/-
Lean version: 4.34.0-rc2 (leanprover/lean4:v4.34.0-rc2).
Mathlib revision: bbcd1968ee6950abe88b85dba6995da346c4b2a8.

Upstream credits

This file includes adapted declarations and local proof fragments from the projects below.
Their credits and Apache 2.0 notices apply to portions derived from those projects. They do not
assert authorship or a license for independently developed material or for this entire file.
Some reuse is limited to subarguments within otherwise independent proofs.

Modified: namespaces and imports consolidated; declarations renamed and reorganized; helpers
inlined; statements, definitions and proofs refactored for this development and its Mathlib API.
The adaptations are not asserted to be verbatim copies of the upstream files.

Attribution: FormalPantheon (frenzymath) contributors.
Adapted areas include the Stepanov and Weil finite-field arguments, Dirichlet L-functions,
large-sieve and Bombieri-Vinogradov estimates, and selected Maynard/Selberg arithmetic,
congruence-counting and tail arguments. These credits include local fragments of the
root-multiplicity, fiber-count, Euler-product, discrepancy and Selberg-moment proofs; they do
not assert that every declaration in these areas is derived from upstream.
Pinned source tree:
https://github.com/frenzymath/FormalPantheon/tree/ffbb65c21afc8a36ace67720f1b0df1c63d26bd1
Released upstream under the Apache License, Version 2.0:
https://github.com/frenzymath/FormalPantheon/blob/ffbb65c21afc8a36ace67720f1b0df1c63d26bd1/LICENSE

Attribution: PrimeNumberTheoremAnd (PNT+) contributors.
Authors of adapted upstream proof ranges include ajirving, giuseppe.sorge and teorth.
Adapted portions of the Mertens development run from `mangoldtLogError` through
`prime_correction_summable`; intervening arguments may be new or substantially rewritten.
Pinned source tree:
https://github.com/AlexKontorovich/PrimeNumberTheoremAnd/tree/47fa48680663df41146704d02a5b092d792bd5b9
Released upstream under the Apache License, Version 2.0:
https://github.com/AlexKontorovich/PrimeNumberTheoremAnd/blob/47fa48680663df41146704d02a5b092d792bd5b9/LICENSE

Copyright (c) 2026 Axiom Math. All rights reserved.
Authors: Axiom Math
Adapted portions of PrimeGapsLib occur in `PrimeGap186.finMulAntidiag_filter_coordinate`,
`PrimeGap186.zeta_pow_eq_card_finMulAntidiag`, `PrimeGap186.one_le_zeta_pow` and
`PrimeGap186.product_lcm_fiber_card_le`. The adaptations rename and move the declarations,
expand divisor-function notation, refactor finite-product arguments, and generalize the
product-fiber estimate to independent divisor supports.
Pinned source tree:
https://github.com/AxiomMath/PrimeGapsLib/tree/1faa7b14e82ddebc2772dfb9153922f01b106477
Released under Apache 2.0 license as described in the upstream LICENSE:
https://github.com/AxiomMath/PrimeGapsLib/blob/1faa7b14e82ddebc2772dfb9153922f01b106477/LICENSE
-/

import Mathlib

/-!
# Conditional prime-gap bound of 186

This file follows *Improved Gaps Between Primes* and its companion,
*Numerical certificate for prime gaps at most 186*. Its main results are DHL[40, 2] for admissible
integer tuples, the explicit forty-element tuple of diameter 186, and the
corresponding prime-gap liminf bound.

## Assumptions

Three external inputs remain explicit axioms:

* `PrimeGap186.kloosterman3_bound`: the normalized rank-three hyper-Kloosterman bound.
* `PrimeGap186.kloosterman2_correlation_bound`: the rank-two Kloosterman correlation bound.
* `PrimeGap186.physical_integral_bounds`: the numerical companion's physical-integral
  bounds and cap bounds.

The terminal theorems depend on these inputs. This is not an unconditional
formalization of either paper. The sharp auxiliary cutoff and the strict
source parameter range are retained.

## Organization

Endpoint adapters are followed by source definitions and the three inputs.
The proofs then develop distribution estimates, fragment minorants,
Selberg moments, and finite trial bounds in dependency order. The final
section assembles the prime-translate and prime-gap consequences.

## Main results

* `PrimeGap186.dhl_40_2`: DHL[40, 2] for every
  admissible forty-element subset of the integers.
* `PrimeGap186.infinite_two_prime_translates_admissibleTuple`:
  infinitely many translates of the explicit tuple contain two primes.
* `PrimeGap186.primeGapLiminf_le_186`: the prime-gap
  liminf is at most 186.
-/

open scoped BigOperators ENNReal NNReal Topology BoundedContinuousFunction
open scoped MeasureTheory.BoundedContinuousFunction Pointwise

open MeasureTheory AddChar Filter Metric

/-! ## Endpoint adapters -/

namespace PrimeGap186

theorem closed_interval_eq_half_open_of_no_endpoint (x : ℝ) (hx : 0 ≤ x)
    (hend : ∀ n : ℕ, (n : ℝ) ≠ 2 * x) :
    Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ = Finset.Ico ⌈x⌉₊ ⌈2 * x⌉₊ := by
  ext n
  simp [Nat.lt_ceil, Nat.le_floor_iff (mul_nonneg zero_le_two hx), (hend n).le_iff_lt]

theorem exists_large_nonintegral_endpoint_of_eventually
    {P : ℝ → Prop} (hP : ∀ᶠ x : ℝ in Filter.atTop, P x) (N : ℝ) :
    ∃ x : ℝ, N < x ∧ P x ∧ ∀ n : ℕ, (n : ℝ) ≠ 2 * x := by
  obtain ⟨M, hM⟩ := Filter.eventually_atTop.mp hP
  obtain ⟨k, hk⟩ := exists_nat_gt (max M N)
  rw [max_lt_iff] at hk
  refine ⟨(k : ℝ) + 1 / 4, by linarith, hM _ (by linarith), ?_⟩
  intro n hn
  have : 2 * n = 4 * k + 1 := by
    exact_mod_cast (show (2 : ℝ) * n = 4 * k + 1 by linarith)
  omega

open Classical in
/--
The rank-three Kloosterman sum over `ZMod p`, normalized by `1 / p`. It sums the standard
additive character of `u + v + w` over triples with product `c`.
-/
noncomputable def normalizedKloosterman3 (p : ℕ) [Fact p.Prime]
    (c : ZMod p) : ℂ :=
  (p : ℂ)⁻¹ *
    ∑ u : ZMod p, ∑ v : ZMod p, ∑ w : ZMod p,
      if u * v * w = c then ZMod.stdAddChar (u + v + w) else 0

/--
The unnormalized classical Kloosterman sum `∑ u ≠ 0, ψ(u + c / u)` over the prime field, indexed
by its units.
-/
noncomputable def unnormalizedKloosterman2 (p : ℕ) [Fact p.Prime]
    (c : ZMod p) : ℂ :=
  ∑ u : (ZMod p)ˣ,
    ZMod.stdAddChar ((u : ZMod p) + c / (u : ZMod p))

end PrimeGap186

/--
Deligne's rank-three hyper-Kloosterman bound, as stated in N. M. Katz,
"Gauss Sums, Kloosterman Sums, and Monodromy Groups", Annals of Mathematics
Studies 116, Princeton University Press (1988), Theorem 4.1.1(1)-(2), p. 49.
https://web.math.princeton.edu/~nmk/Katz-GKM.pdf#page=29
With n = 3, trivial characters and b_i = 1, rank 3 and weight 2 give the raw
bound 3p; normalizedKloosterman3 divides the raw sum by p.
This estimate remains an unproved input in this development.
-/
axiom PrimeGap186.kloosterman3_bound :
  ∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
    c ≠ 0 → ‖PrimeGap186.normalizedKloosterman3 p c‖ ≤ (3 : ℝ)

/--
The rank-two correlation bound of E. Fouvry, E. Kowalski and P. Michel, "The Friedlander-Iwaniec
character sum" (14 June 2013), Proposition 2, p. 1 (proof pp. 2-3, Lemma 4).
https://people.math.ethz.ch/~kowalski/friedlander-iwaniec-sum.pdf
Their Kl_2(c) = unnormalizedKloosterman2 p c / sqrt p after x -> x^(-1).
Thus their 8 sqrt p bound over t != 0,-1 becomes exactly 8p sqrt p here.
This estimate remains an unproved input in this development.
-/
axiom PrimeGap186.kloosterman2_correlation_bound :
  ∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
    A ≠ 0 → B ≠ 0 →
      ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
        PrimeGap186.unnormalizedKloosterman2 p (A / t) *
          PrimeGap186.unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
        8 * (p : ℝ) * Real.sqrt (p : ℝ)

namespace PrimeGap186

/--
The finite atomic measure assigning weight `max (x i) 0` to each sample `x i`. Repeated sample
locations contribute additively, and negative samples have zero weight.
-/
noncomputable def weightedEmpirical (n : ℕ) (x : Fin n → ℝ) : FiniteMeasure ℝ :=
  ∑ i : Fin n,
    let atom : FiniteMeasure ℝ := ⟨Measure.dirac (x i), inferInstance⟩
    (x i).toNNReal • atom

/--
The pushforward obtained by drawing a Poisson count of mean `μ.mass`, drawing locations from
`μ.normalize`, and forming their weighted empirical measure. The atoms are weighted by their
nonnegative locations, not by unit mass.
-/
noncomputable def finitePoissonLaw (μ : FiniteMeasure ℝ) : Measure (FiniteMeasure ℝ) :=
  Measure.map
    (fun p : ℕ × (ℕ → ℝ) =>
      weightedEmpirical p.1 (fun i : Fin p.1 => p.2 i.val))
    ((ProbabilityTheory.poissonMeasure μ.mass).prod
      (Measure.infinitePi (fun _ : ℕ => (μ.normalize : Measure ℝ))))

/--
The finite measure with density `1 / u` on `(0, ζ] ∩ (2^k, 2^(k+1)]`. The dyadic lower bound
keeps the density integrable on each band.
-/
noncomputable def cappedDyadicIntensity (ζ : ℝ) (k : ℤ) : FiniteMeasure ℝ :=
  ⟨((volume.restrict (Set.Ioc (0 : ℝ) ζ)).withDensity
      (fun u : ℝ => ENNReal.ofReal (1 / u))).restrict
      (Set.Ioc ((2 : ℝ) ^ k) ((2 : ℝ) ^ (k + 1))), by
    rw [restrict_withDensity measurableSet_Ioc]
    apply isFiniteMeasure_withDensity
    apply ne_of_lt
    calc
      (∫⁻ u, ENNReal.ofReal (1 / u)
          ∂((volume.restrict (Set.Ioc (0 : ℝ) ζ)).restrict
            (Set.Ioc ((2 : ℝ) ^ k) ((2 : ℝ) ^ (k + 1)))))
        ≤ ∫⁻ _u, ENNReal.ofReal (1 / (2 : ℝ) ^ k)
            ∂((volume.restrict (Set.Ioc (0 : ℝ) ζ)).restrict
              (Set.Ioc ((2 : ℝ) ^ k) ((2 : ℝ) ^ (k + 1)))) := by
          apply lintegral_mono_ae
          filter_upwards [ae_restrict_mem measurableSet_Ioc] with u hu
          exact ENNReal.ofReal_le_ofReal
            (one_div_le_one_div_of_le (zpow_pos (by norm_num) k) hu.1.le)
      _ < ∞ := by
        rw [lintegral_const]
        exact ENNReal.mul_lt_top ENNReal.ofReal_lt_top (measure_lt_top _ _)⟩

/--
Sum a doubly infinite family of fragment measures when the resulting measure has finite mass;
return the zero measure otherwise. The fallback makes this a total function into finite
measures.
-/
noncomputable def finiteFragments (ω : ℤ → FiniteMeasure ℝ) : FiniteMeasure ℝ := by
  classical
  exact if h : IsFiniteMeasure (Measure.sum (fun k : ℤ => (ω k : Measure ℝ))) then
      ⟨Measure.sum (fun k : ℤ => (ω k : Measure ℝ)), h⟩
    else 0

/-- For positive `ζ`, the probability law of the finite weighted fragment measure.
Finite total mass does not mean finitely many fragments. The paper's measure `ν_ζ`
is `exp(γ) * ζ` times this law. -/
noncomputable def fragmentLaw (ζ : ℝ) : Measure (FiniteMeasure ℝ) :=
  Measure.map finiteFragments
    (Measure.infinitePi (fun k : ℤ => finitePoissonLaw (cappedDyadicIntensity ζ k)))

/--
An outer-table row `(scale, rootBound, faceBound, budget)`. The scale is encoded in units of
`10⁻⁶`, the two component bounds in units of `10⁻¹⁸`, and the upward-rounded combined budget in
units of `10⁻¹²`; the component bounds apply after division by the reference value `23685317816
/ 10^24`.
-/
abbrev OuterBoundRow := ℕ × ℕ × ℕ × ℕ

/--
An inner-table row `(massBound, budget)`. The component bound, after division by the reference
value `23685317816 / 10^24`, is encoded in units of `10⁻¹⁸`; the upward-rounded weighted budget
is encoded in units of `10⁻¹²`.
-/
abbrev InnerBoundRow := ℕ × ℕ

/--
The 17 exact integer rows for the order-two outer-component bounds and their rounded budgets.
-/
def outerOrderTwoBounds : List OuterBoundRow :=
  [(961904, 11, 10, 1),
   (502424, 2285, 577, 1),
   (483341, 11432060, 2670744, 12),
   (547373, 3056104728, 915663654, 3346),
   (563915, 37877639997, 12045112668, 42720),
   (583181, 300901046806, 102336788484, 350961),
   (604629, 2682803914309, 980771899210, 3244207),
   (620671, 3338737765461, 1286194297547, 4144522),
   (629321, 7260461043003, 2875471614189, 9138326),
   (635211, 1211995036896, 489032601185, 1539747),
   (616326, 8286469691008, 3147682021553, 10214338),
   (593862, 4616001082128, 1627937050440, 5482540),
   (573977, 2353287968619, 775291485464, 2701470),
   (553178, 1146587714775, 350863740368, 1268537),
   (531463, 529511465762, 149562603056, 562833),
   (508862, 229315416929, 59379253693, 233381),
   (459016, 631278927, 133008010, 580)]

/--
The 35 exact integer rows for the order-`5 / 2` outer-component bounds and their rounded
budgets.
-/
def outerOrderFiveHalvesBounds : List OuterBoundRow :=
  [(7266522, 27, 1426, 1),
   (1241454497, 1, 821, 1),
   (1208324400, 1, 1392, 1),
   (1152630107, 1, 1765, 1),
   (1126190783, 1, 3334, 1),
   (1096246679, 1, 5753, 1),
   (1058983690, 1, 10303, 1),
   (967816560, 1, 18815, 1),
   (867471653, 1, 2089, 1),
   (603785822, 1, 11427, 1),
   (32188902, 16, 16011, 1),
   (1308239, 14362, 24579, 1),
   (386321, 7065761, 1054524, 6),
   (373849, 17914115, 2503735, 14),
   (377891, 260216687, 37159538, 197),
   (385136, 3305952377, 490372043, 2547),
   (395013, 38054077523, 5937779759, 30064),
   (405835, 352112119115, 57993623042, 285799),
   (419505, 3006707964277, 529135146833, 2522662),
   (432001, 19352692647427, 3611707956032, 16720799),
   (445139, 14498518468563, 2872865686933, 12907719),
   (457321, 28197429960534, 5897287451435, 25790569),
   (525975, 57148020076132, 15810035599715, 60116961),
   (518733, 69886316496332, 18805329967080, 72504766),
   (515168, 69366993102523, 18409874222209, 71471327),
   (512357, 62684551010344, 16455348517458, 64233828),
   (509770, 53862830801099, 13997130877252, 54915393),
   (507320, 44981355032435, 11577030541299, 45639918),
   (504951, 36911787941323, 9411611503675, 37277308),
   (502604, 29975466544992, 7572139370727, 30131606),
   (503256, 50573740961589, 12808689167903, 50903176),
   (498048, 32438336646873, 8046407139897, 32311736),
   (492222, 20308616081603, 4920425453752, 19992702),
   (485810, 12358345921158, 2916712121993, 12007621),
   (433769, 15056954296612, 2833062492447, 13062511)]

/--
The seven exact rows for order-two inner components of the base region, recording integral
bounds and rounded weighted budgets.
-/
def innerBaseOrderTwoBounds : List InnerBoundRow :=
  [(25777, 1), (1511410893, 14), (18120016651, 161),
   (903601038105, 8027), (425243194887, 3778),
   (4871216699917, 43272), (23946432, 1)]

/--
The ten exact rows for order-`5 / 2` inner components of the base region, recording integral
bounds and rounded weighted budgets.
-/
def innerBaseOrderFiveHalvesBounds : List InnerBoundRow :=
  [(1, 1), (3229104, 1), (29825526, 1), (77797373079, 692),
   (131978724894, 1173), (292684783730, 2600), (5548294545493, 49286),
   (30283518217418, 269010), (12009121688668, 106678), (686922192553, 6102)]

/--
The eleven exact rows for order-two inner components of the enlarged region, recording integral
bounds and rounded weighted budgets.
-/
def innerEnlargedOrderTwoBounds : List InnerBoundRow :=
  [(467789, 1), (381747797, 383), (386210860, 387),
   (99885644276, 99970), (247732013063, 247941), (381057139991, 381379),
   (266162792752, 266388), (337097314828, 337382), (34427294106, 34457),
   (36820947233, 36852), (18106118, 19)]

/--
The seventeen exact rows for order-`5 / 2` inner components of the enlarged region, recording
integral bounds and rounded weighted budgets.
-/
def innerEnlargedOrderFiveHalvesBounds : List InnerBoundRow :=
  [(2, 1), (107126908277, 107218), (1, 1), (61, 1), (137, 1),
   (177471603, 178), (327802576, 329), (50667881720, 50711),
   (143104919759, 143226), (1323952422879, 1325069), (697854132745, 698443),
   (4234127556194, 4237698), (11632061739670, 11641870),
   (3641610451935, 3644681), (6136054632765, 6141229),
   (3690866567521, 3693979), (737132501820, 737755)]

section
open Set
/--
The eleven multisets of exponents specifying the angular power-sum monomials in the trial
function. The empty multiset gives the constant monomial.
-/
def trialAngularSignature : Fin 11 → Multiset ℕ :=
  ![0, {2}, {3}, {4}, {5}, {6}, {2, 2}, {2, 3}, {2, 4}, {3, 3}, {2, 2, 2}]

/--
The integer coefficient table for the eleven degree-at-most-six radial polynomials. Actual
coefficients are obtained by dividing every entry by `10^10`.
-/
def trialCoefficientInteger : Fin 11 → Fin 7 → ℤ :=
  ![![10000000000, -264598476112, 834262268474, -3540575351215,
      5377491111325, 116705356572254, 121730820431102],
    ![71070047507, 7222861788586, -48747932657986, 290976672545723,
      -1136422724027134, -2058910631434711, 1375878942948547],
    ![6457252424873, -61201446212885, 28811649792090, -2058803084231281,
      9970156747759406, 38278849934023144, 34806920812932737],
    ![-16779263512274, 128033707910825, 169290603857215, 7359669931312727,
      -35090795379920588, -120997133235510923, -141527585901304670],
    ![28114161526671, -276375633435566, -690482702304933, -15120456749385986,
      47650276584638031, 372137534144492224, 2191913505882230103],
    ![-21150553032771, 379875924448266, -929062247569514, -13967219843969236,
      168416050564605519, -248058724714138769, -4161797957833172083],
    ![-19004216224617, 136674974139652, -183344485344333, 1114879023072977,
      1119583327002910, -47568062965320963, 2537631525616777],
    ![31171802814567, -97428388152051, 526635309233054, 1222047580792220,
      15846796161434448, -165623953461271580, -2358019996221938729],
    ![-53602626608739, 329397902441121, 1613505134333316, 13893066541430270,
      -126262434123562668, 239934302929501943, -1506861482386002243],
    ![27653330903418, -290549334488305, -1847330641348475, 28351866831729468,
      -61505472221886320, -424266003419714347, 2585236507449911535],
    ![12374547113901, -244168600145684, 1603694896120437, -21603130476787649,
      -30285492734943698, 381987976419637874, 3605516061450295448]]

/--
The radial polynomial attached to angular signature `s`, with seven coefficients taken from the
exact integer table and scaled by `10⁻¹⁰`.
-/
noncomputable def trialRadialPolynomial (s : Fin 11) : Polynomial ℚ :=
  Polynomial.ofFn 7 (fun d : Fin 7 => (trialCoefficientInteger s d : ℚ) / 10000000000)

/--
The product of power sums `∏ e ∈ σ, ∑ i, t i ^ e`, retaining multiplicities in `σ`. The empty
signature evaluates to `1`.
-/
def angularMonomial {R : Type*} [CommSemiring R] {d : ℕ}
    (σ : Multiset ℕ) (t : Fin d → R) : R :=
  (σ.map (fun e => ∑ i : Fin d, t i ^ e)).prod

end

/-- The rational mesh width `(2742997 / 2624989) / 98304` used to discretize fragment masses. -/
def trialMesh : ℚ := (2742997 / 2624989) / 98304

/-- The largest allowed fragment location, equal to `68225` mesh widths. -/
def trialLargestCap : ℚ := 68225 * trialMesh

/--
The physical fragment measure at the largest cap, obtained by scaling the fragment probability
law by `exp(γ)` times that cap.
-/
noncomputable def trialPhysicalMeasure : Measure (FiniteMeasure ℝ) :=
  ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * (trialLargestCap : ℝ)) •
    fragmentLaw (trialLargestCap : ℝ)

/--
The natural-number floor of a fragment measure's total mass divided by the mesh width. It
indexes the left-closed mesh cell containing the mass.
-/
noncomputable def trialCellIndex (X : FiniteMeasure ℝ) : ℕ :=
  ⌊(X.mass : ℝ) / (trialMesh : ℝ)⌋₊

/-- The rational midpoint `(j + 1 / 2) * trialMesh` of mesh cell `j`. -/
def trialCellMidpoint (j : ℕ) : ℚ := ((j : ℚ) + 1 / 2) * trialMesh

/--
The two-pole rational profile with weights `21 / 200` and `179 / 200`, used multiplicatively in
the trial function. Division follows the ambient field's totalized convention.
-/
def trialProfile {R : Type*} [Field R] (t : R) : R :=
  (21 / 200) / (1 + t / 100) + (179 / 200) / (1 + (907 / 5) * t)

/-- The exact rational trial-profile value at the midpoint of mesh cell `j`. -/
def trialProfileValue (j : ℕ) : ℚ :=
  trialProfile (trialCellMidpoint j)

theorem trialProfile_ratCast (t : ℚ) :
    trialProfile (t : ℝ) = ((trialProfile t : ℚ) : ℝ) := by
  norm_num [trialProfile]

theorem trialProfile_midpoint (j : ℕ) :
    trialProfile (trialCellMidpoint j : ℝ) = (trialProfileValue j : ℝ) :=
  trialProfile_ratCast (trialCellMidpoint j)

theorem sum_trialCellMidpoint (j : Fin 40 → ℕ) :
    (∑ i : Fin 40, (trialCellMidpoint (j i) : ℝ)) =
      (((∑ i : Fin 40, j i : ℕ) : ℝ) + 20) * (trialMesh : ℝ) := by
  push_cast [trialCellMidpoint]
  norm_num [← Finset.sum_mul, Finset.sum_add_distrib]

theorem trialProfile_pos (t : ℝ) (ht : 0 ≤ t) : 0 < trialProfile t := by
  unfold trialProfile
  positivity

/--
The sum of squared midpoint profile values over cells `0` through `98263`. The mesh factor is
applied separately in the physical normalizer.
-/
def trialProfileNormalizer : ℚ :=
  ∑ j ∈ Finset.range 98264, trialProfileValue j ^ 2

/--
The indicator of the admissible 40-coordinate outer region: the summed cell index is at most
`98263`, and every fragment measure obeys the radial band's location cap.
-/
noncomputable def trialOuterMask (X : Fin 40 → FiniteMeasure ℝ) : ℝ := by
  classical
  exact
    let r : ℕ := ∑ i : Fin 40, trialCellIndex (X i)
    let cap : ℕ := if r ≤ 89196 then 68225 else if r ≤ 95598 then 49152 else 46580
    if r ≤ 98263 ∧
        ∀ i : Fin 40,
          (X i : Measure ℝ) (Set.Ioi ((cap : ℝ) * (trialMesh : ℝ))) = 0
    then 1 else 0

/--
The indicator of the base 39-coordinate region, with summed cell index at most `89524` and the
corresponding piecewise fragment-location cap.
-/
noncomputable def trialBaseMask (Y : Fin 39 → FiniteMeasure ℝ) : ℝ := by
  classical
  exact
    let r : ℕ := ∑ i : Fin 39, trialCellIndex (Y i)
    let cap : ℕ := if r ≤ 84930 then 68225 else if r ≤ 87194 then 44781 else 35265
    if r ≤ 89524 ∧
        ∀ i : Fin 39,
          (Y i : Measure ℝ) (Set.Ioi ((cap : ℝ) * (trialMesh : ℝ))) = 0
    then 1 else 0

/--
The indicator of the enlarged 39-coordinate region, with summed cell index at most `89914` and
its piecewise fragment-location cap.
-/
noncomputable def trialEnlargedMask (Y : Fin 39 → FiniteMeasure ℝ) : ℝ := by
  classical
  exact
    let r : ℕ := ∑ i : Fin 39, trialCellIndex (Y i)
    let cap : ℕ := if r ≤ 85161 then 68225 else if r ≤ 87249 then 44976 else 35419
    if r ≤ 89914 ∧
        ∀ i : Fin 39,
          (Y i : Measure ℝ) (Set.Ioi ((cap : ℝ) * (trialMesh : ℝ))) = 0
    then 1 else 0

/--
The indicator of the full 39-coordinate region: summed cell index at most `98263` and no
fragment mass above the largest cap.
-/
noncomputable def trialFullMask (Y : Fin 39 → FiniteMeasure ℝ) : ℝ := by
  classical
  exact
    if (∑ i : Fin 39, trialCellIndex (Y i)) ≤ 98263 ∧
        ∀ i : Fin 39,
          (Y i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0
    then 1 else 0

/--
The masked trial expression: a product of one-variable profiles times eleven
radial-polynomial/angular-monomial terms. The radial polynomials are evaluated at `(∑ i, t i) -
9 / 10`, while the mask depends on the original fragment measures `X`.
-/
noncomputable def trialCore
    (X : Fin 40 → FiniteMeasure ℝ) (t : Fin 40 → ℝ) : ℝ :=
  trialOuterMask X * (∏ i : Fin 40, trialProfile (t i)) *
    ∑ s : Fin 11,
      (trialRadialPolynomial s).eval₂ (Rat.castHom ℝ) ((∑ i, t i) - 9 / 10) *
        angularMonomial (trialAngularSignature s) t

/-- The trial core evaluated at the actual total masses of the 40 fragment measures. -/
noncomputable def trialFormalFunction (X : Fin 40 → FiniteMeasure ℝ) : ℝ :=
  trialCore X (fun i => ((X i).mass : ℝ))

/--
The trial core evaluated at mesh-cell midpoints of the 40 fragment masses, retaining the mask of
the original measures.
-/
noncomputable def trialStepFunction (X : Fin 40 → FiniteMeasure ℝ) : ℝ :=
  trialCore X (fun i => (trialCellMidpoint (trialCellIndex (X i)) : ℝ))

theorem trialStepFunction_eq_cellExpression (X : Fin 40 → FiniteMeasure ℝ) :
    trialStepFunction X =
      trialOuterMask X *
        (∏ i : Fin 40, (trialProfileValue (trialCellIndex (X i)) : ℝ)) *
          ∑ s : Fin 11,
            (trialRadialPolynomial s).eval₂ (Rat.castHom ℝ)
                ((((∑ i : Fin 40, trialCellIndex (X i) : ℕ) : ℝ) + 20) *
                  (trialMesh : ℝ) - 9 / 10) *
              angularMonomial (trialAngularSignature s)
                (fun i => (trialCellMidpoint (trialCellIndex (X i)) : ℝ)) := by
  simp only [trialStepFunction, trialCore, trialProfile_midpoint, sum_trialCellMidpoint]

/--
Integrate the step trial function in coordinate `i` against the physical fragment measure,
keeping the other 39 coordinates fixed.
-/
noncomputable def trialMarginal
    (i : Fin 40) (Y : Fin 39 → FiniteMeasure ℝ) : ℝ :=
  ∫ X : FiniteMeasure ℝ, trialStepFunction (i.insertNth X Y) ∂trialPhysicalMeasure

/--
The fortieth power of the mesh-weighted one-dimensional squared-profile sum, used to normalize
all trial integrals.
-/
noncomputable def trialPhysicalNormalizer : ℝ :=
  ((trialMesh : ℝ) * (trialProfileNormalizer : ℝ)) ^ 40

/--
The normalized squared `L²` integral of the 40-coordinate step trial function under the product
physical measure.
-/
noncomputable def trialIH : ℝ :=
  (∫ X : Fin 40 → FiniteMeasure ℝ, trialStepFunction X ^ 2
    ∂Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)) / trialPhysicalNormalizer

/--
The normalized sum of squared coordinate marginals integrated over the base 39-coordinate
region.
-/
noncomputable def trialJ0 : ℝ :=
  (∑ i : Fin 40,
    ∫ Y : Fin 39 → FiniteMeasure ℝ,
      trialBaseMask Y * trialMarginal i Y ^ 2
      ∂Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)) / trialPhysicalNormalizer

/--
The normalized sum of squared coordinate marginals on the enlarged region outside the base
region.
-/
noncomputable def trialJPlus : ℝ :=
  (∑ i : Fin 40,
    ∫ Y : Fin 39 → FiniteMeasure ℝ,
      trialEnlargedMask Y * (1 - trialBaseMask Y) * trialMarginal i Y ^ 2
      ∂Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)) / trialPhysicalNormalizer

/--
The normalized sum of squared coordinate marginals on the full region outside the enlarged
region.
-/
noncomputable def trialJTail : ℝ :=
  (∑ i : Fin 40,
    ∫ Y : Fin 39 → FiniteMeasure ℝ,
      trialFullMask Y * (1 - trialEnlargedMask Y) * trialMarginal i Y ^ 2
      ∂Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)) / trialPhysicalNormalizer

/--
The signed trial marginal functional combining the base, enlargement, and tail contributions
with the specified exact rational coefficients.
-/
noncomputable def trialJLambdaH : ℝ :=
  trialJ0 +
    ((2479900401 / 2500000000 : ℝ) + (-843183 / 1000000000 : ℝ)) * trialJPlus +
      (-843183 / 1000000000 : ℝ) * trialJTail

/--
Exact rational geometry for one source row: its order, radial band, activation level, outer and
inner core radii, and their thresholds.
-/
structure PhysicalSourceRowData where
  /--
  Dense-divisibility order required by this source row; the canonical rows use orders `1`, `2`,
  and `3`.
  -/
  order : ℕ
  /--
  Exclusive lower endpoint of the row's modulus-size band in logarithmic exponent coordinates.
  -/
  lowerBand : ℚ
  /--
  Inclusive upper endpoint of the row's modulus-size band in logarithmic exponent coordinates.
  -/
  upperBand : ℚ
  /--
  Prime-factor exponent cutoff `ξ`, also determining the dense-divisibility scale `R^ξ`;
  activation requires an exponent strictly greater than `ξ`.
  -/
  activation : ℚ
  /--
  Outer total-mass cutoff at or below which no ownership constraint is needed; canonically the
  lower band endpoint minus the inner support radius.
  -/
  outerCore : ℚ
  /--
  Inner total-mass cutoff at or below which no ownership constraint is needed; canonically the
  lower band endpoint minus the outer support radius.
  -/
  innerCore : ℚ
  /--
  Upper budget for outer-owned mass; canonical rows add their order-dependent increment to
  `outerCore`.
  -/
  outerThreshold : ℚ
  /--
  Upper budget for inner-owned mass; canonical rows add their order-dependent increment to
  `innerCore`.
  -/
  innerThreshold : ℚ

/-- The fixed rational density parameter `262499 / 1000000` used in source-row geometry. -/
def physicalSourceRho : ℚ := 262499 / 1000000

/-- The outer radial cutoff, equal to `98304` mesh widths. -/
def physicalSourceOuterRadius : ℚ := 98304 * trialMesh

/-- The inner radial cutoff for the base (`ν = 0`) or enlarged (`ν = 1`) source family. -/
def physicalSourceInnerRadius (ν : Fin 2) : ℚ :=
  if ν = 0 then 2 - 3 / 1000 - physicalSourceOuterRadius else 2510000 / 2624989

/--
The positive radial advance `10⁻⁷ / physicalSourceRho` separating source thresholds from the
cutoff radii.
-/
def physicalSourceAdvance : ℚ := (1 / 10000000) / physicalSourceRho

/--
Assign source rows to orders one, two, and three using the index bands below `12`, from `12` to
`23`, and from `24` onward.
-/
def physicalSourceOrder (t : ℕ) : ℕ :=
  if t < 12 then 1 else if t < 24 then 2 else 3

/--
The rational intercept and slope governing the source-row activation inequality, selected by
source family and row order.
-/
def physicalSourceAffine (ν : Fin 2) (t : ℕ) : ℚ × ℚ :=
  let σ : ℚ :=
    if ν = 0 then 100001 / 1000000 else 1 / 2 - 40481 / 100000 + 1 / 10000000000
  if physicalSourceOrder t = 1 then ((1 - 5 * σ) / 15, 18 / 5)
  else if physicalSourceOrder t = 2 then ((1 - 4 * σ) / 16, 7 / 2)
  else if ν = 0 then (3 / 80, 3) else ((1 - 2 * σ) / 20, 16 / 5)

/--
The recursively advanced rational source parameter, starting at zero and capped at the
family-specific terminal value. Each step uses the row's affine bound with explicit safety
margins.
-/
def physicalSourceOmegaPrefix (ν : Fin 2) : ℕ → ℚ :=
  Nat.rec 0 (fun t previous =>
    let Ω : ℚ := if ν = 0 then 12499 / 1000000 else 253 / 20000
    let ε : ℚ := if ν = 0 then 1 / 1000000 else 1 / 10000000
    let E : ℚ := physicalSourceRho *
      (physicalSourceOuterRadius + physicalSourceInnerRadius ν) - 1 / 2
    let cs := physicalSourceAffine ν t
    if previous = Ω then Ω else
      min Ω ((cs.1 - ε - E + 2 * previous - 1 / 10000000) / cs.2))

/--
Construct the exact row geometry from two successive source parameters. Orders one and two use
the activation directly as the threshold increment; order three uses the half-adjusted
increment.
-/
def physicalSourceRow (ν : Fin 2) (t : ℕ) : PhysicalSourceRowData :=
  let cs := physicalSourceAffine ν t
  let ε : ℚ := if ν = 0 then 1 / 1000000 else 1 / 10000000
  let B : ℚ := (1 / 2 + 2 * physicalSourceOmegaPrefix ν t) / physicalSourceRho
  let Bplus : ℚ :=
    (1 / 2 + 2 * physicalSourceOmegaPrefix ν (t + 1)) / physicalSourceRho
  let ξ : ℚ :=
    (cs.1 - cs.2 * physicalSourceOmegaPrefix ν (t + 1) - ε) / physicalSourceRho
  let a : ℚ := B - physicalSourceInnerRadius ν
  let b : ℚ := B - physicalSourceOuterRadius
  let η : ℚ := if physicalSourceOrder t ≤ 2 then ξ else
    (ξ + physicalSourceOuterRadius + physicalSourceInnerRadius ν - B) / 2
  { order := physicalSourceOrder t
    lowerBand := B
    upperBand := Bplus
    activation := ξ
    outerCore := a
    innerCore := b
    outerThreshold := a + η
    innerThreshold := b + η }

/-- In both TeX documents, `cap` is the group cap `z_G` and `split` is `p_G`. -/
structure PhysicalSourceGroupData where
  /--
  Number of fragment-measure coordinates; canonical outer and inner groups use `40` and `39`.
  -/
  dimension : ℕ
  /--
  Effective covering order `μ_G`; canonical groups use `2` or `5 / 2`, distinct from a row's
  dense-divisibility order.
  -/
  order : ℚ
  /--
  Lower fragment-size endpoint of the low-fragment partition; canonical groups choose it no
  larger than their assigned rows' activation levels.
  -/
  activation : ℚ
  /--
  Budget `T_G` exceeded in the covering test `tailMass + (order - 1) * p > T_G`, where the tail
  includes fragments of size at least `p`.
  -/
  threshold : ℚ
  /--
  Exclusive lower endpoint of the group's total-fragment-mass range, before component-specific
  clipping and mesh-cell enlargement.
  -/
  lowerRadius : ℚ
  /--
  Inclusive upper endpoint of the group's total-fragment-mass range, used to bound its radial
  cell indices.
  -/
  upperRadius : ℚ
  /-- The group cap `z_G` on individual fragment sizes, not on their total mass. -/
  cap : ℚ
  /--
  The splitting point `p_G` ending the low-fragment partition; the triple-count component counts
  fragments strictly above it.
  -/
  split : ℚ

/--
The six covering groups: two outer groups, two base inner groups, and two enlarged inner groups,
each pair having orders `2` and `5 / 2`.
-/
def physicalSourceGroup (g : Fin 6) : PhysicalSourceGroupData :=
  let S := physicalSourceOuterRadius
  let T0 := physicalSourceInnerRadius 0
  let T1 := physicalSourceInnerRadius 1
  let e := physicalSourceAdvance
  ![{ dimension := 40, order := 2,
      activation := (physicalSourceRow 0 23).activation, threshold := S + e,
      lowerRadius := (physicalSourceRow 1 0).outerCore,
      upperRadius := (physicalSourceRow 1 24).outerCore,
      cap := 49152 * trialMesh, split := 24576 * trialMesh },
    { dimension := 40, order := 5 / 2,
      activation := (physicalSourceRow 1 38).activation, threshold := S + e / 2,
      lowerRadius := (physicalSourceRow 1 24).outerCore,
      upperRadius := 98303 * trialMesh,
      cap := 46580 * trialMesh, split := 19660 * trialMesh },
    { dimension := 39, order := 2,
      activation := (physicalSourceRow 0 23).activation, threshold := T0 + e,
      lowerRadius := (physicalSourceRow 0 12).innerCore,
      upperRadius := (physicalSourceRow 0 24).innerCore,
      cap := 44781 * trialMesh, split := 22390 * trialMesh },
    { dimension := 39, order := 5 / 2,
      activation := (physicalSourceRow 0 27).activation, threshold := T0 + e / 2,
      lowerRadius := (physicalSourceRow 0 24).innerCore,
      upperRadius := 89563 * trialMesh,
      cap := 35265 * trialMesh, split := 17912 * trialMesh },
    { dimension := 39, order := 2,
      activation := (physicalSourceRow 1 23).activation, threshold := T1 + e,
      lowerRadius := (physicalSourceRow 1 12).innerCore,
      upperRadius := (physicalSourceRow 1 24).innerCore,
      cap := 44976 * trialMesh, split := 22488 * trialMesh },
    { dimension := 39, order := 5 / 2,
      activation := (physicalSourceRow 1 38).activation, threshold := T1 + e / 2,
      lowerRadius := (physicalSourceRow 1 24).innerCore,
      upperRadius := 89953 * trialMesh,
      cap := 35419 * trialMesh, split := 17990 * trialMesh }] g

/-- The finite set of source-family and row-index pairs assigned to covering group `g`. -/
def physicalSourceRows (g : Fin 6) : Finset (Fin 2 × ℕ) :=
  ![(Finset.range 24).biUnion (fun t => {(0, t), (1, t)}),
    (Finset.Icc 24 27).image (fun t => (0, t)) ∪
      (Finset.Icc 24 38).image (fun t => (1, t)),
    (Finset.Icc 12 23).image (fun t => (0, t)),
    (Finset.Icc 24 27).image (fun t => (0, t)),
    (Finset.Icc 12 23).image (fun t => (1, t)),
    (Finset.Icc 24 38).image (fun t => (1, t))] g

/--
The exact rational endpoints partitioning the low-fragment part of group `g`, from its
activation level to its splitting point.
-/
def physicalSourceLowBoundaries (g : Fin 6) : List ℚ :=
  let ξ := (physicalSourceGroup g).activation
  let p := (physicalSourceGroup g).split
  let a : ℕ → ℚ := fun j => (1 / 20) * (6 / 5) ^ j
  ![[ξ, (3 / 2) * ξ, a 0, a 4, a 5, a 6, a 7, a 8, (a 8 + a 9) / 2, a 9, p],
    [ξ, 2 * ξ, 4 * ξ, 8 * ξ, 16 * ξ, 32 * ξ, 64 * ξ, 128 * ξ,
      256 * ξ, 1 / 100, 3 / 200, 9 / 400, 27 / 800, a 0, a 1, a 2,
      a 3, a 4, a 5, a 6, a 7, (a 7 + p) / 2, p],
    [ξ, a 0, a 4, a 6, a 8, p],
    [ξ, 2 * ξ, 1 / 100, 27 / 800, a 3, a 5, a 6, p],
    [ξ, a 1, a 4, a 5, a 7, a 8, p],
    [ξ, 2 * ξ, 16 * ξ, 64 * ξ, 256 * ξ, 9 / 400,
      a 1, a 3, a 5, a 6, a 7, p]] g

/--
The rational subdivision fractions used to partition the rank component interval between its
lower endpoint and the group cap.
-/
def physicalSourceRankFractions (g : Fin 6) : List ℚ :=
  ![[0, 1 / 6, 1 / 3, 1 / 2, 2 / 3, 5 / 6, 1],
    [0, 1 / 16, 1 / 8, 3 / 16, 1 / 4, 5 / 16, 3 / 8,
      7 / 16, 1 / 2, 5 / 8, 3 / 4, 7 / 8, 1],
    [0, 1],
    [0, 1 / 2, 1],
    [0, 1 / 6, 1 / 2, 2 / 3, 1],
    [0, 1 / 8, 3 / 8, 1 / 2, 3 / 4, 1]] g

/-- The number of consecutive low-fragment intervals, one less than the boundary-list length. -/
def physicalSourceLowCount (g : Fin 6) : ℕ := (physicalSourceLowBoundaries g).length - 1

/--
The number of consecutive rank intervals, one less than the subdivision-fraction list length.
-/
def physicalSourceRankCount (g : Fin 6) : ℕ := (physicalSourceRankFractions g).length - 1

/--
The total number of covering components: all low intervals, all rank intervals, and one
triple-count component.
-/
def physicalSourceRowCount (g : Fin 6) : ℕ :=
  physicalSourceLowCount g + physicalSourceRankCount g + 1

/--
Encode a component as `0` for low-fragment, `1` for rank, or `2` for triple-count. Indices
beyond the declared row count also receive `2` and are rejected by the radial mask.
-/
def physicalSourceComponentKind (g : Fin 6) (j : ℕ) : ℕ :=
  if j < physicalSourceLowCount g then 0
  else if j < physicalSourceLowCount g + physicalSourceRankCount g then 1 else 2

/--
The rational endpoints of the chosen component: consecutive low boundaries, affinely rescaled
rank fractions, or the split-to-cap interval for the triple-count component.
-/
def physicalSourceComponentEndpoints (g : Fin 6) (j : ℕ) : ℚ × ℚ :=
  let G := physicalSourceGroup g
  if physicalSourceComponentKind g j = 0 then
    ((physicalSourceLowBoundaries g).getD j 0,
      (physicalSourceLowBoundaries g).getD (j + 1) 0)
  else if physicalSourceComponentKind g j = 1 then
    let k := j - physicalSourceLowCount g
    let q0 := G.threshold / (G.order + 1)
    (q0 + (physicalSourceRankFractions g).getD k 0 * (G.cap - q0),
      q0 + (physicalSourceRankFractions g).getD (k + 1) 0 * (G.cap - q0))
  else (G.split, G.cap)

/--
The exponential tilt for a low-fragment component, rounded upward from `7 / upperEndpoint` or `9
/ upperEndpoint`, with the specified exceptional value `120`. Non-low components have zero tilt.
-/
def physicalSourceTheta (g : Fin 6) (j : ℕ) : ℚ :=
  if physicalSourceComponentKind g j = 0 then
    if g = 0 ∧ j = 2 then 120 else
      let numerator : ℚ := if g = 5 then 9 else 7
      ((⌈numerator / (physicalSourceComponentEndpoints g j).2⌉ : ℤ) : ℚ)
  else 0

/--
The lower radial clipping level obtained from eligible source rows activated below `u`,
including rows absorbed from the preceding group where prescribed. It is absent when no row is
eligible; otherwise it is the smallest row bound, truncated below by the group's lower radius.
-/
def physicalSourceLowClipping (g : Fin 6) (u : ℚ) : Option ℚ :=
  let G := physicalSourceGroup g
  let absorbed : Finset (Fin 2 × ℕ) :=
    if g = 1 then physicalSourceRows 0
    else if g = 3 then physicalSourceRows 2
    else if g = 5 then physicalSourceRows 4 else ∅
  let eligible := (physicalSourceRows g ∪ absorbed).filter
    (fun row => (physicalSourceRow row.1 row.2).activation < u)
  let values : Finset ℚ := eligible.image (fun row =>
    let R := physicalSourceRow row.1 row.2
    let core := if g.val < 2 then R.outerCore else R.innerCore
    let threshold := if g.val < 2 then R.outerThreshold else R.innerThreshold
    let μ : ℚ := if R.order ≤ 2 then 2 else 5 / 2
    max core (threshold - (μ - 1) * u))
  if hvalues : values.Nonempty then some (max G.lowerRadius (values.min' hvalues)) else none

/--
The fragment-cap index aligned with radial cell sum `r`, using the outer, base-inner, or
enlarged-inner piecewise schedule according to the group.
-/
def physicalSourceAlignedCapIndex (g : Fin 6) (r : ℕ) : ℕ :=
  if g.val < 2 then
    if r ≤ 89196 then 68225 else if r ≤ 95598 then 49152 else 46580
  else if g.val < 4 then
    if r ≤ 84930 then 68225 else if r ≤ 87194 then 44781 else 35265
  else
    if r ≤ 85161 then 68225 else if r ≤ 87249 then 44976 else 35419

/--
The indicator that a component exists and its radial cell sum satisfies the global cutoff and
clipped group bounds. The lower bound includes the dimension-dependent mesh-cell correction.
-/
def physicalSourceRadialMask (g : Fin 6) (j d r : ℕ) : ℝ :=
  let G := physicalSourceGroup g
  let top : ℕ := if g.val < 2 then 98263 else if g.val < 4 then 89524 else 89914
  let lower : Option ℚ := if physicalSourceComponentKind g j = 0 then
    physicalSourceLowClipping g (physicalSourceComponentEndpoints g j).2
    else some G.lowerRadius
  match lower with
  | none => 0
  | some c =>
    if j < physicalSourceRowCount g ∧ r ≤ top ∧
        (⌊c / trialMesh⌋ : ℤ) - (d : ℤ) + 1 ≤ (r : ℤ) ∧
        (r : ℤ) ≤ (⌊G.upperRadius / trialMesh⌋ : ℤ)
    then 1 else 0

/--
Sum the coordinate fragment measures on positive locations and divide their density by the
location. For weighted fragment atoms `u • δ_u`, this recovers the corresponding counting
measure.
-/
noncomputable def physicalSourceCountMeasure {d : ℕ}
    (X : Fin d → FiniteMeasure ℝ) : Measure ℝ :=
  ((∑ i : Fin d, (X i : Measure ℝ)).restrict (Set.Ioi (0 : ℝ))).withDensity
    (fun t : ℝ => ENNReal.ofReal t⁻¹)

/--
The nonnegative covering weight for one physical component, subject to radial and fragment-cap
masks. Low components use an exponentially tilted count, rank components integrate a rank
condition, and the final component counts triples above the splitting point.
-/
noncomputable def physicalSourceCover (g : Fin 6) (j : ℕ) {d : ℕ}
    (X : Fin d → FiniteMeasure ℝ) : ℝ := by
  classical
  exact
    let P := physicalSourceGroup g
    let e := physicalSourceComponentEndpoints g j
    let r : ℕ := ∑ i : Fin d, trialCellIndex (X i)
    let N := physicalSourceCountMeasure X
    let χ := physicalSourceRadialMask g j d r
    let cap : ℝ := (physicalSourceAlignedCapIndex g r : ℝ) * (trialMesh : ℝ)
    if ∀ i : Fin d, (X i : Measure ℝ) (Set.Ioi cap) = 0 then
      χ *
        (if physicalSourceComponentKind g j = 0 then
          N.real (Set.Ioc (e.1 : ℝ) (e.2 : ℝ)) *
            Real.exp ((physicalSourceTheta g j : ℝ) *
              ((∑ i : Fin d, ((X i).mass : ℝ)) +
                ((P.order : ℝ) - 1) * (e.2 : ℝ) - (P.threshold : ℝ) -
                ∑ i : Fin d, (X i : Measure ℝ).real (Set.Ioc (0 : ℝ) (e.1 : ℝ))))
        else if physicalSourceComponentKind g j = 1 then
          ∫ q : ℝ in Set.Ioc (e.1 : ℝ) (e.2 : ℝ),
            (if N (Set.Ioi q) = 0 ∧
                (2 : ℝ) ≤ N.real (Set.Ioc (((P.threshold : ℝ) - q) / (P.order : ℝ)) q)
              then (1 : ℝ) else 0) ∂N
        else
          (Nat.choose ⌊N.real (Set.Ioi (P.split : ℝ))⌋₊ 3 : ℝ))
    else 0

/--
The absolute-coefficient envelope on a 39-coordinate face: `1` on the base region, the larger
enlargement/tail coefficient magnitude on the enlarged region, and the tail coefficient
magnitude elsewhere.
-/
noncomputable def physicalSourceFaceWeight
    (Y : Fin 39 → FiniteMeasure ℝ) : ℝ := by
  classical
  exact
    if trialBaseMask Y = 1 then 1
    else if trialEnlargedMask Y = 1 then
      max |(2479900401 / 2500000000 : ℝ) + (-843183 / 1000000000 : ℝ)|
        |(-843183 / 1000000000 : ℝ)|
    else |(-843183 / 1000000000 : ℝ)|

/--
The normalized outer-component integral of the squared trial function, summed over all 40 faces
and weighted by the covering function and face-coefficient envelope.
-/
noncomputable def physicalSourceOuterRoot (g : Fin 6) (j : ℕ) : ℝ :=
  (∑ i : Fin 40,
    ∫ X : Fin 40 → FiniteMeasure ℝ,
      physicalSourceCover g j X * physicalSourceFaceWeight (i.removeNth X) *
        trialStepFunction X ^ 2
      ∂Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)) / trialPhysicalNormalizer

/--
The normalized outer-component integral of the squared face marginal, summed over all 40 faces
with the covering function and face-coefficient envelope.
-/
noncomputable def physicalSourceOuterFace (g : Fin 6) (j : ℕ) : ℝ :=
  (∑ i : Fin 40,
    ∫ X : Fin 40 → FiniteMeasure ℝ,
      physicalSourceCover g j X * physicalSourceFaceWeight (i.removeNth X) *
        trialMarginal i (i.removeNth X) ^ 2
      ∂Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)) / trialPhysicalNormalizer

/--
The normalized covering-weighted squared-marginal integral for an inner component, summed over
coordinates. Groups below `4` use the base mask; the remaining groups use the enlarged mask.
-/
noncomputable def physicalSourceInnerMass (g : Fin 6) (j : ℕ) : ℝ :=
  (∑ i : Fin 40,
    ∫ Y : Fin 39 → FiniteMeasure ℝ,
      (if g.val < 4 then trialBaseMask Y else trialEnlargedMask Y) *
        physicalSourceCover g j Y * trialMarginal i Y ^ 2
      ∂Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)) / trialPhysicalNormalizer

end PrimeGap186

/--
Numerical companion, Tables 2.1 through 2.6 and Equation (2.33): 104 outer and 45 inner physical
integral bounds, and three cap bounds. The computational enclosure forms majorize these physical
integrals; they are not the same definitions. The rational assembly below is proved, but the
complete production contractions are not yet proved.
-/
axiom PrimeGap186.physical_integral_bounds :
  (∀ j : Fin PrimeGap186.outerOrderTwoBounds.length,
    PrimeGap186.physicalSourceOuterRoot 0 j.val /
        ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
      ((PrimeGap186.outerOrderTwoBounds.get j).2.1 : ℝ) / (10 : ℝ) ^ 18 ∧
    PrimeGap186.physicalSourceOuterFace 0 j.val /
        ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
      ((PrimeGap186.outerOrderTwoBounds.get j).2.2.1 : ℝ) / (10 : ℝ) ^ 18) ∧
  (∀ j : Fin PrimeGap186.outerOrderFiveHalvesBounds.length,
    PrimeGap186.physicalSourceOuterRoot 1 j.val /
        ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
      ((PrimeGap186.outerOrderFiveHalvesBounds.get j).2.1 : ℝ) / (10 : ℝ) ^ 18 ∧
    PrimeGap186.physicalSourceOuterFace 1 j.val /
        ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
      ((PrimeGap186.outerOrderFiveHalvesBounds.get j).2.2.1 : ℝ) / (10 : ℝ) ^ 18) ∧
  (∀ j : Fin PrimeGap186.innerBaseOrderTwoBounds.length,
    PrimeGap186.physicalSourceInnerMass 2 j.val /
        ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
      ((PrimeGap186.innerBaseOrderTwoBounds.get j).1 : ℝ) / (10 : ℝ) ^ 18) ∧
  (∀ j : Fin PrimeGap186.innerBaseOrderFiveHalvesBounds.length,
    PrimeGap186.physicalSourceInnerMass 3 j.val /
        ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
      ((PrimeGap186.innerBaseOrderFiveHalvesBounds.get j).1 : ℝ) / (10 : ℝ) ^ 18) ∧
  (∀ j : Fin PrimeGap186.innerEnlargedOrderTwoBounds.length,
    PrimeGap186.physicalSourceInnerMass 4 j.val /
        ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
      ((PrimeGap186.innerEnlargedOrderTwoBounds.get j).1 : ℝ) / (10 : ℝ) ^ 18) ∧
  (∀ j : Fin PrimeGap186.innerEnlargedOrderFiveHalvesBounds.length,
    PrimeGap186.physicalSourceInnerMass 5 j.val /
        ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
      ((PrimeGap186.innerEnlargedOrderFiveHalvesBounds.get j).1 : ℝ) / (10 : ℝ) ^ 18) ∧
  (23685317816 : ℝ) / (10 : ℝ) ^ 24 ≤ PrimeGap186.trialIH ∧
  PrimeGap186.trialIH ≤ (23685317890 : ℝ) / (10 : ℝ) ^ 24 ∧
  (90248755123 : ℝ) / (10 : ℝ) ^ 24 ≤ PrimeGap186.trialJLambdaH

namespace PrimeGap186

/--
The explicit 40-element set of even shifts from `0` through `186` used in the bounded-gap
construction.
-/
def admissibleTuple : Finset ℕ :=
  {0, 2, 6, 12, 20, 26, 30, 32, 36, 42, 48, 50, 56, 60, 68, 72, 78, 86, 90, 92,
    98, 102, 110, 116, 120, 126, 132, 138, 140, 146, 152, 156, 158, 162,
    168, 170, 176, 180, 182, 186}

theorem admissibleTuple_card : admissibleTuple.card = 40 := rfl

theorem admissibleTuple_diameter :
    admissibleTuple.max' (by decide) - admissibleTuple.min' (by decide) = 186 := by
  norm_num [admissibleTuple]

theorem admissibleTuple_admissible (p : ℕ) (hp : p.Prime) :
    ∃ a ∈ Finset.range p, a ∉ admissibleTuple.image (· % p) := by
  by_cases h : p < 41
  · have small : ∀ q ∈ Finset.range 41, q.Prime →
        ∃ a ∈ Finset.range q, a ∉ admissibleTuple.image (· % q) := by decide
    exact small p (Finset.mem_range.mpr h) hp
  · apply Finset.exists_mem_notMem_of_card_lt_card
    exact Finset.card_image_le.trans_lt
      (by simpa [admissibleTuple_card] using (show 40 < p by omega))

/--
The masses of a finite measure in the consecutive half-open bands `(a j, a (j + 1)]`, returned
as real numbers. No monotonicity of the supplied boundaries is built into this definition.
-/
noncomputable def fragmentBandMasses {m : ℕ}
    (a : Fin (m + 2) → ℝ) (c : FiniteMeasure ℝ) : Fin (m + 1) → ℝ :=
  fun j => ((c.restrict (Set.Ioc (a j.castSucc) (a j.succ))).mass : ℝ)

/--
The lower limit, in the extended real numbers, of consecutive prime gaps `p_(n+1) - p_n` as `n`
tends to infinity.
-/
noncomputable def primeGapLiminf : EReal :=
  Filter.liminf
    (fun n : ℕ =>
      (Nat.nth Nat.Prime (n + 1) : EReal) - (Nat.nth Nat.Prime n : EReal))
    Filter.atTop

/-- The outer share of mass `3u`, capped at `L`: `min (3u / 2) L`. -/
noncomputable def physicalOuterOwner (L : ℝ≥0) (u : ℝ≥0) : ℝ≥0 :=
  min ((3 / 2 : ℝ≥0) * u) L

/--
The complementary inner share of mass `3u`, equal to `3u / 2` plus its excess over `L`.
Subtraction in `ℝ≥0` truncates at zero.
-/
noncomputable def physicalInnerOwner (L : ℝ≥0) (u : ℝ≥0) : ℝ≥0 :=
  (3 / 2 : ℝ≥0) * u + ((3 / 2 : ℝ≥0) * u - L)

open Real Finset Filter Asymptotics Topology
open ArithmeticFunction hiding log
/-!
## Mertens estimates and harmonic configurations

Establish the normalizations and limiting measures for weighted prime-factor configurations.
-/

/--
The error `∑_{1 ≤ n ≤ t} Λ(n) / n - log t`, with the cutoff interpreted by the natural-number
floor of `t`.
-/
noncomputable def mangoldtLogError : ℝ → ℝ :=
  fun t : ℝ => (∑ n ∈ Finset.Ioc 0 ⌊t⌋₊,
    ArithmeticFunction.vonMangoldt n / (n : ℝ)) - Real.log t

/--
The error `∑_{p ≤ t} log p / p - log t`, summed over primes up to the natural-number floor of
`t`.
-/
noncomputable def primeLogError : ℝ → ℝ :=
  fun t : ℝ => (∑ p ∈ Nat.primesLE ⌊t⌋₊,
    Real.log p / (p : ℝ)) - Real.log t

/--
The constant in the second Mertens expansion for `Λ(n) / (n log n)`, defined by integrating the
first error against `1 / (t (log t)^2)` over `(2, ∞)` and adding the endpoint correction.
-/
noncomputable def mangoldtMertensConstant : ℝ :=
  (∫ t in Set.Ioi (2 : ℝ), mangoldtLogError t /
    (t * (Real.log t) ^ 2) ∂MeasureTheory.volume) + 1 - Real.log (Real.log 2)

/--
The prime reciprocal-sum constant, defined by integrating the prime logarithmic error against `1
/ (t (log t)^2)` over `(2, ∞)` and adding the endpoint correction.
-/
noncomputable def primeMertensConstant : ℝ :=
  (∫ t in Set.Ioi (2 : ℝ), primeLogError t /
    (t * (Real.log t) ^ 2) ∂MeasureTheory.volume) + 1 - Real.log (Real.log 2)

/--
The remainder after subtracting `log (log t)` and the Mertens constant from `∑_{1 ≤ n ≤ t} Λ(n)
/ (n log n)`. The `n = 1` term is interpreted using totalized real division.
-/
noncomputable def mangoldtSecondError : ℝ → ℝ :=
  fun t : ℝ => (∑ n ∈ Finset.Ioc 0 ⌊t⌋₊,
    ArithmeticFunction.vonMangoldt n / ((n : ℝ) * Real.log n)) -
      Real.log (Real.log t) - mangoldtMertensConstant

/--
The remainder after subtracting `log (log t)` and the prime Mertens constant from the sum of
reciprocals of primes at most `t`.
-/
noncomputable def primeSecondError : ℝ → ℝ :=
  fun t : ℝ => (∑ p ∈ Nat.primesLE ⌊t⌋₊, (p : ℝ)⁻¹) -
    Real.log (Real.log t) - primeMertensConstant

@[fun_prop]
theorem measurable_mangoldt_log_error : Measurable mangoldtLogError := by
  unfold mangoldtLogError
  fun_prop

@[fun_prop]
theorem measurable_prime_log_error : Measurable primeLogError := by
  unfold primeLogError
  fun_prop

@[fun_prop]
theorem measurable_mangoldt_second_error : Measurable mangoldtSecondError := by
  unfold mangoldtSecondError
  fun_prop

theorem sum_Ioc_one_eq_sum_Ioc_zero {f : ℕ → ℝ} {x : ℕ} (hx : 1 ≤ x) (hf : f 1 = 0) :
    ∑ n ∈ Ioc 1 x, f n = ∑ n ∈ Ioc 0 x, f n := by
  simpa [← Icc_add_one_left_eq_Ioc 0, ← add_sum_Ioc_eq_sum_Icc hx]

theorem sum_log_le {x : ℝ} (hx : 1 ≤ x) :
    ∑ n ∈ Ioc 0 ⌊x⌋₊, log n ≤ x * log x := by
  calc
  _ ≤ ∑ n ∈ Ioc 0 ⌊x⌋₊, log x := by
    gcongr with n hn
    · exact_mod_cast (mem_Ioc.mp hn).1
    · exact (Nat.le_floor_iff (by linarith)).mp (mem_Ioc.mp hn).2
  _ = ⌊x⌋₊ * log x := by simp
  _ ≤ _ := by
    gcongr
    · exact log_nonneg hx
    · exact Nat.floor_le (by linarith)

theorem integral_log_le {a b : ℝ} (ha : 1 ≤ a) (hab : a ≤ b) :
    ∫ t in a..b, log t ≤ log b * (b - a) := by
  simpa [mul_comm] using
    intervalIntegral.integral_mono_on hab intervalIntegral.intervalIntegrable_log'
      (intervalIntegrable_const (c := log b))
      (fun t ht => log_le_log (by linarith [ht.1]) ht.2)

theorem sum_log_ge {x : ℝ} (hx : 1 ≤ x) :
    ∑ n ∈ Ioc 0 ⌊x⌋₊, log n ≥ x * log x - 2 * x := by
  have one_le_floor : 1 ≤ ⌊x⌋₊ := by simpa
  calc
  _ = ∑ n ∈ Ico (1 + 1) (⌊x⌋₊ + 1), log n := by
    rw [← sum_Ioc_one_eq_sum_Ioc_zero one_le_floor (by simp)]
    rfl
  _ = ∑ n ∈ Ico 1 ⌊x⌋₊, log ((n + 1 : ℕ)) := by
    rw [← sum_Ico_add']
  _ ≥ ∫ t in 1..⌊x⌋₊, log t := by
    convert MonotoneOn.integral_le_sum_Ico one_le_floor ?_|>.ge
    · norm_cast
    · exact strictMonoOn_log.monotoneOn.mono (by grind)
  _ = (∫ t in 1..x, log t) - ∫ t in ⌊x⌋₊..x, log t := eq_sub_of_add_eq
      (intervalIntegral.integral_add_adjacent_intervals
        intervalIntegral.intervalIntegrable_log' intervalIntegral.intervalIntegrable_log')
  _ ≥ (∫ t in 1..x, log t) - log x := by
    gcongr
    grw [integral_log_le (by simpa) (Nat.floor_le (by linarith))]
    nth_rw 2 [← mul_one (log x)]
    gcongr
    · exact log_nonneg hx
    · linarith [Nat.lt_floor_add_one x]
  _ ≥ x * log x - x - log x := by simp only [integral_log, log_one, mul_zero, sub_zero, ge_iff_le,
    tsub_le_iff_right, sub_add_cancel, le_add_iff_nonneg_right, zero_le_one]
  _ ≥ _ := by linarith [log_le_self (by linarith : 0 ≤ x)]

theorem sum_log_eq_sum_mangoldt {x : ℝ} :
    ∑ n ∈ Ioc 0 ⌊x⌋₊, log n = ∑ d ∈ Ioc 0 ⌊x⌋₊, Λ d * ⌊x / d⌋₊ := by
  simpa [← Nat.floor_div_natCast] using
    sum_Ioc_mul_zeta_eq_sum Λ ⌊x⌋₊

theorem sum_mangoldt_div_eq (x : ℝ) : ∑ d ∈ Ioc 0 ⌊x⌋₊, (Λ d) / d = log x +
  mangoldtLogError x := eq_add_of_sub_eq' rfl

theorem mangoldt_log_error_ge {x : ℝ} (hx : 1 ≤ x) :
    mangoldtLogError x  ≥ -2 := by
  unfold mangoldtLogError
  suffices x * ∑ d ∈ Ioc 0 ⌊x⌋₊, Λ d / d  ≥ x * (log x - 2) by
    nlinarith
  calc
  _ = ∑ d ∈ Ioc 0 ⌊x⌋₊, Λ d * (x / d) := by
    rw [Finset.mul_sum]
    ring_nf
  _ ≥ ∑ d ∈ Ioc 0 ⌊x⌋₊, Λ d * ⌊x / d⌋₊ := by
    gcongr
    exact Nat.floor_le <| div_nonneg (by linarith) (by linarith)
  _ ≥ x * log x - 2 * x :=
    sum_log_eq_sum_mangoldt ▸ sum_log_ge hx
  _ = _ := by ring

theorem mangoldt_log_error_le {x : ℝ} (hx : 1 ≤ x) :
    mangoldtLogError x ≤ log 4 + 4 := by
  unfold mangoldtLogError
  suffices x * ∑ d ∈ Ioc 0 ⌊x⌋₊, Λ d / d ≤ x * (log x + log 4 + 4) by
    nlinarith
  calc
  _ = ∑ d ∈ Ioc 0 ⌊x⌋₊, Λ d * (x / d) := by
    rw [Finset.mul_sum]
    ring_nf
  _ ≤ ∑ d ∈ Ioc 0 ⌊x⌋₊, Λ d * (⌊x / d⌋₊ + 1) := by
    gcongr
    exact Nat.lt_floor_add_one _|>.le
  _ = (∑ d ∈ Ioc 0 ⌊x⌋₊, log d) + ∑ d ∈ Ioc 0 ⌊x⌋₊, Λ d := by
    simp_rw [mul_add, mul_one]
    rw [Finset.sum_add_distrib, sum_log_eq_sum_mangoldt]
  _ ≤ x * log x + (log 4 + 4) * x := by
    gcongr
    · exact sum_log_le hx
    · exact Chebyshev.psi_le_const_mul_self (by linarith)
  _ = _ := by ring

theorem sum_mangoldt_div_eq_log {x : ℝ} (hx : 1 ≤ x) :
    |∑ d ∈ Ioc 0 ⌊x⌋₊, (Λ d) / d - log x| ≤ log 4 + 4 := by
  refine abs_le.mpr ⟨?_, mangoldt_log_error_le hx⟩
  exact le_trans (by linarith [show 0 ≤ log 4 by positivity]) (mangoldt_log_error_ge hx)

theorem sum_log_prime_div_eq (x : ℝ) : ∑ p ∈ Ioc 0 ⌊x⌋₊ with p.Prime, (log p) / p
  = log x + primeLogError x := by
  simp [primeLogError, Nat.primesLE_eq_filter_Ioc_zero]

theorem prime_log_error_bounded :
    ∃ C : ℝ, 0 < C ∧ ∀ x : ℝ, 1 ≤ x → |primeLogError x| ≤ C := by
  let f : ℕ → ℝ := fun n =>
    (if n.Prime then 0 else ArithmeticFunction.vonMangoldt n) / (n : ℝ)
  have hf : Summable f := by
    simpa [f, ArithmeticFunction.vonMangoldt.residueClass, Set.indicator,
      ZMod.natCast_eq_zero_iff] using
      (ArithmeticFunction.vonMangoldt.summable_residueClass_non_primes_div (0 : ZMod 1))
  have hf0 (n : ℕ) : 0 ≤ f n := by
    dsimp [f]
    positivity
  have hS : 0 ≤ ∑' n, f n := tsum_nonneg hf0
  refine ⟨log 4 + 4 + ∑' n, f n, by positivity, fun x hx => ?_⟩
  have hsplit : (∑ n ∈ Ioc 0 ⌊x⌋₊, Λ n / n) =
      (∑ p ∈ Nat.primesLE ⌊x⌋₊, log p / p) + ∑ n ∈ Ioc 0 ⌊x⌋₊, f n := by
    rw [Nat.primesLE_eq_filter_Ioc_zero, sum_filter, ← sum_add_distrib]
    apply sum_congr rfl
    intro n _
    dsimp [f]
    split_ifs with hn
    · simp [vonMangoldt_apply_prime hn]
    · simp
  have heq : primeLogError x = mangoldtLogError x - ∑ n ∈ Ioc 0 ⌊x⌋₊, f n := by
    unfold primeLogError mangoldtLogError
    linarith [hsplit]
  rw [heq]
  calc
    _ ≤ |mangoldtLogError x| + |∑ n ∈ Ioc 0 ⌊x⌋₊, f n| := abs_sub _ _
    _ ≤ _ := by
      rw [abs_of_nonneg (sum_nonneg fun n _ => hf0 n)]
      exact add_le_add (sum_mangoldt_div_eq_log hx)
        (hf.sum_le_tsum _ fun n _ => hf0 n)

theorem sum_Ioc_one_eq_sum_Icc_zero {f : ℕ → ℝ} {x : ℕ} (hx : 1 ≤ x) (hf1 : f 1 = 0)
  (hf0 : f 0 = 0) :
    ∑ n ∈ Ioc 1 x, f n = ∑ n ∈ Icc 0 x, f n := by
  simp [← add_sum_Ioc_eq_sum_Icc, hf0, sum_Ioc_one_eq_sum_Ioc_zero hx hf1]

theorem sum_div_log_eq {x : ℝ} (hx : 2 ≤ x) (f : ℕ → ℝ) :
    ∑ n ∈ Ioc 1 ⌊x⌋₊, f n / log n =
      (∑ n ∈ Ioc 1 ⌊x⌋₊, f n) / log x + ∫ t in 2..x, (∑ n ∈ Ioc 1 ⌊t⌋₊, f n) / (t * log
        t ^ 2) := by
  let g : ℕ → ℝ := (fun n ↦ if n < 2 then 0 else f n)
  trans ∑ n ∈ Icc 0 ⌊x⌋₊, (log n)⁻¹ * g n
  · rw [← sum_Ioc_one_eq_sum_Icc_zero (Nat.le_floor (by grind)) (by simp) (by simp)]
    refine sum_congr rfl fun n hn ↦ ?_
    simp [g, show ¬n ≤ 1 by grind, div_eq_inv_mul]
  rw [sum_mul_eq_sub_integral_mul₁ g (f := (fun n ↦ (log n)⁻¹)) (by simp [g]) (by simp [g])]
  · rw [intervalIntegral.integral_of_le hx, mul_comm, ← div_eq_mul_inv, ← sub_neg_eq_add]
    simp_rw [deriv_inv_log]
    congr 1
    · rw [← sum_Ioc_one_eq_sum_Icc_zero (Nat.le_floor (by grind)) (by simp [g]) (by simp [g])]
      congr 1
      refine sum_congr rfl fun n hn ↦ ?_
      simp [g, show ¬n ≤ 1 by grind]
    · rw [← integral_neg]
      refine setIntegral_congr_fun measurableSet_Ioc fun t ht ↦ ?_
      simp only [Set.mem_Ioc] at ht
      rw [← sum_Ioc_one_eq_sum_Icc_zero (Nat.le_floor (by grind)) (by simp [g]) (by simp [g])]
      field_simp
      congr 2
      refine sum_congr rfl fun n hn ↦ ?_
      simp [g, show ¬n ≤ 1 by grind]
  · intro t ht
    exact differentiableAt_inv_log (by grind) (by grind) (by grind)
  · rw [deriv_inv_log]
    apply ContinuousOn.integrableOn_Icc
    have ht1 (t : ℝ) (ht : t ∈ Set.Icc 2 x) : 1 < t :=
      lt_of_lt_of_le (by norm_num : (1 : ℝ) < 2) ht.1
    have ht0 (t : ℝ) (ht : t ∈ Set.Icc 2 x) : t ≠ 0 :=
      (zero_lt_one.trans (ht1 t ht)).ne'
    exact ((continuousOn_id.inv₀ ht0).neg).div
      ((continuousOn_id.log ht0).pow 2)
      (fun t ht => pow_ne_zero 2 (log_pos (ht1 t ht)).ne')

theorem integrable_const_div_mul_log_sq {x : ℝ} (c : ℝ) (hx : 2 ≤ x) :
    IntegrableOn (fun t => c / (t * log t ^ 2)) (Set.Ioi x) := by
  simpa only [IntegrableOn, div_eq_mul_inv, mul_inv] using
    (integrableOn_inv_div_log_sq_Ioi (by linarith : 1 < x)).const_mul c

theorem integral_const_div_mul_log_sq {x : ℝ} (c : ℝ) (hx : 2 ≤ x) :
    (∫ t in Set.Ioi x, c / (t * log t ^ 2)) = c / log x := by
  simpa only [← integral_const_mul, div_eq_mul_inv, mul_inv] using
    congrArg (c * ·)
      (integral_inv_div_log_sq_Ioi (by linarith : 1 < x))

theorem integral_one_div_mul_log {x : ℝ} (hx : 2 ≤ x) :
    (∫ t in 2..x, 1 / (t * log t)) = log (log x) - log (log 2) := by
  simpa [div_mul_eq_div_div] using
    integral_inv_div_log (by norm_num : (1 : ℝ) < 2) (by linarith : 1 < x)

theorem integrable_mangoldt_log_error_kernel {x : ℝ} (hx : 2 ≤ x) :
    MeasureTheory.IntegrableOn (fun x ↦ mangoldtLogError x / (x * log x ^ 2)) (Set.Ioi x)
      MeasureTheory.volume := by
  apply Integrable.mono' (integrable_const_div_mul_log_sq (log 4 + 4) hx)
  · apply Measurable.aestronglyMeasurable
    fun_prop
  · filter_upwards [ae_restrict_mem measurableSet_Ioi] with t ht
    have ht0 : 0 ≤ t := by grind
    rw [Real.norm_eq_abs, abs_div,
      abs_of_nonneg (mul_nonneg ht0 (sq_nonneg _))]
    gcongr
    exact sum_mangoldt_div_eq_log (by grind)

theorem integrable_prime_log_error_kernel {x : ℝ} (hx : 2 ≤ x) :
    MeasureTheory.IntegrableOn (fun x ↦ primeLogError x / (x * log x ^ 2)) (Set.Ioi x)
      MeasureTheory.volume := by
  obtain ⟨c, hc1, hc2⟩ := prime_log_error_bounded
  apply Integrable.mono (integrable_const_div_mul_log_sq c hx)
  · apply Measurable.aestronglyMeasurable
    fun_prop
  · filter_upwards [ae_restrict_mem measurableSet_Ioi] with t ht
    simp only [Set.mem_Ioi] at ht
    simp only [norm_div, norm_eq_abs, abs_of_pos hc1]
    gcongr
    exact hc2 t (by linarith)

theorem intervalIntegrable_one_div_mul_log {x : ℝ} (hx : 2 ≤ x) :
    IntervalIntegrable (fun t ↦ 1 / (t * log t)) MeasureTheory.volume 2 x := by
  apply ContinuousOn.intervalIntegrable
  fun_prop (disch := simp_all; grind)

theorem mangoldt_second_error_eq {x : ℝ} (hx : 2 ≤ x) :
    mangoldtSecondError x = mangoldtLogError x / log x - ∫ t in Set.Ioi x, mangoldtLogError
      t / (t * log t ^ 2) := by
  unfold mangoldtSecondError
  rw [← sum_Ioc_one_eq_sum_Ioc_zero (Nat.le_floor (by grind)) (by simp)]
  conv_lhs => simp only [div_mul_eq_div_div]
  rw [sum_div_log_eq hx]
  rw [sum_Ioc_one_eq_sum_Ioc_zero (Nat.le_floor (by grind)) (by simp), sum_mangoldt_div_eq]
  have : ∫ t in 2..x, (∑ n ∈ Ioc 1 ⌊t⌋₊, Λ n / n) / (t * log t ^ 2) = ∫ t in 2..x, (1 / (t *
    log t) + mangoldtLogError t / (t * log t ^ 2)) := by
    refine intervalIntegral.integral_congr fun t ht ↦ ?_
    rw [Set.uIcc_of_le hx, Set.mem_Icc] at ht
    rw [sum_Ioc_one_eq_sum_Ioc_zero (Nat.le_floor (by grind)) (by simp), sum_mangoldt_div_eq]
    field
  rw [this, intervalIntegral.integral_add]
  · rw [integral_one_div_mul_log hx, add_div, div_self (by simp; grind)]
    unfold mangoldtMertensConstant
    rw [← intervalIntegral.integral_Ioi_sub_Ioi
      (integrable_mangoldt_log_error_kernel (by rfl)) hx]
    ring
  · exact intervalIntegrable_one_div_mul_log hx
  · rw [intervalIntegrable_iff_integrableOn_Ioc_of_le hx]
    exact integrable_mangoldt_log_error_kernel (x := 2) (by rfl)|>.mono_set Set.Ioc_subset_Ioi_self

theorem mangoldt_second_error_abs_le {x : ℝ} (hx : 2 ≤ x) :
    |mangoldtSecondError x| ≤ (log 4 + 6) / log x := by
  rw [mangoldt_second_error_eq hx, ← integral_const_div_mul_log_sq (mangoldtLogError x) hx,
    ← integral_sub (integrable_const_div_mul_log_sq (mangoldtLogError x) hx)
      (integrable_mangoldt_log_error_kernel hx),
    ← integral_const_div_mul_log_sq (log 4 + 6) hx, ← norm_eq_abs]
  apply norm_integral_le_of_norm_le (integrable_const_div_mul_log_sq (log 4 + 6) hx)
  filter_upwards [ae_restrict_mem measurableSet_Ioi] with t ht
  have ht0 : 0 ≤ t := by grind
  rw [← sub_div, Real.norm_eq_abs, abs_div,
    abs_of_nonneg (mul_nonneg ht0 (sq_nonneg _))]
  gcongr
  have hx1 : 1 ≤ x := by linarith
  have ht1 : 1 ≤ t := by grind
  rw [abs_le]
  constructor <;> linarith [mangoldt_log_error_ge hx1, mangoldt_log_error_le hx1,
    mangoldt_log_error_ge ht1, mangoldt_log_error_le ht1]

theorem mangoldt_second_error_littleO :
    mangoldtSecondError =o[atTop] (fun _ ↦ (1 : ℝ)) := by
  rw [isLittleO_one_iff]
  apply squeeze_zero_norm'
  · filter_upwards [eventually_ge_atTop 2] with x hx
    exact mangoldt_second_error_abs_le hx
  · exact tendsto_const_nhds.div_atTop tendsto_log_atTop

theorem prime_second_error_eq {x : ℝ} (hx : 2 ≤ x) :
    primeSecondError x = primeLogError x / log x - ∫ t in Set.Ioi x, primeLogError t / (t *
      log t ^ 2) := by
  unfold primeSecondError
  rw [Nat.primesLE_eq_filter_Ioc_zero]
  simp only [← one_div]
  rw [sum_filter, ← sum_Ioc_one_eq_sum_Ioc_zero (Nat.le_floor (by grind)) (by simp
    [Nat.not_prime_one])]
  have (n : ℕ) : (if n.Prime then (1 : ℝ) / n else 0) = (if n.Prime then log n / n
    else 0) / log n := by
    split_ifs with h
    · have : log n ≠ 0 := by simp; grind [h.two_le]
      field
    · simp
  simp_rw [this]
  rw [sum_div_log_eq hx, sum_Ioc_one_eq_sum_Ioc_zero (Nat.le_floor (by grind)) (by simp), ←
    sum_filter, sum_log_prime_div_eq]
  have : ∫ t in 2..x, (∑ n ∈ Ioc 1 ⌊t⌋₊, if n.Prime then log ↑n / ↑n else 0) / (t * log
    t ^ 2) = ∫ t in 2..x, (1 / (t * log t) + primeLogError t / (t * log t ^ 2)) := by
    refine intervalIntegral.integral_congr fun t ht ↦ ?_
    rw [Set.uIcc_of_le hx, Set.mem_Icc] at ht
    rw [sum_Ioc_one_eq_sum_Ioc_zero (Nat.le_floor (by grind)) (by simp), ← sum_filter,
      sum_log_prime_div_eq]
    field
  rw [this, intervalIntegral.integral_add]
  · rw [integral_one_div_mul_log hx, add_div, div_self (by simp; grind)]
    unfold primeMertensConstant
    rw [← intervalIntegral.integral_Ioi_sub_Ioi
      (integrable_prime_log_error_kernel (by rfl)) hx]
    ring
  · exact intervalIntegrable_one_div_mul_log hx
  · rw [intervalIntegrable_iff_integrableOn_Ioc_of_le hx]
    exact integrable_prime_log_error_kernel (x := 2) (by rfl)|>.mono_set (by grind)

theorem prime_second_error_bounded :
    ∃ C : ℝ, 0 < C ∧ ∀ x : ℝ, 2 ≤ x → |primeSecondError x| ≤ C / log x := by
  obtain ⟨C, hC, hb⟩ := prime_log_error_bounded
  refine ⟨2 * C, by positivity, fun x hx => ?_⟩
  rw [prime_second_error_eq hx, ← integral_const_div_mul_log_sq (primeLogError x) hx,
    ← integral_sub (integrable_const_div_mul_log_sq (primeLogError x) hx)
      (integrable_prime_log_error_kernel hx),
    ← integral_const_div_mul_log_sq (2 * C) hx, ← norm_eq_abs]
  apply norm_integral_le_of_norm_le (integrable_const_div_mul_log_sq (2 * C) hx)
  filter_upwards [ae_restrict_mem measurableSet_Ioi] with t ht
  have ht0 : 0 ≤ t := by grind
  rw [← sub_div, Real.norm_eq_abs, abs_div,
    abs_of_nonneg (mul_nonneg ht0 (sq_nonneg _))]
  gcongr
  refine (abs_sub _ _).trans ?_
  linarith [hb x (by linarith), hb t (by grind)]

theorem prime_second_error_tendsto :
    Tendsto primeSecondError atTop (nhds 0) := by
  obtain ⟨C, _, hb⟩ := prime_second_error_bounded
  apply squeeze_zero_norm'
  · filter_upwards [eventually_ge_atTop 2] with x hx
    exact hb x hx
  · exact tendsto_const_nhds.div_atTop tendsto_log_atTop

theorem integral_log_mul_exp_neg_eq_deriv_Gamma :
    (∫ t in Set.Ioi (0 : ℝ), Real.log t * Real.exp (-t)) = deriv Real.Gamma 1 := by
  have h := Complex.hasDerivAt_GammaIntegral (s := (1 : ℂ)) (by norm_num)
  simp only [sub_self, Complex.cpow_zero, one_mul, ← Complex.ofReal_mul,
    _root_.integral_complex_ofReal] at h
  have hΓ := h.congr_of_eventuallyEq (f₁ := Complex.Gamma) (by
    filter_upwards [(isOpen_lt continuous_const Complex.continuous_re).mem_nhds
      (show (0 : ℝ) < (1 : ℂ).re by norm_num)] with z hz
    exact Complex.Gamma_eq_integral hz)
  rw [Real.hasDerivAt_Gamma_one.deriv]
  exact_mod_cast (hΓ.unique Complex.hasDerivAt_Gamma_one)

theorem integrableOn_log_mul_exp_neg :
    IntegrableOn (fun t : ℝ => Real.log t * Real.exp (-t)) (Set.Ioi 0) := by
  apply MeasureTheory.Integrable.of_integral_ne_zero
  rw [integral_log_mul_exp_neg_eq_deriv_Gamma, Real.hasDerivAt_Gamma_one.deriv]
  linarith [Real.one_half_lt_eulerMascheroniConstant]

theorem log_log_mellin (s : ℝ) (hs : 1 < s) :
    IntegrableOn (fun x : ℝ => Real.log (Real.log x) * x ^ (-s)) (Set.Ioi 1) ∧
      (s - 1) * (∫ x in Set.Ioi 1, Real.log (Real.log x) * x ^ (-s)) =
        -Real.log (s - 1) + deriv Real.Gamma 1 := by
  let a : ℝ := s - 1
  have ha : 0 < a := sub_pos.mpr hs
  let g : ℝ → ℝ := fun t => (Real.log t - Real.log a) * Real.exp (-t)
  have hg : IntegrableOn g (Set.Ioi 0) := by
    simpa only [IntegrableOn, g, sub_mul] using
      integrableOn_log_mul_exp_neg.sub'
        ((integrableOn_exp_neg_Ioi 0).const_mul (Real.log a))
  have hscale :=
    (MeasureTheory.integrableOn_Ioi_comp_mul_left_iff g 0 ha).mpr (by simpa using hg)
  have hpull := (MeasureTheory.integrableOn_comp_log_Ioi
    (fun t => g (a * t)) (a := 1) zero_lt_one).mpr (by simpa using hscale)
  have hpt : Set.EqOn (fun x : ℝ => x⁻¹ • g (a * Real.log x))
      (fun x => Real.log (Real.log x) * x ^ (-s)) (Set.Ioi 1) := by
    intro x hx
    have hx0 : 0 < x := lt_trans zero_lt_one hx
    change x⁻¹ * ((Real.log (a * Real.log x) - Real.log a) *
      Real.exp (-(a * Real.log x))) = Real.log (Real.log x) * x ^ (-s)
    rw [Real.log_mul ha.ne' (Real.log_pos hx).ne', add_sub_cancel_left, ← neg_mul,
      mul_comm (-a), ← Real.rpow_def_of_pos hx0,
      show -a = -s + 1 by dsimp [a]; ring, Real.rpow_add_one hx0.ne']
    field_simp
  have hchange : (∫ x in Set.Ioi 1, Real.log (Real.log x) * x ^ (-s)) =
      ∫ t in Set.Ioi 0, g (a * t) := by
    rw [← MeasureTheory.setIntegral_congr_fun measurableSet_Ioi hpt]
    simpa only [Real.log_one] using MeasureTheory.integral_comp_log_Ioi
      (fun t => g (a * t)) (a := 1) zero_lt_one
  have hvalue : (∫ t in Set.Ioi 0, g t) = -Real.log a + deriv Real.Gamma 1 := by
    simp only [g, sub_mul]
    rw [MeasureTheory.integral_sub integrableOn_log_mul_exp_neg
      ((integrableOn_exp_neg_Ioi 0).const_mul (Real.log a)),
      integral_log_mul_exp_neg_eq_deriv_Gamma, MeasureTheory.integral_const_mul,
      integral_exp_neg_Ioi_zero, mul_one]
    ring
  refine ⟨hpull.congr_fun hpt measurableSet_Ioi, ?_⟩
  change a * (∫ x in Set.Ioi 1, Real.log (Real.log x) * x ^ (-s)) =
    -Real.log a + deriv Real.Gamma 1
  rw [hchange, ← hvalue]
  simpa only [smul_eq_mul, mul_zero] using
    MeasureTheory.integral_comp_mul_left_Ioi' g 0 ha

theorem log_zeta_eq_mellin (s : ℝ) (hs : 1 < s) :
    Real.log (riemannZeta (s : ℂ)).re =
      (s - 1) * ∫ x in Set.Ioi 1,
        (Real.log (Real.log x) + mangoldtMertensConstant + mangoldtSecondError x) *
          x ^ (-s) := by
  let c : ℕ → ℝ := fun n =>
    ArithmeticFunction.vonMangoldt n / ((n : ℝ) * Real.log n)
  let a : ℝ := (s - 1) / 2
  have ha : 0 < a := by dsimp [a]; linarith
  have hc (n : ℕ) : 0 ≤ c n :=
    div_nonneg ArithmeticFunction.vonMangoldt_nonneg
      (mul_nonneg (Nat.cast_nonneg n) (Real.log_natCast_nonneg n))
  have hc_le (n : ℕ) : c n ≤ (n : ℝ)⁻¹ := by
    simpa [c, div_eq_mul_inv, mul_comm, mul_left_comm, mul_assoc] using
      mul_le_mul_of_nonneg_right
        (div_le_one_of_le₀ ArithmeticFunction.vonMangoldt_le_log
          (Real.log_natCast_nonneg n)) (inv_nonneg.mpr (Nat.cast_nonneg n))
  have hsum (n : ℕ) : (∑ k ∈ Finset.Icc 1 n, c k) ≤ (harmonic n : ℝ) := by
    simpa only [harmonic_eq_sum_Icc, Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast] using
      Finset.sum_le_sum (fun k (_ : k ∈ Finset.Icc 1 n) => hc_le k)
  have hO : (fun n : ℕ => ∑ k ∈ Finset.Icc 1 n, c k) =O[atTop]
      (fun n => (n : ℝ) ^ a) := by
    refine (Asymptotics.IsBigO.of_norm_le (fun n : ℕ => ?_)).trans
      (((Real.isLittleO_const_log_atTop (c := 1)).isBigO.add
        (Asymptotics.isBigO_refl Real.log atTop)).trans
        (isLittleO_log_rpow_atTop ha).isBigO |>.comp_tendsto
          tendsto_natCast_atTop_atTop)
    rw [norm_of_nonneg (Finset.sum_nonneg fun k _ => hc k)]
    exact (hsum n).trans (harmonic_le_one_add_log n)
  have hL := LSeries_eq_mul_integral_of_nonneg c ha.le
    (s := ((s - 1 : ℝ) : ℂ))
    (by simpa only [Complex.ofReal_re] using
      (show a < s - 1 by dsimp [a]; linarith)) hO hc
  have hprefix (x : ℝ) : (∑ k ∈ Finset.Icc 1 ⌊x⌋₊, c k) =
      Real.log (Real.log x) + mangoldtMertensConstant + mangoldtSecondError x := by
    simp only [c, mangoldtSecondError, ← Finset.Icc_add_one_left_eq_Ioc, Nat.zero_add]
    ring
  have hseries : LSeries (fun n => (c n : ℂ)) ((s - 1 : ℝ) : ℂ) =
      (Real.log (riemannZeta (s : ℂ)).re : ℂ) := by
    rw [LSeries_def₀ (by simp [c]), log_riemannZeta_eq hs, Complex.ofReal_tsum]
    apply tsum_congr
    intro n
    by_cases hn : n = 0
    · simp [hn, c]
    have hn0 : 0 < (n : ℝ) := Nat.cast_pos.mpr (Nat.pos_of_ne_zero hn)
    have hp : (n : ℂ) ^ ((s - 1 : ℝ) : ℂ) =
        (((n : ℝ) ^ (s - 1) : ℝ) : ℂ) := by
      simpa only [Complex.ofReal_natCast] using
        (Complex.ofReal_cpow (Nat.cast_nonneg n) (s - 1)).symm
    rw [hp, ← Complex.ofReal_div]
    congr 1
    dsimp [c]
    rw [div_div, Real.rpow_sub_one hn0.ne']
    congr 1
    field_simp
  have hexponent : -(((s - 1 : ℝ) : ℂ) + 1) = ((-s : ℝ) : ℂ) := by
    push_cast
    ring
  have hIntegral :
      (∫ x in Set.Ioi (1 : ℝ),
        (∑ k ∈ Finset.Icc 1 ⌊x⌋₊, (c k : ℂ)) *
          (x : ℂ) ^ (-(((s - 1 : ℝ) : ℂ) + 1))) =
      ((∫ x in Set.Ioi 1,
        (Real.log (Real.log x) + mangoldtMertensConstant + mangoldtSecondError x) *
          x ^ (-s) : ℝ) : ℂ) := by
    rw [← _root_.integral_complex_ofReal]
    apply MeasureTheory.setIntegral_congr_fun measurableSet_Ioi
    intro x hx
    dsimp only
    rw [hexponent, ← Complex.ofReal_cpow (lt_trans zero_lt_one hx).le (-s),
      ← Complex.ofReal_sum, ← Complex.ofReal_mul, hprefix x]
  rw [hseries, hIntegral] at hL
  simpa only [← Complex.ofReal_mul, Complex.ofReal_inj] using hL

theorem integrable_mangoldt_constant_rpow (s : ℝ) (hs : 1 < s) :
    MeasureTheory.IntegrableOn (fun x => mangoldtMertensConstant * x ^ (-s)) (Set.Ioi 1) :=
  (integrableOn_Ioi_rpow_of_lt (neg_lt_neg hs) one_pos).const_mul
    mangoldtMertensConstant

theorem integrable_mangoldt_second_error_rpow (s : ℝ) (hs : 1 < s) :
    MeasureTheory.IntegrableOn (fun x => mangoldtSecondError x * x ^ (-s)) (Set.Ioi 1) := by
  rw [← Set.Ioo_union_Ici_eq_Ioi (by norm_num : (1 : ℝ) < 2)]
  apply MeasureTheory.IntegrableOn.union
  · have hsub : Set.Ioo (1 : ℝ) 2 ⊆ Set.Ioi 1 := Set.Ioo_subset_Ioi_self
    apply (((log_log_mellin s hs).1.mono_set hsub).neg.sub
      ((integrable_mangoldt_constant_rpow s hs).mono_set hsub)).congr_fun _ measurableSet_Ioo
    intro x hx
    have hfloor : ⌊x⌋₊ = 1 := by
      exact Nat.floor_eq_on_Ico 1 x (by norm_num; exact ⟨hx.1.le, hx.2⟩)
    norm_num [mangoldtSecondError, hfloor, sub_mul]
  · rw [integrableOn_Ici_iff_integrableOn_Ioi]
    apply (integrableOn_Ioi_rpow_of_lt (neg_lt_neg hs)
      (by norm_num : (0 : ℝ) < 2)).bdd_mul
      (c := (log 4 + 6) / log 2)
      measurable_mangoldt_second_error.aestronglyMeasurable
    filter_upwards [ae_restrict_mem measurableSet_Ioi] with x hx
    rw [Real.norm_eq_abs]
    exact (mangoldt_second_error_abs_le hx.le).trans
      (div_le_div_of_nonneg_left (by positivity) (log_pos (by norm_num))
        (log_le_log (by norm_num) hx.le))

theorem integrable_mangoldt_second_error_Ioo {X : ℝ} (hX : 2 ≤ X) :
    IntegrableOn mangoldtSecondError (Set.Ioo 1 X) := by
  have hi := (integrable_mangoldt_second_error_rpow 2 (by norm_num)).mono_set
    (Set.Ioo_subset_Ioi_self (a := X))
  have hm := hi.bdd_mul (f := fun x : ℝ => x ^ (2 : ℕ)) (c := X ^ (2 : ℕ))
    (by fun_prop) (by
      filter_upwards [ae_restrict_mem measurableSet_Ioo] with x hx
      rw [Real.norm_eq_abs, abs_of_nonneg (sq_nonneg x)]
      nlinarith [hX, hx.1, hx.2])
  apply IntegrableOn.congr_fun hm _ measurableSet_Ioo
  intro x hx
  have hx0 := zero_lt_one.trans hx.1
  change x ^ (2 : ℕ) * (mangoldtSecondError x * x ^ (-(2 : ℝ))) = _
  rw [Real.rpow_neg hx0.le, Real.rpow_two]
  field_simp

theorem log_zeta_eq (s : ℝ) (hs : 1 < s) :
    log (riemannZeta (s : ℂ)).re = - log (s - 1) + deriv Gamma 1 + mangoldtMertensConstant +
      (s - 1) * ∫ x in Set.Ioi 1, mangoldtSecondError x * x ^ (-s) := by
  rcases log_log_mellin s hs with ⟨hi, hv⟩
  have hc := integrable_mangoldt_constant_rpow s hs
  rw [log_zeta_eq_mellin s hs]
  simp_rw [add_mul]
  rw [integral_add (f := fun x => log (log x) * x ^ (-s) +
      mangoldtMertensConstant * x ^ (-s)) (hi.add hc)
      (integrable_mangoldt_second_error_rpow s hs),
    integral_add hi hc, mul_add, mul_add, hv]
  rw [integral_const_mul mangoldtMertensConstant (· ^ (-s)),
    @integral_Ioi_rpow_of_lt (-s), one_rpow] <;> grind

theorem mangoldt_second_error_mellin_tendsto :
    Filter.Tendsto (fun s : ℝ => (s - 1) * ∫ x in Set.Ioi 1, mangoldtSecondError x * x ^ (-s))
      (nhdsWithin 1 (Set.Ioi 1)) (nhds 0) := by
  rw [Metric.tendsto_nhdsWithin_nhds]
  intro ε hε
  obtain ⟨X₀, hX₀⟩ : ∃ X, ∀ x ≥ X, |mangoldtSecondError x| ≤ ε / 2 := by
    have := mangoldt_second_error_littleO.def (by positivity : (0 : ℝ) < ε / 2)
    simp only [Real.norm_eq_abs, abs_one, mul_one] at this
    rw [Filter.eventually_atTop] at this; exact this
  let X := max X₀ 2
  have hX2 : 2 ≤ X := le_max_right _ _
  have hXge : ∀ x ≥ X, |mangoldtSecondError x| ≤ ε / 2 := fun x hx => hX₀ x (le_trans
    (le_max_left _ _) hx)
  set B := ∫ x in Set.Ioo 1 X, |mangoldtSecondError x| with hBdef
  have hB0 : 0 ≤ B := integral_nonneg (fun _ => abs_nonneg _)
  refine ⟨ε / 2 / (B + 1), by positivity, ?_⟩
  intro s hs hdist
  simp only [Set.mem_Ioi] at hs
  rw [Real.dist_eq] at hdist
  have hs1 : s - 1 < ε / 2 / (B + 1) := (abs_lt.mp hdist).2
  have hsm1 : 0 < s - 1 := by linarith
  have hintAbs : IntegrableOn (fun x => |mangoldtSecondError x| * x ^ (-s)) (Set.Ioi 1) volume := by
    refine IntegrableOn.congr_fun (integrable_mangoldt_second_error_rpow s hs).abs ?_
      measurableSet_Ioi
    intro x hx
    simp only [abs_mul, abs_of_nonneg (Real.rpow_nonneg (zero_lt_one.trans hx).le _)]
  have hintAbsIoiX : IntegrableOn (fun x => |mangoldtSecondError x| * x ^ (-s)) (Set.Ioi X)
    volume :=
    hintAbs.mono_set (Set.Ioi_subset_Ioi (by linarith))
  have hsplit : ∫ x in Set.Ioi 1, |mangoldtSecondError x| * x ^ (-s) =
      (∫ x in Set.Ioc 1 X, |mangoldtSecondError x| * x ^ (-s)) + ∫ x in Set.Ioi X,
        |mangoldtSecondError x| * x ^ (-s) := by
    simpa only [intervalIntegral.integral_of_le (by linarith : (1 : ℝ) ≤ X)] using
      (intervalIntegral.integral_interval_add_Ioi hintAbs hintAbsIoiX).symm
  have hp1 : ∫ x in Set.Ioc 1 X, |mangoldtSecondError x| * x ^ (-s) ≤ B := by
    rw [hBdef, integral_Ioc_eq_integral_Ioo]
    apply setIntegral_mono_on (hintAbs.mono_set (Set.Ioo_subset_Ioi_self (a := X)))
      (integrable_mangoldt_second_error_Ioo hX2).abs measurableSet_Ioo
    intro x hx
    exact mul_le_of_le_one_right (abs_nonneg _)
      (Real.rpow_le_one_of_one_le_of_nonpos hx.1.le (by linarith))
  have hp2 : (s - 1) * ∫ x in Set.Ioi X, |mangoldtSecondError x| * x ^ (-s) ≤ ε / 2 := by
    have hi : IntegrableOn (fun x : ℝ => x ^ (-s)) (Set.Ioi 1) volume :=
      integrableOn_Ioi_rpow_of_lt (neg_lt_neg hs) one_pos
    have hsub : Set.Ioi X ⊆ Set.Ioi (1 : ℝ) := Set.Ioi_subset_Ioi (by linarith)
    calc
      _ ≤ (s - 1) * ((ε / 2) * ∫ x in Set.Ioi X, x ^ (-s)) := by
        apply mul_le_mul_of_nonneg_left _ hsm1.le
        rw [← integral_const_mul]
        apply setIntegral_mono_on hintAbsIoiX ((hi.mono_set hsub).const_mul (ε / 2))
          measurableSet_Ioi
        intro x hx
        exact mul_le_mul_of_nonneg_right (hXge x hx.le)
          (Real.rpow_nonneg ((zero_lt_two.trans_le hX2).trans hx).le _)
      _ ≤ (s - 1) * ((ε / 2) * ∫ x in Set.Ioi 1, x ^ (-s)) := by
        apply mul_le_mul_of_nonneg_left _ hsm1.le
        apply mul_le_mul_of_nonneg_left _ (by positivity)
        exact setIntegral_mono_set hi
          ((ae_restrict_mem measurableSet_Ioi).mono fun x hx =>
            Real.rpow_nonneg (zero_lt_one.trans hx).le _) hsub.eventuallyLE
      _ = ε / 2 := by
        rw [integral_Ioi_rpow_of_lt (neg_lt_neg hs) one_pos, one_rpow]
        field [show -s + 1 ≠ 0 by linarith]
  have hbound : (s - 1) * ∫ x in Set.Ioi 1, |mangoldtSecondError x| * x ^ (-s) ≤ (s - 1) * B
    + ε / 2 := by
    rw [hsplit, mul_add]
    exact add_le_add (mul_le_mul_of_nonneg_left hp1 hsm1.le) hp2
  have habs_le : |(s - 1) * ∫ x in Set.Ioi 1, mangoldtSecondError x * x ^ (-s)|
      ≤ (s - 1) * ∫ x in Set.Ioi 1, |mangoldtSecondError x| * x ^ (-s) := by
    rw [abs_mul, abs_of_pos hsm1]
    gcongr
    refine abs_integral_le_integral_abs.trans_eq ?_
    apply setIntegral_congr_fun measurableSet_Ioi
    intro x hx
    simp only [abs_mul, abs_of_nonneg (Real.rpow_nonneg (zero_lt_one.trans hx).le _)]
  rw [Real.dist_eq, sub_zero]
  apply (habs_le.trans hbound).trans_lt
  have h := (lt_div_iff₀ (by linarith : 0 < B + 1)).mp hs1
  nlinarith

theorem mangoldt_constant_eq_eulerMascheroni :
    mangoldtMertensConstant = eulerMascheroniConstant := by
  have h := ((isLittleO_one_iff ℝ).mp
    log_riemannZeta_add_log_sub_isLittleO_ofReal).sub
    mangoldt_second_error_mellin_tendsto
  have hc : Tendsto (fun _ : ℝ => deriv Gamma 1 + mangoldtMertensConstant)
      (nhdsWithin 1 (Set.Ioi 1)) (nhds (0 - 0)) := by
    apply h.congr'
    filter_upwards [self_mem_nhdsWithin] with s hs
    linarith [log_zeta_eq s hs]
  linarith [tendsto_nhds_unique hc tendsto_const_nhds,
    Real.eulerMascheroniConstant_eq_neg_deriv]

theorem hasSum_log_one_sub_one_div_prime {p : ℕ} (hp : p.Prime) :
    HasSum (fun n : ℕ ↦ (-1 : ℝ) / ((n + 1) * p ^ (n + 1)))
      (log (1 - 1 / p)) := by
  simpa [div_eq_mul_inv, mul_comm] using
    (Real.hasSum_pow_div_log_of_abs_lt_one (x := (p : ℝ)⁻¹)
      (by simpa using inv_lt_one_of_one_lt₀ (mod_cast hp.one_lt))).neg

theorem prime_constant_eq_correction :
    primeMertensConstant = mangoldtMertensConstant +
      ∑' p : ℕ, if p.Prime then log (1 - 1 / p) + 1 / p else 0 := by
  let f (n : ℕ) : ℝ := if ¬n.Prime then Λ n / (n * log n) else 0
  have heq (x : ℝ) :
      mangoldtSecondError x - primeSecondError x =
        ∑ n ∈ Ioc 0 ⌊x⌋₊, f n - (mangoldtMertensConstant - primeMertensConstant) := by
    calc
      _ = ∑ n ∈ Ioc 0 ⌊x⌋₊, Λ n / (n * log n) -
          ∑ p ∈ Ioc 0 ⌊x⌋₊ with p.Prime, (1 : ℝ) / p -
          (mangoldtMertensConstant - primeMertensConstant) := by
        unfold mangoldtSecondError primeSecondError
        rw [Nat.primesLE_eq_filter_Ioc_zero]
        simp only [one_div]
        ring
      _ = _ := by
        rw [sum_filter, ← sum_sub_distrib]
        congr 1
        apply sum_congr rfl
        intro n _
        dsimp [f]
        split_ifs with hn
        · rw [vonMangoldt_apply_prime hn]
          have : log n ≠ 0 := by simp; grind [hn.two_le]
          field
        · ring
  have hlim : Tendsto (fun x : ℝ => ∑ n ∈ Ioc 0 ⌊x⌋₊, f n) atTop
      (nhds (mangoldtMertensConstant - primeMertensConstant)) := by
    apply tendsto_sub_nhds_zero_iff.mp
    have h := ((isLittleO_one_iff ℝ).mp mangoldt_second_error_littleO).sub
      prime_second_error_tendsto
    simpa only [sub_zero, heq] using h
  have hnat : Tendsto (fun N : ℕ => ∑ n ∈ range N, f n) atTop
      (nhds (mangoldtMertensConstant - primeMertensConstant)) := by
    apply (tendsto_add_atTop_iff_nat 1).mp
    convert hlim.comp tendsto_natCast_atTop_atTop using 1
    funext N
    simp [Nat.range_succ_eq_Icc_zero, ← add_sum_Ioc_eq_sum_Icc (Nat.zero_le N), f]
  have hf : HasSum f (mangoldtMertensConstant - primeMertensConstant) := by
    apply (hasSum_iff_tendsto_nat_of_nonneg (fun n => ?_) _).mpr hnat
    dsimp [f]
    split_ifs <;> positivity
  have hprime : ∑' p : Nat.Primes, f p = 0 := by
    refine (tsum_congr (fun p => ?_)).trans tsum_zero
    simp [f, p.prop]
  have hsub (g : ℕ → ℝ) :
      ∑' p : Nat.Primes, g p = ∑' n : ℕ, if n.Prime then g n else 0 := by
    convert! _root_.tsum_subtype Nat.Prime g using 2
    ext
    simp [Set.indicator]
    congr
  have hcorr : -∑' n : ℕ, f n =
      ∑' p : ℕ, if p.Prime then log (1 - 1 / p) + 1 / p else 0 := by
    rw [tsum_eq_tsum_primes_add_tsum_primes_of_support_subset_prime_powers hf.summable
      (fun n hn => (by simp_all [f, vonMangoldt_ne_zero_iff])), hprime, zero_add,
      hsub (fun p => ∑' k : ℕ, f (p ^ (k + 2))), ← tsum_neg]
    apply tsum_congr
    intro n
    split_ifs with hn
    · rw [← (hasSum_log_one_sub_one_div_prime hn).tsum_eq,
        (hasSum_log_one_sub_one_div_prime hn).summable.tsum_eq_zero_add]
      simp only [Nat.cast_add,
        CharP.cast_eq_zero, zero_add, pow_one, one_mul, Nat.cast_one, one_div]
      trans -∑' k : ℕ, (1 : ℝ) / ((k + 2) * n ^ (k + 2))
      · apply congrArg Neg.neg
        apply tsum_congr
        intro k
        have hnp : ¬Nat.Prime (n ^ (k + 2)) := Nat.Prime.not_prime_pow (by grind)
        simp only [f, hnp, not_false_eq_true, ↓reduceIte, one_div, mul_inv_rev]
        rw [vonMangoldt_apply_pow (by grind), vonMangoldt_apply_prime hn]
        have : log n ≠ 0 := by simp; grind [hn.two_le]
        push_cast
        rw [log_pow]
        field_simp
        push_cast
        rfl
      · norm_num [← tsum_neg, add_assoc, neg_div]
    · ring
  rw [← hcorr, hf.tsum_eq]
  ring

theorem prime_correction_summable :
    Summable (fun p : ℕ => if p.Prime then log (1 - 1 / p) + 1 / p else (0 : ℝ)) := by
  apply Summable.of_norm_bounded (g := fun n : ℕ => (2 : ℝ) / n ^ 2)
    (Summable.const_div (by simp) _)
  intro n
  rw [Real.norm_eq_abs]
  split_ifs with h
  · trans 1 / n ^ 2 / (1 - 1 / n)
    · convert abs_log_sub_add_sum_range_le (x := 1 / n) _ 1 using 1
      · rw [add_comm]
        simp
      · rw [abs_of_nonneg (by simp)]
        ring
      · simpa using inv_lt_one_of_one_lt₀ (mod_cast h.one_lt)
    rw [(by ring : (2 : ℝ) / n ^ 2 = 1 / n ^ 2 / (1 / 2))]
    gcongr
    suffices (1 : ℝ) / n ≤ 1 / 2 by linarith
    gcongr
    exact_mod_cast h.two_le
  · rw [abs_zero]
    positivity

end PrimeGap186

section
open Real Finset Filter Asymptotics Topology
open ArithmeticFunction hiding log

theorem PrimeGap186.exists_prime_log_harmonic_bounded_error :
    ∃ C : ℝ, 0 < C ∧ ∀ t : ℝ, 1 ≤ t →
      |(∑ p ∈ Nat.primesLE ⌊t⌋₊, Real.log p / (p : ℝ)) -
          Real.log t| ≤ C :=
  PrimeGap186.prime_log_error_bounded

theorem PrimeGap186.prime_mertens_product_tendsto :
    Filter.Tendsto
      (fun t : ℝ => Real.log t *
        ∏ p ∈ Nat.primesLE ⌊t⌋₊, (1 - (p : ℝ)⁻¹))
      Filter.atTop (nhds (Real.exp (-Real.eulerMascheroniConstant))) := by
  let f : ℕ → ℝ := fun p => if p.Prime then log (1 - 1 / p) + 1 / p else 0
  have hf : Summable f := PrimeGap186.prime_correction_summable
  have htsum : ∑' n : ℕ, f n =
      PrimeGap186.primeMertensConstant - PrimeGap186.mangoldtMertensConstant := by
    have h := PrimeGap186.prime_constant_eq_correction
    dsimp [f]
    linarith
  have hfinite : Tendsto
      (fun x : ℝ => ∑ p ∈ Nat.primesLE ⌊x⌋₊, (log (1 - 1 / p) + 1 / p))
      atTop (nhds (PrimeGap186.primeMertensConstant - PrimeGap186.mangoldtMertensConstant)) := by
    have h := hf.hasSum.tendsto_sum_nat.comp
      ((tendsto_add_atTop_nat 1).comp (tendsto_nat_floor_atTop (α := ℝ)))
    rw [htsum] at h
    simpa [Function.comp_def, Nat.primesLE_eq_filter_range, sum_filter, f] using h
  have hlog : Tendsto
      (fun x : ℝ => (∑ p ∈ Nat.primesLE ⌊x⌋₊, log (1 - 1 / p)) + log (log x))
      atTop (nhds (-eulerMascheroniConstant)) := by
    have h := (hfinite.sub PrimeGap186.prime_second_error_tendsto).sub_const
      PrimeGap186.primeMertensConstant
    convert h using 1
    · funext x
      dsimp [PrimeGap186.primeSecondError]
      rw [sum_add_distrib]
      simp only [one_div]
      ring
    · rw [PrimeGap186.mangoldt_constant_eq_eulerMascheroni]
      congr 1
      ring
  apply hlog.rexp.congr'
  filter_upwards [eventually_gt_atTop (1 : ℝ)] with x hx
  rw [exp_add, exp_sum, exp_log (log_pos hx),
    prod_congr rfl fun p hp => exp_log (by
      rw [sub_pos, one_div]
      exact inv_lt_one_of_one_lt₀ (by exact_mod_cast Nat.one_lt_of_mem_primesLE hp))]
  simp only [one_div]
  ring

theorem PrimeGap186.exists_prime_reciprocal_loglog_constant :
    ∃ M C : ℝ, 0 < C ∧ ∀ t : ℝ, 2 ≤ t →
      |(∑ p ∈ Nat.primesLE ⌊t⌋₊, (p : ℝ)⁻¹) -
          Real.log (Real.log t) - M| ≤ C / Real.log t :=
  ⟨PrimeGap186.primeMertensConstant, PrimeGap186.prime_second_error_bounded⟩

end

namespace PrimeGap186

open Real Finset Filter Asymptotics Topology
open ArithmeticFunction hiding log

/-- The paper uses `w_0 = log (log (log x))`. For fixed `H`, the extra tuple factors
are eventually already in it; see `presievingModulus_eventually_eq_primorial`. -/
noncomputable def presievingModulus (H : Finset ℕ) (x : ℝ) : ℕ :=
  ∏ p ∈ Nat.primesLE ⌊Real.log (Real.log (Real.log x))⌋₊ ∪
      H.biUnion (fun h => H.biUnion (fun k => (Nat.dist h k).primeFactors)), p

/--
The primes at most `R^ζ` that do not divide the presieving modulus `W`, using the natural-number
floor for the cutoff.
-/
noncomputable def fragmentPrimes (W : ℕ) (R ζ : ℝ) : Finset ℕ :=
  (Nat.primesLE ⌊R ^ ζ⌋₊).filter (fun p => ¬ p ∣ W)

/--
The total weight `∑ 1 / φ(r)` over divisors of the squarefree product of admissible fragment
primes.
-/
noncomputable def harmonicFragmentMass (W : ℕ) (R ζ : ℝ) : ℝ :=
  ∑ r ∈ (∏ p ∈ fragmentPrimes W R ζ, p).divisors,
    (Nat.totient r : ℝ)⁻¹

/-- The harmonic fragment normalization `(φ(W) / W) * log R`. -/
noncomputable def fragmentNormalization (W : ℕ) (R : ℝ) : ℝ :=
  ((Nat.totient W : ℝ) / (W : ℝ)) * Real.log R

theorem squarefree_prime_prod (S : Finset ℕ) (hS : ∀ p ∈ S, Nat.Prime p) :
    Squarefree (∏ p ∈ S, p) := by
  apply Finset.squarefree_prod_of_pairwise_isCoprime
  · intro p hp q hq hpq
    exact Nat.coprime_iff_isRelPrime.mp ((Nat.coprime_primes (hS p hp) (hS q hq)).mpr hpq)
  · intro p hp
    exact (hS p hp).squarefree

theorem reciprocal_totient_product (S : Finset ℕ)
    (hS : ∀ p ∈ S, Nat.Prime p) :
    (∑ r ∈ (∏ p ∈ S, p).divisors, (Nat.totient r : ℝ)⁻¹) =
      ∏ p ∈ S, (1 + 1 / ((p : ℝ) - 1)) := by
  let f : ArithmeticFunction ℝ := ⟨fun n => (Nat.totient n : ℝ)⁻¹, by simp⟩
  have hf : f.IsMultiplicative := by
    refine ⟨by simp [f], fun {m n} hmn => ?_⟩
    simp [f, Nat.totient_mul hmn, mul_comm]
  have h := hf.prodPrimeFactors_one_add_of_squarefree
    (squarefree_prime_prod S hS)
  rw [Nat.primeFactors_prod hS] at h
  change (∑ r ∈ (∏ p ∈ S, p).divisors, f r) = _
  rw [← h]
  apply prod_congr rfl
  intro p hp
  change 1 + (Nat.totient p : ℝ)⁻¹ = _
  rw [Nat.totient_prime (hS p hp), Nat.cast_sub (hS p hp).one_le, Nat.cast_one, one_div]

theorem marked_reciprocal_totient_sum (S : Finset ℕ)
    (hS : ∀ q ∈ S, Nat.Prime q) {p : ℕ} (hpS : p ∈ S) :
    (∑ r ∈ (∏ q ∈ S, q).divisors.filter (fun r => p ∣ r),
      (Nat.totient r : ℝ)⁻¹) =
      (∑ r ∈ (∏ q ∈ S, q).divisors, (Nat.totient r : ℝ)⁻¹) / (p : ℝ) := by
  let N := ∏ q ∈ S.erase p, q
  have hp := hS p hpS
  have hc : p.Coprime N := by
    apply Nat.Coprime.prod_right
    intro q hq
    exact (Nat.coprime_primes hp (hS q (mem_erase.mp hq).2)).mpr
      (mem_erase.mp hq).1.symm
  have hsplit (f : ℕ → ℝ) :
      (∑ r ∈ (p * N).divisors, f r) =
        (∑ d ∈ N.divisors, f d) + ∑ d ∈ N.divisors, f (p * d) := by
    rw [hc.divisors_mul, sum_map]
    change (∑ q ∈ (p.divisors ×ˢ N.divisors).attach, f (q.val.1 * q.val.2)) = _
    rw [sum_attach (p.divisors ×ˢ N.divisors) (fun q : ℕ × ℕ => f (q.1 * q.2)),
      sum_product, hp.divisors]
    simp [hp.ne_one.symm]
  have hQ : p * N = ∏ q ∈ S, q := mul_prod_erase S (fun q => q) hpS
  have hp0 : (p : ℝ) ≠ 0 := by exact_mod_cast hp.ne_zero
  have hp1 : (p : ℝ) - 1 ≠ 0 := ne_of_gt (sub_pos.mpr (by exact_mod_cast hp.one_lt))
  rw [← hQ, sum_filter, hsplit, hsplit, ← sum_add_distrib, ← sum_add_distrib, sum_div]
  apply sum_congr rfl
  intro d hd
  have hnd : ¬ p ∣ d := hp.coprime_iff_not_dvd.mp
    (hc.coprime_dvd_right (Nat.mem_divisors.mp hd).1)
  simp only [ite_eq_right hnd, ite_eq_left (dvd_mul_right p d), zero_add,
    Nat.totient_mul_of_prime_of_not_dvd hp hnd, Nat.cast_mul,
    Nat.cast_sub hp.one_le, Nat.cast_one, mul_inv]
  generalize (Nat.totient d : ℝ)⁻¹ = z
  field

theorem weighted_prime_factor_sum (S : Finset ℕ)
    (hS : ∀ p ∈ S, Nat.Prime p) (P : ℕ → Prop) [DecidablePred P] (g : ℕ → ℝ) :
    (∑ r ∈ (∏ p ∈ S, p).divisors, (Nat.totient r : ℝ)⁻¹ *
      ∑ p ∈ r.primeFactors.filter P, g p) =
      (∑ r ∈ (∏ p ∈ S, p).divisors, (Nat.totient r : ℝ)⁻¹) *
        ∑ p ∈ S.filter P, g p / (p : ℝ) := by
  have hQ : (∏ p ∈ S, p) ≠ 0 := prod_ne_zero_iff.mpr fun p hp => (hS p hp).ne_zero
  have hf (r : ℕ) (hr : r ∈ (∏ p ∈ S, p).divisors) :
      r.primeFactors.filter P = (S.filter P).filter (fun p => p ∣ r) := by
    rw [filter_comm, ← Nat.primeFactors_prod hS,
      Nat.primeFactors_filter_dvd_of_dvd hQ (Nat.mem_divisors.mp hr).1]
  calc
    _ = ∑ r ∈ (∏ p ∈ S, p).divisors, ∑ p ∈ S.filter P,
        if p ∣ r then (Nat.totient r : ℝ)⁻¹ * g p else 0 := by
      refine sum_congr rfl fun r hr => ?_
      simp only [hf r hr, sum_filter, mul_sum, mul_ite, mul_zero]
    _ = ∑ p ∈ S.filter P, g p *
        ∑ r ∈ (∏ p ∈ S, p).divisors.filter (fun r => p ∣ r),
          (Nat.totient r : ℝ)⁻¹ := by
      rw [sum_comm]
      refine sum_congr rfl fun p _ => ?_
      simp only [sum_filter, mul_sum, mul_ite, mul_zero, mul_comm]
    _ = _ := by
      conv_rhs => rw [mul_sum]
      refine sum_congr rfl fun p hp => ?_
      rw [marked_reciprocal_totient_sum S hS (mem_filter.mp hp).1, mul_div_left_comm]

theorem presieve_factor_prime (H : Finset ℕ) (x : ℝ) {p : ℕ}
    (hp : p ∈ Nat.primesLE ⌊Real.log (Real.log (Real.log x))⌋₊ ∪
      H.biUnion (fun h => H.biUnion (fun k => (Nat.dist h k).primeFactors))) :
    Nat.Prime p := by
  simp only [mem_union, mem_biUnion] at hp
  rcases hp with hp | ⟨h, _, k, _, hp⟩
  · exact Nat.prime_of_mem_primesLE hp
  · exact Nat.prime_of_mem_primeFactors hp

theorem presieving_pos (H : Finset ℕ) (x : ℝ) :
    0 < presievingModulus H x := prod_pos fun _ hp => (presieve_factor_prime H x hp).pos

theorem eventually_prime_dvd_presieving (H : Finset ℕ) {p : ℕ}
    (hp : Nat.Prime p) :
    ∀ᶠ x : ℝ in atTop, p ∣ presievingModulus H x := by
  filter_upwards [(Real.tendsto_log_atTop.comp
    (Real.tendsto_log_atTop.comp Real.tendsto_log_atTop)).eventually_ge_atTop (p : ℝ)]
    with x hx
  unfold presievingModulus
  apply dvd_prod_of_mem (fun q : ℕ => q)
  exact mem_union_left _
    (Nat.mem_primesLE.mpr ⟨(Nat.le_floor_iff' hp.ne_zero).mpr hx, hp⟩)

theorem presievingModulus_eventually_eq_primorial (H : Finset ℕ) :
    ∀ᶠ x : ℝ in atTop, presievingModulus H x =
      ∏ p ∈ Nat.primesLE ⌊Real.log (Real.log (Real.log x))⌋₊, p := by
  let D := H.biUnion (fun h => H.biUnion (fun k => (Nat.dist h k).primeFactors))
  have hD : ∀ᶠ x : ℝ in atTop,
      D ⊆ Nat.primesLE ⌊Real.log (Real.log (Real.log x))⌋₊ := by
    apply (Filter.eventually_all_finset D).mpr
    intro p hp
    simp only [D, Finset.mem_biUnion] at hp
    rcases hp with ⟨h, _, k, _, hp⟩
    have hp' := Nat.prime_of_mem_primeFactors hp
    filter_upwards [(Real.tendsto_log_atTop.comp
      (Real.tendsto_log_atTop.comp Real.tendsto_log_atTop)).eventually_ge_atTop (p : ℝ)]
      with x hx
    exact Nat.mem_primesLE.mpr ⟨(Nat.le_floor_iff' hp'.ne_zero).mpr hx, hp'⟩
  filter_upwards [hD] with x hx
  unfold presievingModulus
  rw [Finset.union_eq_left.mpr hx]

theorem eventually_presieving_factor_lt_rpow (H : Finset ℕ)
    (a : ℝ) (ha : 0 < a) :
    ∀ᶠ x : ℝ in atTop,
      ∀ p ∈ (presievingModulus H x).primeFactors, (p : ℝ) < x ^ a := by
  have hpow := tendsto_rpow_atTop ha
  have hnorm : ∀ᶠ x : ℝ in atTop, 0 < ‖x ^ a‖ :=
    (hpow.eventually_gt_atTop 0).mono fun x hx => hx.trans_le (Real.le_norm_self _)
  have hsmall := (isLittleO_log_rpow_atTop ha).eventuallyLT_norm_of_eventually_pos hnorm
  filter_upwards [hsmall, hpow.eventually_ge_atTop 0,
    Real.tendsto_log_atTop.eventually_ge_atTop 0,
    (Real.tendsto_log_atTop.comp Real.tendsto_log_atTop).eventually_ge_atTop 0,
    presievingModulus_eventually_eq_primorial H] with x hsmall hpow0 hlog hloglog hW
  intro p hp
  rw [hW, Nat.primeFactors_prod (fun p hp => Nat.prime_of_mem_primesLE hp)] at hp
  have hple : (p : ℝ) ≤ log (log (log x)) :=
    (Nat.le_floor_iff' (Nat.prime_of_mem_primesLE hp).ne_zero).mp
      (Nat.mem_primesLE.mp hp).1
  have hll : log (log (log x)) ≤ log x :=
    (Real.log_le_self hloglog).trans (Real.log_le_self hlog)
  have hlt : log x < x ^ a :=
    (Real.le_norm_self _).trans_lt (by
      simpa only [Real.norm_of_nonneg hpow0] using hsmall)
  exact hple.trans_lt (hll.trans_lt hlt)

theorem fragment_mass_mul_euler_product (W : ℕ) (R ζ : ℝ) (hW : W ≠ 0)
    (hsub : W.primeFactors ⊆ Nat.primesLE ⌊R ^ ζ⌋₊) :
    harmonicFragmentMass W R ζ *
        (∏ p ∈ Nat.primesLE ⌊R ^ ζ⌋₊, (1 - (p : ℝ)⁻¹)) =
      (Nat.totient W : ℝ) / (W : ℝ) := by
  have hS : ∀ p ∈ fragmentPrimes W R ζ, p.Prime :=
    fun p hp => Nat.prime_of_mem_primesLE (mem_filter.mp hp).1
  have hsplit :
      (Nat.primesLE ⌊R ^ ζ⌋₊).filter (fun p => p ∣ W) = W.primeFactors := by
    ext p
    simp only [mem_filter, Nat.mem_primeFactors_of_ne_zero hW]
    exact ⟨fun hp => ⟨Nat.prime_of_mem_primesLE hp.1, hp.2⟩,
      fun hp => ⟨hsub (Nat.mem_primeFactors_of_ne_zero hW |>.mpr hp), hp.2⟩⟩
  have htot : (Nat.totient W : ℝ) / (W : ℝ) =
      ∏ p ∈ W.primeFactors, (1 - (p : ℝ)⁻¹) := by
    have h := congrArg (fun q : ℚ => (q : ℝ)) (Nat.totient_eq_mul_prod_factors W)
    push_cast at h
    exact (div_eq_iff (by exact_mod_cast hW)).mpr (by simpa [mul_comm] using h)
  unfold harmonicFragmentMass
  rw [reciprocal_totient_product _ hS,
    ← prod_filter_mul_prod_filter_not (Nat.primesLE ⌊R ^ ζ⌋₊) (fun p => p ∣ W),
    hsplit, htot]
  change (∏ p ∈ fragmentPrimes W R ζ, (1 + 1 / ((p : ℝ) - 1))) *
      ((∏ p ∈ W.primeFactors, (1 - (p : ℝ)⁻¹)) *
        ∏ p ∈ fragmentPrimes W R ζ, (1 - (p : ℝ)⁻¹)) = _
  have hcancel :
      (∏ p ∈ fragmentPrimes W R ζ, (1 + 1 / ((p : ℝ) - 1))) *
        (∏ p ∈ fragmentPrimes W R ζ, (1 - (p : ℝ)⁻¹)) = 1 := by
    rw [← prod_mul_distrib]
    apply prod_eq_one
    intro p hp
    have hp0 : (p : ℝ) ≠ 0 := by exact_mod_cast (hS p hp).ne_zero
    have hp1 : (p : ℝ) - 1 ≠ 0 := ne_of_gt (sub_pos.mpr (by exact_mod_cast (hS p hp).one_lt))
    field
  rw [mul_left_comm, hcancel, mul_one]

end PrimeGap186

section
open Real Finset Filter Asymptotics Topology
open ArithmeticFunction hiding log

theorem PrimeGap186.mem_fragment_divisors_iff
    (W : ℕ) (R ζ : ℝ) (hcap : 1 ≤ R ^ ζ) (r : ℕ) :
    r ∈ (∏ p ∈ PrimeGap186.fragmentPrimes W R ζ, p).divisors ↔
      Squarefree r ∧ Nat.Coprime r W ∧
        (((max 1 (r.primeFactors.sup id) : ℕ) : ℝ) ≤ R ^ ζ) := by
  have hS : ∀ p ∈ PrimeGap186.fragmentPrimes W R ζ, p.Prime :=
    fun p hp => Nat.prime_of_mem_primesLE (mem_filter.mp hp).1
  have hQ : (∏ p ∈ PrimeGap186.fragmentPrimes W R ζ, p) ≠ 0 :=
    prod_ne_zero_iff.mpr fun p hp => (hS p hp).ne_zero
  constructor
  · intro hr
    have hsq := (PrimeGap186.squarefree_prime_prod _ hS).squarefree_of_dvd
      (Nat.mem_divisors.mp hr).1
    have hsub : r.primeFactors ⊆ PrimeGap186.fragmentPrimes W R ζ := by
      rw [← Nat.primeFactors_prod hS]
      exact Nat.primeFactors_mono (Nat.mem_divisors.mp hr).1 hQ
    refine ⟨hsq, ?_, ?_⟩
    · apply Nat.coprime_of_dvd
      intro p hp hpr hpW
      exact (mem_filter.mp (hsub (Nat.mem_primeFactors.mpr ⟨hp, hpr, hsq.ne_zero⟩))).2 hpW
    · rw [Nat.cast_max, Nat.cast_one]
      apply max_le hcap
      have hsup : r.primeFactors.sup id ≤ ⌊R ^ ζ⌋₊ :=
        Finset.sup_le fun p hp => (Nat.mem_primesLE.mp (mem_filter.mp (hsub hp)).1).1
      exact (Nat.cast_le.mpr hsup).trans (Nat.floor_le (zero_le_one.trans hcap))
  · rintro ⟨hsq, hcop, hmax⟩
    apply Nat.mem_divisors.mpr
    refine ⟨?_, hQ⟩
    rw [← Nat.prod_primeFactors_of_squarefree hsq]
    apply (Nat.prod_primeFactors_dvd_iff hQ).mpr
    rw [Nat.primeFactors_prod hS]
    intro p hp
    have hprime := Nat.prime_of_mem_primeFactors hp
    have hple : (p : ℝ) ≤ R ^ ζ :=
      (Nat.cast_le.mpr ((Finset.le_sup (f := id) hp).trans (le_max_right 1 _))).trans hmax
    exact mem_filter.mpr
      ⟨Nat.mem_primesLE.mpr ⟨(Nat.le_floor_iff' hprime.ne_zero).mpr hple, hprime⟩,
        hprime.coprime_iff_not_dvd.mp (hcop.coprime_dvd_left (Nat.dvd_of_mem_primeFactors hp))⟩

theorem PrimeGap186.harmonic_fragment_mass_eq_product
    (W : ℕ) (R ζ : ℝ) :
    PrimeGap186.harmonicFragmentMass W R ζ =
      ∏ p ∈ PrimeGap186.fragmentPrimes W R ζ, (1 + 1 / ((p : ℝ) - 1)) :=
  PrimeGap186.reciprocal_totient_product _ fun _ hp =>
    Nat.prime_of_mem_primesLE (mem_filter.mp hp).1

theorem PrimeGap186.harmonic_fragment_normalizer_tendsto
    (H : Finset ℕ) (ρ ζ : ℝ) (hρ : 0 < ρ) (hζ : 0 < ζ) :
    Filter.Tendsto
      (fun x : ℝ =>
        PrimeGap186.harmonicFragmentMass (PrimeGap186.presievingModulus H x) (x ^ ρ) ζ /
          PrimeGap186.fragmentNormalization (PrimeGap186.presievingModulus H x) (x ^ ρ))
      Filter.atTop (nhds (Real.exp Real.eulerMascheroniConstant * ζ)) := by
  have hR := tendsto_rpow_atTop hρ
  have hT := (tendsto_rpow_atTop hζ).comp hR
  have hlim := ((PrimeGap186.prime_mertens_product_tendsto.comp hT).inv₀
    (Real.exp_ne_zero _)).mul_const ζ
  simp only [Real.exp_neg, inv_inv, Function.comp_def] at hlim
  apply hlim.congr'
  filter_upwards [hR.eventually_gt_atTop 1, eventually_gt_atTop (0 : ℝ),
    PrimeGap186.eventually_presieving_factor_lt_rpow H (ρ * ζ) (mul_pos hρ hζ)] with x hR1 hx hsmall
  have hsub : (PrimeGap186.presievingModulus H x).primeFactors ⊆
      Nat.primesLE ⌊(x ^ ρ) ^ ζ⌋₊ := by
    intro p hp
    have hlt := hsmall p hp
    rw [Real.rpow_mul hx.le] at hlt
    exact Nat.mem_primesLE.mpr
      ⟨(Nat.le_floor_iff' (Nat.prime_of_mem_primeFactors hp).ne_zero).mpr hlt.le,
        Nat.prime_of_mem_primeFactors hp⟩
  have hW := PrimeGap186.presieving_pos H x
  have hphi : 0 < (Nat.totient (PrimeGap186.presievingModulus H x) : ℝ) /
      (PrimeGap186.presievingModulus H x : ℝ) :=
    div_pos (by exact_mod_cast Nat.totient_pos.mpr hW) (by exact_mod_cast hW)
  have hP : 0 < ∏ p ∈ Nat.primesLE ⌊(x ^ ρ) ^ ζ⌋₊, (1 - (p : ℝ)⁻¹) := by
    apply prod_pos
    intro p hp
    exact sub_pos.mpr (inv_lt_one_of_one_lt₀ (by exact_mod_cast Nat.one_lt_of_mem_primesLE hp))
  have hm := PrimeGap186.fragment_mass_mul_euler_product
    (PrimeGap186.presievingModulus H x) (x ^ ρ) ζ hW.ne' hsub
  have hm' := (eq_div_iff hP.ne').mpr hm
  rw [hm', PrimeGap186.fragmentNormalization, Real.log_rpow (zero_lt_one.trans hR1)]
  have hlog : 0 < Real.log (x ^ ρ) := Real.log_pos hR1
  field_simp

theorem PrimeGap186.harmonic_small_seed_first_moment_bound :
    ∃ C : ℝ, 0 < C ∧ ∀ (W : ℕ) (R ζ ε : ℝ),
      1 < R → 0 ≤ ε →
      let Q : ℕ := ∏ p ∈ PrimeGap186.fragmentPrimes W R ζ, p
      let E : ℝ :=
        (∑ r ∈ Q.divisors, (Nat.totient r : ℝ)⁻¹ *
          ∑ p ∈ r.primeFactors.filter (fun p : ℕ => (p : ℝ) ≤ R ^ ε),
            Real.log p / Real.log R) /
          PrimeGap186.harmonicFragmentMass W R ζ
      0 ≤ E ∧ E ≤ ε + C / Real.log R := by
  obtain ⟨C, hC, hbound⟩ := PrimeGap186.exists_prime_log_harmonic_bounded_error
  refine ⟨C, hC, ?_⟩
  intro W R ζ ε hR hε
  dsimp only
  let S := PrimeGap186.fragmentPrimes W R ζ
  have hS : ∀ p ∈ S, p.Prime :=
    fun p hp => Nat.prime_of_mem_primesLE (mem_filter.mp hp).1
  have hmass : 0 < PrimeGap186.harmonicFragmentMass W R ζ := by
    rw [PrimeGap186.harmonic_fragment_mass_eq_product]
    apply prod_pos
    intro p hp
    have hp1 : (1 : ℝ) < p := by exact_mod_cast (hS p hp).one_lt
    positivity
  have hlog : 0 < Real.log R := Real.log_pos hR
  have hcap : 1 ≤ R ^ ε := Real.one_le_rpow hR.le hε
  have hE :
      (∑ r ∈ (∏ p ∈ S, p).divisors, (Nat.totient r : ℝ)⁻¹ *
        ∑ p ∈ r.primeFactors.filter (fun p : ℕ => (p : ℝ) ≤ R ^ ε),
          Real.log p / Real.log R) / PrimeGap186.harmonicFragmentMass W R ζ =
      (∑ p ∈ S.filter (fun p : ℕ => (p : ℝ) ≤ R ^ ε),
        Real.log p / (p : ℝ)) / Real.log R := by
    rw [PrimeGap186.weighted_prime_factor_sum S hS]
    change PrimeGap186.harmonicFragmentMass W R ζ *
      (∑ p ∈ S.filter (fun p : ℕ => (p : ℝ) ≤ R ^ ε),
        (Real.log p / Real.log R) / (p : ℝ)) / PrimeGap186.harmonicFragmentMass W R ζ = _
    rw [mul_div_cancel_left₀ _ hmass.ne', sum_div]
    simp_rw [div_right_comm]
  rw [hE]
  have hnonneg (p : ℕ) : 0 ≤ Real.log p / (p : ℝ) :=
    div_nonneg (Real.log_natCast_nonneg p) (Nat.cast_nonneg p)
  refine ⟨div_nonneg (sum_nonneg fun p _ => hnonneg p) hlog.le, ?_⟩
  have hsub : S.filter (fun p : ℕ => (p : ℝ) ≤ R ^ ε) ⊆ Nat.primesLE ⌊R ^ ε⌋₊ := by
    intro p hp
    have hprime := hS p (mem_filter.mp hp).1
    exact Nat.mem_primesLE.mpr
      ⟨(Nat.le_floor_iff' hprime.ne_zero).mpr (mem_filter.mp hp).2, hprime⟩
  have hsum :
      (∑ p ∈ S.filter (fun p : ℕ => (p : ℝ) ≤ R ^ ε), Real.log p / (p : ℝ)) ≤
        ∑ p ∈ Nat.primesLE ⌊R ^ ε⌋₊, Real.log p / (p : ℝ) :=
    sum_le_sum_of_subset_of_nonneg hsub fun p _ _ => hnonneg p
  have htop : (∑ p ∈ Nat.primesLE ⌊R ^ ε⌋₊, Real.log p / (p : ℝ)) ≤
      Real.log (R ^ ε) + C := by
    have hb := (abs_le.mp (hbound (R ^ ε) hcap)).2
    linarith
  calc
    _ ≤ ((Real.log (R ^ ε) + C) / Real.log R) :=
      div_le_div_of_nonneg_right (hsum.trans htop) hlog.le
    _ = _ := by
      rw [Real.log_rpow (zero_lt_one.trans hR)]
      field_simp

theorem PrimeGap186.presieved_prime_square_tail_tendsto
    (H : Finset ℕ) :
    Filter.Tendsto
      (fun x : ℝ => ∑' p : ℕ,
        if Nat.Prime p ∧ ¬ p ∣ PrimeGap186.presievingModulus H x
        then 1 / (p : ℝ) ^ 2 else 0)
      Filter.atTop (nhds 0) := by
  have hsum : Summable (fun p : ℕ => 1 / (p : ℝ) ^ 2) :=
    Real.summable_one_div_nat_pow.mpr (by norm_num)
  have hpoint (p : ℕ) :
      Tendsto (fun x : ℝ =>
        if Nat.Prime p ∧ ¬ p ∣ PrimeGap186.presievingModulus H x then 1 / (p : ℝ) ^ 2 else 0)
        atTop (nhds (0 : ℝ)) := by
    by_cases hp : Nat.Prime p
    · apply tendsto_const_nhds.congr'
      filter_upwards [PrimeGap186.eventually_prime_dvd_presieving H hp] with x hd
      simp [hd]
    · simp [hp]
  have hbound : ∀ᶠ x : ℝ in atTop, ∀ p : ℕ,
      ‖if Nat.Prime p ∧ ¬ p ∣ PrimeGap186.presievingModulus H x then 1 / (p : ℝ) ^ 2 else 0‖ ≤
        1 / (p : ℝ) ^ 2 :=
    Eventually.of_forall fun x p => by
      split_ifs <;> simp
  simpa only [tsum_zero] using tendsto_tsum_of_dominated_convergence hsum hpoint hbound

theorem PrimeGap186.presieved_prime_band_tendsto
    (H : Finset ℕ) (ρ α β : ℝ)
    (hρ : 0 < ρ) (hα : 0 < α) (hαβ : α ≤ β) :
    Filter.Tendsto
      (fun x : ℝ =>
        ∑ p ∈ (PrimeGap186.fragmentPrimes (PrimeGap186.presievingModulus H x) (x ^ ρ) β).filter
          (fun p : ℕ => (x ^ ρ) ^ α < (p : ℝ)), (p : ℝ)⁻¹)
      Filter.atTop (nhds (Real.log (β / α))) := by
  have hβ : 0 < β := hα.trans_le hαβ
  have hR := tendsto_rpow_atTop hρ
  have hA := (tendsto_rpow_atTop hα).comp hR
  have hB := (tendsto_rpow_atTop hβ).comp hR
  have hlim := ((PrimeGap186.prime_second_error_tendsto.comp hB).sub
    (PrimeGap186.prime_second_error_tendsto.comp hA)).add_const (Real.log (β / α))
  simp only [sub_self, zero_add] at hlim
  apply hlim.congr'
  filter_upwards [hR.eventually_gt_atTop 1, eventually_gt_atTop (0 : ℝ),
    PrimeGap186.eventually_presieving_factor_lt_rpow H (ρ * α) (mul_pos hρ hα)] with x hR1 hx hsmall
  have hpow : (x ^ ρ) ^ α ≤ (x ^ ρ) ^ β :=
    Real.rpow_le_rpow_of_exponent_le hR1.le hαβ
  have hsmall' : ∀ p ∈ (PrimeGap186.presievingModulus H x).primeFactors,
      (p : ℝ) < (x ^ ρ) ^ α := by
    intro p hp
    simpa only [Real.rpow_mul hx.le] using hsmall p hp
  have hfilter :
      (PrimeGap186.fragmentPrimes (PrimeGap186.presievingModulus H x) (x ^ ρ) β).filter
        (fun p : ℕ => (x ^ ρ) ^ α < (p : ℝ)) =
      (Nat.primesLE ⌊(x ^ ρ) ^ β⌋₊).filter (fun p => ¬ p ≤ ⌊(x ^ ρ) ^ α⌋₊) := by
    ext p
    simp only [PrimeGap186.fragmentPrimes, mem_filter, not_le,
      Nat.floor_lt (by positivity : 0 ≤ (x ^ ρ) ^ α)]
    constructor
    · rintro ⟨⟨hp, _⟩, hlow⟩
      exact ⟨hp, hlow⟩
    · rintro ⟨hp, hlow⟩
      refine ⟨⟨hp, ?_⟩, hlow⟩
      intro hd
      have hm := (Nat.prime_of_mem_primesLE hp).mem_primeFactors hd
        (PrimeGap186.presieving_pos H x).ne'
      exact (hsmall' p hm).not_ge hlow.le
  have hlowset :
      (Nat.primesLE ⌊(x ^ ρ) ^ β⌋₊).filter
        (fun p => p ≤ ⌊(x ^ ρ) ^ α⌋₊) = Nat.primesLE ⌊(x ^ ρ) ^ α⌋₊ := by
    ext p
    simp only [mem_filter, Nat.mem_primesLE]
    have hfloor := Nat.floor_mono hpow
    exact ⟨fun h => ⟨h.2, h.1.2⟩, fun h => ⟨⟨h.1.trans hfloor, h.2⟩, h.1⟩⟩
  have hsum := sum_filter_add_sum_filter_not (Nat.primesLE ⌊(x ^ ρ) ^ β⌋₊)
    (fun p => p ≤ ⌊(x ^ ρ) ^ α⌋₊) (fun p => (p : ℝ)⁻¹)
  rw [hlowset] at hsum
  have hlogR : 0 < Real.log (x ^ ρ) := Real.log_pos hR1
  have hlogs :
      Real.log (Real.log ((x ^ ρ) ^ β)) -
        Real.log (Real.log ((x ^ ρ) ^ α)) = Real.log (β / α) := by
    rw [Real.log_rpow (zero_lt_one.trans hR1), Real.log_rpow (zero_lt_one.trans hR1),
      Real.log_mul hβ.ne' hlogR.ne', Real.log_mul hα.ne' hlogR.ne',
      Real.log_div hβ.ne' hα.ne']
    ring
  rw [hfilter]
  dsimp only [Function.comp_def, PrimeGap186.primeSecondError]
  linarith

end

namespace PrimeGap186

section
open Real Finset Filter Asymptotics Topology
open ArithmeticFunction hiding log

/--
The weighted prime-factor configuration of `r`: each distinct prime factor contributes an atom
at `log p / log R` with the nonnegative part of that location as its mass. Prime-factor
multiplicities are not retained.
-/
noncomputable def primeLogConfiguration (R : ℝ) (r : ℕ) : FiniteMeasure ℝ :=
  ∑ p ∈ r.primeFactors,
    let u : ℝ := Real.log p / Real.log R
    let atom : FiniteMeasure ℝ := ⟨Measure.dirac u, inferInstance⟩
    u.toNNReal • atom

/--
The finite measure on prime-factor configurations assigning weight `1 / φ(r)` to each squarefree
divisor of the admissible fragment-prime product.
-/
noncomputable def harmonicConfigurationMass (W : ℕ) (R ζ : ℝ) :
    FiniteMeasure (FiniteMeasure ℝ) :=
  ∑ r ∈ (∏ p ∈ fragmentPrimes W R ζ, p).divisors,
    let atom : FiniteMeasure (FiniteMeasure ℝ) :=
      ⟨Measure.dirac (primeLogConfiguration R r), inferInstance⟩
    ((Nat.totient r : ℝ)⁻¹).toNNReal • atom

theorem integral_prime_log_configuration (R : ℝ) (r : ℕ)
    (hR : 1 < R) (h : ℝ → ℝ) :
    (∫ u, h u ∂(primeLogConfiguration R r : Measure ℝ)) =
      ∑ p ∈ r.primeFactors, (Real.log p / Real.log R) *
        h (Real.log p / Real.log R) := by
  unfold primeLogConfiguration
  rw [FiniteMeasure.toMeasure_sum, integral_finsetSum_measure
    (fun _ _ => (integrable_dirac (by finiteness)).smul_measure_nnreal)]
  apply sum_congr rfl
  intro p _
  change (∫ u, h u ∂((Real.log p / Real.log R).toNNReal •
    Measure.dirac (Real.log p / Real.log R))) = _
  rw [integral_smul_nnreal_measure, integral_dirac, NNReal.smul_def, smul_eq_mul,
    Real.coe_toNNReal _ (div_nonneg (Real.log_natCast_nonneg _) (Real.log_nonneg hR.le))]

theorem reciprocal_totient_prime_factor_product (S : Finset ℕ)
    (hS : ∀ p ∈ S, Nat.Prime p) (g : ℕ → ℝ) :
    (∑ r ∈ (∏ p ∈ S, p).divisors,
      (Nat.totient r : ℝ)⁻¹ * ∏ p ∈ r.primeFactors, g p) =
        ∏ p ∈ S, (1 + g p / ((p : ℝ) - 1)) := by
  let f : ArithmeticFunction ℝ := ⟨fun n => (Nat.totient n : ℝ)⁻¹, by simp⟩
  have hf : f.IsMultiplicative := by
    refine ⟨by simp [f], fun {m n} hmn => ?_⟩
    simp [f, Nat.totient_mul hmn, mul_comm]
  have hprod :=
    (hf.pmul (IsMultiplicative.prodPrimeFactors g)).prodPrimeFactors_one_add_of_squarefree
      (squarefree_prime_prod S hS)
  rw [Nat.primeFactors_prod hS] at hprod
  calc
    _ = ∑ r ∈ (∏ p ∈ S, p).divisors,
        f.pmul (ArithmeticFunction.prodPrimeFactors g) r := by
      apply sum_congr rfl
      intro r hr
      rw [ArithmeticFunction.pmul_apply, ArithmeticFunction.prodPrimeFactors_apply
        (Nat.pos_of_mem_divisors hr).ne']
      rfl
    _ = ∏ p ∈ S, (1 + f.pmul (ArithmeticFunction.prodPrimeFactors g) p) :=
      hprod.symm
    _ = _ := by
      apply prod_congr rfl
      intro p hp
      rw [ArithmeticFunction.pmul_apply, ArithmeticFunction.prodPrimeFactors_apply
        (hS p hp).ne_zero, (hS p hp).primeFactors, prod_singleton]
      change 1 + (Nat.totient p : ℝ)⁻¹ * g p = _
      rw [Nat.totient_prime (hS p hp), Nat.cast_sub (hS p hp).one_le, Nat.cast_one]
      ring

theorem harmonic_fragment_mass_pos (W : ℕ) (R ζ : ℝ) :
    0 < harmonicFragmentMass W R ζ := by
  rw [harmonic_fragment_mass_eq_product]
  apply prod_pos
  intro p hp
  have hp1 : (1 : ℝ) < p := by
    exact_mod_cast (Nat.prime_of_mem_primesLE (mem_filter.mp hp).1).one_lt
  positivity

theorem sum_prime_divisors_eq_sum_bool {A : Type*} [AddCommMonoid A]
    (S : Finset ℕ) (hS : ∀ p ∈ S, Nat.Prime p) (f : ℕ → A) :
    (∑ r ∈ (∏ p ∈ S, p).divisors, f r) =
      ∑ b : S → Bool, f (∏ p : S, if b p then p.val else 1) := by
  classical
  let q (b : S → Bool) : ℕ := ∏ p : S, if b p then p.val else 1
  have hQ := (squarefree_prime_prod S hS).ne_zero
  have hq (b : S → Bool) : q b ∣ ∏ p ∈ S, p := by
    rw [← prod_coe_sort S (fun p : ℕ => p)]
    exact prod_dvd_prod_of_dvd _ _ fun p _ => by split_ifs <;> simp
  have hprime (b : S → Bool) (p : S) : p.val ∣ q b ↔ b p = true := by
    rw [(hS p.val p.property).prime.dvd_finsetProd_iff]
    simp [apply_ite (fun n => p.val ∣ n), (hS p.val p.property).not_dvd_one,
      fun a : S => (hS a.val a.property).dvd_iff_eq (hS p.val p.property).ne_one]
  have hrecover (r : ℕ) (hr : r ∈ (∏ p ∈ S, p).divisors) :
      q (fun p => decide (p.val ∣ r)) = r := by
    calc
      _ = ∏ p ∈ S.filter (fun p => p ∣ r), p := by
        simp only [q, prod_filter, decide_eq_true_eq]
        exact prod_coe_sort S (fun p : ℕ => if p ∣ r then p else 1)
      _ = ∏ p ∈ r.primeFactors, p := by
        rw [← Nat.primeFactors_prod hS,
          Nat.primeFactors_filter_dvd_of_dvd hQ (Nat.mem_divisors.mp hr).1]
      _ = r := Nat.prod_primeFactors_of_squarefree
        ((squarefree_prime_prod S hS).squarefree_of_dvd
          (Nat.mem_divisors.mp hr).1)
  refine sum_bij' (fun r _ p => decide (p.val ∣ r)) (fun b _ => q b)
    (fun _ _ => mem_univ _) (fun b _ => Nat.mem_divisors.mpr ⟨hq b, hQ⟩)
    hrecover ?_ ?_
  · intro b _
    funext p
    apply Bool.eq_iff_iff.mpr
    simpa only [decide_eq_true_eq] using hprime b p
  · intro r hr
    exact congrArg f (hrecover r hr).symm

theorem harmonic_configuration_mass_eq_bernoulli
    (W : ℕ) (R ζ : ℝ) :
    let S := fragmentPrimes W R ζ
    (harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ)) =
      ENNReal.ofReal (harmonicFragmentMass W R ζ) •
        Measure.map
          (fun b : S → Bool =>
            primeLogConfiguration R (∏ p : S, if b p then p.val else 1))
          (Measure.pi (fun p : S =>
            ProbabilityTheory.bernoulliMeasure true false
              (Set.projIcc 0 1 zero_le_one ((p.val : ℝ)⁻¹)))) := by
  classical
  let S := fragmentPrimes W R ζ
  let q (b : S → Bool) : ℕ := ∏ p : S, if b p then p.val else 1
  let μ : Measure (S → Bool) := Measure.pi (fun p : S =>
    ProbabilityTheory.bernoulliMeasure true false
      (Set.projIcc 0 1 zero_le_one ((p.val : ℝ)⁻¹)))
  let F (b : S → Bool) := primeLogConfiguration R (q b)
  have hS : ∀ p ∈ S, Nat.Prime p :=
    fun _ hp => Nat.prime_of_mem_primesLE (mem_filter.mp hp).1
  have hp01 (p : S) : (p.val : ℝ)⁻¹ ∈ Set.Icc (0 : ℝ) 1 := by
    have hp1 : 1 ≤ (p.val : ℝ) := by exact_mod_cast (hS p.val p.property).one_le
    exact ⟨by positivity, inv_le_one_of_one_le₀ hp1⟩
  let f : ArithmeticFunction ℝ := ⟨fun n => (Nat.totient n : ℝ)⁻¹, by simp⟩
  have hf : f.IsMultiplicative := by
    refine ⟨by simp [f], fun {m n} hmn => ?_⟩
    simp [f, Nat.totient_mul hmn, mul_comm]
  have htot (b : S → Bool) :
      (Nat.totient (q b) : ℝ)⁻¹ =
        ∏ p : S, if b p then ((p.val : ℝ) - 1)⁻¹ else 1 := by
    change f (∏ p : S, if b p then p.val else 1) = _
    rw [ArithmeticFunction.IsMultiplicative.map_prod _ hf univ]
    · apply prod_congr rfl
      intro p _
      cases b p <;> simp [f, Nat.totient_prime (hS p.val p.property),
        Nat.cast_sub (hS p.val p.property).one_le]
    · intro p _ a _ hpa
      change Nat.Coprime (if b p then p.val else 1) (if b a then a.val else 1)
      split_ifs
      · exact (Nat.coprime_primes (hS p.val p.property) (hS a.val a.property)).mpr
          (fun h => hpa (Subtype.ext h))
      all_goals simp
  have hreal (b : S → Bool) :
      harmonicFragmentMass W R ζ *
          (∏ p : S, if b p then (p.val : ℝ)⁻¹ else 1 - (p.val : ℝ)⁻¹) =
        (Nat.totient (q b) : ℝ)⁻¹ := by
    rw [htot, harmonic_fragment_mass_eq_product,
      ← prod_coe_sort S (fun p : ℕ => 1 + 1 / ((p : ℝ) - 1)), ← prod_mul_distrib]
    apply prod_congr rfl
    intro p _
    have hp0 : (p.val : ℝ) ≠ 0 := by exact_mod_cast (hS p.val p.property).ne_zero
    have hp1 : (p.val : ℝ) - 1 ≠ 0 := ne_of_gt (sub_pos.mpr (by
      exact_mod_cast (hS p.val p.property).one_lt))
    split_ifs <;> field
  have hprob (p : S) (v : Bool) :
      ProbabilityTheory.bernoulliMeasure true false
          (Set.projIcc 0 1 zero_le_one ((p.val : ℝ)⁻¹)) {v} =
        ENNReal.ofReal (if v then (p.val : ℝ)⁻¹ else 1 - (p.val : ℝ)⁻¹) := by
    rw [Set.projIcc_of_mem zero_le_one (hp01 p),
      ProbabilityTheory.bernoulliMeasure_apply _ (measurableSet_singleton _)]
    cases v <;> simp [ENNReal.coe_nnreal_eq]
  have hweight (b : S → Bool) :
      ENNReal.ofReal (harmonicFragmentMass W R ζ) * μ {b} =
        ENNReal.ofReal (Nat.totient (q b) : ℝ)⁻¹ := by
    change ENNReal.ofReal (harmonicFragmentMass W R ζ) *
      (Measure.pi _ {b}) = _
    rw [Measure.pi_singleton]
    simp_rw [hprob]
    rw [← ENNReal.ofReal_prod_of_nonneg]
    · rw [← ENNReal.ofReal_mul (harmonic_fragment_mass_pos W R ζ).le, hreal]
    · intro p _
      cases b p
      · exact sub_nonneg.mpr (hp01 p).2
      · exact (hp01 p).1
  have hF : Measurable F := measurable_of_countable F
  have hmap : Measure.map F μ = ∑ b : S → Bool, μ {b} • Measure.dirac (F b) := by
    conv_lhs => rw [← Measure.sum_smul_dirac μ, Measure.sum_fintype]
    simp only [Measure.map_finset_sum' hF.aemeasurable, Measure.map_smul _ hF.aemeasurable,
      Measure.map_dirac' hF]
  change (harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ)) =
    ENNReal.ofReal (harmonicFragmentMass W R ζ) • Measure.map F μ
  rw [hmap, smul_sum]
  unfold harmonicConfigurationMass
  rw [FiniteMeasure.toMeasure_sum, sum_prime_divisors_eq_sum_bool S hS]
  apply sum_congr rfl
  intro b _
  change ENNReal.ofReal (Nat.totient (q b) : ℝ)⁻¹ • Measure.dirac (F b) =
    ENNReal.ofReal (harmonicFragmentMass W R ζ) • (μ {b} • Measure.dirac (F b))
  rw [smul_smul, hweight]

theorem harmonic_fragment_laplace_eq_product
    (W : ℕ) (R ζ : ℝ) (hR : 1 < R) (h : ℝ → ℝ) :
    (∑ r ∈ (∏ p ∈ fragmentPrimes W R ζ, p).divisors,
        (Nat.totient r : ℝ)⁻¹ *
          Real.exp (-(∫ u, h u ∂(primeLogConfiguration R r : Measure ℝ)))) /
        harmonicFragmentMass W R ζ =
      ∏ p ∈ fragmentPrimes W R ζ,
        (1 + (Real.exp (-(Real.log p / Real.log R) *
          h (Real.log p / Real.log R)) - 1) / (p : ℝ)) := by
  have hS : ∀ p ∈ fragmentPrimes W R ζ, Nat.Prime p :=
    fun _ hp => Nat.prime_of_mem_primesLE (mem_filter.mp hp).1
  simp_rw [integral_prime_log_configuration R _ hR h,
    ← sum_neg_distrib, Real.exp_sum, neg_mul]
  rw [reciprocal_totient_prime_factor_product _ hS _,
    harmonic_fragment_mass_eq_product, ← prod_div_distrib]
  apply prod_congr rfl
  intro p hp
  have hp0 : (p : ℝ) ≠ 0 := by exact_mod_cast (hS p hp).ne_zero
  have hp1 : 0 < (p : ℝ) - 1 := sub_pos.mpr (by exact_mod_cast (hS p hp).one_lt)
  have hpden : 1 + 1 / ((p : ℝ) - 1) ≠ 0 := ne_of_gt (by positivity)
  field

theorem integral_harmonic_configuration_mass (W : ℕ) (R ζ : ℝ)
    (f : FiniteMeasure ℝ → ℝ) (hf : StronglyMeasurable f) :
    (∫ c, f c ∂(harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ))) =
      ∑ r ∈ (∏ p ∈ fragmentPrimes W R ζ, p).divisors,
        (Nat.totient r : ℝ)⁻¹ * f (primeLogConfiguration R r) := by
  unfold harmonicConfigurationMass
  rw [FiniteMeasure.toMeasure_sum, integral_finsetSum_measure]
  · apply sum_congr rfl
    intro r _
    change (∫ c, f c ∂(((Nat.totient r : ℝ)⁻¹).toNNReal •
      Measure.dirac (primeLogConfiguration R r))) = _
    rw [integral_smul_nnreal_measure, integral_dirac' _ _ hf, NNReal.smul_def,
      smul_eq_mul, Real.coe_toNNReal _ (inv_nonneg.mpr (Nat.cast_nonneg _))]
  · intro r _
    exact (integrable_dirac' hf (by finiteness)).smul_measure_nnreal

theorem integral_logarithmic_band_substitution (R α β s : ℝ)
    (hR : 1 < R) (hα : 0 < α) (hαβ : α ≤ β) :
    (∫ t in R ^ α..R ^ β,
      (Real.exp (-s * (Real.log t / Real.log R)) - 1) / (t * Real.log t)) =
        ∫ u in α..β, (Real.exp (-s * u) - 1) / u := by
  have hR0 : 0 < R := zero_lt_one.trans hR
  have hlogR : 0 < Real.log R := Real.log_pos hR
  have hAB : R ^ α ≤ R ^ β := Real.rpow_le_rpow_of_exponent_le hR.le hαβ
  let f : ℝ → ℝ := fun t => Real.log t / Real.log R
  let fp : ℝ → ℝ := fun t => t⁻¹ / Real.log R
  let g : ℝ → ℝ := fun u => (Real.exp (-s * u) - 1) / u
  have ht_one {t : ℝ} (ht : t ∈ Set.uIcc (R ^ α) (R ^ β)) : 1 < t := by
    rw [Set.uIcc_of_le hAB] at ht
    exact (Real.one_lt_rpow hR hα).trans_le ht.1
  have hf : ∀ t ∈ Set.uIcc (R ^ α) (R ^ β), HasDerivAt f (fp t) t := by
    intro t ht
    exact (Real.hasDerivAt_log (zero_lt_one.trans (ht_one ht)).ne').div_const _
  have hfp : ContinuousOn fp (Set.uIcc (R ^ α) (R ^ β)) :=
    (continuousOn_id.inv₀ (fun t ht => (zero_lt_one.trans (ht_one ht)).ne')).div_const _
  have hg : ContinuousOn g (f '' Set.uIcc (R ^ α) (R ^ β)) := by
    refine ((continuousOn_id.const_mul (-s)).rexp.sub continuousOn_const).div
      continuousOn_id ?_
    rintro u ⟨t, ht, rfl⟩
    exact (div_pos (Real.log_pos (ht_one ht)) hlogR).ne'
  have hsub := intervalIntegral.integral_comp_mul_deriv'
    (a := R ^ α) (b := R ^ β) (f := f) (f' := fp) (g := g) hf hfp hg
  have hleft :
      (∫ t in R ^ α..R ^ β,
        (Real.exp (-s * (Real.log t / Real.log R)) - 1) / (t * Real.log t)) =
      ∫ t in R ^ α..R ^ β, (g ∘ f) t * fp t := by
    apply intervalIntegral.integral_congr
    intro t ht
    have ht0 : 0 < t := zero_lt_one.trans (ht_one ht)
    have hlogt : 0 < Real.log t := Real.log_pos (ht_one ht)
    dsimp only [Function.comp_def, f, fp, g]
    field_simp [ht0.ne', hlogt.ne', hlogR.ne']
  exact hleft.trans (by
    simpa only [f, g, Real.log_rpow hR0, mul_div_cancel_right₀ _ hlogR.ne'] using hsub)

theorem harmonic_band_laplace_eq_product (W : ℕ) (R ζ α β s : ℝ)
    (hR : 1 < R) (hβζ : β ≤ ζ) :
    (∫ c : FiniteMeasure ℝ,
        Real.exp (-s * ((c.restrict (Set.Ioc α β)).mass : ℝ))
        ∂(harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ))) /
      harmonicFragmentMass W R ζ =
        ∏ p ∈ (fragmentPrimes W R β).filter (fun p : ℕ => R ^ α < (p : ℝ)),
          (1 + (Real.exp (-s * (Real.log p / Real.log R)) - 1) / (p : ℝ)) := by
  classical
  have hR0 : 0 < R := zero_lt_one.trans hR
  have hlogR : 0 < Real.log R := Real.log_pos hR
  let h : ℝ → ℝ := (Set.Ioc α β).indicator (fun _ => s)
  have hI (c : FiniteMeasure ℝ) :
      (∫ u, h u ∂(c : Measure ℝ)) = s * ((c.restrict (Set.Ioc α β)).mass : ℝ) := by
    simp [h, integral_indicator_const s measurableSet_Ioc,
      FiniteMeasure.restrict_mass, mul_comm]
  have hfilter :
      (fragmentPrimes W R ζ).filter (fun p : ℕ =>
        α < Real.log p / Real.log R ∧ Real.log p / Real.log R ≤ β) =
      (fragmentPrimes W R β).filter (fun p : ℕ => R ^ α < (p : ℝ)) := by
    ext p
    by_cases hp : p.Prime
    · have hp0 : 0 < (p : ℝ) := by exact_mod_cast hp.pos
      simp only [fragmentPrimes, mem_filter, Nat.mem_primesLE, hp, and_true,
        Nat.le_floor_iff' hp.ne_zero, Real.le_rpow_iff_log_le hp0 hR0,
        Real.rpow_lt_iff_lt_log hR0 hp0, lt_div_iff₀ hlogR, div_le_iff₀ hlogR]
      constructor
      · rintro ⟨⟨_, hW⟩, hl, hu⟩
        exact ⟨⟨hu, hW⟩, hl⟩
      · rintro ⟨⟨hu, hW⟩, hl⟩
        exact ⟨⟨hu.trans (mul_le_mul_of_nonneg_right hβζ hlogR.le), hW⟩, hl, hu⟩
    · simp [fragmentPrimes, Nat.mem_primesLE, hp]
  calc
    _ = (∑ r ∈ (∏ p ∈ fragmentPrimes W R ζ, p).divisors,
        (Nat.totient r : ℝ)⁻¹ *
          Real.exp (-(∫ u, h u ∂(primeLogConfiguration R r : Measure ℝ)))) /
        harmonicFragmentMass W R ζ := by
      rw [integral_harmonic_configuration_mass _ _ _ _
        (by
          have hm : Measurable (fun c : FiniteMeasure ℝ =>
              ((c : Measure ℝ) (Set.Ioc α β)).toReal) :=
            ((Measure.measurable_coe measurableSet_Ioc).comp
              measurable_subtype_coe).ennreal_toReal
          simpa only [FiniteMeasure.restrict_mass, FiniteMeasure.coeFn_def,
            ENNReal.coe_toNNReal_eq_toReal] using
              (hm.const_mul (-s)).exp.stronglyMeasurable)]
      simp only [hI, neg_mul]
    _ = ∏ p ∈ fragmentPrimes W R ζ,
        (1 + (Real.exp (-(Real.log p / Real.log R) *
          h (Real.log p / Real.log R)) - 1) / (p : ℝ)) :=
      harmonic_fragment_laplace_eq_product W R ζ hR h
    _ = ∏ p ∈ (fragmentPrimes W R ζ).filter (fun p : ℕ =>
        α < Real.log p / Real.log R ∧ Real.log p / Real.log R ≤ β),
        (1 + (Real.exp (-s * (Real.log p / Real.log R)) - 1) / (p : ℝ)) := by
      rw [prod_filter]
      apply prod_congr rfl
      intro p _
      by_cases hp : α < Real.log p / Real.log R ∧ Real.log p / Real.log R ≤ β
      · simp [h, hp, mul_comm]
      · simp [h, hp]
    _ = _ := by rw [hfilter]

theorem prime_band_abel_identity (a b : ℝ) (ha : 2 ≤ a) (hab : a ≤ b)
    (f fp : ℝ → ℝ)
    (hf : ∀ t ∈ Set.Icc a b, HasDerivAt f (fp t) t)
    (hfp : ContinuousOn fp (Set.Icc a b)) :
    (∑ p ∈ (Nat.primesLE ⌊b⌋₊).filter (fun p : ℕ => a < (p : ℝ)),
      f p / (p : ℝ)) - (∫ t in a..b, f t / (t * Real.log t)) =
      f b * primeSecondError b - f a * primeSecondError a -
        ∫ t in a..b, fp t * primeSecondError t := by
  classical
  let c : ℕ → ℝ := fun n => if n.Prime then (n : ℝ)⁻¹ else 0
  let g : ℝ → ℝ := fun t => Real.log (Real.log t) + primeMertensConstant
  let gp : ℝ → ℝ := fun t => t⁻¹ / Real.log t
  have ha0 : 0 ≤ a := by linarith
  have ht1 {t : ℝ} (ht : t ∈ Set.Icc a b) : 1 < t := by
    have := ht.1
    linarith
  have hlog : ContinuousOn Real.log (Set.Icc a b) :=
    continuousOn_id.log (fun _ ht => (zero_lt_one.trans (ht1 ht)).ne')
  have hg : ContinuousOn g (Set.Icc a b) :=
    (hlog.log (fun _ ht => (Real.log_pos (ht1 ht)).ne')).add_const _
  have hgp : ContinuousOn gp (Set.Icc a b) :=
    (continuousOn_id.inv₀ (fun _ ht => (zero_lt_one.trans (ht1 ht)).ne')).div
      hlog (fun _ ht => (Real.log_pos (ht1 ht)).ne')
  have hgderiv : ∀ t ∈ Set.Icc a b, HasDerivAt g (gp t) t := by
    intro t ht
    exact ((Real.hasDerivAt_log (zero_lt_one.trans (ht1 ht)).ne').log
      (Real.log_pos (ht1 ht)).ne').add_const _
  have hderiv : IntegrableOn (deriv f) (Set.Icc a b) :=
    hfp.integrableOn_Icc.congr_fun (fun t ht => (hf t ht).deriv.symm) measurableSet_Icc
  have hc (t : ℝ) :
      (∑ n ∈ Icc 0 ⌊t⌋₊, c n) =
        ∑ p ∈ Nat.primesLE ⌊t⌋₊, (p : ℝ)⁻¹ := by
    simp only [Nat.primesLE_eq_filter_Icc_zero, sum_filter, c]
  have hset :
      (Nat.primesLE ⌊b⌋₊).filter (fun p : ℕ => a < (p : ℝ)) =
        (Ioc ⌊a⌋₊ ⌊b⌋₊).filter Nat.Prime := by
    ext p
    simp only [mem_filter, Nat.mem_primesLE, mem_Ioc, Nat.floor_lt ha0]
    tauto
  have hsum :
      (∑ p ∈ (Nat.primesLE ⌊b⌋₊).filter (fun p : ℕ => a < (p : ℝ)),
        f p / (p : ℝ)) =
      ∑ n ∈ Ioc ⌊a⌋₊ ⌊b⌋₊, f n * c n := by
    rw [hset, sum_filter]
    simp only [c, mul_ite, mul_zero, div_eq_mul_inv]
  have hAbel := sum_mul_eq_sub_sub_integral_mul c ha0 hab
    (fun t ht => (hf t ht).differentiableAt) hderiv
  rw [← hsum, ← intervalIntegral.integral_of_le hab] at hAbel
  simp only [hc] at hAbel
  have hAbel' :
      (∑ p ∈ (Nat.primesLE ⌊b⌋₊).filter (fun p : ℕ => a < (p : ℝ)),
        f p / (p : ℝ)) =
      f b * (∑ p ∈ Nat.primesLE ⌊b⌋₊, (p : ℝ)⁻¹) -
        f a * (∑ p ∈ Nat.primesLE ⌊a⌋₊, (p : ℝ)⁻¹) -
        ∫ t in a..b, fp t * ∑ p ∈ Nat.primesLE ⌊t⌋₊, (p : ℝ)⁻¹ := by
    rw [hAbel]
    congr 1
    apply intervalIntegral.integral_congr
    intro t ht
    rw [Set.uIcc_of_le hab] at ht
    dsimp only
    rw [(hf t ht).deriv]
  have hIBP := intervalIntegral.integral_mul_deriv_eq_deriv_mul
    (fun t ht => hf t (by rwa [Set.uIcc_of_le hab] at ht))
    (fun t ht => hgderiv t (by rwa [Set.uIcc_of_le hab] at ht))
    (hfp.intervalIntegrable_of_Icc hab) (hgp.intervalIntegrable_of_Icc hab)
  have hbase : (∫ t in a..b, f t / (t * Real.log t)) =
      ∫ t in a..b, f t * gp t := by
    apply intervalIntegral.integral_congr
    intro t _
    dsimp only [gp]
    ring
  have hS : IntervalIntegrable
      (fun t => fp t * ∑ p ∈ Nat.primesLE ⌊t⌋₊, (p : ℝ)⁻¹) volume a b := by
    rw [intervalIntegrable_iff_integrableOn_Icc_of_le hab]
    simpa only [hc] using integrableOn_mul_sum_Icc c (m := 0) ha0 hfp.integrableOn_Icc
  have hG : IntervalIntegrable (fun t => fp t * g t) volume a b :=
    (hfp.mul hg).intervalIntegrable_of_Icc hab
  have hE :
      (∫ t in a..b, fp t * primeSecondError t) =
      (∫ t in a..b, fp t * ∑ p ∈ Nat.primesLE ⌊t⌋₊, (p : ℝ)⁻¹) -
        ∫ t in a..b, fp t * g t := by
    rw [← intervalIntegral.integral_sub hS hG]
    apply intervalIntegral.integral_congr
    intro t _
    dsimp only [primeSecondError, g]
    ring
  rw [hAbel', hbase, hIBP, hE]
  dsimp only [primeSecondError, g]
  ring

theorem prime_band_exponential_error (α β s : ℝ)
    (hα : 0 < α) (hαβ : α ≤ β) :
    ∃ C : ℝ, 0 < C ∧ ∀ R : ℝ, 1 < R → 2 ≤ R ^ α →
      |(∑ p ∈ (Nat.primesLE ⌊R ^ β⌋₊).filter
          (fun p : ℕ => R ^ α < (p : ℝ)),
          (Real.exp (-s * (Real.log p / Real.log R)) - 1) / (p : ℝ)) -
        ∫ u in α..β, (Real.exp (-s * u) - 1) / u| ≤ C / Real.log R := by
  obtain ⟨C, hC, herror⟩ := prime_second_error_bounded
  let K : ℝ := Real.exp (|s| * β) + 1
  have hK : 0 < K := by dsimp only [K]; positivity
  have hβ : 0 < β := hα.trans_le hαβ
  have hlogβα : 0 ≤ Real.log (β / α) :=
    Real.log_nonneg ((one_le_div hα).mpr hαβ)
  refine ⟨2 * K * C / α + |s| * K * C * Real.log (β / α), by positivity,
    fun R hR hA => ?_⟩
  let A : ℝ := R ^ α
  let B : ℝ := R ^ β
  let f : ℝ → ℝ := fun t => Real.exp (-s * (Real.log t / Real.log R)) - 1
  let fp : ℝ → ℝ := fun t =>
    Real.exp (-s * (Real.log t / Real.log R)) * (-s * (t⁻¹ / Real.log R))
  have hR0 : 0 < R := zero_lt_one.trans hR
  have hlogR : 0 < Real.log R := Real.log_pos hR
  have hAB : A ≤ B := Real.rpow_le_rpow_of_exponent_le hR.le hαβ
  have ht1 {t : ℝ} (ht : t ∈ Set.Icc A B) : 1 < t := by
    have := ht.1
    change R ^ α ≤ t at this
    linarith
  have hlogc : ContinuousOn Real.log (Set.Icc A B) :=
    continuousOn_id.log (fun _ ht => (zero_lt_one.trans (ht1 ht)).ne')
  have hf : ∀ t ∈ Set.Icc A B, HasDerivAt f (fp t) t := by
    intro t ht
    exact ((((Real.hasDerivAt_log (zero_lt_one.trans (ht1 ht)).ne').div_const
      (Real.log R)).const_mul (-s)).exp).sub_const 1
  have hfp : ContinuousOn fp (Set.Icc A B) :=
    ((hlogc.div_const _).const_mul (-s)).rexp.mul
      (((continuousOn_id.inv₀
        (fun _ ht => (zero_lt_one.trans (ht1 ht)).ne')).div_const _).const_mul (-s))
  have hkernel : ContinuousOn (fun t : ℝ => t⁻¹ / Real.log t) (Set.Icc A B) :=
    (continuousOn_id.inv₀ (fun _ ht => (zero_lt_one.trans (ht1 ht)).ne')).div
      hlogc (fun _ ht => (Real.log_pos (ht1 ht)).ne')
  have hexp {t : ℝ} (ht : t ∈ Set.Icc A B) :
      Real.exp (-s * (Real.log t / Real.log R)) ≤ Real.exp (|s| * β) := by
    have hu0 : 0 ≤ Real.log t / Real.log R :=
      (div_pos (Real.log_pos (ht1 ht)) hlogR).le
    have huβ : Real.log t / Real.log R ≤ β := by
      apply (div_le_iff₀ hlogR).mpr
      have hl := Real.log_le_log (zero_lt_one.trans (ht1 ht)) ht.2
      simpa only [B, Real.log_rpow hR0] using hl
    exact Real.exp_le_exp.mpr
      ((mul_le_mul_of_nonneg_right (neg_le_abs s) hu0).trans
        (mul_le_mul_of_nonneg_left huβ (abs_nonneg s)))
  have hfbound {t : ℝ} (ht : t ∈ Set.Icc A B) : |f t| ≤ K := by
    calc
      |f t| ≤ |Real.exp (-s * (Real.log t / Real.log R))| + |(1 : ℝ)| := abs_sub _ _
      _ = Real.exp (-s * (Real.log t / Real.log R)) + 1 := by
        rw [Real.abs_exp, abs_one]
      _ ≤ K := add_le_add (hexp ht) le_rfl
  have he {t : ℝ} (ht : t ∈ Set.Icc A B) :
      |primeSecondError t| ≤ C / (α * Real.log R) := by
    have hAt : 2 ≤ t := hA.trans ht.1
    apply (herror t hAt).trans
    apply div_le_div_of_nonneg_left hC.le (mul_pos hα hlogR)
    have hl := Real.log_le_log (Real.rpow_pos_of_pos hR0 α) ht.1
    simpa only [A, Real.log_rpow hR0] using hl
  have hkerIntegral :
      (∫ t in A..B, t⁻¹ / Real.log t) = Real.log (β / α) := by
    rw [integral_inv_div_log (ht1 ⟨le_rfl, hAB⟩)
      (ht1 ⟨hAB, le_rfl⟩)]
    dsimp only [A, B]
    rw [Real.log_rpow hR0, Real.log_rpow hR0,
      Real.log_mul hβ.ne' hlogR.ne', Real.log_mul hα.ne' hlogR.ne',
      Real.log_div hβ.ne' hα.ne']
    ring
  have hint :
      |∫ t in A..B, fp t * primeSecondError t| ≤
        (|s| * K * C / Real.log R) * Real.log (β / α) := by
    calc
      _ ≤ ∫ t in A..B, (|s| * K * C / Real.log R) * (t⁻¹ / Real.log t) := by
        rw [← Real.norm_eq_abs]
        apply intervalIntegral.norm_integral_le_of_norm_le hAB
          (Filter.Eventually.of_forall ?_)
          ((hkernel.intervalIntegrable_of_Icc hAB).const_mul _)
        intro t ht
        have hti : t ∈ Set.Icc A B := ⟨ht.1.le, ht.2⟩
        have ht0 : 0 < t := zero_lt_one.trans (ht1 hti)
        have hlogt : 0 < Real.log t := Real.log_pos (ht1 hti)
        have hfpabs :
            |fp t| = Real.exp (-s * (Real.log t / Real.log R)) *
              (|s| * (t⁻¹ / Real.log R)) := by
          dsimp only [fp]
          rw [abs_mul, Real.abs_exp, abs_mul, abs_neg,
            abs_div, abs_inv, abs_of_pos ht0, abs_of_pos hlogR]
        rw [Real.norm_eq_abs, abs_mul, hfpabs]
        calc
          _ ≤ (K * (|s| * (t⁻¹ / Real.log R))) * (C / Real.log t) :=
            mul_le_mul
              (mul_le_mul_of_nonneg_right
                ((hexp hti).trans (le_add_of_nonneg_right zero_le_one)) (by positivity))
              (herror t (hA.trans hti.1)) (abs_nonneg _) (by positivity)
          _ = _ := by ring
      _ = _ := by rw [intervalIntegral.integral_const_mul, hkerIntegral]
  have hsub :
      (∫ t in A..B, f t / (t * Real.log t)) =
        ∫ u in α..β, (Real.exp (-s * u) - 1) / u :=
    integral_logarithmic_band_substitution R α β s hR hα hαβ
  have hid := prime_band_abel_identity A B hA hAB f fp hf hfp
  rw [hsub] at hid
  change |(∑ p ∈ (Nat.primesLE ⌊B⌋₊).filter (fun p : ℕ => A < (p : ℝ)),
    f p / (p : ℝ)) - ∫ u in α..β, (Real.exp (-s * u) - 1) / u| ≤ _
  rw [hid]
  calc
    _ ≤ |f B * primeSecondError B| + |f A * primeSecondError A| +
        |∫ t in A..B, fp t * primeSecondError t| :=
      (abs_sub _ _).trans (add_le_add (abs_sub _ _) le_rfl)
    _ ≤ K * (C / (α * Real.log R)) + K * (C / (α * Real.log R)) +
        (|s| * K * C / Real.log R) * Real.log (β / α) := by
      rw [abs_mul, abs_mul]
      exact add_le_add
        (add_le_add
          (mul_le_mul (hfbound ⟨hAB, le_rfl⟩) (he ⟨hAB, le_rfl⟩)
            (abs_nonneg _) hK.le)
          (mul_le_mul (hfbound ⟨le_rfl, hAB⟩) (he ⟨le_rfl, hAB⟩)
            (abs_nonneg _) hK.le)) hint
    _ = _ := by ring

theorem presieved_prime_exponential_band_tendsto
    (H : Finset ℕ) (ρ α β s : ℝ)
    (hρ : 0 < ρ) (hα : 0 < α) (hαβ : α ≤ β) :
    Tendsto
      (fun x : ℝ =>
        ∑ p ∈ (fragmentPrimes (presievingModulus H x) (x ^ ρ) β).filter
          (fun p : ℕ => (x ^ ρ) ^ α < (p : ℝ)),
          (Real.exp (-s * (Real.log p / Real.log (x ^ ρ))) - 1) / (p : ℝ))
      atTop (nhds (∫ u in α..β, (Real.exp (-s * u) - 1) / u)) := by
  obtain ⟨C, _, hbound⟩ := prime_band_exponential_error α β s hα hαβ
  have hR := tendsto_rpow_atTop hρ
  have hA := (tendsto_rpow_atTop hα).comp hR
  let I : ℝ := ∫ u in α..β, (Real.exp (-s * u) - 1) / u
  have he :
      Tendsto
        (fun x : ℝ =>
          (∑ p ∈ (Nat.primesLE ⌊(x ^ ρ) ^ β⌋₊).filter
            (fun p : ℕ => (x ^ ρ) ^ α < (p : ℝ)),
            (Real.exp (-s * (Real.log p / Real.log (x ^ ρ))) - 1) / (p : ℝ)) - I)
        atTop (nhds 0) := by
    rw [tendsto_zero_iff_abs_tendsto_zero]
    apply squeeze_zero' (Eventually.of_forall (fun _ => abs_nonneg _))
    · filter_upwards [hR.eventually_gt_atTop 1, hA.eventually_ge_atTop 2] with x hx hAx
      exact hbound (x ^ ρ) hx hAx
    · simpa only [div_eq_mul_inv, Pi.inv_apply, Function.comp_def, mul_zero] using
        (tendsto_log_atTop.comp hR).inv_tendsto_atTop.const_mul C
  have hlim := he.add_const I
  simp only [zero_add, sub_add_cancel] at hlim
  apply hlim.congr'
  filter_upwards [eventually_gt_atTop (0 : ℝ),
    eventually_presieving_factor_lt_rpow H (ρ * α) (mul_pos hρ hα)] with x hx hsmall
  have hsmall' : ∀ p ∈ (presievingModulus H x).primeFactors,
      (p : ℝ) < (x ^ ρ) ^ α := by
    intro p hp
    simpa only [Real.rpow_mul hx.le] using hsmall p hp
  have hset :
      (fragmentPrimes (presievingModulus H x) (x ^ ρ) β).filter
        (fun p : ℕ => (x ^ ρ) ^ α < (p : ℝ)) =
      (Nat.primesLE ⌊(x ^ ρ) ^ β⌋₊).filter
        (fun p : ℕ => (x ^ ρ) ^ α < (p : ℝ)) := by
    ext p
    simp only [fragmentPrimes, mem_filter]
    constructor
    · rintro ⟨⟨hp, _⟩, hlow⟩
      exact ⟨hp, hlow⟩
    · rintro ⟨hp, hlow⟩
      refine ⟨⟨hp, ?_⟩, hlow⟩
      intro hd
      have hm := (Nat.prime_of_mem_primesLE hp).mem_primeFactors hd (presieving_pos H x).ne'
      exact (hsmall' p hm).not_ge hlow.le
  rw [hset]

theorem presieved_prime_band_product_tendsto
    (H : Finset ℕ) (ρ α β s : ℝ)
    (hρ : 0 < ρ) (hα : 0 < α) (hαβ : α ≤ β) :
    Tendsto
      (fun x : ℝ =>
        ∏ p ∈ (fragmentPrimes (presievingModulus H x) (x ^ ρ) β).filter
          (fun p : ℕ => (x ^ ρ) ^ α < (p : ℝ)),
          (1 + (Real.exp (-s * (Real.log p / Real.log (x ^ ρ))) - 1) / (p : ℝ)))
      atTop (nhds (Real.exp (∫ u in α..β, (Real.exp (-s * u) - 1) / u))) := by
  classical
  let S (x : ℝ) :=
    (fragmentPrimes (presievingModulus H x) (x ^ ρ) β).filter
      (fun p : ℕ => (x ^ ρ) ^ α < (p : ℝ))
  let z (x : ℝ) (p : ℕ) :=
    (Real.exp (-s * (Real.log p / Real.log (x ^ ρ))) - 1) / (p : ℝ)
  let T (x : ℝ) (p : ℕ) :=
    if Nat.Prime p ∧ ¬p ∣ presievingModulus H x then 1 / (p : ℝ) ^ 2 else 0
  let K : ℝ := Real.exp (|s| * β) + 1
  let C : ℝ := 2 * K ^ 2
  have hK : 0 < K := by dsimp only [K]; positivity
  have hC : 0 ≤ C := by dsimp only [C]; positivity
  have hTnonneg (x : ℝ) (p : ℕ) : 0 ≤ T x p := by
    dsimp only [T]
    positivity
  have hTsummable (x : ℝ) : Summable (T x) := by
    exact (Real.summable_one_div_nat_pow.mpr
      (by norm_num : 1 < (2 : ℕ))).summable_of_eq_zero_or_self
      (fun p => by dsimp only [T]; split_ifs <;> simp)
  have hrem (a : ℝ) (ha : |a| ≤ (1 : ℝ) / 2) :
      |Real.log (1 + a) - a| ≤ 2 * a ^ 2 := by
    have hseries :=
      Real.abs_log_sub_add_sum_range_le (x := -a) (by rw [abs_neg]; linarith) 1
    calc
      _ ≤ a ^ 2 / (1 - |a|) := by
        simpa [sub_eq_add_neg, add_comm] using hseries
      _ ≤ a ^ 2 / ((1 : ℝ) / 2) :=
        div_le_div_of_nonneg_left (sq_nonneg a) (by norm_num) (by linarith)
      _ = _ := by ring
  have hR := tendsto_rpow_atTop hρ
  have hA := (tendsto_rpow_atTop hα).comp hR
  have hbound :
      ∀ᶠ x : ℝ in atTop,
        |(∑ p ∈ S x, Real.log (1 + z x p)) - ∑ p ∈ S x, z x p| ≤
          C * ∑' p : ℕ, T x p := by
    filter_upwards [hR.eventually_gt_atTop 1, hA.eventually_gt_atTop (2 * K)]
      with x hx hsmall
    have hlogR : 0 < Real.log (x ^ ρ) := Real.log_pos hx
    have hpoint (p : ℕ) (hp : p ∈ S x) :
        |Real.log (1 + z x p) - z x p| ≤ C * T x p := by
      rcases mem_filter.mp hp with ⟨hfrag, hlow⟩
      rcases mem_filter.mp hfrag with ⟨hpB, hndvd⟩
      have hprime := Nat.prime_of_mem_primesLE hpB
      have hp0 : 0 < (p : ℝ) := by exact_mod_cast hprime.pos
      have hp1 : 1 < (p : ℝ) := by exact_mod_cast hprime.one_lt
      have hpupper : (p : ℝ) ≤ (x ^ ρ) ^ β :=
        (Nat.le_floor_iff' hprime.ne_zero).mp (Nat.mem_primesLE.mp hpB).1
      have hu0 : 0 ≤ Real.log p / Real.log (x ^ ρ) :=
        (div_pos (Real.log_pos hp1) hlogR).le
      have huβ : Real.log p / Real.log (x ^ ρ) ≤ β := by
        apply (div_le_iff₀ hlogR).mpr
        have hl := Real.log_le_log hp0 hpupper
        simpa only [Real.log_rpow (zero_lt_one.trans hx)] using hl
      have hnumerator :
          |Real.exp (-s * (Real.log p / Real.log (x ^ ρ))) - 1| ≤ K := by
        calc
          _ ≤ |Real.exp (-s * (Real.log p / Real.log (x ^ ρ)))| + |(1 : ℝ)| :=
            abs_sub _ _
          _ = Real.exp (-s * (Real.log p / Real.log (x ^ ρ))) + 1 := by
            rw [Real.abs_exp, abs_one]
          _ ≤ K := add_le_add
            (Real.exp_le_exp.mpr
              ((mul_le_mul_of_nonneg_right (neg_le_abs s) hu0).trans
                (mul_le_mul_of_nonneg_left huβ (abs_nonneg s)))) le_rfl
      have hz : |z x p| ≤ K / (p : ℝ) := by
        dsimp only [z]
        rw [abs_div, abs_of_pos hp0]
        exact div_le_div_of_nonneg_right hnumerator hp0.le
      have hzhalf : |z x p| ≤ (1 : ℝ) / 2 :=
        hz.trans ((div_le_iff₀ hp0).mpr (by linarith [hsmall.trans hlow]))
      have hzsq : (z x p) ^ 2 ≤ (K / (p : ℝ)) ^ 2 := by
        simpa only [sq_abs] using
          (sq_le_sq₀ (abs_nonneg (z x p)) (div_nonneg hK.le hp0.le)).mpr hz
      calc
        _ ≤ 2 * (z x p) ^ 2 := hrem _ hzhalf
        _ ≤ 2 * (K / (p : ℝ)) ^ 2 := mul_le_mul_of_nonneg_left hzsq (by norm_num)
        _ = C * T x p := by
          dsimp only [C, T]
          rw [ite_eq_left (And.intro hprime hndvd)]
          ring
    rw [← sum_sub_distrib]
    calc
      _ ≤ ∑ p ∈ S x, |Real.log (1 + z x p) - z x p| := abs_sum_le_sum_abs _ _
      _ ≤ ∑ p ∈ S x, C * T x p := sum_le_sum hpoint
      _ = C * ∑ p ∈ S x, T x p := by rw [mul_sum]
      _ ≤ C * ∑' p : ℕ, T x p :=
        mul_le_mul_of_nonneg_left
          ((hTsummable x).sum_le_tsum (S x) (fun p _ => hTnonneg x p)) hC
  have he :
      Tendsto
        (fun x : ℝ => (∑ p ∈ S x, Real.log (1 + z x p)) - ∑ p ∈ S x, z x p)
        atTop (nhds 0) := by
    rw [tendsto_zero_iff_abs_tendsto_zero]
    apply squeeze_zero' (Eventually.of_forall (fun _ => abs_nonneg _)) hbound
    simpa only [T, mul_zero] using (presieved_prime_square_tail_tendsto H).const_mul C
  have hweighted :
      Tendsto (fun x : ℝ => ∑ p ∈ S x, z x p) atTop
        (nhds (∫ u in α..β, (Real.exp (-s * u) - 1) / u)) :=
    presieved_prime_exponential_band_tendsto H ρ α β s hρ hα hαβ
  have hlogs := he.add hweighted
  simp only [sub_add_cancel, zero_add] at hlogs
  apply hlogs.rexp.congr
  intro x
  change Real.exp (∑ p ∈ S x, Real.log (1 + z x p)) = ∏ p ∈ S x, (1 + z x p)
  rw [Real.exp_sum]
  apply prod_congr rfl
  intro p hp
  apply Real.exp_log
  have hprime := Nat.prime_of_mem_primesLE (mem_filter.mp (mem_filter.mp hp).1).1
  have hp1 : 1 < (p : ℝ) := by exact_mod_cast hprime.one_lt
  have hp0 : 0 < (p : ℝ) := by exact_mod_cast hprime.pos
  have hfactor :
      1 + z x p =
        ((p : ℝ) - 1 + Real.exp (-s * (Real.log p / Real.log (x ^ ρ)))) / (p : ℝ) := by
    dsimp only [z]
    field
  rw [hfactor]
  exact div_pos (add_pos_of_pos_of_nonneg (sub_pos.mpr hp1) (Real.exp_pos _).le) hp0

theorem harmonic_fragment_band_laplace_tendsto
    (H : Finset ℕ) (ρ ζ α β s : ℝ)
    (hρ : 0 < ρ) (hζ : 0 < ζ) (hα : 0 < α)
    (hαβ : α ≤ β) (hβζ : β ≤ ζ) :
    Filter.Tendsto
      (fun x : ℝ =>
        let W := presievingModulus H x
        let R := x ^ ρ
        let L : ℝ :=
          ∫ c : FiniteMeasure ℝ,
            Real.exp (-s * ((c.restrict (Set.Ioc α β)).mass : ℝ))
            ∂(harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ))
        (L / harmonicFragmentMass W R ζ, L / fragmentNormalization W R))
      Filter.atTop
      (nhds
        (Real.exp (∫ u in α..β, (Real.exp (-s * u) - 1) / u),
          (Real.exp Real.eulerMascheroniConstant * ζ) *
            Real.exp (∫ u in α..β, (Real.exp (-s * u) - 1) / u))) := by
  let L (x : ℝ) : ℝ :=
    ∫ c : FiniteMeasure ℝ,
      Real.exp (-s * ((c.restrict (Set.Ioc α β)).mass : ℝ))
      ∂(harmonicConfigurationMass (presievingModulus H x) (x ^ ρ) ζ :
        Measure (FiniteMeasure ℝ))
  have hL :
      Tendsto
        (fun x : ℝ => L x / harmonicFragmentMass (presievingModulus H x) (x ^ ρ) ζ)
        atTop (nhds (Real.exp (∫ u in α..β, (Real.exp (-s * u) - 1) / u))) := by
    apply (presieved_prime_band_product_tendsto H ρ α β s hρ hα hαβ).congr'
    filter_upwards [(tendsto_rpow_atTop hρ).eventually_gt_atTop 1] with x hx
    exact (harmonic_band_laplace_eq_product (presievingModulus H x)
      (x ^ ρ) ζ α β s hx hβζ).symm
  have hpair := hL.prodMk_nhds ((harmonic_fragment_normalizer_tendsto H ρ ζ hρ hζ).mul hL)
  apply hpair.congr
  intro x
  exact Prod.ext rfl (div_mul_div_cancel₀'
    (harmonic_fragment_mass_pos (presievingModulus H x) (x ^ ρ) ζ).ne' _ _)

end

theorem coe_weightedEmpirical (n : ℕ) (x : Fin n → ℝ) :
    (weightedEmpirical n x : Measure ℝ) =
      ∑ i : Fin n, ENNReal.ofReal (x i) • Measure.dirac (x i) := by
  unfold weightedEmpirical
  rw [FiniteMeasure.toMeasure_sum]
  rfl

theorem measurable_weightedEmpirical (n : ℕ) : Measurable (weightedEmpirical n) := by
  have hm : Measurable (fun x : Fin n → ℝ => (weightedEmpirical n x : Measure ℝ)) := by
    apply Measure.measurable_of_measurable_coe
    intro s hs
    simp only [coe_weightedEmpirical, Measure.finsetSum_apply, Measure.smul_apply,
      smul_eq_mul, Measure.dirac_apply' _ hs]
    fun_prop
  exact hm.subtype_mk

theorem measurable_weightedEmpirical_sample :
    Measurable (fun p : ℕ × (ℕ → ℝ) =>
      weightedEmpirical p.1 (fun i : Fin p.1 => p.2 i.val)) := by
  refine measurable_from_prod_countable_right fun n => ?_
  exact (measurable_weightedEmpirical n).comp (by fun_prop)

theorem coe_eq_mass_smul_normalize (μ : FiniteMeasure ℝ) :
    (μ : Measure ℝ) = (μ.mass : ℝ≥0∞) • (μ.normalize : Measure ℝ) :=
  congrArg (fun ν : FiniteMeasure ℝ => (ν : Measure ℝ)) μ.self_eq_mass_smul_normalize

theorem lintegral_finitePoissonLaw_normalized
    (μ : FiniteMeasure ℝ) (F : FiniteMeasure ℝ → ℝ≥0∞) (hF : Measurable F) :
    ∫⁻ c, F c ∂(finitePoissonLaw μ) =
      ∫⁻ n, ∫⁻ x : Fin n → ℝ, F (weightedEmpirical n x)
        ∂(Measure.pi (fun _ : Fin n => (μ.normalize : Measure ℝ)))
        ∂(ProbabilityTheory.poissonMeasure μ.mass) := by
  unfold finitePoissonLaw
  rw [lintegral_map hF measurable_weightedEmpirical_sample,
    lintegral_prod (fun p : ℕ × (ℕ → ℝ) =>
      F (weightedEmpirical p.1 (fun i => p.2 i)))
      (hF.comp measurable_weightedEmpirical_sample).aemeasurable]
  apply lintegral_congr
  intro n
  rw [← Measure.infinitePi_eq_pi,
    ← Measure.map_infinitePi_infinitePi_of_inj
      (P := fun _ : ℕ => (μ.normalize : Measure ℝ)) (f := fun i : Fin n => i.val)
      Fin.val_injective,
    lintegral_map (f := fun x => F (weightedEmpirical n x))
      (hF.comp (measurable_weightedEmpirical n)) (by fun_prop)]

theorem lintegral_weightedEmpirical_pi (μ : FiniteMeasure ℝ) (n : ℕ)
    (h : ℝ → ℝ≥0∞) (hh : Measurable h) :
    (∫⁻ x : Fin n → ℝ, ∫⁻ u, h u ∂(weightedEmpirical n x : Measure ℝ)
      ∂(Measure.pi (fun _ : Fin n => (μ.normalize : Measure ℝ)))) =
      (n : ℝ≥0∞) * ∫⁻ u, ENNReal.ofReal u * h u ∂(μ.normalize : Measure ℝ) := by
  simp_rw [coe_weightedEmpirical, lintegral_finsetSum_measure, lintegral_smul_measure,
    lintegral_dirac, smul_eq_mul]
  rw [lintegral_finsetSum Finset.univ (by fun_prop)]
  simpa using Finset.sum_eq_card_nsmul (s := Finset.univ) (fun i _ =>
    (measurePreserving_eval (fun _ : Fin n => (μ.normalize : Measure ℝ)) i).lintegral_comp
      (measurable_id.ennreal_ofReal.mul hh))

theorem poisson_singleton_succ (r : ℝ≥0) (n : ℕ) :
    ((n + 1 : ℕ) : ℝ≥0∞) * ProbabilityTheory.poissonMeasure r {n + 1} =
      (r : ℝ≥0∞) * ProbabilityTheory.poissonMeasure r {n} := by
  have hreal : ((n + 1 : ℕ) : ℝ) *
      (Real.exp (-(r : ℝ)) * (r : ℝ) ^ (n + 1) / (n + 1).factorial) =
      (r : ℝ) * (Real.exp (-(r : ℝ)) * (r : ℝ) ^ n / n.factorial) := by
    rw [Nat.factorial_succ, Nat.cast_mul, pow_succ]
    field_simp
  simpa only [ENNReal.ofReal_mul (by positivity : 0 ≤ ((n + 1 : ℕ) : ℝ)),
    ENNReal.ofReal_mul r.coe_nonneg, ENNReal.ofReal_natCast, ENNReal.ofReal_coe_nnreal,
    ProbabilityTheory.poissonMeasure_singleton] using congrArg ENNReal.ofReal hreal

theorem lintegral_poisson_id (r : ℝ≥0) :
    ∫⁻ n : ℕ, (n : ℝ≥0∞) ∂(ProbabilityTheory.poissonMeasure r) = (r : ℝ≥0∞) := by
  have hsum : ∑' n : ℕ, ProbabilityTheory.poissonMeasure r {n} = 1 := by
    simpa using (lintegral_countable' (μ := ProbabilityTheory.poissonMeasure r)
      (fun _ : ℕ => (1 : ℝ≥0∞))).symm
  rw [lintegral_countable', tsum_eq_zero_add' ENNReal.summable]
  simp only [Nat.cast_zero, zero_mul, zero_add, poisson_singleton_succ]
  rw [ENNReal.tsum_mul_left, hsum, mul_one]

theorem lintegral_weighted_finitePoissonLaw
    (μ : FiniteMeasure ℝ) (h : ℝ → ℝ≥0∞) (hh : Measurable h) :
    (∫⁻ c, ∫⁻ u, h u ∂(c : Measure ℝ) ∂(finitePoissonLaw μ)) =
      ∫⁻ u, ENNReal.ofReal u * h u ∂(μ : Measure ℝ) := by
  rw [lintegral_finitePoissonLaw_normalized μ
    (fun c => ∫⁻ u, h u ∂(c : Measure ℝ))
    ((Measure.measurable_lintegral hh).comp measurable_subtype_coe)]
  simp_rw [lintegral_weightedEmpirical_pi μ _ h hh]
  rw [lintegral_mul_const _ (by fun_prop), lintegral_poisson_id,
    coe_eq_mass_smul_normalize μ, lintegral_smul_measure, smul_eq_mul]

theorem finitePoissonLaw_isProbabilityMeasure (μ : FiniteMeasure ℝ) :
    IsProbabilityMeasure (finitePoissonLaw μ) := by
  unfold finitePoissonLaw
  infer_instance

theorem measurable_fragment_sum :
    Measurable (fun ω : ℤ → FiniteMeasure ℝ =>
      Measure.sum (fun k : ℤ => (ω k : Measure ℝ))) := by
  apply Measure.measurable_of_measurable_coe
  intro s hs
  simp only [Measure.sum_apply _ hs]
  exact Measurable.tsum fun k => (Measure.measurable_coe hs).comp
    (measurable_subtype_coe.comp (measurable_pi_apply k))

theorem measurable_finiteFragments : Measurable finiteFragments := by
  classical
  have hg : Measurable (fun ω : {ω : ℤ → FiniteMeasure ℝ |
      IsFiniteMeasure (Measure.sum (fun k : ℤ => (ω k : Measure ℝ)))} =>
      (⟨Measure.sum (fun k : ℤ => (ω.val k : Measure ℝ)), ω.property⟩ : FiniteMeasure ℝ)) :=
    (measurable_fragment_sum.comp measurable_subtype_coe).subtype_mk
  unfold finiteFragments
  exact hg.dite (g := fun _ => (0 : FiniteMeasure ℝ)) measurable_const
    (FiniteMeasure.measurableSet_isFiniteMeasure.preimage measurable_fragment_sum)

theorem dyadic_bands_disjoint :
    Pairwise (fun i j : ℤ => Disjoint
      (Set.Ioc ((2 : ℝ) ^ i) ((2 : ℝ) ^ (i + 1)))
      (Set.Ioc ((2 : ℝ) ^ j) ((2 : ℝ) ^ (j + 1)))) :=
  (zpow_right_mono₀ (by norm_num : (1 : ℝ) ≤ 2)).pairwise_disjoint_on_Ioc_succ

theorem iUnion_dyadic_bands :
    (⋃ k : ℤ, Set.Ioc ((2 : ℝ) ^ k) ((2 : ℝ) ^ (k + 1))) = Set.Ioi 0 := by
  ext u
  simp only [Set.mem_iUnion, Set.mem_Ioi]
  constructor
  · rintro ⟨k, hk⟩
    exact (zpow_pos (by norm_num) k).trans hk.1
  · exact fun hu => exists_mem_Ioc_zpow hu (by norm_num : (1 : ℝ) < 2)

theorem sum_cappedDyadicIntensity (ζ : ℝ) :
    Measure.sum (fun k : ℤ => (cappedDyadicIntensity ζ k : Measure ℝ)) =
      (volume.restrict (Set.Ioc (0 : ℝ) ζ)).withDensity
        (fun u : ℝ => ENNReal.ofReal (1 / u)) := by
  change Measure.sum (fun k : ℤ =>
    ((volume.restrict (Set.Ioc (0 : ℝ) ζ)).withDensity
      (fun u : ℝ => ENNReal.ofReal (1 / u))).restrict
      (Set.Ioc ((2 : ℝ) ^ k) ((2 : ℝ) ^ (k + 1)))) = _
  rw [← Measure.restrict_iUnion dyadic_bands_disjoint (fun _ => measurableSet_Ioc),
    iUnion_dyadic_bands, restrict_withDensity measurableSet_Ioi,
    Measure.restrict_restrict measurableSet_Ioi,
    Set.inter_eq_right.mpr (fun _ hu => hu.1)]

theorem lintegral_fragment_sum (ζ : ℝ) (h : ℝ → ℝ≥0∞) (hh : Measurable h) :
    (∫⁻ ω, ∫⁻ u, h u ∂(Measure.sum (fun k : ℤ => (ω k : Measure ℝ)))
      ∂(Measure.infinitePi (fun k : ℤ =>
        finitePoissonLaw (cappedDyadicIntensity ζ k)))) =
      ∫⁻ u in Set.Ioc (0 : ℝ) ζ, h u ∂volume := by
  let : ∀ k : ℤ, IsProbabilityMeasure (finitePoissonLaw (cappedDyadicIntensity ζ k)) :=
    fun k => finitePoissonLaw_isProbabilityMeasure _
  have hm : Measurable (fun c : FiniteMeasure ℝ => ∫⁻ u, h u ∂(c : Measure ℝ)) :=
    (Measure.measurable_lintegral hh).comp measurable_subtype_coe
  simp_rw [lintegral_sum_measure]
  rw [lintegral_tsum (f := fun k : ℤ => fun ω : ℤ → FiniteMeasure ℝ =>
    ∫⁻ u, h u ∂(ω k : Measure ℝ))
    (fun k => (hm.comp (measurable_pi_apply k)).aemeasurable)]
  have he (k : ℤ) := (measurePreserving_eval_infinitePi
      (fun j : ℤ => finitePoissonLaw (cappedDyadicIntensity ζ j)) k).lintegral_comp hm
  simp_rw [he, lintegral_weighted_finitePoissonLaw _ h hh]
  rw [← lintegral_sum_measure, sum_cappedDyadicIntensity,
    lintegral_withDensity_eq_lintegral_mul _
      (f := fun u : ℝ => ENNReal.ofReal (1 / u))
      (g := fun u : ℝ => ENNReal.ofReal u * h u) (by fun_prop) (by fun_prop)]
  apply lintegral_congr_ae
  filter_upwards [ae_restrict_mem measurableSet_Ioc] with u hu
  have hu0 : 0 < u := hu.1
  change ENNReal.ofReal (1 / u) * (ENNReal.ofReal u * h u) = h u
  rw [← mul_assoc, ← ENNReal.ofReal_mul (le_of_lt (one_div_pos.mpr hu0)),
    one_div_mul_cancel hu0.ne', ENNReal.ofReal_one, one_mul]

theorem ae_isFiniteMeasure_fragment_sum (ζ : ℝ) :
    ∀ᵐ ω ∂(Measure.infinitePi (fun k : ℤ =>
      finitePoissonLaw (cappedDyadicIntensity ζ k))),
      IsFiniteMeasure (Measure.sum (fun k : ℤ => (ω k : Measure ℝ))) := by
  have hm : Measurable (fun ω : ℤ → FiniteMeasure ℝ =>
      (Measure.sum (fun k : ℤ => (ω k : Measure ℝ))) Set.univ) :=
    (Measure.measurable_coe MeasurableSet.univ).comp measurable_fragment_sum
  have he := lintegral_fragment_sum ζ (fun _ => 1) measurable_const
  simp only [lintegral_one, Measure.restrict_apply_univ, Real.volume_Ioc, sub_zero] at he
  filter_upwards [ae_lt_top hm (by rw [he]; exact ENNReal.ofReal_ne_top)] with ω hω
  exact ⟨hω⟩

theorem fragmentLaw_isProbabilityMeasure (ζ : ℝ) : IsProbabilityMeasure (fragmentLaw ζ) := by
  let : ∀ k : ℤ, IsProbabilityMeasure (finitePoissonLaw (cappedDyadicIntensity ζ k)) :=
    fun k => finitePoissonLaw_isProbabilityMeasure _
  unfold fragmentLaw
  infer_instance

theorem exp_neg_ennreal_sum {ι : Type*} (s : Finset ι) (f : ι → ℝ≥0∞) :
    EReal.exp (-((∑ i ∈ s, f i : ℝ≥0∞) : EReal)) =
      ∏ i ∈ s, EReal.exp (-((f i : ℝ≥0∞) : EReal)) := by
  classical
  induction s using Finset.induction_on with
  | empty => simp
  | @insert i s hi ih =>
    rw [Finset.sum_insert hi, EReal.coe_ennreal_add,
      EReal.neg_add (.inl (EReal.coe_ennreal_ne_bot _))
        (.inr (EReal.coe_ennreal_ne_bot _)),
      sub_eq_add_neg, EReal.exp_add, ih, Finset.prod_insert hi]

theorem lintegral_exp_neg_finitePoissonLaw
    (μ : FiniteMeasure ℝ) (h : ℝ → ℝ≥0∞) (hh : Measurable h) :
    (∫⁻ c, EReal.exp (-((∫⁻ u, h u ∂(c : Measure ℝ)) : EReal))
      ∂(finitePoissonLaw μ)) =
      EReal.exp (-((∫⁻ u,
        1 - EReal.exp (-((ENNReal.ofReal u * h u : ℝ≥0∞) : EReal))
        ∂(μ : Measure ℝ)) : EReal)) := by
  let g : ℝ → ℝ≥0∞ := fun u =>
    EReal.exp (-((ENNReal.ofReal u * h u : ℝ≥0∞) : EReal))
  have hg : Measurable g :=
    (measurable_id.ennreal_ofReal.mul hh).coe_ereal_ennreal.neg.ereal_exp
  have hg_one (u : ℝ) : g u ≤ 1 :=
    EReal.exp_le_one_iff.2
      (EReal.neg_le_zero.2 (EReal.coe_ennreal_nonneg _))
  let q : ℝ≥0∞ := ∫⁻ u, g u ∂(μ.normalize : Measure ℝ)
  have hq_one : q ≤ 1 :=
    lintegral_le_const (Filter.Eventually.of_forall hg_one)
  have hq : q ≠ ∞ := ne_top_of_le_ne_top ENNReal.one_ne_top hq_one
  have hF : Measurable (fun c : FiniteMeasure ℝ =>
      EReal.exp (-((∫⁻ u, h u ∂(c : Measure ℝ)) : EReal))) :=
    ((Measure.measurable_lintegral hh).comp
      measurable_subtype_coe).coe_ereal_ennreal.neg.ereal_exp
  have hpoint (n : ℕ) (x : Fin n → ℝ) :
      EReal.exp (-((∫⁻ u, h u ∂(weightedEmpirical n x : Measure ℝ)) : EReal)) =
        ∏ i : Fin n, g (x i) := by
    simp_rw [coe_weightedEmpirical, lintegral_finsetSum_measure, lintegral_smul_measure,
      lintegral_dirac, smul_eq_mul]
    exact exp_neg_ennreal_sum Finset.univ _
  have htuple (n : ℕ) :
      (∫⁻ x : Fin n → ℝ,
        EReal.exp (-((∫⁻ u, h u ∂(weightedEmpirical n x : Measure ℝ)) : EReal))
        ∂(Measure.pi (fun _ : Fin n => (μ.normalize : Measure ℝ)))) = q ^ n := by
    simp_rw [hpoint]
    rw [ProbabilityTheory.lintegral_prod_eq_prod_lintegral_of_indepFun
      Finset.univ (fun i (x : Fin n → ℝ) => g (x i))
      (ProbabilityTheory.iIndepFun_pi (fun _ => hg.aemeasurable))
      (fun i => hg.comp (measurable_pi_apply i))]
    simpa using Finset.prod_eq_pow_card (s := Finset.univ) (fun i _ =>
      (measurePreserving_eval
        (fun _ : Fin n => (μ.normalize : Measure ℝ)) i).lintegral_comp hg)
  have hseries :
      HasSum (fun n : ℕ =>
        Real.exp (-(μ.mass : ℝ)) * ((μ.mass : ℝ) * q.toReal) ^ n / n.factorial)
        (Real.exp (-(μ.mass : ℝ)) * Real.exp ((μ.mass : ℝ) * q.toReal)) := by
    simpa only [← Real.exp_eq_exp_ℝ, mul_div_assoc] using
      (NormedSpace.expSeries_div_hasSum_exp
        ((μ.mass : ℝ) * q.toReal)).mul_left (Real.exp (-(μ.mass : ℝ)))
  have hpoisson :
      (∫⁻ n : ℕ, q ^ n ∂(ProbabilityTheory.poissonMeasure μ.mass)) =
        ENNReal.ofReal
          (Real.exp (-(μ.mass : ℝ)) * Real.exp ((μ.mass : ℝ) * q.toReal)) := by
    calc
      _ = ∑' n : ℕ, ENNReal.ofReal
          (Real.exp (-(μ.mass : ℝ)) * ((μ.mass : ℝ) * q.toReal) ^ n / n.factorial) := by
        rw [lintegral_countable']
        apply tsum_congr
        intro n
        have hpow : q ^ n = ENNReal.ofReal (q.toReal ^ n) := by
          rw [ENNReal.ofReal_pow ENNReal.toReal_nonneg, ENNReal.ofReal_toReal hq]
        rw [ProbabilityTheory.poissonMeasure_singleton, hpow,
          ← ENNReal.ofReal_mul (pow_nonneg ENNReal.toReal_nonneg n)]
        congr 1
        rw [mul_pow]
        ring
      _ = _ := by
        rw [← ENNReal.ofReal_tsum_of_nonneg (fun n => by positivity)
          hseries.summable, hseries.tsum_eq]
  have hI : (∫⁻ u, 1 - g u ∂(μ : Measure ℝ)) =
      (μ.mass : ℝ≥0∞) * (1 - q) := by
    rw [coe_eq_mass_smul_normalize μ, lintegral_smul_measure,
      lintegral_sub hg hq (Filter.Eventually.of_forall hg_one)]
    simp [q, smul_eq_mul]
  have hfinite : (μ.mass : ℝ≥0∞) * (1 - q) ≠ ∞ :=
    ENNReal.mul_ne_top ENNReal.coe_ne_top
      (ne_top_of_le_ne_top ENNReal.one_ne_top tsub_le_self)
  rw [lintegral_finitePoissonLaw_normalized μ _ hF]
  simp_rw [htuple]
  rw [hpoisson]
  change ENNReal.ofReal
      (Real.exp (-(μ.mass : ℝ)) * Real.exp ((μ.mass : ℝ) * q.toReal)) =
    EReal.exp (-((∫⁻ u, 1 - g u ∂(μ : Measure ℝ)) : EReal))
  rw [hI, ← EReal.coe_ennreal_toReal hfinite, ← EReal.coe_neg, EReal.exp_coe,
    ENNReal.toReal_mul, ENNReal.coe_toReal,
    ENNReal.toReal_sub_of_le hq_one ENNReal.one_ne_top, ENNReal.toReal_one]
  rw [← Real.exp_add]
  congr 2
  ring

theorem lintegral_exp_neg_fragmentLaw
    (ζ : ℝ) (h : ℝ → ℝ≥0∞) (hh : Measurable h) :
    (∫⁻ c, EReal.exp (-((∫⁻ u, h u ∂(c : Measure ℝ)) : EReal))
      ∂(fragmentLaw ζ)) =
      EReal.exp (-((∫⁻ u,
        1 - EReal.exp (-((ENNReal.ofReal u * h u : ℝ≥0∞) : EReal))
        ∂((volume.restrict (Set.Ioc (0 : ℝ) ζ)).withDensity
          (fun u : ℝ => ENNReal.ofReal (1 / u)))) : EReal)) := by
  classical
  let : ∀ k : ℤ, IsProbabilityMeasure (finitePoissonLaw (cappedDyadicIntensity ζ k)) :=
    fun k => finitePoissonLaw_isProbabilityMeasure _
  let P : Measure (ℤ → FiniteMeasure ℝ) :=
    Measure.infinitePi (fun k : ℤ => finitePoissonLaw (cappedDyadicIntensity ζ k))
  have hm : Measurable (fun c : FiniteMeasure ℝ => ∫⁻ u, h u ∂(c : Measure ℝ)) :=
    (Measure.measurable_lintegral hh).comp measurable_subtype_coe
  have hF : Measurable (fun c : FiniteMeasure ℝ =>
      EReal.exp (-((∫⁻ u, h u ∂(c : Measure ℝ)) : EReal))) :=
    hm.coe_ereal_ennreal.neg.ereal_exp
  have hc : Continuous (fun a : ℝ≥0∞ => EReal.exp (-(a : EReal))) :=
    ENNReal.continuous_exp.comp continuous_coe_ennreal_ereal.neg
  have he (s : Finset ℤ) :
      (∫⁻ ω : ℤ → FiniteMeasure ℝ,
        EReal.exp (-((∑ k ∈ s, ∫⁻ u, h u ∂(ω k : Measure ℝ) : ℝ≥0∞) : EReal))
        ∂P) =
      EReal.exp (-((∑ k ∈ s, ∫⁻ u,
        1 - EReal.exp (-((ENNReal.ofReal u * h u : ℝ≥0∞) : EReal))
        ∂(cappedDyadicIntensity ζ k : Measure ℝ) : ℝ≥0∞) : EReal)) := by
    simp_rw [exp_neg_ennreal_sum]
    rw [ProbabilityTheory.lintegral_prod_eq_prod_lintegral_of_indepFun s _
      (ProbabilityTheory.iIndepFun_infinitePi
        (P := fun k : ℤ => finitePoissonLaw (cappedDyadicIntensity ζ k)) (fun _ => hF))
      (fun k => hF.comp (measurable_pi_apply k))]
    apply Finset.prod_congr rfl
    intro k _
    rw [(measurePreserving_eval_infinitePi
      (fun j : ℤ => finitePoissonLaw (cappedDyadicIntensity ζ j)) k).lintegral_comp hF,
      lintegral_exp_neg_finitePoissonLaw _ h hh]
  have hlim : Filter.Tendsto
      (fun s : Finset ℤ => ∫⁻ ω : ℤ → FiniteMeasure ℝ,
        EReal.exp (-((∑ k ∈ s, ∫⁻ u, h u ∂(ω k : Measure ℝ) : ℝ≥0∞) : EReal))
        ∂P)
      Filter.atTop
      (nhds (∫⁻ ω : ℤ → FiniteMeasure ℝ,
        EReal.exp (-((∫⁻ u, h u ∂(Measure.sum (fun k : ℤ => (ω k : Measure ℝ)))) : EReal))
        ∂P)) := by
    apply tendsto_lintegral_filter_of_dominated_convergence (fun _ => 1)
    · exact Filter.Eventually.of_forall fun s =>
        (s.measurable_fun_sum fun k _ =>
          hm.comp (measurable_pi_apply k)).coe_ereal_ennreal.neg.ereal_exp
    · simp [EReal.coe_ennreal_nonneg]
    · simp
    · exact Filter.Eventually.of_forall fun ω =>
        (hc.tendsto _).comp
          (hasSum_lintegral_measure h (fun k : ℤ => (ω k : Measure ℝ)))
  have hi := (hc.tendsto _).comp (hasSum_lintegral_measure
    (fun u : ℝ => 1 - EReal.exp (-((ENNReal.ofReal u * h u : ℝ≥0∞) : EReal)))
    (fun k : ℤ => (cappedDyadicIntensity ζ k : Measure ℝ)))
  rw [sum_cappedDyadicIntensity] at hi
  simp only [Function.comp_def, SummationFilter.unconditional_filter] at hi
  unfold fragmentLaw
  rw [lintegral_map hF measurable_finiteFragments]
  calc
    _ = (∫⁻ ω : ℤ → FiniteMeasure ℝ,
        EReal.exp (-((∫⁻ u, h u ∂(Measure.sum (fun k : ℤ => (ω k : Measure ℝ)))) : EReal))
        ∂P) := by
      apply lintegral_congr_ae
      filter_upwards [ae_isFiniteMeasure_fragment_sum ζ] with ω hω
      simp [finiteFragments, hω]
    _ = _ := tendsto_nhds_unique (by simpa only [he] using hlim) hi

theorem pi_eq_mass_smul_normalize (μ : FiniteMeasure ℝ) (n : ℕ) :
    Measure.pi (fun _ : Fin n => (μ : Measure ℝ)) =
      (μ.mass : ℝ≥0∞) ^ n •
        Measure.pi (fun _ : Fin n => (μ.normalize : Measure ℝ)) := by
  apply Measure.pi_eq
  intro s _
  simp only [Measure.smul_apply, smul_eq_mul, Measure.pi_pi]
  simp_rw [coe_eq_mass_smul_normalize μ, Measure.smul_apply, smul_eq_mul]
  rw [Finset.prod_mul_distrib]
  simp

theorem lintegral_finitePoissonLaw
    (μ : FiniteMeasure ℝ) (F : FiniteMeasure ℝ → ℝ≥0∞) (hF : Measurable F) :
    ∫⁻ c, F c ∂(finitePoissonLaw μ) =
      ENNReal.ofReal (Real.exp (-(μ.mass : ℝ))) *
        ∑' n : ℕ, (n.factorial : ℝ≥0∞)⁻¹ *
          ∫⁻ x : Fin n → ℝ, F (weightedEmpirical n x)
            ∂(Measure.pi (fun _ : Fin n => (μ : Measure ℝ))) := by
  rw [lintegral_finitePoissonLaw_normalized μ F hF, lintegral_countable',
    ← ENNReal.tsum_mul_left]
  apply tsum_congr
  intro n
  rw [ProbabilityTheory.poissonMeasure_singleton,
    ENNReal.ofReal_div_of_pos (by positivity), ENNReal.ofReal_mul (by positivity),
    ENNReal.ofReal_pow (by positivity), pi_eq_mass_smul_normalize, lintegral_smul_measure]
  simp [div_eq_mul_inv, mul_comm, mul_left_comm, mul_assoc]

theorem weightedEmpirical_zero (x : Fin 0 → ℝ) : weightedEmpirical 0 x = 0 := by
  simp [weightedEmpirical]

theorem measurableSet_zero_configuration :
    MeasurableSet ({0} : Set (FiniteMeasure ℝ)) := by
  have hm : Measurable (fun c : FiniteMeasure ℝ => (c : Measure ℝ) Set.univ) :=
    (Measure.measurable_coe MeasurableSet.univ).comp measurable_subtype_coe
  convert hm (measurableSet_singleton (0 : ℝ≥0∞)) using 1
  ext c
  simp [← FiniteMeasure.ennreal_mass, FiniteMeasure.mass_zero_iff]

theorem weightedEmpirical_eq_zero_iff (n : ℕ) (x : Fin n → ℝ)
    (hx : ∀ i, 0 < x i) : weightedEmpirical n x = 0 ↔ n = 0 := by
  constructor
  · intro hzero
    by_contra hn
    let i : Fin n := ⟨0, Nat.pos_of_ne_zero hn⟩
    have hsum : (∑ j : Fin n, ENNReal.ofReal (x j)) = 0 := by
      have hm := congrArg (fun c : FiniteMeasure ℝ => (c : Measure ℝ) Set.univ) hzero
      simpa [coe_weightedEmpirical] using hm
    have hi := (Finset.sum_eq_zero_iff.mp hsum) i (Finset.mem_univ i)
    exact (ne_of_gt (ENNReal.ofReal_pos.mpr (hx i))) hi
  · rintro rfl
    exact weightedEmpirical_zero x

theorem finitePoissonLaw_zero : finitePoissonLaw 0 = Measure.dirac 0 := by
  have hp : ProbabilityTheory.poissonMeasure 0 = Measure.dirac (0 : ℕ) := by
    apply Measure.ext_of_singleton
    intro n
    cases n <;> simp [ProbabilityTheory.poissonMeasure_singleton]
  rw [finitePoissonLaw, FiniteMeasure.zero_mass, hp, Measure.dirac_prod,
    Measure.map_map measurable_weightedEmpirical_sample (by fun_prop)]
  simp [Function.comp_def, weightedEmpirical_zero]

theorem finitePoissonLaw_singleton_zero
    (μ : FiniteMeasure ℝ)
    (hμ : (μ : Measure ℝ) (Set.Iic (0 : ℝ)) = 0) :
    finitePoissonLaw μ ({0} : Set (FiniteMeasure ℝ)) =
      ENNReal.ofReal (Real.exp (-(μ.mass : ℝ))) := by
  obtain rfl | hne := eq_or_ne μ 0
  · simp [finitePoissonLaw_zero]
  have hν : (μ.normalize : Measure ℝ) (Set.Iic (0 : ℝ)) = 0 := by
    rw [μ.toMeasure_normalize_eq_of_nonzero hne, Measure.smul_apply, hμ, smul_zero]
  have hpos : ∀ᵐ u ∂(μ.normalize : Measure ℝ), 0 < u := by
    simpa only [ae_iff, not_lt, Set.Iic] using hν
  have hpi (n : ℕ) : ∀ᵐ x ∂(Measure.pi (fun _ : Fin n => (μ.normalize : Measure ℝ))),
      ∀ i, 0 < x i := by
    rw [ae_all_iff]
    intro i
    exact (measurePreserving_eval (fun _ : Fin n => (μ.normalize : Measure ℝ))
      i).quasiMeasurePreserving.ae hpos
  have hm : Measurable (({0} : Set (FiniteMeasure ℝ)).indicator (1 : FiniteMeasure ℝ → ℝ≥0∞)) :=
    measurable_const.indicator measurableSet_zero_configuration
  rw [← lintegral_indicator_one measurableSet_zero_configuration,
    lintegral_finitePoissonLaw_normalized μ _ hm]
  have hi (n : ℕ) :
      (∫⁻ x : Fin n → ℝ, ({0} : Set (FiniteMeasure ℝ)).indicator 1 (weightedEmpirical n x)
        ∂(Measure.pi (fun _ : Fin n => (μ.normalize : Measure ℝ)))) =
      if n = 0 then 1 else 0 := by
    by_cases hn : n = 0
    · subst n
      simp [weightedEmpirical_zero]
    · rw [ite_eq_right hn]
      apply (lintegral_eq_zero_iff (hm.comp (measurable_weightedEmpirical n))).mpr
      filter_upwards [hpi n] with x hx
      simp [Set.indicator, weightedEmpirical_eq_zero_iff n x hx, hn]
  simp_rw [hi]
  rw [lintegral_countable']
  simp [ProbabilityTheory.poissonMeasure_singleton]

theorem integral_exp_neg_mass_fragmentLaw
    (ζ s : ℝ) (hζ : 0 < ζ) (hs : 0 ≤ s) :
    (∫ c, Real.exp (-s * (c.mass : ℝ)) ∂(fragmentLaw ζ)) =
      Real.exp (∫ u in (0 : ℝ)..ζ, (Real.exp (-s * u) - 1) / u) := by
  let : IsProbabilityMeasure (fragmentLaw ζ) := fragmentLaw_isProbabilityMeasure ζ
  have hmassm : Measurable (fun c : FiniteMeasure ℝ => (c.mass : ℝ)) :=
    ((Measure.measurable_coe MeasurableSet.univ).comp measurable_subtype_coe).ennreal_toReal
  have hleftInt : Integrable
      (fun c : FiniteMeasure ℝ => Real.exp (-s * (c.mass : ℝ)))
      (fragmentLaw ζ) := by
    refine (integrable_const (1 : ℝ)).mono'
      (measurable_const.mul hmassm).exp.aestronglyMeasurable ?_
    exact Filter.Eventually.of_forall fun c => by
      rw [Real.norm_eq_abs, abs_of_pos (Real.exp_pos _)]
      exact Real.exp_le_one_iff.mpr
        (mul_nonpos_of_nonpos_of_nonneg (neg_nonpos.mpr hs) c.mass.coe_nonneg)
  have hbound : ∀ u ∈ Set.Ioc (0 : ℝ) ζ,
      0 ≤ (1 - Real.exp (-s * u)) / u ∧
      (1 - Real.exp (-s * u)) / u ≤ s := by
    intro u hu
    constructor
    · exact div_nonneg
        (sub_nonneg.mpr (Real.exp_le_one_iff.mpr
          (mul_nonpos_of_nonpos_of_nonneg (neg_nonpos.mpr hs) hu.1.le))) hu.1.le
    · apply (div_le_iff₀ hu.1).2
      linarith [Real.add_one_le_exp (-s * u)]
  have hkernelInt : Integrable
      (fun u : ℝ => (1 - Real.exp (-s * u)) / u)
      (volume.restrict (Set.Ioc (0 : ℝ) ζ)) := by
    refine (integrable_const s).mono'
      ((measurable_const.sub (measurable_const.mul measurable_id).exp).div
        measurable_id).aestronglyMeasurable ?_
    filter_upwards [ae_restrict_mem measurableSet_Ioc] with u hu
    rw [Real.norm_eq_abs, abs_of_nonneg (hbound u hu).1]
    exact (hbound u hu).2
  have hkernelNonneg : ∀ᵐ u ∂volume.restrict (Set.Ioc (0 : ℝ) ζ),
      0 ≤ (1 - Real.exp (-s * u)) / u :=
    ae_restrict_of_forall_mem measurableSet_Ioc fun u hu => (hbound u hu).1
  have hinner (u : ℝ) (hu : 0 ≤ u) :
      EReal.exp (-((ENNReal.ofReal u * ENNReal.ofReal s : ℝ≥0∞) : EReal)) =
        ENNReal.ofReal (Real.exp (-s * u)) := by
    rw [mul_comm (ENNReal.ofReal u) (ENNReal.ofReal s),
      ← ENNReal.ofReal_mul hs, EReal.coe_ennreal_ofReal,
      max_eq_left (mul_nonneg hs hu),
      ← EReal.coe_neg, EReal.exp_coe]
    simp only [neg_mul]
  have hintensity :
      (∫⁻ u, 1 - EReal.exp
        (-((ENNReal.ofReal u * ENNReal.ofReal s : ℝ≥0∞) : EReal))
        ∂((volume.restrict (Set.Ioc (0 : ℝ) ζ)).withDensity
          (fun u : ℝ => ENNReal.ofReal (1 / u)))) =
      ENNReal.ofReal (∫ u in Set.Ioc (0 : ℝ) ζ,
        (1 - Real.exp (-s * u)) / u) := by
    rw [ofReal_integral_eq_lintegral_ofReal hkernelInt hkernelNonneg,
      lintegral_withDensity_eq_lintegral_mul _ (by fun_prop) (by fun_prop)]
    refine lintegral_congr_ae ?_
    filter_upwards [ae_restrict_mem measurableSet_Ioc] with u hu
    change ENNReal.ofReal (1 / u) *
        (1 - EReal.exp
          (-((ENNReal.ofReal u * ENNReal.ofReal s : ℝ≥0∞) : EReal))) =
      ENNReal.ofReal ((1 - Real.exp (-s * u)) / u)
    rw [hinner u hu.1.le, ← ENNReal.ofReal_one,
      ← ENNReal.ofReal_sub 1 (Real.exp_nonneg _),
      ← ENNReal.ofReal_mul (div_nonneg zero_le_one hu.1.le)]
    congr 1
    ring
  have hpoint (c : FiniteMeasure ℝ) :
      EReal.exp (-((∫⁻ _u, ENNReal.ofReal s ∂(c : Measure ℝ)) : EReal)) =
        ENNReal.ofReal (Real.exp (-s * (c.mass : ℝ))) := by
    simpa only [lintegral_const, ← FiniteMeasure.ennreal_mass,
      ENNReal.ofReal_coe_nnreal, mul_comm] using hinner (c.mass : ℝ) c.mass.coe_nonneg
  have horientation :
      (∫ u in (0 : ℝ)..ζ, (Real.exp (-s * u) - 1) / u) =
        -(∫ u in Set.Ioc (0 : ℝ) ζ, (1 - Real.exp (-s * u)) / u) := by
    rw [intervalIntegral.integral_of_le hζ.le, ← integral_neg]
    apply integral_congr_ae
    exact Filter.Eventually.of_forall fun u => by ring
  have hmain := lintegral_exp_neg_fragmentLaw ζ
    (fun _ => ENNReal.ofReal s) measurable_const
  simp_rw [hpoint] at hmain
  rw [← ofReal_integral_eq_lintegral_ofReal hleftInt
      (Filter.Eventually.of_forall fun _ => Real.exp_nonneg _),
    hintensity, EReal.coe_ennreal_ofReal,
    max_eq_left (integral_nonneg_of_ae hkernelNonneg),
    ← EReal.coe_neg, EReal.exp_coe] at hmain
  rw [horientation]
  exact (ENNReal.ofReal_eq_ofReal_iff
    (integral_nonneg fun _ => Real.exp_nonneg _) (Real.exp_nonneg _)).1 hmain

theorem lintegral_fragmentLaw (ζ : ℝ) (h : ℝ → ℝ≥0∞) (hh : Measurable h) :
    (∫⁻ c, ∫⁻ u, h u ∂(c : Measure ℝ) ∂(fragmentLaw ζ)) =
      ∫⁻ u in Set.Ioc (0 : ℝ) ζ, h u ∂volume := by
  have hm : Measurable (fun c : FiniteMeasure ℝ => ∫⁻ u, h u ∂(c : Measure ℝ)) :=
    (Measure.measurable_lintegral hh).comp measurable_subtype_coe
  rw [fragmentLaw, lintegral_map hm measurable_finiteFragments, ← lintegral_fragment_sum ζ h hh]
  apply lintegral_congr_ae
  filter_upwards [ae_isFiniteMeasure_fragment_sum ζ] with ω hω
  simp [finiteFragments, hω]

theorem fragmentLaw_small_seed_tail
    (ζ ε δ : ℝ) (hζ : 0 < ζ) (hε : 0 ≤ ε) (hδ : 0 < δ) :
    fragmentLaw ζ {c : FiniteMeasure ℝ |
      ENNReal.ofReal δ ≤ (c : Measure ℝ) (Set.Ioc (0 : ℝ) ε)} ≤
      ENNReal.ofReal (min ε ζ) / ENNReal.ofReal δ := by
  have hmin : 0 ≤ min ε ζ := le_min hε hζ.le
  have hm : Measurable (fun c : FiniteMeasure ℝ => (c : Measure ℝ) (Set.Ioc (0 : ℝ) ε)) :=
    (Measure.measurable_coe measurableSet_Ioc).comp measurable_subtype_coe
  have he : (∫⁻ c, (c : Measure ℝ) (Set.Ioc (0 : ℝ) ε) ∂(fragmentLaw ζ)) =
      (NNReal.mk (min ε ζ) hmin : ℝ≥0∞) := by
    have hi := lintegral_fragmentLaw ζ ((Set.Ioc (0 : ℝ) ε).indicator (fun _ => 1))
      (measurable_const.indicator measurableSet_Ioc)
    simpa only [lintegral_indicator_fun_one measurableSet_Ioc,
      Measure.restrict_apply measurableSet_Ioc, Set.Ioc_inter_Ioc, max_self,
      Real.volume_Ioc, sub_zero, ENNReal.ofReal_eq_coe_nnreal hmin] using hi
  simpa only [he, ENNReal.ofReal_eq_coe_nnreal hmin] using
    (meas_ge_le_lintegral_div (μ := fragmentLaw ζ) hm.aemeasurable
      (ne_of_gt (ENNReal.ofReal_pos.mpr hδ)) ENNReal.ofReal_ne_top)

theorem cappedDyadicIntensity_measure (ζ : ℝ) (k : ℤ) :
    (cappedDyadicIntensity ζ k : Measure ℝ) =
      (volume.restrict (Set.Ioc ((2 : ℝ) ^ k) (min ζ ((2 : ℝ) ^ (k + 1))))).withDensity
        (fun u : ℝ => ENNReal.ofReal (1 / u)) ∧
      (cappedDyadicIntensity ζ k : Measure ℝ)
        (Set.Ioc ((2 : ℝ) ^ k) (min ζ ((2 : ℝ) ^ (k + 1))))ᶜ = 0 := by
  have hm : (cappedDyadicIntensity ζ k : Measure ℝ) =
      (volume.restrict (Set.Ioc ((2 : ℝ) ^ k) (min ζ ((2 : ℝ) ^ (k + 1))))).withDensity
        (fun u : ℝ => ENNReal.ofReal (1 / u)) := by
    change ((volume.restrict (Set.Ioc (0 : ℝ) ζ)).withDensity _).restrict _ = _
    rw [restrict_withDensity measurableSet_Ioc, Measure.restrict_restrict measurableSet_Ioc,
      Set.Ioc_inter_Ioc, sup_eq_left.mpr (zpow_nonneg (by norm_num : (0 : ℝ) ≤ 2) k), inf_comm]
  refine ⟨hm, ?_⟩
  rw [hm, withDensity_apply _ measurableSet_Ioc.compl,
    Measure.restrict_restrict measurableSet_Ioc.compl]
  simp

theorem cappedDyadicIntensity_mass (ζ : ℝ) (k : ℤ) :
    ((cappedDyadicIntensity ζ k).mass : ℝ) =
      if ζ ≤ (2 : ℝ) ^ k then 0
      else Real.log (min ζ ((2 : ℝ) ^ (k + 1)) / (2 : ℝ) ^ k) := by
  change ((cappedDyadicIntensity ζ k).mass : ℝ≥0∞).toReal = _
  rw [FiniteMeasure.ennreal_mass, (cappedDyadicIntensity_measure ζ k).1,
    withDensity_apply _ MeasurableSet.univ, Measure.restrict_univ]
  by_cases hζ : ζ ≤ (2 : ℝ) ^ k
  · simp [hζ]
  · have ha : 0 < (2 : ℝ) ^ k := zpow_pos (by norm_num) k
    have hab : (2 : ℝ) ^ k ≤ min ζ ((2 : ℝ) ^ (k + 1)) :=
      le_min (lt_of_not_ge hζ).le (zpow_le_zpow_right₀ (by norm_num) (by omega))
    have hb : 0 < min ζ ((2 : ℝ) ^ (k + 1)) := ha.trans_le hab
    have hi : IntervalIntegrable (fun u : ℝ => 1 / u) volume
        ((2 : ℝ) ^ k) (min ζ ((2 : ℝ) ^ (k + 1))) := by
      simpa only [one_div] using
        (intervalIntegrable_inv_iff.mpr (Or.inr (Set.notMem_uIcc_of_lt ha hb)))
    have hn : 0 ≤ᵐ[volume.restrict
        (Set.Ioc ((2 : ℝ) ^ k) (min ζ ((2 : ℝ) ^ (k + 1))))] (fun u : ℝ => 1 / u) := by
      filter_upwards [ae_restrict_mem measurableSet_Ioc] with u hu
      exact one_div_nonneg.mpr (ha.trans hu.1).le
    rw [← integral_eq_lintegral_of_nonneg_ae hn
      ((intervalIntegrable_iff_integrableOn_Ioc_of_le hab).mp hi).aestronglyMeasurable,
      ← intervalIntegral.integral_of_le hab, integral_one_div_of_pos ha hb]
    simp [hζ]

theorem lintegral_weighted_cappedDyadicIntensity
    (ζ : ℝ) (k : ℤ) (h : ℝ → ℝ≥0∞) (hh : Measurable h) :
    (∫⁻ u, ENNReal.ofReal u * h u ∂(cappedDyadicIntensity ζ k : Measure ℝ)) =
      ∫⁻ u in Set.Ioc ((2 : ℝ) ^ k) (min ζ ((2 : ℝ) ^ (k + 1))), h u ∂volume := by
  rw [(cappedDyadicIntensity_measure ζ k).1,
    lintegral_withDensity_eq_lintegral_mul _ (by fun_prop)
      (by fun_prop : Measurable (fun u : ℝ => ENNReal.ofReal u * h u))]
  apply lintegral_congr_ae
  filter_upwards [ae_restrict_mem measurableSet_Ioc] with u hu
  have hu0 : 0 < u := (zpow_pos (by norm_num : (0 : ℝ) < 2) k).trans hu.1
  change ENNReal.ofReal (1 / u) * (ENNReal.ofReal u * h u) = h u
  rw [← mul_assoc, ← ENNReal.ofReal_mul (one_div_nonneg.mpr hu0.le),
    one_div_mul_cancel hu0.ne', ENNReal.ofReal_one, one_mul]

theorem cappedDyadicIntensity_firstMoment (ζ : ℝ) (k : ℤ) :
    (∫⁻ u, ENNReal.ofReal u ∂(cappedDyadicIntensity ζ k : Measure ℝ)) =
      ENNReal.ofReal (max 0 (min ζ ((2 : ℝ) ^ (k + 1)) - (2 : ℝ) ^ k)) := by
  simpa using lintegral_weighted_cappedDyadicIntensity ζ k (fun _ => 1) measurable_const

theorem sum_measureReal_adjacent_Ioc {n : ℕ} (a : Fin (n + 1) → ℝ)
    (ha : Monotone a) (μ : Measure ℝ) [IsFiniteMeasure μ] :
    (∑ j : Fin n, μ.real (Set.Ioc (a j.castSucc) (a j.succ))) =
      μ.real (Set.Ioc (a 0) (a (Fin.last n))) := by
  let f := fun j => μ.real (Set.Iic (a j))
  have h (i j : Fin (n + 1)) (hij : i ≤ j) :
      μ.real (Set.Ioc (a i) (a j)) = f j - f i := by
    rw [← Set.Iic_sdiff_Iic,
      measureReal_sdiff (Set.Iic_subset_Iic.mpr (ha hij)) measurableSet_Iic]
  simp_rw [h _ _ (Fin.castSucc_le_succ _)]
  rw [h _ _ (Fin.zero_le _), Finset.sum_sub_distrib]
  linarith [Fin.sum_univ_succ f, Fin.sum_univ_castSucc f]

theorem pairwise_disjoint_adjacent_Ioc {n : ℕ} (a : Fin (n + 1) → ℝ)
    (ha : Monotone a) :
    Pairwise (fun i j : Fin n =>
      Disjoint (Set.Ioc (a i.castSucc) (a i.succ))
        (Set.Ioc (a j.castSucc) (a j.succ))) := by
  intro i j hij
  simpa using ha.pairwise_disjoint_on_Ioc_succ ((Fin.castSucc_injective n).ne hij)

theorem exp_neg_add_sub_bound (A T : ℝ) (hA : 0 ≤ A) (hT : 0 ≤ T) :
    0 ≤ Real.exp (-A) - Real.exp (-(A + T)) ∧
      Real.exp (-A) - Real.exp (-(A + T)) ≤ T := by
  rw [neg_add, Real.exp_add]
  constructor <;> nlinarith [Real.exp_pos (-A), Real.one_sub_le_exp_neg T,
    Real.exp_le_one_iff.mpr (neg_nonpos.mpr hA),
    Real.exp_le_one_iff.mpr (neg_nonpos.mpr hT)]

theorem disjoint_indicator_euler_factor {n : ℕ} (B : Fin n → Set ℝ)
    (hB : Pairwise (fun i j => Disjoint (B i) (B j)))
    (s : Fin n → ℝ) (u q : ℝ) :
    1 + (Real.exp (-u * (∑ j, (B j).indicator (fun _ => s j) u)) - 1) / q =
      ∏ j, (1 + (Real.exp (-u * (B j).indicator (fun _ => s j) u) - 1) / q) := by
  classical
  by_cases h : ∃ j, u ∈ B j
  · obtain ⟨j, hj⟩ := h
    have ho : ∀ k : Fin n, k ≠ j → u ∉ B k := by
      intro k hkj hk
      exact Set.disjoint_left.mp (hB hkj) hk hj
    rw [Finset.sum_eq_single j
      (fun k _ hkj => Set.indicator_of_notMem (ho k hkj) _) (by simp),
      Finset.prod_eq_single j
        (fun k _ hkj => by simp [Set.indicator_of_notMem (ho k hkj)]) (by simp)]
  · simp [Set.indicator_of_notMem, not_exists.mp h]

theorem measurable_restricted_mass (A : Set ℝ) (hA : MeasurableSet A) :
    Measurable (fun c : FiniteMeasure ℝ => ((c.restrict A).mass : ℝ)) := by
  simp only [FiniteMeasure.restrict_mass]
  exact ((Measure.measurable_coe hA).comp measurable_subtype_coe).ennreal_toReal

theorem measurable_fragmentBandMasses {m : ℕ} (a : Fin (m + 2) → ℝ) :
    Measurable (fragmentBandMasses a) := by
  apply measurable_pi_lambda
  intro j
  exact measurable_restricted_mass _ measurableSet_Ioc

theorem sum_fragmentBandMasses {m : ℕ} (a : Fin (m + 2) → ℝ)
    (ha : Monotone a) (c : FiniteMeasure ℝ) :
    (∑ j, fragmentBandMasses a c j) =
      ((c.restrict (Set.Ioc (a 0) (a (Fin.last (m + 1))))).mass : ℝ) := by
  simp only [fragmentBandMasses, FiniteMeasure.restrict_mass]
  exact sum_measureReal_adjacent_Ioc a ha (c : Measure ℝ)

theorem integrable_harmonicConfigurationMass (W : ℕ) (R ζ : ℝ)
    (f : FiniteMeasure ℝ → ℝ) (hf : StronglyMeasurable f) :
    Integrable f (harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ)) := by
  unfold harmonicConfigurationMass
  rw [FiniteMeasure.toMeasure_sum]
  exact integrable_finsetSum_measure.mpr fun r _ =>
    (integrable_dirac' hf (by finiteness)).smul_measure_nnreal

theorem harmonicConfigurationMass_mass (W : ℕ) (R ζ : ℝ) :
    ((harmonicConfigurationMass W R ζ).mass : ℝ) = harmonicFragmentMass W R ζ := by
  simpa only [integral_const, smul_eq_mul, mul_one,
    FiniteMeasure.measureReal_eq_coe_coeFn, FiniteMeasure.mass, harmonicFragmentMass] using
      integral_harmonic_configuration_mass W R ζ (fun _ => (1 : ℝ)) stronglyMeasurable_const

theorem harmonicConfigurationMass_ne_zero (W : ℕ) (R ζ : ℝ) :
    harmonicConfigurationMass W R ζ ≠ 0 := by
  rw [← FiniteMeasure.mass_nonzero_iff, ← NNReal.coe_ne_zero, harmonicConfigurationMass_mass]
  exact (harmonic_fragment_mass_pos W R ζ).ne'

theorem integral_normalize_harmonicConfigurationMass (W : ℕ) (R ζ : ℝ)
    (f : FiniteMeasure ℝ → ℝ) :
    (∫ c, f c ∂((harmonicConfigurationMass W R ζ).normalize :
      Measure (FiniteMeasure ℝ))) =
      (∫ c, f c ∂(harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ))) /
        harmonicFragmentMass W R ζ := by
  rw [← FiniteMeasure.average_eq_integral_normalize _
    (harmonicConfigurationMass_ne_zero W R ζ), average_eq, smul_eq_mul,
    FiniteMeasure.measureReal_eq_coe_coeFn]
  change (harmonicConfigurationMass W R ζ).mass.toReal⁻¹ * _ = _
  rw [harmonicConfigurationMass_mass]
  ring

open Classical in
theorem restricted_configuration_mass (R : ℝ) (r : ℕ) (hR : 1 < R)
    (A : Set ℝ) (hA : MeasurableSet A) :
    ((primeLogConfiguration R r).restrict A).mass.toReal =
      ∑ p ∈ r.primeFactors,
        if Real.log p / Real.log R ∈ A then Real.log p / Real.log R else 0 := by
  calc
    _ = ∫ u, A.indicator (fun _ => (1 : ℝ)) u
        ∂(primeLogConfiguration R r : Measure ℝ) := by
      simp [integral_indicator_const (1 : ℝ) hA, smul_eq_mul]
    _ = ∑ p ∈ r.primeFactors, (Real.log p / Real.log R) *
        A.indicator (fun _ => (1 : ℝ)) (Real.log p / Real.log R) :=
      integral_prime_log_configuration R r hR _
    _ = _ := by simp [Set.indicator, mul_ite]

theorem seed_configuration_identity (R : ℝ) (r : ℕ) (ε : ℝ) (hR : 1 < R) :
    (((primeLogConfiguration R r).restrict (Set.Ioc (0 : ℝ) ε)).mass : ℝ) =
      ∑ p ∈ r.primeFactors.filter (fun p : ℕ => (p : ℝ) ≤ R ^ ε),
        Real.log p / Real.log R := by
  classical
  rw [restricted_configuration_mass R r hR _ measurableSet_Ioc, Finset.sum_filter]
  apply Finset.sum_congr rfl
  intro p hp
  have hprime := Nat.prime_of_mem_primeFactors hp
  have hmark : 0 < Real.log p / Real.log R :=
    div_pos (Real.log_pos (by exact_mod_cast hprime.one_lt)) (Real.log_pos hR)
  have hle : Real.log p / Real.log R ≤ ε ↔ (p : ℝ) ≤ R ^ ε := by
    rw [div_le_iff₀ (Real.log_pos hR)]
    exact (Real.le_rpow_iff_log_le
      (by exact_mod_cast hprime.pos) (zero_lt_one.trans hR)).symm
  simp only [Set.mem_Ioc, hmark, true_and, hle]

theorem seed_expectation_identity (W : ℕ) (R ζ ε : ℝ) (hR : 1 < R) :
    (∫ c : FiniteMeasure ℝ, ((c.restrict (Set.Ioc (0 : ℝ) ε)).mass : ℝ)
      ∂(harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ))) =
      ∑ r ∈ (∏ p ∈ fragmentPrimes W R ζ, p).divisors,
        (Nat.totient r : ℝ)⁻¹ *
          ∑ p ∈ r.primeFactors.filter (fun p : ℕ => (p : ℝ) ≤ R ^ ε),
            Real.log p / Real.log R := by
  rw [integral_harmonic_configuration_mass W R ζ _
    (measurable_restricted_mass _ measurableSet_Ioc).stronglyMeasurable]
  simp_rw [seed_configuration_identity R _ ε hR]

theorem seed_global_bound :
    ∃ C : ℝ, 0 < C ∧ ∀ (W : ℕ) (R ζ ε : ℝ), 1 < R → 0 ≤ ε →
      let E : ℝ :=
        (∫ c : FiniteMeasure ℝ, ((c.restrict (Set.Ioc (0 : ℝ) ε)).mass : ℝ)
          ∂(harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ))) /
          harmonicFragmentMass W R ζ
      0 ≤ E ∧ E ≤ ε + C / Real.log R := by
  obtain ⟨C, hC, hbound⟩ := harmonic_small_seed_first_moment_bound
  refine ⟨C, hC, fun W R ζ ε hR hε => ?_⟩
  dsimp only
  rw [seed_expectation_identity W R ζ ε hR]
  exact hbound W R ζ ε hR hε

theorem logarithmic_error_vanishes (ρ C : ℝ) (hρ : 0 < ρ) :
    Tendsto (fun x : ℝ => C / Real.log (x ^ ρ)) atTop (nhds 0) := by
  simpa only [div_eq_mul_inv, mul_zero, Pi.inv_apply, Function.comp_def] using
    ((Real.tendsto_log_atTop.comp (tendsto_rpow_atTop hρ)).inv_tendsto_atTop).const_mul C

theorem harmonic_step_laplace_eq_product {n : ℕ}
    (W : ℕ) (R ζ : ℝ) (hR : 1 < R) (B : Fin n → Set ℝ)
    (hB : ∀ j, MeasurableSet (B j)) (s : Fin n → ℝ) :
    (∫ c : FiniteMeasure ℝ,
        Real.exp (-(∑ j, s j * ((c.restrict (B j)).mass : ℝ)))
        ∂(harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ))) /
      harmonicFragmentMass W R ζ =
        ∏ p ∈ fragmentPrimes W R ζ,
          (1 + (Real.exp (-(Real.log p / Real.log R) *
            (∑ j, (B j).indicator (fun _ => s j) (Real.log p / Real.log R))) - 1) /
              (p : ℝ)) := by
  classical
  let h : ℝ → ℝ := fun u => ∑ j, (B j).indicator (fun _ => s j) u
  have hI (c : FiniteMeasure ℝ) :
      (∫ u, h u ∂(c : Measure ℝ)) = ∑ j, s j * ((c.restrict (B j)).mass : ℝ) := by
    dsimp only [h]
    rw [integral_finsetSum Finset.univ
      (fun j _ => (integrable_const (s j)).indicator (hB j))]
    simp only [integral_indicator_const, hB, smul_eq_mul,
      FiniteMeasure.measureReal_eq_coe_coeFn, FiniteMeasure.restrict_mass, mul_comm]
  have hL : StronglyMeasurable (fun c : FiniteMeasure ℝ =>
      Real.exp (-(∑ j, s j * ((c.restrict (B j)).mass : ℝ)))) :=
    (Finset.measurable_fun_sum Finset.univ fun j _ =>
      (measurable_restricted_mass _ (hB j)).const_mul (s j)).neg.exp.stronglyMeasurable
  rw [integral_harmonic_configuration_mass W R ζ _ hL]
  simpa only [hI] using harmonic_fragment_laplace_eq_product W R ζ hR h

theorem harmonic_disjoint_laplace_factorization {n : ℕ}
    (W : ℕ) (R ζ : ℝ) (hR : 1 < R) (B : Fin n → Set ℝ)
    (hB : ∀ j, MeasurableSet (B j))
    (hdis : Pairwise (fun i j => Disjoint (B i) (B j))) (s : Fin n → ℝ) :
    (∫ c : FiniteMeasure ℝ,
        Real.exp (-(∑ j, s j * ((c.restrict (B j)).mass : ℝ)))
        ∂(harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ))) /
      harmonicFragmentMass W R ζ =
        ∏ j, (∫ c : FiniteMeasure ℝ,
          Real.exp (-s j * ((c.restrict (B j)).mass : ℝ))
          ∂(harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ))) /
            harmonicFragmentMass W R ζ := by
  rw [harmonic_step_laplace_eq_product W R ζ hR B hB s]
  simp_rw [disjoint_indicator_euler_factor B hdis s]
  rw [Finset.prod_comm]
  apply Finset.prod_congr rfl
  intro j _
  symm
  simpa only [Fin.sum_univ_one, neg_mul] using
    harmonic_step_laplace_eq_product W R ζ hR (fun _ : Fin 1 => B j)
      (fun _ => hB j) (fun _ => s j)

theorem restricted_mass_Ioc_add (c : FiniteMeasure ℝ)
    (a b d : ℝ) (hab : a ≤ b) (hbd : b ≤ d) :
    ((c.restrict (Set.Ioc a b)).mass : ℝ) +
        ((c.restrict (Set.Ioc b d)).mass : ℝ) =
      ((c.restrict (Set.Ioc a d)).mass : ℝ) := by
  simp only [FiniteMeasure.restrict_mass]
  change (c : Measure ℝ).real (Set.Ioc a b) +
      (c : Measure ℝ).real (Set.Ioc b d) = (c : Measure ℝ).real (Set.Ioc a d)
  rw [← measureReal_union (Set.Ioc_disjoint_Ioc_of_le le_rfl) measurableSet_Ioc,
    Set.Ioc_union_Ioc_eq_Ioc hab hbd]

open Classical in
theorem band_seed_split {m : ℕ} (a : Fin (m + 2) → ℝ)
    (ha0 : a 0 = 0) (s : Fin (m + 1) → ℝ) (δ : ℝ)
    (hδ : 0 ≤ δ) (hδa : δ ≤ a (0 : Fin (m + 1)).succ) (c : FiniteMeasure ℝ) :
    (∑ j, s j * fragmentBandMasses a c j) =
      (∑ j, s j * ((c.restrict
        (Set.Ioc (if j = 0 then δ else a j.castSucc) (a j.succ))).mass : ℝ)) +
          s 0 * ((c.restrict (Set.Ioc (0 : ℝ) δ)).mass : ℝ) := by
  simp only [fragmentBandMasses]
  rw [Fin.sum_univ_succ, Fin.sum_univ_succ]
  simp only [Fin.castSucc_zero, ha0, ite_true, Fin.succ_ne_zero, ite_false]
  rw [← restricted_mass_Ioc_add c 0 δ _ hδ hδa]
  ring

theorem harmonic_disjoint_positive_band_laplace_tendsto {n : ℕ}
    (H : Finset ℕ) (ρ ζ : ℝ) (α β s : Fin n → ℝ)
    (hρ : 0 < ρ) (hζ : 0 < ζ) (hα : ∀ j, 0 < α j)
    (hαβ : ∀ j, α j ≤ β j) (hβζ : ∀ j, β j ≤ ζ)
    (hdis : Pairwise (fun i j => Disjoint (Set.Ioc (α i) (β i))
      (Set.Ioc (α j) (β j)))) :
    Tendsto (fun x : ℝ =>
      (∫ c : FiniteMeasure ℝ,
          Real.exp (-(∑ j, s j * ((c.restrict (Set.Ioc (α j) (β j))).mass : ℝ)))
          ∂(harmonicConfigurationMass (presievingModulus H x) (x ^ ρ) ζ :
            Measure (FiniteMeasure ℝ))) /
        harmonicFragmentMass (presievingModulus H x) (x ^ ρ) ζ)
      atTop (nhds (Real.exp (∑ j, ∫ u in (α j)..(β j),
        (Real.exp (-s j * u) - 1) / u))) := by
  have hp := tendsto_finsetProd Finset.univ (fun j _ =>
    (harmonic_fragment_band_laplace_tendsto H ρ ζ (α j) (β j) (s j)
      hρ hζ (hα j) (hαβ j) (hβζ j)).fst_nhds)
  rw [Real.exp_sum]
  apply hp.congr'
  filter_upwards [(tendsto_rpow_atTop hρ).eventually_gt_atTop 1] with x hx
  exact (harmonic_disjoint_laplace_factorization (presievingModulus H x)
    (x ^ ρ) ζ hx (fun j => Set.Ioc (α j) (β j))
      (fun _ => measurableSet_Ioc) hdis s).symm

theorem laplace_kernel_point_bounds (s u : ℝ) (hs : 0 ≤ s) (hu : 0 < u) :
    (Real.exp (-s * u) - 1) / u ≤ 0 ∧
      ‖(Real.exp (-s * u) - 1) / u‖ ≤ s := by
  have hf : (Real.exp (-s * u) - 1) / u ≤ 0 :=
    div_nonpos_of_nonpos_of_nonneg
      (sub_nonpos.mpr (Real.exp_le_one_iff.mpr
        (mul_nonpos_of_nonpos_of_nonneg (neg_nonpos.mpr hs) hu.le))) hu.le
  refine ⟨hf, ?_⟩
  rw [Real.norm_eq_abs, abs_of_nonpos hf, ← neg_div]
  apply (div_le_iff₀ hu).2
  linarith [Real.add_one_le_exp (-s * u)]

theorem laplace_kernel_intervalIntegrable (s a b : ℝ)
    (hs : 0 ≤ s) (ha : 0 ≤ a) (hab : a ≤ b) :
    IntervalIntegrable (fun u : ℝ => (Real.exp (-s * u) - 1) / u) volume a b := by
  apply (intervalIntegrable_iff_integrableOn_Ioc_of_le hab).mpr
  refine (integrable_const s).mono' (Measurable.aestronglyMeasurable (by fun_prop)) ?_
  filter_upwards [ae_restrict_mem measurableSet_Ioc] with u hu
  exact (laplace_kernel_point_bounds s u hs (ha.trans_lt hu.1)).2

theorem laplace_kernel_interval_bounds (s a b : ℝ)
    (hs : 0 ≤ s) (ha : 0 ≤ a) (hab : a ≤ b) :
    (∫ u in a..b, (Real.exp (-s * u) - 1) / u) ≤ 0 ∧
      |∫ u in a..b, (Real.exp (-s * u) - 1) / u| ≤ s * (b - a) := by
  constructor
  · rw [intervalIntegral.integral_of_le hab]
    apply integral_nonpos_of_ae
    filter_upwards [ae_restrict_mem measurableSet_Ioc] with u hu
    exact (laplace_kernel_point_bounds s u hs (ha.trans_lt hu.1)).1
  · rw [← Real.norm_eq_abs, ← abs_of_nonneg (sub_nonneg.mpr hab)]
    apply intervalIntegral.norm_integral_le_of_norm_le_const
    intro u hu
    rw [Set.uIoc_of_le hab] at hu
    exact (laplace_kernel_point_bounds s u hs (ha.trans_lt hu.1)).2

open Classical in
theorem laplace_kernel_seed_split {m : ℕ} (a : Fin (m + 2) → ℝ)
    (ha0 : a 0 = 0) (s : Fin (m + 1) → ℝ≥0) (δ : ℝ)
    (hδ : 0 ≤ δ) (hδa : δ ≤ a (0 : Fin (m + 1)).succ) :
    (∑ j, ∫ u in (a j.castSucc)..(a j.succ),
      (Real.exp (-(s j : ℝ) * u) - 1) / u) =
      (∑ j, ∫ u in (if j = 0 then δ else a j.castSucc)..(a j.succ),
        (Real.exp (-(s j : ℝ) * u) - 1) / u) +
          ∫ u in (0 : ℝ)..δ, (Real.exp (-(s 0 : ℝ) * u) - 1) / u := by
  rw [Fin.sum_univ_succ, Fin.sum_univ_succ]
  simp only [Fin.castSucc_zero, ha0, ite_true, Fin.succ_ne_zero, ite_false]
  rw [← intervalIntegral.integral_add_adjacent_intervals
    (laplace_kernel_intervalIntegrable (s 0) 0 δ (s 0).coe_nonneg le_rfl hδ)
    (laplace_kernel_intervalIntegrable (s 0) δ _ (s 0).coe_nonneg hδ hδa)]
  ring

open Classical in
theorem joint_laplace_kernel_cutoff_bound {m : ℕ} (a : Fin (m + 2) → ℝ)
    (ha : Monotone a) (ha0 : a 0 = 0) (s : Fin (m + 1) → ℝ≥0) (δ : ℝ)
    (hδ : 0 ≤ δ) (hδa : δ ≤ a (0 : Fin (m + 1)).succ) :
    |Real.exp (∑ j, ∫ u in (a j.castSucc)..(a j.succ),
        (Real.exp (-(s j : ℝ) * u) - 1) / u) -
      Real.exp (∑ j, ∫ u in (if j = 0 then δ else a j.castSucc)..(a j.succ),
        (Real.exp (-(s j : ℝ) * u) - 1) / u)| ≤ (s 0 : ℝ) * δ := by
  let α (j : Fin (m + 1)) : ℝ := if j = 0 then δ else a j.castSucc
  have hα (j : Fin (m + 1)) : 0 ≤ α j := by
    by_cases hj : j = 0
    · simpa [α, hj] using hδ
    · simpa [α, hj, ha0] using ha (Fin.zero_le j.castSucc)
  have hαβ (j : Fin (m + 1)) : α j ≤ a j.succ := by
    by_cases hj : j = 0
    · simpa [α, hj] using hδa
    · simpa [α, hj] using ha j.castSucc_le_succ
  have hJ : (∑ j, ∫ u in (α j)..(a j.succ),
      (Real.exp (-(s j : ℝ) * u) - 1) / u) ≤ 0 :=
    Finset.sum_nonpos fun j _ =>
      (laplace_kernel_interval_bounds (s j) (α j) (a j.succ)
        (s j).coe_nonneg (hα j) (hαβ j)).1
  have hI := laplace_kernel_interval_bounds (s 0) 0 δ (s 0).coe_nonneg le_rfl hδ
  have he := exp_neg_add_sub_bound
    (-(∑ j, ∫ u in (α j)..(a j.succ), (Real.exp (-(s j : ℝ) * u) - 1) / u))
    (-(∫ u in (0 : ℝ)..δ, (Real.exp (-(s 0 : ℝ) * u) - 1) / u))
    (neg_nonneg.mpr hJ) (neg_nonneg.mpr hI.1)
  simp only [neg_add, neg_neg] at he
  rw [laplace_kernel_seed_split a ha0 s δ hδ hδa, abs_sub_comm]
  change |Real.exp (∑ j, ∫ u in (α j)..(a j.succ),
      (Real.exp (-(s j : ℝ) * u) - 1) / u) - _| ≤ _
  rw [abs_of_nonneg he.1]
  exact he.2.trans (by simpa only [abs_of_nonpos hI.1, sub_zero] using hI.2)

open Classical in
theorem harmonic_joint_laplace_cutoff_bound {m : ℕ}
    (W : ℕ) (R ζ : ℝ) (a : Fin (m + 2) → ℝ) (ha0 : a 0 = 0)
    (s : Fin (m + 1) → ℝ≥0) (δ : ℝ) (hδ : 0 ≤ δ)
    (hδa : δ ≤ a (0 : Fin (m + 1)).succ) :
    |(∫ c, Real.exp (-(∑ j, (s j : ℝ) * fragmentBandMasses a c j))
        ∂(harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ))) /
          harmonicFragmentMass W R ζ -
      (∫ c : FiniteMeasure ℝ, Real.exp (-(∑ j, (s j : ℝ) *
          ((c.restrict (Set.Ioc (if j = 0 then δ else a j.castSucc)
            (a j.succ))).mass : ℝ)))
        ∂(harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ))) /
          harmonicFragmentMass W R ζ| ≤
      (s 0 : ℝ) * ((∫ c : FiniteMeasure ℝ,
        ((c.restrict (Set.Ioc (0 : ℝ) δ)).mass : ℝ)
        ∂(harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ))) /
          harmonicFragmentMass W R ζ) := by
  let f (c : FiniteMeasure ℝ) :=
    Real.exp (-(∑ j, (s j : ℝ) * fragmentBandMasses a c j))
  let g (c : FiniteMeasure ℝ) :=
    Real.exp (-(∑ j, (s j : ℝ) *
      ((c.restrict (Set.Ioc (if j = 0 then δ else a j.castSucc) (a j.succ))).mass : ℝ)))
  let t (c : FiniteMeasure ℝ) := ((c.restrict (Set.Ioc (0 : ℝ) δ)).mass : ℝ)
  have hfm : Measurable f :=
    (Finset.measurable_fun_sum Finset.univ fun j _ =>
      (measurable_fragmentBandMasses a).eval.const_mul _).neg.exp
  have hgm : Measurable g :=
    (Finset.measurable_fun_sum Finset.univ fun j _ =>
      (measurable_restricted_mass _ measurableSet_Ioc).const_mul _).neg.exp
  have hfi := integrable_harmonicConfigurationMass W R ζ f hfm.stronglyMeasurable
  have hgi := integrable_harmonicConfigurationMass W R ζ g hgm.stronglyMeasurable
  have hti := integrable_harmonicConfigurationMass W R ζ t
    (measurable_restricted_mass _ measurableSet_Ioc).stronglyMeasurable
  have hpoint (c : FiniteMeasure ℝ) :
      0 ≤ g c - f c ∧ g c - f c ≤ (s 0 : ℝ) * t c := by
    dsimp only [f, g, t]
    rw [band_seed_split a ha0 (fun j => (s j : ℝ)) δ hδ hδa c]
    apply exp_neg_add_sub_bound <;> positivity
  have hnonneg :
      0 ≤ (∫ c, g c ∂(harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ))) -
        (∫ c, f c ∂(harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ))) := by
    rw [← integral_sub hgi hfi]
    exact integral_nonneg fun c => (hpoint c).1
  have hle :
      (∫ c, g c ∂(harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ))) -
        (∫ c, f c ∂(harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ))) ≤
      (s 0 : ℝ) *
        (∫ c, t c ∂(harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ))) := by
    rw [← integral_sub hgi hfi, ← integral_const_mul]
    exact integral_mono (hgi.sub hfi) (hti.const_mul (s 0 : ℝ))
      (fun c => (hpoint c).2)
  change |(∫ c, f c ∂(harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ))) /
      harmonicFragmentMass W R ζ -
    (∫ c, g c ∂(harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ))) /
      harmonicFragmentMass W R ζ| ≤ _
  rw [← sub_div, abs_div, abs_of_pos (harmonic_fragment_mass_pos W R ζ),
    abs_sub_comm, abs_of_nonneg hnonneg]
  exact (div_le_div_of_nonneg_right hle (harmonic_fragment_mass_pos W R ζ).le).trans_eq
    (mul_div_assoc _ _ _)

theorem tendsto_of_cutoff_approximations
    (f : ℝ → ℝ) (F : ℝ → ℝ → ℝ) (K : ℝ) (G : ℝ → ℝ)
    (a s : ℝ) (r : ℝ → ℝ) (ha : 0 < a) (hs : 0 ≤ s)
    (hr : Tendsto r atTop (𝓝 0))
    (hF : ∀ δ, 0 < δ → δ < a → Tendsto (F δ) atTop (𝓝 (G δ)))
    (happrox : ∀ δ, 0 < δ → δ < a →
      ∀ᶠ x in atTop, |f x - F δ x| ≤ s * (δ + r x))
    (hG : ∀ δ, 0 < δ → δ < a → |K - G δ| ≤ s * δ) :
    Tendsto f atTop (𝓝 K) := by
  refine Metric.tendsto_nhds.mpr fun ε hε => ?_
  let δ := min (a / 2) (ε / (8 * (s + 1)))
  have hden : 0 < 8 * (s + 1) := by positivity
  have hδpos : 0 < δ := by positivity
  have hδa : δ < a := lt_of_le_of_lt (min_le_left _ _) (by linarith)
  have hδε : δ * (8 * (s + 1)) ≤ ε :=
    (le_div_iff₀ hden).mp (min_le_right _ _)
  have hFε := (Metric.tendsto_nhds.mp (hF δ hδpos hδa)) (ε / 4) (by positivity)
  have hrδ := hr.eventually_lt_const hδpos
  filter_upwards [happrox δ hδpos hδa, hFε, hrδ] with x hfx hFx hrx
  have hGδ := hG δ hδpos hδa
  simp only [← Real.dist_eq] at hfx hGδ
  have hsr : s * r x ≤ s * δ := mul_le_mul_of_nonneg_left hrx.le hs
  nlinarith only [hfx, hFx, hGδ, hsr, hδε, hδpos, hε,
    dist_triangle4_right (f x) K (F δ x) (G δ)]

theorem joint_band_laplace_fragmentLaw {m : ℕ} (ζ : ℝ)
    (a : Fin (m + 2) → ℝ) (s : Fin (m + 1) → ℝ≥0)
    (ha : StrictMono a) (ha0 : a 0 = 0)
    (haLast : a (Fin.last (m + 1)) = ζ) :
    (∫ c, Real.exp (-(∑ j, (s j : ℝ) * fragmentBandMasses a c j))
      ∂(fragmentLaw ζ)) =
      Real.exp (∑ j, ∫ u in (a j.castSucc)..(a j.succ),
        (Real.exp (-(s j : ℝ) * u) - 1) / u) := by
  classical
  let : IsProbabilityMeasure (fragmentLaw ζ) := fragmentLaw_isProbabilityMeasure ζ
  let I (j : Fin (m + 1)) := Set.Ioc (a j.castSucc) (a j.succ)
  let h (u : ℝ) := ∑ j, (I j).indicator (fun _ => (s j : ℝ)) u
  let k (u : ℝ) := (1 - Real.exp (-h u * u)) / u
  have hI (j : Fin (m + 1)) : MeasurableSet (I j) := measurableSet_Ioc
  have hdis : Pairwise (fun i j : Fin (m + 1) => Disjoint (I i) (I j)) :=
    pairwise_disjoint_adjacent_Ioc a ha.monotone
  have hsub (j : Fin (m + 1)) : I j ⊆ Set.Ioc (0 : ℝ) ζ := by
    rw [← ha0, ← haLast]
    exact Set.Ioc_subset_Ioc (ha.monotone (Fin.zero_le _)) (ha.monotone (Fin.le_last _))
  have hh : Measurable h :=
    Finset.measurable_fun_sum _ fun j _ => measurable_const.indicator (hI j)
  have hh_nonneg (u : ℝ) : 0 ≤ h u :=
    Finset.sum_nonneg fun j _ =>
      Set.indicator_nonneg (fun _ _ => (s j).coe_nonneg) u
  have h_at {u : ℝ} {j : Fin (m + 1)} (hu : u ∈ I j) : h u = s j := by
    dsimp only [h]
    rw [Finset.sum_eq_single j]
    · exact Set.indicator_of_mem hu _
    · intro i _ hij
      exact Set.indicator_of_notMem (fun hi => Set.disjoint_left.mp (hdis hij) hi hu) _
    · simp
  have hk_nonneg : ∀ᵐ u ∂volume.restrict (Set.Ioc (0 : ℝ) ζ), 0 ≤ k u :=
    ae_restrict_of_forall_mem measurableSet_Ioc fun u hu => by
      simpa only [k, ← neg_div, neg_sub] using
        neg_nonneg.mpr (laplace_kernel_point_bounds (h u) u (hh_nonneg u) hu.1).1
  have hk_scalar_int (j : Fin (m + 1)) :
      Integrable (fun u : ℝ => (1 - Real.exp (-(s j : ℝ) * u)) / u)
        (volume.restrict (Set.Ioc (0 : ℝ) ζ)) := by
    have hζ : 0 ≤ ζ := by
      simpa only [ha0, haLast] using ha.monotone (Fin.zero_le (Fin.last (m + 1)))
    simpa only [IntegrableOn, Pi.neg_def, ← neg_div, neg_sub] using
      (laplace_kernel_intervalIntegrable (s j) 0 ζ (s j).coe_nonneg le_rfl hζ).1.neg
  have hk_point (u : ℝ) :
      k u = ∑ j, (I j).indicator
        (fun u => (1 - Real.exp (-(s j : ℝ) * u)) / u) u := by
    by_cases hex : ∃ j, u ∈ I j
    · obtain ⟨j, hj⟩ := hex
      rw [Finset.sum_eq_single j]
      · rw [Set.indicator_of_mem hj]
        dsimp only [k]
        rw [h_at hj]
      · intro i _ hij
        exact Set.indicator_of_notMem (fun hi => Set.disjoint_left.mp (hdis hij) hi hj) _
      · simp
    · have ho : ∀ j, u ∉ I j := not_exists.mp hex
      simp [k, h, ho]
  have hk_int : Integrable k (volume.restrict (Set.Ioc (0 : ℝ) ζ)) :=
    (integrable_finsetSum Finset.univ fun j _ => (hk_scalar_int j).indicator (hI j)).congr
      (Eventually.of_forall fun u => (hk_point u).symm)
  have hk_sum :
      (∫ u in Set.Ioc (0 : ℝ) ζ, k u) =
        ∑ j, ∫ u in I j, (1 - Real.exp (-(s j : ℝ) * u)) / u := by
    simp_rw [hk_point]
    rw [integral_finsetSum Finset.univ
      (fun j _ => (hk_scalar_int j).indicator (hI j))]
    apply Finset.sum_congr rfl
    intro j _
    rw [setIntegral_indicator (hI j), Set.inter_eq_right.mpr (hsub j)]
  have hstep_int (c : FiniteMeasure ℝ) : Integrable h (c : Measure ℝ) :=
    integrable_finsetSum Finset.univ fun j _ =>
      (integrable_const (s j : ℝ)).indicator (hI j)
  have hstep_integral (c : FiniteMeasure ℝ) :
      (∫ u, h u ∂(c : Measure ℝ)) =
        ∑ j, (s j : ℝ) * fragmentBandMasses a c j := by
    dsimp only [h]
    rw [integral_finsetSum Finset.univ
      (fun j _ => (integrable_const (s j : ℝ)).indicator (hI j))]
    apply Finset.sum_congr rfl
    intro j _
    rw [integral_indicator_const _ (hI j)]
    simp only [smul_eq_mul, FiniteMeasure.measureReal_eq_coe_coeFn,
      fragmentBandMasses, FiniteMeasure.restrict_mass, I]
    exact mul_comm _ _
  have hpoint (c : FiniteMeasure ℝ) :
      EReal.exp (-((∫⁻ u, ENNReal.ofReal (h u) ∂(c : Measure ℝ)) : EReal)) =
        ENNReal.ofReal
          (Real.exp (-(∑ j, (s j : ℝ) * fragmentBandMasses a c j))) := by
    rw [← ofReal_integral_eq_lintegral_ofReal (hstep_int c)
      (Filter.Eventually.of_forall hh_nonneg), EReal.coe_ennreal_ofReal,
      max_eq_left (integral_nonneg hh_nonneg), ← EReal.coe_neg,
      EReal.exp_coe, hstep_integral]
  have hinner (u : ℝ) (hu : 0 ≤ u) :
      EReal.exp (-((ENNReal.ofReal u * ENNReal.ofReal (h u) : ℝ≥0∞) : EReal)) =
        ENNReal.ofReal (Real.exp (-h u * u)) := by
    rw [mul_comm (ENNReal.ofReal u) (ENNReal.ofReal (h u)),
      ← ENNReal.ofReal_mul (hh_nonneg u), EReal.coe_ennreal_ofReal,
      max_eq_left (mul_nonneg (hh_nonneg u) hu),
      ← EReal.coe_neg, EReal.exp_coe]
    simp only [neg_mul]
  have hintensity :
      (∫⁻ u, 1 - EReal.exp
        (-((ENNReal.ofReal u * ENNReal.ofReal (h u) : ℝ≥0∞) : EReal))
        ∂((volume.restrict (Set.Ioc (0 : ℝ) ζ)).withDensity
          (fun u : ℝ => ENNReal.ofReal (1 / u)))) =
        ENNReal.ofReal (∫ u in Set.Ioc (0 : ℝ) ζ, k u) := by
    rw [ofReal_integral_eq_lintegral_ofReal hk_int hk_nonneg,
      lintegral_withDensity_eq_lintegral_mul _ (by fun_prop) (by fun_prop)]
    refine lintegral_congr_ae ?_
    filter_upwards [ae_restrict_mem measurableSet_Ioc] with u hu
    change ENNReal.ofReal (1 / u) *
        (1 - EReal.exp
          (-((ENNReal.ofReal u * ENNReal.ofReal (h u) : ℝ≥0∞) : EReal))) =
      ENNReal.ofReal ((1 - Real.exp (-h u * u)) / u)
    rw [hinner u hu.1.le, ← ENNReal.ofReal_one,
      ← ENNReal.ofReal_sub 1 (Real.exp_nonneg _),
      ← ENNReal.ofReal_mul (div_nonneg zero_le_one hu.1.le)]
    congr 1
    ring
  have hleft_int : Integrable
      (fun c => Real.exp (-(∑ j, (s j : ℝ) * fragmentBandMasses a c j)))
      (fragmentLaw ζ) := by
    have hsum : Measurable
        (fun c : FiniteMeasure ℝ => ∑ j, (s j : ℝ) * fragmentBandMasses a c j) :=
      Finset.measurable_fun_sum _ fun j _ =>
        measurable_const.mul (measurable_fragmentBandMasses a).eval
    refine (integrable_const (1 : ℝ)).mono' hsum.neg.exp.aestronglyMeasurable ?_
    exact Filter.Eventually.of_forall fun c => by
      rw [Real.norm_eq_abs, abs_of_pos (Real.exp_pos _)]
      apply Real.exp_le_one_iff.mpr
      exact neg_nonpos.mpr (Finset.sum_nonneg fun j _ =>
        mul_nonneg (s j).coe_nonneg (NNReal.coe_nonneg _))
  have horientation :
      (∑ j, ∫ u in (a j.castSucc)..(a j.succ),
        (Real.exp (-(s j : ℝ) * u) - 1) / u) =
        -(∫ u in Set.Ioc (0 : ℝ) ζ, k u) := by
    rw [hk_sum, ← Finset.sum_neg_distrib]
    apply Finset.sum_congr rfl
    intro j _
    rw [intervalIntegral.integral_of_le (ha.monotone j.castSucc_le_succ), ← integral_neg]
    apply integral_congr_ae
    exact Filter.Eventually.of_forall fun u => by ring
  have hmain := lintegral_exp_neg_fragmentLaw ζ (fun u => ENNReal.ofReal (h u))
    hh.ennreal_ofReal
  simp_rw [hpoint] at hmain
  rw [← ofReal_integral_eq_lintegral_ofReal hleft_int
      (Filter.Eventually.of_forall fun _ => Real.exp_nonneg _),
    hintensity, EReal.coe_ennreal_ofReal,
    max_eq_left (integral_nonneg_of_ae hk_nonneg),
    ← EReal.coe_neg, EReal.exp_coe] at hmain
  rw [horientation]
  exact (ENNReal.ofReal_eq_ofReal_iff
    (integral_nonneg fun _ => Real.exp_nonneg _) (Real.exp_nonneg _)).1 hmain

theorem harmonic_fragment_joint_band_laplace_tendsto
    {m : ℕ} (H : Finset ℕ) (ρ ζ : ℝ)
    (a : Fin (m + 2) → ℝ) (s : Fin (m + 1) → ℝ≥0)
    (hρ : 0 < ρ) (hζ : 0 < ζ)
    (ha : StrictMono a) (ha0 : a 0 = 0)
    (haLast : a (Fin.last (m + 1)) = ζ) :
    let L : FiniteMeasure ℝ → ℝ := fun c =>
      Real.exp (-(∑ j, (s j : ℝ) * fragmentBandMasses a c j))
    let K : ℝ := Real.exp (∑ j,
      ∫ u in (a j.castSucc)..(a j.succ),
        (Real.exp (-(s j : ℝ) * u) - 1) / u)
    (∫ c, L c ∂(fragmentLaw ζ)) = K ∧
      Filter.Tendsto
        (fun x : ℝ =>
          let W := presievingModulus H x
          let R := x ^ ρ
          (∫ c, L c
            ∂(harmonicConfigurationMass W R ζ : Measure (FiniteMeasure ℝ))) /
            harmonicFragmentMass W R ζ)
        Filter.atTop (nhds K) := by
  classical
  dsimp only
  refine ⟨joint_band_laplace_fragmentLaw ζ a s ha ha0 haLast, ?_⟩
  obtain ⟨C, _, hseed⟩ := seed_global_bound
  let f (x : ℝ) :=
    (∫ c, Real.exp (-(∑ j, (s j : ℝ) * fragmentBandMasses a c j))
      ∂(harmonicConfigurationMass (presievingModulus H x) (x ^ ρ) ζ :
        Measure (FiniteMeasure ℝ))) /
          harmonicFragmentMass (presievingModulus H x) (x ^ ρ) ζ
  let F (δ x : ℝ) :=
    (∫ c : FiniteMeasure ℝ, Real.exp (-(∑ j, (s j : ℝ) *
        ((c.restrict (Set.Ioc (if j = 0 then δ else a j.castSucc) (a j.succ))).mass : ℝ)))
      ∂(harmonicConfigurationMass (presievingModulus H x) (x ^ ρ) ζ :
        Measure (FiniteMeasure ℝ))) /
          harmonicFragmentMass (presievingModulus H x) (x ^ ρ) ζ
  let G (δ : ℝ) :=
    Real.exp (∑ j, ∫ u in (if j = 0 then δ else a j.castSucc)..(a j.succ),
      (Real.exp (-(s j : ℝ) * u) - 1) / u)
  have ha1 : 0 < a (0 : Fin (m + 1)).succ := by
    simpa only [ha0] using ha (Fin.succ_pos 0)
  apply tendsto_of_cutoff_approximations f F _ G
    (a (0 : Fin (m + 1)).succ) (s 0 : ℝ) (fun x => C / Real.log (x ^ ρ))
    ha1 (s 0).coe_nonneg (logarithmic_error_vanishes ρ C hρ)
  · intro δ hδ hδa
    let α (j : Fin (m + 1)) : ℝ := if j = 0 then δ else a j.castSucc
    have hα (j : Fin (m + 1)) : 0 < α j := by
      by_cases hj : j = 0
      · simpa [α, hj] using hδ
      · have hp := ha (Fin.castSucc_pos (Fin.pos_iff_ne_zero.mpr hj))
        simpa [α, hj, ha0] using hp
    have hαβ (j : Fin (m + 1)) : α j ≤ a j.succ := by
      by_cases hj : j = 0
      · simpa [α, hj] using hδa.le
      · simpa [α, hj] using ha.monotone j.castSucc_le_succ
    have hβζ (j : Fin (m + 1)) : a j.succ ≤ ζ := by
      rw [← haLast]
      exact ha.monotone (Fin.le_last _)
    have hsub (j : Fin (m + 1)) :
        Set.Ioc (α j) (a j.succ) ⊆ Set.Ioc (a j.castSucc) (a j.succ) := by
      apply Set.Ioc_subset_Ioc_left
      by_cases hj : j = 0
      · simpa [α, hj, ha0] using hδ.le
      · simp [α, hj]
    have hdis : Pairwise (fun i j : Fin (m + 1) =>
        Disjoint (Set.Ioc (α i) (a i.succ)) (Set.Ioc (α j) (a j.succ))) := by
      intro i j hij
      exact (pairwise_disjoint_adjacent_Ioc a ha.monotone hij).mono (hsub i) (hsub j)
    exact harmonic_disjoint_positive_band_laplace_tendsto H ρ ζ α
      (fun j => a j.succ) (fun j => (s j : ℝ)) hρ hζ hα hαβ hβζ hdis
  · intro δ hδ hδa
    filter_upwards [(tendsto_rpow_atTop hρ).eventually_gt_atTop 1] with x hx
    have he := (hseed (presievingModulus H x) (x ^ ρ) ζ δ hx hδ.le).2
    exact (harmonic_joint_laplace_cutoff_bound (presievingModulus H x) (x ^ ρ) ζ
      a ha0 s δ hδ.le hδa.le).trans (mul_le_mul_of_nonneg_left he (s 0).coe_nonneg)
  · intro δ hδ hδa
    exact joint_laplace_kernel_cutoff_bound a ha.monotone ha0 s δ hδ.le hδa.le

end PrimeGap186

namespace MeasureTheory

theorem FiniteMeasure.mass_map_of_aemeasurable
    {Ω Ω' : Type*} [MeasurableSpace Ω] [MeasurableSpace Ω']
    (μ : FiniteMeasure Ω) {f : Ω → Ω'} (hf : AEMeasurable f (μ : Measure Ω)) :
    (μ.map f).mass = μ.mass := by
  simpa [FiniteMeasure.mass] using μ.map_apply_of_aemeasurable hf .univ

theorem FiniteMeasure.normalize_map
    {Ω Ω' : Type*} [MeasurableSpace Ω] [MeasurableSpace Ω']
    [Nonempty Ω] [Nonempty Ω'] (μ : FiniteMeasure Ω) (hμ : μ ≠ 0)
    {f : Ω → Ω'} (hf : Measurable f) :
    (μ.map f).normalize = μ.normalize.map f := by
  have hmass : (μ.map f).mass = μ.mass :=
    μ.mass_map_of_aemeasurable hf.aemeasurable
  apply ProbabilityMeasure.toMeasure_injective
  rw [(μ.map f).toMeasure_normalize_eq_of_nonzero (by
      simpa only [← FiniteMeasure.mass_nonzero_iff, hmass] using hμ),
    ProbabilityMeasure.toMeasure_map, μ.toMeasure_normalize_eq_of_nonzero hμ,
    Measure.map_smul _ hf.aemeasurable, hmass, FiniteMeasure.toMeasure_map]

theorem FiniteMeasure.inv_toNNReal_smul_eq_mass_div_smul_normalize
    {Ω : Type*} [MeasurableSpace Ω] [Nonempty Ω] (μ : FiniteMeasure Ω) (b : ℝ) :
    (b⁻¹).toNNReal • μ =
      (μ.mass.toReal / b).toNNReal • μ.normalize.toFiniteMeasure := by
  nth_rw 1 [μ.self_eq_mass_smul_normalize]
  rw [smul_smul, Real.toNNReal_div μ.mass.coe_nonneg, Real.toNNReal_coe,
    Real.toNNReal_inv, div_eq_mul_inv, mul_comm]

theorem isTightMeasureSet_range_nnreal_pi_of_lintegral_sum_le
    {I ι : Type*} [Fintype ι] (μ : I → Measure (ι → ℝ≥0)) (C : ℝ≥0)
    (hμ : ∀ i, (∫⁻ v, ∑ j, (v j : ℝ≥0∞) ∂μ i) ≤ C) :
    IsTightMeasureSet (Set.range μ) := by
  classical
  refine isTightMeasureSet_iff_exists_isCompact_measure_compl_le.mpr ?_
  intro ε hε
  obtain ⟨r, hr, hrε⟩ := ENNReal.exists_nnreal_pos_mul_lt
    (a := (C : ℝ≥0∞)) ENNReal.coe_ne_top hε.ne'
  refine ⟨Set.Icc (0 : ι → ℝ≥0) (fun _ ↦ r⁻¹), isCompact_Icc, ?_⟩
  rintro ν ⟨i, rfl⟩
  have hsubset : (Set.Icc (0 : ι → ℝ≥0) (fun _ ↦ r⁻¹))ᶜ ⊆
      {v | ((r⁻¹ : ℝ≥0) : ℝ≥0∞) ≤ ∑ j, (v j : ℝ≥0∞)} := by
    intro v hv
    obtain ⟨j, hj⟩ : ∃ j, r⁻¹ < v j := by
      simpa [Set.mem_Icc, Pi.le_def, not_forall] using hv
    exact (ENNReal.coe_le_coe.mpr hj.le).trans
      (Finset.single_le_sum (f := fun j ↦ (v j : ℝ≥0∞))
        (fun _ _ ↦ zero_le) (Finset.mem_univ j))
  calc
    μ i (Set.Icc (0 : ι → ℝ≥0) (fun _ ↦ r⁻¹))ᶜ ≤
        μ i {v | ((r⁻¹ : ℝ≥0) : ℝ≥0∞) ≤ ∑ j, (v j : ℝ≥0∞)} :=
      measure_mono hsubset
    _ ≤ (∫⁻ v, ∑ j, (v j : ℝ≥0∞) ∂μ i) / ((r⁻¹ : ℝ≥0) : ℝ≥0∞) :=
      meas_ge_le_lintegral_div (Measurable.aemeasurable (by fun_prop))
        (by simp [hr.ne']) ENNReal.coe_ne_top
    _ ≤ (C : ℝ≥0∞) / ((r⁻¹ : ℝ≥0) : ℝ≥0∞) :=
      ENNReal.div_le_div_right (hμ i) _
    _ ≤ ε := by
      rw [ENNReal.coe_inv hr.ne', div_eq_mul_inv, inv_inv, mul_comm]
      exact hrε.le

theorem tendsto_of_tight_of_joint_nonnegative_laplace
    {d : ℕ} {ι : Type*} {l : Filter ι}
    {μ : ι → ProbabilityMeasure (Fin d → ℝ≥0)}
    {ν : ProbabilityMeasure (Fin d → ℝ≥0)}
    (ht : IsTightMeasureSet
      (Set.range (fun i => (μ i : Measure (Fin d → ℝ≥0)))))
    (hL : ∀ s : Fin d → ℝ≥0,
      Tendsto
        (fun i => ∫ v, Real.exp (-(∑ j, (s j : ℝ) * (v j : ℝ)))
          ∂(μ i : Measure (Fin d → ℝ≥0))) l
        (𝓝 (∫ v, Real.exp (-(∑ j, (s j : ℝ) * (v j : ℝ)))
          ∂(ν : Measure (Fin d → ℝ≥0))))) :
    Tendsto μ l (𝓝 ν) := by
  classical
  let E := Fin d → ℝ≥0
  have hc (s : Fin d → ℝ≥0) :
      Continuous (fun v : E => Real.exp (-(∑ j, (s j : ℝ) * (v j : ℝ)))) := by
    fun_prop
  have hb (s : Fin d → ℝ≥0) (v : E) :
      ‖Real.exp (-(∑ j, (s j : ℝ) * (v j : ℝ)))‖ ≤ 1 := by
    rw [Real.norm_eq_abs, abs_of_pos (Real.exp_pos _)]
    apply Real.exp_le_one_iff.mpr
    exact neg_nonpos.mpr (by positivity)
  let L : (Fin d → ℝ≥0) → E →ᵇ ℝ := fun s =>
    BoundedContinuousFunction.ofNormedAddCommGroup
      (fun v => Real.exp (-(∑ j, (s j : ℝ) * (v j : ℝ)))) (hc s) 1 (hb s)
  have hzero : L 0 = 1 := by
    ext v
    simp [L]
  have hmul (s t : Fin d → ℝ≥0) : L s * L t = L (s + t) := by
    ext v
    simp [L, ← Real.exp_add, add_mul, Finset.sum_add_distrib, add_comm]
  have hstar (f : E →ᵇ ℝ) : star f = f := by
    ext v
    simp
  let S : Submonoid (E →ᵇ ℝ) :=
    { carrier := Set.range L
      one_mem' := ⟨0, hzero⟩
      mul_mem' := by
        rintro _ _ ⟨s, rfl⟩ ⟨t, rfl⟩
        exact ⟨s + t, (hmul s t).symm⟩ }
  let A := StarAlgebra.adjoin ℝ (Set.range L)
  have hstars : star (Set.range L) = Set.range L := by
    ext f
    simp only [Set.mem_star, hstar]
  have hspan : A.toSubalgebra.toSubmodule = Submodule.span ℝ (Set.range L) := by
    dsimp [A]
    rw [StarAlgebra.adjoin_eq_span, hstars, Set.union_self]
    change Submodule.span ℝ ((Submonoid.closure (S : Set (E →ᵇ ℝ))) : Set (E →ᵇ ℝ)) = _
    rw [Submonoid.closure_eq]
    rfl
  have hsep :
      (A.map (BoundedContinuousFunction.toContinuousMapStarₐ ℝ)).SeparatesPoints := by
    intro v w hvw
    obtain ⟨j, hj⟩ := Function.ne_iff.mp hvw
    let s : Fin d → ℝ≥0 := Pi.single j 1
    refine ⟨(L s : E → ℝ), ?_, ?_⟩
    · refine ⟨(L s).toContinuousMap, ?_, rfl⟩
      exact StarSubalgebra.mem_map.mpr
        ⟨L s, StarAlgebra.subset_adjoin ℝ (Set.range L) ⟨s, rfl⟩, rfl⟩
    · simpa [L, s, Pi.single_apply, apply_ite] using hj
  apply ProbabilityMeasure.tendsto_of_tight_of_separatesPoints ℝ ht hsep
  intro g hg
  change g ∈ A.toSubalgebra.toSubmodule at hg
  rw [hspan] at hg
  induction hg using Submodule.span_induction with
  | mem g hg =>
    obtain ⟨s, rfl⟩ := hg
    exact hL s
  | zero => simpa using (tendsto_const_nhds : Tendsto (fun _ : ι => (0 : ℝ)) l (𝓝 0))
  | add f g _ _ hf hg =>
    simpa only [BoundedContinuousFunction.coe_add, Pi.add_apply, integral_add,
      BoundedContinuousFunction.integrable] using hf.add hg
  | smul a f _ hf =>
    simpa only [BoundedContinuousFunction.coe_smul, integral_smul] using hf.const_smul a

end MeasureTheory

namespace PrimeGap186

theorem measurable_nnreal_fragmentBandMasses {m : ℕ}
    (a : Fin (m + 2) → ℝ) :
    Measurable (fun c : FiniteMeasure ℝ => fun j : Fin (m + 1) =>
      (c.restrict (Set.Ioc (a j.castSucc) (a j.succ))).mass) := by
  apply measurable_pi_lambda
  intro j
  exact measurable_coe_nnreal_real_iff.mp
    (measurable_restricted_mass _ measurableSet_Ioc)

theorem normalized_nnreal_band_moment_bound :
    ∃ C : ℝ, 0 < C ∧ ∀ (W : ℕ) (R ζ : ℝ) {m : ℕ} (a : Fin (m + 2) → ℝ),
      Monotone a → a 0 = 0 → a (Fin.last (m + 1)) = ζ → 0 ≤ ζ → 1 < R →
      (∫⁻ v : Fin (m + 1) → ℝ≥0, ∑ j, (v j : ℝ≥0∞)
        ∂(((harmonicConfigurationMass W R ζ).normalize.map
          (fun c : FiniteMeasure ℝ => fun j : Fin (m + 1) =>
            (c.restrict (Set.Ioc (a j.castSucc) (a j.succ))).mass)) :
            Measure (Fin (m + 1) → ℝ≥0))) ≤
        ENNReal.ofReal (ζ + C / Real.log R) := by
  obtain ⟨C, hC, hbound⟩ := seed_global_bound
  refine ⟨C, hC, ?_⟩
  intro W R ζ m a ha ha0 haLast hζ hR
  have hsum (c : FiniteMeasure ℝ) :
      (∑ j : Fin (m + 1), (c.restrict
        (Set.Ioc (a j.castSucc) (a j.succ))).mass) =
          (c.restrict (Set.Ioc (0 : ℝ) ζ)).mass := by
    apply NNReal.coe_injective
    simpa only [NNReal.coe_sum, fragmentBandMasses, ha0, haLast] using
      sum_fragmentBandMasses a ha c
  rw [ProbabilityMeasure.toMeasure_map,
    lintegral_map (by fun_prop) (measurable_nnreal_fragmentBandMasses a)]
  simp_rw [← ENNReal.ofNNReal_finsetSum, hsum]
  rw [lintegral_coe_eq_integral _ ?_, integral_normalize_harmonicConfigurationMass]
  · exact ENNReal.ofReal_le_ofReal (hbound W R ζ ζ hR hζ).2
  · rw [(harmonicConfigurationMass W R ζ).toMeasure_normalize_eq_of_nonzero
      (harmonicConfigurationMass_ne_zero W R ζ)]
    exact (integrable_harmonicConfigurationMass W R ζ _
      (measurable_restricted_mass _ measurableSet_Ioc).stronglyMeasurable).smul_measure_nnreal

theorem harmonic_fragment_band_vector_tendsto
    {m : ℕ} (H : Finset ℕ) (ρ ζ : ℝ)
    (a : Fin (m + 2) → ℝ)
    (hρ : 0 < ρ) (hζ : 0 < ζ)
    (ha : StrictMono a) (ha0 : a 0 = 0)
    (haLast : a (Fin.last (m + 1)) = ζ) :
    let P : ProbabilityMeasure (FiniteMeasure ℝ) :=
      ⟨fragmentLaw ζ, fragmentLaw_isProbabilityMeasure ζ⟩
    let ν : FiniteMeasure (Fin (m + 1) → ℝ) :=
      P.toFiniteMeasure.map (fragmentBandMasses a)
    Filter.Tendsto
      (fun x : ℝ =>
        let W := presievingModulus H x
        let R := x ^ ρ
        let V := (harmonicConfigurationMass W R ζ).map (fragmentBandMasses a)
        (V.normalize, ((fragmentNormalization W R)⁻¹).toNNReal • V))
      Filter.atTop
      (nhds (ν.normalize,
        (Real.exp Real.eulerMascheroniConstant * ζ).toNNReal • ν)) := by
  classical
  have hJoint (s : Fin (m + 1) → ℝ≥0) :
      Tendsto
        (fun x : ℝ =>
          (∫ c : FiniteMeasure ℝ,
            Real.exp (-(∑ j, (s j : ℝ) * fragmentBandMasses a c j))
              ∂(harmonicConfigurationMass (presievingModulus H x) (x ^ ρ) ζ :
                Measure (FiniteMeasure ℝ))) /
            harmonicFragmentMass (presievingModulus H x) (x ^ ρ) ζ)
        atTop (𝓝 (∫ c : FiniteMeasure ℝ,
          Real.exp (-(∑ j, (s j : ℝ) * fragmentBandMasses a c j)) ∂fragmentLaw ζ)) := by
    have h := harmonic_fragment_joint_band_laplace_tendsto H ρ ζ a s hρ hζ ha ha0 haLast
    dsimp only at h
    rw [h.1]
    exact h.2
  let E := Fin (m + 1) → ℝ≥0
  let q : FiniteMeasure ℝ → E := fun c j =>
    (c.restrict (Set.Ioc (a j.castSucc) (a j.succ))).mass
  have hq : Measurable q := measurable_nnreal_fragmentBandMasses a
  let e : E → Fin (m + 1) → ℝ := fun v j => (v j : ℝ)
  have he : Continuous e := by fun_prop
  have hf : Measurable (fragmentBandMasses a) := measurable_fragmentBandMasses a
  let U : ℝ → FiniteMeasure (FiniteMeasure ℝ) := fun x =>
    harmonicConfigurationMass (presievingModulus H x) (x ^ ρ) ζ
  let B : ℝ → ℝ := fun x => fragmentNormalization (presievingModulus H x) (x ^ ρ)
  let μ : ℝ → ProbabilityMeasure E := fun x => (U x).normalize.map q
  let P : ProbabilityMeasure (FiniteMeasure ℝ) :=
    ⟨fragmentLaw ζ, fragmentLaw_isProbabilityMeasure ζ⟩
  let νp : ProbabilityMeasure E := P.map q
  let V : ℝ → FiniteMeasure (Fin (m + 1) → ℝ) :=
    fun x => (U x).map (fragmentBandMasses a)
  let ν : FiniteMeasure (Fin (m + 1) → ℝ) :=
    P.toFiniteMeasure.map (fragmentBandMasses a)
  change Tendsto (fun x => ((V x).normalize, ((B x)⁻¹).toNNReal • V x)) atTop
    (𝓝 (ν.normalize, (Real.exp Real.eulerMascheroniConstant * ζ).toNNReal • ν))
  have htest (s : Fin (m + 1) → ℝ≥0) :
      StronglyMeasurable (fun v : E => Real.exp (-(∑ j, (s j : ℝ) * (v j : ℝ)))) := by
    fun_prop
  have hxLap (x : ℝ) (s : Fin (m + 1) → ℝ≥0) :
      (∫ v, Real.exp (-(∑ j, (s j : ℝ) * (v j : ℝ))) ∂(μ x : Measure E)) =
        (∫ c : FiniteMeasure ℝ,
          Real.exp (-(∑ j, (s j : ℝ) * fragmentBandMasses a c j))
            ∂(U x : Measure (FiniteMeasure ℝ))) /
          harmonicFragmentMass (presievingModulus H x) (x ^ ρ) ζ := by
    dsimp only [μ]
    rw [ProbabilityMeasure.toMeasure_map, integral_map_of_stronglyMeasurable hq (htest s)]
    exact integral_normalize_harmonicConfigurationMass _ _ _ _
  have hνLap (s : Fin (m + 1) → ℝ≥0) :
      (∫ v, Real.exp (-(∑ j, (s j : ℝ) * (v j : ℝ))) ∂(νp : Measure E)) =
        ∫ c : FiniteMeasure ℝ,
          Real.exp (-(∑ j, (s j : ℝ) * fragmentBandMasses a c j)) ∂fragmentLaw ζ :=
    integral_map_of_stronglyMeasurable hq (htest s)
  have hLap (s : Fin (m + 1) → ℝ≥0) :
      Tendsto
        (fun x => ∫ v, Real.exp (-(∑ j, (s j : ℝ) * (v j : ℝ))) ∂(μ x : Measure E))
        atTop
        (𝓝 (∫ v, Real.exp (-(∑ j, (s j : ℝ) * (v j : ℝ))) ∂(νp : Measure E))) := by
    rw [hνLap s]
    exact (hJoint s).congr' (Eventually.of_forall fun x => (hxLap x s).symm)
  obtain ⟨C, _hC, hbound⟩ := normalized_nnreal_band_moment_bound
  obtain ⟨X, hX⟩ := eventually_atTop.mp
    (((tendsto_rpow_atTop hρ).eventually_gt_atTop 1).and
      ((logarithmic_error_vanishes ρ C hρ).eventually_le_const zero_lt_one))
  let μ' : ℝ → ProbabilityMeasure E := fun x => μ (max x X)
  have hmoment (x : ℝ) :
      (∫⁻ v : E, ∑ j, (v j : ℝ≥0∞) ∂(μ' x : Measure E)) ≤
        ((ζ + 1).toNNReal : ℝ≥0∞) := by
    obtain ⟨hRx, hEx⟩ := hX (max x X) (le_max_right _ _)
    calc
      _ ≤ ENNReal.ofReal (ζ + C / Real.log ((max x X) ^ ρ)) :=
        hbound (presievingModulus H (max x X)) ((max x X) ^ ρ) ζ
          a ha.monotone ha0 haLast hζ.le hRx
      _ ≤ ENNReal.ofReal (ζ + 1) := ENNReal.ofReal_le_ofReal (add_le_add le_rfl hEx)
      _ = _ := rfl
  have ht : IsTightMeasureSet (Set.range (fun x => (μ' x : Measure E))) :=
    isTightMeasureSet_range_nnreal_pi_of_lintegral_sum_le _ (ζ + 1).toNNReal hmoment
  have hweak' : Tendsto μ' atTop (𝓝 νp) := by
    apply tendsto_of_tight_of_joint_nonnegative_laplace ht
    intro s
    exact (hLap s).comp
      (tendsto_atTop_mono (fun x => le_max_left x X) tendsto_id)
  have hweak : Tendsto μ atTop (𝓝 νp) := by
    apply hweak'.congr'
    filter_upwards [eventually_ge_atTop X] with x hx
    simp only [μ', max_eq_left hx]
  have hcompose (Q : ProbabilityMeasure (FiniteMeasure ℝ)) :
      (Q.map q).map e = Q.map (fragmentBandMasses a) :=
    ProbabilityMeasure.toMeasure_injective (Measure.map_map he.measurable hq)
  have hμMap (x : ℝ) :
      (μ x).map e = (V x).normalize := by
    dsimp only [μ, V]
    rw [hcompose]
    exact ((U x).normalize_map (harmonicConfigurationMass_ne_zero _ _ _) hf).symm
  have hνMap : νp.map e = ν.normalize := by
    dsimp only [νp]
    rw [hcompose]
    change P.map (fragmentBandMasses a) =
      (P.map (fragmentBandMasses a)).toFiniteMeasure.normalize
    exact (ProbabilityMeasure.toFiniteMeasure_normalize_eq_self
      (P.map (fragmentBandMasses a))).symm
  have hprob : Tendsto (fun x => (V x).normalize) atTop (𝓝 ν.normalize) := by
    have h := ProbabilityMeasure.tendsto_map_of_tendsto_of_continuous μ νp hweak he
    rw [hνMap] at h
    exact h.congr' (Eventually.of_forall hμMap)
  have hνFinite : ν.normalize.toFiniteMeasure = ν := by
    change (P.map (fragmentBandMasses a)).toFiniteMeasure.normalize.toFiniteMeasure =
      (P.map (fragmentBandMasses a)).toFiniteMeasure
    rw [ProbabilityMeasure.toFiniteMeasure_normalize_eq_self]
  have hmass (x : ℝ) :
      (V x).mass.toReal = harmonicFragmentMass (presievingModulus H x) (x ^ ρ) ζ := by
    dsimp only [V]
    rw [FiniteMeasure.mass_map_of_aemeasurable _ hf.aemeasurable]
    exact harmonicConfigurationMass_mass _ _ _
  have hscalar (x : ℝ) :
      ((B x)⁻¹).toNNReal • V x =
        (harmonicFragmentMass (presievingModulus H x) (x ^ ρ) ζ / B x).toNNReal •
          (V x).normalize.toFiniteMeasure := by
    rw [FiniteMeasure.inv_toNNReal_smul_eq_mass_div_smul_normalize, hmass x]
  have hscaled := (tendsto_real_toNNReal
    (harmonic_fragment_normalizer_tendsto H ρ ζ hρ hζ)).smul
      ((ProbabilityMeasure.toFiniteMeasure_continuous.tendsto _).comp hprob)
  rw [hνFinite] at hscaled
  exact hprob.prodMk_nhds (hscaled.congr'
    (Eventually.of_forall fun x => (hscalar x).symm))

open Real Finset Filter Asymptotics Topology
open ArithmeticFunction hiding log

theorem card_divisors_pow_le_zeta_pow
    (K n : ℕ) (hn : 0 < n) :
    (Nat.divisors n).card ^ K ≤
      ((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (2 ^ K)) n := by
  induction K generalizing n with
  | zero => simp [hn.ne']
  | succ K ih =>
    rw [pow_succ 2 K, mul_two,
      pow_add (ArithmeticFunction.zeta : ArithmeticFunction ℕ), ArithmeticFunction.mul_apply]
    calc
      n.divisors.card ^ (K + 1) =
          ∑ p ∈ n.divisorsAntidiagonal, n.divisors.card ^ K := by
        simp [← Nat.map_div_right_divisors, pow_succ, mul_comm]
      _ ≤ ∑ p ∈ n.divisorsAntidiagonal,
          (ArithmeticFunction.zeta ^ (2 ^ K)) p.1 *
            (ArithmeticFunction.zeta ^ (2 ^ K)) p.2 := by
        apply Finset.sum_le_sum
        intro p hp
        have hpos := Nat.ne_zero_of_mem_divisorsAntidiagonal hp
        calc
          _ ≤ (p.1.divisors.card * p.2.divisors.card) ^ K :=
            Nat.pow_le_pow_left (by
              rw [← (Nat.mem_divisorsAntidiagonal.mp hp).1, Nat.divisors_mul]
              exact Finset.card_mul_le) K
          _ = p.1.divisors.card ^ K * p.2.divisors.card ^ K := mul_pow _ _ _
          _ ≤ _ := Nat.mul_le_mul (ih _ (Nat.pos_of_ne_zero hpos.1))
            (ih _ (Nat.pos_of_ne_zero hpos.2))

theorem sum_zeta_pow_div_le_harmonic_pow (j X : ℕ) :
    (∑ n ∈ Finset.Icc 1 X,
      (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ j) n : ℝ) / (n : ℝ)) ≤
      (harmonic X : ℝ) ^ j := by
  have hweight (f g : ArithmeticFunction ℝ) :
      (f * g).pdiv (ArithmeticFunction.id : ArithmeticFunction ℝ) =
        f.pdiv (ArithmeticFunction.id : ArithmeticFunction ℝ) *
          g.pdiv (ArithmeticFunction.id : ArithmeticFunction ℝ) := by
    ext n
    simp only [ArithmeticFunction.pdiv_apply, ArithmeticFunction.mul_apply,
      ArithmeticFunction.natCoe_apply, ArithmeticFunction.id_apply, Finset.sum_div]
    apply Finset.sum_congr rfl
    intro a ha
    rw [div_mul_div_comm, ← Nat.cast_mul, (Nat.mem_divisorsAntidiagonal.mp ha).1]
  have hconv (f g : ArithmeticFunction ℕ) :
      (∑ n ∈ Finset.Icc 1 X, ((f * g) n : ℝ) / (n : ℝ)) ≤
        (∑ n ∈ Finset.Icc 1 X, (f n : ℝ) / (n : ℝ)) *
          (∑ n ∈ Finset.Icc 1 X, (g n : ℝ) / (n : ℝ)) := by
    have hreindex := ArithmeticFunction.sum_Ioc_mul_eq_sum_prod_filter
      ((f : ArithmeticFunction ℝ).pdiv (ArithmeticFunction.id : ArithmeticFunction ℝ))
      ((g : ArithmeticFunction ℝ).pdiv (ArithmeticFunction.id : ArithmeticFunction ℝ)) X
    rw [← hweight, ← ArithmeticFunction.natCoe_mul] at hreindex
    simp only [ArithmeticFunction.pdiv_apply, ArithmeticFunction.natCoe_apply,
      ArithmeticFunction.id_apply] at hreindex
    rw [← Finset.Icc_succ_left_eq_Ioc (0 : ℕ) X] at hreindex
    calc
      _ = ∑ a ∈ Finset.Icc 1 X ×ˢ Finset.Icc 1 X with a.1 * a.2 ≤ X,
          ((f a.1 : ℝ) / (a.1 : ℝ)) * ((g a.2 : ℝ) / (a.2 : ℝ)) := hreindex
      _ ≤ ∑ a ∈ Finset.Icc 1 X ×ˢ Finset.Icc 1 X,
          ((f a.1 : ℝ) / (a.1 : ℝ)) * ((g a.2 : ℝ) / (a.2 : ℝ)) := by
        apply Finset.sum_le_sum_of_subset_of_nonneg (Finset.filter_subset _ _)
        intro a ha hnot
        positivity
      _ = _ := by
        rw [Finset.sum_product, Finset.sum_mul_sum]
  have hzeta : (∑ n ∈ Finset.Icc 1 X,
      (ArithmeticFunction.zeta n : ℝ) / (n : ℝ)) = (harmonic X : ℝ) := by
    rw [harmonic_eq_sum_Icc]
    simp only [Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast]
    apply Finset.sum_congr rfl
    intro n hn
    rw [ArithmeticFunction.zeta_apply_ne (Nat.ne_of_gt (Finset.mem_Icc.mp hn).1),
      Nat.cast_one, one_div]
  have hHnonneg : 0 ≤ (harmonic X : ℝ) := by unfold harmonic; positivity
  induction j with
  | zero =>
    by_cases hX : X = 0 <;>
      simp [ArithmeticFunction.one_apply, ite_div, hX, Nat.one_le_iff_ne_zero]
  | succ j ih =>
    calc
      _ ≤ (∑ n ∈ Finset.Icc 1 X,
          (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ j) n : ℝ) / (n : ℝ)) *
          (∑ n ∈ Finset.Icc 1 X, (ArithmeticFunction.zeta n : ℝ) / (n : ℝ)) := by
        simpa only [pow_succ] using
          hconv ((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ j) ArithmeticFunction.zeta
      _ ≤ (harmonic X : ℝ) ^ j * (harmonic X : ℝ) := by
        rw [hzeta]
        exact mul_le_mul_of_nonneg_right ih hHnonneg
      _ = _ := (pow_succ _ _).symm

theorem sum_card_divisors_pow_le_mul_log_pow (K X : ℕ) :
    (∑ n ∈ Finset.Icc 1 X, ((Nat.divisors n).card : ℝ) ^ K) ≤
      (X : ℝ) * (1 + Real.log (X : ℝ)) ^ (2 ^ K - 1) := by
  let j : ℕ := 2 ^ K - 1
  have hj : j + 1 = 2 ^ K := Nat.sub_add_cancel Nat.one_le_two_pow
  have hz := congrArg (fun z : ℕ => (z : ℝ))
    (ArithmeticFunction.sum_Ioc_mul_zeta_eq_sum
      ((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ j) X)
  push_cast at hz
  rw [← Finset.Icc_succ_left_eq_Ioc (0 : ℕ) X] at hz
  simp only [ArithmeticFunction.natCoe_nat, ← pow_succ, hj] at hz
  calc
    _ ≤ ∑ n ∈ Finset.Icc 1 X,
        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (2 ^ K)) n : ℝ) := by
      apply Finset.sum_le_sum
      intro n hn
      exact_mod_cast card_divisors_pow_le_zeta_pow K n
        (Finset.mem_Icc.mp hn).1
    _ = ∑ n ∈ Finset.Icc 1 X,
        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ j) n : ℝ) *
          ((X / n : ℕ) : ℝ) := hz
    _ ≤ ∑ n ∈ Finset.Icc 1 X,
        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ j) n : ℝ) *
          ((X : ℝ) / (n : ℝ)) :=
      Finset.sum_le_sum fun n _ =>
        mul_le_mul_of_nonneg_left Nat.cast_div_le (Nat.cast_nonneg _)
    _ = (X : ℝ) * ∑ n ∈ Finset.Icc 1 X,
        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ j) n : ℝ) / (n : ℝ) := by
      simp [Finset.mul_sum, mul_div_left_comm]
    _ ≤ (X : ℝ) * (harmonic X : ℝ) ^ j :=
      mul_le_mul_of_nonneg_left (sum_zeta_pow_div_le_harmonic_pow j X) (Nat.cast_nonneg X)
    _ ≤ _ := mul_le_mul_of_nonneg_left
      (pow_le_pow_left₀ (by unfold harmonic; positivity) (harmonic_le_one_add_log X) j)
      (Nat.cast_nonneg X)

theorem div_totient_le_card_divisors (q : ℕ) :
    (q : ℝ) / (q.totient : ℝ) ≤ ((Nat.divisors q).card : ℝ) := by
  rcases q.eq_zero_or_pos with rfl | hq
  · simp
  have hφ := Nat.totient_pos.mpr hq
  apply (div_le_iff₀ (Nat.cast_pos.mpr hφ)).mpr
  have h := Finset.sum_le_sum fun d (hd : d ∈ q.divisors) ↦
    Nat.le_of_dvd hφ (Nat.totient_dvd_of_dvd (Nat.dvd_of_mem_divisors hd))
  rw [Nat.sum_totient, Finset.sum_const, nsmul_eq_mul] at h
  exact_mod_cast h

end PrimeGap186

section
open Polynomial

universe u v w

namespace PrimeGap186

/-!
## Rational phases and finite-field bounds

Clear denominators and control the polynomial and character-sum expressions arising from
reciprocal phases.
-/

open Classical in
/--
The denominator polynomial for the substitution `x = z₀ + 1 / X` in a rational phase with poles
in `S`. It includes a factor `X` exactly when the linear coefficient `b` is nonzero.
-/
noncomputable def mobiusDenominator {K : Type u} [Field K]
    (S : Finset K) (z₀ b : K) : K[X] :=
  (if b = 0 then 1 else X) *
    ∏ z ∈ S.erase z₀, (X - C ((z - z₀)⁻¹))

open Classical in
/--
For a distinguished pole `z₀ ∈ S`, the numerator polynomial assembled after substituting `x = z₀
+ 1 / X` in the phase with constant `c`, linear coefficient `b`, and simple-pole coefficients
`a`. The remaining pole factors are those of the Möbius denominator; the formula itself is
defined without requiring `z₀ ∈ S`.
-/
noncomputable def mobiusNumerator {K : Type u} [Field K]
    (S : Finset K) (a : K → K) (z₀ b c : K) : K[X] :=
  let Q := S.erase z₀
  let J : K[X] := if b = 0 then 1 else X
  let P : K[X] := ∏ z ∈ Q, (X - C ((z - z₀)⁻¹))
  let c' := c + b * z₀ + ∑ z ∈ Q, a z / (z₀ - z)
  (C (a z₀) * X + C c') * mobiusDenominator S z₀ b + C b * P -
    ∑ z ∈ Q, C (a z / (z₀ - z) ^ 2) * J *
      ∏ v ∈ Q.erase z, (X - C ((v - z₀)⁻¹))

/--
The polynomial `∑ j < m, A(X^(p^j)) * D(X)^(p^(m-1) - p^j)` used to clear denominators in the
finite-field trace construction. Natural-number subtraction is truncated, and the empty sum is
zero.
-/
noncomputable def clearedTraceNumerator {K : Type u} [CommSemiring K]
    (p m : ℕ) (A D : K[X]) : K[X] :=
  ∑ j ∈ Finset.range m, expand K (p ^ j) A * D ^ (p ^ (m - 1) - p ^ j)

theorem scalar_sub_of_natDegree_lt {K : Type*} [Field K]
    {B N : K[X]} (h : B.natDegree < N.natDegree) (hN : N ≠ 0) (t : K) :
    C t * B - N ≠ 0 ∧ (C t * B - N).natDegree = N.natDegree ∧
      (C t * B - N).leadingCoeff = -N.leadingCoeff := by
  have hl := (natDegree_C_mul_le t B).trans_lt h
  have hc := leadingCoeff_sub_of_degree_lt' (degree_lt_degree hl)
  refine ⟨?_, natDegree_sub_eq_right_of_natDegree_lt hl, hc⟩
  simpa only [← leadingCoeff_ne_zero, hc, neg_ne_zero] using hN

theorem clearedTraceNumerator_degrees
    {K : Type u} [Field K] (p m : ℕ) (hp : 1 < p) (hm : 0 < m)
    (A D : K[X]) (hD : D ≠ 0) (hAD : A.natDegree = D.natDegree + 1) :
    let d := D.natDegree
    let T := p ^ (m - 1)
    let L := p ^ (2 * m - 1)
    let B := D ^ T
    let N := clearedTraceNumerator p m A D
    let BH := expand K (p ^ m) B
    let NH := expand K (p ^ m) N
    let U : ℕ → K[X] := fun j => expand K (p ^ j) A * D ^ (T - p ^ j)
    A ≠ 0 ∧ 0 < T ∧
    (∀ j ∈ Finset.range m,
      p ^ j ≤ T ∧ U j ≠ 0 ∧ (U j).natDegree = d * T + p ^ j) ∧
    (∀ j ∈ Finset.range m, j ≠ m - 1 →
      (U j).natDegree < (U (m - 1)).natDegree) ∧
    (U (m - 1)).leadingCoeff = A.leadingCoeff ∧
    B ≠ 0 ∧ N ≠ 0 ∧ BH ≠ 0 ∧ NH ≠ 0 ∧
    B.natDegree = d * T ∧ N.natDegree = (d + 1) * T ∧
    BH.natDegree = d * L ∧ NH.natDegree = (d + 1) * L ∧
    N.leadingCoeff = A.leadingCoeff ∧ NH.leadingCoeff = A.leadingCoeff ∧
    (∀ t : K,
      C t * B - N ≠ 0 ∧
      (C t * B - N).natDegree = (d + 1) * T ∧
      (C t * B - N).leadingCoeff = -A.leadingCoeff) ∧
    (∀ (E : Type v) [Field E] (φ : K →+* E),
      let AE := A.map φ
      let DE := D.map φ
      let BE := B.map φ
      let NE := N.map φ
      let BHE := BH.map φ
      let NHE := NH.map φ
      let UE : ℕ → E[X] := fun j => (U j).map φ
      AE ≠ 0 ∧ DE ≠ 0 ∧ AE.natDegree = d + 1 ∧ DE.natDegree = d ∧
      (∀ j ∈ Finset.range m,
        UE j = expand E (p ^ j) AE * DE ^ (T - p ^ j) ∧
        UE j ≠ 0 ∧ (UE j).natDegree = d * T + p ^ j) ∧
      (∀ j ∈ Finset.range m, j ≠ m - 1 →
        (UE j).natDegree < (UE (m - 1)).natDegree) ∧
      (UE (m - 1)).leadingCoeff = φ A.leadingCoeff ∧
      BE = DE ^ T ∧ NE = clearedTraceNumerator p m AE DE ∧
      BHE = expand E (p ^ m) BE ∧ NHE = expand E (p ^ m) NE ∧
      BE ≠ 0 ∧ NE ≠ 0 ∧ BHE ≠ 0 ∧ NHE ≠ 0 ∧
      BE.natDegree = d * T ∧ NE.natDegree = (d + 1) * T ∧
      BHE.natDegree = d * L ∧ NHE.natDegree = (d + 1) * L ∧
      NE.leadingCoeff = φ A.leadingCoeff ∧ NHE.leadingCoeff = φ A.leadingCoeff ∧
      (∀ t : E,
        C t * BE - NE ≠ 0 ∧
        (C t * BE - NE).natDegree = (d + 1) * T ∧
        (C t * BE - NE).leadingCoeff = -φ A.leadingCoeff)) := by
  classical
  intro d T L B N BH NH U
  have hp0 : 0 < p := lt_trans Nat.zero_lt_one hp
  have hT : 0 < T := Nat.pow_pos hp0
  have hA : A ≠ 0 := Polynomial.ne_zero_of_natDegree_gt (n := 0) (by simp [hAD])
  have hm1 : m - 1 + 1 = m := Nat.sub_add_cancel hm
  have hU : ∀ j ∈ Finset.range m,
      p ^ j ≤ T ∧ U j ≠ 0 ∧ (U j).natDegree = d * T + p ^ j := by
    intro j hj
    have hjle : j ≤ m - 1 := by have := Finset.mem_range.mp hj; omega
    have hjp : p ^ j ≤ T := Nat.pow_le_pow_right hp0 hjle
    have hExp : expand K (p ^ j) A ≠ 0 := (Polynomial.expand_ne_zero (Nat.pow_pos hp0)).mpr hA
    have hPow : D ^ (T - p ^ j) ≠ 0 := pow_ne_zero _ hD
    refine ⟨hjp, mul_ne_zero hExp hPow, ?_⟩
    simp only [U, Polynomial.natDegree_mul hExp hPow, Polynomial.natDegree_expand,
      Polynomial.natDegree_pow, hAD]
    dsimp only [d]
    have heq : T - p ^ j + p ^ j = T := Nat.sub_add_cancel hjp
    linear_combination D.natDegree * heq
  have hlast : m - 1 ∈ Finset.range m := Finset.mem_range.mpr (by omega)
  have htopdeg := (hU (m - 1) hlast).2.2
  have hlt : ∀ j ∈ Finset.range m, j ≠ m - 1 →
      (U j).natDegree < (U (m - 1)).natDegree := by
    intro j hj hne
    rw [(hU j hj).2.2, htopdeg]
    apply Nat.add_lt_add_left
    apply Nat.pow_lt_pow_right hp
    have := Finset.mem_range.mp hj
    omega
  have htopLC : (U (m - 1)).leadingCoeff = A.leadingCoeff := by
    simp only [U, T, Nat.sub_self, pow_zero, mul_one]
    exact Polynomial.leadingCoeff_expand (Nat.pow_pos hp0)
  have hlow : (∑ j ∈ Finset.range (m - 1), U j).natDegree < (U (m - 1)).natDegree := by
    refine (Polynomial.natDegree_sum_le _ _).trans_lt ((Finset.sup_lt_iff ?_).2 ?_)
    · change 0 < (U (m - 1)).natDegree
      rw [htopdeg]
      omega
    · intro j hj
      exact hlt j (Finset.mem_range.mpr
        ((Finset.mem_range.mp hj).trans_le (Nat.sub_le _ _)))
        (ne_of_lt (Finset.mem_range.mp hj))
  have hNsum : N = (∑ j ∈ Finset.range (m - 1), U j) + U (m - 1) := by
    change (∑ j ∈ Finset.range m, U j) = _
    conv_lhs => rw [← hm1, Finset.sum_range_succ]
  have hNlc : N.leadingCoeff = A.leadingCoeff := by
    rw [hNsum, Polynomial.leadingCoeff_add_of_degree_lt (Polynomial.degree_lt_degree hlow), htopLC]
  have hNne : N ≠ 0 :=
    Polynomial.leadingCoeff_ne_zero.mp (hNlc ▸ Polynomial.leadingCoeff_ne_zero.mpr hA)
  have hNdeg : N.natDegree = (d + 1) * T := by
    rw [hNsum, Polynomial.natDegree_add_eq_right_of_natDegree_lt hlow, htopdeg]
    change d * T + T = (d + 1) * T
    ring
  have hBne : B ≠ 0 := pow_ne_zero _ hD
  have hBdeg : B.natDegree = d * T := by simp [B, d, Polynomial.natDegree_pow, mul_comm]
  have hBHne : BH ≠ 0 := (Polynomial.expand_ne_zero (Nat.pow_pos hp0)).mpr hBne
  have hNHne : NH ≠ 0 := (Polynomial.expand_ne_zero (Nat.pow_pos hp0)).mpr hNne
  have hL : T * p ^ m = L := by
    dsimp only [L, T]
    rw [← pow_add]
    congr 1
    omega
  have hBHdeg : BH.natDegree = d * L := by
    simp only [BH, Polynomial.natDegree_expand, hBdeg, mul_assoc, hL]
  have hNHdeg : NH.natDegree = (d + 1) * L := by
    simp only [NH, Polynomial.natDegree_expand, hNdeg, mul_assoc, hL]
  have hNHlc : NH.leadingCoeff = A.leadingCoeff := by
    simp only [NH, Polynomial.leadingCoeff_expand (Nat.pow_pos hp0), hNlc]
  have hBNlt : B.natDegree < N.natDegree := by rw [hBdeg, hNdeg]; nlinarith
  have hdiff : ∀ t : K, C t * B - N ≠ 0 ∧ (C t * B - N).natDegree = (d + 1) * T ∧
      (C t * B - N).leadingCoeff = -A.leadingCoeff := by
    intro t
    simpa only [hNdeg, hNlc] using scalar_sub_of_natDegree_lt hBNlt hNne t
  refine ⟨hA, hT, hU, hlt, htopLC, hBne, hNne, hBHne, hNHne, hBdeg,
    hNdeg, hBHdeg, hNHdeg, hNlc, hNHlc, hdiff, ?_⟩
  intro E _ φ AE DE BE NE BHE NHE UE
  have hBE : BE = DE ^ T := by simp [BE, DE, B]
  have hNE : NE = clearedTraceNumerator p m AE DE := by
    dsimp only [NE, N]
    delta clearedTraceNumerator
    simp [AE, DE, Polynomial.map_sum, Polynomial.map_mul, Polynomial.map_expand, Polynomial.map_pow]
  have hBHE : BHE = expand E (p ^ m) BE := Polynomial.map_expand
  have hNHE : NHE = expand E (p ^ m) NE := Polynomial.map_expand
  refine ⟨Polynomial.map_ne_zero hA, Polynomial.map_ne_zero hD,
    (Polynomial.natDegree_map φ).trans hAD, Polynomial.natDegree_map φ,
    ?_, ?_, ?_, hBE, hNE, hBHE, hNHE,
    Polynomial.map_ne_zero hBne, Polynomial.map_ne_zero hNne,
    Polynomial.map_ne_zero hBHne, Polynomial.map_ne_zero hNHne,
    (Polynomial.natDegree_map φ).trans hBdeg, (Polynomial.natDegree_map φ).trans hNdeg,
    (Polynomial.natDegree_map φ).trans hBHdeg, (Polynomial.natDegree_map φ).trans hNHdeg,
    (Polynomial.leadingCoeff_map φ).trans (congrArg φ hNlc),
    (Polynomial.leadingCoeff_map φ).trans (congrArg φ hNHlc), ?_⟩
  · intro j hj
    refine ⟨?_, Polynomial.map_ne_zero (hU j hj).2.1,
      (Polynomial.natDegree_map φ).trans (hU j hj).2.2⟩
    simp [UE, U, AE, DE, Polynomial.map_mul, Polynomial.map_expand, Polynomial.map_pow]
  · intro j hj hn
    simpa only [UE, Polynomial.natDegree_map] using hlt j hj hn
  · exact (Polynomial.leadingCoeff_map φ).trans (congrArg φ htopLC)
  · intro t
    have hltE : BE.natDegree < NE.natDegree := by
      simpa only [BE, NE, Polynomial.natDegree_map] using hBNlt
    simpa only [show NE.natDegree = (d + 1) * T from (Polynomial.natDegree_map φ).trans hNdeg,
      show NE.leadingCoeff = φ A.leadingCoeff from
        (Polynomial.leadingCoeff_map φ).trans (congrArg φ hNlc)] using
        scalar_sub_of_natDegree_lt hltE (Polynomial.map_ne_zero hNne) t

theorem zmod_expand_eq_pow (p n : ℕ) [Fact p.Prime] (g : (ZMod p)[X]) :
    expand (ZMod p) (p ^ n) g = g ^ (p ^ n) := by
  simpa [Polynomial.ext_iff, iterateFrobenius_def] using
    Polynomial.map_iterateFrobenius_expand p g n

theorem clearedTraceNumerator_trace
    (p m : ℕ) [Fact p.Prime] (hm : 0 < m)
    {E : Type u} [Field E] [Finite E] [Algebra (ZMod p) E]
    (hfinrank : Module.finrank (ZMod p) E = 2 * m)
    (A D : (ZMod p)[X]) (x : E)
    (hx : (D.map (algebraMap (ZMod p) E)).eval x ≠ 0) :
    let φ : ZMod p →+* E := algebraMap (ZMod p) E
    let T := p ^ (m - 1)
    let B := D ^ T
    let N := clearedTraceNumerator p m A D
    let BH := expand (ZMod p) (p ^ m) B
    let NH := expand (ZMod p) (p ^ m) N
    let AE := A.map φ
    let DE := D.map φ
    let BE := B.map φ
    let NE := N.map φ
    let BHE := BH.map φ
    let NHE := NH.map φ
    let f := AE.eval x / DE.eval x
    BE.eval x = DE.eval x ^ T ∧ BE.eval x ≠ 0 ∧
    BHE.eval x = BE.eval x ^ (p ^ m) ∧ BHE.eval x ≠ 0 ∧
    NHE.eval x = NE.eval x ^ (p ^ m) ∧
    NE.eval x / BE.eval x = (∑ j ∈ Finset.range m, f ^ (p ^ j)) ∧
    NHE.eval x / BHE.eval x = (∑ j ∈ Finset.range m, f ^ (p ^ (m + j))) ∧
    φ (Algebra.trace (ZMod p) E f) =
      NE.eval x / BE.eval x + NHE.eval x / BHE.eval x ∧
    (∀ t : ZMod p, Algebra.trace (ZMod p) E f = t ↔
      NHE.eval x * BE.eval x =
        BHE.eval x * (φ t * BE.eval x - NE.eval x)) := by
  classical
  intro φ T B N BH NH AE DE BE NE BHE NHE f
  let : CharP E p := charP_of_injective_algebraMap
    (FaithfulSMul.algebraMap_injective (ZMod p) E) p
  have hBE : BE.eval x = DE.eval x ^ T := by
    simp [BE, B, DE]
  have hBE0 : BE.eval x ≠ 0 := by rw [hBE]; exact pow_ne_zero _ hx
  have hBHE : BHE.eval x = BE.eval x ^ (p ^ m) := by
    simp only [BHE, BH, zmod_expand_eq_pow, Polynomial.map_pow, Polynomial.eval_pow, BE]
  have hBHE0 : BHE.eval x ≠ 0 := by rw [hBHE]; exact pow_ne_zero _ hBE0
  have hNHE : NHE.eval x = NE.eval x ^ (p ^ m) := by
    simp only [NHE, NH, zmod_expand_eq_pow, Polynomial.map_pow, Polynomial.eval_pow, NE]
  have hp0 : 0 < p := (Fact.out : Nat.Prime p).pos
  have hlow : NE.eval x / BE.eval x = ∑ j ∈ Finset.range m, f ^ (p ^ j) := by
    rw [hBE]
    dsimp only [NE, N, clearedTraceNumerator]
    rw [Polynomial.map_sum, Polynomial.eval_finsetSum, Finset.sum_div]
    apply Finset.sum_congr rfl
    intro j hj
    have hjp : p ^ j ≤ T := Nat.pow_le_pow_right hp0 (by have := Finset.mem_range.mp hj; omega)
    rw [Polynomial.map_mul, Polynomial.map_pow, zmod_expand_eq_pow,
      Polynomial.map_pow, Polynomial.eval_mul, Polynomial.eval_pow, Polynomial.eval_pow]
    change AE.eval x ^ (p ^ j) * DE.eval x ^ (T - p ^ j) / DE.eval x ^ T = _
    dsimp only [f]
    rw [div_pow]
    have hxq : DE.eval x ≠ 0 := hx
    rw [← pow_sub_mul_pow (DE.eval x) hjp]
    field_simp [hxq]
  have hhigh : NHE.eval x / BHE.eval x = ∑ j ∈ Finset.range m, f ^ (p ^ (m + j)) := by
    rw [hNHE, hBHE, ← div_pow, hlow, sum_pow_char_pow]
    apply Finset.sum_congr rfl
    intro j _
    rw [← pow_mul, ← pow_add, add_comm]
  have htr : φ (Algebra.trace (ZMod p) E f) = NE.eval x / BE.eval x + NHE.eval x / BHE.eval x := by
    rw [hlow, hhigh]
    simpa only [Nat.card_eq_fintype_card, ZMod.card, hfinrank,
      show 2 * m = m + m by omega, Finset.sum_range_add] using
      FiniteField.algebraMap_trace_eq_sum_pow (ZMod p) E f
  refine ⟨hBE, hBE0, hBHE, hBHE0, hNHE, hlow, hhigh, htr, ?_⟩
  intro t
  rw [← φ.injective.eq_iff, htr]
  constructor <;> intro h <;> field_simp [hBE0, hBHE0] at h ⊢ <;> linear_combination h

open Classical in
theorem mobius_normalization
    {K : Type u} {E : Type v} [Field K] [Field E]
    (φ : K →+* E) (S : Finset K) (a : K → K) (z₀ b c : K)
    (hz₀ : z₀ ∈ S) (ha : ∀ z ∈ S, a z ≠ 0) :
    let Q := S.erase z₀
    let w : K → K := fun z => (z - z₀)⁻¹
    let J : K[X] := if b = 0 then 1 else X
    let P : K[X] := ∏ z ∈ Q, (X - C (w z))
    let F : Finset K := Q.image w ∪ (if b = 0 then ∅ else {0})
    let s := S.card + if b = 0 then 0 else 1
    let D := mobiusDenominator S z₀ b
    let A := mobiusNumerator S a z₀ b c
    let DE := D.map φ
    let AE := A.map φ
    D.Monic ∧ D ≠ 0 ∧ A ≠ 0 ∧
    D.natDegree = s - 1 ∧ A.natDegree = s ∧ A.leadingCoeff = a z₀ ∧
    Set.InjOn w (↑Q : Set K) ∧
    (∀ z ∈ Q, w z ≠ 0 ∧ -a z / (z₀ - z) ^ 2 ≠ 0) ∧
    Set.InjOn (fun z => φ (w z)) (↑Q : Set K) ∧
    (∀ z ∈ Q, φ (w z) ≠ 0 ∧ φ (-a z / (z₀ - z) ^ 2) ≠ 0) ∧
    F.card = s - 1 ∧ (0 ∈ F ↔ b ≠ 0) ∧
    (∀ u : E, DE.eval u ≠ 0 ↔
      (b = 0 ∨ u ≠ 0) ∧ ∀ z ∈ Q, u ≠ φ (w z)) ∧
    (∀ z ∈ Q,
      D.eval (w z) = 0 ∧
      A.eval (w z) =
        (-a z / (z₀ - z) ^ 2) * J.eval (w z) *
          (∏ v ∈ Q.erase z, (w z - w v)) ∧
      A.eval (w z) ≠ 0 ∧
      DE.eval (φ (w z)) = 0 ∧
      AE.eval (φ (w z)) =
        φ ((-a z / (z₀ - z) ^ 2) * J.eval (w z) *
          ∏ v ∈ Q.erase z, (w z - w v)) ∧
      AE.eval (φ (w z)) ≠ 0) ∧
    (b ≠ 0 →
      A.eval 0 = b * P.eval 0 ∧ A.eval 0 ≠ 0 ∧
      AE.eval 0 = φ (b * P.eval 0) ∧ AE.eval 0 ≠ 0) ∧
    (∀ u : E, u ≠ 0 →
      (DE.eval u ≠ 0 ↔ ∀ z ∈ S, φ z₀ + u⁻¹ ≠ φ z)) ∧
    (∀ u : E, u ≠ 0 → DE.eval u ≠ 0 →
      AE.eval u / DE.eval u =
        φ b * (φ z₀ + u⁻¹) + φ c +
          ∑ z ∈ S, φ (a z) / (φ z₀ + u⁻¹ - φ z)) ∧
    Set.BijOn (fun x : E => (x - φ z₀)⁻¹)
      {x : E | ∀ z ∈ S, x ≠ φ z}
      {u : E | u ≠ 0 ∧ DE.eval u ≠ 0} ∧
    (∀ x : E, (∀ z ∈ S, x ≠ φ z) →
      φ z₀ + ((x - φ z₀)⁻¹)⁻¹ = x) ∧
    (∀ u : E, u ≠ 0 ∧ DE.eval u ≠ 0 →
      ((φ z₀ + u⁻¹) - φ z₀)⁻¹ = u) ∧
    (b = 0 → DE.eval 0 ≠ 0 ∧ AE.eval 0 = φ c * DE.eval 0) ∧
    (b ≠ 0 → DE.eval 0 = 0) := by
  intro Q w J P F s D A DE AE
  let c' := c + b * z₀ + ∑ z ∈ Q, a z / (z₀ - z)
  have hQ (z : K) (hz : z ∈ Q) : z ≠ z₀ ∧ z ∈ S := Finset.mem_erase.mp hz
  have hspos : 0 < S.card := Finset.card_pos.mpr ⟨z₀, hz₀⟩
  have hcard : Q.card = S.card - 1 := Finset.card_erase_of_mem hz₀
  have hw : Function.Injective w := inv_injective.comp sub_left_injective
  have hw0 (z : K) (hz : z ∈ Q) : w z ≠ 0 :=
    inv_ne_zero (sub_ne_zero.mpr (hQ z hz).1)
  have hdelt (z : K) (hz : z ∈ Q) : z₀ - z ≠ 0 := sub_ne_zero.mpr (hQ z hz).1.symm
  have hres (z : K) (hz : z ∈ Q) : -a z / (z₀ - z) ^ 2 ≠ 0 :=
    div_ne_zero (neg_ne_zero.mpr (ha z (hQ z hz).2)) (pow_ne_zero _ (hdelt z hz))
  have hwi : Set.InjOn w (↑Q : Set K) := hw.injOn
  have hwEi : Set.InjOn (fun z => φ (w z)) (↑Q : Set K) := (φ.injective.comp hw).injOn
  have hzimg : 0 ∉ Q.image w := by
    simp only [Finset.mem_image, not_exists, not_and]
    intro z hz eq
    exact hw0 z hz eq
  have hDP : D = J * P := rfl
  have hPmono : P.Monic := Polynomial.monic_prod_X_sub_C w Q
  have hPdeg : P.natDegree = Q.card := Polynomial.natDegree_finsetProd_X_sub_C_eq_card Q w
  have hJmono : J.Monic := by
    by_cases hb : b = 0 <;> simp [J, hb, Polynomial.monic_X]
  have hDmono : D.Monic := hDP ▸ hJmono.mul hPmono
  have hDdeg : D.natDegree = s - 1 := by
    rw [hDP, Polynomial.natDegree_mul hJmono.ne_zero hPmono.ne_zero, hPdeg]
    by_cases hb : b = 0
    · simp only [J, hb, ↓reduceIte, Polynomial.natDegree_one, zero_add]
      simpa [s, hb] using hcard
    · simp only [J, hb, ↓reduceIte, Polynomial.natDegree_X]
      simp only [s, hb, ↓reduceIte, hcard]
      omega
  have hJdeg : J.natDegree + Q.card = D.natDegree := by
    rw [hDP, Polynomial.natDegree_mul hJmono.ne_zero hPmono.ne_zero, hPdeg]
  have hsD : D.natDegree + 1 = s := by rw [hDdeg]; dsimp only [s]; split_ifs <;> omega
  have haz₀ : a z₀ ≠ 0 := ha z₀ hz₀
  have hAform : A = (C (a z₀) * X + C c') * D + C b * P -
      ∑ z ∈ Q, C (a z / (z₀ - z) ^ 2) * J *
        ∏ v ∈ Q.erase z, (X - C (w v)) := rfl
  have hlin : (C (a z₀) * X + C c').natDegree = 1 := Polynomial.natDegree_linear haz₀
  have hlinlc : (C (a z₀) * X + C c').leadingCoeff = a z₀ :=
    Polynomial.leadingCoeff_linear haz₀
  let G : K[X] := (C (a z₀) * X + C c') * D
  let R : K[X] := ∑ z ∈ Q, C (a z / (z₀ - z) ^ 2) * J *
        ∏ v ∈ Q.erase z, (X - C (w v))
  have hGdeg : G.natDegree = s := by
    rw [show G = (C (a z₀) * X + C c') * D from rfl,
      Polynomial.natDegree_mul (Polynomial.ne_zero_of_natDegree_gt (n := 0) (by rw [hlin]; omega))
        hDmono.ne_zero, hlin]
    simpa [Nat.add_comm] using hsD
  have hGlc : G.leadingCoeff = a z₀ := by
    simp only [G, Polynomial.leadingCoeff_mul, hlinlc, hDmono.leadingCoeff, mul_one]
  have hCb : (C b * P).natDegree ≤ D.natDegree := le_trans (Polynomial.natDegree_C_mul_le b P) (by
    rw [hPdeg, ← hJdeg]
    omega)
  have hR : R.natDegree ≤ D.natDegree := by
    apply Polynomial.natDegree_sum_le_of_forall_le
    intro z hz
    calc
      _ ≤ J.natDegree + (∏ v ∈ Q.erase z, (X - C (w v))).natDegree :=
        Polynomial.natDegree_mul_le.trans
          (Nat.add_le_add_right (Polynomial.natDegree_C_mul_le _ J) _)
      _ = J.natDegree + (Q.erase z).card := by
        rw [Polynomial.natDegree_finsetProd_X_sub_C_eq_card]
      _ ≤ J.natDegree + Q.card := Nat.add_le_add_left Finset.card_erase_le _
      _ = D.natDegree := hJdeg
  have ht : D.natDegree < G.natDegree := by rw [hGdeg, ← hsD]; omega
  have hplus : (G + C b * P).natDegree = s :=
    (Polynomial.natDegree_add_eq_left_of_natDegree_lt (hCb.trans_lt ht)).trans hGdeg
  have hpluslc : (G + C b * P).leadingCoeff = a z₀ := by
    rw [Polynomial.leadingCoeff_add_of_degree_lt' (Polynomial.degree_lt_degree (hCb.trans_lt ht)),
      hGlc]
  have hRlt : R.natDegree < (G + C b * P).natDegree := by
    rw [hplus]
    exact hR.trans_lt (by simpa [hGdeg] using ht)
  have hAdeg : A.natDegree = s := by
    rw [hAform]
    exact (Polynomial.natDegree_sub_eq_left_of_natDegree_lt hRlt).trans hplus
  have hAlc : A.leadingCoeff = a z₀ := by
    rw [hAform]
    exact
      (Polynomial.leadingCoeff_sub_of_degree_lt (Polynomial.degree_lt_degree hRlt)).trans hpluslc
  have hAne : A ≠ 0 := Polynomial.leadingCoeff_ne_zero.mp (hAlc ▸ haz₀)
  have hFcard : F.card = s - 1 := by
    by_cases hb : b = 0 <;>
      simp [F, s, hb, hzimg, Finset.card_image_of_injOn hwi, hcard, Nat.sub_add_cancel hspos]
  have hFzero : (0 ∈ F ↔ b ≠ 0) := by
    by_cases hb : b = 0 <;> simp [F, hb, hzimg]
  have hJE (u : E) : (J.map φ).eval u = if b = 0 then 1 else u := by
    by_cases hb : b = 0 <;> simp [J, hb]
  have hPE (q : Finset K) (u : E) :
      ((∏ z ∈ q, (X - C (w z))).map φ).eval u = ∏ z ∈ q, (u - φ (w z)) := by
    simp [Polynomial.map_prod, Polynomial.eval_prod]
  have hDEE (u : E) : DE.eval u = (if b = 0 then 1 else u) * ∏ z ∈ Q, (u - φ (w z)) := by
    simp only [DE, hDP, Polynomial.map_mul, Polynomial.eval_mul, hJE, P, hPE]
  have hDEreg (u : E) : DE.eval u ≠ 0 ↔
      (b = 0 ∨ u ≠ 0) ∧ ∀ z ∈ Q, u ≠ φ (w z) := by
    rw [hDEE, mul_ne_zero_iff, Finset.prod_ne_zero_iff]
    by_cases hb : b = 0 <;> simp [hb, sub_ne_zero]
  have hAEE (u : E) : AE.eval u = (φ (a z₀) * u + φ c') * DE.eval u +
      φ b * (P.map φ).eval u -
      ∑ z ∈ Q, φ (a z / (z₀ - z) ^ 2) * (J.map φ).eval u *
        (∏ v ∈ Q.erase z, (u - φ (w v))) := by
    simp [AE, hAform, DE, Polynomial.map_sum, Polynomial.map_mul, Polynomial.eval_finsetSum,
      hPE]
  have hPK (q : Finset K) (u : K) :
      (∏ z ∈ q, (X - C (w z))).eval u = ∏ z ∈ q, (u - w z) := by
    simp [Polynomial.eval_prod]
  have hPzero (z : K) (hz : z ∈ Q) : P.eval (w z) = 0 := by
    simp only [P, hPK]
    exact Finset.prod_eq_zero hz (sub_self _)
  have hDzero (z : K) (hz : z ∈ Q) : D.eval (w z) = 0 := by
    simp [hDP, hPzero z hz]
  have hAvalue (z : K) (hz : z ∈ Q) :
      A.eval (w z) = (-a z / (z₀ - z) ^ 2) * J.eval (w z) *
        (∏ v ∈ Q.erase z, (w z - w v)) := by
    rw [hAform, Polynomial.eval_sub, Polynomial.eval_add, Polynomial.eval_mul, hDzero z hz,
      mul_zero, zero_add, Polynomial.eval_mul, hPzero z hz, mul_zero, zero_sub]
    rw [Polynomial.eval_finsetSum, Finset.sum_eq_single_of_mem z hz]
    · simp only [Polynomial.eval_mul, Polynomial.eval_C, hPK, neg_mul, neg_div]
    · intro y hy hyz
      rw [Polynomial.eval_mul, Polynomial.eval_mul, hPK]
      have hz' : z ∈ Q.erase y := Finset.mem_erase.mpr ⟨Ne.symm hyz, hz⟩
      have hp := Finset.prod_eq_zero (f := fun v => w z - w v) hz' (sub_self (w z))
      rw [hp, mul_zero]
  have hAvalue0 (z : K) (hz : z ∈ Q) :
      (-a z / (z₀ - z) ^ 2) * J.eval (w z) * (∏ v ∈ Q.erase z, (w z - w v)) ≠ 0 := by
    have hJz : J.eval (w z) ≠ 0 := by
      by_cases hb : b = 0 <;> simp [J, hb, hw0 z hz]
    have hpr : (∏ v ∈ Q.erase z, (w z - w v)) ≠ 0 := Finset.prod_ne_zero_iff.mpr (by
      intro v hv
      exact sub_ne_zero.mpr (fun h => (Finset.mem_erase.mp hv).1 (hw h.symm)))
    exact mul_ne_zero (mul_ne_zero (hres z hz) hJz) hpr
  have hpoles (z : K) (hz : z ∈ Q) :
      D.eval (w z) = 0 ∧
      A.eval (w z) = (-a z / (z₀ - z) ^ 2) * J.eval (w z) * (∏ v ∈ Q.erase z, (w z - w v)) ∧
      A.eval (w z) ≠ 0 ∧ DE.eval (φ (w z)) = 0 ∧
      AE.eval (φ (w z)) = φ ((-a z / (z₀ - z) ^ 2) * J.eval (w z) *
        ∏ v ∈ Q.erase z, (w z - w v)) ∧ AE.eval (φ (w z)) ≠ 0 := by
    have hzi := hAvalue z hz
    have hzi0 : A.eval (w z) ≠ 0 := hzi ▸ hAvalue0 z hz
    refine ⟨hDzero z hz, hzi, hzi0, ?_, ?_, ?_⟩
    · simp only [DE, Polynomial.eval_map_apply, hDzero z hz, map_zero]
    · simpa only [AE, Polynomial.eval_map_apply] using congrArg φ hzi
    · simpa only [AE, Polynomial.eval_map_apply] using (_root_.map_ne_zero φ).mpr hzi0
  have hP0 : P.eval 0 ≠ 0 := by
    simp only [P, hPK]
    exact Finset.prod_ne_zero_iff.mpr (by intro z hz; simpa using hw0 z hz)
  have hbvalue (hb : b ≠ 0) : A.eval 0 = b * P.eval 0 ∧ A.eval 0 ≠ 0 ∧
      AE.eval 0 = φ (b * P.eval 0) ∧ AE.eval 0 ≠ 0 := by
    have hj0 : J.eval 0 = 0 := by simp [J, hb]
    have hd0 : D.eval 0 = 0 := by simp [hDP, hj0]
    have ev : A.eval 0 = b * P.eval 0 := by
      rw [hAform]
      simp [hd0, hj0, Polynomial.eval_finsetSum]
    have ev0 : b * P.eval 0 ≠ 0 := mul_ne_zero hb hP0
    have hmap : AE.eval 0 = φ (b * P.eval 0) := by
      simpa only [← map_zero φ, AE, Polynomial.eval_map_apply] using congrArg φ ev
    exact ⟨ev, ev.trans_ne ev0, hmap, hmap.trans_ne ((_root_.map_ne_zero φ).mpr ev0)⟩
  have hwphi (z : K) : φ (w z) = (φ z - φ z₀)⁻¹ := by simp [w, map_inv₀, map_sub]
  have hxiff (u : E) (z : K) :
      (φ z₀ + u⁻¹ = φ z) ↔ u = φ (w z) := by
    rw [hwphi, ← inv_eq_iff_eq_inv, eq_sub_iff_add_eq']
  have hregS (u : E) (hu : u ≠ 0) :
      DE.eval u ≠ 0 ↔ ∀ z ∈ S, φ z₀ + u⁻¹ ≠ φ z := by
    rw [hDEreg u]
    constructor
    · rintro ⟨_, ht⟩ z hz
      by_cases he : z = z₀
      · subst z
        simpa using (inv_ne_zero hu)
      · exact (hxiff u z).not.mpr (ht z (Finset.mem_erase.mpr ⟨he, hz⟩))
    · intro ht
      exact ⟨Or.inr hu, fun z hz => (hxiff u z).not.mp (ht z (hQ z hz).2)⟩
  have heqx (x : E) : φ z₀ + ((x - φ z₀)⁻¹)⁻¹ = x := by simp
  have hequ (u : E) : ((φ z₀ + u⁻¹) - φ z₀)⁻¹ = u := by simp
  have hbij : Set.BijOn (fun x : E => (x - φ z₀)⁻¹)
      {x : E | ∀ z ∈ S, x ≠ φ z} {u : E | u ≠ 0 ∧ DE.eval u ≠ 0} := by
    refine ⟨?_, ?_, ?_⟩
    · intro x hx
      have hi : (x - φ z₀)⁻¹ ≠ 0 := inv_ne_zero (sub_ne_zero.mpr (hx z₀ hz₀))
      refine ⟨hi, (hregS _ hi).mpr ?_⟩
      simpa [heqx] using hx
    · exact (inv_injective.comp sub_left_injective).injOn
    · rintro u ⟨hu, hd⟩
      refine ⟨φ z₀ + u⁻¹, (hregS u hu).mp hd, hequ u⟩
  have hquot (u : E) (hd : DE.eval u ≠ 0) :
      AE.eval u / DE.eval u = φ (a z₀) * u + φ c' +
        φ b * (P.map φ).eval u / DE.eval u -
          ∑ z ∈ Q, φ (a z / (z₀ - z) ^ 2) / (u - φ (w z)) := by
    have hf (z : K) (hz : z ∈ Q) : (u - φ (w z)) * ((J.map φ).eval u *
        (∏ v ∈ Q.erase z, (u - φ (w v)))) = DE.eval u := by
      rw [hDEE, ← Finset.mul_prod_erase Q (fun v => u - φ (w v)) hz, hJE]
      ring
    rw [hAEE, sub_div, add_div, mul_div_cancel_right₀ _ hd, Finset.sum_div]
    congr 1
    apply Finset.sum_congr rfl
    intro z hz
    have ht : u - φ (w z) ≠ 0 := sub_ne_zero.mpr (((hDEreg u).mp hd).2 z hz)
    field_simp [hd, ht]
    rw [← hf z hz]
    ring
  have hmid (u : E) (hu : u ≠ 0) (hd : DE.eval u ≠ 0) :
      φ b * (P.map φ).eval u / DE.eval u = φ b / u := by
    by_cases hb : b = 0
    · simp [hb]
    · have hpu : (P.map φ).eval u ≠ 0 := by
        rw [hDEE] at hd
        simpa [hb, P, hPE] using (mul_ne_zero_iff.mp hd).2
      have hev : DE.eval u = u * (P.map φ).eval u := by
        simpa [P, hPE, hb] using hDEE u
      rw [hev]
      field_simp [hu, hpu]
  have hfrac (r δ u : E) (hd : δ ≠ 0) (hu : u ≠ 0) (hh : u + δ⁻¹ ≠ 0) :
      r / (δ + u⁻¹) = r / δ - (r / δ ^ 2) / (u + δ⁻¹) := by
    have hδu : δ * u + 1 ≠ 0 := by
      simpa [mul_add, hd] using mul_ne_zero hd hh
    field_simp [hd, hu, hδu]
    ring
  have hwsub (u : E) (z : K) : u - φ (w z) = u + (φ z₀ - φ z)⁻¹ := by
    rw [hwphi, sub_eq_add_neg, ← inv_neg, neg_sub]
  have hcmap : φ c' = φ c + φ b * φ z₀ + ∑ z ∈ Q, φ (a z) / (φ z₀ - φ z) := by
    simp [c', map_sum, map_div₀]
  have hregular (u : E) (hu : u ≠ 0) (hd : DE.eval u ≠ 0) :
      AE.eval u / DE.eval u = φ b * (φ z₀ + u⁻¹) + φ c +
          ∑ z ∈ S, φ (a z) / (φ z₀ + u⁻¹ - φ z) := by
    rw [hquot u hd, hmid u hu hd, hcmap,
      ← Finset.add_sum_erase S (fun z => φ (a z) / (φ z₀ + u⁻¹ - φ z)) hz₀]
    have hterm (z : K) (hz : z ∈ Q) : φ (a z) / (φ z₀ + u⁻¹ - φ z) =
        φ (a z) / (φ z₀ - φ z) - φ (a z / (z₀ - z) ^ 2) / (u - φ (w z)) := by
      have hdeltE : φ z₀ - φ z ≠ 0 := by
        simpa only [← map_sub φ, ne_eq, map_eq_zero φ] using hdelt z hz
      simpa only [hwsub, map_div₀, map_pow, map_sub, show φ z₀ + u⁻¹ - φ z =
        (φ z₀ - φ z) + u⁻¹ by ring] using
        hfrac (φ (a z)) (φ z₀ - φ z) u hdeltE hu
          (by rw [← hwsub]; exact sub_ne_zero.mpr (((hDEreg u).mp hd).2 z hz))
    have hsumeq : (∑ z ∈ S.erase z₀, φ (a z) / (φ z₀ + u⁻¹ - φ z)) =
        (∑ z ∈ Q, φ (a z) / (φ z₀ - φ z)) - ∑ z ∈ Q, φ (a z / (z₀ - z) ^ 2) / (u - φ (w z)) := by
      rw [← Finset.sum_sub_distrib]
      exact Finset.sum_congr rfl (fun z hz => hterm z hz)
    rw [hsumeq]
    have hsel : φ (a z₀) / (φ z₀ + u⁻¹ - φ z₀) = φ (a z₀) * u := by simp
    rw [hsel, div_eq_mul_inv]
    ring
  have hbzero (hb : b = 0) : DE.eval 0 ≠ 0 ∧ AE.eval 0 = φ c * DE.eval 0 := by
    have hd : DE.eval 0 ≠ 0 := by
      apply (hDEreg 0).mpr
      refine ⟨Or.inl hb, fun z hz hh => ?_⟩
      exact hw0 z hz (φ.injective (by simpa using hh.symm))
    have hs0 (z : K) (hz : z ∈ Q) :
        φ (a z / (z₀ - z) ^ 2) / ((0 : E) - φ (w z)) = φ (a z) / (φ z₀ - φ z) := by
      rw [hwsub 0, zero_add]
      have hh := (_root_.map_ne_zero φ).mpr (hdelt z hz)
      simp only [map_sub] at hh
      rw [map_div₀, map_pow, map_sub]
      field_simp
    have hv : AE.eval 0 / DE.eval 0 = φ c := by
      rw [hquot 0 hd, hb]
      simp only [map_zero, mul_zero, zero_add, zero_mul, zero_div, add_zero, hcmap]
      simp only [hb, map_zero, zero_mul, add_zero]
      rw [Finset.sum_congr rfl hs0]
      ring
    exact ⟨hd, (div_eq_iff hd).mp hv⟩
  have hbNonzero (hb : b ≠ 0) : DE.eval 0 = 0 := by simp [hDEE, hb]
  refine ⟨hDmono, hDmono.ne_zero, hAne, hDdeg, hAdeg, hAlc, hwi,
    ?_, hwEi, ?_, hFcard, hFzero, hDEreg, hpoles, hbvalue, hregS, hregular, hbij,
    ?_, ?_, hbzero, hbNonzero⟩
  · intro z hz
    exact ⟨hw0 z hz, hres z hz⟩
  · intro z hz
    exact ⟨(_root_.map_ne_zero φ).mpr (hw0 z hz), (_root_.map_ne_zero φ).mpr (hres z hz)⟩
  · intro x hx
    exact heqx x
  · intro u hu
    exact hequ u

open Classical in
theorem mobius_masked_sum
    {K : Type u} {E : Type v} {V : Type w}
    [Field K] [Field E] [Fintype E] [AddCommGroup V]
    (φ : K →+* E) (S M : Finset K) (a : K → K) (z₀ b c : K)
    (hz₀ : z₀ ∈ S) (ha : ∀ z ∈ S, a z ≠ 0) (hSM : S ⊆ M)
    (H : E → V) :
    let DE := (mobiusDenominator S z₀ b).map φ
    let AE := (mobiusNumerator S a z₀ b c).map φ
    let f : E → E := fun x =>
      φ b * x + φ c + ∑ z ∈ S, φ (a z) / (x - φ z)
    (∀ z ∈ M \ S, ∀ v ∈ S, φ z - φ v ≠ 0) ∧
    (∑ x ∈ (Finset.univ : Finset E).filter (fun x => ∀ z ∈ M, x ≠ φ z),
      H (f x)) =
      (∑ u ∈ (Finset.univ : Finset E).filter (fun u => DE.eval u ≠ 0),
        H (AE.eval u / DE.eval u)) -
      (if b = 0 then H (φ c) else 0) -
      ∑ z ∈ M \ S, H (f (φ z)) := by
  intro DE AE f
  obtain ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, heval,
    hbij, heqx, _, hbzero, hbNonzero⟩ := mobius_normalization φ S a z₀ b c hz₀ ha
  have hextra (z : K) (hz : z ∈ M \ S) (v : K) (hv : v ∈ S) : φ z - φ v ≠ 0 :=
    sub_ne_zero.mpr (fun he => (Finset.mem_sdiff.mp hz).2 (φ.injective he ▸ hv))
  refine ⟨hextra, ?_⟩
  let old := (Finset.univ : Finset E).filter (fun x => ∀ z ∈ S, x ≠ φ z)
  let nzreg := (Finset.univ : Finset E).filter (fun u => u ≠ 0 ∧ DE.eval u ≠ 0)
  let newreg := (Finset.univ : Finset E).filter (fun u => DE.eval u ≠ 0)
  let extra := (M \ S).image φ
  have hmasked : old \ extra =
      (Finset.univ : Finset E).filter (fun x => ∀ z ∈ M, x ≠ φ z) := by
    ext x
    simp only [Finset.mem_sdiff, Finset.mem_filter, Finset.mem_univ, true_and,
      Finset.mem_image, not_exists, not_and, old, extra]
    constructor
    · rintro ⟨hS, hn⟩ z hz eq
      by_cases hh : z ∈ S
      · exact hS z hh eq
      · exact hn z ⟨hz, hh⟩ eq.symm
    · intro hM
      refine ⟨fun z hz eq => hM z (hSM hz) eq, ?_⟩
      intro z hz he
      exact hM z hz.1 he.symm
  have hsub : extra ⊆ old := by
    intro x hx
    obtain ⟨z, hz, rfl⟩ := Finset.mem_image.mp hx
    have ht := hextra z hz
    simp only [old, Finset.mem_filter, Finset.mem_univ, true_and]
    intro v hv he
    exact ht v hv (sub_eq_zero.mpr he)
  have himage : (∑ x ∈ extra, H (f x)) = ∑ z ∈ M \ S, H (f (φ z)) :=
    Finset.sum_image φ.injective.injOn
  have hmask : (∑ x ∈ (Finset.univ : Finset E).filter (fun x => ∀ z ∈ M, x ≠ φ z), H (f x)) =
      (∑ x ∈ old, H (f x)) - ∑ z ∈ M \ S, H (f (φ z)) := by
    rw [← hmasked, Finset.sum_sdiff_eq_sub hsub, himage]
  have hreindex : (∑ x ∈ old, H (f x)) = ∑ u ∈ nzreg, H (AE.eval u / DE.eval u) := by
    apply Finset.sum_nbij (fun x : E => (x - φ z₀)⁻¹)
    · intro x hx
      simpa [nzreg] using hbij.1 (Finset.mem_filter.mp hx).2
    · exact (inv_injective.comp sub_left_injective).injOn
    · simpa [old, nzreg] using hbij.2.2
    · intro x hx
      have hx' := (Finset.mem_filter.mp hx).2
      obtain ⟨hu, hd⟩ := hbij.1 hx'
      apply congrArg H
      rw [heval _ hu hd, heqx x hx']
  have hfill : (∑ u ∈ nzreg, H (AE.eval u / DE.eval u)) =
      (∑ u ∈ newreg, H (AE.eval u / DE.eval u)) - (if b = 0 then H (φ c) else 0) := by
    by_cases hb : b = 0
    · have hd : DE.eval 0 ≠ 0 := (hbzero hb).1
      have h0 : 0 ∈ newreg := by simp [newreg, hd]
      have hnzeq : nzreg = newreg.erase 0 := by
        ext u
        simp [nzreg, newreg]
      rw [hnzeq, Finset.sum_erase_eq_sub h0, ite_eq_left hb, (hbzero hb).2,
        mul_div_cancel_right₀ _ hd]
    · have hno : DE.eval 0 = 0 := hbNonzero hb
      have heq : nzreg = newreg := by
        ext u
        simp only [nzreg, newreg, Finset.mem_filter, Finset.mem_univ, true_and]
        exact and_iff_right_iff_imp.mpr (fun hu he => hu (he ▸ hno))
      rw [heq, ite_eq_right hb, sub_zero]
  simpa only [DE, AE, f, newreg] using hmask.trans (by rw [hreindex, hfill])

/--
The denominator-cleared auxiliary polynomial built from coefficient polynomials `e i l`, the
trace numerator, and `D^(p^(h+2))`, with the prescribed `p`-power substitutions.
-/
noncomputable def clearedAuxiliaryPolynomial {K : Type u} [CommSemiring K]
    (p h : ℕ) (A D : K[X])
    (e : Fin p → Fin (p ^ h + 1) → K[X]) : K[X] :=
  let B := D ^ (p ^ (h + 2))
  let N := clearedTraceNumerator p (h + 3) A D
  ∑ i : Fin p, ∑ l : Fin (p ^ h + 1),
    e i l * (expand K (p ^ (h + 3)) N) ^ i.val *
      (expand K (p ^ (h + 3)) B) ^ (p - 1 - i.val) *
      X ^ (p ^ (2 * (h + 3)) * l.val)

/--
The reduced auxiliary polynomial at parameter `t`, replacing the trace factor by `t *
D^(p^(h+2)) - N` and applying the `v`th Hasse derivative to each coefficient polynomial.
-/
noncomputable def clearedReducedPolynomial {K : Type u} [CommRing K]
    (p h : ℕ) (A D : K[X]) (t : K) (v : ℕ)
    (e : Fin p → Fin (p ^ h + 1) → K[X]) : K[X] :=
  let B := D ^ (p ^ (h + 2))
  let N := clearedTraceNumerator p (h + 3) A D
  ∑ i : Fin p, ∑ l : Fin (p ^ h + 1),
    hasseDeriv v (e i l) * (C t * B - N) ^ i.val *
      B ^ (p - 1 - i.val) * X ^ l.val

theorem constraints_lt_coefficients {p h s : ℕ} (hp : 1 < p) (hs : s < p) :
    p ^ (h + 1) * (p ^ (2 * h + 4) + s * (p - 1) * p ^ (h + 2) + p ^ h) <
      p * p ^ (2 * h + 4) * (p ^ h + 1) := by
  have hp0 : 0 < p := by omega
  have hpm : p - 1 < p := by omega
  have hsle : s ≤ p - 1 := by omega
  have hterm : s * (p - 1) * p ^ 2 ≤ (p - 1) * (p - 1) * p ^ 2 := by gcongr
  have hsquare : (p - 1) ^ 2 < p ^ 2 := Nat.pow_lt_pow_left hpm (by norm_num)
  have hfactor : (p - 1) * (p - 1) * p ^ 2 < p ^ 2 * p ^ 2 :=
    Nat.mul_lt_mul_of_pos_right (by simpa [pow_two] using hsquare) (Nat.pow_pos hp0)
  have hcore : s * (p - 1) * p ^ 2 + 1 < p ^ 4 := calc
    _ ≤ (p - 1) * (p - 1) * p ^ 2 + 1 := Nat.add_le_add_right hterm 1
    _ < p ^ 2 * p ^ 2 := by nlinarith [show 2 ≤ p by omega]
    _ = p ^ 4 := by ring
  have hinside : s * (p - 1) * p ^ (h + 2) + p ^ h < p ^ (h + 4) := by
    rw [show s * (p - 1) * p ^ (h + 2) + p ^ h =
      p ^ h * (s * (p - 1) * p ^ 2 + 1) by rw [pow_add]; ring,
      pow_add]
    exact Nat.mul_lt_mul_of_pos_left hcore (Nat.pow_pos hp0)
  have hSP : p ^ (2 * h + 4) = p ^ (h + 4) * p ^ h := by
    rw [← pow_add]; congr 1; omega
  have hRS : p ^ (h + 1) * p ^ (h + 4) = p * p ^ (2 * h + 4) := by
    rw [← pow_add, show h + 1 + (h + 4) = 1 + (2 * h + 4) by omega, pow_add, pow_one]
  calc
    _ < p ^ (h + 1) * (p ^ (2 * h + 4) + p ^ (h + 4)) := by
      apply Nat.mul_lt_mul_of_pos_left _ (Nat.pow_pos hp0)
      rw [Nat.add_assoc]
      exact Nat.add_lt_add_left hinside _
    _ = p * p ^ (2 * h + 4) * (p ^ h + 1) := by
      rw [← hRS, hSP]
      ring

theorem exists_nonzero_clearedAuxiliaryCoefficients
    {K : Type u} [Field K] (p h : ℕ) (hp : 1 < p)
    (A D : K[X]) (hD : D ≠ 0)
    (hAD : A.natDegree = D.natDegree + 1)
    (hs : D.natDegree + 1 < p) :
    ∀ t : K, ∃ e : Fin p → Fin (p ^ h + 1) → K[X],
      (∀ i l, (e i l).natDegree < p ^ (2 * h + 4)) ∧
      (∃ i l, e i l ≠ 0) ∧
      ∀ v : ℕ, v < p ^ (h + 1) →
        clearedReducedPolynomial p h A D t v e = 0 := by
  let S₀ := p ^ (2 * h + 4)
  let K₀ := p ^ h
  let R₀ := p ^ (h + 1)
  let T := p ^ (h + 2)
  let s := D.natDegree + 1
  let D₀ := S₀ + s * (p - 1) * T + K₀
  let B := D ^ T
  let N := clearedTraceNumerator p (h + 3) A D
  have hp0 : 0 < p := by omega
  have hS : 0 < S₀ := Nat.pow_pos hp0
  obtain ⟨_, _, _, _, _, _, _, _, _, hBdeg, _, _, _, _, _, hsub, _⟩ :=
    clearedTraceNumerator_degrees.{u, u} p (h + 3) hp (by omega) A D hD hAD
  have hBd : B.natDegree = D.natDegree * T := by simpa [B, T] using hBdeg
  intro t
  have htdeg : (C t * B - N).natDegree = s * T := by simpa [s, B, N, T] using (hsub t).2.1
  let dec := (Polynomial.degreeLTEquiv K S₀).symm
  let fam (u : Fin p → Fin (K₀ + 1) → Fin S₀ → K) (i : Fin p) (l : Fin (K₀ + 1)) :=
    (dec (u i l)).val
  have hbound (u) (i) (l) : (fam u i l).natDegree < S₀ := by
    have hm := Polynomial.mem_degreeLT.mp (dec (u i l)).property
    by_cases hh : fam u i l = 0
    · simpa [hh] using hS
    · exact (Polynomial.natDegree_lt_iff_degree_lt hh).mpr hm
  let F : (Fin p → Fin (K₀ + 1) → Fin S₀ → K) →ₗ[K] Fin R₀ → Fin D₀ → K :=
    { toFun := fun u v j => (clearedReducedPolynomial p h A D t v (fam u)).coeff j
      map_add' := by
        intro u u'
        funext v j
        simp [clearedReducedPolynomial, fam, dec, map_add, add_mul, Finset.sum_add_distrib,
          Polynomial.coeff_add]
      map_smul' := by
        intro a u
        funext v j
        simp [clearedReducedPolynomial, fam, dec, Polynomial.coeff_smul, ← Finset.mul_sum] }
  have hdim : Module.finrank K (Fin R₀ → Fin D₀ → K) <
      Module.finrank K (Fin p → Fin (K₀ + 1) → Fin S₀ → K) := by
    simpa [Module.finrank_pi_fintype, Module.finrank_self, R₀, S₀, D₀, s, T, K₀,
      mul_assoc, mul_left_comm, mul_comm] using constraints_lt_coefficients (h := h) hp hs
  obtain ⟨u, hu, hu0⟩ := (Submodule.ne_bot_iff (LinearMap.ker F)).mp
    (LinearMap.ker_ne_bot_of_finrank_lt hdim)
  refine ⟨fam u, fun i l => hbound u i l, ?_, ?_⟩
  · by_contra hc
    simp only [not_exists, not_not] at hc
    apply hu0
    funext i l
    apply dec.injective
    exact Subtype.ext (by simpa [fam, dec] using hc i l)
  have hred (v : ℕ) : (clearedReducedPolynomial p h A D t v (fam u)).natDegree < D₀ := by
    have hterm (i : Fin p) (l : Fin (K₀ + 1)) :
        (hasseDeriv v (fam u i l) * (C t * B - N) ^ i.val *
          B ^ (p - 1 - i.val) * X ^ l.val).natDegree < D₀ := by
      have hi : i.val ≤ p - 1 := by have := i.isLt; omega
      have hnl : l.val ≤ K₀ := by have := l.isLt; omega
      have hlow : i.val * s * T + (p - 1 - i.val) * D.natDegree * T ≤ s * (p - 1) * T := by
        calc
          _ ≤ i.val * s * T + (p - 1 - i.val) * s * T := by
            gcongr; simp [s]
          _ = s * (p - 1) * T := by
            rw [← Nat.add_mul, ← Nat.add_mul, Nat.add_sub_of_le hi]
            ring
      calc
        _ ≤ (hasseDeriv v (fam u i l) * (C t * B - N) ^ i.val *
          B ^ (p - 1 - i.val)).natDegree + (X ^ l.val : K[X]).natDegree :=
            Polynomial.natDegree_mul_le
        _ ≤ (hasseDeriv v (fam u i l)).natDegree +
          ((C t * B - N) ^ i.val).natDegree + (B ^ (p - 1 - i.val)).natDegree + l.val := by
            grw [Polynomial.natDegree_mul_le, Polynomial.natDegree_mul_le,
              Polynomial.natDegree_X_pow]
        _ < D₀ := by
          simp only [Polynomial.natDegree_pow, htdeg, hBd]
          rw [show i.val * (s * T) = i.val * s * T by ring,
            show (p - 1 - i.val) * (D.natDegree * T) = (p - 1 - i.val) * D.natDegree * T by ring]
          have hh : (hasseDeriv v (fam u i l)).natDegree < S₀ :=
            (Polynomial.natDegree_hasseDeriv_le _ _).trans_lt (by
              exact (Nat.sub_le _ _).trans_lt (hbound u i l))
          dsimp [D₀]
          omega
    have hdpos : 0 < D₀ := by dsimp [D₀]; omega
    change (∑ i : Fin p, ∑ l : Fin (K₀ + 1), (_ : K[X])).natDegree < D₀
    refine (natDegree_sum_le_of_forall_le _ _ (n := D₀ - 1) fun i _ =>
      natDegree_sum_le_of_forall_le _ _ fun l _ => Nat.le_pred_of_lt (hterm i l)).trans_lt ?_
    omega
  intro v hv
  apply Polynomial.ext
  intro j
  simp only [Polynomial.coeff_zero]
  by_cases hj : j < D₀
  · have hu' : F u = 0 := LinearMap.mem_ker.mp hu
    have hh := congrFun (congrFun hu' (⟨v, hv⟩ : Fin R₀)) (⟨j, hj⟩ : Fin D₀)
    simpa [F, R₀, D₀] using hh
  · exact Polynomial.coeff_eq_zero_of_natDegree_lt ((hred v).trans_le (Nat.le_of_not_gt hj))

theorem clearedAuxiliaryPolynomial_ne_zero_and_degree
    {K : Type u} [Field K] (p h : ℕ) (hp : 1 < p)
    (A D : K[X]) (hD : D ≠ 0)
    (hAD : A.natDegree = D.natDegree + 1)
    (e : Fin p → Fin (p ^ h + 1) → K[X])
    (he : ∀ i l, (e i l).natDegree < p ^ (2 * h + 4))
    (hne : ∃ i l, e i l ≠ 0) :
    let d := D.natDegree
    let L := p ^ (2 * h + 5)
    let B := D ^ (p ^ (h + 2))
    let N := clearedTraceNumerator p (h + 3) A D
    let BH := expand K (p ^ (h + 3)) B
    let NH := expand K (p ^ (h + 3)) N
    (∀ (i : Fin p) (l : Fin (p ^ h + 1)), e i l ≠ 0 →
      (e i l * NH ^ i.val * BH ^ (p - 1 - i.val) *
        X ^ (p ^ (2 * (h + 3)) * l.val)).natDegree =
        d * (p - 1) * L + (e i l).natDegree + L * (i.val + p * l.val)) ∧
    clearedAuxiliaryPolynomial p h A D e ≠ 0 ∧
    (clearedAuxiliaryPolynomial p h A D e).natDegree <
      p ^ (2 * h + 4) + (d + 1) * (p - 1) * L +
        p ^ (2 * (h + 3)) * p ^ h := by
  intro d L B N BH NH
  let S₀ := p ^ (2 * h + 4)
  have hp0 : 0 < p := by omega
  have hLP : 0 < L := Nat.pow_pos hp0
  have hSL : S₀ < L := Nat.pow_lt_pow_right hp (by omega)
  have hexp : p ^ (2 * (h + 3)) = p * L := by
    dsimp [L]; rw [← pow_succ']; congr 1
  obtain ⟨_, _, _, _, _, _, _, hBH0, hNH0, _, _, hBHd, hNHd, _, _, _, _⟩ :=
    clearedTraceNumerator_degrees.{u, u} p (h + 3) hp (by omega) A D hD hAD
  have hBH : BH ≠ 0 := by simpa [BH, B] using hBH0
  have hNH : NH ≠ 0 := by simpa [NH, N] using hNH0
  have hpowL : 2 * (h + 3) - 1 = 2 * h + 5 := by omega
  have hBHdeg : BH.natDegree = d * L := by simpa [BH, B, d, L, hpowL] using hBHd
  have hNHdeg : NH.natDegree = (d + 1) * L := by simpa [NH, N, d, L, hpowL] using hNHd
  let F (a : Fin p × Fin (p ^ h + 1)) :=
    e a.1 a.2 * NH ^ a.1.val * BH ^ (p - 1 - a.1.val) * X ^ (p ^ (2 * (h + 3)) * a.2.val)
  have hnonzero (i : Fin p) (l : Fin (p ^ h + 1)) (hil : e i l ≠ 0) : F (i, l) ≠ 0 :=
    mul_ne_zero (mul_ne_zero (mul_ne_zero hil (pow_ne_zero _ hNH))
      (pow_ne_zero _ hBH)) (pow_ne_zero _ Polynomial.X_ne_zero)
  have hterm (i : Fin p) (l : Fin (p ^ h + 1)) (hil : e i l ≠ 0) :
      (F (i, l)).natDegree = d * (p - 1) * L + (e i l).natDegree + L * (i.val + p * l.val) := by
    have hi : i.val ≤ p - 1 := by have := i.isLt; omega
    have hx : e i l * NH ^ i.val ≠ 0 := mul_ne_zero hil (pow_ne_zero _ hNH)
    have hy : e i l * NH ^ i.val * BH ^ (p - 1 - i.val) ≠ 0 :=
      mul_ne_zero hx (pow_ne_zero _ hBH)
    dsimp [F]
    rw [Polynomial.natDegree_mul hy (pow_ne_zero _ Polynomial.X_ne_zero),
      Polynomial.natDegree_mul hx (pow_ne_zero _ hBH),
      Polynomial.natDegree_mul hil (pow_ne_zero _ hNH),
      Polynomial.natDegree_pow, Polynomial.natDegree_pow, Polynomial.natDegree_X_pow,
      hNHdeg, hBHdeg, hexp]
    have heq : i.val + (p - 1 - i.val) = p - 1 := Nat.add_sub_of_le hi
    linear_combination (d * L) * heq
  have heval : clearedAuxiliaryPolynomial p h A D e = ∑ a, F a := by
    simp only [clearedAuxiliaryPolynomial, F, NH, BH, N, B, ← Finset.univ_product_univ,
      Finset.sum_product]
  refine ⟨hterm, ?_, ?_⟩
  · rw [heval]
    have hpair : Set.Pairwise {a | a ∈ (Finset.univ : Finset (Fin p × Fin (p ^ h + 1))) ∧ F a ≠ 0}
        (Function.onFun Ne (Polynomial.degree ∘ F)) := by
      intro a ha b hb hab eq
      obtain ⟨i, l⟩ := a
      obtain ⟨j, k⟩ := b
      have hi0 : e i l ≠ 0 :=
        left_ne_zero_of_mul (left_ne_zero_of_mul (left_ne_zero_of_mul ha.2))
      have hj0 : e j k ≠ 0 :=
        left_ne_zero_of_mul (left_ne_zero_of_mul (left_ne_zero_of_mul hb.2))
      simp only [Function.comp_apply] at eq
      rw [Polynomial.degree_eq_natDegree ha.2, Polynomial.degree_eq_natDegree hb.2] at eq
      have hlabel := WithBot.coe_eq_coe.mp eq
      rw [hterm i l hi0, hterm j k hj0, Nat.add_assoc, Nat.add_assoc] at hlabel
      have hlabel' := Nat.add_left_cancel hlabel
      have hmod : (e i l).natDegree ≡ (e j k).natDegree [MOD L] := by
        simpa [Nat.ModEq, Nat.add_mod, Nat.mul_mod] using congrArg (· % L) hlabel'
      have hcoeff : (e i l).natDegree = (e j k).natDegree :=
        hmod.eq_of_lt_of_lt ((he i l).trans hSL) ((he j k).trans hSL)
      rw [hcoeff] at hlabel'
      have hmix := Nat.mul_left_cancel hLP (Nat.add_left_cancel hlabel')
      have hijM : i.val ≡ j.val [MOD p] := by
        simpa [Nat.ModEq, Nat.add_mod, Nat.mul_mod] using congrArg (· % p) hmix
      have hij : i = j := Fin.ext (hijM.eq_of_lt_of_lt i.isLt j.isLt)
      subst j
      have hlk := Nat.mul_left_cancel hp0 (Nat.add_left_cancel hmix)
      exact hab (by simp [Fin.ext hlk])
    have hsum := Polynomial.degree_sum_eq_of_disjoint F Finset.univ hpair
    intro hh
    rw [hh, Polynomial.degree_zero, eq_comm, Finset.sup_eq_bot_iff] at hsum
    obtain ⟨i, l, hil⟩ := hne
    exact hnonzero i l hil (Polynomial.degree_eq_bot.mp (hsum (i, l) (Finset.mem_univ _)))
  · rw [heval]
    let U := S₀ + (d + 1) * (p - 1) * L + p ^ (2 * (h + 3)) * p ^ h
    have hU : 0 < U := by dsimp [U]; have : 0 < S₀ := Nat.pow_pos hp0; omega
    change (∑ a, F a).natDegree < U
    refine (Polynomial.natDegree_sum_le _ _).trans_lt ((Finset.sup_lt_iff hU).2 ?_)
    intro a ha
    obtain ⟨i, l⟩ := a
    simp only [Function.comp_apply]
    by_cases hc : e i l = 0
    · simpa [F, hc] using hU
    rw [hterm i l hc]
    have hi : i.val ≤ p - 1 := by have := i.isLt; omega
    have hl : l.val ≤ p ^ h := by have := l.isLt; omega
    have hh : L * (i.val + p * l.val) ≤ L * ((p - 1) + p * p ^ h) := by gcongr
    dsimp only [U, S₀]
    rw [hexp]
    nlinarith only [he i l, hh]

theorem coeff_mul_eq_mul_coeff_zero_of_right_low_coeff_eq_zero
    {R : Type*} [CommSemiring R] {F G : R[X]} {r : ℕ}
    (hG : ∀ j, 0 < j → j ≤ r → G.coeff j = 0) :
    (F * G).coeff r = F.coeff r * G.coeff 0 := by
  rw [coeff_mul, Finset.sum_eq_single (r, 0)]
  · rintro ⟨i, j⟩ hij hne
    have hij := Finset.HasAntidiagonal.mem_antidiagonal.mp hij
    have hj : j ≠ 0 := by rintro rfl; exact hne (by simp_all)
    rw [hG j (Nat.pos_of_ne_zero hj) (by omega), mul_zero]
  · simp

theorem taylor_expand_pow {E : Type*} [CommRing E] {p n : ℕ} [Fact p.Prime]
    [CharP E p] (x : E) (g : E[X]) :
    taylor x (expand E (p ^ n) g) = expand E (p ^ n) (taylor (x ^ (p ^ n)) g) := by
  simp only [taylor_apply, expand_eq_comp_X_pow, comp_assoc, X_pow_comp,
    add_comp, X_comp, C_comp]
  rw [add_pow_char_pow]
  rw [← map_pow]

theorem coeff_taylor_expand_pow_eq_zero
    {E : Type*} [CommRing E] {p n r : ℕ} [Fact p.Prime] [CharP E p]
    (hp : 0 < p) (x : E) (g : E[X]) (hrpos : 0 < r) (hr : r < p ^ n) :
    (taylor x (expand E (p ^ n) g)).coeff r = 0 := by
  rw [taylor_expand_pow x g, coeff_expand (Nat.pow_pos hp),
    ite_eq_right (Nat.not_dvd_of_pos_of_lt hrpos hr)]

theorem coeff_zero_taylor_expand_pow
    {E : Type*} [CommRing E] {p n : ℕ} [Fact p.Prime] [CharP E p]
    (hp : 0 < p) (x : E) (g : E[X]) :
    (taylor x (expand E (p ^ n) g)).coeff 0 = g.eval (x ^ (p ^ n)) := by
  rw [taylor_expand_pow, coeff_expand (Nat.pow_pos hp)]
  simp

theorem eval_hasseDeriv_mul_expand_pow
    {E : Type*} [CommRing E] {p n r : ℕ} [Fact p.Prime] [CharP E p]
    (hp : 0 < p) (x : E) (e g : E[X]) (hr : r < p ^ n) :
    (hasseDeriv r (e * expand E (p ^ n) g)).eval x =
      (hasseDeriv r e).eval x * g.eval (x ^ (p ^ n)) := by
  rw [← taylor_coeff, taylor_mul,
    coeff_mul_eq_mul_coeff_zero_of_right_low_coeff_eq_zero,
    coeff_zero_taylor_expand_pow hp, taylor_coeff]
  intro j hj hjr
  exact coeff_taylor_expand_pow_eq_zero hp x g hj (hjr.trans_lt hr)

theorem clearedAuxiliary_hasse_trace_and_multiplicity
    (p h : ℕ) [Fact p.Prime]
    {E : Type u} [Field E] [Finite E] [Algebra (ZMod p) E]
    (hfinrank : Module.finrank (ZMod p) E = 2 * (h + 3))
    (A D : (ZMod p)[X])
    (e : Fin p → Fin (p ^ h + 1) → E[X]) :
    let φ : ZMod p →+* E := algebraMap (ZMod p) E
    let AE := A.map φ
    let DE := D.map φ
    let B := DE ^ (p ^ (h + 2))
    let BH := expand E (p ^ (h + 3)) B
    let Ψ := clearedAuxiliaryPolynomial p h AE DE e
    ∀ t : ZMod p,
      (∀ x : E, DE.eval x ≠ 0 →
        Algebra.trace (ZMod p) E (AE.eval x / DE.eval x) = t →
        ∀ v : ℕ, v < p ^ (h + 1) →
          B.eval x ^ (p - 1) * (hasseDeriv v Ψ).eval x =
            BH.eval x ^ (p - 1) *
              (clearedReducedPolynomial p h AE DE (φ t) v e).eval x) ∧
      (Ψ ≠ 0 →
        (∀ v : ℕ, v < p ^ (h + 1) →
          clearedReducedPolynomial p h AE DE (φ t) v e = 0) →
        ∀ x : E, DE.eval x ≠ 0 →
          Algebra.trace (ZMod p) E (AE.eval x / DE.eval x) = t →
          p ^ (h + 1) ≤ Ψ.rootMultiplicity x) := by
  let _ := Fintype.ofFinite E
  let _ : CharP E p := charP_of_injective_algebraMap
    (FaithfulSMul.algebraMap_injective (ZMod p) E) p
  intro φ AE DE B BH Ψ
  let N := clearedTraceNumerator p (h + 3) AE DE
  let NH := expand E (p ^ (h + 3)) N
  have hp0 : 0 < p := (Fact.out : Nat.Prime p).pos
  have hlow : p ^ (h + 1) < p ^ (h + 3) := Nat.pow_lt_pow_right (Fact.out : Nat.Prime p).one_lt
    (by omega)
  have hcard : p ^ (2 * (h + 3)) = Fintype.card E := by
    rw [← hfinrank]
    exact FiniteField.pow_finrank_eq_card p E
  have hBM : ((D ^ (p ^ (h + 2))).map φ) = B := by simp [B, DE]
  have hNM : (clearedTraceNumerator p (h + 3) A D).map φ = N := by
    simp [N, clearedTraceNumerator, AE, DE, Polynomial.map_sum, Polynomial.map_mul,
      Polynomial.map_expand, Polynomial.map_pow]
  have hBgood (x : E) (hx : DE.eval x ≠ 0) : B.eval x ≠ 0 := by
    simpa [B, Polynomial.eval_pow] using (pow_ne_zero (p ^ (h + 2)) hx)
  intro t
  have hident : ∀ x : E, DE.eval x ≠ 0 → Algebra.trace (ZMod p) E (AE.eval x / DE.eval x) = t →
      ∀ v : ℕ, v < p ^ (h + 1) → B.eval x ^ (p - 1) * (hasseDeriv v Ψ).eval x =
        BH.eval x ^ (p - 1) * (clearedReducedPolynomial p h AE DE (φ t) v e).eval x := by
    intro x hx ht v hv
    have htr := clearedTraceNumerator_trace p (h + 3) (by omega) hfinrank A D x hx
    have hdiff : NH.eval x * B.eval x = BH.eval x * (φ t * B.eval x - N.eval x) := by
      simpa only [φ, Polynomial.map_expand,
        show h + 3 - 1 = h + 2 by omega, hBM, hNM, NH, BH] using (htr.2.2.2.2.2.2.2.2 t).mp ht
    have hxcard : x ^ (p ^ (2 * (h + 3))) = x := by rw [hcard]; exact FiniteField.pow_card x
    have hfrozen (i : Fin p) (l : Fin (p ^ h + 1)) :
        (hasseDeriv v (e i l * NH ^ i.val * BH ^ (p - 1 - i.val) *
          X ^ (p ^ (2 * (h + 3)) * l.val))).eval x =
        (hasseDeriv v (e i l)).eval x * NH.eval x ^ i.val *
          BH.eval x ^ (p - 1 - i.val) * x ^ l.val := by
      have heq : NH ^ i.val * BH ^ (p - 1 - i.val) * X ^ (p ^ (2 * (h + 3)) * l.val) =
          expand E (p ^ (h + 3)) (N ^ i.val * B ^ (p - 1 - i.val) * X ^ (p ^ (h + 3) * l.val)) := by
        have hpow : p ^ (2 * (h + 3)) = p ^ (h + 3) * p ^ (h + 3) := by
          rw [← pow_add]; congr 1; omega
        simp only [map_pow, map_mul, expand_X, NH, BH]
        rw [hpow, mul_assoc, pow_mul, pow_mul, pow_mul]
        ring
      have hv' : v < p ^ (h + 3) := hv.trans hlow
      simp only [mul_assoc] at heq ⊢
      rw [heq, eval_hasseDeriv_mul_expand_pow hp0 x _ _ hv']
      simp only [Polynomial.eval_mul, Polynomial.eval_pow, Polynomial.eval_X]
      have hXpow : (x ^ (p ^ (h + 3))) ^ (p ^ (h + 3) * l.val) = x ^ l.val := by
        have hx2 : (x ^ (p ^ (h + 3))) ^ (p ^ (h + 3)) = x := by
          rw [← pow_mul, ← pow_add, show h + 3 + (h + 3) = 2 * (h + 3) by omega, hxcard]
        rw [pow_mul, hx2]
      simp only [NH, BH, expand_eval, hXpow]
    have hpoint (i : Fin p) (l : Fin (p ^ h + 1)) :
        B.eval x ^ (p - 1) * (hasseDeriv v (e i l * NH ^ i.val * BH ^ (p - 1 - i.val) *
          X ^ (p ^ (2 * (h + 3)) * l.val))).eval x = BH.eval x ^ (p - 1) *
          (hasseDeriv v (e i l) * (C (φ t) * B - N) ^ i.val *
            B ^ (p - 1 - i.val) * X ^ l.val).eval x := by
      have hi : i.val ≤ p - 1 := by have := i.isLt; omega
      have hdifpow : NH.eval x ^ i.val * B.eval x ^ i.val =
          BH.eval x ^ i.val * (φ t * B.eval x - N.eval x) ^ i.val := by
        rw [← mul_pow, hdiff, mul_pow]
      rw [hfrozen]
      simp only [Polynomial.eval_mul, Polynomial.eval_pow, Polynomial.eval_sub,
        Polynomial.eval_C, Polynomial.eval_X]
      rw [← pow_mul_pow_sub (B.eval x) hi, ← pow_mul_pow_sub (BH.eval x) hi]
      linear_combination (BH.eval x ^ (p - 1 - i.val) * B.eval x ^ (p - 1 - i.val) *
        (hasseDeriv v (e i l)).eval x * x ^ l.val) * hdifpow
    dsimp only [Ψ, clearedAuxiliaryPolynomial, clearedReducedPolynomial]
    simp only [map_sum, Polynomial.eval_finsetSum, Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro i _
    apply Finset.sum_congr rfl
    intro l _
    exact hpoint i l
  refine ⟨hident, ?_⟩
  intro hΨ hred x hx ht
  rw [Polynomial.rootMultiplicity_eq_natTrailingDegree]
  apply Polynomial.le_natTrailingDegree ((Polynomial.taylor_eq_zero x Ψ).not.mpr hΨ)
  intro v hv
  rw [Polynomial.taylor_coeff]
  have hid := hident x hx ht v hv
  rw [hred v hv, Polynomial.eval_zero, mul_zero] at hid
  exact (mul_eq_zero.mp hid).resolve_left (pow_ne_zero _ (hBgood x hx))

theorem norm_fintype_sum_comp_le_of_card_fiber_le
    {X Y : Type*} [Fintype X] [Fintype Y] [DecidableEq Y]
    (g : X → Y) (weight : Y → ℂ) (A E : ℕ)
    (hfiber : ∀ y : Y,
      (Finset.univ.filter fun x : X => g x = y).card ≤ A + E)
    (hcard : Fintype.card X = Fintype.card Y * A)
    (hmean : ∑ y : Y, weight y = 0)
    (hweight : ∀ y : Y, ‖weight y‖ ≤ 1) :
    ‖∑ x : X, weight (g x)‖ ≤ (Fintype.card Y * E : ℕ) := by
  let N : Y → ℕ := fun y => (Finset.univ.filter fun x : X => g x = y).card
  have hN (y : Y) : N y ≤ A + E := hfiber y
  have hNsum : ∑ y : Y, N y = Fintype.card X := by
    simpa [N] using Finset.sum_card_fiberwise_eq_card_filter
      (Finset.univ : Finset X) (Finset.univ : Finset Y) g
  have hdefsum : ∑ y : Y, (A + E - N y) = Fintype.card Y * E := by
    rw [Finset.sum_tsub_distrib _ (fun y _ => hN y), hNsum, hcard]
    simp [mul_add]
  have hgroup : (∑ x : X, weight (g x)) = ∑ y : Y, (N y : ℂ) * weight y := by
    simpa [N, nsmul_eq_mul] using
      (Finset.sum_fiberwise' (Finset.univ : Finset X) g weight).symm
  have hrecenter : (∑ y : Y, (N y : ℂ) * weight y) =
      -∑ y : Y, ((A + E - N y : ℕ) : ℂ) * weight y := by
    simp_rw [Nat.cast_sub (hN _), sub_mul]
    rw [Finset.sum_sub_distrib, ← Finset.mul_sum, hmean]
    simp
  rw [hgroup, hrecenter, norm_neg]
  calc
    ‖∑ y : Y, ((A + E - N y : ℕ) : ℂ) * weight y‖ ≤
        ∑ y : Y, ((A + E - N y : ℕ) : ℝ) := by
      refine norm_sum_le_of_le _ fun y _ => ?_
      rw [norm_mul, Complex.norm_natCast]
      simpa using mul_le_mul_of_nonneg_left (hweight y) (Nat.cast_nonneg (A + E - N y))
    _ = (Fintype.card Y * E : ℕ) := by exact_mod_cast hdefsum

open Classical in
theorem rational_even_extension_fiber_and_sum_bound
    (p : ℕ) [Fact p.Prime]
    (S M : Finset (ZMod p)) (a : ZMod p → ZMod p) (z₀ b c : ZMod p)
    (hz₀ : z₀ ∈ S) (ha : ∀ z ∈ S, a z ≠ 0) (hSM : S ⊆ M)
    (hs : S.card + (if b = 0 then 0 else 1) < p) :
    let s := S.card + if b = 0 then 0 else 1
    let C₀ := s * (p - 1) * p + 1
    let C₁ := p * C₀ + (p + 1) * (s - 1) + 1 + (M \ S).card
    ∀ m : ℕ, 3 ≤ m →
      ∀ (E : Type v) [Field E] [Fintype E] [Algebra (ZMod p) E],
        Module.finrank (ZMod p) E = 2 * m →
        let φ : ZMod p →+* E := algebraMap (ZMod p) E
        let DE := (mobiusDenominator S z₀ b).map φ
        let AE := (mobiusNumerator S a z₀ b c).map φ
        (∀ t : ZMod p,
          ((Finset.univ : Finset E).filter fun x =>
            DE.eval x ≠ 0 ∧
              Algebra.trace (ZMod p) E (AE.eval x / DE.eval x) = t).card <
            p ^ (2 * m - 1) + C₀ * p ^ m) ∧
        (‖∑ x ∈ (Finset.univ : Finset E).filter (fun x => DE.eval x ≠ 0),
          ZMod.stdAddChar (Algebra.trace (ZMod p) E (AE.eval x / DE.eval x))‖ ≤
            ((p * C₀ * p ^ m + (p + 1) * (s - 1) : ℕ) : ℝ)) ∧
        ‖∑ x ∈ (Finset.univ : Finset E).filter (fun x => ∀ z ∈ M, x ≠ φ z),
          ZMod.stdAddChar (Algebra.trace (ZMod p) E
            (φ b * x + φ c + ∑ z ∈ S, φ (a z) / (x - φ z)))‖ ≤
              (C₁ : ℝ) * (p : ℝ) ^ m := by
  intro s C₀ C₁ m hm E _ _ _ hfinrank
  let φ : ZMod p →+* E := algebraMap (ZMod p) E
  let A := mobiusNumerator S a z₀ b c
  let D := mobiusDenominator S z₀ b
  let DE := D.map φ
  let AE := A.map φ
  let h := m - 3
  have hm3 : h + 3 = m := by omega
  rw [← hm3] at hfinrank ⊢
  have hp0 : 0 < p := (Fact.out : Nat.Prime p).pos
  have hp : 1 < p := (Fact.out : Nat.Prime p).one_lt
  have hspos : 0 < s := by dsimp [s]; have := Finset.card_pos.mpr ⟨z₀, hz₀⟩; split_ifs <;> omega
  obtain ⟨_, hD, _, hDdeg, hAdeg, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _⟩ :=
    mobius_normalization φ S a z₀ b c hz₀ ha
  have hDE : DE ≠ 0 := Polynomial.map_ne_zero hD
  have hDEdeg : DE.natDegree = s - 1 := by
    rw [show DE.natDegree = D.natDegree from Polynomial.natDegree_map φ, hDdeg]
    by_cases hb : b = 0 <;> simp [hb, s]
  have hAEdeg : AE.natDegree = s := by
    by_cases hb : b = 0 <;> simpa [AE, A, s, hb] using (Polynomial.natDegree_map φ).trans hAdeg
  have hAD : AE.natDegree = DE.natDegree + 1 := by rw [hAEdeg, hDEdeg]; omega
  have hsE : DE.natDegree + 1 < p := by rw [← hAD, hAEdeg]; exact hs
  let Z := (Finset.univ : Finset E).filter fun x => DE.eval x = 0
  have hZ : Z.card ≤ s - 1 := (Polynomial.card_le_degree_of_subset_roots (by
    intro x hx
    apply (Polynomial.mem_roots hDE).2
    exact (Finset.mem_filter.mp hx).2)).trans_eq hDEdeg
  change
    (∀ t : ZMod p, ((Finset.univ : Finset E).filter fun x => DE.eval x ≠ 0 ∧
      Algebra.trace (ZMod p) E (AE.eval x / DE.eval x) = t).card <
        p ^ (2 * (h + 3) - 1) + C₀ * p ^ (h + 3)) ∧ _
  have hfib (t : ZMod p) : ((Finset.univ : Finset E).filter fun x => DE.eval x ≠ 0 ∧
      Algebra.trace (ZMod p) E (AE.eval x / DE.eval x) = t).card <
      p ^ (2 * (h + 3) - 1) + C₀ * p ^ (h + 3) := by
    obtain ⟨e, he, hnon, hred⟩ := exists_nonzero_clearedAuxiliaryCoefficients
      p h hp AE DE hDE hAD hsE (φ t)
    let Ψ := clearedAuxiliaryPolynomial p h AE DE e
    obtain ⟨_, hΨ, hdeg⟩ := clearedAuxiliaryPolynomial_ne_zero_and_degree.{v} p h hp AE DE
      hDE hAD e he hnon
    have hmult := (clearedAuxiliary_hasse_trace_and_multiplicity p h hfinrank A D e t).2 hΨ hred
    let points := (Finset.univ : Finset E).filter fun x => DE.eval x ≠ 0 ∧
      Algebra.trace (ZMod p) E (AE.eval x / DE.eval x) = t
    let R₀ := p ^ (h + 1)
    have hr : 0 < R₀ := Nat.pow_pos hp0
    have hpts (x : E) (hx : x ∈ points) : R₀ ≤ Ψ.rootMultiplicity x := by
      obtain ⟨_, hx, ht⟩ := Finset.mem_filter.mp hx
      exact hmult x hx ht
    have hsubset : points ⊆ Ψ.roots.toFinset := by
      intro x hx
      rw [Multiset.mem_toFinset, ← Multiset.count_pos, Polynomial.count_roots]
      exact hr.trans_le (hpts x hx)
    have hcount : R₀ * points.card ≤ Ψ.natDegree := calc
      _ = ∑ x ∈ points, R₀ := by simp [Nat.mul_comm]
      _ ≤ ∑ x ∈ points, Ψ.rootMultiplicity x := Finset.sum_le_sum hpts
      _ = ∑ x ∈ points, Ψ.roots.count x := by simp only [Polynomial.count_roots]
      _ ≤ ∑ x ∈ Ψ.roots.toFinset, Ψ.roots.count x := Finset.sum_le_sum_of_subset hsubset
      _ = Ψ.roots.card := Multiset.toFinset_sum_count_eq Ψ.roots
      _ ≤ Ψ.natDegree := Polynomial.card_roots' Ψ
    have hboundeq : p ^ (2 * h + 4) + s * (p - 1) * p ^ (2 * h + 5) +
          p ^ (2 * (h + 3)) * p ^ h = R₀ * (p ^ (2 * (h + 3) - 1) + C₀ * p ^ (h + 3)) := by
      have h1 : p ^ (2 * h + 4) = p ^ (h + 1) * p ^ (h + 3) := by rw [← pow_add]; congr 1; omega
      have h2 : p ^ (2 * h + 5) = p ^ (h + 1) * (p * p ^ (h + 3)) := by
        rw [← pow_succ', ← pow_add]; congr 1; omega
      have h3 : p ^ (2 * (h + 3)) * p ^ h = p ^ (h + 1) * p ^ (2 * (h + 3) - 1) := by
        rw [← pow_add, ← pow_add]; congr 1; omega
      simp only [R₀, C₀, h1, h2, h3]
      ring
    have hdeg' : Ψ.natDegree < R₀ * (p ^ (2 * (h + 3) - 1) + C₀ * p ^ (h + 3)) := by
      rw [hDEdeg, show s - 1 + 1 = s by omega, hboundeq] at hdeg
      exact hdeg
    change points.card < p ^ (2 * (h + 3) - 1) + C₀ * p ^ (h + 3)
    exact (Nat.mul_lt_mul_left hr).mp (hcount.trans_lt hdeg')
  let g (x : E) : ZMod p := if DE.eval x = 0 then 0 else
    Algebra.trace (ZMod p) E (AE.eval x / DE.eval x)
  let weight : ZMod p → ℂ := ZMod.stdAddChar
  have hweight (t : ZMod p) : ‖weight t‖ = 1 := Circle.norm_coe _
  have hmean : ∑ t : ZMod p, weight t = 0 := by
    simpa [weight] using AddChar.sum_eq_zero_of_ne_one
      (ZMod.isPrimitive_stdAddChar p (one_ne_zero : (1 : ZMod p) ≠ 0))
  have hgcard : Fintype.card E = Fintype.card (ZMod p) * p ^ (2 * (h + 3) - 1) := calc
    Fintype.card E = p ^ (2 * (h + 3)) := by
      rw [← hfinrank]
      exact (FiniteField.pow_finrank_eq_card p E).symm
    _ = Fintype.card (ZMod p) * p ^ (2 * (h + 3) - 1) := by
      rw [ZMod.card, ← pow_succ']
      congr 1
  have hg (t : ZMod p) :
      ((Finset.univ : Finset E).filter fun x => g x = t).card ≤
        p ^ (2 * (h + 3) - 1) + (C₀ * p ^ (h + 3) + (s - 1)) := by
    let good := (Finset.univ : Finset E).filter fun x => DE.eval x ≠ 0 ∧
      Algebra.trace (ZMod p) E (AE.eval x / DE.eval x) = t
    have hsub : (Finset.univ : Finset E).filter (fun x => g x = t) ⊆ Z ∪ good := by
      intro x hx
      by_cases hx0 : DE.eval x = 0
      · exact Finset.mem_union_left _ (Finset.mem_filter.mpr ⟨Finset.mem_univ _, hx0⟩)
      · apply Finset.mem_union_right
        apply Finset.mem_filter.mpr
        refine ⟨Finset.mem_univ _, hx0, ?_⟩
        simpa only [g, hx0, ↓reduceIte] using (Finset.mem_filter.mp hx).2
    have ht := hfib t
    have ht' : good.card ≤ p ^ (2 * (h + 3) - 1) + C₀ * p ^ (h + 3) := ht.le
    exact (Finset.card_le_card hsub).trans
      ((Finset.card_union_le _ _).trans (by omega))
  have hfull := norm_fintype_sum_comp_le_of_card_fiber_le g weight
    (p ^ (2 * (h + 3) - 1)) (C₀ * p ^ (h + 3) + (s - 1)) hg hgcard hmean (fun t => (hweight t).le)
  simp only [ZMod.card] at hfull
  let regular := (Finset.univ : Finset E).filter fun x => DE.eval x ≠ 0
  have hsplit : (∑ x : E, weight (g x)) =
      (∑ x ∈ regular, weight (Algebra.trace (ZMod p) E (AE.eval x / DE.eval x))) +
      ∑ x ∈ Z, weight (g x) := by
    have heval (x : E) (hx : DE.eval x ≠ 0) : g x =
        Algebra.trace (ZMod p) E (AE.eval x / DE.eval x) := by simp [g, hx]
    symm
    rw [← Finset.sum_filter_add_sum_filter_not (Finset.univ : Finset E)
      (fun x => DE.eval x ≠ 0) (fun x => weight (g x))]
    congr 1
    · apply Finset.sum_congr rfl
      intro x hx
      rw [heval x (Finset.mem_filter.mp hx).2]
    · congr 1
      ext x
      simp [Z]
  have hZn : ‖∑ x ∈ Z, weight (g x)‖ ≤ ((s - 1 : ℕ) : ℝ) := calc
    _ ≤ ∑ x ∈ Z, ‖weight (g x)‖ := norm_sum_le _ _
    _ = (Z.card : ℝ) := by simp only [hweight, Finset.sum_const, nsmul_eq_mul, mul_one]
    _ ≤ ((s - 1 : ℕ) : ℝ) := by exact_mod_cast hZ
  have hregular : ‖∑ x ∈ regular, ZMod.stdAddChar
      (Algebra.trace (ZMod p) E (AE.eval x / DE.eval x))‖ ≤
      ((p * C₀ * p ^ (h + 3) + (p + 1) * (s - 1) : ℕ) : ℝ) := calc
    _ = ‖(∑ x : E, weight (g x)) - ∑ x ∈ Z, weight (g x)‖ := by rw [hsplit, add_sub_cancel_right]
    _ ≤ ‖∑ x : E, weight (g x)‖ + ‖∑ x ∈ Z, weight (g x)‖ := norm_sub_le _ _
    _ ≤ ((p * (C₀ * p ^ (h + 3) + (s - 1)) : ℕ) : ℝ) + ((s - 1 : ℕ) : ℝ) := add_le_add hfull hZn
    _ = ((p * C₀ * p ^ (h + 3) + (p + 1) * (s - 1) : ℕ) : ℝ) := by push_cast; ring
  refine ⟨hfib, hregular, ?_⟩
  let H (x : E) : ℂ := ZMod.stdAddChar (Algebra.trace (ZMod p) E x)
  let f (x : E) : E := φ b * x + φ c + ∑ z ∈ S, φ (a z) / (x - φ z)
  have hmask := (mobius_masked_sum φ S M a z₀ b c hz₀ ha hSM H).2
  have hbterm : ‖(if b = 0 then H (φ c) else 0)‖ ≤ (1 : ℝ) := by
    split_ifs <;> simp [H]
  have hextra : ‖∑ z ∈ M \ S, H (f (φ z))‖ ≤ ((M \ S).card : ℝ) := calc
    _ ≤ ∑ z ∈ M \ S, ‖H (f (φ z))‖ := norm_sum_le _ _
    _ = ((M \ S).card : ℝ) := by simp [H, hweight, weight]
  change ‖∑ x ∈ (Finset.univ : Finset E).filter (fun x => ∀ z ∈ M, x ≠ φ z), H (f x)‖ ≤
    (C₁ : ℝ) * (p : ℝ) ^ (h + 3)
  have hmask' : (∑ x ∈ (Finset.univ : Finset E).filter (fun x => ∀ z ∈ M, x ≠ φ z), H (f x)) =
      (∑ u ∈ regular, H (AE.eval u / DE.eval u)) - (if b = 0 then H (φ c) else 0) -
        ∑ z ∈ M \ S, H (f (φ z)) := by
    convert hmask using 1
    · apply Finset.sum_congr
      · ext x; simp
      · intro x hx; rfl
    · congr 2
      · by_cases hb : b = 0 <;> simp [hb]
      · ext z; simp
  rw [hmask']
  calc
    _ ≤ ‖∑ u ∈ regular, H (AE.eval u / DE.eval u)‖ + 1 + ((M \ S).card : ℝ) :=
      (norm_sub_le _ _).trans (by gcongr; exact (norm_sub_le _ _).trans (by gcongr))
    _ ≤ ((p * C₀ * p ^ (h + 3) + (p + 1) * (s - 1) : ℕ) : ℝ) + 1 + ((M \ S).card : ℝ) := by
      gcongr
    _ ≤ (C₁ : ℝ) * (p : ℝ) ^ (h + 3) := by
      have hpPow : (1 : ℝ) ≤ (p : ℝ) ^ (h + 3) := by exact one_le_pow₀ (by exact_mod_cast hp.le)
      simp only [C₁, Nat.cast_add, Nat.cast_mul, Nat.cast_one, Nat.cast_pow]
      have hfix : (0 : ℝ) ≤ ((p : ℝ) + 1) * (s - 1 : ℕ) + 1 + (M \ S).card :=
        add_nonneg (add_nonneg (mul_nonneg (add_nonneg (Nat.cast_nonneg _) zero_le_one)
          (Nat.cast_nonneg _)) zero_le_one) (Nat.cast_nonneg _)
      have herr := le_mul_of_one_le_right hfix hpPow
      nlinarith

end PrimeGap186
end

section
open Polynomial

universe u v w

namespace PrimeGap186

/--
The additive-character weight used for monic polynomials in the reciprocal-phase Euler
construction. It is zero if the polynomial vanishes at a masked pole; otherwise it evaluates the
phase through the degree, next coefficient, and logarithmic derivatives at the poles.
-/
noncomputable def maskedReciprocalMonicWeight {K : Type*} [Field K]
    (ψ : AddChar K ℂ) (M : Finset K) (a : K → K) (b c : K)
    (g : Polynomial K) : ℂ := by
  classical
  exact if ∃ z ∈ M, g.eval z = 0 then 0 else
    ψ (c * (g.natDegree : K) - b * g.nextCoeff -
      ∑ z ∈ M, a z * (g.derivative.eval z / g.eval z))

theorem maskedReciprocalMonicWeight_one {K : Type*} [Field K]
    (ψ : AddChar K ℂ) (M : Finset K) (a : K → K) (b c : K) :
    maskedReciprocalMonicWeight ψ M a b c 1 = 1 := by
  simp [maskedReciprocalMonicWeight, Polynomial.nextCoeff]

theorem maskedReciprocalMonicWeight_mul_of_monic {K : Type*} [Field K]
    (ψ : AddChar K ℂ) (M : Finset K) (a : K → K) (b c : K)
    (g h : Polynomial K) (hg : g.Monic) (hh : h.Monic) :
    maskedReciprocalMonicWeight ψ M a b c (g * h) =
      maskedReciprocalMonicWeight ψ M a b c g *
        maskedReciprocalMonicWeight ψ M a b c h := by
  classical
  have hbad_mul : (∃ z ∈ M, (g * h).eval z = 0) ↔
      (∃ z ∈ M, g.eval z = 0) ∨ ∃ z ∈ M, h.eval z = 0 := by
    simp only [eval_mul, mul_eq_zero, and_or_left, exists_or]
  by_cases hg0 : ∃ z ∈ M, g.eval z = 0
  · simp only [maskedReciprocalMonicWeight, hbad_mul, hg0, true_or, ↓reduceIte, zero_mul]
  by_cases hh0 : ∃ z ∈ M, h.eval z = 0
  · simp only [maskedReciprocalMonicWeight, hbad_mul, hh0, or_true, ↓reduceIte, mul_zero]
  have hgval (z : K) (hz : z ∈ M) : g.eval z ≠ 0 := by
    intro hzero
    exact hg0 ⟨z, hz, hzero⟩
  have hhval (z : K) (hz : z ∈ M) : h.eval z ≠ 0 := by
    intro hzero
    exact hh0 ⟨z, hz, hzero⟩
  simp only [maskedReciprocalMonicWeight, hbad_mul, hg0, hh0, or_self, ↓reduceIte]
  rw [← ψ.map_add_eq_mul]
  congr 1
  rw [hg.natDegree_mul hh, hg.nextCoeff_mul hh, Nat.cast_add]
  have hsum :
      (∑ z ∈ M, a z * ((g * h).derivative.eval z / (g * h).eval z)) =
        (∑ z ∈ M, a z * (g.derivative.eval z / g.eval z)) +
          ∑ z ∈ M, a z * (h.derivative.eval z / h.eval z) := by
    rw [← Finset.sum_add_distrib]
    apply Finset.sum_congr rfl
    intro z hz
    simp only [derivative_mul, eval_add, eval_mul]
    field_simp [hgval z hz, hhval z hz]
  rw [hsum]
  ring

theorem finsum_maskedReciprocalMonicWeight_eq_zero
    (p : ℕ) [Fact p.Prime] (M : Finset (ZMod p)) (a : ZMod p → ZMod p)
    (b c : ZMod p) (n : ℕ) (hactive : ∃ j ∈ M, a j ≠ 0)
    (hn : 2 * M.card + (if b = 0 then 0 else 1) ≤ n) :
    (∑ᶠ g : {g : Polynomial (ZMod p) // g.Monic ∧ g.natDegree = n},
      maskedReciprocalMonicWeight ZMod.stdAddChar M a b c g.1) = 0 := by
  classical
  let : Fintype {g : Polynomial (ZMod p) // g.Monic ∧ g.natDegree = n} :=
    Fintype.ofEquiv (Fin n → ZMod p)
      (((Polynomial.monicEquivDegreeLT n).trans
        (Polynomial.degreeLTEquiv (ZMod p) n).toEquiv).symm)
  rw [finsum_eq_sum_of_fintype]
  obtain ⟨j, hj, haj⟩ := hactive
  have hMpos : 0 < M.card := Finset.card_pos.mpr ⟨j, hj⟩
  have hn' : 2 * M.card ≤ n := by omega
  have hnpos : 0 < n := by omega
  let Q : Polynomial (ZMod p) := ∏ z ∈ M.erase j, (X - C z)
  let H : Polynomial (ZMod p) := (X - C j) * Q ^ 2
  let κ : ZMod p := (Q.eval j) ^ 2
  have hQmonic : Q.Monic := monic_prod_X_sub_C id _
  have hQdegree : Q.natDegree = (M.erase j).card := by simp [Q]
  have hHdegree : H.natDegree = 2 * M.card - 1 := by
    dsimp only [H]
    rw [(monic_X_sub_C j).natDegree_mul (hQmonic.pow 2), natDegree_X_sub_C,
      hQmonic.natDegree_pow 2, hQdegree, Finset.card_erase_of_mem hj]
    omega
  have hQeval (x : ZMod p) : Q.eval x = ∏ z ∈ M.erase j, (x - z) := by
    simp [Q, Polynomial.eval_prod]
  have hQj : Q.eval j ≠ 0 := by
    simp +contextual [hQeval, Finset.prod_ne_zero_iff, sub_ne_zero, ne_comm]
  have hQzero (z : ZMod p) (hz : z ∈ M) (hzj : z ≠ j) : Q.eval z = 0 := by
    rw [hQeval]
    exact Finset.prod_eq_zero (Finset.mem_erase.mpr ⟨hzj, hz⟩) (by simp)
  have hHzero (z : ZMod p) (hz : z ∈ M) : H.eval z = 0 := by
    by_cases hzj : z = j
    · subst z
      simp [H]
    · simp [H, hQzero z hz hzj]
  have hHderivative (z : ZMod p) (hz : z ∈ M) :
      H.derivative.eval z = if z = j then κ else 0 := by
    by_cases hzj : z = j
    · subst z
      simp [H, κ, derivative_mul, derivative_sq]
    · simp [H, hzj, hQzero z hz hzj, derivative_mul, derivative_sq]
  have hκ : κ ≠ 0 := pow_ne_zero 2 hQj
  let T : ZMod p → Polynomial (ZMod p) → Polynomial (ZMod p) :=
    fun τ g => g + C (τ * g.eval j) * H
  have hTeval (τ : ZMod p) (g : Polynomial (ZMod p)) (z : ZMod p) (hz : z ∈ M) :
      (T τ g).eval z = g.eval z := by
    simp [T, hHzero z hz]
  have hTdegree (τ : ZMod p) (g : Polynomial (ZMod p))
      (hg : g.Monic) (hgn : g.natDegree = n) :
      (T τ g).Monic ∧ (T τ g).natDegree = n := by
    have hpert : (C (τ * g.eval j) * H).natDegree < g.natDegree := by
      calc
        _ ≤ H.natDegree := natDegree_C_mul_le _ _
        _ = 2 * M.card - 1 := hHdegree
        _ < g.natDegree := by rw [hgn]; omega
    exact ⟨hg.add_of_left (degree_lt_degree hpert),
      (natDegree_add_eq_left_of_natDegree_lt hpert).trans hgn⟩
  have hTinv (τ : ZMod p) (g : Polynomial (ZMod p)) : T (-τ) (T τ g) = g := by
    simp [T, hHzero j hj, neg_mul]
  have hTnext (τ : ZMod p) (g : Polynomial (ZMod p))
      (hg : g.Monic) (hgn : g.natDegree = n) (hb : b ≠ 0) :
      (T τ g).nextCoeff = g.nextCoeff := by
    have hdegree := (hTdegree τ g hg hgn).2
    have hnstrong : 2 * M.card + 1 ≤ n := by simpa [hb] using hn
    have hpert : (C (τ * g.eval j) * H).natDegree < n - 1 := by
      calc
        _ ≤ H.natDegree := natDegree_C_mul_le _ _
        _ = 2 * M.card - 1 := hHdegree
        _ < n - 1 := by omega
    simp only [Polynomial.nextCoeff, hdegree, hgn, ite_eq_right hnpos.ne']
    exact coeff_add_eq_left_of_lt hpert
  have hweight (τ : ZMod p) (g : Polynomial (ZMod p))
      (hg : g.Monic) (hgn : g.natDegree = n) :
      maskedReciprocalMonicWeight ZMod.stdAddChar M a b c (T τ g) =
        ZMod.stdAddChar (-a j * κ * τ) *
          maskedReciprocalMonicWeight ZMod.stdAddChar M a b c g := by
    have hbadT : (∃ z ∈ M, (T τ g).eval z = 0) ↔ ∃ z ∈ M, g.eval z = 0 :=
      exists_congr fun z => and_congr_right fun hz => by rw [hTeval τ g z hz]
    by_cases hbad : ∃ z ∈ M, g.eval z = 0
    · simp [maskedReciprocalMonicWeight, hbadT, hbad]
    have hgood (z : ZMod p) (hz : z ∈ M) : g.eval z ≠ 0 := by
      intro hzero
      exact hbad ⟨z, hz, hzero⟩
    simp only [maskedReciprocalMonicWeight, hbadT, ite_eq_right hbad]
    rw [← (ZMod.stdAddChar (N := p)).map_add_eq_mul]
    congr 1
    rw [(hTdegree τ g hg hgn).2, hgn]
    have hbnext : b * (T τ g).nextCoeff = b * g.nextCoeff := by
      by_cases hb : b = 0
      · simp [hb]
      · rw [hTnext τ g hg hgn hb]
    have hsum :
        (∑ z ∈ M, a z * ((T τ g).derivative.eval z / (T τ g).eval z)) =
          (∑ z ∈ M, a z * (g.derivative.eval z / g.eval z)) + a j * τ * κ := by
      calc
        _ = ∑ z ∈ M,
            (a z * (g.derivative.eval z / g.eval z) +
              if z = j then a j * τ * κ else 0) := by
          apply Finset.sum_congr rfl
          intro z hz
          rw [hTeval τ g z hz]
          simp only [T, derivative_add, derivative_C_mul,
            eval_add, eval_mul, eval_C]
          rw [hHderivative z hz]
          by_cases hzj : z = j
          · subst z
            simp only [↓reduceIte]
            field_simp [hgood j hj]
          · simp [hzj]
        _ = _ := by rw [Finset.sum_add_distrib]; simp [hj]
    rw [hbnext, hsum]
    ring
  let τ : ZMod p := (-a j * κ)⁻¹
  have hα : -a j * κ ≠ 0 := mul_ne_zero (neg_ne_zero.mpr haj) hκ
  have heigen : ZMod.stdAddChar (-a j * κ * τ) = ZMod.stdAddChar (1 : ZMod p) := by
    congr 1
    exact mul_inv_cancel₀ hα
  let e : {g : Polynomial (ZMod p) // g.Monic ∧ g.natDegree = n} ≃
      {g : Polynomial (ZMod p) // g.Monic ∧ g.natDegree = n} :=
    { toFun := fun g => ⟨T τ g.1, hTdegree τ g.1 g.2.1 g.2.2⟩
      invFun := fun g => ⟨T (-τ) g.1, hTdegree (-τ) g.1 g.2.1 g.2.2⟩
      left_inv := by
        intro g
        apply Subtype.ext
        exact hTinv τ g.1
      right_inv := by
        intro g
        apply Subtype.ext
        simpa only [neg_neg] using hTinv (-τ) g.1 }
  have heq : ZMod.stdAddChar (1 : ZMod p) *
      (∑ g : {g : Polynomial (ZMod p) // g.Monic ∧ g.natDegree = n},
        maskedReciprocalMonicWeight ZMod.stdAddChar M a b c g.1) =
      ∑ g : {g : Polynomial (ZMod p) // g.Monic ∧ g.natDegree = n},
        maskedReciprocalMonicWeight ZMod.stdAddChar M a b c g.1 := by
    rw [Finset.mul_sum]
    calc
      _ = ∑ g : {g : Polynomial (ZMod p) // g.Monic ∧ g.natDegree = n},
          maskedReciprocalMonicWeight ZMod.stdAddChar M a b c (T τ g.1) := by
        apply Finset.sum_congr rfl
        intro g _
        rw [hweight τ g.1 g.2.1 g.2.2, heigen]
      _ = _ := e.sum_comp
        (fun g => maskedReciprocalMonicWeight ZMod.stdAddChar M a b c g.1)
  exact eq_zero_of_mul_eq_self_left
    (by simpa using ZMod.injective_stdAddChar.ne (one_ne_zero : (1 : ZMod p) ≠ 0)) heq

/--
The truncated generating polynomial whose degree-`n` coefficient sums reciprocal-phase weights
over monic degree-`n` polynomials over `ZMod p`. Degrees range strictly below `2 * M.card + (if
b = 0 then 0 else 1)`.
-/
noncomputable def maskedReciprocalEulerPolynomial
    (p : ℕ) [Fact p.Prime] (M : Finset (ZMod p))
    (a : ZMod p → ZMod p) (b c : ZMod p) : Polynomial ℂ := by
  classical
  exact ∑ n ∈ Finset.range (2 * M.card + (if b = 0 then 0 else 1)),
    Polynomial.monomial n
      (∑ᶠ g : {g : Polynomial (ZMod p) // g.Monic ∧ g.natDegree = n},
        maskedReciprocalMonicWeight ZMod.stdAddChar M a b c g.1)

theorem maskedReciprocalEulerPolynomial_spec
    (p : ℕ) [Fact p.Prime] (M : Finset (ZMod p))
    (a : ZMod p → ZMod p) (b c : ZMod p)
    (hactive : ∃ j ∈ M, a j ≠ 0) :
    let L := maskedReciprocalEulerPolynomial p M a b c
    L.coeff 0 = 1 ∧
    L.natDegree < 2 * M.card + (if b = 0 then 0 else 1) ∧
    (∀ n : ℕ, L.coeff n =
      ∑ᶠ g : {g : Polynomial (ZMod p) // g.Monic ∧ g.natDegree = n},
        maskedReciprocalMonicWeight ZMod.stdAddChar M a b c g.1) ∧
    L = (L.reverse.roots.map
      (fun α => (1 - Polynomial.C α * Polynomial.X : Polynomial ℂ))).prod ∧
    L.reverse.roots.card = L.natDegree := by
  classical
  let L := maskedReciprocalEulerPolynomial p M a b c
  let N := 2 * M.card + (if b = 0 then 0 else 1)
  have htrunc (n : ℕ) : L.coeff n = if n < N then
      (∑ᶠ g : {g : Polynomial (ZMod p) // g.Monic ∧ g.natDegree = n},
        maskedReciprocalMonicWeight ZMod.stdAddChar M a b c g.1) else 0 := by
    dsimp only [L]
    delta maskedReciprocalEulerPolynomial
    simp only [Polynomial.finsetSum_coeff, Polynomial.coeff_monomial,
      Finset.sum_ite_eq', Finset.mem_range, N]
  have hcoef (n : ℕ) : L.coeff n =
      ∑ᶠ g : {g : Polynomial (ZMod p) // g.Monic ∧ g.natDegree = n},
        maskedReciprocalMonicWeight ZMod.stdAddChar M a b c g.1 := by
    rw [htrunc]
    by_cases hn : n < N
    · simp only [hn, ↓reduceIte]
    · rw [ite_eq_right hn]
      symm
      apply finsum_maskedReciprocalMonicWeight_eq_zero p M a b c n hactive
      exact Nat.le_of_not_gt hn
  have h0sum : (∑ᶠ g : {g : Polynomial (ZMod p) // g.Monic ∧ g.natDegree = 0},
      maskedReciprocalMonicWeight ZMod.stdAddChar M a b c g.1) = 1 := by
    let unit : {g : Polynomial (ZMod p) // g.Monic ∧ g.natDegree = 0} := ⟨1, by simp⟩
    rw [finsum_eq_single _ unit]
    · exact maskedReciprocalMonicWeight_one ZMod.stdAddChar M a b c
    · intro g hg
      exact (hg (Subtype.ext (Polynomial.eq_one_of_monic_natDegree_zero g.2.1 g.2.2))).elim
  have h0 : L.coeff 0 = 1 := (hcoef 0).trans h0sum
  have hne : L ≠ 0 := by intro he; simp [he] at h0
  have hdeg : L.natDegree < N := by
    rw [Polynomial.natDegree_lt_iff_degree_lt hne, Polynomial.degree_lt_iff_coeff_zero]
    intro i hi
    rw [htrunc i, ite_eq_right (Nat.not_lt_of_ge hi)]
  have htrail : L.natTrailingDegree = 0 :=
    Polynomial.natTrailingDegree_eq_zero.mpr (Or.inr (by simp [h0]))
  have hdouble : L.reverse.reverse = L := by
    rw [Polynomial.reverse, Polynomial.reverse_natDegree, htrail, Nat.sub_zero]
    exact Polynomial.reflect_reflect
  have hmon : L.reverse.Monic := by
    rw [Polynomial.Monic, Polynomial.reverse_leadingCoeff,
      Polynomial.trailingCoeff_eq_coeff_zero (by simp [h0]), h0]
  have hcard : L.reverse.roots.card = L.natDegree := by
    rw [Polynomial.splits_iff_card_roots.mp (IsAlgClosed.splits L.reverse),
      Polynomial.reverse_natDegree, htrail, Nat.sub_zero]
  have hlin (z : ℂ) : (Polynomial.X - Polynomial.C z : Polynomial ℂ).reverse =
      1 - Polynomial.C z * Polynomial.X := by
    rw [Polynomial.reverse, Polynomial.natDegree_X_sub_C, Polynomial.reflect_sub,
      Polynomial.reflect_one_X, Polynomial.reflect_C, pow_one]
  have hprod (s : Multiset (Polynomial ℂ)) : s.prod.reverse =
      (s.map Polynomial.reverse).prod := by
    induction s using Multiset.induction_on with
    | empty => simp [Polynomial.reverse]
    | cons F s ih => simp [Polynomial.reverse_mul_of_domain, ih]
  have hfact := (IsAlgClosed.splits L.reverse).eq_prod_roots_of_monic hmon
  have hrecip : L = (L.reverse.roots.map (fun α =>
      (1 - Polynomial.C α * Polynomial.X : Polynomial ℂ))).prod := by
    calc
      L = L.reverse.reverse := hdouble.symm
      _ = ((L.reverse.roots.map (Polynomial.X - Polynomial.C ·)).prod).reverse :=
        congrArg Polynomial.reverse hfact
      _ = _ := by
        rw [hprod, Multiset.map_map]
        congr 1
        exact Multiset.map_congr rfl (fun z _ => hlin z)
  exact ⟨h0, hdeg, hcoef, hrecip, hcard⟩

theorem finite_masked_index {K : Type*} [Field K] [Finite K] (N : ℕ) :
    Finite {P : Polynomial K // P.Monic ∧ Irreducible P ∧ P.natDegree ≤ N} := by
  let _ : Finite (Polynomial.degreeLT K (N + 1)) := Module.finite_of_finite K
  let f (P : {P : Polynomial K // P.Monic ∧ Irreducible P ∧ P.natDegree ≤ N}) :
      Polynomial.degreeLT K (N + 1) :=
    ⟨P.1, by
      rw [Polynomial.mem_degreeLT, Polynomial.degree_eq_natDegree P.2.2.1.ne_zero]
      exact_mod_cast Nat.lt_succ_of_le P.2.2.2⟩
  apply Finite.of_injective f
  intro P Q h
  have h' := congrArg Subtype.val h
  exact Subtype.ext h'

theorem coeff_reciprocal_series {R : Type*} [CommRing R]
    (z : R) {e n : ℕ} (he : e ≠ 0) :
    PowerSeries.coeff n
      (PowerSeries.subst (PowerSeries.X ^ e)
        (PowerSeries.rescale z (PowerSeries.mk 1))) =
      if e ∣ n then z ^ (n / e) else 0 := by
  simp [PowerSeries.coeff_subst_X_pow he]

theorem coeff_finiteEuler_maskedReciprocalMonicWeight
    {K : Type*} [Field K] [Finite K]
    (ψ : AddChar K ℂ) (M : Finset K) (a : K → K) (b c : K)
    (N j : ℕ) (hj : j ≤ N) :
    let I := {P : Polynomial K //
      P.Monic ∧ Irreducible P ∧ P.natDegree ≤ N}
    PowerSeries.coeff j
      (∏ᶠ P : I,
        PowerSeries.subst
          ((PowerSeries.X : PowerSeries ℂ) ^ P.1.natDegree)
          (PowerSeries.rescale
            (maskedReciprocalMonicWeight ψ M a b c P.1)
            (PowerSeries.mk 1))) =
      ∑ᶠ g : {g : Polynomial K // g.Monic ∧ g.natDegree = j},
        maskedReciprocalMonicWeight ψ M a b c g.1 := by
  classical
  let _ : Fintype K := Fintype.ofFinite K
  let I := {P : Polynomial K // P.Monic ∧ Irreducible P ∧ P.natDegree ≤ N}
  let _ : Finite I := finite_masked_index N
  let _ : Fintype I := Fintype.ofFinite I
  let J := {g : Polynomial K // g.Monic ∧ g.natDegree = j}
  let _ : Fintype J := Fintype.ofEquiv (Fin j → K)
    (((Polynomial.monicEquivDegreeLT j).trans (Polynomial.degreeLTEquiv K j).toEquiv).symm)
  let e : I → ℕ := fun P => P.1.natDegree
  let w : I → ℂ := fun P => maskedReciprocalMonicWeight ψ M a b c P.1
  have he : ∀ P, e P ≠ 0 := fun P => P.2.2.1.natDegree_pos.ne'
  let weight : (I →₀ ℕ) →+ ℕ := Finsupp.weight e
  let _ : Fintype {m : I →₀ ℕ // weight m = j} := (Finsupp.finite_of_nat_weight_eq e he j).fintype
  let product (m : I →₀ ℕ) := (m.toMultiset.map Subtype.val).prod
  have hmonic (m : I →₀ ℕ) : (product m).Monic := by
    apply Polynomial.monic_multiset_prod_of_monic
    intro P hP
    exact P.2.1
  have hdeg (m : I →₀ ℕ) : (product m).natDegree = weight m := by
    rw [show product m = (m.toMultiset.map Subtype.val).prod from rfl,
      Polynomial.natDegree_multiset_prod_of_monic]
    · rw [Multiset.map_map, show (Polynomial.natDegree ∘ Subtype.val : I → ℕ) = e from rfl,
        Finsupp.toMultiset_map, Finsupp.sum_toMultiset, Finsupp.sum_mapDomain_index]
      · rfl
      · exact fun _ => zero_smul _ _
      · intro _ x y; exact add_nsmul _ _ _
    · intro g hg
      obtain ⟨P, hp, rfl⟩ := Multiset.mem_map.mp hg
      exact P.2.1
  have hfact (m : I →₀ ℕ) :
      UniqueFactorizationMonoid.normalizedFactors (product m) = m.toMultiset.map Subtype.val := by
    let s := m.toMultiset.map Subtype.val
    have hs : ∀ g ∈ s, Irreducible g := by
      intro g hg
      obtain ⟨P, hP, rfl⟩ := Multiset.mem_map.mp hg
      exact P.2.2.1
    change UniqueFactorizationMonoid.normalizedFactors s.prod = s
    rw [UniqueFactorizationMonoid.normalizedFactors_prod_eq s hs]
    rw [show s.map normalize = s.map id by
      apply Multiset.map_congr rfl
      intro g hg
      obtain ⟨P, hP, rfl⟩ := Multiset.mem_map.mp hg
      exact P.2.1.normalize_eq_self, Multiset.map_id]
  have hinj : Function.Injective product := by
    intro m r h
    have hmaps : m.toMultiset.map Subtype.val = r.toMultiset.map Subtype.val := by
      rw [← hfact m, ← hfact r, h]
    simpa only [Finsupp.toMultiset_toFinsupp] using congrArg Multiset.toFinsupp
      (Multiset.map_injective Subtype.val_injective hmaps)
  let factor (g : J) : I →₀ ℕ := Multiset.toFinsupp
    ((UniqueFactorizationMonoid.normalizedFactors g.1).attach.map fun P =>
      let facets := (Polynomial.mem_normalizedFactors_iff g.2.1.ne_zero).mp P.2
      (⟨P.1, facets.2.1, facets.1, (Polynomial.natDegree_le_of_dvd facets.2.2 g.2.1.ne_zero).trans
        (g.2.2.le.trans hj)⟩ : I))
  have hfmap (g : J) : (factor g).toMultiset.map Subtype.val =
      UniqueFactorizationMonoid.normalizedFactors g.1 := by
    dsimp only [factor]
    rw [Multiset.toFinsupp_toMultiset, Multiset.map_map]
    exact Multiset.attach_map_val _
  have hfprod (g : J) : product (factor g) = g.1 := by
    change (Multiset.map (fun P : I => P.1) (Finsupp.toMultiset (factor g))).prod = g.1
    rw [hfmap, UniqueFactorizationMonoid.prod_normalizedFactors_eq g.2.1.ne_zero,
      g.2.1.normalize_eq_self]
  let equiv : {m : I →₀ ℕ // weight m = j} ≃ J := Equiv.ofBijective
    (fun m => ⟨product m, hmonic m, (hdeg m).trans m.2⟩) ⟨by
      intro m n h
      apply Subtype.ext
      exact hinj (congrArg Subtype.val h), by
      intro g
      refine ⟨⟨factor g, ?_⟩, Subtype.ext (hfprod g)⟩
      rw [← hdeg, hfprod g, g.2.2]⟩
  have hwmult (s : Multiset (Polynomial K)) (h : ∀ P ∈ s, P.Monic) :
      maskedReciprocalMonicWeight ψ M a b c s.prod =
        (s.map (maskedReciprocalMonicWeight ψ M a b c)).prod := by
    induction s using Multiset.induction_on with
    | empty => simpa using maskedReciprocalMonicWeight_one ψ M a b c
    | @cons q s ih =>
      rw [Multiset.prod_cons, maskedReciprocalMonicWeight_mul_of_monic ψ M a b c q s.prod]
      · simp only [Multiset.map_cons, Multiset.prod_cons]
        rw [ih (by intro g hg; exact h g (by simp [hg]))]
      · exact h q (by simp)
      · rw [← Multiset.map_id s]
        apply Polynomial.monic_multiset_prod_of_monic
        intro g hg
        exact h g (by simp [hg])
  change PowerSeries.coeff j (∏ᶠ P : I, _) = ∑ᶠ g : J, _
  rw [finprod_eq_prod_of_fintype, finsum_eq_sum_of_fintype]
  change PowerSeries.coeff j (∏ P : I,
      PowerSeries.subst ((PowerSeries.X : PowerSeries ℂ) ^ e P)
        (PowerSeries.rescale (w P) (PowerSeries.mk 1))) =
    ∑ g : J, maskedReciprocalMonicWeight ψ M a b c g.1
  rw [PowerSeries.coeff_prod]
  have hterm (l : I →₀ ℕ) :
      (∏ P : I, PowerSeries.coeff (l P) (PowerSeries.subst
          ((PowerSeries.X : PowerSeries ℂ) ^ e P) (PowerSeries.rescale (w P) (PowerSeries.mk 1)))) =
      if ∀ P, e P ∣ l P then (∏ P : I, w P ^ (l P / e P)) else 0 := by
    calc
      _ = ∏ P : I, if e P ∣ l P then w P ^ (l P / e P) else 0 :=
        Finset.prod_congr rfl fun P _ => coeff_reciprocal_series _ (he P)
      _ = _ := Fintype.prod_ite_zero
  simp_rw [hterm]
  rw [← Finset.sum_filter]
  let good := (Finset.finsuppAntidiag Finset.univ j).filter (fun l : I →₀ ℕ => ∀ P, e P ∣ l P)
  let scale (m : I →₀ ℕ) : I →₀ ℕ := Finsupp.equivFunOnFinite.symm (fun P => e P * m P)
  let unscale (l : I →₀ ℕ) : I →₀ ℕ := Finsupp.equivFunOnFinite.symm (fun P => l P / e P)
  have huscale (m : I →₀ ℕ) : unscale (scale m) = m := by
    ext P
    simp only [unscale, scale, Finsupp.equivFunOnFinite_symm_apply_apply]
    rw [Nat.mul_div_cancel_left _ (Nat.pos_of_ne_zero (he P))]
  have hscaleu (l : I →₀ ℕ) (hl : ∀ P, e P ∣ l P) : scale (unscale l) = l := by
    ext P
    simp only [unscale, scale, Finsupp.equivFunOnFinite_symm_apply_apply]
    rw [mul_comm, Nat.div_mul_cancel (hl P)]
  have hsdeg (m : I →₀ ℕ) : (∑ P : I, (scale m) P) = weight m := by
    simp [weight, Finsupp.weight_eq_sum, scale, mul_comm]
  have hudeg (l : I →₀ ℕ) (hl : ∀ P, e P ∣ l P) : weight (unscale l) = ∑ P : I, l P := by
    rw [show weight = Finsupp.weight e from rfl, Finsupp.weight_eq_sum]
    apply Finset.sum_congr rfl
    intro P _
    simp only [unscale, Finsupp.equivFunOnFinite_symm_apply_apply, nsmul_eq_mul]
    exact Nat.div_mul_cancel (hl P)
  change (∑ l ∈ good, ∏ P, w P ^ (l P / e P)) = _
  have hrestrict : (∑ l ∈ good, ∏ P, w P ^ (l P / e P)) =
      ∑ m : {m : I →₀ ℕ // weight m = j}, ∏ P, w P ^ (m.1 P) := by
    symm
    apply Finset.sum_bij (fun m _ => scale m.1)
    · intro m _
      simp only [good, Finset.mem_filter, Finset.mem_finsuppAntidiag]
      refine ⟨⟨?_, Finset.subset_univ _⟩, ?_⟩
      · rw [hsdeg]; exact m.2
      · intro P
        exact dvd_mul_right _ _
    · intro m _ r _ eq
      apply Subtype.ext
      simpa only [huscale] using congrArg unscale eq
    · intro l hl
      simp only [good, Finset.mem_filter, Finset.mem_finsuppAntidiag] at hl
      let m : I →₀ ℕ := unscale l
      refine ⟨⟨m, ?_⟩, Finset.mem_univ _, hscaleu l hl.2⟩
      rw [hudeg l hl.2]
      exact hl.1.1
    · intro m _
      simp [scale, Finsupp.equivFunOnFinite_symm_apply_apply, Nat.mul_div_cancel_left _
        (Nat.pos_of_ne_zero <| he _)]
  rw [hrestrict]
  rw [← (equiv.sum_comp _)]
  apply Finset.sum_congr rfl
  intro m _
  rw [show (equiv m).1 = product m.1 from rfl]
  have hmmon : ∀ g ∈ (m.1.toMultiset.map Subtype.val), Polynomial.Monic g := by
    intro g hg
    obtain ⟨P, hP, rfl⟩ := Multiset.mem_map.mp hg
    exact P.2.1
  dsimp only [product]
  rw [hwmult _ hmmon, Multiset.map_map]
  change (∏ P : I, w P ^ (m.1 P)) = (m.1.toMultiset.map w).prod
  rw [Finsupp.toMultiset_map, Finsupp.prod_toMultiset, Finsupp.prod_mapDomain_index]
  · exact (Finsupp.prod_pow m.1 w).symm
  · exact fun _ => pow_zero _
  · intro _ l n
    rw [pow_add]

theorem reciprocal_mul_local {R : Type*} [CommRing R]
    (z : R) {e : ℕ} (he : e ≠ 0) :
    PowerSeries.subst (PowerSeries.X ^ e) (PowerSeries.rescale z (PowerSeries.mk 1)) *
      (1 - PowerSeries.C z * PowerSeries.X ^ e) = 1 := by
  have hbase := PowerSeries.mk_one_mul_one_sub_eq_one R
  have hscale := congrArg (PowerSeries.rescale z) hbase
  simp only [map_mul, map_sub, map_one, PowerSeries.rescale_X] at hscale
  let hs := PowerSeries.HasSubst.X_pow (R := R) he
  let f : PowerSeries R →ₐ[R] PowerSeries R := PowerSeries.substAlgHom hs
  have h := congrArg f hscale
  simp only [map_mul, map_sub, map_one, f, PowerSeries.substAlgHom_X] at h
  rw [PowerSeries.coe_substAlgHom hs, PowerSeries.subst_C] at h
  exact h

theorem X_mul_deriv_reciprocal {R : Type*} [CommRing R]
    (z : R) {e : ℕ} (he : e ≠ 0) :
    PowerSeries.X * PowerSeries.derivative R
        (PowerSeries.subst (PowerSeries.X ^ e) (PowerSeries.rescale z (PowerSeries.mk 1))) =
      PowerSeries.C (e : R) *
        PowerSeries.subst (PowerSeries.X ^ e) (PowerSeries.rescale z (PowerSeries.mk 1)) *
          (PowerSeries.subst (PowerSeries.X ^ e) (PowerSeries.rescale z (PowerSeries.mk 1)) -
            1) := by
  let L : PowerSeries R := PowerSeries.subst (PowerSeries.X ^ e)
    (PowerSeries.rescale z (PowerSeries.mk 1))
  let Q : PowerSeries R := 1 - PowerSeries.C z * PowerSeries.X ^ e
  have hInv : L * Q = 1 := reciprocal_mul_local z he
  have hDer : L * PowerSeries.derivative R Q + Q * PowerSeries.derivative R L = 0 := by
    have h := congrArg (PowerSeries.derivative R) hInv
    rw [Derivation.leibniz, PowerSeries.derivative_one] at h
    simpa only [smul_eq_mul, add_comm] using h
  have hQDer : PowerSeries.derivative R Q =
      -PowerSeries.C ((e : R) * z) * PowerSeries.X ^ (e - 1) := by
    simp [Q, Derivation.leibniz, smul_eq_mul]
    ring
  rw [hQDer] at hDer
  have hPow : (PowerSeries.X : PowerSeries R) * PowerSeries.X ^ (e - 1) = PowerSeries.X ^ e :=
    mul_pow_sub_one he _
  rw [map_mul] at hDer
  simp only [map_natCast] at hDer
  rw [map_natCast]
  linear_combination
    (PowerSeries.X * L) * hDer -
      (PowerSeries.X * PowerSeries.derivative R L + (e : PowerSeries R) * L) * hInv +
      ((e : PowerSeries R) * PowerSeries.C z * L ^ 2) * hPow

theorem X_mul_deriv_product {I : Type*} [Fintype I] {R : Type*} [CommRing R]
    (e : I → ℕ) (he : ∀ i, e i ≠ 0) (z : I → R) :
    PowerSeries.X * PowerSeries.derivative R (∏ i : I,
      PowerSeries.subst (PowerSeries.X ^ (e i)) (PowerSeries.rescale (z i) (PowerSeries.mk 1))) =
      (∏ i : I, PowerSeries.subst (PowerSeries.X ^ (e i))
        (PowerSeries.rescale (z i) (PowerSeries.mk 1))) *
      ∑ i : I, PowerSeries.C (e i : R) *
        (PowerSeries.subst (PowerSeries.X ^ (e i)) (PowerSeries.rescale (z i) (PowerSeries.mk 1)) -
        1) := by
  classical
  let L (i : I) : PowerSeries R := PowerSeries.subst (PowerSeries.X ^ (e i))
    (PowerSeries.rescale (z i) (PowerSeries.mk 1))
  let s : Finset I := Finset.univ
  change PowerSeries.X * PowerSeries.derivative R (∏ i ∈ s, L i) =
    (∏ i ∈ s, L i) * (∑ i ∈ s, PowerSeries.C (e i : R) * (L i - 1))
  induction s using Finset.induction_on with
  | empty => simp
  | @insert a s ha ih =>
    rw [Finset.prod_insert ha, Finset.sum_insert ha, Derivation.leibniz]
    simp only [smul_eq_mul]
    have hlocal := X_mul_deriv_reciprocal (z a) (he a)
    linear_combination (L a) * ih + (∏ i ∈ s, L i) * hlocal

theorem coeff_logderiv_of_coeff_eq {R : Type*} [CommSemiring R]
    [IsLeftCancelAdd R] {L A B C : PowerSeries R} {N : ℕ}
    (hLB : PowerSeries.X * PowerSeries.derivative R L = L * B)
    (hAC : PowerSeries.X * PowerSeries.derivative R A = A * C)
    (hB0 : PowerSeries.constantCoeff B = 0) (hC0 : PowerSeries.constantCoeff C = 0)
    (hL0 : PowerSeries.coeff 0 L = 1)
    (hcoeff : ∀ j, j ≤ N → PowerSeries.coeff j L = PowerSeries.coeff j A)
    {n : ℕ} (hnN : n ≤ N) : PowerSeries.coeff n B = PowerSeries.coeff n C := by
  have hrec (D E : PowerSeries R) (hDE : PowerSeries.X * PowerSeries.derivative R D = D * E)
      (hE0 : PowerSeries.constantCoeff E = 0) (k : ℕ) : (k : R) * PowerSeries.coeff k D =
      ∑ i ∈ Finset.range k, PowerSeries.coeff (k - (i + 1)) D * PowerSeries.coeff (i + 1) E := by
    cases k with
    | zero => simp
    | succ k =>
      have h := congrArg (PowerSeries.coeff (k+1)) hDE
      rw [PowerSeries.coeff_succ_X_mul, PowerSeries.coeff_derivative, PowerSeries.coeff_mul,
        ← Finset.Nat.sum_antidiagonal_swap] at h
      simp only [Prod.fst_swap, Prod.snd_swap] at h
      rw [Finset.Nat.sum_antidiagonal_eq_sum_range_succ_mk] at h
      rw [← mul_comm, Nat.cast_add, Nat.cast_one, h, Finset.sum_range_succ']
      simp only [PowerSeries.coeff_zero_eq_constantCoeff_apply, hE0, mul_zero, add_zero]
  have hA0 : PowerSeries.coeff 0 A = 1 := (hcoeff 0 (Nat.zero_le N)).symm.trans hL0
  induction n using Nat.strong_induction_on with
  | h n ih =>
    cases n with
    | zero => simp only [PowerSeries.coeff_zero_eq_constantCoeff_apply, hB0, hC0]
    | succ k =>
      have hrecL := hrec L B hLB hB0 (k + 1)
      have hrecA := hrec A C hAC hC0 (k + 1)
      have hsums : (∑ i ∈ Finset.range (k + 1), PowerSeries.coeff (k + 1 - (i + 1)) L *
        PowerSeries.coeff (i + 1) B) = ∑ i ∈ Finset.range (k + 1),
        PowerSeries.coeff (k + 1 - (i + 1)) A * PowerSeries.coeff (i + 1) C := by
        rw [← hrecL, ← hrecA, hcoeff (k + 1) hnN]
      rw [Finset.sum_range_succ, Finset.sum_range_succ] at hsums
      have hprevious : (∑ i ∈ Finset.range k, PowerSeries.coeff (k + 1 - (i + 1)) L *
        PowerSeries.coeff (i + 1) B) = ∑ i ∈ Finset.range k, PowerSeries.coeff (k + 1 - (i + 1)) A *
        PowerSeries.coeff (i + 1) C := by
        apply Finset.sum_congr rfl
        intro i hi
        rw [hcoeff _ ((Nat.sub_le _ _).trans hnN)]
        rw [ih (i + 1) (by simp only [Finset.mem_range] at hi; omega)
          (by simp only [Finset.mem_range] at hi; omega)]
      rw [hprevious] at hsums
      simp only [Nat.sub_self, hL0, hA0, one_mul] at hsums
      exact add_left_cancel hsums

theorem sum_extension_monic_irred
    {K : Type*} [Field K] [Finite K] (p n : ℕ)
    [Fact p.Prime] [CharP K p] [NeZero n]
    [Fintype (FiniteField.Extension K p n)]
    [Fintype {P : Polynomial K // P.Monic ∧ Irreducible P ∧ P.natDegree ≤ n}]
    {V : Type*} [AddCommMonoid V] (f : Polynomial K → V) :
    (∑ x : FiniteField.Extension K p n, f (minpoly K x)) =
      ∑ P : { P : Polynomial K // P.Monic ∧ Irreducible P ∧ P.natDegree ≤ n },
        if P.1.natDegree ∣ n then P.1.natDegree • f P.1 else 0 := by
  classical
  let E := FiniteField.Extension K p n
  let I := { P : Polynomial K // P.Monic ∧ Irreducible P ∧ P.natDegree ≤ n }
  let J := { P : I // P.1.natDegree ∣ n }
  let _ : Finite (ConjRootClass K E) :=
    .of_surjective (ConjRootClass.mk K : E → _) Quotient.mk_surjective
  let _ := Fintype.ofFinite (ConjRootClass K E)
  let ccp (d : ConjRootClass K E) : J :=
    ⟨⟨d.minpoly, d.monic_minpoly, d.irreducible_minpoly,
      Nat.le_of_dvd (NeZero.pos n) (by
        simpa only [E, FiniteField.finrank_extension] using
          d.irreducible_minpoly.natDegree_dvd_finrank d.splits_minpoly)⟩, by
      simpa only [E, FiniteField.finrank_extension] using
        d.irreducible_minpoly.natDegree_dvd_finrank d.splits_minpoly⟩
  have hinj : Function.Injective ccp := by
    intro d c h
    exact ConjRootClass.minpoly_injective (congrArg (fun P : J => P.1.1) h)
  have hsurj : Function.Surjective ccp := by
    intro P
    let _ : Fact (Irreducible P.1.1) := ⟨P.1.2.2.1⟩
    have hfne := P.1.2.2.1.ne_zero
    have hdiv : Module.finrank K (AdjoinRoot P.1.1) ∣ Module.finrank K E := by
      rw [(AdjoinRoot.powerBasis hfne).finrank, AdjoinRoot.powerBasis_dim,
        FiniteField.finrank_extension]
      exact P.2
    let g : AdjoinRoot P.1.1 →ₐ[K] E := (FiniteField.nonempty_algHom_of_finrank_dvd hdiv).some
    have hmin : minpoly K (AdjoinRoot.root P.1.1) = P.1.1 := by
      simpa [P.1.2.1.leadingCoeff] using AdjoinRoot.minpoly_root hfne
    refine ⟨ConjRootClass.mk K (g (AdjoinRoot.root P.1.1)), ?_⟩
    apply Subtype.ext
    apply Subtype.ext
    change minpoly K (g (AdjoinRoot.root P.1.1)) = P.1.1
    simpa [hmin] using minpoly.algHom_eq g g.injective (AdjoinRoot.root P.1.1)
  let equiv := Equiv.ofBijective ccp ⟨hinj, hsurj⟩
  change (∑ x : E, f (minpoly K x)) = _
  rw [← Fintype.sum_fiberwise (ConjRootClass.mk K) (fun x : E => f (minpoly K x))]
  have hc (d : ConjRootClass K E) :
      (∑ x : {x : E // ConjRootClass.mk K x = d}, f (minpoly K x.1)) =
        d.minpoly.natDegree • f d.minpoly := by
    let _ : Fintype d.carrier := Fintype.ofFinite _
    have hdcard : Fintype.card {x : E // ConjRootClass.mk K x = d} = d.minpoly.natDegree := calc
      _ = Fintype.card d.carrier := by
        apply Fintype.card_congr
        exact Equiv.refl _
      _ = Fintype.card (d.minpoly.rootSet E) := Fintype.card_congr
          (Equiv.Set.congr d.rootSet_minpoly_eq_carrier).symm
      _ = d.minpoly.natDegree := Polynomial.card_rootSet_eq_natDegree d.separable_minpoly
        d.splits_minpoly
    calc
      _ = ∑ _x : {x : E // ConjRootClass.mk K x = d}, f d.minpoly := by
        apply Fintype.sum_congr
        intro x
        rw [← ConjRootClass.minpoly_mk (K := K) x.1, x.2]
      _ = Fintype.card {x : E // ConjRootClass.mk K x = d} • f d.minpoly := by simp
      _ = d.minpoly.natDegree • f d.minpoly := by rw [hdcard]
  simp_rw [hc]
  calc
    (∑ d : ConjRootClass K E, d.minpoly.natDegree • f d.minpoly) = ∑ P : J, P.1.1.natDegree •
        f P.1.1 :=
      equiv.sum_comp (fun P => P.1.1.natDegree • f P.1.1)
    _ = ∑ P ∈ (Finset.univ : Finset I).filter (fun P => P.1.natDegree ∣ n),
        P.1.natDegree • f P.1 := by
      symm
      apply Finset.sum_subtype
      intro P
      simp
    _ = _ := Finset.sum_filter _ _

theorem root_log_derivative (s : Multiset ℂ) :
    let A := (s.map fun z : ℂ => (1 - PowerSeries.C z * PowerSeries.X)).prod
    let B := (s.map fun z : ℂ => PowerSeries.C (-z) * PowerSeries.X *
      PowerSeries.subst (PowerSeries.X ^ 1) (PowerSeries.rescale z (PowerSeries.mk 1))).sum
    PowerSeries.X * PowerSeries.derivative ℂ A = A * B ∧ PowerSeries.constantCoeff B = 0 ∧
      ∀ n : ℕ, n ≠ 0 → PowerSeries.coeff n B = -(s.map fun z : ℂ => z ^ n).sum := by
  let localE (z : ℂ) : PowerSeries ℂ := PowerSeries.subst (PowerSeries.X ^ 1)
    (PowerSeries.rescale z (PowerSeries.mk 1))
  let lt (z : ℂ) : PowerSeries ℂ := 1 - PowerSeries.C z * PowerSeries.X
  let term (z : ℂ) := PowerSeries.C (-z) * PowerSeries.X * localE z
  have hl (z : ℂ) : PowerSeries.X * PowerSeries.derivative ℂ (lt z) = lt z * term z := by
    have hi : localE z * lt z = 1 := by
      simpa only [localE, lt, pow_one] using reciprocal_mul_local z (e := 1) one_ne_zero
    have hd : PowerSeries.derivative ℂ (lt z) = PowerSeries.C (-z) := by
      simp [lt, Derivation.leibniz, smul_eq_mul]
    rw [hd]
    dsimp only [term]
    linear_combination -(PowerSeries.C (-z) * PowerSeries.X) * hi
  have hcoeff (z : ℂ) (k : ℕ) (hk : k ≠ 0) : PowerSeries.coeff k (term z) = -(z ^ k) := by
    obtain ⟨l, rfl⟩ := Nat.exists_eq_succ_of_ne_zero hk
    simp [term, localE, mul_assoc, PowerSeries.coeff_succ_X_mul, pow_succ']
  change
    PowerSeries.X * PowerSeries.derivative ℂ (s.map lt).prod = (s.map lt).prod * (s.map term).sum ∧
      PowerSeries.constantCoeff (s.map term).sum = 0 ∧
        ∀ n, n ≠ 0 → PowerSeries.coeff n (s.map term).sum = -(s.map fun z : ℂ => z ^ n).sum
  refine ⟨?_, ?_, ?_⟩
  · induction s using Multiset.induction_on with
    | empty => simp
    | cons a s ih =>
      rw [Multiset.map_cons, Multiset.prod_cons, Multiset.map_cons, Multiset.sum_cons,
        Derivation.leibniz]
      simp only [smul_eq_mul]
      have hh := hl a
      linear_combination lt a * ih + (s.map lt).prod * hh
  · simp [map_multiset_sum, Multiset.map_map, term]
  · intro n hn
    simp [map_multiset_sum, Multiset.map_map, hcoeff, hn]

theorem isolated_bases_le_one {N : ℕ} (z w : Fin N → ℂ)
    (hz : Function.Injective z) (hw : ∀ i, w i ≠ 0) (C : ℝ) (n0 : ℕ)
    (hb : ∀ n, n0 ≤ n → ‖∑ i, w i * z i ^ n‖ ≤ C) : ∀ i, ‖z i‖ ≤ 1 := by
  let V : Matrix (Fin N) (Fin N) ℂ := Matrix.vandermonde z
  have hdet : V.det ≠ 0 := Matrix.det_vandermonde_ne_zero_iff.mpr hz
  intro i
  let D : ℝ := ∑ j : Fin N, C * ‖V.adjugate j i‖
  have hwin (n : ℕ) : (fun j : Fin N => ∑ k, w k * z k ^ (n + (j : ℕ))) =
      Matrix.vecMul (fun k => w k * z k ^ n) V := by
    funext j
    simp only [Matrix.vecMul_apply_eq_sum, V, Matrix.vandermonde_apply, pow_add, mul_assoc]
  have hisolate (n : ℕ) : Matrix.vecMul (fun j : Fin N => ∑ k, w k * z k ^ (n + (j : ℕ)))
      V.adjugate i = V.det * (w i * z i ^ n) := by
    rw [hwin, Matrix.vecMul_vecMul, Matrix.mul_adjugate]
    rw [Matrix.vecMul_smul, Matrix.vecMul_one]
    rfl
  have hu (n : ℕ) (hn : n0 ≤ n) : ‖V.det * (w i * z i ^ n)‖ ≤ D := by
    rw [← hisolate n]
    change ‖∑ j : Fin N, (∑ k, w k * z k ^ (n + (j : ℕ))) * V.adjugate j i‖ ≤ D
    refine norm_sum_le_of_le _ fun j _ => ?_
    rw [norm_mul]
    exact mul_le_mul_of_nonneg_right (hb (n + (j : ℕ)) (by omega)) (norm_nonneg _)
  by_contra hi
  have hi1 : 1 < ‖z i‖ := lt_of_not_ge hi
  have hscale : 0 < ‖V.det‖ * ‖w i‖ := mul_pos (norm_pos_iff.mpr hdet) (norm_pos_iff.mpr (hw i))
  obtain ⟨m, hm⟩ := pow_unbounded_of_one_lt (D / (‖V.det‖ * ‖w i‖)) hi1
  have hmle : ‖z i‖ ^ m ≤ ‖z i‖ ^ (m + n0) := pow_le_pow_right₀ hi1.le (by omega)
  have hgrowth := (div_lt_iff₀' hscale).mp (hm.trans_le hmle)
  have ht := hu (m + n0) (by omega)
  rw [norm_mul, norm_mul, norm_pow] at ht
  nlinarith

theorem bounded_even_roots (s : Multiset ℂ) {q C : ℝ} (hq : 0 < q) (n0 : ℕ)
    (hbound : ∀ m, n0 ≤ m → ‖(s.map fun z => z ^ (2 * m)).sum‖ ≤ C * q ^ m) :
    ∀ z ∈ s, ‖z‖ ≤ Real.sqrt q := by
  classical
  let u : Multiset ℂ := s.map fun z => z ^ 2 / (q : ℂ)
  have hu : ∀ m, n0 ≤ m → ‖(u.map fun z => z ^ m).sum‖ ≤ C := by
    intro m hm
    have heval : (u.map fun z => z ^ m).sum = (s.map fun z => z ^ (2 * m)).sum / (q : ℂ) ^ m := by
      simp only [u, Multiset.map_map, Function.comp_def, div_pow, ← pow_mul,
        Multiset.sum_map_div]
    rw [heval, norm_div, norm_pow, Complex.norm_real, Real.norm_of_nonneg hq.le]
    rw [div_le_iff₀ (pow_pos hq m)]
    simpa [mul_comm] using hbound m hm
  let t := u.toFinset
  let w : t → ℂ := fun z => (u.count (z : ℂ) : ℂ)
  have hw : ∀ z : t, w z ≠ 0 := by
    intro z
    exact Nat.cast_ne_zero.mpr
      (Multiset.count_pos.mpr (Multiset.mem_toFinset.mp z.property)).ne'
  have ht : ∀ m, n0 ≤ m → ‖∑ z : t, w z * (z : ℂ) ^ m‖ ≤ C := by
    intro m hm
    have hh : (∑ z : t, w z * (z : ℂ) ^ m) = (u.map fun z => z ^ m).sum := by
      calc
        _ = ∑ z ∈ u.toFinset, (u.count z : ℂ) * z ^ m := Finset.sum_coe_sort _ _
        _ = _ := by
          simpa only [nsmul_eq_mul] using
            (Finset.sum_multiset_map_count u (fun z : ℂ => z ^ m)).symm
    rw [hh]
    exact hu m hm
  let equiv : t ≃ Fin (Fintype.card t) := Fintype.equivFin t
  let z' : Fin (Fintype.card t) → ℂ := fun j => ((equiv.symm j : t) : ℂ)
  let w' := w ∘ equiv.symm
  have hb' : ∀ m, n0 ≤ m → ‖∑ j, w' j * z' j ^ m‖ ≤ C := by
    intro m hm
    rw [← equiv.sum_comp (fun j => w' j * z' j ^ m)]
    simpa [w', z'] using ht m hm
  have hnorm := isolated_bases_le_one z' w' (Subtype.val_injective.comp equiv.symm.injective)
    (fun j => hw (equiv.symm j)) C n0 hb'
  intro z hz
  have hzMem : z ^ 2 / (q : ℂ) ∈ u := Multiset.mem_map.mpr ⟨z, hz, rfl⟩
  let i : t := ⟨z ^ 2 / (q : ℂ), Multiset.mem_toFinset.mpr hzMem⟩
  have hiNorm := hnorm (equiv i)
  simp only [z', Equiv.symm_apply_apply] at hiNorm
  change ‖z ^ 2 / (q : ℂ)‖ ≤ 1 at hiNorm
  rw [norm_div, norm_pow, Complex.norm_real, Real.norm_of_nonneg hq.le] at hiNorm
  exact Real.le_sqrt_of_sq_le ((div_le_one₀ hq).mp hiNorm)

open Classical in
theorem sum_active_poles {K E : Type*} [Field K] [Field E] (φ : K →+* E)
    (M : Finset K) (a : K → K) (x : E) :
    (∑ z ∈ M, φ (a z) / (x - φ z)) =
      ∑ z ∈ M.filter (fun z => a z ≠ 0), φ (a z) / (x - φ z) := by
  symm
  exact Finset.sum_filter_of_ne fun z _ hz ha => hz (by simp [ha])

/--
The standard additive character of `∑ z ∈ M, a z / (x - z)`, set to zero at every masked pole `x
∈ M`.
-/
noncomputable def maskedReciprocalLocal
    (p : ℕ) [Fact p.Prime]
    (M : Finset (ZMod p)) (a : ZMod p → ZMod p)
    (x : ZMod p) : ℂ := by
  classical
  exact if x ∈ M then 0 else
    ZMod.stdAddChar (∑ z ∈ M, a z / (x - z))

theorem norm_maskedReciprocalLocal
    (p : ℕ) [Fact p.Prime]
    (M : Finset (ZMod p)) (a : ZMod p → ZMod p)
    (x : ZMod p) :
    ‖maskedReciprocalLocal p M a x‖ =
      if x ∈ M then 0 else 1 := by
  simp [maskedReciprocalLocal, apply_ite, ZMod.stdAddChar_apply]

theorem maskedReciprocalLocal_of_two_terms
    (p : ℕ) [Fact p.Prime]
    (I : Finset (Fin 2)) (A ℓ : Fin 2 → ZMod p) :
    let M := I.image (fun i => -ℓ i)
    let a : ZMod p → ZMod p := fun z =>
      ∑ i ∈ I, if -ℓ i = z then A i else 0
    M.card ≤ 2 ∧
    ∀ x : ZMod p,
      (∏ i ∈ I,
        if x + ℓ i = 0 then (0 : ℂ) else
          ZMod.stdAddChar (A i / (x + ℓ i))) =
        maskedReciprocalLocal p M a x := by
  let M := I.image (fun i => -ℓ i)
  let a : ZMod p → ZMod p := fun z => ∑ i ∈ I, if -ℓ i = z then A i else 0
  refine ⟨(Finset.card_image_le.trans ?_), ?_⟩
  · simpa using Finset.card_le_univ I
  intro x
  by_cases hx : x ∈ M
  · obtain ⟨i, hi, hx'⟩ := Finset.mem_image.mp hx
    have hv : x + ℓ i = 0 := by rw [← hx', neg_add_cancel]
    rw [maskedReciprocalLocal, ite_eq_left hx]
    exact Finset.prod_eq_zero hi (by simp [hv])
  · have hb (i : Fin 2) (hi : i ∈ I) : x + ℓ i ≠ 0 := by
      intro hbad
      exact hx (Finset.mem_image.mpr ⟨i, hi, (eq_neg_of_add_eq_zero_left hbad).symm⟩)
    have heach : (∏ i ∈ I,
        if x + ℓ i = 0 then (0 : ℂ) else ZMod.stdAddChar (A i / (x + ℓ i))) =
        ∏ i ∈ I, ZMod.stdAddChar (A i / (x + ℓ i)) :=
      Finset.prod_congr rfl fun i hi => ite_eq_right (hb i hi)
    have hsum : (∑ z ∈ M, a z / (x - z)) = ∑ i ∈ I, A i / (x + ℓ i) := by
      simp only [a, Finset.sum_div, ite_div, zero_div]
      rw [Finset.sum_comm]
      apply Finset.sum_congr rfl
      intro i hi
      rw [Finset.sum_ite_eq, ite_eq_left (Finset.mem_image_of_mem _ hi)]
      simp
    have hp : ZMod.stdAddChar (∑ i ∈ I, A i / (x + ℓ i)) =
          ∏ i ∈ I, ZMod.stdAddChar (A i / (x + ℓ i)) :=
      map_sum (ZMod.stdAddChar (N := p)).toAddMonoidHom
        (fun i : Fin 2 => A i / (x + ℓ i)) I
    rw [heach, maskedReciprocalLocal, ite_eq_right hx, hsum, hp]

theorem maskedReciprocalLocal_inactive
    (p : ℕ) [Fact p.Prime]
    (M : Finset (ZMod p)) (a : ZMod p → ZMod p)
    (hinactive : ∀ z ∈ M, a z = 0) :
    (∀ x : ZMod p,
      maskedReciprocalLocal p M a x =
        1 - ∑ z ∈ M, if x = z then (1 : ℂ) else 0) ∧
    (∀ ξ : ZMod p,
      ZMod.dft (maskedReciprocalLocal p M a) ξ =
        (if ξ = 0 then (p : ℂ) else 0) -
          ∑ z ∈ M, ZMod.stdAddChar (-(z * ξ))) ∧
    ((∑ x : ZMod p, maskedReciprocalLocal p M a x) =
      (p : ℂ) - (M.card : ℂ)) ∧
    (∀ ξ : ZMod p, ξ ≠ 0 →
      ‖ZMod.dft (maskedReciprocalLocal p M a) ξ‖ ≤
        (M.card : ℝ)) := by
  have hpind (x : ZMod p) : maskedReciprocalLocal p M a x =
      1 - ∑ z ∈ M, if x = z then (1 : ℂ) else 0 := by
    have hsum : (∑ z ∈ M, a z / (x - z)) = 0 :=
      Finset.sum_eq_zero fun z hz => by rw [hinactive z hz, zero_div]
    simp [maskedReciprocalLocal, hsum, sub_ite]
  have hdft (ξ : ZMod p) : ZMod.dft (maskedReciprocalLocal p M a) ξ =
      (if ξ = 0 then (p : ℂ) else 0) - ∑ z ∈ M, ZMod.stdAddChar (-(z * ξ)) := by
    rw [ZMod.dft_apply]
    simp only [hpind, smul_eq_mul, mul_sub, mul_one, Finset.sum_sub_distrib]
    have horth : (∑ x : ZMod p, ZMod.stdAddChar (-(x * ξ))) =
        if ξ = 0 then (p : ℂ) else 0 := by
      simpa only [mul_neg, neg_eq_zero, ZMod.card, Nat.cast_ite, Nat.cast_zero] using
        AddChar.sum_mulShift (-ξ) (ZMod.isPrimitive_stdAddChar p)
    have hswap : (∑ x : ZMod p, ZMod.stdAddChar (-(x * ξ)) *
          (∑ z ∈ M, if x = z then (1 : ℂ) else 0)) =
        ∑ z ∈ M, ZMod.stdAddChar (-(z * ξ)) := by
      simp_rw [Finset.mul_sum, mul_ite, mul_one, mul_zero]
      rw [Finset.sum_comm]
      simp
    rw [horth, hswap]
  refine ⟨hpind, hdft, ?_, ?_⟩
  · simpa [ZMod.dft_apply_zero] using hdft (0 : ZMod p)
  · intro ξ hξ
    rw [hdft ξ, ite_eq_right hξ, zero_sub, norm_neg]
    refine (norm_sum_le _ _).trans_eq ?_
    simp [ZMod.stdAddChar_apply]

theorem maskedReciprocalLocal_singleton_mean
    (p : ℕ) [Fact p.Prime]
    (z : ZMod p) (a : ZMod p → ZMod p)
    (ha : a z ≠ 0) :
    (∑ x : ZMod p, maskedReciprocalLocal p {z} a x) = -1 := by
  let e : ZMod p ≃ ZMod p := ((Equiv.subRight z).trans (Equiv.inv (ZMod p))).trans
    (Equiv.mulLeft₀ (a z) ha)
  have he (x : ZMod p) : e x = a z / (x - z) := rfl
  have heq (x : ZMod p) : maskedReciprocalLocal p {z} a x =
        if e x = 0 then (0 : ℂ) else ZMod.stdAddChar (e x) := by
    simp [maskedReciprocalLocal, he, ha, sub_eq_zero]
  simp_rw [heq]
  rw [e.sum_comp (fun t : ZMod p => if t = 0 then 0 else ZMod.stdAddChar t)]
  have horth : (∑ t : ZMod p, ZMod.stdAddChar t) = 0 := by
    simpa using AddChar.sum_mulShift (1 : ZMod p) (ZMod.isPrimitive_stdAddChar p)
  calc
    _ = ∑ t ∈ (Finset.univ : Finset (ZMod p)).erase 0, ZMod.stdAddChar t := by
      simp only [← Finset.filter_ne', Finset.sum_filter, ne_eq, ite_not]
    _ = -1 := by
      rw [Finset.sum_erase_eq_sub (Finset.mem_univ _), horth, AddChar.map_zero_eq_one,
        zero_sub]

theorem mem_translatedUnion
    {p : ℕ} [Fact p.Prime] (M : Finset (ZMod p)) (h x : ZMod p) :
    x ∈ M ∪ M.image (fun z => z - h) ↔ x ∈ M ∨ x + h ∈ M := by
  simp [Finset.mem_image, sub_eq_iff_eq_add]

theorem star_stdAddChar_zmod (p : ℕ) [Fact p.Prime] (s : ZMod p) :
    star (ZMod.stdAddChar s) = ZMod.stdAddChar (-s) := by
  rw [AddChar.map_neg_eq_inv,
    Complex.inv_eq_conj (by simp [ZMod.stdAddChar_apply]), starRingEnd_apply]

theorem maskedReciprocalLocal_translate
    (p : ℕ) [Fact p.Prime]
    (M : Finset (ZMod p)) (a : ZMod p → ZMod p)
    (h : ZMod p) :
    let U := M ∪ M.image (fun z => z - h)
    let d : ZMod p → ZMod p := fun z =>
      (if z + h ∈ M then a (z + h) else 0) -
        (if z ∈ M then a z else 0)
    U.card ≤ 2 * M.card ∧
    ∀ x : ZMod p,
      maskedReciprocalLocal p M a (x + h) *
          star (maskedReciprocalLocal p M a x) =
        maskedReciprocalLocal p U d x := by
  intro U d
  let R := M.image (fun z => z - h)
  refine ⟨(Finset.card_union_le M R).trans ?_, ?_⟩
  · have him : R.card ≤ M.card := Finset.card_image_le
    omega
  intro x
  have hmem : x ∈ U ↔ x ∈ M ∨ x + h ∈ M := mem_translatedUnion M h x
  by_cases hx : x ∈ U
  · rcases hmem.mp hx with hxM | hxM <;> simp [maskedReciprocalLocal, hx, hxM]
  · obtain ⟨hxM, hxH⟩ := not_or.mp (hmem.not.mp hx)
    simp only [maskedReciprocalLocal, ite_eq_right hx, ite_eq_right hxM,
      ite_eq_right hxH, star_stdAddChar_zmod]
    rw [← (ZMod.stdAddChar (N := p)).map_add_eq_mul]
    congr 1
    have himg : (∑ z ∈ R, a (z + h) / (x - z)) = ∑ z ∈ M, a z / (x + h - z) := by
      rw [Finset.sum_image]
      · simp only [sub_add_cancel, sub_sub_eq_add_sub]
      · exact sub_left_injective.injOn
    have h1 : (∑ z ∈ U, (if z + h ∈ M then a (z + h) else 0) / (x - z)) =
        ∑ z ∈ R, a (z + h) / (x - z) := by
      simp only [ite_div, zero_div]
      rw [← Finset.sum_filter]
      congr 1
      ext z
      by_cases hz : z + h ∈ M <;>
        simp [U, R, Finset.mem_image, sub_eq_iff_eq_add, hz]
    have h2 : (∑ z ∈ U, (if z ∈ M then a z else 0) / (x - z)) =
        ∑ z ∈ M, a z / (x - z) := by
      simp only [ite_div, zero_div]
      rw [← Finset.sum_filter, Finset.filter_mem_eq_inter,
        Finset.inter_eq_right.mpr Finset.subset_union_left]
    simp only [d, sub_div]
    rw [Finset.sum_sub_distrib, h1, h2, himg]
    simp only [sub_eq_add_neg]

theorem translatedReciprocalResidue_active
    (p : ℕ) [Fact p.Prime]
    (M : Finset (ZMod p)) (a : ZMod p → ZMod p)
    (h : ZMod p)
    (hactive : ∃ z ∈ M, a z ≠ 0)
    (hsize : (M.filter (fun z => a z ≠ 0)).card < p)
    (hh : h ≠ 0) :
    let U := M ∪ M.image (fun z => z - h)
    let d : ZMod p → ZMod p := fun z =>
      (if z + h ∈ M then a (z + h) else 0) -
        (if z ∈ M then a z else 0)
    ∃ z ∈ U, d z ≠ 0 := by
  intro U d
  by_contra hd
  simp only [not_exists, not_and, not_not] at hd
  let a0 (x : ZMod p) := if x ∈ M then a x else 0
  have hper (x : ZMod p) : a0 (x + h) = a0 x := by
    rw [← sub_eq_zero]
    change d x = 0
    by_cases hx : x ∈ U
    · exact hd x hx
    · have hx' := not_or.mp ((mem_translatedUnion M h x).not.mp hx)
      simp [d, hx'.1, hx'.2]
  obtain ⟨j, hj, haj⟩ := hactive
  have hall (x : ZMod p) : x ∈ M ∧ a x ≠ 0 := by
    let k : ℕ := ((x - j) / h).val
    have himp : j + k • h = x := by
      rw [nsmul_eq_mul, ZMod.natCast_zmod_val, div_mul_cancel₀ _ hh]
      simp
    have hz : a0 x ≠ 0 := by
      rw [← himp, Function.Periodic.nsmul hper]
      simpa [a0, hj] using haj
    simpa only [a0, ite_ne_right_iff] using hz
  have huniv : M.filter (fun z => a z ≠ 0) = (Finset.univ : Finset (ZMod p)) := by
    ext x
    simpa using hall x
  simp [huniv] at hsize

theorem weighted_sum_sub_mean_le_dft
    (q : ℕ) [NeZero q]
    (w F : ZMod q → ℂ) (A : ℝ) (hA : 0 ≤ A)
    (hF : ∀ ξ : ZMod q, ξ ≠ 0 → ‖ZMod.dft F ξ‖ ≤ A) :
    let D : ℂ := (∑ x : ZMod q, w x * F x) -
      (∑ x : ZMod q, w x) * (∑ x : ZMod q, F x) / (q : ℂ)
    D = (q : ℂ)⁻¹ *
      ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0,
        ZMod.dft w ξ * ZMod.dft F (-ξ) ∧
    ‖D‖ ≤ A / (q : ℝ) *
      ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0,
        ‖ZMod.dft w ξ‖ := by
  intro D
  have hinv (x : ZMod q) : w x = (q : ℂ)⁻¹ * ∑ ξ : ZMod q,
      ZMod.stdAddChar (ξ * x) * ZMod.dft w ξ := by
    simpa only [LinearEquiv.symm_apply_apply, smul_eq_mul] using
      ZMod.invDFT_apply (ZMod.dft w) x
  have hpair (ξ : ZMod q) : ZMod.dft F (-ξ) = ∑ x : ZMod q,
      ZMod.stdAddChar (ξ * x) * F x := by
    simp [ZMod.dft_apply, mul_comm, smul_eq_mul]
  have hwhole : (∑ x : ZMod q, w x * F x) = (q : ℂ)⁻¹ *
      ∑ ξ : ZMod q, ZMod.dft w ξ * ZMod.dft F (-ξ) := by
    conv_lhs => enter [2, x]; rw [hinv x]
    simp_rw [mul_assoc, Finset.sum_mul]
    rw [← Finset.mul_sum, Finset.sum_comm]
    simp_rw [hpair, Finset.mul_sum, mul_left_comm, mul_assoc]
  have hrep : D = (q : ℂ)⁻¹ *
      ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0, ZMod.dft w ξ * ZMod.dft F (-ξ) := by
    dsimp only [D]
    rw [hwhole, ← Finset.add_sum_erase _ _ (Finset.mem_univ (0 : ZMod q)),
      neg_zero, ZMod.dft_apply_zero, ZMod.dft_apply_zero]
    rw [div_eq_mul_inv]
    ring
  refine ⟨hrep, ?_⟩
  rw [hrep]
  calc
    _ = (q : ℝ)⁻¹ * ‖∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0,
        ZMod.dft w ξ * ZMod.dft F (-ξ)‖ := by
        rw [norm_mul, norm_inv, Complex.norm_natCast]
    _ ≤ (q : ℝ)⁻¹ * (∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0,
        ‖ZMod.dft w ξ‖ * A) := by
        gcongr
        apply norm_sum_le_of_le
        intro ξ hξ
        have hh : ξ ≠ 0 := (Finset.mem_erase.mp hξ).1
        rw [norm_mul, mul_comm]
        simpa only [mul_comm] using
          mul_le_mul (hF _ (neg_ne_zero.mpr hh)) (le_refl ‖ZMod.dft w ξ‖)
            (norm_nonneg _) hA
    _ = A / (q : ℝ) *
        ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0, ‖ZMod.dft w ξ‖ := by
        rw [← Finset.sum_mul]
        ring

/-- The reciprocal phase `ψ(c / x)` on units of `ZMod q`, extended by zero to nonunits. -/
noncomputable def reciprocalUnitPhase
    (q : ℕ) [NeZero q] (c x : ZMod q) : ℂ := by
  classical
  exact if IsUnit x then ZMod.stdAddChar (c * x⁻¹) else 0

/--
The product of masked reciprocal phases over the distinct prime divisors of `q`, reducing `x` to
each prime field before evaluation.
-/
noncomputable def maskedReciprocalProduct
    (q : ℕ)
    (M : (p : q.primeFactors) → Finset (ZMod p.1))
    (a : (p : q.primeFactors) → ZMod p.1 → ZMod p.1)
    (x : ZMod q) : ℂ := by
  classical
  exact ∏ p : q.primeFactors,
    @maskedReciprocalLocal p.1 ⟨Nat.prime_of_mem_primeFactors p.2⟩
      (M p) (a p) (x.val : ZMod p.1)

theorem zmod_castHom_apply_eq_natCast_val {p q : ℕ} [NeZero q] (hpq : p ∣ q) (x : ZMod q) :
    (ZMod.castHom hpq (ZMod p)) x = (x.val : ZMod p) :=
  ZMod.cast_eq_val x

theorem prod_primeFactors_subtype_eq_of_squarefree {q : ℕ} (hq : Squarefree q) :
    (∏ p : q.primeFactors, p.1) = q :=
  (Finset.prod_coe_sort _ id).trans (Nat.prod_primeFactors_of_squarefree hq)

theorem stdAddChar_mul_cofactor {q p : ℕ} [NeZero q] [NeZero p]
    (hpq : p ∣ q) (k : ℕ) :
    ZMod.stdAddChar (((q / p) * k : ℕ) : ZMod q) =
      ZMod.stdAddChar (k : ZMod p) := by
  simp only [ZMod.stdAddChar_apply, ZMod.toCircle_natCast]
  rw [Nat.cast_mul, Nat.cast_div_charZero hpq]
  congr 1
  field_simp [NeZero.ne (q : ℂ)]

theorem isUnit_cofactor_of_squarefree {q p : ℕ} (hq : Squarefree q) (hpq : p ∈ q.primeFactors) :
    IsUnit ((q / p : ℕ) : ZMod p) := by
  apply (ZMod.isUnit_iff_coprime _ _).2
  apply Nat.coprime_of_squarefree_mul
  rwa [Nat.div_mul_cancel (Nat.dvd_of_mem_primeFactors hpq)]

theorem prime_dvd_cofactor_of_ne {q p r : ℕ} (hpq : p ∈ q.primeFactors)
    (hrq : r ∈ q.primeFactors) (hne : p ≠ r) : r ∣ q / p := by
  apply Nat.dvd_div_of_mul_dvd
  exact ((Nat.coprime_primes (Nat.prime_of_mem_primeFactors hpq)
    (Nat.prime_of_mem_primeFactors hrq)).mpr hne).mul_dvd_of_dvd_of_dvd
      (Nat.dvd_of_mem_primeFactors hpq) (Nat.dvd_of_mem_primeFactors hrq)

theorem squarefree_proj_bijective
    (q : ℕ) [NeZero q] (hq : Squarefree q) :
    Function.Bijective (fun t : ZMod q => (fun i : q.primeFactors => (t.val : ZMod i.1))) := by
  have hprod : (∏ i : q.primeFactors, i.val) = q := prod_primeFactors_subtype_eq_of_squarefree hq
  let v (i : q.primeFactors) : ℕ := i.val
  have cop : Pairwise (fun i j : q.primeFactors => Nat.Coprime (v i) (v j)) := by
    intro i j hij
    exact (Nat.coprime_primes (Nat.prime_of_mem_primeFactors i.property)
      (Nat.prime_of_mem_primeFactors j.property)).mpr (Subtype.val_injective.ne hij)
  let e : ZMod q ≃+* ((i : q.primeFactors) → ZMod (v i)) :=
    ((ZMod.ringEquivCongr hprod).symm).trans (ZMod.prodEquivPi v cop)
  have : NeZero (∏ i : q.primeFactors, v i) :=
    ⟨by simpa only [v, hprod] using (NeZero.ne q)⟩
  convert e.bijective using 1
  ext x i
  rw [RingEquiv.trans_apply, ZMod.prodEquivPi_apply, zmod_castHom_apply_eq_natCast_val,
    ZMod.ringEquivCongr_symm, ZMod.ringEquivCongr_val]

theorem squarefree_character (q : ℕ) [NeZero q] (hq : Squarefree q) (x : ZMod q) :
    ZMod.stdAddChar x = ∏ p : q.primeFactors,
      letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
      ZMod.stdAddChar (((q / p.1 : ℕ) : ZMod p.1)⁻¹ * (x.val : ZMod p.1)) := by
  let v (i : q.primeFactors) : ℕ := i.val
  have (i : q.primeFactors) : Fact (v i).Prime := ⟨Nat.prime_of_mem_primeFactors i.property⟩
  have repr : x = ∑ i : q.primeFactors,
        ((q / v i : ℕ) : ZMod q) *
          ((((q / v i : ℕ) : ZMod (v i))⁻¹ * (x.val : ZMod (v i))).val : ZMod q) := by
    apply (squarefree_proj_bijective q hq).1
    ext j
    dsimp only
    conv_rhs => rw [← zmod_castHom_apply_eq_natCast_val (Nat.dvd_of_mem_primeFactors j.property)]
    rw [map_sum]
    simp_rw [map_mul, map_natCast]
    rw [Finset.sum_eq_single j]
    · rw [ZMod.natCast_zmod_val]
      rw [← mul_assoc, ZMod.mul_inv_of_unit _ (isUnit_cofactor_of_squarefree hq j.property),
        one_mul]
    · intro i _ hij
      rw [((ZMod.natCast_eq_zero_iff (q / v i) (v j)).mpr
        (prime_dvd_cofactor_of_ne i.property j.property (Subtype.val_injective.ne hij))),
          zero_mul]
    · simp
  let y (i : q.primeFactors) : ZMod (v i) :=
      ((q / v i : ℕ) : ZMod (v i))⁻¹ * (x.val : ZMod (v i))
  let term (i : q.primeFactors) : ZMod q := ((q / v i : ℕ) : ZMod q) * (y i).val
  calc
    ZMod.stdAddChar x = ZMod.stdAddChar (∑ i : q.primeFactors, term i) :=
      congrArg ZMod.stdAddChar repr
    _ = ∏ i : q.primeFactors, ZMod.stdAddChar (term i) := by
      simpa only [toMul_sum, AddChar.toAddMonoidHom_apply, toMul_ofMul] using
        congrArg Additive.toMul
          (map_sum (ZMod.stdAddChar (N := q)).toAddMonoidHom term Finset.univ)
    _ = _ := by
      apply Finset.prod_congr rfl
      intro i _
      simp only [term, ← Nat.cast_mul]
      rw [stdAddChar_mul_cofactor (Nat.dvd_of_mem_primeFactors i.property) ((y i).val),
        ZMod.natCast_zmod_val]

theorem squarefree_coordinate_sum (q : ℕ) [NeZero q] (hq : Squarefree q)
    [∀ p : q.primeFactors, NeZero p.1]
    (f : (p : q.primeFactors) → ZMod p.1 → ℂ) :
    (∑ x : ZMod q, ∏ i : q.primeFactors, f i (x.val : ZMod i.1)) =
      ∏ i : q.primeFactors, ∑ u : ZMod i.1, f i u := by
  rw [Fintype.prod_sum]
  exact (squarefree_proj_bijective q hq).sum_comp (fun z => ∏ i, f i (z i))

theorem squarefree_crt_character_dft_mean
    (q : ℕ) [NeZero q] (hq : Squarefree q)
    (F : (p : q.primeFactors) → ZMod p.1 → ℂ) :
    (∀ x : ZMod q,
      ZMod.stdAddChar x = ∏ p : q.primeFactors,
        letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
        ZMod.stdAddChar
          (((q / p.1 : ℕ) : ZMod p.1)⁻¹ * (x.val : ZMod p.1))) ∧
    (∀ ξ : ZMod q,
      ZMod.dft (fun x : ZMod q =>
        ∏ p : q.primeFactors, F p (x.val : ZMod p.1)) ξ =
          ∏ p : q.primeFactors,
            letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
            ZMod.dft (F p)
              (((q / p.1 : ℕ) : ZMod p.1)⁻¹ * (ξ.val : ZMod p.1))) ∧
    ((∑ x : ZMod q, ∏ p : q.primeFactors, F p (x.val : ZMod p.1)) /
      (q : ℂ) = ∏ p : q.primeFactors,
        letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
        (∑ u : ZMod p.1, F p u) / (p.1 : ℂ)) := by
  have (i : q.primeFactors) : Fact (i.val).Prime := ⟨Nat.prime_of_mem_primeFactors i.property⟩
  refine ⟨squarefree_character q hq, ?_, ?_⟩
  · intro ξ
    have hfactor (x : ZMod q) : ZMod.stdAddChar (-(x * ξ)) *
          (∏ i : q.primeFactors, F i (x.val : ZMod i.1)) = ∏ i : q.primeFactors,
          ZMod.stdAddChar (-((x.val : ZMod i.1) * (((q / i.1 : ℕ) : ZMod i.1)⁻¹ *
            (ξ.val : ZMod i.1)))) * F i (x.val : ZMod i.1) := by
      rw [squarefree_character q hq (-(x * ξ)), ← Finset.prod_mul_distrib]
      apply Finset.prod_congr rfl
      intro i _
      have hpdiv := Nat.dvd_of_mem_primeFactors i.property
      let pi := ZMod.castHom hpdiv (ZMod i.1)
      rw [← zmod_castHom_apply_eq_natCast_val hpdiv (-(x * ξ)), map_neg pi, map_mul pi,
        zmod_castHom_apply_eq_natCast_val hpdiv, zmod_castHom_apply_eq_natCast_val hpdiv]
      congr 2
      ring
    rw [ZMod.dft_apply]
    simp only [smul_eq_mul]
    simp_rw [hfactor]
    rw [squarefree_coordinate_sum q hq (fun i u =>
      ZMod.stdAddChar (-(u * (((q / i.1 : ℕ) : ZMod i.1)⁻¹ * (ξ.val : ZMod i.1)))) * F i u)]
    rfl
  · rw [squarefree_coordinate_sum q hq F, Finset.prod_div_distrib,
      ← Nat.cast_prod, prod_primeFactors_subtype_eq_of_squarefree hq]

theorem unit_iff_prime_samples (d : ℕ) [NeZero d] (y : ZMod d) :
    IsUnit y ↔ ∀ p : d.primeFactors, (y.val : ZMod p.1) ≠ 0 := by
  conv_lhs => rw [← y.natCast_zmod_val, ZMod.isUnit_iff_coprime]
  rw [← not_iff_not, Nat.Prime.not_coprime_iff_dvd]
  simp only [not_forall, not_not, Subtype.exists,
    Nat.mem_primeFactors_of_ne_zero (NeZero.ne d), ZMod.natCast_eq_zero_iff,
    exists_prop, and_comm, and_left_comm, and_assoc]

theorem unit_phase_factors (d : ℕ) [NeZero d] (hd : Squarefree d)
    (c y : ZMod d) :
    reciprocalUnitPhase d c y = ∏ p : d.primeFactors,
      letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
      let u : ZMod p.1 := (y.val : ZMod p.1)
      if u = 0 then (0 : ℂ) else
        ZMod.stdAddChar ((((d/p.1 : ℕ) : ZMod p.1)⁻¹ * (c.val : ZMod p.1)) / u) := by
  have (p : d.primeFactors) : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
  delta reciprocalUnitPhase
  by_cases hu : IsUnit y
  · simp only [ite_eq_left hu]
    rw [squarefree_character d hd (c * y⁻¹)]
    apply Finset.prod_congr rfl
    intro i _
    have hle := Nat.dvd_of_mem_primeFactors i.property
    let pi := ZMod.castHom hle (ZMod i.1)
    have hyproj : pi (y⁻¹) = (pi y)⁻¹ := by
      apply eq_inv_of_mul_eq_one_left
      rw [← map_mul, ZMod.inv_mul_of_unit y hu, map_one]
    rw [ite_eq_right ((unit_iff_prime_samples d y).1 hu i),
      ← zmod_castHom_apply_eq_natCast_val hle (c * y⁻¹), map_mul pi, hyproj,
      zmod_castHom_apply_eq_natCast_val hle c, zmod_castHom_apply_eq_natCast_val hle y]
    congr 1
    rw [div_eq_mul_inv, mul_assoc]
  · rw [ite_eq_right hu]
    obtain ⟨t, ht⟩ : ∃ t : d.primeFactors, (y.val : ZMod t.1) = 0 := by
      simpa using (not_forall.mp ((unit_iff_prime_samples d y).not.mp hu))
    exact (Finset.prod_eq_zero (Finset.mem_univ t) (by simp only [ht, ite_true])).symm

theorem restrict_divisor_primes {α : Type*} [CommMonoid α]
    (q d : ℕ) [NeZero q] [NeZero d] (hdq : d ∣ q)
    (g : (i : q.primeFactors) → α) :
    (∏ i : q.primeFactors, if i.val ∣ d then g i else 1) =
      (∏ i : d.primeFactors, g ⟨i.1, Nat.primeFactors_mono hdq (NeZero.ne q) i.2⟩) := by
  rw [← Finset.prod_filter]
  symm
  apply Finset.prod_bij (fun (i : d.primeFactors) (_ : i ∈ Finset.univ) =>
    (⟨i.1, Nat.primeFactors_mono hdq (NeZero.ne q) i.2⟩ : q.primeFactors))
  · intro i hi
    exact Finset.mem_filter.mpr ⟨Finset.mem_univ _, Nat.dvd_of_mem_primeFactors i.2⟩
  · intro i hi j hj h
    exact Subtype.ext (Subtype.mk.inj h)
  · intro i hi
    exact ⟨⟨i.val, (Nat.prime_of_mem_primeFactors i.2).mem_primeFactors'
      (Finset.mem_filter.mp hi).2⟩, Finset.mem_univ _, rfl⟩
  · intros; rfl

theorem lifted_unit_phase (d q : ℕ) [NeZero d] [NeZero q]
    (hds : Squarefree d) (hdq : d ∣ q) (c y : ZMod d) :
    reciprocalUnitPhase d c y = ∏ p : q.primeFactors,
      if p.1 ∣ d then
        letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.property⟩
        if (y.val : ZMod p.1) = 0 then (0 : ℂ) else
          ZMod.stdAddChar ((((d/p.1 : ℕ) : ZMod p.1)⁻¹ * (c.val : ZMod p.1)) / (y.val : ZMod p.1))
      else (1 : ℂ) := by
  rw [unit_phase_factors d hds, restrict_divisor_primes q d hdq]

theorem reciprocalUnitPhase_pair_eq_maskedReciprocalProduct
    (q : ℕ) [NeZero q] (hq : Squarefree q)
    (d : Fin 2 → ℕ) (hd : ∀ i, d i ∣ q) (c ℓ : Fin 2 → ℤ) :
    let I : (p : q.primeFactors) → Finset (Fin 2) := fun p =>
      Finset.univ.filter (fun i => p.1 ∣ d i)
    let M : (p : q.primeFactors) → Finset (ZMod p.1) := fun p =>
      (I p).image (fun i => -(ℓ i : ZMod p.1))
    let a : (p : q.primeFactors) → ZMod p.1 → ZMod p.1 := fun p z =>
      ∑ i ∈ I p, if -(ℓ i : ZMod p.1) = z then
        (c i : ZMod p.1) * (((d i / p.1 : ℕ) : ZMod p.1)⁻¹) else 0
    (∀ p : q.primeFactors, (M p).card ≤ 2) ∧
    (∀ x : ZMod q,
      (∏ i : Fin 2,
        letI : NeZero (d i) :=
          ⟨ne_zero_of_dvd_ne_zero (NeZero.ne q) (hd i)⟩
        reciprocalUnitPhase (d i) (c i : ZMod (d i))
          ((x.val : ZMod (d i)) + (ℓ i : ZMod (d i)))) =
        maskedReciprocalProduct q M a x) := by
  intro I M a
  have (i : Fin 2) : NeZero (d i) := ⟨ne_zero_of_dvd_ne_zero (NeZero.ne q) (hd i)⟩
  have (p : q.primeFactors) : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
  refine ⟨fun p => ?_, ?_⟩
  · simpa only [M] using (Finset.card_image_le.trans ((Finset.card_le_univ _).trans_eq (by simp)))
  intro x
  delta maskedReciprocalProduct
  symm
  calc
    _ = ∏ p : q.primeFactors,
        ∏ i ∈ I p, if (x.val : ZMod p.1) + (ℓ i : ZMod p.1) = 0 then (0 : ℂ) else
          ZMod.stdAddChar (((c i : ZMod p.1) * (((d i / p.1 : ℕ) : ZMod p.1)⁻¹)) /
              ((x.val : ZMod p.1) + (ℓ i : ZMod p.1))) := by
      apply Finset.prod_congr rfl
      intro p hp
      exact ((maskedReciprocalLocal_of_two_terms p.1 (I p)
        (fun i => (c i : ZMod p.1) * (((d i / p.1 : ℕ) : ZMod p.1)⁻¹))
        (fun i => (ℓ i : ZMod p.1))).2 (x.val : ZMod p.1)).symm
    _ = ∏ i : Fin 2,
      reciprocalUnitPhase (d i) (c i : ZMod (d i)) ((x.val : ZMod (d i)) + (ℓ i : ZMod (d i))) := by
      simp only [I, Finset.prod_filter]
      rw [Finset.prod_comm]
      apply Finset.prod_congr rfl
      intro i hi
      rw [lifted_unit_phase (d i) q (hq.squarefree_of_dvd (hd i)) (hd i)]
      apply Finset.prod_congr rfl
      intro p hp
      by_cases hpd : p.1 ∣ d i
      · rw [ite_eq_left hpd, ite_eq_left hpd]
        simp only [← zmod_castHom_apply_eq_natCast_val hpd, map_add, map_natCast, map_intCast]
        split_ifs with hz
        · rfl
        · congr 1
          ring
      · simp [hpd]

theorem local_mean_norm_le (p : ℕ) [Fact p.Prime]
    (S : Finset (ZMod p)) (a : ZMod p → ZMod p) :
    ‖(∑ x : ZMod p, maskedReciprocalLocal p S a x) / (p : ℂ)‖ ≤ 1 := by
  rw [norm_div, Complex.norm_natCast, div_le_one₀ (Nat.cast_pos.mpr (NeZero.pos p))]
  calc
    _ ≤ ∑ _ : ZMod p, (1 : ℝ) := norm_sum_le_of_le _ (by
      intro x _
      rw [norm_maskedReciprocalLocal]
      split_ifs <;> norm_num)
    _ = p := by simp [ZMod.card]

theorem maskedReciprocalProduct_exclusive_mean
    (q : ℕ) [NeZero q] (hq : Squarefree q)
    (M : (p : q.primeFactors) → Finset (ZMod p.1))
    (a : (p : q.primeFactors) → ZMod p.1 → ZMod p.1)
    (E : Finset q.primeFactors) (z : (p : q.primeFactors) → ZMod p.1)
    (hE : ∀ p ∈ E, M p = {z p} ∧ a p (z p) ≠ 0) :
    ((∑ x : ZMod q, maskedReciprocalProduct q M a x) / (q : ℂ) =
      (∏ p ∈ E, -(p.1 : ℂ)⁻¹) *
        ∏ p ∈ (Finset.univ : Finset q.primeFactors) \ E,
          letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
          (∑ u : ZMod p.1, maskedReciprocalLocal p.1 (M p) (a p) u) /
            (p.1 : ℂ)) ∧
    (‖(∑ x : ZMod q, maskedReciprocalProduct q M a x) / (q : ℂ)‖ ≤
      ∏ p ∈ E, (p.1 : ℝ)⁻¹) := by
  have (p : q.primeFactors) : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
  have hmean := (squarefree_crt_character_dft_mean q hq
    (fun p => maskedReciprocalLocal p.1 (M p) (a p))).2.2
  have hspecial (p : q.primeFactors) (hp : p ∈ E) :
      (∑ x : ZMod p.1, maskedReciprocalLocal p.1 (M p) (a p) x) /
        (p.1 : ℂ) = -(p.1 : ℂ)⁻¹ := by
    have he := hE p hp
    rw [he.1, maskedReciprocalLocal_singleton_mean p.1 (z p) (a p) he.2]
    simp [div_eq_mul_inv]
  delta maskedReciprocalProduct
  constructor
  · rw [hmean, ← Finset.prod_sdiff (Finset.subset_univ E), mul_comm]
    congr 1
    exact Finset.prod_congr rfl hspecial
  · rw [hmean, norm_prod]
    calc
      _ ≤ ∏ p : q.primeFactors, if p ∈ E then (p.1 : ℝ)⁻¹ else 1 := by
        apply Finset.prod_le_prod (by intros; positivity)
        intro p _
        split_ifs with h
        · rw [hspecial p h, norm_neg, norm_inv, Complex.norm_natCast]
        · exact local_mean_norm_le p.1 (M p) (a p)
      _ = ∏ p ∈ E, (p.1 : ℝ)⁻¹ := by
        rw [← Finset.prod_filter, Finset.filter_univ_mem]

theorem gcd_filter {k n : ℕ} (hn : n ≠ 0) :
    n.primeFactors.filter (fun t => t ∣ k) = (Nat.gcd n k).primeFactors := by
  ext p
  simp [Nat.mem_primeFactors_of_ne_zero hn,
    Nat.mem_primeFactors_of_ne_zero (Nat.gcd_ne_zero_left hn), Nat.dvd_gcd_iff, and_assoc]

theorem inv_primes_not_dvd (u : ℕ) (hu : Squarefree u) (n : ℕ) :
    (∏ p ∈ u.primeFactors.filter (fun p => ¬p ∣ n), (p : ℝ)⁻¹) =
      (Nat.gcd n u : ℝ) / (u : ℝ) := by
  rw [Finset.prod_inv_distrib, ← Nat.cast_prod, Finset.filter_not, gcd_filter hu.ne_zero,
    Nat.prod_primeFactors_sdiff_of_squarefree hu
      (Nat.primeFactors_mono (Nat.gcd_dvd_left u n) hu.ne_zero),
    Nat.prod_primeFactors_of_squarefree (hu.squarefree_of_dvd (Nat.gcd_dvd_left u n)),
    Nat.cast_div_charZero (Nat.gcd_dvd_left u n), inv_div, Nat.gcd_comm]

theorem diag_dft_local (p : ℕ) [Fact p.Prime]
    (M : Finset (ZMod p)) (a : ZMod p → ZMod p) (ξ : ZMod p) :
    ZMod.dft (fun x => maskedReciprocalLocal p M a (x) * star (maskedReciprocalLocal p M a x)) ξ =
      (if ξ = 0 then (p : ℂ) else 0) - ∑ z ∈ M, ZMod.stdAddChar (-(z * ξ)) := by
  have hdiag : (fun x => maskedReciprocalLocal p M a x *
        star (maskedReciprocalLocal p M a x)) = maskedReciprocalLocal p M (fun _ => 0) := by
    funext x
    have ht := (maskedReciprocalLocal_translate p M a 0).2 x
    rw [add_zero] at ht
    convert ht using 1
    congr 1
    · simp only [sub_zero, Finset.image_id', Finset.union_self]
    · funext z
      simp only [add_zero, sub_self]
  rw [hdiag]
  exact (maskedReciprocalLocal_inactive p M (fun _ => 0) (by simp)).2.1 ξ

theorem cofactor_twist_zero (q : ℕ) (hq : Squarefree q) (p : q.primeFactors)
    (ξ : ZMod q) :
    let α : ZMod p.1 := ((q / p.1 : ℕ) : ZMod p.1)⁻¹ * (ξ.val : ZMod p.1)
    α = 0 ↔ p.1 ∣ ξ.val := by
  have : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
  simpa only [mul_eq_zero, inv_eq_zero,
    or_iff_right (isUnit_cofactor_of_squarefree hq p.property).ne_zero] using
    (ZMod.natCast_eq_zero_iff ξ.val p.val)

theorem filtered_factor_prod {R : Type*} [CommMonoid R] (n : ℕ)
    (P : ℕ → Prop) [DecidablePred P] (f : ℕ → R) :
    (∏ j ∈ (Finset.univ : Finset n.primeFactors).filter (fun j => P j.1), f j.1) =
      ∏ p ∈ n.primeFactors.filter P, f p := by
  simpa only [Finset.prod_filter] using
    Finset.prod_coe_sort n.primeFactors (fun j => if P j then f j else 1)

theorem filter_dvd_gcd (n k : ℕ) (hn : Squarefree n) :
    (∏ p ∈ n.primeFactors.filter (fun p => p ∣ k), p) = Nat.gcd n k := by
  rw [gcd_filter hn.ne_zero]
  exact Nat.prod_primeFactors_of_squarefree
    (Squarefree.squarefree_of_dvd (Nat.gcd_dvd_left n k) hn)

theorem maskedReciprocalProduct_inactive_expansion
    (q : ℕ)
    (M : (p : q.primeFactors) → Finset (ZMod p.1))
    (a : (p : q.primeFactors) → ZMod p.1 → ZMod p.1)
    (J : Finset q.primeFactors)
    (hM : ∀ p ∈ J, (M p).card ≤ 2)
    (hinactive : ∀ p ∈ J, ∀ z ∈ M p, a p z = 0) :
    (∀ x : ZMod q,
      maskedReciprocalProduct q M a x =
        (∏ p ∈ (Finset.univ : Finset q.primeFactors) \ J,
          @maskedReciprocalLocal p.1 ⟨Nat.prime_of_mem_primeFactors p.2⟩
            (M p) (a p) (x.val : ZMod p.1)) *
          ∑ σ : ((p : J) → Option (M p.1)),
            ∏ p : J,
              match σ p with
              | none => (1 : ℂ)
              | some z => -(if (x.val : ZMod p.1.1) = z.1 then (1 : ℂ) else 0)) ∧
    (Fintype.card ((p : J) → Option (M p.1)) =
      ∏ p : J, (1 + (M p.1).card)) ∧
    (Fintype.card ((p : J) → Option (M p.1)) ≤ 3 ^ J.card) := by
  classical
  have (p : q.primeFactors) : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
  constructor
  · intro x
    delta maskedReciprocalProduct
    have hchoice := (Fintype.prod_sum (fun (p : J) (z : Option (M p.1)) =>
      match z with
      | none => (1 : ℂ)
      | some z' => -(if (x.val : ZMod p.1.1) = z'.1 then (1 : ℂ) else 0))).symm
    rw [hchoice, ← Finset.prod_sdiff (Finset.subset_univ J)]
    congr 1
    rw [← Finset.prod_coe_sort]
    apply Finset.prod_congr rfl
    intro p hp
    rw [(maskedReciprocalLocal_inactive p.1.1 (M p.1) (a p.1)
      (hinactive _ p.property)).1 _]
    simp only [Fintype.sum_option, Finset.sum_neg_distrib,
      Finset.sum_coe_sort (M p.1) (fun z : ZMod p.1.1 =>
        if (x.val : ZMod p.1.1) = z then (1 : ℂ) else 0), sub_eq_add_neg]
  · constructor
    · simp only [Fintype.card_pi, Fintype.card_option, Fintype.card_coe, add_comm]
    · rw [Fintype.card_pi]
      calc
        _ ≤ ∏ p : J, (3 : ℕ) := by
          apply Finset.prod_le_prod'
          intro p hp
          rw [Fintype.card_option, Fintype.card_coe]
          exact Nat.add_le_add_right (hM p.1 p.2) 1
        _ = 3 ^ J.card := by simp

open Classical in
theorem maskedReciprocalProduct_coprime_split
    (r s : ℕ) [NeZero r] [NeZero s] (hrs : Nat.Coprime r s)
    (M : (p : (r * s).primeFactors) → Finset (ZMod p.1))
    (a : (p : (r * s).primeFactors) → ZMod p.1 → ZMod p.1) :
    let ιr : r.primeFactors → (r * s).primeFactors := fun p =>
      ⟨p.1, Nat.primeFactors_mono (dvd_mul_right r s) (NeZero.ne (r * s)) p.2⟩
    let ιs : s.primeFactors → (r * s).primeFactors := fun p =>
      ⟨p.1, Nat.primeFactors_mono (dvd_mul_left s r) (NeZero.ne (r * s)) p.2⟩
    let Mr := fun p : r.primeFactors => M (ιr p)
    let aR := fun p : r.primeFactors => a (ιr p)
    let Ms := fun p : s.primeFactors => M (ιs p)
    let aS := fun p : s.primeFactors => a (ιs p)
    let R := fun n : ℤ => maskedReciprocalProduct r Mr aR (n : ZMod r)
    let S := fun n : ℤ => maskedReciprocalProduct s Ms aS (n : ZMod s)
    (∀ n : ℤ, maskedReciprocalProduct (r * s) M a (n : ZMod (r * s)) = R n * S n) ∧
      Function.Periodic R (r : ℤ) ∧ (∀ n, ‖R n‖ ≤ 1) ∧ (∀ n, ‖S n‖ ≤ 1) := by
  have hproj (q : ℕ) [NeZero q] (p : q.primeFactors) (n : ℤ) :
      ((n : ZMod q).val : ZMod p.1) = (n : ZMod p.1) := by
    simpa only [ZMod.cast_eq_val] using
      ZMod.cast_intCast (R := ZMod p.1) (Nat.dvd_of_mem_primeFactors p.2) n
  have hn (q : ℕ) [NeZero q]
      (B : (p : q.primeFactors) → Finset (ZMod p.1))
      (b : (p : q.primeFactors) → ZMod p.1 → ZMod p.1) (n : ℤ) :
      ‖maskedReciprocalProduct q B b (n : ZMod q)‖ ≤ 1 := by
    delta maskedReciprocalProduct
    rw [norm_prod]
    apply Finset.prod_le_one
    · intro p hp
      exact norm_nonneg _
    · intro p hp
      rw [norm_maskedReciprocalLocal]
      split_ifs <;> norm_num
  dsimp only
  refine ⟨?_, ?_, hn r _ _, hn s _ _⟩
  · intro n
    delta maskedReciprocalProduct
    conv_lhs => enter [2, p]; rw [hproj]
    conv_rhs =>
      congr
      · enter [2, p]; rw [hproj]
      · enter [2, p]; rw [hproj]
    let g : (r * s).primeFactors → ℂ := fun p =>
      @maskedReciprocalLocal p.1 ⟨Nat.prime_of_mem_primeFactors p.2⟩
        (M p) (a p) (n : ZMod p.1)
    rw [← restrict_divisor_primes (r * s) r (dvd_mul_right r s) g,
      ← restrict_divisor_primes (r * s) s (dvd_mul_left s r) g, ← Finset.prod_mul_distrib]
    apply Finset.prod_congr rfl
    intro p hp
    have hprime := Nat.prime_of_mem_primeFactors p.2
    have hor := hprime.dvd_mul.mp (Nat.dvd_of_mem_primeFactors p.2)
    have hnot : ¬ (p.1 ∣ r ∧ p.1 ∣ s) := fun h =>
      hprime.ne_one (Nat.eq_one_of_dvd_coprimes hrs h.1 h.2)
    rcases hor with hr | hs <;>
      simp_all only [and_true, true_and, ite_true, ite_false, mul_one, one_mul] <;> rfl
  · intro n
    dsimp only
    rw [Int.cast_add, Int.cast_natCast, ZMod.natCast_self, add_zero]

theorem norm_le_four_mul_sqrt_of_sq_le
    (r s N L : ℝ) (hr : 0 ≤ r) (hN : 0 ≤ N) (hL : 1 ≤ L)
    (T : ℂ) (hbound : ‖T‖ ^ 2 ≤ 4 * N * r + 8 * L * N * Real.sqrt s) :
    ‖T‖ ≤ 4 * L * Real.sqrt N * (Real.sqrt r + Real.sqrt (Real.sqrt s)) := by
  have hL0 : 0 ≤ L := zero_le_one.trans hL
  refine le_of_sq_le_sq (hbound.trans ?_) (by positivity)
  calc
    _ = 4 * (N * r) + (8 * L) * (N * Real.sqrt s) := by ring
    _ ≤ (16 * L ^ 2) * (N * r) + (16 * L ^ 2) * (N * Real.sqrt s) := by
      apply add_le_add <;> apply mul_le_mul_of_nonneg_right _ (by positivity) <;>
        nlinarith only [hL, sq_nonneg (L - 1)]
    _ = 16 * L ^ 2 * N * (r + Real.sqrt s) := by ring
    _ ≤ 16 * L ^ 2 * N * (Real.sqrt r + Real.sqrt (Real.sqrt s)) ^ 2 := by
      gcongr
      nlinarith only [Real.sq_sqrt hr, Real.sq_sqrt (Real.sqrt_nonneg s),
        mul_nonneg (Real.sqrt_nonneg r) (Real.sqrt_nonneg (Real.sqrt s))]
    _ = (4 * L * Real.sqrt N * (Real.sqrt r + Real.sqrt (Real.sqrt s))) ^ 2 := by
      norm_num [mul_pow, Real.sq_sqrt hN]

theorem reciprocal_differencing_numeric
    (r s N K : ℕ) (hr : 0 < r) (hs : 0 < s) (hrN : r ≤ N) (hNs : N < s)
    (hK : K = N / r) (C τ ell : ℝ) (hC : 1 ≤ C) (hτ : 1 ≤ τ) (hell : 1 ≤ ell)
    (T : ℂ) (H : ℕ → ℝ)
    (hG : 2 * ∑ h ∈ Finset.Icc 1 (K - 1),
      (K - h : ℝ) * Real.sqrt (Nat.gcd s h : ℝ) ≤ 2 * (K : ℝ) ^ 2 * τ)
    (hCor : ∀ h ∈ Finset.Icc 1 (K - 1),
      H h ≤ 2 * (C * τ * ell) * Real.sqrt (s : ℝ) +
        C * (N : ℝ) * Real.sqrt (Nat.gcd s h : ℝ) / Real.sqrt (s : ℝ))
    (hvdc : ‖T‖ ^ 2 ≤ (((N + (K - 1) * r : ℕ) : ℝ) / (K : ℝ) ^ 2) *
      ((K : ℝ) * (N : ℝ) +
        2 * ∑ h ∈ Finset.Icc 1 (K - 1), (K - h : ℝ) * H h)) :
    ‖T‖ ^ 2 ≤ 4 * (N : ℝ) * r + 8 * (C * τ * ell) * N * Real.sqrt (s : ℝ) ∧
    ‖T‖ ≤ 4 * (C * τ * ell) * Real.sqrt (N : ℝ) *
      (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ))) := by
  have hKpos : 0 < K := hK ▸ Nat.div_pos hrN hr
  have hKposR : 0 < (K : ℝ) := Nat.cast_pos.2 hKpos
  have hKR : (K : ℝ) * r ≤ N := by
    exact_mod_cast (hK ▸ Nat.div_mul_le_self N r)
  have hNKR : (N : ℝ) ≤ 2 * K * r := by
    have h := Nat.lt_mul_div_succ N hr
    rw [← hK] at h
    exact_mod_cast (show N ≤ 2 * K * r by nlinarith only [h, hKpos])
  have hC0 : 0 ≤ C := by linarith
  have hτ0 : 0 ≤ τ := by linarith
  have hL := one_le_mul_of_one_le_of_one_le
    (one_le_mul_of_one_le_of_one_le hC hτ) hell
  have hL0 : 0 ≤ C * τ * ell := zero_le_one.trans hL
  have hweights : 2 * (∑ h ∈ Finset.Icc 1 (K - 1), (K - h : ℝ)) ≤ (K : ℝ) ^ 2 := by
    rw [← Finset.Ico_add_one_right_eq_Icc, Nat.sub_add_cancel (by omega : 1 ≤ K),
      Finset.sum_sub_distrib, Finset.sum_const, nsmul_eq_mul, Nat.card_Ico]
    have hsum : (∑ h ∈ Finset.Ico 1 K, (h : ℝ)) =
        ∑ h ∈ Finset.range K, (h : ℝ) := by
      simpa using (Finset.sum_range_eq_add_Ico (fun h : ℕ => (h : ℝ)) hKpos).symm
    rw [hsum, Nat.cast_sub (by omega : 1 ≤ K), Nat.cast_one]
    have hsumR := congrArg (fun n : ℕ => (n : ℝ)) (Finset.sum_range_id_mul_two K)
    simp only [Nat.cast_mul, Nat.cast_sum, Nat.cast_ofNat,
      Nat.cast_sub (by omega : 1 ≤ K), Nat.cast_one] at hsumR
    nlinarith only [hsumR, hKposR]
  have hsumCor : (2 * ∑ h ∈ Finset.Icc 1 (K - 1), (K - h : ℝ) * H h) ≤
      4 * (C * τ * ell) * Real.sqrt (s : ℝ) * (K : ℝ) ^ 2 := by
    have hsum := Finset.sum_le_sum fun h hh =>
      mul_le_mul_of_nonneg_left (hCor h hh) (sub_nonneg.2
        (Nat.cast_le.2 ((Finset.mem_Icc.1 hh).2.trans (Nat.sub_le _ _))))
    simp_rw [mul_add, ← div_mul_eq_mul_div₀ (C * (N : ℝ)) _ (Real.sqrt (s : ℝ)),
      mul_left_comm _ (C * (N : ℝ) / Real.sqrt (s : ℝ)),
      Finset.sum_add_distrib, ← Finset.sum_mul, ← Finset.mul_sum] at hsum
    have hmean : C * (N : ℝ) / Real.sqrt (s : ℝ) * τ ≤
        (C * τ * ell) * Real.sqrt (s : ℝ) := by
      calc
        _ = C * τ * ((N : ℝ) / Real.sqrt s) := by ring
        _ ≤ C * τ * ell * ((s : ℝ) / Real.sqrt s) :=
          mul_le_mul (le_mul_of_one_le_right (mul_nonneg hC0 hτ0) hell)
            (div_le_div_of_nonneg_right (Nat.cast_le.2 hNs.le) (Real.sqrt_nonneg _))
            (by positivity) hL0
        _ = _ := by rw [Real.div_sqrt]
    have hm := mul_le_mul_of_nonneg_left hG (show 0 ≤ C * (N : ℝ) / Real.sqrt (s : ℝ) by positivity)
    have hc := mul_le_mul_of_nonneg_left hweights
      (show 0 ≤ 2 * (C * τ * ell) * Real.sqrt (s : ℝ) by positivity)
    have hn := mul_le_mul_of_nonneg_right hmean (show 0 ≤ 2 * (K : ℝ) ^ 2 by positivity)
    nlinarith only [hsum, hm, hc, hn]
  have hsquare : ‖T‖ ^ 2 ≤
      4 * (N : ℝ) * r + 8 * (C * τ * ell) * N * Real.sqrt (s : ℝ) := by
    calc
      ‖T‖ ^ 2 ≤ (((N + (K - 1) * r : ℕ) : ℝ) / (K : ℝ) ^ 2) *
          ((K : ℝ) * N + 4 * (C * τ * ell) * Real.sqrt (s : ℝ) * (K : ℝ) ^ 2) :=
        hvdc.trans (mul_le_mul_of_nonneg_left (add_le_add_right hsumCor _) (by positivity))
      _ ≤ (2 * (N : ℝ) / (K : ℝ) ^ 2) *
          ((K : ℝ) * N + 4 * (C * τ * ell) * Real.sqrt (s : ℝ) * (K : ℝ) ^ 2) := by
        gcongr
        rw [Nat.cast_add, Nat.cast_mul, Nat.cast_sub (by omega : 1 ≤ K)]
        norm_num
        nlinarith only [hKR, (Nat.cast_nonneg r : (0 : ℝ) ≤ r)]
      _ = 2 * (N : ℝ) ^ 2 / K + 8 * (C * τ * ell) * N * Real.sqrt (s : ℝ) := by
        field_simp [ne_of_gt hKposR]
        ring
      _ ≤ 4 * (N : ℝ) * r + 8 * (C * τ * ell) * N * Real.sqrt (s : ℝ) := by
        gcongr
        apply (div_le_iff₀ hKposR).2
        nlinarith only [mul_le_mul_of_nonneg_left hNKR (Nat.cast_nonneg N)]
  exact ⟨hsquare, norm_le_four_mul_sqrt_of_sq_le r s N (C * τ * ell)
    (by positivity) (by positivity) hL T hsquare⟩

theorem rs_weighted_prefix_bound
    (N : ℕ) (f w : ℕ → ℂ) (B : ℝ)
    (hbound : ∀ m ≤ N, ‖∑ n ∈ Finset.range m, f n‖ ≤ B) :
    ‖∑ n ∈ Finset.range N, w n * f n‖ ≤
      (‖w (N - 1)‖ + ∑ n ∈ Finset.range (N - 1), ‖w (n + 1) - w n‖) * B := by
  have hparts := Finset.sum_range_by_parts w f N
  simp only [smul_eq_mul] at hparts
  rw [hparts]
  calc
    _ ≤ ‖w (N - 1) * (∑ n ∈ Finset.range N, f n)‖ +
        ‖∑ i ∈ Finset.range (N - 1),
          (w (i + 1) - w i) * (∑ n ∈ Finset.range (i + 1), f n)‖ := norm_sub_le _ _
    _ ≤ ‖w (N - 1)‖ * B +
        ∑ i ∈ Finset.range (N - 1), ‖w (i + 1) - w i‖ * B := by
      apply add_le_add
      · exact norm_mul_le_of_le le_rfl (hbound N le_rfl)
      · apply norm_sum_le_of_le
        intro i hi
        exact norm_mul_le_of_le le_rfl
          (hbound (i + 1) (by have := Finset.mem_range.mp hi; omega))
    _ = _ := by rw [← Finset.sum_mul, add_mul]

theorem finset_prime_residue_crt
    {ι : Type*} (P : ι → ℕ) (hP : ∀ i, Nat.Prime (P i))
    (hPinj : Function.Injective P) (S : Finset ι) (z : (i : ι) → ZMod (P i)) :
    let d := ∏ i ∈ S, P i
    0 < d ∧ ∃ b : ℕ, b < d ∧ ∀ x : ℤ,
      (∏ i ∈ S, if (x : ZMod (P i)) = z i then (1 : ℂ) else 0) =
        if Int.ModEq (d : ℤ) x (b : ℤ) then 1 else 0 := by
  dsimp only
  have hnz (i : ι) (_hi : i ∈ S) : P i ≠ 0 := (hP i).ne_zero
  have hpair : Set.Pairwise (S : Set ι) (fun i j => Nat.Coprime (P i) (P j)) := by
    intro i hi j hj hij
    exact (Nat.coprime_primes (hP i) (hP j)).2 (hPinj.ne hij)
  let b := Nat.chineseRemainderOfFinset (fun i => (z i).val) P S hnz hpair
  refine ⟨Finset.prod_pos (fun i _ => (hP i).pos), b.val,
    Nat.chineseRemainderOfFinset_lt_prod (fun i => (z i).val) P hnz hpair, ?_⟩
  intro x
  have hb (i : ι) (hi : i ∈ S) : (b.val : ZMod (P i)) = z i := by
    let : NeZero (P i) := ⟨(hP i).ne_zero⟩
    rw [← ZMod.natCast_zmod_val (z i)]
    exact (ZMod.natCast_eq_natCast_iff b.val (z i).val (P i)).2 (b.property i hi)
  have hlocal : (∀ i ∈ S, (x : ZMod (P i)) = z i) ↔
      ∀ i ∈ S, Int.ModEq (P i : ℤ) x (b.val : ℤ) := by
    apply forall₂_congr
    intro i hi
    rw [← hb i hi]
    simpa only [Int.cast_natCast] using
      ZMod.intCast_eq_intCast_iff x (b.val : ℤ) (P i)
  have hprod :
      (∀ i ∈ S, Int.ModEq (P i : ℤ) x (b.val : ℤ)) ↔
        Int.ModEq ((∏ i ∈ S, P i : ℕ) : ℤ) x (b.val : ℤ) := by
    simp only [Int.modEq_iff_dvd, Nat.cast_prod]
    refine ⟨fun h => Finset.prod_dvd_of_coprime ?_ h,
      fun h i hi => (Finset.dvd_prod_of_mem _ hi).trans h⟩
    intro i hi j hj hij
    exact (hpair hi hj hij).isCoprime
  simp only [Finset.prod_boole, hlocal, hprod]

open Classical in
theorem finite_option_selection_coefficients
    {ι : Type*} [Fintype ι] (α : ι → Type*) (M : (i : ι) → Finset (α i)) (P : ι → ℕ) :
    let D : ((i : ι) → Option (M i)) → Finset ι :=
      fun σ => Finset.univ.filter (fun i => (σ i).isSome)
    ((∑ σ : ((i : ι) → Option (M i)),
        (-1 : ℂ) ^ (D σ).card / ((∏ i ∈ D σ, P i : ℕ) : ℂ)) =
      ∏ i : ι, (1 - ((M i).card : ℂ) / (P i : ℂ))) ∧
    (∀ (σ : (i : ι) → Option (M i)) (B : ι → ℂ),
      (∏ i : ι, match σ i with | none => (1 : ℂ) | some _ => -B i) =
        (-1 : ℂ) ^ (D σ).card * ∏ i ∈ D σ, B i) := by
  intro D
  have hsign (σ : (i : ι) → Option (M i)) (B : ι → ℂ) :
      (∏ i : ι, match σ i with | none => (1 : ℂ) | some _ => -B i) =
        (-1 : ℂ) ^ (D σ).card * ∏ i ∈ D σ, B i := by
    rw [← Finset.prod_neg B, Finset.prod_filter]
    apply Finset.prod_congr rfl
    intro i hi
    cases σ i <;> simp
  refine ⟨?_, hsign⟩
  simp_rw [Nat.cast_prod, div_eq_mul_inv, ← Finset.prod_inv_distrib, ← hsign]
  refine (Fintype.prod_sum (fun (i : ι) (o : Option (M i)) =>
      match o with | none => (1 : ℂ) | some _ => -(P i : ℂ)⁻¹)).symm.trans ?_
  simp [Fintype.sum_option, sub_eq_add_neg]

open Classical in
theorem maskedReciprocalProduct_inactive_crt_expansion
    (q : ℕ) [NeZero q]
    (M : (p : q.primeFactors) → Finset (ZMod p.1))
    (a : (p : q.primeFactors) → ZMod p.1 → ZMod p.1)
    (J : Finset q.primeFactors)
    (hM : ∀ p ∈ J, (M p).card ≤ 2)
    (hinactive : ∀ p ∈ J, ∀ z ∈ M p, a p z = 0) :
    let κ := (p : J) → Option (M p.1)
    let D : κ → Finset J := fun σ => Finset.univ.filter (fun p => (σ p).isSome)
    let d : κ → ℕ := fun σ => ∏ p ∈ D σ, p.1.1
    let ε : κ → ℂ := fun σ => (-1 : ℂ) ^ (D σ).card
    (∀ σ, d σ ∣ ∏ p : J, p.1.1) ∧
    ∃ b : κ → ℕ, (∀ σ, 0 < d σ ∧ b σ < d σ) ∧
      (∀ n : ℤ, maskedReciprocalProduct q M a (n : ZMod q) =
        (∏ p ∈ (Finset.univ : Finset q.primeFactors) \ J,
          @maskedReciprocalLocal p.1 ⟨Nat.prime_of_mem_primeFactors p.2⟩
            (M p) (a p) (n : ZMod p.1)) *
        ∑ σ, ε σ * (if Int.ModEq (d σ : ℤ) n (b σ : ℤ) then 1 else 0)) ∧
      (∑ σ, ε σ / (d σ : ℂ)) =
        ∏ p : J, (1 - ((M p.1).card : ℂ) / (p.1.1 : ℂ)) ∧
      Fintype.card κ ≤ 3 ^ J.card := by
  intro κ D d ε
  let z : (σ : κ) → (p : J) → ZMod p.1.1 := fun σ p =>
    match σ p with | none => 0 | some z => z.1
  have hP (p : J) : Nat.Prime p.1.1 := Nat.prime_of_mem_primeFactors p.1.2
  have hPi : Function.Injective (fun p : J => p.1.1) :=
    Subtype.val_injective.comp Subtype.val_injective
  have hcrt (σ : κ) := finset_prime_residue_crt
    (fun p : J => p.1.1) hP hPi (D σ) (z σ)
  choose b hb using fun σ : κ => (hcrt σ).2
  have hc := finite_option_selection_coefficients
    (fun p : J => ZMod p.1.1) (fun p : J => M p.1) (fun p : J => p.1.1)
  have hexp := maskedReciprocalProduct_inactive_expansion q M a J hM hinactive
  refine ⟨?_, b, ?_, ?_, ?_, ?_⟩
  · intro σ
    exact Finset.prod_dvd_prod_of_subset (D σ) Finset.univ (fun p : J => p.1.1)
      (Finset.subset_univ _)
  · intro σ
    exact ⟨(hcrt σ).1, (hb σ).1⟩
  · intro n
    have he := hexp.1 (n : ZMod q)
    have hproj (p : q.primeFactors) :
        (((n : ZMod q).val : ℕ) : ZMod p.1) = (n : ZMod p.1) := by
      simpa only [ZMod.cast_eq_val] using
        ZMod.cast_intCast (R := ZMod p.1) (Nat.dvd_of_mem_primeFactors p.2) n
    simp_rw [hproj] at he
    rw [he]
    congr 1
    apply Finset.sum_congr rfl
    intro σ hσ
    rw [← (hb σ).2 n]
    convert! hc.2 σ (fun p => if (n : ZMod p.1.1) = z σ p then 1 else 0) using 1
    apply Finset.prod_congr rfl
    intro p hp
    cases hsp : σ p <;> simp [hsp, z]
  · convert! hc.1
  · exact hexp.2.2

open Classical in
theorem maskedReciprocalLocal_affine_transport
    (p : ℕ) [Fact p.Prime]
    (M : Finset (ZMod p)) (a : ZMod p → ZMod p)
    (A d : ZMod p) (hd : d ≠ 0) :
    let M' := M.image (fun z => (z - A) / d)
    let a' := fun y => a (A + d * y) / d
    M'.card = M.card ∧
      ((∃ z ∈ M', a' z ≠ 0) ↔ (∃ z ∈ M, a z ≠ 0)) ∧
      ∀ x : ZMod p, maskedReciprocalLocal p M a (A + d * x) =
        maskedReciprocalLocal p M' a' x := by
  have hinj : Function.Injective (fun z : ZMod p => (z - A) / d) :=
    fun _ _ h => sub_left_injective ((div_left_inj' hd).mp h)
  have hcancel (z : ZMod p) : A + d * ((z - A) / d) = z := by
    simp [mul_div_cancel₀ _ hd]
  have hmem (x : ZMod p) :
      x ∈ M.image (fun z => (z - A) / d) ↔ A + d * x ∈ M := by
    simp [Finset.mem_image, div_eq_iff hd, sub_eq_iff_eq_add, mul_comm, add_comm]
  dsimp only
  refine ⟨Finset.card_image_of_injective M hinj, ?_, ?_⟩
  · simp [hcancel, hd]
  · intro x
    simp only [maskedReciprocalLocal, ← hmem x]
    split_ifs
    · rfl
    · congr 1
      rw [Finset.sum_image hinj.injOn]
      apply Finset.sum_congr rfl
      intro z hz
      rw [hcancel]
      have hden : A + d * x - z = d * (x - (z - A) / d) := by
        linear_combination hcancel z
      rw [hden, div_mul_eq_div_div]

open Classical in
theorem maskedReciprocalProduct_affine_transport
    (t d : ℕ) [NeZero t] (hdt : Nat.Coprime d t)
    (M : (p : t.primeFactors) → Finset (ZMod p.1))
    (a : (p : t.primeFactors) → ZMod p.1 → ZMod p.1)
    (A : ℤ) :
    letI (p : t.primeFactors) : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
    let M' : (p : t.primeFactors) → Finset (ZMod p.1) := fun p =>
      (M p).image (fun z => (z - (A : ZMod p.1)) / (d : ZMod p.1))
    let a' : (p : t.primeFactors) → ZMod p.1 → ZMod p.1 := fun p y =>
      a p ((A : ZMod p.1) + (d : ZMod p.1) * y) / (d : ZMod p.1)
    (∀ p : t.primeFactors, (M' p).card = (M p).card) ∧
    (∀ p : t.primeFactors,
      (∃ z ∈ M' p, a' p z ≠ 0) ↔ (∃ z ∈ M p, a p z ≠ 0)) ∧
    (∀ x : ZMod t,
      maskedReciprocalProduct t M a ((A : ZMod t) + (d : ZMod t) * x) =
        maskedReciprocalProduct t M' a' x) ∧
    ((∑ x : ZMod t, maskedReciprocalProduct t M' a' x) / (t : ℂ) =
      (∑ x : ZMod t, maskedReciprocalProduct t M a x) / (t : ℂ)) := by
  intro M' a'
  have (p : t.primeFactors) : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
  have hd (p : t.primeFactors) : (d : ZMod p.1) ≠ 0 :=
    ((ZMod.isUnit_iff_coprime d p.1).mpr
      (hdt.of_dvd_right (Nat.dvd_of_mem_primeFactors p.2))).ne_zero
  have hlocal (p : t.primeFactors) :=
    maskedReciprocalLocal_affine_transport p.1 (M p) (a p) (A : ZMod p.1)
      (d : ZMod p.1) (hd p)
  refine ⟨fun p => (hlocal p).1, fun p => (hlocal p).2.1, ?_⟩
  have hphase (x : ZMod t) :
      maskedReciprocalProduct t M a ((A : ZMod t) + (d : ZMod t) * x) =
        maskedReciprocalProduct t M' a' x := by
    rw [maskedReciprocalProduct, maskedReciprocalProduct]
    apply Finset.prod_congr rfl
    intro p hp
    have hpq := Nat.dvd_of_mem_primeFactors p.2
    rw [← ZMod.cast_eq_val, ZMod.cast_add hpq, ZMod.cast_mul hpq,
      ZMod.cast_intCast hpq, ZMod.cast_natCast hpq, ZMod.cast_eq_val]
    exact (hlocal p).2.2 _
  refine ⟨hphase, ?_⟩
  have hb : Function.Bijective (fun x : ZMod t =>
      (A : ZMod t) + (d : ZMod t) * x) :=
    (Equiv.addLeft (A : ZMod t)).bijective.comp
      (IsUnit.isUnit_iff_mulLeft_bijective.mp ((ZMod.isUnit_iff_coprime d t).mpr hdt))
  congr 1
  simp_rw [← hphase]
  exact hb.sum_comp _

theorem integer_interval_modEq_reindex_count
    (A : ℤ) (N d : ℕ) (hd : 0 < d) (b : ℤ) :
    let l : ℤ := ⌈((A - b : ℤ) : ℚ) / (d : ℚ)⌉
    let u : ℤ := ⌈((A + (N : ℤ) - b : ℤ) : ℚ) / (d : ℚ)⌉
    let m : ℕ := (u - l).toNat
    let β : ℤ := b + (d : ℤ) * l
    (∀ f : ℤ → ℂ,
      (∑ n ∈ Finset.range N,
        if Int.ModEq (d : ℤ) (A + n) b then f (A + n) else 0) =
      ∑ j ∈ Finset.range m, f (β + (d : ℤ) * (j : ℤ))) ∧
    m ≤ N ∧ |(m : ℝ) - (N : ℝ) / (d : ℝ)| ≤ 1 := by
  classical
  intro l u m β
  have hdZ : 0 < (d : ℤ) := by exact_mod_cast hd
  have hdQ : 0 < (d : ℚ) := by exact_mod_cast hd
  let I : Finset ℤ := (Finset.Ico A (A + N)).filter (fun x => Int.ModEq (d : ℤ) x b)
  have hmap : I = ((Finset.Ico l u).map
      ⟨(· * (d : ℤ)), mul_left_injective₀ hdZ.ne'⟩).map
      ⟨(· + b), add_left_injective b⟩ := by
    dsimp [I, l, u]
    rw [Int.Ico_filter_modEq_eq, Int.Ico_filter_dvd_eq _ _ hdZ]
    simp
  have hlu : l ≤ u := by
    apply Int.ceil_mono
    apply div_le_div_of_nonneg_right _ hdQ.le
    exact_mod_cast (show A - b ≤ A + (N : ℤ) - b by omega)
  refine ⟨?_, ?_, ?_⟩
  · intro f
    calc
      (∑ n ∈ Finset.range N,
          if Int.ModEq (d : ℤ) (A + n) b then f (A + n) else 0) =
          ∑ x ∈ Finset.Ico A (A + N),
            if Int.ModEq (d : ℤ) x b then f x else 0 := by
        rw [Int.Ico_eq_finset_map, Finset.sum_map]
        simp
      _ = ∑ x ∈ I, f x := (Finset.sum_filter _ _).symm
      _ = ∑ z ∈ Finset.Ico l u, f (z * (d : ℤ) + b) := by
        rw [hmap, Finset.sum_map, Finset.sum_map]
        rfl
      _ = ∑ j ∈ Finset.range m, f (β + (d : ℤ) * (j : ℤ)) := by
        rw [Int.Ico_eq_finset_map, Finset.sum_map]
        apply Finset.sum_congr rfl
        intro j hj
        congr 1
        simp only [Function.Embedding.trans_apply, Nat.castEmbedding_apply, addLeftEmbedding_apply]
        dsimp [β]
        ring
  · calc
      m = I.card := by rw [hmap, Finset.card_map, Finset.card_map, Int.card_Ico]
      _ ≤ (Finset.Ico A (A + (N : ℤ))).card := Finset.card_filter_le _ _
      _ = N := by simp
  · have hmQ : (m : ℚ) = (u : ℚ) - (l : ℚ) := by
      exact_mod_cast Int.toNat_of_nonneg (sub_nonneg.mpr hlu)
    have hl_le := Int.le_ceil (((A - b : ℤ) : ℚ) / (d : ℚ))
    have hl_lt := Int.ceil_lt_add_one (((A - b : ℤ) : ℚ) / (d : ℚ))
    have hu_le := Int.le_ceil (((A + (N : ℤ) - b : ℤ) : ℚ) / (d : ℚ))
    have hu_lt := Int.ceil_lt_add_one (((A + (N : ℤ) - b : ℤ) : ℚ) / (d : ℚ))
    have hquot : ((A + (N : ℤ) - b : ℤ) : ℚ) / (d : ℚ) -
        ((A - b : ℤ) : ℚ) / (d : ℚ) = (N : ℚ) / (d : ℚ) := by
      push_cast
      ring
    have herror : |(m : ℚ) - (N : ℚ) / (d : ℚ)| ≤ 1 := by
      rw [hmQ, abs_le]
      dsimp [l, u]
      constructor <;> linarith only [hl_le, hl_lt, hu_le, hu_lt, hquot]
    simpa using (Rat.cast_le (K := ℝ)).2 herror

open Classical in
theorem maskedReciprocalProduct_divisor_restriction
    (q d : ℕ) [NeZero q] [NeZero d] (hdq : d ∣ q) (hd : Squarefree d)
    (M : (p : q.primeFactors) → Finset (ZMod p.1))
    (a : (p : q.primeFactors) → ZMod p.1 → ZMod p.1) :
    let ι : d.primeFactors → q.primeFactors := fun p =>
      ⟨p.1, Nat.primeFactors_mono hdq (NeZero.ne q) p.2⟩
    let Md := fun p : d.primeFactors => M (ι p)
    let ad := fun p : d.primeFactors => a (ι p)
    (∀ n : ℤ, maskedReciprocalProduct d Md ad (n : ZMod d) =
      ∏ p : q.primeFactors, if p.1 ∣ d then
        @maskedReciprocalLocal p.1 ⟨Nat.prime_of_mem_primeFactors p.2⟩
          (M p) (a p) (n : ZMod p.1)
        else 1) ∧
    ((∑ x : ZMod d, maskedReciprocalProduct d Md ad x) / (d : ℂ) =
      ∏ p : q.primeFactors, if p.1 ∣ d then
        letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
        (∑ x : ZMod p.1, maskedReciprocalLocal p.1 (M p) (a p) x) / (p.1 : ℂ)
        else 1) := by
  intro ι Md ad
  constructor
  · intro n
    rw [restrict_divisor_primes q d hdq, maskedReciprocalProduct]
    apply Finset.prod_congr rfl
    intro p hp
    rw [← ZMod.cast_eq_val, ZMod.cast_intCast (Nat.dvd_of_mem_primeFactors p.2)]
  · rw [restrict_divisor_primes q d hdq]
    exact (squarefree_crt_character_dft_mean d hd (fun p =>
      @maskedReciprocalLocal p.1 ⟨Nat.prime_of_mem_primeFactors p.2⟩
        (Md p) (ad p))).2.2

open Classical in
theorem inactive_product_mean_split
    (q : ℕ) [NeZero q] (hq : Squarefree q)
    (M : (p : q.primeFactors) → Finset (ZMod p.1))
    (a : (p : q.primeFactors) → ZMod p.1 → ZMod p.1)
    (J : Finset q.primeFactors)
    (hinactive : ∀ p ∈ J, ∀ z ∈ M p, a p z = 0) :
    (∑ x : ZMod q, maskedReciprocalProduct q M a x) / (q : ℂ) =
      (∏ p ∈ (Finset.univ : Finset q.primeFactors) \ J,
        letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
        (∑ x : ZMod p.1,
          @maskedReciprocalLocal p.1 ⟨Nat.prime_of_mem_primeFactors p.2⟩
            (M p) (a p) x) / (p.1 : ℂ)) *
      ∏ p ∈ J, ((1 : ℂ) - ((M p).card : ℂ) / (p.1 : ℂ)) := by
  unfold maskedReciprocalProduct
  rw [(squarefree_crt_character_dft_mean q hq (fun p =>
    @maskedReciprocalLocal p.1 ⟨Nat.prime_of_mem_primeFactors p.2⟩
      (M p) (a p))).2.2, ← Finset.prod_sdiff (Finset.subset_univ J)]
  congr 1
  apply Finset.prod_congr rfl
  intro p hp
  let : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
  rw [(maskedReciprocalLocal_inactive p.1 (M p) (a p) (hinactive p hp)).2.2.1,
    sub_div, div_self]
  exact_mod_cast (NeZero.ne p.1)

theorem prime_subtype_product_spec (q : ℕ) (hq : Squarefree q)
    (S : Finset q.primeFactors) :
    let d : ℕ := ∏ p ∈ S, p.1
    d ≠ 0 ∧ d ∣ q ∧ d.primeFactors = S.image Subtype.val := by
  classical
  dsimp only
  refine ⟨Finset.prod_ne_zero_iff.mpr (fun p hp =>
    (Nat.prime_of_mem_primeFactors p.2).ne_zero), ?_, ?_⟩
  · exact (Finset.prod_dvd_prod_of_subset S Finset.univ (fun p => p.1)
      (Finset.subset_univ _)).trans (prod_primeFactors_subtype_eq_of_squarefree hq).dvd
  · rw [← Finset.prod_image (f := fun p : ℕ => p) Subtype.val_injective.injOn]
    apply Nat.primeFactors_prod
    simpa only [Finset.forall_mem_image] using
      fun (p : q.primeFactors) (_ : p ∈ S) => Nat.prime_of_mem_primeFactors p.2

theorem prime_subtype_partition (q : ℕ) (hq : Squarefree q)
    (J : Finset q.primeFactors) :
    let t : ℕ := ∏ p ∈ Finset.univ \ J, p.1
    let u : ℕ := ∏ p ∈ J, p.1
    t * u = q ∧ Nat.Coprime t u ∧
      t.primeFactors.card + u.primeFactors.card = q.primeFactors.card ∧
      u.primeFactors.card = J.card := by
  classical
  dsimp only
  have htu : (∏ p ∈ Finset.univ \ J, p.1) * (∏ p ∈ J, p.1) = q := by
    rw [Finset.prod_sdiff (Finset.subset_univ J)]
    exact prod_primeFactors_subtype_eq_of_squarefree hq
  have ht := prime_subtype_product_spec q hq (Finset.univ \ J)
  have hu := prime_subtype_product_spec q hq J
  have hcard (S : Finset q.primeFactors) : (S.image Subtype.val).card = S.card :=
    Finset.card_image_of_injective S Subtype.val_injective
  refine ⟨htu, Nat.coprime_of_squarefree_mul (htu.symm ▸ hq), ?_, ?_⟩
  · rw [ht.2.2, hu.2.2, hcard, hcard,
      Finset.card_sdiff_add_card_eq_card (Finset.subset_univ J),
      Finset.card_univ, Fintype.card_coe]
  · rw [hu.2.2, hcard]

theorem inactive_ambient_loss_bounds
    (q v R S r s N K j : ℕ) [NeZero q] [NeZero v] [NeZero R]
    (hvq : v ∣ q) (hω : v.primeFactors.card + j = q.primeFactors.card)
    (hK : K ≤ 3 ^ j) (hR : R ≤ r) (hS : S ≤ s) (hN : 0 < N) :
    let Hq : ℝ := 1 + Real.log (q : ℝ)
    let Hv : ℝ := 1 + Real.log (v : ℝ)
    let Cq : ℝ := (6 : ℝ) ^ q.primeFactors.card
    let Cv : ℝ := (6 : ℝ) ^ v.primeFactors.card
    let Lq : ℝ := (12 : ℝ) ^ q.primeFactors.card * (q.divisors.card : ℝ) * Hq
    let Lv : ℝ := (12 : ℝ) ^ v.primeFactors.card * (v.divisors.card : ℝ) * Hv
    ((K : ℝ) * (2 * Cv * Real.sqrt (v : ℝ) * Hv + 1) ≤
      3 * Cq * Real.sqrt (q : ℝ) * Hq) ∧
    ((K : ℝ) *
        (6 * Lv * Real.sqrt (N : ℝ) *
          (Real.sqrt (R : ℝ) + Real.sqrt (Real.sqrt (S : ℝ))) + 1) ≤
      7 * Lq * Real.sqrt (N : ℝ) *
        (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ)))) := by
  intro Hq Hv Cq Cv Lq Lv
  have hvqR : (v : ℝ) ≤ q := by exact_mod_cast Nat.le_of_dvd (NeZero.pos q) hvq
  have hHv1 : 1 ≤ Hv := le_add_of_nonneg_right (Real.log_natCast_nonneg v)
  have hHq0 : 0 ≤ Hq := by dsimp [Hq]; positivity
  have hHvq : Hv ≤ Hq :=
    add_le_add_right (Real.log_le_log (Nat.cast_pos.mpr (NeZero.pos v)) hvqR) 1
  have hdiv : (v.divisors.card : ℝ) ≤ q.divisors.card := by
    exact_mod_cast Finset.card_le_card (Nat.divisors_subset_of_dvd (NeZero.ne q) hvq)
  have hdiv1 : (1 : ℝ) ≤ v.divisors.card := by
    exact_mod_cast Finset.one_le_card.mpr ⟨1, Nat.one_mem_divisors.mpr (NeZero.ne v)⟩
  have hpower (c : ℝ) (hc : 3 ≤ c) :
      (K : ℝ) * c ^ v.primeFactors.card ≤ c ^ q.primeFactors.card := by
    have hc0 : 0 ≤ c := by linarith only [hc]
    calc
      (K : ℝ) * c ^ v.primeFactors.card ≤
          (3 : ℝ) ^ j * c ^ v.primeFactors.card := by
        gcongr
        exact_mod_cast hK
      _ ≤ c ^ j * c ^ v.primeFactors.card := by gcongr
      _ = c ^ q.primeFactors.card := by rw [← hω, pow_add]; ring
  have hC : (K : ℝ) * Cv ≤ Cq := hpower 6 (by norm_num)
  have hL : (K : ℝ) * Lv ≤ Lq := by
    calc
      (K : ℝ) * Lv =
          ((K : ℝ) * (12 : ℝ) ^ v.primeFactors.card) * v.divisors.card * Hv := by
        dsimp [Lv]
        ring
      _ ≤ (12 : ℝ) ^ q.primeFactors.card * q.divisors.card * Hq := by
        gcongr
        exact hpower 12 (by norm_num)
      _ = Lq := rfl
  have hLv1 : 1 ≤ Lv :=
    one_le_mul_of_one_le_of_one_le
      (one_le_mul_of_one_le_of_one_le (one_le_pow₀ (by norm_num)) hdiv1) hHv1
  have hbaseC : 1 ≤ Cv * Real.sqrt (v : ℝ) * Hv :=
    one_le_mul_of_one_le_of_one_le
      (one_le_mul_of_one_le_of_one_le (one_le_pow₀ (by norm_num))
        (Real.one_le_sqrt.mpr (Nat.one_le_cast.mpr (NeZero.pos v)))) hHv1
  have hroot1 : 1 ≤ Real.sqrt (R : ℝ) + Real.sqrt (Real.sqrt (S : ℝ)) :=
    (Real.one_le_sqrt.mpr (Nat.one_le_cast.mpr (NeZero.pos R))).trans
      (le_add_of_nonneg_right (Real.sqrt_nonneg _))
  have hbaseL : 1 ≤ Lv * Real.sqrt (N : ℝ) *
      (Real.sqrt (R : ℝ) + Real.sqrt (Real.sqrt (S : ℝ))) :=
    one_le_mul_of_one_le_of_one_le
      (one_le_mul_of_one_le_of_one_le hLv1
        (Real.one_le_sqrt.mpr (Nat.one_le_cast.mpr hN))) hroot1
  have hroots : Real.sqrt (R : ℝ) + Real.sqrt (Real.sqrt (S : ℝ)) ≤
      Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ)) :=
    add_le_add (Real.sqrt_le_sqrt (by exact_mod_cast hR))
      (Real.sqrt_le_sqrt (Real.sqrt_le_sqrt (by exact_mod_cast hS)))
  constructor
  · calc
      (K : ℝ) * (2 * Cv * Real.sqrt (v : ℝ) * Hv + 1) ≤
          (K : ℝ) * (3 * (Cv * Real.sqrt (v : ℝ) * Hv)) :=
        mul_le_mul_of_nonneg_left (by nlinarith only [hbaseC]) (by positivity)
      _ = 3 * ((K : ℝ) * Cv) * Real.sqrt (v : ℝ) * Hv := by ring
      _ ≤ 3 * Cq * Real.sqrt (q : ℝ) * Hq := by gcongr
  · calc
      (K : ℝ) * (6 * Lv * Real.sqrt (N : ℝ) *
          (Real.sqrt (R : ℝ) + Real.sqrt (Real.sqrt (S : ℝ))) + 1) ≤
          (K : ℝ) * (7 * (Lv * Real.sqrt (N : ℝ) *
            (Real.sqrt (R : ℝ) + Real.sqrt (Real.sqrt (S : ℝ))))) :=
        mul_le_mul_of_nonneg_left (by nlinarith only [hbaseL]) (by positivity)
      _ = 7 * ((K : ℝ) * Lv) * Real.sqrt (N : ℝ) *
          (Real.sqrt (R : ℝ) + Real.sqrt (Real.sqrt (S : ℝ))) := by ring
      _ ≤ 7 * Lq * Real.sqrt (N : ℝ) *
          (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ))) := by gcongr

theorem squarefree_lcm_pair {u v : ℕ} (hu : Squarefree u) (hv : Squarefree v) :
    Squarefree (Nat.lcm u v) := by
  apply Nat.squarefree_of_factorization_le_one (Nat.lcm_ne_zero hu.ne_zero hv.ne_zero)
  intro p
  rw [Nat.factorization_lcm hu.ne_zero hv.ne_zero, Finsupp.sup_apply]
  exact max_le (hu.natFactorization_le_one p) (hv.natFactorization_le_one p)

theorem residual_exclusive_inv_product (d t m n k : ℕ)
    [NeZero d] [NeZero t] [NeZero m] [NeZero n]
    (hdt : Nat.Coprime d t) (hmq : m ∣ d * t) (hm : Squarefree m) :
    (∏ p : t.primeFactors,
      if p.1 ∣ m ∧ ¬p.1 ∣ n ∧ ¬p.1 ∣ k then (p.1 : ℝ)⁻¹ else 1) =
        (Nat.gcd k (m / Nat.gcd m n / Nat.gcd d (m / Nat.gcd m n)) : ℝ) /
        (m / Nat.gcd m n / Nat.gcd d (m / Nat.gcd m n) : ℕ) := by
  classical
  let e := m / Nat.gcd m n
  let u := e / Nat.gcd d e
  have heS : Squarefree e := hm.squarefree_of_dvd
    (Nat.div_dvd_of_dvd (Nat.gcd_dvd_left m n))
  let _ : NeZero e := ⟨heS.ne_zero⟩
  have huS : Squarefree u := heS.squarefree_of_dvd (Nat.div_dvd_of_dvd (Nat.gcd_dvd_right d e))
  let _ : NeZero u := ⟨huS.ne_zero⟩
  have huq : u ∣ d * t := ((Nat.div_dvd_of_dvd (Nat.gcd_dvd_right d e)).trans
    (Nat.div_dvd_of_dvd (Nat.gcd_dvd_left m n))).trans hmq
  have hut : u ∣ t :=
    (show Nat.Coprime u d by
      simpa only [u, Nat.gcd_comm] using
        Nat.coprime_div_gcd_of_squarefree heS (NeZero.ne d)).dvd_of_dvd_mul_left huq
  have hchar (p : t.primeFactors) : p.1 ∣ u ↔ p.1 ∣ m ∧ ¬p.1 ∣ n := by
    have hp := Nat.prime_of_mem_primeFactors p.2
    have hpnd : ¬p.1 ∣ d := hp.coprime_iff_not_dvd.mp
      (hdt.symm.of_dvd_left (Nat.dvd_of_mem_primeFactors p.2))
    calc
      p.1 ∣ u ↔ p.1 ∈ u.primeFactors := by
        simp only [Nat.mem_primeFactors_of_ne_zero (NeZero.ne u), hp, true_and]
      _ ↔ p.1 ∈ m.primeFactors ∧ p.1 ∉ n.primeFactors ∧ p.1 ∉ d.primeFactors := by
        rw [show u = e / e.gcd d by simp [u, Nat.gcd_comm],
          Nat.primeFactors_div_gcd heS (NeZero.ne d),
          Nat.primeFactors_div_gcd hm (NeZero.ne n)]
        simp only [Finset.mem_sdiff]
        tauto
      _ ↔ p.1 ∣ m ∧ ¬p.1 ∣ n := by
        simp only [Nat.mem_primeFactors_of_ne_zero (NeZero.ne m),
          Nat.mem_primeFactors_of_ne_zero (NeZero.ne n),
          Nat.mem_primeFactors_of_ne_zero (NeZero.ne d), hp, true_and, hpnd,
          not_false_eq_true, and_true]
  calc
    _ = ∏ p : t.primeFactors, if p.1 ∣ u then
        (if ¬p.1 ∣ k then (p.1 : ℝ)⁻¹ else 1) else 1 := by
      apply Finset.prod_congr rfl
      intro p hp
      simp only [hchar p, ← ite_and, and_assoc]
    _ = ∏ p : u.primeFactors, if ¬p.1 ∣ k then (p.1 : ℝ)⁻¹ else 1 :=
      restrict_divisor_primes t u hut _
    _ = (Nat.gcd k u : ℝ) / (u : ℝ) := by
      rw [Finset.prod_coe_sort u.primeFactors
        (fun p : ℕ => if ¬p ∣ k then (p : ℝ)⁻¹ else 1)]
      simpa only [Finset.prod_filter] using inv_primes_not_dvd u huS k
    _ = _ := rfl

theorem residual_pair_mean
    (q d t : ℕ) [NeZero q] [NeZero d] [NeZero t]
    (hmul : d * t = q) (hdt : Nat.Coprime d t) (hq : Squarefree q) (hhs : Squarefree t)
    (m : Fin 2 → ℕ) (hmi : ∀ i, m i ∣ q)
    (c ℓ : Fin 2 → ℤ) :
    let ι : t.primeFactors → q.primeFactors := fun p =>
      ⟨p.1, Nat.primeFactors_mono (hmul ▸ dvd_mul_left t d) (NeZero.ne q) p.2⟩
    let I : (p : q.primeFactors) → Finset (Fin 2) := fun p =>
      Finset.univ.filter (fun i => p.1 ∣ m i)
    let M : (p : q.primeFactors) → Finset (ZMod p.1) := fun p =>
      (I p).image (fun i => -(ℓ i : ZMod p.1))
    let a : (p : q.primeFactors) → ZMod p.1 → ZMod p.1 := fun p z =>
      ∑ i ∈ I p, if -(ℓ i : ZMod p.1) = z then
        (c i : ZMod p.1) * (((m i / p.1 : ℕ) : ZMod p.1)⁻¹) else 0
    let Mt := fun p : t.primeFactors => M (ι p)
    let aT : (p : t.primeFactors) → ZMod p.1 → ZMod p.1 := fun p => a (ι p)
    let δ : Fin 2 → ℕ := fun i => m i / Nat.gcd (m 0) (m 1)
    let δ' : Fin 2 → ℕ := fun i => δ i / Nat.gcd d (δ i)
    ‖(∑ x : ZMod t, maskedReciprocalProduct t Mt aT x) / (t : ℂ)‖ ≤
      ∏ i : Fin 2, (Nat.gcd (c i).natAbs (δ' i) : ℝ) / (δ' i : ℝ) := by
  classical
  intro ι I M a Mt aT δ δ'
  have (p : t.primeFactors) : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
  have hm (i : Fin 2) : Squarefree (m i) := hq.squarefree_of_dvd (hmi i)
  have (i : Fin 2) : NeZero (m i) := ⟨(hm i).ne_zero⟩
  let U0 : Finset t.primeFactors := Finset.univ.filter
    (fun p => p.val ∣ m 0 ∧ ¬p.val ∣ m 1 ∧ ¬p.val ∣ (c 0).natAbs)
  let U1 : Finset t.primeFactors := Finset.univ.filter
    (fun p => p.val ∣ m 1 ∧ ¬p.val ∣ m 0 ∧ ¬p.val ∣ (c 1).natAbs)
  let E := U0 ∪ U1
  have hdis : Disjoint U0 U1 := by
    simp only [Finset.disjoint_left, U0, U1, Finset.mem_filter, Finset.mem_univ, true_and]
    tauto
  have honly (p : t.primeFactors) (i j : Fin 2)
      (hp : p.1 ∣ m i) (hn : ¬p.1 ∣ m j) (hnc : ¬p.1 ∣ (c i).natAbs) (hne : j ≠ i) :
      Mt p = {-(ℓ i : ZMod p.1)} ∧ aT p (-(ℓ i : ZMod p.1)) ≠ 0 := by
    have heq : I (ι p) = {i} := by
      change Finset.univ.filter (fun x : Fin 2 => p.1 ∣ m x) = {i}
      fin_cases i <;> fin_cases j <;>
        simp_all [Finset.univ_fin2, Finset.filter_insert, Finset.filter_singleton]
    have hc : (c i : ZMod p.1) ≠ 0 := fun hz => hnc (Int.natCast_dvd.mp
      ((ZMod.intCast_zmod_eq_zero_iff_dvd (c i) p.1).mp hz))
    have hw := inv_ne_zero (isUnit_cofactor_of_squarefree (hm i)
      ((Fact.out : Nat.Prime p.1).mem_primeFactors hp (hm i).ne_zero)).ne_zero
    refine ⟨by simp [Mt, M, heq], ?_⟩
    simp [aT, a, heq, ι, hc, hw]
  let z : (p : t.primeFactors) → ZMod p.1 :=
    fun p => if p ∈ U0 then -(ℓ 0 : ZMod p.1) else -(ℓ 1 : ZMod p.1)
  have hE (p : t.primeFactors) (hp : p ∈ E) : Mt p = {z p} ∧ aT p (z p) ≠ 0 := by
    by_cases hp0 : p ∈ U0
    · have hf := (Finset.mem_filter.mp hp0).2
      simpa only [z, hp0, ↓reduceIte] using honly p 0 1 hf.1 hf.2.1 hf.2.2 (by decide)
    · have hp1 : p ∈ U1 := (Finset.mem_union.mp hp).resolve_left hp0
      have hf := (Finset.mem_filter.mp hp1).2
      simpa only [z, hp0, ↓reduceIte] using honly p 1 0 hf.1 hf.2.1 hf.2.2 (by decide)
  calc
    _ ≤ ∏ p ∈ E, (p.1 : ℝ)⁻¹ :=
      (maskedReciprocalProduct_exclusive_mean t hhs Mt aT E z hE).2
    _ = _ := by
      rw [Finset.prod_union hdis]
      have hg (i j : Fin 2) :=
        residual_exclusive_inv_product d t (m i) (m j) (c i).natAbs
          hdt (hmul.symm ▸ hmi i) (hm i)
      dsimp only [δ', δ]
      rw [Fin.prod_univ_two]
      simp only [U0, U1, Finset.prod_filter, Nat.gcd_comm (m 1) (m 0), hg 0 1, hg 1 0]

theorem restrict_masked_constants
    (q d t : ℕ) [NeZero q] [NeZero t] (htq : t ∣ q) (hhs : Squarefree t)
    (hchoice : ∀ p : q.primeFactors, p.1 ∣ t ↔ ¬p.1 ∣ d)
    (M : (p : q.primeFactors) → Finset (ZMod p.1))
    (a : (p : q.primeFactors) → ZMod p.1 → ZMod p.1) (A u : ℤ) :
    let ι : t.primeFactors → q.primeFactors := fun p =>
      ⟨p.1, Nat.primeFactors_mono htq (NeZero.ne q) p.2⟩
    let Mt := fun p : t.primeFactors => M (ι p)
    let aT : (p : t.primeFactors) → ZMod p.1 → ZMod p.1 := fun p => a (ι p)
    let sign : ℂ := ∏ p : q.primeFactors, if p.1 ∣ d then
      @maskedReciprocalLocal p.1 ⟨Nat.prime_of_mem_primeFactors p.2⟩ (M p) (a p) (A : ZMod p.1)
      else 1
    maskedReciprocalProduct q M a ((A + (d : ℤ) * u : ℤ) : ZMod q) =
      sign * maskedReciprocalProduct t Mt aT ((A + (d : ℤ) * u : ℤ) : ZMod t) := by
  classical
  dsimp only
  rw [(maskedReciprocalProduct_divisor_restriction q t htq hhs M a).1
    (A + (d : ℤ) * u), maskedReciprocalProduct, ← Finset.prod_mul_distrib]
  apply Finset.prod_congr rfl
  intro p hp
  rw [← ZMod.cast_eq_val, ZMod.cast_intCast (Nat.dvd_of_mem_primeFactors p.2)]
  by_cases hpd : p.1 ∣ d
  · simp [hchoice p, hpd, Int.cast_add, Int.cast_mul,
      (ZMod.natCast_eq_zero_iff d p.1).2 hpd]
  · simp [hchoice p, hpd, Int.cast_add, Int.cast_mul]

theorem residual_to_ambient_losses (t q : ℕ) [NeZero t] [NeZero q] (htq : t ∣ q) :
    (1 + Real.log (t : ℝ) ≤ 1 + Real.log (q : ℝ)) ∧
    ((6 : ℝ) ^ t.primeFactors.card ≤ (6 : ℝ) ^ q.primeFactors.card) ∧
    ((12 : ℝ) ^ t.primeFactors.card * (t.divisors.card : ℝ) * (1 + Real.log (t : ℝ)) ≤
      (12 : ℝ) ^ q.primeFactors.card * (q.divisors.card : ℝ) * (1 + Real.log (q : ℝ))) := by
  have hprime := Finset.card_le_card (Nat.primeFactors_mono htq (NeZero.ne q))
  have hdiv : (t.divisors.card : ℝ) ≤ (q.divisors.card : ℝ) := by
    exact_mod_cast Finset.card_le_card (Nat.divisors_subset_of_dvd (NeZero.ne q) htq)
  have hlog : 1 + Real.log (t : ℝ) ≤ 1 + Real.log (q : ℝ) :=
    add_le_add_right (Real.log_le_log (by exact_mod_cast (NeZero.pos t))
      (by exact_mod_cast Nat.le_of_dvd (NeZero.pos q) htq)) 1
  refine ⟨hlog, ?_, ?_⟩ <;> gcongr <;> norm_num

end PrimeGap186
end

section
open Polynomial

universe u v w

namespace PrimeGap186

open IntermediateField

theorem trace_reciprocal_adjoin
    {K L : Type*} [Field K] [Field L] [Algebra K L]
    (x : L) (hsep : IsSeparable K x) (z : K) (hz : x ≠ algebraMap K L z) :
    Algebra.trace K K⟮x⟯
        (1 / (AdjoinSimple.gen K x - algebraMap K K⟮x⟯ z)) =
      -((minpoly K x).derivative.eval z / (minpoly K x).eval z) := by
  classical
  let E := AlgebraicClosure K
  let P := minpoly K x
  let ι := algebraMap K E
  have hx := hsep.isIntegral
  let : FiniteDimensional K K⟮x⟯ := IntermediateField.adjoin.finiteDimensional hx
  let : Algebra.IsSeparable K K⟮x⟯ :=
    (IntermediateField.isSeparable_adjoin_simple_iff_isSeparable K L).2 hsep
  have hp : P.eval z ≠ 0 := fun h ↦ hz (minpoly.root hx h).symm
  have hpE : (P.map ι).eval (ι z) ≠ 0 := by
    simpa only [Polynomial.eval_map_apply, _root_.map_ne_zero] using hp
  have hlog := ((IsAlgClosed.splits (P.map ι)).eval_derivative_div_eval_of_ne_zero hpE).symm
  simp only [Polynomial.derivative_map, Polynomial.eval_map_apply, ← map_div₀] at hlog
  have hnodup : (P.aroots E).Nodup :=
    Polynomial.nodup_roots ((Polynomial.separable_map _).mpr hsep)
  apply ι.injective
  rw [trace_eq_sum_embeddings E, map_neg, ← hlog]
  trans ∑ y : {y // y ∈ P.aroots E}, -(1 / (ι z - (y : E)))
  · let e := IntermediateField.algHomAdjoinIntegralEquiv K (K := E) hx
    apply Fintype.sum_equiv e
    intro σ
    rw [map_div₀, map_one, map_sub, σ.commutes]
    change 1 / ((e σ : E) - ι z) = -(1 / (ι z - (e σ : E)))
    rw [← neg_sub (ι z) (e σ : E), div_neg]
  · rw [Finset.sum_mem_multiset (P.aroots E)
        (fun y ↦ -(1 / (ι z - (y : E))))
        (fun y ↦ -(1 / (ι z - y))) (fun _ ↦ rfl),
      Finset.sum_eq_multiset_sum, Multiset.toFinset_val,
      Multiset.dedup_eq_self.mpr hnodup, Multiset.sum_map_neg]

theorem trace_reciprocal_phase_eq_minpoly_nsmul
    {K L : Type*} [Field K] [Field L] [Algebra K L]
    [FiniteDimensional K L]
    (M : Finset K) (a : K → K) (b c : K) (x : L)
    (hsep : IsSeparable K x)
    (hgood : ∀ z ∈ M, x ≠ algebraMap K L z) :
    Algebra.trace K L
        (algebraMap K L b * x + algebraMap K L c +
          ∑ z ∈ M, algebraMap K L (a z) / (x - algebraMap K L z)) =
      (Module.finrank K L / (minpoly K x).natDegree) •
        (c * ((minpoly K x).natDegree : K) -
          b * (minpoly K x).nextCoeff -
          ∑ z ∈ M, a z *
            ((minpoly K x).derivative.eval z / (minpoly K x).eval z)) := by
  let y : K⟮x⟯ :=
    b • AdjoinSimple.gen K x + algebraMap K K⟮x⟯ c +
      ∑ z ∈ M, a z • (1 / (AdjoinSimple.gen K x - algebraMap K K⟮x⟯ z))
  have hpoint : algebraMap K⟮x⟯ L y =
      algebraMap K L b * x + algebraMap K L c +
        ∑ z ∈ M, algebraMap K L (a z) / (x - algebraMap K L z) := by
    simp [y, Algebra.smul_def, div_eq_mul_inv]
  have hsum := Finset.sum_congr (s₁ := M) rfl fun z hz ↦
    congrArg (a z * ·) (trace_reciprocal_adjoin x hsep z (hgood z hz))
  simp only [mul_neg, Finset.sum_neg_distrib] at hsum
  have hsimple : Algebra.trace K K⟮x⟯ y =
      c * ((minpoly K x).natDegree : K) - b * (minpoly K x).nextCoeff -
        ∑ z ∈ M, a z *
          ((minpoly K x).derivative.eval z / (minpoly K x).eval z) := by
    simp only [y, map_add, map_sum, map_smul, smul_eq_mul]
    rw [trace_adjoinSimpleGen hsep.isIntegral,
      Algebra.trace_algebraMap, IntermediateField.adjoin.finrank hsep.isIntegral,
      hsum, nsmul_eq_mul]
    ring
  rw [← hpoint, ← hsimple, ← IntermediateField.adjoin.finrank hsep.isIntegral,
    Module.finrank_div_finrank_cancel_left_of_nontrivial K K⟮x⟯ L,
    ← Algebra.trace_trace (S := K⟮x⟯), Algebra.trace_algebraMap, map_nsmul]

open scoped Classical in
theorem maskedReciprocalMonicWeight_minpoly_pow_eq_masked_trace
    {K L : Type*} [Field K] [Finite K] [Field L] [Algebra K L]
    [FiniteDimensional K L]
    (ψ : AddChar K ℂ) (M : Finset K) (a : K → K) (b c : K) (x : L) :
    maskedReciprocalMonicWeight ψ M a b c (minpoly K x) ^
        (Module.finrank K L / (minpoly K x).natDegree) =
      if ∃ z ∈ M, x = algebraMap K L z then 0 else
        ψ (Algebra.trace K L
          (algebraMap K L b * x + algebraMap K L c +
            ∑ z ∈ M, algebraMap K L (a z) / (x - algebraMap K L z))) := by
  have hx : IsIntegral K x := IsIntegral.of_finite K x
  have hbad : (∃ z ∈ M, (minpoly K x).eval z = 0) ↔
      ∃ z ∈ M, x = algebraMap K L z := by
    constructor
    · rintro ⟨z, hz, hp⟩
      exact ⟨z, hz, (minpoly.root hx hp).symm⟩
    · rintro ⟨z, hz, rfl⟩
      exact ⟨z, hz, by simp [minpoly.eq_X_sub_C]⟩
  unfold maskedReciprocalMonicWeight
  simp only [hbad]
  split_ifs with hb
  · obtain ⟨z, _, rfl⟩ := hb
    simp [minpoly.eq_X_sub_C, zero_pow (Module.finrank_pos.ne')]
  · rw [trace_reciprocal_phase_eq_minpoly_nsmul M a b c x
      (Algebra.IsSeparable.isSeparable K x) (fun z hz h ↦ hb ⟨z, hz, h⟩),
      AddChar.map_nsmul_eq_pow]

end PrimeGap186
end

section
open Polynomial

universe u v w

namespace PrimeGap186

open scoped Classical in
theorem masked_extensionTraceSum_eq_neg_reciprocalRootPowerSum
    (p n : ℕ) [Fact p.Prime] [NeZero n]
    (M : Finset (ZMod p)) (a : ZMod p → ZMod p) (b c : ZMod p)
    (hactive : ∃ j ∈ M, a j ≠ 0) :
    let E := FiniteField.Extension (ZMod p) p n
    let L := maskedReciprocalEulerPolynomial p M a b c
    (∑ᶠ x : E,
      if ∃ z ∈ M, x = algebraMap (ZMod p) E z then 0 else
        ZMod.stdAddChar (Algebra.trace (ZMod p) E
          (algebraMap (ZMod p) E b * x + algebraMap (ZMod p) E c +
            ∑ z ∈ M, algebraMap (ZMod p) E (a z) /
              (x - algebraMap (ZMod p) E z)))) =
      -(L.reverse.roots.map (fun α => α ^ n)).sum := by
  classical
  intro E L
  let _ := Fintype.ofFinite E
  let I := {P : Polynomial (ZMod p) // P.Monic ∧ Irreducible P ∧ P.natDegree ≤ n}
  let _ : Finite I := finite_masked_index n
  let _ := Fintype.ofFinite I
  let s := L.reverse.roots
  have hn : n ≠ 0 := NeZero.ne n
  let d : I → ℕ := fun P => P.1.natDegree
  let w : I → ℂ := fun P => maskedReciprocalMonicWeight ZMod.stdAddChar M a b c P.1
  have hd : ∀ P, d P ≠ 0 := fun P => P.2.2.1.natDegree_pos.ne'
  let ser (P : I) : PowerSeries ℂ := PowerSeries.subst (PowerSeries.X ^ (d P))
    (PowerSeries.rescale (w P) (PowerSeries.mk 1))
  let F := ∏ P : I, ser P
  let B := ∑ P : I, PowerSeries.C (d P : ℂ) * (ser P - 1)
  let A := (s.map fun z : ℂ => (1 - PowerSeries.C z * PowerSeries.X)).prod
  let T := (s.map fun z : ℂ => PowerSeries.C (-z) * PowerSeries.X *
    PowerSeries.subst (PowerSeries.X ^ 1) (PowerSeries.rescale z (PowerSeries.mk 1))).sum
  have hF : PowerSeries.X * PowerSeries.derivative ℂ F = F * B :=
    X_mul_deriv_product d hd w
  obtain ⟨hA, hT0, hTn⟩ := root_log_derivative s
  have hB0 : PowerSeries.constantCoeff B = 0 := by
    rw [← PowerSeries.coeff_zero_eq_constantCoeff_apply]
    simp only [B, map_sum, PowerSeries.coeff_C_mul, map_sub]
    simp [ser, hd, PowerSeries.coeff_rescale, -PowerSeries.coeff_zero_eq_constantCoeff]
  have hBn : PowerSeries.coeff n B = ∑ P : I,
      if d P ∣ n then (d P : ℂ) * w P ^ (n / d P) else 0 := by
    simp only [B, map_sum, PowerSeries.coeff_C_mul, map_sub]
    simp [ser, hd, hn, mul_ite, PowerSeries.coeff_rescale]
  obtain ⟨hL0, _, hLcoeff, hLprod, _⟩ := maskedReciprocalEulerPolynomial_spec p M a b c hactive
  have hLA : (L : PowerSeries ℂ) = A := by
    simpa [A, map_multiset_prod, Multiset.map_map, Function.comp_def] using
      congrArg (Polynomial.coeToPowerSeries.ringHom : Polynomial ℂ →+* PowerSeries ℂ) hLprod
  have heq (j : ℕ) (hj : j ≤ n) : PowerSeries.coeff j F = PowerSeries.coeff j A := by
    have hcoeff := coeff_finiteEuler_maskedReciprocalMonicWeight ZMod.stdAddChar M a b c n j hj
    change PowerSeries.coeff j (∏ᶠ P : I, _) = _ at hcoeff
    rw [finprod_eq_prod_of_fintype] at hcoeff
    rw [← hLA, Polynomial.coeff_coe]
    exact hcoeff.trans (hLcoeff j).symm
  have hF0 : PowerSeries.coeff 0 F = 1 := by
    rw [heq 0 (Nat.zero_le n), ← hLA, Polynomial.coeff_coe]
    exact hL0
  have hcomp := (coeff_logderiv_of_coeff_eq hF hA hB0 hT0 hF0 heq (by rfl)).trans
    (hTn n hn)
  rw [hBn] at hcomp
  rw [finsum_eq_sum_of_fintype]
  have hfinrank : Module.finrank (ZMod p) E = n := by
    simpa using FiniteField.finrank_zmod_extension (ZMod p) p n
  have hclosed := sum_extension_monic_irred p n
    (fun P : Polynomial (ZMod p) =>
      maskedReciprocalMonicWeight ZMod.stdAddChar M a b c P ^ (n / P.natDegree))
  calc
    _ = ∑ x : E, maskedReciprocalMonicWeight ZMod.stdAddChar M a b c (minpoly (ZMod p) x) ^
        (n / (minpoly (ZMod p) x).natDegree) := by
          apply Finset.sum_congr rfl
          intro x hx
          symm
          simpa only [hfinrank] using
            maskedReciprocalMonicWeight_minpoly_pow_eq_masked_trace ZMod.stdAddChar M a b c x
    _ = ∑ P : I, if d P ∣ n then d P • (w P ^ (n / d P)) else 0 := by
      rw [Subsingleton.elim (FiniteField.instAlgebraExtension (ZMod p) p n)
        (FiniteField.instAlgebraZModExtension (ZMod p) p n)] at hclosed
      simpa only [E, d, w] using hclosed
    _ = -(s.map fun α : ℂ => α ^ n).sum := by
      simpa only [nsmul_eq_mul] using hcomp

open Classical in
theorem maskedReciprocalEulerPolynomial_roots_norm_le_sqrt
    (p : ℕ) [Fact p.Prime]
    (M : Finset (ZMod p)) (a : ZMod p → ZMod p) (b c : ZMod p)
    (hactive : ∃ z ∈ M, a z ≠ 0)
    (hs : (M.filter (fun z => a z ≠ 0)).card +
      (if b = 0 then 0 else 1) < p) :
    ∀ α ∈ (maskedReciprocalEulerPolynomial p M a b c).reverse.roots,
      ‖α‖ ≤ Real.sqrt (p : ℝ) := by
  let S := M.filter (fun z => a z ≠ 0)
  let L := maskedReciprocalEulerPolynomial p M a b c
  obtain ⟨j, hj, haj⟩ := hactive
  let s := S.card + if b = 0 then 0 else 1
  let C₁ := p * (s * (p - 1) * p + 1) + (p + 1) * (s - 1) + 1 + (M \ S).card
  have hbound : ∀ m : ℕ, 3 ≤ m → ‖(L.reverse.roots.map fun α => α ^ (2 * m)).sum‖ ≤
      (C₁ : ℝ) * (p : ℝ) ^ m := by
    intro m hm
    let _ : NeZero (2 * m) := NeZero.of_pos (by omega)
    let F := FiniteField.Extension (ZMod p) p (2 * m)
    let _ := Fintype.ofFinite F
    have heven : Module.finrank (ZMod p) F = 2 * m := by
      simpa using FiniteField.finrank_zmod_extension (ZMod p) p (2 * m)
    have hR := (rational_even_extension_fiber_and_sum_bound p S M a j b c
      (by simp [S, hj, haj]) (fun z hz => (Finset.mem_filter.mp hz).2)
      (Finset.filter_subset _ _) (show s < p from hs) m hm F heven).2.2
    have hC := masked_extensionTraceSum_eq_neg_reciprocalRootPowerSum p (2 * m) M a b c ⟨j, hj, haj⟩
    dsimp only at hC
    rw [finsum_eq_sum_of_fintype] at hC
    have hsplit : (∑ x : F,
      if ∃ z ∈ M, x = algebraMap (ZMod p) F z then 0 else
        ZMod.stdAddChar (Algebra.trace (ZMod p) F
          (algebraMap (ZMod p) F b * x + algebraMap (ZMod p) F c +
            ∑ z ∈ M, algebraMap (ZMod p) F (a z) / (x - algebraMap (ZMod p) F z)))) =
      ∑ x ∈ (Finset.univ : Finset F).filter (fun x => ∀ z ∈ M, x ≠ algebraMap (ZMod p) F z),
        ZMod.stdAddChar (Algebra.trace (ZMod p) F
          (algebraMap (ZMod p) F b * x + algebraMap (ZMod p) F c +
            ∑ z ∈ S, algebraMap (ZMod p) F (a z) / (x - algebraMap (ZMod p) F z))) := by
      rw [Finset.sum_filter]
      apply Finset.sum_congr rfl
      intro x hx
      rw [sum_active_poles (algebraMap (ZMod p) F) M a x]
      by_cases he : ∃ z ∈ M, x = algebraMap (ZMod p) F z <;> simp_all [S]
    rw [hsplit] at hC
    simpa only [hC, norm_neg] using hR
  exact bounded_even_roots _ (by exact_mod_cast (Fact.out : Nat.Prime p).pos) 3 hbound

open Classical in
theorem masked_reciprocal_primeField_sum_norm_le
    (p : ℕ) [Fact p.Prime]
    (M : Finset (ZMod p)) (a : ZMod p → ZMod p) (b c : ZMod p)
    (hactive : ∃ z ∈ M, a z ≠ 0) :
    let S := M.filter (fun z => a z ≠ 0)
    let δ : ℕ := if b = 0 then 0 else 1
    let T : ℂ := ∑ x : ZMod p,
      if x ∈ M then 0 else
        ZMod.stdAddChar (b * x + c + ∑ z ∈ M, a z / (x - z))
    ‖T‖ ≤ ((2 * S.card - 1 + δ : ℕ) : ℝ) * Real.sqrt (p : ℝ) +
      ((M \ S).card : ℝ) := by
  let S := M.filter (fun z => a z ≠ 0)
  let δ : ℕ := if b = 0 then 0 else 1
  let Q := 2 * S.card - 1 + δ
  let phase (x : ZMod p) := b * x + c + ∑ z ∈ S, a z / (x - z)
  let T : ℂ := ∑ x : ZMod p, if x ∈ M then 0 else ZMod.stdAddChar (phase x)
  obtain ⟨j, hjM, hj⟩ := hactive
  have hact : j ∈ S ∧ a j ≠ 0 := by simp [S, hjM, hj]
  have hSpos : 1 ≤ S.card := Finset.card_pos.mpr ⟨j, hact.1⟩
  have hSM : S ⊆ M := Finset.filter_subset _ _
  have hactiveS : ∃ z ∈ S, a z ≠ 0 := ⟨j, hact⟩
  have hsqrt : (1 : ℝ) ≤ Real.sqrt (p : ℝ) := Real.one_le_sqrt.mpr (by
    exact_mod_cast (Fact.out : Nat.Prime p).one_le)
  have hnorm (t : ZMod p) : ‖ZMod.stdAddChar t‖ = 1 := by
    rw [ZMod.stdAddChar_apply]
    exact Circle.norm_coe _
  have hphase (x : ZMod p) : b * x + c + ∑ z ∈ M, a z / (x - z) = phase x := by
    dsimp [phase]
    simpa using congrArg (b * x + c + ·) (sum_active_poles (RingHom.id (ZMod p)) M a x)
  change _ ≤ (Q : ℝ) * Real.sqrt (p : ℝ) + ((M \ S).card : ℝ)
  simp_rw [hphase]
  change ‖T‖ ≤ (Q : ℝ) * Real.sqrt (p : ℝ) + ((M \ S).card : ℝ)
  by_cases hs : S.card + δ < p
  swap
  · have hPQ : p ≤ Q := by
      have hbad : p ≤ S.card + δ := Nat.le_of_not_gt hs
      dsimp [Q]
      omega
    have ht : ‖T‖ ≤ (p : ℝ) := calc
      _ ≤ ∑ x : ZMod p, (1 : ℝ) := by
        apply norm_sum_le_of_le
        intro x hx
        by_cases hxM : x ∈ M <;> simp [hxM, hnorm]
      _ = p := by simp [ZMod.card]
    have hQ : (0 : ℝ) ≤ (Q : ℝ) := Nat.cast_nonneg _
    have hz : (0 : ℝ) ≤ ((M \ S).card : ℕ) := Nat.cast_nonneg _
    nlinarith [show (p : ℝ) ≤ (Q : ℝ) by exact_mod_cast hPQ,
      mul_le_mul_of_nonneg_left hsqrt hQ]
  let LS := maskedReciprocalEulerPolynomial p S a b c
  let roots := LS.reverse.roots
  have hSS : S.filter (fun z => a z ≠ 0) = S := by
    ext z
    simp [S]
  obtain ⟨_, hdegLS, _, _, hcard⟩ := maskedReciprocalEulerPolynomial_spec p S a b c hactiveS
  have hrootsCard : roots.card ≤ Q := by
    rw [hcard]
    dsimp only [δ, Q] at *
    omega
  have hrootsNorm (z : ℂ) (hz : z ∈ roots) : ‖z‖ ≤ Real.sqrt (p : ℝ) := by
    apply maskedReciprocalEulerPolynomial_roots_norm_le_sqrt p S a b c hactiveS
      (show (S.filter fun z => a z ≠ 0).card + (if b = 0 then 0 else 1) < p from by
        rw [hSS]
        exact hs) z hz
  let F := FiniteField.Extension (ZMod p) p 1
  let _ := Fintype.ofFinite F
  have hfinrank : Module.finrank (ZMod p) F = 1 := by
    simpa using FiniteField.finrank_zmod_extension (ZMod p) p 1
  let φ : ZMod p →+* F := algebraMap (ZMod p) F
  have hbij := Module.Free.bijective_algebraMap_of_finrank_eq_one hfinrank
  have hsum : (∑ x : ZMod p, if x ∈ S then 0 else ZMod.stdAddChar (phase x)) =
      -(roots.map fun z : ℂ => z ^ 1).sum := by
    have hext := masked_extensionTraceSum_eq_neg_reciprocalRootPowerSum p 1 S a b c hactiveS
    change (∑ᶠ x : F, if ∃ z ∈ S, x = φ z then 0 else
      ZMod.stdAddChar (Algebra.trace (ZMod p) F (φ b * x + φ c +
        ∑ z ∈ S, φ (a z) / (x - φ z)))) = -(roots.map (fun α : ℂ => α ^ 1)).sum at hext
    rw [finsum_eq_sum_of_fintype] at hext
    rw [← hext]
    apply Fintype.sum_bijective φ hbij
    · intro x
      have hxmask : (∃ z ∈ S, φ x = φ z) ↔ x ∈ S := by
        simp [φ.injective.eq_iff]
      have hxphase : (Algebra.trace (ZMod p) F) (φ b * φ x + φ c +
          ∑ z ∈ S, φ (a z) / (φ x - φ z)) = phase x := by
        have heq : φ b * φ x + φ c + (∑ z ∈ S, φ (a z) / (φ x - φ z)) = φ (phase x) := by
          simp [phase, map_sum, map_div₀]
        rw [heq, Algebra.trace_algebraMap, hfinrank, one_nsmul]
      by_cases hx : x ∈ S
      · simp [hxmask, hx]
      · simp [hxmask, hx, hxphase]
  have hactiveBound : ‖∑ x : ZMod p, if x ∈ S then 0 else ZMod.stdAddChar (phase x)‖ ≤
      (Q : ℝ) * Real.sqrt (p : ℝ) := calc
    _ = ‖roots.sum‖ := by rw [hsum, norm_neg]; simp
    _ ≤ (roots.map fun z => ‖z‖).sum := norm_multiset_sum_le roots
    _ ≤ (Q : ℝ) * Real.sqrt (p : ℝ) := by
      calc
        _ ≤ (roots.map fun z => ‖z‖).card • Real.sqrt (p : ℝ) := by
          apply Multiset.sum_le_card_nsmul
          intro x hx
          obtain ⟨z, hz, rfl⟩ := Multiset.mem_map.mp hx
          exact hrootsNorm z hz
        _ = (roots.card : ℝ) * Real.sqrt (p : ℝ) := by simp [nsmul_eq_mul]
        _ ≤ (Q : ℝ) * Real.sqrt (p : ℝ) := by
          exact mul_le_mul_of_nonneg_right (by exact_mod_cast hrootsCard)
            (le_trans (by norm_num) hsqrt)
  let H : ZMod p → ℂ := fun x => ZMod.stdAddChar (phase x)
  let old := (Finset.univ : Finset (ZMod p)).filter (fun x => x ∉ S)
  let extra := M \ S
  have hex : extra ⊆ old := by
    intro z hz
    exact Finset.mem_filter.mpr ⟨Finset.mem_univ _, (Finset.mem_sdiff.mp hz).2⟩
  have hset : old \ extra = (Finset.univ : Finset (ZMod p)).filter (fun x => x ∉ M) := by
    ext x
    simp only [old, extra, Finset.mem_sdiff, Finset.mem_filter, Finset.mem_univ, true_and]
    by_cases hm : x ∈ M
    · by_cases hss : x ∈ S
      · simp [hm, hss]
      · simp [hm, hss]
    · have hn : x ∉ S := by intro ht; exact hm (hSM ht)
      simp [hm, hn]
  have heqM : T = (∑ x : ZMod p, if x ∈ S then 0 else H x) - ∑ z ∈ extra, H z := by
    dsimp only [T]
    have heq := Finset.sum_sdiff_eq_sub (f := H) hex
    rw [hset, Finset.sum_filter] at heq
    symm
    simpa [H, old, Finset.sum_filter] using heq.symm
  have hexbound : ‖∑ z ∈ extra, H z‖ ≤ ((M \ S).card : ℝ) := calc
    _ ≤ ∑ z ∈ extra, (1 : ℝ) := by
      apply norm_sum_le_of_le
      intro x hx
      exact (hnorm _).le
    _ = ((M \ S).card : ℝ) := by simp [extra]
  rw [heqM]
  calc
    _ ≤ ‖(∑ x : ZMod p, if x ∈ S then 0 else H x)‖ + ‖∑ z ∈ extra, H z‖ := norm_sub_le _ _
    _ ≤ (Q : ℝ) * Real.sqrt (p : ℝ) + ((M \ S).card : ℝ) := add_le_add hactiveBound hexbound

theorem norm_dft_maskedReciprocalLocal_le_three_card_mul_sqrt
    (p : ℕ) [Fact p.Prime] (M : Finset (ZMod p)) (a : ZMod p → ZMod p)
    (hactive : ∃ z ∈ M, a z ≠ 0) (ξ : ZMod p) :
    ‖ZMod.dft (maskedReciprocalLocal p M a) ξ‖ ≤
      ((3 * M.card : ℕ) : ℝ) * Real.sqrt (p : ℝ) := by
  classical
  have hdft : ZMod.dft (maskedReciprocalLocal p M a) ξ =
      ∑ x : ZMod p, if x ∈ M then (0 : ℂ) else
        ZMod.stdAddChar (-ξ * x + 0 + ∑ z ∈ M, a z / (x - z)) := by
    rw [ZMod.dft_apply]
    apply Finset.sum_congr rfl
    intro x hx
    by_cases hh : x ∈ M
    · simp [hh, maskedReciprocalLocal]
    · simp only [maskedReciprocalLocal, ite_eq_right hh]
      rw [smul_eq_mul, ← (ZMod.stdAddChar (N := p)).map_add_eq_mul]
      simp [mul_comm]
  let S := M.filter (fun z => a z ≠ 0)
  let δ : ℕ := if -ξ = 0 then 0 else 1
  have hSpos : 1 ≤ S.card :=
    Finset.card_pos.mpr (by obtain ⟨z, hz, haz⟩ := hactive; exact ⟨z, by simp [S, hz, haz]⟩)
  have hSle : S.card ≤ M.card := Finset.card_le_card (Finset.filter_subset _ _)
  have hδ : δ ≤ 1 := by dsimp [δ]; split_ifs <;> omega
  have hcoeff : 2 * S.card - 1 + δ ≤ 2 * M.card := by omega
  have hext : (M \ S).card ≤ M.card := Finset.card_le_card Finset.sdiff_subset
  have hsqrt : (1 : ℝ) ≤ Real.sqrt (p : ℝ) := Real.one_le_sqrt.mpr (by
    exact_mod_cast (Fact.out : Nat.Prime p).one_le)
  rw [hdft]
  have hb := masked_reciprocal_primeField_sum_norm_le p M a (-ξ) 0 hactive
  change ‖(∑ x : ZMod p, if x ∈ M then (0 : ℂ) else
    ZMod.stdAddChar (-ξ * x + 0 + ∑ z ∈ M, a z / (x - z)))‖ ≤ _
  calc
    _ ≤ ((2 * S.card - 1 + δ : ℕ) : ℝ) * Real.sqrt (p : ℝ) + ((M \ S).card : ℝ) := hb
    _ ≤ ((3 * M.card : ℕ) : ℝ) * Real.sqrt (p : ℝ) := by
      have : (0 : ℝ) ≤ (M.card : ℝ) := Nat.cast_nonneg _
      have hc : (0 : ℝ) ≤ Real.sqrt (p : ℝ) := Real.sqrt_nonneg _
      have hcast : ((2 * S.card - 1 + δ : ℕ) : ℝ) ≤ ((2 * M.card : ℕ) : ℝ) := by
        exact_mod_cast hcoeff
      have hcast' : (((M \ S).card : ℕ) : ℝ) ≤ (M.card : ℝ) := by
        exact_mod_cast hext
      simp only [Nat.cast_add, Nat.cast_mul, Nat.cast_ofNat] at hcast ⊢
      nlinarith

theorem maskedReciprocalLocal_dft_norm_le
    (p : ℕ) [Fact p.Prime]
    (M : Finset (ZMod p)) (a : ZMod p → ZMod p)
    (hM : M.card ≤ 2)
    (hactive : ∃ z ∈ M, a z ≠ 0)
    (ξ : ZMod p) :
    ‖ZMod.dft (maskedReciprocalLocal p M a) ξ‖ ≤
      6 * Real.sqrt (p : ℝ) := by
  refine (norm_dft_maskedReciprocalLocal_le_three_card_mul_sqrt p M a hactive ξ).trans ?_
  apply mul_le_mul_of_nonneg_right _ (Real.sqrt_nonneg _)
  exact_mod_cast (show 3 * M.card ≤ 6 by omega)

theorem maskedReciprocalLocal_correlation_dft
    (p : ℕ) [Fact p.Prime]
    (M : Finset (ZMod p)) (a : ZMod p → ZMod p)
    (hM : M.card ≤ 2)
    (hactive : ∃ z ∈ M, a z ≠ 0) :
    ∀ h ξ : ZMod p,
      let C : ZMod p → ℂ := fun x =>
        maskedReciprocalLocal p M a (x + h) *
          star (maskedReciprocalLocal p M a x)
      (h = 0 →
        ZMod.dft C ξ =
          (if ξ = 0 then (p : ℂ) else 0) -
            ∑ z ∈ M, ZMod.stdAddChar (-(z * ξ))) ∧
      (h ≠ 0 →
        ‖ZMod.dft C ξ‖ ≤ 12 * Real.sqrt (p : ℝ)) := by
  classical
  intro h ξ C
  have htriv : ‖ZMod.dft C ξ‖ ≤ (p : ℝ) := by
    rw [ZMod.dft_apply]
    calc
      _ ≤ ∑ x : ZMod p, (1 : ℝ) := by
        apply norm_sum_le_of_le
        intro x _
        rw [norm_smul, ZMod.stdAddChar_apply, Circle.norm_coe, one_mul]
        dsimp only [C]
        rw [norm_mul, norm_star]
        simp_rw [norm_maskedReciprocalLocal]
        split_ifs <;> norm_num
      _ = p := by simp [ZMod.card]
  constructor
  · intro h0
    subst h
    let zeroRes : ZMod p → ZMod p := 0
    have hdiag : C = maskedReciprocalLocal p M zeroRes := by
      funext x
      dsimp [C]
      simp only [add_zero]
      by_cases hm : x ∈ M
      · simp [maskedReciprocalLocal, hm]
      · simp only [maskedReciprocalLocal, ite_eq_right hm]
        change ZMod.stdAddChar _ * star (ZMod.stdAddChar _) = _
        rw [star_stdAddChar_zmod, ← (ZMod.stdAddChar (N := p)).map_add_eq_mul]
        simp [AddChar.map_zero_eq_one, zeroRes]
    rw [hdiag]
    exact (maskedReciprocalLocal_inactive p M zeroRes (by intro; simp [zeroRes])).2.1 ξ
  · intro hh
    by_cases htwo : p ≤ 2
    · have hp2 : p = 2 := by have hp0 := (Fact.out : Nat.Prime p).two_le; omega
      have hsqrt : (1 : ℝ) ≤ Real.sqrt (p : ℝ) := Real.one_le_sqrt.mpr (by
        exact_mod_cast (Fact.out : Nat.Prime p).one_le)
      have hp2' : (p : ℝ) = 2 := by exact_mod_cast hp2
      exact htriv.trans (by linarith)
    · have hsize : (M.filter (fun z => a z ≠ 0)).card < p :=
        (Finset.card_filter_le M _).trans_lt (lt_of_le_of_lt hM (by omega))
      let U := M ∪ M.image (fun z => z - h)
      let d : ZMod p → ZMod p := fun z => (if z + h ∈ M then a (z + h) else 0) -
        (if z ∈ M then a z else 0)
      obtain ⟨hUle, hU⟩ := maskedReciprocalLocal_translate p M a h
      have hUactive : ∃ z ∈ U, d z ≠ 0 :=
        translatedReciprocalResidue_active p M a h hactive hsize hh
      have hfun : C = maskedReciprocalLocal p U d := funext hU
      rw [hfun]
      calc
        _ ≤ ((3 * U.card : ℕ) : ℝ) * Real.sqrt (p : ℝ) :=
          norm_dft_maskedReciprocalLocal_le_three_card_mul_sqrt p U d hUactive ξ
        _ ≤ 12 * Real.sqrt (p : ℝ) := by
          apply mul_le_mul_of_nonneg_right _ (Real.sqrt_nonneg _)
          have hcard : U.card ≤ 4 := by
            have hle : U.card ≤ 2 * M.card := hUle
            omega
          exact_mod_cast (show 3 * U.card ≤ 12 by omega)

theorem maskedReciprocalProduct_dft_norm_le
    (q : ℕ) [NeZero q] (hq : Squarefree q)
    (M : (p : q.primeFactors) → Finset (ZMod p.1))
    (a : (p : q.primeFactors) → ZMod p.1 → ZMod p.1)
    (hM : ∀ p : q.primeFactors, (M p).card ≤ 2)
    (hactive : ∀ p : q.primeFactors, ∃ z ∈ M p, a p z ≠ 0)
    (ξ : ZMod q) :
    ‖ZMod.dft (maskedReciprocalProduct q M a) ξ‖ ≤
      (6 : ℝ) ^ q.primeFactors.card * Real.sqrt (q : ℝ) := by
  classical
  have (p : q.primeFactors) : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
  have ht := (squarefree_crt_character_dft_mean q hq
    (fun p => maskedReciprocalLocal p.1 (M p) (a p))).2.1 ξ
  change ZMod.dft (maskedReciprocalProduct q M a) ξ = _ at ht
  rw [ht, norm_prod]
  calc
    _ ≤ ∏ p : q.primeFactors, (6 * Real.sqrt (p.1 : ℝ)) := by
      apply Finset.prod_le_prod (by intro i hi; exact norm_nonneg _)
      intro p hp
      apply maskedReciprocalLocal_dft_norm_le p.1 (M p) (a p) (hM p) (hactive p)
    _ = _ := by
      rw [Finset.prod_mul_distrib, Finset.prod_const]
      simp only [Finset.card_univ, Fintype.card_coe]
      have hs : (∏ p : q.primeFactors, Real.sqrt (p.1 : ℝ)) = Real.sqrt (q : ℝ) := by
        rw [← Real.sqrt_prod _ (by intro i hi; positivity)]
        have hh : (∏ p : q.primeFactors, (p.1 : ℝ)) = (q : ℝ) := by
          rw [← Nat.cast_prod]
          exact_mod_cast prod_primeFactors_subtype_eq_of_squarefree hq
        rw [hh]
      rw [hs]

theorem maskedReciprocalProduct_correlation_dft_norm_le
    (q : ℕ) [NeZero q] (hq : Squarefree q)
    (M : (p : q.primeFactors) → Finset (ZMod p.1))
    (a : (p : q.primeFactors) → ZMod p.1 → ZMod p.1)
    (hM : ∀ p : q.primeFactors, (M p).card ≤ 2)
    (hactive : ∀ p : q.primeFactors, ∃ z ∈ M p, a p z ≠ 0)
    (h : ZMod q) :
    let g : ℕ := Nat.gcd q h.val
    let C : ZMod q → ℂ := fun x =>
      maskedReciprocalProduct q M a (x + h) *
        star (maskedReciprocalProduct q M a x)
    ((∏ p ∈ q.primeFactors.filter (fun p => p ∣ h.val), p) = g) ∧
    (∀ ξ : ZMod q,
      (∏ p ∈ q.primeFactors.filter (fun p => p ∣ h.val ∧ p ∣ ξ.val), p) =
        Nat.gcd g ξ.val) ∧
    (∀ ξ : ZMod q,
      ‖ZMod.dft C ξ‖ ≤ (12 : ℝ) ^ q.primeFactors.card *
        Real.sqrt ((q / g : ℕ) : ℝ) * (Nat.gcd g ξ.val : ℝ)) ∧
    (∀ ξ : ZMod q,
      ‖ZMod.dft C ξ‖ ≤ (12 : ℝ) ^ q.primeFactors.card *
        Real.sqrt (q : ℝ) * Real.sqrt (g : ℝ)) := by
  classical
  let g := Nat.gcd q h.val
  let C : ZMod q → ℂ := fun x => maskedReciprocalProduct q M a (x + h) *
        star (maskedReciprocalProduct q M a x)
  have hs (p : q.primeFactors) : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
  have hg : g ∣ q := Nat.gcd_dvd_left _ _
  have hg0 : 0 < g := (Nat.gcd_ne_zero_left (NeZero.ne q)).bot_lt
  have hsq : Squarefree g := Squarefree.squarefree_of_dvd hg hq
  have hprod : (∏ p ∈ q.primeFactors.filter (fun p => p ∣ h.val), p) = g :=
    filter_dvd_gcd q h.val hq
  have hfilt : q.primeFactors.filter (fun p => p ∣ h.val) = g.primeFactors := by
    simpa [g] using gcd_filter (k := h.val) (NeZero.ne q)
  have hpξ (ξ : ZMod q) : (∏ p ∈ q.primeFactors.filter (fun p => p ∣ h.val ∧ p ∣ ξ.val), p) =
        Nat.gcd g ξ.val := by
    rw [← Finset.filter_filter, hfilt]
    exact filter_dvd_gcd g ξ.val hsq
  have hb (ξ : ZMod q) : ‖ZMod.dft C ξ‖ ≤
       (12 : ℝ) ^ q.primeFactors.card * Real.sqrt ((q / g : ℕ) : ℝ) * (Nat.gcd g ξ.val : ℝ) := by
    have (p : q.primeFactors) : Fact p.1.Prime := hs p
    have hident : ZMod.dft C ξ = ∏ p : q.primeFactors,
      ZMod.dft (fun u : ZMod p.1 => maskedReciprocalLocal p.1 (M p) (a p)
          (u + (h.val : ZMod p.1)) * star (maskedReciprocalLocal p.1 (M p) (a p) u))
        (((q / p.1 : ℕ) : ZMod p.1)⁻¹ * (ξ.val : ZMod p.1)) := by
      have ht := (squarefree_crt_character_dft_mean q hq (fun p u =>
        maskedReciprocalLocal p.1 (M p) (a p) (u + (h.val : ZMod p.1)) *
          star (maskedReciprocalLocal p.1 (M p) (a p) u))).2.1 ξ
      have heq : C = (fun x : ZMod q => ∏ p : q.primeFactors,
          maskedReciprocalLocal p.1 (M p) (a p) ((x.val : ZMod p.1) + (h.val : ZMod p.1)) *
            star (maskedReciprocalLocal p.1 (M p) (a p) (x.val : ZMod p.1))) := by
        funext x
        dsimp [C, maskedReciprocalProduct]
        simp only [map_prod]
        rw [← Finset.prod_mul_distrib]
        apply Finset.prod_congr rfl
        intro i _
        have hdv := Nat.dvd_of_mem_primeFactors i.property
        congr 2
        rw [← zmod_castHom_apply_eq_natCast_val hdv, map_add,
          zmod_castHom_apply_eq_natCast_val hdv, zmod_castHom_apply_eq_natCast_val hdv]
      rw [heq]
      exact ht
    rw [hident, norm_prod]
    have hoff (p : q.primeFactors) (hph : ¬p.1 ∣ h.val) :
        ‖ZMod.dft (fun u : ZMod p.1 => maskedReciprocalLocal p.1 (M p) (a p)
          (u + (h.val : ZMod p.1)) * star (maskedReciprocalLocal p.1 (M p) (a p) u))
            (((q / p.1 : ℕ) : ZMod p.1)⁻¹ * (ξ.val : ZMod p.1))‖ ≤ 12 * Real.sqrt (p.1 : ℝ) := by
      have hhph : (h.val : ZMod p.1) ≠ 0 := (ZMod.natCast_eq_zero_iff h.val p.1).not.mpr hph
      exact (maskedReciprocalLocal_correlation_dft p.1 (M p) (a p) (hM p) (hactive p)
        (h.val : ZMod p.1) (((q / p.1 : ℕ) : ZMod p.1)⁻¹ * (ξ.val : ZMod p.1))).2 hhph
    have hon (p : q.primeFactors) (hph : p.1 ∣ h.val) :
        ‖ZMod.dft (fun u : ZMod p.1 => maskedReciprocalLocal p.1 (M p) (a p)
          (u + (h.val : ZMod p.1)) * star (maskedReciprocalLocal p.1 (M p) (a p) u))
            (((q / p.1 : ℕ) : ZMod p.1)⁻¹ * (ξ.val : ZMod p.1))‖ ≤
           12 * (if p.1 ∣ ξ.val then (p.1 : ℝ) else 1) := by
      have hhph : (h.val : ZMod p.1) = 0 := (ZMod.natCast_eq_zero_iff h.val p.1).mpr hph
      simp only [hhph, add_zero]
      rw [diag_dft_local]
      by_cases hpη : ((q / p.1 : ℕ) : ZMod p.1)⁻¹ * (ξ.val : ZMod p.1) = 0
      · have hpq : p.1 ∣ ξ.val := ((cofactor_twist_zero q hq p ξ).mp hpη)
        rw [ite_eq_left hpη, ite_eq_left hpq]
        calc
          _ ≤ ‖(p.1 : ℂ)‖ + ‖(∑ z ∈ M p, ZMod.stdAddChar
            (-(z * (((q / p.1 : ℕ) : ZMod p.1)⁻¹ * (ξ.val : ZMod p.1)))))‖ := norm_sub_le _ _
          _ ≤ (p.1 : ℝ) + (M p).card := by
            rw [Complex.norm_natCast]
            have hz : ‖(∑ z ∈ M p, ZMod.stdAddChar
            (-(z * (((q / p.1 : ℕ) : ZMod p.1)⁻¹ * (ξ.val : ZMod p.1)))))‖ ≤ (M p).card :=
              (norm_sum_le _ _).trans (by simp [ZMod.stdAddChar_apply])
            exact add_le_add (le_refl _) hz
          _ ≤ 12 * (p.1 : ℝ) := by
            have hMs := hM p
            exact_mod_cast (show p.1 + (M p).card ≤ 12 * p.1 by
              have ht0 := (Fact.out : Nat.Prime p.1).two_le
              omega)
      · have hpq : ¬p.1 ∣ ξ.val := (cofactor_twist_zero q hq p ξ).not.mp hpη
        rw [ite_eq_right hpη, ite_eq_right hpq, zero_sub, norm_neg]
        calc
          _ ≤ ((M p).card : ℝ) := (norm_sum_le _ _).trans (by
            simp [ZMod.stdAddChar_apply])
          _ ≤ 12 * (1 : ℝ) := by
            have hMs := hM p
            exact_mod_cast (show (M p).card ≤ 12 by omega)
    calc
      _ ≤ ∏ t : q.primeFactors, (12 : ℝ) *
          (if t.1 ∣ h.val then (if t.1 ∣ ξ.val then (t.1 : ℝ) else 1)
             else Real.sqrt (t.1 : ℝ)) := by
        apply Finset.prod_le_prod (by intros; exact norm_nonneg _)
        intro j hj
        by_cases hph : j.1 ∣ h.val <;> simp only [hph, ite_true, ite_false]
        · exact hon j hph
        · exact hoff j hph
      _ = (12 : ℝ) ^ q.primeFactors.card * Real.sqrt ((q / g : ℕ) : ℝ) * (Nat.gcd g ξ.val : ℝ) := by
        rw [Finset.prod_mul_distrib, Finset.prod_const]
        simp only [Finset.card_univ, Fintype.card_coe]
        rw [Finset.prod_ite]
        rw [← Finset.prod_filter]
        have hs1 := hpξ ξ
        have htprod : (∏ i ∈ (Finset.univ : Finset q.primeFactors).filter
             (fun i : q.primeFactors => i.val ∣ h.val ∧ i.val ∣ ξ.val), (i.val : ℝ)) =
            Nat.gcd g ξ.val := by
          have hh' : (∏ i ∈ (Finset.univ : Finset q.primeFactors).filter
             (fun i : q.primeFactors => i.val ∣ h.val ∧ i.val ∣ ξ.val), i.val) =
              Nat.gcd g ξ.val :=
            (filtered_factor_prod q (fun s : ℕ => s ∣ h.val ∧ s ∣ ξ.val) id).trans hs1
          exact_mod_cast hh'
        have haS := Nat.prod_primeFactors_sdiff_of_squarefree hq
          (show q.primeFactors.filter (fun p => p ∣ h.val) ⊆ q.primeFactors from
            Finset.filter_subset _ _)
        have haSs : (∏ i ∈ (Finset.univ : Finset q.primeFactors).filter
             (fun i : q.primeFactors => ¬ i.val ∣ h.val), Real.sqrt (i.val : ℝ)) =
              Real.sqrt ((q / g : ℕ) : ℝ) := by
          rw [← Real.sqrt_prod _ (by intro i hi; exact Nat.cast_nonneg i.1)]
          have hraw : (∏ i ∈ (Finset.univ : Finset q.primeFactors).filter
             (fun i : q.primeFactors => ¬ i.val ∣ h.val), i.val) = q / g := by
            rw [show (∏ i ∈ (Finset.univ : Finset q.primeFactors).filter
                (fun i : q.primeFactors => ¬ i.val ∣ h.val), i.val) = _ from
                filtered_factor_prod q (fun t : ℕ => ¬ t ∣ h.val) (fun t => t)]
            rw [Finset.filter_not, haS, hprod]
          have hreal : (∏ i ∈ (Finset.univ : Finset q.primeFactors).filter
             (fun i : q.primeFactors => ¬ i.val ∣ h.val), (i.val : ℝ)) = (q / g : ℕ) := by
            exact_mod_cast hraw
          rw [hreal]
        rw [Finset.filter_filter]
        rw [haSs, htprod]
        ring
  refine ⟨hprod, hpξ, hb, ?_⟩
  intro ξ
  calc
    _ ≤ (12 : ℝ) ^ q.primeFactors.card * Real.sqrt ((q / g : ℕ) : ℝ) * (Nat.gcd g ξ.val : ℝ) := hb ξ
    _ ≤ (12 : ℝ) ^ q.primeFactors.card * Real.sqrt ((q / g : ℕ) : ℝ) * (g : ℝ) := by
      apply mul_le_mul_of_nonneg_left _ (by positivity)
      exact_mod_cast (Nat.gcd_le_left _ hg0)
    _ = _ := by
      have hp : (0 : ℝ) ≤ (g : ℝ) := Nat.cast_nonneg g
      have ha : (0 : ℝ) ≤ ((q / g : ℕ) : ℝ) := Nat.cast_nonneg _
      nth_rw 1 [← Real.mul_self_sqrt hp]
      rw [mul_assoc ((12 : ℝ) ^ q.primeFactors.card),
        ← mul_assoc (Real.sqrt ((q / g : ℕ) : ℝ)), ← Real.sqrt_mul ha]
      rw [← Nat.cast_mul, Nat.div_mul_cancel hg]
      simp only [g, mul_assoc]

theorem maskedReciprocalProduct_weighted_completion
    (q : ℕ) [NeZero q] (hq : Squarefree q)
    (M : (p : q.primeFactors) → Finset (ZMod p.1))
    (a : (p : q.primeFactors) → ZMod p.1 → ZMod p.1)
    (hM : ∀ p : q.primeFactors, (M p).card ≤ 2)
    (hactive : ∀ p : q.primeFactors, ∃ z ∈ M p, a p z ≠ 0)
    (w : ZMod q → ℂ) :
    let F : ZMod q → ℂ := maskedReciprocalProduct q M a
    (‖(∑ x : ZMod q, w x * F x) -
        (∑ x : ZMod q, w x) * (∑ x : ZMod q, F x) / (q : ℂ)‖ ≤
      ((6 : ℝ) ^ q.primeFactors.card * Real.sqrt (q : ℝ)) / (q : ℝ) *
        ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0, ‖ZMod.dft w ξ‖) ∧
    (∀ h : ZMod q,
      let g : ℕ := Nat.gcd q h.val
      let C : ZMod q → ℂ := fun x => F (x + h) * star (F x)
      ‖(∑ x : ZMod q, w x * C x) -
          (∑ x : ZMod q, w x) * (∑ x : ZMod q, C x) / (q : ℂ)‖ ≤
        ((12 : ℝ) ^ q.primeFactors.card * Real.sqrt ((q / g : ℕ) : ℝ)) /
          (q : ℝ) *
            ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0,
              ‖ZMod.dft w ξ‖ * (Nat.gcd g ξ.val : ℝ)) := by
  classical
  let F : ZMod q → ℂ := maskedReciprocalProduct q M a
  refine ⟨?_, ?_⟩
  · apply (weighted_sum_sub_mean_le_dft q w F ((6 : ℝ) ^ q.primeFactors.card * Real.sqrt q)
        (by positivity) (by
          intro i hi
          exact maskedReciprocalProduct_dft_norm_le q hq M a hM hactive i)).2
  intro h
  let g := Nat.gcd q h.val
  let C (x : ZMod q) : ℂ := F (x + h) * star (F x)
  have hb := maskedReciprocalProduct_correlation_dft_norm_le q hq M a hM hactive h
  have hfilter : ∀ ξ : ZMod q,
      (∏ p ∈ q.primeFactors.filter (fun p => p ∣ h.val ∧ p ∣ ξ.val), p) = g.gcd ξ.val := hb.2.1
  have hcong (p : q.primeFactors) (u : ZMod q) : p.val ∣ (-u).val ↔ p.val ∣ u.val := by
    have hpd := Nat.dvd_of_mem_primeFactors p.2
    simp only [← ZMod.natCast_eq_zero_iff, ← zmod_castHom_apply_eq_natCast_val hpd, map_neg,
      neg_eq_zero]
  have hgn (ξ : ZMod q) : g.gcd (-ξ).val = g.gcd ξ.val := by
    rw [← hfilter ξ, ← hfilter (-ξ)]
    congr 1
    ext p
    simp only [Finset.mem_filter]
    have hp (hmem : p ∈ q.primeFactors) := hcong ⟨p, hmem⟩ ξ
    aesop
  have hunif : ∀ ξ : ZMod q, ξ ≠ 0 → ‖ZMod.dft C ξ‖ ≤
      (12 : ℝ) ^ q.primeFactors.card * Real.sqrt q * Real.sqrt g := by
    intro k hk
    exact hb.2.2.2 k
  have hid := (weighted_sum_sub_mean_le_dft q w C
      ((12 : ℝ) ^ q.primeFactors.card * Real.sqrt q * Real.sqrt g) (by positivity) hunif).1
  change ‖(∑ x : ZMod q, w x * C x) -
      (∑ x : ZMod q, w x) * (∑ x : ZMod q, C x) / (q : ℂ)‖ ≤
      ((12 : ℝ) ^ q.primeFactors.card * Real.sqrt ((q / g : ℕ) : ℝ)) / (q : ℝ) *
            ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0, ‖ZMod.dft w ξ‖ * (Nat.gcd g ξ.val : ℝ)
  rw [hid, norm_mul, norm_inv, Complex.norm_natCast]
  have hq0 : (0 : ℝ) ≤ (q : ℝ)⁻¹ :=
    inv_nonneg.mpr (mod_cast (NeZero.one_le : 1 ≤ q).trans' (by simp))
  calc
    _ ≤ (q : ℝ)⁻¹ * (∑ i ∈ (Finset.univ : Finset (ZMod q)).erase 0,
        ‖ZMod.dft w i‖ * (12 : ℝ) ^ q.primeFactors.card * Real.sqrt ((q / g : ℕ) : ℝ) *
          (g.gcd i.val : ℝ)) := by
      gcongr
      refine norm_sum_le_of_le _ fun i _ => ?_
      rw [norm_mul]
      have hg0 := hb.2.2.1 (-i)
      rw [hgn i] at hg0
      nlinarith [mul_le_mul_of_nonneg_left hg0 (norm_nonneg (ZMod.dft w i))]
    _ = ((12 : ℝ) ^ q.primeFactors.card * Real.sqrt ((q / g : ℕ) : ℝ)) / (q : ℝ) *
        ∑ i ∈ (Finset.univ : Finset (ZMod q)).erase 0, ‖ZMod.dft w i‖ * (g.gcd i.val : ℝ) := by
      rw [div_eq_mul_inv]
      conv => rhs; rw [Finset.mul_sum]
      rw [Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro i hi
      ring

end PrimeGap186
end

namespace PrimeGap186

theorem sum_zeta_pow_factoredNumbers_le_rankin
    (j X : ℕ) (S : Finset ℕ) (σ : ℝ) (hj : 0 < j) (hσ : 0 < σ) :
    (∑ n ∈ Finset.Icc 1 X with n ∈ Nat.factoredNumbers S,
      (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ j) n : ℝ)) ≤
      (X : ℝ) ^ σ *
        ∏ p ∈ S with p.Prime, ((1 - (p : ℝ) ^ (-σ))⁻¹) ^ j := by
  classical
  obtain ⟨k, rfl⟩ := Nat.exists_eq_succ_of_ne_zero (Nat.ne_of_gt hj)
  have hprime (p : ℕ) (hp : p.Prime) : ∀ k a : ℕ,
      ((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (k + 1)) (p ^ a) =
        (a + k).choose k := by
    intro k
    induction k with
    | zero => intro a; simp [ArithmeticFunction.zeta_apply, hp.ne_zero]
    | succ k ih =>
      intro a
      rw [pow_succ, ArithmeticFunction.mul_zeta_apply, Nat.sum_divisors_prime_pow hp]
      simpa only [ih, Nat.add_assoc] using Nat.sum_range_add_choose a k
  let f : ℕ → ℝ := fun n ↦
    (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (k + 1)) n : ℝ) *
      (n : ℝ) ^ (-σ)
  have hf_nonneg (n : ℕ) : 0 ≤ f n := by positivity
  have hmult : ((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (k + 1)).IsMultiplicative :=
    ArithmeticFunction.isMultiplicative_zeta.pow
  have hf_one : f 1 = 1 := by simp [f, hmult.map_one]
  have hf_mul {m n : ℕ} (hmn : m.Coprime n) : f (m * n) = f m * f n := by
    dsimp [f]
    rw [hmult.map_mul_of_coprime hmn, Nat.cast_mul, Nat.cast_mul,
      Real.mul_rpow (Nat.cast_nonneg m) (Nat.cast_nonneg n)]
    ring
  have hprime_f (p : ℕ) (hp : p.Prime) (a : ℕ) :
      f (p ^ a) = ((a + k).choose k : ℝ) * ((p : ℝ) ^ (-σ)) ^ a := by
    dsimp [f]
    rw [hprime p hp, Nat.cast_pow,
      ← Real.rpow_natCast_mul (Nat.cast_nonneg p), mul_comm (a : ℝ),
      Real.rpow_mul_natCast (Nat.cast_nonneg p)]
  have hseries (p : ℕ) (hp : p.Prime) :
      HasSum (fun a : ℕ ↦ f (p ^ a)) (((1 - (p : ℝ) ^ (-σ))⁻¹) ^ (k + 1)) := by
    have hr : ‖(p : ℝ) ^ (-σ)‖ < 1 := by
      rw [Real.norm_of_nonneg (Real.rpow_nonneg (Nat.cast_nonneg p) _)]
      exact Real.rpow_lt_one_of_one_lt_of_neg (by exact_mod_cast hp.one_lt) (neg_neg_of_pos hσ)
    simpa only [hprime_f p hp, one_div, inv_pow] using
      hasSum_choose_mul_geometric_of_norm_lt_one k hr
  have heuler :=
    (EulerProduct.summable_and_hasSum_factoredNumbers_prod_filter_prime_tsum
      hf_one hf_mul (fun {p} hp ↦ (hseries p hp).summable.norm) S).2
  have hweighted : (∑ n ∈ Finset.Icc 1 X with n ∈ Nat.factoredNumbers S, f n) ≤
      ∏ p ∈ S with p.Prime, ((1 - (p : ℝ) ^ (-σ))⁻¹) ^ (k + 1) := by
    have hfinite := sum_le_hasSum ((Finset.Icc 1 X).subtype (· ∈ Nat.factoredNumbers S))
      (fun n _ ↦ hf_nonneg n) heuler
    rw [Finset.sum_subtype_eq_sum_filter] at hfinite
    refine hfinite.trans_eq ?_
    exact Finset.prod_congr rfl fun p hp ↦ (hseries p (Finset.mem_filter.mp hp).2).tsum_eq
  calc
    (∑ n ∈ Finset.Icc 1 X with n ∈ Nat.factoredNumbers S,
        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (k + 1)) n : ℝ)) ≤
        ∑ n ∈ Finset.Icc 1 X with n ∈ Nat.factoredNumbers S, (X : ℝ) ^ σ * f n := by
      apply Finset.sum_le_sum
      intro n hn
      obtain ⟨hnX, _⟩ := Finset.mem_filter.mp hn
      have hnpos : 0 < (n : ℝ) := by exact_mod_cast (Finset.mem_Icc.mp hnX).1
      have hnle : (n : ℝ) ^ σ ≤ (X : ℝ) ^ σ :=
        Real.rpow_le_rpow hnpos.le (by exact_mod_cast (Finset.mem_Icc.mp hnX).2) hσ.le
      calc
        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (k + 1)) n : ℝ) =
            (n : ℝ) ^ σ * f n := by
          dsimp [f]
          rw [mul_left_comm, ← Real.rpow_add hnpos, add_neg_cancel, Real.rpow_zero, mul_one]
        _ ≤ (X : ℝ) ^ σ * f n := mul_le_mul_of_nonneg_right hnle (hf_nonneg n)
    _ = (X : ℝ) ^ σ *
        ∑ n ∈ Finset.Icc 1 X with n ∈ Nat.factoredNumbers S, f n := by
      rw [Finset.mul_sum]
    _ ≤ (X : ℝ) ^ σ *
        ∏ p ∈ S with p.Prime, ((1 - (p : ℝ) ^ (-σ))⁻¹) ^ (k + 1) :=
      mul_le_mul_of_nonneg_left hweighted (Real.rpow_nonneg (Nat.cast_nonneg X) σ)

theorem prod_prime_rankin_factor_le_exp_reciprocal_sum
    (j : ℕ) (Y : ℝ) (hY : 0 < Y) (hlogY : 2 ≤ Real.log Y) :
    (∏ p ∈ Nat.primesLE ⌊Y⌋₊,
      ((1 - (p : ℝ) ^ (-(1 - 1 / Real.log Y)))⁻¹) ^ j) ≤
      Real.exp
        ((Real.exp 1 / (1 - (2 : ℝ) ^ (-(1 / 2 : ℝ)))) *
          (j : ℝ) * (∑ p ∈ Nat.primesLE ⌊Y⌋₊, (p : ℝ)⁻¹)) := by
  let Q : ℝ := (2 : ℝ) ^ (-(1 / 2 : ℝ))
  let C : ℝ := Real.exp 1 / (1 - Q)
  have hQ : Q < 1 := Real.rpow_lt_one_of_one_lt_of_neg (by norm_num) (by norm_num)
  have hden : 0 < 1 - Q := sub_pos.mpr hQ
  have hC : 0 ≤ C := div_nonneg (Real.exp_nonneg 1) hden.le
  have hlog : 0 < Real.log Y := lt_of_lt_of_le (by norm_num) hlogY
  have hinv : 1 / Real.log Y ≤ (1 / 2 : ℝ) :=
    one_div_le_one_div_of_le (by norm_num) hlogY
  have hfactor (p : ℕ) (hp : p ∈ Nat.primesLE ⌊Y⌋₊) :
      0 ≤ (1 - (p : ℝ) ^ (-(1 - 1 / Real.log Y)))⁻¹ ∧
        (1 - (p : ℝ) ^ (-(1 - 1 / Real.log Y)))⁻¹ ≤
          1 + C * (p : ℝ)⁻¹ := by
    have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast Nat.two_le_of_mem_primesLE hp
    have hp0 : (0 : ℝ) < p := lt_of_lt_of_le (by norm_num) hp2
    have hpY : (p : ℝ) ≤ Y :=
      (Nat.cast_le.mpr (Nat.le_of_mem_primesLE hp)).trans (Nat.floor_le hY.le)
    let u : ℝ := (p : ℝ) ^ (-(1 - 1 / Real.log Y))
    have hu0 : 0 ≤ u := Real.rpow_nonneg hp0.le _
    have huQ : u ≤ Q :=
      (Real.rpow_le_rpow_of_exponent_le (by linarith : (1 : ℝ) ≤ p)
        (by linarith : -(1 - 1 / Real.log Y) ≤ -(1 / 2 : ℝ))).trans
        (Real.rpow_le_rpow_of_nonpos (by norm_num) hp2 (by norm_num))
    have hdu : 0 < 1 - u := sub_pos.mpr (huQ.trans_lt hQ)
    have hue : u ≤ Real.exp 1 * (p : ℝ)⁻¹ := by
      have he : Real.exp (Real.log (p : ℝ) * (1 / Real.log Y)) ≤ Real.exp 1 := by
        apply Real.exp_le_exp.mpr
        simpa [div_eq_mul_inv] using
          (div_le_one hlog).mpr (Real.log_le_log hp0 hpY)
      dsimp [u]
      rw [show -(1 - 1 / Real.log Y) = (-1 : ℝ) + 1 / Real.log Y by ring,
        Real.rpow_add hp0, Real.rpow_neg_one, Real.rpow_def_of_pos hp0]
      simpa only [mul_comm] using mul_le_mul_of_nonneg_left he (inv_nonneg.mpr hp0.le)
    refine ⟨inv_nonneg.mpr hdu.le, ?_⟩
    change (1 - u)⁻¹ ≤ 1 + C * (p : ℝ)⁻¹
    calc
      (1 - u)⁻¹ = 1 + u / (1 - u) := by field_simp; ring
      _ ≤ 1 + u / (1 - Q) :=
        add_le_add_right
          (div_le_div_of_nonneg_left hu0 hden (sub_le_sub_left huQ 1)) 1
      _ ≤ 1 + (Real.exp 1 * (p : ℝ)⁻¹) / (1 - Q) :=
        add_le_add_right (div_le_div_of_nonneg_right hue hden.le) 1
      _ = 1 + C * (p : ℝ)⁻¹ := by dsimp [C]; ring
  have hprod :
      (∏ p ∈ Nat.primesLE ⌊Y⌋₊, (1 - (p : ℝ) ^ (-(1 - 1 / Real.log Y)))⁻¹) ≤
        Real.exp (C * ∑ p ∈ Nat.primesLE ⌊Y⌋₊, (p : ℝ)⁻¹) := by
    calc
      _ ≤ ∏ p ∈ Nat.primesLE ⌊Y⌋₊, (1 + C * (p : ℝ)⁻¹) :=
        Finset.prod_le_prod (fun p hp ↦ (hfactor p hp).1)
          (fun p hp ↦ (hfactor p hp).2)
      _ ≤ Real.exp (∑ p ∈ Nat.primesLE ⌊Y⌋₊, C * (p : ℝ)⁻¹) :=
        Real.prod_one_add_le_exp_sum _ (fun p ↦ mul_nonneg hC (by positivity))
      _ = _ := by rw [Finset.mul_sum]
  rw [Finset.prod_pow]
  calc
    _ ≤ (Real.exp (C * ∑ p ∈ Nat.primesLE ⌊Y⌋₊, (p : ℝ)⁻¹)) ^ j :=
      pow_le_pow_left₀ (Finset.prod_nonneg fun p hp ↦ (hfactor p hp).1) hprod j
    _ = _ := by rw [← Real.exp_nat_mul]; congr 1; dsimp [C, Q]; ring

open Classical in
theorem sum_card_divisors_pow_large_square_le
    (K X Y : ℕ) (hY : 0 < Y) :
    (∑ n ∈ Finset.Icc 1 X with
        ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n,
      ((Nat.divisors n).card : ℝ) ^ K) ≤
      (3 : ℝ) ^ K * (X : ℝ) *
        (1 + Real.log (X : ℝ)) ^ (2 ^ K - 1) / (Y : ℝ) := by
  let P : Finset ℕ := (Finset.Ioc Y X).filter Nat.Prime
  let A : Finset (Σ _ : ℕ, ℕ) := P.sigma (fun p => Finset.Icc 1 (X / p ^ 2))
  have himage :
      A.image (fun z : Σ _ : ℕ, ℕ => z.1 ^ 2 * z.2) =
        (Finset.Icc 1 X).filter (fun n =>
          ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n) := by
    ext n
    constructor
    · intro hn
      obtain ⟨⟨p, m⟩, hpm, rfl⟩ := Finset.mem_image.mp hn
      obtain ⟨hp, hm⟩ := Finset.mem_sigma.mp hpm
      obtain ⟨hpI, hp⟩ := Finset.mem_filter.mp hp
      obtain ⟨hmpos, hmle⟩ := Finset.mem_Icc.mp hm
      refine Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr ⟨?_, ?_⟩,
        p, hp, (Finset.mem_Ioc.mp hpI).1, ⟨m, rfl⟩⟩
      · exact Nat.mul_pos (pow_pos hp.pos 2) hmpos
      · simpa only [Nat.mul_comm] using
          (Nat.le_div_iff_mul_le (pow_pos hp.pos 2)).mp hmle
    · intro hn
      obtain ⟨hn, p, hp, hYp, ⟨m, rfl⟩⟩ := Finset.mem_filter.mp hn
      obtain ⟨hnpos, hnle⟩ := Finset.mem_Icc.mp hn
      have hpX : p ≤ X :=
        (Nat.le_of_dvd hnpos ⟨p * m, by simp [pow_two, mul_assoc]⟩).trans hnle
      refine Finset.mem_image.mpr ⟨⟨p, m⟩, Finset.mem_sigma.mpr
        ⟨Finset.mem_filter.mpr ⟨Finset.mem_Ioc.mpr ⟨hYp, hpX⟩, hp⟩,
          Finset.mem_Icc.mpr ⟨Nat.pos_of_mul_pos_left hnpos, ?_⟩⟩, rfl⟩
      exact (Nat.le_div_iff_mul_le (pow_pos hp.pos 2)).mpr
        (by simpa only [Nat.mul_comm] using hnle)
  have hweight (p m : ℕ) (hp : Nat.Prime p) :
      (((p ^ 2 * m).divisors.card : ℝ) ^ K) ≤
        (3 : ℝ) ^ K * (m.divisors.card : ℝ) ^ K := by
    have hcard : (p ^ 2 * m).divisors.card ≤ 3 * m.divisors.card := by
      calc
        _ ≤ (p ^ 2).divisors.card * m.divisors.card := by
          rw [Nat.divisors_mul]
          exact Finset.card_mul_le
        _ = _ := by simp [Nat.divisors_prime_pow hp]
    calc
      _ ≤ (3 * (m.divisors.card : ℝ)) ^ K :=
        pow_le_pow_left₀ (Nat.cast_nonneg _) (by exact_mod_cast hcard) K
      _ = _ := mul_pow _ _ _
  have hmean (p : ℕ) :
      (∑ m ∈ Finset.Icc 1 (X / p ^ 2), (m.divisors.card : ℝ) ^ K) ≤
        ((X : ℝ) / (p : ℝ) ^ 2) * (1 + Real.log (X : ℝ)) ^ (2 ^ K - 1) := by
    by_cases hM : X / p ^ 2 = 0
    · simp only [hM, Finset.Icc_eq_empty_of_lt (by decide : 0 < 1), Finset.sum_empty]
      positivity
    have hMpos : 0 < X / p ^ 2 := Nat.pos_of_ne_zero hM
    have hlog :
        1 + Real.log ((X / p ^ 2 : ℕ) : ℝ) ≤ 1 + Real.log (X : ℝ) := by
      apply add_le_add_right
      exact Real.log_le_log (by exact_mod_cast hMpos)
        (by exact_mod_cast Nat.div_le_self X (p ^ 2))
    calc
      _ ≤ ((X / p ^ 2 : ℕ) : ℝ) *
          (1 + Real.log ((X / p ^ 2 : ℕ) : ℝ)) ^ (2 ^ K - 1) :=
        sum_card_divisors_pow_le_mul_log_pow K (X / p ^ 2)
      _ ≤ ((X / p ^ 2 : ℕ) : ℝ) *
          (1 + Real.log (X : ℝ)) ^ (2 ^ K - 1) :=
        mul_le_mul_of_nonneg_left (pow_le_pow_left₀ (by positivity) hlog _) (Nat.cast_nonneg _)
      _ ≤ _ := mul_le_mul_of_nonneg_right
        (by simpa only [Nat.cast_pow] using
          (Nat.cast_div_le (m := X) (n := p ^ 2) :
            ((X / p ^ 2 : ℕ) : ℝ) ≤ (X : ℝ) / (p ^ 2 : ℕ)))
        (by positivity)
  have htail : (∑ p ∈ P, ((p : ℝ) ^ 2)⁻¹) ≤ (Y : ℝ)⁻¹ := by
    calc
      _ ≤ ∑ p ∈ Finset.Ioc Y (max Y X), ((p : ℝ) ^ 2)⁻¹ := by
        exact Finset.sum_le_sum_of_subset_of_nonneg
          ((Finset.filter_subset _ _).trans (Finset.Ioc_subset_Ioc_right (le_max_right Y X)))
          (fun _ _ _ => by positivity)
      _ ≤ (Y : ℝ)⁻¹ - ((max Y X : ℕ) : ℝ)⁻¹ :=
        sum_Ioc_inv_sq_le_sub hY.ne' (le_max_left Y X)
      _ ≤ _ := sub_le_self _ (by positivity)
  calc
    _ = ∑ z ∈ A.image (fun z : Σ _ : ℕ, ℕ => z.1 ^ 2 * z.2),
        (z.divisors.card : ℝ) ^ K := by rw [himage]
    _ ≤ ∑ z ∈ A, ((z.1 ^ 2 * z.2).divisors.card : ℝ) ^ K :=
      Finset.sum_image_le_of_nonneg (by intro n hn; positivity)
    _ = ∑ p ∈ P, ∑ m ∈ Finset.Icc 1 (X / p ^ 2),
        ((p ^ 2 * m).divisors.card : ℝ) ^ K := Finset.sum_sigma P _ _
    _ ≤ ∑ p ∈ P, (3 : ℝ) ^ K *
        (((X : ℝ) / (p : ℝ) ^ 2) * (1 + Real.log (X : ℝ)) ^ (2 ^ K - 1)) := by
      apply Finset.sum_le_sum
      intro p hp
      calc
        _ ≤ ∑ m ∈ Finset.Icc 1 (X / p ^ 2),
            (3 : ℝ) ^ K * (m.divisors.card : ℝ) ^ K :=
          Finset.sum_le_sum fun m _ => hweight p m (Finset.mem_filter.mp hp).2
        _ = (3 : ℝ) ^ K *
            ∑ m ∈ Finset.Icc 1 (X / p ^ 2), (m.divisors.card : ℝ) ^ K := by
          rw [Finset.mul_sum]
        _ ≤ _ := mul_le_mul_of_nonneg_left (hmean p) (by positivity)
    _ = (3 : ℝ) ^ K * (X : ℝ) * (1 + Real.log (X : ℝ)) ^ (2 ^ K - 1) *
        ∑ p ∈ P, ((p : ℝ) ^ 2)⁻¹ := by
      rw [Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro p hp
      ring
    _ ≤ (3 : ℝ) ^ K * (X : ℝ) * (1 + Real.log (X : ℝ)) ^ (2 ^ K - 1) *
        (Y : ℝ)⁻¹ := mul_le_mul_of_nonneg_left htail (by positivity)
    _ = _ := by rw [div_eq_mul_inv]

theorem exists_prime_reciprocal_sum_le_log_log :
    ∃ C : ℝ, 0 < C ∧ ∀ X : ℕ, 2 ≤ X →
      (∑ p ∈ Nat.primesLE X, (p : ℝ)⁻¹) ≤
        C * Real.log (Real.log (3 * (X : ℝ))) := by
  classical
  have hbound (x : ℝ) (hx : 2 ≤ x) :
      (∑ p ∈ Nat.primesLE ⌊x⌋₊, (p : ℝ)⁻¹) ≤
        Real.log 4 * (Real.log (Real.log x) - Real.log (Real.log 2) +
          (Real.log 2)⁻¹) := by
    let a : ℕ → ℝ := fun n => if Nat.Prime n then Real.log n else 0
    let f : ℝ → ℝ := fun t => t⁻¹ * (Real.log t)⁻¹
    let g : ℝ → ℝ := fun t =>
      (t ^ 2)⁻¹ / Real.log t + (t ^ 2)⁻¹ / Real.log t ^ 2
    let h : ℝ → ℝ := fun t => t⁻¹ / Real.log t + t⁻¹ / Real.log t ^ 2
    have hxpos : 0 < x := by linarith
    have hxlog : 0 < Real.log x := Real.log_pos (by linarith)
    have htdata {t : ℝ} (ht : t ∈ Set.Icc 2 x) : t ≠ 0 ∧ Real.log t ≠ 0 :=
      ⟨ne_of_gt (by linarith [ht.1]), (Real.log_pos (by linarith [ht.1])).ne'⟩
    have hdiff (t : ℝ) (ht : t ∈ Set.Icc 2 x) : DifferentiableAt ℝ f t := by
      obtain ⟨ht0, htlog⟩ := htdata ht
      dsimp [f]
      fun_prop
    have hderiv (t : ℝ) (ht : t ∈ Set.Icc 2 x) : deriv f t = -g t := by
      obtain ⟨ht0, htlog⟩ := htdata ht
      have hd1 : DifferentiableAt ℝ (fun z : ℝ => z⁻¹) t :=
        differentiableAt_inv_iff.mpr ht0
      have hd2 : DifferentiableAt ℝ (fun z : ℝ => (Real.log z)⁻¹) t := by fun_prop
      dsimp [f]
      rw [deriv_fun_mul hd1 hd2, deriv_inv, Real.deriv_inv_log_apply]
      dsimp [g]
      simp only [div_eq_mul_inv]
      ring
    have hgcont : ContinuousOn g (Set.Icc 2 x) := by
      intro t ht
      obtain ⟨ht0, htlog⟩ := htdata ht
      dsimp [g]
      fun_prop (disch := aesop)
    have hdint : IntegrableOn (deriv f) (Set.Icc 2 x) :=
      (hgcont.neg.congr fun t ht => hderiv t ht).integrableOn_Icc
    have htheta (t : ℝ) :
        (∑ k ∈ Finset.Icc 0 ⌊t⌋₊, a k) = Chebyshev.theta t := by
      rw [Chebyshev.theta_eq_sum_Icc, Finset.sum_filter]
    have hAbel := sum_mul_eq_sub_integral_mul₁ a (f := f)
      (by simp [a]) (by simp [a]) x hdiff hdint
    rw [← intervalIntegral.integral_of_le hx] at hAbel
    simp_rw [htheta] at hAbel
    have hsum : (∑ k ∈ Finset.Icc 0 ⌊x⌋₊, f k * a k) =
        ∑ p ∈ Nat.primesLE ⌊x⌋₊, (p : ℝ)⁻¹ := by
      rw [Nat.primesLE_eq_filter_Icc_zero, Finset.sum_filter]
      apply Finset.sum_congr rfl
      intro k hk
      by_cases hprime : Nat.Prime k
      · have hlogk : Real.log (k : ℝ) ≠ 0 :=
          (Real.log_pos (by exact_mod_cast hprime.one_lt)).ne'
        simp [a, f, hprime, hlogk]
      · simp [a, hprime]
    rw [hsum] at hAbel
    have hneg : (∫ t in 2..x, deriv f t * Chebyshev.theta t) =
        -(∫ t in 2..x, g t * Chebyshev.theta t) := by
      rw [← intervalIntegral.integral_neg]
      apply intervalIntegral.integral_congr
      intro t ht
      rw [Set.uIcc_of_le hx] at ht
      change deriv f t * Chebyshev.theta t = -(g t * Chebyshev.theta t)
      rw [hderiv t ht]
      ring
    rw [hneg, sub_neg_eq_add] at hAbel
    have hgtheta : IntervalIntegrable (fun t => g t * Chebyshev.theta t) volume 2 x := by
      apply (intervalIntegrable_iff_integrableOn_Icc_of_le hx).mpr
      simpa only [htheta] using
        (integrableOn_mul_sum_Icc a (m := 0) (by norm_num : 0 ≤ (2 : ℝ))
          hgcont.integrableOn_Icc)
    have hcont1 : ContinuousOn (fun t : ℝ => t⁻¹ / Real.log t) (Set.Icc 2 x) := by
      intro t ht
      obtain ⟨ht0, htlog⟩ := htdata ht
      fun_prop
    have hcont2 : ContinuousOn (fun t : ℝ => t⁻¹ / Real.log t ^ 2) (Set.Icc 2 x) := by
      intro t ht
      obtain ⟨ht0, htlog⟩ := htdata ht
      fun_prop (disch := aesop)
    have hint1 : IntervalIntegrable (fun t : ℝ => t⁻¹ / Real.log t) volume 2 x :=
      (intervalIntegrable_iff_integrableOn_Icc_of_le hx).mpr hcont1.integrableOn_Icc
    have hint2 : IntervalIntegrable (fun t : ℝ => t⁻¹ / Real.log t ^ 2) volume 2 x :=
      (intervalIntegrable_iff_integrableOn_Icc_of_le hx).mpr hcont2.integrableOn_Icc
    have hupper (t : ℝ) (ht : t ∈ Set.Icc 2 x) :
        g t * Chebyshev.theta t ≤ Real.log 4 * h t := by
      have htpos : 0 < t := by linarith [ht.1]
      have htlog : 0 < Real.log t := Real.log_pos (by linarith [ht.1])
      calc
        _ ≤ g t * (Real.log 4 * t) :=
          mul_le_mul_of_nonneg_left (Chebyshev.theta_le_log4_mul_x htpos.le)
            (by dsimp [g]; positivity)
        _ = _ := by
          dsimp [g, h]
          field_simp [htpos.ne', htlog.ne']
    have hend : f x * Chebyshev.theta x ≤ Real.log 4 / Real.log x := by
      calc
        _ ≤ f x * (Real.log 4 * x) :=
          mul_le_mul_of_nonneg_left (Chebyshev.theta_le_log4_mul_x hxpos.le)
            (by dsimp [f]; positivity)
        _ = _ := by
          dsimp [f]
          field_simp [hxpos.ne', hxlog.ne']
    calc
      _ = f x * Chebyshev.theta x + ∫ t in 2..x, g t * Chebyshev.theta t := hAbel
      _ ≤ Real.log 4 / Real.log x + Real.log 4 * ∫ t in 2..x, h t := by
        apply add_le_add hend
        calc
          _ ≤ ∫ t in 2..x, Real.log 4 * h t :=
            intervalIntegral.integral_mono_on hx hgtheta
              ((hint1.add hint2).const_mul (Real.log 4)) hupper
          _ = _ := intervalIntegral.integral_const_mul _ _
      _ = _ := by
        dsimp [h]
        rw [intervalIntegral.integral_add hint1 hint2,
          integral_inv_div_log (by norm_num) (by linarith),
          integral_inv_div_log_sq (by norm_num) (by linarith)]
        simp only [div_eq_mul_inv]
        ring
  let B : ℝ := (Real.log 2)⁻¹ - Real.log (Real.log 2)
  let b : ℝ := Real.log (Real.log 6)
  have hb : 0 < b := by
    apply Real.log_pos
    apply (Real.lt_log_iff_exp_lt (by norm_num : 0 < (6 : ℝ))).mpr
    exact Real.exp_one_lt_three.trans (by norm_num)
  have hA : 0 < Real.log (4 : ℝ) := Real.log_pos (by norm_num)
  refine ⟨Real.log 4 * (1 + |B| / b), mul_pos hA (by positivity), ?_⟩
  intro X hX
  have hXreal : 2 ≤ (X : ℝ) := by exact_mod_cast hX
  have hlogX : 0 < Real.log (X : ℝ) := Real.log_pos (by linarith)
  have hbT : b ≤ Real.log (Real.log (3 * (X : ℝ))) :=
    Real.log_le_log (Real.log_pos (by norm_num : 1 < (6 : ℝ)))
      (Real.log_le_log (by norm_num) (by linarith))
  have hmono : Real.log (Real.log (X : ℝ)) ≤
      Real.log (Real.log (3 * (X : ℝ))) :=
    Real.log_le_log hlogX (Real.log_le_log (by linarith) (by linarith))
  have habs : |B| ≤ (|B| / b) * Real.log (Real.log (3 * (X : ℝ))) := by
    calc
      _ = (|B| / b) * b := by field_simp [hb.ne']
      _ ≤ _ := mul_le_mul_of_nonneg_left hbT (by positivity)
  have hh := hbound (X : ℝ) hXreal
  simp only [Nat.floor_natCast] at hh
  calc
    _ ≤ Real.log 4 * (Real.log (Real.log (X : ℝ)) + B) := by
      simpa [B, sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using hh
    _ ≤ Real.log 4 * (Real.log (Real.log (3 * (X : ℝ))) + |B|) :=
      mul_le_mul_of_nonneg_left (add_le_add hmono (le_abs_self B)) hA.le
    _ ≤ Real.log 4 * (Real.log (Real.log (3 * (X : ℝ))) +
        (|B| / b) * Real.log (Real.log (3 * (X : ℝ)))) :=
      mul_le_mul_of_nonneg_left (add_le_add le_rfl habs) hA.le
    _ = _ := by ring

theorem exists_smooth_divisor_mass_bound (K : ℕ) :
    ∃ C : ℝ, 0 < C ∧ ∀ (X : ℕ) (Y : ℝ), 0 < X → 0 < Y → 2 ≤ Real.log Y →
      (∑ n ∈ Finset.Icc 1 X with n ∈ Nat.factoredNumbers (Nat.primesLE ⌊Y⌋₊),
        ((Nat.divisors n).card : ℝ) ^ K) ≤
        (X : ℝ) * Real.exp (-Real.log (X : ℝ) / Real.log Y) *
          (Real.log (3 * Y)) ^ C := by
  obtain ⟨H, hH, hprime⟩ := exists_prime_reciprocal_sum_le_log_log
  let D : ℝ := Real.exp 1 / (1 - (2 : ℝ) ^ (-(1 / 2 : ℝ)))
  have hD : 0 < D := div_pos (Real.exp_pos 1)
    (sub_pos.mpr (Real.rpow_lt_one_of_one_lt_of_neg (by norm_num) (by norm_num)))
  have hj : 0 < 2 ^ K := Nat.two_pow_pos K
  have hjR : (0 : ℝ) < (2 ^ K : ℕ) := Nat.cast_pos.mpr hj
  refine ⟨D * (2 ^ K : ℕ) * H, mul_pos (mul_pos hD hjR) hH, ?_⟩
  intro X Y hX hY hlogY
  have hXr : (0 : ℝ) < X := Nat.cast_pos.mpr hX
  have hY3 : 3 ≤ Y := by linarith [Real.log_le_sub_one_of_pos hY]
  have hs : 0 < 1 - 1 / Real.log Y := by
    have := one_div_le_one_div_of_le (by norm_num : (0 : ℝ) < 2) hlogY
    linarith
  have hfloor : 2 ≤ ⌊Y⌋₊ := (Nat.le_floor_iff hY.le).mpr (by norm_num; linarith)
  have hfloorR : (2 : ℝ) ≤ ⌊Y⌋₊ := by exact_mod_cast hfloor
  have hlogfloor : 0 < Real.log (3 * (⌊Y⌋₊ : ℝ)) := Real.log_pos (by linarith)
  have hlog3Y : 0 < Real.log (3 * Y) := Real.log_pos (by linarith)
  have hlogcmp : Real.log (Real.log (3 * (⌊Y⌋₊ : ℝ))) ≤
      Real.log (Real.log (3 * Y)) :=
    Real.log_le_log hlogfloor
      (Real.log_le_log (by linarith) (by linarith [Nat.floor_le hY.le]))
  have hsum : (∑ p ∈ Nat.primesLE ⌊Y⌋₊, (p : ℝ)⁻¹) ≤
      H * Real.log (Real.log (3 * Y)) :=
    (hprime ⌊Y⌋₊ hfloor).trans (mul_le_mul_of_nonneg_left hlogcmp hH.le)
  have hproduct :
      (∏ p ∈ Nat.primesLE ⌊Y⌋₊,
        ((1 - (p : ℝ) ^ (-(1 - 1 / Real.log Y)))⁻¹) ^ (2 ^ K)) ≤
        (Real.log (3 * Y)) ^ (D * (2 ^ K : ℕ) * H) := by
    apply (prod_prime_rankin_factor_le_exp_reciprocal_sum (2 ^ K) Y hY hlogY).trans
    rw [Real.rpow_def_of_pos hlog3Y]
    apply Real.exp_le_exp.mpr
    calc
      D * (2 ^ K : ℕ) * (∑ p ∈ Nat.primesLE ⌊Y⌋₊, (p : ℝ)⁻¹) ≤
          D * (2 ^ K : ℕ) * (H * Real.log (Real.log (3 * Y))) :=
        mul_le_mul_of_nonneg_left hsum (mul_nonneg hD.le hjR.le)
      _ = _ := by ring
  have hrankin := sum_zeta_pow_factoredNumbers_le_rankin (2 ^ K) X
    (Nat.primesLE ⌊Y⌋₊) (1 - 1 / Real.log Y) hj hs
  have hfilter : (Nat.primesLE ⌊Y⌋₊).filter Nat.Prime = Nat.primesLE ⌊Y⌋₊ :=
    Finset.filter_true_of_mem fun p hp ↦ Nat.prime_of_mem_primesLE hp
  rw [hfilter] at hrankin
  have hxpow : (X : ℝ) ^ (1 - 1 / Real.log Y) =
      (X : ℝ) * Real.exp (-Real.log (X : ℝ) / Real.log Y) := by
    rw [Real.rpow_def_of_pos hXr,
      show Real.log (X : ℝ) * (1 - 1 / Real.log Y) =
        Real.log (X : ℝ) + (-Real.log (X : ℝ) / Real.log Y) by ring,
      Real.exp_add, Real.exp_log hXr]
  calc
    _ ≤ ∑ n ∈ Finset.Icc 1 X with n ∈ Nat.factoredNumbers (Nat.primesLE ⌊Y⌋₊),
        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (2 ^ K)) n : ℝ) := by
      apply Finset.sum_le_sum
      intro n hn
      have hnpos : 0 < n := (Finset.mem_Icc.mp (Finset.mem_filter.mp hn).1).1
      exact_mod_cast card_divisors_pow_le_zeta_pow K n hnpos
    _ ≤ (X : ℝ) ^ (1 - 1 / Real.log Y) *
        ∏ p ∈ Nat.primesLE ⌊Y⌋₊,
          ((1 - (p : ℝ) ^ (-(1 - 1 / Real.log Y)))⁻¹) ^ (2 ^ K) := hrankin
    _ ≤ (X : ℝ) ^ (1 - 1 / Real.log Y) *
        (Real.log (3 * Y)) ^ (D * (2 ^ K : ℕ) * H) :=
      mul_le_mul_of_nonneg_left hproduct (Real.rpow_nonneg hXr.le _)
    _ = _ := by rw [hxpow]

theorem eventually_exp_neg_sqrt_log_mul_rpow_le_rpow
    (A B ε : ℝ) (hε : 0 < ε) :
    ∀ᶠ x : ℝ in Filter.atTop,
      Real.exp (-ε * Real.sqrt (Real.log x)) * (Real.log x) ^ B ≤
        (Real.log x) ^ (-A) := by
  have hlim := (tendsto_rpow_mul_exp_neg_mul_atTop_nhds_zero (2 * (A + B)) ε hε).comp
    (Real.tendsto_sqrt_atTop.comp Real.tendsto_log_atTop)
  filter_upwards [hlim.eventually (gt_mem_nhds zero_lt_one),
    Filter.eventually_gt_atTop (1 : ℝ)] with x hx hx1
  have hL : 0 < Real.log x := Real.log_pos hx1
  have hpow : Real.sqrt (Real.log x) ^ (2 * (A + B)) = (Real.log x) ^ (A + B) := by
    simpa using (Real.rpow_div_two_eq_sqrt (2 * (A + B)) hL.le).symm
  dsimp only [Function.comp_apply] at hx
  rw [hpow] at hx
  calc
    _ = ((Real.log x) ^ (A + B) * Real.exp (-ε * Real.sqrt (Real.log x))) *
        (Real.log x) ^ (-A) := by
      rw [mul_right_comm, ← Real.rpow_add hL,
        show A + B + -A = B by ring, mul_comm]
    _ ≤ 1 * (Real.log x) ^ (-A) :=
      mul_le_mul_of_nonneg_right hx.le (Real.rpow_nonneg hL.le _)
    _ = _ := one_mul _

open Classical in
theorem eventually_exceptional_divisor_mass_le
    (K : ℕ) (A B C ε T : ℝ) (hε : 0 < ε) (hT : 0 < T) :
    ∀ᶠ x : ℝ in Filter.atTop, ∀ N : ℝ,
      x ^ ε ≤ N → N ≤ x ^ C →
      (Real.log x) ^ B *
          (∑ n ∈ Finset.Icc 1 ⌊T * N⌋₊ with
            (n ∈ Nat.factoredNumbers
                (Nat.primesLE ⌊Real.exp (Real.sqrt (Real.log x))⌋₊) ∨
              ∃ p : ℕ, Nat.Prime p ∧
                Real.exp (Real.sqrt (Real.log x)) < (p : ℝ) ∧ p ^ 2 ∣ n),
            ((Nat.divisors n).card : ℝ) ^ K) ≤
        N * (Real.log x) ^ (-A) := by
  obtain ⟨D, hD, hsmooth⟩ := exists_smooth_divisor_mass_bound K
  let d : ℕ := 2 ^ K - 1
  let H : ℝ := 1 + |Real.log T| + |C|
  let Cs : ℝ := max 1 T * (2 : ℝ) ^ D
  let Cq : ℝ := 2 * (3 : ℝ) ^ K * T * H ^ d
  have hH : 0 < H := by dsimp [H]; positivity
  have hCs : 0 ≤ Cs := by dsimp [Cs]; positivity
  have hCq : 0 ≤ Cq := by dsimp [Cq]; positivity
  filter_upwards [Real.tendsto_log_atTop.eventually_ge_atTop 4,
    Real.tendsto_log_atTop.eventually_ge_atTop (Cs + Cq),
    (tendsto_rpow_atTop hε).eventually_ge_atTop (1 / T),
    Filter.eventually_gt_atTop (0 : ℝ),
    eventually_exp_neg_sqrt_log_mul_rpow_le_rpow
      (A + 1) (B + D / 2) ε hε,
    eventually_exp_neg_sqrt_log_mul_rpow_le_rpow
      (A + 1) (B + (d : ℝ)) 1 zero_lt_one] with x hxL hxconst hxT hx hsaving hqsaving
  intro N hlow hhigh
  let L : ℝ := Real.log x
  let u : ℝ := Real.sqrt L
  let Y : ℝ := Real.exp u
  let M : ℕ := ⌊Y⌋₊
  let X : ℕ := ⌊T * N⌋₊
  have hL4 : 4 ≤ L := hxL
  have hL : 0 < L := by linarith only [hL4]
  have hu2 : 2 ≤ u := by
    apply Real.le_sqrt_of_sq_le
    norm_num
    exact hL4
  have hu : 0 < u := by linarith only [hu2]
  have hLdiv : L / u = u := Real.div_sqrt
  have hY : 0 < Y := Real.exp_pos u
  have hY1 : 1 ≤ Y := Real.one_le_exp hu.le
  have hlogY : Real.log Y = u := Real.log_exp u
  have hM : 0 < M := Nat.floor_pos.mpr hY1
  have hMr : (0 : ℝ) < M := Nat.cast_pos.mpr hM
  have hN : 0 < N := (Real.rpow_pos_of_pos hx ε).trans_le hlow
  have hTN : 0 < T * N := mul_pos hT hN
  have hTN1 : 1 ≤ T * N := by
    simpa only [mul_comm] using (div_le_iff₀ hT).mp (hxT.trans hlow)
  have hX : 0 < X := Nat.floor_pos.mpr hTN1
  have hXr : (0 : ℝ) < X := Nat.cast_pos.mpr hX
  have hXle : (X : ℝ) ≤ T * N := Nat.floor_le hTN.le
  have hlogNlow : ε * L ≤ Real.log N := Real.le_log_of_rpow_le hx hlow
  have hlogNhigh : Real.log N ≤ C * L := (Real.le_rpow_iff_log_le hN hx).mp hhigh
  let s : ℝ := 1 - 1 / u
  have hs0 : 0 ≤ s := by
    have h := one_div_le_one_div_of_le (by norm_num : (0 : ℝ) < 2) hu2
    dsimp [s]
    linarith only [h]
  have hs1 : s ≤ 1 := sub_le_self 1 (by positivity)
  have hpower (z : ℝ) (hz : 0 < z) :
      z ^ s = z * Real.exp (-Real.log z / u) := by
    rw [Real.rpow_def_of_pos hz,
      show Real.log z * s = Real.log z + (-Real.log z / u) by dsimp [s]; ring,
      Real.exp_add, Real.exp_log hz]
  have hTpower : T ^ s ≤ max 1 T :=
    (Real.rpow_le_rpow hT.le (le_max_right 1 T) hs0).trans
      (Real.rpow_le_self_of_one_le (le_max_left 1 T) hs1)
  have hdecay : Real.exp (-Real.log N / u) ≤ Real.exp (-ε * u) := by
    apply Real.exp_le_exp.mpr
    have h : ε * u ≤ Real.log N / u := by
      calc
        _ = (ε * L) / u := by rw [mul_div_assoc, hLdiv]
        _ ≤ _ := div_le_div_of_nonneg_right hlogNlow hu.le
    simpa only [neg_div, neg_mul] using neg_le_neg h
  have hNpower : N ^ s ≤ N * Real.exp (-ε * u) := by
    rw [hpower N hN]
    exact mul_le_mul_of_nonneg_left hdecay hN.le
  have hprefactor :
      (X : ℝ) * Real.exp (-Real.log (X : ℝ) / u) ≤
        max 1 T * N * Real.exp (-ε * u) := by
    calc
      _ = (X : ℝ) ^ s := (hpower (X : ℝ) hXr).symm
      _ ≤ (T * N) ^ s := Real.rpow_le_rpow hXr.le hXle hs0
      _ = T ^ s * N ^ s := Real.mul_rpow hT.le hN.le
      _ ≤ max 1 T * N ^ s :=
        mul_le_mul_of_nonneg_right hTpower (Real.rpow_nonneg hN.le _)
      _ ≤ max 1 T * (N * Real.exp (-ε * u)) :=
        mul_le_mul_of_nonneg_left hNpower (by positivity)
      _ = _ := by ring
  have hlog3 : Real.log (3 : ℝ) ≤ 2 := by
    linarith only [Real.log_le_sub_one_of_pos (by norm_num : 0 < (3 : ℝ))]
  have hlog3Y : Real.log (3 * Y) = Real.log 3 + u := by
    rw [Real.log_mul (by norm_num) hY.ne', hlogY]
  have hlog3Y0 : 0 ≤ Real.log (3 * Y) := by
    rw [hlog3Y]
    exact add_nonneg (Real.log_nonneg (by norm_num)) hu.le
  have hloss :
      (Real.log (3 * Y)) ^ D ≤ (2 : ℝ) ^ D * L ^ (D / 2) := by
    calc
      _ ≤ (2 * u) ^ D :=
        Real.rpow_le_rpow hlog3Y0 (by rw [hlog3Y]; linarith only [hlog3, hu2]) hD.le
      _ = (2 : ℝ) ^ D * u ^ D := Real.mul_rpow (by norm_num) hu.le
      _ = _ := by rw [Real.rpow_div_two_eq_sqrt D hL.le]
  have hsmass :
      (∑ n ∈ Finset.Icc 1 X with n ∈ Nat.factoredNumbers (Nat.primesLE M),
        ((Nat.divisors n).card : ℝ) ^ K) ≤
        Cs * N * Real.exp (-ε * u) * L ^ (D / 2) := by
    have h := hsmooth X Y hX hY (by rw [hlogY]; exact hu2)
    rw [hlogY] at h
    calc
      _ ≤ (X : ℝ) * Real.exp (-Real.log (X : ℝ) / u) * (Real.log (3 * Y)) ^ D := h
      _ ≤ (max 1 T * N * Real.exp (-ε * u)) * ((2 : ℝ) ^ D * L ^ (D / 2)) :=
        mul_le_mul hprefactor hloss (Real.rpow_nonneg hlog3Y0 _) (by positivity)
      _ = _ := by dsimp [Cs]; ring
  have hinvM : (M : ℝ)⁻¹ ≤ 2 * Real.exp (-u) := by
    calc
      _ = 1 / (M : ℝ) := (one_div _).symm
      _ ≤ 2 / Y := (div_le_div_iff₀ hMr hY).mpr (by
        have h := Nat.div_two_lt_floor hY1
        nlinarith only [h])
      _ = _ := by simp [Y, Real.exp_neg, div_eq_mul_inv]
  have hlogX : 1 + Real.log (X : ℝ) ≤ H * L := by
    have hXlog : Real.log (X : ℝ) ≤ Real.log T + Real.log N := by
      calc
        _ ≤ Real.log (T * N) := Real.log_le_log hXr hXle
        _ = _ := Real.log_mul hT.ne' hN.ne'
    have hTlog : Real.log T ≤ |Real.log T| * L :=
      (le_abs_self _).trans
        (le_mul_of_one_le_right (abs_nonneg _) (by linarith only [hL4]))
    have hClog : C * L ≤ |C| * L :=
      mul_le_mul_of_nonneg_right (le_abs_self C) hL.le
    dsimp [H]
    nlinarith only [hXlog, hlogNhigh, hTlog, hClog, hL4]
  have hglobal :
      (1 + Real.log (X : ℝ)) ^ d ≤ H ^ d * L ^ (d : ℝ) := by
    calc
      _ ≤ (H * L) ^ d := pow_le_pow_left₀ (by positivity) hlogX d
      _ = H ^ d * L ^ d := mul_pow _ _ _
      _ = _ := by rw [Real.rpow_natCast]
  have hpredicate (n : ℕ) :
      (∃ p : ℕ, Nat.Prime p ∧ Y < (p : ℝ) ∧ p ^ 2 ∣ n) ↔
        ∃ p : ℕ, Nat.Prime p ∧ M < p ∧ p ^ 2 ∣ n := by
    constructor
    · rintro ⟨p, hp, hpY, hpn⟩
      exact ⟨p, hp, (Nat.floor_lt' hp.ne_zero).mpr hpY, hpn⟩
    · rintro ⟨p, hp, hpM, hpn⟩
      exact ⟨p, hp, (Nat.floor_lt' hp.ne_zero).mp hpM, hpn⟩
  have hqmass :
      (∑ n ∈ Finset.Icc 1 X with
          ∃ p : ℕ, Nat.Prime p ∧ Y < (p : ℝ) ∧ p ^ 2 ∣ n,
        ((Nat.divisors n).card : ℝ) ^ K) ≤
        Cq * N * Real.exp (-u) * L ^ (d : ℝ) := by
    have htail :
        (∑ n ∈ Finset.Icc 1 X with
            ∃ p : ℕ, Nat.Prime p ∧ Y < (p : ℝ) ∧ p ^ 2 ∣ n,
          ((Nat.divisors n).card : ℝ) ^ K) ≤
          (3 : ℝ) ^ K * (X : ℝ) * (1 + Real.log (X : ℝ)) ^ d / (M : ℝ) := by
      simpa only [hpredicate, d] using sum_card_divisors_pow_large_square_le K X M hM
    have hmean :
        (3 : ℝ) ^ K * (X : ℝ) * (1 + Real.log (X : ℝ)) ^ d ≤
          (3 : ℝ) ^ K * (T * N) * (H ^ d * L ^ (d : ℝ)) :=
      mul_le_mul (mul_le_mul_of_nonneg_left hXle (by positivity)) hglobal
        (by positivity) (by positivity)
    calc
      _ ≤ (3 : ℝ) ^ K * (X : ℝ) * (1 + Real.log (X : ℝ)) ^ d / (M : ℝ) := htail
      _ = (3 : ℝ) ^ K * (X : ℝ) * (1 + Real.log (X : ℝ)) ^ d * (M : ℝ)⁻¹ :=
        div_eq_mul_inv _ _
      _ ≤ ((3 : ℝ) ^ K * (T * N) * (H ^ d * L ^ (d : ℝ))) * (2 * Real.exp (-u)) :=
        mul_le_mul hmean hinvM (inv_nonneg.mpr hMr.le) (by positivity)
      _ = _ := by dsimp [Cq]; ring
  have hor :
      (∑ n ∈ Finset.Icc 1 X with
          (n ∈ Nat.factoredNumbers (Nat.primesLE M) ∨
            ∃ p : ℕ, Nat.Prime p ∧ Y < (p : ℝ) ∧ p ^ 2 ∣ n),
        ((Nat.divisors n).card : ℝ) ^ K) ≤
        (∑ n ∈ Finset.Icc 1 X with n ∈ Nat.factoredNumbers (Nat.primesLE M),
          ((Nat.divisors n).card : ℝ) ^ K) +
        (∑ n ∈ Finset.Icc 1 X with
            ∃ p : ℕ, Nat.Prime p ∧ Y < (p : ℝ) ∧ p ^ 2 ∣ n,
          ((Nat.divisors n).card : ℝ) ^ K) := by
    rw [Finset.filter_or]
    exact (le_add_of_nonneg_right
      (Finset.sum_nonneg (fun n _ => by positivity))).trans_eq Finset.sum_union_inter
  have hqsaving' :
      Real.exp (-u) * L ^ (B + (d : ℝ)) ≤ L ^ (-(A + 1)) := by
    simpa only [neg_one_mul] using hqsaving
  have hcancel : L * L ^ (-(A + 1)) = L ^ (-A) := by
    calc
      _ = L ^ (1 : ℝ) * L ^ (-(A + 1)) := by rw [Real.rpow_one]
      _ = L ^ ((1 : ℝ) + (-(A + 1))) := (Real.rpow_add hL _ _).symm
      _ = _ := by congr 1; ring
  change L ^ B *
      (∑ n ∈ Finset.Icc 1 X with
        (n ∈ Nat.factoredNumbers (Nat.primesLE M) ∨
          ∃ p : ℕ, Nat.Prime p ∧ Y < (p : ℝ) ∧ p ^ 2 ∣ n),
        ((Nat.divisors n).card : ℝ) ^ K) ≤ N * L ^ (-A)
  calc
    _ ≤ L ^ B *
        ((∑ n ∈ Finset.Icc 1 X with n ∈ Nat.factoredNumbers (Nat.primesLE M),
            ((Nat.divisors n).card : ℝ) ^ K) +
          (∑ n ∈ Finset.Icc 1 X with
              ∃ p : ℕ, Nat.Prime p ∧ Y < (p : ℝ) ∧ p ^ 2 ∣ n,
            ((Nat.divisors n).card : ℝ) ^ K)) :=
      mul_le_mul_of_nonneg_left hor (Real.rpow_nonneg hL.le _)
    _ ≤ L ^ B * (Cs * N * Real.exp (-ε * u) * L ^ (D / 2) +
        Cq * N * Real.exp (-u) * L ^ (d : ℝ)) :=
      mul_le_mul_of_nonneg_left (add_le_add hsmass hqmass) (Real.rpow_nonneg hL.le _)
    _ = N * (Cs * (Real.exp (-ε * u) * L ^ (B + D / 2)) +
        Cq * (Real.exp (-u) * L ^ (B + (d : ℝ)))) := by
      rw [Real.rpow_add hL, Real.rpow_add hL]
      ring
    _ ≤ N * (Cs * L ^ (-(A + 1)) + Cq * L ^ (-(A + 1))) :=
      mul_le_mul_of_nonneg_left
        (add_le_add (mul_le_mul_of_nonneg_left hsaving hCs)
          (mul_le_mul_of_nonneg_left hqsaving' hCq)) hN.le
    _ = N * ((Cs + Cq) * L ^ (-(A + 1))) := by ring
    _ ≤ N * (L * L ^ (-(A + 1))) :=
      mul_le_mul_of_nonneg_left
        (mul_le_mul_of_nonneg_right hxconst (Real.rpow_nonneg hL.le _)) hN.le
    _ = _ := by rw [hcancel]

theorem sum_zeta_pow_succ_le_mul_harmonic_pow (k U : ℕ) :
    (∑ n ∈ Finset.Icc 1 U,
      (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (k + 1)) n : ℝ)) ≤
      (U : ℝ) * (harmonic U : ℝ) ^ k := by
  have hz := congrArg (fun z : ℕ => (z : ℝ))
    (ArithmeticFunction.sum_Ioc_mul_zeta_eq_sum
      ((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ k) U)
  push_cast at hz
  rw [← Finset.Icc_succ_left_eq_Ioc (0 : ℕ) U] at hz
  simp only [ArithmeticFunction.natCoe_nat, ← pow_succ] at hz
  calc
    _ = ∑ n ∈ Finset.Icc 1 U,
        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ k) n : ℝ) *
          ((U / n : ℕ) : ℝ) := hz
    _ ≤ ∑ n ∈ Finset.Icc 1 U,
        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ k) n : ℝ) *
          ((U : ℝ) / (n : ℝ)) := by
      apply Finset.sum_le_sum
      intro n _
      exact mul_le_mul_of_nonneg_left Nat.cast_div_le (Nat.cast_nonneg _)
    _ = (U : ℝ) * ∑ n ∈ Finset.Icc 1 U,
        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ k) n : ℝ) / (n : ℝ) := by
      rw [Finset.mul_sum]
      exact Finset.sum_congr rfl fun n _ => by ring
    _ ≤ _ := mul_le_mul_of_nonneg_left
      (sum_zeta_pow_div_le_harmonic_pow k U) (Nat.cast_nonneg U)

theorem sum_zeta_pow_modEq_le
    (j X q a : ℕ) (hj : 2 ≤ j) (hX : 0 < X) (hq : 0 < q)
    (ha : Nat.Coprime a q) :
    (∑ n ∈ Finset.Icc 1 X with Nat.ModEq q n a,
      (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ j) n : ℝ)) ≤
      (j : ℝ) *
        ((X : ℝ) / (q : ℝ) * (1 + Real.log (X : ℝ)) ^ (j - 1) +
          (X : ℝ) ^ (1 - 1 / (j : ℝ)) *
            (1 + Real.log (X : ℝ)) ^ (j - 2)) := by
  classical
  have hAP (q a m M : ℕ) (ha : Nat.Coprime a q) :
      ({t ∈ Finset.Icc 1 M | Nat.ModEq q (m * t) a}.card : ℝ) ≤
        (M : ℝ) / (q : ℝ) + 1 := by
    have hcard : {t ∈ Finset.Icc 1 M | Nat.ModEq q (m * t) a}.card ≤ M / q + 1 := by
      calc
        _ ≤ (Finset.Icc 0 (M / q)).card := by
          apply Finset.card_le_card_of_injOn (fun t : ℕ ↦ t / q)
          · intro t ht
            exact Finset.mem_Icc.mpr ⟨Nat.zero_le _,
              Nat.div_le_div_right (Finset.mem_Icc.mp (Finset.mem_filter.mp ht).1).2⟩
          · intro t ht u hu heq
            have htmod := (Finset.mem_filter.mp ht).2
            have humod := (Finset.mem_filter.mp hu).2
            have hmt : Nat.Coprime (m * t) q := htmod.gcd_eq.trans ha
            exact Nat.ext_div_modEq heq (Nat.ModEq.cancel_left_of_coprime
              hmt.coprime_mul_right.symm (htmod.trans humod.symm))
        _ = M / q + 1 := by simp
    calc
      _ ≤ ((M / q + 1 : ℕ) : ℝ) := by exact_mod_cast hcard
      _ ≤ _ := by
        push_cast
        linarith [Nat.cast_div_le (m := M) (n := q) (α := ℝ)]
  have hresidual (k X : ℕ) (f : Fin (k + 2) → ℕ) (i : Fin (k + 2))
      (hfX : (∏ b, f b) ≤ X) (himax : ∀ b, f b ≤ f i) :
      ((∏ b, Fin.removeNth i f b : ℕ) : ℝ) ≤
        (X : ℝ) ^ (1 - 1 / ((k + 2 : ℕ) : ℝ)) := by
    let m := ∏ b, Fin.removeNth i f b
    let t := f i
    change (m : ℝ) ≤ _
    have hprod : t * m = ∏ b, f b := Fin.mul_prod_removeNth i f
    have hmt : m ≤ t ^ (k + 1) := by
      simpa [m, t] using
        Finset.prod_le_pow_card (Finset.univ : Finset (Fin (k + 1)))
          (Fin.removeNth i f) (f i) (fun b _ ↦ himax (i.succAbove b))
    have hpow : m ^ (k + 2) ≤ X ^ (k + 1) := by
      calc
        _ = m ^ (k + 1) * m := pow_succ m (k + 1)
        _ ≤ m ^ (k + 1) * t ^ (k + 1) := Nat.mul_le_mul_left _ hmt
        _ = (m * t) ^ (k + 1) := (mul_pow m t (k + 1)).symm
        _ ≤ X ^ (k + 1) := Nat.pow_le_pow_left (by simpa [mul_comm, hprod] using hfX) _
    have hroot : (m : ℝ) ≤ ((X : ℝ) ^ (k + 1)) ^ (((k + 2 : ℕ) : ℝ)⁻¹) := by
      apply (Real.le_rpow_inv_iff_of_pos (Nat.cast_nonneg m) (by positivity) (by positivity)).mpr
      rw [Real.rpow_natCast]
      exact_mod_cast hpow
    refine hroot.trans_eq ?_
    rw [← Real.rpow_natCast, ← Real.rpow_mul (Nat.cast_nonneg X)]
    congr 1
    push_cast
    field_simp
    ring
  have hcard (j n : ℕ) :
      (Nat.finMulAntidiag j n).card =
        ((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ j) n := by
    induction j generalizing n with
    | zero =>
      by_cases hn : n = 1
      · subst n
        simp [Nat.finMulAntidiag_one]
      · simp [Nat.finMulAntidiag_zero_left hn, hn]
    | succ j ih =>
      rw [pow_succ, ArithmeticFunction.mul_zeta_apply]
      calc
        (Nat.finMulAntidiag (j + 1) n).card =
            (n.divisorsAntidiagonal.sigma fun ab => Nat.finMulAntidiag j ab.2).card := by
          refine Finset.card_nbij'
            (fun f => ⟨(f 0, ∏ i, Fin.tail f i), Fin.tail f⟩)
            (fun x => Fin.cons x.1.1 x.2) ?_ ?_ ?_ ?_
          · intro f hf
            have hp : (f 0, ∏ i, Fin.tail f i) ∈ n.divisorsAntidiagonal :=
              Nat.mem_divisorsAntidiagonal.mpr
                ⟨(Fin.prod_univ_succ f).symm.trans (Nat.mem_finMulAntidiag.mp hf).1,
                  (Nat.mem_finMulAntidiag.mp hf).2⟩
            exact Finset.mem_sigma.mpr ⟨hp, Nat.mem_finMulAntidiag.mpr
              ⟨rfl, Nat.right_ne_zero_of_mem_divisorsAntidiagonal hp⟩⟩
          · rintro ⟨⟨a, b⟩, t⟩ ht
            rcases Finset.mem_sigma.mp ht with ⟨hab, ht⟩
            rcases Nat.mem_divisorsAntidiagonal.mp hab with ⟨hab, hn⟩
            refine Nat.mem_finMulAntidiag.mpr ⟨?_, hn⟩
            rw [Fin.prod_cons, (Nat.mem_finMulAntidiag.mp ht).1]
            exact hab
          · intro f _
            exact Fin.cons_self_tail f
          · rintro ⟨⟨a, b⟩, t⟩ ht
            have htprod := (Nat.mem_finMulAntidiag.mp (Finset.mem_sigma.mp ht).2).1
            simp only [Fin.cons_zero, Fin.tail_cons, htprod]
        _ = ∑ ab ∈ n.divisorsAntidiagonal, (Nat.finMulAntidiag j ab.2).card :=
          Finset.card_sigma _ _
        _ = ∑ d ∈ n.divisors, (Nat.finMulAntidiag j d).card :=
          Nat.sum_divisorsAntidiagonal' (fun _ d => (Nat.finMulAntidiag j d).card)
        _ = ∑ d ∈ n.divisors, ((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ j) d :=
          Finset.sum_congr rfl fun d _ => ih d
  have hHbound (U X : ℕ) (hUX : U ≤ X) :
      (harmonic U : ℝ) ≤ 1 + Real.log (X : ℝ) := by
    have hH : harmonic U ≤ harmonic X := by
      unfold harmonic
      apply Finset.sum_le_sum_of_subset_of_nonneg (Finset.range_mono hUX)
      intro n _ _
      positivity
    calc
      _ ≤ (harmonic X : ℝ) := by exact_mod_cast hH
      _ ≤ _ := harmonic_le_one_add_log X
  have hcover (k X q a : ℕ) :
      ({n ∈ Finset.Icc 1 X | Nat.ModEq q n a}.sigma fun n =>
        Nat.finMulAntidiag (k + 2) n).card ≤
      (k + 2) * ∑ m ∈ Finset.Icc 1
          ⌊(X : ℝ) ^ (1 - 1 / ((k + 2 : ℕ) : ℝ))⌋₊,
        (Nat.finMulAntidiag (k + 1) m).card *
          {t ∈ Finset.Icc 1 (X / m) | Nat.ModEq q (m * t) a}.card := by
    let U := ⌊(X : ℝ) ^ (1 - 1 / ((k + 2 : ℕ) : ℝ))⌋₊
    let A (m : ℕ) := {t ∈ Finset.Icc 1 (X / m) | Nat.ModEq q (m * t) a}
    let D : Finset (Fin (k + 2) × (Σ _ : ℕ, (Fin (k + 1) → ℕ) × ℕ)) :=
      Finset.univ ×ˢ ((Finset.Icc 1 U).sigma fun m =>
        Nat.finMulAntidiag (k + 1) m ×ˢ A m)
    change _ ≤ (k + 2) * ∑ m ∈ Finset.Icc 1 U,
      (Nat.finMulAntidiag (k + 1) m).card * (A m).card
    calc
      _ ≤ D.card := by
        apply Finset.card_le_card_of_surjOn
          (fun x : Fin (k + 2) × (Σ _ : ℕ, (Fin (k + 1) → ℕ) × ℕ) =>
            (⟨x.2.1 * x.2.2.2, Fin.insertNth x.1 x.2.2.2 x.2.2.1⟩ :
              Σ _ : ℕ, Fin (k + 2) → ℕ))
        rintro ⟨n, f⟩ hnf
        rcases Finset.mem_sigma.mp hnf with ⟨hn, hf⟩
        rcases Finset.mem_filter.mp hn with ⟨hnX, hnmod⟩
        rcases Finset.mem_Icc.mp hnX with ⟨_, hnX⟩
        obtain ⟨i, _, himax⟩ :=
          Finset.exists_max_image (Finset.univ : Finset (Fin (k + 2))) f
            ⟨0, Finset.mem_univ 0⟩
        let g := Fin.removeNth i f
        let m := ∏ b, g b
        let t := f i
        have htm : t * m = n :=
          (Fin.mul_prod_removeNth i f).trans (Nat.mem_finMulAntidiag.mp hf).1
        have hmt : m * t = n := (Nat.mul_comm m t).trans htm
        have htm0 : t * m ≠ 0 := htm.symm ▸ (Nat.mem_finMulAntidiag.mp hf).2
        have hm0 : 0 < m := Nat.pos_of_ne_zero (right_ne_zero_of_mul htm0)
        have ht0 : 0 < t := Nat.pos_of_ne_zero (left_ne_zero_of_mul htm0)
        have hmU : m ≤ U := Nat.le_floor
          (hresidual k X f i
            ((Nat.mem_finMulAntidiag.mp hf).1.le.trans hnX)
            (fun b => himax b (Finset.mem_univ b)))
        have htX : t ≤ X / m :=
          (Nat.le_div_iff_mul_le hm0).mpr (htm.le.trans hnX)
        have htA : t ∈ A m := Finset.mem_filter.mpr
          ⟨Finset.mem_Icc.mpr ⟨ht0, htX⟩, hmt.symm ▸ hnmod⟩
        refine ⟨(i, ⟨m, (g, t)⟩), ?_, ?_⟩
        · exact Finset.mem_product.mpr ⟨Finset.mem_univ i, Finset.mem_sigma.mpr
            ⟨Finset.mem_Icc.mpr ⟨hm0, hmU⟩, Finset.mem_product.mpr
              ⟨Nat.mem_finMulAntidiag.mpr ⟨rfl, Nat.ne_of_gt hm0⟩, htA⟩⟩⟩
        · change (⟨m * t, Fin.insertNth i t g⟩ : Σ _ : ℕ, Fin (k + 2) → ℕ) = ⟨n, f⟩
          rw [hmt, show Fin.insertNth i t g = f from Fin.insertNth_self_removeNth i f]
      _ = _ := by
        simp only [D, Finset.card_product, Finset.card_univ, Fintype.card_fin,
          Finset.card_sigma]
  obtain ⟨k, rfl⟩ : ∃ k, j = k + 2 := ⟨j - 2, (Nat.sub_add_cancel hj).symm⟩
  let R := (X : ℝ) ^ (1 - 1 / ((k + 2 : ℕ) : ℝ))
  let U := ⌊R⌋₊
  let L := 1 + Real.log (X : ℝ)
  let A (m : ℕ) := {t ∈ Finset.Icc 1 (X / m) | Nat.ModEq q (m * t) a}
  have hRX : R ≤ (X : ℝ) :=
    Real.rpow_le_self_of_one_le (by exact_mod_cast hX)
      (Nat.one_sub_one_div_cast_le_one (k + 2))
  have hUX : U ≤ X := Nat.floor_le_of_le hRX
  have hUR : (U : ℝ) ≤ R := Nat.floor_le (by dsimp [R]; positivity)
  have hHnonneg : 0 ≤ (harmonic U : ℝ) := by unfold harmonic; positivity
  have hHL : (harmonic U : ℝ) ≤ L := hHbound U X hUX
  have hrec : (∑ m ∈ Finset.Icc 1 U,
      (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (k + 1)) m : ℝ) /
        (m : ℝ)) ≤ L ^ (k + 1) :=
    (sum_zeta_pow_div_le_harmonic_pow (k + 1) U).trans
      (pow_le_pow_left₀ hHnonneg hHL (k + 1))
  have hmean : (∑ m ∈ Finset.Icc 1 U,
      (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (k + 1)) m : ℝ)) ≤
      R * L ^ k :=
    (sum_zeta_pow_succ_le_mul_harmonic_pow k U).trans
      (mul_le_mul hUR (pow_le_pow_left₀ hHnonneg hHL k)
      (pow_nonneg hHnonneg k) (by dsimp [R]; positivity))
  have hAPm (m : ℕ) : ((A m).card : ℝ) ≤
      (X : ℝ) / ((m : ℝ) * (q : ℝ)) + 1 := by
    calc
      _ ≤ ((X / m : ℕ) : ℝ) / (q : ℝ) + 1 := hAP q a m (X / m) ha
      _ ≤ _ := by
        have hd := div_le_div_of_nonneg_right
          (Nat.cast_div_le (m := X) (n := m) (α := ℝ)) (Nat.cast_nonneg q)
        rw [div_div] at hd
        linarith
  have hcount : (∑ n ∈ Finset.Icc 1 X with Nat.ModEq q n a,
      (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (k + 2)) n : ℝ)) ≤
      ((k + 2 : ℕ) : ℝ) * ∑ m ∈ Finset.Icc 1 U,
        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (k + 1)) m : ℝ) *
          ((A m).card : ℝ) := by
    have hc := hcover k X q a
    rw [Finset.card_sigma] at hc
    simp_rw [hcard] at hc
    exact_mod_cast hc
  have hsplit : (∑ m ∈ Finset.Icc 1 U,
      (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (k + 1)) m : ℝ) *
        ((X : ℝ) / ((m : ℝ) * (q : ℝ)) + 1)) =
      (X : ℝ) / (q : ℝ) * (∑ m ∈ Finset.Icc 1 U,
        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (k + 1)) m : ℝ) /
          (m : ℝ)) +
        ∑ m ∈ Finset.Icc 1 U,
          (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (k + 1)) m : ℝ) := by
    rw [Finset.mul_sum, ← Finset.sum_add_distrib]
    apply Finset.sum_congr rfl
    intro m hm
    have hmne : (m : ℝ) ≠ 0 := by
      exact_mod_cast (Nat.ne_of_gt (Finset.mem_Icc.mp hm).1)
    have hqne : (q : ℝ) ≠ 0 := by exact_mod_cast hq.ne'
    field_simp [hmne, hqne]
  change (∑ n ∈ Finset.Icc 1 X with Nat.ModEq q n a,
      (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (k + 2)) n : ℝ)) ≤
    ((k + 2 : ℕ) : ℝ) * ((X : ℝ) / (q : ℝ) * L ^ (k + 1) + R * L ^ k)
  calc
    _ ≤ ((k + 2 : ℕ) : ℝ) * ∑ m ∈ Finset.Icc 1 U,
        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (k + 1)) m : ℝ) *
          ((A m).card : ℝ) := hcount
    _ ≤ ((k + 2 : ℕ) : ℝ) * ∑ m ∈ Finset.Icc 1 U,
        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (k + 1)) m : ℝ) *
          ((X : ℝ) / ((m : ℝ) * (q : ℝ)) + 1) := by
      apply mul_le_mul_of_nonneg_left _ (Nat.cast_nonneg _)
      apply Finset.sum_le_sum
      intro m _
      exact mul_le_mul_of_nonneg_left (hAPm m) (Nat.cast_nonneg _)
    _ = ((k + 2 : ℕ) : ℝ) *
        ((X : ℝ) / (q : ℝ) * (∑ m ∈ Finset.Icc 1 U,
          (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (k + 1)) m : ℝ) /
            (m : ℝ)) +
          ∑ m ∈ Finset.Icc 1 U,
            (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (k + 1)) m : ℝ)) := by
      rw [hsplit]
    _ ≤ _ := mul_le_mul_of_nonneg_left
      (add_le_add (mul_le_mul_of_nonneg_left hrec
        (div_nonneg (Nat.cast_nonneg X) (Nat.cast_nonneg q))) hmean) (Nat.cast_nonneg _)

theorem eventually_real_divisor_majorant
    (C₀ D : ℝ) :
    ∃ j : ℕ, 2 ≤ j ∧
      ∀ᶠ x : ℝ in Filter.atTop, ∀ n : ℕ, 0 < n →
        D * ((Nat.divisors n).card : ℝ) ^ C₀ * (Real.log x) ^ C₀ ≤
          (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ j) n : ℝ) *
            (Real.log x) ^ (C₀ + 1) := by
  let K := ⌈C₀⌉₊ + 1
  refine ⟨2 ^ K, ?_, ?_⟩
  · exact le_self_pow₀ (by decide) (Nat.succ_ne_zero _)
  have hC : C₀ ≤ (K : ℝ) := Nat.le_of_ceil_le (Nat.le_succ _)
  have hdiv (n : ℕ) (hn : 0 < n) :
      ((Nat.divisors n).card : ℝ) ^ C₀ ≤
        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (2 ^ K)) n : ℝ) := by
    have hτ : (1 : ℝ) ≤ ((Nat.divisors n).card : ℝ) := by
      exact_mod_cast Finset.one_le_card.mpr ⟨1, Nat.one_mem_divisors.mpr hn.ne'⟩
    exact (Real.rpow_le_rpow_of_exponent_le hτ hC).trans
      (by exact_mod_cast card_divisors_pow_le_zeta_pow K n hn)
  filter_upwards [Real.tendsto_log_atTop.eventually_ge_atTop (max 1 D)] with x hx n hn
  have hL : 0 < Real.log x := lt_of_lt_of_le zero_lt_one ((le_max_left 1 D).trans hx)
  have hDL : D ≤ Real.log x := (le_max_right 1 D).trans hx
  calc
    _ ≤ Real.log x * ((Nat.divisors n).card : ℝ) ^ C₀ * (Real.log x) ^ C₀ :=
      mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_right hDL (Real.rpow_nonneg (Nat.cast_nonneg _) C₀))
        (Real.rpow_nonneg hL.le C₀)
    _ ≤ Real.log x *
        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (2 ^ K)) n : ℝ) *
          (Real.log x) ^ C₀ :=
      mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_left (hdiv n hn) hL.le)
        (Real.rpow_nonneg hL.le C₀)
    _ = _ := by rw [Real.rpow_add_one hL.ne']; ring

section
open Set
/--
The iterated integral construction for the Dickman function, starting from the constant `1` and
applying `f ↦ 1 - ∫₁^max(1,x) f(t - 1) / max(1,t) dt` at each stage.
-/
noncomputable def dickmanApproximation : ℕ → ℝ → ℝ :=
  Nat.rec (motive := fun _ => ℝ → ℝ)
    (fun _ => 1)
    (fun _ previous x =>
      1 - ∫ t in (1 : ℝ)..max 1 x, previous (t - 1) / max 1 t)

/--
The Dickman function defined by taking `⌈x⌉₊` integral-iteration steps for `x ≥ 0`, and extended
by zero to negative inputs.
-/
noncomputable def dickmanRho (x : ℝ) : ℝ :=
  if x < 0 then 0 else dickmanApproximation ⌈x⌉₊ x

theorem dickmanRho_analytic :
    (∀ x : ℝ, x < 0 → dickmanRho x = 0) ∧
    (∀ x ∈ Set.Icc (0 : ℝ) 1, dickmanRho x = 1) ∧
    ContinuousOn dickmanRho (Set.Ici 0) ∧
    Measurable dickmanRho ∧
    (∀ x : ℝ, 1 < x →
      HasDerivAt dickmanRho (-(dickmanRho (x - 1) / x)) x) ∧
    (∀ x : ℝ, 0 ≤ dickmanRho x ∧ dickmanRho x ≤ 1) ∧
    AntitoneOn dickmanRho (Set.Ici 0) ∧
    (∀ x : ℝ, 0 ≤ x →
      x * dickmanRho x =
        ∫ t in max 0 (x - 1)..x, dickmanRho t) := by
  let core (x : ℝ) : ℝ := dickmanApproximation ⌈x⌉₊ x
  have continuous_approximation (n : ℕ) : Continuous (dickmanApproximation n) := by
    induction n with
    | zero => exact continuous_const
    | succ n ih =>
        have hk : Continuous (fun t : ℝ => dickmanApproximation n (t-1) / max 1 t) := by
          apply (ih.comp (continuous_id.sub continuous_const)).div
            (continuous_const.max continuous_id)
          intro t
          exact ne_of_gt (lt_of_lt_of_le zero_lt_one (le_max_left 1 t))
        have hp : Continuous (fun x : ℝ =>
            ∫ t in (1 : ℝ)..x, dickmanApproximation n (t-1) / max 1 t) :=
          (intervalIntegral.differentiable_integral_of_continuous hk).continuous
        exact continuous_const.sub (hp.comp (continuous_const.max continuous_id))
  have approximation_succ_eq (n : ℕ) {x : ℝ}
      (hx : x ≤ (n : ℝ)+1) : dickmanApproximation (n+1) x = dickmanApproximation n x := by
    induction n generalizing x with
    | zero => simp [dickmanApproximation, max_eq_left (by simpa using hx)]
    | succ n ih =>
        change (1 - ∫ t in (1 : ℝ)..max 1 x,
          dickmanApproximation (n+1) (t-1) / max 1 t) =
          1 - ∫ t in (1 : ℝ)..max 1 x, dickmanApproximation n (t-1) / max 1 t
        congr 1
        apply intervalIntegral.integral_congr
        intro t ht
        rw [uIcc_of_le (le_max_left 1 x)] at ht
        have htop : max 1 x ≤ (n : ℝ)+2 := by
          apply max_le
          · linarith [Nat.cast_nonneg (α := ℝ) n]
          · push_cast at hx
            linarith
        change dickmanApproximation (n+1) (t-1) / max 1 t =
          dickmanApproximation n (t-1) / max 1 t
        rw [ih (x := t-1) (by linarith [ht.2])]
  have approximation_eq_of_le {m n : ℕ} (hmn : m ≤ n) {x : ℝ}
      (hx : x ≤ (m : ℝ)+1) : dickmanApproximation n x = dickmanApproximation m x := by
    induction n, hmn using Nat.le_induction with
    | base => rfl
    | succ n hmn ih =>
        have hmreal : (m : ℝ) ≤ n := by exact_mod_cast hmn
        rw [approximation_succ_eq n (by linarith), ih]
  have core_eq_approximation (n : ℕ) {x : ℝ}
      (hx : x ≤ (n : ℝ)+1) : core x = dickmanApproximation n x := by
    unfold core
    rcases le_total ⌈x⌉₊ n with h | h
    · exact (approximation_eq_of_le h (by linarith [Nat.le_ceil x])).symm
    · exact approximation_eq_of_le h hx
  have core_eq_one {x : ℝ} (hx : x ≤ 1) : core x = 1 := by
    simpa only [dickmanApproximation, Nat.rec_zero] using
      core_eq_approximation 0 (by simpa using hx)
  have continuous_core : Continuous core := by
    rw [continuous_iff_continuousAt]
    intro x
    let n : ℕ := ⌈x⌉₊+1
    have hx : x < (n : ℝ)+1 := by
      dsimp [n]
      push_cast
      linarith [Nat.le_ceil x]
    apply (continuous_approximation n).continuousAt.congr_of_eventuallyEq
    filter_upwards [eventually_lt_nhds hx] with y hy
    exact core_eq_approximation n hy.le
  have core_integral (x : ℝ) :
      core x = 1 - ∫ t in (1 : ℝ)..max 1 x, core (t-1) / max 1 t := by
    let n : ℕ := ⌈x⌉₊
    have hx : x ≤ (n : ℝ)+1 := by
      dsimp [n]
      linarith [Nat.le_ceil x]
    rw [core_eq_approximation (n+1) (by push_cast; linarith)]
    change (1 - ∫ t in (1 : ℝ)..max 1 x,
      dickmanApproximation n (t-1) / max 1 t) =
      1 - ∫ t in (1 : ℝ)..max 1 x, core (t-1) / max 1 t
    congr 1
    apply intervalIntegral.integral_congr
    intro t ht
    rw [uIcc_of_le (le_max_left 1 x)] at ht
    have htop : max 1 x ≤ (n : ℝ)+1 :=
      max_le (by linarith [Nat.cast_nonneg (α := ℝ) n]) hx
    change dickmanApproximation n (t-1) / max 1 t = core (t-1) / max 1 t
    rw [core_eq_approximation n (x := t-1) (by linarith [ht.2])]
  have hasDerivAt_core {x : ℝ} (hx : 1 < x) :
      HasDerivAt core (-(core (x-1)/x)) x := by
    let k : ℝ → ℝ := fun t => core (t-1) / max 1 t
    have hk : Continuous k := by
      apply (continuous_core.comp (continuous_id.sub continuous_const)).div
        (continuous_const.max continuous_id)
      intro t
      exact ne_of_gt (lt_of_lt_of_le zero_lt_one (le_max_left 1 t))
    have hp := (intervalIntegral.integral_hasDerivAt_right
      (hk.intervalIntegrable 1 x) hk.aestronglyMeasurable.stronglyMeasurableAtFilter
      hk.continuousAt).const_sub 1
    have heq : core =ᶠ[𝓝 x] (fun y => 1 - ∫ t in (1 : ℝ)..y, k t) := by
      filter_upwards [eventually_gt_nhds hx] with y hy
      simpa only [max_eq_right hy.le] using core_integral y
    simpa only [k, max_eq_right hx.le] using hp.congr_of_eventuallyEq heq
  have rho_of_neg {x : ℝ} (hx : x < 0) : dickmanRho x = 0 := by simp [dickmanRho, hx]
  have rho_eq_core {x : ℝ} (hx : 0 ≤ x) : dickmanRho x = core x := by
    simp [dickmanRho, core, not_lt.mpr hx]
  have rho_eq_one {x : ℝ} (hx0 : 0 ≤ x) (hx1 : x ≤ 1) : dickmanRho x = 1 := by
    rw [rho_eq_core hx0, core_eq_one hx1]
  have hasDerivAt_rho {x : ℝ} (hx : 1 < x) :
      HasDerivAt dickmanRho (-(dickmanRho (x-1)/x)) x := by
    have heq : dickmanRho =ᶠ[𝓝 x] core := by
      filter_upwards [eventually_gt_nhds (show 0 < x by linarith)] with y hy
      exact rho_eq_core hy.le
    rw [rho_eq_core (by linarith)]
    exact (hasDerivAt_core hx).congr_of_eventuallyEq heq
  have core_renewal {x : ℝ} (hx : 1 ≤ x) :
      x * core x = ∫ t in x-1..x, core t := by
    have hderiv : ∀ t ∈ Ioo 1 x,
        HasDerivAt (fun t => t * core t) (core t-core (t-1)) t := by
      intro t ht
      have ht0 : t ≠ 0 := ne_of_gt (lt_trans zero_lt_one ht.1)
      have hd : HasDerivAt (fun u : ℝ => u*core u)
          (1*core t+t*(-(core (t-1)/t))) t :=
        (hasDerivAt_id t).mul (hasDerivAt_core ht.1)
      have heq : 1*core t+t*(-(core (t-1)/t)) = core t-core (t-1) := by
        field_simp [ht0]
        ring
      rwa [heq] at hd
    have hshift : Continuous (fun t : ℝ => core (t-1)) :=
      continuous_core.comp (continuous_id.sub continuous_const)
    have hFTC := intervalIntegral.integral_eq_sub_of_hasDerivAt_of_le hx
      (continuous_id.mul continuous_core).continuousOn hderiv
      ((continuous_core.sub hshift).intervalIntegrable 1 x)
    change (∫ t in (1 : ℝ)..x, core t-core (t-1)) = x*core x-1*core 1 at hFTC
    rw [intervalIntegral.integral_sub (continuous_core.intervalIntegrable 1 x)
      (hshift.intervalIntegrable 1 x),
      intervalIntegral.integral_comp_sub_right] at hFTC
    have hunit : (∫ t in (0 : ℝ)..1, core t) = 1 := by
      calc
        (∫ t in (0 : ℝ)..1, core t) = ∫ _ in (0 : ℝ)..1, (1 : ℝ) := by
          apply intervalIntegral.integral_congr
          intro t ht
          rw [uIcc_of_le zero_le_one] at ht
          exact core_eq_one ht.2
        _ = 1 := by simp
    have hleft : (∫ t in (0 : ℝ)..1, core t) + (∫ t in (1 : ℝ)..x, core t) =
        ∫ t in (0 : ℝ)..x, core t :=
      intervalIntegral.integral_add_adjacent_intervals
        (continuous_core.intervalIntegrable (0 : ℝ) 1)
        (continuous_core.intervalIntegrable 1 x)
    have hright : (∫ t in (0 : ℝ)..(x-1), core t) + (∫ t in (x-1)..x, core t) =
        ∫ t in (0 : ℝ)..x, core t :=
      intervalIntegral.integral_add_adjacent_intervals
        (continuous_core.intervalIntegrable (0 : ℝ) (x-1))
        (continuous_core.intervalIntegrable (x-1) x)
    simp only [sub_self, one_mul, core_eq_one (x := 1) le_rfl] at hFTC
    linarith
  have core_nonneg_upto (n : ℕ) :
      ∀ x : ℝ, x ≤ (n : ℝ)+1 → 0 ≤ core x := by
    induction n with
    | zero =>
        intro x hx
        rw [core_eq_one (by simpa using hx)]
        exact zero_le_one
    | succ n ih =>
        let a : ℝ := (n : ℝ)+1
        let b : ℝ := (n : ℝ)+2
        have ha : 0 < a := by dsimp [a]; positivity
        have ha1 : 1 ≤ a := by dsimp [a]; linarith [Nat.cast_nonneg (α := ℝ) n]
        have hab : a < b := by dsimp [a, b]; linarith
        have hb1 : 1 ≤ b := ha1.trans hab.le
        have hanti : AntitoneOn core (Icc a b) := by
          apply antitoneOn_of_hasDerivWithinAt_nonpos (convex_Icc a b)
            continuous_core.continuousOn
            (f' := fun t => -(core (t-1)/t))
          · intro t ht
            rw [interior_Icc] at ht
            exact (hasDerivAt_core (lt_of_le_of_lt ha1 ht.1)).hasDerivWithinAt
          · intro t ht
            rw [interior_Icc] at ht
            apply neg_nonpos.mpr
            apply div_nonneg
            · apply ih
              dsimp [b] at ht
              linarith [ht.2]
            · exact (lt_trans ha ht.1).le
        have hrenewal := core_renewal hb1
        have hbm1 : b-1 = a := by dsimp [a, b]; ring
        rw [hbm1] at hrenewal
        have hint : core b ≤ ∫ t in a..b, core t := by
          have hbound : (∫ _ in a..b, core b) ≤ ∫ t in a..b, core t :=
            intervalIntegral.integral_mono_on hab.le
            (intervalIntegrable_const (c := core b))
            (continuous_core.intervalIntegrable a b)
            (fun t ht => hanti ht ⟨hab.le, le_rfl⟩ ht.2)
          have hablen : b-a = 1 := by dsimp [a, b]; ring
          simpa only [intervalIntegral.integral_const, smul_eq_mul, hablen, one_mul]
            using hbound
        have hbnonneg : 0 ≤ core b := by
          have hprod : 0 ≤ a * core b := by
            rw [← hrenewal] at hint
            dsimp [a, b] at *
            nlinarith
          exact nonneg_of_mul_nonneg_right hprod ha
        intro x hx
        have hxb : x ≤ b := by
          dsimp [b]
          push_cast at hx
          linarith
        by_cases hxa : x ≤ a
        · exact ih x hxa
        · exact hbnonneg.trans (hanti ⟨(lt_of_not_ge hxa).le, hxb⟩
            ⟨hab.le, le_rfl⟩ hxb)
  have core_nonneg (x : ℝ) : 0 ≤ core x :=
    core_nonneg_upto ⌈x⌉₊ x (by linarith [Nat.le_ceil x])
  have core_antitone : Antitone core := by
    have hanti : AntitoneOn core (Ici 1) := by
      apply antitoneOn_of_hasDerivWithinAt_nonpos (convex_Ici 1)
        continuous_core.continuousOn (f' := fun t => -(core (t-1)/t))
      · intro t ht
        rw [interior_Ici] at ht
        exact (hasDerivAt_core ht).hasDerivWithinAt
      · intro t ht
        rw [interior_Ici] at ht
        change 1 < t at ht
        exact neg_nonpos.mpr (div_nonneg (core_nonneg _) (by linarith))
    intro x y hxy
    by_cases hy : y ≤ 1
    · rw [core_eq_one hy, core_eq_one (hxy.trans hy)]
    · by_cases hx : x ≤ 1
      · rw [core_eq_one hx, ← core_eq_one (x := 1) le_rfl]
        exact hanti (by simp) (le_of_not_ge hy) (le_of_not_ge hy)
      · exact hanti (le_of_not_ge hx) (le_of_not_ge hy) hxy
  have core_le_one (x : ℝ) : core x ≤ 1 := by
    by_cases hx : x ≤ 1
    · rw [core_eq_one hx]
    · simpa only [core_eq_one (x := 1) le_rfl] using
        core_antitone (show (1 : ℝ) ≤ x from le_of_not_ge hx)
  have rho_range (x : ℝ) : 0 ≤ dickmanRho x ∧ dickmanRho x ≤ 1 := by
    by_cases hx : x < 0
    · simp [rho_of_neg hx]
    · rw [rho_eq_core (le_of_not_gt hx)]
      exact ⟨core_nonneg x, core_le_one x⟩
  have antitoneOn_rho : AntitoneOn dickmanRho (Ici 0) := by
    intro x hx y hy hxy
    rw [rho_eq_core hx, rho_eq_core hy]
    exact core_antitone hxy
  have renewal {x : ℝ} (hx : 1 ≤ x) :
      x * dickmanRho x = ∫ t in x-1..x, dickmanRho t := by
    rw [rho_eq_core (by linarith), core_renewal hx]
    apply intervalIntegral.integral_congr
    intro t ht
    rw [uIcc_of_le (show x-1 ≤ x by linarith)] at ht
    exact (rho_eq_core (by linarith [ht.1])).symm
  refine ⟨@rho_of_neg, fun x hx => rho_eq_one hx.1 hx.2,
    continuous_core.continuousOn.congr (fun _ hx => rho_eq_core hx),
    Measurable.ite measurableSet_Iio measurable_const continuous_core.measurable,
    @hasDerivAt_rho, rho_range, antitoneOn_rho, ?_⟩
  intro x hx
  by_cases hx1 : 1 ≤ x
  · simpa only [max_eq_right (sub_nonneg.mpr hx1)] using renewal hx1
  · have hxle : x ≤ 1 := (lt_of_not_ge hx1).le
    rw [rho_eq_one hx hxle, mul_one, max_eq_left (sub_nonpos.mpr hxle)]
    symm
    calc
      (∫ t in (0 : ℝ)..x, dickmanRho t) = ∫ _ in (0 : ℝ)..x, (1 : ℝ) := by
        apply intervalIntegral.integral_congr
        intro t ht
        rw [uIcc_of_le hx] at ht
        exact rho_eq_one ht.1 (ht.2.trans hxle)
      _ = x := by simp

/--
The exact rational renewal sequence through the requested index, initialized to `1` through
index `M`. Later values are the sum of the preceding `M` values divided by the new index; `M =
0` gives the constant sequence.
-/
def dickmanRenewalPrefix (M : ℕ) : ℕ → Array ℚ :=
  Nat.rec (motive := fun _ => Array ℚ) #[1]
    (fun j G =>
      if M = 0 ∨ j < M then
        G.push 1
      else
        G.push
          ((∑ a ∈ Finset.Ico (j + 1 - M) (j + 1), G.getD a 1) /
            ((j : ℚ) + 1)))

/--
Lower and upper renewal-sequence bounds through the requested index, obtained by propagating
endpoint sums and rounding outward at dyadic precision `p`. The initial values are `(1, 1)`.
-/
def dickmanRenewalDyadicPrefix (p : ℤ) (M : ℕ) :
    ℕ → Array (ℚ × ℚ) :=
  Nat.rec (motive := fun _ => Array (ℚ × ℚ)) #[(1, 1)]
    (fun j G =>
      if M = 0 ∨ j < M then
        G.push (1, 1)
      else
        let lower : ℚ :=
          (∑ a ∈ Finset.Ico (j + 1 - M) (j + 1),
            (G.getD a (1, 1)).1) / ((j : ℚ) + 1)
        let upper : ℚ :=
          (∑ a ∈ Finset.Ico (j + 1 - M) (j + 1),
            (G.getD a (1, 1)).2) / ((j : ℚ) + 1)
        G.push ((lower.toDyadic p).toRat,
          -(((-upper).toDyadic p).toRat)))

theorem renewalPrefix_size (M J : ℕ) :
    (dickmanRenewalPrefix M J).size = J + 1 := by
  induction J with
  | zero => simp [dickmanRenewalPrefix]
  | succ J ih =>
      change (if M = 0 ∨ J < M then (dickmanRenewalPrefix M J).push 1
        else (dickmanRenewalPrefix M J).push _).size = _
      split <;> simp only [Array.size_push, ih]

theorem renewalPrefix_get_prefix_default (M i J : ℕ) (fallback : ℚ)
    (hi : i ≤ J) :
    (dickmanRenewalPrefix M J).getD i fallback =
      (dickmanRenewalPrefix M i).getD i fallback := by
  induction J generalizing i with
  | zero =>
      obtain rfl : i = 0 := by omega
      rfl
  | succ J ih =>
      by_cases hiJ : i ≤ J
      · have hne : i ≠ J + 1 := by omega
        change (if M = 0 ∨ J < M then (dickmanRenewalPrefix M J).push 1
          else (dickmanRenewalPrefix M J).push _).getD i fallback = _
        split <;>
          simpa only [Array.getD_eq_getD_getElem?, Array.getElem?_push,
            renewalPrefix_size, ite_eq_right hne] using ih i hiJ
      · obtain rfl : i = J + 1 := by omega
        rfl

theorem renewalPrefix_get_prefix (M i J : ℕ) (hi : i ≤ J) :
    (dickmanRenewalPrefix M J).getD i 1 =
      (dickmanRenewalPrefix M i).getD i 1 :=
  renewalPrefix_get_prefix_default M i J 1 hi

theorem renewalPrefix_get_succ (M j : ℕ) :
    (dickmanRenewalPrefix M (j + 1)).getD (j + 1) 1 =
      if M = 0 ∨ j < M then 1 else
        (∑ a ∈ Finset.Ico (j + 1 - M) (j + 1),
          (dickmanRenewalPrefix M j).getD a 1) / ((j : ℚ) + 1) := by
  change
    (let G := dickmanRenewalPrefix M j
     if M = 0 ∨ j < M then G.push 1 else
       G.push ((∑ a ∈ Finset.Ico (j + 1 - M) (j + 1), G.getD a 1) /
         ((j : ℚ) + 1))).getD (j + 1) 1 = _
  split <;> simp only [Array.getD_eq_getD_getElem?, Array.getElem?_push,
    renewalPrefix_size, ite_true, Option.getD_some]

theorem renewalPrefix_step (M j : ℕ) :
    (dickmanRenewalPrefix M (j + 1)).getD (j + 1) 1 =
      if M = 0 ∨ j < M then 1 else
        (∑ a ∈ Finset.Ico (j + 1 - M) (j + 1),
          (dickmanRenewalPrefix M a).getD a 1) / ((j : ℚ) + 1) := by
  rw [renewalPrefix_get_succ]
  by_cases h : M = 0 ∨ j < M
  · simp only [ite_eq_left h]
  · simp only [ite_eq_right h]
    congr 1
    apply Finset.sum_congr rfl
    intro a ha
    exact renewalPrefix_get_prefix M a j (by
      have := (Finset.mem_Ico.mp ha).2
      omega)

theorem renewalPrefix_initial (M j : ℕ) (hj : j ≤ M) :
    (dickmanRenewalPrefix M j).getD j 1 = 1 := by
  cases j with
  | zero => simp [dickmanRenewalPrefix]
  | succ j =>
      rw [renewalPrefix_step]
      exact ite_eq_left (Or.inr (by omega))

theorem renewalPrefix_recurrence (M j : ℕ) (hM : 0 < M) (hj : M ≤ j) :
    (dickmanRenewalPrefix M (j + 1)).getD (j + 1) 1 =
      (∑ a ∈ Finset.Ico (j + 1 - M) (j + 1),
        (dickmanRenewalPrefix M a).getD a 1) / ((j : ℚ) + 1) := by
  rw [renewalPrefix_step, ite_eq_right (by omega)]

theorem renewalPrefix_recurrence_at (M j : ℕ) (hM : 0 < M) (hj : M < j) :
    (dickmanRenewalPrefix M j).getD j 1 =
      (∑ a ∈ Finset.Ico (j - M) j,
        (dickmanRenewalPrefix M a).getD a 1) / (j : ℚ) := by
  cases j with
  | zero => omega
  | succ j =>
      simpa only [Nat.succ_eq_add_one, Nat.cast_add, Nat.cast_one] using
        renewalPrefix_recurrence M j hM (by omega)

theorem renewalPrefix_pos_le_one (M j : ℕ) :
    0 < (dickmanRenewalPrefix M j).getD j 1 ∧
      (dickmanRenewalPrefix M j).getD j 1 ≤ 1 := by
  induction j using Nat.strong_induction_on with
  | h j ih =>
      cases j with
      | zero => norm_num [dickmanRenewalPrefix]
      | succ j =>
          simp only [renewalPrefix_step]
          split_ifs with hinit
          · norm_num
          · have hM : 0 < M := by omega
            have hMj : M ≤ j := by omega
            have hden : (0 : ℚ) < (j : ℚ) + 1 := by positivity
            have hsumpos :
                (0 : ℚ) < ∑ a ∈ Finset.Ico (j + 1 - M) (j + 1),
                  (dickmanRenewalPrefix M a).getD a 1 := by
              apply Finset.sum_pos
              · intro a ha
                exact (ih a (Finset.mem_Ico.mp ha).2).1
              · refine ⟨j, ?_⟩
                exact Finset.mem_Ico.mpr ⟨by omega, by omega⟩
            have hcard : (Finset.Ico (j + 1 - M) (j + 1)).card = M := by
              rw [Nat.card_Ico]
              omega
            have hsumle :
                (∑ a ∈ Finset.Ico (j + 1 - M) (j + 1),
                  (dickmanRenewalPrefix M a).getD a 1) ≤ (M : ℚ) := by
              calc
                _ ≤ ∑ _a ∈ Finset.Ico (j + 1 - M) (j + 1), (1 : ℚ) := by
                  apply Finset.sum_le_sum
                  intro a ha
                  exact (ih a (Finset.mem_Ico.mp ha).2).2
                _ = (M : ℚ) := by simp [hcard]
            have hMden : (M : ℚ) ≤ (j : ℚ) + 1 := by
              exact_mod_cast (show M ≤ j + 1 by omega)
            exact ⟨div_pos hsumpos hden, (div_le_one hden).2 (hsumle.trans hMden)⟩

theorem renewalPrefix_dickman_le (M : ℕ) (hM : 0 < M) (j : ℕ) :
    dickmanRho ((j : ℝ) / (M : ℝ)) ≤
      ((dickmanRenewalPrefix M j).getD j 1 : ℝ) := by
  obtain ⟨_, _, _, _, _, hshape, hanti, hrenewal⟩ := dickmanRho_analytic
  have hMr : (0 : ℝ) < M := by exact_mod_cast hM
  induction j using Nat.strong_induction_on with
  | h j ih =>
      by_cases hj : j ≤ M
      · rw [renewalPrefix_initial M j hj]
        simpa using (hshape ((j : ℝ) / (M : ℝ))).2
      · have hMj : M < j := by omega
        have hjr : (0 : ℝ) < j := by exact_mod_cast (lt_trans hM hMj)
        rw [renewalPrefix_recurrence_at M j hM hMj]
        push_cast
        apply (le_div_iff₀ hjr).2
        have hleft : ((j - M : ℕ) : ℝ) / (M : ℝ) =
            (j : ℝ) / (M : ℝ) - 1 := by
          rw [Nat.cast_sub hMj.le, sub_div, div_self hMr.ne']
        have hunit : (1 : ℝ) ≤ (j : ℝ) / (M : ℝ) := by
          apply (le_div_iff₀ hMr).2
          simpa using (show (M : ℝ) ≤ j by exact_mod_cast hMj.le)
        have hrenew := hrenewal ((j : ℝ) / (M : ℝ)) (by positivity)
        rw [max_eq_right (sub_nonneg.mpr hunit)] at hrenew
        calc
          dickmanRho ((j : ℝ) / (M : ℝ)) * (j : ℝ) =
              ∫ x in ((j - M : ℕ) : ℝ)..(j : ℝ),
                dickmanRho (x / (M : ℝ)) := by
            rw [intervalIntegral.integral_comp_div dickmanRho hMr.ne', smul_eq_mul,
              hleft, ← hrenew]
            field_simp
          _ ≤ ∑ a ∈ Finset.Ico (j - M) j, dickmanRho ((a : ℝ) / (M : ℝ)) := by
            apply AntitoneOn.integral_le_sum_Ico (Nat.sub_le j M)
            intro x hx y hy hxy
            exact hanti
              (div_nonneg ((Nat.cast_nonneg (j - M)).trans hx.1) hMr.le)
              (div_nonneg ((Nat.cast_nonneg (j - M)).trans hy.1) hMr.le)
              (div_le_div_of_nonneg_right hxy hMr.le)
          _ ≤ ∑ a ∈ Finset.Ico (j - M) j,
              ((dickmanRenewalPrefix M a).getD a 1 : ℝ) := by
            apply Finset.sum_le_sum
            intro a ha
            exact ih a (Finset.mem_Ico.mp ha).2

theorem renewalPrefix_scaled (M n : ℕ) (hM : 0 < M) (hn : M ≤ n) :
    (n : ℚ) * (dickmanRenewalPrefix M n).getD n 1 =
      ∑ a ∈ Finset.Ico (n - M) n, (dickmanRenewalPrefix M a).getD a 1 := by
  let R : ℕ → ℚ := fun j => (dickmanRenewalPrefix M j).getD j 1
  change (n : ℚ) * R n = ∑ a ∈ Finset.Ico (n - M) n, R a
  have hinit : ∀ j, j ≤ M → R j = 1 := fun j hj => renewalPrefix_initial M j hj
  rcases eq_or_lt_of_le hn with hEq | hlt
  · subst n
    rw [hinit M le_rfl, mul_one, Nat.sub_self]
    symm
    calc
      (∑ a ∈ Finset.Ico 0 M, R a) = ∑ _a ∈ Finset.Ico 0 M, (1 : ℚ) := by
        apply Finset.sum_congr rfl
        intro a ha
        exact hinit a (le_of_lt (Finset.mem_Ico.mp ha).2)
      _ = (M : ℚ) := by simp
  · have hr := renewalPrefix_recurrence_at M n hM hlt
    change R n = (∑ a ∈ Finset.Ico (n - M) n, R a) / (n : ℚ) at hr
    have hn0 : (n : ℚ) ≠ 0 := by
      exact_mod_cast (show n ≠ 0 by omega)
    calc
      (n : ℚ) * R n = R n * (n : ℚ) := mul_comm _ _
      _ = ∑ a ∈ Finset.Ico (n - M) n, R a := (eq_div_iff hn0).mp hr

theorem renewalPrefix_sliding (M n : ℕ) (hM : 0 < M) (hn : M ≤ n) :
    ((n : ℚ) + 1) *
        ((dickmanRenewalPrefix M n).getD n 1 -
          (dickmanRenewalPrefix M (n + 1)).getD (n + 1) 1) =
      (dickmanRenewalPrefix M (n - M)).getD (n - M) 1 := by
  let R : ℕ → ℚ := fun j => (dickmanRenewalPrefix M j).getD j 1
  change ((n : ℚ) + 1) * (R n - R (n + 1)) = R (n - M)
  have h₁ := renewalPrefix_scaled M n hM hn
  have h₂ := renewalPrefix_scaled M (n + 1) hM (by omega)
  change (n : ℚ) * R n = ∑ a ∈ Finset.Ico (n - M) n, R a at h₁
  change ((n + 1 : ℕ) : ℚ) * R (n + 1) =
    ∑ a ∈ Finset.Ico (n + 1 - M) (n + 1), R a at h₂
  have ht := Finset.sum_Ico_succ_top (show n + 1 - M ≤ n by omega) R
  have hb := Finset.sum_eq_sum_Ico_succ_bot (show n - M < n by omega) R
  have hshift : n + 1 - M = n - M + 1 := by omega
  rw [hshift] at h₂ ht
  simp only [Nat.cast_add, Nat.cast_one] at h₂
  linear_combination h₁ - h₂ - ht + hb

theorem renewalPrefix_antitone (M : ℕ) (hM : 0 < M) :
    Antitone (fun j => (dickmanRenewalPrefix M j).getD j 1) := by
  refine antitone_nat_of_succ_le fun n => ?_
  by_cases hn : n < M
  · rw [renewalPrefix_initial M (n + 1) (by omega),
      renewalPrefix_initial M n (by omega)]
  · have hslide := renewalPrefix_sliding M n hM (by omega)
    have hd :
        0 ≤ ((n : ℚ) + 1) *
          ((dickmanRenewalPrefix M n).getD n 1 -
            (dickmanRenewalPrefix M (n + 1)).getD (n + 1) 1) := by
      rw [hslide]
      exact (renewalPrefix_pos_le_one M (n - M)).1.le
    exact sub_nonneg.mp (nonneg_of_mul_nonneg_right hd (by positivity))

theorem renewalPrefix_block_step (M : ℕ) (hM : 0 < M) (k : ℕ) :
    ((k + 1 : ℕ) : ℚ) *
        (dickmanRenewalPrefix M ((k + 1) * M)).getD ((k + 1) * M) 1 ≤
      (dickmanRenewalPrefix M (k * M)).getD (k * M) 1 := by
  let R : ℕ → ℚ := fun j => (dickmanRenewalPrefix M j).getD j 1
  change ((k + 1 : ℕ) : ℚ) * R ((k + 1) * M) ≤ R (k * M)
  have hanti : Antitone R := renewalPrefix_antitone M hM
  have hMpos : (0 : ℚ) < (M : ℚ) := by exact_mod_cast hM
  have hN : (k + 1) * M = k * M + M := by
    simp only [Nat.add_mul, Nat.one_mul]
  have hs := renewalPrefix_scaled M ((k + 1) * M) hM (by omega)
  change (((k + 1) * M : ℕ) : ℚ) * R ((k + 1) * M) =
    ∑ a ∈ Finset.Ico ((k + 1) * M - M) ((k + 1) * M), R a at hs
  have hlo : (k + 1) * M - M = k * M := by omega
  rw [hlo] at hs
  have hcard : (Finset.Ico (k * M) ((k + 1) * M)).card = M := by
    rw [Nat.card_Ico, hN]
    omega
  have hsum : (∑ a ∈ Finset.Ico (k * M) ((k + 1) * M), R a) ≤
      (M : ℚ) * R (k * M) := by
    calc
      (∑ a ∈ Finset.Ico (k * M) ((k + 1) * M), R a) ≤
          ∑ _a ∈ Finset.Ico (k * M) ((k + 1) * M), R (k * M) :=
        Finset.sum_le_sum fun a ha => hanti (Finset.mem_Ico.mp ha).1
      _ = (M : ℚ) * R (k * M) := by
        rw [Finset.sum_const, hcard, nsmul_eq_mul]
  apply (mul_le_mul_iff_right₀ hMpos).mp
  calc
    (M : ℚ) * (((k + 1 : ℕ) : ℚ) * R ((k + 1) * M)) =
        (((k + 1) * M : ℕ) : ℚ) * R ((k + 1) * M) := by
      push_cast
      ring
    _ = ∑ a ∈ Finset.Ico (k * M) ((k + 1) * M), R a := hs
    _ ≤ (M : ℚ) * R (k * M) := hsum

theorem renewalPrefix_factorial (M : ℕ) (hM : 0 < M) (k : ℕ) :
    (dickmanRenewalPrefix M (k * M)).getD (k * M) 1 ≤ (k.factorial : ℚ)⁻¹ := by
  let R : ℕ → ℚ := fun j => (dickmanRenewalPrefix M j).getD j 1
  have hfact : ∀ k, R (k * M) ≤ 1 / (Nat.factorial k : ℚ) := by
    intro k
    induction k with
    | zero =>
        have hzero : R 0 = 1 := renewalPrefix_initial M 0 (Nat.zero_le M)
        simpa using hzero.le
    | succ k ih =>
        have hkpos : (0 : ℚ) < ((k + 1 : ℕ) : ℚ) := by positivity
        have hb : ((k + 1 : ℕ) : ℚ) * R ((k + 1) * M) ≤ R (k * M) :=
          renewalPrefix_block_step M hM k
        calc
          R ((k + 1) * M) ≤ R (k * M) / ((k + 1 : ℕ) : ℚ) :=
            (le_div_iff₀' hkpos).2 hb
          _ ≤ (1 / (Nat.factorial k : ℚ)) / ((k + 1 : ℕ) : ℚ) :=
            div_le_div_of_nonneg_right ih hkpos.le
          _ = 1 / (Nat.factorial (k + 1) : ℚ) := by
            simp [Nat.factorial_succ, Nat.cast_mul, div_eq_mul_inv, mul_comm]
  simpa only [one_div] using hfact k

theorem dickmanRenewalPrefix_encloses (M : ℕ) (hM : 2 ≤ M) :
    let R : ℕ → ℚ := fun j => (dickmanRenewalPrefix M j).getD j 1
    (∀ j : ℕ, 0 < R j ∧
      dickmanRho ((j : ℝ) / (M : ℝ)) ≤ (R j : ℝ) ∧ R j ≤ 1) ∧
      Antitone R ∧
      (∀ k : ℕ, R (k * M) ≤ (k.factorial : ℚ)⁻¹) := by
  intro R
  have hMpos : 0 < M := by omega
  refine ⟨?_, renewalPrefix_antitone M hMpos, renewalPrefix_factorial M hMpos⟩
  intro j
  obtain ⟨hpos, hle⟩ := renewalPrefix_pos_le_one M j
  exact ⟨hpos, renewalPrefix_dickman_le M hMpos j, hle⟩

theorem renewalDyadicPrefix_size (p : ℤ) (M J : ℕ) :
    (dickmanRenewalDyadicPrefix p M J).size = J + 1 := by
  induction J with
  | zero => simp [dickmanRenewalDyadicPrefix]
  | succ J ih =>
      change (if M = 0 ∨ J < M then (dickmanRenewalDyadicPrefix p M J).push (1, 1)
        else (dickmanRenewalDyadicPrefix p M J).push _).size = _
      split <;> simp only [Array.size_push, ih]

theorem renewalDyadicPrefix_get_prefix (p : ℤ) (M i J : ℕ)
    (hi : i ≤ J) :
    (dickmanRenewalDyadicPrefix p M J).getD i (1, 1) =
      (dickmanRenewalDyadicPrefix p M i).getD i (1, 1) := by
  induction J generalizing i with
  | zero =>
      obtain rfl : i = 0 := by omega
      rfl
  | succ J ih =>
      by_cases hiJ : i ≤ J
      · have hne : i ≠ J + 1 := by omega
        change (if M = 0 ∨ J < M then (dickmanRenewalDyadicPrefix p M J).push (1, 1)
          else (dickmanRenewalDyadicPrefix p M J).push _).getD i (1, 1) = _
        split <;>
          simpa only [Array.getD_eq_getD_getElem?, Array.getElem?_push,
            renewalDyadicPrefix_size, ite_eq_right hne] using ih i hiJ
      · obtain rfl : i = J + 1 := by omega
        rfl

theorem renewalDyadicPrefix_get_succ (p : ℤ) (M j : ℕ) :
    (dickmanRenewalDyadicPrefix p M (j + 1)).getD (j + 1) (1, 1) =
      if M = 0 ∨ j < M then (1, 1) else
        let G := dickmanRenewalDyadicPrefix p M j
        let lower : ℚ :=
          (∑ a ∈ Finset.Ico (j + 1 - M) (j + 1),
            (G.getD a (1, 1)).1) / ((j : ℚ) + 1)
        let upper : ℚ :=
          (∑ a ∈ Finset.Ico (j + 1 - M) (j + 1),
            (G.getD a (1, 1)).2) / ((j : ℚ) + 1)
        ((lower.toDyadic p).toRat, -(((-upper).toDyadic p).toRat)) := by
  change
    (let G := dickmanRenewalDyadicPrefix p M j
     if M = 0 ∨ j < M then G.push (1, 1) else
       let lower : ℚ :=
         (∑ a ∈ Finset.Ico (j + 1 - M) (j + 1), (G.getD a (1, 1)).1) /
           ((j : ℚ) + 1)
       let upper : ℚ :=
         (∑ a ∈ Finset.Ico (j + 1 - M) (j + 1), (G.getD a (1, 1)).2) /
           ((j : ℚ) + 1)
       G.push ((lower.toDyadic p).toRat,
         -(((-upper).toDyadic p).toRat))).getD (j + 1) (1, 1) = _
  split <;> simp only [Array.getD_eq_getD_getElem?, Array.getElem?_push,
    renewalDyadicPrefix_size, ite_true, Option.getD_some]

theorem renewalDyadicPrefix_initial (p : ℤ) (M j : ℕ)
    (hj : j ≤ M) :
    (dickmanRenewalDyadicPrefix p M j).getD j (1, 1) = (1, 1) := by
  cases j with
  | zero => simp [dickmanRenewalDyadicPrefix]
  | succ j =>
      rw [renewalDyadicPrefix_get_succ, ite_eq_left (Or.inr (by omega))]

theorem renewalDyadicPrefix_recurrence (p : ℤ) (M j : ℕ)
    (hM : 0 < M) (hj : M ≤ j) :
    (dickmanRenewalDyadicPrefix p M (j + 1)).getD (j + 1) (1, 1) =
      let lower : ℚ :=
        (∑ a ∈ Finset.Ico (j + 1 - M) (j + 1),
          ((dickmanRenewalDyadicPrefix p M a).getD a (1, 1)).1) /
          ((j : ℚ) + 1)
      let upper : ℚ :=
        (∑ a ∈ Finset.Ico (j + 1 - M) (j + 1),
          ((dickmanRenewalDyadicPrefix p M a).getD a (1, 1)).2) /
          ((j : ℚ) + 1)
      ((lower.toDyadic p).toRat, -(((-upper).toDyadic p).toRat)) := by
  rw [renewalDyadicPrefix_get_succ, ite_eq_right (by omega)]
  dsimp only
  have hL :
      (∑ a ∈ Finset.Ico (j + 1 - M) (j + 1),
        ((dickmanRenewalDyadicPrefix p M j).getD a (1, 1)).1) =
      ∑ a ∈ Finset.Ico (j + 1 - M) (j + 1),
        ((dickmanRenewalDyadicPrefix p M a).getD a (1, 1)).1 := by
    apply Finset.sum_congr rfl
    intro a ha
    rw [renewalDyadicPrefix_get_prefix p M a j
      (by have := (Finset.mem_Ico.mp ha).2; omega)]
  have hU :
      (∑ a ∈ Finset.Ico (j + 1 - M) (j + 1),
        ((dickmanRenewalDyadicPrefix p M j).getD a (1, 1)).2) =
      ∑ a ∈ Finset.Ico (j + 1 - M) (j + 1),
        ((dickmanRenewalDyadicPrefix p M a).getD a (1, 1)).2 := by
    apply Finset.sum_congr rfl
    intro a ha
    rw [renewalDyadicPrefix_get_prefix p M a j
      (by have := (Finset.mem_Ico.mp ha).2; omega)]
  simp only [hL, hU]

theorem renewal_dyadic_round_error (p : ℤ) (q : ℚ) :
    0 ≤ q - (q.toDyadic p).toRat ∧
      q - (q.toDyadic p).toRat < (2 : ℚ) ^ (-p) := by
  have hlo := Rat.toRat_toDyadic_le (x := q) (prec := p)
  have hhi := Rat.lt_toRat_toDyadic_add (x := q) (prec := p)
  rw [Dyadic.toRat_add, Dyadic.toRat_ofIntWithPrec_eq_mul_two_pow] at hhi
  norm_num only [Int.cast_one, one_mul] at hhi
  constructor <;> linarith

theorem renewalDyadicPrefix_encloses (p : ℤ) (M : ℕ) (hM : 0 < M) :
    let R : ℕ → ℚ := fun j => (dickmanRenewalPrefix M j).getD j 1
    let I : ℕ → ℚ × ℚ := fun j =>
      (dickmanRenewalDyadicPrefix p M j).getD j (1, 1)
    let ε : ℚ := (2 : ℚ) ^ (-p)
    ∀ j : ℕ, (I j).1 ≤ R j ∧ R j ≤ (I j).2 ∧
      R j - (I j).1 ≤ (j : ℚ) * ε ∧
      (I j).2 - R j ≤ (j : ℚ) * ε := by
  intro R I ε j
  have hε : 0 < ε := by dsimp only [ε]; positivity
  induction j using Nat.strong_induction_on with
  | h n ih =>
      cases n with
      | zero => simp [R, I, dickmanRenewalPrefix, dickmanRenewalDyadicPrefix]
      | succ j =>
          by_cases hjM : j < M
          · have hR : R (j + 1) = 1 := renewalPrefix_initial M (j + 1) (by omega)
            have hI : I (j + 1) = (1, 1) :=
              renewalDyadicPrefix_initial p M (j + 1) (by omega)
            rw [hR, hI]
            simp only [sub_self, le_refl, true_and]
            constructor <;> positivity
          · let S := Finset.Ico (j + 1 - M) (j + 1)
            let lower : ℚ := (∑ a ∈ S, (I a).1) / ((j : ℚ) + 1)
            let upper : ℚ := (∑ a ∈ S, (I a).2) / ((j : ℚ) + 1)
            have hden : 0 < (j : ℚ) + 1 := by positivity
            have hcard : S.card = M := by
              dsimp only [S]
              rw [Nat.card_Ico]
              omega
            have hMj : (M : ℚ) ≤ (j : ℚ) + 1 := by
              exact_mod_cast (show M ≤ j + 1 by omega)
            have hprev (a : ℕ) (ha : a ∈ S) :=
              ih a (Finset.mem_Ico.mp ha).2
            have hRa : R (j + 1) = (∑ a ∈ S, R a) / ((j : ℚ) + 1) := by
              simpa only [R, S] using
                renewalPrefix_recurrence M j hM (by omega)
            have hIa : I (j + 1) =
                ((lower.toDyadic p).toRat, -(((-upper).toDyadic p).toRat)) := by
              simpa only [I, lower, upper, S] using
                renewalDyadicPrefix_recurrence p M j hM (by omega)
            have hl : lower ≤ R (j + 1) := by
              rw [hRa]
              exact div_le_div_of_nonneg_right
                (Finset.sum_le_sum fun a ha => (hprev a ha).1) hden.le
            have hu : R (j + 1) ≤ upper := by
              rw [hRa]
              exact div_le_div_of_nonneg_right
                (Finset.sum_le_sum fun a ha => (hprev a ha).2.1) hden.le
            have havg (A B : ℕ → ℚ)
                (h : ∀ a ∈ S, A a - B a ≤ (j : ℚ) * ε) :
                (∑ a ∈ S, A a) / ((j : ℚ) + 1) -
                  (∑ a ∈ S, B a) / ((j : ℚ) + 1) ≤ (j : ℚ) * ε := by
              rw [← sub_div, ← Finset.sum_sub_distrib]
              apply (div_le_iff₀ hden).2
              calc
                (∑ a ∈ S, (A a - B a)) ≤ ∑ _a ∈ S, (j : ℚ) * ε :=
                  Finset.sum_le_sum h
                _ = (M : ℚ) * ((j : ℚ) * ε) := by simp [hcard, nsmul_eq_mul]
                _ ≤ ((j : ℚ) + 1) * ((j : ℚ) * ε) :=
                  mul_le_mul_of_nonneg_right hMj (by positivity)
                _ = ((j : ℚ) * ε) * ((j : ℚ) + 1) := by ring
            have hleIndex (a : ℕ) (ha : a ∈ S) :
                (a : ℚ) * ε ≤ (j : ℚ) * ε := by
              apply mul_le_mul_of_nonneg_right _ hε.le
              exact_mod_cast (show a ≤ j from Nat.lt_succ_iff.mp
                (Finset.mem_Ico.mp ha).2)
            have hel : R (j + 1) - lower ≤ (j : ℚ) * ε := by
              rw [hRa]
              exact havg R (fun a => (I a).1) fun a ha =>
                (hprev a ha).2.2.1.trans (hleIndex a ha)
            have heu : upper - R (j + 1) ≤ (j : ℚ) * ε := by
              rw [hRa]
              exact havg (fun a => (I a).2) R fun a ha =>
                (hprev a ha).2.2.2.trans (hleIndex a ha)
            have hrl : 0 ≤ lower - (lower.toDyadic p).toRat ∧
                lower - (lower.toDyadic p).toRat < ε :=
              renewal_dyadic_round_error p lower
            have hru : 0 ≤ -upper - ((-upper).toDyadic p).toRat ∧
                -upper - ((-upper).toDyadic p).toRat < ε :=
              renewal_dyadic_round_error p (-upper)
            rw [hIa]
            simp only [Nat.cast_add, Nat.cast_one]
            refine ⟨?_, ?_, ?_, ?_⟩ <;> linarith [hrl.1, hrl.2, hru.1, hru.2]

end

section
open Set

theorem dickmanRho_scaled_shape (z : ℝ) (hz : 0 < z) :
    let scaled (t : ℝ) : ℝ := dickmanRho (t / z)
    let scaledD (t : ℝ) : ℝ :=
      if t ≤ z then 0 else -(scaled (t - z) / t)
    let scaledDD (t : ℝ) : ℝ :=
      if t ≤ z then 0 else
        if t ≤ 2 * z then 1 / t ^ 2 else
          scaled (t - z) / t ^ 2 + scaled (t - 2 * z) / (t * (t - z))
    let kernel (t : ℝ) : ℝ := scaled (t - z) / t
    let kernelD (t : ℝ) : ℝ :=
      scaledD (t - z) / t - scaled (t - z) / t ^ 2
    let kernelDD (t : ℝ) : ℝ :=
      scaledDD (t - z) / t - 2 * scaledD (t - z) / t ^ 2 +
        2 * scaled (t - z) / t ^ 3
    ContinuousOn scaled (Ici 0) ∧
      (∀ t : ℝ, z < t → HasDerivAt scaled (-(kernel t)) t) ∧
      (∀ t : ℝ, 0 < t → t ≠ z → HasDerivAt scaled (scaledD t) t) ∧
      (∀ t : ℝ, t ≠ z → t ≠ 2 * z →
        HasDerivAt scaledD (scaledDD t) t) ∧
      (∀ t : ℝ, 0 ≤ scaledDD t ∧ scaledDD t ≤ 1 / z ^ 2) ∧
      ContinuousOn kernel (Ici z) ∧
      (∀ t : ℝ, z < t → t ≠ 2 * z →
        HasDerivAt kernel (kernelD t) t) ∧
      (∀ t : ℝ, z < t → t ≠ 2 * z → t ≠ 3 * z →
        HasDerivAt kernelD (kernelDD t) t) ∧
      (∀ t : ℝ, z ≤ t → 0 ≤ kernelDD t ∧ kernelDD t ≤ 6 / z ^ 3) := by
  intro scaled scaledD scaledDD kernel kernelD kernelDD
  obtain ⟨_, hinit, continuousOn_rho, _, hdelay, hrange, _, _⟩ := dickmanRho_analytic
  have scaled_eq_one {t : ℝ} (ht0 : 0 ≤ t) (htz : t ≤ z) :
      scaled t = 1 :=
    hinit _ ⟨div_nonneg ht0 hz.le, (div_le_one hz).2 htz⟩
  have scaled_nonneg (t : ℝ) : 0 ≤ scaled t := (hrange _).1
  have scaled_le_one (t : ℝ) : scaled t ≤ 1 := (hrange _).2
  have continuousOn_scaled : ContinuousOn scaled (Ici 0) := by
    apply continuousOn_rho.comp (continuous_id.div_const z).continuousOn
    intro t ht
    exact div_nonneg ht hz.le
  have hasDerivAt_scaled_of_lt {t : ℝ}
      (ht0 : 0 < t) (htz : t < z) : HasDerivAt scaled 0 t := by
    apply (hasDerivAt_const t (1 : ℝ)).congr_of_eventuallyEq
    filter_upwards [eventually_gt_nhds ht0, eventually_lt_nhds htz] with u hu0 huz
    exact scaled_eq_one hu0.le huz.le
  have hasDerivAt_scaled {t : ℝ} (hzt : z < t) :
      HasDerivAt scaled (-(scaled (t-z)/t)) t := by
    have ht0 : t ≠ 0 := ne_of_gt (hz.trans hzt)
    have hz0 : z ≠ 0 := ne_of_gt hz
    have harg : 1 < t/z := (one_lt_div hz).2 hzt
    have harg' : t/z-1 = (t-z)/z := by field_simp [hz0]
    have hd : HasDerivAt scaled
        (-(dickmanRho (t/z-1)/(t/z))*(1/z)) t := by
      simpa only [scaled, Function.comp_def, id_eq] using!
        (hdelay _ harg).comp t ((hasDerivAt_id t).div_const z)
    have heq : -(dickmanRho (t/z-1)/(t/z))*(1/z) = -(scaled (t-z)/t) := by
      dsimp [scaled]
      rw [harg']
      field_simp [ht0, hz0]
    rwa [heq] at hd
  have hasDerivAt_scaledD_value {t : ℝ}
      (ht0 : 0 < t) (htz : t ≠ z) :
      HasDerivAt scaled (scaledD t) t := by
    rcases lt_or_gt_of_ne htz with htz | hzt
    · simpa [scaledD, htz.le] using hasDerivAt_scaled_of_lt ht0 htz
    · simpa [scaledD, not_le.mpr hzt] using hasDerivAt_scaled hzt
  have scaledD_bounds {t : ℝ} :
      0 ≤ -scaledD t ∧ -scaledD t ≤ 1/z := by
    by_cases htz : t ≤ z
    · simp only [scaledD, ite_eq_left htz, neg_zero]
      exact ⟨le_rfl, by positivity⟩
    · have hzt : z < t := lt_of_not_ge htz
      simp only [scaledD, ite_eq_right htz, neg_neg]
      constructor
      · exact div_nonneg (scaled_nonneg _) (hz.trans hzt).le
      · calc
          scaled (t-z)/t ≤ 1/t :=
            div_le_div_of_nonneg_right (scaled_le_one _) (hz.trans hzt).le
          _ ≤ 1/z := div_le_div_of_nonneg_left zero_le_one hz hzt.le
  have scaledD_eq_neg_inv {t : ℝ}
      (hzt : z < t) (ht2z : t < 2*z) : scaledD t = -(1/t) := by
    dsimp only [scaledD]
    rw [ite_eq_right (not_le.mpr hzt),
      scaled_eq_one (by linarith) (by linarith)]
  have hasDerivAt_scaledDD_value {t : ℝ}
      (htz : t ≠ z) (ht2z : t ≠ 2*z) :
      HasDerivAt scaledD (scaledDD t) t := by
    rcases lt_or_gt_of_ne htz with htz | hzt
    · have heq : scaledD =ᶠ[𝓝 t] fun _ => 0 := by
        filter_upwards [eventually_lt_nhds htz] with u hu
        simp [scaledD, hu.le]
      simpa [scaledDD, htz.le] using
        (hasDerivAt_const t (0 : ℝ)).congr_of_eventuallyEq heq
    · have ht0 : t ≠ 0 := ne_of_gt (hz.trans hzt)
      rcases lt_or_gt_of_ne ht2z with ht2z | h2zt
      · have heq : scaledD =ᶠ[𝓝 t] fun u => -(1/u) := by
          filter_upwards [eventually_gt_nhds hzt, eventually_lt_nhds ht2z]
            with u huz hu2z
          exact scaledD_eq_neg_inv huz hu2z
        have hd := ((hasDerivAt_const t (1 : ℝ)).div (hasDerivAt_id t) ht0).neg
        have hderivValue : -((0*t-1*1)/t ^ 2) = scaledDD t := by
          simp only [scaledDD, ite_eq_right (not_le.mpr hzt), ite_eq_left ht2z.le]
          ring
        simpa only [id_eq, hderivValue] using hd.congr_of_eventuallyEq heq
      · have htmz : z < t-z := by linarith
        have htmz0 : t-z ≠ 0 := ne_of_gt (hz.trans htmz)
        have heq : scaledD =ᶠ[𝓝 t] fun u => -(scaled (u-z)/u) := by
          filter_upwards [eventually_gt_nhds hzt] with u hu
          simp [scaledD, not_le.mpr hu]
        have hd := (((hasDerivAt_scaled htmz).comp_sub_const t z).div
          (hasDerivAt_id t) ht0).neg
        have hderivValue :
            -((-(scaled (t-z-z)/(t-z))*t-scaled (t-z)*1)/t ^ 2) =
              scaledDD t := by
          simp only [scaledDD, ite_eq_right (not_le.mpr hzt), ite_eq_right (not_le.mpr h2zt)]
          have heqarg : t-z-z = t-2*z := by ring
          rw [heqarg]
          field_simp [ht0, htmz0]
          ring
        simpa only [id_eq, hderivValue] using hd.congr_of_eventuallyEq heq
  have scaledDD_bounds {t : ℝ} :
      0 ≤ scaledDD t ∧ scaledDD t ≤ 1/z ^ 2 := by
    by_cases htz : t ≤ z
    · simp only [scaledDD, ite_eq_left htz]
      exact ⟨le_rfl, by positivity⟩
    · have hzt : z < t := lt_of_not_ge htz
      have ht0 : 0 < t := hz.trans hzt
      by_cases ht2z : t ≤ 2*z
      · simp only [scaledDD, ite_eq_right htz, ite_eq_left ht2z]
        constructor
        · positivity
        · apply div_le_div_of_nonneg_left zero_le_one (sq_pos_of_pos hz)
          nlinarith
      · have h2zt : 2*z < t := lt_of_not_ge ht2z
        have htmz : z < t-z := by linarith
        have htmz0 : 0 < t-z := hz.trans htmz
        simp only [scaledDD, ite_eq_right htz, ite_eq_right ht2z]
        constructor
        · exact add_nonneg
            (div_nonneg (scaled_nonneg _) (sq_nonneg t))
            (div_nonneg (scaled_nonneg _) (mul_nonneg ht0.le htmz0.le))
        · have hfirst : scaled (t-z)/t ^ 2 ≤ 1/(4*z ^ 2) := by
            calc
              scaled (t-z)/t ^ 2 ≤ 1/t ^ 2 :=
                div_le_div_of_nonneg_right (scaled_le_one _) (sq_nonneg t)
              _ ≤ 1/(4*z ^ 2) := by
                apply div_le_div_of_nonneg_left zero_le_one (by positivity)
                nlinarith
          have hsecond : scaled (t-2*z)/(t*(t-z)) ≤ 1/(2*z ^ 2) := by
            calc
              scaled (t-2*z)/(t*(t-z)) ≤ 1/(t*(t-z)) :=
                div_le_div_of_nonneg_right (scaled_le_one _)
                  (mul_nonneg ht0.le htmz0.le)
              _ ≤ 1/(2*z ^ 2) := by
                apply div_le_div_of_nonneg_left zero_le_one (by positivity)
                nlinarith
          have hid : 1/(4*z ^ 2)+1/(2*z ^ 2) ≤ 1/z ^ 2 := by
            field_simp [ne_of_gt hz]
            norm_num
          exact (add_le_add hfirst hsecond).trans hid
  have continuousOn_kernel : ContinuousOn kernel (Ici z) := by
    apply (continuousOn_scaled.comp
      (continuous_id.sub continuous_const).continuousOn ?_).div
      continuous_id.continuousOn
    · intro t ht
      exact ne_of_gt (hz.trans_le (show z ≤ t from ht))
    · intro t ht
      change 0 ≤ t-z
      exact sub_nonneg.mpr (show z ≤ t from ht)
  have hasDerivAt_kernelD_value {t : ℝ}
      (hzt : z < t) (ht2z : t ≠ 2*z) :
      HasDerivAt kernel (kernelD t) t := by
    have ht0 : t ≠ 0 := ne_of_gt (hz.trans hzt)
    have htmz : t-z ≠ z := by intro h; apply ht2z; linarith
    have hd := (hasDerivAt_scaledD_value (sub_pos.mpr hzt) htmz).comp_sub_const t z
    have hq : HasDerivAt kernel
        ((scaledD (t-z)*t-scaled (t-z))/t ^ 2) t := by
      simpa only [kernel, Pi.div_apply, id_eq, mul_one] using!
        hd.fun_div (hasDerivAt_id t) ht0
    have heq : (scaledD (t-z)*t-scaled (t-z))/t ^ 2 = kernelD t := by
      dsimp [kernelD]
      field_simp [ht0]
    rwa [heq] at hq
  have hasDerivAt_kernelDD_value {t : ℝ}
      (hzt : z < t) (ht2z : t ≠ 2*z) (ht3z : t ≠ 3*z) :
      HasDerivAt kernelD (kernelDD t) t := by
    have ht0 : t ≠ 0 := ne_of_gt (hz.trans hzt)
    have htmz : t-z ≠ z := by intro h; apply ht2z; linarith
    have htm2z : t-z ≠ 2*z := by intro h; apply ht3z; linarith
    have hd := (hasDerivAt_scaledD_value (sub_pos.mpr hzt) htmz).comp_sub_const t z
    have hdd := (hasDerivAt_scaledDD_value htmz htm2z).comp_sub_const t z
    have hsquare : HasDerivAt (fun u : ℝ => u ^ 2) (2*t) t := by
      simpa only [id_eq, Nat.cast_ofNat, Nat.reduceSub, pow_one, mul_one] using
        (hasDerivAt_id t).fun_pow 2
    have hq : HasDerivAt kernelD
        ((scaledDD (t-z)*t-scaledD (t-z))/t ^ 2 -
          (scaledD (t-z)*t ^ 2-scaled (t-z)*(2*t))/(t ^ 2) ^ 2) t := by
      simpa only [kernelD, Pi.sub_apply, Pi.div_apply, id_eq, mul_one] using!
        (hdd.fun_div (hasDerivAt_id t) ht0).fun_sub
          (hd.fun_div hsquare (pow_ne_zero 2 ht0))
    have heq : (scaledDD (t-z)*t-scaledD (t-z))/t ^ 2 -
        (scaledD (t-z)*t ^ 2-scaled (t-z)*(2*t))/(t ^ 2) ^ 2 = kernelDD t := by
      dsimp [kernelDD]
      field_simp [ht0]
      ring
    rwa [heq] at hq
  have kernelDD_bounds {t : ℝ} (hzt : z ≤ t) :
      0 ≤ kernelDD t ∧ kernelDD t ≤ 6/z ^ 3 := by
    have ht : 0 < t := hz.trans_le hzt
    have hfirst := scaledD_bounds (t := t-z)
    have hsecond := scaledDD_bounds (t := t-z)
    have hfirst0 := hfirst.1
    have hsecond0 := hsecond.1
    have hvalue := scaled_nonneg (t-z)
    have hvalue' := scaled_le_one (t-z)
    have hrewrite : kernelDD t = scaledDD (t-z)/t +
        2*(-scaledD (t-z))/t ^ 2 + 2*scaled (t-z)/t ^ 3 := by
      dsimp [kernelDD]
      ring
    rw [hrewrite]
    constructor
    · positivity
    · have hterm1 : scaledDD (t-z)/t ≤ 1/z ^ 3 := by
        calc
          scaledDD (t-z)/t ≤ (1/z ^ 2)/t :=
            div_le_div_of_nonneg_right hsecond.2 ht.le
          _ ≤ (1/z ^ 2)/z :=
            div_le_div_of_nonneg_left (by positivity) hz hzt
          _ = 1/z ^ 3 := by field_simp
      have hterm2 : 2*(-scaledD (t-z))/t ^ 2 ≤ 2/z ^ 3 := by
        calc
          2*(-scaledD (t-z))/t ^ 2 ≤ (2*(1/z))/t ^ 2 :=
            div_le_div_of_nonneg_right
              (mul_le_mul_of_nonneg_left hfirst.2 (by norm_num)) (sq_nonneg t)
          _ ≤ (2*(1/z))/z ^ 2 := by
            apply div_le_div_of_nonneg_left (by positivity) (sq_pos_of_pos hz)
            nlinarith
          _ = 2/z ^ 3 := by field_simp
      have hterm3 : 2*scaled (t-z)/t ^ 3 ≤ 2/z ^ 3 := by
        calc
          2*scaled (t-z)/t ^ 3 ≤ 2/t ^ 3 :=
            div_le_div_of_nonneg_right (by nlinarith [hvalue']) (pow_nonneg ht.le 3)
          _ ≤ 2/z ^ 3 := by
            apply div_le_div_of_nonneg_left (by positivity) (pow_pos hz 3)
            exact pow_le_pow_left₀ hz.le hzt 3
      have hlast : 1/z ^ 3+2/z ^ 3+2/z ^ 3 ≤ 6/z ^ 3 := by
        calc
          1/z ^ 3+2/z ^ 3+2/z ^ 3 = 5/z ^ 3 := by ring
          _ ≤ 6/z ^ 3 := div_le_div_of_nonneg_right (by norm_num) (pow_nonneg hz.le 3)
      exact (add_le_add (add_le_add hterm1 hterm2) hterm3).trans hlast
  exact ⟨continuousOn_scaled, @hasDerivAt_scaled, @hasDerivAt_scaledD_value,
    @hasDerivAt_scaledDD_value, @scaledDD_bounds, continuousOn_kernel,
    @hasDerivAt_kernelD_value, @hasDerivAt_kernelDD_value, @kernelDD_bounds⟩

theorem trapezoid_error_of_open_derivatives
    {f f' f'' : ℝ → ℝ} {a b C : ℝ} (hab : a < b)
    (hf : ContinuousOn f (Icc a b))
    (h₁ : ∀ t ∈ Ioo a b, HasDerivAt f (f' t) t)
    (h₂ : ∀ t ∈ Ioo a b, HasDerivAt f' (f'' t) t)
    (hbound : ∀ t ∈ Ioo a b, 0 ≤ f'' t ∧ f'' t ≤ C) :
    0 ≤ (b - a) / 2 * (f a + f b) - (∫ t in a..b, f t) ∧
      (b - a) / 2 * (f a + f b) - (∫ t in a..b, f t) ≤
        C * (b - a) ^ 3 / 12 := by
  have upper {f : ℝ → ℝ} (hf : ContinuousOn f (Icc a b))
      (hconv : ConvexOn ℝ (Icc a b) f) :
      (∫ t in a..b, f t) ≤ (b - a) / 2 * (f a + f b) := by
    let L : ℝ → ℝ := fun t => (b - t) * f a + (t - a) * f b
    have hfi : IntervalIntegrable f volume a b := hf.intervalIntegrable_of_Icc hab.le
    have hL : Continuous L := by dsimp [L]; fun_prop
    have hnum := intervalIntegral.integral_mono_on_of_le_Ioo hab.le
      (hfi.const_mul (b - a)) (hL.intervalIntegrable a b)
      (fun t ht => hconv.secant_mono_aux1
        (show a ∈ Icc a b from ⟨le_rfl, hab.le⟩)
        (show b ∈ Icc a b from ⟨hab.le, le_rfl⟩) ht.1 ht.2)
    rw [intervalIntegral.integral_const_mul] at hnum
    have hlin : IntervalIntegrable (fun t : ℝ => (f b - f a) * t) volume a b :=
      (continuous_id.intervalIntegrable a b).const_mul _
    have hLint : (∫ t in a..b, L t) =
        (b - a) * ((b - a) / 2 * (f a + f b)) := by
      calc
        (∫ t in a..b, L t) =
            ∫ t in a..b, (f b - f a) * t + (b * f a - a * f b) := by
          apply intervalIntegral.integral_congr
          intro t _
          dsimp [L]
          ring
        _ = (f b - f a) * ((b ^ 2 - a ^ 2) / 2) +
            (b - a) * (b * f a - a * f b) := by
          rw [intervalIntegral.integral_add hlin intervalIntegrable_const,
            intervalIntegral.integral_const_mul, integral_id,
            intervalIntegral.integral_const]
          simp only [smul_eq_mul]
        _ = (b - a) * ((b - a) / 2 * (f a + f b)) := by ring
    rw [hLint] at hnum
    exact le_of_mul_le_mul_left hnum (sub_pos.mpr hab)
  have hconv : ConvexOn ℝ (Icc a b) f := by
    apply convexOn_of_hasDerivWithinAt2_nonneg
      (f' := f') (f'' := f'') (convex_Icc a b) hf
    · intro t ht
      exact (h₁ t (by simpa only [interior_Icc] using ht)).hasDerivWithinAt
    · intro t ht
      exact (h₂ t (by simpa only [interior_Icc] using ht)).hasDerivWithinAt
    · intro t ht
      exact (hbound t (by simpa only [interior_Icc] using ht)).1
  have hupper := upper hf hconv
  let q : ℝ → ℝ := fun t => (C / 2) * t ^ 2
  let g : ℝ → ℝ := fun t => q t - f t
  have hqc : Continuous q := by dsimp [q]; fun_prop
  have hg : ContinuousOn g (Icc a b) := hqc.continuousOn.sub hf
  have hq₁ (t : ℝ) : HasDerivAt q (C * t) t := by
    have hvalue : C / 2 * (2 * t) = C * t := by ring
    simpa only [q, id_eq, Nat.cast_ofNat, Nat.reduceSub, pow_one, mul_one, hvalue] using!
      ((hasDerivAt_id t).fun_pow 2).const_mul (C / 2)
  have hq₂ (t : ℝ) : HasDerivAt (fun s : ℝ => C * s) C t := by
    simpa only [id_eq, mul_one] using! (hasDerivAt_id t).const_mul C
  have hgconv : ConvexOn ℝ (Icc a b) g := by
    apply convexOn_of_hasDerivWithinAt2_nonneg
      (f' := fun t => C * t - f' t) (f'' := fun t => C - f'' t)
      (convex_Icc a b) hg
    · intro t ht
      exact ((hq₁ t).sub
        (h₁ t (by simpa only [interior_Icc] using ht))).hasDerivWithinAt
    · intro t ht
      exact ((hq₂ t).sub
        (h₂ t (by simpa only [interior_Icc] using ht))).hasDerivWithinAt
    · intro t ht
      exact sub_nonneg.mpr (hbound t (by simpa only [interior_Icc] using ht)).2
  have hother := upper hg hgconv
  have hfi : IntervalIntegrable f volume a b := hf.intervalIntegrable_of_Icc hab.le
  have hqint : (∫ t in a..b, q t) = (C / 2) * ((b ^ 3 - a ^ 3) / 3) := by
    dsimp [q]
    rw [intervalIntegral.integral_const_mul, integral_pow]
    norm_num
  have hgint : (∫ t in a..b, g t) =
      (C / 2) * ((b ^ 3 - a ^ 3) / 3) - (∫ t in a..b, f t) := by
    change (∫ t in a..b, q t - f t) = _
    rw [intervalIntegral.integral_sub (hqc.intervalIntegrable a b) hfi, hqint]
  rw [hgint] at hother
  dsimp [g, q] at hother
  exact ⟨sub_nonneg.mpr hupper, by nlinarith only [hother]⟩

theorem ne_natCast_of_mem_open_cell {j : ℕ} {t : ℝ}
    (ht : t ∈ Ioo (j : ℝ) ((j : ℝ) + 1)) (k : ℕ) : t ≠ (k : ℝ) := by
  intro heq
  rw [heq] at ht
  have hleft : j < k := by exact_mod_cast ht.1
  have hright : k < j + 1 := by exact_mod_cast ht.2
  omega

theorem dickmanRho_grid_step (M j : ℕ) (hM : 0 < M) (hMj : M ≤ j) :
    let d : ℕ → ℝ := fun a => dickmanRho ((a : ℝ) / (M : ℝ))
    let center : ℝ :=
      d j - d (j - M) / (2 * (j : ℝ)) -
        d (j + 1 - M) / (2 * ((j : ℝ) + 1))
    center ≤ d (j + 1) ∧
      d (j + 1) ≤ center + 1 / (2 * (M : ℝ) ^ 3) := by
  intro d center
  have hMr : (0 : ℝ) < (M : ℝ) := by exact_mod_cast hM
  have hMjr : (M : ℝ) ≤ (j : ℝ) := by exact_mod_cast hMj
  have hab : (j : ℝ) < (j : ℝ) + 1 := lt_add_one _
  let r : ℝ → ℝ := fun t => dickmanRho (t / (M : ℝ))
  let K : ℝ → ℝ := fun t => r (t - (M : ℝ)) / t
  obtain ⟨hrcont, hrdelay, _, _, _, hkcont, hkd, hkdd, hkb⟩ :=
    dickmanRho_scaled_shape (M : ℝ) hMr
  have hrc : ContinuousOn r (Icc (j : ℝ) ((j : ℝ) + 1)) :=
    hrcont.mono (fun t ht => (Nat.cast_nonneg j).trans ht.1)
  have hkc : ContinuousOn K (Icc (j : ℝ) ((j : ℝ) + 1)) :=
    hkcont.mono (fun t ht => hMjr.trans ht.1)
  have he := trapezoid_error_of_open_derivatives hab hkc
    (fun t ht => hkd t (hMjr.trans_lt ht.1) (by
      simpa only [Nat.cast_mul, Nat.cast_ofNat] using
        ne_natCast_of_mem_open_cell ht (2 * M)))
    (fun t ht => hkdd t (hMjr.trans_lt ht.1) (by
      simpa only [Nat.cast_mul, Nat.cast_ofNat] using
        ne_natCast_of_mem_open_cell ht (2 * M)) (by
      simpa only [Nat.cast_mul, Nat.cast_ofNat] using
        ne_natCast_of_mem_open_cell ht (3 * M)))
    (fun t ht => hkb t (hMjr.trans ht.1.le))
  have hFTC := intervalIntegral.integral_eq_sub_of_hasDerivAt_of_le hab.le hrc
    (fun t ht => hrdelay t (hMjr.trans_lt ht.1))
    (hkc.neg.intervalIntegrable_of_Icc hab.le)
  change (∫ t in (j : ℝ)..((j : ℝ) + 1), -(K t)) =
    r ((j : ℝ) + 1) - r (j : ℝ) at hFTC
  rw [intervalIntegral.integral_neg] at hFTC
  have hcenter : center = r (j : ℝ) -
      (K (j : ℝ) + K ((j : ℝ) + 1)) / 2 := by
    dsimp [center, d, r, K]
    rw [Nat.cast_sub hMj, Nat.cast_sub (show M ≤ j + 1 by omega)]
    push_cast
    simp only [div_mul_eq_div_div_swap]
    ring
  have hend : d (j + 1) = r ((j : ℝ) + 1) := by
    simp only [d, r, Nat.cast_add, Nat.cast_one]
  have herr : (6 / (M : ℝ) ^ 3) / 12 = 1 / (2 * (M : ℝ) ^ 3) := by ring
  simp only [add_sub_cancel_left, one_pow, mul_one, herr] at he
  rw [hend, hcenter]
  constructor <;> linarith [he.1, he.2]

theorem dickmanRho_physical_cell (M j : ℕ) (hM : 0 < M)
    (h : ℝ) (hh : 0 < h) :
    let c : ℝ := (M : ℝ) * h
    let D : ℝ → ℝ := fun t => dickmanRho (t / c)
    let A : ℝ :=
      ∫ t in Set.Ico ((j : ℝ) * h) (((j : ℝ) + 1) * h), D t
    0 ≤ A ∧ A ≤ h ∧
      (j < M → A = h) ∧
      (M ≤ j →
        max 0 (h / 2 * (D ((j : ℝ) * h) + D (((j : ℝ) + 1) * h)) -
          h ^ 3 / (12 * c ^ 2)) ≤ A ∧
        A ≤ h / 2 * (D ((j : ℝ) * h) + D (((j : ℝ) + 1) * h))) := by
  intro c D A
  have hMr : (0 : ℝ) < (M : ℝ) := by exact_mod_cast hM
  have hab : (j : ℝ) < (j : ℝ) + 1 := lt_add_one _
  let r : ℝ → ℝ := fun t => dickmanRho (t / (M : ℝ))
  let I : ℝ := ∫ t in (j : ℝ)..((j : ℝ) + 1), r t
  obtain ⟨_, hinit, _, _, _, hrange, _, _⟩ := dickmanRho_analytic
  obtain ⟨hrcont, _, hd, hdd, hb, _, _, _, _⟩ :=
    dickmanRho_scaled_shape (M : ℝ) hMr
  have hrc : ContinuousOn r (Icc (j : ℝ) ((j : ℝ) + 1)) :=
    hrcont.mono (fun t ht => (Nat.cast_nonneg j).trans ht.1)
  have hedge (t : ℝ) : D (t * h) = r t := by
    dsimp [D, c, r]
    rw [mul_div_mul_right _ _ (ne_of_gt hh)]
  have hscale : A = h * I := by
    calc
      A = ∫ t in (j : ℝ) * h..(((j : ℝ) + 1) * h), D t := by
        dsimp only [A]
        rw [intervalIntegral.integral_of_le (by nlinarith)]
        exact integral_Ico_eq_integral_Ioc
      _ = h * ∫ t in (j : ℝ)..((j : ℝ) + 1), D (t * h) := by
        symm
        simpa only [smul_eq_mul] using
          intervalIntegral.smul_integral_comp_mul_right D h
      _ = h * I := by simp only [hedge, I]
  have hI0 : 0 ≤ I :=
    intervalIntegral.integral_nonneg hab.le (fun t _ => (hrange _).1)
  have hI1 : I ≤ 1 := by
    have hi : I ≤ ∫ _ in (j : ℝ)..((j : ℝ) + 1), (1 : ℝ) :=
      intervalIntegral.integral_mono_on hab.le
      (hrc.intervalIntegrable_of_Icc hab.le) (intervalIntegrable_const (c := (1 : ℝ)))
      (fun t _ => (hrange _).2)
    simpa only [intervalIntegral.integral_const, smul_eq_mul, mul_one,
      add_sub_cancel_left] using hi
  have hA0 : 0 ≤ A := by rw [hscale]; exact mul_nonneg hh.le hI0
  have hA1 : A ≤ h := by
    rw [hscale]
    simpa only [mul_one] using mul_le_mul_of_nonneg_left hI1 hh.le
  refine ⟨hA0, hA1, ?_, ?_⟩
  · intro hjM
    have hjMr : (j : ℝ) + 1 ≤ (M : ℝ) := by exact_mod_cast hjM
    have hI : I = 1 := by
      calc
        I = ∫ _ in (j : ℝ)..((j : ℝ) + 1), (1 : ℝ) := by
          apply intervalIntegral.integral_congr
          intro t ht
          rw [uIcc_of_le hab.le] at ht
          exact hinit _ ⟨div_nonneg ((Nat.cast_nonneg j).trans ht.1) hMr.le,
            (div_le_one hMr).2 (ht.2.trans hjMr)⟩
        _ = 1 := by simp
    rw [hscale, hI, mul_one]
  · intro _
    have he := trapezoid_error_of_open_derivatives hab hrc
      (fun t ht => hd t ((Nat.cast_nonneg j).trans_lt ht.1)
        (ne_natCast_of_mem_open_cell ht M))
      (fun t ht => hdd t (ne_natCast_of_mem_open_cell ht M) (by
        simpa only [Nat.cast_mul, Nat.cast_ofNat] using
          ne_natCast_of_mem_open_cell ht (2 * M)))
      (fun t _ => hb t)
    simp only [add_sub_cancel_left, one_pow, mul_one] at he
    have herr : h * ((1 / (M : ℝ) ^ 2) / 12) = h ^ 3 / (12 * c ^ 2) := by
      dsimp [c]
      field_simp [ne_of_gt hh, ne_of_gt hMr]
    rw [hedge, hedge, hscale]
    constructor
    · apply max_le (mul_nonneg hh.le hI0)
      have hi := mul_le_mul_of_nonneg_left he.2 hh.le
      rw [herr] at hi
      change h / 2 * (r (j : ℝ) + r ((j : ℝ) + 1)) -
        h ^ 3 / (12 * c ^ 2) ≤ h * I
      dsimp only [I]
      nlinarith only [hi]
    · have hi := mul_le_mul_of_nonneg_left he.1 hh.le
      dsimp only [I]
      nlinarith only [hi]

/--
The directed Dickman grid using delayed endpoint values, a trapezoidal update, and the explicit
upper-error allowance `1 / (2 * M^3)`. Each step rounds outward at dyadic precision `p`, clamps
the lower endpoint from below at `0`, and clamps the upper endpoint from above at `1`.
-/
def dickmanDirectedGrid (p : ℤ) (M : ℕ) : ℕ → Array (ℚ × ℚ) :=
  Nat.rec (motive := fun _ => Array (ℚ × ℚ)) #[(1, 1)]
    (fun j G =>
      if M = 0 ∨ j < M then
        G.push (1, 1)
      else
        let previous := G.getD j (1, 1)
        let left := G.getD (j - M) (1, 1)
        let right := G.getD (j + 1 - M) (1, 1)
        let lower : ℚ :=
          previous.1 - left.2 / (2 * (j : ℚ)) -
            right.2 / (2 * ((j : ℚ) + 1))
        let upper : ℚ :=
          previous.2 - left.1 / (2 * (j : ℚ)) -
            right.1 / (2 * ((j : ℚ) + 1)) +
            1 / (2 * (M : ℚ) ^ 3)
        G.push (max 0 (lower.toDyadic p).toRat,
          min 1 (-(((-upper).toDyadic p).toRat))))

theorem directedGrid_size (p : ℤ) (M J : ℕ) :
    (dickmanDirectedGrid p M J).size = J + 1 := by
  induction J with
  | zero => simp [dickmanDirectedGrid]
  | succ J ih =>
      change (if M = 0 ∨ J < M then (dickmanDirectedGrid p M J).push (1, 1)
        else (dickmanDirectedGrid p M J).push _).size = _
      split <;> simp only [Array.size_push, ih]

theorem directedGrid_get_prefix (p : ℤ) (M i J : ℕ) (hi : i ≤ J) :
    (dickmanDirectedGrid p M J).getD i (1, 1) =
      (dickmanDirectedGrid p M i).getD i (1, 1) := by
  induction J generalizing i with
  | zero =>
      obtain rfl : i = 0 := by omega
      rfl
  | succ J ih =>
      by_cases hiJ : i ≤ J
      · have hne : i ≠ J + 1 := by omega
        change (if M = 0 ∨ J < M then (dickmanDirectedGrid p M J).push (1, 1)
          else (dickmanDirectedGrid p M J).push _).getD i (1, 1) = _
        split <;>
          simpa only [Array.getD_eq_getD_getElem?, Array.getElem?_push,
            directedGrid_size, ite_eq_right hne] using ih i hiJ
      · obtain rfl : i = J + 1 := by omega
        rfl

theorem directedGrid_get_succ (p : ℤ) (M j : ℕ) :
    (dickmanDirectedGrid p M (j + 1)).getD (j + 1) (1, 1) =
      if M = 0 ∨ j < M then (1, 1) else
        let G := dickmanDirectedGrid p M j
        let lower : ℚ :=
          (G.getD j (1, 1)).1 - (G.getD (j - M) (1, 1)).2 / (2 * (j : ℚ)) -
            (G.getD (j + 1 - M) (1, 1)).2 / (2 * ((j : ℚ) + 1))
        let upper : ℚ :=
          (G.getD j (1, 1)).2 - (G.getD (j - M) (1, 1)).1 / (2 * (j : ℚ)) -
            (G.getD (j + 1 - M) (1, 1)).1 / (2 * ((j : ℚ) + 1)) +
            1 / (2 * (M : ℚ) ^ 3)
        (max 0 (lower.toDyadic p).toRat, min 1 (-(((-upper).toDyadic p).toRat))) := by
  change
    (let G := dickmanDirectedGrid p M j
     if M = 0 ∨ j < M then G.push (1, 1) else
       let previous := G.getD j (1, 1)
       let left := G.getD (j - M) (1, 1)
       let right := G.getD (j + 1 - M) (1, 1)
       let lower : ℚ :=
         previous.1 - left.2 / (2 * (j : ℚ)) -
           right.2 / (2 * ((j : ℚ) + 1))
       let upper : ℚ :=
         previous.2 - left.1 / (2 * (j : ℚ)) -
           right.1 / (2 * ((j : ℚ) + 1)) + 1 / (2 * (M : ℚ) ^ 3)
       G.push (max 0 (lower.toDyadic p).toRat,
         min 1 (-(((-upper).toDyadic p).toRat)))).getD (j + 1) (1, 1) = _
  split <;> simp only [Array.getD_eq_getD_getElem?, Array.getElem?_push,
    directedGrid_size, ite_true, Option.getD_some]

theorem dickmanDirectedGrid_encloses (p : ℤ) (M J : ℕ) (hM : 0 < M) :
    let G := dickmanDirectedGrid p M J
    G.size = J + 1 ∧
      ∀ j, j ≤ J →
        0 ≤ (G.getD j (1, 1)).1 ∧
        ((G.getD j (1, 1)).1 : ℝ) ≤ dickmanRho ((j : ℝ) / (M : ℝ)) ∧
        dickmanRho ((j : ℝ) / (M : ℝ)) ≤ ((G.getD j (1, 1)).2 : ℝ) ∧
        (G.getD j (1, 1)).2 ≤ 1 := by
  intro G
  let B : ℕ → ℚ × ℚ := fun j => (dickmanDirectedGrid p M j).getD j (1, 1)
  have hMr : (0 : ℝ) < (M : ℝ) := by exact_mod_cast hM
  obtain ⟨_, hinit, _, _, _, hrange, _, _⟩ := dickmanRho_analytic
  have hpoints (i : ℕ) :
      0 ≤ (B i).1 ∧
      ((B i).1 : ℝ) ≤ dickmanRho ((i : ℝ) / (M : ℝ)) ∧
      dickmanRho ((i : ℝ) / (M : ℝ)) ≤ ((B i).2 : ℝ) ∧
      (B i).2 ≤ 1 := by
    induction i using Nat.strong_induction_on with
    | h i ih =>
      cases i with
      | zero =>
          simp [B, dickmanDirectedGrid, hinit 0 ⟨le_rfl, zero_le_one⟩]
      | succ j =>
          by_cases hjM : j < M
          · have he : dickmanRho (((j + 1 : ℕ) : ℝ) / (M : ℝ)) = 1 :=
              hinit _ ⟨div_nonneg (Nat.cast_nonneg _) hMr.le,
                (div_le_one hMr).2 (by exact_mod_cast (show j + 1 ≤ M by omega))⟩
            simp only [B, directedGrid_get_succ, ite_eq_left (Or.inr hjM),
              Rat.cast_one, he]
            norm_num
          · have hfalse : ¬ (M = 0 ∨ j < M) := by omega
            have hp := ih j (by omega)
            have ha := ih (j - M) (by omega)
            have hb := ih (j + 1 - M) (by omega)
            have hpa := directedGrid_get_prefix p M (j - M) j (by omega)
            have hpb := directedGrid_get_prefix p M (j + 1 - M) j (by omega)
            let lower : ℚ := (B j).1 - (B (j - M)).2 / (2 * (j : ℚ)) -
              (B (j + 1 - M)).2 / (2 * ((j : ℚ) + 1))
            let upper : ℚ := (B j).2 - (B (j - M)).1 / (2 * (j : ℚ)) -
              (B (j + 1 - M)).1 / (2 * ((j : ℚ) + 1)) +
              1 / (2 * (M : ℚ) ^ 3)
            have hjr : (0 : ℝ) < (j : ℝ) := by exact_mod_cast (show 0 < j by omega)
            have hs := dickmanRho_grid_step M j hM (le_of_not_gt hjM)
            simp only [Nat.cast_add, Nat.cast_one] at hs
            have hl : (lower : ℝ) ≤ dickmanRho (((j + 1 : ℕ) : ℝ) / (M : ℝ)) := by
              have hda := div_le_div_of_nonneg_right ha.2.2.1
                (show (0 : ℝ) ≤ 2 * (j : ℝ) by positivity)
              have hdb := div_le_div_of_nonneg_right hb.2.2.1
                (show (0 : ℝ) ≤ 2 * ((j : ℝ) + 1) by positivity)
              dsimp only [lower]
              push_cast
              linarith [hp.2.1, hs.1]
            have hu : dickmanRho (((j + 1 : ℕ) : ℝ) / (M : ℝ)) ≤ (upper : ℝ) := by
              have hda := div_le_div_of_nonneg_right ha.2.1
                (show (0 : ℝ) ≤ 2 * (j : ℝ) by positivity)
              have hdb := div_le_div_of_nonneg_right hb.2.1
                (show (0 : ℝ) ≤ 2 * ((j : ℝ) + 1) by positivity)
              dsimp only [upper]
              push_cast
              linarith [hp.2.2.1, hs.2]
            have hdown : (((lower.toDyadic p).toRat : ℚ) : ℝ) ≤ (lower : ℝ) := by
              exact_mod_cast (Rat.toRat_toDyadic_le (x := lower) (prec := p))
            have hup : (upper : ℝ) ≤ ((-(((-upper).toDyadic p).toRat) : ℚ) : ℝ) := by
              norm_cast
              simpa only [neg_neg] using
                neg_le_neg (Rat.toRat_toDyadic_le (x := -upper) (prec := p))
            have he : B (j + 1) =
                (max 0 (lower.toDyadic p).toRat,
                  min 1 (-(((-upper).toDyadic p).toRat))) := by
              simp only [B, directedGrid_get_succ, ite_eq_right hfalse, hpa, hpb]
              rfl
            rw [he]
            refine ⟨le_max_left _ _, ?_, ?_, min_le_left _ _⟩
            · rw [Rat.cast_max, Rat.cast_zero]
              exact max_le (hrange _).1 (hdown.trans hl)
            · rw [Rat.cast_min, Rat.cast_one]
              exact le_min (hrange _).2 (hu.trans hup)
  refine ⟨directedGrid_size p M J, ?_⟩
  intro j hj
  change 0 ≤ ((dickmanDirectedGrid p M J).getD j (1, 1)).1 ∧ _
  rw [directedGrid_get_prefix p M j J hj]
  exact hpoints j

theorem dickmanDirectedGrid_width (p : ℤ) (M J : ℕ) (hM : 0 < M) :
    let B : ℕ → ℚ × ℚ := fun j =>
      (dickmanDirectedGrid p M j).getD j (1, 1)
    let lower : ℕ → ℚ := fun j =>
      (B j).1 - (B (j - M)).2 / (2 * (j : ℚ)) -
        (B (j + 1 - M)).2 / (2 * ((j : ℚ) + 1))
    let upper : ℕ → ℚ := fun j =>
      (B j).2 - (B (j - M)).1 / (2 * (j : ℚ)) -
        (B (j + 1 - M)).1 / (2 * ((j : ℚ) + 1)) +
        1 / (2 * (M : ℚ) ^ 3)
    let epsilon : ℕ → ℚ := fun j =>
      lower j - ((lower j).toDyadic p).toRat +
        (-(((-(upper j)).toDyadic p).toRat) - upper j)
    (∀ j, M ≤ j →
      0 ≤ epsilon j ∧ epsilon j < 2 * (2 : ℚ) ^ (-p)) ∧
    (∀ j, M ≤ j → j < J →
      (∏ l ∈ Finset.Ico (j + 1) J, (1 + 1 / (l : ℚ))) =
        (J : ℚ) / ((j : ℚ) + 1)) ∧
    (∀ i, i ≤ J →
      (B i).2 - (B i).1 ≤
        (J : ℚ) * ∑ j ∈ Finset.Ico M J,
          (1 / (2 * (M : ℚ) ^ 3) + epsilon j) / ((j : ℚ) + 1)) := by
  intro B lower upper epsilon
  have hround (q : ℚ) :
      0 ≤ q - (q.toDyadic p).toRat ∧
        q - (q.toDyadic p).toRat < (2 : ℚ) ^ (-p) := by
    have hlo := Rat.toRat_toDyadic_le (x := q) (prec := p)
    have hhi := Rat.lt_toRat_toDyadic_add (x := q) (prec := p)
    rw [Dyadic.toRat_add, Dyadic.toRat_ofIntWithPrec_eq_mul_two_pow] at hhi
    norm_num only [Int.cast_one, one_mul] at hhi
    constructor <;> linarith
  have herr (j : ℕ) : 0 ≤ epsilon j ∧ epsilon j < 2 * (2 : ℚ) ^ (-p) := by
    obtain ⟨hl0, hl1⟩ := hround (lower j)
    obtain ⟨hu0, hu1⟩ := hround (-(upper j))
    dsimp only [epsilon]
    constructor <;> linarith
  have hprod (a b : ℕ) (ha : 0 < a) (hab : a ≤ b) :
      (∏ l ∈ Finset.Ico a b, (1 + 1 / (l : ℚ))) = (b : ℚ) / (a : ℚ) := by
    induction b, hab using Nat.le_induction with
    | base => simp [Nat.ne_of_gt ha]
    | succ b hab ih =>
        rw [Finset.prod_Ico_succ_top hab, ih]
        have ha0 : (a : ℚ) ≠ 0 := by exact_mod_cast (Nat.ne_of_gt ha)
        have hb0 : (b : ℚ) ≠ 0 := by exact_mod_cast (Nat.ne_of_gt (ha.trans_le hab))
        push_cast
        field_simp
  refine ⟨fun j _ => herr j, ?_, ?_⟩
  · intro j _ hj
    simpa only [Nat.cast_add, Nat.cast_one] using
      hprod (j + 1) J (Nat.succ_pos _) (Nat.succ_le_of_lt hj)
  · have hinit (i : ℕ) (hi : i ≤ M) : B i = (1, 1) := by
      cases i with
      | zero => simp [B, dickmanDirectedGrid]
      | succ i =>
          simp only [B, directedGrid_get_succ,
            ite_eq_left (show M = 0 ∨ i < M from Or.inr (by omega))]
    by_cases hMJ : M ≤ J
    · let W : ℕ → ℚ := fun j =>
        (Finset.range (j + 1)).sup' Finset.nonempty_range_add_one
          (fun i => (B i).2 - (B i).1)
      have hle (i j : ℕ) (hij : i ≤ j) : (B i).2 - (B i).1 ≤ W j :=
        Finset.le_sup' (fun k => (B k).2 - (B k).1)
          (show i ∈ Finset.range (j + 1) from Finset.mem_range.mpr (Nat.lt_succ_of_le hij))
      have hWpos (j : ℕ) : 0 ≤ W j := by
        simpa only [hinit 0 (Nat.zero_le M), Prod.fst, Prod.snd, sub_self] using
          hle 0 j (Nat.zero_le _)
      have hWinit : W M = 0 := by
        apply Finset.sup'_eq_of_forall
        intro i hi
        rw [hinit i (Nat.lt_succ_iff.mp (Finset.mem_range.mp hi))]
        simp
      have hstep (j : ℕ) (hMj : M ≤ j) :
          W (j + 1) ≤ (1 + 1 / (j : ℚ)) * W j +
            (1 / (2 * (M : ℚ) ^ 3) + epsilon j) := by
        have hjq : (0 : ℚ) < (j : ℚ) := by exact_mod_cast (show 0 < j by omega)
        have hfalse : ¬ (M = 0 ∨ j < M) := by omega
        have hpa := directedGrid_get_prefix p M (j - M) j (by omega)
        have hpb := directedGrid_get_prefix p M (j + 1 - M) j (by omega)
        have he : B (j + 1) =
            (max 0 ((lower j).toDyadic p).toRat,
              min 1 (-(((-(upper j)).toDyadic p).toRat))) := by
          simp only [B, directedGrid_get_succ, ite_eq_right hfalse, hpa, hpb]
          rfl
        have hnew : (B (j + 1)).2 - (B (j + 1)).1 ≤
            (1 + 1 / (j : ℚ)) * W j +
              (1 / (2 * (M : ℚ) ^ 3) + epsilon j) := by
          have hc : (B (j + 1)).2 - (B (j + 1)).1 ≤
              -(((-(upper j)).toDyadic p).toRat) - ((lower j).toDyadic p).toRat := by
            rw [he]
            exact sub_le_sub (min_le_right _ _) (le_max_right _ _)
          have hid :
              -(((-(upper j)).toDyadic p).toRat) - ((lower j).toDyadic p).toRat =
                (B j).2 - (B j).1 +
                  ((B (j - M)).2 - (B (j - M)).1) / (2 * (j : ℚ)) +
                  ((B (j + 1 - M)).2 - (B (j + 1 - M)).1) /
                    (2 * ((j : ℚ) + 1)) +
                  1 / (2 * (M : ℚ) ^ 3) + epsilon j := by
            dsimp only [epsilon, lower, upper]
            ring
          rw [hid] at hc
          have hd : W j / (2 * ((j : ℚ) + 1)) ≤ W j / (2 * (j : ℚ)) :=
            div_le_div_of_nonneg_left (hWpos j) (by positivity) (by linarith)
          calc
            (B (j + 1)).2 - (B (j + 1)).1
                ≤ W j + W j / (2 * (j : ℚ)) +
                    W j / (2 * ((j : ℚ) + 1)) +
                    1 / (2 * (M : ℚ) ^ 3) + epsilon j := by
                  apply hc.trans
                  gcongr
                  · exact hle j j le_rfl
                  · exact hle (j - M) j (by omega)
                  · exact hle (j + 1 - M) j (by omega)
            _ ≤ W j + W j / (2 * (j : ℚ)) + W j / (2 * (j : ℚ)) +
                  1 / (2 * (M : ℚ) ^ 3) + epsilon j := by gcongr
            _ = _ := by field_simp; ring
        have hold : W j ≤ (1 + 1 / (j : ℚ)) * W j +
            (1 / (2 * (M : ℚ) ^ 3) + epsilon j) := by
          have he0 : (0 : ℚ) ≤ 1 / (2 * (M : ℚ) ^ 3) := by positivity
          have hx := mul_nonneg (show (0 : ℚ) ≤ 1 / (j : ℚ) by positivity) (hWpos j)
          nlinarith [(herr j).1]
        apply Finset.sup'_le
        intro i hi
        by_cases hij : i ≤ j
        · exact (hle i j hij).trans hold
        · have heq : i = j + 1 := by
            have := Finset.mem_range.mp hi
            omega
          simpa only [heq] using hnew
      have hg := discrete_gronwall_prod_general hstep
        (fun j (_ : M ≤ j) => by positivity) hMJ
      rw [hWinit, zero_mul, zero_add] at hg
      have heq :
          (∑ k ∈ Finset.Ico M J,
            (1 / (2 * (M : ℚ) ^ 3) + epsilon k) *
              ∏ l ∈ Finset.Ico (k + 1) J, (1 + 1 / (l : ℚ))) =
            (J : ℚ) * ∑ k ∈ Finset.Ico M J,
              (1 / (2 * (M : ℚ) ^ 3) + epsilon k) / ((k : ℚ) + 1) := by
        rw [Finset.mul_sum]
        apply Finset.sum_congr rfl
        intro k hk
        rw [hprod (k + 1) J (Nat.succ_pos _) (Nat.succ_le_of_lt (Finset.mem_Ico.mp hk).2)]
        push_cast
        ring
      rw [heq] at hg
      intro i hi
      exact (hle i J hi).trans hg
    · intro i hi
      have hJM : J ≤ M := by omega
      rw [hinit i (hi.trans hJM), Finset.Ico_eq_empty_of_le hJM]
      simp

theorem dickmanDirectedGrid_physical_cell (p : ℤ) (M J j : ℕ)
    (hM : 0 < M) (hj : j < J) (h : ℚ) (hh : 0 < h) :
    let G := dickmanDirectedGrid p M J
    let c : ℚ := (M : ℚ) * h
    let A : ℝ :=
      ∫ t in Set.Ico ((j : ℝ) * (h : ℝ))
        (((j : ℝ) + 1) * (h : ℝ)), dickmanRho (t / (c : ℝ))
    let lower : ℚ :=
      h / 2 * ((G.getD j (1, 1)).1 + (G.getD (j + 1) (1, 1)).1) -
        h ^ 3 / (12 * c ^ 2)
    let upper : ℚ :=
      h / 2 * ((G.getD j (1, 1)).2 + (G.getD (j + 1) (1, 1)).2)
    0 ≤ A ∧ A ≤ (h : ℝ) ∧
      (j < M → A = (h : ℝ)) ∧
      (M ≤ j →
        max 0 (((lower.toDyadic p).toRat : ℚ) : ℝ) ≤ A ∧
        A ≤ ((-(((-upper).toDyadic p).toRat) : ℚ) : ℝ)) := by
  intro G c A lower upper
  have hhR : (0 : ℝ) < (h : ℝ) := by exact_mod_cast hh
  have hA : A =
      ∫ t in Set.Ico ((j : ℝ) * (h : ℝ)) (((j : ℝ) + 1) * (h : ℝ)),
        dickmanRho (t / ((M : ℝ) * (h : ℝ))) := by
    simp only [A, c, Rat.cast_mul, Rat.cast_natCast]
  have ha := dickmanRho_physical_cell M j hM (h : ℝ) hhR
  dsimp only at ha
  rw [← hA] at ha
  refine ⟨ha.1, ha.2.1, ha.2.2.1, ?_⟩
  intro hMj
  have hab := ha.2.2.2 hMj
  rw [mul_div_mul_right _ _ hhR.ne', mul_div_mul_right _ _ hhR.ne'] at hab
  have hp := (dickmanDirectedGrid_encloses p M J hM).2
  have h0 := hp j hj.le
  have h1 := hp (j + 1) (Nat.succ_le_of_lt hj)
  push_cast at h1
  have hl : (lower : ℝ) ≤ A := by
    have hends := mul_le_mul_of_nonneg_left (add_le_add h0.2.1 h1.2.1)
      (show (0 : ℝ) ≤ (h : ℝ) / 2 by positivity)
    have hb := (le_max_right (0 : ℝ) _).trans hab.1
    dsimp only [lower, c]
    push_cast
    linarith
  have hu : A ≤ (upper : ℝ) := by
    have hends := mul_le_mul_of_nonneg_left (add_le_add h0.2.2.1 h1.2.2.1)
      (show (0 : ℝ) ≤ (h : ℝ) / 2 by positivity)
    dsimp only [upper]
    push_cast
    linarith [hab.2]
  have hdown : (((lower.toDyadic p).toRat : ℚ) : ℝ) ≤ (lower : ℝ) := by
    exact_mod_cast (Rat.toRat_toDyadic_le (x := lower) (prec := p))
  have hup : (upper : ℝ) ≤ ((-(((-upper).toDyadic p).toRat) : ℚ) : ℝ) := by
    norm_cast
    simpa only [neg_neg] using
      neg_le_neg (Rat.toRat_toDyadic_le (x := -upper) (prec := p))
  exact ⟨max_le ha.1 (hdown.trans hl), hu.trans hup⟩

end

/-!
## Dense divisibility and smooth summation
-/

mutual
/--
A recursively structured witness that positive `N` is densely divisible to the given order with
parameter `Y ≥ 1`. At successor order it supplies a factorization witness at every admissible
scale and every split of the preceding order.
-/
inductive DenseDivisibilityWitness (Y : Set.Ici (1 : ℝ)) : ℕ → ℕ → Type
  | zero {N : ℕ} (positive : 0 < N) : DenseDivisibilityWitness Y 0 N
  | succ {r N : ℕ} (positive : 0 < N)
      (factor : ∀ j k : ℕ, j + k = r →
        ∀ X : ℝ, 1 ≤ X → X ≤ (Y : ℝ) * (N : ℝ) →
          DenseFactorizationWitness Y N j k X) : DenseDivisibilityWitness Y (r + 1) N
/--
A factorization `N = u * v` with dense-divisibility witnesses of orders `j` and `k`,
respectively, and the scale bounds `X / Y ≤ v ≤ X`.
-/
inductive DenseFactorizationWitness (Y : Set.Ici (1 : ℝ)) : ℕ → ℕ → ℕ → ℝ → Type
  | intro {N j k : ℕ} {X : ℝ} (u v : ℕ) (product : N = u * v)
      (left : DenseDivisibilityWitness Y j u) (right : DenseDivisibilityWitness Y k v)
      (lower : X / (Y : ℝ) ≤ (v : ℝ)) (upper : (v : ℝ) ≤ X) :
      DenseFactorizationWitness Y N j k X

end

theorem sum_range_norm_sub_le_of_lipschitzOnWith_of_eq_zero_outside
    {E : Type*} [SeminormedAddCommGroup E]
    (f : ℝ → E) (K : ℝ≥0) (a b : ℝ) (hab : a ≤ b)
    (hf : LipschitzOnWith K f (Set.Icc a b))
    (hf0 : ∀ x ∉ Set.Ioo a b, f x = 0)
    (t : ℕ → ℝ) (ht : Monotone t) (N : ℕ) :
    ∑ i ∈ Finset.range N, ‖f (t (i + 1)) - f (t i)‖ ≤
      (K : ℝ) * (b - a) := by
  let u (i : ℕ) := Set.projIcc a b hab (t i)
  have hu : Monotone (fun i => (u i : ℝ)) := (Set.monotone_projIcc hab).comp ht
  have hfu (i : ℕ) : f (u i) = f (t i) :=
    congrFun (Set.IccExtend_eq_self hab f
      (fun x hx => by rw [hf0 x (fun h => hx.not_ge h.1.le), hf0 a (by simp)])
      (fun x hx => by rw [hf0 x (fun h => hx.not_ge h.2.le), hf0 b (by simp)])) (t i)
  calc
    _ = ∑ i ∈ Finset.range N, ‖f (u (i + 1)) - f (u i)‖ := by simp only [hfu]
    _ ≤ ∑ i ∈ Finset.range N, (K : ℝ) * ((u (i + 1) : ℝ) - u i) := by
      refine Finset.sum_le_sum fun i _ => ?_
      simpa only [Real.norm_of_nonneg (sub_nonneg.mpr (hu (Nat.le_succ i)))] using
        hf.norm_sub_le (u (i + 1)).property (u i).property
    _ = (K : ℝ) * ((u N : ℝ) - u 0) := by
      rw [← Finset.mul_sum, Finset.sum_range_sub (fun i => (u i : ℝ))]
    _ ≤ _ := mul_le_mul_of_nonneg_left
      (sub_le_sub (u N).property.2 (u 0).property.1) K.coe_nonneg

theorem existsUnique_largest_prime_factorization
    (n Y : ℕ) (hn : 0 < n)
    (hnot_smooth : n ∉ Nat.factoredNumbers (Nat.primesLE Y))
    (hno_square : ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n) :
    ∃! z : ℕ × ℕ,
      Nat.Prime z.1 ∧ Y < z.1 ∧ 0 < z.2 ∧ z.1 * z.2 = n ∧
        ∀ q : ℕ, Nat.Prime q → q ∣ z.2 → q < z.1 := by
  have hsub : ¬ n.primeFactors ⊆ Nat.primesLE Y := fun h ↦
    hnot_smooth (Nat.mem_factoredNumbers_of_primeFactors_subset hn.ne' h)
  obtain ⟨r, hrn, hrY⟩ := Finset.not_subset.mp hsub
  obtain ⟨p, hpmem, hmax⟩ := Finset.exists_max_image n.primeFactors id ⟨r, hrn⟩
  obtain ⟨hp, hpn, _⟩ := Nat.mem_primeFactors.mp hpmem
  have hpY : Y < p := by
    apply lt_of_lt_of_le _ (hmax r hrn)
    exact Nat.lt_of_not_ge fun h ↦ hrY (Nat.mem_primesLE.mpr
      ⟨h, Nat.prime_of_mem_primeFactors hrn⟩)
  have hpm : p * (n / p) = n := Nat.mul_div_cancel' hpn
  have hmpos : 0 < n / p := Nat.div_pos (Nat.le_of_dvd hn hpn) hp.pos
  have hnot_dvd : ¬ p ∣ n / p := fun h ↦
    hno_square ⟨p, hp, hpY, by
      simpa only [pow_two] using (Nat.dvd_div_iff_mul_dvd hpn).mp h⟩
  have hsmall (q : ℕ) (hq : q.Prime) (hqm : q ∣ n / p) : q < p := by
    have hqn : q ∣ n := hpm ▸ dvd_mul_of_dvd_right hqm p
    have hqle : q ≤ p := hmax q (hq.mem_primeFactors hqn hn.ne')
    exact lt_of_le_of_ne hqle (by rintro rfl; exact hnot_dvd hqm)
  refine ⟨(p, n / p), ⟨hp, hpY, hmpos, hpm, hsmall⟩, ?_⟩
  rintro ⟨r, m⟩ ⟨hr, _, _, hrm, hrsmall⟩
  have hrle : r ≤ p := hmax r (hr.mem_primeFactors ⟨m, hrm.symm⟩ hn.ne')
  have hpr : p = r := by
    rcases hp.dvd_or_dvd (hrm.symm ▸ hpn) with hpr | hpm'
    · exact (Nat.prime_dvd_prime_iff_eq hp hr).mp hpr
    · exact (not_lt_of_ge hrle (hrsmall p hp hpm')).elim
  subst r
  exact Prod.ext rfl (Nat.eq_of_mul_eq_mul_left hp.pos (hrm.trans hpm.symm))

theorem sum_prime_eq_prime_log_sum_partial_summation
    (a : ℕ → ℂ) (X : ℕ) (hX : 2 ≤ X) :
    (∑ p ∈ Finset.Icc 1 X with Nat.Prime p, a p) =
      (Real.log (X : ℝ))⁻¹ •
        (∑ p ∈ Finset.Icc 1 X with Nat.Prime p,
          a p * (Real.log (p : ℝ) : ℂ)) +
      ∑ k ∈ Finset.Ico 2 X,
        ((Real.log (k : ℝ))⁻¹ - (Real.log ((k + 1 : ℕ) : ℝ))⁻¹) •
          (∑ p ∈ Finset.Icc 1 k with Nat.Prime p,
            a p * (Real.log (p : ℝ) : ℂ)) := by
  let f : ℕ → ℝ := fun n => (Real.log (n : ℝ))⁻¹
  let g : ℕ → ℂ := fun n =>
    if Nat.Prime n then a n * (Real.log (n : ℝ) : ℂ) else 0
  have hprefix (k : ℕ) :
      (∑ p ∈ Finset.range (k + 1), g p) =
        ∑ p ∈ Finset.Icc 1 k with Nat.Prime p, a p * (Real.log (p : ℝ) : ℂ) := by
    rw [Finset.sum_range_eq_add_Ico g (n := k + 1) (Nat.succ_pos k),
      Finset.Ico_add_one_right_eq_Icc]
    simp [g, Finset.sum_filter]
  have hbottom : (∑ p ∈ Finset.range 2, g p) = 0 := by
    simp [g, Finset.sum_range_succ]
  have hweighted : (∑ p ∈ Finset.Ioc 1 X, f p • g p) =
      ∑ p ∈ Finset.Icc 1 X with Nat.Prime p, a p := by
    calc
      _ = ∑ p ∈ Finset.Icc 1 X, f p • g p := by
        apply Finset.sum_subset Finset.Ioc_subset_Icc_self
        intro p hp hpnot
        simp only [Finset.mem_Icc, Finset.mem_Ioc] at hp hpnot
        have hp1 : p = 1 := by omega
        simp [hp1, g]
      _ = _ := by
        rw [Finset.sum_filter]
        apply Finset.sum_congr rfl
        intro p hp
        by_cases hprime : Nat.Prime p
        · simp only [g, hprime, ite_true, f, Complex.real_smul, Complex.ofReal_inv]
          have hlog : (Real.log (p : ℝ) : ℂ) ≠ 0 :=
            Complex.ofReal_ne_zero.mpr hprime.log_ne_zero
          rw [mul_comm (a p), inv_mul_cancel_left₀ hlog]
        · simp [g, hprime]
  have hinterval : Finset.Ioc 1 (X - 1) = Finset.Ico 2 X := by
    rw [← Finset.Ico_add_one_add_one_eq_Ioc, Nat.sub_add_cancel (by omega : 1 ≤ X)]
    rfl
  have hparts := Finset.sum_Ioc_by_parts f g (m := 1) (n := X) hX
  rw [hweighted, hbottom, smul_zero, sub_zero, hinterval] at hparts
  simp_rw [hprefix] at hparts
  calc
    _ = f X • (∑ p ∈ Finset.Icc 1 X with Nat.Prime p,
          a p * (Real.log (p : ℝ) : ℂ)) -
        ∑ k ∈ Finset.Ico 2 X, (f (k + 1) - f k) •
          (∑ p ∈ Finset.Icc 1 k with Nat.Prime p,
            a p * (Real.log (p : ℝ) : ℂ)) := hparts
    _ = _ := by
      rw [sub_eq_add_neg, ← Finset.sum_neg_distrib]
      congr 1
      apply Finset.sum_congr rfl
      intro k hk
      rw [← neg_smul, neg_sub]

theorem norm_sum_prime_le_of_prime_log_prefix_bound
    (a : ℕ → ℂ) (X : ℕ) (hX : 2 ≤ X) (B : ℝ)
    (hbound : ∀ k ∈ Finset.Icc 2 X,
      ‖∑ p ∈ Finset.Icc 1 k with Nat.Prime p,
        a p * (Real.log (p : ℝ) : ℂ)‖ ≤ B) :
    ‖∑ p ∈ Finset.Icc 1 X with Nat.Prime p, a p‖ ≤ B / Real.log 2 := by
  let f : ℕ → ℝ := fun k => (Real.log (k : ℝ))⁻¹
  let S : ℕ → ℂ := fun k =>
    ∑ p ∈ Finset.Icc 1 k with Nat.Prime p, a p * (Real.log (p : ℝ) : ℂ)
  have hlog (k : ℕ) (hk : 2 ≤ k) : 0 < Real.log (k : ℝ) :=
    Real.log_pos (by exact_mod_cast (show 1 < k by omega))
  have hnonneg (k : ℕ) (hk : 2 ≤ k) : 0 ≤ f k :=
    inv_nonneg.mpr (hlog k hk).le
  have hdiff (k : ℕ) (hk : 2 ≤ k) : 0 ≤ f k - f (k + 1) := by
    apply sub_nonneg.mpr
    exact inv_anti₀ (hlog k hk)
      (Real.log_le_log (by exact_mod_cast (show 0 < k by omega))
        (by exact_mod_cast Nat.le_succ k))
  have hmass : f X + ∑ k ∈ Finset.Ico 2 X, (f k - f (k + 1)) = f 2 := by
    have htel := Finset.sum_Ico_sub (fun k : ℕ => -f k) hX
    simp only [neg_sub_neg] at htel
    rw [htel]
    ring
  rw [sum_prime_eq_prime_log_sum_partial_summation a X hX]
  change ‖f X • S X + ∑ k ∈ Finset.Ico 2 X, (f k - f (k + 1)) • S k‖ ≤ _
  calc
    _ ≤ ‖f X • S X‖ + ‖∑ k ∈ Finset.Ico 2 X, (f k - f (k + 1)) • S k‖ :=
      norm_add_le _ _
    _ ≤ f X * B + ∑ k ∈ Finset.Ico 2 X, (f k - f (k + 1)) * B := by
      apply add_le_add
      · rw [norm_smul_of_nonneg (hnonneg X hX)]
        exact mul_le_mul_of_nonneg_left (hbound X (Finset.mem_Icc.mpr ⟨hX, le_rfl⟩))
          (hnonneg X hX)
      · apply norm_sum_le_of_le
        intro k hk
        obtain ⟨hk2, hkX⟩ := Finset.mem_Ico.mp hk
        rw [norm_smul_of_nonneg (hdiff k hk2)]
        exact mul_le_mul_of_nonneg_left
          (hbound k (Finset.mem_Icc.mpr ⟨hk2, hkX.le⟩)) (hdiff k hk2)
    _ = (f X + ∑ k ∈ Finset.Ico 2 X, (f k - f (k + 1))) * B := by
      rw [add_mul, Finset.sum_mul]
    _ = B / Real.log 2 := by
      rw [hmass]
      simp only [f, Nat.cast_ofNat, div_eq_mul_inv, mul_comm]

theorem norm_sum_vonMangoldt_sub_sum_prime_log_le
    (X q : ℕ) (χ : DirichletCharacter ℂ q) :
    ‖(∑ n ∈ Finset.Icc 1 X,
        χ (n : ZMod q) * (ArithmeticFunction.vonMangoldt n : ℂ)) -
      ∑ p ∈ Finset.Icc 1 X with Nat.Prime p,
        χ (p : ZMod q) * (Real.log (p : ℝ) : ℂ)‖ ≤
      2 * Real.sqrt (X : ℝ) * Real.log (X : ℝ) := by
  rcases X.eq_zero_or_pos with rfl | hX
  · simp
  have hsum :
      (∑ n ∈ Finset.Icc 1 X,
        χ (n : ZMod q) * (ArithmeticFunction.vonMangoldt n : ℂ)) -
      (∑ p ∈ Finset.Icc 1 X with Nat.Prime p,
        χ (p : ZMod q) * (Real.log (p : ℝ) : ℂ)) =
      ∑ n ∈ Finset.Icc 1 X with ¬ Nat.Prime n,
        χ (n : ZMod q) * (ArithmeticFunction.vonMangoldt n : ℂ) := by
    rw [Finset.sum_filter, Finset.sum_filter, ← Finset.sum_sub_distrib]
    apply Finset.sum_congr rfl
    intro n hn
    by_cases hp : Nat.Prime n
    · simp [hp, ArithmeticFunction.vonMangoldt_apply_prime hp]
    · simp [hp]
  rw [hsum]
  calc
    _ ≤ ∑ n ∈ Finset.Icc 1 X with ¬ Nat.Prime n,
        ArithmeticFunction.vonMangoldt n := by
      refine norm_sum_le_of_le _ fun n _ => ?_
      rw [norm_mul, Complex.norm_of_nonneg ArithmeticFunction.vonMangoldt_nonneg]
      simpa only [one_mul] using
        mul_le_mul_of_nonneg_right (χ.norm_le_one (n : ZMod q))
          ArithmeticFunction.vonMangoldt_nonneg
    _ = Chebyshev.psi (X : ℝ) - Chebyshev.theta (X : ℝ) := by
      rw [Chebyshev.psi_sub_theta_eq_sum_not_prime, Nat.floor_natCast,
        ← Finset.Icc_add_one_left_eq_Ioc]
      rfl
    _ ≤ 2 * Real.sqrt (X : ℝ) * Real.log (X : ℝ) :=
      Chebyshev.psi_sub_theta_le (Nat.one_le_cast.mpr hX)

theorem prime_power_error_le_envelope
    {x c : ℝ} (hx : 0 < x) (hlog : 64 ≤ Real.log x) (hc : c ≤ 1) :
    2 * Real.sqrt x * Real.log x ≤
      x * Real.exp (-c * Real.sqrt (Real.log x)) := by
  let L : ℝ := Real.log x
  let u : ℝ := Real.sqrt L
  have hL64 : 64 ≤ L := hlog
  have hLnonneg : 0 ≤ L := by linarith
  have hunonneg : 0 ≤ u := Real.sqrt_nonneg L
  have husq : u ^ 2 = L := Real.sq_sqrt hLnonneg
  have hu4 : 4 ≤ u := by
    apply (sq_le_sq₀ (by norm_num) hunonneg).mp
    rw [husq]
    linarith
  have hcu : c * u ≤ L / 4 := by
    have := mul_le_mul_of_nonneg_right hc hunonneg
    nlinarith [mul_nonneg hunonneg (sub_nonneg.mpr hu4)]
  have hpoly : 2 * L ≤ Real.exp (L / 4) := by
    have hquad := Real.quadratic_le_exp_of_nonneg (by positivity : 0 ≤ L / 4)
    nlinarith [mul_nonneg hLnonneg (sub_nonneg.mpr hL64)]
  have hsqrt : Real.sqrt x = Real.exp (L / 2) := by
    rw [Real.exp_half, Real.exp_log hx]
  calc
    _ = Real.sqrt x * (2 * L) := by dsimp [L]; ring
    _ ≤ Real.sqrt x * Real.exp (L / 4) :=
      mul_le_mul_of_nonneg_left hpoly (Real.sqrt_nonneg x)
    _ = Real.exp (L / 2 + L / 4) := by rw [hsqrt, Real.exp_add]
    _ ≤ Real.exp (L - c * u) := Real.exp_monotone (by linarith)
    _ = x * Real.exp (-c * Real.sqrt (Real.log x)) := by
      rw [show L - c * u = L + (-c * u) by ring, Real.exp_add,
        show Real.exp L = x from Real.exp_log hx]

theorem norm_sum_range_smul_le_of_partial_sum_bound
    {𝕜 E : Type*} [NormedField 𝕜] [SeminormedAddCommGroup E]
    [NormedSpace 𝕜 E] (w : ℕ → 𝕜) (z : ℕ → E) (N : ℕ) (R : ℝ)
    (hprefix : ∀ k ≤ N, ‖∑ i ∈ Finset.range k, z i‖ ≤ R) :
    ‖∑ i ∈ Finset.range N, w i • z i‖ ≤
      R * (‖w (N - 1)‖ +
        ∑ i ∈ Finset.range (N - 1), ‖w (i + 1) - w i‖) := by
  rw [Finset.sum_range_by_parts]
  refine (norm_sub_le _ _).trans ?_
  calc
    _ ≤ ‖w (N - 1)‖ * R +
        ∑ i ∈ Finset.range (N - 1), ‖w (i + 1) - w i‖ * R := by
      apply add_le_add
      · exact (norm_smul_le _ _).trans
          (mul_le_mul_of_nonneg_left (hprefix N le_rfl) (norm_nonneg _))
      · refine norm_sum_le_of_le _ fun i hi ↦ ?_
        exact (norm_smul_le _ _).trans (mul_le_mul_of_nonneg_left
          (hprefix (i + 1) (Nat.add_lt_of_lt_sub (Finset.mem_range.mp hi)).le)
          (norm_nonneg _))
    _ = _ := by rw [← Finset.sum_mul, ← add_mul, mul_comm]

end PrimeGap186

theorem PrimeGap186.nat_floor_div_log_le_two_mul_div_log
    (y : ℝ) (hy : 4 ≤ y) :
    (Nat.floor y : ℝ) / Real.log (Nat.floor y : ℝ) ≤
      2 * y / Real.log y := by
  have hy0 : 0 ≤ y := by linarith
  have hn : 4 ≤ Nat.floor y := Nat.le_floor hy
  have hn4 : (4 : ℝ) ≤ (Nat.floor y : ℝ) := by exact_mod_cast hn
  have hny : (Nat.floor y : ℝ) ≤ y := Nat.floor_le hy0
  have hyN : y < (Nat.floor y : ℝ) + 1 := Nat.lt_floor_add_one y
  have hySq : y ≤ (Nat.floor y : ℝ) ^ 2 := by nlinarith
  have hnlog : 0 < Real.log (Nat.floor y : ℝ) := Real.log_pos (by linarith)
  have hylog : 0 < Real.log y := Real.log_pos (by linarith)
  have hlogs : Real.log y ≤ 2 * Real.log (Nat.floor y : ℝ) := by
    calc
      Real.log y ≤ Real.log ((Nat.floor y : ℝ) ^ 2) :=
        Real.log_le_log (by linarith) hySq
      _ = 2 * Real.log (Nat.floor y : ℝ) := by rw [Real.log_pow]; norm_num
  apply (div_le_div_iff₀ hnlog hylog).2
  calc
    (Nat.floor y : ℝ) * Real.log y ≤
        (Nat.floor y : ℝ) * (2 * Real.log (Nat.floor y : ℝ)) :=
      mul_le_mul_of_nonneg_left hlogs (Nat.cast_nonneg _)
    _ ≤ y * (2 * Real.log (Nat.floor y : ℝ)) :=
      mul_le_mul_of_nonneg_right hny (by positivity)
    _ = (2 * y) * Real.log (Nat.floor y : ℝ) := by ring

theorem PrimeGap186.abs_psi_sub_self_le_nat_floor_error_add_one
    (y : ℝ) (hy : 0 ≤ y) :
    |Chebyshev.psi y - y| ≤
      |Chebyshev.psi (Nat.floor y : ℝ) - (Nat.floor y : ℝ)| + 1 := by
  calc
    |Chebyshev.psi y - y| =
        |(Chebyshev.psi (Nat.floor y : ℝ) - (Nat.floor y : ℝ)) +
          ((Nat.floor y : ℝ) - y)| := by
      rw [Chebyshev.psi_eq_psi_coe_floor y]
      congr 1
      ring
    _ ≤ |Chebyshev.psi (Nat.floor y : ℝ) - (Nat.floor y : ℝ)| +
        |(Nat.floor y : ℝ) - y| := abs_add_le _ _
    _ ≤ |Chebyshev.psi (Nat.floor y : ℝ) - (Nat.floor y : ℝ)| + 1 :=
      add_le_add le_rfl (Nat.abs_floor_sub_le hy)

theorem PrimeGap186.abs_psi_sub_self_le_mul_div_log_of_nat_bound
    (K : ℝ) (N₀ : ℕ) (hK : 0 ≤ K) (hN₀ : 4 ≤ N₀)
    (hNat : ∀ N : ℕ, N₀ ≤ N →
      |Chebyshev.psi (N : ℝ) - (N : ℝ)| ≤
        K * (N : ℝ) / Real.log (N : ℝ)) :
    ∀ y : ℝ, (N₀ : ℝ) ≤ y →
      |Chebyshev.psi y - y| ≤ (2 * K + 1) * y / Real.log y := by
  intro y hy
  have hN₀real : (4 : ℝ) ≤ (N₀ : ℝ) := by exact_mod_cast hN₀
  have hy4 : 4 ≤ y := hN₀real.trans hy
  have hy0 : 0 ≤ y := by linarith
  have hn : N₀ ≤ Nat.floor y := Nat.le_floor hy
  have hylog : 0 < Real.log y := Real.log_pos (by linarith)
  have hunit : 1 ≤ y / Real.log y :=
    (one_le_div₀ hylog).2 (Real.log_le_self hy0)
  calc
    |Chebyshev.psi y - y| ≤
        |Chebyshev.psi (Nat.floor y : ℝ) - (Nat.floor y : ℝ)| + 1 :=
      PrimeGap186.abs_psi_sub_self_le_nat_floor_error_add_one y hy0
    _ ≤ K * (Nat.floor y : ℝ) / Real.log (Nat.floor y : ℝ) + 1 :=
      add_le_add (hNat _ hn) le_rfl
    _ = K * ((Nat.floor y : ℝ) / Real.log (Nat.floor y : ℝ)) + 1 := by ring
    _ ≤ K * (2 * y / Real.log y) + y / Real.log y :=
      add_le_add
        (mul_le_mul_of_nonneg_left
          (PrimeGap186.nat_floor_div_log_le_two_mul_div_log y hy4) hK) hunit
    _ = (2 * K + 1) * y / Real.log y := by ring

theorem PrimeGap186.exp_neg_mul_sqrt_le_two_div_sq_mul
    (c t : ℝ) (hc : 0 < c) (ht : 0 < t) :
    Real.exp (-c * Real.sqrt t) ≤ 2 / (c ^ 2 * t) := by
  have hpow := Real.pow_div_factorial_le_exp (x := c * Real.sqrt t)
    (mul_nonneg hc.le (Real.sqrt_nonneg t)) 2
  norm_num [mul_pow, Real.sq_sqrt ht.le] at hpow
  rw [neg_mul, Real.exp_neg, inv_eq_one_div]
  apply (div_le_div_iff₀ (Real.exp_pos _) (mul_pos (sq_pos_of_pos hc) ht)).2
  linarith

theorem PrimeGap186.abs_psi_nat_sub_self_le_mul_div_log_of_exp_bound
    (C c : ℝ) (N₀ : ℕ) (hC : 0 < C) (hc : 0 < c) (hN₀ : 4 ≤ N₀)
    (hExp : ∀ N : ℕ, N₀ ≤ N →
      |Chebyshev.psi (N : ℝ) - (N : ℝ)| ≤
        C * ((N : ℝ) * Real.exp (-c * Real.sqrt (Real.log (N : ℝ))))) :
    0 ≤ 2 * C / c ^ 2 ∧
      ∀ N : ℕ, N₀ ≤ N →
        |Chebyshev.psi (N : ℝ) - (N : ℝ)| ≤
          (2 * C / c ^ 2) * (N : ℝ) / Real.log (N : ℝ) := by
  refine ⟨by positivity, ?_⟩
  intro N hN
  have hN4 : (4 : ℝ) ≤ (N : ℝ) := by exact_mod_cast hN₀.trans hN
  have hlog : 0 < Real.log (N : ℝ) := Real.log_pos (by linarith)
  have hbound := PrimeGap186.exp_neg_mul_sqrt_le_two_div_sq_mul
    c (Real.log (N : ℝ)) hc hlog
  calc
    |Chebyshev.psi (N : ℝ) - (N : ℝ)| ≤
        C * ((N : ℝ) * Real.exp (-c * Real.sqrt (Real.log (N : ℝ)))) := hExp N hN
    _ = (C * (N : ℝ)) * Real.exp (-c * Real.sqrt (Real.log (N : ℝ))) := by ring
    _ ≤ (C * (N : ℝ)) * (2 / (c ^ 2 * Real.log (N : ℝ))) :=
      mul_le_mul_of_nonneg_left hbound (mul_nonneg hC.le (Nat.cast_nonneg N))
    _ = (2 * C / c ^ 2) * (N : ℝ) / Real.log (N : ℝ) := by
      rw [← div_div]
      ring

section
open Filter Asymptotics

theorem PrimeGap186.exists_primeCounting_real_logSquare_error_of_psi_bound
    (K T : ℝ) (hK : 0 ≤ K) (hT : 4 ≤ T)
    (hpsi : ∀ y : ℝ, T ≤ y →
      |Chebyshev.psi y - y| ≤ K * y / Real.log y) :
    ∃ C Y0 : ℝ, 0 < C ∧ 2 ≤ Y0 ∧
      ∀ y : ℝ, Y0 ≤ y →
        |(Nat.primeCounting (Nat.floor y) : ℝ) -
            y / Real.log y| ≤ C * y / (Real.log y) ^ 2 := by
  have hpsiO : (fun y : ℝ => Chebyshev.psi y - y) =O[atTop]
      (fun y => y / Real.log y) := by
    refine isBigO_iff'.2 ⟨K + 1, by linarith, ?_⟩
    filter_upwards [eventually_ge_atTop T] with y hy
    have hy0 : 0 ≤ y := by linarith
    have hlog : 0 < Real.log y := Real.log_pos (by linarith)
    rw [Real.norm_eq_abs, Real.norm_eq_abs,
      abs_of_nonneg (div_nonneg hy0 hlog.le)]
    calc
      |Chebyshev.psi y - y| ≤ K * y / Real.log y := hpsi y hy
      _ ≤ (K + 1) * (y / Real.log y) := by
        rw [mul_div_assoc]
        exact mul_le_mul_of_nonneg_right (by linarith) (div_nonneg hy0 hlog.le)
  have hlogO : Real.log =O[atTop] Real.sqrt :=
    (isLittleO_log_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 2)).isBigO.congr_right
      (fun y => (Real.sqrt_eq_rpow y).symm)
  have hmul : (fun y : ℝ => Real.log y * Real.sqrt y) =O[atTop]
      (fun y => y) := by
    refine (hlogO.mul (isBigO_refl Real.sqrt atTop)).congr' .rfl ?_
    filter_upwards [eventually_ge_atTop 0] with y hy
    exact Real.mul_self_sqrt hy
  have hlog_ne : ∀ᶠ y : ℝ in atTop, Real.log y ≠ 0 :=
    (eventually_gt_atTop 1).mono fun _ hy => (Real.log_pos hy).ne'
  have hsqrt : Real.sqrt =O[atTop] (fun y : ℝ => y / Real.log y) :=
    (isBigO_mul_iff_isBigO_div hlog_ne).1 hmul
  have htheta : (fun y : ℝ => Chebyshev.theta y - y) =O[atTop]
      (fun y => y / Real.log y) :=
    (hpsiO.sub (Chebyshev.isBigO_psi_sub_theta_sqrt.trans hsqrt)).congr_left
      (fun y => by dsimp; ring)
  have htheta_div : (fun y : ℝ => Chebyshev.theta y / Real.log y - y / Real.log y)
      =O[atTop] (fun y => y / Real.log y ^ 2) := by
    refine (htheta.mul (isBigO_refl (fun y : ℝ => 1 / Real.log y) atTop)).congr ?_ ?_
    · intro y
      ring
    · intro y
      ring
  have hfinal : (fun y : ℝ => (Nat.primeCounting (Nat.floor y) : ℝ) -
      y / Real.log y) =O[atTop] (fun y => y / Real.log y ^ 2) :=
    (Chebyshev.primeCounting_sub_theta_div_log_isBigO.add htheta_div).congr_left
      (fun y => by ring)
  obtain ⟨C, hC, hbound⟩ := isBigO_iff'.1 hfinal
  obtain ⟨B, hB⟩ := eventually_atTop.1 hbound
  refine ⟨C, max 2 (max T B), hC, le_max_left _ _, ?_⟩
  intro y hy
  have hyT : T ≤ y := (le_max_left T B).trans ((le_max_right 2 (max T B)).trans hy)
  have hyB : B ≤ y := (le_max_right T B).trans ((le_max_right 2 (max T B)).trans hy)
  have h := hB y hyB
  rw [Real.norm_eq_abs, Real.norm_eq_abs,
    abs_of_nonneg (div_nonneg (by linarith : 0 ≤ y) (sq_nonneg _))] at h
  simpa only [mul_div_assoc] using h

end

namespace PrimeGap186

/--
Push the weights `w 0, …, w (N - 1)` from the integer interval beginning at `A` onto residue
classes modulo `q`, summing weights with the same residue.
-/
noncomputable def integerIntervalResidueWeight
    (q : ℕ) (A : ℤ) (N : ℕ) (w : ℕ → ℂ)
    (x : ZMod q) : ℂ := by
  classical
  exact ∑ n ∈ Finset.range N,
    if ((A + n : ℤ) : ZMod q) = x then w n else 0

open Classical in
theorem integerIntervalResidueWeight_spec
    (q : ℕ) [NeZero q] (A : ℤ) (N : ℕ) (w : ℕ → ℂ) :
    let W : ZMod q → ℂ := integerIntervalResidueWeight q A N w
    (∀ F : ZMod q → ℂ,
      (∑ x : ZMod q, W x * F x) =
        ∑ n ∈ Finset.range N, w n * F ((A + n : ℤ) : ZMod q)) ∧
    (∀ ξ : ZMod q,
      ZMod.dft W ξ = ∑ n ∈ Finset.range N,
        w n * ZMod.stdAddChar (-(((A + n : ℤ) : ZMod q) * ξ))) ∧
    ((∑ x : ZMod q, W x) = ∑ n ∈ Finset.range N, w n) ∧
    (N = 0 → W = 0) ∧
    (q = 1 → ∀ x : ZMod q, W x = ∑ n ∈ Finset.range N, w n) := by
  dsimp only
  have pair (F : ZMod q → ℂ) :
      (∑ x : ZMod q, integerIntervalResidueWeight q A N w x * F x) =
        ∑ n ∈ Finset.range N, w n * F ((A + n : ℤ) : ZMod q) := by
    simp only [integerIntervalResidueWeight, Finset.sum_mul]
    rw [Finset.sum_comm]
    simp only [ite_mul, zero_mul, Fintype.sum_ite_eq]
  refine ⟨pair, ?_, ?_, ?_, ?_⟩
  · intro ξ
    rw [ZMod.dft_apply]
    simpa only [smul_eq_mul, mul_comm] using
      pair (fun x => ZMod.stdAddChar (-(x * ξ)))
  · simpa using pair (fun _ => 1)
  · rintro rfl
    ext x
    simp [integerIntervalResidueWeight]
  · intro h x
    subst q
    simp [integerIntervalResidueWeight, Subsingleton.elim (_ : ZMod 1) x]

theorem four_mul_min_val_div_le_norm_stdAddChar_sub_one (q : ℕ) [NeZero q] (j : ZMod q) :
    4 * (min j.val (q - j.val) : ℝ) / (q : ℝ) ≤ ‖ZMod.stdAddChar j - 1‖ := by
  let k := j.val
  have hk : k ≤ q := (ZMod.val_lt j).le
  have hq : 0 < (q : ℝ) := by exact_mod_cast NeZero.pos q
  have hk' : (k : ℝ) ≤ q := by exact_mod_cast hk
  have hz : (0 : ℝ) ≤ k := Nat.cast_nonneg _
  rw [ZMod.stdAddChar_apply, ZMod.toCircle_eq_circleExp, Circle.coe_exp]
  have hx : ((2 * Real.pi * ((j.val : ℝ) / q) : ℝ) : ℂ) * Complex.I =
      Complex.I * (((2 * Real.pi * ((k : ℝ) / q)) : ℝ) : ℂ) := by simp [k, mul_comm]
  rw [hx, Complex.norm_exp_I_mul_ofReal_sub_one]
  have hsin : 2 * ((min k (q - k) : ℕ) : ℝ) / (q : ℝ) ≤
      Real.sin (Real.pi * ((k : ℝ) / q)) := by
    by_cases hhalf : 2 * k ≤ q
    · have hx0 : 0 ≤ Real.pi * ((k : ℝ) / q) := mul_nonneg Real.pi_pos.le (div_nonneg hz hq.le)
      have hxle : Real.pi * ((k : ℝ) / q) ≤ Real.pi / 2 := by
        have : 2 * (k : ℝ) ≤ q := by exact_mod_cast hhalf
        apply (mul_le_mul_of_nonneg_left _ Real.pi_pos.le)
        exact (div_le_iff₀ hq).2 (by linarith)
      have hmin : min k (q - k) = k := Nat.min_eq_left (by omega)
      rw [hmin]
      convert Real.mul_le_sin hx0 hxle using 1
      field_simp
    · have hx0 : 0 ≤ Real.pi * (((q - k : ℕ) : ℝ) / q) := by positivity
      have hxle : Real.pi * (((q - k : ℕ) : ℝ) / q) ≤ Real.pi / 2 := by
        have : 2 * ((q - k : ℕ) : ℝ) ≤ q := by
          rw [Nat.cast_sub hk]
          have hh : (q : ℝ) ≤ 2 * k := by exact_mod_cast (Nat.le_of_not_ge hhalf)
          linarith
        apply (mul_le_mul_of_nonneg_left _ Real.pi_pos.le)
        exact (div_le_iff₀ hq).2 (by linarith)
      have hmin : min k (q - k) = q - k := Nat.min_eq_right (by omega)
      have hs : Real.sin (Real.pi * (((q - k : ℕ) : ℝ) / q)) =
          Real.sin (Real.pi * ((k : ℝ) / q)) := by
        rw [Nat.cast_sub hk]
        convert Real.sin_pi_sub (Real.pi * ((k : ℝ) / q)) using 2
        field_simp
      rw [hmin, ← hs]
      convert Real.mul_le_sin hx0 hxle using 1
      field_simp
  have htheta : 0 ≤ Real.sin (Real.pi * ((k : ℝ) / q)) :=
    Real.sin_nonneg_of_nonneg_of_le_pi (by positivity) (by
      calc
        Real.pi * ((k : ℝ) / q) ≤ Real.pi * (1 : ℝ) :=
          mul_le_mul_of_nonneg_left ((div_le_one hq).2 hk') Real.pi_pos.le
        _ = _ := by simp)
  rw [show (2 * Real.pi * ((k : ℝ) / q)) / 2 = Real.pi * ((k : ℝ) / q) by ring,
    Real.norm_eq_abs, abs_of_nonneg (mul_nonneg (by norm_num) htheta)]
  simp only [Nat.cast_min, Nat.cast_sub hk] at hsin
  dsimp only [k] at *
  convert (mul_le_mul_of_nonneg_left hsin (by norm_num : (0 : ℝ) ≤ 2)) using 1 <;>
    first | rfl | ring

theorem gcd_eq_sum_totient_common_divisors (a b : ℕ) (ha : 0 < a) :
    (Nat.gcd a b : ℝ) = ∑ d ∈ a.divisors with d ∣ b, (Nat.totient d : ℝ) := by
  have heq : (Nat.gcd a b).divisors = a.divisors.filter (fun d => d ∣ b) := by
    ext d
    simp [Nat.mem_divisors, Nat.dvd_gcd_iff, ha.ne',
      (Nat.gcd_pos_of_pos_left b ha).ne']
  exact_mod_cast (heq ▸ Nat.sum_totient (Nat.gcd a b)).symm

theorem sum_pos_multiples {M : Type*} [AddCommMonoid M]
    (T d : ℕ) (hd : 0 < d) (f : ℕ → M) :
    (∑ k ∈ (Finset.Icc 1 T).filter (fun k => d ∣ k), f k) =
      ∑ i ∈ Finset.Icc 1 (T / d), f (d * i) := by
  classical
  symm
  refine Finset.sum_bij (fun i _ => d * i) ?_ ?_ ?_ (fun _ _ => rfl)
  · intro i hi
    have hi' := Finset.mem_Icc.mp hi
    apply Finset.mem_filter.mpr
    refine ⟨Finset.mem_Icc.mpr ⟨Nat.mul_pos hd (by omega), ?_⟩, dvd_mul_right _ _⟩
    simpa only [mul_comm] using (Nat.le_div_iff_mul_le hd).1 hi'.2
  · intro i hi j hj he
    exact Nat.eq_of_mul_eq_mul_left hd he
  · intro k hk
    obtain ⟨⟨hk1, hkT⟩, ℓ, hℓ⟩ := Finset.mem_filter.mp hk |>.imp Finset.mem_Icc.mp id
    refine ⟨ℓ, Finset.mem_Icc.mpr ⟨?_, ?_⟩, ?_⟩
    · exact Nat.pos_of_mul_pos_left (hℓ ▸ hk1)
    · exact (Nat.le_div_iff_mul_le hd).mpr (by simpa [mul_comm] using hℓ ▸ hkT)
    · exact hℓ.symm

theorem sum_gcd_mul_eq_sum_totient_mul (a T : ℕ) (ha : 0 < a) (u : ℕ → ℝ) :
    (∑ k ∈ Finset.Icc 1 T, (Nat.gcd a k : ℝ) * u k) =
      ∑ d ∈ a.divisors, ∑ k ∈ (Finset.Icc 1 T).filter (fun k => d ∣ k),
        (Nat.totient d : ℝ) * u k := by
  classical
  simp_rw [gcd_eq_sum_totient_common_divisors a _ ha, Finset.sum_filter,
    Finset.sum_mul, ite_mul, zero_mul]
  rw [Finset.sum_comm]

theorem sum_gcd_mul_inv_le_card_divisors_mul_one_add_log (a T : ℕ) (ha : 0 < a) :
    (∑ k ∈ Finset.Icc 1 T, (Nat.gcd a k : ℝ) * (k : ℝ)⁻¹) ≤
      (a.divisors.card : ℝ) * (1 + Real.log (T : ℝ)) := by
  classical
  rw [sum_gcd_mul_eq_sum_totient_mul a T ha]
  have each (d : ℕ) (hd : d ∈ a.divisors) :
      (∑ k ∈ (Finset.Icc 1 T).filter (fun k => d ∣ k),
          (Nat.totient d : ℝ) * (k : ℝ)⁻¹) ≤ 1 + Real.log (T : ℝ) := by
    have hd0 : 0 < d := Nat.pos_of_dvd_of_pos (Nat.mem_divisors.mp hd).1 ha
    rw [sum_pos_multiples T d hd0]
    calc
      _ ≤ ∑ i ∈ Finset.Icc 1 (T / d), (i : ℝ)⁻¹ := by
        apply Finset.sum_le_sum
        intro i hi
        have : (Nat.totient d : ℝ) ≤ (d : ℝ) := by exact_mod_cast Nat.totient_le d
        rw [Nat.cast_mul, mul_inv_rev]
        calc
          _ ≤ (d : ℝ) * ((i : ℝ)⁻¹ * (d : ℝ)⁻¹) := by
            exact mul_le_mul_of_nonneg_right this (by positivity)
          _ = (i : ℝ)⁻¹ := by field_simp
      _ ≤ ∑ i ∈ Finset.Icc 1 T, (i : ℝ)⁻¹ := by
        apply Finset.sum_le_sum_of_subset_of_nonneg
          (Finset.Icc_subset_Icc_right (Nat.div_le_self _ _))
        intros; positivity
      _ = (harmonic T : ℝ) := by
        simp only [harmonic_eq_sum_Icc, Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast]
      _ ≤ 1 + Real.log (T : ℝ) := harmonic_le_one_add_log T
  calc
    _ ≤ ∑ _d ∈ a.divisors, (1 + Real.log (T : ℝ)) := Finset.sum_le_sum each
    _ = _ := by simp [mul_add]

theorem sum_zmod_erase_zero_eq_sum_Ico (q : ℕ) [NeZero q] (u : ℕ → ℝ) :
    (∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0, u ξ.val) =
      ∑ k ∈ Finset.Ico 1 q, u k := by
  classical
  rw [Finset.sum_erase_eq_sub (Finset.mem_univ 0), ZMod.val_zero,
    Finset.sum_Ico_eq_sub u (Nat.one_le_iff_ne_zero.mpr (NeZero.ne q)),
    Finset.sum_range_one]
  congr 1
  cases q with
  | zero => exact (NeZero.ne 0 rfl).elim
  | succ q => exact Fin.sum_univ_eq_sum_range u (q + 1)

theorem sum_Ico_one_reflect (q : ℕ) (u : ℕ → ℝ) :
    (∑ k ∈ Finset.Ico 1 q, u (q - k)) = ∑ k ∈ Finset.Ico 1 q, u k := by
  simpa using Finset.sum_Ico_reflect u 1 (m := q) (n := q) (Nat.le_succ q)

open Classical in
theorem integerIntervalResidueWeight_geometric_l1
    (q : ℕ) [NeZero q] (A : ℤ) (N : ℕ) :
    let W : ZMod q → ℂ := integerIntervalResidueWeight q A N (fun _ => 1)
    let m : ZMod q → ℕ := fun ξ => min ξ.val (q - ξ.val)
    (∀ ξ : ZMod q,
      ZMod.dft W ξ = ZMod.stdAddChar (-((A : ZMod q) * ξ)) *
        ∑ n ∈ Finset.range N, (ZMod.stdAddChar (-ξ)) ^ n) ∧
    ZMod.dft W 0 = (N : ℂ) ∧
    (∀ ξ : ZMod q, ξ ≠ 0 →
      0 < m ξ ∧
        ‖ZMod.dft W ξ‖ ≤
          min (N : ℝ) ((q : ℝ) / (2 * (m ξ : ℝ)))) ∧
    (∀ g : ℕ, g ∣ q →
      ((1 / (q : ℝ)) *
          ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0,
            ‖ZMod.dft W ξ‖ * (Nat.gcd g ξ.val : ℝ) ≤
        2 * (g.divisors.card : ℝ) * (1 + Real.log (q : ℝ))) ∧
      ((1 / (q : ℝ)) * ∑ ξ : ZMod q,
            ‖ZMod.dft W ξ‖ * (Nat.gcd g ξ.val : ℝ) ≤
        (N : ℝ) * (g : ℝ) / (q : ℝ) +
          2 * (g.divisors.card : ℝ) * (1 + Real.log (q : ℝ)))) := by
  dsimp only
  let W := integerIntervalResidueWeight q A N (fun _ => 1)
  have geom (ξ : ZMod q) : ZMod.dft W ξ =
      ZMod.stdAddChar (-((A : ZMod q) * ξ)) *
        ∑ n ∈ Finset.range N, (ZMod.stdAddChar (-ξ)) ^ n := by
    rw [(integerIntervalResidueWeight_spec q A N (fun _ => 1)).2.1 ξ]
    rw [Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro n hn
    simp only [one_mul]
    rw [← AddChar.map_nsmul_eq_pow]
    rw [← AddChar.map_add_eq_mul]
    congr 1
    push_cast
    simp [nsmul_eq_mul]
    ring
  have zero : ZMod.dft W 0 = (N : ℂ) := by
    rw [ZMod.dft_apply_zero]
    simpa using (integerIntervalResidueWeight_spec q A N (fun _ => 1)).2.2.1
  have pt (ξ : ZMod q) (hξ : ξ ≠ 0) : 0 < min ξ.val (q - ξ.val) ∧
      ‖ZMod.dft W ξ‖ ≤ min (N : ℝ) ((q : ℝ) / (2 * ((min ξ.val (q - ξ.val) : ℕ) : ℝ))) := by
    let m := min ξ.val (q - ξ.val)
    have hm : 0 < m := lt_min (ZMod.val_pos.mpr hξ) (Nat.sub_pos_of_lt (ZMod.val_lt ξ))
    have hm' : 0 < (m : ℝ) := by exact_mod_cast hm
    have hq : 0 < (q : ℝ) := by exact_mod_cast NeZero.pos q
    have hunit (j : ZMod q) : ‖ZMod.stdAddChar j‖ = 1 := by
      rw [ZMod.stdAddChar_apply, Circle.norm_coe]
    have hx : ZMod.stdAddChar (-ξ) ≠ 1 := by
      intro hx
      apply hξ
      have hz : ZMod.stdAddChar (-ξ) = ZMod.stdAddChar (0 : ZMod q) := by simpa using hx
      exact neg_eq_zero.mp (ZMod.injective_stdAddChar hz)
    have hden : 4 * (m : ℝ) / (q : ℝ) ≤ ‖ZMod.stdAddChar (-ξ) - 1‖ := by
      let _ : NeZero ξ := ⟨hξ⟩
      have ht := four_mul_min_val_div_le_norm_stdAddChar_sub_one q (-ξ)
      rw [ZMod.val_neg_of_ne_zero ξ] at ht
      rw [← Nat.cast_sub (Nat.sub_le q ξ.val), Nat.sub_sub_self (ZMod.val_lt ξ).le,
        ← Nat.cast_min, min_comm] at ht
      exact ht
    have hden0 : 0 < ‖ZMod.stdAddChar (-ξ) - 1‖ :=
      lt_of_lt_of_le (div_pos (mul_pos (by norm_num) hm') hq) hden
    refine ⟨hm, le_min ?_ ?_⟩
    · rw [geom ξ, norm_mul, hunit, one_mul]
      exact (norm_sum_le _ _).trans_eq (by simp [norm_pow, hunit])
    · rw [geom ξ, geom_sum_eq hx, norm_mul, hunit, one_mul, norm_div]
      have hnum : ‖ZMod.stdAddChar (-ξ) ^ N - 1‖ ≤ (2 : ℝ) := by
        calc
          _ ≤ ‖ZMod.stdAddChar (-ξ) ^ N‖ + ‖(1 : ℂ)‖ := norm_sub_le _ _
          _ = _ := by simp [norm_pow, hunit]; norm_num
      calc
        _ ≤ (2 : ℝ) / ‖ZMod.stdAddChar (-ξ) - 1‖ := by gcongr
        _ ≤ (q : ℝ) / (2 * (m : ℝ)) := by
          apply (div_le_div_iff₀ hden0 (by positivity : (0 : ℝ) < 2 * m)).2
          have ht := (div_le_iff₀ hq).mp hden
          convert ht using 1 <;> first | rfl | ring
  refine ⟨geom, zero, (fun ξ hξ => pt ξ hξ), ?_⟩
  intro g hg
  have hgpos : 0 < g := Nat.pos_of_dvd_of_pos hg (NeZero.pos q)
  have hq : 0 < (q : ℝ) := by exact_mod_cast NeZero.pos q
  have nz : (1 / (q : ℝ)) *
      (∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0,
        ‖ZMod.dft W ξ‖ * (Nat.gcd g ξ.val : ℝ)) ≤
      2 * (g.divisors.card : ℝ) * (1 + Real.log (q : ℝ)) := by
    have each (ξ : ZMod q) (hξ : ξ ≠ 0) :
        (1 / (q : ℝ)) * (‖ZMod.dft W ξ‖ * (Nat.gcd g ξ.val : ℝ)) ≤
          (Nat.gcd g ξ.val : ℝ) *
            ((ξ.val : ℝ)⁻¹ + ((q - ξ.val : ℕ) : ℝ)⁻¹) := by
      let k := ξ.val
      let m := min k (q - k)
      have hm : 0 < (m : ℝ) := by exact_mod_cast (pt ξ hξ).1
      have hrec : (m : ℝ)⁻¹ ≤ (k : ℝ)⁻¹ + ((q - k : ℕ) : ℝ)⁻¹ := by
        by_cases hk : k ≤ q - k
        · rw [show m = k from min_eq_left hk]
          exact le_add_of_nonneg_right (by positivity)
        · rw [show m = q - k from min_eq_right (Nat.le_of_not_ge hk)]
          exact le_add_of_nonneg_left (by positivity)
      have hweak : ‖ZMod.dft W ξ‖ ≤ (q : ℝ) * ((k : ℝ)⁻¹ + ((q - k : ℕ) : ℝ)⁻¹) := by
        calc
          _ ≤ (q : ℝ) / (2 * (m : ℝ)) := ((pt ξ hξ).2).trans (min_le_right _ _)
          _ ≤ (q : ℝ) / (m : ℝ) := by gcongr; linarith
          _ = (q : ℝ) * (m : ℝ)⁻¹ := div_eq_mul_inv _ _
          _ ≤ _ := mul_le_mul_of_nonneg_left hrec hq.le
      calc
        _ ≤ (1 / (q : ℝ)) * ((q : ℝ) * ((k : ℝ)⁻¹ + ((q - k : ℕ) : ℝ)⁻¹) *
            (Nat.gcd g ξ.val : ℝ)) := by gcongr
        _ = _ := by
          dsimp only [k]
          field_simp
    rw [Finset.mul_sum]
    calc
      _ ≤ ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0, (Nat.gcd g ξ.val : ℝ) *
            ((ξ.val : ℝ)⁻¹ + ((q - ξ.val : ℕ) : ℝ)⁻¹) := by
        apply Finset.sum_le_sum
        intro ξ hξ
        exact each ξ (Finset.mem_erase.mp hξ).1
      _ = 2 * ∑ k ∈ Finset.Ico 1 q, (Nat.gcd g k : ℝ) * (k : ℝ)⁻¹ := by
        rw [show (∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0, (Nat.gcd g ξ.val : ℝ) *
              ((ξ.val : ℝ)⁻¹ + ((q - ξ.val : ℕ) : ℝ)⁻¹)) =
              ∑ k ∈ Finset.Ico 1 q, (Nat.gcd g k : ℝ) *
                ((k : ℝ)⁻¹ + ((q - k : ℕ) : ℝ)⁻¹) from
            sum_zmod_erase_zero_eq_sum_Ico q
              (fun k => (Nat.gcd g k : ℝ) * ((k : ℝ)⁻¹ + ((q - k : ℕ) : ℝ)⁻¹))]
        simp_rw [mul_add]
        rw [Finset.sum_add_distrib]
        have href : (∑ k ∈ Finset.Ico 1 q, (Nat.gcd g k : ℝ) * ((q - k : ℕ) : ℝ)⁻¹) =
            ∑ k ∈ Finset.Ico 1 q, (Nat.gcd g k : ℝ) * (k : ℝ)⁻¹ := by
          calc
            _ = ∑ k ∈ Finset.Ico 1 q, (Nat.gcd g (q - k) : ℝ) * ((q - k : ℕ) : ℝ)⁻¹ := by
              apply Finset.sum_congr rfl
              intro k hk
              rw [Nat.gcd_sub_left_right_of_dvd g (Finset.mem_Ico.mp hk).2.le hg]
            _ = _ := sum_Ico_one_reflect q (fun k => (Nat.gcd g k : ℝ) * (k : ℝ)⁻¹)
        rw [href]
        ring
      _ ≤ 2 * ∑ k ∈ Finset.Icc 1 q, (Nat.gcd g k : ℝ) * (k : ℝ)⁻¹ := by
        gcongr
        exact Finset.Ico_subset_Icc_self
      _ ≤ _ := by
        simpa [mul_assoc] using
          (mul_le_mul_of_nonneg_left (sum_gcd_mul_inv_le_card_divisors_mul_one_add_log g q hgpos)
            (by norm_num : (0 : ℝ) ≤ 2))
  refine ⟨nz, ?_⟩
  rw [← Finset.sum_erase_add (Finset.univ : Finset (ZMod q)) _ (Finset.mem_univ 0),
    mul_add]
  rw [show ZMod.dft (integerIntervalResidueWeight q A N (fun _ => 1)) 0 = (N : ℂ) from zero]
  simp only [Complex.norm_natCast, ZMod.val_zero, Nat.gcd_zero_right]
  convert (add_le_add_right nz ((1 / (q : ℝ)) * ((N : ℝ) * g))) using 1 <;>
    dsimp only [W] at *
  all_goals ring

open Classical in
theorem integerIntervalResidueWeight_variation_and_derivative
    (q : ℕ) [NeZero q] (A : ℤ) (N : ℕ) :
    (∀ (w : ℕ → ℂ) (g : ℕ), g ∣ q →
      let V : ℝ := if N = 0 then 0 else
        ‖w (N - 1)‖ + ∑ n ∈ Finset.range (N - 1), ‖w (n + 1) - w n‖
      (1 / (q : ℝ)) *
          ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0,
            ‖ZMod.dft (integerIntervalResidueWeight q A N w) ξ‖ *
              (Nat.gcd g ξ.val : ℝ) ≤
        2 * V * (g.divisors.card : ℝ) * (1 + Real.log (q : ℝ))) ∧
    (∀ (f : ℝ → ℂ) (X B D : ℝ),
      0 < X → 0 ≤ B → 0 ≤ D →
      (∀ t ∈ Set.Icc (A : ℝ) ((A : ℝ) + (N : ℝ)),
        DifferentiableAt ℝ f t) →
      (∀ t ∈ Set.Icc (A : ℝ) ((A : ℝ) + (N : ℝ)),
        ‖f t‖ ≤ B ∧ ‖deriv f t‖ ≤ D / X) →
      ∀ g : ℕ, g ∣ q →
        (1 / (q : ℝ)) *
            ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0,
              ‖ZMod.dft (integerIntervalResidueWeight q A N
                (fun n => f ((A : ℝ) + (n : ℝ)))) ξ‖ *
                  (Nat.gcd g ξ.val : ℝ) ≤
          2 * (B + (N : ℝ) * D / X) * (g.divisors.card : ℝ) *
            (1 + Real.log (q : ℝ))) := by
  have hB (L g : ℕ) (hg : g ∣ q) :
      (1 / (q : ℝ)) *
          (∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0,
            ‖ZMod.dft (integerIntervalResidueWeight q A L (fun _ => 1)) ξ‖ *
              (Nat.gcd g ξ.val : ℝ)) ≤
        2 * (g.divisors.card : ℝ) * (1 + Real.log (q : ℝ)) :=
    ((integerIntervalResidueWeight_geometric_l1 q A L).2.2.2 g hg).1
  have abel (w : ℕ → ℂ) (ξ : ZMod q) :
      ZMod.dft (integerIntervalResidueWeight q A N w) ξ =
        w (N - 1) * ZMod.dft (integerIntervalResidueWeight q A N (fun _ => 1)) ξ -
          ∑ i ∈ Finset.range (N - 1), (w (i + 1) - w i) *
            ZMod.dft (integerIntervalResidueWeight q A (i + 1) (fun _ => 1)) ξ := by
    have uch (L : ℕ) : ZMod.dft (integerIntervalResidueWeight q A L (fun _ => 1)) ξ =
        ∑ i ∈ Finset.range L, ZMod.stdAddChar (-(((A + i : ℤ) : ZMod q) * ξ)) := by
      simpa using (integerIntervalResidueWeight_spec q A L (fun _ => 1)).2.1 ξ
    rw [(integerIntervalResidueWeight_spec q A N w).2.1 ξ]
    simpa only [smul_eq_mul, ← uch] using Finset.sum_range_by_parts w
      (fun i => ZMod.stdAddChar (-(((A + i : ℤ) : ZMod q) * ξ))) N
  have var (w : ℕ → ℂ) (g : ℕ) (hg : g ∣ q) :
      let V : ℝ := if N = 0 then 0 else
        ‖w (N - 1)‖ + ∑ n ∈ Finset.range (N - 1), ‖w (n + 1) - w n‖
      (1 / (q : ℝ)) *
          ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0,
            ‖ZMod.dft (integerIntervalResidueWeight q A N w) ξ‖ *
              (Nat.gcd g ξ.val : ℝ) ≤
        2 * V * (g.divisors.card : ℝ) * (1 + Real.log (q : ℝ)) := by
    dsimp only
    by_cases hN : N = 0
    · subst N
      simp [integerIntervalResidueWeight, ZMod.dft_apply]
    simp only [hN, ↓reduceIte]
    have hq : 0 < (q : ℝ) := by exact_mod_cast NeZero.pos q
    let U : ℕ → ZMod q → ℂ := fun L => integerIntervalResidueWeight q A L (fun _ => 1)
    let Δ : ℕ → ℝ := fun i => ‖w (i + 1) - w i‖
    have pt (ξ : ZMod q) :
        ‖ZMod.dft (integerIntervalResidueWeight q A N w) ξ‖ ≤
          ‖w (N - 1)‖ * ‖ZMod.dft (U N) ξ‖ +
            ∑ i ∈ Finset.range (N - 1), Δ i * ‖ZMod.dft (U (i + 1)) ξ‖ := by
      rw [abel]
      exact norm_sub_le_of_le (norm_mul_le _ _)
        (norm_sum_le_of_le _ fun _ _ => norm_mul_le _ _)
    have H : (1 / (q : ℝ)) *
        (∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0,
          ‖ZMod.dft (integerIntervalResidueWeight q A N w) ξ‖ * (Nat.gcd g ξ.val : ℝ)) ≤
          ‖w (N - 1)‖ * ((1 / (q : ℝ)) *
            ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0,
              ‖ZMod.dft (U N) ξ‖ * (Nat.gcd g ξ.val : ℝ)) +
            ∑ i ∈ Finset.range (N - 1), Δ i * ((1 / (q : ℝ)) *
              ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0,
                ‖ZMod.dft (U (i + 1)) ξ‖ * (Nat.gcd g ξ.val : ℝ)) := by
      calc
        _ ≤ (1 / (q : ℝ)) * (∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0,
            (‖w (N - 1)‖ * ‖ZMod.dft (U N) ξ‖ +
              ∑ i ∈ Finset.range (N - 1), Δ i * ‖ZMod.dft (U (i + 1)) ξ‖) *
              (Nat.gcd g ξ.val : ℝ)) := by
          gcongr with ξ hξ
          exact pt ξ
        _ = _ := by
          simp_rw [add_mul, Finset.sum_add_distrib]
          simp_rw [Finset.mul_sum, Finset.sum_mul]
          rw [Finset.sum_comm]
          rw [mul_add]
          simp_rw [Finset.mul_sum, mul_assoc]
          simp only [mul_left_comm]
    calc
      _ ≤ _ := H
      _ ≤ (‖w (N - 1)‖ + ∑ i ∈ Finset.range (N - 1), Δ i) *
            (2 * (g.divisors.card : ℝ) * (1 + Real.log (q : ℝ))) := by
          rw [add_mul, Finset.sum_mul]
          apply add_le_add
          · exact mul_le_mul_of_nonneg_left (hB N g hg) (norm_nonneg _)
          · apply Finset.sum_le_sum
            intro i hi
            exact mul_le_mul_of_nonneg_left (hB (i + 1) g hg) (norm_nonneg _)
      _ = _ := by ring
  refine ⟨var, ?_⟩
  intro f X B D hX hB0 hD hdiff hbnd g hg
  have hDX : 0 ≤ D / X := div_nonneg hD hX.le
  have bounds {n : ℕ} (hn : n ≤ N) :
      ((A : ℝ) + (n : ℝ)) ∈ Set.Icc (A : ℝ) ((A : ℝ) + (N : ℝ)) := by
    constructor
    · exact le_add_of_nonneg_right (Nat.cast_nonneg _)
    · have hh : (n : ℝ) ≤ N := by exact_mod_cast hn
      linarith
  have hadj (i : ℕ) (hi : i ∈ Finset.range (N - 1)) :
      ‖f ((A : ℝ) + (↑(i + 1) : ℝ)) - f ((A : ℝ) + (i : ℝ))‖ ≤ D / X := by
    have hi' : i + 1 ≤ N := by have := Finset.mem_range.mp hi; omega
    calc
      _ ≤ (D / X) * ‖((A : ℝ) + (↑(i + 1) : ℝ)) - ((A : ℝ) + (i : ℝ))‖ :=
        Convex.norm_image_sub_le_of_norm_deriv_le hdiff (fun t ht => (hbnd t ht).2)
          (convex_Icc _ _) (bounds (by omega)) (bounds hi')
      _ = D / X := by simp
  have hlog : 0 ≤ 1 + Real.log (q : ℝ) := by
    have hq : (1 : ℝ) ≤ q := by exact_mod_cast NeZero.pos q
    linarith [Real.log_nonneg hq]
  calc
    _ ≤ 2 * (if N = 0 then 0 else
          ‖f ((A : ℝ) + (N - 1 : ℕ))‖ +
            ∑ n ∈ Finset.range (N - 1), ‖f ((A : ℝ) + (↑(n + 1) : ℝ)) - f ((A : ℝ) + n)‖) *
          (g.divisors.card : ℝ) * (1 + Real.log (q : ℝ)) :=
      var (fun n => f ((A : ℝ) + (n : ℝ))) g hg
    _ ≤ _ := by
      apply mul_le_mul_of_nonneg_right _ hlog
      apply mul_le_mul_of_nonneg_right _ (Nat.cast_nonneg _)
      apply mul_le_mul_of_nonneg_left _ (by norm_num)
      split_ifs with hN
      · subst N; simpa using hB0
      · calc
          _ ≤ B + ∑ _ ∈ Finset.range (N - 1), D / X := by
            gcongr
            · exact (hbnd _ (bounds (by omega))).1
            · exact hadj _ ‹_›
          _ ≤ B + (N : ℝ) * D / X := by
            rw [Finset.sum_const, Finset.card_range, nsmul_eq_mul]
            have hc : ((N - 1 : ℕ) : ℝ) ≤ (N : ℝ) := by exact_mod_cast Nat.sub_le N 1
            simpa [mul_div_assoc] using mul_le_mul_of_nonneg_right hc hDX

theorem nat_Ico_one_eq_Icc_sub_one (K : ℕ) : Finset.Ico 1 K = Finset.Icc 1 (K - 1) := by
  ext x
  simp only [Finset.mem_Ico, Finset.mem_Icc]
  omega

theorem sum_range_erase_eq_sum_displacements {M : Type*} [AddCommMonoid M] (K : ℕ) (c : ℕ → ℕ → M) :
    (∑ k ∈ Finset.range K, ∑ l ∈ (Finset.range K).erase k, c k l) =
      ∑ h ∈ Finset.Ico 1 K, ∑ l ∈ Finset.range (K - h), (c (l + h) l + c l (l + h)) := by
  classical
  have split (k : ℕ) (hk : k ∈ Finset.range K) :
      (Finset.range K).erase k = Finset.Ico 0 k ∪ Finset.Ico (k + 1) K := by
    ext l
    simp only [Finset.mem_erase, Finset.mem_range, Finset.mem_union, Finset.mem_Ico]
    have := Finset.mem_range.mp hk
    omega
  have dj (k : ℕ) : Disjoint (Finset.Ico 0 k) (Finset.Ico (k + 1) K) := by
    apply Finset.disjoint_left.mpr
    simp only [Finset.mem_Ico]
    omega
  calc
    _ = (∑ k ∈ Finset.Ico 0 K, ∑ l ∈ Finset.Ico 0 k, (c k l + c l k)) := by
      simp_rw [Finset.sum_add_distrib]
      rw [← Finset.sum_Ico_Ico_comm' 0 K c]
      rw [← Finset.sum_add_distrib]
      rw [Nat.Ico_zero_eq_range K]
      apply Finset.sum_congr rfl
      intro k hk
      rw [split k hk, Finset.sum_union (dj k)]
    _ = _ := by
      rw [Finset.sum_sigma', Finset.sum_sigma']
      refine Finset.sum_bij (fun x _ => ⟨x.1 - x.2, x.2⟩) ?_ ?_ ?_ ?_
      · rintro ⟨k, l⟩ hx
        rcases Finset.mem_sigma.mp hx with ⟨hk, hl⟩
        simp only [Finset.mem_Ico] at hk hl
        simp only [Finset.mem_sigma, Finset.mem_Ico, Finset.mem_range]
        omega
      · rintro ⟨k, l⟩ hk ⟨k', l'⟩ hk' he
        have h1 := Finset.mem_Ico.mp (Finset.mem_sigma.mp hk).2
        have h2 := Finset.mem_Ico.mp (Finset.mem_sigma.mp hk').2
        injection he with he1 he2
        dsimp at *
        congr 1; omega
      · rintro ⟨h, l⟩ hh
        rcases Finset.mem_sigma.mp hh with ⟨hh, hl⟩
        simp only [Finset.mem_Ico, Finset.mem_range] at hh hl
        refine ⟨⟨l + h, l⟩, ?_, ?_⟩
        · simp only [Finset.mem_sigma, Finset.mem_Ico]
          omega
        · simp
      · rintro ⟨k, l⟩ hx
        rcases Finset.mem_sigma.mp hx with ⟨hk, hl⟩
        simp only [Finset.mem_Ico] at hk hl
        dsimp at *
        congr 2 <;> omega

open Classical in
theorem finite_periodic_factor_van_der_corput
    (A : ℤ) (N r K : ℕ) (hr : 0 < r) (hK : 0 < K)
    (R S : ℤ → ℂ) (hR : Function.Periodic R (r : ℤ))
    (hRnorm : ∀ n : ℤ, ‖R n‖ ≤ 1)
    (hSnorm : ∀ n : ℤ, ‖S n‖ ≤ 1) :
    ‖∑ n ∈ Finset.range N, R (A + n) * S (A + n)‖ ^ 2 ≤
      (((N + (K - 1) * r : ℕ) : ℝ) / (K : ℝ) ^ 2) *
        ((K : ℝ) * (N : ℝ) +
          2 * ∑ h ∈ Finset.Icc 1 (K - 1), (K - h : ℝ) *
            ‖∑ n ∈ Finset.range (N - h * r),
              S (A + (n : ℤ) + ((h * r : ℕ) : ℤ)) * star (S (A + n))‖) := by
  let T : ℤ → ℂ := fun t => if t ∈ Finset.Ico (0 : ℤ) (N : ℤ) then S (A + t) else 0
  let I : Finset ℤ := Finset.Ico (-(((K - 1) * r : ℕ) : ℤ)) (N : ℤ)
  have shiftsize (k : ℕ) (hk : k < K) :
      ((k * r : ℕ) : ℤ) ≤ (((K - 1) * r : ℕ) : ℤ) := by
    exact_mod_cast (Nat.mul_le_mul_right r (show k ≤ K - 1 by omega))
  have single (k : ℕ) (hk : k < K) :
      (∑ t ∈ I, R (A + t) * T (t + ((k * r : ℕ) : ℤ))) =
        ∑ n ∈ Finset.range N, R (A + n) * S (A + n) := by
    have hh (t : ℤ) : R (A + t) * T (t + ((k * r : ℕ) : ℤ)) =
        if t + ((k * r : ℕ) : ℤ) ∈ Finset.Ico (0 : ℤ) (N : ℤ) then
          R (A + t) * S (A + (t + ((k * r : ℕ) : ℤ))) else 0 := by
      simp only [T, mul_ite, mul_zero]
    simp_rw [hh]
    rw [← Finset.sum_filter]
    refine Finset.sum_bij (fun t _ => (t + ((k * r : ℕ) : ℤ)).toNat) ?_ ?_ ?_ ?_
    · intro t ht
      have hx := Finset.mem_Ico.mp (Finset.mem_filter.mp ht).2
      rw [Finset.mem_range]
      exact (Int.toNat_lt hx.1).2 hx.2
    · intro t ht u hu he
      have ht0 := (Finset.mem_Ico.mp (Finset.mem_filter.mp ht).2).1
      have hu0 := (Finset.mem_Ico.mp (Finset.mem_filter.mp hu).2).1
      have := congrArg (fun n : ℕ => (n : ℤ)) he
      rw [Int.toNat_of_nonneg ht0, Int.toNat_of_nonneg hu0] at this
      omega
    · intro n hn
      have hn' := Finset.mem_range.mp hn
      refine ⟨(n : ℤ) - ((k * r : ℕ) : ℤ), ?_, ?_⟩
      · apply Finset.mem_filter.mpr
        have hs := shiftsize k hk
        constructor
        · exact Finset.mem_Ico.mpr (by
            constructor
            · have : (0 : ℤ) ≤ n := Int.natCast_nonneg n
              omega
            · have : (0 : ℤ) ≤ ((k * r : ℕ) : ℤ) := Int.natCast_nonneg _
              have hn'' : (n : ℤ) < (N : ℤ) := by exact_mod_cast hn'
              omega)
        · apply Finset.mem_Ico.mpr
          simp only [sub_add_cancel]
          constructor
          · exact Int.natCast_nonneg _
          · exact_mod_cast hn'
      · simp
    · intro t ht
      have hp := (Finset.mem_filter.mp ht).2
      have hx0 : 0 ≤ t + (k : ℤ) * (r : ℤ) := by
        simpa only [Nat.cast_mul] using (Finset.mem_Ico.mp hp).1
      dsimp
      rw [Int.toNat_of_nonneg hx0]
      congr 1
      rw [← hR.nat_mul k (A + t)]
      ring_nf
  let C : ℕ → ℂ := fun h => ∑ n ∈ Finset.range (N - h * r),
      S (A + (n : ℤ) + ((h * r : ℕ) : ℤ)) * star (S (A + (n : ℤ)))
  let Z : ℕ → ℕ → ℂ := fun k l =>
      ∑ t ∈ I, T (t + ((k * r : ℕ) : ℤ)) * star (T (t + ((l * r : ℕ) : ℤ)))
  have overlap (l h : ℕ) (hlh : l + h < K) : Z (l + h) l = C h := by
    have hplus : (((l + h) * r : ℕ) : ℤ) = ((l * r : ℕ) : ℤ) + ((h * r : ℕ) : ℤ) := by
      push_cast
      ring
    have hr0 : (0 : ℤ) ≤ ((h * r : ℕ) : ℤ) := by
      rw [Nat.cast_mul]
      exact mul_nonneg (Int.natCast_nonneg _) (by exact_mod_cast hr.le)
    have hh (t : ℤ) : T (t + (((l + h) * r : ℕ) : ℤ)) *
        star (T (t + ((l * r : ℕ) : ℤ))) =
          if 0 ≤ t + ((l * r : ℕ) : ℤ) ∧ t + ((l * r : ℕ) : ℤ) + ((h * r : ℕ) : ℤ) < (N : ℤ) then
            S (A + (t + ((l * r : ℕ) : ℤ)) + ((h * r : ℕ) : ℤ)) *
              star (S (A + (t + ((l * r : ℕ) : ℤ)))) else 0 := by
      rw [hplus]
      by_cases ht : 0 ≤ t + ((l * r : ℕ) : ℤ) ∧
          t + ((l * r : ℕ) : ℤ) + ((h * r : ℕ) : ℤ) < (N : ℤ)
      · have hleft : t + (((l * r : ℕ) : ℤ) + ((h * r : ℕ) : ℤ)) ∈
            Finset.Ico (0 : ℤ) (N : ℤ) := Finset.mem_Ico.mpr (by omega)
        have hright : t + (((l * r : ℕ) : ℤ)) ∈ Finset.Ico (0 : ℤ) (N : ℤ) :=
          Finset.mem_Ico.mpr (by omega)
        simp only [T, ite_eq_left hleft, ite_eq_left hright, ite_eq_left ht]
        congr 1; ring_nf
      · simp only [T]
        by_cases ht0 : t + ((l * r : ℕ) : ℤ) ∈ Finset.Ico (0 : ℤ) (N : ℤ)
        · simp only [ite_eq_left ht0]
          have ht1 : t + (((l * r : ℕ) : ℤ) + ((h * r : ℕ) : ℤ)) ∉
              Finset.Ico (0 : ℤ) (N : ℤ) := by
            have ha := Finset.mem_Ico.mp ht0
            simp only [Finset.mem_Ico, not_and] at ht ⊢
            omega
          simp only [ite_eq_right ht, ite_eq_right ht1, zero_mul]
        · simp only [ite_eq_right ht, ite_eq_right ht0, star_zero, mul_zero]
    dsimp only [Z, C]
    simp_rw [hh]
    rw [← Finset.sum_filter]
    refine Finset.sum_bij (fun t _ => (t + ((l * r : ℕ) : ℤ)).toNat) ?_ ?_ ?_ ?_
    · intro t ht
      have hx := (Finset.mem_filter.mp ht).2
      rw [Finset.mem_range]
      apply (Int.toNat_lt hx.1).2
      have hh' : h * r ≤ N := by exact_mod_cast (le_of_lt (by omega : (((h * r : ℕ) : ℤ)) < N))
      rw [Int.ofNat_sub hh']
      omega
    · intro t ht u hu he
      have ht0 := (Finset.mem_filter.mp ht).2.1
      have hu0 := (Finset.mem_filter.mp hu).2.1
      have := congrArg (fun n : ℕ => (n : ℤ)) he
      rw [Int.toNat_of_nonneg ht0, Int.toNat_of_nonneg hu0] at this
      omega
    · intro n hn
      have hn' := Finset.mem_range.mp hn
      have hn'' : ((n : ℤ) + ((h * r : ℕ) : ℤ)) < (N : ℤ) := by
        exact_mod_cast (Nat.lt_sub_iff_add_lt.mp hn')
      refine ⟨(n : ℤ) - ((l * r : ℕ) : ℤ), ?_, ?_⟩
      · apply Finset.mem_filter.mpr
        have hs := shiftsize l (by omega)
        constructor
        · apply Finset.mem_Ico.mpr
          have hn0 : (0 : ℤ) ≤ n := Int.natCast_nonneg _
          have hl0 : (0 : ℤ) ≤ ((l * r : ℕ) : ℤ) := Int.natCast_nonneg _
          exact ⟨by omega, by omega⟩
        · simp only [sub_add_cancel]
          exact ⟨Int.natCast_nonneg _, hn''⟩
      · simp
    · intro t ht
      have hx0 := (Finset.mem_filter.mp ht).2.1
      have hx' : (0 : ℤ) ≤ t + (l : ℤ) * (r : ℤ) := by
        simpa only [Nat.cast_mul] using hx0
      dsimp
      rw [Int.toNat_of_nonneg hx']
  have swap (k l : ℕ) : Z l k = star (Z k l) := by
    simp only [Z, star_sum, star_mul, star_star, mul_comm]
  have cardI : I.card = N + (K - 1) * r := by
    rw [show I.card = (Finset.Ico (-(((K - 1) * r : ℕ) : ℤ)) (N : ℤ)).card from rfl,
      Int.card_Ico]
    have heq : ((N : ℤ) - (-(((K - 1) * r : ℕ) : ℤ))) = (N + (K - 1) * r : ℕ) := by
      simp
    rw [heq, Int.toNat_natCast]
  have avg : (K : ℂ) * (∑ n ∈ Finset.range N, R (A + n) * S (A + n)) =
      ∑ t ∈ I, R (A + t) * (∑ k ∈ Finset.range K, T (t + ((k * r : ℕ) : ℤ))) := by
    have ex : (∑ t ∈ I, R (A + t) *
            (∑ k ∈ Finset.range K, T (t + ((k * r : ℕ) : ℤ)))) =
          ∑ k ∈ Finset.range K, ∑ t ∈ I, R (A + t) * T (t + ((k * r : ℕ) : ℤ)) := by
      simp_rw [Finset.mul_sum]
      rw [Finset.sum_comm]
    rw [ex]
    have hc : (∑ k ∈ Finset.range K, ∑ t ∈ I, R (A + t) * T (t + ((k * r : ℕ) : ℤ))) =
        ∑ _ ∈ Finset.range K, (∑ n ∈ Finset.range N, R (A + n) * S (A + n)) := by
      apply Finset.sum_congr rfl
      intro k hk
      exact single k (Finset.mem_range.mp hk)
    rw [hc]
    simp [Finset.sum_const, nsmul_eq_mul]
  have lhs_le : (K : ℝ) ^ 2 * ‖∑ n ∈ Finset.range N, R (A + n) * S (A + n)‖ ^ 2 ≤
      (I.card : ℝ) * ∑ t ∈ I, ‖∑ k ∈ Finset.range K, T (t + ((k * r : ℕ) : ℤ))‖ ^ 2 := by
    calc
      _ = ‖(K : ℂ) * (∑ n ∈ Finset.range N, R (A + n) * S (A + n))‖ ^ 2 := by
        simp only [norm_mul, Complex.norm_natCast, mul_pow]
      _ ≤ (∑ t ∈ I, ‖∑ k ∈ Finset.range K, T (t + ((k * r : ℕ) : ℤ))‖) ^ 2 := by
        rw [avg]
        apply (sq_le_sq₀ (norm_nonneg _) (Finset.sum_nonneg (by intros; positivity))).2
        refine norm_sum_le_of_le _ fun t _ => ?_
        rw [norm_mul]
        nlinarith [hRnorm (A + t), norm_nonneg
          (∑ k ∈ Finset.range K, T (t + ((k * r : ℕ) : ℤ)))]
      _ ≤ _ := sq_sum_le_card_mul_sum_sq
  have sq_expand : (∑ t ∈ I, ‖∑ k ∈ Finset.range K, T (t + ((k * r : ℕ) : ℤ))‖ ^ 2) =
      (∑ k ∈ Finset.range K, ∑ l ∈ Finset.range K, Z k l).re := by
    have ht (t : ℤ) : ‖∑ k ∈ Finset.range K, T (t + ((k * r : ℕ) : ℤ))‖ ^ 2 =
        (∑ k ∈ Finset.range K, ∑ l ∈ Finset.range K,
          T (t + ((k * r : ℕ) : ℤ)) * star (T (t + ((l * r : ℕ) : ℤ)))).re := by
      rw [← Finset.sum_mul_sum, ← star_sum, ← starRingEnd_apply, Complex.mul_conj']
      rw [← Complex.ofReal_pow, Complex.ofReal_re]
    calc
      _ = (∑ t ∈ I, ∑ k ∈ Finset.range K, ∑ l ∈ Finset.range K,
          T (t + ((k * r : ℕ) : ℤ)) * star (T (t + ((l * r : ℕ) : ℤ)))).re := by
        rw [Complex.re_sum]
        apply Finset.sum_congr rfl
        intro t ht'
        exact ht t
      _ = _ := by
        dsimp only [Z]
        congr 1
        rw [Finset.sum_comm]
        apply Finset.sum_congr rfl
        intro k hk
        rw [Finset.sum_comm]
  have cr0 : (C 0).re ≤ N := by
    apply le_trans (Complex.re_le_norm (C 0))
    simp only [C, zero_mul, Nat.sub_zero, Nat.cast_zero, add_zero]
    calc
      _ ≤ ∑ _ ∈ Finset.range N, (1 : ℝ) := by
        refine norm_sum_le_of_le _ fun n _ => ?_
        rw [norm_mul, norm_star]
        nlinarith [hSnorm (A + n), norm_nonneg (S (A + (n : ℤ)))]
      _ = _ := by simp
  have sq_le : (∑ t ∈ I, ‖∑ k ∈ Finset.range K, T (t + ((k * r : ℕ) : ℤ))‖ ^ 2) ≤
      (K : ℝ) * (N : ℝ) + 2 * ∑ h ∈ Finset.Icc 1 (K - 1), (K - h : ℝ) * ‖C h‖ := by
    rw [sq_expand]
    have decomp : (∑ k ∈ Finset.range K, ∑ l ∈ Finset.range K, Z k l) =
        (∑ k ∈ Finset.range K, Z k k) +
        (∑ h ∈ Finset.Icc 1 (K - 1), ∑ l ∈ Finset.range (K - h),
            (C h + star (C h))) := by
      calc
        _ = (∑ k ∈ Finset.range K, Z k k) + (∑ k ∈ Finset.range K,
            ∑ l ∈ (Finset.range K).erase k, Z k l) := by
          rw [← Finset.sum_add_distrib]
          apply Finset.sum_congr rfl
          intro k hk
          simpa [add_comm] using (Finset.sum_erase_add (Finset.range K) (Z k) hk).symm
        _ = _ := by
          rw [sum_range_erase_eq_sum_displacements, nat_Ico_one_eq_Icc_sub_one K]
          congr 1
          apply Finset.sum_congr rfl
          intro h hh
          apply Finset.sum_congr rfl
          intro l hl
          have hlh : l + h < K := by
            have := Finset.mem_range.mp hl
            omega
          rw [show Z l (l + h) = star (Z (l + h) l) from swap (l + h) l,
            overlap l h hlh]
    rw [decomp, Complex.add_re]
    rw [Complex.re_sum, Complex.re_sum]
    calc
      _ = (K : ℝ) * (C 0).re +
          ∑ h ∈ Finset.Icc 1 (K - 1), ((K - h : ℕ) : ℝ) * (2 * (C h).re) := by
        congr 1
        · calc
            _ = ∑ _ ∈ Finset.range K, (C 0).re := by
              apply Finset.sum_congr rfl
              intro k hk
              rw [show Z k k = C 0 by simpa using overlap k 0 (by
                  simpa using Finset.mem_range.mp hk)]
            _ = _ := by simp
        · simp_rw [Complex.re_sum, Complex.add_re,
            show ∀ c : ℂ, (star c).re = c.re from (by simp [← starRingEnd_apply])]
          simp only [Finset.sum_const, Finset.card_range, nsmul_eq_mul]
          apply Finset.sum_congr rfl
          intro h hh
          ring
      _ ≤ _ := by
        apply add_le_add
        · exact mul_le_mul_of_nonneg_left cr0 (Nat.cast_nonneg _)
        · rw [Finset.mul_sum]
          apply Finset.sum_le_sum
          intro h hh
          rw [← Nat.cast_sub ((Finset.mem_Icc.mp hh).2.trans (Nat.sub_le K 1))]
          have := Complex.re_le_norm (C h)
          nlinarith [show (0 : ℝ) ≤ (K - h : ℕ) by exact_mod_cast Nat.zero_le (K - h)]
  have hK0 : 0 < (K : ℝ) ^ 2 := pow_pos (by exact_mod_cast hK) _
  have hlen := mul_le_mul_of_nonneg_left sq_le
    (show (0 : ℝ) ≤ I.card from Nat.cast_nonneg _)
  rw [cardI] at lhs_le hlen
  have htotal := lhs_le.trans hlen
  change ‖∑ n ∈ Finset.range N, R (A + n) * S (A + n)‖ ^ 2 ≤
    (((N + (K - 1) * r : ℕ) : ℝ) / (K : ℝ) ^ 2) *
      ((K : ℝ) * (N : ℝ) + 2 * ∑ h ∈ Finset.Icc 1 (K - 1), (K - h : ℝ) * ‖C h‖)
  rw [div_mul_eq_mul_div]
  apply (le_div_iff₀ hK0).2
  rw [mul_comm]
  exact htotal

open Classical in
theorem reciprocal_differencing_gcd_sums
    (s K : ℕ) (hs : 0 < s) :
    (∑ h ∈ Finset.Icc 1 K, (Nat.gcd s h : ℝ)) ≤
      (K : ℝ) * (s.divisors.card : ℝ) ∧
    (∑ k ∈ Finset.range K, ∑ l ∈ (Finset.range K).erase k,
        Real.sqrt (Nat.gcd s (Nat.dist k l) : ℝ)) =
      (2 * ∑ h ∈ Finset.Icc 1 (K - 1),
        (K - h : ℝ) * Real.sqrt (Nat.gcd s h : ℝ)) ∧
    (∑ k ∈ Finset.range K, ∑ l ∈ (Finset.range K).erase k,
        Real.sqrt (Nat.gcd s (Nat.dist k l) : ℝ)) ≤
      2 * (K : ℝ) ^ 2 * (s.divisors.card : ℝ) ∧
    (∀ r : ℕ, Nat.Coprime s r → ∀ h : ℕ,
      Nat.gcd s (r * h) = Nat.gcd s h) := by
  have first : (∑ h ∈ Finset.Icc 1 K, (Nat.gcd s h : ℝ)) ≤
      (K : ℝ) * (s.divisors.card : ℝ) := by
    have := sum_gcd_mul_eq_sum_totient_mul s K hs (fun _ => 1)
    simp only [mul_one] at this
    rw [this]
    calc
      _ ≤ ∑ _d ∈ s.divisors, (K : ℝ) := by
        apply Finset.sum_le_sum
        intro d hd
        have hd0 := Nat.pos_of_dvd_of_pos (Nat.mem_divisors.mp hd).1 hs
        rw [sum_pos_multiples K d hd0, Finset.sum_const, Nat.card_Icc]
        have hle : (Nat.totient d) * (K / d) ≤ K := by
          calc
            _ ≤ d * (K / d) := Nat.mul_le_mul_right _ (Nat.totient_le d)
            _ ≤ K := Nat.mul_div_le _ _
        norm_num
        exact_mod_cast (show K / d * (Nat.totient d) ≤ K by simpa [mul_comm] using hle)
      _ = _ := by simp [mul_comm]
  have pairs : (∑ k ∈ Finset.range K, ∑ l ∈ (Finset.range K).erase k,
        Real.sqrt (Nat.gcd s (Nat.dist k l) : ℝ)) =
      (2 * ∑ h ∈ Finset.Icc 1 (K - 1), (K - h : ℝ) * Real.sqrt (Nat.gcd s h : ℝ)) := by
    rw [sum_range_erase_eq_sum_displacements, nat_Ico_one_eq_Icc_sub_one K]
    simp_rw [Nat.dist_eq_sub_of_le_right (Nat.le_add_right _ _),
      Nat.dist_eq_sub_of_le (Nat.le_add_right _ _)]
    simp only [Nat.add_sub_cancel_left, Finset.sum_const,
      Finset.card_range, nsmul_eq_mul]
    rw [Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro h hh
    rw [← Nat.cast_sub ((Finset.mem_Icc.mp hh).2.trans (Nat.sub_le K 1))]
    ring
  refine ⟨first, pairs, ?_, ?_⟩
  · rw [pairs]
    calc
      _ ≤ 2 * ((K : ℝ) * ∑ h ∈ Finset.Icc 1 (K - 1), (Nat.gcd s h : ℝ)) := by
        gcongr
        rw [Finset.mul_sum]
        apply Finset.sum_le_sum
        intro h hh
        have hs1 : (1 : ℝ) ≤ (Nat.gcd s h : ℝ) := by
          exact_mod_cast (Nat.gcd_pos_of_pos_left _ hs)
        have hrt : Real.sqrt (Nat.gcd s h : ℝ) ≤ (Nat.gcd s h : ℝ) :=
          Real.sqrt_le_self_iff.mpr (Or.inr hs1)
        exact mul_le_mul (sub_le_self _ (Nat.cast_nonneg _)) hrt
          (Real.sqrt_nonneg _) (Nat.cast_nonneg _)
      _ ≤ 2 * ((K : ℝ) * ∑ h ∈ Finset.Icc 1 K, (Nat.gcd s h : ℝ)) := by
        gcongr
        exact Nat.sub_le K 1
      _ ≤ _ := by
        calc
          _ ≤ 2 * ((K : ℝ) * ((K : ℝ) * (s.divisors.card : ℝ))) := by gcongr
          _ = _ := by ring
  · intro r hc h
    exact hc.symm.gcd_mul_left_cancel_right h

theorem trial_sieve_density_pos : 0 < (2624989 : ℝ) / 10 ^ 7 := by
  norm_num

theorem presievingModulus_admissibleTuple_eq (x : ℝ) :
    presievingModulus PrimeGap186.admissibleTuple x =
      ∏ p ∈ Nat.primesLE ⌊Real.log (Real.log (Real.log x))⌋₊ ∪
        PrimeGap186.admissibleTuple.biUnion (fun h =>
          PrimeGap186.admissibleTuple.biUnion (fun k => (Nat.dist h k).primeFactors)), p := rfl

theorem tendsto_fragment_normalizer_admissibleTuple (ζ : ℝ) (hζ : 0 < ζ) :
    Tendsto
      (fun x : ℝ =>
        harmonicFragmentMass (presievingModulus PrimeGap186.admissibleTuple x)
            (x ^ ((2624989 : ℝ) / 10 ^ 7)) ζ /
          fragmentNormalization (presievingModulus PrimeGap186.admissibleTuple x)
            (x ^ ((2624989 : ℝ) / 10 ^ 7)))
      atTop (nhds (Real.exp Real.eulerMascheroniConstant * ζ)) :=
  harmonic_fragment_normalizer_tendsto PrimeGap186.admissibleTuple _ ζ trial_sieve_density_pos hζ

theorem tendsto_prime_band_admissibleTuple (α β : ℝ) (hα : 0 < α) (hαβ : α ≤ β) :
    Tendsto
      (fun x : ℝ =>
        ∑ p ∈ (fragmentPrimes (presievingModulus PrimeGap186.admissibleTuple x)
            (x ^ ((2624989 : ℝ) / 10 ^ 7)) β).filter
          (fun p : ℕ => (x ^ ((2624989 : ℝ) / 10 ^ 7)) ^ α < (p : ℝ)),
            (p : ℝ)⁻¹)
      atTop (nhds (Real.log (β / α))) :=
  presieved_prime_band_tendsto PrimeGap186.admissibleTuple _ α β trial_sieve_density_pos hα hαβ

theorem one_mem_fragment_divisors (W : ℕ) (R ζ : ℝ) :
    1 ∈ (∏ p ∈ fragmentPrimes W R ζ, p).divisors := by
  rw [Nat.one_mem_divisors]
  apply Finset.prod_ne_zero_iff.mpr
  intro p hp
  exact (Nat.prime_of_mem_primesLE (Finset.mem_filter.mp hp).1).ne_zero

theorem source_fragment_support (W : ℕ) (R ζ : ℝ) (hcap : 1 ≤ R ^ ζ) (r : ℕ) :
    r ∈ (∏ p ∈ fragmentPrimes W R ζ, p).divisors ↔
      Squarefree r ∧ Nat.Coprime r W ∧
        (((max 1 (r.primeFactors.sup id) : ℕ) : ℝ) ≤ R ^ ζ) :=
  mem_fragment_divisors_iff W R ζ hcap r

theorem harmonicFragmentMass_zero_modulus (R ζ : ℝ) : harmonicFragmentMass 0 R ζ = 1 := by
  simp [harmonicFragmentMass, fragmentPrimes]

theorem harmonicFragmentMass_zero_cap (W : ℕ) (R : ℝ) : harmonicFragmentMass W R 0 = 1 := by
  have hprime : Nat.primesLE 1 = ∅ := by decide
  simp [harmonicFragmentMass, fragmentPrimes, hprime]

theorem harmonic_seed_expectation_zero_cutoff (W : ℕ) (R ζ : ℝ) :
    (∑ r ∈ (∏ p ∈ fragmentPrimes W R ζ, p).divisors, (Nat.totient r : ℝ)⁻¹ *
      ∑ p ∈ r.primeFactors.filter (fun p : ℕ => (p : ℝ) ≤ R ^ (0 : ℝ)),
        Real.log p / Real.log R) / harmonicFragmentMass W R ζ = 0 := by
  have he (r : ℕ) : r.primeFactors.filter (fun p : ℕ => (p : ℝ) ≤ 1) = ∅ := by
    apply Finset.filter_eq_empty_iff.mpr
    intro p hp
    exact not_le.mpr (by exact_mod_cast (Nat.prime_of_mem_primeFactors hp).one_lt)
  simp only [Real.rpow_zero, he, Finset.sum_empty, mul_zero, Finset.sum_const_zero, zero_div]

theorem uniform_seed_source_normalization (H : Finset ℕ) (ρ ζ : ℝ)
    (hρ : 0 < ρ) (hζ : 0 < ζ) :
    ∃ C : ℝ, 0 < C ∧ ∀ᶠ x : ℝ in atTop, ∀ ε : ℝ, 0 ≤ ε →
      let W := presievingModulus H x
      let R := x ^ ρ
      let Q : ℕ := ∏ p ∈ fragmentPrimes W R ζ, p
      (∑ r ∈ Q.divisors, (Nat.totient r : ℝ)⁻¹ *
        ∑ p ∈ r.primeFactors.filter (fun p : ℕ => (p : ℝ) ≤ R ^ ε),
          Real.log p / Real.log R) / fragmentNormalization W R ≤
        (Real.exp Real.eulerMascheroniConstant * ζ + 1) * ε +
          ((Real.exp Real.eulerMascheroniConstant * ζ + 1) * C) / Real.log R := by
  obtain ⟨C, hC, hbound⟩ := harmonic_small_seed_first_moment_bound
  refine ⟨C, hC, ?_⟩
  have hlim := harmonic_fragment_normalizer_tendsto H ρ ζ hρ hζ
  have hL : 0 < Real.exp Real.eulerMascheroniConstant * ζ :=
    mul_pos (Real.exp_pos _) hζ
  have hu := hlim.eventually_lt_const (by linarith :
    Real.exp Real.eulerMascheroniConstant * ζ <
      Real.exp Real.eulerMascheroniConstant * ζ + 1)
  have hl := hlim.eventually_const_lt hL
  filter_upwards [(tendsto_rpow_atTop hρ).eventually_gt_atTop 1, hu, hl]
    with x hR hu hl
  intro ε hε
  let W := presievingModulus H x
  let R := x ^ ρ
  let M := harmonicFragmentMass W R ζ
  let B := fragmentNormalization W R
  let V := ∑ r ∈ (∏ p ∈ fragmentPrimes W R ζ, p).divisors, (Nat.totient r : ℝ)⁻¹ *
    ∑ p ∈ r.primeFactors.filter (fun p : ℕ => (p : ℝ) ≤ R ^ ε),
      Real.log p / Real.log R
  change V / B ≤ (Real.exp Real.eulerMascheroniConstant * ζ + 1) * ε +
    ((Real.exp Real.eulerMascheroniConstant * ζ + 1) * C) / Real.log R
  have hM : 0 < M := by
    dsimp [M]
    rw [harmonic_fragment_mass_eq_product]
    apply Finset.prod_pos
    intro p hp
    have hp1 : (1 : ℝ) < p := by
      exact_mod_cast Nat.one_lt_of_mem_primesLE (Finset.mem_filter.mp hp).1
    positivity
  have hB : B ≠ 0 := by
    intro hzero
    change 0 < M / B at hl
    simp [hzero] at hl
  have hprob : 0 ≤ V / M ∧ V / M ≤ ε + C / Real.log R :=
    hbound W R ζ ε hR hε
  have hlog : 0 < Real.log R := Real.log_pos hR
  calc
    V / B = (V / M) * (M / B) := by field_simp
    _ ≤ (ε + C / Real.log R) * (M / B) :=
      mul_le_mul_of_nonneg_right hprob.2 hl.le
    _ ≤ (ε + C / Real.log R) * (Real.exp Real.eulerMascheroniConstant * ζ + 1) :=
      mul_le_mul_of_nonneg_left hu.le (by positivity)
    _ = _ := by ring

end PrimeGap186

namespace MeasureTheory

theorem ProbabilityMeasure.toFiniteMeasure_map
    {Ω Ω' : Type*} [MeasurableSpace Ω] [MeasurableSpace Ω']
    (μ : ProbabilityMeasure Ω) {f : Ω → Ω'}
    (hf : AEMeasurable f (μ : Measure Ω)) :
    (μ.map f).toFiniteMeasure = μ.toFiniteMeasure.map f := by
  apply FiniteMeasure.eq_of_forall_apply_eq
  intro s hs
  exact (μ.map_apply hf hs).trans (μ.toFiniteMeasure.map_apply_of_aemeasurable hf hs).symm

end MeasureTheory

namespace PrimeGap186

section

open Set

theorem dickmanRho_unique (f : ℝ → ℝ)
    (hcont : ContinuousOn f (Set.Ici 0))
    (hinit : ∀ x ∈ Set.Icc (0 : ℝ) 1, f x = 1)
    (hdelay : ∀ x : ℝ, 1 < x →
      HasDerivAt f (-(f (x - 1) / x)) x) :
    Set.EqOn f dickmanRho (Set.Ici 0) := by
  obtain ⟨_, hrinit, hrcont, _, hrdelay, _, _, _⟩ := dickmanRho_analytic
  have step (n : ℕ) : ∀ x ∈ Icc (0 : ℝ) ((n : ℝ) + 1), f x = dickmanRho x := by
    induction n with
    | zero =>
        intro x hx
        have hx' : x ∈ Icc (0 : ℝ) 1 := by simpa only [Nat.cast_zero, zero_add] using hx
        exact (hinit x hx').trans (hrinit x hx').symm
    | succ n ih =>
        intro x hx
        by_cases hx1 : x ≤ 1
        · exact (hinit x ⟨hx.1, hx1⟩).trans (hrinit x ⟨hx.1, hx1⟩).symm
        have h1x : 1 ≤ x := (lt_of_not_ge hx1).le
        have hc : ContinuousOn (fun t => f t - dickmanRho t) (Icc 1 x) :=
          (hcont.sub hrcont).mono (fun t ht => zero_le_one.trans ht.1)
        have hd : ∀ t ∈ Ioo 1 x, HasDerivAt (fun u => f u - dickmanRho u) 0 t := by
          intro t ht
          have htarg : t - 1 ∈ Icc (0 : ℝ) ((n : ℝ) + 1) := by
            constructor
            · linarith [ht.1]
            · push_cast at hx
              linarith [ht.2, hx.2]
          have h := (hdelay t ht.1).sub (hrdelay t ht.1)
          rw [ih (t - 1) htarg] at h
          simpa only [Pi.sub_apply, sub_self] using! h
        have hi := intervalIntegral.integral_eq_sub_of_hasDerivAt_of_le h1x hc hd
          (intervalIntegrable_const (c := (0 : ℝ)))
        have he : f 1 - dickmanRho 1 = 0 := by
          rw [hinit 1 ⟨zero_le_one, le_rfl⟩, hrinit 1 ⟨zero_le_one, le_rfl⟩, sub_self]
        simp only [intervalIntegral.integral_zero, he, sub_zero] at hi
        exact sub_eq_zero.mp hi.symm
  intro x hx
  exact step ⌈x⌉₊ x ⟨hx, by linarith [Nat.le_ceil x]⟩

theorem dickmanDirectedGrid_eq_replicate_of_initial (p : ℤ) (M J : ℕ) (h : M = 0 ∨ J ≤ M) :
    dickmanDirectedGrid p M J = Array.replicate (J + 1) (1, 1) := by
  induction J with
  | zero => rfl
  | succ J ih =>
      change (if M = 0 ∨ J < M then (dickmanDirectedGrid p M J).push (1, 1)
        else (dickmanDirectedGrid p M J).push _) = _
      rw [ite_eq_left (show M = 0 ∨ J < M by omega),
        ih (by omega), ← Array.replicate_succ]

theorem dickmanDirectedGrid_getD_initial (p : ℤ) (M J i : ℕ) (hi : i ≤ J) (hiM : i ≤ M) :
    (dickmanDirectedGrid p M J).getD i (1, 1) = (1, 1) := by
  rw [directedGrid_get_prefix p M i J hi,
    dickmanDirectedGrid_eq_replicate_of_initial p M i (Or.inr hiM),
    Array.getD_eq_getD_getElem?, Array.getElem?_replicate]
  simp

theorem dickmanDirectedGrid_getD_default_independent (p : ℤ) (M J i : ℕ) (hi : i ≤ J)
    (d e : ℚ × ℚ) :
    (dickmanDirectedGrid p M J).getD i d =
      (dickmanDirectedGrid p M J).getD i e := by
  have hb : i < (dickmanDirectedGrid p M J).size := by rw [directedGrid_size]; omega
  exact (Array.getElem_eq_getD (h := hb) d).symm.trans
    (Array.getElem_eq_getD (h := hb) e)

theorem dickmanDirectedGrid_recurrence_indices_lt_size (p : ℤ) (M j : ℕ) (hM : 0 < M) (hj : M ≤ j) :
    j < (dickmanDirectedGrid p M j).size ∧
      j - M < (dickmanDirectedGrid p M j).size ∧
      j + 1 - M < (dickmanDirectedGrid p M j).size ∧
      (M = 1 → j + 1 - M = j) ∧
      (j = M → j - M = 0 ∧ j + 1 - M = 1) := by
  rw [directedGrid_size]
  omega

theorem dickmanDirectedGrid_succ_of_active (p : ℤ) (M j : ℕ) (hM : 0 < M) (hj : M ≤ j) :
    let G := dickmanDirectedGrid p M j
    let lower : ℚ :=
      (G.getD j (1, 1)).1 - (G.getD (j - M) (1, 1)).2 / (2 * (j : ℚ)) -
        (G.getD (j + 1 - M) (1, 1)).2 / (2 * ((j : ℚ) + 1))
    let upper : ℚ :=
      (G.getD j (1, 1)).2 - (G.getD (j - M) (1, 1)).1 / (2 * (j : ℚ)) -
        (G.getD (j + 1 - M) (1, 1)).1 / (2 * ((j : ℚ) + 1)) +
        1 / (2 * (M : ℚ) ^ 3)
    dickmanDirectedGrid p M (j + 1) =
      G.push (max 0 (lower.toDyadic p).toRat,
        min 1 (-(((-upper).toDyadic p).toRat))) := by
  intro G lower upper
  change (if M = 0 ∨ j < M then G.push (1, 1) else
    G.push (max 0 (lower.toDyadic p).toRat,
      min 1 (-(((-upper).toDyadic p).toRat)))) = _
  rw [ite_eq_right (show ¬ (M = 0 ∨ j < M) by omega)]

theorem toDyadic_toRat_eq_floor_div_and_neg (q : ℚ) (p : ℤ) :
    (q.toDyadic p).toRat = (⌊q * 2 ^ p⌋ : ℚ) / 2 ^ p ∧
      -(((-q).toDyadic p).toRat) = -((⌊(-q) * 2 ^ p⌋ : ℚ) / 2 ^ p) :=
  ⟨Rat.toRat_toDyadic q p, congrArg Neg.neg (Rat.toRat_toDyadic (-q) p)⟩

theorem toDyadic_outward_rounding_error_bounds (q : ℚ) (p : ℤ) :
    0 ≤ q - (q.toDyadic p).toRat ∧
      q - (q.toDyadic p).toRat < (2 : ℚ) ^ (-p) ∧
      0 ≤ -(((-q).toDyadic p).toRat) - q ∧
      -(((-q).toDyadic p).toRat) - q < (2 : ℚ) ^ (-p) := by
  have h (x : ℚ) : 0 ≤ x - (x.toDyadic p).toRat ∧
      x - (x.toDyadic p).toRat < (2 : ℚ) ^ (-p) := by
    have hlo := Rat.toRat_toDyadic_le (x := x) (prec := p)
    have hhi := Rat.lt_toRat_toDyadic_add (x := x) (prec := p)
    rw [Dyadic.toRat_add, Dyadic.toRat_ofIntWithPrec_eq_mul_two_pow] at hhi
    norm_num only [Int.cast_one, one_mul] at hhi
    constructor <;> linarith
  obtain ⟨hl0, hl1⟩ := h q
  obtain ⟨hu0, hu1⟩ := h (-q)
  exact ⟨hl0, hl1, by linarith, by linarith⟩

theorem dickman_grid_physical_scaling (M : ℕ) (hM : 0 < M) (h : ℚ) (hh : 0 < h) (t : ℝ) :
    (((M : ℚ) * h : ℚ) : ℝ) = (M : ℝ) * (h : ℝ) ∧
      (t * (h : ℝ)) / (((M : ℚ) * h : ℚ) : ℝ) = t / (M : ℝ) ∧
      ((h ^ 3 / (12 * ((M : ℚ) * h) ^ 2) : ℚ) : ℝ) =
        (h : ℝ) / (12 * (M : ℝ) ^ 2) := by
  have hMr : (M : ℝ) ≠ 0 := by exact_mod_cast Nat.ne_of_gt hM
  have hhR : (h : ℝ) ≠ 0 := by exact_mod_cast ne_of_gt hh
  push_cast
  refine ⟨rfl, mul_div_mul_right _ _ hhR, ?_⟩
  field_simp

end

section
open scoped ArithmeticFunction.vonMangoldt
/-!
## Character sums and Dirichlet L-functions

Separate prime-power corrections and develop the analytic estimates for twisted von Mangoldt
sums.
-/

/-- The character-twisted Chebyshev sum `∑_{1 ≤ n ≤ x} χ(n) Λ(n)`. -/
noncomputable def twistedChebyshevSum
    (x q : ℕ) (χ : DirichletCharacter ℂ q) : ℂ :=
  ∑ n ∈ Finset.Icc 1 x,
    χ n * (ArithmeticFunction.vonMangoldt n : ℂ)

/--
The Chebyshev sum twisted by a character modulo `r` and restricted to integers coprime to `q`.
-/
noncomputable def coprimeTwistedChebyshevSum
    (x q r : ℕ) (χ : DirichletCharacter ℂ r) : ℂ :=
  ∑ n ∈ Finset.Icc 1 x with Nat.Coprime n q,
    χ n * (ArithmeticFunction.vonMangoldt n : ℂ)

theorem dirichletCharacter_eq_primitiveCharacter_of_coprime
    {q : ℕ} (χ : DirichletCharacter ℂ q) {n : ℕ}
    (hn : Nat.Coprime n q) :
    χ n = χ.primitiveCharacter n := by
  have hi : IsCoprime (n : ℤ) (q : ℤ) :=
    Nat.isCoprime_iff_coprime.mpr hn
  have h := χ.primitiveCharacter_apply_of_isCoprime hi
  simpa using h.symm

theorem twistedChebyshevSum_eq_coprime_add_nonCoprime
    (x q r : ℕ) (χ : DirichletCharacter ℂ r) :
    twistedChebyshevSum x r χ =
      coprimeTwistedChebyshevSum x q r χ +
        ∑ n ∈ Finset.Icc 1 x with ¬Nat.Coprime n q,
          χ n * (ArithmeticFunction.vonMangoldt n : ℂ) := by
  rw [twistedChebyshevSum, coprimeTwistedChebyshevSum]
  exact (Finset.sum_filter_add_sum_filter_not _ _ _).symm

theorem nonCoprimeTwistedChebyshevSum_eq_zero
    (x q : ℕ) (χ : DirichletCharacter ℂ q) :
    (∑ n ∈ Finset.Icc 1 x with ¬Nat.Coprime n q,
      χ n * (ArithmeticFunction.vonMangoldt n : ℂ)) = 0 := by
  apply Finset.sum_eq_zero
  intro n hn
  have hn_not_coprime : ¬Nat.Coprime n q := (Finset.mem_filter.mp hn).2
  have hn_nonunit : ¬IsUnit (n : ZMod q) := by
    rw [ZMod.isUnit_iff_coprime]
    exact hn_not_coprime
  rw [MulChar.map_nonunit χ hn_nonunit, zero_mul]

theorem twistedChebyshevSum_eq_coprime
    (x q : ℕ) (χ : DirichletCharacter ℂ q) :
    twistedChebyshevSum x q χ = coprimeTwistedChebyshevSum x q q χ := by
  rw [twistedChebyshevSum_eq_coprime_add_nonCoprime,
    nonCoprimeTwistedChebyshevSum_eq_zero, add_zero]

theorem coprimeTwistedChebyshevSum_eq_primitive
    {x q : ℕ} (χ : DirichletCharacter ℂ q) :
    coprimeTwistedChebyshevSum x q q χ =
      coprimeTwistedChebyshevSum x q χ.conductor χ.primitiveCharacter := by
  unfold coprimeTwistedChebyshevSum
  apply Finset.sum_congr rfl
  intro n hn
  have hn_coprime : Nat.Coprime n q := (Finset.mem_filter.mp hn).2
  rw [dirichletCharacter_eq_primitiveCharacter_of_coprime χ hn_coprime]

theorem primitiveTwistedChebyshevSum_eq_add_correction
    (x q : ℕ) (χ : DirichletCharacter ℂ q) :
    twistedChebyshevSum x χ.conductor χ.primitiveCharacter =
      twistedChebyshevSum x q χ +
        ∑ n ∈ Finset.Icc 1 x with ¬Nat.Coprime n q,
          χ.primitiveCharacter n *
            (ArithmeticFunction.vonMangoldt n : ℂ) := by
  rw [twistedChebyshevSum_eq_coprime_add_nonCoprime]
  rw [← coprimeTwistedChebyshevSum_eq_primitive χ]
  rw [← twistedChebyshevSum_eq_coprime]

/--
The character-weighted contribution of prime powers at most `x` whose base prime divides `q`,
using `log (minFac n)` as the von Mangoldt weight.
-/
noncomputable def primePowerCorrectionSum
    (x q r : ℕ) (χ : DirichletCharacter ℂ r) : ℂ :=
  ∑ n ∈ Finset.Icc 1 x with IsPrimePow n ∧ ¬Nat.Coprime n q,
    χ n * (Real.log (n.minFac : ℝ) : ℂ)

theorem nonCoprimeTwistedChebyshevSum_eq_primePowerCorrectionSum
    (x q r : ℕ) (χ : DirichletCharacter ℂ r) :
    (∑ n ∈ Finset.Icc 1 x with ¬Nat.Coprime n q,
      χ n * (ArithmeticFunction.vonMangoldt n : ℂ)) =
      primePowerCorrectionSum x q r χ := by
  unfold primePowerCorrectionSum
  rw [Finset.sum_filter, Finset.sum_filter]
  apply Finset.sum_congr rfl
  intro n hn
  by_cases hpp : IsPrimePow n
  · simp only [ArithmeticFunction.vonMangoldt_apply, ite_eq_left hpp]
    by_cases hcop : Nat.Coprime n q
    · simp [hcop, hpp]
    · simp [hcop, hpp]
  · simp only [ArithmeticFunction.vonMangoldt_apply, ite_eq_right hpp]
    simp [hpp]

theorem minFac_dvd_of_isPrimePow_not_coprime
    {n q : ℕ} (hn : IsPrimePow n) (hnot : ¬Nat.Coprime n q) :
    n.minFac ∣ q := by
  obtain ⟨p, k, hp, hk, rfl⟩ := (isPrimePow_nat_iff n).mp hn
  have hnotp : ¬Nat.Coprime p q := by
    intro hcp
    apply hnot
    exact (Nat.coprime_pow_left_iff hk p q).2 hcp
  have hpdvd : p ∣ q := by
    by_contra hpdvd
    exact hnotp (hp.coprime_iff_not_dvd.mpr hpdvd)
  rw [hp.pow_minFac hk.ne']
  exact hpdvd

theorem not_coprime_iff_minFac_dvd_of_isPrimePow
    {n q : ℕ} (hn : IsPrimePow n) :
    ¬Nat.Coprime n q ↔ n.minFac ∣ q := by
  constructor
  · exact minFac_dvd_of_isPrimePow_not_coprime hn
  · intro hdiv hcop
    have hmin_coprime : Nat.Coprime n.minFac q :=
      hcop.coprime_dvd_left (Nat.minFac_dvd n)
    exact (Nat.minFac_prime hn.ne_one).coprime_iff_not_dvd.mp hmin_coprime hdiv

theorem primitiveTwistedChebyshevSum_eq_add_primePowerCorrection
    (x q : ℕ) (χ : DirichletCharacter ℂ q) :
    twistedChebyshevSum x χ.conductor χ.primitiveCharacter =
      twistedChebyshevSum x q χ +
        primePowerCorrectionSum x q χ.conductor χ.primitiveCharacter := by
  rw [primitiveTwistedChebyshevSum_eq_add_correction]
  rw [nonCoprimeTwistedChebyshevSum_eq_primePowerCorrectionSum]

/--
The twisted Chebyshev sum with `ψ(x)` subtracted for the principal character and no subtraction
for nonprincipal characters.
-/
noncomputable def centeredTwistedChebyshevSum
    (x q : ℕ) (χ : DirichletCharacter ℂ q) : ℂ :=
  letI : DecidableEq (DirichletCharacter ℂ q) := Classical.decEq _
  twistedChebyshevSum x q χ -
    if χ = 1 then (Chebyshev.psi (x : ℝ) : ℂ) else 0

theorem centeredTwistedChebyshevSum_one (x : ℕ) :
    centeredTwistedChebyshevSum x 1
      (1 : DirichletCharacter ℂ 1) = 0 := by
  rw [centeredTwistedChebyshevSum, ite_eq_left rfl, sub_eq_zero]
  rw [twistedChebyshevSum, Chebyshev.psi, Nat.floor_natCast]
  have hinterval : Finset.Icc 1 x = Finset.Ioc 0 x := by
    simpa using Finset.Icc_succ_left_eq_Ioc 0 x
  rw [hinterval]
  rw [Complex.ofReal_sum]
  apply Finset.sum_congr rfl
  intro n hn
  have hu : IsUnit (n : ZMod 1) :=
    ⟨1, Subsingleton.elim _ _⟩
  rw [MulChar.one_apply hu]
  simp

end

/--
The unweighted von Mangoldt mass of prime powers at most `x` that are not coprime to `q`; it
bounds the absolute size of the character correction.
-/
noncomputable def primePowerCorrectionMass (x q : ℕ) : ℝ :=
  ∑ n ∈ Finset.Icc 1 x with IsPrimePow n ∧ ¬Nat.Coprime n q,
    Real.log (n.minFac : ℝ)

/--
Pairs `(p, k)` with `p ∈ q.primeFactors`, `1 ≤ k ≤ x`, and `p^k ≤ x`, indexing the prime-power
contributions excluded by coprimality. In particular, the set is empty when `q = 0`, following
the convention for `Nat.primeFactors`.
-/
def primePowerCorrectionPairs (x q : ℕ) : Finset (ℕ × ℕ) :=
  (q.primeFactors ×ˢ Finset.Icc 1 x).filter fun pk => pk.1 ^ pk.2 ≤ x

theorem primePowerCorrectionMass_eq_pair_sum
    {x q : ℕ} (hq : q ≠ 0) :
    primePowerCorrectionMass x q =
      ∑ pk ∈ primePowerCorrectionPairs x q,
        Real.log (pk.1 : ℝ) := by
  rw [primePowerCorrectionMass, primePowerCorrectionPairs]
  apply Finset.sum_bij
      (fun n _ => (n.minFac, n.factorization n.minFac))
  · intro n hn
    rcases Finset.mem_filter.mp hn with ⟨hnx, hpp, hncop⟩
    have hnx_bounds : 1 ≤ n ∧ n ≤ x := Finset.mem_Icc.mp hnx
    have hp : Nat.Prime n.minFac := Nat.minFac_prime hpp.ne_one
    have hk : 0 < n.factorization n.minFac := by
      rw [pos_iff_ne_zero]
      intro hkzero
      apply hpp.ne_one
      simpa [hkzero] using hpp.minFac_pow_factorization_eq.symm
    have hpow := hpp.minFac_pow_factorization_eq
    rw [Finset.mem_filter, Finset.mem_product]
    exact ⟨⟨Nat.mem_primeFactors.mpr
        ⟨hp, minFac_dvd_of_isPrimePow_not_coprime hpp hncop, hq⟩,
      Finset.mem_Icc.mpr
        ⟨hk, (Nat.lt_pow_self hp.one_lt).le.trans
          (hpow.trans_le hnx_bounds.2)⟩⟩,
      hpow.trans_le hnx_bounds.2⟩
  · intro n₁ hn₁ n₂ hn₂ hpair
    have hpp₁ : IsPrimePow n₁ := (Finset.mem_filter.mp hn₁).2.1
    have hpp₂ : IsPrimePow n₂ := (Finset.mem_filter.mp hn₂).2.1
    have hpow₁ := hpp₁.minFac_pow_factorization_eq
    have hpow₂ := hpp₂.minFac_pow_factorization_eq
    calc
      n₁ = n₁.minFac ^ n₁.factorization n₁.minFac := hpow₁.symm
      _ = n₂.minFac ^ n₂.factorization n₂.minFac :=
        congrArg (fun z : ℕ × ℕ => z.1 ^ z.2) hpair
      _ = n₂ := hpow₂
  · rintro ⟨p, k⟩ hpk
    rcases Finset.mem_filter.mp hpk with ⟨hprod, hpow⟩
    rcases Finset.mem_product.mp hprod with ⟨hpq, hkx⟩
    have hp : Nat.Prime p := Nat.prime_of_mem_primeFactors hpq
    have hpdvd : p ∣ q := Nat.dvd_of_mem_primeFactors hpq
    have hk : 0 < k := (Finset.mem_Icc.mp hkx).1
    have hpp : IsPrimePow (p ^ k) :=
      (isPrimePow_nat_iff (p ^ k)).mpr ⟨p, k, hp, hk, rfl⟩
    have hncop : ¬Nat.Coprime (p ^ k) q := by
      rw [not_coprime_iff_minFac_dvd_of_isPrimePow hpp,
        hp.pow_minFac hk.ne']
      exact hpdvd
    have hone : 1 ≤ p ^ k := one_le_pow₀ hp.one_le
    have hnmem : p ^ k ∈
        (Finset.Icc 1 x).filter
          (fun n => IsPrimePow n ∧ ¬Nat.Coprime n q) :=
      Finset.mem_filter.mpr
        ⟨Finset.mem_Icc.mpr ⟨hone, hpow⟩, hpp, hncop⟩
    refine ⟨p ^ k, hnmem, ?_⟩
    simp [hp.pow_minFac hk.ne', hp.factorization_pow]
  · intro n hn
    rfl

theorem sum_prime_powers_log_le_log
    {x p : ℕ} (hx : 2 ≤ x) (hp : Nat.Prime p) :
    (∑ k ∈ Finset.Icc 1 x with p ^ k ≤ x,
      Real.log (p : ℝ)) ≤ Real.log (x : ℝ) := by
  have hx0 : x ≠ 0 := by omega
  have hfilter :
      (Finset.Icc 1 x).filter (fun k => p ^ k ≤ x) =
        Finset.Icc 1 (p.log x) := by
    ext k
    simp only [Finset.mem_filter, Finset.mem_Icc]
    constructor
    · rintro ⟨⟨hk1, _⟩, hpow⟩
      exact ⟨hk1, Nat.le_log_of_pow_le hp.one_lt hpow⟩
    · rintro ⟨hk1, hklog⟩
      have hpow : p ^ k ≤ x :=
        (Nat.le_log_iff_pow_le hp.one_lt hx0).mp hklog
      have hkx : k ≤ x :=
        (Nat.lt_pow_self hp.one_lt).le.trans hpow
      exact ⟨⟨hk1, hkx⟩, hpow⟩
  rw [hfilter]
  simp only [Finset.sum_const, nsmul_eq_mul]
  have hlogp : 0 < Real.log (p : ℝ) :=
    Real.log_pos (by exact_mod_cast hp.one_lt)
  have hnatlog : (p.log x : ℝ) ≤ Real.log (x : ℝ) / Real.log (p : ℝ) := by
    simpa [Real.logb] using Real.natLog_le_logb x p
  have hmul := mul_le_mul_of_nonneg_right hnatlog hlogp.le
  field_simp [hlogp.ne'] at hmul
  simpa [Nat.cast_ofNat] using hmul

theorem primePowerCorrectionMass_le_log_mul_card_primeFactors
    {x q : ℕ} (hx : 2 ≤ x) (hq : 1 ≤ q) :
    primePowerCorrectionMass x q ≤
      Real.log (x : ℝ) * (q.primeFactors.card : ℝ) := by
  have hq0 : q ≠ 0 := by omega
  rw [primePowerCorrectionMass_eq_pair_sum hq0]
  calc
    (∑ pk ∈ primePowerCorrectionPairs x q,
        Real.log (pk.1 : ℝ)) =
        ∑ p ∈ q.primeFactors,
          ∑ k ∈ Finset.Icc 1 x with p ^ k ≤ x,
            Real.log (p : ℝ) := by
      simp only [primePowerCorrectionPairs, Finset.sum_filter,
        Finset.sum_product]
    _ ≤ ∑ p ∈ q.primeFactors, Real.log (x : ℝ) := by
      apply Finset.sum_le_sum
      intro p hpq
      exact sum_prime_powers_log_le_log hx
        (Nat.prime_of_mem_primeFactors hpq)
    _ = Real.log (x : ℝ) * (q.primeFactors.card : ℝ) := by
      simp [Finset.sum_const, mul_comm]

theorem card_primeFactors_le_two_mul_log
    {q : ℕ} (hq : 1 ≤ q) :
    (q.primeFactors.card : ℝ) ≤ 2 * Real.log (q : ℝ) := by
  have hq0 : q ≠ 0 := by omega
  have htwo_prod : 2 ^ q.primeFactors.card ≤
      ∏ p ∈ q.primeFactors, p := by
    apply Finset.pow_card_le_prod
    intro p hpq
    exact (Nat.prime_of_mem_primeFactors hpq).two_le
  have hprod_q : (∏ p ∈ q.primeFactors, p) ≤ q :=
    Nat.le_of_dvd (by omega) (Nat.prod_primeFactors_dvd q)
  have hpow_q : 2 ^ q.primeFactors.card ≤ q := htwo_prod.trans hprod_q
  have hlog_le : Real.log ((2 ^ q.primeFactors.card : ℕ) : ℝ) ≤
      Real.log (q : ℝ) := by
    apply Real.log_le_log
    · positivity
    · exact_mod_cast hpow_q
  rw [Nat.cast_pow, Nat.cast_ofNat, Real.log_pow] at hlog_le
  have hhalf_log_two : (1 / 2 : ℝ) ≤ Real.log 2 := by
    have h := Real.one_sub_inv_le_log_of_pos (show (0 : ℝ) < 2 by norm_num)
    norm_num at h ⊢
    exact h
  have hcard_half : (q.primeFactors.card : ℝ) * (1 / 2) ≤
      (q.primeFactors.card : ℝ) * Real.log 2 :=
    mul_le_mul_of_nonneg_left hhalf_log_two (by positivity)
  nlinarith

theorem norm_primePowerCorrectionSum_le_mass
    (x q r : ℕ) (χ : DirichletCharacter ℂ r) :
    ‖primePowerCorrectionSum x q r χ‖ ≤
      primePowerCorrectionMass x q := by
  unfold primePowerCorrectionSum primePowerCorrectionMass
  refine norm_sum_le_of_le _ fun n _ => ?_
  rw [norm_mul, Complex.norm_of_nonneg (Real.log_natCast_nonneg _)]
  simpa only [one_mul] using
    mul_le_mul_of_nonneg_right (χ.norm_le_one (n : ZMod r))
      (Real.log_natCast_nonneg n.minFac)

theorem norm_primePowerCorrectionSum_le_log_mul_sq
    {x q r : ℕ} (χ : DirichletCharacter ℂ r)
    (hx : 2 ≤ x) (hq : 1 ≤ q) :
    ‖primePowerCorrectionSum x q r χ‖ ≤
      (Real.log ((q * x : ℕ) : ℝ)) ^ 2 := by
  have hlogx : 0 ≤ Real.log (x : ℝ) :=
    Real.log_nonneg (by exact_mod_cast (show 1 ≤ x by omega))
  have hcard := card_primeFactors_le_two_mul_log hq
  have hcard_mul :
      Real.log (x : ℝ) * (q.primeFactors.card : ℝ) ≤
        Real.log (x : ℝ) * (2 * Real.log (q : ℝ)) :=
    mul_le_mul_of_nonneg_left hcard hlogx
  have hq0 : (q : ℝ) ≠ 0 := by exact_mod_cast (show q ≠ 0 by omega)
  have hx0 : (x : ℝ) ≠ 0 := by exact_mod_cast (show x ≠ 0 by omega)
  calc
    ‖primePowerCorrectionSum x q r χ‖ ≤
        primePowerCorrectionMass x q :=
      norm_primePowerCorrectionSum_le_mass x q r χ
    _ ≤ Real.log (x : ℝ) * (q.primeFactors.card : ℝ) :=
      primePowerCorrectionMass_le_log_mul_card_primeFactors hx hq
    _ ≤ Real.log (x : ℝ) * (2 * Real.log (q : ℝ)) := hcard_mul
    _ ≤ (Real.log (q : ℝ) + Real.log (x : ℝ)) ^ 2 := by
      nlinarith [sq_nonneg (Real.log (q : ℝ) - Real.log (x : ℝ))]
    _ = (Real.log ((q * x : ℕ) : ℝ)) ^ 2 := by
      rw [Nat.cast_mul, Real.log_mul hq0 hx0]

theorem norm_primitiveTwistedChebyshevSum_sub_le_log_mul_sq
    {x q : ℕ} (χ : DirichletCharacter ℂ q)
    (hx : 2 ≤ x) (hq : 1 ≤ q) :
    ‖twistedChebyshevSum x χ.conductor χ.primitiveCharacter -
        twistedChebyshevSum x q χ‖ ≤
      (Real.log ((q * x : ℕ) : ℝ)) ^ 2 := by
  rw [primitiveTwistedChebyshevSum_eq_add_primePowerCorrection]
  simpa using
    norm_primePowerCorrectionSum_le_log_mul_sq χ.primitiveCharacter hx hq

section
open Complex

section DirichletLZeroDivisor
theorem analyticOnNhd_LFunction_of_nontrivial
    {N : ℕ} [NeZero N] {χ : DirichletCharacter ℂ N} (hχ : χ ≠ 1) :
    AnalyticOnNhd ℂ (DirichletCharacter.LFunction χ) Set.univ :=
  fun z _ => (DirichletCharacter.differentiable_LFunction hχ).analyticAt z

theorem LFunction_ne_zero_function_of_nontrivial
    {N : ℕ} [NeZero N] {χ : DirichletCharacter ℂ N} (hχ : χ ≠ 1) :
    DirichletCharacter.LFunction χ ≠ 0 :=
  fun hzero => (χ.LFunction_ne_zero_of_one_le_re (.inl hχ)
    (s := 2) (by norm_num)) (congrFun hzero 2)

theorem analyticOrderAt_LFunction_ne_top
    {N : ℕ} [NeZero N] {χ : DirichletCharacter ℂ N} (hχ : χ ≠ 1) (s : ℂ) :
    analyticOrderAt (DirichletCharacter.LFunction χ) s ≠ ⊤ := by
  rw [ne_eq, AnalyticOnNhd.analyticOrderAt_eq_top_iff_eq_zero s
    (fun z => analyticOnNhd_LFunction_of_nontrivial hχ z (Set.mem_univ z))]
  exact LFunction_ne_zero_function_of_nontrivial hχ

end DirichletLZeroDivisor

theorem divisor_LFunction_apply_eq_analyticOrderNatAt
    {N : ℕ} [NeZero N] {χ : DirichletCharacter ℂ N}
    (hχ : χ ≠ 1) {U : Set ℂ} {s : ℂ} (hsU : s ∈ U) :
    MeromorphicOn.divisor (DirichletCharacter.LFunction χ) U s =
      (analyticOrderNatAt (DirichletCharacter.LFunction χ) s : ℤ) := by
  rw [MeromorphicOn.AnalyticOnNhd.divisor_apply
    ((analyticOnNhd_LFunction_of_nontrivial hχ).mono (Set.subset_univ U)) hsU]
  have hfinite := analyticOrderAt_LFunction_ne_top hχ s
  rw [← Nat.cast_analyticOrderNatAt hfinite, ENat.map_natCast,
    WithTop.untop₀_coe]

theorem mem_support_divisor_LFunction_iff
    {N : ℕ} [NeZero N] {χ : DirichletCharacter ℂ N}
    (hχ : χ ≠ 1) {U : Set ℂ} {s : ℂ} (hsU : s ∈ U) :
    s ∈ (MeromorphicOn.divisor (DirichletCharacter.LFunction χ) U).support ↔
      DirichletCharacter.LFunction χ s = 0 := by
  rw [Function.mem_support,
    MeromorphicOn.AnalyticOnNhd.divisor_apply
      ((analyticOnNhd_LFunction_of_nontrivial hχ).mono (Set.subset_univ U)) hsU]
  have htop := analyticOrderAt_LFunction_ne_top hχ s
  lift analyticOrderAt (DirichletCharacter.LFunction χ) s to ℕ using htop
    with n hn
  simp only [ENat.map_natCast, WithTop.untop₀_coe]
  constructor
  · intro hnInt
    have hnNat : n ≠ 0 := by exact_mod_cast hnInt
    have horder : analyticOrderAt (DirichletCharacter.LFunction χ) s ≠ 0 := by
      rw [← hn]
      exact_mod_cast hnNat
    exact ((DirichletCharacter.differentiable_LFunction hχ).analyticAt s
      |>.analyticOrderAt_ne_zero).mp horder
  · intro hzero
    have horder : analyticOrderAt (DirichletCharacter.LFunction χ) s ≠ 0 :=
      ((DirichletCharacter.differentiable_LFunction hχ).analyticAt s
        |>.analyticOrderAt_ne_zero).mpr hzero
    rw [← hn] at horder
    exact_mod_cast horder

theorem divisor_LFunction_nonneg
    {N : ℕ} [NeZero N] {χ : DirichletCharacter ℂ N}
    (hχ : χ ≠ 1) (U : Set ℂ) :
    0 ≤ MeromorphicOn.divisor (DirichletCharacter.LFunction χ) U :=
  MeromorphicOn.AnalyticOnNhd.divisor_nonneg
    ((analyticOnNhd_LFunction_of_nontrivial hχ).mono (Set.subset_univ U))

theorem divisor_LFunction_closedBall_support_finite
    {N : ℕ} [NeZero N] {χ : DirichletCharacter ℂ N}
    (hχ : χ ≠ 1) (c : ℂ) (R : ℝ) :
    (MeromorphicOn.divisor (DirichletCharacter.LFunction χ)
      (Metric.closedBall c R)).support.Finite :=
  ((analyticOnNhd_LFunction_of_nontrivial hχ).mono
    (Set.subset_univ (Metric.closedBall c R))).meromorphicOn
      |>.divisor_support_finite_of_subset (isCompact_closedBall c R)
        Set.Subset.rfl

theorem one_le_divisor_LFunction_of_zero
    {N : ℕ} [NeZero N] {χ : DirichletCharacter ℂ N}
    (hχ : χ ≠ 1) {U : Set ℂ} {s : ℂ}
    (hsU : s ∈ U) (hsZero : DirichletCharacter.LFunction χ s = 0) :
    1 ≤ MeromorphicOn.divisor (DirichletCharacter.LFunction χ) U s := by
  have hne : MeromorphicOn.divisor
      (DirichletCharacter.LFunction χ) U s ≠ 0 :=
    Function.mem_support.mp
      ((mem_support_divisor_LFunction_iff hχ hsU).2 hsZero)
  have hnonneg : 0 ≤ MeromorphicOn.divisor
      (DirichletCharacter.LFunction χ) U s :=
    (divisor_LFunction_nonneg hχ U) s
  omega

end

section
open Complex Set

theorem mem_dirichletExplicitFormulaCandidateSingularities_iff
    {N : ℕ} [NeZero N] {chi : DirichletCharacter ℂ N}
    {z w rho : ℂ} :
    rho ∈ ({pntCandidate | pntCandidate ∈ Complex.Rectangle (z) (w) ∧
             (((chi) = 1 ∧ pntCandidate = 1) ∨
               ((pntCandidate ≠ 1 ∨ (chi) ≠ 1) ∧
                 DirichletCharacter.LFunction (chi) pntCandidate = 0))}) ↔
      rho ∈ Complex.Rectangle z w ∧
        ((chi = 1 ∧ rho = 1) ∨
          ((rho ≠ 1 ∨ chi ≠ 1) ∧
            DirichletCharacter.LFunction chi rho = 0)) :=
  Iff.rfl

theorem dirichletExplicitFormulaCandidateSingularities_finite
    {N : ℕ} [NeZero N] (chi : DirichletCharacter ℂ N)
    (z w : ℂ) :
    (({pntCandidate | pntCandidate ∈ Complex.Rectangle (z) (w) ∧
        (((chi) = 1 ∧ pntCandidate = 1) ∨
          ((pntCandidate ≠ 1 ∨ (chi) ≠ 1) ∧
            DirichletCharacter.LFunction (chi) pntCandidate = 0))})).Finite := by
  have finiteZeros : ∀ (f : ℂ → ℂ),
      Differentiable ℂ f → f ≠ 0 →
      {s | s ∈ Complex.Rectangle z w ∧ f s = 0}.Finite := by
    intro f hf hne
    let U := Complex.Rectangle z w
    have hA : AnalyticOnNhd ℂ f U := fun s _ => hf.analyticAt s
    have hfiniteSupport :
        (MeromorphicOn.divisor f U).support.Finite :=
      hA.meromorphicOn.divisor_support_finite_of_subset
        (isCompact_uIcc.reProdIm isCompact_uIcc) Set.Subset.rfl
    apply hfiniteSupport.subset
    rintro s ⟨hsU, hfs⟩
    have htop : analyticOrderAt f s ≠ ⊤ := by
      rw [ne_eq, AnalyticOnNhd.analyticOrderAt_eq_top_iff_eq_zero s
        (fun u => hf.analyticAt u)]
      exact hne
    have horder : analyticOrderAt f s ≠ 0 :=
      (hf.analyticAt s).analyticOrderAt_ne_zero.mpr hfs
    rw [Function.mem_support,
      MeromorphicOn.AnalyticOnNhd.divisor_apply hA hsU]
    lift analyticOrderAt f s to ℕ using htop with n hn
    simp only [ENat.map_natCast, WithTop.untop₀_coe]
    exact_mod_cast horder
  by_cases hchi : chi = 1
  · subst chi
    let G : ℂ → ℂ := DirichletCharacter.LFunctionTrivChar₁ N
    have hGne : G ≠ 0 := by
      intro hzero
      have hGone : G 1 = 0 := by rw [hzero]; rfl
      exact DirichletCharacter.LFunctionTrivChar₁_apply_one_ne_zero N hGone
    have hGfinite := finiteZeros G
      (by simpa [G] using
        DirichletCharacter.differentiable_LFunctionTrivChar₁ N)
      hGne
    apply (hGfinite.union (Set.finite_singleton (1 : ℂ))).subset
    rintro rho ⟨hrhoRect, hpole | hzero⟩
    · exact Set.mem_union_right _ hpole.2
    · have hrhoOne : rho ≠ 1 := hzero.1.resolve_right (by simp)
      have htrivZero :
          DirichletCharacter.LFunctionTrivChar N rho = 0 :=
        hzero.2
      apply Set.mem_union_left
      refine ⟨hrhoRect, ?_⟩
      dsimp only [G]
      rw [DirichletCharacter.LFunctionTrivChar₁,
        Function.update_of_ne hrhoOne, htrivZero, mul_zero]
  · have hLne : DirichletCharacter.LFunction chi ≠ 0 := by
      intro hzero
      have htwo : DirichletCharacter.LFunction chi (2 : ℂ) = 0 := by
        rw [hzero]
        rfl
      exact (chi.LFunction_ne_zero_of_one_le_re
        (.inl hchi) (by norm_num)) htwo
    apply (finiteZeros (DirichletCharacter.LFunction chi)
      (DirichletCharacter.differentiable_LFunction hchi) hLne).subset
    rintro rho ⟨hrhoRect, hpole | hzero⟩
    · exact (hchi hpole.1).elim
    · exact ⟨hrhoRect, hzero.2⟩

end

section
open Complex

section InducingEulerProduct
local instance inducingEulerProductConductorNeZero
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q) :
    NeZero chi.conductor :=
  ⟨chi.conductor_ne_zero⟩

end InducingEulerProduct
end

section
open Complex

attribute [local instance] inducingEulerProductConductorNeZero
/--
The finite Euler correction `∏ p ∣ q, (1 - χ*(p) * p^(-s))` for the primitive character inducing
`chi`. Primes dividing the conductor contribute the factor `1`.
-/
noncomputable def inducingEulerProduct
    {q : ℕ}
    (chi : DirichletCharacter ℂ q) (s : ℂ) : ℂ :=
  ∏ p ∈ q.primeFactors,
    (1 - chi.primitiveCharacter p * (p : ℂ) ^ (-s))

end

section
open Complex

attribute [local instance] inducingEulerProductConductorNeZero

section InducingEulerProduct
theorem primitiveCharacter_ne_one_of_ne_one
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    (hchi : chi ≠ 1) :
    chi.primitiveCharacter ≠ 1 := by
  rwa [ne_eq, ← DirichletCharacter.changeLevel_eq_one_iff
    (χ := chi.primitiveCharacter) chi.conductor_dvd_level, chi.changeLevel_primitiveCharacter]

theorem norm_character_mul_cpow_lt_one
    {d : ℕ} (psi : DirichletCharacter ℂ d)
    (p : ℕ) (hp : p.Prime) (s : ℂ) (hs : 0 < s.re) :
    ‖psi p * (p : ℂ) ^ (-s)‖ < 1 := by
  rw [norm_mul, Complex.norm_natCast_cpow_of_pos hp.pos, neg_re]
  exact (mul_le_of_le_one_left (by positivity) (psi.norm_le_one _)).trans_lt
    (Real.rpow_lt_one_of_one_lt_of_neg (by exact_mod_cast hp.one_lt) (by linarith))

theorem inducingEulerFactor_ne_zero_of_re_pos
    {d : ℕ} (psi : DirichletCharacter ℂ d)
    (p : ℕ) (hp : p.Prime) (s : ℂ) (hs : 0 < s.re) :
    (1 : ℂ) - psi p * (p : ℂ) ^ (-s) ≠ 0 := by
  intro hzero
  have hw : psi p * (p : ℂ) ^ (-s) = 1 :=
    (sub_eq_zero.mp hzero).symm
  have hnorm := norm_character_mul_cpow_lt_one psi p hp s hs
  rw [hw, norm_one] at hnorm
  exact (lt_irrefl 1) hnorm

theorem differentiableAt_inducingEulerFactor
    {d : ℕ} (psi : DirichletCharacter ℂ d)
    (p : ℕ) (hp : p.Prime) (s : ℂ) :
    DifferentiableAt ℂ
      (fun z : ℂ => 1 - psi p * (p : ℂ) ^ (-z)) s :=
  ((hasDerivAt_const s (1 : ℂ)).sub
    (((hasDerivAt_neg' s).const_cpow
      (Or.inl (Nat.cast_ne_zero.mpr hp.ne_zero))).const_mul
        (psi p))).differentiableAt

end InducingEulerProduct
end

section
open Complex

attribute [local instance] inducingEulerProductConductorNeZero
theorem LFunction_eq_inducingPrimitive_mul_inducingEulerProduct
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    {s : ℂ} (hguard : chi ≠ 1 ∨ s ≠ 1) :
    DirichletCharacter.LFunction chi s =
      DirichletCharacter.LFunction chi.primitiveCharacter s *
        inducingEulerProduct chi s := by
  have hprimitiveGuard : chi.primitiveCharacter ≠ 1 ∨ s ≠ 1 :=
    hguard.imp (primitiveCharacter_ne_one_of_ne_one chi) id
  calc
    DirichletCharacter.LFunction chi s =
        DirichletCharacter.LFunction
          (DirichletCharacter.changeLevel chi.conductor_dvd_level
            chi.primitiveCharacter) s := by
      rw [chi.changeLevel_primitiveCharacter]
    _ = DirichletCharacter.LFunction chi.primitiveCharacter s *
        ∏ p ∈ q.primeFactors,
          (1 - chi.primitiveCharacter p * (p : ℂ) ^ (-s)) :=
      DirichletCharacter.LFunction_changeLevel chi.conductor_dvd_level
        chi.primitiveCharacter hprimitiveGuard
    _ = _ := rfl

theorem inducingEulerProduct_ne_zero_of_re_pos
    {q : ℕ} (chi : DirichletCharacter ℂ q)
    {s : ℂ} (hs : 0 < s.re) :
    inducingEulerProduct chi s ≠ 0 := by
  rw [inducingEulerProduct, Finset.prod_ne_zero_iff]
  intro p hp
  exact inducingEulerFactor_ne_zero_of_re_pos chi.primitiveCharacter p
    (Nat.prime_of_mem_primeFactors hp) s hs

theorem differentiable_inducingEulerProduct
    {q : ℕ} (chi : DirichletCharacter ℂ q) :
    Differentiable ℂ (inducingEulerProduct chi) := by
  intro s
  unfold inducingEulerProduct
  exact .fun_finsetProd fun p hp =>
    differentiableAt_inducingEulerFactor chi.primitiveCharacter p
      (Nat.prime_of_mem_primeFactors hp) s

end

section
open Complex

section InducingEulerProductZeroGeometry
theorem re_eq_zero_of_inducingEulerFactor_eq_zero
    {d : ℕ} (psi : DirichletCharacter ℂ d)
    (p : ℕ) (hp : p.Prime) (s : ℂ)
    (hzero : (1 : ℂ) - psi p * (p : ℂ) ^ (-s) = 0) :
    s.re = 0 := by
  have hprod : psi p * (p : ℂ) ^ (-s) = 1 :=
    (sub_eq_zero.mp hzero).symm
  have hpsi : psi p ≠ 0 := by
    intro h
    rw [h, zero_mul] at hprod
    exact zero_ne_one hprod
  have hpUnit : IsUnit (p : ZMod d) :=
    MulChar.apply_ne_zero_iff.mp hpsi
  have hpsiNorm : ‖psi p‖ = 1 := by
    rw [psi.toUnitHom_eq_char' hpUnit]
    exact psi.unit_norm_eq_one hpUnit.unit
  have hnorm := congrArg norm hprod
  rw [norm_mul, hpsiNorm, one_mul, norm_one,
    Complex.norm_natCast_cpow_of_pos hp.pos, neg_re] at hnorm
  have hpow : (p : ℝ) ^ (-s.re) = (p : ℝ) ^ (0 : ℝ) := by
    simpa using hnorm
  have hbasePos : (0 : ℝ) < p := by exact_mod_cast hp.pos
  have hbaseNeOne : (p : ℝ) ≠ 1 := by exact_mod_cast hp.ne_one
  have : -s.re = 0 :=
    (Real.rpow_right_inj hbasePos hbaseNeOne).mp hpow
  linarith

end InducingEulerProductZeroGeometry

theorem re_eq_zero_of_inducingEulerProduct_eq_zero
    {q : ℕ}
    (chi : DirichletCharacter ℂ q) {rho : ℂ}
    (hzero : inducingEulerProduct chi rho = 0) :
    rho.re = 0 := by
  rw [inducingEulerProduct, Finset.prod_eq_zero_iff] at hzero
  obtain ⟨p, hpMem, hpZero⟩ := hzero
  exact re_eq_zero_of_inducingEulerFactor_eq_zero chi.primitiveCharacter p
    (Nat.prime_of_mem_primeFactors hpMem) rho hpZero

theorem inducingEulerProduct_zero_mem_closedBall_radiusThree
    {q : ℕ}
    (chi : DirichletCharacter ℂ q) {rho : ℂ} (t : ℝ)
    (hzero : inducingEulerProduct chi rho = 0)
    (hheight : |rho.im - t| ≤ 1) :
    rho ∈ closedBall ((2 : ℂ) + t * I) 3 := by
  have hre : rho.re = 0 :=
    re_eq_zero_of_inducingEulerProduct_eq_zero chi hzero
  have hx : (rho.re - 2) ^ 2 ≤ (2 : ℝ) ^ 2 := by
    rw [hre]
    norm_num
  have hy : (rho.im - t) ^ 2 ≤ (1 : ℝ) ^ 2 :=
    sq_le_sq.mpr (by simpa using hheight)
  rw [mem_closedBall, Complex.dist_eq, Complex.norm_def, Real.sqrt_le_iff]
  constructor
  · norm_num
  · rw [Complex.normSq_apply]
    simp only [Complex.sub_re, Complex.add_re, Complex.ofReal_re,
      Complex.mul_re, Complex.ofReal_im, Complex.I_re, Complex.I_im,
      mul_one, sub_zero, Complex.sub_im, Complex.add_im]
    norm_num
    nlinarith

end

section
open Finset

section PrimitiveGaussSum
theorem sum_star_mul_dft {q : ℕ} [NeZero q] (f : ZMod q → ℂ) :
    (∑ k : ZMod q, star (ZMod.dft f k) * ZMod.dft f k) =
      (q : ℂ) * ∑ j : ZMod q, star (f j) * f j := by
  classical
  have hstar (x : ZMod q) :
      star (ZMod.stdAddChar x) = ZMod.stdAddChar (-x) := by
    simpa only [Complex.star_def] using
      (AddChar.map_neg_eq_conj ZMod.stdAddChar x).symm
  simp only [ZMod.dft_apply, smul_eq_mul, star_sum, star_mul]
  simp_rw [hstar]
  simp only [neg_neg]
  simp_rw [Finset.sum_mul, Finset.mul_sum]
  rw [Finset.sum_comm]
  apply Finset.sum_congr rfl
  intro j _
  rw [Finset.sum_comm]
  have hsummand (i k : ZMod q) :
      star (f j) * ZMod.stdAddChar (j * k) *
          (ZMod.stdAddChar (-(i * k)) * f i) =
        (star (f j) * f i) * ZMod.stdAddChar (k * (j - i)) := by
    calc
      _ = (star (f j) * f i) *
          (ZMod.stdAddChar (j * k) * ZMod.stdAddChar (-(i * k))) := by ring
      _ = (star (f j) * f i) *
          ZMod.stdAddChar (j * k + -(i * k)) := by rw [map_add_eq_mul]
      _ = _ := by
        rw [show j * k + -(i * k) = k * (j - i) by ring]
  simp_rw [hsummand, ← Finset.mul_sum]
  simp_rw [AddChar.sum_mulShift (ψ := ZMod.stdAddChar) _
    (ZMod.isPrimitive_stdAddChar q)]
  simp only [sub_eq_zero, ZMod.card, Nat.cast_ite, Nat.cast_zero,
    mul_ite, mul_zero]
  simp [eq_comm]
  ring

end PrimitiveGaussSum

theorem sum_norm_sq_dft {q : ℕ} [NeZero q] (f : ZMod q → ℂ) :
    (∑ k : ZMod q, ‖ZMod.dft f k‖ ^ 2) =
      (q : ℝ) * ∑ j : ZMod q, ‖f j‖ ^ 2 := by
  have h := sum_star_mul_dft f
  rw [Complex.star_def] at h
  simp_rw [← Complex.normSq_eq_conj_mul_self,
    Complex.normSq_eq_norm_sq] at h
  exact_mod_cast h

theorem sum_norm_sq_dirichletCharacter {q : ℕ} [NeZero q]
    (χ : DirichletCharacter ℂ q) :
    (∑ j : ZMod q, ‖χ j‖ ^ 2) = (Nat.totient q : ℝ) := by
  classical
  have h := MulChar.sum_one_eq_card_units (R := ZMod q) (R' := ℂ)
  rw [← MulChar.inv_mul χ] at h
  simp only [MulChar.mul_apply, ← MulChar.star_apply', Complex.star_def,
    ← Complex.normSq_eq_conj_mul_self, Complex.normSq_eq_norm_sq,
    ZMod.card_units_eq_totient] at h
  exact_mod_cast h

theorem norm_gaussSum_stdAddChar_of_isPrimitive {q : ℕ} [NeZero q]
    (χ : DirichletCharacter ℂ q) (hχ : χ.IsPrimitive) :
    ‖gaussSum χ ZMod.stdAddChar‖ = Real.sqrt q := by
  have hmassNeg :
      (∑ k : ZMod q, ‖χ⁻¹ (-k)‖ ^ 2) = (Nat.totient q : ℝ) := by
    calc
      _ = ∑ k : ZMod q, ‖χ⁻¹ k‖ ^ 2 :=
        Equiv.sum_comp (Equiv.neg (ZMod q)) (fun k ↦ ‖χ⁻¹ k‖ ^ 2)
      _ = (Nat.totient q : ℝ) := sum_norm_sq_dirichletCharacter χ⁻¹
  have hparseval := sum_norm_sq_dft (f := fun j ↦ χ j)
  simp_rw [hχ.fourierTransform_eq_inv_mul_gaussSum, norm_mul, mul_pow] at hparseval
  rw [← Finset.sum_mul, hmassNeg,
    sum_norm_sq_dirichletCharacter χ] at hparseval
  have htotient : (Nat.totient q : ℝ) ≠ 0 := by
    exact_mod_cast (Nat.ne_of_gt (Nat.totient_pos.mpr
      (Nat.pos_of_ne_zero (NeZero.ne q))))
  have hsquare : ‖gaussSum χ ZMod.stdAddChar‖ ^ 2 = (q : ℝ) := by
    apply mul_left_cancel₀ htotient
    calc
      (Nat.totient q : ℝ) * ‖gaussSum χ ZMod.stdAddChar‖ ^ 2 =
          (q : ℝ) * Nat.totient q := hparseval
      _ = (Nat.totient q : ℝ) * q := by ring
  nlinarith [Real.sq_sqrt (Nat.cast_nonneg q),
    norm_nonneg (gaussSum χ ZMod.stdAddChar), Real.sqrt_nonneg (q : ℝ)]

theorem primitive_fourier_expansion {q : ℕ} [NeZero q]
    (χ : DirichletCharacter ℂ q) (hχ : χ.IsPrimitive) (n : ZMod q) :
    (∑ a : ZMod q, χ⁻¹ a * ZMod.stdAddChar (a * n)) =
      χ n * gaussSum χ⁻¹ ZMod.stdAddChar := by
  have hχinv : χ⁻¹.IsPrimitive := by
    rw [DirichletCharacter.IsPrimitive, DirichletCharacter.conductor_inv]
    exact hχ
  have hfourier := hχinv.fourierTransform_eq_inv_mul_gaussSum (-n)
  simpa only [ZMod.dft_apply, smul_eq_mul, mul_neg, neg_neg, inv_inv,
    mul_comm] using hfourier

theorem primitive_fourier_expansion_div {q : ℕ} [NeZero q]
    (χ : DirichletCharacter ℂ q) (hχ : χ.IsPrimitive) (n : ZMod q) :
    χ n = (∑ a : ZMod q, χ⁻¹ a * ZMod.stdAddChar (a * n)) /
      gaussSum χ⁻¹ ZMod.stdAddChar := by
  have hχinv : χ⁻¹.IsPrimitive := by
    rw [DirichletCharacter.IsPrimitive, DirichletCharacter.conductor_inv]
    exact hχ
  have hnorm := norm_gaussSum_stdAddChar_of_isPrimitive χ⁻¹ hχinv
  have hgauss : gaussSum χ⁻¹ ZMod.stdAddChar ≠ 0 := by
    intro hz
    rw [hz, norm_zero] at hnorm
    have hqpos : (0 : ℝ) < q := by
      exact_mod_cast Nat.pos_of_ne_zero (NeZero.ne q)
    nlinarith [Real.sqrt_pos.2 hqpos]
  rw [primitive_fourier_expansion χ hχ n,
    mul_div_cancel_right₀ _ hgauss]

end

section
open Complex

section PrimitiveFunctionalEquation
theorem gammaFactor_inv_one_sub_ne_zero
    {q : ℕ} (chi : DirichletCharacter ℂ q) {s : ℂ}
    (hs : s.re ≤ (1 / 2 : ℝ)) :
    DirichletCharacter.gammaFactor chi⁻¹ (1 - s) ≠ 0 := by
  rcases chi⁻¹.even_or_odd with heven | hodd
  · rw [heven.gammaFactor_def]
    exact Complex.Gammaℝ_ne_zero_of_re_pos (by simp; linarith)
  · rw [hodd.gammaFactor_def]
    exact Complex.Gammaℝ_ne_zero_of_re_pos (by simp; linarith)

end PrimitiveFunctionalEquation

theorem norm_rootNumber_of_isPrimitive
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive) :
    ‖DirichletCharacter.rootNumber chi‖ = 1 := by
  have hq0 : q ≠ 0 := NeZero.ne q
  have hqpos : 0 < q := Nat.pos_of_ne_zero hq0
  rw [DirichletCharacter.rootNumber, norm_div, norm_div,
    norm_gaussSum_stdAddChar_of_isPrimitive chi hchi, norm_pow,
    Complex.norm_I, one_pow, div_one,
    Complex.norm_natCast_cpow_of_pos hqpos]
  simp [Real.sqrt_eq_rpow, hq0]

theorem LFunction_eq_functionalEquation_of_isPrimitive
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    (s : ℂ) (hs : s.re ≤ (1 / 2 : ℝ)) :
    DirichletCharacter.LFunction chi s =
      (q : ℂ) ^ ((1 / 2 : ℂ) - s) *
        DirichletCharacter.rootNumber chi *
        DirichletCharacter.LFunction chi⁻¹ (1 - s) *
        (DirichletCharacter.gammaFactor chi⁻¹ (1 - s) /
          DirichletCharacter.gammaFactor chi s) := by
  have hqne : q ≠ 1 := Nat.ne_of_gt hq
  have hcompleted :
      DirichletCharacter.completedLFunction chi s =
        (q : ℂ) ^ ((1 / 2 : ℂ) - s) *
          DirichletCharacter.rootNumber chi *
          DirichletCharacter.completedLFunction chi⁻¹ (1 - s) := by
    convert hchi.completedLFunction_one_sub (1 - s) using 1 <;> ring_nf
  have hgamma := gammaFactor_inv_one_sub_ne_zero chi hs
  have hreflected :
      DirichletCharacter.completedLFunction chi⁻¹ (1 - s) =
        DirichletCharacter.LFunction chi⁻¹ (1 - s) *
          DirichletCharacter.gammaFactor chi⁻¹ (1 - s) := by
    symm
    exact (eq_div_iff hgamma).mp
      (DirichletCharacter.LFunction_eq_completed_div_gammaFactor chi⁻¹
        (1 - s) (.inr hqne))
  rw [DirichletCharacter.LFunction_eq_completed_div_gammaFactor chi s (.inr hqne),
    hcompleted, hreflected]
  ring

theorem norm_LFunction_eq_functionalEquation_of_isPrimitive
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    (s : ℂ) (hs : s.re ≤ (1 / 2 : ℝ)) :
    ‖DirichletCharacter.LFunction chi s‖ =
      (q : ℝ) ^ ((1 : ℝ) / 2 - s.re) *
        ‖DirichletCharacter.LFunction chi⁻¹ (1 - s)‖ *
        ‖DirichletCharacter.gammaFactor chi⁻¹ (1 - s) /
          DirichletCharacter.gammaFactor chi s‖ := by
  rw [LFunction_eq_functionalEquation_of_isPrimitive hq chi hchi s hs,
    norm_mul, norm_mul, norm_mul, norm_rootNumber_of_isPrimitive chi hchi,
    Complex.norm_natCast_cpow_of_pos (Nat.zero_lt_of_lt hq)]
  norm_num

end

section
open Complex

section DirichletExplicitFormulaVerticalEdges
attribute [local instance] inducingEulerProductConductorNeZero

end DirichletExplicitFormulaVerticalEdges
end

section
open Complex

attribute [local instance] inducingEulerProductConductorNeZero

section DirichletExplicitFormulaVerticalEdges
theorem gammaFactor_ne_zero_of_re_eq_neg_nat_sub_half
    {q : ℕ} (chi : DirichletCharacter ℂ q)
    (N : ℕ) {s : ℂ} (hs : s.re = -(N : ℝ) - 1 / 2) :
    DirichletCharacter.gammaFactor chi s ≠ 0 := by
  rcases chi.even_or_odd with heven | hodd
  · rw [heven.gammaFactor_def, ne_eq, Gammaℝ_eq_zero_iff, not_exists]
    intro n hn
    have hre := congrArg Complex.re hn
    norm_num at hre
    rw [hs] at hre
    have hnat : 2 * N + 1 = 4 * n := by
      exact_mod_cast (by linarith : (2 : ℝ) * N + 1 = 4 * n)
    omega
  · rw [hodd.gammaFactor_def, ne_eq, Gammaℝ_eq_zero_iff, not_exists]
    intro n hn
    have hre := congrArg Complex.re hn
    norm_num at hre
    rw [hs] at hre
    have hnat : 2 * N = 4 * n + 1 := by
      exact_mod_cast (by linarith : (2 : ℝ) * N = 4 * n + 1)
    omega

theorem gammaFactor_ne_zero_of_re_pos
    {q : ℕ} (chi : DirichletCharacter ℂ q)
    {s : ℂ} (hs : 0 < s.re) :
    DirichletCharacter.gammaFactor chi s ≠ 0 := by
  rcases chi.even_or_odd with heven | hodd
  · rw [heven.gammaFactor_def]
    exact Gammaℝ_ne_zero_of_re_pos hs
  · rw [hodd.gammaFactor_def]
    exact Gammaℝ_ne_zero_of_re_pos (by simp; linarith)

theorem primitive_LFunction_ne_zero_of_re_eq_neg_nat_sub_half
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    (N : ℕ) {s : ℂ} (hs : s.re = -(N : ℝ) - 1 / 2) :
    DirichletCharacter.LFunction chi s ≠ 0 := by
  have hs0 : s ≠ 0 := by
    intro h
    have hre := congrArg Complex.re h
    simp only [zero_re] at hre
    rw [hs] at hre
    have hN : (0 : ℝ) ≤ N := Nat.cast_nonneg N
    linarith
  have hs1 : s ≠ 1 := by
    intro h
    have hre := congrArg Complex.re h
    simp only [one_re] at hre
    rw [hs] at hre
    have hN : (0 : ℝ) ≤ N := Nat.cast_nonneg N
    linarith
  have hreflected0 : 1 - s ≠ 0 :=
    sub_ne_zero.mpr (Ne.symm hs1)
  have hreflected1 : 1 - s ≠ 1 := by
    intro h
    apply hs0
    linear_combination -h
  have hgamma : DirichletCharacter.gammaFactor chi s ≠ 0 :=
    gammaFactor_ne_zero_of_re_eq_neg_nat_sub_half chi N hs
  have hgammaReflected :
      DirichletCharacter.gammaFactor chi⁻¹ (1 - s) ≠ 0 :=
    gammaFactor_ne_zero_of_re_pos chi⁻¹ (by
      simp only [sub_re, one_re]
      rw [hs]
      have hN : (0 : ℝ) ≤ N := Nat.cast_nonneg N
      linarith)
  have hreflectedL :
      DirichletCharacter.LFunction chi⁻¹ (1 - s) ≠ 0 :=
    (chi⁻¹).LFunction_ne_zero_of_one_le_re (.inr hreflected1) (by
      simp only [sub_re, one_re]
      rw [hs]
      have hN : (0 : ℝ) ≤ N := Nat.cast_nonneg N
      linarith)
  have hreflectedCompleted :
      DirichletCharacter.completedLFunction chi⁻¹ (1 - s) ≠ 0 := by
    have heq :
        DirichletCharacter.completedLFunction chi⁻¹ (1 - s) =
          DirichletCharacter.LFunction chi⁻¹ (1 - s) *
            DirichletCharacter.gammaFactor chi⁻¹ (1 - s) := by
      symm
      exact (eq_div_iff hgammaReflected).mp
        (DirichletCharacter.LFunction_eq_completed_div_gammaFactor chi⁻¹
          (1 - s) (.inl hreflected0))
    rw [heq]
    exact mul_ne_zero hreflectedL hgammaReflected
  have hbase : (q : ℂ) ^ ((1 - s) - 1 / 2) ≠ 0 :=
    Complex.cpow_ne_zero_iff.mpr
      (.inl (Nat.cast_ne_zero.mpr (NeZero.ne q)))
  have hroot : DirichletCharacter.rootNumber chi ≠ 0 := by
    apply norm_ne_zero_iff.mp
    rw [norm_rootNumber_of_isPrimitive chi hchi]
    exact one_ne_zero
  have hcompleted :
      DirichletCharacter.completedLFunction chi s ≠ 0 := by
    have hfun := hchi.completedLFunction_one_sub (1 - s)
    rw [show 1 - (1 - s) = s by ring] at hfun
    rw [hfun]
    exact mul_ne_zero (mul_ne_zero hbase hroot) hreflectedCompleted
  rw [DirichletCharacter.LFunction_eq_completed_div_gammaFactor chi s
    (.inl hs0)]
  exact div_ne_zero hcompleted hgamma

theorem LFunction_ne_zero_of_re_eq_neg_nat_sub_half
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (N : ℕ)
    {s : ℂ} (hs : s.re = -(N : ℝ) - 1 / 2) :
    DirichletCharacter.LFunction chi s ≠ 0 := by
  have hs1 : s ≠ 1 := by
    intro h
    have hre := congrArg Complex.re h
    simp only [one_re] at hre
    rw [hs] at hre
    have hN : (0 : ℝ) ≤ N := Nat.cast_nonneg N
    linarith
  rw [LFunction_eq_inducingPrimitive_mul_inducingEulerProduct chi (.inr hs1)]
  apply mul_ne_zero
  · exact primitive_LFunction_ne_zero_of_re_eq_neg_nat_sub_half
      chi.primitiveCharacter chi.primitiveCharacter_isPrimitive N hs
  · intro hproduct
    have hre := re_eq_zero_of_inducingEulerProduct_eq_zero chi hproduct
    rw [hs] at hre
    have hN : (0 : ℝ) ≤ N := Nat.cast_nonneg N
    linarith

end DirichletExplicitFormulaVerticalEdges
end

section
open Complex

attribute [local instance] inducingEulerProductConductorNeZero
theorem LFunction_ne_zero_on_dirichletExplicitFormulaVerticalEdges
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    (x : ℝ) (hx : 1 < x) (N : ℕ) (t : ℝ) :
    DirichletCharacter.LFunction chi
        (((-(N : ℝ) - 1 / 2 : ℝ) : ℂ) + t * I) ≠ 0 ∧
      DirichletCharacter.LFunction chi
        (((1 + 1 / Real.log x : ℝ) : ℂ) + t * I) ≠ 0 := by
  constructor
  · apply LFunction_ne_zero_of_re_eq_neg_nat_sub_half chi N
    simp
  · have hsre :
        ((((1 + 1 / Real.log x : ℝ) : ℂ) + t * I)).re =
          1 + 1 / Real.log x := by
      simp
    have hlog : 0 < Real.log x := Real.log_pos hx
    have hsreGt :
        1 < ((((1 + 1 / Real.log x : ℝ) : ℂ) + t * I)).re := by
      rw [hsre]
      linarith [one_div_pos.mpr hlog]
    apply chi.LFunction_ne_zero_of_one_le_re
    · refine .inr ?_
      intro hs
      have hre := congrArg Complex.re hs
      simp only [one_re] at hre
      exact (ne_of_gt hsreGt) hre
    · exact hsreGt.le

end

section
open Complex LSeries
open scoped LSeries.notation ArithmeticFunction.Moebius

section FarRightLFunctionCenter
theorem norm_character_mul_moebius_le_one
    {q : ℕ} (chi : DirichletCharacter ℂ q) (n : ℕ) :
    ‖chi n * (ArithmeticFunction.moebius n : ℂ)‖ ≤ 1 := by
  rw [norm_mul]
  calc
    ‖chi n‖ * ‖(ArithmeticFunction.moebius n : ℂ)‖
        ≤ 1 * ‖(ArithmeticFunction.moebius n : ℂ)‖ :=
      mul_le_mul_of_nonneg_right (chi.norm_le_one n) (norm_nonneg _)
    _ ≤ 1 * 1 := by
      gcongr
      exact_mod_cast ArithmeticFunction.abs_moebius_le_one
    _ = 1 := one_mul 1

theorem norm_character_moebius_LSeries_le_eight_thirds
    {q : ℕ} (chi : DirichletCharacter ℂ q) (t : ℝ) :
    ‖L (fun n => chi n * (ArithmeticFunction.moebius n : ℂ))
        (2 + I * t)‖ ≤ (8 : ℝ) / 3 := by
  let s : ℂ := 2 + I * t
  let a : ℕ → ℂ := fun n => chi n * (ArithmeticFunction.moebius n : ℂ)
  have hs : s.re = 2 := by simp [s]
  have ha : LSeriesSummable a s := by
    apply LSeriesSummable_of_bounded_of_one_lt_re (m := 1)
    · intro n _
      exact norm_character_mul_moebius_le_one chi n
    · simp [hs]
  calc
    ‖L a s‖ ≤ ∑' n, ‖term a s n‖ := norm_tsum_le_tsum_norm ha.norm
    _ ≤ ∑' n : ℕ, 1 / (n : ℝ) ^ 2 := by
      apply Summable.tsum_le_tsum
      · intro n
        rw [norm_term_eq, hs]
        split_ifs with hn
        · simp [hn]
        · change ‖a n‖ / (n : ℝ) ^ (2 : ℝ) ≤ 1 / (n : ℝ) ^ 2
          rw [Real.rpow_two]
          exact div_le_div_of_nonneg_right
            (by simpa [a] using norm_character_mul_moebius_le_one chi n)
            (sq_nonneg (n : ℝ))
      · exact ha.norm
      · exact hasSum_zeta_two.summable
    _ = Real.pi ^ 2 / 6 := hasSum_zeta_two.tsum_eq
    _ ≤ (8 : ℝ) / 3 := by nlinarith [Real.pi_le_four, Real.pi_pos]

end FarRightLFunctionCenter

theorem norm_inv_LFunction_two_add_mul_I_le_three
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q) (t : ℝ) :
    ‖(DirichletCharacter.LFunction chi ((2 : ℂ) + t * I))⁻¹‖ ≤ 3 := by
  let s : ℂ := 2 + t * I
  let a : ℕ → ℂ := fun n => chi n * (ArithmeticFunction.moebius n : ℂ)
  have hs : 1 < s.re := by simp [s]
  have hprod : L (chi ·) s * L a s = 1 := by
    have ha_fun : a = (fun n : ℕ => chi n) *
        (fun n : ℕ => (ArithmeticFunction.moebius n : ℂ)) := by
      funext n
      rfl
    rw [ha_fun]
    exact DirichletCharacter.LSeries.mul_mu_eq_one chi hs
  rw [DirichletCharacter.LFunction_eq_LSeries chi hs,
    inv_eq_of_mul_eq_one_right hprod]
  have ha : ‖L a s‖ ≤ (8 : ℝ) / 3 := by
    simpa [a, s, mul_comm] using
      norm_character_moebius_LSeries_le_eight_thirds chi t
  exact ha.trans (by norm_num)

end

section
open Asymptotics Complex _root_.Filter Asymptotics.Filter Set
open scoped Real

section DirichletLFunctionAbelContinuation
/--
The character prefix sum through `⌊y⌋₊` on `y > 1`, extended by zero to `y ≤ 1`, for the
Abel-integral continuation formula.
-/
noncomputable def characterPrefixTail
    {q : ℕ} (chi : DirichletCharacter ℂ q) (y : ℝ) : ℂ :=
  (Ioi (1 : ℝ)).indicator
    (fun u ↦ ∑ k ∈ Finset.Icc 1 ⌊u⌋₊, chi (k : ZMod q)) y

theorem measurable_characterPrefixTail
    {q : ℕ} (chi : DirichletCharacter ℂ q) :
    Measurable (characterPrefixTail chi) := by
  apply Measurable.indicator _ measurableSet_Ioi
  exact
    (measurable_of_countable
      (fun n : ℕ ↦ ∑ k ∈ Finset.Icc 1 n, chi (k : ZMod q))).comp
      Nat.measurable_floor

theorem norm_characterPrefixTail_le
    {q : ℕ} (chi : DirichletCharacter ℂ q) (C : ℝ) (hC : 0 ≤ C)
    (hprefix : ∀ n : ℕ,
      ‖∑ k ∈ Finset.Icc 1 n, chi (k : ZMod q)‖ ≤ C)
    (y : ℝ) :
    ‖characterPrefixTail chi y‖ ≤ C := by
  by_cases hy : y ∈ Ioi (1 : ℝ)
  · rw [characterPrefixTail, indicator_of_mem hy]
    exact hprefix ⌊y⌋₊
  · rw [characterPrefixTail, indicator_of_notMem hy, norm_zero]
    exact hC

theorem locallyIntegrable_characterPrefixTail
    {q : ℕ} (chi : DirichletCharacter ℂ q) (C : ℝ) (hC : 0 ≤ C)
    (hprefix : ∀ n : ℕ,
      ‖∑ k ∈ Finset.Icc 1 n, chi (k : ZMod q)‖ ≤ C) :
    LocallyIntegrableOn (characterPrefixTail chi) (Ioi 0) := by
  have hnormScale : ‖((C : ℝ) : ℂ)‖ = C := by
    rw [norm_real, Real.norm_eq_abs, abs_of_nonneg hC]
  refine ((locallyIntegrable_const ((C : ℝ) : ℂ)).locallyIntegrableOn
      (Ioi 0)).mono
      (measurable_characterPrefixTail chi).aestronglyMeasurable ?_
  filter_upwards with y
  rw [hnormScale]
  exact norm_characterPrefixTail_le chi C hC hprefix y

theorem characterPrefixTail_isBigO_atTop
    {q : ℕ} (chi : DirichletCharacter ℂ q) (C : ℝ) (hC : 0 ≤ C)
    (hprefix : ∀ n : ℕ,
      ‖∑ k ∈ Finset.Icc 1 n, chi (k : ZMod q)‖ ≤ C) :
    characterPrefixTail chi =O[atTop] (fun y : ℝ ↦ y ^ (-(0 : ℝ))) := by
  refine isBigO_iff.mpr ⟨C, Eventually.of_forall fun y ↦ ?_⟩
  simpa using norm_characterPrefixTail_le chi C hC hprefix y

theorem characterPrefixTail_isBigO_nhdsGT_zero
    {q : ℕ} (chi : DirichletCharacter ℂ q) (b : ℝ) :
    characterPrefixTail chi =O[𝓝[>] 0] (fun y : ℝ ↦ y ^ (-b)) := by
  have hlt : ∀ᶠ y : ℝ in 𝓝[>] 0, y < 1 :=
    Filter.Eventually.filter_mono nhdsWithin_le_nhds (Iio_mem_nhds zero_lt_one)
  refine isBigO_iff.mpr ⟨1, ?_⟩
  filter_upwards [hlt] with y hy
  simp [characterPrefixTail, not_lt.mpr hy.le]

theorem differentiableAt_characterPrefixMellin_neg
    {q : ℕ} (chi : DirichletCharacter ℂ q) (C : ℝ) (hC : 0 ≤ C)
    (hprefix : ∀ n : ℕ,
      ‖∑ k ∈ Finset.Icc 1 n, chi (k : ZMod q)‖ ≤ C)
    {s : ℂ} (hs : 0 < s.re) :
    DifferentiableAt ℂ (fun w ↦ mellin (characterPrefixTail chi) (-w)) s := by
  have hm : DifferentiableAt ℂ (mellin (characterPrefixTail chi)) (-s) := by
    refine mellin_differentiableAt_of_isBigO_rpow
      (a := 0) (b := (-s).re - 1)
      (locallyIntegrable_characterPrefixTail chi C hC hprefix)
      (characterPrefixTail_isBigO_atTop chi C hC hprefix) ?_
      (characterPrefixTail_isBigO_nhdsGT_zero chi ((-s).re - 1)) ?_
    · simpa using (neg_lt_zero.mpr hs)
    · linarith
  exact hm.comp s differentiableAt_id.neg

theorem characterPrefixMellin_neg_eq_integral
    {q : ℕ} (chi : DirichletCharacter ℂ q) (s : ℂ) :
    mellin (characterPrefixTail chi) (-s) =
      ∫ y in Ioi (1 : ℝ),
        (∑ k ∈ Finset.Icc 1 ⌊y⌋₊, chi (k : ZMod q)) *
          (y : ℂ) ^ (-(s + 1)) := by
  rw [mellin]
  simp only [smul_eq_mul]
  calc
    (∫ y : ℝ in Ioi 0,
        (y : ℂ) ^ (-s - 1) * characterPrefixTail chi y) =
        ∫ y : ℝ in Ioi 0, (Ioi (1 : ℝ)).indicator
          (fun u ↦ (u : ℂ) ^ (-s - 1) *
            ∑ k ∈ Finset.Icc 1 ⌊u⌋₊, chi (k : ZMod q)) y := by
      refine setIntegral_congr_fun measurableSet_Ioi fun y _ ↦ ?_
      by_cases hy : y ∈ Ioi (1 : ℝ)
      · simp [characterPrefixTail, hy]
      · simp [characterPrefixTail, hy]
    _ = ∫ y : ℝ in Ioi 0 ∩ Ioi 1,
        (y : ℂ) ^ (-s - 1) *
          (∑ k ∈ Finset.Icc 1 ⌊y⌋₊, chi (k : ZMod q)) := by
      rw [setIntegral_indicator measurableSet_Ioi]
    _ = ∫ y : ℝ in Ioi 1,
        (y : ℂ) ^ (-s - 1) *
          (∑ k ∈ Finset.Icc 1 ⌊y⌋₊, chi (k : ZMod q)) := by
      rw [Ioi_inter_Ioi, max_eq_right zero_le_one]
    _ = ∫ y : ℝ in Ioi 1,
        (∑ k ∈ Finset.Icc 1 ⌊y⌋₊, chi (k : ZMod q)) *
          (y : ℂ) ^ (-(s + 1)) := by
      refine setIntegral_congr_fun measurableSet_Ioi fun y _ ↦ ?_
      rw [show -s - 1 = -(s + 1) by ring, mul_comm]

theorem characterPartialSums_isBigO_atTop
    {q : ℕ} (chi : DirichletCharacter ℂ q) (C : ℝ)
    (hprefix : ∀ n : ℕ,
      ‖∑ k ∈ Finset.Icc 1 n, chi (k : ZMod q)‖ ≤ C) :
    (fun n : ℕ ↦ ∑ k ∈ Finset.Icc 1 n, chi (k : ZMod q)) =O[atTop]
      (fun n : ℕ ↦ (n : ℝ) ^ (0 : ℝ)) := by
  refine isBigO_iff.mpr ⟨C, Eventually.of_forall fun n ↦ ?_⟩
  simpa using hprefix n

theorem LFunction_eq_characterPrefixMellin_of_one_lt_re
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (C : ℝ)
    (hprefix : ∀ n : ℕ,
      ‖∑ k ∈ Finset.Icc 1 n, chi (k : ZMod q)‖ ≤ C)
    {s : ℂ} (hs : 1 < s.re) :
    DirichletCharacter.LFunction chi s =
      s * mellin (characterPrefixTail chi) (-s) := by
  calc
    DirichletCharacter.LFunction chi s = LSeries (chi ·) s :=
      DirichletCharacter.LFunction_eq_LSeries chi hs
    _ = s * ∫ y in Ioi (1 : ℝ),
        (∑ k ∈ Finset.Icc 1 ⌊y⌋₊, chi (k : ZMod q)) *
          (y : ℂ) ^ (-(s + 1)) :=
      LSeries_eq_mul_integral (chi ·) (r := 0) le_rfl (zero_lt_one.trans hs)
        (DirichletCharacter.LSeriesSummable_of_one_lt_re chi hs)
        (characterPartialSums_isBigO_atTop chi C hprefix)
    _ = s * mellin (characterPrefixTail chi) (-s) := by
      rw [characterPrefixMellin_neg_eq_integral]

end DirichletLFunctionAbelContinuation

theorem LFunction_eq_abelIntegral_of_prefixBound
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (hchi : chi ≠ 1)
    (C : ℝ)
    (hprefix : ∀ n : ℕ,
      ‖∑ k ∈ Finset.Icc 1 n, chi (k : ZMod q)‖ ≤ C)
    (s : ℂ) (hs : 0 < s.re) :
    DirichletCharacter.LFunction chi s =
      s * ∫ y in Set.Ioi (1 : ℝ),
        (∑ k ∈ Finset.Icc 1 ⌊y⌋₊, chi (k : ZMod q)) *
          (y : ℂ) ^ (-(s + 1)) := by
  have hC : 0 ≤ C := by
    simpa using hprefix 0
  let U : Set ℂ := {w | 0 < w.re}
  have hUOpen : IsOpen U := isOpen_lt continuous_const continuous_re
  have hUPre : IsPreconnected U := (convex_halfSpace_re_gt 0).isPreconnected
  have hLeft :
      AnalyticOnNhd ℂ (DirichletCharacter.LFunction chi) U :=
    (DirichletCharacter.differentiable_LFunction hchi).differentiableOn.analyticOnNhd hUOpen
  have hRight : AnalyticOnNhd ℂ
      (fun w ↦ w * mellin (characterPrefixTail chi) (-w)) U := by
    refine DifferentiableOn.analyticOnNhd (fun w hw ↦ ?_) hUOpen
    exact (differentiableAt_id.mul
      (differentiableAt_characterPrefixMellin_neg chi C hC hprefix hw)).differentiableWithinAt
  have hEq : EqOn (DirichletCharacter.LFunction chi)
      (fun w ↦ w * mellin (characterPrefixTail chi) (-w)) U := by
    refine hLeft.eqOn_of_preconnected_of_eventuallyEq hRight hUPre
      (show (2 : ℂ) ∈ U by simp [U]) ?_
    refine eventually_of_mem
      ((isOpen_lt continuous_const continuous_re).mem_nhds
        (show 1 < (2 : ℂ).re by norm_num)) ?_
    intro w hw
    exact LFunction_eq_characterPrefixMellin_of_one_lt_re chi C hprefix hw
  rw [hEq hs]
  change s * mellin (characterPrefixTail chi) (-s) = _
  rw [characterPrefixMellin_neg_eq_integral]

end

section
open Finset

section StandardAddCharInterval
theorem sum_Ioc_int_eq_sum_range_add_succ
    {A : Type*} [AddCommMonoid A] (f : ℤ → A) (M : ℤ) (N : ℕ) :
    (∑ m ∈ Finset.Ioc M (M + (N : ℤ)), f m) =
      ∑ n ∈ Finset.range N, f (M + (n + 1 : ℕ)) := by
  rw [Int.Ioc_eq_finset_map, Finset.sum_map]
  simp only [Function.Embedding.trans_apply, Nat.castEmbedding_apply,
    addLeftEmbedding_apply]
  congr 1
  · simp
  · funext n
    congr 1
    push_cast
    ring

theorem stdAddChar_mul_int_add_succ {q : ℕ} [NeZero q]
    (a : ZMod q) (M : ℤ) (n : ℕ) :
    ZMod.stdAddChar (a * ((M + ((n + 1 : ℕ) : ℤ) : ℤ) : ZMod q)) =
      ZMod.stdAddChar (a * ((M + 1 : ℤ) : ZMod q)) *
        ZMod.stdAddChar a ^ n := by
  rw [← AddChar.map_nsmul_eq_pow, ← AddChar.map_add_eq_mul]
  congr 1
  push_cast
  simp only [nsmul_eq_mul]
  ring

theorem stdAddChar_ne_one_of_ne_zero
    {q : ℕ} [NeZero q] {a : ZMod q} (ha : a ≠ 0) :
    ZMod.stdAddChar a ≠ 1 := by
  simpa only [AddChar.map_zero_eq_one] using ZMod.injective_stdAddChar.ne ha

theorem norm_stdAddChar_sub_one_eq_two_mul_abs_sin
    {q : ℕ} [NeZero q] (a : ZMod q) :
    ‖ZMod.stdAddChar a - 1‖ =
      2 * |Real.sin (Real.pi * (a.val : ℝ) / (q : ℝ))| := by
  rw [← ZMod.natCast_zmod_val a]
  rw [show (a.val : ZMod q) = ((a.val : ℤ) : ZMod q) by simp,
    ZMod.stdAddChar_coe]
  simp only [Int.cast_natCast]
  rw [show 2 * (Real.pi : ℂ) * Complex.I * (a.val : ℂ) / (q : ℂ) =
      Complex.I * ((2 * Real.pi * (a.val : ℝ) / (q : ℝ) : ℝ) : ℂ) by
        push_cast
        ring]
  rw [Complex.norm_exp_I_mul_ofReal_sub_one]
  simp only [show (2 * Real.pi * (a.val : ℝ) / (q : ℝ)) / 2 =
    Real.pi * (a.val : ℝ) / (q : ℝ) by ring]
  rw [Real.norm_eq_abs, abs_mul]
  norm_num

end StandardAddCharInterval

theorem sum_stdAddChar_Ioc_eq_geometric
    {q : ℕ} [NeZero q] {a : ZMod q} (ha : a ≠ 0)
    (M : ℤ) (N : ℕ) :
    (∑ n ∈ Finset.Ioc M (M + (N : ℤ)),
      ZMod.stdAddChar (a * (n : ZMod q))) =
      ZMod.stdAddChar (a * ((M + 1 : ℤ) : ZMod q)) *
        ((1 - ZMod.stdAddChar (a * (N : ZMod q))) /
          (1 - ZMod.stdAddChar a)) := by
  rw [sum_Ioc_int_eq_sum_range_add_succ]
  simp_rw [stdAddChar_mul_int_add_succ]
  rw [← Finset.mul_sum, geom_sum_eq (stdAddChar_ne_one_of_ne_zero ha)]
  have hpow : ZMod.stdAddChar (a * (N : ZMod q)) =
      ZMod.stdAddChar a ^ N := by
    rw [show a * (N : ZMod q) = N • a by ring,
      AddChar.map_nsmul_eq_pow]
  rw [hpow]
  congr 1
  rw [div_eq_mul_inv, div_eq_mul_inv,
    show ZMod.stdAddChar a - 1 = -(1 - ZMod.stdAddChar a) by ring,
    inv_neg]
  ring

theorem norm_sum_stdAddChar_Ioc_le_inv_sin
    {q : ℕ} [NeZero q] {a : ZMod q} (ha : a ≠ 0)
    (M : ℤ) (N : ℕ) :
    ‖∑ n ∈ Finset.Ioc M (M + (N : ℤ)),
      ZMod.stdAddChar (a * (n : ZMod q))‖ ≤
      (Real.sin (Real.pi * (a.val : ℝ) / (q : ℝ)))⁻¹ := by
  have hqpos : (0 : ℝ) < q := by
    exact_mod_cast Nat.pos_of_ne_zero (NeZero.ne q)
  have havalpos : (0 : ℝ) < a.val := by
    exact_mod_cast Nat.pos_of_ne_zero ((ZMod.val_ne_zero a).mpr ha)
  have hanglepos : 0 < Real.pi * (a.val : ℝ) / (q : ℝ) :=
    div_pos (mul_pos Real.pi_pos havalpos) hqpos
  have hanglelt : Real.pi * (a.val : ℝ) / (q : ℝ) < Real.pi := by
    rw [div_lt_iff₀ hqpos]
    have havallt : (a.val : ℝ) < q := by exact_mod_cast a.val_lt
    nlinarith [Real.pi_pos]
  have hsin : 0 < Real.sin (Real.pi * (a.val : ℝ) / (q : ℝ)) :=
    Real.sin_pos_of_pos_of_lt_pi hanglepos hanglelt
  have hnum : ‖1 - ZMod.stdAddChar (a * (N : ZMod q))‖ ≤ 2 := by
    calc
      _ ≤ ‖(1 : ℂ)‖ + ‖ZMod.stdAddChar (a * (N : ZMod q))‖ :=
        norm_sub_le _ _
      _ = 2 := by rw [AddChar.norm_apply]; norm_num
  have hdenom : ‖1 - ZMod.stdAddChar a‖ =
      2 * Real.sin (Real.pi * (a.val : ℝ) / (q : ℝ)) := by
    rw [show (1 : ℂ) - ZMod.stdAddChar a =
      -(ZMod.stdAddChar a - 1) by ring, norm_neg,
      norm_stdAddChar_sub_one_eq_two_mul_abs_sin,
      abs_of_pos hsin]
  rw [sum_stdAddChar_Ioc_eq_geometric ha, norm_mul,
    AddChar.norm_apply, one_mul, norm_div, hdenom]
  calc
    ‖1 - ZMod.stdAddChar (a * (N : ZMod q))‖ /
        (2 * Real.sin (Real.pi * (a.val : ℝ) / (q : ℝ))) ≤
        2 / (2 * Real.sin (Real.pi * (a.val : ℝ) / (q : ℝ))) :=
      div_le_div_of_nonneg_right hnum (by positivity)
    _ = (Real.sin (Real.pi * (a.val : ℝ) / (q : ℝ)))⁻¹ := by
      field_simp

section PrimitiveCharacterInterval
theorem sum_zmod_erase_zero_eq_sum_Ico_val
    {q : ℕ} [NeZero q]
    {A : Type*} [AddCommMonoid A] (f : ZMod q → A) :
    (∑ a ∈ Finset.univ.erase (0 : ZMod q), f a) =
      ∑ a ∈ Finset.Ico 1 q, f (a : ZMod q) := by
  classical
  apply Finset.sum_nbij (fun a : ZMod q => a.val)
  · intro a ha
    have ha0 : a ≠ 0 := (Finset.mem_erase.mp ha).1
    exact Finset.mem_Ico.mpr ⟨ZMod.val_pos.mpr ha0, a.val_lt⟩
  · exact (ZMod.val_injective q).injOn
  · intro b hb
    have hbmem := Finset.mem_Ico.mp hb
    refine ⟨(b : ZMod q), ?_, ?_⟩
    · apply Finset.mem_erase.mpr
      refine ⟨?_, Finset.mem_univ _⟩
      apply (ZMod.val_ne_zero _).mp
      rw [ZMod.val_cast_of_lt hbmem.2]
      exact Nat.ne_of_gt hbmem.1
    · exact ZMod.val_cast_of_lt hbmem.2
  · intro a ha
    rw [ZMod.natCast_zmod_val]

end PrimitiveCharacterInterval

theorem sum_dirichletCharacter_Ioc_eq_fourier
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    (hchi : chi.IsPrimitive) (M : ℤ) (N : ℕ) :
    (∑ n ∈ Finset.Ioc M (M + (N : ℤ)), chi (n : ZMod q)) =
      (∑ a : ZMod q, chi⁻¹ a *
        ∑ n ∈ Finset.Ioc M (M + (N : ℤ)),
          ZMod.stdAddChar (a * (n : ZMod q))) /
        gaussSum chi⁻¹ ZMod.stdAddChar := by
  classical
  have hpoint (n : ℤ) :
      chi (n : ZMod q) =
        (∑ a : ZMod q,
          chi⁻¹ a * ZMod.stdAddChar (a * (n : ZMod q))) /
          gaussSum chi⁻¹ ZMod.stdAddChar :=
    primitive_fourier_expansion_div chi hchi (n : ZMod q)
  calc
    (∑ n ∈ Finset.Ioc M (M + (N : ℤ)), chi (n : ZMod q)) =
        ∑ n ∈ Finset.Ioc M (M + (N : ℤ)),
          ((∑ a : ZMod q,
            chi⁻¹ a * ZMod.stdAddChar (a * (n : ZMod q))) /
            gaussSum chi⁻¹ ZMod.stdAddChar) := by
      apply Finset.sum_congr rfl
      intro n hn
      exact hpoint n
    _ = (∑ n ∈ Finset.Ioc M (M + (N : ℤ)),
          ∑ a : ZMod q,
            chi⁻¹ a * ZMod.stdAddChar (a * (n : ZMod q))) /
          gaussSum chi⁻¹ ZMod.stdAddChar := by
      rw [Finset.sum_div]
    _ = (∑ a : ZMod q, ∑ n ∈ Finset.Ioc M (M + (N : ℤ)),
          chi⁻¹ a * ZMod.stdAddChar (a * (n : ZMod q))) /
          gaussSum chi⁻¹ ZMod.stdAddChar := by
      congr 1
      rw [Finset.sum_comm]
    _ = (∑ a : ZMod q, chi⁻¹ a *
          ∑ n ∈ Finset.Ioc M (M + (N : ℤ)),
            ZMod.stdAddChar (a * (n : ZMod q))) /
          gaussSum chi⁻¹ ZMod.stdAddChar := by
      congr 1
      apply Finset.sum_congr rfl
      intro a ha
      rw [← Finset.mul_sum]

theorem sum_dirichletCharacter_Ioc_eq_fourier_erase_zero
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    (M : ℤ) (N : ℕ) :
    (∑ n ∈ Finset.Ioc M (M + (N : ℤ)), chi (n : ZMod q)) =
      (∑ a ∈ Finset.univ.erase (0 : ZMod q), chi⁻¹ a *
        ∑ n ∈ Finset.Ioc M (M + (N : ℤ)),
          ZMod.stdAddChar (a * (n : ZMod q))) /
        gaussSum chi⁻¹ ZMod.stdAddChar := by
  classical
  have hzero : chi⁻¹ (0 : ZMod q) = 0 :=
    DirichletCharacter.map_zero' chi⁻¹ (Nat.ne_of_gt hq)
  calc
    (∑ n ∈ Finset.Ioc M (M + (N : ℤ)), chi (n : ZMod q)) =
        (∑ a : ZMod q, chi⁻¹ a *
          ∑ n ∈ Finset.Ioc M (M + (N : ℤ)),
            ZMod.stdAddChar (a * (n : ZMod q))) /
          gaussSum chi⁻¹ ZMod.stdAddChar :=
      sum_dirichletCharacter_Ioc_eq_fourier chi hchi M N
    _ = (∑ a ∈ Finset.univ.erase (0 : ZMod q), chi⁻¹ a *
          ∑ n ∈ Finset.Ioc M (M + (N : ℤ)),
            ZMod.stdAddChar (a * (n : ZMod q))) /
          gaussSum chi⁻¹ ZMod.stdAddChar := by
      congr 1
      rw [← Finset.sum_erase_add _ _ (Finset.mem_univ (0 : ZMod q))]
      simp [hzero]

theorem sum_dirichletCharacter_Ioc_eq_nat_fourier
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    (M : ℤ) (N : ℕ) :
    (∑ n ∈ Finset.Ioc M (M + (N : ℤ)), chi (n : ZMod q)) =
      (∑ a ∈ Finset.Ico 1 q, chi⁻¹ (a : ZMod q) *
        ∑ n ∈ Finset.Ioc M (M + (N : ℤ)),
          ZMod.stdAddChar ((a : ZMod q) * (n : ZMod q))) /
        gaussSum chi⁻¹ ZMod.stdAddChar := by
  classical
  calc
    (∑ n ∈ Finset.Ioc M (M + (N : ℤ)), chi (n : ZMod q)) =
        (∑ a ∈ Finset.univ.erase (0 : ZMod q), chi⁻¹ a *
          ∑ n ∈ Finset.Ioc M (M + (N : ℤ)),
            ZMod.stdAddChar (a * (n : ZMod q))) /
          gaussSum chi⁻¹ ZMod.stdAddChar :=
      sum_dirichletCharacter_Ioc_eq_fourier_erase_zero hq chi hchi M N
    _ = (∑ a ∈ Finset.Ico 1 q, chi⁻¹ (a : ZMod q) *
          ∑ n ∈ Finset.Ioc M (M + (N : ℤ)),
            ZMod.stdAddChar ((a : ZMod q) * (n : ZMod q))) /
          gaussSum chi⁻¹ ZMod.stdAddChar := by
      congr 1
      exact sum_zmod_erase_zero_eq_sum_Ico_val
        (f := fun a : ZMod q => chi⁻¹ a *
          ∑ n ∈ Finset.Ioc M (M + (N : ℤ)),
            ZMod.stdAddChar (a * (n : ZMod q)))

theorem norm_sum_dirichletCharacter_Ioc_le_reciprocalSineSum
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    (M : ℤ) (N : ℕ) :
    ‖∑ n ∈ Finset.Ioc M (M + (N : ℤ)), chi (n : ZMod q)‖ ≤
      (∑ a ∈ Finset.Ico 1 q,
        (Real.sin (Real.pi * (a : ℝ) / (q : ℝ)))⁻¹) /
        Real.sqrt q := by
  classical
  have hchiInv : chi⁻¹.IsPrimitive := by
    rw [DirichletCharacter.IsPrimitive, DirichletCharacter.conductor_inv]
    exact hchi
  have hgaussNorm : ‖gaussSum chi⁻¹ ZMod.stdAddChar‖ = Real.sqrt q :=
    norm_gaussSum_stdAddChar_of_isPrimitive chi⁻¹ hchiInv
  have hnumerator :
      ‖∑ a ∈ Finset.Ico 1 q, chi⁻¹ (a : ZMod q) *
        ∑ n ∈ Finset.Ioc M (M + (N : ℤ)),
          ZMod.stdAddChar ((a : ZMod q) * (n : ZMod q))‖ ≤
        ∑ a ∈ Finset.Ico 1 q,
          (Real.sin (Real.pi * (a : ℝ) / (q : ℝ)))⁻¹ := by
    refine norm_sum_le_of_le _ fun a ha => ?_
    have haIco := Finset.mem_Ico.mp ha
    have ha0 : (a : ZMod q) ≠ 0 := by
      apply (ZMod.val_ne_zero (a : ZMod q)).mp
      rw [ZMod.val_cast_of_lt haIco.2]
      exact Nat.ne_of_gt haIco.1
    have hinterval := norm_sum_stdAddChar_Ioc_le_inv_sin
      (q := q) (a := (a : ZMod q)) ha0 M N
    rw [ZMod.val_cast_of_lt haIco.2] at hinterval
    rw [norm_mul]
    simpa only [one_mul] using
      mul_le_mul (DirichletCharacter.norm_le_one chi⁻¹ (a : ZMod q))
        hinterval (norm_nonneg _) zero_le_one
  rw [sum_dirichletCharacter_Ioc_eq_nat_fourier hq chi hchi M N,
    norm_div, hgaussNorm]
  exact div_le_div_of_nonneg_right hnumerator (Real.sqrt_nonneg q)

end

section
open Finset

section ReciprocalSineAggregate
theorem harmonic_cast_le_log_two_mul_add_one (n : ℕ) :
    (harmonic n : ℝ) ≤ Real.log (2 * (n : ℝ) + 1) := by
  induction n with
  | zero => norm_num
  | succ n ih =>
      rw [harmonic_succ]
      simp only [Rat.cast_add, Rat.cast_inv, Rat.cast_natCast, Nat.cast_succ]
      have hden : (0 : ℝ) < 2 * (n : ℝ) + 1 := by positivity
      have hlog := Real.le_log_one_add_of_nonneg
        (show (0 : ℝ) ≤ 2 / (2 * (n : ℝ) + 1) by positivity)
      have hincrement :
          ((n : ℝ) + 1)⁻¹ ≤
            Real.log (2 * ((n : ℝ) + 1) + 1) -
              Real.log (2 * (n : ℝ) + 1) := by
        rw [← Real.log_div (by positivity) hden.ne']
        convert hlog using 1 <;> field_simp <;> ring_nf
      linarith

theorem harmonic_cast_lt_log_two_mul_add_one {n : ℕ} (hn : 0 < n) :
    (harmonic n : ℝ) < Real.log (2 * (n : ℝ) + 1) := by
  obtain ⟨n, rfl⟩ := Nat.exists_eq_succ_of_ne_zero (Nat.ne_of_gt hn)
  rw [harmonic_succ]
  simp only [Rat.cast_add, Rat.cast_inv, Rat.cast_natCast, Nat.cast_succ]
  have hbase := harmonic_cast_le_log_two_mul_add_one n
  have hden : (0 : ℝ) < 2 * (n : ℝ) + 1 := by positivity
  have hlog := Real.lt_log_one_add_of_pos
    (show (0 : ℝ) < 2 / (2 * (n : ℝ) + 1) by positivity)
  have hincrement :
      ((n : ℝ) + 1)⁻¹ <
        Real.log (2 * ((n : ℝ) + 1) + 1) -
          Real.log (2 * (n : ℝ) + 1) := by
    rw [← Real.log_div (by positivity) hden.ne']
    convert hlog using 1 <;> field_simp <;> ring_nf
  linarith

theorem harmonic_cast_pred_add_inv_two_mul_lt_log_two_mul
    {m : ℕ} (hm : 0 < m) :
    (harmonic (m - 1) : ℝ) + (((2 * m : ℕ) : ℝ))⁻¹ <
      Real.log (((2 * m : ℕ) : ℝ)) := by
  obtain ⟨m, rfl⟩ := Nat.exists_eq_succ_of_ne_zero (Nat.ne_of_gt hm)
  simp only [Nat.succ_sub_one, Nat.cast_mul, Nat.cast_ofNat, Nat.cast_succ]
  have hbase := harmonic_cast_le_log_two_mul_add_one m
  have hden : (0 : ℝ) < 2 * (m : ℝ) + 1 := by positivity
  have hx : (0 : ℝ) < (2 * (m : ℝ) + 1)⁻¹ := by positivity
  have hlog := Real.lt_log_one_add_of_pos hx
  have hincrement :
      (2 * ((m : ℝ) + 1))⁻¹ <
        Real.log (2 * ((m : ℝ) + 1)) -
          Real.log (2 * (m : ℝ) + 1) := by
    rw [← Real.log_div (by positivity) hden.ne']
    calc
      (2 * ((m : ℝ) + 1))⁻¹ <
          2 * (2 * (m : ℝ) + 1)⁻¹ /
            ((2 * (m : ℝ) + 1)⁻¹ + 2) := by
        field_simp
        linarith
      _ < Real.log (1 + (2 * (m : ℝ) + 1)⁻¹) := hlog
      _ = Real.log (2 * ((m : ℝ) + 1) / (2 * (m : ℝ) + 1)) := by
        congr 1
        field_simp
        ring
  linarith

/--
The reciprocal sine `1 / sin (π * a / q)` appearing in the finite character-sum bound. Real
inversion is totalized at zero.
-/
noncomputable def reciprocalSineTerm (q a : ℕ) : ℝ :=
  (Real.sin (Real.pi * (a : ℝ) / (q : ℝ)))⁻¹

theorem reciprocalSineTerm_le_div {q a : ℕ} (hq : 0 < q)
    (ha : 0 < a) (haq : 2 * a ≤ q) :
    reciprocalSineTerm q a ≤ (q : ℝ) / (2 * (a : ℝ)) := by
  have hqR : (0 : ℝ) < q := by exact_mod_cast hq
  have haR : (0 : ℝ) < a := by exact_mod_cast ha
  have hangle0 : 0 ≤ Real.pi * (a : ℝ) / (q : ℝ) := by positivity
  have hanglehalf : Real.pi * (a : ℝ) / (q : ℝ) ≤ Real.pi / 2 := by
    rw [div_le_div_iff₀ hqR zero_lt_two]
    have haqR : (2 : ℝ) * (a : ℝ) ≤ q := by exact_mod_cast haq
    nlinarith [Real.pi_pos]
  have hjordan := Real.mul_le_sin hangle0 hanglehalf
  have hbase : 0 < 2 / Real.pi *
      (Real.pi * (a : ℝ) / (q : ℝ)) := by positivity
  have hinv := inv_anti₀ hbase hjordan
  calc
    reciprocalSineTerm q a =
        (Real.sin (Real.pi * (a : ℝ) / (q : ℝ)))⁻¹ := rfl
    _ ≤ (2 / Real.pi * (Real.pi * (a : ℝ) / (q : ℝ)))⁻¹ := hinv
    _ = (q : ℝ) / (2 * (a : ℝ)) := by field_simp

theorem reciprocalSineTerm_sub {q a : ℕ} (hq : 0 < q) (ha : a ≤ q) :
    reciprocalSineTerm q (q - a) = reciprocalSineTerm q a := by
  rw [reciprocalSineTerm, reciprocalSineTerm, Nat.cast_sub ha]
  have hqR : (q : ℝ) ≠ 0 := by exact_mod_cast (Nat.ne_of_gt hq)
  rw [show Real.pi * ((q : ℝ) - (a : ℝ)) / (q : ℝ) =
      Real.pi - Real.pi * (a : ℝ) / (q : ℝ) by field_simp,
    Real.sin_pi_sub]

theorem reciprocalSineTerm_two_mul_self {m : ℕ} (hm : 0 < m) :
    reciprocalSineTerm (2 * m) m = 1 := by
  rw [reciprocalSineTerm]
  have hmR : (m : ℝ) ≠ 0 := by exact_mod_cast (Nat.ne_of_gt hm)
  rw [show Real.pi * (m : ℝ) / ((2 * m : ℕ) : ℝ) = Real.pi / 2 by
      push_cast
      field_simp,
    Real.sin_pi_div_two, inv_one]

theorem sum_Ico_inv_eq_harmonic (n : ℕ) :
    (∑ a ∈ Finset.Ico 1 (n + 1), ((a : ℝ))⁻¹) = (harmonic n : ℝ) := by
  rw [Finset.Ico_add_one_right_eq_Icc]
  simp only [harmonic_eq_sum_Icc, Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast]

theorem sum_reciprocalSine_Ico_le_half_mul_harmonic
    {q m : ℕ} (hq : 0 < q) (hmq : 2 * m ≤ q) :
    (∑ a ∈ Finset.Ico 1 (m + 1), reciprocalSineTerm q a) ≤
      (q : ℝ) / 2 * (harmonic m : ℝ) := by
  calc
    (∑ a ∈ Finset.Ico 1 (m + 1), reciprocalSineTerm q a) ≤
        ∑ a ∈ Finset.Ico 1 (m + 1), (q : ℝ) / (2 * (a : ℝ)) := by
      apply Finset.sum_le_sum
      intro a ha
      exact reciprocalSineTerm_le_div hq (Finset.mem_Ico.mp ha).1
        ((Nat.mul_le_mul_left 2
          (Nat.le_of_lt_succ (Finset.mem_Ico.mp ha).2)).trans hmq)
    _ = (q : ℝ) / 2 *
        ∑ a ∈ Finset.Ico 1 (m + 1), ((a : ℝ))⁻¹ := by
      rw [Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro a ha
      field_simp
    _ = (q : ℝ) / 2 * (harmonic m : ℝ) := by
      rw [sum_Ico_inv_eq_harmonic]

theorem sum_reciprocalSine_odd_eq_two_mul (m : ℕ) :
    (∑ a ∈ Finset.Ico 1 (2 * m + 1), reciprocalSineTerm (2 * m + 1) a) =
      2 * ∑ a ∈ Finset.Ico 1 (m + 1), reciprocalSineTerm (2 * m + 1) a := by
  have hq : 0 < 2 * m + 1 := by omega
  have hreflect := Finset.sum_Ico_reflect
    (reciprocalSineTerm (2 * m + 1)) 1
    (m := m + 1) (n := 2 * m + 1) (by omega)
  have hb1 : 2 * m + 1 + 1 - (m + 1) = m + 1 := by omega
  have hb2 : 2 * m + 1 + 1 - 1 = 2 * m + 1 := by omega
  rw [hb1, hb2] at hreflect
  have hupper :
      (∑ a ∈ Finset.Ico (m + 1) (2 * m + 1),
        reciprocalSineTerm (2 * m + 1) a) =
        ∑ a ∈ Finset.Ico 1 (m + 1), reciprocalSineTerm (2 * m + 1) a := by
    rw [← hreflect]
    apply Finset.sum_congr rfl
    intro a ha
    apply reciprocalSineTerm_sub hq
    exact (Nat.le_of_lt_succ (Finset.mem_Ico.mp ha).2).trans (by omega)
  calc
    (∑ a ∈ Finset.Ico 1 (2 * m + 1), reciprocalSineTerm (2 * m + 1) a) =
        (∑ a ∈ Finset.Ico 1 (m + 1), reciprocalSineTerm (2 * m + 1) a) +
          ∑ a ∈ Finset.Ico (m + 1) (2 * m + 1),
            reciprocalSineTerm (2 * m + 1) a := by
      rw [Finset.sum_Ico_consecutive (reciprocalSineTerm (2 * m + 1))
        (by omega) (by omega)]
    _ = 2 * ∑ a ∈ Finset.Ico 1 (m + 1),
        reciprocalSineTerm (2 * m + 1) a := by rw [hupper]; ring

theorem sum_reciprocalSine_even_eq_two_mul_add_one
    {m : ℕ} (hm : 0 < m) :
    (∑ a ∈ Finset.Ico 1 (2 * m), reciprocalSineTerm (2 * m) a) =
      2 * (∑ a ∈ Finset.Ico 1 m, reciprocalSineTerm (2 * m) a) + 1 := by
  have hq : 0 < 2 * m := Nat.mul_pos two_pos hm
  have hreflect := Finset.sum_Ico_reflect
    (reciprocalSineTerm (2 * m)) 1
    (m := m) (n := 2 * m) (by omega)
  have hb1 : 2 * m + 1 - m = m + 1 := by omega
  have hb2 : 2 * m + 1 - 1 = 2 * m := by omega
  rw [hb1, hb2] at hreflect
  have hupper :
      (∑ a ∈ Finset.Ico (m + 1) (2 * m), reciprocalSineTerm (2 * m) a) =
        ∑ a ∈ Finset.Ico 1 m, reciprocalSineTerm (2 * m) a := by
    rw [← hreflect]
    apply Finset.sum_congr rfl
    intro a ha
    apply reciprocalSineTerm_sub hq
    exact (Nat.le_of_lt (Finset.mem_Ico.mp ha).2).trans (by omega)
  have hrest :
      (∑ a ∈ Finset.Ico m (2 * m), reciprocalSineTerm (2 * m) a) =
        reciprocalSineTerm (2 * m) m +
          ∑ a ∈ Finset.Ico (m + 1) (2 * m), reciprocalSineTerm (2 * m) a := by
    calc
      _ = (∑ a ∈ Finset.Ico m (m + 1), reciprocalSineTerm (2 * m) a) +
          ∑ a ∈ Finset.Ico (m + 1) (2 * m), reciprocalSineTerm (2 * m) a := by
        rw [Finset.sum_Ico_consecutive (reciprocalSineTerm (2 * m))
          (by omega) (by omega)]
      _ = _ := by simp
  calc
    (∑ a ∈ Finset.Ico 1 (2 * m), reciprocalSineTerm (2 * m) a) =
        (∑ a ∈ Finset.Ico 1 m, reciprocalSineTerm (2 * m) a) +
          ∑ a ∈ Finset.Ico m (2 * m), reciprocalSineTerm (2 * m) a := by
      rw [Finset.sum_Ico_consecutive (reciprocalSineTerm (2 * m))
        (by omega) (by omega)]
    _ = 2 * (∑ a ∈ Finset.Ico 1 m, reciprocalSineTerm (2 * m) a) + 1 := by
      rw [hrest, hupper, reciprocalSineTerm_two_mul_self hm]
      ring

end ReciprocalSineAggregate

theorem sum_reciprocalSine_Ico_lt_mul_log {q : ℕ} (hq : 1 < q) :
    (∑ a ∈ Finset.Ico 1 q,
      (Real.sin (Real.pi * (a : ℝ) / (q : ℝ)))⁻¹) <
      (q : ℝ) * Real.log (q : ℝ) := by
  obtain ⟨m, rfl | rfl⟩ := Nat.even_or_odd' q
  · have hm : 0 < m := by omega
    change (∑ a ∈ Finset.Ico 1 (2 * m), reciprocalSineTerm (2 * m) a) < _
    rw [sum_reciprocalSine_even_eq_two_mul_add_one hm]
    have hhalf := sum_reciprocalSine_Ico_le_half_mul_harmonic
      (q := 2 * m) (m := m - 1) (by omega) (by omega)
    have htop : m - 1 + 1 = m := Nat.sub_add_cancel hm
    rw [htop] at hhalf
    have hlog := harmonic_cast_pred_add_inv_two_mul_lt_log_two_mul hm
    calc
      2 * (∑ a ∈ Finset.Ico 1 m, reciprocalSineTerm (2 * m) a) + 1 ≤
          2 * (((2 * m : ℕ) : ℝ) / 2 * (harmonic (m - 1) : ℝ)) + 1 :=
        by
          simpa only [add_comm] using add_le_add_right
            (mul_le_mul_of_nonneg_left hhalf (show (0 : ℝ) ≤ 2 by norm_num)) 1
      _ = ((2 * m : ℕ) : ℝ) *
          ((harmonic (m - 1) : ℝ) + (((2 * m : ℕ) : ℝ))⁻¹) := by
        have htwoM : (((2 * m : ℕ) : ℝ)) ≠ 0 := by positivity
        field_simp
      _ < ((2 * m : ℕ) : ℝ) * Real.log (((2 * m : ℕ) : ℝ)) :=
        mul_lt_mul_of_pos_left hlog (by positivity)
  · have hm : 0 < m := by omega
    change (∑ a ∈ Finset.Ico 1 (2 * m + 1),
      reciprocalSineTerm (2 * m + 1) a) < _
    rw [sum_reciprocalSine_odd_eq_two_mul]
    have hhalf := sum_reciprocalSine_Ico_le_half_mul_harmonic
      (q := 2 * m + 1) (m := m) (by omega) (by omega)
    have hlog := harmonic_cast_lt_log_two_mul_add_one hm
    calc
      2 * (∑ a ∈ Finset.Ico 1 (m + 1), reciprocalSineTerm (2 * m + 1) a) ≤
          2 * (((2 * m + 1 : ℕ) : ℝ) / 2 * (harmonic m : ℝ)) :=
        mul_le_mul_of_nonneg_left hhalf (by norm_num)
      _ = ((2 * m + 1 : ℕ) : ℝ) * (harmonic m : ℝ) := by ring
      _ < ((2 * m + 1 : ℕ) : ℝ) * Real.log (((2 * m + 1 : ℕ) : ℝ)) := by
        apply mul_lt_mul_of_pos_left _ (by positivity)
        simpa only [Nat.cast_add, Nat.cast_mul, Nat.cast_ofNat, Nat.cast_one] using hlog

end

theorem norm_sum_dirichletCharacter_Ioc_lt_sqrt_mul_log
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    (M : ℤ) (N : ℕ) :
    ‖∑ n ∈ Finset.Ioc M (M + (N : ℤ)), chi (n : ZMod q)‖ <
      Real.sqrt (q : ℝ) * Real.log (q : ℝ) := by
  have hqpos : (0 : ℝ) < q := by
    exact_mod_cast Nat.zero_lt_of_lt hq
  have hsqrt : 0 < Real.sqrt (q : ℝ) := Real.sqrt_pos.2 hqpos
  calc
    ‖∑ n ∈ Finset.Ioc M (M + (N : ℤ)), chi (n : ZMod q)‖ ≤
        (∑ a ∈ Finset.Ico 1 q,
          (Real.sin (Real.pi * (a : ℝ) / (q : ℝ)))⁻¹) /
          Real.sqrt q :=
      norm_sum_dirichletCharacter_Ioc_le_reciprocalSineSum hq chi hchi M N
    _ < ((q : ℝ) * Real.log (q : ℝ)) / Real.sqrt q :=
      div_lt_div_of_pos_right (sum_reciprocalSine_Ico_lt_mul_log hq) hsqrt
    _ = Real.sqrt (q : ℝ) * Real.log (q : ℝ) := by
      apply (div_eq_iff hsqrt.ne').2
      calc
        (q : ℝ) * Real.log (q : ℝ) =
            (Real.sqrt (q : ℝ)) ^ 2 * Real.log (q : ℝ) := by
          rw [Real.sq_sqrt hqpos.le]
        _ = (Real.sqrt (q : ℝ) * Real.log (q : ℝ)) *
            Real.sqrt (q : ℝ) := by ring

/--
The sum of a Dirichlet character over the closed natural-number interval `[a, b]`, with value
zero when the interval is empty.
-/
noncomputable def dirichletCharacterIntervalSum
    (a b q : ℕ) (χ : DirichletCharacter ℂ q) : ℂ :=
  ∑ h ∈ Finset.Icc a b, χ h

theorem norm_dirichletCharacterIntervalSum_lt_sqrt_mul_log
    {q : ℕ} (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    (a b : ℕ) :
    ‖dirichletCharacterIntervalSum a b q chi‖ <
      Real.sqrt (q : ℝ) * Real.log (q : ℝ) := by
  let : NeZero q := ⟨Nat.ne_zero_of_lt hq⟩
  have hboundPos :
      0 < Real.sqrt (q : ℝ) * Real.log (q : ℝ) := by
    exact mul_pos (Real.sqrt_pos.2 (by exact_mod_cast Nat.zero_lt_of_lt hq))
      (Real.log_pos (by exact_mod_cast hq))
  by_cases hab : a ≤ b
  · have hendpoint :
        (a : ℤ) - 1 + (((b - a) + 1 : ℕ) : ℤ) = (b : ℤ) := by
      rw [Nat.cast_add, Nat.cast_sub hab]
      push_cast
      ring
    have hfinset :
        (Finset.Icc a b).map (Nat.castEmbedding : ℕ ↪ ℤ) =
          Finset.Ioc ((a : ℤ) - 1) (b : ℤ) := by
      ext n
      simp only [Finset.mem_map, Nat.castEmbedding_apply, Finset.mem_Icc,
        Finset.mem_Ioc]
      constructor
      · rintro ⟨m, hm, rfl⟩
        constructor <;> omega
      · intro hn
        have hnnonneg : 0 ≤ n := by
          have : (a : ℤ) ≤ n := by omega
          exact (Int.natCast_nonneg a).trans this
        lift n to ℕ using hnnonneg with m
        refine ⟨m, ?_, rfl⟩
        constructor <;> omega
    rw [dirichletCharacterIntervalSum]
    calc
      ‖∑ n ∈ Finset.Icc a b, chi n‖ =
          ‖∑ n ∈ Finset.Ioc ((a : ℤ) - 1) (b : ℤ),
            chi (n : ZMod q)‖ := by
        rw [← hfinset, Finset.sum_map]
        simp
      _ = ‖∑ n ∈ Finset.Ioc ((a : ℤ) - 1)
            ((a : ℤ) - 1 + (((b - a) + 1 : ℕ) : ℤ)),
            chi (n : ZMod q)‖ := by rw [hendpoint]
      _ < Real.sqrt (q : ℝ) * Real.log (q : ℝ) :=
        norm_sum_dirichletCharacter_Ioc_lt_sqrt_mul_log hq chi hchi
          ((a : ℤ) - 1) ((b - a) + 1)
  · rw [dirichletCharacterIntervalSum, Finset.Icc_eq_empty (by omega),
      Finset.sum_empty, norm_zero]
    exact hboundPos

section
open Asymptotics Complex _root_.Filter Asymptotics.Filter Set
open scoped Real

section PrimitiveLFunctionCentralStrip
theorem polyaVinogradovScale_pos {q : ℕ} (hq : 1 < q) :
    0 < Real.sqrt (q : ℝ) * Real.log (q : ℝ) :=
  mul_pos
    (Real.sqrt_pos.2 (by exact_mod_cast Nat.zero_lt_of_lt hq))
    (Real.log_pos (by exact_mod_cast hq))

theorem norm_characterAbelIntegral_le
    {q : ℕ} (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    {s : ℂ} (hs : 0 < s.re) :
    ‖∫ y in Ioi (1 : ℝ),
        dirichletCharacterIntervalSum 1 ⌊y⌋₊ q chi *
          (y : ℂ) ^ (-(s + 1))‖ ≤
      (Real.sqrt (q : ℝ) * Real.log (q : ℝ)) / s.re := by
  have hPower : IntegrableOn
      (fun y : ℝ ↦ y ^ (-(s.re + 1))) (Ioi 1) :=
    integrableOn_Ioi_rpow_of_lt (by linarith) zero_lt_one
  have hScale : 0 ≤ Real.sqrt (q : ℝ) * Real.log (q : ℝ) :=
    (polyaVinogradovScale_pos hq).le
  have hDom : IntegrableOn
      (fun y : ℝ ↦
        (Real.sqrt (q : ℝ) * Real.log (q : ℝ)) *
          y ^ (-(s.re + 1))) (Ioi 1) :=
    hPower.const_mul _
  have hActualMeasurable : AEStronglyMeasurable
      (fun y : ℝ ↦
        dirichletCharacterIntervalSum 1 ⌊y⌋₊ q chi *
          (y : ℂ) ^ (-(s + 1))) (volume.restrict (Ioi 1)) := by
    have hPrefix : Measurable
        (fun y : ℝ ↦ dirichletCharacterIntervalSum 1 ⌊y⌋₊ q chi) :=
      (measurable_of_countable
        (fun n : ℕ ↦ dirichletCharacterIntervalSum 1 n q chi)).comp
        Nat.measurable_floor
    have hCpow : ContinuousOn
        (fun y : ℝ ↦ (y : ℂ) ^ (-(s + 1))) (Ioi 1) :=
      continuousOn_of_forall_continuousAt fun y hy ↦
        continuousAt_ofReal_cpow_const y (-(s + 1))
          (Or.inr (zero_lt_one.trans hy).ne')
    exact hPrefix.aestronglyMeasurable.mul
      (hCpow.aestronglyMeasurable measurableSet_Ioi)
  have hBound : ∀ᵐ (y : ℝ) ∂volume.restrict (Ioi 1),
      ‖dirichletCharacterIntervalSum 1 ⌊y⌋₊ q chi *
          (y : ℂ) ^ (-(s + 1))‖ ≤
        (Real.sqrt (q : ℝ) * Real.log (q : ℝ)) *
          y ^ (-(s.re + 1)) := by
    filter_upwards [ae_restrict_mem measurableSet_Ioi] with y hy
    rw [norm_mul,
      Complex.norm_cpow_eq_rpow_re_of_pos (zero_lt_one.trans hy)]
    simp only [neg_re, add_re, one_re]
    exact mul_le_mul_of_nonneg_right
      (norm_dirichletCharacterIntervalSum_lt_sqrt_mul_log
        hq chi hchi 1 ⌊y⌋₊).le
      (Real.rpow_nonneg (zero_lt_one.trans hy).le _)
  have hActual : IntegrableOn
      (fun y : ℝ ↦
        dirichletCharacterIntervalSum 1 ⌊y⌋₊ q chi *
          (y : ℂ) ^ (-(s + 1))) (Ioi 1) :=
    hDom.mono' hActualMeasurable hBound
  calc
    ‖∫ y in Ioi (1 : ℝ),
        dirichletCharacterIntervalSum 1 ⌊y⌋₊ q chi *
          (y : ℂ) ^ (-(s + 1))‖ ≤
        ∫ y in Ioi (1 : ℝ),
          ‖dirichletCharacterIntervalSum 1 ⌊y⌋₊ q chi *
            (y : ℂ) ^ (-(s + 1))‖ :=
      norm_integral_le_integral_norm _
    _ ≤ ∫ y in Ioi (1 : ℝ),
          (Real.sqrt (q : ℝ) * Real.log (q : ℝ)) *
            y ^ (-(s.re + 1)) :=
      setIntegral_mono_ae_restrict hActual.norm hDom hBound
    _ = (Real.sqrt (q : ℝ) * Real.log (q : ℝ)) *
        ∫ y in Ioi (1 : ℝ), y ^ (-(s.re + 1)) := by
      rw [integral_const_mul]
    _ = (Real.sqrt (q : ℝ) * Real.log (q : ℝ)) / s.re := by
      rw [integral_Ioi_rpow_of_lt (by linarith) zero_lt_one, Real.one_rpow]
      field_simp [hs.ne']
      ring

end PrimitiveLFunctionCentralStrip

theorem character_ne_one_of_isPrimitive
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive) : chi ≠ 1 := by
  intro heq
  have hc : chi.conductor = 1 :=
    DirichletCharacter.eq_one_iff_conductor_eq_one.mp heq
  have hp : chi.conductor = q := hchi
  omega

theorem LFunction_eq_abelIntegral_of_isPrimitive
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    (s : ℂ) (hs : 0 < s.re) :
    DirichletCharacter.LFunction chi s =
      s * ∫ y in Set.Ioi (1 : ℝ),
        dirichletCharacterIntervalSum 1 ⌊y⌋₊ q chi *
          (y : ℂ) ^ (-(s + 1)) := by
  simpa [dirichletCharacterIntervalSum] using
    LFunction_eq_abelIntegral_of_prefixBound chi
      (character_ne_one_of_isPrimitive hq chi hchi)
      (Real.sqrt (q : ℝ) * Real.log (q : ℝ))
      (fun n ↦ by
        simpa [dirichletCharacterIntervalSum] using
          (norm_dirichletCharacterIntervalSum_lt_sqrt_mul_log
            hq chi hchi 1 n).le)
      s hs

theorem norm_LFunction_centralStrip_le
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    {sigma t : ℝ} (hsigma_lower : (1 / 2 : ℝ) ≤ sigma)
    (hsigma_upper : sigma ≤ 2) :
    ‖DirichletCharacter.LFunction chi ((sigma : ℂ) + t * I)‖ ≤
      2 * (|t| + 2) * Real.sqrt (q : ℝ) * Real.log (q : ℝ) := by
  let s : ℂ := (sigma : ℂ) + t * I
  have hsigma_pos : 0 < sigma := by linarith
  have hsre : s.re = sigma := by simp [s]
  have hspos : 0 < s.re := hsre.symm ▸ hsigma_pos
  have hscale : 0 ≤ Real.sqrt (q : ℝ) * Real.log (q : ℝ) :=
    (polyaVinogradovScale_pos hq).le
  have hnormS : ‖s‖ ≤ |t| + 2 := by
    calc
      ‖s‖ ≤ ‖(sigma : ℂ)‖ + ‖(t : ℂ) * I‖ := by
        simpa only [s] using norm_add_le (sigma : ℂ) ((t : ℂ) * I)
      _ = |sigma| + |t| := by simp [Real.norm_eq_abs]
      _ = sigma + |t| := by rw [abs_of_nonneg hsigma_pos.le]
      _ ≤ |t| + 2 := by linarith
  have hinv : 1 / sigma ≤ 2 := by
    apply (div_le_iff₀ hsigma_pos).2
    linarith
  have hquot :
      (Real.sqrt (q : ℝ) * Real.log (q : ℝ)) / sigma ≤
        2 * (Real.sqrt (q : ℝ) * Real.log (q : ℝ)) := by
    calc
      (Real.sqrt (q : ℝ) * Real.log (q : ℝ)) / sigma =
          (1 / sigma) *
            (Real.sqrt (q : ℝ) * Real.log (q : ℝ)) := by ring
      _ ≤ 2 * (Real.sqrt (q : ℝ) * Real.log (q : ℝ)) :=
        mul_le_mul_of_nonneg_right hinv hscale
  have hIntegral := norm_characterAbelIntegral_le hq chi hchi hspos
  rw [hsre] at hIntegral
  change ‖DirichletCharacter.LFunction chi s‖ ≤ _
  calc
    ‖DirichletCharacter.LFunction chi s‖ =
        ‖s‖ *
          ‖∫ y in Ioi (1 : ℝ),
            dirichletCharacterIntervalSum 1 ⌊y⌋₊ q chi *
              (y : ℂ) ^ (-(s + 1))‖ := by
      rw [LFunction_eq_abelIntegral_of_isPrimitive hq chi hchi s hspos,
        norm_mul]
    _ ≤ ‖s‖ *
        ((Real.sqrt (q : ℝ) * Real.log (q : ℝ)) / sigma) :=
      mul_le_mul_of_nonneg_left hIntegral (norm_nonneg s)
    _ ≤ (|t| + 2) *
        ((Real.sqrt (q : ℝ) * Real.log (q : ℝ)) / sigma) :=
      mul_le_mul_of_nonneg_right hnormS
        (div_nonneg hscale hsigma_pos.le)
    _ ≤ (|t| + 2) *
        (2 * (Real.sqrt (q : ℝ) * Real.log (q : ℝ))) :=
      mul_le_mul_of_nonneg_left hquot (by positivity)
    _ = 2 * (|t| + 2) * Real.sqrt (q : ℝ) * Real.log (q : ℝ) := by
      ring

end

section
open Complex Set

section FixedStripGammaRatio
theorem one_div_Gamma_eq_prod_mul_one_div_Gamma_add_nat
    (z : ℂ) (n : ℕ) :
    (Complex.Gamma z)⁻¹ =
      (∏ j ∈ Finset.range n, (z + j)) * (Complex.Gamma (z + n))⁻¹ := by
  induction n with
  | zero => simp
  | succ n ih =>
      rw [ih, Complex.one_div_Gamma_eq_self_mul_one_div_Gamma_add_one,
        Finset.prod_range_succ, Nat.cast_succ]
      ring_nf

theorem Gamma_div_Gamma_eq_prod_mul_beta_div
    (w X : ℂ) (d : ℝ) (hX : 0 < X.re) (hd : 0 < d)
    (hsum : X + (d : ℂ) = w + 11) :
    Complex.Gamma X / Complex.Gamma w =
      (∏ j ∈ Finset.range 11, (w + j)) *
        (Complex.betaIntegral X d / Complex.Gamma d) := by
  have hXd : 0 < (X + (d : ℂ)).re := by simp; linarith
  have hGXd := Complex.Gamma_ne_zero_of_re_pos hXd
  have hGd := Complex.Gamma_ne_zero_of_re_pos
    (show 0 < ((d : ℂ)).re by simpa)
  rw [div_eq_mul_inv, one_div_Gamma_eq_prod_mul_one_div_Gamma_add_nat w 11]
  have hsum' : w + (11 : ℕ) = X + (d : ℂ) := by simpa using hsum.symm
  rw [hsum', Complex.betaIntegral_eq_Gamma_mul_div X d hX
    (show 0 < ((d : ℂ)).re by simpa)]
  field_simp [hGXd, hGd]

theorem norm_betaIntegral_fixed_re_le
    {u : ℂ} {q : ℝ} (hu : (1 / 4 : ℝ) ≤ u.re)
    (hq : (1 / 2 : ℝ) ≤ q) :
    ‖Complex.betaIntegral u q‖ ≤ 12 := by
  rw [Complex.betaIntegral]
  let f : ℝ → ℂ := fun x =>
    (x : ℂ) ^ (u - 1) * (1 - (x : ℂ)) ^ ((q : ℂ) - 1)
  let g : ℝ → ℝ := fun x =>
    2 * x ^ (-(3 / 4 : ℝ)) + 2 * (1 - x) ^ (-(1 / 2 : ℝ))
  have hxpow : IntervalIntegrable (fun x : ℝ => x ^ (-(3 / 4 : ℝ))) volume 0 1 :=
    intervalIntegral.intervalIntegrable_rpow' (by norm_num)
  have hhalfpow :
      IntervalIntegrable (fun x : ℝ => x ^ (-(1 / 2 : ℝ))) volume 0 1 :=
    intervalIntegral.intervalIntegrable_rpow' (by norm_num)
  have hsubpow :
      IntervalIntegrable (fun x : ℝ => (1 - x) ^ (-(1 / 2 : ℝ))) volume 0 1 := by
    simpa only [sub_zero, sub_self] using (hhalfpow.comp_sub_left 1).symm
  have hg : IntervalIntegrable g volume 0 1 :=
    (hxpow.const_mul 2).add (hsubpow.const_mul 2)
  have hf : IntervalIntegrable f volume 0 1 :=
    Complex.betaIntegral_convergent
      (lt_of_lt_of_le (by norm_num) hu)
      (show 0 < ((q : ℂ)).re by simp; linarith)
  have hpoint : ∀ x : ℝ, x ∈ Icc 0 1 → ‖f x‖ ≤ g x := by
    intro x hx
    rcases eq_or_ne x 0 with rfl | hx0
    · have hzero : ‖(0 : ℂ) ^ (u - 1)‖ ≤ 1 := by
        by_cases h : u - 1 = 0
        · rw [h, Complex.cpow_zero, norm_one]
        · rw [Complex.zero_cpow h, norm_zero]
          norm_num
      have htwo : ‖(0 : ℂ) ^ (u - 1)‖ ≤ 2 := hzero.trans (by norm_num)
      simpa [f, g] using htwo
    rcases eq_or_ne x 1 with rfl | hx1
    · have hzero : ‖(0 : ℂ) ^ ((q : ℂ) - 1)‖ ≤ 1 := by
        by_cases h : (q : ℂ) - 1 = 0
        · rw [h, Complex.cpow_zero, norm_one]
        · rw [Complex.zero_cpow h, norm_zero]
          norm_num
      have htwo : ‖(0 : ℂ) ^ ((q : ℂ) - 1)‖ ≤ 2 := hzero.trans (by norm_num)
      simpa [f, g] using htwo
    have hxpos : 0 < x := lt_of_le_of_ne hx.1 (Ne.symm hx0)
    have hxlt : x < 1 := lt_of_le_of_ne hx.2 hx1
    have hsubpos : 0 < 1 - x := sub_pos.mpr hxlt
    dsimp [f]
    rw [norm_mul, Complex.norm_cpow_eq_rpow_re_of_pos hxpos]
    rw [show (1 : ℂ) - (x : ℂ) = ((1 - x : ℝ) : ℂ) by norm_num,
      Complex.norm_cpow_eq_rpow_re_of_pos hsubpos]
    simp only [sub_re, one_re, ofReal_re]
    have hxpow_le : x ^ (u.re - 1) ≤ x ^ (-(3 / 4 : ℝ)) :=
      Real.rpow_le_rpow_of_exponent_ge hxpos hx.2 (by linarith)
    have hsubpow_le :
        (1 - x) ^ (q - 1) ≤ (1 - x) ^ (-(1 / 2 : ℝ)) :=
      Real.rpow_le_rpow_of_exponent_ge hsubpos (sub_le_self 1 hxpos.le) (by linarith)
    have hxnonneg := Real.rpow_nonneg hxpos.le (u.re - 1)
    have hsubnonneg := Real.rpow_nonneg hsubpos.le (q - 1)
    have hbase :
        x ^ (u.re - 1) * (1 - x) ^ (q - 1) ≤
          x ^ (-(3 / 4 : ℝ)) * (1 - x) ^ (-(1 / 2 : ℝ)) :=
      mul_le_mul hxpow_le hsubpow_le hsubnonneg
        (Real.rpow_nonneg hxpos.le (-(3 / 4 : ℝ)))
    have hmajor :
        x ^ (-(3 / 4 : ℝ)) * (1 - x) ^ (-(1 / 2 : ℝ)) ≤ g x := by
      by_cases hhalf : x ≤ 1 / 2
      · have hsubhalf : (1 / 2 : ℝ) ≤ 1 - x := by linarith
        have hone :
            (1 - x) ^ (-(1 / 2 : ℝ)) ≤ (1 - x) ^ (-(1 : ℝ)) :=
          Real.rpow_le_rpow_of_exponent_ge hsubpos (sub_le_self 1 hxpos.le) (by norm_num)
        have hinv : (1 - x) ^ (-(1 : ℝ)) ≤ 2 := by
          rw [Real.rpow_neg_one, ← one_div]
          exact (one_div_le hsubpos (by norm_num)).2 hsubhalf
        dsimp [g]
        have hxrp := Real.rpow_nonneg hxpos.le (-(3 / 4 : ℝ))
        have hsrp := Real.rpow_nonneg hsubpos.le (-(1 / 2 : ℝ))
        nlinarith
      · have hxhalf : (1 / 2 : ℝ) ≤ x := le_of_not_ge hhalf
        have hone :
            x ^ (-(3 / 4 : ℝ)) ≤ x ^ (-(1 : ℝ)) :=
          Real.rpow_le_rpow_of_exponent_ge hxpos hx.2 (by norm_num)
        have hinv : x ^ (-(1 : ℝ)) ≤ 2 := by
          rw [Real.rpow_neg_one, ← one_div]
          exact (one_div_le hxpos (by norm_num)).2 hxhalf
        dsimp [g]
        have hxrp := Real.rpow_nonneg hxpos.le (-(3 / 4 : ℝ))
        have hsrp := Real.rpow_nonneg hsubpos.le (-(1 / 2 : ℝ))
        nlinarith
    exact hbase.trans hmajor
  calc
    _ ≤ ∫ x in (0 : ℝ)..1, ‖f x‖ :=
      intervalIntegral.norm_integral_le_integral_norm (by norm_num)
    _ ≤ ∫ x in (0 : ℝ)..1, g x :=
      intervalIntegral.integral_mono_on (by norm_num) hf.norm hg hpoint
    _ = 12 := by
      dsimp [g]
      rw [intervalIntegral.integral_add (hxpow.const_mul 2) (hsubpow.const_mul 2),
        intervalIntegral.integral_const_mul,
        intervalIntegral.integral_const_mul]
      have hsub :
          (∫ x in (0 : ℝ)..1, (1 - x) ^ (-(1 / 2 : ℝ))) =
            ∫ x in (0 : ℝ)..1, x ^ (-(1 / 2 : ℝ)) := by
        simpa using intervalIntegral.integral_comp_sub_left
          (a := (0 : ℝ)) (b := 1) (fun x : ℝ => x ^ (-(1 / 2 : ℝ))) 1
      rw [hsub, integral_rpow (Or.inl (by norm_num)),
        integral_rpow (Or.inl (by norm_num))]
      norm_num

theorem exists_norm_one_div_Gamma_Icc_le :
    ∃ K : ℝ, 0 < K ∧ ∀ d : ℝ, (1 / 2 : ℝ) ≤ d → d ≤ 11 →
      ‖(Complex.Gamma (d : ℂ))⁻¹‖ ≤ K := by
  have hcont : Continuous (fun d : ℝ => ‖(Complex.Gamma (d : ℂ))⁻¹‖) :=
    (Complex.differentiable_one_div_Gamma.continuous.comp
      Complex.continuous_ofReal).norm
  obtain ⟨c, hc⟩ := bddAbove_def.mp
    (IsCompact.bddAbove_image isCompact_Icc hcont.continuousOn)
  let K : ℝ := max c 0 + 1
  refine ⟨K, by dsimp [K]; linarith [le_max_right c 0], ?_⟩
  intro d hd hd11
  have hdmem : d ∈ Icc (1 / 2 : ℝ) 11 := ⟨hd, hd11⟩
  exact (hc _ (mem_image_of_mem _ hdmem)).trans
    (by dsimp [K]; linarith [le_max_left c 0])

theorem norm_prod_range_eleven_add_le
    (w : ℂ) (t : ℝ)
    (hwlower : -(5 : ℝ) ≤ w.re) (hwupper : w.re ≤ (3 / 4 : ℝ))
    (hwim : |w.im| = |t| / 2) :
    ‖∏ j ∈ Finset.range 11, (w + j)‖ ≤
      (6 : ℝ) ^ 11 * (|t| + 2) ^ 11 := by
  have hfactor : ∀ j ∈ Finset.range 11,
      ‖w + (j : ℂ)‖ ≤ 6 * (|t| + 2) := by
    intro j hj
    have hjlt : j < 11 := Finset.mem_range.mp hj
    have hjle : j ≤ 10 := Nat.le_pred_of_lt hjlt
    have hjreal : (j : ℝ) ≤ 10 := by exact_mod_cast hjle
    have hjnonneg : (0 : ℝ) ≤ j := Nat.cast_nonneg j
    have hreabs : |(w + (j : ℂ)).re| ≤ 43 / 4 := by
      rw [add_re, natCast_re]
      apply abs_le.mpr
      constructor <;> linarith
    have himabs : |(w + (j : ℂ)).im| = |t| / 2 := by
      simp only [add_im, natCast_im, add_zero, hwim]
    calc
      ‖w + (j : ℂ)‖ ≤ |(w + (j : ℂ)).re| + |(w + (j : ℂ)).im| :=
        Complex.norm_le_abs_re_add_abs_im _
      _ ≤ 43 / 4 + |t| / 2 := by rw [himabs]; gcongr
      _ ≤ 6 * (|t| + 2) := by nlinarith [abs_nonneg t]
  calc
    ‖∏ j ∈ Finset.range 11, (w + j)‖ ≤
        ∏ j ∈ Finset.range 11, ‖w + (j : ℂ)‖ :=
      Finset.norm_prod_le _ _
    _ ≤ ∏ _j ∈ Finset.range 11, (6 * (|t| + 2)) :=
      Finset.prod_le_prod (fun _ _ => norm_nonneg _) hfactor
    _ = (6 * (|t| + 2)) ^ 11 := by simp
    _ = (6 : ℝ) ^ 11 * (|t| + 2) ^ 11 := by ring

theorem norm_Gamma_div_Gamma_fixedStrip_le
    (K : ℝ)
    (hK : ∀ d : ℝ, (1 / 2 : ℝ) ≤ d → d ≤ 11 →
      ‖(Complex.Gamma (d : ℂ))⁻¹‖ ≤ K)
    (a : ℝ) (s : ℂ) (ha0 : 0 ≤ a) (ha1 : a ≤ 1)
    (hslo : -(10 : ℝ) ≤ s.re) (hshi : s.re ≤ (1 / 2 : ℝ)) :
    ‖Complex.Gamma ((1 - s + (a : ℂ)) / 2) /
        Complex.Gamma ((s + (a : ℂ)) / 2)‖ ≤
      (12 * K * 6 ^ 11) * (|s.im| + 2) ^ 11 := by
  let w : ℂ := ((starRingEnd ℂ) s + (a : ℂ)) / 2
  let X : ℂ := (1 - s + (a : ℂ)) / 2
  let d : ℝ := 21 / 2 + s.re
  have hwlower : -(5 : ℝ) ≤ w.re := by
    rw [show w.re = (s.re + a) / 2 by norm_num [w]]
    linarith
  have hwupper : w.re ≤ (3 / 4 : ℝ) := by
    rw [show w.re = (s.re + a) / 2 by norm_num [w]]
    linarith
  have hwim : |w.im| = |s.im| / 2 := by
    rw [show w.im = -s.im / 2 by norm_num [w], abs_div, abs_neg]
    norm_num
  have hX : (1 / 4 : ℝ) ≤ X.re := by
    rw [show X.re = (1 - s.re + a) / 2 by norm_num [X]]
    linarith
  have hdlo : (1 / 2 : ℝ) ≤ d := by dsimp [d]; linarith
  have hdhi : d ≤ 11 := by dsimp [d]; linarith
  have hsum : X + (d : ℂ) = w + 11 := by
    dsimp [X, d, w]
    apply Complex.ext
    · norm_num
      ring
    · norm_num
  have hidentity := Gamma_div_Gamma_eq_prod_mul_beta_div w X d
    (lt_of_lt_of_le (by norm_num) hX) (lt_of_lt_of_le (by norm_num) hdlo) hsum
  have hwconj : w = (starRingEnd ℂ) ((s + (a : ℂ)) / 2) := by
    dsimp [w]
    rw [map_div₀, map_add, map_ofNat]
    norm_num
  have hdennorm :
      ‖Complex.Gamma ((s + (a : ℂ)) / 2)‖ = ‖Complex.Gamma w‖ := by
    have h := congrArg norm (Complex.Gamma_conj ((s + (a : ℂ)) / 2))
    rw [Complex.norm_conj] at h
    rw [hwconj, h]
  have hquotnorm :
      ‖Complex.Gamma X / Complex.Gamma ((s + (a : ℂ)) / 2)‖ =
        ‖Complex.Gamma X / Complex.Gamma w‖ := by
    simp only [norm_div, hdennorm]
  have hprod := norm_prod_range_eleven_add_le w s.im hwlower hwupper hwim
  have hresidual :
      ‖Complex.betaIntegral X d / Complex.Gamma d‖ ≤ 12 * K := by
    rw [div_eq_mul_inv, norm_mul]
    exact mul_le_mul (norm_betaIntegral_fixed_re_le hX hdlo)
      (hK d hdlo hdhi) (norm_nonneg _) (by norm_num)
  rw [show (1 - s + (a : ℂ)) / 2 = X by rfl, hquotnorm, hidentity, norm_mul]
  calc
    _ ≤ ((6 : ℝ) ^ 11 * (|s.im| + 2) ^ 11) * (12 * K) :=
      mul_le_mul hprod hresidual (norm_nonneg _)
        (mul_nonneg (by positivity) (by positivity))
    _ = (12 * K * 6 ^ 11) * (|s.im| + 2) ^ 11 := by ring

theorem norm_GammaR_div_GammaR_le_Gamma_div_Gamma
    (a : ℝ) (s : ℂ) (hs : s.re ≤ (1 / 2 : ℝ)) :
    ‖Complex.Gammaℝ (1 - s + (a : ℂ)) /
        Complex.Gammaℝ (s + (a : ℂ))‖ ≤
      ‖Complex.Gamma ((1 - s + (a : ℂ)) / 2) /
        Complex.Gamma ((s + (a : ℂ)) / 2)‖ := by
  rw [Complex.Gammaℝ_def, Complex.Gammaℝ_def]
  have hfactor :
      ((Real.pi : ℂ) ^ (-(1 - s + (a : ℂ)) / 2) *
          Complex.Gamma ((1 - s + (a : ℂ)) / 2)) /
        ((Real.pi : ℂ) ^ (-(s + (a : ℂ)) / 2) *
          Complex.Gamma ((s + (a : ℂ)) / 2)) =
      (((Real.pi : ℂ) ^ (-(1 - s + (a : ℂ)) / 2)) /
          ((Real.pi : ℂ) ^ (-(s + (a : ℂ)) / 2))) *
        (Complex.Gamma ((1 - s + (a : ℂ)) / 2) /
          Complex.Gamma ((s + (a : ℂ)) / 2)) := by
    rw [div_eq_mul_inv, mul_inv]
    ring
  rw [hfactor, norm_mul]
  apply mul_le_of_le_one_left (norm_nonneg _)
  rw [norm_div, Complex.norm_cpow_eq_rpow_re_of_pos Real.pi_pos,
    Complex.norm_cpow_eq_rpow_re_of_pos Real.pi_pos, ← Real.rpow_sub Real.pi_pos]
  have hexp :
      (-(1 - s + (a : ℂ)) / 2).re - (-(s + (a : ℂ)) / 2).re =
        s.re - 1 / 2 := by
    norm_num
    ring
  rw [hexp]
  exact Real.rpow_le_one_of_one_le_of_nonpos
    (le_trans (by norm_num) Real.two_le_pi) (by linarith)

theorem even_inv_for_gammaFactor
    {q : ℕ} {chi : DirichletCharacter ℂ q} (hchi : chi.Even) :
    (chi⁻¹).Even := by
  simp only [DirichletCharacter.Even] at hchi ⊢
  rw [MulChar.inv_apply_eq_inv', hchi, inv_one]

theorem odd_inv_for_gammaFactor
    {q : ℕ} {chi : DirichletCharacter ℂ q} (hchi : chi.Odd) :
    (chi⁻¹).Odd := by
  simp only [DirichletCharacter.Odd] at hchi ⊢
  rw [MulChar.inv_apply_eq_inv', hchi]
  norm_num

end FixedStripGammaRatio

theorem exists_norm_gammaFactor_ratio_fixedStrip_le :
    ∃ C : ℝ, 0 < C ∧
      ∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q) (s : ℂ),
        -(10 : ℝ) ≤ s.re →
        s.re ≤ (1 / 2 : ℝ) →
        ‖DirichletCharacter.gammaFactor chi⁻¹ (1 - s) /
          DirichletCharacter.gammaFactor chi s‖ ≤
          C * (|s.im| + 2) ^ 11 := by
  obtain ⟨K, hKpos, hK⟩ := exists_norm_one_div_Gamma_Icc_le
  let C : ℝ := 12 * K * 6 ^ 11
  refine ⟨C, by dsimp [C]; positivity, ?_⟩
  intro q _ chi s hslo hshi
  have hbound (a : ℝ) (ha0 : 0 ≤ a) (ha1 : a ≤ 1) :
      ‖Complex.Gammaℝ (1 - s + (a : ℂ)) /
          Complex.Gammaℝ (s + (a : ℂ))‖ ≤
        C * (|s.im| + 2) ^ 11 :=
    (norm_GammaR_div_GammaR_le_Gamma_div_Gamma a s hshi).trans
      (norm_Gamma_div_Gamma_fixedStrip_le K hK a s ha0 ha1 hslo hshi)
  rcases chi.even_or_odd with heven | hodd
  · rw [(even_inv_for_gammaFactor heven).gammaFactor_def, heven.gammaFactor_def]
    simpa using hbound 0 (by norm_num) (by norm_num)
  · rw [(odd_inv_for_gammaFactor hodd).gammaFactor_def, hodd.gammaFactor_def]
    convert hbound 1 (by norm_num) (by norm_num) using 1
    all_goals norm_num

end

section
open Complex

theorem norm_LFunction_farRight_le_three
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q) (z : ℂ)
    (hz : (2 : ℝ) ≤ z.re) :
    ‖DirichletCharacter.LFunction chi z‖ ≤ 3 := by
  have hz1 : 1 < z.re := one_lt_two.trans_le hz
  have hsummable : LSeriesSummable (chi ·) z :=
    DirichletCharacter.LSeriesSummable_of_one_lt_re chi hz1
  rw [DirichletCharacter.LFunction_eq_LSeries chi hz1, LSeries]
  calc
    ‖∑' n : ℕ, LSeries.term (chi ·) z n‖ ≤
        ∑' n : ℕ, ‖LSeries.term (chi ·) z n‖ :=
      norm_tsum_le_tsum_norm hsummable.norm
    _ ≤ ∑' n : ℕ, (1 : ℝ) / (n : ℝ) ^ 2 := by
      apply hsummable.norm.tsum_le_tsum
      · intro n
        rw [LSeries.norm_term_eq]
        split_ifs with hn
        · simp
        · have hn1 : (1 : ℝ) ≤ n := by
            exact_mod_cast Nat.one_le_iff_ne_zero.mpr hn
          have hpow : (n : ℝ) ^ 2 ≤ (n : ℝ) ^ z.re := by
            rw [← Real.rpow_natCast]
            exact Real.rpow_le_rpow_of_exponent_le hn1 hz
          calc
            ‖chi n‖ / (n : ℝ) ^ z.re ≤ 1 / (n : ℝ) ^ z.re :=
              div_le_div_of_nonneg_right (chi.norm_le_one n)
                (Real.rpow_nonneg (Nat.cast_nonneg n) z.re)
            _ ≤ 1 / (n : ℝ) ^ 2 :=
              one_div_le_one_div_of_le (by positivity) hpow
      · exact Real.summable_one_div_nat_pow.mpr (by norm_num)
    _ = Real.pi ^ 2 / 6 := hasSum_zeta_two.tsum_eq
    _ ≤ 3 := by nlinarith [Real.pi_nonneg, Real.pi_le_four]

theorem exists_norm_LFunction_fixedStrip_le_const_mul_pow_twelve :
    ∃ C : ℝ, 0 < C ∧
      ∀ (q : ℕ) [NeZero q], 1 < q →
        ∀ (chi : DirichletCharacter ℂ q), chi.IsPrimitive →
          ∀ s : ℂ, -(10 : ℝ) ≤ s.re → s.re ≤ (1 / 2 : ℝ) →
            ‖DirichletCharacter.LFunction chi s‖ ≤
              C * ((q : ℝ) * (|s.im| + 2)) ^ 12 := by
  obtain ⟨Cgamma, hCgamma, hgamma⟩ :=
    exists_norm_gammaFactor_ratio_fixedStrip_le
  refine ⟨3 * Cgamma, mul_pos (by norm_num) hCgamma, ?_⟩
  intro q _ hq chi hchi s hslo hshi
  have hq2 : (2 : ℝ) ≤ q := by exact_mod_cast hq
  have hq1 : (1 : ℝ) ≤ q := one_le_two.trans hq2
  have hq0 : (0 : ℝ) ≤ q := zero_le_one.trans hq1
  have hqpos : (0 : ℝ) < q := zero_lt_one.trans_le hq1
  have hT2 : (2 : ℝ) ≤ |s.im| + 2 := by linarith [abs_nonneg s.im]
  have hT1 : (1 : ℝ) ≤ |s.im| + 2 := one_le_two.trans hT2
  have hT0 : (0 : ℝ) ≤ |s.im| + 2 := zero_le_one.trans hT1
  have hchiInv : chi⁻¹.IsPrimitive := by
    rw [DirichletCharacter.IsPrimitive, DirichletCharacter.conductor_inv]
    exact hchi
  have hgamma' := hgamma q chi s hslo hshi
  rw [norm_LFunction_eq_functionalEquation_of_isPrimitive hq chi hchi s hshi]
  by_cases hmid : -(1 : ℝ) ≤ s.re
  · have hreflected := norm_LFunction_centralStrip_le hq chi⁻¹ hchiInv
      (sigma := 1 - s.re) (t := -s.im) (by linarith) (by linarith)
    have hreflectArg :
        (((1 - s.re : ℝ) : ℂ) + ((-s.im : ℝ) : ℂ) * I) = 1 - s := by
      apply Complex.ext <;> simp
    rw [hreflectArg] at hreflected
    simp only [abs_neg] at hreflected
    have hqpow :
        (q : ℝ) ^ ((1 : ℝ) / 2 - s.re) ≤ (q : ℝ) ^ (2 : ℕ) := by
      rw [← Real.rpow_natCast]
      exact Real.rpow_le_rpow_of_exponent_le hq1 (by linarith)
    have hsqrt : Real.sqrt (q : ℝ) ≤ q :=
      Real.sqrt_le_self_iff.mpr (Or.inr hq1)
    have hlog : Real.log (q : ℝ) ≤ q :=
      (Real.log_le_sub_one_of_pos hqpos).trans
        (sub_le_self _ zero_le_one)
    have hqpowFour : (q : ℝ) ^ 4 ≤ (q : ℝ) ^ 12 :=
      pow_le_pow_right₀ hq1 (by norm_num)
    calc
      (q : ℝ) ^ ((1 : ℝ) / 2 - s.re) *
            ‖DirichletCharacter.LFunction chi⁻¹ (1 - s)‖ *
          ‖DirichletCharacter.gammaFactor chi⁻¹ (1 - s) /
            DirichletCharacter.gammaFactor chi s‖ ≤
          (q : ℝ) ^ 2 *
              (2 * (|s.im| + 2) * Real.sqrt (q : ℝ) * Real.log (q : ℝ)) *
            (Cgamma * (|s.im| + 2) ^ 11) := by
        gcongr
      _ ≤ (q : ℝ) ^ 2 *
              (2 * (|s.im| + 2) * (q : ℝ) * (q : ℝ)) *
            (Cgamma * (|s.im| + 2) ^ 11) := by
        gcongr
      _ = (2 * Cgamma) * (q : ℝ) ^ 4 * (|s.im| + 2) ^ 12 := by
        ring
      _ ≤ (3 * Cgamma) * (q : ℝ) ^ 12 * (|s.im| + 2) ^ 12 := by
        exact mul_le_mul_of_nonneg_right
          (mul_le_mul (by nlinarith) hqpowFour (pow_nonneg hq0 4)
            (by positivity))
          (pow_nonneg hT0 12)
      _ = (3 * Cgamma) * ((q : ℝ) * (|s.im| + 2)) ^ 12 := by
        rw [mul_pow]
        ring
  · have hreflected := norm_LFunction_farRight_le_three chi⁻¹ (1 - s) (by
      simp only [sub_re, one_re]
      linarith)
    have hqpow :
        (q : ℝ) ^ ((1 : ℝ) / 2 - s.re) ≤ (q : ℝ) ^ (11 : ℕ) := by
      rw [← Real.rpow_natCast]
      exact Real.rpow_le_rpow_of_exponent_le hq1 (by linarith)
    have hqpowstep : (q : ℝ) ^ 11 ≤ (q : ℝ) ^ 12 := by
      rw [pow_succ]
      exact le_mul_of_one_le_right (pow_nonneg hq0 11) hq1
    have hTpowstep : (|s.im| + 2) ^ 11 ≤ (|s.im| + 2) ^ 12 := by
      rw [pow_succ]
      exact le_mul_of_one_le_right (pow_nonneg hT0 11) hT1
    calc
      (q : ℝ) ^ ((1 : ℝ) / 2 - s.re) *
            ‖DirichletCharacter.LFunction chi⁻¹ (1 - s)‖ *
          ‖DirichletCharacter.gammaFactor chi⁻¹ (1 - s) /
            DirichletCharacter.gammaFactor chi s‖ ≤
          (q : ℝ) ^ 11 * 3 * (Cgamma * (|s.im| + 2) ^ 11) := by
        gcongr
      _ = (3 * Cgamma) * (q : ℝ) ^ 11 * (|s.im| + 2) ^ 11 := by
        ring
      _ ≤ (3 * Cgamma) * (q : ℝ) ^ 12 * (|s.im| + 2) ^ 12 := by
        exact mul_le_mul
          (mul_le_mul_of_nonneg_left hqpowstep (by positivity)) hTpowstep
          (pow_nonneg hT0 11) (by positivity)
      _ = (3 * Cgamma) * ((q : ℝ) * (|s.im| + 2)) ^ 12 := by
        rw [mul_pow]
        ring

section PrimitiveLFunctionFixedStrip
theorem natCast_le_four_pow (n : ℕ) : (n : ℝ) ≤ 4 ^ n := by
  exact_mod_cast (Nat.lt_pow_self (n := n) (a := 4) (by omega)).le

end PrimitiveLFunctionFixedStrip

theorem exists_norm_LFunction_fixedStrip_le_pow :
    ∃ A : ℕ, 12 ≤ A ∧
      ∀ (q : ℕ) [NeZero q], 1 < q →
        ∀ (chi : DirichletCharacter ℂ q), chi.IsPrimitive →
          ∀ s : ℂ, -(10 : ℝ) ≤ s.re → s.re ≤ (1 / 2 : ℝ) →
            ‖DirichletCharacter.LFunction chi s‖ ≤
              ((q : ℝ) * (|s.im| + 2)) ^ A := by
  obtain ⟨C, _hCpos, hC⟩ :=
    exists_norm_LFunction_fixedStrip_le_const_mul_pow_twelve
  obtain ⟨n : ℕ, hn⟩ := exists_nat_ge C
  refine ⟨n + 12, by omega, ?_⟩
  intro q _ hq chi hchi s hslo hshi
  have hq2 : (2 : ℝ) ≤ q := by exact_mod_cast hq
  have hT2 : (2 : ℝ) ≤ |s.im| + 2 := by linarith [abs_nonneg s.im]
  have hbase4 : (4 : ℝ) ≤ (q : ℝ) * (|s.im| + 2) := by
    nlinarith
  have hbase0 : (0 : ℝ) ≤ (q : ℝ) * (|s.im| + 2) :=
    zero_le_four.trans hbase4
  have hCbase : C ≤ ((q : ℝ) * (|s.im| + 2)) ^ n := by
    calc
      C ≤ (n : ℝ) := hn
      _ ≤ 4 ^ n := natCast_le_four_pow n
      _ ≤ ((q : ℝ) * (|s.im| + 2)) ^ n :=
        pow_le_pow_left₀ (by norm_num) hbase4 n
  calc
    ‖DirichletCharacter.LFunction chi s‖ ≤
        C * ((q : ℝ) * (|s.im| + 2)) ^ 12 :=
      hC q hq chi hchi s hslo hshi
    _ ≤ ((q : ℝ) * (|s.im| + 2)) ^ n *
        ((q : ℝ) * (|s.im| + 2)) ^ 12 :=
      mul_le_mul_of_nonneg_right hCbase (pow_nonneg hbase0 12)
    _ = ((q : ℝ) * (|s.im| + 2)) ^ (n + 12) := by
      rw [pow_add]

end

section
open Complex

section PrimitiveLFunctionRadiusTwelve
theorem radiusTwelveSphere_geometry
    (t : ℝ) (z : ℂ)
    (hz : z ∈ sphere ((2 : ℂ) + t * I) 12) :
    -(10 : ℝ) ≤ z.re ∧ z.re ≤ 14 ∧
      |z.im| + 2 ≤ 7 * (|t| + 2) := by
  have hdist : ‖z - ((2 : ℂ) + t * I)‖ = 12 := by
    simpa [mem_sphere, Complex.dist_eq] using hz
  have hre : |z.re - 2| ≤ 12 := by
    simpa using (Complex.abs_re_le_norm (z - ((2 : ℂ) + t * I))).trans hdist.le
  have him : |z.im - t| ≤ 12 := by
    simpa using (Complex.abs_im_le_norm (z - ((2 : ℂ) + t * I))).trans hdist.le
  have hi := (abs_add_le (z.im - t) t).trans (add_le_add him (le_refl |t|))
  rw [sub_add_cancel] at hi
  obtain ⟨hrelo, hrehi⟩ := abs_le.mp hre
  refine ⟨?_, ?_, ?_⟩ <;> linarith only [hrelo, hrehi, hi, abs_nonneg t]

end PrimitiveLFunctionRadiusTwelve

theorem exists_nat_norm_LFunction_radiusTwelveSphere_le :
    ∃ E : ℕ, 36 ≤ E ∧
      ∀ (q : ℕ) [NeZero q], 1 < q →
        ∀ (chi : DirichletCharacter ℂ q), chi.IsPrimitive →
          ∀ (t : ℝ) (z : ℂ),
            z ∈ sphere ((2 : ℂ) + t * I) 12 →
              ‖DirichletCharacter.LFunction chi z‖ ≤
                ((q : ℝ) * (|t| + 2)) ^ E := by
  obtain ⟨A, hA, hstrip⟩ := exists_norm_LFunction_fixedStrip_le_pow
  refine ⟨3 * A, by omega, ?_⟩
  intro q _ hq chi hchi t z hz
  obtain ⟨hzlo, _hzhi, hzheight⟩ := radiusTwelveSphere_geometry t z hz
  let B : ℝ := (q : ℝ) * (|t| + 2)
  have hq2 : (2 : ℝ) ≤ q := by exact_mod_cast hq
  have hq1 : (1 : ℝ) ≤ q := one_le_two.trans hq2
  have hq0 : (0 : ℝ) ≤ q := zero_le_one.trans hq1
  have hqpos : (0 : ℝ) < q := zero_lt_one.trans_le hq1
  have hT2 : (2 : ℝ) ≤ |t| + 2 := by linarith [abs_nonneg t]
  have hT1 : (1 : ℝ) ≤ |t| + 2 := one_le_two.trans hT2
  have hB4 : (4 : ℝ) ≤ B := by
    dsimp [B]
    nlinarith
  have hB1 : (1 : ℝ) ≤ B := by linarith
  have hB0 : (0 : ℝ) ≤ B := zero_le_one.trans hB1
  have hqB : (q : ℝ) ≤ B := by
    calc
      (q : ℝ) = (q : ℝ) * 1 := by ring
      _ ≤ (q : ℝ) * (|t| + 2) :=
        mul_le_mul_of_nonneg_left hT1 hq0
      _ = B := rfl
  by_cases hleft : z.re ≤ (1 / 2 : ℝ)
  · have hzT0 : (0 : ℝ) ≤ |z.im| + 2 := by positivity
    have hlocal : (q : ℝ) * (|z.im| + 2) ≤ B ^ 3 := by
      calc
        (q : ℝ) * (|z.im| + 2) ≤
            (q : ℝ) * (7 * (|t| + 2)) :=
          mul_le_mul_of_nonneg_left hzheight hq0
        _ = 7 * B := by simp [B]; ring
        _ ≤ B ^ 2 * B := by
          apply mul_le_mul_of_nonneg_right _ hB0
          nlinarith [sq_nonneg B]
        _ = B ^ 3 := by ring
    calc
      ‖DirichletCharacter.LFunction chi z‖ ≤
          ((q : ℝ) * (|z.im| + 2)) ^ A :=
        hstrip q hq chi hchi z hzlo hleft
      _ ≤ (B ^ 3) ^ A :=
        pow_le_pow_left₀ (mul_nonneg hq0 hzT0) hlocal A
      _ = B ^ (3 * A) := by rw [pow_mul]
  · have hhalf : (1 / 2 : ℝ) ≤ z.re := le_of_not_ge hleft
    by_cases hcentral : z.re ≤ 2
    · have hcentralBound := norm_LFunction_centralStrip_le hq chi hchi
          (sigma := z.re) (t := z.im) hhalf hcentral
      have hzarg : (((z.re : ℝ) : ℂ) + ((z.im : ℝ) : ℂ) * I) = z := by
        apply Complex.ext <;> simp
      rw [hzarg] at hcentralBound
      have hsqrt : Real.sqrt (q : ℝ) ≤ q :=
        Real.sqrt_le_self_iff.mpr (Or.inr hq1)
      have hlog : Real.log (q : ℝ) ≤ q :=
        (Real.log_le_sub_one_of_pos hqpos).trans
          (sub_le_self _ zero_le_one)
      have h14 : (14 : ℝ) ≤ B ^ 2 := by
        nlinarith [sq_nonneg B]
      have hcentralPower :
          2 * (|z.im| + 2) * Real.sqrt (q : ℝ) * Real.log (q : ℝ) ≤
            B ^ 4 := by
        calc
          2 * (|z.im| + 2) * Real.sqrt (q : ℝ) * Real.log (q : ℝ) ≤
              2 * (7 * (|t| + 2)) * (q : ℝ) * (q : ℝ) := by
            gcongr
          _ = 14 * (q : ℝ) * B := by simp [B]; ring
          _ ≤ 14 * B * B := by gcongr
          _ = 14 * B ^ 2 := by ring
          _ ≤ B ^ 2 * B ^ 2 :=
            mul_le_mul_of_nonneg_right h14 (sq_nonneg B)
          _ = B ^ 4 := by ring
      calc
        ‖DirichletCharacter.LFunction chi z‖ ≤
            2 * (|z.im| + 2) * Real.sqrt (q : ℝ) * Real.log (q : ℝ) :=
          hcentralBound
        _ ≤ B ^ 4 := hcentralPower
        _ ≤ B ^ (3 * A) :=
          pow_le_pow_right₀ hB1 (by omega)
    · have hfar : (2 : ℝ) ≤ z.re := le_of_not_ge hcentral
      have hfarBound := norm_LFunction_farRight_le_three chi z hfar
      have hBpow : B ≤ B ^ (3 * A) := by
        calc
          B = B ^ 1 := by simp
          _ ≤ B ^ (3 * A) := pow_le_pow_right₀ hB1 (by omega)
      exact hfarBound.trans (le_trans (by linarith) hBpow)

theorem exists_nat_norm_LFunction_radiusTwelveSphere_le_exp_mul_center :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ (q : ℕ) [NeZero q], 1 < q →
        ∀ (chi : DirichletCharacter ℂ q), chi.IsPrimitive →
          ∀ (t : ℝ) (z : ℂ),
            z ∈ sphere ((2 : ℂ) + t * I) 12 →
              ‖DirichletCharacter.LFunction chi z‖ ≤
                Real.exp
                    ((A : ℝ) * Real.log ((q : ℝ) * (|t| + 2))) *
                  ‖DirichletCharacter.LFunction chi ((2 : ℂ) + t * I)‖ := by
  obtain ⟨E, hE, habsolute⟩ :=
    exists_nat_norm_LFunction_radiusTwelveSphere_le
  refine ⟨E + 1, by omega, ?_⟩
  intro q _ hq chi hchi t z hz
  let c : ℂ := (2 : ℂ) + t * I
  let B : ℝ := (q : ℝ) * (|t| + 2)
  have hq2 : (2 : ℝ) ≤ q := by exact_mod_cast hq
  have hT2 : (2 : ℝ) ≤ |t| + 2 := by linarith [abs_nonneg t]
  have hB4 : (4 : ℝ) ≤ B := by
    dsimp [B]
    nlinarith
  have hBpos : (0 : ℝ) < B := zero_lt_four.trans_le hB4
  have hc : DirichletCharacter.LFunction chi c ≠ 0 := by
    have hc_re : 1 < c.re := by simp [c]
    rw [DirichletCharacter.LFunction_eq_LSeries chi hc_re]
    exact DirichletCharacter.LSeries_ne_zero_of_one_lt_re chi hc_re
  have hinv : ‖(DirichletCharacter.LFunction chi c)⁻¹‖ ≤ 3 := by
    simpa [c] using norm_inv_LFunction_two_add_mul_I_le_three chi t
  have hone_center :
      (1 : ℝ) ≤ 3 * ‖DirichletCharacter.LFunction chi c‖ := by
    calc
      (1 : ℝ) = ‖(DirichletCharacter.LFunction chi c)⁻¹ *
          DirichletCharacter.LFunction chi c‖ := by
        rw [inv_mul_cancel₀ hc, norm_one]
      _ = ‖(DirichletCharacter.LFunction chi c)⁻¹‖ *
          ‖DirichletCharacter.LFunction chi c‖ := norm_mul _ _
      _ ≤ 3 * ‖DirichletCharacter.LFunction chi c‖ :=
        mul_le_mul_of_nonneg_right hinv (norm_nonneg _)
  have hone_base_center :
      (1 : ℝ) ≤ B * ‖DirichletCharacter.LFunction chi c‖ := by
    exact hone_center.trans
      (mul_le_mul_of_nonneg_right (by linarith) (norm_nonneg _))
  have habs : ‖DirichletCharacter.LFunction chi z‖ ≤ B ^ E := by
    simpa [B, c] using habsolute q hq chi hchi t z hz
  have hexp :
      Real.exp (((E + 1 : ℕ) : ℝ) * Real.log B) = B ^ (E + 1) := by
    rw [Real.exp_nat_mul, Real.exp_log hBpos]
  calc
    ‖DirichletCharacter.LFunction chi z‖ ≤ B ^ E := habs
    _ = B ^ E * 1 := by ring
    _ ≤ B ^ E * (B * ‖DirichletCharacter.LFunction chi c‖) :=
      mul_le_mul_of_nonneg_left hone_base_center (pow_nonneg hBpos.le E)
    _ = B ^ (E + 1) * ‖DirichletCharacter.LFunction chi c‖ := by
      rw [pow_succ]
      ring
    _ = Real.exp (((E + 1 : ℕ) : ℝ) * Real.log B) *
        ‖DirichletCharacter.LFunction chi c‖ := by rw [hexp]
    _ = Real.exp
          (((E + 1 : ℕ) : ℝ) *
            Real.log ((q : ℝ) * (|t| + 2))) *
        ‖DirichletCharacter.LFunction chi ((2 : ℂ) + t * I)‖ := by
      rfl

end

section
open Asymptotics Complex Filter Set

section RiemannZetaAbel
/--
The complex-valued fractional-part function on `(1, ∞)`, extended by zero on its complement,
used in the Abel representation of zeta.
-/
noncomputable def zetaFractionalTail (u : ℝ) : ℂ :=
  (Ioi (1 : ℝ)).indicator (fun x : ℝ => ((Int.fract x : ℝ) : ℂ)) u

/--
The Mellin transform of the truncated fractional-part function at `-s`, giving the tail term in
the Abel continuation of zeta.
-/
noncomputable def zetaFractionalMellin (s : ℂ) : ℂ :=
  mellin zetaFractionalTail (-s)

theorem measurable_zetaFractionalTail :
    Measurable zetaFractionalTail :=
  (Complex.continuous_ofReal.measurable.comp measurable_fract).indicator
    measurableSet_Ioi

theorem norm_zetaFractionalTail_le_one (u : ℝ) :
    ‖zetaFractionalTail u‖ ≤ 1 := by
  by_cases hu : 1 < u
  · simpa [zetaFractionalTail, hu, Complex.norm_real, Real.norm_eq_abs,
      Int.abs_fract] using
      (Int.fract_lt_one u).le
  · simp [zetaFractionalTail, hu]

theorem locallyIntegrable_zetaFractionalTail :
    LocallyIntegrable zetaFractionalTail := by
  refine (locallyIntegrable_const (1 : ℂ)).mono
    measurable_zetaFractionalTail.aestronglyMeasurable ?_
  filter_upwards with u
  simpa using norm_zetaFractionalTail_le_one u

theorem zetaFractionalTail_isBigO_atTop :
    zetaFractionalTail =O[atTop] (fun _ : ℝ => (1 : ℝ)) := by
  refine isBigO_iff.mpr ⟨1, Eventually.of_forall fun u => ?_⟩
  simpa using norm_zetaFractionalTail_le_one u

theorem zetaFractionalTail_isBigO_nhdsGT_zero (b : ℝ) :
    zetaFractionalTail =O[𝓝[>] 0] (fun u : ℝ => u ^ (-b)) := by
  have hsmall : ∀ᶠ u : ℝ in 𝓝[>] 0, u < 1 :=
    Eventually.filter_mono nhdsWithin_le_nhds (Iio_mem_nhds zero_lt_one)
  refine isBigO_iff.mpr ⟨1, ?_⟩
  filter_upwards [hsmall] with u hu
  simp [zetaFractionalTail, not_lt.mpr hu.le]

theorem mellinConvergent_zetaFractionalTail
    {s : ℂ} (hs : 0 < s.re) :
    MellinConvergent zetaFractionalTail (-s) := by
  refine mellinConvergent_of_isBigO_rpow
    (a := 0) (b := (-s).re - 1)
    (locallyIntegrable_zetaFractionalTail.locallyIntegrableOn (Ioi 0))
    (by simpa using zetaFractionalTail_isBigO_atTop) ?_
    (zetaFractionalTail_isBigO_nhdsGT_zero ((-s).re - 1)) ?_
  · simpa using hs
  · linarith

theorem differentiableAt_zetaFractionalMellin
    {s : ℂ} (hs : 0 < s.re) :
    DifferentiableAt ℂ zetaFractionalMellin s := by
  have hMellin : DifferentiableAt ℂ (mellin zetaFractionalTail) (-s) := by
    refine mellin_differentiableAt_of_isBigO_rpow
      (a := 0) (b := (-s).re - 1)
      (locallyIntegrable_zetaFractionalTail.locallyIntegrableOn (Ioi 0))
      (by simpa using zetaFractionalTail_isBigO_atTop) ?_
      (zetaFractionalTail_isBigO_nhdsGT_zero ((-s).re - 1)) ?_
    · simpa using hs
    · linarith
  exact hMellin.comp s differentiableAt_id.neg

theorem zetaFractionalMellin_eq_integral (s : ℂ) :
    zetaFractionalMellin s =
      ∫ u in Ioi (1 : ℝ),
        (((Int.fract u : ℝ) : ℂ) * (u : ℂ) ^ (-(s + 1))) := by
  rw [zetaFractionalMellin, mellin]
  simp only [smul_eq_mul]
  calc
    (∫ u : ℝ in Ioi 0,
        (u : ℂ) ^ (-s - 1) * zetaFractionalTail u) =
        ∫ u : ℝ in Ioi 0, (Ioi (1 : ℝ)).indicator
          (fun x : ℝ =>
            (x : ℂ) ^ (-s - 1) * ((Int.fract x : ℝ) : ℂ)) u := by
      refine setIntegral_congr_fun measurableSet_Ioi fun u _ => ?_
      by_cases hu : 1 < u <;> simp [zetaFractionalTail, hu]
    _ = ∫ u : ℝ in Ioi (0 : ℝ) ∩ Ioi 1,
        (u : ℂ) ^ (-s - 1) * ((Int.fract u : ℝ) : ℂ) := by
      rw [setIntegral_indicator measurableSet_Ioi]
    _ = ∫ u : ℝ in Ioi 1,
        (u : ℂ) ^ (-s - 1) * ((Int.fract u : ℝ) : ℂ) := by
      rw [Ioi_inter_Ioi, max_eq_right zero_le_one]
    _ = ∫ u : ℝ in Ioi 1,
        ((Int.fract u : ℝ) : ℂ) * (u : ℂ) ^ (-(s + 1)) := by
      refine setIntegral_congr_fun measurableSet_Ioi fun u _ => ?_
      rw [show -s - 1 = -(s + 1) by ring, mul_comm]

theorem norm_zetaFractionalMellin_le
    {s : ℂ} (hs : 0 < s.re) :
    ‖zetaFractionalMellin s‖ ≤ 1 / s.re := by
  rw [zetaFractionalMellin_eq_integral]
  have hmajorant : IntegrableOn
      (fun u : ℝ => u ^ (-(s.re + 1))) (Ioi 1) :=
    integrableOn_Ioi_rpow_of_lt (by linarith) zero_lt_one
  have hconvergent := mellinConvergent_zetaFractionalTail hs
  rw [MellinConvergent] at hconvergent
  have hrestricted :=
    hconvergent.mono_set (Ioi_subset_Ioi zero_le_one)
  have hintegrable : IntegrableOn
      (fun u : ℝ =>
        ((Int.fract u : ℝ) : ℂ) * (u : ℂ) ^ (-(s + 1)))
      (Ioi 1) := by
    refine hrestricted.congr_fun ?_ measurableSet_Ioi
    intro u hu
    simp only [smul_eq_mul]
    rw [zetaFractionalTail, indicator_of_mem hu, mul_comm]
    congr 1
    ring_nf
  have hbound : ∀ᵐ (u : ℝ) ∂volume.restrict (Ioi 1),
      ‖((Int.fract u : ℝ) : ℂ) * (u : ℂ) ^ (-(s + 1))‖ ≤
        u ^ (-(s.re + 1)) := by
    filter_upwards [ae_restrict_mem measurableSet_Ioi] with u hu
    rw [norm_mul,
      Complex.norm_cpow_eq_rpow_re_of_pos (zero_lt_one.trans hu)]
    simp only [neg_re, add_re, one_re, Complex.norm_real, Real.norm_eq_abs,
      Int.abs_fract]
    exact mul_le_of_le_one_left
      (Real.rpow_nonneg (zero_lt_one.trans hu).le _)
      (Int.fract_lt_one u).le
  calc
    ‖∫ u : ℝ in Ioi 1,
        ((Int.fract u : ℝ) : ℂ) * (u : ℂ) ^ (-(s + 1))‖ ≤
        ∫ u : ℝ in Ioi 1,
          ‖((Int.fract u : ℝ) : ℂ) * (u : ℂ) ^ (-(s + 1))‖ :=
      norm_integral_le_integral_norm _
    _ ≤ ∫ u : ℝ in Ioi 1, u ^ (-(s.re + 1)) :=
      setIntegral_mono_ae_restrict hintegrable.norm hmajorant hbound
    _ = 1 / s.re := by
      rw [integral_Ioi_rpow_of_lt (by linarith) zero_lt_one, Real.one_rpow]
      field_simp [hs.ne']
      ring

theorem unit_partialSums_isBigO :
    (fun n : ℕ => ∑ _k ∈ Finset.Icc 1 n, (1 : ℝ)) =O[atTop]
      (fun n : ℕ => (n : ℝ) ^ (1 : ℝ)) := by
  simpa [Nat.card_Icc] using
    (isBigO_refl (fun n : ℕ => (n : ℝ)) atTop)

theorem riemannZeta_eq_pole_sub_mellin
    {s : ℂ} (hs : 1 < s.re) :
    riemannZeta s = s / (s - 1) - s * zetaFractionalMellin s := by
  have hseries :
      riemannZeta s =
        s * ∫ u : ℝ in Ioi 1,
          (∑ k ∈ Finset.Icc 1 ⌊u⌋₊, (1 : ℂ)) *
            (u : ℂ) ^ (-(s + 1)) := by
    have h := LSeries_eq_mul_integral_of_nonneg
      (fun _ : ℕ => (1 : ℝ)) (r := 1) zero_le_one hs
      unit_partialSums_isBigO (fun _ => zero_le_one)
    calc
      riemannZeta s = LSeries (1 : ℕ → ℂ) s :=
        (LSeries_one_eq_riemannZeta hs).symm
      _ = LSeries (fun _ : ℕ => ((1 : ℝ) : ℂ)) s := by
        apply LSeries_congr
        simp
      _ = s * ∫ u : ℝ in Ioi 1,
          (∑ k ∈ Finset.Icc 1 ⌊u⌋₊, (1 : ℂ)) *
            (u : ℂ) ^ (-(s + 1)) := by simpa using h
  have hfloor :
      (∫ u : ℝ in Ioi 1,
          (∑ k ∈ Finset.Icc 1 ⌊u⌋₊, (1 : ℂ)) *
            (u : ℂ) ^ (-(s + 1))) =
        ∫ u : ℝ in Ioi 1,
          ((u : ℂ) - ((Int.fract u : ℝ) : ℂ)) *
            (u : ℂ) ^ (-(s + 1)) := by
    refine setIntegral_congr_fun measurableSet_Ioi fun u hu => ?_
    have hu0 : 0 ≤ u := (zero_lt_one.trans hu).le
    have hfloorReal : (⌊u⌋₊ : ℝ) = u - Int.fract u := by
      rw [natCast_floor_eq_intCast_floor hu0]
      linarith [Int.floor_add_fract u]
    simp only [Finset.sum_const, nsmul_eq_mul, Nat.card_Icc,
      Nat.add_sub_cancel, mul_one]
    rw [← Complex.ofReal_natCast, hfloorReal, Complex.ofReal_sub]
  rw [hfloor] at hseries
  have hpure : IntegrableOn
      (fun u : ℝ => (u : ℂ) ^ (-s)) (Ioi 1) :=
    integrableOn_Ioi_cpow_of_lt (by simpa using hs) zero_lt_one
  have hfrac : IntegrableOn
      (fun u : ℝ => ((Int.fract u : ℝ) : ℂ) *
        (u : ℂ) ^ (-(s + 1))) (Ioi 1) := by
    have hconv := mellinConvergent_zetaFractionalTail (zero_lt_one.trans hs)
    rw [MellinConvergent] at hconv
    have hrestrict := hconv.mono_set (Ioi_subset_Ioi zero_le_one)
    refine hrestrict.congr_fun ?_ measurableSet_Ioi
    intro u hu
    simp only [smul_eq_mul]
    rw [zetaFractionalTail, indicator_of_mem hu, mul_comm]
    congr 1
    ring_nf
  have hpoint : ∀ u ∈ Ioi (1 : ℝ),
      ((u : ℂ) - ((Int.fract u : ℝ) : ℂ)) *
          (u : ℂ) ^ (-(s + 1)) =
        (u : ℂ) ^ (-s) -
          ((Int.fract u : ℝ) : ℂ) * (u : ℂ) ^ (-(s + 1)) := by
    intro u hu
    rw [sub_mul]
    congr 2
    have hu0 : (u : ℂ) ≠ 0 :=
      Complex.ofReal_ne_zero.mpr (zero_lt_one.trans hu).ne'
    calc
      (u : ℂ) * (u : ℂ) ^ (-(s + 1)) =
          (u : ℂ) ^ 1 * (u : ℂ) ^ (-(s + 1)) := by rw [cpow_one]
      _ = (u : ℂ) ^ (1 + -(s + 1)) := (cpow_add _ _ hu0).symm
      _ = (u : ℂ) ^ (-s) := by congr 1; ring
  have hintegral :
      (∫ u : ℝ in Ioi 1,
          ((u : ℂ) - ((Int.fract u : ℝ) : ℂ)) *
            (u : ℂ) ^ (-(s + 1))) =
        (∫ u : ℝ in Ioi 1, (u : ℂ) ^ (-s)) -
          ∫ u : ℝ in Ioi 1,
            ((Int.fract u : ℝ) : ℂ) *
              (u : ℂ) ^ (-(s + 1)) := by
    rw [← integral_sub hpure hfrac]
    exact setIntegral_congr_fun measurableSet_Ioi hpoint
  rw [hintegral,
    integral_Ioi_cpow_of_lt (by simpa using hs) zero_lt_one,
    Complex.ofReal_one, one_cpow, ← zetaFractionalMellin_eq_integral] at hseries
  have hpole : -1 / (-s + 1) = 1 / (s - 1) := by
    rw [show -s + 1 = -(s - 1) by ring, div_neg]
    ring
  calc
    riemannZeta s = s * (-1 / (-s + 1) - zetaFractionalMellin s) := hseries
    _ = s / (s - 1) - s * zetaFractionalMellin s := by
      rw [hpole]
      ring

end RiemannZetaAbel

theorem riemannZeta₁_eq_abelIntegral
    (s : ℂ) (hs : 0 < s.re) :
    riemannZeta₁ s =
      s - s * (s - 1) *
        ∫ u in Set.Ioi (1 : ℝ),
          (((Int.fract u : ℝ) : ℂ) *
            (u : ℂ) ^ (-(s + 1))) := by
  let U : Set ℂ := {z | 0 < z.re}
  let rhs : ℂ → ℂ := fun z =>
    z - z * (z - 1) * zetaFractionalMellin z
  have hUopen : IsOpen U := isOpen_lt continuous_const continuous_re
  have hleft : AnalyticOnNhd ℂ riemannZeta₁ U :=
    differentiable_riemannZeta₁.differentiableOn.analyticOnNhd hUopen
  have hright : AnalyticOnNhd ℂ rhs U := by
    refine DifferentiableOn.analyticOnNhd (fun z hz => ?_) hUopen
    exact (differentiableAt_id.sub
      ((differentiableAt_id.mul (differentiableAt_id.sub_const 1)).mul
        (differentiableAt_zetaFractionalMellin hz))).differentiableWithinAt
  have heq : Set.EqOn riemannZeta₁ rhs U := by
    refine hleft.eqOn_of_preconnected_of_eventuallyEq hright
      (convex_halfSpace_re_gt 0).isPreconnected
      (show (2 : ℂ) ∈ U by simp [U]) ?_
    refine eventually_of_mem
      ((isOpen_lt continuous_const continuous_re).mem_nhds
        (show 1 < (2 : ℂ).re by norm_num)) ?_
    intro z hz
    have hz1 : z ≠ 1 := by
      intro h
      subst z
      norm_num at hz
    have hfactor : riemannZeta₁ z = (z - 1) * riemannZeta z := by
      rw [riemannZeta_eq_inv_sub_mul hz1]
      field_simp
    rw [hfactor, riemannZeta_eq_pole_sub_mellin hz]
    dsimp [rhs]
    field_simp
  rw [heq hs]
  dsimp [rhs]
  rw [zetaFractionalMellin_eq_integral]

theorem norm_riemannZeta₁_le_abel
    (s : ℂ) (hs : 0 < s.re) :
    ‖riemannZeta₁ s‖ ≤
      ‖s‖ + ‖s‖ * ‖s - 1‖ / s.re := by
  rw [riemannZeta₁_eq_abelIntegral s hs,
    ← zetaFractionalMellin_eq_integral]
  calc
    ‖s - s * (s - 1) * zetaFractionalMellin s‖ ≤
        ‖s‖ + ‖s * (s - 1) * zetaFractionalMellin s‖ := norm_sub_le _ _
    _ = ‖s‖ + ‖s‖ * ‖s - 1‖ * ‖zetaFractionalMellin s‖ := by
      rw [norm_mul, norm_mul]
    _ ≤ ‖s‖ + ‖s‖ * ‖s - 1‖ * (1 / s.re) := by
      gcongr
      exact norm_zetaFractionalMellin_le hs
    _ = ‖s‖ + ‖s‖ * ‖s - 1‖ / s.re := by ring

end

section
open Complex Set

section RiemannZetaRadiusFour
theorem even_one_mod_one :
    (1 : DirichletCharacter ℂ 1).Even := by
  rw [DirichletCharacter.Even]
  exact map_one _

theorem radiusFourSphere_geometry
    (t : ℝ) (z : ℂ)
    (hz : z ∈ sphere ((2 : ℂ) + t * I) 4) :
    -(2 : ℝ) ≤ z.re ∧ z.re ≤ 6 ∧
      |z.im| + 2 ≤ 3 * (|t| + 2) ∧
        ‖z‖ ≤ 3 * (|t| + 2) := by
  have hdist : ‖z - ((2 : ℂ) + t * I)‖ = 4 := by
    simpa [mem_sphere, Complex.dist_eq] using hz
  have hre : |z.re - 2| ≤ 4 := by
    simpa using (Complex.abs_re_le_norm (z - ((2 : ℂ) + t * I))).trans hdist.le
  have him : |z.im - t| ≤ 4 := by
    simpa using (Complex.abs_im_le_norm (z - ((2 : ℂ) + t * I))).trans hdist.le
  have hi := (abs_add_le (z.im - t) t).trans (add_le_add him (le_refl |t|))
  rw [sub_add_cancel] at hi
  have hn := norm_le_of_mem_closedBall (sphere_subset_closedBall hz)
  have hc : ‖(2 : ℂ) + t * I‖ ≤ 2 + |t| := by
    simpa [Real.norm_eq_abs] using norm_add_le (2 : ℂ) ((t : ℂ) * I)
  obtain ⟨hrelo, hrehi⟩ := abs_le.mp hre
  refine ⟨?_, ?_, ?_, ?_⟩ <;>
    linarith only [hrelo, hrehi, hi, hn, hc, abs_nonneg t]

theorem exists_pos_norm_riemannZeta₁_closedBall_one_le :
    ∃ C : ℝ, 0 < C ∧ ∀ z ∈ closedBall (0 : ℂ) 1,
      ‖riemannZeta₁ z‖ ≤ C := by
  have hball : IsCompact (closedBall (0 : ℂ) 1) :=
    isCompact_closedBall (0 : ℂ) 1
  obtain ⟨C, hC⟩ := hball.exists_bound_of_continuousOn
    differentiable_riemannZeta₁.continuous.continuousOn
  refine ⟨max C 0 + 1, by linarith [le_max_right C 0], ?_⟩
  intro z hz
  exact (hC z hz).trans (by linarith [le_max_left C 0])

theorem natCast_le_two_pow (n : ℕ) : (n : ℝ) ≤ 2 ^ n := by
  exact_mod_cast (Nat.lt_two_pow_self (n := n)).le

end RiemannZetaRadiusFour

theorem riemannZeta₁_eq_reflection_of_re_le
    (s : ℂ) (hs0 : s ≠ 0) (hs : s.re ≤ (1 / 2 : ℝ)) :
    riemannZeta₁ s =
      (1 - s) / s * riemannZeta₁ (1 - s) *
        (DirichletCharacter.gammaFactor
            (1 : DirichletCharacter ℂ 1) (1 - s) /
          DirichletCharacter.gammaFactor
            (1 : DirichletCharacter ℂ 1) s) := by
  have hs1 : s ≠ 1 := by
    intro h
    subst s
    norm_num at hs
  have hreflect0 : 1 - s ≠ 0 := sub_ne_zero.mpr hs1.symm
  have hGammaReflect : Gammaℝ (1 - s) ≠ 0 :=
    Gammaℝ_ne_zero_of_re_pos (by simp; linarith)
  have hGammaR :
      riemannZeta₁ s =
        (1 - s) / s * riemannZeta₁ (1 - s) *
          (Gammaℝ (1 - s) / Gammaℝ s) := by
    by_cases hGamma : Gammaℝ s = 0
    · obtain ⟨n, hn⟩ := Gammaℝ_eq_zero_iff.mp hGamma
      have hn0 : n ≠ 0 := by
        intro hn0
        subst n
        exact hs0 (by simpa using hn)
      obtain ⟨k, rfl⟩ := Nat.exists_eq_succ_of_ne_zero hn0
      have hzeta : riemannZeta (-(2 * ((k + 1 : ℕ) : ℂ))) = 0 := by
        simpa [Nat.cast_add, Nat.cast_one] using
          riemannZeta_neg_two_mul_nat_add_one k
      have harg1 : -(2 * ((k + 1 : ℕ) : ℂ)) ≠ 1 := by
        intro h
        have hreal := congrArg Complex.re h
        norm_num at hreal
        have hk : (0 : ℝ) ≤ k := Nat.cast_nonneg k
        nlinarith
      have hsub : -(2 * ((k + 1 : ℕ) : ℂ)) - 1 ≠ 0 :=
        sub_ne_zero.mpr harg1
      have hfactor := riemannZeta_eq_inv_sub_mul harg1
      rw [hzeta] at hfactor
      have hinv : (-(2 * ((k + 1 : ℕ) : ℂ)) - 1)⁻¹ ≠ 0 :=
        inv_ne_zero hsub
      have hzeta1 : riemannZeta₁ (-(2 * ((k + 1 : ℕ) : ℂ))) = 0 :=
        (mul_eq_zero.mp hfactor.symm).resolve_left hinv
      have hden : Gammaℝ (-(2 * ((k + 1 : ℕ) : ℂ))) = 0 := by
        simpa [hn] using hGamma
      rw [hn, hzeta1, hden]
      simp
    · have hreflected :
          completedRiemannZeta (1 - s) =
            riemannZeta (1 - s) * Gammaℝ (1 - s) := by
        symm
        exact (eq_div_iff hGammaReflect).mp
          (riemannZeta_def_of_ne_zero hreflect0)
      have hzeta :
          riemannZeta s =
            riemannZeta (1 - s) * Gammaℝ (1 - s) / Gammaℝ s := by
        rw [riemannZeta_def_of_ne_zero hs0,
          ← completedRiemannZeta_one_sub s, hreflected]
      have hreg : riemannZeta₁ s = (s - 1) * riemannZeta s := by
        rw [riemannZeta_eq_inv_sub_mul hs1]
        field_simp
      have hreflect1 : 1 - s ≠ 1 := by
        intro h
        apply hs0
        linear_combination -h
      have hregReflect :
          riemannZeta₁ (1 - s) =
            ((1 - s) - 1) * riemannZeta (1 - s) := by
        rw [riemannZeta_eq_inv_sub_mul hreflect1]
        field_simp
      rw [hreg, hzeta, hregReflect]
      field_simp [hs0, hGamma]
      ring
  rw [even_one_mod_one.gammaFactor_def, even_one_mod_one.gammaFactor_def]
  exact hGammaR

theorem exists_nat_norm_riemannZeta₁_radiusFourSphere_le :
    ∃ E : ℕ, 1 ≤ E ∧
      ∀ (t : ℝ) (z : ℂ),
        z ∈ sphere ((2 : ℂ) + t * I) 4 →
          ‖riemannZeta₁ z‖ ≤ (|t| + 2) ^ E := by
  obtain ⟨Ccompact, hCcompact, hcompact⟩ :=
    exists_pos_norm_riemannZeta₁_closedBall_one_le
  obtain ⟨Cgamma, hCgamma, hgamma⟩ :=
    exists_norm_gammaFactor_ratio_fixedStrip_le
  let K : ℝ := max Ccompact (4 * Cgamma * 3 ^ 11)
  obtain ⟨n : ℕ, hn⟩ := exists_nat_ge K
  refine ⟨n + 19, by omega, ?_⟩
  intro t z hz
  obtain ⟨hzlo, hzhi, hzheight, hznorm⟩ :=
    radiusFourSphere_geometry t z hz
  let T : ℝ := |t| + 2
  have hT2 : (2 : ℝ) ≤ T := by dsimp [T]; linarith [abs_nonneg t]
  have hT1 : (1 : ℝ) ≤ T := one_le_two.trans hT2
  have hT0 : (0 : ℝ) ≤ T := zero_le_one.trans hT1
  have hzsub : ‖z - 1‖ ≤ 4 * T := by
    calc
      ‖z - 1‖ ≤ ‖z‖ + ‖(1 : ℂ)‖ := norm_sub_le _ _
      _ ≤ 3 * T + 1 := add_le_add (by simpa [T] using hznorm) (by norm_num)
      _ ≤ 4 * T := by linarith
  have hKpow : K ≤ T ^ n := by
    calc
      K ≤ (n : ℝ) := hn
      _ ≤ 2 ^ n := natCast_le_two_pow n
      _ ≤ T ^ n := pow_le_pow_left₀ (by norm_num) hT2 n
  by_cases hright : (1 / 2 : ℝ) ≤ z.re
  · have habel := norm_riemannZeta₁_le_abel z (by linarith)
    have hrightBound : ‖riemannZeta₁ z‖ ≤ T ^ 7 := by
      calc
        ‖riemannZeta₁ z‖ ≤ ‖z‖ + ‖z‖ * ‖z - 1‖ / z.re := habel
        _ ≤ 3 * T + (3 * T) * (4 * T) / (1 / 2 : ℝ) := by
          gcongr
        _ = 3 * T + 24 * T ^ 2 := by ring
        _ ≤ T ^ 7 := by
          have hT5 : (32 : ℝ) ≤ T ^ 5 := by
            have h := pow_le_pow_left₀ (by norm_num : (0 : ℝ) ≤ 2) hT2 5
            norm_num at h
            exact h
          have hT7 : 32 * T ^ 2 ≤ T ^ 7 := by
            calc
              32 * T ^ 2 ≤ T ^ 5 * T ^ 2 :=
                mul_le_mul_of_nonneg_right hT5 (sq_nonneg T)
              _ = T ^ 7 := by ring
          nlinarith [sq_nonneg T]
    exact hrightBound.trans (pow_le_pow_right₀ hT1 (by omega))
  · have hzleft : z.re ≤ (1 / 2 : ℝ) := le_of_not_ge hright
    by_cases hzsmall : ‖z‖ ≤ 1
    · have hzball : z ∈ closedBall (0 : ℂ) 1 := by
        simpa [mem_closedBall, dist_zero_right] using hzsmall
      have hC : Ccompact ≤ K := le_max_left _ _
      calc
        ‖riemannZeta₁ z‖ ≤ Ccompact := hcompact z hzball
        _ ≤ K := hC
        _ ≤ T ^ n := hKpow
        _ ≤ T ^ (n + 19) := pow_le_pow_right₀ hT1 (by omega)
    · have hz0 : z ≠ 0 := by
        intro h
        subst z
        simp at hzsmall
      have hreflect := riemannZeta₁_eq_reflection_of_re_le z hz0 hzleft
      have hreflectRe : (1 / 2 : ℝ) ≤ (1 - z).re := by simp; linarith
      have hreflectNorm : ‖1 - z‖ ≤ 4 * T := by
        calc
          ‖1 - z‖ = ‖z - 1‖ := by
            rw [show 1 - z = -(z - 1) by ring, norm_neg]
          _ ≤ 4 * T := hzsub
      have hreflectSub : ‖(1 - z) - 1‖ ≤ 3 * T := by
        simpa only [sub_sub_cancel_left, norm_neg] using
          (show ‖z‖ ≤ 3 * T by simpa [T] using hznorm)
      have hreflectAbel := norm_riemannZeta₁_le_abel (1 - z) (by linarith)
      have hreflectBound : ‖riemannZeta₁ (1 - z)‖ ≤ T ^ 7 := by
        calc
          ‖riemannZeta₁ (1 - z)‖ ≤
              ‖1 - z‖ + ‖1 - z‖ * ‖(1 - z) - 1‖ / (1 - z).re :=
            hreflectAbel
          _ ≤ 4 * T + (4 * T) * (3 * T) / (1 / 2 : ℝ) := by
            gcongr
          _ = 4 * T + 24 * T ^ 2 := by ring
          _ ≤ T ^ 7 := by
            have hT5 : (32 : ℝ) ≤ T ^ 5 := by
              have h := pow_le_pow_left₀ (by norm_num : (0 : ℝ) ≤ 2) hT2 5
              norm_num at h
              exact h
            have hT7 : 32 * T ^ 2 ≤ T ^ 7 := by
              calc
                32 * T ^ 2 ≤ T ^ 5 * T ^ 2 :=
                  mul_le_mul_of_nonneg_right hT5 (sq_nonneg T)
                _ = T ^ 7 := by ring
            nlinarith [sq_nonneg T]
      have hratio : ‖(1 - z) / z‖ ≤ 4 * T := by
        rw [norm_div]
        have hzOne : (1 : ℝ) ≤ ‖z‖ := le_of_not_ge hzsmall
        exact (div_le_iff₀ (norm_pos_iff.mpr hz0)).2 (by
          calc
            ‖1 - z‖ ≤ 4 * T := hreflectNorm
            _ ≤ 4 * T * ‖z‖ := by
              exact le_mul_of_one_le_right (by positivity) hzOne)
      have hgamma' := hgamma 1 (1 : DirichletCharacter ℂ 1) z
        (by linarith) hzleft
      have hgammaBound :
          ‖DirichletCharacter.gammaFactor
                (1 : DirichletCharacter ℂ 1)⁻¹ (1 - z) /
              DirichletCharacter.gammaFactor
                (1 : DirichletCharacter ℂ 1) z‖ ≤
            Cgamma * (3 * T) ^ 11 := by
        exact hgamma'.trans (mul_le_mul_of_nonneg_left
          (pow_le_pow_left₀ (by positivity) (by simpa [T] using hzheight) 11)
          hCgamma.le)
      have hinvOne : (1 : DirichletCharacter ℂ 1)⁻¹ = 1 := inv_one
      rw [hinvOne] at hgammaBound
      rw [hreflect, norm_mul, norm_mul]
      calc
        ‖(1 - z) / z‖ * ‖riemannZeta₁ (1 - z)‖ *
              ‖DirichletCharacter.gammaFactor
                  (1 : DirichletCharacter ℂ 1) (1 - z) /
                DirichletCharacter.gammaFactor
                  (1 : DirichletCharacter ℂ 1) z‖ ≤
            (4 * T) * T ^ 7 * (Cgamma * (3 * T) ^ 11) := by
          gcongr
        _ = (4 * Cgamma * 3 ^ 11) * T ^ 19 := by ring
        _ ≤ K * T ^ 19 :=
          mul_le_mul_of_nonneg_right (le_max_right _ _) (pow_nonneg hT0 19)
        _ ≤ T ^ n * T ^ 19 :=
          mul_le_mul_of_nonneg_right hKpow (pow_nonneg hT0 19)
        _ = T ^ (n + 19) := by rw [pow_add]

theorem exists_nat_norm_riemannZeta₁_radiusFourSphere_le_exp_mul_center :
    ∃ A : ℕ, 1 ≤ A ∧
      ∀ (t : ℝ) (z : ℂ),
        z ∈ sphere ((2 : ℂ) + t * I) 4 →
          ‖riemannZeta₁ z‖ ≤
            Real.exp ((A : ℝ) * Real.log (|t| + 2)) *
              ‖riemannZeta₁ ((2 : ℂ) + t * I)‖ := by
  obtain ⟨E, hE, habsolute⟩ :=
    exists_nat_norm_riemannZeta₁_radiusFourSphere_le
  refine ⟨E + 2, by omega, ?_⟩
  intro t z hz
  let c : ℂ := (2 : ℂ) + t * I
  let T : ℝ := |t| + 2
  have hT2 : (2 : ℝ) ≤ T := by dsimp [T]; linarith [abs_nonneg t]
  have hTpos : 0 < T := zero_lt_two.trans_le hT2
  have hc1 : c ≠ 1 := by intro h; have := congrArg Complex.re h; simp [c] at this
  have hzeta : riemannZeta c ≠ 0 :=
    riemannZeta_ne_zero_of_one_le_re (by simp [c])
  have hcenter : riemannZeta₁ c = (c - 1) * riemannZeta c := by
    rw [riemannZeta_eq_inv_sub_mul hc1]
    field_simp
  have hcsubNorm : (1 : ℝ) ≤ ‖c - 1‖ := by
    rw [show c - 1 = (1 : ℂ) + t * I by dsimp [c]; ring]
    have hre := Complex.abs_re_le_norm ((1 : ℂ) + t * I)
    simpa using hre
  have hcsubInv : ‖(c - 1)⁻¹‖ ≤ 1 := by
    rw [norm_inv]
    exact inv_le_one₀ (norm_pos_iff.mpr (sub_ne_zero.mpr hc1)) |>.2 hcsubNorm
  have hzetaInv : ‖(riemannZeta c)⁻¹‖ ≤ 3 := by
    have h := norm_inv_LFunction_two_add_mul_I_le_three
      (1 : DirichletCharacter ℂ 1) t
    simpa [DirichletCharacter.LFunction_modOne_eq, c] using h
  have hcenterInv : ‖(riemannZeta₁ c)⁻¹‖ ≤ 3 := by
    rw [hcenter, mul_inv_rev, norm_mul]
    nlinarith [mul_le_mul hcsubInv hzetaInv (norm_nonneg _)
      (by norm_num : (0 : ℝ) ≤ 1)]
  have hcenterNe : riemannZeta₁ c ≠ 0 := by
    rw [hcenter]
    exact mul_ne_zero (sub_ne_zero.mpr hc1) hzeta
  have honeCenter : (1 : ℝ) ≤ 3 * ‖riemannZeta₁ c‖ := by
    calc
      (1 : ℝ) = ‖(riemannZeta₁ c)⁻¹ * riemannZeta₁ c‖ := by
        rw [inv_mul_cancel₀ hcenterNe, norm_one]
      _ = ‖(riemannZeta₁ c)⁻¹‖ * ‖riemannZeta₁ c‖ := norm_mul _ _
      _ ≤ 3 * ‖riemannZeta₁ c‖ :=
        mul_le_mul_of_nonneg_right hcenterInv (norm_nonneg _)
  have hTcenter : (1 : ℝ) ≤ T ^ 2 * ‖riemannZeta₁ c‖ := by
    exact honeCenter.trans (mul_le_mul_of_nonneg_right
      (by nlinarith [sq_nonneg T]) (norm_nonneg _))
  have habs : ‖riemannZeta₁ z‖ ≤ T ^ E := by
    simpa [T, c] using habsolute t z (by simpa [c] using hz)
  have hexp : Real.exp (((E + 2 : ℕ) : ℝ) * Real.log T) = T ^ (E + 2) := by
    rw [Real.exp_nat_mul, Real.exp_log hTpos]
  calc
    ‖riemannZeta₁ z‖ ≤ T ^ E := habs
    _ = T ^ E * 1 := by ring
    _ ≤ T ^ E * (T ^ 2 * ‖riemannZeta₁ c‖) :=
      mul_le_mul_of_nonneg_left hTcenter (pow_nonneg hTpos.le E)
    _ = T ^ (E + 2) * ‖riemannZeta₁ c‖ := by rw [pow_add]; ring
    _ = Real.exp (((E + 2 : ℕ) : ℝ) * Real.log T) *
        ‖riemannZeta₁ c‖ := by rw [hexp]
    _ = Real.exp (((E + 2 : ℕ) : ℝ) * Real.log (|t| + 2)) *
        ‖riemannZeta₁ ((2 : ℂ) + t * I)‖ := rfl

theorem exists_nat_finsum_divisor_LFunction_radiusSix_le :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ (q : ℕ) [NeZero q], 1 < q →
        ∀ (chi : DirichletCharacter ℂ q), chi.IsPrimitive →
          ∀ t : ℝ,
            ((∑ᶠ rho : ℂ,
                MeromorphicOn.divisor
                  (DirichletCharacter.LFunction chi)
                  (closedBall ((2 : ℂ) + t * I) 6) rho : ℤ) : ℝ) ≤
              2 * (A : ℝ) *
                Real.log ((q : ℝ) * (|t| + 2)) := by
  obtain ⟨A, hA, hgrowth⟩ :=
    exists_nat_norm_LFunction_radiusTwelveSphere_le_exp_mul_center
  refine ⟨A, hA, ?_⟩
  intro q _ hq chi hchi t
  let c : ℂ := (2 : ℂ) + t * I
  let B : ℝ := (q : ℝ) * (|t| + 2)
  let K : ℝ := (A : ℝ) * Real.log B
  let M : ℝ :=
    Real.exp K * ‖DirichletCharacter.LFunction chi c‖
  have hq2 : (2 : ℝ) ≤ q := by
    exact_mod_cast hq
  have hT2 : (2 : ℝ) ≤ |t| + 2 := by
    linarith [abs_nonneg t]
  have hB4 : (4 : ℝ) ≤ B := by
    dsimp [B]
    nlinarith
  have hBpos : 0 < B := zero_lt_four.trans_le hB4
  have hB1 : 1 ≤ B := by linarith
  have hc : DirichletCharacter.LFunction chi c ≠ 0 := by
    have hc_re : 1 < c.re := by simp [c]
    rw [DirichletCharacter.LFunction_eq_LSeries chi hc_re]
    exact DirichletCharacter.LSeries_ne_zero_of_one_lt_re chi hc_re
  have hinv : ‖(DirichletCharacter.LFunction chi c)⁻¹‖ ≤ 3 := by
    simpa [c] using norm_inv_LFunction_two_add_mul_I_le_three chi t
  have hone_center :
      (1 : ℝ) ≤ 3 * ‖DirichletCharacter.LFunction chi c‖ := by
    calc
      (1 : ℝ) = ‖(DirichletCharacter.LFunction chi c)⁻¹ *
          DirichletCharacter.LFunction chi c‖ := by
        rw [inv_mul_cancel₀ hc, norm_one]
      _ = ‖(DirichletCharacter.LFunction chi c)⁻¹‖ *
          ‖DirichletCharacter.LFunction chi c‖ := norm_mul _ _
      _ ≤ 3 * ‖DirichletCharacter.LFunction chi c‖ :=
        mul_le_mul_of_nonneg_right hinv (norm_nonneg _)
  have hBexp : B ≤ Real.exp K := by
    have hexp : Real.exp K = B ^ A := by
      dsimp [K]
      rw [Real.exp_nat_mul, Real.exp_log hBpos]
    rw [hexp]
    calc
      B = B ^ 1 := by ring
      _ ≤ B ^ A := pow_le_pow_right₀ hB1 (by omega)
  have hM : 1 ≤ M := by
    calc
      (1 : ℝ) ≤ 3 * ‖DirichletCharacter.LFunction chi c‖ :=
        hone_center
      _ ≤ B * ‖DirichletCharacter.LFunction chi c‖ := by
        gcongr
        linarith
      _ ≤ Real.exp K * ‖DirichletCharacter.LFunction chi c‖ :=
        mul_le_mul_of_nonneg_right hBexp (norm_nonneg _)
      _ = M := rfl
  have hf : AnalyticOnNhd ℂ
      (DirichletCharacter.LFunction chi) (closedBall c |(12 : ℝ)|) :=
    fun z _ =>
      (DirichletCharacter.differentiable_LFunction
        (character_ne_one_of_isPrimitive hq chi hchi)).analyticAt z
  have hbound : ∀ z ∈ sphere c |(12 : ℝ)|,
      ‖DirichletCharacter.LFunction chi z‖ ≤ M := by
    intro z hz
    simpa [M, K, B, c] using
      hgrowth q hq chi hchi t z (by simpa using hz)
  have hjensen := hf.sum_divisor_le
    (r := (6 : ℝ)) (R := (12 : ℝ)) (M := M)
    (by norm_num) (by norm_num) hM hc hbound
  rw [show |(6 : ℝ)| = 6 by norm_num] at hjensen
  norm_num at hjensen
  have hratio :
      M / ‖DirichletCharacter.LFunction chi c‖ = Real.exp K := by
    dsimp [M]
    exact mul_div_cancel_right₀ _ (norm_ne_zero_iff.mpr hc)
  have hKnonneg : 0 ≤ K :=
    mul_nonneg (Nat.cast_nonneg A) (Real.log_nonneg hB1)
  have hlog2 : (1 / 2 : ℝ) < Real.log 2 := by
    linarith [Real.log_two_gt_d9]
  have hquot : K / Real.log 2 ≤ 2 * K := by
    apply (div_le_iff₀ (lt_trans (by norm_num) hlog2)).2
    nlinarith
  calc
    ((∑ᶠ rho : ℂ,
        MeromorphicOn.divisor
          (DirichletCharacter.LFunction chi)
          (closedBall ((2 : ℂ) + t * I) 6) rho : ℤ) : ℝ) ≤
        Real.log (M / ‖DirichletCharacter.LFunction chi c‖) /
          Real.log 2 := by
            simpa [c] using hjensen
    _ = K / Real.log 2 := by rw [hratio, Real.log_exp]
    _ ≤ 2 * K := hquot
    _ = 2 * (A : ℝ) *
        Real.log ((q : ℝ) * (|t| + 2)) := by
      simp [K, B]
      ring

theorem exists_nat_finsum_divisor_riemannZeta₁_radiusThree_le :
    ∃ A : ℕ, 1 ≤ A ∧
      ∀ t : ℝ,
        ((∑ᶠ rho : ℂ,
            MeromorphicOn.divisor riemannZeta₁
              (closedBall ((2 : ℂ) + t * I) 3) rho : ℤ) : ℝ) ≤
          12 * (A : ℝ) * Real.log (|t| + 2) := by
  obtain ⟨A, hA, hgrowth⟩ :=
    exists_nat_norm_riemannZeta₁_radiusFourSphere_le_exp_mul_center
  refine ⟨A, hA, ?_⟩
  intro t
  let c : ℂ := (2 : ℂ) + t * I
  let T : ℝ := |t| + 2
  let K : ℝ := (A : ℝ) * Real.log T
  let M : ℝ := 3 * Real.exp K * ‖riemannZeta₁ c‖
  have hT2 : (2 : ℝ) ≤ T := by
    dsimp [T]
    linarith [abs_nonneg t]
  have hT1 : 1 ≤ T := by linarith
  have hc1 : c ≠ 1 := by
    intro h
    have hre := congrArg Complex.re h
    simp [c] at hre
  have hzeta : riemannZeta c ≠ 0 :=
    riemannZeta_ne_zero_of_one_le_re (by simp [c])
  have hcenter : riemannZeta₁ c = (c - 1) * riemannZeta c := by
    rw [riemannZeta_eq_inv_sub_mul hc1]
    field_simp
  have hcsubNorm : (1 : ℝ) ≤ ‖c - 1‖ := by
    rw [show c - 1 = (1 : ℂ) + t * I by dsimp [c]; ring]
    have hre := Complex.abs_re_le_norm ((1 : ℂ) + t * I)
    simpa using hre
  have hcsubInv : ‖(c - 1)⁻¹‖ ≤ 1 := by
    rw [norm_inv]
    exact inv_le_one₀ (norm_pos_iff.mpr (sub_ne_zero.mpr hc1)) |>.2
      hcsubNorm
  have hzetaInv : ‖(riemannZeta c)⁻¹‖ ≤ 3 := by
    have h := norm_inv_LFunction_two_add_mul_I_le_three
      (1 : DirichletCharacter ℂ 1) t
    simpa [DirichletCharacter.LFunction_modOne_eq, c] using h
  have hcenterInv : ‖(riemannZeta₁ c)⁻¹‖ ≤ 3 := by
    rw [hcenter, mul_inv_rev, norm_mul]
    nlinarith [mul_le_mul hcsubInv hzetaInv (norm_nonneg _)
      (by norm_num : (0 : ℝ) ≤ 1)]
  have hc : riemannZeta₁ c ≠ 0 := by
    rw [hcenter]
    exact mul_ne_zero (sub_ne_zero.mpr hc1) hzeta
  have honeCenter : (1 : ℝ) ≤ 3 * ‖riemannZeta₁ c‖ := by
    calc
      (1 : ℝ) = ‖(riemannZeta₁ c)⁻¹ * riemannZeta₁ c‖ := by
        rw [inv_mul_cancel₀ hc, norm_one]
      _ = ‖(riemannZeta₁ c)⁻¹‖ * ‖riemannZeta₁ c‖ := norm_mul _ _
      _ ≤ 3 * ‖riemannZeta₁ c‖ :=
        mul_le_mul_of_nonneg_right hcenterInv (norm_nonneg _)
  have hKnonneg : 0 ≤ K :=
    mul_nonneg (Nat.cast_nonneg A) (Real.log_nonneg hT1)
  have hexp1 : 1 ≤ Real.exp K := by
    simpa using Real.exp_monotone hKnonneg
  have hthree : (3 : ℝ) ≤ 3 * Real.exp K := by nlinarith
  have hM : 1 ≤ M := by
    calc
      (1 : ℝ) ≤ 3 * ‖riemannZeta₁ c‖ := honeCenter
      _ ≤ (3 * Real.exp K) * ‖riemannZeta₁ c‖ :=
        mul_le_mul_of_nonneg_right hthree (norm_nonneg _)
      _ = M := by ring
  have hf : AnalyticOnNhd ℂ riemannZeta₁
      (closedBall c |(4 : ℝ)|) :=
    fun z _ => differentiable_riemannZeta₁.analyticAt z
  have hbound : ∀ z ∈ sphere c |(4 : ℝ)|,
      ‖riemannZeta₁ z‖ ≤ M := by
    intro z hz
    calc
      ‖riemannZeta₁ z‖ ≤ Real.exp K * ‖riemannZeta₁ c‖ := by
        simpa [K, T, c] using hgrowth t z (by simpa using hz)
      _ ≤ (3 * Real.exp K) * ‖riemannZeta₁ c‖ := by
        apply mul_le_mul_of_nonneg_right _ (norm_nonneg _)
        nlinarith [Real.exp_pos K]
      _ = M := by ring
  have hjensen := hf.sum_divisor_le
    (r := (3 : ℝ)) (R := (4 : ℝ)) (M := M)
    (by norm_num) (by norm_num) hM hc hbound
  rw [show |(3 : ℝ)| = 3 by norm_num] at hjensen
  norm_num at hjensen
  have hratio : M / ‖riemannZeta₁ c‖ = 3 * Real.exp K := by
    dsimp [M]
    exact mul_div_cancel_right₀ _ (norm_ne_zero_iff.mpr hc)
  have hlogRatio :
      Real.log (M / ‖riemannZeta₁ c‖) = Real.log 3 + K := by
    rw [hratio, Real.log_mul (by norm_num : (3 : ℝ) ≠ 0)
      (Real.exp_ne_zero K), Real.log_exp]
  have hlog43 : (1 / 4 : ℝ) < Real.log ((4 : ℝ) / 3) := by
    rw [Real.log_div (by norm_num : (4 : ℝ) ≠ 0)
      (by norm_num : (3 : ℝ) ≠ 0), Real.log_four_eq]
    nlinarith [Real.log_two_gt_d9, Real.log_three_lt_d9]
  have hquot :
      (Real.log 3 + K) / Real.log ((4 : ℝ) / 3) ≤
        4 * (Real.log 3 + K) := by
    have hsum0 : 0 ≤ Real.log 3 + K :=
      add_nonneg (Real.log_nonneg (by norm_num)) hKnonneg
    apply (div_le_iff₀ (lt_trans (by norm_num) hlog43)).2
    nlinarith
  have hlog3 : Real.log 3 ≤ 2 * K := by
    have hlogT : Real.log 2 ≤ Real.log T :=
      Real.log_le_log (by norm_num) hT2
    have hlog2K : Real.log 2 ≤ K := by
      calc
        Real.log 2 ≤ Real.log T := hlogT
        _ ≤ (A : ℝ) * Real.log T := by
          have hlogT0 := Real.log_nonneg hT1
          have hAreal : (1 : ℝ) ≤ A := by exact_mod_cast hA
          nlinarith
        _ = K := rfl
    nlinarith [Real.log_two_gt_d9, Real.log_three_lt_d9]
  calc
    ((∑ᶠ rho : ℂ,
        MeromorphicOn.divisor riemannZeta₁
          (closedBall ((2 : ℂ) + t * I) 3) rho : ℤ) : ℝ) ≤
        Real.log (M / ‖riemannZeta₁ c‖) /
          Real.log ((4 : ℝ) / 3) := by
            simpa [c] using hjensen
    _ = (Real.log 3 + K) / Real.log ((4 : ℝ) / 3) := by
      rw [hlogRatio]
    _ ≤ 4 * (Real.log 3 + K) := hquot
    _ ≤ 12 * K := by nlinarith
    _ = 12 * (A : ℝ) * Real.log (|t| + 2) := by
      simp [K, T]
      ring

theorem one_le_riemannZetaHorizontalLogScale
    {T : ℝ} (hT : 2 ≤ T) :
    (1 : ℝ) ≤ Real.log (T + 2) := by
  have hscale : (4 : ℝ) ≤ T + 2 := by linarith
  have hlogFour : (1 : ℝ) < Real.log 4 := by
    rw [Real.log_four_eq]
    nlinarith [Real.log_two_gt_d9]
  exact hlogFour.le.trans (Real.log_le_log (by norm_num) hscale)

end

section DivisorSupportCardinality
theorem cast_ncard_support_le_finsum
    {α : Type*} (f : α → ℤ) (hf : (Function.support f).Finite)
    (hone : ∀ x ∈ Function.support f, 1 ≤ f x) :
    ((Function.support f).ncard : ℝ) ≤
      ((∑ᶠ x : α, f x : ℤ) : ℝ) := by
  rw [Set.ncard_eq_toFinset_card _ hf, finsum_eq_sum f hf]
  have hb := Finset.card_nsmul_le_sum hf.toFinset f (1 : ℤ)
    (fun x hx => hone x (hf.mem_toFinset.mp hx))
  simpa only [nsmul_eq_mul, mul_one, Int.cast_natCast] using
    (Int.cast_le (R := ℝ)).mpr hb

end DivisorSupportCardinality

theorem cast_ncard_support_divisor_le_finsum
    {𝕜 : Type*} [NontriviallyNormedField 𝕜]
    {E : Type*} [NormedAddCommGroup E] [NormedSpace 𝕜 E]
    {f : 𝕜 → E} {K : Set 𝕜}
    (hf : AnalyticOnNhd 𝕜 f K) (hK : IsCompact K) :
    ((MeromorphicOn.divisor f K).support.ncard : ℝ) ≤
      ((∑ᶠ z : 𝕜, MeromorphicOn.divisor f K z : ℤ) : ℝ) := by
  refine cast_ncard_support_le_finsum _
    (hf.meromorphicOn.divisor_support_finite_of_subset hK Set.Subset.rfl) ?_
  intro z hz
  have hnonneg : 0 ≤ MeromorphicOn.divisor f K z :=
    MeromorphicOn.AnalyticOnNhd.divisor_nonneg hf z
  have hne : MeromorphicOn.divisor f K z ≠ 0 := Function.mem_support.mp hz
  omega

section
open Complex Set

theorem exists_nat_ncard_support_divisor_LFunction_radiusSix_le :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ (q : ℕ) [NeZero q], 1 < q →
        ∀ (chi : DirichletCharacter ℂ q), chi.IsPrimitive →
          ∀ t : ℝ,
            ((MeromorphicOn.divisor
                (DirichletCharacter.LFunction chi)
                (closedBall ((2 : ℂ) + t * I) 6)).support.ncard : ℝ) ≤
              2 * (A : ℝ) *
                Real.log ((q : ℝ) * (|t| + 2)) := by
  obtain ⟨A, hA, hmass⟩ :=
    exists_nat_finsum_divisor_LFunction_radiusSix_le
  refine ⟨A, hA, ?_⟩
  intro q _ hq chi hchi t
  let U : Set ℂ := closedBall ((2 : ℂ) + t * I) 6
  have hchiOne : chi ≠ 1 := character_ne_one_of_isPrimitive hq chi hchi
  have hanalytic : AnalyticOnNhd ℂ
      (DirichletCharacter.LFunction chi) U :=
    fun z _ =>
      (DirichletCharacter.differentiable_LFunction hchiOne).analyticAt z
  calc
    ((MeromorphicOn.divisor
        (DirichletCharacter.LFunction chi)
        (closedBall ((2 : ℂ) + t * I) 6)).support.ncard : ℝ) ≤
      ((∑ᶠ rho : ℂ,
        MeromorphicOn.divisor (DirichletCharacter.LFunction chi) U rho : ℤ) : ℝ) := by
      simpa [U] using cast_ncard_support_divisor_le_finsum hanalytic
        (isCompact_closedBall ((2 : ℂ) + t * I) 6)
    _ ≤ 2 * (A : ℝ) * Real.log ((q : ℝ) * (|t| + 2)) := by
      simpa [U] using hmass q hq chi hchi t

theorem exists_nat_ncard_support_divisor_riemannZeta₁_radiusThree_le :
    ∃ A : ℕ, 1 ≤ A ∧
      ∀ t : ℝ,
        ((MeromorphicOn.divisor riemannZeta₁
            (closedBall ((2 : ℂ) + t * I) 3)).support.ncard : ℝ) ≤
          12 * (A : ℝ) * Real.log (|t| + 2) := by
  obtain ⟨A, hA, hmass⟩ :=
    exists_nat_finsum_divisor_riemannZeta₁_radiusThree_le
  refine ⟨A, hA, ?_⟩
  intro t
  let U : Set ℂ := closedBall ((2 : ℂ) + t * I) 3
  have hanalytic : AnalyticOnNhd ℂ riemannZeta₁ U :=
    fun z _ => differentiable_riemannZeta₁.analyticAt z
  calc
    ((MeromorphicOn.divisor riemannZeta₁
        (closedBall ((2 : ℂ) + t * I) 3)).support.ncard : ℝ) ≤
      ((∑ᶠ rho : ℂ,
        MeromorphicOn.divisor riemannZeta₁ U rho : ℤ) : ℝ) := by
      simpa [U] using cast_ncard_support_divisor_le_finsum hanalytic
        (isCompact_closedBall ((2 : ℂ) + t * I) 3)
    _ ≤ 12 * (A : ℝ) * Real.log (|t| + 2) := by
      simpa [U] using hmass t

end

section
open Complex

section InducingEulerProductLocalDivisorMass
theorem three_fourths_le_norm_inducingEulerFactor_center
    {d : ℕ} (psi : DirichletCharacter ℂ d)
    (p : ℕ) (hp : p.Prime) (t : ℝ) :
    (3 / 4 : ℝ) ≤
      ‖(1 : ℂ) - psi p * (p : ℂ) ^
        (-((2 : ℂ) + t * I))‖ := by
  let w : ℂ := psi p * (p : ℂ) ^ (-((2 : ℂ) + t * I))
  change (3 / 4 : ℝ) ≤ ‖(1 : ℂ) - w‖
  have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast hp.two_le
  have hpow : (p : ℝ) ^ (-2 : ℝ) ≤ (1 / 4 : ℝ) := by
    calc
      (p : ℝ) ^ (-2 : ℝ) ≤ (2 : ℝ) ^ (-2 : ℝ) :=
        Real.rpow_le_rpow_of_nonpos (by norm_num) hp2 (by norm_num)
      _ = (1 / 4 : ℝ) := by
        rw [Real.rpow_neg (by norm_num), Real.rpow_two]
        norm_num
  have hterm : ‖w‖ ≤ (1 / 4 : ℝ) := by
    dsimp only [w]
    rw [norm_mul, Complex.norm_natCast_cpow_of_pos hp.pos, neg_re]
    calc
      ‖psi p‖ * (p : ℝ) ^ (-((2 : ℂ) + t * I).re) ≤
          1 * (p : ℝ) ^ (-((2 : ℂ) + t * I).re) :=
        mul_le_mul_of_nonneg_right (psi.norm_le_one p)
          (Real.rpow_nonneg (Nat.cast_nonneg p) _)
      _ = (p : ℝ) ^ (-2 : ℝ) := by simp
      _ ≤ (1 / 4 : ℝ) := hpow
  have hreverse : (1 : ℝ) - ‖w‖ ≤ ‖(1 : ℂ) - w‖ := by
    simpa using norm_sub_norm_le (1 : ℂ) w
  linarith

theorem norm_inducingEulerFactor_sphere_le_cube_mul_center
    {d : ℕ} (psi : DirichletCharacter ℂ d)
    (p : ℕ) (hp : p.Prime) (t : ℝ) {z : ℂ}
    (hz : z ∈ sphere ((2 : ℂ) + t * I) 4) :
    ‖(1 : ℂ) - psi p * (p : ℂ) ^ (-z)‖ ≤
      (p : ℝ) ^ 3 *
        ‖(1 : ℂ) - psi p * (p : ℂ) ^
          (-((2 : ℂ) + t * I))‖ := by
  let c : ℂ := (2 : ℂ) + t * I
  have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast hp.two_le
  have hp1 : (1 : ℝ) ≤ p := one_le_two.trans hp2
  have hreAbs : |z.re - 2| ≤ 4 := by
    calc
      |z.re - 2| = |(z - c).re| := by simp [c]
      _ ≤ ‖z - c‖ := Complex.abs_re_le_norm _
      _ = dist z c := by rw [Complex.dist_eq]
      _ = 4 := mem_sphere.mp hz
  have hzre : -2 ≤ z.re := by
    have hneg := neg_abs_le (z.re - 2)
    linarith
  have hpow : (p : ℝ) ^ (-z.re) ≤ (p : ℝ) ^ (2 : ℝ) :=
    Real.rpow_le_rpow_of_exponent_le hp1 (by linarith)
  have hterm : ‖psi p * (p : ℂ) ^ (-z)‖ ≤ (p : ℝ) ^ 2 := by
    rw [norm_mul, Complex.norm_natCast_cpow_of_pos hp.pos, neg_re]
    calc
      ‖psi p‖ * (p : ℝ) ^ (-z.re) ≤
          1 * (p : ℝ) ^ (-z.re) :=
        mul_le_mul_of_nonneg_right (psi.norm_le_one p)
          (Real.rpow_nonneg (Nat.cast_nonneg p) _)
      _ ≤ (p : ℝ) ^ (2 : ℝ) := by simpa using hpow
      _ = (p : ℝ) ^ 2 := Real.rpow_two _
  have hpSq4 : (4 : ℝ) ≤ (p : ℝ) ^ 2 := by nlinarith
  have hpoly : (1 : ℝ) + (p : ℝ) ^ 2 ≤
      (3 / 4 : ℝ) * (p : ℝ) ^ 3 := by
    calc
      (1 : ℝ) + (p : ℝ) ^ 2 ≤ (5 / 4 : ℝ) * (p : ℝ) ^ 2 := by
        nlinarith
      _ ≤ ((3 / 4 : ℝ) * (p : ℝ)) * (p : ℝ) ^ 2 :=
        mul_le_mul_of_nonneg_right (by nlinarith) (sq_nonneg _)
      _ = (3 / 4 : ℝ) * (p : ℝ) ^ 3 := by ring
  have hcenter := three_fourths_le_norm_inducingEulerFactor_center
    psi p hp t
  calc
    ‖(1 : ℂ) - psi p * (p : ℂ) ^ (-z)‖ ≤
        ‖(1 : ℂ)‖ + ‖psi p * (p : ℂ) ^ (-z)‖ := norm_sub_le _ _
    _ ≤ (1 : ℝ) + (p : ℝ) ^ 2 := by
      norm_num
      simpa [norm_mul] using hterm
    _ ≤ (3 / 4 : ℝ) * (p : ℝ) ^ 3 := hpoly
    _ ≤ (p : ℝ) ^ 3 *
        ‖(1 : ℂ) - psi p * (p : ℂ) ^
          (-((2 : ℂ) + t * I))‖ := by
      simpa [mul_comm] using
        mul_le_mul_of_nonneg_left hcenter (pow_nonneg (Nat.cast_nonneg p) 3)

end InducingEulerProductLocalDivisorMass

theorem finsum_divisor_inducingEulerProduct_radiusThree_le
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (t : ℝ) :
    ((∑ᶠ rho : ℂ,
        MeromorphicOn.divisor (inducingEulerProduct chi)
          (closedBall ((2 : ℂ) + t * I) 3) rho : ℤ) : ℝ) ≤
      12 * Real.log (q : ℝ) := by
  let c : ℂ := (2 : ℂ) + t * I
  let Q : ℝ := ∏ p ∈ q.primeFactors, (p : ℝ) ^ 3
  let M : ℝ := Q * ‖inducingEulerProduct chi c‖
  have hc : inducingEulerProduct chi c ≠ 0 := by
    apply inducingEulerProduct_ne_zero_of_re_pos chi
    simp [c]
  have hM_eq : M = ∏ p ∈ q.primeFactors,
      (p : ℝ) ^ 3 *
        ‖(1 : ℂ) - chi.primitiveCharacter p *
          (p : ℂ) ^ (-c)‖ := by
    simp only [M, Q, inducingEulerProduct, norm_prod]
    rw [Finset.prod_mul_distrib]
  have hM : 1 ≤ M := by
    rw [hM_eq]
    apply Finset.one_le_prod
    intro p hp
    have hpPrime := Nat.prime_of_mem_primeFactors hp
    have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast hpPrime.two_le
    have hp3 : (8 : ℝ) ≤ (p : ℝ) ^ 3 := by
      have h := pow_le_pow_left₀ (by norm_num : (0 : ℝ) ≤ 2) hp2 3
      norm_num at h ⊢
      exact h
    have hcenter : (3 / 4 : ℝ) ≤
        ‖(1 : ℂ) - chi.primitiveCharacter p *
          (p : ℂ) ^ (-c)‖ := by
      simpa [c] using three_fourths_le_norm_inducingEulerFactor_center
        chi.primitiveCharacter p hpPrime t
    have hmul := mul_le_mul hp3 hcenter
      (by norm_num : (0 : ℝ) ≤ 3 / 4) (by positivity : (0 : ℝ) ≤ (p : ℝ) ^ 3)
    nlinarith
  have hf : AnalyticOnNhd ℂ (inducingEulerProduct chi)
      (closedBall c |(4 : ℝ)|) :=
    fun z _ => (differentiable_inducingEulerProduct chi).analyticAt z
  have hbound : ∀ z ∈ sphere c |(4 : ℝ)|,
      ‖inducingEulerProduct chi z‖ ≤ M := by
    intro z hz
    rw [hM_eq]
    simp only [inducingEulerProduct, norm_prod]
    apply Finset.prod_le_prod
    · intro p hp
      exact norm_nonneg _
    · intro p hp
      exact norm_inducingEulerFactor_sphere_le_cube_mul_center
        chi.primitiveCharacter p (Nat.prime_of_mem_primeFactors hp) t
          (by simpa [c] using hz)
  have hjensen := hf.sum_divisor_le
    (r := (3 : ℝ)) (R := (4 : ℝ)) (M := M)
    (by norm_num) (by norm_num) hM hc hbound
  rw [show |(3 : ℝ)| = 3 by norm_num] at hjensen
  norm_num at hjensen
  have hratio : M / ‖inducingEulerProduct chi c‖ = Q := by
    dsimp [M]
    exact mul_div_cancel_right₀ Q (norm_ne_zero_iff.mpr hc)
  let S : ℝ := ∑ p ∈ q.primeFactors, Real.log p
  have hSnonneg : 0 ≤ S := by
    dsimp [S]
    exact Finset.sum_nonneg fun p hp =>
      Real.log_nonneg (by exact_mod_cast
        (Nat.prime_of_mem_primeFactors hp).one_le)
  have hlogQ : Real.log Q = 3 * S := by
    dsimp [Q, S]
    rw [Finset.prod_pow, Real.log_pow, Real.log_prod]
    · ring
    · intro p hp
      exact_mod_cast (Nat.prime_of_mem_primeFactors hp).ne_zero
  have hSle : S ≤ Real.log (q : ℝ) := by
    let P : ℕ := ∏ p ∈ q.primeFactors, p
    have hPpos : 0 < P := by
      dsimp [P]
      exact Finset.prod_pos fun p hp =>
        (Nat.prime_of_mem_primeFactors hp).pos
    have hPle : P ≤ q :=
      Nat.le_of_dvd (NeZero.pos q)
        (by simpa [P] using Nat.prod_primeFactors_dvd q)
    have hcast : (P : ℝ) =
        ∏ p ∈ q.primeFactors, (p : ℝ) := by
      simp [P]
    have hlogProd :
        Real.log (∏ p ∈ q.primeFactors, (p : ℝ)) = S := by
      dsimp [S]
      rw [Real.log_prod]
      intro p hp
      exact_mod_cast (Nat.prime_of_mem_primeFactors hp).ne_zero
    rw [← hlogProd, ← hcast]
    exact Real.log_le_log (by exact_mod_cast hPpos)
      (by exact_mod_cast hPle)
  have hlogQnonneg : 0 ≤ Real.log Q := by
    rw [hlogQ]
    positivity
  have hlog43 : (1 / 4 : ℝ) < Real.log ((4 : ℝ) / 3) := by
    rw [Real.log_div (by norm_num : (4 : ℝ) ≠ 0)
      (by norm_num : (3 : ℝ) ≠ 0), Real.log_four_eq]
    nlinarith [Real.log_two_gt_d9, Real.log_three_lt_d9]
  have hquot :
      Real.log Q / Real.log ((4 : ℝ) / 3) ≤ 4 * Real.log Q := by
    apply (div_le_iff₀ (lt_trans (by norm_num) hlog43)).2
    nlinarith
  calc
    ((∑ᶠ rho : ℂ,
        MeromorphicOn.divisor (inducingEulerProduct chi)
          (closedBall ((2 : ℂ) + t * I) 3) rho : ℤ) : ℝ) ≤
        Real.log (M / ‖inducingEulerProduct chi c‖) /
          Real.log ((4 : ℝ) / 3) := by
      simpa [c] using hjensen
    _ = Real.log Q / Real.log ((4 : ℝ) / 3) := by rw [hratio]
    _ ≤ 4 * Real.log Q := hquot
    _ = 12 * S := by rw [hlogQ]; ring
    _ ≤ 12 * Real.log (q : ℝ) := by linarith

theorem ncard_support_divisor_inducingEulerProduct_radiusThree_le
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (t : ℝ) :
    ((MeromorphicOn.divisor (inducingEulerProduct chi)
        (closedBall ((2 : ℂ) + t * I) 3)).support.ncard : ℝ) ≤
      12 * Real.log (q : ℝ) := by
  let K : Set ℂ := closedBall ((2 : ℂ) + t * I) 3
  have hanalytic : AnalyticOnNhd ℂ (inducingEulerProduct chi) K :=
    fun z _ => (differentiable_inducingEulerProduct chi).analyticAt z
  calc
    ((MeromorphicOn.divisor (inducingEulerProduct chi)
        (closedBall ((2 : ℂ) + t * I) 3)).support.ncard : ℝ) ≤
        ((∑ᶠ z : ℂ,
          MeromorphicOn.divisor (inducingEulerProduct chi) K z : ℤ) : ℝ) := by
      simpa [K] using cast_ncard_support_divisor_le_finsum hanalytic
        (isCompact_closedBall ((2 : ℂ) + t * I) 3)
    _ ≤ 12 * Real.log (q : ℝ) := by
      simpa [K] using
        finsum_divisor_inducingEulerProduct_radiusThree_le chi t

theorem divisor_LFunction_radiusSix_apply
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    (t : ℝ) (rho : ℂ) :
    MeromorphicOn.divisor (DirichletCharacter.LFunction chi)
        (closedBall ((2 : ℂ) + t * I) 6) rho =
      ((if dist rho ((2 : ℂ) + t * I) ≤ 6 then
          analyticOrderNatAt (DirichletCharacter.LFunction chi) rho
        else 0 : ℕ) : ℤ) := by
  have hchi_ne := character_ne_one_of_isPrimitive hq chi hchi
  by_cases hrho : dist rho ((2 : ℂ) + t * I) ≤ 6
  · rw [ite_eq_left hrho,
      divisor_LFunction_apply_eq_analyticOrderNatAt hchi_ne
        (mem_closedBall.mpr hrho)]
  · rw [ite_eq_right hrho,
      Function.locallyFinsuppWithin.apply_eq_zero_of_notMem _
        (by simpa [mem_closedBall] using hrho)]
    norm_cast

theorem finsum_divisor_LFunction_radiusSix_eq
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    (t : ℝ) (s : ℂ) :
    (∑ᶠ rho : ℂ,
        ((MeromorphicOn.divisor (DirichletCharacter.LFunction chi)
          (closedBall ((2 : ℂ) + t * I) 6)) rho : ℂ) / (s - rho)) =
      ∑ᶠ rho : ℂ,
        ((if dist rho ((2 : ℂ) + t * I) ≤ 6 then
            analyticOrderNatAt (DirichletCharacter.LFunction chi) rho
          else 0 : ℕ) : ℂ) / (s - rho) := by
  apply finsum_congr
  intro rho
  rw [divisor_LFunction_radiusSix_apply hq chi hchi t rho]
  norm_cast

theorem LFunction_zero_re_lt_one_of_isPrimitive
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    {rho : ℂ} (hzero : DirichletCharacter.LFunction chi rho = 0) :
    rho.re < 1 := by
  by_contra hrho
  exact (chi.LFunction_ne_zero_of_one_le_re
    (.inl (character_ne_one_of_isPrimitive hq chi hchi))
    (le_of_not_gt hrho)) hzero

section InducingEulerProductZeroOrdinates
theorem mem_support_divisor_inducingEulerProduct_iff
    {q : ℕ}
    (chi : DirichletCharacter ℂ q) {U : Set ℂ} {s : ℂ} (hsU : s ∈ U) :
    s ∈ (MeromorphicOn.divisor (inducingEulerProduct chi) U).support ↔
      inducingEulerProduct chi s = 0 := by
  have hA : AnalyticOnNhd ℂ (inducingEulerProduct chi) U :=
    fun z _ => (differentiable_inducingEulerProduct chi).analyticAt z
  have htop : analyticOrderAt (inducingEulerProduct chi) s ≠ ⊤ := by
    rw [ne_eq, AnalyticOnNhd.analyticOrderAt_eq_top_iff_eq_zero s
      (fun z => (differentiable_inducingEulerProduct chi).analyticAt z)]
    intro hzeroFunction
    have hzeroTwo : inducingEulerProduct chi (2 : ℂ) = 0 := by
      rw [hzeroFunction]
      rfl
    exact (inducingEulerProduct_ne_zero_of_re_pos chi (by norm_num)) hzeroTwo
  rw [Function.mem_support,
    MeromorphicOn.AnalyticOnNhd.divisor_apply hA hsU]
  lift analyticOrderAt (inducingEulerProduct chi) s to ℕ using htop
    with n hn
  simp only [ENat.map_natCast, WithTop.untop₀_coe]
  constructor
  · intro hnInt
    have hnNat : n ≠ 0 := by exact_mod_cast hnInt
    have horder : analyticOrderAt (inducingEulerProduct chi) s ≠ 0 := by
      rw [← hn]
      exact_mod_cast hnNat
    exact ((differentiable_inducingEulerProduct chi).analyticAt s
      |>.analyticOrderAt_ne_zero).mp horder
  · intro hzero
    have horder : analyticOrderAt (inducingEulerProduct chi) s ≠ 0 :=
      ((differentiable_inducingEulerProduct chi).analyticAt s
        |>.analyticOrderAt_ne_zero).mpr hzero
    rw [← hn] at horder
    exact_mod_cast horder

theorem inducingEulerProduct_ordinate_injective :
    Function.Injective (fun gamma : ℝ => (gamma : ℂ) * I) := by
  intro gamma delta h
  have him := congrArg Complex.im h
  simpa using him

theorem inducingEulerProductZeroOrdinates_mapsTo_divisorSupport
    {q : ℕ}
    (chi : DirichletCharacter ℂ q) (t : ℝ) :
    Set.MapsTo (fun gamma : ℝ => (gamma : ℂ) * I)
      (({pntOrdinate |
          inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
            |pntOrdinate - (t)| ≤ 1}))
      (MeromorphicOn.divisor (inducingEulerProduct chi)
        (closedBall ((2 : ℂ) + t * I) 3)).support := by
  intro gamma hgamma
  rcases hgamma with ⟨hzero, hheight⟩
  have hmem : (gamma : ℂ) * I ∈ closedBall ((2 : ℂ) + t * I) 3 :=
    inducingEulerProduct_zero_mem_closedBall_radiusThree chi t hzero
      (by simpa using hheight)
  exact (mem_support_divisor_inducingEulerProduct_iff chi hmem).2 hzero

theorem support_divisor_inducingEulerProduct_radiusThree_finite
    {q : ℕ}
    (chi : DirichletCharacter ℂ q) (t : ℝ) :
    (MeromorphicOn.divisor (inducingEulerProduct chi)
      (closedBall ((2 : ℂ) + t * I) 3)).support.Finite := by
  have hA : AnalyticOnNhd ℂ (inducingEulerProduct chi)
      (closedBall ((2 : ℂ) + t * I) 3) :=
    fun z _ => (differentiable_inducingEulerProduct chi).analyticAt z
  exact hA.meromorphicOn.divisor_support_finite_of_subset
    (isCompact_closedBall ((2 : ℂ) + t * I) 3) Set.Subset.rfl

end InducingEulerProductZeroOrdinates

theorem inducingEulerProductZeroOrdinatesInUnitWindow_finite
    {q : ℕ}
    (chi : DirichletCharacter ℂ q) (t : ℝ) :
    (({pntOrdinate : ℝ |
        inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
          |pntOrdinate - (t)| ≤ 1})).Finite :=
  Set.Finite.of_injOn
    (inducingEulerProductZeroOrdinates_mapsTo_divisorSupport chi t)
    inducingEulerProduct_ordinate_injective.injOn
    (support_divisor_inducingEulerProduct_radiusThree_finite chi t)

theorem ncard_inducingEulerProductZeroOrdinatesInUnitWindow_le
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (t : ℝ) :
    ((({pntOrdinate : ℝ |
         inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
           |pntOrdinate - (t)| ≤ 1})).ncard : ℝ) ≤
      12 * Real.log (q : ℝ) := by
  have hnat :
      (({pntOrdinate : ℝ |
          inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
            |pntOrdinate - (t)| ≤ 1})).ncard ≤
        (MeromorphicOn.divisor (inducingEulerProduct chi)
          (closedBall ((2 : ℂ) + t * I) 3)).support.ncard :=
    Set.ncard_le_ncard_of_injOn
      (fun gamma : ℝ => (gamma : ℂ) * I)
      (inducingEulerProductZeroOrdinates_mapsTo_divisorSupport chi t)
      inducingEulerProduct_ordinate_injective.injOn
      (support_divisor_inducingEulerProduct_radiusThree_finite chi t)
  have hreal :
      ((({pntOrdinate : ℝ |
           inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
             |pntOrdinate - (t)| ≤ 1})).ncard : ℝ) ≤
        ((MeromorphicOn.divisor (inducingEulerProduct chi)
          (closedBall ((2 : ℂ) + t * I) 3)).support.ncard : ℝ) := by
    exact_mod_cast hnat
  exact hreal.trans
    (ncard_support_divisor_inducingEulerProduct_radiusThree_le chi t)

end

section
open Complex Set

section DirichletTwoSidedBadHeights
attribute [local instance] inducingEulerProductConductorNeZero

end DirichletTwoSidedBadHeights
end

section
open Complex Set

attribute [local instance] inducingEulerProductConductorNeZero

section DirichletTwoSidedBadHeights
/--
Classical decidable equality on Dirichlet characters, used in finite character-set
constructions.
-/
noncomputable local instance characterDecidableEq (q : ℕ) :
    DecidableEq (DirichletCharacter ℂ q) :=
  Classical.decEq _

end DirichletTwoSidedBadHeights
end

section
open Complex Set

attribute [local instance] inducingEulerProductConductorNeZero
attribute [local instance] characterDecidableEq

section DirichletTwoSidedBadHeights

theorem characterBaseDivisorOrdinatesInLocalDisk_finite
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (t : ℝ) :
    ((if (chi) = 1 then
        Complex.im ''
          (MeromorphicOn.divisor riemannZeta₁
            (closedBall ((2 : ℂ) + (t) * I) 3)).support
      else
        Complex.im ''
          (MeromorphicOn.divisor
            (DirichletCharacter.LFunction (chi).primitiveCharacter)
            (closedBall ((2 : ℂ) + (t) * I) 6)).support)).Finite := by
  split_ifs with hchi
  · apply Set.Finite.image
    have hA : AnalyticOnNhd ℂ riemannZeta₁
        (closedBall ((2 : ℂ) + t * I) 3) :=
      fun z _ => differentiable_riemannZeta₁.analyticAt z
    exact hA.meromorphicOn.divisor_support_finite_of_subset
      (isCompact_closedBall ((2 : ℂ) + t * I) 3) Set.Subset.rfl
  · exact Set.Finite.image Complex.im
      (divisor_LFunction_closedBall_support_finite
        (primitiveCharacter_ne_one_of_ne_one chi hchi)
        ((2 : ℂ) + t * I) 6)

theorem dirichletLocalBadOrdinates_finite
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (t : ℝ) :
    (((if (chi) = 1 then
         Complex.im ''
           (MeromorphicOn.divisor riemannZeta₁
             (closedBall ((2 : ℂ) + (t) * I) 3)).support
       else
         Complex.im ''
           (MeromorphicOn.divisor
             (DirichletCharacter.LFunction (chi).primitiveCharacter)
             (closedBall ((2 : ℂ) + (t) * I) 6)).support) ∪
        ({pntOrdinate |
           inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
             |pntOrdinate - (t)| ≤ 1}))).Finite :=
  (characterBaseDivisorOrdinatesInLocalDisk_finite chi t).union
    (inducingEulerProductZeroOrdinatesInUnitWindow_finite chi t)

theorem cast_ncard_union_le (s t : Set ℝ) :
    ((s ∪ t).ncard : ℝ) ≤ (s.ncard : ℝ) + (t.ncard : ℝ) := by
  exact_mod_cast Set.ncard_union_le s t

theorem log_midpoint_scale_le_two_mul
    {q : ℕ} [NeZero q]
    (r : ℝ) (hr : 0 < r) (hrq : r ≤ (q : ℝ))
    (T : ℝ) (hT : 2 ≤ T) :
    Real.log (r * (|T + 1 / 2| + 2)) ≤
      2 * Real.log ((q : ℝ) * (T + 2)) := by
  have hq : (1 : ℝ) ≤ q := by
    exact_mod_cast Nat.one_le_iff_ne_zero.mpr (NeZero.ne q)
  have hq0 : (0 : ℝ) ≤ q :=
    (show (0 : ℝ) ≤ 1 by norm_num).trans hq
  have hm : 0 ≤ T + 1 / 2 := by linarith
  have harg : 0 < r * (|T + 1 / 2| + 2) := by positivity
  have hle : r * (|T + 1 / 2| + 2) ≤
      ((q : ℝ) * (T + 2)) ^ 2 := by
    rw [abs_of_nonneg hm]
    have hmid : T + 1 / 2 + 2 ≤ (T + 2) ^ 2 := by
      nlinarith [sq_nonneg T]
    have hqq : (q : ℝ) ≤ (q : ℝ) ^ 2 := by
      nlinarith [mul_nonneg hq0 (sub_nonneg.mpr hq)]
    calc
      r * (T + 1 / 2 + 2) ≤ (q : ℝ) * (T + 1 / 2 + 2) :=
        mul_le_mul_of_nonneg_right hrq (by linarith)
      _ ≤ (q : ℝ) * (T + 2) ^ 2 :=
        mul_le_mul_of_nonneg_left hmid hq0
      _ ≤ (q : ℝ) ^ 2 * (T + 2) ^ 2 :=
        mul_le_mul_of_nonneg_right hqq (sq_nonneg (T + 2))
      _ = ((q : ℝ) * (T + 2)) ^ 2 := by ring
  calc
    Real.log (r * (|T + 1 / 2| + 2)) ≤
        Real.log (((q : ℝ) * (T + 2)) ^ 2) :=
      Real.log_le_log harg hle
    _ = 2 * Real.log ((q : ℝ) * (T + 2)) := by
      rw [Real.log_pow]
      norm_num

theorem log_level_le_log_heightScale
    {q : ℕ} [NeZero q]
    (T : ℝ) (hT : 2 ≤ T) :
    Real.log (q : ℝ) ≤ Real.log ((q : ℝ) * (T + 2)) := by
  have hq : (0 : ℝ) < q := by
    exact_mod_cast Nat.pos_of_ne_zero (NeZero.ne q)
  apply Real.log_le_log hq
  nlinarith [mul_nonneg hq.le (show 0 ≤ T + 1 by linarith)]

theorem cast_ncard_localBadOrdinates_le
    {AL AZ A : ℕ}
    (hAL : 37 ≤ AL)
    (hprimitive :
      ∀ (d : ℕ) [NeZero d], 1 < d →
        ∀ (psi : DirichletCharacter ℂ d), psi.IsPrimitive →
          ∀ t : ℝ,
            ((MeromorphicOn.divisor
                (DirichletCharacter.LFunction psi)
                (closedBall ((2 : ℂ) + t * I) 6)).support.ncard : ℝ) ≤
              2 * (AL : ℝ) *
                Real.log ((d : ℝ) * (|t| + 2)))
    (hzeta :
      ∀ t : ℝ,
        ((MeromorphicOn.divisor riemannZeta₁
            (closedBall ((2 : ℂ) + t * I) 3)).support.ncard : ℝ) ≤
          12 * (AZ : ℝ) * Real.log (|t| + 2))
    (hALA : AL ≤ A) (hAZA : AZ ≤ A)
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (T t : ℝ)
    (hT : 2 ≤ T) (ht : |t| = T + 1 / 2) :
    ((((if (chi) = 1 then
          Complex.im ''
            (MeromorphicOn.divisor riemannZeta₁
              (closedBall ((2 : ℂ) + (t) * I) 3)).support
        else
          Complex.im ''
            (MeromorphicOn.divisor
              (DirichletCharacter.LFunction (chi).primitiveCharacter)
              (closedBall ((2 : ℂ) + (t) * I) 6)).support) ∪
         ({pntOrdinate |
            inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
              |pntOrdinate - (t)| ≤ 1}))).ncard : ℝ) ≤
      36 * (A : ℝ) * Real.log ((q : ℝ) * (T + 2)) := by
  let L := Real.log ((q : ℝ) * (T + 2))
  have hq : (1 : ℝ) ≤ q := by
    exact_mod_cast Nat.one_le_iff_ne_zero.mpr (NeZero.ne q)
  have hLpos : 0 < L := by
    apply Real.log_pos
    nlinarith [mul_le_mul_of_nonneg_left
      (show (4 : ℝ) ≤ T + 2 by linarith) (show (0 : ℝ) ≤ q by positivity)]
  have hAone : 1 ≤ A := hAL.trans hALA |>.trans' (by omega)
  have hproduct :
      ((({pntOrdinate : ℝ |
           inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
             |pntOrdinate - (t)| ≤ 1})).ncard : ℝ) ≤
        12 * (A : ℝ) * L := by
    calc
      ((({pntOrdinate : ℝ |
           inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
             |pntOrdinate - (t)| ≤ 1})).ncard : ℝ) ≤
          12 * Real.log (q : ℝ) :=
        ncard_inducingEulerProductZeroOrdinatesInUnitWindow_le chi t
      _ ≤ 12 * L := by
        exact mul_le_mul_of_nonneg_left
          (log_level_le_log_heightScale T hT) (by norm_num)
      _ ≤ 12 * (A : ℝ) * L := by
        have hAreal : (1 : ℝ) ≤ A := by exact_mod_cast hAone
        nlinarith [mul_le_mul_of_nonneg_right hAreal hLpos.le]
  have hbase :
      (((if (chi) = 1 then
           Complex.im ''
             (MeromorphicOn.divisor riemannZeta₁
               (closedBall ((2 : ℂ) + (t) * I) 3)).support
         else
           Complex.im ''
             (MeromorphicOn.divisor
               (DirichletCharacter.LFunction (chi).primitiveCharacter)
               (closedBall ((2 : ℂ) + (t) * I) 6)).support)).ncard : ℝ) ≤
        24 * (A : ℝ) * L := by
    split_ifs with hchi
    · let S := (MeromorphicOn.divisor riemannZeta₁
          (closedBall ((2 : ℂ) + t * I) 3)).support
      have hSfinite : S.Finite := by
        have hAnalytic : AnalyticOnNhd ℂ riemannZeta₁
            (closedBall ((2 : ℂ) + t * I) 3) :=
          fun z _ => differentiable_riemannZeta₁.analyticAt z
        exact hAnalytic.meromorphicOn.divisor_support_finite_of_subset
          (isCompact_closedBall ((2 : ℂ) + t * I) 3) Set.Subset.rfl
      have himage : ((Complex.im '' S).ncard : ℝ) ≤ (S.ncard : ℝ) := by
        exact_mod_cast Set.ncard_image_le hSfinite
      have hlog : Real.log (|t| + 2) ≤ 2 * L := by
        rw [ht]
        have hscale :=
          log_midpoint_scale_le_two_mul (q := q) 1 (by norm_num) hq T hT
        rw [abs_of_nonneg (show 0 ≤ T + 1 / 2 by linarith)] at hscale
        simpa [L] using hscale
      have hAZreal : (AZ : ℝ) ≤ A := by exact_mod_cast hAZA
      calc
        ((Complex.im '' S).ncard : ℝ) ≤ (S.ncard : ℝ) := himage
        _ ≤ 12 * (AZ : ℝ) * Real.log (|t| + 2) := by
          simpa [S] using hzeta t
        _ ≤ 24 * (A : ℝ) * L := by
          have hlogNonneg : 0 ≤ Real.log (|t| + 2) := by
            apply Real.log_nonneg
            linarith [abs_nonneg t]
          nlinarith [mul_le_mul hAZreal hlog hlogNonneg
            (by positivity : (0 : ℝ) ≤ A)]
    · let d := chi.conductor
      let : NeZero d := ⟨chi.conductor_ne_zero⟩
      have hdpos : 0 < d := Nat.pos_of_ne_zero (NeZero.ne d)
      have hdne : d ≠ 1 := by
        intro hd
        exact hchi (DirichletCharacter.eq_one_iff_conductor_eq_one.mpr hd)
      have hd : 1 < d := by omega
      let S := (MeromorphicOn.divisor
          (DirichletCharacter.LFunction chi.primitiveCharacter)
          (closedBall ((2 : ℂ) + t * I) 6)).support
      have hpsi : chi.primitiveCharacter ≠ 1 :=
        primitiveCharacter_ne_one_of_ne_one chi hchi
      have hSfinite : S.Finite := by
        simpa [S] using divisor_LFunction_closedBall_support_finite hpsi
          ((2 : ℂ) + t * I) 6
      have himage : ((Complex.im '' S).ncard : ℝ) ≤ (S.ncard : ℝ) := by
        exact_mod_cast Set.ncard_image_le hSfinite
      have hdqNat : d ≤ q :=
        Nat.le_of_dvd (Nat.pos_of_ne_zero (NeZero.ne q))
          chi.conductor_dvd_level
      have hdq : (d : ℝ) ≤ q := by exact_mod_cast hdqNat
      have hlog : Real.log ((d : ℝ) * (|t| + 2)) ≤ 2 * L := by
        rw [ht]
        have hscale := log_midpoint_scale_le_two_mul (q := q)
          (d : ℝ) (by exact_mod_cast hdpos) hdq T hT
        rw [abs_of_nonneg (show 0 ≤ T + 1 / 2 by linarith)] at hscale
        simpa [L] using hscale
      have hALreal : (AL : ℝ) ≤ A := by exact_mod_cast hALA
      calc
        ((Complex.im '' S).ncard : ℝ) ≤ (S.ncard : ℝ) := himage
        _ ≤ 2 * (AL : ℝ) * Real.log ((d : ℝ) * (|t| + 2)) := by
          simpa [S, d] using hprimitive d hd chi.primitiveCharacter
            chi.primitiveCharacter_isPrimitive t
        _ ≤ 24 * (A : ℝ) * L := by
          have hlogNonneg :
              0 ≤ Real.log ((d : ℝ) * (|t| + 2)) := by
            apply Real.log_nonneg
            have hdOne : (1 : ℝ) ≤ d := by exact_mod_cast hd.le
            nlinarith [mul_le_mul_of_nonneg_left
              (show (1 : ℝ) ≤ |t| + 2 by linarith [abs_nonneg t])
              (by positivity : (0 : ℝ) ≤ d)]
          nlinarith [mul_le_mul hALreal hlog hlogNonneg
            (by positivity : (0 : ℝ) ≤ A)]
  have hunion := cast_ncard_union_le
    ((if (chi) = 1 then
        Complex.im ''
          (MeromorphicOn.divisor riemannZeta₁
            (closedBall ((2 : ℂ) + (t) * I) 3)).support
      else
        Complex.im ''
          (MeromorphicOn.divisor
            (DirichletCharacter.LFunction (chi).primitiveCharacter)
            (closedBall ((2 : ℂ) + (t) * I) 6)).support))
    (({pntOrdinate |
        inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
          |pntOrdinate - (t)| ≤ 1}))
  nlinarith

end DirichletTwoSidedBadHeights
end

section
open Complex Set

attribute [local instance] inducingEulerProductConductorNeZero
attribute [local instance] characterDecidableEq
theorem dirichletTwoSidedBadHeights_finite
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (T : ℝ) :
    ((let pntMidpoint := (T) + 1 / 2
      ((if (chi) = 1 then
          Complex.im ''
            (MeromorphicOn.divisor riemannZeta₁
              (closedBall ((2 : ℂ) + pntMidpoint * I) 3)).support
        else
          Complex.im ''
            (MeromorphicOn.divisor
              (DirichletCharacter.LFunction (chi).primitiveCharacter)
              (closedBall ((2 : ℂ) + pntMidpoint * I) 6)).support) ∪
         ({pntOrdinate |
            inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
              |pntOrdinate - pntMidpoint| ≤ 1})) ∪
        (fun pntOrdinate : ℝ => -pntOrdinate) ''
          ((if (chi) = 1 then
              Complex.im ''
                (MeromorphicOn.divisor riemannZeta₁
                  (closedBall ((2 : ℂ) + (-pntMidpoint) * I) 3)).support
            else
              Complex.im ''
                (MeromorphicOn.divisor
                  (DirichletCharacter.LFunction (chi).primitiveCharacter)
                  (closedBall ((2 : ℂ) + (-pntMidpoint) * I) 6)).support) ∪
             ({pntOrdinate |
                inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
                  |pntOrdinate - (-pntMidpoint)| ≤ 1})))).Finite := by
  have h :=
    (dirichletLocalBadOrdinates_finite chi (T + 1 / 2)).union
      ((dirichletLocalBadOrdinates_finite chi (-(T + 1 / 2))).image
        (fun gamma : ℝ => -gamma))
  rw [Complex.ofReal_neg] at h
  exact h

theorem exists_nat_ncard_dirichletTwoSidedBadHeights_le :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q) (T : ℝ),
          2 ≤ T →
            (((let pntMidpoint := (T) + 1 / 2
               ((if (chi) = 1 then
                   Complex.im ''
                     (MeromorphicOn.divisor riemannZeta₁
                       (closedBall ((2 : ℂ) + pntMidpoint * I) 3)).support
                 else
                   Complex.im ''
                     (MeromorphicOn.divisor
                       (DirichletCharacter.LFunction (chi).primitiveCharacter)
                       (closedBall ((2 : ℂ) + pntMidpoint * I) 6)).support) ∪
                  ({pntOrdinate |
                     inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
                       |pntOrdinate - pntMidpoint| ≤ 1})) ∪
                 (fun pntOrdinate : ℝ => -pntOrdinate) ''
                   ((if (chi) = 1 then
                       Complex.im ''
                         (MeromorphicOn.divisor riemannZeta₁
                           (closedBall ((2 : ℂ) + (-pntMidpoint) * I) 3)).support
                     else
                       Complex.im ''
                         (MeromorphicOn.divisor
                           (DirichletCharacter.LFunction (chi).primitiveCharacter)
                           (closedBall ((2 : ℂ) + (-pntMidpoint) * I) 6)).support) ∪
                      ({pntOrdinate |
                         inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
                           |pntOrdinate - (-pntMidpoint)| ≤ 1})))).ncard : ℝ) ≤
              72 * (A : ℝ) *
                Real.log ((q : ℝ) * (T + 2)) := by
  obtain ⟨AL, hAL, hprimitive⟩ :=
    exists_nat_ncard_support_divisor_LFunction_radiusSix_le
  obtain ⟨AZ, _, hzeta⟩ :=
    exists_nat_ncard_support_divisor_riemannZeta₁_radiusThree_le
  let A := max AL AZ
  refine ⟨A, hAL.trans (Nat.le_max_left AL AZ), ?_⟩
  intro q _ chi T hT
  let m := T + 1 / 2
  let P := ((if (chi) = 1 then
               Complex.im ''
                 (MeromorphicOn.divisor riemannZeta₁
                   (closedBall ((2 : ℂ) + (m) * I) 3)).support
             else
               Complex.im ''
                 (MeromorphicOn.divisor
                   (DirichletCharacter.LFunction (chi).primitiveCharacter)
                   (closedBall ((2 : ℂ) + (m) * I) 6)).support) ∪
              ({pntOrdinate |
                 inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
                   |pntOrdinate - (m)| ≤ 1}))
  let N := ((if (chi) = 1 then
               Complex.im ''
                 (MeromorphicOn.divisor riemannZeta₁
                   (closedBall ((2 : ℂ) + ((-m)) * I) 3)).support
             else
               Complex.im ''
                 (MeromorphicOn.divisor
                   (DirichletCharacter.LFunction (chi).primitiveCharacter)
                   (closedBall ((2 : ℂ) + ((-m)) * I) 6)).support) ∪
              ({pntOrdinate |
                 inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
                   |pntOrdinate - ((-m))| ≤ 1}))
  have hP : (P.ncard : ℝ) ≤
      36 * (A : ℝ) * Real.log ((q : ℝ) * (T + 2)) := by
    apply cast_ncard_localBadOrdinates_le hAL hprimitive hzeta
      (Nat.le_max_left AL AZ) (Nat.le_max_right AL AZ) chi T m hT
    change |T + 1 / 2| = T + 1 / 2
    rw [abs_of_nonneg (by linarith)]
  have hN : (N.ncard : ℝ) ≤
      36 * (A : ℝ) * Real.log ((q : ℝ) * (T + 2)) := by
    have hmneg : |(-m)| = T + 1 / 2 := by
      change |-(T + 1 / 2)| = T + 1 / 2
      rw [abs_neg, abs_of_nonneg (by linarith)]
    have h :=
      cast_ncard_localBadOrdinates_le hAL hprimitive hzeta
        (Nat.le_max_left AL AZ) (Nat.le_max_right AL AZ) chi T (-m) hT hmneg
    rw [Complex.ofReal_neg] at h
    exact h
  have hneg :
      ((((fun gamma : ℝ => -gamma) '' N).ncard : ℕ) : ℝ) =
        (N.ncard : ℝ) := by
    rw [Set.ncard_image_of_injective N]
    intro x y hxy
    linarith
  have hunion := cast_ncard_union_le P ((fun gamma : ℝ => -gamma) '' N)
  rw [hneg] at hunion
  change (((let pntMidpoint := (T) + 1 / 2
            ((if (chi) = 1 then
                Complex.im ''
                  (MeromorphicOn.divisor riemannZeta₁
                    (closedBall ((2 : ℂ) + pntMidpoint * I) 3)).support
              else
                Complex.im ''
                  (MeromorphicOn.divisor
                    (DirichletCharacter.LFunction (chi).primitiveCharacter)
                    (closedBall ((2 : ℂ) + pntMidpoint * I) 6)).support) ∪
               ({pntOrdinate |
                  inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
                    |pntOrdinate - pntMidpoint| ≤ 1})) ∪
              (fun pntOrdinate : ℝ => -pntOrdinate) ''
                ((if (chi) = 1 then
                    Complex.im ''
                      (MeromorphicOn.divisor riemannZeta₁
                        (closedBall ((2 : ℂ) + (-pntMidpoint) * I) 3)).support
                  else
                    Complex.im ''
                      (MeromorphicOn.divisor
                        (DirichletCharacter.LFunction (chi).primitiveCharacter)
                        (closedBall ((2 : ℂ) + (-pntMidpoint) * I) 6)).support) ∪
                   ({pntOrdinate |
                      inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
                        |pntOrdinate - (-pntMidpoint)| ≤ 1})))).ncard : ℝ) ≤ _
  simpa [m, P, N] using
    hunion.trans (by linarith)

end

section
open Set

section DirichletGoodHeightSelector
theorem exists_unitInterval_point_away_from_finite
    (S : Set ℝ) (hS : S.Finite) (T : ℝ) :
    ∃ T' : ℝ, T' ∈ Icc T (T + 1) ∧
      ∀ gamma ∈ S,
        1 / (2 * ((S.ncard : ℝ) + 1)) ≤ |T' - gamma| := by
  classical
  let n := S.ncard
  let delta : ℝ := 1 / ((n : ℝ) + 1)
  let radius : ℝ := delta / 2
  let grid : Fin (n + 1) → ℝ := fun i => T + (i : ℝ) * delta
  have hdelta : 0 < delta := by
    dsimp [delta]
    positivity
  have hradius :
      1 / (2 * ((S.ncard : ℝ) + 1)) = radius := by
    dsimp [radius, delta, n]
    field_simp
  have hgrid_mem (i : Fin (n + 1)) : grid i ∈ Icc T (T + 1) := by
    have hi : i.val ≤ n := Nat.lt_succ_iff.mp i.isLt
    have hiReal : (i.val : ℝ) ≤ n := by exact_mod_cast hi
    constructor
    · dsimp [grid]
      have hmul : 0 ≤ (i.val : ℝ) * delta :=
        mul_nonneg (Nat.cast_nonneg _) hdelta.le
      linarith
    · have hmul : (i.val : ℝ) * delta ≤ 1 := by
        calc
          (i.val : ℝ) * delta ≤ (n : ℝ) * delta :=
            mul_le_mul_of_nonneg_right hiReal hdelta.le
          _ ≤ ((n : ℝ) + 1) * delta := by
            gcongr
            norm_num
          _ = 1 := by
            dsimp [delta]
            field_simp
      dsimp [grid]
      linarith
  by_contra! h
  have hnear : ∀ i : Fin (n + 1), ∃ gamma : S,
      |grid i - (gamma : ℝ)| < radius := by
    intro i
    obtain ⟨gamma, hgamma, hi⟩ := h (grid i) (hgrid_mem i)
    exact ⟨⟨gamma, hgamma⟩, by simpa [hradius] using hi⟩
  let f : Fin (n + 1) → S := fun i => Classical.choose (hnear i)
  have hf_near (i : Fin (n + 1)) :
      |grid i - (f i : ℝ)| < radius :=
    Classical.choose_spec (hnear i)
  let := hS.fintype
  have hcard : Fintype.card S < Fintype.card (Fin (n + 1)) := by
    simp only [Set.fintypeCard_eq_ncard, Fintype.card_fin]
    dsimp [n]
    omega
  obtain ⟨i, j, hij, hfij⟩ :=
    Fintype.exists_ne_map_eq_of_card_lt f hcard
  have hsep_lt {i j : Fin (n + 1)} (hij : i < j) :
      delta ≤ |grid i - grid j| := by
    have hijNat : i.val + 1 ≤ j.val := Nat.succ_le_iff.mpr hij
    have hijReal : (i.val : ℝ) + 1 ≤ (j.val : ℝ) := by
      exact_mod_cast hijNat
    have horder : grid i ≤ grid j := by
      dsimp [grid]
      gcongr
      exact_mod_cast hij.le
    rw [abs_of_nonpos (sub_nonpos.mpr horder)]
    dsimp [grid]
    nlinarith [hdelta]
  have hsep : delta ≤ |grid i - grid j| := by
    rcases lt_or_gt_of_ne hij with hij' | hji'
    · exact hsep_lt hij'
    · simpa [abs_sub_comm] using hsep_lt hji'
  have hclose : |grid i - grid j| < radius + radius := calc
    |grid i - grid j| =
        |(grid i - (f i : ℝ)) + ((f j : ℝ) - grid j)| := by
          have hfij' : (f i : ℝ) = (f j : ℝ) :=
            congrArg Subtype.val hfij
          rw [hfij']
          congr 1
          ring
    _ ≤ |grid i - (f i : ℝ)| + |(f j : ℝ) - grid j| :=
      abs_add_le _ _
    _ < radius + radius :=
      add_lt_add (hf_near i) (by simpa [abs_sub_comm] using hf_near j)
  have htwo : radius + radius = delta := by
    dsimp [radius]
    ring
  rw [htwo] at hclose
  exact (not_lt_of_ge hsep) hclose

end DirichletGoodHeightSelector
end

section
open Set

attribute [local instance] inducingEulerProductConductorNeZero
attribute [local instance] characterDecidableEq
theorem exists_nat_dirichletTwoSidedBadHeights_clearance :
    ∃ C : ℕ, 2 ≤ C ∧
      ∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q) (T : ℝ),
          2 ≤ T →
            ∃ T' : ℝ, T' ∈ Icc T (T + 1) ∧
              ∀ gamma ∈ (let pntMidpoint := (T) + 1 / 2
                         ((if (chi) = 1 then
                             Complex.im ''
                               (MeromorphicOn.divisor riemannZeta₁
                                 (Metric.closedBall ((2 : ℂ) + pntMidpoint * Complex.I) 3)).support
                           else
                             Complex.im ''
                               (MeromorphicOn.divisor
                                 (DirichletCharacter.LFunction (chi).primitiveCharacter)
                                 (Metric.closedBall
                                   ((2 : ℂ) + pntMidpoint * Complex.I) 6)).support) ∪
                            ({pntOrdinate |
                               inducingEulerProduct (chi) ((pntOrdinate : ℂ) * Complex.I) = 0 ∧
                                 |pntOrdinate - pntMidpoint| ≤ 1})) ∪
                           (fun pntOrdinate : ℝ => -pntOrdinate) ''
                             ((if (chi) = 1 then
                                 Complex.im ''
                                   (MeromorphicOn.divisor riemannZeta₁
                                     (Metric.closedBall
                                       ((2 : ℂ) + (-pntMidpoint) * Complex.I) 3)).support
                               else
                                 Complex.im ''
                                   (MeromorphicOn.divisor
                                     (DirichletCharacter.LFunction (chi).primitiveCharacter)
                                     (Metric.closedBall
                                       ((2 : ℂ) + (-pntMidpoint) * Complex.I) 6)).support) ∪
                                ({pntOrdinate |
                                   inducingEulerProduct (chi) ((pntOrdinate : ℂ) * Complex.I) = 0 ∧
                                     |pntOrdinate - (-pntMidpoint)| ≤ 1}))),
                1 / ((C : ℝ) *
                    Real.log ((q : ℝ) * (T + 2))) ≤
                  |T' - gamma| := by
  obtain ⟨A, hA, hcount⟩ :=
    exists_nat_ncard_dirichletTwoSidedBadHeights_le
  refine ⟨146 * A, by omega, ?_⟩
  intro q _ chi T hT
  let S := (let pntMidpoint := (T) + 1 / 2
            ((if (chi) = 1 then
                Complex.im ''
                  (MeromorphicOn.divisor riemannZeta₁
                    (Metric.closedBall ((2 : ℂ) + pntMidpoint * Complex.I) 3)).support
              else
                Complex.im ''
                  (MeromorphicOn.divisor
                    (DirichletCharacter.LFunction (chi).primitiveCharacter)
                    (Metric.closedBall ((2 : ℂ) + pntMidpoint * Complex.I) 6)).support) ∪
               ({pntOrdinate |
                  inducingEulerProduct (chi) ((pntOrdinate : ℂ) * Complex.I) = 0 ∧
                    |pntOrdinate - pntMidpoint| ≤ 1})) ∪
              (fun pntOrdinate : ℝ => -pntOrdinate) ''
                ((if (chi) = 1 then
                    Complex.im ''
                      (MeromorphicOn.divisor riemannZeta₁
                        (Metric.closedBall ((2 : ℂ) + (-pntMidpoint) * Complex.I) 3)).support
                  else
                    Complex.im ''
                      (MeromorphicOn.divisor
                        (DirichletCharacter.LFunction (chi).primitiveCharacter)
                        (Metric.closedBall ((2 : ℂ) + (-pntMidpoint) * Complex.I) 6)).support) ∪
                   ({pntOrdinate |
                      inducingEulerProduct (chi) ((pntOrdinate : ℂ) * Complex.I) = 0 ∧
                        |pntOrdinate - (-pntMidpoint)| ≤ 1})))
  let L := Real.log ((q : ℝ) * (T + 2))
  obtain ⟨T', hT'mem, hclear⟩ :=
    exists_unitInterval_point_away_from_finite S
      (dirichletTwoSidedBadHeights_finite chi T) T
  refine ⟨T', hT'mem, ?_⟩
  intro gamma hgamma
  change gamma ∈ S at hgamma
  change 1 / (((146 * A : ℕ) : ℝ) * L) ≤ |T' - gamma|
  have hq : (1 : ℝ) ≤ q := by
    exact_mod_cast Nat.one_le_iff_ne_zero.mpr (NeZero.ne q)
  have hscale : (4 : ℝ) ≤ (q : ℝ) * (T + 2) := by
    nlinarith [mul_le_mul hq (show (4 : ℝ) ≤ T + 2 by linarith)
      (by norm_num : (0 : ℝ) ≤ 4) (by positivity : (0 : ℝ) ≤ q)]
  have hlogFour : (1 : ℝ) < Real.log 4 := by
    rw [Real.log_four_eq]
    nlinarith [Real.log_two_gt_d9]
  have hLone : (1 : ℝ) ≤ L := by
    have hlogScale : Real.log 4 ≤ L := by
      dsimp [L]
      exact Real.log_le_log (by norm_num) hscale
    exact hlogFour.le.trans hlogScale
  have hcount' : (S.ncard : ℝ) ≤ 72 * (A : ℝ) * L := by
    simpa [S, L] using hcount q chi T hT
  have hAreal : (1 : ℝ) ≤ A := by exact_mod_cast (by omega : 1 ≤ A)
  have hAL : (1 : ℝ) ≤ (A : ℝ) * L := by
    nlinarith [mul_nonneg (sub_nonneg.mpr hAreal) (zero_le_one.trans hLone)]
  have hden' :
      2 * ((S.ncard : ℝ) + 1) ≤ 146 * (A : ℝ) * L := by
    nlinarith
  have hden :
      2 * ((S.ncard : ℝ) + 1) ≤ (((146 * A : ℕ) : ℝ) * L) := by
    simpa using hden'
  exact (one_div_le_one_div_of_le (by positivity) hden).trans
    (hclear gamma hgamma)

end

section
open Function Set

section FixedDiskLogDerivative
/--
The integer-valued meromorphic divisor of `f` on the closed disk of radius `2 * R` about `c`,
recording zero orders positively and pole orders negatively.
-/
noncomputable def selectedDivisor
    (f : ℂ -> ℂ) (c : ℂ) (R : ℝ) : Function.locallyFinsuppWithin
      (closedBall c (2 * R)) ℤ :=
  MeromorphicOn.divisor f (closedBall c (2 * R))

/--
The factorized product of `z - ρ` with exponents given by the divisor on the selected disk.
Integer exponents also encode poles; under the analytic hypotheses used later, only zero factors
remain.
-/
noncomputable def selectedZeroProduct
    (f : ℂ -> ℂ) (c : ℂ) (R : ℝ) : ℂ -> ℂ :=
  ∏ᶠ rho : ℂ, (fun z => z - rho) ^ selectedDivisor f c R rho

/--
The pointwise quotient of `f` by the factorized divisor product selected on the closed disk of
radius `2 * R` about `c`. Integer divisor exponents can encode poles as well as zeros; removable
values of the quotient have not yet been filled in.
-/
noncomputable def selectedRawFactor
    (f : ℂ -> ℂ) (c : ℂ) (R : ℝ) : ℂ -> ℂ :=
  (selectedZeroProduct f c R)⁻¹ * f

/--
The meromorphic normal form of the quotient by the selected divisor product, taken on the closed
disk of radius `4 * R` about `c`. It fills removable values; the later analytic hypotheses
ensure that the resulting factor has the required regularity.
-/
noncomputable def selectedRegularFactor
    (f : ℂ -> ℂ) (c : ℂ) (R : ℝ) : ℂ -> ℂ :=
  toMeromorphicNFOn (selectedRawFactor f c R)
    (closedBall c (4 * R))

theorem selectedDivisor_support_finite
    (f : ℂ -> ℂ) (c : ℂ) (R : ℝ) :
    (selectedDivisor f c R).support.Finite :=
  (selectedDivisor f c R).finiteSupport (isCompact_closedBall c (2 * R))

theorem analyticOrderAt_ne_top_on_closedBall
    {f : ℂ -> ℂ} {c : ℂ} {R : ℝ} (hR : 0 ≤ R)
    (hf : AnalyticOnNhd ℂ f (closedBall c R)) (hc : f c ≠ 0)
    {z : ℂ} (hz : z ∈ closedBall c R) :
    analyticOrderAt f z ≠ ⊤ := by
  have hc_mem : c ∈ closedBall c R := mem_closedBall_self hR
  apply hf.analyticOrderAt_ne_top_of_isPreconnected
    (convex_closedBall c R).isPreconnected hc_mem hz
  rw [(hf c hc_mem).analyticOrderAt_eq_zero.mpr hc]
  exact WithTop.zero_ne_top

theorem selectedDivisor_apply_eq_order
    {f : ℂ -> ℂ} {c : ℂ} {R : ℝ} (hR : 0 < R)
    (hf : AnalyticOnNhd ℂ f (closedBall c (4 * R))) (hc : f c ≠ 0)
    {z : ℂ} (hz : z ∈ closedBall c (2 * R)) :
    selectedDivisor f c R z = (analyticOrderNatAt f z : ℤ) := by
  have hf_inner : AnalyticOnNhd ℂ f (closedBall c (2 * R)) :=
    hf.mono (closedBall_subset_closedBall (by linarith))
  have hfinite := analyticOrderAt_ne_top_on_closedBall (by positivity)
    hf_inner hc hz
  rw [selectedDivisor, MeromorphicOn.AnalyticOnNhd.divisor_apply hf_inner hz,
    ← Nat.cast_analyticOrderNatAt hfinite, ENat.map_natCast, WithTop.untop₀_coe]

theorem selectedDivisor_nonneg
    {f : ℂ -> ℂ} {c : ℂ} {R : ℝ}
    (hR : 0 < R) (hf : AnalyticOnNhd ℂ f (closedBall c (4 * R))) :
    0 ≤ selectedDivisor f c R :=
  MeromorphicOn.AnalyticOnNhd.divisor_nonneg
    (hf.mono (closedBall_subset_closedBall (by linarith)))

theorem meromorphic_selectedZeroProduct
    (f : ℂ -> ℂ) (c : ℂ) (R : ℝ) :
    Meromorphic (selectedZeroProduct f c R) := by
  simpa [selectedZeroProduct] using
    (Function.FactorizedRational.meromorphicNFOn_univ
      (selectedDivisor f c R)).meromorphicOn

theorem meromorphicOn_selectedRawFactor
    {f : ℂ -> ℂ} {c : ℂ} {R : ℝ}
    (hf : AnalyticOnNhd ℂ f (closedBall c (4 * R))) :
    MeromorphicOn (selectedRawFactor f c R) (closedBall c (4 * R)) :=
  (meromorphic_selectedZeroProduct f c R).meromorphicOn.inv.mul
    hf.meromorphicOn

theorem meromorphicOrderAt_selectedRawFactor
    {f : ℂ -> ℂ} {c z : ℂ} {R : ℝ}
    (hfz : AnalyticAt ℂ f z) :
    meromorphicOrderAt (selectedRawFactor f c R) z =
      -(selectedDivisor f c R z : WithTop ℤ) +
        (analyticOrderAt f z).map (↑) := by
  rw [selectedRawFactor,
    meromorphicOrderAt_mul
      ((meromorphic_selectedZeroProduct f c R z).inv) hfz.meromorphicAt,
    meromorphicOrderAt_inv,
    selectedZeroProduct,
    Function.FactorizedRational.meromorphicOrderAt_eq
      (selectedDivisor f c R) (selectedDivisor_support_finite f c R),
    hfz.meromorphicOrderAt_eq]

theorem meromorphicOrderAt_selectedRawFactor_eq_zero
    {f : ℂ -> ℂ} {c z : ℂ} {R : ℝ} (hR : 0 < R)
    (hf : AnalyticOnNhd ℂ f (closedBall c (4 * R))) (hc : f c ≠ 0)
    (hz : z ∈ closedBall c (2 * R)) :
    meromorphicOrderAt (selectedRawFactor f c R) z = 0 := by
  have hz_outer : z ∈ closedBall c (4 * R) :=
    closedBall_subset_closedBall (by linarith) hz
  have hfinite := analyticOrderAt_ne_top_on_closedBall (by positivity) hf hc hz_outer
  rw [meromorphicOrderAt_selectedRawFactor (hf z hz_outer),
    selectedDivisor_apply_eq_order hR hf hc hz,
    ← Nat.cast_analyticOrderNatAt hfinite, ENat.map_natCast]
  simp

theorem meromorphicOrderAt_selectedRawFactor_nonneg
    {f : ℂ -> ℂ} {c z : ℂ} {R : ℝ} (hR : 0 < R)
    (hf : AnalyticOnNhd ℂ f (closedBall c (4 * R))) (hc : f c ≠ 0)
    (hz : z ∈ closedBall c (4 * R)) :
    0 ≤ meromorphicOrderAt (selectedRawFactor f c R) z := by
  by_cases hz_inner : z ∈ closedBall c (2 * R)
  · rw [meromorphicOrderAt_selectedRawFactor_eq_zero hR hf hc hz_inner]
  · have hfinite := analyticOrderAt_ne_top_on_closedBall (by positivity) hf hc hz
    rw [meromorphicOrderAt_selectedRawFactor (hf z hz),
      selectedDivisor, Function.locallyFinsuppWithin.apply_eq_zero_of_notMem _ hz_inner,
      ← Nat.cast_analyticOrderNatAt hfinite, ENat.map_natCast]
    simp only [WithTop.coe_zero, neg_zero, zero_add]
    exact_mod_cast Nat.zero_le (analyticOrderNatAt f z)

theorem analyticOnNhd_selectedRegularFactor
    {f : ℂ -> ℂ} {c : ℂ} {R : ℝ} (hR : 0 < R)
    (hf : AnalyticOnNhd ℂ f (closedBall c (4 * R))) (hc : f c ≠ 0) :
    AnalyticOnNhd ℂ (selectedRegularFactor f c R) (closedBall c (4 * R)) := by
  intro z hz
  have hraw := meromorphicOn_selectedRawFactor hf
  have hnf := meromorphicNFOn_toMeromorphicNFOn
    (selectedRawFactor f c R) (closedBall c (4 * R)) hz
  unfold selectedRegularFactor
  rw [← hnf.meromorphicOrderAt_nonneg_iff_analyticAt,
    meromorphicOrderAt_toMeromorphicNFOn hraw hz]
  exact meromorphicOrderAt_selectedRawFactor_nonneg hR hf hc hz

theorem selectedRegularFactor_ne_zero
    {f : ℂ -> ℂ} {c z : ℂ} {R : ℝ} (hR : 0 < R)
    (hf : AnalyticOnNhd ℂ f (closedBall c (4 * R))) (hc : f c ≠ 0)
    (hz : z ∈ closedBall c (2 * R)) :
    selectedRegularFactor f c R z ≠ 0 := by
  have hz_outer : z ∈ closedBall c (4 * R) :=
    closedBall_subset_closedBall (by linarith) hz
  have hraw := meromorphicOn_selectedRawFactor hf
  have hnf := meromorphicNFOn_toMeromorphicNFOn
    (selectedRawFactor f c R) (closedBall c (4 * R)) hz_outer
  unfold selectedRegularFactor
  rw [← hnf.meromorphicOrderAt_eq_zero_iff,
    meromorphicOrderAt_toMeromorphicNFOn hraw hz_outer]
  exact meromorphicOrderAt_selectedRawFactor_eq_zero hR hf hc hz

theorem selectedZeroProduct_ne_zero_of_divisor_eq_zero
    {f : ℂ -> ℂ} {c z : ℂ} {R : ℝ}
    (hz : selectedDivisor f c R z = 0) :
    selectedZeroProduct f c R z ≠ 0 := by
  simpa [selectedZeroProduct] using
    (Function.FactorizedRational.ne_zero (d := selectedDivisor f c R) hz)

theorem selectedRegularFactor_eq_raw
    {f : ℂ -> ℂ} {c z : ℂ} {R : ℝ} (hR : 0 < R)
    (hf : AnalyticOnNhd ℂ f (closedBall c (4 * R)))
    (hz : z ∈ closedBall c (4 * R))
    (hPz : selectedZeroProduct f c R z ≠ 0) :
    selectedRegularFactor f c R z = selectedRawFactor f c R z := by
  have hraw := meromorphicOn_selectedRawFactor hf
  have hP_analytic : AnalyticAt ℂ (selectedZeroProduct f c R) z := by
    unfold selectedZeroProduct
    exact Function.FactorizedRational.analyticAt
      (selectedDivisor_nonneg hR hf z)
  have hraw_nf : MeromorphicNFAt (selectedRawFactor f c R) z := by
    apply AnalyticAt.meromorphicNFAt
    unfold selectedRawFactor
    exact (hP_analytic.inv hPz).mul (hf z hz)
  rw [selectedRegularFactor,
    toMeromorphicNFOn_eq_toMeromorphicNFAt hraw hz,
    toMeromorphicNFAt_eq_self.2 hraw_nf]

theorem selectedDivisor_apply_center_eq_zero
    {f : ℂ -> ℂ} {c : ℂ} {R : ℝ} (hR : 0 < R)
    (hf : AnalyticOnNhd ℂ f (closedBall c (4 * R))) (hc : f c ≠ 0) :
    selectedDivisor f c R c = 0 := by
  rw [selectedDivisor_apply_eq_order hR hf hc (by simp [hR.le])]
  have horder := (hf c (by simp [hR.le])).analyticOrderAt_eq_zero.mpr hc
  simp [analyticOrderNatAt, horder]

theorem selectedDivisor_apply_eq_zero_of_ne_zero
    {f : ℂ -> ℂ} {c z : ℂ} {R : ℝ} (hR : 0 < R)
    (hf : AnalyticOnNhd ℂ f (closedBall c (4 * R))) (hc : f c ≠ 0)
    (hz : z ∈ closedBall c (2 * R)) (hfz : f z ≠ 0) :
    selectedDivisor f c R z = 0 := by
  rw [selectedDivisor_apply_eq_order hR hf hc hz]
  have hz_outer : z ∈ closedBall c (4 * R) :=
    closedBall_subset_closedBall (by linarith) hz
  have horder := (hf z hz_outer).analyticOrderAt_eq_zero.mpr hfz
  simp [analyticOrderNatAt, horder]

theorem norm_selectedZeroProduct_center_le_sphere
    {f : ℂ -> ℂ} {c w : ℂ} {R : ℝ} (hR : 0 < R)
    (hf : AnalyticOnNhd ℂ f (closedBall c (4 * R))) (hc : f c ≠ 0)
    (hw : w ∈ sphere c (4 * R)) :
    ‖selectedZeroProduct f c R c‖ ≤ ‖selectedZeroProduct f c R w‖ := by
  let D := selectedDivisor f c R
  have hD : D.support.Finite := selectedDivisor_support_finite f c R
  have hmul (x : ℂ) : (fun rho => (x - rho) ^ D rho).mulSupport ⊆ hD.toFinset := by
    intro rho hrho
    apply hD.mem_toFinset.mpr
    intro hzero
    simp [hzero] at hrho
  rw [selectedZeroProduct, Function.FactorizedRational.finprod_eq_fun hD]
  change ‖∏ᶠ rho : ℂ, (c - rho) ^ D rho‖ ≤
    ‖∏ᶠ rho : ℂ, (w - rho) ^ D rho‖
  rw [finprod_eq_prod_of_mulSupport_subset _ (hmul c),
    finprod_eq_prod_of_mulSupport_subset _ (hmul w), norm_prod, norm_prod]
  apply Finset.prod_le_prod
  · intro rho hrho
    exact norm_nonneg _
  · intro rho hrho
    have hrho_support : rho ∈ D.support := hD.mem_toFinset.mp hrho
    have hrho_inner : rho ∈ closedBall c (2 * R) := D.supportWithinDomain hrho_support
    have hrho_dist : dist rho c ≤ 2 * R := mem_closedBall.mp hrho_inner
    have hbase : ‖c - rho‖ ≤ ‖w - rho‖ := by
      have htriangle := dist_triangle w rho c
      rw [mem_sphere] at hw
      rw [hw] at htriangle
      calc
        ‖c - rho‖ = dist rho c := by
          rw [dist_eq_norm]
          simpa only [neg_sub] using (norm_neg (c - rho)).symm
        _ ≤ 2 * R := hrho_dist
        _ ≤ dist w rho := by linarith [htriangle, hrho_dist]
        _ = ‖w - rho‖ := dist_eq_norm w rho
    rw [selectedDivisor_apply_eq_order hR hf hc hrho_inner]
    simp only [zpow_natCast, norm_pow]
    exact pow_le_pow_left₀ (norm_nonneg _) hbase _

theorem norm_selectedRegularFactor_le_on_outer_sphere
    {f : ℂ -> ℂ} {c w : ℂ} {R M : ℝ} (hR : 0 < R)
    (hf : AnalyticOnNhd ℂ f (closedBall c (4 * R))) (hc : f c ≠ 0)
    (hbound : ∀ z ∈ sphere c (4 * R),
      ‖f z‖ ≤ Real.exp M * ‖f c‖)
    (hw : w ∈ sphere c (4 * R)) :
    ‖selectedRegularFactor f c R w‖ ≤
      Real.exp M * ‖selectedRegularFactor f c R c‖ := by
  have hc_outer : c ∈ closedBall c (4 * R) := by simp [hR.le]
  have hw_outer : w ∈ closedBall c (4 * R) := sphere_subset_closedBall hw
  have hw_not_inner : w ∉ closedBall c (2 * R) := by
    intro hw_inner
    have hw_dist := mem_sphere.mp hw
    have hw_inner_dist := mem_closedBall.mp hw_inner
    linarith
  have hDc := selectedDivisor_apply_center_eq_zero hR hf hc
  have hDw : selectedDivisor f c R w = 0 := by
    unfold selectedDivisor
    exact Function.locallyFinsuppWithin.apply_eq_zero_of_notMem _ hw_not_inner
  have hPc := selectedZeroProduct_ne_zero_of_divisor_eq_zero hDc
  have hPw := selectedZeroProduct_ne_zero_of_divisor_eq_zero hDw
  rw [selectedRegularFactor_eq_raw hR hf hw_outer hPw,
    selectedRegularFactor_eq_raw hR hf hc_outer hPc]
  simp only [selectedRawFactor, Pi.mul_apply, Pi.inv_apply, norm_mul, norm_inv]
  have hPnorm := norm_selectedZeroProduct_center_le_sphere hR hf hc hw
  have hPinv : ‖selectedZeroProduct f c R w‖⁻¹ ≤
      ‖selectedZeroProduct f c R c‖⁻¹ :=
    (inv_le_inv₀ (norm_pos_iff.mpr hPw) (norm_pos_iff.mpr hPc)).2 hPnorm
  calc
    ‖selectedZeroProduct f c R w‖⁻¹ * ‖f w‖
        ≤ ‖selectedZeroProduct f c R w‖⁻¹ *
            (Real.exp M * ‖f c‖) :=
      mul_le_mul_of_nonneg_left (hbound w hw) (inv_nonneg.mpr (norm_nonneg _))
    _ ≤ ‖selectedZeroProduct f c R c‖⁻¹ *
          (Real.exp M * ‖f c‖) :=
      mul_le_mul_of_nonneg_right hPinv (mul_nonneg (Real.exp_pos M).le (norm_nonneg _))
    _ = Real.exp M *
          (‖selectedZeroProduct f c R c‖⁻¹ * ‖f c‖) := by ring

theorem norm_selectedRegularFactor_le_on_outer_closedBall
    {f : ℂ -> ℂ} {c z : ℂ} {R M : ℝ} (hR : 0 < R)
    (hf : AnalyticOnNhd ℂ f (closedBall c (4 * R))) (hc : f c ≠ 0)
    (hbound : ∀ w ∈ sphere c (4 * R),
      ‖f w‖ ≤ Real.exp M * ‖f c‖)
    (hz : z ∈ closedBall c (4 * R)) :
    ‖selectedRegularFactor f c R z‖ ≤
      Real.exp M * ‖selectedRegularFactor f c R c‖ := by
  have h4R : 4 * R ≠ 0 := by positivity
  apply Complex.norm_le_of_forall_mem_frontier_norm_le isBounded_ball
    ((analyticOnNhd_selectedRegularFactor hR hf hc).differentiableOn.diffContOnCl_ball
      (by rfl))
  · intro w hw
    apply norm_selectedRegularFactor_le_on_outer_sphere hR hf hc hbound
    simpa [frontier_ball c h4R] using hw
  · simpa [closure_ball c h4R] using hz

theorem norm_logDeriv_selectedRegularFactor_le
    {f : ℂ -> ℂ} {c s : ℂ} {R M : ℝ} (hR : 0 < R) (hM : 0 < M)
    (hf : AnalyticOnNhd ℂ f (closedBall c (4 * R))) (hc : f c ≠ 0)
    (hbound : ∀ z ∈ sphere c (4 * R), ‖f z‖ ≤ Real.exp M * ‖f c‖)
    (hs : s ∈ closedBall c R) :
    ‖logDeriv (selectedRegularFactor f c R) s‖ ≤ 16 * M / R := by
  let G := selectedRegularFactor f c R
  have hG : AnalyticOnNhd ℂ G (closedBall c (4 * R)) :=
    analyticOnNhd_selectedRegularFactor hR hf hc
  have hGne {z : ℂ} (hz : z ∈ closedBall c (2 * R)) : G z ≠ 0 :=
    selectedRegularFactor_ne_zero hR hf hc hz
  have hlogDiff : DifferentiableOn ℂ (logDeriv G) (ball c (2 * R)) := by
    intro z hz
    have hz' : z ∈ closedBall c (2 * R) := mem_closedBall.mpr (mem_ball.mp hz).le
    have hz'' : z ∈ closedBall c (4 * R) :=
      closedBall_subset_closedBall (by linarith) hz'
    exact (by
      simpa [logDeriv] using ((hG z hz'').deriv.div (hG z hz'') (hGne hz'))
      : AnalyticAt ℂ (logDeriv G) z).differentiableAt.differentiableWithinAt
  obtain ⟨H, hHc, hH⟩ := hlogDiff.isExactOn_ball.with_val_at c 0
  have hHDiff : DifferentiableOn ℂ H (ball c (2 * R)) :=
    fun z hz => (hH z hz).differentiableAt.differentiableWithinAt
  have hc_ball : c ∈ ball c (2 * R) := mem_ball_self (by positivity)
  have hGDiff : DifferentiableOn ℂ G (ball c (2 * R)) := by
    intro z hz
    exact (hG z (closedBall_subset_closedBall (by linarith)
      (mem_closedBall.mpr (mem_ball.mp hz).le))).differentiableAt.differentiableWithinAt
  have hEDiff : DifferentiableOn ℂ (Complex.exp ∘ H) (ball c (2 * R)) := by
    intro z hz
    exact (Complex.differentiableAt_exp.comp z
      (hH z hz).differentiableAt).differentiableWithinAt
  have hlogEq : EqOn (logDeriv (Complex.exp ∘ H)) (logDeriv G) (ball c (2 * R)) := by
    intro z hz
    rw [logDeriv_comp Complex.differentiableAt_exp (hH z hz).differentiableAt]
    simp only [logDeriv_apply, (Complex.hasDerivAt_exp _).deriv,
      div_self (Complex.exp_ne_zero _), one_mul, (hH z hz).deriv]
  obtain ⟨a, ha, hEq⟩ := (logDeriv_eqOn_iff hEDiff hGDiff isOpen_ball
    (convex_ball c (2 * R)).isPreconnected (fun z hz => hGne
      (mem_closedBall.mpr (mem_ball.mp hz).le))
    (fun z _ => Complex.exp_ne_zero (H z))).mp hlogEq
  have hGc : G c ≠ 0 := hGne (by simp [hR.le])
  have ha_eq : a = (G c)⁻¹ := by
    apply eq_inv_of_mul_eq_one_left
    simpa [hHc, smul_eq_mul] using (hEq hc_ball).symm
  have hHre {z : ℂ} (hz : z ∈ ball c (2 * R)) : (H z).re ≤ M := by
    have hz_outer : z ∈ closedBall c (4 * R) :=
      closedBall_subset_closedBall (by linarith)
        (mem_closedBall.mpr (mem_ball.mp hz).le)
    have hmax := norm_selectedRegularFactor_le_on_outer_closedBall hR hf hc hbound hz_outer
    have hexp : ‖Complex.exp (H z)‖ ≤ Real.exp M := by
      change ‖(Complex.exp ∘ H) z‖ ≤ Real.exp M
      rw [hEq hz, ha_eq]
      simp only [Pi.smul_apply, smul_eq_mul, norm_mul, norm_inv]
      calc
        ‖G c‖⁻¹ * ‖G z‖ ≤ ‖G c‖⁻¹ * (Real.exp M * ‖G c‖) :=
          mul_le_mul_of_nonneg_left hmax (inv_nonneg.mpr (norm_nonneg _))
        _ = Real.exp M := by field_simp
    rw [Complex.norm_exp] at hexp
    exact Real.exp_le_exp.mp hexp
  have hHbound {w : ℂ} (hw : w ∈ sphere s (R / 2)) : ‖H w‖ ≤ 6 * M := by
    have hws : dist w s = R / 2 := mem_sphere.mp hw
    have hsc : dist s c ≤ R := by simpa [dist_comm] using mem_closedBall.mp hs
    have hwc : ‖w - c‖ ≤ 3 * R / 2 := by
      rw [← dist_eq_norm]
      linarith [dist_triangle w s c]
    have huc : w - c ∈ ball (0 : ℂ) (2 * R) := by
      rw [mem_ball_zero_iff]
      linarith
    have hBC := Complex.borelCaratheodory_zero hM (f := fun u => H (c + u)) (R := 2 * R)
      (by
        intro u hu
        have hcu : c + u ∈ ball c (2 * R) := by
          simpa [mem_ball, dist_eq_norm] using hu
        exact ((hH (c + u) hcu).differentiableAt.comp u
          (by fun_prop)).differentiableWithinAt)
      (by
        intro u hu
        have hcu : c + u ∈ ball c (2 * R) := by
          simpa [mem_ball, dist_eq_norm] using hu
        exact hHre hcu)
      (by positivity) huc (by simpa using hHc)
    have hden : 0 < 2 * R - ‖w - c‖ := by linarith
    calc
      ‖H w‖ = ‖H (c + (w - c))‖ := by ring_nf
      _ ≤ 2 * M * ‖w - c‖ / (2 * R - ‖w - c‖) := hBC
      _ ≤ 6 * M := by
        rw [div_le_iff₀ hden]
        nlinarith [mul_nonneg hM.le (norm_nonneg (w - c))]
  have hclosure : closedBall s (R / 2) ⊆ ball c (2 * R) := by
    intro w hw
    have hws : dist w s ≤ R / 2 := mem_closedBall.mp hw
    have hsc : dist s c ≤ R := by simpa [dist_comm] using mem_closedBall.mp hs
    exact mem_ball.mpr (by linarith [dist_triangle w s c])
  have hCauchy := Complex.norm_deriv_le_of_forall_mem_sphere_norm_le
    (by positivity : 0 < R / 2)
    (hHDiff.diffContOnCl_ball hclosure)
    (fun w hw => hHbound hw)
  rw [(hH s (hclosure (mem_closedBall_self (by positivity)))).deriv] at hCauchy
  calc
    ‖logDeriv G s‖ ≤ 6 * M / (R / 2) := hCauchy
    _ ≤ 16 * M / R := by
      field_simp
      nlinarith

theorem logDeriv_factorizedRational_eq_finsum
    {D : ℂ -> ℤ} (hD : D.support.Finite) {s : ℂ} (hs : D s = 0) :
    logDeriv (∏ᶠ rho : ℂ, (fun z => z - rho) ^ D rho) s =
      ∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho) := by
  have hmul : (fun rho : ℂ => (fun z : ℂ => z - rho) ^ D rho).mulSupport ⊆
      hD.toFinset := by
    rw [Function.FactorizedRational.mulSupport]
    exact hD.coe_toFinset.ge
  rw [finprod_eq_prod_of_mulSupport_subset _ hmul]
  have hprod : (∏ rho ∈ hD.toFinset, (fun z : ℂ => z - rho) ^ D rho) =
      fun z => ∏ rho ∈ hD.toFinset, (z - rho) ^ D rho := by ext z; simp
  rw [hprod, logDeriv_fun_prod]
  · rw [finsum_eq_sum_of_support_subset]
    · apply Finset.sum_congr rfl
      intro rho _
      rw [logDeriv_fun_zpow (by fun_prop)]
      simp [logDeriv_apply, div_eq_mul_inv]
    · intro rho hrho
      apply hD.mem_toFinset.mpr
      intro hzero
      simp [hzero] at hrho
  · intro rho hrho
    have hrho := Function.mem_support.mp (hD.mem_toFinset.mp hrho)
    exact zpow_ne_zero _ (sub_ne_zero.mpr (fun h => hrho (h ▸ hs)))
  · intro rho hrho
    have hrho := Function.mem_support.mp (hD.mem_toFinset.mp hrho)
    exact (by fun_prop : DifferentiableAt ℂ (fun z : ℂ => z - rho) s).zpow
      (.inl (sub_ne_zero.mpr (fun h => hrho (h ▸ hs))))

theorem logDeriv_selectedRegularFactor_eq_sub_finsum
    {f : ℂ -> ℂ} {c s : ℂ} {R : ℝ} (hR : 0 < R)
    (hf : AnalyticOnNhd ℂ f (closedBall c (4 * R))) (hc : f c ≠ 0)
    (hs : s ∈ closedBall c R) (hfs : f s ≠ 0) :
    logDeriv (selectedRegularFactor f c R) s = logDeriv f s -
      ∑ᶠ rho : ℂ, ((selectedDivisor f c R rho : ℤ) : ℂ) / (s - rho) := by
  have hs_inner : s ∈ closedBall c (2 * R) :=
    closedBall_subset_closedBall (by linarith) hs
  have hs_outer : s ∈ closedBall c (4 * R) :=
    closedBall_subset_closedBall (by linarith) hs
  have hDs := selectedDivisor_apply_eq_zero_of_ne_zero hR hf hc hs_inner hfs
  have hPs := selectedZeroProduct_ne_zero_of_divisor_eq_zero hDs
  have hPa : AnalyticAt ℂ (selectedZeroProduct f c R) s := by
    unfold selectedZeroProduct
    exact Function.FactorizedRational.analyticAt (selectedDivisor_nonneg hR hf s)
  have hrawa : AnalyticAt ℂ (selectedRawFactor f c R) s := by
    unfold selectedRawFactor
    exact (hPa.inv hPs).mul (hf s hs_outer)
  have hraw := meromorphicOn_selectedRawFactor hf
  have heq : selectedRegularFactor f c R =ᶠ[nhds s] selectedRawFactor f c R := by
    simpa [selectedRegularFactor, toMeromorphicNFAt_eq_self.2 hrawa.meromorphicNFAt] using
      toMeromorphicNFOn_eq_toMeromorphicNFAt_on_nhds hraw hs_outer
  have hlogeq : logDeriv (selectedRegularFactor f c R) s =
      logDeriv (selectedRawFactor f c R) s := by
    simp only [logDeriv_apply]
    rw [heq.deriv_eq, heq.self_of_nhds]
  rw [hlogeq]
  have hrawfun : selectedRawFactor f c R =
      fun z => f z / selectedZeroProduct f c R z := by
    funext z
    simp [selectedRawFactor, div_eq_mul_inv, mul_comm]
  rw [hrawfun, logDeriv_fun_div s hfs hPs (hf s hs_outer).differentiableAt
    hPa.differentiableAt]
  rw [selectedZeroProduct, logDeriv_factorizedRational_eq_finsum
    (selectedDivisor_support_finite f c R) hDs]

end FixedDiskLogDerivative

theorem norm_logDeriv_sub_divisor_finsum_le
    {f : ℂ → ℂ} {c s : ℂ} {R M : ℝ}
    (hR : 0 < R) (hM : 0 ≤ M)
    (hf : AnalyticOnNhd ℂ f (closedBall c (4 * R)))
    (hc : f c ≠ 0)
    (hbound : ∀ z ∈ sphere c (4 * R),
      ‖f z‖ ≤ Real.exp M * ‖f c‖)
    (hs : s ∈ closedBall c R) (hfs : f s ≠ 0) :
    ‖logDeriv f s - ∑ᶠ rho : ℂ,
      ((MeromorphicOn.divisor f (closedBall c (2 * R))) rho : ℂ) /
        (s - rho)‖ ≤ 16 * M / R := by
  have hid := logDeriv_selectedRegularFactor_eq_sub_finsum hR hf hc hs hfs
  rw [selectedDivisor] at hid
  rw [← hid]
  rcases hM.eq_or_lt with rfl | hM
  · simp only [mul_zero, zero_div]
    refine le_of_forall_pos_le_add fun ε hε => ?_
    have hεR : 0 < ε * R / 16 := by positivity
    have hb : ∀ z ∈ sphere c (4 * R),
        ‖f z‖ ≤ Real.exp (ε * R / 16) * ‖f c‖ := by
      intro z hz
      exact (hbound z hz).trans (mul_le_mul_of_nonneg_right
        (Real.exp_le_exp.mpr hεR.le) (norm_nonneg _))
    have he := norm_logDeriv_selectedRegularFactor_le hR hεR hf hc hb hs
    exact he.trans_eq (by field_simp [hR.ne']; ring)
  · exact norm_logDeriv_selectedRegularFactor_le hR hM hf hc hbound hs

end

section
open Complex

theorem exists_nat_norm_logDeriv_LFunction_sub_radiusSix_divisor_finsum_le :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ (q : ℕ) [NeZero q], 1 < q →
        ∀ (chi : DirichletCharacter ℂ q), chi.IsPrimitive →
          ∀ (t : ℝ) (s : ℂ),
            s ∈ closedBall ((2 : ℂ) + t * I) 3 →
              DirichletCharacter.LFunction chi s ≠ 0 →
                ‖logDeriv (DirichletCharacter.LFunction chi) s -
                    ∑ᶠ rho : ℂ,
                      ((MeromorphicOn.divisor
                        (DirichletCharacter.LFunction chi)
                        (closedBall ((2 : ℂ) + t * I) 6)) rho : ℂ) /
                          (s - rho)‖ ≤
                  16 * ((A : ℝ) *
                    Real.log ((q : ℝ) * (|t| + 2))) / 3 := by
  obtain ⟨A, hA, hgrowth⟩ :=
    exists_nat_norm_LFunction_radiusTwelveSphere_le_exp_mul_center
  refine ⟨A, hA, ?_⟩
  intro q _ hq chi hchi t s hs hLs
  let c : ℂ := (2 : ℂ) + t * I
  let B : ℝ := (q : ℝ) * (|t| + 2)
  let M : ℝ := (A : ℝ) * Real.log B
  have hq2 : (2 : ℝ) ≤ q := by exact_mod_cast hq
  have hT2 : (2 : ℝ) ≤ |t| + 2 := by linarith [abs_nonneg t]
  have hB4 : (4 : ℝ) ≤ B := by
    dsimp [B]
    nlinarith
  have hM : 0 ≤ M := by
    exact mul_nonneg (Nat.cast_nonneg A) (Real.log_nonneg (by linarith))
  have hchi_ne : chi ≠ 1 := character_ne_one_of_isPrimitive hq chi hchi
  have hf : AnalyticOnNhd ℂ (DirichletCharacter.LFunction chi)
      (closedBall c (4 * (3 : ℝ))) :=
    fun z _ => (DirichletCharacter.differentiable_LFunction hchi_ne).analyticAt z
  have hc : DirichletCharacter.LFunction chi c ≠ 0 := by
    have hc_re : 1 < c.re := by simp [c]
    rw [DirichletCharacter.LFunction_eq_LSeries chi hc_re]
    exact DirichletCharacter.LSeries_ne_zero_of_one_lt_re chi hc_re
  have hbound : ∀ z ∈ sphere c (4 * (3 : ℝ)),
      ‖DirichletCharacter.LFunction chi z‖ ≤
        Real.exp M * ‖DirichletCharacter.LFunction chi c‖ := by
    intro z hz
    norm_num at hz
    simpa [c, M, B] using
      hgrowth q hq chi hchi t z (by simpa [c] using hz)
  have hfixed := norm_logDeriv_sub_divisor_finsum_le
    (f := DirichletCharacter.LFunction chi) (c := c) (s := s)
    (R := (3 : ℝ)) (M := M) (by norm_num) hM hf hc hbound
    (by simpa [c] using hs) hLs
  rw [show (2 : ℝ) * 3 = 6 by norm_num] at hfixed
  simpa [c, M, B] using hfixed

theorem exists_nat_norm_logDeriv_LFunction_sub_radiusSix_analyticOrder_finsum_le :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ (q : ℕ) [NeZero q], 1 < q →
        ∀ (chi : DirichletCharacter ℂ q), chi.IsPrimitive →
          ∀ (t : ℝ) (s : ℂ),
            s ∈ closedBall ((2 : ℂ) + t * I) 3 →
              DirichletCharacter.LFunction chi s ≠ 0 →
                ‖logDeriv (DirichletCharacter.LFunction chi) s -
                    ∑ᶠ rho : ℂ,
                      ((if dist rho ((2 : ℂ) + t * I) ≤ 6 then
                          analyticOrderNatAt
                            (DirichletCharacter.LFunction chi) rho
                        else 0 : ℕ) : ℂ) / (s - rho)‖ ≤
                  16 * ((A : ℝ) *
                    Real.log ((q : ℝ) * (|t| + 2))) / 3 := by
  obtain ⟨A, hA, hbound⟩ :=
    exists_nat_norm_logDeriv_LFunction_sub_radiusSix_divisor_finsum_le
  refine ⟨A, hA, ?_⟩
  intro q _ hq chi hchi t s hs hLs
  rw [← finsum_divisor_LFunction_radiusSix_eq hq chi hchi t s]
  exact hbound q hq chi hchi t s hs hLs

section PrimitiveLFunctionSelectedSubdivisor
theorem radiusSixAnalyticOrder_hasFiniteSupport
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    (t : ℝ) :
    Function.HasFiniteSupport fun rho : ℂ =>
      if dist rho ((2 : ℂ) + t * I) ≤ 6 then
        analyticOrderNatAt (DirichletCharacter.LFunction chi) rho
      else 0 := by
  apply (divisor_LFunction_closedBall_support_finite
    (character_ne_one_of_isPrimitive hq chi hchi)
    ((2 : ℂ) + t * I) 6).subset
  intro rho hrho
  rw [Function.mem_support] at hrho ⊢
  rw [divisor_LFunction_radiusSix_apply hq chi hchi t rho]
  exact_mod_cast hrho

end PrimitiveLFunctionSelectedSubdivisor

theorem selected_radiusSix_subdivisor_sum_le_re_analyticOrder_finsum
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    (t : ℝ) (s : ℂ) (hs : 1 ≤ s.re) (Z : ℂ →₀ ℕ)
    (hZ : ∀ rho : ℂ,
      Z rho ≤
        if dist rho ((2 : ℂ) + t * I) ≤ 6 then
          analyticOrderNatAt (DirichletCharacter.LFunction chi) rho
        else 0) :
    Z.sum (fun rho m =>
        (m : ℝ) * (((s - rho)⁻¹).re)) ≤
      (∑ᶠ rho : ℂ,
        ((if dist rho ((2 : ℂ) + t * I) ≤ 6 then
            analyticOrderNatAt (DirichletCharacter.LFunction chi) rho
          else 0 : ℕ) : ℂ) / (s - rho)).re := by
  let m : ℂ → ℕ := fun rho =>
    if dist rho ((2 : ℂ) + t * I) ≤ 6 then
      analyticOrderNatAt (DirichletCharacter.LFunction chi) rho
    else 0
  have hm : (Function.support m).Finite :=
    radiusSixAnalyticOrder_hasFiniteSupport hq chi hchi t
  have hZsupport : Z.support ⊆ hm.toFinset := by
    intro rho hrho
    apply hm.mem_toFinset.mpr
    rw [Function.mem_support]
    intro hmrho
    have hZrho : Z rho = 0 :=
      Nat.eq_zero_of_le_zero ((hZ rho).trans_eq hmrho)
    exact Finsupp.mem_support_iff.mp hrho hZrho
  have hfullSupport :
      Function.support (fun rho : ℂ => (m rho : ℂ) / (s - rho)) ⊆
        hm.toFinset := by
    intro rho hrho
    apply hm.mem_toFinset.mpr
    rw [Function.mem_support] at hrho ⊢
    exact fun hmrho => hrho (by simp [hmrho])
  have hfullSum :
      (∑ᶠ rho : ℂ, (m rho : ℂ) / (s - rho)) =
        ∑ rho ∈ hm.toFinset, (m rho : ℂ) / (s - rho) :=
    finsum_eq_sum_of_support_subset
      (fun rho : ℂ => (m rho : ℂ) / (s - rho)) hfullSupport
  rw [Finsupp.sum_of_support_subset Z hZsupport _ (by simp)]
  change (∑ rho ∈ hm.toFinset,
      (Z rho : ℝ) * ((s - rho)⁻¹).re) ≤
    (∑ᶠ rho : ℂ, (m rho : ℂ) / (s - rho)).re
  rw [hfullSum, Complex.re_sum]
  apply Finset.sum_le_sum
  intro rho _
  by_cases hmrho : m rho = 0
  · have hZrho : Z rho = 0 :=
      Nat.eq_zero_of_le_zero ((hZ rho).trans_eq hmrho)
    simp [hZrho, hmrho]
  · have hzero : DirichletCharacter.LFunction chi rho = 0 :=
      apply_eq_zero_of_analyticOrderNatAt_ne_zero (by
        dsimp [m] at hmrho
        split at hmrho
        · exact hmrho
        · exact False.elim (hmrho rfl))
    have hrho : rho.re < 1 :=
      LFunction_zero_re_lt_one_of_isPrimitive hq chi hchi hzero
    have hinv : 0 ≤ ((s - rho)⁻¹).re := by
      rw [Complex.inv_re]
      exact div_nonneg (by simp only [Complex.sub_re]; linarith)
        (Complex.normSq_nonneg _)
    have hcoeff : (Z rho : ℝ) ≤ (m rho : ℝ) := by
      exact_mod_cast hZ rho
    simpa [div_eq_mul_inv] using
      mul_le_mul_of_nonneg_right hcoeff hinv

theorem exists_nat_selected_radiusSix_subdivisor_sum_sub_le_re_logDeriv_LFunction :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ (q : ℕ) [NeZero q], 1 < q →
        ∀ (chi : DirichletCharacter ℂ q), chi.IsPrimitive →
          ∀ (t sigma : ℝ) (Z : ℂ →₀ ℕ),
            1 ≤ sigma → sigma ≤ 2 →
              DirichletCharacter.LFunction chi
                  ((sigma : ℂ) + t * I) ≠ 0 →
                (∀ rho : ℂ,
                  Z rho ≤
                    if dist rho ((2 : ℂ) + t * I) ≤ 6 then
                      analyticOrderNatAt
                        (DirichletCharacter.LFunction chi) rho
                    else 0) →
                  Z.sum (fun rho m =>
                      (m : ℝ) *
                        ((((sigma : ℂ) + t * I) - rho)⁻¹).re) -
                      16 * ((A : ℝ) *
                        Real.log ((q : ℝ) * (|t| + 2))) / 3 ≤
                    (logDeriv (DirichletCharacter.LFunction chi)
                      ((sigma : ℂ) + t * I)).re := by
  obtain ⟨A, hA, hfixed⟩ :=
    exists_nat_norm_logDeriv_LFunction_sub_radiusSix_analyticOrder_finsum_le
  refine ⟨A, hA, ?_⟩
  intro q _ hq chi hchi t sigma Z hsigma1 hsigma2 hLs hZ
  let s : ℂ := (sigma : ℂ) + t * I
  let E : ℝ :=
    16 * ((A : ℝ) * Real.log ((q : ℝ) * (|t| + 2))) / 3
  let S : ℂ := ∑ᶠ rho : ℂ,
    ((if dist rho ((2 : ℂ) + t * I) ≤ 6 then
        analyticOrderNatAt (DirichletCharacter.LFunction chi) rho
      else 0 : ℕ) : ℂ) / (s - rho)
  have hsball : s ∈ closedBall ((2 : ℂ) + t * I) 3 := by
    rw [mem_closedBall, Complex.dist_eq]
    have hdiff :
        s - ((2 : ℂ) + t * I) = ((sigma - 2 : ℝ) : ℂ) := by
      simp [s]
    rw [hdiff, Complex.norm_real, Real.norm_eq_abs, abs_le]
    constructor <;> linarith
  have hsre : 1 ≤ s.re := by
    simpa [s] using hsigma1
  have hnorm :
      ‖logDeriv (DirichletCharacter.LFunction chi) s - S‖ ≤ E := by
    simpa [S, E] using
      hfixed q hq chi hchi t s hsball (by simpa [s] using hLs)
  have hselected :
      Z.sum (fun rho m =>
        (m : ℝ) * (((s - rho)⁻¹).re)) ≤ S.re := by
    simpa [S] using
      selected_radiusSix_subdivisor_sum_le_re_analyticOrder_finsum
        hq chi hchi t s hsre Z hZ
  have hnormSwap :
      ‖S - logDeriv (DirichletCharacter.LFunction chi) s‖ ≤ E := by
    rw [norm_sub_rev]
    exact hnorm
  have hreal :
      (S - logDeriv (DirichletCharacter.LFunction chi) s).re ≤
        ‖S - logDeriv (DirichletCharacter.LFunction chi) s‖ :=
    Complex.re_le_norm _
  have hresult :
      Z.sum (fun rho m =>
          (m : ℝ) * (((s - rho)⁻¹).re)) - E ≤
        (logDeriv (DirichletCharacter.LFunction chi) s).re := by
    rw [Complex.sub_re] at hreal
    linarith
  simpa [s, E] using hresult

theorem IsPrimitiveNontrivialLFunctionZero.LFunction_eq_zero
    {q : ℕ} [NeZero q] {chi : DirichletCharacter ℂ q} {rho : ℂ}
    (hrho : (1 < q ∧ chi.IsPrimitive ∧
              DirichletCharacter.completedLFunction chi rho = 0)) :
    DirichletCharacter.LFunction chi rho = 0 := by
  rw [DirichletCharacter.LFunction_eq_completed_div_gammaFactor chi rho
    (.inr (Nat.ne_of_gt hrho.1)), hrho.2.2, zero_div]

theorem IsPrimitiveNontrivialLFunctionZero.re_pos
    {q : ℕ} [NeZero q] {chi : DirichletCharacter ℂ q} {rho : ℂ}
    (hrho : (1 < q ∧ chi.IsPrimitive ∧
              DirichletCharacter.completedLFunction chi rho = 0)) :
    0 < rho.re := by
  by_contra hrhoRe
  have hchi_ne : chi ≠ 1 :=
    character_ne_one_of_isPrimitive hrho.1 chi hrho.2.1
  have hq0 : (q : ℂ) ≠ 0 := by
    exact_mod_cast NeZero.ne q
  have hroot : DirichletCharacter.rootNumber chi ≠ 0 := by
    apply norm_ne_zero_iff.mp
    rw [norm_rootNumber_of_isPrimitive chi hrho.2.1]
    exact one_ne_zero
  have hfun := hrho.2.1.completedLFunction_one_sub (1 - rho)
  have hinvzero :
      DirichletCharacter.completedLFunction chi⁻¹ (1 - rho) = 0 := by
    rw [show 1 - (1 - rho) = rho by ring] at hfun
    rw [show 1 - rho - 1 / 2 = 1 / 2 - rho by ring] at hfun
    have hpow : (q : ℂ) ^ ((1 / 2 : ℂ) - rho) ≠ 0 :=
      Complex.cpow_ne_zero_iff.mpr (.inl hq0)
    exact (mul_eq_zero.mp (hfun.symm.trans hrho.2.2)).resolve_left
      (mul_ne_zero hpow hroot)
  have hLzero : DirichletCharacter.LFunction chi⁻¹ (1 - rho) = 0 := by
    rw [DirichletCharacter.LFunction_eq_completed_div_gammaFactor chi⁻¹
      (1 - rho) (.inr (Nat.ne_of_gt hrho.1)), hinvzero, zero_div]
  exact ((chi⁻¹).LFunction_ne_zero_of_one_le_re
    (.inl (inv_ne_one.mpr hchi_ne)) (by simp; linarith)) hLzero

theorem IsPrimitiveNontrivialLFunctionZero.re_lt_one
    {q : ℕ} [NeZero q] {chi : DirichletCharacter ℂ q} {rho : ℂ}
    (hrho : (1 < q ∧ chi.IsPrimitive ∧
              DirichletCharacter.completedLFunction chi rho = 0)) :
    rho.re < 1 :=
  LFunction_zero_re_lt_one_of_isPrimitive hrho.1 chi hrho.2.1
    (IsPrimitiveNontrivialLFunctionZero.LFunction_eq_zero hrho)

theorem isPrimitiveNontrivialLFunctionZero_iff
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q) (rho : ℂ) :
    (1 < q ∧ chi.IsPrimitive ∧
      DirichletCharacter.completedLFunction chi rho = 0) ↔
      1 < q ∧ chi.IsPrimitive ∧
        DirichletCharacter.LFunction chi rho = 0 ∧
          0 < rho.re ∧ rho.re < 1 := by
  constructor
  · intro hrho
    exact ⟨hrho.1, hrho.2.1, (IsPrimitiveNontrivialLFunctionZero.LFunction_eq_zero hrho),
      (IsPrimitiveNontrivialLFunctionZero.re_pos hrho),
      (IsPrimitiveNontrivialLFunctionZero.re_lt_one hrho)⟩
  · rintro ⟨hq, hchi, hL, hre0, hre1⟩
    refine ⟨hq, hchi, ?_⟩
    have hgamma := gammaFactor_ne_zero_of_re_pos chi hre0
    have hquot :
        DirichletCharacter.completedLFunction chi rho /
            DirichletCharacter.gammaFactor chi rho = 0 :=
      (DirichletCharacter.LFunction_eq_completed_div_gammaFactor chi rho
        (.inr (Nat.ne_of_gt hq))).symm.trans hL
    exact (div_eq_zero_iff.mp hquot).resolve_right hgamma

theorem IsPrimitiveNontrivialLFunctionZero.dist_two_add_mul_I_le_six
    {q : ℕ} [NeZero q] {chi : DirichletCharacter ℂ q} {rho : ℂ}
    (hrho : (1 < q ∧ chi.IsPrimitive ∧
              DirichletCharacter.completedLFunction chi rho = 0))
    {t : ℝ} (hheight : |rho.im - t| ≤ 1) :
    dist rho ((2 : ℂ) + t * I) ≤ 6 := by
  have hre0 := IsPrimitiveNontrivialLFunctionZero.re_pos hrho
  have hre1 := IsPrimitiveNontrivialLFunctionZero.re_lt_one hrho
  have hre : |rho.re - 2| ≤ (2 : ℝ) := by
    rw [abs_le]
    constructor <;> linarith only [hre0, hre1]
  have hn : ‖rho - ((2 : ℂ) + t * I)‖ ≤ |rho.re - 2| + |rho.im - t| := by
    simpa using Complex.norm_le_abs_re_add_abs_im (rho - ((2 : ℂ) + t * I))
  rw [Complex.dist_eq]
  linarith only [hn, hre, hheight]

theorem selectedPrimitiveNontrivialZeros_le_radiusSix_analyticOrder
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    (t : ℝ) (Z : ℂ →₀ ℕ)
    (hZ : ∀ rho ∈ Z.support,
      (1 < q ∧ chi.IsPrimitive ∧
        DirichletCharacter.completedLFunction chi rho = 0) ∧
        |rho.im - t| ≤ 1)
    (hmult : ∀ rho : ℂ,
      Z rho ≤ analyticOrderNatAt
        (DirichletCharacter.LFunction chi) rho) :
    ∀ rho : ℂ,
      Z rho ≤
        if dist rho ((2 : ℂ) + t * I) ≤ 6 then
          analyticOrderNatAt (DirichletCharacter.LFunction chi) rho
        else 0 := by
  intro rho
  by_cases hzero : Z rho = 0
  · simp [hzero]
  · have hmem : rho ∈ Z.support := Finsupp.mem_support_iff.mpr hzero
    have hdisk : dist rho ((2 : ℂ) + t * I) ≤ 6 :=
      IsPrimitiveNontrivialLFunctionZero.dist_two_add_mul_I_le_six
        (hZ rho hmem).1 (hZ rho hmem).2
    rw [ite_eq_left hdisk]
    exact hmult rho

theorem exists_nat_selectedPrimitiveNontrivialZeros_sum_sub_le_re_logDeriv_LFunction :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ (q : ℕ) [NeZero q], 1 < q →
        ∀ (chi : DirichletCharacter ℂ q), chi.IsPrimitive →
          ∀ (t sigma : ℝ) (Z : ℂ →₀ ℕ),
            1 ≤ sigma → sigma ≤ 2 →
              DirichletCharacter.LFunction chi
                  ((sigma : ℂ) + t * I) ≠ 0 →
                (∀ rho ∈ Z.support,
                  (1 < q ∧ chi.IsPrimitive ∧
                    DirichletCharacter.completedLFunction chi rho = 0) ∧
                    |rho.im - t| ≤ 1) →
                  (∀ rho : ℂ,
                    Z rho ≤ analyticOrderNatAt
                      (DirichletCharacter.LFunction chi) rho) →
                    Z.sum (fun rho m =>
                        (m : ℝ) *
                          ((((sigma : ℂ) + t * I) - rho)⁻¹).re) -
                        16 * ((A : ℝ) *
                          Real.log ((q : ℝ) * (|t| + 2))) / 3 ≤
                      (logDeriv (DirichletCharacter.LFunction chi)
                        ((sigma : ℂ) + t * I)).re := by
  obtain ⟨A, hA, hselected⟩ :=
    exists_nat_selected_radiusSix_subdivisor_sum_sub_le_re_logDeriv_LFunction
  refine ⟨A, hA, ?_⟩
  intro q _ hq chi hchi t sigma Z hsigma1 hsigma2 hLs hZ hmult
  exact hselected q hq chi hchi t sigma Z hsigma1 hsigma2 hLs
    (selectedPrimitiveNontrivialZeros_le_radiusSix_analyticOrder
      chi t Z hZ hmult)

end

section
open Complex Set

section RiemannZetaHeightPole
theorem analyticOnNhd_riemannZeta₁ :
    AnalyticOnNhd ℂ riemannZeta₁ Set.univ :=
  differentiable_riemannZeta₁.differentiableOn.analyticOnNhd isOpen_univ

theorem analyticOrderAt_riemannZeta₁_ne_top (s : ℂ) :
    analyticOrderAt riemannZeta₁ s ≠ ⊤ := by
  rw [ne_eq, AnalyticOnNhd.analyticOrderAt_eq_top_iff_eq_zero s
    (fun z => analyticOnNhd_riemannZeta₁ z (mem_univ z))]
  intro hzero
  have hone := congrFun hzero 1
  change riemannZeta₁ 1 = 0 at hone
  rw [riemannZeta₁_one] at hone
  exact one_ne_zero hone

theorem divisor_riemannZeta₁_radiusTwo_apply
    (t : ℝ) (rho : ℂ) :
    MeromorphicOn.divisor riemannZeta₁
        (closedBall ((2 : ℂ) + t * I) 2) rho =
      ((if dist rho ((2 : ℂ) + t * I) ≤ 2 then
          analyticOrderNatAt riemannZeta₁ rho
        else 0 : ℕ) : ℤ) := by
  by_cases hrho : dist rho ((2 : ℂ) + t * I) ≤ 2
  · rw [ite_eq_left hrho, MeromorphicOn.AnalyticOnNhd.divisor_apply
      (analyticOnNhd_riemannZeta₁.mono
        (Set.subset_univ (closedBall ((2 : ℂ) + t * I) 2)))
      (mem_closedBall.mpr hrho)]
    have hfinite := analyticOrderAt_riemannZeta₁_ne_top rho
    rw [← Nat.cast_analyticOrderNatAt hfinite, ENat.map_natCast,
      WithTop.untop₀_coe]
  · rw [ite_eq_right hrho,
      Function.locallyFinsuppWithin.apply_eq_zero_of_notMem _
        (by simpa [mem_closedBall] using hrho)]
    norm_cast

theorem finsum_divisor_riemannZeta₁_radiusTwo_eq
    (t : ℝ) (s : ℂ) :
    (∑ᶠ rho : ℂ,
        ((MeromorphicOn.divisor riemannZeta₁
          (closedBall ((2 : ℂ) + t * I) 2)) rho : ℂ) / (s - rho)) =
      ∑ᶠ rho : ℂ,
        ((if dist rho ((2 : ℂ) + t * I) ≤ 2 then
            analyticOrderNatAt riemannZeta₁ rho
          else 0 : ℕ) : ℂ) / (s - rho) := by
  apply finsum_congr
  intro rho
  rw [divisor_riemannZeta₁_radiusTwo_apply t rho]
  norm_cast

end RiemannZetaHeightPole

theorem radiusTwoAnalyticOrder_hasFiniteSupport (t : ℝ) :
    Function.HasFiniteSupport fun rho : ℂ =>
      if dist rho ((2 : ℂ) + t * I) ≤ 2 then
        analyticOrderNatAt riemannZeta₁ rho
      else 0 := by
  have hfinite :
      (MeromorphicOn.divisor riemannZeta₁
        (closedBall ((2 : ℂ) + t * I) 2)).support.Finite :=
    (MeromorphicOn.divisor riemannZeta₁
      (closedBall ((2 : ℂ) + t * I) 2)).finiteSupport
        (isCompact_closedBall _ _)
  apply hfinite.subset
  intro rho hrho
  rw [Function.mem_support] at hrho ⊢
  rw [divisor_riemannZeta₁_radiusTwo_apply t rho]
  exact_mod_cast hrho

theorem riemannZeta₁_zero_re_lt_one
    {rho : ℂ} (hzero : riemannZeta₁ rho = 0) :
    rho.re < 1 := by
  have hrho1 : rho ≠ 1 := by
    intro h
    subst rho
    rw [riemannZeta₁_one] at hzero
    exact one_ne_zero hzero
  have hzeta : riemannZeta rho = 0 := by
    rw [riemannZeta_eq_inv_sub_mul hrho1, hzero, mul_zero]
  by_contra hrho
  exact (riemannZeta_ne_zero_of_one_le_re (le_of_not_gt hrho)) hzeta

theorem exists_nat_norm_logDeriv_riemannZeta₁_sub_radiusTwo_finsum_le :
    ∃ A : ℕ, 1 ≤ A ∧
      ∀ (t : ℝ) (s : ℂ),
        s ∈ closedBall ((2 : ℂ) + t * I) 1 →
          riemannZeta₁ s ≠ 0 →
            ‖logDeriv riemannZeta₁ s -
                ∑ᶠ rho : ℂ,
                  ((if dist rho ((2 : ℂ) + t * I) ≤ 2 then
                      analyticOrderNatAt riemannZeta₁ rho
                    else 0 : ℕ) : ℂ) / (s - rho)‖ ≤
              16 * (A : ℝ) * Real.log (|t| + 2) := by
  obtain ⟨A, hA, hgrowth⟩ :=
    exists_nat_norm_riemannZeta₁_radiusFourSphere_le_exp_mul_center
  refine ⟨A, hA, ?_⟩
  intro t s hs hfs
  let c : ℂ := (2 : ℂ) + t * I
  let T : ℝ := |t| + 2
  let M : ℝ := (A : ℝ) * Real.log T
  have hT2 : (2 : ℝ) ≤ T := by dsimp [T]; linarith [abs_nonneg t]
  have hM : 0 ≤ M :=
    mul_nonneg (Nat.cast_nonneg A) (Real.log_nonneg (by linarith))
  have hf : AnalyticOnNhd ℂ riemannZeta₁ (closedBall c (4 * (1 : ℝ))) :=
    analyticOnNhd_riemannZeta₁.mono
      (Set.subset_univ (closedBall c (4 * (1 : ℝ))))
  have hc1 : c ≠ 1 := by
    intro h
    have := congrArg Complex.re h
    simp [c] at this
  have hzeta : riemannZeta c ≠ 0 :=
    riemannZeta_ne_zero_of_one_le_re (by simp [c])
  have hc : riemannZeta₁ c ≠ 0 := by
    intro hzero
    have hfactor := riemannZeta_eq_inv_sub_mul hc1
    rw [hzero, mul_zero] at hfactor
    exact hzeta hfactor
  have hbound : ∀ z ∈ sphere c (4 * (1 : ℝ)),
      ‖riemannZeta₁ z‖ ≤ Real.exp M * ‖riemannZeta₁ c‖ := by
    intro z hz
    norm_num at hz
    simpa [c, M, T] using
      hgrowth t z (by simpa [c] using hz)
  have hfixed := norm_logDeriv_sub_divisor_finsum_le
    (f := riemannZeta₁) (c := c) (s := s) (R := (1 : ℝ)) (M := M)
    (by norm_num) hM hf hc hbound (by simpa [c] using hs) hfs
  rw [show (2 : ℝ) * 1 = 2 by norm_num,
    finsum_divisor_riemannZeta₁_radiusTwo_eq t s] at hfixed
  simpa [M, T, mul_assoc] using hfixed

theorem neg_logDeriv_riemannZeta_eq_pole_sub_regularized
    (s : ℂ) (hs : 1 ≤ s.re) (hs1 : s ≠ 1) :
    -logDeriv riemannZeta s =
      (s - 1)⁻¹ - logDeriv riemannZeta₁ s := by
  have hzeta : riemannZeta s ≠ 0 :=
    riemannZeta_ne_zero_of_one_le_re hs
  have hsub : s - 1 ≠ 0 := sub_ne_zero.mpr hs1
  have hzeta1 : riemannZeta₁ s ≠ 0 := by
    intro hzero
    have hfactor := riemannZeta_eq_inv_sub_mul hs1
    rw [hzero, mul_zero] at hfactor
    exact hzeta hfactor
  rw [logDeriv_apply, logDeriv_apply,
    deriv_riemannZeta_eq_neg_inv_sub_sq_mul_add hs1,
    riemannZeta_eq_inv_sub_mul hs1]
  field_simp [hsub, hzeta1]
  ring

section RiemannZetaHeightPole
theorem radiusTwoAnalyticOrder_finsum_re_nonneg
    (t : ℝ) (s : ℂ) (hs : 1 ≤ s.re) :
    0 ≤ (∑ᶠ rho : ℂ,
      ((if dist rho ((2 : ℂ) + t * I) ≤ 2 then
          analyticOrderNatAt riemannZeta₁ rho
        else 0 : ℕ) : ℂ) / (s - rho)).re := by
  let m : ℂ → ℕ := fun rho =>
    if dist rho ((2 : ℂ) + t * I) ≤ 2 then
      analyticOrderNatAt riemannZeta₁ rho
    else 0
  have hm : (Function.support m).Finite :=
    radiusTwoAnalyticOrder_hasFiniteSupport t
  have hsupport :
      Function.support (fun rho : ℂ => (m rho : ℂ) / (s - rho)) ⊆
        hm.toFinset := by
    intro rho hrho
    apply hm.mem_toFinset.mpr
    rw [Function.mem_support] at hrho ⊢
    exact fun hmrho => hrho (by simp [hmrho])
  rw [finsum_eq_sum_of_support_subset _ hsupport, Complex.re_sum]
  apply Finset.sum_nonneg
  intro rho _
  by_cases hmrho : m rho = 0
  · simp [hmrho]
  · have hzero : riemannZeta₁ rho = 0 :=
      apply_eq_zero_of_analyticOrderNatAt_ne_zero (by
        dsimp [m] at hmrho
        split at hmrho
        · exact hmrho
        · exact False.elim (hmrho rfl))
    have hrho : rho.re < 1 := riemannZeta₁_zero_re_lt_one hzero
    have hinv : 0 ≤ ((s - rho)⁻¹).re := by
      rw [Complex.inv_re]
      exact div_nonneg (by simp only [Complex.sub_re]; linarith)
        (Complex.normSq_nonneg _)
    simpa [div_eq_mul_inv] using
      mul_nonneg (show (0 : ℝ) ≤ m rho by positivity) hinv

end RiemannZetaHeightPole

theorem exists_nat_neg_logDeriv_riemannZeta_re_le_pole_add_log :
    ∃ A : ℕ, 1 ≤ A ∧
      ∀ s : ℂ, 1 ≤ s.re → s.re ≤ 2 → s ≠ 1 →
        (-logDeriv riemannZeta s).re ≤
          ((s - 1)⁻¹).re +
            16 * (A : ℝ) * Real.log (|s.im| + 2) := by
  obtain ⟨A, hA, hfixed⟩ :=
    exists_nat_norm_logDeriv_riemannZeta₁_sub_radiusTwo_finsum_le
  refine ⟨A, hA, ?_⟩
  intro s hs1 hs2 hsne
  let t : ℝ := s.im
  let S : ℂ := ∑ᶠ rho : ℂ,
    ((if dist rho ((2 : ℂ) + t * I) ≤ 2 then
        analyticOrderNatAt riemannZeta₁ rho
      else 0 : ℕ) : ℂ) / (s - rho)
  let E : ℝ := 16 * (A : ℝ) * Real.log (|t| + 2)
  have hsball : s ∈ closedBall ((2 : ℂ) + t * I) 1 := by
    rw [mem_closedBall, Complex.dist_eq]
    have hdiff : s - ((2 : ℂ) + t * I) = ((s.re - 2 : ℝ) : ℂ) := by
      apply Complex.ext <;> simp [t]
    rw [hdiff, Complex.norm_real, Real.norm_eq_abs, abs_le]
    constructor <;> linarith
  have hzeta : riemannZeta s ≠ 0 :=
    riemannZeta_ne_zero_of_one_le_re hs1
  have hzeta1 : riemannZeta₁ s ≠ 0 := by
    intro hzero
    have hfactor := riemannZeta_eq_inv_sub_mul hsne
    rw [hzero, mul_zero] at hfactor
    exact hzeta hfactor
  have hnorm : ‖logDeriv riemannZeta₁ s - S‖ ≤ E := by
    simpa [S, E, t] using hfixed t s hsball hzeta1
  have hsum : 0 ≤ S.re := by
    simpa [S] using radiusTwoAnalyticOrder_finsum_re_nonneg t s hs1
  have hswap : ‖S - logDeriv riemannZeta₁ s‖ ≤ E := by
    rw [norm_sub_rev]
    exact hnorm
  have hreal :
      (S - logDeriv riemannZeta₁ s).re ≤
        ‖S - logDeriv riemannZeta₁ s‖ :=
    Complex.re_le_norm _
  have hregular : -(logDeriv riemannZeta₁ s).re ≤ E := by
    rw [Complex.sub_re] at hreal
    linarith
  have hpole := congrArg Complex.re
    (neg_logDeriv_riemannZeta_eq_pole_sub_regularized s hs1 hsne)
  simp only [Complex.sub_re] at hpole
  simpa [E, t] using (show
    (-logDeriv riemannZeta s).re ≤ ((s - 1)⁻¹).re + E by linarith)

end

section
open Complex

theorem selected_radiusTwo_riemannZeta₁_subdivisor_sum_le_re_analyticOrder_finsum
    (t : ℝ) (s : ℂ) (hs : 1 ≤ s.re) (Z : ℂ →₀ ℕ)
    (hZ : ∀ rho : ℂ,
      Z rho ≤
        if dist rho ((2 : ℂ) + t * I) ≤ 2 then
          analyticOrderNatAt riemannZeta₁ rho
        else 0) :
    Z.sum (fun rho m =>
        (m : ℝ) * (((s - rho)⁻¹).re)) ≤
      (∑ᶠ rho : ℂ,
        ((if dist rho ((2 : ℂ) + t * I) ≤ 2 then
            analyticOrderNatAt riemannZeta₁ rho
          else 0 : ℕ) : ℂ) / (s - rho)).re := by
  let m : ℂ → ℕ := fun rho =>
    if dist rho ((2 : ℂ) + t * I) ≤ 2 then
      analyticOrderNatAt riemannZeta₁ rho
    else 0
  have hm : (Function.support m).Finite :=
    radiusTwoAnalyticOrder_hasFiniteSupport t
  have hZsupport : Z.support ⊆ hm.toFinset := by
    intro rho hrho
    apply hm.mem_toFinset.mpr
    rw [Function.mem_support]
    intro hmrho
    have hZrho : Z rho = 0 :=
      Nat.eq_zero_of_le_zero ((hZ rho).trans_eq hmrho)
    exact Finsupp.mem_support_iff.mp hrho hZrho
  have hfullSupport :
      Function.support (fun rho : ℂ => (m rho : ℂ) / (s - rho)) ⊆
        hm.toFinset := by
    intro rho hrho
    apply hm.mem_toFinset.mpr
    rw [Function.mem_support] at hrho ⊢
    exact fun hmrho => hrho (by simp [hmrho])
  have hfullSum :
      (∑ᶠ rho : ℂ, (m rho : ℂ) / (s - rho)) =
        ∑ rho ∈ hm.toFinset, (m rho : ℂ) / (s - rho) :=
    finsum_eq_sum_of_support_subset
      (fun rho : ℂ => (m rho : ℂ) / (s - rho)) hfullSupport
  rw [Finsupp.sum_of_support_subset Z hZsupport _ (by simp)]
  change (∑ rho ∈ hm.toFinset,
      (Z rho : ℝ) * ((s - rho)⁻¹).re) ≤
    (∑ᶠ rho : ℂ, (m rho : ℂ) / (s - rho)).re
  rw [hfullSum, Complex.re_sum]
  apply Finset.sum_le_sum
  intro rho _
  by_cases hmrho : m rho = 0
  · have hZrho : Z rho = 0 :=
      Nat.eq_zero_of_le_zero ((hZ rho).trans_eq hmrho)
    simp [hZrho, hmrho]
  · have hzero : riemannZeta₁ rho = 0 :=
      apply_eq_zero_of_analyticOrderNatAt_ne_zero (by
        dsimp [m] at hmrho
        split at hmrho
        · exact hmrho
        · exact False.elim (hmrho rfl))
    have hrho : rho.re < 1 := riemannZeta₁_zero_re_lt_one hzero
    have hinv : 0 ≤ ((s - rho)⁻¹).re := by
      rw [Complex.inv_re]
      exact div_nonneg (by simp only [Complex.sub_re]; linarith)
        (Complex.normSq_nonneg _)
    have hcoeff : (Z rho : ℝ) ≤ (m rho : ℝ) := by
      exact_mod_cast hZ rho
    simpa [div_eq_mul_inv] using
      mul_le_mul_of_nonneg_right hcoeff hinv

theorem exists_nat_selected_radiusTwo_subdivisor_sum_sub_le_re_logDeriv_riemannZeta₁ :
    ∃ A : ℕ, 1 ≤ A ∧
      ∀ (t sigma : ℝ) (Z : ℂ →₀ ℕ),
        1 ≤ sigma → sigma ≤ 2 →
          riemannZeta₁ ((sigma : ℂ) + t * I) ≠ 0 →
            (∀ rho : ℂ,
              Z rho ≤
                if dist rho ((2 : ℂ) + t * I) ≤ 2 then
                  analyticOrderNatAt riemannZeta₁ rho
                else 0) →
              Z.sum (fun rho m =>
                  (m : ℝ) *
                    ((((sigma : ℂ) + t * I) - rho)⁻¹).re) -
                  16 * (A : ℝ) * Real.log (|t| + 2) ≤
                (logDeriv riemannZeta₁
                  ((sigma : ℂ) + t * I)).re := by
  obtain ⟨A, hA, hfixed⟩ :=
    exists_nat_norm_logDeriv_riemannZeta₁_sub_radiusTwo_finsum_le
  refine ⟨A, hA, ?_⟩
  intro t sigma Z hsigma1 hsigma2 hzs hZ
  let s : ℂ := (sigma : ℂ) + t * I
  let E : ℝ := 16 * (A : ℝ) * Real.log (|t| + 2)
  let S : ℂ := ∑ᶠ rho : ℂ,
    ((if dist rho ((2 : ℂ) + t * I) ≤ 2 then
        analyticOrderNatAt riemannZeta₁ rho
      else 0 : ℕ) : ℂ) / (s - rho)
  have hsball : s ∈ closedBall ((2 : ℂ) + t * I) 1 := by
    rw [mem_closedBall, Complex.dist_eq]
    have hdiff : s - ((2 : ℂ) + t * I) = ((sigma - 2 : ℝ) : ℂ) := by
      simp [s]
    rw [hdiff, Complex.norm_real, Real.norm_eq_abs, abs_le]
    constructor <;> linarith
  have hsre : 1 ≤ s.re := by
    simpa [s] using hsigma1
  have hnorm : ‖logDeriv riemannZeta₁ s - S‖ ≤ E := by
    simpa [S, E, s] using hfixed t s hsball (by simpa [s] using hzs)
  have hselected :
      Z.sum (fun rho m =>
        (m : ℝ) * (((s - rho)⁻¹).re)) ≤ S.re := by
    simpa [S] using
      selected_radiusTwo_riemannZeta₁_subdivisor_sum_le_re_analyticOrder_finsum
        t s hsre Z hZ
  have hnormSwap : ‖S - logDeriv riemannZeta₁ s‖ ≤ E := by
    rw [norm_sub_rev]
    exact hnorm
  have hreal :
      (S - logDeriv riemannZeta₁ s).re ≤
        ‖S - logDeriv riemannZeta₁ s‖ :=
    Complex.re_le_norm _
  have hresult :
      Z.sum (fun rho m =>
          (m : ℝ) * (((s - rho)⁻¹).re)) - E ≤
        (logDeriv riemannZeta₁ s).re := by
    rw [Complex.sub_re] at hreal
    linarith
  simpa [s, E] using hresult

theorem exists_nat_selected_radiusTwo_subdivisor_sum_sub_pole_le_re_logDeriv_riemannZeta :
    ∃ A : ℕ, 1 ≤ A ∧
      ∀ (t sigma : ℝ) (Z : ℂ →₀ ℕ),
        1 < sigma → sigma ≤ 2 →
          (∀ rho : ℂ,
            Z rho ≤
              if dist rho ((2 : ℂ) + t * I) ≤ 2 then
                analyticOrderNatAt riemannZeta₁ rho
              else 0) →
            Z.sum (fun rho m =>
                (m : ℝ) *
                  ((((sigma : ℂ) + t * I) - rho)⁻¹).re) -
                ((((sigma : ℂ) + t * I) - 1)⁻¹).re -
                16 * (A : ℝ) * Real.log (|t| + 2) ≤
              (logDeriv riemannZeta
                ((sigma : ℂ) + t * I)).re := by
  obtain ⟨A, hA, hselected⟩ :=
    exists_nat_selected_radiusTwo_subdivisor_sum_sub_le_re_logDeriv_riemannZeta₁
  refine ⟨A, hA, ?_⟩
  intro t sigma Z hsigma1 hsigma2 hZ
  let s : ℂ := (sigma : ℂ) + t * I
  have hsre : 1 ≤ s.re := by simp [s]; linarith
  have hsne : s ≠ 1 := by
    intro h
    have := congrArg Complex.re h
    simp [s] at this
    linarith
  have hzeta : riemannZeta s ≠ 0 :=
    riemannZeta_ne_zero_of_one_le_re hsre
  have hzeta₁ : riemannZeta₁ s ≠ 0 := by
    intro hzero
    have hfactor := riemannZeta_eq_inv_sub_mul hsne
    rw [hzero, mul_zero] at hfactor
    exact hzeta hfactor
  have hlower := hselected t sigma Z hsigma1.le hsigma2 hzeta₁ hZ
  have hpole := congrArg Complex.re
    (neg_logDeriv_riemannZeta_eq_pole_sub_regularized s hsre hsne)
  simp only [Complex.neg_re, Complex.sub_re] at hpole
  simpa [s] using (show
    Z.sum (fun rho m =>
        (m : ℝ) * (((s - rho)⁻¹).re)) - ((s - 1)⁻¹).re -
          16 * (A : ℝ) * Real.log (|t| + 2) ≤
        (logDeriv riemannZeta s).re by linarith)

end

section
open ArithmeticFunction

theorem norm_neg_logDeriv_LSeries_le_vonMangoldt_tsum
    {N : ℕ} (χ : DirichletCharacter ℂ N) {s : ℂ} (hs : 1 < s.re) :
    ‖-logDeriv (LSeries (fun n : ℕ => χ n)) s‖ ≤
      ∑' n : ℕ, vonMangoldt n / (n : ℝ) ^ s.re := by
  rw [logDeriv_apply, ← neg_div,
    ← DirichletCharacter.LSeries_twist_vonMangoldt_eq χ hs]
  let f : ℕ → ℂ :=
    (fun n : ℕ => χ n) * fun n => (vonMangoldt n : ℂ)
  let g : ℕ → ℂ := fun n => (vonMangoldt n : ℂ)
  change ‖LSeries f s‖ ≤ ∑' n : ℕ, vonMangoldt n / (n : ℝ) ^ s.re
  have hf : LSeriesSummable f s := by
    simpa [f] using
      (DirichletCharacter.LSeriesSummable_twist_vonMangoldt χ hs)
  have hg : LSeriesSummable g (s.re : ℂ) := by
    simpa [g] using
      (LSeriesSummable_vonMangoldt (s := (s.re : ℂ)) hs)
  have hcoeff (n : ℕ) : ‖f n‖ ≤ ‖g n‖ := by
    simp only [f, g, Pi.mul_apply, norm_mul]
    exact (mul_le_mul_of_nonneg_right (χ.norm_le_one (n : ZMod N))
      (norm_nonneg _)).trans_eq (one_mul _)
  have hterm (n : ℕ) :
      ‖LSeries.term f s n‖ ≤ ‖LSeries.term g (s.re : ℂ) n‖ := by
    calc
      ‖LSeries.term f s n‖ ≤ ‖LSeries.term g s n‖ :=
        LSeries.norm_term_le s (hcoeff n)
      _ = ‖LSeries.term g (s.re : ℂ) n‖ := by
        simp only [LSeries.norm_term_eq, Complex.ofReal_re]
  calc
    ‖LSeries f s‖ ≤ ∑' n, ‖LSeries.term f s n‖ :=
      norm_tsum_le_tsum_norm hf.norm
    _ ≤ ∑' n, ‖LSeries.term g (s.re : ℂ) n‖ :=
      Summable.tsum_le_tsum hterm hf.norm hg.norm
    _ = ∑' n : ℕ, vonMangoldt n / (n : ℝ) ^ s.re := by
      apply tsum_congr
      intro n
      rw [LSeries.norm_term_eq]
      by_cases hn : n = 0
      · simp [hn]
      · simp only [hn, ↓reduceIte, g, Complex.ofReal_re]
        rw [Complex.norm_of_nonneg vonMangoldt_nonneg]

end

section
open ArithmeticFunction Set

theorem ofReal_vonMangoldt_tsum_eq_neg_logDeriv_riemannZeta
    {sigma : ℝ} (hsigma : 1 < sigma) :
    (((∑' n : ℕ,
      ArithmeticFunction.vonMangoldt n / (n : ℝ) ^ sigma) : ℝ) : ℂ) =
      -logDeriv riemannZeta (sigma : ℂ) := by
  rw [logDeriv_apply, ← neg_div,
    ← ArithmeticFunction.LSeries_vonMangoldt_eq_deriv_riemannZeta_div
      (s := (sigma : ℂ)) (by simpa using hsigma)]
  rw [LSeries, Complex.ofReal_tsum]
  apply tsum_congr
  intro n
  by_cases hn : n = 0
  · subst n
    simp
  · rw [LSeries.term_of_ne_zero hn]
    push_cast
    rw [Complex.ofReal_cpow (Nat.cast_nonneg n) sigma]
    norm_cast

theorem exists_pos_vonMangoldt_tsum_lt_inv_sub_one_add :
    ∃ C : ℝ, 0 < C ∧ ∀ sigma : ℝ, 1 < sigma → sigma < 2 →
      (∑' n : ℕ,
        ArithmeticFunction.vonMangoldt n / (n : ℝ) ^ sigma) <
        (sigma - 1)⁻¹ + C := by
  have hzeta1 {x : ℝ} (hx : x ∈ Icc (1 : ℝ) 2) :
      riemannZeta₁ (x : ℂ) ≠ 0 := by
    by_cases h : x = 1
    · subst x
      simp
    · have hx' : 1 < x := lt_of_le_of_ne hx.1 (Ne.symm h)
      intro hz
      have hzeta := riemannZeta_ne_zero_of_one_lt_re
        (s := (x : ℂ)) (by simpa using hx')
      rw [riemannZeta_eq_inv_sub_mul (by exact_mod_cast h), hz, mul_zero] at hzeta
      exact hzeta rfl
  have hcont : ContinuousOn
      (fun x : ℝ =>
        ‖deriv riemannZeta₁ (x : ℂ) / riemannZeta₁ (x : ℂ)‖)
      (Icc (1 : ℝ) 2) :=
    (ContinuousOn.div
      (differentiable_riemannZeta₁.deriv.continuous.comp
        Complex.continuous_ofReal |>.continuousOn)
      (differentiable_riemannZeta₁.continuous.comp
        Complex.continuous_ofReal |>.continuousOn)
      (fun x hx => hzeta1 hx)).norm
  obtain ⟨c, hc⟩ := bddAbove_def.mp
    (IsCompact.bddAbove_image isCompact_Icc hcont)
  let C : ℝ := max c 0 + 1
  have hC : 0 < C := by
    dsimp [C]
    linarith [le_max_right c 0]
  refine ⟨C, hC, ?_⟩
  intro sigma hsigma hsigma_two
  have hsigma_icc : sigma ∈ Icc (1 : ℝ) 2 :=
    ⟨hsigma.le, hsigma_two.le⟩
  have hresidual :
      ‖deriv riemannZeta₁ (sigma : ℂ) /
          riemannZeta₁ (sigma : ℂ)‖ ≤ max c 0 :=
    (hc _ (mem_image_of_mem _ hsigma_icc)).trans (le_max_left _ _)
  have hzeta1_sigma := hzeta1 hsigma_icc
  have hsigma_ne : (sigma : ℂ) ≠ 1 := by
    exact_mod_cast ne_of_gt hsigma
  have hsub_ne : (sigma : ℂ) - 1 ≠ 0 := sub_ne_zero.mpr hsigma_ne
  have hzeta_sigma := riemannZeta_ne_zero_of_one_lt_re
    (s := (sigma : ℂ)) (by simpa using hsigma)
  have hlog :
      deriv riemannZeta (sigma : ℂ) / riemannZeta (sigma : ℂ) =
        -((sigma : ℂ) - 1)⁻¹ +
          deriv riemannZeta₁ (sigma : ℂ) / riemannZeta₁ (sigma : ℂ) := by
    rw [deriv_riemannZeta_eq_neg_inv_sub_sq_mul_add hsigma_ne,
      riemannZeta_eq_inv_sub_mul hsigma_ne]
    field_simp
  have hsum_nonneg :
      0 ≤ ∑' n : ℕ, vonMangoldt n / (n : ℝ) ^ sigma :=
    tsum_nonneg fun n => div_nonneg vonMangoldt_nonneg
      (Real.rpow_nonneg (Nat.cast_nonneg n) _)
  calc
    (∑' n : ℕ, vonMangoldt n / (n : ℝ) ^ sigma) =
        ‖((∑' n : ℕ, vonMangoldt n / (n : ℝ) ^ sigma : ℝ) : ℂ)‖ := by
      rw [Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg hsum_nonneg]
    _ = ‖-logDeriv riemannZeta (sigma : ℂ)‖ := by
      rw [ofReal_vonMangoldt_tsum_eq_neg_logDeriv_riemannZeta hsigma]
    _ = ‖((sigma : ℂ) - 1)⁻¹ -
          deriv riemannZeta₁ (sigma : ℂ) / riemannZeta₁ (sigma : ℂ)‖ := by
      rw [logDeriv_apply, hlog]
      ring_nf
    _ ≤ ‖((sigma : ℂ) - 1)⁻¹‖ +
          ‖deriv riemannZeta₁ (sigma : ℂ) / riemannZeta₁ (sigma : ℂ)‖ :=
      norm_sub_le _ _
    _ = (sigma - 1)⁻¹ +
          ‖deriv riemannZeta₁ (sigma : ℂ) / riemannZeta₁ (sigma : ℂ)‖ := by
      have hcast : ((sigma : ℂ) - 1)⁻¹ =
          (((sigma - 1)⁻¹ : ℝ) : ℂ) := by
        push_cast
        rfl
      rw [hcast, Complex.norm_real, Real.norm_eq_abs,
        abs_of_pos (inv_pos.mpr (sub_pos.mpr hsigma))]
    _ ≤ (sigma - 1)⁻¹ + max c 0 := add_le_add (le_refl _) hresidual
    _ < (sigma - 1)⁻¹ + C := by
      dsimp [C]
      linarith

theorem exists_pos_neg_logDeriv_riemannZeta_re_lt_inv_sub_one_add :
    ∃ C : ℝ, 0 < C ∧ ∀ sigma : ℝ, 1 < sigma → sigma < 2 →
      (-logDeriv riemannZeta (sigma : ℂ)).re < (sigma - 1)⁻¹ + C := by
  rcases exists_pos_vonMangoldt_tsum_lt_inv_sub_one_add with ⟨C, hC, hbound⟩
  refine ⟨C, hC, ?_⟩
  intro sigma hsigma hsigma_two
  rw [← ofReal_vonMangoldt_tsum_eq_neg_logDeriv_riemannZeta hsigma]
  simpa using hbound sigma hsigma hsigma_two

end

section
open ArithmeticFunction Complex

theorem three_four_one_unit_circle_identity {z : ℂ} (hz : ‖z‖ = 1) :
    3 + 4 * z.re + (z ^ 2).re = 2 * (1 + z.re) ^ 2 := by
  rw [pow_two, Complex.mul_re]
  have hnorm : z.re ^ 2 + z.im ^ 2 = 1 := by
    have h := congrArg (fun r : ℝ => r ^ 2) hz
    rw [Complex.sq_norm, Complex.normSq_apply] at h
    simpa [pow_two] using h
  nlinarith

section ThreeFourOne
theorem three_four_one_unit_circle_nonneg {z : ℂ} (hz : ‖z‖ = 1) :
    0 ≤ 3 + 4 * z.re + (z ^ 2).re := by
  rw [three_four_one_unit_circle_identity hz]
  positivity

theorem re_twist_vonMangoldt_term_eq_phase
    {N n : ℕ} (chi : DirichletCharacter ℂ N) (sigma t : ℝ) :
    (LSeries.term
      ((fun m : ℕ => chi m) * fun m => (vonMangoldt m : ℂ))
      ((sigma : ℂ) + I * t) n).re =
      vonMangoldt n * (n : ℝ) ^ (-sigma) *
        (chi n * (n : ℂ) ^ (-(I * t))).re := by
  by_cases hn : n = 0
  · simp [hn]
  rw [LSeries.term_of_ne_zero hn]
  simp only [Pi.mul_apply]
  rw [div_eq_mul_inv, ← Complex.cpow_neg]
  rw [neg_add, Complex.cpow_add _ _ (Nat.cast_ne_zero.mpr hn)]
  rw [← Complex.ofReal_natCast, ← Complex.ofReal_neg,
    ← Complex.ofReal_cpow (Nat.cast_nonneg n)]
  simp only [Complex.mul_re, Complex.mul_im, Complex.ofReal_re,
    Complex.ofReal_im, zero_mul, mul_zero, add_zero, sub_zero]
  ring

end ThreeFourOne

theorem three_four_one_character_phase_nonneg
    {N n : ℕ} (chi : DirichletCharacter ℂ N) (hn : n ≠ 0) (t : ℝ) :
    0 ≤ 3 * ((1 : DirichletCharacter ℂ N) n).re +
      4 * (chi n * (n : ℂ) ^ (-(I * t))).re +
      ((chi ^ 2) n * (n : ℂ) ^ (-(I * (2 * t : ℝ)))).re := by
  by_cases hunit : IsUnit (n : ZMod N)
  · let z : ℂ := chi n * (n : ℂ) ^ (-(I * t))
    have hz : ‖z‖ = 1 := by
      dsimp [z]
      rw [norm_mul, ← hunit.unit_spec,
        DirichletCharacter.unit_norm_eq_one chi hunit.unit,
        Complex.norm_natCast_cpow_of_pos (Nat.pos_of_ne_zero hn)]
      simp
    have hsquare :
        (chi ^ 2) n * (n : ℂ) ^ (-(I * (2 * t : ℝ))) = z ^ 2 := by
      dsimp [z]
      rw [chi.pow_apply' two_ne_zero]
      rw [show -(I * ((2 * t : ℝ) : ℂ)) = (2 : ℕ) * -(I * t) by
          push_cast
          ring,
        Complex.cpow_nat_mul, mul_pow]
    rw [MulChar.one_apply hunit, hsquare]
    simp only [one_re, mul_one]
    change 0 ≤ 3 + 4 * z.re + (z ^ 2).re
    exact three_four_one_unit_circle_nonneg hz
  · simp [MulChar.map_nonunit, hunit]

theorem summable_vonMangoldt_rpow_mul_character_phase
    {N : ℕ} (chi : DirichletCharacter ℂ N) {sigma : ℝ}
    (hsigma : 1 < sigma) (t : ℝ) :
    Summable fun n : ℕ => vonMangoldt n * (n : ℝ) ^ (-sigma) *
      (chi n * (n : ℂ) ^ (-(I * t))).re := by
  have hs : 1 < ((sigma : ℂ) + I * t).re := by simpa
  refine (Complex.reCLM.summable
    (DirichletCharacter.LSeriesSummable_twist_vonMangoldt chi hs)).congr ?_
  intro n
  simpa using re_twist_vonMangoldt_term_eq_phase chi sigma t (n := n)

theorem re_neg_logDeriv_LSeries_eq_phase_tsum
    {N : ℕ} (chi : DirichletCharacter ℂ N) {sigma : ℝ}
    (hsigma : 1 < sigma) (t : ℝ) :
    (-logDeriv (LSeries (fun n : ℕ => chi n))
      ((sigma : ℂ) + I * t)).re =
      ∑' n : ℕ, vonMangoldt n * (n : ℝ) ^ (-sigma) *
        (chi n * (n : ℂ) ^ (-(I * t))).re := by
  have hs : 1 < ((sigma : ℂ) + I * t).re := by simpa
  have hsum := DirichletCharacter.LSeriesSummable_twist_vonMangoldt chi hs
  rw [logDeriv_apply, ← neg_div,
    ← DirichletCharacter.LSeries_twist_vonMangoldt_eq chi hs]
  rw [LSeries, Complex.re_tsum hsum]
  apply tsum_congr
  intro n
  exact re_twist_vonMangoldt_term_eq_phase chi sigma t

theorem three_four_one_neg_logDeriv_LSeries_nonneg
    {N : ℕ} (chi : DirichletCharacter ℂ N) {sigma : ℝ}
    (hsigma : 1 < sigma) (t : ℝ) :
    0 ≤ 3 * (-logDeriv (LSeries (fun n : ℕ =>
        (1 : DirichletCharacter ℂ N) n)) (sigma : ℂ)).re +
      4 * (-logDeriv (LSeries (fun n : ℕ => chi n))
        ((sigma : ℂ) + I * t)).re +
      (-logDeriv (LSeries (fun n : ℕ => (chi ^ 2) n))
        ((sigma : ℂ) + I * (2 * t : ℝ))).re := by
  have hzero := re_neg_logDeriv_LSeries_eq_phase_tsum
    (1 : DirichletCharacter ℂ N) hsigma 0
  have hzero' :
      (-logDeriv (LSeries (fun n : ℕ =>
        (1 : DirichletCharacter ℂ N) n)) (sigma : ℂ)).re =
        ∑' n : ℕ, vonMangoldt n * (n : ℝ) ^ (-sigma) *
          ((1 : DirichletCharacter ℂ N) n *
            (n : ℂ) ^ (-(I * (0 : ℝ)))).re := by
    simpa using hzero
  rw [hzero', re_neg_logDeriv_LSeries_eq_phase_tsum chi hsigma t,
    re_neg_logDeriv_LSeries_eq_phase_tsum (chi ^ 2) hsigma (2 * t)]
  have hsum0 := summable_vonMangoldt_rpow_mul_character_phase
    (1 : DirichletCharacter ℂ N) hsigma 0
  have hsum1 := summable_vonMangoldt_rpow_mul_character_phase chi hsigma t
  have hsum2 := summable_vonMangoldt_rpow_mul_character_phase
    (chi ^ 2) hsigma (2 * t)
  rw [← tsum_mul_left, ← tsum_mul_left,
    ← (hsum0.mul_left 3).tsum_add (hsum1.mul_left 4),
    ← ((hsum0.mul_left 3).add (hsum1.mul_left 4)).tsum_add hsum2]
  refine tsum_nonneg fun n => ?_
  by_cases hn : n = 0
  · simp [hn]
  have hweight : 0 ≤ vonMangoldt n * (n : ℝ) ^ (-sigma) :=
    mul_nonneg vonMangoldt_nonneg (Real.rpow_nonneg (Nat.cast_nonneg n) _)
  have hphase := three_four_one_character_phase_nonneg chi hn t
  calc
    0 ≤ (vonMangoldt n * (n : ℝ) ^ (-sigma)) *
        (3 * ((1 : DirichletCharacter ℂ N) n).re +
          4 * (chi n * (n : ℂ) ^ (-(I * t))).re +
          ((chi ^ 2) n *
            (n : ℂ) ^ (-(I * (2 * t : ℝ)))).re) :=
      mul_nonneg hweight hphase
    _ = 3 * (vonMangoldt n * (n : ℝ) ^ (-sigma) *
          ((1 : DirichletCharacter ℂ N) n * (n : ℂ) ^ (-(I * 0))).re) +
        4 * (vonMangoldt n * (n : ℝ) ^ (-sigma) *
          (chi n * (n : ℂ) ^ (-(I * t))).re) +
        vonMangoldt n * (n : ℝ) ^ (-sigma) *
          ((chi ^ 2) n *
            (n : ℂ) ^ (-(I * (2 * t : ℝ)))).re := by
      simp
      ring

theorem neg_logDeriv_principal_LSeries_re_le_riemannZeta
    {N : ℕ} {sigma : ℝ} (hsigma : 1 < sigma) :
    (-logDeriv (LSeries (fun n : ℕ =>
      (1 : DirichletCharacter ℂ N) n)) (sigma : ℂ)).re ≤
      (-logDeriv riemannZeta (sigma : ℂ)).re := by
  calc
    (-logDeriv (LSeries (fun n : ℕ =>
        (1 : DirichletCharacter ℂ N) n)) (sigma : ℂ)).re ≤
        ‖-logDeriv (LSeries (fun n : ℕ =>
          (1 : DirichletCharacter ℂ N) n)) (sigma : ℂ)‖ :=
      Complex.re_le_norm _
    _ ≤ ∑' n : ℕ, vonMangoldt n / (n : ℝ) ^ sigma :=
      norm_neg_logDeriv_LSeries_le_vonMangoldt_tsum
        (1 : DirichletCharacter ℂ N) (by simpa using hsigma)
    _ = (-logDeriv riemannZeta (sigma : ℂ)).re := by
      have h := congrArg Complex.re
        (ofReal_vonMangoldt_tsum_eq_neg_logDeriv_riemannZeta hsigma)
      simpa using h

theorem three_four_one_zeta_neg_logDeriv_LSeries_nonneg
    {N : ℕ} (chi : DirichletCharacter ℂ N) {sigma : ℝ}
    (hsigma : 1 < sigma) (t : ℝ) :
    0 ≤ 3 * (-logDeriv riemannZeta (sigma : ℂ)).re +
      4 * (-logDeriv (LSeries (fun n : ℕ => chi n))
        ((sigma : ℂ) + I * t)).re +
      (-logDeriv (LSeries (fun n : ℕ => (chi ^ 2) n))
        ((sigma : ℂ) + I * (2 * t : ℝ))).re := by
  have hpos := three_four_one_neg_logDeriv_LSeries_nonneg chi hsigma t
  have hle := neg_logDeriv_principal_LSeries_re_le_riemannZeta
    (N := N) hsigma
  linarith

theorem neg_logDeriv_LFunction_eq_LSeries
    {N : ℕ} [NeZero N] (chi : DirichletCharacter ℂ N)
    {s : ℂ} (hs : 1 < s.re) :
    -logDeriv (DirichletCharacter.LFunction chi) s =
      -logDeriv (LSeries (fun n : ℕ => chi n)) s := by
  rw [logDeriv_apply,
    DirichletCharacter.deriv_LFunction_eq_deriv_LSeries chi hs,
    DirichletCharacter.LFunction_eq_LSeries chi hs, ← logDeriv_apply]

theorem three_four_one_zeta_neg_logDeriv_LFunction_nonneg
    {N : ℕ} [NeZero N] (chi : DirichletCharacter ℂ N) {sigma : ℝ}
    (hsigma : 1 < sigma) (t : ℝ) :
    0 ≤ 3 * (-logDeriv riemannZeta (sigma : ℂ)).re +
      4 * (-logDeriv (DirichletCharacter.LFunction chi)
        ((sigma : ℂ) + I * t)).re +
      (-logDeriv (DirichletCharacter.LFunction (chi ^ 2))
        ((sigma : ℂ) + I * (2 * t : ℝ))).re := by
  rw [neg_logDeriv_LFunction_eq_LSeries chi (by simpa using hsigma),
    neg_logDeriv_LFunction_eq_LSeries (chi ^ 2) (by simpa using hsigma)]
  exact three_four_one_zeta_neg_logDeriv_LSeries_nonneg chi hsigma t

end

theorem two_le_level_height
    {q : ℕ} [NeZero q] (t : ℝ) :
    (2 : ℝ) ≤ (q : ℝ) * (|t| + 2) := by
  have hq : (1 : ℝ) ≤ q := by
    exact_mod_cast NeZero.pos q
  have ht : (2 : ℝ) ≤ |t| + 2 := by
    linarith [abs_nonneg t]
  simpa using mul_le_mul hq ht (by norm_num : (0 : ℝ) ≤ 2)
    (zero_le_one.trans hq)

theorem doubled_height_scale_le_sq
    {q : ℕ} [NeZero q] (t : ℝ) :
    (q : ℝ) * (|2 * t| + 2) ≤
      ((q : ℝ) * (|t| + 2)) ^ 2 := by
  let Q : ℝ := (q : ℝ) * (|t| + 2)
  have hq0 : (0 : ℝ) ≤ q := by positivity
  have hQ2 : (2 : ℝ) ≤ Q := by
    simpa [Q] using two_le_level_height (q := q) t
  have hfirst : (q : ℝ) * (|2 * t| + 2) ≤ 2 * Q := by
    rw [abs_mul, abs_of_nonneg (by norm_num : (0 : ℝ) ≤ 2)]
    dsimp [Q]
    nlinarith
  have hsecond : 2 * Q ≤ Q ^ 2 := by
    have hprod : 0 ≤ Q * (Q - 2) :=
      mul_nonneg (by linarith) (by linarith)
    nlinarith
  exact hfirst.trans hsecond

theorem log_doubled_height_le_two_mul_log
    {q : ℕ} [NeZero q] (t : ℝ) :
    Real.log ((q : ℝ) * (|2 * t| + 2)) ≤
      2 * Real.log ((q : ℝ) * (|t| + 2)) := by
  have hqpos : (0 : ℝ) < q := by
    exact_mod_cast NeZero.pos q
  have hleftpos : (0 : ℝ) < (q : ℝ) * (|2 * t| + 2) :=
    mul_pos hqpos (by linarith [abs_nonneg (2 * t)])
  calc
    Real.log ((q : ℝ) * (|2 * t| + 2)) ≤
        Real.log (((q : ℝ) * (|t| + 2)) ^ 2) :=
      Real.log_le_log hleftpos (doubled_height_scale_le_sq (q := q) t)
    _ = 2 * Real.log ((q : ℝ) * (|t| + 2)) := by
      rw [Real.log_pow]
      norm_num

theorem mul_sub_one_le_inv_one_add_inv_sub
    {m L beta : ℝ} (hm : 2 ≤ m) (hL : 0 < L)
    (hbeta : 1 - 1 / (m ^ 2 * L) ≤ beta) (hbeta_one : beta < 1) :
    (m - 1) * L ≤ (1 + 1 / (m * L) - beta)⁻¹ := by
  have hm0 : 0 < m := by linarith
  have hdelta : 0 < 1 + 1 / (m * L) - beta := by
    have := one_div_pos.mpr (mul_pos hm0 hL)
    linarith
  have hmul : 0 ≤ (m - 1) * L := mul_nonneg (by linarith) hL.le
  rw [inv_eq_one_div, le_div_iff₀ hdelta]
  calc
    _ ≤ (m - 1) * L * (1 / (m * L) + 1 / (m ^ 2 * L)) := by
      gcongr
      linarith
    _ = 1 - 1 / m ^ 2 := by field_simp [hm0.ne', hL.ne']; ring
    _ ≤ 1 := sub_le_self _ (by positivity)

section
open Complex Set

section RiemannZetaZeroFree
theorem riemannZeta_zero_regularized
    {rho : ℂ} (hzero : riemannZeta rho = 0) :
    riemannZeta₁ rho = 0 := by
  have hrho1 : rho ≠ 1 := by
    intro h
    subst rho
    exact riemannZeta_one_ne_zero hzero
  have hfactor := riemannZeta_eq_inv_sub_mul hrho1
  rw [hzero] at hfactor
  exact (mul_eq_zero.mp hfactor.symm).resolve_left
    (inv_ne_zero (sub_ne_zero.mpr hrho1))

theorem analyticOrderAt_riemannZeta₁_ne_top_zeroFree (rho : ℂ) :
    analyticOrderAt riemannZeta₁ rho ≠ ⊤ :=
  analyticOrderAt_riemannZeta₁_ne_top rho

theorem one_le_analyticOrderNatAt_riemannZeta₁_of_zero
    {rho : ℂ} (hzero : riemannZeta₁ rho = 0) :
    1 ≤ analyticOrderNatAt riemannZeta₁ rho := by
  have horder : analyticOrderAt riemannZeta₁ rho ≠ 0 :=
    (differentiable_riemannZeta₁.analyticAt rho).analyticOrderAt_ne_zero.mpr hzero
  have hfinite := analyticOrderAt_riemannZeta₁_ne_top_zeroFree rho
  have hcast : (1 : ℕ∞) ≤ analyticOrderAt riemannZeta₁ rho :=
    Order.one_le_iff_ne_zero.mpr horder
  rw [← Nat.cast_analyticOrderNatAt hfinite] at hcast
  exact_mod_cast hcast

theorem dist_sq_riemannZeta_zero_one
    {rho : ℂ} :
    dist rho 1 ^ 2 = (1 - rho.re) ^ 2 + rho.im ^ 2 := by
  rw [Complex.dist_eq, Complex.sq_norm, Complex.normSq_apply]
  simp only [Complex.sub_re, Complex.sub_im, Complex.one_re,
    Complex.one_im, sub_zero]
  ring

theorem re_inv_same_height (sigma : ℝ) (rho : ℂ) :
    (((((sigma : ℂ) + rho.im * I) - rho)⁻¹).re) =
      (sigma - rho.re)⁻¹ := by
  have heq : (sigma : ℂ) + rho.im * I - rho = (sigma - rho.re : ℝ) := by
    apply Complex.ext <;> simp
  rw [heq, ← Complex.ofReal_inv, Complex.ofReal_re]

theorem pole_re_le_of_im_ge
    {a gamma delta : ℝ} (ha : 0 ≤ a) (ha_one : a ≤ 1) (hdelta : 0 < delta)
    (hgamma : delta / 2 ≤ |gamma|) :
    (((a : ℂ) + gamma * I)⁻¹).re ≤ 4 / delta ^ 2 := by
  have hsq : delta ^ 2 ≤ 4 * gamma ^ 2 := by
    have := (sq_le_sq₀ (by positivity : 0 ≤ delta / 2) (abs_nonneg gamma)).2 hgamma
    nlinarith [sq_abs gamma]
  have hden : delta ^ 2 / 4 ≤ a ^ 2 + gamma ^ 2 := by nlinarith [sq_nonneg a]
  have hfrac := div_le_div_of_nonneg_left ha (by positivity : 0 < delta ^ 2 / 4) hden
  calc
    _ ≤ a / (delta ^ 2 / 4) := by
      simpa [Complex.inv_re, Complex.normSq_apply, pow_two] using hfrac
    _ ≤ 4 / delta ^ 2 := by
      rw [div_le_div_iff₀ (by positivity) (by positivity)]
      nlinarith [mul_le_mul_of_nonneg_right ha_one (sq_nonneg delta)]

end RiemannZetaZeroFree

theorem exists_nat_riemannZeta_zero_re_lt :
    ∃ M : ℕ, 2 ≤ M ∧
      ∀ rho : ℂ,
        riemannZeta rho = 0 →
          rho.re <
            1 - 1 / ((M : ℝ) ^ 2 *
              Real.log (|rho.im| + 2)) := by
  obtain ⟨Aselect, hAselect, hselected⟩ :=
    exists_nat_selected_radiusTwo_subdivisor_sum_sub_pole_le_re_logDeriv_riemannZeta
  obtain ⟨Azeta, hAzeta, hzetaBound⟩ :=
    exists_nat_neg_logDeriv_riemannZeta_re_le_pole_add_log
  have hlogTwo : 0 < Real.log 2 := Real.log_pos one_lt_two
  have hnear : {s : ℂ | riemannZeta s ≠ 0} ∈ nhds (1 : ℂ) := by
    simpa only [Filter.eventually_iff] using
      riemannZeta_eventually_ne_zero_nhds_one
  obtain ⟨delta, hdelta, hdeltaBall⟩ := Metric.mem_nhds_iff.mp hnear
  let d : ℝ := min delta 1
  have hdpos : 0 < d := lt_min hdelta zero_lt_one
  have hdle_one : d ≤ 1 := min_le_right _ _
  have hdle_delta : d ≤ delta := min_le_left _ _
  let P : ℝ := 4 / d ^ 2
  let E : ℝ := 64 * (Aselect : ℝ) +
    80 * (Azeta : ℝ) + 5 * P / Real.log 2
  let B : ℝ := max 2 (max (2 / (d * Real.log 2)) (4 + E))
  obtain ⟨M, hM⟩ := exists_nat_gt B
  let m : ℝ := M
  have hMtwoReal : (2 : ℝ) < m := by
    dsimp [m]
    exact (show (2 : ℝ) ≤ B from le_max_left _ _).trans_lt hM
  have hMtwo : 2 ≤ M := by
    have hcast : (2 : ℝ) ≤ (M : ℝ) := by
      simpa [m] using hMtwoReal.le
    exact_mod_cast hcast
  have hMsmall : 2 / (d * Real.log 2) < m := by
    dsimp [m]
    have hle : 2 / (d * Real.log 2) ≤ B :=
      (le_max_left (2 / (d * Real.log 2)) (4 + E)).trans
        (le_max_right 2 _)
    exact hle.trans_lt hM
  have hMcoef : 4 + E < m := by
    dsimp [m]
    have hle : 4 + E ≤ B :=
      (le_max_right (2 / (d * Real.log 2)) (4 + E)).trans
        (le_max_right 2 _)
    exact hle.trans_lt hM
  refine ⟨M, hMtwo, ?_⟩
  intro rho hzero
  have hregularized : riemannZeta₁ rho = 0 :=
    riemannZeta_zero_regularized hzero
  have hbetaOne : rho.re < 1 :=
    riemannZeta₁_zero_re_lt_one hregularized
  let L : ℝ := Real.log (|rho.im| + 2)
  have hLlog : Real.log 2 ≤ L := by
    dsimp [L]
    exact Real.log_le_log (by positivity) (by linarith [abs_nonneg rho.im])
  have hLpos : 0 < L := hlogTwo.trans_le hLlog
  have hdmLogTwo : 2 < d * m * Real.log 2 := by
    have hprodpos : 0 < d * Real.log 2 := mul_pos hdpos hlogTwo
    have hmul := mul_lt_mul_of_pos_right hMsmall hprodpos
    have hcancel :
        (2 / (d * Real.log 2)) * (d * Real.log 2) = 2 := by
      field_simp [ne_of_gt hprodpos]
    rw [hcancel] at hmul
    nlinarith [hmul]
  have hmLogTwo : 1 < m * Real.log 2 := by
    have hnonneg : 0 ≤ m * Real.log 2 := by positivity
    have hle : d * (m * Real.log 2) ≤ 1 * (m * Real.log 2) :=
      mul_le_mul_of_nonneg_right hdle_one hnonneg
    rw [one_mul] at hle
    nlinarith [hdmLogTwo, hle]
  by_cases hsmall : |rho.im| < d / 2
  · have hdist : d ≤ dist rho (1 : ℂ) := by
      by_contra hnot
      have hltD : dist rho (1 : ℂ) < d := lt_of_not_ge hnot
      have hlt : dist rho (1 : ℂ) < delta :=
        hltD.trans_le hdle_delta
      exact (hdeltaBall (by simpa [Metric.mem_ball] using hlt)) hzero
    have hdistNonneg : 0 ≤ dist rho (1 : ℂ) := dist_nonneg
    have hdistSq : d ^ 2 ≤ dist rho (1 : ℂ) ^ 2 :=
      (sq_le_sq₀ (by positivity) hdistNonneg).2 hdist
    have hgap : d / 2 < 1 - rho.re := by
      have himsq : rho.im ^ 2 < (d / 2) ^ 2 := by
        simpa [sq_abs] using
          ((sq_lt_sq₀ (abs_nonneg rho.im) (by positivity)).2 hsmall)
      rw [dist_sq_riemannZeta_zero_one] at hdistSq
      nlinarith
    have hden : 0 < (m : ℝ) ^ 2 * Real.log (|rho.im| + 2) := by
      positivity
    have hrecip :
        1 / (m ^ 2 * Real.log (|rho.im| + 2)) < d / 2 := by
      have hlog : Real.log 2 ≤ Real.log (|rho.im| + 2) := hLlog
      have hmul : 2 < d * (m ^ 2 * Real.log (|rho.im| + 2)) := by
        have hmone : 1 ≤ m := by linarith
        have hmsq : m ≤ m ^ 2 := by nlinarith
        have hml : m * Real.log 2 ≤ m ^ 2 *
            Real.log (|rho.im| + 2) := by
          have hfirst : m * Real.log 2 ≤ m *
              Real.log (|rho.im| + 2) :=
            mul_le_mul_of_nonneg_left hlog (zero_le_one.trans hmone)
          have hsecond : m * Real.log (|rho.im| + 2) ≤
              m ^ 2 * Real.log (|rho.im| + 2) :=
            mul_le_mul_of_nonneg_right hmsq hLpos.le
          exact hfirst.trans hsecond
        have hprod : d * m * Real.log 2 ≤
            d * (m ^ 2 * Real.log (|rho.im| + 2)) := by
          simpa [mul_assoc] using
            (mul_le_mul_of_nonneg_left hml hdpos.le)
        exact hdmLogTwo.trans_le hprod
      have hpos : 0 < d * (m ^ 2 * Real.log (|rho.im| + 2)) := by positivity
      apply (div_lt_iff₀ hden).2
      nlinarith
    have hgap' :
        1 / (m ^ 2 * Real.log (|rho.im| + 2)) < 1 - rho.re :=
      hrecip.trans hgap
    dsimp [m] at hgap'
    linarith
  · have hlarge : d / 2 ≤ |rho.im| := le_of_not_gt hsmall
    let a : ℝ := 1 / (m * L)
    let sigma : ℝ := 1 + a
    have hmpos : 0 < m := by linarith
    have hmLpos : 0 < m * L := mul_pos hmpos hLpos
    have hmLone : 1 < m * L :=
      hmLogTwo.trans_le (mul_le_mul_of_nonneg_left hLlog hmpos.le)
    have haPos : 0 < a := by
      dsimp [a]
      exact one_div_pos.mpr hmLpos
    have haLtOne : a < 1 := by
      dsimp [a]
      rw [one_div]
      exact (inv_lt_one₀ hmLpos).2 hmLone
    have hsigmaOne : 1 < sigma := by
      dsimp [sigma]
      linarith
    have hsigmaTwo : sigma < 2 := by
      dsimp [sigma]
      linarith
    by_contra hcontra
    have hbeta : 1 - 1 / (m ^ 2 * L) ≤ rho.re := by
      simpa [m, L] using le_of_not_gt hcontra
    have hreciprocal :
        (m - 1) * L ≤ (sigma - rho.re)⁻¹ := by
      simpa [sigma, a] using mul_sub_one_le_inv_one_add_inv_sub
        (m := m) (L := L) (beta := rho.re) hMtwoReal.le hLpos
          hbeta hbetaOne
    have hmSqLone : 1 < m ^ 2 * L := by
      have hprod : 0 < (m - 1) * (m * L - 1) :=
        mul_pos (by linarith) (by linarith)
      nlinarith
    have hbetaPos : 0 < rho.re := by
      have hinv : 1 / (m ^ 2 * L) < 1 := by
        rw [one_div]
        exact (inv_lt_one₀ (by positivity)).2 hmSqLone
      linarith
    let Z : ℂ →₀ ℕ := Finsupp.single rho 1
    have horder : 1 ≤ analyticOrderNatAt riemannZeta₁ rho :=
      one_le_analyticOrderNatAt_riemannZeta₁_of_zero hregularized
    have hdistCenter :
        dist rho ((2 : ℂ) + rho.im * I) ≤ 2 := by
      have heq :
          dist rho ((2 : ℂ) + rho.im * I) = |rho.re - 2| := by
        rw [Complex.dist_eq]
        have hdiff : rho - ((2 : ℂ) + rho.im * I) =
            ((rho.re - 2 : ℝ) : ℂ) := by
          apply Complex.ext <;> simp
        rw [hdiff, norm_real, Real.norm_eq_abs]
      rw [heq, abs_of_nonpos (by linarith)]
      linarith
    have hZmult :
        ∀ z : ℂ,
          Z z ≤ if dist z ((2 : ℂ) + rho.im * I) ≤ 2 then
            analyticOrderNatAt riemannZeta₁ z else 0 := by
      intro z
      by_cases hz : z = rho
      · subst z
        rw [ite_eq_left hdistCenter]
        simpa [Z] using horder
      · simp [Z, hz]
    have hselectedRaw := hselected rho.im sigma Z
      hsigmaOne hsigmaTwo.le hZmult
    have hZsum :
        Z.sum (fun z n =>
          (n : ℝ) *
            (((((sigma : ℂ) + rho.im * I) - z)⁻¹).re)) =
          (sigma - rho.re)⁻¹ := by
      calc
        _ = ((1 : ℕ) : ℝ) *
            (((((sigma : ℂ) + rho.im * I) - rho)⁻¹).re) := by
          dsimp [Z]
          exact Finsupp.sum_single_index (a := rho) (b := 1)
            (h := fun (z : ℂ) (n : ℕ) =>
              (n : ℝ) *
                (((((sigma : ℂ) + rho.im * I) - z)⁻¹).re))
            (by norm_num)
        _ = (sigma - rho.re)⁻¹ := by
          rw [Nat.cast_one, one_mul, re_inv_same_height]
    let sOne : ℂ := (sigma : ℂ) + rho.im * I
    have hsOneSub : sOne - 1 = (a : ℂ) + rho.im * I := by
      apply Complex.ext <;> simp [sOne, sigma]
    have hpoleOne : ((sOne - 1)⁻¹).re ≤ P := by
      rw [hsOneSub]
      dsimp [P]
      exact pole_re_le_of_im_ge haPos.le haLtOne.le hdpos hlarge
    change Z.sum (fun z n =>
        (n : ℝ) * (((((sigma : ℂ) + rho.im * I) - z)⁻¹).re)) -
        ((sOne - 1)⁻¹).re - 16 * (Aselect : ℝ) * L ≤
      (logDeriv riemannZeta sOne).re at hselectedRaw
    rw [hZsum] at hselectedRaw
    have hmiddle :
        (-logDeriv riemannZeta sOne).re ≤
          P - (sigma - rho.re)⁻¹ + 16 * (Aselect : ℝ) * L := by
      simp only [Complex.neg_re]
      linarith
    have hpoleSigma : (sigma - 1)⁻¹ = m * L := by
      have heq : sigma - 1 = (m * L)⁻¹ := by
        dsimp [sigma, a]
        rw [one_div]
        ring
      rw [heq, inv_inv]
    have hrealRaw := hzetaBound (sigma : ℂ)
      (by simpa using hsigmaOne.le) (by simpa using hsigmaTwo.le)
      (by exact_mod_cast ne_of_gt hsigmaOne)
    have hsubSigma : (sigma : ℂ) - 1 = ((sigma - 1 : ℝ) : ℂ) := by
      norm_cast
    rw [hsubSigma, ← Complex.ofReal_inv, Complex.ofReal_re] at hrealRaw
    simp only [Complex.ofReal_im, abs_zero, zero_add] at hrealRaw
    rw [hpoleSigma] at hrealRaw
    have hreal :
        (-logDeriv riemannZeta (sigma : ℂ)).re ≤
          m * L + 16 * (Azeta : ℝ) * L := by
      have herror := mul_le_mul_of_nonneg_left hLlog
        (by positivity : 0 ≤ 16 * (Azeta : ℝ))
      linarith
    let sTwo : ℂ := (sigma : ℂ) + (2 * rho.im : ℝ) * I
    have hsTwoSub : sTwo - 1 = (a : ℂ) + (2 * rho.im : ℝ) * I := by
      apply Complex.ext <;> simp [sTwo, sigma]
    have hlargeTwo : d / 2 ≤ |2 * rho.im| := by
      rw [abs_mul, abs_of_nonneg (by norm_num : (0 : ℝ) ≤ 2)]
      linarith [abs_nonneg rho.im]
    have hpoleTwo : ((sTwo - 1)⁻¹).re ≤ P := by
      rw [hsTwoSub]
      dsimp [P]
      exact pole_re_le_of_im_ge haPos.le haLtOne.le hdpos hlargeTwo
    have hsTwoNe : sTwo ≠ 1 := by
      intro heq
      have hre := congrArg Complex.re heq
      simp [sTwo] at hre
      linarith
    have hdoubleRaw := hzetaBound sTwo
      (by simpa [sTwo] using hsigmaOne.le)
      (by simpa [sTwo] using hsigmaTwo.le) hsTwoNe
    have hdoubleLog :
        Real.log (|2 * rho.im| + 2) ≤ 2 * L := by
      simpa [L] using
        log_doubled_height_le_two_mul_log (q := 1) rho.im
    have hdouble :
        (-logDeriv riemannZeta sTwo).re ≤
          P + 32 * (Azeta : ℝ) * L := by
      have hsTwoIm : sTwo.im = 2 * rho.im := by simp [sTwo]
      rw [hsTwoIm] at hdoubleRaw
      have herror := mul_le_mul_of_nonneg_left hdoubleLog
        (by positivity : 0 ≤ 16 * (Azeta : ℝ))
      calc
        _ ≤ P + (16 * (Azeta : ℝ)) * (2 * L) :=
          hdoubleRaw.trans (add_le_add hpoleTwo herror)
        _ = _ := by ring
    have hphase := three_four_one_zeta_neg_logDeriv_LFunction_nonneg
      (1 : DirichletCharacter ℂ 1) hsigmaOne rho.im
    simp only [DirichletCharacter.LFunction_modOne_eq] at hphase
    have hevalOne :
        (sigma : ℂ) + I * rho.im = sOne := by
      dsimp [sOne]
      ring
    have hevalTwo :
        (sigma : ℂ) + I * (2 * rho.im : ℝ) = sTwo := by
      dsimp [sTwo]
      ring
    rw [hevalOne, hevalTwo] at hphase
    have hupper :
        4 * (sigma - rho.re)⁻¹ ≤
          3 * m * L +
            (64 * (Aselect : ℝ) + 80 * (Azeta : ℝ)) * L + 5 * P := by
      nlinarith only [hphase, hreal, hmiddle, hdouble]
    have hPnonneg : 0 ≤ P := by
      dsimp [P]
      positivity
    have hPabsorb :
        5 * P ≤ (5 * P / Real.log 2) * L := by
      calc
        5 * P = (5 * P / Real.log 2) * Real.log 2 := by
          field_simp [hlogTwo.ne']
        _ ≤ (5 * P / Real.log 2) * L :=
          mul_le_mul_of_nonneg_left hLlog (by positivity)
    have hupperE :
        4 * (sigma - rho.re)⁻¹ ≤ 3 * m * L + E * L := by
      dsimp [E]
      nlinarith only [hupper, hPabsorb]
    have hlower := mul_le_mul_of_nonneg_left hreciprocal
      (by norm_num : (0 : ℝ) ≤ 4)
    have hineq : 4 * ((m - 1) * L) ≤ 3 * m * L + E * L :=
      hlower.trans hupperE
    have hcoef : 0 < m - 4 - E := by
      linarith only [hMcoef]
    have hmargin : 0 < (m - 4 - E) * L := mul_pos hcoef hLpos
    nlinarith only [hineq, hmargin]

end

section
open Complex

section PrincipalLFunctionZeroTransport
theorem norm_natCast_cpow_neg_lt_one
    (p : ℕ) (hp : p.Prime) (s : ℂ) (hs : 0 < s.re) :
    ‖(p : ℂ) ^ (-s)‖ < 1 := by
  have hp1 : (1 : ℝ) < p := by exact_mod_cast hp.one_lt
  rw [Complex.norm_natCast_cpow_of_pos hp.pos, neg_re]
  exact Real.rpow_lt_one_of_one_lt_of_neg hp1 (neg_neg_of_pos hs)

theorem principalEulerFactor_ne_zero_of_re_pos
    (p : ℕ) (hp : p.Prime) (s : ℂ) (hs : 0 < s.re) :
    (1 : ℂ) - (p : ℂ) ^ (-s) ≠ 0 := by
  intro hzero
  have hpow : (p : ℂ) ^ (-s) = 1 := (sub_eq_zero.mp hzero).symm
  have hnorm := norm_natCast_cpow_neg_lt_one p hp s hs
  rw [hpow, norm_one] at hnorm
  exact (lt_irrefl 1) hnorm

theorem principalEulerProduct_ne_zero_of_re_pos
    (q : ℕ) (s : ℂ) (hs : 0 < s.re) :
    (∏ p ∈ q.primeFactors, (1 - (p : ℂ) ^ (-s))) ≠ 0 := by
  rw [Finset.prod_ne_zero_iff]
  intro p hp
  exact principalEulerFactor_ne_zero_of_re_pos p
    (Nat.prime_of_mem_primeFactors hp) s hs

end PrincipalLFunctionZeroTransport

theorem principal_LFunction_eq_zero_iff_riemannZeta_eq_zero_of_re_pos_of_ne_one
    {q : ℕ} [NeZero q] {rho : ℂ}
    (hrho : 0 < rho.re) (hrho_one : rho ≠ 1) :
    DirichletCharacter.LFunction
        (1 : DirichletCharacter ℂ q) rho = 0 ↔
      riemannZeta rho = 0 := by
  have hproduct :
      (∏ p ∈ q.primeFactors, (1 - (p : ℂ) ^ (-rho))) ≠ 0 :=
    principalEulerProduct_ne_zero_of_re_pos q rho hrho
  change DirichletCharacter.LFunctionTrivChar q rho = 0 ↔ _
  rw [DirichletCharacter.LFunctionTrivChar_eq_mul_riemannZeta hrho_one,
    mul_eq_zero]
  simp only [hproduct, false_or]

theorem exists_nat_principal_LFunction_openStrip_zero_re_lt :
    ∃ M : ℕ, 2 ≤ M ∧
      ∀ (q : ℕ) [NeZero q] (rho : ℂ),
        0 < rho.re → rho.re < 1 →
          DirichletCharacter.LFunction
              (1 : DirichletCharacter ℂ q) rho = 0 →
            rho.re <
              1 - 1 / ((M : ℝ) ^ 2 *
                Real.log (|rho.im| + 2)) := by
  obtain ⟨M, hM, hzeta⟩ := exists_nat_riemannZeta_zero_re_lt
  refine ⟨M, hM, ?_⟩
  intro q _ rho hrho0 hrho1 hzero
  have hrho_one : rho ≠ 1 := by
    intro hrho
    have hre := congrArg Complex.re hrho
    norm_num at hre
    linarith
  exact hzeta rho
    ((principal_LFunction_eq_zero_iff_riemannZeta_eq_zero_of_re_pos_of_ne_one
      hrho0 hrho_one).mp hzero)

end

section
open Complex Set

section DirichletGoodHeightZeroCoverage
attribute [local instance] inducingEulerProductConductorNeZero

end DirichletGoodHeightZeroCoverage
end

section
open Complex Set

attribute [local instance] inducingEulerProductConductorNeZero

section DirichletGoodHeightZeroCoverage
theorem gammaFactor_ne_zero_of_im_ne_zero
    {q : ℕ} (chi : DirichletCharacter ℂ q) {rho : ℂ}
    (him : rho.im ≠ 0) :
    DirichletCharacter.gammaFactor chi rho ≠ 0 := by
  rcases chi.even_or_odd with heven | hodd
  · rw [heven.gammaFactor_def, ne_eq, Gammaℝ_eq_zero_iff, not_exists]
    intro n hn
    have himEq := congrArg Complex.im hn
    norm_num at himEq
    exact him himEq
  · rw [hodd.gammaFactor_def, ne_eq, Gammaℝ_eq_zero_iff, not_exists]
    intro n hn
    have himEq := congrArg Complex.im hn
    norm_num at himEq
    exact him himEq

theorem primitive_LFunction_zero_re_pos_of_im_ne_zero
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    {rho : ℂ} (him : rho.im ≠ 0)
    (hzero : DirichletCharacter.LFunction chi rho = 0) :
    0 < rho.re := by
  by_contra hre
  have hre0 : rho.re ≤ 0 := le_of_not_gt hre
  have hrho0 : rho ≠ 0 := by
    intro hrho
    apply him
    rw [hrho]
    rfl
  have hrho1 : rho ≠ 1 := by
    intro hrho
    apply him
    rw [hrho]
    rfl
  have hgamma : DirichletCharacter.gammaFactor chi rho ≠ 0 :=
    gammaFactor_ne_zero_of_im_ne_zero chi him
  have hcompleted :
      DirichletCharacter.completedLFunction chi rho = 0 := by
    have hquot := DirichletCharacter.LFunction_eq_completed_div_gammaFactor
      chi rho (.inl hrho0)
    rw [hzero] at hquot
    exact (div_eq_zero_iff.mp hquot.symm).resolve_right hgamma
  have hfun := hchi.completedLFunction_one_sub (1 - rho)
  have hbase : (q : ℂ) ^ ((1 - rho) - 1 / 2) ≠ 0 :=
    Complex.cpow_ne_zero_iff.mpr (.inl (Nat.cast_ne_zero.mpr (NeZero.ne q)))
  have hroot : DirichletCharacter.rootNumber chi ≠ 0 := by
    apply norm_ne_zero_iff.mp
    rw [norm_rootNumber_of_isPrimitive chi hchi]
    exact one_ne_zero
  have hreflectedCompleted :
      DirichletCharacter.completedLFunction chi⁻¹ (1 - rho) = 0 := by
    rw [show 1 - (1 - rho) = rho by ring, hcompleted] at hfun
    exact (mul_eq_zero.mp hfun.symm).resolve_left (mul_ne_zero hbase hroot)
  have hreflectedL :
      DirichletCharacter.LFunction chi⁻¹ (1 - rho) = 0 := by
    rw [DirichletCharacter.LFunction_eq_completed_div_gammaFactor chi⁻¹
      (1 - rho) (.inl (sub_ne_zero.mpr (Ne.symm hrho1))),
      hreflectedCompleted, zero_div]
  have hreflectedGuard : chi⁻¹ ≠ 1 ∨ (1 - rho) ≠ 1 := by
    refine .inr ?_
    intro h
    apply hrho0
    linear_combination -h
  exact (chi⁻¹).LFunction_ne_zero_of_one_le_re hreflectedGuard
    (by simp; linarith) hreflectedL

theorem LFunction_zero_re_lt_one_of_im_ne_zero
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) {rho : ℂ}
    (him : rho.im ≠ 0)
    (hzero : DirichletCharacter.LFunction chi rho = 0) :
    rho.re < 1 := by
  by_contra hre
  have hguard : chi ≠ 1 ∨ rho ≠ 1 := by
    refine .inr ?_
    intro hrho
    apply him
    rw [hrho]
    rfl
  exact chi.LFunction_ne_zero_of_one_le_re hguard (le_of_not_gt hre) hzero

theorem isPrimitiveNontrivialLFunctionZero_of_nonreal_zero
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    {rho : ℂ} (him : rho.im ≠ 0)
    (hzero : DirichletCharacter.LFunction chi rho = 0) :
    (1 < q ∧ chi.IsPrimitive ∧
      DirichletCharacter.completedLFunction chi rho = 0) := by
  refine ⟨hq, hchi, ?_⟩
  have hgamma : DirichletCharacter.gammaFactor chi rho ≠ 0 :=
    gammaFactor_ne_zero_of_im_ne_zero chi him
  have hquot := DirichletCharacter.LFunction_eq_completed_div_gammaFactor
    chi rho (.inr (Nat.ne_of_gt hq))
  rw [hzero] at hquot
  exact (div_eq_zero_iff.mp hquot.symm).resolve_right hgamma

theorem mem_support_divisor_riemannZetaOne_of_zero
    {U : Set ℂ} {rho : ℂ} (hrhoU : rho ∈ U)
    (hzero : riemannZeta₁ rho = 0) :
    rho ∈ (MeromorphicOn.divisor riemannZeta₁ U).support := by
  have hA : AnalyticOnNhd ℂ riemannZeta₁ U :=
    fun z _ => differentiable_riemannZeta₁.analyticAt z
  have htop : analyticOrderAt riemannZeta₁ rho ≠ ⊤ := by
    rw [ne_eq, AnalyticOnNhd.analyticOrderAt_eq_top_iff_eq_zero rho
      (fun z => differentiable_riemannZeta₁.analyticAt z)]
    intro hzeroFunction
    have hone := congrFun hzeroFunction 1
    rw [riemannZeta₁_one] at hone
    exact one_ne_zero hone
  rw [Function.mem_support,
    MeromorphicOn.AnalyticOnNhd.divisor_apply hA hrhoU]
  lift analyticOrderAt riemannZeta₁ rho to ℕ using htop with n hn
  simp only [ENat.map_natCast, WithTop.untop₀_coe]
  have horder : analyticOrderAt riemannZeta₁ rho ≠ 0 :=
    (differentiable_riemannZeta₁.analyticAt rho
      |>.analyticOrderAt_ne_zero).mpr hzero
  rw [← hn] at horder
  exact_mod_cast horder

theorem riemannZetaOne_eq_zero_of_riemannZeta_eq_zero
    {rho : ℂ} (hzero : riemannZeta rho = 0) :
    riemannZeta₁ rho = 0 :=
  riemannZeta_zero_regularized hzero

theorem mem_closedBall_three_of_openStrip_of_localHeight
    {rho : ℂ} {t : ℝ}
    (hre0 : 0 < rho.re) (hre1 : rho.re < 1)
    (hheight : |rho.im - t| ≤ 1) :
    rho ∈ closedBall ((2 : ℂ) + t * I) 3 := by
  have hre : |rho.re - 2| ≤ (2 : ℝ) := by
    rw [abs_le]
    constructor <;> linarith only [hre0, hre1]
  have hn : ‖rho - ((2 : ℂ) + t * I)‖ ≤ |rho.re - 2| + |rho.im - t| := by
    simpa using Complex.norm_le_abs_re_add_abs_im (rho - ((2 : ℂ) + t * I))
  apply Metric.mem_closedBall.mpr
  rw [Complex.dist_eq]
  linarith only [hn, hre, hheight]

end DirichletGoodHeightZeroCoverage
end

section
open Complex Set

attribute [local instance] inducingEulerProductConductorNeZero
attribute [local instance] inducingEulerProductConductorNeZero
attribute [local instance] characterDecidableEq

section DirichletGoodHeightZeroCoverage
theorem im_mem_dirichletLocalBadOrdinates_of_LFunction_eq_zero
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) {rho : ℂ} (t : ℝ)
    (hguard : rho ≠ 1 ∨ chi ≠ 1)
    (hzero : DirichletCharacter.LFunction chi rho = 0)
    (him : rho.im ≠ 0) (hheight : |rho.im - t| ≤ 1) :
    rho.im ∈ ((if (chi) = 1 then
                 Complex.im ''
                   (MeromorphicOn.divisor riemannZeta₁
                     (closedBall ((2 : ℂ) + (t) * I) 3)).support
               else
                 Complex.im ''
                   (MeromorphicOn.divisor
                     (DirichletCharacter.LFunction (chi).primitiveCharacter)
                     (closedBall ((2 : ℂ) + (t) * I) 6)).support) ∪
                ({pntOrdinate |
                   inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
                     |pntOrdinate - (t)| ≤ 1})) := by
  have hzeroOriginal := hzero
  rw [LFunction_eq_inducingPrimitive_mul_inducingEulerProduct chi
    hguard.symm] at hzero
  rcases mul_eq_zero.mp hzero with hbase | hproduct
  · apply Set.mem_union_left
    split_ifs with hchi
    · subst chi
      refine ⟨rho, ?_, rfl⟩
      have hre0 := primitive_LFunction_zero_re_pos_of_im_ne_zero
        (1 : DirichletCharacter ℂ q).primitiveCharacter
          (1 : DirichletCharacter ℂ q).primitiveCharacter_isPrimitive him hbase
      have hre1 := LFunction_zero_re_lt_one_of_im_ne_zero
        (1 : DirichletCharacter ℂ q).primitiveCharacter him hbase
      apply mem_support_divisor_riemannZetaOne_of_zero
        (mem_closedBall_three_of_openStrip_of_localHeight hre0 hre1 hheight)
      apply riemannZetaOne_eq_zero_of_riemannZeta_eq_zero
      exact (principal_LFunction_eq_zero_iff_riemannZeta_eq_zero_of_re_pos_of_ne_one
        hre0 (by
          intro hrho
          apply him
          rw [hrho]
          rfl)).mp hzeroOriginal
    · refine ⟨rho, ?_, rfl⟩
      have hprimitiveNe : chi.primitiveCharacter ≠ 1 := by
        intro hp
        apply hchi
        rw [← chi.changeLevel_primitiveCharacter, hp]
        exact DirichletCharacter.changeLevel_one chi.conductor_dvd_level
      have hd : 1 < chi.conductor := by
        have hd0 := chi.conductor_ne_zero
        have hd1 : chi.conductor ≠ 1 := by
          intro hd
          exact hchi (DirichletCharacter.eq_one_iff_conductor_eq_one.mpr hd)
        omega
      have hnontrivial :=
        isPrimitiveNontrivialLFunctionZero_of_nonreal_zero
          hd chi.primitiveCharacter chi.primitiveCharacter_isPrimitive him hbase
      apply (mem_support_divisor_LFunction_iff hprimitiveNe ?_).2 hbase
      exact mem_closedBall.mpr
        (IsPrimitiveNontrivialLFunctionZero.dist_two_add_mul_I_le_six
          hnontrivial hheight)
  · apply Set.mem_union_right
    refine ⟨?_, hheight⟩
    have hre := re_eq_zero_of_inducingEulerProduct_eq_zero chi hproduct
    have hrho : rho = (rho.im : ℂ) * I := by
      apply Complex.ext
      · simp [hre]
      · simp
    rw [hrho] at hproduct
    exact hproduct

end DirichletGoodHeightZeroCoverage
end

section
open Complex Set

attribute [local instance] inducingEulerProductConductorNeZero
attribute [local instance] inducingEulerProductConductorNeZero
attribute [local instance] characterDecidableEq
theorem guardedLFunctionZero_twoSidedBadHeights_coverage
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    (T : ℝ) (hT : 2 ≤ T) {rho : ℂ}
    (hguard : rho ≠ 1 ∨ chi ≠ 1)
    (hzero : DirichletCharacter.LFunction chi rho = 0) :
    (|rho.im - (T + 1 / 2)| ≤ 1 →
      rho.im ∈ (let pntMidpoint := (T) + 1 / 2
                ((if (chi) = 1 then
                    Complex.im ''
                      (MeromorphicOn.divisor riemannZeta₁
                        (closedBall ((2 : ℂ) + pntMidpoint * I) 3)).support
                  else
                    Complex.im ''
                      (MeromorphicOn.divisor
                        (DirichletCharacter.LFunction (chi).primitiveCharacter)
                        (closedBall ((2 : ℂ) + pntMidpoint * I) 6)).support) ∪
                   ({pntOrdinate |
                      inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
                        |pntOrdinate - pntMidpoint| ≤ 1})) ∪
                  (fun pntOrdinate : ℝ => -pntOrdinate) ''
                    ((if (chi) = 1 then
                        Complex.im ''
                          (MeromorphicOn.divisor riemannZeta₁
                            (closedBall ((2 : ℂ) + (-pntMidpoint) * I) 3)).support
                      else
                        Complex.im ''
                          (MeromorphicOn.divisor
                            (DirichletCharacter.LFunction (chi).primitiveCharacter)
                            (closedBall ((2 : ℂ) + (-pntMidpoint) * I) 6)).support) ∪
                       ({pntOrdinate |
                          inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
                            |pntOrdinate - (-pntMidpoint)| ≤ 1})))) ∧
    (|rho.im + (T + 1 / 2)| ≤ 1 →
      -rho.im ∈ (let pntMidpoint := (T) + 1 / 2
                 ((if (chi) = 1 then
                     Complex.im ''
                       (MeromorphicOn.divisor riemannZeta₁
                         (closedBall ((2 : ℂ) + pntMidpoint * I) 3)).support
                   else
                     Complex.im ''
                       (MeromorphicOn.divisor
                         (DirichletCharacter.LFunction (chi).primitiveCharacter)
                         (closedBall ((2 : ℂ) + pntMidpoint * I) 6)).support) ∪
                    ({pntOrdinate |
                       inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
                         |pntOrdinate - pntMidpoint| ≤ 1})) ∪
                   (fun pntOrdinate : ℝ => -pntOrdinate) ''
                     ((if (chi) = 1 then
                         Complex.im ''
                           (MeromorphicOn.divisor riemannZeta₁
                             (closedBall ((2 : ℂ) + (-pntMidpoint) * I) 3)).support
                       else
                         Complex.im ''
                           (MeromorphicOn.divisor
                             (DirichletCharacter.LFunction (chi).primitiveCharacter)
                             (closedBall ((2 : ℂ) + (-pntMidpoint) * I) 6)).support) ∪
                        ({pntOrdinate |
                           inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
                             |pntOrdinate - (-pntMidpoint)| ≤ 1})))) := by
  constructor
  · intro hheight
    have him : rho.im ≠ 0 := by
      intro him
      rw [him, zero_sub, abs_neg,
        abs_of_nonneg (by linarith [hT])] at hheight
      linarith [hT]
    apply Set.mem_union_left
    exact im_mem_dirichletLocalBadOrdinates_of_LFunction_eq_zero
      chi (T + 1 / 2) hguard hzero him hheight
  · intro hheight
    have him : rho.im ≠ 0 := by
      intro him
      rw [him, zero_add, abs_of_nonneg (by linarith [hT])] at hheight
      linarith [hT]
    apply Set.mem_union_right
    refine ⟨rho.im, ?_, rfl⟩
    have hwindow : |rho.im - (-(T + 1 / 2))| ≤ 1 := by
      simpa only [sub_neg_eq_add] using hheight
    have h :=
      im_mem_dirichletLocalBadOrdinates_of_LFunction_eq_zero
        chi (-(T + 1 / 2)) hguard hzero him hwindow
    rw [Complex.ofReal_neg] at h
    exact h

theorem exists_nat_guardedLFunctionZero_twoSided_clearance :
    ∃ C : ℕ, 2 ≤ C ∧
      ∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q) (T : ℝ),
          2 ≤ T →
            ∃ T' : ℝ, T' ∈ Icc T (T + 1) ∧
              ∀ rho : ℂ,
                (rho ≠ 1 ∨ chi ≠ 1) →
                  DirichletCharacter.LFunction chi rho = 0 →
                    (1 / ((C : ℝ) *
                        Real.log ((q : ℝ) * (T + 2))) ≤
                      |T' - rho.im|) ∧
                    (1 / ((C : ℝ) *
                        Real.log ((q : ℝ) * (T + 2))) ≤
                      |T' + rho.im|) := by
  obtain ⟨C, hC, hselect⟩ :=
    exists_nat_dirichletTwoSidedBadHeights_clearance
  refine ⟨C, hC, ?_⟩
  intro q _ chi T hT
  obtain ⟨T', hT', hclear⟩ := hselect q chi T hT
  refine ⟨T', hT', ?_⟩
  let L := Real.log ((q : ℝ) * (T + 2))
  let delta := 1 / ((C : ℝ) * L)
  have hq : (1 : ℝ) ≤ q := by
    exact_mod_cast Nat.one_le_iff_ne_zero.mpr (NeZero.ne q)
  have hscale : (4 : ℝ) ≤ (q : ℝ) * (T + 2) := by
    nlinarith [mul_le_mul hq (show (4 : ℝ) ≤ T + 2 by linarith)
      (by norm_num : (0 : ℝ) ≤ 4) (by positivity : (0 : ℝ) ≤ q)]
  have hlogFour : (1 : ℝ) < Real.log 4 := by
    rw [Real.log_four_eq]
    nlinarith [Real.log_two_gt_d9]
  have hLone : (1 : ℝ) ≤ L := by
    have hlogScale : Real.log 4 ≤ L := by
      dsimp [L]
      exact Real.log_le_log (by norm_num) hscale
    exact hlogFour.le.trans hlogScale
  have hCreal : (2 : ℝ) ≤ C := by exact_mod_cast hC
  have hden : (2 : ℝ) ≤ (C : ℝ) * L := by
    nlinarith [mul_le_mul hCreal hLone (by norm_num : (0 : ℝ) ≤ 1)
      (by positivity : (0 : ℝ) ≤ C)]
  have hdeltaHalf : delta ≤ 1 / 2 := by
    dsimp [delta]
    exact one_div_le_one_div_of_le (by norm_num) hden
  intro rho hguard hzero
  constructor
  · by_contra hdistance
    have hlt : |T' - rho.im| < delta := lt_of_not_ge hdistance
    have hmid : |T' - (T + 1 / 2)| ≤ 1 / 2 := by
      rw [abs_le]
      constructor <;> linarith [hT'.1, hT'.2]
    have hheight : |rho.im - (T + 1 / 2)| ≤ 1 := by
      have htri : |rho.im - (T + 1 / 2)| ≤
          |rho.im - T'| + |T' - (T + 1 / 2)| := by
        calc
          |rho.im - (T + 1 / 2)| =
              |(rho.im - T') + (T' - (T + 1 / 2))| := by ring_nf
          _ ≤ _ := abs_add_le _ _
      have hlt' : |rho.im - T'| < 1 / 2 := by
        have := hlt.trans_le hdeltaHalf
        simpa only [abs_sub_comm] using this
      linarith
    have hbad : rho.im ∈ (let pntMidpoint := (T) + 1 / 2
                          ((if (chi) = 1 then
                              Complex.im ''
                                (MeromorphicOn.divisor riemannZeta₁
                                  (closedBall ((2 : ℂ) + pntMidpoint * I) 3)).support
                            else
                              Complex.im ''
                                (MeromorphicOn.divisor
                                  (DirichletCharacter.LFunction (chi).primitiveCharacter)
                                  (closedBall ((2 : ℂ) + pntMidpoint * I) 6)).support) ∪
                             ({pntOrdinate |
                                inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
                                  |pntOrdinate - pntMidpoint| ≤ 1})) ∪
                            (fun pntOrdinate : ℝ => -pntOrdinate) ''
                              ((if (chi) = 1 then
                                  Complex.im ''
                                    (MeromorphicOn.divisor riemannZeta₁
                                      (closedBall ((2 : ℂ) + (-pntMidpoint) * I) 3)).support
                                else
                                  Complex.im ''
                                    (MeromorphicOn.divisor
                                      (DirichletCharacter.LFunction (chi).primitiveCharacter)
                                      (closedBall ((2 : ℂ) + (-pntMidpoint) * I) 6)).support) ∪
                                 ({pntOrdinate |
                                    inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
                                      |pntOrdinate - (-pntMidpoint)| ≤ 1}))) :=
      (guardedLFunctionZero_twoSidedBadHeights_coverage
        chi T hT hguard hzero).1 hheight
    exact (not_lt_of_ge (by simpa [delta, L] using hclear rho.im hbad)) hlt
  · by_contra hdistance
    have hlt : |T' + rho.im| < delta := lt_of_not_ge hdistance
    have hmid : |(T + 1 / 2) - T'| ≤ 1 / 2 := by
      rw [abs_le]
      constructor <;> linarith [hT'.1, hT'.2]
    have hheight : |rho.im + (T + 1 / 2)| ≤ 1 := by
      have htri : |rho.im + (T + 1 / 2)| ≤
          |rho.im + T'| + |(T + 1 / 2) - T'| := by
        calc
          |rho.im + (T + 1 / 2)| =
              |(rho.im + T') + ((T + 1 / 2) - T')| := by ring_nf
          _ ≤ _ := abs_add_le _ _
      have hlt' : |rho.im + T'| < 1 / 2 := by
        have := hlt.trans_le hdeltaHalf
        simpa only [add_comm] using this
      linarith
    have hbad : -rho.im ∈ (let pntMidpoint := (T) + 1 / 2
                           ((if (chi) = 1 then
                               Complex.im ''
                                 (MeromorphicOn.divisor riemannZeta₁
                                   (closedBall ((2 : ℂ) + pntMidpoint * I) 3)).support
                             else
                               Complex.im ''
                                 (MeromorphicOn.divisor
                                   (DirichletCharacter.LFunction (chi).primitiveCharacter)
                                   (closedBall ((2 : ℂ) + pntMidpoint * I) 6)).support) ∪
                              ({pntOrdinate |
                                 inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
                                   |pntOrdinate - pntMidpoint| ≤ 1})) ∪
                             (fun pntOrdinate : ℝ => -pntOrdinate) ''
                               ((if (chi) = 1 then
                                   Complex.im ''
                                     (MeromorphicOn.divisor riemannZeta₁
                                       (closedBall ((2 : ℂ) + (-pntMidpoint) * I) 3)).support
                                 else
                                   Complex.im ''
                                     (MeromorphicOn.divisor
                                       (DirichletCharacter.LFunction (chi).primitiveCharacter)
                                       (closedBall ((2 : ℂ) + (-pntMidpoint) * I) 6)).support) ∪
                                  ({pntOrdinate |
                                     inducingEulerProduct (chi) ((pntOrdinate : ℂ) * I) = 0 ∧
                                       |pntOrdinate - (-pntMidpoint)| ≤ 1}))) :=
      (guardedLFunctionZero_twoSidedBadHeights_coverage
        chi T hT hguard hzero).2 hheight
    exact (not_lt_of_ge (by
      simpa only [sub_neg_eq_add, delta, L] using hclear (-rho.im) hbad)) hlt

end

section
open Complex Set

theorem
    dirichletExplicitFormulaCandidateSingularities_subset_interior_of_clearance
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    {x T U : ℝ} (N C : ℕ)
    (hx : 1 < x) (hT : 2 ≤ T) (hU : U ∈ Set.Icc T (T + 1))
    (hC : 2 ≤ C)
    (hclear : ∀ rho : ℂ,
      (rho ≠ 1 ∨ chi ≠ 1) →
        DirichletCharacter.LFunction chi rho = 0 →
          (1 / ((C : ℝ) * Real.log ((q : ℝ) * (T + 2))) ≤
              |U - rho.im|) ∧
          (1 / ((C : ℝ) * Real.log ((q : ℝ) * (T + 2))) ≤
              |U + rho.im|)) :
    ({pntCandidate |
      pntCandidate ∈ Complex.Rectangle
        ((((-(N : ℝ) - 1 / 2 : ℝ) : ℂ) - U * Complex.I))
        ((((1 + 1 / Real.log x : ℝ) : ℂ) + U * Complex.I)) ∧
       (((chi) = 1 ∧ pntCandidate = 1) ∨
         ((pntCandidate ≠ 1 ∨ (chi) ≠ 1) ∧
           DirichletCharacter.LFunction (chi) pntCandidate = 0))}) ⊆
      interior (Complex.Rectangle
        (((-(N : ℝ) - 1 / 2 : ℝ) : ℂ) - U * Complex.I)
        (((1 + 1 / Real.log x : ℝ) : ℂ) + U * Complex.I)) := by
  have hUpos : 0 < U := by linarith [hT, hU.1]
  have himEdges : -U ≤ U := by linarith
  have hlogx : 0 < Real.log x := Real.log_pos hx
  have hreEdges : -(N : ℝ) - 1 / 2 ≤ 1 + 1 / Real.log x := by
    have hN : (0 : ℝ) ≤ N := Nat.cast_nonneg N
    linarith [one_div_pos.mpr hlogx]
  have hq : (1 : ℝ) ≤ q := by
    exact_mod_cast Nat.one_le_iff_ne_zero.mpr (NeZero.ne q)
  have hscale : (1 : ℝ) < (q : ℝ) * (T + 2) := by
    have hq0 : (0 : ℝ) ≤ q := zero_le_one.trans hq
    nlinarith [mul_le_mul hq (show (4 : ℝ) ≤ T + 2 by linarith)
      (by norm_num : (0 : ℝ) ≤ 4) hq0]
  have hlogScale : 0 < Real.log ((q : ℝ) * (T + 2)) :=
    Real.log_pos hscale
  have hCreal : (0 : ℝ) < C := by exact_mod_cast (by omega : 0 < C)
  have hdelta :
      0 < 1 / ((C : ℝ) * Real.log ((q : ℝ) * (T + 2))) :=
    one_div_pos.mpr (mul_pos hCreal hlogScale)
  intro rho hrho
  rw [mem_dirichletExplicitFormulaCandidateSingularities_iff] at hrho
  have hrect := hrho.1
  rw [Complex.Rectangle, Complex.mem_reProdIm] at hrect
  norm_num at hrect
  have hreEdges' : -(N : ℝ) - 1 / 2 ≤ 1 + (Real.log x)⁻¹ := by
    simpa only [one_div] using hreEdges
  rw [uIcc_of_le hreEdges', uIcc_of_le himEdges] at hrect
  have hrealNe : rho.re ≠ -(N : ℝ) - 1 / 2 ∧
      rho.re ≠ 1 + 1 / Real.log x := by
    rcases hrho.2 with hpole | hzero
    · rcases hpole with ⟨_, rfl⟩
      constructor
      · have hN : (0 : ℝ) ≤ N := Nat.cast_nonneg N
        norm_num
        linarith
      · intro h
        have hinv : 0 < 1 / Real.log x := one_div_pos.mpr hlogx
        change (1 : ℝ) = 1 + 1 / Real.log x at h
        linarith
    · have hvert := LFunction_ne_zero_on_dirichletExplicitFormulaVerticalEdges
          chi x hx N rho.im
      constructor
      · intro hre
        apply hvert.1
        have hrhoEq :
            (((-(N : ℝ) - 1 / 2 : ℝ) : ℂ) + rho.im * I) = rho := by
          apply Complex.ext
          · simpa using hre.symm
          · simp
        rw [hrhoEq]
        exact hzero.2
      · intro hre
        apply hvert.2
        have hrhoEq :
            (((1 + 1 / Real.log x : ℝ) : ℂ) + rho.im * I) = rho := by
          apply Complex.ext
          · simpa using hre.symm
          · simp
        rw [hrhoEq]
        exact hzero.2
  have himNe : rho.im ≠ -U ∧ rho.im ≠ U := by
    rcases hrho.2 with hpole | hzero
    · rcases hpole with ⟨_, rfl⟩
      constructor <;> norm_num <;> linarith
    · have hc := hclear rho hzero.1 hzero.2
      constructor
      · intro him
        rw [him, add_neg_cancel, abs_zero] at hc
        linarith [hc.2]
      · intro him
        rw [him, sub_self, abs_zero] at hc
        linarith [hc.1]
  have hright : rho.re ≤ 1 + 1 / Real.log x := by
    simpa only [one_div] using hrect.1.2
  have hcoordinates :
      rho.re ∈ Ioo (-(N : ℝ) - 1 / 2) (1 + 1 / Real.log x) ∧
        rho.im ∈ Ioo (-U) U :=
    ⟨⟨lt_of_le_of_ne hrect.1.1 hrealNe.1.symm,
        lt_of_le_of_ne hright hrealNe.2⟩,
      ⟨lt_of_le_of_ne hrect.2.1 himNe.1.symm,
        lt_of_le_of_ne hrect.2.2 himNe.2⟩⟩
  rw [Complex.Rectangle, Complex.interior_reProdIm]
  norm_num
  rw [uIcc_of_le hreEdges', uIcc_of_le himEdges,
    interior_Icc, interior_Icc, Complex.mem_reProdIm]
  simpa only [one_div] using hcoordinates

theorem norm_finsum_intCast_div_sub_le
    (D : ℂ → ℤ) (hfinite : D.support.Finite) (hnonneg : 0 ≤ D)
    {s : ℂ} {delta : ℝ} (hdelta : 0 < delta)
    (hsep : ∀ rho ∈ D.support, delta ≤ ‖s - rho‖) :
    ‖∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ ≤
      ((∑ᶠ rho : ℂ, D rho : ℤ) : ℝ) / delta := by
  classical
  have hsupp : Function.support (fun rho : ℂ => (D rho : ℂ) / (s - rho)) ⊆
      hfinite.toFinset := by
    intro rho h
    apply hfinite.mem_toFinset.mpr
    exact fun hzero => (div_ne_zero_iff.mp h).1 (by simp [hzero])
  rw [finsum_eq_sum_of_support_subset _ hsupp, finsum_eq_sum D hfinite,
    Int.cast_sum, Finset.sum_div]
  refine norm_sum_le_of_le _ fun rho hrho => ?_
  have hD : (0 : ℝ) ≤ D rho := by exact_mod_cast hnonneg rho
  rw [norm_div, Complex.norm_intCast, abs_of_nonneg hD]
  exact div_le_div_of_nonneg_left hD hdelta (hsep rho (hfinite.mem_toFinset.mp hrho))

end

section
open Set
/--
The entire kernel `(exp (rho * log x) - 1) / rho`, with the removable value `log x` at `rho =
0`. For positive `x`, the numerator is `x ^ rho - 1`.
-/
noncomputable def dirichletExplicitFormulaKernel (x : ℝ) (rho : ℂ) : ℂ :=
  dslope (fun s : ℂ => Complex.exp (s * (Real.log x : ℂ))) 0 rho

@[simp]
theorem dirichletExplicitFormulaKernel_zero (x : ℝ) :
    dirichletExplicitFormulaKernel x 0 = (Real.log x : ℂ) := by
  rw [dirichletExplicitFormulaKernel, dslope_same]
  rw [Complex.exp_eq_exp_ℂ]
  change deriv (fun s : ℂ => NormedSpace.exp (s • (Real.log x : ℂ))) 0 = _
  rw [(hasDerivAt_exp_smul_const (Real.log x : ℂ) (0 : ℂ)).deriv]
  simp

theorem mul_dirichletExplicitFormulaKernel (x : ℝ) (rho : ℂ) :
    rho * dirichletExplicitFormulaKernel x rho =
      Complex.exp (rho * (Real.log x : ℂ)) - 1 := by
  simpa [dirichletExplicitFormulaKernel, smul_eq_mul] using
    (sub_smul_dslope
      (fun s : ℂ => Complex.exp (s * (Real.log x : ℂ))) (0 : ℂ) rho)

theorem dirichletExplicitFormulaKernel_eq_cpow_sub_one_div
    {x : ℝ} (hx : 0 < x) {rho : ℂ} (hrho : rho ≠ 0) :
    dirichletExplicitFormulaKernel x rho =
      ((x : ℂ) ^ rho - 1) / rho := by
  rw [dirichletExplicitFormulaKernel, dslope_of_ne _ hrho]
  simp only [slope, sub_zero, vsub_eq_sub, smul_eq_mul]
  rw [zero_mul, Complex.exp_zero]
  rw [Complex.cpow_def_of_ne_zero (Complex.ofReal_ne_zero.mpr hx.ne')]
  rw [← Complex.ofReal_log hx.le, div_eq_mul_inv]
  ring_nf

theorem differentiable_dirichletExplicitFormulaKernel (x : ℝ) :
    Differentiable ℂ (dirichletExplicitFormulaKernel x) := by
  rw [← differentiableOn_univ]
  exact (Complex.differentiableOn_dslope Filter.univ_mem).2 <| by
    rw [Complex.exp_eq_exp_ℂ]
    simpa only [smul_eq_mul] using
      (differentiable_exp_smul_const ℂ (Real.log x : ℂ)).differentiableOn

end

section
open Set

section LocalLogarithmicResidue
theorem logDeriv_sub_pow_mul
    {rho z : ℂ} {g : ℂ -> ℂ} (m : ℕ)
    (hz : z ≠ rho) (hg0 : g z ≠ 0) (hg : DifferentiableAt ℂ g z) :
    logDeriv (fun w : ℂ => (w - rho) ^ m * g w) z =
      (m : ℂ) / (z - rho) + logDeriv g z := by
  rw [logDeriv_fun_mul (f := fun w : ℂ => (w - rho) ^ m) (g := g) z
    (pow_ne_zero m (sub_ne_zero.mpr hz)) hg0 (by fun_prop) hg,
    logDeriv_fun_pow (by fun_prop)]
  simp [logDeriv_apply, div_eq_mul_inv]

end LocalLogarithmicResidue

theorem AnalyticAt.exists_eventually_logDeriv_eq_order_div_add
    {f : ℂ -> ℂ} {rho : ℂ} (hf : AnalyticAt ℂ f rho)
    (hfinite : analyticOrderAt f rho ≠ ⊤) :
    ∃ g : ℂ -> ℂ,
      AnalyticAt ℂ g rho ∧ g rho ≠ 0 ∧
      ∀ᶠ z in 𝓝[≠] rho,
        logDeriv f z =
          (analyticOrderNatAt f rho : ℂ) / (z - rho) + logDeriv g z := by
  obtain ⟨g, hg, hg0, hfactor⟩ := hf.analyticOrderAt_ne_top.mp hfinite
  have hfactor' : f =ᶠ[𝓝 rho] fun z =>
      (z - rho) ^ analyticOrderNatAt f rho * g z := by
    simpa [smul_eq_mul] using hfactor
  refine ⟨g, hg, hg0, ?_⟩
  filter_upwards [(logDeriv_congr_nhds hfactor').filter_mono nhdsWithin_le_nhds,
    (hg.continuousAt.eventually_ne hg0).filter_mono nhdsWithin_le_nhds,
    hg.eventually_analyticAt.filter_mono nhdsWithin_le_nhds, self_mem_nhdsWithin]
    with z hlog hgne hgdiff hz
  rw [hlog]
  exact logDeriv_sub_pow_mul _ (by simpa using hz) hgne hgdiff.differentiableAt

theorem AnalyticAt.tendsto_sub_mul_logDeriv
    {f : ℂ -> ℂ} {rho : ℂ} (hf : AnalyticAt ℂ f rho)
    (hfinite : analyticOrderAt f rho ≠ ⊤) :
    Tendsto (fun z => (z - rho) * logDeriv f z) (𝓝[≠] rho)
      (𝓝 (analyticOrderNatAt f rho : ℂ)) := by
  obtain ⟨g, hg, hg0, hexpansion⟩ :=
    AnalyticAt.exists_eventually_logDeriv_eq_order_div_add
      hf hfinite
  have hlog : ContinuousAt (logDeriv g) rho :=
    hg.deriv.continuousAt.div hg.continuousAt hg0
  have hsub : Tendsto (fun z : ℂ => z - rho) (𝓝[≠] rho) (𝓝 0) := by
    have h :=
      (show ContinuousAt (fun z : ℂ => z - rho) rho by fun_prop).tendsto
        |>.mono_left (show 𝓝[≠] rho ≤ 𝓝 rho from nhdsWithin_le_nhds)
    simpa using h
  have hrem :
      Tendsto (fun z => (z - rho) * logDeriv g z) (𝓝[≠] rho) (𝓝 0) := by
    simpa using hsub.mul (hlog.tendsto.mono_left nhdsWithin_le_nhds)
  apply Tendsto.congr'
    (hexpansion.and self_mem_nhdsWithin |>.mono fun z hz => by
      have hne : z - rho ≠ 0 := sub_ne_zero.mpr (by simpa using hz.2)
      rw [hz.1, mul_add, ← mul_div_assoc, mul_div_cancel_left₀ _ hne])
  simpa using tendsto_const_nhds.add hrem

theorem tendsto_sub_mul_logDeriv_LFunction
    {N : ℕ} [NeZero N] {chi : DirichletCharacter ℂ N}
    (hchi : chi ≠ 1) (rho : ℂ) :
    Tendsto
      (fun z => (z - rho) *
        logDeriv (DirichletCharacter.LFunction chi) z)
      (𝓝[≠] rho)
      (𝓝 (analyticOrderNatAt
        (DirichletCharacter.LFunction chi) rho : ℂ)) :=
  AnalyticAt.tendsto_sub_mul_logDeriv
    ((DirichletCharacter.differentiable_LFunction hchi).analyticAt rho)
    (analyticOrderAt_LFunction_ne_top hchi rho)

/--
The negative logarithmic derivative of the Dirichlet L-function, multiplied by the entire
explicit-formula kernel. Its pole contributions encode the principal term and
multiplicity-weighted zeros.
-/
noncomputable def dirichletExplicitFormulaIntegrand
    {N : ℕ} [NeZero N] (chi : DirichletCharacter ℂ N)
    (x : ℝ) (s : ℂ) : ℂ :=
  -logDeriv (DirichletCharacter.LFunction chi) s *
    dirichletExplicitFormulaKernel x s

/--
The contribution assigned to a zero `rho`: minus its analytic multiplicity times the
explicit-formula kernel. The multiplicity is recorded as a natural number and then coerced to
`ℂ`.
-/
noncomputable def dirichletExplicitFormulaZeroResidue
    {N : ℕ} [NeZero N] (chi : DirichletCharacter ℂ N)
    (x : ℝ) (rho : ℂ) : ℂ :=
  -(analyticOrderNatAt (DirichletCharacter.LFunction chi) rho : ℂ) *
    dirichletExplicitFormulaKernel x rho

@[simp]
theorem dirichletExplicitFormulaZeroResidue_zero
    {N : ℕ} [NeZero N] (chi : DirichletCharacter ℂ N) (x : ℝ) :
    dirichletExplicitFormulaZeroResidue chi x 0 =
      -(analyticOrderNatAt
          (DirichletCharacter.LFunction chi) 0 : ℂ) *
        (Real.log x : ℂ) := by
  simp [dirichletExplicitFormulaZeroResidue]

theorem tendsto_sub_mul_dirichletExplicitFormulaIntegrand
    {N : ℕ} [NeZero N] {chi : DirichletCharacter ℂ N}
    (hchi : chi ≠ 1) (x : ℝ) (rho : ℂ) :
    Tendsto
      (fun s => (s - rho) * dirichletExplicitFormulaIntegrand chi x s)
      (𝓝[≠] rho)
      (𝓝 (dirichletExplicitFormulaZeroResidue chi x rho)) := by
  have hkernel : Tendsto
      (dirichletExplicitFormulaKernel x) (𝓝[≠] rho)
      (𝓝 (dirichletExplicitFormulaKernel x rho)) :=
    (differentiable_dirichletExplicitFormulaKernel x).continuous
      |>.continuousAt.tendsto.mono_left nhdsWithin_le_nhds
  have hlimit :=
    (tendsto_sub_mul_logDeriv_LFunction hchi rho).neg.mul hkernel
  rw [dirichletExplicitFormulaZeroResidue]
  exact hlimit.congr' (Filter.Eventually.of_forall fun s => by
    simp only [dirichletExplicitFormulaIntegrand]
    ring)

theorem differentiableAt_dirichletExplicitFormulaIntegrand_of_ne_zero
    {N : ℕ} [NeZero N] {chi : DirichletCharacter ℂ N}
    (hchi : chi ≠ 1) (x : ℝ) {s : ℂ}
    (hs : DirichletCharacter.LFunction chi s ≠ 0) :
    DifferentiableAt ℂ (dirichletExplicitFormulaIntegrand chi x) s := by
  have hL : AnalyticAt ℂ (DirichletCharacter.LFunction chi) s :=
    (DirichletCharacter.differentiable_LFunction hchi).analyticAt s
  have hLog : AnalyticAt ℂ
      (logDeriv (DirichletCharacter.LFunction chi)) s := by
    change AnalyticAt ℂ
      (fun z => deriv (DirichletCharacter.LFunction chi) z /
        DirichletCharacter.LFunction chi z) s
    exact hL.deriv.div hL hs
  exact hLog.differentiableAt.neg.mul
    (differentiable_dirichletExplicitFormulaKernel x s)

/--
The principal-character pole contribution, obtained by evaluating the explicit-formula kernel at
`1`. It equals `x - 1` when `x` is positive.
-/
noncomputable def dirichletExplicitFormulaPrincipalPoleResidue
    (x : ℝ) : ℂ :=
  dirichletExplicitFormulaKernel x 1

theorem dirichletExplicitFormulaPrincipalPoleResidue_eq_sub_one
    {x : ℝ} (hx : 0 < x) :
    dirichletExplicitFormulaPrincipalPoleResidue x = (x : ℂ) - 1 := by
  simpa [dirichletExplicitFormulaPrincipalPoleResidue] using
    (dirichletExplicitFormulaKernel_eq_cpow_sub_one_div
      hx (rho := (1 : ℂ)) one_ne_zero)

theorem tendsto_sub_one_mul_neg_logDeriv_principal_LFunction
    {N : ℕ} [NeZero N] :
    Tendsto
      (fun s => (s - 1) *
        (-logDeriv (DirichletCharacter.LFunction
          (1 : DirichletCharacter ℂ N)) s))
      (nhdsWithin (1 : ℂ) {1}ᶜ)
      (𝓝 1) := by
  let L : ℂ → ℂ :=
    DirichletCharacter.LFunction (1 : DirichletCharacter ℂ N)
  let G : ℂ → ℂ := DirichletCharacter.LFunctionTrivChar₁ N
  have hGdiff : Differentiable ℂ G := by
    simpa [G] using DirichletCharacter.differentiable_LFunctionTrivChar₁ N
  have hGone : G 1 ≠ 0 := by
    simpa [G] using
      DirichletCharacter.LFunctionTrivChar₁_apply_one_ne_zero N
  have hGreg : Tendsto (fun s => logDeriv G s) (𝓝 (1 : ℂ))
      (𝓝 (logDeriv G 1)) := by
    have hderiv : Continuous (deriv G) :=
      hGdiff.contDiff.continuous_deriv le_rfl
    change Tendsto (deriv G / G) (𝓝 (1 : ℂ))
      (𝓝 ((deriv G / G) 1))
    exact (hderiv.continuousAt.div
      hGdiff.continuous.continuousAt hGone).tendsto
  have hGregNeg : Tendsto (fun s => -logDeriv G s) (𝓝 (1 : ℂ))
      (𝓝 (-logDeriv G 1)) :=
    hGreg.neg
  have hzero : Tendsto (fun s : ℂ => s - 1)
      (nhdsWithin (1 : ℂ) {1}ᶜ) (𝓝 0) := by
    have hid : Tendsto (fun s : ℂ => s)
        (nhdsWithin (1 : ℂ) {1}ᶜ) (𝓝 1) :=
      tendsto_id.mono_left nhdsWithin_le_nhds
    have hone : Tendsto (fun _ : ℂ => (1 : ℂ))
        (nhdsWithin (1 : ℂ) {1}ᶜ) (𝓝 1) :=
      tendsto_const_nhds
    simpa using hid.sub hone
  have hlimit : Tendsto
      (fun s => (s - 1) * (-logDeriv G s) + 1)
      (nhdsWithin (1 : ℂ) {1}ᶜ) (𝓝 1) := by
    simpa using
      (hzero.mul (hGregNeg.mono_left nhdsWithin_le_nhds)).add
        tendsto_const_nhds
  have hGne : ∀ᶠ s in 𝓝 (1 : ℂ), G s ≠ 0 :=
    hGdiff.continuous.continuousAt.eventually_ne hGone
  refine hlimit.congr' ?_
  filter_upwards [self_mem_nhdsWithin,
    hGne.filter_mono nhdsWithin_le_nhds] with s hs hGs
  have hsOne : s ≠ 1 := by simpa using hs
  have hsub : s - 1 ≠ 0 := sub_ne_zero.mpr hsOne
  have hregularized : G s = (s - 1) * L s := by
    dsimp only [G, L]
    rw [DirichletCharacter.LFunctionTrivChar₁,
      Function.update_of_ne hsOne]
  have hL : L s ≠ 0 := by
    intro hzeroL
    rw [hzeroL, mul_zero] at hregularized
    exact hGs hregularized
  have hderivRegularized :
      deriv G s = (s - 1) * deriv L s + L s := by
    simpa [G, L] using
      DirichletCharacter.deriv_LFunctionTrivChar₁_apply_of_ne_one N hsOne
  have hrelation :
      -logDeriv L s = -logDeriv G s + 1 / (s - 1) := by
    rw [logDeriv_apply, logDeriv_apply, hderivRegularized,
      hregularized]
    field_simp [hsub, hL]
    ring
  rw [hrelation]
  field_simp [hsub]

theorem tendsto_sub_one_mul_dirichletExplicitFormulaIntegrand_one
    {N : ℕ} [NeZero N] (x : ℝ) :
    Tendsto
      (fun s => (s - 1) *
        dirichletExplicitFormulaIntegrand
          (1 : DirichletCharacter ℂ N) x s)
      (nhdsWithin (1 : ℂ) {1}ᶜ)
      (𝓝 (dirichletExplicitFormulaPrincipalPoleResidue x)) := by
  have hkernel : Tendsto
      (dirichletExplicitFormulaKernel x)
      (nhdsWithin (1 : ℂ) {1}ᶜ)
      (𝓝 (dirichletExplicitFormulaKernel x 1)) :=
    (differentiable_dirichletExplicitFormulaKernel x).continuous
      |>.continuousAt.tendsto.mono_left nhdsWithin_le_nhds
  simpa [dirichletExplicitFormulaIntegrand,
    dirichletExplicitFormulaPrincipalPoleResidue, mul_assoc] using
    (tendsto_sub_one_mul_neg_logDeriv_principal_LFunction
      (N := N)).mul hkernel

theorem differentiableAt_dirichletExplicitFormulaIntegrand_one_of_ne_one_of_ne_zero
    {N : ℕ} [NeZero N] (x : ℝ) {s : ℂ} (hsOne : s ≠ 1)
    (hs : DirichletCharacter.LFunction
      (1 : DirichletCharacter ℂ N) s ≠ 0) :
    DifferentiableAt ℂ
      (dirichletExplicitFormulaIntegrand
        (1 : DirichletCharacter ℂ N) x) s := by
  have hLDiff : DifferentiableOn ℂ
      (DirichletCharacter.LFunction
        (1 : DirichletCharacter ℂ N)) ({1}ᶜ : Set ℂ) := by
    intro z hz
    exact (DirichletCharacter.differentiableAt_LFunction
      (1 : DirichletCharacter ℂ N) z
        (.inl (by simpa using hz))).differentiableWithinAt
  have hL : AnalyticAt ℂ
      (DirichletCharacter.LFunction
        (1 : DirichletCharacter ℂ N)) s :=
    (hLDiff.analyticOnNhd isOpen_compl_singleton) s (by simpa)
  have hLog : AnalyticAt ℂ
      (logDeriv (DirichletCharacter.LFunction
        (1 : DirichletCharacter ℂ N))) s := by
    change AnalyticAt ℂ
      (fun z => deriv (DirichletCharacter.LFunction
          (1 : DirichletCharacter ℂ N)) z /
        DirichletCharacter.LFunction
          (1 : DirichletCharacter ℂ N) z) s
    exact hL.deriv.div hL hs
  exact hLog.differentiableAt.neg.mul
    (differentiable_dirichletExplicitFormulaKernel x s)

theorem tendsto_sub_mul_dirichletExplicitFormulaIntegrand_one_of_ne_one
    {N : ℕ} [NeZero N] (x : ℝ) (rho : ℂ) (hrho : rho ≠ 1) :
    Tendsto
      (fun s => (s - rho) *
        dirichletExplicitFormulaIntegrand
          (1 : DirichletCharacter ℂ N) x s)
      (𝓝[≠] rho)
      (𝓝 (dirichletExplicitFormulaZeroResidue
        (1 : DirichletCharacter ℂ N) x rho)) := by
  let L : ℂ → ℂ :=
    DirichletCharacter.LFunction (1 : DirichletCharacter ℂ N)
  have hL : AnalyticOnNhd ℂ L ({1}ᶜ : Set ℂ) := by
    refine DifferentiableOn.analyticOnNhd (fun z hz => ?_)
      isOpen_compl_singleton
    exact (DirichletCharacter.differentiableAt_LFunction
      (1 : DirichletCharacter ℂ N) z
        (.inl (by simpa using hz))).differentiableWithinAt
  have htwoMem : (2 : ℂ) ∈ ({1}ᶜ : Set ℂ) := by norm_num
  have hrhoMem : rho ∈ ({1}ᶜ : Set ℂ) := by simpa
  have htwo : L (2 : ℂ) ≠ 0 := by
    dsimp only [L]
    exact DirichletCharacter.LFunction_ne_zero_of_one_le_re
      (1 : DirichletCharacter ℂ N) (.inr (by norm_num)) (by norm_num)
  have htwoFinite : analyticOrderAt L (2 : ℂ) ≠ ⊤ := by
    rw [(hL 2 htwoMem).analyticOrderAt_eq_zero.mpr htwo]
    exact WithTop.zero_ne_top
  have hfinite : analyticOrderAt L rho ≠ ⊤ :=
    hL.analyticOrderAt_ne_top_of_isPreconnected
      (isConnected_compl_singleton_of_one_lt_rank
        (Complex.rank_real_complex ▸ Nat.one_lt_ofNat) 1).isPreconnected
      htwoMem hrhoMem htwoFinite
  have hlog : Tendsto
      (fun s => (s - rho) * logDeriv L s)
      (𝓝[≠] rho)
      (𝓝 (analyticOrderNatAt L rho : ℂ)) :=
    AnalyticAt.tendsto_sub_mul_logDeriv
      (hL rho hrhoMem) hfinite
  have hkernel : Tendsto
      (dirichletExplicitFormulaKernel x) (𝓝[≠] rho)
      (𝓝 (dirichletExplicitFormulaKernel x rho)) :=
    (differentiable_dirichletExplicitFormulaKernel x).continuous
      |>.continuousAt.tendsto.mono_left nhdsWithin_le_nhds
  have hlimit := hlog.neg.mul hkernel
  rw [dirichletExplicitFormulaZeroResidue]
  exact hlimit.congr' (Filter.Eventually.of_forall fun s => by
    dsimp only [L]
    simp only [dirichletExplicitFormulaIntegrand]
    ring)

end

section
open Complex Set
/--
The residue contribution attached to a candidate singularity. The point `1` for the principal
character uses the principal pole term; every other candidate uses the negative
multiplicity-weighted zero term.
-/
noncomputable def dirichletExplicitFormulaCandidateContribution
    {N : ℕ} [NeZero N] (chi : DirichletCharacter ℂ N)
    (x : ℝ) (rho : ℂ) : ℂ := by
  classical
  exact if chi = 1 ∧ rho = 1 then
      dirichletExplicitFormulaPrincipalPoleResidue x
    else
      dirichletExplicitFormulaZeroResidue chi x rho

/--
Finite enumeration of the candidate singularities of the explicit-formula integrand in the
closed rectangle with opposite corners `z` and `w`. The candidates consist of L-function zeros
together with the principal-character pole.
-/
noncomputable def dirichletExplicitFormulaCandidateSingularitiesFinset
    {N : ℕ} [NeZero N] (chi : DirichletCharacter ℂ N)
    (z w : ℂ) : Finset ℂ :=
  (dirichletExplicitFormulaCandidateSingularities_finite chi z w).toFinset

@[simp]
theorem mem_dirichletExplicitFormulaCandidateSingularitiesFinset_iff
    {N : ℕ} [NeZero N] {chi : DirichletCharacter ℂ N}
    {z w rho : ℂ} :
    rho ∈ dirichletExplicitFormulaCandidateSingularitiesFinset chi z w ↔
      rho ∈ ({pntCandidate | pntCandidate ∈ Complex.Rectangle (z) (w) ∧
               (((chi) = 1 ∧ pntCandidate = 1) ∨
                 ((pntCandidate ≠ 1 ∨ (chi) ≠ 1) ∧
                   DirichletCharacter.LFunction (chi) pntCandidate = 0))}) := by
  simp [dirichletExplicitFormulaCandidateSingularitiesFinset]

end

section
open Complex

section ImprimitiveLFunctionTransport
attribute [local instance] inducingEulerProductConductorNeZero

end ImprimitiveLFunctionTransport
end

section
open Complex

attribute [local instance] inducingEulerProductConductorNeZero

section ImprimitiveLFunctionTransport

theorem one_lt_conductor_of_ne_one
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    (hchi : chi ≠ 1) :
    1 < chi.conductor := by
  have := chi.conductor_ne_zero
  have := mt DirichletCharacter.eq_one_iff_conductor_eq_one.mpr hchi
  omega

theorem norm_character_mul_cpow_neg_le_half
    {d : ℕ} (psi : DirichletCharacter ℂ d)
    (p : ℕ) (hp : p.Prime) (s : ℂ) (hs : 1 ≤ s.re) :
    ‖psi p * (p : ℂ) ^ (-s)‖ ≤ (1 / 2 : ℝ) := by
  have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast hp.two_le
  have hp1 : (1 : ℝ) ≤ p := one_le_two.trans hp2
  have hpow : (2 : ℝ) ≤ (p : ℝ) ^ s.re := by
    calc
      (2 : ℝ) ≤ p := hp2
      _ = (p : ℝ) ^ (1 : ℝ) := by rw [Real.rpow_one]
      _ ≤ (p : ℝ) ^ s.re :=
        Real.rpow_le_rpow_of_exponent_le hp1 hs
  rw [norm_mul, Complex.norm_natCast_cpow_of_pos hp.pos, neg_re,
    Real.rpow_neg (Nat.cast_nonneg p)]
  calc
    ‖psi p‖ * ((p : ℝ) ^ s.re)⁻¹ ≤
        1 * ((p : ℝ) ^ s.re)⁻¹ :=
      mul_le_mul_of_nonneg_right (psi.norm_le_one p)
        (inv_nonneg.mpr (Real.rpow_nonneg (Nat.cast_nonneg p) _))
    _ ≤ (1 / 2 : ℝ) := by
      simpa [one_div] using
        (one_div_le_one_div_of_le (by norm_num : (0 : ℝ) < 2) hpow)

theorem norm_logDeriv_inducingEulerFactor_le_log
    {d : ℕ} (psi : DirichletCharacter ℂ d)
    (p : ℕ) (hp : p.Prime) (s : ℂ) (hs : 1 ≤ s.re) :
    ‖logDeriv (fun z : ℂ =>
        1 - psi p * (p : ℂ) ^ (-z)) s‖ ≤ Real.log p := by
  let w : ℂ := psi p * (p : ℂ) ^ (-s)
  have hp1 : (1 : ℝ) ≤ p := by exact_mod_cast hp.one_le
  have hwNorm : ‖w‖ ≤ (1 / 2 : ℝ) :=
    norm_character_mul_cpow_neg_le_half psi p hp s hs
  have hden : (1 / 2 : ℝ) ≤ ‖(1 : ℂ) - w‖ := by
    have hreverse := norm_sub_norm_le (1 : ℂ) w
    norm_num at hreverse
    linarith
  have hdenPos : 0 < ‖(1 : ℂ) - w‖ := by linarith
  have hpowDeriv :=
    (hasDerivAt_neg' s).const_cpow (c := (p : ℂ))
      (Or.inl (Nat.cast_ne_zero.mpr hp.ne_zero))
  have hfactorDeriv := (hasDerivAt_const s (1 : ℂ)).sub
    (hpowDeriv.const_mul (psi p))
  have hderiv :
      deriv (fun z : ℂ => 1 - psi p * (p : ℂ) ^ (-z)) s =
        psi p * (p : ℂ) ^ (-s) * Complex.log p := by
    have hd := hfactorDeriv.deriv
    change deriv (fun z : ℂ => 1 - psi p * (p : ℂ) ^ (-z)) s = _ at hd
    calc
      _ = 0 - psi p * ((p : ℂ) ^ (-s) * Complex.log p * -1) := hd
      _ = _ := by ring
  have hlogNorm : ‖Complex.log (p : ℂ)‖ = Real.log p := by
    rw [show (p : ℂ) = ((p : ℝ) : ℂ) by norm_cast,
      ← Complex.ofReal_log (Nat.cast_nonneg p), Complex.norm_real,
      Real.norm_eq_abs, abs_of_nonneg]
    exact Real.log_nonneg hp1
  rw [logDeriv_apply, hderiv, norm_div, norm_mul, hlogNorm]
  change ‖w‖ * Real.log p / ‖(1 : ℂ) - w‖ ≤ Real.log p
  apply (div_le_iff₀ hdenPos).2
  have hwDen : ‖w‖ ≤ ‖(1 : ℂ) - w‖ := hwNorm.trans hden
  simpa [mul_comm] using
    mul_le_mul_of_nonneg_right hwDen (Real.log_nonneg hp1)

theorem norm_logDeriv_inducingEulerProduct_le_log
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    (s : ℂ) (hs : 1 ≤ s.re) :
    ‖logDeriv (inducingEulerProduct chi) s‖ ≤ Real.log q := by
  change ‖logDeriv (fun z : ℂ =>
    ∏ p ∈ q.primeFactors,
      (1 - chi.primitiveCharacter p * (p : ℂ) ^ (-z))) s‖ ≤ _
  rw [logDeriv_fun_prod]
  · calc
      _ ≤ ∑ p ∈ q.primeFactors, Real.log p :=
        norm_sum_le_of_le _ fun p hp =>
          norm_logDeriv_inducingEulerFactor_le_log
            chi.primitiveCharacter p (Nat.prime_of_mem_primeFactors hp) s hs
      _ = Real.log (∏ p ∈ q.primeFactors, (p : ℝ)) := by
        rw [Real.log_prod]
        intro p hp
        exact_mod_cast (Nat.prime_of_mem_primeFactors hp).ne_zero
      _ ≤ Real.log q := by
        let P : ℕ := ∏ p ∈ q.primeFactors, p
        have hPpos : 0 < P := by
          dsimp [P]
          exact Finset.prod_pos fun p hp =>
            (Nat.prime_of_mem_primeFactors hp).pos
        have hPle : P ≤ q :=
          Nat.le_of_dvd (NeZero.pos q)
            (by simpa [P] using Nat.prod_primeFactors_dvd q)
        have hcast : (P : ℝ) =
            ∏ p ∈ q.primeFactors, (p : ℝ) := by
          simp [P]
        rw [← hcast]
        exact Real.log_le_log (by exact_mod_cast hPpos)
          (by exact_mod_cast hPle)
  · intro p hp
    exact inducingEulerFactor_ne_zero_of_re_pos chi.primitiveCharacter p
      (Nat.prime_of_mem_primeFactors hp) s (zero_lt_one.trans_le hs)
  · intro p hp
    exact differentiableAt_inducingEulerFactor chi.primitiveCharacter p
      (Nat.prime_of_mem_primeFactors hp) s

end ImprimitiveLFunctionTransport
end

section
open Complex

attribute [local instance] inducingEulerProductConductorNeZero
theorem isNonprincipalNontrivialLFunctionZero_iff
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (rho : ℂ) :
    (chi ≠ 1 ∧
      DirichletCharacter.completedLFunction chi.primitiveCharacter rho = 0) ↔
      chi ≠ 1 ∧
        DirichletCharacter.LFunction chi rho = 0 ∧
          0 < rho.re ∧ rho.re < 1 := by
  constructor
  · rintro ⟨hchi, hcompleted⟩
    have hprimitive :
        (1 < chi.conductor ∧ chi.primitiveCharacter.IsPrimitive ∧
          DirichletCharacter.completedLFunction chi.primitiveCharacter rho = 0) :=
      ⟨one_lt_conductor_of_ne_one chi hchi,
        chi.primitiveCharacter_isPrimitive, hcompleted⟩
    have hordinary :=
      (isPrimitiveNontrivialLFunctionZero_iff
        chi.primitiveCharacter rho).1 hprimitive
    refine ⟨hchi, ?_, hordinary.2.2.2.1, hordinary.2.2.2.2⟩
    rw [LFunction_eq_inducingPrimitive_mul_inducingEulerProduct chi
      (.inl hchi),
      hordinary.2.2.1, zero_mul]
  · rintro ⟨hchi, hzero, hre0, hre1⟩
    have hprimitiveZero :
        DirichletCharacter.LFunction chi.primitiveCharacter rho = 0 := by
      rw [LFunction_eq_inducingPrimitive_mul_inducingEulerProduct chi
        (.inl hchi)] at hzero
      exact (mul_eq_zero.mp hzero).resolve_right
        (inducingEulerProduct_ne_zero_of_re_pos chi hre0)
    have hprimitive :
        (1 < chi.conductor ∧ chi.primitiveCharacter.IsPrimitive ∧
          DirichletCharacter.completedLFunction chi.primitiveCharacter rho = 0) :=
      (isPrimitiveNontrivialLFunctionZero_iff
        chi.primitiveCharacter rho).2
          ⟨one_lt_conductor_of_ne_one chi hchi,
            chi.primitiveCharacter_isPrimitive,
            hprimitiveZero, hre0, hre1⟩
    exact ⟨hchi, hprimitive.2.2⟩

theorem norm_logDeriv_LFunction_sub_inducingPrimitive_le_log
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (hchi : chi ≠ 1)
    {s : ℂ} (hs : 1 ≤ s.re) :
    ‖logDeriv (DirichletCharacter.LFunction chi) s -
        logDeriv
          (DirichletCharacter.LFunction chi.primitiveCharacter) s‖ ≤
      Real.log (q : ℝ) := by
  let P : ℂ → ℂ := inducingEulerProduct chi
  have heq : DirichletCharacter.LFunction chi =ᶠ[𝓝 s]
      fun z => DirichletCharacter.LFunction chi.primitiveCharacter z * P z :=
    Eventually.of_forall fun z => by
      simpa [P] using
        LFunction_eq_inducingPrimitive_mul_inducingEulerProduct chi
          (.inl hchi)
  have hPne : P s ≠ 0 := by
    simpa [P] using inducingEulerProduct_ne_zero_of_re_pos chi
      (zero_lt_one.trans_le hs)
  have hpsiNe :
      DirichletCharacter.LFunction chi.primitiveCharacter s ≠ 0 :=
    chi.primitiveCharacter.LFunction_ne_zero_of_one_le_re
      (.inl (primitiveCharacter_ne_one_of_ne_one chi hchi)) hs
  have hlog :
      logDeriv (DirichletCharacter.LFunction chi) s =
        logDeriv (DirichletCharacter.LFunction chi.primitiveCharacter) s +
          logDeriv P s := by
    calc
      logDeriv (DirichletCharacter.LFunction chi) s =
          logDeriv (fun z =>
            DirichletCharacter.LFunction chi.primitiveCharacter z * P z) s := by
        rw [logDeriv_apply, logDeriv_apply, heq.deriv_eq,
          heq.self_of_nhds]
      _ = logDeriv
            (DirichletCharacter.LFunction chi.primitiveCharacter) s +
          logDeriv P s :=
        logDeriv_mul s hpsiNe hPne
          (DirichletCharacter.differentiable_LFunction
            (primitiveCharacter_ne_one_of_ne_one chi hchi) s)
          (by simpa [P] using differentiable_inducingEulerProduct chi s)
  rw [hlog, add_sub_cancel_left]
  simpa [P] using norm_logDeriv_inducingEulerProduct_le_log chi s hs

end

section
open Complex Set

section DirichletNontrivialZeroTransport
attribute [local instance] inducingEulerProductConductorNeZero

end DirichletNontrivialZeroTransport
end

section
open Complex Set

attribute [local instance] inducingEulerProductConductorNeZero

end

section
open Complex Set

attribute [local instance] inducingEulerProductConductorNeZero
theorem isDirichletNontrivialLFunctionZero_iff_inducingPrimitive
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (rho : ℂ) :
    (DirichletCharacter.LFunction chi rho = 0 ∧
      0 < rho.re ∧ rho.re < 1) ↔
      (DirichletCharacter.LFunction chi.primitiveCharacter rho = 0 ∧
        0 < rho.re ∧ rho.re < 1) := by
  by_cases hrhoOne : rho = 1
  · subst rho
    simp
  · constructor
    · rintro ⟨hzero, hre0, hre1⟩
      have hfactor :=
        LFunction_eq_inducingPrimitive_mul_inducingEulerProduct chi
          (.inr hrhoOne)
      rw [hfactor] at hzero
      exact ⟨(mul_eq_zero.mp hzero).resolve_right
        (inducingEulerProduct_ne_zero_of_re_pos chi hre0), hre0, hre1⟩
    · rintro ⟨hzero, hre0, hre1⟩
      refine ⟨?_, hre0, hre1⟩
      rw [LFunction_eq_inducingPrimitive_mul_inducingEulerProduct chi
        (.inr hrhoOne), hzero, zero_mul]

theorem
    analyticOrderNatAt_LFunction_eq_inducingPrimitive_of_re_pos_of_guard
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) {rho : ℂ}
    (hguard : chi ≠ 1 ∨ rho ≠ 1) (hrho : 0 < rho.re) :
    analyticOrderNatAt (DirichletCharacter.LFunction chi) rho =
      analyticOrderNatAt
        (DirichletCharacter.LFunction chi.primitiveCharacter) rho := by
  let P : ℂ → ℂ := inducingEulerProduct chi
  have heq : DirichletCharacter.LFunction chi =ᶠ[𝓝 rho]
      fun z => DirichletCharacter.LFunction chi.primitiveCharacter z * P z := by
    rcases hguard with hchi | hrhoOne
    · exact Eventually.of_forall fun z => by
        simpa [P] using
          LFunction_eq_inducingPrimitive_mul_inducingEulerProduct chi
            (.inl hchi)
    · filter_upwards [eventually_ne_nhds hrhoOne] with z hz
      simpa [P] using
        LFunction_eq_inducingPrimitive_mul_inducingEulerProduct chi
          (.inr hz)
  have hprimitiveGuard : rho ≠ 1 ∨ chi.primitiveCharacter ≠ 1 := by
    rcases hguard with hchi | hrhoOne
    · exact .inr (primitiveCharacter_ne_one_of_ne_one chi hchi)
    · exact .inl hrhoOne
  have hprimitive : AnalyticAt ℂ
      (DirichletCharacter.LFunction chi.primitiveCharacter) rho := by
    rcases hprimitiveGuard with hrhoOne | hpsi
    · have hdiff : DifferentiableOn ℂ
          (DirichletCharacter.LFunction chi.primitiveCharacter) ({1}ᶜ : Set ℂ) := by
        intro z hz
        exact (DirichletCharacter.differentiableAt_LFunction
          chi.primitiveCharacter z (.inl (by simpa using hz))).differentiableWithinAt
      exact hdiff.analyticAt
        (isOpen_compl_singleton.mem_nhds (by simpa using hrhoOne))
    · exact (DirichletCharacter.differentiable_LFunction hpsi).analyticAt rho
  have hP : AnalyticAt ℂ P rho := by
    simpa [P] using (differentiable_inducingEulerProduct chi).analyticAt rho
  have hPne : P rho ≠ 0 := by
    simpa [P] using inducingEulerProduct_ne_zero_of_re_pos chi hrho
  apply congrArg ENat.toNat
  rw [analyticOrderAt_congr heq]
  change analyticOrderAt (DirichletCharacter.LFunction chi.primitiveCharacter * P) rho = _
  rw [analyticOrderAt_mul hprimitive hP, hP.analyticOrderAt_eq_zero.mpr hPne, add_zero]

/--
The distinct zeros of the Dirichlet L-function in `0 < re < 1` with absolute imaginary part at
most `|T|`. Multiplicities are not encoded in this finset and must be supplied separately when
summing.
-/
noncomputable def dirichletNontrivialLFunctionZerosFinset
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (T : ℝ) : Finset ℂ := by
  classical
  exact (dirichletExplicitFormulaCandidateSingularitiesFinset chi
    ((0 : ℂ) - |T| * I) ((1 : ℂ) + |T| * I)).filter
      (fun rho : ℂ =>
        DirichletCharacter.LFunction chi rho = 0 ∧
          0 < rho.re ∧ rho.re < 1)

@[simp]
theorem mem_dirichletNontrivialLFunctionZerosFinset_iff
    {q : ℕ} [NeZero q] {chi : DirichletCharacter ℂ q}
    {T : ℝ} {rho : ℂ} :
    rho ∈ dirichletNontrivialLFunctionZerosFinset chi T ↔
      (DirichletCharacter.LFunction (chi) (rho) = 0 ∧
         0 < (rho).re ∧ (rho).re < 1) ∧
        |rho.im| ≤ |T| := by
  classical
  rw [dirichletNontrivialLFunctionZerosFinset, Finset.mem_filter,
    mem_dirichletExplicitFormulaCandidateSingularitiesFinset_iff,
    mem_dirichletExplicitFormulaCandidateSingularities_iff]
  constructor
  · rintro ⟨⟨hrect, _⟩, hzero⟩
    rw [Complex.Rectangle, Complex.mem_reProdIm] at hrect
    norm_num at hrect
    exact ⟨hzero, (abs_le.mpr hrect.2)⟩
  · rintro ⟨hzero, hheight⟩
    have hrhoOne : rho ≠ 1 := by
      intro hrho
      have hre := congrArg Complex.re hrho
      simp only [one_re] at hre
      exact (lt_irrefl 1) (hre ▸ hzero.2.2)
    refine ⟨⟨?_, Or.inr ⟨Or.inl hrhoOne, hzero.1⟩⟩, hzero⟩
    rw [Complex.Rectangle, Complex.mem_reProdIm]
    norm_num
    exact ⟨⟨hzero.2.1.le, hzero.2.2.le⟩, abs_le.mp hheight⟩

theorem dirichletNontrivialLFunctionZerosFinset_eq_inducingPrimitive
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (T : ℝ) :
    dirichletNontrivialLFunctionZerosFinset chi T =
      dirichletNontrivialLFunctionZerosFinset chi.primitiveCharacter T := by
  classical
  ext rho
  rw [mem_dirichletNontrivialLFunctionZerosFinset_iff,
    mem_dirichletNontrivialLFunctionZerosFinset_iff,
    isDirichletNontrivialLFunctionZero_iff_inducingPrimitive]

/--
The explicit-formula kernel summed over nontrivial zeros up to height `|T|`, weighted by their
analytic multiplicities. This sum has positive multiplicity weights and is subtracted in the
main explicit-formula expression.
-/
noncomputable def dirichletNontrivialZeroKernelSum
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (x T : ℝ) : ℂ :=
  ∑ rho ∈ dirichletNontrivialLFunctionZerosFinset chi T,
    (analyticOrderNatAt
      (DirichletCharacter.LFunction chi) rho : ℂ) *
        dirichletExplicitFormulaKernel x rho

theorem dirichletNontrivialZeroKernelSum_eq_inducingPrimitive
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (x T : ℝ) :
    dirichletNontrivialZeroKernelSum chi x T =
      dirichletNontrivialZeroKernelSum chi.primitiveCharacter x T := by
  classical
  rw [dirichletNontrivialZeroKernelSum,
    dirichletNontrivialZeroKernelSum,
    dirichletNontrivialLFunctionZerosFinset_eq_inducingPrimitive chi T]
  apply Finset.sum_congr rfl
  intro rho hrho
  have hzero :=
    (mem_dirichletNontrivialLFunctionZerosFinset_iff.mp hrho).1
  have hrhoOne : rho ≠ 1 := by
    intro hrho
    have hre := congrArg Complex.re hrho
    simp only [one_re] at hre
    exact (lt_irrefl 1) (hre ▸ hzero.2.2)
  rw [analyticOrderNatAt_LFunction_eq_inducingPrimitive_of_re_pos_of_guard
    chi (.inr hrhoOne) hzero.2.1]

end

section
open Complex

attribute [local instance] inducingEulerProductConductorNeZero
theorem analyticOrderNatAt_LFunction_eq_inducingPrimitive_of_re_pos
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (hchi : chi ≠ 1)
    {rho : ℂ} (hrho : 0 < rho.re) :
    analyticOrderNatAt (DirichletCharacter.LFunction chi) rho =
      analyticOrderNatAt
        (DirichletCharacter.LFunction chi.primitiveCharacter) rho :=
  analyticOrderNatAt_LFunction_eq_inducingPrimitive_of_re_pos_of_guard chi (.inl hchi) hrho

theorem exists_nat_selectedNonprincipalNontrivialZeros_sum_sub_le_re_logDeriv_LFunction :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q), chi ≠ 1 →
          ∀ (t sigma : ℝ) (Z : ℂ →₀ ℕ),
            1 ≤ sigma → sigma ≤ 2 →
              (∀ rho ∈ Z.support,
                (chi ≠ 1 ∧
                  DirichletCharacter.completedLFunction chi.primitiveCharacter rho = 0) ∧
                  |rho.im - t| ≤ 1) →
                (∀ rho : ℂ,
                  Z rho ≤ analyticOrderNatAt
                    (DirichletCharacter.LFunction chi) rho) →
                  Z.sum (fun rho m =>
                      (m : ℝ) *
                        ((((sigma : ℂ) + t * Complex.I) - rho)⁻¹).re) -
                    (16 * (A : ℝ) + 3) *
                        Real.log ((q : ℝ) * (|t| + 2)) / 3 ≤
                    (logDeriv (DirichletCharacter.LFunction chi)
                      ((sigma : ℂ) + t * Complex.I)).re := by
  obtain ⟨A, hA, hprimitive⟩ :=
    exists_nat_selectedPrimitiveNontrivialZeros_sum_sub_le_re_logDeriv_LFunction
  refine ⟨A, hA, ?_⟩
  intro q _ chi hchi t sigma Z hsigma1 hsigma2 hZ hmult
  let s : ℂ := (sigma : ℂ) + t * I
  let T : ℝ := |t| + 2
  let d : ℕ := chi.conductor
  let D : ℂ := logDeriv (DirichletCharacter.LFunction chi) s -
    logDeriv (DirichletCharacter.LFunction chi.primitiveCharacter) s
  have hd1 : 1 < d := by
    simpa [d] using one_lt_conductor_of_ne_one chi hchi
  have hZprimitive :
      ∀ rho ∈ Z.support,
        (1 < chi.conductor ∧ chi.primitiveCharacter.IsPrimitive ∧
          DirichletCharacter.completedLFunction chi.primitiveCharacter rho = 0) ∧
          |rho.im - t| ≤ 1 := by
    intro rho hrho
    exact ⟨⟨hd1, chi.primitiveCharacter_isPrimitive,
      (hZ rho hrho).1.2⟩, (hZ rho hrho).2⟩
  have hmultPrimitive :
      ∀ rho : ℂ,
        Z rho ≤ analyticOrderNatAt
          (DirichletCharacter.LFunction chi.primitiveCharacter) rho := by
    intro rho
    by_cases hz : Z rho = 0
    · simp [hz]
    · have hrho : rho ∈ Z.support := Finsupp.mem_support_iff.mpr hz
      have hre0 : 0 < rho.re :=
        ((isNonprincipalNontrivialLFunctionZero_iff chi rho).1
          (hZ rho hrho).1).2.2.1
      rw [← analyticOrderNatAt_LFunction_eq_inducingPrimitive_of_re_pos
        chi hchi hre0]
      exact hmult rho
  have hsre : 1 ≤ s.re := by simpa [s] using hsigma1
  have hpsiNe :
      DirichletCharacter.LFunction chi.primitiveCharacter s ≠ 0 :=
    chi.primitiveCharacter.LFunction_ne_zero_of_one_le_re
      (.inl (primitiveCharacter_ne_one_of_ne_one chi hchi)) hsre
  have hprimitiveBound := hprimitive d hd1 chi.primitiveCharacter
    chi.primitiveCharacter_isPrimitive t sigma Z hsigma1 hsigma2 hpsiNe
    hZprimitive hmultPrimitive
  have hcomparison : ‖D‖ ≤ Real.log (q : ℝ) := by
    simpa [D] using
      norm_logDeriv_LFunction_sub_inducingPrimitive_le_log chi hchi hsre
  have hDre : -Real.log (q : ℝ) ≤ D.re := by
    have habs : |D.re| ≤ ‖D‖ := Complex.abs_re_le_norm D
    have hnegabs : -|D.re| ≤ D.re := neg_abs_le D.re
    linarith
  have hidentity :
      (logDeriv (DirichletCharacter.LFunction chi) s).re =
        (logDeriv
          (DirichletCharacter.LFunction chi.primitiveCharacter) s).re +
            D.re := by
    simp only [D, Complex.sub_re]
    ring
  have hT2 : (2 : ℝ) ≤ T := by
    dsimp [T]
    linarith [abs_nonneg t]
  have hTpos : 0 < T := zero_lt_two.trans_le hT2
  have hqpos : (0 : ℝ) < q := by exact_mod_cast NeZero.pos q
  have hdpos : (0 : ℝ) < d := by
    exact_mod_cast (zero_lt_one.trans hd1)
  have hdqNat : d ≤ q := by
    dsimp [d]
    exact Nat.le_of_dvd (NeZero.pos q) chi.conductor_dvd_level
  have hdq : (d : ℝ) ≤ q := by exact_mod_cast hdqNat
  have hprod : (d : ℝ) * T ≤ (q : ℝ) * T :=
    mul_le_mul_of_nonneg_right hdq hTpos.le
  have hlogProd :
      Real.log ((d : ℝ) * T) ≤ Real.log ((q : ℝ) * T) :=
    Real.log_le_log (mul_pos hdpos hTpos) hprod
  have hTone : (1 : ℝ) ≤ T := one_le_two.trans hT2
  have hqT : (q : ℝ) ≤ (q : ℝ) * T := by
    simpa using mul_le_mul_of_nonneg_left hTone hqpos.le
  have hlogq :
      Real.log (q : ℝ) ≤ Real.log ((q : ℝ) * T) :=
    Real.log_le_log hqpos hqT
  have hscaled :
      16 * ((A : ℝ) * Real.log ((d : ℝ) * T)) / 3 +
          Real.log (q : ℝ) ≤
        (16 * (A : ℝ) + 3) * Real.log ((q : ℝ) * T) / 3 := by
    have hA0 : (0 : ℝ) ≤ A := Nat.cast_nonneg A
    have hmul := mul_le_mul_of_nonneg_left hlogProd
      (mul_nonneg (by norm_num : (0 : ℝ) ≤ 16) hA0)
    nlinarith
  have hprim :
      Z.sum (fun rho m =>
        (m : ℝ) * (((s - rho)⁻¹).re)) -
          16 * ((A : ℝ) * Real.log ((d : ℝ) * T)) / 3 ≤
        (logDeriv
          (DirichletCharacter.LFunction chi.primitiveCharacter) s).re := by
    simpa [s, d, T] using hprimitiveBound
  change Z.sum (fun rho m =>
      (m : ℝ) * (((s - rho)⁻¹).re)) -
      (16 * (A : ℝ) + 3) * Real.log ((q : ℝ) * T) / 3 ≤
    (logDeriv (DirichletCharacter.LFunction chi) s).re
  rw [hidentity]
  linarith

end

section
open Complex Set

section DirichletPrimitiveShallowZeros
theorem primitive_LFunction_zero_forces_gammaFactor_zero
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    {rho : ℂ} (hright : rho.re ≤ 0)
    (hzero : DirichletCharacter.LFunction chi rho = 0) :
    DirichletCharacter.gammaFactor chi rho = 0 := by
  by_contra hgamma
  have hrelationGuard : rho ≠ 0 ∨ q ≠ 1 := by
    by_cases hrho : rho = 0
    · right
      intro hq
      subst q
      rw [hrho, DirichletCharacter.LFunction_modOne_eq,
        riemannZeta_zero] at hzero
      norm_num at hzero
    · exact .inl hrho
  have hcompleted :
      DirichletCharacter.completedLFunction chi rho = 0 := by
    have hquot := DirichletCharacter.LFunction_eq_completed_div_gammaFactor
      chi rho hrelationGuard
    rw [hzero] at hquot
    exact (div_eq_zero_iff.mp hquot.symm).resolve_right hgamma
  have hqzero : (q : ℂ) ≠ 0 := by exact_mod_cast NeZero.ne q
  have hbase : (q : ℂ) ^ ((1 - rho) - 1 / 2) ≠ 0 :=
    Complex.cpow_ne_zero_iff.mpr (.inl hqzero)
  have hroot : DirichletCharacter.rootNumber chi ≠ 0 := by
    apply norm_ne_zero_iff.mp
    rw [norm_rootNumber_of_isPrimitive chi hchi]
    exact one_ne_zero
  have hfun := hchi.completedLFunction_one_sub (1 - rho)
  have hreflectedCompleted :
      DirichletCharacter.completedLFunction chi⁻¹ (1 - rho) = 0 := by
    rw [show 1 - (1 - rho) = rho by ring, hcompleted] at hfun
    exact (mul_eq_zero.mp hfun.symm).resolve_left (mul_ne_zero hbase hroot)
  have hrhoOne : rho ≠ 1 := by
    intro hrho
    have hre := congrArg Complex.re hrho
    norm_num at hre
    linarith
  have hreflectedL :
      DirichletCharacter.LFunction chi⁻¹ (1 - rho) = 0 := by
    rw [DirichletCharacter.LFunction_eq_completed_div_gammaFactor chi⁻¹
      (1 - rho) (.inl (sub_ne_zero.mpr (Ne.symm hrhoOne))),
      hreflectedCompleted, zero_div]
  have hreflectedGuard : chi⁻¹ ≠ 1 ∨ (1 - rho) ≠ 1 := by
    by_cases hrho : rho = 0
    · left
      apply inv_ne_one.mpr
      have hq : 1 < q := by
        have hqpos : 0 < q := Nat.pos_of_ne_zero (NeZero.ne q)
        have hqne : q ≠ 1 := hrelationGuard.resolve_left (not_ne_iff.mpr hrho)
        omega
      exact character_ne_one_of_isPrimitive hq chi hchi
    · right
      intro h
      apply hrho
      linear_combination -h
  exact (chi⁻¹).LFunction_ne_zero_of_one_le_re hreflectedGuard
    (by simp; linarith) hreflectedL

end DirichletPrimitiveShallowZeros

theorem
    one_half_le_norm_neg_half_add_mul_I_sub_of_LFunction_eq_zero_of_isPrimitive
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    (t : ℝ) {rho : ℂ}
    (hzero : DirichletCharacter.LFunction chi rho = 0) :
    (1 / 2 : ℝ) ≤
      ‖(((-1 / 2 : ℝ) : ℂ) + t * Complex.I) - rho‖ := by
  by_contra hsep
  rw [not_le] at hsep
  let s : ℂ := ((-1 / 2 : ℝ) : ℂ) + t * I
  have hreNorm : |(-1 / 2 : ℝ) - rho.re| ≤ ‖s - rho‖ := by
    have h := Complex.abs_re_le_norm (s - rho)
    simpa [s] using h
  have hreAbs : |(-1 / 2 : ℝ) - rho.re| < 1 / 2 :=
    hreNorm.trans_lt (by simpa [s] using hsep)
  rw [abs_lt] at hreAbs
  have hrhoLower : (-1 : ℝ) < rho.re := by linarith [hreAbs.1]
  have hrhoUpper : rho.re < 0 := by linarith [hreAbs.2]
  have hgamma := primitive_LFunction_zero_forces_gammaFactor_zero
    chi hchi hrhoUpper.le hzero
  rcases chi.even_or_odd with heven | hodd
  · rw [heven.gammaFactor_def, Gammaℝ_eq_zero_iff] at hgamma
    obtain ⟨n, hn⟩ := hgamma
    have hre := congrArg Complex.re hn
    norm_num at hre
    have hnnonneg : (0 : ℝ) ≤ n := Nat.cast_nonneg n
    by_cases hnzero : n = 0
    · subst n
      norm_num at hre
      linarith
    · have hnOne : (1 : ℝ) ≤ n := by
        exact_mod_cast Nat.one_le_iff_ne_zero.mpr hnzero
      linarith
  · rw [hodd.gammaFactor_def, Gammaℝ_eq_zero_iff] at hgamma
    obtain ⟨n, hn⟩ := hgamma
    have hre := congrArg Complex.re hn
    norm_num at hre
    have hnnonneg : (0 : ℝ) ≤ n := Nat.cast_nonneg n
    linarith

theorem
    primitive_LFunction_eq_zero_iff_origin_of_neg_half_lt_re_of_re_nonpos
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    {rho : ℂ} (hleft : -(1 / 2 : ℝ) < rho.re)
    (hright : rho.re ≤ 0) :
    DirichletCharacter.LFunction chi rho = 0 ↔
      rho = 0 ∧ chi ≠ 1 ∧ chi.Even := by
  constructor
  · intro hzero
    have hgamma := primitive_LFunction_zero_forces_gammaFactor_zero
      chi hchi hright hzero
    rcases chi.even_or_odd with heven | hodd
    · have hrho : rho = 0 := by
        rw [heven.gammaFactor_def, Gammaℝ_eq_zero_iff] at hgamma
        obtain ⟨n, hn⟩ := hgamma
        by_cases hnzero : n = 0
        · subst n
          simpa using hn
        · have hnOne : (1 : ℝ) ≤ n := by
            exact_mod_cast (Nat.one_le_iff_ne_zero.mpr hnzero)
          have hre := congrArg Complex.re hn
          norm_num at hre
          have hrhoLe : rho.re ≤ -2 := by
            rw [hre]
            linarith [hnOne]
          linarith
      refine ⟨hrho, ?_, heven⟩
      intro hchiOne
      have hconductorOne : chi.conductor = 1 :=
        DirichletCharacter.eq_one_iff_conductor_eq_one.mp hchiOne
      have hconductorLevel : chi.conductor = q := hchi
      have hq : q = 1 := hconductorLevel.symm.trans hconductorOne
      subst q
      rw [hrho, DirichletCharacter.LFunction_modOne_eq,
        riemannZeta_zero] at hzero
      norm_num at hzero
    · rw [hodd.gammaFactor_def, Gammaℝ_eq_zero_iff] at hgamma
      obtain ⟨n, hn⟩ := hgamma
      have hnnonneg : (0 : ℝ) ≤ n := Nat.cast_nonneg n
      have hre := congrArg Complex.re hn
      norm_num at hre
      linarith
  · rintro ⟨rfl, hchi, heven⟩
    have hq : q ≠ 1 := fun hq => hchi (chi.level_one' hq)
    change ZMod.LFunction chi 0 = 0
    rw [ZMod.LFunction_apply_zero_of_even heven.to_fun, chi.map_zero' hq,
      neg_zero, zero_div]

theorem analyticOrderNatAt_LFunction_zero_eq_one_of_isPrimitive_even
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    (heven : chi.Even) :
    analyticOrderNatAt (DirichletCharacter.LFunction chi) 0 = 1 := by
  let L : ℂ → ℂ := DirichletCharacter.LFunction chi
  let A : ℂ → ℂ := fun s =>
    (q : ℂ) ^ ((1 - s) - 1 / 2) *
      DirichletCharacter.rootNumber chi *
        DirichletCharacter.completedLFunction chi⁻¹ (1 - s)
  have hqne : q ≠ 1 := Nat.ne_of_gt hq
  have hchiNe : chi ≠ 1 := character_ne_one_of_isPrimitive hq chi hchi
  have hinvNe : chi⁻¹ ≠ 1 := inv_ne_one.mpr hchiNe
  have hqzero : (q : ℂ) ≠ 0 := by exact_mod_cast NeZero.ne q
  have hroot : DirichletCharacter.rootNumber chi ≠ 0 := by
    apply norm_ne_zero_iff.mp
    rw [norm_rootNumber_of_isPrimitive chi hchi]
    exact one_ne_zero
  have hcompletedOne :
      DirichletCharacter.completedLFunction chi⁻¹ 1 ≠ 0 := by
    intro hzero
    have hrelation :=
      DirichletCharacter.LFunction_eq_completed_div_gammaFactor
        chi⁻¹ 1 (.inr hqne)
    rw [hzero, zero_div] at hrelation
    exact (DirichletCharacter.LFunction_apply_one_ne_zero hinvNe) hrelation
  have hAZero : A 0 ≠ 0 := by
    dsimp only [A]
    simpa using
      (mul_ne_zero
        (mul_ne_zero (Complex.cpow_ne_zero_iff.mpr (.inl hqzero)) hroot)
        hcompletedOne)
  have hAContinuous : ContinuousAt A 0 := by
    have hpow : ContinuousAt
        (fun s : ℂ => (q : ℂ) ^ ((1 - s) - 1 / 2)) 0 :=
      (by
        change ContinuousAt
          ((fun z : ℂ => (q : ℂ) ^ z) ∘
            (fun s : ℂ => (1 - s) - 1 / 2)) 0
        exact (continuousAt_const_cpow hqzero).comp (by fun_prop))
    have hcompleted : ContinuousAt
        (fun s : ℂ =>
          DirichletCharacter.completedLFunction chi⁻¹ (1 - s)) 0 :=
      (by
        change ContinuousAt
          (DirichletCharacter.completedLFunction chi⁻¹ ∘
            (fun s : ℂ => 1 - s)) 0
        exact
          ((DirichletCharacter.differentiable_completedLFunction hinvNe).continuous
            |>.continuousAt).comp (by fun_prop))
    exact (hpow.mul continuousAt_const).mul hcompleted
  have hLZero : L 0 = 0 := by
    change ZMod.LFunction chi 0 = 0
    rw [ZMod.LFunction_apply_zero_of_even heven.to_fun, chi.map_zero' hqne,
      neg_zero, zero_div]
  have hratio : Tendsto (fun s => A s / (s * Gammaℝ s))
      (nhdsWithin 0 {0}ᶜ) (nhds (A 0 / 2)) :=
    (hAContinuous.tendsto.mono_left nhdsWithin_le_nhds).div
      Gammaℝ_residue_zero two_ne_zero
  have hslope : Tendsto
      (fun t : ℂ => t⁻¹ • (L (0 + t) - L 0))
      (nhdsWithin 0 {0}ᶜ) (nhds (A 0 / 2)) := by
    apply hratio.congr'
    filter_upwards [self_mem_nhdsWithin] with t ht
    have htZero : t ≠ 0 := by simpa using ht
    have hcompleted :
        DirichletCharacter.completedLFunction chi t = A t := by
      have hfun := hchi.completedLFunction_one_sub (1 - t)
      rw [show 1 - (1 - t) = t by ring] at hfun
      simpa only [A] using hfun
    rw [zero_add, hLZero, sub_zero, smul_eq_mul]
    change A t / (t * Gammaℝ t) = t⁻¹ * L t
    rw [show L t = DirichletCharacter.LFunction chi t by rfl,
      DirichletCharacter.LFunction_eq_completed_div_gammaFactor
        chi t (.inr hqne), heven.gammaFactor_def, hcompleted]
    simp only [div_eq_mul_inv, mul_inv_rev]
    ring
  have hderiv : HasDerivAt L (A 0 / 2) 0 :=
    hasDerivAt_iff_tendsto_slope_zero.mpr hslope
  have hLAnalytic : AnalyticAt ℂ L 0 :=
    (DirichletCharacter.differentiable_LFunction hchiNe).analyticAt 0
  have horder : analyticOrderAt L 0 = 1 :=
    hLAnalytic.analyticOrderAt_eq_one_of_zero_deriv_ne_zero hLZero (by
      rw [hderiv.deriv]
      exact div_ne_zero hAZero two_ne_zero)
  change (analyticOrderAt L 0).toNat = 1
  rw [horder]
  rfl

end

section
open Complex Set

/--
Classical proposition decidability for the primitive shallow-contour candidate constructions.
-/
noncomputable local instance primitiveShallowCandidateDecidable
    (p : Prop) : Decidable p :=
  Classical.propDecidable p

end

section
open Complex Set

attribute [local instance] PrimeGap186.primitiveShallowCandidateDecidable
/--
Candidate singularities in the shallow rectangle with opposite corners `-1 / 2 - |T| * I` and `1
+ 1 / log x + |T| * I`. For primitive characters and `x > 1`, these are the nontrivial zeros in
range, the possible principal pole, and the possible even-character zero at the origin.
-/
noncomputable def dirichletExplicitFormulaShallowCandidateSingularitiesFinset
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    (x T : ℝ) : Finset ℂ :=
  dirichletExplicitFormulaCandidateSingularitiesFinset chi
    ((-(1 / 2 : ℝ) : ℂ) - |T| * Complex.I)
    (((1 + 1 / Real.log x : ℝ) : ℂ) + |T| * Complex.I)

end

section
open Complex Set

attribute [local instance] PrimeGap186.primitiveShallowCandidateDecidable
attribute [local instance] inducingEulerProductConductorNeZero
theorem
    mem_dirichletExplicitFormulaShallowCandidateSingularitiesFinset_iff_of_isPrimitive
    {q : ℕ} [NeZero q] {chi : DirichletCharacter ℂ q}
    (hchi : chi.IsPrimitive) {x T : ℝ} (hx : 1 < x) {rho : ℂ} :
    rho ∈ dirichletExplicitFormulaShallowCandidateSingularitiesFinset
        chi x T ↔
      (chi = 1 ∧ rho = 1) ∨
        ((DirichletCharacter.LFunction (chi) (rho) = 0 ∧
            0 < (rho).re ∧ (rho).re < 1) ∧
          |rho.im| ≤ |T|) ∨
        (rho = 0 ∧ chi ≠ 1 ∧ chi.Even) := by
  classical
  rw [dirichletExplicitFormulaShallowCandidateSingularitiesFinset,
    mem_dirichletExplicitFormulaCandidateSingularitiesFinset_iff,
    mem_dirichletExplicitFormulaCandidateSingularities_iff]
  have hlog : 0 < Real.log x := Real.log_pos hx
  have hright : 1 < 1 + 1 / Real.log x := by
    linarith [one_div_pos.mpr hlog]
  have hright' : 1 < 1 + (Real.log x)⁻¹ := by
    simpa [one_div] using hright
  have hedges : -(1 / 2 : ℝ) < 1 + 1 / Real.log x := by
    linarith
  have hedges' : -(1 / 2 : ℝ) ≤ 1 + (Real.log x)⁻¹ := by
    simpa [one_div] using hedges.le
  constructor
  · rintro ⟨hrect, hpole | hzero⟩
    · exact .inl hpole
    rw [Complex.Rectangle, Complex.mem_reProdIm] at hrect
    norm_num at hrect
    rw [uIcc_of_le hedges'] at hrect
    have hheight : |rho.im| ≤ |T| := abs_le.mpr hrect.2
    by_cases hre : 0 < rho.re
    · have hreOne : rho.re < 1 := by
        by_contra hnot
        have hone : 1 ≤ rho.re := le_of_not_gt hnot
        have hguard : chi ≠ 1 ∨ rho ≠ 1 := hzero.1.symm
        exact (chi.LFunction_ne_zero_of_one_le_re hguard hone) hzero.2
      exact .inr (.inl ⟨⟨hzero.2, hre, hreOne⟩, hheight⟩)
    · have hreNonpos : rho.re ≤ 0 := le_of_not_gt hre
      have hleft : -(1 / 2 : ℝ) < rho.re := by
        rcases hrect.1.1.lt_or_eq with hlt | heq
        · exact hlt
        · exfalso
          have hboundary :=
            (LFunction_ne_zero_on_dirichletExplicitFormulaVerticalEdges
              chi x hx 0 rho.im).1
          apply hboundary
          have hrhoEq :
              (((-((0 : ℕ) : ℝ) - 1 / 2 : ℝ) : ℂ) +
                rho.im * I) = rho := by
            apply Complex.ext
            · simpa using heq
            · simp
          rw [hrhoEq]
          exact hzero.2
      exact .inr (.inr
        ((primitive_LFunction_eq_zero_iff_origin_of_neg_half_lt_re_of_re_nonpos
          chi hchi hleft hreNonpos).mp hzero.2))
  · intro hrhs
    rw [Complex.Rectangle, Complex.mem_reProdIm]
    norm_num
    rw [uIcc_of_le hedges']
    rcases hrhs with hpole | hnontriv | horigin
    · rcases hpole with ⟨rfl, rfl⟩
      exact ⟨⟨⟨by norm_num, hright'.le⟩, by simp⟩, .inl ⟨rfl, rfl⟩⟩
    · rcases hnontriv with ⟨⟨hzero, hre0, hre1⟩, hheight⟩
      have hrhoOne : rho ≠ 1 := by
        intro hrho
        have hre := congrArg Complex.re hrho
        norm_num at hre
        linarith
      exact ⟨⟨⟨by linarith, by linarith⟩, abs_le.mp hheight⟩,
        .inr ⟨.inl hrhoOne, hzero⟩⟩
    · rcases horigin with ⟨rfl, hchiNe, heven⟩
      have hzero :=
        (primitive_LFunction_eq_zero_iff_origin_of_neg_half_lt_re_of_re_nonpos
          chi hchi (by norm_num) (by norm_num)).mpr
            ⟨rfl, hchiNe, heven⟩
      exact ⟨⟨⟨by norm_num, by
        simpa using (show (0 : ℝ) ≤ 1 by norm_num).trans hright'.le⟩, by simp⟩,
        .inr ⟨.inr hchiNe, hzero⟩⟩

end

section
open Complex Set

attribute [local instance] PrimeGap186.primitiveShallowCandidateDecidable
theorem
    dirichletExplicitFormulaShallowCandidateSingularitiesFinset_eq_of_isPrimitive
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    (hchi : chi.IsPrimitive) (x T : ℝ) (hx : 1 < x) :
    dirichletExplicitFormulaShallowCandidateSingularitiesFinset chi x T =
      ((if chi = 1 then {1} else ∅) ∪
        dirichletNontrivialLFunctionZerosFinset chi T) ∪
      (if chi ≠ 1 ∧ chi.Even then {0} else ∅) := by
  classical
  ext rho
  rw [mem_dirichletExplicitFormulaShallowCandidateSingularitiesFinset_iff_of_isPrimitive
    hchi hx]
  simp only [Finset.mem_union,
    mem_dirichletNontrivialLFunctionZerosFinset_iff]
  by_cases hchiOne : chi = 1
  · subst chi
    simp
  · by_cases heven : chi.Even
    · simp [hchiOne, heven, and_comm]
    · simp [hchiOne, heven]

end

section
open Complex Set

attribute [local instance] PrimeGap186.primitiveShallowCandidateDecidable

section DirichletExplicitFormulaPrimitiveShallowCandidates
theorem sum_nontrivial_candidateContribution_eq_neg_kernelSum
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q) (x T : ℝ) :
    (∑ rho ∈ dirichletNontrivialLFunctionZerosFinset chi T,
      dirichletExplicitFormulaCandidateContribution chi x rho) =
        -dirichletNontrivialZeroKernelSum chi x T := by
  classical
  rw [dirichletNontrivialZeroKernelSum, ← Finset.sum_neg_distrib]
  apply Finset.sum_congr rfl
  intro rho hrho
  have hzero :=
    (mem_dirichletNontrivialLFunctionZerosFinset_iff.mp hrho).1
  have hrhoOne : rho ≠ 1 := by
    intro hrho
    have hre := congrArg Complex.re hrho
    norm_num at hre
    linarith [hzero.2.2]
  simp [dirichletExplicitFormulaCandidateContribution, hrhoOne,
    dirichletExplicitFormulaZeroResidue]

end DirichletExplicitFormulaPrimitiveShallowCandidates
end

section
open Complex Set

attribute [local instance] PrimeGap186.primitiveShallowCandidateDecidable
theorem
    sum_dirichletExplicitFormulaShallowCandidateContribution_eq_of_isPrimitive
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    (hchi : chi.IsPrimitive) (x T : ℝ) (hx : 1 < x) :
    (∑ rho ∈
        dirichletExplicitFormulaShallowCandidateSingularitiesFinset chi x T,
      dirichletExplicitFormulaCandidateContribution chi x rho) =
      (if chi = 1 then (x : ℂ) - 1 else 0) -
        dirichletNontrivialZeroKernelSum chi x T -
          (if chi ≠ 1 ∧ chi.Even then (Real.log x : ℂ) else 0) := by
  classical
  rw [dirichletExplicitFormulaShallowCandidateSingularitiesFinset_eq_of_isPrimitive
    chi hchi x T hx]
  by_cases hchiOne : chi = 1
  · subst chi
    have horigin : ¬((1 : DirichletCharacter ℂ q) ≠ 1 ∧
        (1 : DirichletCharacter ℂ q).Even) := fun h => h.1 rfl
    have hdisjoint : Disjoint ({1} : Finset ℂ)
        (dirichletNontrivialLFunctionZerosFinset
          (1 : DirichletCharacter ℂ q) T) := by
      rw [Finset.disjoint_left]
      intro rho hrhoOne hrho
      simp only [Finset.mem_singleton] at hrhoOne
      subst rho
      have hzero :=
        (mem_dirichletNontrivialLFunctionZerosFinset_iff.mp hrho).1
      norm_num at hzero
    simp only [ite_true, ite_eq_right horigin, Finset.union_empty]
    rw [Finset.sum_union hdisjoint,
      sum_nontrivial_candidateContribution_eq_neg_kernelSum]
    rw [Finset.sum_singleton,
      dirichletExplicitFormulaCandidateContribution,
      ite_eq_left ⟨rfl, rfl⟩,
      dirichletExplicitFormulaPrincipalPoleResidue_eq_sub_one
        (x := x) (zero_lt_one.trans hx)]
    ring
  · by_cases heven : chi.Even
    · have hq : 1 < q := by
        have hqpos : 0 < q := Nat.pos_of_ne_zero (NeZero.ne q)
        have hqne : q ≠ 1 := fun hq => hchiOne (chi.level_one' hq)
        omega
      have hdisjoint : Disjoint
          (dirichletNontrivialLFunctionZerosFinset chi T)
          ({0} : Finset ℂ) := by
        rw [Finset.disjoint_left]
        intro rho hrho hrhoZero
        simp only [Finset.mem_singleton] at hrhoZero
        subst rho
        have hzero :=
          (mem_dirichletNontrivialLFunctionZerosFinset_iff.mp hrho).1
        norm_num at hzero
      have horigin : chi ≠ 1 ∧ chi.Even := ⟨hchiOne, heven⟩
      simp only [ite_eq_right hchiOne, ite_eq_left horigin, Finset.empty_union]
      rw [Finset.sum_union hdisjoint,
        sum_nontrivial_candidateContribution_eq_neg_kernelSum]
      rw [Finset.sum_singleton,
        dirichletExplicitFormulaCandidateContribution,
        ite_eq_right (by simp [hchiOne]),
        dirichletExplicitFormulaZeroResidue_zero,
        analyticOrderNatAt_LFunction_zero_eq_one_of_isPrimitive_even
          hq chi hchi heven]
      norm_num
      ring
    · have horigin : ¬(chi ≠ 1 ∧ chi.Even) := fun h => heven h.2
      simp only [ite_eq_right hchiOne, ite_eq_right horigin, Finset.empty_union,
        Finset.union_empty]
      simpa using
        (sum_nontrivial_candidateContribution_eq_neg_kernelSum chi x T)

end

section
open Complex Set

theorem
    differentiableAt_dirichletExplicitFormulaIntegrand_of_mem_rectangle_of_not_candidate
    {N : ℕ} [NeZero N] (chi : DirichletCharacter ℂ N)
    (x : ℝ) {z w s : ℂ} (hsRect : s ∈ Complex.Rectangle z w)
    (hsNot :
      s ∉ ({pntCandidate | pntCandidate ∈ Complex.Rectangle (z) (w) ∧
             (((chi) = 1 ∧ pntCandidate = 1) ∨
               ((pntCandidate ≠ 1 ∨ (chi) ≠ 1) ∧
                 DirichletCharacter.LFunction (chi) pntCandidate = 0))})) :
    DifferentiableAt ℂ (dirichletExplicitFormulaIntegrand chi x) s := by
  by_cases hchi : chi = 1
  · subst chi
    have hsOne : s ≠ 1 := by
      intro hs
      apply hsNot
      exact
        mem_dirichletExplicitFormulaCandidateSingularities_iff.mpr
          ⟨hsRect, Or.inl ⟨rfl, hs⟩⟩
    have hsL : DirichletCharacter.LFunction
        (1 : DirichletCharacter ℂ N) s ≠ 0 := by
      intro hsZero
      apply hsNot
      exact
        mem_dirichletExplicitFormulaCandidateSingularities_iff.mpr
          ⟨hsRect, Or.inr ⟨Or.inl hsOne, hsZero⟩⟩
    exact
      differentiableAt_dirichletExplicitFormulaIntegrand_one_of_ne_one_of_ne_zero
        x hsOne hsL
  · have hsL : DirichletCharacter.LFunction chi s ≠ 0 := by
      intro hsZero
      apply hsNot
      exact
        mem_dirichletExplicitFormulaCandidateSingularities_iff.mpr
          ⟨hsRect, Or.inr ⟨Or.inr hchi, hsZero⟩⟩
    exact
      differentiableAt_dirichletExplicitFormulaIntegrand_of_ne_zero
        hchi x hsL

end

section
open Asymptotics Complex Filter Function Set

section DirichletExplicitFormulaRemovableRemainder
/--
The finite sum of simple principal parts `c rho / (s - rho)` at the points of `P`. The
coefficient function supplies the residue assigned to each point.
-/
noncomputable def principalPartSum
    (P : Finset ℂ) (c : ℂ → ℂ) (s : ℂ) : ℂ :=
  ∑ rho ∈ P, c rho / (s - rho)

/--
Replaces the value of `g` at each point of `P` by its punctured-neighborhood limit and leaves
all other values unchanged. This fills the removable singularities whenever the indicated limits
exist.
-/
noncomputable def fillFiniteRemovable
    (P : Finset ℂ) (g : ℂ → ℂ) (s : ℂ) : ℂ :=
  if s ∈ P then limUnder (𝓝[≠] s) g else g s

theorem isLittleO_sub_self_inv_of_tendsto_mul
    {g : ℂ → ℂ} {rho : ℂ}
    (h : Tendsto (fun s => (s - rho) * g s) (𝓝[≠] rho) (𝓝 0)) :
    (fun s => g s - g rho) =o[𝓝[≠] rho] fun s => (s - rho)⁻¹ := by
  apply Asymptotics.isLittleO_of_tendsto
  · intro s hs
    have hs : s = rho := sub_eq_zero.mp (inv_eq_zero.mp hs)
    simp [hs]
  · have hfull : Tendsto (fun s : ℂ => s - rho) (𝓝 rho) (𝓝 (rho - rho)) :=
      (continuousAt_id.sub continuousAt_const).tendsto
    have hz : Tendsto (fun s : ℂ => s - rho) (𝓝[≠] rho) (𝓝 0) := by
      simpa using hfull.mono_left nhdsWithin_le_nhds
    convert h.sub (hz.mul_const (g rho)) using 1
    · ext s
      simp only [div_eq_mul_inv, inv_inv]
      ring
    · simp

theorem differentiableOn_update_limUnder_of_tendsto_mul
    {g : ℂ → ℂ} {U : Set ℂ} {rho : ℂ} (hrho : U ∈ 𝓝 rho)
    (hd : DifferentiableOn ℂ g (U \ {rho}))
    (h : Tendsto (fun s => (s - rho) * g s) (𝓝[≠] rho) (𝓝 0)) :
    DifferentiableOn ℂ
      (update g rho (limUnder (𝓝[≠] rho) g)) U :=
  Complex.differentiableOn_update_limUnder_of_isLittleO hrho hd
    (isLittleO_sub_self_inv_of_tendsto_mul h)

theorem differentiableOn_fillFiniteRemovable_of_tendsto_mul
    (P : Finset ℂ) (g : ℂ → ℂ) (U : Set ℂ)
    (hP : ∀ rho ∈ P, rho ∈ interior U)
    (hd : ∀ s ∈ U, s ∉ P → DifferentiableAt ℂ g s)
    (hrem : ∀ rho ∈ P,
      Tendsto (fun s => (s - rho) * g s) (𝓝[≠] rho) (𝓝 0)) :
    DifferentiableOn ℂ (fillFiniteRemovable P g) U := by
  classical
  intro rho hrhoU
  by_cases hrhoP : rho ∈ P
  · let V : Set ℂ :=
      interior U ∩ ((P.erase rho : Finset ℂ) : Set ℂ)ᶜ
    have hEraseNhd : ((P.erase rho : Finset ℂ) : Set ℂ)ᶜ ∈ 𝓝 rho :=
      (P.erase rho).finite_toSet.isClosed.compl_mem_nhds (by simp)
    have hV : V ∈ 𝓝 rho :=
      inter_mem (isOpen_interior.mem_nhds (hP rho hrhoP)) hEraseNhd
    have hdV : DifferentiableOn ℂ g (V \ {rho}) := by
      intro s hs
      apply (hd s (interior_subset hs.1.1) ?_).differentiableWithinAt
      intro hsP
      have hsrho : s ≠ rho := by simpa using hs.2
      exact hs.1.2 (by simpa [Finset.mem_erase, hsrho] using hsP)
    have hUpdate : DifferentiableAt ℂ
        (update g rho (limUnder (𝓝[≠] rho) g)) rho :=
      (differentiableOn_update_limUnder_of_tendsto_mul
        hV hdV (hrem rho hrhoP)).differentiableAt hV
    have heq : fillFiniteRemovable P g =ᶠ[𝓝 rho]
        update g rho (limUnder (𝓝[≠] rho) g) := by
      filter_upwards [hEraseNhd] with s hs
      by_cases hsrho : s = rho
      · subst s
        simp [fillFiniteRemovable, hrhoP]
      · have hsNotP : s ∉ P := by
          intro hsP
          exact hs (by simpa [Finset.mem_erase, hsrho] using hsP)
        simp [fillFiniteRemovable, hsNotP, Function.update_of_ne hsrho]
    exact (hUpdate.congr_of_eventuallyEq heq).differentiableWithinAt
  · have hPcompl : ((P : Finset ℂ) : Set ℂ)ᶜ ∈ 𝓝 rho :=
      P.finite_toSet.isClosed.compl_mem_nhds (by simpa)
    have heq : fillFiniteRemovable P g =ᶠ[𝓝 rho] g := by
      filter_upwards [hPcompl] with s hs
      simp [fillFiniteRemovable, show s ∉ P by simpa using hs]
    exact ((hd rho hrhoU hrhoP).congr_of_eventuallyEq heq).differentiableWithinAt

theorem tendsto_mul_principalPartSum
    (P : Finset ℂ) (c : ℂ → ℂ) {rho : ℂ} (hrho : rho ∈ P) :
    Tendsto (fun s => (s - rho) * principalPartSum P c s)
      (𝓝[≠] rho) (𝓝 (c rho)) := by
  classical
  have hzero : Tendsto (fun s : ℂ => s - rho) (𝓝[≠] rho) (𝓝 0) := by
    have hfull : Tendsto (fun s : ℂ => s - rho) (𝓝 rho) (𝓝 (rho - rho)) :=
      (continuousAt_id.sub
        (continuousAt_const : ContinuousAt (fun _ : ℂ => rho) rho)).tendsto
    simpa using hfull.mono_left nhdsWithin_le_nhds
  have hother : Tendsto
      (fun s => ∑ q ∈ P.erase rho, c q / (s - q)) (𝓝[≠] rho)
      (𝓝 (∑ q ∈ P.erase rho, c q / (rho - q))) := by
    apply tendsto_finsetSum
    intro q hq
    have hrhoq : rho - q ≠ 0 :=
      sub_ne_zero.mpr (Finset.mem_erase.mp hq).1.symm
    exact ((continuousAt_const.div
      (continuousAt_id.sub continuousAt_const) hrhoq).tendsto).mono_left
        nhdsWithin_le_nhds
  have hrhoTerm : Tendsto
      (fun s : ℂ => (s - rho) * (c rho / (s - rho)))
      (𝓝[≠] rho) (𝓝 (c rho)) := by
    apply tendsto_const_nhds.congr'
    filter_upwards [self_mem_nhdsWithin] with s hs
    have hsrho : s - rho ≠ 0 := sub_ne_zero.mpr (by simpa using hs)
    rw [← mul_div_assoc, mul_div_cancel_left₀ _ hsrho]
  have htotal : Tendsto
      (fun s => (s - rho) * (c rho / (s - rho)) +
        (s - rho) * ∑ q ∈ P.erase rho, c q / (s - q))
      (𝓝[≠] rho) (𝓝 (c rho)) := by
    simpa only [add_zero, zero_mul] using hrhoTerm.add (hzero.mul hother)
  apply htotal.congr'
  filter_upwards [self_mem_nhdsWithin] with s hs
  rw [principalPartSum,
    ← Finset.add_sum_erase P (fun q => c q / (s - q)) hrho, mul_add]

theorem differentiableOn_filledRemainder
    (P : Finset ℂ) (c : ℂ → ℂ) (f : ℂ → ℂ) (U : Set ℂ)
    (hP : ∀ rho ∈ P, rho ∈ interior U)
    (hd : ∀ s ∈ U, s ∉ P → DifferentiableAt ℂ f s)
    (hres : ∀ rho ∈ P,
      Tendsto (fun s => (s - rho) * f s) (𝓝[≠] rho) (𝓝 (c rho))) :
    DifferentiableOn ℂ
      (fillFiniteRemovable P
        (fun s => f s - principalPartSum P c s)) U := by
  classical
  apply differentiableOn_fillFiniteRemovable_of_tendsto_mul P
      (fun s => f s - principalPartSum P c s) U hP
  · intro s hsU hsP
    apply (hd s hsU hsP).sub
    apply DifferentiableAt.fun_sum
    intro rho hrho
    exact (differentiableAt_const (c rho)).div
      (differentiableAt_id.sub_const rho)
      (sub_ne_zero.mpr fun h => hsP (h ▸ hrho))
  · intro rho hrho
    have hf := hres rho hrho
    have hs := tendsto_mul_principalPartSum P c hrho
    simpa only [mul_sub, sub_self] using hf.sub hs

theorem
    tendsto_sub_mul_dirichletExplicitFormulaIntegrand_eq_candidateContribution
    {N : ℕ} [NeZero N] (chi : DirichletCharacter ℂ N)
    (x : ℝ) (rho : ℂ) :
    Tendsto
      (fun s => (s - rho) * dirichletExplicitFormulaIntegrand chi x s)
      (𝓝[≠] rho)
      (𝓝 (dirichletExplicitFormulaCandidateContribution chi x rho)) := by
  by_cases hchi : chi = 1
  · subst chi
    by_cases hrho : rho = 1
    · subst rho
      simpa [dirichletExplicitFormulaCandidateContribution] using
        (tendsto_sub_one_mul_dirichletExplicitFormulaIntegrand_one
          (N := N) x)
    · simpa [dirichletExplicitFormulaCandidateContribution, hrho] using
        (tendsto_sub_mul_dirichletExplicitFormulaIntegrand_one_of_ne_one
          (N := N) x rho hrho)
  · simpa [dirichletExplicitFormulaCandidateContribution, hchi] using
      (tendsto_sub_mul_dirichletExplicitFormulaIntegrand hchi x rho)

end DirichletExplicitFormulaRemovableRemainder

theorem
    exists_differentiableOn_dirichletExplicitFormulaIntegrand_sub_candidatePrincipalParts
    {N : ℕ} [NeZero N] (chi : DirichletCharacter ℂ N)
    (x : ℝ) (z w : ℂ)
    (hinside :
      ({pntCandidate | pntCandidate ∈ Complex.Rectangle (z) (w) ∧
         (((chi) = 1 ∧ pntCandidate = 1) ∨
           ((pntCandidate ≠ 1 ∨ (chi) ≠ 1) ∧
             DirichletCharacter.LFunction (chi) pntCandidate = 0))}) ⊆
        interior (Complex.Rectangle z w)) :
    ∃ F : ℂ → ℂ,
      DifferentiableOn ℂ F (Complex.Rectangle z w) ∧
      Set.EqOn F
        (fun s =>
          dirichletExplicitFormulaIntegrand chi x s -
            ∑ rho ∈
              dirichletExplicitFormulaCandidateSingularitiesFinset chi z w,
              dirichletExplicitFormulaCandidateContribution chi x rho /
                (s - rho))
        ((dirichletExplicitFormulaCandidateSingularitiesFinset chi z w :
          Set ℂ)ᶜ) := by
  classical
  let P := dirichletExplicitFormulaCandidateSingularitiesFinset chi z w
  let g : ℂ → ℂ := fun s =>
    dirichletExplicitFormulaIntegrand chi x s -
      principalPartSum P
        (dirichletExplicitFormulaCandidateContribution chi x) s
  refine ⟨fillFiniteRemovable P g, ?_, ?_⟩
  · change DifferentiableOn ℂ
      (fillFiniteRemovable P (fun s =>
        dirichletExplicitFormulaIntegrand chi x s -
          principalPartSum P
            (dirichletExplicitFormulaCandidateContribution chi x) s))
      (Complex.Rectangle z w)
    apply differentiableOn_filledRemainder
    · intro rho hrho
      apply hinside
      exact
        mem_dirichletExplicitFormulaCandidateSingularitiesFinset_iff.mp hrho
    · intro s hsRect hsP
      apply
        differentiableAt_dirichletExplicitFormulaIntegrand_of_mem_rectangle_of_not_candidate
          chi x hsRect
      intro hsCandidate
      exact hsP
        (mem_dirichletExplicitFormulaCandidateSingularitiesFinset_iff.mpr
          hsCandidate)
    · intro rho _hrho
      exact
        tendsto_sub_mul_dirichletExplicitFormulaIntegrand_eq_candidateContribution
          chi x rho
  · intro s hs
    have hsP : s ∉ P := by
      change s ∉
        dirichletExplicitFormulaCandidateSingularitiesFinset chi z w
      exact hs
    simp [fillFiniteRemovable, g, principalPartSum, P, hsP]

end

section
open Complex intervalIntegral

theorem wedgeIntegral_comp_sub
    {E : Type*} [NormedAddCommGroup E] [NormedSpace ℂ E]
    (f : ℂ → E) (z w p : ℂ) :
    Complex.wedgeIntegral z w (fun s => f (s - p)) =
      Complex.wedgeIntegral (z - p) (w - p) f := by
  simp_rw [Complex.wedgeIntegral, sub_re, sub_im,
    ← intervalIntegral.integral_comp_sub_right]
  apply congrArg₂ (· + ·)
  · apply intervalIntegral.integral_congr
    intro t _
    apply congrArg f
    apply Complex.ext <;> simp
  · apply congrArg (Complex.I • ·)
    apply intervalIntegral.integral_congr
    intro t _
    apply congrArg f
    apply Complex.ext <;> simp

section RectangleReciprocalWedgeIntegral
theorem sq_add_sq_ne_zero_right (x : ℝ) {y : ℝ} (hy : y ≠ 0) :
    x ^ 2 + y ^ 2 ≠ 0 := by
  positivity

theorem inv_add_mul_I (x y : ℝ) :
    ((x : ℂ) + (y : ℂ) * I)⁻¹ =
      ((x : ℂ) - I * (y : ℂ)) / (x ^ 2 + y ^ 2 : ℝ) := by
  rw [Complex.inv_def, div_eq_mul_inv]
  congr 1
  · simp [map_add, map_mul]
    ring
  · simp [Complex.normSq]
    ring

theorem integral_self_div_sq_add_sq {a b y : ℝ} (hy : y ≠ 0) :
    ∫ x in a..b, x / (x ^ 2 + y ^ 2) =
      Real.log (b ^ 2 + y ^ 2) / 2 -
        Real.log (a ^ 2 + y ^ 2) / 2 := by
  let F : ℝ → ℝ := fun x => Real.log (x ^ 2 + y ^ 2) / 2
  have hF : ∀ x : ℝ, HasDerivAt F (x / (x ^ 2 + y ^ 2)) x := by
    intro x
    have hbase :
        HasDerivAt (fun t : ℝ => t ^ 2 + y ^ 2) (2 * x) x := by
      simpa using (hasDerivAt_pow 2 x).add_const (y ^ 2)
    convert! (hbase.log (sq_add_sq_ne_zero_right x hy)).div_const 2 using 1
    field_simp
  have hderiv : deriv F = fun x => x / (x ^ 2 + y ^ 2) :=
    funext fun x => (hF x).deriv
  rw [← hderiv, intervalIntegral.integral_deriv_eq_sub
    (fun x _ => (hF x).differentiableAt)]
  rw [hderiv]
  exact
    (continuous_id.div (continuous_id.pow 2 |>.add continuous_const)
      (fun x => sq_add_sq_ne_zero_right x hy)).intervalIntegrable _ _

theorem integral_const_div_sq_add_sq {a b y : ℝ} (hy : y ≠ 0) :
    ∫ x in a..b, y / (x ^ 2 + y ^ 2) =
      Real.arctan (b / y) - Real.arctan (a / y) := by
  simpa only [mul_inv_cancel_left₀ hy, ← intervalIntegral.integral_const_mul,
    ← div_eq_mul_inv, add_comm] using
    congrArg (y * ·) (integral_inv_sq_add_sq (a := a) (b := b) hy)

theorem integral_div_add_mul_I {a b y : ℝ} (hy : y ≠ 0) (c : ℂ) :
    ∫ x : ℝ in a..b, c / (x + y * I) =
      c * (Real.log (b ^ 2 + y ^ 2) / 2 -
        Real.log (a ^ 2 + y ^ 2) / 2) -
      c * I * (Real.arctan (b / y) - Real.arctan (a / y)) := by
  have hpoint (x : ℝ) :
      c / (x + y * I) =
        c * (x / (x ^ 2 + y ^ 2) : ℝ) -
          c * I * (y / (x ^ 2 + y ^ 2) : ℝ) := by
    rw [div_eq_mul_inv, inv_add_mul_I]
    push_cast
    ring
  have hdenom : Continuous fun x : ℝ => x ^ 2 + y ^ 2 :=
    continuous_id.pow 2 |>.add continuous_const
  have hxReal : Continuous fun x : ℝ => x / (x ^ 2 + y ^ 2) :=
    continuous_id.div hdenom (fun x => sq_add_sq_ne_zero_right x hy)
  have hyReal : Continuous fun x : ℝ => y / (x ^ 2 + y ^ 2) :=
    continuous_const.div hdenom (fun x => sq_add_sq_ne_zero_right x hy)
  have hx : IntervalIntegrable
      (fun x : ℝ => c * (x / (x ^ 2 + y ^ 2) : ℝ)) volume a b :=
    (continuous_const.mul (continuous_ofReal.comp hxReal)).intervalIntegrable _ _
  have hyi : IntervalIntegrable
      (fun x : ℝ => c * I * (y / (x ^ 2 + y ^ 2) : ℝ)) volume a b :=
    ((continuous_const.mul continuous_const).mul
      (continuous_ofReal.comp hyReal)).intervalIntegrable _ _
  rw [intervalIntegral.integral_congr (fun x _ => hpoint x),
    intervalIntegral.integral_sub hx hyi]
  simp_rw [intervalIntegral.integral_const_mul,
    intervalIntegral.integral_ofReal, integral_self_div_sq_add_sq hy,
    integral_const_div_sq_add_sq hy]
  push_cast
  rfl

theorem I_mul_div_add_mul_I (x y : ℝ) (c : ℂ) :
    I * (c / (x + y * I)) = c / (y + (-x) * I) := by
  have hrotate : (y : ℂ) + -(x : ℂ) * I =
      -I * ((x : ℂ) + (y : ℂ) * I) := by
    apply Complex.ext <;> simp
  change I * (c / ((x : ℂ) + (y : ℂ) * I)) =
    c / ((y : ℂ) + -(x : ℂ) * I)
  rw [hrotate]
  simp [div_eq_mul_inv]
  ring

theorem I_mul_integral_div_add_mul_I
    {a b x : ℝ} (hx : x ≠ 0) (c : ℂ) :
    I * (∫ y : ℝ in a..b, c / (x + y * I)) =
      c * (Real.log (b ^ 2 + (-x) ^ 2) / 2 -
        Real.log (a ^ 2 + (-x) ^ 2) / 2) -
      c * I * (Real.arctan (b / (-x)) - Real.arctan (a / (-x))) := by
  rw [← intervalIntegral.integral_const_mul]
  calc
    (∫ y : ℝ in a..b, I * (c / (x + y * I))) =
        ∫ y : ℝ in a..b, c / (y + (-x) * I) :=
      intervalIntegral.integral_congr fun y _ => I_mul_div_add_mul_I x y c
    _ = _ := by
      simpa using
        (integral_div_add_mul_I (a := a) (b := b)
          (neg_ne_zero.mpr hx) c)

theorem arctan_div_neg_eq_add_of_div_neg {x y : ℝ}
    (hx : x ≠ 0) (hy : y ≠ 0) (hxy : x / y < 0) :
    Real.arctan (y / -x) = Real.pi / 2 + Real.arctan (x / y) := by
  have hratio : y / x = (x / y)⁻¹ := by field_simp [hx, hy]
  rw [div_neg, Real.arctan_neg, hratio, Real.arctan_inv_of_neg hxy]
  ring

theorem arctan_div_neg_eq_sub_of_div_pos {x y : ℝ}
    (hx : x ≠ 0) (hy : y ≠ 0) (hxy : 0 < x / y) :
    Real.arctan (y / -x) = -Real.pi / 2 + Real.arctan (x / y) := by
  have hratio : y / x = (x / y)⁻¹ := by field_simp [hx, hy]
  rw [div_neg, Real.arctan_neg, hratio, Real.arctan_inv_of_pos hxy]
  ring

theorem wedgeIntegral_add_wedgeIntegral_div_of_straddles_zero
    (z w c : ℂ)
    (hzRe : z.re < 0) (hwRe : 0 < w.re)
    (hzIm : z.im < 0) (hwIm : 0 < w.im) :
    Complex.wedgeIntegral z w (fun s => c / s) +
        Complex.wedgeIntegral w z (fun s => c / s) =
      2 * Real.pi * I * c := by
  rw [Complex.wedgeIntegral_add_wedgeIntegral_eq]
  simp only [smul_eq_mul]
  rw [integral_div_add_mul_I hzIm.ne c,
    integral_div_add_mul_I hwIm.ne' c,
    I_mul_integral_div_add_mul_I hwRe.ne' c,
    I_mul_integral_div_add_mul_I hzRe.ne c]
  have h₁ := arctan_div_neg_eq_add_of_div_neg
    hwRe.ne' hzIm.ne (div_neg_of_pos_of_neg hwRe hzIm)
  have h₂ := arctan_div_neg_eq_sub_of_div_pos
    hwRe.ne' hwIm.ne' (div_pos hwRe hwIm)
  have h₃ := arctan_div_neg_eq_sub_of_div_pos
    hzRe.ne hzIm.ne (div_pos_of_neg_of_neg hzRe hzIm)
  have h₄ := arctan_div_neg_eq_add_of_div_neg
    hzRe.ne hwIm.ne' (div_neg_of_neg_of_pos hzRe hwIm)
  rw [h₁, h₂, h₃, h₄]
  push_cast
  ring_nf

end RectangleReciprocalWedgeIntegral

theorem wedgeIntegral_add_wedgeIntegral_div_sub_eq_two_pi_I_mul
    (z w p c : ℂ)
    (hzRe : z.re < p.re) (hpRe : p.re < w.re)
    (hzIm : z.im < p.im) (hpIm : p.im < w.im) :
    Complex.wedgeIntegral z w (fun s => c / (s - p)) +
        Complex.wedgeIntegral w z (fun s => c / (s - p)) =
      2 * Real.pi * I * c := by
  rw [wedgeIntegral_comp_sub (fun s => c / s) z w p,
    wedgeIntegral_comp_sub (fun s => c / s) w z p]
  apply wedgeIntegral_add_wedgeIntegral_div_of_straddles_zero
  · simpa using sub_neg.mpr hzRe
  · simpa using sub_pos.mpr hpRe
  · simpa using sub_neg.mpr hzIm
  · simpa using sub_pos.mpr hpIm

end

section
open Complex

section RectangleFinitePrincipalPartSum
theorem continuous_horizontal_principal_part
    (c p : ℂ) (y : ℝ) (hy : y ≠ p.im) :
    Continuous (fun x : ℝ => c / ((x : ℂ) + y * I - p)) := by
  refine continuous_const.div (by fun_prop) fun x h => hy ?_
  simpa using congrArg Complex.im (sub_eq_zero.mp h)

theorem continuous_vertical_principal_part
    (c p : ℂ) (x : ℝ) (hx : x ≠ p.re) :
    Continuous (fun y : ℝ => c / ((x : ℂ) + y * I - p)) := by
  refine continuous_const.div (by fun_prop) fun y h => hx ?_
  simpa using congrArg Complex.re (sub_eq_zero.mp h)

end RectangleFinitePrincipalPartSum

theorem
    wedgeIntegral_add_wedgeIntegral_finset_sum_div_sub_eq_two_pi_I_mul_sum
    (z w : ℂ) (P : Finset ℂ) (c : ℂ → ℂ)
    (hP : ∀ p ∈ P,
      z.re < p.re ∧ p.re < w.re ∧ z.im < p.im ∧ p.im < w.im) :
    Complex.wedgeIntegral z w (fun s => ∑ p ∈ P, c p / (s - p)) +
        Complex.wedgeIntegral w z (fun s => ∑ p ∈ P, c p / (s - p)) =
      (2 * Real.pi * I) * ∑ p ∈ P, c p := by
  classical
  have hbottom : ∀ p ∈ P,
      IntervalIntegrable
        (fun x : ℝ => c p / ((x : ℂ) + z.im * I - p)) volume z.re w.re := by
    intro p hp
    exact (continuous_horizontal_principal_part (c p) p z.im
      (ne_of_lt (hP p hp).2.2.1)).intervalIntegrable _ _
  have htop : ∀ p ∈ P,
      IntervalIntegrable
        (fun x : ℝ => c p / ((x : ℂ) + w.im * I - p)) volume w.re z.re := by
    intro p hp
    exact (continuous_horizontal_principal_part (c p) p w.im
      (ne_of_gt (hP p hp).2.2.2)).intervalIntegrable _ _
  have hright : ∀ p ∈ P,
      IntervalIntegrable
        (fun y : ℝ => c p / ((w.re : ℂ) + y * I - p)) volume z.im w.im := by
    intro p hp
    exact (continuous_vertical_principal_part (c p) p w.re
      (ne_of_gt (hP p hp).2.1)).intervalIntegrable _ _
  have hleft : ∀ p ∈ P,
      IntervalIntegrable
        (fun y : ℝ => c p / ((z.re : ℂ) + y * I - p)) volume w.im z.im := by
    intro p hp
    exact (continuous_vertical_principal_part (c p) p z.re
      (ne_of_lt (hP p hp).1)).intervalIntegrable _ _
  have hzw :
      Complex.wedgeIntegral z w (fun s => ∑ p ∈ P, c p / (s - p)) =
        ∑ p ∈ P, Complex.wedgeIntegral z w (fun s => c p / (s - p)) := by
    simp only [Complex.wedgeIntegral]
    rw [intervalIntegral.integral_finsetSum hbottom,
      intervalIntegral.integral_finsetSum hright]
    rw [Finset.smul_sum, ← Finset.sum_add_distrib]
  have hwz :
      Complex.wedgeIntegral w z (fun s => ∑ p ∈ P, c p / (s - p)) =
        ∑ p ∈ P, Complex.wedgeIntegral w z (fun s => c p / (s - p)) := by
    simp only [Complex.wedgeIntegral]
    rw [intervalIntegral.integral_finsetSum htop,
      intervalIntegral.integral_finsetSum hleft]
    rw [Finset.smul_sum, ← Finset.sum_add_distrib]
  rw [hzw, hwz, ← Finset.sum_add_distrib]
  calc
    (∑ p ∈ P, (Complex.wedgeIntegral z w (fun s => c p / (s - p)) +
        Complex.wedgeIntegral w z (fun s => c p / (s - p)))) =
        ∑ p ∈ P, (2 * Real.pi * I) * c p := by
      apply Finset.sum_congr rfl
      intro p hp
      exact wedgeIntegral_add_wedgeIntegral_div_sub_eq_two_pi_I_mul z w p (c p)
        (hP p hp).1 (hP p hp).2.1 (hP p hp).2.2.1 (hP p hp).2.2.2
    _ = (2 * Real.pi * I) * ∑ p ∈ P, c p := by
      rw [Finset.mul_sum]

end

section
open Complex Set
open scoped Interval

section DirichletExplicitFormulaRectangleBoundary

theorem intervalIntegrable_horizontal_of_continuousOn_rectangle
    {F : ℂ → ℂ} {z w : ℂ}
    (hF : ContinuousOn F (Complex.Rectangle z w))
    {y : ℝ} (hy : y ∈ [[z.im, w.im]]) :
    IntervalIntegrable (fun t : ℝ => F ((t : ℂ) + y * I))
      volume z.re w.re := by
  apply ContinuousOn.intervalIntegrable
  apply hF.comp
  · exact (Complex.continuous_ofReal.add continuous_const).continuousOn
  · intro t ht
    simpa [Complex.Rectangle, Complex.mem_reProdIm] using And.intro ht hy

theorem intervalIntegrable_vertical_of_continuousOn_rectangle
    {F : ℂ → ℂ} {z w : ℂ}
    (hF : ContinuousOn F (Complex.Rectangle z w))
    {x : ℝ} (hx : x ∈ [[z.re, w.re]]) :
    IntervalIntegrable (fun t : ℝ => F ((x : ℂ) + t * I))
      volume z.im w.im := by
  apply ContinuousOn.intervalIntegrable
  apply hF.comp
  · exact (continuous_const.add
      (Complex.continuous_ofReal.mul continuous_const)).continuousOn
  · intro t ht
    simpa [Complex.Rectangle, Complex.mem_reProdIm] using And.intro hx ht

theorem intervalIntegrable_horizontal_principalPartSum
    (P : Finset ℂ) (c : ℂ → ℂ) (y a b : ℝ)
    (hy : ∀ p ∈ P, y ≠ p.im) :
    IntervalIntegrable
      (fun t : ℝ => ∑ p ∈ P, c p / ((t : ℂ) + y * I - p))
      volume a b := by
  rw [← Finset.sum_fn]
  apply IntervalIntegrable.sum P
  intro p hp
  exact (continuous_horizontal_principal_part (c p) p y
    (hy p hp)).intervalIntegrable a b

theorem intervalIntegrable_vertical_principalPartSum
    (P : Finset ℂ) (c : ℂ → ℂ) (x a b : ℝ)
    (hx : ∀ p ∈ P, x ≠ p.re) :
    IntervalIntegrable
      (fun t : ℝ => ∑ p ∈ P, c p / ((x : ℂ) + t * I - p))
      volume a b := by
  rw [← Finset.sum_fn]
  apply IntervalIntegrable.sum P
  intro p hp
  exact (continuous_vertical_principal_part (c p) p x
    (hx p hp)).intervalIntegrable a b

end DirichletExplicitFormulaRectangleBoundary

theorem
  wedgeIntegral_add_wedgeIntegral_dirichletExplicitFormulaIntegrand_eq_mul_sum_candidateContribution
    {N : ℕ} [NeZero N] (chi : DirichletCharacter ℂ N)
    (x : ℝ) (z w : ℂ)
    (hP : ∀ rho ∈
      dirichletExplicitFormulaCandidateSingularitiesFinset chi z w,
        z.re < rho.re ∧ rho.re < w.re ∧
          z.im < rho.im ∧ rho.im < w.im) :
    Complex.wedgeIntegral z w
          (dirichletExplicitFormulaIntegrand chi x) +
        Complex.wedgeIntegral w z
          (dirichletExplicitFormulaIntegrand chi x) =
      (2 * Real.pi * Complex.I) *
        ∑ rho ∈
          dirichletExplicitFormulaCandidateSingularitiesFinset chi z w,
          dirichletExplicitFormulaCandidateContribution chi x rho := by
  classical
  let P := dirichletExplicitFormulaCandidateSingularitiesFinset chi z w
  let c : ℂ → ℂ := dirichletExplicitFormulaCandidateContribution chi x
  let f : ℂ → ℂ := dirichletExplicitFormulaIntegrand chi x
  let G : ℂ → ℂ := fun s => ∑ rho ∈ P, c rho / (s - rho)
  change ∀ rho ∈ P,
    z.re < rho.re ∧ rho.re < w.re ∧
      z.im < rho.im ∧ rho.im < w.im at hP
  change Complex.wedgeIntegral z w f + Complex.wedgeIntegral w z f =
    (2 * Real.pi * I) * ∑ rho ∈ P, c rho
  have hinside :
      ({pntCandidate | pntCandidate ∈ Complex.Rectangle (z) (w) ∧
         (((chi) = 1 ∧ pntCandidate = 1) ∨
           ((pntCandidate ≠ 1 ∨ (chi) ≠ 1) ∧
             DirichletCharacter.LFunction (chi) pntCandidate = 0))}) ⊆
        interior (Complex.Rectangle z w) := by
    intro rho hrho
    have hrhoP : rho ∈ P := by
      change rho ∈
        dirichletExplicitFormulaCandidateSingularitiesFinset chi z w
      exact mem_dirichletExplicitFormulaCandidateSingularitiesFinset_iff.mpr hrho
    have hrhoPosition := hP rho hrhoP
    have hre : z.re ≤ w.re :=
      (hrhoPosition.1.trans hrhoPosition.2.1).le
    have him : z.im ≤ w.im :=
      (hrhoPosition.2.2.1.trans hrhoPosition.2.2.2).le
    rw [Complex.Rectangle, Complex.interior_reProdIm,
      uIcc_of_le hre, uIcc_of_le him, interior_Icc, interior_Icc,
      Complex.mem_reProdIm]
    exact ⟨⟨hrhoPosition.1, hrhoPosition.2.1⟩,
      ⟨hrhoPosition.2.2.1, hrhoPosition.2.2.2⟩⟩
  obtain ⟨F, hF, hEq⟩ :=
    exists_differentiableOn_dirichletExplicitFormulaIntegrand_sub_candidatePrincipalParts
      chi x z w hinside
  change Set.EqOn F (fun s => f s - G s) ((P : Set ℂ)ᶜ) at hEq
  have hFbottom :
      IntervalIntegrable (fun t : ℝ => F ((t : ℂ) + z.im * I))
        volume z.re w.re :=
    intervalIntegrable_horizontal_of_continuousOn_rectangle
      (y := z.im) hF.continuousOn left_mem_uIcc
  have hFtop :
      IntervalIntegrable (fun t : ℝ => F ((t : ℂ) + w.im * I))
        volume w.re z.re :=
    (intervalIntegrable_horizontal_of_continuousOn_rectangle
      (y := w.im) hF.continuousOn right_mem_uIcc).symm
  have hFright :
      IntervalIntegrable (fun t : ℝ => F ((w.re : ℂ) + t * I))
        volume z.im w.im :=
    intervalIntegrable_vertical_of_continuousOn_rectangle
      (x := w.re) hF.continuousOn right_mem_uIcc
  have hFleft :
      IntervalIntegrable (fun t : ℝ => F ((z.re : ℂ) + t * I))
        volume w.im z.im :=
    (intervalIntegrable_vertical_of_continuousOn_rectangle
      (x := z.re) hF.continuousOn left_mem_uIcc).symm
  have hGbottom :
      IntervalIntegrable (fun t : ℝ => G ((t : ℂ) + z.im * I))
        volume z.re w.re := by
    apply intervalIntegrable_horizontal_principalPartSum P c
    intro rho hrho
    exact ne_of_lt (hP rho hrho).2.2.1
  have hGtop :
      IntervalIntegrable (fun t : ℝ => G ((t : ℂ) + w.im * I))
        volume w.re z.re := by
    apply intervalIntegrable_horizontal_principalPartSum P c
    intro rho hrho
    exact ne_of_gt (hP rho hrho).2.2.2
  have hGright :
      IntervalIntegrable (fun t : ℝ => G ((w.re : ℂ) + t * I))
        volume z.im w.im := by
    apply intervalIntegrable_vertical_principalPartSum P c
    intro rho hrho
    exact ne_of_gt (hP rho hrho).2.1
  have hGleft :
      IntervalIntegrable (fun t : ℝ => G ((z.re : ℂ) + t * I))
        volume w.im z.im := by
    apply intervalIntegrable_vertical_principalPartSum P c
    intro rho hrho
    exact ne_of_lt (hP rho hrho).1
  have hnotBottom (t : ℝ) : ((t : ℂ) + z.im * I) ∉ P := by
    intro ht
    simpa using (hP _ ht).2.2.1
  have hnotTop (t : ℝ) : ((t : ℂ) + w.im * I) ∉ P := by
    intro ht
    simpa using (hP _ ht).2.2.2
  have hnotRight (t : ℝ) : ((w.re : ℂ) + t * I) ∉ P := by
    intro ht
    simpa using (hP _ ht).2.1
  have hnotLeft (t : ℝ) : ((z.re : ℂ) + t * I) ∉ P := by
    intro ht
    simpa using (hP _ ht).1
  have hdecomp {s : ℂ} (hs : s ∉ P) : f s = F s + G s := by
    have hs' : s ∈ ((P : Set ℂ)ᶜ) := hs
    exact eq_add_of_sub_eq (hEq hs').symm
  have hbottom :
      (∫ t : ℝ in z.re..w.re, f ((t : ℂ) + z.im * I)) =
        ∫ t : ℝ in z.re..w.re,
          F ((t : ℂ) + z.im * I) + G ((t : ℂ) + z.im * I) := by
    apply intervalIntegral.integral_congr
    intro t _ht
    exact hdecomp (hnotBottom t)
  have htop :
      (∫ t : ℝ in w.re..z.re, f ((t : ℂ) + w.im * I)) =
        ∫ t : ℝ in w.re..z.re,
          F ((t : ℂ) + w.im * I) + G ((t : ℂ) + w.im * I) := by
    apply intervalIntegral.integral_congr
    intro t _ht
    exact hdecomp (hnotTop t)
  have hright :
      (∫ t : ℝ in z.im..w.im, f ((w.re : ℂ) + t * I)) =
        ∫ t : ℝ in z.im..w.im,
          F ((w.re : ℂ) + t * I) + G ((w.re : ℂ) + t * I) := by
    apply intervalIntegral.integral_congr
    intro t _ht
    exact hdecomp (hnotRight t)
  have hleft :
      (∫ t : ℝ in w.im..z.im, f ((z.re : ℂ) + t * I)) =
        ∫ t : ℝ in w.im..z.im,
          F ((z.re : ℂ) + t * I) + G ((z.re : ℂ) + t * I) := by
    apply intervalIntegral.integral_congr
    intro t _ht
    exact hdecomp (hnotLeft t)
  have hzw : Complex.wedgeIntegral z w f =
      Complex.wedgeIntegral z w F + Complex.wedgeIntegral z w G := by
    simp only [Complex.wedgeIntegral]
    rw [hbottom, hright,
      intervalIntegral.integral_add hFbottom hGbottom,
      intervalIntegral.integral_add hFright hGright]
    simp only [smul_add]
    abel
  have hwz : Complex.wedgeIntegral w z f =
      Complex.wedgeIntegral w z F + Complex.wedgeIntegral w z G := by
    simp only [Complex.wedgeIntegral]
    rw [htop, hleft,
      intervalIntegral.integral_add hFtop hGtop,
      intervalIntegral.integral_add hFleft hGleft]
    simp only [smul_add]
    abel
  have hFzero :
      Complex.wedgeIntegral z w F + Complex.wedgeIntegral w z F = 0 := by
    have hconservative := hF.isConservativeOn z w (fun _ hs => hs)
    rw [hconservative]
    simp
  have hGsum :
      Complex.wedgeIntegral z w G + Complex.wedgeIntegral w z G =
        (2 * Real.pi * I) * ∑ rho ∈ P, c rho := by
    simpa [G] using
      wedgeIntegral_add_wedgeIntegral_finset_sum_div_sub_eq_two_pi_I_mul_sum
        z w P c hP
  calc
    Complex.wedgeIntegral z w f + Complex.wedgeIntegral w z f =
        (Complex.wedgeIntegral z w F + Complex.wedgeIntegral z w G) +
          (Complex.wedgeIntegral w z F + Complex.wedgeIntegral w z G) := by
      rw [hzw, hwz]
    _ = (Complex.wedgeIntegral z w F + Complex.wedgeIntegral w z F) +
        (Complex.wedgeIntegral z w G + Complex.wedgeIntegral w z G) := by
      abel
    _ = (2 * Real.pi * I) * ∑ rho ∈ P, c rho := by
      rw [hFzero, hGsum, zero_add]

end

section
open Complex Set
open scoped Interval
/--
The explicit-formula integral on the right edge `re = 1 + 1 / log x`, parameterized by `t` from
`-U` to `U`. The factor `1 / (2 * pi)` is the vertical-line form of contour normalization by `1
/ (2 * pi * I)`.
-/
noncomputable def dirichletExplicitFormulaNormalizedRightEdge
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    (x U : ℝ) : ℂ :=
  (((2 * Real.pi : ℝ) : ℂ)⁻¹) *
    ∫ t in -U..U,
      dirichletExplicitFormulaIntegrand chi x
        (((1 + 1 / Real.log x : ℝ) : ℂ) + t * I)

/--
The other three edge contributions in the shallow contour identity, combined as `(I * lower - I
* upper + left) / (2 * pi)`. The horizontal edges span real parts from `-1 / 2` to `1 + 1 / log
x`, and the left edge is parameterized upward from `-U` to `U`.
-/
noncomputable def dirichletExplicitFormulaShallowContourRemainder
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    (x U : ℝ) : ℂ :=
  (((2 * Real.pi : ℝ) : ℂ)⁻¹) *
    (I * (∫ sigma in (-1 / 2)..(1 + 1 / Real.log x),
          dirichletExplicitFormulaIntegrand chi x
            ((sigma : ℂ) - U * I)) -
      I * (∫ sigma in (-1 / 2)..(1 + 1 / Real.log x),
          dirichletExplicitFormulaIntegrand chi x
            ((sigma : ℂ) + U * I)) +
      (∫ t in -U..U,
        dirichletExplicitFormulaIntegrand chi x
          (((-1 / 2 : ℝ) : ℂ) + t * I)))

theorem dirichletExplicitFormulaNormalizedRightEdge_eq_sum_add_remainder
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    {x U : ℝ} (hx : 1 < x) (hU : 0 < U)
    (hinside : ({pntCandidate |
      pntCandidate ∈ Complex.Rectangle
        ((((-1 / 2 : ℝ) : ℂ) - U * I))
        ((((1 + 1 / Real.log x : ℝ) : ℂ) + U * I)) ∧
                  (((chi) = 1 ∧ pntCandidate = 1) ∨
                    ((pntCandidate ≠ 1 ∨ (chi) ≠ 1) ∧
                      DirichletCharacter.LFunction (chi) pntCandidate = 0))}) ⊆
      interior (Complex.Rectangle
        (((-1 / 2 : ℝ) : ℂ) - U * I)
        (((1 + 1 / Real.log x : ℝ) : ℂ) + U * I))) :
    dirichletExplicitFormulaNormalizedRightEdge chi x U =
      (∑ rho ∈
          dirichletExplicitFormulaShallowCandidateSingularitiesFinset chi x U,
        dirichletExplicitFormulaCandidateContribution chi x rho) +
      dirichletExplicitFormulaShallowContourRemainder chi x U := by
  classical
  let z : ℂ := ((-1 / 2 : ℝ) : ℂ) - U * I
  let w : ℂ := ((1 + 1 / Real.log x : ℝ) : ℂ) + U * I
  let F : ℂ → ℂ := dirichletExplicitFormulaIntegrand chi x
  let S : ℂ :=
    ∑ rho ∈ dirichletExplicitFormulaCandidateSingularitiesFinset chi z w,
      dirichletExplicitFormulaCandidateContribution chi x rho
  let lower : ℂ :=
    ∫ sigma in (-1 / 2)..(1 + 1 / Real.log x),
      F ((sigma : ℂ) - U * I)
  let upper : ℂ :=
    ∫ sigma in (-1 / 2)..(1 + 1 / Real.log x),
      F ((sigma : ℂ) + U * I)
  let right : ℂ :=
    ∫ t in -U..U,
      F (((1 + 1 / Real.log x : ℝ) : ℂ) + t * I)
  let left : ℂ :=
    ∫ t in -U..U, F (((-1 / 2 : ℝ) : ℂ) + t * I)
  have hlog : 0 < Real.log x := Real.log_pos hx
  have hinvLog : 0 < (Real.log x)⁻¹ := inv_pos.mpr hlog
  have hzwRe : z.re ≤ w.re := by
    dsimp [z, w]
    norm_num
    linarith
  have hzwIm : z.im ≤ w.im := by
    dsimp [z, w]
    norm_num
    linarith
  have hposition : ∀ rho ∈
      dirichletExplicitFormulaCandidateSingularitiesFinset chi z w,
      z.re < rho.re ∧ rho.re < w.re ∧
        z.im < rho.im ∧ rho.im < w.im := by
    intro rho hrho
    have hrhoSet : rho ∈ ({pntCandidate | pntCandidate ∈ Complex.Rectangle (z) (w) ∧
                            (((chi) = 1 ∧ pntCandidate = 1) ∨
                              ((pntCandidate ≠ 1 ∨ (chi) ≠ 1) ∧
                                DirichletCharacter.LFunction (chi) pntCandidate = 0))}) :=
      mem_dirichletExplicitFormulaCandidateSingularitiesFinset_iff.mp hrho
    have hrhoInterior := hinside hrhoSet
    rw [Complex.Rectangle, Complex.interior_reProdIm,
      uIcc_of_le hzwRe, uIcc_of_le hzwIm, interior_Icc, interior_Icc,
      Complex.mem_reProdIm] at hrhoInterior
    exact ⟨hrhoInterior.1.1, hrhoInterior.1.2,
      hrhoInterior.2.1, hrhoInterior.2.2⟩
  have hboundary :=
  wedgeIntegral_add_wedgeIntegral_dirichletExplicitFormulaIntegrand_eq_mul_sum_candidateContribution
      chi x z w hposition
  change Complex.wedgeIntegral z w F + Complex.wedgeIntegral w z F =
    (2 * Real.pi * I) * S at hboundary
  rw [Complex.wedgeIntegral_add_wedgeIntegral_eq] at hboundary
  have hboundary' :
      lower - upper + I * right - I * left =
        (2 * Real.pi * I) * S := by
    simpa [lower, upper, right, left, z, w, ofReal_neg,
      sub_eq_add_neg] using hboundary
  have hIright :
      I * right = (2 * Real.pi * I) * S - lower + upper + I * left := by
    linear_combination hboundary'
  have hmainMul :
      -I * ((2 * Real.pi * I) * S) =
        ((2 * Real.pi : ℝ) : ℂ) * S := by
    calc
      _ = (-I * I) * (((2 * Real.pi : ℝ) : ℂ) * S) := by
        push_cast
        ring
      _ = _ := by rw [neg_mul, I_mul_I]; simp
  have hleftMul : -I * (I * left) = left := by
    rw [← mul_assoc, neg_mul, I_mul_I]
    simp
  have hright :
      right = ((2 * Real.pi : ℝ) : ℂ) * S +
        I * lower - I * upper + left := by
    calc
      _ = -I * (I * right) := by
        rw [← mul_assoc, neg_mul, I_mul_I]
        simp
      _ = -I * ((2 * Real.pi * I) * S - lower + upper + I * left) := by
        rw [hIright]
      _ = _ := by
        rw [mul_add, mul_add, mul_sub]
        rw [hmainMul, hleftMul]
        ring
  have htwoPi : (((2 * Real.pi : ℝ) : ℂ)) ≠ 0 := by
    exact_mod_cast Real.two_pi_pos.ne'
  have hfinset :
      dirichletExplicitFormulaCandidateSingularitiesFinset chi z w =
        dirichletExplicitFormulaShallowCandidateSingularitiesFinset chi x U := by
    simp [z, w, dirichletExplicitFormulaShallowCandidateSingularitiesFinset,
      abs_of_pos hU]
    norm_num
  rw [dirichletExplicitFormulaNormalizedRightEdge,
    dirichletExplicitFormulaShallowContourRemainder]
  change (((2 * Real.pi : ℝ) : ℂ)⁻¹) * right = _
  rw [hright]
  rw [← hfinset]
  change _ = S + (((2 * Real.pi : ℝ) : ℂ)⁻¹) *
    (I * lower - I * upper + left)
  field_simp [htwoPi]
  ring

theorem norm_dirichletExplicitFormulaShallowContourRemainder_le
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    {x U A C E : ℝ} (hC : 2 ≤ C) (hE : 0 ≤ E)
    (hlower : ‖∫ sigma in (-1 / 2)..(1 + 1 / Real.log x),
        dirichletExplicitFormulaIntegrand chi x
          ((sigma : ℂ) - U * I)‖ ≤ 640 * A * C * E)
    (hupper : ‖∫ sigma in (-1 / 2)..(1 + 1 / Real.log x),
        dirichletExplicitFormulaIntegrand chi x
          ((sigma : ℂ) + U * I)‖ ≤ 640 * A * C * E)
    (hleft : ‖∫ t in -U..U,
        dirichletExplicitFormulaIntegrand chi x
          (((-1 / 2 : ℝ) : ℂ) + t * I)‖ ≤ 720 * A * E) :
    ‖dirichletExplicitFormulaShallowContourRemainder chi x U‖ ≤
      1640 * A * C * E := by
  let lower : ℂ :=
    ∫ sigma in (-1 / 2)..(1 + 1 / Real.log x),
      dirichletExplicitFormulaIntegrand chi x ((sigma : ℂ) - U * I)
  let upper : ℂ :=
    ∫ sigma in (-1 / 2)..(1 + 1 / Real.log x),
      dirichletExplicitFormulaIntegrand chi x ((sigma : ℂ) + U * I)
  let left : ℂ :=
    ∫ t in -U..U,
      dirichletExplicitFormulaIntegrand chi x
        (((-1 / 2 : ℝ) : ℂ) + t * I)
  change ‖lower‖ ≤ 640 * A * C * E at hlower
  change ‖upper‖ ≤ 640 * A * C * E at hupper
  change ‖left‖ ≤ 720 * A * E at hleft
  have hAE : 0 ≤ A * E := by
    rcases hE.eq_or_lt with hEzero | hEpos
    · rw [← hEzero]
      simp
    · have hnonneg : 0 ≤ 720 * A * E := (norm_nonneg left).trans hleft
      nlinarith
  have htwoAE_le : 2 * (A * E) ≤ C * (A * E) :=
    mul_le_mul_of_nonneg_right hC hAE
  have hinvNorm : ‖((2 * Real.pi : ℝ) : ℂ)⁻¹‖ ≤ 1 := by
    rw [norm_inv, Complex.norm_real, Real.norm_eq_abs,
      abs_of_pos Real.two_pi_pos]
    exact inv_le_one_of_one_le₀ (by nlinarith [Real.one_le_pi_div_two])
  have hremainderNorm :
      ‖I * lower - I * upper + left‖ ≤
        ‖lower‖ + ‖upper‖ + ‖left‖ := by
    calc
      ‖I * lower - I * upper + left‖ ≤
          ‖I * lower - I * upper‖ + ‖left‖ := norm_add_le _ _
      _ ≤ (‖I * lower‖ + ‖I * upper‖) + ‖left‖ := by
        gcongr
        exact norm_sub_le _ _
      _ = ‖lower‖ + ‖upper‖ + ‖left‖ := by simp
  have hproduct :
      ‖((2 * Real.pi : ℝ) : ℂ)⁻¹‖ *
          ‖I * lower - I * upper + left‖ ≤
        1640 * A * C * E := by
    calc
      ‖((2 * Real.pi : ℝ) : ℂ)⁻¹‖ *
        ‖I * lower - I * upper + left‖ ≤
        1 * ‖I * lower - I * upper + left‖ :=
        mul_le_mul_of_nonneg_right hinvNorm (norm_nonneg _)
      _ ≤ ‖lower‖ + ‖upper‖ + ‖left‖ := by
        simpa using hremainderNorm
      _ ≤ (640 * A * C * E) + (640 * A * C * E) + 720 * A * E := by
        gcongr
      _ ≤ 1640 * A * C * E := by
        nlinarith
  simpa [dirichletExplicitFormulaShallowContourRemainder,
    lower, upper, left, norm_mul] using hproduct

end

section
open Complex

/--
Classical proposition decidability for the principal- and even-character branches of the
shallow-contour correction.
-/
noncomputable local instance shallowMainTermCorrectionDecidable
    (p : Prop) : Decidable p :=
  Classical.propDecidable p

end

section
open Complex

attribute [local instance] PrimeGap186.shallowMainTermCorrectionDecidable
/--
The principal-character term `x`, or zero for a nonprincipal character, minus the
multiplicity-weighted nontrivial-zero kernel sum through height `|T|`.
-/
noncomputable def dirichletExplicitFormulaMainZeroTerms
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    (x T : ℝ) : ℂ :=
  (if chi = 1 then (x : ℂ) else 0) -
    dirichletNontrivialZeroKernelSum chi x T

/--
The correction from the modified kernel and the origin: `-1` for the principal character, `-log
x` for a nonprincipal even character, and zero otherwise.
-/
noncomputable def dirichletExplicitFormulaShallowMainTermCorrection
    {q : ℕ} (chi : DirichletCharacter ℂ q) (x : ℝ) : ℂ :=
  if chi = 1 then -1
  else if chi.Even then -(Real.log x : ℂ) else 0

/--
The truncation-error scale `x * log (x * q) ^ 2 / T` used for the Dirichlet explicit formula.
-/
noncomputable def dirichletExplicitFormulaErrorScale
    (x : ℝ) (q : ℕ) (T : ℝ) : ℝ :=
  x * Real.log (x * (q : ℝ)) ^ 2 / T

theorem
    sum_shallowCandidateContribution_eq_mainZeroTerms_add_correction_of_isPrimitive
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    (hchi : chi.IsPrimitive) (x T : ℝ) (hx : 1 < x) :
    (∑ rho ∈
        dirichletExplicitFormulaShallowCandidateSingularitiesFinset chi x T,
      dirichletExplicitFormulaCandidateContribution chi x rho) =
      dirichletExplicitFormulaMainZeroTerms chi x T +
        dirichletExplicitFormulaShallowMainTermCorrection chi x := by
  rw [sum_dirichletExplicitFormulaShallowCandidateContribution_eq_of_isPrimitive
    chi hchi x T hx]
  classical
  by_cases hchiOne : chi = 1
  · simp [dirichletExplicitFormulaMainZeroTerms,
      dirichletExplicitFormulaShallowMainTermCorrection, hchiOne]
    ring
  · by_cases heven : chi.Even
    · simp [dirichletExplicitFormulaMainZeroTerms,
        dirichletExplicitFormulaShallowMainTermCorrection, hchiOne, heven]
      ring
    · simp [dirichletExplicitFormulaMainZeroTerms,
        dirichletExplicitFormulaShallowMainTermCorrection, hchiOne, heven]

end

section
open Complex

attribute [local instance] PrimeGap186.shallowMainTermCorrectionDecidable

section DirichletExplicitFormulaShallowCorrection
theorem norm_dirichletExplicitFormulaShallowMainTermCorrection_eq
    {q : ℕ} (chi : DirichletCharacter ℂ q)
    {x : ℝ} (hx : 1 < x) :
    ‖dirichletExplicitFormulaShallowMainTermCorrection chi x‖ =
      if chi = 1 then 1 else if chi.Even then Real.log x else 0 := by
  classical
  have hlog : 0 < Real.log x := Real.log_pos hx
  by_cases hchiOne : chi = 1
  · simp [dirichletExplicitFormulaShallowMainTermCorrection, hchiOne]
  · by_cases heven : chi.Even
    · simp [dirichletExplicitFormulaShallowMainTermCorrection,
        hchiOne, heven, Complex.norm_real, abs_of_pos hlog]
    · simp [dirichletExplicitFormulaShallowMainTermCorrection,
        hchiOne, heven]

end DirichletExplicitFormulaShallowCorrection
end

section
open Complex

attribute [local instance] PrimeGap186.shallowMainTermCorrectionDecidable
theorem norm_dirichletExplicitFormulaShallowMainTermCorrection_le_two_mul_log
    {q : ℕ} (chi : DirichletCharacter ℂ q)
    {x : ℝ} (hx : 2 ≤ x) :
    ‖dirichletExplicitFormulaShallowMainTermCorrection chi x‖ ≤
      2 * Real.log x := by
  have hxone : 1 < x := lt_of_lt_of_le one_lt_two hx
  rw [norm_dirichletExplicitFormulaShallowMainTermCorrection_eq chi hxone]
  have hhalf : (1 / 2 : ℝ) ≤ Real.log 2 := by
    have h := Real.one_sub_inv_le_log_of_pos
      (show (0 : ℝ) < 2 by norm_num)
    norm_num at h ⊢
    exact h
  have hlogmono : Real.log 2 ≤ Real.log x :=
    Real.log_le_log (by norm_num) hx
  have hone : (1 : ℝ) ≤ 2 * Real.log x := by linarith
  have hlog : 0 ≤ Real.log x := (Real.log_pos hxone).le
  classical
  by_cases hchiOne : chi = 1
  · simp [hchiOne, hone]
  · by_cases heven : chi.Even
    · simp only [ite_eq_right hchiOne, ite_eq_left heven]
      linarith
    · simp [hchiOne, heven, hlog]

theorem
    norm_dirichletExplicitFormulaShallowMainTermCorrection_le_four_mul_errorScale
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    {x T : ℝ} (hT : 2 ≤ T) (hTx : T ≤ x) :
    ‖dirichletExplicitFormulaShallowMainTermCorrection chi x‖ ≤
      4 * dirichletExplicitFormulaErrorScale x q T := by
  have hx : 2 ≤ x := hT.trans hTx
  have hxpos : 0 < x := zero_lt_two.trans_le hx
  have hTpos : 0 < T := zero_lt_two.trans_le hT
  have hq : (1 : ℝ) ≤ q := by
    exact_mod_cast Nat.one_le_iff_ne_zero.mpr (NeZero.ne q)
  have hxqx : x ≤ x * (q : ℝ) := by
    simpa using mul_le_mul_of_nonneg_left hq hxpos.le
  have hlogxProduct : Real.log x ≤ Real.log (x * (q : ℝ)) :=
    Real.log_le_log hxpos hxqx
  have hlogProductHalf : (1 / 2 : ℝ) ≤
      Real.log (x * (q : ℝ)) := by
    have hhalf : (1 / 2 : ℝ) ≤ Real.log 2 := by
      have h := Real.one_sub_inv_le_log_of_pos
        (show (0 : ℝ) < 2 by norm_num)
      norm_num at h ⊢
      exact h
    have hlogTwoX : Real.log 2 ≤ Real.log x :=
      Real.log_le_log (by norm_num) hx
    linarith
  have hxT : 1 ≤ x / T :=
    (le_div_iff₀ hTpos).2 (by simpa using hTx)
  have hlogxLeSquare :
      2 * Real.log x ≤ 4 * Real.log (x * (q : ℝ)) ^ 2 := by
    have hlinear : 2 * Real.log x ≤
        2 * Real.log (x * (q : ℝ)) := by linarith
    have hsquare : 2 * Real.log (x * (q : ℝ)) ≤
        4 * Real.log (x * (q : ℝ)) ^ 2 := by
      nlinarith [sq_nonneg (Real.log (x * (q : ℝ)) - 1 / 2)]
    exact hlinear.trans hsquare
  calc
    ‖dirichletExplicitFormulaShallowMainTermCorrection chi x‖ ≤
        2 * Real.log x :=
      norm_dirichletExplicitFormulaShallowMainTermCorrection_le_two_mul_log
        chi hx
    _ ≤ 4 * Real.log (x * (q : ℝ)) ^ 2 := hlogxLeSquare
    _ ≤ 4 * dirichletExplicitFormulaErrorScale x q T := by
      rw [dirichletExplicitFormulaErrorScale, div_eq_mul_inv, mul_assoc]
      have hratio : 1 ≤ x * T⁻¹ := by
        simpa [div_eq_mul_inv] using hxT
      nlinarith [sq_nonneg (Real.log (x * (q : ℝ)))]

end

section
open scoped Interval

theorem norm_dirichletExplicitFormulaKernel_horizontal_le
    {x sigma t T : ℝ} (hx : 0 < x) (hT : 0 < T) (ht : T ≤ |t|) :
    ‖dirichletExplicitFormulaKernel x
        ((sigma : ℂ) + (t : ℂ) * Complex.I)‖ ≤ (x ^ sigma + 1) / T := by
  let s : ℂ := (sigma : ℂ) + (t : ℂ) * Complex.I
  have hTnorm : T ≤ ‖s‖ := by
    calc
      T ≤ |t| := ht
      _ = |s.im| := by simp [s]
      _ ≤ ‖s‖ := Complex.abs_im_le_norm s
  have hs : s ≠ 0 := by
    intro hs
    rw [hs, norm_zero] at hTnorm
    linarith
  rw [show (sigma : ℂ) + (t : ℂ) * Complex.I = s by rfl,
    dirichletExplicitFormulaKernel_eq_cpow_sub_one_div hx hs,
    Complex.norm_div]
  have hnum : ‖(x : ℂ) ^ s - 1‖ ≤ x ^ sigma + 1 := by
    calc
      ‖(x : ℂ) ^ s - 1‖ ≤ ‖(x : ℂ) ^ s‖ + ‖1‖ := norm_sub_le _ _
      _ = x ^ sigma + 1 := by
        rw [Complex.norm_cpow_eq_rpow_re_of_pos hx]
        simp [s]
  calc
    ‖(x : ℂ) ^ s - 1‖ / ‖s‖ ≤ (x ^ sigma + 1) / ‖s‖ :=
      div_le_div_of_nonneg_right hnum (norm_nonneg s)
    _ ≤ (x ^ sigma + 1) / T := by
      exact div_le_div_of_nonneg_left (by positivity) hT hTnorm

theorem norm_dirichletExplicitFormulaKernel_horizontal_le_four_mul
    {x sigma t T : ℝ} (hx : 2 ≤ x)
    (hsigma : sigma ≤ 1 + 1 / Real.log x)
    (hT : 0 < T) (ht : T ≤ |t|) :
    ‖dirichletExplicitFormulaKernel x
        ((sigma : ℂ) + (t : ℂ) * Complex.I)‖ ≤ 4 * x / T := by
  have hxpos : 0 < x := by linarith
  have hxone : 1 ≤ x := by linarith
  have hxne : x ≠ 1 := by linarith
  have hpow : x ^ sigma ≤ x ^ (1 + 1 / Real.log x) :=
    Real.rpow_le_rpow_of_exponent_le hxone hsigma
  have hnum : x ^ sigma + 1 ≤ 4 * x := by
    calc
      x ^ sigma + 1 ≤ x ^ (1 + 1 / Real.log x) + 1 :=
        add_le_add hpow le_rfl
      _ = x * Real.exp 1 + 1 := by
        rw [Real.rpow_add hxpos, Real.rpow_one, one_div,
          Real.rpow_inv_log hxpos hxne]
      _ ≤ x * 3 + x :=
        add_le_add
          (mul_le_mul_of_nonneg_left Real.exp_one_lt_three.le hxpos.le) hxone
      _ = 4 * x := by ring
  refine (norm_dirichletExplicitFormulaKernel_horizontal_le hxpos hT ht).trans ?_
  exact div_le_div_of_nonneg_right hnum hT.le

theorem norm_intervalIntegral_dirichletExplicitFormulaIntegrand_horizontal_le
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    {x a b t T K : ℝ} (hx : 2 ≤ x) (hab : a ≤ b)
    (hb : b ≤ 1 + 1 / Real.log x) (hT : 0 < T) (ht : T ≤ |t|)
    (hK : 0 ≤ K)
    (hIntegrable : IntervalIntegrable
      (fun r : ℝ => dirichletExplicitFormulaIntegrand chi x
        ((r : ℂ) + (t : ℂ) * Complex.I)) MeasureTheory.volume a b)
    (hLogDeriv : ∀ r ∈ Set.Icc a b,
      ‖logDeriv (DirichletCharacter.LFunction chi)
        ((r : ℂ) + (t : ℂ) * Complex.I)‖ ≤ K) :
    ‖∫ r in a..b,
        dirichletExplicitFormulaIntegrand chi x
          ((r : ℂ) + (t : ℂ) * Complex.I)‖ ≤
      (4 * K * x / T) * (b - a) := by
  have hpoint : ∀ r ∈ Set.Icc a b,
      ‖dirichletExplicitFormulaIntegrand chi x
        ((r : ℂ) + (t : ℂ) * Complex.I)‖ ≤ 4 * K * x / T := by
    intro r hr
    have hrUpper : r ≤ 1 + 1 / Real.log x := hr.2.trans hb
    have hkernel :=
      norm_dirichletExplicitFormulaKernel_horizontal_le_four_mul
        hx hrUpper hT ht
    have hlog := hLogDeriv r hr
    rw [dirichletExplicitFormulaIntegrand, norm_mul, norm_neg]
    calc
      ‖logDeriv (DirichletCharacter.LFunction chi)
          ((r : ℂ) + (t : ℂ) * Complex.I)‖ *
          ‖dirichletExplicitFormulaKernel x
            ((r : ℂ) + (t : ℂ) * Complex.I)‖ ≤ K * (4 * x / T) :=
        mul_le_mul hlog hkernel (norm_nonneg _) hK
      _ = 4 * K * x / T := by ring
  calc
    ‖∫ r in a..b,
        dirichletExplicitFormulaIntegrand chi x
          ((r : ℂ) + (t : ℂ) * Complex.I)‖ ≤
        ∫ r in a..b,
          ‖dirichletExplicitFormulaIntegrand chi x
            ((r : ℂ) + (t : ℂ) * Complex.I)‖ :=
      intervalIntegral.norm_integral_le_integral_norm hab
    _ ≤ ∫ _r in a..b, 4 * K * x / T :=
      intervalIntegral.integral_mono_on hab hIntegrable.norm
        intervalIntegrable_const hpoint
    _ = (4 * K * x / T) * (b - a) := by
      rw [intervalIntegral.integral_const]
      simp [smul_eq_mul]
      ring

end

section
open Complex Set
/--
The nontrivial zeros with `|T| < |rho.im|` and `|rho.im| ≤ |U|`, obtained by subtracting the
lower-height finset from the upper-height finset.
-/
noncomputable def dirichletNontrivialLFunctionZeroShellFinset
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    (T U : ℝ) : Finset ℂ :=
  dirichletNontrivialLFunctionZerosFinset chi U \
    dirichletNontrivialLFunctionZerosFinset chi T

theorem dirichletNontrivialZeroKernelSum_sub_eq_sum_zeroShell
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    (x : ℝ) {T U : ℝ} (hT : 0 ≤ T) (hTU : T ≤ U) :
    dirichletNontrivialZeroKernelSum chi x U -
        dirichletNontrivialZeroKernelSum chi x T =
      ∑ rho ∈ dirichletNontrivialLFunctionZeroShellFinset chi T U,
        (analyticOrderNatAt
          (DirichletCharacter.LFunction chi) rho : ℂ) *
            dirichletExplicitFormulaKernel x rho := by
  have hsubset :
      dirichletNontrivialLFunctionZerosFinset chi T ⊆
        dirichletNontrivialLFunctionZerosFinset chi U := by
    intro rho hrho
    rw [mem_dirichletNontrivialLFunctionZerosFinset_iff] at hrho ⊢
    refine ⟨hrho.1, ?_⟩
    rw [abs_of_nonneg (hT.trans hTU)]
    have hrhoT : |rho.im| ≤ T := by
      simpa [abs_of_nonneg hT] using hrho.2
    exact hrhoT.trans hTU
  rw [dirichletNontrivialZeroKernelSum,
    dirichletNontrivialZeroKernelSum,
    dirichletNontrivialLFunctionZeroShellFinset]
  exact (Finset.sum_sdiff_eq_sub hsubset).symm

theorem norm_dirichletExplicitFormulaKernel_le_two_mul_x_div_of_mem_zeroShell
    {q : ℕ} [NeZero q] {chi : DirichletCharacter ℂ q}
    {x T U : ℝ} (hx : 2 ≤ x) (hT : 2 ≤ T) {rho : ℂ}
    (hrho : rho ∈
      dirichletNontrivialLFunctionZeroShellFinset chi T U) :
    ‖dirichletExplicitFormulaKernel x rho‖ ≤ 2 * x / T := by
  have hrhoU := (Finset.mem_sdiff.mp hrho).1
  have hzero :=
    (mem_dirichletNontrivialLFunctionZerosFinset_iff.mp hrhoU).1
  have hheight : T ≤ |rho.im| := by
    have hrhoT := (Finset.mem_sdiff.mp hrho).2
    by_contra hnot
    apply hrhoT
    rw [mem_dirichletNontrivialLFunctionZerosFinset_iff,
      abs_of_nonneg (show 0 ≤ T by linarith)]
    exact ⟨hzero, le_of_not_ge hnot⟩
  have hkernel :
      ‖dirichletExplicitFormulaKernel x rho‖ ≤
        (x ^ rho.re + 1) / T := by
    simpa only [Complex.re_add_im] using
      (norm_dirichletExplicitFormulaKernel_horizontal_le
        (x := x) (sigma := rho.re) (t := rho.im) (T := T)
        (by linarith) (by linarith) hheight)
  have hpow : x ^ rho.re ≤ x := by
    calc
      x ^ rho.re ≤ x ^ (1 : ℝ) :=
        Real.rpow_le_rpow_of_exponent_le (by linarith) hzero.2.2.le
      _ = x := Real.rpow_one x
  have hnum : x ^ rho.re + 1 ≤ 2 * x := by
    linarith [show (1 : ℝ) ≤ x by linarith]
  exact hkernel.trans
    (div_le_div_of_nonneg_right hnum (show 0 ≤ T by linarith))

theorem
    norm_dirichletNontrivialZeroKernelSum_sub_le_zeroShellMultiplicity
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    {x T U : ℝ} (hx : 2 ≤ x) (hT : 2 ≤ T)
    (hU : U ∈ Set.Icc T (T + 1)) :
    ‖dirichletNontrivialZeroKernelSum chi x U -
        dirichletNontrivialZeroKernelSum chi x T‖ ≤
      (2 * x / T) *
        ∑ rho ∈ dirichletNontrivialLFunctionZeroShellFinset chi T U,
          (analyticOrderNatAt
            (DirichletCharacter.LFunction chi) rho : ℝ) := by
  rw [dirichletNontrivialZeroKernelSum_sub_eq_sum_zeroShell
    chi x (show 0 ≤ T by linarith) hU.1]
  calc
    _ ≤ ∑ rho ∈ dirichletNontrivialLFunctionZeroShellFinset chi T U,
        (analyticOrderNatAt
          (DirichletCharacter.LFunction chi) rho : ℝ) *
            (2 * x / T) := by
      refine norm_sum_le_of_le _ fun rho hrho => ?_
      rw [norm_mul, Complex.norm_natCast]
      exact mul_le_mul_of_nonneg_left
        (norm_dirichletExplicitFormulaKernel_le_two_mul_x_div_of_mem_zeroShell
          hx hT hrho) (Nat.cast_nonneg _)
    _ = (2 * x / T) *
        ∑ rho ∈ dirichletNontrivialLFunctionZeroShellFinset chi T U,
          (analyticOrderNatAt
            (DirichletCharacter.LFunction chi) rho : ℝ) := by
      rw [← Finset.sum_mul]
      ring

/--
The nontrivial zeros whose imaginary parts lie in the closed unit window around `t`. They are
selected from the finite height cutoff `|t| + 1`.
-/
noncomputable def dirichletNontrivialLFunctionZeroWindowFinset
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    (t : ℝ) : Finset ℂ :=
  (dirichletNontrivialLFunctionZerosFinset chi (|t| + 1)).filter
    fun rho => |rho.im - t| ≤ 1

end

section
open Complex Set

attribute [local instance] inducingEulerProductConductorNeZero
@[simp] theorem mem_dirichletNontrivialLFunctionZeroShellFinset_iff
    {q : ℕ} [NeZero q] {chi : DirichletCharacter ℂ q}
    {T U : ℝ} (hT : 0 ≤ T) (hTU : T ≤ U) {rho : ℂ} :
    rho ∈ dirichletNontrivialLFunctionZeroShellFinset chi T U ↔
      (DirichletCharacter.LFunction chi rho = 0 ∧
        0 < rho.re ∧ rho.re < 1) ∧
        T < |rho.im| ∧ |rho.im| ≤ U := by
  rw [dirichletNontrivialLFunctionZeroShellFinset, Finset.mem_sdiff,
    mem_dirichletNontrivialLFunctionZerosFinset_iff,
    mem_dirichletNontrivialLFunctionZerosFinset_iff,
    abs_of_nonneg hT, abs_of_nonneg (hT.trans hTU)]
  constructor
  · rintro ⟨⟨hzero, hupper⟩, hnotLower⟩
    refine ⟨hzero, ?_, hupper⟩
    by_contra hlower
    exact hnotLower ⟨hzero, le_of_not_gt hlower⟩
  · rintro ⟨hzero, hlower, hupper⟩
    refine ⟨⟨hzero, hupper⟩, ?_⟩
    rintro ⟨_, hlower'⟩
    exact (not_lt_of_ge hlower') hlower

theorem IsDirichletNontrivialLFunctionZero.dist_two_add_mul_I_le_six
    {q : ℕ} [NeZero q] {chi : DirichletCharacter ℂ q}
    {rho : ℂ} (hrho : DirichletCharacter.LFunction chi rho = 0 ∧
      0 < rho.re ∧ rho.re < 1)
    {t : ℝ} (hheight : |rho.im - t| ≤ 1) :
    dist rho ((2 : ℂ) + t * Complex.I) ≤ 6 :=
  (Metric.mem_closedBall.mp
    (mem_closedBall_three_of_openStrip_of_localHeight
      hrho.2.1 hrho.2.2 hheight)).trans (by norm_num)

end

theorem sum_natCast_le_finsum_intCast_pair
    {α : Type*} (S : Finset α) (m : α → ℕ)
    (D₁ D₂ : α → ℤ)
    (hD₁finite : D₁.support.Finite) (hD₂finite : D₂.support.Finite)
    (hD₁nonneg : 0 ≤ D₁) (hD₂nonneg : 0 ≤ D₂)
    (hm : ∀ a ∈ S, (m a : ℤ) ≤ D₁ a + D₂ a) :
    (∑ a ∈ S, (m a : ℝ)) ≤
      ((∑ᶠ a, D₁ a : ℤ) : ℝ) + ((∑ᶠ a, D₂ a : ℤ) : ℝ) := by
  have hs₁ : Summable D₁ := summable_of_hasFiniteSupport hD₁finite
  have hs₂ : Summable D₂ := summable_of_hasFiniteSupport hD₂finite
  have hb := (hs₁.add hs₂).sum_le_tsum S
    (fun a _ => add_nonneg (hD₁nonneg a) (hD₂nonneg a))
  rw [hs₁.tsum_add hs₂, tsum_eq_finsum hD₁finite, tsum_eq_finsum hD₂finite] at hb
  exact_mod_cast (Finset.sum_le_sum hm).trans hb

section
open Complex Set

theorem
    exists_nat_sum_dirichletNontrivialZeroShellMultiplicity_primitive_le :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ (q : ℕ) [NeZero q], 1 < q →
        ∀ (chi : DirichletCharacter ℂ q), chi.IsPrimitive →
          ∀ (T U : ℝ), 2 ≤ T → U ∈ Set.Icc T (T + 1) →
            (∑ rho ∈
                dirichletNontrivialLFunctionZeroShellFinset chi T U,
              (analyticOrderNatAt
                (DirichletCharacter.LFunction chi) rho : ℝ)) ≤
              4 * (A : ℝ) * Real.log ((q : ℝ) * (T + 2)) := by
  obtain ⟨A, hA, hmass⟩ :=
    exists_nat_finsum_divisor_LFunction_radiusSix_le
  refine ⟨A, hA, ?_⟩
  intro q _ hq chi hchi T U hT hU
  let Dplus : ℂ → ℤ :=
    MeromorphicOn.divisor (DirichletCharacter.LFunction chi)
      (closedBall ((2 : ℂ) + T * I) 6)
  let Dminus : ℂ → ℤ :=
    MeromorphicOn.divisor (DirichletCharacter.LFunction chi)
      (closedBall ((2 : ℂ) + ((-T : ℝ) : ℂ) * I) 6)
  have hchiNe : chi ≠ 1 := character_ne_one_of_isPrimitive hq chi hchi
  have hDplusFinite : Dplus.support.Finite := by
    simpa [Dplus] using divisor_LFunction_closedBall_support_finite
      hchiNe ((2 : ℂ) + T * I) 6
  have hDminusFinite : Dminus.support.Finite := by
    simpa [Dminus] using divisor_LFunction_closedBall_support_finite
      hchiNe ((2 : ℂ) + ((-T : ℝ) : ℂ) * I) 6
  have hDplusNonneg : 0 ≤ Dplus := by
    intro rho
    exact (divisor_LFunction_nonneg hchiNe
      (closedBall ((2 : ℂ) + T * I) 6)) rho
  have hDminusNonneg : 0 ≤ Dminus := by
    intro rho
    exact (divisor_LFunction_nonneg hchiNe
      (closedBall ((2 : ℂ) + ((-T : ℝ) : ℂ) * I) 6)) rho
  have hcoeff : ∀ rho ∈
      dirichletNontrivialLFunctionZeroShellFinset chi T U,
      (analyticOrderNatAt
          (DirichletCharacter.LFunction chi) rho : ℤ) ≤
        Dplus rho + Dminus rho := by
    intro rho hrho
    obtain ⟨hzero, hlower, hupper⟩ :=
      (mem_dirichletNontrivialLFunctionZeroShellFinset_iff
        (show 0 ≤ T by linarith) hU.1).mp hrho
    by_cases him : 0 ≤ rho.im
    · rw [abs_of_nonneg him] at hlower hupper
      have hheight : |rho.im - T| ≤ 1 := by
        rw [abs_le]
        constructor <;> linarith [hU.2]
      have hdisk := IsDirichletNontrivialLFunctionZero.dist_two_add_mul_I_le_six
          hzero hheight
      have hDplus : Dplus rho =
          (analyticOrderNatAt
            (DirichletCharacter.LFunction chi) rho : ℤ) := by
        have happly := divisor_LFunction_radiusSix_apply hq chi hchi T rho
        rw [ite_eq_left hdisk] at happly
        simpa [Dplus] using happly
      rw [hDplus]
      exact le_add_of_nonneg_right (hDminusNonneg rho)
    · have himNonpos : rho.im ≤ 0 := le_of_not_ge him
      rw [abs_of_nonpos himNonpos] at hlower hupper
      have hheight : |rho.im - (-T)| ≤ 1 := by
        rw [sub_neg_eq_add, abs_le]
        constructor <;> linarith [hU.2]
      have hdisk := IsDirichletNontrivialLFunctionZero.dist_two_add_mul_I_le_six
          hzero hheight
      have hDminus : Dminus rho =
          (analyticOrderNatAt
            (DirichletCharacter.LFunction chi) rho : ℤ) := by
        have happly := divisor_LFunction_radiusSix_apply hq chi hchi (-T) rho
        rw [ite_eq_left hdisk] at happly
        simpa [Dminus] using happly
      rw [hDminus]
      exact le_add_of_nonneg_left (hDplusNonneg rho)
  have hsubmass := sum_natCast_le_finsum_intCast_pair
    (dirichletNontrivialLFunctionZeroShellFinset chi T U)
    (fun rho => analyticOrderNatAt
      (DirichletCharacter.LFunction chi) rho)
    Dplus Dminus hDplusFinite hDminusFinite
    hDplusNonneg hDminusNonneg hcoeff
  have hplus : ((∑ᶠ rho, Dplus rho : ℤ) : ℝ) ≤
      2 * (A : ℝ) * Real.log ((q : ℝ) * (T + 2)) := by
    simpa [Dplus, abs_of_nonneg (show 0 ≤ T by linarith)] using
      hmass q hq chi hchi T
  have hminus : ((∑ᶠ rho, Dminus rho : ℤ) : ℝ) ≤
      2 * (A : ℝ) * Real.log ((q : ℝ) * (T + 2)) := by
    simpa [Dminus, abs_of_nonneg (show 0 ≤ T by linarith)] using
      hmass q hq chi hchi (-T)
  calc
    (∑ rho ∈ dirichletNontrivialLFunctionZeroShellFinset chi T U,
        (analyticOrderNatAt
          (DirichletCharacter.LFunction chi) rho : ℝ)) ≤
        ((∑ᶠ rho, Dplus rho : ℤ) : ℝ) +
          ((∑ᶠ rho, Dminus rho : ℤ) : ℝ) := hsubmass
    _ ≤ 2 * (A : ℝ) * Real.log ((q : ℝ) * (T + 2)) +
        2 * (A : ℝ) * Real.log ((q : ℝ) * (T + 2)) :=
      add_le_add hplus hminus
    _ = 4 * (A : ℝ) * Real.log ((q : ℝ) * (T + 2)) := by ring

section RiemannZetaRadiusTwelve
theorem radiusTwelveRiemannZetaSphere_geometry
    (t : ℝ) (z : ℂ)
    (hz : z ∈ sphere ((2 : ℂ) + t * I) 12) :
    -(10 : ℝ) ≤ z.re ∧ z.re ≤ 14 ∧
      |z.im| + 2 ≤ 7 * (|t| + 2) ∧
        ‖z‖ ≤ 7 * (|t| + 2) := by
  obtain ⟨hlo, hhi, him⟩ :=
    radiusTwelveSphere_geometry t z hz
  refine ⟨hlo, hhi, him, ?_⟩
  have hn := norm_le_of_mem_closedBall (sphere_subset_closedBall hz)
  have hc : ‖(2 : ℂ) + t * I‖ ≤ 2 + |t| := by
    simpa [Real.norm_eq_abs] using norm_add_le (2 : ℂ) ((t : ℂ) * I)
  linarith only [hn, hc, abs_nonneg t]

theorem exists_pos_norm_riemannZeta₁_closedBall_one_le_radiusTwelve :
    ∃ C : ℝ, 0 < C ∧ ∀ z ∈ closedBall (0 : ℂ) 1,
      ‖riemannZeta₁ z‖ ≤ C :=
  exists_pos_norm_riemannZeta₁_closedBall_one_le

end RiemannZetaRadiusTwelve

theorem exists_nat_norm_riemannZeta₁_radiusTwelveSphere_le :
    ∃ E : ℕ, 1 ≤ E ∧
      ∀ (t : ℝ) (z : ℂ),
        z ∈ sphere ((2 : ℂ) + t * I) 12 →
          ‖riemannZeta₁ z‖ ≤ (|t| + 2) ^ E := by
  obtain ⟨Ccompact, _hCcompact, hcompact⟩ :=
    exists_pos_norm_riemannZeta₁_closedBall_one_le_radiusTwelve
  obtain ⟨Cgamma, hCgamma, hgamma⟩ :=
    exists_norm_gammaFactor_ratio_fixedStrip_le
  let K : ℝ := max Ccompact (8 * Cgamma * 7 ^ 11)
  obtain ⟨n : ℕ, hn⟩ := exists_nat_ge K
  refine ⟨n + 21, by omega, ?_⟩
  intro t z hz
  obtain ⟨hzlo, _hzhi, hzheight, hznorm⟩ :=
    radiusTwelveRiemannZetaSphere_geometry t z hz
  let T : ℝ := |t| + 2
  have hT2 : (2 : ℝ) ≤ T := by dsimp [T]; linarith [abs_nonneg t]
  have hT1 : (1 : ℝ) ≤ T := one_le_two.trans hT2
  have hT0 : (0 : ℝ) ≤ T := zero_le_one.trans hT1
  have hzsub : ‖z - 1‖ ≤ 8 * T := by
    calc
      ‖z - 1‖ ≤ ‖z‖ + ‖(1 : ℂ)‖ := norm_sub_le _ _
      _ ≤ 7 * T + 1 := add_le_add (by simpa [T] using hznorm) (by norm_num)
      _ ≤ 8 * T := by linarith
  have hKpow : K ≤ T ^ n := by
    calc
      K ≤ (n : ℝ) := hn
      _ ≤ 2 ^ n := natCast_le_two_pow n
      _ ≤ T ^ n := pow_le_pow_left₀ (by norm_num) hT2 n
  have h120 : (120 : ℝ) ≤ T ^ 7 := by
    have h := pow_le_pow_left₀ (by norm_num : (0 : ℝ) ≤ 2) hT2 7
    norm_num at h ⊢
    linarith
  by_cases hright : (1 / 2 : ℝ) ≤ z.re
  · have habel := norm_riemannZeta₁_le_abel z (by linarith)
    have hrightBound : ‖riemannZeta₁ z‖ ≤ T ^ 9 := by
      calc
        ‖riemannZeta₁ z‖ ≤ ‖z‖ + ‖z‖ * ‖z - 1‖ / z.re := habel
        _ ≤ 7 * T + (7 * T) * (8 * T) / (1 / 2 : ℝ) := by gcongr
        _ = 7 * T + 112 * T ^ 2 := by ring
        _ ≤ 120 * T ^ 2 := by nlinarith [sq_nonneg T]
        _ ≤ T ^ 7 * T ^ 2 :=
          mul_le_mul_of_nonneg_right h120 (sq_nonneg T)
        _ = T ^ 9 := by ring
    exact hrightBound.trans (pow_le_pow_right₀ hT1 (by omega))
  · have hzleft : z.re ≤ (1 / 2 : ℝ) := le_of_not_ge hright
    by_cases hzsmall : ‖z‖ ≤ 1
    · have hzball : z ∈ closedBall (0 : ℂ) 1 := by
        simpa [mem_closedBall, dist_zero_right] using hzsmall
      calc
        ‖riemannZeta₁ z‖ ≤ Ccompact := hcompact z hzball
        _ ≤ K := le_max_left _ _
        _ ≤ T ^ n := hKpow
        _ ≤ T ^ (n + 21) := pow_le_pow_right₀ hT1 (by omega)
    · have hz0 : z ≠ 0 := by
        intro h
        subst z
        simp at hzsmall
      have hreflect := riemannZeta₁_eq_reflection_of_re_le z hz0 hzleft
      have hreflectNorm : ‖1 - z‖ ≤ 8 * T := by
        rw [show 1 - z = -(z - 1) by ring, norm_neg]
        exact hzsub
      have hreflectSub : ‖(1 - z) - 1‖ ≤ 7 * T := by
        simpa only [sub_sub_cancel_left, norm_neg] using
          (show ‖z‖ ≤ 7 * T by simpa [T] using hznorm)
      have hreflectAbel :=
        norm_riemannZeta₁_le_abel (1 - z) (by simp; linarith)
      have hreflectBound : ‖riemannZeta₁ (1 - z)‖ ≤ T ^ 9 := by
        calc
          ‖riemannZeta₁ (1 - z)‖ ≤
              ‖1 - z‖ + ‖1 - z‖ * ‖(1 - z) - 1‖ / (1 - z).re :=
            hreflectAbel
          _ ≤ 8 * T + (8 * T) * (7 * T) / (1 / 2 : ℝ) := by
            gcongr
            · simp
              linarith
          _ = 8 * T + 112 * T ^ 2 := by ring
          _ ≤ 120 * T ^ 2 := by nlinarith [sq_nonneg T]
          _ ≤ T ^ 7 * T ^ 2 :=
            mul_le_mul_of_nonneg_right h120 (sq_nonneg T)
          _ = T ^ 9 := by ring
      have hratio : ‖(1 - z) / z‖ ≤ 8 * T := by
        rw [norm_div]
        have hzOne : (1 : ℝ) ≤ ‖z‖ := le_of_not_ge hzsmall
        exact (div_le_iff₀ (norm_pos_iff.mpr hz0)).2 (by
          calc
            ‖1 - z‖ ≤ 8 * T := hreflectNorm
            _ ≤ 8 * T * ‖z‖ :=
              le_mul_of_one_le_right (by positivity) hzOne)
      have hgamma' := hgamma 1 (1 : DirichletCharacter ℂ 1) z hzlo hzleft
      have hgammaBound :
          ‖DirichletCharacter.gammaFactor
                (1 : DirichletCharacter ℂ 1)⁻¹ (1 - z) /
              DirichletCharacter.gammaFactor
                (1 : DirichletCharacter ℂ 1) z‖ ≤
            Cgamma * (7 * T) ^ 11 := by
        exact hgamma'.trans (mul_le_mul_of_nonneg_left
          (pow_le_pow_left₀ (by positivity)
            (by simpa [T] using hzheight) 11) hCgamma.le)
      have hinvOne : (1 : DirichletCharacter ℂ 1)⁻¹ = 1 := inv_one
      rw [hinvOne] at hgammaBound
      rw [hreflect, norm_mul, norm_mul]
      calc
        ‖(1 - z) / z‖ * ‖riemannZeta₁ (1 - z)‖ *
              ‖DirichletCharacter.gammaFactor
                    (1 : DirichletCharacter ℂ 1) (1 - z) /
                DirichletCharacter.gammaFactor
                    (1 : DirichletCharacter ℂ 1) z‖ ≤
            (8 * T) * T ^ 9 * (Cgamma * (7 * T) ^ 11) := by gcongr
        _ = (8 * Cgamma * 7 ^ 11) * T ^ 21 := by ring
        _ ≤ K * T ^ 21 :=
          mul_le_mul_of_nonneg_right (le_max_right _ _) (pow_nonneg hT0 21)
        _ ≤ T ^ n * T ^ 21 :=
          mul_le_mul_of_nonneg_right hKpow (pow_nonneg hT0 21)
        _ = T ^ (n + 21) := by rw [pow_add]

theorem exists_nat_norm_riemannZeta₁_radiusTwelveSphere_le_exp_mul_center :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ (t : ℝ) (z : ℂ),
        z ∈ sphere ((2 : ℂ) + t * I) 12 →
          ‖riemannZeta₁ z‖ ≤
            Real.exp ((A : ℝ) * Real.log (|t| + 2)) *
              ‖riemannZeta₁ ((2 : ℂ) + t * I)‖ := by
  obtain ⟨E, _hE, habsolute⟩ :=
    exists_nat_norm_riemannZeta₁_radiusTwelveSphere_le
  let A := max 37 (E + 2)
  refine ⟨A, Nat.le_max_left 37 (E + 2), ?_⟩
  intro t z hz
  let c : ℂ := (2 : ℂ) + t * I
  let T : ℝ := |t| + 2
  have hT2 : (2 : ℝ) ≤ T := by dsimp [T]; linarith [abs_nonneg t]
  have hTpos : 0 < T := zero_lt_two.trans_le hT2
  have hc1 : c ≠ 1 := by
    intro h
    have := congrArg Complex.re h
    simp [c] at this
  have hzeta : riemannZeta c ≠ 0 :=
    riemannZeta_ne_zero_of_one_le_re (by simp [c])
  have hcenter : riemannZeta₁ c = (c - 1) * riemannZeta c := by
    rw [riemannZeta_eq_inv_sub_mul hc1]
    field_simp
  have hcsubNorm : (1 : ℝ) ≤ ‖c - 1‖ := by
    rw [show c - 1 = (1 : ℂ) + t * I by dsimp [c]; ring]
    simpa using Complex.abs_re_le_norm ((1 : ℂ) + t * I)
  have hcsubInv : ‖(c - 1)⁻¹‖ ≤ 1 := by
    rw [norm_inv]
    exact inv_le_one₀ (norm_pos_iff.mpr (sub_ne_zero.mpr hc1)) |>.2 hcsubNorm
  have hzetaInv : ‖(riemannZeta c)⁻¹‖ ≤ 3 := by
    have h := norm_inv_LFunction_two_add_mul_I_le_three
      (1 : DirichletCharacter ℂ 1) t
    simpa [DirichletCharacter.LFunction_modOne_eq, c] using h
  have hcenterInv : ‖(riemannZeta₁ c)⁻¹‖ ≤ 3 := by
    rw [hcenter, mul_inv_rev, norm_mul]
    nlinarith [mul_le_mul hcsubInv hzetaInv (norm_nonneg _)
      (by norm_num : (0 : ℝ) ≤ 1)]
  have hcenterNe : riemannZeta₁ c ≠ 0 := by
    rw [hcenter]
    exact mul_ne_zero (sub_ne_zero.mpr hc1) hzeta
  have honeCenter : (1 : ℝ) ≤ 3 * ‖riemannZeta₁ c‖ := by
    calc
      (1 : ℝ) = ‖(riemannZeta₁ c)⁻¹ * riemannZeta₁ c‖ := by
        rw [inv_mul_cancel₀ hcenterNe, norm_one]
      _ = ‖(riemannZeta₁ c)⁻¹‖ * ‖riemannZeta₁ c‖ := norm_mul _ _
      _ ≤ 3 * ‖riemannZeta₁ c‖ :=
        mul_le_mul_of_nonneg_right hcenterInv (norm_nonneg _)
  have hTcenter : (1 : ℝ) ≤ T ^ 2 * ‖riemannZeta₁ c‖ := by
    exact honeCenter.trans (mul_le_mul_of_nonneg_right
      (by nlinarith [sq_nonneg T]) (norm_nonneg _))
  have habs : ‖riemannZeta₁ z‖ ≤ T ^ E := by
    simpa [T, c] using habsolute t z (by simpa [c] using hz)
  have hEA : E + 2 ≤ A := Nat.le_max_right 37 (E + 2)
  have hpowEA : T ^ (E + 2) ≤ T ^ A :=
    pow_le_pow_right₀ (by linarith : (1 : ℝ) ≤ T) hEA
  have hexp : Real.exp ((A : ℝ) * Real.log T) = T ^ A := by
    rw [Real.exp_nat_mul, Real.exp_log hTpos]
  calc
    ‖riemannZeta₁ z‖ ≤ T ^ E := habs
    _ = T ^ E * 1 := by ring
    _ ≤ T ^ E * (T ^ 2 * ‖riemannZeta₁ c‖) :=
      mul_le_mul_of_nonneg_left hTcenter (pow_nonneg hTpos.le E)
    _ = T ^ (E + 2) * ‖riemannZeta₁ c‖ := by rw [pow_add]; ring
    _ ≤ T ^ A * ‖riemannZeta₁ c‖ :=
      mul_le_mul_of_nonneg_right hpowEA (norm_nonneg _)
    _ = Real.exp ((A : ℝ) * Real.log T) * ‖riemannZeta₁ c‖ := by rw [hexp]
    _ = Real.exp ((A : ℝ) * Real.log (|t| + 2)) *
        ‖riemannZeta₁ ((2 : ℂ) + t * I)‖ := rfl

section RiemannZetaFixedDisk
theorem analyticOnNhd_riemannZeta₁_fixedDisk :
    AnalyticOnNhd ℂ riemannZeta₁ Set.univ :=
  fun z _ => differentiable_riemannZeta₁.analyticAt z

theorem analyticOrderAt_riemannZeta₁_ne_top_fixedDisk (s : ℂ) :
    analyticOrderAt riemannZeta₁ s ≠ ⊤ :=
  analyticOrderAt_riemannZeta₁_ne_top s

end RiemannZetaFixedDisk

theorem divisor_riemannZeta₁_apply_eq_analyticOrderNatAt
    {U : Set ℂ} {s : ℂ} (hsU : s ∈ U) :
    MeromorphicOn.divisor riemannZeta₁ U s =
      (analyticOrderNatAt riemannZeta₁ s : ℤ) := by
  rw [MeromorphicOn.AnalyticOnNhd.divisor_apply
    (analyticOnNhd_riemannZeta₁_fixedDisk.mono (Set.subset_univ U)) hsU]
  have hfinite := analyticOrderAt_riemannZeta₁_ne_top_fixedDisk s
  rw [← Nat.cast_analyticOrderNatAt hfinite, ENat.map_natCast,
    WithTop.untop₀_coe]

theorem mem_support_divisor_riemannZeta₁_iff
    {U : Set ℂ} {s : ℂ} (hsU : s ∈ U) :
    s ∈ (MeromorphicOn.divisor riemannZeta₁ U).support ↔
      riemannZeta₁ s = 0 := by
  rw [Function.mem_support,
    MeromorphicOn.AnalyticOnNhd.divisor_apply
      (analyticOnNhd_riemannZeta₁_fixedDisk.mono (Set.subset_univ U)) hsU]
  have htop := analyticOrderAt_riemannZeta₁_ne_top_fixedDisk s
  lift analyticOrderAt riemannZeta₁ s to ℕ using htop with n hn
  simp only [ENat.map_natCast, WithTop.untop₀_coe]
  constructor
  · intro hnInt
    have hnNat : n ≠ 0 := by exact_mod_cast hnInt
    have horder : analyticOrderAt riemannZeta₁ s ≠ 0 := by
      rw [← hn]
      exact_mod_cast hnNat
    exact (differentiable_riemannZeta₁.analyticAt s
      |>.analyticOrderAt_ne_zero).mp horder
  · intro hzero
    have horder : analyticOrderAt riemannZeta₁ s ≠ 0 :=
      (differentiable_riemannZeta₁.analyticAt s
        |>.analyticOrderAt_ne_zero).mpr hzero
    rw [← hn] at horder
    exact_mod_cast horder

theorem divisor_riemannZeta₁_nonneg (U : Set ℂ) :
    0 ≤ MeromorphicOn.divisor riemannZeta₁ U :=
  MeromorphicOn.AnalyticOnNhd.divisor_nonneg
    (analyticOnNhd_riemannZeta₁_fixedDisk.mono (Set.subset_univ U))

theorem divisor_riemannZeta₁_closedBall_support_finite (c : ℂ) (R : ℝ) :
    (MeromorphicOn.divisor riemannZeta₁
      (closedBall c R)).support.Finite :=
  (analyticOnNhd_riemannZeta₁_fixedDisk.mono
      (Set.subset_univ (closedBall c R))).meromorphicOn
    |>.divisor_support_finite_of_subset (isCompact_closedBall c R)
      Set.Subset.rfl

theorem neg_logDeriv_riemannZeta_eq_pole_sub_regularized_of_ne_zero
    (s : ℂ) (hsOne : s ≠ 1) (hsZero : riemannZeta s ≠ 0) :
    -logDeriv riemannZeta s =
      (s - 1)⁻¹ - logDeriv riemannZeta₁ s := by
  have hsub : s - 1 ≠ 0 := sub_ne_zero.mpr hsOne
  have hzetaOne : riemannZeta₁ s ≠ 0 := by
    intro hzero
    have hfactor := riemannZeta_eq_inv_sub_mul hsOne
    rw [hzero, mul_zero] at hfactor
    exact hsZero hfactor
  rw [logDeriv_apply, logDeriv_apply,
    deriv_riemannZeta_eq_neg_inv_sub_sq_mul_add hsOne,
    riemannZeta_eq_inv_sub_mul hsOne]
  field_simp [hsub, hzetaOne]
  ring

theorem
    exists_nat_norm_logDeriv_riemannZeta₁_sub_radiusSix_divisor_finsum_le :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ (t : ℝ) (s : ℂ),
        s ∈ closedBall ((2 : ℂ) + t * I) 3 →
          riemannZeta₁ s ≠ 0 →
            ‖logDeriv riemannZeta₁ s -
                ∑ᶠ rho : ℂ,
                  ((MeromorphicOn.divisor riemannZeta₁
                    (closedBall ((2 : ℂ) + t * I) 6)) rho : ℂ) /
                      (s - rho)‖ ≤
              16 * ((A : ℝ) * Real.log (|t| + 2)) / 3 := by
  obtain ⟨A, hA, hgrowth⟩ :=
    exists_nat_norm_riemannZeta₁_radiusTwelveSphere_le_exp_mul_center
  refine ⟨A, hA, ?_⟩
  intro t s hs hfs
  let c : ℂ := (2 : ℂ) + t * I
  let T : ℝ := |t| + 2
  let M : ℝ := (A : ℝ) * Real.log T
  have hT2 : (2 : ℝ) ≤ T := by dsimp [T]; linarith [abs_nonneg t]
  have hM : 0 ≤ M :=
    mul_nonneg (Nat.cast_nonneg A) (Real.log_nonneg (by linarith))
  have hf : AnalyticOnNhd ℂ riemannZeta₁ (closedBall c (4 * (3 : ℝ))) :=
    analyticOnNhd_riemannZeta₁_fixedDisk.mono
      (Set.subset_univ (closedBall c (4 * (3 : ℝ))))
  have hcOne : c ≠ 1 := by
    intro h
    have hre := congrArg Complex.re h
    simp [c] at hre
  have hzeta : riemannZeta c ≠ 0 :=
    riemannZeta_ne_zero_of_one_le_re (by simp [c])
  have hc : riemannZeta₁ c ≠ 0 := by
    intro hzero
    have hfactor := riemannZeta_eq_inv_sub_mul hcOne
    rw [hzero, mul_zero] at hfactor
    exact hzeta hfactor
  have hbound : ∀ z ∈ sphere c (4 * (3 : ℝ)),
      ‖riemannZeta₁ z‖ ≤ Real.exp M * ‖riemannZeta₁ c‖ := by
    intro z hz
    norm_num at hz
    simpa [c, M, T] using hgrowth t z (by simpa [c] using hz)
  have hfixed := norm_logDeriv_sub_divisor_finsum_le
    (f := riemannZeta₁) (c := c) (s := s) (R := (3 : ℝ)) (M := M)
    (by norm_num) hM hf hc hbound (by simpa [c] using hs) hfs
  rw [show (2 : ℝ) * 3 = 6 by norm_num] at hfixed
  simpa [M, T, mul_assoc] using hfixed

theorem exists_nat_finsum_divisor_riemannZeta₁_radiusSix_le :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ t : ℝ,
        ((∑ᶠ rho : ℂ,
            MeromorphicOn.divisor riemannZeta₁
              (closedBall ((2 : ℂ) + t * I) 6) rho : ℤ) : ℝ) ≤
          2 * (A : ℝ) * Real.log (|t| + 2) := by
  obtain ⟨A, hA, hgrowth⟩ :=
    exists_nat_norm_riemannZeta₁_radiusTwelveSphere_le_exp_mul_center
  refine ⟨A, hA, ?_⟩
  intro t
  let c : ℂ := (2 : ℂ) + t * I
  let T : ℝ := |t| + 2
  let K : ℝ := (A : ℝ) * Real.log T
  let M : ℝ := Real.exp K * ‖riemannZeta₁ c‖
  have hT2 : (2 : ℝ) ≤ T := by dsimp [T]; linarith [abs_nonneg t]
  have hT1 : (1 : ℝ) ≤ T := by linarith
  have hcOne : c ≠ 1 := by
    intro h
    have hre := congrArg Complex.re h
    simp [c] at hre
  have hzeta : riemannZeta c ≠ 0 :=
    riemannZeta_ne_zero_of_one_le_re (by simp [c])
  have hcenter : riemannZeta₁ c = (c - 1) * riemannZeta c := by
    rw [riemannZeta_eq_inv_sub_mul hcOne]
    field_simp
  have hcsubNorm : (1 : ℝ) ≤ ‖c - 1‖ := by
    rw [show c - 1 = (1 : ℂ) + t * I by dsimp [c]; ring]
    simpa using Complex.abs_re_le_norm ((1 : ℂ) + t * I)
  have hcsubInv : ‖(c - 1)⁻¹‖ ≤ 1 := by
    rw [norm_inv]
    exact inv_le_one₀ (norm_pos_iff.mpr (sub_ne_zero.mpr hcOne)) |>.2
      hcsubNorm
  have hzetaInv : ‖(riemannZeta c)⁻¹‖ ≤ 3 := by
    have h := norm_inv_LFunction_two_add_mul_I_le_three
      (1 : DirichletCharacter ℂ 1) t
    simpa [DirichletCharacter.LFunction_modOne_eq, c] using h
  have hcenterInv : ‖(riemannZeta₁ c)⁻¹‖ ≤ 3 := by
    rw [hcenter, mul_inv_rev, norm_mul]
    nlinarith [mul_le_mul hcsubInv hzetaInv (norm_nonneg _)
      (by norm_num : (0 : ℝ) ≤ 1)]
  have hc : riemannZeta₁ c ≠ 0 := by
    rw [hcenter]
    exact mul_ne_zero (sub_ne_zero.mpr hcOne) hzeta
  have honeCenter : (1 : ℝ) ≤ 3 * ‖riemannZeta₁ c‖ := by
    calc
      (1 : ℝ) = ‖(riemannZeta₁ c)⁻¹ * riemannZeta₁ c‖ := by
        rw [inv_mul_cancel₀ hc, norm_one]
      _ = ‖(riemannZeta₁ c)⁻¹‖ * ‖riemannZeta₁ c‖ := norm_mul _ _
      _ ≤ 3 * ‖riemannZeta₁ c‖ :=
        mul_le_mul_of_nonneg_right hcenterInv (norm_nonneg _)
  have hKnonneg : 0 ≤ K :=
    mul_nonneg (Nat.cast_nonneg A) (Real.log_nonneg hT1)
  have hexp : Real.exp K = T ^ A := by
    dsimp [K]
    rw [Real.exp_nat_mul, Real.exp_log (by linarith : 0 < T)]
  have hthreeExp : (3 : ℝ) ≤ Real.exp K := by
    rw [hexp]
    have h2A : (2 : ℝ) ^ 2 ≤ T ^ A := by
      calc
        (2 : ℝ) ^ 2 ≤ T ^ 2 := pow_le_pow_left₀ (by norm_num) hT2 2
        _ ≤ T ^ A := pow_le_pow_right₀ hT1 (by omega)
    norm_num at h2A ⊢
    linarith
  have hM : 1 ≤ M := by
    calc
      (1 : ℝ) ≤ 3 * ‖riemannZeta₁ c‖ := honeCenter
      _ ≤ Real.exp K * ‖riemannZeta₁ c‖ :=
        mul_le_mul_of_nonneg_right hthreeExp (norm_nonneg _)
      _ = M := rfl
  have hf : AnalyticOnNhd ℂ riemannZeta₁ (closedBall c |(12 : ℝ)|) :=
    fun z _ => differentiable_riemannZeta₁.analyticAt z
  have hbound : ∀ z ∈ sphere c |(12 : ℝ)|, ‖riemannZeta₁ z‖ ≤ M := by
    intro z hz
    simpa [M, K, T, c] using hgrowth t z (by simpa using hz)
  have hjensen := hf.sum_divisor_le
    (r := (6 : ℝ)) (R := (12 : ℝ)) (M := M)
    (by norm_num) (by norm_num) hM hc hbound
  rw [show |(6 : ℝ)| = 6 by norm_num] at hjensen
  norm_num at hjensen
  have hratio : M / ‖riemannZeta₁ c‖ = Real.exp K := by
    dsimp [M]
    exact mul_div_cancel_right₀ _ (norm_ne_zero_iff.mpr hc)
  have hquot : K / Real.log 2 ≤ 2 * K := by
    apply (div_le_iff₀ (by positivity : 0 < Real.log 2)).2
    nlinarith [Real.log_two_gt_d9]
  calc
    ((∑ᶠ rho : ℂ,
        MeromorphicOn.divisor riemannZeta₁
          (closedBall ((2 : ℂ) + t * I) 6) rho : ℤ) : ℝ) ≤
        Real.log (M / ‖riemannZeta₁ c‖) / Real.log 2 := by
          simpa [c] using hjensen
    _ = K / Real.log 2 := by rw [hratio, Real.log_exp]
    _ ≤ 2 * K := hquot
    _ = 2 * (A : ℝ) * Real.log (|t| + 2) := by
      simp [K, T]
      ring

end

section
open Complex Set

theorem analyticOrderNatAt_LFunction_modOne_eq_riemannZeta₁_of_ne_one
    {rho : ℂ} (hrho : rho ≠ 1) :
    analyticOrderNatAt
        (DirichletCharacter.LFunction
          (1 : DirichletCharacter ℂ 1)) rho =
      analyticOrderNatAt riemannZeta₁ rho := by
  rw [DirichletCharacter.LFunction_modOne_eq]
  have heq : riemannZeta₁ =ᶠ[𝓝 rho]
      fun s => (s - 1) * riemannZeta s := by
    filter_upwards [eventually_ne_nhds hrho] with s hs
    rw [riemannZeta_eq_inv_sub_mul hs]
    field_simp [sub_ne_zero.mpr hs]
  have hlinear : AnalyticAt ℂ (fun s : ℂ => s - 1) rho := by fun_prop
  have hzeta : AnalyticAt ℂ riemannZeta rho :=
    analyticOn_riemannZeta rho (by simpa using hrho)
  have horder :
      analyticOrderAt riemannZeta₁ rho =
        analyticOrderAt riemannZeta rho := by
    calc
      analyticOrderAt riemannZeta₁ rho =
          analyticOrderAt (fun s => (s - 1) * riemannZeta s) rho :=
        analyticOrderAt_congr heq
      _ = analyticOrderAt (fun s : ℂ => s - 1) rho +
          analyticOrderAt riemannZeta rho :=
        analyticOrderAt_mul hlinear hzeta
      _ = 0 + analyticOrderAt riemannZeta rho := by
        rw [hlinear.analyticOrderAt_eq_zero.mpr (sub_ne_zero.mpr hrho)]
      _ = analyticOrderAt riemannZeta rho := zero_add _
  exact congrArg ENat.toNat horder.symm

theorem
    exists_nat_sum_dirichletNontrivialZeroShellMultiplicity_modOne_le :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ (T U : ℝ), 2 ≤ T → U ∈ Set.Icc T (T + 1) →
        (∑ rho ∈ dirichletNontrivialLFunctionZeroShellFinset
            (1 : DirichletCharacter ℂ 1) T U,
          (analyticOrderNatAt
            (DirichletCharacter.LFunction
              (1 : DirichletCharacter ℂ 1)) rho : ℝ)) ≤
          4 * (A : ℝ) * Real.log (T + 2) := by
  obtain ⟨A, hA, hmass⟩ :=
    exists_nat_finsum_divisor_riemannZeta₁_radiusSix_le
  refine ⟨A, hA, ?_⟩
  intro T U hT hU
  let Dplus : ℂ → ℤ :=
    MeromorphicOn.divisor riemannZeta₁
      (closedBall ((2 : ℂ) + T * I) 6)
  let Dminus : ℂ → ℤ :=
    MeromorphicOn.divisor riemannZeta₁
      (closedBall ((2 : ℂ) + ((-T : ℝ) : ℂ) * I) 6)
  have hDplusFinite : Dplus.support.Finite := by
    simpa [Dplus] using divisor_riemannZeta₁_closedBall_support_finite
      ((2 : ℂ) + T * I) 6
  have hDminusFinite : Dminus.support.Finite := by
    simpa [Dminus] using divisor_riemannZeta₁_closedBall_support_finite
      ((2 : ℂ) + ((-T : ℝ) : ℂ) * I) 6
  have hDplusNonneg : 0 ≤ Dplus := by
    intro rho
    exact (divisor_riemannZeta₁_nonneg
      (closedBall ((2 : ℂ) + T * I) 6)) rho
  have hDminusNonneg : 0 ≤ Dminus := by
    intro rho
    exact (divisor_riemannZeta₁_nonneg
      (closedBall ((2 : ℂ) + ((-T : ℝ) : ℂ) * I) 6)) rho
  have hcoeff : ∀ rho ∈ dirichletNontrivialLFunctionZeroShellFinset
      (1 : DirichletCharacter ℂ 1) T U,
      (analyticOrderNatAt
          (DirichletCharacter.LFunction
            (1 : DirichletCharacter ℂ 1)) rho : ℤ) ≤
        Dplus rho + Dminus rho := by
    intro rho hrho
    obtain ⟨hzero, hlower, hupper⟩ :=
      (mem_dirichletNontrivialLFunctionZeroShellFinset_iff
        (show 0 ≤ T by linarith) hU.1).mp hrho
    have hrhoOne : rho ≠ 1 := by
      intro hrho
      have hre := congrArg Complex.re hrho
      norm_num at hre
      linarith [hzero.2.2]
    have horder :=
      analyticOrderNatAt_LFunction_modOne_eq_riemannZeta₁_of_ne_one hrhoOne
    by_cases him : 0 ≤ rho.im
    · rw [abs_of_nonneg him] at hlower hupper
      have hheight : |rho.im - T| ≤ 1 := by
        rw [abs_le]
        constructor <;> linarith [hU.2]
      have hdisk := IsDirichletNontrivialLFunctionZero.dist_two_add_mul_I_le_six
          hzero hheight
      have hDplus : Dplus rho =
          (analyticOrderNatAt riemannZeta₁ rho : ℤ) := by
        dsimp [Dplus]
        exact divisor_riemannZeta₁_apply_eq_analyticOrderNatAt
          (mem_closedBall.mpr hdisk)
      rw [horder, hDplus]
      exact le_add_of_nonneg_right (hDminusNonneg rho)
    · have himNonpos : rho.im ≤ 0 := le_of_not_ge him
      rw [abs_of_nonpos himNonpos] at hlower hupper
      have hheight : |rho.im - (-T)| ≤ 1 := by
        rw [sub_neg_eq_add, abs_le]
        constructor <;> linarith [hU.2]
      have hdisk := IsDirichletNontrivialLFunctionZero.dist_two_add_mul_I_le_six
          hzero hheight
      have hDminus : Dminus rho =
          (analyticOrderNatAt riemannZeta₁ rho : ℤ) := by
        dsimp [Dminus]
        exact divisor_riemannZeta₁_apply_eq_analyticOrderNatAt
          (mem_closedBall.mpr hdisk)
      rw [horder, hDminus]
      exact le_add_of_nonneg_left (hDplusNonneg rho)
  have hsubmass := sum_natCast_le_finsum_intCast_pair
    (dirichletNontrivialLFunctionZeroShellFinset
      (1 : DirichletCharacter ℂ 1) T U)
    (fun rho => analyticOrderNatAt
      (DirichletCharacter.LFunction
        (1 : DirichletCharacter ℂ 1)) rho)
    Dplus Dminus hDplusFinite hDminusFinite
    hDplusNonneg hDminusNonneg hcoeff
  have hplus : ((∑ᶠ rho, Dplus rho : ℤ) : ℝ) ≤
      2 * (A : ℝ) * Real.log (T + 2) := by
    simpa [Dplus, abs_of_nonneg (show 0 ≤ T by linarith)] using hmass T
  have hminus : ((∑ᶠ rho, Dminus rho : ℤ) : ℝ) ≤
      2 * (A : ℝ) * Real.log (T + 2) := by
    simpa [Dminus, abs_of_nonneg (show 0 ≤ T by linarith)] using hmass (-T)
  calc
    (∑ rho ∈ dirichletNontrivialLFunctionZeroShellFinset
        (1 : DirichletCharacter ℂ 1) T U,
      (analyticOrderNatAt
        (DirichletCharacter.LFunction
          (1 : DirichletCharacter ℂ 1)) rho : ℝ)) ≤
        ((∑ᶠ rho, Dplus rho : ℤ) : ℝ) +
          ((∑ᶠ rho, Dminus rho : ℤ) : ℝ) := hsubmass
    _ ≤ 2 * (A : ℝ) * Real.log (T + 2) +
        2 * (A : ℝ) * Real.log (T + 2) := add_le_add hplus hminus
    _ = 4 * (A : ℝ) * Real.log (T + 2) := by ring

end

section
open Complex Set

theorem
    exists_nat_sum_dirichletNontrivialZeroShellMultiplicity_of_isPrimitive_le :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q), chi.IsPrimitive →
          ∀ (T U : ℝ), 2 ≤ T → U ∈ Set.Icc T (T + 1) →
            (∑ rho ∈
                dirichletNontrivialLFunctionZeroShellFinset chi T U,
              (analyticOrderNatAt
                (DirichletCharacter.LFunction chi) rho : ℝ)) ≤
              4 * (A : ℝ) * Real.log ((q : ℝ) * (T + 2)) := by
  obtain ⟨Ap, hAp, hprimitive⟩ :=
    exists_nat_sum_dirichletNontrivialZeroShellMultiplicity_primitive_le
  obtain ⟨Az, hAz, hzeta⟩ :=
    exists_nat_sum_dirichletNontrivialZeroShellMultiplicity_modOne_le
  let A := max Ap Az
  refine ⟨A, hAp.trans (Nat.le_max_left Ap Az), ?_⟩
  intro q _ chi hchi T U hT hU
  have hlogNonneg : 0 ≤ Real.log ((q : ℝ) * (T + 2)) := by
    apply Real.log_nonneg
    have hq : (1 : ℝ) ≤ q := by
      exact_mod_cast Nat.one_le_iff_ne_zero.mpr (NeZero.ne q)
    nlinarith [mul_le_mul hq
      (show (1 : ℝ) ≤ T + 2 by linarith)
      (by norm_num : (0 : ℝ) ≤ 1) (by positivity : (0 : ℝ) ≤ q)]
  by_cases hqOne : q = 1
  · subst q
    have hchiOne : chi = (1 : DirichletCharacter ℂ 1) :=
      Subsingleton.elim _ _
    subst chi
    have hz := hzeta T U hT hU
    have hAzA : (Az : ℝ) ≤ A := by
      exact_mod_cast Nat.le_max_right Ap Az
    simpa only [Nat.cast_one, one_mul] using
      hz.trans (by nlinarith [Real.log_nonneg (by linarith : (1 : ℝ) ≤ T + 2)])
  · have hq : 1 < q := by
      have hqpos := Nat.pos_of_ne_zero (NeZero.ne q)
      omega
    have hp := hprimitive q hq chi hchi T U hT hU
    have hApA : (Ap : ℝ) ≤ A := by
      exact_mod_cast Nat.le_max_left Ap Az
    exact hp.trans (by nlinarith)

theorem
    exists_nat_norm_dirichletNontrivialZeroKernelSum_selected_sub_requested_le :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q), chi.IsPrimitive →
          ∀ (x T U : ℝ), 2 ≤ T → T ≤ x →
            U ∈ Set.Icc T (T + 1) →
              ‖dirichletNontrivialZeroKernelSum chi x U -
                  dirichletNontrivialZeroKernelSum chi x T‖ ≤
                32 * (A : ℝ) *
                  dirichletExplicitFormulaErrorScale x q T := by
  obtain ⟨A, hA, hmass⟩ :=
    exists_nat_sum_dirichletNontrivialZeroShellMultiplicity_of_isPrimitive_le
  refine ⟨A, hA, ?_⟩
  intro q _ chi hchi x T U hT hTx hU
  let L : ℝ := Real.log ((q : ℝ) * x)
  let M : ℝ := Real.log ((q : ℝ) * (T + 2))
  have hx : 2 ≤ x := hT.trans hTx
  have hxpos : 0 < x := by linarith
  have hTpos : 0 < T := by linarith
  have hq : (1 : ℝ) ≤ q := by
    exact_mod_cast Nat.one_le_iff_ne_zero.mpr (NeZero.ne q)
  have hq0 : (0 : ℝ) ≤ q := zero_le_one.trans hq
  have hqxPos : 0 < (q : ℝ) * x := mul_pos (by linarith) hxpos
  have hT2xSq : T + 2 ≤ x ^ 2 := by
    have hproduct : 0 ≤ (x - 2) * (x + 1) :=
      mul_nonneg (sub_nonneg.mpr hx) (by linarith)
    nlinarith
  have hqSq : (q : ℝ) ≤ (q : ℝ) ^ 2 := by
    nlinarith [mul_nonneg hq0 (sub_nonneg.mpr hq)]
  have hscale : (q : ℝ) * (T + 2) ≤ ((q : ℝ) * x) ^ 2 := by
    calc
      (q : ℝ) * (T + 2) ≤ (q : ℝ) * x ^ 2 :=
        mul_le_mul_of_nonneg_left hT2xSq hq0
      _ ≤ (q : ℝ) ^ 2 * x ^ 2 :=
        mul_le_mul_of_nonneg_right hqSq (sq_nonneg x)
      _ = ((q : ℝ) * x) ^ 2 := by ring_nf
  have hMle : M ≤ 2 * L := by
    dsimp [M, L]
    calc
      Real.log ((q : ℝ) * (T + 2)) ≤
          Real.log (((q : ℝ) * x) ^ 2) :=
        Real.log_le_log (mul_pos (by linarith) (by linarith)) hscale
      _ = 2 * Real.log ((q : ℝ) * x) := by
        rw [Real.log_pow]
        norm_num
  have hLhalf : (1 / 2 : ℝ) ≤ L := by
    have htwo : (2 : ℝ) ≤ (q : ℝ) * x := by
      nlinarith [mul_le_mul hq hx (by norm_num : (0 : ℝ) ≤ 2) hq0]
    have hhalfTwo : (1 / 2 : ℝ) ≤ Real.log 2 := by
      have h := Real.one_sub_inv_le_log_of_pos
        (show (0 : ℝ) < 2 by norm_num)
      norm_num at h ⊢
      exact h
    exact hhalfTwo.trans (by
      simpa [L] using Real.log_le_log (by norm_num) htwo)
  have hL0 : 0 ≤ L := by linarith
  have hMfour : M ≤ 4 * L ^ 2 := by
    have hLlinear : L ≤ 2 * L ^ 2 := by
      nlinarith [sq_nonneg (L - 1 / 2)]
    linarith
  have hkernel :=
    norm_dirichletNontrivialZeroKernelSum_sub_le_zeroShellMultiplicity
      chi hx hT hU
  have hshell := hmass q chi hchi T U hT hU
  have hfactor : 0 ≤ 2 * x / T := by positivity
  calc
    ‖dirichletNontrivialZeroKernelSum chi x U -
        dirichletNontrivialZeroKernelSum chi x T‖ ≤
        (2 * x / T) *
          (∑ rho ∈ dirichletNontrivialLFunctionZeroShellFinset chi T U,
            (analyticOrderNatAt
              (DirichletCharacter.LFunction chi) rho : ℝ)) := hkernel
    _ ≤ (2 * x / T) *
        (4 * (A : ℝ) * M) :=
      mul_le_mul_of_nonneg_left (by simpa [M] using hshell) hfactor
    _ = 8 * ((A : ℝ) * x / T) * M := by ring_nf
    _ ≤ 8 * ((A : ℝ) * x / T) * (4 * L ^ 2) := by
      exact mul_le_mul_of_nonneg_left hMfour (by positivity)
    _ = 32 * (A : ℝ) *
        dirichletExplicitFormulaErrorScale x q T := by
      rw [dirichletExplicitFormulaErrorScale]
      dsimp [L]
      ring_nf

end

section
open Complex Set
open scoped Interval

theorem one_le_dirichletHorizontalLogScale
    {q : ℕ} [NeZero q] {T : ℝ} (hT : 2 ≤ T) :
    (1 : ℝ) ≤ Real.log ((q : ℝ) * (T + 2)) := by
  have hq : (1 : ℝ) ≤ q := by
    exact_mod_cast Nat.one_le_iff_ne_zero.mpr (NeZero.ne q)
  have hscale : (4 : ℝ) ≤ (q : ℝ) * (T + 2) := by
    nlinarith [mul_le_mul hq (show (4 : ℝ) ≤ T + 2 by linarith)
      (by norm_num : (0 : ℝ) ≤ 4) (by positivity : (0 : ℝ) ≤ q)]
  have hlogFour : (1 : ℝ) < Real.log 4 := by
    rw [Real.log_four_eq]
    nlinarith [Real.log_two_gt_d9]
  exact hlogFour.le.trans (Real.log_le_log (by norm_num) hscale)

theorem exists_nat_norm_logDeriv_LFunction_primitive_leftEdge_le :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ (q : ℕ) [NeZero q], 1 < q →
        ∀ (chi : DirichletCharacter ℂ q), chi.IsPrimitive →
          ∀ t : ℝ,
            ‖logDeriv (DirichletCharacter.LFunction chi)
              (((-1 / 2 : ℝ) : ℂ) + t * Complex.I)‖ ≤
              10 * (A : ℝ) *
                Real.log ((q : ℝ) * (|t| + 2)) := by
  obtain ⟨Af, hAf, hfixed⟩ :=
    exists_nat_norm_logDeriv_LFunction_sub_radiusSix_divisor_finsum_le
  obtain ⟨Ad, _hAd, hmass⟩ :=
    exists_nat_finsum_divisor_LFunction_radiusSix_le
  let A := max Af Ad
  refine ⟨A, hAf.trans (Nat.le_max_left Af Ad), ?_⟩
  intro q _ hq chi hchi t
  let s : ℂ := ((-1 / 2 : ℝ) : ℂ) + t * I
  let D : ℂ → ℤ :=
    MeromorphicOn.divisor (DirichletCharacter.LFunction chi)
      (closedBall ((2 : ℂ) + t * I) 6)
  let L : ℝ := Real.log ((q : ℝ) * (|t| + 2))
  have hqTwo : (2 : ℝ) ≤ q := by exact_mod_cast hq
  have hscaleFour : (4 : ℝ) ≤ (q : ℝ) * (|t| + 2) := by
    nlinarith [mul_le_mul hqTwo
      (show (2 : ℝ) ≤ |t| + 2 by linarith [abs_nonneg t])
      (by norm_num : (0 : ℝ) ≤ 2) (by positivity : (0 : ℝ) ≤ q)]
  have hL0 : 0 ≤ L := by
    dsimp [L]
    exact Real.log_nonneg (by linarith)
  have hsDisk : s ∈ closedBall ((2 : ℂ) + t * I) 3 := by
    rw [mem_closedBall, Complex.dist_eq]
    have hsSub : s - ((2 : ℂ) + t * I) = ((-5 / 2 : ℝ) : ℂ) := by
      dsimp [s]
      push_cast
      ring
    rw [hsSub, Complex.norm_real, Real.norm_eq_abs]
    norm_num
  have hsNonzero : DirichletCharacter.LFunction chi s ≠ 0 := by
    intro hsZero
    have hsep :=
      one_half_le_norm_neg_half_add_mul_I_sub_of_LFunction_eq_zero_of_isPrimitive
        chi hchi t hsZero
    rw [show (((-1 / 2 : ℝ) : ℂ) + t * I) = s by rfl,
      sub_self, norm_zero] at hsep
    norm_num at hsep
  have hAfAReal : (Af : ℝ) ≤ A := by
    exact_mod_cast Nat.le_max_left Af Ad
  have hAdAReal : (Ad : ℝ) ≤ A := by
    exact_mod_cast Nat.le_max_right Af Ad
  have hA0 : (0 : ℝ) ≤ A := by positivity
  have hresidual0 := hfixed q hq chi hchi t s hsDisk hsNonzero
  have hresidual :
      ‖logDeriv (DirichletCharacter.LFunction chi) s -
          ∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ ≤
        16 * ((A : ℝ) * L) / 3 := by
    calc
      _ ≤ 16 * ((Af : ℝ) * L) / 3 := by
        simpa [D, L] using hresidual0
      _ ≤ 16 * ((A : ℝ) * L) / 3 := by
        gcongr
  have hchiNe : chi ≠ 1 := character_ne_one_of_isPrimitive hq chi hchi
  have hDfinite : D.support.Finite := by
    simpa [D] using divisor_LFunction_closedBall_support_finite hchiNe
      ((2 : ℂ) + t * I) 6
  have hDnonneg : 0 ≤ D := by
    intro rho
    exact (divisor_LFunction_nonneg hchiNe
      (closedBall ((2 : ℂ) + t * I) 6)) rho
  have hDsep : ∀ rho ∈ D.support, (1 / 2 : ℝ) ≤ ‖s - rho‖ := by
    intro rho hrho
    have hrhoDisk : rho ∈ closedBall ((2 : ℂ) + t * I) 6 :=
      (MeromorphicOn.divisor (DirichletCharacter.LFunction chi)
        (closedBall ((2 : ℂ) + t * I) 6)).supportWithinDomain
          (by simpa [D] using hrho)
    have hrhoZero : DirichletCharacter.LFunction chi rho = 0 :=
      (mem_support_divisor_LFunction_iff hchiNe hrhoDisk).1
        (by simpa [D] using hrho)
    simpa [s] using
      one_half_le_norm_neg_half_add_mul_I_sub_of_LFunction_eq_zero_of_isPrimitive
        chi hchi t hrhoZero
  have hsum0 := norm_finsum_intCast_div_sub_le D hDfinite hDnonneg
    (show (0 : ℝ) < 1 / 2 by norm_num) hDsep
  have hmass0 := hmass q hq chi hchi t
  have hmassA : ((∑ᶠ rho : ℂ, D rho : ℤ) : ℝ) ≤
      2 * (A : ℝ) * L := by
    calc
      _ ≤ 2 * (Ad : ℝ) * L := by simpa [D, L] using hmass0
      _ ≤ 2 * (A : ℝ) * L := by gcongr
  have hsum : ‖∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ ≤
      4 * (A : ℝ) * L := by
    calc
      _ ≤ ((∑ᶠ rho : ℂ, D rho : ℤ) : ℝ) / (1 / 2) := hsum0
      _ ≤ (2 * (A : ℝ) * L) / (1 / 2) := by gcongr
      _ = 4 * (A : ℝ) * L := by ring
  calc
    ‖logDeriv (DirichletCharacter.LFunction chi) s‖ =
        ‖(logDeriv (DirichletCharacter.LFunction chi) s -
            ∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)) +
          ∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ := by ring_nf
    _ ≤ ‖logDeriv (DirichletCharacter.LFunction chi) s -
            ∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ +
          ‖∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ := norm_add_le _ _
    _ ≤ 16 * ((A : ℝ) * L) / 3 + 4 * (A : ℝ) * L :=
      add_le_add hresidual hsum
    _ ≤ 10 * (A : ℝ) * L := by
      nlinarith [mul_nonneg hA0 hL0]
    _ = 10 * (A : ℝ) *
        Real.log ((q : ℝ) * (|t| + 2)) := rfl

theorem intervalIntegrable_dirichletExplicitFormulaIntegrand_primitive_leftEdge
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    (x U : ℝ) :
    IntervalIntegrable
      (fun t : ℝ => dirichletExplicitFormulaIntegrand chi x
        (((-1 / 2 : ℝ) : ℂ) + t * Complex.I))
      MeasureTheory.volume (-U) U := by
  have hchiNe : chi ≠ 1 := character_ne_one_of_isPrimitive hq chi hchi
  have hnonzero : ∀ t : ℝ, DirichletCharacter.LFunction chi
      (((-1 / 2 : ℝ) : ℂ) + t * I) ≠ 0 := by
    intro t htZero
    have hsep :=
      one_half_le_norm_neg_half_add_mul_I_sub_of_LFunction_eq_zero_of_isPrimitive
        chi hchi t htZero
    rw [sub_self, norm_zero] at hsep
    norm_num at hsep
  have hpath : Continuous (fun t : ℝ => ((-1 / 2 : ℝ) : ℂ) + t * I) :=
    continuous_const.add (Complex.continuous_ofReal.mul continuous_const)
  have hcontinuous : Continuous (fun t : ℝ =>
      dirichletExplicitFormulaIntegrand chi x
        (((-1 / 2 : ℝ) : ℂ) + t * I)) := by
    rw [continuous_iff_continuousAt]
    intro t
    have hdiff := differentiableAt_dirichletExplicitFormulaIntegrand_of_ne_zero
      hchiNe x (hnonzero t)
    have hcomp := hdiff.continuousAt.comp
      (f := fun r : ℝ => ((-1 / 2 : ℝ) : ℂ) + r * I)
      hpath.continuousAt
    change ContinuousAt
      (dirichletExplicitFormulaIntegrand chi x ∘
        fun r : ℝ => ((-1 / 2 : ℝ) : ℂ) + r * I) t
    exact hcomp
  exact hcontinuous.intervalIntegrable _ _

theorem exists_nat_norm_logDeriv_LFunction_modOne_leftEdge_le :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ t : ℝ,
        ‖logDeriv (DirichletCharacter.LFunction
          (1 : DirichletCharacter ℂ 1))
            (((-1 / 2 : ℝ) : ℂ) + t * Complex.I)‖ ≤
          10 * (A : ℝ) * Real.log (|t| + 2) := by
  obtain ⟨Af, hAf, hfixed⟩ :=
    exists_nat_norm_logDeriv_riemannZeta₁_sub_radiusSix_divisor_finsum_le
  obtain ⟨Ad, _hAd, hmass⟩ :=
    exists_nat_finsum_divisor_riemannZeta₁_radiusSix_le
  let A := max Af Ad
  refine ⟨A, hAf.trans (Nat.le_max_left Af Ad), ?_⟩
  intro t
  let s : ℂ := ((-1 / 2 : ℝ) : ℂ) + t * I
  let D : ℂ → ℤ := MeromorphicOn.divisor riemannZeta₁
    (closedBall ((2 : ℂ) + t * I) 6)
  let L : ℝ := Real.log (|t| + 2)
  have hL0 : 0 ≤ L := by
    dsimp [L]
    exact Real.log_nonneg (by linarith [abs_nonneg t])
  have hsDisk : s ∈ closedBall ((2 : ℂ) + t * I) 3 := by
    rw [mem_closedBall, Complex.dist_eq]
    have hsSub : s - ((2 : ℂ) + t * I) = ((-5 / 2 : ℝ) : ℂ) := by
      dsimp [s]
      push_cast
      ring
    rw [hsSub, Complex.norm_real, Real.norm_eq_abs]
    norm_num
  have hsOne : s ≠ 1 := by
    intro hsEq
    have hre := congrArg Complex.re hsEq
    norm_num [s] at hre
  have hsZeta : riemannZeta s ≠ 0 := by
    intro hsZero
    have hsep :=
      one_half_le_norm_neg_half_add_mul_I_sub_of_LFunction_eq_zero_of_isPrimitive
        (1 : DirichletCharacter ℂ 1)
        DirichletCharacter.isPrimitive_one_level_one t (by
          simpa [DirichletCharacter.LFunction_modOne_eq] using hsZero)
    rw [show (((-1 / 2 : ℝ) : ℂ) + t * I) = s by rfl,
      sub_self, norm_zero] at hsep
    norm_num at hsep
  have hsZetaOne : riemannZeta₁ s ≠ 0 := by
    intro hsZero
    have hfactor := riemannZeta_eq_inv_sub_mul hsOne
    rw [hsZero, mul_zero] at hfactor
    exact hsZeta hfactor
  have hAfAReal : (Af : ℝ) ≤ A := by
    exact_mod_cast Nat.le_max_left Af Ad
  have hAdAReal : (Ad : ℝ) ≤ A := by
    exact_mod_cast Nat.le_max_right Af Ad
  have hA37 : 37 ≤ A := hAf.trans (Nat.le_max_left Af Ad)
  have hA0 : (0 : ℝ) ≤ A := by positivity
  have hresidual0 := hfixed t s hsDisk hsZetaOne
  have hresidual :
      ‖logDeriv riemannZeta₁ s -
          ∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ ≤
        16 * ((A : ℝ) * L) / 3 := by
    calc
      _ ≤ 16 * ((Af : ℝ) * L) / 3 := by
        simpa [D, L] using hresidual0
      _ ≤ 16 * ((A : ℝ) * L) / 3 := by gcongr
  have hDfinite : D.support.Finite := by
    simpa [D] using divisor_riemannZeta₁_closedBall_support_finite
      ((2 : ℂ) + t * I) 6
  have hDnonneg : 0 ≤ D := by
    intro rho
    exact (divisor_riemannZeta₁_nonneg
      (closedBall ((2 : ℂ) + t * I) 6)) rho
  have hDsep : ∀ rho ∈ D.support, (1 / 2 : ℝ) ≤ ‖s - rho‖ := by
    intro rho hrho
    have hrhoDisk : rho ∈ closedBall ((2 : ℂ) + t * I) 6 :=
      (MeromorphicOn.divisor riemannZeta₁
        (closedBall ((2 : ℂ) + t * I) 6)).supportWithinDomain
          (by simpa [D] using hrho)
    have hrhoReg : riemannZeta₁ rho = 0 :=
      (mem_support_divisor_riemannZeta₁_iff hrhoDisk).1
        (by simpa [D] using hrho)
    have hrhoOne : rho ≠ 1 := by
      intro hrhoEq
      subst rho
      rw [riemannZeta₁_one] at hrhoReg
      exact one_ne_zero hrhoReg
    have hrhoZeta : riemannZeta rho = 0 := by
      have hfactor := riemannZeta_eq_inv_sub_mul hrhoOne
      rw [hrhoReg, mul_zero] at hfactor
      exact hfactor
    simpa [s, DirichletCharacter.LFunction_modOne_eq] using
      one_half_le_norm_neg_half_add_mul_I_sub_of_LFunction_eq_zero_of_isPrimitive
        (1 : DirichletCharacter ℂ 1)
        DirichletCharacter.isPrimitive_one_level_one t (by
          simpa [DirichletCharacter.LFunction_modOne_eq] using hrhoZeta)
  have hsum0 := norm_finsum_intCast_div_sub_le D hDfinite hDnonneg
    (show (0 : ℝ) < 1 / 2 by norm_num) hDsep
  have hmass0 := hmass t
  have hmassA : ((∑ᶠ rho : ℂ, D rho : ℤ) : ℝ) ≤
      2 * (A : ℝ) * L := by
    calc
      _ ≤ 2 * (Ad : ℝ) * L := by simpa [D, L] using hmass0
      _ ≤ 2 * (A : ℝ) * L := by gcongr
  have hsum : ‖∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ ≤
      4 * (A : ℝ) * L := by
    calc
      _ ≤ ((∑ᶠ rho : ℂ, D rho : ℤ) : ℝ) / (1 / 2) := hsum0
      _ ≤ (2 * (A : ℝ) * L) / (1 / 2) := by gcongr
      _ = 4 * (A : ℝ) * L := by ring
  have hregular : ‖logDeriv riemannZeta₁ s‖ ≤
      16 * ((A : ℝ) * L) / 3 + 4 * (A : ℝ) * L := by
    calc
      ‖logDeriv riemannZeta₁ s‖ =
          ‖(logDeriv riemannZeta₁ s -
              ∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)) +
            ∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ := by ring_nf
      _ ≤ ‖logDeriv riemannZeta₁ s -
              ∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ +
            ‖∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ := norm_add_le _ _
      _ ≤ _ := add_le_add hresidual hsum
  have hsPoleNorm : (3 / 2 : ℝ) ≤ ‖s - 1‖ := by
    calc
      (3 / 2 : ℝ) = |(s - 1).re| := by norm_num [s]
      _ ≤ ‖s - 1‖ := Complex.abs_re_le_norm _
  have hpole : ‖(s - 1)⁻¹‖ ≤ 2 / 3 := by
    rw [norm_inv]
    calc
      ‖s - 1‖⁻¹ ≤ (3 / 2 : ℝ)⁻¹ :=
        by simpa [one_div] using
          one_div_le_one_div_of_le (by norm_num : (0 : ℝ) < 3 / 2)
            hsPoleNorm
      _ = 2 / 3 := by norm_num
  have hrelation :=
    neg_logDeriv_riemannZeta_eq_pole_sub_regularized_of_ne_zero
      s hsOne hsZeta
  have hlogTwo : Real.log 2 ≤ L := by
    dsimp [L]
    exact Real.log_le_log (by norm_num) (by linarith [abs_nonneg t])
  have hLhalf : (1 / 2 : ℝ) ≤ L := by
    nlinarith [Real.log_two_gt_d9]
  have hAreal : (37 : ℝ) ≤ A := by exact_mod_cast hA37
  have hALone : (1 : ℝ) ≤ (A : ℝ) * L := by nlinarith
  have hzetaBound : ‖logDeriv riemannZeta s‖ ≤
      10 * (A : ℝ) * L := by
    have heq : logDeriv riemannZeta s =
        logDeriv riemannZeta₁ s - (s - 1)⁻¹ := by
      linear_combination -hrelation
    rw [heq]
    calc
      ‖logDeriv riemannZeta₁ s - (s - 1)⁻¹‖ ≤
          ‖logDeriv riemannZeta₁ s‖ + ‖(s - 1)⁻¹‖ := norm_sub_le _ _
      _ ≤ (16 * ((A : ℝ) * L) / 3 + 4 * (A : ℝ) * L) +
          2 / 3 := add_le_add hregular hpole
      _ ≤ 10 * (A : ℝ) * L := by nlinarith
  simpa [s, L, DirichletCharacter.LFunction_modOne_eq] using hzetaBound

theorem intervalIntegrable_dirichletExplicitFormulaIntegrand_modOne_leftEdge
    (x U : ℝ) :
    IntervalIntegrable
      (fun t : ℝ => dirichletExplicitFormulaIntegrand
        (1 : DirichletCharacter ℂ 1) x
          (((-1 / 2 : ℝ) : ℂ) + t * Complex.I))
      MeasureTheory.volume (-U) U := by
  have hone : ∀ t : ℝ, (((-1 / 2 : ℝ) : ℂ) + t * I) ≠ 1 := by
    intro t ht
    have hre := congrArg Complex.re ht
    norm_num at hre
  have hnonzero : ∀ t : ℝ,
      DirichletCharacter.LFunction (1 : DirichletCharacter ℂ 1)
        (((-1 / 2 : ℝ) : ℂ) + t * I) ≠ 0 := by
    intro t htZero
    have hsep :=
      one_half_le_norm_neg_half_add_mul_I_sub_of_LFunction_eq_zero_of_isPrimitive
        (1 : DirichletCharacter ℂ 1)
        DirichletCharacter.isPrimitive_one_level_one t htZero
    rw [sub_self, norm_zero] at hsep
    norm_num at hsep
  have hpath : Continuous (fun t : ℝ => ((-1 / 2 : ℝ) : ℂ) + t * I) :=
    continuous_const.add (Complex.continuous_ofReal.mul continuous_const)
  have hcontinuous : Continuous (fun t : ℝ =>
      dirichletExplicitFormulaIntegrand (1 : DirichletCharacter ℂ 1) x
        (((-1 / 2 : ℝ) : ℂ) + t * I)) := by
    rw [continuous_iff_continuousAt]
    intro t
    have hdiff :=
      differentiableAt_dirichletExplicitFormulaIntegrand_one_of_ne_one_of_ne_zero
        x (hone t) (hnonzero t)
    have hcomp := hdiff.continuousAt.comp
      (f := fun r : ℝ => ((-1 / 2 : ℝ) : ℂ) + r * I)
      hpath.continuousAt
    change ContinuousAt
      (dirichletExplicitFormulaIntegrand
        (1 : DirichletCharacter ℂ 1) x ∘
          fun r : ℝ => ((-1 / 2 : ℝ) : ℂ) + r * I) t
    exact hcomp
  exact hcontinuous.intervalIntegrable _ _

section PrimitiveLFunctionHorizontalLogDerivative
theorem log_selectedHeightScale_le_two_mul
    {q : ℕ} [NeZero q] {T U : ℝ} (hT : 2 ≤ T)
    (hU : U ∈ Icc T (T + 1)) :
    Real.log ((q : ℝ) * (|U| + 2)) ≤
      2 * Real.log ((q : ℝ) * (T + 2)) := by
  have hq : (1 : ℝ) ≤ q := by
    exact_mod_cast Nat.one_le_iff_ne_zero.mpr (NeZero.ne q)
  have hq0 : (0 : ℝ) ≤ q := zero_le_one.trans hq
  have hU0 : 0 ≤ U := by linarith [hT, hU.1]
  have hargPos : 0 < (q : ℝ) * (|U| + 2) := by positivity
  have hheight : U + 2 ≤ (T + 2) ^ 2 := by
    nlinarith [hU.2, sq_nonneg T]
  have hlevel : (q : ℝ) ≤ (q : ℝ) ^ 2 := by
    nlinarith [mul_nonneg hq0 (sub_nonneg.mpr hq)]
  have hscale : (q : ℝ) * (|U| + 2) ≤
      ((q : ℝ) * (T + 2)) ^ 2 := by
    rw [abs_of_nonneg hU0]
    calc
      (q : ℝ) * (U + 2) ≤ (q : ℝ) * (T + 2) ^ 2 :=
        mul_le_mul_of_nonneg_left hheight hq0
      _ ≤ (q : ℝ) ^ 2 * (T + 2) ^ 2 :=
        mul_le_mul_of_nonneg_right hlevel (sq_nonneg (T + 2))
      _ = ((q : ℝ) * (T + 2)) ^ 2 := by ring
  calc
    Real.log ((q : ℝ) * (|U| + 2)) ≤
        Real.log (((q : ℝ) * (T + 2)) ^ 2) :=
      Real.log_le_log hargPos hscale
    _ = 2 * Real.log ((q : ℝ) * (T + 2)) := by
      rw [Real.log_pow]
      norm_num

end PrimitiveLFunctionHorizontalLogDerivative

theorem exists_nat_norm_logDeriv_LFunction_primitive_horizontal_le :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ C : ℕ, 2 ≤ C →
        ∀ (q : ℕ) [NeZero q], 1 < q →
          ∀ (chi : DirichletCharacter ℂ q), chi.IsPrimitive →
            ∀ (T U sigma : ℝ), 2 ≤ T →
              U ∈ Icc T (T + 1) →
                -1 ≤ sigma → sigma ≤ 3 →
                  (∀ rho : ℂ,
                    (rho ≠ 1 ∨ chi ≠ 1) →
                      DirichletCharacter.LFunction chi rho = 0 →
                        (1 / ((C : ℝ) *
                            Real.log ((q : ℝ) * (T + 2))) ≤
                          |U - rho.im|) ∧
                        (1 / ((C : ℝ) *
                            Real.log ((q : ℝ) * (T + 2))) ≤
                          |U + rho.im|)) →
                    ‖logDeriv (DirichletCharacter.LFunction chi)
                        ((sigma : ℂ) + U * I)‖ ≤
                      10 * (A : ℝ) * C *
                        Real.log ((q : ℝ) * (T + 2)) ^ 2 ∧
                    ‖logDeriv (DirichletCharacter.LFunction chi)
                        ((sigma : ℂ) - U * I)‖ ≤
                      10 * (A : ℝ) * C *
                        Real.log ((q : ℝ) * (T + 2)) ^ 2 := by
  obtain ⟨Af, hAf, hfixed⟩ :=
    exists_nat_norm_logDeriv_LFunction_sub_radiusSix_divisor_finsum_le
  obtain ⟨Ad, _hAd, hmass⟩ :=
    exists_nat_finsum_divisor_LFunction_radiusSix_le
  let A := max Af Ad
  refine ⟨A, hAf.trans (Nat.le_max_left Af Ad), ?_⟩
  intro C hC q _ hq chi hchi T U sigma hT hU hsigmaLower
    hsigmaUpper hclear
  let L : ℝ := Real.log ((q : ℝ) * (T + 2))
  let delta : ℝ := 1 / ((C : ℝ) * L)
  have hLone : (1 : ℝ) ≤ L := by
    simpa [L] using one_le_dirichletHorizontalLogScale (q := q) hT
  have hL0 : 0 ≤ L := zero_le_one.trans hLone
  have hCreal : (2 : ℝ) ≤ C := by exact_mod_cast hC
  have hC0 : (0 : ℝ) ≤ C := by positivity
  have hCLpos : 0 < (C : ℝ) * L :=
    mul_pos (by linarith) (by linarith)
  have hdelta : 0 < delta :=
    one_div_pos.mpr hCLpos
  have hchiNe : chi ≠ 1 := character_ne_one_of_isPrimitive hq chi hchi
  have hU0 : 0 ≤ U := by linarith [hT, hU.1]
  have hheightLog : Real.log ((q : ℝ) * (|U| + 2)) ≤ 2 * L := by
    simpa [L] using log_selectedHeightScale_le_two_mul (q := q) hT hU
  have hAfA : Af ≤ A := Nat.le_max_left Af Ad
  have hAdA : Ad ≤ A := Nat.le_max_right Af Ad
  have hAfAReal : (Af : ℝ) ≤ A := by exact_mod_cast hAfA
  have hAdAReal : (Ad : ℝ) ≤ A := by exact_mod_cast hAdA
  have hA0 : (0 : ℝ) ≤ A := by positivity
  have hbound : ∀ (t : ℝ), |t| = U →
      (∀ rho : ℂ, DirichletCharacter.LFunction chi rho = 0 →
        delta ≤ |t - rho.im|) →
      ∀ (r : ℝ), -1 ≤ r → r ≤ 3 →
        ‖logDeriv (DirichletCharacter.LFunction chi)
            ((r : ℂ) + t * I)‖ ≤
          10 * (A : ℝ) * C * L ^ 2 := by
    intro t htAbs hclearSigned r hrLower hrUpper
    let s : ℂ := (r : ℂ) + t * I
    let D : ℂ → ℤ :=
      MeromorphicOn.divisor (DirichletCharacter.LFunction chi)
        (closedBall ((2 : ℂ) + t * I) 6)
    have hlogt : Real.log ((q : ℝ) * (|t| + 2)) ≤ 2 * L := by
      simpa [htAbs, abs_of_nonneg hU0] using hheightLog
    have hlogt0 : 0 ≤ Real.log ((q : ℝ) * (|t| + 2)) := by
      apply Real.log_nonneg
      have hqOne : (1 : ℝ) ≤ q := by
        exact_mod_cast Nat.one_le_iff_ne_zero.mpr (NeZero.ne q)
      nlinarith [mul_le_mul hqOne
        (show (1 : ℝ) ≤ |t| + 2 by linarith [abs_nonneg t])
        (by norm_num : (0 : ℝ) ≤ 1) (by positivity : (0 : ℝ) ≤ q)]
    have hsDisk : s ∈ closedBall ((2 : ℂ) + t * I) 3 := by
      rw [mem_closedBall, Complex.dist_eq]
      have hsSub : s - ((2 : ℂ) + t * I) = ((r - 2 : ℝ) : ℂ) := by
        dsimp [s]
        push_cast
        ring
      rw [hsSub, Complex.norm_real, Real.norm_eq_abs, abs_le]
      constructor <;> linarith
    have hsNonzero : DirichletCharacter.LFunction chi s ≠ 0 := by
      intro hsZero
      have hsep := hclearSigned s hsZero
      have hsim : s.im = t := by simp [s]
      rw [hsim, sub_self, abs_zero] at hsep
      linarith
    have hresidual0 := hfixed q hq chi hchi t s hsDisk hsNonzero
    have hprodResidual :
        (Af : ℝ) * Real.log ((q : ℝ) * (|t| + 2)) ≤
          (A : ℝ) * (2 * L) :=
      mul_le_mul hAfAReal hlogt hlogt0 hA0
    have hresidual :
        ‖logDeriv (DirichletCharacter.LFunction chi) s -
            ∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ ≤
          32 * (A : ℝ) * L / 3 := by
      calc
        ‖logDeriv (DirichletCharacter.LFunction chi) s -
            ∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ ≤
            16 * ((Af : ℝ) *
              Real.log ((q : ℝ) * (|t| + 2))) / 3 := by
          simpa [D] using hresidual0
        _ ≤ 16 * ((A : ℝ) * (2 * L)) / 3 := by
          exact div_le_div_of_nonneg_right
            (mul_le_mul_of_nonneg_left hprodResidual (by norm_num)) (by norm_num)
        _ = 32 * (A : ℝ) * L / 3 := by ring
    have hDfinite : D.support.Finite := by
      simpa [D] using divisor_LFunction_closedBall_support_finite hchiNe
        ((2 : ℂ) + t * I) 6
    have hDnonneg : 0 ≤ D := by
      intro rho
      exact (divisor_LFunction_nonneg hchiNe
        (closedBall ((2 : ℂ) + t * I) 6)) rho
    have hDsep : ∀ rho ∈ D.support, delta ≤ ‖s - rho‖ := by
      intro rho hrho
      have hrhoDisk : rho ∈ closedBall ((2 : ℂ) + t * I) 6 := by
        exact (MeromorphicOn.divisor (DirichletCharacter.LFunction chi)
          (closedBall ((2 : ℂ) + t * I) 6)).supportWithinDomain
            (by simpa [D] using hrho)
      have hrhoZero : DirichletCharacter.LFunction chi rho = 0 :=
        (mem_support_divisor_LFunction_iff hchiNe hrhoDisk).1 (by
          simpa [D] using hrho)
      calc
        delta ≤ |t - rho.im| := hclearSigned rho hrhoZero
        _ = |(s - rho).im| := by simp [s]
        _ ≤ ‖s - rho‖ := Complex.abs_im_le_norm _
    have hsum0 := norm_finsum_intCast_div_sub_le D hDfinite hDnonneg
      hdelta hDsep
    have hmass0 := hmass q hq chi hchi t
    have hprodMass :
        (Ad : ℝ) * Real.log ((q : ℝ) * (|t| + 2)) ≤
          (A : ℝ) * (2 * L) :=
      mul_le_mul hAdAReal hlogt hlogt0 hA0
    have hmassBound :
        ((∑ᶠ rho : ℂ, D rho : ℤ) : ℝ) ≤ 4 * (A : ℝ) * L := by
      calc
        ((∑ᶠ rho : ℂ, D rho : ℤ) : ℝ) ≤
            2 * (Ad : ℝ) * Real.log ((q : ℝ) * (|t| + 2)) := by
          simpa [D] using hmass0
        _ ≤ 2 * ((A : ℝ) * (2 * L)) := by nlinarith
        _ = 4 * (A : ℝ) * L := by ring
    have hsum :
        ‖∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ ≤
          4 * (A : ℝ) * C * L ^ 2 := by
      calc
        ‖∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ ≤
            ((∑ᶠ rho : ℂ, D rho : ℤ) : ℝ) / delta := hsum0
        _ ≤ (4 * (A : ℝ) * L) / delta :=
          div_le_div_of_nonneg_right hmassBound hdelta.le
        _ = 4 * (A : ℝ) * C * L ^ 2 := by
          dsimp [delta]
          field_simp
    have hCLtwo : (2 : ℝ) ≤ (C : ℝ) * L := by
      nlinarith [mul_le_mul hCreal hLone (by norm_num : (0 : ℝ) ≤ 1) hC0]
    have hAL0 : 0 ≤ (A : ℝ) * L := mul_nonneg hA0 hL0
    have hscaleProduct :
        2 * ((A : ℝ) * L) ≤ ((C : ℝ) * L) * ((A : ℝ) * L) :=
      mul_le_mul_of_nonneg_right hCLtwo hAL0
    calc
      ‖logDeriv (DirichletCharacter.LFunction chi) s‖ =
          ‖(logDeriv (DirichletCharacter.LFunction chi) s -
              ∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)) +
            ∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ := by ring_nf
      _ ≤ ‖logDeriv (DirichletCharacter.LFunction chi) s -
              ∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ +
            ‖∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ := norm_add_le _ _
      _ ≤ 32 * (A : ℝ) * L / 3 +
            4 * (A : ℝ) * C * L ^ 2 := add_le_add hresidual hsum
      _ ≤ 10 * (A : ℝ) * C * L ^ 2 := by
        nlinarith [hscaleProduct]
  constructor
  · exact hbound U (abs_of_nonneg hU0)
      (fun rho hrho => (hclear rho (Or.inr hchiNe) hrho).1)
      sigma hsigmaLower hsigmaUpper
  · have hlower := hbound (-U) (by rw [abs_neg, abs_of_nonneg hU0])
        (fun rho hrho => by
          have hc := (hclear rho (Or.inr hchiNe) hrho).2
          convert hc using 1
          rw [show -U - rho.im = -(U + rho.im) by ring, abs_neg])
        sigma hsigmaLower hsigmaUpper
    simpa [L, sub_eq_add_neg] using hlower

end

section
open Complex Set
open scoped Interval

theorem
    intervalIntegrable_dirichletExplicitFormulaIntegrand_primitive_horizontal
    {C q : ℕ} [NeZero q] (hC : 2 ≤ C) (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive)
    {T U : ℝ} (hT : 2 ≤ T) (_hU : U ∈ Icc T (T + 1))
    (hclear : ∀ rho : ℂ,
      (rho ≠ 1 ∨ chi ≠ 1) →
        DirichletCharacter.LFunction chi rho = 0 →
          (1 / ((C : ℝ) * Real.log ((q : ℝ) * (T + 2))) ≤
            |U - rho.im|) ∧
          (1 / ((C : ℝ) * Real.log ((q : ℝ) * (T + 2))) ≤
            |U + rho.im|))
    {x : ℝ} (_hx : 2 ≤ x) :
    IntervalIntegrable
        (fun sigma : ℝ =>
          dirichletExplicitFormulaIntegrand chi x
            ((sigma : ℂ) + U * I))
        volume (-1 / 2) (1 + 1 / Real.log x) ∧
      IntervalIntegrable
        (fun sigma : ℝ =>
          dirichletExplicitFormulaIntegrand chi x
            ((sigma : ℂ) - U * I))
        volume (-1 / 2) (1 + 1 / Real.log x) := by
  let L : ℝ := Real.log ((q : ℝ) * (T + 2))
  let delta : ℝ := 1 / ((C : ℝ) * L)
  have hLone : (1 : ℝ) ≤ L := by
    simpa [L] using one_le_dirichletHorizontalLogScale (q := q) hT
  have hCreal : (2 : ℝ) ≤ C := by exact_mod_cast hC
  have hdelta : 0 < delta := by
    exact one_div_pos.mpr (mul_pos (by linarith) (by linarith))
  have hchiNe : chi ≠ 1 := character_ne_one_of_isPrimitive hq chi hchi
  have hupperNonzero : ∀ sigma : ℝ,
      DirichletCharacter.LFunction chi ((sigma : ℂ) + U * I) ≠ 0 := by
    intro sigma hsZero
    have hc := (hclear ((sigma : ℂ) + U * I) (Or.inr hchiNe) hsZero).1
    have hfalse : delta ≤ 0 := by simpa [delta, L] using hc
    linarith
  have hlowerNonzero : ∀ sigma : ℝ,
      DirichletCharacter.LFunction chi ((sigma : ℂ) - U * I) ≠ 0 := by
    intro sigma hsZero
    have hc := (hclear ((sigma : ℂ) - U * I) (Or.inr hchiNe) hsZero).2
    have hfalse : delta ≤ 0 := by simpa [delta, L] using hc
    linarith
  have hupperPath : Continuous (fun sigma : ℝ => (sigma : ℂ) + U * I) :=
    Complex.continuous_ofReal.add continuous_const
  have hlowerPath : Continuous (fun sigma : ℝ => (sigma : ℂ) - U * I) :=
    Complex.continuous_ofReal.sub continuous_const
  have hupperContinuous : Continuous (fun sigma : ℝ =>
      dirichletExplicitFormulaIntegrand chi x ((sigma : ℂ) + U * I)) := by
    rw [continuous_iff_continuousAt]
    intro sigma
    have hdiff :=
      differentiableAt_dirichletExplicitFormulaIntegrand_of_ne_zero
        hchiNe x (hupperNonzero sigma)
    have hpathAt : ContinuousAt
        (fun r : ℝ => (r : ℂ) + U * I) sigma := hupperPath.continuousAt
    have hcomp := hdiff.continuousAt.comp
      (f := fun r : ℝ => (r : ℂ) + U * I) hpathAt
    change ContinuousAt
      (dirichletExplicitFormulaIntegrand chi x ∘
        fun r : ℝ => (r : ℂ) + U * I) sigma
    exact hcomp
  have hlowerContinuous : Continuous (fun sigma : ℝ =>
      dirichletExplicitFormulaIntegrand chi x ((sigma : ℂ) - U * I)) := by
    rw [continuous_iff_continuousAt]
    intro sigma
    have hdiff :=
      differentiableAt_dirichletExplicitFormulaIntegrand_of_ne_zero
        hchiNe x (hlowerNonzero sigma)
    have hpathAt : ContinuousAt
        (fun r : ℝ => (r : ℂ) - U * I) sigma := hlowerPath.continuousAt
    have hcomp := hdiff.continuousAt.comp
      (f := fun r : ℝ => (r : ℂ) - U * I) hpathAt
    change ContinuousAt
      (dirichletExplicitFormulaIntegrand chi x ∘
        fun r : ℝ => (r : ℂ) - U * I) sigma
    exact hcomp
  exact ⟨hupperContinuous.intervalIntegrable _ _,
    hlowerContinuous.intervalIntegrable _ _⟩

theorem
    exists_nat_norm_intervalIntegral_dirichletExplicitFormulaIntegrand_primitive_horizontal_le :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ C : ℕ, 2 ≤ C →
        ∀ (q : ℕ) [NeZero q], 1 < q →
          ∀ (chi : DirichletCharacter ℂ q), chi.IsPrimitive →
            ∀ (x T U : ℝ), 2 ≤ T → T ≤ x →
              U ∈ Icc T (T + 1) →
                (∀ rho : ℂ,
                  (rho ≠ 1 ∨ chi ≠ 1) →
                    DirichletCharacter.LFunction chi rho = 0 →
                      (1 / ((C : ℝ) *
                          Real.log ((q : ℝ) * (T + 2))) ≤
                        |U - rho.im|) ∧
                      (1 / ((C : ℝ) *
                          Real.log ((q : ℝ) * (T + 2))) ≤
                        |U + rho.im|)) →
                  ‖∫ sigma in (-1 / 2)..(1 + 1 / Real.log x),
                      dirichletExplicitFormulaIntegrand chi x
                        ((sigma : ℂ) + U * I)‖ ≤
                    640 * (A : ℝ) * C * x *
                      Real.log ((q : ℝ) * x) ^ 2 / T ∧
                  ‖∫ sigma in (-1 / 2)..(1 + 1 / Real.log x),
                      dirichletExplicitFormulaIntegrand chi x
                        ((sigma : ℂ) - U * I)‖ ≤
                    640 * (A : ℝ) * C * x *
                      Real.log ((q : ℝ) * x) ^ 2 / T := by
  obtain ⟨A, hA, hpointwise⟩ :=
    exists_nat_norm_logDeriv_LFunction_primitive_horizontal_le
  refine ⟨A, hA, ?_⟩
  intro C hC q _ hq chi hchi x T U hT hTx hU hclear
  let a : ℝ := -1 / 2
  let b : ℝ := 1 + 1 / Real.log x
  let L : ℝ := Real.log ((q : ℝ) * (T + 2))
  let Q : ℝ := Real.log ((q : ℝ) * x)
  let K : ℝ := 10 * (A : ℝ) * C * L ^ 2
  have hx : 2 ≤ x := hT.trans hTx
  have hlogx : 0 < Real.log x := Real.log_pos (by linarith)
  have hab : a ≤ b := by
    dsimp [a, b]
    linarith [one_div_pos.mpr hlogx]
  have hlogHalf : (1 / 2 : ℝ) < Real.log x := by
    have hlogTwo : Real.log 2 ≤ Real.log x :=
      Real.log_le_log (by norm_num) hx
    nlinarith [Real.log_two_gt_d9]
  have hinvLog : 1 / Real.log x ≤ 2 := by
    apply (div_le_iff₀ hlogx).2
    nlinarith
  have hbThree : b ≤ 3 := by
    dsimp [b]
    linarith
  have hlength : b - a ≤ 4 := by
    dsimp [a]
    linarith
  have hTpos : 0 < T := by linarith
  have hU0 : 0 ≤ U := by linarith [hT, hU.1]
  have htUpper : T ≤ |U| := by simpa [abs_of_nonneg hU0] using hU.1
  have htLower : T ≤ |-U| := by simpa [abs_neg] using htUpper
  have hLone : (1 : ℝ) ≤ L := by
    simpa [L] using one_le_dirichletHorizontalLogScale (q := q) hT
  have hL0 : 0 ≤ L := zero_le_one.trans hLone
  have hK0 : 0 ≤ K := by
    dsimp [K]
    positivity
  have hintegrable :=
    intervalIntegrable_dirichletExplicitFormulaIntegrand_primitive_horizontal
      hC hq chi hchi hT hU hclear hx
  have hupperLog : ∀ r ∈ Icc a b,
      ‖logDeriv (DirichletCharacter.LFunction chi)
          ((r : ℂ) + U * I)‖ ≤ K := by
    intro r hr
    have hp := hpointwise C hC q hq chi hchi T U r hT hU
      (by dsimp [a] at hr; linarith [hr.1])
      (hr.2.trans hbThree) hclear
    simpa [K, L] using hp.1
  have hlowerLog : ∀ r ∈ Icc a b,
      ‖logDeriv (DirichletCharacter.LFunction chi)
          ((r : ℂ) + ((-U : ℝ) : ℂ) * I)‖ ≤ K := by
    intro r hr
    have hp := hpointwise C hC q hq chi hchi T U r hT hU
      (by dsimp [a] at hr; linarith [hr.1])
      (hr.2.trans hbThree) hclear
    simpa [K, L, sub_eq_add_neg] using hp.2
  have hlowerIntegrable : IntervalIntegrable
      (fun r : ℝ => dirichletExplicitFormulaIntegrand chi x
        ((r : ℂ) + ((-U : ℝ) : ℂ) * I)) volume a b := by
    simpa [a, b, sub_eq_add_neg] using hintegrable.2
  have hupperRaw :=
    norm_intervalIntegral_dirichletExplicitFormulaIntegrand_horizontal_le
      chi (x := x) (a := a) (b := b) (t := U) (T := T) (K := K)
      hx hab (by simp [b]) hTpos htUpper hK0
      (by simpa [a, b] using hintegrable.1) hupperLog
  have hlowerRaw :=
    norm_intervalIntegral_dirichletExplicitFormulaIntegrand_horizontal_le
      chi (x := x) (a := a) (b := b) (t := -U) (T := T) (K := K)
      hx hab (by simp [b]) hTpos htLower hK0 hlowerIntegrable hlowerLog
  have hqTwo : (2 : ℝ) ≤ q := by exact_mod_cast hq
  have hq0 : (0 : ℝ) ≤ q := by positivity
  have hsourceArg : (4 : ℝ) ≤ (q : ℝ) * x := by nlinarith
  have hQ0 : 0 ≤ Q := by
    dsimp [Q]
    exact Real.log_nonneg (by linarith)
  have hbaseArgPos : 0 < (q : ℝ) * (T + 2) := by positivity
  have hargFirst : (q : ℝ) * (T + 2) ≤ 2 * ((q : ℝ) * x) := by
    have hheight : T + 2 ≤ 2 * x := by linarith
    nlinarith [mul_le_mul_of_nonneg_left hheight hq0]
  have hargSecond : 2 * ((q : ℝ) * x) ≤ ((q : ℝ) * x) ^ 2 := by
    nlinarith [hsourceArg, sq_nonneg ((q : ℝ) * x - 2)]
  have hLQ : L ≤ 2 * Q := by
    calc
      L = Real.log ((q : ℝ) * (T + 2)) := rfl
      _ ≤ Real.log (((q : ℝ) * x) ^ 2) :=
        Real.log_le_log hbaseArgPos (hargFirst.trans hargSecond)
      _ = 2 * Q := by
        rw [Real.log_pow]
        simp [Q]
  have hLsq : L ^ 2 ≤ 4 * Q ^ 2 := by
    calc
      L ^ 2 ≤ (2 * Q) ^ 2 := pow_le_pow_left₀ hL0 hLQ 2
      _ = 4 * Q ^ 2 := by ring
  have hselectedUpper :
      ‖∫ r in a..b, dirichletExplicitFormulaIntegrand chi x
          ((r : ℂ) + U * I)‖ ≤
        160 * (A : ℝ) * C * x * L ^ 2 / T := by
    calc
      ‖∫ r in a..b, dirichletExplicitFormulaIntegrand chi x
          ((r : ℂ) + U * I)‖ ≤ (4 * K * x / T) * (b - a) := hupperRaw
      _ ≤ (4 * K * x / T) * 4 :=
        mul_le_mul_of_nonneg_left hlength (by positivity)
      _ = 160 * (A : ℝ) * C * x * L ^ 2 / T := by
        simp [K]
        ring
  have hselectedLower :
      ‖∫ r in a..b, dirichletExplicitFormulaIntegrand chi x
          ((r : ℂ) + ((-U : ℝ) : ℂ) * I)‖ ≤
        160 * (A : ℝ) * C * x * L ^ 2 / T := by
    calc
      ‖∫ r in a..b, dirichletExplicitFormulaIntegrand chi x
          ((r : ℂ) + ((-U : ℝ) : ℂ) * I)‖ ≤
            (4 * K * x / T) * (b - a) := hlowerRaw
      _ ≤ (4 * K * x / T) * 4 :=
        mul_le_mul_of_nonneg_left hlength (by positivity)
      _ = 160 * (A : ℝ) * C * x * L ^ 2 / T := by
        simp [K]
        ring
  have hcoefficient : 0 ≤ 160 * (A : ℝ) * C * x := by positivity
  have hsourceNumerator :
      160 * (A : ℝ) * C * x * L ^ 2 ≤
        640 * (A : ℝ) * C * x * Q ^ 2 := by
    calc
      160 * (A : ℝ) * C * x * L ^ 2 ≤
          (160 * (A : ℝ) * C * x) * (4 * Q ^ 2) :=
        mul_le_mul_of_nonneg_left hLsq hcoefficient
      _ = 640 * (A : ℝ) * C * x * Q ^ 2 := by ring
  constructor
  · have hfinal := hselectedUpper.trans
      (div_le_div_of_nonneg_right hsourceNumerator hTpos.le)
    simpa [a, b, L, Q] using hfinal
  · have hfinal := hselectedLower.trans
      (div_le_div_of_nonneg_right hsourceNumerator hTpos.le)
    simpa [a, b, L, Q, sub_eq_add_neg] using hfinal

theorem norm_dirichletExplicitFormulaKernel_leftEdge_le
    {x t : ℝ} (hx : 2 ≤ x) :
    ‖dirichletExplicitFormulaKernel x
        (((-1 / 2 : ℝ) : ℂ) + t * Complex.I)‖ ≤
      6 / (|t| + 1) := by
  let s : ℂ := ((-1 / 2 : ℝ) : ℂ) + t * I
  have hxpos : 0 < x := by linarith
  have hxone : (1 : ℝ) ≤ x := by linarith
  have hs : s ≠ 0 := by
    intro hsZero
    have hre := congrArg Complex.re hsZero
    norm_num [s] at hre
  rw [show (((-1 / 2 : ℝ) : ℂ) + t * I) = s by rfl,
    dirichletExplicitFormulaKernel_eq_cpow_sub_one_div hxpos hs,
    norm_div]
  have hpow : x ^ (-1 / 2 : ℝ) ≤ 1 :=
    Real.rpow_le_one_of_one_le_of_nonpos hxone (by norm_num)
  have hnum : ‖(x : ℂ) ^ s - 1‖ ≤ 2 := by
    calc
      ‖(x : ℂ) ^ s - 1‖ ≤ ‖(x : ℂ) ^ s‖ + ‖(1 : ℂ)‖ := norm_sub_le _ _
      _ = x ^ (-1 / 2 : ℝ) + 1 := by
        rw [Complex.norm_cpow_eq_rpow_re_of_pos hxpos]
        simp [s]
      _ ≤ 2 := by linarith
  have hhalf : (1 / 2 : ℝ) ≤ ‖s‖ := by
    calc
      (1 / 2 : ℝ) = |s.re| := by norm_num [s]
      _ ≤ ‖s‖ := Complex.abs_re_le_norm s
  have htNorm : |t| ≤ ‖s‖ := by
    calc
      |t| = |s.im| := by simp [s]
      _ ≤ ‖s‖ := Complex.abs_im_le_norm s
  have hscale : |t| + 1 ≤ 3 * ‖s‖ := by nlinarith
  have hsNormPos : 0 < ‖s‖ := norm_pos_iff.mpr hs
  have hheightPos : 0 < |t| + 1 := by linarith [abs_nonneg t]
  calc
    ‖(x : ℂ) ^ s - 1‖ / ‖s‖ ≤ 2 / ‖s‖ :=
      div_le_div_of_nonneg_right hnum hsNormPos.le
    _ ≤ 6 / (|t| + 1) := by
      apply (div_le_div_iff₀ hsNormPos hheightPos).2
      nlinarith

theorem integral_inv_abs_add_one_neg_eq
    {U : ℝ} (hU : 0 ≤ U) :
    (∫ t in -U..U, (|t| + 1)⁻¹) =
      2 * Real.log (U + 1) := by
  let w : ℝ → ℝ := fun t => (|t| + 1)⁻¹
  have hwContinuous : Continuous w := by
    dsimp [w]
    exact (continuous_abs.add continuous_const).inv₀ (fun t => by
      have ht : 0 < |t| + 1 := by linarith [abs_nonneg t]
      exact ht.ne')
  have hpos : (∫ t in 0..U, w t) = Real.log (U + 1) := by
    rw [intervalIntegral.integral_congr (f := w)
      (g := fun t : ℝ => (t + 1)⁻¹)]
    · rw [intervalIntegral.integral_comp_add_right (fun t : ℝ => t⁻¹) 1,
        integral_inv_of_pos (by norm_num) (by linarith)]
      simp
    · intro t ht
      rw [uIcc_of_le hU] at ht
      simp [w, abs_of_nonneg ht.1]
  have hneg : (∫ t in -U..0, w t) = ∫ t in 0..U, w t := by
    calc
      (∫ t in -U..0, w t) = ∫ t in 0..U, w (-t) := by
        symm
        simpa only [neg_zero] using intervalIntegral.integral_comp_neg
          (a := 0) (b := U) w
      _ = ∫ t in 0..U, w t := by
        apply intervalIntegral.integral_congr
        intro t _ht
        simp [w]
  rw [← intervalIntegral.integral_add_adjacent_intervals
      (hwContinuous.intervalIntegrable (-U) 0)
      (hwContinuous.intervalIntegrable 0 U),
    hneg, hpos]
  ring

theorem norm_intervalIntegral_dirichletExplicitFormulaIntegrand_leftEdge_le
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    {x U K : ℝ} (hx : 2 ≤ x) (hU : 0 ≤ U) (hK : 0 ≤ K)
    (hIntegrable : IntervalIntegrable
      (fun t : ℝ => dirichletExplicitFormulaIntegrand chi x
        (((-1 / 2 : ℝ) : ℂ) + t * Complex.I))
      MeasureTheory.volume (-U) U)
    (hLogDeriv : ∀ t ∈ Set.Icc (-U) U,
      ‖logDeriv (DirichletCharacter.LFunction chi)
        (((-1 / 2 : ℝ) : ℂ) + t * Complex.I)‖ ≤ K) :
    ‖∫ t in -U..U,
        dirichletExplicitFormulaIntegrand chi x
          (((-1 / 2 : ℝ) : ℂ) + t * Complex.I)‖ ≤
      12 * K * Real.log (U + 1) := by
  let w : ℝ → ℝ := fun t => (|t| + 1)⁻¹
  let g : ℝ → ℝ := fun t => 6 * K * w t
  have hab : -U ≤ U := by linarith
  have hwContinuous : Continuous w := by
    dsimp [w]
    exact (continuous_abs.add continuous_const).inv₀ (fun t => by
      have ht : 0 < |t| + 1 := by linarith [abs_nonneg t]
      exact ht.ne')
  have hgIntegrable : IntervalIntegrable g volume (-U) U :=
    (continuous_const.mul hwContinuous).intervalIntegrable _ _
  have hpoint : ∀ t ∈ Icc (-U) U,
      ‖dirichletExplicitFormulaIntegrand chi x
        (((-1 / 2 : ℝ) : ℂ) + t * I)‖ ≤ g t := by
    intro t ht
    have hlog := hLogDeriv t ht
    have hkernel := norm_dirichletExplicitFormulaKernel_leftEdge_le
      (x := x) (t := t) hx
    rw [dirichletExplicitFormulaIntegrand, norm_mul, norm_neg]
    calc
      ‖logDeriv (DirichletCharacter.LFunction chi)
          (((-1 / 2 : ℝ) : ℂ) + t * I)‖ *
          ‖dirichletExplicitFormulaKernel x
            (((-1 / 2 : ℝ) : ℂ) + t * I)‖ ≤
        K * (6 / (|t| + 1)) :=
          mul_le_mul hlog hkernel (norm_nonneg _) hK
      _ = g t := by simp [g, w, div_eq_mul_inv]; ring
  calc
    ‖∫ t in -U..U,
        dirichletExplicitFormulaIntegrand chi x
          (((-1 / 2 : ℝ) : ℂ) + t * I)‖ ≤
        ∫ t in -U..U,
          ‖dirichletExplicitFormulaIntegrand chi x
            (((-1 / 2 : ℝ) : ℂ) + t * I)‖ :=
      intervalIntegral.norm_integral_le_integral_norm hab
    _ ≤ ∫ t in -U..U, g t :=
      intervalIntegral.integral_mono_on hab hIntegrable.norm
        hgIntegrable hpoint
    _ = 12 * K * Real.log (U + 1) := by
      rw [show (∫ t in -U..U, g t) =
          6 * K * ∫ t in -U..U, (|t| + 1)⁻¹ by
        simp only [g, w, intervalIntegral.integral_const_mul],
        integral_inv_abs_add_one_neg_eq hU]
      ring

theorem intervalIntegrable_dirichletExplicitFormulaIntegrand_modOne_horizontal
    {C : ℕ} (hC : 2 ≤ C) {T U : ℝ} (hT : 2 ≤ T)
    (hU : U ∈ Icc T (T + 1))
    (hclear : ∀ rho : ℂ,
      (rho ≠ 1 ∨ (1 : DirichletCharacter ℂ 1) ≠ 1) →
        DirichletCharacter.LFunction (1 : DirichletCharacter ℂ 1) rho = 0 →
          (1 / ((C : ℝ) * Real.log (T + 2)) ≤ |U - rho.im|) ∧
          (1 / ((C : ℝ) * Real.log (T + 2)) ≤ |U + rho.im|))
    {x : ℝ} (_hx : 2 ≤ x) :
    IntervalIntegrable
        (fun sigma : ℝ => dirichletExplicitFormulaIntegrand
          (1 : DirichletCharacter ℂ 1) x ((sigma : ℂ) + U * I))
        volume (-1 / 2) (1 + 1 / Real.log x) ∧
      IntervalIntegrable
        (fun sigma : ℝ => dirichletExplicitFormulaIntegrand
          (1 : DirichletCharacter ℂ 1) x ((sigma : ℂ) - U * I))
        volume (-1 / 2) (1 + 1 / Real.log x) := by
  let L : ℝ := Real.log (T + 2)
  let delta : ℝ := 1 / ((C : ℝ) * L)
  have hLone : (1 : ℝ) ≤ L := by
    simpa [L] using one_le_riemannZetaHorizontalLogScale hT
  have hCreal : (2 : ℝ) ≤ C := by exact_mod_cast hC
  have hdelta : 0 < delta :=
    one_div_pos.mpr (mul_pos (by linarith) (by linarith))
  have hUpos : 0 < U := by linarith [hT, hU.1]
  have hupperOne : ∀ sigma : ℝ, ((sigma : ℂ) + U * I) ≠ 1 := by
    intro sigma hs
    have him := congrArg Complex.im hs
    simp at him
    linarith
  have hlowerOne : ∀ sigma : ℝ, ((sigma : ℂ) - U * I) ≠ 1 := by
    intro sigma hs
    have him := congrArg Complex.im hs
    simp at him
    linarith
  have hupperNonzero : ∀ sigma : ℝ,
      DirichletCharacter.LFunction (1 : DirichletCharacter ℂ 1)
        ((sigma : ℂ) + U * I) ≠ 0 := by
    intro sigma hsZero
    have hc := (hclear ((sigma : ℂ) + U * I)
      (Or.inl (hupperOne sigma)) hsZero).1
    have hfalse : delta ≤ 0 := by simpa [delta, L] using hc
    linarith
  have hlowerNonzero : ∀ sigma : ℝ,
      DirichletCharacter.LFunction (1 : DirichletCharacter ℂ 1)
        ((sigma : ℂ) - U * I) ≠ 0 := by
    intro sigma hsZero
    have hc := (hclear ((sigma : ℂ) - U * I)
      (Or.inl (hlowerOne sigma)) hsZero).2
    have hfalse : delta ≤ 0 := by simpa [delta, L] using hc
    linarith
  have hupperPath : Continuous (fun sigma : ℝ => (sigma : ℂ) + U * I) :=
    Complex.continuous_ofReal.add continuous_const
  have hlowerPath : Continuous (fun sigma : ℝ => (sigma : ℂ) - U * I) :=
    Complex.continuous_ofReal.sub continuous_const
  have hupperContinuous : Continuous (fun sigma : ℝ =>
      dirichletExplicitFormulaIntegrand (1 : DirichletCharacter ℂ 1) x
        ((sigma : ℂ) + U * I)) := by
    rw [continuous_iff_continuousAt]
    intro sigma
    have hdiff :=
      differentiableAt_dirichletExplicitFormulaIntegrand_one_of_ne_one_of_ne_zero
        x (hupperOne sigma) (hupperNonzero sigma)
    have hcomp := hdiff.continuousAt.comp
      (f := fun r : ℝ => (r : ℂ) + U * I) hupperPath.continuousAt
    change ContinuousAt
      (dirichletExplicitFormulaIntegrand
        (1 : DirichletCharacter ℂ 1) x ∘
          fun r : ℝ => (r : ℂ) + U * I) sigma
    exact hcomp
  have hlowerContinuous : Continuous (fun sigma : ℝ =>
      dirichletExplicitFormulaIntegrand (1 : DirichletCharacter ℂ 1) x
        ((sigma : ℂ) - U * I)) := by
    rw [continuous_iff_continuousAt]
    intro sigma
    have hdiff :=
      differentiableAt_dirichletExplicitFormulaIntegrand_one_of_ne_one_of_ne_zero
        x (hlowerOne sigma) (hlowerNonzero sigma)
    have hcomp := hdiff.continuousAt.comp
      (f := fun r : ℝ => (r : ℂ) - U * I) hlowerPath.continuousAt
    change ContinuousAt
      (dirichletExplicitFormulaIntegrand
        (1 : DirichletCharacter ℂ 1) x ∘
          fun r : ℝ => (r : ℂ) - U * I) sigma
    exact hcomp
  exact ⟨hupperContinuous.intervalIntegrable _ _,
    hlowerContinuous.intervalIntegrable _ _⟩

end

section
open Complex Set
open scoped Interval

theorem
    exists_nat_norm_intervalIntegral_dirichletExplicitFormulaIntegrand_primitive_leftEdge_le :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ (q : ℕ) [NeZero q], 1 < q →
        ∀ (chi : DirichletCharacter ℂ q), chi.IsPrimitive →
          ∀ (x T U : ℝ), 2 ≤ T → T ≤ x →
            U ∈ Set.Icc T (T + 1) →
              ‖∫ t in -U..U,
                  dirichletExplicitFormulaIntegrand chi x
                    (((-1 / 2 : ℝ) : ℂ) + t * Complex.I)‖ ≤
                720 * (A : ℝ) * x *
                  Real.log ((q : ℝ) * x) ^ 2 / T := by
  obtain ⟨A, hA, hpointwise⟩ :=
    exists_nat_norm_logDeriv_LFunction_primitive_leftEdge_le
  refine ⟨A, hA, ?_⟩
  intro q _ hq chi hchi x T U hT hTx hU
  let L : ℝ := Real.log ((q : ℝ) * (U + 2))
  let R : ℝ := Real.log (U + 1)
  let Q : ℝ := Real.log ((q : ℝ) * x)
  let K : ℝ := 10 * (A : ℝ) * L
  have hx : 2 ≤ x := hT.trans hTx
  have hU0 : 0 ≤ U := by linarith [hT, hU.1]
  have hqOne : (1 : ℝ) ≤ q := by
    exact_mod_cast Nat.one_le_iff_ne_zero.mpr (NeZero.ne q)
  have hqTwo : (2 : ℝ) ≤ q := by exact_mod_cast hq
  have hq0 : (0 : ℝ) ≤ q := zero_le_one.trans hqOne
  have hA0 : (0 : ℝ) ≤ A := by positivity
  have hL0 : 0 ≤ L := by
    dsimp [L]
    apply Real.log_nonneg
    nlinarith [mul_le_mul hqOne
      (show (1 : ℝ) ≤ U + 2 by linarith)
      (by norm_num : (0 : ℝ) ≤ 1) hq0]
  have hR0 : 0 ≤ R := by
    dsimp [R]
    exact Real.log_nonneg (by linarith)
  have hK0 : 0 ≤ K := by
    dsimp [K]
    positivity
  have hintegrable :=
    intervalIntegrable_dirichletExplicitFormulaIntegrand_primitive_leftEdge
      hq chi hchi x U
  have hlogBound : ∀ t ∈ Icc (-U) U,
      ‖logDeriv (DirichletCharacter.LFunction chi)
        (((-1 / 2 : ℝ) : ℂ) + t * I)‖ ≤ K := by
    intro t ht
    have htAbs : |t| ≤ U := abs_le.mpr ht
    have hargPos : 0 < (q : ℝ) * (|t| + 2) := by positivity
    have harg : (q : ℝ) * (|t| + 2) ≤ (q : ℝ) * (U + 2) :=
      mul_le_mul_of_nonneg_left (by linarith) hq0
    have hlog : Real.log ((q : ℝ) * (|t| + 2)) ≤ L := by
      dsimp [L]
      exact Real.log_le_log hargPos harg
    have hp := hpointwise q hq chi hchi t
    calc
      _ ≤ 10 * (A : ℝ) * Real.log ((q : ℝ) * (|t| + 2)) := hp
      _ ≤ 10 * (A : ℝ) * L := by gcongr
      _ = K := rfl
  have hraw :=
    norm_intervalIntegral_dirichletExplicitFormulaIntegrand_leftEdge_le
      chi hx hU0 hK0 hintegrable hlogBound
  have hxpos : 0 < x := by linarith
  have hxPlusThree : x + 3 ≤ x ^ 3 := by
    have hxSq : (3 : ℝ) ≤ x ^ 2 := by
      nlinarith [mul_nonneg (sub_nonneg.mpr hx)
        (show (0 : ℝ) ≤ x + 2 by linarith)]
    have hmul : 0 ≤ x * (x ^ 2 - 3) :=
      mul_nonneg hxpos.le (sub_nonneg.mpr hxSq)
    nlinarith
  have hxPlusTwo : x + 2 ≤ x ^ 2 := by
    nlinarith [mul_nonneg (sub_nonneg.mpr hx)
      (show (0 : ℝ) ≤ x + 1 by linarith)]
  have hqSq : (q : ℝ) ≤ (q : ℝ) ^ 2 := by
    nlinarith [mul_nonneg hq0 (sub_nonneg.mpr hqOne)]
  have hqCubeStep : (q : ℝ) ^ 2 ≤ (q : ℝ) ^ 3 := by
    have hmul : 0 ≤ (q : ℝ) ^ 2 * ((q : ℝ) - 1) :=
      mul_nonneg (sq_nonneg _) (sub_nonneg.mpr hqOne)
    nlinarith
  have hqCube : (q : ℝ) ≤ (q : ℝ) ^ 3 := hqSq.trans hqCubeStep
  have hUxOne : U ≤ x + 1 := by
    calc
      U ≤ T + 1 := hU.2
      _ ≤ x + 1 := by linarith
  have hleftArg : (q : ℝ) * (U + 2) ≤
      ((q : ℝ) * x) ^ 3 := by
    calc
      (q : ℝ) * (U + 2) ≤ (q : ℝ) * (x + 3) := by
        exact mul_le_mul_of_nonneg_left (by linarith) hq0
      _ ≤ (q : ℝ) * x ^ 3 :=
        mul_le_mul_of_nonneg_left hxPlusThree hq0
      _ ≤ (q : ℝ) ^ 3 * x ^ 3 :=
        mul_le_mul_of_nonneg_right hqCube (by positivity)
      _ = ((q : ℝ) * x) ^ 3 := by ring
  have hrightArg : U + 1 ≤ ((q : ℝ) * x) ^ 2 := by
    have hxqx : x ≤ (q : ℝ) * x := by
      calc
        x = 1 * x := by ring
        _ ≤ (q : ℝ) * x := mul_le_mul_of_nonneg_right hqOne hxpos.le
    calc
      U + 1 ≤ x + 2 := by linarith
      _ ≤ x ^ 2 := hxPlusTwo
      _ ≤ ((q : ℝ) * x) ^ 2 := pow_le_pow_left₀ hxpos.le hxqx 2
  have hqxFour : (4 : ℝ) ≤ (q : ℝ) * x := by
    nlinarith [mul_le_mul hqTwo hx (by norm_num : (0 : ℝ) ≤ 2) hq0]
  have hQ0 : 0 ≤ Q := by
    dsimp [Q]
    exact Real.log_nonneg (by linarith)
  have hLQ : L ≤ 3 * Q := by
    calc
      L = Real.log ((q : ℝ) * (U + 2)) := rfl
      _ ≤ Real.log (((q : ℝ) * x) ^ 3) :=
        Real.log_le_log (by positivity) hleftArg
      _ = 3 * Q := by rw [Real.log_pow]; simp [Q]
  have hRQ : R ≤ 2 * Q := by
    calc
      R = Real.log (U + 1) := rfl
      _ ≤ Real.log (((q : ℝ) * x) ^ 2) :=
        Real.log_le_log (by linarith) hrightArg
      _ = 2 * Q := by rw [Real.log_pow]; simp [Q]
  have hLR : L * R ≤ 6 * Q ^ 2 := by
    calc
      L * R ≤ (3 * Q) * (2 * Q) :=
        mul_le_mul hLQ hRQ hR0 (by positivity)
      _ = 6 * Q ^ 2 := by ring
  have hsource :
      ‖∫ t in -U..U, dirichletExplicitFormulaIntegrand chi x
          (((-1 / 2 : ℝ) : ℂ) + t * I)‖ ≤
        720 * (A : ℝ) * Q ^ 2 := by
    calc
      _ ≤ 12 * K * R := by simpa [R] using hraw
      _ = (120 * (A : ℝ)) * (L * R) := by simp [K]; ring
      _ ≤ (120 * (A : ℝ)) * (6 * Q ^ 2) :=
        mul_le_mul_of_nonneg_left hLR (by positivity)
      _ = 720 * (A : ℝ) * Q ^ 2 := by ring
  have hTpos : 0 < T := by linarith
  have hratio : (1 : ℝ) ≤ x / T :=
    (le_div_iff₀ hTpos).2 (by simpa using hTx)
  calc
    _ ≤ 720 * (A : ℝ) * Q ^ 2 := hsource
    _ ≤ (720 * (A : ℝ) * Q ^ 2) * (x / T) :=
      le_mul_of_one_le_right (by positivity) hratio
    _ = 720 * (A : ℝ) * x *
        Real.log ((q : ℝ) * x) ^ 2 / T := by simp [Q]; ring

theorem
    exists_nat_norm_intervalIntegral_dirichletExplicitFormulaIntegrand_modOne_leftEdge_le :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ (x T U : ℝ), 2 ≤ T → T ≤ x →
        U ∈ Set.Icc T (T + 1) →
          ‖∫ t in -U..U,
              dirichletExplicitFormulaIntegrand
                (1 : DirichletCharacter ℂ 1) x
                  (((-1 / 2 : ℝ) : ℂ) + t * Complex.I)‖ ≤
            720 * (A : ℝ) * x * Real.log x ^ 2 / T := by
  obtain ⟨A, hA, hpointwise⟩ :=
    exists_nat_norm_logDeriv_LFunction_modOne_leftEdge_le
  refine ⟨A, hA, ?_⟩
  intro x T U hT hTx hU
  let L : ℝ := Real.log (U + 2)
  let R : ℝ := Real.log (U + 1)
  let Q : ℝ := Real.log x
  let K : ℝ := 10 * (A : ℝ) * L
  have hx : 2 ≤ x := hT.trans hTx
  have hU0 : 0 ≤ U := by linarith [hT, hU.1]
  have hL0 : 0 ≤ L := by
    dsimp [L]
    exact Real.log_nonneg (by linarith)
  have hR0 : 0 ≤ R := by
    dsimp [R]
    exact Real.log_nonneg (by linarith)
  have hK0 : 0 ≤ K := by dsimp [K]; positivity
  have hintegrable :=
    intervalIntegrable_dirichletExplicitFormulaIntegrand_modOne_leftEdge x U
  have hlogBound : ∀ t ∈ Icc (-U) U,
      ‖logDeriv (DirichletCharacter.LFunction
        (1 : DirichletCharacter ℂ 1))
          (((-1 / 2 : ℝ) : ℂ) + t * I)‖ ≤ K := by
    intro t ht
    have htAbs : |t| ≤ U := abs_le.mpr ht
    have hlog : Real.log (|t| + 2) ≤ L := by
      dsimp [L]
      exact Real.log_le_log (by positivity) (by linarith)
    have hp := hpointwise t
    calc
      _ ≤ 10 * (A : ℝ) * Real.log (|t| + 2) := hp
      _ ≤ 10 * (A : ℝ) * L := by gcongr
      _ = K := rfl
  have hraw :=
    norm_intervalIntegral_dirichletExplicitFormulaIntegrand_leftEdge_le
      (1 : DirichletCharacter ℂ 1) hx hU0 hK0 hintegrable hlogBound
  have hxpos : 0 < x := by linarith
  have hxPlusThree : x + 3 ≤ x ^ 3 := by
    have hxSq : (3 : ℝ) ≤ x ^ 2 := by
      nlinarith [mul_nonneg (sub_nonneg.mpr hx)
        (show (0 : ℝ) ≤ x + 2 by linarith)]
    have hmul : 0 ≤ x * (x ^ 2 - 3) :=
      mul_nonneg hxpos.le (sub_nonneg.mpr hxSq)
    nlinarith
  have hxPlusTwo : x + 2 ≤ x ^ 2 := by
    nlinarith [mul_nonneg (sub_nonneg.mpr hx)
      (show (0 : ℝ) ≤ x + 1 by linarith)]
  have hUxOne : U ≤ x + 1 := by
    calc
      U ≤ T + 1 := hU.2
      _ ≤ x + 1 := by linarith
  have hleftArg : U + 2 ≤ x ^ 3 :=
    (by linarith : U + 2 ≤ x + 3).trans hxPlusThree
  have hrightArg : U + 1 ≤ x ^ 2 :=
    (by linarith : U + 1 ≤ x + 2).trans hxPlusTwo
  have hQ0 : 0 ≤ Q := by
    dsimp [Q]
    exact Real.log_nonneg (by linarith)
  have hLQ : L ≤ 3 * Q := by
    calc
      L = Real.log (U + 2) := rfl
      _ ≤ Real.log (x ^ 3) := Real.log_le_log (by linarith) hleftArg
      _ = 3 * Q := by rw [Real.log_pow]; simp [Q]
  have hRQ : R ≤ 2 * Q := by
    calc
      R = Real.log (U + 1) := rfl
      _ ≤ Real.log (x ^ 2) := Real.log_le_log (by linarith) hrightArg
      _ = 2 * Q := by rw [Real.log_pow]; simp [Q]
  have hLR : L * R ≤ 6 * Q ^ 2 := by
    calc
      L * R ≤ (3 * Q) * (2 * Q) :=
        mul_le_mul hLQ hRQ hR0 (by positivity)
      _ = 6 * Q ^ 2 := by ring
  have hsource :
      ‖∫ t in -U..U,
          dirichletExplicitFormulaIntegrand
            (1 : DirichletCharacter ℂ 1) x
              (((-1 / 2 : ℝ) : ℂ) + t * I)‖ ≤
        720 * (A : ℝ) * Q ^ 2 := by
    calc
      _ ≤ 12 * K * R := by simpa [R] using hraw
      _ = (120 * (A : ℝ)) * (L * R) := by simp [K]; ring
      _ ≤ (120 * (A : ℝ)) * (6 * Q ^ 2) :=
        mul_le_mul_of_nonneg_left hLR (by positivity)
      _ = 720 * (A : ℝ) * Q ^ 2 := by ring
  have hTpos : 0 < T := by linarith
  have hratio : (1 : ℝ) ≤ x / T :=
    (le_div_iff₀ hTpos).2 (by simpa using hTx)
  calc
    _ ≤ 720 * (A : ℝ) * Q ^ 2 := hsource
    _ ≤ (720 * (A : ℝ) * Q ^ 2) * (x / T) :=
      le_mul_of_one_le_right (by positivity) hratio
    _ = 720 * (A : ℝ) * x * Real.log x ^ 2 / T := by simp [Q]; ring

end

section
open Complex Set

section RiemannZetaHorizontalLogDerivative
theorem log_riemannZetaSelectedHeightScale_le_two_mul
    {T U : ℝ} (hT : 2 ≤ T) (hU : U ∈ Icc T (T + 1)) :
    Real.log (|U| + 2) ≤ 2 * Real.log (T + 2) := by
  have hU0 : 0 ≤ U := by linarith [hT, hU.1]
  have hheight : U + 2 ≤ (T + 2) ^ 2 := by
    nlinarith [hU.2, sq_nonneg T]
  calc
    Real.log (|U| + 2) ≤ Real.log ((T + 2) ^ 2) := by
      rw [abs_of_nonneg hU0]
      exact Real.log_le_log (by linarith) hheight
    _ = 2 * Real.log (T + 2) := by
      rw [Real.log_pow]
      norm_num

end RiemannZetaHorizontalLogDerivative

theorem exists_nat_norm_logDeriv_LFunction_modOne_horizontal_le :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ C : ℕ, 2 ≤ C →
        ∀ (T U sigma : ℝ), 2 ≤ T →
          U ∈ Icc T (T + 1) →
            -1 ≤ sigma → sigma ≤ 3 →
              (∀ rho : ℂ,
                (rho ≠ 1 ∨ (1 : DirichletCharacter ℂ 1) ≠ 1) →
                  DirichletCharacter.LFunction
                      (1 : DirichletCharacter ℂ 1) rho = 0 →
                    (1 / ((C : ℝ) * Real.log (T + 2)) ≤
                      |U - rho.im|) ∧
                    (1 / ((C : ℝ) * Real.log (T + 2)) ≤
                      |U + rho.im|)) →
                ‖logDeriv (DirichletCharacter.LFunction
                    (1 : DirichletCharacter ℂ 1))
                    ((sigma : ℂ) + U * I)‖ ≤
                  10 * (A : ℝ) * C * Real.log (T + 2) ^ 2 ∧
                ‖logDeriv (DirichletCharacter.LFunction
                    (1 : DirichletCharacter ℂ 1))
                    ((sigma : ℂ) - U * I)‖ ≤
                  10 * (A : ℝ) * C * Real.log (T + 2) ^ 2 := by
  obtain ⟨Af, hAf, hfixed⟩ :=
    exists_nat_norm_logDeriv_riemannZeta₁_sub_radiusSix_divisor_finsum_le
  obtain ⟨Ad, _hAd, hmass⟩ :=
    exists_nat_finsum_divisor_riemannZeta₁_radiusSix_le
  let A := max Af Ad
  refine ⟨A, hAf.trans (Nat.le_max_left Af Ad), ?_⟩
  intro C hC T U sigma hT hU hsigmaLower hsigmaUpper hclear
  let L : ℝ := Real.log (T + 2)
  let delta : ℝ := 1 / ((C : ℝ) * L)
  have hLone : (1 : ℝ) ≤ L := by
    simpa [L] using one_le_riemannZetaHorizontalLogScale hT
  have hL0 : 0 ≤ L := zero_le_one.trans hLone
  have hCreal : (2 : ℝ) ≤ C := by exact_mod_cast hC
  have hC0 : (0 : ℝ) ≤ C := by positivity
  have hdelta : 0 < delta :=
    one_div_pos.mpr (mul_pos (by linarith) (by linarith))
  have hU0 : 0 ≤ U := by linarith [hT, hU.1]
  have hheightLog : Real.log (|U| + 2) ≤ 2 * L := by
    simpa [L] using log_riemannZetaSelectedHeightScale_le_two_mul hT hU
  have hAfA : Af ≤ A := Nat.le_max_left Af Ad
  have hAdA : Ad ≤ A := Nat.le_max_right Af Ad
  have hAfAReal : (Af : ℝ) ≤ A := by exact_mod_cast hAfA
  have hAdAReal : (Ad : ℝ) ≤ A := by exact_mod_cast hAdA
  have hA37 : 37 ≤ A := hAf.trans hAfA
  have hA0 : (0 : ℝ) ≤ A := by positivity
  have hbound : ∀ (t : ℝ), |t| = U →
      (∀ rho : ℂ, riemannZeta rho = 0 → rho ≠ 1 →
        delta ≤ |t - rho.im|) →
      ∀ (r : ℝ), -1 ≤ r → r ≤ 3 →
        ‖logDeriv riemannZeta ((r : ℂ) + t * I)‖ ≤
          10 * (A : ℝ) * C * L ^ 2 := by
    intro t htAbs hclearSigned r hrLower hrUpper
    let s : ℂ := (r : ℂ) + t * I
    let D : ℂ → ℤ := MeromorphicOn.divisor riemannZeta₁
      (closedBall ((2 : ℂ) + t * I) 6)
    have hlogt : Real.log (|t| + 2) ≤ 2 * L := by
      simpa [htAbs, abs_of_nonneg hU0] using hheightLog
    have hlogt0 : 0 ≤ Real.log (|t| + 2) :=
      Real.log_nonneg (by linarith [abs_nonneg t])
    have hsDisk : s ∈ closedBall ((2 : ℂ) + t * I) 3 := by
      rw [mem_closedBall, Complex.dist_eq]
      have hsSub : s - ((2 : ℂ) + t * I) = ((r - 2 : ℝ) : ℂ) := by
        dsimp [s]
        push_cast
        ring
      rw [hsSub, Complex.norm_real, Real.norm_eq_abs, abs_le]
      constructor
      · linarith
      · linarith
    have hsOne : s ≠ 1 := by
      intro hsEq
      have ht0 : 0 < |t| := by
        rw [htAbs]
        linarith [hT, hU.1]
      exact (abs_pos.mp ht0) (by simpa [s] using congrArg Complex.im hsEq)
    have hsZeta : riemannZeta s ≠ 0 := by
      intro hsZero
      have hsep := hclearSigned s hsZero hsOne
      have hsim : s.im = t := by simp [s]
      rw [hsim, sub_self, abs_zero] at hsep
      linarith
    have hsZetaOne : riemannZeta₁ s ≠ 0 := by
      intro hsZero
      have hfactor := riemannZeta_eq_inv_sub_mul hsOne
      rw [hsZero, mul_zero] at hfactor
      exact hsZeta hfactor
    have hresidual0 := hfixed t s hsDisk hsZetaOne
    have hprodResidual :
        (Af : ℝ) * Real.log (|t| + 2) ≤ (A : ℝ) * (2 * L) :=
      mul_le_mul hAfAReal hlogt hlogt0 hA0
    have hresidual :
        ‖logDeriv riemannZeta₁ s -
            ∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ ≤
          32 * (A : ℝ) * L / 3 := by
      calc
        _ ≤ 16 * ((Af : ℝ) * Real.log (|t| + 2)) / 3 := by
          simpa [D] using hresidual0
        _ ≤ 16 * ((A : ℝ) * (2 * L)) / 3 := by
          exact div_le_div_of_nonneg_right
            (mul_le_mul_of_nonneg_left hprodResidual (by norm_num))
            (by norm_num)
        _ = 32 * (A : ℝ) * L / 3 := by ring
    have hDfinite : D.support.Finite := by
      simpa [D] using divisor_riemannZeta₁_closedBall_support_finite
        ((2 : ℂ) + t * I) 6
    have hDnonneg : 0 ≤ D := by
      intro rho
      exact (divisor_riemannZeta₁_nonneg
        (closedBall ((2 : ℂ) + t * I) 6)) rho
    have hDsep : ∀ rho ∈ D.support, delta ≤ ‖s - rho‖ := by
      intro rho hrho
      have hrhoDisk : rho ∈ closedBall ((2 : ℂ) + t * I) 6 :=
        (MeromorphicOn.divisor riemannZeta₁
          (closedBall ((2 : ℂ) + t * I) 6)).supportWithinDomain
            (by simpa [D] using hrho)
      have hrhoReg : riemannZeta₁ rho = 0 :=
        (mem_support_divisor_riemannZeta₁_iff hrhoDisk).1
          (by simpa [D] using hrho)
      have hrhoOne : rho ≠ 1 := by
        intro h
        subst rho
        rw [riemannZeta₁_one] at hrhoReg
        exact one_ne_zero hrhoReg
      have hrhoZero : riemannZeta rho = 0 := by
        have hfactor := riemannZeta_eq_inv_sub_mul hrhoOne
        rw [hrhoReg, mul_zero] at hfactor
        exact hfactor
      calc
        delta ≤ |t - rho.im| := hclearSigned rho hrhoZero hrhoOne
        _ = |(s - rho).im| := by simp [s]
        _ ≤ ‖s - rho‖ := Complex.abs_im_le_norm _
    have hsum0 := norm_finsum_intCast_div_sub_le
      D hDfinite hDnonneg hdelta hDsep
    have hmass0 := hmass t
    have hprodMass :
        (Ad : ℝ) * Real.log (|t| + 2) ≤ (A : ℝ) * (2 * L) :=
      mul_le_mul hAdAReal hlogt hlogt0 hA0
    have hmassBound : ((∑ᶠ rho : ℂ, D rho : ℤ) : ℝ) ≤
        4 * (A : ℝ) * L := by
      calc
        _ ≤ 2 * (Ad : ℝ) * Real.log (|t| + 2) := by
          simpa [D] using hmass0
        _ ≤ 2 * ((A : ℝ) * (2 * L)) := by nlinarith
        _ = 4 * (A : ℝ) * L := by ring
    have hsum : ‖∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ ≤
        4 * (A : ℝ) * C * L ^ 2 := by
      calc
        _ ≤ ((∑ᶠ rho : ℂ, D rho : ℤ) : ℝ) / delta := hsum0
        _ ≤ (4 * (A : ℝ) * L) / delta :=
          div_le_div_of_nonneg_right hmassBound hdelta.le
        _ = 4 * (A : ℝ) * C * L ^ 2 := by
          dsimp [delta]
          field_simp
    have hTnorm : 2 ≤ ‖s - 1‖ := by
      calc
        2 ≤ |t| := by simpa [htAbs] using hT.trans hU.1
        _ = |(s - 1).im| := by simp [s]
        _ ≤ ‖s - 1‖ := Complex.abs_im_le_norm _
    have hpole : ‖(s - 1)⁻¹‖ ≤ 1 / 2 := by
      rw [norm_inv]
      simpa [one_div] using
        one_div_le_one_div_of_le (by norm_num) hTnorm
    have hrelation :=
      neg_logDeriv_riemannZeta_eq_pole_sub_regularized_of_ne_zero
        s hsOne hsZeta
    have hCLtwo : (2 : ℝ) ≤ (C : ℝ) * L := by
      nlinarith [mul_le_mul hCreal hLone
        (by norm_num : (0 : ℝ) ≤ 1) hC0]
    have hAL0 : 0 ≤ (A : ℝ) * L := mul_nonneg hA0 hL0
    have hscaleProduct : 2 * ((A : ℝ) * L) ≤
        ((C : ℝ) * L) * ((A : ℝ) * L) :=
      mul_le_mul_of_nonneg_right hCLtwo hAL0
    have hhalf : (1 / 2 : ℝ) ≤
        (2 / 3) * (A : ℝ) * C * L ^ 2 := by
      have hAreal : (37 : ℝ) ≤ A := by exact_mod_cast hA37
      nlinarith [mul_le_mul hCreal hLone
        (by norm_num : (0 : ℝ) ≤ 1) hC0]
    have hregularTotal : ‖logDeriv riemannZeta₁ s‖ ≤
        ‖logDeriv riemannZeta₁ s -
          ∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ +
        ‖∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ := by
      calc
        ‖logDeriv riemannZeta₁ s‖ =
            ‖(logDeriv riemannZeta₁ s -
                ∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)) +
              ∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ := by ring_nf
        _ ≤ _ := norm_add_le _ _
    calc
      ‖logDeriv riemannZeta s‖ =
          ‖logDeriv riemannZeta₁ s - (s - 1)⁻¹‖ := by
        have heq : logDeriv riemannZeta s =
            logDeriv riemannZeta₁ s - (s - 1)⁻¹ := by
          linear_combination -hrelation
        rw [heq]
      _ ≤ ‖logDeriv riemannZeta₁ s‖ + ‖(s - 1)⁻¹‖ := norm_sub_le _ _
      _ ≤ (‖logDeriv riemannZeta₁ s -
            ∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖ +
          ‖∑ᶠ rho : ℂ, (D rho : ℂ) / (s - rho)‖) +
            ‖(s - 1)⁻¹‖ := add_le_add hregularTotal le_rfl
      _ ≤ 32 * (A : ℝ) * L / 3 +
          4 * (A : ℝ) * C * L ^ 2 + 1 / 2 :=
        add_le_add (add_le_add hresidual hsum) hpole
      _ ≤ 10 * (A : ℝ) * C * L ^ 2 := by
        nlinarith [hscaleProduct, hhalf]
  constructor
  · have hu := hbound U (abs_of_nonneg hU0)
        (fun rho hrho hrhoOne =>
          (hclear rho (Or.inl hrhoOne) (by simpa using hrho)).1)
        sigma hsigmaLower hsigmaUpper
    simpa [L, DirichletCharacter.LFunction_modOne_eq] using hu
  · have hl := hbound (-U) (by rw [abs_neg, abs_of_nonneg hU0])
        (fun rho hrho hrhoOne => by
          have hc :=
            (hclear rho (Or.inl hrhoOne) (by simpa using hrho)).2
          convert hc using 1
          rw [show -U - rho.im = -(U + rho.im) by ring, abs_neg])
        sigma hsigmaLower hsigmaUpper
    simpa [L, sub_eq_add_neg, DirichletCharacter.LFunction_modOne_eq]
      using hl

end

section
open Complex Set
open scoped Interval

theorem
    exists_nat_norm_intervalIntegral_dirichletExplicitFormulaIntegrand_modOne_horizontal_le :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ C : ℕ, 2 ≤ C →
        ∀ (x T U : ℝ), 2 ≤ T → T ≤ x →
          U ∈ Icc T (T + 1) →
            (∀ rho : ℂ,
              (rho ≠ 1 ∨ (1 : DirichletCharacter ℂ 1) ≠ 1) →
                DirichletCharacter.LFunction
                    (1 : DirichletCharacter ℂ 1) rho = 0 →
                  (1 / ((C : ℝ) * Real.log (T + 2)) ≤
                    |U - rho.im|) ∧
                  (1 / ((C : ℝ) * Real.log (T + 2)) ≤
                    |U + rho.im|)) →
              ‖∫ sigma in (-1 / 2)..(1 + 1 / Real.log x),
                  dirichletExplicitFormulaIntegrand
                    (1 : DirichletCharacter ℂ 1) x
                    ((sigma : ℂ) + U * I)‖ ≤
                640 * (A : ℝ) * C * x * Real.log x ^ 2 / T ∧
              ‖∫ sigma in (-1 / 2)..(1 + 1 / Real.log x),
                  dirichletExplicitFormulaIntegrand
                    (1 : DirichletCharacter ℂ 1) x
                    ((sigma : ℂ) - U * I)‖ ≤
                640 * (A : ℝ) * C * x * Real.log x ^ 2 / T := by
  obtain ⟨A, hA, hpointwise⟩ :=
    exists_nat_norm_logDeriv_LFunction_modOne_horizontal_le
  refine ⟨A, hA, ?_⟩
  intro C hC x T U hT hTx hU hclear
  let a : ℝ := -1 / 2
  let b : ℝ := 1 + 1 / Real.log x
  let L : ℝ := Real.log (T + 2)
  let Q : ℝ := Real.log x
  let K : ℝ := 10 * (A : ℝ) * C * L ^ 2
  have hx : 2 ≤ x := hT.trans hTx
  have hlogx : 0 < Real.log x := Real.log_pos (by linarith)
  have hab : a ≤ b := by
    dsimp [a, b]
    linarith [one_div_pos.mpr hlogx]
  have hlogHalf : (1 / 2 : ℝ) < Real.log x := by
    have hlogTwo : Real.log 2 ≤ Real.log x :=
      Real.log_le_log (by norm_num) hx
    nlinarith [Real.log_two_gt_d9]
  have hinvLog : 1 / Real.log x ≤ 2 := by
    apply (div_le_iff₀ hlogx).2
    nlinarith
  have hbThree : b ≤ 3 := by dsimp [b]; linarith
  have hlength : b - a ≤ 4 := by dsimp [a]; linarith
  have hTpos : 0 < T := by linarith
  have hU0 : 0 ≤ U := by linarith [hT, hU.1]
  have htUpper : T ≤ |U| := by
    simpa [abs_of_nonneg hU0] using hU.1
  have htLower : T ≤ |-U| := by simpa [abs_neg] using htUpper
  have hLone : (1 : ℝ) ≤ L := by
    simpa [L] using one_le_riemannZetaHorizontalLogScale hT
  have hK0 : 0 ≤ K := by dsimp [K]; positivity
  have hintegrable :=
    intervalIntegrable_dirichletExplicitFormulaIntegrand_modOne_horizontal
      hC hT hU hclear hx
  have hupperLog : ∀ r ∈ Icc a b,
      ‖logDeriv (DirichletCharacter.LFunction
        (1 : DirichletCharacter ℂ 1)) ((r : ℂ) + U * I)‖ ≤ K := by
    intro r hr
    have hp := hpointwise C hC T U r hT hU
      (by dsimp [a] at hr; linarith [hr.1])
      (hr.2.trans hbThree) hclear
    simpa [K, L] using hp.1
  have hlowerLog : ∀ r ∈ Icc a b,
      ‖logDeriv (DirichletCharacter.LFunction
        (1 : DirichletCharacter ℂ 1))
          ((r : ℂ) + ((-U : ℝ) : ℂ) * I)‖ ≤ K := by
    intro r hr
    have hp := hpointwise C hC T U r hT hU
      (by dsimp [a] at hr; linarith [hr.1])
      (hr.2.trans hbThree) hclear
    simpa [K, L, sub_eq_add_neg] using hp.2
  have hlowerIntegrable : IntervalIntegrable
      (fun r : ℝ => dirichletExplicitFormulaIntegrand
        (1 : DirichletCharacter ℂ 1) x
          ((r : ℂ) + ((-U : ℝ) : ℂ) * I)) volume a b := by
    simpa [a, b, sub_eq_add_neg] using hintegrable.2
  have hupperRaw :=
    norm_intervalIntegral_dirichletExplicitFormulaIntegrand_horizontal_le
      (1 : DirichletCharacter ℂ 1)
      (x := x) (a := a) (b := b) (t := U) (T := T) (K := K)
      hx hab (by simp [b]) hTpos htUpper hK0
      (by simpa [a, b] using hintegrable.1) hupperLog
  have hlowerRaw :=
    norm_intervalIntegral_dirichletExplicitFormulaIntegrand_horizontal_le
      (1 : DirichletCharacter ℂ 1)
      (x := x) (a := a) (b := b) (t := -U) (T := T) (K := K)
      hx hab (by simp [b]) hTpos htLower hK0 hlowerIntegrable hlowerLog
  have hL0 : 0 ≤ L := zero_le_one.trans hLone
  have hargPos : 0 < T + 2 := by linarith
  have harg : T + 2 ≤ x ^ 2 := by
    have hxpoly : x + 2 ≤ x ^ 2 := by
      nlinarith [mul_nonneg (sub_nonneg.mpr hx)
        (by linarith : 0 ≤ x + 1)]
    nlinarith
  have hLQ : L ≤ 2 * Q := by
    calc
      L = Real.log (T + 2) := rfl
      _ ≤ Real.log (x ^ 2) := Real.log_le_log hargPos harg
      _ = 2 * Q := by rw [Real.log_pow]; simp [Q]
  have hLsq : L ^ 2 ≤ 4 * Q ^ 2 := by
    calc
      L ^ 2 ≤ (2 * Q) ^ 2 := pow_le_pow_left₀ hL0 hLQ 2
      _ = 4 * Q ^ 2 := by ring
  have hselectedUpper :
      ‖∫ r in a..b, dirichletExplicitFormulaIntegrand
          (1 : DirichletCharacter ℂ 1) x ((r : ℂ) + U * I)‖ ≤
        160 * (A : ℝ) * C * x * L ^ 2 / T := by
    calc
      _ ≤ (4 * K * x / T) * (b - a) := hupperRaw
      _ ≤ (4 * K * x / T) * 4 :=
        mul_le_mul_of_nonneg_left hlength (by positivity)
      _ = 160 * (A : ℝ) * C * x * L ^ 2 / T := by
        simp [K]
        ring
  have hselectedLower :
      ‖∫ r in a..b, dirichletExplicitFormulaIntegrand
          (1 : DirichletCharacter ℂ 1) x
            ((r : ℂ) + ((-U : ℝ) : ℂ) * I)‖ ≤
        160 * (A : ℝ) * C * x * L ^ 2 / T := by
    calc
      _ ≤ (4 * K * x / T) * (b - a) := hlowerRaw
      _ ≤ (4 * K * x / T) * 4 :=
        mul_le_mul_of_nonneg_left hlength (by positivity)
      _ = 160 * (A : ℝ) * C * x * L ^ 2 / T := by
        simp [K]
        ring
  have hcoefficient : 0 ≤ 160 * (A : ℝ) * C * x := by positivity
  have hsourceNumerator :
      160 * (A : ℝ) * C * x * L ^ 2 ≤
        640 * (A : ℝ) * C * x * Q ^ 2 := by
    calc
      _ ≤ (160 * (A : ℝ) * C * x) * (4 * Q ^ 2) :=
        mul_le_mul_of_nonneg_left hLsq hcoefficient
      _ = 640 * (A : ℝ) * C * x * Q ^ 2 := by ring
  constructor
  · have hfinal := hselectedUpper.trans
      (div_le_div_of_nonneg_right hsourceNumerator hTpos.le)
    simpa [a, b, L, Q] using hfinal
  · have hfinal := hselectedLower.trans
      (div_le_div_of_nonneg_right hsourceNumerator hTpos.le)
    simpa [a, b, L, Q, sub_eq_add_neg] using hfinal

end

section
open Complex Set
open scoped Interval

theorem
    exists_nat_norm_dirichletExplicitFormulaNormalizedRightEdge_sub_mainZeroTerms_le :
    ∃ A : ℕ, 37 ≤ A ∧
      ∃ C : ℕ, 2 ≤ C ∧
        ∀ (q : ℕ) [NeZero q]
          (chi : DirichletCharacter ℂ q), chi.IsPrimitive →
            ∀ T : ℝ, 2 ≤ T →
              ∃ U : ℝ, U ∈ Set.Icc T (T + 1) ∧
                (∀ rho : ℂ,
                  (rho ≠ 1 ∨ chi ≠ 1) →
                    DirichletCharacter.LFunction chi rho = 0 →
                      (1 / ((C : ℝ) *
                          Real.log ((q : ℝ) * (T + 2))) ≤
                        |U - rho.im|) ∧
                      (1 / ((C : ℝ) *
                          Real.log ((q : ℝ) * (T + 2))) ≤
                        |U + rho.im|)) ∧
                ∀ x : ℝ, T ≤ x →
                  ‖dirichletExplicitFormulaNormalizedRightEdge chi x U -
                      dirichletExplicitFormulaMainZeroTerms chi x T‖ ≤
                    1700 * (A : ℝ) * C *
                      dirichletExplicitFormulaErrorScale x q T := by
  obtain ⟨Aph, hAph, hprimitiveHorizontal⟩ :=
    exists_nat_norm_intervalIntegral_dirichletExplicitFormulaIntegrand_primitive_horizontal_le
  obtain ⟨Azh, hAzh, hzetaHorizontal⟩ :=
    exists_nat_norm_intervalIntegral_dirichletExplicitFormulaIntegrand_modOne_horizontal_le
  obtain ⟨Apl, hApl, hprimitiveLeft⟩ :=
    exists_nat_norm_intervalIntegral_dirichletExplicitFormulaIntegrand_primitive_leftEdge_le
  obtain ⟨Azl, hAzl, hzetaLeft⟩ :=
    exists_nat_norm_intervalIntegral_dirichletExplicitFormulaIntegrand_modOne_leftEdge_le
  obtain ⟨As, hAs, hshell⟩ :=
    exists_nat_norm_dirichletNontrivialZeroKernelSum_selected_sub_requested_le
  obtain ⟨C, hC, hselect⟩ :=
    exists_nat_guardedLFunctionZero_twoSided_clearance
  let A := Aph + Azh + Apl + Azl + As
  have hA : 37 ≤ A := by
    dsimp [A]
    omega
  have hAphA : Aph ≤ A := by dsimp [A]; omega
  have hAzhA : Azh ≤ A := by dsimp [A]; omega
  have hAplA : Apl ≤ A := by dsimp [A]; omega
  have hAzlA : Azl ≤ A := by dsimp [A]; omega
  have hAsA : As ≤ A := by dsimp [A]; omega
  refine ⟨A, hA, C, hC, ?_⟩
  intro q _ chi hchi T hT
  obtain ⟨U, hU, hclear⟩ := hselect q chi T hT
  refine ⟨U, hU, hclear, ?_⟩
  intro x hTx
  let E := dirichletExplicitFormulaErrorScale x q T
  have hx : 2 ≤ x := hT.trans hTx
  have hxone : 1 < x := one_lt_two.trans_le hx
  have hTpos : 0 < T := zero_lt_two.trans_le hT
  have hUpos : 0 < U := by linarith [hT, hU.1]
  have hCReal : (2 : ℝ) ≤ C := by exact_mod_cast hC
  have hCNonneg : (0 : ℝ) ≤ C := by linarith
  have hE : 0 ≤ E := by
    dsimp [E, dirichletExplicitFormulaErrorScale]
    positivity
  have hscaleWithC :
      ∀ (Ai : ℕ), Ai ≤ A → ∀ K : ℝ, 0 ≤ K →
        K * (Ai : ℝ) * C * E ≤ K * (A : ℝ) * C * E := by
    intro Ai hAi K hK
    apply mul_le_mul_of_nonneg_right _ hE
    apply mul_le_mul_of_nonneg_right _ hCNonneg
    apply mul_le_mul_of_nonneg_left _ hK
    exact_mod_cast hAi
  have hscaleWithoutC :
      ∀ (Ai : ℕ), Ai ≤ A → ∀ K : ℝ, 0 ≤ K →
        K * (Ai : ℝ) * E ≤ K * (A : ℝ) * E := by
    intro Ai hAi K hK
    apply mul_le_mul_of_nonneg_right _ hE
    apply mul_le_mul_of_nonneg_left _ hK
    exact_mod_cast hAi
  have hinside :
      ({pntCandidate |
        pntCandidate ∈ Complex.Rectangle
          ((((-1 / 2 : ℝ) : ℂ) - U * I))
          ((((1 + 1 / Real.log x : ℝ) : ℂ) + U * I)) ∧
         (((chi) = 1 ∧ pntCandidate = 1) ∨
           ((pntCandidate ≠ 1 ∨ (chi) ≠ 1) ∧
             DirichletCharacter.LFunction (chi) pntCandidate = 0))}) ⊆
        interior (Complex.Rectangle
          (((-1 / 2 : ℝ) : ℂ) - U * I)
          (((1 + 1 / Real.log x : ℝ) : ℂ) + U * I)) := by
    convert
      dirichletExplicitFormulaCandidateSingularities_subset_interior_of_clearance
        chi 0 C hxone hT hU hC hclear using 1 <;> norm_num
  have hcontour :=
    dirichletExplicitFormulaNormalizedRightEdge_eq_sum_add_remainder
      chi hxone hUpos hinside
  have hcandidates :=
    sum_shallowCandidateContribution_eq_mainZeroTerms_add_correction_of_isPrimitive
      chi hchi x U hxone
  have hcorrection :=
    norm_dirichletExplicitFormulaShallowMainTermCorrection_le_four_mul_errorScale
      chi hT hTx
  have hshellRaw := hshell q chi hchi x T U hT hTx hU
  have hedgeBounds :
      (‖∫ sigma in (-1 / 2)..(1 + 1 / Real.log x),
          dirichletExplicitFormulaIntegrand chi x
            ((sigma : ℂ) + U * I)‖ ≤
          640 * (A : ℝ) * C * E) ∧
      (‖∫ sigma in (-1 / 2)..(1 + 1 / Real.log x),
          dirichletExplicitFormulaIntegrand chi x
            ((sigma : ℂ) - U * I)‖ ≤
          640 * (A : ℝ) * C * E) ∧
      ‖∫ t in -U..U,
          dirichletExplicitFormulaIntegrand chi x
            (((-1 / 2 : ℝ) : ℂ) + t * I)‖ ≤
        720 * (A : ℝ) * E := by
    by_cases hqOne : q = 1
    · subst q
      have hchiOne : chi = (1 : DirichletCharacter ℂ 1) :=
        Subsingleton.elim _ _
      subst chi
      have hclearOne : ∀ rho : ℂ,
          (rho ≠ 1 ∨ (1 : DirichletCharacter ℂ 1) ≠ 1) →
            DirichletCharacter.LFunction
                (1 : DirichletCharacter ℂ 1) rho = 0 →
              (1 / ((C : ℝ) * Real.log (T + 2)) ≤
                |U - rho.im|) ∧
              (1 / ((C : ℝ) * Real.log (T + 2)) ≤
                |U + rho.im|) := by
        simpa using hclear
      have hh := hzetaHorizontal C hC x T U hT hTx hU hclearOne
      have hl := hzetaLeft x T U hT hTx hU
      have hhUpper :
          ‖∫ sigma in (-1 / 2)..(1 + 1 / Real.log x),
              dirichletExplicitFormulaIntegrand
                (1 : DirichletCharacter ℂ 1) x
                ((sigma : ℂ) + U * I)‖ ≤
            640 * (Azh : ℝ) * C * E := by
        calc
          _ ≤ 640 * (Azh : ℝ) * C * x * Real.log x ^ 2 / T := hh.1
          _ = 640 * (Azh : ℝ) * C * E := by
            dsimp [E, dirichletExplicitFormulaErrorScale]
            ring_nf
      have hhLower :
          ‖∫ sigma in (-1 / 2)..(1 + 1 / Real.log x),
              dirichletExplicitFormulaIntegrand
                (1 : DirichletCharacter ℂ 1) x
                ((sigma : ℂ) - U * I)‖ ≤
            640 * (Azh : ℝ) * C * E := by
        calc
          _ ≤ 640 * (Azh : ℝ) * C * x * Real.log x ^ 2 / T := hh.2
          _ = 640 * (Azh : ℝ) * C * E := by
            dsimp [E, dirichletExplicitFormulaErrorScale]
            ring_nf
      have hlBound :
          ‖∫ t in -U..U,
              dirichletExplicitFormulaIntegrand
                (1 : DirichletCharacter ℂ 1) x
                (((-1 / 2 : ℝ) : ℂ) + t * I)‖ ≤
            720 * (Azl : ℝ) * E := by
        calc
          _ ≤ 720 * (Azl : ℝ) * x * Real.log x ^ 2 / T := hl
          _ = 720 * (Azl : ℝ) * E := by
            dsimp [E, dirichletExplicitFormulaErrorScale]
            ring_nf
      exact ⟨hhUpper.trans (hscaleWithC Azh hAzhA 640 (by norm_num)),
        hhLower.trans (hscaleWithC Azh hAzhA 640 (by norm_num)),
        hlBound.trans (hscaleWithoutC Azl hAzlA 720 (by norm_num))⟩
    · have hq : 1 < q := by
        have hqpos := Nat.pos_of_ne_zero (NeZero.ne q)
        omega
      have hh :=
        hprimitiveHorizontal C hC q hq chi hchi x T U hT hTx hU hclear
      have hl := hprimitiveLeft q hq chi hchi x T U hT hTx hU
      have hlogEq :
          Real.log ((q : ℝ) * x) = Real.log (x * (q : ℝ)) := by
        rw [mul_comm]
      have hhUpper :
          ‖∫ sigma in (-1 / 2)..(1 + 1 / Real.log x),
              dirichletExplicitFormulaIntegrand chi x
                ((sigma : ℂ) + U * I)‖ ≤
            640 * (Aph : ℝ) * C * E := by
        calc
          _ ≤ 640 * (Aph : ℝ) * C * x *
              Real.log ((q : ℝ) * x) ^ 2 / T := hh.1
          _ = 640 * (Aph : ℝ) * C * E := by
            rw [hlogEq]
            dsimp [E, dirichletExplicitFormulaErrorScale]
            ring_nf
      have hhLower :
          ‖∫ sigma in (-1 / 2)..(1 + 1 / Real.log x),
              dirichletExplicitFormulaIntegrand chi x
                ((sigma : ℂ) - U * I)‖ ≤
            640 * (Aph : ℝ) * C * E := by
        calc
          _ ≤ 640 * (Aph : ℝ) * C * x *
              Real.log ((q : ℝ) * x) ^ 2 / T := hh.2
          _ = 640 * (Aph : ℝ) * C * E := by
            rw [hlogEq]
            dsimp [E, dirichletExplicitFormulaErrorScale]
            ring_nf
      have hlBound :
          ‖∫ t in -U..U,
              dirichletExplicitFormulaIntegrand chi x
                (((-1 / 2 : ℝ) : ℂ) + t * I)‖ ≤
            720 * (Apl : ℝ) * E := by
        calc
          _ ≤ 720 * (Apl : ℝ) * x *
              Real.log ((q : ℝ) * x) ^ 2 / T := hl
          _ = 720 * (Apl : ℝ) * E := by
            rw [hlogEq]
            dsimp [E, dirichletExplicitFormulaErrorScale]
            ring_nf
      exact ⟨hhUpper.trans (hscaleWithC Aph hAphA 640 (by norm_num)),
        hhLower.trans (hscaleWithC Aph hAphA 640 (by norm_num)),
        hlBound.trans (hscaleWithoutC Apl hAplA 720 (by norm_num))⟩
  have hremainder :=
    norm_dirichletExplicitFormulaShallowContourRemainder_le
      chi hCReal hE hedgeBounds.2.1 hedgeBounds.1 hedgeBounds.2.2
  have hshellBound :
      ‖dirichletNontrivialZeroKernelSum chi x U -
          dirichletNontrivialZeroKernelSum chi x T‖ ≤
        32 * (A : ℝ) * E := by
    exact hshellRaw.trans (hscaleWithoutC As hAsA 32 (by norm_num))
  have hmainDifference :
      ‖dirichletExplicitFormulaMainZeroTerms chi x U -
          dirichletExplicitFormulaMainZeroTerms chi x T‖ =
        ‖dirichletNontrivialZeroKernelSum chi x U -
          dirichletNontrivialZeroKernelSum chi x T‖ := by
    have heq :
        dirichletExplicitFormulaMainZeroTerms chi x U -
            dirichletExplicitFormulaMainZeroTerms chi x T =
          -(dirichletNontrivialZeroKernelSum chi x U -
            dirichletNontrivialZeroKernelSum chi x T) := by
      simp only [dirichletExplicitFormulaMainZeroTerms]
      ring_nf
    rw [heq, norm_neg]
  have hdecomp :
      dirichletExplicitFormulaNormalizedRightEdge chi x U -
          dirichletExplicitFormulaMainZeroTerms chi x T =
        dirichletExplicitFormulaShallowContourRemainder chi x U +
          dirichletExplicitFormulaShallowMainTermCorrection chi x +
          (dirichletExplicitFormulaMainZeroTerms chi x U -
            dirichletExplicitFormulaMainZeroTerms chi x T) := by
    rw [hcontour, hcandidates]
    ring_nf
  rw [hdecomp]
  calc
    _ ≤ ‖dirichletExplicitFormulaShallowContourRemainder chi x U‖ +
          ‖dirichletExplicitFormulaShallowMainTermCorrection chi x‖ +
          ‖dirichletExplicitFormulaMainZeroTerms chi x U -
            dirichletExplicitFormulaMainZeroTerms chi x T‖ := norm_add₃_le
    _ ≤ 1640 * (A : ℝ) * C * E + 4 * E + 32 * (A : ℝ) * E := by
      rw [hmainDifference]
      gcongr
    _ ≤ 1700 * (A : ℝ) * C * E := by
      have hAReal : (37 : ℝ) ≤ A := by exact_mod_cast hA
      have hANonneg : (0 : ℝ) ≤ A := by linarith
      have hAE : 0 ≤ (A : ℝ) * E := mul_nonneg hANonneg hE
      nlinarith [mul_nonneg (sub_nonneg.mpr hCReal) hAE,
        mul_nonneg (sub_nonneg.mpr hAReal) hE]
    _ = 1700 * (A : ℝ) * C *
        dirichletExplicitFormulaErrorScale x q T := by rfl

end

section
open Complex
open scoped Interval
/--
The truncated Perron kernel for `y ^ s / s` on the line `re = alpha`, with imaginary parameter
from `-U` to `U` and normalization `1 / (2 * pi)`.
-/
noncomputable def dirichletPerronKernel
    (y alpha U : ℝ) : ℂ :=
  (((2 * Real.pi : ℝ) : ℂ)⁻¹) *
    ∫ t in -U..U,
      (y : ℂ) ^ ((alpha : ℂ) + t * I) /
        ((alpha : ℂ) + t * I)

/--
The sharp Perron weight on natural indices: one for `0 < n < x`, one half for `n = x > 0`, and
zero otherwise. The index `n = 0` always has weight zero.
-/
noncomputable def dirichletPerronNaturalWeight (x n : ℕ) : ℝ :=
  if n = 0 then 0
  else if n < x then 1
  else if n = x then 1 / 2
  else 0

@[simp]
theorem dirichletPerronNaturalWeight_zero (x : ℕ) :
    dirichletPerronNaturalWeight x 0 = 0 := by
  simp [dirichletPerronNaturalWeight]

@[simp]
theorem dirichletPerronNaturalWeight_of_pos_of_lt
    {x n : ℕ} (hn : 0 < n) (hnx : n < x) :
    dirichletPerronNaturalWeight x n = 1 := by
  simp [dirichletPerronNaturalWeight, hn.ne', hnx]

@[simp]
theorem dirichletPerronNaturalWeight_self {x : ℕ} (hx : 0 < x) :
    dirichletPerronNaturalWeight x x = 1 / 2 := by
  simp [dirichletPerronNaturalWeight, hx.ne']

@[simp]
theorem dirichletPerronNaturalWeight_of_lt
    {x n : ℕ} (hxn : x < n) :
    dirichletPerronNaturalWeight x n = 0 := by
  have hn : n ≠ 0 := (Nat.zero_lt_of_lt hxn).ne'
  simp [dirichletPerronNaturalWeight, hn,
    Nat.not_lt.mpr hxn.le, hxn.ne']

section DirichletPerronKernel

theorem integral_inv_perronLine
    {alpha U : ℝ} (halpha : 0 < alpha) :
    (∫ t in -U..U, (1 : ℂ) / ((alpha : ℂ) + t * I)) =
      ((2 * Real.arctan (U / alpha) : ℝ) : ℂ) := by
  apply mul_left_cancel₀ Complex.I_ne_zero
  rw [I_mul_integral_div_add_mul_I halpha.ne' 1]
  simp [neg_div, div_neg, Real.arctan_neg]
  ring

theorem arctan_le_self_of_nonneg {z : ℝ} (hz : 0 ≤ z) :
    Real.arctan z ≤ z := by
  have h := intervalIntegral.integral_mono_on hz
    (intervalIntegral.intervalIntegrable_inv_one_add_sq (a := 0) (b := z))
    (show IntervalIntegrable (fun _ : ℝ => (1 : ℝ)) volume 0 z by
      exact intervalIntegrable_const)
    (fun t _ => inv_le_one_of_one_le₀ (by nlinarith [sq_nonneg t]))
  simpa using h

end DirichletPerronKernel

theorem dirichletPerronKernel_one_eq_arctan
    {alpha U : ℝ} (halpha : 0 < alpha) :
    dirichletPerronKernel 1 alpha U =
      ((Real.arctan (U / alpha) / Real.pi : ℝ) : ℂ) := by
  rw [dirichletPerronKernel]
  have hfun :
      (∫ t in -U..U,
        ((1 : ℝ) : ℂ) ^ ((alpha : ℂ) + t * I) /
          ((alpha : ℂ) + t * I)) =
        ∫ t in -U..U, (1 : ℂ) / ((alpha : ℂ) + t * I) := by
    apply intervalIntegral.integral_congr
    intro t _
    simp
  rw [hfun, integral_inv_perronLine halpha]
  push_cast
  field_simp [Real.pi_ne_zero]

theorem norm_dirichletPerronKernel_one_sub_half_le
    {alpha U : ℝ} (halpha : 0 < alpha) (hU : 0 < U) :
    ‖dirichletPerronKernel 1 alpha U - (1 / 2 : ℂ)‖ ≤
      alpha / (Real.pi * U) := by
  rw [dirichletPerronKernel_one_eq_arctan halpha]
  rw [show (1 / 2 : ℂ) = ((1 / 2 : ℝ) : ℂ) by norm_num,
    ← Complex.ofReal_sub, Complex.norm_real, Real.norm_eq_abs]
  have hratio : 0 < U / alpha := div_pos hU halpha
  have hnonpos :
      Real.arctan (U / alpha) / Real.pi - 1 / 2 ≤ 0 := by
    rw [sub_nonpos, div_le_iff₀ Real.pi_pos]
    nlinarith [Real.arctan_lt_pi_div_two (U / alpha)]
  rw [abs_of_nonpos hnonpos]
  have hinv : (U / alpha)⁻¹ = alpha / U := by
    field_simp
  have hidentity :
      -(Real.arctan (U / alpha) / Real.pi - 1 / 2) =
        Real.arctan (alpha / U) / Real.pi := by
    rw [← hinv, Real.arctan_inv_of_pos hratio]
    field_simp [Real.pi_ne_zero]
    ring
  rw [hidentity]
  calc
    Real.arctan (alpha / U) / Real.pi ≤
        (alpha / U) / Real.pi :=
      div_le_div_of_nonneg_right
        (arctan_le_self_of_nonneg (div_nonneg halpha.le hU.le))
        Real.pi_pos.le
    _ = alpha / (Real.pi * U) := by field_simp

end

section
open Set
open scoped Interval

section DirichletSineRemainder
/-- The exponentially damped sine kernel `exp (-u * t) * sin u`, with Laplace parameter `t`. -/
noncomputable def laplaceSineIntegrand (u t : ℝ) : ℝ :=
  Real.exp (-u * t) * Real.sin u

/--
The Laplace representation kernel `exp (-X * t) * (cos X + t * sin X) / (1 + t ^ 2)` used to
bound the truncated sine-integral remainder.
-/
noncomputable def dirichletSineRemainderIntegrand (X t : ℝ) : ℝ :=
  Real.exp (-X * t) * (Real.cos X + t * Real.sin X) / (1 + t ^ 2)

theorem abs_cos_add_mul_sin_le_sqrt (X t : ℝ) :
    |Real.cos X + t * Real.sin X| ≤ Real.sqrt (1 + t ^ 2) := by
  apply Real.abs_le_sqrt
  nlinarith [sq_nonneg (t * Real.cos X - Real.sin X), Real.cos_sq_add_sin_sq X]

theorem norm_dirichletSineRemainderIntegrand_le_exp (X t : ℝ) :
    ‖dirichletSineRemainderIntegrand X t‖ ≤ Real.exp (-X * t) := by
  have hden : 0 < 1 + t ^ 2 := by positivity
  have hsqrt : Real.sqrt (1 + t ^ 2) ≤ 1 + t ^ 2 := by
    rw [Real.sqrt_le_left hden.le]
    nlinarith [sq_nonneg t]
  rw [dirichletSineRemainderIntegrand, Real.norm_eq_abs, abs_div, abs_mul,
    abs_of_pos (Real.exp_pos _), abs_of_pos hden]
  calc
    Real.exp (-X * t) * |Real.cos X + t * Real.sin X| / (1 + t ^ 2)
        ≤ Real.exp (-X * t) * Real.sqrt (1 + t ^ 2) / (1 + t ^ 2) := by
          gcongr
          exact abs_cos_add_mul_sin_le_sqrt X t
    _ ≤ Real.exp (-X * t) * (1 + t ^ 2) / (1 + t ^ 2) := by gcongr
    _ = Real.exp (-X * t) := by field_simp

theorem integrableOn_dirichletSineRemainderIntegrand_Ioi {X : ℝ} (hX : 0 < X) :
    IntegrableOn (dirichletSineRemainderIntegrand X) (Ioi 0) := by
  refine (integrableOn_exp_mul_Ioi (a := -X) (by linarith) 0).mono' ?_ ?_
  · unfold dirichletSineRemainderIntegrand
    exact ((by fun_prop : Continuous fun t : ℝ ↦
        Real.exp (-X * t) * (Real.cos X + t * Real.sin X)).div
      (by fun_prop : Continuous fun t : ℝ ↦ 1 + t ^ 2)
      (fun t ↦ by positivity)).aestronglyMeasurable
  filter_upwards with t
  exact norm_dirichletSineRemainderIntegrand_le_exp X t

theorem integral_laplaceSineIntegrand {u : ℝ} (hu : 0 < u) :
    ∫ t in Ioi 0, laplaceSineIntegrand u t = Real.sinc u := by
  unfold laplaceSineIntegrand
  rw [integral_mul_const, integral_exp_mul_Ioi (a := -u) (by linarith)]
  rw [Real.sinc_of_ne_zero hu.ne']
  simp
  field_simp

theorem integral_norm_laplaceSineIntegrand_le_one {u : ℝ} (hu : 0 < u) :
    ∫ t in Ioi 0, ‖laplaceSineIntegrand u t‖ ≤ 1 := by
  calc
    ∫ t in Ioi 0, ‖laplaceSineIntegrand u t‖ =
        (∫ t in Ioi 0, Real.exp (-u * t)) * |Real.sin u| := by
          unfold laplaceSineIntegrand
          simp_rw [Real.norm_eq_abs, abs_mul, abs_of_pos (Real.exp_pos _)]
          rw [integral_mul_const]
    _ = |Real.sin u| / u := by
      rw [integral_exp_mul_Ioi (a := -u) (by linarith)]
      simp
      field_simp
    _ ≤ 1 := by
      rw [div_le_one hu]
      simpa [abs_of_pos hu] using (Real.abs_sin_le_abs : |Real.sin u| ≤ |u|)

theorem integrable_laplaceSineIntegrand_prod (X : ℝ) :
    Integrable (Function.uncurry laplaceSineIntegrand)
      ((volume.restrict (Ioc 0 X)).prod (volume.restrict (Ioi 0))) := by
  have hmeas : AEStronglyMeasurable (Function.uncurry laplaceSineIntegrand)
      ((volume.restrict (Ioc 0 X)).prod (volume.restrict (Ioi 0))) := by
    unfold laplaceSineIntegrand Function.uncurry
    fun_prop
  rw [integrable_prod_iff hmeas]
  constructor
  · filter_upwards [ae_restrict_mem measurableSet_Ioc] with u hu
    have hu0 : 0 < u := hu.1
    simpa [laplaceSineIntegrand] using
      (integrableOn_exp_mul_Ioi (a := -u) (by linarith) 0).mul_const (Real.sin u)
  · refine (integrableOn_const (C := (1 : ℝ)) measure_Ioc_lt_top.ne).mono'
      hmeas.norm.integral_prod_right' ?_
    filter_upwards [ae_restrict_mem measurableSet_Ioc] with u hu
    rw [Real.norm_eq_abs, abs_of_nonneg (integral_nonneg fun _ ↦ norm_nonneg _)]
    exact integral_norm_laplaceSineIntegrand_le_one hu.1

theorem hasDerivAt_laplaceSineAntiderivative (t u : ℝ) :
    HasDerivAt
      (fun v : ℝ ↦
        -Real.exp (-v * t) * (Real.cos v + t * Real.sin v) / (1 + t ^ 2))
      (laplaceSineIntegrand u t) u := by
  have hden : 1 + t ^ 2 ≠ 0 := by positivity
  have hexp : HasDerivAt (fun v : ℝ ↦ Real.exp (-v * t))
      (-t * Real.exp (-u * t)) u := by
    simpa only [Pi.neg_apply, id_eq, mul_neg, neg_mul, one_mul, mul_one, mul_comm] using
      ((hasDerivAt_id u).neg.mul_const t).exp
  have htrig : HasDerivAt (fun v : ℝ ↦ Real.cos v + t * Real.sin v)
      (-Real.sin u + t * Real.cos u) u :=
    (Real.hasDerivAt_cos u).add ((Real.hasDerivAt_sin u).const_mul t)
  have hvalue :
      -((-t * Real.exp (-u * t)) * (Real.cos u + t * Real.sin u) +
          Real.exp (-u * t) * (-Real.sin u + t * Real.cos u)) / (1 + t ^ 2) =
        laplaceSineIntegrand u t := by
    unfold laplaceSineIntegrand
    field_simp [hden]
    ring_nf
  exact (by
    simpa only [Pi.mul_apply, Pi.neg_apply, Pi.div_apply, neg_mul] using
      ((hexp.mul htrig).neg.div_const (1 + t ^ 2)).congr_deriv hvalue)

theorem intervalIntegral_laplaceSineIntegrand (X t : ℝ) :
    ∫ u in (0 : ℝ)..X, laplaceSineIntegrand u t =
      (1 - Real.exp (-X * t) * (Real.cos X + t * Real.sin X)) / (1 + t ^ 2) := by
  rw [intervalIntegral.integral_eq_sub_of_hasDerivAt
    (fun u _ ↦ hasDerivAt_laplaceSineAntiderivative t u)
    (Continuous.intervalIntegrable (by unfold laplaceSineIntegrand; fun_prop) 0 X)]
  simp only [Real.exp_zero, Real.cos_zero, Real.sin_zero, neg_zero, zero_mul]
  ring

theorem integral_sinc_eq_pi_div_two_sub_remainder {X : ℝ} (hX : 0 < X) :
    ∫ u in (0 : ℝ)..X, Real.sinc u =
      Real.pi / 2 - ∫ t in Ioi 0, dirichletSineRemainderIntegrand X t := by
  have hprod := integrable_laplaceSineIntegrand_prod X
  have hprod' : Integrable (Function.uncurry laplaceSineIntegrand)
      ((volume.restrict (uIoc 0 X)).prod (volume.restrict (Ioi 0))) := by
    simpa [uIoc_of_le hX.le] using hprod
  have hswap := MeasureTheory.intervalIntegral_integral_swap hprod'
  have hleft :
      (∫ u in (0 : ℝ)..X, ∫ t in Ioi 0, laplaceSineIntegrand u t) =
        ∫ u in (0 : ℝ)..X, Real.sinc u := by
    apply intervalIntegral.integral_congr_Ioo_of_le hX.le
    intro u hu
    exact integral_laplaceSineIntegrand hu.1
  have hright :
      (∫ t in Ioi 0, ∫ u in (0 : ℝ)..X, laplaceSineIntegrand u t) =
        Real.pi / 2 - ∫ t in Ioi 0, dirichletSineRemainderIntegrand X t := by
    simp_rw [intervalIntegral_laplaceSineIntegrand]
    have hbase : IntegrableOn (fun t : ℝ ↦ (1 + t ^ 2)⁻¹) (Ioi 0) :=
      integrable_inv_one_add_sq.integrableOn
    have hrem := integrableOn_dirichletSineRemainderIntegrand_Ioi hX
    rw [show (fun t : ℝ ↦
          (1 - Real.exp (-X * t) * (Real.cos X + t * Real.sin X)) / (1 + t ^ 2)) =
        (fun t ↦ (1 + t ^ 2)⁻¹ - dirichletSineRemainderIntegrand X t) by
          funext t
          rw [dirichletSineRemainderIntegrand]
          ring]
    rw [integral_sub hbase hrem, integral_Ioi_inv_one_add_sq]
    simp
  rw [← hleft, hswap, hright]

end DirichletSineRemainder

theorem abs_integral_sinc_sub_pi_div_two_le_inv
    {X : ℝ} (hX : 0 < X) :
    |(∫ u in (0 : ℝ)..X, Real.sinc u) - Real.pi / 2| ≤ X ^ (-1 : ℤ) := by
  rw [integral_sinc_eq_pi_div_two_sub_remainder hX]
  have hrem := integrableOn_dirichletSineRemainderIntegrand_Ioi hX
  calc
    |(Real.pi / 2 - ∫ t in Ioi 0, dirichletSineRemainderIntegrand X t) - Real.pi / 2| =
        |∫ t in Ioi 0, dirichletSineRemainderIntegrand X t| := by ring_nf; simp
    _ ≤ ∫ t in Ioi 0, ‖dirichletSineRemainderIntegrand X t‖ :=
      by
        simpa only [Real.norm_eq_abs] using
          (norm_integral_le_integral_norm
            (dirichletSineRemainderIntegrand X) (μ := volume.restrict (Ioi 0)))
    _ ≤ ∫ t in Ioi 0, Real.exp (-X * t) := by
      exact integral_mono_ae hrem.norm
        (integrableOn_exp_mul_Ioi (a := -X) (by linarith) 0)
        (ae_of_all _ fun t ↦ norm_dirichletSineRemainderIntegrand_le_exp X t)
    _ = X ^ (-1 : ℤ) := by
      rw [integral_exp_mul_Ioi (a := -X) (by linarith)]
      simp [zpow_neg]

theorem abs_integral_sinc_sub_sign_pi_div_two_le_inv_abs
    {X : ℝ} (hX : X ≠ 0) :
    |(∫ u in (0 : ℝ)..X, Real.sinc u) -
      Real.sign X * (Real.pi / 2)| ≤ |X| ^ (-1 : ℤ) := by
  rcases lt_or_gt_of_ne hX with hXneg | hXpos
  · have h := abs_integral_sinc_sub_pi_div_two_le_inv
      (X := -X) (by linarith)
    have hneg : (∫ u in (0 : ℝ)..(-X), Real.sinc u) =
        -(∫ u in (0 : ℝ)..X, Real.sinc u) := by
      simpa only [Real.sinc_neg, neg_zero, neg_neg,
        intervalIntegral.integral_symm X 0] using
        (intervalIntegral.integral_comp_neg Real.sinc (a := 0) (b := -X))
    simp only [hneg, sub_eq_add_neg, ← neg_add, abs_neg] at h
    simpa [Real.sign_of_neg hXneg, abs_of_neg hXneg] using h
  · simpa [Real.sign_of_pos hXpos, abs_of_pos hXpos] using
      abs_integral_sinc_sub_pi_div_two_le_inv hXpos

end

section
open Complex Set
open scoped Interval

section DirichletPerronCentral
theorem dirichletExplicitFormulaKernel_imaginary
    {y t : ℝ} (hy : 0 < y) :
    dirichletExplicitFormulaKernel y ((t : ℂ) * I) =
      ∫ u in (0 : ℝ)..Real.log y,
        Complex.exp (((t : ℂ) * I) * (u : ℂ)) := by
  by_cases ht : t = 0
  · subst t
    simp [dirichletExplicitFormulaKernel_zero]
  · have htI : (t : ℂ) * I ≠ 0 :=
      mul_ne_zero (Complex.ofReal_ne_zero.mpr ht) I_ne_zero
    rw [dirichletExplicitFormulaKernel_eq_cpow_sub_one_div hy htI,
      integral_exp_mul_complex htI]
    rw [Complex.cpow_def_of_ne_zero (Complex.ofReal_ne_zero.mpr hy.ne'),
      ← Complex.ofReal_log hy.le]
    simp
    ring_nf

theorem integral_exp_imaginary_frequency
    (U u : ℝ) :
    (∫ t in -U..U,
      Complex.exp (((t : ℂ) * I) * (u : ℂ))) =
      ((2 * U * Real.sinc (U * u) : ℝ) : ℂ) := by
  by_cases hu : u = 0
  · subst u
    simp
    ring
  have hchange := intervalIntegral.integral_comp_mul_left
    (f := fun v : ℝ => Complex.exp ((v : ℂ) * I)) hu
    (a := -U) (b := U)
  have hpoint (t : ℝ) :
      Complex.exp (((t : ℂ) * I) * (u : ℂ)) =
        Complex.exp (((u * t : ℝ) : ℂ) * I) := by
    congr 1
    push_cast
    ring
  calc
    (∫ t in -U..U,
        Complex.exp (((t : ℂ) * I) * (u : ℂ))) =
        ∫ t in -U..U,
          Complex.exp (((u * t : ℝ) : ℂ) * I) := by
      apply intervalIntegral.integral_congr
      intro t _
      exact hpoint t
    _ = (u : ℂ)⁻¹ *
        ∫ v in u * (-U)..u * U,
          Complex.exp ((v : ℂ) * I) := by
      simpa [smul_eq_mul] using hchange
    _ = (u : ℂ)⁻¹ *
        ∫ v in -(U * u)..(U * u),
          Complex.exp ((v : ℂ) * I) := by
      congr 2 <;> ring
    _ = (u : ℂ)⁻¹ *
        ((2 * (U * u) * Real.sinc (U * u) : ℝ) : ℂ) := by
      rw [integral_exp_mul_I_eq_sinc]
      congr 1
      push_cast
      ring
    _ = ((2 * U * Real.sinc (U * u) : ℝ) : ℂ) := by
      push_cast
      field_simp [Complex.ofReal_ne_zero.mpr hu]

theorem integral_dirichletExplicitFormulaKernel_imaginary
    {y U : ℝ} (hy : 0 < y) (hU : 0 < U) :
    (∫ t in -U..U,
      dirichletExplicitFormulaKernel y ((t : ℂ) * I)) =
      ((2 : ℝ) : ℂ) *
        (∫ u in (0 : ℝ)..(U * Real.log y), Real.sinc u) := by
  let L := Real.log y
  let F : ℝ → ℝ → ℂ := fun t u =>
    Complex.exp (((t : ℂ) * I) * (u : ℂ))
  have hcont : ContinuousOn F.uncurry
      (uIcc (-U) U ×ˢ uIcc 0 L) := by
    apply Continuous.continuousOn
    fun_prop
  have hIntegrable : IntegrableOn F.uncurry
      (uIoc (-U) U ×ˢ uIoc 0 L) :=
    (ContinuousOn.integrableOn_compact
      (isCompact_uIcc.prod isCompact_uIcc) hcont).mono_set
        (Set.prod_mono uIoc_subset_uIcc uIoc_subset_uIcc)
  have hswap := MeasureTheory.intervalIntegral_intervalIntegral_swap
    (F := F) hIntegrable
  calc
    (∫ t in -U..U,
        dirichletExplicitFormulaKernel y ((t : ℂ) * I)) =
        ∫ t in -U..U, ∫ u in (0 : ℝ)..L, F t u := by
      apply intervalIntegral.integral_congr
      intro t _
      simpa [F, L] using dirichletExplicitFormulaKernel_imaginary
        (y := y) (t := t) hy
    _ = ∫ u in (0 : ℝ)..L, ∫ t in -U..U, F t u := hswap
    _ = ∫ u in (0 : ℝ)..L,
        ((2 * U * Real.sinc (U * u) : ℝ) : ℂ) := by
      apply intervalIntegral.integral_congr
      intro u _
      exact integral_exp_imaginary_frequency U u
    _ = ((2 * U : ℝ) : ℂ) *
        (∫ u in (0 : ℝ)..L, (Real.sinc (U * u) : ℂ)) := by
      rw [← intervalIntegral.integral_const_mul]
      apply intervalIntegral.integral_congr
      intro u _
      push_cast
      ring
    _ = ((2 * U : ℝ) : ℂ) *
        ((U : ℂ)⁻¹ *
          ∫ u in (0 : ℝ)..(U * L), (Real.sinc u : ℂ)) := by
      rw [intervalIntegral.integral_comp_mul_left
        (fun u : ℝ => (Real.sinc u : ℂ)) hU.ne']
      simp
    _ = ((2 : ℝ) : ℂ) *
        (∫ u in (0 : ℝ)..(U * Real.log y), Real.sinc u) := by
      rw [← intervalIntegral.integral_ofReal]
      dsimp [L]
      push_cast
      field_simp [Complex.ofReal_ne_zero.mpr hU.ne']

theorem norm_dirichletExplicitFormulaKernel_horizontal_le_five_div
    {y r t U : ℝ} (hy : 0 < y) (hyUpper : y ≤ 2)
    (hr : 0 ≤ r) (hrUpper : r ≤ 2) (hU : 0 < U)
    (hUt : U ≤ |t|) :
    ‖dirichletExplicitFormulaKernel y ((r : ℂ) + t * I)‖ ≤ 5 / U := by
  have hs : (r : ℂ) + t * I ≠ 0 := by
    intro hs
    have him := congrArg Complex.im hs
    simp at him
    subst t
    simp at hUt
    linarith
  have hden : U ≤ ‖(r : ℂ) + t * I‖ := by
    calc
      U ≤ |t| := hUt
      _ = |((r : ℂ) + t * I).im| := by simp
      _ ≤ ‖(r : ℂ) + t * I‖ := Complex.abs_im_le_norm _
  have hpow :
      ‖(y : ℂ) ^ ((r : ℂ) + t * I)‖ ≤ 4 := by
    rw [Complex.norm_cpow_eq_rpow_re_of_pos hy]
    simp only [add_re, ofReal_re, mul_re, ofReal_im, I_re, I_im,
      mul_zero, zero_mul, sub_zero, add_zero]
    calc
      y ^ r ≤ (2 : ℝ) ^ r := Real.rpow_le_rpow hy.le hyUpper hr
      _ ≤ (2 : ℝ) ^ (2 : ℝ) :=
        Real.rpow_le_rpow_of_exponent_le one_le_two hrUpper
      _ = 4 := by norm_num
  rw [dirichletExplicitFormulaKernel_eq_cpow_sub_one_div hy hs,
    norm_div]
  have hdenPos : 0 < ‖(r : ℂ) + t * I‖ := hU.trans_le hden
  calc
    ‖(y : ℂ) ^ ((r : ℂ) + t * I) - 1‖ /
        ‖(r : ℂ) + t * I‖ ≤
        (‖(y : ℂ) ^ ((r : ℂ) + t * I)‖ + 1) /
          ‖(r : ℂ) + t * I‖ := by
      gcongr
      simpa using norm_sub_le
        ((y : ℂ) ^ ((r : ℂ) + t * I)) 1
    _ ≤ 5 / ‖(r : ℂ) + t * I‖ := by
      apply div_le_div_of_nonneg_right ?_ hdenPos.le
      linarith
    _ ≤ 5 / U := div_le_div_of_nonneg_left (by norm_num) hU hden

theorem norm_regularized_vertical_difference_le
    {y alpha U : ℝ} (hyLower : 1 / 2 ≤ y) (hyUpper : y ≤ 2)
    (halpha : 0 < alpha) (halphaUpper : alpha ≤ 2)
    (hU : 0 < U) :
    ‖(∫ t in -U..U,
        dirichletExplicitFormulaKernel y ((alpha : ℂ) + t * I)) -
      ∫ t in -U..U,
        dirichletExplicitFormulaKernel y ((t : ℂ) * I)‖ ≤
      10 * alpha / U := by
  have hy : 0 < y := (by norm_num : (0 : ℝ) < 1 / 2).trans_le hyLower
  let bottom : ℂ := ∫ r in (0 : ℝ)..alpha,
    dirichletExplicitFormulaKernel y ((r : ℂ) - U * I)
  let top : ℂ := ∫ r in (0 : ℝ)..alpha,
    dirichletExplicitFormulaKernel y ((r : ℂ) + U * I)
  let right : ℂ := ∫ t in -U..U,
    dirichletExplicitFormulaKernel y ((alpha : ℂ) + t * I)
  let left : ℂ := ∫ t in -U..U,
    dirichletExplicitFormulaKernel y ((t : ℂ) * I)
  have hboundary :=
    Complex.integral_boundary_rect_eq_zero_of_differentiableOn
      (dirichletExplicitFormulaKernel y)
      (Complex.mk 0 (-U)) (Complex.mk alpha U)
      (differentiable_dirichletExplicitFormulaKernel y).differentiableOn
  have hboundary' : bottom - top + I * right - I * left = 0 := by
    simpa [bottom, top, right, left, smul_eq_mul, mul_comm,
      sub_eq_add_neg] using hboundary
  have hsolve : I * (right - left) = top - bottom := by
    linear_combination hboundary'
  have hnorm : ‖right - left‖ ≤ ‖top‖ + ‖bottom‖ := by
    calc
      ‖right - left‖ = ‖I * (right - left)‖ := by simp
      _ = ‖top - bottom‖ := by rw [hsolve]
      _ ≤ ‖top‖ + ‖bottom‖ := norm_sub_le _ _
  have htop : ‖top‖ ≤ 5 * alpha / U := by
    dsimp [top]
    calc
      ‖∫ r in (0 : ℝ)..alpha,
          dirichletExplicitFormulaKernel y ((r : ℂ) + U * I)‖ ≤
          (5 / U) * |alpha - 0| :=
        intervalIntegral.norm_integral_le_of_norm_le_const (by
          intro r hr
          rw [uIoc_of_le halpha.le] at hr
          exact norm_dirichletExplicitFormulaKernel_horizontal_le_five_div
            hy hyUpper hr.1.le (hr.2.trans halphaUpper) hU (le_abs_self U))
      _ = 5 * alpha / U := by rw [sub_zero, abs_of_pos halpha]; ring
  have hbottom : ‖bottom‖ ≤ 5 * alpha / U := by
    dsimp [bottom]
    calc
      ‖∫ r in (0 : ℝ)..alpha,
          dirichletExplicitFormulaKernel y ((r : ℂ) - U * I)‖ ≤
          (5 / U) * |alpha - 0| :=
        intervalIntegral.norm_integral_le_of_norm_le_const (by
          intro r hr
          rw [uIoc_of_le halpha.le] at hr
          have hbound :=
            norm_dirichletExplicitFormulaKernel_horizontal_le_five_div
              (y := y) (r := r) (t := -U) hy hyUpper hr.1.le
                (hr.2.trans halphaUpper) hU
                  (by simpa only [abs_neg] using le_abs_self U)
          have heq : (r : ℂ) - U * I = (r : ℂ) + ((-U : ℝ) : ℂ) * I := by
            push_cast
            ring
          rw [heq]
          exact hbound)
      _ = 5 * alpha / U := by rw [sub_zero, abs_of_pos halpha]; ring
  change ‖right - left‖ ≤ 10 * alpha / U
  exact hnorm.trans <| calc
    ‖top‖ + ‖bottom‖ ≤
        5 * alpha / U + 5 * alpha / U := add_le_add htop hbottom
    _ = 10 * alpha / U := by ring

theorem dirichletPerronKernel_eq_regularized_add_endpoint
    {y alpha U : ℝ} (hy : 0 < y) (halpha : 0 < alpha) :
    dirichletPerronKernel y alpha U =
      (((2 * Real.pi : ℝ) : ℂ)⁻¹) *
        (∫ t in -U..U,
          dirichletExplicitFormulaKernel y ((alpha : ℂ) + t * I)) +
      dirichletPerronKernel 1 alpha U := by
  let R : ℝ → ℂ := fun t =>
    dirichletExplicitFormulaKernel y ((alpha : ℂ) + t * I)
  let P : ℝ → ℂ := fun t => (1 : ℂ) / ((alpha : ℂ) + t * I)
  have hR : Continuous R :=
    (differentiable_dirichletExplicitFormulaKernel y).continuous.comp
      (by fun_prop)
  have hP : Continuous P := by
    apply continuous_const.div₀
    · fun_prop
    · intro t ht
      exact halpha.ne' (by simpa using congrArg Complex.re ht)
  rw [dirichletPerronKernel, dirichletPerronKernel]
  have hpoint (t : ℝ) :
      (y : ℂ) ^ ((alpha : ℂ) + t * I) /
          ((alpha : ℂ) + t * I) = R t + P t := by
    have hs : (alpha : ℂ) + t * I ≠ 0 := by
      intro hs
      exact halpha.ne' (by simpa using congrArg Complex.re hs)
    dsimp [R, P]
    rw [dirichletExplicitFormulaKernel_eq_cpow_sub_one_div hy hs]
    field_simp
    ring
  have hone (t : ℝ) :
      ((1 : ℝ) : ℂ) ^ ((alpha : ℂ) + t * I) /
          ((alpha : ℂ) + t * I) = P t := by simp [P]
  rw [intervalIntegral.integral_congr (fun t _ => hpoint t),
    intervalIntegral.integral_add
      (hR.intervalIntegrable _ _) (hP.intervalIntegrable _ _),
    intervalIntegral.integral_congr (fun t _ => hone t)]
  ring

end DirichletPerronCentral

theorem norm_dirichletPerronKernel_sub_half_add_sinc_le
    {y alpha U : ℝ}
    (hyLower : 1 / 2 ≤ y) (hyUpper : y ≤ 2)
    (halpha : 0 < alpha) (halphaUpper : alpha ≤ 2)
    (hU : 0 < U) :
    ‖dirichletPerronKernel y alpha U -
      (((1 / 2 +
        (∫ u in (0 : ℝ)..(U * Real.log y), Real.sinc u) /
          Real.pi : ℝ)) : ℂ)‖ ≤
      20 / (Real.pi * U) := by
  have hy : 0 < y := (by norm_num : (0 : ℝ) < 1 / 2).trans_le hyLower
  let right : ℂ := ∫ t in -U..U,
    dirichletExplicitFormulaKernel y ((alpha : ℂ) + t * I)
  let left : ℂ := ∫ t in -U..U,
    dirichletExplicitFormulaKernel y ((t : ℂ) * I)
  let S : ℝ := ∫ u in (0 : ℝ)..(U * Real.log y), Real.sinc u
  let c : ℂ := (((2 * Real.pi : ℝ) : ℂ)⁻¹)
  have hdiff : ‖right - left‖ ≤ 10 * alpha / U :=
    norm_regularized_vertical_difference_le
      hyLower hyUpper halpha halphaUpper hU
  have hleft : left = ((2 : ℝ) : ℂ) * (S : ℂ) :=
    integral_dirichletExplicitFormulaKernel_imaginary hy hU
  have hsplit :
      dirichletPerronKernel y alpha U =
        c * right + dirichletPerronKernel 1 alpha U :=
    dirichletPerronKernel_eq_regularized_add_endpoint hy halpha
  have hc : ‖c‖ = 1 / (2 * Real.pi) := by
    dsimp [c]
    rw [norm_inv, Complex.norm_real, Real.norm_eq_abs,
      abs_of_pos (by positivity : 0 < 2 * Real.pi)]
    norm_num
  have hsinc : c * left = ((S / Real.pi : ℝ) : ℂ) := by
    rw [hleft]
    dsimp [c]
    push_cast
    field_simp [Real.pi_ne_zero]
  have hendpoint := norm_dirichletPerronKernel_one_sub_half_le halpha hU
  rw [hsplit]
  have hrewrite :
      c * right + dirichletPerronKernel 1 alpha U -
          (((1 / 2 + S / Real.pi : ℝ)) : ℂ) =
        c * (right - left) +
          (dirichletPerronKernel 1 alpha U - (1 / 2 : ℂ)) := by
    rw [mul_sub, hsinc]
    push_cast
    ring
  change ‖c * right + dirichletPerronKernel 1 alpha U -
      (((1 / 2 + S / Real.pi : ℝ)) : ℂ)‖ ≤ _
  rw [hrewrite]
  calc
    ‖c * (right - left) +
        (dirichletPerronKernel 1 alpha U - (1 / 2 : ℂ))‖ ≤
        ‖c‖ * ‖right - left‖ +
          ‖dirichletPerronKernel 1 alpha U - (1 / 2 : ℂ)‖ := by
      simpa [norm_mul] using norm_add_le
        (c * (right - left))
        (dirichletPerronKernel 1 alpha U - (1 / 2 : ℂ))
    _ ≤ (1 / (2 * Real.pi)) * (10 * alpha / U) +
          alpha / (Real.pi * U) := add_le_add
      (mul_le_mul_of_nonneg_left hdiff (by positivity) |>.trans_eq (by rw [hc]))
      hendpoint
    _ ≤ 20 / (Real.pi * U) := by
      field_simp [Real.pi_ne_zero, hU.ne']
      nlinarith

end

section
open Complex
open scoped Interval

section DirichletPerronCentralNatural
theorem abs_half_add_sincIntegral_sub_step_le
    {A : ℝ} (hA : A ≠ 0) :
    |1 / 2 +
        (∫ u in (0 : ℝ)..A, Real.sinc u) / Real.pi -
          (if 0 < A then 1 else 0)| ≤
      min 1 (1 / |A|) := by
  let S : ℝ := ∫ u in (0 : ℝ)..A, Real.sinc u
  have hAabs : 0 < |A| := abs_pos.mpr hA
  by_cases hlarge : 1 ≤ |A|
  · rw [min_eq_right ((div_le_one hAabs).2 hlarge)]
    have htail :=
      abs_integral_sinc_sub_sign_pi_div_two_le_inv_abs hA
    by_cases hApos : 0 < A
    · rw [ite_eq_left hApos, Real.sign_of_pos hApos] at *
      have htailS : |S - Real.pi / 2| ≤ |A| ^ (-1 : ℤ) := by
        simpa [S] using htail
      calc
        |1 / 2 + S / Real.pi - 1| =
            |S - Real.pi / 2| / Real.pi := by
          rw [show 1 / 2 + S / Real.pi - 1 =
              (S - Real.pi / 2) / Real.pi by
            field_simp [Real.pi_ne_zero]
            ring,
            abs_div, abs_of_pos Real.pi_pos]
        _ ≤ (|A| ^ (-1 : ℤ)) / Real.pi :=
          div_le_div_of_nonneg_right htailS Real.pi_pos.le
        _ ≤ 1 / |A| := by
          rw [zpow_neg_one]
          have hpi : 1 ≤ Real.pi := by linarith [Real.pi_gt_three]
          have hinv : 0 ≤ |A|⁻¹ := inv_nonneg.mpr hAabs.le
          rw [one_div]
          exact (div_le_iff₀ Real.pi_pos).2
            (by simpa using mul_le_mul_of_nonneg_left hpi hinv)
    · have hAneg : A < 0 := lt_of_le_of_ne (le_of_not_gt hApos) hA
      rw [ite_eq_right hApos, Real.sign_of_neg hAneg] at *
      have htailS : |S + Real.pi / 2| ≤ |A| ^ (-1 : ℤ) := by
        simpa [S] using htail
      calc
        |1 / 2 + S / Real.pi - 0| =
            |S + Real.pi / 2| / Real.pi := by
          rw [show 1 / 2 + S / Real.pi - 0 =
              (S + Real.pi / 2) / Real.pi by
            field_simp [Real.pi_ne_zero]
            ring,
            abs_div, abs_of_pos Real.pi_pos]
        _ ≤ (|A| ^ (-1 : ℤ)) / Real.pi :=
          div_le_div_of_nonneg_right htailS Real.pi_pos.le
        _ ≤ 1 / |A| := by
          rw [zpow_neg_one]
          have hpi : 1 ≤ Real.pi := by linarith [Real.pi_gt_three]
          have hinv : 0 ≤ |A|⁻¹ := inv_nonneg.mpr hAabs.le
          rw [one_div]
          exact (div_le_iff₀ Real.pi_pos).2
            (by simpa using mul_le_mul_of_nonneg_left hpi hinv)
  · have hsmall : |A| ≤ 1 := le_of_not_ge hlarge
    rw [min_eq_left]
    · have hS : |S| ≤ |A| := by
        have hbound := intervalIntegral.norm_integral_le_of_norm_le_const
          (a := (0 : ℝ)) (b := A) (C := (1 : ℝ)) (f := Real.sinc)
          (fun u _ => by
            simpa [Real.norm_eq_abs] using Real.abs_sinc_le_one u)
        simpa [S, Real.norm_eq_abs] using hbound
      have hInvPi : 1 / Real.pi ≤ 1 / 2 := by
        rw [div_le_iff₀ Real.pi_pos]
        linarith [Real.pi_gt_three]
      have hStep :
          |(1 / 2 : ℝ) - (if 0 < A then 1 else 0)| = 1 / 2 := by
        split_ifs <;> norm_num
      calc
        |1 / 2 + S / Real.pi - (if 0 < A then 1 else 0)| =
            |((1 / 2 : ℝ) - (if 0 < A then 1 else 0)) +
              S / Real.pi| := by congr 1; ring
        _ ≤ |(1 / 2 : ℝ) - (if 0 < A then 1 else 0)| +
            |S / Real.pi| := abs_add_le _ _
        _ = 1 / 2 + |S| / Real.pi := by
          rw [hStep, abs_div, abs_of_pos Real.pi_pos]
        _ ≤ 1 / 2 + 1 / Real.pi := by
          gcongr
          exact hS.trans hsmall
        _ ≤ 1 := by linarith
    · exact (one_le_div hAabs).2 hsmall

theorem one_div_abs_log_div_le
    {x y : ℝ} (hx : 0 < x) (hy : 0 < y)
    (hyUpper : y < 2 * x) (hne : x ≠ y) :
    1 / |Real.log (x / y)| ≤ 2 * x / |x - y| := by
  by_cases hxy : x < y
  · have hratio : 0 < y / x := div_pos hy hx
    have hratioInv : (y / x)⁻¹ = x / y := by field_simp
    have hlower := Real.one_sub_inv_le_log_of_pos hratio
    rw [hratioInv] at hlower
    have hrewrite : 1 - x / y = (y - x) / y := by field_simp
    rw [hrewrite] at hlower
    have hlogInv : Real.log (y / x) = -Real.log (x / y) := by
      rw [show y / x = (x / y)⁻¹ by field_simp, Real.log_inv]
    rw [hlogInv] at hlower
    have hlogNeg : Real.log (x / y) < 0 :=
      Real.log_neg (div_pos hx hy) ((div_lt_one hy).2 hxy)
    have hdiff : 0 < y - x := sub_pos.mpr hxy
    rw [abs_of_neg hlogNeg, abs_of_neg (sub_neg.mpr hxy)]
    have hrecip :
        1 / (-Real.log (x / y)) ≤ y / (y - x) := by
      have hbase : 0 < (y - x) / y := div_pos hdiff hy
      calc
        1 / (-Real.log (x / y)) ≤ 1 / ((y - x) / y) :=
          one_div_le_one_div_of_le hbase hlower
        _ = y / (y - x) := by field_simp
    calc
      1 / -Real.log (x / y) ≤ y / (y - x) := hrecip
      _ ≤ 2 * x / (y - x) :=
        div_le_div_of_nonneg_right hyUpper.le hdiff.le
      _ = 2 * x / -(x - y) := by congr 1; ring
  · have hyx : y < x := lt_of_le_of_ne (le_of_not_gt hxy) hne.symm
    have hratio : 0 < x / y := div_pos hx hy
    have hlower := Real.one_sub_inv_le_log_of_pos hratio
    have hrewrite : 1 - (x / y)⁻¹ = (x - y) / x := by field_simp
    rw [hrewrite] at hlower
    have hlogPos : 0 < Real.log (x / y) :=
      Real.log_pos ((one_lt_div hy).2 hyx)
    have hdiff : 0 < x - y := sub_pos.mpr hyx
    rw [abs_of_pos hlogPos, abs_of_pos hdiff]
    calc
      1 / Real.log (x / y) ≤ 1 / ((x - y) / x) :=
        one_div_le_one_div_of_le (div_pos hdiff hx) hlower
      _ = x / (x - y) := by field_simp
      _ ≤ 2 * x / (x - y) := by
        exact div_le_div_of_nonneg_right (by linarith) hdiff.le

theorem min_log_error_le_distance_error
    {x y U : ℝ} (hx : 0 < x) (hy : 0 < y)
    (hyUpper : y < 2 * x) (hne : x ≠ y) (hU : 0 < U) :
    min 1 (1 / (U * |Real.log (x / y)|)) ≤
      min 1 (2 * x / (U * |x - y|)) := by
  apply min_le_min_left
  have hbase := one_div_abs_log_div_le hx hy hyUpper hne
  have hlog : Real.log (x / y) ≠ 0 :=
    Real.log_ne_zero_of_pos_of_ne_one (div_pos hx hy) (by
      intro hratio
      apply hne
      exact (div_eq_one_iff_eq hy.ne').mp hratio)
  have hdiff : x - y ≠ 0 := sub_ne_zero.mpr hne
  calc
    1 / (U * |Real.log (x / y)|) =
        (1 / |Real.log (x / y)|) / U := by
      field_simp [hU.ne', hlog]
    _ ≤ (2 * x / |x - y|) / U :=
      div_le_div_of_nonneg_right hbase hU.le
    _ = 2 * x / (U * |x - y|) := by
      field_simp [hU.ne', hdiff]

end DirichletPerronCentralNatural

theorem norm_dirichletPerronKernel_sub_naturalWeight_central_le
    {x n : ℕ} {alpha U : ℝ}
    (hx : 0 < x) (hn : 0 < n)
    (hLower : (x : ℝ) / 2 < (n : ℝ))
    (hUpper : (n : ℝ) < 2 * x) (hne : n ≠ x)
    (halpha : 0 < alpha) (halphaUpper : alpha ≤ 2)
    (hU : 0 < U) :
    ‖dirichletPerronKernel ((x : ℝ) / n) alpha U -
      (dirichletPerronNaturalWeight x n : ℂ)‖ ≤
      min 1 (2 * (x : ℝ) /
        (U * |(x : ℝ) - n|)) + 20 / (Real.pi * U) := by
  have hxR : (0 : ℝ) < x := by exact_mod_cast hx
  have hnR : (0 : ℝ) < n := by exact_mod_cast hn
  let y : ℝ := (x : ℝ) / n
  have hy : 0 < y := div_pos hxR hnR
  have hyLower : (1 / 2 : ℝ) ≤ y := by
    dsimp [y]
    rw [le_div_iff₀ hnR]
    nlinarith
  have hyUpper : y ≤ 2 := by
    dsimp [y]
    rw [div_le_iff₀ hnR]
    nlinarith
  have hxy : (x : ℝ) ≠ (n : ℝ) := by exact_mod_cast hne.symm
  have hyOne : y ≠ 1 := by
    intro hyOne
    apply hxy
    exact (div_eq_one_iff_eq hnR.ne').mp hyOne
  have hlog : Real.log y ≠ 0 :=
    Real.log_ne_zero_of_pos_of_ne_one hy hyOne
  have hA : U * Real.log y ≠ 0 := mul_ne_zero hU.ne' hlog
  let S : ℝ := ∫ u in (0 : ℝ)..(U * Real.log y), Real.sinc u
  let approx : ℂ := ((1 / 2 + S / Real.pi : ℝ) : ℂ)
  have hcentral :
      ‖dirichletPerronKernel y alpha U - approx‖ ≤
        20 / (Real.pi * U) :=
    norm_dirichletPerronKernel_sub_half_add_sinc_le
      hyLower hyUpper halpha halphaUpper hU
  have hstepRaw := abs_half_add_sincIntegral_sub_step_le hA
  change |1 / 2 + S / Real.pi -
      (if 0 < U * Real.log y then 1 else 0)| ≤
    min 1 (1 / |U * Real.log y|) at hstepRaw
  have hweight :
      (if 0 < U * Real.log y then (1 : ℝ) else 0) =
        dirichletPerronNaturalWeight x n := by
    rcases lt_or_gt_of_ne hne with hnx | hxn
    · have hyOneLt : 1 < y := by
        dsimp [y]
        rw [lt_div_iff₀ hnR]
        have hnxR : (n : ℝ) < x := by exact_mod_cast hnx
        simpa using hnxR
      have hApos : 0 < U * Real.log y :=
        mul_pos hU (Real.log_pos hyOneLt)
      rw [ite_eq_left hApos,
        dirichletPerronNaturalWeight_of_pos_of_lt hn hnx]
    · have hyLtOne : y < 1 := by
        dsimp [y]
        exact (div_lt_one hnR).2 (by exact_mod_cast hxn)
      have hAneg : U * Real.log y < 0 :=
        mul_neg_of_pos_of_neg hU (Real.log_neg hy hyLtOne)
      rw [ite_eq_right hAneg.not_gt,
        dirichletPerronNaturalWeight_of_lt hxn]
  have hstep :
      ‖approx - (dirichletPerronNaturalWeight x n : ℂ)‖ ≤
        min 1 (1 / (U * |Real.log y|)) := by
    rw [hweight, abs_mul, abs_of_pos hU] at hstepRaw
    dsimp [approx]
    rw [← Complex.ofReal_sub, Complex.norm_real, Real.norm_eq_abs]
    exact hstepRaw
  have hdistance :
      min 1 (1 / (U * |Real.log y|)) ≤
        min 1 (2 * (x : ℝ) / (U * |(x : ℝ) - n|)) := by
    dsimp [y]
    exact min_log_error_le_distance_error hxR hnR hUpper hxy hU
  change ‖dirichletPerronKernel y alpha U -
    (dirichletPerronNaturalWeight x n : ℂ)‖ ≤ _
  calc
    ‖dirichletPerronKernel y alpha U -
        (dirichletPerronNaturalWeight x n : ℂ)‖ =
        ‖(dirichletPerronKernel y alpha U - approx) +
          (approx - (dirichletPerronNaturalWeight x n : ℂ))‖ := by
      congr 1
      ring
    _ ≤ ‖dirichletPerronKernel y alpha U - approx‖ +
        ‖approx - (dirichletPerronNaturalWeight x n : ℂ)‖ :=
      norm_add_le _ _
    _ ≤ 20 / (Real.pi * U) +
        min 1 (1 / (U * |Real.log y|)) := add_le_add hcentral hstep
    _ ≤ 20 / (Real.pi * U) +
        min 1 (2 * (x : ℝ) / (U * |(x : ℝ) - n|)) :=
      add_le_add_right hdistance _
    _ = min 1 (2 * (x : ℝ) / (U * |(x : ℝ) - n|)) +
        20 / (Real.pi * U) := add_comm _ _

end

section
open Complex Set
open scoped Interval

section DirichletPerronLowBase
/--
The meromorphic Perron factor `y ^ s / s`, using complex exponentiation of the real base coerced
to `ℂ`.
-/
noncomputable def dirichletPerronQuotient
    (y : ℝ) (s : ℂ) : ℂ :=
  (y : ℂ) ^ s / s

theorem differentiableOn_dirichletPerronQuotient_positiveRectangle
    {y alpha R U : ℝ} (hy : 0 < y) (halpha : 0 < alpha)
    (halphaR : alpha ≤ R) :
    DifferentiableOn ℂ (dirichletPerronQuotient y)
      ([[alpha, R]] ×ℂ [[-U, U]]) := by
  apply DifferentiableOn.fun_div
  · exact (differentiable_id.const_cpow
      (.inl (Complex.ofReal_ne_zero.mpr hy.ne'))).differentiableOn
  · exact differentiableOn_id
  · intro s hs
    rw [Complex.mem_reProdIm, uIcc_of_le halphaR] at hs
    intro hsZero
    have hre := congrArg Complex.re hsZero
    simp at hre
    linarith [hs.1.1]

theorem norm_dirichletPerronQuotient_horizontal_le
    {y alpha R U t : ℝ} (hy : 0 < y) (hyOne : y < 1)
    (halphaR : alpha ≤ R) (hU : 0 < U) (hUt : U ≤ |t|) :
    ‖∫ r in alpha..R,
      dirichletPerronQuotient y ((r : ℂ) + t * I)‖ ≤
      y ^ alpha / (U * (-Real.log y)) := by
  have hlog : Real.log y < 0 := Real.log_neg hy hyOne
  let g : ℝ → ℝ := fun r => y ^ r / U
  have hg : Continuous g :=
    (Real.continuous_const_rpow hy.ne').div_const U
  have hpoint (r : ℝ) :
      ‖dirichletPerronQuotient y ((r : ℂ) + t * I)‖ ≤ g r := by
    rw [dirichletPerronQuotient, norm_div,
      Complex.norm_cpow_eq_rpow_re_of_pos hy]
    simp only [add_re, ofReal_re, mul_re, ofReal_im, I_re, I_im,
      mul_zero, zero_mul, sub_zero, add_zero]
    have hden : U ≤ ‖(r : ℂ) + t * I‖ := by
      calc
        U ≤ |t| := hUt
        _ = |((r : ℂ) + t * I).im| := by simp
        _ ≤ ‖(r : ℂ) + t * I‖ := Complex.abs_im_le_norm _
    exact div_le_div_of_nonneg_left (Real.rpow_nonneg hy.le r) hU hden
  have hderiv (r : ℝ) :
      HasDerivAt (fun u : ℝ => y ^ u / (U * Real.log y)) (g r) r := by
    have hraw := (Real.hasStrictDerivAt_const_rpow hy r).hasDerivAt
      |>.div_const (U * Real.log y)
    have hcoeff :
        y ^ r * Real.log y / (U * Real.log y) = y ^ r / U := by
      field_simp [hU.ne', hlog.ne]
    simpa [g, hcoeff] using hraw
  have hgInt : IntervalIntegrable g volume alpha R :=
    hg.intervalIntegrable _ _
  calc
    ‖∫ r in alpha..R,
        dirichletPerronQuotient y ((r : ℂ) + t * I)‖ ≤
        ∫ r in alpha..R, g r :=
      intervalIntegral.norm_integral_le_of_norm_le halphaR
        (Eventually.of_forall fun r _ => hpoint r) hgInt
    _ = y ^ R / (U * Real.log y) -
        y ^ alpha / (U * Real.log y) :=
      intervalIntegral.integral_eq_sub_of_hasDerivAt
        (fun r _ => hderiv r) hgInt
    _ = (y ^ alpha - y ^ R) / (U * (-Real.log y)) := by ring
    _ ≤ y ^ alpha / (U * (-Real.log y)) := by
      have hden : 0 < U * (-Real.log y) := mul_pos hU (neg_pos.mpr hlog)
      exact div_le_div_of_nonneg_right
        (by linarith [Real.rpow_nonneg hy.le R]) hden.le

theorem norm_dirichletPerronQuotient_farVertical_le
    {y alpha R U : ℝ} (hy : 0 < y) (halpha : 0 < alpha)
    (halphaR : alpha ≤ R) :
    ‖∫ t in -U..U,
      dirichletPerronQuotient y ((R : ℂ) + t * I)‖ ≤
      (y ^ R / alpha) * (2 * |U|) := by
  change ‖∫ t in -U..U,
      (y : ℂ) ^ ((R : ℂ) + t * I) / ((R : ℂ) + t * I)‖ ≤
    (y ^ R / alpha) * (2 * |U|)
  calc
    ‖∫ t in -U..U,
        (y : ℂ) ^ ((R : ℂ) + t * I) / ((R : ℂ) + t * I)‖ ≤
        (y ^ R / alpha) * |U - (-U)| :=
      intervalIntegral.norm_integral_le_of_norm_le_const
        (a := -U) (b := U) (C := y ^ R / alpha) (by
        intro t _
        change ‖(y : ℂ) ^ ((R : ℂ) + t * I) /
          ((R : ℂ) + t * I)‖ ≤ y ^ R / alpha
        rw [norm_div,
          Complex.norm_cpow_eq_rpow_re_of_pos hy]
        simp only [add_re, ofReal_re, mul_re, ofReal_im, I_re, I_im,
          mul_zero, zero_mul, sub_zero, add_zero]
        have hden : alpha ≤ ‖(R : ℂ) + t * I‖ := by
          calc
            alpha ≤ R := halphaR
            _ = |((R : ℂ) + t * I).re| := by
              simp [abs_of_nonneg (halpha.le.trans halphaR)]
            _ ≤ ‖(R : ℂ) + t * I‖ := Complex.abs_re_le_norm _
        exact div_le_div_of_nonneg_left
          (Real.rpow_nonneg hy.le R) halpha hden)
    _ = (y ^ R / alpha) * (2 * |U|) := by
      rw [show |U - (-U)| = 2 * |U| by
        rw [show U - (-U) = 2 * U by ring, abs_mul]
        norm_num]

theorem norm_dirichletPerronQuotient_vertical_le
    {y alpha U : ℝ} (hy : 0 < y) (hyOne : y < 1)
    (halpha : 0 < alpha) (hU : 0 < U) :
    ‖∫ t in -U..U,
      dirichletPerronQuotient y ((alpha : ℂ) + t * I)‖ ≤
      2 * (y ^ alpha / (U * (-Real.log y))) := by
  let H : ℝ := y ^ alpha / (U * (-Real.log y))
  have hfinite (R : ℝ) (halphaR : alpha ≤ R) :
      ‖∫ t in -U..U,
        dirichletPerronQuotient y ((alpha : ℂ) + t * I)‖ ≤
        2 * H + (y ^ R / alpha) * (2 * U) := by
    let bottom : ℂ := ∫ r in alpha..R,
      dirichletPerronQuotient y ((r : ℂ) - U * I)
    let top : ℂ := ∫ r in alpha..R,
      dirichletPerronQuotient y ((r : ℂ) + U * I)
    let right : ℂ := ∫ t in -U..U,
      dirichletPerronQuotient y ((R : ℂ) + t * I)
    let left : ℂ := ∫ t in -U..U,
      dirichletPerronQuotient y ((alpha : ℂ) + t * I)
    have hboundary :=
      Complex.integral_boundary_rect_eq_zero_of_differentiableOn
        (dirichletPerronQuotient y)
        (Complex.mk alpha (-U)) (Complex.mk R U)
        (differentiableOn_dirichletPerronQuotient_positiveRectangle
          hy halpha halphaR)
    have hboundary' : bottom - top + I * right - I * left = 0 := by
      simpa [bottom, top, right, left, smul_eq_mul, mul_comm,
        sub_eq_add_neg] using hboundary
    have hsolve : I * left = bottom - top + I * right := by
      linear_combination -hboundary'
    have hnorm : ‖left‖ ≤ ‖bottom‖ + ‖top‖ + ‖right‖ := by
      calc
        ‖left‖ = ‖I * left‖ := by simp
        _ = ‖bottom - top + I * right‖ := by rw [hsolve]
        _ ≤ ‖bottom - top‖ + ‖I * right‖ := norm_add_le _ _
        _ ≤ (‖bottom‖ + ‖top‖) + ‖right‖ := by
          gcongr
          · exact norm_sub_le _ _
          · simp
    have hbottom : ‖bottom‖ ≤ H := by
      dsimp [bottom, H]
      have hbound := norm_dirichletPerronQuotient_horizontal_le
        (y := y) (alpha := alpha) (R := R) (U := U) (t := -U)
        hy hyOne halphaR hU (by simp [abs_of_pos hU])
      convert hbound using 1
      · apply congrArg norm
        apply intervalIntegral.integral_congr
        intro r _
        apply congrArg (dirichletPerronQuotient y)
        push_cast
        ring
    have htop : ‖top‖ ≤ H :=
      norm_dirichletPerronQuotient_horizontal_le
        hy hyOne halphaR hU (le_abs_self U)
    have hright : ‖right‖ ≤ (y ^ R / alpha) * (2 * U) := by
      simpa [abs_of_pos hU] using
        norm_dirichletPerronQuotient_farVertical_le
          (U := U) hy halpha halphaR
    change ‖left‖ ≤ 2 * H + (y ^ R / alpha) * (2 * U)
    exact hnorm.trans <| calc
      ‖bottom‖ + ‖top‖ + ‖right‖ ≤
          H + H + (y ^ R / alpha) * (2 * U) :=
        add_le_add (add_le_add hbottom htop) hright
      _ = 2 * H + (y ^ R / alpha) * (2 * U) := by ring
  have hyLimit : Tendsto (fun R : ℝ => y ^ R) atTop (nhds 0) :=
    tendsto_rpow_atTop_of_base_lt_one y (by linarith) hyOne
  have hlimit : Tendsto
      (fun R : ℝ => 2 * H + (y ^ R / alpha) * (2 * U))
      atTop (nhds (2 * H)) := by
    simpa using tendsto_const_nhds.add
      ((hyLimit.div_const alpha).mul_const (2 * U))
  exact ge_of_tendsto hlimit <|
    (eventually_ge_atTop alpha).mono fun R hR => hfinite R hR

theorem one_lt_pi_mul_log_two :
    (1 : ℝ) < Real.pi * Real.log 2 := by
  have hmul :
      (3 : ℝ) * 0.6931471803 < Real.pi * Real.log 2 :=
    mul_lt_mul Real.pi_gt_three Real.log_two_gt_d9.le
      (by norm_num) Real.pi_pos.le
  exact (by norm_num : (1 : ℝ) < 3 * 0.6931471803).trans hmul

end DirichletPerronLowBase

theorem norm_dirichletPerronKernel_lowBase_le
    {y alpha U : ℝ} (hy : 0 < y) (hyUpper : y ≤ 1 / 2)
    (halpha : 0 < alpha) (hU : 0 < U) :
    ‖dirichletPerronKernel y alpha U‖ ≤ y ^ alpha / U := by
  have hyOne : y < 1 := hyUpper.trans_lt (by norm_num)
  have hlog : Real.log y < 0 := Real.log_neg hy hyOne
  have hraw := norm_dirichletPerronQuotient_vertical_le
    hy hyOne halpha hU
  rw [dirichletPerronKernel, norm_mul]
  change ‖(((2 * Real.pi : ℝ) : ℂ)⁻¹)‖ *
      ‖∫ t in -U..U,
        dirichletPerronQuotient y ((alpha : ℂ) + t * I)‖ ≤
    y ^ alpha / U
  rw [norm_inv, Complex.norm_real,
    Real.norm_eq_abs, abs_of_pos (mul_pos (by norm_num) Real.pi_pos)]
  have hsharp :
      (1 / (2 * Real.pi)) *
        ‖∫ t in -U..U,
          dirichletPerronQuotient y ((alpha : ℂ) + t * I)‖ ≤
        y ^ alpha / (Real.pi * U * (-Real.log y)) := by
    calc
      (1 / (2 * Real.pi)) *
          ‖∫ t in -U..U,
            dirichletPerronQuotient y ((alpha : ℂ) + t * I)‖ ≤
          (1 / (2 * Real.pi)) *
            (2 * (y ^ alpha / (U * (-Real.log y)))) :=
        mul_le_mul_of_nonneg_left hraw (by positivity)
      _ = y ^ alpha / (Real.pi * U * (-Real.log y)) := by
        field_simp [Real.pi_ne_zero, hU.ne', hlog.ne]
  have hfactor : (2 * Real.pi)⁻¹ = 1 / (2 * Real.pi) := by
    simp [div_eq_mul_inv]
  rw [hfactor]
  apply hsharp.trans
  have hlogHalf : Real.log y ≤ -Real.log 2 := by
    calc
      Real.log y ≤ Real.log (1 / 2 : ℝ) :=
        Real.log_le_log hy hyUpper
      _ = -Real.log 2 := by
        rw [show (1 / 2 : ℝ) = (2 : ℝ)⁻¹ by norm_num,
          Real.log_inv]
  have hden : U ≤ Real.pi * U * (-Real.log y) := by
    calc
      U = U * 1 := by ring
      _ ≤ U * (Real.pi * Real.log 2) :=
        mul_le_mul_of_nonneg_left one_lt_pi_mul_log_two.le hU.le
      _ ≤ U * (Real.pi * (-Real.log y)) := by
        gcongr
        linarith
      _ = Real.pi * U * (-Real.log y) := by ring
  exact div_le_div_of_nonneg_left
    (Real.rpow_nonneg hy.le alpha) hU hden

section DirichletPerronHighBase
/--
The meromorphic Perron factor `y ^ s / s`, using complex exponentiation of the real base coerced
to `ℂ`.
-/
noncomputable def dirichletPerronHighQuotient
    (y : ℝ) (s : ℂ) : ℂ :=
  (y : ℂ) ^ s / s

theorem dirichletPerronHighQuotient_eq_kernel_add_inv
    {y : ℝ} (hy : 0 < y) {s : ℂ} (hs : s ≠ 0) :
    dirichletPerronHighQuotient y s =
      dirichletExplicitFormulaKernel y s + 1 / s := by
  rw [dirichletPerronHighQuotient,
    dirichletExplicitFormulaKernel_eq_cpow_sub_one_div hy hs]
  field_simp
  ring

theorem integral_dirichletPerronHighQuotient_eq_kernel_add_inv
    {y a b : ℝ} (hy : 0 < y) (g : ℝ → ℂ)
    (hg : Continuous g) (hgZero : ∀ t, g t ≠ 0) :
    (∫ t in a..b, dirichletPerronHighQuotient y (g t)) =
      (∫ t in a..b, dirichletExplicitFormulaKernel y (g t)) +
        ∫ t in a..b, 1 / g t := by
  have hkernel : Continuous fun t : ℝ =>
      dirichletExplicitFormulaKernel y (g t) :=
    (differentiable_dirichletExplicitFormulaKernel y).continuous.comp hg
  have hinv : Continuous fun t : ℝ => (1 : ℂ) / g t := by
    apply continuous_const.div₀ hg
    intro t ht
    exact (hgZero t ht).elim
  rw [intervalIntegral.integral_congr (fun t _ =>
      dirichletPerronHighQuotient_eq_kernel_add_inv hy (hgZero t)),
    intervalIntegral.integral_add
      (hkernel.intervalIntegrable _ _) (hinv.intervalIntegrable _ _)]

theorem norm_dirichletPerronHighQuotient_horizontal_le
    {y alpha R U t : ℝ} (hy : 0 < y) (hyOne : 1 < y)
    (horder : -R ≤ alpha) (hU : 0 < U) (hUt : U ≤ |t|) :
    ‖∫ r in -R..alpha,
      dirichletPerronHighQuotient y ((r : ℂ) + t * I)‖ ≤
      y ^ alpha / (U * Real.log y) := by
  have hlog : 0 < Real.log y := Real.log_pos hyOne
  let g : ℝ → ℝ := fun r => y ^ r / U
  have hg : Continuous g :=
    (Real.continuous_const_rpow hy.ne').div_const U
  have hpoint (r : ℝ) :
      ‖dirichletPerronHighQuotient y ((r : ℂ) + t * I)‖ ≤ g r := by
    rw [dirichletPerronHighQuotient, norm_div,
      Complex.norm_cpow_eq_rpow_re_of_pos hy]
    simp only [add_re, ofReal_re, mul_re, ofReal_im, I_re, I_im,
      mul_zero, zero_mul, sub_zero, add_zero]
    have hden : U ≤ ‖(r : ℂ) + t * I‖ := by
      calc
        U ≤ |t| := hUt
        _ = |((r : ℂ) + t * I).im| := by simp
        _ ≤ ‖(r : ℂ) + t * I‖ := Complex.abs_im_le_norm _
    exact div_le_div_of_nonneg_left
      (Real.rpow_nonneg hy.le r) hU hden
  have hderiv (r : ℝ) :
      HasDerivAt (fun u : ℝ => y ^ u / (U * Real.log y)) (g r) r := by
    have hraw := (Real.hasStrictDerivAt_const_rpow hy r).hasDerivAt
      |>.div_const (U * Real.log y)
    have hcoeff :
        y ^ r * Real.log y / (U * Real.log y) = y ^ r / U := by
      field_simp [hU.ne', hlog.ne']
    simpa [g, hcoeff] using hraw
  have hgInt : IntervalIntegrable g volume (-R) alpha :=
    hg.intervalIntegrable _ _
  calc
    ‖∫ r in -R..alpha,
        dirichletPerronHighQuotient y ((r : ℂ) + t * I)‖ ≤
        ∫ r in -R..alpha, g r :=
      intervalIntegral.norm_integral_le_of_norm_le horder
        (Eventually.of_forall fun r _ => hpoint r) hgInt
    _ = y ^ alpha / (U * Real.log y) -
        y ^ (-R) / (U * Real.log y) :=
      intervalIntegral.integral_eq_sub_of_hasDerivAt
        (fun r _ => hderiv r) hgInt
    _ ≤ y ^ alpha / (U * Real.log y) := by
      have hden : 0 < U * Real.log y := mul_pos hU hlog
      exact sub_le_self _ (div_nonneg
        (Real.rpow_nonneg hy.le (-R)) hden.le)

theorem norm_dirichletPerronHighQuotient_farVertical_le
    {y alpha R U : ℝ} (hy : 0 < y) (halpha : 0 < alpha)
    (halphaR : alpha ≤ R) :
    ‖∫ t in -U..U,
      dirichletPerronHighQuotient y (((-R : ℝ) : ℂ) + t * I)‖ ≤
      (y ^ (-R) / alpha) * (2 * |U|) := by
  change ‖∫ t in -U..U,
      (y : ℂ) ^ (((-R : ℝ) : ℂ) + t * I) /
        (((-R : ℝ) : ℂ) + t * I)‖ ≤
    (y ^ (-R) / alpha) * (2 * |U|)
  calc
    ‖∫ t in -U..U,
        (y : ℂ) ^ (((-R : ℝ) : ℂ) + t * I) /
          (((-R : ℝ) : ℂ) + t * I)‖ ≤
        (y ^ (-R) / alpha) * |U - (-U)| :=
      intervalIntegral.norm_integral_le_of_norm_le_const
        (a := -U) (b := U) (C := y ^ (-R) / alpha) (by
        intro t _
        rw [norm_div, Complex.norm_cpow_eq_rpow_re_of_pos hy]
        simp only [add_re, ofReal_re, mul_re, ofReal_im, I_re, I_im,
          mul_zero, zero_mul, sub_zero, add_zero]
        have hden : alpha ≤ ‖(((-R : ℝ) : ℂ) + t * I)‖ := by
          calc
            alpha ≤ R := halphaR
            _ = |(((-R : ℝ) : ℂ) + t * I).re| := by
              simp [abs_of_nonneg (halpha.le.trans halphaR)]
            _ ≤ ‖(((-R : ℝ) : ℂ) + t * I)‖ := Complex.abs_re_le_norm _
        exact div_le_div_of_nonneg_left
          (Real.rpow_nonneg hy.le (-R)) halpha hden)
    _ = (y ^ (-R) / alpha) * (2 * |U|) := by
      rw [show |U - (-U)| = 2 * |U| by
        rw [show U - (-U) = 2 * U by ring, abs_mul]
        norm_num]

theorem norm_dirichletPerronHighQuotient_vertical_sub_residue_le
    {y alpha U : ℝ} (hy : 0 < y) (hyOne : 1 < y)
    (halpha : 0 < alpha) (hU : 0 < U) :
    ‖(∫ t in -U..U,
        dirichletPerronHighQuotient y ((alpha : ℂ) + t * I)) -
      ((2 * Real.pi : ℝ) : ℂ)‖ ≤
      2 * (y ^ alpha / (U * Real.log y)) := by
  let H : ℝ := y ^ alpha / (U * Real.log y)
  have hfinite (R : ℝ) (halphaR : alpha ≤ R) :
      ‖(∫ t in -U..U,
          dirichletPerronHighQuotient y ((alpha : ℂ) + t * I)) -
        ((2 * Real.pi : ℝ) : ℂ)‖ ≤
        2 * H + (y ^ (-R) / alpha) * (2 * U) := by
    let bottom : ℂ := ∫ r in -R..alpha,
      dirichletPerronHighQuotient y ((r : ℂ) - U * I)
    let top : ℂ := ∫ r in -R..alpha,
      dirichletPerronHighQuotient y ((r : ℂ) + U * I)
    let right : ℂ := ∫ t in -U..U,
      dirichletPerronHighQuotient y ((alpha : ℂ) + t * I)
    let left : ℂ := ∫ t in -U..U,
      dirichletPerronHighQuotient y (((-R : ℝ) : ℂ) + t * I)
    have hRpos : 0 < R := halpha.trans_le halphaR
    have hbottomSplit : bottom =
        (∫ r in -R..alpha,
          dirichletExplicitFormulaKernel y ((r : ℂ) - U * I)) +
        ∫ r in -R..alpha, 1 / ((r : ℂ) - U * I) := by
      dsimp [bottom]
      exact integral_dirichletPerronHighQuotient_eq_kernel_add_inv hy
        (fun r : ℝ => (r : ℂ) - U * I) (by fun_prop) (fun r hr => by
          exact hU.ne' (by simpa using congrArg Complex.im hr))
    have htopSplit : top =
        (∫ r in -R..alpha,
          dirichletExplicitFormulaKernel y ((r : ℂ) + U * I)) +
        ∫ r in -R..alpha, 1 / ((r : ℂ) + U * I) := by
      dsimp [top]
      exact integral_dirichletPerronHighQuotient_eq_kernel_add_inv hy
        (fun r : ℝ => (r : ℂ) + U * I) (by fun_prop) (fun r hr => by
          exact hU.ne' (by simpa using congrArg Complex.im hr))
    have hrightSplit : right =
        (∫ t in -U..U,
          dirichletExplicitFormulaKernel y ((alpha : ℂ) + t * I)) +
        ∫ t in -U..U, 1 / ((alpha : ℂ) + t * I) := by
      dsimp [right]
      exact integral_dirichletPerronHighQuotient_eq_kernel_add_inv hy
        (fun t : ℝ => (alpha : ℂ) + t * I) (by fun_prop) (fun t ht => by
          exact halpha.ne' (by simpa using congrArg Complex.re ht))
    have hleftSplit : left =
        (∫ t in -U..U,
          dirichletExplicitFormulaKernel y (((-R : ℝ) : ℂ) + t * I)) +
        ∫ t in -U..U, 1 / (((-R : ℝ) : ℂ) + t * I) := by
      dsimp [left]
      exact integral_dirichletPerronHighQuotient_eq_kernel_add_inv hy
        (fun t : ℝ => (((-R : ℝ) : ℂ) + t * I)) (by fun_prop)
          (fun t ht => by
            exact hRpos.ne' (by simpa using congrArg Complex.re ht))
    have hregularized :=
      Complex.integral_boundary_rect_eq_zero_of_differentiableOn
        (dirichletExplicitFormulaKernel y)
        (Complex.mk (-R) (-U)) (Complex.mk alpha U)
        (differentiable_dirichletExplicitFormulaKernel y).differentiableOn
    have hregularized' :
        (∫ r in -R..alpha,
          dirichletExplicitFormulaKernel y ((r : ℂ) - U * I)) -
        (∫ r in -R..alpha,
          dirichletExplicitFormulaKernel y ((r : ℂ) + U * I)) +
        I * (∫ t in -U..U,
          dirichletExplicitFormulaKernel y ((alpha : ℂ) + t * I)) -
        I * (∫ t in -U..U,
          dirichletExplicitFormulaKernel y (((-R : ℝ) : ℂ) + t * I)) = 0 := by
      simpa [smul_eq_mul, sub_eq_add_neg] using hregularized
    have hpoleWedge :=
      wedgeIntegral_add_wedgeIntegral_div_sub_eq_two_pi_I_mul
        (Complex.mk (-R) (-U)) (Complex.mk alpha U) 0 1
        (by simp; linarith) (by simpa using halpha)
        (by simpa using hU) (by simpa using hU)
    rw [Complex.wedgeIntegral_add_wedgeIntegral_eq] at hpoleWedge
    have hpole :
        (∫ r in -R..alpha, 1 / ((r : ℂ) - U * I)) -
        (∫ r in -R..alpha, 1 / ((r : ℂ) + U * I)) +
        I * (∫ t in -U..U, 1 / ((alpha : ℂ) + t * I)) -
        I * (∫ t in -U..U, 1 / (((-R : ℝ) : ℂ) + t * I)) =
          2 * Real.pi * I := by
      simpa [smul_eq_mul, sub_eq_add_neg] using hpoleWedge
    have hboundary :
        bottom - top + I * right - I * left = 2 * Real.pi * I := by
      rw [hbottomSplit, htopSplit, hrightSplit, hleftSplit]
      linear_combination hregularized' + hpole
    have hsolve :
        I * (right - ((2 * Real.pi : ℝ) : ℂ)) =
          top - bottom + I * left := by
      calc
        I * (right - ((2 * Real.pi : ℝ) : ℂ)) =
            I * right - 2 * Real.pi * I := by
          push_cast
          ring
        _ = top - bottom + I * left := by
          linear_combination hboundary
    have hnorm :
        ‖right - ((2 * Real.pi : ℝ) : ℂ)‖ ≤
          ‖top‖ + ‖bottom‖ + ‖left‖ := by
      calc
        ‖right - ((2 * Real.pi : ℝ) : ℂ)‖ =
            ‖I * (right - ((2 * Real.pi : ℝ) : ℂ))‖ := by simp
        _ = ‖top - bottom + I * left‖ := by rw [hsolve]
        _ ≤ ‖top - bottom‖ + ‖I * left‖ := norm_add_le _ _
        _ ≤ (‖top‖ + ‖bottom‖) + ‖left‖ := by
          gcongr
          · exact norm_sub_le _ _
          · simp
    have horder : -R ≤ alpha := by linarith
    have hbottom : ‖bottom‖ ≤ H := by
      dsimp [bottom, H]
      have hbound := norm_dirichletPerronHighQuotient_horizontal_le
        (y := y) (alpha := alpha) (R := R) (U := U) (t := -U)
        hy hyOne horder hU (by simp [abs_of_pos hU])
      convert hbound using 1
      apply congrArg norm
      apply intervalIntegral.integral_congr
      intro r _
      apply congrArg (dirichletPerronHighQuotient y)
      push_cast
      ring
    have htop : ‖top‖ ≤ H :=
      norm_dirichletPerronHighQuotient_horizontal_le
        hy hyOne horder hU (le_abs_self U)
    have hleft : ‖left‖ ≤ (y ^ (-R) / alpha) * (2 * U) := by
      simpa [left, abs_of_pos hU] using
        norm_dirichletPerronHighQuotient_farVertical_le
          (U := U) hy halpha halphaR
    change ‖right - ((2 * Real.pi : ℝ) : ℂ)‖ ≤
      2 * H + (y ^ (-R) / alpha) * (2 * U)
    exact hnorm.trans <| calc
      ‖top‖ + ‖bottom‖ + ‖left‖ ≤
          H + H + (y ^ (-R) / alpha) * (2 * U) :=
        add_le_add (add_le_add htop hbottom) hleft
      _ = 2 * H + (y ^ (-R) / alpha) * (2 * U) := by ring
  have hyLimit : Tendsto (fun R : ℝ => y ^ (-R)) atTop (nhds 0) := by
    simpa [Function.comp_def] using
      (tendsto_rpow_atBot_of_base_gt_one y hyOne).comp
        tendsto_neg_atTop_atBot
  have hlimit : Tendsto
      (fun R : ℝ => 2 * H + (y ^ (-R) / alpha) * (2 * U))
      atTop (nhds (2 * H)) := by
    simpa using tendsto_const_nhds.add
      ((hyLimit.div_const alpha).mul_const (2 * U))
  exact ge_of_tendsto hlimit <|
    (eventually_ge_atTop alpha).mono fun R hR => hfinite R hR

end DirichletPerronHighBase

theorem norm_dirichletPerronKernel_sub_one_highBase_le
    {y alpha U : ℝ} (hyLower : 2 ≤ y)
    (halpha : 0 < alpha) (hU : 0 < U) :
    ‖dirichletPerronKernel y alpha U - 1‖ ≤ y ^ alpha / U := by
  have hy : 0 < y := (by norm_num : (0 : ℝ) < 2).trans_le hyLower
  have hyOne : 1 < y := (by norm_num : (1 : ℝ) < 2).trans_le hyLower
  have hlog : 0 < Real.log y := Real.log_pos hyOne
  have hraw := norm_dirichletPerronHighQuotient_vertical_sub_residue_le
    hy hyOne halpha hU
  rw [dirichletPerronKernel]
  change ‖(((2 * Real.pi : ℝ) : ℂ)⁻¹) *
      (∫ t in -U..U,
        dirichletPerronHighQuotient y ((alpha : ℂ) + t * I)) - 1‖ ≤
    y ^ alpha / U
  have hscale :
      (((2 * Real.pi : ℝ) : ℂ)⁻¹) *
        ((2 * Real.pi : ℝ) : ℂ) = 1 := by
    exact inv_mul_cancel₀ (Complex.ofReal_ne_zero.mpr
      (mul_ne_zero (by norm_num) Real.pi_ne_zero))
  have hnormalize :
      (((2 * Real.pi : ℝ) : ℂ)⁻¹) *
          (∫ t in -U..U,
            dirichletPerronHighQuotient y ((alpha : ℂ) + t * I)) - 1 =
        (((2 * Real.pi : ℝ) : ℂ)⁻¹) *
          ((∫ t in -U..U,
            dirichletPerronHighQuotient y ((alpha : ℂ) + t * I)) -
              ((2 * Real.pi : ℝ) : ℂ)) := by
    rw [mul_sub, hscale]
  rw [hnormalize, norm_mul, norm_inv, Complex.norm_real,
    Real.norm_eq_abs, abs_of_pos (mul_pos (by norm_num) Real.pi_pos)]
  have hsharp :
      (1 / (2 * Real.pi)) *
          ‖(∫ t in -U..U,
              dirichletPerronHighQuotient y ((alpha : ℂ) + t * I)) -
            ((2 * Real.pi : ℝ) : ℂ)‖ ≤
        y ^ alpha / (Real.pi * U * Real.log y) := by
    calc
      (1 / (2 * Real.pi)) *
          ‖(∫ t in -U..U,
              dirichletPerronHighQuotient y ((alpha : ℂ) + t * I)) -
            ((2 * Real.pi : ℝ) : ℂ)‖ ≤
          (1 / (2 * Real.pi)) *
            (2 * (y ^ alpha / (U * Real.log y))) :=
        mul_le_mul_of_nonneg_left hraw (by positivity)
      _ = y ^ alpha / (Real.pi * U * Real.log y) := by
        field_simp [Real.pi_ne_zero, hU.ne', hlog.ne']
  have hfactor : (2 * Real.pi)⁻¹ = 1 / (2 * Real.pi) := by
    simp [div_eq_mul_inv]
  rw [hfactor]
  apply hsharp.trans
  have hlogTwo : Real.log 2 ≤ Real.log y :=
    Real.log_le_log (by norm_num) hyLower
  have hpiLogTwo : (1 : ℝ) ≤ Real.pi * Real.log 2 := by
    have hmul :
        (3 : ℝ) * 0.6931471803 < Real.pi * Real.log 2 :=
      mul_lt_mul Real.pi_gt_three Real.log_two_gt_d9.le
        (by norm_num) Real.pi_pos.le
    exact ((by norm_num : (1 : ℝ) < 3 * 0.6931471803).trans hmul).le
  have hden : U ≤ Real.pi * U * Real.log y := by
    calc
      U = U * 1 := by ring
      _ ≤ U * (Real.pi * Real.log 2) :=
        mul_le_mul_of_nonneg_left hpiLogTwo hU.le
      _ ≤ U * (Real.pi * Real.log y) := by gcongr
      _ = Real.pi * U * Real.log y := by ring
  exact div_le_div_of_nonneg_left
    (Real.rpow_nonneg hy.le alpha) hU hden

theorem norm_dirichletPerronKernel_sub_naturalWeight_outer_le
    {x n : ℕ} {alpha U : ℝ}
    (hx : 0 < x) (hn : 0 < n)
    (hOuter : (n : ℝ) ≤ (x : ℝ) / 2 ∨
      2 * x ≤ (n : ℝ))
    (halpha : 0 < alpha) (hU : 0 < U) :
    ‖dirichletPerronKernel ((x : ℝ) / n) alpha U -
      (dirichletPerronNaturalWeight x n : ℂ)‖ ≤
      (((x : ℝ) / n) ^ alpha) / U := by
  have hnReal : (0 : ℝ) < n := by exact_mod_cast hn
  have hxReal : (0 : ℝ) < x := by exact_mod_cast hx
  rcases hOuter with hLower | hUpper
  · have hnx : n < x := by
      exact_mod_cast (show (n : ℝ) < x by linarith)
    have hyLower : (2 : ℝ) ≤ (x : ℝ) / n := by
      rw [le_div_iff₀ hnReal]
      linarith
    rw [dirichletPerronNaturalWeight_of_pos_of_lt hn hnx]
    simpa using norm_dirichletPerronKernel_sub_one_highBase_le
      hyLower halpha hU
  · have hxn : x < n := by
      exact_mod_cast (show (x : ℝ) < n by linarith)
    have hy : (0 : ℝ) < (x : ℝ) / n := div_pos hxReal hnReal
    have hyUpper : (x : ℝ) / n ≤ 1 / 2 := by
      rw [div_le_iff₀ hnReal]
      linarith
    rw [dirichletPerronNaturalWeight_of_lt hxn]
    simpa using norm_dirichletPerronKernel_lowBase_le
      hy hyUpper halpha hU

end

section
open Complex
/--
The near-diagonal truncation weight `min 1 (2 * x / (U * |x - n|))` for positive indices with `x
/ 2 < n < 2 * x` and `n ≠ x`. It is zero outside that range and at the endpoint `n = x`.
-/
noncomputable def dirichletPerronNearError
    (x : ℕ) (U : ℝ) (n : ℕ) : ℝ :=
  if 0 < n ∧ (x : ℝ) / 2 < (n : ℝ) ∧
      (n : ℝ) < 2 * x ∧ n ≠ x then
    min 1 (2 * (x : ℝ) /
      (U * |(x : ℝ) - n|))
  else 0

@[simp]
theorem dirichletPerronNearError_zero (x : ℕ) (U : ℝ) :
    dirichletPerronNearError x U 0 = 0 := by
  simp [dirichletPerronNearError]

@[simp]
theorem dirichletPerronNearError_self (x : ℕ) (U : ℝ) :
    dirichletPerronNearError x U x = 0 := by
  simp [dirichletPerronNearError]

section DirichletPerronOneTerm
theorem quarter_le_div_rpow
    {x n : ℕ} {alpha : ℝ}
    (hx : 0 < x) (hn : 0 < n)
    (hUpper : (n : ℝ) < 2 * x)
    (halpha : 0 < alpha) (halphaUpper : alpha ≤ 2) :
    (1 / 4 : ℝ) ≤ ((x : ℝ) / n) ^ alpha := by
  have hxR : (0 : ℝ) < x := by exact_mod_cast hx
  have hnR : (0 : ℝ) < n := by exact_mod_cast hn
  let y : ℝ := (x : ℝ) / n
  have hy : 0 < y := div_pos hxR hnR
  have hyLower : (1 / 2 : ℝ) ≤ y := by
    dsimp [y]
    rw [le_div_iff₀ hnR]
    nlinarith
  by_cases hyOne : y ≤ 1
  · have hsquare : (1 / 4 : ℝ) ≤ y ^ (2 : ℕ) := by
      nlinarith
    have hsquareReal : (1 / 4 : ℝ) ≤ y ^ (2 : ℝ) := by
      simpa [Real.rpow_two] using hsquare
    have hpower : y ^ (2 : ℝ) ≤ y ^ alpha :=
      Real.rpow_le_rpow_of_exponent_ge hy hyOne halphaUpper
    simpa [y] using hsquareReal.trans hpower
  · have hone : (1 : ℝ) ≤ y := le_of_not_ge hyOne
    have hpower : (1 : ℝ) ≤ y ^ alpha :=
      Real.one_le_rpow hone halpha.le
    dsimp [y] at hpower ⊢
    linarith

theorem central_constant_le_ratio_power
    {x n : ℕ} {alpha U : ℝ}
    (hx : 0 < x) (hn : 0 < n)
    (hUpper : (n : ℝ) < 2 * x)
    (halpha : 0 < alpha) (halphaUpper : alpha ≤ 2)
    (hU : 0 < U) :
    20 / (Real.pi * U) ≤
      32 * (((x : ℝ) / n) ^ alpha) / U := by
  have hquarter := quarter_le_div_rpow hx hn hUpper
    halpha halphaUpper
  have hpi : 20 / Real.pi ≤ (8 : ℝ) := by
    rw [div_le_iff₀ Real.pi_pos]
    nlinarith [Real.pi_gt_three]
  have hpow :
      20 / Real.pi ≤ 32 * (((x : ℝ) / n) ^ alpha) := by
    nlinarith
  calc
    20 / (Real.pi * U) = (20 / Real.pi) / U := by ring
    _ ≤ (32 * (((x : ℝ) / n) ^ alpha)) / U :=
      div_le_div_of_nonneg_right hpow hU.le

theorem endpoint_constant_le
    {alpha U : ℝ} (halphaUpper : alpha ≤ 2) (hU : 0 < U) :
    alpha / (Real.pi * U) ≤ 32 / U := by
  have hpi : alpha / Real.pi ≤ (32 : ℝ) := by
    rw [div_le_iff₀ Real.pi_pos]
    nlinarith [Real.pi_gt_three]
  calc
    alpha / (Real.pi * U) = (alpha / Real.pi) / U := by ring
    _ ≤ 32 / U := div_le_div_of_nonneg_right hpi hU.le

end DirichletPerronOneTerm

theorem norm_dirichletPerronKernel_sub_naturalWeight_le
    {x n : ℕ} {alpha U : ℝ}
    (hx : 0 < x) (hn : 0 < n)
    (halpha : 0 < alpha) (halphaUpper : alpha ≤ 2)
    (hU : 0 < U) :
    ‖dirichletPerronKernel ((x : ℝ) / n) alpha U -
      (dirichletPerronNaturalWeight x n : ℂ)‖ ≤
      dirichletPerronNearError x U n +
        32 * (((x : ℝ) / n) ^ alpha) / U := by
  by_cases hne : n = x
  · subst n
    have hxR0 : (x : ℝ) ≠ 0 := by exact_mod_cast hx.ne'
    have hendpoint :=
      norm_dirichletPerronKernel_one_sub_half_le halpha hU
    have hbound := endpoint_constant_le halphaUpper hU
    simpa [dirichletPerronNaturalWeight_self hx, hxR0] using
      hendpoint.trans hbound
  · by_cases hLower : (x : ℝ) / 2 < (n : ℝ)
    · by_cases hUpper : (n : ℝ) < 2 * x
      · have hcentral :=
          norm_dirichletPerronKernel_sub_naturalWeight_central_le
            hx hn hLower hUpper hne halpha halphaUpper hU
        rw [dirichletPerronNearError,
          ite_eq_left ⟨hn, hLower, hUpper, hne⟩]
        exact hcentral.trans <| add_le_add (le_refl _)
          (central_constant_le_ratio_power hx hn hUpper
            halpha halphaUpper hU)
      · have hOuter :
          (n : ℝ) ≤ (x : ℝ) / 2 ∨ 2 * x ≤ (n : ℝ) :=
          Or.inr (le_of_not_gt hUpper)
        have houter :=
          norm_dirichletPerronKernel_sub_naturalWeight_outer_le
            hx hn hOuter halpha hU
        rw [dirichletPerronNearError, ite_eq_right (by
          intro h
          exact hUpper h.2.2.1)]
        have hyNonneg : (0 : ℝ) ≤ ((x : ℝ) / n) ^ alpha :=
          Real.rpow_nonneg (div_nonneg (by positivity) (by positivity)) _
        exact houter.trans (by
          simp only [zero_add]
          have hfactor : (1 : ℝ) ≤ 32 := by norm_num
          calc
            ((x : ℝ) / n) ^ alpha / U =
                1 * (((x : ℝ) / n) ^ alpha / U) := by ring
            _ ≤ 32 * (((x : ℝ) / n) ^ alpha / U) :=
              mul_le_mul_of_nonneg_right hfactor
                (div_nonneg hyNonneg hU.le)
            _ = 32 * ((x : ℝ) / n) ^ alpha / U := by ring)
    · have hOuter :
        (n : ℝ) ≤ (x : ℝ) / 2 ∨ 2 * x ≤ (n : ℝ) :=
        Or.inl (le_of_not_gt hLower)
      have houter :=
        norm_dirichletPerronKernel_sub_naturalWeight_outer_le
          hx hn hOuter halpha hU
      rw [dirichletPerronNearError, ite_eq_right (by
        intro h
        exact hLower h.2.1)]
      have hyNonneg : (0 : ℝ) ≤ ((x : ℝ) / n) ^ alpha :=
        Real.rpow_nonneg (div_nonneg (by positivity) (by positivity)) _
      exact houter.trans (by
        simp only [zero_add]
        have hfactor : (1 : ℝ) ≤ 32 := by norm_num
        calc
          ((x : ℝ) / n) ^ alpha / U =
              1 * (((x : ℝ) / n) ^ alpha / U) := by ring
          _ ≤ 32 * (((x : ℝ) / n) ^ alpha / U) :=
            mul_le_mul_of_nonneg_right hfactor
              (div_nonneg hyNonneg hU.le)
          _ = 32 * ((x : ℝ) / n) ^ alpha / U := by ring)

end

section
open Complex
/--
The sum of `a n` over `1 ≤ n < x`, with an additional half-weighted endpoint term `a x / 2`.
-/
noncomputable def dirichletPerronStarredSum
    (a : ℕ → ℂ) (x : ℕ) : ℂ :=
  (∑ n ∈ Finset.Ico 1 x, a n) + (1 / 2 : ℂ) * a x

/--
The sum of coefficient norms weighted by the near-diagonal Perron error. The weight restricts
the contribution to indices close to, but different from, `x`.
-/
noncomputable def dirichletPerronNearMass
    (a : ℕ → ℂ) (x : ℕ) (U : ℝ) : ℝ :=
  ∑' n : ℕ, ‖a n‖ * dirichletPerronNearError x U n

/--
The sum of the norms of the Dirichlet-series terms on the real line `s = alpha`. When the norm
series is summable, this is the absolute coefficient mass used to control Perron truncation away
from the endpoint.
-/
noncomputable def dirichletPerronCoefficientMass
    (a : ℕ → ℂ) (alpha : ℝ) : ℝ :=
  ∑' n : ℕ, ‖LSeries.term a (alpha : ℂ) n‖

/--
The truncated vertical integral of `LSeries a s * y ^ s / s` on `re = alpha`. The imaginary
parameter runs from `-U` to `U`, with normalization `1 / (2 * pi)`.
-/
noncomputable def dirichletPerronIntegral
    (a : ℕ → ℂ) (y alpha U : ℝ) : ℂ :=
  (((2 * Real.pi : ℝ) : ℂ)⁻¹) *
    ∫ t in -U..U,
      LSeries a ((alpha : ℂ) + t * I) *
        (y : ℂ) ^ ((alpha : ℂ) + t * I) /
          ((alpha : ℂ) + t * I)

section DirichletPerronSeries
theorem cpow_div_of_pos
    {x y : ℝ} (hx : 0 < x) (hy : 0 < y) (s : ℂ) :
    ((x / y : ℝ) : ℂ) ^ s = (x : ℂ) ^ s / (y : ℂ) ^ s := by
  simpa only [Complex.ofReal_div] using
    Complex.div_cpow_ofReal_nonneg hx.le hy.le s

theorem norm_perron_series_term_le
    {a : ℕ → ℂ} {x : ℕ} {alpha : ℝ}
    (hx : 0 < x) (halpha : 0 < alpha) (n : ℕ) (t : ℝ) :
    ‖LSeries.term a ((alpha : ℂ) + t * I) n *
        (x : ℂ) ^ ((alpha : ℂ) + t * I) /
          ((alpha : ℂ) + t * I)‖ ≤
      ‖LSeries.term a (alpha : ℂ) n‖ * ((x : ℝ) ^ alpha / alpha) := by
  let s : ℂ := (alpha : ℂ) + t * I
  have hxR : (0 : ℝ) < x := by exact_mod_cast hx
  have hsRe : s.re = alpha := by simp [s]
  have hsNorm : alpha ≤ ‖s‖ := by
    have h := Complex.abs_re_le_norm s
    simpa [hsRe, abs_of_pos halpha] using h
  have hsNormPos : 0 < ‖s‖ := halpha.trans_le hsNorm
  have hterm : ‖LSeries.term a s n‖ = ‖LSeries.term a (alpha : ℂ) n‖ := by
    simp only [LSeries.norm_term_eq, hsRe, Complex.ofReal_re]
  have hxPow : ‖(x : ℂ) ^ s‖ = (x : ℝ) ^ alpha := by
    simpa [hsRe] using Complex.norm_cpow_eq_rpow_re_of_pos hxR s
  have hpowNonneg : 0 ≤ (x : ℝ) ^ alpha := Real.rpow_nonneg hxR.le _
  have hdiv : (x : ℝ) ^ alpha / ‖s‖ ≤ (x : ℝ) ^ alpha / alpha :=
    div_le_div_of_nonneg_left hpowNonneg halpha hsNorm
  change ‖LSeries.term a s n * (x : ℂ) ^ s / s‖ ≤ _
  rw [norm_div, norm_mul, hterm, hxPow]
  calc
    ‖LSeries.term a (alpha : ℂ) n‖ * (x : ℝ) ^ alpha / ‖s‖ =
        ‖LSeries.term a (alpha : ℂ) n‖ *
          ((x : ℝ) ^ alpha / ‖s‖) := by ring
    _ ≤ ‖LSeries.term a (alpha : ℂ) n‖ *
          ((x : ℝ) ^ alpha / alpha) :=
      mul_le_mul_of_nonneg_left hdiv (norm_nonneg _)

theorem integral_perron_series_term_eq
    {a : ℕ → ℂ} {x n : ℕ} {alpha U : ℝ}
    (hx : 0 < x) (hn : 0 < n) :
    (∫ t in -U..U,
      LSeries.term a ((alpha : ℂ) + t * I) n *
        (x : ℂ) ^ ((alpha : ℂ) + t * I) /
          ((alpha : ℂ) + t * I)) =
      a n * (∫ t in -U..U,
        (((x : ℝ) / n : ℝ) : ℂ) ^ ((alpha : ℂ) + t * I) /
          ((alpha : ℂ) + t * I)) := by
  have hxR : (0 : ℝ) < x := by exact_mod_cast hx
  have hnR : (0 : ℝ) < n := by exact_mod_cast hn
  rw [← intervalIntegral.integral_const_mul]
  apply intervalIntegral.integral_congr
  intro t _
  change LSeries.term a ((alpha : ℂ) + t * I) n *
      (x : ℂ) ^ ((alpha : ℂ) + t * I) /
        ((alpha : ℂ) + t * I) =
    a n * ((((x : ℝ) / n : ℝ) : ℂ) ^ ((alpha : ℂ) + t * I) /
      ((alpha : ℂ) + t * I))
  rw [LSeries.term_of_ne_zero hn.ne', cpow_div_of_pos hxR hnR]
  simp only [Complex.ofReal_natCast]
  ring

theorem hasSum_perron_kernel_integrals
    {a : ℕ → ℂ} {x : ℕ} {alpha U : ℝ}
    (hsum : LSeriesSummable a (alpha : ℂ))
    (hx : 0 < x) (halpha : 0 < alpha) :
    HasSum (fun n : ℕ => if n = 0 then 0 else
      a n * dirichletPerronKernel ((x : ℝ) / n) alpha U)
        (dirichletPerronIntegral a x alpha U) := by
  let F : ℕ → ℝ → ℂ := fun n t =>
    LSeries.term a ((alpha : ℂ) + t * I) n *
      (x : ℂ) ^ ((alpha : ℂ) + t * I) /
        ((alpha : ℂ) + t * I)
  let G : ℝ → ℂ := fun t =>
    LSeries a ((alpha : ℂ) + t * I) *
      (x : ℂ) ^ ((alpha : ℂ) + t * I) /
        ((alpha : ℂ) + t * I)
  let bound : ℕ → ℝ → ℝ := fun n _ =>
    ‖LSeries.term a (alpha : ℂ) n‖ * ((x : ℝ) ^ alpha / alpha)
  have hnorm : Summable fun n : ℕ => ‖LSeries.term a (alpha : ℂ) n‖ := hsum.norm
  have hboundSummable : Summable fun n : ℕ =>
      ‖LSeries.term a (alpha : ℂ) n‖ * ((x : ℝ) ^ alpha / alpha) :=
    hnorm.mul_right _
  have hinterchange : HasSum (fun n : ℕ => ∫ t in -U..U, F n t)
      (∫ t in -U..U, G t) := by
    refine intervalIntegral.hasSum_integral_of_dominated_convergence bound ?_ ?_ ?_ ?_ ?_
    · intro n
      rcases eq_or_ne n 0 with rfl | hn
      · simpa [F] using
          (continuous_const.aestronglyMeasurable :
            AEStronglyMeasurable (fun _ : ℝ => (0 : ℂ))).restrict
      · have hnR : (0 : ℝ) < n := by exact_mod_cast Nat.pos_of_ne_zero hn
        have hxR : (0 : ℝ) < x := by exact_mod_cast hx
        have hs : Continuous fun t : ℝ => (alpha : ℂ) + t * I := by fun_prop
        have hsne : ∀ t : ℝ, (alpha : ℂ) + t * I ≠ 0 := by
          intro t ht
          have hre := congrArg Complex.re ht
          simp at hre
          linarith
        have hnPow : Continuous fun t : ℝ =>
            (n : ℂ) ^ ((alpha : ℂ) + t * I) := by
          exact continuous_const.cpow hs fun _ => by
            simpa only [← Complex.ofReal_natCast] using
              Complex.ofReal_mem_slitPlane.mpr hnR
        have hnPowNe : ∀ t : ℝ,
            (n : ℂ) ^ ((alpha : ℂ) + t * I) ≠ 0 := by
          intro t
          exact Complex.cpow_ne_zero_iff.mpr <| Or.inl <|
            Nat.cast_ne_zero.mpr hn
        have hxPow : Continuous fun t : ℝ =>
            (x : ℂ) ^ ((alpha : ℂ) + t * I) := by
          exact continuous_const.cpow hs fun _ => by
            simpa only [← Complex.ofReal_natCast] using
              Complex.ofReal_mem_slitPlane.mpr hxR
        have hterm : Continuous fun t : ℝ =>
            a n / (n : ℂ) ^ ((alpha : ℂ) + t * I) :=
          continuous_const.div hnPow hnPowNe
        exact (show Continuous (F n) by
          simp only [F, LSeries.term_of_ne_zero hn]
          exact (hterm.mul hxPow).div hs hsne).aestronglyMeasurable
    · intro n
      exact ae_of_all _ fun t _ => norm_perron_series_term_le hx halpha n t
    · exact ae_of_all _ fun _ _ => hboundSummable
    · simpa only [bound, tsum_mul_right] using
        (intervalIntegrable_const : IntervalIntegrable
          (fun _ : ℝ =>
            (∑' n : ℕ, ‖LSeries.term a (alpha : ℂ) n‖) *
              ((x : ℝ) ^ alpha / alpha)) volume (-U) U)
    · exact ae_of_all _ fun t _ => by
        have htSum : LSeriesSummable a ((alpha : ℂ) + t * I) :=
          hsum.of_re_le_re (by simp)
        let K : ℂ := (x : ℂ) ^ ((alpha : ℂ) + t * I) /
          ((alpha : ℂ) + t * I)
        have hG : G t = LSeries a ((alpha : ℂ) + t * I) * K := by
          dsimp [G, K]
          ring
        rw [hG]
        exact (htSum.LSeriesHasSum.mul_right K).congr_fun fun n => by
          dsimp [F, K]
          ring
  have hscaled := hinterchange.mul_left (((2 * Real.pi : ℝ) : ℂ)⁻¹)
  rw [dirichletPerronIntegral]
  refine hscaled.congr_fun ?_
  intro n
  rcases eq_or_ne n 0 with rfl | hn
  · simp [F]
  · rw [ite_eq_right hn]
    rw [integral_perron_series_term_eq hx (Nat.pos_of_ne_zero hn)]
    rw [dirichletPerronKernel]
    ring

theorem tsum_naturalWeight_eq_starredSum
    {a : ℕ → ℂ} {x : ℕ} (hx : 0 < x) :
    (∑' n : ℕ, if n = 0 then 0 else
      a n * (dirichletPerronNaturalWeight x n : ℂ)) =
        dirichletPerronStarredSum a x := by
  rw [tsum_eq_sum (s := Finset.Ico 1 (x + 1)) (by
    intro n hn
    have hnot : ¬(1 ≤ n ∧ n < x + 1) := by
      simpa only [Finset.mem_Ico] using hn
    by_cases hnZero : n = 0
    · simp [hnZero]
    · have hnx : x < n := by omega
      simp [hnZero, dirichletPerronNaturalWeight,
        not_lt_of_ge hnx.le, ne_of_gt hnx])]
  rw [Finset.sum_Ico_succ_top (Nat.one_le_iff_ne_zero.mpr hx.ne')]
  rw [dirichletPerronStarredSum]
  congr 1
  · apply Finset.sum_congr rfl
    intro n hn
    have hmem := Finset.mem_Ico.mp hn
    have hnZero : n ≠ 0 := by omega
    simp [dirichletPerronNaturalWeight, hnZero, hmem.2]
  · simp [dirichletPerronNaturalWeight, hx.ne']
    ring

theorem summable_perron_nearMass
    (a : ℕ → ℂ) (x : ℕ) (U : ℝ) :
    Summable fun n : ℕ => ‖a n‖ * dirichletPerronNearError x U n := by
  refine summable_of_ne_finset_zero (s := Finset.range (2 * x)) ?_
  intro n hn
  have hnLower : 2 * x ≤ n := by simpa using hn
  have hnLowerR : (2 : ℝ) * x ≤ n := by exact_mod_cast hnLower
  rw [dirichletPerronNearError, ite_eq_right]
  · simp
  · intro h
    exact (not_lt_of_ge hnLowerR) h.2.2.1

theorem ratio_mass_identity
    {a : ℕ → ℂ} {x n : ℕ} {alpha U : ℝ} (hn : 0 < n) :
    ‖a n‖ * (32 * (((x : ℝ) / n) ^ alpha) / U) =
      (32 * (x : ℝ) ^ alpha / U) *
        ‖LSeries.term a (alpha : ℂ) n‖ := by
  rw [LSeries.norm_term_eq, ite_eq_right hn.ne', Complex.ofReal_re,
    Real.div_rpow (Nat.cast_nonneg _) (Nat.cast_nonneg _)]
  ring

end DirichletPerronSeries

theorem intervalIntegrable_dirichletPerronLSeriesIntegrand
    {a : ℕ → ℂ} {y alpha U : ℝ}
    (hsum : LSeriesSummable a (alpha : ℂ))
    (hy : 0 < y) (halpha : 0 < alpha) :
    IntervalIntegrable
      (fun t : ℝ =>
        LSeries a ((alpha : ℂ) + t * I) *
          (y : ℂ) ^ ((alpha : ℂ) + t * I) /
            ((alpha : ℂ) + t * I))
      volume (-U) U := by
  let s : ℝ → ℂ := fun t => (alpha : ℂ) + t * I
  have hs : Continuous s := by fun_prop
  have hsne (t : ℝ) : s t ≠ 0 := by
    intro ht
    exact halpha.ne' (by simpa [s] using congrArg Complex.re ht)
  have htermContinuous (n : ℕ) :
      Continuous fun t : ℝ => LSeries.term a (s t) n := by
    rcases eq_or_ne n 0 with rfl | hn
    · simpa using
        (continuous_const : Continuous fun _ : ℝ => (0 : ℂ))
    · have hnReal : (0 : ℝ) < n := by exact_mod_cast Nat.pos_of_ne_zero hn
      have hpow : Continuous fun t : ℝ => (n : ℂ) ^ s t := by
        exact continuous_const.cpow hs fun _ => by
          simpa only [← Complex.ofReal_natCast] using
            Complex.ofReal_mem_slitPlane.mpr hnReal
      have hpowNe (t : ℝ) : (n : ℂ) ^ s t ≠ 0 :=
        Complex.cpow_ne_zero_iff.mpr <| Or.inl <|
          Nat.cast_ne_zero.mpr hn
      simp only [LSeries.term_of_ne_zero hn]
      exact continuous_const.div hpow hpowNe
  have hLMeasurable : AEStronglyMeasurable
      (fun t : ℝ => LSeries a (s t))
      (volume.restrict (Set.uIoc (-U) U)) := by
    have hmeas : AEMeasurable
        (fun t : ℝ => ∑' n : ℕ, LSeries.term a (s t) n)
        (volume.restrict (Set.uIoc (-U) U)) :=
      AEMeasurable.tsum fun n => (htermContinuous n).aemeasurable
    simpa only [LSeries] using hmeas.aestronglyMeasurable
  have hyPow : Continuous fun t : ℝ => (y : ℂ) ^ s t :=
    continuous_const.cpow hs fun _ =>
      Complex.ofReal_mem_slitPlane.mpr hy
  have hscalar : Continuous fun t : ℝ => (y : ℂ) ^ s t / s t :=
    hyPow.div hs hsne
  have hintegrandMeasurable : AEStronglyMeasurable
      (fun t : ℝ => LSeries a (s t) * (y : ℂ) ^ s t / s t)
      (volume.restrict (Set.uIoc (-U) U)) := by
    convert hLMeasurable.mul hscalar.aestronglyMeasurable using 1
    ext t
    simp only [Pi.mul_apply]
    ring
  let M : ℝ :=
    dirichletPerronCoefficientMass a alpha * (y ^ alpha / alpha)
  have hmassNonneg : 0 ≤ dirichletPerronCoefficientMass a alpha :=
    tsum_nonneg fun _ => norm_nonneg _
  have hbound (t : ℝ) :
      ‖LSeries a (s t) * (y : ℂ) ^ s t / s t‖ ≤ M := by
    have hsRe : (s t).re = alpha := by simp [s]
    have hline : LSeriesSummable a (s t) :=
      hsum.of_re_le_re (by simp [s])
    have hL : ‖LSeries a (s t)‖ ≤
        dirichletPerronCoefficientMass a alpha := by
      calc
        ‖LSeries a (s t)‖ ≤ ∑' n : ℕ, ‖LSeries.term a (s t) n‖ :=
          norm_tsum_le_tsum_norm hline.norm
        _ = dirichletPerronCoefficientMass a alpha := by
          rw [dirichletPerronCoefficientMass]
          apply tsum_congr
          intro n
          simp only [LSeries.norm_term_eq, hsRe, Complex.ofReal_re]
    have hsNorm : alpha ≤ ‖s t‖ := by
      have h := Complex.abs_re_le_norm (s t)
      simpa [hsRe, abs_of_pos halpha] using h
    have hyNorm : ‖(y : ℂ) ^ s t / s t‖ ≤ y ^ alpha / alpha := by
      rw [norm_div, Complex.norm_cpow_eq_rpow_re_of_pos hy, hsRe]
      exact div_le_div_of_nonneg_left
        (Real.rpow_nonneg hy.le alpha) halpha hsNorm
    rw [show LSeries a (s t) * (y : ℂ) ^ s t / s t =
        LSeries a (s t) * ((y : ℂ) ^ s t / s t) by ring,
      norm_mul]
    dsimp [M]
    calc
      ‖LSeries a (s t)‖ * ‖(y : ℂ) ^ s t / s t‖ ≤
          dirichletPerronCoefficientMass a alpha *
            ‖(y : ℂ) ^ s t / s t‖ :=
        mul_le_mul_of_nonneg_right hL (norm_nonneg _)
      _ ≤ dirichletPerronCoefficientMass a alpha *
          (y ^ alpha / alpha) :=
        mul_le_mul_of_nonneg_left hyNorm hmassNonneg
  change IntervalIntegrable
    (fun t : ℝ => LSeries a (s t) * (y : ℂ) ^ s t / s t)
    volume (-U) U
  exact intervalIntegrable_const.mono_fun' hintegrandMeasurable
    (ae_restrict_of_forall_mem measurableSet_uIoc fun t _ => hbound t)

theorem norm_dirichletPerronStarredSum_sub_integral_le
    {a : ℕ → ℂ} {x : ℕ} {alpha U : ℝ}
    (hsum : LSeriesSummable a (alpha : ℂ))
    (hx : 0 < x) (halpha : 0 < alpha)
    (halphaUpper : alpha ≤ 2) (hU : 0 < U) :
    ‖dirichletPerronStarredSum a x -
      dirichletPerronIntegral a x alpha U‖ ≤
      dirichletPerronNearMass a x U +
        (32 * (x : ℝ) ^ alpha / U) *
          dirichletPerronCoefficientMass a alpha := by
  let weighted : ℕ → ℂ := fun n => if n = 0 then 0 else
    a n * (dirichletPerronNaturalWeight x n : ℂ)
  let kernel : ℕ → ℂ := fun n => if n = 0 then 0 else
    a n * dirichletPerronKernel ((x : ℝ) / n) alpha U
  let majorant : ℕ → ℝ := fun n =>
    ‖a n‖ * dirichletPerronNearError x U n +
      (32 * (x : ℝ) ^ alpha / U) *
        ‖LSeries.term a (alpha : ℂ) n‖
  have hweighted : Summable weighted := by
    refine summable_of_ne_finset_zero (s := Finset.Ico 1 (x + 1)) ?_
    intro n hn
    have hnot : ¬(1 ≤ n ∧ n < x + 1) := by
      simpa only [Finset.mem_Ico] using hn
    by_cases hnZero : n = 0
    · simp [weighted, hnZero]
    · have hnx : x < n := by omega
      simp [weighted, hnZero, dirichletPerronNaturalWeight,
        not_lt_of_ge hnx.le, ne_of_gt hnx]
  have hkernelHasSum : HasSum kernel (dirichletPerronIntegral a x alpha U) := by
    simpa only [kernel] using hasSum_perron_kernel_integrals hsum hx halpha
  have hnear := summable_perron_nearMass a x U
  have hcoefficient : Summable fun n : ℕ =>
      (32 * (x : ℝ) ^ alpha / U) *
        ‖LSeries.term a (alpha : ℂ) n‖ :=
    hsum.norm.mul_left _
  have hmajorant : Summable majorant := hnear.add hcoefficient
  have hterm : ∀ n : ℕ, ‖weighted n - kernel n‖ ≤ majorant n := by
    intro n
    dsimp [weighted, kernel, majorant]
    rcases eq_or_ne n 0 with rfl | hn
    · simp [dirichletPerronNearError]
    · have hnPos := Nat.pos_of_ne_zero hn
      simp only [ite_eq_right hn]
      have hscalar := norm_dirichletPerronKernel_sub_naturalWeight_le
        hx hnPos halpha halphaUpper hU
      have hmul := mul_le_mul_of_nonneg_left hscalar (norm_nonneg (a n))
      rw [← norm_mul, mul_sub, norm_sub_rev] at hmul
      calc
        ‖a n * (dirichletPerronNaturalWeight x n : ℂ) -
            a n * dirichletPerronKernel ((x : ℝ) / n) alpha U‖
            ≤ ‖a n‖ * (dirichletPerronNearError x U n +
                32 * (((x : ℝ) / n) ^ alpha) / U) := hmul
        _ = ‖a n‖ * dirichletPerronNearError x U n +
            (32 * (x : ℝ) ^ alpha / U) *
              ‖LSeries.term a (alpha : ℂ) n‖ := by
          rw [mul_add, ratio_mass_identity hnPos]
  have herrorNorm : Summable fun n : ℕ => ‖weighted n - kernel n‖ :=
    hmajorant.of_nonneg_of_le (fun _ => norm_nonneg _) hterm
  have hstar : ∑' n : ℕ, weighted n = dirichletPerronStarredSum a x := by
    simpa only [weighted] using tsum_naturalWeight_eq_starredSum (a := a) hx
  calc
    ‖dirichletPerronStarredSum a x -
        dirichletPerronIntegral a x alpha U‖ =
        ‖∑' n : ℕ, (weighted n - kernel n)‖ := by
      rw [← hstar, ← hkernelHasSum.tsum_eq,
        hweighted.tsum_sub hkernelHasSum.summable]
    _ ≤ ∑' n : ℕ, ‖weighted n - kernel n‖ :=
      norm_tsum_le_tsum_norm herrorNorm
    _ ≤ ∑' n : ℕ, majorant n :=
      herrorNorm.tsum_le_tsum hterm hmajorant
    _ = dirichletPerronNearMass a x U +
        (32 * (x : ℝ) ^ alpha / U) *
          dirichletPerronCoefficientMass a alpha := by
      rw [hnear.tsum_add hcoefficient, tsum_mul_left]
      rfl

end

section
open Complex

section DirichletPerronVonMangoldt

theorem sum_inv_abs_sub_lower (x : ℕ) :
    (∑ n ∈ Finset.Ico 1 x,
      |(x : ℝ) - n|⁻¹) = (harmonic (x - 1) : ℝ) := by
  calc
    (∑ n ∈ Finset.Ico 1 x, |(x : ℝ) - n|⁻¹) =
        ∑ n ∈ Finset.Ico 1 x, (((x - n : ℕ) : ℝ))⁻¹ := by
      apply Finset.sum_congr rfl
      intro n hn
      have hnx := (Finset.mem_Ico.mp hn).2.le
      have hnonneg : (0 : ℝ) ≤ (x : ℝ) - n :=
        sub_nonneg.mpr (by exact_mod_cast hnx)
      rw [abs_of_nonneg hnonneg, Nat.cast_sub hnx]
    _ = ∑ k ∈ Finset.Ico 1 x, ((k : ℝ))⁻¹ := by
      simpa using Finset.sum_Ico_reflect
        (fun k : ℕ => ((k : ℝ))⁻¹) 1 (m := x) (n := x) (Nat.le_succ x)
    _ = (harmonic (x - 1) : ℝ) := by
      by_cases hx : x = 0
      · simp [hx]
      have hxid : (x - 1) + 1 = x := by omega
      simpa [hxid] using sum_Ico_inv_eq_harmonic (x - 1)

theorem sum_inv_abs_sub_upper (x : ℕ) :
    (∑ n ∈ Finset.Ico (x + 1) (2 * x),
      |(x : ℝ) - n|⁻¹) = (harmonic (x - 1) : ℝ) := by
  by_cases hx : x = 0
  · simp [hx]
  rw [show x + 1 = 1 + x by omega, two_mul,
    ← Finset.sum_Ico_add (fun n : ℕ => |(x : ℝ) - n|⁻¹) 1 x x]
  have hxid : (x - 1) + 1 = x := Nat.sub_add_cancel (Nat.one_le_iff_ne_zero.mpr hx)
  simp [harmonic_eq_sum_Icc, ← Finset.Ico_add_one_right_eq_Icc, hxid]

theorem tsum_inv_abs_sub_ne_le
    (x : ℕ) :
    (∑' n : ℕ,
      if 0 < n ∧ (n : ℝ) < 2 * x ∧ n ≠ x then
        |(x : ℝ) - n|⁻¹ else 0) ≤
      2 * (harmonic x : ℝ) := by
  rw [tsum_eq_sum (s := Finset.Ico 1 (2 * x)) (by
    intro n hn
    have hnOut : n < 1 ∨ 2 * x ≤ n := by
      simp only [Finset.mem_Ico] at hn
      omega
    split_ifs with h
    · rcases hnOut with hnLow | hnHigh
      · omega
      · have hnHighReal : 2 * (x : ℝ) ≤ n := by
          exact_mod_cast hnHigh
        have hnot : ¬ (n : ℝ) < 2 * x := not_lt.mpr hnHighReal
        exact (hnot h.2.1).elim
    · rfl)]
  rw [← Finset.sum_filter]
  let S := (Finset.Ico 1 (2 * x)).filter fun n => n ≠ x
  have hfilter :
      (Finset.Ico 1 (2 * x)).filter
          (fun n : ℕ => 0 < n ∧ (n : ℝ) < 2 * x ∧ n ≠ x) = S := by
    ext n
    simp only [S, Finset.mem_filter, Finset.mem_Ico]
    constructor
    · intro h
      exact ⟨h.1, h.2.2.2⟩
    · intro h
      have hnPos : 0 < n := by omega
      have hnUpper : (n : ℝ) < 2 * x := by exact_mod_cast h.1.2
      exact ⟨h.1, hnPos, hnUpper, h.2⟩
  have hsplit : S = Finset.Ico 1 x ∪ Finset.Ico (x + 1) (2 * x) := by
    ext n
    simp only [S, Finset.mem_filter, Finset.mem_Ico, Finset.mem_union]
    omega
  rw [hfilter, hsplit, Finset.sum_union]
  · rw [sum_inv_abs_sub_lower, sum_inv_abs_sub_upper]
    have hmono : (harmonic (x - 1) : ℝ) ≤ (harmonic x : ℝ) := by
      by_cases hx : x = 0
      · simp [hx]
      have hxid : x = (x - 1) + 1 := by omega
      have hharmonic :
          harmonic x = harmonic (x - 1) + ((x : ℚ))⁻¹ := by
        calc
          harmonic x = harmonic ((x - 1) + 1) := congrArg harmonic hxid
          _ = harmonic (x - 1) + (((x - 1 + 1 : ℕ) : ℚ))⁻¹ :=
            harmonic_succ (x - 1)
          _ = harmonic (x - 1) + ((x : ℚ))⁻¹ := by rw [← hxid]
      rw [hharmonic, Rat.cast_add]
      exact le_add_of_nonneg_right (by positivity)
    linarith
  · simp only [Finset.disjoint_left, Finset.mem_Ico]
    omega

theorem one_le_log_natCast_of_four_le
    {x : ℕ} (hx : 4 ≤ x) :
    (1 : ℝ) ≤ Real.log x := by
  have hlogTwo : (1 / 2 : ℝ) < Real.log 2 :=
    (by norm_num : (1 / 2 : ℝ) < 0.6931471803).trans
      Real.log_two_gt_d9
  calc
    (1 : ℝ) ≤ 2 * Real.log 2 := by linarith
    _ = Real.log 4 := Real.log_four_eq.symm
    _ ≤ Real.log (x : ℝ) := by
      exact Real.log_le_log (by norm_num) (by exact_mod_cast hx)

theorem summable_dirichletPerronNearMass
    (a : ℕ → ℂ) (x : ℕ) (U : ℝ) :
    Summable fun n : ℕ => ‖a n‖ * dirichletPerronNearError x U n :=
  summable_perron_nearMass a x U

theorem summable_inv_abs_sub_ne (x : ℕ) :
    Summable fun n : ℕ =>
      if 0 < n ∧ (n : ℝ) < 2 * x ∧ n ≠ x then
        |(x : ℝ) - n|⁻¹ else 0 := by
  refine summable_of_ne_finset_zero (s := Finset.Ico 1 (2 * x)) ?_
  intro n hn
  rw [ite_eq_right]
  intro h
  apply hn
  exact Finset.mem_Ico.mpr ⟨h.1, by exact_mod_cast h.2.1⟩

theorem dirichletPerronCoefficientMass_twist_vonMangoldt_le
    {q : ℕ} (chi : DirichletCharacter ℂ q)
    {sigma : ℝ} (hsigma : 1 < sigma) :
    dirichletPerronCoefficientMass
        ((fun n : ℕ => chi n) *
          fun n => (ArithmeticFunction.vonMangoldt n : ℂ)) sigma ≤
      ∑' n : ℕ,
        ArithmeticFunction.vonMangoldt n / (n : ℝ) ^ sigma := by
  let f : ℕ → ℂ :=
    (fun n : ℕ => chi n) *
      fun n => (ArithmeticFunction.vonMangoldt n : ℂ)
  let g : ℕ → ℂ :=
    fun n => (ArithmeticFunction.vonMangoldt n : ℂ)
  have hf : LSeriesSummable f (sigma : ℂ) := by
    simpa [f] using
      DirichletCharacter.LSeriesSummable_twist_vonMangoldt chi hsigma
  have hg : LSeriesSummable g (sigma : ℂ) := by
    simpa [g] using
      ArithmeticFunction.LSeriesSummable_vonMangoldt hsigma
  have hcoeff (n : ℕ) : ‖f n‖ ≤ ‖g n‖ := by
    simp only [f, g, Pi.mul_apply, norm_mul]
    exact (mul_le_mul_of_nonneg_right
      (chi.norm_le_one (n : ZMod q)) (norm_nonneg _)).trans_eq
        (one_mul _)
  have hterm (n : ℕ) :
      ‖LSeries.term f (sigma : ℂ) n‖ ≤
        ArithmeticFunction.vonMangoldt n / (n : ℝ) ^ sigma := by
    calc
      ‖LSeries.term f (sigma : ℂ) n‖ ≤
          ‖LSeries.term g (sigma : ℂ) n‖ :=
        LSeries.norm_term_le _ (hcoeff n)
      _ = ArithmeticFunction.vonMangoldt n / (n : ℝ) ^ sigma := by
        rw [LSeries.norm_term_eq]
        by_cases hn : n = 0
        · simp [hn]
        · simp only [hn, ite_false, g, Complex.ofReal_re]
          rw [Complex.norm_of_nonneg
            ArithmeticFunction.vonMangoldt_nonneg]
  have hpositive : Summable fun n : ℕ =>
      ArithmeticFunction.vonMangoldt n / (n : ℝ) ^ sigma := by
    exact hg.norm.congr fun n => by
      symm
      rw [LSeries.norm_term_eq]
      by_cases hn : n = 0
      · simp [hn]
      · simp only [hn, ite_false, g, Complex.ofReal_re]
        rw [Complex.norm_of_nonneg ArithmeticFunction.vonMangoldt_nonneg]
  exact hf.norm.tsum_le_tsum hterm hpositive

end DirichletPerronVonMangoldt

theorem dirichletPerronNearMass_twist_vonMangoldt_le
    {q : ℕ} (chi : DirichletCharacter ℂ q)
    {x : ℕ} {U : ℝ} (hx : 4 ≤ x) (hU : 0 < U) :
    dirichletPerronNearMass
        ((fun n : ℕ => chi n) *
          fun n => (ArithmeticFunction.vonMangoldt n : ℂ)) x U ≤
      32 * (x : ℝ) * Real.log x ^ 2 / U := by
  let a : ℕ → ℂ :=
    (fun n : ℕ => chi n) *
      fun n => (ArithmeticFunction.vonMangoldt n : ℂ)
  let r : ℕ → ℝ := fun n =>
    if 0 < n ∧ (n : ℝ) < 2 * x ∧ n ≠ x then
      |(x : ℝ) - n|⁻¹ else 0
  let K : ℝ := 4 * (x : ℝ) * Real.log x / U
  have hxPos : 0 < x := by omega
  have hxReal : (0 : ℝ) < x := by exact_mod_cast hxPos
  have hlogOne := one_le_log_natCast_of_four_le hx
  have hK : 0 ≤ K := by
    dsimp [K]
    positivity
  have hpoint (n : ℕ) :
      ‖a n‖ * dirichletPerronNearError x U n ≤ K * r n := by
    rw [dirichletPerronNearError]
    split_ifs with hn
    · have hnPosReal : (0 : ℝ) < n := by exact_mod_cast hn.1
      have hnUpper : (n : ℝ) ≤ 2 * x := hn.2.2.1.le
      have hlogn : Real.log n ≤ Real.log (2 * (x : ℝ)) :=
        Real.log_le_log hnPosReal hnUpper
      have hlogTwoLe : Real.log 2 ≤ Real.log (x : ℝ) :=
        Real.log_le_log (by norm_num) (by exact_mod_cast (show 2 ≤ x by omega))
      have hlogTwoX : Real.log (2 * (x : ℝ)) ≤
          2 * Real.log x := by
        rw [Real.log_mul (by norm_num) hxReal.ne']
        linarith
      have hcoeff : ‖a n‖ ≤ 2 * Real.log x := by
        calc
          ‖a n‖ = ‖chi n‖ * ArithmeticFunction.vonMangoldt n := by
            simp only [a, Pi.mul_apply, norm_mul]
            rw [Complex.norm_of_nonneg
              ArithmeticFunction.vonMangoldt_nonneg]
          _ ≤ ArithmeticFunction.vonMangoldt n := by
            simpa using mul_le_mul_of_nonneg_right
              (chi.norm_le_one (n : ZMod q))
              ArithmeticFunction.vonMangoldt_nonneg
          _ ≤ Real.log n := ArithmeticFunction.vonMangoldt_le_log
          _ ≤ Real.log (2 * (x : ℝ)) := hlogn
          _ ≤ 2 * Real.log x := hlogTwoX
      have hcastNe : (x : ℝ) ≠ (n : ℝ) := by
        exact_mod_cast hn.2.2.2.symm
      have habs : 0 < |(x : ℝ) - n| :=
        abs_pos.mpr (sub_ne_zero.mpr hcastNe)
      have hnearNonneg :
          0 ≤ min 1 (2 * (x : ℝ) /
            (U * |(x : ℝ) - n|)) := by
        exact le_min (by norm_num)
          (div_nonneg (by positivity) (mul_nonneg hU.le habs.le))
      have hnear :
          min 1 (2 * (x : ℝ) /
              (U * |(x : ℝ) - n|)) ≤
            2 * (x : ℝ) / (U * |(x : ℝ) - n|) :=
        min_le_right _ _
      have hr : r n = |(x : ℝ) - n|⁻¹ := by
        dsimp [r]
        rw [ite_eq_left ⟨hn.1, hn.2.2.1, hn.2.2.2⟩]
      rw [hr]
      calc
        ‖a n‖ * min 1 (2 * (x : ℝ) /
            (U * |(x : ℝ) - n|)) ≤
            (2 * Real.log x) * min 1 (2 * (x : ℝ) /
              (U * |(x : ℝ) - n|)) :=
          mul_le_mul_of_nonneg_right hcoeff hnearNonneg
        _ ≤ (2 * Real.log x) *
            (2 * (x : ℝ) / (U * |(x : ℝ) - n|)) :=
          mul_le_mul_of_nonneg_left hnear (by positivity)
        _ = K * |(x : ℝ) - n|⁻¹ := by
          dsimp [K]
          field_simp [hU.ne', habs.ne']
          ring
    · simp only [mul_zero]
      exact mul_nonneg hK (by
        dsimp [r]
        split_ifs
        · positivity
        · rfl)
  have hleft := summable_dirichletPerronNearMass a x U
  have hright : Summable fun n : ℕ => K * r n :=
    (summable_inv_abs_sub_ne x).mul_left K
  have hrBound : (∑' n : ℕ, r n) ≤ 2 * (harmonic x : ℝ) := by
    simpa [r] using tsum_inv_abs_sub_ne_le x
  have hHarmonic : (harmonic x : ℝ) ≤ 2 * Real.log x := by
    have hraw : (harmonic x : ℝ) ≤ 1 + Real.log x :=
      harmonic_le_one_add_log x
    linarith
  change (∑' n : ℕ, ‖a n‖ * dirichletPerronNearError x U n) ≤ _
  calc
    (∑' n : ℕ, ‖a n‖ * dirichletPerronNearError x U n) ≤
        ∑' n : ℕ, K * r n :=
      hleft.tsum_le_tsum hpoint hright
    _ = K * ∑' n : ℕ, r n := tsum_mul_left
    _ ≤ K * (2 * (harmonic x : ℝ)) :=
      mul_le_mul_of_nonneg_left hrBound hK
    _ ≤ K * (4 * Real.log x) := by
      apply mul_le_mul_of_nonneg_left _ hK
      linarith
    _ = 16 * (x : ℝ) * Real.log x ^ 2 / U := by
      dsimp [K]
      ring
    _ ≤ 32 * (x : ℝ) * Real.log x ^ 2 / U := by
      have hbase : 0 ≤ (x : ℝ) * Real.log x ^ 2 / U := by positivity
      calc
        16 * (x : ℝ) * Real.log x ^ 2 / U =
            16 * ((x : ℝ) * Real.log x ^ 2 / U) := by ring
        _ ≤ 32 * ((x : ℝ) * Real.log x ^ 2 / U) :=
          mul_le_mul_of_nonneg_right (by norm_num) hbase
        _ = 32 * (x : ℝ) * Real.log x ^ 2 / U := by ring

theorem
    exists_nat_dirichletPerronCoefficientMass_twist_vonMangoldt_le :
    ∃ B : ℕ, 1 ≤ B ∧
      ∀ {q : ℕ} (chi : DirichletCharacter ℂ q)
        {x : ℕ}, 4 ≤ x →
          dirichletPerronCoefficientMass
              ((fun n : ℕ => chi n) *
                fun n => (ArithmeticFunction.vonMangoldt n : ℂ))
              (1 + 1 / Real.log x) ≤
            B * Real.log x := by
  rcases exists_pos_vonMangoldt_tsum_lt_inv_sub_one_add with
    ⟨C, hC, hsource⟩
  let B : ℕ := ⌈C⌉₊ + 2
  refine ⟨B, by simp [B], ?_⟩
  intro q chi x hx
  have hxPos : 0 < x := by omega
  have hxReal : (0 : ℝ) < x := by exact_mod_cast hxPos
  have hlogTwo : (1 / 2 : ℝ) < Real.log 2 :=
    (by norm_num : (1 / 2 : ℝ) < 0.6931471803).trans
      Real.log_two_gt_d9
  have hlogStrict : (1 : ℝ) < Real.log x := by
    calc
      (1 : ℝ) < 2 * Real.log 2 := by linarith
      _ = Real.log 4 := Real.log_four_eq.symm
      _ ≤ Real.log (x : ℝ) :=
        Real.log_le_log (by norm_num) (by exact_mod_cast hx)
  let sigma : ℝ := 1 + 1 / Real.log x
  have hsigmaOne : 1 < sigma := by
    dsimp [sigma]
    have : 0 < 1 / Real.log x := by positivity
    linarith
  have hsigmaTwo : sigma < 2 := by
    have hinv : 1 / Real.log x < 1 :=
      (div_lt_one (by linarith : 0 < Real.log x)).2 hlogStrict
    dsimp [sigma]
    linarith
  have hmass :=
    dirichletPerronCoefficientMass_twist_vonMangoldt_le chi hsigmaOne
  have hraw := hsource sigma hsigmaOne hsigmaTwo
  have hinverse : (sigma - 1)⁻¹ = Real.log x := by
    dsimp [sigma]
    field_simp [ne_of_gt (show 0 < Real.log x by linarith)]
    ring
  rw [hinverse] at hraw
  have hceil : C ≤ (⌈C⌉₊ : ℝ) := Nat.le_ceil C
  have hlogOne : (1 : ℝ) ≤ Real.log x := hlogStrict.le
  have hprod :
      0 ≤ ((⌈C⌉₊ : ℝ) + 1) * (Real.log x - 1) :=
    mul_nonneg (by positivity) (sub_nonneg.mpr hlogOne)
  change dirichletPerronCoefficientMass
      ((fun n : ℕ => chi n) *
        fun n => (ArithmeticFunction.vonMangoldt n : ℂ)) sigma ≤ _
  calc
    dirichletPerronCoefficientMass
        ((fun n : ℕ => chi n) *
          fun n => (ArithmeticFunction.vonMangoldt n : ℂ)) sigma ≤
        ∑' n : ℕ,
          ArithmeticFunction.vonMangoldt n / (n : ℝ) ^ sigma := hmass
    _ ≤ Real.log x + C := hraw.le
    _ ≤ (B : ℝ) * Real.log x := by
      dsimp [B]
      push_cast
      nlinarith

end

section
open Complex Set
open scoped Interval

section DirichletModifiedPerron
/--
The von Mangoldt sequence twisted by the Dirichlet character: `chi n * vonMangoldt n`, with the
real von Mangoldt value coerced to `ℂ`.
-/
noncomputable def twistVonMangoldt
    {q : ℕ} (chi : DirichletCharacter ℂ q) : ℕ → ℂ :=
  (fun n : ℕ => chi n) *
    fun n => (ArithmeticFunction.vonMangoldt n : ℂ)

theorem one_lt_perronAbscissa {x : ℝ} (hx : 1 < x) :
    1 < 1 + 1 / Real.log x := by
  have hlog : 0 < Real.log x := Real.log_pos hx
  have : 0 < 1 / Real.log x := by positivity
  linarith

theorem dirichletPerronStarredSum_twistVonMangoldt_eq
    {q x : ℕ} (chi : DirichletCharacter ℂ q) (hx : 0 < x) :
    twistedChebyshevSum x q chi =
      dirichletPerronStarredSum (twistVonMangoldt chi) x +
        (1 / 2 : ℂ) * twistVonMangoldt chi x := by
  rw [twistedChebyshevSum, dirichletPerronStarredSum]
  rw [← Finset.Ico_add_one_right_eq_Icc]
  rw [Finset.sum_Ico_succ_top (Nat.one_le_iff_ne_zero.mpr hx.ne')]
  simp only [twistVonMangoldt, Pi.mul_apply]
  ring

@[simp]
theorem dirichletPerronStarredSum_twistVonMangoldt_one
    {q : ℕ} (chi : DirichletCharacter ℂ q) :
    dirichletPerronStarredSum (twistVonMangoldt chi) 1 = 0 := by
  simp [dirichletPerronStarredSum, twistVonMangoldt,
    ArithmeticFunction.vonMangoldt_apply_one]

@[simp]
theorem dirichletPerronNearMass_twistVonMangoldt_one
    {q : ℕ} (chi : DirichletCharacter ℂ q) (U : ℝ) :
    dirichletPerronNearMass (twistVonMangoldt chi) 1 U = 0 := by
  calc
    _ = ∑' _ : ℕ, (0 : ℝ) := tsum_congr fun n => by
      rw [dirichletPerronNearError]
      split_ifs with h
      · norm_num at h
        have hn : n ≤ 1 := by exact_mod_cast h.2.2.1
        omega
      · simp
    _ = 0 := tsum_zero

theorem rpow_perronAbscissa_le_three_mul
    {x : ℝ} (hx : 1 < x) :
    x ^ (1 + 1 / Real.log x) ≤ 3 * x := by
  have hxPos : 0 < x := zero_lt_one.trans hx
  have hxNe : x ≠ 1 := hx.ne'
  rw [Real.rpow_add hxPos, Real.rpow_one, one_div,
    Real.rpow_inv_log hxPos hxNe]
  nlinarith [Real.exp_one_lt_three]

theorem norm_half_twistVonMangoldt_le_log
    {q x : ℕ} (chi : DirichletCharacter ℂ q) :
    ‖(1 / 2 : ℂ) * twistVonMangoldt chi x‖ ≤ Real.log x := by
  have hcoeff : ‖twistVonMangoldt chi x‖ ≤
      ArithmeticFunction.vonMangoldt x := by
    simp only [twistVonMangoldt, Pi.mul_apply, norm_mul]
    rw [Complex.norm_of_nonneg ArithmeticFunction.vonMangoldt_nonneg]
    simpa using mul_le_mul_of_nonneg_right
      (chi.norm_le_one (x : ZMod q))
      ArithmeticFunction.vonMangoldt_nonneg
  calc
    ‖(1 / 2 : ℂ) * twistVonMangoldt chi x‖ =
        (1 / 2 : ℝ) * ‖twistVonMangoldt chi x‖ := by
      rw [norm_mul, norm_div, norm_one]
      norm_num
    _ ≤ ArithmeticFunction.vonMangoldt x := by
      have hv : 0 ≤ ArithmeticFunction.vonMangoldt x :=
        ArithmeticFunction.vonMangoldt_nonneg
      calc
        (1 / 2 : ℝ) * ‖twistVonMangoldt chi x‖ ≤
            (1 / 2 : ℝ) * ArithmeticFunction.vonMangoldt x :=
          mul_le_mul_of_nonneg_left hcoeff (by norm_num)
        _ ≤ ArithmeticFunction.vonMangoldt x := by nlinarith
    _ ≤ Real.log x := ArithmeticFunction.vonMangoldt_le_log

end DirichletModifiedPerron

theorem
    dirichletExplicitFormulaNormalizedRightEdge_eq_rawPerron_sub_baseOne
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    {x U : ℝ} (hx : 1 < x) :
    dirichletExplicitFormulaNormalizedRightEdge chi x U =
      dirichletPerronIntegral
          ((fun n : ℕ => chi n) *
            fun n => (ArithmeticFunction.vonMangoldt n : ℂ))
          x (1 + 1 / Real.log x) U -
        dirichletPerronIntegral
          ((fun n : ℕ => chi n) *
            fun n => (ArithmeticFunction.vonMangoldt n : ℂ))
          1 (1 + 1 / Real.log x) U := by
  let alpha : ℝ := 1 + 1 / Real.log x
  let a : ℕ → ℂ := twistVonMangoldt chi
  have hxPos : 0 < x := zero_lt_one.trans hx
  have halphaOne : 1 < alpha := one_lt_perronAbscissa hx
  have halpha : 0 < alpha := zero_lt_one.trans halphaOne
  have hsum : LSeriesSummable a (alpha : ℂ) := by
    simpa [a, twistVonMangoldt] using
      DirichletCharacter.LSeriesSummable_twist_vonMangoldt chi halphaOne
  have hpoint (t : ℝ) :
      dirichletExplicitFormulaIntegrand chi x
          ((alpha : ℂ) + t * I) =
        LSeries a ((alpha : ℂ) + t * I) *
            (x : ℂ) ^ ((alpha : ℂ) + t * I) /
              ((alpha : ℂ) + t * I) -
          LSeries a ((alpha : ℂ) + t * I) *
            (1 : ℂ) ^ ((alpha : ℂ) + t * I) /
              ((alpha : ℂ) + t * I) := by
    let s : ℂ := (alpha : ℂ) + t * I
    have hsRe : s.re = alpha := by simp [s]
    have hs : 1 < s.re := by simpa [hsRe] using halphaOne
    have hsNe : s ≠ 0 := by
      intro hsZero
      have hre := congrArg Complex.re hsZero
      simp [s] at hre
      linarith
    have hlogDeriv :
        -logDeriv (DirichletCharacter.LFunction chi) s = LSeries a s := by
      rw [neg_logDeriv_LFunction_eq_LSeries chi hs,
        logDeriv_apply, ← neg_div,
        ← DirichletCharacter.LSeries_twist_vonMangoldt_eq chi hs]
      rfl
    rw [dirichletExplicitFormulaIntegrand, hlogDeriv,
      dirichletExplicitFormulaKernel_eq_cpow_sub_one_div hxPos hsNe]
    dsimp [a, s]
    simp only [one_cpow]
    ring
  have hxInt := intervalIntegrable_dirichletPerronLSeriesIntegrand
    (U := U) hsum hxPos halpha
  have hOneInt := intervalIntegrable_dirichletPerronLSeriesIntegrand
    (U := U) hsum (by norm_num : (0 : ℝ) < 1) halpha
  have hOneInt' : IntervalIntegrable
      (fun t : ℝ =>
        LSeries a ((alpha : ℂ) + t * I) *
          (1 : ℂ) ^ ((alpha : ℂ) + t * I) /
            ((alpha : ℂ) + t * I)) volume (-U) U := by
    simpa using hOneInt
  have hintegral :
      (∫ t in -U..U,
        dirichletExplicitFormulaIntegrand chi x
          ((alpha : ℂ) + t * I)) =
        (∫ t in -U..U,
          LSeries a ((alpha : ℂ) + t * I) *
            (x : ℂ) ^ ((alpha : ℂ) + t * I) /
              ((alpha : ℂ) + t * I)) -
        ∫ t in -U..U,
          LSeries a ((alpha : ℂ) + t * I) *
            (1 : ℂ) ^ ((alpha : ℂ) + t * I) /
              ((alpha : ℂ) + t * I) := by
    rw [← intervalIntegral.integral_sub hxInt hOneInt']
    exact intervalIntegral.integral_congr fun t _ => hpoint t
  rw [dirichletExplicitFormulaNormalizedRightEdge,
    dirichletPerronIntegral, dirichletPerronIntegral]
  change (((2 * Real.pi : ℝ) : ℂ)⁻¹) *
        (∫ t in -U..U,
          dirichletExplicitFormulaIntegrand chi x
            ((alpha : ℂ) + t * I)) =
      (((2 * Real.pi : ℝ) : ℂ)⁻¹) *
          (∫ t in -U..U,
            LSeries a ((alpha : ℂ) + t * I) *
              (x : ℂ) ^ ((alpha : ℂ) + t * I) /
                ((alpha : ℂ) + t * I)) -
        (((2 * Real.pi : ℝ) : ℂ)⁻¹) *
          (∫ t in -U..U,
            LSeries a ((alpha : ℂ) + t * I) *
              (1 : ℂ) ^ ((alpha : ℂ) + t * I) /
                ((alpha : ℂ) + t * I))
  rw [hintegral]
  ring

theorem
    exists_nat_norm_twistedChebyshevSum_sub_dirichletExplicitFormulaNormalizedRightEdge_le_raw :
    ∃ P : ℕ, 1 ≤ P ∧
      ∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q)
        (x : ℕ) (U : ℝ),
          4 ≤ x → 2 ≤ U →
            ‖twistedChebyshevSum x q chi -
              dirichletExplicitFormulaNormalizedRightEdge chi x U‖ ≤
              P * ((x : ℝ) * Real.log x ^ 2 / U + Real.log x) := by
  rcases exists_nat_dirichletPerronCoefficientMass_twist_vonMangoldt_le with
    ⟨B, hB, hmass⟩
  let P : ℕ := 128 * (B + 1)
  refine ⟨P, by dsimp [P]; omega, ?_⟩
  intro q _ chi x U hx hU
  let a : ℕ → ℂ := twistVonMangoldt chi
  let alpha : ℝ := 1 + 1 / Real.log x
  let A : ℝ := (x : ℝ) * Real.log x ^ 2 / U
  let L : ℝ := Real.log x
  have hxPos : 0 < x := by omega
  have hxReal : (0 : ℝ) < x := by exact_mod_cast hxPos
  have hxOne : (1 : ℝ) < x := by exact_mod_cast (show 1 < x by omega)
  have hlogOne : (1 : ℝ) ≤ L := by
    dsimp [L]
    have hlogTwo : (1 / 2 : ℝ) < Real.log 2 :=
      (by norm_num : (1 / 2 : ℝ) < 0.6931471803).trans
        Real.log_two_gt_d9
    calc
      (1 : ℝ) ≤ 2 * Real.log 2 := by linarith
      _ = Real.log 4 := Real.log_four_eq.symm
      _ ≤ Real.log (x : ℝ) :=
        Real.log_le_log (by norm_num) (by exact_mod_cast hx)
  have hlogPos : 0 < L := zero_lt_one.trans_le hlogOne
  have halphaOne : 1 < alpha := by
    dsimp [alpha, L] at *
    have : 0 < 1 / Real.log x := by positivity
    linarith
  have halpha : 0 < alpha := zero_lt_one.trans halphaOne
  have halphaTwo : alpha ≤ 2 := by
    dsimp [alpha, L] at *
    have hinv : 1 / Real.log x ≤ 1 :=
      (div_le_one hlogPos).2 hlogOne
    linarith
  have hUPos : 0 < U := zero_lt_two.trans_le hU
  have hsum : LSeriesSummable a (alpha : ℂ) := by
    simpa [a, twistVonMangoldt] using
      DirichletCharacter.LSeriesSummable_twist_vonMangoldt chi halphaOne
  have hmassBound : dirichletPerronCoefficientMass a alpha ≤ B * L := by
    simpa [a, alpha, L, twistVonMangoldt] using hmass chi hx
  have hmassNonneg : 0 ≤ dirichletPerronCoefficientMass a alpha :=
    tsum_nonneg fun _ => norm_nonneg _
  have hnearBound : dirichletPerronNearMass a x U ≤ 32 * A := by
    have hnear :=
      dirichletPerronNearMass_twist_vonMangoldt_le chi hx hUPos
    change dirichletPerronNearMass a x U ≤ 32 * A
    calc
      dirichletPerronNearMass a x U ≤
          32 * (x : ℝ) * Real.log x ^ 2 / U := by
        simpa [a, twistVonMangoldt] using hnear
      _ = 32 * A := by dsimp [A]; ring
  have hxPerron := norm_dirichletPerronStarredSum_sub_integral_le
    hsum hxPos halpha halphaTwo hUPos
  have hxPow : (x : ℝ) ^ alpha ≤ 3 * x := by
    simpa [alpha] using rpow_perronAbscissa_le_three_mul hxOne
  have hfactor : 32 * (x : ℝ) ^ alpha / U ≤ 96 * x / U := by
    exact div_le_div_of_nonneg_right
      (by nlinarith [hxPow]) hUPos.le
  have hLsq : L ≤ L ^ 2 := by nlinarith
  have hmassTerm :
      (32 * (x : ℝ) ^ alpha / U) *
          dirichletPerronCoefficientMass a alpha ≤
        96 * B * A := by
    calc
      (32 * (x : ℝ) ^ alpha / U) *
          dirichletPerronCoefficientMass a alpha ≤
          (96 * (x : ℝ) / U) * (B * L) :=
        mul_le_mul hfactor hmassBound hmassNonneg (by positivity)
      _ = 96 * B * ((x : ℝ) * L / U) := by ring
      _ ≤ 96 * B * ((x : ℝ) * L ^ 2 / U) := by
        apply mul_le_mul_of_nonneg_left _ (by positivity)
        exact div_le_div_of_nonneg_right
          (mul_le_mul_of_nonneg_left hLsq hxReal.le) hUPos.le
      _ = 96 * B * A := by rfl
  have hxError :
      ‖dirichletPerronStarredSum a x -
          dirichletPerronIntegral a x alpha U‖ ≤
        (32 + 96 * B) * A := by
    exact hxPerron.trans <| calc
      dirichletPerronNearMass a x U +
          (32 * (x : ℝ) ^ alpha / U) *
            dirichletPerronCoefficientMass a alpha ≤
          32 * A + 96 * B * A := add_le_add hnearBound hmassTerm
      _ = (32 + 96 * B) * A := by ring
  have hbasePerron := norm_dirichletPerronStarredSum_sub_integral_le
    (x := 1) hsum one_pos halpha halphaTwo hUPos
  have hbaseError :
      ‖dirichletPerronIntegral a 1 alpha U‖ ≤ 16 * B * L := by
    have hfactorOne : (32 : ℝ) / U ≤ 16 := by
      rw [div_le_iff₀ hUPos]
      nlinarith
    have hraw :
        ‖dirichletPerronIntegral a 1 alpha U‖ ≤
          (32 / U) * dirichletPerronCoefficientMass a alpha := by
      simpa [a, Real.one_rpow] using hbasePerron
    exact hraw.trans <| calc
      (32 / U) * dirichletPerronCoefficientMass a alpha ≤
          16 * (B * L) :=
        mul_le_mul hfactorOne hmassBound hmassNonneg (by norm_num)
      _ = 16 * B * L := by ring
  have hstar := dirichletPerronStarredSum_twistVonMangoldt_eq chi hxPos
  have hright :=
    dirichletExplicitFormulaNormalizedRightEdge_eq_rawPerron_sub_baseOne
      (U := U) chi hxOne
  have hendpoint := norm_half_twistVonMangoldt_le_log (x := x) chi
  have hdecomp :
      twistedChebyshevSum x q chi -
          dirichletExplicitFormulaNormalizedRightEdge chi x U =
        (1 / 2 : ℂ) * a x +
          (dirichletPerronStarredSum a x -
            dirichletPerronIntegral a x alpha U) +
          dirichletPerronIntegral a 1 alpha U := by
    rw [hright, hstar]
    dsimp [a, alpha, twistVonMangoldt]
    ring
  have hA : 0 ≤ A := by dsimp [A, L]; positivity
  have hcoeffA : (32 : ℝ) + 96 * B ≤ P := by
    dsimp [P]
    push_cast
    nlinarith [show (1 : ℝ) ≤ B by exact_mod_cast hB]
  have hcoeffL : (1 : ℝ) + 16 * B ≤ P := by
    dsimp [P]
    push_cast
    nlinarith [show (1 : ℝ) ≤ B by exact_mod_cast hB]
  rw [hdecomp]
  calc
    ‖(1 / 2 : ℂ) * a x +
        (dirichletPerronStarredSum a x -
          dirichletPerronIntegral a x alpha U) +
        dirichletPerronIntegral a 1 alpha U‖ ≤
      ‖(1 / 2 : ℂ) * a x‖ +
        ‖dirichletPerronStarredSum a x -
          dirichletPerronIntegral a x alpha U‖ +
        ‖dirichletPerronIntegral a 1 alpha U‖ :=
      (norm_add_le _ _).trans
        (add_le_add (norm_add_le _ _) (le_refl _))
    _ ≤ L + (32 + 96 * B) * A + 16 * B * L :=
      add_le_add (add_le_add (by simpa [a, L] using hendpoint) hxError)
        hbaseError
    _ = (32 + 96 * B) * A + (1 + 16 * B) * L := by ring
    _ ≤ P * A + P * L :=
      add_le_add (mul_le_mul_of_nonneg_right hcoeffA hA)
        (mul_le_mul_of_nonneg_right hcoeffL hlogPos.le)
    _ = (P : ℝ) *
        ((x : ℝ) * Real.log x ^ 2 / U + Real.log x) := by
      dsimp [A, L]
      ring

theorem
    exists_nat_norm_twistedChebyshevSum_sub_dirichletExplicitFormulaNormalizedRightEdge_le :
    ∃ P : ℕ, 1 ≤ P ∧
      ∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q)
        (x : ℕ) (T U : ℝ),
          4 ≤ x → 2 ≤ T → T ≤ x → U ∈ Set.Icc T (T + 1) →
            ‖twistedChebyshevSum x q chi -
              dirichletExplicitFormulaNormalizedRightEdge chi x U‖ ≤
              P * dirichletExplicitFormulaErrorScale x q T := by
  rcases
      exists_nat_norm_twistedChebyshevSum_sub_dirichletExplicitFormulaNormalizedRightEdge_le_raw
    with ⟨P, hP, hraw⟩
  refine ⟨2 * P, by omega, ?_⟩
  intro q _ chi x T U hx hT hTx hU
  have hUtwo : 2 ≤ U := hT.trans hU.1
  have hrawBound := hraw q chi x U hx hUtwo
  have hxPos : (0 : ℝ) < x := by exact_mod_cast (show 0 < x by omega)
  have hTPos : 0 < T := zero_lt_two.trans_le hT
  have hUPos : 0 < U := hTPos.trans_le hU.1
  have hqOne : (1 : ℝ) ≤ q := by
    exact_mod_cast Nat.one_le_iff_ne_zero.mpr (NeZero.ne q)
  have hxProduct : (x : ℝ) ≤ (x : ℝ) * q := by
    simpa using mul_le_mul_of_nonneg_left hqOne hxPos.le
  have hlog : Real.log x ≤ Real.log ((x : ℝ) * q) :=
    Real.log_le_log hxPos hxProduct
  have hlogOne : (1 : ℝ) ≤ Real.log x := by
    have hlogTwo : (1 / 2 : ℝ) < Real.log 2 :=
      (by norm_num : (1 / 2 : ℝ) < 0.6931471803).trans
        Real.log_two_gt_d9
    calc
      (1 : ℝ) ≤ 2 * Real.log 2 := by linarith
      _ = Real.log 4 := Real.log_four_eq.symm
      _ ≤ Real.log (x : ℝ) :=
        Real.log_le_log (by norm_num) (by exact_mod_cast hx)
  have hlogProductOne :
      (1 : ℝ) ≤ Real.log ((x : ℝ) * q) := hlogOne.trans hlog
  have hlogSq : Real.log x ^ 2 ≤
      Real.log ((x : ℝ) * q) ^ 2 := by
    nlinarith
  let E : ℝ := dirichletExplicitFormulaErrorScale x q T
  have hE : 0 ≤ E := by
    dsimp [E, dirichletExplicitFormulaErrorScale]
    positivity
  have hreciprocal :
      (x : ℝ) * Real.log x ^ 2 / U ≤ E := by
    calc
      (x : ℝ) * Real.log x ^ 2 / U ≤
          (x : ℝ) * Real.log x ^ 2 / T :=
        div_le_div_of_nonneg_left (by positivity) hTPos hU.1
      _ ≤ (x : ℝ) * Real.log ((x : ℝ) * q) ^ 2 / T :=
        div_le_div_of_nonneg_right
          (mul_le_mul_of_nonneg_left hlogSq hxPos.le) hTPos.le
      _ = E := by rfl
  have hstandalone : Real.log x ≤ E := by
    have hxT : (1 : ℝ) ≤ (x : ℝ) / T :=
      (le_div_iff₀ hTPos).2 (by simpa using hTx)
    have hlogLeSquare : Real.log x ≤
        Real.log ((x : ℝ) * q) ^ 2 := by
      nlinarith
    calc
      Real.log x ≤ Real.log ((x : ℝ) * q) ^ 2 := hlogLeSquare
      _ = 1 * Real.log ((x : ℝ) * q) ^ 2 := by ring
      _ ≤ ((x : ℝ) / T) *
          Real.log ((x : ℝ) * q) ^ 2 :=
        mul_le_mul_of_nonneg_right hxT (sq_nonneg _)
      _ = E := by
        dsimp [E, dirichletExplicitFormulaErrorScale]
        ring
  exact hrawBound.trans <| calc
    (P : ℝ) *
        ((x : ℝ) * Real.log x ^ 2 / U + Real.log x) ≤
        (P : ℝ) * (E + E) :=
      mul_le_mul_of_nonneg_left (add_le_add hreciprocal hstandalone)
        (by positivity)
    _ = ((2 * P : ℕ) : ℝ) * E := by
      push_cast
      ring

end

section
open Complex Set

theorem
  exists_nat_norm_twistedChebyshevSum_sub_dirichletExplicitFormulaMainZeroTerms_le_of_isPrimitive :
    ∃ K : ℕ, 1 ≤ K ∧
      ∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q), chi.IsPrimitive →
          ∀ T : ℝ, 2 ≤ T →
            ∀ x : ℕ, 4 ≤ x → T ≤ (x : ℝ) →
              ‖twistedChebyshevSum x q chi -
                  dirichletExplicitFormulaMainZeroTerms chi (x : ℝ) T‖ ≤
                (K : ℝ) *
                  dirichletExplicitFormulaErrorScale (x : ℝ) q T := by
  obtain ⟨A, hA, C, hC, hcontour⟩ :=
    exists_nat_norm_dirichletExplicitFormulaNormalizedRightEdge_sub_mainZeroTerms_le
  obtain ⟨P, hP, hperron⟩ :=
    exists_nat_norm_twistedChebyshevSum_sub_dirichletExplicitFormulaNormalizedRightEdge_le
  let K : ℕ := P + 1700 * A * C
  refine ⟨K, by dsimp [K]; omega, ?_⟩
  intro q _ chi hchi T hT
  obtain ⟨U, hU, _, hcontourU⟩ := hcontour q chi hchi T hT
  intro x hx hTx
  have hperronU := hperron q chi x T U hx hT hTx hU
  have hcontourX := hcontourU (x : ℝ) hTx
  let E : ℝ := dirichletExplicitFormulaErrorScale (x : ℝ) q T
  calc
    ‖twistedChebyshevSum x q chi -
          dirichletExplicitFormulaMainZeroTerms chi (x : ℝ) T‖ =
        ‖(twistedChebyshevSum x q chi -
            dirichletExplicitFormulaNormalizedRightEdge chi (x : ℝ) U) +
          (dirichletExplicitFormulaNormalizedRightEdge chi (x : ℝ) U -
            dirichletExplicitFormulaMainZeroTerms chi (x : ℝ) T)‖ := by
      congr 1
      ring
    _ ≤ ‖twistedChebyshevSum x q chi -
            dirichletExplicitFormulaNormalizedRightEdge chi (x : ℝ) U‖ +
          ‖dirichletExplicitFormulaNormalizedRightEdge chi (x : ℝ) U -
            dirichletExplicitFormulaMainZeroTerms chi (x : ℝ) T‖ :=
      norm_add_le _ _
    _ ≤ (P : ℝ) * E + 1700 * (A : ℝ) * C * E :=
      add_le_add hperronU hcontourX
    _ = (K : ℝ) *
        dirichletExplicitFormulaErrorScale (x : ℝ) q T := by
      dsimp [K, E]
      push_cast
      ring

theorem norm_dirichletExplicitFormulaKernel_le_rpow_mul_log
    {x : ℝ} (hx : 1 ≤ x) {rho : ℂ} (hrho : 0 ≤ rho.re) :
    ‖dirichletExplicitFormulaKernel x rho‖ ≤
      x ^ rho.re * Real.log x := by
  have hxpos : 0 < x := zero_lt_one.trans_le hx
  have hlog : 0 ≤ Real.log x := Real.log_nonneg hx
  by_cases hrhozero : rho = 0
  · subst rho
    simp [dirichletExplicitFormulaKernel_zero, abs_of_nonneg hlog]
  let L : ℂ := (Real.log x : ℂ)
  let f : ℂ → ℂ := fun z => NormedSpace.exp (z • L)
  let C : ℝ := x ^ rho.re * Real.log x
  have hderiv : ∀ z ∈ segment ℝ (0 : ℂ) rho,
      HasDerivWithinAt f (NormedSpace.exp (z • L) * L)
        (segment ℝ (0 : ℂ) rho) z := by
    intro z hz
    exact (hasDerivAt_exp_smul_const L z).hasDerivWithinAt
  have hbound : ∀ z ∈ segment ℝ (0 : ℂ) rho,
      ‖NormedSpace.exp (z • L) * L‖ ≤ C := by
    intro z hz
    rcases hz with ⟨a, b, ha, hb, hab, rfl⟩
    have hbOne : b ≤ 1 := by linarith
    have hre : (a • (0 : ℂ) + b • rho).re ≤ rho.re := by
      simp only [smul_zero, zero_add, Complex.smul_re, smul_eq_mul]
      nlinarith
    have hre' : (0 + (b : ℂ) * rho).re ≤ rho.re := by
      simpa [smul_eq_mul] using hre
    have hexp :
        ‖NormedSpace.exp ((a • (0 : ℂ) + b • rho) • L)‖ ≤
          x ^ rho.re := by
      rw [← Complex.exp_eq_exp_ℂ, Complex.norm_exp]
      rw [Real.rpow_def_of_pos hxpos]
      apply Real.exp_le_exp.mpr
      dsimp [L]
      simp only [Complex.mul_re, Complex.ofReal_re, Complex.ofReal_im,
        mul_zero, sub_zero]
      calc
        (0 + (b : ℂ) * rho).re * Real.log x ≤
            rho.re * Real.log x :=
          mul_le_mul_of_nonneg_right hre' hlog
        _ = Real.log x * rho.re := mul_comm _ _
    rw [norm_mul]
    have hnormL : ‖L‖ = Real.log x := by
      simp [L, abs_of_nonneg hlog]
    rw [hnormL]
    exact mul_le_mul_of_nonneg_right hexp hlog
  have hmv :=
    (convex_segment (0 : ℂ) rho).norm_image_sub_le_of_norm_hasDerivWithin_le
      hderiv hbound
      (left_mem_segment ℝ (0 : ℂ) rho)
      (right_mem_segment ℝ (0 : ℂ) rho)
  have hmul := mul_dirichletExplicitFormulaKernel x rho
  have hnormrho : 0 < ‖rho‖ := norm_pos_iff.mpr hrhozero
  have hnum :
      ‖Complex.exp (rho * (Real.log x : ℂ)) - 1‖ ≤ C * ‖rho‖ := by
    simpa [f, L, C, Complex.exp_eq_exp_ℂ, smul_eq_mul] using hmv
  calc
    ‖dirichletExplicitFormulaKernel x rho‖ =
        ‖Complex.exp (rho * (Real.log x : ℂ)) - 1‖ / ‖rho‖ := by
      rw [← hmul, norm_mul, mul_div_cancel_left₀ _ hnormrho.ne']
    _ ≤ (C * ‖rho‖) / ‖rho‖ :=
      div_le_div_of_nonneg_right hnum hnormrho.le
    _ = x ^ rho.re * Real.log x := by
      rw [mul_div_cancel_right₀ C hnormrho.ne']

end

section
open Complex

section DirichletExplicitFormula
attribute [local instance] inducingEulerProductConductorNeZero

end DirichletExplicitFormula
end

section
open Complex

attribute [local instance] inducingEulerProductConductorNeZero
theorem dirichletExplicitFormulaMainZeroTerms_eq_inducingPrimitive
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (x T : ℝ) :
    dirichletExplicitFormulaMainZeroTerms chi x T =
      dirichletExplicitFormulaMainZeroTerms
        chi.primitiveCharacter x T := by
  classical
  have hprincipal : chi = 1 ↔ chi.primitiveCharacter = 1 := by
    constructor
    · intro hchi
      subst chi
      exact DirichletCharacter.primitiveCharacter_one
    · intro hprimitive
      rw [← chi.changeLevel_primitiveCharacter]
      exact (DirichletCharacter.changeLevel_eq_one_iff
        chi.conductor_dvd_level).2 hprimitive
  rw [dirichletExplicitFormulaMainZeroTerms,
    dirichletExplicitFormulaMainZeroTerms,
    dirichletNontrivialZeroKernelSum_eq_inducingPrimitive chi x T]
  congr 1
  by_cases hchi : chi = 1
  · rw [ite_eq_left hchi, ite_eq_left (hprincipal.mp hchi)]
  · rw [ite_eq_right hchi, ite_eq_right (mt hprincipal.mpr hchi)]

theorem
    exists_nat_norm_twistedChebyshevSum_sub_dirichletExplicitFormulaMainZeroTerms_le :
    ∃ K : ℕ, 1 ≤ K ∧
      ∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q),
          ∀ T : ℝ, 2 ≤ T →
            ∀ x : ℕ, 4 ≤ x → T ≤ (x : ℝ) →
              ‖twistedChebyshevSum x q chi -
                  dirichletExplicitFormulaMainZeroTerms chi (x : ℝ) T‖ ≤
                (K : ℝ) *
                  dirichletExplicitFormulaErrorScale (x : ℝ) q T := by
  obtain ⟨P, hP, hprimitive⟩ :=
    exists_nat_norm_twistedChebyshevSum_sub_dirichletExplicitFormulaMainZeroTerms_le_of_isPrimitive
  let K : ℕ := P + 1
  refine ⟨K, by dsimp [K]; omega, ?_⟩
  intro q _ chi T hT x hx hTx
  have hTpos : 0 < T := zero_lt_two.trans_le hT
  have hxposNat : 0 < x := by omega
  have hxpos : (0 : ℝ) < x := by exact_mod_cast hxposNat
  have hxone : (1 : ℝ) ≤ x := by exact_mod_cast (show 1 ≤ x by omega)
  have hqoneNat : 1 ≤ q := NeZero.pos q
  have hqone : (1 : ℝ) ≤ q := by exact_mod_cast hqoneNat
  have hdposNat : 0 < chi.conductor :=
    Nat.pos_of_ne_zero chi.conductor_ne_zero
  have hdone : (1 : ℝ) ≤ chi.conductor := by
    exact_mod_cast (Nat.one_le_iff_ne_zero.mpr chi.conductor_ne_zero)
  have hdqNat : chi.conductor ≤ q :=
    Nat.le_of_dvd (NeZero.pos q) chi.conductor_dvd_level
  have hdq : (chi.conductor : ℝ) ≤ q := by exact_mod_cast hdqNat
  have hproduct :
      (x : ℝ) * chi.conductor ≤ (x : ℝ) * q :=
    mul_le_mul_of_nonneg_left hdq hxpos.le
  have hlogProduct :
      Real.log ((x : ℝ) * chi.conductor) ≤
        Real.log ((x : ℝ) * q) :=
    Real.log_le_log
      (mul_pos hxpos (by exact_mod_cast hdposNat)) hproduct
  have hlogConductor :
      0 ≤ Real.log ((x : ℝ) * chi.conductor) :=
    Real.log_nonneg (one_le_mul_of_one_le_of_one_le hxone hdone)
  have hlogLevel : 0 ≤ Real.log ((x : ℝ) * q) :=
    Real.log_nonneg (one_le_mul_of_one_le_of_one_le hxone hqone)
  have hlogSquare :
      Real.log ((x : ℝ) * chi.conductor) ^ 2 ≤
        Real.log ((x : ℝ) * q) ^ 2 :=
    (sq_le_sq₀ hlogConductor hlogLevel).2 hlogProduct
  have hscale :
      dirichletExplicitFormulaErrorScale (x : ℝ) chi.conductor T ≤
        dirichletExplicitFormulaErrorScale (x : ℝ) q T := by
    rw [dirichletExplicitFormulaErrorScale,
      dirichletExplicitFormulaErrorScale]
    apply (div_le_div_iff_of_pos_right hTpos).2
    exact mul_le_mul_of_nonneg_left hlogSquare hxpos.le
  have hxdiv : (1 : ℝ) ≤ (x : ℝ) / T :=
    (le_div_iff₀ hTpos).2 (by simpa using hTx)
  have hcorrectionScale :
      Real.log ((q * x : ℕ) : ℝ) ^ 2 ≤
        dirichletExplicitFormulaErrorScale (x : ℝ) q T := by
    calc
      Real.log ((q * x : ℕ) : ℝ) ^ 2 =
          Real.log ((x : ℝ) * q) ^ 2 := by
        rw [Nat.cast_mul, mul_comm]
      _ ≤ Real.log ((x : ℝ) * q) ^ 2 * ((x : ℝ) / T) := by
        simpa only [mul_one] using
          mul_le_mul_of_nonneg_left hxdiv
            (sq_nonneg (Real.log ((x : ℝ) * q)))
      _ = dirichletExplicitFormulaErrorScale (x : ℝ) q T := by
        rw [dirichletExplicitFormulaErrorScale]
        ring
  have hcorrection :
      ‖twistedChebyshevSum x q chi -
          twistedChebyshevSum x chi.conductor chi.primitiveCharacter‖ ≤
        Real.log ((q * x : ℕ) : ℝ) ^ 2 := by
    simpa only [norm_sub_rev] using
      norm_primitiveTwistedChebyshevSum_sub_le_log_mul_sq
        (x := x) chi (by omega) hqoneNat
  have hprimitiveBound :=
    hprimitive chi.conductor chi.primitiveCharacter
      chi.primitiveCharacter_isPrimitive T hT x hx hTx
  have hmain :=
    dirichletExplicitFormulaMainZeroTerms_eq_inducingPrimitive
      chi (x : ℝ) T
  calc
    ‖twistedChebyshevSum x q chi -
          dirichletExplicitFormulaMainZeroTerms chi (x : ℝ) T‖ =
        ‖(twistedChebyshevSum x q chi -
            twistedChebyshevSum x chi.conductor chi.primitiveCharacter) +
          (twistedChebyshevSum x chi.conductor chi.primitiveCharacter -
            dirichletExplicitFormulaMainZeroTerms
              chi.primitiveCharacter (x : ℝ) T)‖ := by
      rw [hmain]
      congr 1
      ring
    _ ≤ ‖twistedChebyshevSum x q chi -
            twistedChebyshevSum x chi.conductor chi.primitiveCharacter‖ +
          ‖twistedChebyshevSum x chi.conductor chi.primitiveCharacter -
            dirichletExplicitFormulaMainZeroTerms
              chi.primitiveCharacter (x : ℝ) T‖ :=
      norm_add_le _ _
    _ ≤ Real.log ((q * x : ℕ) : ℝ) ^ 2 +
          (P : ℝ) *
            dirichletExplicitFormulaErrorScale
              (x : ℝ) chi.conductor T :=
      add_le_add hcorrection hprimitiveBound
    _ ≤ dirichletExplicitFormulaErrorScale (x : ℝ) q T +
          (P : ℝ) * dirichletExplicitFormulaErrorScale (x : ℝ) q T :=
      add_le_add hcorrectionScale
        (mul_le_mul_of_nonneg_left hscale (Nat.cast_nonneg P))
    _ = (K : ℝ) *
        dirichletExplicitFormulaErrorScale (x : ℝ) q T := by
      dsimp [K]
      push_cast
      ring

end

section
open Complex

end

section
open Complex

attribute [local instance] inducingEulerProductConductorNeZero
theorem exists_nat_nonprincipalNontrivialLFunctionZero_re_lt_of_sq_ne_one :
    ∃ M : ℕ, 2 ≤ M ∧
      ∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q) (rho : ℂ),
          chi ^ 2 ≠ 1 →
            (chi ≠ 1 ∧
              DirichletCharacter.completedLFunction chi.primitiveCharacter rho = 0) →
              rho.re <
                1 - 1 / ((M : ℝ) ^ 2 *
                  Real.log ((q : ℝ) * (|rho.im| + 2))) := by
  obtain ⟨A, hA, hselected⟩ :=
    exists_nat_selectedNonprincipalNontrivialZeros_sum_sub_le_re_logDeriv_LFunction
  obtain ⟨C, hC, hzeta⟩ :=
    exists_pos_neg_logDeriv_riemannZeta_re_lt_inv_sub_one_add
  let K : ℝ := (16 * (A : ℝ) + 3) / 3
  have hKpos : 0 < K := by
    dsimp [K]
    positivity
  have hlogTwo : 0 < Real.log 2 := Real.log_pos one_lt_two
  let B : ℝ := max 2
    (max (1 / Real.log 2) (4 + 6 * K + 3 * C / Real.log 2))
  obtain ⟨M, hM⟩ := exists_nat_gt B
  let m : ℝ := M
  have hMtwoReal : (2 : ℝ) < m := by
    dsimp [m]
    exact (le_max_left 2
      (max (1 / Real.log 2)
        (4 + 6 * K + 3 * C / Real.log 2))).trans_lt (by simpa [B] using hM)
  have hMtwo : 2 ≤ M := by
    have hcast : (2 : ℝ) ≤ (M : ℝ) := by
      simpa [m] using hMtwoReal.le
    exact_mod_cast hcast
  have hMinvLog : 1 / Real.log 2 < m := by
    dsimp [m]
    have hle :
        1 / Real.log 2 ≤ B :=
      (le_max_left (1 / Real.log 2)
        (4 + 6 * K + 3 * C / Real.log 2)).trans
          (le_max_right 2 _)
    exact hle.trans_lt hM
  have hMthreshold :
      4 + 6 * K + 3 * C / Real.log 2 < m := by
    dsimp [m]
    have hle :
        4 + 6 * K + 3 * C / Real.log 2 ≤ B :=
      (le_max_right (1 / Real.log 2)
        (4 + 6 * K + 3 * C / Real.log 2)).trans
          (le_max_right 2 _)
    exact hle.trans_lt hM
  have hmLogTwo : 1 < m * Real.log 2 := by
    calc
      1 = (1 / Real.log 2) * Real.log 2 := by
        field_simp
      _ < m * Real.log 2 :=
        mul_lt_mul_of_pos_right hMinvLog hlogTwo
  have hcoefficient :
      3 * C / Real.log 2 < m - 4 - 6 * K := by
    linarith
  refine ⟨M, hMtwo, ?_⟩
  intro q _ chi rho hsquare hrho
  let Q : ℝ := (q : ℝ) * (|rho.im| + 2)
  let L : ℝ := Real.log Q
  let sigma : ℝ := 1 + 1 / (m * L)
  have hQtwo : (2 : ℝ) ≤ Q := by
    simpa [Q] using two_le_level_height (q := q) rho.im
  have hlogLower : Real.log 2 ≤ L := by
    dsimp [L]
    exact Real.log_le_log zero_lt_two hQtwo
  have hLpos : 0 < L := hlogTwo.trans_le hlogLower
  have hmpos : 0 < m := by linarith
  have hmLpos : 0 < m * L := mul_pos hmpos hLpos
  have hmLone : 1 < m * L :=
    hmLogTwo.trans_le (mul_le_mul_of_nonneg_left hlogLower hmpos.le)
  have hsigma_one : 1 < sigma := by
    dsimp [sigma]
    have : 0 < 1 / (m * L) := one_div_pos.mpr hmLpos
    linarith
  have hsigma_two : sigma < 2 := by
    dsimp [sigma]
    have hinv : (m * L)⁻¹ < 1 := (inv_lt_one₀ hmLpos).2 hmLone
    rw [one_div]
    linarith
  obtain ⟨hchi, hzero, hrho_pos, hrho_one⟩ :=
    (isNonprincipalNontrivialLFunctionZero_iff chi rho).1 hrho
  by_contra hcontra
  have hbeta : 1 - 1 / (m ^ 2 * L) ≤ rho.re := by
    simpa [m, L, Q] using le_of_not_gt hcontra
  have hreciprocal :
      (m - 1) * L ≤ (sigma - rho.re)⁻¹ := by
    simpa [sigma] using mul_sub_one_le_inv_one_add_inv_sub
      (m := m) (L := L) (beta := rho.re) hMtwoReal.le hLpos hbeta hrho_one
  let Z : ℂ →₀ ℕ := Finsupp.single rho 1
  have hZsupport :
      ∀ z ∈ Z.support,
        (chi ≠ 1 ∧
          DirichletCharacter.completedLFunction chi.primitiveCharacter z = 0) ∧
          |z.im - rho.im| ≤ 1 := by
    intro z hz
    rw [Finsupp.support_single rho one_ne_zero] at hz
    simp only [Finset.mem_singleton] at hz
    subst z
    exact ⟨hrho, by simp⟩
  have horder :
      1 ≤ analyticOrderNatAt (DirichletCharacter.LFunction chi) rho := by
    have hdiv := one_le_divisor_LFunction_of_zero
      (U := Set.univ) (s := rho) hchi (Set.mem_univ rho) hzero
    rw [divisor_LFunction_apply_eq_analyticOrderNatAt
      hchi (Set.mem_univ rho)] at hdiv
    exact_mod_cast hdiv
  have hZmult :
      ∀ z : ℂ,
        Z z ≤ analyticOrderNatAt (DirichletCharacter.LFunction chi) z := by
    intro z
    by_cases hz : z = rho
    · subst z
      simpa [Z] using horder
    · simp [Z, hz]
  have hchiRaw := hselected q chi hchi rho.im sigma Z
    hsigma_one.le hsigma_two.le hZsupport hZmult
  have hZsum :
      Z.sum (fun z n =>
          (n : ℝ) *
            (((((sigma : ℂ) + rho.im * I) - z)⁻¹).re)) =
        (sigma - rho.re)⁻¹ := by
    calc
      Z.sum (fun z n =>
          (n : ℝ) * (((((sigma : ℂ) + rho.im * I) - z)⁻¹).re)) =
          ((1 : ℕ) : ℝ) *
            (((((sigma : ℂ) + rho.im * I) - rho)⁻¹).re) := by
        dsimp [Z]
        exact Finsupp.sum_single_index (a := rho) (b := 1)
          (h := fun (z : ℂ) (n : ℕ) =>
            (n : ℝ) * (((((sigma : ℂ) + rho.im * I) - z)⁻¹).re))
          (by norm_num)
      _ = (sigma - rho.re)⁻¹ := by
        rw [Nat.cast_one, one_mul, re_inv_same_height]
  change Z.sum (fun z n =>
      (n : ℝ) * (((((sigma : ℂ) + rho.im * I) - z)⁻¹).re)) -
      (16 * (A : ℝ) + 3) * L / 3 ≤
    (logDeriv (DirichletCharacter.LFunction chi)
      ((sigma : ℂ) + rho.im * I)).re at hchiRaw
  have hresidual : (16 * (A : ℝ) + 3) * L / 3 = K * L := by
    dsimp [K]
    ring
  rw [hZsum, hresidual] at hchiRaw
  have hchiLower :
      (m - 1) * L - K * L ≤
        (logDeriv (DirichletCharacter.LFunction chi)
          ((sigma : ℂ) + rho.im * I)).re := by
    linarith
  have hsquareRaw := hselected q (chi ^ 2) hsquare (2 * rho.im) sigma 0
    hsigma_one.le hsigma_two.le (by simp) (by simp)
  rw [Finsupp.sum_zero_index] at hsquareRaw
  change 0 - (16 * (A : ℝ) + 3) *
      Real.log ((q : ℝ) * (|2 * rho.im| + 2)) / 3 ≤
    (logDeriv (DirichletCharacter.LFunction (chi ^ 2))
      ((sigma : ℂ) + ((2 * rho.im : ℝ) : ℂ) * I)).re at hsquareRaw
  have hsquareResidual :
      (16 * (A : ℝ) + 3) *
          Real.log ((q : ℝ) * (|2 * rho.im| + 2)) / 3 =
        K * Real.log ((q : ℝ) * (|2 * rho.im| + 2)) := by
    dsimp [K]
    ring
  rw [hsquareResidual, zero_sub] at hsquareRaw
  have hdoubleLog :
      Real.log ((q : ℝ) * (|2 * rho.im| + 2)) ≤ 2 * L := by
    simpa [L, Q] using log_doubled_height_le_two_mul_log (q := q) rho.im
  have hsquareLower :
      -2 * K * L ≤
        (logDeriv (DirichletCharacter.LFunction (chi ^ 2))
          ((sigma : ℂ) + ((2 * rho.im : ℝ) : ℂ) * I)).re := by
    have hmul := mul_le_mul_of_nonneg_left hdoubleLog hKpos.le
    nlinarith
  have hphase :=
    three_four_one_zeta_neg_logDeriv_LFunction_nonneg
      chi hsigma_one rho.im
  have hevalOne :
      (sigma : ℂ) + I * rho.im = (sigma : ℂ) + rho.im * I := by ring
  have hevalTwo :
      (sigma : ℂ) + I * (2 * rho.im : ℝ) =
        (sigma : ℂ) + ((2 * rho.im : ℝ) : ℂ) * I := by ring
  rw [hevalOne, hevalTwo] at hphase
  simp only [Complex.neg_re] at hphase
  have hpole : (sigma - 1)⁻¹ = m * L := by
    have heq : sigma - 1 = (m * L)⁻¹ := by
      dsimp [sigma]
      rw [one_div]
      ring
    rw [heq, inv_inv]
  have hzetaBound := hzeta sigma hsigma_one hsigma_two
  rw [hpole] at hzetaBound
  have hzetaBound' :
      -(logDeriv riemannZeta (sigma : ℂ)).re < m * L + C := by
    simpa only [Complex.neg_re] using hzetaBound
  have hphaseUpper :
      4 * (logDeriv (DirichletCharacter.LFunction chi)
          ((sigma : ℂ) + rho.im * I)).re +
        (logDeriv (DirichletCharacter.LFunction (chi ^ 2))
          ((sigma : ℂ) + ((2 * rho.im : ℝ) : ℂ) * I)).re ≤
        3 * (-(logDeriv riemannZeta (sigma : ℂ)).re) := by
    linarith only [hphase]
  have hupper :
      4 * (logDeriv (DirichletCharacter.LFunction chi)
          ((sigma : ℂ) + rho.im * I)).re +
        (logDeriv (DirichletCharacter.LFunction (chi ^ 2))
          ((sigma : ℂ) + ((2 * rho.im : ℝ) : ℂ) * I)).re <
        3 * m * L + 3 * C := by
    calc
      _ ≤ 3 * (-(logDeriv riemannZeta (sigma : ℂ)).re) := hphaseUpper
      _ < 3 * (m * L + C) :=
        mul_lt_mul_of_pos_left hzetaBound' (by norm_num)
      _ = 3 * m * L + 3 * C := by ring
  have hlower :
      (4 * m - 4 - 6 * K) * L ≤
        4 * (logDeriv (DirichletCharacter.LFunction chi)
            ((sigma : ℂ) + rho.im * I)).re +
          (logDeriv (DirichletCharacter.LFunction (chi ^ 2))
            ((sigma : ℂ) + ((2 * rho.im : ℝ) : ℂ) * I)).re := by
    nlinarith
  have hcoefficient_pos : 0 < m - 4 - 6 * K :=
    (div_pos (mul_pos (by norm_num) hC) hlogTwo).trans hcoefficient
  have hcoefficientLog :
      3 * C < (m - 4 - 6 * K) * Real.log 2 := by
    calc
      3 * C = (3 * C / Real.log 2) * Real.log 2 := by
        field_simp
      _ < (m - 4 - 6 * K) * Real.log 2 :=
        mul_lt_mul_of_pos_right hcoefficient hlogTwo
  have hscaleCoefficient :
      (m - 4 - 6 * K) * Real.log 2 ≤
        (m - 4 - 6 * K) * L :=
    mul_le_mul_of_nonneg_left hlogLower hcoefficient_pos.le
  have hcontradiction :
      3 * m * L + 3 * C < (4 * m - 4 - 6 * K) * L := by
    calc
      3 * m * L + 3 * C <
          3 * m * L + (m - 4 - 6 * K) * L :=
        add_lt_add_right (hcoefficientLog.trans_le hscaleCoefficient) _
      _ = (4 * m - 4 - 6 * K) * L := by ring
  exact (not_lt_of_ge (hlower.trans hupper.le)) hcontradiction

end

section
open Complex
open scoped ComplexConjugate

section DirichletLFunctionConjugation
theorem conj_LSeries_conj_eq_inv
    {q : ℕ} (chi : DirichletCharacter ℂ q) (s : ℂ) :
    conj (LSeries (chi ·) (conj s)) = LSeries (chi⁻¹ ·) s := by
  rw [LSeries, conj_tsum, LSeries]
  apply tsum_congr
  intro n
  by_cases hn : n = 0
  · subst n
    simp
  · rw [LSeries.term_of_ne_zero hn, LSeries.term_of_ne_zero hn,
      map_div₀]
    have hcoeff : (starRingEnd ℂ) (chi n) = chi⁻¹ n := by
      change star (chi n) = chi⁻¹ n
      exact MulChar.star_apply' chi n
    rw [hcoeff]
    congr 1
    rw [← Complex.conj_cpow (n : ℂ) s (by
      rw [Complex.natCast_arg]
      exact ne_of_eq_of_ne rfl Real.pi_ne_zero.symm),
      Complex.conj_natCast]

end DirichletLFunctionConjugation

theorem LFunction_inv_conj
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    (hchi : chi ≠ 1) (s : ℂ) :
    DirichletCharacter.LFunction chi⁻¹ (conj s) =
      conj (DirichletCharacter.LFunction chi s) := by
  have hinvAnalytic : AnalyticOnNhd ℂ
      (DirichletCharacter.LFunction chi⁻¹) Set.univ :=
    DifferentiableOn.analyticOnNhd
      (DirichletCharacter.differentiable_LFunction
        (inv_ne_one.mpr hchi)).differentiableOn isOpen_univ
  have hconjAnalytic : AnalyticOnNhd ℂ
      (fun z : ℂ =>
        conj (DirichletCharacter.LFunction chi (conj z))) Set.univ :=
    DifferentiableOn.analyticOnNhd (fun z _ =>
      (differentiableAt_conj_conj_iff.mpr
        (DirichletCharacter.differentiable_LFunction hchi (conj z))).differentiableWithinAt)
      isOpen_univ
  have heq (z : ℂ) (hz : 1 < z.re) :
      DirichletCharacter.LFunction chi⁻¹ z =
        conj (DirichletCharacter.LFunction chi (conj z)) := by
    rw [DirichletCharacter.LFunction_eq_LSeries chi⁻¹ hz,
      DirichletCharacter.LFunction_eq_LSeries chi (by simpa using hz)]
    exact (conj_LSeries_conj_eq_inv chi z).symm
  have hfun : DirichletCharacter.LFunction chi⁻¹ =
      fun z : ℂ => conj (DirichletCharacter.LFunction chi (conj z)) :=
    hinvAnalytic.eq_of_eventuallyEq hconjAnalytic <|
      eventuallyEq_of_mem
        ((isOpen_lt continuous_const continuous_re).mem_nhds
          (by norm_num : (1 : ℝ) < ((2 : ℂ).re))) heq
  simpa using congrFun hfun (conj s)

theorem LFunction_conj_of_sq_eq_one
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    (hchi : chi ≠ 1) (hsquare : chi ^ 2 = 1) (s : ℂ) :
    DirichletCharacter.LFunction chi (conj s) =
      conj (DirichletCharacter.LFunction chi s) := by
  have hinv : chi⁻¹ = chi :=
    inv_eq_of_mul_eq_one_right (by simpa [pow_two] using hsquare)
  simpa [hinv] using LFunction_inv_conj chi hchi s

end

section
open Complex
open scoped ComplexConjugate

attribute [local instance] inducingEulerProductConductorNeZero
theorem IsNonprincipalNontrivialLFunctionZero.conj_of_sq_eq_one
    {q : ℕ} [NeZero q] {chi : DirichletCharacter ℂ q} {rho : ℂ}
    (hrho : (chi ≠ 1 ∧
              DirichletCharacter.completedLFunction chi.primitiveCharacter rho = 0))
    (hsquare : chi ^ 2 = 1) :
    (chi ≠ 1 ∧
      DirichletCharacter.completedLFunction chi.primitiveCharacter (conj rho) = 0) := by
  rw [isNonprincipalNontrivialLFunctionZero_iff chi rho] at hrho
  rw [isNonprincipalNontrivialLFunctionZero_iff chi (conj rho)]
  rcases hrho with ⟨hchi, hzero, hrePos, hreLt⟩
  refine ⟨hchi, ?_, ?_, ?_⟩
  · rw [LFunction_conj_of_sq_eq_one chi hchi hsquare rho, hzero,
      map_zero]
  · simpa using hrePos
  · simpa using hreLt

end

section
open Complex

section PrincipalLFunctionHeightPole
/--
The finite Euler correction `∏ p ∣ q, (1 - p ^ (-s))`, with each prime divisor included once.
Multiplying zeta by this factor gives the principal-character L-function away from its pole.
-/
noncomputable def principalEulerProduct (q : ℕ) (s : ℂ) : ℂ :=
  ∏ p ∈ q.primeFactors, (1 - (p : ℂ) ^ (-s))

theorem norm_natCast_cpow_neg_le_half
    (p : ℕ) (hp : p.Prime) (s : ℂ) (hs : 1 ≤ s.re) :
    ‖(p : ℂ) ^ (-s)‖ ≤ (1 / 2 : ℝ) := by
  have hone : (1 : DirichletCharacter ℂ 1) (p : ZMod 1) = 1 :=
    MulChar.one_apply (isUnit_of_subsingleton _)
  simpa only [hone, one_mul] using
    norm_character_mul_cpow_neg_le_half
      (1 : DirichletCharacter ℂ 1) p hp s hs

theorem principalEulerFactor_ne_zero
    (p : ℕ) (hp : p.Prime) (s : ℂ) (hs : 1 ≤ s.re) :
    (1 : ℂ) - (p : ℂ) ^ (-s) ≠ 0 := by
  intro hzero
  have hpow : (p : ℂ) ^ (-s) = 1 := (sub_eq_zero.mp hzero).symm
  have hnorm := norm_natCast_cpow_neg_le_half p hp s hs
  rw [hpow, norm_one] at hnorm
  linarith

theorem differentiableAt_principalEulerFactor
    (p : ℕ) (hp : p.Prime) (s : ℂ) :
    DifferentiableAt ℂ (fun z : ℂ => 1 - (p : ℂ) ^ (-z)) s :=
  ((hasDerivAt_const s (1 : ℂ)).sub
    ((hasDerivAt_neg' s).const_cpow
      (Or.inl (Nat.cast_ne_zero.mpr hp.ne_zero)))).differentiableAt

theorem principalEulerProduct_ne_zero
    (q : ℕ) (s : ℂ) (hs : 1 ≤ s.re) :
    principalEulerProduct q s ≠ 0 := by
  rw [principalEulerProduct, Finset.prod_ne_zero_iff]
  intro p hp
  exact principalEulerFactor_ne_zero p
    (Nat.prime_of_mem_primeFactors hp) s hs

theorem differentiableAt_principalEulerProduct
    (q : ℕ) (s : ℂ) :
    DifferentiableAt ℂ (principalEulerProduct q) s := by
  unfold principalEulerProduct
  exact .fun_finsetProd fun p hp =>
    differentiableAt_principalEulerFactor p
      (Nat.prime_of_mem_primeFactors hp) s

theorem norm_logDeriv_principalEulerProduct_le_log
    (q : ℕ) [NeZero q] (s : ℂ) (hs : 1 ≤ s.re) :
    ‖logDeriv (principalEulerProduct q) s‖ ≤ Real.log q := by
  have hone (p : ℕ) : (1 : DirichletCharacter ℂ q).primitiveCharacter p = 1 := by
    have : Subsingleton (ZMod (1 : DirichletCharacter ℂ q).conductor) := by
      rw [DirichletCharacter.conductor_one]
      infer_instance
    rw [DirichletCharacter.primitiveCharacter_one]
    exact MulChar.one_apply (isUnit_of_subsingleton _)
  have hprod : principalEulerProduct q = inducingEulerProduct (1 : DirichletCharacter ℂ q) := by
    funext z
    simp only [principalEulerProduct, inducingEulerProduct, hone, one_mul]
  rw [hprod]
  exact norm_logDeriv_inducingEulerProduct_le_log
    (1 : DirichletCharacter ℂ q) s hs

end PrincipalLFunctionHeightPole

theorem norm_logDeriv_principal_LFunction_sub_riemannZeta_le_log
    {q : ℕ} [NeZero q] {s : ℂ}
    (hs : 1 ≤ s.re) (hs1 : s ≠ 1) :
    ‖logDeriv (DirichletCharacter.LFunction
          (1 : DirichletCharacter ℂ q)) s -
        logDeriv riemannZeta s‖ ≤ Real.log (q : ℝ) := by
  let P : ℂ → ℂ := principalEulerProduct q
  have heq : DirichletCharacter.LFunction
      (1 : DirichletCharacter ℂ q) =ᶠ[𝓝 s]
        fun z => P z * riemannZeta z := by
    filter_upwards [eventually_ne_nhds hs1] with z hz
    change DirichletCharacter.LFunctionTrivChar q z = _
    simpa [P, principalEulerProduct] using
      DirichletCharacter.LFunctionTrivChar_eq_mul_riemannZeta
        (N := q) hz
  have hP : P s ≠ 0 := principalEulerProduct_ne_zero q s hs
  have hzeta : riemannZeta s ≠ 0 :=
    riemannZeta_ne_zero_of_one_le_re hs
  have hlog :
      logDeriv (DirichletCharacter.LFunction
          (1 : DirichletCharacter ℂ q)) s =
        logDeriv P s + logDeriv riemannZeta s := by
    calc
      logDeriv (DirichletCharacter.LFunction
          (1 : DirichletCharacter ℂ q)) s =
          logDeriv (fun z => P z * riemannZeta z) s := by
        rw [logDeriv_apply, logDeriv_apply, heq.deriv_eq,
          heq.self_of_nhds]
      _ = logDeriv P s + logDeriv riemannZeta s :=
        logDeriv_mul s hP hzeta
          (differentiableAt_principalEulerProduct q s)
          (differentiableAt_riemannZeta hs1)
  rw [hlog, add_sub_cancel_right]
  exact norm_logDeriv_principalEulerProduct_le_log q s hs

theorem exists_nat_neg_logDeriv_principal_LFunction_re_le_pole_add_log :
    ∃ A : ℕ, 1 ≤ A ∧
      ∀ (q : ℕ) [NeZero q] (s : ℂ),
        1 ≤ s.re → s.re ≤ 2 → s ≠ 1 →
          (-logDeriv (DirichletCharacter.LFunction
            (1 : DirichletCharacter ℂ q)) s).re ≤
            ((s - 1)⁻¹).re +
              (16 * (A : ℝ) + 1) *
                Real.log ((q : ℝ) * (|s.im| + 2)) := by
  obtain ⟨A, hA, hzetaBound⟩ :=
    exists_nat_neg_logDeriv_riemannZeta_re_le_pole_add_log
  refine ⟨A, hA, ?_⟩
  intro q _ s hs1 hs2 hsne
  let T : ℝ := |s.im| + 2
  let Q : ℝ := (q : ℝ) * T
  let D : ℂ :=
    logDeriv (DirichletCharacter.LFunction
      (1 : DirichletCharacter ℂ q)) s - logDeriv riemannZeta s
  have hq1 : (1 : ℝ) ≤ q := by
    exact_mod_cast Nat.one_le_iff_ne_zero.mpr (NeZero.ne q)
  have hqpos : (0 : ℝ) < q := zero_lt_one.trans_le hq1
  have hT2 : (2 : ℝ) ≤ T := by dsimp [T]; linarith [abs_nonneg s.im]
  have hTpos : 0 < T := zero_lt_two.trans_le hT2
  have hlogq : 0 ≤ Real.log (q : ℝ) := Real.log_nonneg hq1
  have hlogT : 0 ≤ Real.log T := Real.log_nonneg (one_le_two.trans hT2)
  have hcorrection : ‖D‖ ≤ Real.log (q : ℝ) := by
    simpa [D] using
      norm_logDeriv_principal_LFunction_sub_riemannZeta_le_log hs1 hsne
  have hcorrectionRe : -D.re ≤ Real.log (q : ℝ) := by
    calc
      -D.re ≤ |D.re| := neg_le_abs _
      _ ≤ ‖D‖ := Complex.abs_re_le_norm _
      _ ≤ Real.log (q : ℝ) := hcorrection
  have hidentity :
      (-logDeriv (DirichletCharacter.LFunction
        (1 : DirichletCharacter ℂ q)) s).re =
        (-logDeriv riemannZeta s).re - D.re := by
    simp only [Complex.neg_re, D, Complex.sub_re]
    ring_nf
  have hzeta :
      (-logDeriv riemannZeta s).re ≤
        ((s - 1)⁻¹).re + 16 * (A : ℝ) * Real.log T := by
    simpa [T] using hzetaBound s hs1 hs2 hsne
  have hraw :
      (-logDeriv (DirichletCharacter.LFunction
        (1 : DirichletCharacter ℂ q)) s).re ≤
        ((s - 1)⁻¹).re +
          16 * (A : ℝ) * Real.log T + Real.log (q : ℝ) := by
    rw [hidentity]
    linarith
  have hlogQ : Real.log Q = Real.log (q : ℝ) + Real.log T := by
    dsimp [Q]
    exact Real.log_mul hqpos.ne' hTpos.ne'
  have hscale :
      16 * (A : ℝ) * Real.log T + Real.log (q : ℝ) ≤
        (16 * (A : ℝ) + 1) * Real.log Q := by
    rw [hlogQ]
    have hA0 : (0 : ℝ) ≤ A := Nat.cast_nonneg A
    have hAq : 0 ≤ 16 * (A : ℝ) * Real.log (q : ℝ) :=
      mul_nonneg (mul_nonneg (by norm_num) hA0) hlogq
    nlinarith
  calc
    (-logDeriv (DirichletCharacter.LFunction
        (1 : DirichletCharacter ℂ q)) s).re ≤
        ((s - 1)⁻¹).re +
          (16 * (A : ℝ) * Real.log T + Real.log (q : ℝ)) := by
      linarith
    _ ≤ ((s - 1)⁻¹).re + (16 * (A : ℝ) + 1) * Real.log Q :=
      by linarith
    _ = ((s - 1)⁻¹).re +
        (16 * (A : ℝ) + 1) *
          Real.log ((q : ℝ) * (|s.im| + 2)) := by rfl

end

section
open Complex
open scoped ComplexConjugate

section SquarePrincipalNonreal

theorem re_inv_add_two_mul_I (x t : ℝ) :
    ((((x : ℂ) + (2 * t : ℝ) * I)⁻¹).re) =
      x / (x ^ 2 + 4 * t ^ 2) := by
  rw [Complex.inv_re, Complex.normSq_apply]
  simp only [add_re, ofReal_re, mul_re, ofReal_im, I_re, zero_mul,
    I_im, mul_one, sub_zero, add_im, mul_im, add_zero]
  ring

theorem re_inv_conjugate_height (sigma : ℝ) (rho : ℂ) :
    (((((sigma : ℂ) + rho.im * I) - conj rho)⁻¹).re) =
      (sigma - rho.re) /
        ((sigma - rho.re) ^ 2 + 4 * rho.im ^ 2) := by
  have heq :
      ((sigma : ℂ) + rho.im * I) - conj rho =
        ((sigma - rho.re : ℝ) : ℂ) + (2 * rho.im : ℝ) * I := by
    apply Complex.ext
    · simp
    · simp
      ring
  rw [heq, re_inv_add_two_mul_I]

theorem principal_pole_le_half_inv
    {a t : ℝ} (ha : 0 < a) (hlarge : a ≤ 2 * |t|) :
    a / (a ^ 2 + 4 * t ^ 2) ≤ 1 / (2 * a) := by
  rw [div_le_div_iff₀ (by positivity) (by positivity)]
  have := (sq_le_sq₀ ha.le (by positivity : 0 ≤ 2 * |t|)).2 hlarge
  nlinarith [sq_abs t]

theorem principal_pole_le_four_mul_conjugate
    {a x t : ℝ} (ha : 0 < a) (hax : a ≤ x)
    (hxa : x ≤ 3 * a / 2) :
    a / (a ^ 2 + 4 * t ^ 2) ≤
      4 * (x / (x ^ 2 + 4 * t ^ 2)) := by
  have hx : 0 < x := ha.trans_le hax
  have hdenA : 0 < a ^ 2 + 4 * t ^ 2 := by positivity
  have hdenX : 0 < x ^ 2 + 4 * t ^ 2 := by positivity
  rw [show 4 * (x / (x ^ 2 + 4 * t ^ 2)) =
      (4 * x) / (x ^ 2 + 4 * t ^ 2) by ring,
    div_le_div_iff₀ hdenA hdenX]
  have hxaFour : x ≤ 4 * a := hxa.trans (by linarith)
  have hfirst : a * x ^ 2 ≤ 4 * x * a ^ 2 := by
    nlinarith [mul_nonneg (mul_nonneg ha.le hx.le) (sub_nonneg.mpr hxaFour)]
  have hsecond : 4 * a * t ^ 2 ≤ 16 * x * t ^ 2 := by
    nlinarith [mul_nonneg (sub_nonneg.mpr hax) (sq_nonneg t)]
  nlinarith

end SquarePrincipalNonreal
end

section
open Complex
open scoped ComplexConjugate

attribute [local instance] inducingEulerProductConductorNeZero

section SquarePrincipalNonreal
theorem one_le_LFunction_order_of_nonprincipal_zero
    {q : ℕ} [NeZero q] {chi : DirichletCharacter ℂ q} {rho : ℂ}
    (hrho : (chi ≠ 1 ∧
              DirichletCharacter.completedLFunction chi.primitiveCharacter rho = 0)) :
    1 ≤ analyticOrderNatAt (DirichletCharacter.LFunction chi) rho := by
  obtain ⟨hchi, hzero, _, _⟩ :=
    (isNonprincipalNontrivialLFunctionZero_iff chi rho).1 hrho
  have hdiv := one_le_divisor_LFunction_of_zero
    (U := Set.univ) (s := rho) hchi (Set.mem_univ rho) hzero
  rw [divisor_LFunction_apply_eq_analyticOrderNatAt
    hchi (Set.mem_univ rho)] at hdiv
  exact_mod_cast hdiv

end SquarePrincipalNonreal
end

section
open Complex
open scoped ComplexConjugate

attribute [local instance] inducingEulerProductConductorNeZero
theorem exists_nat_nonprincipalNontrivialLFunctionZero_im_eq_zero_of_sq_eq_one :
    ∃ M : ℕ, 2 ≤ M ∧
      ∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q) (rho : ℂ),
          chi ^ 2 = 1 →
            (chi ≠ 1 ∧
              DirichletCharacter.completedLFunction chi.primitiveCharacter rho = 0) →
              1 - 1 / ((M : ℝ) ^ 2 *
                Real.log ((q : ℝ) * (|rho.im| + 2))) ≤ rho.re →
                rho.im = 0 := by
  obtain ⟨A, hA, hselected⟩ :=
    exists_nat_selectedNonprincipalNontrivialZeros_sum_sub_le_re_logDeriv_LFunction
  obtain ⟨B, hB, hprincipal⟩ :=
    exists_nat_neg_logDeriv_principal_LFunction_re_le_pole_add_log
  obtain ⟨C, hC, hzeta⟩ :=
    exists_pos_neg_logDeriv_riemannZeta_re_lt_inv_sub_one_add
  let K : ℝ := (16 * (A : ℝ) + 3) / 3
  let J : ℝ := 16 * (B : ℝ) + 1
  have hKpos : 0 < K := by dsimp [K]; positivity
  have hJpos : 0 < J := by dsimp [J]; positivity
  have hlogTwo : 0 < Real.log 2 := Real.log_pos one_lt_two
  let R : ℝ := 2 * (4 + 4 * K + 2 * J + 3 * C / Real.log 2)
  let D : ℝ := max 2 (max (1 / Real.log 2) R)
  obtain ⟨M, hM⟩ := exists_nat_gt D
  let m : ℝ := M
  have hmTwo : (2 : ℝ) < m := by
    dsimp [m]
    exact (le_max_left 2 (max (1 / Real.log 2) R)).trans_lt
      (by simpa [D] using hM)
  have hMtwo : 2 ≤ M := by
    have hcast : (2 : ℝ) ≤ (M : ℝ) := by simpa [m] using hmTwo.le
    exact_mod_cast hcast
  have hmInvLog : 1 / Real.log 2 < m := by
    dsimp [m]
    exact ((le_max_left (1 / Real.log 2) R).trans
      (le_max_right 2 _)).trans_lt (by simpa [D] using hM)
  have hmThreshold : R < m := by
    dsimp [m]
    exact ((le_max_right (1 / Real.log 2) R).trans
      (le_max_right 2 _)).trans_lt (by simpa [D] using hM)
  have hmLogTwo : 1 < m * Real.log 2 := by
    calc
      1 = (1 / Real.log 2) * Real.log 2 := by field_simp
      _ < m * Real.log 2 := mul_lt_mul_of_pos_right hmInvLog hlogTwo
  have hmargin :
      3 * C / Real.log 2 < m / 2 - 4 - 4 * K - 2 * J := by
    dsimp [R] at hmThreshold
    linarith
  refine ⟨M, hMtwo, ?_⟩
  intro q _ chi rho hsquare hrho hbeta
  by_contra hgamma
  let Q : ℝ := (q : ℝ) * (|rho.im| + 2)
  let L : ℝ := Real.log Q
  let a : ℝ := 1 / (m * L)
  let sigma : ℝ := 1 + a
  let x : ℝ := sigma - rho.re
  have hQtwo : (2 : ℝ) ≤ Q := by
    simpa [Q] using two_le_level_height (q := q) rho.im
  have hlogLower : Real.log 2 ≤ L := by
    dsimp [L]
    exact Real.log_le_log zero_lt_two hQtwo
  have hLpos : 0 < L := hlogTwo.trans_le hlogLower
  have hmpos : 0 < m := by linarith
  have hmLpos : 0 < m * L := mul_pos hmpos hLpos
  have hmLone : 1 < m * L :=
    hmLogTwo.trans_le (mul_le_mul_of_nonneg_left hlogLower hmpos.le)
  have haPos : 0 < a := by dsimp [a]; positivity
  have haLtOne : a < 1 := by
    dsimp [a]
    rw [one_div]
    exact (inv_lt_one₀ hmLpos).2 hmLone
  have hsigmaOne : 1 < sigma := by dsimp [sigma]; linarith
  have hsigmaTwo : sigma < 2 := by dsimp [sigma]; linarith
  obtain ⟨hchi, hzero, hrhoPos, hrhoOne⟩ :=
    (isNonprincipalNontrivialLFunctionZero_iff chi rho).1 hrho
  have hbeta' : 1 - 1 / (m ^ 2 * L) ≤ rho.re := by
    simpa only [m, L, Q] using hbeta
  have hreciprocal : (m - 1) * L ≤ x⁻¹ := by
    simpa [x, sigma, a] using mul_sub_one_le_inv_one_add_inv_sub
      (m := m) (L := L) (beta := rho.re) hmTwo.le hLpos
        hbeta' hrhoOne
  have hax : a < x := by dsimp [x, sigma]; linarith
  have hxa : x ≤ 3 * a / 2 := by
    have hmhalf : 1 / m ≤ (1 / 2 : ℝ) := by
      exact one_div_le_one_div_of_le (by norm_num) hmTwo.le
    have hnear : 1 - rho.re ≤ 1 / (m ^ 2 * L) := by
      linarith only [hbeta']
    have haRelation : 1 / (m ^ 2 * L) = a / m := by
      dsimp [a]
      field_simp [hmpos.ne', hLpos.ne']
    rw [haRelation] at hnear
    have : a / m ≤ a / 2 := by
      simpa [div_eq_mul_inv] using mul_le_mul_of_nonneg_left hmhalf haPos.le
    dsimp [x, sigma]
    linarith
  let Zone : ℂ →₀ ℕ := Finsupp.single rho 1
  have hZoneSupport :
      ∀ z ∈ Zone.support,
        (chi ≠ 1 ∧
          DirichletCharacter.completedLFunction chi.primitiveCharacter z = 0) ∧
          |z.im - rho.im| ≤ 1 := by
    intro z hz
    rw [Finsupp.support_single rho one_ne_zero] at hz
    simp only [Finset.mem_singleton] at hz
    subst z
    exact ⟨hrho, by simp⟩
  have horder := one_le_LFunction_order_of_nonprincipal_zero hrho
  have hZoneMult :
      ∀ z : ℂ,
        Zone z ≤ analyticOrderNatAt
          (DirichletCharacter.LFunction chi) z := by
    intro z
    by_cases hz : z = rho
    · subst z
      simpa [Zone] using horder
    · simp [Zone, hz]
  have hchiRaw := hselected q chi hchi rho.im sigma Zone
    hsigmaOne.le hsigmaTwo.le hZoneSupport hZoneMult
  have hZoneSum :
      Zone.sum (fun z n =>
        (n : ℝ) * (((((sigma : ℂ) + rho.im * I) - z)⁻¹).re)) =
          x⁻¹ := by
    calc
      _ = ((1 : ℕ) : ℝ) *
          (((((sigma : ℂ) + rho.im * I) - rho)⁻¹).re) := by
        dsimp [Zone]
        exact Finsupp.sum_single_index (a := rho) (b := 1)
          (h := fun (z : ℂ) (n : ℕ) =>
            (n : ℝ) * (((((sigma : ℂ) + rho.im * I) - z)⁻¹).re))
          (by norm_num)
      _ = x⁻¹ := by rw [Nat.cast_one, one_mul, re_inv_same_height]
  change Zone.sum (fun z n =>
      (n : ℝ) * (((((sigma : ℂ) + rho.im * I) - z)⁻¹).re)) -
      (16 * (A : ℝ) + 3) * L / 3 ≤
    (logDeriv (DirichletCharacter.LFunction chi)
      ((sigma : ℂ) + rho.im * I)).re at hchiRaw
  have hresidual : (16 * (A : ℝ) + 3) * L / 3 = K * L := by
    dsimp [K]
    ring
  rw [hZoneSum, hresidual] at hchiRaw
  have hchiLower :
      (m - 1) * L - K * L ≤
        (logDeriv (DirichletCharacter.LFunction chi)
          ((sigma : ℂ) + rho.im * I)).re := by
    linarith
  let sTwo : ℂ := (sigma : ℂ) + (2 * rho.im : ℝ) * I
  have hsTwoNe : sTwo ≠ 1 := by
    intro heq
    have hre := congrArg Complex.re heq
    simp [sTwo] at hre
    linarith
  have hprincipalRaw := hprincipal q sTwo
    (by simpa [sTwo] using hsigmaOne.le)
    (by simpa [sTwo] using hsigmaTwo.le) hsTwoNe
  have hsTwoSub : sTwo - 1 = (a : ℂ) + (2 * rho.im : ℝ) * I := by
    apply Complex.ext <;> simp [sTwo, sigma]
  have hpoleRe : ((sTwo - 1)⁻¹).re =
      a / (a ^ 2 + 4 * rho.im ^ 2) := by
    rw [hsTwoSub, re_inv_add_two_mul_I]
  have hdoubleLog :
      Real.log ((q : ℝ) * (|2 * rho.im| + 2)) ≤ 2 * L := by
    simpa [L, Q] using log_doubled_height_le_two_mul_log (q := q) rho.im
  have hsTwoIm : sTwo.im = 2 * rho.im := by simp [sTwo]
  have hprincipalLower :
      -a / (a ^ 2 + 4 * rho.im ^ 2) - 2 * J * L ≤
        (logDeriv (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re := by
    have hraw :
        (-logDeriv (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re ≤
          ((sTwo - 1)⁻¹).re +
            J * Real.log ((q : ℝ) * (|2 * rho.im| + 2)) := by
      simpa [hsquare, J, hsTwoIm] using hprincipalRaw
    rw [hpoleRe] at hraw
    simp only [Complex.neg_re] at hraw
    have hJlog := mul_le_mul_of_nonneg_left hdoubleLog hJpos.le
    calc
      -a / (a ^ 2 + 4 * rho.im ^ 2) - 2 * J * L ≤
          -a / (a ^ 2 + 4 * rho.im ^ 2) -
            J * Real.log ((q : ℝ) * (|2 * rho.im| + 2)) := by
        nlinarith only [hJlog]
      _ ≤ (logDeriv
          (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re := by
        have hneg := neg_le_neg hraw
        simp only [neg_neg] at hneg
        calc
          -a / (a ^ 2 + 4 * rho.im ^ 2) -
              J * Real.log ((q : ℝ) * (|2 * rho.im| + 2)) =
              -(a / (a ^ 2 + 4 * rho.im ^ 2) +
                J * Real.log ((q : ℝ) * (|2 * rho.im| + 2))) := by ring
          _ ≤ (logDeriv
              (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re := hneg
  have hphase := three_four_one_zeta_neg_logDeriv_LFunction_nonneg
    chi hsigmaOne rho.im
  have hevalOne :
      (sigma : ℂ) + I * rho.im = (sigma : ℂ) + rho.im * I := by ring
  have hevalTwo :
      (sigma : ℂ) + I * (2 * rho.im : ℝ) = sTwo := by
    dsimp [sTwo]
    ring
  rw [hevalOne, hevalTwo] at hphase
  simp only [Complex.neg_re] at hphase
  have hpoleSigma : (sigma - 1)⁻¹ = m * L := by
    have heq : sigma - 1 = (m * L)⁻¹ := by
      dsimp [sigma, a]
      rw [one_div]
      ring
    rw [heq, inv_inv]
  have hzetaBound := hzeta sigma hsigmaOne hsigmaTwo
  rw [hpoleSigma] at hzetaBound
  have hzetaBound' :
      -(logDeriv riemannZeta (sigma : ℂ)).re < m * L + C := by
    simpa only [Complex.neg_re] using hzetaBound
  have hupper :
      4 * (logDeriv (DirichletCharacter.LFunction chi)
          ((sigma : ℂ) + rho.im * I)).re +
        (logDeriv (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re <
          3 * m * L + 3 * C := by
    have hphaseUpper :
        4 * (logDeriv (DirichletCharacter.LFunction chi)
            ((sigma : ℂ) + rho.im * I)).re +
          (logDeriv (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re ≤
            3 * (-(logDeriv riemannZeta (sigma : ℂ)).re) := by
      linarith only [hphase]
    calc
      _ ≤ 3 * (-(logDeriv riemannZeta (sigma : ℂ)).re) := hphaseUpper
      _ < 3 * (m * L + C) :=
        mul_lt_mul_of_pos_left hzetaBound' (by norm_num)
      _ = 3 * m * L + 3 * C := by ring
  have hmarginPos : 0 < m / 2 - 4 - 4 * K - 2 * J :=
    (div_pos (mul_pos (by norm_num) hC) hlogTwo).trans hmargin
  have hmarginLog :
      3 * C < (m / 2 - 4 - 4 * K - 2 * J) * L := by
    calc
      3 * C = (3 * C / Real.log 2) * Real.log 2 := by field_simp
      _ < (m / 2 - 4 - 4 * K - 2 * J) * Real.log 2 :=
        mul_lt_mul_of_pos_right hmargin hlogTwo
      _ ≤ (m / 2 - 4 - 4 * K - 2 * J) * L :=
        mul_le_mul_of_nonneg_left hlogLower hmarginPos.le
  by_cases hlarge : a ≤ 2 * |rho.im|
  · have hpoleHalf :
        a / (a ^ 2 + 4 * rho.im ^ 2) ≤ m * L / 2 := by
      calc
        _ ≤ 1 / (2 * a) := principal_pole_le_half_inv haPos hlarge
        _ = m * L / 2 := by
          dsimp [a]
          field_simp [hmpos.ne', hLpos.ne']
    have hlower :
        (7 * m / 2 - 4 - 4 * K - 2 * J) * L ≤
          4 * (logDeriv (DirichletCharacter.LFunction chi)
              ((sigma : ℂ) + rho.im * I)).re +
            (logDeriv (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re := by
      have hchiFour := mul_le_mul_of_nonneg_left hchiLower (by norm_num : (0 : ℝ) ≤ 4)
      have hprincipalHalf :
          -(m * L / 2) - 2 * J * L ≤
            (logDeriv (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re := by
        calc
          -(m * L / 2) - 2 * J * L ≤
              -(a / (a ^ 2 + 4 * rho.im ^ 2)) - 2 * J * L :=
            sub_le_sub_right (neg_le_neg hpoleHalf) _
          _ = -a / (a ^ 2 + 4 * rho.im ^ 2) - 2 * J * L := by ring
          _ ≤ (logDeriv
              (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re :=
            hprincipalLower
      calc
        _ = 4 * ((m - 1) * L - K * L) +
            (-(m * L / 2) - 2 * J * L) := by ring
        _ ≤ 4 * (logDeriv (DirichletCharacter.LFunction chi)
              ((sigma : ℂ) + rho.im * I)).re +
            (logDeriv (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re :=
          add_le_add hchiFour hprincipalHalf
    have : 3 * m * L + 3 * C <
        (7 * m / 2 - 4 - 4 * K - 2 * J) * L := by
      calc
        3 * m * L + 3 * C = 3 * C + 3 * m * L := by ring
        _ < (m / 2 - 4 - 4 * K - 2 * J) * L + 3 * m * L :=
          by simpa [add_comm] using
            (add_lt_add_right hmarginLog (3 * m * L))
        _ = (7 * m / 2 - 4 - 4 * K - 2 * J) * L := by ring
    exact (not_lt_of_ge hlower) (hupper.trans this)
  · have hsmall : 2 * |rho.im| < a := lt_of_not_ge hlarge
    have hdist : rho ≠ conj rho := by
      intro heq
      have him := congrArg Complex.im heq
      simp only [conj_im] at him
      exact hgamma (by linarith only [him])
    have hrhoConj := IsNonprincipalNontrivialLFunctionZero.conj_of_sq_eq_one hrho hsquare
    have horderConj := one_le_LFunction_order_of_nonprincipal_zero hrhoConj
    let Zpair : ℂ →₀ ℕ :=
      Finsupp.single rho 1 + Finsupp.single (conj rho) 1
    have hlocalConj : |(conj rho).im - rho.im| ≤ 1 := by
      rw [conj_im]
      have : |-rho.im - rho.im| = 2 * |rho.im| := by
        rw [show -rho.im - rho.im = -(2 * rho.im) by ring,
          abs_neg, abs_mul, abs_of_nonneg (by norm_num : (0 : ℝ) ≤ 2)]
      rw [this]
      exact (hsmall.trans haLtOne).le
    have hZpairSupport :
        ∀ z ∈ Zpair.support,
          (chi ≠ 1 ∧
            DirichletCharacter.completedLFunction chi.primitiveCharacter z = 0) ∧
            |z.im - rho.im| ≤ 1 := by
      intro z hz
      rw [Finsupp.support_single_add_single hdist one_ne_zero one_ne_zero] at hz
      simp only [Finset.mem_insert, Finset.mem_singleton] at hz
      rcases hz with rfl | rfl
      · exact ⟨hrho, by simp⟩
      · exact ⟨hrhoConj, hlocalConj⟩
    have hZpairMult :
        ∀ z : ℂ,
          Zpair z ≤ analyticOrderNatAt
            (DirichletCharacter.LFunction chi) z := by
      intro z
      by_cases hz : z = rho
      · subst z
        simpa [Zpair, hdist, hdist.symm] using horder
      · by_cases hzc : z = conj rho
        · subst z
          simpa [Zpair, hdist, hdist.symm] using horderConj
        · simp [Zpair, hz, hzc]
    have hpairRaw := hselected q chi hchi rho.im sigma Zpair
      hsigmaOne.le hsigmaTwo.le hZpairSupport hZpairMult
    let conjugateReciprocal : ℝ :=
      x / (x ^ 2 + 4 * rho.im ^ 2)
    have hZpairSum :
        Zpair.sum (fun z n =>
          (n : ℝ) * (((((sigma : ℂ) + rho.im * I) - z)⁻¹).re)) =
            x⁻¹ + conjugateReciprocal := by
      dsimp [Zpair]
      rw [Finsupp.sum_single_add_single rho (conj rho) 1 1 _ hdist]
      · simp only [Nat.cast_one, one_mul]
        rw [re_inv_same_height, re_inv_conjugate_height]
      · intro z
        simp
    change Zpair.sum (fun z n =>
        (n : ℝ) * (((((sigma : ℂ) + rho.im * I) - z)⁻¹).re)) -
        (16 * (A : ℝ) + 3) * L / 3 ≤
      (logDeriv (DirichletCharacter.LFunction chi)
        ((sigma : ℂ) + rho.im * I)).re at hpairRaw
    rw [hZpairSum, hresidual] at hpairRaw
    have hpoleCancel :
        a / (a ^ 2 + 4 * rho.im ^ 2) ≤
          4 * conjugateReciprocal := by
      dsimp [conjugateReciprocal]
      exact principal_pole_le_four_mul_conjugate haPos hax.le hxa
    have hlower :
        (4 * m - 4 - 4 * K - 2 * J) * L ≤
          4 * (logDeriv (DirichletCharacter.LFunction chi)
              ((sigma : ℂ) + rho.im * I)).re +
            (logDeriv (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re := by
      have hpairSelected :
          (m - 1) * L + conjugateReciprocal - K * L ≤
            (logDeriv (DirichletCharacter.LFunction chi)
              ((sigma : ℂ) + rho.im * I)).re := by
        linarith only [hpairRaw, hreciprocal]
      have hpairFour :=
        mul_le_mul_of_nonneg_left hpairSelected (by norm_num : (0 : ℝ) ≤ 4)
      have hprincipalPair :
          -4 * conjugateReciprocal - 2 * J * L ≤
            (logDeriv (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re := by
        calc
          -4 * conjugateReciprocal - 2 * J * L =
              -(4 * conjugateReciprocal) - 2 * J * L := by ring
          _ ≤ -(a / (a ^ 2 + 4 * rho.im ^ 2)) - 2 * J * L :=
            sub_le_sub_right (neg_le_neg hpoleCancel) _
          _ = -a / (a ^ 2 + 4 * rho.im ^ 2) - 2 * J * L := by ring
          _ ≤ (logDeriv
              (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re :=
            hprincipalLower
      calc
        _ = 4 * ((m - 1) * L + conjugateReciprocal - K * L) +
            (-4 * conjugateReciprocal - 2 * J * L) := by ring
        _ ≤ 4 * (logDeriv (DirichletCharacter.LFunction chi)
              ((sigma : ℂ) + rho.im * I)).re +
            (logDeriv (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re :=
          add_le_add hpairFour hprincipalPair
    have hmLpositive : 0 < m * L := mul_pos hmpos hLpos
    have : 3 * m * L + 3 * C <
        (4 * m - 4 - 4 * K - 2 * J) * L := by
      have hstronger :
          3 * C < (m - 4 - 4 * K - 2 * J) * L := by
        calc
          3 * C < (m / 2 - 4 - 4 * K - 2 * J) * L := hmarginLog
          _ < (m - 4 - 4 * K - 2 * J) * L := by
            nlinarith only [hmLpositive]
      calc
        3 * m * L + 3 * C = 3 * C + 3 * m * L := by ring
        _ < (m - 4 - 4 * K - 2 * J) * L + 3 * m * L :=
          by simpa [add_comm] using
            (add_lt_add_right hstronger (3 * m * L))
        _ = (4 * m - 4 - 4 * K - 2 * J) * L := by ring
    exact (not_lt_of_ge hlower) (hupper.trans this)

end

section
open Complex

end

section
open Complex

attribute [local instance] inducingEulerProductConductorNeZero

end

section
open Complex

attribute [local instance] inducingEulerProductConductorNeZero
theorem exists_nat_nonprincipalNontrivialLFunctionZero_order_eq_one_of_sq_eq_one_of_im_eq_zero :
    ∃ M : ℕ, 2 ≤ M ∧
      ∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q) (rho : ℂ),
          chi ^ 2 = 1 →
            (chi ≠ 1 ∧
              DirichletCharacter.completedLFunction chi.primitiveCharacter rho = 0) →
              rho.im = 0 →
                1 - 1 / ((M : ℝ) ^ 2 *
                  Real.log ((q : ℝ) * (|rho.im| + 2))) ≤ rho.re →
                  analyticOrderNatAt
                    (DirichletCharacter.LFunction chi) rho = 1 := by
  obtain ⟨A, hA, hselected⟩ :=
    exists_nat_selectedNonprincipalNontrivialZeros_sum_sub_le_re_logDeriv_LFunction
  obtain ⟨B, hB, hprincipal⟩ :=
    exists_nat_neg_logDeriv_principal_LFunction_re_le_pole_add_log
  obtain ⟨C, hC, hzeta⟩ :=
    exists_pos_neg_logDeriv_riemannZeta_re_lt_inv_sub_one_add
  let K : ℝ := (16 * (A : ℝ) + 3) / 3
  let J : ℝ := 16 * (B : ℝ) + 1
  have hKpos : 0 < K := by dsimp [K]; positivity
  have hJpos : 0 < J := by dsimp [J]; positivity
  have hlogTwo : 0 < Real.log 2 := Real.log_pos one_lt_two
  let R : ℝ := 2 * (4 + 4 * K + 2 * J + 3 * C / Real.log 2)
  let D : ℝ := max 2 (max (1 / Real.log 2) R)
  obtain ⟨M, hM⟩ := exists_nat_gt D
  let m : ℝ := M
  have hmTwo : (2 : ℝ) < m := by
    dsimp [m]
    exact (le_max_left 2 (max (1 / Real.log 2) R)).trans_lt
      (by simpa [D] using hM)
  have hMtwo : 2 ≤ M := by
    have hcast : (2 : ℝ) ≤ (M : ℝ) := by simpa [m] using hmTwo.le
    exact_mod_cast hcast
  have hmInvLog : 1 / Real.log 2 < m := by
    dsimp [m]
    exact ((le_max_left (1 / Real.log 2) R).trans
      (le_max_right 2 _)).trans_lt (by simpa [D] using hM)
  have hmThreshold : R < m := by
    dsimp [m]
    exact ((le_max_right (1 / Real.log 2) R).trans
      (le_max_right 2 _)).trans_lt (by simpa [D] using hM)
  have hmLogTwo : 1 < m * Real.log 2 := by
    calc
      1 = (1 / Real.log 2) * Real.log 2 := by field_simp
      _ < m * Real.log 2 := mul_lt_mul_of_pos_right hmInvLog hlogTwo
  have hmargin :
      3 * C / Real.log 2 < m / 2 - 4 - 4 * K - 2 * J := by
    dsimp [R] at hmThreshold
    linarith
  refine ⟨M, hMtwo, ?_⟩
  intro q _ chi rho hsquare hrho hgamma hbeta
  by_contra horderNe
  let Q : ℝ := (q : ℝ) * (|rho.im| + 2)
  let L : ℝ := Real.log Q
  let a : ℝ := 1 / (m * L)
  let sigma : ℝ := 1 + a
  let x : ℝ := sigma - rho.re
  have hQtwo : (2 : ℝ) ≤ Q := by
    simpa [Q] using two_le_level_height (q := q) rho.im
  have hlogLower : Real.log 2 ≤ L := by
    dsimp [L]
    exact Real.log_le_log zero_lt_two hQtwo
  have hLpos : 0 < L := hlogTwo.trans_le hlogLower
  have hmpos : 0 < m := by linarith
  have hmLpos : 0 < m * L := mul_pos hmpos hLpos
  have hmLone : 1 < m * L :=
    hmLogTwo.trans_le (mul_le_mul_of_nonneg_left hlogLower hmpos.le)
  have haPos : 0 < a := by dsimp [a]; positivity
  have haLtOne : a < 1 := by
    dsimp [a]
    rw [one_div]
    exact (inv_lt_one₀ hmLpos).2 hmLone
  have hsigmaOne : 1 < sigma := by dsimp [sigma]; linarith
  have hsigmaTwo : sigma < 2 := by dsimp [sigma]; linarith
  obtain ⟨hchi, hzero, hrhoPos, hrhoOne⟩ :=
    (isNonprincipalNontrivialLFunctionZero_iff chi rho).1 hrho
  have hbeta' : 1 - 1 / (m ^ 2 * L) ≤ rho.re := by
    simpa only [m, L, Q] using hbeta
  have hreciprocal : (m - 1) * L ≤ x⁻¹ := by
    simpa [x, sigma, a] using mul_sub_one_le_inv_one_add_inv_sub
      (m := m) (L := L) (beta := rho.re) hmTwo.le hLpos
        hbeta' hrhoOne
  have horderOne := one_le_LFunction_order_of_nonprincipal_zero hrho
  have horderTwo :
      2 ≤ analyticOrderNatAt
        (DirichletCharacter.LFunction chi) rho :=
    (Nat.two_le_iff _).2
      ⟨Nat.one_le_iff_ne_zero.mp horderOne, horderNe⟩
  let Ztwo : ℂ →₀ ℕ := Finsupp.single rho 2
  have hZtwoSupport :
      ∀ z ∈ Ztwo.support,
        (chi ≠ 1 ∧
          DirichletCharacter.completedLFunction chi.primitiveCharacter z = 0) ∧
          |z.im - rho.im| ≤ 1 := by
    intro z hz
    rw [Finsupp.support_single rho (by norm_num : (2 : ℕ) ≠ 0)] at hz
    simp only [Finset.mem_singleton] at hz
    subst z
    exact ⟨hrho, by simp⟩
  have hZtwoMult :
      ∀ z : ℂ,
        Ztwo z ≤ analyticOrderNatAt
          (DirichletCharacter.LFunction chi) z := by
    intro z
    by_cases hz : z = rho
    · subst z
      simpa [Ztwo] using horderTwo
    · simp [Ztwo, hz]
  have htwoRaw := hselected q chi hchi rho.im sigma Ztwo
    hsigmaOne.le hsigmaTwo.le hZtwoSupport hZtwoMult
  have hZtwoSum :
      Ztwo.sum (fun z n =>
        (n : ℝ) * (((((sigma : ℂ) + rho.im * I) - z)⁻¹).re)) =
          2 * x⁻¹ := by
    calc
      _ = ((2 : ℕ) : ℝ) *
          (((((sigma : ℂ) + rho.im * I) - rho)⁻¹).re) := by
        dsimp [Ztwo]
        exact Finsupp.sum_single_index (a := rho) (b := 2)
          (h := fun (z : ℂ) (n : ℕ) =>
            (n : ℝ) * (((((sigma : ℂ) + rho.im * I) - z)⁻¹).re))
          (by norm_num)
      _ = 2 * x⁻¹ := by rw [Nat.cast_ofNat, re_inv_same_height]
  change Ztwo.sum (fun z n =>
      (n : ℝ) * (((((sigma : ℂ) + rho.im * I) - z)⁻¹).re)) -
      (16 * (A : ℝ) + 3) * L / 3 ≤
    (logDeriv (DirichletCharacter.LFunction chi)
      ((sigma : ℂ) + rho.im * I)).re at htwoRaw
  have hresidual : (16 * (A : ℝ) + 3) * L / 3 = K * L := by
    dsimp [K]
    ring
  rw [hZtwoSum, hresidual] at htwoRaw
  have hchiLower :
      2 * (m - 1) * L - K * L ≤
        (logDeriv (DirichletCharacter.LFunction chi)
          ((sigma : ℂ) + rho.im * I)).re := by
    linarith
  let sTwo : ℂ := (sigma : ℂ) + (2 * rho.im : ℝ) * I
  have hsTwoNe : sTwo ≠ 1 := by
    intro heq
    have hre := congrArg Complex.re heq
    simp [sTwo] at hre
    linarith
  have hprincipalRaw := hprincipal q sTwo
    (by simpa [sTwo] using hsigmaOne.le)
    (by simpa [sTwo] using hsigmaTwo.le) hsTwoNe
  have hsTwoSub : sTwo - 1 =
      (a : ℂ) + (2 * rho.im : ℝ) * I := by
    apply Complex.ext <;> simp [sTwo, sigma]
  have hpoleRe : ((sTwo - 1)⁻¹).re = m * L := by
    rw [hsTwoSub, re_inv_add_two_mul_I, hgamma]
    norm_num
    dsimp [a]
    field_simp [hmpos.ne', hLpos.ne']
  have hdoubleLog :
      Real.log ((q : ℝ) * (|2 * rho.im| + 2)) ≤ 2 * L := by
    simpa [L, Q] using log_doubled_height_le_two_mul_log (q := q) rho.im
  have hsTwoIm : sTwo.im = 2 * rho.im := by simp [sTwo]
  have hprincipalLower :
      -m * L - 2 * J * L ≤
        (logDeriv (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re := by
    have hraw :
        (-logDeriv (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re ≤
          ((sTwo - 1)⁻¹).re +
            J * Real.log ((q : ℝ) * (|2 * rho.im| + 2)) := by
      simpa [hsquare, J, hsTwoIm] using hprincipalRaw
    rw [hpoleRe] at hraw
    simp only [Complex.neg_re] at hraw
    have hJlog := mul_le_mul_of_nonneg_left hdoubleLog hJpos.le
    calc
      -m * L - 2 * J * L ≤
          -m * L -
            J * Real.log ((q : ℝ) * (|2 * rho.im| + 2)) := by
        nlinarith only [hJlog]
      _ ≤ (logDeriv
          (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re := by
        linarith only [hraw]
  have hphase := three_four_one_zeta_neg_logDeriv_LFunction_nonneg
    chi hsigmaOne rho.im
  have hevalOne :
      (sigma : ℂ) + I * rho.im = (sigma : ℂ) + rho.im * I := by ring
  have hevalTwo :
      (sigma : ℂ) + I * (2 * rho.im : ℝ) = sTwo := by
    dsimp [sTwo]
    ring
  rw [hevalOne, hevalTwo] at hphase
  simp only [Complex.neg_re] at hphase
  have hpoleSigma : (sigma - 1)⁻¹ = m * L := by
    have heq : sigma - 1 = (m * L)⁻¹ := by
      dsimp [sigma, a]
      rw [one_div]
      ring
    rw [heq, inv_inv]
  have hzetaBound := hzeta sigma hsigmaOne hsigmaTwo
  rw [hpoleSigma] at hzetaBound
  have hzetaBound' :
      -(logDeriv riemannZeta (sigma : ℂ)).re < m * L + C := by
    simpa only [Complex.neg_re] using hzetaBound
  have hupper :
      4 * (logDeriv (DirichletCharacter.LFunction chi)
          ((sigma : ℂ) + rho.im * I)).re +
        (logDeriv (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re <
          3 * m * L + 3 * C := by
    have hphaseUpper :
        4 * (logDeriv (DirichletCharacter.LFunction chi)
            ((sigma : ℂ) + rho.im * I)).re +
          (logDeriv (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re ≤
            3 * (-(logDeriv riemannZeta (sigma : ℂ)).re) := by
      linarith only [hphase]
    calc
      _ ≤ 3 * (-(logDeriv riemannZeta (sigma : ℂ)).re) := hphaseUpper
      _ < 3 * (m * L + C) :=
        mul_lt_mul_of_pos_left hzetaBound' (by norm_num)
      _ = 3 * m * L + 3 * C := by ring
  have hmarginPos : 0 < m / 2 - 4 - 4 * K - 2 * J :=
    (div_pos (mul_pos (by norm_num) hC) hlogTwo).trans hmargin
  have hmarginLog :
      3 * C < (m / 2 - 4 - 4 * K - 2 * J) * L := by
    calc
      3 * C = (3 * C / Real.log 2) * Real.log 2 := by field_simp
      _ < (m / 2 - 4 - 4 * K - 2 * J) * Real.log 2 :=
        mul_lt_mul_of_pos_right hmargin hlogTwo
      _ ≤ (m / 2 - 4 - 4 * K - 2 * J) * L :=
        mul_le_mul_of_nonneg_left hlogLower hmarginPos.le
  have hlower :
      (7 * m - 8 - 4 * K - 2 * J) * L ≤
        4 * (logDeriv (DirichletCharacter.LFunction chi)
            ((sigma : ℂ) + rho.im * I)).re +
          (logDeriv (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re := by
    nlinarith only [hchiLower, hprincipalLower]
  have hstrict :
      3 * m * L + 3 * C <
        (7 * m - 8 - 4 * K - 2 * J) * L := by
    nlinarith only [hmarginLog, hmTwo, hLpos]
  exact (not_lt_of_ge hlower) (hupper.trans hstrict)

end

section SquarePrincipalRealSimple
theorem near_one_of_le
    {m M : ℕ} {L beta : ℝ} (hm : 1 ≤ m) (hmM : m ≤ M)
    (hL : 0 < L)
    (hnear : 1 - 1 / ((M : ℝ) ^ 2 * L) ≤ beta) :
    1 - 1 / ((m : ℝ) ^ 2 * L) ≤ beta := by
  have hmpos : (0 : ℝ) < m := by exact_mod_cast hm
  refine le_trans ?_ hnear
  gcongr

end SquarePrincipalRealSimple

section

attribute [local instance] inducingEulerProductConductorNeZero
theorem exists_nat_nonprincipalNontrivialLFunctionZero_real_simple_of_sq_eq_one :
    ∃ M : ℕ, 2 ≤ M ∧
      ∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q) (rho : ℂ),
          chi ^ 2 = 1 →
            (chi ≠ 1 ∧
              DirichletCharacter.completedLFunction chi.primitiveCharacter rho = 0) →
              1 - 1 / ((M : ℝ) ^ 2 *
                Real.log ((q : ℝ) * (|rho.im| + 2))) ≤ rho.re →
                rho.im = 0 ∧
                  analyticOrderNatAt
                    (DirichletCharacter.LFunction chi) rho = 1 := by
  obtain ⟨Mnonreal, hMnonreal, hnonreal⟩ :=
    exists_nat_nonprincipalNontrivialLFunctionZero_im_eq_zero_of_sq_eq_one
  obtain ⟨Msimple, hMsimple, hsimple⟩ :=
    exists_nat_nonprincipalNontrivialLFunctionZero_order_eq_one_of_sq_eq_one_of_im_eq_zero
  let M := max Mnonreal Msimple
  have hMtwo : 2 ≤ M := hMnonreal.trans (le_max_left _ _)
  refine ⟨M, hMtwo, ?_⟩
  intro q _ chi rho hsquare hrho hnear
  let L : ℝ := Real.log ((q : ℝ) * (|rho.im| + 2))
  have hscale : (2 : ℝ) ≤ (q : ℝ) * (|rho.im| + 2) :=
    two_le_level_height (q := q) rho.im
  have hLpos : 0 < L := by
    dsimp [L]
    exact (Real.log_pos one_lt_two).trans_le
      (Real.log_le_log zero_lt_two hscale)
  have hnearNonreal :
      1 - 1 / ((Mnonreal : ℝ) ^ 2 * L) ≤ rho.re := by
    apply near_one_of_le (one_le_two.trans hMnonreal) (le_max_left _ _) hLpos
    simpa only [M, L] using hnear
  have him := hnonreal q chi rho hsquare hrho
    (by simpa only [L] using hnearNonreal)
  have hnearSimple :
      1 - 1 / ((Msimple : ℝ) ^ 2 * L) ≤ rho.re := by
    apply near_one_of_le (one_le_two.trans hMsimple) (le_max_right _ _) hLpos
    simpa only [M, L] using hnear
  exact ⟨him, hsimple q chi rho hsquare hrho him
    (by simpa only [L] using hnearSimple)⟩

end

section
open Complex

end

section
open Complex

attribute [local instance] inducingEulerProductConductorNeZero

end

section
open Complex

attribute [local instance] inducingEulerProductConductorNeZero
theorem exists_nat_nonprincipalNontrivialLFunctionZero_eq_of_sq_eq_one_of_im_eq_zero :
    ∃ M : ℕ, 2 ≤ M ∧
      ∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q) (rho1 rho2 : ℂ),
          chi ^ 2 = 1 →
            (chi ≠ 1 ∧
              DirichletCharacter.completedLFunction chi.primitiveCharacter rho1 = 0) →
              (chi ≠ 1 ∧
                DirichletCharacter.completedLFunction chi.primitiveCharacter rho2 = 0) →
                rho1.im = 0 →
                  rho2.im = 0 →
                    1 - 1 / ((M : ℝ) ^ 2 *
                      Real.log ((q : ℝ) * (|rho1.im| + 2))) ≤ rho1.re →
                      1 - 1 / ((M : ℝ) ^ 2 *
                        Real.log ((q : ℝ) * (|rho2.im| + 2))) ≤ rho2.re →
                        rho1 = rho2 := by
  obtain ⟨A, hA, hselected⟩ :=
    exists_nat_selectedNonprincipalNontrivialZeros_sum_sub_le_re_logDeriv_LFunction
  obtain ⟨B, hB, hprincipal⟩ :=
    exists_nat_neg_logDeriv_principal_LFunction_re_le_pole_add_log
  obtain ⟨C, hC, hzeta⟩ :=
    exists_pos_neg_logDeriv_riemannZeta_re_lt_inv_sub_one_add
  let K : ℝ := (16 * (A : ℝ) + 3) / 3
  let J : ℝ := 16 * (B : ℝ) + 1
  have hKpos : 0 < K := by dsimp [K]; positivity
  have hJpos : 0 < J := by dsimp [J]; positivity
  have hlogTwo : 0 < Real.log 2 := Real.log_pos one_lt_two
  let R : ℝ := 2 * (4 + 4 * K + 2 * J + 3 * C / Real.log 2)
  let D : ℝ := max 2 (max (1 / Real.log 2) R)
  obtain ⟨M, hM⟩ := exists_nat_gt D
  let m : ℝ := M
  have hmTwo : (2 : ℝ) < m := by
    dsimp [m]
    exact (le_max_left 2 (max (1 / Real.log 2) R)).trans_lt
      (by simpa [D] using hM)
  have hMtwo : 2 ≤ M := by
    have hcast : (2 : ℝ) ≤ (M : ℝ) := by simpa [m] using hmTwo.le
    exact_mod_cast hcast
  have hmInvLog : 1 / Real.log 2 < m := by
    dsimp [m]
    exact ((le_max_left (1 / Real.log 2) R).trans
      (le_max_right 2 _)).trans_lt (by simpa [D] using hM)
  have hmThreshold : R < m := by
    dsimp [m]
    exact ((le_max_right (1 / Real.log 2) R).trans
      (le_max_right 2 _)).trans_lt (by simpa [D] using hM)
  have hmLogTwo : 1 < m * Real.log 2 := by
    calc
      1 = (1 / Real.log 2) * Real.log 2 := by field_simp
      _ < m * Real.log 2 := mul_lt_mul_of_pos_right hmInvLog hlogTwo
  have hmargin :
      3 * C / Real.log 2 < m / 2 - 4 - 4 * K - 2 * J := by
    dsimp [R] at hmThreshold
    linarith
  refine ⟨M, hMtwo, ?_⟩
  intro q _ chi rho1 rho2 hsquare hrho1 hrho2 him1 him2 hbeta1 hbeta2
  by_contra hdistinct
  let Q : ℝ := (q : ℝ) * (|rho1.im| + 2)
  let L : ℝ := Real.log Q
  let a : ℝ := 1 / (m * L)
  let sigma : ℝ := 1 + a
  let x1 : ℝ := sigma - rho1.re
  let x2 : ℝ := sigma - rho2.re
  have hQtwo : (2 : ℝ) ≤ Q := by
    simpa [Q] using two_le_level_height (q := q) rho1.im
  have hlogLower : Real.log 2 ≤ L := by
    dsimp [L]
    exact Real.log_le_log zero_lt_two hQtwo
  have hLpos : 0 < L := hlogTwo.trans_le hlogLower
  have hmpos : 0 < m := by linarith
  have hmLpos : 0 < m * L := mul_pos hmpos hLpos
  have hmLone : 1 < m * L :=
    hmLogTwo.trans_le (mul_le_mul_of_nonneg_left hlogLower hmpos.le)
  have haPos : 0 < a := by dsimp [a]; positivity
  have haLtOne : a < 1 := by
    dsimp [a]
    rw [one_div]
    exact (inv_lt_one₀ hmLpos).2 hmLone
  have hsigmaOne : 1 < sigma := by dsimp [sigma]; linarith
  have hsigmaTwo : sigma < 2 := by dsimp [sigma]; linarith
  obtain ⟨hchi, _, _, hrho1One⟩ :=
    (isNonprincipalNontrivialLFunctionZero_iff chi rho1).1 hrho1
  obtain ⟨_, _, _, hrho2One⟩ :=
    (isNonprincipalNontrivialLFunctionZero_iff chi rho2).1 hrho2
  have hbeta1' : 1 - 1 / (m ^ 2 * L) ≤ rho1.re := by
    simpa only [m, L, Q] using hbeta1
  have hbeta2' : 1 - 1 / (m ^ 2 * L) ≤ rho2.re := by
    simpa only [m, L, Q, him1, him2, abs_zero] using hbeta2
  have hreciprocal1 : (m - 1) * L ≤ x1⁻¹ := by
    simpa [x1, sigma, a] using mul_sub_one_le_inv_one_add_inv_sub
      (m := m) (L := L) (beta := rho1.re) hmTwo.le hLpos
        hbeta1' hrho1One
  have hreciprocal2 : (m - 1) * L ≤ x2⁻¹ := by
    simpa [x2, sigma, a] using mul_sub_one_le_inv_one_add_inv_sub
      (m := m) (L := L) (beta := rho2.re) hmTwo.le hLpos
        hbeta2' hrho2One
  let Zpair : ℂ →₀ ℕ :=
    Finsupp.single rho1 1 + Finsupp.single rho2 1
  have hlocal : |rho2.im - rho1.im| ≤ 1 := by simp [him1, him2]
  have hZpairSupport :
      ∀ z ∈ Zpair.support,
        (chi ≠ 1 ∧
          DirichletCharacter.completedLFunction chi.primitiveCharacter z = 0) ∧
          |z.im - rho1.im| ≤ 1 := by
    intro z hz
    rw [Finsupp.support_single_add_single hdistinct one_ne_zero one_ne_zero] at hz
    simp only [Finset.mem_insert, Finset.mem_singleton] at hz
    rcases hz with rfl | rfl
    · exact ⟨hrho1, by simp⟩
    · exact ⟨hrho2, hlocal⟩
  have horder1 := one_le_LFunction_order_of_nonprincipal_zero hrho1
  have horder2 := one_le_LFunction_order_of_nonprincipal_zero hrho2
  have hZpairMult :
      ∀ z : ℂ,
        Zpair z ≤ analyticOrderNatAt
          (DirichletCharacter.LFunction chi) z := by
    intro z
    by_cases hz1 : z = rho1
    · subst z
      simpa [Zpair, hdistinct, Ne.symm hdistinct] using horder1
    · by_cases hz2 : z = rho2
      · subst z
        simpa [Zpair, hdistinct, Ne.symm hdistinct] using horder2
      · simp [Zpair, hz1, hz2]
  have hpairRaw := hselected q chi hchi rho1.im sigma Zpair
    hsigmaOne.le hsigmaTwo.le hZpairSupport hZpairMult
  have hsameHeight : rho1.im = rho2.im := him1.trans him2.symm
  have hZpairSum :
      Zpair.sum (fun z n =>
        (n : ℝ) * (((((sigma : ℂ) + rho1.im * I) - z)⁻¹).re)) =
          x1⁻¹ + x2⁻¹ := by
    dsimp [Zpair]
    rw [Finsupp.sum_single_add_single rho1 rho2 1 1 _ hdistinct]
    · simp only [Nat.cast_one, one_mul]
      rw [re_inv_same_height, hsameHeight, re_inv_same_height]
    · intro z
      simp
  change Zpair.sum (fun z n =>
      (n : ℝ) * (((((sigma : ℂ) + rho1.im * I) - z)⁻¹).re)) -
      (16 * (A : ℝ) + 3) * L / 3 ≤
    (logDeriv (DirichletCharacter.LFunction chi)
      ((sigma : ℂ) + rho1.im * I)).re at hpairRaw
  have hresidual : (16 * (A : ℝ) + 3) * L / 3 = K * L := by
    dsimp [K]
    ring
  rw [hZpairSum, hresidual] at hpairRaw
  have hchiLower :
      2 * (m - 1) * L - K * L ≤
        (logDeriv (DirichletCharacter.LFunction chi)
          ((sigma : ℂ) + rho1.im * I)).re := by
    linarith only [hpairRaw, hreciprocal1, hreciprocal2]
  let sTwo : ℂ := (sigma : ℂ) + (2 * rho1.im : ℝ) * I
  have hsTwoNe : sTwo ≠ 1 := by
    intro heq
    have hre := congrArg Complex.re heq
    simp [sTwo] at hre
    linarith
  have hprincipalRaw := hprincipal q sTwo
    (by simpa [sTwo] using hsigmaOne.le)
    (by simpa [sTwo] using hsigmaTwo.le) hsTwoNe
  have hsTwoSub : sTwo - 1 =
      (a : ℂ) + (2 * rho1.im : ℝ) * I := by
    apply Complex.ext <;> simp [sTwo, sigma]
  have hpoleRe : ((sTwo - 1)⁻¹).re = m * L := by
    rw [hsTwoSub, re_inv_add_two_mul_I, him1]
    norm_num
    dsimp [a]
    field_simp [hmpos.ne', hLpos.ne']
  have hdoubleLog :
      Real.log ((q : ℝ) * (|2 * rho1.im| + 2)) ≤ 2 * L := by
    simpa [L, Q] using log_doubled_height_le_two_mul_log (q := q) rho1.im
  have hsTwoIm : sTwo.im = 2 * rho1.im := by simp [sTwo]
  have hprincipalLower :
      -m * L - 2 * J * L ≤
        (logDeriv (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re := by
    have hraw :
        (-logDeriv (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re ≤
          ((sTwo - 1)⁻¹).re +
            J * Real.log ((q : ℝ) * (|2 * rho1.im| + 2)) := by
      simpa [hsquare, J, hsTwoIm] using hprincipalRaw
    rw [hpoleRe] at hraw
    simp only [Complex.neg_re] at hraw
    have hJlog := mul_le_mul_of_nonneg_left hdoubleLog hJpos.le
    calc
      -m * L - 2 * J * L ≤
          -m * L - J * Real.log ((q : ℝ) * (|2 * rho1.im| + 2)) := by
        nlinarith only [hJlog]
      _ ≤ (logDeriv
          (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re := by
        linarith only [hraw]
  have hphase := three_four_one_zeta_neg_logDeriv_LFunction_nonneg
    chi hsigmaOne rho1.im
  have hevalOne :
      (sigma : ℂ) + I * rho1.im = (sigma : ℂ) + rho1.im * I := by ring
  have hevalTwo :
      (sigma : ℂ) + I * (2 * rho1.im : ℝ) = sTwo := by
    dsimp [sTwo]
    ring
  rw [hevalOne, hevalTwo] at hphase
  simp only [Complex.neg_re] at hphase
  have hpoleSigma : (sigma - 1)⁻¹ = m * L := by
    have heq : sigma - 1 = (m * L)⁻¹ := by
      dsimp [sigma, a]
      rw [one_div]
      ring
    rw [heq, inv_inv]
  have hzetaBound := hzeta sigma hsigmaOne hsigmaTwo
  rw [hpoleSigma] at hzetaBound
  have hzetaBound' :
      -(logDeriv riemannZeta (sigma : ℂ)).re < m * L + C := by
    simpa only [Complex.neg_re] using hzetaBound
  have hupper :
      4 * (logDeriv (DirichletCharacter.LFunction chi)
          ((sigma : ℂ) + rho1.im * I)).re +
        (logDeriv (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re <
          3 * m * L + 3 * C := by
    have hphaseUpper :
        4 * (logDeriv (DirichletCharacter.LFunction chi)
            ((sigma : ℂ) + rho1.im * I)).re +
          (logDeriv (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re ≤
            3 * (-(logDeriv riemannZeta (sigma : ℂ)).re) := by
      linarith only [hphase]
    calc
      _ ≤ 3 * (-(logDeriv riemannZeta (sigma : ℂ)).re) := hphaseUpper
      _ < 3 * (m * L + C) :=
        mul_lt_mul_of_pos_left hzetaBound' (by norm_num)
      _ = 3 * m * L + 3 * C := by ring
  have hmarginPos : 0 < m / 2 - 4 - 4 * K - 2 * J :=
    (div_pos (mul_pos (by norm_num) hC) hlogTwo).trans hmargin
  have hmarginLog :
      3 * C < (m / 2 - 4 - 4 * K - 2 * J) * L := by
    calc
      3 * C = (3 * C / Real.log 2) * Real.log 2 := by field_simp
      _ < (m / 2 - 4 - 4 * K - 2 * J) * Real.log 2 :=
        mul_lt_mul_of_pos_right hmargin hlogTwo
      _ ≤ (m / 2 - 4 - 4 * K - 2 * J) * L :=
        mul_le_mul_of_nonneg_left hlogLower hmarginPos.le
  have hlower :
      (7 * m - 8 - 4 * K - 2 * J) * L ≤
        4 * (logDeriv (DirichletCharacter.LFunction chi)
            ((sigma : ℂ) + rho1.im * I)).re +
          (logDeriv (DirichletCharacter.LFunction (chi ^ 2)) sTwo).re := by
    nlinarith only [hchiLower, hprincipalLower]
  have hstrict :
      3 * m * L + 3 * C <
        (7 * m - 8 - 4 * K - 2 * J) * L := by
    nlinarith only [hmarginLog, hmTwo, hLpos]
  exact (not_lt_of_ge hlower) (hupper.trans hstrict)

end

section

attribute [local instance] inducingEulerProductConductorNeZero
theorem exists_nat_nonprincipalNontrivialLFunctionZero_eq_of_sq_eq_one :
    ∃ M : ℕ, 2 ≤ M ∧
      ∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q) (rho1 rho2 : ℂ),
          chi ^ 2 = 1 →
            (chi ≠ 1 ∧
              DirichletCharacter.completedLFunction chi.primitiveCharacter rho1 = 0) →
              (chi ≠ 1 ∧
                DirichletCharacter.completedLFunction chi.primitiveCharacter rho2 = 0) →
                1 - 1 / ((M : ℝ) ^ 2 *
                  Real.log ((q : ℝ) * (|rho1.im| + 2))) ≤ rho1.re →
                  1 - 1 / ((M : ℝ) ^ 2 *
                    Real.log ((q : ℝ) * (|rho2.im| + 2))) ≤ rho2.re →
                    rho1 = rho2 := by
  obtain ⟨Mreal, hMreal, hreal⟩ :=
    exists_nat_nonprincipalNontrivialLFunctionZero_real_simple_of_sq_eq_one
  obtain ⟨Mpair, hMpair, hpair⟩ :=
    exists_nat_nonprincipalNontrivialLFunctionZero_eq_of_sq_eq_one_of_im_eq_zero
  let M := max Mreal Mpair
  have hMtwo : 2 ≤ M := hMreal.trans (le_max_left _ _)
  refine ⟨M, hMtwo, ?_⟩
  intro q _ chi rho1 rho2 hsquare hrho1 hrho2 hnear1 hnear2
  let L1 : ℝ := Real.log ((q : ℝ) * (|rho1.im| + 2))
  let L2 : ℝ := Real.log ((q : ℝ) * (|rho2.im| + 2))
  have hL1pos : 0 < L1 := by
    dsimp [L1]
    exact (Real.log_pos one_lt_two).trans_le
      (Real.log_le_log zero_lt_two (two_le_level_height (q := q) rho1.im))
  have hL2pos : 0 < L2 := by
    dsimp [L2]
    exact (Real.log_pos one_lt_two).trans_le
      (Real.log_le_log zero_lt_two (two_le_level_height (q := q) rho2.im))
  have hnearReal1 : 1 - 1 / ((Mreal : ℝ) ^ 2 * L1) ≤ rho1.re := by
    apply near_one_of_le (one_le_two.trans hMreal) (le_max_left _ _) hL1pos
    simpa only [M, L1] using hnear1
  have hnearReal2 : 1 - 1 / ((Mreal : ℝ) ^ 2 * L2) ≤ rho2.re := by
    apply near_one_of_le (one_le_two.trans hMreal) (le_max_left _ _) hL2pos
    simpa only [M, L2] using hnear2
  have him1 := (hreal q chi rho1 hsquare hrho1
    (by simpa only [L1] using hnearReal1)).1
  have him2 := (hreal q chi rho2 hsquare hrho2
    (by simpa only [L2] using hnearReal2)).1
  have hnearPair1 : 1 - 1 / ((Mpair : ℝ) ^ 2 * L1) ≤ rho1.re := by
    apply near_one_of_le (one_le_two.trans hMpair) (le_max_right _ _) hL1pos
    simpa only [M, L1] using hnear1
  have hnearPair2 : 1 - 1 / ((Mpair : ℝ) ^ 2 * L2) ≤ rho2.re := by
    apply near_one_of_le (one_le_two.trans hMpair) (le_max_right _ _) hL2pos
    simpa only [M, L2] using hnear2
  exact hpair q chi rho1 rho2 hsquare hrho1 hrho2 him1 him2
    (by simpa only [L1] using hnearPair1)
    (by simpa only [L2] using hnearPair2)

end

section
open ArithmeticFunction Complex

section CrossCharacterPositivity
theorem four_factor_character_phase_nonneg
    {N n : ℕ} (chi1 chi2 : DirichletCharacter ℂ N)
    (hsquare1 : chi1 ^ 2 = 1) (hsquare2 : chi2 ^ 2 = 1) :
    0 ≤ ((1 : DirichletCharacter ℂ N) n).re + (chi1 n).re +
      (chi2 n).re + ((chi1 * chi2) n).re := by
  by_cases hunit : IsUnit (n : ZMod N)
  · have hsq1 : chi1 n ^ 2 = 1 := by
      rw [← chi1.pow_apply' two_ne_zero, hsquare1,
        MulChar.one_apply hunit]
    have hsq2 : chi2 n ^ 2 = 1 := by
      rw [← chi2.pow_apply' two_ne_zero, hsquare2,
        MulChar.one_apply hunit]
    rcases sq_eq_one_iff.mp hsq1 with h1 | h1 <;>
      rcases sq_eq_one_iff.mp hsq2 with h2 | h2 <;>
      rw [MulChar.one_apply hunit, MulChar.mul_apply, h1, h2] <;>
      norm_num
  · simp [MulChar.map_nonunit, hunit]

theorem four_factor_neg_logDeriv_LSeries_nonneg
    {N : ℕ} (chi1 chi2 : DirichletCharacter ℂ N)
    (hsquare1 : chi1 ^ 2 = 1) (hsquare2 : chi2 ^ 2 = 1)
    {sigma : ℝ} (hsigma : 1 < sigma) :
    0 ≤ (-logDeriv (LSeries (fun n : ℕ =>
        (1 : DirichletCharacter ℂ N) n)) (sigma : ℂ)).re +
      (-logDeriv (LSeries (fun n : ℕ => chi1 n)) (sigma : ℂ)).re +
      (-logDeriv (LSeries (fun n : ℕ => chi2 n)) (sigma : ℂ)).re +
      (-logDeriv (LSeries (fun n : ℕ => (chi1 * chi2) n))
        (sigma : ℂ)).re := by
  have hseries (chi : DirichletCharacter ℂ N) :
      (-logDeriv (LSeries (fun n : ℕ => chi n)) (sigma : ℂ)).re =
        ∑' n : ℕ, vonMangoldt n * (n : ℝ) ^ (-sigma) *
          (chi n).re := by
    simpa using re_neg_logDeriv_LSeries_eq_phase_tsum chi hsigma 0
  rw [hseries (1 : DirichletCharacter ℂ N), hseries chi1,
    hseries chi2, hseries (chi1 * chi2)]
  have hsum (chi : DirichletCharacter ℂ N) :
      Summable fun n : ℕ =>
        vonMangoldt n * (n : ℝ) ^ (-sigma) * (chi n).re := by
    simpa using
      summable_vonMangoldt_rpow_mul_character_phase chi hsigma 0
  rw [← (hsum (1 : DirichletCharacter ℂ N)).tsum_add (hsum chi1),
    ← ((hsum (1 : DirichletCharacter ℂ N)).add (hsum chi1)).tsum_add
      (hsum chi2),
    ← (((hsum (1 : DirichletCharacter ℂ N)).add (hsum chi1)).add
      (hsum chi2)).tsum_add (hsum (chi1 * chi2))]
  refine tsum_nonneg fun n => ?_
  have hweight : 0 ≤ vonMangoldt n * (n : ℝ) ^ (-sigma) :=
    mul_nonneg vonMangoldt_nonneg (Real.rpow_nonneg (Nat.cast_nonneg n) _)
  have hphase :=
    four_factor_character_phase_nonneg chi1 chi2 hsquare1 hsquare2 (n := n)
  calc
    0 ≤ (vonMangoldt n * (n : ℝ) ^ (-sigma)) *
        (((1 : DirichletCharacter ℂ N) n).re + (chi1 n).re +
          (chi2 n).re + ((chi1 * chi2) n).re) :=
      mul_nonneg hweight hphase
    _ = vonMangoldt n * (n : ℝ) ^ (-sigma) *
          ((1 : DirichletCharacter ℂ N) n).re +
        vonMangoldt n * (n : ℝ) ^ (-sigma) * (chi1 n).re +
        vonMangoldt n * (n : ℝ) ^ (-sigma) * (chi2 n).re +
        vonMangoldt n * (n : ℝ) ^ (-sigma) *
          ((chi1 * chi2) n).re := by ring

theorem four_factor_zeta_neg_logDeriv_LSeries_nonneg
    {N : ℕ} (chi1 chi2 : DirichletCharacter ℂ N)
    (hsquare1 : chi1 ^ 2 = 1) (hsquare2 : chi2 ^ 2 = 1)
    {sigma : ℝ} (hsigma : 1 < sigma) :
    0 ≤ (-logDeriv riemannZeta (sigma : ℂ)).re +
      (-logDeriv (LSeries (fun n : ℕ => chi1 n)) (sigma : ℂ)).re +
      (-logDeriv (LSeries (fun n : ℕ => chi2 n)) (sigma : ℂ)).re +
      (-logDeriv (LSeries (fun n : ℕ => (chi1 * chi2) n))
        (sigma : ℂ)).re := by
  have hpos := four_factor_neg_logDeriv_LSeries_nonneg
    chi1 chi2 hsquare1 hsquare2 hsigma
  have hle := neg_logDeriv_principal_LSeries_re_le_riemannZeta
    (N := N) hsigma
  linarith

theorem four_factor_zeta_neg_logDeriv_LFunction_nonneg
    {N : ℕ} [NeZero N]
    (chi1 chi2 : DirichletCharacter ℂ N)
    (hsquare1 : chi1 ^ 2 = 1) (hsquare2 : chi2 ^ 2 = 1)
    {sigma : ℝ} (hsigma : 1 < sigma) :
    0 ≤ (-logDeriv riemannZeta (sigma : ℂ)).re +
      (-logDeriv (DirichletCharacter.LFunction chi1) (sigma : ℂ)).re +
      (-logDeriv (DirichletCharacter.LFunction chi2) (sigma : ℂ)).re +
      (-logDeriv (DirichletCharacter.LFunction (chi1 * chi2))
        (sigma : ℂ)).re := by
  rw [neg_logDeriv_LFunction_eq_LSeries chi1 (by simpa using hsigma),
    neg_logDeriv_LFunction_eq_LSeries chi2 (by simpa using hsigma),
    neg_logDeriv_LFunction_eq_LSeries (chi1 * chi2)
      (by simpa using hsigma)]
  exact four_factor_zeta_neg_logDeriv_LSeries_nonneg
    chi1 chi2 hsquare1 hsquare2 hsigma

end CrossCharacterPositivity

theorem four_factor_logDeriv_le_neg_logDeriv_riemannZeta
    {q : ℕ} [NeZero q]
    (chi1 chi2 : DirichletCharacter ℂ q)
    (hsquare1 : chi1 ^ 2 = 1) (hsquare2 : chi2 ^ 2 = 1)
    {sigma : ℝ} (hsigma : 1 < sigma) :
    (logDeriv (DirichletCharacter.LFunction chi1) (sigma : ℂ)).re +
        (logDeriv (DirichletCharacter.LFunction chi2) (sigma : ℂ)).re +
          (logDeriv (DirichletCharacter.LFunction (chi1 * chi2))
            (sigma : ℂ)).re ≤
      (-logDeriv riemannZeta (sigma : ℂ)).re := by
  have hpos := four_factor_zeta_neg_logDeriv_LFunction_nonneg
    chi1 chi2 hsquare1 hsquare2 hsigma
  simp only [Complex.neg_re] at hpos ⊢
  linarith

end

section
open Complex

section SquarePrincipalCharacterUniqueness

theorem mul_ne_one_of_sq_eq_one_of_ne
    {q : ℕ} {chi1 chi2 : DirichletCharacter ℂ q}
    (hsquare1 : chi1 ^ 2 = 1) (hne : chi1 ≠ chi2) :
    chi1 * chi2 ≠ 1 := by
  intro hproduct
  have hself : chi1⁻¹ = chi1 :=
    inv_eq_of_mul_eq_one_right (by simpa [pow_two] using hsquare1)
  have hother : chi1⁻¹ = chi2 := inv_eq_of_mul_eq_one_right hproduct
  exact hne (hself.symm.trans hother)

end SquarePrincipalCharacterUniqueness
end

section
open Complex

attribute [local instance] inducingEulerProductConductorNeZero

end

section
open Complex

attribute [local instance] inducingEulerProductConductorNeZero
theorem exists_nat_nonprincipalNontrivialLFunctionZero_character_eq_of_sq_eq_one_of_im_eq_zero :
    ∃ M : ℕ, 2 ≤ M ∧
      ∀ (q : ℕ) [NeZero q]
        (chi1 chi2 : DirichletCharacter ℂ q) (rho1 rho2 : ℂ),
          chi1 ^ 2 = 1 →
            chi2 ^ 2 = 1 →
              (chi1 ≠ 1 ∧
                DirichletCharacter.completedLFunction chi1.primitiveCharacter rho1 = 0) →
                (chi2 ≠ 1 ∧
                  DirichletCharacter.completedLFunction chi2.primitiveCharacter rho2 = 0) →
                  rho1.im = 0 →
                    rho2.im = 0 →
                      1 - 1 / ((M : ℝ) ^ 2 *
                        Real.log ((q : ℝ) * (|rho1.im| + 2))) ≤ rho1.re →
                        1 - 1 / ((M : ℝ) ^ 2 *
                          Real.log ((q : ℝ) * (|rho2.im| + 2))) ≤ rho2.re →
                          chi1 = chi2 := by
  obtain ⟨A, _, hselected⟩ :=
    exists_nat_selectedNonprincipalNontrivialZeros_sum_sub_le_re_logDeriv_LFunction
  obtain ⟨C, hC, hzeta⟩ :=
    exists_pos_neg_logDeriv_riemannZeta_re_lt_inv_sub_one_add
  let K : ℝ := (16 * (A : ℝ) + 3) / 3
  have hlogTwo : 0 < Real.log 2 := Real.log_pos one_lt_two
  let R : ℝ := 2 + 3 * K + C / Real.log 2
  let D : ℝ := max 2 (max (1 / Real.log 2) R)
  obtain ⟨M, hM⟩ := exists_nat_gt D
  let m : ℝ := M
  have hmTwo : (2 : ℝ) < m := by
    dsimp [m]
    exact (le_max_left 2 (max (1 / Real.log 2) R)).trans_lt
      (by simpa [D] using hM)
  have hMtwo : 2 ≤ M := by
    have hcast : (2 : ℝ) ≤ (M : ℝ) := by simpa [m] using hmTwo.le
    exact_mod_cast hcast
  have hmInvLog : 1 / Real.log 2 < m := by
    dsimp [m]
    exact ((le_max_left (1 / Real.log 2) R).trans
      (le_max_right 2 _)).trans_lt (by simpa [D] using hM)
  have hmThreshold : R < m := by
    dsimp [m]
    exact ((le_max_right (1 / Real.log 2) R).trans
      (le_max_right 2 _)).trans_lt (by simpa [D] using hM)
  have hmLogTwo : 1 < m * Real.log 2 := by
    calc
      1 = (1 / Real.log 2) * Real.log 2 := by field_simp
      _ < m * Real.log 2 := mul_lt_mul_of_pos_right hmInvLog hlogTwo
  have hmargin : C / Real.log 2 < m - 2 - 3 * K := by
    dsimp [R] at hmThreshold
    linarith
  refine ⟨M, hMtwo, ?_⟩
  intro q _ chi1 chi2 rho1 rho2 hsquare1 hsquare2 hrho1 hrho2
    him1 him2 hbeta1 hbeta2
  by_contra hne
  have hproduct : chi1 * chi2 ≠ 1 :=
    mul_ne_one_of_sq_eq_one_of_ne hsquare1 hne
  let L : ℝ := Real.log ((q : ℝ) * 2)
  let a : ℝ := 1 / (m * L)
  let sigma : ℝ := 1 + a
  have hscale : (2 : ℝ) ≤ (q : ℝ) * 2 := by
    simpa using two_le_level_height (q := q) 0
  have hlogLower : Real.log 2 ≤ L := by
    dsimp [L]
    exact Real.log_le_log zero_lt_two hscale
  have hLpos : 0 < L := hlogTwo.trans_le hlogLower
  have hmpos : 0 < m := by linarith
  have hmLpos : 0 < m * L := mul_pos hmpos hLpos
  have hmLone : 1 < m * L :=
    hmLogTwo.trans_le (mul_le_mul_of_nonneg_left hlogLower hmpos.le)
  have haPos : 0 < a := by dsimp [a]; positivity
  have haLtOne : a < 1 := by
    dsimp [a]
    rw [one_div]
    exact (inv_lt_one₀ hmLpos).2 hmLone
  have hsigmaOne : 1 < sigma := by dsimp [sigma]; linarith
  have hsigmaTwo : sigma < 2 := by dsimp [sigma]; linarith
  obtain ⟨hchi1, _, _, hrho1One⟩ :=
    (isNonprincipalNontrivialLFunctionZero_iff chi1 rho1).1 hrho1
  obtain ⟨hchi2, _, _, hrho2One⟩ :=
    (isNonprincipalNontrivialLFunctionZero_iff chi2 rho2).1 hrho2
  have hbeta1' : 1 - 1 / (m ^ 2 * L) ≤ rho1.re := by
    simpa [m, L, him1] using hbeta1
  have hbeta2' : 1 - 1 / (m ^ 2 * L) ≤ rho2.re := by
    simpa [m, L, him2] using hbeta2
  have hreciprocal1 :
      (m - 1) * L ≤ (sigma - rho1.re)⁻¹ := by
    simpa [sigma, a] using mul_sub_one_le_inv_one_add_inv_sub
      (m := m) (L := L) (beta := rho1.re) hmTwo.le hLpos
        hbeta1' hrho1One
  have hreciprocal2 :
      (m - 1) * L ≤ (sigma - rho2.re)⁻¹ := by
    simpa [sigma, a] using mul_sub_one_le_inv_one_add_inv_sub
      (m := m) (L := L) (beta := rho2.re) hmTwo.le hLpos
        hbeta2' hrho2One
  have hresidual : (16 * (A : ℝ) + 3) * L / 3 = K * L := by
    dsimp [K]
    ring
  have hcharLower (chi : DirichletCharacter ℂ q) (rho : ℂ)
      (hchi : chi ≠ 1)
      (hrho : (chi ≠ 1 ∧
                DirichletCharacter.completedLFunction chi.primitiveCharacter rho = 0))
      (him : rho.im = 0)
      (hreciprocal : (m - 1) * L ≤ (sigma - rho.re)⁻¹) :
      (m - 1 - K) * L ≤
        (logDeriv (DirichletCharacter.LFunction chi) (sigma : ℂ)).re := by
    let Zone : ℂ →₀ ℕ := Finsupp.single rho 1
    have hZoneSupport :
        ∀ z ∈ Zone.support,
          (chi ≠ 1 ∧
            DirichletCharacter.completedLFunction chi.primitiveCharacter z = 0) ∧
            |z.im - 0| ≤ 1 := by
      intro z hz
      rw [Finsupp.support_single rho one_ne_zero] at hz
      simp only [Finset.mem_singleton] at hz
      subst z
      exact ⟨hrho, by simp [him]⟩
    have horder := one_le_LFunction_order_of_nonprincipal_zero hrho
    have hZoneMult :
        ∀ z : ℂ,
          Zone z ≤ analyticOrderNatAt
            (DirichletCharacter.LFunction chi) z := by
      intro z
      by_cases hz : z = rho
      · subst z
        simpa [Zone] using horder
      · simp [Zone, hz]
    have hraw := hselected q chi hchi 0 sigma Zone
      hsigmaOne.le hsigmaTwo.le hZoneSupport hZoneMult
    simp only [abs_zero, zero_add] at hraw
    change Zone.sum (fun z n =>
        (n : ℝ) * (((((sigma : ℂ) + (0 : ℝ) * I - z)⁻¹).re))) -
        (16 * (A : ℝ) + 3) * L / 3 ≤
      (logDeriv (DirichletCharacter.LFunction chi)
        ((sigma : ℂ) + (0 : ℝ) * I)).re at hraw
    have hZoneSum :
        Zone.sum (fun z n =>
          (n : ℝ) *
            (((((sigma : ℂ) + (0 : ℝ) * I - z)⁻¹).re))) =
            (sigma - rho.re)⁻¹ := by
      calc
        _ = ((1 : ℕ) : ℝ) *
            ((((sigma : ℂ) + (0 : ℝ) * I - rho)⁻¹).re) := by
          dsimp [Zone]
          exact Finsupp.sum_single_index (a := rho) (b := 1)
            (h := fun (z : ℂ) (n : ℕ) =>
              (n : ℝ) *
                (((((sigma : ℂ) + (0 : ℝ) * I - z)⁻¹).re)))
            (by norm_num)
        _ = (sigma - rho.re)⁻¹ := by
          rw [Nat.cast_one, one_mul]
          simpa [him] using re_inv_same_height sigma rho
    rw [hZoneSum, hresidual] at hraw
    have hraw' :
        (sigma - rho.re)⁻¹ - K * L ≤
          (logDeriv (DirichletCharacter.LFunction chi) (sigma : ℂ)).re := by
      simpa using hraw
    nlinarith only [hreciprocal, hraw']
  have hchi1Lower :=
    hcharLower chi1 rho1 hchi1 hrho1 him1 hreciprocal1
  have hchi2Lower :=
    hcharLower chi2 rho2 hchi2 hrho2 him2 hreciprocal2
  let Zempty : ℂ →₀ ℕ := 0
  have hEmptySupport :
      ∀ z ∈ Zempty.support,
        ((chi1 * chi2) ≠ 1 ∧
          DirichletCharacter.completedLFunction (chi1 * chi2).primitiveCharacter z = 0) ∧
          |z.im - 0| ≤ 1 := by
    intro z hz
    simp [Zempty] at hz
  have hEmptyMult :
      ∀ z : ℂ,
        Zempty z ≤ analyticOrderNatAt
          (DirichletCharacter.LFunction (chi1 * chi2)) z := by
    intro z
    simp [Zempty]
  have hproductRaw := hselected q (chi1 * chi2) hproduct 0 sigma Zempty
    hsigmaOne.le hsigmaTwo.le hEmptySupport hEmptyMult
  simp only [abs_zero, zero_add] at hproductRaw
  change Zempty.sum (fun z n =>
      (n : ℝ) *
        (((((sigma : ℂ) + (0 : ℝ) * I - z)⁻¹).re))) -
      (16 * (A : ℝ) + 3) * L / 3 ≤
    (logDeriv (DirichletCharacter.LFunction (chi1 * chi2))
      ((sigma : ℂ) + (0 : ℝ) * I)).re at hproductRaw
  have hproductLower :
      -K * L ≤
        (logDeriv (DirichletCharacter.LFunction (chi1 * chi2))
          (sigma : ℂ)).re := by
    rw [show Zempty.sum (fun z n =>
        (n : ℝ) *
          (((((sigma : ℂ) + (0 : ℝ) * I - z)⁻¹).re))) = 0 by
          simp [Zempty],
      hresidual] at hproductRaw
    simpa using hproductRaw
  have hfour := four_factor_logDeriv_le_neg_logDeriv_riemannZeta
    chi1 chi2 hsquare1 hsquare2 hsigmaOne
  have hpoleSigma : (sigma - 1)⁻¹ = m * L := by
    have heq : sigma - 1 = (m * L)⁻¹ := by
      dsimp [sigma, a]
      rw [one_div]
      ring
    rw [heq, inv_inv]
  have hzetaBound := hzeta sigma hsigmaOne hsigmaTwo
  rw [hpoleSigma] at hzetaBound
  have hzetaUpper :
      (-logDeriv riemannZeta (sigma : ℂ)).re < m * L + C :=
    hzetaBound
  have hlower :
      (2 * m - 2 - 3 * K) * L ≤
        (logDeriv (DirichletCharacter.LFunction chi1) (sigma : ℂ)).re +
          (logDeriv (DirichletCharacter.LFunction chi2) (sigma : ℂ)).re +
            (logDeriv (DirichletCharacter.LFunction (chi1 * chi2))
              (sigma : ℂ)).re := by
    nlinarith only [hchi1Lower, hchi2Lower, hproductLower]
  have hsumUpper :
      (logDeriv (DirichletCharacter.LFunction chi1) (sigma : ℂ)).re +
          (logDeriv (DirichletCharacter.LFunction chi2) (sigma : ℂ)).re +
            (logDeriv (DirichletCharacter.LFunction (chi1 * chi2))
              (sigma : ℂ)).re < m * L + C :=
    hfour.trans_lt hzetaUpper
  have hmarginPos : 0 < m - 2 - 3 * K :=
    (div_pos hC hlogTwo).trans hmargin
  have hmarginLog : C < (m - 2 - 3 * K) * L := by
    calc
      C = (C / Real.log 2) * Real.log 2 := by field_simp
      _ < (m - 2 - 3 * K) * Real.log 2 :=
        mul_lt_mul_of_pos_right hmargin hlogTwo
      _ ≤ (m - 2 - 3 * K) * L :=
        mul_le_mul_of_nonneg_left hlogLower hmarginPos.le
  have hstrict :
      m * L + C < (2 * m - 2 - 3 * K) * L := by
    nlinarith only [hmarginLog, hmpos, hLpos]
  exact (not_lt_of_ge hlower) (hsumUpper.trans hstrict)

theorem exists_nat_nonprincipalNontrivialLFunctionZero_character_eq_of_sq_eq_one :
    ∃ M : ℕ, 2 ≤ M ∧
      ∀ (q : ℕ) [NeZero q]
        (chi1 chi2 : DirichletCharacter ℂ q) (rho1 rho2 : ℂ),
          chi1 ^ 2 = 1 →
            chi2 ^ 2 = 1 →
              (chi1 ≠ 1 ∧
                DirichletCharacter.completedLFunction chi1.primitiveCharacter rho1 = 0) →
                (chi2 ≠ 1 ∧
                  DirichletCharacter.completedLFunction chi2.primitiveCharacter rho2 = 0) →
                  1 - 1 / ((M : ℝ) ^ 2 *
                    Real.log ((q : ℝ) * (|rho1.im| + 2))) ≤ rho1.re →
                    1 - 1 / ((M : ℝ) ^ 2 *
                      Real.log ((q : ℝ) * (|rho2.im| + 2))) ≤ rho2.re →
                      chi1 = chi2 := by
  obtain ⟨Mreal, hMreal, hreal⟩ :=
    exists_nat_nonprincipalNontrivialLFunctionZero_real_simple_of_sq_eq_one
  obtain ⟨Mchar, hMchar, hchar⟩ :=
    exists_nat_nonprincipalNontrivialLFunctionZero_character_eq_of_sq_eq_one_of_im_eq_zero
  let M := max Mreal Mchar
  have hMtwo : 2 ≤ M := hMreal.trans (le_max_left _ _)
  refine ⟨M, hMtwo, ?_⟩
  intro q _ chi1 chi2 rho1 rho2 hsquare1 hsquare2 hrho1 hrho2
    hnear1 hnear2
  let L1 : ℝ := Real.log ((q : ℝ) * (|rho1.im| + 2))
  let L2 : ℝ := Real.log ((q : ℝ) * (|rho2.im| + 2))
  have hscale1 : (2 : ℝ) ≤ (q : ℝ) * (|rho1.im| + 2) :=
    two_le_level_height (q := q) rho1.im
  have hscale2 : (2 : ℝ) ≤ (q : ℝ) * (|rho2.im| + 2) :=
    two_le_level_height (q := q) rho2.im
  have hL1pos : 0 < L1 := by
    dsimp [L1]
    exact (Real.log_pos one_lt_two).trans_le
      (Real.log_le_log zero_lt_two hscale1)
  have hL2pos : 0 < L2 := by
    dsimp [L2]
    exact (Real.log_pos one_lt_two).trans_le
      (Real.log_le_log zero_lt_two hscale2)
  have hnearReal1 :
      1 - 1 / ((Mreal : ℝ) ^ 2 * L1) ≤ rho1.re := by
    apply near_one_of_le (one_le_two.trans hMreal)
      (le_max_left _ _) hL1pos
    simpa only [M, L1] using hnear1
  have hnearReal2 :
      1 - 1 / ((Mreal : ℝ) ^ 2 * L2) ≤ rho2.re := by
    apply near_one_of_le (one_le_two.trans hMreal)
      (le_max_left _ _) hL2pos
    simpa only [M, L2] using hnear2
  have him1 := (hreal q chi1 rho1 hsquare1 hrho1
    (by simpa only [L1] using hnearReal1)).1
  have him2 := (hreal q chi2 rho2 hsquare2 hrho2
    (by simpa only [L2] using hnearReal2)).1
  have hnearChar1 :
      1 - 1 / ((Mchar : ℝ) ^ 2 * L1) ≤ rho1.re := by
    apply near_one_of_le (one_le_two.trans hMchar)
      (le_max_right _ _) hL1pos
    simpa only [M, L1] using hnear1
  have hnearChar2 :
      1 - 1 / ((Mchar : ℝ) ^ 2 * L2) ≤ rho2.re := by
    apply near_one_of_le (one_le_two.trans hMchar)
      (le_max_right _ _) hL2pos
    simpa only [M, L2] using hnear2
  exact hchar q chi1 chi2 rho1 rho2 hsquare1 hsquare2 hrho1 hrho2
    him1 him2 (by simpa only [L1] using hnearChar1)
      (by simpa only [L2] using hnearChar2)

end

section

attribute [local instance] inducingEulerProductConductorNeZero
theorem exists_nat_nonprincipalNontrivialLFunctionZero_sq_eq_one_real_simple :
    ∃ M : ℕ, 2 ≤ M ∧
      ∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q) (rho : ℂ),
          (chi ≠ 1 ∧
            DirichletCharacter.completedLFunction chi.primitiveCharacter rho = 0) →
            1 - 1 / ((M : ℝ) ^ 2 *
              Real.log ((q : ℝ) * (|rho.im| + 2))) ≤ rho.re →
              chi ^ 2 = 1 ∧
                rho.im = 0 ∧
                  analyticOrderNatAt
                    (DirichletCharacter.LFunction chi) rho = 1 := by
  obtain ⟨Mnonquad, hMnonquad, hnonquad⟩ :=
    exists_nat_nonprincipalNontrivialLFunctionZero_re_lt_of_sq_ne_one
  obtain ⟨Mreal, hMreal, hreal⟩ :=
    exists_nat_nonprincipalNontrivialLFunctionZero_real_simple_of_sq_eq_one
  let M := max Mnonquad Mreal
  have hMtwo : 2 ≤ M := hMnonquad.trans (le_max_left _ _)
  refine ⟨M, hMtwo, ?_⟩
  intro q _ chi rho hrho hnear
  let L : ℝ := Real.log ((q : ℝ) * (|rho.im| + 2))
  have hLpos : 0 < L := by
    dsimp [L]
    exact (Real.log_pos one_lt_two).trans_le
      (Real.log_le_log zero_lt_two (two_le_level_height (q := q) rho.im))
  have hnearNonquad :
      1 - 1 / ((Mnonquad : ℝ) ^ 2 * L) ≤ rho.re := by
    apply near_one_of_le (one_le_two.trans hMnonquad)
      (le_max_left _ _) hLpos
    simpa only [M, L] using hnear
  have hsquare : chi ^ 2 = 1 := by
    by_contra hsquare
    have hleft := hnonquad q chi rho hsquare hrho
    exact (not_lt_of_ge (by simpa only [L] using hnearNonquad)) hleft
  have hnearReal :
      1 - 1 / ((Mreal : ℝ) ^ 2 * L) ≤ rho.re := by
    apply near_one_of_le (one_le_two.trans hMreal)
      (le_max_right _ _) hLpos
    simpa only [M, L] using hnear
  have hrealSimple := hreal q chi rho hsquare hrho
    (by simpa only [L] using hnearReal)
  exact ⟨hsquare, hrealSimple.1, hrealSimple.2⟩

theorem exists_nat_nonprincipalNontrivialLFunctionZero_character_eq_and_zero_eq :
    ∃ M : ℕ, 2 ≤ M ∧
      ∀ (q : ℕ) [NeZero q]
        (chi1 chi2 : DirichletCharacter ℂ q) (rho1 rho2 : ℂ),
          (chi1 ≠ 1 ∧
            DirichletCharacter.completedLFunction chi1.primitiveCharacter rho1 = 0) →
            (chi2 ≠ 1 ∧
              DirichletCharacter.completedLFunction chi2.primitiveCharacter rho2 = 0) →
              1 - 1 / ((M : ℝ) ^ 2 *
                Real.log ((q : ℝ) * (|rho1.im| + 2))) ≤ rho1.re →
                1 - 1 / ((M : ℝ) ^ 2 *
                  Real.log ((q : ℝ) * (|rho2.im| + 2))) ≤ rho2.re →
                  chi1 = chi2 ∧ rho1 = rho2 := by
  obtain ⟨Mshape, hMshape, hshape⟩ :=
    exists_nat_nonprincipalNontrivialLFunctionZero_sq_eq_one_real_simple
  obtain ⟨Mchar, hMchar, hchar⟩ :=
    exists_nat_nonprincipalNontrivialLFunctionZero_character_eq_of_sq_eq_one
  obtain ⟨Mzero, hMzero, hzero⟩ :=
    exists_nat_nonprincipalNontrivialLFunctionZero_eq_of_sq_eq_one
  let M := max Mshape (max Mchar Mzero)
  have hMtwo : 2 ≤ M := hMshape.trans (le_max_left _ _)
  refine ⟨M, hMtwo, ?_⟩
  intro q _ chi1 chi2 rho1 rho2 hrho1 hrho2 hnear1 hnear2
  let L1 : ℝ := Real.log ((q : ℝ) * (|rho1.im| + 2))
  let L2 : ℝ := Real.log ((q : ℝ) * (|rho2.im| + 2))
  have hL1pos : 0 < L1 := by
    dsimp [L1]
    exact (Real.log_pos one_lt_two).trans_le
      (Real.log_le_log zero_lt_two (two_le_level_height (q := q) rho1.im))
  have hL2pos : 0 < L2 := by
    dsimp [L2]
    exact (Real.log_pos one_lt_two).trans_le
      (Real.log_le_log zero_lt_two (two_le_level_height (q := q) rho2.im))
  have hnearShape1 :
      1 - 1 / ((Mshape : ℝ) ^ 2 * L1) ≤ rho1.re := by
    apply near_one_of_le (one_le_two.trans hMshape)
      (le_max_left _ _) hL1pos
    simpa only [M, L1] using hnear1
  have hnearShape2 :
      1 - 1 / ((Mshape : ℝ) ^ 2 * L2) ≤ rho2.re := by
    apply near_one_of_le (one_le_two.trans hMshape)
      (le_max_left _ _) hL2pos
    simpa only [M, L2] using hnear2
  have hshape1 := hshape q chi1 rho1 hrho1
    (by simpa only [L1] using hnearShape1)
  have hshape2 := hshape q chi2 rho2 hrho2
    (by simpa only [L2] using hnearShape2)
  have hMcharM : Mchar ≤ M :=
    (le_max_left Mchar Mzero).trans (le_max_right Mshape _)
  have hMzeroM : Mzero ≤ M :=
    (le_max_right Mchar Mzero).trans (le_max_right Mshape _)
  have hnearChar1 :
      1 - 1 / ((Mchar : ℝ) ^ 2 * L1) ≤ rho1.re := by
    apply near_one_of_le (one_le_two.trans hMchar) hMcharM hL1pos
    simpa only [M, L1] using hnear1
  have hnearChar2 :
      1 - 1 / ((Mchar : ℝ) ^ 2 * L2) ≤ rho2.re := by
    apply near_one_of_le (one_le_two.trans hMchar) hMcharM hL2pos
    simpa only [M, L2] using hnear2
  have hcharEq := hchar q chi1 chi2 rho1 rho2 hshape1.1 hshape2.1
    hrho1 hrho2 (by simpa only [L1] using hnearChar1)
      (by simpa only [L2] using hnearChar2)
  have hnearZero1 :
      1 - 1 / ((Mzero : ℝ) ^ 2 * L1) ≤ rho1.re := by
    apply near_one_of_le (one_le_two.trans hMzero) hMzeroM hL1pos
    simpa only [M, L1] using hnear1
  have hnearZero2 :
      1 - 1 / ((Mzero : ℝ) ^ 2 * L2) ≤ rho2.re := by
    apply near_one_of_le (one_le_two.trans hMzero) hMzeroM hL2pos
    simpa only [M, L2] using hnear2
  refine ⟨hcharEq, ?_⟩
  subst chi2
  exact hzero q chi1 rho1 rho2 hshape1.1 hrho1 hrho2
    (by simpa only [L1] using hnearZero1)
    (by simpa only [L2] using hnearZero2)

end

/--
The product of the L-functions of all Dirichlet characters modulo the nonzero modulus `q`,
including the principal character.
-/
noncomputable def dirichletLFunctionProduct
    (q : ℕ) [NeZero q] (s : ℂ) : ℂ :=
  ∏ chi : DirichletCharacter ℂ q,
    DirichletCharacter.LFunction chi s

/--
The product over all characters modulo `q`, with the principal factor replaced by its
pole-removed version. Away from `s = 1`, this equals `(s - 1)` times the unregularized product.
-/
noncomputable def regularizedDirichletLFunctionProduct
    (q : ℕ) [NeZero q] (s : ℂ) : ℂ :=
  open Classical in
  DirichletCharacter.LFunctionTrivChar₁ q s *
    ∏ chi ∈ Finset.univ.erase (1 : DirichletCharacter ℂ q),
      DirichletCharacter.LFunction chi s

theorem regularizedDirichletLFunctionProduct_eq_sub_one_mul_of_ne_one
    (q : ℕ) [NeZero q] {s : ℂ} (hs : s ≠ 1) :
    regularizedDirichletLFunctionProduct q s =
      (s - 1) * dirichletLFunctionProduct q s := by
  classical
  rw [regularizedDirichletLFunctionProduct,
    DirichletCharacter.LFunctionTrivChar₁, Function.update_of_ne hs,
    dirichletLFunctionProduct]
  rw [← Finset.mul_prod_erase Finset.univ
    (fun chi : DirichletCharacter ℂ q =>
      DirichletCharacter.LFunction chi s)
    (Finset.mem_univ (1 : DirichletCharacter ℂ q))]
  ring

theorem regularizedDirichletLFunctionProduct_apply_one_ne_zero
    (q : ℕ) [NeZero q] :
    regularizedDirichletLFunctionProduct q 1 ≠ 0 := by
  classical
  rw [regularizedDirichletLFunctionProduct, mul_ne_zero_iff,
    Finset.prod_ne_zero_iff]
  refine ⟨DirichletCharacter.LFunctionTrivChar₁_apply_one_ne_zero q, ?_⟩
  intro chi hchi
  exact DirichletCharacter.LFunction_apply_one_ne_zero
    (Finset.ne_of_mem_erase hchi)

theorem regularizedDirichletLFunctionProduct_eq_zero_iff
    (q : ℕ) [NeZero q] (rho : ℂ) :
    regularizedDirichletLFunctionProduct q rho = 0 ↔
      rho ≠ 1 ∧
        ∃ chi : DirichletCharacter ℂ q,
          DirichletCharacter.LFunction chi rho = 0 := by
  classical
  constructor
  · intro hzero
    have hrho : rho ≠ 1 := by
      intro h
      subst rho
      exact regularizedDirichletLFunctionProduct_apply_one_ne_zero q hzero
    have hproduct : dirichletLFunctionProduct q rho = 0 := by
      rw [regularizedDirichletLFunctionProduct_eq_sub_one_mul_of_ne_one q hrho,
        mul_eq_zero] at hzero
      exact hzero.resolve_left (sub_ne_zero.mpr hrho)
    unfold dirichletLFunctionProduct at hproduct
    rw [Finset.prod_eq_zero_iff] at hproduct
    obtain ⟨chi, _, hchi⟩ := hproduct
    exact ⟨hrho, chi, hchi⟩
  · rintro ⟨hrho, chi, hchi⟩
    rw [regularizedDirichletLFunctionProduct_eq_sub_one_mul_of_ne_one q hrho]
    have hproduct : dirichletLFunctionProduct q rho = 0 := by
      unfold dirichletLFunctionProduct
      exact Finset.prod_eq_zero (Finset.mem_univ chi) hchi
    rw [hproduct, mul_zero]

section RegularizedProductExceptionalZero
theorem near_one_of_le_of_scale_le
    {m M : ℕ} {l L beta : ℝ}
    (hm : 1 ≤ m) (hmM : m ≤ M) (hl : 0 < l) (hlL : l ≤ L)
    (hnear : 1 - 1 / ((M : ℝ) ^ 2 * L) ≤ beta) :
    1 - 1 / ((m : ℝ) ^ 2 * l) ≤ beta := by
  have hm0 : (0 : ℝ) < m := by exact_mod_cast hm
  refine le_trans ?_ hnear
  gcongr

theorem re_pos_of_near_one
    {M q : ℕ} [NeZero q] {rho : ℂ} (hM : 2 ≤ M)
    (hnear : 1 - 1 / ((M : ℝ) ^ 2 *
      Real.log ((q : ℝ) * (|rho.im| + 2))) ≤ rho.re) :
    0 < rho.re := by
  let L : ℝ := Real.log ((q : ℝ) * (|rho.im| + 2))
  have hlog : (1 / 2 : ℝ) < L := by
    have hhalf : (1 / 2 : ℝ) < Real.log 2 :=
      (by norm_num : (1 / 2 : ℝ) < 0.6931471803).trans
        Real.log_two_gt_d9
    exact hhalf.trans_le
      (Real.log_le_log zero_lt_two
        (by simpa [L] using two_le_level_height (q := q) rho.im))
  have hMcast : (2 : ℝ) ≤ M := by exact_mod_cast hM
  have hMpos : (0 : ℝ) < M := zero_lt_two.trans_le hMcast
  have hMsquare : (4 : ℝ) ≤ (M : ℝ) ^ 2 := by nlinarith
  have hden : (1 : ℝ) < (M : ℝ) ^ 2 * L := by
    calc
      (1 : ℝ) < 4 * (1 / 2 : ℝ) := by norm_num
      _ ≤ (M : ℝ) ^ 2 * (1 / 2 : ℝ) :=
        mul_le_mul_of_nonneg_right hMsquare (by norm_num)
      _ < (M : ℝ) ^ 2 * L :=
        mul_lt_mul_of_pos_left hlog (sq_pos_of_pos hMpos)
  have hinv : 1 / ((M : ℝ) ^ 2 * L) < 1 :=
    (div_lt_one (zero_lt_one.trans hden)).2 hden
  dsimp [L] at hinv
  linarith

theorem re_lt_one_of_constituent_zero
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q) {rho : ℂ}
    (hrho : rho ≠ 1) (hzero : DirichletCharacter.LFunction chi rho = 0) :
    rho.re < 1 := by
  apply lt_of_not_ge
  intro hre
  exact (DirichletCharacter.LFunction_ne_zero_of_one_le_re chi
    (.inr hrho) hre) hzero

end RegularizedProductExceptionalZero

section

attribute [local instance] inducingEulerProductConductorNeZero
theorem exists_nat_regularizedDirichletLFunctionProduct_zero_structure :
    ∃ M : ℕ, 2 ≤ M ∧
      ∀ (q : ℕ) [NeZero q] (rho : ℂ),
        1 - 1 / ((M : ℝ) ^ 2 *
          Real.log ((q : ℝ) * (|rho.im| + 2))) ≤ rho.re →
          regularizedDirichletLFunctionProduct q rho = 0 →
            analyticOrderNatAt
                (regularizedDirichletLFunctionProduct q) rho = 1 ∧
              ∃ chi : DirichletCharacter ℂ q,
                (chi ≠ 1 ∧
                  DirichletCharacter.completedLFunction chi.primitiveCharacter rho = 0) ∧
                  chi ^ 2 = 1 ∧
                    rho.im = 0 ∧
                      analyticOrderNatAt
                          (DirichletCharacter.LFunction chi) rho = 1 ∧
                        ∀ psi : DirichletCharacter ℂ q,
                          (psi ≠ 1 ∧
                            DirichletCharacter.completedLFunction psi.primitiveCharacter rho = 0) →
                            psi = chi := by
  classical
  obtain ⟨Mprincipal, hMprincipal, hprincipal⟩ :=
    exists_nat_principal_LFunction_openStrip_zero_re_lt
  obtain ⟨Mshape, hMshape, hshape⟩ :=
    exists_nat_nonprincipalNontrivialLFunctionZero_sq_eq_one_real_simple
  obtain ⟨Munique, hMunique, hunique⟩ :=
    exists_nat_nonprincipalNontrivialLFunctionZero_character_eq_and_zero_eq
  let M := max Mprincipal (max Mshape Munique)
  have hMtwo : 2 ≤ M := hMprincipal.trans (le_max_left _ _)
  refine ⟨M, hMtwo, ?_⟩
  intro q _ rho hnear hproductZero
  obtain ⟨hrhoOne, chi, hchiZero⟩ :=
    (regularizedDirichletLFunctionProduct_eq_zero_iff q rho).mp hproductZero
  have hrhoPos : 0 < rho.re := re_pos_of_near_one hMtwo hnear
  have hrhoLt : rho.re < 1 :=
    re_lt_one_of_constituent_zero chi hrhoOne hchiZero
  let Lq : ℝ := Real.log ((q : ℝ) * (|rho.im| + 2))
  let L0 : ℝ := Real.log (|rho.im| + 2)
  have hLqPos : 0 < Lq := by
    exact (Real.log_pos one_lt_two).trans_le
      (Real.log_le_log zero_lt_two
        (by simpa [Lq] using two_le_level_height (q := q) rho.im))
  have hL0Pos : 0 < L0 := by
    apply Real.log_pos
    linarith [abs_nonneg rho.im]
  have hL0Lq : L0 ≤ Lq := by
    have hq : (1 : ℝ) ≤ q := by exact_mod_cast NeZero.pos q
    have ht : (0 : ℝ) < |rho.im| + 2 := by
      linarith [abs_nonneg rho.im]
    apply Real.log_le_log ht
    nlinarith
  have hnearPrincipal :
      1 - 1 / ((Mprincipal : ℝ) ^ 2 * L0) ≤ rho.re := by
    apply near_one_of_le_of_scale_le (one_le_two.trans hMprincipal)
      (le_max_left _ _) hL0Pos hL0Lq
    simpa only [M, Lq] using hnear
  have hprincipalNe :
      DirichletCharacter.LFunction
          (1 : DirichletCharacter ℂ q) rho ≠ 0 := by
    intro hzero
    have hlt := hprincipal q rho hrhoPos hrhoLt hzero
    exact (not_lt_of_ge (by simpa only [L0] using hnearPrincipal)) hlt
  have hchiNe : chi ≠ 1 := by
    intro hchi
    subst chi
    exact hprincipalNe hchiZero
  have hchi : (chi ≠ 1 ∧
                DirichletCharacter.completedLFunction chi.primitiveCharacter rho = 0) :=
    (isNonprincipalNontrivialLFunctionZero_iff chi rho).2
      ⟨hchiNe, hchiZero, hrhoPos, hrhoLt⟩
  have hnearShape :
      1 - 1 / ((Mshape : ℝ) ^ 2 * Lq) ≤ rho.re := by
    apply near_one_of_le_of_scale_le (one_le_two.trans hMshape)
      ((le_max_left Mshape Munique).trans (le_max_right Mprincipal _))
      hLqPos le_rfl
    simpa only [M, Lq] using hnear
  have hnearUnique :
      1 - 1 / ((Munique : ℝ) ^ 2 * Lq) ≤ rho.re := by
    apply near_one_of_le_of_scale_le (one_le_two.trans hMunique)
      ((le_max_right Mshape Munique).trans (le_max_right Mprincipal _))
      hLqPos le_rfl
    simpa only [M, Lq] using hnear
  have hshapeResult := hshape q chi rho hchi
    (by simpa only [Lq] using hnearShape)
  have hlabel : ∀ psi : DirichletCharacter ℂ q,
      (psi ≠ 1 ∧
        DirichletCharacter.completedLFunction psi.primitiveCharacter rho = 0) → psi = chi := by
    intro psi hpsi
    exact (hunique q chi psi rho rho hchi hpsi
      (by simpa only [Lq] using hnearUnique)
      (by simpa only [Lq] using hnearUnique)).1.symm
  have hprincipalRegularizedNe :
      DirichletCharacter.LFunctionTrivChar₁ q rho ≠ 0 := by
    rw [DirichletCharacter.LFunctionTrivChar₁,
      Function.update_of_ne hrhoOne]
    exact mul_ne_zero (sub_ne_zero.mpr hrhoOne) hprincipalNe
  have hchiMem : chi ∈
      Finset.univ.erase (1 : DirichletCharacter ℂ q) :=
    Finset.mem_erase.mpr ⟨hchiNe, Finset.mem_univ chi⟩
  have hotherNe : ∀ psi ∈
      (Finset.univ.erase (1 : DirichletCharacter ℂ q)).erase chi,
        DirichletCharacter.LFunction psi rho ≠ 0 := by
    intro psi hpsi
    have hpsiNeChi := Finset.ne_of_mem_erase hpsi
    have hpsiMem := Finset.mem_of_mem_erase hpsi
    have hpsiNeOne := Finset.ne_of_mem_erase hpsiMem
    intro hpsiZero
    have hpsiPred : (psi ≠ 1 ∧
                      DirichletCharacter.completedLFunction psi.primitiveCharacter rho = 0) :=
      (isNonprincipalNontrivialLFunctionZero_iff psi rho).2
        ⟨hpsiNeOne, hpsiZero, hrhoPos, hrhoLt⟩
    exact hpsiNeChi (hlabel psi hpsiPred)
  let G : ℂ → ℂ := fun z =>
    DirichletCharacter.LFunctionTrivChar₁ q z *
      ∏ psi ∈
        (Finset.univ.erase (1 : DirichletCharacter ℂ q)).erase chi,
          DirichletCharacter.LFunction psi z
  have hGAnalytic : AnalyticAt ℂ G rho := by
    apply ((DirichletCharacter.differentiable_LFunctionTrivChar₁ q).mul ?_).analyticAt
    apply Differentiable.fun_finsetProd
    intro psi hpsi
    exact DirichletCharacter.differentiable_LFunction
      (Finset.ne_of_mem_erase (Finset.mem_of_mem_erase hpsi))
  have hGNe : G rho ≠ 0 := by
    apply mul_ne_zero hprincipalRegularizedNe
    rw [Finset.prod_ne_zero_iff]
    exact hotherNe
  have hfactor : regularizedDirichletLFunctionProduct q =
      DirichletCharacter.LFunction chi * G := by
    funext z
    simp only [Pi.mul_apply]
    dsimp only [G, regularizedDirichletLFunctionProduct]
    rw [← Finset.mul_prod_erase
      (Finset.univ.erase (1 : DirichletCharacter ℂ q))
      (fun psi : DirichletCharacter ℂ q =>
        DirichletCharacter.LFunction psi z) hchiMem]
    ring
  have hchiAnalytic : AnalyticAt ℂ
      (DirichletCharacter.LFunction chi) rho :=
    (DirichletCharacter.differentiable_LFunction hchiNe).analyticAt rho
  have hchiFinite :
      analyticOrderAt (DirichletCharacter.LFunction chi) rho ≠ ⊤ := by
    intro htop
    have horder := hshapeResult.2.2
    simp [analyticOrderNatAt, htop] at horder
  have hGOrderZero : analyticOrderAt G rho = 0 :=
    hGAnalytic.analyticOrderAt_eq_zero.mpr hGNe
  have hGFinite : analyticOrderAt G rho ≠ ⊤ := by
    rw [hGOrderZero]
    simp
  have hGNatOrderZero : analyticOrderNatAt G rho = 0 := by
    simp [analyticOrderNatAt, hGOrderZero]
  have hproductOrder : analyticOrderNatAt
      (regularizedDirichletLFunctionProduct q) rho = 1 := by
    rw [hfactor, analyticOrderNatAt_mul hchiAnalytic hGAnalytic
      hchiFinite hGFinite, hshapeResult.2.2, hGNatOrderZero, add_zero]
  exact ⟨hproductOrder, chi, hchi, hshapeResult.1,
    hshapeResult.2.1, hshapeResult.2.2, hlabel⟩

end

theorem exists_nat_regularizedDirichletLFunctionProduct_zero_eq :
    ∃ M : ℕ, 2 ≤ M ∧
      ∀ (q : ℕ) [NeZero q] (rho1 rho2 : ℂ),
        1 - 1 / ((M : ℝ) ^ 2 *
          Real.log ((q : ℝ) * (|rho1.im| + 2))) ≤ rho1.re →
          1 - 1 / ((M : ℝ) ^ 2 *
            Real.log ((q : ℝ) * (|rho2.im| + 2))) ≤ rho2.re →
            regularizedDirichletLFunctionProduct q rho1 = 0 →
              regularizedDirichletLFunctionProduct q rho2 = 0 →
                rho1 = rho2 := by
  obtain ⟨Mstructure, hMstructure, hstructure⟩ :=
    exists_nat_regularizedDirichletLFunctionProduct_zero_structure
  obtain ⟨Mpair, hMpair, hpair⟩ :=
    exists_nat_nonprincipalNontrivialLFunctionZero_character_eq_and_zero_eq
  let M := max Mstructure Mpair
  have hMtwo : 2 ≤ M := hMstructure.trans (le_max_left _ _)
  refine ⟨M, hMtwo, ?_⟩
  intro q _ rho1 rho2 hnear1 hnear2 hzero1 hzero2
  let L1 : ℝ := Real.log ((q : ℝ) * (|rho1.im| + 2))
  let L2 : ℝ := Real.log ((q : ℝ) * (|rho2.im| + 2))
  have hL1Pos : 0 < L1 := by
    exact (Real.log_pos one_lt_two).trans_le
      (Real.log_le_log zero_lt_two
        (by simpa [L1] using two_le_level_height (q := q) rho1.im))
  have hL2Pos : 0 < L2 := by
    exact (Real.log_pos one_lt_two).trans_le
      (Real.log_le_log zero_lt_two
        (by simpa [L2] using two_le_level_height (q := q) rho2.im))
  have hnearStructure1 :
      1 - 1 / ((Mstructure : ℝ) ^ 2 * L1) ≤ rho1.re := by
    apply near_one_of_le_of_scale_le (one_le_two.trans hMstructure)
      (le_max_left _ _) hL1Pos le_rfl
    simpa only [M, L1] using hnear1
  have hnearStructure2 :
      1 - 1 / ((Mstructure : ℝ) ^ 2 * L2) ≤ rho2.re := by
    apply near_one_of_le_of_scale_le (one_le_two.trans hMstructure)
      (le_max_left _ _) hL2Pos le_rfl
    simpa only [M, L2] using hnear2
  obtain ⟨_, chi1, hchi1, _⟩ := hstructure q rho1
    (by simpa only [L1] using hnearStructure1) hzero1
  obtain ⟨_, chi2, hchi2, _⟩ := hstructure q rho2
    (by simpa only [L2] using hnearStructure2) hzero2
  have hnearPair1 :
      1 - 1 / ((Mpair : ℝ) ^ 2 * L1) ≤ rho1.re := by
    apply near_one_of_le_of_scale_le (one_le_two.trans hMpair)
      (le_max_right _ _) hL1Pos le_rfl
    simpa only [M, L1] using hnear1
  have hnearPair2 :
      1 - 1 / ((Mpair : ℝ) ^ 2 * L2) ≤ rho2.re := by
    apply near_one_of_le_of_scale_le (one_le_two.trans hMpair)
      (le_max_right _ _) hL2Pos le_rfl
    simpa only [M, L2] using hnear2
  exact (hpair q chi1 chi2 rho1 rho2 hchi1 hchi2
    (by simpa only [L1] using hnearPair1)
    (by simpa only [L2] using hnearPair2)).2

section
open Complex Set

attribute [local instance] inducingEulerProductConductorNeZero

section DirichletNonexceptionalZeroKernel
theorem norm_kernel_le_far
    {M q : ℕ} [NeZero q] {chi : DirichletCharacter ℂ q}
    {x T : ℝ} {rho : ℂ}
    (hM : 2 ≤ M) (hx : 4 ≤ x) (hT : 2 ≤ T)
    (hzero : DirichletCharacter.LFunction chi rho = 0 ∧
      0 < rho.re ∧ rho.re < 1)
    (hfar : rho.re < 1 - 1 / ((M : ℝ) ^ 2 *
      Real.log ((q : ℝ) * (T + 2)))) :
    ‖dirichletExplicitFormulaKernel x rho‖ ≤
      12 * x ^ (1 - 1 / ((M : ℝ) ^ 2 *
        Real.log ((q : ℝ) * (T + 2)))) / (1 + |rho.im|) := by
  let L : ℝ := Real.log ((q : ℝ) * (T + 2))
  let alpha : ℝ := 1 - 1 / ((M : ℝ) ^ 2 * L)
  let g : ℝ := |rho.im|
  have hxone : (1 : ℝ) ≤ x := by linarith
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  have hbeta0 : 0 ≤ rho.re := hzero.2.1.le
  have hLone : (1 : ℝ) ≤ L := by
    have hq : (1 : ℝ) ≤ q := by exact_mod_cast NeZero.pos q
    have hscale : (4 : ℝ) ≤ (q : ℝ) * (T + 2) := by
      nlinarith [mul_le_mul hq (show (4 : ℝ) ≤ T + 2 by linarith)
        (by norm_num : (0 : ℝ) ≤ 4) (by positivity : (0 : ℝ) ≤ q)]
    have hlogFour : (1 : ℝ) < Real.log 4 := by
      rw [Real.log_four_eq]
      nlinarith [Real.log_two_gt_d9]
    exact hlogFour.le.trans (Real.log_le_log (by norm_num) hscale)
  have hLpos : 0 < L := zero_lt_one.trans_le hLone
  have hMreal : (2 : ℝ) ≤ M := by exact_mod_cast hM
  have hMsq : (4 : ℝ) ≤ (M : ℝ) ^ 2 := by nlinarith
  have hden : (4 : ℝ) ≤ (M : ℝ) ^ 2 * L := by
    nlinarith [mul_le_mul_of_nonneg_left hLone (sq_nonneg (M : ℝ))]
  have hinv : 1 / ((M : ℝ) ^ 2 * L) ≤ (1 / 4 : ℝ) := by
    exact one_div_le_one_div_of_le (by norm_num) hden
  have halpha : (1 / 2 : ℝ) ≤ alpha := by
    dsimp [alpha]
    linarith
  have hbetaAlpha : rho.re ≤ alpha := by
    simpa only [alpha, L] using hfar.le
  have hpow : x ^ rho.re ≤ x ^ alpha :=
    Real.rpow_le_rpow_of_exponent_le hxone hbetaAlpha
  have hpowOne : (1 : ℝ) ≤ x ^ rho.re := by
    calc
      (1 : ℝ) = x ^ (0 : ℝ) := (Real.rpow_zero x).symm
      _ ≤ x ^ rho.re := Real.rpow_le_rpow_of_exponent_le hxone hbeta0
  have halphaPow : 0 ≤ x ^ alpha := Real.rpow_nonneg hxpos.le alpha
  have hrhoNe : rho ≠ 0 := by
    intro hrho
    subst rho
    have := hzero.2.1
    norm_num at this
  have hnormrho : 0 < ‖rho‖ := norm_pos_iff.mpr hrhoNe
  have hquot :
      ‖dirichletExplicitFormulaKernel x rho‖ ≤
        (x ^ rho.re + 1) / ‖rho‖ := by
    rw [dirichletExplicitFormulaKernel_eq_cpow_sub_one_div hxpos hrhoNe,
      norm_div]
    apply div_le_div_of_nonneg_right _ hnormrho.le
    calc
      ‖(x : ℂ) ^ rho - 1‖ ≤ ‖(x : ℂ) ^ rho‖ + ‖(1 : ℂ)‖ :=
        norm_sub_le _ _
      _ = x ^ rho.re + 1 := by
        rw [Complex.norm_cpow_eq_rpow_re_of_pos hxpos, norm_one]
  have hg0 : 0 ≤ g := abs_nonneg rho.im
  have hgden : 0 < 1 + g := by linarith
  apply (le_div_iff₀ hgden).2
  by_cases hbeta : rho.re ≤ 1 / 3
  · by_cases hgamma : g ≤ 1
    · have hkernel :=
        norm_dirichletExplicitFormulaKernel_le_rpow_mul_log hxone hbeta0
      have hlog6 : Real.log x ≤ 6 * x ^ (1 / 6 : ℝ) := by
        have h := Real.log_le_rpow_div hxpos.le
          (show (0 : ℝ) < 1 / 6 by norm_num)
        convert h using 1
        ring
      have hsum : rho.re + 1 / 6 ≤ alpha := by linarith
      have hpowsum : x ^ (rho.re + 1 / 6) ≤ x ^ alpha :=
        Real.rpow_le_rpow_of_exponent_le hxone hsum
      calc
        ‖dirichletExplicitFormulaKernel x rho‖ * (1 + g) ≤
            (x ^ rho.re * Real.log x) * (1 + g) :=
          mul_le_mul_of_nonneg_right hkernel (by linarith)
        _ ≤ (x ^ rho.re * (6 * x ^ (1 / 6 : ℝ))) * 2 := by
          gcongr
          linarith
        _ = 12 * x ^ (rho.re + 1 / 6) := by
          rw [show x ^ rho.re * (6 * x ^ (1 / 6 : ℝ)) * 2 =
            12 * (x ^ rho.re * x ^ (1 / 6 : ℝ)) by ring,
            ← Real.rpow_add hxpos]
        _ ≤ 12 * x ^ alpha :=
          mul_le_mul_of_nonneg_left hpowsum (by norm_num)
    · have hgOne : 1 < g := lt_of_not_ge hgamma
      have hgNorm : g ≤ ‖rho‖ := by
        simpa [g] using Complex.abs_im_le_norm rho
      have hdenLe : 1 + g ≤ 2 * ‖rho‖ := by nlinarith
      calc
        ‖dirichletExplicitFormulaKernel x rho‖ * (1 + g) ≤
            ((x ^ rho.re + 1) / ‖rho‖) * (1 + g) :=
          mul_le_mul_of_nonneg_right hquot (by linarith)
        _ ≤ ((x ^ rho.re + 1) / ‖rho‖) * (2 * ‖rho‖) := by gcongr
        _ = 2 * (x ^ rho.re + 1) := by field_simp [hnormrho.ne']
        _ ≤ 4 * x ^ rho.re := by nlinarith
        _ ≤ 12 * x ^ alpha := by nlinarith
  · have hbetaThird : 1 / 3 < rho.re := lt_of_not_ge hbeta
    have hreNorm : rho.re ≤ ‖rho‖ := by
      have hbetaPos : 0 < rho.re := by linarith
      simpa [abs_of_pos hbetaPos] using Complex.abs_re_le_norm rho
    have himNorm : g ≤ ‖rho‖ := by
      simpa [g] using Complex.abs_im_le_norm rho
    have hdenLe : 1 + g ≤ 4 * ‖rho‖ := by nlinarith
    calc
      ‖dirichletExplicitFormulaKernel x rho‖ * (1 + g) ≤
          ((x ^ rho.re + 1) / ‖rho‖) * (1 + g) :=
        mul_le_mul_of_nonneg_right hquot (by linarith)
      _ ≤ ((x ^ rho.re + 1) / ‖rho‖) * (4 * ‖rho‖) := by gcongr
      _ = 4 * (x ^ rho.re + 1) := by field_simp [hnormrho.ne']
      _ ≤ 8 * x ^ rho.re := by nlinarith
      _ ≤ 12 * x ^ alpha := by nlinarith

end DirichletNonexceptionalZeroKernel
end

section
open Complex Set

end

section
open Complex Set

attribute [local instance] inducingEulerProductConductorNeZero
attribute [local instance] inducingEulerProductConductorNeZero
theorem
    exists_nat_norm_dirichletExplicitFormulaKernel_le_or_exceptional :
    ∃ M : ℕ, 2 ≤ M ∧
      ∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q) (rho : ℂ),
          (DirichletCharacter.LFunction chi rho = 0 ∧
            0 < rho.re ∧ rho.re < 1) →
            ∀ x T : ℝ, 4 ≤ x → 2 ≤ T → T ≤ x → |rho.im| ≤ T →
              ‖dirichletExplicitFormulaKernel x rho‖ ≤
                    12 * x ^ (1 - 1 / ((M : ℝ) ^ 2 *
                      Real.log ((q : ℝ) * (T + 2)))) /
                        (1 + |rho.im|) ∨
                1 - 1 / ((M : ℝ) ^ 2 *
                    Real.log ((q : ℝ) * (|rho.im| + 2))) ≤ rho.re ∧
                  regularizedDirichletLFunctionProduct q rho = 0 ∧
                    analyticOrderNatAt
                        (regularizedDirichletLFunctionProduct q) rho = 1 ∧
                      (∀ zeta : ℂ,
                        1 - 1 / ((M : ℝ) ^ 2 *
                            Real.log ((q : ℝ) * (|zeta.im| + 2))) ≤ zeta.re →
                          regularizedDirichletLFunctionProduct q zeta = 0 →
                            zeta = rho) ∧
                        ∃ psi : DirichletCharacter ℂ q,
                          (psi ≠ 1 ∧
                            DirichletCharacter.completedLFunction psi.primitiveCharacter rho = 0) ∧
                            chi = psi ∧ psi ^ 2 = 1 ∧ rho.im = 0 ∧
                              analyticOrderNatAt
                                  (DirichletCharacter.LFunction psi) rho = 1 ∧
                                ∀ eta : DirichletCharacter ℂ q,
                                  (DirichletCharacter.LFunction eta rho = 0 ∧
                                    0 < rho.re ∧ rho.re < 1) →
                                    eta = psi := by
  obtain ⟨Ms, hMs, hstructure⟩ :=
    exists_nat_regularizedDirichletLFunctionProduct_zero_structure
  obtain ⟨Mp, hMp, hprincipal⟩ :=
    exists_nat_principal_LFunction_openStrip_zero_re_lt
  obtain ⟨Mu, hMu, hunique⟩ :=
    exists_nat_regularizedDirichletLFunctionProduct_zero_eq
  let M : ℕ := max Ms (max Mp Mu)
  have hM : 2 ≤ M := hMs.trans (le_max_left _ _)
  refine ⟨M, hM, ?_⟩
  intro q _ chi rho hzero x T hx hT _hTx hheight
  let Lrho : ℝ := Real.log ((q : ℝ) * (|rho.im| + 2))
  let LT : ℝ := Real.log ((q : ℝ) * (T + 2))
  have hq : (1 : ℝ) ≤ q := by exact_mod_cast NeZero.pos q
  have hheightPos : 0 < |rho.im| + 2 := by
    linarith [abs_nonneg rho.im]
  have hLrhoPos : 0 < Lrho := by
    exact (Real.log_pos one_lt_two).trans_le
      (Real.log_le_log zero_lt_two
        (by
          nlinarith [mul_le_mul hq
            (show (2 : ℝ) ≤ |rho.im| + 2 by
              linarith [abs_nonneg rho.im])
            (by norm_num : (0 : ℝ) ≤ 2) (by positivity : (0 : ℝ) ≤ q)]))
  have hLrhoLT : Lrho ≤ LT := by
    dsimp [Lrho, LT]
    apply Real.log_le_log (mul_pos (by exact_mod_cast NeZero.pos q) hheightPos)
    exact mul_le_mul_of_nonneg_left (by linarith) (by positivity)
  by_cases hnear :
      1 - 1 / ((M : ℝ) ^ 2 * Lrho) ≤ rho.re
  · right
    have hrhoOne : rho ≠ 1 := by
      intro hrho
      have hre := congrArg Complex.re hrho
      norm_num at hre
      linarith [hzero.2.2]
    have hproduct : regularizedDirichletLFunctionProduct q rho = 0 :=
      (regularizedDirichletLFunctionProduct_eq_zero_iff q rho).2
        ⟨hrhoOne, chi, hzero.1⟩
    have hnearStructure :
        1 - 1 / ((Ms : ℝ) ^ 2 * Lrho) ≤ rho.re :=
      near_one_of_le_of_scale_le (one_le_two.trans hMs)
        (le_max_left _ _) hLrhoPos le_rfl hnear
    obtain ⟨hproductOrder, psi, hpsi, hpsiSq, him,
        hpsiOrder, hlabel⟩ :=
      hstructure q rho (by simpa [Lrho] using hnearStructure) hproduct
    let L0 : ℝ := Real.log (|rho.im| + 2)
    have hL0Pos : 0 < L0 := by
      exact Real.log_pos (by linarith [abs_nonneg rho.im])
    have hL0Lrho : L0 ≤ Lrho := by
      dsimp [L0, Lrho]
      exact Real.log_le_log hheightPos (by nlinarith)
    have hnearPrincipal :
        1 - 1 / ((Mp : ℝ) ^ 2 * L0) ≤ rho.re :=
      near_one_of_le_of_scale_le (one_le_two.trans hMp)
        ((le_max_left Mp Mu).trans (le_max_right Ms (max Mp Mu)))
        hL0Pos hL0Lrho hnear
    have hall : ∀ eta : DirichletCharacter ℂ q,
        (DirichletCharacter.LFunction eta rho = 0 ∧
          0 < rho.re ∧ rho.re < 1) → eta = psi := by
      intro eta heta
      by_cases hetaOne : eta = 1
      · subst eta
        have hlt := hprincipal q rho heta.2.1 heta.2.2 heta.1
        exact (not_lt_of_ge (by simpa [L0] using hnearPrincipal) hlt).elim
      · apply hlabel
        exact (isNonprincipalNontrivialLFunctionZero_iff eta rho).2
          ⟨hetaOne, heta.1, heta.2.1, heta.2.2⟩
    have hnearUniqueRho :
        1 - 1 / ((Mu : ℝ) ^ 2 * Lrho) ≤ rho.re :=
      near_one_of_le_of_scale_le (one_le_two.trans hMu)
        ((le_max_right Mp Mu).trans (le_max_right Ms (max Mp Mu)))
        hLrhoPos le_rfl hnear
    have hpoint : ∀ zeta : ℂ,
        1 - 1 / ((M : ℝ) ^ 2 *
            Real.log ((q : ℝ) * (|zeta.im| + 2))) ≤ zeta.re →
          regularizedDirichletLFunctionProduct q zeta = 0 →
            zeta = rho := by
      intro zeta hnearZeta hproductZeta
      let Lzeta : ℝ := Real.log ((q : ℝ) * (|zeta.im| + 2))
      have hLzetaPos : 0 < Lzeta := by
        exact (Real.log_pos one_lt_two).trans_le
          (Real.log_le_log zero_lt_two
            (by simpa [Lzeta] using two_le_level_height (q := q) zeta.im))
      have hnearUniqueZeta :
          1 - 1 / ((Mu : ℝ) ^ 2 * Lzeta) ≤ zeta.re :=
        near_one_of_le_of_scale_le (one_le_two.trans hMu)
          ((le_max_right Mp Mu).trans (le_max_right Ms (max Mp Mu)))
          hLzetaPos le_rfl (by simpa only [Lzeta] using hnearZeta)
      exact hunique q zeta rho
        (by simpa only [Lzeta] using hnearUniqueZeta)
        (by simpa only [Lrho] using hnearUniqueRho)
        hproductZeta hproduct
    exact ⟨by simpa only [Lrho] using hnear, hproduct, hproductOrder,
      hpoint, psi, hpsi, hall chi hzero, hpsiSq, him, hpsiOrder, hall⟩
  · left
    have hfarActual :
        rho.re < 1 - 1 / ((M : ℝ) ^ 2 * Lrho) :=
      lt_of_not_ge hnear
    have hMpos : (0 : ℝ) < M := by
      exact_mod_cast (show 0 < M by omega)
    have hdenLe : (M : ℝ) ^ 2 * Lrho ≤ (M : ℝ) ^ 2 * LT :=
      mul_le_mul_of_nonneg_left hLrhoLT (sq_nonneg (M : ℝ))
    have hinv : 1 / ((M : ℝ) ^ 2 * LT) ≤
        1 / ((M : ℝ) ^ 2 * Lrho) :=
      one_div_le_one_div_of_le (mul_pos (sq_pos_of_pos hMpos) hLrhoPos)
        hdenLe
    have hfarT :
        rho.re < 1 - 1 / ((M : ℝ) ^ 2 * LT) := by
      linarith
    simpa only [M, LT] using
      (norm_kernel_le_far (M := M) hM hx hT hzero
        (by simpa only [LT] using hfarT))

end

section
open Complex Set

attribute [local instance] inducingEulerProductConductorNeZero
@[simp]
theorem mem_dirichletNontrivialLFunctionZeroWindowFinset_iff
    {q : ℕ} [NeZero q] {chi : DirichletCharacter ℂ q}
    {t : ℝ} {rho : ℂ} :
    rho ∈ dirichletNontrivialLFunctionZeroWindowFinset chi t ↔
      (DirichletCharacter.LFunction chi rho = 0 ∧
        0 < rho.re ∧ rho.re < 1) ∧
        |rho.im - t| ≤ 1 := by
  classical
  rw [dirichletNontrivialLFunctionZeroWindowFinset, Finset.mem_filter,
    mem_dirichletNontrivialLFunctionZerosFinset_iff]
  have hcutoff : 0 ≤ |t| + 1 := by linarith [abs_nonneg t]
  rw [abs_of_nonneg hcutoff]
  constructor
  · rintro ⟨⟨hzero, _⟩, hwindow⟩
    exact ⟨hzero, hwindow⟩
  · rintro ⟨hzero, hwindow⟩
    refine ⟨⟨hzero, ?_⟩, hwindow⟩
    calc
      |rho.im| = |(rho.im - t) + t| := by ring_nf
      _ ≤ |rho.im - t| + |t| := abs_add_le _ _
      _ ≤ 1 + |t| := by
        simpa [add_comm] using add_le_add_right hwindow |t|
      _ = |t| + 1 := add_comm _ _

end

section
open Complex Set

section DirichletZeroWindowMultiplicity
theorem sum_natCast_le_finsum_intCast
    {α : Type*} (S : Finset α) (m : α → ℕ) (D : α → ℤ)
    (hDfinite : D.support.Finite) (hDnonneg : 0 ≤ D)
    (hm : ∀ a ∈ S, (m a : ℤ) ≤ D a) :
    (∑ a ∈ S, (m a : ℝ)) ≤ ((∑ᶠ a, D a : ℤ) : ℝ) := by
  have hzeroFinite : (0 : α → ℤ).support.Finite := by simp
  have hzeroNonneg : (0 : α → ℤ) ≤ 0 := le_rfl
  have hpair := sum_natCast_le_finsum_intCast_pair
    S m D 0 hDfinite hzeroFinite hDnonneg hzeroNonneg
    (fun a ha => by simpa using hm a ha)
  simpa using hpair

end DirichletZeroWindowMultiplicity

theorem
    exists_nat_sum_dirichletNontrivialZeroWindowMultiplicity_of_isPrimitive_le :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q), chi.IsPrimitive →
          ∀ t : ℝ,
            (∑ rho ∈ dirichletNontrivialLFunctionZeroWindowFinset chi t,
              (analyticOrderNatAt
                (DirichletCharacter.LFunction chi) rho : ℝ)) ≤
              2 * (A : ℝ) *
                Real.log ((q : ℝ) * (|t| + 2)) := by
  obtain ⟨Ap, hAp, hp⟩ :=
    exists_nat_finsum_divisor_LFunction_radiusSix_le
  obtain ⟨Az, hAz, hz⟩ :=
    exists_nat_finsum_divisor_riemannZeta₁_radiusSix_le
  let A := max Ap Az
  refine ⟨A, hAp.trans (Nat.le_max_left Ap Az), ?_⟩
  intro q _ chi hchi t
  by_cases hqOne : q = 1
  · subst q
    have hchiOne : chi = 1 := Subsingleton.elim _ _
    subst chi
    let D : ℂ → ℤ :=
      MeromorphicOn.divisor riemannZeta₁
        (closedBall ((2 : ℂ) + t * I) 6)
    have hDfinite : D.support.Finite := by
      simpa [D] using divisor_riemannZeta₁_closedBall_support_finite
        ((2 : ℂ) + t * I) 6
    have hDnonneg : 0 ≤ D := by
      intro rho
      exact (divisor_riemannZeta₁_nonneg
        (closedBall ((2 : ℂ) + t * I) 6)) rho
    have hcoeff : ∀ rho ∈
        dirichletNontrivialLFunctionZeroWindowFinset
          (1 : DirichletCharacter ℂ 1) t,
        (analyticOrderNatAt
            (DirichletCharacter.LFunction
              (1 : DirichletCharacter ℂ 1)) rho : ℤ) ≤ D rho := by
      intro rho hrho
      obtain ⟨hzero, hheight⟩ :=
        mem_dirichletNontrivialLFunctionZeroWindowFinset_iff.mp hrho
      have hrhoOne : rho ≠ 1 := by
        intro hrho
        have hre := congrArg Complex.re hrho
        norm_num at hre
        linarith [hzero.2.2]
      have hdisk := IsDirichletNontrivialLFunctionZero.dist_two_add_mul_I_le_six
          hzero hheight
      have horder :=
        analyticOrderNatAt_LFunction_modOne_eq_riemannZeta₁_of_ne_one
          hrhoOne
      have hD : D rho = (analyticOrderNatAt riemannZeta₁ rho : ℤ) := by
        dsimp [D]
        exact divisor_riemannZeta₁_apply_eq_analyticOrderNatAt
          (mem_closedBall.mpr hdisk)
      rw [horder, hD]
    have hsubmass := sum_natCast_le_finsum_intCast
      (dirichletNontrivialLFunctionZeroWindowFinset
        (1 : DirichletCharacter ℂ 1) t)
      (fun rho => analyticOrderNatAt
        (DirichletCharacter.LFunction
          (1 : DirichletCharacter ℂ 1)) rho)
      D hDfinite hDnonneg hcoeff
    have hAzA : (Az : ℝ) ≤ A := by
      exact_mod_cast Nat.le_max_right Ap Az
    have hlogNonneg : 0 ≤ Real.log (|t| + 2) :=
      Real.log_nonneg (by linarith [abs_nonneg t])
    calc
      (∑ rho ∈ dirichletNontrivialLFunctionZeroWindowFinset
          (1 : DirichletCharacter ℂ 1) t,
        (analyticOrderNatAt
          (DirichletCharacter.LFunction
            (1 : DirichletCharacter ℂ 1)) rho : ℝ)) ≤
          ((∑ᶠ rho, D rho : ℤ) : ℝ) := hsubmass
      _ ≤ 2 * (Az : ℝ) * Real.log (|t| + 2) := by
        simpa [D] using hz t
      _ ≤ 2 * (A : ℝ) * Real.log (|t| + 2) := by
        exact mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left hAzA (by norm_num)) hlogNonneg
      _ = 2 * (A : ℝ) *
          Real.log (((1 : ℕ) : ℝ) * (|t| + 2)) := by simp
  · have hq : 1 < q := by
      have hqpos := NeZero.pos q
      omega
    have hchiNe : chi ≠ 1 :=
      character_ne_one_of_isPrimitive hq chi hchi
    let D : ℂ → ℤ :=
      MeromorphicOn.divisor (DirichletCharacter.LFunction chi)
        (closedBall ((2 : ℂ) + t * I) 6)
    have hDfinite : D.support.Finite := by
      simpa [D] using divisor_LFunction_closedBall_support_finite
        hchiNe ((2 : ℂ) + t * I) 6
    have hDnonneg : 0 ≤ D := by
      intro rho
      exact (divisor_LFunction_nonneg hchiNe
        (closedBall ((2 : ℂ) + t * I) 6)) rho
    have hcoeff : ∀ rho ∈
        dirichletNontrivialLFunctionZeroWindowFinset chi t,
        (analyticOrderNatAt
            (DirichletCharacter.LFunction chi) rho : ℤ) ≤ D rho := by
      intro rho hrho
      obtain ⟨hzero, hheight⟩ :=
        mem_dirichletNontrivialLFunctionZeroWindowFinset_iff.mp hrho
      have hdisk := IsDirichletNontrivialLFunctionZero.dist_two_add_mul_I_le_six
          hzero hheight
      have hD : D rho =
          (analyticOrderNatAt
            (DirichletCharacter.LFunction chi) rho : ℤ) := by
        dsimp [D]
        exact divisor_LFunction_apply_eq_analyticOrderNatAt
          hchiNe (mem_closedBall.mpr hdisk)
      rw [hD]
    have hsubmass := sum_natCast_le_finsum_intCast
      (dirichletNontrivialLFunctionZeroWindowFinset chi t)
      (fun rho => analyticOrderNatAt
        (DirichletCharacter.LFunction chi) rho)
      D hDfinite hDnonneg hcoeff
    have hApA : (Ap : ℝ) ≤ A := by
      exact_mod_cast Nat.le_max_left Ap Az
    have hqReal : (1 : ℝ) ≤ q := by exact_mod_cast NeZero.pos q
    have hscale : (1 : ℝ) ≤ (q : ℝ) * (|t| + 2) := by
      nlinarith [mul_le_mul hqReal
        (show (1 : ℝ) ≤ |t| + 2 by linarith [abs_nonneg t])
        (by norm_num : (0 : ℝ) ≤ 1) (by positivity : (0 : ℝ) ≤ q)]
    have hlogNonneg :
        0 ≤ Real.log ((q : ℝ) * (|t| + 2)) :=
      Real.log_nonneg hscale
    calc
      (∑ rho ∈ dirichletNontrivialLFunctionZeroWindowFinset chi t,
        (analyticOrderNatAt
          (DirichletCharacter.LFunction chi) rho : ℝ)) ≤
          ((∑ᶠ rho, D rho : ℤ) : ℝ) := hsubmass
      _ ≤ 2 * (Ap : ℝ) *
          Real.log ((q : ℝ) * (|t| + 2)) := by
        simpa [D] using hp q hq chi hchi t
      _ ≤ 2 * (A : ℝ) *
          Real.log ((q : ℝ) * (|t| + 2)) := by
        exact mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left hApA (by norm_num)) hlogNonneg

end

section
open Complex Set

section DirichletZeroReciprocalSum
attribute [local instance] inducingEulerProductConductorNeZero

end DirichletZeroReciprocalSum
end

section
open Complex Set

attribute [local instance] inducingEulerProductConductorNeZero
/--
The sum of zero multiplicities divided by `1 + |rho.im|` over nontrivial zeros through height
`|T|`. This reciprocal-height weight controls zero contributions in the explicit formula.
-/
noncomputable def dirichletNontrivialZeroReciprocalMultiplicitySum
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    (T : ℝ) : ℝ :=
  ∑ rho ∈ dirichletNontrivialLFunctionZerosFinset chi T,
    (analyticOrderNatAt
      (DirichletCharacter.LFunction chi) rho : ℝ) /
        (1 + |rho.im|)

theorem
    dirichletNontrivialZeroReciprocalMultiplicitySum_eq_inducingPrimitive
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q) (T : ℝ) :
    dirichletNontrivialZeroReciprocalMultiplicitySum chi T =
      dirichletNontrivialZeroReciprocalMultiplicitySum
        chi.primitiveCharacter T := by
  classical
  rw [dirichletNontrivialZeroReciprocalMultiplicitySum,
    dirichletNontrivialZeroReciprocalMultiplicitySum,
    dirichletNontrivialLFunctionZerosFinset_eq_inducingPrimitive chi T]
  apply Finset.sum_congr rfl
  intro rho hrho
  have hzero :=
    (mem_dirichletNontrivialLFunctionZerosFinset_iff.mp hrho).1
  have hrhoOne : rho ≠ 1 := by
    intro hrho
    have hre := congrArg Complex.re hrho
    norm_num at hre
    linarith [hzero.2.2]
  rw [analyticOrderNatAt_LFunction_eq_inducingPrimitive_of_re_pos_of_guard
    chi (.inr hrhoOne) hzero.2.1]

end

section
open Complex Set

attribute [local instance] inducingEulerProductConductorNeZero

section DirichletZeroReciprocalSum
theorem sum_range_inv_nat_add_one_eq_harmonic (N : ℕ) :
    (∑ n ∈ Finset.range N, (((n + 1 : ℕ) : ℝ))⁻¹) =
      (harmonic N : ℝ) := by
  simp only [harmonic, Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast]

theorem
    exists_nat_dirichletNontrivialZeroReciprocalMultiplicitySum_le_of_isPrimitive :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q), chi.IsPrimitive →
          ∀ T : ℝ, 2 ≤ T →
            dirichletNontrivialZeroReciprocalMultiplicitySum chi T ≤
              8 * (A : ℝ) *
                Real.log ((q : ℝ) * (T + 2)) ^ 2 := by
  obtain ⟨A, hA, hwindow⟩ :=
    exists_nat_sum_dirichletNontrivialZeroWindowMultiplicity_of_isPrimitive_le
  refine ⟨A, hA, ?_⟩
  intro q _ chi hchi T hT
  let S := dirichletNontrivialLFunctionZerosFinset chi T
  let N := ⌊T⌋₊ + 1
  let L := Real.log ((q : ℝ) * (T + 2))
  let g : ℂ → ℕ := fun rho => ⌊|rho.im|⌋₊
  let m : ℂ → ℝ := fun rho =>
    analyticOrderNatAt (DirichletCharacter.LFunction chi) rho
  have hT0 : 0 ≤ T := by linarith
  have hq : (1 : ℝ) ≤ q := by exact_mod_cast NeZero.pos q
  have hq0 : (0 : ℝ) ≤ q := zero_le_one.trans hq
  have hscaleFour : (4 : ℝ) ≤ (q : ℝ) * (T + 2) := by
    nlinarith [mul_le_mul hq
      (show (4 : ℝ) ≤ T + 2 by linarith)
      (by norm_num : (0 : ℝ) ≤ 4) hq0]
  have hLOne : (1 : ℝ) ≤ L := by
    have hlogFour : (1 : ℝ) < Real.log 4 := by
      rw [Real.log_four_eq]
      nlinarith [Real.log_two_gt_d9]
    exact hlogFour.le.trans
      (Real.log_le_log (by norm_num) (by simpa [L] using hscaleFour))
  have hmaps : ∀ rho ∈ S, g rho ∈ Finset.range N := by
    intro rho hrho
    have hheight :=
      (mem_dirichletNontrivialLFunctionZerosFinset_iff.mp hrho).2
    rw [abs_of_nonneg hT0] at hheight
    rw [Finset.mem_range]
    have hfloor : ⌊|rho.im|⌋₊ ≤ ⌊T⌋₊ :=
      Nat.floor_mono hheight
    simpa [g, N] using Nat.lt_succ_of_le hfloor
  have hnT : ∀ n ∈ Finset.range N, (n : ℝ) ≤ T := by
    intro n hn
    have hnNat : n ≤ ⌊T⌋₊ := by
      simpa [N] using Nat.le_of_lt_succ (Finset.mem_range.mp hn)
    exact (Nat.cast_le.mpr hnNat).trans (Nat.floor_le hT0)
  have hwindowScale : ∀ n ∈ Finset.range N,
      Real.log ((q : ℝ) * ((n : ℝ) + 2)) ≤ L := by
    intro n hn
    have hn := hnT n hn
    dsimp [L]
    apply Real.log_le_log (mul_pos (by linarith) (by positivity))
    exact mul_le_mul_of_nonneg_left (by linarith) hq0
  have hfiberMass : ∀ n ∈ Finset.range N,
      (∑ rho ∈ S with g rho = n, m rho) ≤
        4 * (A : ℝ) * L := by
    intro n hn
    let F := S.filter fun rho => g rho = n
    let Fplus := F.filter fun rho => 0 ≤ rho.im
    let Fminus := F.filter fun rho => ¬ 0 ≤ rho.im
    have hplusSubset : Fplus ⊆
        dirichletNontrivialLFunctionZeroWindowFinset chi (n : ℝ) := by
      intro rho hrho
      have hrho' := Finset.mem_filter.mp hrho
      have hF := Finset.mem_filter.mp hrho'.1
      have hzero :=
        (mem_dirichletNontrivialLFunctionZerosFinset_iff.mp hF.1).1
      have hfloor := hF.2
      have him := hrho'.2
      have hlower : (n : ℝ) ≤ |rho.im| := by
        rw [← hfloor]
        exact Nat.floor_le (abs_nonneg rho.im)
      have hupper : |rho.im| < (n : ℝ) + 1 := by
        have h := Nat.lt_floor_add_one |rho.im|
        have hfloor' : ⌊|rho.im|⌋₊ = n := by
          simpa [g] using hfloor
        rw [hfloor'] at h
        simpa using h
      rw [mem_dirichletNontrivialLFunctionZeroWindowFinset_iff]
      refine ⟨hzero, ?_⟩
      rw [abs_of_nonneg him] at hlower hupper
      rw [abs_le]
      constructor <;> linarith
    have hminusSubset : Fminus ⊆
        dirichletNontrivialLFunctionZeroWindowFinset chi (-(n : ℝ)) := by
      intro rho hrho
      have hrho' := Finset.mem_filter.mp hrho
      have hF := Finset.mem_filter.mp hrho'.1
      have hzero :=
        (mem_dirichletNontrivialLFunctionZerosFinset_iff.mp hF.1).1
      have hfloor := hF.2
      have him : rho.im ≤ 0 := le_of_not_ge hrho'.2
      have hlower : (n : ℝ) ≤ |rho.im| := by
        rw [← hfloor]
        exact Nat.floor_le (abs_nonneg rho.im)
      have hupper : |rho.im| < (n : ℝ) + 1 := by
        have h := Nat.lt_floor_add_one |rho.im|
        have hfloor' : ⌊|rho.im|⌋₊ = n := by
          simpa [g] using hfloor
        rw [hfloor'] at h
        simpa using h
      rw [mem_dirichletNontrivialLFunctionZeroWindowFinset_iff]
      refine ⟨hzero, ?_⟩
      rw [abs_of_nonpos him] at hlower hupper
      rw [abs_le]
      constructor <;> linarith
    have hplus : (∑ rho ∈ Fplus, m rho) ≤
        ∑ rho ∈ dirichletNontrivialLFunctionZeroWindowFinset chi (n : ℝ),
          m rho :=
      Finset.sum_le_sum_of_subset_of_nonneg hplusSubset
        (fun rho _ _ => by simp [m])
    have hminus : (∑ rho ∈ Fminus, m rho) ≤
        ∑ rho ∈
          dirichletNontrivialLFunctionZeroWindowFinset chi (-(n : ℝ)),
            m rho :=
      Finset.sum_le_sum_of_subset_of_nonneg hminusSubset
        (fun rho _ _ => by simp [m])
    have hwindowPlus := hwindow q chi hchi (n : ℝ)
    have hwindowMinus := hwindow q chi hchi (-(n : ℝ))
    have hlog := hwindowScale n hn
    have hwindowPlus' :
        (∑ rho ∈
            dirichletNontrivialLFunctionZeroWindowFinset chi (n : ℝ),
          m rho) ≤
          2 * (A : ℝ) *
            Real.log ((q : ℝ) * ((n : ℝ) + 2)) := by
      simpa [m, abs_of_nonneg (show (0 : ℝ) ≤ (n : ℝ) by positivity)] using
        hwindowPlus
    have hplusBound : (∑ rho ∈ Fplus, m rho) ≤
        2 * (A : ℝ) * L := by
      exact hplus.trans (hwindowPlus'.trans
        (mul_le_mul_of_nonneg_left hlog (by positivity)))
    have hminusBound : (∑ rho ∈ Fminus, m rho) ≤
        2 * (A : ℝ) * L := by
      have hwindowMinus' :
          (∑ rho ∈
              dirichletNontrivialLFunctionZeroWindowFinset chi (-(n : ℝ)),
            m rho) ≤
            2 * (A : ℝ) *
              Real.log ((q : ℝ) * ((n : ℝ) + 2)) := by
        simpa [m, abs_of_nonneg (show (0 : ℝ) ≤ (n : ℝ) by positivity)] using
          hwindowMinus
      exact hminus.trans (hwindowMinus'.trans
        (mul_le_mul_of_nonneg_left hlog (by positivity)))
    have hsplit := Finset.sum_filter_add_sum_filter_not
      F (fun rho => 0 ≤ rho.im) m
    change (∑ rho ∈ F, m rho) ≤ 4 * (A : ℝ) * L
    rw [← hsplit]
    linarith
  have hfiberWeight : ∀ n ∈ Finset.range N,
      (∑ rho ∈ S with g rho = n,
        m rho / (1 + |rho.im|)) ≤
          (4 * (A : ℝ) * L) * (((n + 1 : ℕ) : ℝ))⁻¹ := by
    intro n hn
    calc
      (∑ rho ∈ S with g rho = n,
          m rho / (1 + |rho.im|)) ≤
          ∑ rho ∈ S with g rho = n,
            m rho * (((n + 1 : ℕ) : ℝ))⁻¹ := by
        apply Finset.sum_le_sum
        intro rho hrho
        have hfloor := (Finset.mem_filter.mp hrho).2
        have hnle : (n : ℝ) ≤ |rho.im| := by
          rw [← hfloor]
          exact Nat.floor_le (abs_nonneg rho.im)
        have hden : ((n + 1 : ℕ) : ℝ) ≤ 1 + |rho.im| := by
          norm_num only [Nat.cast_add, Nat.cast_one]
          linarith
        have hinv : (1 + |rho.im|)⁻¹ ≤
            (((n + 1 : ℕ) : ℝ))⁻¹ := by
          simpa [one_div] using one_div_le_one_div_of_le
            (by positivity : (0 : ℝ) < ((n + 1 : ℕ) : ℝ)) hden
        rw [div_eq_mul_inv]
        exact mul_le_mul_of_nonneg_left hinv (by positivity)
      _ = (∑ rho ∈ S with g rho = n, m rho) *
          (((n + 1 : ℕ) : ℝ))⁻¹ := by
        rw [Finset.sum_mul]
      _ ≤ (4 * (A : ℝ) * L) * (((n + 1 : ℕ) : ℝ))⁻¹ :=
        mul_le_mul_of_nonneg_right (hfiberMass n hn) (by positivity)
  have hfiber := Finset.sum_fiberwise_of_maps_to
    (s := S) (t := Finset.range N) (g := g) hmaps
    (fun rho => m rho / (1 + |rho.im|))
  have hNreal : (N : ℝ) ≤ T + 1 := by
    dsimp [N]
    norm_num only [Nat.cast_add, Nat.cast_one]
    linarith [Nat.floor_le hT0]
  have hNpos : (0 : ℝ) < N := by positivity
  have hNscale : (N : ℝ) ≤ (q : ℝ) * (T + 2) := by
    calc
      (N : ℝ) ≤ T + 1 := hNreal
      _ ≤ T + 2 := by linarith
      _ = 1 * (T + 2) := by ring
      _ ≤ (q : ℝ) * (T + 2) :=
        mul_le_mul hq le_rfl (by linarith) (by norm_num)
  have hlogN : Real.log N ≤ L := by
    simpa [L] using Real.log_le_log hNpos hNscale
  have hharmonic : (harmonic N : ℝ) ≤ 2 * L := by
    have hbase := harmonic_le_one_add_log N
    linarith
  rw [dirichletNontrivialZeroReciprocalMultiplicitySum]
  change (∑ rho ∈ S, m rho / (1 + |rho.im|)) ≤ _
  rw [← hfiber]
  calc
    (∑ n ∈ Finset.range N,
        ∑ rho ∈ S with g rho = n,
          m rho / (1 + |rho.im|)) ≤
        ∑ n ∈ Finset.range N,
          (4 * (A : ℝ) * L) * (((n + 1 : ℕ) : ℝ))⁻¹ :=
      Finset.sum_le_sum hfiberWeight
    _ = (4 * (A : ℝ) * L) * (harmonic N : ℝ) := by
      rw [← Finset.mul_sum, sum_range_inv_nat_add_one_eq_harmonic]
    _ ≤ (4 * (A : ℝ) * L) * (2 * L) :=
      mul_le_mul_of_nonneg_left hharmonic (by positivity)
    _ = 8 * (A : ℝ) * L ^ 2 := by ring
    _ = 8 * (A : ℝ) *
        Real.log ((q : ℝ) * (T + 2)) ^ 2 := rfl

end DirichletZeroReciprocalSum
end

section
open Complex Set

attribute [local instance] inducingEulerProductConductorNeZero
theorem exists_nat_dirichletNontrivialZeroReciprocalMultiplicitySum_le :
    ∃ A : ℕ, 37 ≤ A ∧
      ∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q) (T : ℝ), 2 ≤ T →
          dirichletNontrivialZeroReciprocalMultiplicitySum chi T ≤
            8 * (A : ℝ) *
              Real.log ((q : ℝ) * (T + 2)) ^ 2 := by
  obtain ⟨A, hA, hprimitive⟩ :=
    exists_nat_dirichletNontrivialZeroReciprocalMultiplicitySum_le_of_isPrimitive
  refine ⟨A, hA, ?_⟩
  intro q _ chi T hT
  have hbase := hprimitive chi.conductor chi.primitiveCharacter
    chi.primitiveCharacter_isPrimitive T hT
  have hdqNat : chi.conductor ≤ q :=
    Nat.le_of_dvd (NeZero.pos q) chi.conductor_dvd_level
  have hdq : (chi.conductor : ℝ) ≤ q := by exact_mod_cast hdqNat
  have hTpos : 0 < T + 2 := by linarith
  have hdpos : (0 : ℝ) < chi.conductor := by
    exact_mod_cast NeZero.pos chi.conductor
  have hscale : (chi.conductor : ℝ) * (T + 2) ≤
      (q : ℝ) * (T + 2) :=
    mul_le_mul_of_nonneg_right hdq hTpos.le
  have hlog :
      Real.log ((chi.conductor : ℝ) * (T + 2)) ≤
        Real.log ((q : ℝ) * (T + 2)) :=
    Real.log_le_log (mul_pos hdpos hTpos) hscale
  have hleftNonneg :
      0 ≤ Real.log ((chi.conductor : ℝ) * (T + 2)) := by
    apply Real.log_nonneg
    nlinarith [mul_le_mul (show (1 : ℝ) ≤ chi.conductor by
      exact_mod_cast NeZero.pos chi.conductor)
      (show (1 : ℝ) ≤ T + 2 by linarith)
      (by norm_num : (0 : ℝ) ≤ 1)
      (by positivity : (0 : ℝ) ≤ chi.conductor)]
  have hrightNonneg : 0 ≤ Real.log ((q : ℝ) * (T + 2)) :=
    hleftNonneg.trans hlog
  have hsquare :
      Real.log ((chi.conductor : ℝ) * (T + 2)) ^ 2 ≤
        Real.log ((q : ℝ) * (T + 2)) ^ 2 :=
    sq_le_sq₀ hleftNonneg hrightNonneg |>.2 hlog
  rw [dirichletNontrivialZeroReciprocalMultiplicitySum_eq_inducingPrimitive
    chi T]
  exact hbase.trans
    (mul_le_mul_of_nonneg_left hsquare (by positivity))

end

section
open Complex

attribute [local instance] inducingEulerProductConductorNeZero
/--
Nontrivial zeros through height `|T|` carrying the full exceptional-zero certificate in the
region `re ≥ 1 - 1 / (M ^ 2 * log (q * (|im| + 2)))`. The certificate requires a unique simple
zero of the regularized character product, real and belonging to the unique nonprincipal
quadratic character that vanishes there, together with the corresponding primitive completed
L-function zero.
-/
noncomputable def dirichletExceptionalLFunctionZerosFinset
    (M : ℕ) {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (T : ℝ) : Finset ℂ := by
  classical
  exact (dirichletNontrivialLFunctionZerosFinset chi T).filter
    (fun rho : ℂ =>
      (1 - 1 / ((M : ℝ) ^ 2 *
           Real.log ((q : ℝ) * (|rho.im| + 2))) ≤ rho.re ∧
         regularizedDirichletLFunctionProduct q rho = 0 ∧
           analyticOrderNatAt
               (regularizedDirichletLFunctionProduct q) rho = 1 ∧
             (∀ zeta : ℂ,
               1 - 1 / ((M : ℝ) ^ 2 *
                   Real.log ((q : ℝ) * (|zeta.im| + 2))) ≤ zeta.re →
                 regularizedDirichletLFunctionProduct q zeta = 0 →
                   zeta = rho) ∧
               ∃ psi : DirichletCharacter ℂ q,
                 (psi ≠ 1 ∧
                    DirichletCharacter.completedLFunction psi.primitiveCharacter rho = 0) ∧
                   chi = psi ∧ psi ^ 2 = 1 ∧ rho.im = 0 ∧
                     analyticOrderNatAt
                         (DirichletCharacter.LFunction psi) rho = 1 ∧
                       ∀ eta : DirichletCharacter ℂ q,
                         (DirichletCharacter.LFunction eta rho = 0 ∧
                            0 < rho.re ∧ rho.re < 1) →
                           eta = psi))

/--
The nontrivial zeros through height `|T|` that do not satisfy the full exceptional-zero
certificate for `M`. This is the complementary part of the finite zero set, not merely a
restriction on the real part.
-/
noncomputable def dirichletNonexceptionalLFunctionZerosFinset
    (M : ℕ) {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (T : ℝ) : Finset ℂ := by
  classical
  exact (dirichletNontrivialLFunctionZerosFinset chi T).filter
    fun rho =>
      ¬ (1 - 1 / ((M : ℝ) ^ 2 *
             Real.log ((q : ℝ) * (|rho.im| + 2))) ≤ rho.re ∧
           regularizedDirichletLFunctionProduct q rho = 0 ∧
             analyticOrderNatAt
                 (regularizedDirichletLFunctionProduct q) rho = 1 ∧
               (∀ zeta : ℂ,
                 1 - 1 / ((M : ℝ) ^ 2 *
                     Real.log ((q : ℝ) * (|zeta.im| + 2))) ≤ zeta.re →
                   regularizedDirichletLFunctionProduct q zeta = 0 →
                     zeta = rho) ∧
                 ∃ psi : DirichletCharacter ℂ q,
                   (psi ≠ 1 ∧
                      DirichletCharacter.completedLFunction psi.primitiveCharacter rho = 0) ∧
                     chi = psi ∧ psi ^ 2 = 1 ∧ rho.im = 0 ∧
                       analyticOrderNatAt
                           (DirichletCharacter.LFunction psi) rho = 1 ∧
                         ∀ eta : DirichletCharacter ℂ q,
                           (DirichletCharacter.LFunction eta rho = 0 ∧
                              0 < rho.re ∧ rho.re < 1) →
                             eta = psi)

end

section
open Complex

attribute [local instance] inducingEulerProductConductorNeZero
attribute [local instance] inducingEulerProductConductorNeZero
@[simp]
theorem mem_dirichletExceptionalLFunctionZerosFinset_iff
    {M q : ℕ} [NeZero q] {chi : DirichletCharacter ℂ q}
    {T : ℝ} {rho : ℂ} :
    rho ∈ dirichletExceptionalLFunctionZerosFinset M chi T ↔
      (DirichletCharacter.LFunction chi rho = 0 ∧
        0 < rho.re ∧ rho.re < 1) ∧
        |rho.im| ≤ |T| ∧
          (1 - 1 / ((M : ℝ) ^ 2 *
              Real.log ((q : ℝ) * (|rho.im| + 2))) ≤ rho.re ∧
            regularizedDirichletLFunctionProduct q rho = 0 ∧
              analyticOrderNatAt
                  (regularizedDirichletLFunctionProduct q) rho = 1 ∧
                (∀ zeta : ℂ,
                  1 - 1 / ((M : ℝ) ^ 2 *
                      Real.log ((q : ℝ) * (|zeta.im| + 2))) ≤ zeta.re →
                    regularizedDirichletLFunctionProduct q zeta = 0 →
                      zeta = rho) ∧
                  ∃ psi : DirichletCharacter ℂ q,
                    (psi ≠ 1 ∧
                       DirichletCharacter.completedLFunction psi.primitiveCharacter rho = 0) ∧
                      chi = psi ∧ psi ^ 2 = 1 ∧ rho.im = 0 ∧
                        analyticOrderNatAt
                            (DirichletCharacter.LFunction psi) rho = 1 ∧
                          ∀ eta : DirichletCharacter ℂ q,
                            (DirichletCharacter.LFunction eta rho = 0 ∧
                               0 < rho.re ∧ rho.re < 1) →
                              eta = psi) := by
  classical
  rw [dirichletExceptionalLFunctionZerosFinset, Finset.mem_filter,
    mem_dirichletNontrivialLFunctionZerosFinset_iff, and_assoc]

@[simp]
theorem mem_dirichletNonexceptionalLFunctionZerosFinset_iff
    {M q : ℕ} [NeZero q] {chi : DirichletCharacter ℂ q}
    {T : ℝ} {rho : ℂ} :
    rho ∈ dirichletNonexceptionalLFunctionZerosFinset M chi T ↔
      (DirichletCharacter.LFunction chi rho = 0 ∧
        0 < rho.re ∧ rho.re < 1) ∧
        |rho.im| ≤ |T| ∧
          ¬ (1 - 1 / ((M : ℝ) ^ 2 *
              Real.log ((q : ℝ) * (|rho.im| + 2))) ≤ rho.re ∧
            regularizedDirichletLFunctionProduct q rho = 0 ∧
              analyticOrderNatAt
                  (regularizedDirichletLFunctionProduct q) rho = 1 ∧
                (∀ zeta : ℂ,
                  1 - 1 / ((M : ℝ) ^ 2 *
                      Real.log ((q : ℝ) * (|zeta.im| + 2))) ≤ zeta.re →
                    regularizedDirichletLFunctionProduct q zeta = 0 →
                      zeta = rho) ∧
                  ∃ psi : DirichletCharacter ℂ q,
                    (psi ≠ 1 ∧
                       DirichletCharacter.completedLFunction psi.primitiveCharacter rho = 0) ∧
                      chi = psi ∧ psi ^ 2 = 1 ∧ rho.im = 0 ∧
                        analyticOrderNatAt
                            (DirichletCharacter.LFunction psi) rho = 1 ∧
                          ∀ eta : DirichletCharacter ℂ q,
                            (DirichletCharacter.LFunction eta rho = 0 ∧
                               0 < rho.re ∧ rho.re < 1) →
                              eta = psi) := by
  classical
  rw [dirichletNonexceptionalLFunctionZerosFinset, Finset.mem_filter,
    mem_dirichletNontrivialLFunctionZerosFinset_iff, and_assoc]

end

section
open Complex
/--
The multiplicity-weighted explicit-formula kernel sum over zeros satisfying the exceptional-zero
certificate for `M`.
-/
noncomputable def dirichletExceptionalZeroKernelSum
    (M : ℕ) {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (x T : ℝ) : ℂ :=
  ∑ rho ∈ dirichletExceptionalLFunctionZerosFinset M chi T,
    (analyticOrderNatAt
      (DirichletCharacter.LFunction chi) rho : ℂ) *
        dirichletExplicitFormulaKernel x rho

/--
The multiplicity-weighted explicit-formula kernel sum over the nonexceptional part of the zeros
through height `|T|`.
-/
noncomputable def dirichletNonexceptionalZeroKernelSum
    (M : ℕ) {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (x T : ℝ) : ℂ :=
  ∑ rho ∈ dirichletNonexceptionalLFunctionZerosFinset M chi T,
    (analyticOrderNatAt
      (DirichletCharacter.LFunction chi) rho : ℂ) *
        dirichletExplicitFormulaKernel x rho

theorem card_dirichletExceptionalLFunctionZerosFinset_le_one
    (M : ℕ) {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (T : ℝ) :
    (dirichletExceptionalLFunctionZerosFinset M chi T).card ≤ 1 := by
  classical
  rw [Finset.card_le_one]
  intro rho hrho zeta hzeta
  have hr :=
    (mem_dirichletExceptionalLFunctionZerosFinset_iff.mp hrho).2.2
  have hz :=
    (mem_dirichletExceptionalLFunctionZerosFinset_iff.mp hzeta).2.2
  exact (hr.2.2.2.1 zeta hz.1 hz.2.1).symm

theorem
    exists_nat_exceptional_card_le_one_and_norm_nonexceptionalZeroKernelSum_le :
    ∃ M A : ℕ, 2 ≤ M ∧ 37 ≤ A ∧
      (∀ (q : ℕ) [NeZero q]
        (chi : DirichletCharacter ℂ q) (T : ℝ),
          (dirichletExceptionalLFunctionZerosFinset M chi T).card ≤ 1) ∧
        ∀ (q : ℕ) [NeZero q]
          (chi : DirichletCharacter ℂ q) (x T : ℝ),
            4 ≤ x → 2 ≤ T → T ≤ x →
              ‖dirichletNonexceptionalZeroKernelSum M chi x T‖ ≤
                96 * (A : ℝ) *
                  x ^ (1 - 1 / ((M : ℝ) ^ 2 *
                    Real.log ((q : ℝ) * (T + 2)))) *
                      Real.log ((q : ℝ) * (T + 2)) ^ 2 := by
  classical
  obtain ⟨M, hM, hpointwise⟩ :=
    exists_nat_norm_dirichletExplicitFormulaKernel_le_or_exceptional
  obtain ⟨A, hA, hreciprocal⟩ :=
    exists_nat_dirichletNontrivialZeroReciprocalMultiplicitySum_le
  refine ⟨M, A, hM, hA,
    fun q _ chi T =>
      card_dirichletExceptionalLFunctionZerosFinset_le_one M chi T, ?_⟩
  intro q _ chi x T hx hT hTx
  let alpha : ℝ := 1 - 1 / ((M : ℝ) ^ 2 *
    Real.log ((q : ℝ) * (T + 2)))
  let C : ℝ := 12 * x ^ alpha
  let w : ℂ → ℝ := fun rho =>
    (analyticOrderNatAt
      (DirichletCharacter.LFunction chi) rho : ℝ) /
        (1 + |rho.im|)
  have hT0 : 0 ≤ T := by linarith
  have hC0 : 0 ≤ C := by positivity
  have hsubset :
      dirichletNonexceptionalLFunctionZerosFinset M chi T ⊆
        dirichletNontrivialLFunctionZerosFinset chi T := by
    intro rho hrho
    rw [dirichletNonexceptionalLFunctionZerosFinset] at hrho
    exact (Finset.mem_filter.mp hrho).1
  have hsumSubset :
      (∑ rho ∈ dirichletNonexceptionalLFunctionZerosFinset M chi T,
          w rho) ≤
        ∑ rho ∈ dirichletNontrivialLFunctionZerosFinset chi T,
          w rho :=
    Finset.sum_le_sum_of_subset_of_nonneg hsubset
      (fun rho _ _ => div_nonneg (Nat.cast_nonneg _)
        (add_nonneg zero_le_one (abs_nonneg _)))
  have hterm : ∀ rho ∈
      dirichletNonexceptionalLFunctionZerosFinset M chi T,
      ‖(analyticOrderNatAt
          (DirichletCharacter.LFunction chi) rho : ℂ) *
            dirichletExplicitFormulaKernel x rho‖ ≤ C * w rho := by
    intro rho hrho
    obtain ⟨hzero, hheight, hnotExceptional⟩ :=
      mem_dirichletNonexceptionalLFunctionZerosFinset_iff.mp hrho
    have hheight' : |rho.im| ≤ T := by
      simpa [abs_of_nonneg hT0] using hheight
    have hsplit := hpointwise q chi rho hzero x T hx hT hTx hheight'
    have hkernel :
        ‖dirichletExplicitFormulaKernel x rho‖ ≤
          12 * x ^ alpha / (1 + |rho.im|) := by
      rcases hsplit with hbound | hexceptional
      · simpa only [alpha] using hbound
      · exact (hnotExceptional hexceptional).elim
    rw [norm_mul, Complex.norm_natCast]
    calc
      (analyticOrderNatAt
          (DirichletCharacter.LFunction chi) rho : ℝ) *
            ‖dirichletExplicitFormulaKernel x rho‖ ≤
          (analyticOrderNatAt
            (DirichletCharacter.LFunction chi) rho : ℝ) *
              (12 * x ^ alpha / (1 + |rho.im|)) :=
        mul_le_mul_of_nonneg_left hkernel (by positivity)
      _ = C * w rho := by
        dsimp [C, w]
        ring
  have hreciprocalBound := hreciprocal q chi T hT
  calc
    _ ≤ ∑ rho ∈ dirichletNonexceptionalLFunctionZerosFinset M chi T,
        C * w rho := norm_sum_le_of_le _ hterm
    _ = C *
        ∑ rho ∈ dirichletNonexceptionalLFunctionZerosFinset M chi T,
          w rho := by rw [Finset.mul_sum]
    _ ≤ C *
        ∑ rho ∈ dirichletNontrivialLFunctionZerosFinset chi T,
          w rho := mul_le_mul_of_nonneg_left hsumSubset hC0
    _ = C * dirichletNontrivialZeroReciprocalMultiplicitySum chi T := by
      rw [dirichletNontrivialZeroReciprocalMultiplicitySum]
    _ ≤ C * (8 * (A : ℝ) *
        Real.log ((q : ℝ) * (T + 2)) ^ 2) :=
      mul_le_mul_of_nonneg_left hreciprocalBound hC0
    _ = 96 * (A : ℝ) *
        x ^ (1 - 1 / ((M : ℝ) ^ 2 *
          Real.log ((q : ℝ) * (T + 2)))) *
            Real.log ((q : ℝ) * (T + 2)) ^ 2 := by
      dsimp [C, alpha]
      ring

end

section
open Complex

attribute [local instance] inducingEulerProductConductorNeZero
theorem dirichletNontrivialZeroKernelSum_eq_nonexceptional_add_exceptional
    (M : ℕ) {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (x T : ℝ) :
    dirichletNontrivialZeroKernelSum chi x T =
      dirichletNonexceptionalZeroKernelSum M chi x T +
        dirichletExceptionalZeroKernelSum M chi x T := by
  classical
  rw [dirichletNontrivialZeroKernelSum,
    dirichletNonexceptionalZeroKernelSum,
    dirichletExceptionalZeroKernelSum,
    dirichletNonexceptionalLFunctionZerosFinset,
    dirichletExceptionalLFunctionZerosFinset]
  have hsplit := Finset.sum_filter_add_sum_filter_not
    (dirichletNontrivialLFunctionZerosFinset chi T)
    (fun (rho : ℂ) =>
      (1 - 1 / ((M : ℝ) ^ 2 *
          Real.log ((q : ℝ) * (|rho.im| + 2))) ≤ rho.re ∧
        regularizedDirichletLFunctionProduct q rho = 0 ∧
          analyticOrderNatAt
              (regularizedDirichletLFunctionProduct q) rho = 1 ∧
            (∀ zeta : ℂ,
              1 - 1 / ((M : ℝ) ^ 2 *
                  Real.log ((q : ℝ) * (|zeta.im| + 2))) ≤ zeta.re →
                regularizedDirichletLFunctionProduct q zeta = 0 →
                  zeta = rho) ∧
              ∃ psi : DirichletCharacter ℂ q,
                (psi ≠ 1 ∧
                   DirichletCharacter.completedLFunction psi.primitiveCharacter rho = 0) ∧
                  chi = psi ∧ psi ^ 2 = 1 ∧ rho.im = 0 ∧
                    analyticOrderNatAt
                        (DirichletCharacter.LFunction psi) rho = 1 ∧
                      ∀ eta : DirichletCharacter ℂ q,
                        (DirichletCharacter.LFunction eta rho = 0 ∧
                           0 < rho.re ∧ rho.re < 1) →
                          eta = psi))
    (fun rho =>
      (analyticOrderNatAt
        (DirichletCharacter.LFunction chi) rho : ℂ) *
          dirichletExplicitFormulaKernel x rho)
  simpa [add_comm] using hsplit.symm

end

/--
The contour height `exp (sqrt (log x))` used to balance the error terms in the Siegel–Walfisz
estimate.
-/
noncomputable def siegelWalfiszHeight (x : ℕ) : ℝ :=
  Real.exp (Real.sqrt (Real.log (x : ℝ)))

theorem eventually_siegelWalfiszHeight_conditions
    (D : ℝ) (_hD : 0 < D) (M : ℕ) (hM : 2 ≤ M) :
    ∀ᶠ x : ℕ in Filter.atTop,
      4 ≤ x ∧
        1 ≤ Real.log (x : ℝ) ∧
          2 ≤ siegelWalfiszHeight x ∧
            siegelWalfiszHeight x ≤ (x : ℝ) ∧
              Real.log (x : ℝ) ^ D ≤ siegelWalfiszHeight x ∧
                4 * Real.sqrt (Real.log (x : ℝ)) ^ 4 ≤
                    Real.exp (Real.sqrt (Real.log (x : ℝ)) / 2) ∧
                  16 * Real.sqrt (Real.log (x : ℝ)) ^ 2 ≤
                    Real.exp (Real.sqrt (Real.log (x : ℝ)) /
                      (8 * (M : ℝ) ^ 2)) := by
  have hxTop : Tendsto (fun x : ℕ ↦ (x : ℝ)) atTop atTop :=
    tendsto_natCast_atTop_atTop
  have hLTop : Tendsto (fun x : ℕ ↦ Real.log (x : ℝ)) atTop atTop :=
    Real.tendsto_log_atTop.comp hxTop
  have huTop : Tendsto
      (fun x : ℕ ↦ Real.sqrt (Real.log (x : ℝ))) atTop atTop :=
    Real.tendsto_sqrt_atTop.comp hLTop
  have hheightTwo : ∀ᶠ x : ℕ in atTop, 2 ≤ siegelWalfiszHeight x :=
    (Real.tendsto_exp_atTop.comp huTop).eventually
      (eventually_ge_atTop 2)
  have hmodulus : ∀ᶠ x : ℕ in atTop,
      Real.log (x : ℝ) ^ D ≤ siegelWalfiszHeight x := by
    have hdom := ((isLittleO_rpow_exp_atTop (2 * D)).comp_tendsto huTop).eventuallyLE
    filter_upwards [hdom,
      hLTop.eventually (eventually_ge_atTop (0 : ℝ))] with x hdomx hLx
    let L : ℝ := Real.log (x : ℝ)
    let u : ℝ := Real.sqrt L
    have hu0 : 0 ≤ u := by dsimp [u]; positivity
    have husq : u ^ 2 = L := by
      dsimp [u]
      exact Real.sq_sqrt (by simpa [L] using hLx)
    have hpow : L ^ D = u ^ (2 * D) := by
      calc
        L ^ D = (u ^ 2) ^ D := by rw [husq]
        _ = (u ^ (2 : ℝ)) ^ D := by rw [Real.rpow_two]
        _ = u ^ (2 * D) := (Real.rpow_mul hu0 2 D).symm
    simp only [Function.comp_apply, Real.norm_eq_abs] at hdomx
    rw [abs_of_nonneg (Real.rpow_nonneg hu0 (2 * D)),
      abs_of_pos (Real.exp_pos u)] at hdomx
    simpa [L, u, siegelWalfiszHeight, hpow] using hdomx
  have hfour : ∀ᶠ x : ℕ in atTop,
      4 * Real.sqrt (Real.log (x : ℝ)) ^ 4 ≤
        Real.exp (Real.sqrt (Real.log (x : ℝ)) / 2) := by
    have hdom := (((isLittleO_pow_exp_pos_mul_atTop 4
      (by norm_num : (0 : ℝ) < 1 / 2)).const_mul_left 4).comp_tendsto
        huTop).eventuallyLE
    filter_upwards [hdom] with x hdomx
    let u : ℝ := Real.sqrt (Real.log (x : ℝ))
    have hu0 : 0 ≤ u := by dsimp [u]; positivity
    have hleft : 0 ≤ 4 * u ^ 4 := by positivity
    simp only [Function.comp_apply, Real.norm_eq_abs] at hdomx
    rw [abs_of_nonneg hleft,
      abs_of_pos (Real.exp_pos ((1 / 2 : ℝ) * u))] at hdomx
    simpa [u, div_eq_mul_inv, mul_comm] using hdomx
  have hb : 0 < (1 / (8 * (M : ℝ) ^ 2) : ℝ) := by
    have hMpos : (0 : ℝ) < M := by exact_mod_cast Nat.zero_lt_of_lt hM
    positivity
  have hsixteen : ∀ᶠ x : ℕ in atTop,
      16 * Real.sqrt (Real.log (x : ℝ)) ^ 2 ≤
        Real.exp (Real.sqrt (Real.log (x : ℝ)) /
          (8 * (M : ℝ) ^ 2)) := by
    have hlittle := (isLittleO_pow_exp_pos_mul_atTop 2 hb).const_mul_left 16
    have hdom := (hlittle.comp_tendsto huTop).eventuallyLE
    filter_upwards [hdom] with x hdomx
    let u : ℝ := Real.sqrt (Real.log (x : ℝ))
    have hu0 : 0 ≤ u := by dsimp [u]; positivity
    have hleft : 0 ≤ 16 * u ^ 2 := by positivity
    simp only [Function.comp_apply, Real.norm_eq_abs] at hdomx
    rw [abs_of_nonneg hleft,
      abs_of_pos (Real.exp_pos ((1 / (8 * (M : ℝ) ^ 2)) * u))] at hdomx
    simpa [u, div_eq_mul_inv, mul_comm] using hdomx
  filter_upwards [eventually_ge_atTop 4,
    hLTop.eventually (eventually_ge_atTop (1 : ℝ)), hheightTwo,
    hmodulus, hfour, hsixteen] with x hx hL hheight hmodulus hfour hsixteen
  have hxpos : (0 : ℝ) < x := by exact_mod_cast (show 0 < x by omega)
  have huL : Real.sqrt (Real.log (x : ℝ)) ≤ Real.log (x : ℝ) := by
    have hsquare := Real.sq_sqrt (zero_le_one.trans hL)
    have hu := Real.one_le_sqrt.mpr hL
    nlinarith
  have hheightX : siegelWalfiszHeight x ≤ (x : ℝ) := by
    calc
      siegelWalfiszHeight x ≤ Real.exp (Real.log (x : ℝ)) :=
        Real.exp_monotone huL
      _ = (x : ℝ) := Real.exp_log hxpos
  exact ⟨hx, hL, hheight, hheightX, hmodulus, hfour, hsixteen⟩

theorem log_modulus_mul_siegelWalfiszHeight_add_two_bounds
    {x q : ℕ} [NeZero q]
    (hxlog : 1 ≤ Real.log (x : ℝ))
    (hq : (q : ℝ) ≤ siegelWalfiszHeight x) :
    0 < Real.log ((q : ℝ) * (siegelWalfiszHeight x + 2)) ∧
      Real.log ((q : ℝ) * (siegelWalfiszHeight x + 2)) ≤
        4 * Real.sqrt (Real.log (x : ℝ)) := by
  let u : ℝ := Real.sqrt (Real.log (x : ℝ))
  let T : ℝ := Real.exp u
  have hu : 1 ≤ u := by
    dsimp [u]
    exact Real.one_le_sqrt.mpr hxlog
  have hTtwo : 2 < T := by
    dsimp [T]
    exact Real.exp_one_gt_two.trans_le (Real.exp_monotone hu)
  have hqone : (1 : ℝ) ≤ q := by
    exact_mod_cast NeZero.pos q
  have hprodOne : 1 < (q : ℝ) * (T + 2) := by
    have hTadd : 1 < T + 2 := by linarith
    nlinarith [mul_le_mul hqone hTadd.le (by norm_num : (0 : ℝ) ≤ 1)
      (by positivity : (0 : ℝ) ≤ (q : ℝ))]
  have hTadd : T + 2 ≤ 3 * T := by linarith
  have hTsqThree : 3 ≤ T ^ 2 := by nlinarith [sq_nonneg (T - 2)]
  have hprodPow : (q : ℝ) * (T + 2) ≤ T ^ 4 := by
    calc
      (q : ℝ) * (T + 2) ≤ T * (T + 2) :=
        mul_le_mul_of_nonneg_right hq (by positivity)
      _ ≤ T * (3 * T) := mul_le_mul_of_nonneg_left hTadd (by positivity)
      _ = 3 * T ^ 2 := by ring
      _ ≤ T ^ 2 * T ^ 2 :=
        mul_le_mul_of_nonneg_right hTsqThree (sq_nonneg T)
      _ = T ^ 4 := by ring
  have hlogT : Real.log T = u := by simp [T]
  constructor
  · exact Real.log_pos hprodOne
  · have hlog := Real.log_le_log (by positivity : (0 : ℝ) < (q : ℝ) * (T + 2))
      hprodPow
    rw [Real.log_pow, hlogT] at hlog
    simpa [u, T, siegelWalfiszHeight] using hlog

theorem mul_dirichletExplicitFormulaErrorScale_siegelWalfiszHeight_le
    (K : ℝ) (hK : 0 ≤ K) {x q : ℕ} [NeZero q]
    (hxlog : 1 ≤ Real.log (x : ℝ))
    (hq : (q : ℝ) ≤ siegelWalfiszHeight x)
    (habsorb : 4 * Real.sqrt (Real.log (x : ℝ)) ^ 4 ≤
      Real.exp (Real.sqrt (Real.log (x : ℝ)) / 2)) :
    K * dirichletExplicitFormulaErrorScale
        (x : ℝ) q (siegelWalfiszHeight x) ≤
      K * ((x : ℝ) * Real.exp
        (-(1 / 2 : ℝ) * Real.sqrt (Real.log (x : ℝ)))) := by
  let L : ℝ := Real.log (x : ℝ)
  let u : ℝ := Real.sqrt L
  let T : ℝ := Real.exp u
  have hL : 1 ≤ L := by simpa [L] using hxlog
  have hLpos : 0 < L := zero_lt_one.trans_le hL
  have hu : 1 ≤ u := by
    dsimp [u]
    exact Real.one_le_sqrt.mpr hL
  have huL : u ≤ L := by
    have husq : u ^ 2 = L := by
      dsimp [u]
      exact Real.sq_sqrt (zero_le_one.trans hL)
    nlinarith
  have hxone : (1 : ℝ) < x :=
    (Real.log_pos_iff (Nat.cast_nonneg x)).mp
      (zero_lt_one.trans_le hxlog)
  have hxpos : (0 : ℝ) < x := zero_lt_one.trans hxone
  have hqpos : (0 : ℝ) < q := by exact_mod_cast NeZero.pos q
  have hqone : (1 : ℝ) ≤ q := by exact_mod_cast NeZero.pos q
  have hqT : (q : ℝ) ≤ T := by
    simpa [T, u, L, siegelWalfiszHeight] using hq
  have hlogqNonneg : 0 ≤ Real.log (q : ℝ) := Real.log_nonneg hqone
  have hlogq : Real.log (q : ℝ) ≤ u := by
    calc
      Real.log (q : ℝ) ≤ Real.log T := Real.log_le_log hqpos hqT
      _ = u := by simp [T]
  have hlogProductNonneg : 0 ≤ Real.log ((x : ℝ) * q) := by
    rw [Real.log_mul hxpos.ne' hqpos.ne']
    exact add_nonneg (zero_le_one.trans hL) hlogqNonneg
  have hlogProduct : Real.log ((x : ℝ) * q) ≤ 2 * L := by
    rw [Real.log_mul hxpos.ne' hqpos.ne']
    linarith
  have hlogSquare : Real.log ((x : ℝ) * q) ^ 2 ≤ 4 * u ^ 4 := by
    have hsquare := pow_le_pow_left₀ hlogProductNonneg hlogProduct 2
    have husq : u ^ 2 = L := by
      dsimp [u]
      exact Real.sq_sqrt (zero_le_one.trans hL)
    calc
      Real.log ((x : ℝ) * q) ^ 2 ≤ (2 * L) ^ 2 := hsquare
      _ = 4 * u ^ 4 := by rw [← husq]; ring
  have habsorb' : 4 * u ^ 4 ≤ Real.exp (u / 2) := by
    simpa [u, L] using habsorb
  have hTpos : 0 < T := by positivity
  rw [dirichletExplicitFormulaErrorScale]
  calc
    K * ((x : ℝ) * Real.log ((x : ℝ) * q) ^ 2 / T) ≤
        K * ((x : ℝ) * (4 * u ^ 4) / T) := by
      gcongr
    _ ≤ K * ((x : ℝ) * Real.exp (u / 2) / T) := by
      gcongr
    _ = K * ((x : ℝ) * Real.exp (-(1 / 2 : ℝ) * u)) := by
      change K * ((x : ℝ) * Real.exp (u / 2) / Real.exp u) = _
      rw [div_eq_mul_inv, ← Real.exp_neg]
      calc
        K * ((x : ℝ) * Real.exp (u / 2) * Real.exp (-u)) =
            K * ((x : ℝ) * (Real.exp (u / 2) * Real.exp (-u))) := by ring
        _ = K * ((x : ℝ) * Real.exp (u / 2 + -u)) := by
          rw [← Real.exp_add]
        _ = K * ((x : ℝ) * Real.exp (-(1 / 2 : ℝ) * u)) := by
          congr 3
          ring
    _ = K * ((x : ℝ) * Real.exp
        (-(1 / 2 : ℝ) * Real.sqrt (Real.log (x : ℝ)))) := by
      rfl

theorem dirichletNonexceptionalSiegelWalfiszEnvelope_le
    (A M : ℕ) (hM : 2 ≤ M) {x q : ℕ} [NeZero q]
    (hxlog : 1 ≤ Real.log (x : ℝ))
    (hq : (q : ℝ) ≤ siegelWalfiszHeight x)
    (habsorb : 16 * Real.sqrt (Real.log (x : ℝ)) ^ 2 ≤
      Real.exp (Real.sqrt (Real.log (x : ℝ)) /
        (8 * (M : ℝ) ^ 2))) :
    96 * (A : ℝ) *
        (x : ℝ) ^ (1 - 1 / ((M : ℝ) ^ 2 *
          Real.log ((q : ℝ) * (siegelWalfiszHeight x + 2)))) *
            Real.log ((q : ℝ) * (siegelWalfiszHeight x + 2)) ^ 2 ≤
      96 * (A : ℝ) * ((x : ℝ) * Real.exp
        (-(1 / (8 * (M : ℝ) ^ 2)) *
          Real.sqrt (Real.log (x : ℝ)))) := by
  let L : ℝ := Real.log (x : ℝ)
  let u : ℝ := Real.sqrt L
  let T : ℝ := Real.exp u
  let m : ℝ := (M : ℝ) ^ 2
  let V : ℝ := Real.log ((q : ℝ) * (T + 2))
  have hL : 1 ≤ L := by simpa [L] using hxlog
  have hLpos : 0 < L := zero_lt_one.trans_le hL
  have hu : 1 ≤ u := by
    dsimp [u]
    exact Real.one_le_sqrt.mpr hL
  have hupos : 0 < u := zero_lt_one.trans_le hu
  have husq : u ^ 2 = L := by
    dsimp [u]
    exact Real.sq_sqrt (zero_le_one.trans hL)
  have hmpos : 0 < m := by
    dsimp [m]
    positivity
  have hxone : (1 : ℝ) < x :=
    (Real.log_pos_iff (Nat.cast_nonneg x)).mp
      (zero_lt_one.trans_le hxlog)
  have hxpos : (0 : ℝ) < x := zero_lt_one.trans hxone
  have hVbounds : 0 < V ∧ V ≤ 4 * u := by
    simpa [V, T, u, L, siegelWalfiszHeight] using
      (log_modulus_mul_siegelWalfiszHeight_add_two_bounds hxlog hq)
  have hden : 0 < m * V := mul_pos hmpos hVbounds.1
  have hdenUpper : m * V ≤ 4 * m * u := by
    calc
      m * V ≤ m * (4 * u) :=
        mul_le_mul_of_nonneg_left hVbounds.2 hmpos.le
      _ = 4 * m * u := by ring
  have hreciprocal : 1 / (4 * m * u) ≤ 1 / (m * V) :=
    one_div_le_one_div_of_le (by positivity) hdenUpper
  have hscaledReciprocal :
      L * (1 / (4 * m * u)) ≤ L * (1 / (m * V)) :=
    mul_le_mul_of_nonneg_left hreciprocal (zero_le_one.trans hL)
  have hcancel : L * (1 / (4 * m * u)) = u / (4 * m) := by
    rw [← husq]
    field_simp [hmpos.ne', hupos.ne']
  have hlogExponent :
      L * (1 - 1 / (m * V)) ≤ L - u / (4 * m) := by
    calc
      L * (1 - 1 / (m * V)) = L - L * (1 / (m * V)) := by ring
      _ ≤ L - L * (1 / (4 * m * u)) :=
        sub_le_sub_left hscaledReciprocal L
      _ = L - u / (4 * m) := by rw [hcancel]
  have hxpower :
      (x : ℝ) ^ (1 - 1 / (m * V)) ≤
        (x : ℝ) * Real.exp (-(u / (4 * m))) := by
    rw [Real.rpow_def_of_pos hxpos]
    calc
      Real.exp (Real.log (x : ℝ) * (1 - 1 / (m * V))) ≤
          Real.exp (L - u / (4 * m)) := by
        apply Real.exp_monotone
        simpa [L] using hlogExponent
      _ = Real.exp L * Real.exp (-(u / (4 * m))) := by
        rw [show L - u / (4 * m) = L + -(u / (4 * m)) by ring,
          Real.exp_add]
      _ = (x : ℝ) * Real.exp (-(u / (4 * m))) := by
        change Real.exp (Real.log (x : ℝ)) * Real.exp (-(u / (4 * m))) = _
        rw [Real.exp_log hxpos]
  have hVsquare : V ^ 2 ≤ 16 * u ^ 2 := by
    have hsquare := pow_le_pow_left₀ hVbounds.1.le hVbounds.2 2
    calc
      V ^ 2 ≤ (4 * u) ^ 2 := hsquare
      _ = 16 * u ^ 2 := by ring
  have habsorb' : 16 * u ^ 2 ≤ Real.exp (u / (8 * m)) := by
    simpa [u, L, m] using habsorb
  change 96 * (A : ℝ) *
      (x : ℝ) ^ (1 - 1 / (m * V)) * V ^ 2 ≤ _
  calc
    96 * (A : ℝ) * (x : ℝ) ^ (1 - 1 / (m * V)) * V ^ 2 ≤
        96 * (A : ℝ) *
          ((x : ℝ) * Real.exp (-(u / (4 * m)))) * V ^ 2 := by
      gcongr
    _ ≤ 96 * (A : ℝ) *
          ((x : ℝ) * Real.exp (-(u / (4 * m)))) * (16 * u ^ 2) := by
      gcongr
    _ ≤ 96 * (A : ℝ) *
          ((x : ℝ) * Real.exp (-(u / (4 * m)))) *
            Real.exp (u / (8 * m)) := by
      gcongr
    _ = 96 * (A : ℝ) * ((x : ℝ) *
        Real.exp (-(1 / (8 * m)) * u)) := by
      calc
        96 * (A : ℝ) * ((x : ℝ) * Real.exp (-(u / (4 * m)))) *
            Real.exp (u / (8 * m)) =
          96 * (A : ℝ) * ((x : ℝ) *
            (Real.exp (-(u / (4 * m))) * Real.exp (u / (8 * m)))) := by ring
        _ = 96 * (A : ℝ) * ((x : ℝ) *
            Real.exp (-(u / (4 * m)) + u / (8 * m))) := by
          rw [← Real.exp_add]
        _ = 96 * (A : ℝ) * ((x : ℝ) *
            Real.exp (-(1 / (8 * m)) * u)) := by
          congr 3
          ring
    _ = 96 * (A : ℝ) * ((x : ℝ) * Real.exp
        (-(1 / (8 * (M : ℝ) ^ 2)) *
          Real.sqrt (Real.log (x : ℝ)))) := by
      rfl

theorem twistedChebyshevSum_one_eq_psi (x : ℕ) :
    twistedChebyshevSum x 1
        (1 : DirichletCharacter ℂ 1) =
      (Chebyshev.psi (x : ℝ) : ℂ) := by
  have h := centeredTwistedChebyshevSum_one x
  rw [centeredTwistedChebyshevSum, ite_eq_left rfl] at h
  exact sub_eq_zero.mp h

theorem dirichletExceptionalLFunctionZerosFinset_one_eq_empty
    (M : ℕ) (T : ℝ) :
    dirichletExceptionalLFunctionZerosFinset
        M (1 : DirichletCharacter ℂ 1) T = ∅ := by
  classical
  apply Finset.eq_empty_iff_forall_notMem.mpr
  intro rho hrho
  have hexceptional :=
    (mem_dirichletExceptionalLFunctionZerosFinset_iff.mp
      hrho).2.2
  obtain ⟨_, _, _, _, psi, hpsi, _⟩ := hexceptional
  exact hpsi.1 (DirichletCharacter.level_one psi)

theorem dirichletExceptionalZeroKernelSum_one_eq_zero
    (M : ℕ) (x T : ℝ) :
    dirichletExceptionalZeroKernelSum
        M (1 : DirichletCharacter ℂ 1) x T = 0 := by
  rw [dirichletExceptionalZeroKernelSum,
    dirichletExceptionalLFunctionZerosFinset_one_eq_empty]
  simp

theorem exists_abs_chebyshevPsi_sub_natCast_le_exp_neg_sqrtLog :
    ∃ C c : ℝ, 0 < C ∧ 0 < c ∧
      ∃ X0 : ℕ, 4 ≤ X0 ∧
        ∀ x : ℕ, X0 ≤ x →
          |Chebyshev.psi (x : ℝ) - (x : ℝ)| ≤
            C * ((x : ℝ) *
              Real.exp (-c * Real.sqrt (Real.log (x : ℝ)))) := by
  obtain ⟨K, hK, hformula⟩ :=
    exists_nat_norm_twistedChebyshevSum_sub_dirichletExplicitFormulaMainZeroTerms_le
  obtain ⟨M, A, hM, _hA, _hcard, hnonexceptional⟩ :=
    exists_nat_exceptional_card_le_one_and_norm_nonexceptionalZeroKernelSum_le
  let cN : ℝ := 1 / (8 * (M : ℝ) ^ 2)
  let c : ℝ := min (1 / 2 : ℝ) cN
  let C : ℝ := (K : ℝ) + 96 * (A : ℝ)
  have hcN : 0 < cN := by
    dsimp [cN]
    have hMpos : (0 : ℝ) < M := by
      exact_mod_cast Nat.zero_lt_of_lt hM
    positivity
  have hc : 0 < c := by
    dsimp [c]
    exact lt_min (by norm_num) hcN
  have hC : 0 < C := by
    dsimp [C]
    positivity
  have hevent :=
    eventually_siegelWalfiszHeight_conditions
      1 one_pos M hM
  rw [Filter.eventually_atTop] at hevent
  obtain ⟨X0, hX0⟩ := hevent
  have hX0four : 4 ≤ X0 := (hX0 X0 le_rfl).1
  refine ⟨C, c, hC, hc, X0, hX0four, ?_⟩
  intro x hxX
  obtain ⟨hx, hxlog, hheightTwo, hheightX, _hlogHeight,
    habsorbFour, habsorbTwo⟩ := hX0 x hxX
  let T : ℝ := siegelWalfiszHeight x
  let u : ℝ := Real.sqrt (Real.log (x : ℝ))
  have hu0 : 0 ≤ u := by
    dsimp [u]
    positivity
  have hqHeight : (((1 : ℕ) : ℝ)) ≤
      siegelWalfiszHeight x :=
    (by norm_num : (((1 : ℕ) : ℝ)) ≤ 2).trans hheightTwo
  have hformulaRaw := hformula 1
    (1 : DirichletCharacter ℂ 1) T hheightTwo x hx hheightX
  have hformulaHeight :
      ‖twistedChebyshevSum x 1
            (1 : DirichletCharacter ℂ 1) -
          dirichletExplicitFormulaMainZeroTerms
            (1 : DirichletCharacter ℂ 1) (x : ℝ) T‖ ≤
        (K : ℝ) * ((x : ℝ) * Real.exp (-(1 / 2 : ℝ) * u)) := by
    exact hformulaRaw.trans
      (by
        simpa [T, u] using
          (mul_dirichletExplicitFormulaErrorScale_siegelWalfiszHeight_le
            (K : ℝ) (Nat.cast_nonneg K) hxlog hqHeight habsorbFour))
  have hnonexceptionalRaw := hnonexceptional 1
    (1 : DirichletCharacter ℂ 1) (x : ℝ) T
      (by exact_mod_cast hx) hheightTwo hheightX
  have hnonexceptionalHeight :
      ‖dirichletNonexceptionalZeroKernelSum M
          (1 : DirichletCharacter ℂ 1) (x : ℝ) T‖ ≤
        96 * (A : ℝ) * ((x : ℝ) * Real.exp (-cN * u)) := by
    exact hnonexceptionalRaw.trans
      (by
        simpa only [T, u, cN] using
          (dirichletNonexceptionalSiegelWalfiszEnvelope_le
            A M hM hxlog hqHeight habsorbTwo))
  have hcHalf : c ≤ (1 / 2 : ℝ) := min_le_left _ _
  have hcNbound : c ≤ cN := min_le_right _ _
  have hformulaCommon :
      ‖twistedChebyshevSum x 1
            (1 : DirichletCharacter ℂ 1) -
          dirichletExplicitFormulaMainZeroTerms
            (1 : DirichletCharacter ℂ 1) (x : ℝ) T‖ ≤
        (K : ℝ) * ((x : ℝ) * Real.exp (-c * u)) := by
    apply hformulaHeight.trans
    gcongr
  have hnonexceptionalCommon :
      ‖dirichletNonexceptionalZeroKernelSum M
          (1 : DirichletCharacter ℂ 1) (x : ℝ) T‖ ≤
        96 * (A : ℝ) * ((x : ℝ) * Real.exp (-c * u)) := by
    apply hnonexceptionalHeight.trans
    gcongr
  have hmain :
      dirichletExplicitFormulaMainZeroTerms
          (1 : DirichletCharacter ℂ 1) (x : ℝ) T =
        ((x : ℝ) : ℂ) -
          dirichletNonexceptionalZeroKernelSum M
            (1 : DirichletCharacter ℂ 1) (x : ℝ) T := by
    rw [dirichletExplicitFormulaMainZeroTerms,
      ite_eq_left rfl,
      dirichletNontrivialZeroKernelSum_eq_nonexceptional_add_exceptional,
      dirichletExceptionalZeroKernelSum_one_eq_zero]
    ring
  rw [← Real.norm_eq_abs, ← Complex.norm_real]
  change ‖((Chebyshev.psi (x : ℝ) - (x : ℝ) : ℝ) : ℂ)‖ ≤ _
  rw [Complex.ofReal_sub, ← twistedChebyshevSum_one_eq_psi]
  calc
    ‖twistedChebyshevSum x 1
          (1 : DirichletCharacter ℂ 1) - ((x : ℝ) : ℂ)‖ =
        ‖(twistedChebyshevSum x 1
            (1 : DirichletCharacter ℂ 1) -
              dirichletExplicitFormulaMainZeroTerms
                (1 : DirichletCharacter ℂ 1) (x : ℝ) T) -
          dirichletNonexceptionalZeroKernelSum M
            (1 : DirichletCharacter ℂ 1) (x : ℝ) T‖ := by
      rw [hmain]
      congr 1
      ring
    _ ≤ ‖twistedChebyshevSum x 1
            (1 : DirichletCharacter ℂ 1) -
              dirichletExplicitFormulaMainZeroTerms
                (1 : DirichletCharacter ℂ 1) (x : ℝ) T‖ +
          ‖dirichletNonexceptionalZeroKernelSum M
            (1 : DirichletCharacter ℂ 1) (x : ℝ) T‖ := norm_sub_le _ _
    _ ≤ (K : ℝ) * ((x : ℝ) * Real.exp (-c * u)) +
          96 * (A : ℝ) * ((x : ℝ) * Real.exp (-c * u)) :=
      add_le_add hformulaCommon hnonexceptionalCommon
    _ = C * ((x : ℝ) *
        Real.exp (-c * Real.sqrt (Real.log (x : ℝ)))) := by
      dsimp [C, u]
      ring

end PrimeGap186

section
open Polynomial

universe u v w

namespace PrimeGap186

open Classical in
theorem maskedReciprocalProduct_integer_interval_completion
    (q : ℕ) [NeZero q] (hq : Squarefree q)
    (M : (p : q.primeFactors) → Finset (ZMod p.1))
    (a : (p : q.primeFactors) → ZMod p.1 → ZMod p.1)
    (hM : ∀ p : q.primeFactors, (M p).card ≤ 2)
    (hactive : ∀ p : q.primeFactors, ∃ z ∈ M p, a p z ≠ 0)
    (A : ℤ) (N : ℕ) (w : ℕ → ℂ) :
    let F : ZMod q → ℂ := maskedReciprocalProduct q M a
    let μ : ℂ := (∑ x : ZMod q, F x) / (q : ℂ)
    let V : ℝ := if N = 0 then 0 else
      ‖w (N - 1)‖ + ∑ n ∈ Finset.range (N - 1), ‖w (n + 1) - w n‖
    (‖∑ n ∈ Finset.range N, w n * F ((A + n : ℤ) : ZMod q)‖ ≤
      2 * V * (6 : ℝ) ^ q.primeFactors.card * Real.sqrt (q : ℝ) *
          (1 + Real.log (q : ℝ)) +
        ‖∑ n ∈ Finset.range N, w n‖ * ‖μ‖) ∧
    (∀ h : ZMod q,
      let g : ℕ := Nat.gcd q h.val
      let C : ZMod q → ℂ := fun x => F (x + h) * star (F x)
      ‖∑ n ∈ Finset.range N, w n * C ((A + n : ℤ) : ZMod q)‖ ≤
        (12 : ℝ) ^ q.primeFactors.card * Real.sqrt ((q / g : ℕ) : ℝ) *
          (2 * V * (g.divisors.card : ℝ) * (1 + Real.log (q : ℝ)) +
            (g : ℝ) / (q : ℝ) * ‖∑ n ∈ Finset.range N, w n‖)) := by
  let F : ZMod q → ℂ := maskedReciprocalProduct q M a
  let W : ZMod q → ℂ := integerIntervalResidueWeight q A N w
  let T : ℂ := ∑ n ∈ Finset.range N, w n
  let V : ℝ := if N = 0 then 0 else
    ‖w (N - 1)‖ + ∑ n ∈ Finset.range (N - 1), ‖w (n + 1) - w n‖
  have hspec := integerIntervalResidueWeight_spec q A N w
  have hpair (G : ZMod q → ℂ) :
      (∑ x : ZMod q, W x * G x) =
        ∑ n ∈ Finset.range N, w n * G ((A + n : ℤ) : ZMod q) :=
    hspec.1 G
  have hmass : (∑ x : ZMod q, W x) = T := hspec.2.2.1
  have hl1 (g : ℕ) (hg : g ∣ q) :
      (1 / (q : ℝ)) *
          ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0,
            ‖ZMod.dft W ξ‖ * (Nat.gcd g ξ.val : ℝ) ≤
        2 * V * (g.divisors.card : ℝ) * (1 + Real.log (q : ℝ)) :=
    (integerIntervalResidueWeight_variation_and_derivative q A N).1 w g hg
  have hcomplete := maskedReciprocalProduct_weighted_completion q hq M a hM hactive W
  have restore (G : ZMod q → ℂ) :
      ‖∑ x : ZMod q, W x * G x‖ ≤
        ‖(∑ x : ZMod q, W x * G x) - T * ((∑ x : ZMod q, G x) / (q : ℂ))‖ +
          ‖T‖ * ‖(∑ x : ZMod q, G x) / (q : ℂ)‖ := by
    simpa only [norm_mul] using
      norm_le_norm_sub_add (∑ x : ZMod q, W x * G x)
        (T * ((∑ x : ZMod q, G x) / (q : ℂ)))
  refine ⟨?_, ?_⟩
  · have hweight :
        (1 / (q : ℝ)) *
            ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0, ‖ZMod.dft W ξ‖ ≤
          2 * V * (1 + Real.log (q : ℝ)) := by
      simpa using hl1 1 (one_dvd q)
    have herror :
        ‖(∑ x : ZMod q, W x * F x) - T * ((∑ x : ZMod q, F x) / (q : ℂ))‖ ≤
          2 * V * (6 : ℝ) ^ q.primeFactors.card * Real.sqrt (q : ℝ) *
            (1 + Real.log (q : ℝ)) := by
      calc
        _ ≤ ((6 : ℝ) ^ q.primeFactors.card * Real.sqrt (q : ℝ)) / (q : ℝ) *
              ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0, ‖ZMod.dft W ξ‖ := by
          simpa only [hmass, mul_div_assoc] using hcomplete.1
        _ = ((6 : ℝ) ^ q.primeFactors.card * Real.sqrt (q : ℝ)) *
              ((1 / (q : ℝ)) *
                ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0, ‖ZMod.dft W ξ‖) := by
          ring
        _ ≤ ((6 : ℝ) ^ q.primeFactors.card * Real.sqrt (q : ℝ)) *
              (2 * V * (1 + Real.log (q : ℝ))) :=
          mul_le_mul_of_nonneg_left hweight (by positivity)
        _ = _ := by ring
    calc
      _ = ‖∑ x : ZMod q, W x * F x‖ := congrArg norm (hpair F).symm
      _ ≤ _ := (restore F).trans (add_le_add herror le_rfl)
  · intro h
    let g : ℕ := Nat.gcd q h.val
    let C : ZMod q → ℂ := fun x => F (x + h) * star (F x)
    let B : ℝ := (12 : ℝ) ^ q.primeFactors.card * Real.sqrt ((q / g : ℕ) : ℝ)
    have hg : g ∣ q := Nat.gcd_dvd_left q h.val
    have hB : 0 ≤ B := by positivity
    have hmean : ‖(∑ x : ZMod q, C x) / (q : ℂ)‖ ≤
        B * (g : ℝ) / (q : ℝ) := by
      rw [norm_div, Complex.norm_natCast]
      apply div_le_div_of_nonneg_right _ (Nat.cast_nonneg q)
      simpa only [ZMod.dft_apply_zero, ZMod.val_zero, Nat.gcd_zero_right] using
        (maskedReciprocalProduct_correlation_dft_norm_le q hq M a hM hactive h).2.2.1 0
    have herror :
        ‖(∑ x : ZMod q, W x * C x) - T * ((∑ x : ZMod q, C x) / (q : ℂ))‖ ≤
          B * (2 * V * (g.divisors.card : ℝ) * (1 + Real.log (q : ℝ))) := by
      calc
        _ ≤ B / (q : ℝ) *
              ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0,
                ‖ZMod.dft W ξ‖ * (Nat.gcd g ξ.val : ℝ) := by
          simpa only [hmass, mul_div_assoc, B, C, F, g] using hcomplete.2 h
        _ = B * ((1 / (q : ℝ)) *
              ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0,
                ‖ZMod.dft W ξ‖ * (Nat.gcd g ξ.val : ℝ)) := by ring
        _ ≤ _ := mul_le_mul_of_nonneg_left (hl1 g hg) hB
    calc
      _ = ‖∑ x : ZMod q, W x * C x‖ := congrArg norm (hpair C).symm
      _ ≤ ‖(∑ x : ZMod q, W x * C x) - T * ((∑ x : ZMod q, C x) / (q : ℂ))‖ +
            ‖T‖ * ‖(∑ x : ZMod q, C x) / (q : ℂ)‖ := restore C
      _ ≤ B * (2 * V * (g.divisors.card : ℝ) * (1 + Real.log (q : ℝ))) +
            ‖T‖ * (B * (g : ℝ) / (q : ℝ)) :=
        add_le_add herror (mul_le_mul_of_nonneg_left hmean (norm_nonneg T))
      _ = _ := by ring

open Classical in
theorem norm_sum_maskedReciprocalProduct_shift_mul_star_le
    (s : ℕ) [NeZero s] (hsq : Squarefree s)
    (M : (p : s.primeFactors) → Finset (ZMod p.1))
    (a : (p : s.primeFactors) → ZMod p.1 → ZMod p.1)
    (hM : ∀ p : s.primeFactors, (M p).card ≤ 2)
    (hactive : ∀ p : s.primeFactors, ∃ z ∈ M p, a p z ≠ 0)
    (A : ℤ) (J N h : ℕ) (hJN : J ≤ N) (hh : h < s) :
    let F : ZMod s → ℂ := maskedReciprocalProduct s M a
    let C : ℝ := (12 : ℝ) ^ s.primeFactors.card
    let L : ℝ := C * (s.divisors.card : ℝ) * (1 + Real.log (s : ℝ))
    ‖∑ n ∈ Finset.range J,
        F (((A + n : ℤ) + (h : ℤ)) : ZMod s) *
          star (F ((A + n : ℤ) : ZMod s))‖ ≤
      2 * L * Real.sqrt (s : ℝ) +
        C * (N : ℝ) * Real.sqrt (Nat.gcd s h : ℝ) / Real.sqrt (s : ℝ) := by
  let F : ZMod s → ℂ := maskedReciprocalProduct s M a
  let C : ℝ := (12 : ℝ) ^ s.primeFactors.card
  let L : ℝ := C * (s.divisors.card : ℝ) * (1 + Real.log (s : ℝ))
  let g : ℕ := Nat.gcd s h
  have hC : 0 ≤ C := by positivity
  have hlog : 0 ≤ 1 + Real.log (s : ℝ) := by
    have := Real.log_nonneg (show (1 : ℝ) ≤ s by
      exact_mod_cast (NeZero.one_le : 1 ≤ s))
    linarith
  have hL : 0 ≤ L := mul_nonneg (mul_nonneg hC (Nat.cast_nonneg _)) hlog
  by_cases hJ : J = 0
  · subst J
    simp only [Finset.range_zero, Finset.sum_empty, norm_zero]
    positivity
  have hg : g ∣ s := Nat.gcd_dvd_left s h
  have hgpos : 0 < g := Nat.gcd_pos_of_pos_left h (NeZero.pos s)
  have hg0 : (g : ℝ) ≠ 0 := by exact_mod_cast hgpos.ne'
  have hτ : (g.divisors.card : ℝ) ≤ (s.divisors.card : ℝ) := by
    exact_mod_cast Finset.card_le_card (Nat.divisors_subset_of_dvd (NeZero.ne s) hg)
  have hsqrt : Real.sqrt ((s / g : ℕ) : ℝ) ≤ Real.sqrt (s : ℝ) :=
    Real.sqrt_le_sqrt (by exact_mod_cast Nat.div_le_self s g)
  have hgeo :
      Real.sqrt ((s / g : ℕ) : ℝ) * (g : ℝ) / (s : ℝ) =
        Real.sqrt (g : ℝ) / Real.sqrt (s : ℝ) := by
    rw [Nat.cast_div hg hg0, Real.sqrt_div (Nat.cast_nonneg s) (g : ℝ)]
    calc
      _ = (Real.sqrt (s : ℝ) / (s : ℝ)) * ((g : ℝ) / Real.sqrt (g : ℝ)) := by ring
      _ = _ := by rw [Real.sqrt_div_self', Real.div_sqrt]; ring
  have hbase :
      ‖∑ n ∈ Finset.range J,
          F (((A + n : ℤ) + (h : ℤ)) : ZMod s) *
            star (F ((A + n : ℤ) : ZMod s))‖ ≤
        C * Real.sqrt ((s / g : ℕ) : ℝ) *
          (2 * (g.divisors.card : ℝ) * (1 + Real.log (s : ℝ)) +
            (g : ℝ) / (s : ℝ) * (J : ℝ)) := by
    simpa [F, C, g, hJ, ZMod.val_natCast_of_lt hh] using
      (maskedReciprocalProduct_integer_interval_completion s hsq M a hM hactive
        A J (fun _ => 1)).2 (h : ZMod s)
  calc
    _ ≤ C * Real.sqrt ((s / g : ℕ) : ℝ) *
          (2 * (g.divisors.card : ℝ) * (1 + Real.log (s : ℝ)) +
            (g : ℝ) / (s : ℝ) * (J : ℝ)) := hbase
    _ = 2 * C * (1 + Real.log (s : ℝ)) *
          (Real.sqrt ((s / g : ℕ) : ℝ) * (g.divisors.card : ℝ)) +
        C * (J : ℝ) * (Real.sqrt ((s / g : ℕ) : ℝ) * (g : ℝ) / (s : ℝ)) := by ring
    _ ≤ 2 * C * (1 + Real.log (s : ℝ)) *
          (Real.sqrt (s : ℝ) * (s.divisors.card : ℝ)) +
        C * (N : ℝ) * (Real.sqrt (g : ℝ) / Real.sqrt (s : ℝ)) := by
      apply add_le_add
      · exact mul_le_mul_of_nonneg_left
          (mul_le_mul hsqrt hτ (Nat.cast_nonneg _) (Real.sqrt_nonneg _)) (by positivity)
      · rw [hgeo]
        exact mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left (by exact_mod_cast hJN) hC) (by positivity)
    _ = _ := by dsimp only [L, g]; ring

open Classical in
theorem maskedReciprocalProduct_coprime_interval_differencing
    (r s : ℕ) [NeZero r] [NeZero s]
    (hrs : Nat.Coprime r s) (hq : Squarefree (r * s))
    (M : (p : (r * s).primeFactors) → Finset (ZMod p.1))
    (a : (p : (r * s).primeFactors) → ZMod p.1 → ZMod p.1)
    (hM : ∀ p : (r * s).primeFactors, (M p).card ≤ 2)
    (hactive : ∀ p : (r * s).primeFactors, ∃ z ∈ M p, a p z ≠ 0)
    (A : ℤ) (N : ℕ) (hrN : r ≤ N) (hNs : N < s) (w : ℕ → ℂ) :
    let F : ZMod (r * s) → ℂ := maskedReciprocalProduct (r * s) M a
    let μ : ℂ := (∑ x : ZMod (r * s), F x) / ((r * s : ℕ) : ℂ)
    let V : ℝ := if N = 0 then 0 else
      ‖w (N - 1)‖ + ∑ n ∈ Finset.range (N - 1), ‖w (n + 1) - w n‖
    let L : ℝ := (12 : ℝ) ^ s.primeFactors.card *
      (s.divisors.card : ℝ) * (1 + Real.log (s : ℝ))
    ‖∑ n ∈ Finset.range N,
        w n * F ((A + n : ℤ) : ZMod (r * s))‖ ≤
      4 * V * L * Real.sqrt (N : ℝ) *
          (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ))) +
        ‖∑ n ∈ Finset.range N, w n‖ * ‖μ‖ := by
  let F : ZMod (r * s) → ℂ := maskedReciprocalProduct (r * s) M a
  let μ : ℂ := (∑ x : ZMod (r * s), F x) / ((r * s : ℕ) : ℂ)
  let V : ℝ := if N = 0 then 0 else
    ‖w (N - 1)‖ + ∑ n ∈ Finset.range (N - 1), ‖w (n + 1) - w n‖
  let C : ℝ := (12 : ℝ) ^ s.primeFactors.card
  let τ : ℝ := (s.divisors.card : ℝ)
  let ell : ℝ := 1 + Real.log (s : ℝ)
  let L : ℝ := C * τ * ell
  let ιr : r.primeFactors → (r * s).primeFactors := fun p =>
    ⟨p.1, Nat.primeFactors_mono (dvd_mul_right r s) (NeZero.ne (r * s)) p.2⟩
  let ιs : s.primeFactors → (r * s).primeFactors := fun p =>
    ⟨p.1, Nat.primeFactors_mono (dvd_mul_left s r) (NeZero.ne (r * s)) p.2⟩
  let Mr := fun p : r.primeFactors => M (ιr p)
  let aR := fun p : r.primeFactors => a (ιr p)
  let Ms := fun p : s.primeFactors => M (ιs p)
  let aS := fun p : s.primeFactors => a (ιs p)
  let R := fun n : ℤ => maskedReciprocalProduct r Mr aR (n : ZMod r)
  let S := fun n : ℤ => maskedReciprocalProduct s Ms aS (n : ZMod s)
  have hsplit :
      (∀ n : ℤ, F (n : ZMod (r * s)) = R n * S n) ∧
        Function.Periodic R (r : ℤ) ∧ (∀ n, ‖R n‖ ≤ 1) ∧ (∀ n, ‖S n‖ ≤ 1) :=
    maskedReciprocalProduct_coprime_split r s hrs M a
  have hsq : Squarefree s := hq.of_mul_right
  have hC : 1 ≤ C := one_le_pow₀ (by norm_num)
  have hτ : 1 ≤ τ := by
    change (1 : ℝ) ≤ (s.divisors.card : ℝ)
    exact_mod_cast Finset.one_le_card.mpr ⟨1, Nat.one_mem_divisors.mpr (NeZero.ne s)⟩
  have hell : 1 ≤ ell := by
    have := Real.log_nonneg (show (1 : ℝ) ≤ s by exact_mod_cast (NeZero.one_le : 1 ≤ s))
    dsimp only [ell]
    linarith
  have hL : 1 ≤ L := one_le_mul_of_one_le_of_one_le
    (one_le_mul_of_one_le_of_one_le hC hτ) hell
  have hraw (m : ℕ) (hrm : r ≤ m) (hms : m < s) :
      ‖∑ n ∈ Finset.range m, F ((A + n : ℤ) : ZMod (r * s))‖ ≤
        4 * L * Real.sqrt (m : ℝ) *
          (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ))) := by
    let K : ℕ := m / r
    let H : ℕ → ℝ := fun h =>
      ‖∑ n ∈ Finset.range (m - h * r),
        S (A + (n : ℤ) + ((h * r : ℕ) : ℤ)) * star (S (A + n))‖
    have hK : 0 < K := Nat.div_pos hrm (NeZero.pos r)
    have hgcd := reciprocal_differencing_gcd_sums s K (NeZero.pos s)
    have hG : 2 * ∑ h ∈ Finset.Icc 1 (K - 1),
        (K - h : ℝ) * Real.sqrt (Nat.gcd s h : ℝ) ≤ 2 * (K : ℝ) ^ 2 * τ := by
      rw [← hgcd.2.1]
      exact hgcd.2.2.1
    have hCor : ∀ h ∈ Finset.Icc 1 (K - 1),
        H h ≤ 2 * (C * τ * ell) * Real.sqrt (s : ℝ) +
          C * (m : ℝ) * Real.sqrt (Nat.gcd s h : ℝ) / Real.sqrt (s : ℝ) := by
      intro h hh
      have hhK : h ≤ K := (Finset.mem_Icc.mp hh).2.trans (Nat.sub_le K 1)
      have hshift : h * r < s :=
        ((Nat.mul_le_mul_right r hhK).trans (Nat.div_mul_le_self m r)).trans_lt hms
      have hcop : Nat.gcd s (h * r) = Nat.gcd s h := by
        simpa only [Nat.mul_comm] using hgcd.2.2.2 r hrs.symm h
      simpa only [H, S, C, τ, ell, hcop, Int.cast_add, Int.cast_natCast] using
        norm_sum_maskedReciprocalProduct_shift_mul_star_le s hsq Ms aS (fun p => hM (ιs p))
          (fun p => hactive (ιs p)) A (m - h * r) m (h * r) (Nat.sub_le m _) hshift
    have hvdc :
        ‖∑ n ∈ Finset.range m, F ((A + n : ℤ) : ZMod (r * s))‖ ^ 2 ≤
          (((m + (K - 1) * r : ℕ) : ℝ) / (K : ℝ) ^ 2) *
            ((K : ℝ) * (m : ℝ) +
              2 * ∑ h ∈ Finset.Icc 1 (K - 1), (K - h : ℝ) * H h) := by
      simpa only [H, hsplit.1] using
        finite_periodic_factor_van_der_corput A m r K (NeZero.pos r) hK R S
          hsplit.2.1 hsplit.2.2.1 hsplit.2.2.2
    exact (reciprocal_differencing_numeric r s m K (NeZero.pos r) (NeZero.pos s)
      hrm hms rfl C τ ell hC hτ hell
      (∑ n ∈ Finset.range m, F ((A + n : ℤ) : ZMod (r * s))) H hG hCor hvdc).2
  let B : ℝ := 4 * L * Real.sqrt (N : ℝ) *
    (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ)))
  have hprefix (m : ℕ) (hmN : m ≤ N) :
      ‖∑ n ∈ Finset.range m, F ((A + n : ℤ) : ZMod (r * s))‖ ≤ B := by
    by_cases hrm : r ≤ m
    · refine (hraw m hrm (hmN.trans_lt hNs)).trans ?_
      dsimp only [B]
      gcongr
    · have hpoint (n : ℕ) : ‖F ((A + n : ℤ) : ZMod (r * s))‖ ≤ 1 := by
        rw [hsplit.1, norm_mul]
        exact (mul_le_mul (hsplit.2.2.1 _) (hsplit.2.2.2 _)
          (norm_nonneg _) (by norm_num)).trans_eq (one_mul 1)
      have hsum : ‖∑ n ∈ Finset.range m, F ((A + n : ℤ) : ZMod (r * s))‖ ≤ (m : ℝ) := by
        simpa using norm_sum_le_of_le (Finset.range m) (fun n _ => hpoint n)
      have hmN' : (m : ℝ) ≤ N := by exact_mod_cast hmN
      have hmr : (m : ℝ) ≤ r := by exact_mod_cast (show m ≤ r by omega)
      have hroot : (m : ℝ) ≤ Real.sqrt (N : ℝ) * Real.sqrt (r : ℝ) := by
        rw [← Real.sqrt_mul (Nat.cast_nonneg N)]
        apply Real.le_sqrt_of_sq_le
        simpa only [sq] using mul_le_mul hmN' hmr (Nat.cast_nonneg m) (Nat.cast_nonneg N)
      have hrootB : Real.sqrt (N : ℝ) * Real.sqrt (r : ℝ) ≤ B := by
        calc
          _ ≤ Real.sqrt (N : ℝ) *
              (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ))) :=
            mul_le_mul_of_nonneg_left (le_add_of_nonneg_right (Real.sqrt_nonneg _))
              (Real.sqrt_nonneg _)
          _ ≤ (4 * L) * (Real.sqrt (N : ℝ) *
              (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ)))) := by
            exact le_mul_of_one_le_left (by positivity) (by linarith only [hL])
          _ = B := by dsimp only [B]; ring
      exact hsum.trans (hroot.trans hrootB)
  have hN : N ≠ 0 := Nat.ne_of_gt ((NeZero.pos r).trans_le hrN)
  have hweight :
      ‖∑ n ∈ Finset.range N, w n * F ((A + n : ℤ) : ZMod (r * s))‖ ≤ V * B := by
    simpa only [V, hN, ↓reduceIte] using
      rs_weighted_prefix_bound N (fun n => F ((A + n : ℤ) : ZMod (r * s))) w B hprefix
  change ‖∑ n ∈ Finset.range N, w n * F ((A + n : ℤ) : ZMod (r * s))‖ ≤
    4 * V * L * Real.sqrt (N : ℝ) *
        (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ))) +
      ‖∑ n ∈ Finset.range N, w n‖ * ‖μ‖
  calc
    _ ≤ V * B := hweight
    _ ≤ V * B + ‖∑ n ∈ Finset.range N, w n‖ * ‖μ‖ :=
      le_add_of_nonneg_right (mul_nonneg (norm_nonneg _) (norm_nonneg _))
    _ = _ := by dsimp only [B]; ring

theorem inactive_active_centered_completion
    (q : ℕ) [NeZero q] (hq : Squarefree q)
    (M : (p : q.primeFactors) → Finset (ZMod p.1))
    (a : (p : q.primeFactors) → ZMod p.1 → ZMod p.1)
    (hM : ∀ p : q.primeFactors, (M p).card ≤ 2)
    (hactive : ∀ p : q.primeFactors, ∃ z ∈ M p, a p z ≠ 0)
    (A : ℤ) (N : ℕ) :
    let F : ZMod q → ℂ := maskedReciprocalProduct q M a
    let μ : ℂ := (∑ x : ZMod q, F x) / (q : ℂ)
    ‖(∑ n ∈ Finset.range N, F ((A + n : ℤ) : ZMod q)) - (N : ℂ) * μ‖ ≤
      2 * (6 : ℝ) ^ q.primeFactors.card * Real.sqrt (q : ℝ) *
        (1 + Real.log (q : ℝ)) := by
  classical
  let F : ZMod q → ℂ := maskedReciprocalProduct q M a
  let W : ZMod q → ℂ := integerIntervalResidueWeight q A N (fun _ => 1)
  have hspec := integerIntervalResidueWeight_spec q A N (fun _ => 1)
  have hpair : (∑ x : ZMod q, W x * F x) =
      ∑ n ∈ Finset.range N, F ((A + n : ℤ) : ZMod q) := by
    simpa only [one_mul] using hspec.1 F
  have hmass : (∑ x : ZMod q, W x) = (N : ℂ) := by
    simpa using hspec.2.2.1
  have hl1 : (1 / (q : ℝ)) *
      ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0, ‖ZMod.dft W ξ‖ ≤
        2 * (1 + Real.log (q : ℝ)) := by
    simpa only [Nat.gcd_one_left, Nat.cast_one, mul_one, Nat.divisors_one,
      Finset.card_singleton] using
      ((integerIntervalResidueWeight_geometric_l1 q A N).2.2.2 1 (one_dvd q)).1
  have hb := (maskedReciprocalProduct_weighted_completion q hq M a hM hactive W).1
  change ‖(∑ x : ZMod q, W x * F x) -
      (∑ x : ZMod q, W x) * (∑ x : ZMod q, F x) / (q : ℂ)‖ ≤ _ at hb
  rw [hpair, hmass] at hb
  change ‖(∑ n ∈ Finset.range N, F ((A + n : ℤ) : ZMod q)) -
    (N : ℂ) * ((∑ x : ZMod q, F x) / (q : ℂ))‖ ≤ _
  calc
    _ ≤ ((6 : ℝ) ^ q.primeFactors.card * Real.sqrt (q : ℝ)) / (q : ℝ) *
        ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0, ‖ZMod.dft W ξ‖ := by
      simpa only [mul_div_assoc] using hb
    _ = ((6 : ℝ) ^ q.primeFactors.card * Real.sqrt (q : ℝ)) *
        ((1 / (q : ℝ)) *
          ∑ ξ ∈ (Finset.univ : Finset (ZMod q)).erase 0, ‖ZMod.dft W ξ‖) := by ring
    _ ≤ ((6 : ℝ) ^ q.primeFactors.card * Real.sqrt (q : ℝ)) *
        (2 * (1 + Real.log (q : ℝ))) :=
      mul_le_mul_of_nonneg_left hl1 (by positivity)
    _ = _ := by ring

theorem inactive_active_centered_bounds
    (r s : ℕ) [NeZero r] [NeZero s]
    (hrs : Nat.Coprime r s) (hq : Squarefree (r * s))
    (M : (p : (r * s).primeFactors) → Finset (ZMod p.1))
    (a : (p : (r * s).primeFactors) → ZMod p.1 → ZMod p.1)
    (hM : ∀ p : (r * s).primeFactors, (M p).card ≤ 2)
    (hactive : ∀ p : (r * s).primeFactors, ∃ z ∈ M p, a p z ≠ 0)
    (A : ℤ) (N : ℕ) :
    let F : ZMod (r * s) → ℂ := maskedReciprocalProduct (r * s) M a
    let μ : ℂ := (∑ x : ZMod (r * s), F x) / ((r * s : ℕ) : ℂ)
    let H : ℝ := 1 + Real.log ((r * s : ℕ) : ℝ)
    let C : ℝ := (6 : ℝ) ^ (r * s).primeFactors.card
    let L : ℝ := (12 : ℝ) ^ (r * s).primeFactors.card *
      ((r * s).divisors.card : ℝ) * H
    (‖(∑ n ∈ Finset.range N, F ((A + n : ℤ) : ZMod (r * s))) - (N : ℂ) * μ‖ ≤
      2 * C * Real.sqrt ((r * s : ℕ) : ℝ) * H) ∧
    (‖(∑ n ∈ Finset.range N, F ((A + n : ℤ) : ZMod (r * s))) - (N : ℂ) * μ‖ ≤
      6 * L * Real.sqrt (N : ℝ) *
        (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ)))) := by
  classical
  let q : ℕ := r * s
  let F : ZMod q → ℂ := maskedReciprocalProduct q M a
  let μ : ℂ := (∑ x : ZMod q, F x) / (q : ℂ)
  let H : ℝ := 1 + Real.log (q : ℝ)
  let C : ℝ := (6 : ℝ) ^ q.primeFactors.card
  let L : ℝ := (12 : ℝ) ^ q.primeFactors.card * (q.divisors.card : ℝ) * H
  let Ls : ℝ := (12 : ℝ) ^ s.primeFactors.card *
    (s.divisors.card : ℝ) * (1 + Real.log (s : ℝ))
  let G : ℝ := Real.sqrt (N : ℝ) *
    (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ)))
  let Z : ℂ := (∑ n ∈ Finset.range N, F ((A + n : ℤ) : ZMod q)) - (N : ℂ) * μ
  have hcomplete : ‖Z‖ ≤ 2 * C * Real.sqrt (q : ℝ) * H :=
    inactive_active_centered_completion q hq M a hM hactive A N
  refine ⟨hcomplete, ?_⟩
  change ‖Z‖ ≤ 6 * L * Real.sqrt (N : ℝ) *
    (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ)))
  have hqpos : (0 : ℝ) < q := by exact_mod_cast (NeZero.pos q)
  have hspos : (0 : ℝ) < s := by exact_mod_cast (NeZero.pos s)
  have hrone : (1 : ℝ) ≤ r := by exact_mod_cast (NeZero.one_le : 1 ≤ r)
  have hqone : (1 : ℝ) ≤ q := by exact_mod_cast (NeZero.one_le : 1 ≤ q)
  have hH : 1 ≤ H := by
    dsimp only [H]
    linarith [Real.log_nonneg hqone]
  have hHs : 1 ≤ 1 + Real.log (s : ℝ) := by
    have hsone : (1 : ℝ) ≤ s := by exact_mod_cast (NeZero.one_le : 1 ≤ s)
    linarith [Real.log_nonneg hsone]
  have hτ : (1 : ℝ) ≤ q.divisors.card := by
    exact_mod_cast Finset.one_le_card.mpr ⟨1, Nat.one_mem_divisors.mpr (NeZero.ne q)⟩
  have hL : 1 ≤ L := one_le_mul_of_one_le_of_one_le
    (one_le_mul_of_one_le_of_one_le (one_le_pow₀ (by norm_num)) hτ) hH
  have hCp : C ≤ (12 : ℝ) ^ q.primeFactors.card :=
    pow_le_pow_left₀ (by norm_num) (by norm_num) _
  have hCL : C ≤ L := by
    calc
      C ≤ (12 : ℝ) ^ q.primeFactors.card := hCp
      _ ≤ (12 : ℝ) ^ q.primeFactors.card * (q.divisors.card : ℝ) :=
        le_mul_of_one_le_right (by positivity) hτ
      _ ≤ L := le_mul_of_one_le_right (by positivity) hH
  have hCH : C * H ≤ L := by
    exact mul_le_mul_of_nonneg_right
      (hCp.trans (le_mul_of_one_le_right (by positivity) hτ)) (by linarith only [hH])
  have hsdvd : s ∣ q := dvd_mul_left s r
  have hsleq : (s : ℝ) ≤ q := by
    exact_mod_cast Nat.le_of_dvd (NeZero.pos q) hsdvd
  have hLS : Ls ≤ L := by
    have hp : s.primeFactors.card ≤ q.primeFactors.card :=
      Finset.card_le_card (Nat.primeFactors_mono hsdvd (NeZero.ne q))
    have ht : (s.divisors.card : ℝ) ≤ q.divisors.card := by
      exact_mod_cast Finset.card_le_card (Nat.divisors_subset_of_dvd (NeZero.ne q) hsdvd)
    have he : 1 + Real.log (s : ℝ) ≤ H := by
      dsimp only [H]
      linarith [Real.log_le_log hspos hsleq]
    exact mul_le_mul
      (mul_le_mul (pow_le_pow_right₀ (by norm_num) hp) ht
        (Nat.cast_nonneg _) (by positivity)) he
      (by linarith only [hHs]) (by positivity)
  have hG : 0 ≤ G := by positivity
  have hrootG : Real.sqrt (N : ℝ) * Real.sqrt (r : ℝ) ≤ G :=
    mul_le_mul_of_nonneg_left (le_add_of_nonneg_right (Real.sqrt_nonneg _))
      (Real.sqrt_nonneg _)
  have hpoint (x : ZMod q) : ‖F x‖ ≤ 1 := by
    dsimp only [F, maskedReciprocalProduct]
    rw [norm_prod]
    apply Finset.prod_le_one
    · intro p hp
      exact norm_nonneg _
    · intro p hp
      let : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
      rw [norm_maskedReciprocalLocal]
      split_ifs <;> norm_num
  have hmeanone : ‖μ‖ ≤ 1 := by
    dsimp only [μ]
    rw [norm_div, Complex.norm_natCast]
    apply (div_le_one₀ hqpos).2
    simpa [ZMod.card] using norm_sum_le_of_le Finset.univ (fun x _ => hpoint x)
  have hsqrtq : 0 < Real.sqrt (q : ℝ) := Real.sqrt_pos.mpr hqpos
  have hmean : ‖μ‖ ≤ C / Real.sqrt (q : ℝ) := by
    dsimp only [μ]
    rw [norm_div, Complex.norm_natCast]
    have hdft := maskedReciprocalProduct_dft_norm_le q hq M a hM hactive 0
    rw [ZMod.dft_apply_zero] at hdft
    calc
      ‖∑ x : ZMod q, F x‖ / (q : ℝ) ≤ C * Real.sqrt (q : ℝ) / (q : ℝ) :=
        div_le_div_of_nonneg_right hdft hqpos.le
      _ = C / Real.sqrt (q : ℝ) := by
        apply (div_eq_div_iff (ne_of_gt hqpos) (ne_of_gt hsqrtq)).2
        rw [mul_assoc, Real.mul_self_sqrt hqpos.le]
  by_cases hN : N = 0
  · subst N
    simp [Z]
  have hnormN : ‖(N : ℂ) * μ‖ = (N : ℝ) * ‖μ‖ := by
    rw [norm_mul, Complex.norm_natCast]
  by_cases hrN : r ≤ N
  · by_cases hNs : N < s
    · have hraw : ‖∑ n ∈ Finset.range N, F ((A + n : ℤ) : ZMod q)‖ ≤
          4 * Ls * G + (N : ℝ) * ‖μ‖ := by
        simpa [q, F, μ, Ls, G, hN, mul_assoc] using
          maskedReciprocalProduct_coprime_interval_differencing r s hrs hq
            M a hM hactive A N hrN hNs (fun _ => 1)
      have hratio : (N : ℝ) / Real.sqrt (q : ℝ) ≤
          Real.sqrt (N : ℝ) * Real.sqrt (r : ℝ) := by
        apply (div_le_iff₀ hsqrtq).2
        rw [← Real.sqrt_mul (Nat.cast_nonneg N),
          ← Real.sqrt_mul (mul_nonneg (Nat.cast_nonneg N) (Nat.cast_nonneg r))]
        apply Real.le_sqrt_of_sq_le
        have hnq : (N : ℝ) ≤ (r : ℝ) * (q : ℝ) := by
          have hns : (N : ℝ) ≤ s := by exact_mod_cast hNs.le
          exact (hns.trans hsleq).trans (le_mul_of_one_le_left hqpos.le hrone)
        nlinarith only [mul_le_mul_of_nonneg_left hnq (Nat.cast_nonneg N)]
      have hmeanN : (N : ℝ) * ‖μ‖ ≤ L * G := by
        calc
          _ ≤ (N : ℝ) * (C / Real.sqrt (q : ℝ)) :=
            mul_le_mul_of_nonneg_left hmean (Nat.cast_nonneg N)
          _ = C * ((N : ℝ) / Real.sqrt (q : ℝ)) := by ring
          _ ≤ C * (Real.sqrt (N : ℝ) * Real.sqrt (r : ℝ)) :=
            mul_le_mul_of_nonneg_left hratio (by positivity)
          _ ≤ C * G := mul_le_mul_of_nonneg_left hrootG (by positivity)
          _ ≤ L * G := mul_le_mul_of_nonneg_right hCL hG
      calc
        ‖Z‖ ≤ ‖∑ n ∈ Finset.range N, F ((A + n : ℤ) : ZMod q)‖ +
            (N : ℝ) * ‖μ‖ := by
          simpa only [Z, hnormN] using
            (norm_sub_le (∑ n ∈ Finset.range N, F ((A + n : ℤ) : ZMod q)) ((N : ℂ) * μ))
        _ ≤ 4 * Ls * G + 2 * ((N : ℝ) * ‖μ‖) := by linarith only [hraw]
        _ ≤ 6 * L * G := by
          have ht := mul_le_mul_of_nonneg_right hLS hG
          nlinarith only [ht, hmeanN]
        _ = _ := by dsimp only [G]; ring
    · have hsN : (s : ℝ) ≤ N := by exact_mod_cast (show s ≤ N by omega)
      have hroot : Real.sqrt (q : ℝ) ≤ Real.sqrt (N : ℝ) * Real.sqrt (r : ℝ) := by
        rw [← Real.sqrt_mul (Nat.cast_nonneg N)]
        apply Real.sqrt_le_sqrt
        dsimp only [q]
        push_cast
        nlinarith only [mul_le_mul_of_nonneg_left hsN (Nat.cast_nonneg r)]
      calc
        ‖Z‖ ≤ 2 * C * Real.sqrt (q : ℝ) * H := hcomplete
        _ = 2 * (C * H) * Real.sqrt (q : ℝ) := by ring
        _ ≤ 2 * L * (Real.sqrt (N : ℝ) * Real.sqrt (r : ℝ)) :=
          mul_le_mul (mul_le_mul_of_nonneg_left hCH (by norm_num)) hroot
            (Real.sqrt_nonneg _) (by positivity)
        _ ≤ 2 * L * G := mul_le_mul_of_nonneg_left hrootG (by positivity)
        _ ≤ 6 * L * G := by
          have hLG : 0 ≤ L * G := mul_nonneg (by linarith only [hL]) hG
          nlinarith only [hLG]
        _ = _ := by dsimp only [G]; ring
  · have hNr : (N : ℝ) ≤ r := by exact_mod_cast (show N ≤ r by omega)
    have hroot : (N : ℝ) ≤ Real.sqrt (N : ℝ) * Real.sqrt (r : ℝ) := by
      rw [← Real.sqrt_mul (Nat.cast_nonneg N)]
      apply Real.le_sqrt_of_sq_le
      nlinarith only [mul_le_mul_of_nonneg_left hNr (Nat.cast_nonneg N)]
    have hsum : ‖∑ n ∈ Finset.range N, F ((A + n : ℤ) : ZMod q)‖ ≤ (N : ℝ) := by
      simpa using norm_sum_le_of_le (Finset.range N)
        (fun n _ => hpoint ((A + n : ℤ) : ZMod q))
    have hmuN : (N : ℝ) * ‖μ‖ ≤ (N : ℝ) := by
      simpa using mul_le_mul_of_nonneg_left hmeanone (Nat.cast_nonneg N)
    calc
      ‖Z‖ ≤ ‖∑ n ∈ Finset.range N, F ((A + n : ℤ) : ZMod q)‖ +
          (N : ℝ) * ‖μ‖ := by
        simpa only [Z, hnormN] using
          (norm_sub_le (∑ n ∈ Finset.range N, F ((A + n : ℤ) : ZMod q)) ((N : ℂ) * μ))
      _ ≤ 2 * (N : ℝ) := by linarith only [hsum, hmuN]
      _ ≤ 2 * (Real.sqrt (N : ℝ) * Real.sqrt (r : ℝ)) :=
        mul_le_mul_of_nonneg_left hroot (by norm_num)
      _ ≤ 2 * G := mul_le_mul_of_nonneg_left hrootG (by norm_num)
      _ ≤ 6 * L * G := by
        have ht := mul_le_mul_of_nonneg_right hL hG
        nlinarith only [ht, hG]
      _ = _ := by dsimp only [G]; ring

open Classical in
theorem inactive_active_progression_centered_bounds
    (r s : ℕ) [NeZero r] [NeZero s]
    (hrs : Nat.Coprime r s) (hq : Squarefree (r * s))
    (M : (p : (r * s).primeFactors) → Finset (ZMod p.1))
    (a : (p : (r * s).primeFactors) → ZMod p.1 → ZMod p.1)
    (hM : ∀ p : (r * s).primeFactors, (M p).card ≤ 2)
    (hactive : ∀ p : (r * s).primeFactors, ∃ z ∈ M p, a p z ≠ 0)
    (d : ℕ) (hd : 0 < d) (hdt : Nat.Coprime d (r * s))
    (A : ℤ) (N : ℕ) (b : ℤ) :
    let F : ZMod (r * s) → ℂ := maskedReciprocalProduct (r * s) M a
    let μ : ℂ := (∑ x : ZMod (r * s), F x) / ((r * s : ℕ) : ℂ)
    let H : ℝ := 1 + Real.log ((r * s : ℕ) : ℝ)
    let C : ℝ := (6 : ℝ) ^ (r * s).primeFactors.card
    let L : ℝ := (12 : ℝ) ^ (r * s).primeFactors.card *
      ((r * s).divisors.card : ℝ) * H
    let Z : ℂ := (∑ n ∈ Finset.range N,
      if Int.ModEq (d : ℤ) (A + n) b then F ((A + n : ℤ) : ZMod (r * s)) else 0) -
        ((N : ℂ) / (d : ℂ)) * μ
    (‖Z‖ ≤ 2 * C * Real.sqrt ((r * s : ℕ) : ℝ) * H + 1) ∧
    (‖Z‖ ≤ 6 * L * Real.sqrt (N : ℝ) *
      (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ))) + 1) := by
  let q : ℕ := r * s
  let F : ZMod q → ℂ := maskedReciprocalProduct q M a
  let μ : ℂ := (∑ x : ZMod q, F x) / (q : ℂ)
  let H : ℝ := 1 + Real.log (q : ℝ)
  let C : ℝ := (6 : ℝ) ^ q.primeFactors.card
  let L : ℝ := (12 : ℝ) ^ q.primeFactors.card * (q.divisors.card : ℝ) * H
  let Z : ℂ := (∑ n ∈ Finset.range N,
    if Int.ModEq (d : ℤ) (A + n) b then F ((A + n : ℤ) : ZMod q) else 0) -
      ((N : ℂ) / (d : ℂ)) * μ
  let l : ℤ := ⌈((A - b : ℤ) : ℚ) / (d : ℚ)⌉
  let u : ℤ := ⌈((A + (N : ℤ) - b : ℤ) : ℚ) / (d : ℚ)⌉
  let m : ℕ := (u - l).toNat
  let β : ℤ := b + (d : ℤ) * l
  have hcount := integer_interval_modEq_reindex_count A N d hd b
  change (∀ f : ℤ → ℂ,
      (∑ n ∈ Finset.range N,
        if Int.ModEq (d : ℤ) (A + n) b then f (A + n) else 0) =
      ∑ j ∈ Finset.range m, f (β + (d : ℤ) * (j : ℤ))) ∧
    m ≤ N ∧ |(m : ℝ) - (N : ℝ) / (d : ℝ)| ≤ 1 at hcount
  have (p : q.primeFactors) : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
  let M' : (p : q.primeFactors) → Finset (ZMod p.1) := fun p =>
    (M p).image (fun z => (z - (β : ZMod p.1)) / (d : ZMod p.1))
  let a' : (p : q.primeFactors) → ZMod p.1 → ZMod p.1 := fun p y =>
    a p ((β : ZMod p.1) + (d : ZMod p.1) * y) / (d : ZMod p.1)
  let F' : ZMod q → ℂ := maskedReciprocalProduct q M' a'
  have haff := maskedReciprocalProduct_affine_transport q d hdt M a β
  have hM' : ∀ p : q.primeFactors, (M' p).card ≤ 2 := by
    intro p
    exact (haff.1 p).trans_le (hM p)
  have hactive' : ∀ p : q.primeFactors, ∃ z ∈ M' p, a' p z ≠ 0 :=
    fun p => (haff.2.1 p).mpr (hactive p)
  have hmean' : (∑ x : ZMod q, F' x) / (q : ℂ) = μ := haff.2.2.2
  have hphase (n : ℕ) :
      F ((β + (d : ℤ) * (n : ℤ) : ℤ) : ZMod q) = F' (n : ZMod q) := by
    simpa only [Int.cast_add, Int.cast_mul, Int.cast_natCast] using haff.2.2.1 (n : ZMod q)
  have hreindex : (∑ n ∈ Finset.range N,
      if Int.ModEq (d : ℤ) (A + n) b then F ((A + n : ℤ) : ZMod q) else 0) =
      ∑ n ∈ Finset.range m, F' (n : ZMod q) :=
    (hcount.1 (fun z : ℤ => F (z : ZMod q))).trans
      (Finset.sum_congr rfl (fun n _ => hphase n))
  let Zm : ℂ := (∑ n ∈ Finset.range m, F' (n : ZMod q)) - (m : ℂ) * μ
  have hb := inactive_active_centered_bounds r s hrs hq M' a' hM' hactive' 0 m
  change (‖(∑ n ∈ Finset.range m, F' ((0 + n : ℤ) : ZMod q)) -
      (m : ℂ) * ((∑ x : ZMod q, F' x) / (q : ℂ))‖ ≤
      2 * C * Real.sqrt (q : ℝ) * H) ∧
    (‖(∑ n ∈ Finset.range m, F' ((0 + n : ℤ) : ZMod q)) -
      (m : ℂ) * ((∑ x : ZMod q, F' x) / (q : ℂ))‖ ≤
      6 * L * Real.sqrt (m : ℝ) *
        (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ)))) at hb
  rw [hmean'] at hb
  have hbounds : (‖Zm‖ ≤ 2 * C * Real.sqrt (q : ℝ) * H) ∧
      (‖Zm‖ ≤ 6 * L * Real.sqrt (m : ℝ) *
        (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ)))) := by
    simpa only [Zm, zero_add, Int.cast_natCast] using hb
  have hpoint (x : ZMod q) : ‖F x‖ ≤ 1 := by
    dsimp only [F, maskedReciprocalProduct]
    rw [norm_prod]
    apply Finset.prod_le_one
    · intro p hp
      exact norm_nonneg _
    · intro p hp
      rw [norm_maskedReciprocalLocal]
      split_ifs <;> norm_num
  have hmeanone : ‖μ‖ ≤ 1 := by
    dsimp only [μ]
    rw [norm_div, Complex.norm_natCast]
    apply (div_le_one₀ (show (0 : ℝ) < q by exact_mod_cast NeZero.pos q)).2
    simpa [ZMod.card] using norm_sum_le_of_le Finset.univ (fun x _ => hpoint x)
  have hcast : (m : ℂ) - (N : ℂ) / (d : ℂ) =
      (((m : ℝ) - (N : ℝ) / (d : ℝ) : ℝ) : ℂ) := by
    simp only [Complex.ofReal_sub, Complex.ofReal_div, Complex.ofReal_natCast]
  have hdiscrepancy : ‖((m : ℂ) - (N : ℂ) / (d : ℂ)) * μ‖ ≤ 1 := by
    rw [norm_mul, hcast, Complex.norm_real, Real.norm_eq_abs]
    exact (mul_le_mul hcount.2.2 hmeanone (norm_nonneg μ) (by norm_num)).trans_eq
      (one_mul 1)
  have hsplit : Z = Zm + ((m : ℂ) - (N : ℂ) / (d : ℂ)) * μ := by
    dsimp only [Z, Zm]
    rw [hreindex]
    ring
  have hZ : ‖Z‖ ≤ ‖Zm‖ + 1 := by
    rw [hsplit]
    exact (norm_add_le _ _).trans (add_le_add_right hdiscrepancy ‖Zm‖)
  have hqone : (1 : ℝ) ≤ q := by exact_mod_cast (NeZero.one_le : 1 ≤ q)
  have hH : 0 ≤ H := by
    dsimp only [H]
    linarith [Real.log_nonneg hqone]
  have hL : 0 ≤ L := mul_nonneg (mul_nonneg (by positivity) (Nat.cast_nonneg _)) hH
  have hroot : Real.sqrt (m : ℝ) ≤ Real.sqrt (N : ℝ) :=
    Real.sqrt_le_sqrt (by exact_mod_cast hcount.2.1)
  have hboundN : 6 * L * Real.sqrt (m : ℝ) *
      (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ))) ≤
      6 * L * Real.sqrt (N : ℝ) *
        (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ))) :=
    mul_le_mul_of_nonneg_right
      (mul_le_mul_of_nonneg_left hroot (by positivity)) (by positivity)
  exact ⟨hZ.trans (add_le_add_left hbounds.1 1),
    hZ.trans (add_le_add_left (hbounds.2.trans hboundN) 1)⟩

open Classical in
theorem maskedReciprocalProduct_integer_interval_centered_bounds
    (r s : ℕ) [NeZero r] [NeZero s]
    (hrs : Nat.Coprime r s) (hq : Squarefree (r * s))
    (M : (p : (r * s).primeFactors) → Finset (ZMod p.1))
    (a : (p : (r * s).primeFactors) → ZMod p.1 → ZMod p.1)
    (hM : ∀ p : (r * s).primeFactors, (M p).card ≤ 2)
    (A : ℤ) (N : ℕ) :
    let F : ZMod (r * s) → ℂ := maskedReciprocalProduct (r * s) M a
    let μ : ℂ := (∑ x : ZMod (r * s), F x) / ((r * s : ℕ) : ℂ)
    let H : ℝ := 1 + Real.log ((r * s : ℕ) : ℝ)
    let C : ℝ := (6 : ℝ) ^ (r * s).primeFactors.card
    let L : ℝ := (12 : ℝ) ^ (r * s).primeFactors.card *
      ((r * s).divisors.card : ℝ) * H
    (‖(∑ n ∈ Finset.range N, F ((A + n : ℤ) : ZMod (r * s))) - (N : ℂ) * μ‖ ≤
      3 * C * Real.sqrt ((r * s : ℕ) : ℝ) * H) ∧
    (‖(∑ n ∈ Finset.range N, F ((A + n : ℤ) : ZMod (r * s))) - (N : ℂ) * μ‖ ≤
      7 * L * Real.sqrt (N : ℝ) *
        (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ)))) := by
  let q : ℕ := r * s
  let F : ZMod q → ℂ := maskedReciprocalProduct q M a
  let μ : ℂ := (∑ x : ZMod q, F x) / (q : ℂ)
  let Z : ℂ := (∑ n ∈ Finset.range N, F ((A + n : ℤ) : ZMod q)) - (N : ℂ) * μ
  have hqone : (1 : ℝ) ≤ q := by exact_mod_cast (NeZero.one_le : 1 ≤ q)
  have hlog := Real.log_nonneg hqone
  by_cases hN : N = 0
  · subst N
    dsimp only
    simp only [Finset.range_zero, Finset.sum_empty, Nat.cast_zero, zero_mul, sub_zero,
      norm_zero, Real.sqrt_zero, mul_zero]
    exact ⟨by positivity, le_rfl⟩
  have hNpos : 0 < N := Nat.pos_of_ne_zero hN
  let J : Finset q.primeFactors := Finset.univ.filter (fun p => ∀ z ∈ M p, a p z = 0)
  have hi (p : q.primeFactors) (hp : p ∈ J) : ∀ z ∈ M p, a p z = 0 :=
    (Finset.mem_filter.mp hp).2
  let t : ℕ := ∏ p ∈ Finset.univ \ J, p.1
  let u : ℕ := ∏ p ∈ J, p.1
  have ht := prime_subtype_product_spec q hq (Finset.univ \ J)
  let : NeZero t := ⟨ht.1⟩
  have hpart := prime_subtype_partition q hq J
  let R := Nat.gcd t r
  let S := Nat.gcd t s
  have hvt : R * S = t := (Nat.gcd_mul_gcd_eq_iff_dvd_mul_of_coprime hrs).2 ht.2.1
  have hmulne : R * S ≠ 0 := hvt.symm ▸ ht.1
  let : NeZero R := ⟨left_ne_zero_of_mul hmulne⟩
  let : NeZero S := ⟨right_ne_zero_of_mul hmulne⟩
  let v : ℕ := R * S
  have hvq : v ∣ q := hvt.dvd.trans ht.2.1
  have hvsq : Squarefree v := hq.squarefree_of_dvd hvq
  have hRS : Nat.Coprime R S := hrs.gcd_both t t
  have hR : R ≤ r := Nat.gcd_le_right t (NeZero.pos r)
  have hS : S ≤ s := Nat.gcd_le_right t (NeZero.pos s)
  have hchar (p : q.primeFactors) : p.1 ∣ v ↔ p ∉ J := by
    change p.1 ∣ R * S ↔ p ∉ J
    rw [hvt]
    constructor
    · intro hp
      have hm := (Nat.prime_of_mem_primeFactors p.2).mem_primeFactors' hp
      rw [ht.2.2] at hm
      obtain ⟨p', hp', heq⟩ := Finset.mem_image.mp hm
      have hpp : p' = p := Subtype.ext heq
      subst p'
      exact (Finset.mem_sdiff.mp hp').2
    · intro hp
      apply Nat.dvd_of_mem_primeFactors
      rw [ht.2.2]
      exact Finset.mem_image.mpr ⟨p, Finset.mem_sdiff.mpr ⟨Finset.mem_univ _, hp⟩, rfl⟩
  have hfilter : (Finset.univ : Finset q.primeFactors).filter (fun p => p.1 ∣ v) =
      Finset.univ \ J := by
    ext p
    simp only [Finset.mem_filter, Finset.mem_univ, true_and, Finset.mem_sdiff, hchar]
  let ι : v.primeFactors → q.primeFactors := fun p =>
    ⟨p.1, Nat.primeFactors_mono hvq (NeZero.ne q) p.2⟩
  let Mv := fun p : v.primeFactors => M (ι p)
  let av := fun p : v.primeFactors => a (ι p)
  let Fv : ZMod v → ℂ := maskedReciprocalProduct v Mv av
  let μv : ℂ := (∑ x : ZMod v, Fv x) / (v : ℂ)
  have hvM (p : v.primeFactors) : (Mv p).card ≤ 2 := hM (ι p)
  have hvactive (p : v.primeFactors) : ∃ z ∈ Mv p, av p z ≠ 0 := by
    by_contra! h
    exact ((hchar (ι p)).mp (Nat.dvd_of_mem_primeFactors p.2))
      (Finset.mem_filter.mpr ⟨Finset.mem_univ _, h⟩)
  have hrestrict := maskedReciprocalProduct_divisor_restriction q v hvq hvsq M a
  have hactiveprod (n : ℤ) :
      (∏ p ∈ (Finset.univ : Finset q.primeFactors) \ J,
        @maskedReciprocalLocal p.1 ⟨Nat.prime_of_mem_primeFactors p.2⟩
          (M p) (a p) (n : ZMod p.1)) = Fv (n : ZMod v) := by
    dsimp only [Fv, Mv, av, ι]
    rw [hrestrict.1 n, ← Finset.prod_filter, hfilter]
  have hmeanv : μv =
      ∏ p ∈ (Finset.univ : Finset q.primeFactors) \ J,
        letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
        (∑ x : ZMod p.1, maskedReciprocalLocal p.1 (M p) (a p) x) / (p.1 : ℂ) := by
    dsimp only [μv, Fv, Mv, av, ι]
    rw [hrestrict.2, ← Finset.prod_filter, hfilter]
  let κ := (p : J) → Option (M p.1)
  let D : κ → Finset J := fun σ => Finset.univ.filter (fun p => (σ p).isSome)
  let d : κ → ℕ := fun σ => ∏ p ∈ D σ, p.1.1
  let ε : κ → ℂ := fun σ => (-1 : ℂ) ^ (D σ).card
  obtain ⟨hdd, b, hb, hphase, hcoef, hcard⟩ :=
    maskedReciprocalProduct_inactive_crt_expansion q M a J (fun p _ => hM p) hi
  have hmean : μ = μv * ∑ σ : κ, ε σ / (d σ : ℂ) := by
    dsimp only [μ, F]
    rw [inactive_product_mean_split q hq M a J hi, ← hmeanv]
    congr 1
    calc
      _ = ∏ p : J, (1 - ((M p.1).card : ℂ) / (p.1.1 : ℂ)) :=
        (Finset.prod_coe_sort J
          (fun p : q.primeFactors => (1 : ℂ) - ((M p).card : ℂ) / (p.1 : ℂ))).symm
      _ = _ := by convert! hcoef.symm
  have hdcop (σ : κ) : Nat.Coprime (d σ) v := by
    have hddu : d σ ∣ u := by
      simpa only [Finset.prod_coe_sort J (fun p : q.primeFactors => p.1)] using hdd σ
    simpa only [v, hvt] using hpart.2.1.symm.of_dvd_left hddu
  have hphase' (n : ℤ) : F (n : ZMod q) =
      ∑ σ : κ, ε σ *
        (if Int.ModEq (d σ : ℤ) n (b σ : ℤ) then Fv (n : ZMod v) else 0) := by
    dsimp only [F]
    rw [hphase n, hactiveprod n, Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro σ hσ
    split_ifs <;> ring
  let T : κ → ℂ := fun σ =>
    (∑ n ∈ Finset.range N,
      if Int.ModEq (d σ : ℤ) (A + n) (b σ : ℤ) then Fv ((A + n : ℤ) : ZMod v) else 0) -
      ((N : ℂ) / (d σ : ℂ)) * μv
  have hsum : (∑ n ∈ Finset.range N, F ((A + n : ℤ) : ZMod q)) =
      ∑ σ : κ, ε σ *
        ∑ n ∈ Finset.range N,
          if Int.ModEq (d σ : ℤ) (A + n) (b σ : ℤ) then Fv ((A + n : ℤ) : ZMod v) else 0 := by
    simp_rw [hphase']
    rw [Finset.sum_comm]
    simp_rw [Finset.mul_sum]
  have hZ : Z = ∑ σ : κ, ε σ * T σ := by
    dsimp only [Z, T]
    rw [hsum, hmean]
    simp only [mul_sub, Finset.sum_sub_distrib, Finset.mul_sum]
    congr 1
    apply Finset.sum_congr rfl
    intro σ hσ
    ring
  have hnorm (B : ℝ) (hB : ∀ σ : κ, ‖T σ‖ ≤ B) : ‖Z‖ ≤ (Fintype.card κ : ℝ) * B := by
    rw [hZ]
    have hb (σ : κ) (_ : σ ∈ Finset.univ) : ‖ε σ * T σ‖ ≤ B := by
      simpa only [ε, norm_mul, norm_pow, norm_neg, norm_one, one_pow, one_mul] using hB σ
    simpa using norm_sum_le_of_le Finset.univ hb
  have hlocal (σ : κ) := inactive_active_progression_centered_bounds R S hRS hvsq
    Mv av hvM hvactive (d σ) (hb σ).1 (hdcop σ) A N (b σ : ℤ)
  have hω : v.primeFactors.card + J.card = q.primeFactors.card := by
    simpa only [v, hvt, hpart.2.2.2] using hpart.2.2.1
  have hamb := inactive_ambient_loss_bounds q v R S r s N (Fintype.card κ) J.card
    hvq hω hcard hR hS hNpos
  exact ⟨(hnorm _ (fun σ => (hlocal σ).1)).trans hamb.1,
    (hnorm _ (fun σ => (hlocal σ).2)).trans hamb.2⟩

open Classical in
theorem maskedReciprocalProduct_integer_interval_bounds
    (r s : ℕ) [NeZero r] [NeZero s]
    (hrs : Nat.Coprime r s) (hq : Squarefree (r * s))
    (M : (p : (r * s).primeFactors) → Finset (ZMod p.1))
    (a : (p : (r * s).primeFactors) → ZMod p.1 → ZMod p.1)
    (hM : ∀ p : (r * s).primeFactors, (M p).card ≤ 2)
    (A : ℤ) (N : ℕ) (w : ℕ → ℂ) :
    let F : ZMod (r * s) → ℂ := maskedReciprocalProduct (r * s) M a
    let μ : ℂ := (∑ x : ZMod (r * s), F x) / ((r * s : ℕ) : ℂ)
    let V : ℝ := if N = 0 then 0 else
      ‖w (N - 1)‖ + ∑ n ∈ Finset.range (N - 1), ‖w (n + 1) - w n‖
    let H : ℝ := 1 + Real.log ((r * s : ℕ) : ℝ)
    let C : ℝ := (6 : ℝ) ^ (r * s).primeFactors.card
    let L : ℝ := (12 : ℝ) ^ (r * s).primeFactors.card *
      ((r * s).divisors.card : ℝ) * H
    (‖∑ n ∈ Finset.range N, w n * F ((A + n : ℤ) : ZMod (r * s))‖ ≤
      3 * V * C * Real.sqrt ((r * s : ℕ) : ℝ) * H +
        ‖∑ n ∈ Finset.range N, w n‖ * ‖μ‖) ∧
    (‖∑ n ∈ Finset.range N, w n * F ((A + n : ℤ) : ZMod (r * s))‖ ≤
      7 * V * L * Real.sqrt (N : ℝ) *
          (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ))) +
        ‖∑ n ∈ Finset.range N, w n‖ * ‖μ‖)
:= by
  let F : ZMod (r * s) → ℂ := maskedReciprocalProduct (r * s) M a
  let μ : ℂ := (∑ x : ZMod (r * s), F x) / ((r * s : ℕ) : ℂ)
  let V : ℝ := if N = 0 then 0 else
    ‖w (N - 1)‖ + ∑ n ∈ Finset.range (N - 1), ‖w (n + 1) - w n‖
  let H : ℝ := 1 + Real.log ((r * s : ℕ) : ℝ)
  let C : ℝ := (6 : ℝ) ^ (r * s).primeFactors.card
  let L : ℝ := (12 : ℝ) ^ (r * s).primeFactors.card *
    ((r * s).divisors.card : ℝ) * H
  let B₁ : ℝ := 3 * C * Real.sqrt ((r * s : ℕ) : ℝ) * H
  let B₂ : ℝ := 7 * L * Real.sqrt (N : ℝ) *
    (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ)))
  by_cases hN : N = 0
  · subst N
    simp
  have hH : 0 ≤ H := by
    have hqone : (1 : ℝ) ≤ ((r * s : ℕ) : ℝ) := by
      exact_mod_cast (NeZero.one_le : 1 ≤ r * s)
    dsimp only [H]
    linarith [Real.log_nonneg hqone]
  have hL : 0 ≤ L := by dsimp only [L]; positivity
  have hprefix₁ (m : ℕ) (_hm : m ≤ N) :
      ‖∑ n ∈ Finset.range m, (F ((A + n : ℤ) : ZMod (r * s)) - μ)‖ ≤ B₁ := by
    simpa only [Finset.sum_sub_distrib, Finset.sum_const, Finset.card_range, nsmul_eq_mul]
      using (maskedReciprocalProduct_integer_interval_centered_bounds r s hrs hq M a hM A m).1
  have hprefix₂ (m : ℕ) (hm : m ≤ N) :
      ‖∑ n ∈ Finset.range m, (F ((A + n : ℤ) : ZMod (r * s)) - μ)‖ ≤ B₂ := by
    have hb := (maskedReciprocalProduct_integer_interval_centered_bounds r s hrs hq M a hM A m).2
    simp only [Finset.sum_sub_distrib, Finset.sum_const, Finset.card_range, nsmul_eq_mul]
    refine hb.trans ?_
    change 7 * L * Real.sqrt (m : ℝ) *
      (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ))) ≤ B₂
    dsimp only [B₂]
    gcongr
  have hweighted (B : ℝ)
      (hprefix : ∀ m ≤ N,
        ‖∑ n ∈ Finset.range m, (F ((A + n : ℤ) : ZMod (r * s)) - μ)‖ ≤ B) :
      ‖∑ n ∈ Finset.range N, w n * F ((A + n : ℤ) : ZMod (r * s))‖ ≤
        V * B + ‖∑ n ∈ Finset.range N, w n‖ * ‖μ‖ := by
    have hc := rs_weighted_prefix_bound N
      (fun n => F ((A + n : ℤ) : ZMod (r * s)) - μ) w B hprefix
    have hv : V = ‖w (N - 1)‖ +
        ∑ n ∈ Finset.range (N - 1), ‖w (n + 1) - w n‖ := ite_eq_right hN
    rw [← hv] at hc
    have hid : (∑ n ∈ Finset.range N, w n * F ((A + n : ℤ) : ZMod (r * s))) =
        (∑ n ∈ Finset.range N, w n * (F ((A + n : ℤ) : ZMod (r * s)) - μ)) +
          (∑ n ∈ Finset.range N, w n) * μ := by
      simp only [mul_sub, Finset.sum_sub_distrib, Finset.sum_mul]
      ring
    calc
      _ ≤ ‖∑ n ∈ Finset.range N, w n * (F ((A + n : ℤ) : ZMod (r * s)) - μ)‖ +
          ‖(∑ n ∈ Finset.range N, w n) * μ‖ := by rw [hid]; exact norm_add_le _ _
      _ ≤ V * B + ‖∑ n ∈ Finset.range N, w n‖ * ‖μ‖ := by
        rw [norm_mul]
        exact add_le_add hc le_rfl
  dsimp only
  constructor
  · calc
      _ ≤ V * B₁ + ‖∑ n ∈ Finset.range N, w n‖ * ‖μ‖ := hweighted B₁ hprefix₁
      _ = _ := by dsimp only [B₁]; ring
  · calc
      _ ≤ V * B₂ + ‖∑ n ∈ Finset.range N, w n‖ * ‖μ‖ := hweighted B₂ hprefix₂
      _ = _ := by dsimp only [B₂]; ring

open Classical in
theorem reciprocalUnitPhase_pair_progression_bounds
    (m : Fin 2 → ℕ) (hm : ∀ i, Squarefree (m i))
    (d r s : ℕ) (hd : d ∣ Nat.lcm (m 0) (m 1))
    (hrs : Nat.Coprime r s)
    (hrs_q : r * s = Nat.lcm (m 0) (m 1) / d)
    (c ℓ : Fin 2 → ℤ) (A : ℤ) (K : ℕ) (w : ℕ → ℂ) :
    let q : ℕ := Nat.lcm (m 0) (m 1)
    let F : ℤ → ℂ := fun t => ∏ i : Fin 2,
      letI : NeZero (m i) := ⟨(hm i).ne_zero⟩
      reciprocalUnitPhase (m i) (c i : ZMod (m i))
        ((t + ℓ i : ℤ) : ZMod (m i))
    let δ : Fin 2 → ℕ := fun i => m i / Nat.gcd (m 0) (m 1)
    let δ' : Fin 2 → ℕ := fun i => δ i / Nat.gcd d (δ i)
    let B : ℝ := ∏ i : Fin 2,
      (Nat.gcd (c i).natAbs (δ' i) : ℝ) / (δ' i : ℝ)
    let V : ℝ := if K = 0 then 0 else
      ‖w (K - 1)‖ + ∑ n ∈ Finset.range (K - 1), ‖w (n + 1) - w n‖
    let H : ℝ := 1 + Real.log (q : ℝ)
    let C : ℝ := (6 : ℝ) ^ q.primeFactors.card
    let L : ℝ := (12 : ℝ) ^ q.primeFactors.card *
      (q.divisors.card : ℝ) * H
    (‖∑ n ∈ Finset.range K, w n * F (A + (d : ℤ) * (n : ℤ))‖ ≤
      3 * V * C * Real.sqrt ((q / d : ℕ) : ℝ) * H +
        ‖∑ n ∈ Finset.range K, w n‖ * B) ∧
    (‖∑ n ∈ Finset.range K, w n * F (A + (d : ℤ) * (n : ℤ))‖ ≤
      7 * V * L * Real.sqrt (K : ℝ) *
          (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ))) +
        ‖∑ n ∈ Finset.range K, w n‖ * B) := by
  let q := Nat.lcm (m 0) (m 1)
  let F : ℤ → ℂ := fun b => ∏ i : Fin 2,
    letI : NeZero (m i) := ⟨(hm i).ne_zero⟩
    reciprocalUnitPhase (m i) (c i : ZMod (m i)) ((b + ℓ i : ℤ) : ZMod (m i))
  let δ : Fin 2 → ℕ := fun i => m i / Nat.gcd (m 0) (m 1)
  let δ' : Fin 2 → ℕ := fun i => δ i / Nat.gcd d (δ i)
  let B : ℝ := ∏ i : Fin 2, (Nat.gcd (c i).natAbs (δ' i) : ℝ) / (δ' i : ℝ)
  let V : ℝ := if K = 0 then 0 else
    ‖w (K - 1)‖ + ∑ n ∈ Finset.range (K - 1), ‖w (n + 1) - w n‖
  let H : ℝ := 1 + Real.log (q : ℝ)
  let C : ℝ := (6 : ℝ) ^ q.primeFactors.card
  let L : ℝ := (12 : ℝ) ^ q.primeFactors.card * (q.divisors.card : ℝ) * H
  have hq : Squarefree q := squarefree_lcm_pair (hm 0) (hm 1)
  let _ : NeZero q := ⟨hq.ne_zero⟩
  let _ : NeZero d := ⟨ne_zero_of_dvd_ne_zero hq.ne_zero hd⟩
  let _ (i : Fin 2) : NeZero (m i) := ⟨(hm i).ne_zero⟩
  have hmi (i : Fin 2) : m i ∣ q := by
    fin_cases i
    · exact Nat.dvd_lcm_left _ _
    · exact Nat.dvd_lcm_right _ _
  let t := r * s
  have hmul : d * t = q := by
    simpa [t, hrs_q, mul_comm] using (Nat.div_mul_cancel hd)
  have htq : t ∣ q := by rw [← hmul]; exact dvd_mul_left t d
  have hhs : Squarefree t := hq.squarefree_of_dvd htq
  let _ : NeZero t := ⟨hhs.ne_zero⟩
  let _ : NeZero r := ⟨left_ne_zero_of_mul (show r * s ≠ 0 from hhs.ne_zero)⟩
  let _ : NeZero s := ⟨right_ne_zero_of_mul (show r * s ≠ 0 from hhs.ne_zero)⟩
  have hdt : Nat.Coprime d t := Nat.coprime_of_squarefree_mul (by rwa [hmul])
  have hchoice (p : q.primeFactors) : p.1 ∣ t ↔ ¬p.1 ∣ d := by
    have hp := Nat.prime_of_mem_primeFactors p.2
    constructor
    · intro hpd
      exact hp.coprime_iff_not_dvd.mp (hdt.symm.of_dvd_left hpd)
    · intro hpnd
      have hqpd : p.1 ∣ d * t := by rw [hmul]; exact Nat.dvd_of_mem_primeFactors p.2
      exact (hp.dvd_mul.mp hqpd).resolve_left hpnd
  let I : (p : q.primeFactors) → Finset (Fin 2) := fun p =>
    Finset.univ.filter (fun i => p.1 ∣ m i)
  let M : (p : q.primeFactors) → Finset (ZMod p.1) := fun p =>
    (I p).image (fun i => -(ℓ i : ZMod p.1))
  let a : (p : q.primeFactors) → ZMod p.1 → ZMod p.1 := fun p z =>
    ∑ i ∈ I p, if -(ℓ i : ZMod p.1) = z then
      (c i : ZMod p.1) * (((m i / p.1 : ℕ) : ZMod p.1)⁻¹) else 0
  have hident := reciprocalUnitPhase_pair_eq_maskedReciprocalProduct q hq m hmi c ℓ
  have hM : ∀ p : q.primeFactors, (M p).card ≤ 2 := hident.1
  have hid (u : ℤ) : F u = maskedReciprocalProduct q M a (u : ZMod q) := by
    rw [← hident.2 (u : ZMod q)]
    apply Finset.prod_congr rfl
    intro i hi
    have heq : (((u : ZMod q).val : ℕ) : ZMod (m i)) = (u : ZMod (m i)) := by
      simpa only [ZMod.cast_eq_val] using ZMod.cast_intCast (R := ZMod (m i)) (hmi i) u
    rw [Int.cast_add, ← heq]
  let sign : ℂ := ∏ p : q.primeFactors, if p.1 ∣ d then
    @maskedReciprocalLocal p.1 ⟨Nat.prime_of_mem_primeFactors p.2⟩ (M p) (a p) (A : ZMod p.1)
    else 1
  have hsign : ‖sign‖ ≤ 1 := by
    dsimp only [sign]
    rw [norm_prod]
    apply Finset.prod_le_one
    · intro p hp
      split_ifs <;> exact norm_nonneg _
    · intro p hp
      split_ifs
      · rw [norm_maskedReciprocalLocal]; split_ifs <;> norm_num
      · simp
  let ι : t.primeFactors → q.primeFactors := fun p =>
    ⟨p.1, Nat.primeFactors_mono htq (NeZero.ne q) p.2⟩
  let Mt := fun p : t.primeFactors => M (ι p)
  let aT : (p : t.primeFactors) → ZMod p.1 → ZMod p.1 := fun p : t.primeFactors => a (ι p)
  let Ft := maskedReciprocalProduct t Mt aT
  have hseparate (u : ℤ) : F (A + (d : ℤ) * u) =
      sign * Ft ((A + (d : ℤ) * u : ℤ) : ZMod t) := by
    rw [hid]
    exact restrict_masked_constants q d t htq hhs hchoice M a A u
  have (p : t.primeFactors) : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
  let M' : (p : t.primeFactors) → Finset (ZMod p.1) := fun p =>
    (Mt p).image (fun z => (z - (A : ZMod p.1)) / (d : ZMod p.1))
  let a' : (p : t.primeFactors) → ZMod p.1 → ZMod p.1 := fun p y =>
    aT p ((A : ZMod p.1) + (d : ZMod p.1) * y) / (d : ZMod p.1)
  let F' := maskedReciprocalProduct t M' a'
  let μ' : ℂ := (∑ x : ZMod t, F' x) / (t : ℂ)
  have haff := maskedReciprocalProduct_affine_transport t d hdt Mt aT A
  have hM' (p : t.primeFactors) : (M' p).card ≤ 2 := (haff.1 p).trans_le (hM (ι p))
  have hph (n : ℕ) : F (A + (d : ℤ) * (n : ℤ)) = sign * F' (n : ZMod t) := by
    rw [hseparate]
    congr 1
    simpa only [Int.cast_add, Int.cast_mul, Int.cast_natCast] using haff.2.2.1 (n : ZMod t)
  have hmean : ‖μ'‖ ≤ B := by
    rw [show μ' = (∑ x : ZMod t, maskedReciprocalProduct t Mt aT x) / (t : ℂ) from haff.2.2.2]
    exact residual_pair_mean q d t hmul hdt hq hhs m hmi c ℓ
  have hsmall : ‖∑ n ∈ Finset.range K, w n * F (A + (d : ℤ) * (n : ℤ))‖ ≤
      ‖∑ n ∈ Finset.range K, w n * F' (n : ZMod t)‖ := by
    have heq : (∑ n ∈ Finset.range K, w n * F (A + (d : ℤ) * (n : ℤ))) =
        sign * (∑ n ∈ Finset.range K, w n * F' (n : ZMod t)) := by
      rw [Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro n hn
      rw [hph]
      ring
    rw [heq, norm_mul]
    simpa only [one_mul] using mul_le_mul_of_nonneg_right hsign (norm_nonneg
      (∑ n ∈ Finset.range K, w n * F' (n : ZMod t)))
  let Ht : ℝ := 1 + Real.log (t : ℝ)
  let Ct : ℝ := (6 : ℝ) ^ t.primeFactors.card
  let Lt : ℝ := (12 : ℝ) ^ t.primeFactors.card * (t.divisors.card : ℝ) * Ht
  have hv : 0 ≤ V := by dsimp only [V]; split_ifs <;> positivity
  obtain ⟨hhle, hcle, hlle⟩ := residual_to_ambient_losses t q htq
  change Ht ≤ H at hhle
  change Ct ≤ C at hcle
  change Lt ≤ L at hlle
  have hb := maskedReciprocalProduct_integer_interval_bounds r s hrs hhs M' a' hM' 0 K w
  change (‖∑ n ∈ Finset.range K, w n * F' ((0 + (n : ℤ) : ℤ) : ZMod t)‖ ≤
      3 * V * Ct * Real.sqrt (t : ℝ) * Ht + ‖∑ n ∈ Finset.range K, w n‖ * ‖μ'‖) ∧
    (‖∑ n ∈ Finset.range K, w n * F' ((0 + (n : ℤ) : ℤ) : ZMod t)‖ ≤
      7 * V * Lt * Real.sqrt (K : ℝ) *
        (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ))) +
      ‖∑ n ∈ Finset.range K, w n‖ * ‖μ'‖) at hb
  have hb' : (‖∑ n ∈ Finset.range K, w n * F' (n : ZMod t)‖ ≤
      3 * V * Ct * Real.sqrt (t : ℝ) * Ht + ‖∑ n ∈ Finset.range K, w n‖ * ‖μ'‖) ∧
    (‖∑ n ∈ Finset.range K, w n * F' (n : ZMod t)‖ ≤
      7 * V * Lt * Real.sqrt (K : ℝ) *
        (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ))) +
      ‖∑ n ∈ Finset.range K, w n‖ * ‖μ'‖) := by simpa only [zero_add, Int.cast_natCast] using hb
  have hmule : ‖∑ n ∈ Finset.range K, w n‖ * ‖μ'‖ ≤ ‖∑ n ∈ Finset.range K, w n‖ * B :=
    mul_le_mul_of_nonneg_left hmean (norm_nonneg _)
  change (_ ≤ _) ∧ (_ ≤ _)
  constructor
  · calc
      _ ≤ ‖∑ n ∈ Finset.range K, w n * F' (n : ZMod t)‖ := hsmall
      _ ≤ _ := hb'.1
      _ ≤ 3 * V * C * Real.sqrt ((q / d : ℕ) : ℝ) * H + ‖∑ n ∈ Finset.range K, w n‖ * B := by
        rw [← hrs_q]
        gcongr
      _ = _ := rfl
  · calc
      _ ≤ ‖∑ n ∈ Finset.range K, w n * F' (n : ZMod t)‖ := hsmall
      _ ≤ _ := hb'.2
      _ ≤ 7 * V * L * Real.sqrt (K : ℝ) *
            (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ))) +
          ‖∑ n ∈ Finset.range K, w n‖ * B := by
        gcongr
      _ = _ := rfl

end PrimeGap186
end

namespace PrimeGap186

open Set

theorem intervalIntegrable_exp_sub_one_div (T : ℝ) (hT : 0 < T) :
    IntervalIntegrable (fun t : ℝ => (Real.exp (-t) - 1) / t) volume 0 T := by
  classical
  let g := Function.update (fun t : ℝ => (Real.exp (-t) - 1) / t) 0 (-1)
  have hg : Continuous g := by
    apply continuous_iff_continuousAt.mpr
    intro t
    by_cases ht : t = 0
    · subst t
      have hd : HasDerivAt (fun t : ℝ => Real.exp (-t)) (-1) 0 := by
        simpa using (hasDerivAt_id (0 : ℝ)).neg.exp
      simpa [g] using hd.continuousAt_div
    · rw [continuousAt_update_of_ne ht]
      exact ((Real.continuous_exp.comp continuous_neg).continuousAt.sub
        continuousAt_const).div continuousAt_id ht
  apply (hg.intervalIntegrable 0 T).congr_uIoo
  intro t ht
  have ht' : t ∈ Ioo 0 T := by simpa [uIoo_of_lt hT] using ht
  have ht0 : t ≠ 0 := ht'.1.ne'
  simp [g, Function.update_of_ne ht0]

theorem exp_sub_one_mul_log_tendsto_zero :
    Tendsto (fun t : ℝ => (Real.exp (-t) - 1) * Real.log t) (𝓝[>] 0) (𝓝 0) := by
  have hd : HasDerivAt (fun t : ℝ => Real.exp (-t)) (-1) 0 := by
    simpa using (hasDerivAt_id (0 : ℝ)).neg.exp
  have hs := hd.tendsto_slope_zero_right
  have hl := tendsto_log_mul_rpow_nhdsGT_zero (r := (1 : ℝ)) zero_lt_one
  have h := hs.mul hl
  simp only [zero_add, neg_zero, Real.exp_zero, smul_eq_mul, Real.rpow_one,
    mul_zero] at h
  apply h.congr'
  filter_upwards [self_mem_nhdsWithin] with t ht
  have ht0 : t ≠ 0 := (show 0 < t from ht).ne'
  calc
    _ = (t⁻¹ * t) * ((Real.exp (-t) - 1) * Real.log t) := by ring
    _ = _ := by rw [inv_mul_cancel₀ ht0, one_mul]

theorem log_add_integral_exp_sub_one_div (T : ℝ) (hT : 0 < T) :
    Real.log T + (∫ t in (0 : ℝ)..T, (Real.exp (-t) - 1) / t) =
      Real.exp (-T) * Real.log T + ∫ t in (0 : ℝ)..T, Real.log t * Real.exp (-t) := by
  have hi := intervalIntegrable_exp_sub_one_div T hT
  have hj : IntervalIntegrable (fun t : ℝ => Real.log t * Real.exp (-t)) volume 0 T :=
    (intervalIntegrable_iff_integrableOn_Ioc_of_le hT.le).mpr
      (integrableOn_log_mul_exp_neg.mono_set Ioc_subset_Ioi_self)
  have hder (t : ℝ) (ht : t ∈ Ioo 0 T) :
      HasDerivAt (fun t : ℝ => (Real.exp (-t) - 1) * Real.log t)
        ((Real.exp (-t) - 1) / t - Real.log t * Real.exp (-t)) t := by
    convert! ((hasDerivAt_id t).neg.exp.sub_const 1).mul
      (Real.hasDerivAt_log ht.1.ne') using 1
    dsimp
    ring
  have hb : Tendsto (fun t : ℝ => (Real.exp (-t) - 1) * Real.log t)
      (𝓝[<] T) (𝓝 ((Real.exp (-T) - 1) * Real.log T)) :=
    (((Real.continuous_exp.comp continuous_neg).continuousAt.sub continuousAt_const).mul
      (Real.continuousAt_log hT.ne')).tendsto.mono_left nhdsWithin_le_nhds
  have h := intervalIntegral.integral_eq_sub_of_hasDerivAt_of_tendsto hT hder
    (hi.sub hj) exp_sub_one_mul_log_tendsto_zero hb
  rw [intervalIntegral.integral_sub hi hj, sub_zero] at h
  nlinarith

theorem scaled_exp_integral_tendsto :
    Tendsto (fun T : ℝ => T * Real.exp
      (∫ t in (0 : ℝ)..T, (Real.exp (-t) - 1) / t)) atTop
      (𝓝 (Real.exp (-Real.eulerMascheroniConstant))) := by
  have hb : Tendsto (fun T : ℝ => Real.exp (-T) * Real.log T) atTop (𝓝 0) := by
    apply squeeze_zero'
    · filter_upwards [eventually_ge_atTop 1] with T hT
      exact mul_nonneg (Real.exp_nonneg _) (Real.log_nonneg hT)
    · filter_upwards [eventually_ge_atTop 1] with T hT
      exact mul_le_mul_of_nonneg_left (Real.log_le_self (by positivity)) (Real.exp_nonneg _)
    · simpa [pow_one, mul_comm] using Real.tendsto_pow_mul_exp_neg_atTop_nhds_zero 1
  have hi := intervalIntegral_tendsto_integral_Ioi 0 integrableOn_log_mul_exp_neg
    (tendsto_id : Tendsto (fun T : ℝ => T) atTop atTop)
  rw [integral_log_mul_exp_neg_eq_deriv_Gamma, Real.hasDerivAt_Gamma_one.deriv] at hi
  have hlog : Tendsto (fun T : ℝ => Real.log T +
      ∫ t in (0 : ℝ)..T, (Real.exp (-t) - 1) / t) atTop
      (𝓝 (-Real.eulerMascheroniConstant)) := by
    have hsum := hb.add hi
    rw [zero_add] at hsum
    apply hsum.congr'
    filter_upwards [eventually_gt_atTop 0] with T hT
    exact (log_add_integral_exp_sub_one_div T hT).symm
  apply (Real.continuous_exp.tendsto _ |>.comp hlog).congr'
  filter_upwards [eventually_gt_atTop 0] with T hT
  simp [Real.exp_add, Real.exp_log hT]

end PrimeGap186

section
open Set

theorem PrimeGap186.fragmentLaplace_scaled_tendsto
    (κ : ℝ) (hκ : 0 < κ) :
    Filter.Tendsto
      (fun s : ℝ => s * Real.exp
        (∫ u in (0 : ℝ)..κ, (Real.exp (-s * u) - 1) / u))
      Filter.atTop
      (nhds (Real.exp (-Real.eulerMascheroniConstant) / κ)) := by
  have h := PrimeGap186.scaled_exp_integral_tendsto.comp
    (Tendsto.atTop_mul_const hκ (tendsto_id : Tendsto (fun s : ℝ => s) atTop atTop))
  apply (h.div_const κ).congr'
  filter_upwards [eventually_gt_atTop 0] with s hs
  have hsub : (∫ u in (0 : ℝ)..κ, (Real.exp (-s * u) - 1) / u) =
      ∫ t in (0 : ℝ)..s * κ, (Real.exp (-t) - 1) / t := by
    simpa only [smul_eq_mul, div_eq_mul_inv, neg_mul, mul_neg, mul_zero, mul_comm] using
      (Frullani.integral_comp_mul_inv_smul
        (f := fun t : ℝ => Real.exp (-t) - 1) (ε := 0) (r := κ) hs.ne')
  dsimp only [Function.comp_apply, id_eq]
  rw [hsub, mul_assoc, mul_div_assoc, mul_div_cancel_left₀ _ hκ.ne']

end

section
open Set

theorem PrimeGap186.uniform_mixture_restrict_and_remainder
    (κ : ℝ) (hκ : 0 < κ) (μ : MeasureTheory.Measure ℝ)
    [MeasureTheory.IsProbabilityMeasure μ]
    (hμ : ∀ᵐ z ∂μ, 0 ≤ z) :
    let ν := MeasureTheory.Measure.map
      (fun p : ℝ × ℝ => p.1 * (κ + p.2))
      ((MeasureTheory.volume.restrict (Set.Ioc (0 : ℝ) 1)).prod μ)
    let A := ∫ z, (κ + z)⁻¹ ∂μ
    MeasureTheory.IsProbabilityMeasure ν ∧
      (∀ᵐ z ∂ν, 0 ≤ z) ∧
      ν.restrict (Set.Ioo 0 κ) =
        ENNReal.ofReal A • MeasureTheory.volume.restrict (Set.Ioo 0 κ) ∧
      ∀ s : ℝ, 0 < s →
        0 ≤ A - s * (∫ z, Real.exp (-s * z) ∂ν) ∧
        A - s * (∫ z, Real.exp (-s * z) ∂ν) ≤ Real.exp (-κ * s) / κ := by
  let U : Measure ℝ := volume.restrict (Ioc (0 : ℝ) 1)
  let F : ℝ × ℝ → ℝ := fun p => p.1 * (κ + p.2)
  have hF : Measurable F := by fun_prop
  let : IsProbabilityMeasure U := ⟨by simp [U]⟩
  have hprod : ∀ᵐ p ∂U.prod μ, 0 ≤ F p := by
    apply (Measure.ae_prod_iff_ae_ae (measurableSet_le measurable_const hF)).2
    filter_upwards [ae_restrict_mem measurableSet_Ioc] with u hu
    filter_upwards [hμ] with z hz
    exact mul_nonneg hu.1.le (by dsimp; linarith)
  have hν : IsProbabilityMeasure (Measure.map F (U.prod μ)) :=
    inferInstance
  have hνpos : ∀ᵐ z ∂Measure.map F (U.prod μ), 0 ≤ z :=
    (ae_map_iff hF.aemeasurable measurableSet_Ici).2 hprod
  have hinv : Integrable (fun z : ℝ => (κ + z)⁻¹) μ := by
    apply Integrable.of_bound (by fun_prop) κ⁻¹
    filter_upwards [hμ] with z hz
    rw [Real.norm_eq_abs, abs_of_nonneg (inv_nonneg.mpr (by linarith))]
    exact inv_anti₀ hκ (by linarith)
  have hnonneg : ∀ᵐ z ∂μ, 0 ≤ (κ + z)⁻¹ :=
    hμ.mono fun z hz => inv_nonneg.mpr (by linarith)
  refine ⟨hν, hνpos, ?_, ?_⟩
  · apply Measure.ext
    intro t ht
    rw [Measure.restrict_apply ht, Measure.map_apply hF (ht.inter measurableSet_Ioo),
      Measure.prod_apply_symm (hF (ht.inter measurableSet_Ioo)), Measure.smul_apply, smul_eq_mul,
      Measure.restrict_apply ht, ofReal_integral_eq_lintegral_ofReal hinv hnonneg,
      ← lintegral_mul_const _ (by fun_prop)]
    apply lintegral_congr_ae
    filter_upwards [hμ] with z hz
    have ha : 0 < κ + z := by linarith
    have hs : (fun u : ℝ => u * (κ + z)) ⁻¹' (t ∩ Ioo 0 κ) ⊆ Ioc 0 1 := by
      intro u hu
      change u * (κ + z) ∈ t ∩ Ioo 0 κ at hu
      have hu0 : 0 < u := (mul_pos_iff_of_pos_right ha).mp hu.2.1
      refine ⟨hu0, ?_⟩
      have hlt : u * (κ + z) < 1 * (κ + z) := by nlinarith [hu.2.2]
      exact ((mul_lt_mul_iff_left₀ ha).mp hlt).le
    change (volume.restrict (Ioc (0 : ℝ) 1))
      ((fun u : ℝ => u * (κ + z)) ⁻¹' (t ∩ Ioo 0 κ)) = _
    rw [Measure.restrict_apply' (s := Ioc (0 : ℝ) 1) measurableSet_Ioc, inter_eq_left.mpr hs,
      Real.volume_preimage_mul_right ha.ne', abs_of_pos (inv_pos.mpr ha)]
  · intro s hs
    have hrem : Integrable (fun z : ℝ => Real.exp (-s * (κ + z)) * (κ + z)⁻¹) μ := by
      apply hinv.mono' (by fun_prop)
      filter_upwards [hμ] with z hz
      have ha : 0 < κ + z := by linarith
      rw [Real.norm_eq_abs, abs_of_nonneg (mul_nonneg (Real.exp_pos _).le (inv_pos.mpr ha).le)]
      exact mul_le_of_le_one_left (inv_pos.mpr ha).le
        (Real.exp_le_one_iff.mpr (by nlinarith))
    have hexp : Integrable (fun p : ℝ × ℝ => Real.exp (-s * F p)) (U.prod μ) := by
      apply Integrable.of_bound (by fun_prop) 1
      filter_upwards [hprod] with p hp
      rw [Real.norm_eq_abs, abs_of_pos (Real.exp_pos _)]
      exact Real.exp_le_one_iff.mpr (by nlinarith)
    have hinner (z : ℝ) (hz : 0 ≤ z) :
        s * (∫ u, Real.exp (-s * (u * (κ + z))) ∂U) =
          (κ + z)⁻¹ - Real.exp (-s * (κ + z)) * (κ + z)⁻¹ := by
      have ha : κ + z ≠ 0 := ne_of_gt (by linarith)
      have hc : -s * (κ + z) ≠ 0 := mul_ne_zero (neg_ne_zero.mpr hs.ne') ha
      have hscale := intervalIntegral.integral_comp_mul_left
        (a := (0 : ℝ)) (b := 1) Real.exp hc
      simp only [mul_zero, mul_one, integral_exp,
        Real.exp_zero, smul_eq_mul] at hscale
      rw [show (∫ u, Real.exp (-s * (u * (κ + z))) ∂U) =
          ∫ u in (0 : ℝ)..1, Real.exp ((-s * (κ + z)) * u) by
        rw [intervalIntegral.integral_of_le zero_le_one]
        congr 1
        ext u
        congr 1
        ring, hscale]
      field_simp
      ring
    have hid :
        (∫ z, (κ + z)⁻¹ ∂μ) -
            s * (∫ z, Real.exp (-s * z) ∂Measure.map F (U.prod μ)) =
          ∫ z, Real.exp (-s * (κ + z)) * (κ + z)⁻¹ ∂μ := by
      rw [integral_map_of_stronglyMeasurable hF (by fun_prop), integral_prod_symm _ hexp,
        ← integral_const_mul]
      have heq :
          (∫ z, s * (∫ u, Real.exp (-s * F (u, z)) ∂U) ∂μ) =
            ∫ z, (κ + z)⁻¹ - Real.exp (-s * (κ + z)) * (κ + z)⁻¹ ∂μ := by
        apply integral_congr_ae
        filter_upwards [hμ] with z hz using hinner z hz
      rw [heq, integral_sub hinv hrem]
      ring
    change 0 ≤ (∫ z, (κ + z)⁻¹ ∂μ) -
        s * (∫ z, Real.exp (-s * z) ∂Measure.map F (U.prod μ)) ∧ _
    rw [hid]
    constructor
    · apply integral_nonneg_of_ae
      filter_upwards [hμ] with z hz
      exact mul_nonneg (Real.exp_pos _).le (inv_nonneg.mpr (by linarith))
    · calc
        (∫ z, Real.exp (-s * (κ + z)) * (κ + z)⁻¹ ∂μ) ≤
            ∫ _ : ℝ, Real.exp (-κ * s) / κ ∂μ := by
          apply integral_mono_ae hrem (integrable_const _)
          filter_upwards [hμ] with z hz
          have ha : 0 < κ + z := by linarith
          rw [div_eq_mul_inv]
          apply mul_le_mul
          · exact Real.exp_le_exp.mpr (by nlinarith)
          · exact inv_anti₀ hκ (by linarith)
          · exact (inv_pos.mpr ha).le
          · exact (Real.exp_pos _).le
        _ = Real.exp (-κ * s) / κ := by simp

end

namespace PrimeGap186

open Set

theorem nonnegative_laplace_measure_ext
    (μ ν : Measure ℝ) [IsProbabilityMeasure μ] [IsProbabilityMeasure ν]
    (hμ : ∀ᵐ x ∂μ, 0 ≤ x) (hν : ∀ᵐ x ∂ν, 0 ≤ x)
    (hL : ∀ s : ℝ, 0 ≤ s →
      (∫ x, Real.exp (-s * x) ∂μ) = ∫ x, Real.exp (-s * x) ∂ν) :
    μ = ν := by
  let E := Fin 1 → ℝ≥0
  let f : ℝ → E := fun x _ => x.toNNReal
  have hf : Measurable f := by fun_prop
  let P : ProbabilityMeasure E :=
    ⟨Measure.map f μ, inferInstance⟩
  let Q : ProbabilityMeasure E :=
    ⟨Measure.map f ν, inferInstance⟩
  have htransform (s : Fin 1 → ℝ≥0) :
      (∫ v, Real.exp (-(∑ j, (s j : ℝ) * (v j : ℝ))) ∂(P : Measure E)) =
        ∫ v, Real.exp (-(∑ j, (s j : ℝ) * (v j : ℝ))) ∂(Q : Measure E) := by
    change (∫ v, Real.exp (-(∑ j, (s j : ℝ) * (v j : ℝ))) ∂Measure.map f μ) =
      ∫ v, Real.exp (-(∑ j, (s j : ℝ) * (v j : ℝ))) ∂Measure.map f ν
    have hc : Continuous (fun v : E =>
        Real.exp (-(∑ j, (s j : ℝ) * (v j : ℝ)))) := by fun_prop
    rw [integral_map hf.aemeasurable hc.aestronglyMeasurable,
      integral_map hf.aemeasurable hc.aestronglyMeasurable]
    calc
      _ = ∫ x, Real.exp (-(s 0 : ℝ) * x) ∂μ := by
        apply integral_congr_ae
        filter_upwards [hμ] with x hx
        simp [f, Real.toNNReal_of_nonneg hx]
      _ = ∫ x, Real.exp (-(s 0 : ℝ) * x) ∂ν := hL _ (s 0).coe_nonneg
      _ = _ := by
        apply integral_congr_ae
        filter_upwards [hν] with x hx
        simp [f, Real.toNNReal_of_nonneg hx]
  have hlim : Tendsto (fun _ : ℕ => P) atTop (𝓝 Q) := by
    apply tendsto_of_tight_of_joint_nonnegative_laplace
    · simpa only [Set.range_const] using
        (isTightMeasureSet_singleton (μ := (P : Measure E)))
    · intro s
      rw [htransform]
      exact tendsto_const_nhds
  have heq : P = Q := tendsto_nhds_unique tendsto_const_nhds hlim
  have heq' : Measure.map f μ = Measure.map f ν :=
    congrArg (fun p : ProbabilityMeasure E => (p : Measure E)) heq
  let g : E → ℝ := fun v => (v 0 : ℝ)
  have hg : Measurable g := by fun_prop
  have hback (η : Measure ℝ) (hη : ∀ᵐ x ∂η, 0 ≤ x) :
      Measure.map g (Measure.map f η) = η := by
    rw [Measure.map_map hg hf]
    calc
      _ = Measure.map id η := Measure.map_congr (by
        filter_upwards [hη] with x hx
        simp [g, f, Real.toNNReal_of_nonneg hx])
      _ = η := Measure.map_id
  simpa only [hback μ hμ, hback ν hν] using congrArg (Measure.map g) heq'

theorem fragmentLaplace_primitive (κ s : ℝ) (hκ : 0 < κ) (hs : 0 ≤ s) :
    (∫ v in (0 : ℝ)..s, Real.exp (-κ * v) *
      Real.exp (∫ u in (0 : ℝ)..κ, (Real.exp (-v * u) - 1) / u)) =
      s * Real.exp (∫ u in (0 : ℝ)..κ, (Real.exp (-s * u) - 1) / u) := by
  let f : ℝ → ℝ := fun u => (Real.exp (-u) - 1) / u
  let F : ℝ → ℝ := fun t => ∫ u in (0 : ℝ)..t, f u
  let L : ℝ → ℝ := fun v => Real.exp (F (v * κ))
  have hfm : Measurable f := by dsimp [f]; fun_prop
  have hfi (t : ℝ) (ht : 0 ≤ t) : IntervalIntegrable f volume 0 t := by
    rcases ht.eq_or_lt with rfl | ht
    · simp
    · exact intervalIntegrable_exp_sub_one_div t ht
  have hscale (v : ℝ) :
      (∫ u in (0 : ℝ)..κ, (Real.exp (-v * u) - 1) / u) = F (v * κ) := by
    by_cases hv : v = 0
    · simp [hv, F, f]
    simpa only [f, F, smul_eq_mul, div_eq_mul_inv, neg_mul, mul_neg, mul_zero, mul_comm] using
      (Frullani.integral_comp_mul_inv_smul
        (f := fun u : ℝ => Real.exp (-u) - 1) (ε := 0) (r := κ) hv)
  simp_rw [hscale]
  change (∫ v in (0 : ℝ)..s, Real.exp (-κ * v) * L v) = s * L s
  have hFcont : ContinuousOn F (Set.Icc 0 (s * κ)) := by
    simpa only [Set.uIcc_of_le (mul_nonneg hs hκ.le)] using
      (intervalIntegral.continuousOn_primitive_interval' (hfi (s * κ) (mul_nonneg hs hκ.le))
        (a := 0) Set.left_mem_uIcc)
  have hLc : ContinuousOn L (Set.Icc 0 s) := by
    apply (hFcont.comp (continuous_id.mul_const κ).continuousOn ?_).rexp
    intro v hv
    exact ⟨mul_nonneg hv.1 hκ.le, mul_le_mul_of_nonneg_right hv.2 hκ.le⟩
  have hLd (v : ℝ) (hv : 0 < v) :
      HasDerivAt (fun t => t * L t) (Real.exp (-κ * v) * L v) v := by
    have hvκ : 0 < v * κ := mul_pos hv hκ
    have hfc : ContinuousAt f (v * κ) := by
      dsimp [f]
      exact (Real.continuous_exp.continuousAt.comp continuousAt_id.neg |>.sub
        continuousAt_const).div continuousAt_id hvκ.ne'
    have hFd : HasDerivAt F (f (v * κ)) (v * κ) :=
      intervalIntegral.integral_hasDerivAt_right (hfi (v * κ) hvκ.le)
        hfm.stronglyMeasurable.stronglyMeasurableAtFilter hfc
    convert! (hasDerivAt_id v).mul
      ((hFd.comp v ((hasDerivAt_id v).mul_const κ)).exp) using 1
    dsimp [f, L]
    rw [show -κ * v = -(v * κ) by ring]
    field_simp [hv.ne', hκ.ne']
    ring
  have hc : ContinuousOn (fun v => v * L v) (Set.Icc 0 s) :=
    continuousOn_id.mul hLc
  have hi : IntervalIntegrable (fun v => Real.exp (-κ * v) * L v) volume 0 s :=
    ((by fun_prop : Continuous (fun v : ℝ => Real.exp (-κ * v))).continuousOn.mul
      hLc).intervalIntegrable_of_Icc hs
  have h := intervalIntegral.integral_eq_sub_of_hasDerivAt_of_le hs hc
    (fun v hv => hLd v hv.1) hi
  simpa using h

end PrimeGap186

section
open Set

theorem PrimeGap186.fragmentLaw_mass_perpetuity
    (κ : ℝ) (hκ : 0 < κ) :
    let μ := MeasureTheory.Measure.map
      (fun c : MeasureTheory.FiniteMeasure ℝ => (c.mass : ℝ))
      (PrimeGap186.fragmentLaw κ)
    μ = MeasureTheory.Measure.map
      (fun p : ℝ × ℝ => p.1 * (κ + p.2))
      ((MeasureTheory.volume.restrict (Set.Ioc (0 : ℝ) 1)).prod μ) := by
  let μ := Measure.map (fun c : FiniteMeasure ℝ => (c.mass : ℝ)) (PrimeGap186.fragmentLaw κ)
  let U : Measure ℝ := volume.restrict (Set.Ioc (0 : ℝ) 1)
  let f : ℝ × ℝ → ℝ := fun p => p.1 * (κ + p.2)
  let ν := Measure.map f (U.prod μ)
  let L : ℝ → ℝ := fun s => Real.exp
    (∫ u in (0 : ℝ)..κ, (Real.exp (-s * u) - 1) / u)
  change μ = ν
  have hm : Measurable (fun c : FiniteMeasure ℝ => (c.mass : ℝ)) := by
    have h : Measurable (fun c : FiniteMeasure ℝ => (c : Measure ℝ) Set.univ) :=
      (Measure.measurable_coe MeasurableSet.univ).comp measurable_subtype_coe
    simpa only [← FiniteMeasure.ennreal_mass, ENNReal.coe_toReal] using h.ennreal_toReal
  let : IsProbabilityMeasure (PrimeGap186.fragmentLaw κ) :=
    PrimeGap186.fragmentLaw_isProbabilityMeasure κ
  let : IsProbabilityMeasure μ := inferInstance
  let : IsProbabilityMeasure U := ⟨by simp [U]⟩
  have hf : Measurable f := by fun_prop
  have hμ : ∀ᵐ z ∂μ, 0 ≤ z :=
    (ae_map_iff hm.aemeasurable measurableSet_Ici).2
      (ae_of_all _ fun c => c.mass.coe_nonneg)
  have hmix := PrimeGap186.uniform_mixture_restrict_and_remainder κ hκ μ hμ
  let : IsProbabilityMeasure ν := hmix.1
  have hν : ∀ᵐ z ∂ν, 0 ≤ z := hmix.2.1
  have hprod : ∀ᵐ p ∂U.prod μ, 0 ≤ f p :=
    (ae_map_iff hf.aemeasurable measurableSet_Ici).1 hν
  have hLaplace (v : ℝ) (hv : 0 ≤ v) :
      (∫ z, Real.exp (-v * z) ∂μ) = L v := by
    rw [integral_map_of_stronglyMeasurable hm (by fun_prop)]
    exact PrimeGap186.integral_exp_neg_mass_fragmentLaw κ v hκ hv
  apply PrimeGap186.nonnegative_laplace_measure_ext μ ν hμ hν
  intro s hs
  rcases hs.eq_or_lt with rfl | hs
  · simp
  have hi : Integrable (fun p : ℝ × ℝ => Real.exp (-s * f p)) (U.prod μ) := by
    apply Integrable.of_bound (by fun_prop) 1
    filter_upwards [hprod] with p hp
    rw [Real.norm_eq_abs, abs_of_pos (Real.exp_pos _)]
    exact Real.exp_le_one_iff.mpr (by nlinarith)
  rw [hLaplace s hs.le]
  symm
  change (∫ z, Real.exp (-s * z) ∂Measure.map f (U.prod μ)) = L s
  rw [integral_map_of_stronglyMeasurable hf (by fun_prop), integral_prod _ hi]
  have hinner :
      (∫ u, ∫ z, Real.exp (-s * f (u, z)) ∂μ ∂U) =
        ∫ u in (0 : ℝ)..1, Real.exp (-κ * (s * u)) * L (s * u) := by
    rw [intervalIntegral.integral_of_le zero_le_one]
    apply integral_congr_ae
    filter_upwards [ae_restrict_mem measurableSet_Ioc] with u hu
    have he (z : ℝ) :
        Real.exp (-s * f (u, z)) =
          Real.exp (-κ * (s * u)) * Real.exp (-(s * u) * z) := by
      rw [← Real.exp_add]
      congr 1
      dsimp [f]
      ring
    simp_rw [he]
    rw [integral_const_mul, hLaplace (s * u) (mul_nonneg hs.le hu.1.le)]
  rw [hinner]
  have hscale := intervalIntegral.integral_comp_mul_left
    (a := (0 : ℝ)) (b := 1)
    (fun v : ℝ => Real.exp (-κ * v) * L v) hs.ne'
  simp only [mul_zero, mul_one, smul_eq_mul] at hscale
  have hprimitive :
      (∫ v in (0 : ℝ)..s, Real.exp (-κ * v) * L v) = s * L s :=
    PrimeGap186.fragmentLaplace_primitive κ s hκ hs.le
  rw [hscale, hprimitive, inv_mul_cancel_left₀ hs.ne']

theorem PrimeGap186.fragmentLaw_mass_restrict_Ioo
    (κ : ℝ) (hκ : 0 < κ) :
    ((ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ)) •
        MeasureTheory.Measure.map
          (fun c : MeasureTheory.FiniteMeasure ℝ => (c.mass : ℝ))
          (PrimeGap186.fragmentLaw κ)).restrict (Set.Ioo 0 κ) =
      MeasureTheory.volume.restrict (Set.Ioo 0 κ) := by
  let μ := Measure.map (fun c : FiniteMeasure ℝ => (c.mass : ℝ)) (PrimeGap186.fragmentLaw κ)
  let ν := Measure.map (fun p : ℝ × ℝ => p.1 * (κ + p.2))
    ((volume.restrict (Set.Ioc (0 : ℝ) 1)).prod μ)
  let A := ∫ z, (κ + z)⁻¹ ∂μ
  have hm : Measurable (fun c : FiniteMeasure ℝ => (c.mass : ℝ)) := by
    have h : Measurable (fun c : FiniteMeasure ℝ => (c : Measure ℝ) Set.univ) :=
      (Measure.measurable_coe MeasurableSet.univ).comp measurable_subtype_coe
    simpa only [← FiniteMeasure.ennreal_mass, ENNReal.coe_toReal] using h.ennreal_toReal
  let : IsProbabilityMeasure (PrimeGap186.fragmentLaw κ) :=
    PrimeGap186.fragmentLaw_isProbabilityMeasure κ
  let : IsProbabilityMeasure μ := inferInstance
  have hμ : ∀ᵐ z ∂μ, 0 ≤ z :=
    (ae_map_iff hm.aemeasurable measurableSet_Ici).2
      (ae_of_all _ fun c => c.mass.coe_nonneg)
  have heq : μ = ν := PrimeGap186.fragmentLaw_mass_perpetuity κ hκ
  have hmix := PrimeGap186.uniform_mixture_restrict_and_remainder κ hκ μ hμ
  have hrestrict :
      μ.restrict (Set.Ioo 0 κ) =
        ENNReal.ofReal A • volume.restrict (Set.Ioo 0 κ) := by
    rw [heq]
    exact hmix.2.2.1
  have hrem (s : ℝ) (hs : 0 < s) :
      0 ≤ A - s * (∫ z, Real.exp (-s * z) ∂μ) ∧
        A - s * (∫ z, Real.exp (-s * z) ∂μ) ≤ Real.exp (-κ * s) / κ := by
    rw [heq]
    exact hmix.2.2.2 s hs
  have hbound : Tendsto (fun s : ℝ => Real.exp (-κ * s) / κ) atTop (𝓝 0) := by
    have hn : Tendsto (fun s : ℝ => -κ * s) atTop atBot :=
      (tendsto_id : Tendsto (fun s : ℝ => s) atTop atTop).const_mul_atTop_of_neg
        (neg_lt_zero.mpr hκ)
    simpa using (Real.tendsto_exp_atBot.comp hn).div_const κ
  have hzero : Tendsto (fun s : ℝ => A - s * (∫ z, Real.exp (-s * z) ∂μ))
      atTop (𝓝 0) := by
    apply squeeze_zero'
    · filter_upwards [eventually_gt_atTop 0] with s hs using (hrem s hs).1
    · filter_upwards [eventually_gt_atTop 0] with s hs using (hrem s hs).2
    · exact hbound
  have hA_limit : Tendsto (fun s : ℝ => s * (∫ z, Real.exp (-s * z) ∂μ))
      atTop (𝓝 A) := by
    simpa only [sub_sub_cancel, sub_zero] using
      (tendsto_const_nhds : Tendsto (fun _ : ℝ => A) atTop (𝓝 A)).sub hzero
  have hLaplace (s : ℝ) (hs : 0 ≤ s) :
      (∫ z, Real.exp (-s * z) ∂μ) =
        Real.exp (∫ u in (0 : ℝ)..κ, (Real.exp (-s * u) - 1) / u) := by
    rw [integral_map_of_stronglyMeasurable hm (by fun_prop)]
    exact PrimeGap186.integral_exp_neg_mass_fragmentLaw κ s hκ hs
  have hscalar := (PrimeGap186.fragmentLaplace_scaled_tendsto κ hκ).congr'
    (show (fun s : ℝ => s * Real.exp
        (∫ u in (0 : ℝ)..κ, (Real.exp (-s * u) - 1) / u)) =ᶠ[atTop]
      (fun s : ℝ => s * (∫ z, Real.exp (-s * z) ∂μ)) from by
      filter_upwards [eventually_ge_atTop 0] with s hs
      rw [hLaplace s hs])
  have hA : A = Real.exp (-Real.eulerMascheroniConstant) / κ :=
    tendsto_nhds_unique hA_limit hscalar
  have hconstant :
      (Real.exp Real.eulerMascheroniConstant * κ) * A = 1 := by
    rw [hA]
    calc
      _ = Real.exp Real.eulerMascheroniConstant *
          (Real.exp (-Real.eulerMascheroniConstant) / κ * κ) := by ring
      _ = Real.exp Real.eulerMascheroniConstant * Real.exp (-Real.eulerMascheroniConstant) := by
        rw [div_mul_cancel₀ _ hκ.ne']
      _ = 1 := by rw [← Real.exp_add, add_neg_cancel, Real.exp_zero]
  change (ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) • μ).restrict
    (Set.Ioo 0 κ) = volume.restrict (Set.Ioo 0 κ)
  rw [Measure.restrict_smul, hrestrict, smul_smul,
    ← ENNReal.ofReal_mul (mul_nonneg (Real.exp_pos _).le hκ.le),
    hconstant, ENNReal.ofReal_one, one_smul]

end

namespace PrimeGap186

theorem sum_Icc_divisorsAntidiagonal_fixed (m N p : ℕ) (hm : 0 < m)
    (hp : 0 < p) (f : ℕ → ℝ) :
    (∑ n ∈ Finset.Icc m N, ∑ d ∈ n.divisorsAntidiagonal,
      if d.1 = p then f d.2 else 0) =
      ∑ q ∈ Finset.Icc 1 N, if m ≤ p * q ∧ p * q ≤ N then f q else 0 := by
  classical
  simp_rw [← Finset.sum_filter]
  rw [Finset.sum_sigma']
  refine Finset.sum_bij (fun a _ => a.2.2) ?_ ?_ ?_ (by intros; rfl)
  · rintro ⟨n, a, b⟩ hn
    simp only [Finset.mem_sigma, Finset.mem_filter, Finset.mem_Icc,
      Nat.mem_divisorsAntidiagonal] at hn ⊢
    rcases hn with ⟨⟨hmn, hnN⟩, ⟨hprod, _⟩, rfl⟩
    subst n
    exact ⟨⟨Nat.pos_of_mul_pos_left (hm.trans_le hmn),
      (Nat.le_mul_of_pos_left b hp).trans hnN⟩, hmn, hnN⟩
  · rintro ⟨n, a, b⟩ hn ⟨n', a', b'⟩ hn' h
    simp only [Finset.mem_sigma, Finset.mem_filter, Nat.mem_divisorsAntidiagonal] at hn hn'
    rcases hn with ⟨_, ⟨hprod, _⟩, rfl⟩
    rcases hn' with ⟨_, ⟨hprod', _⟩, rfl⟩
    dsimp at h
    subst n
    subst n'
    cases h
    rfl
  · intro q hq
    simp only [Finset.mem_filter, Finset.mem_Icc] at hq
    refine ⟨⟨p * q, p, q⟩, ?_, rfl⟩
    simp only [Finset.mem_sigma, Finset.mem_filter, Finset.mem_Icc,
      Nat.mem_divisorsAntidiagonal]
    exact ⟨hq.2, ⟨True.intro, (mul_pos hp hq.1.1).ne'⟩, True.intro⟩

theorem sum_real_Icc_divisorsAntidiagonal_fixed (A B : ℝ) (p : ℕ)
    (hA : 0 < A) (hAB : A ≤ B) (hp : 0 < p) (f : ℕ → ℝ) :
    (∑ n ∈ Finset.Icc ⌈A⌉₊ ⌊B⌋₊, ∑ d ∈ n.divisorsAntidiagonal,
      if d.1 = p then f d.2 else 0) =
      ∑ q ∈ Finset.Icc ⌈A / (p : ℝ)⌉₊ ⌊B / (p : ℝ)⌋₊, f q := by
  classical
  rw [sum_Icc_divisorsAntidiagonal_fixed _ _ p (Nat.ceil_pos.mpr hA) hp,
    ← Finset.sum_filter]
  congr 1
  ext q
  have hpR : 0 < (p : ℝ) := by exact_mod_cast hp
  have hB : 0 ≤ B := le_trans hA.le hAB
  have hBp : 0 ≤ B / (p : ℝ) := div_nonneg hB hpR.le
  simp only [Finset.mem_filter, Finset.mem_Icc, Nat.ceil_le,
    Nat.le_floor_iff hB, Nat.le_floor_iff hBp, Nat.cast_mul]
  constructor
  · rintro ⟨⟨_, _⟩, hlo, hhi⟩
    exact ⟨(div_le_iff₀ hpR).mpr (by simpa [mul_comm] using hlo),
      (le_div_iff₀ hpR).mpr (by simpa [mul_comm] using hhi)⟩
  · rintro ⟨hlo, hhi⟩
    have hlo' : A ≤ (p : ℝ) * q := by
      simpa [mul_comm] using (div_le_iff₀ hpR).mp hlo
    have hhi' : (p : ℝ) * q ≤ B := by
      simpa [mul_comm] using (le_div_iff₀ hpR).mp hhi
    have hqpos : 0 < q := by
      exact_mod_cast (div_pos hA hpR).trans_le hlo
    refine ⟨⟨hqpos, ?_⟩, hlo', hhi'⟩
    have hqp : (q : ℝ) ≤ (p : ℝ) * q := by
      exact_mod_cast Nat.le_mul_of_pos_left q hp
    exact hqp.trans hhi'

open Real Finset Filter Asymptotics Topology
open ArithmeticFunction hiding log

theorem integral_semiprime_logarithmic_kernel_substitution (x : ℝ) (hx : 1 < x) :
    (∫ t in x ^ ((9519 : ℝ) / 50000)..x ^ ((40481 : ℝ) / 100000),
      (1 - Real.log t / Real.log x)⁻¹ / (t * Real.log t)) =
      ∫ u in ((9519 : ℝ) / 50000)..((40481 : ℝ) / 100000),
        (u * (1 - u))⁻¹ := by
  let α : ℝ := 9519 / 50000
  let β : ℝ := 40481 / 100000
  change (∫ t in x ^ α..x ^ β,
    (1 - Real.log t / Real.log x)⁻¹ / (t * Real.log t)) =
    ∫ u in α..β, (u * (1 - u))⁻¹
  have hα : 0 < α := by norm_num [α]
  have hαβ : α ≤ β := by norm_num [α, β]
  have hβ : β < 1 := by norm_num [β]
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hlogx : 0 < Real.log x := Real.log_pos hx
  have hAB : x ^ α ≤ x ^ β := Real.rpow_le_rpow_of_exponent_le hx.le hαβ
  let f : ℝ → ℝ := fun t => Real.log t / Real.log x
  let fp : ℝ → ℝ := fun t => t⁻¹ / Real.log x
  let g : ℝ → ℝ := fun u => (u * (1 - u))⁻¹
  have ht_one {t : ℝ} (ht : t ∈ Set.uIcc (x ^ α) (x ^ β)) : 1 < t := by
    rw [Set.uIcc_of_le hAB] at ht
    exact (Real.one_lt_rpow hx hα).trans_le ht.1
  have hft {t : ℝ} (ht : t ∈ Set.uIcc (x ^ α) (x ^ β)) : 0 < f t ∧ f t < 1 := by
    have ht1 := ht_one ht
    rw [Set.uIcc_of_le hAB] at ht
    exact ⟨Real.logb_pos hx ht1,
      ((Real.logb_le_iff_le_rpow hx (zero_lt_one.trans ht1)).2 ht.2).trans_lt hβ⟩
  have hf : ∀ t ∈ Set.uIcc (x ^ α) (x ^ β), HasDerivAt f (fp t) t := by
    intro t ht
    exact (Real.hasDerivAt_log (zero_lt_one.trans (ht_one ht)).ne').div_const _
  have hfp : ContinuousOn fp (Set.uIcc (x ^ α) (x ^ β)) :=
    (continuousOn_id.inv₀ (fun t ht => (zero_lt_one.trans (ht_one ht)).ne')).div_const _
  have hg : ContinuousOn g (f '' Set.uIcc (x ^ α) (x ^ β)) := by
    refine (continuousOn_id.mul (continuousOn_const.sub continuousOn_id)).inv₀ ?_
    rintro u ⟨t, ht, rfl⟩
    exact mul_ne_zero (hft ht).1.ne' (sub_pos.mpr (hft ht).2).ne'
  have hfa : f (x ^ α) = α := Real.logb_rpow hx0 hx.ne'
  have hfb : f (x ^ β) = β := Real.logb_rpow hx0 hx.ne'
  have hsub := intervalIntegral.integral_comp_mul_deriv'
    (a := x ^ α) (b := x ^ β) (f := f) (f' := fp) (g := g) hf hfp hg
  have hleft :
      (∫ t in x ^ α..x ^ β, (1 - Real.log t / Real.log x)⁻¹ / (t * Real.log t)) =
      ∫ t in x ^ α..x ^ β, (g ∘ f) t * fp t := by
    apply intervalIntegral.integral_congr
    intro t ht
    have ht0 : 0 < t := zero_lt_one.trans (ht_one ht)
    have hlogt : 0 < Real.log t := Real.log_pos (ht_one ht)
    have hu : 1 - Real.log t / Real.log x ≠ 0 := (sub_pos.mpr (hft ht).2).ne'
    dsimp only [Function.comp_def, f, fp, g]
    field_simp [ht0.ne', hlogt.ne', hlogx.ne', hu]
  exact hleft.trans (by simpa only [hfa, hfb, g] using hsub)

theorem prime_band_semiprime_kernel_error (α β : ℝ)
    (hα : 0 < α) (hαβ : α ≤ β) (hβ : β < 1) :
    ∃ C : ℝ, 0 < C ∧ ∀ x : ℝ, 1 < x → 2 ≤ x ^ α →
      |(∑ p ∈ (Nat.primesLE ⌊x ^ β⌋₊).filter
          (fun p : ℕ => x ^ α < (p : ℝ)),
          (1 - Real.log p / Real.log x)⁻¹ / (p : ℝ)) -
        ∫ t in x ^ α..x ^ β,
          (1 - Real.log t / Real.log x)⁻¹ / (t * Real.log t)| ≤ C / Real.log x := by
  obtain ⟨C, hC, herror⟩ := prime_second_error_bounded
  let K : ℝ := (1 - β)⁻¹
  have hK : 0 < K := inv_pos.mpr (sub_pos.mpr hβ)
  have hβpos : 0 < β := hα.trans_le hαβ
  have hlogβα : 0 ≤ Real.log (β / α) :=
    Real.log_nonneg ((one_le_div hα).mpr hαβ)
  refine ⟨2 * K * C / α + K ^ 2 * C * Real.log (β / α), by positivity,
    fun x hx hA => ?_⟩
  let A : ℝ := x ^ α
  let B : ℝ := x ^ β
  let f : ℝ → ℝ := fun t => (1 - Real.log t / Real.log x)⁻¹
  let fp : ℝ → ℝ := fun t =>
    (t⁻¹ / Real.log x) * ((1 - Real.log t / Real.log x)⁻¹) ^ 2
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hlogx : 0 < Real.log x := Real.log_pos hx
  have hAB : A ≤ B := Real.rpow_le_rpow_of_exponent_le hx.le hαβ
  have ht1 {t : ℝ} (ht : t ∈ Set.Icc A B) : 1 < t :=
    one_lt_two.trans_le (hA.trans ht.1)
  have htβ {t : ℝ} (ht : t ∈ Set.Icc A B) :
      Real.log t / Real.log x ≤ β :=
    (Real.logb_le_iff_le_rpow hx (zero_lt_one.trans (ht1 ht))).2 ht.2
  have hden {t : ℝ} (ht : t ∈ Set.Icc A B) :
      0 < 1 - Real.log t / Real.log x :=
    sub_pos.mpr ((htβ ht).trans_lt hβ)
  have hlogc : ContinuousOn Real.log (Set.Icc A B) :=
    continuousOn_id.log (fun _ ht => (zero_lt_one.trans (ht1 ht)).ne')
  have hf : ∀ t ∈ Set.Icc A B, HasDerivAt f (fp t) t := by
    intro t ht
    have hd := ((((Real.hasDerivAt_log (zero_lt_one.trans (ht1 ht)).ne').div_const
      (Real.log x)).const_sub 1).inv (hden ht).ne')
    convert! hd using 1
    simp [fp, div_eq_mul_inv, inv_pow]
  have hfc : ContinuousOn f (Set.Icc A B) :=
    (continuousOn_const.sub (hlogc.div_const _)).inv₀ (fun _ ht => (hden ht).ne')
  have hfp : ContinuousOn fp (Set.Icc A B) :=
    ((continuousOn_id.inv₀
      (fun _ ht => (zero_lt_one.trans (ht1 ht)).ne')).div_const _).mul (hfc.pow 2)
  have hfbound {t : ℝ} (ht : t ∈ Set.Icc A B) : |f t| ≤ K := by
    change |(1 - Real.log t / Real.log x)⁻¹| ≤ (1 - β)⁻¹
    rw [abs_of_pos (inv_pos.mpr (hden ht))]
    exact inv_anti₀ (sub_pos.mpr hβ) (sub_le_sub_left (htβ ht) 1)
  have he {t : ℝ} (ht : t ∈ Set.Icc A B) :
      |primeSecondError t| ≤ C / (α * Real.log x) := by
    have hAt : 2 ≤ t := hA.trans ht.1
    apply (herror t hAt).trans
    apply div_le_div_of_nonneg_left hC.le (mul_pos hα hlogx)
    have hl := Real.log_le_log (Real.rpow_pos_of_pos hx0 α) ht.1
    simpa only [A, Real.log_rpow hx0] using hl
  have hkernel : ContinuousOn (fun t : ℝ => t⁻¹ / Real.log t) (Set.Icc A B) :=
    (continuousOn_id.inv₀ (fun _ ht => (zero_lt_one.trans (ht1 ht)).ne')).div
      hlogc (fun _ ht => (Real.log_pos (ht1 ht)).ne')
  have hkerIntegral :
      (∫ t in A..B, t⁻¹ / Real.log t) = Real.log (β / α) := by
    rw [integral_inv_div_log (ht1 ⟨le_rfl, hAB⟩) (ht1 ⟨hAB, le_rfl⟩)]
    dsimp only [A, B]
    rw [Real.log_rpow hx0, Real.log_rpow hx0,
      Real.log_mul hβpos.ne' hlogx.ne', Real.log_mul hα.ne' hlogx.ne',
      Real.log_div hβpos.ne' hα.ne']
    ring
  have hint :
      |∫ t in A..B, fp t * primeSecondError t| ≤
        (K ^ 2 * C / Real.log x) * Real.log (β / α) := by
    calc
      _ ≤ ∫ t in A..B, (K ^ 2 * C / Real.log x) * (t⁻¹ / Real.log t) := by
        rw [← Real.norm_eq_abs]
        apply intervalIntegral.norm_integral_le_of_norm_le hAB
          (Filter.Eventually.of_forall ?_)
          ((hkernel.intervalIntegrable_of_Icc hAB).const_mul _)
        intro t ht
        have hti : t ∈ Set.Icc A B := ⟨ht.1.le, ht.2⟩
        have ht0 : 0 < t := zero_lt_one.trans (ht1 hti)
        have hlogt : 0 < Real.log t := Real.log_pos (ht1 hti)
        have hft : 0 ≤ f t := (inv_pos.mpr (hden hti)).le
        have hftK : f t ≤ K := (le_abs_self _).trans (hfbound hti)
        have hfp0 : 0 ≤ fp t := by dsimp only [fp]; positivity
        have hfpbound : fp t ≤ (t⁻¹ / Real.log x) * K ^ 2 :=
          mul_le_mul_of_nonneg_left (pow_le_pow_left₀ hft hftK 2) (by positivity)
        rw [Real.norm_eq_abs, abs_mul, abs_of_nonneg hfp0]
        calc
          _ ≤ ((t⁻¹ / Real.log x) * K ^ 2) * (C / Real.log t) :=
            mul_le_mul hfpbound (herror t (hA.trans hti.1)) (abs_nonneg _)
              (by positivity)
          _ = _ := by ring
      _ = _ := by rw [intervalIntegral.integral_const_mul, hkerIntegral]
  have hid := prime_band_abel_identity A B hA hAB f fp hf hfp
  change |(∑ p ∈ (Nat.primesLE ⌊B⌋₊).filter (fun p : ℕ => A < (p : ℝ)),
    f p / (p : ℝ)) - ∫ t in A..B, f t / (t * Real.log t)| ≤ _
  rw [hid]
  calc
    _ ≤ |f B * primeSecondError B| + |f A * primeSecondError A| +
        |∫ t in A..B, fp t * primeSecondError t| :=
      (abs_sub _ _).trans (add_le_add (abs_sub _ _) le_rfl)
    _ ≤ K * (C / (α * Real.log x)) + K * (C / (α * Real.log x)) +
        (K ^ 2 * C / Real.log x) * Real.log (β / α) := by
      rw [abs_mul, abs_mul]
      exact add_le_add
        (add_le_add
          (mul_le_mul (hfbound ⟨hAB, le_rfl⟩) (he ⟨hAB, le_rfl⟩)
            (abs_nonneg _) hK.le)
          (mul_le_mul (hfbound ⟨le_rfl, hAB⟩) (he ⟨le_rfl, hAB⟩)
            (abs_nonneg _) hK.le)) hint
    _ = _ := by ring

theorem semiprime_named_band_endpoint_error (x : ℝ) (hx : 1 < x) :
    |(∑ p ∈ (Nat.primesBelow (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
          (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ)),
          ((p : ℝ) * (1 - Real.logb x (p : ℝ)))⁻¹) -
        ∑ p ∈ (Nat.primesLE (Nat.floor (x ^ ((40481 : ℝ) / 100000)))).filter
          (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) < (p : ℝ)),
          ((p : ℝ) * (1 - Real.logb x (p : ℝ)))⁻¹| ≤
      2 / ((1 - (40481 : ℝ) / 100000) * x ^ ((9519 : ℝ) / 50000)) := by
  classical
  let α : ℝ := 9519 / 50000
  let β : ℝ := 40481 / 100000
  let A : ℝ := x ^ α
  let B : ℝ := x ^ β
  let S := (Nat.primesBelow (Nat.ceil B)).filter (fun p : ℕ => A ≤ (p : ℝ))
  let T := (Nat.primesLE (Nat.floor B)).filter (fun p : ℕ => A < (p : ℝ))
  let g : ℕ → ℝ := fun p => ((p : ℝ) * (1 - Real.logb x (p : ℝ)))⁻¹
  change |(∑ p ∈ S, g p) - ∑ p ∈ T, g p| ≤ 2 / ((1 - β) * A)
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hβ : β < 1 := by norm_num [β]
  have hβgap : 0 < 1 - β := sub_pos.mpr hβ
  have hApos : 0 < A := Real.rpow_pos_of_pos hx0 α
  have hBpos : 0 < B := Real.rpow_pos_of_pos hx0 β
  have hS (p : ℕ) : p ∈ S ↔ (p : ℝ) < B ∧ p.Prime ∧ A ≤ (p : ℝ) := by
    simp only [S, mem_filter, Nat.mem_primesBelow, Nat.lt_ceil, and_assoc]
  have hT (p : ℕ) : p ∈ T ↔ (p : ℝ) ≤ B ∧ p.Prime ∧ A < (p : ℝ) := by
    simp only [T, mem_filter, Nat.mem_primesLE, Nat.le_floor_iff hBpos.le, and_assoc]
  have hleft (p : ℕ) (hp : p ∈ S \ T) : (p : ℝ) = A := by
    rcases mem_sdiff.mp hp with ⟨hpS, hpT⟩
    obtain ⟨hpB, hpprime, hpA⟩ := (hS p).mp hpS
    have hnot : ¬A < (p : ℝ) := by
      intro hlt
      exact hpT ((hT p).mpr ⟨hpB.le, hpprime, hlt⟩)
    exact le_antisymm (le_of_not_gt hnot) hpA
  have hright (p : ℕ) (hp : p ∈ T \ S) : (p : ℝ) = B := by
    rcases mem_sdiff.mp hp with ⟨hpT, hpS⟩
    obtain ⟨hpB, hpprime, hpA⟩ := (hT p).mp hpT
    have hnot : ¬(p : ℝ) < B := by
      intro hlt
      exact hpS ((hS p).mpr ⟨hlt, hpprime, hpA.le⟩)
    exact le_antisymm hpB (le_of_not_gt hnot)
  have hleftCard : (S \ T).card ≤ 1 := by
    apply card_le_one.mpr
    intro p hp q hq
    exact_mod_cast (hleft p hp).trans (hleft q hq).symm
  have hrightCard : (T \ S).card ≤ 1 := by
    apply card_le_one.mpr
    intro p hp q hq
    exact_mod_cast (hright p hp).trans (hright q hq).symm
  have hpoint (p : ℕ) (hpA : A ≤ (p : ℝ)) (hpB : (p : ℝ) ≤ B) :
      0 ≤ g p ∧ g p ≤ (1 - β)⁻¹ / A := by
    have hp0 : 0 < (p : ℝ) := hApos.trans_le hpA
    have halpha : Real.logb x (p : ℝ) ≤ β :=
      (Real.logb_le_iff_le_rpow hx hp0).2 hpB
    have hden : 0 < 1 - Real.logb x (p : ℝ) := sub_pos.mpr (halpha.trans_lt hβ)
    refine ⟨(inv_pos.mpr (mul_pos hp0 hden)).le, ?_⟩
    calc
      g p ≤ ((1 - β) * A)⁻¹ := by
        apply inv_anti₀ (mul_pos hβgap hApos)
        rw [mul_comm (1 - β) A]
        exact mul_le_mul hpA (sub_le_sub_left halpha 1) hβgap.le hp0.le
      _ = (1 - β)⁻¹ / A := by rw [mul_inv, div_eq_mul_inv]
  have hsum (s : Finset ℕ) (hc : s.card ≤ 1)
      (hs : ∀ p ∈ s, A ≤ (p : ℝ) ∧ (p : ℝ) ≤ B) :
      0 ≤ ∑ p ∈ s, g p ∧ (∑ p ∈ s, g p) ≤ (1 - β)⁻¹ / A := by
    refine ⟨sum_nonneg (fun p hp => (hpoint p (hs p hp).1 (hs p hp).2).1), ?_⟩
    have hcap : 0 ≤ (1 - β)⁻¹ / A := by positivity
    exact (Finset.sum_le_card_nsmul s g _
      (fun p hp => (hpoint p (hs p hp).1 (hs p hp).2).2)).trans
        (by simpa only [one_nsmul] using nsmul_le_nsmul_left hcap hc)
  have hleftSum := hsum (S \ T) hleftCard (fun p hp => by
    have h := (hS p).mp (mem_sdiff.mp hp).1
    exact ⟨h.2.2, h.1.le⟩)
  have hrightSum := hsum (T \ S) hrightCard (fun p hp => by
    have h := (hT p).mp (mem_sdiff.mp hp).1
    exact ⟨h.2.2.le, h.1⟩)
  rw [← sum_sdiff_sub_sum_sdiff]
  calc
    |(∑ p ∈ S \ T, g p) - ∑ p ∈ T \ S, g p| ≤
        |∑ p ∈ S \ T, g p| + |∑ p ∈ T \ S, g p| := abs_sub _ _
    _ = (∑ p ∈ S \ T, g p) + ∑ p ∈ T \ S, g p := by
      rw [abs_of_nonneg hleftSum.1, abs_of_nonneg hrightSum.1]
    _ ≤ (1 - β)⁻¹ / A + (1 - β)⁻¹ / A := add_le_add hleftSum.2 hrightSum.2
    _ = 2 / ((1 - β) * A) := by simp only [div_eq_mul_inv, mul_inv]; ring

theorem semiprime_weighted_prime_kernel_tendsto :
    Tendsto
      (fun x : ℝ =>
        ∑ p ∈ (Nat.primesBelow (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
          (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ)),
          ((p : ℝ) * (1 - Real.logb x (p : ℝ)))⁻¹)
      atTop (nhds (∫ t in ((9519 : ℝ) / 50000)..((40481 : ℝ) / 100000),
        (t * (1 - t))⁻¹)) := by
  let I : ℝ := ∫ t in ((9519 : ℝ) / 50000)..((40481 : ℝ) / 100000),
    (t * (1 - t))⁻¹
  let S : ℝ → ℝ := fun x =>
    ∑ p ∈ (Nat.primesBelow (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
      (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ)),
      ((p : ℝ) * (1 - Real.logb x (p : ℝ)))⁻¹
  let O : ℝ → ℝ := fun x =>
    ∑ p ∈ (Nat.primesLE (Nat.floor (x ^ ((40481 : ℝ) / 100000)))).filter
      (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) < (p : ℝ)),
      ((p : ℝ) * (1 - Real.logb x (p : ℝ)))⁻¹
  obtain ⟨C, _, hbound⟩ := prime_band_semiprime_kernel_error
    ((9519 : ℝ) / 50000) ((40481 : ℝ) / 100000)
    (by norm_num) (by norm_num) (by norm_num)
  have hA := tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 9519 / 50000)
  have herror : Tendsto (fun x : ℝ => O x - I) atTop (nhds 0) := by
    rw [tendsto_zero_iff_abs_tendsto_zero]
    apply squeeze_zero' (g := fun x : ℝ => C / Real.log x)
      (Eventually.of_forall (fun _ => abs_nonneg _))
    · filter_upwards [eventually_gt_atTop (1 : ℝ), hA.eventually_ge_atTop 2] with x hx hAx
      have h := hbound x hx hAx
      rw [integral_semiprime_logarithmic_kernel_substitution x hx] at h
      simpa only [O, I, Real.logb, mul_inv, div_eq_mul_inv, mul_comm] using h
    · exact tendsto_log_atTop.const_div_atTop C
  have hendpoint : Tendsto (fun x : ℝ => S x - O x) atTop (nhds 0) := by
    rw [tendsto_zero_iff_abs_tendsto_zero]
    apply squeeze_zero' (Eventually.of_forall (fun _ => abs_nonneg _))
    · filter_upwards [eventually_gt_atTop (1 : ℝ)] with x hx
      exact semiprime_named_band_endpoint_error x hx
    · simpa only [div_div] using
        hA.const_div_atTop (2 / (1 - (40481 : ℝ) / 100000))
  simpa only [S, sub_add_cancel, zero_add] using
    hendpoint.add (tendsto_sub_nhds_zero_iff.1 herror)

end PrimeGap186

section
open Set

theorem PrimeGap186.ae_restrict_Ioc_fragmentLaw (ζ : ℝ) :
    ∀ᵐ c ∂PrimeGap186.fragmentLaw ζ,
      c.restrict (Set.Ioc (0 : ℝ) ζ) = c := by
  have hm : Measurable (fun c : FiniteMeasure ℝ =>
      (c : Measure ℝ) (Set.Ioc (0 : ℝ) ζ)ᶜ) :=
    (Measure.measurable_coe measurableSet_Ioc.compl).comp measurable_subtype_coe
  have hz : (∫⁻ c, (c : Measure ℝ) (Set.Ioc (0 : ℝ) ζ)ᶜ
      ∂PrimeGap186.fragmentLaw ζ) = 0 := by
    have h := PrimeGap186.lintegral_fragmentLaw ζ
      ((Set.Ioc (0 : ℝ) ζ)ᶜ.indicator (fun _ => 1))
      (measurable_const.indicator measurableSet_Ioc.compl)
    simpa only [lintegral_indicator_fun_one measurableSet_Ioc.compl,
      Measure.restrict_apply measurableSet_Ioc.compl, Set.compl_inter_self,
      measure_empty] using h
  filter_upwards [(lintegral_eq_zero_iff hm).1 hz] with c hc
  apply FiniteMeasure.toMeasure_injective
  exact Measure.restrict_eq_self_of_ae_mem (ae_iff.2 hc)

end

namespace PrimeGap186

open Set
open Classical in
theorem fragment_divisor_configuration_mass (W : ℕ) (x κ : ℝ) (hx : 1 < x)
    (hκ : 0 < κ) (s : ℕ)
    (hs : s ∈ (∏ p ∈ fragmentPrimes W x κ, p).divisors) :
    (((primeLogConfiguration x s).restrict (Set.Ioc (0 : ℝ) κ)).mass : ℝ) =
      Real.log s / Real.log x := by
  have hd := (mem_fragment_divisors_iff W x κ
    (Real.one_le_rpow hx.le hκ.le) s).mp hs
  rw [seed_configuration_identity x s κ hx]
  have hfilter : s.primeFactors.filter (fun p : ℕ => (p : ℝ) ≤ x ^ κ) =
      s.primeFactors := by
    apply Finset.filter_eq_self.mpr
    intro p hp
    calc
      (p : ℝ) ≤ ((s.primeFactors.sup id : ℕ) : ℝ) := by
        exact_mod_cast Finset.le_sup (f := id) hp
      _ ≤ ((max 1 (s.primeFactors.sup id) : ℕ) : ℝ) :=
        Nat.cast_le.mpr (le_max_right _ _)
      _ ≤ x ^ κ := hd.2.2
  rw [hfilter, ← Finset.sum_div]
  congr 1
  rw [← Real.log_prod (fun p hp => by
    exact_mod_cast (Nat.prime_of_mem_primeFactors hp).ne_zero), ← Nat.cast_prod,
    Nat.prod_primeFactors_of_squarefree hd.1]

end PrimeGap186

section
open Set

end

namespace PrimeGap186

theorem lintegral_exp_neg_fragmentLaw_restrict_cap
    (κ c : ℝ) (hc : 0 < c) (hcκ : c ≤ κ)
    (h : ℝ → ℝ≥0∞) (hh : Measurable h) :
    (∫⁻ μ, EReal.exp (-((∫⁻ u, h u ∂(μ : Measure ℝ)) : EReal))
      ∂((fragmentLaw κ).restrict
        {μ : FiniteMeasure ℝ | (μ : Measure ℝ) (Set.Ioi c) = 0})) =
      ENNReal.ofReal (c / κ) *
        ∫⁻ μ, EReal.exp (-((∫⁻ u, h u ∂(μ : Measure ℝ)) : EReal))
          ∂fragmentLaw c := by
  classical
  have hκ : 0 < κ := hc.trans_le hcκ
  let C : Set (FiniteMeasure ℝ) :=
    {μ : FiniteMeasure ℝ | (μ : Measure ℝ) (Set.Ioi c) = 0}
  let F : FiniteMeasure ℝ → ℝ≥0∞ := fun μ =>
    EReal.exp (-((∫⁻ u, h u ∂(μ : Measure ℝ)) : EReal))
  let H : ℝ → ℝ≥0∞ := fun u =>
    h u + (Set.Ioi c).indicator (fun _ => ∞) u
  let J : ℝ → (ℝ → ℝ≥0∞) → ℝ≥0∞ := fun z f =>
    ∫⁻ u, 1 - EReal.exp (-((ENNReal.ofReal u * f u : ℝ≥0∞) : EReal))
      ∂((volume.restrict (Set.Ioc (0 : ℝ) z)).withDensity
        (fun u : ℝ => ENNReal.ofReal (1 / u)))
  have hC : MeasurableSet C :=
    measurableSet_eq_fun
      ((Measure.measurable_coe measurableSet_Ioi).comp measurable_subtype_coe)
      measurable_const
  have hH : Measurable H :=
    hh.add (measurable_const.indicator measurableSet_Ioi)
  have hkill (μ : FiniteMeasure ℝ) :
      EReal.exp (-((∫⁻ u, H u ∂(μ : Measure ℝ)) : EReal)) = C.indicator F μ := by
    dsimp only [H]
    rw [lintegral_add_left hh, lintegral_indicator_const measurableSet_Ioi]
    by_cases hμ : (μ : Measure ℝ) (Set.Ioi c) = 0
    · simp [hμ, C, F]
    · simp [ENNReal.top_mul hμ, hμ, C]
  have hreciprocal :
      (∫⁻ u in Set.Ioc c κ, ENNReal.ofReal (1 / u)) =
        ENNReal.ofReal (Real.log (κ / c)) := by
    have hi : IntervalIntegrable (fun u : ℝ => 1 / u) volume c κ := by
      simpa only [one_div] using
        (intervalIntegrable_inv_iff.mpr (Or.inr (Set.notMem_uIcc_of_lt hc hκ)))
    have hn : 0 ≤ᵐ[volume.restrict (Set.Ioc c κ)] fun u : ℝ => 1 / u := by
      filter_upwards [ae_restrict_mem measurableSet_Ioc] with u hu
      exact (one_div_pos.mpr (hc.trans hu.1)).le
    rw [← ofReal_integral_eq_lintegral_ofReal hi.1 hn,
      ← intervalIntegral.integral_of_le hcκ,
      _root_.integral_one_div_of_pos hc hκ]
  have hw : Measurable (fun u : ℝ => ENNReal.ofReal (1 / u)) := by fun_prop
  have hsplit : J κ H = J c h + ENNReal.ofReal (Real.log (κ / c)) := by
    dsimp only [J]
    rw [lintegral_withDensity_eq_lintegral_mul_non_measurable _ hw
        (ae_of_all _ fun _ => ENNReal.ofReal_lt_top) _,
      lintegral_withDensity_eq_lintegral_mul_non_measurable _ hw
        (ae_of_all _ fun _ => ENNReal.ofReal_lt_top) _,
      ← Set.Ioc_union_Ioc_eq_Ioc hc.le hcκ,
      Measure.restrict_union (Set.Ioc_disjoint_Ioc_of_le le_rfl) measurableSet_Ioc,
      lintegral_add_measure]
    congr 1
    · apply lintegral_congr_ae
      filter_upwards [ae_restrict_mem measurableSet_Ioc] with u hu
      have hnot : u ∉ Set.Ioi c := not_lt.mpr hu.2
      simp [H, hnot]
    · calc
        _ = ∫⁻ u in Set.Ioc c κ, ENNReal.ofReal (1 / u) := by
          apply lintegral_congr_ae
          filter_upwards [ae_restrict_mem measurableSet_Ioc] with u hu
          have hHu : ENNReal.ofReal u * H u = ∞ := by
            rw [show H u = ∞ by simp [H, hu.1]]
            exact ENNReal.mul_top (ne_of_gt (ENNReal.ofReal_pos.mpr (hc.trans hu.1)))
          change ENNReal.ofReal (1 / u) *
            (1 - EReal.exp (-((ENNReal.ofReal u * H u : ℝ≥0∞) : EReal))) = _
          rw [hHu]
          simp
        _ = _ := hreciprocal
  have hlog : 0 ≤ Real.log (κ / c) :=
    Real.log_nonneg ((le_div_iff₀ hc).mpr (by simpa using hcκ))
  have hfactor :
      EReal.exp (-((ENNReal.ofReal (Real.log (κ / c))) : EReal)) =
        ENNReal.ofReal (c / κ) := by
    rw [← EReal.coe_ennreal_toReal ENNReal.ofReal_ne_top,
      ENNReal.toReal_ofReal hlog, ← EReal.coe_neg, EReal.exp_coe,
      Real.exp_neg, Real.exp_log (div_pos hκ hc), inv_div]
  change (∫⁻ μ, F μ ∂(fragmentLaw κ).restrict C) =
    ENNReal.ofReal (c / κ) * ∫⁻ μ, F μ ∂fragmentLaw c
  calc
    _ = ∫⁻ μ, EReal.exp (-((∫⁻ u, H u ∂(μ : Measure ℝ)) : EReal))
        ∂fragmentLaw κ := by
      rw [← lintegral_indicator hC]
      exact lintegral_congr fun μ => (hkill μ).symm
    _ = EReal.exp (-(J κ H : EReal)) := lintegral_exp_neg_fragmentLaw κ H hH
    _ = EReal.exp (-(J c h : EReal)) * ENNReal.ofReal (c / κ) := by
      rw [hsplit, EReal.coe_ennreal_add,
        EReal.neg_add (.inl (EReal.coe_ennreal_ne_bot _))
          (.inr (EReal.coe_ennreal_ne_bot _)),
        sub_eq_add_neg, EReal.exp_add, hfactor]
    _ = ENNReal.ofReal (c / κ) * ∫⁻ μ, F μ ∂fragmentLaw c := by
      rw [mul_comm]
      congr 1
      exact (lintegral_exp_neg_fragmentLaw c h hh).symm

theorem map_mass_fragmentLaw_restrict_cap
    (κ c : ℝ) (hc : 0 < c) (hcκ : c ≤ κ) :
    Measure.map (fun μ : FiniteMeasure ℝ => (μ.mass : ℝ))
        (((ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ)) •
          fragmentLaw κ).restrict
            {μ : FiniteMeasure ℝ | (μ : Measure ℝ) (Set.Ioi c) = 0}) =
      (ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * c)) •
        Measure.map (fun μ : FiniteMeasure ℝ => (μ.mass : ℝ)) (fragmentLaw c) := by
  have hκ : 0 < κ := hc.trans_le hcκ
  let P : Measure (FiniteMeasure ℝ) :=
    (fragmentLaw κ).restrict
      {μ : FiniteMeasure ℝ | (μ : Measure ℝ) (Set.Ioi c) = 0}
  let a : ℝ≥0∞ := ENNReal.ofReal (c / κ)
  have ha0 : a ≠ 0 := ne_of_gt (ENNReal.ofReal_pos.mpr (div_pos hc hκ))
  have hatop : a ≠ ∞ := ENNReal.ofReal_ne_top
  let : IsProbabilityMeasure (fragmentLaw c) := fragmentLaw_isProbabilityMeasure c
  have hPmass : P Set.univ = a := by
    simpa [P, a] using
      lintegral_exp_neg_fragmentLaw_restrict_cap κ c hc hcκ
        (fun _ => 0) measurable_const
  let N : Measure (FiniteMeasure ℝ) := a⁻¹ • P
  let : IsProbabilityMeasure N := ⟨by
    change (a⁻¹ • P) Set.univ = 1
    rw [Measure.smul_apply, smul_eq_mul, hPmass,
      ENNReal.inv_mul_cancel ha0 hatop]⟩
  have hm : Measurable (fun μ : FiniteMeasure ℝ => (μ.mass : ℝ)) := by
    have h : Measurable (fun μ : FiniteMeasure ℝ => (μ : Measure ℝ) Set.univ) :=
      (Measure.measurable_coe MeasurableSet.univ).comp measurable_subtype_coe
    simpa only [← FiniteMeasure.ennreal_mass, ENNReal.coe_toReal] using h.ennreal_toReal
  let μ : Measure ℝ := Measure.map (fun ξ : FiniteMeasure ℝ => (ξ.mass : ℝ)) N
  let ν : Measure ℝ :=
    Measure.map (fun ξ : FiniteMeasure ℝ => (ξ.mass : ℝ)) (fragmentLaw c)
  let : IsProbabilityMeasure μ := inferInstance
  let : IsProbabilityMeasure ν := inferInstance
  have hμ : ∀ᵐ x ∂μ, 0 ≤ x :=
    (ae_map_iff hm.aemeasurable measurableSet_Ici).2
      (ae_of_all _ fun ξ => ξ.mass.coe_nonneg)
  have hν : ∀ᵐ x ∂ν, 0 ≤ x :=
    (ae_map_iff hm.aemeasurable measurableSet_Ici).2
      (ae_of_all _ fun ξ => ξ.mass.coe_nonneg)
  have heq : μ = ν := by
    apply nonnegative_laplace_measure_ext μ ν hμ hν
    intro s hs
    have hE (ξ : FiniteMeasure ℝ) :
        EReal.exp (-((∫⁻ u, ENNReal.ofReal s ∂(ξ : Measure ℝ)) : EReal)) =
          ENNReal.ofReal (Real.exp (-s * (ξ.mass : ℝ))) := by
      rw [lintegral_const, ← FiniteMeasure.ennreal_mass,
        ← ENNReal.ofReal_coe_nnreal (p := ξ.mass), ← ENNReal.ofReal_mul hs,
        ← EReal.coe_ennreal_toReal ENNReal.ofReal_ne_top,
        ENNReal.toReal_ofReal (mul_nonneg hs ξ.mass.coe_nonneg),
        ← EReal.coe_neg, EReal.exp_coe, neg_mul]
    have hL :
        (∫⁻ ξ, ENNReal.ofReal (Real.exp (-s * (ξ.mass : ℝ))) ∂P) =
          a * ∫⁻ ξ, ENNReal.ofReal (Real.exp (-s * (ξ.mass : ℝ))) ∂fragmentLaw c := by
      simpa only [hE] using lintegral_exp_neg_fragmentLaw_restrict_cap κ c hc hcκ
        (fun _ => ENNReal.ofReal s) measurable_const
    have hf : Measurable (fun ξ : FiniteMeasure ℝ => Real.exp (-s * (ξ.mass : ℝ))) :=
      (hm.const_mul (-s)).exp
    change (∫ x, Real.exp (-s * x) ∂Measure.map
        (fun ξ : FiniteMeasure ℝ => (ξ.mass : ℝ)) N) =
      ∫ x, Real.exp (-s * x) ∂Measure.map
        (fun ξ : FiniteMeasure ℝ => (ξ.mass : ℝ)) (fragmentLaw c)
    rw [integral_map_of_stronglyMeasurable hm (by fun_prop),
      integral_map_of_stronglyMeasurable hm (by fun_prop),
      integral_eq_lintegral_of_nonneg_ae
        (ae_of_all _ fun _ => (Real.exp_pos _).le) hf.aestronglyMeasurable,
      integral_eq_lintegral_of_nonneg_ae
        (ae_of_all _ fun _ => (Real.exp_pos _).le) hf.aestronglyMeasurable]
    congr 1
    dsimp only [N]
    rw [lintegral_smul_measure, smul_eq_mul, hL,
      ENNReal.inv_mul_cancel_left ha0 hatop]
  have hscaled :
      Measure.map (fun ξ : FiniteMeasure ℝ => (ξ.mass : ℝ)) P =
        a • Measure.map (fun ξ : FiniteMeasure ℝ => (ξ.mass : ℝ)) (fragmentLaw c) := by
    have h := congrArg (fun η : Measure ℝ => a • η) heq
    change a • Measure.map (fun ξ : FiniteMeasure ℝ => (ξ.mass : ℝ)) (a⁻¹ • P) =
      a • Measure.map (fun ξ : FiniteMeasure ℝ => (ξ.mass : ℝ)) (fragmentLaw c) at h
    simpa only [Measure.map_smul _ hm.aemeasurable, smul_smul,
      ENNReal.mul_inv_cancel ha0 hatop, one_smul] using h
  have hcoefficient :
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) * a =
        ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * c) := by
    dsimp only [a]
    rw [← ENNReal.ofReal_mul
      (mul_nonneg (Real.exp_pos Real.eulerMascheroniConstant).le hκ.le)]
    congr 1
    field_simp [hκ.ne']
  rw [Measure.restrict_smul, Measure.map_smul _ hm.aemeasurable]
  change ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
      Measure.map (fun ξ : FiniteMeasure ℝ => (ξ.mass : ℝ)) P = _
  rw [hscaled, smul_smul, hcoefficient]

section
open Real Finset Topology

theorem exists_real_reciprocal_prefix :
    ∃ D M : ℝ, 0 < D ∧
      ∀ y : ℝ, 2 ≤ y →
        |(∑ p ∈ Nat.primesLE (Nat.floor y), (p : ℝ)⁻¹) - Real.log (Real.log y) - M| ≤
          D / Real.log y := by
  obtain ⟨D, hD, hbound⟩ := prime_second_error_bounded
  exact ⟨D, primeMertensConstant, hD, hbound⟩

end

theorem exists_primeFactors_power_bound {a ε : ℝ}
    (ha : 1 ≤ a) (hε : 0 < ε) :
    ∃ C : ℝ, 0 < C ∧ ∀ n : ℕ, n ≠ 0 →
      a ^ n.primeFactors.card ≤ C * (n : ℝ) ^ ε := by
  classical
  obtain ⟨B, hB⟩ := exists_nat_gt (a ^ ε⁻¹)
  have ha0 : 0 ≤ a := le_trans zero_le_one ha
  have hlarge : ∀ p : ℕ, B ≤ p → a ≤ (p : ℝ) ^ ε := by
    intro p hp
    apply (Real.rpow_inv_le_iff_of_pos ha0 (Nat.cast_nonneg p) hε).mp
    exact hB.le.trans (by exact_mod_cast hp)
  refine ⟨a ^ B, pow_pos (lt_of_lt_of_le zero_lt_one ha) _, ?_⟩
  intro n hn
  let small := n.primeFactors.filter (fun p => p < B)
  let large := n.primeFactors.filter (fun p => ¬p < B)
  have hsmall : small.card ≤ B := by
    calc
      small.card ≤ (Finset.range B).card := by
        apply Finset.card_le_card
        intro p hp
        exact Finset.mem_range.mpr (Finset.mem_filter.mp hp).2
      _ = B := Finset.card_range B
  have hcard : small.card + large.card = n.primeFactors.card :=
    Finset.card_filter_add_card_filter_not (s := n.primeFactors) (fun p => p < B)
  have hlargeBound : a ^ large.card ≤ (∏ p ∈ large, (p : ℝ)) ^ ε := by
    rw [← Real.finsetProd_rpow large (fun p : ℕ => (p : ℝ))
      (fun p _ => Nat.cast_nonneg p) ε, ← Finset.prod_const]
    apply Finset.prod_le_prod (fun _ _ => ha0)
    intro p hp
    exact hlarge p (Nat.le_of_not_gt (Finset.mem_filter.mp hp).2)
  have hproduct : (∏ p ∈ large, (p : ℝ)) ≤ (n : ℝ) := by
    rw [← Nat.cast_prod]
    exact_mod_cast Nat.le_of_dvd (Nat.pos_of_ne_zero hn)
      ((Finset.prod_dvd_prod_of_subset large n.primeFactors (fun p : ℕ => p)
        (Finset.filter_subset _ _)).trans (Nat.prod_primeFactors_dvd n))
  calc
    a ^ n.primeFactors.card = a ^ small.card * a ^ large.card := by
      rw [← hcard, pow_add]
    _ ≤ a ^ B * (n : ℝ) ^ ε := by
      apply mul_le_mul (pow_le_pow_right₀ ha hsmall)
        (hlargeBound.trans (Real.rpow_le_rpow
          (Finset.prod_nonneg (fun p _ => Nat.cast_nonneg p)) hproduct hε.le))
      · exact pow_nonneg ha0 _
      · exact pow_nonneg ha0 _

section
open Real Finset

theorem abs_sum_div_le_of_card_le_one (s : Finset ℕ) (A K : ℝ)
    (f : ℕ → ℝ) (hA : 0 < A) (hK : 0 ≤ K) (hc : s.card ≤ 1)
    (hf : ∀ p ∈ s, A ≤ (p : ℝ) ∧ |f p| ≤ K) :
    |∑ p ∈ s, f p / (p : ℝ)| ≤ K / A := by
  have hpoint (p : ℕ) (hp : p ∈ s) : |f p / (p : ℝ)| ≤ K / A := by
    obtain ⟨hpA, hfp⟩ := hf p hp
    rw [abs_div, abs_of_pos (hA.trans_le hpA)]
    exact div_le_div₀ hK hfp hA hpA
  exact (Finset.abs_sum_le_sum_abs _ _).trans
    ((Finset.sum_le_card_nsmul s (fun p => |f p / (p : ℝ)|) _ hpoint).trans
      (by simpa only [one_nsmul] using nsmul_le_nsmul_left (div_nonneg hK hA.le) hc))

theorem prime_band_closed_lower_endpoint_error (A B K : ℝ) (f : ℕ → ℝ)
    (hA : 0 < A) (hAB : A ≤ B) (hK : 0 ≤ K)
    (hf : ∀ p : ℕ, p.Prime → A ≤ (p : ℝ) → (p : ℝ) ≤ B → |f p| ≤ K) :
    |(∑ p ∈ (Nat.primesLE (Nat.floor B)).filter (fun p : ℕ => A ≤ (p : ℝ)),
        f p / (p : ℝ)) -
      ∑ p ∈ (Nat.primesLE (Nat.floor B)).filter (fun p : ℕ => A < (p : ℝ)),
        f p / (p : ℝ)| ≤ K / A := by
  classical
  let S := (Nat.primesLE (Nat.floor B)).filter (fun p : ℕ => A ≤ (p : ℝ))
  let T := (Nat.primesLE (Nat.floor B)).filter (fun p : ℕ => A < (p : ℝ))
  have hS (p : ℕ) : p ∈ S ↔ (p : ℝ) ≤ B ∧ p.Prime ∧ A ≤ (p : ℝ) := by
    simp only [S, mem_filter, Nat.mem_primesLE, Nat.le_floor_iff (hA.le.trans hAB),
      and_assoc]
  have hT (p : ℕ) : p ∈ T ↔ (p : ℝ) ≤ B ∧ p.Prime ∧ A < (p : ℝ) := by
    simp only [T, mem_filter, Nat.mem_primesLE, Nat.le_floor_iff (hA.le.trans hAB),
      and_assoc]
  have hsub : T ⊆ S := Finset.monotone_filter_right _ (fun _ _ h => h.le)
  have heq (p : ℕ) (hp : p ∈ S \ T) : (p : ℝ) = A := by
    obtain ⟨hpS, hpT⟩ := mem_sdiff.mp hp
    obtain ⟨hpB, hp, hpA⟩ := (hS p).mp hpS
    exact le_antisymm (le_of_not_gt fun h => hpT ((hT p).mpr ⟨hpB, hp, h⟩)) hpA
  have hc : (S \ T).card ≤ 1 := by
    apply card_le_one.mpr
    intro p hp q hq
    exact_mod_cast (heq p hp).trans (heq q hq).symm
  change |(∑ p ∈ S, f p / (p : ℝ)) - ∑ p ∈ T, f p / (p : ℝ)| ≤ K / A
  rw [← sum_sdiff_eq_sub hsub]
  apply abs_sum_div_le_of_card_le_one _ A K f hA hK hc
  intro p hp
  obtain ⟨hpB, hprime, hpA⟩ := (hS p).mp (mem_sdiff.mp hp).1
  exact ⟨hpA, hf p hprime hpA hpB⟩

theorem prime_band_half_open_endpoint_error (A B K : ℝ) (f : ℕ → ℝ)
    (hA : 0 < A) (hAB : A ≤ B) (hK : 0 ≤ K)
    (hf : ∀ p : ℕ, p.Prime → A ≤ (p : ℝ) → (p : ℝ) ≤ B → |f p| ≤ K) :
    |(∑ p ∈ (Nat.primesBelow (Nat.ceil B)).filter (fun p : ℕ => A ≤ (p : ℝ)),
        f p / (p : ℝ)) -
      ∑ p ∈ (Nat.primesLE (Nat.floor B)).filter (fun p : ℕ => A < (p : ℝ)),
        f p / (p : ℝ)| ≤ 2 * K / A := by
  classical
  let S := (Nat.primesBelow (Nat.ceil B)).filter (fun p : ℕ => A ≤ (p : ℝ))
  let T := (Nat.primesLE (Nat.floor B)).filter (fun p : ℕ => A < (p : ℝ))
  have hS (p : ℕ) : p ∈ S ↔ (p : ℝ) < B ∧ p.Prime ∧ A ≤ (p : ℝ) := by
    simp only [S, mem_filter, Nat.mem_primesBelow, Nat.lt_ceil, and_assoc]
  have hT (p : ℕ) : p ∈ T ↔ (p : ℝ) ≤ B ∧ p.Prime ∧ A < (p : ℝ) := by
    simp only [T, mem_filter, Nat.mem_primesLE, Nat.le_floor_iff (hA.le.trans hAB),
      and_assoc]
  have hleft (p : ℕ) (hp : p ∈ S \ T) : (p : ℝ) = A := by
    obtain ⟨hpS, hpT⟩ := mem_sdiff.mp hp
    obtain ⟨hpB, hp, hpA⟩ := (hS p).mp hpS
    exact le_antisymm (le_of_not_gt fun h => hpT ((hT p).mpr ⟨hpB.le, hp, h⟩)) hpA
  have hright (p : ℕ) (hp : p ∈ T \ S) : (p : ℝ) = B := by
    obtain ⟨hpT, hpS⟩ := mem_sdiff.mp hp
    obtain ⟨hpB, hp, hpA⟩ := (hT p).mp hpT
    exact le_antisymm hpB (le_of_not_gt fun h => hpS ((hS p).mpr ⟨h, hp, hpA.le⟩))
  have hleftCard : (S \ T).card ≤ 1 := by
    apply card_le_one.mpr
    intro p hp q hq
    exact_mod_cast (hleft p hp).trans (hleft q hq).symm
  have hrightCard : (T \ S).card ≤ 1 := by
    apply card_le_one.mpr
    intro p hp q hq
    exact_mod_cast (hright p hp).trans (hright q hq).symm
  have hl := abs_sum_div_le_of_card_le_one (S \ T) A K f hA hK hleftCard
    (fun p hp => by
      obtain ⟨hpB, hprime, hpA⟩ := (hS p).mp (mem_sdiff.mp hp).1
      exact ⟨hpA, hf p hprime hpA hpB.le⟩)
  have hr := abs_sum_div_le_of_card_le_one (T \ S) A K f hA hK hrightCard
    (fun p hp => by
      obtain ⟨hpB, hprime, hpA⟩ := (hT p).mp (mem_sdiff.mp hp).1
      exact ⟨hpA.le, hf p hprime hpA.le hpB⟩)
  change |(∑ p ∈ S, f p / (p : ℝ)) - ∑ p ∈ T, f p / (p : ℝ)| ≤ 2 * K / A
  rw [← sum_sdiff_sub_sum_sdiff]
  calc
    _ ≤ |∑ p ∈ S \ T, f p / (p : ℝ)| + |∑ p ∈ T \ S, f p / (p : ℝ)| :=
      abs_sub _ _
    _ ≤ K / A + K / A := add_le_add hl hr
    _ = 2 * K / A := by ring

theorem prime_band_logarithmic_weight_error
    (α γ : ℝ) (hα : 0 < α) :
    ∃ C : ℝ, 0 < C ∧
      ∀ (f fp : ℝ → ℝ) (M0 M1 : ℝ), 0 ≤ M0 → 0 ≤ M1 →
        (∀ t ∈ Set.Icc α γ, HasDerivAt f (fp t) t) →
        ContinuousOn fp (Set.Icc α γ) →
        (∀ t ∈ Set.Icc α γ, |f t| ≤ M0) →
        (∀ t ∈ Set.Icc α γ, |fp t| ≤ M1) →
        ∀ x : ℝ, 1 < x → 2 ≤ x ^ α →
          ∀ β : ℝ, α ≤ β → β ≤ γ →
            |(∑ p ∈ (Nat.primesLE ⌊x ^ β⌋₊).filter
                (fun p : ℕ => x ^ α < (p : ℝ)),
                f (Real.logb x (p : ℝ)) / (p : ℝ)) -
              ∫ t in α..β, f t / t| ≤
              (2 * M0 * C / α + M1 * C * Real.log (γ / α)) / Real.log x := by
  obtain ⟨C, hC, herror⟩ := prime_second_error_bounded
  refine ⟨C, hC, fun f fp M0 M1 hM0 hM1 hf hfp hfbound hfpbound x hx hA β hαβ hβγ => ?_⟩
  let A : ℝ := x ^ α
  let B : ℝ := x ^ β
  let u : ℝ → ℝ := fun y => Real.log y / Real.log x
  let up : ℝ → ℝ := fun y => y⁻¹ / Real.log x
  let F : ℝ → ℝ := fun y => f (u y)
  let Fp : ℝ → ℝ := fun y => fp (u y) * up y
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hL : 0 < Real.log x := Real.log_pos hx
  have hβ0 : 0 < β := hα.trans_le hαβ
  have hAB : A ≤ B := Real.rpow_le_rpow_of_exponent_le hx.le hαβ
  have ht1 {y : ℝ} (hy : y ∈ Set.Icc A B) : 1 < y :=
    one_lt_two.trans_le (hA.trans hy.1)
  have huI {y : ℝ} (hy : y ∈ Set.Icc A B) : u y ∈ Set.Icc α γ := by
    have hy0 : 0 < y := zero_lt_one.trans (ht1 hy)
    exact ⟨(Real.le_logb_iff_rpow_le hx hy0).2 hy.1,
      ((Real.logb_le_iff_le_rpow hx hy0).2 hy.2).trans hβγ⟩
  have hlogc : ContinuousOn Real.log (Set.Icc A B) :=
    continuousOn_id.log (fun _ hy => (zero_lt_one.trans (ht1 hy)).ne')
  have hup : ContinuousOn up (Set.Icc A B) :=
    (continuousOn_id.inv₀ (fun _ hy => (zero_lt_one.trans (ht1 hy)).ne')).div_const _
  have hu : ContinuousOn u (Set.Icc A B) := hlogc.div_const _
  have huDeriv {y : ℝ} (hy : y ∈ Set.Icc A B) : HasDerivAt u (up y) y :=
    (Real.hasDerivAt_log (zero_lt_one.trans (ht1 hy)).ne').div_const _
  have hF : ∀ y ∈ Set.Icc A B, HasDerivAt F (Fp y) y := by
    intro y hy
    exact (hf (u y) (huI hy)).comp y (huDeriv hy)
  have hFp : ContinuousOn Fp (Set.Icc A B) :=
    (hfp.comp hu (fun _ hy => huI hy)).mul hup
  have he {y : ℝ} (hy : y ∈ Set.Icc A B) :
      |primeSecondError y| ≤ C / (α * Real.log x) := by
    apply (herror y (hA.trans hy.1)).trans
    apply div_le_div_of_nonneg_left hC.le (mul_pos hα hL)
    have hl := Real.log_le_log (Real.rpow_pos_of_pos hx0 α) hy.1
    simpa only [A, Real.log_rpow hx0] using hl
  have hkernel : ContinuousOn (fun y : ℝ => y⁻¹ / Real.log y) (Set.Icc A B) :=
    (continuousOn_id.inv₀ (fun _ hy => (zero_lt_one.trans (ht1 hy)).ne')).div
      hlogc (fun _ hy => (Real.log_pos (ht1 hy)).ne')
  have hkerIntegral :
      (∫ y in A..B, y⁻¹ / Real.log y) = Real.log (β / α) := by
    rw [integral_inv_div_log (ht1 ⟨le_rfl, hAB⟩) (ht1 ⟨hAB, le_rfl⟩)]
    dsimp only [A, B]
    rw [Real.log_rpow hx0, Real.log_rpow hx0,
      Real.log_mul hβ0.ne' hL.ne', Real.log_mul hα.ne' hL.ne',
      Real.log_div hβ0.ne' hα.ne']
    ring
  have hint :
      |∫ y in A..B, Fp y * primeSecondError y| ≤
        (M1 * C / Real.log x) * Real.log (γ / α) := by
    calc
      _ ≤ ∫ y in A..B, (M1 * C / Real.log x) * (y⁻¹ / Real.log y) := by
        rw [← Real.norm_eq_abs]
        apply intervalIntegral.norm_integral_le_of_norm_le hAB
          (Filter.Eventually.of_forall ?_)
          ((hkernel.intervalIntegrable_of_Icc hAB).const_mul _)
        intro y hy
        have hyI : y ∈ Set.Icc A B := ⟨hy.1.le, hy.2⟩
        have hy0 : 0 < y := zero_lt_one.trans (ht1 hyI)
        have hlogy : 0 < Real.log y := Real.log_pos (ht1 hyI)
        have hup0 : 0 ≤ up y := by dsimp only [up]; positivity
        rw [Real.norm_eq_abs, abs_mul]
        calc
          _ ≤ (M1 * up y) * (C / Real.log y) := by
            apply mul_le_mul _ (herror y (hA.trans hyI.1)) (abs_nonneg _) (by positivity)
            dsimp only [Fp]
            rw [abs_mul, abs_of_nonneg hup0]
            exact mul_le_mul_of_nonneg_right (hfpbound (u y) (huI hyI)) hup0
          _ = _ := by dsimp only [up]; ring
      _ = (M1 * C / Real.log x) * Real.log (β / α) := by
        rw [intervalIntegral.integral_const_mul, hkerIntegral]
      _ ≤ _ := by
        apply mul_le_mul_of_nonneg_left _ (by positivity)
        exact Real.log_le_log (div_pos hβ0 hα)
          (div_le_div_of_nonneg_right hβγ hα.le)
  have hsub :
      (∫ y in A..B, F y / (y * Real.log y)) = ∫ t in α..β, f t / t := by
    have hfc := HasDerivAt.continuousOn hf
    have hg : ContinuousOn (fun t => f t / t) (u '' Set.uIcc A B) := by
      apply (hfc.div continuousOn_id (fun t ht => (hα.trans_le ht.1).ne')).mono
      rintro t ⟨y, hy, rfl⟩
      exact huI (by rwa [Set.uIcc_of_le hAB] at hy)
    have hs := intervalIntegral.integral_comp_mul_deriv'
      (a := A) (b := B) (f := u) (f' := up) (g := fun t => f t / t)
      (fun y hy => huDeriv (by rwa [Set.uIcc_of_le hAB] at hy))
      (by rwa [Set.uIcc_of_le hAB]) hg
    have hua : u A = α := Real.logb_rpow hx0 hx.ne'
    have hub : u B = β := Real.logb_rpow hx0 hx.ne'
    rw [hua, hub] at hs
    rw [← hs]
    apply intervalIntegral.integral_congr
    intro y hy
    have hyI : y ∈ Set.Icc A B := by rwa [Set.uIcc_of_le hAB] at hy
    have hy0 : 0 < y := zero_lt_one.trans (ht1 hyI)
    have hlogy : 0 < Real.log y := Real.log_pos (ht1 hyI)
    dsimp only [F, Function.comp_def, u, up]
    field_simp
  have hid := prime_band_abel_identity A B hA hAB F Fp hF hFp
  change |(∑ p ∈ (Nat.primesLE ⌊B⌋₊).filter (fun p : ℕ => A < (p : ℝ)),
    F p / (p : ℝ)) - ∫ t in α..β, f t / t| ≤ _
  rw [← hsub, hid]
  calc
    _ ≤ |F B * primeSecondError B| + |F A * primeSecondError A| +
        |∫ y in A..B, Fp y * primeSecondError y| :=
      (abs_sub _ _).trans (add_le_add (abs_sub _ _) le_rfl)
    _ ≤ M0 * (C / (α * Real.log x)) + M0 * (C / (α * Real.log x)) +
        (M1 * C / Real.log x) * Real.log (γ / α) := by
      rw [abs_mul, abs_mul]
      exact add_le_add
        (add_le_add
          (mul_le_mul (hfbound (u B) (huI ⟨hAB, le_rfl⟩)) (he ⟨hAB, le_rfl⟩)
            (abs_nonneg _) hM0)
          (mul_le_mul (hfbound (u A) (huI ⟨le_rfl, hAB⟩)) (he ⟨le_rfl, hAB⟩)
            (abs_nonneg _) hM0)) hint
    _ = _ := by ring

theorem three_prime_inner_open_kernel_error :
    ∃ C : ℝ, 0 < C ∧ ∀ x : ℝ, 1 < x →
      2 ≤ x ^ ((9519 : ℝ) / 50000) →
      ∀ t ∈ Set.Icc ((9519 : ℝ) / 50000) ((40481 : ℝ) / 100000),
        |(∑ q ∈ (Nat.primesLE ⌊x ^ ((1 - t) / 2)⌋₊).filter
            (fun q : ℕ => x ^ ((9519 : ℝ) / 50000) < (q : ℝ)),
            ((q : ℝ) * (1 - t - Real.logb x (q : ℝ)))⁻¹) -
          ∫ s in ((9519 : ℝ) / 50000)..((1 - t) / 2),
            (s * (1 - t - s))⁻¹| ≤ C / Real.log x := by
  let α : ℝ := 9519 / 50000
  let γ : ℝ := 40481 / 100000
  have hα : 0 < α := by norm_num [α]
  have hαγ : α ≤ γ := by norm_num [α, γ]
  have hrel : 1 - 2 * γ = α := by norm_num [α, γ]
  have hlog : 0 ≤ Real.log (γ / α) :=
    Real.log_nonneg ((one_le_div hα).2 hαγ)
  obtain ⟨C, hC, hb⟩ := prime_band_logarithmic_weight_error α γ hα
  refine ⟨2 * α⁻¹ * C / α + α⁻¹ ^ 2 * C * Real.log (γ / α),
    by positivity, fun x hx hA t ht => ?_⟩
  change t ∈ Set.Icc α γ at ht
  have hβ : α ≤ (1 - t) / 2 ∧ (1 - t) / 2 ≤ γ := by
    dsimp [α, γ] at ht ⊢
    constructor <;> linarith [ht.1, ht.2]
  let f : ℝ → ℝ := fun s => (1 - t - s)⁻¹
  let fp : ℝ → ℝ := fun s => (1 - t - s)⁻¹ ^ 2
  have hden {s : ℝ} (hs : s ∈ Set.Icc α γ) : α ≤ 1 - t - s := by
    linarith [ht.2, hs.2]
  have hden0 {s : ℝ} (hs : s ∈ Set.Icc α γ) : 0 < 1 - t - s :=
    hα.trans_le (hden hs)
  have hf : ∀ s ∈ Set.Icc α γ, HasDerivAt f (fp s) s := by
    intro s hs
    have hd := ((hasDerivAt_id s).const_sub (1 - t)).inv (hden0 hs).ne'
    convert! hd using 1
    simp [fp, inv_pow]
  have hfc := HasDerivAt.continuousOn hf
  have hfp : ContinuousOn fp (Set.Icc α γ) := hfc.pow 2
  have hfbound : ∀ s ∈ Set.Icc α γ, |f s| ≤ α⁻¹ := by
    intro s hs
    change |(1 - t - s)⁻¹| ≤ α⁻¹
    rw [abs_of_pos (inv_pos.mpr (hden0 hs))]
    exact inv_anti₀ hα (hden hs)
  have hfpbound : ∀ s ∈ Set.Icc α γ, |fp s| ≤ α⁻¹ ^ 2 := by
    intro s hs
    simpa only [fp, f, abs_pow] using
      pow_le_pow_left₀ (abs_nonneg (f s)) (hfbound s hs) 2
  have hb' := hb f fp α⁻¹ (α⁻¹ ^ 2) (by positivity) (by positivity)
    hf hfp hfbound hfpbound x hx hA ((1 - t) / 2) hβ.1 hβ.2
  simpa only [f, α, div_eq_mul_inv, mul_inv, mul_comm] using hb'

theorem prime_band_logarithmic_weight_tendsto
    (α β : ℝ) (hα : 0 < α) (hαβ : α ≤ β) (f fp : ℝ → ℝ)
    (hf : ∀ t ∈ Set.Icc α β, HasDerivAt f (fp t) t)
    (hfp : ContinuousOn fp (Set.Icc α β)) :
    Tendsto
      (fun x : ℝ =>
        ∑ p ∈ (Nat.primesBelow (Nat.ceil (x ^ β))).filter
          (fun p : ℕ => x ^ α ≤ (p : ℝ)),
          f (Real.logb x (p : ℝ)) / (p : ℝ))
      atTop (nhds (∫ t in α..β, f t / t)) := by
  have hfc := HasDerivAt.continuousOn hf
  obtain ⟨M0, hM0b⟩ := isCompact_Icc.exists_bound_of_continuousOn hfc
  obtain ⟨M1, hM1b⟩ := isCompact_Icc.exists_bound_of_continuousOn hfp
  have hM0 : 0 ≤ M0 := (norm_nonneg _).trans (hM0b α ⟨le_rfl, hαβ⟩)
  have hM1 : 0 ≤ M1 := (norm_nonneg _).trans (hM1b α ⟨le_rfl, hαβ⟩)
  have hM0' : ∀ t ∈ Set.Icc α β, |f t| ≤ M0 := by
    simpa only [Real.norm_eq_abs] using hM0b
  have hM1' : ∀ t ∈ Set.Icc α β, |fp t| ≤ M1 := by
    simpa only [Real.norm_eq_abs] using hM1b
  obtain ⟨C, _, hb⟩ := prime_band_logarithmic_weight_error α β hα
  let S : ℝ → ℝ := fun x =>
    ∑ p ∈ (Nat.primesBelow (Nat.ceil (x ^ β))).filter
      (fun p : ℕ => x ^ α ≤ (p : ℝ)), f (Real.logb x (p : ℝ)) / (p : ℝ)
  let O : ℝ → ℝ := fun x =>
    ∑ p ∈ (Nat.primesLE (Nat.floor (x ^ β))).filter
      (fun p : ℕ => x ^ α < (p : ℝ)), f (Real.logb x (p : ℝ)) / (p : ℝ)
  let I : ℝ := ∫ t in α..β, f t / t
  have hA := tendsto_rpow_atTop hα
  have herror : Tendsto (fun x : ℝ => O x - I) atTop (nhds 0) := by
    rw [tendsto_zero_iff_abs_tendsto_zero]
    apply squeeze_zero' (g := fun x : ℝ =>
      (2 * M0 * C / α + M1 * C * Real.log (β / α)) / Real.log x)
      (Eventually.of_forall (fun _ => abs_nonneg _))
    · filter_upwards [eventually_gt_atTop (1 : ℝ), hA.eventually_ge_atTop 2] with x hx hAx
      exact hb f fp M0 M1 hM0 hM1 hf hfp hM0' hM1' x hx hAx β hαβ le_rfl
    · exact tendsto_log_atTop.const_div_atTop _
  have hendpoint : Tendsto (fun x : ℝ => S x - O x) atTop (nhds 0) := by
    rw [tendsto_zero_iff_abs_tendsto_zero]
    apply squeeze_zero' (g := fun x : ℝ => 2 * M0 / x ^ α)
      (Eventually.of_forall (fun _ => abs_nonneg _))
    · filter_upwards [eventually_gt_atTop (1 : ℝ)] with x hx
      have hx0 : 0 < x := zero_lt_one.trans hx
      apply prime_band_half_open_endpoint_error (x ^ α) (x ^ β) M0
        (fun p => f (Real.logb x (p : ℝ))) (Real.rpow_pos_of_pos hx0 α)
        (Real.rpow_le_rpow_of_exponent_le hx.le hαβ) hM0
      intro p hp hpA hpB
      have hp0 : 0 < (p : ℝ) := by exact_mod_cast hp.pos
      exact hM0' _ ⟨(Real.le_logb_iff_rpow_le hx hp0).2 hpA,
        (Real.logb_le_iff_le_rpow hx hp0).2 hpB⟩
    · exact hA.const_div_atTop _
  simpa only [S, sub_add_cancel, zero_add] using
    hendpoint.add (tendsto_sub_nhds_zero_iff.1 herror)

theorem three_prime_inner_closed_kernel_error :
    ∃ C : ℝ, 0 < C ∧ ∀ x : ℝ, 1 < x →
      2 ≤ x ^ ((9519 : ℝ) / 50000) →
      ∀ t ∈ Set.Icc ((9519 : ℝ) / 50000) ((40481 : ℝ) / 100000),
        |(∑ q ∈ (Nat.primesLE ⌊x ^ ((1 - t) / 2)⌋₊).filter
            (fun q : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (q : ℝ)),
            ((q : ℝ) * (1 - t - Real.logb x (q : ℝ)))⁻¹) -
          ∫ s in ((9519 : ℝ) / 50000)..((1 - t) / 2),
            (s * (1 - t - s))⁻¹| ≤
          C / Real.log x + ((9519 : ℝ) / 50000)⁻¹ / x ^ ((9519 : ℝ) / 50000) := by
  obtain ⟨C, hC, hb⟩ := three_prime_inner_open_kernel_error
  refine ⟨C, hC, fun x hx hA t ht => ?_⟩
  let α : ℝ := 9519 / 50000
  let γ : ℝ := 40481 / 100000
  let β : ℝ := (1 - t) / 2
  have hα : 0 < α := by norm_num [α]
  have ht' : t ∈ Set.Icc α γ := ht
  have hβ : α ≤ β ∧ β ≤ γ := by
    dsimp [α, γ, β] at ht' ⊢
    constructor <;> linarith [ht'.1, ht'.2]
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hep := prime_band_closed_lower_endpoint_error (x ^ α) (x ^ β) α⁻¹
    (fun q => (1 - t - Real.logb x (q : ℝ))⁻¹)
    (Real.rpow_pos_of_pos hx0 α)
    (Real.rpow_le_rpow_of_exponent_le hx.le hβ.1) (by positivity) (by
      intro q hq _ hqB
      have hq0 : 0 < (q : ℝ) := by exact_mod_cast hq.pos
      have hqβ := (Real.logb_le_iff_le_rpow hx hq0).2 hqB
      have hd : α ≤ 1 - t - Real.logb x (q : ℝ) := by
        have hqγ := hqβ.trans hβ.2
        dsimp [α, γ] at ht' hqγ ⊢
        linarith [ht'.2]
      rw [abs_of_pos (inv_pos.mpr (hα.trans_le hd))]
      exact inv_anti₀ hα hd)
  have hep' :
      |(∑ q ∈ (Nat.primesLE ⌊x ^ β⌋₊).filter (fun q : ℕ => x ^ α ≤ (q : ℝ)),
          ((q : ℝ) * (1 - t - Real.logb x (q : ℝ)))⁻¹) -
        ∑ q ∈ (Nat.primesLE ⌊x ^ β⌋₊).filter (fun q : ℕ => x ^ α < (q : ℝ)),
          ((q : ℝ) * (1 - t - Real.logb x (q : ℝ)))⁻¹| ≤ α⁻¹ / x ^ α := by
    simpa only [mul_inv, div_eq_mul_inv, mul_comm] using hep
  exact (abs_sub_le _ _ _).trans ((add_le_add hep' (hb x hx hA t ht)).trans
    (by rw [add_comm]))

theorem eventually_prime_reciprocal_band_bounded (α β : ℝ)
    (hα : 0 < α) (hαβ : α ≤ β) :
    ∃ H : ℝ, 0 < H ∧ ∀ᶠ x : ℝ in atTop,
      ∑ p ∈ (Nat.primesLE (Nat.floor (x ^ β))).filter
          (fun p : ℕ => x ^ α ≤ (p : ℝ)), (p : ℝ)⁻¹ ≤ H := by
  classical
  obtain ⟨C, hC, herror⟩ :=
    prime_band_logarithmic_weight_error α β hα
  have hβ : 0 < β := hα.trans_le hαβ
  have hlogratio : 0 ≤ log (β / α) := log_nonneg ((one_le_div₀ hα).2 hαβ)
  refine ⟨1 + log (β / α) + 2 * C / α, by positivity, ?_⟩
  filter_upwards [eventually_gt_atTop (1 : ℝ),
    (tendsto_rpow_atTop hα).eventually_ge_atTop 2,
    Real.tendsto_log_atTop.eventually_ge_atTop 1] with x hx hA hL
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hA0 : 0 < x ^ α := Real.rpow_pos_of_pos hx0 α
  have hAB : x ^ α ≤ x ^ β := Real.rpow_le_rpow_of_exponent_le hx.le hαβ
  have hopen := herror (fun _ => 1) (fun _ => 0) 1 0 (by norm_num) (by norm_num)
    (fun t _ => hasDerivAt_const t 1) continuousOn_const
    (by intros; norm_num) (by intros; norm_num) x hx hA β hαβ le_rfl
  simp only [one_div, mul_one, zero_mul, add_zero, integral_inv_of_pos hα hβ] at hopen
  have hopen' := (abs_le.mp hopen).2
  have hscale : (2 * C / α) / log x ≤ 2 * C / α := div_le_self (by positivity) hL
  have he := prime_band_closed_lower_endpoint_error (x ^ α) (x ^ β) 1 (fun _ => 1)
    hA0 hAB (by norm_num) (by intros; norm_num)
  simp only [one_div] at he
  have hunit : (x ^ α)⁻¹ ≤ 1 := (inv_le_one₀ hA0).2 (by linarith)
  have hclosed := (le_abs_self _).trans he
  linarith

theorem reciprocal_split_integral {c z : ℝ} (hz : 0 < z) (hzc : z ≤ c / 2) :
    (∫ s in z..(c / 2), (s * (c - s))⁻¹) = Real.log ((c - z) / z) / c := by
  have hc : 0 < c := by linarith
  have hcz : 0 < c - z := by linarith
  have hden (s : ℝ) (hs : s ∈ Set.uIcc z (c / 2)) :
      0 < s ∧ 0 < c - s := by
    rw [Set.uIcc_of_le hzc] at hs
    constructor <;> linarith [hs.1, hs.2]
  have hint : IntervalIntegrable (fun s : ℝ => (s * (c - s))⁻¹) volume z (c / 2) := by
    apply ContinuousOn.intervalIntegrable
    apply ContinuousOn.inv₀ (by fun_prop)
    intro s hs
    exact mul_ne_zero (hden s hs).1.ne' (hden s hs).2.ne'
  have hder (s : ℝ) (hs : s ∈ Set.uIcc z (c / 2)) :
      HasDerivAt (fun s : ℝ => (Real.log s - Real.log (c - s)) / c)
        (s * (c - s))⁻¹ s := by
    have hd := ((Real.hasDerivAt_log (hden s hs).1.ne').fun_sub
      ((Real.hasDerivAt_log (hden s hs).2.ne').comp_const_sub c s)).div_const c
    convert hd using 1 <;> first | rfl |
      (field_simp [hc.ne', (hden s hs).1.ne', (hden s hs).2.ne']; ring)
  rw [intervalIntegral.integral_eq_sub_of_hasDerivAt hder hint]
  rw [sub_half, sub_self, zero_div, zero_sub, Real.log_div hcz.ne' hz.ne']
  ring

theorem three_prime_inner_integral {t : ℝ}
    (ht : t ∈ Set.Icc ((9519 : ℝ) / 50000) ((40481 : ℝ) / 100000)) :
    (∫ s in ((9519 : ℝ) / 50000)..((1 - t) / 2), (s * (1 - t - s))⁻¹) =
      Real.log ((1 - t - (9519 : ℝ) / 50000) / ((9519 : ℝ) / 50000)) / (1 - t) := by
  apply reciprocal_split_integral (by norm_num)
  linarith [ht.2]

theorem three_prime_inner_density_integral {t : ℝ}
    (ht : t ∈ Set.Icc ((9519 : ℝ) / 50000) ((40481 : ℝ) / 100000)) :
    (∫ s in ((9519 : ℝ) / 50000)..((1 - t) / 2), (t * s * (1 - t - s))⁻¹) =
      Real.log ((1 - t - (9519 : ℝ) / 50000) / ((9519 : ℝ) / 50000)) /
        (t * (1 - t)) := by
  simp_rw [mul_assoc, mul_inv t]
  rw [intervalIntegral.integral_const_mul, three_prime_inner_integral ht]
  simp only [div_eq_mul_inv, mul_inv, mul_left_comm]

theorem three_prime_coefficient_regular :
    let f : ℝ → ℝ := fun t =>
      Real.log ((1 - t - (9519 : ℝ) / 50000) / ((9519 : ℝ) / 50000)) / (1 - t)
    let f' : ℝ → ℝ := fun t =>
      Real.log ((1 - t - (9519 : ℝ) / 50000) / ((9519 : ℝ) / 50000)) / (1 - t) ^ 2 -
        1 / ((1 - t) * (1 - t - (9519 : ℝ) / 50000))
    (∀ t ∈ Set.Icc ((9519 : ℝ) / 50000) ((40481 : ℝ) / 100000),
      HasDerivAt f (f' t) t) ∧
    ContinuousOn f' (Set.Icc ((9519 : ℝ) / 50000) ((40481 : ℝ) / 100000)) := by
  dsimp only
  have hpos (t : ℝ)
      (ht : t ∈ Set.Icc ((9519 : ℝ) / 50000) ((40481 : ℝ) / 100000)) :
      0 < 1 - t ∧ 0 < 1 - t - (9519 : ℝ) / 50000 := by
    constructor <;> linarith [ht.2]
  constructor
  · intro t ht
    have hd := (((((hasDerivAt_id' t).const_sub 1).sub_const
      ((9519 : ℝ) / 50000)).div_const ((9519 : ℝ) / 50000)).log
      (div_ne_zero (hpos t ht).2.ne' (by norm_num))).div
      ((hasDerivAt_id' t).const_sub 1) (hpos t ht).1.ne'
    convert hd using 1 <;> first | rfl |
      (field_simp [(hpos t ht).1.ne', (hpos t ht).2.ne']; ring)
  · fun_prop (disch := intro t ht; obtain ⟨h₁, h₂⟩ := hpos t ht; positivity)

theorem three_prime_weighted_prime_kernel_tendsto :
    Tendsto
      (fun x : ℝ =>
        ∑ p ∈ (Nat.primesBelow (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
          (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ)),
          ∑ q ∈ (Nat.primesLE (Nat.floor (Real.sqrt (x / (p : ℝ))))).filter
            (fun q : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (q : ℝ)),
            ((p : ℝ) * (q : ℝ) *
              (1 - Real.logb x (p : ℝ) - Real.logb x (q : ℝ)))⁻¹)
      atTop (nhds
        (∫ t in ((9519 : ℝ) / 50000)..((40481 : ℝ) / 100000),
          ∫ s in ((9519 : ℝ) / 50000)..((1 - t) / 2),
            (t * s * (1 - t - s))⁻¹)) := by
  classical
  let α : ℝ := 9519 / 50000
  let γ : ℝ := 40481 / 100000
  let f : ℝ → ℝ := fun t => Real.log ((1 - t - α) / α) / (1 - t)
  let fp : ℝ → ℝ := fun t =>
    Real.log ((1 - t - α) / α) / (1 - t) ^ 2 - 1 / ((1 - t) * (1 - t - α))
  let P : ℝ → Finset ℕ := fun x =>
    (Nat.primesBelow (Nat.ceil (x ^ γ))).filter (fun p : ℕ => x ^ α ≤ (p : ℝ))
  let Q : ℝ → ℕ → Finset ℕ := fun x p =>
    (Nat.primesLE (Nat.floor (Real.sqrt (x / (p : ℝ))))).filter
      (fun q : ℕ => x ^ α ≤ (q : ℝ))
  let S : ℝ → ℝ := fun x =>
    ∑ p ∈ P x, ∑ q ∈ Q x p,
      ((p : ℝ) * (q : ℝ) * (1 - Real.logb x (p : ℝ) - Real.logb x (q : ℝ)))⁻¹
  let O : ℝ → ℝ := fun x =>
    ∑ p ∈ P x, f (Real.logb x (p : ℝ)) / (p : ℝ)
  have hα : 0 < α := by norm_num [α]
  have hαγ : α ≤ γ := by norm_num [α, γ]
  have hreg := three_prime_coefficient_regular
  have houter : Tendsto O atTop (nhds (∫ t in α..γ, f t / t)) :=
    prime_band_logarithmic_weight_tendsto α γ hα hαγ f fp hreg.1 hreg.2
  have hI :
      (∫ t in α..γ, f t / t) =
        ∫ t in α..γ, ∫ s in α..((1 - t) / 2), (t * s * (1 - t - s))⁻¹ := by
    apply intervalIntegral.integral_congr
    intro t ht
    rw [Set.uIcc_of_le hαγ] at ht
    simpa only [f, α, div_div, mul_comm] using
      (three_prime_inner_density_integral ht).symm
  obtain ⟨C, hC, hb⟩ := three_prime_inner_closed_kernel_error
  obtain ⟨H, _, hband⟩ := eventually_prime_reciprocal_band_bounded α γ hα hαγ
  have hA := tendsto_rpow_atTop hα
  have herror : Tendsto (fun x : ℝ => S x - O x) atTop (nhds 0) := by
    rw [tendsto_zero_iff_abs_tendsto_zero]
    apply squeeze_zero' (g := fun x : ℝ =>
      H * (C / Real.log x + α⁻¹ / x ^ α))
      (Eventually.of_forall (fun _ => abs_nonneg _))
    · filter_upwards [eventually_gt_atTop (1 : ℝ), hA.eventually_ge_atTop 2, hband]
        with x hx hAx hBx
      have hx0 : 0 < x := zero_lt_one.trans hx
      have hL : 0 < Real.log x := Real.log_pos hx
      have hPx : ∑ p ∈ P x, (p : ℝ)⁻¹ ≤ H := by
        apply le_trans _ hBx
        apply Finset.sum_le_sum_of_subset_of_nonneg
        · exact Finset.filter_subset_filter _
            (Nat.primesBelow_mono (Nat.ceil_le_floor_add_one _))
        · intro p _ _
          positivity
      have hpoint (p : ℕ) (hp : p ∈ P x) :
          |(∑ q ∈ Q x p,
              ((p : ℝ) * (q : ℝ) *
                (1 - Real.logb x (p : ℝ) - Real.logb x (q : ℝ)))⁻¹) -
            f (Real.logb x (p : ℝ)) / (p : ℝ)| ≤
          (C / Real.log x + α⁻¹ / x ^ α) / (p : ℝ) := by
        obtain ⟨hp, hpA⟩ := mem_filter.mp hp
        obtain ⟨hpB, hpprime⟩ := Nat.mem_primesBelow.mp hp
        have hp0 : 0 < (p : ℝ) := by exact_mod_cast hpprime.pos
        have hpγ : (p : ℝ) < x ^ γ := Nat.lt_ceil.mp hpB
        have ht : Real.logb x (p : ℝ) ∈ Set.Icc α γ :=
          ⟨(Real.le_logb_iff_rpow_le hx hp0).2 hpA,
            ((Real.logb_lt_iff_lt_rpow hx hp0).2 hpγ).le⟩
        have hsqrt :
            Real.sqrt (x / (p : ℝ)) = x ^ ((1 - Real.logb x (p : ℝ)) / 2) := by
          have heq : x / (p : ℝ) = x ^ (1 - Real.logb x (p : ℝ)) := by
            rw [Real.rpow_sub hx0, Real.rpow_one, Real.rpow_logb hx0 hx.ne' hp0]
          rw [Real.sqrt_eq_rpow, heq, ← Real.rpow_mul hx0.le, mul_one_div]
        have hi := hb x hx hAx (Real.logb x (p : ℝ)) ht
        rw [three_prime_inner_integral ht] at hi
        have hsum :
            (∑ q ∈ Q x p,
                ((p : ℝ) * (q : ℝ) *
                  (1 - Real.logb x (p : ℝ) - Real.logb x (q : ℝ)))⁻¹) =
              (∑ q ∈ Q x p,
                ((q : ℝ) * (1 - Real.logb x (p : ℝ) - Real.logb x (q : ℝ)))⁻¹) /
                (p : ℝ) := by
          rw [Finset.sum_div]
          simp only [mul_inv_rev, div_eq_mul_inv, mul_assoc]
        rw [hsum, ← sub_div, abs_div, abs_of_pos hp0]
        apply div_le_div_of_nonneg_right _ hp0.le
        simpa only [Q, hsqrt, f, α] using hi
      change |(∑ p ∈ P x, _) - ∑ p ∈ P x, _| ≤ _
      rw [← sum_sub_distrib]
      calc
        _ ≤ ∑ p ∈ P x, (C / Real.log x + α⁻¹ / x ^ α) / (p : ℝ) :=
          (Finset.abs_sum_le_sum_abs _ _).trans (sum_le_sum hpoint)
        _ = (∑ p ∈ P x, (p : ℝ)⁻¹) * (C / Real.log x + α⁻¹ / x ^ α) := by
          simp_rw [Finset.sum_mul, div_eq_mul_inv, mul_comm]
        _ ≤ H * (C / Real.log x + α⁻¹ / x ^ α) :=
          mul_le_mul_of_nonneg_right hPx (by positivity)
    · simpa only [add_zero, mul_zero] using
        tendsto_const_nhds.mul
          ((tendsto_log_atTop.const_div_atTop C).add (hA.const_div_atTop α⁻¹))
  rw [hI] at houter
  simpa only [S, P, Q, α, γ, sub_add_cancel, zero_add] using herror.add houter

end

section
open scoped ComplexOrder
open ArithmeticFunction

section GoldfeldCoefficient
local instance goldfeldLcmNeZero {q1 q : ℕ} [NeZero q1] [NeZero q] :
    NeZero (Nat.lcm q1 q) :=
  ⟨Nat.lcm_ne_zero (NeZero.ne q1) (NeZero.ne q)⟩

end GoldfeldCoefficient
end

/-!
## Goldfeld's method and Siegel–Walfisz bounds

Use positive convolutions and Mellin estimates to control the contribution of real character
zeros.
-/

theorem goldfeldCharactersDistinct_same_level_iff
    {q : ℕ} [NeZero q]
    (chi1 chi : DirichletCharacter Complex q) :
    (chi1.changeLevel (Nat.dvd_lcm_left q q) ≠
      chi.changeLevel (Nat.dvd_lcm_right q q)) ↔ chi1 ≠ chi := by
  let : NeZero (Nat.lcm q q) :=
    ⟨Nat.lcm_ne_zero (NeZero.ne q) (NeZero.ne q)⟩
  exact (DirichletCharacter.changeLevel_injective
    (R := Complex) (Nat.dvd_lcm_left q q)).ne_iff

theorem goldfeldCharactersDistinct_of_modulus_ne
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter Complex q1)
    (chi : DirichletCharacter Complex q)
    (hprimitive1 : DirichletCharacter.IsPrimitive chi1)
    (hprimitive : DirichletCharacter.IsPrimitive chi)
    (hmodulus : q1 ≠ q) :
    (chi1.changeLevel (Nat.dvd_lcm_left q1 q) ≠ chi.changeLevel (Nat.dvd_lcm_right q1 q)) := by
  let : NeZero (Nat.lcm q1 q) :=
    ⟨Nat.lcm_ne_zero (NeZero.ne q1) (NeZero.ne q)⟩
  intro heq
  apply hmodulus
  have hconductor := congrArg DirichletCharacter.conductor heq
  rw [chi1.conductor_changeLevel, chi.conductor_changeLevel] at hconductor
  exact hprimitive1.symm.trans (hconductor.trans hprimitive)

theorem goldfeldCrossLevelMul_ne_one
    {q1 q : ℕ}
    (chi1 : DirichletCharacter Complex q1)
    (chi : DirichletCharacter Complex q)
    (hsquare1 : chi1 ^ 2 = 1)
    (hdistinct : (chi1.changeLevel (Nat.dvd_lcm_left q1 q) ≠
      chi.changeLevel (Nat.dvd_lcm_right q1 q))) :
    DirichletCharacter.mul chi1 chi ≠ 1 := by
  intro h
  apply hdistinct
  apply mul_left_cancel (a := chi1.changeLevel (Nat.dvd_lcm_left q1 q))
  simpa only [DirichletCharacter.mul, ← pow_two, ← map_pow, hsquare1, map_one] using h.symm

section
open Complex

theorem norm_inducingEulerProduct_le_sq_of_neg_one_le_re
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    {s : ℂ} (hs : -(1 : ℝ) ≤ s.re) :
    ‖inducingEulerProduct chi s‖ ≤ (q : ℝ) ^ 2 := by
  rw [inducingEulerProduct]
  calc
    ‖∏ p ∈ q.primeFactors,
        (1 - chi.primitiveCharacter p * (p : ℂ) ^ (-s))‖ ≤
        ∏ p ∈ q.primeFactors,
          ‖1 - chi.primitiveCharacter p * (p : ℂ) ^ (-s)‖ :=
      Finset.norm_prod_le _ _
    _ ≤ ∏ p ∈ q.primeFactors, (p : ℝ) ^ 2 := by
      apply Finset.prod_le_prod
      · intro p hp
        positivity
      · intro p hp
        have hpPrime := Nat.prime_of_mem_primeFactors hp
        have hp1 : (1 : ℝ) ≤ p := by exact_mod_cast hpPrime.one_le
        have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast hpPrime.two_le
        have hpow : (p : ℝ) ^ (-s.re) ≤ (p : ℝ) := by
          calc
            (p : ℝ) ^ (-s.re) ≤ (p : ℝ) ^ (1 : ℝ) :=
              Real.rpow_le_rpow_of_exponent_le hp1 (by linarith)
            _ = (p : ℝ) := Real.rpow_one _
        calc
          ‖1 - chi.primitiveCharacter p * (p : ℂ) ^ (-s)‖ ≤
              1 + ‖chi.primitiveCharacter p * (p : ℂ) ^ (-s)‖ := by
            simpa using norm_sub_le (1 : ℂ)
              (chi.primitiveCharacter p * (p : ℂ) ^ (-s))
          _ = 1 + ‖chi.primitiveCharacter p‖ * (p : ℝ) ^ (-s.re) := by
            rw [norm_mul, Complex.norm_natCast_cpow_of_pos hpPrime.pos, neg_re]
          _ ≤ 1 + 1 * (p : ℝ) := by
            gcongr
            exact chi.primitiveCharacter.norm_le_one p
          _ ≤ (p : ℝ) ^ 2 := by nlinarith
    _ = (∏ p ∈ q.primeFactors, (p : ℝ)) ^ 2 :=
      Finset.prod_pow q.primeFactors 2 (fun p : ℕ => (p : ℝ))
    _ = ((∏ p ∈ q.primeFactors, p : ℕ) : ℝ) ^ 2 := by
      push_cast
      rfl
    _ ≤ (q : ℝ) ^ 2 := by
      gcongr
      exact_mod_cast Nat.le_of_dvd (NeZero.pos q)
        (Nat.prod_primeFactors_dvd q)

section DirichletLFunctionClosedStripGrowth

theorem exists_norm_primitiveLFunction_closedStrip_le_pow :
    ∃ A : ℕ, 12 ≤ A ∧
      ∀ (q : ℕ) [NeZero q], 1 < q →
        ∀ (chi : DirichletCharacter ℂ q), chi.IsPrimitive →
          ∀ s : ℂ, -(1 : ℝ) ≤ s.re → s.re ≤ 3 →
            ‖DirichletCharacter.LFunction chi s‖ ≤
              ((q : ℝ) * (|s.im| + 2)) ^ A := by
  obtain ⟨A, hA, hleft⟩ := exists_norm_LFunction_fixedStrip_le_pow
  refine ⟨A, hA, ?_⟩
  intro q _ hq chi hchi s hslo hshi
  let T : ℝ := |s.im| + 2
  let B : ℝ := (q : ℝ) * T
  have hq2 : (2 : ℝ) ≤ q := by exact_mod_cast hq
  have hq1 : (1 : ℝ) ≤ q := one_le_two.trans hq2
  have hT2 : (2 : ℝ) ≤ T := by
    dsimp [T]
    linarith [abs_nonneg s.im]
  have hB4 : (4 : ℝ) ≤ B := by
    dsimp [B]
    nlinarith
  have hB1 : (1 : ℝ) ≤ B := by linarith
  by_cases hleftCase : s.re ≤ (1 / 2 : ℝ)
  · exact hleft q hq chi hchi s (by linarith) hleftCase
  · have hhalf : (1 / 2 : ℝ) ≤ s.re := le_of_not_ge hleftCase
    by_cases hcentral : s.re ≤ 2
    · have hc := norm_LFunction_centralStrip_le hq chi hchi
          (sigma := s.re) (t := s.im) hhalf hcentral
      have hsarg : (((s.re : ℝ) : ℂ) + ((s.im : ℝ) : ℂ) * I) = s := by
        apply Complex.ext <;> simp
      rw [hsarg] at hc
      have hsqrt : Real.sqrt (q : ℝ) ≤ q :=
        Real.sqrt_le_self_iff.mpr (Or.inr hq1)
      have hlog : Real.log (q : ℝ) ≤ q :=
        (Real.log_le_sub_one_of_pos (by positivity)).trans
          (sub_le_self _ zero_le_one)
      have hcentralBound :
          2 * T * Real.sqrt (q : ℝ) * Real.log (q : ℝ) ≤ B ^ 2 := by
        calc
          2 * T * Real.sqrt (q : ℝ) * Real.log (q : ℝ) ≤
              2 * T * (q : ℝ) * (q : ℝ) := by gcongr
          _ ≤ ((q : ℝ) * T) ^ 2 := by nlinarith
          _ = B ^ 2 := rfl
      calc
        ‖DirichletCharacter.LFunction chi s‖ ≤
            2 * T * Real.sqrt (q : ℝ) * Real.log (q : ℝ) := by
          simpa [T] using hc
        _ ≤ B ^ 2 := hcentralBound
        _ ≤ B ^ A := pow_le_pow_right₀ hB1 (by omega)
    · have hfar : (2 : ℝ) ≤ s.re := le_of_not_ge hcentral
      have hf := norm_LFunction_farRight_le_three chi s hfar
      calc
        ‖DirichletCharacter.LFunction chi s‖ ≤ 3 := hf
        _ ≤ B ^ 1 := by simp; linarith
        _ ≤ B ^ A := pow_le_pow_right₀ hB1 (by omega)

end DirichletLFunctionClosedStripGrowth

theorem exists_norm_LFunction_closedStrip_le_pow :
    ∃ A : ℕ, 14 ≤ A ∧
      ∀ (q : ℕ) [NeZero q], 1 < q →
        ∀ (chi : DirichletCharacter ℂ q), chi ≠ 1 →
          ∀ s : ℂ, -(1 : ℝ) ≤ s.re → s.re ≤ 3 →
            ‖DirichletCharacter.LFunction chi s‖ ≤
              ((q : ℝ) * (|s.im| + 2)) ^ A := by
  obtain ⟨A, hA, hprimitive⟩ :=
    exists_norm_primitiveLFunction_closedStrip_le_pow
  refine ⟨A + 2, by omega, ?_⟩
  intro q _ hq chi hchi s hslo hshi
  let d := chi.conductor
  let : NeZero d := ⟨chi.conductor_ne_zero⟩
  have hd1 : 1 < d := by
    have hdne : d ≠ 1 := by
      intro hd
      apply hchi
      exact DirichletCharacter.eq_one_iff_conductor_eq_one.mpr hd
    have hd0 : d ≠ 0 := NeZero.ne d
    omega
  have hdq : d ≤ q :=
    Nat.le_of_dvd (NeZero.pos q) chi.conductor_dvd_level
  let T : ℝ := |s.im| + 2
  let B : ℝ := (q : ℝ) * T
  have hq2 : (2 : ℝ) ≤ q := by exact_mod_cast hq
  have hq1 : (1 : ℝ) ≤ q := one_le_two.trans hq2
  have hT2 : (2 : ℝ) ≤ T := by
    dsimp [T]
    linarith [abs_nonneg s.im]
  have hT0 : (0 : ℝ) ≤ T := zero_le_two.trans hT2
  have hB1 : (1 : ℝ) ≤ B := by
    dsimp [B]
    nlinarith
  have hprimitiveBound := hprimitive d hd1 chi.primitiveCharacter
    chi.primitiveCharacter_isPrimitive s hslo hshi
  have hbase : (d : ℝ) * T ≤ B := by
    dsimp [B]
    gcongr
  have hprimitiveBound' :
      ‖DirichletCharacter.LFunction chi.primitiveCharacter s‖ ≤ B ^ A :=
    hprimitiveBound.trans (by
      simpa [T] using
        pow_le_pow_left₀ (mul_nonneg (Nat.cast_nonneg d) hT0) hbase A)
  have hEuler := norm_inducingEulerProduct_le_sq_of_neg_one_le_re chi hslo
  have hqB : (q : ℝ) ≤ B := by
    dsimp [B]
    nlinarith
  have hqSq : (q : ℝ) ^ 2 ≤ B ^ 2 := by gcongr
  rw [LFunction_eq_inducingPrimitive_mul_inducingEulerProduct chi (.inl hchi),
    norm_mul]
  calc
    ‖DirichletCharacter.LFunction chi.primitiveCharacter s‖ *
        ‖inducingEulerProduct chi s‖ ≤ B ^ A * B ^ 2 :=
      mul_le_mul hprimitiveBound' (hEuler.trans hqSq)
        (norm_nonneg _) (pow_nonneg (zero_le_one.trans hB1) A)
    _ = B ^ (A + 2) := by rw [pow_add]

end

section
open scoped ComplexOrder
open ArithmeticFunction

attribute [local instance] goldfeldLcmNeZero
/--
The arithmetic function given by the Dirichlet convolution of the constant-one function, `chi1`,
`chi`, and their product character. Its Dirichlet series is the four-factor product used in
Goldfeld's argument.
-/
noncomputable def goldfeldCoefficient
    {q1 q : ℕ}
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q) : ArithmeticFunction ℂ :=
  ((ArithmeticFunction.zeta * toArithmeticFunction (chi1 ·)) *
      toArithmeticFunction (chi ·)) *
    toArithmeticFunction (DirichletCharacter.mul chi1 chi ·)

theorem goldfeldCrossLevelMul_apply
    {q1 q n : ℕ}
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q) :
    DirichletCharacter.mul chi1 chi n = chi1 n * chi n := by
  by_cases h1 : Nat.Coprime n q1
  · by_cases h2 : Nat.Coprime n q
    · have hlcm : Nat.Coprime n (Nat.lcm q1 q) :=
        Nat.Coprime.of_dvd_right (Nat.lcm_dvd_mul q1 q) (h1.mul_right h2)
      change
        (chi1.changeLevel (Nat.dvd_lcm_left q1 q) *
          chi.changeLevel (Nat.dvd_lcm_right q1 q)) n = _
      rw [MulChar.mul_apply]
      have hInt : IsCoprime (n : ℤ) (Nat.lcm q1 q : ℤ) :=
        Nat.Coprime.isCoprime hlcm
      simpa using congrArg₂ (· * ·)
        (DirichletCharacter.changeLevel_eq_cast_of_dvd' chi1
          (Nat.dvd_lcm_left q1 q) hInt)
        (DirichletCharacter.changeLevel_eq_cast_of_dvd' chi
          (Nat.dvd_lcm_right q1 q) hInt)
    · have hlcm : ¬Nat.Coprime n (Nat.lcm q1 q) := fun h =>
        h2 (Nat.Coprime.of_dvd_right (Nat.dvd_lcm_right q1 q) h)
      have hpzero : DirichletCharacter.mul chi1 chi n = 0 :=
        MulChar.map_nonunit _ (by
          simpa [ZMod.isUnit_iff_coprime] using hlcm)
      have hzero : chi n = 0 :=
        MulChar.map_nonunit _ (by
          simpa [ZMod.isUnit_iff_coprime] using h2)
      rw [hpzero, hzero, mul_zero]
  · have hlcm : ¬Nat.Coprime n (Nat.lcm q1 q) := fun h =>
      h1 (Nat.Coprime.of_dvd_right (Nat.dvd_lcm_left q1 q) h)
    have hpzero : DirichletCharacter.mul chi1 chi n = 0 :=
      MulChar.map_nonunit _ (by
        simpa [ZMod.isUnit_iff_coprime] using hlcm)
    have hzero : chi1 n = 0 :=
      MulChar.map_nonunit _ (by
        simpa [ZMod.isUnit_iff_coprime] using h1)
    rw [hpzero, hzero, zero_mul]

theorem goldfeldCoefficient_one
    {q1 q : ℕ}
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q) :
    goldfeldCoefficient chi1 chi 1 = 1 := by
  simp only [goldfeldCoefficient, ArithmeticFunction.mul_apply_one]
  simp [toArithmeticFunction]

end

section
open scoped ComplexOrder
open ArithmeticFunction

section GoldfeldCoefficient

attribute [local instance] goldfeldLcmNeZero
theorem characterAF_prime_pow
    {q p k : ℕ} (chi : DirichletCharacter ℂ q) (hp : p.Prime) :
    toArithmeticFunction (chi ·) (p ^ k) = (chi p) ^ k := by
  rw [← chi.apply_eq_toArithmeticFunction_apply (pow_ne_zero k hp.ne_zero)]
  simpa only [Nat.cast_pow] using map_pow chi (p : ZMod q) k

theorem productAF_prime_pow
    {q1 q p k : ℕ}
    (chi1 : DirichletCharacter ℂ q1) (chi : DirichletCharacter ℂ q)
    (hp : p.Prime) :
    toArithmeticFunction (DirichletCharacter.mul chi1 chi ·) (p ^ k) =
      (chi1 p * chi p) ^ k := by
  rw [characterAF_prime_pow _ hp, goldfeldCrossLevelMul_apply]

theorem zeta_prime_pow {p k : ℕ} (hp : p.Prime) :
    (ArithmeticFunction.zeta : ArithmeticFunction ℂ) (p ^ k) = 1 := by
  have hpow : p ^ k ≠ 0 := pow_ne_zero k hp.ne_zero
  simp only [ArithmeticFunction.natCoe_apply,
    ArithmeticFunction.zeta_apply_ne hpow, Nat.cast_one]

theorem mul_apply_prime_pow
    (f g : ArithmeticFunction ℂ) {p k : ℕ} (hp : p.Prime) :
    (f * g) (p ^ k) =
      ∑ i ∈ Finset.range (k + 1), f (p ^ i) * g (p ^ (k - i)) := by
  rw [ArithmeticFunction.mul_apply,
    Nat.sum_divisorsAntidiagonal (fun x y => f x * g y),
    Nat.sum_divisors_prime_pow hp]
  apply Finset.sum_congr rfl
  intro i hi
  rw [Nat.pow_div (Nat.le_of_lt_succ (Finset.mem_range.mp hi)) hp.pos]

theorem mul_apply_prime_pow_eq_left_of_right_unit
    (f g : ArithmeticFunction ℂ) {p k : ℕ} (hp : p.Prime)
    (hone : g 1 = 1) (hzero : ∀ j, 0 < j → g (p ^ j) = 0) :
    (f * g) (p ^ k) = f (p ^ k) := by
  rw [mul_apply_prime_pow f g hp]
  classical
  rw [Finset.sum_eq_single k]
  · simp [hone]
  · intro i hi hik
    have hik' : i < k :=
      (Nat.le_of_lt_succ (Finset.mem_range.mp hi)).lt_of_ne hik
    rw [hzero (k - i) (Nat.sub_pos_of_lt hik'), mul_zero]
  · simp

theorem mul_prime_pow_nonneg_of_local_eq
    (f g : ArithmeticFunction ℂ) {p k : ℕ} (hp : p.Prime)
    (hf : ∀ n, 0 ≤ f n) (hlocal : ∀ j, g (p ^ j) = f (p ^ j)) :
    0 ≤ (f * g) (p ^ k) := by
  rw [mul_apply_prime_pow f g hp]
  exact Finset.sum_nonneg fun i _ => by
    rw [hlocal]
    exact mul_nonneg (hf _) (hf _)

theorem goldfeldCoefficient_prime_pow_nonneg
    {q1 q p : ℕ}
    (chi1 : DirichletCharacter ℂ q1) (chi : DirichletCharacter ℂ q)
    (hsquare1 : chi1 ^ 2 = 1) (hsquare : chi ^ 2 = 1)
    (hp : p.Prime) (k : ℕ) :
    0 ≤ goldfeldCoefficient chi1 chi (p ^ k) := by
  let A := toArithmeticFunction (chi1 ·)
  let B := toArithmeticFunction (chi ·)
  let C := toArithmeticFunction (DirichletCharacter.mul chi1 chi ·)
  let Z : ArithmeticFunction ℂ := ArithmeticFunction.zeta
  have hA : ∀ j, A (p ^ j) = (chi1 p) ^ j := fun _ =>
    characterAF_prime_pow chi1 hp
  have hB : ∀ j, B (p ^ j) = (chi p) ^ j := fun _ =>
    characterAF_prime_pow chi hp
  have hC : ∀ j, C (p ^ j) = (chi1 p * chi p) ^ j := fun _ =>
    productAF_prime_pow chi1 chi hp
  have hZ : ∀ j, Z (p ^ j) = 1 := fun _ => zeta_prime_pow hp
  have hZA : ∀ n, 0 ≤ (Z * A) n := fun n => by
    simpa [Z, A, DirichletCharacter.zetaMul] using
      chi1.zetaMul_nonneg hsquare1 n
  have hZB : ∀ n, 0 ≤ (Z * B) n := fun n => by
    simpa [Z, B, DirichletCharacter.zetaMul] using
      chi.zetaMul_nonneg hsquare n
  rcases MulChar.isQuadratic_iff_sq_eq_one.mpr hsquare1 p with ha | ha | ha
  · have hCunit : C 1 = 1 := by simpa using hC 0
    have hCzero : ∀ j, 0 < j → C (p ^ j) = 0 := by
      intro j hj
      rw [hC]
      simp [ha, zero_pow hj.ne']
    have hAC (j : ℕ) : (A * C) (p ^ j) = A (p ^ j) :=
      mul_apply_prime_pow_eq_left_of_right_unit A C hp hCunit hCzero
    have hACunit : (A * C) 1 = 1 := by
      calc
        (A * C) 1 = (A * C) (p ^ 0) := by simp
        _ = A (p ^ 0) := hAC 0
        _ = (chi1 p) ^ 0 := hA 0
        _ = 1 := by simp
    have hACzero : ∀ j, 0 < j → (A * C) (p ^ j) = 0 := by
      intro j hj
      rw [hAC, hA]
      simp [ha, zero_pow hj.ne']
    rw [goldfeldCoefficient]
    rw [show ((Z * A) * B) * C = (Z * B) * (A * C) by ac_rfl]
    rw [mul_apply_prime_pow_eq_left_of_right_unit (Z * B) (A * C)
      hp hACunit hACzero]
    exact hZB _
  · rcases MulChar.isQuadratic_iff_sq_eq_one.mpr hsquare p with hb | hb | hb
    · have hBunit : B 1 = 1 := by simpa using hB 0
      have hBzero : ∀ j, 0 < j → B (p ^ j) = 0 := by
        intro j hj
        rw [hB]
        simp [hb, zero_pow hj.ne']
      have hCB (j : ℕ) : (C * B) (p ^ j) = C (p ^ j) :=
        mul_apply_prime_pow_eq_left_of_right_unit C B hp hBunit hBzero
      have hCBunit : (C * B) 1 = 1 := by
        calc
          (C * B) 1 = (C * B) (p ^ 0) := by simp
          _ = C (p ^ 0) := hCB 0
          _ = (chi1 p * chi p) ^ 0 := hC 0
          _ = 1 := by simp
      have hCBzero : ∀ j, 0 < j → (C * B) (p ^ j) = 0 := by
        intro j hj
        rw [hCB, hC]
        simp [hb, zero_pow hj.ne']
      rw [goldfeldCoefficient]
      rw [show ((Z * A) * B) * C = (Z * A) * (C * B) by ac_rfl]
      rw [mul_apply_prime_pow_eq_left_of_right_unit (Z * A) (C * B)
        hp hCBunit hCBzero]
      exact hZA _
    · have hpair (j : ℕ) : (B * C) (p ^ j) = (Z * A) (p ^ j) := by
        rw [mul_apply_prime_pow B C hp,
          mul_apply_prime_pow Z A hp]
        apply Finset.sum_congr rfl
        intro i hi
        rw [hB, hC, hZ, hA]
        simp [ha, hb]
      rw [goldfeldCoefficient]
      rw [show ((Z * A) * B) * C = (Z * A) * (B * C) by ac_rfl]
      exact mul_prime_pow_nonneg_of_local_eq (Z * A) (B * C) hp hZA hpair
    · have hpair (j : ℕ) : (A * C) (p ^ j) = (Z * B) (p ^ j) := by
        rw [mul_apply_prime_pow A C hp,
          mul_apply_prime_pow Z B hp]
        apply Finset.sum_congr rfl
        intro i hi
        rw [hA, hC, hZ, hB]
        simp [ha, hb]
      rw [goldfeldCoefficient]
      rw [show ((Z * A) * B) * C = (Z * B) * (A * C) by ac_rfl]
      exact mul_prime_pow_nonneg_of_local_eq (Z * B) (A * C) hp hZB hpair
  · rcases MulChar.isQuadratic_iff_sq_eq_one.mpr hsquare p with hb | hb | hb
    · have hBunit : B 1 = 1 := by simpa using hB 0
      have hBzero : ∀ j, 0 < j → B (p ^ j) = 0 := by
        intro j hj
        rw [hB]
        simp [hb, zero_pow hj.ne']
      have hCB (j : ℕ) : (C * B) (p ^ j) = C (p ^ j) :=
        mul_apply_prime_pow_eq_left_of_right_unit C B hp hBunit hBzero
      have hCBunit : (C * B) 1 = 1 := by
        calc
          (C * B) 1 = (C * B) (p ^ 0) := by simp
          _ = C (p ^ 0) := hCB 0
          _ = (chi1 p * chi p) ^ 0 := hC 0
          _ = 1 := by simp
      have hCBzero : ∀ j, 0 < j → (C * B) (p ^ j) = 0 := by
        intro j hj
        rw [hCB, hC]
        simp [hb, zero_pow hj.ne']
      rw [goldfeldCoefficient]
      rw [show ((Z * A) * B) * C = (Z * A) * (C * B) by ac_rfl]
      rw [mul_apply_prime_pow_eq_left_of_right_unit (Z * A) (C * B)
        hp hCBunit hCBzero]
      exact hZA _
    · have hpair (j : ℕ) : (B * C) (p ^ j) = (Z * A) (p ^ j) := by
        rw [mul_apply_prime_pow B C hp,
          mul_apply_prime_pow Z A hp]
        apply Finset.sum_congr rfl
        intro i hi
        rw [hB, hC, hZ, hA]
        simp [ha, hb]
      rw [goldfeldCoefficient]
      rw [show ((Z * A) * B) * C = (Z * A) * (B * C) by ac_rfl]
      exact mul_prime_pow_nonneg_of_local_eq (Z * A) (B * C) hp hZA hpair
    · have hpair (j : ℕ) : (C * B) (p ^ j) = (Z * A) (p ^ j) := by
        rw [mul_apply_prime_pow C B hp,
          mul_apply_prime_pow Z A hp]
        apply Finset.sum_congr rfl
        intro i hi
        rw [hC, hB, hZ, hA]
        simp [ha, hb]
      rw [goldfeldCoefficient]
      rw [show ((Z * A) * B) * C = (Z * A) * (C * B) by ac_rfl]
      exact mul_prime_pow_nonneg_of_local_eq (Z * A) (C * B) hp hZA hpair

theorem goldfeldCoefficient_isMultiplicative
    {q1 q : ℕ}
    (chi1 : DirichletCharacter ℂ q1) (chi : DirichletCharacter ℂ q) :
    (goldfeldCoefficient chi1 chi).IsMultiplicative :=
  (((ArithmeticFunction.isMultiplicative_zeta.natCast.mul
    chi1.isMultiplicative_toArithmeticFunction).mul
      chi.isMultiplicative_toArithmeticFunction).mul
        (DirichletCharacter.mul chi1 chi).isMultiplicative_toArithmeticFunction)

theorem characterAF_LSeriesHasSum
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    {s : ℂ} (hs : 1 < s.re) :
    LSeriesHasSum (toArithmeticFunction (chi ·)) s
      (DirichletCharacter.LFunction chi s) := by
  have hsummable : LSeriesSummable (toArithmeticFunction (chi ·)) s :=
    (LSeriesSummable_congr s fun hn =>
      chi.apply_eq_toArithmeticFunction_apply hn).mp
        (ZMod.LSeriesSummable_of_one_lt_re chi hs)
  rw [chi.LFunction_eq_LSeries hs,
    LSeries_congr (fun hn => chi.apply_eq_toArithmeticFunction_apply hn) s]
  exact hsummable.LSeriesHasSum

end GoldfeldCoefficient
end

section
open scoped ComplexOrder
open ArithmeticFunction

attribute [local instance] goldfeldLcmNeZero
theorem goldfeldCoefficient_nonneg
    {q1 q : ℕ}
    (chi1 : DirichletCharacter ℂ q1) (chi : DirichletCharacter ℂ q)
    (hsquare1 : chi1 ^ 2 = 1) (hsquare : chi ^ 2 = 1) (n : ℕ) :
    0 ≤ goldfeldCoefficient chi1 chi n := by
  rcases eq_or_ne n 0 with rfl | hn
  · simp
  · rw [(goldfeldCoefficient_isMultiplicative
      chi1 chi).multiplicative_factorization _ hn]
    exact Finset.prod_nonneg fun p hp =>
      goldfeldCoefficient_prime_pow_nonneg chi1 chi hsquare1 hsquare
        (Nat.prime_of_mem_primeFactors hp) _

theorem goldfeldCoefficient_LSeriesHasSum
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    {s : ℂ} (hs : 1 < s.re) :
    LSeriesHasSum (goldfeldCoefficient chi1 chi) s
      (riemannZeta s * DirichletCharacter.LFunction chi1 s *
        DirichletCharacter.LFunction chi s *
          DirichletCharacter.LFunction
            (DirichletCharacter.mul chi1 chi) s) :=
  ArithmeticFunction.LSeriesHasSum_mul
    (ArithmeticFunction.LSeriesHasSum_mul
      (ArithmeticFunction.LSeriesHasSum_mul
        (ArithmeticFunction.LSeriesHasSum_zeta hs)
        (characterAF_LSeriesHasSum chi1 hs))
      (characterAF_LSeriesHasSum chi hs))
    (characterAF_LSeriesHasSum (DirichletCharacter.mul chi1 chi) hs)

end

section
open Complex

section GoldfeldMellinInversion

theorem cpow_neg_div_of_pos
    {x y : ℝ} (hx : 0 < x) (hy : 0 < y) (s : ℂ) :
    ((x / y : ℝ) : ℂ) ^ (-s) =
      (x : ℂ) ^ (-s) * (y : ℂ) ^ s := by
  rw [cpow_div_of_pos hx hy, Complex.cpow_neg, Complex.cpow_neg,
    div_inv_eq_mul]

end GoldfeldMellinInversion

theorem smoothMellinLSeriesInversion
    (a : ℕ → ℂ) (ha0 : a 0 = 0)
    (phi : ℝ → ℂ) {alpha x : ℝ}
    (_halpha : 0 < alpha) (hx : 0 < x)
    (hsum : LSeriesSummable a (alpha : ℂ))
    (hphi : MellinConvergent phi (alpha : ℂ))
    (hphiVertical : VerticalIntegrable (mellin phi) alpha)
    (hphiContinuous : Continuous phi) :
    (∑' n : ℕ, a n * phi ((n : ℝ) / x)) =
      (((2 * Real.pi : ℝ) : ℂ)⁻¹) *
        ∫ t : ℝ,
          LSeries a ((alpha : ℂ) + t * I) *
            mellin phi ((alpha : ℂ) + t * I) *
            (x : ℂ) ^ ((alpha : ℂ) + t * I) := by
  let s : ℝ → ℂ := fun t => (alpha : ℂ) + t * I
  let phiLine : ℝ → ℂ := fun t => mellin phi (s t)
  let F : ℕ → ℝ → ℂ := fun n t =>
    LSeries.term a (s t) n * phiLine t * (x : ℂ) ^ (s t)
  let G : ℝ → ℂ := fun t =>
    LSeries a (s t) * phiLine t * (x : ℂ) ^ (s t)
  have hsContinuous : Continuous s := by
    fun_prop
  have hxPowContinuous : Continuous fun t : ℝ => (x : ℂ) ^ (s t) :=
    continuous_const.cpow hsContinuous fun _ =>
      Complex.ofReal_mem_slitPlane.mpr hx
  have htermContinuous (n : ℕ) :
      Continuous fun t : ℝ => LSeries.term a (s t) n := by
    rcases eq_or_ne n 0 with rfl | hn
    · simpa using (continuous_const : Continuous fun _ : ℝ => (0 : ℂ))
    · have hnReal : (0 : ℝ) < n := by
        exact_mod_cast Nat.pos_of_ne_zero hn
      have hpow : Continuous fun t : ℝ => (n : ℂ) ^ (s t) := by
        exact continuous_const.cpow hsContinuous fun _ => by
          simpa only [← Complex.ofReal_natCast] using
            Complex.ofReal_mem_slitPlane.mpr hnReal
      have hpowNe (t : ℝ) : (n : ℂ) ^ (s t) ≠ 0 :=
        Complex.cpow_ne_zero_iff.mpr <| Or.inl <| Nat.cast_ne_zero.mpr hn
      simp only [LSeries.term_of_ne_zero hn]
      exact continuous_const.div hpow hpowNe
  have hphiLineIntegrable : Integrable phiLine := by
    simpa [VerticalIntegrable, phiLine, s] using hphiVertical
  have hmultiplierContinuous (n : ℕ) : Continuous fun t : ℝ =>
      LSeries.term a (s t) n * (x : ℂ) ^ (s t) :=
    (htermContinuous n).mul hxPowContinuous
  have hmultiplierNorm (n : ℕ) (t : ℝ) :
      ‖LSeries.term a (s t) n * (x : ℂ) ^ (s t)‖ =
        ‖LSeries.term a (alpha : ℂ) n‖ * x ^ alpha := by
    rw [norm_mul, LSeries.norm_term_eq, LSeries.norm_term_eq,
      Complex.norm_cpow_eq_rpow_re_of_pos hx]
    simp [s]
  have hFIntegrable (n : ℕ) : Integrable (F n) := by
    have h := hphiLineIntegrable.mul_bdd
      (hmultiplierContinuous n).aestronglyMeasurable
      (ae_of_all _ fun t => (hmultiplierNorm n t).le)
    convert h using 1
    funext t
    simp only [F, phiLine]
    ring
  have hFNormIntegral (n : ℕ) :
      (∫ t : ℝ, ‖F n t‖) =
        ‖LSeries.term a (alpha : ℂ) n‖ * x ^ alpha *
          ∫ t : ℝ, ‖phiLine t‖ := by
    rw [← integral_const_mul]
    apply integral_congr_ae
    filter_upwards [] with t
    rw [show F n t = phiLine t *
        (LSeries.term a (s t) n * (x : ℂ) ^ (s t)) by
      simp only [F]
      ring]
    rw [norm_mul, hmultiplierNorm]
    ring
  have hFNormSummable : Summable fun n : ℕ => ∫ t : ℝ, ‖F n t‖ := by
    refine (hsum.norm.mul_right
      (x ^ alpha * ∫ t : ℝ, ‖phiLine t‖)).congr ?_
    intro n
    rw [hFNormIntegral]
    ring
  have hFHasSum (t : ℝ) : HasSum (fun n : ℕ => F n t) (G t) := by
    have hline : LSeriesSummable a (s t) :=
      hsum.of_re_le_re (by simp [s])
    have h := (hline.LSeriesHasSum.mul_right (phiLine t)).mul_right
      ((x : ℂ) ^ (s t))
    simpa [F, G] using h
  have hinterchange : HasSum (fun n : ℕ => ∫ t : ℝ, F n t)
      (∫ t : ℝ, G t) := by
    have h := hasSum_integral_of_summable_integral_norm hFIntegrable hFNormSummable
    rw [← integral_congr_ae
      (ae_of_all _ fun t => (hFHasSum t).tsum_eq)]
    exact h
  have hterm (n : ℕ) :
      (((2 * Real.pi : ℝ) : ℂ)⁻¹) * (∫ t : ℝ, F n t) =
        a n * phi ((n : ℝ) / x) := by
    rcases eq_or_ne n 0 with rfl | hn
    · simp [ha0, F]
    · have hnReal : (0 : ℝ) < n := by
        exact_mod_cast Nat.pos_of_ne_zero hn
      have hratio : 0 < (n : ℝ) / x := div_pos hnReal hx
      have hpoint (t : ℝ) : F n t =
          a n * (((n : ℝ) / x : ℝ) : ℂ) ^ (-(s t)) * phiLine t := by
        dsimp only [F]
        rw [LSeries.term_def₀ ha0, cpow_neg_div_of_pos hnReal hx]
        simp only [Complex.ofReal_natCast]
        ring
      have hintegral : (∫ t : ℝ, F n t) =
          a n * ∫ t : ℝ,
            (((n : ℝ) / x : ℝ) : ℂ) ^ (-(s t)) * phiLine t := by
        calc
          (∫ t : ℝ, F n t) = ∫ t : ℝ,
              a n * ((((n : ℝ) / x : ℝ) : ℂ) ^ (-(s t)) * phiLine t) := by
            apply integral_congr_ae
            exact ae_of_all _ fun t => by rw [hpoint]; ring
          _ = a n * ∫ t : ℝ,
              (((n : ℝ) / x : ℝ) : ℂ) ^ (-(s t)) * phiLine t :=
            MeasureTheory.integral_const_mul _ _
      have hinversion := mellinInv_mellin_eq alpha phi hratio hphi
        hphiVertical (hphiContinuous.continuousAt)
      have hinversion' :
          (((2 * Real.pi : ℝ) : ℂ)⁻¹) *
              (∫ t : ℝ,
                (((n : ℝ) / x : ℝ) : ℂ) ^ (-(s t)) * phiLine t) =
            phi ((n : ℝ) / x) := by
        simpa [mellinInv, s, phiLine, smul_eq_mul, div_eq_mul_inv,
          mul_comm] using hinversion
      rw [hintegral, ← mul_assoc, mul_comm _ (a n), mul_assoc,
        hinversion']
  have hscaled := hinterchange.mul_left (((2 * Real.pi : ℝ) : ℂ)⁻¹)
  have hsumSmoothed : HasSum (fun n : ℕ =>
      a n * phi ((n : ℝ) / x))
      ((((2 * Real.pi : ℝ) : ℂ)⁻¹) * ∫ t : ℝ, G t) :=
    hscaled.congr_fun fun n => (hterm n).symm
  simpa [G, phiLine, s] using hsumSmoothed.tsum_eq

end

section
open Complex Set
open scoped ContDiff

section GoldfeldPlateauMellin

/--
A smooth bump centered at `1 / 2`, with inner radius `1 / 2` and outer radius `3 / 2`. It equals
one on `[0, 1]` and vanishes outside `(-1, 2)`.
-/
noncomputable def goldfeldPlateauBump : ContDiffBump (1 / 2 : ℝ) :=
  ⟨1 / 2, 3 / 2, by norm_num, by norm_num⟩

end GoldfeldPlateauMellin

/--
The real-valued smooth cutoff used in Goldfeld's smoothed sum. It equals one on `[0, 1]`,
vanishes for arguments at least `2`, and has compact support.
-/
noncomputable def goldfeldPlateau : ℝ → ℝ := goldfeldPlateauBump

theorem goldfeldPlateau_contDiff : ContDiff ℝ ∞ goldfeldPlateau := by
  simpa [goldfeldPlateau] using
    (goldfeldPlateauBump.contDiff :
      ContDiff ℝ ∞ (goldfeldPlateauBump : ℝ → ℝ))

theorem goldfeldPlateau_range : Set.range goldfeldPlateau ⊆ Icc 0 1 := by
  rintro _ ⟨y, rfl⟩
  exact ⟨goldfeldPlateauBump.nonneg,
    goldfeldPlateauBump.le_one⟩

theorem goldfeldPlateau_nonneg (y : ℝ) : 0 ≤ goldfeldPlateau y :=
  (goldfeldPlateau_range ⟨y, rfl⟩).1

theorem goldfeldPlateau_le_one (y : ℝ) : goldfeldPlateau y ≤ 1 :=
  (goldfeldPlateau_range ⟨y, rfl⟩).2

theorem goldfeldPlateau_eq_one {y : ℝ} (hy0 : 0 ≤ y) (hy1 : y ≤ 1) :
    goldfeldPlateau y = 1 := by
  apply goldfeldPlateauBump.one_of_mem_closedBall
  rw [Metric.mem_closedBall, Real.dist_eq]
  simp only [goldfeldPlateauBump]
  rw [abs_le]
  constructor <;> linarith

theorem goldfeldPlateau_eq_zero {y : ℝ} (hy : 2 ≤ y) :
    goldfeldPlateau y = 0 := by
  apply goldfeldPlateauBump.zero_of_le_dist
  rw [Real.dist_eq]
  simp only [goldfeldPlateauBump]
  rw [abs_of_nonneg (by linarith : 0 ≤ y - 1 / 2)]
  linarith

theorem goldfeldPlateau_hasCompactSupport :
    HasCompactSupport goldfeldPlateau := by
  simpa [goldfeldPlateau] using goldfeldPlateauBump.hasCompactSupport

/--
The derivative of the real plateau cutoff, regarded as a complex-valued function for Mellin
transformation.
-/
noncomputable def goldfeldPlateauDerivativeComplex : ℝ → ℂ :=
  fun y => ((deriv goldfeldPlateau) y : ℂ)

/--
The weighted cutoff derivative `y * goldfeldPlateau' y`, viewed in `ℂ`. The extra factor of `y`
shifts the Mellin parameter by one.
-/
noncomputable def goldfeldMellinDerivativeWeight (y : ℝ) : ℂ :=
  (y : ℂ) * goldfeldPlateauDerivativeComplex y

theorem goldfeldPlateau_deriv_contDiff :
    ContDiff ℝ ∞ (deriv goldfeldPlateau) :=
  (contDiff_infty_iff_deriv.mp goldfeldPlateau_contDiff).2

theorem goldfeldPlateau_deriv_eq_zero_of_pos_of_lt_one
    {y : ℝ} (hy0 : 0 < y) (hy1 : y < 1) :
    deriv goldfeldPlateau y = 0 := by
  have hconst : HasDerivAt (fun _ : ℝ => (1 : ℝ)) 0 y := hasDerivAt_const y 1
  have h := hconst.congr_of_eventuallyEq
    (show (fun z : ℝ => goldfeldPlateau z) =ᶠ[𝓝 y] (fun _ => (1 : ℝ)) by
      filter_upwards [Ioo_mem_nhds hy0 hy1] with z hz
      exact goldfeldPlateau_eq_one hz.1.le hz.2.le)
  exact h.deriv

theorem goldfeldPlateau_deriv_eq_zero_of_two_lt
    {y : ℝ} (hy : 2 < y) : deriv goldfeldPlateau y = 0 := by
  have hconst : HasDerivAt (fun _ : ℝ => (0 : ℝ)) 0 y := hasDerivAt_const y 0
  have h := hconst.congr_of_eventuallyEq
    (show (fun z : ℝ => goldfeldPlateau z) =ᶠ[𝓝 y] (fun _ => (0 : ℝ)) by
      filter_upwards [Ioi_mem_nhds hy] with z hz
      exact goldfeldPlateau_eq_zero hz.le)
  exact h.deriv

/--
The Mellin transform of the cutoff derivative at `s + 1`, equivalently the Mellin transform of
`y * goldfeldPlateau' y` at `s`.
-/
noncomputable def goldfeldDerivativeMellin (s : ℂ) : ℂ :=
  mellin goldfeldPlateauDerivativeComplex (s + 1)

theorem goldfeldDerivativeMellin_eq_weight (s : ℂ) :
    goldfeldDerivativeMellin s = mellin goldfeldMellinDerivativeWeight s := by
  unfold goldfeldDerivativeMellin goldfeldMellinDerivativeWeight
  rw [← mellin_cpow_smul]
  simp only [Complex.cpow_one, smul_eq_mul]

/--
The meromorphic continuation candidate `-goldfeldDerivativeMellin s / s`, obtained by
integration by parts. Its germ has residue one at the origin, while Lean's totalized division
assigns the point value zero there.
-/
noncomputable def goldfeldPlateauMellinContinuation (s : ℂ) : ℂ :=
  -goldfeldDerivativeMellin s / s

section GoldfeldPlateauMellin

/-- The plateau cutoff regarded as a complex-valued function, without changing its real values. -/
noncomputable def goldfeldPlateauComplex : ℝ → ℂ :=
  fun y => goldfeldPlateau y

theorem goldfeldPlateauComplex_locallyIntegrable :
    LocallyIntegrableOn goldfeldPlateauComplex (Ioi (0 : ℝ)) := by
  apply (Complex.continuous_ofReal.comp goldfeldPlateau_contDiff.continuous).continuousOn
    |>.locallyIntegrableOn measurableSet_Ioi

theorem goldfeldPlateauComplex_isBigO_top :
    ∀ a : ℝ, goldfeldPlateauComplex =O[atTop] (fun x : ℝ => x ^ (-a)) := by
  intro a
  refine Filter.Eventually.isBigO ?_
  filter_upwards [eventually_gt_atTop (2 : ℝ)] with y hy
  change ‖(goldfeldPlateau y : ℂ)‖ ≤ _
  rw [goldfeldPlateau_eq_zero hy.le]
  simp only [Complex.ofReal_zero, norm_zero]
  exact Real.rpow_nonneg (by linarith) _

theorem goldfeldPlateauComplex_isBigO_zero :
    goldfeldPlateauComplex =O[nhdsWithin 0 (Ioi 0)]
      (fun _ : ℝ => (1 : ℝ)) := by
  refine Filter.Eventually.isBigO ?_
  filter_upwards [] with y
  change ‖(goldfeldPlateau y : ℂ)‖ ≤ 1
  calc
    ‖(goldfeldPlateau y : ℂ)‖ = |goldfeldPlateau y| := RCLike.norm_ofReal _
    _ = goldfeldPlateau y := abs_of_nonneg (goldfeldPlateau_nonneg y)
    _ ≤ 1 := goldfeldPlateau_le_one y

theorem goldfeldPlateau_deriv_hasCompactSupport :
    HasCompactSupport (deriv goldfeldPlateau) :=
  goldfeldPlateau_hasCompactSupport.deriv

theorem goldfeldPlateauDerivativeComplex_locallyIntegrable :
    LocallyIntegrableOn goldfeldPlateauDerivativeComplex (Ioi (0 : ℝ)) := by
  have hcont : Continuous (deriv goldfeldPlateau) :=
    goldfeldPlateau_contDiff.continuous_deriv (by norm_num)
  exact (Complex.continuous_ofReal.comp hcont).continuousOn.locallyIntegrableOn
    (μ := volume) measurableSet_Ioi

theorem goldfeldPlateauDerivativeComplex_isBigO_top :
    ∀ a : ℝ, goldfeldPlateauDerivativeComplex =O[atTop]
      (fun x : ℝ => x ^ (-a)) := by
  intro a
  refine Filter.Eventually.isBigO ?_
  filter_upwards [eventually_gt_atTop (2 : ℝ)] with y hy
  change ‖((deriv goldfeldPlateau) y : ℂ)‖ ≤ _
  rw [goldfeldPlateau_deriv_eq_zero_of_two_lt hy]
  simp only [Complex.ofReal_zero, norm_zero]
  exact Real.rpow_nonneg (by linarith) _

theorem goldfeldPlateauDerivativeComplex_isBigO_zero :
    ∀ b : ℝ, goldfeldPlateauDerivativeComplex =O[nhdsWithin 0 (Ioi 0)]
      (fun x : ℝ => x ^ (-b)) := by
  intro b
  refine Filter.Eventually.isBigO ?_
  filter_upwards [Ioo_mem_nhdsGT (by norm_num : (0 : ℝ) < 1)] with y hy
  change ‖((deriv goldfeldPlateau) y : ℂ)‖ ≤ _
  rw [goldfeldPlateau_deriv_eq_zero_of_pos_of_lt_one hy.1 hy.2]
  simp only [Complex.ofReal_zero, norm_zero]
  exact Real.rpow_nonneg hy.1.le _

theorem goldfeldPlateauDerivativeComplex_mellin_differentiableAt
    (s : ℂ) :
    DifferentiableAt ℂ (mellin goldfeldPlateauDerivativeComplex) s := by
  refine mellin_differentiableAt_of_isBigO_rpow
    (a := s.re + 1) (b := s.re - 1)
    goldfeldPlateauDerivativeComplex_locallyIntegrable ?_ ?_ ?_ ?_
  · simpa using goldfeldPlateauDerivativeComplex_isBigO_top (s.re + 1)
  · linarith
  · simpa using goldfeldPlateauDerivativeComplex_isBigO_zero (s.re - 1)
  · linarith

theorem goldfeldDerivativeMellin_differentiableAt (s : ℂ) :
    DifferentiableAt ℂ goldfeldDerivativeMellin s :=
  (goldfeldPlateauDerivativeComplex_mellin_differentiableAt (s + 1)).comp s
    ((hasDerivAt_id' s).add_const 1).differentiableAt

theorem goldfeldDerivativeMellin_zero :
    goldfeldDerivativeMellin 0 = -1 := by
  unfold goldfeldDerivativeMellin
  rw [show (0 : ℂ) + 1 = 1 by norm_num]
  rw [mellin]
  simp only [sub_self, cpow_zero, one_smul]
  have h := goldfeldPlateau_hasCompactSupport.integral_Ioi_deriv_eq
    (goldfeldPlateau_contDiff.of_le (by norm_num)) (0 : ℝ)
  unfold goldfeldPlateauDerivativeComplex
  change (∫ t : ℝ in Ioi 0, ((deriv goldfeldPlateau t : ℝ) : ℂ)) = -1
  have hcast := (integral_ofReal (𝕜 := ℂ) (μ := volume.restrict (Ioi (0 : ℝ)))
    (f := fun t : ℝ => (deriv goldfeldPlateau) t))
  calc
    (∫ t : ℝ in Ioi 0, (((deriv goldfeldPlateau) t : ℝ) : ℂ)) =
        Complex.ofReal (∫ t : ℝ in Ioi 0, (deriv goldfeldPlateau) t) :=
          hcast
    _ = -Complex.ofReal (goldfeldPlateau 0) := by
      simpa using congrArg Complex.ofReal h
    _ = -1 := by
      rw [goldfeldPlateau_eq_one (by norm_num) (by norm_num)]
      norm_num

end GoldfeldPlateauMellin

/--
The Mellin integral of the plateau cutoff over the positive real axis. On `re s > 0`, this
convergent integral agrees with the meromorphic continuation candidate.
-/
noncomputable def goldfeldPlateauMellin (s : ℂ) : ℂ :=
  mellin goldfeldPlateauComplex s

theorem mellinConvergent_goldfeldPlateauComplex {s : ℂ} (hs : 0 < s.re) :
    MellinConvergent goldfeldPlateauComplex s := by
  refine mellinConvergent_of_isBigO_rpow (a := s.re + 1) (b := 0)
    goldfeldPlateauComplex_locallyIntegrable ?_ ?_ ?_ ?_
  · simpa using goldfeldPlateauComplex_isBigO_top (s.re + 1)
  · linarith
  · simpa using goldfeldPlateauComplex_isBigO_zero
  · linarith

theorem differentiable_goldfeldDerivativeMellin :
    Differentiable ℂ goldfeldDerivativeMellin :=
  fun s => goldfeldDerivativeMellin_differentiableAt s

theorem goldfeldPlateauMellinContinuation_eq_plateauMellin {s : ℂ} (hs : 0 < s.re) :
    goldfeldPlateauMellinContinuation s = goldfeldPlateauMellin s := by
  have hs0 : s ≠ 0 := by
    intro h
    subst s
    simp at hs
  let u : ℝ → ℂ := fun x => (x : ℂ) ^ s
  let v : ℝ → ℂ := goldfeldPlateauComplex
  let uD : ℝ → ℂ := fun x => s * (x : ℂ) ^ (s - 1)
  let vD : ℝ → ℂ := fun x => Complex.ofReal ((deriv goldfeldPlateau) x)
  have hu : ∀ x ∈ Ioi (0 : ℝ), HasDerivAt u (uD x) x := by
    intro x hx
    exact hasDerivAt_ofReal_cpow_const hx.ne' hs0
  have hv : ∀ x ∈ Ioi (0 : ℝ), HasDerivAt v (vD x) x := by
    intro x hx
    exact (goldfeldPlateau_contDiff.differentiable (by simp)).differentiableAt
      |>.hasDerivAt.ofReal_comp
  have hvD_cont : Continuous vD :=
    Complex.continuous_ofReal.comp goldfeldPlateau_deriv_contDiff.continuous
  have hvD_compact : HasCompactSupport vD := by
    change HasCompactSupport (Complex.ofReal ∘ deriv goldfeldPlateau)
    exact goldfeldPlateau_deriv_hasCompactSupport.comp_left
      Complex.ofReal_zero
  have huvD : IntegrableOn (u * vD) (Ioi 0) := by
    apply Integrable.integrableOn
    exact ((Complex.continuous_ofReal_cpow_const hs).mul hvD_cont)
      |>.integrable_of_hasCompactSupport hvD_compact.mul_left
  have huDv : IntegrableOn (uD * v) (Ioi 0) := by
    have hm := mellinConvergent_goldfeldPlateauComplex hs
    rw [MellinConvergent] at hm
    change Integrable
      (fun x : ℝ => (s * (x : ℂ) ^ (s - 1)) * goldfeldPlateauComplex x)
      (volume.restrict (Ioi 0))
    simpa only [smul_eq_mul, mul_assoc] using hm.const_mul s
  have hzero : Tendsto (u * v) (𝓝[>] (0 : ℝ)) (𝓝 0) := by
    have hp : Tendsto u (𝓝[>] (0 : ℝ)) (𝓝 0) := by
      have hc := (Complex.continuousAt_ofReal_cpow_const 0 s (Or.inl hs)).tendsto
      change Tendsto u (𝓝 0 ⊓ 𝓟 (Ioi 0)) (𝓝 0)
      simpa [u, Complex.zero_cpow hs0] using hc.mono_left inf_le_left
    have hv0 : Tendsto v (𝓝[>] (0 : ℝ)) (𝓝 1) := by
      have hphi0 : goldfeldPlateauComplex 0 = 1 := by
        change (goldfeldPlateau 0 : ℂ) = 1
        rw [goldfeldPlateau_eq_one (by norm_num) (by norm_num)]
        norm_num
      have hc : Tendsto goldfeldPlateauComplex (𝓝 (0 : ℝ))
          (𝓝 (goldfeldPlateauComplex 0)) :=
        (Complex.continuous_ofReal.comp goldfeldPlateau_contDiff.continuous)
          |>.continuousAt.tendsto
      change Tendsto v (𝓝 0 ⊓ 𝓟 (Ioi 0)) (𝓝 1)
      simpa [v, hphi0] using hc.mono_left inf_le_left
    change Tendsto (fun x => u x * v x) (𝓝[>] (0 : ℝ)) (𝓝 0)
    simpa using hp.mul hv0
  have hinfty : Tendsto (u * v) atTop (𝓝 0) := by
    have heq : u * v =ᶠ[atTop] 0 := by
      filter_upwards [eventually_ge_atTop (2 : ℝ)] with x hx
      simp [Pi.mul_apply, v, goldfeldPlateauComplex,
        goldfeldPlateau_eq_zero hx]
    exact heq.tendsto
  have hibp := MeasureTheory.integral_Ioi_mul_deriv_eq_deriv_mul
    (a := 0) hu hv huvD huDv hzero hinfty
  have hweight : mellin goldfeldMellinDerivativeWeight s =
      ∫ x : ℝ in Ioi 0, u x * vD x := by
    rw [mellin]
    apply setIntegral_congr_fun measurableSet_Ioi
    intro x hx
    simp only [goldfeldMellinDerivativeWeight, goldfeldPlateauDerivativeComplex,
      u, vD, smul_eq_mul]
    have hpow : (x : ℂ) ^ (s - 1) * (x : ℂ) = (x : ℂ) ^ s := by
      calc
        (x : ℂ) ^ (s - 1) * (x : ℂ) =
            (x : ℂ) ^ (s - 1) * (x : ℂ) ^ (1 : ℂ) := by
              rw [Complex.cpow_one]
        _ = (x : ℂ) ^ ((s - 1) + 1) :=
          (Complex.cpow_add _ _ (Complex.ofReal_ne_zero.mpr hx.ne')).symm
        _ = (x : ℂ) ^ s := by rw [sub_add_cancel]
    rw [← mul_assoc, hpow]
  have hraw : ∫ x : ℝ in Ioi 0, uD x * v x =
      s * ∫ x : ℝ in Ioi 0,
        (x : ℂ) ^ (s - 1) * goldfeldPlateauComplex x := by
    rw [← integral_const_mul]
    apply setIntegral_congr_fun measurableSet_Ioi
    intro x hx
    simp [uD, v, mul_assoc]
  rw [hraw] at hibp
  rw [goldfeldPlateauMellinContinuation, goldfeldDerivativeMellin_eq_weight, hweight,
    goldfeldPlateauMellin, mellin]
  simp only [smul_eq_mul, zero_sub, sub_zero] at hibp ⊢
  rw [hibp]
  field_simp [hs0]

theorem meromorphicOn_goldfeldPlateauMellinContinuation :
    MeromorphicOn goldfeldPlateauMellinContinuation Set.univ := by
  have hJ : AnalyticOnNhd ℂ goldfeldDerivativeMellin Set.univ :=
    Complex.analyticOnNhd_univ_iff_differentiable.mpr
      (fun s => goldfeldDerivativeMellin_differentiableAt s)
  have hneg : AnalyticOnNhd ℂ (fun s : ℂ => -goldfeldDerivativeMellin s) Set.univ :=
    hJ.neg
  exact hneg.meromorphicOn.div analyticOnNhd_id.meromorphicOn

theorem analyticAt_goldfeldPlateauMellinContinuation_of_ne_zero {s : ℂ} (hs : s ≠ 0) :
    AnalyticAt ℂ goldfeldPlateauMellinContinuation s := by
  have hJ : AnalyticOnNhd ℂ goldfeldDerivativeMellin Set.univ :=
    Complex.analyticOnNhd_univ_iff_differentiable.mpr
      (fun z => goldfeldDerivativeMellin_differentiableAt z)
  have hneg : AnalyticOnNhd ℂ (fun z : ℂ => -goldfeldDerivativeMellin z) {0}ᶜ :=
    hJ.neg.mono (by intro z hz; exact Set.mem_univ z)
  have hdiv : AnalyticOnNhd ℂ goldfeldPlateauMellinContinuation {0}ᶜ := by
    change AnalyticOnNhd ℂ (fun z : ℂ => -goldfeldDerivativeMellin z / z) {0}ᶜ
    exact hneg.div (analyticOnNhd_id.mono (by intro z hz; exact Set.mem_univ z))
      (fun z hz => hz)
  exact hdiv s (by simp [hs])

theorem tendsto_mul_goldfeldPlateauMellinContinuation_nhdsNE_zero :
    Tendsto (fun s => s * goldfeldPlateauMellinContinuation s) (𝓝[≠] 0) (𝓝 1) := by
  have hcont : Tendsto goldfeldDerivativeMellin (𝓝 0) (𝓝 (-(1 : ℂ))) := by
    have hc := (goldfeldDerivativeMellin_differentiableAt 0).continuousAt
    change Tendsto goldfeldDerivativeMellin (𝓝 0)
      (𝓝 (goldfeldDerivativeMellin 0)) at hc
    simpa only [goldfeldDerivativeMellin_zero] using hc
  have hpunct : Tendsto (fun s : ℂ => s * goldfeldPlateauMellinContinuation s)
      (𝓝[≠] 0) (𝓝 (1 : ℂ)) := by
    have heq : (fun s : ℂ => s * goldfeldPlateauMellinContinuation s) =ᶠ[𝓝[≠] 0]
        (fun s => -goldfeldDerivativeMellin s) := by
      filter_upwards [self_mem_nhdsWithin] with s hs
      simp only [goldfeldPlateauMellinContinuation]
      calc
        s * (-goldfeldDerivativeMellin s / s) =
            (-goldfeldDerivativeMellin s) * s / s := by ring
        _ = -goldfeldDerivativeMellin s := mul_div_cancel_right₀ _ hs
    have hneg : Tendsto (fun s : ℂ => -goldfeldDerivativeMellin s)
        (𝓝[≠] 0) (𝓝 (1 : ℂ)) := by
      simpa using ((hcont.mono_left
        (nhdsWithin_le_nhds : 𝓝[≠] (0 : ℂ) ≤ 𝓝 0)).neg)
    exact hneg.congr' heq.symm
  exact hpunct

/--
A Mellin continuation together with its analytic guarantees: agreement with the raw transform on
the right half-plane, meromorphy, analyticity off zero, and residue one at zero. It also records
arbitrary polynomial decay on the line `re = -1` and identifies the continuation with the
integration-by-parts candidate.
-/
structure GoldfeldMellinContinuationData where
  /--
  The meromorphic continuation of the plateau cutoff's Mellin transform, identified with
  `goldfeldPlateauMellinContinuation` by the accompanying proof fields.
  -/
  Phi : ℂ → ℂ
  agrees_on_right : ∀ {s : ℂ}, 0 < s.re → Phi s = goldfeldPlateauMellin s
  eq_plateauMellinContinuation : ∀ s, Phi s = goldfeldPlateauMellinContinuation s
  meromorphic : MeromorphicOn Phi Set.univ
  analytic_off_zero : ∀ {s : ℂ}, s ≠ 0 → AnalyticAt ℂ Phi s
  residue_one : Tendsto (fun s => s * Phi s) (𝓝[≠] 0) (𝓝 1)
  decay_on_neg_one : ∀ (A : ℕ), 1 ≤ A →
    ∃ C : ℝ, 0 < C ∧ ∀ t : ℝ,
      ‖Phi ((-1 : ℂ) + t * I)‖ ≤ C / (1 + |t|) ^ A

/--
Packages the explicit Mellin continuation candidate with its established analytic properties,
assuming the supplied arbitrary-order polynomial decay bounds on `re = -1`.
-/
noncomputable def goldfeldMellinContinuationDataOfDecay
    (hdecay : ∀ (A : ℕ), 1 ≤ A → ∃ C : ℝ, 0 < C ∧ ∀ t : ℝ,
      ‖goldfeldPlateauMellinContinuation ((-1 : ℂ) + t * I)‖ ≤ C / (1 + |t|) ^ A) :
    GoldfeldMellinContinuationData :=
  { Phi := goldfeldPlateauMellinContinuation
    agrees_on_right := fun hs => goldfeldPlateauMellinContinuation_eq_plateauMellin hs
    eq_plateauMellinContinuation := fun _ => rfl
    meromorphic := meromorphicOn_goldfeldPlateauMellinContinuation
    analytic_off_zero := fun hs => analyticAt_goldfeldPlateauMellinContinuation_of_ne_zero hs
    residue_one := tendsto_mul_goldfeldPlateauMellinContinuation_nhdsNE_zero
    decay_on_neg_one := hdecay }

end

section
open Complex Set Real
open scoped ContDiff SchwartzMap FourierTransform

section GoldfeldPlateauMellinDecay

/--
The logarithmic kernel `exp u * goldfeldMellinDerivativeWeight (exp (-u))`. The substitution `y
= exp (-u)` makes this the Fourier-side kernel for the Mellin transform on `re = -1`.
-/
noncomputable def goldfeldLogKernel (u : ℝ) : ℂ :=
  (Real.exp u : ℂ) * goldfeldMellinDerivativeWeight (Real.exp (-u))

theorem goldfeldMellinDerivativeWeight_contDiff :
    ContDiff ℝ ∞ goldfeldMellinDerivativeWeight := by
  have hd : ContDiff ℝ ∞ goldfeldPlateauDerivativeComplex :=
    Complex.ofRealCLM.contDiff.comp goldfeldPlateau_deriv_contDiff
  unfold goldfeldMellinDerivativeWeight
  exact (Complex.ofRealCLM.contDiff.comp contDiff_id).mul hd

theorem goldfeldLogKernel_contDiff :
    ContDiff ℝ ∞ goldfeldLogKernel := by
  unfold goldfeldLogKernel
  exact (Complex.ofRealCLM.contDiff.comp contDiff_id.exp).mul
    (goldfeldMellinDerivativeWeight_contDiff.comp contDiff_id.neg.exp)

theorem goldfeldLogKernel_eq_zero_of_pos {u : ℝ} (hu : 0 < u) :
    goldfeldLogKernel u = 0 := by
  have harg : 0 < Real.exp (-u) := Real.exp_pos _
  have hlt : Real.exp (-u) < 1 := by
    rw [Real.exp_lt_one_iff]
    linarith
  have hd := goldfeldPlateau_deriv_eq_zero_of_pos_of_lt_one harg hlt
  simp [goldfeldLogKernel, goldfeldMellinDerivativeWeight,
    goldfeldPlateauDerivativeComplex, hd]

theorem goldfeldLogKernel_eq_zero_of_lt_neg_log_two
    {u : ℝ} (hu : u < -Real.log 2) : goldfeldLogKernel u = 0 := by
  have harg : 0 < Real.exp (-u) := Real.exp_pos _
  have hlog : Real.log 2 < -u := by linarith
  have hgt : 2 < Real.exp (-u) := by
    rw [← Real.exp_log (by norm_num : (0 : ℝ) < 2)]
    exact (Real.exp_lt_exp).2 hlog
  have hd := goldfeldPlateau_deriv_eq_zero_of_two_lt hgt
  simp [goldfeldLogKernel, goldfeldMellinDerivativeWeight,
    goldfeldPlateauDerivativeComplex, hd]

theorem goldfeldLogKernel_support_subset :
    Function.support goldfeldLogKernel ⊆ Icc (-Real.log 2) 0 := by
  refine Function.support_subset_iff'.2 fun u hu => ?_
  simp only [mem_Icc, not_and_or, not_le] at hu
  exact hu.elim
    (goldfeldLogKernel_eq_zero_of_lt_neg_log_two)
    (goldfeldLogKernel_eq_zero_of_pos)

theorem goldfeldLogKernel_hasCompactSupport :
    HasCompactSupport goldfeldLogKernel := by
  apply HasCompactSupport.of_support_subset_isCompact (K := Icc (-Real.log 2) 0)
    isCompact_Icc
  exact goldfeldLogKernel_support_subset

/--
The logarithmic Mellin kernel as a Schwartz function, using its smoothness and compact support
in `[-log 2, 0]`.
-/
noncomputable def goldfeldLogKernelSchwartz : 𝓢(ℝ, ℂ) :=
  goldfeldLogKernel_hasCompactSupport.toSchwartzMap
    goldfeldLogKernel_contDiff

theorem goldfeldDerivativeMellin_on_neg_one (t : ℝ) :
    goldfeldDerivativeMellin ((-1 : ℂ) + t * I) =
      𝓕 goldfeldLogKernelSchwartz (t / (2 * π)) := by
  calc
    goldfeldDerivativeMellin ((-1 : ℂ) + t * I) =
        mellin goldfeldMellinDerivativeWeight ((-1 : ℂ) + t * I) :=
      goldfeldDerivativeMellin_eq_weight _
    _ = 𝓕 (fun u : ℝ =>
        Real.exp (-((-1 : ℂ) + t * I).re * u) •
          goldfeldMellinDerivativeWeight (Real.exp (-u)))
        (((-1 : ℂ) + t * I).im / (2 * π)) :=
      mellin_eq_fourier goldfeldMellinDerivativeWeight
    _ = 𝓕 goldfeldLogKernelSchwartz (t / (2 * π)) := by
      norm_num
      rw [SchwartzMap.fourier_coe]
      apply congrArg (fun f : ℝ → ℂ => 𝓕 f (t / (2 * π)))
      funext u
      simp [goldfeldLogKernelSchwartz,
        goldfeldLogKernel]

theorem schwartz_pointwise_bound (f : 𝓢(ℝ, ℂ)) (A : ℕ) :
    ∃ C : ℝ, 0 < C ∧ ∀ x : ℝ,
      ‖(f : ℝ → ℂ) x‖ ≤ C / (1 + |x|) ^ A := by
  obtain ⟨C, hC, hbound⟩ := f.decay A 0
  obtain ⟨C0, hC0, hbound0⟩ := f.decay 0 0
  refine ⟨max (C * 2 ^ A) (C0 * 2 ^ A), by positivity, ?_⟩
  intro x
  by_cases hx : 1 ≤ |x|
  · have hpow : (1 + |x|) ^ A ≤ (2 * |x|) ^ A := by
      apply pow_le_pow_left₀ (by positivity) _ _
      linarith
    have hprod := hbound x
    simp only [norm_iteratedFDeriv_zero, Real.norm_eq_abs] at hprod
    have hxpos : 0 < |x| := lt_of_lt_of_le (by norm_num) hx
    have hnorm : ‖(f : ℝ → ℂ) x‖ ≤ C / |x| ^ A := by
      apply (le_div_iff₀ (pow_pos hxpos A)).2
      simpa [mul_comm] using hprod
    calc
      ‖(f : ℝ → ℂ) x‖ ≤ C / |x| ^ A := hnorm
      _ ≤ (C * 2 ^ A) / (1 + |x|) ^ A := by
        apply (div_le_div_iff₀ (pow_pos hxpos A) (by positivity)).2
        calc
          C * (1 + |x|) ^ A ≤ C * (2 * |x|) ^ A :=
            mul_le_mul_of_nonneg_left hpow hC.le
          _ = (C * 2 ^ A) * |x| ^ A := by rw [mul_pow]; ring
      _ ≤ max (C * 2 ^ A) (C0 * 2 ^ A) / (1 + |x|) ^ A := by
        apply (div_le_div_iff₀ (by positivity) (by positivity)).2
        exact mul_le_mul_of_nonneg_right (le_max_left _ _) (by positivity)
  · have hx' : |x| < 1 := lt_of_not_ge hx
    have h0 := hbound0 x
    have h0' : ‖(f : ℝ → ℂ) x‖ ≤ C0 := by
      simpa [norm_iteratedFDeriv_zero] using h0
    have hsmall : C0 ≤ C0 * 2 ^ A / (1 + |x|) ^ A := by
      have hden : (1 + |x|) ^ A ≤ 2 ^ A := by
        apply pow_le_pow_left₀ (by positivity) _ _
        linarith
      have hdenpos : 0 < (1 + |x|) ^ A := by positivity
      apply (le_div_iff₀ hdenpos).2
      exact mul_le_mul_of_nonneg_left hden hC0.le
    have hmax : C0 * 2 ^ A / (1 + |x|) ^ A ≤
        max (C * 2 ^ A) (C0 * 2 ^ A) / (1 + |x|) ^ A := by
      apply (div_le_div_iff₀ (by positivity) (by positivity)).2
      exact mul_le_mul_of_nonneg_right (le_max_right _ _) (by positivity)
    calc
      ‖(f : ℝ → ℂ) x‖ ≤ C0 := h0'
      _ ≤ C0 * 2 ^ A / (1 + |x|) ^ A := hsmall
      _ ≤ max (C * 2 ^ A) (C0 * 2 ^ A) / (1 + |x|) ^ A := hmax

end GoldfeldPlateauMellinDecay

theorem goldfeldPlateauMellinContinuation_decay_on_neg_one (A : ℕ) (_hA : 1 ≤ A) :
    ∃ C : ℝ, 0 < C ∧ ∀ t : ℝ,
      ‖goldfeldPlateauMellinContinuation ((-1 : ℂ) + t * I)‖ ≤ C / (1 + |t|) ^ A := by
  obtain ⟨C, hC, hpoint⟩ :=
    schwartz_pointwise_bound
      (𝓕 goldfeldLogKernelSchwartz) A
  refine ⟨C * (2 * π) ^ A, by positivity, ?_⟩
  intro t
  have hs : ((-1 : ℂ) + t * I) ≠ 0 := by
    intro h
    have := congrArg Complex.re h
    norm_num at this
  have hnorms : 1 ≤ ‖(-1 : ℂ) + t * I‖ := by
    have h := Complex.abs_re_le_norm ((-1 : ℂ) + t * I)
    norm_num at h ⊢
    exact h
  rw [goldfeldPlateauMellinContinuation, norm_div, norm_neg]
  calc
    ‖goldfeldDerivativeMellin ((-1 : ℂ) + t * I)‖ /
        ‖(-1 : ℂ) + t * I‖ ≤
      ‖goldfeldDerivativeMellin ((-1 : ℂ) + t * I)‖ :=
        (div_le_self (norm_nonneg _) hnorms)
    _ = ‖𝓕 goldfeldLogKernelSchwartz (t / (2 * π))‖ := by
      rw [goldfeldDerivativeMellin_on_neg_one]
    _ ≤ C / (1 + |t / (2 * π)|) ^ A := hpoint _
    _ ≤ C * (2 * π) ^ A / (1 + |t|) ^ A := by
      have hpi : 0 < (2 * π : ℝ) := by positivity
      have hpi1 : (1 : ℝ) ≤ 2 * π := by
        nlinarith [two_le_pi]
      rw [abs_div, abs_of_pos hpi]
      have hscale : 1 + |t| ≤ (2 * π) * (1 + |t| / (2 * π)) := by
        rw [mul_add, mul_div_cancel₀ _ (ne_of_gt hpi)]
        nlinarith
      have hpowscale : (1 + |t|) ^ A ≤
          ((2 * π) * (1 + |t| / (2 * π))) ^ A :=
        pow_le_pow_left₀ (by positivity) hscale A
      apply (div_le_div_iff₀ (by positivity) (by positivity)).2
      calc
        C * (1 + |t|) ^ A ≤
            C * ((2 * π) ^ A * (1 + |t| / (2 * π)) ^ A) := by
          apply mul_le_mul_of_nonneg_left _ hC.le
          simpa [mul_pow] using hpowscale
        _ = (C * (2 * π) ^ A) * (1 + |t| / (2 * π)) ^ A := by ring

/--
The explicit Mellin continuation with all required analytic properties and polynomial decay
bounds supplied by the proved decay estimate.
-/
noncomputable def goldfeldMellinContinuationData :
    GoldfeldMellinContinuationData :=
  goldfeldMellinContinuationDataOfDecay
    goldfeldPlateauMellinContinuation_decay_on_neg_one

end

section
open Complex Set Real
open scoped ContDiff SchwartzMap FourierTransform

section GoldfeldMellinPositiveLine

/--
The logarithmic Mellin kernel on `re = alpha`: `exp (-alpha * u)` times the weighted cutoff
derivative at `exp (-u)`.
-/
noncomputable def goldfeldPositiveLineKernel
    (alpha u : ℝ) : ℂ :=
  (Real.exp (-alpha * u) : ℂ) *
    goldfeldMellinDerivativeWeight (Real.exp (-u))

theorem goldfeldPositiveLineKernel_contDiff (alpha : ℝ) :
    ContDiff ℝ ∞ (goldfeldPositiveLineKernel alpha) := by
  unfold goldfeldPositiveLineKernel
  exact (Complex.ofRealCLM.contDiff.comp
    (contDiff_const.mul contDiff_id).exp).mul
      (goldfeldMellinDerivativeWeight_contDiff.comp
        contDiff_id.neg.exp)

theorem goldfeldPositiveLineKernel_eq_zero_of_pos
    (alpha : ℝ) {u : ℝ} (hu : 0 < u) :
    goldfeldPositiveLineKernel alpha u = 0 := by
  have harg : 0 < Real.exp (-u) := Real.exp_pos _
  have hlt : Real.exp (-u) < 1 := by
    rw [Real.exp_lt_one_iff]
    linarith
  have hd := goldfeldPlateau_deriv_eq_zero_of_pos_of_lt_one harg hlt
  simp [goldfeldPositiveLineKernel, goldfeldMellinDerivativeWeight,
    goldfeldPlateauDerivativeComplex, hd]

theorem goldfeldPositiveLineKernel_eq_zero_of_lt_neg_log_two
    (alpha : ℝ) {u : ℝ} (hu : u < -Real.log 2) :
    goldfeldPositiveLineKernel alpha u = 0 := by
  have harg : 0 < Real.exp (-u) := Real.exp_pos _
  have hlog : Real.log 2 < -u := by linarith
  have hgt : 2 < Real.exp (-u) := by
    rw [← Real.exp_log (by norm_num : (0 : ℝ) < 2)]
    exact (Real.exp_lt_exp).2 hlog
  have hd := goldfeldPlateau_deriv_eq_zero_of_two_lt hgt
  simp [goldfeldPositiveLineKernel, goldfeldMellinDerivativeWeight,
    goldfeldPlateauDerivativeComplex, hd]

theorem goldfeldPositiveLineKernel_support_subset (alpha : ℝ) :
    Function.support (goldfeldPositiveLineKernel alpha) ⊆
      Icc (-Real.log 2) 0 := by
  refine Function.support_subset_iff'.2 fun u hu => ?_
  simp only [mem_Icc, not_and_or, not_le] at hu
  exact hu.elim
    (goldfeldPositiveLineKernel_eq_zero_of_lt_neg_log_two alpha)
    (goldfeldPositiveLineKernel_eq_zero_of_pos alpha)

theorem goldfeldPositiveLineKernel_hasCompactSupport (alpha : ℝ) :
    HasCompactSupport (goldfeldPositiveLineKernel alpha) := by
  apply HasCompactSupport.of_support_subset_isCompact
    (K := Icc (-Real.log 2) 0) isCompact_Icc
  exact goldfeldPositiveLineKernel_support_subset alpha

/--
The logarithmic kernel for the line `re = alpha`, packaged as a Schwartz function. Smoothness
and compact support hold for every real `alpha`.
-/
noncomputable def goldfeldPositiveLineKernelSchwartz
    (alpha : ℝ) : 𝓢(ℝ, ℂ) :=
  (goldfeldPositiveLineKernel_hasCompactSupport alpha).toSchwartzMap
    (goldfeldPositiveLineKernel_contDiff alpha)

theorem goldfeldDerivativeMellin_on_positiveLine
    (alpha t : ℝ) :
    goldfeldDerivativeMellin ((alpha : ℂ) + t * I) =
      𝓕 (goldfeldPositiveLineKernelSchwartz alpha) (t / (2 * π)) := by
  calc
    goldfeldDerivativeMellin ((alpha : ℂ) + t * I) =
        mellin goldfeldMellinDerivativeWeight ((alpha : ℂ) + t * I) :=
      goldfeldDerivativeMellin_eq_weight _
    _ = 𝓕 (fun u : ℝ =>
        Real.exp (-((alpha : ℂ) + t * I).re * u) •
          goldfeldMellinDerivativeWeight (Real.exp (-u)))
        (((alpha : ℂ) + t * I).im / (2 * π)) :=
      mellin_eq_fourier goldfeldMellinDerivativeWeight
    _ = 𝓕 (goldfeldPositiveLineKernelSchwartz alpha) (t / (2 * π)) := by
      norm_num
      rw [SchwartzMap.fourier_coe]
      apply congrArg (fun f : ℝ → ℂ => 𝓕 f (t / (2 * π)))
      funext u
      simp [goldfeldPositiveLineKernelSchwartz,
        goldfeldPositiveLineKernel]

end GoldfeldMellinPositiveLine

theorem verticalIntegrable_goldfeldPlateauMellin
    {alpha : ℝ} (halpha : 0 < alpha) :
    VerticalIntegrable goldfeldPlateauMellin alpha := by
  let fourierLine : ℝ → ℂ := fun t =>
    𝓕 (goldfeldPositiveLineKernelSchwartz alpha) (t / (2 * π))
  let z : ℝ → ℂ := fun t => (alpha : ℂ) + t * I
  let invFactor : ℝ → ℂ := fun t => -(z t)⁻¹
  have hfourier : Integrable fourierLine := by
    have h := (𝓕 (goldfeldPositiveLineKernelSchwartz alpha)).integrable
      |>.comp_mul_right'
        (show (2 * π : ℝ)⁻¹ ≠ 0 by positivity)
    simpa [fourierLine, div_eq_mul_inv] using h
  have hzContinuous : Continuous z := by
    fun_prop
  have hzNe (t : ℝ) : z t ≠ 0 := by
    intro ht
    exact halpha.ne' (by simpa [z] using congrArg Complex.re ht)
  have hinvContinuous : Continuous invFactor :=
    (hzContinuous.inv₀ hzNe).neg
  have hzNorm (t : ℝ) : alpha ≤ ‖z t‖ := by
    have h := Complex.abs_re_le_norm (z t)
    simpa [z, abs_of_pos halpha] using h
  have hinvBound : ∀ᵐ t : ℝ, ‖invFactor t‖ ≤ alpha⁻¹ :=
    ae_of_all _ fun t => by
      change ‖-(z t)⁻¹‖ ≤ alpha⁻¹
      rw [norm_neg, norm_inv]
      exact (inv_le_inv₀ (halpha.trans_le (hzNorm t)) halpha).2 (hzNorm t)
  have hproduct : Integrable fun t => fourierLine t * invFactor t :=
    hfourier.mul_bdd hinvContinuous.aestronglyMeasurable hinvBound
  rw [VerticalIntegrable]
  refine hproduct.congr (ae_of_all _ fun t => ?_)
  have hraw : goldfeldPlateauMellin (z t) = fourierLine t * invFactor t := by
    rw [← goldfeldPlateauMellinContinuation_eq_plateauMellin (by simp [z, halpha])]
    rw [goldfeldPlateauMellinContinuation,
      goldfeldDerivativeMellin_on_positiveLine alpha t]
    simp only [fourierLine, invFactor, div_eq_mul_inv]
    ring
  simpa [z] using hraw.symm

end

section
open Complex

attribute [local instance] goldfeldLcmNeZero
/--
Goldfeld's product `zeta(s) * L(chi1, s) * L(chi, s) * L(chi1 * chi, s)`, where the product
character is taken at the common modulus.
-/
noncomputable def goldfeldFourFactorLFunction
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q) (s : ℂ) : ℂ :=
  riemannZeta s * DirichletCharacter.LFunction chi1 s *
    DirichletCharacter.LFunction chi s *
      DirichletCharacter.LFunction (DirichletCharacter.mul chi1 chi) s

/--
The Dirichlet-series coefficient obtained by weighting the Goldfeld arithmetic function by `n ^
(-beta)`. The zero index follows the `LSeries.term` convention and contributes zero.
-/
noncomputable def goldfeldBetaCoefficient
    {q1 q : ℕ}
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (beta : ℝ) (n : ℕ) : ℂ :=
  LSeries.term (goldfeldCoefficient chi1 chi) (beta : ℂ) n

end

section
open Complex

section GoldfeldSmoothedSum

attribute [local instance] goldfeldLcmNeZero
theorem goldfeldBetaCoefficient_term
    {q1 q : ℕ}
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (beta : ℝ) (s : ℂ) (n : ℕ) :
    LSeries.term (goldfeldBetaCoefficient chi1 chi beta) s n =
      LSeries.term (goldfeldCoefficient chi1 chi)
        (s + (beta : ℂ)) n := by
  rcases eq_or_ne n 0 with rfl | hn
  · simp
  · simp only [goldfeldBetaCoefficient, LSeries.term_of_ne_zero hn]
    rw [Complex.cpow_add _ _ (Nat.cast_ne_zero.mpr hn)]
    field_simp

end GoldfeldSmoothedSum
end

section
open Complex

attribute [local instance] goldfeldLcmNeZero
theorem goldfeldBetaCoefficient_LSeriesHasSum
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (beta : ℝ) {s : ℂ}
    (hs : 1 < (s + (beta : ℂ)).re) :
    LSeriesHasSum (goldfeldBetaCoefficient chi1 chi beta) s
      (goldfeldFourFactorLFunction chi1 chi (s + (beta : ℂ))) := by
  have h := goldfeldCoefficient_LSeriesHasSum chi1 chi hs
  change HasSum (LSeries.term (goldfeldBetaCoefficient chi1 chi beta) s) _
  simpa [goldfeldFourFactorLFunction] using
    h.congr_fun (goldfeldBetaCoefficient_term chi1 chi beta s)

/--
The beta-weighted Goldfeld coefficients summed against the plateau cutoff at `n / x`. For
positive `x`, the cutoff leaves indices up to `x` unchanged and vanishes from `2 * x` onward.
-/
noncomputable def goldfeldSmoothedSum
    {q1 q : ℕ}
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (beta x : ℝ) : ℂ :=
  ∑' n : ℕ,
    goldfeldBetaCoefficient chi1 chi beta n *
      (goldfeldPlateau ((n : ℝ) / x) : ℂ)

/--
The Mellin-inversion integrand for the smoothed Goldfeld sum: the four-factor L-function at `s +
beta`, times the continued cutoff transform and `x ^ s`.
-/
noncomputable def goldfeldContourIntegrand
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (beta x : ℝ) (s : ℂ) : ℂ :=
  goldfeldFourFactorLFunction chi1 chi (s + (beta : ℂ)) *
    goldfeldMellinContinuationData.Phi s * (x : ℂ) ^ s

/--
The full vertical-line integral of the Goldfeld integrand on `re = alpha`, parameterized over
all real imaginary parts and normalized by `1 / (2 * pi)`.
-/
noncomputable def goldfeldVerticalIntegral
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (beta x alpha : ℝ) : ℂ :=
  (((2 * Real.pi : ℝ) : ℂ)⁻¹) *
    ∫ t : ℝ,
      goldfeldContourIntegrand chi1 chi beta x
        ((alpha : ℂ) + t * I)

theorem goldfeldSmoothedSum_eq_verticalIntegral_two
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    {beta x : ℝ} (hbeta : -1 < beta) (hx : 1 ≤ x) :
    goldfeldSmoothedSum chi1 chi beta x =
      goldfeldVerticalIntegral chi1 chi beta x 2 := by
  have hxpos : 0 < x := zero_lt_one.trans_le hx
  have hsum : LSeriesSummable
      (goldfeldBetaCoefficient chi1 chi beta) (2 : ℂ) := by
    apply (goldfeldBetaCoefficient_LSeriesHasSum
      chi1 chi beta (s := (2 : ℂ)) ?_).LSeriesSummable
    norm_num
    linarith
  have hinversion := smoothMellinLSeriesInversion
    (goldfeldBetaCoefficient chi1 chi beta) (by simp [goldfeldBetaCoefficient])
    (fun y : ℝ => (goldfeldPlateau y : ℂ))
    (alpha := 2) (x := x) (by norm_num) hxpos hsum
    (mellinConvergent_goldfeldPlateauComplex (by norm_num))
    (verticalIntegrable_goldfeldPlateauMellin (by norm_num))
    (Complex.continuous_ofReal.comp goldfeldPlateau_contDiff.continuous)
  rw [goldfeldSmoothedSum, goldfeldVerticalIntegral]
  calc
    (∑' n : ℕ,
        goldfeldBetaCoefficient chi1 chi beta n *
          (goldfeldPlateau ((n : ℝ) / x) : ℂ)) =
        (((2 * Real.pi : ℝ) : ℂ)⁻¹) *
          ∫ t : ℝ,
            LSeries (goldfeldBetaCoefficient chi1 chi beta)
                ((2 : ℂ) + t * I) *
              goldfeldPlateauMellin ((2 : ℂ) + t * I) *
              (x : ℂ) ^ ((2 : ℂ) + t * I) := hinversion
    _ = (((2 * Real.pi : ℝ) : ℂ)⁻¹) *
          ∫ t : ℝ,
            goldfeldContourIntegrand chi1 chi beta x
              ((2 : ℂ) + t * I) := by
      congr 1
      apply integral_congr_ae
      filter_upwards [] with t
      have hs : 1 < (((2 : ℂ) + t * I) + (beta : ℂ)).re := by
        norm_num
        linarith
      have hseries := (goldfeldBetaCoefficient_LSeriesHasSum
        chi1 chi beta (s := (2 : ℂ) + t * I) hs).LSeries_eq
      have hphi := goldfeldMellinContinuationData.agrees_on_right
        (s := (2 : ℂ) + t * I) (by norm_num)
      rw [hseries, ← hphi]
      rfl

end

section
open Complex Set

theorem exists_norm_riemannZeta₁_closedStrip_le_pow :
    ∃ E : ℕ, 1 ≤ E ∧
      ∀ z : ℂ, -(1 : ℝ) ≤ z.re → z.re ≤ 3 →
        ‖riemannZeta₁ z‖ ≤ (|z.im| + 2) ^ E := by
  obtain ⟨E, hE, hsphere⟩ :=
    exists_nat_norm_riemannZeta₁_radiusFourSphere_le
  refine ⟨E, hE, ?_⟩
  intro z hzlo hzhi
  let c : ℂ := (2 : ℂ) + z.im * I
  have hzmem : z ∈ closedBall c 4 := by
    rw [mem_closedBall, Complex.dist_eq]
    have heq : z - c = ((z.re - 2 : ℝ) : ℂ) := by
      apply Complex.ext <;> simp [c]
    rw [heq, norm_real, Real.norm_eq_abs, abs_le]
    constructor <;> linarith
  apply Complex.norm_le_of_forall_mem_frontier_norm_le
    (U := ball c 4) Metric.isBounded_ball
    differentiable_riemannZeta₁.diffContOnCl
    (C := (|z.im| + 2) ^ E)
  · intro w hw
    rw [frontier_ball c (by norm_num)] at hw
    exact hsphere z.im w (by simpa [c] using hw)
  · rw [closure_ball c (by norm_num)]
    exact hzmem

theorem exists_norm_riemannZeta_closedStrip_le_pow :
    ∃ E : ℕ, 1 ≤ E ∧
      ∀ z : ℂ, -(1 : ℝ) ≤ z.re → z.re ≤ 3 → 1 ≤ |z.im| →
        ‖riemannZeta z‖ ≤ (|z.im| + 2) ^ E := by
  obtain ⟨E, hE, hzetaOne⟩ :=
    exists_norm_riemannZeta₁_closedStrip_le_pow
  refine ⟨E, hE, ?_⟩
  intro z hzlo hzhi hzim
  have hz1 : z ≠ 1 := by
    intro h
    subst z
    norm_num at hzim
  have hsub : (1 : ℝ) ≤ ‖z - 1‖ := by
    have him := Complex.abs_im_le_norm (z - 1)
    simp only [sub_im, one_im, sub_zero] at him
    exact hzim.trans him
  have hinv : ‖(z - 1)⁻¹‖ ≤ 1 := by
    rw [norm_inv]
    exact inv_le_one₀ (norm_pos_iff.mpr (sub_ne_zero.mpr hz1)) |>.2 hsub
  rw [riemannZeta_eq_inv_sub_mul hz1, norm_mul]
  calc
    ‖(z - 1)⁻¹‖ * ‖riemannZeta₁ z‖ ≤ 1 * ‖riemannZeta₁ z‖ :=
      mul_le_mul_of_nonneg_right hinv (norm_nonneg _)
    _ ≤ (|z.im| + 2) ^ E := by simpa using hzetaOne z hzlo hzhi

end

section
open Complex

attribute [local instance] goldfeldLcmNeZero
theorem exists_norm_goldfeldFourFactorLFunction_closedStrip_le_pow :
    ∃ A : ℕ, 57 ≤ A ∧
      ∀ (q1 q : ℕ) [NeZero q1] [NeZero q],
        1 < q1 → q1 ≤ q →
        ∀ (chi1 : DirichletCharacter ℂ q1)
          (chi : DirichletCharacter ℂ q),
          chi1 ≠ 1 → chi ≠ 1 →
          DirichletCharacter.mul chi1 chi ≠ 1 →
          ∀ (beta : ℝ) (s : ℂ),
            0 ≤ beta → beta ≤ 1 →
            -(1 : ℝ) ≤ s.re → s.re ≤ 2 → 1 ≤ |s.im| →
            ‖goldfeldFourFactorLFunction chi1 chi
                (s + (beta : ℂ))‖ ≤
              ((q : ℝ) * (|s.im| + 2)) ^ A := by
  obtain ⟨L, hLexp, hL⟩ := exists_norm_LFunction_closedStrip_le_pow
  obtain ⟨E, hEexp, hZeta⟩ := exists_norm_riemannZeta_closedStrip_le_pow
  refine ⟨E + 4 * L, by omega, ?_⟩
  intro q1 q _ _ hq1 hq1q chi1 chi hchi1 hchi hcross beta s
    hbeta0 hbeta1 hslo hshi hheight
  have hq : 1 < q := hq1.trans_le hq1q
  let w : ℂ := s + (beta : ℂ)
  let T : ℝ := |s.im| + 2
  let B : ℝ := (q : ℝ) * T
  have hwre : w.re = s.re + beta := by simp [w]
  have hwim : w.im = s.im := by simp [w]
  have hwlo : -(1 : ℝ) ≤ w.re := by rw [hwre]; linarith
  have hwhi : w.re ≤ 3 := by rw [hwre]; linarith
  have hwheight : 1 ≤ |w.im| := by simpa [hwim] using hheight
  have hq2 : (2 : ℝ) ≤ q := by exact_mod_cast hq
  have hq1r : (1 : ℝ) ≤ q := one_le_two.trans hq2
  have hq0 : (0 : ℝ) ≤ q := zero_le_one.trans hq1r
  have hT3 : (3 : ℝ) ≤ T := by
    dsimp [T]
    linarith
  have hT1 : (1 : ℝ) ≤ T := by linarith
  have hT0 : (0 : ℝ) ≤ T := zero_le_one.trans hT1
  have hB1 : (1 : ℝ) ≤ B := by
    dsimp [B]
    nlinarith
  have hq1qReal : (q1 : ℝ) ≤ q := by exact_mod_cast hq1q
  have hZetaBound : ‖riemannZeta w‖ ≤ B ^ E := by
    have hz := hZeta w hwlo hwhi hwheight
    have hTB : T ≤ B := by
      dsimp [B]
      nlinarith
    exact hz.trans (by
      simpa [T, hwim] using pow_le_pow_left₀ hT0 hTB E)
  have hchar (d : ℕ) [NeZero d] (hd : 1 < d)
      (psi : DirichletCharacter ℂ d) (hpsi : psi ≠ 1)
      (k : ℕ) (hk : k ≠ 0) (hdq : (d : ℝ) ≤ (q : ℝ) ^ k) :
      ‖DirichletCharacter.LFunction psi w‖ ≤ B ^ (k * L) := by
    have hbase : (d : ℝ) * (|w.im| + 2) ≤ B ^ k := by
      simpa only [B, T, hwim, mul_pow] using
        mul_le_mul hdq (le_self_pow₀ hT1 hk) hT0 (pow_nonneg hq0 k)
    exact (hL d hd psi hpsi w hwlo hwhi).trans (by
      simpa only [pow_mul] using pow_le_pow_left₀ (by positivity) hbase L)
  have hchi1Bound : ‖DirichletCharacter.LFunction chi1 w‖ ≤ B ^ L := by
    simpa only [one_mul] using hchar q1 hq1 chi1 hchi1 1 one_ne_zero
      (by simpa only [pow_one] using hq1qReal)
  have hchiBound : ‖DirichletCharacter.LFunction chi w‖ ≤ B ^ L := by
    simpa [B, T, hwim] using hL q hq chi hchi w hwlo hwhi
  let m := Nat.lcm q1 q
  have hmpos : 0 < m := Nat.lcm_pos (NeZero.pos q1) (NeZero.pos q)
  let : NeZero m := ⟨hmpos.ne'⟩
  have hm1 : 1 < m := hq.trans_le
    (Nat.le_of_dvd hmpos (Nat.dvd_lcm_right q1 q))
  have hmqqReal : (m : ℝ) ≤ (q : ℝ) ^ 2 := by
    exact_mod_cast (show m ≤ q ^ 2 from by
      simpa only [pow_two] using
        (Nat.lcm_le_mul (NeZero.pos q1) (NeZero.pos q)).trans
          (Nat.mul_le_mul_right q hq1q))
  have hcrossBound :
      ‖DirichletCharacter.LFunction (DirichletCharacter.mul chi1 chi) w‖ ≤
        B ^ (2 * L) :=
    hchar m hm1 (DirichletCharacter.mul chi1 chi) hcross 2 two_ne_zero hmqqReal
  rw [goldfeldFourFactorLFunction, norm_mul, norm_mul, norm_mul]
  calc
    ‖riemannZeta w‖ * ‖DirichletCharacter.LFunction chi1 w‖ *
          ‖DirichletCharacter.LFunction chi w‖ *
        ‖DirichletCharacter.LFunction
            (DirichletCharacter.mul chi1 chi) w‖ ≤
      B ^ E * B ^ L * B ^ L * B ^ (2 * L) := by gcongr
    _ = B ^ (E + 4 * L) := by ring

end

section
open Complex

attribute [local instance] goldfeldLcmNeZero
theorem exists_norm_goldfeldFourFactorLFunction_leftLine_le_pow :
    ∃ A : ℕ, 57 ≤ A ∧
      ∀ (q1 q : ℕ) [NeZero q1] [NeZero q],
        1 < q1 → q1 ≤ q →
        ∀ (chi1 : DirichletCharacter ℂ q1)
          (chi : DirichletCharacter ℂ q),
          chi1 ≠ 1 → chi ≠ 1 →
          DirichletCharacter.mul chi1 chi ≠ 1 →
          ∀ (beta t : ℝ),
            0 ≤ beta → beta ≤ 1 →
            ‖goldfeldFourFactorLFunction chi1 chi
                (((-1 : ℂ) + t * I) + (beta : ℂ))‖ ≤
              ((q : ℝ) * (|t| + 2)) ^ A := by
  obtain ⟨L, hLexp, hL⟩ := exists_norm_LFunction_closedStrip_le_pow
  obtain ⟨E, hEexp, hZetaOne⟩ :=
    exists_norm_riemannZeta₁_closedStrip_le_pow
  refine ⟨E + 4 * L, by omega, ?_⟩
  intro q1 q _ _ hq1 hq1q chi1 chi hchi1 hchi hcross
    beta t hbeta0 hbeta1
  let w : ℂ := ((-1 : ℂ) + t * I) + (beta : ℂ)
  let T : ℝ := |t| + 2
  let B : ℝ := (q : ℝ) * T
  have hwre : w.re = -1 + beta := by simp [w]
  have hwim : w.im = t := by simp [w]
  have hwlo : -(1 : ℝ) ≤ w.re := by rw [hwre]; linarith
  have hwhi : w.re ≤ 3 := by rw [hwre]; linarith
  have hq : 1 < q := hq1.trans_le hq1q
  have hq2 : (2 : ℝ) ≤ q := by exact_mod_cast hq
  have hq1r : (1 : ℝ) ≤ q := one_le_two.trans hq2
  have hq0 : (0 : ℝ) ≤ q := zero_le_one.trans hq1r
  have hT2 : (2 : ℝ) ≤ T := by
    dsimp [T]
    linarith [abs_nonneg t]
  have hT1 : (1 : ℝ) ≤ T := one_le_two.trans hT2
  have hT0 : (0 : ℝ) ≤ T := zero_le_one.trans hT1
  have hB1 : (1 : ℝ) ≤ B := by
    dsimp [B]
    nlinarith
  have hwOne : w ≠ 1 := by
    intro h
    have hre := congrArg Complex.re h
    rw [hwre] at hre
    norm_num at hre
    linarith
  have hwSubNorm : (1 : ℝ) ≤ ‖w - 1‖ := by
    have hre : (w - 1).re ≤ -1 := by
      simp only [sub_re, one_re]
      rw [hwre]
      linarith
    have habs : (1 : ℝ) ≤ |(w - 1).re| := by
      rw [abs_of_nonpos (hre.trans (by norm_num))]
      linarith
    exact habs.trans (Complex.abs_re_le_norm (w - 1))
  have hZetaInv : ‖(w - 1)⁻¹‖ ≤ 1 := by
    rw [norm_inv]
    exact (inv_le_one₀ (norm_pos_iff.mpr (sub_ne_zero.mpr hwOne))).2 hwSubNorm
  have hZetaBound : ‖riemannZeta w‖ ≤ B ^ E := by
    have hregular := hZetaOne w hwlo hwhi
    have hTB : T ≤ B := by
      dsimp [B]
      nlinarith
    rw [riemannZeta_eq_inv_sub_mul hwOne, norm_mul]
    calc
      ‖(w - 1)⁻¹‖ * ‖riemannZeta₁ w‖ ≤
          1 * ‖riemannZeta₁ w‖ :=
        mul_le_mul_of_nonneg_right hZetaInv (norm_nonneg _)
      _ ≤ T ^ E := by simpa [T, hwim] using hregular
      _ ≤ B ^ E := pow_le_pow_left₀ hT0 hTB E
  have hq1qReal : (q1 : ℝ) ≤ q := by exact_mod_cast hq1q
  have hchar (d : ℕ) [NeZero d] (hd : 1 < d)
      (psi : DirichletCharacter ℂ d) (hpsi : psi ≠ 1)
      (k : ℕ) (hk : k ≠ 0) (hdq : (d : ℝ) ≤ (q : ℝ) ^ k) :
      ‖DirichletCharacter.LFunction psi w‖ ≤ B ^ (k * L) := by
    have hbase : (d : ℝ) * (|w.im| + 2) ≤ B ^ k := by
      simpa only [B, T, hwim, mul_pow] using
        mul_le_mul hdq (le_self_pow₀ hT1 hk) hT0 (pow_nonneg hq0 k)
    exact (hL d hd psi hpsi w hwlo hwhi).trans (by
      simpa only [pow_mul] using pow_le_pow_left₀ (by positivity) hbase L)
  have hchi1Bound : ‖DirichletCharacter.LFunction chi1 w‖ ≤ B ^ L := by
    simpa only [one_mul] using hchar q1 hq1 chi1 hchi1 1 one_ne_zero
      (by simpa only [pow_one] using hq1qReal)
  have hchiBound : ‖DirichletCharacter.LFunction chi w‖ ≤ B ^ L := by
    simpa [B, T, hwim] using hL q hq chi hchi w hwlo hwhi
  let m := Nat.lcm q1 q
  have hmpos : 0 < m := Nat.lcm_pos (NeZero.pos q1) (NeZero.pos q)
  let : NeZero m := ⟨hmpos.ne'⟩
  have hm1 : 1 < m := hq.trans_le
    (Nat.le_of_dvd hmpos (Nat.dvd_lcm_right q1 q))
  have hmqqReal : (m : ℝ) ≤ (q : ℝ) ^ 2 := by
    exact_mod_cast (show m ≤ q ^ 2 from by
      simpa only [pow_two] using
        (Nat.lcm_le_mul (NeZero.pos q1) (NeZero.pos q)).trans
          (Nat.mul_le_mul_right q hq1q))
  have hcrossBound :
      ‖DirichletCharacter.LFunction (DirichletCharacter.mul chi1 chi) w‖ ≤
        B ^ (2 * L) :=
    hchar m hm1 (DirichletCharacter.mul chi1 chi) hcross 2 two_ne_zero hmqqReal
  rw [goldfeldFourFactorLFunction, norm_mul, norm_mul, norm_mul]
  calc
    ‖riemannZeta w‖ * ‖DirichletCharacter.LFunction chi1 w‖ *
          ‖DirichletCharacter.LFunction chi w‖ *
        ‖DirichletCharacter.LFunction
            (DirichletCharacter.mul chi1 chi) w‖ ≤
      B ^ E * B ^ L * B ^ L * B ^ (2 * L) := by gcongr
    _ = B ^ (E + 4 * L) := by ring

end

section
open Complex

section GoldfeldLeftLineBounds

attribute [local instance] goldfeldLcmNeZero
theorem goldfeld_leftLine_decay_product_le
    {q u x C : ℝ} {A : ℕ}
    (hq : 0 ≤ q) (hu : 0 ≤ u) (hx : 0 < x) (hC : 0 ≤ C) :
    (q * (u + 2)) ^ A * (C / (1 + u) ^ (A + 2)) * x⁻¹ ≤
      (C * (2 : ℝ) ^ A) * q ^ A /
        (x * (1 + u) ^ 2) := by
  have hbase : u + 2 ≤ 2 * (1 + u) := by linarith
  have hpow : (u + 2) ^ A ≤ (2 * (1 + u)) ^ A :=
    pow_le_pow_left₀ (by linarith) hbase A
  have hqpow : 0 ≤ q ^ A := pow_nonneg hq A
  have hprod :
      q ^ A * (u + 2) ^ A * (C / (1 + u) ^ (A + 2)) * x⁻¹ ≤
        q ^ A * (2 * (1 + u)) ^ A *
          (C / (1 + u) ^ (A + 2)) * x⁻¹ := by
    gcongr
  calc
    (q * (u + 2)) ^ A * (C / (1 + u) ^ (A + 2)) * x⁻¹ =
        q ^ A * (u + 2) ^ A *
          (C / (1 + u) ^ (A + 2)) * x⁻¹ := by rw [mul_pow]
    _ ≤ q ^ A * (2 * (1 + u)) ^ A *
          (C / (1 + u) ^ (A + 2)) * x⁻¹ := hprod
    _ = (C * (2 : ℝ) ^ A) * q ^ A /
          (x * (1 + u) ^ 2) := by
      rw [mul_pow]
      field_simp
      ring

end GoldfeldLeftLineBounds
end

section
open Complex

attribute [local instance] goldfeldLcmNeZero
theorem exists_norm_goldfeldContourIntegrand_leftLine_le :
    ∃ A : ℕ, 57 ≤ A ∧ ∃ C : ℝ, 0 < C ∧
      ∀ (q1 q : ℕ) [NeZero q1] [NeZero q],
        1 < q1 → q1 ≤ q →
        ∀ (chi1 : DirichletCharacter ℂ q1)
          (chi : DirichletCharacter ℂ q),
          chi1 ≠ 1 → chi ≠ 1 →
          DirichletCharacter.mul chi1 chi ≠ 1 →
          ∀ (beta x t : ℝ),
            0 ≤ beta → beta ≤ 1 → 1 ≤ x →
            ‖goldfeldContourIntegrand chi1 chi beta x
                ((-1 : ℂ) + t * I)‖ ≤
              C * (q : ℝ) ^ A / (x * (1 + |t|) ^ 2) := by
  obtain ⟨A, hA, hF⟩ :=
    exists_norm_goldfeldFourFactorLFunction_leftLine_le_pow
  obtain ⟨Cphi, hCphi, hPhi⟩ :=
    goldfeldMellinContinuationData.decay_on_neg_one (A + 2) (by omega)
  let C : ℝ := Cphi * (2 : ℝ) ^ A
  have hC : 0 < C := by
    dsimp [C]
    positivity
  refine ⟨A, hA, C, hC, ?_⟩
  intro q1 q _ _ hq1 hq1q chi1 chi hchi1 hchi hcross
    beta x t hbeta0 hbeta1 hx
  have hxpos : 0 < x := zero_lt_one.trans_le hx
  have hq0 : (0 : ℝ) ≤ q := by positivity
  have hF' := hF q1 q hq1 hq1q chi1 chi hchi1 hchi hcross
    beta t hbeta0 hbeta1
  have hPhi' := hPhi t
  have hxpow : ‖(x : ℂ) ^ ((-1 : ℂ) + t * I)‖ = x⁻¹ := by
    rw [Complex.norm_cpow_eq_rpow_re_of_pos hxpos]
    simp [Real.rpow_neg_one]
  rw [goldfeldContourIntegrand, norm_mul, norm_mul, hxpow]
  calc
    ‖goldfeldFourFactorLFunction chi1 chi
          (((-1 : ℂ) + t * I) + (beta : ℂ))‖ *
        ‖goldfeldMellinContinuationData.Phi ((-1 : ℂ) + t * I)‖ * x⁻¹ ≤
      ((q : ℝ) * (|t| + 2)) ^ A *
        (Cphi / (1 + |t|) ^ (A + 2)) * x⁻¹ := by gcongr
    _ ≤ (Cphi * (2 : ℝ) ^ A) * (q : ℝ) ^ A /
          (x * (1 + |t|) ^ 2) :=
      goldfeld_leftLine_decay_product_le hq0 (abs_nonneg t)
        hxpos hCphi.le
    _ = C * (q : ℝ) ^ A / (x * (1 + |t|) ^ 2) := by rfl

end

section
open Complex

section GoldfeldLeftLineIntegral

attribute [local instance] goldfeldLcmNeZero
theorem continuous_goldfeldContourIntegrand_leftLine
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    {chi1 : DirichletCharacter ℂ q1}
    {chi : DirichletCharacter ℂ q}
    (hchi1 : chi1 ≠ 1) (hchi : chi ≠ 1)
    (hcross : DirichletCharacter.mul chi1 chi ≠ 1)
    {beta x : ℝ} (hbeta1 : beta ≤ 1) (hx : 0 < x) :
    Continuous (fun t : ℝ =>
      goldfeldContourIntegrand chi1 chi beta x
        ((-1 : ℂ) + t * I)) := by
  let s : ℝ → ℂ := fun t => (-1 : ℂ) + t * I
  have hs : Continuous s := by fun_prop
  have hs0 (t : ℝ) : s t ≠ 0 := by
    intro h
    have hre := congrArg Complex.re h
    simp [s] at hre
  have hshift : Continuous (fun t : ℝ => s t + (beta : ℂ)) :=
    hs.add continuous_const
  have hshiftOne (t : ℝ) : s t + (beta : ℂ) ≠ 1 := by
    intro h
    have hre := congrArg Complex.re h
    simp [s] at hre
    linarith
  have hzeta : Continuous (fun t : ℝ =>
      riemannZeta (s t + (beta : ℂ))) := by
    rw [continuous_iff_continuousAt]
    intro t
    have hcomp :=
      (differentiableAt_riemannZeta (hshiftOne t)).continuousAt.comp
        (f := fun u : ℝ => s u + (beta : ℂ)) hshift.continuousAt
    simpa [Function.comp_def] using hcomp
  have hLchi1 : Continuous (fun t : ℝ =>
      DirichletCharacter.LFunction chi1 (s t + (beta : ℂ))) :=
    (DirichletCharacter.differentiable_LFunction hchi1).continuous.comp
      hshift
  have hLchi : Continuous (fun t : ℝ =>
      DirichletCharacter.LFunction chi (s t + (beta : ℂ))) :=
    (DirichletCharacter.differentiable_LFunction hchi).continuous.comp
      hshift
  have hLcross : Continuous (fun t : ℝ =>
      DirichletCharacter.LFunction (DirichletCharacter.mul chi1 chi)
        (s t + (beta : ℂ))) :=
    (DirichletCharacter.differentiable_LFunction hcross).continuous.comp
      hshift
  have hPhi : Continuous (fun t : ℝ =>
      goldfeldMellinContinuationData.Phi (s t)) := by
    rw [continuous_iff_continuousAt]
    intro t
    simpa [Function.comp_def] using
      (goldfeldMellinContinuationData.analytic_off_zero
        (hs0 t)).continuousAt.comp hs.continuousAt
  have hxpow : Continuous (fun t : ℝ => (x : ℂ) ^ s t) :=
    continuous_const.cpow hs fun _ => Complex.ofReal_mem_slitPlane.mpr hx
  have hproduct :=
    (((((hzeta.mul hLchi1).mul hLchi).mul hLcross).mul hPhi).mul hxpow)
  convert hproduct using 1
  ext t
  simp [s, goldfeldContourIntegrand, goldfeldFourFactorLFunction]

theorem goldfeld_leftLine_source_envelope_le_cauchy
    {q A : ℕ} {C x t y : ℝ}
    (hC : 0 ≤ C) (hx : 0 < x)
    (hy : y ≤ C * (q : ℝ) ^ A / (x * (1 + |t|) ^ 2)) :
    y ≤ (C * (q : ℝ) ^ A / x) * (1 + t ^ 2)⁻¹ := by
  let K : ℝ := C * (q : ℝ) ^ A / x
  have hK : 0 ≤ K := by
    dsimp [K]
    positivity
  have hden : 1 + t ^ 2 ≤ (1 + |t|) ^ 2 := by
    nlinarith [sq_abs t, abs_nonneg t]
  have hinv : ((1 + |t|) ^ 2)⁻¹ ≤ (1 + t ^ 2)⁻¹ :=
    (inv_le_inv₀ (by positivity) (by positivity)).2 hden
  calc
    y ≤ C * (q : ℝ) ^ A / (x * (1 + |t|) ^ 2) := hy
    _ = K * ((1 + |t|) ^ 2)⁻¹ := by
      dsimp [K]
      field_simp
    _ ≤ K * (1 + t ^ 2)⁻¹ :=
      mul_le_mul_of_nonneg_left hinv hK

end GoldfeldLeftLineIntegral
end

section
open Complex

attribute [local instance] goldfeldLcmNeZero
theorem goldfeldContourIntegrand_leftLine_verticalIntegrable
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (hq1 : 1 < q1) (hq1q : q1 ≤ q)
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (hchi1 : chi1 ≠ 1) (hchi : chi ≠ 1)
    (hcross : DirichletCharacter.mul chi1 chi ≠ 1)
    {beta x : ℝ} (hbeta0 : 0 ≤ beta) (hbeta1 : beta ≤ 1)
    (hx : 1 ≤ x) :
    VerticalIntegrable
      (goldfeldContourIntegrand chi1 chi beta x) (-1) := by
  obtain ⟨A, _hA, C, hC, hpoint⟩ :=
    exists_norm_goldfeldContourIntegrand_leftLine_le
  let K : ℝ := C * (q : ℝ) ^ A / x
  have hmajor : Integrable (fun t : ℝ => K * (1 + t ^ 2)⁻¹) :=
    integrable_inv_one_add_sq.const_mul K
  have hcontinuous := continuous_goldfeldContourIntegrand_leftLine
    hchi1 hchi hcross hbeta1 (zero_lt_one.trans_le hx)
  rw [VerticalIntegrable]
  refine hmajor.mono' ?_ ?_
  · simpa using hcontinuous.aestronglyMeasurable
  · filter_upwards [] with t
    have hp := hpoint q1 q hq1 hq1q chi1 chi hchi1 hchi hcross
      beta x t hbeta0 hbeta1 hx
    have hcauchy := goldfeld_leftLine_source_envelope_le_cauchy
      hC.le (zero_lt_one.trans_le hx) hp
    simpa [K] using hcauchy

theorem exists_norm_goldfeldVerticalIntegral_neg_one_le :
    ∃ A : ℕ, 57 ≤ A ∧ ∃ C : ℝ, 0 < C ∧
      ∀ (q1 q : ℕ) [NeZero q1] [NeZero q],
        1 < q1 → q1 ≤ q →
        ∀ (chi1 : DirichletCharacter ℂ q1)
          (chi : DirichletCharacter ℂ q),
          chi1 ≠ 1 → chi ≠ 1 →
          DirichletCharacter.mul chi1 chi ≠ 1 →
          ∀ (beta x : ℝ),
            0 ≤ beta → beta ≤ 1 → 1 ≤ x →
            ‖goldfeldVerticalIntegral chi1 chi beta x (-1)‖ ≤
              C * (q : ℝ) ^ A / x := by
  obtain ⟨A, hA, C0, hC0, hpoint⟩ :=
    exists_norm_goldfeldContourIntegrand_leftLine_le
  let C : ℝ := C0 * Real.pi
  have hC : 0 < C := by
    dsimp [C]
    positivity
  refine ⟨A, hA, C, hC, ?_⟩
  intro q1 q _ _ hq1 hq1q chi1 chi hchi1 hchi hcross
    beta x hbeta0 hbeta1 hx
  let f : ℝ → ℂ := fun t =>
    goldfeldContourIntegrand chi1 chi beta x
      (((-1 : ℝ) : ℂ) + t * I)
  let K : ℝ := C0 * (q : ℝ) ^ A / x
  have hvertical := goldfeldContourIntegrand_leftLine_verticalIntegrable
    hq1 hq1q chi1 chi hchi1 hchi hcross hbeta0 hbeta1 hx
  have hraw : Integrable f := by
    simpa [VerticalIntegrable, f] using hvertical
  have hmajor : Integrable (fun t : ℝ => K * (1 + t ^ 2)⁻¹) :=
    integrable_inv_one_add_sq.const_mul K
  have hmajorPoint : ∀ t : ℝ, ‖f t‖ ≤ K * (1 + t ^ 2)⁻¹ := by
    intro t
    have hp := hpoint q1 q hq1 hq1q chi1 chi hchi1 hchi hcross
      beta x t hbeta0 hbeta1 hx
    have hcauchy := goldfeld_leftLine_source_envelope_le_cauchy
      hC0.le (zero_lt_one.trans_le hx) hp
    simpa [f, K] using hcauchy
  have hnormIntegral : ‖∫ t : ℝ, f t‖ ≤ K * Real.pi := by
    calc
      ‖∫ t : ℝ, f t‖ ≤ ∫ t : ℝ, ‖f t‖ :=
        norm_integral_le_integral_norm f
      _ ≤ ∫ t : ℝ, K * (1 + t ^ 2)⁻¹ :=
        integral_mono_ae hraw.norm hmajor (ae_of_all _ hmajorPoint)
      _ = K * Real.pi := by
        rw [integral_const_mul, integral_univ_inv_one_add_sq]
  have hcoefficient :
      ‖(((2 * Real.pi : ℝ) : ℂ)⁻¹)‖ ≤ 1 := by
    rw [norm_inv, norm_real, Real.norm_eq_abs,
      abs_of_pos (by positivity : 0 < 2 * Real.pi)]
    exact (inv_le_one₀ (by positivity : 0 < 2 * Real.pi)).2
      (by nlinarith [Real.two_le_pi])
  rw [goldfeldVerticalIntegral, norm_mul]
  calc
    ‖(((2 * Real.pi : ℝ) : ℂ)⁻¹)‖ * ‖∫ t : ℝ, f t‖ ≤
        1 * (K * Real.pi) := by gcongr
    _ = C * (q : ℝ) ^ A / x := by
      dsimp [C, K]
      ring

end

section
open Complex Set

attribute [local instance] goldfeldLcmNeZero
/-- The point `1 - beta` in `ℂ`, where the shifted factor `zeta (s + beta)` has its pole. -/
noncomputable def goldfeldShiftedZetaPole (beta : ℝ) : ℂ :=
  ((1 - beta : ℝ) : ℂ)

/--
The divided difference of `L(chi1, s + beta)` about `s = 0`, with the derivative used at zero.
When `L(chi1, beta) = 0`, it removes that zero by dividing by `s` away from the origin.
-/
noncomputable def goldfeldShiftedLFunctionDividedSlope
    {q1 : ℕ} [NeZero q1]
    (chi1 : DirichletCharacter ℂ q1) (beta : ℝ) (s : ℂ) : ℂ :=
  dslope
    (fun z : ℂ => DirichletCharacter.LFunction chi1 (z + (beta : ℂ))) 0 s

/--
The candidate numerator isolating the shifted zeta factor, assembled from pole-removed zeta, a
divided difference of the shifted first L-function, the other two L-factors, and the
differentiated Mellin transform. Its identification with the original contour integrand uses the
vanishing condition `L(chi1, beta) = 0`.
-/
noncomputable def goldfeldContourNumerator
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (beta x : ℝ) (s : ℂ) : ℂ :=
  riemannZeta₁ (s + (beta : ℂ)) *
    goldfeldShiftedLFunctionDividedSlope chi1 beta s *
    DirichletCharacter.LFunction chi (s + (beta : ℂ)) *
    DirichletCharacter.LFunction (DirichletCharacter.mul chi1 chi)
      (s + (beta : ℂ)) *
    (-goldfeldDerivativeMellin s) * (x : ℂ) ^ s

/--
The contour numerator divided by `s - (1 - beta)`. If `L(chi1, beta) = 0`, this agrees with the
original Goldfeld integrand away from `s = 0` and the shifted zeta pole.
-/
noncomputable def goldfeldRegularizedContourIntegrand
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (beta x : ℝ) (s : ℂ) : ℂ :=
  goldfeldContourNumerator chi1 chi beta x s /
    (s - goldfeldShiftedZetaPole beta)

/--
The candidate residue at the shifted zeta pole `s = 1 - beta`: `x ^ (1 - beta)` times the three
character L-values at one and the continued Mellin transform at `1 - beta`.
-/
noncomputable def goldfeldContourResidue
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (beta x : ℝ) : ℂ :=
  (x : ℂ) ^ goldfeldShiftedZetaPole beta *
    DirichletCharacter.LFunction chi1 1 *
    DirichletCharacter.LFunction chi 1 *
    DirichletCharacter.LFunction (DirichletCharacter.mul chi1 chi) 1 *
    goldfeldMellinContinuationData.Phi (goldfeldShiftedZetaPole beta)

end

section
open Complex Set

section GoldfeldLocalCancellation

attribute [local instance] goldfeldLcmNeZero
theorem goldfeldShiftedLFunctionDividedSlope_mul
    {q1 : ℕ} [NeZero q1]
    (chi1 : DirichletCharacter ℂ q1) (beta : ℝ)
    (hzero : DirichletCharacter.LFunction chi1 (beta : ℂ) = 0)
    (s : ℂ) :
    s * goldfeldShiftedLFunctionDividedSlope chi1 beta s =
      DirichletCharacter.LFunction chi1 (s + (beta : ℂ)) := by
  simpa [goldfeldShiftedLFunctionDividedSlope, smul_eq_mul] using
    (sub_smul_dslope_of_zero (f := fun z : ℂ =>
      DirichletCharacter.LFunction chi1 (z + (beta : ℂ)))
      (a := (0 : ℂ)) (by simpa using hzero) s)

end GoldfeldLocalCancellation
end

section
open Complex Set

attribute [local instance] goldfeldLcmNeZero
theorem differentiable_goldfeldShiftedLFunctionDividedSlope
    {q1 : ℕ} [NeZero q1]
    {chi1 : DirichletCharacter ℂ q1} (hchi1 : chi1 ≠ 1)
    (beta : ℝ) :
    Differentiable ℂ (goldfeldShiftedLFunctionDividedSlope chi1 beta) := by
  rw [← differentiableOn_univ]
  exact (Complex.differentiableOn_dslope Filter.univ_mem).2
    (((DirichletCharacter.differentiable_LFunction hchi1).comp
      (differentiable_id.add_const (beta : ℂ))).differentiableOn)

theorem differentiable_goldfeldContourNumerator
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    {chi1 : DirichletCharacter ℂ q1}
    {chi : DirichletCharacter ℂ q}
    (hchi1 : chi1 ≠ 1) (hchi : chi ≠ 1)
    (hcross : DirichletCharacter.mul chi1 chi ≠ 1)
    (beta : ℝ) {x : ℝ} (hx : 0 < x) :
    Differentiable ℂ (goldfeldContourNumerator chi1 chi beta x) := by
  have hshift : Differentiable ℂ (fun s : ℂ => s + (beta : ℂ)) :=
    differentiable_id.add_const _
  have hzeta : Differentiable ℂ (fun s : ℂ =>
      riemannZeta₁ (s + (beta : ℂ))) :=
    differentiable_riemannZeta₁.comp hshift
  have hLchi : Differentiable ℂ (fun s : ℂ =>
      DirichletCharacter.LFunction chi (s + (beta : ℂ))) :=
    (DirichletCharacter.differentiable_LFunction hchi).comp hshift
  have hLcross : Differentiable ℂ (fun s : ℂ =>
      DirichletCharacter.LFunction (DirichletCharacter.mul chi1 chi)
        (s + (beta : ℂ))) :=
    (DirichletCharacter.differentiable_LFunction hcross).comp hshift
  have hx0 : (x : ℂ) ≠ 0 := Complex.ofReal_ne_zero.mpr hx.ne'
  have hxpow : Differentiable ℂ (fun s : ℂ => (x : ℂ) ^ s) :=
    differentiable_id.const_cpow (.inl hx0)
  unfold goldfeldContourNumerator
  exact (((((hzeta.mul
    (differentiable_goldfeldShiftedLFunctionDividedSlope hchi1 beta)).mul
      hLchi).mul hLcross).mul
        differentiable_goldfeldDerivativeMellin.neg).mul hxpow)

theorem goldfeldRegularizedContourIntegrand_eq_contourIntegrand
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    {beta x : ℝ}
    (hzero : DirichletCharacter.LFunction chi1 (beta : ℂ) = 0)
    {s : ℂ} (hs0 : s ≠ 0)
    (hspole : s ≠ goldfeldShiftedZetaPole beta) :
    goldfeldRegularizedContourIntegrand chi1 chi beta x s =
      goldfeldContourIntegrand chi1 chi beta x s := by
  have hL := goldfeldShiftedLFunctionDividedSlope_mul chi1 beta hzero s
  have harg : s + (beta : ℂ) ≠ 1 := by
    intro h
    apply hspole
    rw [goldfeldShiftedZetaPole]
    norm_num at h ⊢
    linear_combination h
  have hshift : s + (beta : ℂ) - 1 =
      s - goldfeldShiftedZetaPole beta := by
    rw [goldfeldShiftedZetaPole]
    norm_num
    ring
  have hzeta := riemannZeta_eq_inv_sub_mul harg
  rw [hshift] at hzeta
  rw [goldfeldRegularizedContourIntegrand, goldfeldContourNumerator,
    goldfeldContourIntegrand, goldfeldFourFactorLFunction,
    hzeta, ← hL, goldfeldMellinContinuationData.eq_plateauMellinContinuation,
    goldfeldPlateauMellinContinuation]
  field_simp [hs0, sub_ne_zero.mpr hspole]

theorem goldfeldContourNumerator_apply_shiftedZetaPole
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    {beta x : ℝ} (hbeta : beta < 1)
    (hzero : DirichletCharacter.LFunction chi1 (beta : ℂ) = 0) :
    goldfeldContourNumerator chi1 chi beta x
        (goldfeldShiftedZetaPole beta) =
      goldfeldContourResidue chi1 chi beta x := by
  have hdelta0 : goldfeldShiftedZetaPole beta ≠ 0 := by
    rw [goldfeldShiftedZetaPole]
    exact Complex.ofReal_ne_zero.mpr (sub_ne_zero.mpr hbeta.ne')
  have hshift : goldfeldShiftedZetaPole beta + (beta : ℂ) = 1 := by
    rw [goldfeldShiftedZetaPole]
    norm_num
  have hL := goldfeldShiftedLFunctionDividedSlope_mul chi1 beta hzero
    (goldfeldShiftedZetaPole beta)
  rw [hshift] at hL
  have hphi := goldfeldMellinContinuationData.eq_plateauMellinContinuation
    (goldfeldShiftedZetaPole beta)
  rw [goldfeldPlateauMellinContinuation] at hphi
  have hphiMul : goldfeldShiftedZetaPole beta *
      goldfeldMellinContinuationData.Phi (goldfeldShiftedZetaPole beta) =
      -goldfeldDerivativeMellin (goldfeldShiftedZetaPole beta) := by
    rw [hphi]
    field_simp [hdelta0]
  rw [goldfeldContourNumerator, goldfeldContourResidue, hshift,
    riemannZeta₁_one, one_mul, ← hphiMul, ← hL]
  ring

end

section
open Complex Set Real
open scoped ContDiff SchwartzMap FourierTransform RealInnerProductSpace

section GoldfeldMellinStripDecay

theorem iteratedDeriv_real_smul
    (n : ℕ) (f : ℝ → ℝ) (g : ℝ → ℂ) (u : ℝ)
    (hf : ContDiffAt ℝ n f u) (hg : ContDiffAt ℝ n g u) :
    iteratedDeriv n (f • g) u = ∑ i ∈ Finset.range (n + 1),
      n.choose i • iteratedDeriv i f u • iteratedDeriv (n - i) g u := by
  simpa only [iteratedDerivWithin_univ] using
    iteratedDerivWithin_smul (Set.mem_univ u) uniqueDiffOn_univ
      hf.contDiffWithinAt hg.contDiffWithinAt

/--
The weighted cutoff derivative pulled back by `y = exp (-u)`. This smooth compactly supported
kernel is the common base for the vertical-strip Mellin estimates.
-/
noncomputable def goldfeldMellinBaseKernel (u : ℝ) : ℂ :=
  goldfeldMellinDerivativeWeight (Real.exp (-u))

/--
The base logarithmic kernel multiplied by `exp (-sigma * u)`, giving the Mellin kernel on the
vertical line `re = sigma`.
-/
noncomputable def goldfeldMellinStripKernel (sigma u : ℝ) : ℂ :=
  Real.exp (-sigma * u) • goldfeldMellinBaseKernel u

theorem contDiff_goldfeldMellinBaseKernel : ContDiff ℝ ∞ goldfeldMellinBaseKernel := by
  unfold goldfeldMellinBaseKernel
  exact goldfeldMellinDerivativeWeight_contDiff.comp (contDiff_id.neg.exp)

theorem contDiff_goldfeldMellinStripKernel (sigma : ℝ) :
    ContDiff ℝ ∞ (goldfeldMellinStripKernel sigma) := by
  unfold goldfeldMellinStripKernel
  exact (contDiff_const.mul contDiff_id).exp.smul contDiff_goldfeldMellinBaseKernel

theorem goldfeldMellinBaseKernel_eq_zero_of_pos {u : ℝ} (hu : 0 < u) :
    goldfeldMellinBaseKernel u = 0 := by
  have harg : 0 < Real.exp (-u) := Real.exp_pos _
  have hlt : Real.exp (-u) < 1 := by
    rw [Real.exp_lt_one_iff]
    linarith
  have hd := goldfeldPlateau_deriv_eq_zero_of_pos_of_lt_one harg hlt
  simp [goldfeldMellinBaseKernel, goldfeldMellinDerivativeWeight,
    goldfeldPlateauDerivativeComplex, hd]

theorem goldfeldMellinBaseKernel_eq_zero_of_lt_neg_log_two
    {u : ℝ} (hu : u < -Real.log 2) : goldfeldMellinBaseKernel u = 0 := by
  have harg : 0 < Real.exp (-u) := Real.exp_pos _
  have hlog : Real.log 2 < -u := by linarith
  have hgt : 2 < Real.exp (-u) := by
    rw [← Real.exp_log (by norm_num : (0 : ℝ) < 2)]
    exact (Real.exp_lt_exp).2 hlog
  have hd := goldfeldPlateau_deriv_eq_zero_of_two_lt hgt
  simp [goldfeldMellinBaseKernel, goldfeldMellinDerivativeWeight,
    goldfeldPlateauDerivativeComplex, hd]

theorem support_goldfeldMellinBaseKernel_subset :
    Function.support goldfeldMellinBaseKernel ⊆ Icc (-Real.log 2) 0 := by
  refine Function.support_subset_iff'.2 fun u hu => ?_
  simp only [mem_Icc, not_and_or, not_le] at hu
  exact hu.elim
    (goldfeldMellinBaseKernel_eq_zero_of_lt_neg_log_two)
    (goldfeldMellinBaseKernel_eq_zero_of_pos)

theorem hasCompactSupport_goldfeldMellinBaseKernel :
    HasCompactSupport goldfeldMellinBaseKernel := by
  apply HasCompactSupport.of_support_subset_isCompact
    (K := Icc (-Real.log 2) 0) isCompact_Icc
  exact support_goldfeldMellinBaseKernel_subset

/--
The base logarithmic kernel as a Schwartz function, with smoothness and compact support
supplying the required decay properties.
-/
noncomputable def goldfeldMellinBaseSchwartz : 𝓢(ℝ, ℂ) :=
  hasCompactSupport_goldfeldMellinBaseKernel.toSchwartzMap
    contDiff_goldfeldMellinBaseKernel

theorem goldfeldDerivativeMellin_eq_fourier (sigma t : ℝ) :
    goldfeldDerivativeMellin ((sigma : ℂ) + t * I) =
      𝓕 (goldfeldMellinStripKernel sigma) (t / (2 * π)) := by
  calc
    goldfeldDerivativeMellin ((sigma : ℂ) + t * I) =
        mellin goldfeldMellinDerivativeWeight ((sigma : ℂ) + t * I) :=
      goldfeldDerivativeMellin_eq_weight _
    _ = 𝓕 (fun u : ℝ =>
        Real.exp (-((sigma : ℂ) + t * I).re * u) •
          goldfeldMellinDerivativeWeight (Real.exp (-u)))
        (((sigma : ℂ) + t * I).im / (2 * π)) :=
      mellin_eq_fourier goldfeldMellinDerivativeWeight
    _ = 𝓕 (goldfeldMellinStripKernel sigma) (t / (2 * π)) := by
      norm_num
      apply congrArg (fun f : ℝ → ℂ => 𝓕 f (t / (2 * π)))
      funext u
      simp [goldfeldMellinStripKernel, goldfeldMellinBaseKernel]

theorem iteratedDeriv_goldfeldMellinBaseKernel_eq_zero_of_not_mem
    (n : ℕ) {u : ℝ} (hu : u ∉ Icc (-Real.log 2) 0) :
    iteratedDeriv n goldfeldMellinBaseKernel u = 0 := by
  have heq : Set.EqOn goldfeldMellinBaseKernel 0 (Icc (-Real.log 2) 0)ᶜ :=
    Function.support_subset_iff'.mp support_goldfeldMellinBaseKernel_subset
  simpa using heq.iteratedDeriv_of_isOpen isClosed_Icc.isOpen_compl n hu

theorem norm_iteratedDeriv_goldfeldMellinBaseKernel_le_seminorm (n : ℕ) (u : ℝ) :
    ‖iteratedDeriv n goldfeldMellinBaseKernel u‖ ≤
      SchwartzMap.seminorm ℝ 0 n goldfeldMellinBaseSchwartz := by
  have h := SchwartzMap.le_seminorm' ℝ 0 n goldfeldMellinBaseSchwartz u
  change ‖iteratedDeriv n (goldfeldMellinBaseSchwartz : ℝ → ℂ) u‖ ≤
    SchwartzMap.seminorm ℝ 0 n goldfeldMellinBaseSchwartz
  simpa using h

theorem iteratedDeriv_exp_neg_mul (sigma : ℝ) (n : ℕ) :
    iteratedDeriv n (fun u : ℝ => Real.exp (-sigma * u)) =
      fun u => (-sigma) ^ n * Real.exp (-sigma * u) := by
  simpa only [neg_mul] using iteratedDeriv_exp_const_mul n (-sigma)

theorem exp_neg_mul_le_four_of_mem_Icc
    {sigma u : ℝ} (hsigma : sigma ∈ Icc (-(1 : ℝ)) 2)
    (hu : u ∈ Icc (-Real.log 2) 0) :
    Real.exp (-sigma * u) ≤ 4 := by
  have hlog0 : 0 ≤ Real.log 2 := Real.log_nonneg (by norm_num)
  have hsigmaAbs : |sigma| ≤ 2 :=
    (abs_le).2 ⟨by linarith [hsigma.1], hsigma.2⟩
  have huAbs : |u| ≤ Real.log 2 := by
    rw [abs_of_nonpos hu.2]
    linarith [hu.1]
  have hprod : |sigma * u| ≤ 2 * Real.log 2 := by
    rw [abs_mul]
    exact mul_le_mul hsigmaAbs huAbs (abs_nonneg u) (by norm_num)
  have harg : -sigma * u ≤ 2 * Real.log 2 := by
    calc
      -sigma * u = -(sigma * u) := by ring
      _ ≤ |sigma * u| := neg_le_abs _
      _ ≤ 2 * Real.log 2 := hprod
  calc
    Real.exp (-sigma * u) ≤ Real.exp (2 * Real.log 2) :=
      Real.exp_le_exp.mpr harg
    _ = 4 := by
      rw [show (2 : ℝ) * Real.log 2 = Real.log 2 + Real.log 2 by ring,
        Real.exp_add, Real.exp_log (by norm_num : (0 : ℝ) < 2)]
      norm_num

theorem norm_iteratedDeriv_goldfeldMellinStripKernel_le
    (n : ℕ) {sigma : ℝ} (hsigma : sigma ∈ Icc (-(1 : ℝ)) 2)
    (u : ℝ) :
    ‖iteratedDeriv n (goldfeldMellinStripKernel sigma) u‖ ≤
      ∑ i ∈ Finset.range (n + 1),
        (n.choose i : ℝ) * 2 ^ i * 4 *
          SchwartzMap.seminorm ℝ 0 (n - i) goldfeldMellinBaseSchwartz := by
  have hExp : ContDiffAt ℝ n (fun u : ℝ => Real.exp (-sigma * u)) u :=
    (contDiff_const.mul contDiff_id).exp.contDiffAt.of_le (by
      exact_mod_cast le_top)
  have hBase : ContDiffAt ℝ n goldfeldMellinBaseKernel u :=
    contDiff_goldfeldMellinBaseKernel.contDiffAt.of_le (by exact_mod_cast le_top)
  by_cases hu : u ∈ Icc (-Real.log 2) 0
  · rw [show goldfeldMellinStripKernel sigma =
        (fun u : ℝ => Real.exp (-sigma * u)) • goldfeldMellinBaseKernel by rfl]
    rw [iteratedDeriv_real_smul n _ _ u hExp hBase]
    apply norm_sum_le_of_le
    intro i hi
    rw [iteratedDeriv_exp_neg_mul]
    rw [RCLike.norm_nsmul (K := ℂ), nsmul_eq_mul,
      norm_smul, Real.norm_eq_abs]
    have hsigmaPow : |(-sigma) ^ i| ≤ (2 : ℝ) ^ i := by
      rw [abs_pow, abs_neg]
      exact pow_le_pow_left₀ (abs_nonneg sigma) (by
        exact (abs_le).2 ⟨by linarith [hsigma.1], hsigma.2⟩) i
    have hexp := exp_neg_mul_le_four_of_mem_Icc hsigma hu
    have hbase := norm_iteratedDeriv_goldfeldMellinBaseKernel_le_seminorm (n - i) u
    rw [abs_mul, abs_of_nonneg (Real.exp_pos _).le]
    change (n.choose i : ℝ) *
        (|(-sigma) ^ i| * Real.exp (-sigma * u) *
          ‖iteratedDeriv (n - i) goldfeldMellinBaseKernel u‖) ≤ _
    calc
      (n.choose i : ℝ) *
            (|(-sigma) ^ i| * Real.exp (-sigma * u) *
              ‖iteratedDeriv (n - i) goldfeldMellinBaseKernel u‖) ≤
          (n.choose i : ℝ) *
            ((2 : ℝ) ^ i * 4 *
              SchwartzMap.seminorm ℝ 0 (n - i) goldfeldMellinBaseSchwartz) := by
        gcongr
      _ = (n.choose i : ℝ) * 2 ^ i * 4 *
          SchwartzMap.seminorm ℝ 0 (n - i) goldfeldMellinBaseSchwartz := by ring
  · have hzero : iteratedDeriv n (goldfeldMellinStripKernel sigma) u = 0 := by
      rw [show goldfeldMellinStripKernel sigma =
        (fun u : ℝ => Real.exp (-sigma * u)) • goldfeldMellinBaseKernel by rfl]
      rw [iteratedDeriv_real_smul n _ _ u hExp hBase]
      apply Finset.sum_eq_zero
      intro i hi
      rw [iteratedDeriv_goldfeldMellinBaseKernel_eq_zero_of_not_mem (n - i) hu]
      simp
    rw [hzero, norm_zero]
    positivity

theorem hasCompactSupport_goldfeldMellinStripKernel (sigma : ℝ) :
    HasCompactSupport (goldfeldMellinStripKernel sigma) := by
  change HasCompactSupport
    ((fun u : ℝ => Real.exp (-sigma * u)) • goldfeldMellinBaseKernel)
  exact hasCompactSupport_goldfeldMellinBaseKernel.smul_left

theorem hasCompactSupport_iteratedDeriv
    {f : ℝ → ℂ} (hf : HasCompactSupport f) :
    ∀ n : ℕ, HasCompactSupport (iteratedDeriv n f) := by
  intro n
  rw [iteratedDeriv_eq_equiv_comp]
  exact (hf.iteratedFDeriv (𝕜 := ℝ) n).comp_left (map_zero _)

theorem integrable_iteratedDeriv_goldfeldMellinStripKernel
    (sigma : ℝ) (n : ℕ) :
    Integrable (iteratedDeriv n (goldfeldMellinStripKernel sigma)) := by
  apply Continuous.integrable_of_hasCompactSupport
  · exact (contDiff_goldfeldMellinStripKernel sigma).continuous_iteratedDeriv n (by
      exact_mod_cast le_top)
  · exact hasCompactSupport_iteratedDeriv
      (hasCompactSupport_goldfeldMellinStripKernel sigma) n

theorem iteratedDeriv_goldfeldMellinStripKernel_eq_zero_of_not_mem
    (n : ℕ) (sigma : ℝ) {u : ℝ}
    (hu : u ∉ Icc (-Real.log 2) 0) :
    iteratedDeriv n (goldfeldMellinStripKernel sigma) u = 0 := by
  have heq : Set.EqOn (goldfeldMellinStripKernel sigma) 0
      (Icc (-Real.log 2) 0)ᶜ := by
    intro v hv
    simp [goldfeldMellinStripKernel,
      Function.support_subset_iff'.mp support_goldfeldMellinBaseKernel_subset v hv]
  simpa using heq.iteratedDeriv_of_isOpen isClosed_Icc.isOpen_compl n hu

theorem integral_norm_iteratedDeriv_goldfeldMellinStripKernel_le
    (n : ℕ) {sigma : ℝ} (hsigma : sigma ∈ Icc (-(1 : ℝ)) 2) :
    ∫ u : ℝ, ‖iteratedDeriv n (goldfeldMellinStripKernel sigma) u‖ ≤
      (∑ i ∈ Finset.range (n + 1),
        (n.choose i : ℝ) * 2 ^ i * 4 *
          SchwartzMap.seminorm ℝ 0 (n - i) goldfeldMellinBaseSchwartz) * Real.log 2 := by
  let M : ℝ := ∑ i ∈ Finset.range (n + 1),
    (n.choose i : ℝ) * 2 ^ i * 4 *
      SchwartzMap.seminorm ℝ 0 (n - i) goldfeldMellinBaseSchwartz
  have hM : 0 ≤ M := by
    dsimp [M]
    positivity
  have hsupport : (fun u : ℝ => ‖iteratedDeriv n (goldfeldMellinStripKernel sigma) u‖) =
      (Icc (-Real.log 2) 0).indicator
        (fun u : ℝ => ‖iteratedDeriv n (goldfeldMellinStripKernel sigma) u‖) := by
    funext u
    by_cases hu : u ∈ Icc (-Real.log 2) 0
    · simp [hu]
    · rw [iteratedDeriv_goldfeldMellinStripKernel_eq_zero_of_not_mem n sigma hu]
      simp [hu]
  rw [hsupport, integral_indicator measurableSet_Icc]
  calc
    (∫ u : ℝ in Icc (-Real.log 2) 0,
        ‖iteratedDeriv n (goldfeldMellinStripKernel sigma) u‖) ≤
        ∫ _u : ℝ in Icc (-Real.log 2) 0, M := by
      apply setIntegral_mono_on
      · exact
          (integrable_iteratedDeriv_goldfeldMellinStripKernel sigma n).norm.integrableOn
      · apply integrableOn_const
        · exact ne_of_lt isCompact_Icc.measure_lt_top
        · finiteness
      · exact measurableSet_Icc
      · intro u hu
        simpa [M] using norm_iteratedDeriv_goldfeldMellinStripKernel_le n hsigma u
    _ = M * Real.log 2 := by
      rw [setIntegral_const, Measure.real, Real.volume_Icc]
      rw [show 0 - -Real.log 2 = Real.log 2 by ring]
      rw [ENNReal.toReal_ofReal (Real.log_nonneg (by norm_num))]
      simp [smul_eq_mul, mul_comm]
    _ = (∑ i ∈ Finset.range (n + 1),
        (n.choose i : ℝ) * 2 ^ i * 4 *
          SchwartzMap.seminorm ℝ 0 (n - i) goldfeldMellinBaseSchwartz) *
            Real.log 2 := rfl

theorem abs_pow_mul_norm_fourier_goldfeldMellinStripKernel_le
    (n : ℕ) {sigma : ℝ} (hsigma : sigma ∈ Icc (-(1 : ℝ)) 2)
    (t : ℝ) :
    |t| ^ n * ‖𝓕 (goldfeldMellinStripKernel sigma) (t / (2 * π))‖ ≤
      (∑ i ∈ Finset.range (n + 1),
        (n.choose i : ℝ) * 2 ^ i * 4 *
          SchwartzMap.seminorm ℝ 0 (n - i) goldfeldMellinBaseSchwartz) * Real.log 2 := by
  let xi : ℝ := t / (2 * π)
  have hFourier := congrFun
    (Real.fourier_iteratedDeriv (N := n)
      ((contDiff_goldfeldMellinStripKernel sigma).of_le (by exact_mod_cast le_top))
      (fun m _hm => integrable_iteratedDeriv_goldfeldMellinStripKernel sigma m)
      (n := n) (by rfl)) xi
  have hfreq : ‖(2 * (π : ℂ) * I * (xi : ℂ))‖ = |t| := by
    have hcoeff : 2 * (π : ℂ) * I * (xi : ℂ) = (t : ℂ) * I := by
      dsimp [xi]
      push_cast
      field_simp [Real.pi_ne_zero]
    rw [hcoeff, norm_mul, norm_I, mul_one, norm_real, Real.norm_eq_abs]
  calc
    |t| ^ n * ‖𝓕 (goldfeldMellinStripKernel sigma) (t / (2 * π))‖ =
        ‖(2 * (π : ℂ) * I * (xi : ℂ)) ^ n •
          𝓕 (goldfeldMellinStripKernel sigma) xi‖ := by
      rw [norm_smul, norm_pow, hfreq]
    _ = ‖𝓕 (iteratedDeriv n (goldfeldMellinStripKernel sigma)) xi‖ := by
      rw [hFourier]
    _ ≤ ∫ u : ℝ, ‖iteratedDeriv n (goldfeldMellinStripKernel sigma) u‖ :=
      VectorFourier.norm_fourierIntegral_le_integral_norm
        𝐞 volume (innerₗ ℝ) (iteratedDeriv n (goldfeldMellinStripKernel sigma)) xi
    _ ≤ (∑ i ∈ Finset.range (n + 1),
        (n.choose i : ℝ) * 2 ^ i * 4 *
          SchwartzMap.seminorm ℝ 0 (n - i) goldfeldMellinBaseSchwartz) * Real.log 2 :=
      integral_norm_iteratedDeriv_goldfeldMellinStripKernel_le n hsigma

end GoldfeldMellinStripDecay

theorem goldfeldPlateauMellinContinuation_decay_on_closedStrip
    (A : ℕ) (_hA : 1 ≤ A) :
    ∃ C : ℝ, 0 < C ∧
      ∀ sigma t : ℝ, sigma ∈ Icc (-(1 : ℝ)) 2 →
        1 ≤ |t| →
          ‖goldfeldPlateauMellinContinuation ((sigma : ℂ) + t * I)‖ ≤
            C / (1 + |t|) ^ A := by
  let M : ℝ := (∑ i ∈ Finset.range (A + 1),
    (A.choose i : ℝ) * 2 ^ i * 4 *
      SchwartzMap.seminorm ℝ 0 (A - i) goldfeldMellinBaseSchwartz) * Real.log 2
  have hM : 0 ≤ M := by
    dsimp [M]
    positivity
  let C : ℝ := (M + 1) * 2 ^ A
  have hC : 0 < C := by
    dsimp [C]
    positivity
  refine ⟨C, hC, ?_⟩
  intro sigma t hsigma ht
  let s : ℂ := (sigma : ℂ) + t * I
  have htpos : 0 < |t| := zero_lt_one.trans_le ht
  have hsNorm : (1 : ℝ) ≤ ‖s‖ := by
    have him := Complex.abs_im_le_norm s
    have him' : |t| ≤ ‖s‖ := by simpa [s] using him
    exact ht.trans him'
  have hcandidate :
      ‖goldfeldPlateauMellinContinuation s‖ ≤ ‖goldfeldDerivativeMellin s‖ := by
    rw [goldfeldPlateauMellinContinuation, norm_div, norm_neg]
    exact div_le_self (norm_nonneg _) hsNorm
  have hfourier :
      ‖goldfeldDerivativeMellin s‖ =
        ‖𝓕 (goldfeldMellinStripKernel sigma) (t / (2 * π))‖ := by
    rw [goldfeldDerivativeMellin_eq_fourier]
  have hpow := abs_pow_mul_norm_fourier_goldfeldMellinStripKernel_le A hsigma t
  have hfourierDecay :
      ‖𝓕 (goldfeldMellinStripKernel sigma) (t / (2 * π))‖ ≤ M / |t| ^ A := by
    apply (le_div_iff₀ (pow_pos htpos A)).2
    simpa [M, mul_comm] using hpow
  have hscale : 1 + |t| ≤ 2 * |t| := by linarith
  have hpowscale : (1 + |t|) ^ A ≤ (2 * |t|) ^ A :=
    pow_le_pow_left₀ (by positivity) hscale A
  have hconvert : M / |t| ^ A ≤ C / (1 + |t|) ^ A := by
    apply (div_le_div_iff₀ (pow_pos htpos A) (by positivity)).2
    calc
      M * (1 + |t|) ^ A ≤ M * (2 * |t|) ^ A :=
        mul_le_mul_of_nonneg_left hpowscale hM
      _ ≤ (M + 1) * (2 * |t|) ^ A := by
        gcongr
        linarith
      _ = C * |t| ^ A := by
        dsimp [C]
        rw [mul_pow]
        ring
  calc
    ‖goldfeldPlateauMellinContinuation s‖ ≤ ‖goldfeldDerivativeMellin s‖ := hcandidate
    _ = ‖𝓕 (goldfeldMellinStripKernel sigma) (t / (2 * π))‖ := hfourier
    _ ≤ M / |t| ^ A := hfourierDecay
    _ ≤ C / (1 + |t|) ^ A := hconvert

theorem goldfeldMellinContinuation_decay_on_closedStrip
    (A : ℕ) (hA : 1 ≤ A) :
    ∃ C : ℝ, 0 < C ∧
      ∀ sigma t : ℝ, sigma ∈ Icc (-(1 : ℝ)) 2 →
        1 ≤ |t| →
          ‖goldfeldMellinContinuationData.Phi
              ((sigma : ℂ) + t * I)‖ ≤
            C / (1 + |t|) ^ A := by
  obtain ⟨C, hC, hbound⟩ :=
    goldfeldPlateauMellinContinuation_decay_on_closedStrip A hA
  refine ⟨C, hC, ?_⟩
  intro sigma t hsigma ht
  rw [goldfeldMellinContinuationData.eq_plateauMellinContinuation]
  exact hbound sigma t hsigma ht

end

section
open Complex Set
open scoped Interval

section GoldfeldHorizontalEdge

attribute [local instance] goldfeldLcmNeZero
theorem goldfeld_mul_decay_bound
    {q u x C : ℝ} {A : ℕ} (hq : 0 ≤ q) (hu : 0 ≤ u)
    (_hx : 0 ≤ x) (hC : 0 ≤ C) :
    (q * (u + 2)) ^ A * (C / (1 + u) ^ (A + 2)) * x ^ 2 ≤
      (C * (2 : ℝ) ^ A) * q ^ A * x ^ 2 / (1 + u) ^ 2 := by
  have hbase : u + 2 ≤ 2 * (1 + u) := by linarith
  have hpow : (u + 2) ^ A ≤ (2 * (1 + u)) ^ A :=
    pow_le_pow_left₀ (by linarith) hbase A
  have hqpow : 0 ≤ q ^ A := pow_nonneg hq A
  have hprod :
      q ^ A * (u + 2) ^ A * (C / (1 + u) ^ (A + 2)) * x ^ 2 ≤
        q ^ A * (2 * (1 + u)) ^ A *
          (C / (1 + u) ^ (A + 2)) * x ^ 2 := by
    gcongr
  calc
    (q * (u + 2)) ^ A * (C / (1 + u) ^ (A + 2)) * x ^ 2 =
        q ^ A * (u + 2) ^ A * (C / (1 + u) ^ (A + 2)) * x ^ 2 := by
      rw [mul_pow]
    _ ≤ q ^ A * (2 * (1 + u)) ^ A *
          (C / (1 + u) ^ (A + 2)) * x ^ 2 := hprod
    _ = (C * (2 : ℝ) ^ A) * q ^ A * x ^ 2 / (1 + u) ^ 2 := by
      rw [mul_pow]
      field_simp
      ring

theorem norm_goldfeldContourIntegrand_horizontal_le_of_bounds
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    {chi1 : DirichletCharacter ℂ q1}
    {chi : DirichletCharacter ℂ q}
    {A : ℕ} {Cphi beta x sigma t : ℝ}
    (hx : 1 ≤ x)
    (hsigma : sigma ∈ Icc (-(1 : ℝ)) 2) (ht : 1 ≤ |t|)
    (hF : ‖goldfeldFourFactorLFunction chi1 chi
        (((sigma : ℂ) + t * I) + (beta : ℂ))‖ ≤
      ((q : ℝ) * (|t| + 2)) ^ A)
    (hPhi : ‖goldfeldMellinContinuationData.Phi
        ((sigma : ℂ) + t * I)‖ ≤ Cphi / (1 + |t|) ^ (A + 2))
    (hCphi : 0 ≤ Cphi) :
    ‖goldfeldContourIntegrand chi1 chi beta x
        ((sigma : ℂ) + t * I)‖ ≤
      (Cphi * (2 : ℝ) ^ A) * (q : ℝ) ^ A * x ^ 2 /
        (1 + |t|) ^ 2 := by
  have hxpos : 0 < x := lt_of_lt_of_le zero_lt_one hx
  have hq0 : (0 : ℝ) ≤ q := by positivity
  have hsigmaPow : x ^ sigma ≤ x ^ (2 : ℕ) := by
    calc
      x ^ sigma ≤ x ^ (2 : ℝ) :=
        Real.rpow_le_rpow_of_exponent_le hx hsigma.2
      _ = x ^ (2 : ℕ) := Real.rpow_two x
  have hpowprod := goldfeld_mul_decay_bound (A := A) hq0 (abs_nonneg t)
    (by positivity : 0 ≤ x) hCphi
  have hcpow : ‖(x : ℂ) ^ ((sigma : ℂ) + t * I)‖ = x ^ sigma := by
    rw [Complex.norm_cpow_eq_rpow_re_of_pos hxpos]
    simp
  rw [goldfeldContourIntegrand, norm_mul, norm_mul, hcpow]
  calc
    ‖goldfeldFourFactorLFunction chi1 chi
        (((sigma : ℂ) + t * I) + (beta : ℂ))‖ *
        ‖goldfeldMellinContinuationData.Phi ((sigma : ℂ) + t * I)‖ *
        x ^ sigma ≤
      ((q : ℝ) * (|t| + 2)) ^ A *
        (Cphi / (1 + |t|) ^ (A + 2)) * x ^ 2 := by
      calc
        _ ≤
            ‖goldfeldFourFactorLFunction chi1 chi
                (((sigma : ℂ) + t * I) + (beta : ℂ))‖ *
              ‖goldfeldMellinContinuationData.Phi ((sigma : ℂ) + t * I)‖ *
              x ^ (2 : ℕ) :=
          mul_le_mul_of_nonneg_left hsigmaPow
            (mul_nonneg (norm_nonneg _) (norm_nonneg _))
        _ ≤ _ := by
          gcongr
    _ ≤ (Cphi * (2 : ℝ) ^ A) * (q : ℝ) ^ A * x ^ 2 /
          (1 + |t|) ^ 2 := hpowprod

theorem continuous_goldfeldRegularizedContourIntegrand_horizontal_plus
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    {chi1 : DirichletCharacter ℂ q1} {chi : DirichletCharacter ℂ q}
    (hchi1 : chi1 ≠ 1) (hchi : chi ≠ 1)
    (hcross : DirichletCharacter.mul chi1 chi ≠ 1)
    {beta x T : ℝ} (hx : 0 < x) (hT : 1 ≤ T) :
    Continuous (fun sigma : ℝ => goldfeldRegularizedContourIntegrand
      chi1 chi beta x ((sigma : ℂ) + T * I)) := by
  have hpath : Continuous (fun sigma : ℝ => (sigma : ℂ) + T * I) :=
    Complex.continuous_ofReal.add continuous_const
  have hnum : Continuous (goldfeldContourNumerator chi1 chi beta x) :=
    (differentiable_goldfeldContourNumerator hchi1 hchi hcross beta hx).continuous
  have hden : Continuous (fun sigma : ℝ =>
      ((sigma : ℂ) + T * I) - goldfeldShiftedZetaPole beta) :=
    hpath.sub continuous_const
  have hden_ne : ∀ sigma : ℝ,
      ((sigma : ℂ) + T * I) - goldfeldShiftedZetaPole beta ≠ 0 := by
    intro sigma hs
    have hi := congrArg Complex.im hs
    simp [goldfeldShiftedZetaPole] at hi
    linarith
  unfold goldfeldRegularizedContourIntegrand
  exact (hnum.comp hpath).div hden hden_ne

theorem continuous_goldfeldRegularizedContourIntegrand_horizontal_minus
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    {chi1 : DirichletCharacter ℂ q1} {chi : DirichletCharacter ℂ q}
    (hchi1 : chi1 ≠ 1) (hchi : chi ≠ 1)
    (hcross : DirichletCharacter.mul chi1 chi ≠ 1)
    {beta x T : ℝ} (hx : 0 < x) (hT : 1 ≤ T) :
    Continuous (fun sigma : ℝ => goldfeldRegularizedContourIntegrand
      chi1 chi beta x ((sigma : ℂ) - T * I)) := by
  have hpath : Continuous (fun sigma : ℝ => (sigma : ℂ) - T * I) :=
    Complex.continuous_ofReal.sub continuous_const
  have hnum : Continuous (goldfeldContourNumerator chi1 chi beta x) :=
    (differentiable_goldfeldContourNumerator hchi1 hchi hcross beta hx).continuous
  have hden : Continuous (fun sigma : ℝ =>
      ((sigma : ℂ) - T * I) - goldfeldShiftedZetaPole beta) :=
    hpath.sub continuous_const
  have hden_ne : ∀ sigma : ℝ,
      ((sigma : ℂ) - T * I) - goldfeldShiftedZetaPole beta ≠ 0 := by
    intro sigma hs
    have hi := congrArg Complex.im hs
    simp [goldfeldShiftedZetaPole] at hi
    linarith
  unfold goldfeldRegularizedContourIntegrand
  exact (hnum.comp hpath).div hden hden_ne

theorem goldfeldRegularizedContourIntegrand_eq_horizontal_plus
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1) (chi : DirichletCharacter ℂ q)
    {beta x T : ℝ}
    (hzero : DirichletCharacter.LFunction chi1 (beta : ℂ) = 0)
    (hT : 1 ≤ T) (sigma : ℝ) :
    goldfeldRegularizedContourIntegrand chi1 chi beta x
        ((sigma : ℂ) + T * I) =
      goldfeldContourIntegrand chi1 chi beta x
        ((sigma : ℂ) + T * I) := by
  have hTpos : 0 < T := lt_of_lt_of_le zero_lt_one hT
  have hs0 : ((sigma : ℂ) + T * I) ≠ 0 := by
    intro hs
    have hi := congrArg Complex.im hs
    simp at hi
    linarith
  have hsp : ((sigma : ℂ) + T * I) ≠ goldfeldShiftedZetaPole beta := by
    intro hs
    have hi := congrArg Complex.im hs
    simp [goldfeldShiftedZetaPole] at hi
    linarith
  exact goldfeldRegularizedContourIntegrand_eq_contourIntegrand
    chi1 chi hzero hs0 hsp

theorem goldfeldRegularizedContourIntegrand_eq_horizontal_minus
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1) (chi : DirichletCharacter ℂ q)
    {beta x T : ℝ}
    (hzero : DirichletCharacter.LFunction chi1 (beta : ℂ) = 0)
    (hT : 1 ≤ T) (sigma : ℝ) :
    goldfeldRegularizedContourIntegrand chi1 chi beta x
        ((sigma : ℂ) - T * I) =
      goldfeldContourIntegrand chi1 chi beta x
        ((sigma : ℂ) - T * I) := by
  have hTpos : 0 < T := lt_of_lt_of_le zero_lt_one hT
  have hs0 : ((sigma : ℂ) - T * I) ≠ 0 := by
    intro hs
    have hi := congrArg Complex.im hs
    simp at hi
    linarith
  have hsp : ((sigma : ℂ) - T * I) ≠ goldfeldShiftedZetaPole beta := by
    intro hs
    have hi := congrArg Complex.im hs
    simp [goldfeldShiftedZetaPole] at hi
    linarith
  exact goldfeldRegularizedContourIntegrand_eq_contourIntegrand
    chi1 chi hzero hs0 hsp

end GoldfeldHorizontalEdge
end

section
open Complex Set
open scoped Interval

attribute [local instance] goldfeldLcmNeZero
theorem exists_norm_goldfeldContourIntegrand_horizontal_le :
    ∃ A : ℕ, 57 ≤ A ∧ ∃ C : ℝ, 0 < C ∧
      ∀ (q1 q : ℕ) [NeZero q1] [NeZero q],
        1 < q1 → q1 ≤ q →
        ∀ (chi1 : DirichletCharacter ℂ q1)
          (chi : DirichletCharacter ℂ q),
          chi1 ≠ 1 → chi ≠ 1 →
          DirichletCharacter.mul chi1 chi ≠ 1 →
          ∀ (beta x sigma t : ℝ),
            0 ≤ beta → beta ≤ 1 → 1 ≤ x →
            sigma ∈ Icc (-(1 : ℝ)) 2 → 1 ≤ |t| →
            ‖goldfeldContourIntegrand chi1 chi beta x
                ((sigma : ℂ) + t * I)‖ ≤
              C * (q : ℝ) ^ A * x ^ 2 / (1 + |t|) ^ 2 := by
  obtain ⟨A, hA, hF⟩ :=
    exists_norm_goldfeldFourFactorLFunction_closedStrip_le_pow
  obtain ⟨Cphi, hCphi, hPhi⟩ :=
    goldfeldMellinContinuation_decay_on_closedStrip (A + 2) (by omega)
  let C : ℝ := Cphi * (2 : ℝ) ^ A
  have hC : 0 < C := by
    dsimp [C]
    positivity
  refine ⟨A, hA, C, hC, ?_⟩
  intro q1 q _ _ hq1 hq1q chi1 chi hchi1 hchi hcross
    beta x sigma t hbeta0 hbeta1 hx hsigma ht
  have him : (((sigma : ℂ) + t * I).im) = t := by simp
  have hF' : ‖goldfeldFourFactorLFunction chi1 chi
        (((sigma : ℂ) + t * I) + (beta : ℂ))‖ ≤
      ((q : ℝ) * (|t| + 2)) ^ A := by
    have h := hF q1 q hq1 hq1q chi1 chi hchi1 hchi hcross
      beta ((sigma : ℂ) + t * I) hbeta0 hbeta1
        (by simpa using hsigma.1) (by simpa using hsigma.2)
        (by simpa [him] using ht)
    simpa [him] using h
  have hPhi' := hPhi sigma t hsigma ht
  have hpoint := norm_goldfeldContourIntegrand_horizontal_le_of_bounds
    (A := A) (q := q) (chi1 := chi1) (chi := chi)
    hx hsigma ht hF' hPhi' hCphi.le
  simpa [C, mul_assoc, mul_left_comm, mul_comm] using hpoint

theorem intervalIntegrable_goldfeldRegularizedContourIntegrand_horizontal
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    {chi1 : DirichletCharacter ℂ q1} {chi : DirichletCharacter ℂ q}
    (hchi1 : chi1 ≠ 1) (hchi : chi ≠ 1)
    (hcross : DirichletCharacter.mul chi1 chi ≠ 1)
    {beta x T : ℝ} (hx : 0 < x) (hT : 1 ≤ T) :
    IntervalIntegrable
      (fun sigma : ℝ => goldfeldRegularizedContourIntegrand
        chi1 chi beta x ((sigma : ℂ) + T * I)) volume (-1) 2 ∧
    IntervalIntegrable
      (fun sigma : ℝ => goldfeldRegularizedContourIntegrand
        chi1 chi beta x ((sigma : ℂ) - T * I)) volume (-1) 2 :=
  ⟨(continuous_goldfeldRegularizedContourIntegrand_horizontal_plus
      hchi1 hchi hcross hx hT).intervalIntegrable _ _,
    (continuous_goldfeldRegularizedContourIntegrand_horizontal_minus
      hchi1 hchi hcross hx hT).intervalIntegrable _ _⟩

theorem goldfeldRegularizedContourIntegrand_eq_intervalIntegral_goldfeldContourIntegrand_horizontal
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    {chi1 : DirichletCharacter ℂ q1} {chi : DirichletCharacter ℂ q}
    {beta x T : ℝ}
    (hzero : DirichletCharacter.LFunction chi1 (beta : ℂ) = 0)
    (hT : 1 ≤ T) :
    (∫ sigma in (-1)..2,
      goldfeldRegularizedContourIntegrand chi1 chi beta x
        ((sigma : ℂ) + T * I)) =
      ∫ sigma in (-1)..2,
        goldfeldContourIntegrand chi1 chi beta x
          ((sigma : ℂ) + T * I) ∧
    (∫ sigma in (-1)..2,
      goldfeldRegularizedContourIntegrand chi1 chi beta x
        ((sigma : ℂ) - T * I)) =
      ∫ sigma in (-1)..2,
        goldfeldContourIntegrand chi1 chi beta x
          ((sigma : ℂ) - T * I) := by
  have hplus : Set.EqOn
      (fun sigma : ℝ => goldfeldRegularizedContourIntegrand chi1 chi beta x
        ((sigma : ℂ) + T * I))
      (fun sigma : ℝ => goldfeldContourIntegrand chi1 chi beta x
        ((sigma : ℂ) + T * I)) (uIcc (-1) 2) := by
    intro sigma _hsigma
    exact goldfeldRegularizedContourIntegrand_eq_horizontal_plus
      chi1 chi hzero hT sigma
  have hminus : Set.EqOn
      (fun sigma : ℝ => goldfeldRegularizedContourIntegrand chi1 chi beta x
        ((sigma : ℂ) - T * I))
      (fun sigma : ℝ => goldfeldContourIntegrand chi1 chi beta x
        ((sigma : ℂ) - T * I)) (uIcc (-1) 2) := by
    intro sigma _hsigma
    exact goldfeldRegularizedContourIntegrand_eq_horizontal_minus
      chi1 chi hzero hT sigma
  exact ⟨intervalIntegral.integral_congr hplus,
    intervalIntegral.integral_congr hminus⟩

theorem intervalIntegrable_goldfeldContourIntegrand_horizontal
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    {chi1 : DirichletCharacter ℂ q1} {chi : DirichletCharacter ℂ q}
    (hchi1 : chi1 ≠ 1) (hchi : chi ≠ 1)
    (hcross : DirichletCharacter.mul chi1 chi ≠ 1)
    {beta x T : ℝ} (hx : 0 < x) (hT : 1 ≤ T)
    (hzero : DirichletCharacter.LFunction chi1 (beta : ℂ) = 0) :
    IntervalIntegrable
      (fun sigma : ℝ => goldfeldContourIntegrand chi1 chi beta x
        ((sigma : ℂ) + T * I)) volume (-1) 2 ∧
    IntervalIntegrable
      (fun sigma : ℝ => goldfeldContourIntegrand chi1 chi beta x
        ((sigma : ℂ) - T * I)) volume (-1) 2 := by
  have hreg := intervalIntegrable_goldfeldRegularizedContourIntegrand_horizontal
    (beta := beta) hchi1 hchi hcross hx hT
  constructor
  · exact hreg.1.congr fun sigma _hsigma =>
      goldfeldRegularizedContourIntegrand_eq_horizontal_plus
        chi1 chi hzero hT sigma
  · exact hreg.2.congr fun sigma _hsigma =>
      goldfeldRegularizedContourIntegrand_eq_horizontal_minus
        chi1 chi hzero hT sigma

end

section
open Complex Set
open scoped Interval

attribute [local instance] goldfeldLcmNeZero
/--
The divided difference of the contour numerator about `s = 1 - beta`, using the derivative at
the center. When the numerator is analytic there, this is the analytic remainder after
subtracting its simple principal part.
-/
noncomputable def goldfeldContourAnalyticRemainder
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (beta x : ℝ) (s : ℂ) : ℂ :=
  dslope (goldfeldContourNumerator chi1 chi beta x)
    (goldfeldShiftedZetaPole beta) s

/--
The Goldfeld vertical-line integral on `re = alpha`, truncated to imaginary parameters from `-T`
to `T` and normalized by `1 / (2 * pi)`.
-/
noncomputable def goldfeldTruncatedVerticalIntegral
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (beta x alpha T : ℝ) : ℂ :=
  (((2 * Real.pi : ℝ) : ℂ)⁻¹) *
    ∫ t in (-T)..T,
      goldfeldContourIntegrand chi1 chi beta x
        ((alpha : ℂ) + t * I)

/--
The lower horizontal edge correction, oriented from `2 - T * I` to `-1 - T * I` and normalized
by `1 / (2 * pi * I)`.
-/
noncomputable def goldfeldTruncatedLowerIntegral
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (beta x T : ℝ) : ℂ :=
  ((((2 * Real.pi : ℝ) : ℂ) * I)⁻¹) *
    (-(∫ sigma in (-1)..2,
      goldfeldContourIntegrand chi1 chi beta x
        ((sigma : ℂ) - T * I)))

/--
The upper horizontal edge correction, oriented from `-1 + T * I` to `2 + T * I` and normalized
by `1 / (2 * pi * I)`.
-/
noncomputable def goldfeldTruncatedUpperIntegral
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (beta x T : ℝ) : ℂ :=
  ((((2 * Real.pi : ℝ) : ℂ) * I)⁻¹) *
    ∫ sigma in (-1)..2,
      goldfeldContourIntegrand chi1 chi beta x
        ((sigma : ℂ) + T * I)

theorem differentiable_goldfeldContourAnalyticRemainder
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    {chi1 : DirichletCharacter ℂ q1}
    {chi : DirichletCharacter ℂ q}
    (hchi1 : chi1 ≠ 1) (hchi : chi ≠ 1)
    (hcross : DirichletCharacter.mul chi1 chi ≠ 1)
    (beta : ℝ) {x : ℝ} (hx : 0 < x) :
    Differentiable ℂ
      (goldfeldContourAnalyticRemainder chi1 chi beta x) := by
  rw [← differentiableOn_univ]
  exact (Complex.differentiableOn_dslope Filter.univ_mem).2
    (differentiable_goldfeldContourNumerator
      hchi1 hchi hcross beta hx).differentiableOn

theorem goldfeldRegularizedContourIntegrand_eq_remainder_add
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    {beta x : ℝ} (hbeta : beta < 1)
    (hzero : DirichletCharacter.LFunction chi1 (beta : ℂ) = 0)
    {s : ℂ} (hs : s ≠ goldfeldShiftedZetaPole beta) :
    goldfeldRegularizedContourIntegrand chi1 chi beta x s =
      goldfeldContourAnalyticRemainder chi1 chi beta x s +
        goldfeldContourResidue chi1 chi beta x /
          (s - goldfeldShiftedZetaPole beta) := by
  have hnum := sub_smul_dslope
    (goldfeldContourNumerator chi1 chi beta x)
    (goldfeldShiftedZetaPole beta) s
  have hp := goldfeldContourNumerator_apply_shiftedZetaPole
    chi1 chi (x := x) hbeta hzero
  rw [hp] at hnum
  unfold goldfeldRegularizedContourIntegrand
    goldfeldContourAnalyticRemainder
  have hsub : s - goldfeldShiftedZetaPole beta ≠ 0 :=
    sub_ne_zero.mpr hs
  simp only [smul_eq_mul] at hnum
  apply (div_eq_iff hsub).2
  rw [add_mul, div_mul_cancel₀ _ hsub]
  calc
    goldfeldContourNumerator chi1 chi beta x s =
        (goldfeldContourNumerator chi1 chi beta x s -
          goldfeldContourResidue chi1 chi beta x) +
          goldfeldContourResidue chi1 chi beta x := by ring
    _ = (s - goldfeldShiftedZetaPole beta) *
          dslope (goldfeldContourNumerator chi1 chi beta x)
            (goldfeldShiftedZetaPole beta) s +
          goldfeldContourResidue chi1 chi beta x := by rw [hnum]
    _ = dslope (goldfeldContourNumerator chi1 chi beta x)
          (goldfeldShiftedZetaPole beta) s *
          (s - goldfeldShiftedZetaPole beta) +
          goldfeldContourResidue chi1 chi beta x := by ring

end

section
open Complex Set
open scoped Interval

section GoldfeldContourRectangle

attribute [local instance] goldfeldLcmNeZero

theorem rectangle_boundary_eq_two_pi_I_mul_of_decomposition
    (f F : ℂ → ℂ) (z w p c : ℂ)
    (hF : Differentiable ℂ F)
    (hdecomp : ∀ s, s ≠ p → f s = F s + c / (s - p))
    (hzRe : z.re < p.re) (hpRe : p.re < w.re)
    (hzIm : z.im < p.im) (hpIm : p.im < w.im) :
    Complex.wedgeIntegral z w f + Complex.wedgeIntegral w z f =
      (2 * Real.pi * I) * c := by
  let G : ℂ → ℂ := fun s => c / (s - p)
  have hFcontinuous : Continuous F := hF.continuous
  have hFbottom : IntervalIntegrable
      (fun t : ℝ => F ((t : ℂ) + z.im * I)) volume z.re w.re :=
    (hFcontinuous.comp (by fun_prop)).intervalIntegrable _ _
  have hFtop : IntervalIntegrable
      (fun t : ℝ => F ((t : ℂ) + w.im * I)) volume w.re z.re :=
    (hFcontinuous.comp (by fun_prop)).intervalIntegrable _ _
  have hFright : IntervalIntegrable
      (fun t : ℝ => F ((w.re : ℂ) + t * I)) volume z.im w.im :=
    (hFcontinuous.comp (by fun_prop)).intervalIntegrable _ _
  have hFleft : IntervalIntegrable
      (fun t : ℝ => F ((z.re : ℂ) + t * I)) volume w.im z.im :=
    (hFcontinuous.comp (by fun_prop)).intervalIntegrable _ _
  have hGbottom : IntervalIntegrable
      (fun t : ℝ => G ((t : ℂ) + z.im * I)) volume z.re w.re :=
    (continuous_horizontal_principal_part c p z.im
      (ne_of_lt hzIm)).intervalIntegrable _ _
  have hGtop : IntervalIntegrable
      (fun t : ℝ => G ((t : ℂ) + w.im * I)) volume w.re z.re :=
    (continuous_horizontal_principal_part c p w.im
      (ne_of_gt hpIm)).intervalIntegrable _ _
  have hGright : IntervalIntegrable
      (fun t : ℝ => G ((w.re : ℂ) + t * I)) volume z.im w.im :=
    (continuous_vertical_principal_part c p w.re
      (ne_of_gt hpRe)).intervalIntegrable _ _
  have hGleft : IntervalIntegrable
      (fun t : ℝ => G ((z.re : ℂ) + t * I)) volume w.im z.im :=
    (continuous_vertical_principal_part c p z.re
      (ne_of_lt hzRe)).intervalIntegrable _ _
  have hnotBottom (t : ℝ) : (t : ℂ) + z.im * I ≠ p := by
    intro h
    exact (ne_of_lt hzIm) (by simpa using congrArg Complex.im h)
  have hnotTop (t : ℝ) : (t : ℂ) + w.im * I ≠ p := by
    intro h
    exact (ne_of_gt hpIm) (by simpa using congrArg Complex.im h)
  have hnotRight (t : ℝ) : (w.re : ℂ) + t * I ≠ p := by
    intro h
    exact (ne_of_gt hpRe) (by simpa using congrArg Complex.re h)
  have hnotLeft (t : ℝ) : (z.re : ℂ) + t * I ≠ p := by
    intro h
    exact (ne_of_lt hzRe) (by simpa using congrArg Complex.re h)
  have hbottom :
      (∫ t : ℝ in z.re..w.re, f ((t : ℂ) + z.im * I)) =
        ∫ t : ℝ in z.re..w.re,
          F ((t : ℂ) + z.im * I) + G ((t : ℂ) + z.im * I) := by
    apply intervalIntegral.integral_congr
    intro t _ht
    exact hdecomp _ (hnotBottom t)
  have htop :
      (∫ t : ℝ in w.re..z.re, f ((t : ℂ) + w.im * I)) =
        ∫ t : ℝ in w.re..z.re,
          F ((t : ℂ) + w.im * I) + G ((t : ℂ) + w.im * I) := by
    apply intervalIntegral.integral_congr
    intro t _ht
    exact hdecomp _ (hnotTop t)
  have hright :
      (∫ t : ℝ in z.im..w.im, f ((w.re : ℂ) + t * I)) =
        ∫ t : ℝ in z.im..w.im,
          F ((w.re : ℂ) + t * I) + G ((w.re : ℂ) + t * I) := by
    apply intervalIntegral.integral_congr
    intro t _ht
    exact hdecomp _ (hnotRight t)
  have hleft :
      (∫ t : ℝ in w.im..z.im, f ((z.re : ℂ) + t * I)) =
        ∫ t : ℝ in w.im..z.im,
          F ((z.re : ℂ) + t * I) + G ((z.re : ℂ) + t * I) := by
    apply intervalIntegral.integral_congr
    intro t _ht
    exact hdecomp _ (hnotLeft t)
  have hzw : Complex.wedgeIntegral z w f =
      Complex.wedgeIntegral z w F + Complex.wedgeIntegral z w G := by
    simp only [Complex.wedgeIntegral]
    rw [hbottom, hright,
      intervalIntegral.integral_add hFbottom hGbottom,
      intervalIntegral.integral_add hFright hGright]
    simp only [smul_add]
    abel
  have hwz : Complex.wedgeIntegral w z f =
      Complex.wedgeIntegral w z F + Complex.wedgeIntegral w z G := by
    simp only [Complex.wedgeIntegral]
    rw [htop, hleft,
      intervalIntegral.integral_add hFtop hGtop,
      intervalIntegral.integral_add hFleft hGleft]
    simp only [smul_add]
    abel
  have hFzero : Complex.wedgeIntegral z w F +
      Complex.wedgeIntegral w z F = 0 := by
    have hconservative := hF.differentiableOn.isConservativeOn z w
      (fun _ _ => mem_univ _)
    rw [hconservative]
    simp
  have hGsum : Complex.wedgeIntegral z w G +
      Complex.wedgeIntegral w z G = (2 * Real.pi * I) * c :=
    wedgeIntegral_add_wedgeIntegral_div_sub_eq_two_pi_I_mul
      z w p c hzRe hpRe hzIm hpIm
  rw [hzw, hwz]
  calc
    (Complex.wedgeIntegral z w F + Complex.wedgeIntegral z w G) +
        (Complex.wedgeIntegral w z F + Complex.wedgeIntegral w z G) =
      (Complex.wedgeIntegral z w F + Complex.wedgeIntegral w z F) +
        (Complex.wedgeIntegral z w G + Complex.wedgeIntegral w z G) := by
          abel
    _ = (2 * Real.pi * I) * c := by rw [hFzero, hGsum, zero_add]

end GoldfeldContourRectangle
end

section
open Complex Set
open scoped Interval

attribute [local instance] goldfeldLcmNeZero
theorem goldfeldRegularizedContourIntegrand_rectangle_boundary_eq
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (hchi1 : chi1 ≠ 1) (hchi : chi ≠ 1)
    (hcross : DirichletCharacter.mul chi1 chi ≠ 1)
    {beta x T : ℝ}
    (hbeta0 : 0 ≤ beta) (hbeta1 : beta < 1)
    (hx : 0 < x) (hT : 1 ≤ T)
    (hzero : DirichletCharacter.LFunction chi1 (beta : ℂ) = 0) :
    (∫ sigma in (-1)..2,
        goldfeldRegularizedContourIntegrand chi1 chi beta x
          ((sigma : ℂ) - T * I)) -
      (∫ sigma in (-1)..2,
        goldfeldRegularizedContourIntegrand chi1 chi beta x
          ((sigma : ℂ) + T * I)) +
      I * (∫ t in (-T)..T,
        goldfeldRegularizedContourIntegrand chi1 chi beta x
          ((2 : ℂ) + t * I)) -
      I * (∫ t in (-T)..T,
        goldfeldRegularizedContourIntegrand chi1 chi beta x
          ((-1 : ℂ) + t * I)) =
      (2 * Real.pi * I) *
        goldfeldContourResidue chi1 chi beta x := by
  let z : ℂ := (-1 : ℂ) - T * I
  let w : ℂ := (2 : ℂ) + T * I
  let p : ℂ := goldfeldShiftedZetaPole beta
  let f : ℂ → ℂ := goldfeldRegularizedContourIntegrand chi1 chi beta x
  let F : ℂ → ℂ := goldfeldContourAnalyticRemainder chi1 chi beta x
  let c : ℂ := goldfeldContourResidue chi1 chi beta x
  have hzRe : z.re < p.re := by
    simp [z, p, goldfeldShiftedZetaPole]
    linarith
  have hpRe : p.re < w.re := by
    simp [w, p, goldfeldShiftedZetaPole]
    linarith
  have hzIm : z.im < p.im := by
    simp [z, p, goldfeldShiftedZetaPole]
    linarith
  have hpIm : p.im < w.im := by
    simp [w, p, goldfeldShiftedZetaPole]
    linarith
  have hboundary := rectangle_boundary_eq_two_pi_I_mul_of_decomposition
    f F z w p c
    (differentiable_goldfeldContourAnalyticRemainder
      hchi1 hchi hcross beta hx)
    (fun s hs => goldfeldRegularizedContourIntegrand_eq_remainder_add
      chi1 chi hbeta1 hzero hs)
    hzRe hpRe hzIm hpIm
  rw [Complex.wedgeIntegral_add_wedgeIntegral_eq] at hboundary
  simpa [f, F, c, z, w, p, smul_eq_mul, sub_eq_add_neg] using hboundary

theorem goldfeldContourIntegrand_truncated_rectangle_decomposition
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (hchi1 : chi1 ≠ 1) (hchi : chi ≠ 1)
    (hcross : DirichletCharacter.mul chi1 chi ≠ 1)
    {beta x T : ℝ}
    (hbeta0 : 0 ≤ beta) (hbeta1 : beta < 1)
    (hx : 0 < x) (hT : 1 ≤ T)
    (hzero : DirichletCharacter.LFunction chi1 (beta : ℂ) = 0) :
    goldfeldTruncatedVerticalIntegral chi1 chi beta x 2 T =
      goldfeldTruncatedLowerIntegral chi1 chi beta x T +
        goldfeldTruncatedVerticalIntegral chi1 chi beta x (-1) T +
        goldfeldTruncatedUpperIntegral chi1 chi beta x T +
        goldfeldContourResidue chi1 chi beta x := by
  have hboundary :=
    goldfeldRegularizedContourIntegrand_rectangle_boundary_eq
      chi1 chi hchi1 hchi hcross hbeta0 hbeta1 hx hT hzero
  have hhorizontal :=
    goldfeldRegularizedContourIntegrand_eq_intervalIntegral_goldfeldContourIntegrand_horizontal
      (chi1 := chi1) (chi := chi) (x := x) hzero hT
  have hright :
      (∫ t in (-T)..T,
        goldfeldRegularizedContourIntegrand chi1 chi beta x
          ((2 : ℂ) + t * I)) =
      ∫ t in (-T)..T,
        goldfeldContourIntegrand chi1 chi beta x
          ((2 : ℂ) + t * I) := by
    apply intervalIntegral.integral_congr
    intro t _ht
    exact goldfeldRegularizedContourIntegrand_eq_contourIntegrand
      chi1 chi hzero (by
        intro hs
        have hre := congrArg Complex.re hs
        norm_num at hre)
      (by
        intro hs
        have hre := congrArg Complex.re hs
        simp [goldfeldShiftedZetaPole] at hre
        linarith)
  have hleft :
      (∫ t in (-T)..T,
        goldfeldRegularizedContourIntegrand chi1 chi beta x
          ((-1 : ℂ) + t * I)) =
      ∫ t in (-T)..T,
        goldfeldContourIntegrand chi1 chi beta x
          ((-1 : ℂ) + t * I) := by
    apply intervalIntegral.integral_congr
    intro t _ht
    exact goldfeldRegularizedContourIntegrand_eq_contourIntegrand
      chi1 chi hzero (by
        intro hs
        have hre := congrArg Complex.re hs
        norm_num at hre)
      (by
        intro hs
        have hre := congrArg Complex.re hs
        simp [goldfeldShiftedZetaPole] at hre
        linarith)
  rw [hhorizontal.2, hhorizontal.1, hright, hleft] at hboundary
  let lower : ℂ := ∫ sigma in (-1)..2,
    goldfeldContourIntegrand chi1 chi beta x
      ((sigma : ℂ) - T * I)
  let upper : ℂ := ∫ sigma in (-1)..2,
    goldfeldContourIntegrand chi1 chi beta x
      ((sigma : ℂ) + T * I)
  let right : ℂ := ∫ t in (-T)..T,
    goldfeldContourIntegrand chi1 chi beta x
      ((2 : ℂ) + t * I)
  let left : ℂ := ∫ t in (-T)..T,
    goldfeldContourIntegrand chi1 chi beta x
      ((-1 : ℂ) + t * I)
  change lower - upper + I * right - I * left =
    (2 * Real.pi * I) * goldfeldContourResidue chi1 chi beta x at hboundary
  have hIright :
      I * right =
        (2 * Real.pi * I) * goldfeldContourResidue chi1 chi beta x -
          lower + upper + I * left := by
    linear_combination hboundary
  have hmainMul :
      -I * ((2 * Real.pi * I) *
        goldfeldContourResidue chi1 chi beta x) =
        (((2 * Real.pi : ℝ) : ℂ)) *
          goldfeldContourResidue chi1 chi beta x := by
    calc
      _ = (-I * I) * ((((2 * Real.pi : ℝ) : ℂ)) *
          goldfeldContourResidue chi1 chi beta x) := by
        push_cast
        ring
      _ = _ := by rw [neg_mul, I_mul_I]; simp
  have hleftMul : -I * (I * left) = left := by
    rw [← mul_assoc, neg_mul, I_mul_I]
    simp
  have hrightEq :
      right = (((2 * Real.pi : ℝ) : ℂ)) *
          goldfeldContourResidue chi1 chi beta x +
        I * lower - I * upper + left := by
    calc
      _ = -I * (I * right) := by
        rw [← mul_assoc, neg_mul, I_mul_I]
        simp
      _ = -I * ((2 * Real.pi * I) *
          goldfeldContourResidue chi1 chi beta x -
          lower + upper + I * left) := by rw [hIright]
      _ = _ := by
        rw [mul_add, mul_add, mul_sub, hmainMul, hleftMul]
        ring
  simp only [goldfeldTruncatedVerticalIntegral,
    goldfeldTruncatedLowerIntegral, goldfeldTruncatedUpperIntegral]
  norm_num only [ofReal_neg, ofReal_one]
  change (((2 * Real.pi : ℝ) : ℂ)⁻¹) * right =
    ((((2 * Real.pi : ℝ) : ℂ) * I)⁻¹) * (-lower) +
      (((2 * Real.pi : ℝ) : ℂ)⁻¹) * left +
      ((((2 * Real.pi : ℝ) : ℂ) * I)⁻¹) * upper +
      goldfeldContourResidue chi1 chi beta x
  have hpi : (((2 * Real.pi : ℝ) : ℂ)) ≠ 0 := by
    exact_mod_cast Real.two_pi_pos.ne'
  rw [hrightEq]
  field_simp [hpi, I_ne_zero]
  simp [mul_add, mul_sub, ← mul_assoc, I_mul_I]
  ring

end

section
open Complex Set
open scoped Interval

section GoldfeldHorizontalEdgeLimit

attribute [local instance] goldfeldLcmNeZero
theorem norm_intervalIntegral_le_const_of_intervalIntegrable
    {f : ℝ → ℂ} {a b M : ℝ} (hab : a ≤ b)
    (hf : IntervalIntegrable f volume a b)
    (hpoint : ∀ x ∈ Icc a b, ‖f x‖ ≤ M) :
    ‖∫ x in a..b, f x‖ ≤ M * (b - a) := by
  simpa [mul_comm] using
    (intervalIntegral.norm_integral_le_integral_norm hab).trans
      (intervalIntegral.integral_mono_on hab hf.norm intervalIntegrable_const hpoint)

end GoldfeldHorizontalEdgeLimit
end

section
open Complex Set
open scoped Interval

attribute [local instance] goldfeldLcmNeZero
theorem exists_norm_intervalIntegral_goldfeldContourIntegrand_horizontal_le :
    ∃ A : ℕ, 57 ≤ A ∧ ∃ C : ℝ, 0 < C ∧
      ∀ (q1 q : ℕ) [NeZero q1] [NeZero q],
        1 < q1 → q1 ≤ q →
        ∀ (chi1 : DirichletCharacter ℂ q1)
          (chi : DirichletCharacter ℂ q),
          chi1 ≠ 1 → chi ≠ 1 →
          DirichletCharacter.mul chi1 chi ≠ 1 →
          ∀ (beta x T : ℝ),
            0 ≤ beta → beta ≤ 1 → 1 ≤ x → 1 ≤ T →
            DirichletCharacter.LFunction chi1 (beta : ℂ) = 0 →
            (‖∫ sigma in (-1)..2,
              goldfeldContourIntegrand chi1 chi beta x
                ((sigma : ℂ) + T * I)‖ ≤
                3 * C * (q : ℝ) ^ A * x ^ 2 / (1 + |T|) ^ 2) ∧
            (‖∫ sigma in (-1)..2,
              goldfeldContourIntegrand chi1 chi beta x
                ((sigma : ℂ) - T * I)‖ ≤
                3 * C * (q : ℝ) ^ A * x ^ 2 / (1 + |T|) ^ 2) := by
  obtain ⟨A, hA, C, hC, hpoint⟩ :=
    exists_norm_goldfeldContourIntegrand_horizontal_le
  refine ⟨A, hA, C, hC, ?_⟩
  intro q1 q _ _ hq1 hq1q chi1 chi hchi1 hchi hcross
    beta x T hbeta0 hbeta1 hx hT hzero
  have hTpos : 0 < T := lt_of_lt_of_le zero_lt_one hT
  have hTabs : 1 ≤ |T| := by simpa [abs_of_pos hTpos] using hT
  have hraw := intervalIntegrable_goldfeldContourIntegrand_horizontal
    (beta := beta) hchi1 hchi hcross (zero_lt_one.trans_le hx) hT hzero
  have hplusBound : ∀ sigma ∈ Icc (-(1 : ℝ)) 2,
      ‖goldfeldContourIntegrand chi1 chi beta x
        ((sigma : ℂ) + T * I)‖ ≤
        C * (q : ℝ) ^ A * x ^ 2 / (1 + |T|) ^ 2 := by
    intro sigma hsigma
    exact hpoint q1 q hq1 hq1q chi1 chi hchi1 hchi hcross
      beta x sigma T hbeta0 hbeta1 hx hsigma hTabs
  have hminusBound : ∀ sigma ∈ Icc (-(1 : ℝ)) 2,
      ‖goldfeldContourIntegrand chi1 chi beta x
        ((sigma : ℂ) - T * I)‖ ≤
        C * (q : ℝ) ^ A * x ^ 2 / (1 + |T|) ^ 2 := by
    intro sigma hsigma
    have h := hpoint q1 q hq1 hq1q chi1 chi hchi1 hchi hcross
      beta x sigma (-T) hbeta0 hbeta1 hx hsigma
      (by simpa [abs_of_pos hTpos, abs_neg] using hT)
    simpa [sub_eq_add_neg, abs_neg] using h
  have hplus := norm_intervalIntegral_le_const_of_intervalIntegrable
    (by norm_num : (-1 : ℝ) ≤ 2) hraw.1 hplusBound
  have hminus := norm_intervalIntegral_le_const_of_intervalIntegrable
    (by norm_num : (-1 : ℝ) ≤ 2) hraw.2 hminusBound
  constructor
  · calc
      ‖∫ sigma in (-1)..2,
          goldfeldContourIntegrand chi1 chi beta x
            ((sigma : ℂ) + T * I)‖ ≤
          (C * (q : ℝ) ^ A * x ^ 2 / (1 + |T|) ^ 2) *
            ((2 : ℝ) - (-1)) := hplus
      _ = 3 * C * (q : ℝ) ^ A * x ^ 2 / (1 + |T|) ^ 2 := by ring
  · calc
      ‖∫ sigma in (-1)..2,
          goldfeldContourIntegrand chi1 chi beta x
            ((sigma : ℂ) - T * I)‖ ≤
          (C * (q : ℝ) ^ A * x ^ 2 / (1 + |T|) ^ 2) *
            ((2 : ℝ) - (-1)) := hminus
      _ = 3 * C * (q : ℝ) ^ A * x ^ 2 / (1 + |T|) ^ 2 := by ring

theorem exists_tendsto_goldfeldContourIntegrand_horizontal_integrals_zero :
    ∃ A : ℕ, 57 ≤ A ∧ ∃ C : ℝ, 0 < C ∧
      ∀ (q1 q : ℕ) [NeZero q1] [NeZero q],
        1 < q1 → q1 ≤ q →
        ∀ (chi1 : DirichletCharacter ℂ q1)
          (chi : DirichletCharacter ℂ q),
          chi1 ≠ 1 → chi ≠ 1 →
          DirichletCharacter.mul chi1 chi ≠ 1 →
          ∀ (beta x : ℝ),
            0 ≤ beta → beta ≤ 1 → 1 ≤ x →
            DirichletCharacter.LFunction chi1 (beta : ℂ) = 0 →
            Tendsto
              (fun T : ℝ => ∫ sigma in (-1)..2,
                goldfeldContourIntegrand chi1 chi beta x
                  ((sigma : ℂ) + T * I)) atTop (𝓝 0) ∧
            Tendsto
              (fun T : ℝ => -(∫ sigma in (-1)..2,
                goldfeldContourIntegrand chi1 chi beta x
                  ((sigma : ℂ) - T * I))) atTop (𝓝 0) := by
  obtain ⟨A, hA, C, hC, hbound⟩ :=
    exists_norm_intervalIntegral_goldfeldContourIntegrand_horizontal_le
  refine ⟨A, hA, C, hC, ?_⟩
  intro q1 q _ _ hq1 hq1q chi1 chi hchi1 hchi hcross
    beta x hbeta0 hbeta1 hx hzero
  let K : ℝ := 3 * C * (q : ℝ) ^ A * x ^ 2
  have hlinear : Tendsto (fun T : ℝ => 1 + T) atTop atTop := by
    simpa [add_comm] using
      (tendsto_atTop_add_const_right atTop (1 : ℝ)
        (tendsto_id : Tendsto (fun T : ℝ => T) atTop atTop))
  have hsquare : Tendsto (fun T : ℝ => (1 + T) ^ 2) atTop atTop := by
    have h := tendsto_mul_self_atTop.comp hlinear
    simpa [Function.comp_def, pow_two] using h
  have hdecay : Tendsto (fun T : ℝ => K / (1 + T) ^ 2)
      atTop (𝓝 0) :=
    tendsto_const_nhds.div_atTop hsquare
  have hupperNorm : Tendsto
      (fun T : ℝ => ‖∫ sigma in (-1)..2,
        goldfeldContourIntegrand chi1 chi beta x
          ((sigma : ℂ) + T * I)‖) atTop (𝓝 0) := by
    apply squeeze_zero' (g := fun T : ℝ => K / (1 + T) ^ 2)
    · exact Eventually.of_forall fun _ => norm_nonneg _
    · filter_upwards [eventually_ge_atTop (1 : ℝ)] with T hT
      have h := (hbound q1 q hq1 hq1q chi1 chi hchi1 hchi hcross
        beta x T hbeta0 hbeta1 hx hT hzero).1
      simpa [K, abs_of_nonneg (zero_le_one.trans hT)] using h
    · exact hdecay
  have hlowerNorm : Tendsto
      (fun T : ℝ => ‖-(∫ sigma in (-1)..2,
        goldfeldContourIntegrand chi1 chi beta x
          ((sigma : ℂ) - T * I))‖) atTop (𝓝 0) := by
    apply squeeze_zero' (g := fun T : ℝ => K / (1 + T) ^ 2)
    · exact Eventually.of_forall fun _ => norm_nonneg _
    · filter_upwards [eventually_ge_atTop (1 : ℝ)] with T hT
      have h := (hbound q1 q hq1 hq1q chi1 chi hchi1 hchi hcross
        beta x T hbeta0 hbeta1 hx hT hzero).2
      simpa [K, norm_neg, abs_of_nonneg (zero_le_one.trans hT)] using h
    · exact hdecay
  exact ⟨tendsto_zero_iff_norm_tendsto_zero.mpr hupperNorm,
    tendsto_zero_iff_norm_tendsto_zero.mpr hlowerNorm⟩

end

section
open Complex

section GoldfeldContourLimit

attribute [local instance] goldfeldLcmNeZero
theorem continuous_goldfeldRightLineMultiplier
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    {beta x : ℝ} (hbeta : -1 < beta) (hx : 0 < x) :
    Continuous (fun t : ℝ =>
      goldfeldFourFactorLFunction chi1 chi
          (((2 : ℂ) + t * I) + (beta : ℂ)) *
        (x : ℂ) ^ ((2 : ℂ) + t * I)) := by
  let s : ℝ → ℂ := fun t => (2 : ℂ) + t * I
  have hs : Continuous s := by fun_prop
  have hshift : Continuous (fun t : ℝ => s t + (beta : ℂ)) :=
    hs.add continuous_const
  have hnotOne (t : ℝ) : s t + (beta : ℂ) ≠ 1 := by
    intro h
    have hre := congrArg Complex.re h
    simp [s] at hre
    linarith
  have hzeta : Continuous (fun t : ℝ =>
      riemannZeta (s t + (beta : ℂ))) := by
    rw [continuous_iff_continuousAt]
    intro t
    simpa [Function.comp_def] using
      (differentiableAt_riemannZeta (hnotOne t)).continuousAt.comp
        (f := fun u : ℝ => s u + (beta : ℂ)) hshift.continuousAt
  have hchi1 : Continuous (fun t : ℝ =>
      DirichletCharacter.LFunction chi1 (s t + (beta : ℂ))) := by
    rw [continuous_iff_continuousAt]
    intro t
    simpa [Function.comp_def] using
      (DirichletCharacter.differentiableAt_LFunction chi1
        (s t + (beta : ℂ)) (.inl (hnotOne t))).continuousAt.comp
          (f := fun u : ℝ => s u + (beta : ℂ)) hshift.continuousAt
  have hchi : Continuous (fun t : ℝ =>
      DirichletCharacter.LFunction chi (s t + (beta : ℂ))) := by
    rw [continuous_iff_continuousAt]
    intro t
    simpa [Function.comp_def] using
      (DirichletCharacter.differentiableAt_LFunction chi
        (s t + (beta : ℂ)) (.inl (hnotOne t))).continuousAt.comp
          (f := fun u : ℝ => s u + (beta : ℂ)) hshift.continuousAt
  have hcross : Continuous (fun t : ℝ =>
      DirichletCharacter.LFunction (DirichletCharacter.mul chi1 chi)
        (s t + (beta : ℂ))) := by
    rw [continuous_iff_continuousAt]
    intro t
    simpa [Function.comp_def] using
      (DirichletCharacter.differentiableAt_LFunction
        (DirichletCharacter.mul chi1 chi)
        (s t + (beta : ℂ)) (.inl (hnotOne t))).continuousAt.comp
          (f := fun u : ℝ => s u + (beta : ℂ)) hshift.continuousAt
  have hxpow : Continuous (fun t : ℝ => (x : ℂ) ^ (s t)) :=
    continuous_const.cpow hs fun _ => Complex.ofReal_mem_slitPlane.mpr hx
  have hfour := (((hzeta.mul hchi1).mul hchi).mul hcross)
  change Continuous (fun t : ℝ =>
    (((riemannZeta (s t + (beta : ℂ)) *
      DirichletCharacter.LFunction chi1 (s t + (beta : ℂ))) *
      DirichletCharacter.LFunction chi (s t + (beta : ℂ))) *
      DirichletCharacter.LFunction (DirichletCharacter.mul chi1 chi)
        (s t + (beta : ℂ))) * (x : ℂ) ^ (s t))
  exact hfour.mul hxpow

theorem tendsto_goldfeldTruncatedVerticalIntegral_of_verticalIntegrable
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (beta x alpha : ℝ)
    (hvertical : VerticalIntegrable
      (goldfeldContourIntegrand chi1 chi beta x) alpha) :
    Tendsto
      (goldfeldTruncatedVerticalIntegral chi1 chi beta x alpha)
      atTop
      (𝓝 (goldfeldVerticalIntegral chi1 chi beta x alpha)) := by
  let f : ℝ → ℂ := fun t =>
    goldfeldContourIntegrand chi1 chi beta x
      ((alpha : ℂ) + t * I)
  have hraw : Integrable f := by
    simpa [VerticalIntegrable, f] using hvertical
  have hlimit := MeasureTheory.intervalIntegral_tendsto_integral hraw
    tendsto_neg_atTop_atBot tendsto_id
  have hnormalized := hlimit.const_mul (((2 * Real.pi : ℝ) : ℂ)⁻¹)
  change Tendsto
    (fun T : ℝ => (((2 * Real.pi : ℝ) : ℂ)⁻¹) *
      ∫ t in (-T)..T, f t) atTop
    (𝓝 ((((2 * Real.pi : ℝ) : ℂ)⁻¹) * ∫ t : ℝ, f t))
  exact hnormalized

end GoldfeldContourLimit
end

section
open Complex

attribute [local instance] goldfeldLcmNeZero
theorem goldfeldContourIntegrand_two_verticalIntegrable
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    {beta x : ℝ} (hbeta : -1 < beta) (hx : 0 < x) :
    VerticalIntegrable
      (goldfeldContourIntegrand chi1 chi beta x) 2 := by
  let a : ℕ → ℂ := goldfeldBetaCoefficient chi1 chi beta
  let s : ℝ → ℂ := fun t => (2 : ℂ) + t * I
  let phiLine : ℝ → ℂ := fun t => goldfeldPlateauMellin (s t)
  let multiplier : ℝ → ℂ := fun t =>
    goldfeldFourFactorLFunction chi1 chi (s t + (beta : ℂ)) *
      (x : ℂ) ^ (s t)
  have hsum : LSeriesSummable a (2 : ℂ) := by
    apply (goldfeldBetaCoefficient_LSeriesHasSum
      chi1 chi beta (s := (2 : ℂ)) ?_).LSeriesSummable
    norm_num
    linarith
  let K : ℝ := ∑' n : ℕ, ‖LSeries.term a (2 : ℂ) n‖
  have hfactor (t : ℝ) :
      ‖goldfeldFourFactorLFunction chi1 chi
        (s t + (beta : ℂ))‖ ≤ K := by
    have hsReal : 1 < ((s t + (beta : ℂ))).re := by
      simp [s]
      linarith
    have hseries := goldfeldBetaCoefficient_LSeriesHasSum
      chi1 chi beta (s := s t) hsReal
    have hline : LSeriesSummable a (s t) := by
      simpa [a] using hseries.LSeriesSummable
    have hlineNorm : Summable fun n : ℕ => ‖LSeries.term a (s t) n‖ :=
      summable_norm_iff.mpr hline
    calc
      ‖goldfeldFourFactorLFunction chi1 chi
          (s t + (beta : ℂ))‖ = ‖LSeries a (s t)‖ := by
            rw [hseries.LSeries_eq]
      _ ≤ ∑' n : ℕ, ‖LSeries.term a (s t) n‖ :=
        norm_tsum_le_tsum_norm hlineNorm
      _ = K := by
        apply tsum_congr
        intro n
        simp only [LSeries.norm_term_eq]
        congr 2
        simp [s]
  have hmultiplierContinuous : Continuous multiplier := by
    simpa [multiplier, s] using
      continuous_goldfeldRightLineMultiplier chi1 chi hbeta hx
  have hmultiplierBound : ∀ᵐ t : ℝ, ‖multiplier t‖ ≤ K * x ^ 2 :=
    ae_of_all _ fun t => by
      simp only [multiplier, norm_mul]
      rw [Complex.norm_cpow_eq_rpow_re_of_pos hx]
      have hxpow : x ^ (s t).re = x ^ 2 := by
        rw [show (s t).re = 2 by simp [s], Real.rpow_two]
      rw [hxpow]
      exact mul_le_mul_of_nonneg_right (hfactor t) (sq_nonneg x)
  have hphi : Integrable phiLine := by
    simpa [phiLine, s, VerticalIntegrable] using
      (verticalIntegrable_goldfeldPlateauMellin (alpha := 2) (by norm_num))
  have hproduct : Integrable fun t => phiLine t * multiplier t :=
    hphi.mul_bdd hmultiplierContinuous.aestronglyMeasurable
      hmultiplierBound
  rw [VerticalIntegrable]
  refine hproduct.congr (ae_of_all _ fun t => ?_)
  change phiLine t * multiplier t =
    goldfeldContourIntegrand chi1 chi beta x (s t)
  have hPhi := goldfeldMellinContinuationData.agrees_on_right
    (s := s t) (by simp [s])
  rw [goldfeldContourIntegrand, hPhi]
  simp only [phiLine, multiplier, s]
  ring

theorem tendsto_goldfeldContourIntegrand_truncated_vertical_two
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    {beta x : ℝ} (hbeta : -1 < beta) (hx : 0 < x) :
    Tendsto
      (goldfeldTruncatedVerticalIntegral chi1 chi beta x 2)
      atTop
      (𝓝 (goldfeldVerticalIntegral chi1 chi beta x 2)) :=
  tendsto_goldfeldTruncatedVerticalIntegral_of_verticalIntegrable
    chi1 chi beta x 2
      (goldfeldContourIntegrand_two_verticalIntegrable
        chi1 chi hbeta hx)

theorem tendsto_goldfeldContourIntegrand_truncated_vertical_neg_one
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (hq1 : 1 < q1) (hq1q : q1 ≤ q)
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (hchi1 : chi1 ≠ 1) (hchi : chi ≠ 1)
    (hcross : DirichletCharacter.mul chi1 chi ≠ 1)
    {beta x : ℝ} (hbeta0 : 0 ≤ beta) (hbeta1 : beta ≤ 1)
    (hx : 1 ≤ x) :
    Tendsto
      (goldfeldTruncatedVerticalIntegral chi1 chi beta x (-1))
      atTop
      (𝓝 (goldfeldVerticalIntegral chi1 chi beta x (-1))) :=
  tendsto_goldfeldTruncatedVerticalIntegral_of_verticalIntegrable
    chi1 chi beta x (-1)
      (goldfeldContourIntegrand_leftLine_verticalIntegrable
        hq1 hq1q chi1 chi hchi1 hchi hcross hbeta0 hbeta1 hx)

theorem goldfeldVerticalIntegral_two_eq_residue_add_neg_one
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (hq1 : 1 < q1) (hq1q : q1 ≤ q)
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (hchi1 : chi1 ≠ 1) (hchi : chi ≠ 1)
    (hcross : DirichletCharacter.mul chi1 chi ≠ 1)
    {beta x : ℝ}
    (hbeta0 : 0 ≤ beta) (hbeta1 : beta < 1)
    (hx : 1 ≤ x)
    (hzero : DirichletCharacter.LFunction chi1 (beta : ℂ) = 0) :
    goldfeldVerticalIntegral chi1 chi beta x 2 =
      goldfeldContourResidue chi1 chi beta x +
        goldfeldVerticalIntegral chi1 chi beta x (-1) := by
  have hxpos : 0 < x := zero_lt_one.trans_le hx
  have hright := tendsto_goldfeldContourIntegrand_truncated_vertical_two
    chi1 chi (show -1 < beta by linarith) hxpos
  have hleft := tendsto_goldfeldContourIntegrand_truncated_vertical_neg_one
    hq1 hq1q chi1 chi hchi1 hchi hcross hbeta0 hbeta1.le hx
  obtain ⟨_A, _hA, _C, _hC, hhorizontal⟩ :=
    exists_tendsto_goldfeldContourIntegrand_horizontal_integrals_zero
  have hedges := hhorizontal q1 q hq1 hq1q chi1 chi
    hchi1 hchi hcross beta x hbeta0 hbeta1.le hx hzero
  have hlower : Tendsto
      (goldfeldTruncatedLowerIntegral chi1 chi beta x)
      atTop (𝓝 0) := by
    have h := hedges.2.const_mul
      ((((2 * Real.pi : ℝ) : ℂ) * I)⁻¹)
    change Tendsto (fun T : ℝ =>
      ((((2 * Real.pi : ℝ) : ℂ) * I)⁻¹) *
        (-(∫ sigma in (-1)..2,
          goldfeldContourIntegrand chi1 chi beta x
            ((sigma : ℂ) - T * I)))) atTop (𝓝 0)
    simpa only [mul_zero] using h
  have hupper : Tendsto
      (goldfeldTruncatedUpperIntegral chi1 chi beta x)
      atTop (𝓝 0) := by
    have h := hedges.1.const_mul
      ((((2 * Real.pi : ℝ) : ℂ) * I)⁻¹)
    change Tendsto (fun T : ℝ =>
      ((((2 * Real.pi : ℝ) : ℂ) * I)⁻¹) *
        ∫ sigma in (-1)..2,
          goldfeldContourIntegrand chi1 chi beta x
            ((sigma : ℂ) + T * I)) atTop (𝓝 0)
    simpa only [mul_zero] using h
  let rhs : ℝ → ℂ := fun T =>
    goldfeldTruncatedLowerIntegral chi1 chi beta x T +
      goldfeldTruncatedVerticalIntegral chi1 chi beta x (-1) T +
      goldfeldTruncatedUpperIntegral chi1 chi beta x T +
      goldfeldContourResidue chi1 chi beta x
  have hrhs : Tendsto rhs atTop
      (𝓝 (goldfeldVerticalIntegral chi1 chi beta x (-1) +
        goldfeldContourResidue chi1 chi beta x)) := by
    have hconstant : Tendsto
        (fun _ : ℝ => goldfeldContourResidue chi1 chi beta x) atTop
        (𝓝 (goldfeldContourResidue chi1 chi beta x)) :=
      tendsto_const_nhds
    have h := ((hlower.add hleft).add hupper).add hconstant
    simpa [rhs] using h
  have heq :
      (goldfeldTruncatedVerticalIntegral chi1 chi beta x 2) =ᶠ[atTop]
        rhs := by
    filter_upwards [eventually_ge_atTop (1 : ℝ)] with T hT
    exact goldfeldContourIntegrand_truncated_rectangle_decomposition
      chi1 chi hchi1 hchi hcross hbeta0 hbeta1 hxpos hT hzero
  have hright' := hright.congr' heq
  have hresult := tendsto_nhds_unique hright' hrhs
  simpa [add_comm] using hresult

theorem goldfeldSmoothedSum_eq_residue_add_verticalIntegral_neg_one
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (hq1 : 1 < q1) (hq1q : q1 ≤ q)
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (hchi1 : chi1 ≠ 1) (hchi : chi ≠ 1)
    (hcross : DirichletCharacter.mul chi1 chi ≠ 1)
    {beta x : ℝ}
    (hbeta0 : 0 ≤ beta) (hbeta1 : beta < 1)
    (hx : 1 ≤ x)
    (hzero : DirichletCharacter.LFunction chi1 (beta : ℂ) = 0) :
    goldfeldSmoothedSum chi1 chi beta x =
      goldfeldContourResidue chi1 chi beta x +
        goldfeldVerticalIntegral chi1 chi beta x (-1) := by
  rw [goldfeldSmoothedSum_eq_verticalIntegral_two
    chi1 chi (show -1 < beta by linarith) hx]
  exact goldfeldVerticalIntegral_two_eq_residue_add_neg_one
    hq1 hq1q chi1 chi hchi1 hchi hcross hbeta0 hbeta1 hx hzero

end

section
open scoped ArithmeticFunction.Moebius

section ImprimitivePolyaVinogradovPrefix

theorem card_divisors_le_two_mul_sqrt
    {n : ℕ} (hn : 0 < n) :
    n.divisors.card ≤ 2 * Nat.sqrt n := by
  classical
  let small := n.divisors.filter fun d ↦ d ≤ Nat.sqrt n
  let large := n.divisors.filter fun d ↦ ¬d ≤ Nat.sqrt n
  have hsmall : small.card ≤ (Finset.Icc 1 (Nat.sqrt n)).card := by
    apply Finset.card_le_card
    intro d hd
    simp only [small, Finset.mem_filter] at hd
    exact Finset.mem_Icc.mpr ⟨Nat.pos_of_mem_divisors hd.1, hd.2⟩
  have hlarge : large.card ≤ (Finset.Icc 1 (Nat.sqrt n)).card := by
    refine Finset.card_le_card_of_injOn (fun d ↦ n / d) ?_ ?_
    · intro d hd
      simp only [large, Finset.mem_coe, Finset.mem_filter] at hd
      have hdDvd : d ∣ n := (Nat.mem_divisors.mp hd.1).1
      have hdPos : 0 < d := Nat.pos_of_mem_divisors hd.1
      have hquotPos : 0 < n / d :=
        Nat.div_pos (Nat.le_of_dvd hn hdDvd) hdPos
      have hfactor : n = d * (n / d) := (Nat.mul_div_cancel' hdDvd).symm
      exact Finset.mem_Icc.mpr
        ⟨hquotPos, (Nat.le_sqrt_of_eq_mul hfactor).resolve_left hd.2⟩
    · intro d₁ hd₁ d₂ hd₂ heq
      have h₁ := Nat.div_div_self
        (Nat.mem_divisors.mp (Finset.mem_filter.mp hd₁).1).1 hn.ne'
      have h₂ := Nat.div_div_self
        (Nat.mem_divisors.mp (Finset.mem_filter.mp hd₂).1).1 hn.ne'
      exact h₁.symm.trans ((congrArg (fun d : ℕ => n / d) heq).trans h₂)
  have hsmall' : small.card ≤ Nat.sqrt n := by
    simpa only [Nat.card_Icc, Nat.add_sub_cancel] using hsmall
  have hlarge' : large.card ≤ Nat.sqrt n := by
    simpa only [Nat.card_Icc, Nat.add_sub_cancel] using hlarge
  have hpartition : small.card + large.card = n.divisors.card := by
    simpa [small, large] using
      (Finset.card_filter_add_card_filter_not (s := n.divisors)
        (fun d ↦ d ≤ Nat.sqrt n))
  omega

theorem divisors_gcd_eq_filter
    {n r : ℕ} (hn : 0 < n) (hr : 0 < r) :
    (n.gcd r).divisors = r.divisors.filter (fun a ↦ a ∣ n) := by
  ext a
  simp [Nat.mem_divisors, Nat.dvd_gcd_iff, hr.ne',
    (Nat.gcd_pos_of_pos_left r hn).ne', and_comm]

theorem sum_moebius_divisors_eq_coprimeIndicator
    {n r : ℕ} (hn : 0 < n) (hr : 0 < r) :
    (∑ a ∈ r.divisors,
      if a ∣ n then
        ((ArithmeticFunction.moebius a : ℤ) : ℂ)
      else 0) =
      if n.Coprime r then 1 else 0 := by
  rw [← Finset.sum_filter,
    ← divisors_gcd_eq_filter hn hr]
  change (∑ a ∈ (n.gcd r).divisors,
    (ArithmeticFunction.moebius : ArithmeticFunction ℂ) a) = _
  rw [← ArithmeticFunction.coe_mul_zeta_apply,
    ArithmeticFunction.coe_moebius_mul_coe_zeta]
  by_cases hcop : n.Coprime r <;> simp [hcop]

theorem character_eq_primitive_mul_coprimeIndicator
    {q : ℕ} (chi : DirichletCharacter ℂ q) (n : ℕ) :
    chi n = chi.primitiveCharacter n *
      (if n.Coprime (q / chi.conductor) then 1 else 0) := by
  have hdvd : chi.conductor ∣ q := chi.conductor_dvd_level
  have hfactor : chi.conductor * (q / chi.conductor) = q :=
    Nat.mul_div_cancel' hdvd
  by_cases hnr : n.Coprime (q / chi.conductor)
  · rw [ite_eq_left hnr, mul_one]
    by_cases hnd : n.Coprime chi.conductor
    · have hnq : n.Coprime q := by
        rw [← hfactor, Nat.coprime_mul_iff_right]
        exact ⟨hnd, hnr⟩
      simpa only [Int.cast_natCast] using
        (chi.primitiveCharacter_apply_of_isCoprime
          (Nat.isCoprime_iff_coprime.mpr hnq)).symm
    · have hnq : ¬n.Coprime q := by
        rw [← hfactor, Nat.coprime_mul_iff_right]
        exact fun h ↦ hnd h.1
      have hchiZero : chi (n : ℤ) = 0 :=
        (DirichletCharacter.apply_eq_zero_iff chi (n : ℤ)).2
          (fun h ↦ hnq (Nat.isCoprime_iff_coprime.mp h))
      have hpsiZero : chi.primitiveCharacter (n : ℤ) = 0 :=
        (DirichletCharacter.apply_eq_zero_iff chi.primitiveCharacter (n : ℤ)).2
          (fun h ↦ hnd (Nat.isCoprime_iff_coprime.mp h))
      simpa only [Int.cast_natCast] using hchiZero.trans hpsiZero.symm
  · rw [ite_eq_right hnr, mul_zero]
    have hnq : ¬n.Coprime q := by
      rw [← hfactor, Nat.coprime_mul_iff_right]
      exact fun h ↦ hnr h.2
    simpa only [Int.cast_natCast] using
      (DirichletCharacter.apply_eq_zero_iff chi (n : ℤ)).2
        (fun h ↦ hnq (Nat.isCoprime_iff_coprime.mp h))

theorem sum_multiples_character
    {d a Y : ℕ} (ha : 0 < a) (psi : DirichletCharacter ℂ d) :
    (∑ n ∈ (Finset.Icc 1 Y).filter (fun n ↦ a ∣ n), psi n) =
      ∑ m ∈ Finset.Icc 1 (Y / a), psi (a * m) := by
  classical
  refine Finset.sum_bij'
    (fun n _ ↦ n / a) (fun m _ ↦ a * m) ?_ ?_ ?_ ?_ ?_
  · intro n hn
    simp only [Finset.mem_filter, Finset.mem_Icc] at hn
    have hnPos : 0 < n := zero_lt_one.trans_le hn.1.1
    exact Finset.mem_Icc.mpr
      ⟨Nat.div_pos (Nat.le_of_dvd hnPos hn.2) ha,
        Nat.div_le_div_right hn.1.2⟩
  · intro m hm
    simp only [Finset.mem_Icc] at hm
    exact Finset.mem_filter.mpr
      ⟨Finset.mem_Icc.mpr ⟨Nat.mul_pos ha hm.1,
        by simpa [Nat.mul_comm] using (Nat.le_div_iff_mul_le ha).mp hm.2⟩,
        Nat.dvd_mul_right a m⟩
  · intro n hn
    simp only [Finset.mem_filter] at hn
    exact Nat.mul_div_cancel' hn.2
  · intro m hm
    exact Nat.mul_div_cancel_left m ha
  · intro n hn
    simp only [Finset.mem_filter] at hn
    congr 1
    simpa only [Nat.cast_mul] using
      congrArg (fun k : ℕ ↦ (k : ZMod d))
        (Nat.mul_div_cancel' hn.2).symm

theorem imprimitivePrefix_eq_divisorSum
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q) (Y : ℕ) :
    dirichletCharacterIntervalSum 1 Y q chi =
      ∑ a ∈ (q / chi.conductor).divisors,
        (((ArithmeticFunction.moebius a : ℤ) : ℂ) *
            chi.primitiveCharacter a) *
          dirichletCharacterIntervalSum 1 (Y / a) chi.conductor
            chi.primitiveCharacter := by
  classical
  have hdPos : 0 < chi.conductor := Nat.pos_of_ne_zero chi.conductor_ne_zero
  have hrPos : 0 < q / chi.conductor :=
    Nat.div_pos
      (Nat.le_of_dvd (NeZero.pos q) chi.conductor_dvd_level) hdPos
  rw [dirichletCharacterIntervalSum]
  calc
    (∑ n ∈ Finset.Icc 1 Y, chi n) =
        ∑ n ∈ Finset.Icc 1 Y,
          chi.primitiveCharacter n *
            (if n.Coprime (q / chi.conductor) then 1 else 0) := by
      apply Finset.sum_congr rfl
      intro n hn
      exact character_eq_primitive_mul_coprimeIndicator chi n
    _ = ∑ n ∈ Finset.Icc 1 Y,
          chi.primitiveCharacter n *
            (∑ a ∈ (q / chi.conductor).divisors,
              if a ∣ n then
                ((ArithmeticFunction.moebius a : ℤ) : ℂ)
              else 0) := by
      apply Finset.sum_congr rfl
      intro n hn
      rw [sum_moebius_divisors_eq_coprimeIndicator
        (zero_lt_one.trans_le (Finset.mem_Icc.mp hn).1) hrPos]
    _ = ∑ a ∈ (q / chi.conductor).divisors,
          ∑ n ∈ Finset.Icc 1 Y,
            chi.primitiveCharacter n *
              (if a ∣ n then
                ((ArithmeticFunction.moebius a : ℤ) : ℂ)
              else 0) := by
      simp_rw [Finset.mul_sum]
      rw [Finset.sum_comm]
    _ = ∑ a ∈ (q / chi.conductor).divisors,
        (((ArithmeticFunction.moebius a : ℤ) : ℂ) *
            chi.primitiveCharacter a) *
          dirichletCharacterIntervalSum 1 (Y / a) chi.conductor
            chi.primitiveCharacter := by
      apply Finset.sum_congr rfl
      intro a ha
      have haPos : 0 < a := Nat.pos_of_mem_divisors ha
      calc
        (∑ n ∈ Finset.Icc 1 Y,
            chi.primitiveCharacter n *
              (if a ∣ n then
                ((ArithmeticFunction.moebius a : ℤ) : ℂ)
              else 0)) =
            ∑ n ∈ (Finset.Icc 1 Y).filter (fun n ↦ a ∣ n),
              chi.primitiveCharacter n *
                ((ArithmeticFunction.moebius a : ℤ) : ℂ) := by
          rw [Finset.sum_filter]
          apply Finset.sum_congr rfl
          intro n hn
          by_cases han : a ∣ n <;> simp [han]
        _ = ∑ m ∈ Finset.Icc 1 (Y / a),
              chi.primitiveCharacter (a * m) *
                ((ArithmeticFunction.moebius a : ℤ) : ℂ) := by
          rw [← Finset.sum_mul, sum_multiples_character haPos,
            Finset.sum_mul]
        _ = (((ArithmeticFunction.moebius a : ℤ) : ℂ) *
              chi.primitiveCharacter a) *
            (∑ m ∈ Finset.Icc 1 (Y / a),
              chi.primitiveCharacter m) := by
          rw [Finset.mul_sum]
          apply Finset.sum_congr rfl
          intro m hm
          rw [map_mul]
          ring
        _ = (((ArithmeticFunction.moebius a : ℤ) : ℂ) *
              chi.primitiveCharacter a) *
            dirichletCharacterIntervalSum 1 (Y / a) chi.conductor
              chi.primitiveCharacter := by
          rw [dirichletCharacterIntervalSum]

end ImprimitivePolyaVinogradovPrefix

theorem norm_dirichletCharacterPrefixSum_le_two_mul_sqrt_mul_log
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi ≠ 1) (Y : ℕ) :
    ‖dirichletCharacterIntervalSum 1 Y q chi‖ ≤
      2 * Real.sqrt (q : ℝ) * Real.log (q : ℝ) := by
  let d := chi.conductor
  let r := q / d
  have hdPos : 0 < d := Nat.pos_of_ne_zero chi.conductor_ne_zero
  have hdDvd : d ∣ q := chi.conductor_dvd_level
  have hfactor : d * r = q := Nat.mul_div_cancel' hdDvd
  have hrPos : 0 < r :=
    Nat.div_pos (Nat.le_of_dvd (NeZero.pos q) hdDvd) hdPos
  have hdNeOne : d ≠ 1 := by
    intro hd
    exact hchi (DirichletCharacter.eq_one_iff_conductor_eq_one.mpr hd)
  have hd : 1 < d := by omega
  have hdLeq : d ≤ q := Nat.le_of_dvd (NeZero.pos q) hdDvd
  let : NeZero d := ⟨hdPos.ne'⟩
  have hscalePos :
      0 < Real.sqrt (d : ℝ) * Real.log (d : ℝ) :=
    mul_pos (Real.sqrt_pos.2 (by exact_mod_cast hdPos))
      (Real.log_pos (by exact_mod_cast hd))
  have hcard : r.divisors.card ≤ 2 * Nat.sqrt r :=
    card_divisors_le_two_mul_sqrt hrPos
  have hcardReal :
      (r.divisors.card : ℝ) ≤ 2 * Real.sqrt (r : ℝ) := by
    calc
      (r.divisors.card : ℝ) ≤ ((2 * Nat.sqrt r : ℕ) : ℝ) := by
        exact_mod_cast hcard
      _ = 2 * (Nat.sqrt r : ℝ) := by norm_num
      _ ≤ 2 * Real.sqrt (r : ℝ) := by
        gcongr
        exact Real.nat_sqrt_le_real_sqrt
  have hsqrt :
      Real.sqrt (d : ℝ) * Real.sqrt (r : ℝ) = Real.sqrt (q : ℝ) := by
    calc
      Real.sqrt (d : ℝ) * Real.sqrt (r : ℝ) =
          Real.sqrt ((d : ℝ) * (r : ℝ)) :=
        (Real.sqrt_mul (by positivity) _).symm
      _ = Real.sqrt (q : ℝ) := by rw [← Nat.cast_mul, hfactor]
  have hlog : Real.log (d : ℝ) ≤ Real.log (q : ℝ) :=
    Real.log_le_log (by exact_mod_cast hdPos) (by exact_mod_cast hdLeq)
  rw [imprimitivePrefix_eq_divisorSum chi Y]
  calc
    _ ≤ ∑ _a ∈ r.divisors,
        Real.sqrt (d : ℝ) * Real.log (d : ℝ) := by
      apply norm_sum_le_of_le
      intro a _ha
      have hmu : ‖((ArithmeticFunction.moebius a : ℤ) : ℂ)‖ ≤ 1 := by
        rcases ArithmeticFunction.moebius_eq_or a with hzero | hone | hneg
        · simp [hzero]
        · simp [hone]
        · simp [hneg]
      have hcoeff :
          ‖((ArithmeticFunction.moebius a : ℤ) : ℂ) *
              chi.primitiveCharacter a‖ ≤ 1 := by
        rw [norm_mul]
        exact (mul_le_of_le_one_left (norm_nonneg _) hmu).trans
          (chi.primitiveCharacter.norm_le_one a)
      rw [norm_mul]
      exact (mul_le_of_le_one_left (norm_nonneg _) hcoeff).trans
        (norm_dirichletCharacterIntervalSum_lt_sqrt_mul_log
          hd chi.primitiveCharacter chi.primitiveCharacter_isPrimitive 1 (Y / a)).le
    _ = (r.divisors.card : ℝ) *
        (Real.sqrt (d : ℝ) * Real.log (d : ℝ)) := by simp
    _ ≤ (2 * Real.sqrt (r : ℝ)) *
        (Real.sqrt (d : ℝ) * Real.log (d : ℝ)) :=
      mul_le_mul_of_nonneg_right hcardReal hscalePos.le
    _ = 2 * Real.sqrt (q : ℝ) * Real.log (d : ℝ) := by
      calc
        (2 * Real.sqrt (r : ℝ)) *
            (Real.sqrt (d : ℝ) * Real.log (d : ℝ)) =
            2 * (Real.sqrt (d : ℝ) * Real.sqrt (r : ℝ)) *
              Real.log (d : ℝ) := by ring
        _ = 2 * Real.sqrt (q : ℝ) * Real.log (d : ℝ) := by rw [hsqrt]
    _ ≤ 2 * Real.sqrt (q : ℝ) * Real.log (q : ℝ) := by
      gcongr

end

section
open Asymptotics Complex Filter Set
open scoped Real

theorem LFunction_eq_abelIntegral_of_ne_one
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi ≠ 1)
    (s : ℂ) (hs : 0 < s.re) :
    DirichletCharacter.LFunction chi s =
      s * ∫ y in Set.Ioi (1 : ℝ),
        dirichletCharacterIntervalSum 1 ⌊y⌋₊ q chi *
          (y : ℂ) ^ (-(s + 1)) := by
  simpa [dirichletCharacterIntervalSum] using
    LFunction_eq_abelIntegral_of_prefixBound chi hchi
      (2 * Real.sqrt (q : ℝ) * Real.log (q : ℝ))
      (fun n ↦ by
        simpa [dirichletCharacterIntervalSum] using
          norm_dirichletCharacterPrefixSum_le_two_mul_sqrt_mul_log
            hq chi hchi n)
      s hs

end

section
open Complex Set
open scoped Real

section NearOneLFunction

theorem three_le_modulus_of_character_ne_one
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (hchi : chi ≠ 1) :
    3 ≤ q := by
  by_contra hq
  have hqPos : 0 < q := NeZero.pos q
  have hqNeOne : q ≠ 1 := fun h ↦ hchi (chi.level_one' h)
  have hqTwo : q = 2 := by omega
  subst q
  have hcard : Nat.card (DirichletCharacter ℂ 2) = 1 := by
    rw [DirichletCharacter.card_eq_totient_of_hasEnoughRootsOfUnity]
    norm_num
  exact hchi ((Nat.card_eq_one_iff_unique.mp hcard).1.elim chi 1)

theorem one_lt_log_modulus
    {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (hchi : chi ≠ 1) :
    1 < Real.log (q : ℝ) := by
  have hqThree : (3 : ℝ) ≤ q := by
    exact_mod_cast three_le_modulus_of_character_ne_one chi hchi
  exact (by norm_num : (1 : ℝ) < 1.0986122885).trans
    (Real.log_three_gt_d9.trans_le
      (Real.log_le_log (by norm_num) hqThree))

theorem norm_characterIntervalSum_floor_le
    {q : ℕ} (chi : DirichletCharacter ℂ q)
    {y : ℝ} (hy : 1 < y) :
    ‖dirichletCharacterIntervalSum 1 ⌊y⌋₊ q chi‖ ≤ y := by
  refine le_trans ?_ (Nat.floor_le (zero_lt_one.trans hy).le)
  simpa [dirichletCharacterIntervalSum, Nat.card_Icc] using
    norm_sum_le_of_le (Finset.Icc 1 ⌊y⌋₊) (fun n _ => chi.norm_le_one n)

theorem measurable_characterAbelIntegrand
    {q : ℕ} (chi : DirichletCharacter ℂ q) (s : ℂ) :
    AEStronglyMeasurable
      (fun y : ℝ ↦
        dirichletCharacterIntervalSum 1 ⌊y⌋₊ q chi *
          (y : ℂ) ^ (-(s + 1)))
      (volume.restrict (Ioi 1)) := by
  have hPrefix : Measurable
      (fun y : ℝ ↦ dirichletCharacterIntervalSum 1 ⌊y⌋₊ q chi) :=
    (measurable_of_countable
      (fun n : ℕ ↦ dirichletCharacterIntervalSum 1 n q chi)).comp
      Nat.measurable_floor
  have hCpow : ContinuousOn
      (fun y : ℝ ↦ (y : ℂ) ^ (-(s + 1))) (Ioi 1) :=
    continuousOn_of_forall_continuousAt fun y hy ↦
      continuousAt_ofReal_cpow_const y (-(s + 1))
        (Or.inr (zero_lt_one.trans hy).ne')
  exact hPrefix.aestronglyMeasurable.mul
    (hCpow.aestronglyMeasurable measurableSet_Ioi)

theorem integrableOn_characterAbelIntegrand
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi ≠ 1)
    {s : ℂ} (hs : 0 < s.re) :
    IntegrableOn
      (fun y : ℝ ↦
        dirichletCharacterIntervalSum 1 ⌊y⌋₊ q chi *
          (y : ℂ) ^ (-(s + 1)))
      (Ioi 1) := by
  let C := 2 * Real.sqrt (q : ℝ) * Real.log (q : ℝ)
  have hPower : IntegrableOn
      (fun y : ℝ ↦ y ^ (-(s.re + 1))) (Ioi 1) :=
    integrableOn_Ioi_rpow_of_lt (by linarith) zero_lt_one
  have hMajorant : IntegrableOn
      (fun y : ℝ ↦ C * y ^ (-(s.re + 1))) (Ioi 1) :=
    hPower.const_mul C
  have hBound : ∀ᵐ (y : ℝ) ∂volume.restrict (Ioi 1),
      ‖dirichletCharacterIntervalSum 1 ⌊y⌋₊ q chi *
          (y : ℂ) ^ (-(s + 1))‖ ≤
        C * y ^ (-(s.re + 1)) := by
    filter_upwards [ae_restrict_mem measurableSet_Ioi] with y hy
    have hyPos : 0 < y := zero_lt_one.trans hy
    rw [norm_mul, Complex.norm_cpow_eq_rpow_re_of_pos hyPos]
    simp only [neg_re, add_re, one_re]
    exact mul_le_mul_of_nonneg_right
      (by
        simpa [C] using
          norm_dirichletCharacterPrefixSum_le_two_mul_sqrt_mul_log
            hq chi hchi ⌊y⌋₊)
      (Real.rpow_nonneg hyPos.le _)
  exact hMajorant.mono' (measurable_characterAbelIntegrand chi s) hBound

theorem initial_characterAbelIntegral_le
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi ≠ 1) {s : ℂ}
    (hsRe : 1 - 5 / (16 * Real.log (q : ℝ)) ≤ s.re) :
    ‖∫ y in Ioc (1 : ℝ) q,
        dirichletCharacterIntervalSum 1 ⌊y⌋₊ q chi *
          (y : ℂ) ^ (-(s + 1))‖ ≤
      3 * Real.log (q : ℝ) := by
  let L := Real.log (q : ℝ)
  let f : ℝ → ℂ := fun y ↦
    dirichletCharacterIntervalSum 1 ⌊y⌋₊ q chi *
      (y : ℂ) ^ (-(s + 1))
  let g : ℝ → ℝ := fun y ↦ 3 * y ^ (-1 : ℝ)
  have hqOne : (1 : ℝ) ≤ q := by exact_mod_cast hq.le
  have hqPos : (0 : ℝ) < q := zero_lt_one.trans_le hqOne
  have hLpos : 0 < L := by
    exact Real.log_pos (by exact_mod_cast hq)
  have hLone : 1 < L := one_lt_log_modulus chi hchi
  have hMajorant : IntegrableOn g (Ioc (1 : ℝ) q) := by
    apply (continuousOn_const.mul ?_).integrableOn_Icc.mono_set Ioc_subset_Icc_self
    exact continuousOn_of_forall_continuousAt fun y hy ↦
      Real.continuousAt_rpow_const _ _
        (Or.inl (zero_lt_one.trans_le hy.1).ne')
  have hPoint : ∀ y ∈ Ioc (1 : ℝ) q, ‖f y‖ ≤ g y := by
    intro y hy
    have hyPos : 0 < y := zero_lt_one.trans hy.1
    have hyOne : 1 ≤ y := hy.1.le
    have hdelta : 1 - s.re ≤ 5 / (16 * L) := by
      dsimp [L]
      linarith
    have hpow : y ^ (1 - s.re) ≤ 3 := by
      by_cases hdeltaNonpos : 1 - s.re ≤ 0
      · exact (Real.rpow_le_one_of_one_le_of_nonpos hyOne hdeltaNonpos).trans
          (by norm_num)
      · have hdeltaNonneg : 0 ≤ 1 - s.re := le_of_not_ge hdeltaNonpos
        have hbase : y ^ (1 - s.re) ≤ (q : ℝ) ^ (1 - s.re) :=
          Real.rpow_le_rpow hyPos.le hy.2 hdeltaNonneg
        have hexponent :
            (q : ℝ) ^ (1 - s.re) ≤ (q : ℝ) ^ (5 / (16 * L)) :=
          Real.rpow_le_rpow_of_exponent_le hqOne hdelta
        have heval : (q : ℝ) ^ (5 / (16 * L)) = Real.exp (5 / 16) := by
          rw [Real.rpow_def_of_pos hqPos]
          congr 1
          dsimp [L]
          have hlogNe : Real.log (q : ℝ) ≠ 0 :=
            (Real.log_pos (by exact_mod_cast hq)).ne'
          field_simp [hlogNe]
        calc
          y ^ (1 - s.re) ≤ (q : ℝ) ^ (1 - s.re) := hbase
          _ ≤ (q : ℝ) ^ (5 / (16 * L)) := hexponent
          _ = Real.exp (5 / 16) := heval
          _ ≤ Real.exp 1 := Real.exp_le_exp.mpr (by norm_num)
          _ ≤ 3 := Real.exp_one_lt_three.le
    dsimp [f, g]
    rw [norm_mul,
      Complex.norm_cpow_eq_rpow_re_of_pos hyPos]
    simp only [neg_re, add_re, one_re]
    calc
      ‖dirichletCharacterIntervalSum 1 ⌊y⌋₊ q chi‖ *
          y ^ (-(s.re + 1)) ≤
          y * y ^ (-(s.re + 1)) :=
        mul_le_mul_of_nonneg_right
          (norm_characterIntervalSum_floor_le chi hy.1)
          (Real.rpow_nonneg hyPos.le _)
      _ = y ^ (-s.re) := by
        rw [mul_comm, ← Real.rpow_add_one hyPos.ne']
        congr 1
        ring
      _ = y ^ (-1 : ℝ) * y ^ (1 - s.re) := by
        rw [← Real.rpow_add hyPos]
        congr 1
        ring
      _ ≤ y ^ (-1 : ℝ) * 3 :=
        mul_le_mul_of_nonneg_left hpow (Real.rpow_nonneg hyPos.le _)
      _ = 3 * y ^ (-1 : ℝ) := by ring
  have hsPos : 0 < s.re := by
    have hfrac : 5 / (16 * L) ≤ 5 / 16 := by
      rw [div_le_iff₀ (by positivity : 0 < 16 * L)]
      nlinarith
    linarith
  have hActual : IntegrableOn f (Ioc (1 : ℝ) q) :=
    (integrableOn_characterAbelIntegrand hq chi hchi hsPos).mono_set
      Ioc_subset_Ioi_self
  calc
    ‖∫ y in Ioc (1 : ℝ) q, f y‖ ≤
        ∫ y in Ioc (1 : ℝ) q, ‖f y‖ := norm_integral_le_integral_norm _
    _ ≤ ∫ y in Ioc (1 : ℝ) q, g y :=
      setIntegral_mono_on hActual.norm hMajorant measurableSet_Ioc hPoint
    _ = 3 * Real.log (q : ℝ) := by
      rw [integral_const_mul]
      rw [← intervalIntegral.integral_of_le hqOne]
      simp_rw [Real.rpow_neg_one]
      rw [integral_inv_of_pos zero_lt_one hqPos]
      simp

theorem tail_characterAbelIntegral_le
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi ≠ 1)
    {s : ℂ} (hsRe : 1 - 5 / (16 * Real.log (q : ℝ)) ≤ s.re) :
    ‖∫ y in Ioi (q : ℝ),
        dirichletCharacterIntervalSum 1 ⌊y⌋₊ q chi *
          (y : ℂ) ^ (-(s + 1))‖ ≤
      4 * Real.log (q : ℝ) := by
  let L := Real.log (q : ℝ)
  let C := 2 * Real.sqrt (q : ℝ) * L
  let f : ℝ → ℂ := fun y ↦
    dirichletCharacterIntervalSum 1 ⌊y⌋₊ q chi *
      (y : ℂ) ^ (-(s + 1))
  let g : ℝ → ℝ := fun y ↦ C * y ^ (-(s.re + 1))
  have hqThree := three_le_modulus_of_character_ne_one chi hchi
  have hqOne : (1 : ℝ) ≤ q := by exact_mod_cast hqThree.trans' (by norm_num)
  have hqPos : (0 : ℝ) < q := zero_lt_one.trans_le hqOne
  have hLone : 1 < L := one_lt_log_modulus chi hchi
  have hLpos : 0 < L := zero_lt_one.trans hLone
  have hfrac : 5 / (16 * L) ≤ 5 / 16 := by
    rw [div_le_iff₀ (by positivity : 0 < 16 * L)]
    nlinarith
  have hsLower : (11 / 16 : ℝ) ≤ s.re := by
    dsimp [L] at hfrac
    linarith
  have hsPos : 0 < s.re := by linarith
  have hCnonneg : 0 ≤ C := by positivity
  have hPower : IntegrableOn (fun y : ℝ ↦ y ^ (-(s.re + 1))) (Ioi q) :=
    integrableOn_Ioi_rpow_of_lt (by linarith) hqPos
  have hMajorant : IntegrableOn g (Ioi (q : ℝ)) := hPower.const_mul C
  have hPoint : ∀ y ∈ Ioi (q : ℝ), ‖f y‖ ≤ g y := by
    intro y hy
    have hyPos : 0 < y := hqPos.trans hy
    dsimp [f, g, C]
    rw [norm_mul, Complex.norm_cpow_eq_rpow_re_of_pos hyPos]
    simp only [neg_re, add_re, one_re]
    exact mul_le_mul_of_nonneg_right
      (norm_dirichletCharacterPrefixSum_le_two_mul_sqrt_mul_log
        hq chi hchi ⌊y⌋₊)
      (Real.rpow_nonneg hyPos.le _)
  have hActual : IntegrableOn f (Ioi (q : ℝ)) :=
    (integrableOn_characterAbelIntegrand hq chi hchi hsPos).mono_set
      (Ioi_subset_Ioi hqOne)
  have hnormIntegral :
      ‖∫ y in Ioi (q : ℝ), f y‖ ≤
        C * ((q : ℝ) ^ (-s.re) / s.re) := by
    calc
      ‖∫ y in Ioi (q : ℝ), f y‖ ≤
          ∫ y in Ioi (q : ℝ), ‖f y‖ := norm_integral_le_integral_norm _
      _ ≤ ∫ y in Ioi (q : ℝ), g y :=
        setIntegral_mono_on hActual.norm hMajorant measurableSet_Ioi hPoint
      _ = C * ∫ y in Ioi (q : ℝ), y ^ (-(s.re + 1)) := by
        rw [integral_const_mul]
      _ = C * ((q : ℝ) ^ (-s.re) / s.re) := by
        rw [integral_Ioi_rpow_of_lt (by linarith) hqPos]
        congr 1
        field_simp [hsPos.ne']
        ring_nf
  have hsHalf : (1 / 2 : ℝ) ≤ s.re := by linarith
  have hpowProduct :
      Real.sqrt (q : ℝ) * (q : ℝ) ^ (-s.re) ≤ 1 := by
    rw [Real.sqrt_eq_rpow, ← Real.rpow_add hqPos]
    exact Real.rpow_le_one_of_one_le_of_nonpos hqOne (by linarith)
  have hinv : 1 / s.re ≤ 2 := by
    exact (div_le_iff₀ hsPos).2 (by linarith)
  calc
    ‖∫ y in Ioi (q : ℝ), f y‖ ≤
        C * ((q : ℝ) ^ (-s.re) / s.re) := hnormIntegral
    _ = 2 * L *
        (Real.sqrt (q : ℝ) * (q : ℝ) ^ (-s.re)) * (1 / s.re) := by
      dsimp [C]
      ring
    _ ≤ 2 * L * 1 * 2 := by
      gcongr
    _ = 4 * Real.log (q : ℝ) := by
      dsimp [L]
      ring

end NearOneLFunction

theorem norm_LFunction_near_one_le
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi ≠ 1)
    {s : ℂ}
    (hsRe : 1 - 5 / (16 * Real.log (q : ℝ)) ≤ s.re)
    (hsNorm : ‖s‖ ≤ 2) :
    ‖DirichletCharacter.LFunction chi s‖ ≤
      32 * Real.log (q : ℝ) := by
  let f : ℝ → ℂ := fun y ↦
    dirichletCharacterIntervalSum 1 ⌊y⌋₊ q chi *
      (y : ℂ) ^ (-(s + 1))
  have hLone := one_lt_log_modulus chi hchi
  have hLpos : 0 < Real.log (q : ℝ) := zero_lt_one.trans hLone
  have hRePos : 0 < s.re := by
    have hfrac : 5 / (16 * Real.log (q : ℝ)) ≤ 5 / 16 := by
      rw [div_le_iff₀ (by positivity : 0 < 16 * Real.log (q : ℝ))]
      nlinarith
    linarith
  have hqOne : (1 : ℝ) ≤ q := by exact_mod_cast hq.le
  have hInitial := initial_characterAbelIntegral_le hq chi hchi hsRe
  have hTail := tail_characterAbelIntegral_le hq chi hchi hsRe
  have hIntegrable := integrableOn_characterAbelIntegrand hq chi hchi hRePos
  have hSplit :
      (∫ y in Ioi (1 : ℝ), f y) =
        (∫ y in Ioc (1 : ℝ) q, f y) +
          (∫ y in Ioi (q : ℝ), f y) := by
    rw [← Ioc_union_Ioi_eq_Ioi hqOne,
      setIntegral_union Ioc_disjoint_Ioi_same measurableSet_Ioi
        (hIntegrable.mono_set Ioc_subset_Ioi_self)
        (hIntegrable.mono_set (Ioi_subset_Ioi hqOne))]
  rw [LFunction_eq_abelIntegral_of_ne_one hq chi hchi s hRePos, norm_mul]
  change ‖s‖ * ‖∫ y in Ioi (1 : ℝ), f y‖ ≤ _
  rw [hSplit]
  calc
    ‖s‖ * ‖(∫ y in Ioc (1 : ℝ) q, f y) +
        (∫ y in Ioi (q : ℝ), f y)‖ ≤
      ‖s‖ * (‖∫ y in Ioc (1 : ℝ) q, f y‖ +
        ‖∫ y in Ioi (q : ℝ), f y‖) :=
      mul_le_mul_of_nonneg_left (norm_add_le _ _) (norm_nonneg s)
    _ ≤ 2 * (3 * Real.log (q : ℝ) + 4 * Real.log (q : ℝ)) := by
      gcongr
    _ ≤ 32 * Real.log (q : ℝ) := by nlinarith

theorem norm_deriv_LFunction_ofReal_near_one_le
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi ≠ 1)
    {sigma : ℝ}
    (hsigmaNear :
      1 - 1 / (4 * Real.log (q : ℝ)) ≤ sigma)
    (hsigmaOne : sigma ≤ 1) :
    ‖deriv (DirichletCharacter.LFunction chi) (sigma : ℂ)‖ ≤
      512 * (Real.log (q : ℝ)) ^ 2 := by
  let L := Real.log (q : ℝ)
  let r := 1 / (16 * L)
  have hLone : 1 < L := one_lt_log_modulus chi hchi
  have hLpos : 0 < L := zero_lt_one.trans hLone
  have hrPos : 0 < r := by positivity
  have hrLe : r ≤ 1 / 16 := by
    dsimp [r]
    rw [div_le_iff₀ (by positivity : 0 < 16 * L)]
    nlinarith
  have hsigmaPos : 0 < sigma := by
    have hquarter : 1 / (4 * L) < 1 := by
      rw [div_lt_one (by positivity : 0 < 4 * L)]
      nlinarith
    change 1 - 1 / (4 * L) ≤ sigma at hsigmaNear
    linarith
  have hsphere : ∀ z ∈ sphere (sigma : ℂ) r,
      ‖DirichletCharacter.LFunction chi z‖ ≤ 32 * L := by
    intro z hz
    have hdist : ‖z - (sigma : ℂ)‖ = r := by
      simpa [dist_eq_norm] using mem_sphere.mp hz
    have hreDiff : |z.re - sigma| ≤ r := by
      calc
        |z.re - sigma| = |(z - (sigma : ℂ)).re| := by simp
        _ ≤ ‖z - (sigma : ℂ)‖ := Complex.abs_re_le_norm _
        _ = r := hdist
    have hzRe : 1 - 5 / (16 * L) ≤ z.re := by
      have hrad : r = 1 / (16 * L) := rfl
      rw [hrad] at hreDiff
      have hlower := (abs_le.mp hreDiff).1
      change 1 - 1 / (4 * L) ≤ sigma at hsigmaNear
      have hratio : 1 / (4 * L) = 4 * (1 / (16 * L)) := by
        field_simp [hLpos.ne']
        ring
      rw [hratio] at hsigmaNear
      have hfive : 5 / (16 * L) = 5 * (1 / (16 * L)) := by ring
      rw [hfive]
      linarith
    have hzNorm : ‖z‖ ≤ 2 := by
      calc
        ‖z‖ ≤ ‖(sigma : ℂ)‖ + ‖z - (sigma : ℂ)‖ := by
          simpa [add_comm] using norm_add_le (z - (sigma : ℂ)) (sigma : ℂ)
        _ = sigma + r := by simp [abs_of_pos hsigmaPos, hdist]
        _ ≤ 2 := by linarith
    simpa [L] using norm_LFunction_near_one_le hq chi hchi hzRe hzNorm
  have hCauchy := Complex.norm_deriv_le_of_forall_mem_sphere_norm_le
    hrPos (DirichletCharacter.differentiable_LFunction hchi).diffContOnCl hsphere
  calc
    ‖deriv (DirichletCharacter.LFunction chi) (sigma : ℂ)‖ ≤
        (32 * L) / r := hCauchy
    _ = 512 * (Real.log (q : ℝ)) ^ 2 := by
      change (32 * L) / (1 / (16 * L)) = 512 * L ^ 2
      field_simp [hLpos.ne']
      ring

end

section
open Set

theorem norm_LFunction_one_sub_ofReal_le
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi ≠ 1)
    {beta : ℝ}
    (hbetaNear :
      1 - 1 / (4 * Real.log (q : ℝ)) ≤ beta)
    (hbetaOne : beta ≤ 1) :
    ‖DirichletCharacter.LFunction chi (1 : ℂ) -
        DirichletCharacter.LFunction chi (beta : ℂ)‖ ≤
      512 * (Real.log (q : ℝ)) ^ 2 * (1 - beta) := by
  let f : ℝ → ℂ := fun sigma ↦
    DirichletCharacter.LFunction chi (sigma : ℂ)
  let f' : ℝ → ℂ := fun sigma ↦
    deriv (DirichletCharacter.LFunction chi) (sigma : ℂ)
  have hderiv : ∀ sigma ∈ Icc beta 1,
      HasDerivWithinAt f (f' sigma) (Icc beta 1) sigma := by
    intro sigma _
    exact ((DirichletCharacter.differentiable_LFunction hchi
      (sigma : ℂ)).hasDerivAt.comp_ofReal).hasDerivWithinAt
  have hbound : ∀ sigma ∈ Ico beta 1,
      ‖f' sigma‖ ≤ 512 * (Real.log (q : ℝ)) ^ 2 := by
    intro sigma hsigma
    dsimp [f']
    apply norm_deriv_LFunction_ofReal_near_one_le hq chi hchi
    · exact hbetaNear.trans hsigma.1
    · exact hsigma.2.le
  have hmean := norm_image_sub_le_of_norm_deriv_le_segment'
    hderiv hbound (1 : ℝ) (right_mem_Icc.mpr hbetaOne)
  simpa [f] using hmean

end

theorem norm_LFunction_one_of_real_zero_le
    {q : ℕ} [NeZero q] (hq : 1 < q)
    (chi : DirichletCharacter ℂ q) (hchi : chi ≠ 1)
    {beta : ℝ} (hbetaOne : beta ≤ 1)
    (hzero : DirichletCharacter.LFunction chi (beta : ℂ) = 0) :
    ‖DirichletCharacter.LFunction chi (1 : ℂ)‖ ≤
      512 * (1 - beta) * (q : ℝ) ^ ((1 - beta) / 2) *
        (Real.log (q : ℝ)) ^ 2 := by
  let L := Real.log (q : ℝ)
  let Q := (q : ℝ) ^ ((1 - beta) / 2)
  have hLpos : 0 < L := by
    exact Real.log_pos (by exact_mod_cast hq)
  have hdelta : 0 ≤ 1 - beta := sub_nonneg.mpr hbetaOne
  have hqOne : (1 : ℝ) ≤ q := by
    exact_mod_cast hq.le
  have hQone : 1 ≤ Q := by
    exact Real.one_le_rpow hqOne (div_nonneg hdelta (by norm_num))
  by_cases hbetaNear : 1 - 1 / (4 * L) ≤ beta
  · have hmean := norm_LFunction_one_sub_ofReal_le hq chi hchi
      (by simpa [L] using hbetaNear) hbetaOne
    have hbase :
        ‖DirichletCharacter.LFunction chi (1 : ℂ)‖ ≤
          512 * L ^ 2 * (1 - beta) := by
      simpa [hzero, L] using hmean
    calc
      ‖DirichletCharacter.LFunction chi (1 : ℂ)‖ ≤
          512 * L ^ 2 * (1 - beta) := hbase
      _ = 512 * (1 - beta) * 1 * L ^ 2 := by ring
      _ ≤ 512 * (1 - beta) * Q * L ^ 2 := by gcongr
      _ = 512 * (1 - beta) * (q : ℝ) ^ ((1 - beta) / 2) *
          (Real.log (q : ℝ)) ^ 2 := rfl
  · have hfar : 1 / (4 * L) < 1 - beta := by
      linarith
    have hvalue :
        ‖DirichletCharacter.LFunction chi (1 : ℂ)‖ ≤ 32 * L := by
      simpa [L] using
        norm_LFunction_near_one_le hq chi hchi (s := (1 : ℂ))
          (by
            have hfrac : 0 ≤ 5 / (16 * L) := by positivity
            simpa [L] using sub_le_self (1 : ℝ) hfrac)
          (by norm_num)
    calc
      ‖DirichletCharacter.LFunction chi (1 : ℂ)‖ ≤ 32 * L := hvalue
      _ ≤ 128 * L := by nlinarith
      _ = 512 * (1 / (4 * L)) * 1 * L ^ 2 := by
        field_simp [hLpos.ne']
        ring
      _ ≤ 512 * (1 - beta) * Q * L ^ 2 := by gcongr
      _ = 512 * (1 - beta) * (q : ℝ) ^ ((1 - beta) / 2) *
          (Real.log (q : ℝ)) ^ 2 := rfl

section
open Complex Set

theorem norm_goldfeldMellinContinuationData_Phi_ofReal_le_two_div
    {delta : ℝ} (hdelta0 : 0 < delta) (hdelta1 : delta ≤ 1) :
    ‖goldfeldMellinContinuationData.Phi (delta : ℂ)‖ ≤ 2 / delta := by
  rw [goldfeldMellinContinuationData.agrees_on_right (by simpa using hdelta0)]
  let f : ℝ → ℂ := fun y =>
    (y : ℂ) ^ (((delta : ℝ) : ℂ) - 1) * (goldfeldPlateau y : ℂ)
  have hfIoi : IntegrableOn f (Ioi (0 : ℝ)) := by
    have hconv := mellinConvergent_goldfeldPlateauComplex
      (s := ((delta : ℝ) : ℂ)) (by simpa using hdelta0)
    rw [MellinConvergent] at hconv
    change IntegrableOn f (Ioi (0 : ℝ)) at hconv
    exact hconv
  have htruncate :
      (∫ y in Ioi (0 : ℝ), f y) = ∫ y in Ioc (0 : ℝ) 2, f y := by
    apply setIntegral_eq_of_subset_of_forall_sdiff_eq_zero measurableSet_Ioi
      (fun _ hy => hy.1)
    intro y hy
    have hyTwo : 2 ≤ y :=
      (lt_of_not_ge fun hyLe => hy.2 ⟨hy.1, hyLe⟩).le
    simp [f, goldfeldPlateau_eq_zero hyTwo]
  have hfIoc : IntegrableOn f (Ioc (0 : ℝ) 2) :=
    hfIoi.mono_set (fun _ hy => hy.1)
  have hpowInterval : IntervalIntegrable
      (fun y : ℝ => y ^ (delta - 1)) volume 0 2 :=
    intervalIntegral.intervalIntegrable_rpow' (by linarith)
  have hpowIoc : IntegrableOn (fun y : ℝ => y ^ (delta - 1))
      (Ioc (0 : ℝ) 2) :=
    (intervalIntegrable_iff_integrableOn_Ioc_of_le (by norm_num)).1
      hpowInterval
  have hpoint : ∀ y ∈ Ioc (0 : ℝ) 2, ‖f y‖ ≤ y ^ (delta - 1) := by
    intro y hy
    dsimp only [f]
    rw [norm_mul,
      Complex.norm_cpow_eq_rpow_re_of_pos hy.1]
    simp only [Complex.sub_re, Complex.ofReal_re, Complex.one_re]
    rw [Complex.norm_real, Real.norm_eq_abs,
      abs_of_nonneg (goldfeldPlateau_nonneg y)]
    exact mul_le_of_le_one_right (Real.rpow_nonneg hy.1.le _)
      (goldfeldPlateau_le_one y)
  have heval :
      (∫ y in Ioc (0 : ℝ) 2, y ^ (delta - 1)) =
        (2 : ℝ) ^ delta / delta := by
    calc
      (∫ y in Ioc (0 : ℝ) 2, y ^ (delta - 1)) =
          ∫ y in (0 : ℝ)..2, y ^ (delta - 1) := by
        exact (intervalIntegral.integral_of_le (by norm_num)).symm
      _ = ((2 : ℝ) ^ ((delta - 1) + 1) -
            (0 : ℝ) ^ ((delta - 1) + 1)) / ((delta - 1) + 1) := by
        rw [integral_rpow (Or.inl (by linarith))]
      _ = (2 : ℝ) ^ delta / delta := by
        rw [show delta - 1 + 1 = delta by ring,
          Real.zero_rpow hdelta0.ne']
        ring
  have hpow : (2 : ℝ) ^ delta ≤ 2 := by
    simpa using Real.rpow_le_rpow_of_exponent_le
      (by norm_num : (1 : ℝ) ≤ 2) hdelta1
  rw [goldfeldPlateauMellin, mellin]
  change ‖∫ y in Ioi (0 : ℝ), f y‖ ≤ 2 / delta
  rw [htruncate]
  calc
    ‖∫ y in Ioc (0 : ℝ) 2, f y‖ ≤
        ∫ y in Ioc (0 : ℝ) 2, ‖f y‖ :=
      norm_integral_le_integral_norm _
    _ ≤ ∫ y in Ioc (0 : ℝ) 2, y ^ (delta - 1) :=
      setIntegral_mono_on hfIoc.norm hpowIoc measurableSet_Ioc hpoint
    _ = (2 : ℝ) ^ delta / delta := heval
    _ ≤ 2 / delta :=
      (div_le_div_iff_of_pos_right hdelta0).2 hpow

end

section
open scoped ComplexOrder

section GoldfeldSmoothedSumLowerBound

attribute [local instance] goldfeldLcmNeZero
theorem goldfeldSmoothedSummand_nonneg
    {q1 q : ℕ}
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (hsquare1 : chi1 ^ 2 = 1) (hsquare : chi ^ 2 = 1)
    (beta x : ℝ) (n : ℕ) :
    0 ≤ goldfeldBetaCoefficient chi1 chi beta n *
      (goldfeldPlateau ((n : ℝ) / x) : ℂ) := by
  apply mul_nonneg
  · simpa [goldfeldBetaCoefficient] using
      LSeries.term_nonneg
        (goldfeldCoefficient_nonneg chi1 chi hsquare1 hsquare n) beta
  · exact (RCLike.ofReal_nonneg (K := ℂ)).2
      (goldfeldPlateau_nonneg _)

theorem goldfeldSmoothedSummand_summable
    {q1 q : ℕ}
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (beta : ℝ) {x : ℝ} (hx : 0 < x) :
    Summable fun n : ℕ =>
      goldfeldBetaCoefficient chi1 chi beta n *
        (goldfeldPlateau ((n : ℝ) / x) : ℂ) := by
  apply summable_of_ne_finset_zero
    (s := Finset.range (Nat.ceil (2 * x)))
  intro n hn
  have hnceil : Nat.ceil (2 * x) ≤ n := by
    simpa only [Finset.mem_range, not_lt] using hn
  have hcutoff : 2 * x ≤ (n : ℝ) := by
    calc
      2 * x ≤ (Nat.ceil (2 * x) : ℕ) := Nat.le_ceil _
      _ ≤ n := by exact_mod_cast hnceil
  have hratio : 2 ≤ (n : ℝ) / x :=
    (le_div_iff₀ hx).2 hcutoff
  rw [goldfeldPlateau_eq_zero hratio]
  simp

end GoldfeldSmoothedSumLowerBound
end

section
open scoped ComplexOrder

attribute [local instance] goldfeldLcmNeZero
theorem one_le_goldfeldSmoothedSum
    {q1 q : ℕ}
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (hsquare1 : chi1 ^ 2 = 1) (hsquare : chi ^ 2 = 1)
    {beta x : ℝ} (hx : 1 ≤ x) :
    (1 : ℂ) ≤ goldfeldSmoothedSum chi1 chi beta x := by
  have hxpos : 0 < x := zero_lt_one.trans_le hx
  have hsummable :=
    goldfeldSmoothedSummand_summable chi1 chi beta hxpos
  rw [goldfeldSmoothedSum]
  calc
    (1 : ℂ) = goldfeldBetaCoefficient chi1 chi beta 1 *
        (goldfeldPlateau ((1 : ℝ) / x) : ℂ) := by
      rw [goldfeldBetaCoefficient,
        LSeries.term_of_ne_zero one_ne_zero, goldfeldCoefficient_one]
      have hplateau : goldfeldPlateau ((1 : ℝ) / x) = 1 :=
        goldfeldPlateau_eq_one
          (div_nonneg zero_le_one hxpos.le)
          ((div_le_one hxpos).2 hx)
      rw [hplateau]
      norm_num
    _ ≤ ∑' n : ℕ,
        goldfeldBetaCoefficient chi1 chi beta n *
          (goldfeldPlateau ((n : ℝ) / x) : ℂ) := by
      simpa using hsummable.sum_le_tsum {1} fun n _ =>
        goldfeldSmoothedSummand_nonneg
          chi1 chi hsquare1 hsquare beta x n

end

section
open Complex
open scoped ComplexOrder

attribute [local instance] goldfeldLcmNeZero
theorem half_le_norm_goldfeldContourResidue_of_leftLine
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (hq1 : 1 < q1) (hq1q : q1 ≤ q)
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (hchi1 : chi1 ≠ 1) (hchi : chi ≠ 1)
    (hcross : DirichletCharacter.mul chi1 chi ≠ 1)
    (hsquare1 : chi1 ^ 2 = 1) (hsquare : chi ^ 2 = 1)
    {beta x : ℝ}
    (hbeta0 : 0 ≤ beta) (hbeta1 : beta < 1)
    (hx : 1 ≤ x)
    (hzero : DirichletCharacter.LFunction chi1 (beta : ℂ) = 0)
    (hleft : ‖goldfeldVerticalIntegral chi1 chi beta x (-1)‖ ≤ 1 / 2) :
    1 / 2 ≤ ‖goldfeldContourResidue chi1 chi beta x‖ := by
  have hsumOrder := one_le_goldfeldSmoothedSum
    chi1 chi hsquare1 hsquare (beta := beta) hx
  have hsumRe : 1 ≤ (goldfeldSmoothedSum chi1 chi beta x).re := by
    have hre := Complex.re_le_re hsumOrder
    simpa using hre
  have hsumNorm : 1 ≤ ‖goldfeldSmoothedSum chi1 chi beta x‖ :=
    hsumRe.trans (Complex.re_le_norm _)
  rw [goldfeldSmoothedSum_eq_residue_add_verticalIntegral_neg_one
    hq1 hq1q chi1 chi hchi1 hchi hcross hbeta0 hbeta1 hx hzero] at hsumNorm
  have htriangle :
      1 ≤ ‖goldfeldContourResidue chi1 chi beta x‖ +
        ‖goldfeldVerticalIntegral chi1 chi beta x (-1)‖ :=
    hsumNorm.trans (norm_add_le _ _)
  linarith

theorem norm_goldfeldContourResidue_le
    {q1 q : ℕ} [NeZero q1] [NeZero q]
    (hq1 : 1 < q1) (hq1q : q1 ≤ q)
    (chi1 : DirichletCharacter ℂ q1)
    (chi : DirichletCharacter ℂ q)
    (hchi1 : chi1 ≠ 1)
    (hcross : DirichletCharacter.mul chi1 chi ≠ 1)
    {beta x : ℝ}
    (hbeta0 : 0 ≤ beta) (hbeta1 : beta < 1)
    (hx : 1 ≤ x)
    (hzero : DirichletCharacter.LFunction chi1 (beta : ℂ) = 0) :
    ‖goldfeldContourResidue chi1 chi beta x‖ ≤
      65536 * x ^ (1 - beta) *
        (q : ℝ) ^ ((1 - beta) / 2) *
        (Real.log (q : ℝ)) ^ 3 *
        ‖DirichletCharacter.LFunction chi (1 : ℂ)‖ := by
  let delta : ℝ := 1 - beta
  have hdelta0 : 0 < delta := by dsimp [delta]; linarith
  have hdelta1 : delta ≤ 1 := by dsimp [delta]; linarith
  have hdeltaNonneg : 0 ≤ delta := hdelta0.le
  have hq1Pos : 0 < (q1 : ℝ) := by positivity
  have hq1qReal : (q1 : ℝ) ≤ q := by exact_mod_cast hq1q
  have hlogq1Nonneg : 0 ≤ Real.log (q1 : ℝ) :=
    (Real.log_pos (by exact_mod_cast hq1)).le
  have hlogq1q : Real.log (q1 : ℝ) ≤ Real.log (q : ℝ) :=
    Real.log_le_log hq1Pos hq1qReal
  have hqpow :
      (q1 : ℝ) ^ (delta / 2) ≤ (q : ℝ) ^ (delta / 2) :=
    Real.rpow_le_rpow hq1Pos.le hq1qReal (by positivity)
  have hlogpow :
      (Real.log (q1 : ℝ)) ^ 2 ≤ (Real.log (q : ℝ)) ^ 2 :=
    pow_le_pow_left₀ hlogq1Nonneg hlogq1q 2
  have hLone := norm_LFunction_one_of_real_zero_le
    hq1 chi1 hchi1 hbeta1.le hzero
  have hLoneQ :
      ‖DirichletCharacter.LFunction chi1 (1 : ℂ)‖ ≤
        512 * delta * (q : ℝ) ^ (delta / 2) *
          (Real.log (q : ℝ)) ^ 2 := by
    calc
      ‖DirichletCharacter.LFunction chi1 (1 : ℂ)‖ ≤
          512 * delta * (q1 : ℝ) ^ (delta / 2) *
            (Real.log (q1 : ℝ)) ^ 2 := by simpa [delta] using hLone
      _ ≤ 512 * delta * (q : ℝ) ^ (delta / 2) *
          (Real.log (q : ℝ)) ^ 2 := by
        gcongr
  let : NeZero (Nat.lcm q1 q) :=
    ⟨Nat.lcm_ne_zero (NeZero.ne q1) (NeZero.ne q)⟩
  have hlcmPos : 0 < Nat.lcm q1 q := NeZero.pos _
  have hq1lcm : q1 ≤ Nat.lcm q1 q :=
    Nat.le_of_dvd hlcmPos (Nat.dvd_lcm_left q1 q)
  have hlcmOne : 1 < Nat.lcm q1 q := hq1.trans_le hq1lcm
  have hlcmNat : Nat.lcm q1 q ≤ q ^ 2 := by
    calc
      Nat.lcm q1 q ≤ q1 * q :=
        Nat.le_of_dvd (Nat.mul_pos (NeZero.pos q1) (NeZero.pos q))
          (Nat.lcm_dvd_mul q1 q)
      _ ≤ q * q := Nat.mul_le_mul_right q hq1q
      _ = q ^ 2 := by ring
  have hlcmReal : (Nat.lcm q1 q : ℝ) ≤ (q : ℝ) ^ 2 := by
    exact_mod_cast hlcmNat
  have hlcmLog :
      Real.log (Nat.lcm q1 q : ℝ) ≤ 2 * Real.log (q : ℝ) := by
    calc
      Real.log (Nat.lcm q1 q : ℝ) ≤ Real.log ((q : ℝ) ^ 2) :=
        Real.log_le_log (by exact_mod_cast hlcmPos) hlcmReal
      _ = 2 * Real.log (q : ℝ) := by rw [Real.log_pow]; norm_num
  have hcrossValue := norm_LFunction_near_one_le hlcmOne
    (DirichletCharacter.mul chi1 chi) hcross (s := (1 : ℂ))
    (by
      exact sub_le_self 1 (div_nonneg (by norm_num) (by positivity)))
    (by norm_num)
  have hcrossQ :
      ‖DirichletCharacter.LFunction (DirichletCharacter.mul chi1 chi)
          (1 : ℂ)‖ ≤ 64 * Real.log (q : ℝ) := by
    nlinarith
  have hPhi :=
    norm_goldfeldMellinContinuationData_Phi_ofReal_le_two_div
      hdelta0 hdelta1
  have hxPos : 0 < x := zero_lt_one.trans_le hx
  have hxpow :
      ‖(x : ℂ) ^ goldfeldShiftedZetaPole beta‖ = x ^ delta := by
    rw [Complex.norm_cpow_eq_rpow_re_of_pos hxPos]
    simp [goldfeldShiftedZetaPole, delta]
  rw [goldfeldContourResidue]
  simp only [norm_mul]
  rw [hxpow]
  calc
    x ^ delta * ‖DirichletCharacter.LFunction chi1 1‖ *
          ‖DirichletCharacter.LFunction chi 1‖ *
          ‖DirichletCharacter.LFunction (DirichletCharacter.mul chi1 chi) 1‖ *
          ‖goldfeldMellinContinuationData.Phi
            (goldfeldShiftedZetaPole beta)‖ ≤
        x ^ delta *
          (512 * delta * (q : ℝ) ^ (delta / 2) *
            (Real.log (q : ℝ)) ^ 2) *
          ‖DirichletCharacter.LFunction chi 1‖ *
          (64 * Real.log (q : ℝ)) * (2 / delta) := by
      have hPhi' :
          ‖goldfeldMellinContinuationData.Phi
              (goldfeldShiftedZetaPole beta)‖ ≤ 2 / delta := by
        simpa [goldfeldShiftedZetaPole, delta] using hPhi
      gcongr
    _ = 65536 * x ^ (1 - beta) *
        (q : ℝ) ^ ((1 - beta) / 2) *
        (Real.log (q : ℝ)) ^ 3 *
        ‖DirichletCharacter.LFunction chi (1 : ℂ)‖ := by
      have hbetaNe : 1 - beta ≠ 0 := by linarith
      dsimp [delta]
      field_simp [hbetaNe]
      ring

end

section
open Complex

attribute [local instance] goldfeldLcmNeZero
theorem exists_goldfeldDistinctLValueLowerBound :
    ∃ A : ℕ, 58 ≤ A ∧ ∃ c : ℝ, 0 < c ∧
      ∀ (q1 q : ℕ) [NeZero q1] [NeZero q],
        1 < q1 → q1 ≤ q →
        ∀ (chi1 : DirichletCharacter ℂ q1)
          (chi : DirichletCharacter ℂ q),
          chi1 ≠ 1 → chi ≠ 1 →
          chi1 ^ 2 = 1 → chi ^ 2 = 1 →
          (chi1.changeLevel (Nat.dvd_lcm_left q1 q) ≠ chi.changeLevel (Nat.dvd_lcm_right q1 q)) →
          ∀ beta : ℝ, 0 ≤ beta → beta < 1 →
            DirichletCharacter.LFunction chi1 (beta : ℂ) = 0 →
            c * (q : ℝ) ^ (-((A : ℝ) * (1 - beta))) /
                (Real.log (q : ℝ)) ^ 3 ≤
              ‖DirichletCharacter.LFunction chi (1 : ℂ)‖ := by
  obtain ⟨E, hE, C, hC, hleft⟩ :=
    exists_norm_goldfeldVerticalIntegral_neg_one_le
  let D : ℝ := 2 * max 1 C
  let A : ℕ := E + 1
  let c : ℝ := (131072 * D)⁻¹
  have hDpos : 0 < D := by
    dsimp [D]
    positivity
  have hDone : 1 ≤ D := by
    dsimp [D]
    nlinarith [le_max_left (1 : ℝ) C]
  have hcpos : 0 < c := by
    dsimp [c]
    positivity
  refine ⟨A, ?_, c, hcpos, ?_⟩
  · dsimp [A]
    omega
  intro q1 q _ _ hq1 hq1q chi1 chi hchi1 hchi
    hsquare1 hsquare hdistinct beta hbeta0 hbeta1 hzero
  have hqOne : 1 < q := hq1.trans_le hq1q
  have hqPos : 0 < (q : ℝ) := by positivity
  have hqRealOne : (1 : ℝ) ≤ q := by exact_mod_cast hqOne.le
  have hlogqPos : 0 < Real.log (q : ℝ) :=
    Real.log_pos (by exact_mod_cast hqOne)
  have hcross : DirichletCharacter.mul chi1 chi ≠ 1 :=
    goldfeldCrossLevelMul_ne_one chi1 chi hsquare1 hdistinct
  let x : ℝ := D * (q : ℝ) ^ E
  have hqPowPos : 0 < (q : ℝ) ^ E := pow_pos hqPos E
  have hqPowOne : (1 : ℝ) ≤ (q : ℝ) ^ E := one_le_pow₀ hqRealOne
  have hxOne : 1 ≤ x := by
    dsimp [x]
    exact one_le_mul_of_one_le_of_one_le hDone hqPowOne
  have hleftAtScale := hleft q1 q hq1 hq1q chi1 chi
    hchi1 hchi hcross beta x hbeta0 hbeta1.le hxOne
  have hscaleIdentity : C * (q : ℝ) ^ E / x = C / D := by
    dsimp [x]
    field_simp [hDpos.ne', hqPowPos.ne']
  have hCmax : C ≤ max 1 C := le_max_right 1 C
  have hCdiv : C / D ≤ (1 : ℝ) / 2 := by
    apply (div_le_iff₀ hDpos).2
    dsimp [D]
    nlinarith
  have hleftSmall :
      ‖goldfeldVerticalIntegral chi1 chi beta x (-1)‖ ≤ 1 / 2 :=
    hleftAtScale.trans (hscaleIdentity.trans_le hCdiv)
  have hresLower := half_le_norm_goldfeldContourResidue_of_leftLine
    hq1 hq1q chi1 chi hchi1 hchi hcross hsquare1 hsquare
    hbeta0 hbeta1 hxOne hzero hleftSmall
  have hresUpper := norm_goldfeldContourResidue_le
    hq1 hq1q chi1 chi hchi1 hcross hbeta0 hbeta1 hxOne hzero
  let delta : ℝ := 1 - beta
  have hdelta0 : 0 < delta := by dsimp [delta]; linarith
  have hdelta1 : delta ≤ 1 := by dsimp [delta]; linarith
  have hdeltaNonneg : 0 ≤ delta := hdelta0.le
  have hmaster :
      1 ≤ 131072 * x ^ delta * (q : ℝ) ^ (delta / 2) *
        (Real.log (q : ℝ)) ^ 3 *
        ‖DirichletCharacter.LFunction chi (1 : ℂ)‖ := by
    calc
      (1 : ℝ) = 2 * (1 / 2 : ℝ) := by norm_num
      _ ≤ 2 * ‖goldfeldContourResidue chi1 chi beta x‖ :=
        mul_le_mul_of_nonneg_left hresLower (by norm_num)
      _ ≤ 2 * (65536 * x ^ (1 - beta) *
          (q : ℝ) ^ ((1 - beta) / 2) *
          (Real.log (q : ℝ)) ^ 3 *
          ‖DirichletCharacter.LFunction chi (1 : ℂ)‖) :=
        mul_le_mul_of_nonneg_left hresUpper (by norm_num)
      _ = 131072 * x ^ delta * (q : ℝ) ^ (delta / 2) *
          (Real.log (q : ℝ)) ^ 3 *
          ‖DirichletCharacter.LFunction chi (1 : ℂ)‖ := by
        dsimp [delta]
        ring
  have hDpow : D ^ delta ≤ D := by
    simpa using Real.rpow_le_rpow_of_exponent_le hDone hdelta1
  have hexponent :
      (E : ℝ) * delta + delta / 2 ≤ (A : ℝ) * delta := by
    dsimp [A]
    push_cast
    nlinarith
  have hqExponent :
      (q : ℝ) ^ ((E : ℝ) * delta + delta / 2) ≤
        (q : ℝ) ^ ((A : ℝ) * delta) :=
    Real.rpow_le_rpow_of_exponent_le hqRealOne hexponent
  have hscalePower :
      x ^ delta * (q : ℝ) ^ (delta / 2) ≤
        D * (q : ℝ) ^ ((A : ℝ) * delta) := by
    calc
      x ^ delta * (q : ℝ) ^ (delta / 2) =
          (D ^ delta * (((q : ℝ) ^ E) ^ delta)) *
            (q : ℝ) ^ (delta / 2) := by
        dsimp [x]
        rw [Real.mul_rpow hDpos.le (pow_nonneg hqPos.le E)]
      _ = D ^ delta *
          (q : ℝ) ^ ((E : ℝ) * delta + delta / 2) := by
        rw [← Real.rpow_natCast_mul hqPos.le E delta,
          mul_assoc, ← Real.rpow_add hqPos]
      _ ≤ D * (q : ℝ) ^ ((E : ℝ) * delta + delta / 2) :=
        mul_le_mul_of_nonneg_right hDpow (Real.rpow_nonneg hqPos.le _)
      _ ≤ D * (q : ℝ) ^ ((A : ℝ) * delta) :=
        mul_le_mul_of_nonneg_left hqExponent hDpos.le
  have hmaster' :
      1 ≤ 131072 * D * (q : ℝ) ^ ((A : ℝ) * delta) *
        (Real.log (q : ℝ)) ^ 3 *
        ‖DirichletCharacter.LFunction chi (1 : ℂ)‖ := by
    calc
      (1 : ℝ) ≤ 131072 *
          (x ^ delta * (q : ℝ) ^ (delta / 2)) *
          (Real.log (q : ℝ)) ^ 3 *
          ‖DirichletCharacter.LFunction chi (1 : ℂ)‖ := by
        simpa [mul_assoc] using hmaster
      _ ≤ 131072 *
          (D * (q : ℝ) ^ ((A : ℝ) * delta)) *
          (Real.log (q : ℝ)) ^ 3 *
          ‖DirichletCharacter.LFunction chi (1 : ℂ)‖ := by
        gcongr
      _ = 131072 * D * (q : ℝ) ^ ((A : ℝ) * delta) *
          (Real.log (q : ℝ)) ^ 3 *
          ‖DirichletCharacter.LFunction chi (1 : ℂ)‖ := by ring
  have hdenPos :
      0 < 131072 * D * (q : ℝ) ^ ((A : ℝ) * delta) *
        (Real.log (q : ℝ)) ^ 3 := by
    positivity
  have hdivided :
      1 / (131072 * D * (q : ℝ) ^ ((A : ℝ) * delta) *
          (Real.log (q : ℝ)) ^ 3) ≤
        ‖DirichletCharacter.LFunction chi (1 : ℂ)‖ := by
    apply (div_le_iff₀ hdenPos).2
    simpa [mul_comm, mul_left_comm, mul_assoc] using hmaster'
  calc
    c * (q : ℝ) ^ (-((A : ℝ) * (1 - beta))) /
          (Real.log (q : ℝ)) ^ 3 =
        1 / (131072 * D * (q : ℝ) ^ ((A : ℝ) * delta) *
          (Real.log (q : ℝ)) ^ 3) := by
      dsimp [c, delta]
      rw [Real.rpow_neg hqPos.le]
      field_simp [hDpos.ne',
        (Real.rpow_pos_of_pos hqPos ((A : ℝ) * (1 - beta))).ne',
        hlogqPos.ne']
    _ ≤ ‖DirichletCharacter.LFunction chi (1 : ℂ)‖ := hdivided

end

section
open Complex Set

attribute [local instance] goldfeldLcmNeZero
/--
A primitive nonprincipal quadratic Dirichlet character together with its modulus, which is
required to exceed one. The identity `character ^ 2 = 1` records the real-character condition.
-/
structure GoldfeldPrimitiveRealCharacter where
  /-- The character's natural-number modulus, required by `modulus_gt_one` to exceed `1`. -/
  modulus : ℕ
  modulus_gt_one : 1 < modulus
  /--
  The Dirichlet character at the specified modulus, required by the accompanying proofs to be
  primitive, nonprincipal, and quadratic.
  -/
  character : DirichletCharacter ℂ modulus
  isPrimitive : character.IsPrimitive
  ne_one : character ≠ 1
  sq_eq_one : character ^ 2 = 1

end

section
open Complex Set

local instance instNeZeroNatModulus (psi : GoldfeldPrimitiveRealCharacter) :
    NeZero psi.modulus :=
  ⟨Nat.ne_of_gt (Nat.zero_lt_of_lt psi.modulus_gt_one)⟩

end

open Complex Set

attribute [local instance] goldfeldLcmNeZero
attribute [local instance] PrimeGap186.instNeZeroNatModulus
theorem goldfeldPrimitiveRealCharacter_distinct_iff_ne
    (psi1 psi2 : GoldfeldPrimitiveRealCharacter) :
    (psi1.character.changeLevel (Nat.dvd_lcm_left psi1.modulus psi2.modulus) ≠
      psi2.character.changeLevel (Nat.dvd_lcm_right psi1.modulus psi2.modulus)) ↔
      psi1 ≠ psi2 := by
  constructor
  · intro hdistinct heq
    subst psi2
    exact (goldfeldCharactersDistinct_same_level_iff _ _).mp hdistinct rfl
  · intro hne
    by_cases hmodulus : psi1.modulus = psi2.modulus
    · cases psi1 with
      | mk q hq chi hprimitive hchi hsquare =>
        cases psi2 with
        | mk q' hq' chi' hprimitive' hchi' hsquare' =>
          dsimp at hmodulus
          subst q'
          let : NeZero q :=
            ⟨Nat.ne_of_gt (Nat.zero_lt_of_lt hq)⟩
          rw [goldfeldCharactersDistinct_same_level_iff]
          intro hcharacters
          apply hne
          cases hcharacters
          rfl
    · exact goldfeldCharactersDistinct_of_modulus_ne
        psi1.character psi2.character psi1.isPrimitive psi2.isPrimitive
        hmodulus

theorem goldfeldPrimitiveNearOneZero_iff_not_zeroFree
    (epsilon c : ℝ) (psi : GoldfeldPrimitiveRealCharacter) :
    (∃ beta : ℝ,
      1 - c * (psi.modulus : ℝ) ^ (-epsilon) < beta ∧ beta < 1 ∧
        DirichletCharacter.LFunction psi.character (beta : ℂ) = 0) ↔
      ¬ (∀ sigma : ℝ,
        1 - c * (psi.modulus : ℝ) ^ (-epsilon) < sigma →
          DirichletCharacter.LFunction psi.character (sigma : ℂ) ≠ 0) := by
  constructor
  · rintro ⟨beta, hbetaLower, _, hzero⟩ hzeroFree
    exact hzeroFree beta hbetaLower hzero
  · intro hnotZeroFree
    classical
    simp only [not_forall,
      not_ne_iff] at hnotZeroFree
    obtain ⟨sigma, hsigmaLower, hzero⟩ := hnotZeroFree
    refine ⟨sigma, hsigmaLower, ?_, hzero⟩
    by_contra hsigmaOne
    have hone : 1 ≤ sigma := le_of_not_gt hsigmaOne
    exact (DirichletCharacter.LFunction_ne_zero_of_one_le_re
      psi.character (.inl psi.ne_one) (by simpa using hone)) hzero

theorem exists_goldfeldPrimitiveNearOneZero_subsingleton :
    ∀ epsilon : ℝ, 0 < epsilon →
      ∃ c : ℝ, 0 < c ∧
        Set.Subsingleton
          {psi : GoldfeldPrimitiveRealCharacter |
            (∃ beta : ℝ,
              1 - c * (psi.modulus : ℝ) ^ (-epsilon) < beta ∧ beta < 1 ∧
                DirichletCharacter.LFunction psi.character (beta : ℂ) = 0)} := by
  intro epsilon hepsilon
  obtain ⟨A, hA, c0, hc0, hLValueLower⟩ :=
    exists_goldfeldDistinctLValueLowerBound
  let r : ℝ := epsilon / 20
  let c : ℝ := min (1 / 2) (min
    (epsilon / (2 * (A : ℝ))) (c0 * r ^ 5 / 1024))
  have hAOne : (1 : ℝ) ≤ A := by exact_mod_cast (by omega : 1 ≤ A)
  have hAPos : (0 : ℝ) < A := zero_lt_one.trans_le hAOne
  have hrPos : 0 < r := by dsimp [r]; positivity
  have hcPos : 0 < c := by
    dsimp [c]
    exact lt_min (by norm_num) (lt_min (by positivity) (by positivity))
  have hcHalf : c ≤ 1 / 2 := by
    dsimp [c]
    exact min_le_left _ _
  have hcExponent : c ≤ epsilon / (2 * (A : ℝ)) := by
    dsimp [c]
    exact (min_le_right _ _).trans (min_le_left _ _)
  have hcLog : c ≤ c0 * r ^ 5 / 1024 := by
    dsimp [c]
    exact (min_le_right _ _).trans (min_le_right _ _)
  have hordered :
      ∀ (psi1 psi : GoldfeldPrimitiveRealCharacter),
        psi1.modulus ≤ psi.modulus →
          (∃ beta : ℝ,
            1 - c * (psi1.modulus : ℝ) ^ (-epsilon) < beta ∧ beta < 1 ∧
              DirichletCharacter.LFunction psi1.character (beta : ℂ) = 0) →
            (∃ beta : ℝ,
              1 - c * (psi.modulus : ℝ) ^ (-epsilon) < beta ∧ beta < 1 ∧
                DirichletCharacter.LFunction psi.character (beta : ℂ) = 0) →
              (psi1.character.changeLevel (Nat.dvd_lcm_left psi1.modulus psi.modulus) ≠
                psi.character.changeLevel (Nat.dvd_lcm_right psi1.modulus psi.modulus)) →
                False := by
    intro psi1 psi hmoduli hnear1 hnear hdistinct
    obtain ⟨beta1, hbeta1Lower, hbeta1One, hzero1⟩ := hnear1
    obtain ⟨beta, hbetaLower, hbetaOne, hzero⟩ := hnear
    let Q : ℝ := psi.modulus
    let L : ℝ := Real.log Q
    let delta1 : ℝ := 1 - beta1
    let delta : ℝ := 1 - beta
    have hQOne : 1 ≤ Q := by
      dsimp [Q]
      exact_mod_cast psi.modulus_gt_one.le
    have hQPos : 0 < Q := zero_lt_one.trans_le hQOne
    have hLPos : 0 < L := by
      dsimp [L, Q]
      exact Real.log_pos (by exact_mod_cast psi.modulus_gt_one)
    have hq1PowLeOne :
        (psi1.modulus : ℝ) ^ (-epsilon) ≤ 1 :=
      Real.rpow_le_one_of_one_le_of_nonpos
        (by exact_mod_cast psi1.modulus_gt_one.le) (by linarith)
    have hqPowLeOne : Q ^ (-epsilon) ≤ 1 :=
      Real.rpow_le_one_of_one_le_of_nonpos hQOne (by linarith)
    have hdelta1Near :
        delta1 < c * (psi1.modulus : ℝ) ^ (-epsilon) := by
      dsimp [delta1]
      linarith
    have hdeltaNear : delta < c * Q ^ (-epsilon) := by
      dsimp [delta, Q] at hbetaLower ⊢
      linarith
    have hdelta1LtC : delta1 < c :=
      hdelta1Near.trans_le (mul_le_of_le_one_right hcPos.le hq1PowLeOne)
    have hdeltaLtC : delta < c :=
      hdeltaNear.trans_le (mul_le_of_le_one_right hcPos.le hqPowLeOne)
    have hbeta1Half : 1 / 2 < beta1 := by
      have hbase : 1 - c ≤
          1 - c * (psi1.modulus : ℝ) ^ (-epsilon) := by
        linarith [mul_le_of_le_one_right hcPos.le hq1PowLeOne]
      linarith
    have hbetaHalf : 1 / 2 < beta := by
      have hbase : 1 - c ≤ 1 - c * Q ^ (-epsilon) := by
        linarith [mul_le_of_le_one_right hcPos.le hqPowLeOne]
      dsimp [Q] at hbase hbetaLower
      linarith
    have hLower := hLValueLower psi1.modulus psi.modulus
      psi1.modulus_gt_one hmoduli psi1.character psi.character
      psi1.ne_one psi.ne_one psi1.sq_eq_one psi.sq_eq_one hdistinct
      beta1 (by linarith) hbeta1One hzero1
    have hUpper := norm_LFunction_one_of_real_zero_le
      psi.modulus_gt_one psi.character psi.ne_one hbetaOne.le hzero
    have hLThreePos : 0 < L ^ 3 := pow_pos hLPos 3
    have hcomparison :
        c0 * Q ^ (-((A : ℝ) * delta1)) ≤
          512 * delta * Q ^ (delta / 2) * L ^ 5 := by
      calc
        c0 * Q ^ (-((A : ℝ) * delta1)) ≤
            ‖DirichletCharacter.LFunction psi.character (1 : ℂ)‖ *
              L ^ 3 := by
          apply (div_le_iff₀ hLThreePos).mp
          simpa [Q, L, delta1] using hLower
        _ ≤ (512 * delta * Q ^ (delta / 2) * L ^ 2) * L ^ 3 :=
          mul_le_mul_of_nonneg_right (by simpa [Q, L, delta] using hUpper)
            hLThreePos.le
        _ = 512 * delta * Q ^ (delta / 2) * L ^ 5 := by ring
    have hdelta1Exponent :
        (A : ℝ) * delta1 < epsilon / 2 := by
      have hdelta1Bound :
          delta1 < epsilon / (2 * (A : ℝ)) :=
        hdelta1LtC.trans_le hcExponent
      calc
        (A : ℝ) * delta1 <
            (A : ℝ) * (epsilon / (2 * (A : ℝ))) :=
          mul_lt_mul_of_pos_left hdelta1Bound hAPos
        _ = epsilon / 2 := by field_simp [hAPos.ne']
    have hleftFloor :
        c0 * Q ^ (-epsilon / 2) ≤
          c0 * Q ^ (-((A : ℝ) * delta1)) := by
      exact mul_le_mul_of_nonneg_left
        (Real.rpow_le_rpow_of_exponent_le hQOne (by linarith)) hc0.le
    have hcScaled : c * (2 * (A : ℝ)) ≤ epsilon :=
      (le_div_iff₀ (by positivity : 0 < 2 * (A : ℝ))).mp hcExponent
    have hcEpsilonHalf : c ≤ epsilon / 2 := by
      have htwoC : 2 * c ≤ c * (2 * (A : ℝ)) := by
        calc
          2 * c = c * (2 * 1) := by ring
          _ ≤ c * (2 * (A : ℝ)) := by gcongr
      linarith
    have hdeltaQuarter : delta / 2 ≤ epsilon / 4 := by
      linarith
    have hdeltaPower : Q ^ (delta / 2) ≤ Q ^ (epsilon / 4) :=
      Real.rpow_le_rpow_of_exponent_le hQOne hdeltaQuarter
    have hlogBase : L ≤ Q ^ r / r := by
      simpa [L, Q] using
        Real.log_natCast_le_rpow_div psi.modulus hrPos
    have hlogPow : L ^ 5 ≤ Q ^ (epsilon / 4) / r ^ 5 := by
      calc
        L ^ 5 ≤ (Q ^ r / r) ^ 5 :=
          pow_le_pow_left₀ hLPos.le hlogBase 5
        _ = Q ^ (epsilon / 4) / r ^ 5 := by
          rw [div_pow, ← Real.rpow_mul_natCast hQPos.le]
          congr 2
          dsimp [r]
          ring
    have hpowThreeQuarter :
        Q ^ (-epsilon) * Q ^ (epsilon / 4) =
          Q ^ (-3 * epsilon / 4) := by
      rw [← Real.rpow_add hQPos]
      congr 1
      ring
    have hpowHalf :
        Q ^ (-3 * epsilon / 4) * Q ^ (epsilon / 4) =
          Q ^ (-epsilon / 2) := by
      rw [← Real.rpow_add hQPos]
      congr 1
      ring
    have hupperStrict :
        512 * delta * Q ^ (delta / 2) * L ^ 5 <
          c0 * Q ^ (-epsilon / 2) := by
      calc
        512 * delta * Q ^ (delta / 2) * L ^ 5 <
            512 * (c * Q ^ (-epsilon)) * Q ^ (delta / 2) *
              L ^ 5 := by gcongr
        _ ≤ 512 * (c * Q ^ (-epsilon)) * Q ^ (epsilon / 4) *
              L ^ 5 := by gcongr
        _ = 512 * c * Q ^ (-3 * epsilon / 4) * L ^ 5 := by
          rw [show 512 * (c * Q ^ (-epsilon)) * Q ^ (epsilon / 4) *
              L ^ 5 = 512 * c *
                (Q ^ (-epsilon) * Q ^ (epsilon / 4)) * L ^ 5 by ring,
            hpowThreeQuarter]
        _ ≤ 512 * (c0 * r ^ 5 / 1024) *
              Q ^ (-3 * epsilon / 4) *
                (Q ^ (epsilon / 4) / r ^ 5) := by gcongr
        _ = (c0 / 2) * Q ^ (-epsilon / 2) := by
          calc
            512 * (c0 * r ^ 5 / 1024) * Q ^ (-3 * epsilon / 4) *
                (Q ^ (epsilon / 4) / r ^ 5) =
                (c0 / 2) *
                  (Q ^ (-3 * epsilon / 4) * Q ^ (epsilon / 4)) := by
              field_simp [hrPos.ne']; ring
            _ = (c0 / 2) * Q ^ (-epsilon / 2) := by rw [hpowHalf]
        _ < c0 * Q ^ (-epsilon / 2) := by
          have hproductPos : 0 < c0 * Q ^ (-epsilon / 2) :=
            mul_pos hc0 (Real.rpow_pos_of_pos hQPos _)
          nlinarith
    exact (not_lt_of_ge (hleftFloor.trans hcomparison)) hupperStrict
  refine ⟨c, hcPos, ?_⟩
  intro psi1 hnear1 psi2 hnear2
  by_contra hne
  rcases le_total psi1.modulus psi2.modulus with hle | hle
  · exact hordered psi1 psi2 hle hnear1 hnear2
      ((goldfeldPrimitiveRealCharacter_distinct_iff_ne _ _).2 hne)
  · exact hordered psi2 psi1 hle hnear2 hnear1
      ((goldfeldPrimitiveRealCharacter_distinct_iff_ne _ _).2 (Ne.symm hne))

theorem exists_goldfeldPrimitiveExceptionalCharacter :
    ∀ epsilon : ℝ, 0 < epsilon →
      ∃ c : ℝ, 0 < c ∧
        ∃ exception : Option GoldfeldPrimitiveRealCharacter,
          ∀ psi : GoldfeldPrimitiveRealCharacter,
            some psi ≠ exception →
              (∀ sigma : ℝ,
                1 - c * (psi.modulus : ℝ) ^ (-epsilon) < sigma →
                  DirichletCharacter.LFunction psi.character (sigma : ℂ) ≠ 0) := by
  intro epsilon hepsilon
  obtain ⟨c, hc, hsubsingleton⟩ :=
    exists_goldfeldPrimitiveNearOneZero_subsingleton epsilon hepsilon
  refine ⟨c, hc, ?_⟩
  classical
  by_cases hnonempty :
      Set.Nonempty
        {psi : GoldfeldPrimitiveRealCharacter |
          (∃ beta : ℝ,
            1 - c * (psi.modulus : ℝ) ^ (-epsilon) < beta ∧ beta < 1 ∧
              DirichletCharacter.LFunction psi.character (beta : ℂ) = 0)}
  · obtain ⟨exception, hexception⟩ := hnonempty
    refine ⟨some exception, ?_⟩
    intro psi hpsi
    by_contra hnotZeroFree
    have hnear :=
      (goldfeldPrimitiveNearOneZero_iff_not_zeroFree _ _ _).2
        hnotZeroFree
    have heq : psi = exception := hsubsingleton hnear hexception
    exact hpsi (congrArg some heq)
  · refine ⟨none, ?_⟩
    intro psi _
    by_contra hnotZeroFree
    exact hnonempty ⟨psi,
      (goldfeldPrimitiveNearOneZero_iff_not_zeroFree _ _ _).2
        hnotZeroFree⟩

end PrimeGap186

section
open Complex

attribute [local instance] PrimeGap186.goldfeldLcmNeZero
attribute [local instance] PrimeGap186.instNeZeroNatModulus
theorem PrimeGap186.exists_siegelPrimitiveRealCharacterZeroFree :
    ∀ epsilon : ℝ, 0 < epsilon →
      ∃ c : ℝ, 0 < c ∧
        ∀ psi : PrimeGap186.GoldfeldPrimitiveRealCharacter,
          ∀ sigma : ℝ,
            1 - c * (psi.modulus : ℝ) ^ (-epsilon) < sigma →
              DirichletCharacter.LFunction psi.character (sigma : ℂ) ≠ 0
  := by
  classical
  intro epsilon hepsilon
  obtain ⟨c0, hc0, exception, hzeroFree⟩ :=
    PrimeGap186.exists_goldfeldPrimitiveExceptionalCharacter epsilon hepsilon
  cases exception with
  | none =>
      let c : ℝ := min c0 (1 / 2)
      have hcPos : 0 < c := by
        dsimp [c]
        exact lt_min hc0 (by norm_num)
      refine ⟨c, hcPos, ?_⟩
      intro psi sigma hsigma
      apply hzeroFree psi (by simp) sigma
      have hcLe : c ≤ c0 := by
        dsimp [c]
        exact min_le_left _ _
      have hweightNonneg : 0 ≤ (psi.modulus : ℝ) ^ (-epsilon) :=
        Real.rpow_nonneg (Nat.cast_nonneg psi.modulus) _
      have hscaled := mul_le_mul_of_nonneg_right hcLe hweightNonneg
      linarith
  | some exception =>
      have hLone : DirichletCharacter.LFunction exception.character (1 : ℂ) ≠ 0 :=
        DirichletCharacter.LFunction_apply_one_ne_zero exception.ne_one
      have hLcontinuous :
          ContinuousAt (DirichletCharacter.LFunction exception.character) (1 : ℂ) :=
        (DirichletCharacter.differentiable_LFunction exception.ne_one (1 : ℂ)).continuousAt
      obtain ⟨delta, hdeltaPos, hdelta⟩ :=
        Metric.eventually_nhds_iff.mp (hLcontinuous.eventually_ne hLone)
      let weight : ℝ := (exception.modulus : ℝ) ^ (-epsilon)
      let c : ℝ := min (min c0 (1 / 2)) (delta / weight)
      have hmodulusPos : (0 : ℝ) < exception.modulus := by
        exact_mod_cast (Nat.zero_lt_of_lt exception.modulus_gt_one)
      have hweightPos : 0 < weight := by
        dsimp [weight]
        exact Real.rpow_pos_of_pos hmodulusPos _
      have hcPos : 0 < c := by
        dsimp [c]
        exact lt_min (lt_min hc0 (by norm_num)) (div_pos hdeltaPos hweightPos)
      have hcLe : c ≤ c0 := by
        dsimp [c]
        exact (min_le_left _ _).trans (min_le_left _ _)
      have hcRadius : c * weight ≤ delta := by
        apply (le_div_iff₀ hweightPos).mp
        dsimp [c]
        exact min_le_right _ _
      refine ⟨c, hcPos, ?_⟩
      intro psi
      by_cases hpsi : psi = exception
      · subst psi
        intro sigma hsigma
        by_cases hsigmaOne : 1 ≤ sigma
        · exact DirichletCharacter.LFunction_ne_zero_of_one_le_re
            exception.character (.inl exception.ne_one) (by simpa using hsigmaOne)
        · have hsigmaLt : sigma < 1 := lt_of_not_ge hsigmaOne
          have hdist : dist (sigma : ℂ) 1 = 1 - sigma := by
            rw [Complex.dist_eq, ← Complex.ofReal_one, ← Complex.ofReal_sub,
              Complex.norm_real, Real.norm_eq_abs, abs_of_neg (sub_neg.mpr hsigmaLt)]
            ring
          apply hdelta
          rw [hdist]
          have hsigma' : 1 - c * weight < sigma := by
            simpa only [weight] using hsigma
          have hgap : 1 - sigma < c * weight := by linarith
          exact hgap.trans_le hcRadius
      · intro sigma hsigma
        apply hzeroFree psi (by simpa using hpsi) sigma
        have hweightNonneg : 0 ≤ (psi.modulus : ℝ) ^ (-epsilon) :=
          Real.rpow_nonneg (Nat.cast_nonneg psi.modulus) _
        have hscaled := mul_le_mul_of_nonneg_right hcLe hweightNonneg
        linarith

end

namespace PrimeGap186

open Complex

section

attribute [local instance] goldfeldLcmNeZero
attribute [local instance] PrimeGap186.instNeZeroNatModulus
theorem exists_siegelRealCharacterZeroFree :
    ∀ epsilon : ℝ, 0 < epsilon →
      ∃ c : ℝ, 0 < c ∧
        ∀ (q : ℕ) [NeZero q]
          (chi : DirichletCharacter ℂ q),
            chi ≠ 1 →
              chi ^ 2 = 1 →
                ∀ sigma : ℝ,
                  1 - c * (q : ℝ) ^ (-epsilon) < sigma →
                    DirichletCharacter.LFunction chi (sigma : ℂ) ≠ 0 := by
  intro epsilon hepsilon
  obtain ⟨c0, hc0, hprimitive⟩ :=
    exists_siegelPrimitiveRealCharacterZeroFree epsilon hepsilon
  let c : ℝ := min c0 (1 / 2)
  have hcPos : 0 < c := by
    dsimp [c]
    exact lt_min hc0 (by norm_num)
  have hcLe : c ≤ c0 := by
    dsimp [c]
    exact min_le_left _ _
  have hcHalf : c ≤ 1 / 2 := by
    dsimp [c]
    exact min_le_right _ _
  refine ⟨c, hcPos, ?_⟩
  intro q _ chi hchi hsquare sigma hsigma
  have hconductorOne : 1 < chi.conductor := by
    have hconductorZero : chi.conductor ≠ 0 := chi.conductor_ne_zero
    have hconductorNeOne : chi.conductor ≠ 1 := by
      intro hconductor
      exact hchi
        (DirichletCharacter.eq_one_iff_conductor_eq_one.mpr hconductor)
    omega
  let : NeZero chi.conductor := ⟨chi.conductor_ne_zero⟩
  have hprimitiveNeOne : chi.primitiveCharacter ≠ 1 := by
    intro hprincipal
    apply hchi
    rw [← chi.changeLevel_primitiveCharacter]
    exact (DirichletCharacter.changeLevel_eq_one_iff
      chi.conductor_dvd_level).2 hprincipal
  have hprimitiveSquare : chi.primitiveCharacter ^ 2 = 1 := by
    apply DirichletCharacter.changeLevel_injective
      chi.conductor_dvd_level
    rw [map_pow, chi.changeLevel_primitiveCharacter, hsquare, map_one]
  let psi : GoldfeldPrimitiveRealCharacter :=
    { modulus := chi.conductor
      modulus_gt_one := hconductorOne
      character := chi.primitiveCharacter
      isPrimitive := chi.primitiveCharacter_isPrimitive
      ne_one := hprimitiveNeOne
      sq_eq_one := hprimitiveSquare }
  have hconductorLe : chi.conductor ≤ q :=
    Nat.le_of_dvd (NeZero.pos q) chi.conductor_dvd_level
  have hconductorPos : (0 : ℝ) < chi.conductor := by
    exact_mod_cast (Nat.zero_lt_of_lt hconductorOne)
  have hconductorLevel : (chi.conductor : ℝ) ≤ q := by
    exact_mod_cast hconductorLe
  have hnegativePower :
      (q : ℝ) ^ (-epsilon) ≤
        (chi.conductor : ℝ) ^ (-epsilon) :=
    Real.rpow_le_rpow_of_nonpos hconductorPos hconductorLevel
      (by linarith)
  have hconductorWeightNonneg :
      0 ≤ (chi.conductor : ℝ) ^ (-epsilon) :=
    Real.rpow_nonneg (Nat.cast_nonneg chi.conductor) _
  have hscaled :
      c * (q : ℝ) ^ (-epsilon) ≤
        c0 * (chi.conductor : ℝ) ^ (-epsilon) := by
    calc
      c * (q : ℝ) ^ (-epsilon) ≤
          c * (chi.conductor : ℝ) ^ (-epsilon) :=
        mul_le_mul_of_nonneg_left hnegativePower hcPos.le
      _ ≤ c0 * (chi.conductor : ℝ) ^ (-epsilon) :=
        mul_le_mul_of_nonneg_right hcLe hconductorWeightNonneg
  have hprimitiveThreshold :
      1 - c0 * (chi.conductor : ℝ) ^ (-epsilon) < sigma := by
    linarith
  have hprimitiveNonzero :
      DirichletCharacter.LFunction chi.primitiveCharacter
          (sigma : ℂ) ≠ 0 := by
    apply hprimitive psi sigma
    simpa [psi] using hprimitiveThreshold
  have hlevelOne : (1 : ℝ) ≤ q := by
    exact_mod_cast NeZero.pos q
  have hlevelWeightLeOne :
      (q : ℝ) ^ (-epsilon) ≤ 1 :=
    Real.rpow_le_one_of_one_le_of_nonpos hlevelOne (by linarith)
  have hscaledHalf : c * (q : ℝ) ^ (-epsilon) ≤ 1 / 2 :=
    (mul_le_of_le_one_right hcPos.le hlevelWeightLeOne).trans hcHalf
  have hsigmaPos : 0 < sigma := by
    linarith
  rw [LFunction_eq_inducingPrimitive_mul_inducingEulerProduct chi
    (.inl hchi)]
  exact mul_ne_zero hprimitiveNonzero
    (inducingEulerProduct_ne_zero_of_re_pos chi (by simpa using hsigmaPos))

end

open Set
open scoped ComplexOrder Interval

theorem moebiusCharacterSeries_eq_inv {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) {s : ℂ} (hs : 1 < s.re) :
    LSeries (fun n => chi n * (ArithmeticFunction.moebius n : ℂ)) s =
      (DirichletCharacter.LFunction chi s)⁻¹ := by
  have hprod : LSeries (fun n : ℕ => chi n) s *
      LSeries (fun n => chi n * (ArithmeticFunction.moebius n : ℂ)) s = 1 := by
    have hfun : (fun n : ℕ => chi n * (ArithmeticFunction.moebius n : ℂ)) =
        (fun n : ℕ => chi n) * (fun n : ℕ => (ArithmeticFunction.moebius n : ℂ)) := by
      funext n
      rfl
    rw [hfun]
    exact DirichletCharacter.LSeries.mul_mu_eq_one chi hs
  rw [DirichletCharacter.LFunction_eq_LSeries chi hs]
  exact (inv_eq_of_mul_eq_one_right hprod).symm

/--
The usable strip width obtained by taking the minimum of `1 / 2`, the logarithmic zero-free
width, and the Siegel bound `c * q ^ (-epsilon)`. The minimum accounts for both ordinary zeros
and a possible exceptional real zero.
-/
noncomputable def zeroFreeWidth (M : ℕ) (c epsilon : ℝ) (q : ℕ) (T : ℝ) : ℝ :=
  min (1 / 2) (min
    (1 / ((M : ℝ) ^ 2 * Real.log ((q : ℝ) * (T + 2))))
    (c * (q : ℝ) ^ (-epsilon)))

theorem zeroFreeWidth_pos {M q : ℕ} [NeZero q] {c epsilon T : ℝ}
    (hM : 2 ≤ M) (hc : 0 < c) (hT : 0 ≤ T) :
    0 < zeroFreeWidth M c epsilon q T := by
  have hMpos : (0 : ℝ) < M := by exact_mod_cast (show 0 < M by omega)
  have hqpos : (0 : ℝ) < q := by exact_mod_cast Nat.pos_of_ne_zero (NeZero.ne q)
  have hlevel : (2 : ℝ) ≤ (q : ℝ) * (T + 2) := by
    simpa only [abs_of_nonneg hT] using (two_le_level_height (q := q) T)
  have hlog : 0 < Real.log ((q : ℝ) * (T + 2)) :=
    Real.log_pos (one_lt_two.trans_le hlevel)
  exact lt_min (by norm_num) (lt_min
    (one_div_pos.mpr (mul_pos (sq_pos_of_pos hMpos) hlog))
    (mul_pos hc (Real.rpow_pos_of_pos hqpos _)))

theorem zeroFreeWidth_antitone_level {M d q : ℕ} [NeZero d]
    {c epsilon T : ℝ} (hM : 2 ≤ M) (hc : 0 ≤ c) (hepsilon : 0 ≤ epsilon)
    (hT : 0 ≤ T) (hdq : d ≤ q) :
    zeroFreeWidth M c epsilon q T ≤ zeroFreeWidth M c epsilon d T := by
  have hMpos : (0 : ℝ) < M := by exact_mod_cast (show 0 < M by omega)
  have hdpos : (0 : ℝ) < d := by exact_mod_cast NeZero.pos d
  have hdqR : (d : ℝ) ≤ q := by exact_mod_cast hdq
  have hlevel : (2 : ℝ) ≤ (d : ℝ) * (T + 2) := by
    simpa only [abs_of_nonneg hT] using two_le_level_height (q := d) T
  have hlogpos : 0 < Real.log ((d : ℝ) * (T + 2)) :=
    Real.log_pos (one_lt_two.trans_le hlevel)
  apply min_le_min le_rfl
  apply min_le_min
  · exact one_div_le_one_div_of_le (mul_pos (sq_pos_of_pos hMpos) hlogpos)
      (mul_le_mul_of_nonneg_left
        (Real.log_le_log (zero_lt_two.trans_le hlevel)
          (mul_le_mul_of_nonneg_right hdqR (by linarith))) (sq_nonneg _))
  · exact mul_le_mul_of_nonneg_left
      (Real.rpow_le_rpow_of_nonpos hdpos hdqR (neg_nonpos.mpr hepsilon)) hc

theorem zeroFreeWidth_mono_constants {M M' q : ℕ} [NeZero q]
    {c c' epsilon T : ℝ} (hM : 2 ≤ M) (hMM' : M ≤ M')
    (hcc' : c' ≤ c) (hT : 0 ≤ T) :
    zeroFreeWidth M' c' epsilon q T ≤ zeroFreeWidth M c epsilon q T := by
  have hMpos : (0 : ℝ) < M := by exact_mod_cast (show 0 < M by omega)
  have hMM'R : (M : ℝ) ≤ M' := by exact_mod_cast hMM'
  have hlevel : (2 : ℝ) ≤ (q : ℝ) * (T + 2) := by
    simpa only [abs_of_nonneg hT] using two_le_level_height (q := q) T
  have hlog : 0 < Real.log ((q : ℝ) * (T + 2)) :=
    Real.log_pos (one_lt_two.trans_le hlevel)
  apply min_le_min le_rfl
  apply min_le_min
  · exact one_div_le_one_div_of_le (mul_pos (sq_pos_of_pos hMpos) hlog)
      (mul_le_mul_of_nonneg_right
        ((sq_le_sq₀ hMpos.le (Nat.cast_nonneg M')).mpr hMM'R) hlog.le)
  · exact mul_le_mul_of_nonneg_right hcc' (Real.rpow_nonneg (Nat.cast_nonneg q) _)

theorem exists_nonprincipal_zeroFree_rectangle {epsilon : ℝ} (hepsilon : 0 < epsilon) :
    ∃ M : ℕ, 2 ≤ M ∧ ∃ c : ℝ, 0 < c ∧
      ∀ (q : ℕ) [NeZero q] (chi : DirichletCharacter ℂ q), chi ≠ 1 →
        ∀ T : ℝ, 0 ≤ T → ∀ s : ℂ, |s.im| ≤ T →
          1 - zeroFreeWidth M c epsilon q T < s.re →
            DirichletCharacter.LFunction chi s ≠ 0 := by
  obtain ⟨M, hM, hshape⟩ :=
    exists_nat_nonprincipalNontrivialLFunctionZero_sq_eq_one_real_simple
  obtain ⟨c, hc, hsiegel⟩ := exists_siegelRealCharacterZeroFree epsilon hepsilon
  refine ⟨M, hM, c, hc, ?_⟩
  intro q _ chi hchi T hT s him hnear hzero
  let : NeZero chi.conductor := ⟨chi.conductor_ne_zero⟩
  have hMpos : (0 : ℝ) < M := by exact_mod_cast (show 0 < M by omega)
  have hqpos : (0 : ℝ) < q := by exact_mod_cast Nat.pos_of_ne_zero (NeZero.ne q)
  have hhalf : zeroFreeWidth M c epsilon q T ≤ 1 / 2 := min_le_left _ _
  have hwidthLog : zeroFreeWidth M c epsilon q T ≤
      1 / ((M : ℝ) ^ 2 * Real.log ((q : ℝ) * (T + 2))) :=
    (min_le_right _ _).trans (min_le_left _ _)
  have hwidthSiegel : zeroFreeWidth M c epsilon q T ≤ c * (q : ℝ) ^ (-epsilon) :=
    (min_le_right _ _).trans (min_le_right _ _)
  have hre0 : 0 < s.re := by linarith
  have hre1 : s.re < 1 := by
    by_contra h
    exact chi.LFunction_ne_zero_of_one_le_re (.inl hchi) (le_of_not_gt h) hzero
  have hrho : (chi ≠ 1 ∧
      DirichletCharacter.completedLFunction chi.primitiveCharacter s = 0) :=
    (isNonprincipalNontrivialLFunctionZero_iff chi s).mpr ⟨hchi, hzero, hre0, hre1⟩
  have hlevel : (2 : ℝ) ≤ (q : ℝ) * (|s.im| + 2) := two_le_level_height s.im
  have hlogpos : 0 < Real.log ((q : ℝ) * (|s.im| + 2)) :=
    Real.log_pos (one_lt_two.trans_le hlevel)
  have hlogle : Real.log ((q : ℝ) * (|s.im| + 2)) ≤
      Real.log ((q : ℝ) * (T + 2)) :=
    Real.log_le_log (zero_lt_two.trans_le hlevel)
      (mul_le_mul_of_nonneg_left (by linarith : |s.im| + 2 ≤ T + 2) hqpos.le)
  have hgap : 1 / ((M : ℝ) ^ 2 * Real.log ((q : ℝ) * (T + 2))) ≤
      1 / ((M : ℝ) ^ 2 * Real.log ((q : ℝ) * (|s.im| + 2))) :=
    one_div_le_one_div_of_le (mul_pos (sq_pos_of_pos hMpos) hlogpos)
      (mul_le_mul_of_nonneg_left hlogle (sq_nonneg _))
  have hshapeNear :
      1 - 1 / ((M : ℝ) ^ 2 * Real.log ((q : ℝ) * (|s.im| + 2))) ≤ s.re := by
    linarith [hwidthLog.trans hgap]
  obtain ⟨hsquare, himzero, _⟩ := hshape q chi s hrho hshapeNear
  have hsreal : s = (s.re : ℂ) := by
    apply Complex.ext <;> simp [himzero]
  have hrealNear : 1 - c * (q : ℝ) ^ (-epsilon) < s.re := by linarith
  exact hsiegel q chi hchi hsquare s.re hrealNear (by simpa only [← hsreal] using hzero)

theorem norm_inv_horizontal_le_exp {f : ℂ → ℂ} {c : ℂ} {L B : ℝ}
    (hL : 0 ≤ L)
    (hdiff : ∀ u ∈ Icc (0 : ℝ) L, DifferentiableAt ℂ f (c - (u : ℂ)))
    (hne : ∀ u ∈ Icc (0 : ℝ) L, f (c - (u : ℂ)) ≠ 0)
    (hlog : ∀ u ∈ Icc (0 : ℝ) L, ‖logDeriv f (c - (u : ℂ))‖ ≤ B) :
    ‖(f (c - (L : ℂ)))⁻¹‖ ≤ ‖(f c)⁻¹‖ * Real.exp (B * L) := by
  let F : ℝ → ℂ := fun u => (f (c - (u : ℂ)))⁻¹
  let F' : ℝ → ℂ := fun u => logDeriv f (c - (u : ℂ)) * F u
  have hderiv : ∀ u ∈ Icc (0 : ℝ) L, HasDerivAt F (F' u) u := by
    intro u hu
    change HasDerivAt (fun v : ℝ => (f (c - (v : ℂ)))⁻¹)
      (logDeriv f (c - (u : ℂ)) * (f (c - (u : ℂ)))⁻¹) u
    have hcomp := HasDerivAt.comp_const_sub c (u : ℂ) (hdiff u hu).hasDerivAt
    have hinv := (hcomp.inv (hne u hu)).comp_ofReal
    change HasDerivAt (fun v : ℝ => (f (c - (v : ℂ)))⁻¹)
      (-(-deriv f (c - (u : ℂ))) / f (c - (u : ℂ)) ^ 2) u at hinv
    apply hinv.congr_deriv
    rw [logDeriv_apply]
    field_simp [hne u hu]
  have hcont : ContinuousOn F (Icc (0 : ℝ) L) :=
    fun u hu => (hderiv u hu).continuousAt.continuousWithinAt
  have hbound : ∀ u ∈ Ico (0 : ℝ) L, ‖F' u‖ ≤ B * ‖F u‖ + 0 := by
    intro u hu
    dsimp [F']
    rw [norm_mul, add_zero]
    exact mul_le_mul_of_nonneg_right (hlog u ⟨hu.1, hu.2.le⟩) (norm_nonneg _)
  have hg := norm_le_gronwallBound_of_norm_deriv_right_le hcont
    (fun u hu => (hderiv u ⟨hu.1, hu.2.le⟩).hasDerivWithinAt)
    (le_refl ‖F 0‖) hbound L ⟨hL, le_rfl⟩
  simpa only [gronwallBound_ε0, sub_zero, F, Complex.ofReal_zero, sub_zero] using hg

theorem tsum_norm_term_of_bounded_le_zeta (a : ℕ → ℂ)
    (ha : ∀ n, ‖a n‖ ≤ 1) {s : ℂ} (hs : 1 < s.re) :
    (∑' n, ‖LSeries.term a s n‖) ≤ ‖riemannZeta (s.re : ℂ)‖ := by
  have hsum : LSeriesSummable a s :=
    LSeriesSummable_of_bounded_of_one_lt_re (fun n _ => ha n) hs
  have hone : LSeriesSummable 1 (s.re : ℂ) :=
    LSeriesSummable_one_iff.mpr (by simpa using hs)
  have hterm : ∀ n : ℕ, ‖LSeries.term a s n‖ ≤
      ‖LSeries.term 1 (s.re : ℂ) n‖ := by
    intro n
    simp only [LSeries.norm_term_eq, Complex.ofReal_re]
    split_ifs with hn
    · exact le_rfl
    · simpa using div_le_div_of_nonneg_right (ha n)
        (Real.rpow_nonneg (Nat.cast_nonneg n) s.re)
  have hreal : ∀ n : ℕ, (LSeries.term 1 (s.re : ℂ) n).re =
      ‖LSeries.term 1 (s.re : ℂ) n‖ := by
    intro n
    exact Complex.re_eq_norm.mpr (LSeries.term_nonneg (by exact zero_le_one) s.re)
  calc
    _ ≤ ∑' n, ‖LSeries.term 1 (s.re : ℂ) n‖ :=
      hsum.norm.tsum_le_tsum hterm hone.norm
    _ = (LSeries 1 (s.re : ℂ)).re := by
      rw [LSeries, Complex.re_tsum hone]
      exact tsum_congr fun n => (hreal n).symm
    _ = (riemannZeta (s.re : ℂ)).re := by
      rw [LSeries_one_eq_riemannZeta (by simpa using hs)]
    _ ≤ ‖riemannZeta (s.re : ℂ)‖ := Complex.re_le_norm _

theorem norm_LSeries_of_bounded_le_zeta (a : ℕ → ℂ)
    (ha : ∀ n, ‖a n‖ ≤ 1) {s : ℂ} (hs : 1 < s.re) :
    ‖LSeries a s‖ ≤ ‖riemannZeta (s.re : ℂ)‖ := by
  have hsum : LSeriesSummable a s :=
    LSeriesSummable_of_bounded_of_one_lt_re (fun n _ => ha n) hs
  exact (norm_tsum_le_tsum_norm hsum.norm).trans
    (tsum_norm_term_of_bounded_le_zeta a ha hs)

theorem norm_riemannZeta_real_le_three_div_sub {sigma : ℝ}
    (hsigma : 1 < sigma) (hupper : sigma ≤ 2) :
    ‖riemannZeta (sigma : ℂ)‖ ≤ 3 / (sigma - 1) := by
  have hpos : 0 < sigma := zero_lt_one.trans hsigma
  have hgap : 0 < sigma - 1 := sub_pos.mpr hsigma
  have hne : (sigma : ℂ) ≠ 1 := by
    intro h
    have := congrArg Complex.re h
    simp only [Complex.ofReal_re, Complex.one_re] at this
    linarith
  have hnorm : ‖(sigma : ℂ)‖ = sigma := by
    simp only [Complex.norm_real, Real.norm_eq_abs, abs_of_pos hpos]
  have hsubnorm : ‖(sigma : ℂ) - 1‖ = sigma - 1 := by
    rw [← Complex.ofReal_one, ← Complex.ofReal_sub, Complex.norm_real,
      Real.norm_eq_abs, abs_of_pos hgap]
  have hreg := norm_riemannZeta₁_le_abel (sigma : ℂ) (by simpa using hpos)
  rw [hnorm, hsubnorm, Complex.ofReal_re] at hreg
  have hcancel : sigma * (sigma - 1) / sigma = sigma - 1 := by
    field_simp
  have hreg3 : ‖riemannZeta₁ (sigma : ℂ)‖ ≤ 3 := by
    rw [hcancel] at hreg
    linarith
  rw [riemannZeta_eq_inv_sub_mul hne, norm_mul, norm_inv, hsubnorm]
  calc
    _ ≤ (sigma - 1)⁻¹ * 3 :=
      mul_le_mul_of_nonneg_left hreg3 (inv_nonneg.mpr hgap.le)
    _ = _ := by ring

theorem norm_inv_LFunction_le_three_div_sub
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    {s : ℂ} (hs : 1 < s.re) (hupper : s.re ≤ 2) :
    ‖(DirichletCharacter.LFunction chi s)⁻¹‖ ≤ 3 / (s.re - 1) := by
  rw [← moebiusCharacterSeries_eq_inv chi hs]
  exact (norm_LSeries_of_bounded_le_zeta _
    (norm_character_mul_moebius_le_one chi) hs).trans
      (norm_riemannZeta_real_le_three_div_sub hs hupper)

theorem exists_primitive_nearOne_logDeriv_bound {epsilon : ℝ} (hepsilon : 0 < epsilon) :
    ∃ M : ℕ, 2 ≤ M ∧ ∃ c : ℝ, 0 < c ∧ ∃ A : ℕ, 37 ≤ A ∧
      ∀ (q : ℕ) [NeZero q], 1 < q →
        ∀ chi : DirichletCharacter ℂ q, chi.IsPrimitive →
          ∀ T : ℝ, 0 ≤ T → ∀ t sigma : ℝ, |t| ≤ T →
            1 - zeroFreeWidth M c epsilon q (T + 6) / 2 ≤ sigma → sigma ≤ 2 →
              DirichletCharacter.LFunction chi ((sigma : ℂ) + t * I) ≠ 0 ∧
                ‖logDeriv (DirichletCharacter.LFunction chi)
                    ((sigma : ℂ) + t * I)‖ ≤
                  10 * (A : ℝ) * Real.log ((q : ℝ) * (T + 8)) /
                    zeroFreeWidth M c epsilon q (T + 6) := by
  obtain ⟨M, hM, c, hc, hzeroFree⟩ := exists_nonprincipal_zeroFree_rectangle hepsilon
  obtain ⟨Af, hAf, hfixed⟩ :=
    exists_nat_norm_logDeriv_LFunction_sub_radiusSix_divisor_finsum_le
  obtain ⟨Ad, _hAd, hmass⟩ := exists_nat_finsum_divisor_LFunction_radiusSix_le
  let A : ℕ := max Af Ad
  refine ⟨M, hM, c, hc, A, hAf.trans (le_max_left _ _), ?_⟩
  intro q _ hq chi hchi T hT t sigma ht hsigma hsigmaupper
  let W : ℝ := zeroFreeWidth M c epsilon q (T + 6)
  let H : ℝ := Real.log ((q : ℝ) * (T + 8))
  let s : ℂ := (sigma : ℂ) + t * I
  let Z : ℂ → ℤ := MeromorphicOn.divisor (DirichletCharacter.LFunction chi)
    (closedBall ((2 : ℂ) + t * I) 6)
  have hW : 0 < W := zeroFreeWidth_pos hM hc (by linarith)
  have hWhalf : W ≤ 1 / 2 := min_le_left _ _
  have hchiNe : chi ≠ 1 := character_ne_one_of_isPrimitive hq chi hchi
  have hsnonzero : DirichletCharacter.LFunction chi s ≠ 0 := by
    apply hzeroFree q chi hchiNe (T + 6) (by linarith) s
    · simpa [s] using (ht.trans (by linarith : T ≤ T + 6))
    · have hsnear : 1 - W < sigma := by
        change 1 - W / 2 ≤ sigma at hsigma
        linarith
      simpa [s] using hsnear
  have hsdisk : s ∈ closedBall ((2 : ℂ) + t * I) 3 := by
    rw [mem_closedBall, Complex.dist_eq]
    have hsub : s - ((2 : ℂ) + t * I) = ((sigma - 2 : ℝ) : ℂ) := by
      dsimp [s]
      push_cast
      ring
    rw [hsub, Complex.norm_real, Real.norm_eq_abs, abs_le]
    change 1 - W / 2 ≤ sigma at hsigma
    constructor <;> linarith
  have hZfinite : Z.support.Finite :=
    divisor_LFunction_closedBall_support_finite hchiNe _ _
  have hZnonneg : 0 ≤ Z := divisor_LFunction_nonneg hchiNe _
  have hZsep : ∀ rho ∈ Z.support, W / 2 ≤ ‖s - rho‖ := by
    intro rho hrho
    have hrhoDisk : rho ∈ closedBall ((2 : ℂ) + t * I) 6 :=
      (MeromorphicOn.divisor (DirichletCharacter.LFunction chi)
        (closedBall ((2 : ℂ) + t * I) 6)).supportWithinDomain hrho
    have hrhoZero : DirichletCharacter.LFunction chi rho = 0 :=
      (mem_support_divisor_LFunction_iff hchiNe hrhoDisk).mp hrho
    have himdiff : |rho.im - t| ≤ 6 := by
      have habs := Complex.abs_im_le_norm (rho - ((2 : ℂ) + t * I))
      have hnorm := mem_closedBall.mp hrhoDisk
      rw [Complex.dist_eq] at hnorm
      simpa using habs.trans hnorm
    have hrhoim : |rho.im| ≤ T + 6 := by
      have htri := abs_add_le (rho.im - t) t
      rw [sub_add_cancel] at htri
      linarith
    have hrhore : rho.re ≤ 1 - W := by
      by_contra h
      exact hzeroFree q chi hchiNe (T + 6) (by linarith) rho hrhoim
        (lt_of_not_ge h) hrhoZero
    calc
      W / 2 ≤ sigma - rho.re := by
        change 1 - W / 2 ≤ sigma at hsigma
        linarith
      _ ≤ |sigma - rho.re| := le_abs_self _
      _ = |(s - rho).re| := by simp [s]
      _ ≤ ‖s - rho‖ := Complex.abs_re_le_norm _
  have hqpos : (0 : ℝ) < q := by exact_mod_cast (show 0 < q by omega)
  have hlogt0 : 0 ≤ Real.log ((q : ℝ) * (|t| + 2)) :=
    Real.log_nonneg (one_le_two.trans (two_le_level_height (q := q) t))
  have hlogtH : Real.log ((q : ℝ) * (|t| + 2)) ≤ H := by
    apply Real.log_le_log (zero_lt_two.trans_le (two_le_level_height (q := q) t))
    exact mul_le_mul_of_nonneg_left (by linarith : |t| + 2 ≤ T + 8) hqpos.le
  have hH : 0 ≤ H := hlogt0.trans hlogtH
  have hAfA : (Af : ℝ) ≤ A := by exact_mod_cast (le_max_left Af Ad)
  have hAdA : (Ad : ℝ) ≤ A := by exact_mod_cast (le_max_right Af Ad)
  have hA0 : (0 : ℝ) ≤ A := Nat.cast_nonneg A
  have hresidual : ‖logDeriv (DirichletCharacter.LFunction chi) s -
      ∑ᶠ rho : ℂ, (Z rho : ℂ) / (s - rho)‖ ≤ 16 * ((A : ℝ) * H) / 3 := by
    apply (hfixed q hq chi hchi t s hsdisk hsnonzero).trans
    exact div_le_div_of_nonneg_right
      (mul_le_mul_of_nonneg_left (mul_le_mul hAfA hlogtH hlogt0 hA0) (by norm_num))
      (by norm_num)
  have hZmass : ((∑ᶠ rho : ℂ, Z rho : ℤ) : ℝ) ≤ 2 * (A : ℝ) * H := by
    apply (hmass q hq chi hchi t).trans
    nlinarith [mul_le_mul hAdA hlogtH hlogt0 hA0]
  have hsum : ‖∑ᶠ rho : ℂ, (Z rho : ℂ) / (s - rho)‖ ≤
      4 * (A : ℝ) * H / W := by
    calc
      _ ≤ ((∑ᶠ rho : ℂ, Z rho : ℤ) : ℝ) / (W / 2) :=
        norm_finsum_intCast_div_sub_le Z hZfinite hZnonneg (by positivity) hZsep
      _ ≤ (2 * (A : ℝ) * H) / (W / 2) :=
        div_le_div_of_nonneg_right hZmass (by positivity)
      _ = _ := by ring
  refine ⟨hsnonzero, ?_⟩
  change ‖logDeriv (DirichletCharacter.LFunction chi) s‖ ≤ 10 * (A : ℝ) * H / W
  calc
    _ ≤ ‖logDeriv (DirichletCharacter.LFunction chi) s -
        ∑ᶠ rho : ℂ, (Z rho : ℂ) / (s - rho)‖ +
        ‖∑ᶠ rho : ℂ, (Z rho : ℂ) / (s - rho)‖ := norm_le_norm_sub_add _ _
    _ ≤ 16 * ((A : ℝ) * H) / 3 + 4 * (A : ℝ) * H / W :=
      add_le_add hresidual hsum
    _ = ((A : ℝ) * H / W) * (16 * W / 3 + 4) := by
      field_simp [hW.ne']
    _ ≤ ((A : ℝ) * H / W) * 10 :=
      mul_le_mul_of_nonneg_left (by linarith) (div_nonneg (mul_nonneg hA0 hH) hW.le)
    _ = _ := by ring

theorem exists_primitive_nearOne_reciprocal_bound {epsilon eta : ℝ}
    (hepsilon : 0 < epsilon) (heta : 0 < eta) :
    ∃ M : ℕ, 2 ≤ M ∧ ∃ c : ℝ, 0 < c ∧
      ∃ alpha : ℝ, 0 < alpha ∧ alpha ≤ 1 / 2 ∧
        ∀ (q : ℕ) [NeZero q], 1 < q →
          ∀ chi : DirichletCharacter ℂ q, chi.IsPrimitive →
            ∀ T : ℝ, 0 ≤ T → ∀ t sigma : ℝ, |t| ≤ T →
              1 - alpha * zeroFreeWidth M c epsilon q (T + 6) ≤ sigma →
                sigma ≤ 2 →
                  DirichletCharacter.LFunction chi ((sigma : ℂ) + t * I) ≠ 0 ∧
                  ‖(DirichletCharacter.LFunction chi
                      ((sigma : ℂ) + t * I))⁻¹‖ ≤
                    (3 / (alpha * zeroFreeWidth M c epsilon q (T + 6))) *
                      ((q : ℝ) * (T + 8)) ^ eta := by
  obtain ⟨M, hM, c, hc, A, hA, hlogBound⟩ :=
    exists_primitive_nearOne_logDeriv_bound hepsilon
  have hApos : (0 : ℝ) < A := by exact_mod_cast (show 0 < A by omega)
  let alpha : ℝ := min (1 / 2) (eta / (20 * (A : ℝ)))
  have halpha : 0 < alpha := lt_min (by norm_num) (div_pos heta (by positivity))
  have halphaHalf : alpha ≤ 1 / 2 := min_le_left _ _
  have halphaEta : 20 * (A : ℝ) * alpha ≤ eta := by
    have h := (le_div_iff₀ (show (0 : ℝ) < 20 * A by positivity)).mp
      (show alpha ≤ eta / (20 * (A : ℝ)) from min_le_right _ _)
    nlinarith
  refine ⟨M, hM, c, hc, alpha, halpha, halphaHalf, ?_⟩
  intro q _ hq chi hchi T hT t sigma ht hsigma hupper
  let W : ℝ := zeroFreeWidth M c epsilon q (T + 6)
  let H : ℝ := Real.log ((q : ℝ) * (T + 8))
  let sigma0 : ℝ := 1 + alpha * W
  let z0 : ℂ := (sigma0 : ℂ) + t * I
  let B : ℝ := 10 * (A : ℝ) * H / W
  have hW : 0 < W := zeroFreeWidth_pos hM hc (by linarith)
  have hWhalf : W ≤ 1 / 2 := min_le_left _ _
  have halphaW : 0 < alpha * W := mul_pos halpha hW
  have halphaWHalf : alpha * W ≤ W / 2 := by
    nlinarith [mul_le_mul_of_nonneg_right halphaHalf hW.le]
  have hsigmalo : 1 - W / 2 ≤ sigma := by
    change 1 - alpha * W ≤ sigma at hsigma
    linarith
  have hsigma0 : 1 < sigma0 := by dsimp [sigma0]; linarith
  have hsigma0Upper : sigma0 ≤ 2 := by dsimp [sigma0]; linarith
  have hqpos : (0 : ℝ) < q := by exact_mod_cast (show 0 < q by omega)
  have hbase : 1 ≤ (q : ℝ) * (T + 8) := by
    have hq1 : (1 : ℝ) ≤ q := by exact_mod_cast (show 1 ≤ q by omega)
    nlinarith
  have hH : 0 ≤ H := Real.log_nonneg hbase
  have hB : 0 ≤ B := div_nonneg (by positivity) hW.le
  have hexp : Real.exp (eta * H) = ((q : ℝ) * (T + 8)) ^ eta := by
    rw [Real.rpow_def_of_pos (zero_lt_one.trans_le hbase)]
    dsimp [H]
    rw [mul_comm]
  have hpow : 1 ≤ ((q : ℝ) * (T + 8)) ^ eta :=
    Real.one_le_rpow hbase heta.le
  have hnonzero := (hlogBound q hq chi hchi T hT t sigma ht hsigmalo hupper).1
  refine ⟨hnonzero, ?_⟩
  change ‖(DirichletCharacter.LFunction chi ((sigma : ℂ) + t * I))⁻¹‖ ≤
    (3 / (alpha * W)) * ((q : ℝ) * (T + 8)) ^ eta
  by_cases hsright : sigma0 ≤ sigma
  · have hsone : 1 < sigma := hsigma0.trans_le hsright
    have hstart := norm_inv_LFunction_le_three_div_sub chi
      (s := (sigma : ℂ) + t * I) (by simpa using hsone) (by simpa using hupper)
    simp only [Complex.add_re, Complex.ofReal_re, Complex.mul_re,
      Complex.ofReal_im, Complex.I_re, Complex.I_im, mul_zero, zero_mul,
      sub_zero, add_zero] at hstart
    calc
      _ ≤ 3 / (sigma - 1) := hstart
      _ ≤ 3 / (alpha * W) :=
        div_le_div_of_nonneg_left (by norm_num) halphaW (by dsimp [sigma0] at hsright; linarith)
      _ ≤ (3 / (alpha * W)) * ((q : ℝ) * (T + 8)) ^ eta := by
        simpa using mul_le_mul_of_nonneg_left hpow (by positivity : 0 ≤ 3 / (alpha * W))
  · have hL : 0 ≤ sigma0 - sigma := sub_nonneg.mpr (le_of_not_ge hsright)
    have hLupper : sigma0 - sigma ≤ 2 * alpha * W := by
      change 1 - alpha * W ≤ sigma at hsigma
      dsimp [sigma0]
      linarith
    have hpoint (u : ℝ) : z0 - (u : ℂ) = ((sigma0 - u : ℝ) : ℂ) + t * I := by
      dsimp [z0]
      push_cast
      ring
    have hsegment (u : ℝ) (hu : u ∈ Icc (0 : ℝ) (sigma0 - sigma)) :
        1 - W / 2 ≤ sigma0 - u ∧ sigma0 - u ≤ 2 := by
      constructor <;> linarith [hu.1, hu.2]
    have hchiNe : chi ≠ 1 := character_ne_one_of_isPrimitive hq chi hchi
    have hprop := norm_inv_horizontal_le_exp (f := DirichletCharacter.LFunction chi)
      (c := z0) (L := sigma0 - sigma) (B := B) hL
      (fun u _ => DirichletCharacter.differentiable_LFunction hchiNe _)
      (fun u hu => by
        rw [hpoint]
        exact (hlogBound q hq chi hchi T hT t (sigma0 - u) ht
          (hsegment u hu).1 (hsegment u hu).2).1)
      (fun u hu => by
        rw [hpoint]
        exact (hlogBound q hq chi hchi T hT t (sigma0 - u) ht
          (hsegment u hu).1 (hsegment u hu).2).2)
    have hend : z0 - ((sigma0 - sigma : ℝ) : ℂ) =
        (sigma : ℂ) + t * I := by rw [hpoint]; simp
    rw [hend] at hprop
    have hstart : ‖(DirichletCharacter.LFunction chi z0)⁻¹‖ ≤ 3 / (alpha * W) := by
      have h := norm_inv_LFunction_le_three_div_sub chi (s := z0)
        (by simpa [z0] using hsigma0) (by simpa [z0] using hsigma0Upper)
      simpa [z0, sigma0] using h
    have hBL : B * (sigma0 - sigma) ≤ eta * H := by
      calc
        _ ≤ B * (2 * alpha * W) := mul_le_mul_of_nonneg_left hLupper hB
        _ = (20 * (A : ℝ) * alpha) * H := by
          dsimp [B]
          field_simp [hW.ne']
          ring
        _ ≤ eta * H := mul_le_mul_of_nonneg_right halphaEta hH
    calc
      _ ≤ ‖(DirichletCharacter.LFunction chi z0)⁻¹‖ *
          Real.exp (B * (sigma0 - sigma)) := hprop
      _ ≤ (3 / (alpha * W)) * Real.exp (eta * H) :=
        mul_le_mul hstart (Real.exp_le_exp.mpr hBL) (Real.exp_pos _).le (by positivity)
      _ = _ := by rw [hexp]

theorem norm_inv_inducingEulerProduct_le_sq
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    {s : ℂ} (hs : (1 / 2 : ℝ) ≤ s.re) :
    ‖(inducingEulerProduct chi s)⁻¹‖ ≤ (q : ℝ) ^ 2 := by
  have hfactor (p : ℕ) (hp : p.Prime) :
      ‖(1 - chi.primitiveCharacter p * (p : ℂ) ^ (-s))⁻¹‖ ≤ (p : ℝ) ^ 2 := by
    have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast hp.two_le
    have hp1 : (1 : ℝ) ≤ p := by linarith
    have hroot : (4 / 3 : ℝ) ≤ Real.sqrt (p : ℝ) := by
      nlinarith [Real.sq_sqrt (Nat.cast_nonneg p), Real.sqrt_nonneg (p : ℝ)]
    have hpow : (4 / 3 : ℝ) ≤ (p : ℝ) ^ s.re := by
      calc
        _ ≤ Real.sqrt (p : ℝ) := hroot
        _ = (p : ℝ) ^ (1 / 2 : ℝ) := Real.sqrt_eq_rpow _
        _ ≤ _ := Real.rpow_le_rpow_of_exponent_le hp1 hs
    have hw : ‖chi.primitiveCharacter p * (p : ℂ) ^ (-s)‖ ≤ (3 / 4 : ℝ) := by
      rw [norm_mul, Complex.norm_natCast_cpow_of_pos hp.pos, neg_re,
        Real.rpow_neg (Nat.cast_nonneg p)]
      calc
        _ ≤ 1 * ((p : ℝ) ^ s.re)⁻¹ :=
          mul_le_mul_of_nonneg_right (chi.primitiveCharacter.norm_le_one p)
            (inv_nonneg.mpr (Real.rpow_nonneg (Nat.cast_nonneg p) _))
        _ ≤ (3 / 4 : ℝ) := by
          have h := one_div_le_one_div_of_le (by norm_num : (0 : ℝ) < 4 / 3) hpow
          norm_num [one_div] at h ⊢
          exact h
    have hden : (1 / 4 : ℝ) ≤
        ‖1 - chi.primitiveCharacter p * (p : ℂ) ^ (-s)‖ := by
      have hreverse := norm_sub_norm_le (1 : ℂ)
        (chi.primitiveCharacter p * (p : ℂ) ^ (-s))
      simp only [norm_one] at hreverse
      linarith
    calc
      _ ≤ (4 : ℝ) := by
        rw [norm_inv]
        have h := one_div_le_one_div_of_le (by norm_num : (0 : ℝ) < 1 / 4) hden
        norm_num [one_div] at h ⊢
        exact h
      _ ≤ _ := by nlinarith
  rw [inducingEulerProduct, ← Finset.prod_inv_distrib]
  calc
    _ ≤ ∏ p ∈ q.primeFactors,
        ‖(1 - chi.primitiveCharacter p * (p : ℂ) ^ (-s))⁻¹‖ :=
      Finset.norm_prod_le _ _
    _ ≤ ∏ p ∈ q.primeFactors, (p : ℝ) ^ 2 :=
      Finset.prod_le_prod (fun _ _ => norm_nonneg _)
        (fun p hp => hfactor p (Nat.prime_of_mem_primeFactors hp))
    _ = (∏ p ∈ q.primeFactors, (p : ℝ)) ^ 2 :=
      Finset.prod_pow q.primeFactors 2 (fun p : ℕ => (p : ℝ))
    _ = ((∏ p ∈ q.primeFactors, p : ℕ) : ℝ) ^ 2 := by
      push_cast
      rfl
    _ ≤ (q : ℝ) ^ 2 := by
      gcongr
      exact_mod_cast Nat.le_of_dvd (NeZero.pos q) (Nat.prod_primeFactors_dvd q)

theorem exists_nonprincipal_nearOne_reciprocal_bound {epsilon eta : ℝ}
    (hepsilon : 0 < epsilon) (heta : 0 < eta) :
    ∃ M : ℕ, 2 ≤ M ∧ ∃ c : ℝ, 0 < c ∧
      ∃ alpha : ℝ, 0 < alpha ∧ alpha ≤ 1 / 2 ∧
        ∀ (q : ℕ) [NeZero q] (chi : DirichletCharacter ℂ q), chi ≠ 1 →
          ∀ T : ℝ, 0 ≤ T → ∀ t sigma : ℝ, |t| ≤ T →
            1 - alpha * zeroFreeWidth M c epsilon q (T + 6) ≤ sigma →
              sigma ≤ 2 →
                DirichletCharacter.LFunction chi ((sigma : ℂ) + t * I) ≠ 0 ∧
                ‖(DirichletCharacter.LFunction chi
                    ((sigma : ℂ) + t * I))⁻¹‖ ≤
                  (q : ℝ) ^ 2 *
                    (3 / (alpha * zeroFreeWidth M c epsilon q (T + 6))) *
                    ((q : ℝ) * (T + 8)) ^ eta := by
  obtain ⟨M, hM, c, hc, alpha, halpha, halphaHalf, hprimitive⟩ :=
    exists_primitive_nearOne_reciprocal_bound hepsilon heta
  refine ⟨M, hM, c, hc, alpha, halpha, halphaHalf, ?_⟩
  intro q _ chi hchi T hT t sigma ht hsigma hupper
  let d : ℕ := chi.conductor
  have hdne : d ≠ 0 := chi.conductor_ne_zero
  let : NeZero d := ⟨hdne⟩
  have hd1 : 1 < d := by
    have hdnotone : d ≠ 1 := by
      intro h
      exact hchi (DirichletCharacter.eq_one_iff_conductor_eq_one.mpr h)
    omega
  have hdq : d ≤ q := Nat.le_of_dvd (NeZero.pos q) chi.conductor_dvd_level
  let Wq : ℝ := zeroFreeWidth M c epsilon q (T + 6)
  let Wd : ℝ := zeroFreeWidth M c epsilon d (T + 6)
  have hWq : 0 < Wq := zeroFreeWidth_pos hM hc (by linarith)
  have hWd : 0 < Wd := zeroFreeWidth_pos hM hc (by linarith)
  have hWqd : Wq ≤ Wd :=
    zeroFreeWidth_antitone_level hM hc.le hepsilon.le (by linarith) hdq
  have hsigmaD : 1 - alpha * Wd ≤ sigma := by
    have := mul_le_mul_of_nonneg_left hWqd halpha.le
    change 1 - alpha * Wq ≤ sigma at hsigma
    linarith
  have hsigmaHalf : (1 / 2 : ℝ) ≤ sigma := by
    have hWqhalf : Wq ≤ 1 / 2 := min_le_left _ _
    have hprod := mul_le_mul halphaHalf hWqhalf hWq.le (by norm_num : (0 : ℝ) ≤ 1 / 2)
    change 1 - alpha * Wq ≤ sigma at hsigma
    nlinarith
  have hprim := hprimitive d hd1 chi.primitiveCharacter
    chi.primitiveCharacter_isPrimitive T hT t sigma ht hsigmaD hupper
  let s : ℂ := (sigma : ℂ) + t * I
  have hEuler : inducingEulerProduct chi s ≠ 0 :=
    inducingEulerProduct_ne_zero_of_re_pos chi (by simp [s]; linarith)
  have hnonzero : DirichletCharacter.LFunction chi s ≠ 0 := by
    rw [LFunction_eq_inducingPrimitive_mul_inducingEulerProduct chi (.inl hchi)]
    exact mul_ne_zero hprim.1 hEuler
  refine ⟨hnonzero, ?_⟩
  change ‖(DirichletCharacter.LFunction chi s)⁻¹‖ ≤
    (q : ℝ) ^ 2 * (3 / (alpha * Wq)) * ((q : ℝ) * (T + 8)) ^ eta
  have hquot : 3 / (alpha * Wd) ≤ 3 / (alpha * Wq) :=
    div_le_div_of_nonneg_left (by norm_num) (mul_pos halpha hWq)
      (mul_le_mul_of_nonneg_left hWqd halpha.le)
  have hlevel : ((d : ℝ) * (T + 8)) ^ eta ≤
      ((q : ℝ) * (T + 8)) ^ eta := by
    apply Real.rpow_le_rpow (by positivity)
      (mul_le_mul_of_nonneg_right (by exact_mod_cast hdq) (by linarith)) heta.le
  have hboundPrim : ‖(DirichletCharacter.LFunction chi.primitiveCharacter s)⁻¹‖ ≤
      (3 / (alpha * Wq)) * ((q : ℝ) * (T + 8)) ^ eta := by
    apply hprim.2.trans
    exact mul_le_mul hquot hlevel (Real.rpow_nonneg (by positivity) _)
      (by positivity)
  rw [LFunction_eq_inducingPrimitive_mul_inducingEulerProduct chi (.inl hchi),
    mul_inv_rev, norm_mul]
  calc
    _ ≤ (q : ℝ) ^ 2 *
        ((3 / (alpha * Wq)) * ((q : ℝ) * (T + 8)) ^ eta) :=
      mul_le_mul (norm_inv_inducingEulerProduct_le_sq chi (by simpa [s] using hsigmaHalf))
        hboundPrim (norm_nonneg _) (sq_nonneg _)
    _ = _ := by ring

/--
The zeta zero-free strip width `min (1 / 2) (1 / (M ^ 2 * log (T + 2)))`, capped to keep the
left edge at real part at least one half.
-/
noncomputable def zetaZeroFreeWidth (M : ℕ) (T : ℝ) : ℝ :=
  min (1 / 2) (1 / ((M : ℝ) ^ 2 * Real.log (T + 2)))

theorem zetaZeroFreeWidth_pos {M : ℕ} {T : ℝ}
    (hM : 2 ≤ M) (hT : 0 ≤ T) : 0 < zetaZeroFreeWidth M T := by
  have hMpos : (0 : ℝ) < M := by exact_mod_cast (show 0 < M by omega)
  exact lt_min (by norm_num)
    (one_div_pos.mpr (mul_pos (sq_pos_of_pos hMpos) (Real.log_pos (by linarith))))

theorem zeroFreeWidth_le_zetaZeroFreeWidth {M Mz q : ℕ} [NeZero q]
    {c epsilon T : ℝ} (hMz : 2 ≤ Mz) (hMzM : Mz ≤ M) (hT : 0 ≤ T) :
    zeroFreeWidth M c epsilon q T ≤ zetaZeroFreeWidth Mz T := by
  have hMzpos : (0 : ℝ) < Mz := by exact_mod_cast (show 0 < Mz by omega)
  have hMzMR : (Mz : ℝ) ≤ M := by exact_mod_cast hMzM
  have hq1 : (1 : ℝ) ≤ q := by exact_mod_cast (show 1 ≤ q from NeZero.pos q)
  have hlogpos : 0 < Real.log (T + 2) := Real.log_pos (by linarith)
  have hlogle : Real.log (T + 2) ≤ Real.log ((q : ℝ) * (T + 2)) :=
    Real.log_le_log (by linarith) (by nlinarith)
  apply le_min (min_le_left _ _)
  apply ((min_le_right _ _).trans (min_le_left _ _)).trans
  exact one_div_le_one_div_of_le (mul_pos (sq_pos_of_pos hMzpos) hlogpos)
    (mul_le_mul ((sq_le_sq₀ hMzpos.le (Nat.cast_nonneg M)).mpr hMzMR)
      hlogle hlogpos.le (sq_nonneg _))

theorem exists_regularizedZeta_zeroFree_rectangle :
    ∃ M : ℕ, 2 ≤ M ∧ ∀ T : ℝ, 0 ≤ T → ∀ s : ℂ, |s.im| ≤ T →
      1 - zetaZeroFreeWidth M T < s.re → riemannZeta₁ s ≠ 0 := by
  obtain ⟨M, hM, hzero⟩ := exists_nat_riemannZeta_zero_re_lt
  refine ⟨M, hM, ?_⟩
  intro T hT s him hnear hregzero
  have hsone : s ≠ 1 := by
    intro h
    subst s
    simp at hregzero
  have hzetazero : riemannZeta s = 0 := by
    rw [riemannZeta_eq_inv_sub_mul hsone, hregzero, mul_zero]
  have hMpos : (0 : ℝ) < M := by exact_mod_cast (show 0 < M by omega)
  have hlogpos : 0 < Real.log (|s.im| + 2) := Real.log_pos (by linarith [abs_nonneg s.im])
  have hlogle : Real.log (|s.im| + 2) ≤ Real.log (T + 2) :=
    Real.log_le_log (by positivity) (by linarith)
  have hgap : 1 / ((M : ℝ) ^ 2 * Real.log (T + 2)) ≤
      1 / ((M : ℝ) ^ 2 * Real.log (|s.im| + 2)) :=
    one_div_le_one_div_of_le (mul_pos (sq_pos_of_pos hMpos) hlogpos)
      (mul_le_mul_of_nonneg_left hlogle (sq_nonneg _))
  have hwidth : zetaZeroFreeWidth M T ≤
      1 / ((M : ℝ) ^ 2 * Real.log (|s.im| + 2)) :=
    (min_le_right _ _).trans hgap
  linarith [hzero s hzetazero]

theorem exists_regularizedZeta_nearOne_logDeriv_bound :
    ∃ M : ℕ, 2 ≤ M ∧ ∃ A : ℕ, 37 ≤ A ∧
      ∀ T : ℝ, 0 ≤ T → ∀ t sigma : ℝ, |t| ≤ T →
        1 - zetaZeroFreeWidth M (T + 6) / 2 ≤ sigma → sigma ≤ 2 →
          riemannZeta₁ ((sigma : ℂ) + t * I) ≠ 0 ∧
          ‖logDeriv riemannZeta₁ ((sigma : ℂ) + t * I)‖ ≤
            10 * (A : ℝ) * Real.log (T + 8) / zetaZeroFreeWidth M (T + 6) := by
  obtain ⟨M, hM, hzeroFree⟩ := exists_regularizedZeta_zeroFree_rectangle
  obtain ⟨Af, hAf, hfixed⟩ :=
    exists_nat_norm_logDeriv_riemannZeta₁_sub_radiusSix_divisor_finsum_le
  obtain ⟨Ad, _hAd, hmass⟩ := exists_nat_finsum_divisor_riemannZeta₁_radiusSix_le
  let A : ℕ := max Af Ad
  refine ⟨M, hM, A, hAf.trans (le_max_left _ _), ?_⟩
  intro T hT t sigma ht hsigma hupper
  let W : ℝ := zetaZeroFreeWidth M (T + 6)
  let H : ℝ := Real.log (T + 8)
  let s : ℂ := (sigma : ℂ) + t * I
  let Z : ℂ → ℤ := MeromorphicOn.divisor riemannZeta₁
    (closedBall ((2 : ℂ) + t * I) 6)
  have hW : 0 < W := zetaZeroFreeWidth_pos hM (by linarith)
  have hWhalf : W ≤ 1 / 2 := min_le_left _ _
  have hsnonzero : riemannZeta₁ s ≠ 0 := by
    apply hzeroFree (T + 6) (by linarith) s
    · simpa [s] using (ht.trans (by linarith : T ≤ T + 6))
    · have hsnear : 1 - W < sigma := by
        change 1 - W / 2 ≤ sigma at hsigma
        linarith
      simpa [s] using hsnear
  have hsdisk : s ∈ closedBall ((2 : ℂ) + t * I) 3 := by
    rw [mem_closedBall, Complex.dist_eq]
    have hsub : s - ((2 : ℂ) + t * I) = ((sigma - 2 : ℝ) : ℂ) := by
      dsimp [s]
      push_cast
      ring
    rw [hsub, Complex.norm_real, Real.norm_eq_abs, abs_le]
    change 1 - W / 2 ≤ sigma at hsigma
    constructor <;> linarith
  have hZfinite : Z.support.Finite :=
    divisor_riemannZeta₁_closedBall_support_finite _ _
  have hZnonneg : 0 ≤ Z := divisor_riemannZeta₁_nonneg _
  have hZsep : ∀ rho ∈ Z.support, W / 2 ≤ ‖s - rho‖ := by
    intro rho hrho
    have hrhoDisk : rho ∈ closedBall ((2 : ℂ) + t * I) 6 :=
      (MeromorphicOn.divisor riemannZeta₁
        (closedBall ((2 : ℂ) + t * I) 6)).supportWithinDomain hrho
    have hrhoZero : riemannZeta₁ rho = 0 :=
      (mem_support_divisor_riemannZeta₁_iff hrhoDisk).mp hrho
    have himdiff : |rho.im - t| ≤ 6 := by
      have habs := Complex.abs_im_le_norm (rho - ((2 : ℂ) + t * I))
      have hnorm := mem_closedBall.mp hrhoDisk
      rw [Complex.dist_eq] at hnorm
      simpa using habs.trans hnorm
    have hrhoim : |rho.im| ≤ T + 6 := by
      have htri := abs_add_le (rho.im - t) t
      rw [sub_add_cancel] at htri
      linarith
    have hrhore : rho.re ≤ 1 - W := by
      by_contra h
      exact hzeroFree (T + 6) (by linarith) rho hrhoim (lt_of_not_ge h) hrhoZero
    calc
      W / 2 ≤ sigma - rho.re := by
        change 1 - W / 2 ≤ sigma at hsigma
        linarith
      _ ≤ |sigma - rho.re| := le_abs_self _
      _ = |(s - rho).re| := by simp [s]
      _ ≤ ‖s - rho‖ := Complex.abs_re_le_norm _
  have hlogt0 : 0 ≤ Real.log (|t| + 2) := Real.log_nonneg (by linarith [abs_nonneg t])
  have hlogtH : Real.log (|t| + 2) ≤ H :=
    Real.log_le_log (by positivity) (by linarith)
  have hH : 0 ≤ H := hlogt0.trans hlogtH
  have hAfA : (Af : ℝ) ≤ A := by exact_mod_cast (le_max_left Af Ad)
  have hAdA : (Ad : ℝ) ≤ A := by exact_mod_cast (le_max_right Af Ad)
  have hA0 : (0 : ℝ) ≤ A := Nat.cast_nonneg A
  have hresidual : ‖logDeriv riemannZeta₁ s -
      ∑ᶠ rho : ℂ, (Z rho : ℂ) / (s - rho)‖ ≤ 16 * ((A : ℝ) * H) / 3 := by
    apply (hfixed t s hsdisk hsnonzero).trans
    exact div_le_div_of_nonneg_right
      (mul_le_mul_of_nonneg_left (mul_le_mul hAfA hlogtH hlogt0 hA0) (by norm_num))
      (by norm_num)
  have hZmass : ((∑ᶠ rho : ℂ, Z rho : ℤ) : ℝ) ≤ 2 * (A : ℝ) * H := by
    apply (hmass t).trans
    nlinarith [mul_le_mul hAdA hlogtH hlogt0 hA0]
  have hsum : ‖∑ᶠ rho : ℂ, (Z rho : ℂ) / (s - rho)‖ ≤
      4 * (A : ℝ) * H / W := by
    calc
      _ ≤ ((∑ᶠ rho : ℂ, Z rho : ℤ) : ℝ) / (W / 2) :=
        norm_finsum_intCast_div_sub_le Z hZfinite hZnonneg (by positivity) hZsep
      _ ≤ (2 * (A : ℝ) * H) / (W / 2) :=
        div_le_div_of_nonneg_right hZmass (by positivity)
      _ = _ := by ring
  refine ⟨hsnonzero, ?_⟩
  change ‖logDeriv riemannZeta₁ s‖ ≤ 10 * (A : ℝ) * H / W
  calc
    _ ≤ ‖logDeriv riemannZeta₁ s - ∑ᶠ rho : ℂ, (Z rho : ℂ) / (s - rho)‖ +
        ‖∑ᶠ rho : ℂ, (Z rho : ℂ) / (s - rho)‖ := norm_le_norm_sub_add _ _
    _ ≤ 16 * ((A : ℝ) * H) / 3 + 4 * (A : ℝ) * H / W := add_le_add hresidual hsum
    _ = ((A : ℝ) * H / W) * (16 * W / 3 + 4) := by field_simp [hW.ne']
    _ ≤ ((A : ℝ) * H / W) * 10 :=
      mul_le_mul_of_nonneg_left (by linarith) (div_nonneg (mul_nonneg hA0 hH) hW.le)
    _ = _ := by ring

/--
The quotient `(s - 1) / riemannZeta₁ s`, representing reciprocal zeta with its removable value
zero at `s = 1`.
-/
noncomputable def regularizedReciprocalZeta (s : ℂ) : ℂ := (s - 1) / riemannZeta₁ s

theorem regularizedReciprocalZeta_eq_inv {s : ℂ} (hs : s ≠ 1) :
    regularizedReciprocalZeta s = (riemannZeta s)⁻¹ := by
  rw [regularizedReciprocalZeta, riemannZeta_eq_inv_sub_mul hs, mul_inv_rev, inv_inv]
  ring

theorem differentiableAt_regularizedReciprocalZeta {s : ℂ}
    (hs : riemannZeta₁ s ≠ 0) : DifferentiableAt ℂ regularizedReciprocalZeta s :=
  (differentiableAt_id.sub_const 1).div differentiable_riemannZeta₁.differentiableAt hs

theorem norm_regularizedReciprocalZeta_le_three_div_sub
    {s : ℂ} (hs : 1 < s.re) (hupper : s.re ≤ 2) :
    ‖regularizedReciprocalZeta s‖ ≤ 3 / (s.re - 1) := by
  have hsone : s ≠ 1 := by
    intro h
    subst s
    norm_num at hs
  rw [regularizedReciprocalZeta_eq_inv hsone]
  simpa only [DirichletCharacter.LFunction_modOne_eq] using
    norm_inv_LFunction_le_three_div_sub (1 : DirichletCharacter ℂ 1) hs hupper

theorem exists_regularizedZeta_nearOne_reciprocal_bound {eta : ℝ} (heta : 0 < eta) :
    ∃ M : ℕ, 2 ≤ M ∧ ∃ alpha : ℝ, 0 < alpha ∧ alpha ≤ 1 / 2 ∧
      ∀ T : ℝ, 0 ≤ T → ∀ t sigma : ℝ, |t| ≤ T →
        1 - alpha * zetaZeroFreeWidth M (T + 6) ≤ sigma → sigma ≤ 2 →
          riemannZeta₁ ((sigma : ℂ) + t * I) ≠ 0 ∧
          ‖regularizedReciprocalZeta ((sigma : ℂ) + t * I)‖ ≤
            (3 / (alpha * zetaZeroFreeWidth M (T + 6))) * (T + 8) ^ eta := by
  obtain ⟨M, hM, A, hA, hlogBound⟩ := exists_regularizedZeta_nearOne_logDeriv_bound
  have hApos : (0 : ℝ) < A := by exact_mod_cast (show 0 < A by omega)
  let alpha : ℝ := min (1 / 2) (eta / (20 * (A : ℝ)))
  have halpha : 0 < alpha := lt_min (by norm_num) (div_pos heta (by positivity))
  have halphaHalf : alpha ≤ 1 / 2 := min_le_left _ _
  have halphaEta : 20 * (A : ℝ) * alpha ≤ eta := by
    have h := (le_div_iff₀ (show (0 : ℝ) < 20 * A by positivity)).mp
      (show alpha ≤ eta / (20 * (A : ℝ)) from min_le_right _ _)
    nlinarith
  refine ⟨M, hM, alpha, halpha, halphaHalf, ?_⟩
  intro T hT t sigma ht hsigma hupper
  let W : ℝ := zetaZeroFreeWidth M (T + 6)
  let H : ℝ := Real.log (T + 8)
  let sigma0 : ℝ := 1 + alpha * W
  let z0 : ℂ := (sigma0 : ℂ) + t * I
  let B : ℝ := 10 * (A : ℝ) * H / W
  have hW : 0 < W := zetaZeroFreeWidth_pos hM (by linarith)
  have hWhalf : W ≤ 1 / 2 := min_le_left _ _
  have halphaW : 0 < alpha * W := mul_pos halpha hW
  have halphaWHalf : alpha * W ≤ W / 2 := by
    nlinarith [mul_le_mul_of_nonneg_right halphaHalf hW.le]
  have hsigmalo : 1 - W / 2 ≤ sigma := by
    change 1 - alpha * W ≤ sigma at hsigma
    linarith
  have hsigma0 : 1 < sigma0 := by dsimp [sigma0]; linarith
  have hsigma0Upper : sigma0 ≤ 2 := by dsimp [sigma0]; linarith
  have hbase : 1 ≤ T + 8 := by linarith
  have hH : 0 ≤ H := Real.log_nonneg hbase
  have hB : 0 ≤ B := div_nonneg (by positivity) hW.le
  have hexp : Real.exp (eta * H) = (T + 8) ^ eta := by
    rw [Real.rpow_def_of_pos (zero_lt_one.trans_le hbase)]
    dsimp [H]
    rw [mul_comm]
  have hpow : 1 ≤ (T + 8) ^ eta := Real.one_le_rpow hbase heta.le
  refine ⟨(hlogBound T hT t sigma ht hsigmalo hupper).1, ?_⟩
  change ‖regularizedReciprocalZeta ((sigma : ℂ) + t * I)‖ ≤
    (3 / (alpha * W)) * (T + 8) ^ eta
  by_cases hsright : sigma0 ≤ sigma
  · have hsone : 1 < sigma := hsigma0.trans_le hsright
    have hstart := norm_regularizedReciprocalZeta_le_three_div_sub
      (s := (sigma : ℂ) + t * I) (by simpa using hsone) (by simpa using hupper)
    simp only [Complex.add_re, Complex.ofReal_re, Complex.mul_re,
      Complex.ofReal_im, Complex.I_re, Complex.I_im, mul_zero, zero_mul,
      sub_zero, add_zero] at hstart
    calc
      _ ≤ 3 / (sigma - 1) := hstart
      _ ≤ 3 / (alpha * W) :=
        div_le_div_of_nonneg_left (by norm_num) halphaW (by dsimp [sigma0] at hsright; linarith)
      _ ≤ (3 / (alpha * W)) * (T + 8) ^ eta := by
        simpa using mul_le_mul_of_nonneg_left hpow (by positivity : 0 ≤ 3 / (alpha * W))
  · have hL : 0 ≤ sigma0 - sigma := sub_nonneg.mpr (le_of_not_ge hsright)
    have hLupper : sigma0 - sigma ≤ 2 * alpha * W := by
      change 1 - alpha * W ≤ sigma at hsigma
      dsimp [sigma0]
      linarith
    have hpoint (u : ℝ) : z0 - (u : ℂ) = ((sigma0 - u : ℝ) : ℂ) + t * I := by
      dsimp [z0]
      push_cast
      ring
    have hsegment (u : ℝ) (hu : u ∈ Icc (0 : ℝ) (sigma0 - sigma)) :
        1 - W / 2 ≤ sigma0 - u ∧ sigma0 - u ≤ 2 := by
      constructor <;> linarith [hu.1, hu.2]
    have hprop := norm_inv_horizontal_le_exp (f := riemannZeta₁)
      (c := z0) (L := sigma0 - sigma) (B := B) hL
      (fun _ _ => differentiable_riemannZeta₁.differentiableAt)
      (fun u hu => by
        rw [hpoint]
        exact (hlogBound T hT t (sigma0 - u) ht
          (hsegment u hu).1 (hsegment u hu).2).1)
      (fun u hu => by
        rw [hpoint]
        exact (hlogBound T hT t (sigma0 - u) ht
          (hsegment u hu).1 (hsegment u hu).2).2)
    have hend : z0 - ((sigma0 - sigma : ℝ) : ℂ) =
        (sigma : ℂ) + t * I := by rw [hpoint]; simp
    rw [hend] at hprop
    have hnormSquare (r : ℝ) :
        ‖((r : ℂ) + t * I) - 1‖ ^ 2 = (r - 1) ^ 2 + t ^ 2 := by
      simp only [Complex.sq_norm, Complex.normSq_apply, Complex.sub_re,
        Complex.add_re, Complex.ofReal_re, Complex.mul_re, Complex.ofReal_im,
        Complex.I_re, Complex.I_im, Complex.one_re, Complex.sub_im,
        Complex.add_im, Complex.mul_im, Complex.one_im]
      ring
    have hrealSquare : (sigma - 1) ^ 2 ≤ (alpha * W) ^ 2 := by
      apply sq_le_sq.mpr
      rw [abs_of_pos halphaW, abs_le]
      change 1 - alpha * W ≤ sigma at hsigma
      dsimp [sigma0] at hsright
      constructor <;> linarith
    have hnumerator : ‖((sigma : ℂ) + t * I) - 1‖ ≤ ‖z0 - 1‖ := by
      apply (sq_le_sq₀ (norm_nonneg _) (norm_nonneg _)).mp
      change ‖((sigma : ℂ) + t * I) - 1‖ ^ 2 ≤
        ‖((sigma0 : ℂ) + t * I) - 1‖ ^ 2
      rw [hnormSquare, hnormSquare]
      dsimp [sigma0]
      nlinarith
    have hstart : ‖regularizedReciprocalZeta z0‖ ≤ 3 / (alpha * W) := by
      have h := norm_regularizedReciprocalZeta_le_three_div_sub (s := z0)
        (by simpa [z0] using hsigma0) (by simpa [z0] using hsigma0Upper)
      simpa [z0, sigma0] using h
    have hBL : B * (sigma0 - sigma) ≤ eta * H := by
      calc
        _ ≤ B * (2 * alpha * W) := mul_le_mul_of_nonneg_left hLupper hB
        _ = (20 * (A : ℝ) * alpha) * H := by
          dsimp [B]
          field_simp [hW.ne']
          ring
        _ ≤ eta * H := mul_le_mul_of_nonneg_right halphaEta hH
    calc
      _ = ‖((sigma : ℂ) + t * I) - 1‖ *
          ‖(riemannZeta₁ ((sigma : ℂ) + t * I))⁻¹‖ := by
        simp only [regularizedReciprocalZeta, div_eq_mul_inv, norm_mul]
      _ ≤ ‖((sigma : ℂ) + t * I) - 1‖ *
          (‖(riemannZeta₁ z0)⁻¹‖ * Real.exp (B * (sigma0 - sigma))) :=
        mul_le_mul_of_nonneg_left hprop (norm_nonneg _)
      _ ≤ ‖z0 - 1‖ *
          (‖(riemannZeta₁ z0)⁻¹‖ * Real.exp (B * (sigma0 - sigma))) :=
        mul_le_mul_of_nonneg_right hnumerator (by positivity)
      _ = ‖regularizedReciprocalZeta z0‖ * Real.exp (B * (sigma0 - sigma)) := by
        simp only [regularizedReciprocalZeta, div_eq_mul_inv, norm_mul]
        ring
      _ ≤ (3 / (alpha * W)) * Real.exp (eta * H) :=
        mul_le_mul hstart (Real.exp_le_exp.mpr hBL) (Real.exp_pos _).le (by positivity)
      _ = _ := by rw [hexp]

theorem inducingEulerProduct_one_eq (q : ℕ) [NeZero q] (s : ℂ) :
    inducingEulerProduct (1 : DirichletCharacter ℂ q) s =
      ∏ p ∈ q.primeFactors, (1 - (p : ℂ) ^ (-s)) := by
  unfold inducingEulerProduct
  apply Finset.prod_congr rfl
  intro p hp
  have : Subsingleton (ZMod (1 : DirichletCharacter ℂ q).conductor) := by
    rw [DirichletCharacter.conductor_one]
    infer_instance
  simp only [DirichletCharacter.primitiveCharacter_one]
  rw [MulChar.one_apply (isUnit_of_subsingleton _), one_mul]

/--
A reciprocal L-function expression suitable for continuation through the principal pole. For the
principal character it uses regularized reciprocal zeta divided by the inducing Euler product;
otherwise it is the ordinary reciprocal L-function.
-/
noncomputable def analyticReciprocalL {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (s : ℂ) : ℂ := by
  classical
  exact if chi = 1 then regularizedReciprocalZeta s / inducingEulerProduct chi s
    else (DirichletCharacter.LFunction chi s)⁻¹

theorem analyticReciprocalL_eq_inv_of_ne_one {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) {s : ℂ} (hs : s ≠ 1) :
    analyticReciprocalL chi s = (DirichletCharacter.LFunction chi s)⁻¹ := by
  classical
  by_cases hchi : chi = 1
  · subst chi
    rw [analyticReciprocalL, ite_eq_left rfl, regularizedReciprocalZeta_eq_inv hs]
    have hfactor : DirichletCharacter.LFunction (1 : DirichletCharacter ℂ q) s =
        inducingEulerProduct (1 : DirichletCharacter ℂ q) s * riemannZeta s := by
      rw [inducingEulerProduct_one_eq]
      exact DirichletCharacter.LFunctionTrivChar_eq_mul_riemannZeta hs
    rw [hfactor, mul_inv_rev]
    ring
  · simp only [analyticReciprocalL, ite_eq_right hchi]

theorem analyticReciprocalL_eq_moebiusSeries {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) {s : ℂ} (hs : 1 < s.re) :
    analyticReciprocalL chi s =
      LSeries (fun n => chi n * (ArithmeticFunction.moebius n : ℂ)) s := by
  have hsone : s ≠ 1 := by intro h; subst s; norm_num at hs
  rw [analyticReciprocalL_eq_inv_of_ne_one chi hsone,
    moebiusCharacterSeries_eq_inv chi hs]

theorem differentiableAt_analyticReciprocalL {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) {s : ℂ} (hsre : 0 < s.re)
    (hprincipal : chi = 1 → riemannZeta₁ s ≠ 0)
    (hnonprincipal : chi ≠ 1 → DirichletCharacter.LFunction chi s ≠ 0) :
    DifferentiableAt ℂ (analyticReciprocalL chi) s := by
  classical
  by_cases hchi : chi = 1
  · have hfun : analyticReciprocalL chi =
        fun z => regularizedReciprocalZeta z / inducingEulerProduct chi z := by
      funext z
      simp only [analyticReciprocalL, ite_eq_left hchi]
    rw [hfun]
    exact (differentiableAt_regularizedReciprocalZeta (hprincipal hchi)).div
      (differentiable_inducingEulerProduct chi s)
      (inducingEulerProduct_ne_zero_of_re_pos chi hsre)
  · have hfun : analyticReciprocalL chi =
        fun z => (DirichletCharacter.LFunction chi z)⁻¹ := by
      funext z
      simp only [analyticReciprocalL, ite_eq_right hchi]
    rw [hfun]
    exact (DirichletCharacter.differentiable_LFunction hchi s).inv (hnonprincipal hchi)

theorem exists_analyticReciprocalL_nearOne_bound {epsilon eta : ℝ}
    (hepsilon : 0 < epsilon) (heta : 0 < eta) :
    ∃ M : ℕ, 2 ≤ M ∧ ∃ c : ℝ, 0 < c ∧
      ∃ alpha : ℝ, 0 < alpha ∧ alpha ≤ 1 / 2 ∧
        ∀ (q : ℕ) [NeZero q] (chi : DirichletCharacter ℂ q),
          ∀ T : ℝ, 0 ≤ T → ∀ t sigma : ℝ, |t| ≤ T →
            1 - alpha * zeroFreeWidth M c epsilon q (T + 6) ≤ sigma →
              sigma ≤ 2 →
                DifferentiableAt ℂ (analyticReciprocalL chi) ((sigma : ℂ) + t * I) ∧
                ‖analyticReciprocalL chi ((sigma : ℂ) + t * I)‖ ≤
                  (q : ℝ) ^ 2 *
                    (3 / (alpha * zeroFreeWidth M c epsilon q (T + 6))) *
                    ((q : ℝ) * (T + 8)) ^ eta := by
  obtain ⟨Mn, hMn, c, hc, an, han, hanHalf, hn⟩ :=
    exists_nonprincipal_nearOne_reciprocal_bound hepsilon heta
  obtain ⟨Mz, hMz, az, haz, hazHalf, hz⟩ :=
    exists_regularizedZeta_nearOne_reciprocal_bound heta
  let M : ℕ := max Mn Mz
  let alpha : ℝ := min an az
  have hM : 2 ≤ M := hMn.trans (le_max_left _ _)
  have halpha : 0 < alpha := lt_min han haz
  have halphaN : alpha ≤ an := min_le_left _ _
  have halphaZ : alpha ≤ az := min_le_right _ _
  have halphaHalf : alpha ≤ 1 / 2 := halphaN.trans hanHalf
  refine ⟨M, hM, c, hc, alpha, halpha, halphaHalf, ?_⟩
  intro q _ chi T hT t sigma ht hsigma hupper
  let W : ℝ := zeroFreeWidth M c epsilon q (T + 6)
  let Wn : ℝ := zeroFreeWidth Mn c epsilon q (T + 6)
  let Wz : ℝ := zetaZeroFreeWidth Mz (T + 6)
  let s : ℂ := (sigma : ℂ) + t * I
  have hW : 0 < W := zeroFreeWidth_pos hM hc (by linarith)
  have hWn : 0 < Wn := zeroFreeWidth_pos hMn hc (by linarith)
  have hWz : 0 < Wz := zetaZeroFreeWidth_pos hMz (by linarith)
  have hWWn : W ≤ Wn := zeroFreeWidth_mono_constants hMn
    (le_max_left _ _) le_rfl (by linarith)
  have hWWz : W ≤ Wz := zeroFreeWidth_le_zetaZeroFreeWidth hMz
    (le_max_right _ _) (by linarith)
  have hprodN : alpha * W ≤ an * Wn :=
    mul_le_mul halphaN hWWn hW.le han.le
  have hprodZ : alpha * W ≤ az * Wz :=
    mul_le_mul halphaZ hWWz hW.le haz.le
  have hsigmaN : 1 - an * Wn ≤ sigma := by
    change 1 - alpha * W ≤ sigma at hsigma
    linarith
  have hsigmaZ : 1 - az * Wz ≤ sigma := by
    change 1 - alpha * W ≤ sigma at hsigma
    linarith
  have hsigmaHalf : (1 / 2 : ℝ) ≤ sigma := by
    have hWhalf : W ≤ 1 / 2 := min_le_left _ _
    have hprod := mul_le_mul halphaHalf hWhalf hW.le (by norm_num : (0 : ℝ) ≤ 1 / 2)
    change 1 - alpha * W ≤ sigma at hsigma
    nlinarith
  have hsre : 0 < s.re := by simp [s]; linarith
  have hquotN : 3 / (an * Wn) ≤ 3 / (alpha * W) :=
    div_le_div_of_nonneg_left (by norm_num) (mul_pos halpha hW) hprodN
  have hquotZ : 3 / (az * Wz) ≤ 3 / (alpha * W) :=
    div_le_div_of_nonneg_left (by norm_num) (mul_pos halpha hW) hprodZ
  have hq1 : (1 : ℝ) ≤ q := by exact_mod_cast (show 1 ≤ q from NeZero.pos q)
  have hpower : (T + 8) ^ eta ≤ ((q : ℝ) * (T + 8)) ^ eta :=
    Real.rpow_le_rpow (by linarith) (by nlinarith) heta.le
  have hzeta := hz T hT t sigma ht hsigmaZ hupper
  have hdiff : DifferentiableAt ℂ (analyticReciprocalL chi) s :=
    differentiableAt_analyticReciprocalL chi hsre (fun _ => hzeta.1)
      (fun hchi => (hn q chi hchi T hT t sigma ht hsigmaN hupper).1)
  refine ⟨hdiff, ?_⟩
  change ‖analyticReciprocalL chi s‖ ≤
    (q : ℝ) ^ 2 * (3 / (alpha * W)) * ((q : ℝ) * (T + 8)) ^ eta
  classical
  by_cases hchi : chi = 1
  · have hreg : ‖regularizedReciprocalZeta s‖ ≤
        (3 / (alpha * W)) * ((q : ℝ) * (T + 8)) ^ eta := by
      apply hzeta.2.trans
      exact mul_le_mul hquotZ hpower (Real.rpow_nonneg (by linarith) _) (by positivity)
    rw [analyticReciprocalL, ite_eq_left hchi, div_eq_mul_inv, norm_mul]
    calc
      _ ≤ ((3 / (alpha * W)) * ((q : ℝ) * (T + 8)) ^ eta) * (q : ℝ) ^ 2 :=
        mul_le_mul hreg (norm_inv_inducingEulerProduct_le_sq chi (by simpa [s] using hsigmaHalf))
          (norm_nonneg _) (by positivity)
      _ = _ := by ring
  · rw [analyticReciprocalL, ite_eq_right hchi]
    apply (hn q chi hchi T hT t sigma ht hsigmaN hupper).2.trans
    exact mul_le_mul_of_nonneg_right
      (mul_le_mul_of_nonneg_left hquotN (sq_nonneg _))
      (Real.rpow_nonneg (by positivity) _)

theorem dirichletPerronNearMass_of_bounded_le (a : ℕ → ℂ)
    (ha : ∀ n, ‖a n‖ ≤ 1) {x : ℕ} {U : ℝ} (hU : 0 < U) :
    dirichletPerronNearMass a x U ≤
      4 * (x : ℝ) * (1 + Real.log x) / U := by
  let reciprocalDistance : ℕ → ℝ := fun n =>
    if 0 < n ∧ (n : ℝ) < 2 * x ∧ n ≠ x then |(x : ℝ) - n|⁻¹ else 0
  let K : ℝ := 2 * (x : ℝ) / U
  have hK : 0 ≤ K := by dsimp [K]; positivity
  have hpoint (n : ℕ) : ‖a n‖ * dirichletPerronNearError x U n ≤
      K * reciprocalDistance n := by
    rw [dirichletPerronNearError]
    split_ifs with hn
    · have habs : 0 < |(x : ℝ) - n| := by
        apply abs_pos.mpr
        exact sub_ne_zero.mpr (by exact_mod_cast hn.2.2.2.symm)
      have hnearNonneg : 0 ≤ min 1 (2 * (x : ℝ) / (U * |(x : ℝ) - n|)) :=
        le_min (by norm_num) (by positivity)
      have hr : reciprocalDistance n = |(x : ℝ) - n|⁻¹ :=
        ite_eq_left ⟨hn.1, hn.2.2.1, hn.2.2.2⟩
      rw [hr]
      calc
        _ ≤ 1 * min 1 (2 * (x : ℝ) / (U * |(x : ℝ) - n|)) :=
          mul_le_mul_of_nonneg_right (ha n) hnearNonneg
        _ ≤ 2 * (x : ℝ) / (U * |(x : ℝ) - n|) := by
          rw [one_mul]
          exact min_le_right _ _
        _ = _ := by dsimp [K]; ring
    · simp only [mul_zero]
      exact mul_nonneg hK (by
        dsimp [reciprocalDistance]
        split_ifs <;> positivity)
  change (∑' n : ℕ, ‖a n‖ * dirichletPerronNearError x U n) ≤ _
  calc
    _ ≤ ∑' n : ℕ, K * reciprocalDistance n :=
      (summable_perron_nearMass a x U).tsum_le_tsum hpoint
        ((summable_inv_abs_sub_ne x).mul_left K)
    _ = K * ∑' n : ℕ, reciprocalDistance n := tsum_mul_left
    _ ≤ K * (2 * (harmonic x : ℝ)) :=
      mul_le_mul_of_nonneg_left (tsum_inv_abs_sub_ne_le x) hK
    _ ≤ K * (2 * (1 + Real.log x)) :=
      mul_le_mul_of_nonneg_left (by linarith [harmonic_le_one_add_log x]) hK
    _ = _ := by dsimp [K]; ring

theorem dirichletPerronCoefficientMass_of_bounded_le (a : ℕ → ℂ)
    (ha : ∀ n, ‖a n‖ ≤ 1) {sigma : ℝ} (hsigma : 1 < sigma)
    (hupper : sigma ≤ 2) :
    dirichletPerronCoefficientMass a sigma ≤ 3 / (sigma - 1) :=
  (tsum_norm_term_of_bounded_le_zeta a ha (by simpa using hsigma)).trans
    (norm_riemannZeta_real_le_three_div_sub hsigma hupper)

theorem norm_sum_Icc_sub_perronIntegral_le_of_bounded (a : ℕ → ℂ)
    (ha : ∀ n, ‖a n‖ ≤ 1) {x : ℕ} {sigma U : ℝ}
    (hx : 0 < x) (hsigma : 1 < sigma) (hupper : sigma ≤ 2) (hU : 0 < U) :
    ‖(∑ n ∈ Finset.Icc 1 x, a n) - dirichletPerronIntegral a x sigma U‖ ≤
      1 / 2 + 4 * (x : ℝ) * (1 + Real.log x) / U +
        96 * (x : ℝ) ^ sigma / (U * (sigma - 1)) := by
  have hsum : LSeriesSummable a (sigma : ℂ) :=
    LSeriesSummable_of_bounded_of_one_lt_re (fun n _ => ha n) (by simpa using hsigma)
  have hperron := norm_dirichletPerronStarredSum_sub_integral_le hsum hx
    (zero_lt_one.trans hsigma) hupper hU
  have hprefix : (∑ n ∈ Finset.Icc 1 x, a n) =
      dirichletPerronStarredSum a x + (1 / 2 : ℂ) * a x := by
    rw [dirichletPerronStarredSum, ← Finset.Ico_add_one_right_eq_Icc,
      Finset.sum_Ico_succ_top (Nat.one_le_iff_ne_zero.mpr hx.ne')]
    ring
  have hendpoint : ‖(1 / 2 : ℂ) * a x‖ ≤ (1 / 2 : ℝ) := by
    rw [norm_mul]
    norm_num
    linarith [ha x]
  rw [hprefix]
  calc
    _ ≤ ‖dirichletPerronStarredSum a x - dirichletPerronIntegral a x sigma U‖ +
        ‖(1 / 2 : ℂ) * a x‖ := by
      rw [show dirichletPerronStarredSum a x + (1 / 2 : ℂ) * a x -
          dirichletPerronIntegral a x sigma U =
          (dirichletPerronStarredSum a x - dirichletPerronIntegral a x sigma U) +
            (1 / 2 : ℂ) * a x by ring]
      exact norm_add_le _ _
    _ ≤ (dirichletPerronNearMass a x U +
        (32 * (x : ℝ) ^ sigma / U) * dirichletPerronCoefficientMass a sigma) + 1 / 2 :=
      add_le_add hperron hendpoint
    _ ≤ (4 * (x : ℝ) * (1 + Real.log x) / U +
        (32 * (x : ℝ) ^ sigma / U) * (3 / (sigma - 1))) + 1 / 2 := by
      have hnear := dirichletPerronNearMass_of_bounded_le a ha (x := x) hU
      have hmass := mul_le_mul_of_nonneg_left
        (dirichletPerronCoefficientMass_of_bounded_le a ha hsigma hupper)
        (by positivity : 0 ≤ 32 * (x : ℝ) ^ sigma / U)
      linarith
    _ = _ := by simp only [div_eq_mul_inv, mul_inv_rev]; ring

/--
The Perron integrand `F s * x ^ s / s` for an analytic factor `F`, using complex exponentiation
of the real base.
-/
noncomputable def perronIntegrand (F : ℂ → ℂ) (x : ℝ) (s : ℂ) : ℂ := F s * (x : ℂ) ^ s / s

/--
The truncated Perron integral for `F` on `re = sigma`, parameterized from imaginary part `-U` to
`U` and normalized by `1 / (2 * pi)`.
-/
noncomputable def analyticPerronIntegral (F : ℂ → ℂ) (x sigma U : ℝ) : ℂ :=
  (((2 * Real.pi : ℝ) : ℂ)⁻¹) *
    ∫ t in -U..U, perronIntegrand F x ((sigma : ℂ) + t * I)

theorem moebius_perronIntegral_eq_analytic {q : ℕ} [NeZero q]
    (chi : DirichletCharacter ℂ q) (x : ℕ) {sigma : ℝ} (hsigma : 1 < sigma) (U : ℝ) :
    dirichletPerronIntegral
        (fun n => chi n * (ArithmeticFunction.moebius n : ℂ)) x sigma U =
      analyticPerronIntegral (analyticReciprocalL chi) x sigma U := by
  unfold dirichletPerronIntegral analyticPerronIntegral perronIntegrand
  congr 1
  apply intervalIntegral.integral_congr
  intro t ht
  dsimp only
  rw [analyticReciprocalL_eq_moebiusSeries chi (by simpa using hsigma)]

theorem norm_moebiusCharacterSum_sub_analyticPerronIntegral_le
    {q : ℕ} [NeZero q] (chi : DirichletCharacter ℂ q)
    {x : ℕ} {sigma U : ℝ} (hx : 0 < x) (hsigma : 1 < sigma)
    (hupper : sigma ≤ 2) (hU : 0 < U) :
    ‖(∑ n ∈ Finset.Icc 1 x, chi n * (ArithmeticFunction.moebius n : ℂ)) -
      analyticPerronIntegral (analyticReciprocalL chi) x sigma U‖ ≤
      1 / 2 + 4 * (x : ℝ) * (1 + Real.log x) / U +
        96 * (x : ℝ) ^ sigma / (U * (sigma - 1)) := by
  rw [← moebius_perronIntegral_eq_analytic chi x hsigma U]
  exact norm_sum_Icc_sub_perronIntegral_le_of_bounded _
    (norm_character_mul_moebius_le_one chi) hx hsigma hupper hU

theorem norm_perronIntegrand_le {F : ℂ → ℂ} {x K r delta : ℝ} {s : ℂ}
    (hx : 1 ≤ x) (hK : 0 ≤ K) (hF : ‖F s‖ ≤ K) (hr : s.re ≤ r)
    (hdelta : 0 < delta) (hden : delta ≤ ‖s‖) :
    ‖perronIntegrand F x s‖ ≤ K * x ^ r / delta := by
  have hxpos : 0 < x := zero_lt_one.trans_le hx
  have hpower : x ^ s.re ≤ x ^ r := Real.rpow_le_rpow_of_exponent_le hx hr
  rw [perronIntegrand, norm_div, norm_mul, Complex.norm_cpow_eq_rpow_re_of_pos hxpos]
  calc
    _ ≤ K * x ^ r / ‖s‖ :=
      div_le_div_of_nonneg_right
        (mul_le_mul hF hpower (Real.rpow_nonneg hxpos.le _) hK) (norm_nonneg _)
    _ ≤ _ := div_le_div_of_nonneg_left (by positivity) hdelta hden

theorem norm_analyticPerronIntegral_le_of_rectangle
    {F : ℂ → ℂ} {x beta sigma T K : ℝ}
    (hx : 1 ≤ x) (hbeta : 0 < beta) (hbetasigma : beta ≤ sigma)
    (hT : 0 < T) (hK : 0 ≤ K)
    (hdiff : ∀ s : ℂ, beta ≤ s.re → s.re ≤ sigma → |s.im| ≤ T →
      DifferentiableAt ℂ F s)
    (hbound : ∀ s : ℂ, beta ≤ s.re → s.re ≤ sigma → |s.im| ≤ T → ‖F s‖ ≤ K) :
    ‖analyticPerronIntegral F x sigma T‖ ≤
      2 * T * K * x ^ beta / beta +
        2 * (sigma - beta) * K * x ^ sigma / T := by
  let G : ℂ → ℂ := perronIntegrand F x
  let z : ℂ := (beta : ℂ) - T * I
  let w : ℂ := (sigma : ℂ) + T * I
  let lowerInt : ℂ := ∫ r in beta..sigma, G ((r : ℂ) - T * I)
  let upperInt : ℂ := ∫ r in beta..sigma, G ((r : ℂ) + T * I)
  let rightInt : ℂ := ∫ t in -T..T, G ((sigma : ℂ) + t * I)
  let leftInt : ℂ := ∫ t in -T..T, G ((beta : ℂ) + t * I)
  have hTorder : -T ≤ T := by linarith
  have hxC : (x : ℂ) ≠ 0 := Complex.ofReal_ne_zero.mpr (zero_lt_one.trans_le hx).ne'
  have hrect (s : ℂ) (hs : s ∈ [[z.re, w.re]] ×ℂ [[z.im, w.im]]) :
      beta ≤ s.re ∧ s.re ≤ sigma ∧ |s.im| ≤ T := by
    have hs' : s.re ∈ Icc beta sigma ∧ s.im ∈ Icc (-T) T := by
      simpa [z, w, Complex.mem_reProdIm, uIcc_of_le hbetasigma,
        uIcc_of_le hTorder] using hs
    exact ⟨hs'.1.1, hs'.1.2, abs_le.mpr hs'.2⟩
  have hGdiff : DifferentiableOn ℂ G ([[z.re, w.re]] ×ℂ [[z.im, w.im]]) := by
    intro s hs
    obtain ⟨hslo, hshi, hsim⟩ := hrect s hs
    have hsne : s ≠ 0 := by
      intro h
      subst s
      simp only [Complex.zero_re] at hslo
      linarith
    exact (((hdiff s hslo hshi hsim).mul
      (differentiableAt_id.const_cpow (.inl hxC))).div
        differentiableAt_id hsne).differentiableWithinAt
  have hboundary : lowerInt - upperInt + I * rightInt - I * leftInt = 0 := by
    have h := Complex.integral_boundary_rect_eq_zero_of_differentiableOn G z w hGdiff
    simpa [lowerInt, upperInt, rightInt, leftInt, z, w, smul_eq_mul, sub_eq_add_neg] using h
  have hsolve : I * rightInt = I * leftInt + upperInt - lowerInt := by
    linear_combination hboundary
  have hleft : ‖leftInt‖ ≤ (K * x ^ beta / beta) * (2 * T) := by
    have h := intervalIntegral.norm_integral_le_of_norm_le_const
      (a := -T) (b := T) (C := K * x ^ beta / beta)
      (f := fun t : ℝ => G ((beta : ℂ) + t * I)) (by
        intro t ht
        have ht' : t ∈ Ioc (-T) T := by simpa only [uIoc_of_le hTorder] using ht
        have habs : |t| ≤ T := abs_le.mpr ⟨ht'.1.le, ht'.2⟩
        apply norm_perronIntegrand_le hx hK
          (hbound _ (by simp) (by simpa using hbetasigma) (by simpa using habs))
          (by simp) hbeta
        simpa using Complex.re_le_norm ((beta : ℂ) + t * I))
    have hlen : |T - -T| = 2 * T := by rw [abs_of_nonneg (by linarith)]; ring
    simpa only [hlen] using h
  have hhorizontal (v : ℝ) (hv : |v| = T) :
      ‖∫ r in beta..sigma, G ((r : ℂ) + v * I)‖ ≤
        (K * x ^ sigma / T) * (sigma - beta) := by
    have h := intervalIntegral.norm_integral_le_of_norm_le_const
      (a := beta) (b := sigma) (C := K * x ^ sigma / T)
      (f := fun r : ℝ => G ((r : ℂ) + v * I)) (by
        intro r hr
        have hr' : r ∈ Ioc beta sigma := by simpa only [uIoc_of_le hbetasigma] using hr
        apply norm_perronIntegrand_le hx hK
          (hbound _ (by simpa using hr'.1.le) (by simpa using hr'.2) (by simpa using hv.le))
          (by simpa using hr'.2) hT
        simpa only [Complex.add_im, Complex.ofReal_im, Complex.mul_im, Complex.ofReal_re,
          Complex.I_im, Complex.I_re, mul_one, mul_zero, add_zero, zero_add, hv] using
          Complex.abs_im_le_norm ((r : ℂ) + v * I))
    simpa only [abs_of_nonneg (sub_nonneg.mpr hbetasigma)] using h
  have hlower : ‖lowerInt‖ ≤ (K * x ^ sigma / T) * (sigma - beta) := by
    simpa [lowerInt, sub_eq_add_neg] using hhorizontal (-T) (by simp [abs_of_pos hT])
  have hupper : ‖upperInt‖ ≤ (K * x ^ sigma / T) * (sigma - beta) :=
    hhorizontal T (abs_of_pos hT)
  have hraw : ‖rightInt‖ ≤ (K * x ^ beta / beta) * (2 * T) +
      2 * ((K * x ^ sigma / T) * (sigma - beta)) := by
    calc
      _ = ‖I * rightInt‖ := by simp
      _ = ‖I * leftInt + upperInt - lowerInt‖ := by rw [hsolve]
      _ ≤ ‖I * leftInt + upperInt‖ + ‖lowerInt‖ := norm_sub_le _ _
      _ ≤ (‖leftInt‖ + ‖upperInt‖) + ‖lowerInt‖ := by
        have h := norm_add_le (I * leftInt) upperInt
        simp only [norm_mul, Complex.norm_I, one_mul] at h
        linarith
      _ ≤ _ := by linarith [hleft, hupper, hlower]
  have hconst : ‖(((2 * Real.pi : ℝ) : ℂ)⁻¹)‖ ≤ 1 := by
    rw [norm_inv, Complex.norm_real, Real.norm_eq_abs,
      abs_of_pos (mul_pos (by norm_num) Real.pi_pos)]
    exact (inv_le_one₀ (mul_pos (by norm_num) Real.pi_pos)).mpr
      (by nlinarith [Real.pi_gt_three])
  change ‖(((2 * Real.pi : ℝ) : ℂ)⁻¹) * rightInt‖ ≤ _
  rw [norm_mul]
  calc
    _ ≤ 1 * ‖rightInt‖ := mul_le_mul_of_nonneg_right hconst (norm_nonneg _)
    _ ≤ (K * x ^ beta / beta) * (2 * T) +
        2 * ((K * x ^ sigma / T) * (sigma - beta)) := by simpa using hraw
    _ = _ := by ring

theorem exists_moebiusCharacterSum_rectangle_bound {epsilon eta : ℝ}
    (hepsilon : 0 < epsilon) (heta : 0 < eta) :
    ∃ M : ℕ, 2 ≤ M ∧ ∃ c : ℝ, 0 < c ∧
      ∃ alpha : ℝ, 0 < alpha ∧ alpha ≤ 1 / 2 ∧
        ∀ (q : ℕ) [NeZero q] (chi : DirichletCharacter ℂ q),
          ∀ x : ℕ, 0 < x → ∀ sigma T : ℝ, 1 < sigma → sigma ≤ 2 → 0 < T →
            let delta := alpha * zeroFreeWidth M c epsilon q (T + 6)
            let K := (q : ℝ) ^ 2 * (3 / delta) * ((q : ℝ) * (T + 8)) ^ eta
            ‖(∑ n ∈ Finset.Icc 1 x, chi n * (ArithmeticFunction.moebius n : ℂ))‖ ≤
              1 / 2 + 4 * (x : ℝ) * (1 + Real.log x) / T +
                96 * (x : ℝ) ^ sigma / (T * (sigma - 1)) +
                2 * T * K * (x : ℝ) ^ (1 - delta) / (1 - delta) +
                2 * (sigma - (1 - delta)) * K * (x : ℝ) ^ sigma / T := by
  obtain ⟨M, hM, c, hc, alpha, halpha, halphaHalf, hreciprocal⟩ :=
    exists_analyticReciprocalL_nearOne_bound hepsilon heta
  refine ⟨M, hM, c, hc, alpha, halpha, halphaHalf, ?_⟩
  intro q _ chi x hx sigma T hsigma hupper hT
  let W : ℝ := zeroFreeWidth M c epsilon q (T + 6)
  let delta : ℝ := alpha * W
  let beta : ℝ := 1 - delta
  let K : ℝ := (q : ℝ) ^ 2 * (3 / delta) * ((q : ℝ) * (T + 8)) ^ eta
  have hW : 0 < W := zeroFreeWidth_pos hM hc (by linarith)
  have hWhalf : W ≤ 1 / 2 := min_le_left _ _
  have hdelta : 0 < delta := mul_pos halpha hW
  have hdeltaQuarter : delta ≤ 1 / 4 := by
    have h := mul_le_mul halphaHalf hWhalf hW.le (by norm_num : (0 : ℝ) ≤ 1 / 2)
    dsimp [delta]
    nlinarith
  have hbeta : 0 < beta := by dsimp [beta]; linarith
  have hbetasigma : beta ≤ sigma := by dsimp [beta]; linarith
  have hK : 0 ≤ K := by dsimp [K]; positivity
  have hxone : (1 : ℝ) ≤ x := by exact_mod_cast hx
  have hrectangle (s : ℂ) (hslo : beta ≤ s.re) (hshi : s.re ≤ sigma)
      (hsim : |s.im| ≤ T) :
      DifferentiableAt ℂ (analyticReciprocalL chi) s ∧
        ‖analyticReciprocalL chi s‖ ≤ K := by
    have h := hreciprocal q chi T hT.le s.im s.re hsim hslo (hshi.trans hupper)
    simpa only [Complex.re_add_im] using h
  have hcontour := norm_analyticPerronIntegral_le_of_rectangle hxone hbeta hbetasigma hT hK
    (fun s hslo hshi hsim => (hrectangle s hslo hshi hsim).1)
    (fun s hslo hshi hsim => (hrectangle s hslo hshi hsim).2)
  have hperron := norm_moebiusCharacterSum_sub_analyticPerronIntegral_le
    chi hx hsigma hupper hT
  change ‖(∑ n ∈ Finset.Icc 1 x, chi n * (ArithmeticFunction.moebius n : ℂ))‖ ≤
    1 / 2 + 4 * (x : ℝ) * (1 + Real.log x) / T +
      96 * (x : ℝ) ^ sigma / (T * (sigma - 1)) +
      2 * T * K * (x : ℝ) ^ beta / beta +
      2 * (sigma - beta) * K * (x : ℝ) ^ sigma / T
  calc
    _ ≤ ‖(∑ n ∈ Finset.Icc 1 x, chi n * (ArithmeticFunction.moebius n : ℂ)) -
        analyticPerronIntegral (analyticReciprocalL chi) x sigma T‖ +
        ‖analyticPerronIntegral (analyticReciprocalL chi) x sigma T‖ :=
      norm_le_norm_sub_add _ _
    _ ≤ (1 / 2 + 4 * (x : ℝ) * (1 + Real.log x) / T +
        96 * (x : ℝ) ^ sigma / (T * (sigma - 1))) +
        (2 * T * K * (x : ℝ) ^ beta / beta +
          2 * (sigma - beta) * K * (x : ℝ) ^ sigma / T) :=
      add_le_add hperron hcontour
    _ = _ := by ring

/--
The combined endpoint, Perron-truncation, and contour-shift error bound for a rectangle with
real edges `sigma` and `1 - delta`, height `T`, and analytic-factor bound `K`.
-/
noncomputable def rectangleError (x sigma T delta K : ℝ) : ℝ :=
  1 / 2 + 4 * x * (1 + Real.log x) / T +
    96 * x ^ sigma / (T * (sigma - 1)) +
    2 * T * K * x ^ (1 - delta) / (1 - delta) +
    2 * (sigma - (1 - delta)) * K * x ^ sigma / T

theorem contourWidth_envelope_bounds
    {E M q : ℕ} [NeZero q] (hE : 0 < E) (hM : 2 ≤ M)
    {c alpha k a u : ℝ} (hc : 0 < c) (halpha : 0 < alpha)
    (hk : 0 < k) (hkone : k ≤ 1) (hkc : k ≤ c) (ha : 0 < a)
    (hsmall : 4 * (M : ℝ) ^ 2 * a * k ≤ 1)
    (hu : 2 ≤ u) (hheight : 8 ≤ Real.exp (a * u))
    (hqpower : (q : ℝ) ≤ u ^ (2 * E)) (hqheight : (q : ℝ) ≤ Real.exp (a * u))
    (habsorb : (3 / (alpha * k)) * u ^ (4 * E + 1) ≤ Real.exp (a * u / 4)) :
    let T := Real.exp (a * u)
    let W := zeroFreeWidth M c (1 / (2 * (E : ℝ))) q (T + 6)
    k / u ≤ W ∧
      (q : ℝ) ^ 2 * (3 / (alpha * W)) *
        ((q : ℝ) * (T + 8)) ^ (1 / 16 : ℝ) ≤ Real.exp (a * u / 2) := by
  let T : ℝ := Real.exp (a * u)
  let epsilon : ℝ := 1 / (2 * (E : ℝ))
  let W : ℝ := zeroFreeWidth M c epsilon q (T + 6)
  have hEpos : (0 : ℝ) < E := by exact_mod_cast hE
  have hepsilon : 0 < epsilon := by dsimp [epsilon]; positivity
  have hupos : 0 < u := by linarith
  have hT : 8 ≤ T := hheight
  have hTpos : 0 < T := Real.exp_pos _
  have hqpos : (0 : ℝ) < q := by exact_mod_cast NeZero.pos q
  have hqone : (1 : ℝ) ≤ q := by exact_mod_cast NeZero.pos q
  have hbasepos : 0 < (q : ℝ) * (T + 8) := by positivity
  have hbaseone : 1 < (q : ℝ) * (T + 8) := by nlinarith
  have hbasePow : (q : ℝ) * (T + 8) ≤ T ^ 4 := by
    calc
      _ ≤ T * (T + 8) := mul_le_mul_of_nonneg_right hqheight (by linarith)
      _ ≤ T * (2 * T) := mul_le_mul_of_nonneg_left (by linarith) hTpos.le
      _ = 2 * T ^ 2 := by ring
      _ ≤ T ^ 2 * T ^ 2 :=
        mul_le_mul_of_nonneg_right (by nlinarith : (2 : ℝ) ≤ T ^ 2) (sq_nonneg T)
      _ = _ := by ring
  have hlogpos : 0 < Real.log ((q : ℝ) * (T + 8)) := Real.log_pos hbaseone
  have hlog : Real.log ((q : ℝ) * (T + 8)) ≤ 4 * a * u := by
    have h := Real.log_le_log hbasepos hbasePow
    have hlogT : Real.log T = a * u := by simp [T]
    rw [Real.log_pow, hlogT] at h
    norm_num at h
    nlinarith
  have hqepsilon : (q : ℝ) ^ epsilon ≤ u := by
    calc
      _ ≤ (u ^ (2 * E)) ^ epsilon :=
        Real.rpow_le_rpow hqpos.le hqpower hepsilon.le
      _ = u := by
        rw [← Real.rpow_natCast, ← Real.rpow_mul hupos.le]
        have hexponent : ((2 * E : ℕ) : ℝ) * epsilon = 1 := by
          dsimp [epsilon]
          push_cast
          field_simp
        rw [hexponent, Real.rpow_one]
  have hW : 0 < W := zeroFreeWidth_pos hM hc (by linarith)
  have hWlower : k / u ≤ W := by
    apply le_min
    · exact (div_le_iff₀ hupos).mpr (by nlinarith)
    · apply le_min
      · have hMpos : (0 : ℝ) < M := by exact_mod_cast (show 0 < M by omega)
        have hden : 0 < (M : ℝ) ^ 2 * Real.log ((q : ℝ) * (T + 8)) :=
          mul_pos (sq_pos_of_pos hMpos) hlogpos
        change k / u ≤ 1 / ((M : ℝ) ^ 2 * Real.log ((q : ℝ) * ((T + 6) + 2)))
        rw [show (T + 6) + 2 = T + 8 by ring]
        apply (le_div_iff₀ hden).mpr
        calc
          _ ≤ (k / u) * ((M : ℝ) ^ 2 * (4 * a * u)) :=
            mul_le_mul_of_nonneg_left
              (mul_le_mul_of_nonneg_left hlog (sq_nonneg _)) (by positivity)
          _ = 4 * (M : ℝ) ^ 2 * a * k := by field_simp [hupos.ne']
          _ ≤ 1 := hsmall
      · change k / u ≤ c * (q : ℝ) ^ (-epsilon)
        calc
          _ ≤ c / u := div_le_div_of_nonneg_right hkc hupos.le
          _ ≤ c / (q : ℝ) ^ epsilon :=
            div_le_div_of_nonneg_left hc.le (Real.rpow_pos_of_pos hqpos _) hqepsilon
          _ = _ := by rw [Real.rpow_neg hqpos.le]; rfl
  have hqSquare : (q : ℝ) ^ 2 ≤ u ^ (4 * E) := by
    have h := pow_le_pow_left₀ hqpos.le hqpower 2
    simpa only [← pow_mul, show 2 * E * 2 = 4 * E by omega] using h
  have hquot : 3 / (alpha * W) ≤ (3 / (alpha * k)) * u := by
    calc
      _ ≤ 3 / (alpha * (k / u)) :=
        div_le_div_of_nonneg_left (by norm_num) (mul_pos halpha (div_pos hk hupos))
          (mul_le_mul_of_nonneg_left hWlower halpha.le)
      _ = _ := by field_simp [halpha.ne', hk.ne', hupos.ne']
  have hcoeff : (q : ℝ) ^ 2 * (3 / (alpha * W)) ≤
      (3 / (alpha * k)) * u ^ (4 * E + 1) := by
    calc
      _ ≤ u ^ (4 * E) * ((3 / (alpha * k)) * u) :=
        mul_le_mul hqSquare hquot (by positivity) (by positivity)
      _ = _ := by rw [pow_succ]; ring
  have hbaseRpow : ((q : ℝ) * (T + 8)) ^ (1 / 16 : ℝ) ≤ Real.exp (a * u / 4) := by
    rw [Real.rpow_def_of_pos hbasepos]
    apply Real.exp_le_exp.mpr
    nlinarith
  refine ⟨hWlower, ?_⟩
  change (q : ℝ) ^ 2 * (3 / (alpha * W)) *
    ((q : ℝ) * (T + 8)) ^ (1 / 16 : ℝ) ≤ _
  calc
    _ ≤ ((3 / (alpha * k)) * u ^ (4 * E + 1)) * Real.exp (a * u / 4) :=
      mul_le_mul hcoeff hbaseRpow (Real.rpow_nonneg hbasepos.le _) (by positivity)
    _ ≤ Real.exp (a * u / 4) * Real.exp (a * u / 4) :=
      mul_le_mul_of_nonneg_right habsorb (Real.exp_pos _).le
    _ = _ := by rw [← Real.exp_add]; congr 1; ring

theorem rectangleError_at_exp_height_le
    {x u a delta K : ℝ} (hx : 0 < x) (hu : 2 ≤ u)
    (hlog : Real.log x = u ^ 2) (_ha : 0 < a) (haone : a ≤ 1)
    (hdelta : 0 < delta) (hdeltaQuarter : delta ≤ 1 / 4)
    (hK : 0 ≤ K) (hKbound : K ≤ Real.exp (a * u / 2))
    (hvertical : 2 * a * u ≤ delta * Real.log x)
    (habsorb : (8 + 96 * Real.exp 1) * u ^ 2 ≤ Real.exp (a * u / 2)) :
    rectangleError x (1 + 1 / Real.log x) (Real.exp (a * u)) delta K ≤
      (6 + 4 * Real.exp 1) * x * Real.exp (-a * u / 2) := by
  let sigma : ℝ := 1 + 1 / Real.log x
  let T : ℝ := Real.exp (a * u)
  let R : ℝ := x * Real.exp (-a * u / 2)
  have hupos : 0 < u := by linarith
  have hLpos : 0 < Real.log x := by rw [hlog]; positivity
  have hLone : 1 ≤ Real.log x := by rw [hlog]; nlinarith
  have hTpos : 0 < T := Real.exp_pos _
  have hbetaHalf : (1 / 2 : ℝ) ≤ 1 - delta := by linarith
  have hbeta : 0 < 1 - delta := by linarith
  have hsigmasub : sigma - 1 = 1 / Real.log x := by dsimp [sigma]; ring
  have hsigmapow : x ^ sigma = x * Real.exp 1 := by
    dsimp [sigma]
    rw [Real.rpow_add hx, Real.rpow_one, Real.rpow_def_of_pos hx]
    have hcancel : Real.log x * (1 / Real.log x) = 1 := by field_simp
    rw [hcancel]
  have hbetapow : x ^ (1 - delta) ≤ x * Real.exp (-2 * a * u) := by
    rw [Real.rpow_def_of_pos hx]
    calc
      _ = x * Real.exp (-delta * Real.log x) := by
        rw [show Real.log x * (1 - delta) = Real.log x + (-delta * Real.log x) by ring,
          Real.exp_add, Real.exp_log hx]
      _ ≤ _ := mul_le_mul_of_nonneg_left (Real.exp_le_exp.mpr (by nlinarith)) hx.le
  have hexpdiv : Real.exp (a * u / 2) / T = Real.exp (-a * u / 2) := by
    dsimp [T]
    rw [← Real.exp_sub]
    congr 1
    ring
  have hRone : 1 ≤ R := by
    have hR : R = Real.exp (Real.log x - a * u / 2) := by
      calc
        R = Real.exp (Real.log x) * Real.exp (-a * u / 2) := by
          rw [Real.exp_log hx]
        _ = Real.exp (Real.log x + (-a * u / 2)) := (Real.exp_add _ _).symm
        _ = _ := by congr 1; ring
    rw [hR, Real.one_le_exp_iff, hlog]
    nlinarith
  have hendpoint : (1 / 2 : ℝ) ≤ R := by linarith
  have hperronIdentity :
      4 * x * (1 + Real.log x) / T + 96 * x ^ sigma / (T * (sigma - 1)) =
        x * (4 * (1 + Real.log x) + 96 * Real.exp 1 * Real.log x) / T := by
    rw [hsigmapow, hsigmasub]
    simp only [div_eq_mul_inv, mul_inv_rev, inv_inv]
    ring
  have hpoly : 4 * (1 + Real.log x) + 96 * Real.exp 1 * Real.log x ≤
      (8 + 96 * Real.exp 1) * u ^ 2 := by
    rw [hlog]
    nlinarith
  have hperron : 4 * x * (1 + Real.log x) / T +
      96 * x ^ sigma / (T * (sigma - 1)) ≤ R := by
    rw [hperronIdentity]
    calc
      _ ≤ x * Real.exp (a * u / 2) / T :=
        div_le_div_of_nonneg_right
          (mul_le_mul_of_nonneg_left (hpoly.trans habsorb) hx.le) hTpos.le
      _ = R := by rw [mul_div_assoc, hexpdiv]
  have hleftDen : 2 * T * K * x ^ (1 - delta) / (1 - delta) ≤
      4 * T * K * x ^ (1 - delta) := by
    apply (div_le_iff₀ hbeta).mpr
    calc
      _ = 2 * (T * K * x ^ (1 - delta)) := by ring
      _ ≤ (4 * (1 - delta)) * (T * K * x ^ (1 - delta)) :=
        mul_le_mul_of_nonneg_right (by linarith) (by positivity)
      _ = _ := by ring
  have hleft : 2 * T * K * x ^ (1 - delta) / (1 - delta) ≤ 4 * R := by
    apply hleftDen.trans
    calc
      _ ≤ 4 * T * Real.exp (a * u / 2) * (x * Real.exp (-2 * a * u)) :=
        mul_le_mul (mul_le_mul_of_nonneg_left hKbound (by positivity)) hbetapow
          (Real.rpow_nonneg hx.le _) (by positivity)
      _ = 4 * R := by
        dsimp [T, R]
        calc
          _ = 4 * x * (Real.exp (a * u) * Real.exp (a * u / 2) *
              Real.exp (-2 * a * u)) := by ring
          _ = _ := by
            rw [← Real.exp_add, ← Real.exp_add,
              show a * u + a * u / 2 + -2 * a * u = -a * u / 2 by ring]
            ring
  have hwidth : 0 ≤ sigma - (1 - delta) ∧ sigma - (1 - delta) ≤ 2 := by
    have hrecip : 0 < 1 / Real.log x := one_div_pos.mpr hLpos
    have hrecipUpper : 1 / Real.log x ≤ 1 := by
      simpa using one_div_le_one_div_of_le zero_lt_one hLone
    dsimp [sigma]
    constructor <;> linarith
  have hright : 2 * (sigma - (1 - delta)) * K * x ^ sigma / T ≤
      (4 * Real.exp 1) * R := by
    calc
      _ ≤ 4 * K * x ^ sigma / T := by
        apply div_le_div_of_nonneg_right _ hTpos.le
        have h := mul_le_mul_of_nonneg_right hwidth.2
          (by positivity : 0 ≤ K * x ^ sigma)
        nlinarith
      _ ≤ 4 * Real.exp (a * u / 2) * (x * Real.exp 1) / T := by
        rw [hsigmapow]
        exact div_le_div_of_nonneg_right
          (mul_le_mul_of_nonneg_right
            (mul_le_mul_of_nonneg_left hKbound (by norm_num)) (by positivity)) hTpos.le
      _ = (4 * Real.exp 1) * R := by
        calc
          _ = (4 * Real.exp 1) * x * (Real.exp (a * u / 2) / T) := by ring
          _ = _ := by rw [hexpdiv]; dsimp [R]; ring
  change rectangleError x sigma T delta K ≤ _
  calc
    _ = (1 / 2 + (4 * x * (1 + Real.log x) / T +
        96 * x ^ sigma / (T * (sigma - 1)))) +
        2 * T * K * x ^ (1 - delta) / (1 - delta) +
        2 * (sigma - (1 - delta)) * K * x ^ sigma / T := by
      unfold rectangleError
      ring
    _ ≤ (R + R) + 4 * R + (4 * Real.exp 1) * R := by
      linarith [hendpoint, hperron, hleft, hright]
    _ = _ := by dsimp [R]; ring

theorem eventually_mobiusContour_conditions (E : ℕ)
    {alpha k a : ℝ} (halpha : 0 < alpha) (hk : 0 < k) (ha : 0 < a) :
    ∀ᶠ x : ℕ in atTop,
      4 ≤ x ∧ 1 ≤ Real.log (x : ℝ) ∧
        2 ≤ Real.sqrt (Real.log (x : ℝ)) ∧
        8 ≤ Real.exp (a * Real.sqrt (Real.log (x : ℝ))) ∧
        Real.sqrt (Real.log (x : ℝ)) ^ (2 * E) ≤
          Real.exp (a * Real.sqrt (Real.log (x : ℝ))) ∧
        (3 / (alpha * k)) * Real.sqrt (Real.log (x : ℝ)) ^ (4 * E + 1) ≤
          Real.exp (a * Real.sqrt (Real.log (x : ℝ)) / 4) ∧
        (8 + 96 * Real.exp 1) * Real.sqrt (Real.log (x : ℝ)) ^ 2 ≤
          Real.exp (a * Real.sqrt (Real.log (x : ℝ)) / 2) := by
  let u : ℕ → ℝ := fun x => Real.sqrt (Real.log (x : ℝ))
  have hLTop : Tendsto (fun x : ℕ => Real.log (x : ℝ)) atTop atTop :=
    Real.tendsto_log_atTop.comp tendsto_natCast_atTop_atTop
  have huTop : Tendsto u atTop atTop := Real.tendsto_sqrt_atTop.comp hLTop
  have hheight : ∀ᶠ x : ℕ in atTop, 8 ≤ Real.exp (a * u x) :=
    (Real.tendsto_exp_atTop.comp (Filter.Tendsto.const_mul_atTop ha huTop)).eventually
      (eventually_ge_atTop 8)
  have hmodulus : ∀ᶠ x : ℕ in atTop, u x ^ (2 * E) ≤ Real.exp (a * u x) := by
    have hdom := ((isLittleO_pow_exp_pos_mul_atTop (2 * E) ha).comp_tendsto huTop).eventuallyLE
    filter_upwards [hdom] with x h
    have hu0 : 0 ≤ u x := by dsimp [u]; positivity
    simpa only [Function.comp_apply, Real.norm_eq_abs,
      abs_of_nonneg (pow_nonneg hu0 _), abs_of_pos (Real.exp_pos _)] using h
  have hcoefficient : ∀ᶠ x : ℕ in atTop,
      (3 / (alpha * k)) * u x ^ (4 * E + 1) ≤ Real.exp (a * u x / 4) := by
    have hdom := (((isLittleO_pow_exp_pos_mul_atTop (4 * E + 1)
      (by positivity : 0 < a / 4)).const_mul_left (3 / (alpha * k))).comp_tendsto
        huTop).eventuallyLE
    filter_upwards [hdom] with x h
    have hleft : 0 ≤ (3 / (alpha * k)) * u x ^ (4 * E + 1) := by
      dsimp [u]
      positivity
    simp only [Function.comp_apply, Real.norm_eq_abs, abs_of_nonneg hleft,
      abs_of_pos (Real.exp_pos _)] at h
    rw [show (a / 4) * u x = a * u x / 4 by ring] at h
    exact h
  have hperron : ∀ᶠ x : ℕ in atTop,
      (8 + 96 * Real.exp 1) * u x ^ 2 ≤ Real.exp (a * u x / 2) := by
    have hdom := (((isLittleO_pow_exp_pos_mul_atTop 2
      (by positivity : 0 < a / 2)).const_mul_left (8 + 96 * Real.exp 1)).comp_tendsto
        huTop).eventuallyLE
    filter_upwards [hdom] with x h
    have hleft : 0 ≤ (8 + 96 * Real.exp 1) * u x ^ 2 := by positivity
    simp only [Function.comp_apply, Real.norm_eq_abs, abs_of_nonneg hleft,
      abs_of_pos (Real.exp_pos _)] at h
    rw [show (a / 2) * u x = a * u x / 2 by ring] at h
    exact h
  filter_upwards [eventually_ge_atTop (4 : ℕ), hLTop.eventually (eventually_ge_atTop 1),
    huTop.eventually (eventually_ge_atTop 2), hheight, hmodulus, hcoefficient, hperron]
    with x hx hL hu hheight hmodulus hcoefficient hperron
  exact ⟨hx, hL, hu, hheight, hmodulus, hcoefficient, hperron⟩

end PrimeGap186

section
open Complex Set
open scoped ComplexOrder Interval

theorem PrimeGap186.unconditional_moebiusCharacterSiegelWalfisz :
    ∀ D : ℝ, 0 < D → ∃ C c : ℝ, 0 < C ∧ 0 < c ∧
      ∃ X₀ : ℕ, 4 ≤ X₀ ∧ ∀ x : ℕ, X₀ ≤ x →
        ∀ (q : ℕ) [NeZero q] (chi : DirichletCharacter ℂ q),
          (q : ℝ) ≤ Real.rpow (Real.log (x : ℝ)) D →
            ‖∑ n ∈ Finset.Icc 1 x, chi n * (ArithmeticFunction.moebius n : ℂ)‖ ≤
              C * (x : ℝ) * Real.exp (-c * Real.sqrt (Real.log (x : ℝ))) := by
  intro D hD
  obtain ⟨E, hDE⟩ := exists_nat_gt D
  have hE : 0 < E := by exact_mod_cast (hD.trans hDE)
  have hEpos : (0 : ℝ) < E := by exact_mod_cast hE
  let epsilon : ℝ := 1 / (2 * (E : ℝ))
  have hepsilon : 0 < epsilon := by dsimp [epsilon]; positivity
  obtain ⟨M, hM, c, hc, alpha, halpha, halphaHalf, hfinite⟩ :=
    PrimeGap186.exists_moebiusCharacterSum_rectangle_bound hepsilon (by norm_num : (0 : ℝ) < 1 / 16)
  let k : ℝ := min 1 c
  have hk : 0 < k := lt_min zero_lt_one hc
  have hkone : k ≤ 1 := min_le_left _ _
  have hkc : k ≤ c := min_le_right _ _
  have hMpos : (0 : ℝ) < M := by exact_mod_cast (show 0 < M by omega)
  have hden : 0 < 4 * (M : ℝ) ^ 2 * k := by positivity
  let a : ℝ := min 1 (min (alpha * k / 4) (1 / (4 * (M : ℝ) ^ 2 * k)))
  have ha : 0 < a := lt_min zero_lt_one
    (lt_min (by positivity) (one_div_pos.mpr hden))
  have haone : a ≤ 1 := min_le_left _ _
  have haAlpha : a ≤ alpha * k / 4 :=
    (min_le_right _ _).trans (min_le_left _ _)
  have haDen : a ≤ 1 / (4 * (M : ℝ) ^ 2 * k) :=
    (min_le_right _ _).trans (min_le_right _ _)
  have hsmall : 4 * (M : ℝ) ^ 2 * a * k ≤ 1 := by
    have h := (le_div_iff₀ hden).mp haDen
    nlinarith
  have htwosmall : 2 * a ≤ alpha * k := by
    have hpos : 0 < alpha * k := mul_pos halpha hk
    nlinarith
  obtain ⟨X0, hX0⟩ := Filter.eventually_atTop.mp
    (PrimeGap186.eventually_mobiusContour_conditions E halpha hk ha)
  refine ⟨6 + 4 * Real.exp 1, a / 2, by positivity, by positivity,
    X0, (hX0 X0 le_rfl).1, ?_⟩
  intro x hxX q _ chi hqlog
  obtain ⟨hxFour, hLone, huTwo, hheight, hmodulus, hcoefficient, hperronAbsorb⟩ := hX0 x hxX
  let u : ℝ := Real.sqrt (Real.log (x : ℝ))
  let T : ℝ := Real.exp (a * u)
  let W : ℝ := PrimeGap186.zeroFreeWidth M c epsilon q (T + 6)
  let delta : ℝ := alpha * W
  let K : ℝ := (q : ℝ) ^ 2 * (3 / delta) * ((q : ℝ) * (T + 8)) ^ (1 / 16 : ℝ)
  let sigma : ℝ := 1 + 1 / Real.log (x : ℝ)
  have hx : 0 < x := by omega
  have hxReal : (0 : ℝ) < x := by exact_mod_cast hx
  have hupos : 0 < u := by change 2 ≤ u at huTwo; linarith
  have hLpos : 0 < Real.log (x : ℝ) := zero_lt_one.trans_le hLone
  have husq : u ^ 2 = Real.log (x : ℝ) := Real.sq_sqrt hLpos.le
  have hT : 0 < T := Real.exp_pos _
  have hqL : (q : ℝ) ≤ Real.log (x : ℝ) ^ E := by
    calc
      _ ≤ Real.log (x : ℝ) ^ D := hqlog
      _ ≤ Real.log (x : ℝ) ^ (E : ℝ) :=
        Real.rpow_le_rpow_of_exponent_le hLone hDE.le
      _ = _ := Real.rpow_natCast _ _
  have hqpower : (q : ℝ) ≤ u ^ (2 * E) := by
    calc
      _ ≤ Real.log (x : ℝ) ^ E := hqL
      _ = (u ^ 2) ^ E := by rw [husq]
      _ = _ := (pow_mul u 2 E).symm
  have hqheight : (q : ℝ) ≤ Real.exp (a * u) := hqpower.trans hmodulus
  have hwidthEnvelope := PrimeGap186.contourWidth_envelope_bounds
    hE hM hc halpha hk hkone hkc ha hsmall huTwo hheight hqpower hqheight hcoefficient
  change k / u ≤ W ∧ K ≤ Real.exp (a * u / 2) at hwidthEnvelope
  have hW : 0 < W := PrimeGap186.zeroFreeWidth_pos hM hc (by linarith)
  have hdelta : 0 < delta := mul_pos halpha hW
  have hdeltaQuarter : delta ≤ 1 / 4 := by
    have hWhalf : W ≤ 1 / 2 := min_le_left _ _
    have h := mul_le_mul halphaHalf hWhalf hW.le (by norm_num : (0 : ℝ) ≤ 1 / 2)
    dsimp [delta]
    nlinarith
  have hK : 0 ≤ K := by dsimp [K]; positivity
  have hvertical : 2 * a * u ≤ delta * Real.log (x : ℝ) := by
    have hscaled : alpha * (k / u) ≤ delta :=
      mul_le_mul_of_nonneg_left hwidthEnvelope.1 halpha.le
    have hscale : alpha * (k / u) * Real.log (x : ℝ) = alpha * k * u := by
      rw [← husq]
      field_simp [hupos.ne']
    have h := mul_le_mul_of_nonneg_right hscaled hLpos.le
    rw [hscale] at h
    exact (mul_le_mul_of_nonneg_right htwosmall hupos.le).trans h
  have hsigma : 1 < sigma := by
    dsimp [sigma]
    linarith [one_div_pos.mpr hLpos]
  have hupper : sigma ≤ 2 := by
    have hrecip : 1 / Real.log (x : ℝ) ≤ 1 := by
      simpa using one_div_le_one_div_of_le zero_lt_one hLone
    dsimp [sigma]
    linarith
  have hraw := hfinite q chi x hx sigma T hsigma hupper hT
  change ‖(∑ n ∈ Finset.Icc 1 x, chi n * (ArithmeticFunction.moebius n : ℂ))‖ ≤
    PrimeGap186.rectangleError (x : ℝ) sigma T delta K at hraw
  have hscalar := PrimeGap186.rectangleError_at_exp_height_le hxReal huTwo husq.symm ha haone
    hdelta hdeltaQuarter hK hwidthEnvelope.2 hvertical hperronAbsorb
  have hexponent : -a * u / 2 = -(a / 2) * u := by ring
  rw [hexponent] at hscalar
  exact hraw.trans hscalar

end

namespace PrimeGap186

section
open Filter Asymptotics

theorem log_window_bound (R e : ℝ) (hR : 0 ≤ R) (he : 0 < e) :
    ∃ D : ℝ, 0 < D ∧ ∀ x : ℝ, 1 ≤ x → (1 + Real.log x) ^ R ≤ D * x ^ e := by
  have hev := (isLittleO_log_rpow_rpow_atTop R he).isBigOWith.bound
  obtain ⟨b, hb⟩ := (Filter.eventually_atTop.1 hev)
  let b' := max (Real.exp 1) b
  let D := max ((2 : ℝ) ^ R) ((1 + Real.log b') ^ R) + 1
  have hdp : 0 < D := by
    dsimp [D]
    have := Real.rpow_nonneg (show (0 : ℝ) ≤ 2 by norm_num) R
    linarith [le_max_left ((2 : ℝ) ^ R) ((1 + Real.log b') ^ R)]
  refine ⟨D, hdp, fun x hx => ?_⟩
  have hxp : 0 < x := lt_of_lt_of_le zero_lt_one hx
  have hax : 0 ≤ Real.log x := Real.log_nonneg hx
  have hxp_e : 1 ≤ x ^ e := Real.one_le_rpow hx he.le
  by_cases hc : x ≤ b'
  · have hu : (1 + Real.log x) ^ R ≤ (1 + Real.log b') ^ R :=
      Real.rpow_le_rpow (by linarith) (add_le_add le_rfl (Real.log_le_log hxp hc)) hR
    calc
      (1 + Real.log x) ^ R ≤ (1 + Real.log b') ^ R := hu
      _ ≤ D := by dsimp [D]; linarith only [le_max_right ((2 : ℝ) ^ R) ((1 + Real.log b') ^ R)]
      _ ≤ D * x ^ e := by nlinarith only [hxp_e, hdp]
  · have hlarge : b ≤ x := (le_max_right _ _).trans (le_of_lt (lt_of_not_ge hc))
    have he1 : 1 ≤ Real.log x := by
      have ht : Real.exp 1 ≤ x := (le_max_left (Real.exp 1) b).trans
        (le_of_lt (lt_of_not_ge hc))
      simpa using (Real.log_le_log (Real.exp_pos 1) ht)
    have hrpo : Real.log x ^ R ≤ x ^ e := by
      have heval := hb x hlarge
      simpa only [Real.norm_of_nonneg (Real.rpow_nonneg hax R),
        Real.norm_of_nonneg (Real.rpow_nonneg hxp.le e), one_mul] using heval
    have hsmall : (1 + Real.log x) ^ R ≤ (2 * Real.log x) ^ R :=
      Real.rpow_le_rpow (show 0 ≤ 1 + Real.log x by linarith) (by linarith only [he1]) hR
    calc
      (1 + Real.log x) ^ R ≤ (2 * Real.log x) ^ R := hsmall
      _ = (2 : ℝ) ^ R * (Real.log x) ^ R := Real.mul_rpow (by norm_num) (by linarith)
      _ ≤ (2 : ℝ) ^ R * x ^ e := mul_le_mul_of_nonneg_left hrpo (by positivity)
      _ ≤ D * x ^ e := mul_le_mul_of_nonneg_right
        (by dsimp [D]; linarith only [le_max_left ((2 : ℝ) ^ R) ((1 + Real.log b') ^ R)])
        (by positivity)

theorem prime_factor_logarithmic_loss
    (a C E F ε : ℝ) (ha : 1 ≤ a) (hC : 0 < C)
    (hE : 0 ≤ E) (hF : 0 ≤ F) (hε : 0 < ε) :
    ∃ K : ℝ, 0 < K ∧ ∀ x : ℝ, 2 ≤ x → ∀ m : ℕ,
      m ≠ 0 → (m : ℝ) ≤ x ^ C →
      a ^ m.primeFactors.card * (1 + Real.log (m : ℝ)) ^ E *
        (Real.log x) ^ F ≤ K * x ^ ε := by
  have hβ : 0 < ε / (2 * C) := div_pos hε (mul_pos (by norm_num) hC)
  obtain ⟨Kp, hKp, hp⟩ := exists_primeFactors_power_bound ha hβ
  obtain ⟨Kl, hKl, hl⟩ := log_window_bound (E + F) (ε / 2)
    (add_nonneg hE hF) (half_pos hε)
  let K := (1 + C) ^ E * Kp * Kl
  refine ⟨K, mul_pos (mul_pos (Real.rpow_pos_of_pos (by linarith) E) hKp) hKl, ?_⟩
  intro x hx m hm hmx
  have hx1 : 1 ≤ x := by linarith
  have hx0 : 0 < x := by linarith
  have hm0 : (0 : ℝ) < m := by exact_mod_cast Nat.pos_of_ne_zero hm
  have hm1 : (1 : ℝ) ≤ m := by exact_mod_cast Nat.one_le_iff_ne_zero.mpr hm
  have hlogx : 0 ≤ Real.log x := Real.log_nonneg hx1
  have hlogm : 0 ≤ Real.log (m : ℝ) := Real.log_nonneg hm1
  have hmpow : (m : ℝ) ^ (ε / (2 * C)) ≤ x ^ (ε / 2) := by
    calc
      _ ≤ (x ^ C) ^ (ε / (2 * C)) :=
        Real.rpow_le_rpow (Nat.cast_nonneg m) hmx hβ.le
      _ = x ^ (ε / 2) := by
        rw [← Real.rpow_mul hx0.le]
        congr 1
        field_simp
  have hmlog : Real.log (m : ℝ) ≤ C * Real.log x := by
    calc
      _ ≤ Real.log (x ^ C) := Real.log_le_log hm0 hmx
      _ = _ := Real.log_rpow hx0 C
  have hbase : 1 + Real.log (m : ℝ) ≤ (1 + C) * (1 + Real.log x) := by
    nlinarith
  have hlogs :
      (1 + Real.log (m : ℝ)) ^ E * (Real.log x) ^ F ≤
        (1 + C) ^ E * (Kl * x ^ (ε / 2)) := by
    calc
      _ ≤ ((1 + C) * (1 + Real.log x)) ^ E * (1 + Real.log x) ^ F :=
        mul_le_mul
          (Real.rpow_le_rpow (by linarith) hbase hE)
          (Real.rpow_le_rpow hlogx (by linarith) hF)
          (Real.rpow_nonneg hlogx F) (by positivity)
      _ = (1 + C) ^ E * (1 + Real.log x) ^ (E + F) := by
        rw [Real.mul_rpow (by linarith : 0 ≤ 1 + C) (by linarith : 0 ≤ 1 + Real.log x),
          Real.rpow_add (by linarith : 0 < 1 + Real.log x)]
        ring
      _ ≤ (1 + C) ^ E * (Kl * x ^ (ε / 2)) :=
        mul_le_mul_of_nonneg_left (hl x hx1) (by positivity)
  calc
    _ = a ^ m.primeFactors.card *
        ((1 + Real.log (m : ℝ)) ^ E * (Real.log x) ^ F) := by ring
    _ ≤ (Kp * x ^ (ε / 2)) * ((1 + C) ^ E * (Kl * x ^ (ε / 2))) :=
      mul_le_mul ((hp m hm).trans (mul_le_mul_of_nonneg_left hmpow hKp.le))
        hlogs (by positivity) (by positivity)
    _ = K * (x ^ (ε / 2) * x ^ (ε / 2)) := by dsimp [K]; ring
    _ = K * x ^ ε := by
      rw [← Real.rpow_add hx0, show ε / 2 + ε / 2 = ε by ring]

theorem prescribed_subpower_absorption
    (L₀ : ℝ → ℝ) (hL₀ : ∀ᶠ x : ℝ in atTop, 0 < L₀ x)
    (hsub : (fun x : ℝ => Real.log (L₀ x)) =o[atTop] Real.log)
    (η : ℝ) (hη : 0 < η) :
    ∀ᶠ x : ℝ in atTop, L₀ x ≤ x ^ η := by
  filter_upwards [hL₀, hsub.bound hη, eventually_ge_atTop (2 : ℝ)] with x hL hb hx
  have hx0 : 0 < x := by linarith
  have hlog : 0 ≤ Real.log x := Real.log_nonneg (by linarith)
  have hle : Real.log (L₀ x) ≤ Real.log x * η := by
    calc
      _ ≤ ‖Real.log (L₀ x)‖ := le_abs_self _
      _ ≤ η * ‖Real.log x‖ := hb
      _ = _ := by rw [Real.norm_of_nonneg hlog]; ring
  rw [Real.rpow_def_of_pos hx0 η]
  exact (Real.log_le_iff_le_exp hL).mp hle

theorem small_prime_density_scale_absorption
    (δ₀ δ : ℝ) (hδ : δ₀ < δ) :
    ∀ᶠ x : ℝ in atTop,
      x ^ δ₀ * Real.exp ((Real.log x) ^ (2 / 3 : ℝ)) ≤ x ^ δ := by
  have ht : Tendsto (fun x : ℝ => (Real.log x) ^ (-(1 / 3 : ℝ)))
      atTop (𝓝 0) :=
    (tendsto_rpow_neg_atTop (by norm_num : (0 : ℝ) < 1 / 3)).comp Real.tendsto_log_atTop
  filter_upwards [ht.eventually_lt_const (sub_pos.mpr hδ),
    eventually_ge_atTop (2 : ℝ)] with x hb hx
  have hx0 : 0 < x := by linarith
  have hlog : 0 < Real.log x := Real.log_pos (by linarith)
  have hpower : (Real.log x) ^ (2 / 3 : ℝ) ≤ (δ - δ₀) * Real.log x := by
    calc
      _ = (Real.log x) ^ (-(1 / 3 : ℝ) + 1) := by congr 1; norm_num
      _ = (Real.log x) ^ (-(1 / 3 : ℝ)) * Real.log x := by
        rw [Real.rpow_add hlog, Real.rpow_one]
      _ ≤ (δ - δ₀) * Real.log x := mul_le_mul_of_nonneg_right hb.le hlog.le
  rw [Real.rpow_def_of_pos hx0 δ₀, Real.rpow_def_of_pos hx0 δ, ← Real.exp_add]
  apply Real.exp_le_exp.mpr
  nlinarith

end

section
open Polynomial

theorem squarefree_card_divisors (q : ℕ) (hq : Squarefree q) :
    q.divisors.card = 2 ^ q.primeFactors.card := by
  have h := Nat.sum_divisors_filter_squarefree (f := fun _ : ℕ => (1 : ℕ)) hq.ne_zero
  rw [Nat.divisors_filter_squarefree_of_squarefree hq] at h
  simpa only [Finset.sum_const, nsmul_eq_mul, mul_one, Finset.card_powerset,
    Nat.factors_eq, List.toFinset_coe, Nat.toFinset_factors, Nat.cast_id] using h

theorem ambient_reciprocal_loss (E C₀ ε : ℝ) (hE : 0 ≤ E) (hC₀ : 0 < C₀) (hε : 0 < ε) :
    ∃ D : ℝ, 0 < D ∧ ∀ q : ℕ, Squarefree q → ∀ N : ℝ, 1 ≤ N → N ≤ (q : ℝ) ^ C₀ →
      (Real.log (2 * (q : ℝ) * N)) ^ E *
        ((12 : ℝ) ^ q.primeFactors.card * (q.divisors.card : ℝ) * (1 + Real.log q)) ≤
          D * (q : ℝ) ^ ε := by
  obtain ⟨D₁, hD₁, hlog⟩ := log_window_bound (E + 1) (ε / 2) (by linarith) (by linarith)
  obtain ⟨D₂, hD₂, hp⟩ := exists_primeFactors_power_bound
    (a := 24) (ε := ε / 2) (by norm_num) (by linarith)
  let R := Real.log 2 + 1 + C₀
  have hRp : 0 < R := by
    dsimp [R]
    have := Real.log_pos (by norm_num : (1 : ℝ) < 2)
    linarith
  let D := R ^ E * (D₁ * D₂)
  have hDp : 0 < D := mul_pos (Real.rpow_pos_of_pos hRp E) (mul_pos hD₁ hD₂)
  refine ⟨D, hDp, fun q hq N hNone hNmax => ?_⟩
  have hqone : (1 : ℝ) ≤ q := by exact_mod_cast Nat.one_le_iff_ne_zero.mpr hq.ne_zero
  have hqp : (0 : ℝ) < q := lt_of_lt_of_le zero_lt_one hqone
  let H := 1 + Real.log q
  have hHp : 0 < H := by dsimp only [H]; linarith [Real.log_nonneg hqone]
  have hNpos : 0 < N := lt_of_lt_of_le zero_lt_one hNone
  have hLupper : Real.log (2 * (q : ℝ) * N) ≤ R * H := by
    rw [Real.log_mul (by positivity : (2 * (q : ℝ)) ≠ 0) hNpos.ne',
      Real.log_mul (by norm_num : (2 : ℝ) ≠ 0) hqp.ne']
    have hnle : Real.log N ≤ C₀ * Real.log q := by
      rw [← Real.log_rpow hqp]
      exact Real.log_le_log hNpos hNmax
    have hnon : 0 ≤ Real.log (q : ℝ) := Real.log_nonneg hqone
    dsimp [H, R]
    nlinarith only [hnle, hnon, (le_of_lt (Real.log_pos (by norm_num : (1 : ℝ) < 2))),
      mul_nonneg (le_of_lt (Real.log_pos (by norm_num : (1 : ℝ) < 2))) hnon,
      mul_nonneg hC₀.le hnon, hC₀]
  have hLlo : 0 ≤ Real.log (2 * (q : ℝ) * N) := Real.log_nonneg (by nlinarith [hqp, hNpos])
  have hLE : (Real.log (2 * (q : ℝ) * N)) ^ E ≤ R ^ E * H ^ E := by
    calc
      _ ≤ (R * H) ^ E := Real.rpow_le_rpow hLlo hLupper hE
      _ = R ^ E * H ^ E := Real.mul_rpow hRp.le hHp.le
  have hτ : (q.divisors.card : ℝ) = (2 : ℝ) ^ q.primeFactors.card := by
    rw [squarefree_card_divisors q hq]; norm_cast
  have hmain := hlog (q : ℝ) hqone
  have hpf := hp q hq.ne_zero
  rw [hτ]
  calc
    (Real.log (2 * (q : ℝ) * N)) ^ E *
        ((12 : ℝ) ^ q.primeFactors.card * (2 : ℝ) ^ q.primeFactors.card * H) ≤
        R ^ E * ((24 : ℝ) ^ q.primeFactors.card * H ^ (E + 1)) := by
      have heqr : (24 : ℝ) ^ q.primeFactors.card =
          (12 : ℝ) ^ q.primeFactors.card * (2 : ℝ) ^ q.primeFactors.card := by
        rw [show (24 : ℝ) = 12 * 2 by norm_num, mul_pow]
      rw [heqr, Real.rpow_add hHp E 1, Real.rpow_one]
      have := mul_le_mul_of_nonneg_right hLE
        (mul_nonneg (mul_nonneg (show 0 ≤ (12 : ℝ) ^ q.primeFactors.card by positivity)
          (show 0 ≤ (2 : ℝ) ^ q.primeFactors.card by positivity)) hHp.le)
      nlinarith only [this]
    _ ≤ R ^ E * (D₂ * (q : ℝ) ^ (ε / 2) * (D₁ * (q : ℝ) ^ (ε / 2))) := by
      gcongr
    _ = D * (q : ℝ) ^ ε := by
      have heq : (q : ℝ) ^ (ε / 2) * (q : ℝ) ^ (ε / 2) = (q : ℝ) ^ ε := by
        rw [← Real.rpow_add hqp]; congr 1; ring
      dsimp only [D]
      calc
        _ = R ^ E * (D₁ * D₂) * ((q : ℝ) ^ (ε / 2) * (q : ℝ) ^ (ε / 2)) := by ring
        _ = _ := by rw [heq]

theorem profile_bound_enlargement (a e E L A : ℝ) (ha : 0 ≤ a) (hee : e ≤ E)
    (hL : Real.log 2 ≤ L) (hA : a * max 1 ((Real.log 2) ^ (e - E)) ≤ A) :
    a * L ^ e ≤ A * L ^ E := by
  have h2 : 0 < Real.log (2 : ℝ) := Real.log_pos (by norm_num)
  have hLp : 0 < L := h2.trans_le hL
  have hminus : L ^ (e - E) ≤ (Real.log 2) ^ (e - E) := by
    exact Real.rpow_le_rpow_of_nonpos h2 hL (by linarith)
  calc
    a * L ^ e = (a * L ^ (e - E)) * L ^ E := by
      rw [mul_assoc, ← Real.rpow_add hLp, sub_add_cancel]
    _ ≤ A * L ^ E := by
      gcongr
      exact (mul_le_mul_of_nonneg_left (hminus.trans (le_max_right _ _)) ha).trans hA

end

/--
The mass of the finitely supported sequence `f` in the residue class of `a` modulo `q`, tested
by equality of natural remainders.
-/
noncomputable def progressionMass (f : ℕ →₀ ℂ) (q a : ℕ) : ℂ :=
  ∑ n ∈ f.support, if n % q = a % q then f n else 0

/-- The total mass of `f` on indices coprime to `q`, summing only over its finite support. -/
noncomputable def reducedMass (f : ℕ →₀ ℂ) (q : ℕ) : ℂ :=
  ∑ n ∈ f.support, if Nat.Coprime n q then f n else 0

/--
The mass in one residue class minus the reduced mass divided by Euler's totient. For a reduced
residue class, this measures deviation from equal distribution among the units modulo `q`.
-/
noncomputable def fullDiscrepancy (f : ℕ →₀ ℂ) (q a : ℕ) : ℂ :=
  progressionMass f q a - reducedMass f q / (q.totient : ℂ)

/--
The squarefree product of the distinct prime divisors of `n` that are at most `B`. Prime powers
contribute their prime only once.
-/
def smallPrimePart (B n : ℕ) : ℕ :=
  ∏ p ∈ n.primeFactors.filter (fun p => p ≤ B), p

section
open Set

theorem dickmanRenewalPrefix_le_shifted_dickman (M : ℕ) (hM : 0 < M) (j : ℕ) :
    ((dickmanRenewalPrefix M j).getD j 1 : ℝ) ≤
      dickmanRho (((j : ℝ) + 1) / ((M : ℝ) + 1)) := by
  obtain ⟨_, hinit, _, _, _, _, hanti, hrenewal⟩ := dickmanRho_analytic
  have hden : (0 : ℝ) < (M : ℝ) + 1 := by positivity
  induction j using Nat.strong_induction_on with
  | h j ih =>
      by_cases hj : j ≤ M
      · rw [renewalPrefix_initial M j hj]
        rw [hinit _ ⟨by positivity, ?_⟩]
        · norm_num
        · apply (div_le_one hden).2
          exact_mod_cast Nat.add_le_add_right hj 1
      · have hMj : M < j := by omega
        have hjr : (0 : ℝ) < j := by exact_mod_cast (lt_trans hM hMj)
        let f : ℝ → ℝ := fun t => dickmanRho (t / ((M : ℝ) + 1))
        have hf : AntitoneOn f (Ici 0) := by
          intro x hx y hy hxy
          exact hanti (div_nonneg hx hden.le) (div_nonneg hy hden.le)
            (div_le_div_of_nonneg_right hxy hden.le)
        have hint (a b : ℝ) (ha : 0 ≤ a) (hb : 0 ≤ b) :
            IntervalIntegrable f volume a b := by
          apply AntitoneOn.intervalIntegrable
          exact hf.mono (fun _ ht => (le_min ha hb).trans ht.1)
        have hsum :
            (∑ a ∈ Finset.Ico (j - M) j,
              ((dickmanRenewalPrefix M a).getD a 1 : ℝ)) ≤
            ∫ t in ((j - M : ℕ) : ℝ)..(j : ℝ), f t := by
          calc
            _ ≤ ∑ a ∈ Finset.Ico (j - M) j, f ((a : ℝ) + 1) := by
              apply Finset.sum_le_sum
              intro a ha
              exact ih a (Finset.mem_Ico.mp ha).2
            _ ≤ ∫ t in ((j - M : ℕ) : ℝ)..(j : ℝ), f t := by
              simpa only [Nat.cast_add, Nat.cast_one] using
                AntitoneOn.sum_le_integral_Ico (Nat.sub_le j M)
                  (hf.mono (Icc_subset_Ici_self.trans
                    (Ici_subset_Ici.mpr (Nat.cast_nonneg (j - M)))))
        have hlast : f ((j : ℝ) + 1) ≤ ∫ t in (j : ℝ)..(j : ℝ) + 1, f t := by
          have hb := intervalIntegral.integral_mono_on (show (j : ℝ) ≤ (j : ℝ) + 1 by
            linarith) (intervalIntegrable_const (c := f ((j : ℝ) + 1)))
            (hint _ _ (Nat.cast_nonneg j) (by positivity))
            (fun t ht => hf ((Nat.cast_nonneg j).trans ht.1)
              (show 0 ≤ (j : ℝ) + 1 by positivity) ht.2)
          simpa only [intervalIntegral.integral_const, smul_eq_mul,
            add_sub_cancel_left, one_mul] using hb
        have hunit : (1 : ℝ) ≤ ((j : ℝ) + 1) / ((M : ℝ) + 1) := by
          apply (le_div_iff₀ hden).2
          simpa using (show (M : ℝ) ≤ j by exact_mod_cast hMj.le)
        have hleft : ((j - M : ℕ) : ℝ) / ((M : ℝ) + 1) =
            ((j : ℝ) + 1) / ((M : ℝ) + 1) - 1 := by
          rw [Nat.cast_sub hMj.le]
          field_simp
          ring
        have htotal : (∫ t in ((j - M : ℕ) : ℝ)..(j : ℝ) + 1, f t) =
            ((j : ℝ) + 1) * f ((j : ℝ) + 1) := by
          have hr := hrenewal (((j : ℝ) + 1) / ((M : ℝ) + 1)) (by positivity)
          rw [max_eq_right (sub_nonneg.mpr hunit)] at hr
          dsimp only [f]
          rw [intervalIntegral.integral_comp_div dickmanRho hden.ne', smul_eq_mul,
            hleft, ← hr]
          field_simp
        have hadd := intervalIntegral.integral_add_adjacent_intervals
          (hint _ _ (Nat.cast_nonneg (j - M)) (Nat.cast_nonneg j))
          (hint (j : ℝ) ((j : ℝ) + 1) (Nat.cast_nonneg j) (by positivity))
        rw [htotal] at hadd
        rw [renewalPrefix_recurrence_at M j hM hMj]
        push_cast
        apply (div_le_iff₀ hjr).2
        change (∑ a ∈ Finset.Ico (j - M) j,
          ((dickmanRenewalPrefix M a).getD a 1 : ℝ)) ≤ f ((j : ℝ) + 1) * (j : ℝ)
        nlinarith

theorem dickmanRenewalPrefix_sandwich (M : ℕ) (hM : 2 ≤ M) (j : ℕ) :
    dickmanRho ((j : ℝ) / (M : ℝ)) ≤
        ((dickmanRenewalPrefix M j).getD j 1 : ℝ) ∧
      ((dickmanRenewalPrefix M j).getD j 1 : ℝ) ≤
        dickmanRho (((j : ℝ) + 1) / ((M : ℝ) + 1)) :=
  ⟨renewalPrefix_dickman_le M (by omega) j,
    dickmanRenewalPrefix_le_shifted_dickman M (by omega) j⟩

theorem dickmanRho_sub_le_sub {x y : ℝ} (hx : 1 ≤ x) (hxy : x ≤ y) :
    dickmanRho x - dickmanRho y ≤ y - x := by
  obtain ⟨_, _, hcont, _, hderiv, hrange, _, _⟩ := dickmanRho_analytic
  have hdiff : DifferentiableOn ℝ dickmanRho (interior (Ici 1)) := by
    intro t ht
    rw [interior_Ici] at ht
    exact (hderiv t ht).differentiableAt.differentiableWithinAt
  have hbound : ∀ t ∈ interior (Ici (1 : ℝ)), (-1 : ℝ) ≤ deriv dickmanRho t := by
    intro t ht
    rw [interior_Ici] at ht
    rw [(hderiv t ht).deriv]
    have hdiv : dickmanRho (t - 1) / t ≤ 1 :=
      (div_le_one (lt_trans zero_lt_one ht)).2 ((hrange (t - 1)).2.trans ht.le)
    linarith
  have hb := (convex_Ici (1 : ℝ)).mul_sub_le_image_sub_of_le_deriv
    (hcont.mono (Ici_subset_Ici.mpr zero_le_one)) hdiff hbound x hx y (hx.trans hxy) hxy
  linarith

theorem dickmanRenewalPrefix_bias_le (M : ℕ) (hM : 2 ≤ M) (j : ℕ) :
    0 ≤ ((dickmanRenewalPrefix M j).getD j 1 : ℝ) -
        dickmanRho ((j : ℝ) / (M : ℝ)) ∧
      ((dickmanRenewalPrefix M j).getD j 1 : ℝ) -
          dickmanRho ((j : ℝ) / (M : ℝ)) ≤
        max 0 (((j : ℝ) - (M : ℝ)) / ((M : ℝ) * ((M : ℝ) + 1))) := by
  have hs := dickmanRenewalPrefix_sandwich M hM j
  refine ⟨sub_nonneg.mpr hs.1, ?_⟩
  have hMr : (0 : ℝ) < M := by exact_mod_cast (show 0 < M by omega)
  have hden : (0 : ℝ) < (M : ℝ) + 1 := by positivity
  by_cases hj : j ≤ M
  · rw [renewalPrefix_initial M j hj]
    have hrho := dickmanRho_analytic.2.1 ((j : ℝ) / (M : ℝ))
      ⟨by positivity, (div_le_one hMr).2 (by exact_mod_cast hj)⟩
    simpa only [Rat.cast_one, hrho, sub_self] using
      le_max_left (0 : ℝ) (((j : ℝ) - (M : ℝ)) / ((M : ℝ) * ((M : ℝ) + 1)))
  · have hMj : (M : ℝ) ≤ j := by exact_mod_cast (show M ≤ j by omega)
    have hshift : (1 : ℝ) ≤ ((j : ℝ) + 1) / ((M : ℝ) + 1) := by
      apply (le_div_iff₀ hden).2
      linarith
    have hxy : ((j : ℝ) + 1) / ((M : ℝ) + 1) ≤ (j : ℝ) / (M : ℝ) := by
      apply (div_le_div_iff₀ hden hMr).2
      nlinarith
    have hd := dickmanRho_sub_le_sub hshift hxy
    have heq : (j : ℝ) / (M : ℝ) - ((j : ℝ) + 1) / ((M : ℝ) + 1) =
        ((j : ℝ) - (M : ℝ)) / ((M : ℝ) * ((M : ℝ) + 1)) := by
      field_simp
      ring
    rw [heq] at hd
    exact (sub_le_sub_right hs.2 _).trans (hd.trans (le_max_right _ _))

end

section
open Set

theorem uniform_mixture_eq_withDensity_tail
    (κ : ℝ) (hκ : 0 < κ) (μ : Measure ℝ) [IsProbabilityMeasure μ]
    (hμ : ∀ᵐ z ∂μ, 0 ≤ z) :
    Measure.map (fun p : ℝ × ℝ => p.1 * (κ + p.2))
      ((volume.restrict (Set.Ioc (0 : ℝ) 1)).prod μ) =
        (volume.restrict (Set.Ioi (0 : ℝ))).withDensity
          (fun t => ENNReal.ofReal (∫ z in Set.Ici (t - κ), (κ + z)⁻¹ ∂μ)) := by
  classical
  have hinv : Integrable (fun z : ℝ => (κ + z)⁻¹) μ := by
    apply Integrable.of_bound (by fun_prop) κ⁻¹
    filter_upwards [hμ] with z hz
    rw [Real.norm_eq_abs, abs_of_nonneg (inv_nonneg.mpr (by linarith))]
    exact inv_anti₀ hκ (by linarith)
  have hnonneg : ∀ᵐ z ∂μ, 0 ≤ (κ + z)⁻¹ :=
    hμ.mono fun z hz => inv_nonneg.mpr (by linarith)
  let k : ℝ → ℝ → ℝ≥0∞ := fun t z =>
    if t - κ ≤ z then ENNReal.ofReal ((κ + z)⁻¹) else 0
  have hk : Measurable (Function.uncurry k) := by
    change Measurable (fun p : ℝ × ℝ =>
      if p.1 - κ ≤ p.2 then ENNReal.ofReal ((κ + p.2)⁻¹) else 0)
    exact Measurable.ite
      (measurableSet_le (measurable_fst.sub measurable_const) measurable_snd)
      ((measurable_const.add measurable_snd).inv.ennreal_ofReal) measurable_const
  have htail (t : ℝ) :
      ENNReal.ofReal (∫ z in Ici (t - κ), (κ + z)⁻¹ ∂μ) =
        ∫⁻ z, k t z ∂μ := by
    rw [ofReal_integral_eq_lintegral_ofReal hinv.integrableOn
      (ae_restrict_of_ae hnonneg)]
    change (∫⁻ z in Ici (t - κ), ENNReal.ofReal ((κ + z)⁻¹) ∂μ) =
      ∫⁻ z, (Ici (t - κ)).indicator
        (fun z => ENNReal.ofReal ((κ + z)⁻¹)) z ∂μ
    rw [lintegral_indicator measurableSet_Ici]
  have hF : Measurable (fun p : ℝ × ℝ => p.1 * (κ + p.2)) := by fun_prop
  apply Measure.ext
  intro s hs
  rw [Measure.map_apply hF hs, Measure.prod_apply_symm (hF hs),
    withDensity_apply _ hs, Measure.restrict_restrict hs]
  change (∫⁻ z, (volume.restrict (Ioc (0 : ℝ) 1))
      ((fun u : ℝ => u * (κ + z)) ⁻¹' s) ∂μ) =
    ∫⁻ t in s ∩ Ioi (0 : ℝ),
      ENNReal.ofReal (∫ z in Ici (t - κ), (κ + z)⁻¹ ∂μ)
  simp_rw [htail]
  rw [lintegral_lintegral_swap hk.aemeasurable]
  apply lintegral_congr_ae
  filter_upwards [hμ] with z hz
  have ha : 0 < κ + z := by linarith
  have hpre :
      ((fun u : ℝ => u * (κ + z)) ⁻¹' s) ∩ Ioc (0 : ℝ) 1 =
        (fun u : ℝ => u * (κ + z)) ⁻¹' (s ∩ Ioc (0 : ℝ) (κ + z)) := by
    rw [Set.preimage_inter, Set.preimage_mul_const_Ioc₀ 0 (κ + z) ha]
    simp only [zero_div, div_self ha.ne']
  have hkernel (t : ℝ) :
      k t z = (Iic (κ + z)).indicator
        (fun _ => ENNReal.ofReal ((κ + z)⁻¹)) t := by
    simp only [k, Set.indicator_apply, Set.mem_Iic, sub_le_iff_le_add']
  have hslice : Iic (κ + z) ∩ (s ∩ Ioi (0 : ℝ)) =
      s ∩ Ioc (0 : ℝ) (κ + z) := by
    ext t
    simp only [Set.mem_inter_iff, Set.mem_Iic, Set.mem_Ioi, Set.mem_Ioc]
    tauto
  rw [Measure.restrict_apply' measurableSet_Ioc, hpre,
    Real.volume_preimage_mul_right ha.ne', abs_of_pos (inv_pos.mpr ha)]
  simp_rw [hkernel]
  rw [lintegral_indicator measurableSet_Iic,
    Measure.restrict_restrict measurableSet_Iic, hslice,
    lintegral_const, Measure.restrict_apply_univ]

end

section
open Set

theorem normalized_uniform_perpetuity_eq_dickman
    (κ c : ℝ) (hκ : 0 < κ) (hc : 0 < c)
    (μ : Measure ℝ) [IsProbabilityMeasure μ]
    (hμ : ∀ᵐ z ∂μ, 0 ≤ z)
    (hfixed : μ = Measure.map (fun p : ℝ × ℝ => p.1 * (κ + p.2))
      ((volume.restrict (Ioc (0 : ℝ) 1)).prod μ))
    (hbelow : ((ENNReal.ofReal c) • μ).restrict (Ioo 0 κ) =
      volume.restrict (Ioo 0 κ)) :
    (ENNReal.ofReal c) • μ =
      (volume.restrict (Ici (0 : ℝ))).withDensity
        (fun t => ENNReal.ofReal (dickmanRho (t / κ))) := by
  let f : ℝ → ℝ := fun t => ∫ z in Ici (t - κ), (κ + z)⁻¹ ∂μ
  let A : ℝ := ∫ z, (κ + z)⁻¹ ∂μ
  have hinv : Integrable (fun z : ℝ => (κ + z)⁻¹) μ := by
    apply Integrable.of_bound (by fun_prop) κ⁻¹
    filter_upwards [hμ] with z hz
    rw [Real.norm_eq_abs, abs_of_nonneg (inv_nonneg.mpr (by linarith))]
    exact inv_anti₀ hκ (by linarith)
  have hnonneg : ∀ᵐ z ∂μ, 0 ≤ (κ + z)⁻¹ :=
    hμ.mono fun z hz => inv_nonneg.mpr (by linarith)
  have hA : 0 ≤ A := integral_nonneg_of_ae hnonneg
  have hfnonneg (t : ℝ) : 0 ≤ f t :=
    integral_nonneg_of_ae (ae_restrict_of_ae hnonneg)
  have hinit_tail (t : ℝ) (ht : t ≤ κ) : f t = A := by
    have hres : μ.restrict (Ici (t - κ)) = μ :=
      Measure.restrict_eq_self_of_ae_mem (hμ.mono fun z hz => by
        change t - κ ≤ z
        linarith)
    change (∫ z, (κ + z)⁻¹ ∂μ.restrict (Ici (t - κ))) = A
    rw [hres]
  have hμdensity : μ = (volume.restrict (Ioi (0 : ℝ))).withDensity
      (fun t => ENNReal.ofReal (f t)) :=
    hfixed.trans (uniform_mixture_eq_withDensity_tail κ hκ μ hμ)
  let : NullSingletonClass μ := by
    rw [hμdensity]
    infer_instance
  have hfcontinuous : Continuous f := by
    rw [continuous_iff_continuousAt]
    intro t
    have htail : ContinuousOn
        (fun b : ℝ => ∫ z in Ici b, (κ + z)⁻¹ ∂μ) (Ici (t - κ - 1)) :=
      hinv.integrableOn.continuousOn_Ici_primitive_Ici
    have htailAt : ContinuousAt
        (fun b : ℝ => ∫ z in Ici b, (κ + z)⁻¹ ∂μ) (t - κ) :=
      htail.continuousAt (Ici_mem_nhds (by linarith))
    exact ContinuousAt.comp (f := fun y : ℝ => y - κ) (x := t)
      htailAt (continuousAt_id.sub continuousAt_const)
  have hlocal : μ.restrict (Ioo 0 κ) =
      ENNReal.ofReal A • volume.restrict (Ioo 0 κ) := by
    have h := (uniform_mixture_restrict_and_remainder κ hκ μ hμ).2.2.1
    rw [← hfixed] at h
    exact h
  have hnormalization : c * A = 1 := by
    have h := hbelow
    rw [Measure.restrict_smul, hlocal, smul_smul] at h
    have hv := congrArg (fun ν : Measure ℝ => ν (Ioo 0 κ)) h
    simp only [Measure.smul_apply, smul_eq_mul,
      Measure.restrict_apply measurableSet_Ioo, Set.inter_self,
      Real.volume_Ioo, sub_zero] at hv
    have hr := congrArg ENNReal.toReal hv
    simp only [ENNReal.toReal_mul, ENNReal.toReal_ofReal hc.le,
      ENNReal.toReal_ofReal hA, ENNReal.toReal_ofReal hκ.le] at hr
    apply mul_right_cancel₀ hκ.ne'
    simpa only [one_mul] using hr
  have hres (b : ℝ) : μ.restrict (Ioc 0 b) =
      (volume.restrict (Ioc 0 b)).withDensity (fun z => ENNReal.ofReal (f z)) := by
    rw [hμdensity, restrict_withDensity measurableSet_Ioc,
      Measure.restrict_restrict measurableSet_Ioc]
    rw [inter_eq_left.mpr (show Ioc (0 : ℝ) b ⊆ Ioi 0 from fun _ hz => hz.1)]
  have htransport (b : ℝ) (hb : 0 ≤ b) :
      (∫ z in (0 : ℝ)..b, (κ + z)⁻¹ ∂μ) =
        ∫ z in (0 : ℝ)..b, f z / (κ + z) := by
    calc
      _ = ∫ z in Ioc (0 : ℝ) b, (κ + z)⁻¹ ∂μ :=
        intervalIntegral.integral_of_le hb
      _ = ∫ z in Ioc (0 : ℝ) b, f z * (κ + z)⁻¹ := by
        rw [hres b, integral_withDensity_eq_integral_toReal_smul
          hfcontinuous.measurable.ennreal_ofReal
          (ae_of_all _ fun _ => ENNReal.ofReal_lt_top)]
        apply integral_congr_ae
        exact ae_of_all _ fun z => by
          simp only [ENNReal.toReal_ofReal (hfnonneg z), smul_eq_mul]
      _ = ∫ z in (0 : ℝ)..b, f z / (κ + z) := by
        rw [intervalIntegral.integral_of_le hb]
        simp only [div_eq_mul_inv]
  have hrenewal (t : ℝ) (ht : κ ≤ t) :
      f t = f κ - ∫ z in (0 : ℝ)..t - κ, f z / (κ + z) := by
    have htail : f κ - f t = ∫ z in (0 : ℝ)..t - κ, (κ + z)⁻¹ ∂μ := by
      simpa only [f, sub_self] using
        (intervalIntegral.integral_Ici_sub_Ici'
          (a := (0 : ℝ)) (b := t - κ) hinv.integrableOn hinv.integrableOn)
    rw [htransport (t - κ) (sub_nonneg.mpr ht)] at htail
    linarith only [htail]
  have hdelay (t : ℝ) (ht : κ < t) :
      HasDerivAt f (-(f (t - κ) / t)) t := by
    let k : ℝ → ℝ := fun z => f z / (κ + z)
    have hb : 0 ≤ t - κ := sub_nonneg.mpr ht.le
    have hki : IntervalIntegrable k volume 0 (t - κ) :=
      (hfcontinuous.continuousOn.div
        (continuous_const.add continuous_id).continuousOn
        (fun z hz => ne_of_gt (add_pos_of_pos_of_nonneg hκ hz.1))).intervalIntegrable_of_Icc hb
    have hkm : Measurable k :=
      hfcontinuous.measurable.div (measurable_const.add measurable_id)
    have hkc : ContinuousAt k (t - κ) :=
      hfcontinuous.continuousAt.div (continuousAt_const.add continuousAt_id)
        (ne_of_gt (by linarith))
    have hp := intervalIntegral.integral_hasDerivAt_right hki
      hkm.stronglyMeasurable.stronglyMeasurableAtFilter hkc
    have hd : HasDerivAt
        (fun y : ℝ => f κ - ∫ z in (0 : ℝ)..y - κ, k z)
        (-(f (t - κ) / t)) t := by
      convert! (hasDerivAt_const t (f κ)).sub
        (hp.comp t ((hasDerivAt_id t).sub_const κ)) using 1
      dsimp [k]
      rw [show κ + (t - κ) = t by ring]
      ring
    apply hd.congr_of_eventuallyEq
    filter_upwards [Ioi_mem_nhds ht] with y hy
    exact hrenewal y hy.le
  let q : ℝ → ℝ := fun x => c * f (κ * x)
  have hqcont : ContinuousOn q (Ici 0) :=
    (continuous_const.mul (hfcontinuous.comp (continuous_const.mul continuous_id))).continuousOn
  have hqinit (x : ℝ) (hx : x ∈ Icc (0 : ℝ) 1) : q x = 1 := by
    change c * f (κ * x) = 1
    rw [hinit_tail (κ * x) (by nlinarith [hx.2]), hnormalization]
  have hqdelay (x : ℝ) (hx : 1 < x) : HasDerivAt q (-(q (x - 1) / x)) x := by
    have ht : κ < κ * x := by nlinarith
    have hd := ((hdelay (κ * x) ht).comp x
      ((hasDerivAt_id x).const_mul κ)).const_mul c
    apply hd.congr_deriv
    dsimp [q]
    rw [show κ * x - κ = κ * (x - 1) by ring]
    field_simp [hκ.ne', (show x ≠ 0 by linarith)]
  have hq := dickmanRho_unique q hqcont hqinit hqdelay
  have hdensity (t : ℝ) (ht : 0 ≤ t) :
      c * f t = dickmanRho (t / κ) := by
    have h := hq (div_nonneg ht hκ.le)
    change c * f (κ * (t / κ)) = _ at h
    rw [show κ * (t / κ) = t by field_simp] at h
    exact h
  calc
    (ENNReal.ofReal c) • μ =
        (volume.restrict (Ioi (0 : ℝ))).withDensity
          (fun t => ENNReal.ofReal (c * f t)) := by
      rw [hμdensity, ← withDensity_smul (ENNReal.ofReal c)
        hfcontinuous.measurable.ennreal_ofReal]
      congr 1
      funext t
      simp only [Pi.smul_apply, smul_eq_mul, ENNReal.ofReal_mul hc.le]
    _ = _ := by
      rw [restrict_Ioi_eq_restrict_Ici]
      apply withDensity_congr_ae
      filter_upwards [ae_restrict_mem measurableSet_Ici] with t ht
      rw [hdensity t ht]

theorem normalized_fragmentLaw_mass_eq_dickman
    (κ : ℝ) (hκ : 0 < κ) :
    (ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ)) •
        Measure.map (fun c : FiniteMeasure ℝ => (c.mass : ℝ)) (fragmentLaw κ) =
      (volume.restrict (Set.Ici (0 : ℝ))).withDensity
        (fun t => ENNReal.ofReal (dickmanRho (t / κ))) := by
  let μ := Measure.map (fun c : FiniteMeasure ℝ => (c.mass : ℝ)) (fragmentLaw κ)
  have hm : Measurable (fun c : FiniteMeasure ℝ => (c.mass : ℝ)) := by
    have h : Measurable (fun c : FiniteMeasure ℝ => (c : Measure ℝ) Set.univ) :=
      (Measure.measurable_coe MeasurableSet.univ).comp measurable_subtype_coe
    simpa only [← FiniteMeasure.ennreal_mass, ENNReal.coe_toReal] using h.ennreal_toReal
  let : IsProbabilityMeasure (fragmentLaw κ) := fragmentLaw_isProbabilityMeasure κ
  let : IsProbabilityMeasure μ := inferInstance
  have hμ : ∀ᵐ z ∂μ, 0 ≤ z :=
    (ae_map_iff hm.aemeasurable measurableSet_Ici).2
      (ae_of_all _ fun c => c.mass.coe_nonneg)
  exact normalized_uniform_perpetuity_eq_dickman κ
    (Real.exp Real.eulerMascheroniConstant * κ) hκ (mul_pos (Real.exp_pos _) hκ) μ hμ
    (fragmentLaw_mass_perpetuity κ hκ) (fragmentLaw_mass_restrict_Ioo κ hκ)

end

/--
The arithmetic function obtained by retaining `f n` when `(n : ℝ) ≤ U` and setting all larger
indices to zero.
-/
noncomputable def arithmeticFunctionLowCutoff
    (U : ℝ) (f : ArithmeticFunction ℝ) : ArithmeticFunction ℝ :=
  ⟨fun n ↦ if (n : ℝ) ≤ U then f n else 0, by simp⟩

/--
The complementary high-index part of `f`, supported on indices with `(n : ℝ) > U`. It is defined
by subtracting the low cutoff from `f`.
-/
noncomputable def arithmeticFunctionHighCutoff
    (U : ℝ) (f : ArithmeticFunction ℝ) : ArithmeticFunction ℝ :=
  f - arithmeticFunctionLowCutoff U f

theorem arithmeticFunctionLowCutoff_apply_of_le
    {U : ℝ} {f : ArithmeticFunction ℝ} {n : ℕ}
    (hn : (n : ℝ) ≤ U) :
    arithmeticFunctionLowCutoff U f n = f n := by
  simp [arithmeticFunctionLowCutoff, hn]

theorem arithmeticFunctionHighCutoff_apply_of_le
    {U : ℝ} {f : ArithmeticFunction ℝ} {n : ℕ}
    (hn : (n : ℝ) ≤ U) :
    arithmeticFunctionHighCutoff U f n = 0 := by
  change f n - arithmeticFunctionLowCutoff U f n = 0
  rw [arithmeticFunctionLowCutoff_apply_of_le hn, sub_self]

theorem primeFactors_prod_pow_factorization_dvd_and_coprime_div
    (m n : ℕ) (hm : m ≠ 0) (hn : n ≠ 0) :
    let W : ℕ := ∏ p ∈ m.primeFactors, p ^ (n.factorization p)
    0 < W ∧ W ∣ n ∧
      W.primeFactors = n.primeFactors ∩ m.primeFactors ∧
      Nat.Coprime (n / W) m ∧
      (∀ a : ℕ, a ≠ 0 → Nat.Coprime a m →
        (∏ p ∈ m.primeFactors, p ^ ((a * n).factorization p)) = W) := by
  intro W
  have hpow : ∀ p ∈ m.primeFactors, p ^ (n.factorization p) ≠ 0 :=
    fun p hp ↦ pow_ne_zero _ (Nat.prime_of_mem_primeFactors hp).ne_zero
  have hW : W ≠ 0 := Finset.prod_ne_zero_iff.mpr hpow
  have hfac (p : ℕ) :
      W.factorization p = if p ∈ m.primeFactors then n.factorization p else 0 := by
    change (∏ q ∈ m.primeFactors, q ^ (n.factorization q)).factorization p = _
    rw [Nat.factorization_prod_apply hpow]
    calc
      (∑ q ∈ m.primeFactors, (q ^ (n.factorization q)).factorization p) =
          ∑ q ∈ m.primeFactors, if q = p then n.factorization q else 0 :=
        Finset.sum_congr rfl fun q hq ↦ by
          simp only [(Nat.prime_of_mem_primeFactors hq).factorization_pow, Finsupp.single_apply]
      _ = if p ∈ m.primeFactors then n.factorization p else 0 := by simp
  have hWdvd : W ∣ n := (Nat.factorization_le_iff_dvd hW hn).mp fun p ↦ by
    rw [hfac p]
    split <;> simp
  have hsupport : W.primeFactors = n.primeFactors ∩ m.primeFactors := by
    ext p
    rw [← Nat.support_factorization W, Finsupp.mem_support_iff, Finset.mem_inter,
      ← Nat.support_factorization n, Finsupp.mem_support_iff, hfac p, ite_ne_right_iff,
      and_comm]
  have hquot : Nat.Coprime (n / W) m := by
    apply Nat.coprime_of_dvd
    intro p hp hpquot hpm
    have hpS : p ∈ m.primeFactors := Nat.mem_primeFactors.mpr ⟨hp, hpm, hm⟩
    simpa [Nat.factorization_div hWdvd, Finsupp.tsub_apply, hfac p, hpS] using
      hp.factorization_pos_of_dvd
        ((Nat.div_ne_zero_iff_of_dvd hWdvd).mpr ⟨hn, hW⟩) hpquot
  refine ⟨Nat.pos_of_ne_zero hW, hWdvd, hsupport, hquot, ?_⟩
  intro a ha ham
  change (∏ p ∈ m.primeFactors, p ^ ((a * n).factorization p)) =
    ∏ p ∈ m.primeFactors, p ^ (n.factorization p)
  apply Finset.prod_congr rfl
  intro p hp
  have hpa := (Nat.prime_of_mem_primeFactors hp).coprime_iff_not_dvd.mp
    (ham.of_dvd_right (Nat.dvd_of_mem_primeFactors hp)).symm
  rw [Nat.factorization_mul ha hn, Finsupp.add_apply,
    Nat.factorization_eq_zero_of_not_dvd hpa, zero_add]

end PrimeGap186

section
open scoped ContDiff

theorem PrimeGap186.fragment_divisors_common_cap
    (W : ℕ) (x ρ ζ ζ_a : ℝ) (hx : 1 < x) (hρ : 0 < ρ) :
    let κ := max ζ (ζ_a / ρ)
    (∏ p ∈ PrimeGap186.fragmentPrimes W (x ^ ρ) ζ, p).divisors ⊆
        (∏ p ∈ PrimeGap186.fragmentPrimes W (x ^ ρ) κ, p).divisors ∧
      (∏ p ∈ PrimeGap186.fragmentPrimes W x ζ_a, p).divisors ⊆
        (∏ p ∈ PrimeGap186.fragmentPrimes W (x ^ ρ) κ, p).divisors := by
  intro κ
  have hdiv {R₁ R₂ α β : ℝ} (h : R₁ ^ α ≤ R₂ ^ β) :
      (∏ p ∈ PrimeGap186.fragmentPrimes W R₁ α, p).divisors ⊆
        (∏ p ∈ PrimeGap186.fragmentPrimes W R₂ β, p).divisors := by
    apply Nat.divisors_subset_of_dvd
    · exact Finset.prod_ne_zero_iff.mpr fun p hp =>
        (Nat.prime_of_mem_primesLE (Finset.mem_filter.mp hp).1).ne_zero
    · exact Finset.prod_dvd_prod_of_subset _ _ _
        (Finset.filter_subset_filter _
          (Nat.primesLE_mono (Nat.floor_mono h)))
  constructor
  · apply hdiv
    exact Real.rpow_le_rpow_of_exponent_le
      (Real.one_le_rpow hx.le hρ.le) (le_max_left _ _)
  · apply hdiv
    rw [← Real.rpow_mul (zero_lt_one.trans hx).le]
    exact Real.rpow_le_rpow_of_exponent_le hx.le
      ((div_le_iff₀' hρ).mp (le_max_right ζ (ζ_a / ρ)))

end

namespace PrimeGap186

open Real Finset Asymptotics

section
open Topology

open Classical in
/--
The ordered pairs of distinct primes `p < q`, each between `x ^ ξ` and `x ^ a`, whose product is
strictly below `x ^ a`. The logarithmic product `logb x (p * q)` must lie in the half-open bin
`(l, u]`.
-/
noncomputable def markedPrimePairBin (x ξ a l u : ℝ) : Finset (ℕ × ℕ) :=
  ((Nat.primesLE ⌊x ^ a⌋₊) ×ˢ (Nat.primesLE ⌊x ^ a⌋₊)).filter
    (fun v => v.1 < v.2 ∧ x ^ ξ ≤ (v.1 : ℝ) ∧ x ^ ξ ≤ (v.2 : ℝ) ∧
      l < Real.logb x ((v.1 * v.2 : ℕ) : ℝ) ∧
      Real.logb x ((v.1 * v.2 : ℕ) : ℝ) ≤ u ∧
      ((v.1 * v.2 : ℕ) : ℝ) < x ^ a)

theorem markedPrimePairBin_product_injective (x ξ a l u : ℝ) :
    Set.InjOn (fun v : ℕ × ℕ => v.1 * v.2) (markedPrimePairBin x ξ a l u) := by
  intro v hv w hw he
  change v.1 * v.2 = w.1 * w.2 at he
  obtain ⟨hvbox, hvlt, _⟩ := Finset.mem_filter.mp hv
  obtain ⟨hwbox, hwlt, _⟩ := Finset.mem_filter.mp hw
  have hvp : Nat.Prime v.1 :=
    Nat.prime_of_mem_primesLE (Finset.mem_product.mp hvbox).1
  have hwq : Nat.Prime w.2 :=
    Nat.prime_of_mem_primesLE (Finset.mem_product.mp hwbox).2
  have hwp : Nat.Prime w.1 :=
    Nat.prime_of_mem_primesLE (Finset.mem_product.mp hwbox).1
  have hd : v.1 ∣ w.1 * w.2 := by
    rw [← he]
    exact dvd_mul_right _ _
  rcases hvp.dvd_or_dvd hd with hd | hd
  · have hp : v.1 = w.1 := (Nat.prime_dvd_prime_iff_eq hvp hwp).mp hd
    have hq : v.2 = w.2 := Nat.eq_of_mul_eq_mul_left hvp.pos (by simpa [← hp] using he)
    exact Prod.ext hp hq
  · have hp : v.1 = w.2 := (Nat.prime_dvd_prime_iff_eq hvp hwq).mp hd
    have hq : v.2 = w.1 := Nat.eq_of_mul_eq_mul_left hwq.pos (by
      simpa only [hp, mul_comm w.1 w.2] using he)
    have hvlt' : w.2 < w.1 := by simpa only [hp, hq] using hvlt
    exact False.elim ((not_lt_of_ge hwlt.le) hvlt')

theorem markedPrimePairBin_card_le (x ξ a l u : ℝ) (hx : 1 < x) :
    ((markedPrimePairBin x ξ a l u).card : ℝ) ≤ x ^ u := by
  have hmap : Set.MapsTo (fun v : ℕ × ℕ => v.1 * v.2)
      (markedPrimePairBin x ξ a l u) (Finset.Icc 1 ⌊x ^ u⌋₊) := by
    intro v hv
    obtain ⟨hbox, _, _, _, _, hupper, _⟩ := Finset.mem_filter.mp hv
    have hp := Nat.prime_of_mem_primesLE (Finset.mem_product.mp hbox).1
    have hq := Nat.prime_of_mem_primesLE (Finset.mem_product.mp hbox).2
    have hprod : 0 < v.1 * v.2 := Nat.mul_pos hp.pos hq.pos
    have hprodR : (0 : ℝ) < (v.1 * v.2 : ℕ) := Nat.cast_pos.mpr hprod
    have hbound : ((v.1 * v.2 : ℕ) : ℝ) ≤ x ^ u :=
      (Real.logb_le_iff_le_rpow hx hprodR).mp hupper
    exact Finset.mem_Icc.mpr ⟨hprod,
      (Nat.le_floor_iff (Real.rpow_nonneg (zero_lt_one.trans hx).le u)).mpr hbound⟩
  have hcard := Finset.card_le_card_of_injOn (fun v : ℕ × ℕ => v.1 * v.2)
    hmap (markedPrimePairBin_product_injective x ξ a l u)
  have hcard' : (markedPrimePairBin x ξ a l u).card ≤ ⌊x ^ u⌋₊ := by
    simpa using hcard
  exact (Nat.cast_le.mpr hcard').trans
    (Nat.floor_le (Real.rpow_nonneg (zero_lt_one.trans hx).le u))

theorem eventually_large_prime_coprime_presieving
    (H : Finset ℕ) (ξ : ℝ) (hξ : 0 < ξ) :
    ∀ᶠ x : ℝ in Filter.atTop, ∀ p : ℕ, Nat.Prime p → x ^ ξ ≤ (p : ℝ) →
      Nat.Coprime p (presievingModulus H x) := by
  filter_upwards [eventually_presieving_factor_lt_rpow H ξ hξ] with x hx
  intro p hp hlarge
  apply hp.coprime_iff_not_dvd.mpr
  intro hdiv
  have hmem : p ∈ (presievingModulus H x).primeFactors :=
    Nat.mem_primeFactors.mpr ⟨hp, hdiv, (presieving_pos H x).ne'⟩
  exact (not_lt_of_ge hlarge) (hx p hmem)

theorem fragmentPrimeProduct_coprime_of_large_prime
    (W p : ℕ) (R κ : ℝ) (hR : 0 ≤ R) (hp : Nat.Prime p)
    (hlarge : R ^ κ < (p : ℝ)) :
    Nat.Coprime p (∏ q ∈ fragmentPrimes W R κ, q) := by
  apply Nat.Coprime.prod_right
  intro q hq
  have hmem := (Finset.mem_filter.mp hq).1
  have hqprime := Nat.prime_of_mem_primesLE hmem
  have hqle : (q : ℝ) ≤ R ^ κ :=
    (Nat.cast_le.mpr (Nat.mem_primesLE.mp hmem).1).trans
      (Nat.floor_le (Real.rpow_nonneg hR κ))
  exact Nat.coprime_of_lt_prime hqprime.ne_zero
    (Nat.cast_lt.mp (hqle.trans_lt hlarge)) hp

theorem markedPrimePairBin_coprime_eventually
    (H : Finset ℕ) (ρ κ ξ a l u : ℝ)
    (hξ : 0 < ξ) (hcap : ρ * κ < ξ) :
    ∀ᶠ x : ℝ in Filter.atTop,
      1 < x ∧ ∀ v ∈ markedPrimePairBin x ξ a l u,
        Nat.Coprime (v.1 * v.2) (presievingModulus H x) ∧
        Nat.Coprime (v.1 * v.2)
          (∏ p ∈ fragmentPrimes (presievingModulus H x) (x ^ ρ) κ, p) := by
  filter_upwards [eventually_gt_atTop (1 : ℝ),
    eventually_large_prime_coprime_presieving H ξ hξ] with x hx hW
  refine ⟨hx, ?_⟩
  intro v hv
  obtain ⟨hbox, _, hpbound, hqbound, _⟩ := Finset.mem_filter.mp hv
  have hp := Nat.prime_of_mem_primesLE (Finset.mem_product.mp hbox).1
  have hq := Nat.prime_of_mem_primesLE (Finset.mem_product.mp hbox).2
  have hsmall : (x ^ ρ) ^ κ < x ^ ξ := by
    rw [← Real.rpow_mul (zero_lt_one.trans hx).le]
    exact Real.rpow_lt_rpow_of_exponent_lt hx hcap
  have hpQ := fragmentPrimeProduct_coprime_of_large_prime
    (presievingModulus H x) v.1 (x ^ ρ) κ
      (Real.rpow_nonneg (zero_lt_one.trans hx).le ρ) hp (hsmall.trans_le hpbound)
  have hqQ := fragmentPrimeProduct_coprime_of_large_prime
    (presievingModulus H x) v.2 (x ^ ρ) κ
      (Real.rpow_nonneg (zero_lt_one.trans hx).le ρ) hq (hsmall.trans_le hqbound)
  exact ⟨(hW v.1 hp hpbound).mul_left (hW v.2 hq hqbound), hpQ.mul_left hqQ⟩

end

section
open Topology Real Finset _root_.Filter Asymptotics.Filter

open Classical in
theorem markedPrimePairBin_reciprocal_le_square (x ξ a l u : ℝ) :
    (∑ v ∈ markedPrimePairBin x ξ a l u, 1 / ((v.1 * v.2 : ℕ) : ℝ)) ≤
      (∑ p ∈ (Nat.primesLE ⌊x ^ a⌋₊).filter
        (fun p : ℕ => x ^ ξ ≤ (p : ℝ)), 1 / (p : ℝ)) ^ 2 := by
  let P : Finset ℕ := (Nat.primesLE ⌊x ^ a⌋₊).filter
    (fun p : ℕ => x ^ ξ ≤ (p : ℝ))
  have hsubset : markedPrimePairBin x ξ a l u ⊆ P ×ˢ P := by
    intro v hv
    obtain ⟨hbox, _, hp, hq, _⟩ := Finset.mem_filter.mp hv
    exact Finset.mem_product.mpr
      ⟨Finset.mem_filter.mpr ⟨(Finset.mem_product.mp hbox).1, hp⟩,
        Finset.mem_filter.mpr ⟨(Finset.mem_product.mp hbox).2, hq⟩⟩
  calc
    _ ≤ ∑ v ∈ P ×ˢ P, 1 / ((v.1 * v.2 : ℕ) : ℝ) :=
      Finset.sum_le_sum_of_subset_of_nonneg hsubset (fun _ _ _ => by positivity)
    _ = (∑ p ∈ P, 1 / (p : ℝ)) ^ 2 := by
      simp only [Finset.sum_product, Nat.cast_mul, one_div, mul_inv, pow_two,
        Finset.sum_mul_sum]

open Classical in
theorem markedPrimePairBin_reciprocal_eventually_bounded
    (ξ a : ℝ) (hξ : 0 < ξ) (hξa : ξ ≤ a) :
    ∃ K : ℝ, 0 < K ∧ ∀ᶠ x : ℝ in atTop, ∀ l u : ℝ,
      0 ≤ (∑ v ∈ markedPrimePairBin x ξ a l u, 1 / ((v.1 * v.2 : ℕ) : ℝ)) ∧
      (∑ v ∈ markedPrimePairBin x ξ a l u, 1 / ((v.1 * v.2 : ℕ) : ℝ)) ≤ K := by
  obtain ⟨H, hH, hband⟩ := eventually_prime_reciprocal_band_bounded ξ a hξ hξa
  refine ⟨H ^ 2, sq_pos_of_pos hH, ?_⟩
  filter_upwards [hband] with x hx
  intro l u
  refine ⟨Finset.sum_nonneg (fun _ _ => by positivity), ?_⟩
  exact (markedPrimePairBin_reciprocal_le_square x ξ a l u).trans
    (pow_le_pow_left₀ (Finset.sum_nonneg (fun _ _ => by positivity))
      (by simpa only [one_div] using hx) 2)

end

theorem unordered_prime_pair_sum_prefix
    (A T U : ℝ) (hT : 0 ≤ T) (hTU : T ^ 2 ≤ U) :
    (∑ v ∈ ((Nat.primesLE ⌊U⌋₊) ×ˢ (Nat.primesLE ⌊U⌋₊)).filter
        (fun v => v.1 < v.2 ∧ A ≤ (v.1 : ℝ) ∧ A ≤ (v.2 : ℝ) ∧
          ((v.1 * v.2 : ℕ) : ℝ) ≤ T ^ 2),
      (((v.1 * v.2 : ℕ) : ℝ))⁻¹) =
      ∑ p ∈ (Nat.primesBelow (Nat.ceil T)).filter (fun p : ℕ => A ≤ (p : ℝ)),
        (p : ℝ)⁻¹ *
          ((∑ q ∈ Nat.primesLE ⌊T ^ 2 / (p : ℝ)⌋₊, (q : ℝ)⁻¹) -
            ∑ q ∈ Nat.primesLE p, (q : ℝ)⁻¹) := by
  classical
  let S : Finset (ℕ × ℕ) :=
    ((Nat.primesLE ⌊U⌋₊) ×ˢ (Nat.primesLE ⌊U⌋₊)).filter
      (fun v => v.1 < v.2 ∧ A ≤ (v.1 : ℝ) ∧ A ≤ (v.2 : ℝ) ∧
        ((v.1 * v.2 : ℕ) : ℝ) ≤ T ^ 2)
  let P : Finset ℕ :=
    (Nat.primesBelow (Nat.ceil T)).filter (fun p : ℕ => A ≤ (p : ℝ))
  let Q : ℕ → Finset ℕ := fun p =>
    Nat.primesLE ⌊T ^ 2 / (p : ℝ)⌋₊ \ Nat.primesLE p
  have hmem : ∀ v : ℕ × ℕ, v ∈ S ↔ v.1 ∈ P ∧ v.2 ∈ Q v.1 := by
    rintro ⟨p, q⟩
    constructor
    · intro hv
      obtain ⟨hbox, hpq, hAp, _hAq, hprod⟩ := Finset.mem_filter.mp hv
      have hp : Nat.Prime p :=
        Nat.prime_of_mem_primesLE (Finset.mem_product.mp hbox).1
      have hq : Nat.Prime q :=
        Nat.prime_of_mem_primesLE (Finset.mem_product.mp hbox).2
      have hp0 : (0 : ℝ) < p := by exact_mod_cast hp.pos
      have hpqR : (p : ℝ) < q := by exact_mod_cast hpq
      have hprodR : (p : ℝ) * (q : ℝ) ≤ T ^ 2 := by
        simpa only [Nat.cast_mul] using hprod
      have hpsq : (p : ℝ) ^ 2 < T ^ 2 := by
        nlinarith [mul_pos hp0 (sub_pos.mpr hpqR)]
      have hpT : (p : ℝ) < T := (sq_lt_sq₀ hp0.le hT).mp hpsq
      have hqdiv : (q : ℝ) ≤ T ^ 2 / (p : ℝ) := (le_div_iff₀' hp0).mpr hprodR
      refine ⟨Finset.mem_filter.mpr
        ⟨Nat.mem_primesBelow.mpr ⟨Nat.lt_ceil.mpr hpT, hp⟩, hAp⟩, ?_⟩
      apply Finset.mem_sdiff.mpr
      refine ⟨Nat.mem_primesLE.mpr ⟨Nat.le_floor hqdiv, hq⟩, ?_⟩
      intro hqp
      exact (not_le_of_gt hpq) (Nat.mem_primesLE.mp hqp).1
    · rintro ⟨hpP, hqQ⟩
      obtain ⟨hpBelow, hAp⟩ := Finset.mem_filter.mp hpP
      have hp : Nat.Prime p := Nat.prime_of_mem_primesBelow hpBelow
      obtain ⟨hqUpper, hqNot⟩ := Finset.mem_sdiff.mp hqQ
      obtain ⟨hqFloor, hq⟩ := Nat.mem_primesLE.mp hqUpper
      have hp0 : (0 : ℝ) < p := by exact_mod_cast hp.pos
      have hp1 : (1 : ℝ) ≤ p := by exact_mod_cast hp.one_lt.le
      have hpq : p < q := by
        apply lt_of_not_ge
        intro hqp
        exact hqNot (Nat.mem_primesLE.mpr ⟨hqp, hq⟩)
      have hpqR : (p : ℝ) < q := by exact_mod_cast hpq
      have hqdiv : (q : ℝ) ≤ T ^ 2 / (p : ℝ) := (Nat.le_floor_iff' hq.ne_zero).mp hqFloor
      have hprodR : (p : ℝ) * (q : ℝ) ≤ T ^ 2 := (le_div_iff₀' hp0).mp hqdiv
      have hqU : (q : ℝ) ≤ U :=
        (le_mul_of_one_le_left (Nat.cast_nonneg q) hp1).trans
          (hprodR.trans hTU)
      have hpU : (p : ℝ) ≤ U := hpqR.le.trans hqU
      refine Finset.mem_filter.mpr
        ⟨Finset.mem_product.mpr
          ⟨Nat.mem_primesLE.mpr ⟨Nat.le_floor hpU, hp⟩,
            Nat.mem_primesLE.mpr ⟨Nat.le_floor hqU, hq⟩⟩,
          hpq, hAp, hAp.trans hpqR.le, ?_⟩
      simpa only [Nat.cast_mul] using hprodR
  change (∑ v ∈ S, (((v.1 * v.2 : ℕ) : ℝ))⁻¹) =
    ∑ p ∈ P, (p : ℝ)⁻¹ *
      ((∑ q ∈ Nat.primesLE ⌊T ^ 2 / (p : ℝ)⌋₊, (q : ℝ)⁻¹) -
        ∑ q ∈ Nat.primesLE p, (q : ℝ)⁻¹)
  rw [Finset.sum_finset_product S P Q hmem]
  apply Finset.sum_congr rfl
  intro p hpP
  obtain ⟨hpBelow, _hAp⟩ := Finset.mem_filter.mp hpP
  have hp : Nat.Prime p := Nat.prime_of_mem_primesBelow hpBelow
  have hp0 : (0 : ℝ) < p := by exact_mod_cast hp.pos
  have hpT : (p : ℝ) < T :=
    Nat.lt_ceil.mp (Nat.lt_of_mem_primesBelow hpBelow)
  have hpsq : (p : ℝ) ^ 2 ≤ T ^ 2 := (sq_le_sq₀ hp0.le hT).mpr hpT.le
  have hpdiv : (p : ℝ) ≤ T ^ 2 / (p : ℝ) :=
    (le_div_iff₀ hp0).mpr (by simpa only [pow_two] using hpsq)
  have hsubset : Nat.primesLE p ⊆ Nat.primesLE ⌊T ^ 2 / (p : ℝ)⌋₊ :=
    Nat.primesLE_mono (Nat.le_floor hpdiv)
  have hsplit : (∑ q ∈ Q p, (q : ℝ)⁻¹) =
      (∑ q ∈ Nat.primesLE ⌊T ^ 2 / (p : ℝ)⌋₊, (q : ℝ)⁻¹) -
        ∑ q ∈ Nat.primesLE p, (q : ℝ)⁻¹ :=
    Finset.sum_sdiff_eq_sub (f := fun q : ℕ => (q : ℝ)⁻¹) hsubset
  calc
    (∑ q ∈ Q p, (((p * q : ℕ) : ℝ))⁻¹) =
        (p : ℝ)⁻¹ * ∑ q ∈ Q p, (q : ℝ)⁻¹ := by
      simp only [Nat.cast_mul, mul_inv_rev, mul_comm, Finset.mul_sum]
    _ = (p : ℝ)⁻¹ *
        ((∑ q ∈ Nat.primesLE ⌊T ^ 2 / (p : ℝ)⌋₊, (q : ℝ)⁻¹) -
          ∑ q ∈ Nat.primesLE p, (q : ℝ)⁻¹) := by rw [hsplit]

theorem marked_pair_cdf_difference {ξ l u : ℝ}
    (hξ : 0 < ξ) (hl : 2 * ξ ≤ l) (hlu : l ≤ u) :
    (∫ t in ξ..(u / 2), Real.log ((u - t) / t) / t) -
        (∫ t in ξ..(l / 2), Real.log ((l - t) / t) / t) =
      ∫ s in l..u, Real.log ((s - ξ) / ξ) / s := by
  let f : ℝ → ℝ := fun v => Real.log ((1 - v) / v) / v
  have hl0 : 0 < l := by linarith
  have hu0 : 0 < u := hl0.trans_le hlu
  have hξul : ξ / u ≤ ξ / l := by
    apply (div_le_div_iff₀ hu0 hl0).2
    exact mul_le_mul_of_nonneg_left hlu hξ.le
  have hlhalf : ξ / l ≤ (1 / 2 : ℝ) := by
    apply (div_le_iff₀ hl0).2
    linarith
  have hf : ContinuousOn f (Set.Icc (ξ / u) (1 / 2 : ℝ)) := by
    have hv0 (v : ℝ) (hv : v ∈ Set.Icc (ξ / u) (1 / 2 : ℝ)) :
        0 < v := (div_pos hξ hu0).trans_le hv.1
    have hquot : ContinuousOn (fun v : ℝ => (1 - v) / v)
        (Set.Icc (ξ / u) (1 / 2 : ℝ)) :=
      (continuousOn_const.sub continuousOn_id).div continuousOn_id
        (fun v hv => (hv0 v hv).ne')
    exact (hquot.log (fun v hv =>
      (div_pos (by linarith [hv.2]) (hv0 v hv)).ne')).div continuousOn_id
        (fun v hv => (hv0 v hv).ne')
  have hscale (s : ℝ) (hs : 2 * ξ ≤ s) :
      (∫ t in ξ..(s / 2), Real.log ((s - t) / t) / t) =
        ∫ v in (ξ / s)..(1 / 2 : ℝ), f v := by
    have hs0 : 0 < s := by linarith
    have hbound : ξ / s ≤ (1 / 2 : ℝ) := by
      apply (div_le_iff₀ hs0).2
      linarith
    let g : ℝ → ℝ := fun t => Real.log ((s - t) / t) / t
    have hleft : s * (ξ / s) = ξ := mul_div_cancel₀ ξ hs0.ne'
    have hright : s * (1 / 2 : ℝ) = s / 2 := by ring
    have hsub := intervalIntegral.smul_integral_comp_mul_left g s
      (a := ξ / s) (b := (1 / 2 : ℝ))
    rw [hleft, hright] at hsub
    change (∫ t in ξ..(s / 2), g t) = _
    rw [← hsub, ← intervalIntegral.integral_smul]
    apply intervalIntegral.integral_congr
    intro v hv
    rw [Set.uIcc_of_le hbound] at hv
    have hv0 : 0 < v := (div_pos hξ hs0).trans_le hv.1
    change s * (Real.log ((s - s * v) / (s * v)) / (s * v)) =
      Real.log ((1 - v) / v) / v
    have hratio : (s - s * v) / (s * v) = (1 - v) / v := by
      field_simp [hs0.ne', hv0.ne']
    rw [hratio]
    field_simp [hs0.ne', hv0.ne']
  have hpoint (s : ℝ) (hs : s ∈ Set.uIcc l u) :
      0 < s ∧ ξ / u ≤ ξ / s ∧ ξ / s ≤ (1 / 2 : ℝ) := by
    rw [Set.uIcc_of_le hlu] at hs
    have hs0 : 0 < s := hl0.trans_le hs.1
    refine ⟨hs0, ?_, ?_⟩
    · apply (div_le_div_iff₀ hu0 hs0).2
      exact mul_le_mul_of_nonneg_left hs.2 hξ.le
    · apply (div_le_iff₀ hs0).2
      linarith [hs.1]
  have hder (s : ℝ) (hs : s ∈ Set.uIcc l u) :
      HasDerivAt (fun y : ℝ => ξ / y) (-ξ / s ^ 2) s := by
    simpa only [zero_mul, mul_one, zero_sub] using
      (hasDerivAt_const s ξ).fun_div (hasDerivAt_id' s) (hpoint s hs).1.ne'
  have hdercont : ContinuousOn (fun s : ℝ => -ξ / s ^ 2) (Set.uIcc l u) :=
    continuousOn_const.div (continuousOn_id.pow 2)
      (fun s hs => pow_ne_zero 2 (hpoint s hs).1.ne')
  have himage : ContinuousOn f ((fun s : ℝ => ξ / s) '' Set.uIcc l u) := by
    apply hf.mono
    rintro v ⟨s, hs, rfl⟩
    exact ⟨(hpoint s hs).2.1, (hpoint s hs).2.2⟩
  have hsub := intervalIntegral.integral_comp_mul_deriv' hder hdercont himage
  have hchange :
      (∫ s in l..u, -(Real.log ((s - ξ) / ξ) / s)) =
        ∫ v in (ξ / l)..(ξ / u), f v := by
    rw [← hsub]
    apply intervalIntegral.integral_congr
    intro s hs
    have hs0 := (hpoint s hs).1
    change -(Real.log ((s - ξ) / ξ) / s) =
      (Real.log ((1 - ξ / s) / (ξ / s)) / (ξ / s)) * (-ξ / s ^ 2)
    have hratio : (1 - ξ / s) / (ξ / s) = (s - ξ) / ξ := by
      field_simp [hξ.ne', hs0.ne']
    rw [hratio]
    field_simp [hξ.ne', hs0.ne']
  have hreverse : (∫ v in (ξ / u)..(ξ / l), f v) =
      ∫ s in l..u, Real.log ((s - ξ) / ξ) / s := by
    rw [intervalIntegral.integral_symm (ξ / l) (ξ / u), ← hchange,
      intervalIntegral.integral_neg, neg_neg]
  have hfl : IntervalIntegrable f MeasureTheory.volume (ξ / l) (1 / 2 : ℝ) :=
    ContinuousOn.intervalIntegrable_of_Icc hlhalf
      (hf.mono (Set.Icc_subset_Icc hξul le_rfl))
  have hful : IntervalIntegrable f MeasureTheory.volume (ξ / u) (ξ / l) :=
    ContinuousOn.intervalIntegrable_of_Icc hξul
      (hf.mono (Set.Icc_subset_Icc le_rfl hlhalf))
  rw [hscale u (hl.trans hlu), hscale l hl]
  calc
    _ = ∫ v in (ξ / u)..(ξ / l), f v :=
      sub_eq_iff_eq_add.mpr
        (intervalIntegral.integral_add_adjacent_intervals hful hfl).symm
    _ = _ := hreverse

theorem marked_pair_inner_prefix_error (ξ : ℝ) (hξ : 0 < ξ) :
    ∃ C : ℝ, 0 < C ∧ ∀ x s p : ℝ,
      1 < x → 2 ≤ x ^ ξ → 2 * ξ ≤ s →
      x ^ ξ ≤ p → p ≤ x ^ (s / 2) →
      |((∑ q ∈ Nat.primesLE ⌊x ^ s / p⌋₊, (q : ℝ)⁻¹) -
          ∑ q ∈ Nat.primesLE ⌊p⌋₊, (q : ℝ)⁻¹) -
        Real.log ((s - Real.logb x p) / Real.logb x p)| ≤
        2 * C / (ξ * Real.log x) := by
  obtain ⟨M, C, hC, hbound⟩ := exists_prime_reciprocal_loglog_constant
  refine ⟨C, hC, fun x s p hx hA hs hpA hpB => ?_⟩
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hL : 0 < Real.log x := Real.log_pos hx
  have hAp : 0 < x ^ ξ := Real.rpow_pos_of_pos hx0 ξ
  have hp0 : 0 < p := hAp.trans_le hpA
  have hB0 : 0 < x ^ s / p := div_pos (Real.rpow_pos_of_pos hx0 s) hp0
  have hp2 : 2 ≤ p := hA.trans hpA
  have htlo : ξ ≤ Real.logb x p := (Real.le_logb_iff_rpow_le hx hp0).2 hpA
  have hthi : Real.logb x p ≤ s / 2 := (Real.logb_le_iff_le_rpow hx hp0).2 hpB
  have ht0 : 0 < Real.logb x p := hξ.trans_le htlo
  have hst : 0 < s - Real.logb x p := by linarith
  have hlogp : Real.log p = Real.logb x p * Real.log x := by
    simpa only [Real.logb] using (div_mul_cancel₀ (Real.log p) hL.ne').symm
  have hlogB : Real.log (x ^ s / p) = (s - Real.logb x p) * Real.log x := by
    rw [Real.log_div (Real.rpow_pos_of_pos hx0 s).ne' hp0.ne',
      Real.log_rpow hx0, hlogp]
    ring
  have hAB : x ^ ξ ≤ x ^ s / p := by
    apply (Real.log_le_log_iff hAp hB0).mp
    rw [Real.log_rpow hx0, hlogB]
    exact mul_le_mul_of_nonneg_right (by linarith) hL.le
  have hmain : Real.log (Real.log (x ^ s / p)) - Real.log (Real.log p) =
      Real.log ((s - Real.logb x p) / Real.logb x p) := by
    rw [hlogB, hlogp, Real.log_mul hst.ne' hL.ne',
      Real.log_mul ht0.ne' hL.ne', Real.log_div hst.ne' ht0.ne']
    ring
  have hscale (y : ℝ) (hy : x ^ ξ ≤ y) :
      C / Real.log y ≤ C / (ξ * Real.log x) := by
    apply div_le_div_of_nonneg_left hC.le (mul_pos hξ hL)
    simpa only [Real.log_rpow hx0] using Real.log_le_log hAp hy
  calc
    _ = |((∑ q ∈ Nat.primesLE ⌊x ^ s / p⌋₊, (q : ℝ)⁻¹) -
          Real.log (Real.log (x ^ s / p)) - M) -
        ((∑ q ∈ Nat.primesLE ⌊p⌋₊, (q : ℝ)⁻¹) - Real.log (Real.log p) - M)| := by
      rw [← hmain]
      congr 1
      ring
    _ ≤ C / Real.log (x ^ s / p) + C / Real.log p :=
      (abs_sub _ _).trans (add_le_add (hbound _ (hA.trans hAB)) (hbound _ hp2))
    _ ≤ C / (ξ * Real.log x) + C / (ξ * Real.log x) :=
      add_le_add (hscale _ hAB) (hscale _ hpA)
    _ = _ := by ring

theorem unordered_prime_pair_cumulative_tendsto
    (ξ a s : ℝ) (hξ : 0 < ξ) (hs : 2 * ξ ≤ s) (hsa : s ≤ a) :
    Tendsto
      (fun x : ℝ =>
        ∑ v ∈ ((Nat.primesLE ⌊x ^ a⌋₊) ×ˢ (Nat.primesLE ⌊x ^ a⌋₊)).filter
            (fun v => v.1 < v.2 ∧ x ^ ξ ≤ (v.1 : ℝ) ∧ x ^ ξ ≤ (v.2 : ℝ) ∧
              ((v.1 * v.2 : ℕ) : ℝ) ≤ x ^ s),
          (((v.1 * v.2 : ℕ) : ℝ))⁻¹)
      atTop (nhds (∫ t in ξ..(s / 2), Real.log ((s - t) / t) / t)) := by
  classical
  let P : ℝ → Finset ℕ := fun x =>
    (Nat.primesBelow (Nat.ceil (x ^ (s / 2)))).filter (fun p : ℕ => x ^ ξ ≤ (p : ℝ))
  let f : ℝ → ℝ := fun t => Real.log ((s - t) / t)
  let fp : ℝ → ℝ := fun t => -(s / (t * (s - t)))
  let S : ℝ → ℝ := fun x => ∑ p ∈ P x, (p : ℝ)⁻¹ *
    ((∑ q ∈ Nat.primesLE ⌊x ^ s / (p : ℝ)⌋₊, (q : ℝ)⁻¹) -
      ∑ q ∈ Nat.primesLE p, (q : ℝ)⁻¹)
  let V : ℝ → ℝ := fun x => ∑ p ∈ P x, f (Real.logb x (p : ℝ)) / (p : ℝ)
  have hξs : ξ ≤ s / 2 := by linarith
  have hden (t : ℝ) (ht : t ∈ Set.Icc ξ (s / 2)) : 0 < t ∧ 0 < s - t := by
    constructor <;> linarith [ht.1, ht.2]
  have hf : ∀ t ∈ Set.Icc ξ (s / 2), HasDerivAt f (fp t) t := by
    intro t ht
    obtain ⟨ht0, hst⟩ := hden t ht
    have hd := (((hasDerivAt_id t).const_sub s).div (hasDerivAt_id t) ht0.ne').log
      (div_ne_zero hst.ne' ht0.ne')
    simp only [Pi.div_apply, id_eq] at hd
    convert hd using 1
    dsimp only [fp]
    field_simp [ht0.ne', hst.ne']
    ring
  have hfp : ContinuousOn fp (Set.Icc ξ (s / 2)) := by
    apply ContinuousOn.neg
    apply continuousOn_const.div (continuousOn_id.mul (continuousOn_const.sub continuousOn_id))
    intro t ht
    exact mul_ne_zero (hden t ht).1.ne' (hden t ht).2.ne'
  have hV : Tendsto V atTop (nhds (∫ t in ξ..(s / 2), f t / t)) :=
    prime_band_logarithmic_weight_tendsto ξ (s / 2) hξ hξs f fp hf hfp
  obtain ⟨C, hC, hinner⟩ := marked_pair_inner_prefix_error ξ hξ
  obtain ⟨H, _, hband⟩ := eventually_prime_reciprocal_band_bounded ξ (s / 2) hξ hξs
  have herror : Tendsto (fun x : ℝ => S x - V x) atTop (nhds 0) := by
    rw [tendsto_zero_iff_abs_tendsto_zero]
    apply squeeze_zero' (g := fun x : ℝ => (2 * C * H / ξ) / Real.log x)
      (Eventually.of_forall (fun _ => abs_nonneg _))
    · filter_upwards [eventually_gt_atTop (1 : ℝ),
        (tendsto_rpow_atTop hξ).eventually_ge_atTop 2, hband] with x hx hA hHx
      have hL : 0 < Real.log x := Real.log_pos hx
      have hP (p : ℕ) (hp : p ∈ P x) :
          p.Prime ∧ x ^ ξ ≤ (p : ℝ) ∧ (p : ℝ) < x ^ (s / 2) := by
        obtain ⟨hp', hpA⟩ := Finset.mem_filter.mp hp
        exact ⟨Nat.prime_of_mem_primesBelow hp', hpA,
          Nat.lt_ceil.mp (Nat.mem_primesBelow.mp hp').1⟩
      have hPH : (∑ p ∈ P x, (p : ℝ)⁻¹) ≤ H := by
        apply le_trans (Finset.sum_le_sum_of_subset_of_nonneg ?_ (fun _ _ _ => by positivity)) hHx
        intro p hp
        obtain ⟨hpp, hpA, hpB⟩ := hP p hp
        exact Finset.mem_filter.mpr ⟨Nat.mem_primesLE.mpr
          ⟨Nat.le_floor hpB.le, hpp⟩, hpA⟩
      calc
        |S x - V x| = |∑ p ∈ P x,
            (p : ℝ)⁻¹ * (((∑ q ∈ Nat.primesLE ⌊x ^ s / (p : ℝ)⌋₊, (q : ℝ)⁻¹) -
              ∑ q ∈ Nat.primesLE p, (q : ℝ)⁻¹) - f (Real.logb x (p : ℝ)))| := by
          dsimp only [S, V]
          rw [← Finset.sum_sub_distrib]
          congr 1
          apply Finset.sum_congr rfl
          intro p _
          ring
        _ ≤ ∑ p ∈ P x, (p : ℝ)⁻¹ * (2 * C / (ξ * Real.log x)) := by
          apply (Finset.abs_sum_le_sum_abs _ _).trans
          apply Finset.sum_le_sum
          intro p hp
          obtain ⟨_, hpA, hpB⟩ := hP p hp
          rw [abs_mul, abs_of_nonneg (inv_nonneg.mpr (Nat.cast_nonneg p))]
          apply mul_le_mul_of_nonneg_left _ (inv_nonneg.mpr (Nat.cast_nonneg p))
          simpa only [Nat.floor_natCast, f] using
            hinner x s (p : ℝ) hx hA hs hpA hpB.le
        _ = (∑ p ∈ P x, (p : ℝ)⁻¹) * (2 * C / (ξ * Real.log x)) :=
          (Finset.sum_mul ..).symm
        _ ≤ H * (2 * C / (ξ * Real.log x)) :=
          mul_le_mul_of_nonneg_right hPH (by positivity)
        _ = _ := by ring
    · exact Real.tendsto_log_atTop.const_div_atTop _
  have hS : Tendsto S atTop (nhds (∫ t in ξ..(s / 2), f t / t)) := by
    simpa only [sub_add_cancel, zero_add] using herror.add hV
  apply hS.congr'
  filter_upwards [eventually_gt_atTop (1 : ℝ)] with x hx
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hsq : (x ^ (s / 2)) ^ (2 : ℕ) = x ^ s := by
    rw [← Real.rpow_mul_natCast hx0.le]
    congr 1
    norm_num
  have heq := unordered_prime_pair_sum_prefix (x ^ ξ) (x ^ (s / 2)) (x ^ a)
    (Real.rpow_nonneg hx0.le _) (by rw [hsq]; exact Real.rpow_le_rpow_of_exponent_le hx.le hsa)
  simpa only [hsq, S, P] using heq.symm

theorem markedPrimePairBin_harmonic_tendsto
    (l u : ℝ)
    (hl : 2 * ((9519 : ℝ) / 50000) ≤ l)
    (hlu : l < u) (hu : u ≤ (40481 : ℝ) / 100000) :
    Tendsto
      (fun x : ℝ =>
        ∑ v ∈ markedPrimePairBin x ((9519 : ℝ) / 50000)
            ((40481 : ℝ) / 100000) l u,
          (((v.1 * v.2 : ℕ) : ℝ))⁻¹)
      atTop
      (nhds (∫ s in l..u,
        Real.log ((s - (9519 : ℝ) / 50000) / ((9519 : ℝ) / 50000)) / s)) := by
  classical
  let ξ : ℝ := 9519 / 50000
  let a : ℝ := 40481 / 100000
  let P : ℝ → Finset ℕ := fun x => Nat.primesLE ⌊x ^ a⌋₊
  let C : ℝ → ℝ → Finset (ℕ × ℕ) := fun x s =>
    ((P x) ×ˢ (P x)).filter (fun v =>
      v.1 < v.2 ∧ x ^ ξ ≤ (v.1 : ℝ) ∧ x ^ ξ ≤ (v.2 : ℝ) ∧
        ((v.1 * v.2 : ℕ) : ℝ) ≤ x ^ s)
  let w : ℕ × ℕ → ℝ := fun v => (((v.1 * v.2 : ℕ) : ℝ))⁻¹
  let B : ℝ → ℝ := fun x => ∑ v ∈ markedPrimePairBin x ξ a l u, w v
  let D : ℝ → ℝ := fun x => (∑ v ∈ C x u, w v) - ∑ v ∈ C x l, w v
  have hξ : 0 < ξ := by norm_num [ξ]
  have ha : 0 < a := by norm_num [a]
  have hCu := unordered_prime_pair_cumulative_tendsto ξ a u hξ (hl.trans hlu.le) hu
  have hCl := unordered_prime_pair_cumulative_tendsto ξ a l hξ hl (hlu.le.trans hu)
  have hD : Tendsto D atTop (nhds ((∫ t in ξ..(u / 2), Real.log ((u - t) / t) / t) -
      ∫ t in ξ..(l / 2), Real.log ((l - t) / t) / t)) := hCu.sub hCl
  have herror : Tendsto (fun x : ℝ => B x - D x) atTop (nhds 0) := by
    rw [tendsto_zero_iff_abs_tendsto_zero]
    apply squeeze_zero' (g := fun x : ℝ => (x ^ a)⁻¹)
      (Eventually.of_forall (fun _ => abs_nonneg _))
    · filter_upwards [eventually_gt_atTop (1 : ℝ)] with x hx
      have hx0 : 0 < x := zero_lt_one.trans hx
      have hsub : C x l ⊆ C x u := by
        intro v hv
        obtain ⟨hvP, hlt, hp, hq, hpq⟩ := Finset.mem_filter.mp hv
        exact Finset.mem_filter.mpr ⟨hvP, hlt, hp, hq,
          hpq.trans (Real.rpow_le_rpow_of_exponent_le hx.le hlu.le)⟩
      let Q : Finset (ℕ × ℕ) := C x u \ C x l
      let E : Finset (ℕ × ℕ) := Q.filter (fun v => ¬ ((v.1 * v.2 : ℕ) : ℝ) < x ^ a)
      have hQ (v : ℕ × ℕ) (hv : v ∈ Q) :
          v ∈ (P x) ×ˢ (P x) ∧ v.1 < v.2 ∧
            x ^ ξ ≤ (v.1 : ℝ) ∧ x ^ ξ ≤ (v.2 : ℝ) ∧
            x ^ l < ((v.1 * v.2 : ℕ) : ℝ) ∧
            ((v.1 * v.2 : ℕ) : ℝ) ≤ x ^ u := by
        obtain ⟨hvu, hvl⟩ := Finset.mem_sdiff.mp hv
        obtain ⟨hvP, hlt, hp, hq, hpq⟩ := Finset.mem_filter.mp hvu
        refine ⟨hvP, hlt, hp, hq, ?_, hpq⟩
        by_contra! he
        exact hvl (Finset.mem_filter.mpr ⟨hvP, hlt, hp, hq, he⟩)
      have hbin : markedPrimePairBin x ξ a l u =
          Q.filter (fun v => ((v.1 * v.2 : ℕ) : ℝ) < x ^ a) := by
        ext v
        by_cases hvP : v ∈ (P x) ×ˢ (P x)
        · have hp : v.1.Prime := Nat.prime_of_mem_primesLE (Finset.mem_product.mp hvP).1
          have hq : v.2.Prime := Nat.prime_of_mem_primesLE (Finset.mem_product.mp hvP).2
          have hpq0 : 0 < ((v.1 * v.2 : ℕ) : ℝ) := by
            exact_mod_cast mul_pos hp.pos hq.pos
          simp only [markedPrimePairBin, Q, C, P, Finset.mem_filter,
            Finset.mem_sdiff, ← Real.logb_le_iff_le_rpow hx hpq0, not_and, not_le]
          tauto
        · simp only [markedPrimePairBin, Q, C, P, Finset.mem_filter, Finset.mem_sdiff] at *
          tauto
      have hEvalue (v : ℕ × ℕ) (hv : v ∈ E) :
          ((v.1 * v.2 : ℕ) : ℝ) = x ^ a := by
        obtain ⟨hvQ, hvnot⟩ := Finset.mem_filter.mp hv
        exact le_antisymm ((hQ v hvQ).2.2.2.2.2.trans
          (Real.rpow_le_rpow_of_exponent_le hx.le hu)) (le_of_not_gt hvnot)
      have hEcard : E.card ≤ 1 := by
        apply Finset.card_le_one.mpr
        intro v hv z hz
        have hvQ := hQ v (Finset.mem_filter.mp hv).1
        have hzQ := hQ z (Finset.mem_filter.mp hz).1
        have hvp : v.1.Prime := Nat.prime_of_mem_primesLE (Finset.mem_product.mp hvQ.1).1
        have hzp : z.1.Prime := Nat.prime_of_mem_primesLE (Finset.mem_product.mp hzQ.1).1
        have hzq : z.2.Prime := Nat.prime_of_mem_primesLE (Finset.mem_product.mp hzQ.1).2
        have he : v.1 * v.2 = z.1 * z.2 := by
          exact_mod_cast (hEvalue v hv).trans (hEvalue z hz).symm
        have hvq : v.2.Prime := Nat.prime_of_mem_primesLE (Finset.mem_product.mp hvQ.1).2
        have hperm : List.Perm [v.1, v.2] [z.1, z.2] :=
          _root_.perm_of_prod_eq_prod (by simpa using he)
            (by simpa using And.intro hvp.prime hvq.prime)
            (by simpa using And.intro hzp.prime hzq.prime)
        have hlist : [v.1, v.2] = [z.1, z.2] :=
          List.Perm.eq_of_pairwise' (r := (· ≤ ·))
            (List.pairwise_pair.mpr hvQ.2.1.le) (List.pairwise_pair.mpr hzQ.2.1.le) hperm
        have hp : v.1 = z.1 ∧ v.2 = z.2 := by simpa using hlist
        exact Prod.ext hp.1 hp.2
      have hEsum : (∑ v ∈ E, w v) ≤ (x ^ a)⁻¹ := by
        apply (Finset.sum_le_card_nsmul E w ((x ^ a)⁻¹)
          (fun v hv => (congrArg Inv.inv (hEvalue v hv)).le)).trans
        simpa only [one_nsmul] using
          nsmul_le_nsmul_left (inv_nonneg.mpr (Real.rpow_nonneg hx0.le a)) hEcard
      have hsplit : B x + (∑ v ∈ E, w v) = D x := by
        dsimp only [B, D]
        rw [hbin]
        change (∑ v ∈ Q.filter (fun v => ((v.1 * v.2 : ℕ) : ℝ) < x ^ a), w v) +
          (∑ v ∈ Q.filter (fun v => ¬ ((v.1 * v.2 : ℕ) : ℝ) < x ^ a), w v) = _
        rw [Finset.sum_filter_add_sum_filter_not]
        exact Finset.sum_sdiff_eq_sub hsub
      have hnonneg : 0 ≤ ∑ v ∈ E, w v :=
        Finset.sum_nonneg (fun v _ => inv_nonneg.mpr (Nat.cast_nonneg _))
      have heq : B x - D x = -(∑ v ∈ E, w v) := by linarith
      rw [heq, abs_neg, abs_of_nonneg hnonneg]
      exact hEsum
    · exact (tendsto_rpow_atTop ha).inv_tendsto_atTop
  have hlim := herror.add hD
  rw [marked_pair_cdf_difference hξ hl hlu.le] at hlim
  simpa only [sub_add_cancel, zero_add, B, w, ξ, a] using hlim

end PrimeGap186

namespace MeasureTheory

theorem finiteMeasure_probability_ext_of_laplace_functional
    (P Q : Measure (FiniteMeasure ℝ))
    [IsProbabilityMeasure P] [IsProbabilityMeasure Q]
    (hL : ∀ h : ℝ → ℝ≥0∞, Measurable h →
      (∫⁻ μ, EReal.exp (-((∫⁻ u, h u ∂(μ : Measure ℝ)) : EReal)) ∂P) =
        ∫⁻ μ, EReal.exp (-((∫⁻ u, h u ∂(μ : Measure ℝ)) : EReal)) ∂Q) :
    P = Q := by
  classical
  have heval (s : Set ℝ) (hs : MeasurableSet s) :
      Measurable (fun μ : FiniteMeasure ℝ => μ s) :=
    ((Measure.measurable_coe hs).comp measurable_subtype_coe).ennreal_toNNReal
  have hfinite (d : ℕ) (s : Fin d → Set ℝ) (hs : ∀ j, MeasurableSet (s j)) :
      Measure.map (fun μ : FiniteMeasure ℝ => fun j => μ (s j)) P =
        Measure.map (fun μ : FiniteMeasure ℝ => fun j => μ (s j)) Q := by
    let E := Fin d → ℝ≥0
    let f : FiniteMeasure ℝ → E := fun μ j => μ (s j)
    have hf : Measurable f := measurable_pi_lambda _ fun j => heval (s j) (hs j)
    let P' : ProbabilityMeasure E :=
      ⟨Measure.map f P, inferInstance⟩
    let Q' : ProbabilityMeasure E :=
      ⟨Measure.map f Q, inferInstance⟩
    have htransform (t : Fin d → ℝ≥0) :
        (∫ v, Real.exp (-(∑ j, (t j : ℝ) * (v j : ℝ))) ∂(P' : Measure E)) =
          ∫ v, Real.exp (-(∑ j, (t j : ℝ) * (v j : ℝ))) ∂(Q' : Measure E) := by
      let h : ℝ → ℝ≥0∞ := fun u =>
        ∑ j, (s j).indicator (fun _ => (t j : ℝ≥0∞)) u
      have hh : Measurable h :=
        Finset.measurable_fun_sum _ fun j _ => measurable_const.indicator (hs j)
      have hnonneg (μ : FiniteMeasure ℝ) :
          0 ≤ ∑ j, (t j : ℝ) * (μ (s j) : ℝ) :=
        Finset.sum_nonneg fun j _ => mul_nonneg (t j).coe_nonneg (μ (s j)).coe_nonneg
      have hinner (μ : FiniteMeasure ℝ) :
          (∫⁻ u, h u ∂(μ : Measure ℝ)) =
            ENNReal.ofReal (∑ j, (t j : ℝ) * (μ (s j) : ℝ)) := by
        dsimp only [h]
        rw [lintegral_finsetSum _ (fun j _ => measurable_const.indicator (hs j)),
          ENNReal.ofReal_sum_of_nonneg
            (fun j _ => mul_nonneg (t j).coe_nonneg (μ (s j)).coe_nonneg)]
        apply Finset.sum_congr rfl
        intro j _
        rw [lintegral_indicator_const (hs j), ENNReal.ofReal_mul (t j).coe_nonneg,
          ENNReal.ofReal_coe_nnreal, ENNReal.ofReal_coe_nnreal,
          FiniteMeasure.ennreal_coeFn_eq_coeFn_toMeasure]
      have hexp (μ : FiniteMeasure ℝ) :
          EReal.exp (-((∫⁻ u, h u ∂(μ : Measure ℝ)) : EReal)) =
            ENNReal.ofReal (Real.exp (-(∑ j, (t j : ℝ) * (μ (s j) : ℝ)))) := by
        rw [hinner, ← EReal.coe_ennreal_toReal ENNReal.ofReal_ne_top,
          ENNReal.toReal_ofReal (hnonneg μ), ← EReal.coe_neg, EReal.exp_coe]
      have hLaplace := hL h hh
      simp only [hexp] at hLaplace
      have hc : Continuous (fun v : E =>
          Real.exp (-(∑ j, (t j : ℝ) * (v j : ℝ)))) := by fun_prop
      have hm : Measurable (fun μ : FiniteMeasure ℝ =>
          Real.exp (-(∑ j, (t j : ℝ) * (f μ j : ℝ)))) := hc.measurable.comp hf
      change (∫ v, Real.exp (-(∑ j, (t j : ℝ) * (v j : ℝ))) ∂Measure.map f P) =
        ∫ v, Real.exp (-(∑ j, (t j : ℝ) * (v j : ℝ))) ∂Measure.map f Q
      rw [integral_map hf.aemeasurable hc.aestronglyMeasurable,
        integral_map hf.aemeasurable hc.aestronglyMeasurable,
        integral_eq_lintegral_of_nonneg_ae
          (ae_of_all _ fun _ => (Real.exp_pos _).le) hm.aestronglyMeasurable,
        integral_eq_lintegral_of_nonneg_ae
          (ae_of_all _ fun _ => (Real.exp_pos _).le) hm.aestronglyMeasurable]
      exact congrArg ENNReal.toReal hLaplace
    have hlim : Tendsto (fun _ : ℕ => P') atTop (𝓝 Q') := by
      apply tendsto_of_tight_of_joint_nonnegative_laplace
      · simpa only [Set.range_const] using
          (isTightMeasureSet_singleton (μ := (P' : Measure E)))
      · intro t
        exact tendsto_const_nhds.congr (fun _ => (htransform t).symm)
    exact congrArg (fun η : ProbabilityMeasure E => (η : Measure E))
      (tendsto_nhds_unique tendsto_const_nhds hlim)
  let I := {s : Set ℝ // MeasurableSet s}
  let ev : FiniteMeasure ℝ → I → ℝ≥0 := fun μ s => μ s.val
  have hev : Measurable ev := measurable_pi_lambda _ fun s => heval s.val s.property
  have hrestrict (J : Finset I) :
      (Measure.map ev P).map J.restrict = (Measure.map ev Q).map J.restrict := by
    let e : Fin (Fintype.card J) ≃ J := (Fintype.equivFin J).symm
    let s : Fin (Fintype.card J) → Set ℝ := fun j => (e j).val.val
    have hs (j : Fin (Fintype.card J)) : MeasurableSet (s j) := (e j).val.property
    let f : FiniteMeasure ℝ → Fin (Fintype.card J) → ℝ≥0 := fun μ j => μ (s j)
    let g : (Fin (Fintype.card J) → ℝ≥0) → J → ℝ≥0 := fun v j => v (e.symm j)
    have hf : Measurable f := measurable_pi_lambda _ fun j => heval (s j) (hs j)
    have hg : Measurable g := measurable_pi_lambda _ fun j => measurable_pi_apply (e.symm j)
    have heq := congrArg (Measure.map g) (hfinite (Fintype.card J) s hs)
    change Measure.map g (Measure.map f P) = Measure.map g (Measure.map f Q) at heq
    rw [Measure.map_map hg hf, Measure.map_map hg hf] at heq
    have hcomp : g ∘ f = J.restrict ∘ ev := by
      funext μ j
      simp only [Function.comp_apply, g, f, s, ev, Finset.restrict_def,
        Equiv.apply_symm_apply]
    rw [hcomp] at heq
    simpa only [Measure.map_map
      (J.measurable_restrict (X := fun _ : I => ℝ≥0)) hev] using heq
  have hmap : Measure.map ev P = Measure.map ev Q :=
    IsProjectiveLimit.unique
      (P := fun J : Finset I => (Measure.map ev P).map J.restrict)
      (fun _ => rfl) (fun J => (hrestrict J).symm)
  let m : MeasurableSpace (FiniteMeasure ℝ) := inferInstance
  let mE : MeasurableSpace (I → ℝ≥0) := inferInstance
  have hgenerate : m = mE.comap ev := by
    apply le_antisymm
    · have hev' : @Measurable (FiniteMeasure ℝ) (I → ℝ≥0) (mE.comap ev) mE ev :=
        Measurable.of_comap_le le_rfl
      have hcoe : @Measurable (FiniteMeasure ℝ) (Measure ℝ) (mE.comap ev)
          inferInstance (fun μ => (μ : Measure ℝ)) := by
        apply Measure.measurable_of_measurable_coe
        intro s hs
        have ht := ((measurable_pi_apply (⟨s, hs⟩ : I)).comp hev').coe_nnreal_ennreal
        simpa only [Function.comp_apply, ev,
          FiniteMeasure.ennreal_coeFn_eq_coeFn_toMeasure] using ht
      have hid : @Measurable (FiniteMeasure ℝ) (FiniteMeasure ℝ) (mE.comap ev) m id :=
        hcoe.subtype_mk
      simpa only [MeasurableSpace.comap_id] using hid.comap_le
    · exact hev.comap_le
  apply Measure.ext
  intro s hs
  have hs' : MeasurableSet[mE.comap ev] s := by
    rw [← hgenerate]
    exact hs
  obtain ⟨t, ht, hts⟩ := MeasurableSpace.measurableSet_comap.mp hs'
  rw [← hts, ← Measure.map_apply hev ht, ← Measure.map_apply hev ht]
  exact congrArg (fun η : Measure (I → ℝ≥0) => η t) hmap

end MeasureTheory

namespace PrimeGap186

theorem fragmentLaw_full_configuration_cap_restriction
    (κ c : ℝ) (hc : 0 < c) (hcκ : c ≤ κ) :
    MeasurableSet
      {μ : FiniteMeasure ℝ | (μ : Measure ℝ) (Set.Ioi c) = 0} ∧
      ((ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        fragmentLaw κ).restrict
          {μ : FiniteMeasure ℝ | (μ : Measure ℝ) (Set.Ioi c) = 0}) =
        ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * c) •
          fragmentLaw c := by
  have hκ : 0 < κ := hc.trans_le hcκ
  let C : Set (FiniteMeasure ℝ) :=
    {μ : FiniteMeasure ℝ | (μ : Measure ℝ) (Set.Ioi c) = 0}
  have hC : MeasurableSet C :=
    measurableSet_eq_fun
      ((Measure.measurable_coe measurableSet_Ioi).comp measurable_subtype_coe)
      measurable_const
  let P : Measure (FiniteMeasure ℝ) := (fragmentLaw κ).restrict C
  let a : ℝ≥0∞ := ENNReal.ofReal (c / κ)
  have ha0 : a ≠ 0 := ne_of_gt (ENNReal.ofReal_pos.mpr (div_pos hc hκ))
  have hatop : a ≠ ∞ := ENNReal.ofReal_ne_top
  have : IsProbabilityMeasure (fragmentLaw c) := ⟨by
    simpa using lintegral_exp_neg_fragmentLaw c (fun _ => 0) measurable_const⟩
  have hPmass : P Set.univ = a := by
    simpa [P, C, a] using
      lintegral_exp_neg_fragmentLaw_restrict_cap κ c hc hcκ
        (fun _ => 0) measurable_const
  let N : Measure (FiniteMeasure ℝ) := a⁻¹ • P
  have : IsProbabilityMeasure N := ⟨by
    change (a⁻¹ • P) Set.univ = 1
    rw [Measure.smul_apply, smul_eq_mul, hPmass,
      ENNReal.inv_mul_cancel ha0 hatop]⟩
  have heq : N = fragmentLaw c := by
    apply MeasureTheory.finiteMeasure_probability_ext_of_laplace_functional
    intro h hh
    have hL := lintegral_exp_neg_fragmentLaw_restrict_cap κ c hc hcκ h hh
    change _ = a * _ at hL
    simpa only [N, P, C, lintegral_smul_measure, smul_eq_mul,
      ENNReal.inv_mul_cancel_left ha0 hatop] using
      congrArg (fun t : ℝ≥0∞ => a⁻¹ * t) hL
  have hscaled : P = a • fragmentLaw c := by
    simpa only [N, smul_smul, ENNReal.mul_inv_cancel ha0 hatop, one_smul] using
      congrArg (fun η : Measure (FiniteMeasure ℝ) => a • η) heq
  have hcoefficient :
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) * a =
        ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * c) := by
    dsimp only [a]
    rw [← ENNReal.ofReal_mul
      (mul_nonneg (Real.exp_pos Real.eulerMascheroniConstant).le hκ.le)]
    congr 1
    rw [mul_assoc, mul_div_cancel₀ _ hκ.ne']
  refine ⟨hC, ?_⟩
  rw [Measure.restrict_smul]
  change ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) • P = _
  rw [hscaled, smul_smul, hcoefficient]

section
open Complex

theorem rpow_neg_half_le_modulus_rpow_neg
    {D L q : ℝ} (hD : 0 < D) (hL : 1 ≤ L)
    (hq : 1 ≤ q) (hqL : q ≤ L ^ D) :
    L ^ (-(1 / 2 : ℝ)) ≤ q ^ (-(2 * D)⁻¹) := by
  have hLpos : 0 < L := zero_lt_one.trans_le hL
  have hqpos : 0 < q := zero_lt_one.trans_le hq
  have hexponent : D * (-(2 * D)⁻¹) = -(1 / 2 : ℝ) := by
    field_simp
  calc
    L ^ (-(1 / 2 : ℝ)) = (L ^ D) ^ (-(2 * D)⁻¹) := by
      rw [← Real.rpow_mul hLpos.le, hexponent]
    _ ≤ q ^ (-(2 * D)⁻¹) := by
      apply Real.rpow_le_rpow_of_nonpos hqpos hqL
      exact neg_nonpos.mpr (inv_nonneg.mpr (mul_nonneg (by norm_num) hD.le))

theorem exceptionalZeroPower_lt_exp_neg_sqrtLog
    {D c x q beta : ℝ} (hD : 0 < D) (hc : 0 < c)
    (hx : 0 < x) (hxlog : 1 ≤ Real.log x)
    (hq : 1 ≤ q) (hqlog : q ≤ Real.log x ^ D)
    (hbeta : beta < 1 - c * q ^ (-(2 * D)⁻¹)) :
    x ^ beta < x * Real.exp (-c * Real.sqrt (Real.log x)) := by
  let L := Real.log x
  have hLpos : 0 < L := zero_lt_one.trans_le hxlog
  have hinvPower : L ^ (-(1 / 2 : ℝ)) ≤ q ^ (-(2 * D)⁻¹) :=
    rpow_neg_half_le_modulus_rpow_neg hD hxlog hq hqlog
  have hscaled : c * L ^ (-(1 / 2 : ℝ)) ≤ c * q ^ (-(2 * D)⁻¹) :=
    mul_le_mul_of_nonneg_left hinvPower hc.le
  have hgap : beta < 1 - c * L ^ (-(1 / 2 : ℝ)) := by
    linarith
  have hhalf : L * L ^ (-(1 / 2 : ℝ)) = Real.sqrt L := by
    rw [Real.sqrt_eq_rpow]
    nth_rw 1 [← Real.rpow_one L]
    rw [← Real.rpow_add hLpos]
    norm_num
  have hlogGap : L * beta < L - c * Real.sqrt L := by
    calc
      L * beta < L * (1 - c * L ^ (-(1 / 2 : ℝ))) :=
        mul_lt_mul_of_pos_left hgap hLpos
      _ = L - c * Real.sqrt L := by
        rw [mul_sub, mul_one, mul_left_comm L c, hhalf]
  rw [Real.rpow_def_of_pos hx, ← Real.exp_log hx, ← Real.exp_add]
  rw [Real.exp_lt_exp]
  simpa [L, sub_eq_add_neg] using hlogGap

theorem half_lt_re_of_near_one_scale
    {M q : ℕ} [NeZero q] {rho : ℂ} (hM : 2 ≤ M)
    (hnear : 1 - 1 / ((M : ℝ) ^ 2 *
      Real.log ((q : ℝ) * (|rho.im| + 2))) ≤ rho.re) :
    (1 / 2 : ℝ) < rho.re := by
  let L : ℝ := Real.log ((q : ℝ) * (|rho.im| + 2))
  have hlog : (1 / 2 : ℝ) < L := by
    have hhalf : (1 / 2 : ℝ) < Real.log 2 :=
      (by norm_num : (1 / 2 : ℝ) < 0.6931471803).trans
        Real.log_two_gt_d9
    exact hhalf.trans_le
      (Real.log_le_log zero_lt_two
        (by simpa [L] using two_le_level_height (q := q) rho.im))
  have hMcast : (2 : ℝ) ≤ M := by exact_mod_cast hM
  have hMsquare : (4 : ℝ) ≤ (M : ℝ) ^ 2 := by nlinarith
  have hMpos : (0 : ℝ) < M := zero_lt_two.trans_le hMcast
  have hden : (2 : ℝ) < (M : ℝ) ^ 2 * L := by
    calc
      (2 : ℝ) = 4 * (1 / 2 : ℝ) := by norm_num
      _ ≤ (M : ℝ) ^ 2 * (1 / 2 : ℝ) :=
        mul_le_mul_of_nonneg_right hMsquare (by norm_num)
      _ < (M : ℝ) ^ 2 * L :=
        mul_lt_mul_of_pos_left hlog (sq_pos_of_pos hMpos)
  have hinv : 1 / ((M : ℝ) ^ 2 * L) < (1 / 2 : ℝ) :=
    one_div_lt_one_div_of_lt (by norm_num) hden
  dsimp [L] at hinv
  linarith

theorem rpow_div_le_two_mul_rpow_of_half_le
    {x beta : ℝ} (hx : 0 ≤ x) (hbeta : (1 / 2 : ℝ) ≤ beta) :
    x ^ beta / beta ≤ 2 * x ^ beta := by
  calc
    x ^ beta / beta ≤ x ^ beta / (1 / 2 : ℝ) :=
      div_le_div_of_nonneg_left (Real.rpow_nonneg hx beta) one_half_pos hbeta
    _ = 2 * x ^ beta := by ring

theorem exceptionalZeroRpow_div_lt_two_mul_exp_neg_sqrtLog
    {D c x q beta : ℝ} (hD : 0 < D) (hc : 0 < c)
    (hx : 0 < x) (hxlog : 1 ≤ Real.log x)
    (hq : 1 ≤ q) (hqlog : q ≤ Real.log x ^ D)
    (hbetaHalf : (1 / 2 : ℝ) ≤ beta)
    (hbetaGap : beta < 1 - c * q ^ (-(2 * D)⁻¹)) :
    x ^ beta / beta <
      2 * (x * Real.exp (-c * Real.sqrt (Real.log x))) :=
  (rpow_div_le_two_mul_rpow_of_half_le hx.le hbetaHalf).trans_lt
    (mul_lt_mul_of_pos_left
      (exceptionalZeroPower_lt_exp_neg_sqrtLog
        hD hc hx hxlog hq hqlog hbetaGap) zero_lt_two)

theorem norm_dirichletExplicitFormulaKernel_ofReal_eq_rpow_sub_one_div
    {x beta : ℝ} (hx : 1 ≤ x) (hbeta : 0 < beta) :
    ‖dirichletExplicitFormulaKernel x (beta : ℂ)‖ =
      (x ^ beta - 1) / beta := by
  have hxpos : 0 < x := zero_lt_one.trans_le hx
  have hbetaNe : (beta : ℂ) ≠ 0 :=
    Complex.ofReal_ne_zero.mpr hbeta.ne'
  have hquotientNonneg : 0 ≤ (x ^ beta - 1) / beta :=
    div_nonneg
      (sub_nonneg.mpr (Real.one_le_rpow hx hbeta.le)) hbeta.le
  rw [dirichletExplicitFormulaKernel_eq_cpow_sub_one_div hxpos hbetaNe,
    ← Complex.ofReal_cpow (zero_le_one.trans hx)]
  norm_cast
  exact abs_of_nonneg hquotientNonneg

theorem exists_norm_dirichletExceptionalZeroKernelSum_lt :
    ∀ D : ℝ, 0 < D →
      ∃ c : ℝ, 0 < c ∧
        ∀ M : ℕ, 2 ≤ M →
          ∀ (q : ℕ) [NeZero q]
            (chi : DirichletCharacter ℂ q) (x T : ℝ),
              0 < x → 1 ≤ Real.log x →
                (q : ℝ) ≤ Real.log x ^ D →
                  ‖dirichletExceptionalZeroKernelSum M chi x T‖ <
                    2 * (x * Real.exp
                      (-c * Real.sqrt (Real.log x))) := by
  intro D hD
  let epsilon : ℝ := (2 * D)⁻¹
  have hepsilon : 0 < epsilon := by
    dsimp [epsilon]
    positivity
  obtain ⟨c0, hc0, hzeroFree⟩ :=
    exists_siegelRealCharacterZeroFree epsilon hepsilon
  let c : ℝ := c0 / 2
  have hc : 0 < c := half_pos hc0
  refine ⟨c, hc, ?_⟩
  intro M hM q _ chi x T hx hxlog hqlog
  classical
  let S := dirichletExceptionalLFunctionZerosFinset M chi T
  have htargetPos :
      0 < 2 * (x * Real.exp (-c * Real.sqrt (Real.log x))) := by
    positivity
  rcases S.eq_empty_or_nonempty with hS | hS
  · rw [dirichletExceptionalZeroKernelSum]
    change ‖∑ rho ∈ S,
      (analyticOrderNatAt
        (DirichletCharacter.LFunction chi) rho : ℂ) *
          dirichletExplicitFormulaKernel x rho‖ < _
    rw [hS]
    simpa using htargetPos
  · obtain ⟨rho, hrhoS⟩ := hS
    have hcard : S.card ≤ 1 :=
      card_dirichletExceptionalLFunctionZerosFinset_le_one M chi T
    have hsingle : S = {rho} :=
      Finset.eq_singleton_iff_unique_mem.mpr
        ⟨hrhoS, fun z hz =>
          Finset.card_le_one.mp hcard z hz rho hrhoS⟩
    obtain ⟨hzeroData, _, hnear, _, _, _, psi, hpsi, hchi, hsquare, him,
      horder, _⟩ := mem_dirichletExceptionalLFunctionZerosFinset_iff.mp hrhoS
    subst psi
    have hrhoReal : rho = (rho.re : ℂ) := by
      apply Complex.ext
      · simp
      · simpa using him
    have hzero : DirichletCharacter.LFunction chi (rho.re : ℂ) = 0 := by
      rw [← hrhoReal]
      exact hzeroData.1
    have hbetaGap : rho.re < 1 - c * (q : ℝ) ^ (-(2 * D)⁻¹) := by
      let weight : ℝ := (q : ℝ) ^ (-epsilon)
      have hqPos : (0 : ℝ) < q := Nat.cast_pos.mpr (NeZero.pos q)
      have hweightPos : 0 < weight := Real.rpow_pos_of_pos hqPos _
      have hcLt : c < c0 := half_lt_self hc0
      change rho.re < 1 - c * weight
      by_contra hgap
      have hthreshold : 1 - c0 * weight < 1 - c * weight := by
        nlinarith
      have hinput : 1 - c0 * weight < rho.re :=
        hthreshold.trans_le (le_of_not_gt hgap)
      exact (hzeroFree q chi hpsi.1 hsquare rho.re
        (by simpa [weight] using hinput)) hzero
    have hhalf : (1 / 2 : ℝ) < rho.re :=
      half_lt_re_of_near_one_scale hM hnear
    have hbetaPos : 0 < rho.re :=
      one_half_pos.trans hhalf
    have hxone : 1 ≤ x :=
      (Real.log_nonneg_iff hx).mp (zero_le_one.trans hxlog)
    have hkernel :
        ‖dirichletExplicitFormulaKernel x rho‖ ≤ x ^ rho.re / rho.re := by
      rw [hrhoReal,
        norm_dirichletExplicitFormulaKernel_ofReal_eq_rpow_sub_one_div
          hxone hbetaPos]
      exact div_le_div_of_nonneg_right
        (sub_le_self _ (by norm_num)) hbetaPos.le
    have hq : (1 : ℝ) ≤ q := Nat.one_le_cast.mpr (NeZero.pos q)
    have hquotient :=
      exceptionalZeroRpow_div_lt_two_mul_exp_neg_sqrtLog
        hD hc hx hxlog hq hqlog hhalf.le hbetaGap
    rw [dirichletExceptionalZeroKernelSum]
    change ‖∑ z ∈ S,
      (analyticOrderNatAt
        (DirichletCharacter.LFunction chi) z : ℂ) *
          dirichletExplicitFormulaKernel x z‖ < _
    rw [hsingle]
    simp only [Finset.sum_singleton, horder, Nat.cast_one, one_mul]
    exact hkernel.trans_lt hquotient

theorem exists_siegelWalfisz_norm_twistedChebyshevSum_le :
    ∀ D : ℝ, 0 < D →
      ∃ C c : ℝ, 0 < C ∧ 0 < c ∧
        ∃ X0 : ℕ, 4 ≤ X0 ∧
          ∀ x : ℕ, X0 ≤ x →
            ∀ (q : ℕ) [NeZero q]
              (chi : DirichletCharacter ℂ q), chi ≠ 1 →
                (q : ℝ) ≤ Real.log (x : ℝ) ^ D →
                  ‖twistedChebyshevSum x q chi‖ ≤
                    C * ((x : ℝ) * Real.exp
                      (-c * Real.sqrt (Real.log (x : ℝ)))) := by
  intro D hD
  obtain ⟨K, _hK, hformula⟩ :=
    exists_nat_norm_twistedChebyshevSum_sub_dirichletExplicitFormulaMainZeroTerms_le
  obtain ⟨M, A, hM, _hA, _hcard, hnonexceptional⟩ :=
    exists_nat_exceptional_card_le_one_and_norm_nonexceptionalZeroKernelSum_le
  obtain ⟨cE, hcE, hexceptional⟩ :=
    exists_norm_dirichletExceptionalZeroKernelSum_lt D hD
  let cN : ℝ := 1 / (8 * (M : ℝ) ^ 2)
  let c : ℝ := min cE (min cN (1 / 2 : ℝ))
  let C : ℝ := (K : ℝ) + 96 * (A : ℝ) + 2
  have hcN : 0 < cN := by
    dsimp [cN]
    have hMpos : (0 : ℝ) < M := by exact_mod_cast Nat.zero_lt_of_lt hM
    positivity
  have hc : 0 < c := by
    dsimp [c]
    exact lt_min hcE (lt_min hcN (by norm_num))
  have hC : 0 < C := by
    dsimp [C]
    positivity
  obtain ⟨X0, hX0⟩ := Filter.eventually_atTop.mp
    (eventually_siegelWalfiszHeight_conditions D hD M hM)
  have hX0four : 4 ≤ X0 := (hX0 X0 le_rfl).1
  refine ⟨C, c, hC, hc, X0, hX0four, ?_⟩
  intro x hxX q _ chi hchi hqlog
  obtain ⟨hx, hxlog, hheightTwo, hheightX, hlogHeight,
    habsorbFour, habsorbTwo⟩ := hX0 x hxX
  let T : ℝ := siegelWalfiszHeight x
  let u : ℝ := Real.sqrt (Real.log (x : ℝ))
  have hxReal : (4 : ℝ) ≤ x := by exact_mod_cast hx
  have hxpos : (0 : ℝ) < x := by exact_mod_cast (show 0 < x by omega)
  have hu0 : 0 ≤ u := by dsimp [u]; positivity
  have hqHeight : (q : ℝ) ≤ siegelWalfiszHeight x :=
    hqlog.trans hlogHeight
  have hformulaRaw := hformula q chi T hheightTwo x hx hheightX
  have hformulaHeight :
      ‖twistedChebyshevSum x q chi -
          dirichletExplicitFormulaMainZeroTerms chi (x : ℝ) T‖ ≤
        (K : ℝ) * ((x : ℝ) * Real.exp (-(1 / 2 : ℝ) * u)) := by
    exact hformulaRaw.trans
      (by
        simpa [T, u] using
          (mul_dirichletExplicitFormulaErrorScale_siegelWalfiszHeight_le
            (K : ℝ) (Nat.cast_nonneg K) hxlog hqHeight habsorbFour))
  have hnonexceptionalRaw :=
    hnonexceptional q chi (x : ℝ) T hxReal hheightTwo hheightX
  have hnonexceptionalHeight :
      ‖dirichletNonexceptionalZeroKernelSum M chi (x : ℝ) T‖ ≤
        96 * (A : ℝ) * ((x : ℝ) * Real.exp (-cN * u)) := by
    exact hnonexceptionalRaw.trans
      (by
        simpa [T, u, cN] using
          (dirichletNonexceptionalSiegelWalfiszEnvelope_le
            A M hM hxlog hqHeight habsorbTwo))
  have hexceptionalRaw :=
    hexceptional M hM q chi (x : ℝ) T hxpos hxlog hqlog
  have hcEbound : c ≤ cE := min_le_left _ _
  have hcNbound : c ≤ cN :=
    (min_le_right cE (min cN (1 / 2 : ℝ))).trans (min_le_left _ _)
  have hcHalf : c ≤ (1 / 2 : ℝ) :=
    (min_le_right cE (min cN (1 / 2 : ℝ))).trans (min_le_right _ _)
  have hformulaCommon :
      ‖twistedChebyshevSum x q chi -
          dirichletExplicitFormulaMainZeroTerms chi (x : ℝ) T‖ ≤
        (K : ℝ) * ((x : ℝ) * Real.exp (-c * u)) := by
    apply hformulaHeight.trans
    gcongr
  have hnonexceptionalCommon :
      ‖dirichletNonexceptionalZeroKernelSum M chi (x : ℝ) T‖ ≤
        96 * (A : ℝ) * ((x : ℝ) * Real.exp (-c * u)) := by
    apply hnonexceptionalHeight.trans
    gcongr
  have hexceptionalCommon :
      ‖dirichletExceptionalZeroKernelSum M chi (x : ℝ) T‖ ≤
        2 * ((x : ℝ) * Real.exp (-c * u)) := by
    apply (le_of_lt hexceptionalRaw).trans
    gcongr
  have hpartition :=
    dirichletNontrivialZeroKernelSum_eq_nonexceptional_add_exceptional
      M chi (x : ℝ) T
  have hmainZero :
      dirichletExplicitFormulaMainZeroTerms chi (x : ℝ) T =
        -(dirichletNonexceptionalZeroKernelSum M chi (x : ℝ) T +
          dirichletExceptionalZeroKernelSum M chi (x : ℝ) T) := by
    rw [dirichletExplicitFormulaMainZeroTerms, hpartition, ite_eq_right hchi, zero_sub]
  calc
    ‖twistedChebyshevSum x q chi‖ =
        ‖(twistedChebyshevSum x q chi -
            dirichletExplicitFormulaMainZeroTerms chi (x : ℝ) T) -
          (dirichletNonexceptionalZeroKernelSum M chi (x : ℝ) T +
            dirichletExceptionalZeroKernelSum M chi (x : ℝ) T)‖ := by
      rw [hmainZero, sub_neg_eq_add, add_sub_cancel_right]
    _ ≤ ‖twistedChebyshevSum x q chi -
            dirichletExplicitFormulaMainZeroTerms chi (x : ℝ) T‖ +
          ‖dirichletNonexceptionalZeroKernelSum M chi (x : ℝ) T +
            dirichletExceptionalZeroKernelSum M chi (x : ℝ) T‖ :=
      norm_sub_le _ _
    _ ≤ (K : ℝ) * ((x : ℝ) * Real.exp (-c * u)) +
          (96 * (A : ℝ) * ((x : ℝ) * Real.exp (-c * u)) +
            2 * ((x : ℝ) * Real.exp (-c * u))) := by
      apply add_le_add hformulaCommon
      exact (norm_add_le _ _).trans
        (add_le_add hnonexceptionalCommon hexceptionalCommon)
    _ = C * ((x : ℝ) * Real.exp
        (-c * Real.sqrt (Real.log (x : ℝ)))) := by
      dsimp [C, u]
      ring

end

section
open Set

theorem weightedDirac_sum_restricted_mass_gap
    {ι : Type*} (s : Finset ι) (x : ι → ℝ) (a b : ℝ) (ha : 0 < a) :
    let c : FiniteMeasure ℝ :=
      ∑ i ∈ s,
        let atom : FiniteMeasure ℝ := ⟨Measure.dirac (x i), inferInstance⟩
        (x i).toNNReal • atom
    ((c.restrict (Set.Ioc a b)).mass : ℝ) = 0 ∨
      a < ((c.restrict (Set.Ioc a b)).mass : ℝ) := by
  classical
  intro c
  have hc : (c : Measure ℝ) =
      ∑ i ∈ s, ENNReal.ofReal (x i) • Measure.dirac (x i) := by
    dsimp only [c]
    rw [FiniteMeasure.toMeasure_sum]
    rfl
  simp only [FiniteMeasure.restrict_mass]
  change ((c : Measure ℝ) (Set.Ioc a b)).toReal = 0 ∨
    a < ((c : Measure ℝ) (Set.Ioc a b)).toReal
  by_cases h : ∃ i ∈ s, x i ∈ Set.Ioc a b
  · obtain ⟨i, hi, hxi⟩ := h
    have hle : ENNReal.ofReal (x i) ≤ (c : Measure ℝ) (Set.Ioc a b) := by
      rw [hc, Measure.finsetSum_apply]
      simpa only [Measure.smul_apply, smul_eq_mul,
        Measure.dirac_apply_of_mem hxi, mul_one] using
        (Finset.single_le_sum_of_canonicallyOrdered (s := s)
          (f := fun j => (ENNReal.ofReal (x j) • Measure.dirac (x j)) (Set.Ioc a b))
          hi)
    have hreal := ENNReal.toReal_mono
      (measure_ne_top (c : Measure ℝ) (Set.Ioc a b)) hle
    rw [ENNReal.toReal_ofReal (ha.trans hxi.1).le] at hreal
    exact Or.inr (hxi.1.trans_le hreal)
  · left
    have hz : (c : Measure ℝ) (Set.Ioc a b) = 0 := by
      rw [hc, Measure.finsetSum_apply]
      apply Finset.sum_eq_zero
      intro i hi
      have hxi : x i ∉ Set.Ioc a b := fun hxi => h ⟨i, hi, hxi⟩
      simp only [Measure.smul_apply, smul_eq_mul,
        Measure.dirac_apply' _ measurableSet_Ioc,
        Set.indicator_of_notMem hxi, mul_zero]
    rw [hz, ENNReal.toReal_zero]

theorem primeLogConfiguration_restricted_mass_gap
    (R : ℝ) (r : ℕ) (a b : ℝ) (ha : 0 < a) :
    (((primeLogConfiguration R r).restrict (Set.Ioc a b)).mass : ℝ) = 0 ∨
      a < (((primeLogConfiguration R r).restrict (Set.Ioc a b)).mass : ℝ) := by
  simpa only [primeLogConfiguration] using
    weightedDirac_sum_restricted_mass_gap r.primeFactors
      (fun p : ℕ => Real.log p / Real.log R) a b ha

theorem fragmentLaw_restricted_mass_gap
    (ζ a b : ℝ) (ha : 0 < a) :
    ∀ᵐ c ∂fragmentLaw ζ,
      ((c.restrict (Set.Ioc a b)).mass : ℝ) = 0 ∨
        a < ((c.restrict (Set.Ioc a b)).mass : ℝ) := by
  classical
  let m : FiniteMeasure ℝ → ℝ := fun c => ((c.restrict (Set.Ioc a b)).mass : ℝ)
  let G : Set (FiniteMeasure ℝ) := {c | m c = 0 ∨ a < m c}
  have hm : Measurable m := measurable_restricted_mass _ measurableSet_Ioc
  have hG : MeasurableSet G :=
    (measurableSet_eq_fun hm measurable_const).union
      (measurableSet_lt measurable_const hm)
  have hm_eval (c : FiniteMeasure ℝ) :
      m c = ((c : Measure ℝ) (Set.Ioc a b)).toReal :=
    congrArg (fun t : ℝ≥0 => (t : ℝ)) (FiniteMeasure.restrict_mass c (Set.Ioc a b))
  have hm_zero (c : FiniteMeasure ℝ) :
      m c = 0 ↔ (c : Measure ℝ) (Set.Ioc a b) = 0 := by
    rw [hm_eval, ENNReal.toReal_eq_zero_iff]
    exact or_iff_left (measure_ne_top (c : Measure ℝ) (Set.Ioc a b))
  have hemp (n : ℕ) (x : Fin n → ℝ) : weightedEmpirical n x ∈ G := by
    change (((weightedEmpirical n x).restrict (Set.Ioc a b)).mass : ℝ) = 0 ∨
      a < (((weightedEmpirical n x).restrict (Set.Ioc a b)).mass : ℝ)
    simpa only [weightedEmpirical] using
      weightedDirac_sum_restricted_mass_gap Finset.univ x a b ha
  have hpoisson (μ : FiniteMeasure ℝ) : ∀ᵐ c ∂finitePoissonLaw μ, c ∈ G := by
    unfold finitePoissonLaw
    exact (ae_map_iff measurable_weightedEmpirical_sample.aemeasurable hG).mpr
      (ae_of_all _ fun p => hemp p.1 (fun i : Fin p.1 => p.2 i.val))
  have hprobability (μ : FiniteMeasure ℝ) :
      IsProbabilityMeasure (finitePoissonLaw μ) := ⟨by
    simpa using lintegral_exp_neg_finitePoissonLaw μ (fun _ => 0) measurable_const⟩
  let μ : ℤ → Measure (FiniteMeasure ℝ) :=
    fun k => finitePoissonLaw (cappedDyadicIntensity ζ k)
  let : ∀ k : ℤ, IsProbabilityMeasure (μ k) :=
    fun k => hprobability (cappedDyadicIntensity ζ k)
  let Q : Measure (ℤ → FiniteMeasure ℝ) := Measure.infinitePi μ
  have hcomponents : ∀ᵐ ω ∂Q, ∀ k : ℤ, ω k ∈ G :=
    ae_all_iff.mpr fun k =>
      (measurePreserving_eval_infinitePi μ k).quasiMeasurePreserving.ae
        (hpoisson (cappedDyadicIntensity ζ k))
  have hsum (ω : ℤ → FiniteMeasure ℝ) (hω : ∀ k : ℤ, ω k ∈ G) :
      finiteFragments ω ∈ G := by
    by_cases hf : IsFiniteMeasure (Measure.sum (fun k : ℤ => (ω k : Measure ℝ)))
    · let c : FiniteMeasure ℝ :=
        ⟨Measure.sum (fun k : ℤ => (ω k : Measure ℝ)), hf⟩
      have hfc : finiteFragments ω = c := dite_eq_left hf
      rw [hfc]
      change m c = 0 ∨ a < m c
      by_cases hc : m c = 0
      · exact Or.inl hc
      · have hc0 : (c : Measure ℝ) (Set.Ioc a b) ≠ 0 :=
          fun hz => hc ((hm_zero c).mpr hz)
        obtain ⟨k, hk⟩ : ∃ k : ℤ, (ω k : Measure ℝ) (Set.Ioc a b) ≠ 0 :=
          not_forall.mp (fun hall => hc0 (Measure.sum_apply_eq_zero.mpr hall))
        have hk0 : m (ω k) ≠ 0 := fun hz => hk ((hm_zero (ω k)).mp hz)
        have hkGap := hω k
        change m (ω k) = 0 ∨ a < m (ω k) at hkGap
        have hle : m (ω k) ≤ m c := by
          simp only [hm_eval]
          exact ENNReal.toReal_mono
            (measure_ne_top (c : Measure ℝ) (Set.Ioc a b))
            ((Measure.le_sum (fun j : ℤ => (ω j : Measure ℝ)) k) (Set.Ioc a b))
        exact Or.inr ((hkGap.resolve_left hk0).trans_le hle)
    · have hfc : finiteFragments ω = 0 := dite_eq_right hf
      rw [hfc]
      change m 0 = 0 ∨ a < m 0
      left
      simp [hm_eval]
  change ∀ᵐ c ∂Measure.map finiteFragments Q, c ∈ G
  apply (ae_map_iff measurable_finiteFragments.aemeasurable hG).mpr
  filter_upwards [hcomponents] with ω hω
  exact hsum ω hω

end

theorem moebius_coprime_character_sum_eq_supported_convolution
    (r Y q : ℕ) (hr : 0 < r) (χ : DirichletCharacter ℂ q) :
    (∑ n ∈ Finset.Icc 1 Y,
      if Nat.Coprime n r then χ n * (ArithmeticFunction.moebius n : ℂ) else 0) =
      ∑ d ∈ (Finset.Icc 1 Y).filter
          (fun d : ℕ => d ∈ Nat.factoredNumbers r.primeFactors),
        χ d * ∑ n ∈ Finset.Icc 1 (Y / d),
          χ n * (ArithmeticFunction.moebius n : ℂ) := by
  classical
  let mu : ArithmeticFunction ℂ := ArithmeticFunction.moebius
  let supported : ArithmeticFunction ℂ :=
    ⟨fun n => if n ∈ Nat.factoredNumbers r.primeFactors then 1 else 0,
      by simp [Nat.mem_factoredNumbers]⟩
  let restricted : ArithmeticFunction ℂ :=
    ⟨fun n => if Nat.Coprime n r then mu n else 0, by simp⟩
  have hmu : mu.IsMultiplicative := ArithmeticFunction.isMultiplicative_moebius.intCast
  have hzeta : (ArithmeticFunction.zeta : ArithmeticFunction ℂ).IsMultiplicative :=
    ArithmeticFunction.isMultiplicative_zeta.natCast
  have honeSupported : 1 ∈ Nat.factoredNumbers r.primeFactors := by
    simp [Nat.mem_factoredNumbers]
  have hsupported : supported.IsMultiplicative := by
    refine ⟨?_, ?_⟩
    · change (if (1 : ℕ) ∈ Nat.factoredNumbers r.primeFactors then (1 : ℂ) else 0) = 1
      exact ite_eq_left honeSupported
    · intro m n _
      have hmem : m * n ∈ Nat.factoredNumbers r.primeFactors ↔
          m ∈ Nat.factoredNumbers r.primeFactors ∧ n ∈ Nat.factoredNumbers r.primeFactors :=
        ⟨fun h =>
          ⟨Nat.mem_factoredNumbers_of_dvd h (Nat.dvd_mul_right m n),
            Nat.mem_factoredNumbers_of_dvd h (Nat.dvd_mul_left n m)⟩,
          fun h => Nat.mul_mem_factoredNumbers h.1 h.2⟩
      change (if m * n ∈ Nat.factoredNumbers r.primeFactors then (1 : ℂ) else 0) = _
      simp only [supported, ArithmeticFunction.coe_mk, hmem,
        ite_zero_mul_ite_zero, one_mul]
  have hrestricted : restricted.IsMultiplicative := by
    refine ⟨by simp [restricted, hmu.map_one], ?_⟩
    intro m n hmn
    change (if Nat.Coprime (m * n) r then mu (m * n) else 0) =
      (if Nat.Coprime m r then mu m else 0) * (if Nat.Coprime n r then mu n else 0)
    rw [hmu.map_mul_of_coprime hmn]
    simp only [Nat.coprime_mul_iff_left, ite_zero_mul_ite_zero]
  have hrestricted_zeta :
      restricted * (ArithmeticFunction.zeta : ArithmeticFunction ℂ) = supported := by
    apply (ArithmeticFunction.IsMultiplicative.eq_iff_eq_on_prime_powers _
      (hrestricted.mul hzeta) supported hsupported).2
    intro p k hp
    rcases k with _ | k
    · simpa only [pow_zero] using
        (hrestricted.mul hzeta).map_one.trans hsupported.map_one.symm
    · by_cases hcop : Nat.Coprime p r
      · have hpdiv : p ∣ p ^ (k + 1) := dvd_pow_self p (Nat.succ_ne_zero k)
        have hneone : p ^ (k + 1) ≠ 1 :=
          (one_lt_pow₀ hp.one_lt (Nat.succ_ne_zero k)).ne'
        have hnot : p ^ (k + 1) ∉ Nat.factoredNumbers r.primeFactors := by
          intro h
          have hpr := Nat.mem_factoredNumbers'.mp h p hp hpdiv
          exact (hp.coprime_iff_not_dvd.mp hcop) (Nat.dvd_of_mem_primeFactors hpr)
        have hsame :
            (restricted * (ArithmeticFunction.zeta : ArithmeticFunction ℂ)) (p ^ (k + 1)) =
              (mu * (ArithmeticFunction.zeta : ArithmeticFunction ℂ)) (p ^ (k + 1)) := by
          simp only [ArithmeticFunction.coe_mul_zeta_apply, Nat.sum_divisors_prime_pow hp]
          apply Finset.sum_congr rfl
          intro i _
          change (if Nat.Coprime (p ^ i) r then mu (p ^ i) else 0) = mu (p ^ i)
          exact ite_eq_left (hcop.pow_left i)
        have hcancel : mu * (ArithmeticFunction.zeta : ArithmeticFunction ℂ) = 1 :=
          ArithmeticFunction.coe_moebius_mul_coe_zeta
        rw [hcancel, ArithmeticFunction.one_apply_ne hneone] at hsame
        simpa only [supported, ArithmeticFunction.coe_mk, ite_eq_right hnot] using hsame
      · have hpdiv : p ∣ r := hp.dvd_iff_not_coprime.mpr hcop
        have hpFactor : p ∈ r.primeFactors := hp.mem_primeFactors hpdiv hr.ne'
        have hpowSupported (i : ℕ) : p ^ i ∈ Nat.factoredNumbers r.primeFactors := by
          simpa only [mul_one, Finset.insert_eq_of_mem hpFactor] using
            Nat.pow_mul_mem_factoredNumbers hp i honeSupported
        have hzero (i : ℕ) : restricted (p ^ (i + 1)) = 0 := by
          change (if Nat.Coprime (p ^ (i + 1)) r then mu (p ^ (i + 1)) else 0) = 0
          exact ite_eq_right (fun h => hcop ((Nat.coprime_pow_left_iff (Nat.succ_pos i) p r).mp h))
        calc
          (restricted * (ArithmeticFunction.zeta : ArithmeticFunction ℂ)) (p ^ (k + 1)) =
              ∑ i ∈ Finset.range (k + 1 + 1), restricted (p ^ i) := by
                rw [ArithmeticFunction.coe_mul_zeta_apply, Nat.sum_divisors_prime_pow hp]
          _ = 1 := by
            rw [Finset.sum_range_succ']
            simp only [hzero, Finset.sum_const_zero, pow_zero, hrestricted.map_one,
              zero_add]
          _ = supported (p ^ (k + 1)) := by
            simp only [supported, ArithmeticFunction.coe_mk, ite_eq_left (hpowSupported (k + 1))]
  have hconvolution : supported * mu = restricted := by
    rw [← hrestricted_zeta, mul_assoc]
    have hcancel : (ArithmeticFunction.zeta : ArithmeticFunction ℂ) * mu = 1 :=
      ArithmeticFunction.coe_zeta_mul_coe_moebius
    rw [hcancel, mul_one]
  let f : ArithmeticFunction ℂ := ⟨fun n => χ n * supported n, by simp⟩
  let g : ArithmeticFunction ℂ := ⟨fun n => χ n * mu n, by simp⟩
  have hcharacter (a b : ℕ) :
      χ ((a * b : ℕ) : ZMod q) = χ (a : ZMod q) * χ (b : ZMod q) := by
    rw [Nat.cast_mul, map_mul]
  have htwist (n : ℕ) :
      (f * g) n =
        if Nat.Coprime n r then χ n * (ArithmeticFunction.moebius n : ℂ) else 0 := by
    calc
      (f * g) n = χ n * (supported * mu) n := by
        simp only [ArithmeticFunction.mul_apply, Finset.mul_sum]
        apply Finset.sum_congr rfl
        rintro ⟨a, b⟩ hab
        have hab' : a * b = n := (Nat.mem_divisorsAntidiagonal.mp hab).1
        change (χ a * supported a) * (χ b * mu b) = χ n * (supported a * mu b)
        rw [mul_mul_mul_comm, ← hcharacter, hab']
      _ = χ n * restricted n := by rw [hconvolution]
      _ = _ := by simp [restricted, mu, mul_ite]
  have hinterval (Z : ℕ) : Finset.Ioc 0 Z = Finset.Icc 1 Z :=
    (Finset.Icc_succ_left_eq_Ioc 0 Z).symm
  calc
    (∑ n ∈ Finset.Icc 1 Y,
        if Nat.Coprime n r then χ n * (ArithmeticFunction.moebius n : ℂ) else 0) =
        ∑ n ∈ Finset.Icc 1 Y, (f * g) n :=
      Finset.sum_congr rfl (fun n _ => (htwist n).symm)
    _ = ∑ d ∈ Finset.Icc 1 Y, f d * ∑ n ∈ Finset.Icc 1 (Y / d), g n := by
      simpa only [hinterval] using ArithmeticFunction.sum_Ioc_mul_eq_sum_sum f g Y
    _ = _ := by
      rw [Finset.sum_filter]
      apply Finset.sum_congr rfl
      intro d _
      simp [f, g, supported, mu]

theorem supported_prime_reciprocal_mass_bounds
    (r Y : ℕ) (hr : 0 < r) (T : ℝ) (hT : 0 < T) :
    (∑ d ∈ (Finset.Icc 1 Y).filter
        (fun d : ℕ => d ∈ Nat.factoredNumbers r.primeFactors),
      (d : ℝ)⁻¹) ≤ (r.divisors.card : ℝ) ∧
    (∑ d ∈ (Finset.Icc 1 Y).filter
        (fun d : ℕ => d ∈ Nat.factoredNumbers r.primeFactors ∧ T < (d : ℝ)),
      (d : ℝ)⁻¹) ≤ T ^ (-(1 / 2 : ℝ)) * (r.divisors.card : ℝ) ^ 2 := by
  classical
  have hmass (σ : ℝ) (hσ : 0 < σ) :
      (∑ d ∈ (Finset.Icc 1 Y).filter
          (fun d : ℕ => d ∈ Nat.factoredNumbers r.primeFactors),
        (d : ℝ) ^ (-σ)) ≤
          ∏ p ∈ r.primeFactors, (1 - (p : ℝ) ^ (-σ))⁻¹ := by
    let f : ℕ →* ℝ :=
      { toFun := fun n => (n : ℝ) ^ (-σ)
        map_one' := by simp
        map_mul' := fun m n => by
          rw [Nat.cast_mul, Real.mul_rpow (Nat.cast_nonneg m) (Nat.cast_nonneg n)] }
    have hf_nonneg (n : ℕ) : 0 ≤ f n := Real.rpow_nonneg (Nat.cast_nonneg n) _
    have hprimeNorm {p : ℕ} (hp : p.Prime) : ‖f p‖ < 1 := by
      change ‖(p : ℝ) ^ (-σ)‖ < 1
      rw [Real.norm_of_nonneg (Real.rpow_nonneg (Nat.cast_nonneg p) _)]
      exact Real.rpow_lt_one_of_one_lt_of_neg
        (by exact_mod_cast hp.one_lt) (neg_neg_of_pos hσ)
    have heuler :=
      (EulerProduct.summable_and_hasSum_factoredNumbers_prod_filter_prime_geometric
        hprimeNorm r.primeFactors).2
    have hfilter : r.primeFactors.filter Nat.Prime = r.primeFactors :=
      Finset.filter_true_of_mem (fun p hp => Nat.prime_of_mem_primeFactors hp)
    rw [hfilter] at heuler
    have hfinite := sum_le_hasSum
      ((Finset.Icc 1 Y).subtype (· ∈ Nat.factoredNumbers r.primeFactors))
      (fun n _ => hf_nonneg n) heuler
    rw [Finset.sum_subtype_eq_sum_filter] at hfinite
    exact hfinite
  have htwo : (2 : ℝ) ^ r.primeFactors.card ≤ (r.divisors.card : ℝ) := by
    suffices hnat : 2 ^ r.primeFactors.card ≤ r.divisors.card by
      exact_mod_cast hnat
    rw [Nat.card_divisors hr.ne']
    apply Finset.pow_card_le_prod
    intro p hp
    have hpos := (Nat.prime_of_mem_primeFactors hp).factorization_pos_of_dvd
      hr.ne' (Nat.dvd_of_mem_primeFactors hp)
    omega
  have hfactor_nonneg (p : ℕ) (hp : p.Prime) (σ : ℝ) (hσ : 0 < σ) :
      0 ≤ (1 - (p : ℝ) ^ (-σ))⁻¹ := by
    apply inv_nonneg.mpr
    exact sub_nonneg.mpr
      (Real.rpow_lt_one_of_one_lt_of_neg (by exact_mod_cast hp.one_lt)
        (neg_neg_of_pos hσ)).le
  have hfactor_one (p : ℕ) (hp : p.Prime) :
      (1 - (p : ℝ) ^ (-(1 : ℝ)))⁻¹ ≤ 2 := by
    have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast hp.two_le
    have hinv : (p : ℝ)⁻¹ ≤ (1 / 2 : ℝ) := by
      simpa only [one_div] using
        one_div_le_one_div_of_le (by norm_num : (0 : ℝ) < 2) hp2
    have hden : (1 / 2 : ℝ) ≤ 1 - (p : ℝ) ^ (-(1 : ℝ)) := by
      rw [Real.rpow_neg_one]
      linarith
    have h := one_div_le_one_div_of_le (by norm_num : (0 : ℝ) < 1 / 2) hden
    norm_num [one_div] at h
    exact h
  have hfactor_half (p : ℕ) (hp : p.Prime) :
      (1 - (p : ℝ) ^ (-(1 / 2 : ℝ)))⁻¹ ≤ 4 := by
    have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast hp.two_le
    have hroot : (4 / 3 : ℝ) ≤ Real.sqrt (p : ℝ) := by
      nlinarith [Real.sq_sqrt (Nat.cast_nonneg p), Real.sqrt_nonneg (p : ℝ)]
    have hpow : (4 / 3 : ℝ) ≤ (p : ℝ) ^ (1 / 2 : ℝ) := by
      rwa [Real.sqrt_eq_rpow] at hroot
    have hinv : (p : ℝ) ^ (-(1 / 2 : ℝ)) ≤ (3 / 4 : ℝ) := by
      rw [Real.rpow_neg (Nat.cast_nonneg p)]
      have h := one_div_le_one_div_of_le (by norm_num : (0 : ℝ) < 4 / 3) hpow
      norm_num [one_div] at h
      exact h
    have hden : (1 / 4 : ℝ) ≤ 1 - (p : ℝ) ^ (-(1 / 2 : ℝ)) := by linarith
    have h := one_div_le_one_div_of_le (by norm_num : (0 : ℝ) < 1 / 4) hden
    norm_num [one_div] at h
    exact h
  have hfirst :
      (∑ d ∈ (Finset.Icc 1 Y).filter
          (fun d : ℕ => d ∈ Nat.factoredNumbers r.primeFactors),
        (d : ℝ)⁻¹) ≤ (r.divisors.card : ℝ) := by
    calc
      _ ≤ ∏ p ∈ r.primeFactors, (1 - (p : ℝ) ^ (-(1 : ℝ)))⁻¹ := by
        simpa only [Real.rpow_neg_one] using hmass 1 zero_lt_one
      _ ≤ ∏ _p ∈ r.primeFactors, (2 : ℝ) :=
        Finset.prod_le_prod
          (fun p hp => hfactor_nonneg p (Nat.prime_of_mem_primeFactors hp) 1 zero_lt_one)
          (fun p hp => hfactor_one p (Nat.prime_of_mem_primeFactors hp))
      _ = (2 : ℝ) ^ r.primeFactors.card := Finset.prod_const _
      _ ≤ _ := htwo
  have hhalf :
      (∑ d ∈ (Finset.Icc 1 Y).filter
          (fun d : ℕ => d ∈ Nat.factoredNumbers r.primeFactors),
        (d : ℝ) ^ (-(1 / 2 : ℝ))) ≤ (r.divisors.card : ℝ) ^ 2 := by
    calc
      _ ≤ ∏ p ∈ r.primeFactors, (1 - (p : ℝ) ^ (-(1 / 2 : ℝ)))⁻¹ :=
        hmass (1 / 2) (by norm_num)
      _ ≤ ∏ _p ∈ r.primeFactors, (4 : ℝ) :=
        Finset.prod_le_prod
          (fun p hp => hfactor_nonneg p (Nat.prime_of_mem_primeFactors hp) (1 / 2)
            (by norm_num))
          (fun p hp => hfactor_half p (Nat.prime_of_mem_primeFactors hp))
      _ = (4 : ℝ) ^ r.primeFactors.card := Finset.prod_const _
      _ = ((2 : ℝ) ^ r.primeFactors.card) ^ 2 := by
        rw [show (4 : ℝ) = 2 ^ 2 by norm_num, pow_right_comm]
      _ ≤ _ := pow_le_pow_left₀ (pow_nonneg zero_le_two _) htwo 2
  refine ⟨hfirst, ?_⟩
  let S := (Finset.Icc 1 Y).filter
    (fun d : ℕ => d ∈ Nat.factoredNumbers r.primeFactors)
  let S' := (Finset.Icc 1 Y).filter
    (fun d : ℕ => d ∈ Nat.factoredNumbers r.primeFactors ∧ T < (d : ℝ))
  have hsubset : S' ⊆ S :=
    Finset.monotone_filter_right (Finset.Icc 1 Y) (fun _ _ hd => hd.1)
  have hTpower : 0 ≤ T ^ (-(1 / 2 : ℝ)) := Real.rpow_nonneg hT.le _
  change (∑ d ∈ S', (d : ℝ)⁻¹) ≤ _
  calc
    (∑ d ∈ S', (d : ℝ)⁻¹) ≤
        ∑ d ∈ S', T ^ (-(1 / 2 : ℝ)) * (d : ℝ) ^ (-(1 / 2 : ℝ)) := by
      apply Finset.sum_le_sum
      intro d hd
      obtain ⟨hdY, _, hTd⟩ := Finset.mem_filter.mp hd
      have hdpos : (0 : ℝ) < d := by
        exact_mod_cast (Finset.mem_Icc.mp hdY).1
      have hcompare : (d : ℝ) ^ (-(1 / 2 : ℝ)) ≤ T ^ (-(1 / 2 : ℝ)) :=
        Real.rpow_le_rpow_of_nonpos hT hTd.le (by norm_num)
      calc
        (d : ℝ)⁻¹ = (d : ℝ) ^ (-(1 / 2 : ℝ)) * (d : ℝ) ^ (-(1 / 2 : ℝ)) := by
          rw [← Real.rpow_add hdpos]
          norm_num [Real.rpow_neg_one]
        _ ≤ _ := mul_le_mul_of_nonneg_right hcompare
          (Real.rpow_nonneg (Nat.cast_nonneg d) _)
    _ = T ^ (-(1 / 2 : ℝ)) * ∑ d ∈ S', (d : ℝ) ^ (-(1 / 2 : ℝ)) :=
      (Finset.mul_sum S' (fun d => (d : ℝ) ^ (-(1 / 2 : ℝ))) _).symm
    _ ≤ T ^ (-(1 / 2 : ℝ)) * ∑ d ∈ S, (d : ℝ) ^ (-(1 / 2 : ℝ)) :=
      mul_le_mul_of_nonneg_left
        (Finset.sum_le_sum_of_subset_of_nonneg hsubset
          (fun d _ _ => Real.rpow_nonneg (Nat.cast_nonneg d) _)) hTpower
    _ ≤ _ := mul_le_mul_of_nonneg_left hhalf hTpower

theorem moebius_coprime_character_siegelWalfisz :
    ∀ D : ℝ, 0 < D → ∃ C c : ℝ, 0 < C ∧ 0 < c ∧
      ∃ Y₀ : ℕ, 4 ≤ Y₀ ∧ ∀ Y : ℕ, Y₀ ≤ Y →
        ∀ (q r : ℕ) [NeZero q] (χ : DirichletCharacter ℂ q),
          0 < r → (q : ℝ) ≤ (Real.log (Y : ℝ)) ^ D →
            ‖∑ n ∈ Finset.Icc 1 Y,
              if Nat.Coprime n r then
                χ n * (ArithmeticFunction.moebius n : ℂ) else 0‖ ≤
              C * (r.divisors.card : ℝ) ^ 2 * (Y : ℝ) *
                Real.exp (-c * Real.sqrt (Real.log (Y : ℝ))) := by
  classical
  intro D hD
  obtain ⟨C₀, c₀, hC₀, hc₀, X₀, _, hsw⟩ :=
    unconditional_moebiusCharacterSiegelWalfisz (D + 1) (by linarith)
  have hlogTop : Tendsto (fun Y : ℕ => Real.log (Y : ℝ)) atTop atTop :=
    Real.tendsto_log_atTop.comp tendsto_natCast_atTop_atTop
  have hsqrtTop : Tendsto (fun Y : ℕ => Real.sqrt (Y : ℝ)) atTop atTop :=
    Real.tendsto_sqrt_atTop.comp tendsto_natCast_atTop_atTop
  have hconditions : ∀ᶠ Y : ℕ in atTop,
      4 ≤ Y ∧ 1 ≤ Real.log (Y : ℝ) ∧
        4 * Real.log 2 ≤ Real.log (Y : ℝ) ∧
        c₀ ^ 2 ≤ Real.log (Y : ℝ) ∧
        (4 : ℝ) ^ (D + 1) ≤ Real.log (Y : ℝ) ∧
        2 ≤ Real.sqrt (Y : ℝ) ∧
        2 * (X₀ : ℝ) ≤ Real.sqrt (Y : ℝ) := by
    filter_upwards [eventually_ge_atTop (4 : ℕ),
      hlogTop.eventually (eventually_ge_atTop 1),
      hlogTop.eventually (eventually_ge_atTop (4 * Real.log 2)),
      hlogTop.eventually (eventually_ge_atTop (c₀ ^ 2)),
      hlogTop.eventually (eventually_ge_atTop ((4 : ℝ) ^ (D + 1))),
      hsqrtTop.eventually (eventually_ge_atTop 2),
      hsqrtTop.eventually (eventually_ge_atTop (2 * (X₀ : ℝ)))]
      with Y hY hL hLtwo hLc hLD hroot hrootX
    exact ⟨hY, hL, hLtwo, hLc, hLD, hroot, hrootX⟩
  obtain ⟨Y₁, hY₁⟩ := Filter.eventually_atTop.mp hconditions
  refine ⟨C₀ + 1, c₀ / 4, by positivity, by positivity,
    max 4 Y₁, le_max_left _ _, ?_⟩
  intro Y hY q r _ χ hr hq
  obtain ⟨hYfour, hLone, hLtwo, hLc, hLD, hrootTwo, hrootX⟩ :=
    hY₁ Y ((le_max_right _ _).trans hY)
  have hYpos : (0 : ℝ) < Y := by exact_mod_cast (show 0 < Y by omega)
  have hLpos : 0 < Real.log (Y : ℝ) := by linarith
  have hrootpos : 0 < Real.sqrt (Y : ℝ) := Real.sqrt_pos.mpr hYpos
  have htau : (1 : ℝ) ≤ r.divisors.card := by
    exact_mod_cast Finset.one_le_card.mpr ⟨1, Nat.one_mem_divisors.mpr hr.ne'⟩
  have htauSq : (r.divisors.card : ℝ) ≤ (r.divisors.card : ℝ) ^ 2 :=
    le_self_pow₀ htau two_ne_zero
  let S := (Finset.Icc 1 Y).filter
    (fun d : ℕ => d ∈ Nat.factoredNumbers r.primeFactors)
  let F : ℕ → ℂ := fun d =>
    χ d * ∑ n ∈ Finset.Icc 1 (Y / d), χ n * (ArithmeticFunction.moebius n : ℂ)
  let E₀ : ℝ := Real.exp (-(c₀ / 2) * Real.sqrt (Real.log (Y : ℝ)))
  let E : ℝ := Real.exp (-(c₀ / 4) * Real.sqrt (Real.log (Y : ℝ)))
  have hEpos : 0 < E := Real.exp_pos _
  have hEcompare : E₀ ≤ E := by
    apply Real.exp_le_exp.mpr
    nlinarith [mul_nonneg hc₀.le (Real.sqrt_nonneg (Real.log (Y : ℝ)))]
  have htailDecay : Real.sqrt (Y : ℝ) ^ (-(1 / 2 : ℝ)) ≤ E := by
    rw [Real.rpow_def_of_pos hrootpos, Real.log_sqrt (Nat.cast_nonneg Y)]
    apply Real.exp_le_exp.mpr
    have hcu : c₀ ≤ Real.sqrt (Real.log (Y : ℝ)) :=
      Real.le_sqrt_of_sq_le hLc
    have hmul := mul_le_mul_of_nonneg_right hcu
      (Real.sqrt_nonneg (Real.log (Y : ℝ)))
    nlinarith [Real.sq_sqrt hLpos.le]
  obtain ⟨hmass, htail⟩ :=
    supported_prime_reciprocal_mass_bounds r Y hr (Real.sqrt (Y : ℝ)) hrootpos
  have hinner (d : ℕ) (hd : d ∈ S)
      (hcut : (d : ℝ) ≤ Real.sqrt (Y : ℝ)) :
      ‖F d‖ ≤ (C₀ * (Y : ℝ) * E₀) * (d : ℝ)⁻¹ := by
    have hdI := Finset.mem_Icc.mp (Finset.mem_filter.mp hd).1
    have hdpos : 0 < d := by omega
    have hquot : (Y : ℝ) < (d : ℝ) * (((Y / d : ℕ) : ℝ) + 1) := by
      exact_mod_cast Nat.lt_mul_div_succ Y hdpos
    have hquotUpper := mul_le_mul_of_nonneg_right hcut
      (by positivity : 0 ≤ ((Y / d : ℕ) : ℝ) + 1)
    have hrootLt : Real.sqrt (Y : ℝ) < ((Y / d : ℕ) : ℝ) + 1 := by
      apply (mul_lt_mul_iff_right₀ hrootpos).mp
      calc
        Real.sqrt (Y : ℝ) * Real.sqrt (Y : ℝ) = (Y : ℝ) :=
          Real.mul_self_sqrt (Nat.cast_nonneg Y)
        _ < (d : ℝ) * (((Y / d : ℕ) : ℝ) + 1) := hquot
        _ ≤ _ := hquotUpper
    have hhalf : Real.sqrt (Y : ℝ) / 2 ≤ ((Y / d : ℕ) : ℝ) := by
      linarith
    have htX : X₀ ≤ Y / d := by
      exact_mod_cast (show (X₀ : ℝ) ≤ ((Y / d : ℕ) : ℝ) by linarith)
    have hlog : Real.log (Y : ℝ) / 4 ≤ Real.log ((Y / d : ℕ) : ℝ) := by
      have hmono := Real.log_le_log (half_pos hrootpos) hhalf
      rw [Real.log_div hrootpos.ne' (by norm_num),
        Real.log_sqrt (Nat.cast_nonneg Y)] at hmono
      linarith
    have hmodulus : (q : ℝ) ≤ Real.log ((Y / d : ℕ) : ℝ) ^ (D + 1) := by
      apply hq.trans
      calc
        Real.log (Y : ℝ) ^ D ≤ (Real.log (Y : ℝ) / 4) ^ (D + 1) := by
          rw [Real.div_rpow hLpos.le (by norm_num),
            Real.rpow_add_one hLpos.ne']
          apply (le_div_iff₀ (Real.rpow_pos_of_pos (by norm_num : (0 : ℝ) < 4) _)).mpr
          exact mul_le_mul_of_nonneg_left hLD (Real.rpow_nonneg hLpos.le D)
        _ ≤ _ := Real.rpow_le_rpow (by positivity) hlog (by linarith)
    have hrootLog : Real.sqrt (Real.log (Y : ℝ)) / 2 ≤
        Real.sqrt (Real.log ((Y / d : ℕ) : ℝ)) := by
      calc
        _ = Real.sqrt (Real.log (Y : ℝ) / 4) := by
          rw [Real.sqrt_div hLpos.le]
          norm_num
        _ ≤ _ := Real.sqrt_le_sqrt hlog
    have hexp : Real.exp (-c₀ * Real.sqrt (Real.log ((Y / d : ℕ) : ℝ))) ≤ E₀ := by
      apply Real.exp_le_exp.mpr
      nlinarith [mul_le_mul_of_nonneg_left hrootLog hc₀.le]
    calc
      ‖F d‖ ≤ C₀ * ((Y / d : ℕ) : ℝ) *
          Real.exp (-c₀ * Real.sqrt (Real.log ((Y / d : ℕ) : ℝ))) := by
        simpa only [F, one_mul] using norm_mul_le_of_le (χ.norm_le_one d)
          (hsw (Y / d) htX q χ hmodulus)
      _ ≤ (C₀ * ((Y : ℝ) / (d : ℝ))) * E₀ :=
        mul_le_mul (mul_le_mul_of_nonneg_left Nat.cast_div_le hC₀.le)
          hexp (Real.exp_pos _).le (by positivity)
      _ = _ := by rw [div_eq_mul_inv]; ring
  have htrivial (d : ℕ) : ‖F d‖ ≤ (Y : ℝ) * (d : ℝ)⁻¹ := by
    have hsum : ‖∑ n ∈ Finset.Icc 1 (Y / d),
        χ n * (ArithmeticFunction.moebius n : ℂ)‖ ≤ ((Y / d : ℕ) : ℝ) := by
      calc
        _ ≤ ∑ n ∈ Finset.Icc 1 (Y / d), (1 : ℝ) := by
          apply norm_sum_le_of_le
          intro n _
          rw [norm_mul]
          apply (mul_le_of_le_one_left (norm_nonneg _) (χ.norm_le_one _)).trans
          exact_mod_cast ArithmeticFunction.abs_moebius_le_one (n := n)
        _ = _ := by simp
    calc
      ‖F d‖ ≤ ((Y / d : ℕ) : ℝ) := by
        simpa only [F, one_mul] using norm_mul_le_of_le (χ.norm_le_one d) hsum
      _ ≤ (Y : ℝ) / (d : ℝ) := Nat.cast_div_le
      _ = _ := div_eq_mul_inv _ _
  have hsmallMass :
      (∑ d ∈ S.filter (fun d : ℕ => (d : ℝ) ≤ Real.sqrt (Y : ℝ)),
        (d : ℝ)⁻¹) ≤ (r.divisors.card : ℝ) := by
    apply (Finset.sum_le_sum_of_subset_of_nonneg (Finset.filter_subset _ _)
      (fun d _ _ => inv_nonneg.mpr (Nat.cast_nonneg d))).trans
    exact hmass
  have hlargeMass :
      (∑ d ∈ S.filter (fun d : ℕ => ¬ (d : ℝ) ≤ Real.sqrt (Y : ℝ)),
        (d : ℝ)⁻¹) ≤ E * (r.divisors.card : ℝ) ^ 2 := by
    have htail' :
        (∑ d ∈ S.filter (fun d : ℕ => ¬ (d : ℝ) ≤ Real.sqrt (Y : ℝ)),
          (d : ℝ)⁻¹) ≤
            Real.sqrt (Y : ℝ) ^ (-(1 / 2 : ℝ)) * (r.divisors.card : ℝ) ^ 2 := by
      simpa only [S, Finset.filter_filter, not_le] using htail
    exact htail'.trans (mul_le_mul_of_nonneg_right htailDecay (sq_nonneg _))
  have hsmall :
      ‖∑ d ∈ S.filter (fun d : ℕ => (d : ℝ) ≤ Real.sqrt (Y : ℝ)), F d‖ ≤
        C₀ * (r.divisors.card : ℝ) ^ 2 * (Y : ℝ) * E := by
    calc
      _ ≤ ∑ d ∈ S.filter (fun d : ℕ => (d : ℝ) ≤ Real.sqrt (Y : ℝ)),
          (C₀ * (Y : ℝ) * E₀) * (d : ℝ)⁻¹ := by
        apply norm_sum_le_of_le
        intro d hd
        exact hinner d (Finset.mem_filter.mp hd).1 (Finset.mem_filter.mp hd).2
      _ = (C₀ * (Y : ℝ) * E₀) *
          ∑ d ∈ S.filter (fun d : ℕ => (d : ℝ) ≤ Real.sqrt (Y : ℝ)),
            (d : ℝ)⁻¹ := (Finset.mul_sum _ _ _).symm
      _ ≤ (C₀ * (Y : ℝ) * E₀) * (r.divisors.card : ℝ) :=
        mul_le_mul_of_nonneg_left hsmallMass (by positivity)
      _ ≤ (C₀ * (Y : ℝ)) * (E * (r.divisors.card : ℝ) ^ 2) := by
        rw [mul_assoc]
        exact mul_le_mul_of_nonneg_left
          (mul_le_mul hEcompare htauSq (Nat.cast_nonneg _) hEpos.le) (by positivity)
      _ = _ := by ring
  have hlarge :
      ‖∑ d ∈ S.filter (fun d : ℕ => ¬ (d : ℝ) ≤ Real.sqrt (Y : ℝ)), F d‖ ≤
        (r.divisors.card : ℝ) ^ 2 * (Y : ℝ) * E := by
    calc
      _ ≤ ∑ d ∈ S.filter (fun d : ℕ => ¬ (d : ℝ) ≤ Real.sqrt (Y : ℝ)),
          (Y : ℝ) * (d : ℝ)⁻¹ :=
        norm_sum_le_of_le _ (fun d _ => htrivial d)
      _ = (Y : ℝ) *
          ∑ d ∈ S.filter (fun d : ℕ => ¬ (d : ℝ) ≤ Real.sqrt (Y : ℝ)),
            (d : ℝ)⁻¹ := (Finset.mul_sum _ _ _).symm
      _ ≤ (Y : ℝ) * (E * (r.divisors.card : ℝ) ^ 2) :=
        mul_le_mul_of_nonneg_left hlargeMass (Nat.cast_nonneg Y)
      _ = _ := by ring
  rw [moebius_coprime_character_sum_eq_supported_convolution r Y q hr χ]
  change ‖∑ d ∈ S, F d‖ ≤ (C₀ + 1) * (r.divisors.card : ℝ) ^ 2 * (Y : ℝ) * E
  rw [← Finset.sum_filter_add_sum_filter_not S
    (fun d : ℕ => (d : ℝ) ≤ Real.sqrt (Y : ℝ)) F]
  calc
    _ ≤ C₀ * (r.divisors.card : ℝ) ^ 2 * (Y : ℝ) * E +
        (r.divisors.card : ℝ) ^ 2 * (Y : ℝ) * E :=
      norm_add_le_of_le hsmall hlarge
    _ = _ := by ring

theorem truncated_moebius_interval_coefficient_siegelWalfisz
    (δ H Cψ Eψ : ℝ)
    (hδ : 0 < δ) (hH : 0 < H) (hCψ : 0 < Cψ) (hEψ : 0 ≤ Eψ) :
    ∀ A : ℝ, 0 < A → ∃ C X₀ : ℝ, 0 < C ∧ Real.exp 1 ≤ X₀ ∧
      ∀ x : ℝ, X₀ ≤ x →
        ∀ N U : ℝ, x ^ δ ≤ N →
          ∀ L R : ℕ, (R : ℝ) ≤ H * N →
            ∀ ψ : ℝ → ℂ, ContDiff ℝ 1 ψ →
              (∀ t ∈ Set.Icc (0 : ℝ) H,
                ‖ψ t‖ ≤ Cψ * (Real.log x) ^ Eψ ∧
                ‖deriv ψ t‖ ≤ Cψ * (Real.log x) ^ Eψ) →
              ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
                let f : ℕ →₀ ℂ :=
                  ∑ n ∈ Finset.Icc L R,
                    Finsupp.single n
                      (if (n : ℝ) ≤ U then
                        (ArithmeticFunction.moebius n : ℂ) * ψ ((n : ℝ) / N)
                      else 0)
                ‖fullDiscrepancy
                    (f.filter (fun n => Nat.Coprime n r)) q a‖ ≤
                  C * ((q * r).divisors.card : ℝ) ^ 2 * N / (Real.log x) ^ A := by
  classical
  let v : ℕ → ℕ → ℂ := fun r n =>
    if Nat.Coprime n r then (ArithmeticFunction.moebius n : ℂ) else 0
  let z : ℕ → ℕ → ℕ → ℕ → ℂ := fun q r a n =>
    (if n % q = a % q then v r n else 0) -
      (if Nat.Coprime n q then v r n else 0) / (q.totient : ℂ)
  have hv (r n : ℕ) : ‖v r n‖ ≤ 1 := by
    dsimp [v]
    split_ifs
    · exact_mod_cast ArithmeticFunction.abs_moebius_le_one (n := n)
    · simp
  have htauone (q : ℕ) (hq : q ≠ 0) : (1 : ℝ) ≤ q.divisors.card := by
    exact_mod_cast Finset.one_le_card.mpr ⟨1, Nat.one_mem_divisors.mpr hq⟩
  have htaumono (m n : ℕ) (hn : n ≠ 0) (hmn : m ∣ n) :
      (m.divisors.card : ℝ) ≤ n.divisors.card := by
    exact_mod_cast Finset.card_le_card (Nat.divisors_subset_of_dvd hn hmn)
  have hmass (q r a T : ℕ) :
      (∑ n ∈ Finset.range T, z q r a n) =
        (∑ n ∈ Finset.range T with n % q = a % q, v r n) -
          (∑ n ∈ Finset.range T with Nat.Coprime n q, v r n) /
            (q.totient : ℂ) := by
    simp [z, Finset.sum_sub_distrib, Finset.sum_div, Finset.sum_filter]
  have hshort (q r a T : ℕ) (hq : 0 < q) :
      ‖∑ n ∈ Finset.range T, z q r a n‖ ≤ 2 * (T : ℝ) := by
    have hφ : (0 : ℝ) < q.totient := by exact_mod_cast Nat.totient_pos.mpr hq
    have hφone : (1 : ℝ) ≤ q.totient := by
      exact_mod_cast Nat.totient_pos.mpr hq
    have hterm (n : ℕ) : ‖z q r a n‖ ≤ 2 := by
      have hfirst : ‖if n % q = a % q then v r n else 0‖ ≤ 1 := by
        split_ifs
        · exact hv r n
        · simp
      have hsecond : ‖(if Nat.Coprime n q then v r n else 0) /
          (q.totient : ℂ)‖ ≤ 1 := by
        rw [norm_div, Complex.norm_natCast]
        apply (div_le_one hφ).mpr
        by_cases hn : Nat.Coprime n q
        · rw [ite_eq_left hn]
          exact (hv r n).trans hφone
        · rw [ite_eq_right hn, norm_zero]
          exact hφ.le
      simpa only [one_add_one_eq_two] using norm_sub_le_of_le hfirst hsecond
    calc
      _ ≤ ∑ _n ∈ Finset.range T, (2 : ℝ) := norm_sum_le_of_le _ (fun n _ => hterm n)
      _ = _ := by simp [mul_comm]
  have hlarge (q r a T : ℕ) (hq : 0 < q) :
      ‖∑ n ∈ Finset.range T, z q r a n‖ ≤
        2 * (q.divisors.card : ℝ) * T / q + 1 := by
    have hqR : (0 : ℝ) < q := by exact_mod_cast hq
    have hφ : (0 : ℝ) < q.totient := by exact_mod_cast Nat.totient_pos.mpr hq
    have htau := htauone q hq.ne'
    have hcard : (((Finset.range T).filter (fun n => n % q = a % q)).card : ℝ) ≤
        (T : ℝ) / q + 1 := by
      have hn : ((Finset.range T).filter (fun n => n % q = a % q)).card ≤ T / q + 1 := by
        have hcount := Nat.count_modEq_card T hq a
        rw [Nat.count_eq_card_filter_range] at hcount
        change ((Finset.range T).filter (fun n : ℕ => n % q = a % q)).card =
          T / q + (if a % q < T % q then 1 else 0) at hcount
        rw [hcount]
        split_ifs <;> omega
      calc
        _ ≤ ((T / q + 1 : ℕ) : ℝ) := by exact_mod_cast hn
        _ ≤ _ := by
          push_cast
          linarith only [Nat.cast_div_le (m := T) (n := q) (α := ℝ)]
    have hfirst : ‖∑ n ∈ Finset.range T with n % q = a % q, v r n‖ ≤
        (T : ℝ) / q + 1 := by
      calc
        _ ≤ ∑ _n ∈ (Finset.range T).filter (fun n => n % q = a % q), (1 : ℝ) :=
          norm_sum_le_of_le _ (fun n _ => hv r n)
        _ = (((Finset.range T).filter (fun n => n % q = a % q)).card : ℝ) := by simp
        _ ≤ _ := hcard
    have hsecond : ‖∑ n ∈ Finset.range T with Nat.Coprime n q, v r n‖ ≤ (T : ℝ) := by
      calc
        _ ≤ ∑ _n ∈ (Finset.range T).filter (fun n => Nat.Coprime n q), (1 : ℝ) :=
          norm_sum_le_of_le _ (fun n _ => hv r n)
        _ = (((Finset.range T).filter (fun n => Nat.Coprime n q)).card : ℝ) := by simp
        _ ≤ T := by
          exact_mod_cast (show ((Finset.range T).filter
            (fun n => Nat.Coprime n q)).card ≤ T by
              simpa using Finset.card_filter_le (Finset.range T) (fun n => Nat.Coprime n q))
    have hinv : (q.totient : ℝ)⁻¹ ≤ (q.divisors.card : ℝ) / q := by
      apply (le_div_iff₀ hqR).mpr
      simpa [div_eq_mul_inv, mul_comm] using
        div_totient_le_card_divisors q
    rw [hmass]
    calc
      _ ≤ (T : ℝ) / q + 1 + T / (q.totient : ℝ) := by
        apply norm_sub_le_of_le hfirst
        rw [norm_div, Complex.norm_natCast]
        exact div_le_div_of_nonneg_right hsecond hφ.le
      _ ≤ (q.divisors.card : ℝ) * T / q + 1 +
          (q.divisors.card : ℝ) * T / q := by
        apply add_le_add
        · apply add_le_add _ le_rfl
          apply div_le_div_of_nonneg_right _ hqR.le
          simpa using mul_le_mul_of_nonneg_right htau (Nat.cast_nonneg T)
        · simpa [div_eq_mul_inv, mul_comm, mul_left_comm, mul_assoc] using
            mul_le_mul_of_nonneg_left hinv (Nat.cast_nonneg T)
      _ = _ := by ring
  have hcharacter (q r a T : ℕ) (hq : 0 < q) (ha : Nat.Coprime a q)
      (B : ℝ) (hB : 0 ≤ B)
      (hχ : ∀ χ : DirichletCharacter ℂ q,
        ‖∑ n ∈ Finset.range T, χ n * v r n‖ ≤ B) :
      ‖∑ n ∈ Finset.range T, z q r a n‖ ≤ 2 * B := by
    have : NeZero q := ⟨hq.ne'⟩
    have hφ : (0 : ℝ) < q.totient := by exact_mod_cast Nat.totient_pos.mpr hq
    have hφone : (1 : ℝ) ≤ q.totient := by
      exact_mod_cast Nat.totient_pos.mpr hq
    have hφC : (q.totient : ℂ) ≠ 0 := by exact_mod_cast hφ.ne'
    have haunit : IsUnit (a : ZMod q) := (ZMod.isUnit_iff_coprime a q).mpr ha
    have horth (n : ℕ) :
        (∑ χ : DirichletCharacter ℂ q, χ ((a : ZMod q)⁻¹) * χ n) =
          if n % q = a % q then (q.totient : ℂ) else 0 := by
      simpa only [ZMod.natCast_eq_natCast_iff', eq_comm] using
        DirichletCharacter.sum_char_inv_mul_char_eq ℂ haunit (n : ZMod q)
    have havg :
        (∑ n ∈ Finset.range T with n % q = a % q, v r n) =
          (q.totient : ℂ)⁻¹ * ∑ χ : DirichletCharacter ℂ q,
            χ ((a : ZMod q)⁻¹) * ∑ n ∈ Finset.range T, χ n * v r n := by
      rw [Finset.mul_sum]
      simp_rw [Finset.mul_sum]
      rw [Finset.sum_comm, Finset.sum_filter]
      apply Finset.sum_congr rfl
      intro n hn
      calc
        _ = (q.totient : ℂ)⁻¹ *
            ((∑ χ : DirichletCharacter ℂ q, χ ((a : ZMod q)⁻¹) * χ n) * v r n) := by
          rw [horth]
          split_ifs <;> simp [hφC]
        _ = _ := by
          rw [Finset.sum_mul, Finset.mul_sum]
          apply Finset.sum_congr rfl
          intro χ hχmem
          ring
    have hfirst : ‖∑ n ∈ Finset.range T with n % q = a % q, v r n‖ ≤ B := by
      have hcardNat : Fintype.card (DirichletCharacter ℂ q) = q.totient := by
        simpa only [Nat.card_eq_fintype_card] using
          DirichletCharacter.card_eq_totient_of_hasEnoughRootsOfUnity ℂ q
      have hcard : (Fintype.card (DirichletCharacter ℂ q) : ℝ) = q.totient := by
        exact_mod_cast hcardNat
      rw [havg, norm_mul, norm_inv, Complex.norm_natCast]
      calc
        _ ≤ (q.totient : ℝ)⁻¹ * ∑ _χ : DirichletCharacter ℂ q, B := by
          apply mul_le_mul_of_nonneg_left _ (inv_nonneg.mpr hφ.le)
          apply norm_sum_le_of_le
          intro χ hχmem
          simpa only [one_mul] using norm_mul_le_of_le (χ.norm_le_one _) (hχ χ)
        _ = B := by simp [hcard, hφ.ne']
    have hprincipal : (∑ n ∈ Finset.range T with Nat.Coprime n q, v r n) =
        ∑ n ∈ Finset.range T, (1 : DirichletCharacter ℂ q) n * v r n := by
      rw [Finset.sum_filter]
      apply Finset.sum_congr rfl
      intro n hn
      by_cases hcop : Nat.Coprime n q
      · simp [hcop, MulChar.one_apply ((ZMod.isUnit_iff_coprime n q).mpr hcop)]
      · have hunit : ¬ IsUnit (n : ZMod q) := by
          simpa only [ZMod.isUnit_iff_coprime] using hcop
        simp [hcop, MulChar.map_nonunit _ hunit]
    rw [hmass]
    calc
      _ ≤ B + B := by
        apply norm_sub_le_of_le hfirst
        rw [norm_div, Complex.norm_natCast, hprincipal]
        exact (div_le_div_of_nonneg_right (hχ 1) hφ.le).trans (div_le_self hB hφone)
      _ = _ := by ring
  have hlogpow (P d : ℝ) (hd : 0 < d) :
      ∀ᶠ x : ℝ in Filter.atTop, (Real.log x) ^ P ≤ x ^ d := by
    have he := (isLittleO_log_rpow_rpow_atTop P hd).eventuallyLE
    filter_upwards [he, Filter.eventually_ge_atTop (1 : ℝ)] with x hx hxone
    simpa only [Real.norm_eq_abs, abs_of_nonneg (Real.rpow_nonneg
      (Real.log_nonneg hxone) _), abs_of_nonneg
      (Real.rpow_nonneg (zero_le_one.trans hxone) _)] using hx
  have hall (P : ℝ) (hP : 0 < P) :
      ∃ C : ℝ, 0 < C ∧ ∃ Y : ℕ, 4 ≤ Y ∧
        ∀ y : ℕ, Y ≤ y → ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
          ‖∑ n ∈ Finset.range (y + 1), z q r a n‖ ≤
            C * ((q * r).divisors.card : ℝ) ^ 2 * (y : ℝ) /
              (Real.log (y : ℝ)) ^ P := by
    obtain ⟨C, c, hC, hc, X, hX, hsw⟩ :=
      moebius_coprime_character_siegelWalfisz P hP
    have hdecay : ∀ᶠ y : ℕ in Filter.atTop,
        Real.exp (-c * Real.sqrt (Real.log (y : ℝ))) ≤
          1 / (Real.log (y : ℝ)) ^ P := by
      have he := (tendsto_natCast_atTop_atTop :
        Filter.Tendsto (fun n : ℕ => (n : ℝ)) Filter.atTop Filter.atTop).eventually
          (eventually_exp_neg_sqrt_log_mul_rpow_le_rpow P 0 c hc)
      filter_upwards [he, Filter.eventually_ge_atTop (2 : ℕ)] with y hy hy2
      have hL : 0 ≤ Real.log (y : ℝ) := Real.log_nonneg (by exact_mod_cast (show 1 ≤ y by omega))
      simpa [Real.rpow_neg hL, one_div] using hy
    have habsorb : ∀ᶠ y : ℕ in Filter.atTop, (Real.log (y : ℝ)) ^ P ≤ (y : ℝ) := by
      simpa using (tendsto_natCast_atTop_atTop :
        Filter.Tendsto (fun n : ℕ => (n : ℝ)) Filter.atTop Filter.atTop).eventually
          (hlogpow P 1 zero_lt_one)
    obtain ⟨Y, hY⟩ := Filter.eventually_atTop.mp (hdecay.and habsorb)
    refine ⟨2 * C + 5, by positivity, max X Y, hX.trans (le_max_left _ _), ?_⟩
    intro y hy q r a hq hr ha
    have : NeZero q := ⟨hq.ne'⟩
    have hyX : X ≤ y := (le_max_left _ _).trans hy
    have hyY : Y ≤ y := (le_max_right _ _).trans hy
    have hy4 : 4 ≤ y := hX.trans hyX
    have hyone : (1 : ℝ) ≤ y := by exact_mod_cast (show 1 ≤ y by omega)
    have hypos : (0 : ℝ) < y := zero_lt_one.trans_le hyone
    have hL : 0 < Real.log (y : ℝ) :=
      Real.log_pos (by exact_mod_cast (show 1 < y by omega))
    have hpow : 0 < (Real.log (y : ℝ)) ^ P := Real.rpow_pos_of_pos hL P
    have hqr : q * r ≠ 0 := Nat.mul_ne_zero hq.ne' hr.ne'
    have htau := htauone (q * r) hqr
    have htaur := htaumono r (q * r) hqr (Nat.dvd_mul_left r q)
    have htauq := htaumono q (q * r) hqr (Nat.dvd_mul_right q r)
    have htau2 : (1 : ℝ) ≤ ((q * r).divisors.card : ℝ) ^ 2 := one_le_pow₀ htau
    have htauq2 : (q.divisors.card : ℝ) ≤ ((q * r).divisors.card : ℝ) ^ 2 :=
      htauq.trans (le_self_pow₀ htau two_ne_zero)
    obtain ⟨hdec, hlog⟩ := hY y hyY
    by_cases hsmall : (q : ℝ) ≤ (Real.log (y : ℝ)) ^ P
    · let B : ℝ := C * (r.divisors.card : ℝ) ^ 2 * (y : ℝ) *
        Real.exp (-c * Real.sqrt (Real.log (y : ℝ)))
      have hB : 0 ≤ B := by dsimp [B]; positivity
      have hchars (χ : DirichletCharacter ℂ q) :
          ‖∑ n ∈ Finset.range (y + 1), χ n * v r n‖ ≤ B := by
        have hid : (∑ n ∈ Finset.range (y + 1), χ n * v r n) =
            ∑ n ∈ Finset.Icc 1 y,
              if Nat.Coprime n r then χ n * (ArithmeticFunction.moebius n : ℂ) else 0 := by
          have hh := Finset.sum_range_add_sum_Ico
            (fun n : ℕ => χ n * v r n) (show 1 ≤ y + 1 by omega)
          simpa [v, mul_ite, Finset.Ico_add_one_right_eq_Icc] using hh.symm
        rw [hid]
        exact hsw y hyX q r χ hr hsmall
      apply (hcharacter q r a (y + 1) hq ha B hB hchars).trans
      calc
        2 * B ≤ 2 * C * ((q * r).divisors.card : ℝ) ^ 2 * (y : ℝ) *
            (1 / (Real.log (y : ℝ)) ^ P) := by
          dsimp [B]
          have htaupow := pow_le_pow_left₀ (Nat.cast_nonneg r.divisors.card) htaur 2
          have hh := mul_le_mul
            (mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_left htaupow hC.le) hypos.le)
            hdec (Real.exp_pos _).le (by positivity :
              0 ≤ C * ((q * r).divisors.card : ℝ) ^ 2 * (y : ℝ))
          simpa only [mul_assoc] using
            mul_le_mul_of_nonneg_left hh (by norm_num : (0 : ℝ) ≤ 2)
        _ ≤ (2 * C + 5) * ((q * r).divisors.card : ℝ) ^ 2 * (y : ℝ) /
            (Real.log (y : ℝ)) ^ P := by
          rw [mul_one_div]
          gcongr
          linarith only [hC]
    · have hqR : (0 : ℝ) < q := by exact_mod_cast hq
      have hPq : (Real.log (y : ℝ)) ^ P ≤ q := (lt_of_not_ge hsmall).le
      have hsucc : ((y + 1 : ℕ) : ℝ) ≤ 2 * (y : ℝ) := by
        push_cast
        linarith only [hyone]
      have hdiv : (y : ℝ) / q ≤ (y : ℝ) / (Real.log (y : ℝ)) ^ P :=
        div_le_div_of_nonneg_left hypos.le hpow hPq
      have hunit : 1 ≤ ((q * r).divisors.card : ℝ) ^ 2 * (y : ℝ) /
          (Real.log (y : ℝ)) ^ P := by
        apply (one_le_div₀ hpow).mpr
        exact hlog.trans (by simpa using mul_le_mul_of_nonneg_right htau2 hypos.le)
      calc
        _ ≤ 2 * (q.divisors.card : ℝ) * ((y + 1 : ℕ) : ℝ) / q + 1 :=
          hlarge q r a (y + 1) hq
        _ ≤ 4 * (q.divisors.card : ℝ) * (y : ℝ) / q + 1 := by
          have hh := div_le_div_of_nonneg_right
            (mul_le_mul_of_nonneg_left hsucc
              (by positivity : 0 ≤ 2 * (q.divisors.card : ℝ))) hqR.le
          calc
            _ ≤ 2 * (q.divisors.card : ℝ) * (2 * (y : ℝ)) / q + 1 :=
              add_le_add hh le_rfl
            _ = _ := by ring
        _ ≤ 4 * ((q * r).divisors.card : ℝ) ^ 2 * (y : ℝ) /
            (Real.log (y : ℝ)) ^ P + 1 := by
          have hh := mul_le_mul
            (mul_le_mul_of_nonneg_left htauq2 (by norm_num : (0 : ℝ) ≤ 4))
            hdiv (div_nonneg hypos.le hqR.le) (by positivity)
          simpa [mul_div_assoc] using add_le_add hh (le_refl (1 : ℝ))
        _ ≤ 5 * ((q * r).divisors.card : ℝ) ^ 2 * (y : ℝ) /
            (Real.log (y : ℝ)) ^ P := by
          calc
            _ = 4 * (((q * r).divisors.card : ℝ) ^ 2 * (y : ℝ) /
                (Real.log (y : ℝ)) ^ P) + 1 := by ring
            _ ≤ 4 * (((q * r).divisors.card : ℝ) ^ 2 * (y : ℝ) /
                (Real.log (y : ℝ)) ^ P) +
                ((q * r).divisors.card : ℝ) ^ 2 * (y : ℝ) /
                  (Real.log (y : ℝ)) ^ P := add_le_add le_rfl hunit
            _ = _ := by ring
        _ ≤ (2 * C + 5) * ((q * r).divisors.card : ℝ) ^ 2 * (y : ℝ) /
            (Real.log (y : ℝ)) ^ P := by gcongr; linarith only [hC]
  intro A hA
  let P : ℝ := A + Eψ
  have hP : 0 < P := by dsimp [P]; linarith only [hA, hEψ]
  obtain ⟨C₀, hC₀, Y, hY, hbound⟩ := hall P hP
  let d : ℝ := δ / 2
  have hd : 0 < d := by dsimp [d]; positivity
  have hdP : 0 < d ^ P := Real.rpow_pos_of_pos hd P
  let K : ℝ := 4 + C₀ * H / d ^ P
  have hKfour : 4 ≤ K := by
    have hh : 0 ≤ C₀ * H / d ^ P := by positivity
    dsimp [K]
    linarith only [hh]
  have hK : 0 < K := by linarith only [hKfour]
  have hevent : ∀ᶠ x : ℝ in Filter.atTop,
      Real.exp 1 ≤ x ∧ (Y : ℝ) ≤ x ^ d ∧ (Real.log x) ^ P ≤ x ^ d := by
    filter_upwards [Filter.eventually_ge_atTop (Real.exp 1),
      (tendsto_rpow_atTop hd).eventually_ge_atTop (Y : ℝ), hlogpow P d hd]
      with x hx hy hl
    exact ⟨hx, hy, hl⟩
  obtain ⟨X, hX⟩ := Filter.eventually_atTop.mp hevent
  refine ⟨2 * K * (1 + H) * Cψ, max X (Real.exp 1), by positivity,
    le_max_right _ _, ?_⟩
  intro x hx N U hN L R hR ψ hψ hψbound q r a hq hr ha
  have hxX : X ≤ x := (le_max_left _ _).trans hx
  obtain ⟨hxexp, hthreshold, habsorb⟩ := hX x hxX
  have hxone : 1 < x := (Real.one_lt_exp_iff.mpr zero_lt_one).trans_le hxexp
  have hxpos : 0 < x := zero_lt_one.trans hxone
  have hlog : 0 < Real.log x := Real.log_pos hxone
  have hPow : 0 < (Real.log x) ^ P := Real.rpow_pos_of_pos hlog P
  have hNpos : 0 < N := (Real.rpow_pos_of_pos hxpos δ).trans_le hN
  have hqr : q * r ≠ 0 := Nat.mul_ne_zero hq.ne' hr.ne'
  have htau := htauone (q * r) hqr
  have htau2 : (1 : ℝ) ≤ ((q * r).divisors.card : ℝ) ^ 2 := one_le_pow₀ htau
  have hYone : (1 : ℝ) ≤ (Y : ℝ) := by exact_mod_cast (show 1 ≤ Y by omega)
  have hpowerone : (1 : ℝ) ≤ x ^ d := hYone.trans hthreshold
  let B : ℝ := K * ((q * r).divisors.card : ℝ) ^ 2 * N / (Real.log x) ^ P
  have hB : 0 ≤ B := by dsimp [B]; positivity
  have hprefix (T : ℕ) (hT : (T : ℝ) ≤ H * N) :
      ‖∑ n ∈ Finset.range (T + 1), z q r a n‖ ≤ B := by
    have hcoeff : 4 ≤ K * ((q * r).divisors.card : ℝ) ^ 2 :=
      hKfour.trans (by simpa using mul_le_mul_of_nonneg_left htau2 hK.le)
    by_cases hsmall : (T : ℝ) < x ^ d
    · have hsucc : ((T + 1 : ℕ) : ℝ) ≤ 2 * x ^ d := by
        push_cast
        linarith only [hsmall, hpowerone]
      have hsquare : x ^ d * x ^ d = x ^ δ := by
        rw [← Real.rpow_add hxpos]
        congr 1
        dsimp [d]
        ring
      have hmasssmall : x ^ d ≤ N / (Real.log x) ^ P := by
        apply (le_div_iff₀ hPow).mpr
        calc
          _ ≤ x ^ d * x ^ d :=
            mul_le_mul_of_nonneg_left habsorb (Real.rpow_nonneg hxpos.le _)
          _ = x ^ δ := hsquare
          _ ≤ N := hN
      calc
        _ ≤ 2 * ((T + 1 : ℕ) : ℝ) := hshort q r a (T + 1) hq
        _ ≤ 4 * x ^ d := by
          calc
            _ ≤ 2 * (2 * x ^ d) :=
              mul_le_mul_of_nonneg_left hsucc (by norm_num : (0 : ℝ) ≤ 2)
            _ = _ := by ring
        _ ≤ 4 * (N / (Real.log x) ^ P) :=
          mul_le_mul_of_nonneg_left hmasssmall (by norm_num)
        _ ≤ (K * ((q * r).divisors.card : ℝ) ^ 2) * (N / (Real.log x) ^ P) :=
          mul_le_mul_of_nonneg_right hcoeff (div_nonneg hNpos.le hPow.le)
        _ = B := by dsimp [B]; ring
    · have hlargeT : x ^ d ≤ (T : ℝ) := le_of_not_gt hsmall
      have hTY : Y ≤ T := by exact_mod_cast hthreshold.trans hlargeT
      have hlogscale : d * Real.log x ≤ Real.log (T : ℝ) := by
        have hh := Real.log_le_log (Real.rpow_pos_of_pos hxpos d) hlargeT
        rwa [Real.log_rpow hxpos] at hh
      have hden : d ^ P * (Real.log x) ^ P ≤ (Real.log (T : ℝ)) ^ P := by
        rw [← Real.mul_rpow hd.le hlog.le]
        exact Real.rpow_le_rpow (mul_nonneg hd.le hlog.le) hlogscale hP.le
      have hdenpos : 0 < d ^ P * (Real.log x) ^ P := mul_pos hdP hPow
      calc
        _ ≤ C₀ * ((q * r).divisors.card : ℝ) ^ 2 * (T : ℝ) /
            (Real.log (T : ℝ)) ^ P := hbound T hTY q r a hq hr ha
        _ ≤ C₀ * ((q * r).divisors.card : ℝ) ^ 2 * (H * N) /
            (d ^ P * (Real.log x) ^ P) := by
          exact div_le_div₀ (by positivity)
            (mul_le_mul_of_nonneg_left hT (by positivity)) hdenpos hden
        _ = (C₀ * H / d ^ P) * ((q * r).divisors.card : ℝ) ^ 2 * N /
            (Real.log x) ^ P := by ring
        _ ≤ B := by
          dsimp [B]
          apply div_le_div_of_nonneg_right _ hPow.le
          apply mul_le_mul_of_nonneg_right _ hNpos.le
          apply mul_le_mul_of_nonneg_right _ (sq_nonneg _)
          dsimp [K]
          linarith only
  have hintervalAbel (z : ℕ → ℂ) (B : ℝ) (hB : 0 ≤ B)
      (hprefix : ∀ T : ℕ, (T : ℝ) ≤ H * N →
        ‖∑ n ∈ Finset.range (T + 1), z n‖ ≤ B) :
      ‖∑ n ∈ Finset.Icc L R,
        if (n : ℝ) ≤ U then ψ ((n : ℝ) / N) * z n else 0‖ ≤
        2 * B * ((1 + H) * Cψ * (Real.log x) ^ Eψ) := by
    let W : ℝ := Cψ * (Real.log x) ^ Eψ
    have hW : 0 ≤ W :=
      (norm_nonneg (ψ 0)).trans (hψbound 0 ⟨le_rfl, hH.le⟩).1
    have hsample (i : ℕ) (hi : i ≤ R) : (i : ℝ) / N ∈ Set.Icc (0 : ℝ) H := by
      refine ⟨div_nonneg (Nat.cast_nonneg i) hNpos.le, (div_le_iff₀ hNpos).2 ?_⟩
      exact (show (i : ℝ) ≤ R by exact_mod_cast hi).trans hR
    have hweighted (K : ℕ) (hK : K ≤ R + 1) :
        ‖∑ n ∈ Finset.range K, ψ ((n : ℝ) / N) * z n‖ ≤
          B * ((1 + H) * W) := by
      cases K with
      | zero =>
          simp only [Finset.range_zero, Finset.sum_empty, norm_zero]
          positivity
      | succ K =>
          have hKR : K ≤ R := by omega
          have hKR' : (K : ℝ) ≤ H * N :=
            (show (K : ℝ) ≤ R by exact_mod_cast hKR).trans hR
          have hraw (j : ℕ) (hj : j ≤ K + 1) :
              ‖∑ n ∈ Finset.range j, z n‖ ≤ B := by
            cases j with
            | zero => simpa using hB
            | succ j =>
                have hjK : j ≤ K := by omega
                exact hprefix j
                  ((show (j : ℝ) ≤ K by exact_mod_cast hjK).trans hKR')
          have hstep (i : ℕ) (hi : i ∈ Finset.range K) :
              ‖ψ (((i + 1 : ℕ) : ℝ) / N) - ψ ((i : ℝ) / N)‖ ≤ W / N := by
            have hiK : i < K := Finset.mem_range.mp hi
            have hiR : i ≤ R := (Nat.le_of_lt hiK).trans hKR
            have hiR' : i + 1 ≤ R := (Nat.succ_le_of_lt hiK).trans hKR
            calc
              _ ≤ W * ‖(((i + 1 : ℕ) : ℝ) / N) - (i : ℝ) / N‖ :=
                Convex.norm_image_sub_le_of_norm_deriv_le
                  (fun t _ => hψ.differentiable_one t)
                  (fun t ht => (hψbound t ht).2) (convex_Icc 0 H)
                  (hsample i hiR) (hsample (i + 1) hiR')
              _ = W / N := by
                rw [Nat.cast_add, Nat.cast_one, add_div, add_sub_cancel_left,
                  Real.norm_eq_abs, abs_of_pos (one_div_pos.mpr hNpos)]
                ring
          have hvariation :
              (∑ i ∈ Finset.range K,
                ‖ψ (((i + 1 : ℕ) : ℝ) / N) - ψ ((i : ℝ) / N)‖) ≤ H * W := by
            calc
              _ ≤ ∑ _i ∈ Finset.range K, W / N :=
                Finset.sum_le_sum hstep
              _ = (K : ℝ) * (W / N) := by simp
              _ = W * ((K : ℝ) / N) := by ring
              _ ≤ W * H := mul_le_mul_of_nonneg_left (hsample K hKR).2 hW
              _ = H * W := mul_comm _ _
          have hAbel :
              ‖∑ n ∈ Finset.range (K + 1), ψ ((n : ℝ) / N) * z n‖ ≤
                B * (‖ψ ((K : ℝ) / N)‖ +
                  ∑ i ∈ Finset.range K,
                    ‖ψ (((i + 1 : ℕ) : ℝ) / N) - ψ ((i : ℝ) / N)‖) := by
            simpa only [Nat.add_sub_cancel, smul_eq_mul] using
              norm_sum_range_smul_le_of_partial_sum_bound
                (fun n : ℕ => ψ ((n : ℝ) / N)) z (K + 1) B hraw
          calc
            _ ≤ B * (‖ψ ((K : ℝ) / N)‖ +
                ∑ i ∈ Finset.range K,
                  ‖ψ (((i + 1 : ℕ) : ℝ) / N) - ψ ((i : ℝ) / N)‖) := hAbel
            _ ≤ B * (W + H * W) := mul_le_mul_of_nonneg_left
              (add_le_add (hψbound _ (hsample K hKR)).1 hvariation) hB
            _ = B * ((1 + H) * W) := by ring
    suffices h :
        ‖∑ n ∈ Finset.Icc L R,
          if (n : ℝ) ≤ U then ψ ((n : ℝ) / N) * z n else 0‖ ≤
          2 * B * ((1 + H) * W) by
      simpa only [W, mul_assoc] using h
    by_cases hU : 0 ≤ U
    · let T : ℕ := min R (Nat.floor U)
      have hTR : T ≤ R := min_le_left _ _
      have hcut :
          (∑ n ∈ Finset.Icc L R,
            if (n : ℝ) ≤ U then ψ ((n : ℝ) / N) * z n else 0) =
          ∑ n ∈ Finset.Icc L T, ψ ((n : ℝ) / N) * z n := by
        rw [← Finset.sum_filter]
        apply Finset.sum_congr
        · ext n
          simp [T, Nat.le_floor_iff hU, and_assoc]
        · intro n hn
          rfl
      rw [hcut]
      by_cases hLT : L ≤ T
      · calc
          _ = ‖(∑ n ∈ Finset.range (T + 1), ψ ((n : ℝ) / N) * z n) -
              ∑ n ∈ Finset.range L, ψ ((n : ℝ) / N) * z n‖ := by
            congr 1
            rw [← Finset.Ico_add_one_right_eq_Icc]
            exact Finset.sum_Ico_eq_sub
              (fun n : ℕ => ψ ((n : ℝ) / N) * z n)
              (show L ≤ T + 1 from Nat.le_succ_of_le hLT)
          _ ≤ B * ((1 + H) * W) + B * ((1 + H) * W) :=
            norm_sub_le_of_le
              (hweighted (T + 1) (Nat.succ_le_succ hTR))
              (hweighted L (hLT.trans (hTR.trans (Nat.le_succ R))))
          _ = 2 * B * ((1 + H) * W) := by ring
      · rw [Finset.Icc_eq_empty_of_lt (lt_of_not_ge hLT), Finset.sum_empty, norm_zero]
        positivity
    · have hzero :
          (∑ n ∈ Finset.Icc L R,
            if (n : ℝ) ≤ U then ψ ((n : ℝ) / N) * z n else 0) = 0 := by
        apply Finset.sum_eq_zero
        intro n hn
        exact ite_eq_right (not_le.mpr ((lt_of_not_ge hU).trans_le (Nat.cast_nonneg n)))
      rw [hzero, norm_zero]
      positivity
  let f : ℕ →₀ ℂ :=
    ∑ n ∈ Finset.Icc L R,
      Finsupp.single n
        (if (n : ℝ) ≤ U then
          (ArithmeticFunction.moebius n : ℂ) * ψ ((n : ℝ) / N) else 0)
  have hMass (pred : ℕ → Prop) [DecidablePred pred] :
      (f.filter (fun n => Nat.Coprime n r)).sum
          (fun n c => if pred n then c else 0) =
        ∑ n ∈ Finset.Icc L R,
          if (n : ℝ) ≤ U then
            ψ ((n : ℝ) / N) * (if pred n then v r n else 0) else 0 := by
    dsimp only [f]
    rw [Finsupp.filter_sum,
      Finsupp.sum_finsetSum _ _ _ (fun n => by simp)
        (fun n b c => by by_cases hn : pred n <;> simp [hn])]
    refine Finset.sum_congr rfl fun n _ => ?_
    by_cases hrn : Nat.Coprime n r
    · rw [Finsupp.filter_single_of_pos (fun n => Nat.Coprime n r) hrn,
        Finsupp.sum_single_index (by simp)]
      by_cases hU : (n : ℝ) ≤ U <;> by_cases hpred : pred n <;>
        simp [hU, hpred, v, hrn, mul_comm]
    · rw [Finsupp.filter_single_of_neg (fun n => Nat.Coprime n r) hrn]
      simp [v, hrn]
  have hDiscrepancy :
      fullDiscrepancy
          (f.filter (fun n => Nat.Coprime n r)) q a =
        ∑ n ∈ Finset.Icc L R,
          if (n : ℝ) ≤ U then ψ ((n : ℝ) / N) * z q r a n else 0 := by
    change
      (f.filter (fun n => Nat.Coprime n r)).sum
          (fun n c => if n % q = a % q then c else 0) -
        (f.filter (fun n => Nat.Coprime n r)).sum
            (fun n c => if Nat.Coprime n q then c else 0) /
          (q.totient : ℂ) = _
    rw [hMass, hMass, Finset.sum_div, ← Finset.sum_sub_distrib]
    refine Finset.sum_congr rfl fun n _ => ?_
    by_cases hU : (n : ℝ) ≤ U
    · simp only [hU, ite_eq_left, z]
      ring
    · simp [hU]
  have hfinite :
      ‖fullDiscrepancy
          (f.filter (fun n => Nat.Coprime n r)) q a‖ ≤
        2 * B * ((1 + H) * Cψ * (Real.log x) ^ Eψ) := by
    rw [hDiscrepancy]
    exact hintervalAbel (z q r a) B hB hprefix
  calc
    _ ≤ 2 * B * ((1 + H) * Cψ * (Real.log x) ^ Eψ) := hfinite
    _ = (2 * K * (1 + H) * Cψ) * ((q * r).divisors.card : ℝ) ^ 2 * N /
        (Real.log x) ^ A := by
      dsimp only [B, P]
      rw [Real.rpow_add hlog, div_mul_eq_div_div]
      calc
        _ = (((2 * K * (1 + H) * Cψ) *
              ((q * r).divisors.card : ℝ) ^ 2 * N /
              (Real.log x) ^ A) / (Real.log x) ^ Eψ) *
              (Real.log x) ^ Eψ := by
          simp only [div_eq_mul_inv]
          ac_rfl
        _ = _ := div_mul_cancel₀ _ (Real.rpow_pos_of_pos hlog Eψ).ne'

open Classical in
theorem exists_factoredNumbers_count_bound
    (σ ε : ℝ) (hσ : 0 < σ) (hε : 0 < ε) :
    ∃ K : ℝ, 0 < K ∧ ∀ m X : ℕ, 0 < m →
      (((Finset.Icc 1 X).filter (fun n => n ∈ Nat.factoredNumbers m.primeFactors)).card : ℝ) ≤
        K * (m : ℝ) ^ ε * (X : ℝ) ^ σ := by
  let a : ℝ := (1 - (2 : ℝ) ^ (-σ))⁻¹
  have hden : 0 < 1 - (2 : ℝ) ^ (-σ) := sub_pos.mpr
    (Real.rpow_lt_one_of_one_lt_of_neg one_lt_two (neg_neg_of_pos hσ))
  have ha : 1 ≤ a := (one_le_inv₀ hden).mpr
    (sub_le_self _ (Real.rpow_nonneg zero_le_two _))
  obtain ⟨K, hK, hbound⟩ :=
    exists_primeFactors_power_bound ha hε
  refine ⟨K, hK, ?_⟩
  intro m X hm
  have hcount :
      (∑ n ∈ Finset.Icc 1 X with n ∈ Nat.factoredNumbers m.primeFactors,
        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 1) n : ℝ)) =
        (((Finset.Icc 1 X).filter
          (fun n => n ∈ Nat.factoredNumbers m.primeFactors)).card : ℝ) := by
    rw [Finset.sum_eq_card_nsmul (b := (1 : ℝ)), nsmul_eq_mul, mul_one]
    intro n hn
    simp only [pow_one, ArithmeticFunction.zeta_apply_ne
      (Nat.ne_zero_of_mem_factoredNumbers (Finset.mem_filter.mp hn).2),
      Nat.cast_one]
  have hpr : m.primeFactors.filter Nat.Prime = m.primeFactors :=
    Finset.filter_true_of_mem fun _ => Nat.prime_of_mem_primeFactors
  have hrankin := sum_zeta_pow_factoredNumbers_le_rankin 1 X m.primeFactors σ
    (by decide) hσ
  rw [hcount, hpr] at hrankin
  simp only [pow_one] at hrankin
  have hfactor (p : ℕ) (hp : p ∈ m.primeFactors) :
      0 ≤ (1 - (p : ℝ) ^ (-σ))⁻¹ ∧ (1 - (p : ℝ) ^ (-σ))⁻¹ ≤ a := by
    have hp2 : (2 : ℝ) ≤ p := by
      exact_mod_cast (Nat.prime_of_mem_primeFactors hp).two_le
    have hpow := Real.rpow_le_rpow_of_nonpos zero_lt_two hp2
      (neg_nonpos.mpr hσ.le)
    have hdenp : 0 < 1 - (p : ℝ) ^ (-σ) :=
      hden.trans_le (sub_le_sub_left hpow 1)
    exact ⟨inv_nonneg.mpr hdenp.le, inv_anti₀ hden (sub_le_sub_left hpow 1)⟩
  have hprod : (∏ p ∈ m.primeFactors, (1 - (p : ℝ) ^ (-σ))⁻¹) ≤
      a ^ m.primeFactors.card := by
    rw [← Finset.prod_const]
    exact Finset.prod_le_prod (fun p hp => (hfactor p hp).1)
      (fun p hp => (hfactor p hp).2)
  calc
    _ ≤ (X : ℝ) ^ σ * ∏ p ∈ m.primeFactors, (1 - (p : ℝ) ^ (-σ))⁻¹ := hrankin
    _ ≤ (X : ℝ) ^ σ * (K * (m : ℝ) ^ ε) :=
      mul_le_mul_of_nonneg_left (hprod.trans (hbound m hm.ne'))
        (Real.rpow_nonneg (Nat.cast_nonneg X) σ)
    _ = _ := by ring

open Classical in
theorem eventually_factoredNumbers_card_subpower
    (C ε : ℝ) (hC : 0 < C) (hε : 0 < ε) :
    ∀ᶠ x : ℝ in Filter.atTop, ∀ m X : ℕ,
      0 < m → (m : ℝ) ≤ x ^ C → (X : ℝ) ≤ x ^ C →
        (((Finset.Icc 1 X).filter (fun n => n ∈ Nat.factoredNumbers m.primeFactors)).card : ℝ) ≤
          x ^ ε := by
  let σ : ℝ := ε / (4 * C)
  have hσ : 0 < σ := div_pos hε (mul_pos zero_lt_four hC)
  obtain ⟨K, hK, hbound⟩ := exists_factoredNumbers_count_bound σ σ hσ hσ
  have hexp : C * σ + C * σ = ε / 2 := by
    dsimp only [σ]
    field_simp
    ring
  filter_upwards [Filter.eventually_gt_atTop (0 : ℝ),
    (tendsto_rpow_atTop (half_pos hε)).eventually_ge_atTop K] with x hx0 hxK
  intro m X hm hmx hXx
  have hmPow := Real.rpow_le_rpow (Nat.cast_nonneg m) hmx hσ.le
  have hXPow := Real.rpow_le_rpow (Nat.cast_nonneg X) hXx hσ.le
  rw [← Real.rpow_mul hx0.le] at hmPow hXPow
  calc
    _ ≤ K * (m : ℝ) ^ σ * (X : ℝ) ^ σ := hbound m X hm
    _ ≤ K * x ^ (C * σ) * x ^ (C * σ) :=
      mul_le_mul (mul_le_mul_of_nonneg_left hmPow hK.le) hXPow
        (Real.rpow_nonneg (Nat.cast_nonneg X) σ)
        (mul_nonneg hK.le (Real.rpow_nonneg hx0.le _))
    _ = K * x ^ (ε / 2) := by rw [mul_assoc, ← Real.rpow_add hx0, hexp]
    _ ≤ x ^ (ε / 2) * x ^ (ε / 2) :=
      mul_le_mul_of_nonneg_right hxK (Real.rpow_nonneg hx0.le _)
    _ = x ^ ε := by rw [← Real.rpow_add hx0, add_halves]

open Classical in
theorem eventually_full_supported_parts_card_subpower
    (C ε : ℝ) (hC : 0 < C) (hε : 0 < ε) :
    ∀ᶠ x : ℝ in Filter.atTop, ∀ m : ℕ,
      0 < m → (m : ℝ) ≤ x ^ C → ∀ S : Finset ℤ,
        (∀ u ∈ S, u ≠ 0 ∧ (u.natAbs : ℝ) ≤ x ^ C) →
          ((S.image (fun u =>
            ∏ p ∈ m.primeFactors, p ^ (u.natAbs.factorization p))).card : ℝ) ≤ x ^ ε := by
  filter_upwards [eventually_factoredNumbers_card_subpower C ε hC hε] with x hxbound
  intro m hm hmx S hS
  let T : Finset ℕ := (Finset.Icc 1 ⌊x ^ C⌋₊).filter
    (fun n => n ∈ Nat.factoredNumbers m.primeFactors)
  have hsubset :
      S.image (fun u => ∏ p ∈ m.primeFactors, p ^ (u.natAbs.factorization p)) ⊆ T := by
    apply Finset.image_subset_iff.mpr
    intro u hu
    obtain ⟨hWpos, hWdvd, hWprimes, _, _⟩ :=
      primeFactors_prod_pow_factorization_dvd_and_coprime_div m u.natAbs hm.ne'
        (Int.natAbs_ne_zero.mpr (hS u hu).1)
    apply Finset.mem_filter.mpr
    constructor
    · refine Finset.mem_Icc.mpr ⟨hWpos, Nat.le_floor ?_⟩
      exact (Nat.cast_le.mpr (Nat.le_of_dvd
        (Int.natAbs_pos.mpr (hS u hu).1) hWdvd)).trans (hS u hu).2
    · apply Nat.mem_factoredNumbers_of_primeFactors_subset hWpos.ne'
      rw [hWprimes]
      exact Finset.inter_subset_right
  calc
    _ ≤ (T.card : ℝ) := Nat.cast_le.mpr (Finset.card_le_card hsubset)
    _ ≤ x ^ ε := hxbound m ⌊x ^ C⌋₊ hm hmx
      (Nat.floor_le ((Nat.cast_nonneg m).trans hmx))

theorem exists_finiteFragments_eq_small_add_weightedEmpirical
    (κ δ : ℝ) (hκ : 0 < κ) (hδ : 0 < δ)
    (ω : ℤ → ℕ × (ℕ → ℝ))
    (hω : ∀ (k : ℤ) (a : Fin (ω k).1),
      (2 : ℝ) ^ k < (ω k).2 a.val ∧
        (ω k).2 a.val ≤ κ ∧ (ω k).2 a.val ≤ (2 : ℝ) ^ (k + 1)) :
    let X := finiteFragments
      (fun k => weightedEmpirical (ω k).1 (fun a => (ω k).2 a.val))
    ∃ (Y : FiniteMeasure ℝ) (n : ℕ) (x : Fin n → ℝ),
      Y.restrict (Set.Ioc (0 : ℝ) δ) = Y ∧
        (∀ a, δ < x a ∧ x a ≤ κ) ∧ X = Y + weightedEmpirical n x := by
  classical
  let ξ : ℤ → FiniteMeasure ℝ := fun k =>
    weightedEmpirical (ω k).1 (fun a => (ω k).2 a.val)
  let M : Measure ℝ := Measure.sum (fun k => (ξ k : Measure ℝ))
  change ∃ (Y : FiniteMeasure ℝ) (n : ℕ) (x : Fin n → ℝ),
    Y.restrict (Set.Ioc (0 : ℝ) δ) = Y ∧
      (∀ a, δ < x a ∧ x a ≤ κ) ∧ finiteFragments ξ = Y + weightedEmpirical n x
  by_cases hM : IsFiniteMeasure M
  · let X : FiniteMeasure ℝ := ⟨M, hM⟩
    have hX : finiteFragments ξ = X := by
      change (if h : IsFiniteMeasure M then (⟨M, h⟩ : FiniteMeasure ℝ)
        else (0 : FiniteMeasure ℝ)) = X
      exact dite_eq_left hM
    rw [hX]
    obtain ⟨a, ha⟩ := exists_mem_Ioc_zpow hδ (by norm_num : (1 : ℝ) < 2)
    obtain ⟨b, hb⟩ := exists_mem_Ioc_zpow hκ (by norm_num : (1 : ℝ) < 2)
    let S : Finset ℤ := Finset.Icc a b
    let atom : ℝ → Measure ℝ := fun u => ENNReal.ofReal u • Measure.dirac u
    have hband (k : ℤ) (j : Fin (ω k).1) (hj : δ < (ω k).2 j.val) : k ∈ S := by
      apply Finset.mem_Icc.mpr
      constructor
      · by_contra hka
        have hk : k + 1 ≤ a := by omega
        have hle : (ω k).2 j.val ≤ (2 : ℝ) ^ a :=
          (hω k j).2.2.trans (zpow_le_zpow_right₀ (by norm_num) hk)
        exact (lt_trans ha.1 hj).not_ge hle
      · by_contra hbk
        have hk : b + 1 ≤ k := by omega
        have hle : κ ≤ (2 : ℝ) ^ k :=
          hb.2.trans (zpow_le_zpow_right₀ (by norm_num) hk)
        exact (lt_of_le_of_lt hle (hω k j).1).not_ge (hω k j).2.1
    have hrestrict (k : ℤ) :
        (ξ k : Measure ℝ).restrict (Set.Ioi δ) =
          ∑ j : Fin (ω k).1,
            if δ < (ω k).2 j.val then atom ((ω k).2 j.val) else 0 := by
      change (weightedEmpirical (ω k).1 (fun j => (ω k).2 j.val) : Measure ℝ).restrict
        (Set.Ioi δ) = _
      rw [coe_weightedEmpirical]
      conv_lhs =>
        rw [← Measure.sum_fintype, Measure.restrict_sum _ measurableSet_Ioi,
          Measure.sum_fintype]
      apply Finset.sum_congr rfl
      intro j _
      rw [Measure.restrict_smul, restrict_dirac]
      by_cases hj : δ < (ω k).2 j.val <;> simp [Set.mem_Ioi, hj, atom]
    have houtside (k : ℤ) (hk : k ∉ S) :
        (ξ k : Measure ℝ).restrict (Set.Ioi δ) = 0 := by
      rw [hrestrict]
      apply Finset.sum_eq_zero
      intro j _
      have hj : ¬δ < (ω k).2 j.val := fun hj => hk (hband k j hj)
      exact ite_eq_right hj
    have hcut : M.restrict (Set.Ioi δ) =
        ∑ k ∈ S, (ξ k : Measure ℝ).restrict (Set.Ioi δ) := by
      apply Measure.ext
      intro s hs
      change (Measure.sum (fun k => (ξ k : Measure ℝ))).restrict (Set.Ioi δ) s = _
      rw [Measure.restrict_sum _ measurableSet_Ioi, Measure.sum_apply _ hs,
        Measure.finsetSum_apply]
      exact tsum_eq_sum (s := S) (fun k hk => by rw [houtside k hk]; rfl)
    let I := (k : S) × Fin (ω (k : ℤ)).1
    let mark : I → ℝ := fun v => (ω (v.1 : ℤ)).2 v.2.val
    let J := {v : I // δ < mark v}
    let n := Fintype.card J
    let e : J ≃ Fin n := Fintype.equivFin J
    let x : Fin n → ℝ := fun j => mark (e.symm j).val
    have htail : M.restrict (Set.Ioi δ) = (weightedEmpirical n x : Measure ℝ) := by
      calc
        M.restrict (Set.Ioi δ) =
            ∑ k ∈ S, (ξ k : Measure ℝ).restrict (Set.Ioi δ) := hcut
        _ = ∑ k : S, ∑ j : Fin (ω (k : ℤ)).1,
            if δ < (ω (k : ℤ)).2 j.val then atom ((ω (k : ℤ)).2 j.val) else 0 := by
          rw [← Finset.sum_coe_sort (s := S)
            (f := fun k => (ξ k : Measure ℝ).restrict (Set.Ioi δ))]
          exact Finset.sum_congr rfl fun k _ => hrestrict (k : ℤ)
        _ = ∑ v : I, if δ < mark v then atom (mark v) else 0 :=
          (Fintype.sum_sigma
            (fun v : I => if δ < mark v then atom (mark v) else 0)).symm
        _ = ∑ v : J, atom (mark v.val) := by
          rw [← Finset.sum_filter]
          exact Finset.sum_subtype
            (Finset.univ.filter (fun v : I => δ < mark v))
            (fun v => by simp) (fun v => atom (mark v))
        _ = (weightedEmpirical n x : Measure ℝ) := by
          rw [coe_weightedEmpirical]
          exact Fintype.sum_equiv e (fun v => atom (mark v.val))
            (fun j => atom (x j)) (fun v => by simp [x])
    have hpositive : M.restrict (Set.Ioi (0 : ℝ)) = M := by
      change (Measure.sum (fun k => (ξ k : Measure ℝ))).restrict (Set.Ioi (0 : ℝ)) =
        Measure.sum (fun k => (ξ k : Measure ℝ))
      rw [Measure.restrict_sum _ measurableSet_Ioi]
      apply congrArg Measure.sum
      funext k
      change (weightedEmpirical (ω k).1 (fun j => (ω k).2 j.val) : Measure ℝ).restrict
        (Set.Ioi (0 : ℝ)) = _
      simp only [ξ, coe_weightedEmpirical]
      conv_lhs =>
        rw [← Measure.sum_fintype, Measure.restrict_sum _ measurableSet_Ioi,
          Measure.sum_fintype]
      apply Finset.sum_congr rfl
      intro j _
      have hj : 0 < (ω k).2 j.val :=
        (zpow_pos (by norm_num : (0 : ℝ) < 2) k).trans (hω k j).1
      simp [Measure.restrict_smul, restrict_dirac, Set.mem_Ioi, hj]
    let Y := X.restrict (Set.Ioc (0 : ℝ) δ)
    refine ⟨Y, n, x, ?_, ?_, ?_⟩
    · apply FiniteMeasure.toMeasure_injective
      change (M.restrict (Set.Ioc (0 : ℝ) δ)).restrict (Set.Ioc (0 : ℝ) δ) =
        M.restrict (Set.Ioc (0 : ℝ) δ)
      rw [Measure.restrict_restrict measurableSet_Ioc, Set.inter_self]
    · intro j
      change δ < mark (e.symm j).val ∧ mark (e.symm j).val ≤ κ
      exact ⟨(e.symm j).property,
        (hω ((e.symm j).val.1 : ℤ) (e.symm j).val.2).2.1⟩
    · apply FiniteMeasure.toMeasure_injective
      change M = M.restrict (Set.Ioc (0 : ℝ) δ) + (weightedEmpirical n x : Measure ℝ)
      rw [← htail]
      have hdis : Disjoint (Set.Ioc (0 : ℝ) δ) (Set.Ioi δ) := by
        apply Set.disjoint_left.mpr
        intro u hu hv
        exact (not_lt_of_ge hu.2) hv
      have hunion : Set.Ioc (0 : ℝ) δ ∪ Set.Ioi δ = Set.Ioi (0 : ℝ) := by
        ext u
        constructor
        · rintro (hu | hu)
          · exact hu.1
          · exact hδ.trans hu
        · intro hu
          by_cases hud : u ≤ δ
          · exact Or.inl ⟨hu, hud⟩
          · exact Or.inr (lt_of_not_ge hud)
      calc
        M = M.restrict (Set.Ioi (0 : ℝ)) := hpositive.symm
        _ = M.restrict (Set.Ioc (0 : ℝ) δ) + M.restrict (Set.Ioi δ) := by
          rw [← hunion, Measure.restrict_union hdis measurableSet_Ioi]
  · have hX : finiteFragments ξ = 0 := by
      change (if h : IsFiniteMeasure M then (⟨M, h⟩ : FiniteMeasure ℝ)
        else (0 : FiniteMeasure ℝ)) = (0 : FiniteMeasure ℝ)
      exact dite_eq_right hM
    rw [hX]
    refine ⟨0, 0, (fun a => Fin.elim0 a), ?_, ?_, ?_⟩
    · apply FiniteMeasure.toMeasure_injective
      simp
    · intro a
      exact Fin.elim0 a
    · simp [weightedEmpirical]

theorem fragmentLaw_ae_finite_tail_elim
    (κ δ : ℝ) (hκ : 0 < κ) (hδ : 0 < δ) (d : ℕ)
    (P : (Fin d → FiniteMeasure ℝ) → Prop)
    (hP : MeasurableSet {X | P X})
    (hfinite : ∀ (Y : Fin d → FiniteMeasure ℝ) (n : Fin d → ℕ)
      (x : (i : Fin d) → Fin (n i) → ℝ),
      (∀ i, (Y i).restrict (Set.Ioc (0 : ℝ) δ) = Y i) →
      (∀ i a, δ < x i a ∧ x i a ≤ κ) →
      P (fun i => Y i + weightedEmpirical (n i) (x i))) :
    ∀ᵐ X ∂Measure.pi (fun _ : Fin d => fragmentLaw κ), P X := by
  classical
  let μ : ℤ → FiniteMeasure ℝ := cappedDyadicIntensity κ
  let ν : ℤ → Measure (ℕ × (ℕ → ℝ)) := fun k =>
    (ProbabilityTheory.poissonMeasure (μ k).mass).prod
      (Measure.infinitePi (fun _ : ℕ => ((μ k).normalize : Measure ℝ)))
  let : ∀ k : ℤ, IsProbabilityMeasure (ν k) := fun k => by
    dsimp [ν]
    infer_instance
  let ρ := Measure.infinitePi ν
  let : IsProbabilityMeasure ρ := by dsimp [ρ]; infer_instance
  let : IsProbabilityMeasure (fragmentLaw κ) := fragmentLaw_isProbabilityMeasure κ
  let sample : (ℕ × (ℕ → ℝ)) → FiniteMeasure ℝ := fun p =>
    weightedEmpirical p.1 (fun a => p.2 a.val)
  have hsample : Measurable sample := measurable_weightedEmpirical_sample
  let f : (ℤ → ℕ × (ℕ → ℝ)) → FiniteMeasure ℝ := fun ω =>
    finiteFragments (fun k => sample (ω k))
  have hf : Measurable f := measurable_finiteFragments.comp
    (measurable_pi_lambda _ fun k => hsample.comp (measurable_pi_apply k))
  have hlaw : ρ.map f = fragmentLaw κ := by
    calc
      ρ.map f = (ρ.map (fun ω k => sample (ω k))).map finiteFragments :=
        (Measure.map_map (μ := ρ)
          (f := fun ω : ℤ → ℕ × (ℕ → ℝ) => fun k => sample (ω k))
          (g := finiteFragments) measurable_finiteFragments
          (measurable_pi_lambda _ fun k =>
            hsample.comp (measurable_pi_apply k))).symm
      _ = (Measure.infinitePi (fun k => (ν k).map sample)).map finiteFragments := by
        rw [Measure.infinitePi_map_pi ν (fun _ => hsample)]
      _ = fragmentLaw κ := rfl
  have hused (k : ℤ) : ∀ᵐ p ∂ν k, ∀ a : Fin p.1,
      (2 : ℝ) ^ k < p.2 a.val ∧
        p.2 a.val ≤ κ ∧ p.2 a.val ≤ (2 : ℝ) ^ (k + 1) := by
    let B := Set.Ioc ((2 : ℝ) ^ k) (min κ ((2 : ℝ) ^ (k + 1)))
    have hB : MeasurableSet B := measurableSet_Ioc
    have hcap : (μ k : Measure ℝ) Bᶜ = 0 :=
      (cappedDyadicIntensity_measure κ k).2
    have hmeas : MeasurableSet {p : ℕ × (ℕ → ℝ) |
        ∀ a : ℕ, a < p.1 → p.2 a ∈ B} := by
      have hs (a : ℕ) : MeasurableSet {p : ℕ × (ℕ → ℝ) |
          a < p.1 → p.2 a ∈ B} := by
        have hleft : MeasurableSet {p : ℕ × (ℕ → ℝ) | a < p.1} :=
          measurableSet_lt measurable_const measurable_fst
        have hright : MeasurableSet {p : ℕ × (ℕ → ℝ) | p.2 a ∈ B} :=
          ((measurable_pi_apply a).comp measurable_snd) hB
        convert hleft.compl.union hright using 1
        ext p
        simp only [Set.mem_ofPred_eq, Set.mem_union, Set.mem_compl_iff, imp_iff_not_or]
      simpa only [Set.ofPred_forall] using MeasurableSet.iInter hs
    have husedNat : ∀ᵐ p ∂ν k, ∀ a : ℕ, a < p.1 → p.2 a ∈ B := by
      change ∀ᵐ p ∂(ProbabilityTheory.poissonMeasure (μ k).mass).prod
        (Measure.infinitePi (fun _ : ℕ => ((μ k).normalize : Measure ℝ))),
          ∀ a : ℕ, a < p.1 → p.2 a ∈ B
      rw [Measure.ae_prod_iff_ae_ae hmeas]
      by_cases hzero : μ k = 0
      · have hmass : (μ k).mass = 0 := congrArg FiniteMeasure.mass hzero
        have hcount : ∀ᵐ n ∂ProbabilityTheory.poissonMeasure (μ k).mass, n = 0 := by
          rw [ae_iff]
          change ProbabilityTheory.poissonMeasure (μ k).mass ({0} : Set ℕ)ᶜ = 0
          rw [measure_compl (measurableSet_singleton 0) (measure_ne_top _ _), measure_univ]
          simp [hmass, ProbabilityTheory.poissonMeasure_singleton]
        filter_upwards [hcount] with n hn
        subst n
        filter_upwards [] with z
        intro a ha
        exact False.elim (Nat.not_lt_zero a ha)
      · have hmark : ∀ᵐ u ∂((μ k).normalize : Measure ℝ), u ∈ B := by
          rw [ae_iff]
          change ((μ k).normalize : Measure ℝ) Bᶜ = 0
          rw [(μ k).toMeasure_normalize_eq_of_nonzero hzero,
            Measure.smul_apply, hcap, smul_zero]
        have hmarks : ∀ᵐ z ∂Measure.infinitePi
            (fun _ : ℕ => ((μ k).normalize : Measure ℝ)), ∀ a : ℕ, z a ∈ B := by
          rw [ae_all_iff]
          intro a
          exact (measurePreserving_eval_infinitePi
            (fun _ : ℕ => ((μ k).normalize : Measure ℝ)) a).quasiMeasurePreserving.ae hmark
        filter_upwards [] with n
        filter_upwards [hmarks] with z hz
        intro a _
        exact hz a
    filter_upwards [husedNat] with p hp
    intro a
    have ha := hp a.val a.isLt
    change (2 : ℝ) ^ k < p.2 a.val ∧
      p.2 a.val ≤ min κ ((2 : ℝ) ^ (k + 1)) at ha
    exact ⟨ha.1, (le_min_iff.mp ha.2).1, (le_min_iff.mp ha.2).2⟩
  have hraw : ∀ᵐ ω ∂ρ, ∀ (k : ℤ) (a : Fin (ω k).1),
      (2 : ℝ) ^ k < (ω k).2 a.val ∧
        (ω k).2 a.val ≤ κ ∧ (ω k).2 a.val ≤ (2 : ℝ) ^ (k + 1) := by
    rw [ae_all_iff]
    intro k
    exact (measurePreserving_eval_infinitePi ν k).quasiMeasurePreserving.ae (hused k)
  let F : (Fin d → ℤ → ℕ × (ℕ → ℝ)) → (Fin d → FiniteMeasure ℝ) :=
    fun Ω i => f (Ω i)
  have hF : Measurable F :=
    measurable_pi_lambda _ fun i => hf.comp (measurable_pi_apply i)
  let : IsProbabilityMeasure (ρ.map f) := inferInstance
  have hpi : (Measure.pi (fun _ : Fin d => ρ)).map F =
      Measure.pi (fun _ : Fin d => fragmentLaw κ) := by
    rw [Measure.pi_map_pi (fun _ => hf.aemeasurable)]
    simp only [hlaw]
  rw [← hpi, ae_map_iff hF.aemeasurable hP]
  have hall : ∀ᵐ Ω ∂Measure.pi (fun _ : Fin d => ρ),
      ∀ (i : Fin d) (k : ℤ) (a : Fin (Ω i k).1),
        (2 : ℝ) ^ k < (Ω i k).2 a.val ∧
          (Ω i k).2 a.val ≤ κ ∧ (Ω i k).2 a.val ≤ (2 : ℝ) ^ (k + 1) := by
    rw [ae_all_iff]
    intro i
    exact (measurePreserving_eval (fun _ : Fin d => ρ) i).quasiMeasurePreserving.ae hraw
  filter_upwards [hall] with Ω hΩ
  have hex (i : Fin d) : ∃ (Y : FiniteMeasure ℝ) (n : ℕ) (x : Fin n → ℝ),
      Y.restrict (Set.Ioc (0 : ℝ) δ) = Y ∧
        (∀ a, δ < x a ∧ x a ≤ κ) ∧ f (Ω i) = Y + weightedEmpirical n x :=
    exists_finiteFragments_eq_small_add_weightedEmpirical κ δ hκ hδ (Ω i) (hΩ i)
  choose Y n x hY hx hX using hex
  have heq : F Ω = fun i => Y i + weightedEmpirical (n i) (x i) := funext hX
  rw [heq]
  exact hfinite Y n x hY hx

section
open scoped ContDiff

theorem sum_card_divisors_pow_div_le_log_pow (e Z : ℕ) :
    (∑ d ∈ Finset.Icc 1 Z, (d.divisors.card : ℝ) ^ e / (d : ℝ)) ≤
      (1 + Real.log (Z : ℝ)) ^ (2 ^ e) := by
  calc
    _ ≤ ∑ d ∈ Finset.Icc 1 Z,
        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (2 ^ e)) d : ℝ) /
          (d : ℝ) := by
      apply Finset.sum_le_sum
      intro d hd
      apply div_le_div_of_nonneg_right _ (Nat.cast_nonneg d)
      exact_mod_cast card_divisors_pow_le_zeta_pow e d
        (Finset.mem_Icc.mp hd).1
    _ ≤ (harmonic Z : ℝ) ^ (2 ^ e) := sum_zeta_pow_div_le_harmonic_pow _ _
    _ ≤ _ := pow_le_pow_left₀ (by unfold harmonic; positivity)
      (harmonic_le_one_add_log Z) _

theorem sum_Ico_card_divisors_pow_modEq_le
    (Y K k X : ℕ) (hY : 2 ≤ Y) (hX : X ≤ Y ^ K)
    (b c q a : ℕ) (hb : 1 ≤ b) (hbc : b ≤ c) (hc : c ≤ X + 1)
    (hq : 0 < q) (ha : Nat.Coprime a q) :
    (∑ n ∈ (Finset.Ico b c).filter (fun n : ℕ => n % q = a % q),
      (n.divisors.card : ℝ) ^ k) ≤
      (2 : ℝ) ^ (K * k) * (1 + Real.log (Y ^ 2 : ℕ)) ^ (2 ^ (K * k)) *
        (((c - b : ℕ) : ℝ) / q + (Y ^ 2 : ℕ)) := by
  classical
  have hsmall (n : ℕ) (hYn : Y ≤ n) :
      ∃ d : ℕ, d ∣ n ∧ Y ≤ d ∧ (d ≤ Y ^ 2 ∨ d.Prime) := by
    have hex : ∃ d : ℕ, d ∣ n ∧ Y ≤ d := ⟨n, dvd_rfl, hYn⟩
    let d := Nat.find hex
    have hd : d ∣ n ∧ Y ≤ d := Nat.find_spec hex
    have hdpos : 0 < d := by omega
    obtain ⟨p, hp, hpd⟩ := Nat.exists_prime_and_dvd (show d ≠ 1 by omega)
    have hpdle : p ≤ d := Nat.le_of_dvd hdpos hpd
    have hquotdvd : d / p ∣ n := (Nat.div_dvd_of_dvd hpd).trans hd.1
    have hquotlt : d / p < d := Nat.div_lt_self hdpos hp.one_lt
    have hquotY : d / p < Y := Nat.lt_of_not_ge
      (fun h => Nat.find_min hex hquotlt ⟨hquotdvd, h⟩)
    refine ⟨d, hd.1, hd.2, ?_⟩
    by_cases hYp : Y ≤ p
    · have hdp : d ≤ p := Nat.find_min' hex ⟨hpd.trans hd.1, hYp⟩
      have heq : d = p := Nat.le_antisymm hdp hpdle
      exact Or.inr (heq ▸ hp)
    · apply Or.inl
      calc
        d = p * (d / p) := (Nat.mul_div_cancel' hpd).symm
        _ ≤ Y * Y := Nat.mul_le_mul (by omega) (by omega)
        _ = Y ^ 2 := (pow_two Y).symm
  have hgroup (s m n : ℕ) (hm : 2 ≤ m) (hn : 0 < n) (hnY : n ≤ Y ^ s)
      (hbound : ∀ d : ℕ, d ∣ n → d ≤ Y ^ 2 → d.divisors.card ≤ m) :
      n.divisors.card ≤ m ^ s := by
    induction s generalizing n with
    | zero =>
      have hn1 : n = 1 := by
        simpa only [pow_zero] using Nat.le_antisymm hnY hn
      simp [hn1]
    | succ s ih =>
      by_cases hnsmall : n < Y
      · have hnY2 : n ≤ Y ^ 2 := by nlinarith
        exact (hbound n dvd_rfl hnY2).trans
          (le_self_pow₀ (show 1 ≤ m by omega) (Nat.succ_ne_zero s))
      · obtain ⟨d, hdn, hYd, hdcase⟩ := hsmall n (by omega)
        have hdpos : 0 < d := by omega
        have hquotpos : 0 < n / d := Nat.div_pos (Nat.le_of_dvd hn hdn) hdpos
        have hprod : d * (n / d) = n := Nat.mul_div_cancel' hdn
        have hquotpow : n / d ≤ Y ^ s := Nat.div_le_of_le_mul (by
          calc
            n ≤ Y * Y ^ s := by simpa only [pow_succ, Nat.mul_comm] using hnY
            _ ≤ d * Y ^ s := Nat.mul_le_mul_right _ hYd)
        have hquot : (n / d).divisors.card ≤ m ^ s :=
          ih (n / d) hquotpos hquotpow (fun e he heY =>
            hbound e (he.trans (Nat.div_dvd_of_dvd hdn)) heY)
        have hdcard : d.divisors.card ≤ m := by
          rcases hdcase with hdsmall | hdprime
          · exact hbound d hdn hdsmall
          · simpa only [hdprime.divisors, Finset.card_pair hdprime.ne_one.symm] using hm
        calc
          n.divisors.card = (d * (n / d)).divisors.card := by rw [hprod]
          _ ≤ d.divisors.card * (n / d).divisors.card := by
            rw [Nat.divisors_mul]
            exact Finset.card_mul_le
          _ ≤ m * m ^ s := Nat.mul_le_mul hdcard hquot
          _ = m ^ (s + 1) := by rw [pow_succ, Nat.mul_comm]
  have hmajorant (n : ℕ) (hn : 0 < n) (hnY : n ≤ Y ^ K) :
      n.divisors.card ^ k ≤
        2 ^ (K * k) * ∑ d ∈ n.divisors.filter (fun d => d ≤ Y ^ 2),
          d.divisors.card ^ (K * k) := by
    let V := n.divisors.filter (fun d => d ≤ Y ^ 2)
    have hone : 1 ∈ V := Finset.mem_filter.mpr
      ⟨Nat.one_mem_divisors.mpr hn.ne', by nlinarith⟩
    let m := V.sup (fun d : ℕ => d.divisors.card)
    have hm : 1 ≤ m := Finset.le_sup_of_le hone (by simp)
    have hfull : n.divisors.card ≤ (2 * m) ^ K :=
      hgroup K (2 * m) n (by omega) hn hnY (by
        intro d hdn hdY
        have hdV : d ∈ V := Finset.mem_filter.mpr
          ⟨Nat.mem_divisors.mpr ⟨hdn, hn.ne'⟩, hdY⟩
        exact (Finset.le_sup (f := fun d : ℕ => d.divisors.card) hdV).trans (by omega))
    obtain ⟨d, hd, hmax⟩ := Finset.exists_mem_eq_sup V ⟨1, hone⟩
      (fun d : ℕ => d.divisors.card)
    have hmaxsum : m ^ (K * k) ≤ ∑ e ∈ V, e.divisors.card ^ (K * k) := by
      rw [show m = d.divisors.card from hmax]
      exact Finset.single_le_sum (f := fun e : ℕ => e.divisors.card ^ (K * k))
        (fun _ _ => Nat.zero_le _) hd
    calc
      n.divisors.card ^ k ≤ ((2 * m) ^ K) ^ k := Nat.pow_le_pow_left hfull k
      _ = 2 ^ (K * k) * m ^ (K * k) := by rw [← pow_mul, mul_pow]
      _ ≤ _ := Nat.mul_le_mul_left _ hmaxsum
  have hfilter (n : ℕ) (hn : 0 < n) :
      n.divisors.filter (fun d => d ≤ Y ^ 2) =
        (Finset.Icc 1 (Y ^ 2)).filter (fun d => d ∣ n) := by
    ext d
    simp only [Finset.mem_filter, Nat.mem_divisors, Finset.mem_Icc]
    constructor
    · rintro ⟨⟨hd, _⟩, hdY⟩
      exact ⟨⟨Nat.pos_of_dvd_of_pos hd hn, hdY⟩, hd⟩
    · rintro ⟨⟨_, hdY⟩, hd⟩
      exact ⟨⟨hd, hn.ne'⟩, hdY⟩
  have hcount (b c q v : ℕ) (hbc : b ≤ c) (hq : 0 < q) :
      |({n ∈ Finset.Ico b c | Nat.ModEq q n v}.card : ℝ) -
        ((c : ℝ) - b) / q| ≤ 1 := by
    let s : ℚ := ((c : ℚ) - v) / q
    let t : ℚ := ((b : ℚ) - v) / q
    have hqQ : (0 : ℚ) < q := Nat.cast_pos.mpr hq
    have hts : t ≤ s := by
      dsimp [s, t]
      exact div_le_div_of_nonneg_right
        (sub_le_sub_right (by exact_mod_cast hbc) _) hqQ.le
    have hdiff : 0 ≤ (⌈s⌉ : ℤ) - ⌈t⌉ := sub_nonneg.mpr (Int.ceil_mono hts)
    have hcardZ :
        ({n ∈ Finset.Ico b c | Nat.ModEq q n v}.card : ℤ) =
          (⌈s⌉ : ℤ) - ⌈t⌉ := by
      simpa [s, t, max_eq_left hdiff] using Nat.Ico_filter_modEq_card b c hq v
    have hcardR :
        ({n ∈ Finset.Ico b c | Nat.ModEq q n v}.card : ℝ) =
          (((⌈s⌉ : ℤ) - ⌈t⌉ : ℤ) : ℝ) := by exact_mod_cast hcardZ
    have herr : |((⌈s⌉ : ℚ) - ⌈t⌉) - (s - t)| ≤ 1 := by
      rw [abs_le]
      constructor <;>
        linarith [Int.le_ceil s, Int.ceil_lt_add_one s, Int.le_ceil t, Int.ceil_lt_add_one t]
    have herrR :
        |(((⌈s⌉ : ℤ) - ⌈t⌉ : ℤ) : ℝ) - ((s - t : ℚ) : ℝ)| ≤ 1 := by
      exact_mod_cast herr
    have hst : ((s - t : ℚ) : ℝ) = ((c : ℝ) - b) / q := by
      dsimp [s, t]
      push_cast
      ring
    rw [hcardR, ← hst]
    exact herrR
  have hcrt (b c d q v : ℕ) (hbc : b ≤ c) (hd : 0 < d)
      (hq : 0 < q) (hv : Nat.Coprime v q) :
      (((Finset.Ico b c).filter (fun n => n % q = v % q ∧ d ∣ n)).card : ℝ) ≤
        ((c - b : ℕ) : ℝ) / (d * q : ℕ) + 1 := by
    by_cases hdq : Nat.Coprime d q
    · have hset :
          (Finset.Ico b c).filter (fun n => n % q = v % q ∧ d ∣ n) =
          (Finset.Ico b c).filter (fun n =>
            Nat.ModEq (d * q) n (Nat.chineseRemainder hdq 0 v).val) := by
        ext n
        simp only [Finset.mem_filter]
        constructor
        · rintro ⟨hn, hmod, hdiv⟩
          exact ⟨hn, Nat.chineseRemainder_modEq_unique hdq
            (Nat.modEq_zero_iff_dvd.mpr hdiv) hmod⟩
        · rintro ⟨hn, hmod⟩
          obtain ⟨hd', hq'⟩ := (Nat.modEq_and_modEq_iff_modEq_mul hdq).mpr hmod
          have hc := (Nat.chineseRemainder hdq 0 v).property
          exact ⟨hn, hq'.trans hc.2, Nat.modEq_zero_iff_dvd.mp (hd'.trans hc.1)⟩
      have herr := (abs_le.mp (hcount b c (d * q)
        (Nat.chineseRemainder hdq 0 v).val hbc (Nat.mul_pos hd hq))).2
      rw [hset, Nat.cast_sub hbc]
      linarith
    · have hempty :
          (Finset.Ico b c).filter (fun n => n % q = v % q ∧ d ∣ n) = ∅ := by
        apply Finset.filter_eq_empty_iff.mpr
        intro n _ hjoint
        have hncop : Nat.Coprime n q :=
          (show Nat.ModEq q n v from hjoint.1).gcd_eq.trans hv
        exact hdq (Nat.Coprime.of_dvd_left hjoint.2 hncop)
      simp only [hempty, Finset.card_empty, Nat.cast_zero]
      positivity
  let Z := Y ^ 2
  have hZ : 1 ≤ Z := one_le_pow₀ (by omega : 1 ≤ Y)
  let e := K * k
  let T := (1 + Real.log (Z : ℝ)) ^ (2 ^ e)
  have hT : 0 ≤ ((c - b : ℕ) : ℝ) / q := by positivity
  have hdouble :
      (∑ d ∈ Finset.Icc 1 Z, (d.divisors.card : ℝ) ^ e *
        (((Finset.Ico b c).filter (fun n => n % q = a % q ∧ d ∣ n)).card : ℝ)) ≤
        (((c - b : ℕ) : ℝ) / q + Z) * T := by
    calc
      _ ≤ ∑ d ∈ Finset.Icc 1 Z, (d.divisors.card : ℝ) ^ e *
          (((c - b : ℕ) : ℝ) / (d * q : ℕ) + 1) := by
        apply Finset.sum_le_sum
        intro d hd
        exact mul_le_mul_of_nonneg_left
          (hcrt b c d q a hbc (Finset.mem_Icc.mp hd).1 hq ha) (by positivity)
      _ = (((c - b : ℕ) : ℝ) / q) *
          (∑ d ∈ Finset.Icc 1 Z, (d.divisors.card : ℝ) ^ e / d) +
            ∑ d ∈ Finset.Icc 1 Z, (d.divisors.card : ℝ) ^ e := by
        simp only [mul_add, mul_one, Finset.sum_add_distrib, Finset.mul_sum, Nat.cast_mul]
        congr 1
        apply Finset.sum_congr rfl
        intro d _
        ring
      _ ≤ (((c - b : ℕ) : ℝ) / q) * T + (Z : ℝ) * T := by
        apply add_le_add
        · exact mul_le_mul_of_nonneg_left
            (sum_card_divisors_pow_div_le_log_pow e Z) hT
        · refine (sum_card_divisors_pow_le_mul_log_pow e Z).trans ?_
          apply mul_le_mul_of_nonneg_left _ (Nat.cast_nonneg Z)
          apply pow_le_pow_right₀
          · exact le_add_of_nonneg_right (Real.log_nonneg (by exact_mod_cast hZ))
          · exact Nat.sub_le _ _
      _ = _ := by ring
  have hswap :
      (∑ n ∈ (Finset.Ico b c).filter (fun n => n % q = a % q),
        ∑ d ∈ n.divisors.filter (fun d => d ≤ Y ^ 2), (d.divisors.card : ℝ) ^ e) =
        ∑ d ∈ Finset.Icc 1 Z, (d.divisors.card : ℝ) ^ e *
          (((Finset.Ico b c).filter (fun n => n % q = a % q ∧ d ∣ n)).card : ℝ) := by
    calc
      _ = ∑ n ∈ (Finset.Ico b c).filter (fun n => n % q = a % q),
          ∑ d ∈ Finset.Icc 1 Z, if d ∣ n then (d.divisors.card : ℝ) ^ e else 0 := by
        apply Finset.sum_congr rfl
        intro n hn
        have hnpos : 0 < n := hb.trans
          (Finset.mem_Ico.mp (Finset.mem_filter.mp hn).1).1
        rw [hfilter n hnpos, Finset.sum_filter]
      _ = ∑ d ∈ Finset.Icc 1 Z,
          ∑ n ∈ (Finset.Ico b c).filter (fun n => n % q = a % q),
            if d ∣ n then (d.divisors.card : ℝ) ^ e else 0 := Finset.sum_comm
      _ = _ := by
        apply Finset.sum_congr rfl
        intro d _
        rw [← Finset.sum_filter]
        simp only [Finset.filter_filter, Finset.sum_const, nsmul_eq_mul, mul_comm]
  calc
    _ ≤ (2 : ℝ) ^ e *
        ∑ n ∈ (Finset.Ico b c).filter (fun n => n % q = a % q),
          ∑ d ∈ n.divisors.filter (fun d => d ≤ Y ^ 2), (d.divisors.card : ℝ) ^ e := by
      rw [Finset.mul_sum]
      apply Finset.sum_le_sum
      intro n hn
      obtain ⟨hbn, hnc⟩ := Finset.mem_Ico.mp (Finset.mem_filter.mp hn).1
      have hnpos : 0 < n := hb.trans hbn
      have hnX : n ≤ X := by omega
      exact_mod_cast hmajorant n hnpos (hnX.trans hX)
    _ = (2 : ℝ) ^ e * ∑ d ∈ Finset.Icc 1 Z, (d.divisors.card : ℝ) ^ e *
        (((Finset.Ico b c).filter (fun n => n % q = a % q ∧ d ∣ n)).card : ℝ) := by
      rw [hswap]
    _ ≤ (2 : ℝ) ^ e * ((((c - b : ℕ) : ℝ) / q + Z) * T) :=
      mul_le_mul_of_nonneg_left hdouble (by positivity)
    _ = _ := by dsimp [T, e, Z]; ring

theorem long_progression_card_divisors_pow_bound
    (θ : ℝ) (hθ0 : 0 < θ) (hθ1 : θ < 1)
    (k : ℕ) (Cscale : ℝ) (hCscale : 1 ≤ Cscale) :
    ∃ P : ℕ, ∃ K : ℝ, 0 < K ∧
      ∀ x : ℝ, Real.exp 1 ≤ x →
      ∀ q a : ℕ, 0 < q → (q : ℝ) ≤ x ^ θ → Nat.Coprime a q →
        (∑ n ∈ (Finset.Icc 1 ⌈Cscale * x⌉₊).filter
            (fun n : ℕ => n % q = a % q), (n.divisors.card : ℝ) ^ k) ≤
          K * x / q * (Real.log x) ^ P := by
  obtain ⟨κ, hκ⟩ := exists_nat_gt (max (3 : ℝ) (2 / (1 - θ)))
  have hκpos : (0 : ℝ) < κ := lt_of_lt_of_le (by positivity) hκ.le
  let α : ℝ := 2 / (κ : ℝ)
  have hαpos : 0 < α := div_pos (by norm_num) hκpos
  have hαgap : α < 1 - θ :=
    (div_lt_comm₀ hκpos (sub_pos.mpr hθ1)).mpr ((le_max_right _ _).trans_lt hκ)
  have hα1 : α ≤ 1 := hαgap.le.trans (sub_le_self 1 hθ0.le)
  let P : ℕ := 2 ^ (κ * k)
  have hCscale0 : 0 < Cscale := zero_lt_one.trans_le hCscale
  let cY : ℝ := 32 * Cscale
  have hcY1 : 1 ≤ cY := by dsimp only [cY]; linarith only [hCscale]
  have hcYpos : 0 < cY := zero_lt_one.trans_le hcY1
  have hlogcY : 0 ≤ Real.log cY := Real.log_nonneg hcY1
  let dY : ℝ := 2 + Real.log cY
  have hdYpos : 0 < dY := add_pos_of_pos_of_nonneg (by norm_num) hlogcY
  let Kraw : ℝ := 34 * Cscale * (2 : ℝ) ^ (κ * k) * dY ^ P
  have hKraw : 0 < Kraw := by dsimp only [Kraw]; positivity
  refine ⟨P, Kraw, hKraw, ?_⟩
  intro x hxexp q a hq hqx ha
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hx1 : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hxexp
  have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxpos).mpr hxexp
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlog1
  have hqpos : (0 : ℝ) < q := by exact_mod_cast hq
  let X : ℕ := ⌈Cscale * x⌉₊
  let t : ℝ := (X : ℝ) ^ (1 / (κ : ℝ))
  let Y : ℕ := 2 + ⌈t⌉₊
  have hCx1 : 1 ≤ Cscale * x := one_le_mul_of_one_le_of_one_le hCscale hx1
  have hX1r : (1 : ℝ) ≤ X := hCx1.trans (Nat.le_ceil _)
  have hX0 : (0 : ℝ) ≤ X := Nat.cast_nonneg X
  have hXupper : (X : ℝ) ≤ 2 * Cscale * x := by
    have h := (Nat.ceil_lt_add_one (zero_le_one.trans hCx1)).le
    change (X : ℝ) ≤ Cscale * x + 1 at h
    nlinarith only [h, hCx1]
  have ht1 : 1 ≤ t := Real.one_le_rpow hX1r (by positivity)
  have ht0 : 0 ≤ t := zero_le_one.trans ht1
  have hY : 2 ≤ Y := by dsimp only [Y]; omega
  have htY : t ≤ (Y : ℝ) := by
    simpa only [Y, Nat.cast_add, Nat.cast_ofNat] using
      (Nat.le_ceil t).trans (le_add_of_nonneg_left zero_le_two)
  have hYupper : (Y : ℝ) ≤ 4 * t := by
    have h := (Nat.ceil_lt_add_one ht0).le
    change ((2 + ⌈t⌉₊ : ℕ) : ℝ) ≤ 4 * t
    push_cast
    linarith only [h, ht1]
  have ht2 : t ^ 2 = (X : ℝ) ^ α := by
    dsimp only [t, α]
    rw [← Real.rpow_mul_natCast hX0]
    congr 1
    ring
  have hXscale : X ≤ Y ^ κ := by
    have h := (Real.rpow_inv_le_iff_of_pos hX0 (Nat.cast_nonneg Y) hκpos).mp
      (by simpa only [t, one_div] using htY)
    rw [Real.rpow_natCast] at h
    exact_mod_cast h
  have hCpow : (2 * Cscale) ^ α ≤ 2 * Cscale := Real.rpow_le_self_of_one_le
    (show (1 : ℝ) ≤ 2 * Cscale by linarith only [hCscale]) hα1
  have hY2 : ((Y ^ 2 : ℕ) : ℝ) ≤ 32 * Cscale * x ^ α := by
    calc
      _ = (Y : ℝ) ^ 2 := by simp only [Nat.cast_pow]
      _ ≤ (4 * t) ^ 2 := pow_le_pow_left₀ (Nat.cast_nonneg _) hYupper 2
      _ = 16 * (X : ℝ) ^ α := by
        rw [show (4 * t) ^ 2 = 16 * t ^ 2 by ring, ht2]
      _ ≤ 16 * (2 * Cscale * x) ^ α :=
        mul_le_mul_of_nonneg_left (Real.rpow_le_rpow hX0 hXupper hαpos.le)
          (by norm_num)
      _ = 16 * (2 * Cscale) ^ α * x ^ α := by
        rw [Real.mul_rpow (by positivity) hxpos.le]
        ring
      _ ≤ 16 * (2 * Cscale) * x ^ α :=
        mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left hCpow (by norm_num))
          (Real.rpow_nonneg hxpos.le _)
      _ = _ := by ring
  have hYsq1 : (1 : ℝ) ≤ (Y ^ 2 : ℕ) := by
    exact_mod_cast (one_le_pow₀ (show 1 ≤ Y by omega) : 1 ≤ Y ^ 2)
  have hYsqpos : (0 : ℝ) < (Y ^ 2 : ℕ) := zero_lt_one.trans_le hYsq1
  have hxα : x ^ α ≤ x := Real.rpow_le_self_of_one_le hx1 hα1
  have hYsmall : ((Y ^ 2 : ℕ) : ℝ) ≤ cY * x :=
    hY2.trans (mul_le_mul_of_nonneg_left hxα hcYpos.le)
  have hlogY0 : 0 ≤ 1 + Real.log (Y ^ 2 : ℕ) :=
    add_nonneg zero_le_one (Real.log_nonneg hYsq1)
  have hlogY : 1 + Real.log (Y ^ 2 : ℕ) ≤ dY * Real.log x := by
    have h := Real.log_le_log hYsqpos hYsmall
    rw [Real.log_mul hcYpos.ne' hxpos.ne'] at h
    dsimp only [dY]
    nlinarith only [h, hlog1, hlogcY,
      mul_nonneg hlogcY (sub_nonneg.mpr hlog1)]
  have hxαq : x ^ α * (q : ℝ) ≤ x := by
    calc
      _ ≤ x ^ α * x ^ θ :=
        mul_le_mul_of_nonneg_left hqx (Real.rpow_nonneg hxpos.le _)
      _ = x ^ (α + θ) := (Real.rpow_add hxpos α θ).symm
      _ ≤ x := Real.rpow_le_self_of_one_le hx1 (by linarith only [hαgap])
  have hxαdiv : x ^ α ≤ x / q := (le_div_iff₀ hqpos).mpr hxαq
  have hYq : ((Y ^ 2 : ℕ) : ℝ) ≤ 32 * Cscale * x / q := by
    calc
      _ ≤ 32 * Cscale * x ^ α := hY2
      _ ≤ 32 * Cscale * (x / q) :=
        mul_le_mul_of_nonneg_left hxαdiv (by positivity)
      _ = _ := by ring
  have hXq : (X : ℝ) / q ≤ 2 * Cscale * x / q :=
    div_le_div_of_nonneg_right hXupper hqpos.le
  have hsize : (X : ℝ) / q + (Y ^ 2 : ℕ) ≤ 34 * Cscale * x / q := by
    calc
      _ ≤ 2 * Cscale * x / q + 32 * Cscale * x / q := add_le_add hXq hYq
      _ = _ := by ring
  have hI : Finset.Ico 1 (X + 1) = Finset.Icc 1 X := by
    ext n
    simp only [Finset.mem_Ico, Finset.mem_Icc]
    omega
  have hraw :
      (∑ n ∈ (Finset.Icc 1 X).filter (fun n : ℕ => n % q = a % q),
        (n.divisors.card : ℝ) ^ k) ≤
        (2 : ℝ) ^ (κ * k) * (1 + Real.log (Y ^ 2 : ℕ)) ^ P *
          ((X : ℝ) / q + (Y ^ 2 : ℕ)) := by
    simpa only [hI, Nat.add_sub_cancel] using
      sum_Ico_card_divisors_pow_modEq_le Y κ k X hY hXscale
        1 (X + 1) q a le_rfl (by omega) le_rfl hq ha
  calc
    _ ≤ (2 : ℝ) ^ (κ * k) * (1 + Real.log (Y ^ 2 : ℕ)) ^ P *
        ((X : ℝ) / q + (Y ^ 2 : ℕ)) := hraw
    _ ≤ (2 : ℝ) ^ (κ * k) * (dY * Real.log x) ^ P *
        (34 * Cscale * x / q) :=
      mul_le_mul
        (mul_le_mul_of_nonneg_left (pow_le_pow_left₀ hlogY0 hlogY P)
          (by positivity)) hsize (by positivity) (by positivity)
    _ = Kraw * x / q * (Real.log x) ^ P := by
      dsimp only [Kraw]
      rw [mul_pow]
      ring

theorem exceptional_smallPrimePart_reciprocal_moment_bound
    (x : ℝ) (hx : Real.exp 1 ≤ x) (J Q : ℕ) :
    (∑ q ∈ (Finset.Icc 1 Q).filter (fun q : ℕ =>
        Real.exp ((Real.log x) ^ (2 / 3 : ℝ)) <
          (smallPrimePart
            ⌊Real.exp ((Real.log x) ^ (1 / 3 : ℝ))⌋₊ q : ℝ)),
      (q.divisors.card : ℝ) ^ J / q) ≤
        Real.exp (-(Real.log 2 * (Real.log x) ^ (1 / 3 : ℝ))) *
          (1 + Real.log (Q : ℝ)) ^ (2 ^ (J + 1)) := by
  classical
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le hx
  have hlog : 0 < Real.log x :=
    zero_lt_one.trans_le ((Real.le_log_iff_exp_le hx0).2 hx)
  let t : ℝ := (Real.log x) ^ (1 / 3 : ℝ)
  have ht : 0 < t := Real.rpow_pos_of_pos hlog _
  have ht2 : t ^ 2 = (Real.log x) ^ (2 / 3 : ℝ) := by
    calc
      t ^ 2 = (Real.log x) ^ ((1 / 3 : ℝ) * (2 : ℕ)) :=
        (Real.rpow_mul_natCast hlog.le _ 2).symm
      _ = (Real.log x) ^ (2 / 3 : ℝ) := by norm_num
  let T : Finset ℕ := (Finset.Icc 1 Q).filter (fun q : ℕ =>
    Real.exp ((Real.log x) ^ (2 / 3 : ℝ)) <
      (smallPrimePart ⌊Real.exp t⌋₊ q : ℝ))
  have hweight (q : ℕ) (hq : q ∈ T) :
      (q.divisors.card : ℝ) ^ J / q ≤
        Real.exp (-(Real.log 2 * t)) * ((q.divisors.card : ℝ) ^ (J + 1) / q) := by
    obtain ⟨hqI, hqex⟩ := Finset.mem_filter.mp hq
    have hq0 : q ≠ 0 := by
      have := (Finset.mem_Icc.mp hqI).1
      omega
    let F : Finset ℕ := q.primeFactors.filter (fun p : ℕ => p ≤ ⌊Real.exp t⌋₊)
    have hprod : (smallPrimePart ⌊Real.exp t⌋₊ q : ℝ) ≤
        Real.exp (t * (F.card : ℝ)) := by
      calc
        (smallPrimePart ⌊Real.exp t⌋₊ q : ℝ) =
            ∏ p ∈ F, (p : ℝ) := by
          simp only [smallPrimePart, F, Nat.cast_prod]
        _ ≤ ∏ _p ∈ F, Real.exp t := by
          apply Finset.prod_le_prod (fun p _ => Nat.cast_nonneg p)
          intro p hp
          exact (Nat.le_floor_iff (Real.exp_pos t).le).mp (Finset.mem_filter.mp hp).2
        _ = Real.exp t ^ F.card := by simp only [Finset.prod_const]
        _ = Real.exp ((F.card : ℝ) * t) := (Real.exp_nat_mul t F.card).symm
        _ = Real.exp (t * (F.card : ℝ)) := by rw [mul_comm (F.card : ℝ) t]
    have hsq : t ^ 2 < t * (F.card : ℝ) := by
      rw [ht2]
      exact Real.exp_lt_exp.mp (hqex.trans_le hprod)
    have htF : t < (F.card : ℝ) :=
      (mul_lt_mul_iff_right₀ ht).mp (by simpa only [pow_two] using hsq)
    have hF : F.card ≤ q.primeFactors.card :=
      Finset.card_le_card (Finset.filter_subset _ _)
    have hdivisorCount : 2 ^ q.primeFactors.card ≤ q.divisors.card := by
      rw [Nat.card_divisors hq0, ← Finset.prod_const]
      apply Finset.prod_le_prod'
      intro p hp
      exact Nat.succ_le_succ
        ((Nat.prime_of_mem_primeFactors hp).factorization_pos_of_dvd hq0
          (Nat.dvd_of_mem_primeFactors hp))
    have htau : Real.exp (Real.log 2 * t) < (q.divisors.card : ℝ) := by
      calc
        Real.exp (Real.log 2 * t) < Real.exp (Real.log 2 * (F.card : ℝ)) :=
          Real.exp_lt_exp.mpr
            (mul_lt_mul_of_pos_left htF (Real.log_pos (by norm_num : (1 : ℝ) < 2)))
        _ = (2 : ℝ) ^ F.card := by
          rw [mul_comm (Real.log 2) (F.card : ℝ), Real.exp_nat_mul,
            Real.exp_log (by norm_num : (0 : ℝ) < 2)]
        _ ≤ (2 : ℝ) ^ q.primeFactors.card :=
          pow_le_pow_right₀ (by norm_num : (1 : ℝ) ≤ 2) hF
        _ ≤ (q.divisors.card : ℝ) := by exact_mod_cast hdivisorCount
    have hcancel : Real.exp (-(Real.log 2 * t)) * Real.exp (Real.log 2 * t) = 1 := by
      rw [Real.exp_neg]
      exact inv_mul_cancel₀ (Real.exp_ne_zero _)
    have hone : 1 ≤ Real.exp (-(Real.log 2 * t)) * (q.divisors.card : ℝ) := by
      calc
        1 = Real.exp (-(Real.log 2 * t)) * Real.exp (Real.log 2 * t) := hcancel.symm
        _ ≤ Real.exp (-(Real.log 2 * t)) * (q.divisors.card : ℝ) :=
          mul_le_mul_of_nonneg_left htau.le (Real.exp_pos _).le
    have hpow : (q.divisors.card : ℝ) ^ J ≤
        Real.exp (-(Real.log 2 * t)) * (q.divisors.card : ℝ) ^ (J + 1) := by
      calc
        (q.divisors.card : ℝ) ^ J = 1 * (q.divisors.card : ℝ) ^ J := by rw [one_mul]
        _ ≤ (Real.exp (-(Real.log 2 * t)) * (q.divisors.card : ℝ)) *
            (q.divisors.card : ℝ) ^ J :=
          mul_le_mul_of_nonneg_right hone (pow_nonneg (Nat.cast_nonneg _) _)
        _ = Real.exp (-(Real.log 2 * t)) * (q.divisors.card : ℝ) ^ (J + 1) := by
          rw [pow_succ]
          ring
    simpa only [mul_div_assoc] using
      div_le_div_of_nonneg_right hpow (Nat.cast_nonneg q)
  change (∑ q ∈ T, (q.divisors.card : ℝ) ^ J / q) ≤
    Real.exp (-(Real.log 2 * t)) * (1 + Real.log (Q : ℝ)) ^ (2 ^ (J + 1))
  calc
    (∑ q ∈ T, (q.divisors.card : ℝ) ^ J / q) ≤
        ∑ q ∈ T, Real.exp (-(Real.log 2 * t)) *
          ((q.divisors.card : ℝ) ^ (J + 1) / q) := Finset.sum_le_sum hweight
    _ = Real.exp (-(Real.log 2 * t)) *
        ∑ q ∈ T, (q.divisors.card : ℝ) ^ (J + 1) / q :=
      (Finset.mul_sum _ _ _).symm
    _ ≤ Real.exp (-(Real.log 2 * t)) *
        ∑ q ∈ Finset.Icc 1 Q, (q.divisors.card : ℝ) ^ (J + 1) / q := by
      apply mul_le_mul_of_nonneg_left _ (Real.exp_pos _).le
      apply Finset.sum_le_sum_of_subset_of_nonneg (Finset.filter_subset _ _)
      intro q _hq _hqT
      exact div_nonneg (pow_nonneg (Nat.cast_nonneg _) _) (Nat.cast_nonneg q)
    _ ≤ Real.exp (-(Real.log 2 * t)) *
        (1 + Real.log (Q : ℝ)) ^ (2 ^ (J + 1)) :=
      mul_le_mul_of_nonneg_left (sum_card_divisors_pow_div_le_log_pow (J + 1) Q)
        (Real.exp_pos _).le

end

/-- The subtype of Dirichlet characters modulo `d` equipped with a proof of primitivity. -/
abbrev primitiveCharacters (d : ℕ) :=
  {ψ : DirichletCharacter ℂ d // ψ.IsPrimitive}

noncomputable instance primitiveCharactersFintype (d : ℕ) :
    Fintype (primitiveCharacters d) := Fintype.ofFinite _

/--
The unnormalized character transform of a function on the units modulo `q`: the sum of `chi⁻¹ a
* b a`. No factor of `1 / q.totient` is included.
-/
noncomputable def dirichletCharacterUnitTransform
    {q : ℕ} [NeZero q] (b : (ZMod q)ˣ → ℂ)
    (χ : DirichletCharacter ℂ q) : ℂ :=
  ∑ a : (ZMod q)ˣ, χ⁻¹ (a : ZMod q) * b a

theorem sum_norm_sq_dirichletCharacterUnitTransform
    {q : ℕ} [NeZero q] (b : (ZMod q)ˣ → ℂ) :
    (∑ χ : DirichletCharacter ℂ q,
      ‖dirichletCharacterUnitTransform b χ‖ ^ 2) =
      (q.totient : ℝ) * ∑ a : (ZMod q)ˣ, ‖b a‖ ^ 2 := by
  have hcomplex :
      (∑ χ : DirichletCharacter ℂ q,
        star (dirichletCharacterUnitTransform b χ) *
          dirichletCharacterUnitTransform b χ) =
        (q.totient : ℂ) * ∑ a : (ZMod q)ˣ, star (b a) * b a := by
    simp_rw [dirichletCharacterUnitTransform, star_sum, star_mul]
    simp_rw [Finset.sum_mul, Finset.mul_sum]
    calc
      (∑ χ : DirichletCharacter ℂ q,
          ∑ a : (ZMod q)ˣ,
            ∑ c : (ZMod q)ˣ,
              (star (b a) * star (χ⁻¹ (a : ZMod q))) *
                (χ⁻¹ (c : ZMod q) * b c)) =
          ∑ a : (ZMod q)ˣ,
            ∑ c : (ZMod q)ˣ,
              ∑ χ : DirichletCharacter ℂ q,
                (star (b a) * star (χ⁻¹ (a : ZMod q))) *
                  (χ⁻¹ (c : ZMod q) * b c) := by
        rw [Finset.sum_comm]
        apply Finset.sum_congr rfl
        intro a _ha
        rw [Finset.sum_comm]
      _ = ∑ a : (ZMod q)ˣ,
          ∑ c : (ZMod q)ˣ,
            (star (b a) * b c) *
              ∑ χ : DirichletCharacter ℂ q,
                star (χ⁻¹ (a : ZMod q)) * χ⁻¹ (c : ZMod q) := by
        apply Finset.sum_congr rfl
        intro a _ha
        apply Finset.sum_congr rfl
        intro c _hc
        rw [Finset.mul_sum]
        apply Finset.sum_congr rfl
        intro χ _hχ
        ring
      _ = ∑ a : (ZMod q)ˣ,
          ∑ c : (ZMod q)ˣ,
            (star (b a) * b c) *
              (if a = c then (q.totient : ℂ) else 0) := by
        apply Finset.sum_congr rfl
        intro a _ha
        apply Finset.sum_congr rfl
        intro c _hc
        congr 1
        simp_rw [MulChar.star_apply', inv_inv]
        simp_rw [MulChar.inv_apply_eq_inv']
        simpa only [ZMod.inv_coe_unit, map_units_inv, mul_comm, Units.val_inj, eq_comm] using
          (DirichletCharacter.sum_char_inv_mul_char_eq ℂ c.isUnit (a : ZMod q))
      _ = ∑ a : (ZMod q)ˣ,
          (q.totient : ℂ) * (star (b a) * b a) := by
        apply Finset.sum_congr rfl
        intro a _ha
        simp
        ring
  rw [Complex.star_def] at hcomplex
  simp_rw [← Complex.normSq_eq_conj_mul_self,
    Complex.normSq_eq_norm_sq] at hcomplex
  exact_mod_cast hcomplex

theorem sum_norm_sq_primitiveCharacterUnitTransform_le
    {q : ℕ} [NeZero q] (b : (ZMod q)ˣ → ℂ) :
    (∑ ψ : primitiveCharacters q,
      ‖dirichletCharacterUnitTransform b ψ.1‖ ^ 2) ≤
      (q.totient : ℝ) * ∑ a : (ZMod q)ˣ, ‖b a‖ ^ 2 := by
  classical
  rw [← sum_norm_sq_dirichletCharacterUnitTransform]
  exact Finset.sum_le_sum_of_injOn Subtype.val Subtype.val_injective.injOn
    (Finset.subset_univ _) (fun _ _ => le_rfl) (by intros; positivity)

theorem sum_units_invCharacter_mul_stdAddChar_eq_sum_zmod
    {q : ℕ} [NeZero q] (χ : DirichletCharacter ℂ q) (n : ZMod q) :
    (∑ u : (ZMod q)ˣ,
      χ⁻¹ (u : ZMod q) * ZMod.stdAddChar ((u : ZMod q) * n)) =
      ∑ a : ZMod q, χ⁻¹ a * ZMod.stdAddChar (a * n) := by
  refine Fintype.sum_of_injective ((↑) : (ZMod q)ˣ → ZMod q)
    Units.val_injective _ _ ?_ (fun _ ↦ rfl)
  intro a ha
  simp [MulChar.map_nonunit χ⁻¹ (show ¬ IsUnit a from ha)]

theorem dirichletCharacterUnitTransform_additive_eq_gaussSum_mul_twist
    {q : ℕ} [NeZero q] (s : Finset ℕ) (c : ℕ → ℂ)
    (ψ : primitiveCharacters q) :
    dirichletCharacterUnitTransform
        (fun u ↦ ∑ n ∈ s,
          c n * ZMod.stdAddChar ((u : ZMod q) * (n : ZMod q))) ψ.1 =
      gaussSum ψ.1⁻¹ ZMod.stdAddChar *
        ∑ n ∈ s, c n * ψ.1 n := by
  unfold dirichletCharacterUnitTransform
  calc
    (∑ u : (ZMod q)ˣ,
        ψ.1⁻¹ (u : ZMod q) *
          ∑ n ∈ s,
            c n * ZMod.stdAddChar ((u : ZMod q) * (n : ZMod q))) =
        ∑ u : (ZMod q)ˣ,
          ∑ n ∈ s,
            ψ.1⁻¹ (u : ZMod q) *
              (c n * ZMod.stdAddChar ((u : ZMod q) * (n : ZMod q))) := by
      apply Finset.sum_congr rfl
      intro u _hu
      rw [Finset.mul_sum]
    _ = ∑ n ∈ s,
        ∑ u : (ZMod q)ˣ,
          ψ.1⁻¹ (u : ZMod q) *
            (c n * ZMod.stdAddChar ((u : ZMod q) * (n : ZMod q))) := by
      rw [Finset.sum_comm]
    _ = ∑ n ∈ s, c n *
        ∑ u : (ZMod q)ˣ,
          ψ.1⁻¹ (u : ZMod q) *
            ZMod.stdAddChar ((u : ZMod q) * (n : ZMod q)) := by
      apply Finset.sum_congr rfl
      intro n _hn
      rw [Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro u _hu
      ring
    _ = ∑ n ∈ s, c n *
        (ψ.1 (n : ZMod q) * gaussSum ψ.1⁻¹ ZMod.stdAddChar) := by
      apply Finset.sum_congr rfl
      intro n _hn
      rw [sum_units_invCharacter_mul_stdAddChar_eq_sum_zmod]
      rw [primitive_fourier_expansion (χ := ψ.1) ψ.2 (n : ZMod q)]
    _ = gaussSum ψ.1⁻¹ ZMod.stdAddChar *
        ∑ n ∈ s, c n * ψ.1 n := by
      rw [Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro n _hn
      ring

theorem weighted_sum_norm_sq_primitiveTwists_le_unitAdditiveSums
    {q : ℕ} [NeZero q] (s : Finset ℕ) (c : ℕ → ℂ) :
    (q : ℝ) / (q.totient : ℝ) *
        ∑ ψ : primitiveCharacters q,
          ‖∑ n ∈ s, c n * ψ.1 n‖ ^ 2 ≤
      ∑ u : (ZMod q)ˣ,
        ‖∑ n ∈ s,
          c n * ZMod.stdAddChar ((u : ZMod q) * (n : ZMod q))‖ ^ 2 := by
  let b : (ZMod q)ˣ → ℂ := fun u ↦
    ∑ n ∈ s, c n * ZMod.stdAddChar ((u : ZMod q) * (n : ZMod q))
  have hphi : (0 : ℝ) < q.totient := by
    exact_mod_cast Nat.totient_pos.mpr q.pos_of_neZero
  have htransform (ψ : primitiveCharacters q) :
      ‖dirichletCharacterUnitTransform b ψ.1‖ ^ 2 =
        (q : ℝ) * ‖∑ n ∈ s, c n * ψ.1 n‖ ^ 2 := by
    have hψinv : ψ.1⁻¹.IsPrimitive := by
      rw [DirichletCharacter.IsPrimitive, DirichletCharacter.conductor_inv]
      exact ψ.2
    rw [dirichletCharacterUnitTransform_additive_eq_gaussSum_mul_twist]
    rw [norm_mul, mul_pow,
      norm_gaussSum_stdAddChar_of_isPrimitive ψ.1⁻¹ hψinv]
    rw [Real.sq_sqrt (Nat.cast_nonneg q)]
  have hsum :
      (∑ ψ : primitiveCharacters q,
        ‖dirichletCharacterUnitTransform b ψ.1‖ ^ 2) =
        (q : ℝ) *
          ∑ ψ : primitiveCharacters q,
            ‖∑ n ∈ s, c n * ψ.1 n‖ ^ 2 := by
    simp_rw [htransform, Finset.mul_sum]
  have hparseval := sum_norm_sq_primitiveCharacterUnitTransform_le b
  rw [div_mul_eq_mul_div, div_le_iff₀ hphi]
  calc
    (q : ℝ) *
        ∑ ψ : primitiveCharacters q,
          ‖∑ n ∈ s, c n * ψ.1 n‖ ^ 2 =
        ∑ ψ : primitiveCharacters q,
          ‖dirichletCharacterUnitTransform b ψ.1‖ ^ 2 := hsum.symm
    _ ≤ (q.totient : ℝ) * ∑ u : (ZMod q)ˣ, ‖b u‖ ^ 2 := hparseval
    _ = (∑ u : (ZMod q)ˣ, ‖b u‖ ^ 2) * (q.totient : ℝ) := by ring

/--
The natural moduli in the inclusive range `1 ≤ q ≤ Q`, with the range condition stored in the
subtype.
-/
abbrev positiveModuliUpTo (Q : ℕ) :=
  {q : ℕ // q ∈ Finset.Icc 1 Q}

/--
Indices for reduced fractions with denominators from `1` through `Q`: a positive modulus
together with a unit residue modulo that modulus.
-/
abbrev reducedFractionIndices (Q : ℕ) :=
  Σ q : positiveModuliUpTo Q, (ZMod q.1)ˣ

noncomputable instance reducedFractionIndicesFintype (Q : ℕ) :
    Fintype (reducedFractionIndices Q) := Fintype.ofFinite _

@[instance] theorem positiveModulusNeZero {Q : ℕ}
    (q : positiveModuliUpTo Q) : NeZero q.1 :=
  ⟨by
    have hq := q.2
    simp only [Finset.mem_Icc] at hq
    omega⟩

/--
The point of the unit additive circle represented by the indexed reduced fraction `a / q`, using
the canonical map from `ZMod q`.
-/
noncomputable def reducedFractionPoint {Q : ℕ}
    (x : reducedFractionIndices Q) : UnitAddCircle :=
  ZMod.toAddCircle (x.2 : ZMod x.1.1)

/--
The standard complex additive character on the unit circle, sending a real class `x` to `exp (2
* pi * I * x)`.
-/
noncomputable def unitAddCircleAddChar : AddChar UnitAddCircle ℂ :=
  Circle.coeHom.compAddChar AddCircle.toCircle_addChar

theorem unitAddCircleAddChar_nsmul_reducedFractionPoint
    {Q : ℕ} (x : reducedFractionIndices Q) (n : ℕ) :
    unitAddCircleAddChar (n • reducedFractionPoint x) =
      ZMod.stdAddChar ((x.2 : ZMod x.1.1) * (n : ZMod x.1.1)) := by
  calc
    unitAddCircleAddChar (n • reducedFractionPoint x) =
        unitAddCircleAddChar (reducedFractionPoint x) ^ n :=
      AddChar.map_nsmul_eq_pow _ _ _
    _ = ZMod.stdAddChar (x.2 : ZMod x.1.1) ^ n := by
      rfl
    _ = ZMod.stdAddChar (n • (x.2 : ZMod x.1.1)) := by
      rw [AddChar.map_nsmul_eq_pow]
    _ = ZMod.stdAddChar
        ((x.2 : ZMod x.1.1) * (n : ZMod x.1.1)) := by
      congr 1
      simp [nsmul_eq_mul, mul_comm]

theorem addOrderOf_coe_unit {q : ℕ} [NeZero q]
    (u : (ZMod q)ˣ) :
    addOrderOf (u : ZMod q) = q := by
  rw [← ZMod.natCast_zmod_val (u : ZMod q)]
  rw [ZMod.addOrderOf_coe (u : ZMod q).val (NeZero.ne q)]
  have hu := ZMod.val_coe_unit_coprime u
  rw [Nat.gcd_comm, hu.gcd_eq_one, Nat.div_one]

theorem addOrderOf_reducedFractionPoint {Q : ℕ}
    (x : reducedFractionIndices Q) :
    addOrderOf (reducedFractionPoint x) = x.1.1 := by
  rw [reducedFractionPoint,
    addOrderOf_injective _ (ZMod.toAddCircle_injective _),
    addOrderOf_coe_unit]

theorem reducedFractionPoint_injective {Q : ℕ} :
    Function.Injective
      (reducedFractionPoint : reducedFractionIndices Q → UnitAddCircle) := by
  intro x y hxy
  have hq : x.1.1 = y.1.1 := by
    rw [← addOrderOf_reducedFractionPoint x,
      ← addOrderOf_reducedFractionPoint y, hxy]
  rcases x with ⟨q, u⟩
  rcases y with ⟨r, v⟩
  have hqr : q = r := Subtype.ext hq
  subst r
  have huv : u = v := by
    apply Units.ext
    apply ZMod.toAddCircle_injective q.1
    exact hxy
  subst v
  exact Sigma.ext_iff.mpr ⟨rfl, HEq.rfl⟩

theorem one_div_sq_le_dist_reducedFractionPoint
    {Q : ℕ} {x y : reducedFractionIndices Q} (hxy : x ≠ y) :
    (1 : ℝ) / (Q : ℝ) ^ 2 ≤
      dist (reducedFractionPoint x) (reducedFractionPoint y) := by
  have hxq := x.1.2
  have hyq := y.1.2
  simp only [Finset.mem_Icc] at hxq hyq
  have hQ : 0 < Q := by omega
  have hxzero : x.1.1 • reducedFractionPoint x = 0 := by
    rw [← addOrderOf_reducedFractionPoint x, addOrderOf_nsmul_eq_zero]
  have hyzero : y.1.1 • reducedFractionPoint y = 0 := by
    rw [← addOrderOf_reducedFractionPoint y, addOrderOf_nsmul_eq_zero]
  have hproduct :
      (x.1.1 * y.1.1) •
          (reducedFractionPoint x - reducedFractionPoint y) = 0 := by
    rw [nsmul_sub]
    rw [mul_nsmul, hxzero, nsmul_zero]
    rw [mul_comm, mul_nsmul, hyzero, nsmul_zero, sub_zero]
  have hproduct_pos : 0 < x.1.1 * y.1.1 := Nat.mul_pos hxq.1 hyq.1
  have hfinite :
      IsOfFinAddOrder (reducedFractionPoint x - reducedFractionPoint y) :=
    isOfFinAddOrder_iff_nsmul_eq_zero.mpr
      ⟨x.1.1 * y.1.1, hproduct_pos, hproduct⟩
  have hdiff : reducedFractionPoint x - reducedFractionPoint y ≠ 0 :=
    sub_ne_zero.mpr (reducedFractionPoint_injective.ne hxy)
  have horder :
      addOrderOf (reducedFractionPoint x - reducedFractionPoint y) ≤
        x.1.1 * y.1.1 :=
    addOrderOf_le_of_nsmul_eq_zero hproduct_pos hproduct
  have hunit :
      (1 : ℝ) ≤
        (addOrderOf
          (reducedFractionPoint x - reducedFractionPoint y) : ℝ) *
          ‖reducedFractionPoint x - reducedFractionPoint y‖ := by
    simpa [nsmul_eq_mul] using
      AddCircle.le_add_order_smul_norm_of_isOfFinAddOrder hfinite hdiff
  rw [dist_eq_norm]
  rw [div_le_iff₀ (sq_pos_of_pos (Nat.cast_pos.mpr hQ))]
  calc
    (1 : ℝ) ≤
        (addOrderOf
          (reducedFractionPoint x - reducedFractionPoint y) : ℝ) *
          ‖reducedFractionPoint x - reducedFractionPoint y‖ := hunit
    _ ≤ ((x.1.1 * y.1.1 : ℕ) : ℝ) *
          ‖reducedFractionPoint x - reducedFractionPoint y‖ := by
      gcongr
    _ ≤ (Q : ℝ) ^ 2 *
          ‖reducedFractionPoint x - reducedFractionPoint y‖ := by
      apply mul_le_mul_of_nonneg_right _ (norm_nonneg _)
      norm_cast
      nlinarith
    _ = ‖reducedFractionPoint x - reducedFractionPoint y‖ *
          (Q : ℝ) ^ 2 := by ring

theorem sum_weighted_norm_mul_primitiveTwists_le
    (Q : ℕ)
    (A B : (q : ℕ) → primitiveCharacters q → ℂ) :
    (∑ q ∈ Finset.Ioc 0 Q,
      (q : ℝ) / (q.totient : ℝ) *
        ∑ psi : primitiveCharacters q, ‖A q psi * B q psi‖) ≤
      Real.sqrt
          (∑ q ∈ Finset.Ioc 0 Q,
            (q : ℝ) / (q.totient : ℝ) *
              ∑ psi : primitiveCharacters q, ‖A q psi‖ ^ 2) *
        Real.sqrt
          (∑ q ∈ Finset.Ioc 0 Q,
            (q : ℝ) / (q.totient : ℝ) *
              ∑ psi : primitiveCharacters q, ‖B q psi‖ ^ 2) := by
  classical
  let indices : Finset (Σ q : ℕ, primitiveCharacters q) :=
    (Finset.Ioc 0 Q).sigma fun q => (Finset.univ : Finset (primitiveCharacters q))
  have hw (q : ℕ) : 0 ≤ (q : ℝ) / (q.totient : ℝ) := by positivity
  have hprod (q : ℕ) (a b : ℝ) :
      (Real.sqrt ((q : ℝ) / (q.totient : ℝ)) * a) *
        (Real.sqrt ((q : ℝ) / (q.totient : ℝ)) * b) =
      ((q : ℝ) / (q.totient : ℝ)) * (a * b) := by
    rw [mul_mul_mul_comm, Real.mul_self_sqrt (hw q)]
  simpa only [indices, Finset.sum_sigma, Finset.mul_sum, norm_mul, mul_pow,
    hprod, Real.sq_sqrt, hw] using
    Real.sum_mul_le_sqrt_mul_sqrt indices
      (fun z => Real.sqrt ((z.1 : ℝ) / (z.1.totient : ℝ)) * ‖A z.1 z.2‖)
      (fun z => Real.sqrt ((z.1 : ℝ) / (z.1.totient : ℝ)) * ‖B z.1 z.2‖)

end PrimeGap186

section
open Set
/--
The unique real representative of a point of the unit additive circle in the half-open interval
`[-1 / 2, 1 / 2)`.
-/
noncomputable def PrimeGap186.centeredRepresentative (z : UnitAddCircle) : ℝ :=
  AddCircle.equivIco 1 (-(1 / 2 : ℝ)) z

theorem PrimeGap186.norm_eq_abs_centeredRepresentative (z : UnitAddCircle) :
    ‖z‖ = |PrimeGap186.centeredRepresentative z| := by
  have hmem : PrimeGap186.centeredRepresentative z ∈ Set.Ico (-(1 / 2 : ℝ)) (1 / 2) := by
    have hz := (AddCircle.equivIco 1 (-(1 / 2 : ℝ)) z).property
    constructor
    · exact hz.1
    · dsimp [PrimeGap186.centeredRepresentative]
      linarith [hz.2]
  have habs : |PrimeGap186.centeredRepresentative z| ≤ (1 / 2 : ℝ) :=
    abs_le.mpr ⟨hmem.1, hmem.2.le⟩
  simpa only [PrimeGap186.centeredRepresentative, AddCircle.coe_equivIco] using
    (AddCircle.norm_coe_eq_abs_iff 1
      (x := PrimeGap186.centeredRepresentative z) one_ne_zero).2
      (by simpa using habs)

theorem PrimeGap186.dist_le_abs_centeredRepresentative_sub_sub
    (a b base : UnitAddCircle) :
    dist a b ≤
      |PrimeGap186.centeredRepresentative (a - base) -
        PrimeGap186.centeredRepresentative (b - base)| := by
  rw [dist_eq_norm]
  have hcoe :
      ((PrimeGap186.centeredRepresentative (a - base) -
        PrimeGap186.centeredRepresentative (b - base) : ℝ) : UnitAddCircle) = a - b := by
    change (PrimeGap186.centeredRepresentative (a - base) : UnitAddCircle) -
      (PrimeGap186.centeredRepresentative (b - base) : UnitAddCircle) = a - b
    simp only [PrimeGap186.centeredRepresentative, AddCircle.coe_equivIco]
    abel
  calc
    ‖a - b‖ =
        ‖((PrimeGap186.centeredRepresentative (a - base) -
          PrimeGap186.centeredRepresentative (b - base) : ℝ) : UnitAddCircle)‖ := by rw [hcoe]
    _ ≤ |PrimeGap186.centeredRepresentative (a - base) -
        PrimeGap186.centeredRepresentative (b - base)| :=
      QuotientAddGroup.norm_mk_le_norm

/--
The natural-number bin of the absolute centered displacement from `y i` to `y j`, obtained by
flooring its ratio to `δ`.
-/
noncomputable def PrimeGap186.packingBin {ι : Type*}
    (y : ι → UnitAddCircle) (i j : ι) (δ : ℝ) : ℕ :=
  ⌊|PrimeGap186.centeredRepresentative (y j - y i)| / δ⌋₊

/--
A signed packing key for an index different from `i`. It records the displacement bin and uses
the left summand for nonnegative centered displacement, the right summand for negative
displacement.
-/
noncomputable def PrimeGap186.packingKey {ι : Type*} (y : ι → UnitAddCircle) (i : ι) (δ : ℝ)
    (j : {j // j ≠ i}) : ℕ ⊕ ℕ :=
  if 0 ≤ PrimeGap186.centeredRepresentative (y j - y i) then
    Sum.inl (PrimeGap186.packingBin y i j δ)
  else
    Sum.inr (PrimeGap186.packingBin y i j δ)

theorem PrimeGap186.packingKey_injective {ι : Type*}
    (y : ι → UnitAddCircle) (i : ι) {δ : ℝ} (hδ : 0 < δ)
    (hsep : Pairwise fun j k => δ ≤ dist (y j) (y k)) :
    Function.Injective (PrimeGap186.packingKey y i δ) := by
  intro a b hab
  by_contra hab'
  have hab_val : (a : ι) ≠ b := fun h => hab' (Subtype.ext h)
  have hsep_ab : δ ≤ dist (y a) (y b) := hsep hab_val
  let ca := PrimeGap186.centeredRepresentative (y a - y i)
  let cb := PrimeGap186.centeredRepresentative (y b - y i)
  have hmetric : dist (y a) (y b) ≤ |ca - cb| := by
    simpa [ca, cb] using PrimeGap186.dist_le_abs_centeredRepresentative_sub_sub (y a) (y b) (y i)
  have hfloor_bounds (c : ℝ) :
      ((⌊|c| / δ⌋₊ : ℕ) : ℝ) * δ ≤ |c| ∧
        |c| < (((⌊|c| / δ⌋₊ : ℕ) : ℝ) + 1) * δ := by
    constructor
    · exact (le_div_iff₀ hδ).mp (Nat.floor_le (div_nonneg (abs_nonneg c) hδ.le))
    · exact (div_lt_iff₀ hδ).mp (Nat.lt_floor_add_one (|c| / δ))
  have hba := hfloor_bounds ca
  have hbb := hfloor_bounds cb
  by_cases ha : 0 ≤ ca <;> by_cases hb : 0 ≤ cb
  · have hn : PrimeGap186.packingBin y i a δ = PrimeGap186.packingBin y i b δ := by
      simpa [PrimeGap186.packingKey, ca, cb, ha, hb] using hab
    have hca : |ca| = ca := abs_of_nonneg ha
    have hcb : |cb| = cb := abs_of_nonneg hb
    rw [hca] at hba
    rw [hcb] at hbb
    have hbin : (⌊|ca| / δ⌋₊ : ℝ) = (⌊|cb| / δ⌋₊ : ℝ) := by
      exact_mod_cast (show ⌊|ca| / δ⌋₊ = ⌊|cb| / δ⌋₊ by
        simpa [PrimeGap186.packingBin, ca, cb] using hn)
    rw [hca, hcb] at hbin
    rw [← hbin] at hbb
    have : |ca - cb| < δ := by rw [abs_lt]; constructor <;> nlinarith
    linarith
  · exfalso
    simp [PrimeGap186.packingKey, ca, cb, ha, hb] at hab
  · exfalso
    simp [PrimeGap186.packingKey, ca, cb, ha, hb] at hab
  · have hn : PrimeGap186.packingBin y i a δ = PrimeGap186.packingBin y i b δ := by
      simpa [PrimeGap186.packingKey, ca, cb, ha, hb] using hab
    have hca : |ca| = -ca := abs_of_nonpos (le_of_not_ge ha)
    have hcb : |cb| = -cb := abs_of_nonpos (le_of_not_ge hb)
    rw [hca] at hba
    rw [hcb] at hbb
    have hbin : (⌊|ca| / δ⌋₊ : ℝ) = (⌊|cb| / δ⌋₊ : ℝ) := by
      exact_mod_cast (show ⌊|ca| / δ⌋₊ = ⌊|cb| / δ⌋₊ by
        simpa [PrimeGap186.packingBin, ca, cb] using hn)
    rw [hca, hcb] at hbin
    rw [← hbin] at hbb
    have : |ca - cb| < δ := by rw [abs_lt]; constructor <;> nlinarith
    linarith

/--
The reciprocal-square weight `1 / (n ^ 2 * δ ^ 2)` on either sign of a packing key. The zeroth
bin has value zero by Lean's totalized division convention.
-/
noncomputable def PrimeGap186.packingMajorant (δ : ℝ) : ℕ ⊕ ℕ → ℝ :=
  Sum.elim (fun n => (1 / (n : ℝ) ^ 2) / δ ^ 2)
    (fun n => (1 / (n : ℝ) ^ 2) / δ ^ 2)

theorem PrimeGap186.hasSum_packingMajorant (δ : ℝ) :
    HasSum (PrimeGap186.packingMajorant δ) (Real.pi ^ 2 / (3 * δ ^ 2)) := by
  have hnat :
      HasSum (fun n : ℕ => (1 / (n : ℝ) ^ 2) / δ ^ 2)
        ((Real.pi ^ 2 / 6) / δ ^ 2) :=
    hasSum_zeta_two.div_const (δ ^ 2)
  convert HasSum.sum (f := PrimeGap186.packingMajorant δ) hnat hnat using 1
  ring

theorem PrimeGap186.packingTerm_le_majorant {ι : Type*}
    (y : ι → UnitAddCircle) (i : ι) {δ : ℝ} (hδ : 0 < δ)
    (hsep : Pairwise fun j k => δ ≤ dist (y j) (y k)) (j : {j // j ≠ i}) :
    (dist (y i) (y j) ^ 2)⁻¹ ≤ PrimeGap186.packingMajorant δ (PrimeGap186.packingKey y i δ j) := by
  let c := PrimeGap186.centeredRepresentative (y j - y i)
  let n := PrimeGap186.packingBin y i j δ
  have hsep_ij : δ ≤ dist (y i) (y j) := hsep (Ne.symm j.property)
  have hdist : dist (y i) (y j) = |c| := by
    rw [dist_comm, dist_eq_norm, PrimeGap186.norm_eq_abs_centeredRepresentative]
  have hn_le : (n : ℝ) * δ ≤ dist (y i) (y j) := by
    rw [hdist]
    exact (le_div_iff₀ hδ).mp
      (Nat.floor_le (div_nonneg (abs_nonneg c) hδ.le) :
        (n : ℝ) ≤ |c| / δ)
  have hratio : 1 ≤ |c| / δ := by
    apply (le_div_iff₀ hδ).2
    simpa [← hdist] using hsep_ij
  have hn_pos : 0 < n :=
    Nat.floor_pos.mpr hratio
  have hnδ_pos : 0 < (n : ℝ) * δ := mul_pos (by exact_mod_cast hn_pos) hδ
  have hsquare : ((n : ℝ) * δ) ^ 2 ≤ dist (y i) (y j) ^ 2 :=
    (sq_le_sq₀ hnδ_pos.le (dist_nonneg : 0 ≤ dist (y i) (y j))).2 hn_le
  have hinv : (dist (y i) (y j) ^ 2)⁻¹ ≤ (((n : ℝ) * δ) ^ 2)⁻¹ :=
    inv_anti₀ (sq_pos_of_pos hnδ_pos) hsquare
  by_cases hc : 0 ≤ c <;>
    simpa [PrimeGap186.packingMajorant, PrimeGap186.packingKey, PrimeGap186.packingBin, c, n, hc,
      mul_pow, mul_inv_rev, div_eq_mul_inv, mul_comm] using hinv

end

namespace PrimeGap186

section
open Set

theorem sum_inv_sq_circle_dist_lt {ι : Type*} [Fintype ι] [DecidableEq ι]
    (y : ι → UnitAddCircle) {δ : ℝ} (hδ : 0 < δ)
    (hsep : ∀ r s, r ≠ s → δ ≤ dist (y r) (y s)) (i : ι) :
    (∑ j ∈ Finset.univ.erase i, (dist (y i) (y j) ^ 2)⁻¹) <
      Real.pi ^ 2 / (3 * δ ^ 2) := by
  classical
  have hpair : Pairwise fun j k => δ ≤ dist (y j) (y k) := fun j k hjk => hsep j k hjk
  let J := {j // j ≠ i}
  let f : J → ℝ := fun j => (dist (y i) (y j) ^ 2)⁻¹
  let e : J → ℕ ⊕ ℕ := packingKey y i δ
  let g : ℕ ⊕ ℕ → ℝ := packingMajorant δ
  let S : Finset (ℕ ⊕ ℕ) := Finset.univ.image e
  let project : ℕ ⊕ ℕ → ℕ := Sum.elim id id
  let T : Finset ℕ := insert 0 (S.image project)
  obtain ⟨m, hm⟩ := Finset.exists_notMem T
  have hm_zero : m ≠ 0 := by
    intro hm0
    apply hm
    simp [T, hm0]
  let missing : ℕ ⊕ ℕ := Sum.inl m
  have hmissing : missing ∉ S := by
    intro hmem
    apply hm
    apply Finset.mem_insert_of_mem
    apply Finset.mem_image.mpr
    exact ⟨missing, hmem, by simp [project, missing]⟩
  have hmissing_pos : 0 < g missing := by
    have hm_pos : 0 < (m : ℝ) := by exact_mod_cast Nat.pos_of_ne_zero hm_zero
    simp only [g, missing, packingMajorant, Sum.elim_inl]
    positivity
  have hsum_le : (∑ j : J, f j) ≤ ∑ j : J, g (e j) := by
    apply Finset.sum_le_sum
    intro j hj
    exact packingTerm_le_majorant y i hδ hpair j
  have hreindex : (∑ j : J, g (e j)) = ∑ k ∈ S, g k := by
    symm
    exact Finset.sum_image (packingKey_injective y i hδ hpair).injOn
  have hfinite_lt : (∑ k ∈ S, g k) < ∑' k, g k := by
    have hproper : (∑ k ∈ S, g k) < ∑ k ∈ insert missing S, g k := by
      rw [Finset.sum_insert hmissing]
      linarith
    exact hproper.trans_le ((hasSum_packingMajorant δ).summable.sum_le_tsum
      (insert missing S) (by
        intro k hk
        cases k <;>
          simp only [g, packingMajorant, Sum.elim_inl, Sum.elim_inr] <;> positivity))
  calc
    (∑ j ∈ Finset.univ.erase i, (dist (y i) (y j) ^ 2)⁻¹) = ∑ j : J, f j := by
      change (∑ j ∈ Finset.univ.erase i, (dist (y i) (y j) ^ 2)⁻¹) =
        ∑ j : {j // j ≠ i}, (dist (y i) (y j) ^ 2)⁻¹
      exact Finset.sum_subtype (p := fun j => j ≠ i)
        (Finset.univ.erase i) (fun j => by simp)
        (fun j => (dist (y i) (y j) ^ 2)⁻¹)
    _ ≤ ∑ j : J, g (e j) := hsum_le
    _ = ∑ k ∈ S, g k := hreindex
    _ < ∑' k, g k := hfinite_lt
    _ = Real.pi ^ 2 / (3 * δ ^ 2) := (hasSum_packingMajorant δ).tsum_eq

theorem sum_inv_sq_circle_dist_le {ι : Type*} [Fintype ι] [DecidableEq ι]
    (y : ι → UnitAddCircle) {δ : ℝ} (hδ : 0 < δ)
    (hsep : ∀ r s, r ≠ s → δ ≤ dist (y r) (y s)) (i : ι) :
    (∑ j ∈ Finset.univ.erase i, (dist (y i) (y j) ^ 2)⁻¹) ≤
      Real.pi ^ 2 / (3 * δ ^ 2) :=
  (sum_inv_sq_circle_dist_lt y hδ hsep i).le

end

/--
The reciprocal of `sin (pi * x)`, with Lean's inverse convention assigning zero when the sine
vanishes.
-/
noncomputable def cosecantPi (x : ℝ) : ℝ :=
  (Real.sin (Real.pi * x))⁻¹

theorem cos_le_quartic {t : ℝ} (ht : 0 ≤ t) :
    Real.cos t ≤ 1 - t ^ 2 / 2 + t ^ 4 / 24 := by
  let f : ℝ → ℝ := fun y => 1 - y ^ 2 / 2 + y ^ 4 / 24 - Real.cos y
  have hderiv (y : ℝ) :
      deriv f y = Real.sin y - (y - y ^ 3 / 6) := by
    simp (disch := fun_prop) [f]
    ring
  have hmono : MonotoneOn f (Set.Ici 0) := by
    apply monotoneOn_of_deriv_nonneg (convex_Ici 0) (by fun_prop) (by fun_prop)
    intro y hy
    rw [hderiv]
    exact sub_nonneg.mpr (Real.sin_ge_sub_cube (interior_subset hy))
  have h := hmono (by simp) ht ht
  norm_num [f] at h
  linarith

theorem sq_mul_one_add_two_mul_abs_cos_le_three_mul_sin_sq {t : ℝ} (ht0 : 0 ≤ t)
    (ht : t ≤ Real.pi / 2) :
    t ^ 2 * (1 + 2 * |Real.cos t|) ≤ 3 * Real.sin t ^ 2 := by
  have hcos0 : 0 ≤ Real.cos t :=
    Real.cos_nonneg_of_neg_pi_div_two_le_of_le
      (by linarith [Real.pi_pos]) ht
  rw [abs_of_nonneg hcos0]
  have hcos := cos_le_quartic ht0
  have hsin := Real.sin_ge_sub_cube ht0
  have hsin0 : 0 ≤ Real.sin t :=
    Real.sin_nonneg_of_nonneg_of_le_pi ht0
      (ht.trans (by linarith [Real.pi_pos]))
  have ht_two : t ≤ 2 := by linarith [Real.pi_lt_four]
  have hpoly0 : 0 ≤ t - t ^ 3 / 6 := by
    nlinarith [sq_nonneg t, mul_self_le_mul_self ht0 ht_two]
  have hsq : (t - t ^ 3 / 6) ^ 2 ≤ Real.sin t ^ 2 := by
    nlinarith
  nlinarith [sq_nonneg t]

theorem abs_sin_pi_eq_sin_pi_norm (x : ℝ) :
    |Real.sin (Real.pi * x)| =
      Real.sin (Real.pi * ‖(x : UnitAddCircle)‖) := by
  let z : ℝ := x - (round x : ℝ)
  have hzabs : |z| = ‖(x : UnitAddCircle)‖ := by
    simp only [z, UnitAddCircle.norm_eq]
  have hzle : |Real.pi * z| ≤ Real.pi := by
    rw [abs_mul, abs_of_pos Real.pi_pos]
    have := abs_sub_round x
    nlinarith [Real.pi_pos]
  have hlocal : |Real.sin (Real.pi * z)| = Real.sin (Real.pi * |z|) := by
    rw [Real.abs_sin_eq_sin_abs_of_abs_le_pi hzle]
    rw [abs_mul, abs_of_pos Real.pi_pos]
  have hshift := Real.sin_sub_int_mul_pi (Real.pi * x) (round x)
  have habs := congrArg abs hshift
  rw [show Real.pi * x - (round x : ℝ) * Real.pi = Real.pi * z by
    simp [z]
    ring] at habs
  rw [abs_mul, abs_neg_one_zpow, one_mul] at habs
  rw [← habs, hlocal, hzabs]

theorem abs_cos_pi_eq_cos_pi_norm (x : ℝ) :
    |Real.cos (Real.pi * x)| =
      Real.cos (Real.pi * ‖(x : UnitAddCircle)‖) := by
  let z : ℝ := x - (round x : ℝ)
  have hzabs : |z| = ‖(x : UnitAddCircle)‖ := by
    simp only [z, UnitAddCircle.norm_eq]
  have htheta : Real.pi * |z| ≤ Real.pi / 2 := by
    have := abs_sub_round x
    dsimp [z]
    nlinarith [Real.pi_pos]
  have hcos0 : 0 ≤ Real.cos (Real.pi * |z|) :=
    Real.cos_nonneg_of_neg_pi_div_two_le_of_le
      (by
        have : 0 ≤ Real.pi * |z| := by positivity
        linarith [Real.pi_pos]) htheta
  have hlocal : |Real.cos (Real.pi * z)| = Real.cos (Real.pi * |z|) := by
    rw [← Real.cos_abs]
    rw [abs_mul, abs_of_pos Real.pi_pos, abs_of_nonneg hcos0]
  have hshift := Real.cos_sub_int_mul_pi (Real.pi * x) (round x)
  have habs := congrArg abs hshift
  rw [show Real.pi * x - (round x : ℝ) * Real.pi = Real.pi * z by
    simp [z]
    ring] at habs
  rw [abs_mul, abs_neg_one_zpow, one_mul] at habs
  rw [← habs, hlocal, hzabs]

theorem cosecantPi_sq_mul_one_add_two_abs_cos_le
    (x : ℝ) (hx : (x : UnitAddCircle) ≠ 0) :
    cosecantPi x ^ 2 * (1 + 2 * |Real.cos (Real.pi * x)|) ≤
      3 / (Real.pi ^ 2 * ‖(x : UnitAddCircle)‖ ^ 2) := by
  let d : ℝ := ‖(x : UnitAddCircle)‖
  let t : ℝ := Real.pi * d
  have hd0 : 0 < d := norm_pos_iff.mpr hx
  have hdhalf : d ≤ 1 / 2 := by
    simpa [d] using
      (AddCircle.norm_le_half_period (1 : ℝ) one_ne_zero
        (x := (x : UnitAddCircle)))
  have ht0 : 0 ≤ t := by positivity
  have ht : t ≤ Real.pi / 2 := by
    dsimp [t]
    nlinarith [Real.pi_pos]
  have hsinpos : 0 < Real.sin t := by
    apply Real.sin_pos_of_pos_of_lt_pi
    · positivity
    · linarith [Real.pi_pos]
  have htrig := sq_mul_one_add_two_mul_abs_cos_le_three_mul_sin_sq ht0 ht
  have hcost0 : 0 ≤ Real.cos t :=
    Real.cos_nonneg_of_neg_pi_div_two_le_of_le
      (by linarith [Real.pi_pos]) ht
  rw [abs_of_nonneg hcost0] at htrig
  have hsinequal : |Real.sin (Real.pi * x)| = Real.sin t := by
    simpa [t, d] using abs_sin_pi_eq_sin_pi_norm x
  have hcosequal : |Real.cos (Real.pi * x)| = Real.cos t := by
    simpa [t, d] using abs_cos_pi_eq_cos_pi_norm x
  have hpi : 0 < Real.pi := Real.pi_pos
  change cosecantPi x ^ 2 * (1 + 2 * |Real.cos (Real.pi * x)|) ≤
    3 / (Real.pi ^ 2 * d ^ 2)
  rw [hcosequal]
  simp only [cosecantPi]
  rw [← sq_abs (Real.sin (Real.pi * x))⁻¹, abs_inv, hsinequal]
  rw [inv_pow, inv_mul_eq_div]
  rw [div_le_div_iff₀ (sq_pos_of_pos hsinpos)
    (mul_pos (sq_pos_of_pos hpi) (sq_pos_of_pos hd0))]
  dsimp [t] at htrig
  nlinarith

theorem cosecant_cotangent_majorant
    (x : ℝ) (hx : (x : UnitAddCircle) ≠ 0) :
    cosecantPi x ^ 2 +
        2 * |Real.cot (Real.pi * x) * cosecantPi x| ≤
      3 / (Real.pi ^ 2 * ‖(x : UnitAddCircle)‖ ^ 2) := by
  have hfactor := cosecantPi_sq_mul_one_add_two_abs_cos_le x hx
  convert hfactor using 1
  rw [Real.cot_eq_cos_div_sin, div_eq_mul_inv]
  simp only [cosecantPi]
  rw [abs_mul, abs_mul, mul_assoc, abs_mul_abs_self]
  ring

section
open scoped ComplexConjugate
open Finset Matrix
/-!
## Cosecant kernels, large-sieve estimates, and Vaughan sums
-/

/--
The off-diagonal cosecant form with summands `u r * conj (u s) * csc (pi * (x r - x s))`. Each
ordered pair of distinct indices is included once.
-/
noncomputable def cosecantBilinearForm
    {ι : Type*} [Fintype ι] [DecidableEq ι]
    (x : ι → ℝ) (u : ι → ℂ) : ℂ :=
  ∑ r, ∑ s ∈ Finset.univ.erase r,
    u r * star (u s) *
      (((Real.sin (Real.pi * (x r - x s)))⁻¹ : ℝ) : ℂ)

end

section
open scoped ComplexConjugate
open Finset Matrix

section CosecantHilbert
variable {ι : Type*} [Fintype ι] [DecidableEq ι]
/--
The complex matrix with zero diagonal and real off-diagonal entries `csc (pi * (x r - x s))`.
Its antisymmetry is inherited from the oddness of sine.
-/
noncomputable def cosecantKernel (x : ι → ℝ) : Matrix ι ι ℂ := fun r s =>
  if r = s then 0
  else (((Real.sin (Real.pi * (x r - x s)))⁻¹ : ℝ) : ℂ)

/--
The cosecant kernel multiplied by `I`, turning its real antisymmetric matrix into a Hermitian
matrix.
-/
noncomputable def hermitianCosecantKernel (x : ι → ℝ) : Matrix ι ι ℂ :=
  Complex.I • cosecantKernel x

/--
The incoming cosecant sum at `s`, weighted by the source coefficients `u r` and using
differences `x r - x s`; the diagonal index is omitted.
-/
noncomputable def incomingCosecantSum (x : ι → ℝ) (u : ι → ℂ) (s : ι) : ℂ :=
  ∑ r ∈ Finset.univ.erase s,
    u r * (((Real.sin (Real.pi * (x r - x s)))⁻¹ : ℝ) : ℂ)

omit [Fintype ι] in
theorem cosecantKernel_diag (x : ι → ℝ) (r : ι) : cosecantKernel x r r = 0 := by
  simp [cosecantKernel]

omit [Fintype ι] in
theorem cosecantKernel_swap (x : ι → ℝ) (r s : ι) :
    cosecantKernel x s r = -cosecantKernel x r s := by
  by_cases hrs : r = s
  · subst s
    simp [cosecantKernel]
  · rw [cosecantKernel, cosecantKernel, ite_eq_right hrs, ite_eq_right (Ne.symm hrs)]
    rw [show x s - x r = -(x r - x s) by ring, mul_neg, Real.sin_neg, inv_neg]
    norm_cast

omit [Fintype ι] in
theorem star_cosecantKernel (x : ι → ℝ) (r s : ι) :
    star (cosecantKernel x r s) = cosecantKernel x r s := by
  unfold cosecantKernel
  split_ifs
  · exact star_zero ℂ
  · exact Complex.conj_ofReal _

omit [Fintype ι] in
theorem hermitianCosecantKernel_isHermitian (x : ι → ℝ) :
    (hermitianCosecantKernel x).IsHermitian := by
  apply Matrix.IsHermitian.ext
  intro r s
  change star (Complex.I * (cosecantKernel x) s r) =
    Complex.I * (cosecantKernel x) r s
  rw [star_mul', star_cosecantKernel, cosecantKernel_swap x r s,
    Complex.star_def, Complex.conj_I, neg_mul_neg]

theorem incomingCosecantSum_eq_neg_mulVec (x : ι → ℝ) (u : ι → ℂ) (s : ι) :
    incomingCosecantSum x u s = -(cosecantKernel x *ᵥ u) s := by
  have hdiag : (cosecantKernel x) s s * u s = 0 := by
    rw [cosecantKernel_diag, zero_mul]
  have hsum :
      ∑ i ∈ Finset.univ.erase s, (cosecantKernel x) s i * u i =
        ∑ i, (cosecantKernel x) s i * u i :=
    Finset.sum_erase Finset.univ hdiag
  rw [incomingCosecantSum, mulVec, dotProduct, ← hsum]
  rw [← Finset.sum_neg_distrib]
  apply Finset.sum_congr rfl
  intro r hr
  have hrs : r ≠ s := Finset.ne_of_mem_erase hr
  rw [show (((Real.sin (Real.pi * (x r - x s)))⁻¹ : ℝ) : ℂ) =
      (cosecantKernel x) r s by simp [cosecantKernel, hrs]]
  rw [cosecantKernel_swap]
  ring

theorem incomingCosecantSum_of_eigenvector
    (x : ι → ℝ) (u : ι → ℂ) (μ : ℝ)
    (hu : hermitianCosecantKernel x *ᵥ u = (μ : ℂ) • u) (s : ι) :
    incomingCosecantSum x u s = Complex.I * μ * u s := by
  have hs := congr_fun hu s
  rw [incomingCosecantSum_eq_neg_mulVec]
  have hs' : Complex.I * (cosecantKernel x *ᵥ u) s = (μ : ℂ) * u s := by
    simpa only [hermitianCosecantKernel, smul_mulVec, Pi.smul_apply, smul_eq_mul]
      using hs
  calc
    -(cosecantKernel x *ᵥ u) s =
        Complex.I * (Complex.I * (cosecantKernel x *ᵥ u) s) := by
          rw [← mul_assoc, Complex.I_mul_I, neg_one_mul]
    _ = Complex.I * ((μ : ℂ) * u s) := by rw [hs']
    _ = Complex.I * μ * u s := by ring

theorem sum_erase_eq_sum_ite (a : ι) (f : ι → ℂ) :
    ∑ b ∈ Finset.univ.erase a, f b = ∑ b, if b = a then 0 else f b := by
  simpa only [Finset.filter_ne', ite_not] using
    (Finset.sum_filter (s := Finset.univ) (fun b => b ≠ a) f)

theorem cosecantBilinearForm_eq_sum_star_mul_incomingCosecantSum
    (x : ι → ℝ) (u : ι → ℂ) :
    cosecantBilinearForm x u = ∑ s, star (u s) * incomingCosecantSum x u s := by
  rw [cosecantBilinearForm, Finset.sum_comm'
    (s := Finset.univ) (t := fun r : ι => Finset.univ.erase r)
    (t' := Finset.univ) (s' := fun s : ι => Finset.univ.erase s)
    (fun r s => by simp [ne_comm])]
  simp_rw [incomingCosecantSum, Finset.mul_sum]
  apply Finset.sum_congr rfl
  intro s hs
  apply Finset.sum_congr rfl
  intro r hr
  ring

end CosecantHilbert
end

section
open scoped ComplexConjugate
open Finset Matrix

variable {ι : Type*} [Fintype ι] [DecidableEq ι]
variable {E : Type*} [NormedAddCommGroup E] [InnerProductSpace ℂ E]
omit [DecidableEq ι] in
theorem norm_inner_apply_le_of_orthonormal_eigenbasis
    (T : E →ₗ[ℂ] E) (b : OrthonormalBasis ι ℂ E) (μ : ι → ℝ)
    (hT : ∀ i, T (b i) = (μ i : ℂ) • b i)
    {C : ℝ} (hμ : ∀ i, |μ i| ≤ C) (u : E) :
    ‖inner ℂ u (T u)‖ ≤ C * ‖u‖ ^ 2 := by
  let a : ι → ℂ := fun i => (b.repr u).ofLp i
  have hu : ∑ i, a i • b i = u := b.sum_repr u
  have hTu : T u = ∑ i, ((μ i : ℂ) * a i) • b i := by
    rw [← hu, map_sum]
    simp only [map_smul, hT, smul_smul, mul_comm]
  have hinner :
      inner ℂ u (T u) = ∑ i, star (a i) * ((μ i : ℂ) * a i) := by
    rw [hTu, ← hu, sum_inner]
    simp only [inner_smul_left, b.orthonormal.inner_right_fintype, Complex.star_def]
  have hnorm : ∑ i, ‖a i‖ ^ 2 = ‖u‖ ^ 2 := by
    change (∑ i, ‖(b.repr u).ofLp i‖ ^ 2) = ‖u‖ ^ 2
    rw [← PiLp.norm_sq_eq_of_L2 (fun _ : ι => ℂ) (b.repr u)]
    rw [b.repr.norm_map]
  rw [hinner, ← hnorm, Finset.mul_sum]
  apply norm_sum_le_of_le
  intro i _hi
  rw [norm_mul, norm_star, norm_mul, Complex.norm_real, Real.norm_eq_abs]
  nlinarith [hμ i, norm_nonneg (a i)]

theorem norm_star_dotProduct_mulVec_le_of_eigenvalues
    (A : Matrix ι ι ℂ) (hA : A.IsHermitian)
    {C : ℝ} (hμ : ∀ i, |hA.eigenvalues i| ≤ C)
    (u : ι → ℂ) :
    ‖star u ⬝ᵥ (A *ᵥ u)‖ ≤ C * ∑ i, ‖u i‖ ^ 2 := by
  let U : EuclideanSpace ℂ ι := WithLp.toLp 2 u
  have hbound := norm_inner_apply_le_of_orthonormal_eigenbasis
    (ι := ι) (E := EuclideanSpace ℂ ι) ((Matrix.toLpLin 2 2) A)
    hA.eigenvectorBasis hA.eigenvalues
    (fun i => by
      rw [Matrix.toLpLin_apply, hA.mulVec_eigenvectorBasis]
      rw [WithLp.toLp_smul, WithLp.toLp_ofLp]
      exact RCLike.real_smul_eq_coe_smul (K := ℂ) _ _)
    hμ U
  rw [EuclideanSpace.inner_eq_star_dotProduct] at hbound
  change ‖star u ⬝ᵥ (A *ᵥ u)‖ ≤ C * ∑ i, ‖u i‖ ^ 2
  simpa only [U, WithLp.ofLp_toLp, Matrix.toLpLin_apply,
    PiLp.norm_sq_eq_of_L2, dotProduct_comm] using hbound

theorem cosecantBilinearForm_eq_I_mul_hermitianForm
    (x : ι → ℝ) (u : ι → ℂ) :
    cosecantBilinearForm x u =
      Complex.I * (star u ⬝ᵥ (hermitianCosecantKernel x *ᵥ u)) := by
  rw [cosecantBilinearForm_eq_sum_star_mul_incomingCosecantSum, dotProduct]
  simp_rw [incomingCosecantSum_eq_neg_mulVec]
  rw [hermitianCosecantKernel, smul_mulVec]
  simp only [Pi.smul_apply, smul_eq_mul, Pi.star_apply]
  rw [Finset.mul_sum]
  apply Finset.sum_congr rfl
  intro s hs
  rw [mul_left_comm Complex.I (star (u s)), ← mul_assoc Complex.I Complex.I,
    Complex.I_mul_I, neg_one_mul]

theorem norm_cosecantBilinearForm_le_of_eigenvalue_sq_le
    (x : ι → ℝ) {δ : ℝ} (hδ : 0 < δ)
    (heigen : ∀ i,
      (hermitianCosecantKernel_isHermitian x).eigenvalues i ^ 2 ≤ δ⁻¹ ^ 2)
    (u : ι → ℂ) :
    ‖cosecantBilinearForm x u‖ ≤ δ⁻¹ * ∑ i, ‖u i‖ ^ 2 := by
  have hC : 0 ≤ δ⁻¹ := (inv_pos.mpr hδ).le
  have habs : ∀ i,
      |(hermitianCosecantKernel_isHermitian x).eigenvalues i| ≤ δ⁻¹ := by
    intro i
    exact abs_le_of_sq_le_sq (heigen i) hC
  rw [cosecantBilinearForm_eq_I_mul_hermitianForm, norm_mul, Complex.norm_I,
    one_mul]
  exact norm_star_dotProduct_mulVec_le_of_eigenvalues
    (hermitianCosecantKernel x) (hermitianCosecantKernel_isHermitian x)
    habs u

theorem norm_cosecantBilinearForm_le_of_normalized_eigenvector_estimate
    (x : ι → ℝ) {δ : ℝ} (hδ : 0 < δ)
    (hanalytic : ∀ (μ : ℝ) (v : ι → ℂ),
      (∀ s, incomingCosecantSum x v s = Complex.I * μ * v s) →
      (∑ r, ‖v r‖ ^ 2) = 1 → μ ^ 2 ≤ δ⁻¹ ^ 2)
    (u : ι → ℂ) :
    ‖cosecantBilinearForm x u‖ ≤ δ⁻¹ * ∑ i, ‖u i‖ ^ 2 := by
  apply norm_cosecantBilinearForm_le_of_eigenvalue_sq_le x hδ
  intro i
  let hH := hermitianCosecantKernel_isHermitian x
  let v : ι → ℂ := (hH.eigenvectorBasis i).ofLp
  have hv : hermitianCosecantKernel x *ᵥ v =
      (hH.eigenvalues i : ℂ) • v := by
    have heig := hH.mulVec_eigenvectorBasis i
    change hermitianCosecantKernel x *ᵥ (hH.eigenvectorBasis i).ofLp =
      (hH.eigenvalues i : ℂ) • (hH.eigenvectorBasis i).ofLp
    rw [heig]
    exact RCLike.real_smul_eq_coe_smul (K := ℂ) _ _
  apply hanalytic (hH.eigenvalues i) v
  · exact fun s => incomingCosecantSum_of_eigenvector x v (hH.eigenvalues i) hv s
  · have hvnorm : ‖hH.eigenvectorBasis i‖ = 1 := hH.eigenvectorBasis.orthonormal.1 i
    have hsquare := PiLp.norm_sq_eq_of_L2 (fun _ : ι => ℂ) (hH.eigenvectorBasis i)
    simpa only [v, hvnorm, one_pow] using hsquare.symm

end

section
open scoped ComplexConjugate
open Finset Matrix

variable {ι : Type*} [Fintype ι] [DecidableEq ι]
/--
The cosecant row at `r` applied to the conjugated coefficients, omitting `s = r` and using
differences `x r - x s`.
-/
noncomputable def conjugateCosecantRow (x : ι → ℝ) (u : ι → ℂ) (r : ι) : ℂ :=
  ∑ s ∈ Finset.univ.erase r,
    star (u s) * (((Real.sin (Real.pi * (x r - x s)))⁻¹ : ℝ) : ℂ)

/--
The diagonal contribution in the expansion of the squared cosecant row norms: each squared
cosecant is weighted by `|u s| ^ 2`.
-/
noncomputable def montgomeryVaughanS1 (x : ι → ℝ) (u : ι → ℂ) : ℂ :=
  ∑ r, ∑ s ∈ Finset.univ.erase r,
    star (u s) * u s *
      (((Real.sin (Real.pi * (x r - x s)))⁻¹ : ℝ) : ℂ) ^ 2

/--
The off-diagonal contribution in the expansion of the squared cosecant row norms. The indices
`r`, `s`, and `t` are pairwise distinct, with coefficient `conj (u s) * u t`.
-/
noncomputable def montgomeryVaughanS2 (x : ι → ℝ) (u : ι → ℂ) : ℂ :=
  ∑ r, ∑ s ∈ Finset.univ.erase r,
    ∑ t ∈ (Finset.univ.erase r).erase s,
      star (u s) * u t *
        (((Real.sin (Real.pi * (x r - x s)))⁻¹ : ℝ) : ℂ) *
        (((Real.sin (Real.pi * (x r - x t)))⁻¹ : ℝ) : ℂ)

theorem cauchyEnergy_eq_S1_add_S2 (x : ι → ℝ) (u : ι → ℂ) :
    (∑ r, (Complex.normSq (conjugateCosecantRow x u r) : ℂ)) =
      montgomeryVaughanS1 x u + montgomeryVaughanS2 x u := by
  rw [montgomeryVaughanS1, montgomeryVaughanS2, ← Finset.sum_add_distrib]
  apply Finset.sum_congr rfl
  intro r hr
  rw [← Finset.sum_add_distrib]
  rw [conjugateCosecantRow, Complex.normSq_eq_conj_mul_self]
  rw [mul_comm]
  simp only [map_sum, map_mul, Complex.conj_ofReal]
  simp_rw [starRingEnd_apply, star_star]
  rw [Finset.sum_mul]
  apply Finset.sum_congr rfl
  intro s hs
  rw [Finset.mul_sum]
  rw [← Finset.sum_erase_add (Finset.univ.erase r)
    (fun t =>
      star (u s) *
        ↑(Real.sin (Real.pi * (x r - x s)))⁻¹ *
        (u t * ↑(Real.sin (Real.pi * (x r - x t)))⁻¹)) hs]
  ring_nf

theorem offDiagonal_sum_comm (f : ι → ι → ℂ) :
    (∑ s, ∑ r ∈ Finset.univ.erase s, f r s) =
      ∑ r, ∑ s ∈ Finset.univ.erase r, f r s :=
  Finset.sum_comm' fun _ _ => by simp [ne_comm]

omit [Fintype ι] in
theorem offDiagonal_sum_comm_on (S : Finset ι) (f : ι → ι → ℂ) :
    (∑ s ∈ S, ∑ r ∈ S.erase s, f s r) =
      ∑ r ∈ S, ∑ s ∈ S.erase r, f s r :=
  Finset.sum_comm' fun s r => by
    simp only [Finset.mem_erase, and_assoc, and_left_comm, ne_comm]

/-- The real cotangent of `pi * (x r - x s)`, expressed as cosine times the reciprocal sine. -/
noncomputable def cotangentPiDiff (x : ι → ℝ) (r s : ι) : ℝ :=
  Real.cos (Real.pi * (x r - x s)) *
    (Real.sin (Real.pi * (x r - x s)))⁻¹

/--
The pairwise-distinct triple sum with coefficient `conj (u s) * u t`, cosecant difference `x s -
x t`, and cotangent difference `x r - x s`. It is one part of the cotangent decomposition of the
off-diagonal square term.
-/
noncomputable def montgomeryVaughanA (x : ι → ℝ) (u : ι → ℂ) : ℂ :=
  ∑ r, ∑ s ∈ Finset.univ.erase r,
    ∑ t ∈ (Finset.univ.erase r).erase s,
      star (u s) * u t *
        (((Real.sin (Real.pi * (x s - x t)))⁻¹ : ℝ) : ℂ) *
        (cotangentPiDiff x r s : ℂ)

/--
The pairwise-distinct triple sum with coefficient `conj (u s) * u t`, cosecant difference `x s -
x t`, and cotangent difference `x r - x t`. It is the second part of the cotangent decomposition
of the off-diagonal square term.
-/
noncomputable def montgomeryVaughanB (x : ι → ℝ) (u : ι → ℂ) : ℂ :=
  ∑ r, ∑ s ∈ Finset.univ.erase r,
    ∑ t ∈ (Finset.univ.erase r).erase s,
      star (u s) * u t *
        (((Real.sin (Real.pi * (x s - x t)))⁻¹ : ℝ) : ℂ) *
        (cotangentPiDiff x r t : ℂ)

theorem montgomeryVaughanS2_eq_A_sub_B
    (x : ι → ℝ) (u : ι → ℂ)
    (htrig : ∀ r s t, r ≠ s → r ≠ t → s ≠ t →
      (((Real.sin (Real.pi * (x r - x s)))⁻¹ : ℝ) : ℂ) *
          (((Real.sin (Real.pi * (x r - x t)))⁻¹ : ℝ) : ℂ) =
        (((Real.sin (Real.pi * (x s - x t)))⁻¹ : ℝ) : ℂ) *
          ((cotangentPiDiff x r s : ℂ) - (cotangentPiDiff x r t : ℂ))) :
    montgomeryVaughanS2 x u =
      montgomeryVaughanA x u - montgomeryVaughanB x u := by
  rw [montgomeryVaughanS2, montgomeryVaughanA, montgomeryVaughanB,
    ← Finset.sum_sub_distrib]
  apply Finset.sum_congr rfl
  intro r hr
  rw [← Finset.sum_sub_distrib]
  apply Finset.sum_congr rfl
  intro s hs
  rw [← Finset.sum_sub_distrib]
  apply Finset.sum_congr rfl
  intro t ht
  have hrs : r ≠ s := Ne.symm (Finset.ne_of_mem_erase hs)
  have htr : t ≠ r := (Finset.mem_erase.mp (Finset.mem_erase.mp ht).2).1
  have hts : t ≠ s := Finset.ne_of_mem_erase ht
  have hi := htrig r s t hrs (Ne.symm htr) (Ne.symm hts)
  simpa only [mul_assoc, mul_sub] using
    congrArg (fun z : ℂ => star (u s) * u t * z) hi

omit [Fintype ι] [DecidableEq ι] in
theorem cotangentPiDiff_swap (x : ι → ℝ) (r s : ι) :
    cotangentPiDiff x s r = -cotangentPiDiff x r s := by
  rw [cotangentPiDiff, cotangentPiDiff]
  rw [show x s - x r = -(x r - x s) by ring, mul_neg, Real.cos_neg,
    Real.sin_neg, inv_neg]
  ring

theorem sum_reverse_cosecant_eq_neg_incomingCosecantSum (x : ι → ℝ) (u : ι → ℂ) (s : ι) :
    (∑ r ∈ Finset.univ.erase s,
      u r * (((Real.sin (Real.pi * (x s - x r)))⁻¹ : ℝ) : ℂ)) =
      -incomingCosecantSum x u s := by
  rw [incomingCosecantSum, ← Finset.sum_neg_distrib]
  apply Finset.sum_congr rfl
  intro r hr
  rw [show x s - x r = -(x r - x s) by ring, mul_neg, Real.sin_neg, inv_neg]
  rw [Complex.ofReal_neg]
  ring

/--
The cotangent-decomposition sum with only `r ≠ s` and `t ≠ s` imposed. Allowing `r = t`
separates the row sums at the cost of a diagonal correction.
-/
noncomputable def montgomeryVaughanS3 (x : ι → ℝ) (u : ι → ℂ) : ℂ :=
  ∑ s, ∑ r ∈ Finset.univ.erase s, ∑ t ∈ Finset.univ.erase s,
    star (u s) * u t *
      (((Real.sin (Real.pi * (x s - x t)))⁻¹ : ℝ) : ℂ) *
      (cotangentPiDiff x r s : ℂ)

/--
The cotangent-decomposition sum with only `r ≠ t` and `s ≠ t` imposed. Allowing `r = s`
separates the row sums at the cost of a diagonal correction.
-/
noncomputable def montgomeryVaughanS4 (x : ι → ℝ) (u : ι → ℂ) : ℂ :=
  ∑ t, ∑ r ∈ Finset.univ.erase t, ∑ s ∈ Finset.univ.erase t,
    star (u s) * u t *
      (((Real.sin (Real.pi * (x s - x t)))⁻¹ : ℝ) : ℂ) *
      (cotangentPiDiff x r t : ℂ)

/--
The double-sum correction with coefficient `conj (u s) * u r` and the product of cosecant and
cotangent at `pi * (x r - x s)`. The diagonal `r = s` is omitted.
-/
noncomputable def montgomeryVaughanS5 (x : ι → ℝ) (u : ι → ℂ) : ℂ :=
  ∑ s, ∑ r ∈ Finset.univ.erase s,
    star (u s) * u r *
      (((Real.sin (Real.pi * (x r - x s)))⁻¹ : ℝ) : ℂ) *
      (cotangentPiDiff x r s : ℂ)

/--
The zero-diagonal matrix whose off-diagonal entry is the product of cosecant and cotangent at
`pi * (x r - x s)`. Both factors are odd, so their product gives a real symmetric kernel.
-/
noncomputable def cscCotangentKernel (x : ι → ℝ) : Matrix ι ι ℂ := fun s r =>
  if s = r then 0
  else (((Real.sin (Real.pi * (x r - x s)))⁻¹ : ℝ) : ℂ) *
    (cotangentPiDiff x r s : ℂ)

omit [Fintype ι] in
theorem cscCotangentKernel_isHermitian (x : ι → ℝ) :
    (cscCotangentKernel x).IsHermitian := by
  apply Matrix.IsHermitian.ext
  intro s r
  by_cases hsr : s = r
  · subst r
    simp [cscCotangentKernel]
  · rw [cscCotangentKernel, cscCotangentKernel, ite_eq_right hsr,
      ite_eq_right (Ne.symm hsr)]
    rw [star_mul', Complex.star_def, Complex.conj_ofReal, Complex.conj_ofReal]
    rw [show x s - x r = -(x r - x s) by ring, mul_neg, Real.sin_neg, inv_neg,
      cotangentPiDiff_swap]
    push_cast
    ring

theorem montgomeryVaughanS5_eq_star_dotProduct_mulVec
    (x : ι → ℝ) (u : ι → ℂ) :
    montgomeryVaughanS5 x u = star u ⬝ᵥ (cscCotangentKernel x *ᵥ u) := by
  rw [montgomeryVaughanS5, dotProduct]
  simp only [Matrix.mulVec, dotProduct]
  apply Finset.sum_congr rfl
  intro s hs
  have hdiag : (cscCotangentKernel x) s s * u s = 0 := by
    simp [cscCotangentKernel]
  have hsum :
      ∑ r ∈ Finset.univ.erase s, (cscCotangentKernel x) s r * u r =
        ∑ r, (cscCotangentKernel x) s r * u r :=
    Finset.sum_erase Finset.univ hdiag
  rw [← hsum, Finset.mul_sum]
  apply Finset.sum_congr rfl
  intro r hr
  have hrs : r ≠ s := Finset.ne_of_mem_erase hr
  rw [cscCotangentKernel, ite_eq_right (Ne.symm hrs)]
  rw [Pi.star_apply]
  ring

theorem montgomeryVaughanS5_im (x : ι → ℝ) (u : ι → ℂ) :
    (montgomeryVaughanS5 x u).im = 0 := by
  rw [montgomeryVaughanS5_eq_star_dotProduct_mulVec]
  exact (cscCotangentKernel_isHermitian x).im_star_dotProduct_mulVec_self u

theorem montgomeryVaughanS5_row_first (x : ι → ℝ) (u : ι → ℂ) :
    montgomeryVaughanS5 x u =
      ∑ r, ∑ s ∈ Finset.univ.erase r,
        star (u s) * u r *
          (((Real.sin (Real.pi * (x r - x s)))⁻¹ : ℝ) : ℂ) *
          (cotangentPiDiff x r s : ℂ) := by
  rw [montgomeryVaughanS5]
  exact offDiagonal_sum_comm (fun r s =>
    star (u s) * u r *
      (((Real.sin (Real.pi * (x r - x s)))⁻¹ : ℝ) : ℂ) *
      (cotangentPiDiff x r s : ℂ))

theorem montgomeryVaughanS5_same_orientation (x : ι → ℝ) (u : ι → ℂ) :
    montgomeryVaughanS5 x u =
      ∑ r, ∑ t ∈ Finset.univ.erase r,
        star (u r) * u t *
          (((Real.sin (Real.pi * (x r - x t)))⁻¹ : ℝ) : ℂ) *
          (cotangentPiDiff x r t : ℂ) := by
  rw [montgomeryVaughanS5]
  apply Finset.sum_congr rfl
  intro r hr
  apply Finset.sum_congr rfl
  intro t ht
  rw [show x t - x r = -(x r - x t) by ring, mul_neg, Real.sin_neg, inv_neg,
    Complex.ofReal_neg, cotangentPiDiff_swap, Complex.ofReal_neg]
  ring

theorem montgomeryVaughanS3_eq_A_sub_S5 (x : ι → ℝ) (u : ι → ℂ) :
    montgomeryVaughanS3 x u =
      montgomeryVaughanA x u - montgomeryVaughanS5 x u := by
  rw [montgomeryVaughanS3, offDiagonal_sum_comm]
  rw [montgomeryVaughanA, montgomeryVaughanS5_row_first,
    ← Finset.sum_sub_distrib]
  apply Finset.sum_congr rfl
  intro r hr
  rw [← Finset.sum_sub_distrib]
  apply Finset.sum_congr rfl
  intro s hs
  have hsr : s ≠ r := Finset.ne_of_mem_erase hs
  have hrmem : r ∈ Finset.univ.erase s := by simp [Ne.symm hsr]
  rw [← Finset.sum_erase_add (Finset.univ.erase s)
    (fun t =>
      star (u s) * u t *
        (((Real.sin (Real.pi * (x s - x t)))⁻¹ : ℝ) : ℂ) *
        (cotangentPiDiff x r s : ℂ)) hrmem]
  rw [Finset.erase_right_comm]
  rw [show x s - x r = -(x r - x s) by ring, mul_neg, Real.sin_neg, inv_neg,
    Complex.ofReal_neg]
  ring

theorem montgomeryVaughanS4_eq_B_add_S5 (x : ι → ℝ) (u : ι → ℂ) :
    montgomeryVaughanS4 x u =
      montgomeryVaughanB x u + montgomeryVaughanS5 x u := by
  rw [montgomeryVaughanS4, offDiagonal_sum_comm]
  rw [montgomeryVaughanB, montgomeryVaughanS5_same_orientation]
  conv_rhs => arg 1; arg 2; intro r; rw [offDiagonal_sum_comm_on]
  rw [← Finset.sum_add_distrib]
  apply Finset.sum_congr rfl
  intro r hr
  rw [← Finset.sum_add_distrib]
  apply Finset.sum_congr rfl
  intro t ht
  have htr : t ≠ r := Finset.ne_of_mem_erase ht
  have hrmem : r ∈ Finset.univ.erase t := by simp [Ne.symm htr]
  rw [← Finset.sum_erase_add (Finset.univ.erase t)
    (fun s =>
      star (u s) * u t *
        (((Real.sin (Real.pi * (x s - x t)))⁻¹ : ℝ) : ℂ) *
        (cotangentPiDiff x r t : ℂ)) hrmem]
  rw [Finset.erase_right_comm]

theorem montgomeryVaughanS2_eq_S3_sub_S4_add_two_S5
    (x : ι → ℝ) (u : ι → ℂ)
    (htrig : ∀ r s t, r ≠ s → r ≠ t → s ≠ t →
      (((Real.sin (Real.pi * (x r - x s)))⁻¹ : ℝ) : ℂ) *
          (((Real.sin (Real.pi * (x r - x t)))⁻¹ : ℝ) : ℂ) =
        (((Real.sin (Real.pi * (x s - x t)))⁻¹ : ℝ) : ℂ) *
          ((cotangentPiDiff x r s : ℂ) - (cotangentPiDiff x r t : ℂ))) :
    montgomeryVaughanS2 x u =
      montgomeryVaughanS3 x u - montgomeryVaughanS4 x u +
        2 * montgomeryVaughanS5 x u := by
  rw [montgomeryVaughanS2_eq_A_sub_B x u htrig]
  have h3 := montgomeryVaughanS3_eq_A_sub_S5 x u
  have h4 := montgomeryVaughanS4_eq_B_add_S5 x u
  linear_combination -h3 + h4

theorem montgomeryVaughanS5_eq_ofReal_re (x : ι → ℝ) (u : ι → ℂ) :
    montgomeryVaughanS5 x u = ((montgomeryVaughanS5 x u).re : ℂ) :=
  Complex.ext rfl (montgomeryVaughanS5_im x u)

/--
The cotangent row sums weighted by `|u s| ^ 2`, with the result viewed in `ℂ`. Each inner sum
omits `r = s`.
-/
noncomputable def cotangentWeightedDiagonal (x : ι → ℝ) (u : ι → ℂ) : ℂ :=
  ∑ s, ∑ r ∈ Finset.univ.erase s,
    star (u s) * u s * (cotangentPiDiff x r s : ℂ)

theorem montgomeryVaughanS3_eq_of_cosecant_eigenvector
    (x : ι → ℝ) (u : ι → ℂ) (μ : ℝ)
    (hu : ∀ s, incomingCosecantSum x u s = Complex.I * μ * u s) :
    montgomeryVaughanS3 x u =
      (-Complex.I * μ) * cotangentWeightedDiagonal x u := by
  rw [montgomeryVaughanS3, cotangentWeightedDiagonal]
  rw [Finset.mul_sum]
  apply Finset.sum_congr rfl
  intro s hs
  rw [Finset.mul_sum]
  apply Finset.sum_congr rfl
  intro r hr
  rw [← Finset.sum_mul]
  simp_rw [mul_assoc (star (u s))]
  rw [← Finset.mul_sum, sum_reverse_cosecant_eq_neg_incomingCosecantSum, hu]
  ring

theorem montgomeryVaughanS4_eq_of_cosecant_eigenvector
    (x : ι → ℝ) (u : ι → ℂ) (μ : ℝ)
    (hu : ∀ s, incomingCosecantSum x u s = Complex.I * μ * u s) :
    montgomeryVaughanS4 x u =
      (-Complex.I * μ) * cotangentWeightedDiagonal x u := by
  rw [montgomeryVaughanS4, cotangentWeightedDiagonal]
  rw [Finset.mul_sum]
  apply Finset.sum_congr rfl
  intro t ht
  rw [Finset.mul_sum]
  apply Finset.sum_congr rfl
  intro r hr
  have hconj :
      (∑ s ∈ Finset.univ.erase t,
        star (u s) *
          (((Real.sin (Real.pi * (x s - x t)))⁻¹ : ℝ) : ℂ)) =
        -Complex.I * μ * star (u t) := by
    have hstar := congrArg star (hu t)
    rw [incomingCosecantSum] at hstar
    simp only [map_sum, map_mul, Complex.conj_ofReal, Complex.star_def,
      Complex.conj_I] at hstar
    simpa only [Complex.star_def] using hstar
  rw [← Finset.sum_mul]
  simp_rw [mul_right_comm _ (u t)]
  rw [← Finset.sum_mul, hconj]
  ring

theorem montgomeryVaughanS3_eq_S4_of_cosecant_eigenvector
    (x : ι → ℝ) (u : ι → ℂ) (μ : ℝ)
    (hu : ∀ s, incomingCosecantSum x u s = Complex.I * μ * u s) :
    montgomeryVaughanS3 x u = montgomeryVaughanS4 x u := by
  rw [montgomeryVaughanS3_eq_of_cosecant_eigenvector x u μ hu,
    montgomeryVaughanS4_eq_of_cosecant_eigenvector x u μ hu]

theorem montgomeryVaughanS2_eq_two_re_S5_of_cosecant_eigenvector
    (x : ι → ℝ) (u : ι → ℂ) (μ : ℝ)
    (htrig : ∀ r s t, r ≠ s → r ≠ t → s ≠ t →
      (((Real.sin (Real.pi * (x r - x s)))⁻¹ : ℝ) : ℂ) *
          (((Real.sin (Real.pi * (x r - x t)))⁻¹ : ℝ) : ℂ) =
        (((Real.sin (Real.pi * (x s - x t)))⁻¹ : ℝ) : ℂ) *
          ((cotangentPiDiff x r s : ℂ) - (cotangentPiDiff x r t : ℂ)))
    (hu : ∀ s, incomingCosecantSum x u s = Complex.I * μ * u s) :
    montgomeryVaughanS2 x u =
      2 * ((montgomeryVaughanS5 x u).re : ℂ) := by
  rw [montgomeryVaughanS2_eq_S3_sub_S4_add_two_S5 x u htrig,
    montgomeryVaughanS3_eq_S4_of_cosecant_eigenvector x u μ hu, sub_self, zero_add]
  exact congrArg (fun z : ℂ => 2 * z) (montgomeryVaughanS5_eq_ofReal_re x u)

end

section
open scoped ComplexConjugate
open Finset

variable {ι : Type*} [Fintype ι] [DecidableEq ι]
theorem conjugateCosecantRow_of_cosecant_eigenvector
    (x : ι → ℝ) (u : ι → ℂ) (μ : ℝ)
    (hu : ∀ s, incomingCosecantSum x u s = Complex.I * μ * u s) (r : ι) :
    conjugateCosecantRow x u r = Complex.I * μ * star (u r) := by
  have hstar := congrArg star (sum_reverse_cosecant_eq_neg_incomingCosecantSum x u r)
  simp only [map_sum, map_mul, Complex.conj_ofReal, map_neg, Complex.star_def] at hstar
  rw [hu] at hstar
  simp only [map_mul, Complex.conj_I, Complex.conj_ofReal] at hstar
  rw [conjugateCosecantRow]
  change (∑ s ∈ Finset.univ.erase r,
    (starRingEnd ℂ) (u s) *
      (((Real.sin (Real.pi * (x r - x s)))⁻¹ : ℝ) : ℂ)) =
    Complex.I * μ * (starRingEnd ℂ) (u r)
  calc
    _ = -(-Complex.I * μ * (starRingEnd ℂ) (u r)) := hstar
    _ = Complex.I * μ * (starRingEnd ℂ) (u r) := by ring

theorem cauchyEnergy_eq_eigenvalue_sq
    (x : ι → ℝ) (u : ι → ℂ) (μ : ℝ)
    (hu : ∀ s, incomingCosecantSum x u s = Complex.I * μ * u s)
    (hnorm : (∑ r, ‖u r‖ ^ 2) = 1) :
    (∑ r, (Complex.normSq (conjugateCosecantRow x u r) : ℂ)) = (μ ^ 2 : ℂ) := by
  have hsquare (r : ι) :
      Complex.normSq (Complex.I * (μ : ℂ) * star (u r)) = μ ^ 2 * ‖u r‖ ^ 2 := by
    rw [Complex.normSq_mul, Complex.normSq_mul, Complex.normSq_I,
      Complex.normSq_ofReal, Complex.star_def, Complex.normSq_conj,
      Complex.normSq_eq_norm_sq]
    simp only [one_mul, pow_two]
  simp_rw [conjugateCosecantRow_of_cosecant_eigenvector x u μ hu, hsquare]
  have hnormC : (∑ r, (‖u r‖ : ℂ) ^ 2) = 1 := by
    exact_mod_cast hnorm
  push_cast
  rw [← Finset.mul_sum, hnormC]
  norm_num

theorem eigenvalue_sq_eq_S1_add_two_re_S5
    (x : ι → ℝ) (u : ι → ℂ) (μ : ℝ)
    (htrig : ∀ r s t, r ≠ s → r ≠ t → s ≠ t →
      (((Real.sin (Real.pi * (x r - x s)))⁻¹ : ℝ) : ℂ) *
          (((Real.sin (Real.pi * (x r - x t)))⁻¹ : ℝ) : ℂ) =
        (((Real.sin (Real.pi * (x s - x t)))⁻¹ : ℝ) : ℂ) *
          ((cotangentPiDiff x r s : ℂ) - (cotangentPiDiff x r t : ℂ)))
    (hu : ∀ s, incomingCosecantSum x u s = Complex.I * μ * u s)
    (hnorm : (∑ r, ‖u r‖ ^ 2) = 1) :
    (μ ^ 2 : ℂ) = montgomeryVaughanS1 x u +
      2 * ((montgomeryVaughanS5 x u).re : ℂ) := by
  rw [← cauchyEnergy_eq_eigenvalue_sq x u μ hu hnorm,
    cauchyEnergy_eq_S1_add_S2,
    montgomeryVaughanS2_eq_two_re_S5_of_cosecant_eigenvector x u μ htrig hu]

theorem eigenvalue_sq_eq_re_S1_add_two_re_S5
    (x : ι → ℝ) (u : ι → ℂ) (μ : ℝ)
    (htrig : ∀ r s t, r ≠ s → r ≠ t → s ≠ t →
      (((Real.sin (Real.pi * (x r - x s)))⁻¹ : ℝ) : ℂ) *
          (((Real.sin (Real.pi * (x r - x t)))⁻¹ : ℝ) : ℂ) =
        (((Real.sin (Real.pi * (x s - x t)))⁻¹ : ℝ) : ℂ) *
          ((cotangentPiDiff x r s : ℂ) - (cotangentPiDiff x r t : ℂ)))
    (hu : ∀ s, incomingCosecantSum x u s = Complex.I * μ * u s)
    (hnorm : (∑ r, ‖u r‖ ^ 2) = 1) :
    μ ^ 2 = (montgomeryVaughanS1 x u).re +
      2 * (montgomeryVaughanS5 x u).re := by
  have h := congrArg Complex.re
    (eigenvalue_sq_eq_S1_add_two_re_S5 x u μ htrig hu hnorm)
  norm_num [pow_two, Complex.mul_re] at h
  simpa [pow_two] using h

end

theorem sin_pi_mul_ne_zero_of_unitAddCircle_ne_zero (a : ℝ)
    (ha : (a : UnitAddCircle) ≠ 0) :
    Real.sin (Real.pi * a) ≠ 0 := by
  rw [Real.sin_ne_zero_iff]
  intro n hn
  apply ha
  rw [AddCircle.coe_eq_zero_iff]
  refine ⟨n, ?_⟩
  have hna : (n : ℝ) = a := by
    nlinarith [Real.pi_pos]
  simpa [zsmul_eq_mul] using hna

theorem quotientDiff_ne_zero
    {ι : Type*} (x : ι → ℝ) {δ : ℝ} (hδ : 0 < δ)
    (hsep : ∀ r s, r ≠ s →
      δ ≤ dist (x r : UnitAddCircle) (x s : UnitAddCircle))
    {r s : ι} (hrs : r ≠ s) :
    ((x r - x s : ℝ) : UnitAddCircle) ≠ 0 := by
  change (x r : UnitAddCircle) - (x s : UnitAddCircle) ≠ 0
  exact sub_ne_zero.mpr (dist_pos.mp (hδ.trans_le (hsep r s hrs)))

theorem cosecantCotangentIdentity_of_separated
    {ι : Type*} (x : ι → ℝ) {δ : ℝ} (hδ : 0 < δ)
    (hsep : ∀ r s, r ≠ s →
      δ ≤ dist (x r : UnitAddCircle) (x s : UnitAddCircle)) :
    ∀ r s t, r ≠ s → r ≠ t → s ≠ t →
      (((Real.sin (Real.pi * (x r - x s)))⁻¹ : ℝ) : ℂ) *
          (((Real.sin (Real.pi * (x r - x t)))⁻¹ : ℝ) : ℂ) =
        (((Real.sin (Real.pi * (x s - x t)))⁻¹ : ℝ) : ℂ) *
          ((cotangentPiDiff x r s : ℂ) - (cotangentPiDiff x r t : ℂ)) := by
  intro r s t hrs hrt hst
  have hrs0 := sin_pi_mul_ne_zero_of_unitAddCircle_ne_zero (x r - x s)
    (quotientDiff_ne_zero x hδ hsep hrs)
  have hrt0 := sin_pi_mul_ne_zero_of_unitAddCircle_ne_zero (x r - x t)
    (quotientDiff_ne_zero x hδ hsep hrt)
  have hst0 := sin_pi_mul_ne_zero_of_unitAddCircle_ne_zero (x s - x t)
    (quotientDiff_ne_zero x hδ hsep hst)
  norm_cast
  dsimp [cotangentPiDiff]
  field_simp
  rw [show Real.pi * (x s - x t) =
    Real.pi * (x r - x t) - Real.pi * (x r - x s) by ring, Real.sin_sub]
  ring

section
open scoped ComplexConjugate
open Finset

variable {ι : Type*} [Fintype ι] [DecidableEq ι]
/--
The absolute value of the cosecant–cotangent product at `pi * (x r - x s)`, used as a
nonnegative kernel weight.
-/
noncomputable def cscCotangentWeight (x : ι → ℝ) (r s : ι) : ℝ :=
  |cotangentPiDiff x r s * cosecantPi (x r - x s)|

theorem sum_csc_sq_add_two_weight_le_inv_sq
    (x : ι → ℝ) {δ : ℝ} (hδ : 0 < δ)
    (hsep : ∀ r s, r ≠ s →
      δ ≤ dist (x r : UnitAddCircle) (x s : UnitAddCircle))
    (s : ι) :
    (∑ r ∈ Finset.univ.erase s,
      (cosecantPi (x r - x s) ^ 2 + 2 * cscCotangentWeight x r s)) ≤
      δ⁻¹ ^ 2 := by
  calc
    (∑ r ∈ Finset.univ.erase s,
      (cosecantPi (x r - x s) ^ 2 + 2 * cscCotangentWeight x r s)) ≤
        ∑ r ∈ Finset.univ.erase s,
          3 / (Real.pi ^ 2 *
            dist (x r : UnitAddCircle) (x s : UnitAddCircle) ^ 2) := by
      apply Finset.sum_le_sum
      intro r hr
      simpa only [cscCotangentWeight, cotangentPiDiff,
        Real.cot_eq_cos_div_sin, div_eq_mul_inv, AddCircle.coe_sub, dist_eq_norm] using
        (cosecant_cotangent_majorant (x r - x s)
          (quotientDiff_ne_zero x hδ hsep (Finset.ne_of_mem_erase hr)))
    _ = (3 / Real.pi ^ 2) *
        ∑ r ∈ Finset.univ.erase s,
          (dist (x s : UnitAddCircle) (x r : UnitAddCircle) ^ 2)⁻¹ := by
      rw [Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro r hr
      rw [dist_comm (x s : UnitAddCircle) (x r : UnitAddCircle)]
      simp only [div_eq_mul_inv, _root_.mul_inv_rev]
      ring
    _ ≤ (3 / Real.pi ^ 2) * (Real.pi ^ 2 / (3 * δ ^ 2)) := by
      apply mul_le_mul_of_nonneg_left
      · exact sum_inv_sq_circle_dist_le
          (fun r => (x r : UnitAddCircle)) hδ hsep s
      · positivity
    _ = δ⁻¹ ^ 2 := by
      field_simp [ne_of_gt Real.pi_pos, hδ.ne']

theorem montgomeryVaughanS5_re_le (x : ι → ℝ) (u : ι → ℂ) :
    (montgomeryVaughanS5 x u).re ≤
      ∑ s, ∑ r ∈ Finset.univ.erase s,
        ‖u s‖ * ‖u r‖ * cscCotangentWeight x r s := by
  rw [montgomeryVaughanS5, Complex.re_sum]
  apply Finset.sum_le_sum
  intro s hs
  rw [Complex.re_sum]
  apply Finset.sum_le_sum
  intro r hr
  apply (Complex.re_le_norm _).trans_eq
  simp only [norm_mul, norm_star, Complex.norm_real, Real.norm_eq_abs]
  rw [cscCotangentWeight, cosecantPi, cotangentPiDiff, abs_mul]
  simp only [abs_mul]
  ring

theorem two_mul_sum_norm_mul_norm_weight_le
    (x : ι → ℝ) (u : ι → ℂ) :
    2 * (∑ s, ∑ r ∈ Finset.univ.erase s,
      ‖u s‖ * ‖u r‖ * cscCotangentWeight x r s) ≤
      2 * (∑ s, ∑ r ∈ Finset.univ.erase s,
        ‖u s‖ ^ 2 * cscCotangentWeight x r s) := by
  let D := ∑ s, ∑ r ∈ Finset.univ.erase s,
    ‖u s‖ ^ 2 * cscCotangentWeight x r s
  have hyoung :
      2 * (∑ s, ∑ r ∈ Finset.univ.erase s,
        ‖u s‖ * ‖u r‖ * cscCotangentWeight x r s) ≤
        ∑ s, ∑ r ∈ Finset.univ.erase s,
          (‖u s‖ ^ 2 + ‖u r‖ ^ 2) * cscCotangentWeight x r s := by
    rw [Finset.mul_sum]
    apply Finset.sum_le_sum
    intro s hs
    rw [Finset.mul_sum]
    apply Finset.sum_le_sum
    intro r hr
    calc
      2 * (‖u s‖ * ‖u r‖ * cscCotangentWeight x r s) =
          (2 * ‖u s‖ * ‖u r‖) * cscCotangentWeight x r s := by ring
      _ ≤ (‖u s‖ ^ 2 + ‖u r‖ ^ 2) * cscCotangentWeight x r s :=
        mul_le_mul_of_nonneg_right (two_mul_le_add_sq _ _) (abs_nonneg _)
  have hswap :
      (∑ s, ∑ r ∈ Finset.univ.erase s,
        ‖u r‖ ^ 2 * cscCotangentWeight x r s) = D := by
    calc
      (∑ s, ∑ r ∈ Finset.univ.erase s,
        ‖u r‖ ^ 2 * cscCotangentWeight x r s) =
          ∑ r, ∑ s ∈ Finset.univ.erase r,
            ‖u r‖ ^ 2 * cscCotangentWeight x r s :=
        Finset.sum_comm' fun _ _ => by simp [ne_comm]
      _ = D := by
        dsimp [D]
        apply Finset.sum_congr rfl
        intro r hr
        apply Finset.sum_congr rfl
        intro s hs
        congr 1
        rw [cscCotangentWeight, cscCotangentWeight, cotangentPiDiff_swap,
          show x s - x r = -(x r - x s) by ring,
          cosecantPi, cosecantPi, mul_neg, Real.sin_neg, inv_neg]
        congr 1
        ring
  calc
    2 * (∑ s, ∑ r ∈ Finset.univ.erase s,
      ‖u s‖ * ‖u r‖ * cscCotangentWeight x r s) ≤
        ∑ s, ∑ r ∈ Finset.univ.erase s,
          (‖u s‖ ^ 2 + ‖u r‖ ^ 2) * cscCotangentWeight x r s := hyoung
    _ = D + D := by
      simp_rw [add_mul, Finset.sum_add_distrib]
      rw [hswap]
    _ = 2 * D := by ring
    _ = 2 * (∑ s, ∑ r ∈ Finset.univ.erase s,
        ‖u s‖ ^ 2 * cscCotangentWeight x r s) := rfl

theorem montgomeryVaughan_energy_le
    (x : ι → ℝ) {δ : ℝ} (hδ : 0 < δ)
    (hsep : ∀ r s, r ≠ s →
      δ ≤ dist (x r : UnitAddCircle) (x s : UnitAddCircle))
    (u : ι → ℂ) (hnorm : (∑ r, ‖u r‖ ^ 2) = 1) :
    (montgomeryVaughanS1 x u).re + 2 * (montgomeryVaughanS5 x u).re ≤
      δ⁻¹ ^ 2 := by
  have hS1 : (montgomeryVaughanS1 x u).re =
      ∑ s, ∑ r ∈ Finset.univ.erase s,
        ‖u s‖ ^ 2 * cosecantPi (x r - x s) ^ 2 := by
    calc
      _ = ∑ r, ∑ s ∈ Finset.univ.erase r,
          ‖u s‖ ^ 2 * cosecantPi (x r - x s) ^ 2 := by
        rw [montgomeryVaughanS1, Complex.re_sum]
        apply Finset.sum_congr rfl
        intro r hr
        rw [Complex.re_sum]
        apply Finset.sum_congr rfl
        intro s hs
        rw [show star (u s) * u s = (‖u s‖ ^ 2 : ℂ) by
          exact RCLike.conj_mul (u s)]
        rw [cosecantPi]
        norm_cast
      _ = _ := Finset.sum_comm' fun _ _ => by simp [ne_comm]
  have hS5 : 2 * (montgomeryVaughanS5 x u).re ≤
      2 * (∑ s, ∑ r ∈ Finset.univ.erase s,
        ‖u s‖ ^ 2 * cscCotangentWeight x r s) := by
    calc
      2 * (montgomeryVaughanS5 x u).re ≤
          2 * (∑ s, ∑ r ∈ Finset.univ.erase s,
            ‖u s‖ * ‖u r‖ * cscCotangentWeight x r s) :=
        mul_le_mul_of_nonneg_left (montgomeryVaughanS5_re_le x u) (by norm_num)
      _ ≤ 2 * (∑ s, ∑ r ∈ Finset.univ.erase s,
          ‖u s‖ ^ 2 * cscCotangentWeight x r s) :=
        two_mul_sum_norm_mul_norm_weight_le x u
  calc
    (montgomeryVaughanS1 x u).re + 2 * (montgomeryVaughanS5 x u).re ≤
        (montgomeryVaughanS1 x u).re +
          2 * (∑ s, ∑ r ∈ Finset.univ.erase s,
            ‖u s‖ ^ 2 * cscCotangentWeight x r s) :=
      add_le_add_right hS5 _
    _ = ∑ s, ∑ r ∈ Finset.univ.erase s,
        ‖u s‖ ^ 2 *
          (cosecantPi (x r - x s) ^ 2 + 2 * cscCotangentWeight x r s) := by
      rw [hS1]
      simp_rw [mul_add, Finset.sum_add_distrib]
      rw [Finset.mul_sum]
      simp_rw [Finset.mul_sum]
      ring_nf
    _ ≤ ∑ s, ‖u s‖ ^ 2 * δ⁻¹ ^ 2 := by
      apply Finset.sum_le_sum
      intro s hs
      calc
        (∑ r ∈ Finset.univ.erase s,
          ‖u s‖ ^ 2 *
            (cosecantPi (x r - x s) ^ 2 + 2 * cscCotangentWeight x r s)) =
            ‖u s‖ ^ 2 *
              ∑ r ∈ Finset.univ.erase s,
                (cosecantPi (x r - x s) ^ 2 +
                  2 * cscCotangentWeight x r s) := by
          rw [Finset.mul_sum]
        _ ≤ ‖u s‖ ^ 2 * δ⁻¹ ^ 2 :=
          mul_le_mul_of_nonneg_left
            (sum_csc_sq_add_two_weight_le_inv_sq x hδ hsep s)
            (sq_nonneg ‖u s‖)
    _ = δ⁻¹ ^ 2 := by
      rw [← Finset.sum_mul, hnorm, one_mul]

theorem normalizedEigenvalue_sq_le_of_separated
    (x : ι → ℝ) {δ : ℝ} (hδ : 0 < δ)
    (hsep : ∀ r s, r ≠ s →
      δ ≤ dist (x r : UnitAddCircle) (x s : UnitAddCircle))
    (u : ι → ℂ) (μ : ℝ)
    (hu : ∀ s, incomingCosecantSum x u s = Complex.I * μ * u s)
    (hnorm : (∑ r, ‖u r‖ ^ 2) = 1) :
    μ ^ 2 ≤ δ⁻¹ ^ 2 := by
  rw [eigenvalue_sq_eq_re_S1_add_two_re_S5 x u μ
    (cosecantCotangentIdentity_of_separated x hδ hsep) hu hnorm]
  exact montgomeryVaughan_energy_le x hδ hsep u hnorm

theorem norm_cosecantBilinearForm_le_of_separated
    (x : ι → ℝ) {δ : ℝ} (hδ : 0 < δ)
    (hsep : ∀ r s, r ≠ s →
      δ ≤ dist (x r : UnitAddCircle) (x s : UnitAddCircle))
    (u : ι → ℂ) :
    ‖cosecantBilinearForm x u‖ ≤ δ⁻¹ * ∑ i, ‖u i‖ ^ 2 := by
  apply norm_cosecantBilinearForm_le_of_normalized_eigenvector_estimate x hδ
  intro μ v hv hnorm
  exact normalizedEigenvalue_sq_le_of_separated x hδ hsep v μ hv hnorm

end

theorem norm_cosecantBilinearForm_le
    {ι : Type*} [Fintype ι] [DecidableEq ι]
    (x : ι → ℝ) {δ : ℝ} (hδ : 0 < δ)
    (hsep : ∀ r s, r ≠ s →
      δ ≤ dist (x r : UnitAddCircle) (x s : UnitAddCircle))
    (u : ι → ℂ) :
    ‖cosecantBilinearForm x u‖ ≤ δ⁻¹ * ∑ r, ‖u r‖ ^ 2 :=
  norm_cosecantBilinearForm_le_of_separated x hδ hsep u

section
open scoped ComplexConjugate

variable {ι : Type*} {κ : Type*}
/--
The finite transpose action of the kernel `C` on `v`, summing over source indices in `s`. This
is an ordinary transpose sum, with no complex conjugation.
-/
def transposeSum
    (s : Finset ι) (C : ι → κ → ℂ) (v : ι → ℂ) (n : κ) : ℂ :=
  ∑ r ∈ s, C r n * v r

/-- The finite matrix action of the kernel `C` on `w`, summing over column indices in `t`. -/
def matrixSum
    (t : Finset κ) (C : ι → κ → ℂ) (w : κ → ℂ) (r : ι) : ℂ :=
  ∑ n ∈ t, C r n * w n

theorem finite_transpose_l2_bound
    {ι κ : Type*} [Fintype ι] [Fintype κ]
    (C : ι → κ → ℂ) {A : ℝ} (hA : 0 ≤ A)
    (hdual : ∀ v : ι → ℂ,
      (∑ n, ‖∑ r, C r n * v r‖ ^ 2) ≤
        A * ∑ r, ‖v r‖ ^ 2)
    (w : κ → ℂ) :
    (∑ r, ‖∑ n, C r n * w n‖ ^ 2) ≤
      A * ∑ n, ‖w n‖ ^ 2 := by
  let z : ι → ℂ := matrixSum Finset.univ C w
  let v : ι → ℂ := fun r => star (z r)
  let L : ℝ := ∑ r, ‖z r‖ ^ 2
  let W : ℝ := ∑ n, ‖w n‖ ^ 2
  let R : ℝ := ∑ n, ‖transposeSum Finset.univ C v n‖ ^ 2
  have hL : 0 ≤ L := Finset.sum_nonneg fun _ _ => sq_nonneg _
  have hW : 0 ≤ W := Finset.sum_nonneg fun _ _ => sq_nonneg _
  have hpair : (L : ℂ) = ∑ n, w n * transposeSum Finset.univ C v n := by
    dsimp only [L, v, z, transposeSum]
    calc
      _ = ∑ r, star (matrixSum Finset.univ C w r) *
          matrixSum Finset.univ C w r := by
        simp only [Complex.ofReal_sum, Complex.star_def,
          ← Complex.normSq_eq_conj_mul_self, Complex.normSq_eq_norm_sq]
      _ = _ := by
        unfold matrixSum
        simp_rw [Finset.mul_sum]
        rw [Finset.sum_comm]
        simp only [mul_left_comm, mul_comm, mul_assoc]
  have hcs : L ^ 2 ≤ W * R := by
    calc
      L ^ 2 = ‖(L : ℂ)‖ ^ 2 := by rw [Complex.norm_of_nonneg hL]
      _ = ‖∑ n, w n * transposeSum Finset.univ C v n‖ ^ 2 := by rw [hpair]
      _ ≤ (∑ n, ‖w n‖ * ‖transposeSum Finset.univ C v n‖) ^ 2 :=
        pow_le_pow_left₀ (norm_nonneg _)
          (by
            simpa only [norm_mul] using norm_sum_le Finset.univ
              (fun n => w n * transposeSum Finset.univ C v n)) 2
      _ ≤ W * R :=
        Finset.sum_mul_sq_le_sq_mul_sq Finset.univ
          (fun n => ‖w n‖) (fun n => ‖transposeSum Finset.univ C v n‖)
  have hR : R ≤ A * L := by
    simpa only [R, transposeSum, L, v, norm_star] using hdual v
  have hsq : L ^ 2 ≤ (A * W) * L := by
    calc
      L ^ 2 ≤ W * R := hcs
      _ ≤ W * (A * L) := mul_le_mul_of_nonneg_left hR hW
      _ = (A * W) * L := by ring
  have hmain : L ≤ A * W := by
    rcases hL.eq_or_lt with hLzero | hLpos
    · rw [← hLzero]
      exact mul_nonneg hA hW
    · rw [← mul_le_mul_iff_right₀ hLpos]
      simpa only [pow_two, mul_assoc, mul_comm] using hsq
  dsimp only [L, W, z, matrixSum] at hmain
  exact hmain

end

theorem phase_half_denominator (t : ℝ) :
    (1 - (Real.fourierChar t : ℂ)) * Complex.I =
      2 * (Real.fourierChar (t / 2) : ℂ) * (Real.sin (Real.pi * t) : ℂ) := by
  have hdouble :
      (Real.fourierChar t : ℂ) =
        (Real.fourierChar (t / 2) : ℂ) * (Real.fourierChar (t / 2) : ℂ) := by
    simpa only [show t / 2 + t / 2 = t by ring, Circle.coe_mul] using
      congrArg (fun z : Circle ↦ (z : ℂ))
        (AddChar.map_add_eq_mul Real.fourierChar (t / 2) (t / 2))
  rw [hdouble]
  have hhalf :
      (Real.fourierChar (t / 2) : ℂ) =
        Complex.exp (Real.pi * Complex.I * t) := by
    rw [Real.fourierChar_apply]
    congr 1
    push_cast
    ring
  rw [hhalf, Complex.ofReal_sin]
  rw [show ((Real.pi * t : ℝ) : ℂ) =
      (Real.pi : ℂ) * (t : ℂ) by push_cast; rfl]
  change (1 - Complex.exp (Real.pi * Complex.I * t) *
      Complex.exp (Real.pi * Complex.I * t)) * Complex.I =
    2 * Complex.exp (Real.pi * Complex.I * t) *
      (Complex.sin (Real.pi * t) : ℂ)
  rw [Complex.sin]
  have hcancel :
      Complex.exp (Real.pi * Complex.I * t) *
          Complex.exp (-(Real.pi * Complex.I * t)) = 1 := by
    rw [← Complex.exp_add]
    simp
  ring_nf
  rw [show Complex.I * Complex.exp (Real.pi * Complex.I * t) *
      Complex.exp (-(Real.pi * Complex.I * t)) = Complex.I by
        rw [mul_assoc, hcancel, mul_one]]

theorem phase_ne_one_of_unitAddCircle_ne_zero (t : ℝ)
    (ht : (t : UnitAddCircle) ≠ 0) : (Real.fourierChar t : ℂ) ≠ 1 := by
  intro hphase
  apply ht
  apply AddCircle.injective_toCircle one_ne_zero
  apply Subtype.ext
  simpa [AddCircle.toCircle_apply_mk, Real.fourierChar_apply'] using hphase

theorem sum_phase_Ioc (t : ℝ) (ht : (t : UnitAddCircle) ≠ 0)
    (m0 N : ℕ) :
    (∑ n ∈ Finset.Ioc m0 (m0 + N),
      (Real.fourierChar ((n : ℝ) * t) : ℂ)) =
      (Real.fourierChar (((m0 : ℝ) + 1) * t) : ℂ) *
        ((1 - (Real.fourierChar ((N : ℝ) * t) : ℂ)) / (1 - (Real.fourierChar t : ℂ))) := by
  have hpow (n : ℕ) :
      (Real.fourierChar ((n : ℝ) * t) : ℂ) = (Real.fourierChar t : ℂ) ^ n := by
    simpa only [nsmul_eq_mul, Circle.coe_pow] using
      congrArg (fun z : Circle ↦ (z : ℂ))
        (AddChar.map_nsmul_eq_pow Real.fourierChar n t)
  have hstart :
      (Real.fourierChar (((m0 : ℝ) + 1) * t) : ℂ) =
        (Real.fourierChar t : ℂ) ^ (m0 + 1) := by
    simpa only [Nat.cast_add, Nat.cast_one] using hpow (m0 + 1)
  simp_rw [hpow, hstart]
  rw [← Finset.Ico_add_one_add_one_eq_Ioc m0 (m0 + N),
    geom_sum_Ico' (phase_ne_one_of_unitAddCircle_ne_zero t ht) (by omega),
    show m0 + N + 1 = (m0 + 1) + N by omega,
    pow_add (Real.fourierChar t : ℂ) (m0 + 1) N]
  ring

theorem phase_one_half_split (a t : ℝ) :
    (Real.fourierChar ((a + 1) * t) : ℂ) =
      (Real.fourierChar ((a + 1 / 2) * t) : ℂ) * (Real.fourierChar (t / 2) : ℂ) := by
  rw [show (a + 1) * t = (a + 1 / 2) * t + t / 2 by ring,
    AddChar.map_add_eq_mul, Circle.coe_mul]

theorem half_phase_ratio {H Z s : ℂ}
    (hden : (1 - Z) * Complex.I = 2 * H * s)
    (hZ : Z ≠ 1) (hs : s ≠ 0) :
    H * (1 - Z)⁻¹ = (Complex.I / 2) * s⁻¹ := by
  field_simp [sub_ne_zero.mpr hZ.symm, hs]
  linear_combination -hden

theorem sum_unitAddCircleAddChar_Ioc_eq_cosecant
    (t : ℝ) (ht : (t : UnitAddCircle) ≠ 0) (m0 N : ℕ) :
    (∑ n ∈ Finset.Ioc m0 (m0 + N),
      unitAddCircleAddChar (n • (t : UnitAddCircle))) =
      Complex.I / 2 *
        (Complex.exp (2 * Real.pi * Complex.I *
          (((m0 : ℝ) + 1 / 2) * t)) -
         Complex.exp (2 * Real.pi * Complex.I *
          ((((m0 + N : ℕ) : ℝ) + 1 / 2) * t))) *
        (((Real.sin (Real.pi * t))⁻¹ : ℝ) : ℂ) := by
  have hchar (n : ℕ) :
      unitAddCircleAddChar (n • (t : UnitAddCircle)) =
        (Real.fourierChar ((n : ℝ) * t) : ℂ) := by
    rw [← AddCircle.coe_nsmul, nsmul_eq_mul]
    change (AddCircle.toCircle (((n : ℝ) * t : ℝ) : UnitAddCircle) : ℂ) = _
    rw [AddCircle.toCircle_apply_mk, Real.fourierChar_apply']
    simp only [div_one]
  have hexp (x : ℝ) :
      (Real.fourierChar x : ℂ) = Complex.exp (2 * Real.pi * Complex.I * x) := by
    rw [Real.fourierChar_apply]
    congr 1
    push_cast
    ring
  simp_rw [hchar]
  rw [sum_phase_Ioc t ht m0 N]
  have hstart := phase_one_half_split (m0 : ℝ) t
  have hend :
      (Real.fourierChar (((m0 : ℝ) + 1) * t) : ℂ) *
          (Real.fourierChar ((N : ℝ) * t) : ℂ) =
        (Real.fourierChar ((((m0 + N : ℕ) : ℝ) + 1 / 2) * t) : ℂ) *
          (Real.fourierChar (t / 2) : ℂ) := by
    rw [← Circle.coe_mul, ← AddChar.map_add_eq_mul,
      show ((m0 : ℝ) + 1) * t + (N : ℝ) * t =
        (((m0 : ℝ) + (N : ℝ)) + 1) * t by ring]
    simpa only [Nat.cast_add] using phase_one_half_split ((m0 : ℝ) + (N : ℝ)) t
  have hnum :
      (Real.fourierChar (((m0 : ℝ) + 1) * t) : ℂ) *
          (1 - (Real.fourierChar ((N : ℝ) * t) : ℂ)) =
        ((Real.fourierChar (((m0 : ℝ) + 1 / 2) * t) : ℂ) -
          (Real.fourierChar ((((m0 + N : ℕ) : ℝ) + 1 / 2) * t) : ℂ)) *
            (Real.fourierChar (t / 2) : ℂ) := by
    linear_combination hstart - hend
  have hratio :
      (Real.fourierChar (t / 2) : ℂ) * (1 - (Real.fourierChar t : ℂ))⁻¹ =
        (Complex.I / 2) * (Real.sin (Real.pi * t) : ℂ)⁻¹ :=
    half_phase_ratio (phase_half_denominator t)
      (phase_ne_one_of_unitAddCircle_ne_zero t ht)
      (Complex.ofReal_ne_zero.mpr
        (sin_pi_mul_ne_zero_of_unitAddCircle_ne_zero t ht))
  calc
    (Real.fourierChar (((m0 : ℝ) + 1) * t) : ℂ) *
        ((1 - (Real.fourierChar ((N : ℝ) * t) : ℂ)) /
          (1 - (Real.fourierChar t : ℂ))) =
        ((Real.fourierChar (((m0 : ℝ) + 1 / 2) * t) : ℂ) -
          (Real.fourierChar ((((m0 + N : ℕ) : ℝ) + 1 / 2) * t) : ℂ)) *
          ((Real.fourierChar (t / 2) : ℂ) *
            (1 - (Real.fourierChar t : ℂ))⁻¹) := by
      rw [div_eq_mul_inv, ← mul_assoc, hnum, mul_assoc]
    _ = (Complex.I / 2) *
        ((Real.fourierChar (((m0 : ℝ) + 1 / 2) * t) : ℂ) -
          (Real.fourierChar ((((m0 + N : ℕ) : ℝ) + 1 / 2) * t) : ℂ)) *
          (Real.sin (Real.pi * t) : ℂ)⁻¹ := by
      rw [hratio]
      ring
    _ = _ := by simp [hexp]

section
open scoped ComplexConjugate

theorem sum_phase_norm_sq_expand
    {ι : Type*} [Fintype ι]
    (S : Finset ℕ) (y : ι → ℝ) (v : ι → ℂ) :
    (((∑ n ∈ S, ‖∑ r, (Real.fourierChar ((n : ℝ) * y r) : ℂ) * v r‖ ^ 2 : ℝ) : ℂ)) =
      ∑ r, ∑ s,
        v r * star (v s) *
          ∑ n ∈ S, (Real.fourierChar ((n : ℝ) * (y r - y s)) : ℂ) := by
  calc
    (((∑ n ∈ S, ‖∑ r, (Real.fourierChar ((n : ℝ) * y r) : ℂ) * v r‖ ^ 2 :
        ℝ) : ℂ)) =
        ∑ n ∈ S,
          (∑ r, (Real.fourierChar ((n : ℝ) * y r) : ℂ) * v r) *
            star (∑ s, (Real.fourierChar ((n : ℝ) * y s) : ℂ) * v s) := by
      simp only [Complex.ofReal_sum, Complex.star_def, Complex.mul_conj,
        Complex.normSq_eq_norm_sq]
    _ = ∑ n ∈ S, ∑ r, ∑ s,
          ((Real.fourierChar ((n : ℝ) * y r) : ℂ) * v r) *
            star ((Real.fourierChar ((n : ℝ) * y s) : ℂ) * v s) := by
      simp only [Complex.star_def, map_sum, Finset.sum_mul_sum]
    _ = ∑ r, ∑ s,
          v r * star (v s) *
            ∑ n ∈ S, (Real.fourierChar ((n : ℝ) * (y r - y s)) : ℂ) := by
      rw [Finset.sum_comm]
      apply Finset.sum_congr rfl
      intro r _
      rw [Finset.sum_comm]
      apply Finset.sum_congr rfl
      intro s _
      rw [Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro n _
      simp only [sub_eq_add_neg, mul_add, mul_neg, AddChar.map_add_eq_mul,
        Circle.coe_mul, star_mul', Circle.star_addChar]
      ring

theorem sum_phase_norm_sq_eq_diag_add_offDiagonal
    {ι : Type*} [Fintype ι] [DecidableEq ι]
    (S : Finset ℕ) (y : ι → ℝ) (v : ι → ℂ) :
    (((∑ n ∈ S, ‖∑ r, (Real.fourierChar ((n : ℝ) * y r) : ℂ) * v r‖ ^ 2 : ℝ) : ℂ)) =
      ((S.card : ℝ) * ∑ r, ‖v r‖ ^ 2 : ℝ) +
        ∑ r, ∑ s ∈ Finset.univ.erase r,
          v r * star (v s) *
            ∑ n ∈ S, (Real.fourierChar ((n : ℝ) * (y r - y s)) : ℂ) := by
  rw [sum_phase_norm_sq_expand S y v]
  calc
    (∑ r, ∑ s,
        v r * star (v s) *
          ∑ n ∈ S, (Real.fourierChar ((n : ℝ) * (y r - y s)) : ℂ)) =
        ∑ r, (v r * star (v r) *
            ∑ n ∈ S, (Real.fourierChar ((n : ℝ) * (y r - y r)) : ℂ) +
          ∑ s ∈ Finset.univ.erase r,
            v r * star (v s) *
              ∑ n ∈ S, (Real.fourierChar ((n : ℝ) * (y r - y s)) : ℂ)) := by
      apply Finset.sum_congr rfl
      intro r _
      exact (Finset.add_sum_erase Finset.univ
        (fun s => v r * star (v s) *
          ∑ n ∈ S, (Real.fourierChar ((n : ℝ) * (y r - y s)) : ℂ))
        (Finset.mem_univ r)).symm
    _ = ∑ r, (((S.card : ℝ) * ‖v r‖ ^ 2 : ℝ) : ℂ) +
          ∑ r, ∑ s ∈ Finset.univ.erase r,
            v r * star (v s) *
              ∑ n ∈ S, (Real.fourierChar ((n : ℝ) * (y r - y s)) : ℂ) := by
      rw [Finset.sum_add_distrib]
      apply congrArg (fun z : ℂ => z + _)
      apply Finset.sum_congr rfl
      intro r _
      simp only [sub_self, mul_zero, AddChar.map_zero_eq_one, Circle.coe_one,
        Finset.sum_const, nsmul_one]
      simp only [Complex.star_def, RCLike.mul_conj]
      push_cast
      exact mul_comm _ _
    _ = (((S.card : ℝ) * ∑ r, ‖v r‖ ^ 2 : ℝ) : ℂ) +
          ∑ r, ∑ s ∈ Finset.univ.erase r,
            v r * star (v s) *
              ∑ n ∈ S, (Real.fourierChar ((n : ℝ) * (y r - y s)) : ℂ) := by
      congr 1
      push_cast
      rw [Finset.mul_sum]

theorem sum_phase_Ioc_eq_cosecant
    (t : ℝ) (ht : (t : UnitAddCircle) ≠ 0) (m0 N : ℕ) :
    (∑ n ∈ Finset.Ioc m0 (m0 + N), (Real.fourierChar ((n : ℝ) * t) : ℂ)) =
      Complex.I / 2 *
        ((Real.fourierChar (((m0 : ℝ) + 1 / 2) * t) : ℂ) -
          (Real.fourierChar ((((m0 + N : ℕ) : ℝ) + 1 / 2) * t) : ℂ)) *
        (((Real.sin (Real.pi * t))⁻¹ : ℝ) : ℂ) := by
  have hchar (n : ℕ) :
      unitAddCircleAddChar (n • (t : UnitAddCircle)) =
        (Real.fourierChar ((n : ℝ) * t) : ℂ) := by
    rw [← AddCircle.coe_nsmul, nsmul_eq_mul]
    change (AddCircle.toCircle (((n : ℝ) * t : ℝ) : UnitAddCircle) : ℂ) = _
    rw [AddCircle.toCircle_apply_mk, Real.fourierChar_apply']
    simp only [div_one]
  have hexp (a : ℝ) :
      Complex.exp (2 * (Real.pi : ℂ) * Complex.I *
        (((a : ℂ) + 1 / 2) * (t : ℂ))) =
          (Real.fourierChar ((a + 1 / 2) * t) : ℂ) := by
    rw [Real.fourierChar_apply]
    congr 1
    push_cast
    ring
  simpa only [hchar, hexp] using
    sum_unitAddCircleAddChar_Ioc_eq_cosecant t ht m0 N

theorem offDiagonal_eq_endpoint_forms
    {ι : Type*} [Fintype ι] [DecidableEq ι]
    (y : ι → ℝ) (v : ι → ℂ)
    (hneq : ∀ r s, r ≠ s →
      ((y r - y s : ℝ) : UnitAddCircle) ≠ 0)
    (m0 N : ℕ) :
    (∑ r, ∑ s ∈ Finset.univ.erase r,
      v r * star (v s) *
        ∑ n ∈ Finset.Ioc m0 (m0 + N),
          (Real.fourierChar ((n : ℝ) * (y r - y s)) : ℂ)) =
      Complex.I / 2 *
        (cosecantBilinearForm y
            (fun r => v r * (Real.fourierChar (((m0 : ℝ) + 1 / 2) * y r) : ℂ)) -
          cosecantBilinearForm y
            (fun r => v r *
              (Real.fourierChar ((((m0 + N : ℕ) : ℝ) + 1 / 2) * y r) : ℂ))) := by
  rw [cosecantBilinearForm, cosecantBilinearForm]
  rw [← Finset.sum_sub_distrib, Finset.mul_sum]
  apply Finset.sum_congr rfl
  intro r _
  rw [← Finset.sum_sub_distrib, Finset.mul_sum]
  apply Finset.sum_congr rfl
  intro s hs
  have hrs : r ≠ s := Ne.symm (Finset.ne_of_mem_erase hs)
  rw [sum_phase_Ioc_eq_cosecant (y r - y s) (hneq r s hrs)]
  simp only [sub_eq_add_neg, mul_add, mul_neg, AddChar.map_add_eq_mul,
    Circle.coe_mul, star_mul', Circle.star_addChar]
  ring

theorem norm_offDiagonal_le
    {ι : Type*} [Fintype ι] [DecidableEq ι]
    (y : ι → ℝ) {δ : ℝ} (hδ : 0 < δ)
    (hsep : ∀ r s, r ≠ s →
      δ ≤ dist (y r : UnitAddCircle) (y s : UnitAddCircle))
    (v : ι → ℂ) (m0 N : ℕ) :
    ‖∑ r, ∑ s ∈ Finset.univ.erase r,
      v r * star (v s) *
        ∑ n ∈ Finset.Ioc m0 (m0 + N),
          (Real.fourierChar ((n : ℝ) * (y r - y s)) : ℂ)‖ ≤
      δ⁻¹ * ∑ r, ‖v r‖ ^ 2 := by
  have hneq : ∀ r s, r ≠ s →
      ((y r - y s : ℝ) : UnitAddCircle) ≠ 0 := by
    intro r s hrs
    rw [AddCircle.coe_sub]
    exact sub_ne_zero.mpr (dist_pos.mp (hδ.trans_le (hsep r s hrs)))
  rw [offDiagonal_eq_endpoint_forms y v hneq m0 N]
  let u₀ : ι → ℂ :=
    fun r => v r * (Real.fourierChar (((m0 : ℝ) + 1 / 2) * y r) : ℂ)
  let u₁ : ι → ℂ :=
    fun r => v r * (Real.fourierChar ((((m0 + N : ℕ) : ℝ) + 1 / 2) * y r) : ℂ)
  have h₀ := norm_cosecantBilinearForm_le y hδ hsep u₀
  have h₁ := norm_cosecantBilinearForm_le y hδ hsep u₁
  simp only [u₀, norm_mul, Circle.norm_coe, mul_one] at h₀
  simp only [u₁, norm_mul, Circle.norm_coe, mul_one] at h₁
  calc
    ‖Complex.I / 2 *
        (cosecantBilinearForm y u₀ - cosecantBilinearForm y u₁)‖ =
        (1 / 2 : ℝ) *
          ‖cosecantBilinearForm y u₀ - cosecantBilinearForm y u₁‖ := by
      rw [norm_mul, norm_div, Complex.norm_I]
      norm_num
    _ ≤ (1 / 2 : ℝ) *
        (‖cosecantBilinearForm y u₀‖ + ‖cosecantBilinearForm y u₁‖) :=
      mul_le_mul_of_nonneg_left (norm_sub_le _ _) (by norm_num)
    _ ≤ (1 / 2 : ℝ) *
        (δ⁻¹ * ∑ r, ‖v r‖ ^ 2 + δ⁻¹ * ∑ r, ‖v r‖ ^ 2) :=
      mul_le_mul_of_nonneg_left (add_le_add h₀ h₁) (by norm_num)
    _ = δ⁻¹ * ∑ r, ‖v r‖ ^ 2 := by ring

theorem sum_phase_norm_sq_Ioc_le
    {ι : Type*} [Fintype ι]
    (y : ι → ℝ) {δ : ℝ} (hδ : 0 < δ)
    (hsep : ∀ r s, r ≠ s →
      δ ≤ dist (y r : UnitAddCircle) (y s : UnitAddCircle))
    (m0 N : ℕ) (v : ι → ℂ) :
    (∑ n ∈ Finset.Ioc m0 (m0 + N),
      ‖∑ r, (Real.fourierChar ((n : ℝ) * y r) : ℂ) * v r‖ ^ 2) ≤
      ((N : ℝ) + δ⁻¹) * ∑ r, ‖v r‖ ^ 2 := by
  classical
  let S : Finset ℕ := Finset.Ioc m0 (m0 + N)
  let E : ℝ := ∑ r, ‖v r‖ ^ 2
  let O : ℂ := ∑ r, ∑ s ∈ Finset.univ.erase r,
    v r * star (v s) *
      ∑ n ∈ S, (Real.fourierChar ((n : ℝ) * (y r - y s)) : ℂ)
  have hre' :
      (∑ n ∈ S, ‖∑ r, (Real.fourierChar ((n : ℝ) * y r) : ℂ) * v r‖ ^ 2) =
        (S.card : ℝ) * E + O.re := by
    simpa only [Complex.add_re, Complex.ofReal_re] using
      congrArg Complex.re (sum_phase_norm_sq_eq_diag_add_offDiagonal S y v)
  have hcard : (S.card : ℝ) = N := by simp [S]
  have hO : ‖O‖ ≤ δ⁻¹ * E := norm_offDiagonal_le y hδ hsep v m0 N
  calc
    (∑ n ∈ Finset.Ioc m0 (m0 + N),
        ‖∑ r, (Real.fourierChar ((n : ℝ) * y r) : ℂ) * v r‖ ^ 2) =
        (N : ℝ) * E + O.re := by rw [hre', hcard]
    _ ≤ (N : ℝ) * E + δ⁻¹ * E :=
      add_le_add_right ((Complex.re_le_norm O).trans hO) _
    _ = ((N : ℝ) + δ⁻¹) * ∑ r, ‖v r‖ ^ 2 := by
      dsimp only [E]
      ring

theorem sum_norm_sq_unitAddCircleAddChar_Ioc_le
    {ι : Type*} [Fintype ι]
    (x : ι → UnitAddCircle) {δ : ℝ} (hδ : 0 < δ)
    (hsep : ∀ r s, r ≠ s → δ ≤ dist (x r) (x s))
    (m0 N : ℕ) (c : ℕ → ℂ) :
    (∑ r, ‖∑ n ∈ Finset.Ioc m0 (m0 + N),
      c n * unitAddCircleAddChar (n • x r)‖ ^ 2) ≤
      ((N : ℝ) + δ⁻¹) *
        ∑ n ∈ Finset.Ioc m0 (m0 + N), ‖c n‖ ^ 2 := by
  classical
  let S : Finset ℕ := Finset.Ioc m0 (m0 + N)
  let y : ι → ℝ := fun r => AddCircle.equivIco 1 (0 : ℝ) (x r)
  let C : ι → {n : ℕ // n ∈ S} → ℂ :=
    fun r n => unitAddCircleAddChar (n.1 • x r)
  let w : {n : ℕ // n ∈ S} → ℂ := fun n => c n.1
  have hchar (r : ι) (n : ℕ) :
      unitAddCircleAddChar (n • x r) = (Real.fourierChar ((n : ℝ) * y r) : ℂ) := by
    calc
      _ = unitAddCircleAddChar (n • (y r : UnitAddCircle)) := by
        rw [show (y r : UnitAddCircle) = x r from AddCircle.coe_equivIco]
      _ = _ := by
        rw [← AddCircle.coe_nsmul, nsmul_eq_mul]
        change (AddCircle.toCircle (((n : ℝ) * y r : ℝ) : UnitAddCircle) : ℂ) = _
        rw [AddCircle.toCircle_apply_mk, Real.fourierChar_apply']
        simp only [div_one]
  have hsep' : ∀ r s, r ≠ s →
      δ ≤ dist (y r : UnitAddCircle) (y s : UnitAddCircle) := by
    intro r s hrs
    simpa only [y, AddCircle.coe_equivIco] using hsep r s hrs
  have hA : 0 ≤ (N : ℝ) + δ⁻¹ :=
    add_nonneg (Nat.cast_nonneg N) (inv_nonneg.mpr hδ.le)
  have hdual : ∀ v : ι → ℂ,
      (∑ n : {n : ℕ // n ∈ S}, ‖∑ r, C r n * v r‖ ^ 2) ≤
        ((N : ℝ) + δ⁻¹) * ∑ r, ‖v r‖ ^ 2 := by
    intro v
    dsimp only [C]
    rw [Finset.sum_coe_sort S
      (fun n : ℕ => ‖∑ r, unitAddCircleAddChar (n • x r) * v r‖ ^ 2)]
    simpa only [S, hchar] using
      sum_phase_norm_sq_Ioc_le y hδ hsep' m0 N v
  have htranspose := finite_transpose_l2_bound C hA hdual w
  dsimp only [C, w] at htranspose
  have hinner (r : ι) :
      (∑ n : {n : ℕ // n ∈ S},
        unitAddCircleAddChar (n.1 • x r) * c n.1) =
        ∑ n ∈ S, unitAddCircleAddChar (n • x r) * c n :=
    Finset.sum_coe_sort S
      (fun n : ℕ => unitAddCircleAddChar (n • x r) * c n)
  simp_rw [hinner] at htranspose
  rw [Finset.sum_coe_sort S (fun n : ℕ => ‖c n‖ ^ 2)] at htranspose
  simpa only [S, mul_comm] using htranspose

end

theorem sum_norm_sq_reducedFraction_stdAddChar_Ioc_le
    (Q m0 N : ℕ) (c : ℕ → ℂ) :
    (∑ z : reducedFractionIndices Q,
      ‖∑ n ∈ Finset.Ioc m0 (m0 + N),
        c n * ZMod.stdAddChar
          ((z.2 : ZMod z.1.1) * (n : ZMod z.1.1))‖ ^ 2) ≤
      ((N : ℝ) + (Q : ℝ) ^ 2) *
        ∑ n ∈ Finset.Ioc m0 (m0 + N), ‖c n‖ ^ 2 := by
  classical
  by_cases hQ : Q = 0
  · subst Q
    have hempty : (Finset.univ : Finset (reducedFractionIndices 0)) = ∅ := by
      apply Finset.eq_empty_iff_forall_notMem.mpr
      intro z _hz
      have hq := z.1.2
      simp only [Finset.mem_Icc] at hq
      omega
    rw [hempty, Finset.sum_empty]
    positivity
  · have hQpos : (0 : ℝ) < Q := by
      exact_mod_cast Nat.pos_of_ne_zero hQ
    have hdelta : (0 : ℝ) < 1 / (Q : ℝ) ^ 2 :=
      div_pos zero_lt_one (sq_pos_of_pos hQpos)
    have hlarge := sum_norm_sq_unitAddCircleAddChar_Ioc_le
      (x := reducedFractionPoint)
      (δ := (1 : ℝ) / (Q : ℝ) ^ 2) hdelta
      (fun r s hrs => one_div_sq_le_dist_reducedFractionPoint hrs)
      m0 N c
    simp_rw [unitAddCircleAddChar_nsmul_reducedFractionPoint] at hlarge
    simpa only [inv_div, div_one] using hlarge

theorem sum_units_eq_sum_reduced
    (Q : ℕ) (f : reducedFractionIndices Q → ℝ) :
    (∑ q : positiveModuliUpTo Q, ∑ u : (ZMod q.1)ˣ, f ⟨q, u⟩) =
      ∑ z : reducedFractionIndices Q, f z := by
  convert! (Fintype.sum_sigma f).symm using 1
  congr 1; ext z; simp

theorem sum_weighted_norm_sq_primitiveTwists_Ioc_le
    (Q m0 N : ℕ) (c : ℕ → ℂ) :
    (∑ q ∈ Finset.Ioc 0 Q,
      (q : ℝ) / (Nat.totient q : ℝ) *
        ∑ psi : primitiveCharacters q,
          ‖∑ n ∈ Finset.Ioc m0 (m0 + N),
            c n * psi.1 n‖ ^ 2) ≤
      ((N : ℝ) + (Q : ℝ) ^ 2) *
        ∑ n ∈ Finset.Ioc m0 (m0 + N), ‖c n‖ ^ 2 := by
  classical
  have hfixed :
      (∑ q : positiveModuliUpTo Q,
        (q.1 : ℝ) / (Nat.totient q.1 : ℝ) *
          ∑ psi : primitiveCharacters q.1,
            ‖∑ n ∈ Finset.Ioc m0 (m0 + N),
              c n * psi.1 n‖ ^ 2) ≤
        ∑ q : positiveModuliUpTo Q,
          ∑ u : (ZMod q.1)ˣ,
            ‖∑ n ∈ Finset.Ioc m0 (m0 + N),
              c n * ZMod.stdAddChar
                ((u : ZMod q.1) * (n : ZMod q.1))‖ ^ 2 := by
    apply Finset.sum_le_sum
    intro q _hq
    exact weighted_sum_norm_sq_primitiveTwists_le_unitAdditiveSums
      (q := q.1) (Finset.Ioc m0 (m0 + N)) c
  have hlarge := sum_norm_sq_reducedFraction_stdAddChar_Ioc_le Q m0 N c
  rw [← sum_units_eq_sum_reduced] at hlarge
  rw [Finset.sum_coe_sort (Finset.Icc 1 Q)
    (fun q => (q : ℝ) / (Nat.totient q : ℝ) *
      ∑ psi : primitiveCharacters q,
        ‖∑ n ∈ Finset.Ioc m0 (m0 + N), c n * psi.1 n‖ ^ 2)] at hfixed
  have hIcc : Finset.Icc 1 Q = Finset.Ioc 0 Q := by
    simpa only [Nat.zero_add] using Finset.Icc_add_one_left_eq_Ioc (0 : ℕ) Q
  simpa only [hIcc] using hfixed.trans hlarge

theorem sum_weighted_norm_sq_primitiveTwists_subset_Ioc_le
    (Q m0 N : ℕ) (s : Finset ℕ)
    (hs : s ⊆ Finset.Ioc m0 (m0 + N)) (c : ℕ → ℂ) :
    (∑ q ∈ Finset.Ioc 0 Q,
      (q : ℝ) / (Nat.totient q : ℝ) *
        ∑ psi : primitiveCharacters q,
          ‖∑ n ∈ s, c n * psi.1 n‖ ^ 2) ≤
      ((N : ℝ) + (Q : ℝ) ^ 2) * ∑ n ∈ s, ‖c n‖ ^ 2 := by
  have hlarge := sum_weighted_norm_sq_primitiveTwists_Ioc_le Q m0 N
    (fun n => if n ∈ s then c n else 0)
  simp only [ite_mul, zero_mul, Finset.sum_ite_mem,
    Finset.inter_eq_right.mpr hs] at hlarge
  simpa [apply_ite, Finset.inter_eq_right.mpr hs] using hlarge

theorem sum_weighted_norm_bilinear_primitiveTwists_subset_Ioc_le
    (Q m0 M n0 N : ℕ) (sm sn : Finset ℕ)
    (hm : sm ⊆ Finset.Ioc m0 (m0 + M))
    (hn : sn ⊆ Finset.Ioc n0 (n0 + N))
    (a b : ℕ → ℂ) :
    (∑ q ∈ Finset.Ioc 0 Q,
      (q : ℝ) / (q.totient : ℝ) *
        ∑ psi : primitiveCharacters q,
          ‖∑ m ∈ sm, ∑ n ∈ sn,
            a m * b n * psi.1 (m * n)‖) ≤
      Real.sqrt ((M : ℝ) + (Q : ℝ) ^ 2) *
        Real.sqrt ((N : ℝ) + (Q : ℝ) ^ 2) *
        Real.sqrt (∑ m ∈ sm, ‖a m‖ ^ 2) *
        Real.sqrt (∑ n ∈ sn, ‖b n‖ ^ 2) := by
  let A : (q : ℕ) → primitiveCharacters q → ℂ := fun q psi =>
    ∑ m ∈ sm, a m * psi.1 m
  let B : (q : ℕ) → primitiveCharacters q → ℂ := fun q psi =>
    ∑ n ∈ sn, b n * psi.1 n
  have hcauchy := sum_weighted_norm_mul_primitiveTwists_le Q A B
  have hA := sum_weighted_norm_sq_primitiveTwists_subset_Ioc_le
    Q m0 M sm hm a
  have hB := sum_weighted_norm_sq_primitiveTwists_subset_Ioc_le
    Q n0 N sn hn b
  calc
    (∑ q ∈ Finset.Ioc 0 Q,
        (q : ℝ) / (q.totient : ℝ) *
          ∑ psi : primitiveCharacters q,
            ‖∑ m ∈ sm, ∑ n ∈ sn,
              a m * b n * psi.1 (m * n)‖) =
        ∑ q ∈ Finset.Ioc 0 Q,
          (q : ℝ) / (q.totient : ℝ) *
            ∑ psi : primitiveCharacters q, ‖A q psi * B q psi‖ := by
      simp only [A, B, Finset.sum_mul_sum, map_mul, mul_mul_mul_comm]
    _ ≤ Real.sqrt
          (∑ q ∈ Finset.Ioc 0 Q,
            (q : ℝ) / (q.totient : ℝ) *
              ∑ psi : primitiveCharacters q, ‖A q psi‖ ^ 2) *
        Real.sqrt
          (∑ q ∈ Finset.Ioc 0 Q,
            (q : ℝ) / (q.totient : ℝ) *
              ∑ psi : primitiveCharacters q, ‖B q psi‖ ^ 2) := hcauchy
    _ ≤ Real.sqrt
          (((M : ℝ) + (Q : ℝ) ^ 2) * ∑ m ∈ sm, ‖a m‖ ^ 2) *
        Real.sqrt
          (((N : ℝ) + (Q : ℝ) ^ 2) * ∑ n ∈ sn, ‖b n‖ ^ 2) :=
      mul_le_mul (Real.sqrt_le_sqrt hA) (Real.sqrt_le_sqrt hB)
        (Real.sqrt_nonneg _) (Real.sqrt_nonneg _)
    _ = Real.sqrt ((M : ℝ) + (Q : ℝ) ^ 2) *
        Real.sqrt ((N : ℝ) + (Q : ℝ) ^ 2) *
        Real.sqrt (∑ m ∈ sm, ‖a m‖ ^ 2) *
        Real.sqrt (∑ n ∈ sn, ‖b n‖ ^ 2) := by
      rw [Real.sqrt_mul (by positivity : 0 ≤ (M : ℝ) + (Q : ℝ) ^ 2),
        Real.sqrt_mul (by positivity : 0 ≤ (N : ℝ) + (Q : ℝ) ^ 2)]
      ring

section
open scoped ContDiff

theorem sum_divisor_weighted_nonnegative_sq_le
    (S : Finset ℕ) (J : ℕ) (v : ℕ → ℝ)
    (hv : ∀ q ∈ S, 0 ≤ v q) :
    (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * v q) ^ 2 ≤
      (∑ q ∈ S, v q) *
        ∑ q ∈ S, (q.divisors.card : ℝ) ^ (2 * J) * v q := by
  apply Finset.sum_sq_le_sum_mul_sum_of_sq_le_mul S hv
    (fun q hq => mul_nonneg (pow_nonneg (Nat.cast_nonneg _) _) (hv q hq))
  intro q hq
  have hp : (q.divisors.card : ℝ) ^ (2 * J) =
      ((q.divisors.card : ℝ) ^ J) ^ 2 := by
    rw [Nat.mul_comm 2 J, pow_mul]
  rw [hp]
  nlinarith only [sq_nonneg ((q.divisors.card : ℝ) ^ J * v q)]

theorem sum_divisor_weighted_log_saving_of_two_bounds
    (S : Finset ℕ) (J : ℕ) (v : ℕ → ℝ)
    (hv : ∀ q ∈ S, 0 ≤ v q)
    (x L A K0 K1 : ℝ) (P : ℕ)
    (hx : 0 ≤ x) (hL : 0 < L) (hK0 : 0 < K0) (hK1 : 0 < K1)
    (hsmall : (∑ q ∈ S, v q) ≤ K0 * x / L ^ (2 * A + (P : ℝ)))
    (hlarge : (∑ q ∈ S, (q.divisors.card : ℝ) ^ (2 * J) * v q) ≤
      K1 * x * L ^ P) :
    (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * v q) ≤
      (K0 + K1) * x / L ^ A := by
  have hCS := sum_divisor_weighted_nonnegative_sq_le S J v hv
  have hlarge0 : 0 ≤ ∑ q ∈ S, (q.divisors.card : ℝ) ^ (2 * J) * v q :=
    Finset.sum_nonneg fun q hq =>
      mul_nonneg (pow_nonneg (Nat.cast_nonneg _) _) (hv q hq)
  have hsmallBound0 : 0 ≤ K0 * x / L ^ (2 * A + (P : ℝ)) := by positivity
  have hprod := mul_le_mul hsmall hlarge hlarge0 hsmallBound0
  have hpow : L ^ (2 * A + (P : ℝ)) = (L ^ A) ^ 2 * L ^ P := by
    rw [Real.rpow_add hL, Real.rpow_natCast]
    congr 1
    rw [show 2 * A = A * 2 by ring, Real.rpow_mul hL.le, Real.rpow_two]
  have hcancel :
      (K0 * x / L ^ (2 * A + (P : ℝ))) * (K1 * x * L ^ P) =
        (K0 * K1) * (x / L ^ A) ^ 2 := by
    rw [hpow]
    field_simp (disch := positivity)
  rw [hcancel] at hprod
  have hfactor : K0 * K1 ≤ (K0 + K1) ^ 2 := by
    nlinarith only [sq_nonneg K0, sq_nonneg K1, mul_pos hK0 hK1]
  have hsq :
      (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * v q) ^ 2 ≤
        ((K0 + K1) * x / L ^ A) ^ 2 := by
    calc
      _ ≤ (K0 * K1) * (x / L ^ A) ^ 2 := hCS.trans hprod
      _ ≤ (K0 + K1) ^ 2 * (x / L ^ A) ^ 2 :=
        mul_le_mul_of_nonneg_right hfactor (sq_nonneg _)
      _ = _ := by ring
  have hright : 0 ≤ (K0 + K1) * x / L ^ A := by positivity
  nlinarith only [hsq, hright]

open Classical in
theorem vonMangoldt_closedInterval_support_and_envelope
    (x : ℝ) (hx : Real.exp 1 ≤ x) :
    let Λx : ℕ →₀ ℂ :=
      ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)
    (∀ n ∈ Λx.support, 0 < n ∧ (n : ℝ) ≤ 2 * x) ∧
      (∀ n ∈ Λx.support, ‖Λx n‖ ≤ (1 + Real.log 2) * Real.log x) := by
  intro Λx
  let T := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
  have hlogx : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxpos).mpr hx
  have hlog2 : 0 ≤ Real.log (2 : ℝ) := Real.log_nonneg (by norm_num)
  have hvalue (n : ℕ) :
      Λx n = if n ∈ T then ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ) else 0 := by
    simp only [Λx, T, Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_ite_eq']
  have hmem (n : ℕ) (hn : n ∈ Λx.support) : n ∈ T := by
    by_contra h
    exact (Finsupp.mem_support_iff.mp hn) (by rw [hvalue, ite_eq_right h])
  have hsupport (n : ℕ) (hn : n ∈ Λx.support) :
      0 < n ∧ (n : ℝ) ≤ 2 * x := by
    have hi := Finset.mem_Icc.mp (hmem n hn)
    have hlo : x ≤ (n : ℝ) :=
      (Nat.le_ceil x).trans (Nat.cast_le.mpr hi.1)
    have hpos : 0 < (n : ℝ) := hxpos.trans_le hlo
    refine ⟨Nat.cast_pos.mp hpos, ?_⟩
    exact (Nat.cast_le.mpr hi.2).trans (Nat.floor_le (by positivity))
  refine ⟨hsupport, ?_⟩
  intro n hn
  rw [hvalue, ite_eq_left (hmem n hn)]
  have hnorm :
      ‖((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)‖ =
        ArithmeticFunction.vonMangoldt n := by
    simp only [Complex.norm_real, Real.norm_eq_abs,
      abs_of_nonneg ArithmeticFunction.vonMangoldt_nonneg]
  rw [hnorm]
  calc
    _ ≤ Real.log (n : ℝ) := ArithmeticFunction.vonMangoldt_le_log
    _ ≤ Real.log (2 * x) :=
      Real.log_le_log (Nat.cast_pos.mpr (hsupport n hn).1) (hsupport n hn).2
    _ = Real.log 2 + Real.log x := Real.log_mul (by norm_num) hxpos.ne'
    _ ≤ (1 + Real.log 2) * Real.log x := by nlinarith only [hlogx, hlog2]

theorem eventually_exp_neg_sqrt_sqrt_log_mul_rpow_le_rpow
    (A B c : ℝ) (hc : 0 < c) :
    ∀ᶠ x : ℝ in Filter.atTop,
      Real.exp (-c * Real.sqrt (Real.sqrt (Real.log x))) * (Real.log x) ^ B ≤
        (Real.log x) ^ (-A) := by
  have hscale : Filter.Tendsto (fun x : ℝ => Real.exp (Real.sqrt (Real.log x)))
      Filter.atTop Filter.atTop :=
    Real.tendsto_exp_atTop.comp (Real.tendsto_sqrt_atTop.comp Real.tendsto_log_atTop)
  have hdecay := hscale.eventually
    (eventually_exp_neg_sqrt_log_mul_rpow_le_rpow (2 * A) (2 * B) c hc)
  filter_upwards [hdecay, Filter.eventually_gt_atTop (1 : ℝ)] with x hx hx1
  have hL : 0 ≤ Real.log x := (Real.log_pos hx1).le
  have hpower (s : ℝ) : Real.sqrt (Real.log x) ^ (2 * s) = (Real.log x) ^ s := by
    simpa using (Real.rpow_div_two_eq_sqrt (2 * s) hL).symm
  simpa only [Real.log_exp, show -(2 * A) = 2 * (-A) by ring, hpower] using hx

theorem largest_prime_scale_logarithmic_comparison
    (x : ℝ) (hx : Real.exp 1 ≤ x) (X : ℕ)
    (hX : Real.exp (Real.sqrt (Real.log x)) ≤ (X : ℝ))
    (D c : ℝ) (hD : 0 < D) (hc : 0 < c) :
    (Real.log x) ^ D ≤ (Real.log (X : ℝ)) ^ (2 * D) ∧
      Real.exp (-c * Real.sqrt (Real.log (X : ℝ))) ≤
        Real.exp (-c * Real.sqrt (Real.sqrt (Real.log x))) := by
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le hx
  have hlogx : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hx
  have hX0 : 0 < (X : ℝ) :=
    (Real.exp_pos (Real.sqrt (Real.log x))).trans_le hX
  have hlog : Real.sqrt (Real.log x) ≤ Real.log (X : ℝ) :=
    (Real.le_log_iff_exp_le hX0).mpr hX
  constructor
  · have hpower : Real.sqrt (Real.log x) ^ (2 * D) = (Real.log x) ^ D := by
      simpa using (Real.rpow_div_two_eq_sqrt (2 * D) (by linarith : 0 ≤ Real.log x)).symm
    rw [← hpower]
    exact Real.rpow_le_rpow (Real.sqrt_nonneg _) hlog (by positivity)
  · apply Real.exp_le_exp.mpr
    exact mul_le_mul_of_nonpos_left (Real.sqrt_le_sqrt hlog) (neg_nonpos.mpr hc.le)

theorem eventually_largest_prime_scale_sw_loss_le
    (A B c : ℝ) (hc : 0 < c) :
    ∀ᶠ x : ℝ in Filter.atTop, ∀ X : ℕ,
      Real.exp (Real.sqrt (Real.log x)) ≤ (X : ℝ) →
      Real.exp (-c * Real.sqrt (Real.log (X : ℝ))) * (Real.log x) ^ B ≤
        (Real.log x) ^ (-A) := by
  filter_upwards [eventually_exp_neg_sqrt_sqrt_log_mul_rpow_le_rpow A B c hc,
    Filter.eventually_ge_atTop (Real.exp 1)] with x hdecay hx
  intro X hX
  have hcomparison := (largest_prime_scale_logarithmic_comparison x hx X hX
    1 c zero_lt_one hc).2
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le hx
  have hlogx : 0 ≤ Real.log x := by
    have := (Real.le_log_iff_exp_le hx0).mpr hx
    linarith
  exact (mul_le_mul_of_nonneg_right hcomparison (Real.rpow_nonneg hlogx B)).trans hdecay

/--
The natural representatives `0 ≤ a < q` of the reduced residue classes modulo `q`, selected by
coprimality with `q`.
-/
def coprimeResidues (q : ℕ) : Finset ℕ :=
  (Finset.range q).filter (Nat.Coprime · q)

theorem coprimeResidues_nonempty {q : ℕ} (hq : 0 < q) :
    (coprimeResidues q).Nonempty := by
  by_cases hq1 : q = 1
  · subst q
    simp [coprimeResidues]
  · have hq0 : q ≠ 0 := Nat.ne_of_gt hq
    have h1q : 1 < q :=
      Nat.one_lt_iff_ne_zero_and_ne_one.mpr ⟨hq0, hq1⟩
    refine ⟨1, ?_⟩
    simp [coprimeResidues, h1q]

/--
The natural-number dyadic block `2 ^ alpha < n ≤ 2 ^ (alpha + 1)`, with the lower endpoint
excluded and the upper endpoint included.
-/
def dyadicBlock (alpha : ℕ) : Finset ℕ :=
  Finset.Ioc (2 ^ alpha) (2 ^ (alpha + 1))

/--
The exponents from zero through `Nat.log 2 X`, inclusive, used to index the dyadic decomposition
up to the scale of `X`.
-/
def dyadicExponentRange (X : ℕ) : Finset ℕ :=
  Finset.range (Nat.log 2 X + 1)

theorem mem_dyadicBlock_iff_log_pred_eq
    {t alpha : ℕ} (ht : 2 ≤ t) :
    t ∈ dyadicBlock alpha ↔ Nat.log 2 (t - 1) = alpha := by
  rw [dyadicBlock, Finset.mem_Ioc]
  constructor
  · intro hblock
    apply Nat.log_eq_of_pow_le_of_lt_pow
    · omega
    · omega
  · intro hlog
    have htPred : t - 1 ≠ 0 := by omega
    have hlower := Nat.pow_log_le_self 2 htPred
    have hupper := Nat.lt_pow_succ_log_self (by omega : 1 < 2) (t - 1)
    rw [hlog] at hlower hupper
    constructor
    · omega
    · simpa only [Nat.succ_eq_add_one] using (show t ≤ 2 ^ alpha.succ by omega)

theorem sum_eq_sum_dyadicBlocks
    {A : Type*} [AddCommMonoid A] {X : ℕ}
    (s : Finset ℕ) (hs : ∀ t ∈ s, 2 ≤ t ∧ t ≤ X)
    (f : ℕ → A) :
    (∑ t ∈ s, f t) =
      ∑ alpha ∈ dyadicExponentRange X,
        ∑ t ∈ s.filter (fun t ↦ t ∈ dyadicBlock alpha), f t := by
  let exponent : ℕ → ℕ := fun t ↦ Nat.log 2 (t - 1)
  have hmaps : ∀ t ∈ s, exponent t ∈ dyadicExponentRange X := by
    intro t ht
    rw [dyadicExponentRange, Finset.mem_range]
    have htX := (hs t ht).2
    have hlog : Nat.log 2 (t - 1) ≤ Nat.log 2 X :=
      Nat.log_mono_right (by omega)
    exact Nat.lt_succ_of_le hlog
  have hfiber (alpha : ℕ) :
      s.filter (fun t ↦ t ∈ dyadicBlock alpha) =
        s.filter (fun t ↦ exponent t = alpha) := by
    ext t
    simp only [Finset.mem_filter]
    constructor
    · rintro ⟨ht, hblock⟩
      exact ⟨ht, (mem_dyadicBlock_iff_log_pred_eq (hs t ht).1).mp hblock⟩
    · rintro ⟨ht, hlog⟩
      exact ⟨ht, (mem_dyadicBlock_iff_log_pred_eq (hs t ht).1).mpr hlog⟩
  symm
  calc
    (∑ alpha ∈ dyadicExponentRange X,
        ∑ t ∈ s.filter (fun t ↦ t ∈ dyadicBlock alpha), f t) =
        ∑ alpha ∈ dyadicExponentRange X,
          ∑ t ∈ s.filter (fun t ↦ exponent t = alpha), f t := by
      apply Finset.sum_congr rfl
      intro alpha _halpha
      rw [hfiber]
    _ = ∑ t ∈ s, f t :=
      Finset.sum_fiberwise_of_maps_to hmaps f

theorem card_dyadicExponentRange_le_log
    {X : ℕ} (hX : 0 < X) :
    ((dyadicExponentRange X).card : ℝ) ≤
      Real.log (2 * (X : ℝ)) / Real.log 2 := by
  have hpowNat : 2 ^ (Nat.log 2 X + 1) ≤ 2 * X := by
    calc
      2 ^ (Nat.log 2 X + 1) = 2 ^ Nat.log 2 X * 2 := by rw [pow_succ]
      _ ≤ X * 2 := Nat.mul_le_mul_right 2 (Nat.pow_log_le_self 2 hX.ne')
      _ = 2 * X := Nat.mul_comm X 2
  have hpowReal :
      (2 : ℝ) ^ (Nat.log 2 X + 1) ≤ 2 * (X : ℝ) := by
    exact_mod_cast hpowNat
  have hlog := Real.log_le_log
    (pow_pos (by norm_num : (0 : ℝ) < 2) (Nat.log 2 X + 1)) hpowReal
  rw [Real.log_pow] at hlog
  rw [dyadicExponentRange, Finset.card_range]
  exact (le_div_iff₀ (Real.log_pos (by norm_num))).2 hlog

/--
The truncated Möbius divisor sum `∑ d ∣ k, d ≤ V, μ(d)` used as the second coefficient in
Vaughan's fourth term. The real cutoff is applied to positive natural divisors.
-/
noncomputable def vaughanFourthCoefficient (V : ℝ) (k : ℕ) : ℝ :=
  ∑ d ∈ k.divisors.filter (fun d : ℕ => (d : ℝ) ≤ V),
    ((ArithmeticFunction.moebius d : ℤ) : ℝ)

theorem sum_moebius_divisors_gcd
    {m P : ℕ} :
    (∑ d ∈ (m.gcd P).divisors,
      ((ArithmeticFunction.moebius d : ℤ) : ℝ)) =
      if Nat.Coprime m P then 1 else 0 := by
  change (∑ d ∈ (m.gcd P).divisors,
    (ArithmeticFunction.moebius : ArithmeticFunction ℝ) d) = _
  rw [← ArithmeticFunction.coe_mul_zeta_apply, ArithmeticFunction.coe_moebius_mul_coe_zeta]
  by_cases h : Nat.Coprime m P <;> simp [h]

theorem abs_sum_moebius_div_coprime_le_one (D N : ℕ) :
    |∑ n ∈ (Finset.Ioc 0 N).filter (fun n => Nat.Coprime n D),
      ((ArithmeticFunction.moebius n : ℤ) : ℝ) / (n : ℝ)| ≤ 1 := by
  classical
  by_cases hN : N = 0
  · subst N
    simp
  have hNPos : 0 < N := Nat.pos_of_ne_zero hN
  let S : Finset ℕ :=
    (Finset.Ioc 0 N).filter (fun n => Nat.Coprime n D)
  let P : ℕ := ∏ n ∈ S, n
  let A : Finset ℕ :=
    (Finset.Ioc 0 N).filter (fun m => Nat.Coprime m P)
  have hPCoprime : Nat.Coprime P D := by
    dsimp [P]
    apply Nat.Coprime.prod_left
    intro n hn
    exact (Finset.mem_filter.mp hn).2
  have hRestrictedDivisors (m : ℕ) (hm : m ∈ Finset.Ioc 0 N) :
      (m.gcd P).divisors =
        m.divisors.filter (fun n => Nat.Coprime n D) := by
    have hmPos : 0 < m := (Finset.mem_Ioc.mp hm).1
    have hGcdPos : 0 < m.gcd P := Nat.gcd_pos_of_pos_left P hmPos
    ext n
    simp only [Nat.mem_divisors, Finset.mem_filter]
    constructor
    · rintro ⟨hnGcd, -⟩
      have hnm : n ∣ m := hnGcd.trans (Nat.gcd_dvd_left m P)
      have hnP : n ∣ P := hnGcd.trans (Nat.gcd_dvd_right m P)
      exact ⟨⟨hnm, hmPos.ne'⟩, Nat.Coprime.of_dvd_left hnP hPCoprime⟩
    · rintro ⟨⟨hnm, -⟩, hnCoprime⟩
      have hnPos : 0 < n := Nat.pos_of_dvd_of_pos hnm hmPos
      have hnLeN : n ≤ N :=
        (Nat.le_of_dvd hmPos hnm).trans (Finset.mem_Ioc.mp hm).2
      have hnS : n ∈ S :=
        Finset.mem_filter.mpr
          ⟨Finset.mem_Ioc.mpr ⟨hnPos, hnLeN⟩, hnCoprime⟩
      have hnP : n ∣ P := by
        dsimp [P]
        exact Finset.dvd_prod_of_mem (fun k : ℕ => k) hnS
      exact ⟨Nat.dvd_gcd hnm hnP, hGcdPos.ne'⟩
  have hRangeDivisors (m : ℕ) (hm : m ∈ Finset.Ioc 0 N) :
      S.filter (fun n => n ∣ m) =
        m.divisors.filter (fun n => Nat.Coprime n D) := by
    have hmPos : 0 < m := (Finset.mem_Ioc.mp hm).1
    ext n
    simp only [Finset.mem_filter, Nat.mem_divisors]
    constructor
    · rintro ⟨hnS, hnm⟩
      exact ⟨⟨hnm, hmPos.ne'⟩, (Finset.mem_filter.mp hnS).2⟩
    · rintro ⟨⟨hnm, -⟩, hnCoprime⟩
      have hnPos : 0 < n := Nat.pos_of_dvd_of_pos hnm hmPos
      have hnLeN : n ≤ N :=
        (Nat.le_of_dvd hmPos hnm).trans (Finset.mem_Ioc.mp hm).2
      exact ⟨Finset.mem_filter.mpr
        ⟨Finset.mem_Ioc.mpr ⟨hnPos, hnLeN⟩, hnCoprime⟩, hnm⟩
  have hIndicator (m : ℕ) (hm : m ∈ Finset.Ioc 0 N) :
      (∑ n ∈ S, if n ∣ m then
          ((ArithmeticFunction.moebius n : ℤ) : ℝ) else 0) =
        if Nat.Coprime m P then 1 else 0 := by
    rw [← Finset.sum_filter, hRangeDivisors m hm, ← hRestrictedDivisors m hm]
    exact sum_moebius_divisors_gcd
  have hCardA :
      (A.card : ℝ) =
        ∑ n ∈ S, ((ArithmeticFunction.moebius n : ℤ) : ℝ) *
          ((N / n : ℕ) : ℝ) := by
    calc
      (A.card : ℝ) =
          ∑ m ∈ Finset.Ioc 0 N,
            if Nat.Coprime m P then (1 : ℝ) else 0 := by
        simp [A]
      _ = ∑ m ∈ Finset.Ioc 0 N, ∑ n ∈ S,
            if n ∣ m then
              ((ArithmeticFunction.moebius n : ℤ) : ℝ) else 0 := by
        apply Finset.sum_congr rfl
        intro m hm
        exact (hIndicator m hm).symm
      _ = ∑ n ∈ S, ∑ m ∈ Finset.Ioc 0 N,
            if n ∣ m then
              ((ArithmeticFunction.moebius n : ℤ) : ℝ) else 0 := by
        rw [Finset.sum_comm]
      _ = ∑ n ∈ S, ((ArithmeticFunction.moebius n : ℤ) : ℝ) *
            ((N / n : ℕ) : ℝ) := by
        apply Finset.sum_congr rfl
        intro n hn
        rw [← Finset.sum_filter, Finset.sum_const, nsmul_eq_mul,
          Nat.Ioc_filter_dvd_card_eq_div]
        ring
  have hDecomposition :
      (N : ℝ) * (∑ n ∈ S,
          ((ArithmeticFunction.moebius n : ℤ) : ℝ) / (n : ℝ)) =
        (A.card : ℝ) +
          ∑ n ∈ S, ((ArithmeticFunction.moebius n : ℤ) : ℝ) *
            (((N % n : ℕ) : ℝ) / (n : ℝ)) := by
    rw [hCardA, ← Finset.sum_add_distrib, Finset.mul_sum]
    refine Finset.sum_congr rfl fun n hn => ?_
    have hnReal : (n : ℝ) ≠ 0 := Nat.cast_ne_zero.mpr
      (Finset.mem_Ioc.mp (Finset.mem_filter.mp hn).1).1.ne'
    conv_lhs => rw [← Nat.div_add_mod N n]
    push_cast
    field_simp
  have hEraseSum :
      (∑ n ∈ S, ((ArithmeticFunction.moebius n : ℤ) : ℝ) *
          (((N % n : ℕ) : ℝ) / (n : ℝ))) =
        ∑ n ∈ S.erase 1, ((ArithmeticFunction.moebius n : ℤ) : ℝ) *
          (((N % n : ℕ) : ℝ) / (n : ℝ)) := by
    by_cases hOne : 1 ∈ S
    · rw [← Finset.sum_erase_add _ _ hOne]
      simp [Nat.mod_one]
    · rw [Finset.erase_eq_of_notMem hOne]
  have hRemainder :
      |∑ n ∈ S, ((ArithmeticFunction.moebius n : ℤ) : ℝ) *
          (((N % n : ℕ) : ℝ) / (n : ℝ))| ≤
        ((S.erase 1).card : ℝ) := by
    rw [hEraseSum]
    calc
      _ ≤ ∑ _n ∈ S.erase 1, (1 : ℝ) := by
        rw [← Real.norm_eq_abs]
        apply norm_sum_le_of_le
        intro n hn
        have hnPos : 0 < n :=
          (Finset.mem_Ioc.mp (Finset.mem_filter.mp (Finset.mem_of_mem_erase hn)).1).1
        rw [Real.norm_eq_abs, abs_mul,
          abs_of_nonneg (show 0 ≤ ((N % n : ℕ) : ℝ) / (n : ℝ) by positivity)]
        exact (mul_le_of_le_one_left (by positivity)
          (by exact_mod_cast ArithmeticFunction.abs_moebius_le_one (n := n))).trans
          ((div_le_one (by positivity)).2 (by exact_mod_cast (Nat.mod_lt N hnPos).le))
      _ = _ := by simp
  have hDisjoint : Disjoint A (S.erase 1) := by
    rw [Finset.disjoint_left]
    intro n hnA hnErase
    have hnS : n ∈ S := Finset.mem_of_mem_erase hnErase
    have hnDivP : n ∣ P := by
      dsimp [P]
      exact Finset.dvd_prod_of_mem (fun k : ℕ => k) hnS
    have hnCoprime : Nat.Coprime n P := (Finset.mem_filter.mp hnA).2
    have hnOne : n = 1 :=
      Nat.eq_one_of_dvd_coprimes hnCoprime (dvd_refl n) hnDivP
    exact (Finset.ne_of_mem_erase hnErase) hnOne
  have hASubset : A ⊆ Finset.Ioc 0 N := Finset.filter_subset _ _
  have hEraseSubset : S.erase 1 ⊆ Finset.Ioc 0 N :=
    (Finset.erase_subset _ _).trans (Finset.filter_subset _ _)
  have hCardNat : A.card + (S.erase 1).card ≤ N := by
    have hUnion := Finset.card_le_card
      (Finset.union_subset hASubset hEraseSubset)
    rw [Finset.card_union_of_disjoint hDisjoint, Nat.card_Ioc] at hUnion
    simpa using hUnion
  have hCard :
      (A.card : ℝ) + ((S.erase 1).card : ℝ) ≤ (N : ℝ) := by
    exact_mod_cast hCardNat
  have hScaled :
      |(N : ℝ) * (∑ n ∈ S,
          ((ArithmeticFunction.moebius n : ℤ) : ℝ) / (n : ℝ))| ≤ (N : ℝ) := by
    rw [hDecomposition]
    exact ((abs_add_le _ _).trans (add_le_add le_rfl hRemainder)).trans
      (by simpa using hCard)
  have hNReal : (0 : ℝ) < (N : ℝ) := by exact_mod_cast hNPos
  apply (mul_le_mul_iff_right₀ hNReal).mp
  simpa [S, abs_mul, abs_of_nonneg hNReal.le] using hScaled

/--
Integers in `(0, N]` divisible by neither `4` nor `9`. This is an elementary superset of the
squarefree integers in the same interval.
-/
def squarefreeCandidateIndices (N : ℕ) : Finset ℕ :=
  (Finset.Ioc 0 N).filter (fun n ↦ ¬4 ∣ n ∧ ¬9 ∣ n)

theorem card_squarefreeCandidateIndices (N : ℕ) :
    (squarefreeCandidateIndices N).card =
      N - N / 4 - N / 9 + N / 36 := by
  let s := Finset.Ioc 0 N
  let a := s.filter (fun n ↦ 4 ∣ n)
  let na := s.filter (fun n ↦ ¬4 ∣ n)
  let b := s.filter (fun n ↦ 9 ∣ n)
  let ab := b.filter (fun n ↦ 4 ∣ n)
  let nab := na.filter (fun n ↦ 9 ∣ n)
  have hs : s.card = N := by
    simp [s, Nat.card_Ioc]
  have ha : a.card = N / 4 := by
    simpa only [a, s] using Nat.Ioc_filter_dvd_card_eq_div N 4
  have hb : b.card = N / 9 := by
    simpa only [b, s] using Nat.Ioc_filter_dvd_card_eq_div N 9
  have habFinset : ab = s.filter (fun n ↦ 36 ∣ n) := by
    ext n
    simp only [ab, b, Finset.mem_filter]
    constructor
    · rintro ⟨⟨hn, h9⟩, h4⟩
      refine ⟨hn, ?_⟩
      simpa only [show 36 = 4 * 9 by norm_num] using
        (by norm_num : Nat.Coprime 4 9).mul_dvd_of_dvd_of_dvd h4 h9
    · rintro ⟨hn, h36⟩
      exact ⟨⟨hn, (by omega : 9 ∣ 36).trans h36⟩,
        (by omega : 4 ∣ 36).trans h36⟩
  have hab : ab.card = N / 36 := by
    rw [habFinset]
    exact Nat.Ioc_filter_dvd_card_eq_div N 36
  have hsplitA : a.card + na.card = s.card := by
    simpa only [a, na] using
      (Finset.card_filter_add_card_filter_not (s := s) (fun n ↦ 4 ∣ n))
  have hsplitB : ab.card + nab.card = b.card := by
    have h := Finset.card_filter_add_card_filter_not
      (s := b) (fun n ↦ 4 ∣ n)
    have hnotEq : b.filter (fun n ↦ ¬4 ∣ n) = nab := by
      ext n
      simp only [b, nab, na, Finset.mem_filter]
      tauto
    simpa only [ab, hnotEq] using h
  have hsplitNine : nab.card + (squarefreeCandidateIndices N).card =
      na.card := by
    have h := Finset.card_filter_add_card_filter_not
      (s := na) (fun n ↦ 9 ∣ n)
    have hcandEq : na.filter (fun n ↦ ¬9 ∣ n) =
        squarefreeCandidateIndices N := by
      ext n
      simp only [na, squarefreeCandidateIndices, Finset.mem_filter]
      tauto
    simpa only [nab, hcandEq] using h
  omega

theorem sum_sq_moebius_eq_card_squarefree (N : ℕ) :
    (∑ n ∈ Finset.Ioc 0 N,
      (((ArithmeticFunction.moebius n : ℤ) : ℝ)) ^ 2) =
      (((Finset.Ioc 0 N).filter Squarefree).card : ℝ) := by
  calc
    _ = ∑ n ∈ Finset.Ioc 0 N, if Squarefree n then (1 : ℝ) else 0 := by
      apply Finset.sum_congr rfl
      intro n _hn
      rw [← Int.cast_pow, ArithmeticFunction.moebius_sq]
      split_ifs <;> norm_num
    _ = _ := by simp

theorem squarefree_subset_candidateIndices (N : ℕ) :
    (Finset.Ioc 0 N).filter Squarefree ⊆ squarefreeCandidateIndices N := by
  intro n hn
  rcases Finset.mem_filter.mp hn with ⟨hnIoc, hsq⟩
  rw [squarefreeCandidateIndices, Finset.mem_filter]
  refine ⟨hnIoc, ?_, ?_⟩
  · intro h4
    exact (Nat.squarefree_iff_prime_squarefree.mp hsq 2 Nat.prime_two)
      (by simpa using h4)
  · intro h9
    exact (Nat.squarefree_iff_prime_squarefree.mp hsq 3 Nat.prime_three)
      (by simpa using h9)

theorem sum_sq_moebius_le_two_thirds (N : ℕ) :
    (∑ n ∈ Finset.Ioc 0 N,
      (((ArithmeticFunction.moebius n : ℤ) : ℝ)) ^ 2) ≤
      (2 / 3 : ℝ) * ((N : ℝ) + 2) := by
  rw [sum_sq_moebius_eq_card_squarefree]
  have hcard := Finset.card_le_card (squarefree_subset_candidateIndices N)
  have hcandidates :
      3 * (squarefreeCandidateIndices N).card ≤ 2 * (N + 2) := by
    rw [card_squarefreeCandidateIndices]
    omega
  have hcandidatesReal :
      (3 : ℝ) * ((squarefreeCandidateIndices N).card : ℝ) ≤
        2 * ((N : ℝ) + 2) := by
    exact_mod_cast hcandidates
  have hcardReal :
      (((Finset.Ioc 0 N).filter Squarefree).card : ℝ) ≤
        ((squarefreeCandidateIndices N).card : ℝ) := by
    exact_mod_cast hcard
  nlinarith

/--
The real-valued square `μ(n)²` of the Möbius function, which is the indicator of squarefreeness.
-/
def moebiusSquare (n : ℕ) : ℝ :=
  (((ArithmeticFunction.moebius n : ℤ) : ℝ)) ^ 2

/--
The sum of `μ(n)²` over `1 ≤ n ≤ N`, hence the number of squarefree positive integers up to `N`,
viewed in `ℝ`.
-/
def moebiusSquarePrefix (N : ℕ) : ℝ :=
  ∑ n ∈ Finset.Ioc 0 N, moebiusSquare n

theorem sum_range_moebiusSquare (N : ℕ) :
    (∑ n ∈ Finset.range (N + 1), moebiusSquare n) =
      moebiusSquarePrefix N := by
  rw [← Nat.Ico_zero_eq_range, Finset.Ico_add_one_right_eq_Icc,
    Finset.Icc_eq_cons_Ioc (Nat.zero_le N), Finset.sum_cons]
  simp [moebiusSquare, moebiusSquarePrefix]

theorem moebiusSquare_abel (N : ℕ) (hN : 1 ≤ N) :
    (∑ n ∈ Finset.Ioc 0 N, moebiusSquare n / (n : ℝ)) =
      moebiusSquarePrefix N / (N : ℝ) +
        ∑ n ∈ Finset.Ioc 0 (N - 1), moebiusSquarePrefix n *
          ((n : ℝ)⁻¹ - ((n + 1 : ℕ) : ℝ)⁻¹) := by
  have h := Finset.sum_Ioc_by_parts (fun n : ℕ ↦ ((n : ℝ))⁻¹)
    moebiusSquare (show 0 < N by omega)
  simp_rw [sum_range_moebiusSquare] at h
  have hprefixZero : moebiusSquarePrefix 0 = 0 := by
    simp [moebiusSquarePrefix]
  rw [hprefixZero] at h
  calc
    _ = ∑ n ∈ Finset.Ioc 0 N, (n : ℝ)⁻¹ * moebiusSquare n := by
      apply Finset.sum_congr rfl
      intro n _hn
      ring
    _ = (N : ℝ)⁻¹ * moebiusSquarePrefix N -
        ∑ n ∈ Finset.Ioc 0 (N - 1),
          (((n + 1 : ℕ) : ℝ)⁻¹ - (n : ℝ)⁻¹) *
            moebiusSquarePrefix n := by
      simpa only [smul_eq_mul, mul_zero, sub_zero] using h
    _ = _ := by
      rw [sub_eq_add_neg, ← Finset.sum_neg_distrib]
      congr 1
      · ring
      · apply Finset.sum_congr rfl
        intro n _hn
        ring

theorem moebiusSquare_abel_weights (N : ℕ) (hN : 1 ≤ N) :
    ((N : ℝ) + 2) / (N : ℝ) +
        ∑ n ∈ Finset.Ioc 0 (N - 1), ((n : ℝ) + 2) *
          ((n : ℝ)⁻¹ - ((n + 1 : ℕ) : ℝ)⁻¹) =
      (harmonic N : ℝ) + 2 := by
  rcases Nat.exists_eq_add_of_le hN with ⟨k, rfl⟩
  induction k with
  | zero => norm_num [harmonic]
  | succ k ih =>
      have ih' := ih (by omega : 1 ≤ 1 + k)
      simp only [show 1 + k - 1 = k by omega] at ih'
      rw [show 1 + (k + 1) - 1 = k + 1 by omega,
        Finset.sum_Ioc_succ_top (Nat.zero_le k),
        show 1 + (k + 1) = (1 + k) + 1 by omega, harmonic_succ]
      simp only [Rat.cast_add, Rat.cast_inv, Rat.cast_natCast]
      have hk1 : (k : ℝ) + 1 ≠ 0 := by positivity
      have hk2 : (k : ℝ) + 2 ≠ 0 := by positivity
      calc
        _ = (((1 + k : ℕ) : ℝ) + 2) / ((1 + k : ℕ) : ℝ) +
              ∑ n ∈ Finset.Ioc 0 k, ((n : ℝ) + 2) *
                ((n : ℝ)⁻¹ - ((n + 1 : ℕ) : ℝ)⁻¹) +
              (((1 + k + 1 : ℕ) : ℝ))⁻¹ := by
            norm_num only [Nat.cast_add, Nat.cast_one]
            field_simp
            ring
        _ = ((harmonic (1 + k) : ℝ) + 2) +
              (((1 + k + 1 : ℕ) : ℝ))⁻¹ := by rw [ih']
        _ = _ := by ring

theorem sum_sq_moebius_div_le_two_thirds
    {N : ℕ} (hN : 1 ≤ N) :
    (∑ n ∈ Finset.Ioc 0 N,
      (((ArithmeticFunction.moebius n : ℤ) : ℝ)) ^ 2 / (n : ℝ)) ≤
      (2 / 3 : ℝ) * (Real.log (N : ℝ) + 3) := by
  change (∑ n ∈ Finset.Ioc 0 N, moebiusSquare n / (n : ℝ)) ≤ _
  rw [moebiusSquare_abel N hN]
  calc
    moebiusSquarePrefix N / (N : ℝ) +
          ∑ n ∈ Finset.Ioc 0 (N - 1), moebiusSquarePrefix n *
            ((n : ℝ)⁻¹ - ((n + 1 : ℕ) : ℝ)⁻¹) ≤
        (2 / 3 : ℝ) * ((N : ℝ) + 2) / (N : ℝ) +
          ∑ n ∈ Finset.Ioc 0 (N - 1),
            (2 / 3 : ℝ) * ((n : ℝ) + 2) *
              ((n : ℝ)⁻¹ - ((n + 1 : ℕ) : ℝ)⁻¹) := by
      apply add_le_add
      · exact div_le_div_of_nonneg_right
          (by simpa [moebiusSquarePrefix, moebiusSquare] using
            sum_sq_moebius_le_two_thirds N)
          (by positivity)
      · apply Finset.sum_le_sum
        intro n hn
        have hnpos : 0 < n := (Finset.mem_Ioc.mp hn).1
        have hweight :
            0 ≤ (n : ℝ)⁻¹ - ((n + 1 : ℕ) : ℝ)⁻¹ := by
          apply sub_nonneg.mpr
          exact inv_anti₀ (by exact_mod_cast hnpos) (by norm_num)
        exact mul_le_mul_of_nonneg_right
          (by simpa [moebiusSquarePrefix, moebiusSquare] using
            sum_sq_moebius_le_two_thirds n)
          hweight
    _ = (2 / 3 : ℝ) *
        (((N : ℝ) + 2) / (N : ℝ) +
          ∑ n ∈ Finset.Ioc 0 (N - 1), ((n : ℝ) + 2) *
            ((n : ℝ)⁻¹ - ((n + 1 : ℕ) : ℝ)⁻¹)) := by
      have hsum :
          (∑ n ∈ Finset.Ioc 0 (N - 1),
            (2 / 3 : ℝ) * ((n : ℝ) + 2) *
              ((n : ℝ)⁻¹ - ((n + 1 : ℕ) : ℝ)⁻¹)) =
          (2 / 3 : ℝ) *
            ∑ n ∈ Finset.Ioc 0 (N - 1), ((n : ℝ) + 2) *
              ((n : ℝ)⁻¹ - ((n + 1 : ℕ) : ℝ)⁻¹) := by
        rw [Finset.mul_sum]
        apply Finset.sum_congr rfl
        intro n _hn
        ring
      rw [hsum]
      ring
    _ = (2 / 3 : ℝ) * ((harmonic N : ℝ) + 2) := by
      rw [moebiusSquare_abel_weights N hN]
    _ ≤ (2 / 3 : ℝ) * (Real.log (N : ℝ) + 3) := by
      have hH := harmonic_le_one_add_log N
      norm_num at hH ⊢
      linarith

theorem moebiusSquare_nonneg (n : ℕ) : 0 ≤ moebiusSquare n :=
  sq_nonneg _

/--
The arithmetic function `n ↦ μ(n)² / n`, with value zero at `0`. Its positive partial sums
weight squarefree integers by their reciprocals.
-/
noncomputable def moebiusSquareDiv : ArithmeticFunction ℝ :=
  ⟨fun n ↦ moebiusSquare n / (n : ℝ), by simp [moebiusSquare]⟩

theorem moebiusSquareDiv_nonneg (n : ℕ) :
    0 ≤ moebiusSquareDiv n :=
  div_nonneg (moebiusSquare_nonneg n) (Nat.cast_nonneg n)

theorem moebiusSquare_divisorCard_div_le_convolution (n : ℕ) :
    moebiusSquare n * (n.divisors.card : ℝ) / (n : ℝ) ≤
      (moebiusSquareDiv * moebiusSquareDiv) n := by
  rw [ArithmeticFunction.mul_apply]
  rw [show
      (∑ x ∈ n.divisorsAntidiagonal,
        moebiusSquareDiv x.1 * moebiusSquareDiv x.2) =
        ∑ d ∈ n.divisors, moebiusSquareDiv d * moebiusSquareDiv (n / d) from
      Nat.sum_divisorsAntidiagonal
        (fun a b ↦ moebiusSquareDiv a * moebiusSquareDiv b)]
  by_cases hsq : Squarefree n
  · have hgn : moebiusSquare n = 1 := by
      rw [moebiusSquare, ← Int.cast_pow, ArithmeticFunction.moebius_sq,
        ite_eq_left hsq]
      norm_num
    rw [hgn, one_mul]
    have hterm (d : ℕ) (hd : d ∈ n.divisors) :
        moebiusSquareDiv d * moebiusSquareDiv (n / d) =
          1 / (n : ℝ) := by
      have hdvd : d ∣ n := Nat.dvd_of_mem_divisors hd
      have hprodNat : d * (n / d) = n := Nat.mul_div_cancel' hdvd
      have hprod : (d : ℝ) * ((n / d : ℕ) : ℝ) = (n : ℝ) := by
        exact_mod_cast hprodNat
      have hgd : moebiusSquare d = 1 := by
        rw [moebiusSquare, ← Int.cast_pow, ArithmeticFunction.moebius_sq,
          ite_eq_left (hsq.squarefree_of_dvd hdvd)]
        norm_num
      have hgnd : moebiusSquare (n / d) = 1 := by
        rw [moebiusSquare, ← Int.cast_pow, ArithmeticFunction.moebius_sq,
          ite_eq_left (hsq.squarefree_of_dvd (Nat.div_dvd_of_dvd hdvd))]
        norm_num
      rw [moebiusSquareDiv, ArithmeticFunction.coe_mk, hgd, hgnd]
      norm_num only [one_div]
      rw [← mul_inv, hprod]
    calc
      (n.divisors.card : ℝ) / (n : ℝ) =
          ∑ _d ∈ n.divisors, 1 / (n : ℝ) := by
        simp [div_eq_mul_inv]
      _ = ∑ d ∈ n.divisors,
          moebiusSquareDiv d * moebiusSquareDiv (n / d) := by
        apply Finset.sum_congr rfl
        intro d hd
        exact (hterm d hd).symm
      _ ≤ _ := le_rfl
  · have hgn : moebiusSquare n = 0 := by
      rw [moebiusSquare, ← Int.cast_pow, ArithmeticFunction.moebius_sq,
        ite_eq_right hsq]
      norm_num
    rw [hgn, zero_mul, zero_div]
    exact Finset.sum_nonneg fun d _hd ↦
      mul_nonneg (moebiusSquareDiv_nonneg d)
        (moebiusSquareDiv_nonneg (n / d))

theorem sum_sq_moebius_mul_card_divisors_div_le_four_ninths
    {N : ℕ} (hN : 1 ≤ N) :
    (∑ n ∈ Finset.Ioc 0 N,
      (((ArithmeticFunction.moebius n : ℤ) : ℝ)) ^ 2 *
        (n.divisors.card : ℝ) / (n : ℝ)) ≤
      (4 / 9 : ℝ) * (Real.log (N : ℝ) + 3) ^ 2 := by
  let s := Finset.Ioc 0 N
  let box := s ×ˢ s
  let pairs := box.filter (fun x : ℕ × ℕ ↦ x.1 * x.2 ≤ N)
  have hpairsSubset : pairs ⊆ box := Finset.filter_subset _ _
  have hdrop :
      (∑ x ∈ pairs, moebiusSquareDiv x.1 * moebiusSquareDiv x.2) ≤
        ∑ x ∈ box, moebiusSquareDiv x.1 * moebiusSquareDiv x.2 := by
    apply Finset.sum_le_sum_of_subset_of_nonneg hpairsSubset
    intro x _hx _hnot
    exact mul_nonneg (moebiusSquareDiv_nonneg x.1)
      (moebiusSquareDiv_nonneg x.2)
  have hfirst := sum_sq_moebius_div_le_two_thirds hN
  have hsumNonneg : 0 ≤ ∑ n ∈ s, moebiusSquareDiv n :=
    Finset.sum_nonneg fun n _hn ↦ moebiusSquareDiv_nonneg n
  have hrightNonneg :
      0 ≤ (2 / 3 : ℝ) * (Real.log (N : ℝ) + 3) := by
    have hlog : 0 ≤ Real.log (N : ℝ) := by
      exact Real.log_nonneg (by exact_mod_cast hN)
    positivity
  calc
    (∑ n ∈ Finset.Ioc 0 N,
        (((ArithmeticFunction.moebius n : ℤ) : ℝ)) ^ 2 *
          (n.divisors.card : ℝ) / (n : ℝ)) ≤
        ∑ n ∈ Finset.Ioc 0 N,
          (moebiusSquareDiv * moebiusSquareDiv) n := by
      apply Finset.sum_le_sum
      intro n _hn
      simpa only [moebiusSquare] using
        moebiusSquare_divisorCard_div_le_convolution n
    _ = ∑ x ∈ pairs,
        moebiusSquareDiv x.1 * moebiusSquareDiv x.2 := by
      simpa only [s, box, pairs] using
        ArithmeticFunction.sum_Ioc_mul_eq_sum_prod_filter
          moebiusSquareDiv moebiusSquareDiv N
    _ ≤ ∑ x ∈ box,
        moebiusSquareDiv x.1 * moebiusSquareDiv x.2 := hdrop
    _ = ∑ a ∈ s, ∑ b ∈ s, moebiusSquareDiv a * moebiusSquareDiv b :=
      Finset.sum_product' s s
        (fun a b ↦ moebiusSquareDiv a * moebiusSquareDiv b)
    _ = (∑ n ∈ s, moebiusSquareDiv n) ^ 2 := by
      rw [← Finset.sum_mul_sum]
      ring
    _ ≤ ((2 / 3 : ℝ) * (Real.log (N : ℝ) + 3)) ^ 2 := by
      apply (sq_le_sq₀ hsumNonneg hrightNonneg).2
      simpa only [s, moebiusSquareDiv, ArithmeticFunction.coe_mk,
        moebiusSquare] using hfirst
    _ = (4 / 9 : ℝ) * (Real.log (N : ℝ) + 3) ^ 2 := by ring

/--
Ordered pairs of squarefree positive integers at most `Z` whose least common multiple is at most
`B`.
-/
def squarefreeLcmPairs (Z B : ℕ) : Finset (ℕ × ℕ) :=
  (Finset.Ioc 0 Z ×ˢ Finset.Ioc 0 Z).filter
    (fun p => Nat.lcm p.1 p.2 ≤ B ∧ Squarefree p.1 ∧ Squarefree p.2)

/--
The nested triple type recording two quotients and their common gcd in a pair's gcd
decomposition. No arithmetic conditions are built into the type.
-/
abbrev GcdDecompositionTriple := Σ _a : ℕ, Σ _b : ℕ, ℕ

/--
An ambient set of triples `(a, b, g)` with squarefree `a, b ∈ (0, Z]` and `0 < g ≤ B / (a * b)`.
Coprimality of the first two coordinates is not required.
-/
def gcdDecompositionTriples (Z B : ℕ) :
    Finset GcdDecompositionTriple :=
  ((Finset.Ioc 0 Z).filter Squarefree).sigma (fun a =>
    ((Finset.Ioc 0 Z).filter Squarefree).sigma (fun b =>
      Finset.Ioc 0 (B / (a * b))))

/--
Sends a pair `(m, n)` to `(m / gcd m n, n / gcd m n, gcd m n)`, using natural-number division.
-/
def decomposeLcmPair (p : ℕ × ℕ) : GcdDecompositionTriple :=
  ⟨p.1 / Nat.gcd p.1 p.2,
    ⟨p.2 / Nat.gcd p.1 p.2, Nat.gcd p.1 p.2⟩⟩

theorem pairMass_eq_card_squarefreeLcmPairs (Z B : ℕ) :
    (∑ d ∈ Finset.Ioc 0 Z,
      ∑ e ∈ (Finset.Ioc 0 Z).filter (fun e => Nat.lcm d e ≤ B),
        (((ArithmeticFunction.moebius d : ℤ) : ℝ)) ^ 2 *
          (((ArithmeticFunction.moebius e : ℤ) : ℝ)) ^ 2) =
      ((squarefreeLcmPairs Z B).card : ℝ) := by
  unfold squarefreeLcmPairs
  rw [Finset.natCast_card_filter, Finset.sum_product]
  simp_rw [← Int.cast_pow, ArithmeticFunction.moebius_sq]
  apply Finset.sum_congr rfl
  intro d _hd
  rw [Finset.sum_filter]
  apply Finset.sum_congr rfl
  intro e _he
  by_cases hlcm : Nat.lcm d e ≤ B <;>
    by_cases hdSq : Squarefree d <;>
      by_cases heSq : Squarefree e <;> simp [hlcm, hdSq, heSq]

theorem lcm_eq_gcd_mul_div_mul_div
    {d e : ℕ} (hd : 0 < d) :
    Nat.lcm d e = Nat.gcd d e *
      ((d / Nat.gcd d e) * (e / Nat.gcd d e)) := by
  rw [← (Nat.coprime_div_gcd_div_gcd (Nat.gcd_pos_of_pos_left e hd)).lcm_eq_mul,
    Nat.lcm_div (Nat.gcd_dvd_left d e) (Nat.gcd_dvd_right d e),
    Nat.mul_div_cancel' ((Nat.gcd_dvd_left d e).trans (Nat.dvd_lcm_left d e))]

theorem card_squarefreeLcmPairs_le_gcdDecompositionTriples
    (Z B : ℕ) :
    (squarefreeLcmPairs Z B).card ≤
      (gcdDecompositionTriples Z B).card := by
  apply Finset.card_le_card_of_injOn decomposeLcmPair
  · intro p hp
    rcases Finset.mem_filter.mp hp with
      ⟨hpProd, hlcm, hdSq, heSq⟩
    rcases Finset.mem_product.mp hpProd with ⟨hdZ, heZ⟩
    have hdPos : 0 < p.1 := (Finset.mem_Ioc.mp hdZ).1
    have hePos : 0 < p.2 := (Finset.mem_Ioc.mp heZ).1
    have hgPos : 0 < Nat.gcd p.1 p.2 :=
      Nat.gcd_pos_of_pos_left p.2 hdPos
    have haPos : 0 < p.1 / Nat.gcd p.1 p.2 :=
      Nat.div_pos
        (Nat.le_of_dvd hdPos (Nat.gcd_dvd_left p.1 p.2)) hgPos
    have hbPos : 0 < p.2 / Nat.gcd p.1 p.2 :=
      Nat.div_pos
        (Nat.le_of_dvd hePos (Nat.gcd_dvd_right p.1 p.2)) hgPos
    have haSq : Squarefree (p.1 / Nat.gcd p.1 p.2) :=
      hdSq.squarefree_of_dvd
        (Nat.div_dvd_of_dvd (Nat.gcd_dvd_left p.1 p.2))
    have hbSq : Squarefree (p.2 / Nat.gcd p.1 p.2) :=
      heSq.squarefree_of_dvd
        (Nat.div_dvd_of_dvd (Nat.gcd_dvd_right p.1 p.2))
    have hlcmEq := lcm_eq_gcd_mul_div_mul_div (e := p.2) hdPos
    apply Finset.mem_sigma.mpr
    refine ⟨Finset.mem_filter.mpr
      ⟨Finset.mem_Ioc.mpr ⟨haPos, ?_⟩, haSq⟩, ?_⟩
    · exact (Nat.div_le_self p.1 _).trans (Finset.mem_Ioc.mp hdZ).2
    apply Finset.mem_sigma.mpr
    refine ⟨Finset.mem_filter.mpr
      ⟨Finset.mem_Ioc.mpr ⟨hbPos, ?_⟩, hbSq⟩, ?_⟩
    · exact (Nat.div_le_self p.2 _).trans (Finset.mem_Ioc.mp heZ).2
    change Nat.gcd p.1 p.2 ∈ Finset.Ioc 0
      (B / ((p.1 / Nat.gcd p.1 p.2) *
        (p.2 / Nat.gcd p.1 p.2)))
    apply Finset.mem_Ioc.mpr
    refine ⟨hgPos, (Nat.le_div_iff_mul_le (Nat.mul_pos haPos hbPos)).2 ?_⟩
    simpa only [← hlcmEq] using hlcm
  · intro p _hp q _hq hpq
    apply Prod.ext
    · have hfirst := congrArg
        (fun x : GcdDecompositionTriple => x.1 * x.2.2) hpq
      calc
        p.1 = (p.1 / Nat.gcd p.1 p.2) * Nat.gcd p.1 p.2 :=
          (Nat.div_mul_cancel (Nat.gcd_dvd_left p.1 p.2)).symm
        _ = (q.1 / Nat.gcd q.1 q.2) * Nat.gcd q.1 q.2 := by
          simpa only [decomposeLcmPair] using hfirst
        _ = q.1 := Nat.div_mul_cancel (Nat.gcd_dvd_left q.1 q.2)
    · have hsecond := congrArg
        (fun x : GcdDecompositionTriple => x.2.1 * x.2.2) hpq
      calc
        p.2 = (p.2 / Nat.gcd p.1 p.2) * Nat.gcd p.1 p.2 :=
          (Nat.div_mul_cancel (Nat.gcd_dvd_right p.1 p.2)).symm
        _ = (q.2 / Nat.gcd q.1 q.2) * Nat.gcd q.1 q.2 := by
          simpa only [decomposeLcmPair] using hsecond
        _ = q.2 := Nat.div_mul_cancel (Nat.gcd_dvd_right q.1 q.2)

theorem card_gcdDecompositionTriples (Z B : ℕ) :
    ((gcdDecompositionTriples Z B).card : ℝ) =
      ∑ a ∈ (Finset.Ioc 0 Z).filter Squarefree,
        ∑ b ∈ (Finset.Ioc 0 Z).filter Squarefree,
          ((B / (a * b) : ℕ) : ℝ) := by
  simp [gcdDecompositionTriples, Finset.card_sigma, Nat.card_Ioc]

theorem sum_inv_squarefree_eq_moebiusSquareMoment (Z : ℕ) :
    (∑ a ∈ (Finset.Ioc 0 Z).filter Squarefree, (a : ℝ)⁻¹) =
      ∑ a ∈ Finset.Ioc 0 Z,
        (((ArithmeticFunction.moebius a : ℤ) : ℝ)) ^ 2 / (a : ℝ) := by
  rw [Finset.sum_filter]
  apply Finset.sum_congr rfl
  intro a _ha
  rw [← Int.cast_pow, ArithmeticFunction.moebius_sq]
  by_cases haSq : Squarefree a <;> simp [haSq]

theorem sum_cast_div_le_squarefreeMoment_sq (Z B : ℕ) :
    (∑ a ∈ (Finset.Ioc 0 Z).filter Squarefree,
      ∑ b ∈ (Finset.Ioc 0 Z).filter Squarefree,
        ((B / (a * b) : ℕ) : ℝ)) ≤
      (B : ℝ) *
        (∑ a ∈ (Finset.Ioc 0 Z).filter Squarefree, (a : ℝ)⁻¹) ^ 2 := by
  calc
    _ ≤ ∑ a ∈ (Finset.Ioc 0 Z).filter Squarefree,
        ∑ b ∈ (Finset.Ioc 0 Z).filter Squarefree,
          (B : ℝ) / ((a * b : ℕ) : ℝ) := by
      apply Finset.sum_le_sum
      intro a _ha
      apply Finset.sum_le_sum
      intro b _hb
      exact Nat.cast_div_le
    _ = _ := by
      rw [pow_two, Finset.sum_mul_sum, Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro a ha
      rw [Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro b hb
      have ha0 : (a : ℝ) ≠ 0 := by
        exact_mod_cast (Finset.mem_Ioc.mp (Finset.mem_filter.mp ha).1).1.ne'
      have hb0 : (b : ℝ) ≠ 0 := by
        exact_mod_cast (Finset.mem_Ioc.mp (Finset.mem_filter.mp hb).1).1.ne'
      push_cast
      field_simp

theorem sum_sq_moebius_pair_lcm_le
    {Z B : ℕ} (hZ : 1 ≤ Z) :
    (∑ d ∈ Finset.Ioc 0 Z,
      ∑ e ∈ (Finset.Ioc 0 Z).filter
        (fun e => Nat.lcm d e ≤ B),
        (((ArithmeticFunction.moebius d : ℤ) : ℝ)) ^ 2 *
          (((ArithmeticFunction.moebius e : ℤ) : ℝ)) ^ 2) ≤
      (B : ℝ) *
        ((2 / 3 : ℝ) * (Real.log (Z : ℝ) + 3)) ^ 2 := by
  rw [pairMass_eq_card_squarefreeLcmPairs]
  have hcardNat := card_squarefreeLcmPairs_le_gcdDecompositionTriples Z B
  have hcardReal :
      ((squarefreeLcmPairs Z B).card : ℝ) ≤
        ((gcdDecompositionTriples Z B).card : ℝ) := by
    exact_mod_cast hcardNat
  have hmoment := sum_sq_moebius_div_le_two_thirds hZ
  have hmoment' :
      (∑ a ∈ (Finset.Ioc 0 Z).filter Squarefree, (a : ℝ)⁻¹) ≤
        (2 / 3 : ℝ) * (Real.log (Z : ℝ) + 3) := by
    rw [sum_inv_squarefree_eq_moebiusSquareMoment]
    exact hmoment
  have hsumNonneg :
      0 ≤ ∑ a ∈ (Finset.Ioc 0 Z).filter Squarefree, (a : ℝ)⁻¹ :=
    Finset.sum_nonneg fun a _ha => inv_nonneg.mpr (Nat.cast_nonneg a)
  have hrightNonneg :
      0 ≤ (2 / 3 : ℝ) * (Real.log (Z : ℝ) + 3) := by
    have hlog : 0 ≤ Real.log (Z : ℝ) :=
      Real.log_nonneg (by exact_mod_cast hZ)
    positivity
  calc
    ((squarefreeLcmPairs Z B).card : ℝ) ≤
        ((gcdDecompositionTriples Z B).card : ℝ) := hcardReal
    _ = ∑ a ∈ (Finset.Ioc 0 Z).filter Squarefree,
        ∑ b ∈ (Finset.Ioc 0 Z).filter Squarefree,
          ((B / (a * b) : ℕ) : ℝ) := card_gcdDecompositionTriples Z B
    _ ≤ (B : ℝ) *
        (∑ a ∈ (Finset.Ioc 0 Z).filter Squarefree, (a : ℝ)⁻¹) ^ 2 :=
      sum_cast_div_le_squarefreeMoment_sq Z B
    _ ≤ (B : ℝ) *
        ((2 / 3 : ℝ) * (Real.log (Z : ℝ) + 3)) ^ 2 := by
      apply mul_le_mul_of_nonneg_left
      · exact (sq_le_sq₀ hsumNonneg hrightNonneg).2 hmoment'
      · positivity

end

section
open scoped ContDiff

open scoped ArithmeticFunction.vonMangoldt
/--
The von Mangoldt sum over `1 ≤ n ≤ x` with `n ≡ a` modulo `q`. Both residues are reduced modulo
`q`, so no chosen representative for `a` is required.
-/
noncomputable def chebyshevProgressionSum (x q a : ℕ) : ℝ :=
  ∑ n ∈ Finset.Icc 1 x with n % q = a % q,
    ArithmeticFunction.vonMangoldt n

theorem weightedEndpointRange_nonempty {x : ℕ} (hx : 2 ≤ x) :
    (Finset.Icc 2 x).Nonempty :=
  ⟨2, Finset.mem_Icc.mpr ⟨le_rfl, hx⟩⟩

/--
The sum of `χ(a⁻¹) χ(n)` over all Dirichlet characters modulo `q`. Orthogonality identifies this
kernel with a totient-weighted congruence indicator when `a` is a unit.
-/
noncomputable def characterOrthogonalityKernel (q a n : ℕ) : ℂ :=
  ∑ χ : DirichletCharacter ℂ q,
    χ (a : ZMod q)⁻¹ * χ (n : ZMod q)

theorem characterOrthogonalityKernel_eq_of_coprime
    {q a n : ℕ} [NeZero q] (ha : Nat.Coprime a q) :
    characterOrthogonalityKernel q a n =
      if (a : ZMod q) = (n : ZMod q) then (q.totient : ℂ) else 0 := by
  unfold characterOrthogonalityKernel
  have hunit : IsUnit (a : ZMod q) := by
    rw [ZMod.isUnit_iff_coprime]
    exact ha
  simpa using
    (DirichletCharacter.sum_char_inv_mul_char_eq ℂ hunit (n : ZMod q))

theorem characterOrthogonalityKernel_eq_mod_of_coprime
    {q a n : ℕ} [NeZero q] (ha : Nat.Coprime a q) :
    characterOrthogonalityKernel q a n =
      if a % q = n % q then (q.totient : ℂ) else 0 := by
  rw [characterOrthogonalityKernel_eq_of_coprime ha]
  congr 1
  simpa using (ZMod.natCast_eq_natCast_iff' a n q)

theorem inv_totient_mul_characterOrthogonalityKernel
    {q a n : ℕ} [NeZero q] (ha : Nat.Coprime a q) :
    (q.totient : ℂ)⁻¹ * characterOrthogonalityKernel q a n =
      if a % q = n % q then 1 else 0 := by
  rw [characterOrthogonalityKernel_eq_mod_of_coprime ha]
  split_ifs
  · rw [inv_mul_cancel₀]
    norm_num [Nat.totient_pos.mpr q.pos_of_neZero, NeZero.ne q]
  · simp

theorem chebyshevProgressionSum_complex_eq_character_average
    {x q a : ℕ} [NeZero q] (ha : Nat.Coprime a q) :
    (chebyshevProgressionSum x q a : ℂ) =
      (q.totient : ℂ)⁻¹ *
        ∑ χ : DirichletCharacter ℂ q,
          χ (a : ZMod q)⁻¹ * twistedChebyshevSum x q χ := by
  simp only [chebyshevProgressionSum, twistedChebyshevSum, Complex.ofReal_sum]
  rw [Finset.mul_sum]
  simp only [Finset.mul_sum]
  rw [Finset.sum_comm]
  rw [Finset.sum_filter]
  apply Finset.sum_congr rfl
  intro n _
  simp only [← mul_assoc]
  rw [← Finset.sum_mul]
  simp only [mul_assoc]
  rw [← Finset.mul_sum]
  change (if n % q = a % q then (ArithmeticFunction.vonMangoldt n : ℂ) else 0) =
    ((q.totient : ℂ)⁻¹ * characterOrthogonalityKernel q a n) *
      (ArithmeticFunction.vonMangoldt n : ℂ)
  rw [inv_totient_mul_characterOrthogonalityKernel ha]
  by_cases h : n % q = a % q
  · have h' : a % q = n % q := h.symm
    rw [ite_eq_left h, ite_eq_left h']
    simp
  · have h' : ¬a % q = n % q := fun h'' => h h''.symm
    rw [ite_eq_right h, ite_eq_right h']
    simp

theorem primitiveCharacter_eq_one_iff
    {q : ℕ} [NeZero q] (χ : DirichletCharacter ℂ q) :
    χ.primitiveCharacter = 1 ↔ χ = 1 := by
  constructor
  · intro h
    have hchange := χ.changeLevel_primitiveCharacter
    rw [h, DirichletCharacter.changeLevel_one] at hchange
    exact hchange.symm
  · rintro rfl
    exact DirichletCharacter.primitiveCharacter_one

theorem centeredPrimitive_sub_centered_eq
    {x q : ℕ} [NeZero q] (χ : DirichletCharacter ℂ q) :
    centeredTwistedChebyshevSum x χ.conductor χ.primitiveCharacter -
        centeredTwistedChebyshevSum x q χ =
      twistedChebyshevSum x χ.conductor χ.primitiveCharacter -
        twistedChebyshevSum x q χ := by
  classical
  simp only [centeredTwistedChebyshevSum]
  by_cases hχ : χ = 1
  · have hp := (primitiveCharacter_eq_one_iff χ).mpr hχ
    simp only [ite_eq_left hχ, ite_eq_left hp]
    ring
  · have hp : χ.primitiveCharacter ≠ 1 := fun hp => hχ ((primitiveCharacter_eq_one_iff χ).mp hp)
    simp only [ite_eq_right hχ, ite_eq_right hp, sub_zero]

theorem chebyshevProgressionSum_sub_global_eq_centered_character_average
    {x q a : ℕ} [NeZero q] (ha : Nat.Coprime a q) :
    ((chebyshevProgressionSum x q a -
        Chebyshev.psi (x : ℝ) / (q.totient : ℝ) : ℝ) : ℂ) =
      (q.totient : ℂ)⁻¹ *
        ∑ χ : DirichletCharacter ℂ q,
          χ (a : ZMod q)⁻¹ * centeredTwistedChebyshevSum x q χ := by
  classical
  have hraw := chebyshevProgressionSum_complex_eq_character_average
    (x := x) (q := q) (a := a) ha
  have hone_inv : (1 : DirichletCharacter ℂ q) (a : ZMod q)⁻¹ = 1 := by
    have hunit : IsUnit (a : ZMod q) := by
      rw [ZMod.isUnit_iff_coprime]
      exact ha
    rcases hunit with ⟨u, hu⟩
    rw [← hu]
    rw [ZMod.inv_coe_unit]
    exact MulChar.one_apply_coe (R' := ℂ) (u⁻¹)
  simp_rw [centeredTwistedChebyshevSum]
  simp only [Complex.ofReal_sub, Complex.ofReal_div, hraw]
  rw [Finset.mul_sum]
  simp_rw [mul_sub]
  rw [Finset.sum_sub_distrib]
  simp only [mul_ite, mul_zero, Fintype.sum_ite_eq', hone_inv, one_mul]
  rw [← Finset.mul_sum]
  push_cast
  ring

theorem abs_chebyshevProgressionSum_sub_global_le_centered_average
    {x q a : ℕ} [NeZero q] (ha : Nat.Coprime a q) :
    |chebyshevProgressionSum x q a -
        Chebyshev.psi (x : ℝ) / (q.totient : ℝ)| ≤
      (q.totient : ℝ)⁻¹ *
        ∑ χ : DirichletCharacter ℂ q,
          ‖centeredTwistedChebyshevSum x q χ‖ := by
  have hunit : IsUnit (a : ZMod q) := by
    rw [ZMod.isUnit_iff_coprime]
    exact ha
  rcases hunit with ⟨u, hu⟩
  have hχnorm (χ : DirichletCharacter ℂ q) :
      ‖χ (a : ZMod q)⁻¹‖ = 1 := by
    rw [← hu, ZMod.inv_coe_unit]
    exact χ.unit_norm_eq_one (u⁻¹)
  rw [← Real.norm_eq_abs, ← Complex.norm_real]
  change ‖((chebyshevProgressionSum x q a -
      Chebyshev.psi (x : ℝ) / (q.totient : ℝ) : ℝ) : ℂ)‖ ≤ _
  rw [chebyshevProgressionSum_sub_global_eq_centered_character_average ha]
  rw [norm_mul]
  have hinvnorm : ‖(q.totient : ℂ)⁻¹‖ = (q.totient : ℝ)⁻¹ := by
    rw [norm_inv, Complex.norm_natCast]
  rw [hinvnorm]
  apply mul_le_mul_of_nonneg_left
  · apply norm_sum_le_of_le
    intro χ _hχ
    simp only [norm_mul, hχnorm, one_mul, le_refl]
  · positivity

theorem norm_centeredTwistedChebyshevSum_le_log_sq_add_primitive
    {x q : ℕ} (χ : DirichletCharacter ℂ q)
    (hx : 2 ≤ x) (hq : 1 ≤ q) :
    ‖centeredTwistedChebyshevSum x q χ‖ ≤
      (Real.log ((q * x : ℕ) : ℝ)) ^ 2 +
        ‖centeredTwistedChebyshevSum
          x χ.conductor χ.primitiveCharacter‖ := by
  have hq0 : q ≠ 0 := by omega
  let : NeZero q := ⟨hq0⟩
  have hdiff := centeredPrimitive_sub_centered_eq (x := x) χ
  have hraw := norm_primitiveTwistedChebyshevSum_sub_le_log_mul_sq χ hx hq
  have hcenter :
      ‖centeredTwistedChebyshevSum
              x χ.conductor χ.primitiveCharacter -
            centeredTwistedChebyshevSum x q χ‖ ≤
        (Real.log ((q * x : ℕ) : ℝ)) ^ 2 := by
    rw [hdiff]
    exact hraw
  calc
    ‖centeredTwistedChebyshevSum x q χ‖ =
        ‖centeredTwistedChebyshevSum
            x χ.conductor χ.primitiveCharacter -
          (centeredTwistedChebyshevSum
              x χ.conductor χ.primitiveCharacter -
            centeredTwistedChebyshevSum x q χ)‖ := by
      congr 1
      ring
    _ ≤ ‖centeredTwistedChebyshevSum
            x χ.conductor χ.primitiveCharacter‖ +
        ‖centeredTwistedChebyshevSum
              x χ.conductor χ.primitiveCharacter -
            centeredTwistedChebyshevSum x q χ‖ := norm_sub_le _ _
    _ ≤ ‖centeredTwistedChebyshevSum
            x χ.conductor χ.primitiveCharacter‖ +
        (Real.log ((q * x : ℕ) : ℝ)) ^ 2 := by
      simpa [add_comm] using
        (add_le_add_left hcenter
          ‖centeredTwistedChebyshevSum
            x χ.conductor χ.primitiveCharacter‖)
    _ = (Real.log ((q * x : ℕ) : ℝ)) ^ 2 +
        ‖centeredTwistedChebyshevSum
          x χ.conductor χ.primitiveCharacter‖ := by ring

theorem inv_totient_mul_sum_norm_centered_le_log_sq_add_primitive
    {x q : ℕ} (hx : 2 ≤ x) (hq : 1 ≤ q) :
    (q.totient : ℝ)⁻¹ *
        ∑ χ : DirichletCharacter ℂ q,
          ‖centeredTwistedChebyshevSum x q χ‖ ≤
      (Real.log ((q * x : ℕ) : ℝ)) ^ 2 +
        (q.totient : ℝ)⁻¹ *
          ∑ χ : DirichletCharacter ℂ q,
            ‖centeredTwistedChebyshevSum
              x χ.conductor χ.primitiveCharacter‖ := by
  have hq0 : q ≠ 0 := by omega
  let : NeZero q := ⟨hq0⟩
  have hpoint : ∀ χ : DirichletCharacter ℂ q,
      ‖centeredTwistedChebyshevSum x q χ‖ ≤
        (Real.log ((q * x : ℕ) : ℝ)) ^ 2 +
          ‖centeredTwistedChebyshevSum
            x χ.conductor χ.primitiveCharacter‖ := by
    intro χ
    exact norm_centeredTwistedChebyshevSum_le_log_sq_add_primitive χ hx hq
  have hsum :
      ∑ χ : DirichletCharacter ℂ q,
          ‖centeredTwistedChebyshevSum x q χ‖ ≤
        (q.totient : ℝ) * (Real.log ((q * x : ℕ) : ℝ)) ^ 2 +
          ∑ χ : DirichletCharacter ℂ q,
            ‖centeredTwistedChebyshevSum
              x χ.conductor χ.primitiveCharacter‖ := by
    calc
      ∑ χ : DirichletCharacter ℂ q,
          ‖centeredTwistedChebyshevSum x q χ‖ ≤
          ∑ χ : DirichletCharacter ℂ q,
            ((Real.log ((q * x : ℕ) : ℝ)) ^ 2 +
              ‖centeredTwistedChebyshevSum
                x χ.conductor χ.primitiveCharacter‖) := by
        apply Finset.sum_le_sum
        intro χ hχ
        exact hpoint χ
      _ = (q.totient : ℝ) * (Real.log ((q * x : ℕ) : ℝ)) ^ 2 +
          ∑ χ : DirichletCharacter ℂ q,
            ‖centeredTwistedChebyshevSum
              x χ.conductor χ.primitiveCharacter‖ := by
        rw [Finset.sum_add_distrib]
        have hcard : Fintype.card (DirichletCharacter ℂ q) = q.totient := by
          rw [← Nat.card_eq_fintype_card]
          exact DirichletCharacter.card_eq_totient_of_hasEnoughRootsOfUnity ℂ q
        simp [hcard, Finset.sum_const, nsmul_eq_mul]
  have hphi : 0 < (q.totient : ℝ) := by
    exact_mod_cast Nat.totient_pos.mpr (Nat.pos_of_ne_zero hq0)
  have hmul := mul_le_mul_of_nonneg_left hsum
    (inv_nonneg.mpr hphi.le)
  calc
    (q.totient : ℝ)⁻¹ *
        ∑ χ : DirichletCharacter ℂ q,
          ‖centeredTwistedChebyshevSum x q χ‖ ≤
      (q.totient : ℝ)⁻¹ *
        ((q.totient : ℝ) * (Real.log ((q * x : ℕ) : ℝ)) ^ 2 +
          ∑ χ : DirichletCharacter ℂ q,
            ‖centeredTwistedChebyshevSum
              x χ.conductor χ.primitiveCharacter‖) := hmul
    _ = (Real.log ((q * x : ℕ) : ℝ)) ^ 2 +
        (q.totient : ℝ)⁻¹ *
          ∑ χ : DirichletCharacter ℂ q,
            ‖centeredTwistedChebyshevSum
              x χ.conductor χ.primitiveCharacter‖ := by
      field_simp [hphi.ne']

theorem abs_chebyshevProgressionSum_sub_global_le_log_sq_add_primitive_average
    {x q a : ℕ} (hx : 2 ≤ x) (hq : 1 ≤ q)
    (ha : Nat.Coprime a q) :
    |chebyshevProgressionSum x q a -
        Chebyshev.psi (x : ℝ) / (q.totient : ℝ)| ≤
      (Real.log ((q * x : ℕ) : ℝ)) ^ 2 +
        (q.totient : ℝ)⁻¹ *
          ∑ χ : DirichletCharacter ℂ q,
            ‖centeredTwistedChebyshevSum
              x χ.conductor χ.primitiveCharacter‖ := by
  have hq0 : q ≠ 0 := by omega
  let : NeZero q := ⟨hq0⟩
  exact (abs_chebyshevProgressionSum_sub_global_le_centered_average ha).trans
    (inv_totient_mul_sum_norm_centered_le_log_sq_add_primitive hx hq)

/--
The restricted convolution `∑ m * d = t, m ≤ U, d ≤ V, Λ(m) μ(d)` in Vaughan's third term. The
cutoffs are real, while the factor pairs are natural-number divisors.
-/
noncomputable def vaughanThirdCoefficient
    (U V : ℝ) (t : ℕ) : ℝ :=
  ∑ md ∈ t.divisorsAntidiagonal.filter
      (fun md : ℕ × ℕ ↦
        (md.1 : ℝ) ≤ U ∧ (md.2 : ℝ) ≤ V),
    ArithmeticFunction.vonMangoldt md.1 *
      (ArithmeticFunction.moebius md.2 : ℝ)

theorem abs_vaughanThirdCoefficient_le_log
    (U V : ℝ) (t : ℕ) :
    |vaughanThirdCoefficient U V t| ≤ Real.log t := by
  unfold vaughanThirdCoefficient
  calc
    _ ≤ ∑ md ∈ t.divisorsAntidiagonal.filter
        (fun md : ℕ × ℕ ↦ (md.1 : ℝ) ≤ U ∧ (md.2 : ℝ) ≤ V),
        ArithmeticFunction.vonMangoldt md.1 := by
      rw [← Real.norm_eq_abs]
      apply norm_sum_le_of_le
      intro md _hmd
      rw [Real.norm_eq_abs, abs_mul, abs_of_nonneg ArithmeticFunction.vonMangoldt_nonneg]
      exact mul_le_of_le_one_right ArithmeticFunction.vonMangoldt_nonneg
        (by exact_mod_cast ArithmeticFunction.abs_moebius_le_one (n := md.2))
    _ ≤ ∑ md ∈ t.divisorsAntidiagonal, ArithmeticFunction.vonMangoldt md.1 :=
      Finset.sum_le_sum_of_subset_of_nonneg (Finset.filter_subset _ _)
        (fun md _hmd _hnot ↦ ArithmeticFunction.vonMangoldt_nonneg)
    _ = ∑ m ∈ t.divisors, ArithmeticFunction.vonMangoldt m :=
      Nat.sum_divisorsAntidiagonal (fun m _d ↦ ArithmeticFunction.vonMangoldt m)
    _ = Real.log t := ArithmeticFunction.vonMangoldt_sum

theorem norm_vaughanThirdCoefficient_le_log
    (U V : ℝ) (t : ℕ) :
    ‖((vaughanThirdCoefficient U V t : ℝ) : ℂ)‖ ≤ Real.log t := by
  rw [Complex.norm_real, Real.norm_eq_abs]
  exact abs_vaughanThirdCoefficient_le_log U V t

theorem norm_vaughanThirdCoefficient_mul_character_le_log
    (U V : ℝ) (t q : ℕ) (χ : DirichletCharacter ℂ q) :
    ‖((vaughanThirdCoefficient U V t : ℝ) : ℂ) * χ t‖ ≤ Real.log t := by
  rw [norm_mul]
  exact (mul_le_of_le_one_right (norm_nonneg _) (χ.norm_le_one t)).trans
    (norm_vaughanThirdCoefficient_le_log U V t)

theorem norm_vaughanThirdCoefficient_mul_character_le_log_cutoff
    {U V : ℝ} {t q : ℕ} (χ : DirichletCharacter ℂ q)
    (ht : 0 < t) (htU : (t : ℝ) ≤ U) :
    ‖((vaughanThirdCoefficient U V t : ℝ) : ℂ) * χ t‖ ≤ Real.log U :=
  (norm_vaughanThirdCoefficient_mul_character_le_log U V t q χ).trans
    (Real.log_le_log (by exact_mod_cast ht) htU)

end

section
open scoped ContDiff

/--
Dirichlet characters at level `q` whose conductor is exactly `d`, with the conductor equality
retained as a subtype witness.
-/
abbrev charactersOfConductor (q d : ℕ) :=
  {χ : DirichletCharacter ℂ q // χ.conductor = d}

noncomputable instance charactersOfConductorFintype (q d : ℕ) :
    Fintype (charactersOfConductor q d) := Fintype.ofFinite _

theorem card_primitiveCharacters_le_totient
    {q : ℕ} (hq : 0 < q) :
    Fintype.card (primitiveCharacters q) ≤ q.totient := by
  let : NeZero q := ⟨hq.ne'⟩
  calc
    Fintype.card (primitiveCharacters q) ≤
        Fintype.card (DirichletCharacter ℂ q) :=
      Fintype.card_subtype_le _
    _ = Nat.card (DirichletCharacter ℂ q) :=
      Nat.card_eq_fintype_card.symm
    _ = q.totient :=
      DirichletCharacter.card_eq_totient_of_hasEnoughRootsOfUnity ℂ q

/--
For a positive level `q` and a divisor `d`, raising the level gives a bijection from primitive
characters modulo `d` to characters modulo `q` of conductor `d`.
-/
noncomputable def primitiveCharactersEquivConductorFiber
    {q d : ℕ} (hq : 0 < q) (hd : d ∣ q) :
    primitiveCharacters d ≃ charactersOfConductor q d := by
  letI : NeZero q := ⟨by omega⟩
  let f : primitiveCharacters d → charactersOfConductor q d := fun ψ ↦
    ⟨DirichletCharacter.changeLevel hd ψ.1, by
      rw [DirichletCharacter.conductor_changeLevel ψ.1 hd]
      exact (DirichletCharacter.isPrimitive_def ψ.1).mp ψ.2⟩
  have hf_injective : Function.Injective f := by
    intro ψ ψ' h
    apply Subtype.ext
    apply DirichletCharacter.changeLevel_injective hd
    exact congrArg Subtype.val h
  have hf_surjective : Function.Surjective f := by
    intro χ
    rcases χ with ⟨χ, hχ⟩
    subst d
    refine ⟨⟨χ.primitiveCharacter, χ.primitiveCharacter_isPrimitive⟩, ?_⟩
    apply Subtype.ext
    exact χ.changeLevel_primitiveCharacter
  exact Equiv.ofBijective f ⟨hf_injective, hf_surjective⟩

theorem sum_characters_of_conductor_eq_sum_primitive
    {q d : ℕ} (hq : 0 < q) (hd : d ∣ q)
    {M : Type*} [AddCommMonoid M]
    (F : DirichletCharacter ℂ q → M) :
    (∑ χ : charactersOfConductor q d, F χ.1) =
      ∑ ψ : primitiveCharacters d,
        F (DirichletCharacter.changeLevel hd ψ.1) := by
  let : NeZero q := ⟨by omega⟩
  apply Fintype.sum_equiv (primitiveCharactersEquivConductorFiber hq hd).symm
      (fun χ : charactersOfConductor q d ↦ F χ.1)
      (fun ψ : primitiveCharacters d ↦
        F (DirichletCharacter.changeLevel hd ψ.1))
  intro χ
  have hχ := (primitiveCharactersEquivConductorFiber hq hd).apply_symm_apply χ
  exact (congrArg (fun z : charactersOfConductor q d ↦ F z.1) hχ).symm

/--
The conductor of a character modulo positive `q`, packaged as an element of the finite set
`q.divisors`.
-/
noncomputable def conductorDivisor {q : ℕ} (hq : 0 < q)
    (χ : DirichletCharacter ℂ q) : q.divisors :=
  ⟨χ.conductor, Nat.mem_divisors.mpr ⟨χ.conductor_dvd_level, by omega⟩⟩

/--
Identifies the fiber of the divisor-valued conductor map over `d` with characters whose
natural-number conductor equals `d`. The underlying character is unchanged.
-/
noncomputable def conductorFiberEquiv {q : ℕ} (hq : 0 < q)
    (d : q.divisors) :
    {χ : DirichletCharacter ℂ q // conductorDivisor hq χ = d} ≃
      charactersOfConductor q d.1 where
  toFun χ := ⟨χ.1, congrArg Subtype.val χ.2⟩
  invFun χ := ⟨χ.1, Subtype.ext χ.2⟩
  left_inv χ := by
    apply Subtype.ext
    rfl
  right_inv χ := by
    apply Subtype.ext
    rfl

theorem sum_characters_eq_sum_conductor_fibers
    {q : ℕ} (hq : 0 < q)
    {M : Type*} [AddCommMonoid M]
    (F : DirichletCharacter ℂ q → M) :
    (∑ χ : DirichletCharacter ℂ q, F χ) =
      ∑ d : q.divisors,
        ∑ χ : charactersOfConductor q d.1, F χ.1 := by
  let g := conductorDivisor hq
  have hfiber := Fintype.sum_fiberwise g F
  rw [← hfiber]
  apply Fintype.sum_congr
  intro d
  exact Fintype.sum_equiv (conductorFiberEquiv hq d)
    (fun χ : {χ : DirichletCharacter ℂ q // g χ = d} ↦ F χ.1)
    (fun χ : charactersOfConductor q d.1 ↦ F χ.1)
    (fun χ ↦ rfl)

theorem sum_characters_eq_sum_divisor_primitive
    {q : ℕ} (hq : 0 < q)
    {M : Type*} [AddCommMonoid M]
    (F : DirichletCharacter ℂ q → M) :
    (∑ χ : DirichletCharacter ℂ q, F χ) =
      ∑ d : q.divisors,
        ∑ ψ : primitiveCharacters d.1,
          F (DirichletCharacter.changeLevel
            (Nat.dvd_of_mem_divisors d.2) ψ.1) := by
  rw [sum_characters_eq_sum_conductor_fibers hq F]
  apply Fintype.sum_congr
  intro d
  exact sum_characters_of_conductor_eq_sum_primitive hq
    (Nat.dvd_of_mem_divisors d.2) F

/--
Ordered positive integer pairs `(a, b)` with `a * b ≤ Q`, represented inside `(0, Q] × (0, Q]`.
-/
def positiveFactorPairs (Q : ℕ) : Finset (ℕ × ℕ) :=
  (Finset.Ioc 0 Q ×ˢ Finset.Ioc 0 Q).filter
    (fun p ↦ p.1 * p.2 ≤ Q)

theorem sum_positiveFactorPairs_filter_fst_eq_sum_multipliers
    {Q : ℕ} {M : Type*} [AddCommMonoid M]
    (P : ℕ → Prop) [DecidablePred P] (f : ℕ → ℕ → M) :
    (∑ p ∈ (positiveFactorPairs Q).filter (fun p ↦ P p.1),
      f p.1 p.2) =
      ∑ d ∈ Finset.Ioc 0 Q with P d,
        ∑ k ∈ Finset.Ioc 0 (Q / d), f d k := by
  refine Finset.sum_finset_product' _ _ _ ?_
  intro p
  by_cases hp : p.1 = 0
  · simp [positiveFactorPairs, hp]
  have hp0 : 0 < p.1 := Nat.pos_of_ne_zero hp
  have hmul := Nat.le_mul_of_pos_right p.2 hp0
  simp only [positiveFactorPairs, Finset.mem_filter, Finset.mem_product,
    Finset.mem_Ioc, Nat.le_div_iff_mul_le hp0, Nat.mul_comm p.1 p.2]
  by_cases hP : P p.1 <;> simp [hP]
  omega

theorem sum_divisorsAntidiagonal_up_to_eq_sum_positiveFactorPairs
    {Q : ℕ} {M : Type*} [AddCommMonoid M]
    (f : ℕ → ℕ → M) :
    (∑ q ∈ Finset.Ioc 0 Q,
      ∑ p ∈ q.divisorsAntidiagonal, f p.1 p.2) =
      ∑ p ∈ positiveFactorPairs Q, f p.1 p.2 := by
  let T : Finset ℕ := Finset.Ioc 0 Q
  let g : ℕ × ℕ → ℕ := fun p ↦ p.1 * p.2
  have hmaps : ∀ p ∈ positiveFactorPairs Q, g p ∈ T := by
    intro p hp
    rcases Finset.mem_filter.mp hp with ⟨hp, hprod⟩
    rcases Finset.mem_product.mp hp with ⟨hp₁, hp₂⟩
    rw [Finset.mem_Ioc] at hp₁ hp₂
    exact Finset.mem_Ioc.mpr ⟨Nat.mul_pos hp₁.1 hp₂.1, hprod⟩
  have hfiber := Finset.sum_fiberwise_of_maps_to
    (s := positiveFactorPairs Q) (t := T) hmaps
    (fun p ↦ f p.1 p.2)
  rw [← hfiber]
  apply Finset.sum_congr rfl
  intro q hq
  rw [Nat.divisorsAntidiagonal_eq_prod_filter_of_le (N := Q)]
  · apply Finset.sum_congr
    · ext p
      simp only [positiveFactorPairs, g, Finset.mem_filter]
      constructor
      · rintro ⟨hp, hprod⟩
        exact ⟨⟨hp, hprod.le.trans (Finset.mem_Ioc.mp hq).2⟩, hprod⟩
      · rintro ⟨⟨hp, _⟩, hprod⟩
        exact ⟨hp, hprod⟩
    · intro p _
      rfl
  · exact (Finset.mem_Ioc.mp hq).1.ne'
  · exact (Finset.mem_Ioc.mp hq).2

theorem sum_divisors_up_to_eq_sum_positiveFactorPairs
    {Q : ℕ} {M : Type*} [AddCommMonoid M]
    (f : ℕ → ℕ → M) :
    (∑ q ∈ Finset.Ioc 0 Q,
      ∑ d ∈ q.divisors, f q d) =
      ∑ p ∈ positiveFactorPairs Q,
        f (p.1 * p.2) p.1 := by
  calc
    (∑ q ∈ Finset.Ioc 0 Q, ∑ d ∈ q.divisors, f q d) =
        ∑ q ∈ Finset.Ioc 0 Q,
          ∑ p ∈ q.divisorsAntidiagonal,
            f (p.1 * p.2) p.1 := by
      apply Finset.sum_congr rfl
      intro q hq
      rw [← Nat.sum_divisorsAntidiagonal
        (f := fun d _k ↦ f q d)]
      apply Finset.sum_congr rfl
      intro p hp
      rw [Nat.mem_divisorsAntidiagonal] at hp
      rw [hp.1]
    _ = _ :=
      sum_divisorsAntidiagonal_up_to_eq_sum_positiveFactorPairs
        (fun d k ↦ f (d * k) d)

theorem sum_primitive_conductors_up_to_eq_sum_positiveFactorPairs
    {Q : ℕ} {M : Type*} [AddCommMonoid M]
    (F : ∀ {q d : ℕ}, d ∣ q → primitiveCharacters d → M) :
    (∑ q ∈ Finset.Ioc 0 Q,
      ∑ d : q.divisors,
        ∑ ψ : primitiveCharacters d.1,
          F (Nat.dvd_of_mem_divisors d.2) ψ) =
      ∑ p ∈ positiveFactorPairs Q,
        ∑ ψ : primitiveCharacters p.1,
          F (Nat.dvd_mul_right p.1 p.2) ψ := by
  let f : ℕ → ℕ → M := fun q d ↦
    if h : d ∣ q then
      ∑ ψ : primitiveCharacters d, F h ψ
    else 0
  have hdiv :
      (∑ q ∈ Finset.Ioc 0 Q,
        ∑ d : q.divisors,
          ∑ ψ : primitiveCharacters d.1,
            F (Nat.dvd_of_mem_divisors d.2) ψ) =
        ∑ q ∈ Finset.Ioc 0 Q,
          ∑ d ∈ q.divisors, f q d := by
    apply Finset.sum_congr rfl
    intro q hq
    calc
      (∑ d : q.divisors,
          ∑ ψ : primitiveCharacters d.1,
            F (Nat.dvd_of_mem_divisors d.2) ψ) =
          ∑ d : q.divisors, f q d.1 := by
        apply Fintype.sum_congr
        intro d
        simp only [f, dite_eq_left (Nat.dvd_of_mem_divisors d.2)]
      _ = ∑ d ∈ q.divisors, f q d :=
        (Finset.sum_subtype q.divisors
          (fun _ ↦ Iff.rfl) (f q)).symm
  rw [hdiv, sum_divisors_up_to_eq_sum_positiveFactorPairs]
  apply Finset.sum_congr rfl
  intro p hp
  simp only [f, dite_eq_left (Nat.dvd_mul_right p.1 p.2)]

/--
The absolute difference between the progression von Mangoldt sum and the global Chebyshev mass
divided by `φ(q)`. This centers at `ψ(x) / φ(q)`, not at `x / φ(q)`.
-/
noncomputable def centeredProgressionDiscrepancy
    (x q a : ℕ) : ℝ :=
  |chebyshevProgressionSum x q a -
    Chebyshev.psi (x : ℝ) / (q.totient : ℝ)|

/--
The largest centered progression discrepancy over reduced residue classes modulo positive `q`.
Defined to be zero when `q = 0`.
-/
noncomputable def maxCenteredProgressionDiscrepancy
    (x q : ℕ) : ℝ :=
  if hq : 0 < q then
    (coprimeResidues q).sup' (coprimeResidues_nonempty hq)
      (centeredProgressionDiscrepancy x q)
  else 0

/--
The maximum centered progression discrepancy over integer endpoints `2 ≤ y ≤ x` and reduced
residue classes modulo `q`. Defined to be zero when `x < 2`.
-/
noncomputable def maxCenteredProgressionDiscrepancyUpTo
    (x q : ℕ) : ℝ :=
  if hx : 2 ≤ x then
    (Finset.Icc 2 x).sup' (weightedEndpointRange_nonempty hx)
      (fun y ↦ maxCenteredProgressionDiscrepancy y q)
  else 0

theorem maxCenteredProgressionDiscrepancyUpTo_eq_sup_endpoint_residues
    {x q : ℕ} (hx : 2 ≤ x) (hq : 0 < q) :
    maxCenteredProgressionDiscrepancyUpTo x q =
      (Finset.Icc 2 x).sup' (weightedEndpointRange_nonempty hx) (fun y ↦
        (coprimeResidues q).sup' (coprimeResidues_nonempty hq) (fun a ↦
          |chebyshevProgressionSum y q a -
            Chebyshev.psi (y : ℝ) / (q.totient : ℝ)|)) := by
  simp only [maxCenteredProgressionDiscrepancyUpTo, dite_eq_left hx,
    maxCenteredProgressionDiscrepancy, dite_eq_left hq]
  rfl

theorem sum_allModuli_log_sq_le
    (x Q : ℕ) (hx : 2 ≤ x) :
    (∑ q ∈ Finset.Icc 1 Q,
      Real.log ((q * x : ℕ) : ℝ) ^ 2) ≤
      (Q : ℝ) * Real.log ((Q * x : ℕ) : ℝ) ^ 2 := by
  calc
    _ ≤ ∑ _q ∈ Finset.Icc 1 Q, Real.log ((Q * x : ℕ) : ℝ) ^ 2 := by
      apply Finset.sum_le_sum
      intro q hq
      apply pow_le_pow_left₀ (Real.log_natCast_nonneg _)
      apply Real.log_le_log
      · exact_mod_cast Nat.mul_pos (Finset.mem_Icc.mp hq).1 (Nat.zero_lt_of_lt hx)
      · exact_mod_cast Nat.mul_le_mul_right x (Finset.mem_Icc.mp hq).2
    _ = _ := by simp [nsmul_eq_mul]

theorem one_div_nat_sq_le_two_mul_telescoping
    {m : ℕ} (hm : 0 < m) :
    (1 : ℝ) / (m : ℝ) ^ 2 ≤
      2 * ((1 : ℝ) / m - 1 / (m + 1)) := by
  have hmR : (0 : ℝ) < m := by exact_mod_cast hm
  have hmOneR : (1 : ℝ) ≤ m := by
    exact_mod_cast (Nat.one_le_iff_ne_zero.mpr hm.ne')
  have hm1R : (0 : ℝ) < m + 1 := by positivity
  field_simp [ne_of_gt hmR, ne_of_gt hm1R]
  ring_nf
  nlinarith

theorem sum_Ico_one_div_nat_sq_le
    {D Q : ℕ} (hD : 0 < D) (hDQ : D ≤ Q) :
    (∑ m ∈ Finset.Ico D Q, (1 : ℝ) / (m : ℝ) ^ 2) ≤
      2 / (D : ℝ) := by
  calc
    (∑ m ∈ Finset.Ico D Q, (1 : ℝ) / (m : ℝ) ^ 2) ≤
        ∑ m ∈ Finset.Ico D Q,
          2 * ((1 : ℝ) / m - 1 / (m + 1)) := by
      apply Finset.sum_le_sum
      intro m hm
      exact one_div_nat_sq_le_two_mul_telescoping
        (lt_of_lt_of_le hD (Finset.mem_Ico.mp hm).1)
    _ = 2 * ((1 : ℝ) / D - 1 / Q) := by
      rw [← Finset.mul_sum]
      have htel := Finset.sum_Ico_sub (fun m : ℕ => -((1 : ℝ) / m)) hDQ
      simpa only [neg_sub_neg, Nat.cast_add, Nat.cast_one] using
        congrArg (fun x : ℝ => 2 * x) htel
    _ ≤ 2 / (D : ℝ) := by
      have hQnonneg : (0 : ℝ) ≤ 1 / Q := by positivity
      have hle : 2 * ((1 : ℝ) / D - 1 / Q) ≤ 2 * (1 / D) :=
        mul_le_mul_of_nonneg_left (sub_le_self _ hQnonneg) (by norm_num)
      calc
        2 * ((1 : ℝ) / D - 1 / Q) ≤ 2 * (1 / D) := hle
        _ = 2 / (D : ℝ) := by ring

theorem squarefree_le_totient_mul_card_divisors
    {n : ℕ} (hn : Squarefree n) :
    n ≤ n.totient * n.divisors.card := by
  have hn0 : n ≠ 0 := hn.ne_zero
  have htot : n.totient = ∏ p ∈ n.primeFactors, (p - 1) := by
    rw [Nat.totient_eq_div_primeFactors_mul,
      Nat.prod_primeFactors_of_squarefree hn,
      Nat.div_self (Nat.pos_of_ne_zero hn0), one_mul]
  have hcard : n.divisors.card = ∏ p ∈ n.primeFactors, 2 := by
    rw [Nat.card_divisors hn0]
    apply Finset.prod_congr rfl
    intro p hp
    rw [Nat.factorization_eq_one_of_squarefree hn
      (Nat.prime_of_mem_primeFactors hp) (Nat.dvd_of_mem_primeFactors hp)]
  calc
    n = ∏ p ∈ n.primeFactors, p :=
      (Nat.prod_primeFactors_of_squarefree hn).symm
    _ ≤ ∏ p ∈ n.primeFactors, ((p - 1) * 2) := by
      refine Finset.prod_le_prod (fun p hp => Nat.zero_le _) ?_
      intro p hp
      have hp2 := (Nat.prime_of_mem_primeFactors hp).two_le
      omega
    _ = (∏ p ∈ n.primeFactors, (p - 1)) *
        ∏ p ∈ n.primeFactors, 2 := by
      rw [Finset.prod_mul_distrib]
    _ = n.totient * n.divisors.card := by rw [htot, hcard]

theorem inv_totient_le_card_divisors_div
    {n : ℕ} (hn : Squarefree n) :
    (Nat.totient n : ℝ)⁻¹ ≤ (n.divisors.card : ℝ) / n := by
  have hnpos : 0 < n := Nat.pos_of_ne_zero hn.ne_zero
  rw [inv_eq_one_div, div_le_div_iff₀
    (by exact_mod_cast Nat.totient_pos.mpr hnpos) (by exact_mod_cast hnpos)]
  exact_mod_cast (by simpa [mul_comm] using squarefree_le_totient_mul_card_divisors hn)

/-- The squarefree-restricted sum `∑ 1 / (d * φ(d))` over positive integers `d ≤ Q`. -/
noncomputable def squarefreeInvNatTotientSum (Q : ℕ) : ℝ := by
  classical
  exact ∑ d ∈ Finset.Icc 1 Q,
    if Squarefree d then (1 : ℝ) / ((d : ℝ) * Nat.totient d) else 0

/--
Ordered pairs `(a, b) ∈ [1, Q]²` satisfying `a * b ≤ Q`; the square is an ambient indexing set
for the product cutoff.
-/
def boundedPositiveProductPairs (Q : ℕ) : Finset (ℕ × ℕ) :=
  ((Finset.Icc 1 Q) ×ˢ (Finset.Icc 1 Q)).filter
    (fun ab => ab.1 * ab.2 ≤ Q)

theorem sum_card_divisors_div_sq_eq_productPairSum (Q : ℕ) :
    (∑ n ∈ Finset.Icc 1 Q, (n.divisors.card : ℝ) / (n : ℝ) ^ 2) =
      ∑ ab ∈ boundedPositiveProductPairs Q,
        (1 : ℝ) / ((ab.1 : ℝ) ^ 2 * (ab.2 : ℝ) ^ 2) := by
  have h := sum_divisors_up_to_eq_sum_positiveFactorPairs (Q := Q)
    (fun n _ => (1 : ℝ) / (n : ℝ) ^ 2)
  simp only [Finset.sum_const, nsmul_eq_mul, mul_one_div, Nat.cast_mul, mul_pow] at h
  simpa only [boundedPositiveProductPairs, positiveFactorPairs,
    ← Finset.Icc_add_one_left_eq_Ioc, Nat.zero_add] using h

theorem sum_card_divisors_div_sq_le_four (Q : ℕ) :
    (∑ n ∈ Finset.Icc 1 Q, (n.divisors.card : ℝ) / (n : ℝ) ^ 2) ≤ 4 := by
  rw [sum_card_divisors_div_sq_eq_productPairSum]
  calc
    (∑ ab ∈ boundedPositiveProductPairs Q,
        (1 : ℝ) / ((ab.1 : ℝ) ^ 2 * (ab.2 : ℝ) ^ 2)) ≤
        ∑ ab ∈ (Finset.Icc 1 Q) ×ˢ (Finset.Icc 1 Q),
          (1 : ℝ) / ((ab.1 : ℝ) ^ 2 * (ab.2 : ℝ) ^ 2) := by
      apply Finset.sum_le_sum_of_subset_of_nonneg
      · exact Finset.filter_subset _ _
      · intro ab hab habNot
        positivity
    _ = (∑ a ∈ Finset.Icc 1 Q, (1 : ℝ) / (a : ℝ) ^ 2) ^ 2 := by
      rw [Finset.sum_product]
      calc
        (∑ a ∈ Finset.Icc 1 Q, ∑ b ∈ Finset.Icc 1 Q,
            (1 : ℝ) / ((a : ℝ) ^ 2 * (b : ℝ) ^ 2)) =
            ∑ a ∈ Finset.Icc 1 Q,
              ((1 : ℝ) / (a : ℝ) ^ 2) *
                (∑ b ∈ Finset.Icc 1 Q, (1 : ℝ) / (b : ℝ) ^ 2) := by
          apply Finset.sum_congr rfl
          intro a ha
          rw [Finset.mul_sum]
          apply Finset.sum_congr rfl
          intro b hb
          ring
        _ = (∑ a ∈ Finset.Icc 1 Q, (1 : ℝ) / (a : ℝ) ^ 2) ^ 2 := by
          rw [← Finset.sum_mul, pow_two]
    _ ≤ 4 := by
      have htail := sum_Ico_one_div_nat_sq_le (D := 1) (Q := Q + 1)
        Nat.zero_lt_one (by omega)
      have hsum : (∑ a ∈ Finset.Icc 1 Q,
          (1 : ℝ) / (a : ℝ) ^ 2) ≤ 2 := by
        have hinterval : Finset.Ico 1 (Q + 1) = Finset.Icc 1 Q := by
          ext x
          simp
        rw [hinterval] at htail
        norm_num at htail
        simpa only [one_div] using htail
      have hnonneg : 0 ≤ ∑ a ∈ Finset.Icc 1 Q,
          (1 : ℝ) / (a : ℝ) ^ 2 := by
        apply Finset.sum_nonneg
        intro a ha
        exact div_nonneg zero_le_one (sq_nonneg (a : ℝ))
      nlinarith

theorem squarefreeInvNatTotientSum_le_four (Q : ℕ) :
    squarefreeInvNatTotientSum Q ≤ 4 := by
  unfold squarefreeInvNatTotientSum
  calc
    (∑ d ∈ Finset.Icc 1 Q,
        if Squarefree d then (1 : ℝ) / ((d : ℝ) * Nat.totient d) else 0) ≤
        ∑ d ∈ Finset.Icc 1 Q,
          (d.divisors.card : ℝ) / (d : ℝ) ^ 2 := by
      apply Finset.sum_le_sum
      intro d hd
      by_cases hsq : Squarefree d
      · rw [ite_eq_left hsq]
        have hinv := inv_totient_le_card_divisors_div hsq
        have hdNonneg : (0 : ℝ) ≤ 1 / d := by positivity
        calc
          (1 : ℝ) / ((d : ℝ) * Nat.totient d) =
              (1 / (d : ℝ)) * (Nat.totient d : ℝ)⁻¹ := by ring
          _ ≤ (1 / (d : ℝ)) * ((d.divisors.card : ℝ) / d) :=
            mul_le_mul_of_nonneg_left hinv hdNonneg
          _ = (d.divisors.card : ℝ) / (d : ℝ) ^ 2 := by ring
      · rw [ite_eq_right hsq]
        positivity
    _ ≤ 4 := sum_card_divisors_div_sq_le_four Q

theorem squarefree_div_totient_eq_sum_divisors_inv_totient
    {n : ℕ} (hn : Squarefree n) :
    (n : ℝ) / (Nat.totient n : ℝ) =
      ∑ a ∈ n.divisors, (Nat.totient a : ℝ)⁻¹ := by
  classical
  have hn0 : n ≠ 0 := hn.ne_zero
  have hterm : ∀ a ∈ n.divisors,
      (Nat.totient a : ℝ)⁻¹ =
        (Nat.totient (n / a) : ℝ) / (Nat.totient n : ℝ) := by
    intro a ha
    have hadvd : a ∣ n := Nat.dvd_of_mem_divisors ha
    have hmul : a * (n / a) = n := Nat.mul_div_cancel' hadvd
    have hcop : Nat.Coprime a (n / a) := by
      apply Nat.coprime_of_squarefree_mul
      rwa [hmul]
    have hphi : Nat.totient n =
        Nat.totient a * Nat.totient (n / a) := by
      calc
        Nat.totient n = Nat.totient (a * (n / a)) :=
          congrArg Nat.totient hmul.symm
        _ = Nat.totient a * Nat.totient (n / a) := Nat.totient_mul hcop
    have hapos : 0 < a := Nat.pos_of_mem_divisors ha
    have hqpos : 0 < n / a := Nat.div_pos
      (Nat.le_of_dvd (Nat.pos_of_ne_zero hn0) hadvd) hapos
    have hphiA0 : (Nat.totient a : ℝ) ≠ 0 := by
      exact_mod_cast (Nat.ne_of_gt (Nat.totient_pos.mpr hapos))
    have hphiQ0 : (Nat.totient (n / a) : ℝ) ≠ 0 := by
      exact_mod_cast (Nat.ne_of_gt (Nat.totient_pos.mpr hqpos))
    rw [hphi]
    push_cast
    field_simp
  rw [Finset.sum_congr rfl hterm]
  rw [← Finset.sum_div]
  have hsum : (∑ a ∈ n.divisors,
      (Nat.totient (n / a) : ℝ)) = (n : ℝ) := by
    exact_mod_cast
      (Nat.sum_div_divisors n Nat.totient).trans (Nat.sum_totient n)
  rw [hsum]

theorem div_totient_eq_radical_div_totient_radical {n : ℕ} (hn : 0 < n) :
    (n : ℝ) / (n.totient : ℝ) =
      ((UniqueFactorizationMonoid.radical (M := ℕ) n : ℕ) : ℝ) /
        (Nat.totient
          (UniqueFactorizationMonoid.radical (M := ℕ) n) : ℝ) := by
  let r : ℕ := UniqueFactorizationMonoid.radical (M := ℕ) n
  have hr : 0 < r := Nat.radical_pos n
  have hphiNQ : (n.totient : ℚ) =
      (n : ℚ) * ∏ p ∈ n.primeFactors, (1 - (p : ℚ)⁻¹) :=
    Nat.totient_eq_mul_prod_factors n
  have hphiRQ : (r.totient : ℚ) =
      (r : ℚ) * ∏ p ∈ n.primeFactors, (1 - (p : ℚ)⁻¹) := by
    rw [Nat.totient_eq_mul_prod_factors r]
    congr 2
    exact Nat.primeFactors_radical n
  have hphiN : (n.totient : ℝ) =
      (n : ℝ) * ∏ p ∈ n.primeFactors, (1 - (p : ℝ)⁻¹) := by
    simpa using congrArg (Rat.castHom ℝ) hphiNQ
  have hphiR : (r.totient : ℝ) =
      (r : ℝ) * ∏ p ∈ n.primeFactors, (1 - (p : ℝ)⁻¹) := by
    simpa using congrArg (Rat.castHom ℝ) hphiRQ
  have hphiN0 : (n.totient : ℝ) ≠ 0 := by
    exact_mod_cast (Nat.totient_pos.mpr hn).ne'
  have hphiR0 : (r.totient : ℝ) ≠ 0 := by
    exact_mod_cast (Nat.totient_pos.mpr hr).ne'
  apply (div_eq_div_iff hphiN0 hphiR0).2
  rw [hphiN, hphiR]
  ring

theorem inv_totient_eq_sum_squarefree_divisors
    {n : ℕ} (hn : 0 < n) :
    (Nat.totient n : ℝ)⁻¹ =
      ∑ d ∈ n.divisors.filter Squarefree,
        (1 : ℝ) / ((n : ℝ) * Nat.totient d) := by
  let r : ℕ := UniqueFactorizationMonoid.radical (M := ℕ) n
  have hr : 0 < r := Nat.radical_pos n
  have hratio := div_totient_eq_radical_div_totient_radical hn
  have hfilter : n.divisors.filter Squarefree = r.divisors := by
    ext d
    constructor
    · intro hd
      have hdf := Finset.mem_filter.mp hd
      have hdn := (Nat.mem_divisors.mp hdf.1).1
      have hdr : d ∣ r :=
        (UniqueFactorizationMonoid.dvd_radical_iff
          hdf.2.isRadical hn.ne').2 hdn
      exact Nat.mem_divisors.mpr ⟨hdr, (Nat.radical_pos n).ne'⟩
    · intro hd
      have hdr := (Nat.mem_divisors.mp hd).1
      have hsq : Squarefree d :=
        UniqueFactorizationMonoid.squarefree_radical.squarefree_of_dvd hdr
      have hdn : d ∣ n :=
        (UniqueFactorizationMonoid.dvd_radical_iff
          hsq.isRadical hn.ne').1 hdr
      exact Finset.mem_filter.mpr
        ⟨Nat.mem_divisors.mpr ⟨hdn, hn.ne'⟩, hsq⟩
  have hsum := squarefree_div_totient_eq_sum_divisors_inv_totient
    (UniqueFactorizationMonoid.squarefree_radical (a := n))
  have hnR : (0 : ℝ) < n := by exact_mod_cast hn
  calc
    (Nat.totient n : ℝ)⁻¹ =
        (1 / (n : ℝ)) * ((n : ℝ) / Nat.totient n) := by field_simp
    _ = (1 / (n : ℝ)) * ((r : ℝ) / Nat.totient r) := by
      rw [show r = UniqueFactorizationMonoid.radical (M := ℕ) n by rfl]
      rw [hratio]
    _ = (1 / (n : ℝ)) *
        ∑ d ∈ r.divisors, (Nat.totient d : ℝ)⁻¹ := by rw [hsum]
    _ = ∑ d ∈ n.divisors.filter Squarefree,
        (1 : ℝ) / ((n : ℝ) * Nat.totient d) := by
      rw [hfilter, Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro d hd
      ring

/--
The squarefree positive integers at most `K`; no divisibility condition relative to `K` is
imposed.
-/
def squarefreePositiveDivisors (K : ℕ) : Finset ℕ :=
  (Finset.Icc 1 K).filter Squarefree

/-- The reciprocal-totient sum `∑ 1 / φ(k)` over `1 ≤ k ≤ K`, with all terms valued in `ℝ`. -/
noncomputable def reciprocalTotientPrefix (K : ℕ) : ℝ := by
  classical
  exact ∑ k ∈ Finset.Ioc 0 K, (Nat.totient k : ℝ)⁻¹

theorem reciprocalTotientPrefix_le_coefficient_mul_harmonic (K : ℕ) :
    reciprocalTotientPrefix K ≤
      squarefreeInvNatTotientSum K * ((harmonic K : ℚ) : ℝ) := by
  classical
  let S : Finset (Σ _n : ℕ, ℕ) :=
    (Finset.Ioc 0 K).sigma (fun n => n.divisors.filter Squarefree)
  let f : (Σ _n : ℕ, ℕ) → ℕ × ℕ :=
    fun x => (x.2, x.1 / x.2)
  let A : Finset ℕ := squarefreePositiveDivisors K
  let B : Finset ℕ := Finset.Icc 1 K
  let g : ℕ × ℕ → ℝ := fun ab =>
    (1 : ℝ) / ((ab.1 : ℝ) * Nat.totient ab.1) * (1 / (ab.2 : ℝ))
  have hinj : Set.InjOn f S := by
    intro x hx y hy hxy
    have hxmem := Finset.mem_sigma.mp hx
    have hymem := Finset.mem_sigma.mp hy
    have hd : x.2 = y.2 := congrArg Prod.fst hxy
    have hprod : x.2 * (x.1 / x.2) = y.2 * (y.1 / y.2) :=
      congrArg (fun z : ℕ × ℕ => z.1 * z.2) hxy
    apply Sigma.ext
    · calc
        x.1 = x.2 * (x.1 / x.2) :=
          (Nat.mul_div_cancel' (Nat.dvd_of_mem_divisors
            (Finset.mem_filter.mp hxmem.2).1)).symm
        _ = y.2 * (y.1 / y.2) := hprod
        _ = y.1 := Nat.mul_div_cancel' (Nat.dvd_of_mem_divisors
          (Finset.mem_filter.mp hymem.2).1)
    · simp [hd]
  have himage : S.image f ⊆ A ×ˢ B := by
    intro z hz
    obtain ⟨x, hx, rfl⟩ := Finset.mem_image.mp hz
    have hxmem := Finset.mem_sigma.mp hx
    have hn := Finset.mem_Ioc.mp hxmem.1
    have hdmem := Finset.mem_filter.mp hxmem.2
    have hdvd := Nat.dvd_of_mem_divisors hdmem.1
    have hnpos : 0 < x.1 := hn.1
    have hdpos : 0 < x.2 := Nat.pos_of_dvd_of_pos hdvd hnpos
    have hdle : x.2 ≤ x.1 := Nat.le_of_dvd hnpos hdvd
    have hmpos : 0 < x.1 / x.2 := Nat.div_pos hdle hdpos
    apply Finset.mem_product.mpr
    refine ⟨Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr
      ⟨hdpos, hdle.trans hn.2⟩, hdmem.2⟩, ?_⟩
    exact Finset.mem_Icc.mpr
      ⟨hmpos, (Nat.div_le_self _ _).trans hn.2⟩
  calc
    reciprocalTotientPrefix K =
        ∑ n ∈ Finset.Ioc 0 K,
          ∑ d ∈ n.divisors.filter Squarefree,
            (1 : ℝ) / ((n : ℝ) * Nat.totient d) := by
      unfold reciprocalTotientPrefix
      apply Finset.sum_congr rfl
      intro n hn
      exact inv_totient_eq_sum_squarefree_divisors (Finset.mem_Ioc.mp hn).1
    _ = ∑ x ∈ S, (1 : ℝ) / ((x.1 : ℝ) * Nat.totient x.2) := by
      unfold S
      rw [Finset.sum_sigma']
    _ = ∑ x ∈ S, g (f x) := by
      apply Finset.sum_congr rfl
      intro x hx
      have hxmem := Finset.mem_sigma.mp hx
      have hdvd := Nat.dvd_of_mem_divisors
        (Finset.mem_filter.mp hxmem.2).1
      have hprod : x.2 * (x.1 / x.2) = x.1 := Nat.mul_div_cancel' hdvd
      have hprodR : (x.1 : ℝ) =
          (x.2 : ℝ) * (x.1 / x.2 : ℕ) := by
        exact_mod_cast hprod.symm
      dsimp [g, f]
      rw [hprodR]
      ring
    _ = ∑ z ∈ S.image f, g z := by
      rw [Finset.sum_image]
      intro a ha b hb hab
      exact hinj ha hb hab
    _ ≤ ∑ z ∈ A ×ˢ B, g z := by
      apply Finset.sum_le_sum_of_subset_of_nonneg himage
      intro z hz hznot
      unfold g
      positivity
    _ = squarefreeInvNatTotientSum K * ((harmonic K : ℚ) : ℝ) := by
      unfold A B g squarefreePositiveDivisors
      rw [Finset.sum_product]
      calc
        (∑ d ∈ (Finset.Icc 1 K).filter Squarefree,
            ∑ m ∈ Finset.Icc 1 K,
              (1 : ℝ) / ((d : ℝ) * Nat.totient d) *
                (1 / (m : ℝ))) =
            ∑ d ∈ (Finset.Icc 1 K).filter Squarefree,
              ((1 : ℝ) / ((d : ℝ) * Nat.totient d)) *
                (∑ m ∈ Finset.Icc 1 K, (1 / (m : ℝ))) := by
          apply Finset.sum_congr rfl
          intro d hd
          rw [Finset.mul_sum]
        _ = (∑ d ∈ Finset.Icc 1 K,
              if Squarefree d then
                (1 : ℝ) / ((d : ℝ) * Nat.totient d) else 0) *
            (∑ m ∈ Finset.Icc 1 K, (1 / (m : ℝ))) := by
          rw [← Finset.sum_filter]
          rw [Finset.sum_mul]
        _ = squarefreeInvNatTotientSum K * ((harmonic K : ℚ) : ℝ) := by
          rw [show (∑ d ∈ Finset.Icc 1 K,
                if Squarefree d then
                  (1 : ℝ) / ((d : ℝ) * Nat.totient d) else 0) =
              squarefreeInvNatTotientSum K by rfl]
          rw [harmonic_eq_sum_Icc]
          norm_num [Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast]

theorem reciprocalTotientPrefix_le_four_mul_harmonic (K : ℕ) :
    reciprocalTotientPrefix K ≤ 4 * ((harmonic K : ℚ) : ℝ) :=
  (reciprocalTotientPrefix_le_coefficient_mul_harmonic K).trans
    (mul_le_mul_of_nonneg_right (squarefreeInvNatTotientSum_le_four K)
      (by unfold harmonic; positivity))

theorem reciprocalTotientPrefix_le_four_mul_one_add_log
    {K : ℕ} (hK : 0 < K) :
    reciprocalTotientPrefix K ≤ 4 * (1 + Real.log K) := by
  calc
    reciprocalTotientPrefix K ≤ 4 * ((harmonic K : ℚ) : ℝ) :=
      reciprocalTotientPrefix_le_four_mul_harmonic K
    _ ≤ 4 * (1 + Real.log K) := by
      apply mul_le_mul_of_nonneg_left
      · have hKreal : (0 : ℝ) < K := by exact_mod_cast hK
        simpa [ne_of_gt hKreal] using harmonic_le_one_add_log K
      · norm_num

theorem inv_totient_mul_le_mul_inv_totient
    {d k : ℕ} (hd : 0 < d) (hk : 0 < k) :
    ((d * k).totient : ℝ)⁻¹ ≤
      (d.totient : ℝ)⁻¹ * (k.totient : ℝ)⁻¹ := by
  rw [← mul_inv]
  exact inv_anti₀
    (by exact_mod_cast mul_pos (Nat.totient_pos.mpr hd) (Nat.totient_pos.mpr hk))
    (by exact_mod_cast Nat.totient_super_multiplicative d k)

theorem sum_inv_totient_mul_le_inv_totient_mul_sum
    (Q d : ℕ) (hd : 0 < d) :
    (∑ k ∈ Finset.Ioc 0 (Q / d),
      ((d * k).totient : ℝ)⁻¹) ≤
      (d.totient : ℝ)⁻¹ *
        ∑ k ∈ Finset.Ioc 0 (Q / d),
          (k.totient : ℝ)⁻¹ := by
  rw [Finset.mul_sum]
  exact Finset.sum_le_sum fun k hk =>
    inv_totient_mul_le_mul_inv_totient hd (Finset.mem_Ioc.mp hk).1

theorem primitiveCharacter_ne_one_of_one_lt
    {d : ℕ} (hd : 1 < d) (ψ : primitiveCharacters d) :
    ψ.1 ≠ (1 : DirichletCharacter ℂ d) := by
  let : NeZero d := ⟨by omega⟩
  intro hψ
  have hconductorOne : ψ.1.conductor = 1 :=
    (DirichletCharacter.eq_one_iff_conductor_eq_one).mp hψ
  have hconductorLevel : ψ.1.conductor = d :=
    (DirichletCharacter.isPrimitive_def ψ.1).mp ψ.2
  omega

theorem centeredTwistedChebyshevSum_eq_twisted_of_primitive
    {y d : ℕ} (hd : 1 < d) (ψ : primitiveCharacters d) :
    centeredTwistedChebyshevSum y d ψ.1 =
      twistedChebyshevSum y d ψ.1 := by
  classical
  simp [centeredTwistedChebyshevSum,
    primitiveCharacter_ne_one_of_one_lt hd ψ]

/--
The maximum norm of the uncentered twisted Chebyshev sum for a primitive character over integer
endpoints `2 ≤ y ≤ x`. The value is zero for `x < 2`.
-/
noncomputable def primitiveRawEndpointMaximum
    (x d : ℕ) (ψ : primitiveCharacters d) : ℝ :=
  if hx : 2 ≤ x then
    (Finset.Icc 2 x).sup' (weightedEndpointRange_nonempty hx)
      (fun y ↦ ‖twistedChebyshevSum y d ψ.1‖)
  else 0

theorem primitiveRawEndpointMaximum_nonneg
    (x d : ℕ) (ψ : primitiveCharacters d) :
    0 ≤ primitiveRawEndpointMaximum x d ψ := by
  unfold primitiveRawEndpointMaximum
  split_ifs with hx
  · exact (norm_nonneg _).trans (Finset.le_sup'
      (fun y ↦ ‖twistedChebyshevSum y d ψ.1‖)
      (weightedEndpointRange_nonempty hx).choose_spec)
  · rfl

theorem sum_primitiveRawEndpointMaximum_nonneg (x d : ℕ) :
    0 ≤ ∑ ψ : primitiveCharacters d,
      primitiveRawEndpointMaximum x d ψ := by
  apply Finset.sum_nonneg
  intro ψ hψ
  exact primitiveRawEndpointMaximum_nonneg x d ψ

/-- Classical decidability of the strict real cutoff `Q1 < (q : ℝ)` on natural moduli. -/
noncomputable local instance realCutoffDecidableForMeanNormalization
    (Q1 : ℝ) : DecidablePred (fun q : ℕ ↦ Q1 < (q : ℝ)) :=
  Classical.decPred _

end

section
open scoped ContDiff

/--
Positive integers `d ≤ y` satisfying the real cutoff `d ≤ V`, used to index the truncated Möbius
factor in Vaughan's second term.
-/
noncomputable def vaughanSecondTermIndices (V : ℝ) (y : ℕ) : Finset ℕ :=
  (Finset.Icc 1 y).filter (fun d : ℕ ↦ (d : ℝ) ≤ V)

/--
Positive ordered factor pairs whose product is at most `y`, used to rearrange the second Vaughan
sum.
-/
def vaughanSecondTermFactorPairs (y : ℕ) : Finset (ℕ × ℕ) :=
  (Finset.Ioc 0 y ×ˢ Finset.Ioc 0 y).filter
    (fun p ↦ p.1 * p.2 ≤ y)

theorem sum_divisorsAntidiagonal_up_to_eq_sum_secondTermFactorPairs
    {y : ℕ} {M : Type*} [AddCommMonoid M] (f : ℕ → ℕ → M) :
    (∑ n ∈ Finset.Ioc 0 y,
      ∑ p ∈ n.divisorsAntidiagonal, f p.1 p.2) =
      ∑ p ∈ vaughanSecondTermFactorPairs y, f p.1 p.2 :=
  sum_divisorsAntidiagonal_up_to_eq_sum_positiveFactorPairs f

theorem mem_secondTermFactorPairs_filter_iff
    {V : ℝ} {y : ℕ} (p : ℕ × ℕ) :
    p ∈ (vaughanSecondTermFactorPairs y).filter
        (fun p ↦ (p.2 : ℝ) ≤ V) ↔
      p.2 ∈ vaughanSecondTermIndices V y ∧
        p.1 ∈ Finset.Icc 1 (y / p.2) := by
  by_cases hp : p.2 = 0
  · simp [vaughanSecondTermFactorPairs, vaughanSecondTermIndices, hp]
  have hp0 : 0 < p.2 := Nat.pos_of_ne_zero hp
  have hmul := Nat.le_mul_of_pos_right p.1 hp0
  simp only [vaughanSecondTermFactorPairs, vaughanSecondTermIndices,
    Finset.mem_filter, Finset.mem_product, Finset.mem_Ioc, Finset.mem_Icc,
    Nat.le_div_iff_mul_le hp0]
  by_cases hV : (p.2 : ℝ) ≤ V <;> simp [hV]
  omega

theorem card_vaughanSecondTermIndices_le_cutoff
    {V : ℝ} (hV : 1 ≤ V) (y : ℕ) :
    ((vaughanSecondTermIndices V y).card : ℝ) ≤ V := by
  have hsubset : vaughanSecondTermIndices V y ⊆ Finset.Icc 1 ⌊V⌋₊ := by
    intro d hd
    rcases Finset.mem_filter.mp hd with ⟨hdy, hdV⟩
    exact Finset.mem_Icc.mpr
      ⟨(Finset.mem_Icc.mp hdy).1, Nat.le_floor hdV⟩
  have hcard := Finset.card_le_card hsubset
  calc
    ((vaughanSecondTermIndices V y).card : ℝ) ≤
        ((Finset.Icc 1 ⌊V⌋₊).card : ℝ) := by exact_mod_cast hcard
    _ = (⌊V⌋₊ : ℝ) := by simp [Nat.card_Icc]
    _ ≤ V := Nat.floor_le (zero_le_one.trans hV)

/--
The maximum norm of `dirichletCharacterIntervalSum a b q χ` as its starting point ranges over `1
≤ a ≤ x`, with fixed endpoint `b`. It is zero when `x = 0`.
-/
noncomputable def dirichletCharacterSuffixMaximum
    (x b q : ℕ) (χ : DirichletCharacter ℂ q) : ℝ :=
  if hx : 1 ≤ x then
    (Finset.Icc 1 x).sup'
      ⟨1, Finset.mem_Icc.mpr ⟨le_rfl, hx⟩⟩
      (fun a ↦ ‖dirichletCharacterIntervalSum a b q χ‖)
  else 0

theorem sum_log_sub_log_natPred_Icc (H : ℕ) :
    (∑ a ∈ Finset.Icc 2 H,
      (Real.log a - Real.log ((a - 1 : ℕ) : ℝ))) = Real.log H := by
  induction H with
  | zero => simp
  | succ H ih =>
      by_cases hH : 2 ≤ H + 1
      · rw [Finset.sum_Icc_succ_top hH, ih]
        have hpred : H + 1 - 1 = H := by omega
        rw [hpred]
        ring
      · have hzero : H = 0 := by omega
        subst H
        simp

theorem sum_character_mul_log_eq_sum_logIncrement_mul_suffixes
    (H q : ℕ) (χ : DirichletCharacter ℂ q) :
    (∑ h ∈ Finset.Icc 1 H, χ h * (Real.log h : ℂ)) =
      ∑ a ∈ Finset.Icc 2 H,
        ((Real.log a - Real.log ((a - 1 : ℕ) : ℝ) : ℝ) : ℂ) *
          dirichletCharacterIntervalSum a H q χ := by
  have htail (a : ℕ) (ha : a ∈ Finset.Icc 2 H) :
      dirichletCharacterIntervalSum a H q χ =
        ∑ h ∈ Finset.Icc 1 H, if a ≤ h then χ h else 0 := by
    have hfinset :
        Finset.Icc a H =
          (Finset.Icc 1 H).filter (fun h : ℕ ↦ a ≤ h) := by
      have haBounds := Finset.mem_Icc.mp ha
      ext h
      simp only [Finset.mem_Icc, Finset.mem_filter]
      omega
    rw [dirichletCharacterIntervalSum, hfinset, Finset.sum_filter]
  symm
  calc
    (∑ a ∈ Finset.Icc 2 H,
        ((Real.log a - Real.log ((a - 1 : ℕ) : ℝ) : ℝ) : ℂ) *
          dirichletCharacterIntervalSum a H q χ) =
        ∑ a ∈ Finset.Icc 2 H,
          ((Real.log a - Real.log ((a - 1 : ℕ) : ℝ) : ℝ) : ℂ) *
            ∑ h ∈ Finset.Icc 1 H, if a ≤ h then χ h else 0 := by
      apply Finset.sum_congr rfl
      intro a ha
      rw [htail a ha]
    _ = ∑ h ∈ Finset.Icc 1 H,
        ∑ a ∈ Finset.Icc 2 H,
          ((Real.log a - Real.log ((a - 1 : ℕ) : ℝ) : ℝ) : ℂ) *
            (if a ≤ h then χ h else 0) := by
      simp_rw [Finset.mul_sum]
      rw [Finset.sum_comm]
    _ = ∑ h ∈ Finset.Icc 1 H, χ h * (Real.log h : ℂ) := by
      apply Finset.sum_congr rfl
      intro h hh
      have hfilter :
          (Finset.Icc 2 H).filter (fun a : ℕ ↦ a ≤ h) =
            Finset.Icc 2 h := by
        have hhBounds := Finset.mem_Icc.mp hh
        ext a
        simp only [Finset.mem_filter, Finset.mem_Icc]
        omega
      have hsumCast :
          (∑ a ∈ Finset.Icc 2 h,
            ((Real.log a - Real.log ((a - 1 : ℕ) : ℝ) : ℝ) : ℂ)) =
              (Real.log h : ℂ) :=
        by
          rw [← Complex.ofReal_sum]
          exact congrArg (fun r : ℝ ↦ (r : ℂ))
            (sum_log_sub_log_natPred_Icc h)
      calc
        (∑ a ∈ Finset.Icc 2 H,
            ((Real.log a - Real.log ((a - 1 : ℕ) : ℝ) : ℝ) : ℂ) *
              (if a ≤ h then χ h else 0)) =
            (∑ a ∈ Finset.Icc 2 H,
              if a ≤ h then
                ((Real.log a - Real.log ((a - 1 : ℕ) : ℝ) : ℝ) : ℂ)
              else 0) * χ h := by
          rw [Finset.sum_mul]
          apply Finset.sum_congr rfl
          intro a _ha
          split_ifs <;> simp
        _ = (∑ a ∈ Finset.Icc 2 h,
              ((Real.log a - Real.log ((a - 1 : ℕ) : ℝ) : ℝ) : ℂ)) * χ h := by
          rw [← Finset.sum_filter, hfilter]
        _ = χ h * (Real.log h : ℂ) := by
          rw [hsumCast]
          exact mul_comm _ _

theorem norm_dirichletCharacterIntervalSum_le_suffixMaximum
    {a x b q : ℕ} (ha : a ∈ Finset.Icc 1 x)
    (χ : DirichletCharacter ℂ q) :
    ‖dirichletCharacterIntervalSum a b q χ‖ ≤
      dirichletCharacterSuffixMaximum x b q χ := by
  unfold dirichletCharacterSuffixMaximum
  split_ifs with hx
  · exact Finset.le_sup' (fun c ↦ ‖dirichletCharacterIntervalSum c b q χ‖) ha
  · exact False.elim
      (hx ((Finset.mem_Icc.mp ha).1.trans (Finset.mem_Icc.mp ha).2))

theorem norm_sum_character_mul_log_le_log_mul_suffixMaximum
    {H x q : ℕ} (hH : H ≤ x) (hx : 1 ≤ x)
    (χ : DirichletCharacter ℂ q) :
    ‖∑ h ∈ Finset.Icc 1 H, χ h * (Real.log h : ℂ)‖ ≤
      Real.log x * dirichletCharacterSuffixMaximum x H q χ := by
  rw [sum_character_mul_log_eq_sum_logIncrement_mul_suffixes]
  have hmaxNonneg :
      0 ≤ dirichletCharacterSuffixMaximum x H q χ :=
    (norm_nonneg (dirichletCharacterIntervalSum 1 H q χ)).trans
      (norm_dirichletCharacterIntervalSum_le_suffixMaximum
        (Finset.mem_Icc.mpr ⟨le_rfl, hx⟩) χ)
  calc
    _ ≤ ∑ a ∈ Finset.Icc 2 H,
        (Real.log a - Real.log ((a - 1 : ℕ) : ℝ)) *
          dirichletCharacterSuffixMaximum x H q χ := by
      apply norm_sum_le_of_le
      intro a ha
      have haBounds := Finset.mem_Icc.mp ha
      have hpredPos : 0 < ((a - 1 : ℕ) : ℝ) := by
        exact_mod_cast (show 0 < a - 1 by omega)
      have hpredLe : ((a - 1 : ℕ) : ℝ) ≤ (a : ℝ) := by
        exact_mod_cast Nat.sub_le a 1
      have hdelta :
          0 ≤ Real.log a - Real.log ((a - 1 : ℕ) : ℝ) :=
        sub_nonneg.mpr (Real.log_le_log hpredPos hpredLe)
      rw [norm_mul, Complex.norm_real, Real.norm_of_nonneg hdelta]
      gcongr
      exact norm_dirichletCharacterIntervalSum_le_suffixMaximum
        (Finset.mem_Icc.mpr ⟨by omega, haBounds.2.trans hH⟩) χ
    _ = Real.log H * dirichletCharacterSuffixMaximum x H q χ := by
      rw [← Finset.sum_mul, sum_log_sub_log_natPred_Icc]
    _ ≤ Real.log x * dirichletCharacterSuffixMaximum x H q χ := by
      by_cases hHzero : H = 0
      · subst H
        simp only [Nat.cast_zero, Real.log_zero, zero_mul]
        exact mul_nonneg (Real.log_nonneg (by exact_mod_cast hx)) hmaxNonneg
      · apply mul_le_mul_of_nonneg_right _ hmaxNonneg
        exact Real.log_le_log
          (by exact_mod_cast (Nat.pos_of_ne_zero hHzero))
          (by exact_mod_cast hH)

theorem sum_inv_vaughanSecondTermIndices_le_one_add_log
    {V : ℝ} (hV : 1 ≤ V) (y : ℕ) :
    (∑ d ∈ vaughanSecondTermIndices V y, ((d : ℝ))⁻¹) ≤
      1 + Real.log V := by
  have hsubset :
      vaughanSecondTermIndices V y ⊆ Finset.Icc 1 ⌊V⌋₊ := by
    intro d hd
    rcases Finset.mem_filter.mp hd with ⟨hdy, hdV⟩
    exact Finset.mem_Icc.mpr
      ⟨(Finset.mem_Icc.mp hdy).1, Nat.le_floor hdV⟩
  calc
    (∑ d ∈ vaughanSecondTermIndices V y, ((d : ℝ))⁻¹) ≤
        ∑ d ∈ Finset.Icc 1 ⌊V⌋₊, ((d : ℝ))⁻¹ := by
      apply Finset.sum_le_sum_of_subset_of_nonneg hsubset
      intro d _hd _hnot
      positivity
    _ = ((harmonic ⌊V⌋₊ : ℚ) : ℝ) := by
      rw [harmonic_eq_sum_Icc]
      simp only [Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast]
    _ ≤ 1 + Real.log V := harmonic_floor_le_one_add_log V hV

theorem norm_dirichletCharacterIntervalSum_level_one_le_upper
    {a b : ℕ} (ha : 1 ≤ a) (chi : DirichletCharacter ℂ 1) :
    ‖dirichletCharacterIntervalSum a b 1 chi‖ ≤ (b : ℝ) := by
  have h := norm_sum_le_of_le (Finset.Icc a b) fun n _ => chi.norm_le_one n
  simp only [Finset.sum_const, nsmul_eq_mul, mul_one, Nat.card_Icc] at h
  exact h.trans (by exact_mod_cast (show b + 1 - a ≤ b by omega))

/-- The principal character at level `1`, equipped with its proof of primitivity. -/
noncomputable def primitiveCharacterOne : primitiveCharacters 1 :=
  ⟨(1 : DirichletCharacter ℂ 1),
    DirichletCharacter.isPrimitive_one_level_one⟩

/--
The unique primitive character modulo `1`, with the principal character as the distinguished
value.
-/
noncomputable local instance primitiveCharactersOneUnique :
    Unique (primitiveCharacters 1) where
  default := primitiveCharacterOne
  uniq chi := by
    apply Subtype.ext
    exact DirichletCharacter.level_one chi.1

end

section
open scoped ContDiff

/-- The positive indices `t ≤ y` in the small part `t ≤ U` of the third Vaughan term. -/
noncomputable def vaughanThirdSmallIndices (U : ℝ) (y : ℕ) : Finset ℕ :=
  (Finset.Icc 1 y).filter (fun t : ℕ ↦ (t : ℝ) ≤ U)

/-- The positive indices `t ≤ y` in the large part `U < t ≤ U * V` of the third Vaughan term. -/
noncomputable def vaughanThirdLargeIndices (U V : ℝ) (y : ℕ) : Finset ℕ :=
  (Finset.Icc 1 y).filter
    (fun t : ℕ ↦ U < (t : ℝ) ∧ (t : ℝ) ≤ U * V)

/--
The unsigned small-index contribution to Vaughan's third sum, combining its truncated
convolution coefficient with `χ(t)` and the character sum up to `y / t`. The minus sign in the
full third term is not included.
-/
noncomputable def vaughanTwistedSumThreeSmall
    (U V : ℝ) (y q : ℕ) (χ : DirichletCharacter ℂ q) : ℂ :=
  ∑ t ∈ vaughanThirdSmallIndices U y,
    ((vaughanThirdCoefficient U V t : ℝ) : ℂ) * χ t *
      dirichletCharacterIntervalSum 1 (y / t) q χ

/--
The unsigned large-index contribution to Vaughan's third sum over `U < t ≤ U * V`, truncated at
`y`. Each coefficient is multiplied by `χ(t)` and the character sum up to `y / t`.
-/
noncomputable def vaughanTwistedSumThreeLarge
    (U V : ℝ) (y q : ℕ) (χ : DirichletCharacter ℂ q) : ℂ :=
  ∑ t ∈ vaughanThirdLargeIndices U V y,
    ((vaughanThirdCoefficient U V t : ℝ) : ℂ) * χ t *
      dirichletCharacterIntervalSum 1 (y / t) q χ

theorem mem_positiveFactorPairs_iff
    {y : ℕ} (p : ℕ × ℕ) :
    p ∈ positiveFactorPairs y ↔
      p.1 ∈ Finset.Icc 1 y ∧ p.2 ∈ Finset.Icc 1 (y / p.1) := by
  by_cases hp : p.1 = 0
  · simp [positiveFactorPairs, hp]
  have hp0 : 0 < p.1 := Nat.pos_of_ne_zero hp
  have hmul := Nat.le_mul_of_pos_right p.2 hp0
  simp only [positiveFactorPairs, Finset.mem_filter, Finset.mem_product,
    Finset.mem_Ioc, Finset.mem_Icc, Nat.le_div_iff_mul_le hp0, Nat.mul_comm p.1 p.2]
  omega

theorem vaughanThirdCoefficient_eq_zero_of_cutoffProduct_lt
    {U V : ℝ} (hU : 0 ≤ U) (_hV : 0 ≤ V) {t : ℕ}
    (ht : U * V < (t : ℝ)) :
    vaughanThirdCoefficient U V t = 0 := by
  unfold vaughanThirdCoefficient
  apply Finset.sum_eq_zero
  intro md hmd
  rcases Finset.mem_filter.mp hmd with ⟨hmd, hcut⟩
  have hanti := Nat.mem_divisorsAntidiagonal.mp hmd
  have hle : (t : ℝ) ≤ U * V := by
    calc
      (t : ℝ) = (md.1 : ℝ) * (md.2 : ℝ) := by
        exact_mod_cast hanti.1.symm
      _ ≤ U * V := mul_le_mul hcut.1 hcut.2 (Nat.cast_nonneg _) hU
  exact False.elim ((not_le_of_gt ht) hle)

theorem card_vaughanThirdSmallIndices_le_cutoff
    {U : ℝ} (hU : 1 ≤ U) (y : ℕ) :
    ((vaughanThirdSmallIndices U y).card : ℝ) ≤ U :=
  card_vaughanSecondTermIndices_le_cutoff hU y

theorem norm_vaughanTwistedSumThreeSmall_le_log_mul_sum_prefix
    {U V : ℝ} {y q : ℕ} (χ : DirichletCharacter ℂ q) :
    ‖vaughanTwistedSumThreeSmall U V y q χ‖ ≤
      Real.log U *
        ∑ t ∈ vaughanThirdSmallIndices U y,
          ‖dirichletCharacterIntervalSum 1 (y / t) q χ‖ := by
  unfold vaughanTwistedSumThreeSmall
  rw [Finset.mul_sum]
  apply norm_sum_le_of_le
  intro t ht
  rcases Finset.mem_filter.mp ht with ⟨hty, htU⟩
  rw [norm_mul]
  exact mul_le_mul_of_nonneg_right
    (norm_vaughanThirdCoefficient_mul_character_le_log_cutoff χ
      (Finset.mem_Icc.mp hty).1 htU) (norm_nonneg _)

theorem norm_dirichletCharacterPrefixSum_le_upper
    {b q : ℕ} (χ : DirichletCharacter ℂ q) :
    ‖dirichletCharacterIntervalSum 1 b q χ‖ ≤ (b : ℝ) := by
  simpa [dirichletCharacterIntervalSum, Nat.card_Icc] using
    norm_sum_le_of_le (Finset.Icc 1 b) (fun n _ => χ.norm_le_one n)

theorem norm_vaughanTwistedSumThreeSmall_level_one_le_endpoint_mul_log_mul_one_add_log
    {U V : ℝ} {y : ℕ} (hU : 1 ≤ U)
    (χ : DirichletCharacter ℂ 1) :
    ‖vaughanTwistedSumThreeSmall U V y 1 χ‖ ≤
      (y : ℝ) * Real.log U * (1 + Real.log U) := by
  have hlogU : 0 ≤ Real.log U := Real.log_nonneg hU
  calc
    ‖vaughanTwistedSumThreeSmall U V y 1 χ‖ ≤
        Real.log U *
          ∑ t ∈ vaughanThirdSmallIndices U y,
            ‖dirichletCharacterIntervalSum 1 (y / t) 1 χ‖ :=
      norm_vaughanTwistedSumThreeSmall_le_log_mul_sum_prefix χ
    _ ≤ Real.log U *
        ∑ t ∈ vaughanThirdSmallIndices U y,
          (y : ℝ) * ((t : ℝ))⁻¹ := by
      gcongr with t _ht
      calc
        ‖dirichletCharacterIntervalSum 1 (y / t) 1 χ‖ ≤
            ((y / t : ℕ) : ℝ) :=
          norm_dirichletCharacterPrefixSum_le_upper χ
        _ ≤ (y : ℝ) / (t : ℝ) := Nat.cast_div_le
        _ = (y : ℝ) * ((t : ℝ))⁻¹ := by rw [div_eq_mul_inv]
    _ = (y : ℝ) * Real.log U *
        ∑ t ∈ vaughanThirdSmallIndices U y, ((t : ℝ))⁻¹ := by
      rw [← Finset.mul_sum]
      ring
    _ ≤ (y : ℝ) * Real.log U * (1 + Real.log U) := by
      gcongr
      simpa [vaughanThirdSmallIndices, vaughanSecondTermIndices] using
        sum_inv_vaughanSecondTermIndices_le_one_add_log hU y

theorem norm_vaughanTwistedSumThreeSmall_level_one_lt_endpoint_mul_log_sq
    {U V : ℝ} {x y : ℕ}
    (hx : 4 ≤ x) (hU : 1 ≤ U) (hyx : y ≤ x)
    (χ : DirichletCharacter ℂ 1) :
    ‖vaughanTwistedSumThreeSmall U V y 1 χ‖ <
      (x : ℝ) * (Real.log ((x : ℝ) * U)) ^ 2 := by
  have hxpos : (0 : ℝ) < x := by
    exact_mod_cast (show 0 < x by omega)
  have hxone : (1 : ℝ) < x := by
    exact_mod_cast (show 1 < x by omega)
  have hUpos : (0 : ℝ) < U := zero_lt_one.trans_le hU
  have hlogU : 0 ≤ Real.log U := Real.log_nonneg hU
  have hlogTwo : (2 / 3 : ℝ) < Real.log 2 := by
    convert Real.lt_log_one_add_of_pos (x := (1 : ℝ)) (by norm_num) using 1 <;>
      norm_num
  have hlogFour : (4 / 3 : ℝ) < Real.log 4 := by
    calc
      (4 / 3 : ℝ) = 2 * (2 / 3) := by ring
      _ < 2 * Real.log 2 := by nlinarith
      _ = Real.log 4 := by
        rw [show (4 : ℝ) = 2 * 2 by norm_num,
          Real.log_mul (by norm_num) (by norm_num)]
        ring
  have hlogFourLe : Real.log (4 : ℝ) ≤ Real.log (x : ℝ) :=
    Real.log_le_log (by norm_num) (by exact_mod_cast hx)
  have hlogx : 1 < Real.log (x : ℝ) := by linarith
  have hlogStrict :
      Real.log U * (1 + Real.log U) <
        (Real.log ((x : ℝ) * U)) ^ 2 := by
    rw [Real.log_mul hxpos.ne' hUpos.ne']
    have hterm :
        0 ≤ Real.log U * (2 * Real.log (x : ℝ) - 1) :=
      mul_nonneg hlogU (by linarith)
    have hsquare : 0 < (Real.log (x : ℝ)) ^ 2 :=
      sq_pos_of_pos (zero_lt_one.trans hlogx)
    nlinarith
  have hfactor :
      0 ≤ Real.log U * (1 + Real.log U) := by positivity
  calc
    ‖vaughanTwistedSumThreeSmall U V y 1 χ‖ ≤
        (y : ℝ) * Real.log U * (1 + Real.log U) :=
      norm_vaughanTwistedSumThreeSmall_level_one_le_endpoint_mul_log_mul_one_add_log
        hU χ
    _ ≤ (x : ℝ) * (Real.log U * (1 + Real.log U)) := by
      rw [mul_assoc]
      exact mul_le_mul_of_nonneg_right (by exact_mod_cast hyx) hfactor
    _ < (x : ℝ) * (Real.log ((x : ℝ) * U)) ^ 2 :=
      mul_lt_mul_of_pos_left hlogStrict hxpos

theorem norm_vaughanTwistedSumThreeSmall_lt_sqrt_mul_cutoff_mul_log_sq
    {Q U V : ℝ} {x y q : ℕ}
    (hx : 4 ≤ x) (hU : 1 ≤ U)
    (hq : 1 < q) (hqQ : (q : ℝ) ≤ Q)
    (hQsqrt : Q ≤ Real.sqrt (x : ℝ))
    (χ : DirichletCharacter ℂ q) (hχ : χ.IsPrimitive) :
    ‖vaughanTwistedSumThreeSmall U V y q χ‖ <
      Real.sqrt (q : ℝ) * U *
        (Real.log ((x : ℝ) * U)) ^ 2 := by
  have hqpos : (0 : ℝ) < q := by
    exact_mod_cast Nat.zero_lt_of_lt hq
  have hsqrtq : 0 < Real.sqrt (q : ℝ) := Real.sqrt_pos.2 hqpos
  have hlogq : 0 < Real.log (q : ℝ) :=
    Real.log_pos (by exact_mod_cast hq)
  have hUpos : 0 < U := zero_lt_one.trans_le hU
  have hlogU : 0 ≤ Real.log U := Real.log_nonneg hU
  have hxone : (1 : ℝ) < x := by exact_mod_cast (show 1 < x by omega)
  have hsqrtxlt : Real.sqrt (x : ℝ) < (x : ℝ) :=
    Real.sqrt_lt_self_iff.mpr hxone
  have hxUpos : 0 < (x : ℝ) * U := by positivity
  have hU_lt_xU : U < (x : ℝ) * U := by nlinarith
  have hq_lt_xU : (q : ℝ) < (x : ℝ) * U :=
    (hqQ.trans hQsqrt).trans_lt (hsqrtxlt.trans_le (by nlinarith))
  have hlogU_lt : Real.log U < Real.log ((x : ℝ) * U) :=
    Real.strictMonoOn_log hUpos hxUpos hU_lt_xU
  have hlogq_lt : Real.log (q : ℝ) < Real.log ((x : ℝ) * U) :=
    Real.strictMonoOn_log hqpos hxUpos hq_lt_xU
  have hlogxUpos : 0 < Real.log ((x : ℝ) * U) :=
    Real.log_pos (hxone.trans_le (by nlinarith))
  have hlogs :
      Real.log U * Real.log (q : ℝ) <
        (Real.log ((x : ℝ) * U)) ^ 2 := by
    calc
      Real.log U * Real.log (q : ℝ) <
          Real.log ((x : ℝ) * U) * Real.log (q : ℝ) :=
        mul_lt_mul_of_pos_right hlogU_lt hlogq
      _ < Real.log ((x : ℝ) * U) * Real.log ((x : ℝ) * U) :=
        mul_lt_mul_of_pos_left hlogq_lt hlogxUpos
      _ = (Real.log ((x : ℝ) * U)) ^ 2 := by ring
  have hprefix (t : ℕ) (_ht : t ∈ vaughanThirdSmallIndices U y) :
      ‖dirichletCharacterIntervalSum 1 (y / t) q χ‖ ≤
        Real.sqrt (q : ℝ) * Real.log (q : ℝ) :=
    (norm_dirichletCharacterIntervalSum_lt_sqrt_mul_log
      hq χ hχ 1 (y / t)).le
  calc
    ‖vaughanTwistedSumThreeSmall U V y q χ‖ ≤
        Real.log U *
          ∑ t ∈ vaughanThirdSmallIndices U y,
            ‖dirichletCharacterIntervalSum 1 (y / t) q χ‖ :=
      norm_vaughanTwistedSumThreeSmall_le_log_mul_sum_prefix χ
    _ ≤ Real.log U *
        ∑ _t ∈ vaughanThirdSmallIndices U y,
          Real.sqrt (q : ℝ) * Real.log (q : ℝ) := by
      gcongr with t ht
      exact hprefix t ht
    _ = Real.log U * ((vaughanThirdSmallIndices U y).card : ℝ) *
        (Real.sqrt (q : ℝ) * Real.log (q : ℝ)) := by
      simp [mul_assoc]
    _ ≤ Real.log U * U *
        (Real.sqrt (q : ℝ) * Real.log (q : ℝ)) := by
      gcongr
      exact card_vaughanThirdSmallIndices_le_cutoff hU y
    _ = Real.sqrt (q : ℝ) * U *
        (Real.log U * Real.log (q : ℝ)) := by ring
    _ < Real.sqrt (q : ℝ) * U *
        (Real.log ((x : ℝ) * U)) ^ 2 := by
      gcongr

/--
Dyadic scales `M = 2 ^ alpha` from the range up to `⌊U * V⌋₊` satisfying `U / 2 < M ≤ U * V` and
`M < x`. These select blocks relevant to the large third Vaughan term.
-/
noncomputable def vaughanThirdLargeDyadicExponents
  (U V : ℝ) (x : ℕ) : Finset ℕ :=
  (dyadicExponentRange ⌊U * V⌋₊).filter (fun alpha ↦
    let M : ℕ := 2 ^ alpha
    U / 2 < (M : ℝ) ∧ (M : ℝ) ≤ U * V ∧ M < x)

/--
The large third-term indices up to `x` lying in the half-open dyadic interval `(2 ^ alpha, 2 ^
(alpha + 1)]`.
-/
noncomputable def vaughanThirdLargeDyadicIndices
    (U V : ℝ) (x alpha : ℕ) : Finset ℕ :=
  vaughanThirdLargeIndices U V x ∩ dyadicBlock alpha

/--
The positive auxiliary factors `r ≤ x / 2 ^ alpha` for a dyadic third-term block, using
natural-number division.
-/
def vaughanThirdLargeDyadicRIndices
    (x alpha : ℕ) : Finset ℕ :=
  Finset.Icc 1 (x / 2 ^ alpha)

theorem card_vaughanThirdLargeDyadicExponents_le_log
    {U V : ℝ} (hU : 1 ≤ U) (hV : 1 ≤ V) (x : ℕ) :
    ((vaughanThirdLargeDyadicExponents U V x).card : ℝ) ≤
      Real.log (2 * U * V) / Real.log 2 := by
  have hUnonneg : 0 ≤ U := zero_le_one.trans hU
  have hUV : 1 ≤ U * V := by
    calc
      1 ≤ U := hU
      _ = U * 1 := (mul_one U).symm
      _ ≤ U * V := mul_le_mul_of_nonneg_left hV hUnonneg
  have hfloorPos : 0 < ⌊U * V⌋₊ := Nat.floor_pos.mpr hUV
  have hfloorLe : (⌊U * V⌋₊ : ℝ) ≤ U * V :=
    Nat.floor_le (zero_le_one.trans hUV)
  calc
    ((vaughanThirdLargeDyadicExponents U V x).card : ℝ) ≤
        ((dyadicExponentRange ⌊U * V⌋₊).card : ℝ) := by
      rw [vaughanThirdLargeDyadicExponents]
      exact_mod_cast Finset.card_filter_le
        (dyadicExponentRange ⌊U * V⌋₊) _
    _ ≤ Real.log (2 * (⌊U * V⌋₊ : ℝ)) / Real.log 2 :=
      card_dyadicExponentRange_le_log hfloorPos
    _ ≤ Real.log (2 * U * V) / Real.log 2 := by
      apply div_le_div_of_nonneg_right _ (Real.log_pos (by norm_num)).le
      apply Real.log_le_log (by positivity)
      calc
        2 * (⌊U * V⌋₊ : ℝ) ≤ 2 * (U * V) :=
          mul_le_mul_of_nonneg_left hfloorLe (by norm_num)
        _ = 2 * U * V := by ring

/--
The maximum norm of the large third Vaughan contribution over integer endpoints `1 ≤ y ≤ x`. It
is zero for `x = 0`.
-/
noncomputable def vaughanTwistedSumThreeLargeEndpointMaximum
    (U V : ℝ) (x q : ℕ)
    (chi : DirichletCharacter ℂ q) : ℝ :=
  if hx : 1 ≤ x then
    (Finset.Icc 1 x).sup'
      ⟨1, Finset.mem_Icc.mpr ⟨le_rfl, hx⟩⟩
      (fun y ↦ ‖vaughanTwistedSumThreeLarge U V y q chi‖)
  else 0

theorem le_two_mul_pow_two_mul_div_of_pow_two_lt
    {x alpha : ℕ} (hMlt : 2 ^ alpha < x) :
    x ≤ ((2 ^ alpha + 2 ^ alpha) * (x / 2 ^ alpha)) := by
  have hpos : 0 < 2 ^ alpha := by positivity
  have hdiv : 2 ^ alpha ≤ 2 ^ alpha * (x / 2 ^ alpha) := by
    simpa using Nat.mul_le_mul_left (2 ^ alpha) (Nat.div_pos hMlt.le hpos)
  have hmod := Nat.mod_lt x hpos
  have hid := Nat.mod_add_div x (2 ^ alpha)
  rw [add_mul]
  omega

theorem sum_norm_sq_vaughanThirdCoefficient_dyadic_le
    (U V : ℝ) (x alpha : ℕ) :
    (∑ t ∈ vaughanThirdLargeDyadicIndices U V x alpha,
      ‖((vaughanThirdCoefficient U V t : ℝ) : ℂ)‖ ^ 2) ≤
      ((2 ^ alpha : ℕ) : ℝ) *
        (Real.log (2 * ((2 ^ alpha : ℕ) : ℝ))) ^ 2 := by
  classical
  let M : ℕ := 2 ^ alpha
  have hMpos : 0 < M := by positivity
  have hlogNonneg : 0 ≤ Real.log (2 * (M : ℝ)) :=
    Real.log_nonneg (by exact_mod_cast (show 1 ≤ 2 * M by omega))
  have hcard : (vaughanThirdLargeDyadicIndices U V x alpha).card ≤ M := by
    calc
      (vaughanThirdLargeDyadicIndices U V x alpha).card ≤
          (dyadicBlock alpha).card :=
        Finset.card_le_card Finset.inter_subset_right
      _ = M := by
        rw [dyadicBlock, Nat.card_Ioc, pow_succ]
        dsimp only [M]
        omega
  calc
    (∑ t ∈ vaughanThirdLargeDyadicIndices U V x alpha,
        ‖((vaughanThirdCoefficient U V t : ℝ) : ℂ)‖ ^ 2) ≤
        ∑ _t ∈ vaughanThirdLargeDyadicIndices U V x alpha,
          (Real.log (2 * (M : ℝ))) ^ 2 := by
      apply Finset.sum_le_sum
      intro t ht
      have htBlock := (Finset.mem_inter.mp ht).2
      have htBounds := Finset.mem_Ioc.mp (show t ∈ dyadicBlock alpha from htBlock)
      have htpos : 0 < t := hMpos.trans htBounds.1
      have htUpperNat : t ≤ M + M := by
        calc
          t ≤ 2 ^ (alpha + 1) := htBounds.2
          _ = M + M := by
            rw [pow_succ]
            dsimp only [M]
            omega
      have htUpper : (t : ℝ) ≤ 2 * (M : ℝ) := by
        have htUpperNat' : t ≤ 2 * M := by omega
        exact_mod_cast htUpperNat'
      have hnorm : ‖((vaughanThirdCoefficient U V t : ℝ) : ℂ)‖ ≤
          Real.log (2 * (M : ℝ)) :=
        (norm_vaughanThirdCoefficient_le_log U V t).trans
          (Real.log_le_log (by exact_mod_cast htpos) htUpper)
      exact (sq_le_sq₀ (norm_nonneg _) hlogNonneg).2 hnorm
    _ = ((vaughanThirdLargeDyadicIndices U V x alpha).card : ℝ) *
        (Real.log (2 * (M : ℝ))) ^ 2 := by simp
    _ ≤ (M : ℝ) * (Real.log (2 * (M : ℝ))) ^ 2 := by
      exact mul_le_mul_of_nonneg_right (by exact_mod_cast hcard) (sq_nonneg _)
    _ = ((2 ^ alpha : ℕ) : ℝ) *
        (Real.log (2 * ((2 ^ alpha : ℕ) : ℝ))) ^ 2 := by rfl

theorem sqrt_sum_norm_sq_vaughanThirdCoefficient_dyadic_le
    (U V : ℝ) (x alpha : ℕ) :
    Real.sqrt (∑ t ∈ vaughanThirdLargeDyadicIndices U V x alpha,
      ‖((vaughanThirdCoefficient U V t : ℝ) : ℂ)‖ ^ 2) ≤
      Real.sqrt ((2 ^ alpha : ℕ) : ℝ) *
        Real.log (2 * ((2 ^ alpha : ℕ) : ℝ)) := by
  have henergy := sum_norm_sq_vaughanThirdCoefficient_dyadic_le U V x alpha
  have hlogNonneg :
      0 ≤ Real.log (2 * ((2 ^ alpha : ℕ) : ℝ)) :=
    Real.log_nonneg (by
      have hpow : (1 : ℝ) ≤ ((2 ^ alpha : ℕ) : ℝ) := by
        exact_mod_cast (by simpa using Nat.one_le_pow' alpha 1)
      nlinarith)
  calc
    Real.sqrt (∑ t ∈ vaughanThirdLargeDyadicIndices U V x alpha,
        ‖((vaughanThirdCoefficient U V t : ℝ) : ℂ)‖ ^ 2) ≤
        Real.sqrt (((2 ^ alpha : ℕ) : ℝ) *
          (Real.log (2 * ((2 ^ alpha : ℕ) : ℝ))) ^ 2) :=
      Real.sqrt_le_sqrt henergy
    _ = Real.sqrt ((2 ^ alpha : ℕ) : ℝ) *
        Real.log (2 * ((2 ^ alpha : ℕ) : ℝ)) := by
      rw [Real.sqrt_mul (by positivity), Real.sqrt_sq_eq_abs,
        abs_of_nonneg hlogNonneg]

/--
Positive factor pairs `(m, k)` with `m * k ≤ y`, `m > U`, and `k > V`, indexing Vaughan's fourth
term.
-/
noncomputable def vaughanFourthPairIndices (U V : ℝ) (y : ℕ) : Finset (ℕ × ℕ) :=
  (positiveFactorPairs y).filter (fun mk ↦
    U < (mk.1 : ℝ) ∧ V < (mk.2 : ℝ))

/--
Dyadic scales `M = 2 ^ alpha` from the range up to `⌊x / V⌋₊` satisfying `U / 2 < M < x / V`.
-/
noncomputable def vaughanFourthDyadicExponents
    (U V : ℝ) (x : ℕ) : Finset ℕ :=
  (dyadicExponentRange ⌊(x : ℝ) / V⌋₊).filter (fun alpha ↦
    let M : ℕ := 2 ^ alpha
    U / 2 < (M : ℝ) ∧ (M : ℝ) < (x : ℝ) / V)

/--
The first factors in `(2 ^ alpha, 2 ^ (alpha + 1)]` satisfying `U < m ≤ x / V` for Vaughan's
fourth term.
-/
noncomputable def vaughanFourthDyadicMIndices
    (U V : ℝ) (x alpha : ℕ) : Finset ℕ :=
  (dyadicBlock alpha).filter (fun m ↦
    U < (m : ℝ) ∧ (m : ℝ) ≤ (x : ℝ) / V)

/-- The positive second factors `k ≤ x / 2 ^ alpha` satisfying the real lower cutoff `V < k`. -/
noncomputable def vaughanFourthDyadicKIndices
    (V : ℝ) (x alpha : ℕ) : Finset ℕ :=
  (Finset.Ioc 0 (x / 2 ^ alpha)).filter (fun k ↦ V < (k : ℝ))

/-- The Möbius function viewed as real-valued via the integer-to-real coercion. -/
abbrev moebiusReal (n : ℕ) : ℝ :=
  ((ArithmeticFunction.moebius n : ℤ) : ℝ)

/-- The finite interval of positive natural numbers at most `N`. -/
def positiveNaturalsUpTo (N : ℕ) : Finset ℕ :=
  Finset.Ioc 0 N

theorem abs_moebiusReal_eq_sq (n : ℕ) :
    |moebiusReal n| = (moebiusReal n) ^ 2 := by
  rcases ArithmeticFunction.moebius_eq_or n with h | h | h <;>
    simp [moebiusReal, h]

theorem gcd_lcm_mul_of_dvd_of_coprime
    {d g b : ℕ} (hg : g ∣ d) (hb : Nat.Coprime b d) :
    Nat.gcd d (g * b) = g ∧ Nat.lcm d (g * b) = d * b := by
  have hdEq : d = g * (d / g) := (Nat.mul_div_cancel' hg).symm
  have hcop : Nat.Coprime (d / g) b :=
    Nat.Coprime.of_dvd_left (Nat.div_dvd_of_dvd hg) hb.symm
  constructor
  · rw [hdEq, Nat.gcd_mul_left, hcop.gcd_eq_one, mul_one]
  · rw [hdEq, Nat.lcm_mul_left, hcop.lcm_eq_mul]
    ac_rfl

theorem moebius_mul_moebius_div_lcm_eq_of_dvd_of_coprime
    {d g b : ℕ} (hd : 0 < d) (hbPos : 0 < b)
    (hg : g ∣ d) (hb : Nat.Coprime b d) :
    moebiusReal d * moebiusReal (g * b) / (Nat.lcm d (g * b) : ℝ) =
      (moebiusReal d * moebiusReal g / (d : ℝ)) * (moebiusReal b / (b : ℝ)) := by
  have hcop : Nat.Coprime g b := (hb.coprime_dvd_right hg).symm
  have hmu :=
    ArithmeticFunction.isMultiplicative_moebius.map_mul_of_coprime hcop
  have hmuR : moebiusReal (g * b) = moebiusReal g * moebiusReal b := by exact_mod_cast hmu
  rw [hmuR, (gcd_lcm_mul_of_dvd_of_coprime hg hb).2]
  push_cast
  field_simp

/--
Pairs `(g, b)` with `g ∣ d`, `0 < b ≤ min (Z / g) (B / d)`, and `b` coprime to `d`. The
quotients are natural-number divisions.
-/
def moebiusLcmFiberIndices (d Z B : ℕ) : Finset (Σ _g : ℕ, ℕ) :=
  d.divisors.sigma (fun g =>
    (positiveNaturalsUpTo (min (Z / g) (B / d))).filter
      (fun b => Nat.Coprime b d))

theorem abs_sum_moebius_mul_moebius_div_lcm_fiber_le
    {d Z B : ℕ} (hdZ : d ∈ positiveNaturalsUpTo Z) :
    |∑ e ∈ (positiveNaturalsUpTo Z).filter (fun e => Nat.lcm d e ≤ B),
      moebiusReal d * moebiusReal e / (Nat.lcm d e : ℝ)| ≤
      (moebiusReal d) ^ 2 * (d.divisors.card : ℝ) / (d : ℝ) := by
  have hdPos : 0 < d := (Finset.mem_Ioc.mp hdZ).1
  by_cases hdSq : Squarefree d
  · have hreindex :
        (∑ e ∈ (positiveNaturalsUpTo Z).filter (fun e => Nat.lcm d e ≤ B),
          moebiusReal d * moebiusReal e / (Nat.lcm d e : ℝ)) =
        ∑ x ∈ moebiusLcmFiberIndices d Z B,
          (moebiusReal d * moebiusReal x.1 / (d : ℝ)) *
            (moebiusReal x.2 / (x.2 : ℝ)) := by
      apply Finset.sum_bij_ne_zero
          (fun e _he _hne => ⟨Nat.gcd d e, e / Nat.gcd d e⟩)
      · intro e he hne
        rcases Finset.mem_filter.mp he with ⟨heZ, hlcm⟩
        have hePos : 0 < e := (Finset.mem_Ioc.mp heZ).1
        have hmuE : ArithmeticFunction.moebius e ≠ 0 := by
          intro hzero
          apply hne
          simp [moebiusReal, hzero]
        have heSq := ArithmeticFunction.moebius_ne_zero_iff_squarefree.mp hmuE
        have hgPos : 0 < Nat.gcd d e := Nat.gcd_pos_of_pos_left e hdPos
        have hgDvd : Nat.gcd d e ∣ d := Nat.gcd_dvd_left d e
        have hbCop : Nat.Coprime (e / Nat.gcd d e) d := by
          simpa only [Nat.gcd_comm] using
            Nat.coprime_div_gcd_of_squarefree heSq hdPos.ne'
        have hbPos : 0 < e / Nat.gcd d e :=
          Nat.div_pos (Nat.le_of_dvd hePos (Nat.gcd_dvd_right d e)) hgPos
        have heEq : e = Nat.gcd d e * (e / Nat.gcd d e) :=
          (Nat.mul_div_cancel' (Nat.gcd_dvd_right d e)).symm
        have hlcmEq : Nat.lcm d e = d * (e / Nat.gcd d e) := by
          calc
            Nat.lcm d e =
                Nat.lcm d (Nat.gcd d e * (e / Nat.gcd d e)) := by rw [← heEq]
            _ = d * (e / Nat.gcd d e) :=
              (gcd_lcm_mul_of_dvd_of_coprime hgDvd hbCop).2
        apply Finset.mem_sigma.mpr
        refine ⟨Nat.mem_divisors.mpr ⟨hgDvd, hdPos.ne'⟩,
          Finset.mem_filter.mpr ⟨Finset.mem_Ioc.mpr ⟨hbPos, ?_⟩, hbCop⟩⟩
        exact le_min (Nat.div_le_div_right (Finset.mem_Ioc.mp heZ).2)
          ((Nat.le_div_iff_mul_le hdPos).2
            (by simpa only [Nat.mul_comm, ← hlcmEq] using hlcm))
      · intro e₁ he₁ hn₁ e₂ he₂ hn₂ h
        have hprod := congrArg
          (fun x : Σ _g : ℕ, ℕ => x.1 * x.2) h
        calc
          e₁ = Nat.gcd d e₁ * (e₁ / Nat.gcd d e₁) :=
            (Nat.mul_div_cancel' (Nat.gcd_dvd_right d e₁)).symm
          _ = Nat.gcd d e₂ * (e₂ / Nat.gcd d e₂) := by
            simpa only using hprod
          _ = e₂ := Nat.mul_div_cancel' (Nat.gcd_dvd_right d e₂)
      · rintro ⟨g, b⟩ hx hne
        rcases Finset.mem_sigma.mp hx with ⟨hgMem, hbMem⟩
        rcases Finset.mem_filter.mp hbMem with ⟨hbRange, hbCop⟩
        have hgDvd := Nat.dvd_of_mem_divisors hgMem
        have hgPos := Nat.pos_of_mem_divisors hgMem
        have hbData := Finset.mem_Ioc.mp hbRange
        have hdata := gcd_lcm_mul_of_dvd_of_coprime hgDvd hbCop
        refine ⟨g * b, ?_, ?_, ?_⟩
        · apply Finset.mem_filter.mpr
          refine ⟨Finset.mem_Ioc.mpr ⟨Nat.mul_pos hgPos hbData.1, ?_⟩, ?_⟩
          · simpa only [Nat.mul_comm] using
              (Nat.le_div_iff_mul_le hgPos).mp (le_min_iff.mp hbData.2).1
          · rw [hdata.2]
            simpa only [Nat.mul_comm] using
              (Nat.le_div_iff_mul_le hdPos).mp (le_min_iff.mp hbData.2).2
        · rw [moebius_mul_moebius_div_lcm_eq_of_dvd_of_coprime hdPos hbData.1 hgDvd hbCop]
          exact hne
        · apply Sigma.ext hdata.1
          simp only [hdata.1, Nat.mul_div_cancel_left b hgPos]
          exact HEq.rfl
      · intro e he hne
        rcases Finset.mem_filter.mp he with ⟨heZ, hlcm⟩
        have hePos : 0 < e := (Finset.mem_Ioc.mp heZ).1
        have hmuE : ArithmeticFunction.moebius e ≠ 0 := by
          intro hzero
          apply hne
          simp [moebiusReal, hzero]
        have heSq := ArithmeticFunction.moebius_ne_zero_iff_squarefree.mp hmuE
        have hgPos : 0 < Nat.gcd d e := Nat.gcd_pos_of_pos_left e hdPos
        have hbPos : 0 < e / Nat.gcd d e :=
          Nat.div_pos (Nat.le_of_dvd hePos (Nat.gcd_dvd_right d e)) hgPos
        have hbCop : Nat.Coprime (e / Nat.gcd d e) d := by
          simpa only [Nat.gcd_comm] using
            Nat.coprime_div_gcd_of_squarefree heSq hdPos.ne'
        have heEq : e = Nat.gcd d e * (e / Nat.gcd d e) :=
          (Nat.mul_div_cancel' (Nat.gcd_dvd_right d e)).symm
        calc
          moebiusReal d * moebiusReal e / (Nat.lcm d e : ℝ) =
              moebiusReal d * moebiusReal (Nat.gcd d e * (e / Nat.gcd d e)) /
                (Nat.lcm d (Nat.gcd d e * (e / Nat.gcd d e)) : ℝ) := by
                  rw [← heEq]
          _ = _ := moebius_mul_moebius_div_lcm_eq_of_dvd_of_coprime hdPos hbPos
            (Nat.gcd_dvd_left d e) hbCop
    rw [hreindex]
    unfold moebiusLcmFiberIndices
    change |∑ x ∈ d.divisors.sigma (fun g =>
      (positiveNaturalsUpTo (min (Z / g) (B / d))).filter
        (fun b => Nat.Coprime b d)),
      (fun g b => (moebiusReal d * moebiusReal g / (d : ℝ)) *
        (moebiusReal b / (b : ℝ))) x.1 x.2| ≤ _
    rw [← Finset.sum_sigma' d.divisors
      (fun g => (positiveNaturalsUpTo (min (Z / g) (B / d))).filter
        (fun b => Nat.Coprime b d))
      (fun g b => (moebiusReal d * moebiusReal g / (d : ℝ)) *
        (moebiusReal b / (b : ℝ)))]
    simp_rw [← Finset.mul_sum]
    calc
      |∑ g ∈ d.divisors, (moebiusReal d * moebiusReal g / (d : ℝ)) *
          ∑ b ∈ (positiveNaturalsUpTo (min (Z / g) (B / d))).filter
            (fun b => Nat.Coprime b d), moebiusReal b / (b : ℝ)| ≤
          ∑ g ∈ d.divisors, (moebiusReal d) ^ 2 / (d : ℝ) := by
            refine (Finset.abs_sum_le_sum_abs _ _).trans ?_
            apply Finset.sum_le_sum
            intro g hgMem
            have hgSq := hdSq.squarefree_of_dvd
              (Nat.dvd_of_mem_divisors hgMem)
            have hdMu : (moebiusReal d) ^ 2 = 1 := by
              exact_mod_cast ArithmeticFunction.moebius_sq_eq_one_of_squarefree hdSq
            have hgMu : (moebiusReal g) ^ 2 = 1 := by
              exact_mod_cast ArithmeticFunction.moebius_sq_eq_one_of_squarefree hgSq
            have habs : |moebiusReal d * moebiusReal g / (d : ℝ)| =
                (moebiusReal d) ^ 2 / (d : ℝ) := by
              rw [abs_div, abs_mul, abs_moebiusReal_eq_sq, abs_moebiusReal_eq_sq,
                abs_of_pos (by exact_mod_cast hdPos), hdMu, hgMu]
              ring
            rw [abs_mul, habs]
            exact mul_le_of_le_one_right (by positivity)
              (abs_sum_moebius_div_coprime_le_one d
                (min (Z / g) (B / d)))
      _ = _ := by rw [Finset.sum_const, nsmul_eq_mul]; ring
  · simp [moebiusReal, ArithmeticFunction.moebius_eq_zero_of_not_squarefree hdSq]

theorem abs_sum_moebius_mul_moebius_div_lcm_le_four_ninths
    {Z B : ℕ} (hZ : 1 ≤ Z) :
    |∑ d ∈ Finset.Ioc 0 Z,
      ∑ e ∈ (Finset.Ioc 0 Z).filter
        (fun e => Nat.lcm d e ≤ B),
        ((ArithmeticFunction.moebius d : ℤ) : ℝ) *
          ((ArithmeticFunction.moebius e : ℤ) : ℝ) /
            (Nat.lcm d e : ℝ)| ≤
      (4 / 9 : ℝ) * (Real.log (Z : ℝ) + 3) ^ 2 := by
  refine le_trans ?_ (sum_sq_moebius_mul_card_divisors_div_le_four_ninths hZ)
  rw [← Real.norm_eq_abs]
  apply norm_sum_le_of_le
  intro d hd
  simpa only [Real.norm_eq_abs, positiveNaturalsUpTo, moebiusReal] using
    (abs_sum_moebius_mul_moebius_div_lcm_fiber_le (B := B) hd)

theorem card_multiples_Ioc_eq_sub
    {a b p : ℕ} (hab : a ≤ b) :
    ((Finset.Ioc a b).filter (fun n => p ∣ n)).card = b / p - a / p := by
  let lower := (Finset.Ioc 0 a).filter (fun n => p ∣ n)
  let upper := (Finset.Ioc 0 b).filter (fun n => p ∣ n)
  have hsubset : lower ⊆ upper := by
    intro n hn
    simp only [lower, upper, Finset.mem_filter, Finset.mem_Ioc] at hn ⊢
    omega
  have heq :
      (Finset.Ioc a b).filter (fun n => p ∣ n) = upper \ lower := by
    ext n
    simp only [lower, upper, Finset.mem_filter, Finset.mem_Ioc,
      Finset.mem_sdiff]
    omega
  rw [heq, Finset.card_sdiff_of_subset hsubset]
  simp only [lower, upper, Nat.Ioc_filter_dvd_card_eq_div]

theorem abs_cast_card_multiples_real_dyadic_sub_le_one
    {N : ℝ} (hN : 0 ≤ N) {p : ℕ} (hp : 0 < p) :
    |((((Finset.Ioc ⌊N⌋₊ ⌊2 * N⌋₊).filter
      (fun n => p ∣ n)).card : ℕ) : ℝ) - N / (p : ℝ)| ≤ 1 := by
  have hTwoN : N ≤ 2 * N := by linarith
  have hfloor : ⌊N⌋₊ ≤ ⌊2 * N⌋₊ := Nat.floor_mono hTwoN
  rw [card_multiples_Ioc_eq_sub hfloor]
  have hpReal : (0 : ℝ) < p := by exact_mod_cast hp
  have hdiv : N / (p : ℝ) ≤ 2 * N / (p : ℝ) :=
    (div_le_div_iff_of_pos_right hpReal).2 hTwoN
  have hfloorDiv : ⌊N / (p : ℝ)⌋₊ ≤ ⌊2 * N / (p : ℝ)⌋₊ :=
    Nat.floor_mono hdiv
  rw [← Nat.floor_div_natCast, ← Nat.floor_div_natCast,
    Nat.cast_sub hfloorDiv]
  have hNdiv : 0 ≤ N / (p : ℝ) := div_nonneg hN hpReal.le
  have hTwoNdiv : 0 ≤ 2 * N / (p : ℝ) := by positivity
  have hfloorN := Nat.floor_le hNdiv
  have hfloorTwoN := Nat.floor_le hTwoNdiv
  have hceilN := Nat.lt_floor_add_one (N / (p : ℝ))
  have hceilTwoN := Nat.lt_floor_add_one (2 * N / (p : ℝ))
  have hdouble : 2 * N / (p : ℝ) = 2 * (N / (p : ℝ)) := by ring
  rw [abs_le]
  constructor <;> nlinarith

theorem vaughanFourthCoefficient_eq_sum_filter_dvd
    {V : ℝ} (hV : 0 ≤ V) {n : ℕ} (hn : 0 < n) :
    vaughanFourthCoefficient V n =
      ∑ d ∈ (positiveNaturalsUpTo ⌊V⌋₊).filter (fun d => d ∣ n), moebiusReal d := by
  unfold vaughanFourthCoefficient positiveNaturalsUpTo
  apply Finset.sum_congr
  · ext d
    simp only [Finset.mem_filter, Nat.mem_divisors, Finset.mem_Ioc]
    constructor
    · rintro ⟨⟨hdn, -⟩, hdV⟩
      exact ⟨⟨Nat.pos_of_dvd_of_pos hdn hn, Nat.le_floor hdV⟩, hdn⟩
    · rintro ⟨⟨hdPos, hdV⟩, hdn⟩
      exact ⟨⟨hdn, hn.ne'⟩,
        (Nat.cast_le.mpr hdV).trans (Nat.floor_le hV)⟩
  · intro d hd
    rfl

theorem sum_sq_divisor_filter_eq_pair_count (D I : Finset ℕ) :
    (∑ n ∈ I, (∑ d ∈ D.filter (fun d => d ∣ n), moebiusReal d) ^ 2) =
      ∑ d ∈ D, ∑ e ∈ D, moebiusReal d * moebiusReal e *
        (((I.filter (fun n => Nat.lcm d e ∣ n)).card : ℕ) : ℝ) := by
  have hexpand (n : ℕ) :
      (∑ d ∈ D.filter (fun d => d ∣ n), moebiusReal d) ^ 2 =
        ∑ d ∈ D, ∑ e ∈ D,
          if d ∣ n ∧ e ∣ n then moebiusReal d * moebiusReal e else 0 := by
    rw [pow_two, Finset.sum_mul_sum]
    calc
      (∑ d ∈ D.filter (fun d => d ∣ n),
        ∑ e ∈ D.filter (fun e => e ∣ n), moebiusReal d * moebiusReal e) =
          ∑ d ∈ D, if d ∣ n then
            ∑ e ∈ D.filter (fun e => e ∣ n), moebiusReal d * moebiusReal e else 0 := by
              rw [← Finset.sum_filter]
      _ = _ := by
        apply Finset.sum_congr rfl
        intro d hd
        by_cases hdn : d ∣ n
        · rw [ite_eq_left hdn, Finset.sum_filter]
          apply Finset.sum_congr rfl
          intro e he
          by_cases hen : e ∣ n <;> simp [hdn, hen]
        · simp [hdn]
  simp_rw [hexpand]
  calc
    (∑ n ∈ I, ∑ d ∈ D, ∑ e ∈ D,
      if d ∣ n ∧ e ∣ n then moebiusReal d * moebiusReal e else 0) =
      ∑ d ∈ D, ∑ e ∈ D, ∑ n ∈ I,
        if d ∣ n ∧ e ∣ n then moebiusReal d * moebiusReal e else 0 := by
          rw [Finset.sum_comm]
          apply Finset.sum_congr rfl
          intro d hd
          rw [Finset.sum_comm]
    _ = _ := by
      apply Finset.sum_congr rfl
      intro d hd
      apply Finset.sum_congr rfl
      intro e he
      calc
        (∑ n ∈ I, if d ∣ n ∧ e ∣ n then moebiusReal d * moebiusReal e else 0) =
            ∑ n ∈ I.filter (fun n => Nat.lcm d e ∣ n),
              moebiusReal d * moebiusReal e := by
                rw [Finset.sum_filter]
                apply Finset.sum_congr rfl
                intro n hn
                simp only [Nat.lcm_dvd_iff]
        _ = _ := by rw [Finset.sum_const, nsmul_eq_mul]; ring

theorem sum_pair_count_eq_filter_lcm (Z A B : ℕ) :
    (∑ d ∈ positiveNaturalsUpTo Z, ∑ e ∈ positiveNaturalsUpTo Z,
      moebiusReal d * moebiusReal e *
        ((((Finset.Ioc A B).filter
          (fun n => Nat.lcm d e ∣ n)).card : ℕ) : ℝ)) =
      ∑ d ∈ positiveNaturalsUpTo Z,
        ∑ e ∈ (positiveNaturalsUpTo Z).filter (fun e => Nat.lcm d e ≤ B),
          moebiusReal d * moebiusReal e *
            ((((Finset.Ioc A B).filter
              (fun n => Nat.lcm d e ∣ n)).card : ℕ) : ℝ) := by
  apply Finset.sum_congr rfl
  intro d hd
  symm
  rw [Finset.sum_filter]
  apply Finset.sum_congr rfl
  intro e he
  by_cases hle : Nat.lcm d e ≤ B
  · simp [hle]
  · rw [ite_eq_right hle]
    have hempty :
        (Finset.Ioc A B).filter (fun n => Nat.lcm d e ∣ n) = ∅ := by
      apply Finset.filter_false_of_mem
      intro n hnI hdiv
      have hnPos : 0 < n :=
        (Nat.zero_le A).trans_lt (Finset.mem_Ioc.mp hnI).1
      exact hle ((Nat.le_of_dvd hnPos hdiv).trans
        (Finset.mem_Ioc.mp hnI).2)
    simp [hempty]

theorem pair_count_sum_le_main_add_mass
    {N : ℝ} (hN : 0 ≤ N) (Z : ℕ) :
    (∑ d ∈ positiveNaturalsUpTo Z,
      ∑ e ∈ (positiveNaturalsUpTo Z).filter
        (fun e => Nat.lcm d e ≤ ⌊2 * N⌋₊),
        moebiusReal d * moebiusReal e *
          ((((Finset.Ioc ⌊N⌋₊ ⌊2 * N⌋₊).filter
            (fun n => Nat.lcm d e ∣ n)).card : ℕ) : ℝ)) ≤
      N * |∑ d ∈ positiveNaturalsUpTo Z,
        ∑ e ∈ (positiveNaturalsUpTo Z).filter
          (fun e => Nat.lcm d e ≤ ⌊2 * N⌋₊),
          moebiusReal d * moebiusReal e / (Nat.lcm d e : ℝ)| +
        ∑ d ∈ positiveNaturalsUpTo Z,
          ∑ e ∈ (positiveNaturalsUpTo Z).filter
            (fun e => Nat.lcm d e ≤ ⌊2 * N⌋₊),
            (moebiusReal d) ^ 2 * (moebiusReal e) ^ 2 := by
  let count : ℕ → ℕ → ℝ := fun d e =>
    ((((Finset.Ioc ⌊N⌋₊ ⌊2 * N⌋₊).filter
      (fun n => Nat.lcm d e ∣ n)).card : ℕ) : ℝ)
  let main : ℝ := ∑ d ∈ positiveNaturalsUpTo Z,
    ∑ e ∈ (positiveNaturalsUpTo Z).filter
      (fun e => Nat.lcm d e ≤ ⌊2 * N⌋₊),
      moebiusReal d * moebiusReal e / (Nat.lcm d e : ℝ)
  let error : ℝ := ∑ d ∈ positiveNaturalsUpTo Z,
    ∑ e ∈ (positiveNaturalsUpTo Z).filter
      (fun e => Nat.lcm d e ≤ ⌊2 * N⌋₊),
      moebiusReal d * moebiusReal e * (count d e - N / (Nat.lcm d e : ℝ))
  have hdecomp :
      (∑ d ∈ positiveNaturalsUpTo Z,
        ∑ e ∈ (positiveNaturalsUpTo Z).filter
          (fun e => Nat.lcm d e ≤ ⌊2 * N⌋₊),
          moebiusReal d * moebiusReal e * count d e) = N * main + error := by
    dsimp only [main, error]
    rw [Finset.mul_sum, ← Finset.sum_add_distrib]
    apply Finset.sum_congr rfl
    intro d hd
    rw [Finset.mul_sum, ← Finset.sum_add_distrib]
    apply Finset.sum_congr rfl
    intro e he
    ring
  have herror :
      |error| ≤ ∑ d ∈ positiveNaturalsUpTo Z,
        ∑ e ∈ (positiveNaturalsUpTo Z).filter
          (fun e => Nat.lcm d e ≤ ⌊2 * N⌋₊),
          (moebiusReal d) ^ 2 * (moebiusReal e) ^ 2 := by
    dsimp only [error]
    refine (Finset.abs_sum_le_sum_abs _ _).trans ?_
    apply Finset.sum_le_sum
    intro d hd
    refine (Finset.abs_sum_le_sum_abs _ _).trans ?_
    apply Finset.sum_le_sum
    intro e he
    have hdPos : 0 < d := (Finset.mem_Ioc.mp hd).1
    have hePos : 0 < e :=
      (Finset.mem_Ioc.mp (Finset.mem_filter.mp he).1).1
    have hlcmPos : 0 < Nat.lcm d e := Nat.lcm_pos hdPos hePos
    have hcount := abs_cast_card_multiples_real_dyadic_sub_le_one hN hlcmPos
    change |moebiusReal d * moebiusReal e *
      (count d e - N / (Nat.lcm d e : ℝ))| ≤ _
    rw [abs_mul, abs_mul, abs_moebiusReal_eq_sq, abs_moebiusReal_eq_sq]
    exact mul_le_of_le_one_right
      (mul_nonneg (sq_nonneg _) (sq_nonneg _)) hcount
  change (∑ d ∈ positiveNaturalsUpTo Z,
    ∑ e ∈ (positiveNaturalsUpTo Z).filter
      (fun e => Nat.lcm d e ≤ ⌊2 * N⌋₊),
      moebiusReal d * moebiusReal e * count d e) ≤ _
  rw [hdecomp]
  calc
    N * main + error ≤ |N * main + error| := le_abs_self _
    _ ≤ |N * main| + |error| := abs_add_le _ _
    _ = N * |main| + |error| := by rw [abs_mul, abs_of_nonneg hN]
    _ ≤ N * |main| +
        ∑ d ∈ positiveNaturalsUpTo Z,
          ∑ e ∈ (positiveNaturalsUpTo Z).filter
            (fun e => Nat.lcm d e ≤ ⌊2 * N⌋₊),
            (moebiusReal d) ^ 2 * (moebiusReal e) ^ 2 :=
      add_le_add le_rfl herror

theorem sum_sq_vaughanFourthCoefficient_dyadic_le
    {N V : ℝ} (hN : 1 ≤ N) (hV : 1 ≤ V) :
    (∑ n ∈ Finset.Ioc ⌊N⌋₊ ⌊2 * N⌋₊,
      (vaughanFourthCoefficient V n) ^ 2) ≤
      (4 / 3 : ℝ) * N * (Real.log V + 3) ^ 2 := by
  have hNNonneg : 0 ≤ N := zero_le_one.trans hN
  have hVNonneg : 0 ≤ V := zero_le_one.trans hV
  have hFloorV : 1 ≤ ⌊V⌋₊ := (Nat.one_le_floor_iff V).2 hV
  have hExpanded :
      (∑ n ∈ Finset.Ioc ⌊N⌋₊ ⌊2 * N⌋₊,
        (vaughanFourthCoefficient V n) ^ 2) =
        ∑ n ∈ Finset.Ioc ⌊N⌋₊ ⌊2 * N⌋₊,
          (∑ d ∈ (positiveNaturalsUpTo ⌊V⌋₊).filter (fun d => d ∣ n),
            moebiusReal d) ^ 2 := by
    apply Finset.sum_congr rfl
    intro n hn
    rw [vaughanFourthCoefficient_eq_sum_filter_dvd hVNonneg
      ((Nat.zero_le ⌊N⌋₊).trans_lt (Finset.mem_Ioc.mp hn).1)]
  have hMain := abs_sum_moebius_mul_moebius_div_lcm_le_four_ninths
    (Z := ⌊V⌋₊) (B := ⌊2 * N⌋₊) hFloorV
  have hMass := sum_sq_moebius_pair_lcm_le
    (Z := ⌊V⌋₊) (B := ⌊2 * N⌋₊) hFloorV
  have hFloorTwoN : ((⌊2 * N⌋₊ : ℕ) : ℝ) ≤ 2 * N :=
    Nat.floor_le (mul_nonneg (by norm_num) hNNonneg)
  have hFloorVCast : ((⌊V⌋₊ : ℕ) : ℝ) ≤ V := Nat.floor_le hVNonneg
  have hFloorVPositive : (0 : ℝ) < (⌊V⌋₊ : ℕ) := by
    exact_mod_cast (lt_of_lt_of_le Nat.zero_lt_one hFloorV)
  have hVPositive : 0 < V := zero_lt_one.trans_le hV
  have hLogLe : Real.log (⌊V⌋₊ : ℕ) ≤ Real.log V :=
    Real.strictMonoOn_log.monotoneOn
      hFloorVPositive hVPositive hFloorVCast
  have hLogFloorNonneg : 0 ≤ Real.log (⌊V⌋₊ : ℕ) :=
    Real.log_nonneg (by exact_mod_cast hFloorV)
  have hLogVNonneg : 0 ≤ Real.log V := Real.log_nonneg hV
  have hSquareLog :
      (Real.log (⌊V⌋₊ : ℕ) + 3) ^ 2 ≤ (Real.log V + 3) ^ 2 := by
    have hDiff : 0 ≤ (Real.log V + 3) -
        (Real.log (⌊V⌋₊ : ℕ) + 3) := sub_nonneg.mpr (by linarith)
    have hSum : 0 ≤ (Real.log V + 3) +
        (Real.log (⌊V⌋₊ : ℕ) + 3) := by linarith
    nlinarith [mul_nonneg hDiff hSum]
  calc
    (∑ n ∈ Finset.Ioc ⌊N⌋₊ ⌊2 * N⌋₊,
        (vaughanFourthCoefficient V n) ^ 2) =
        ∑ d ∈ positiveNaturalsUpTo ⌊V⌋₊,
          ∑ e ∈ (positiveNaturalsUpTo ⌊V⌋₊).filter
            (fun e => Nat.lcm d e ≤ ⌊2 * N⌋₊),
            moebiusReal d * moebiusReal e *
              ((((Finset.Ioc ⌊N⌋₊ ⌊2 * N⌋₊).filter
                (fun n => Nat.lcm d e ∣ n)).card : ℕ) : ℝ) := by
      rw [hExpanded,
        sum_sq_divisor_filter_eq_pair_count,
        sum_pair_count_eq_filter_lcm]
    _ ≤ N * |∑ d ∈ positiveNaturalsUpTo ⌊V⌋₊,
          ∑ e ∈ (positiveNaturalsUpTo ⌊V⌋₊).filter
            (fun e => Nat.lcm d e ≤ ⌊2 * N⌋₊),
            moebiusReal d * moebiusReal e / (Nat.lcm d e : ℝ)| +
        ∑ d ∈ positiveNaturalsUpTo ⌊V⌋₊,
          ∑ e ∈ (positiveNaturalsUpTo ⌊V⌋₊).filter
            (fun e => Nat.lcm d e ≤ ⌊2 * N⌋₊),
            (moebiusReal d) ^ 2 * (moebiusReal e) ^ 2 :=
      pair_count_sum_le_main_add_mass hNNonneg ⌊V⌋₊
    _ ≤ N * ((4 / 9 : ℝ) *
          (Real.log (⌊V⌋₊ : ℕ) + 3) ^ 2) +
        (⌊2 * N⌋₊ : ℕ) *
          ((2 / 3 : ℝ) * (Real.log (⌊V⌋₊ : ℕ) + 3)) ^ 2 :=
      add_le_add (mul_le_mul_of_nonneg_left hMain hNNonneg) hMass
    _ ≤ N * ((4 / 9 : ℝ) *
          (Real.log (⌊V⌋₊ : ℕ) + 3) ^ 2) +
        (2 * N) *
          ((2 / 3 : ℝ) * (Real.log (⌊V⌋₊ : ℕ) + 3)) ^ 2 :=
      add_le_add le_rfl
        (mul_le_mul_of_nonneg_right hFloorTwoN (sq_nonneg _))
    _ = (4 / 3 : ℝ) * N *
        (Real.log (⌊V⌋₊ : ℕ) + 3) ^ 2 := by ring
    _ ≤ (4 / 3 : ℝ) * N * (Real.log V + 3) ^ 2 :=
      mul_le_mul_of_nonneg_left hSquareLog
        (mul_nonneg (by norm_num) hNNonneg)

theorem sum_sq_vaughanFourthCoefficient_prefix_le
    {V : ℝ} (hV : 1 ≤ V) (X : ℕ) :
    (∑ n ∈ Finset.Ioc 0 X,
      (vaughanFourthCoefficient V n) ^ 2) ≤
      (4 / 3 : ℝ) * (X : ℝ) * (Real.log V + 3) ^ 2 := by
  induction X using Nat.strong_induction_on with
  | h X ih =>
      by_cases hXZero : X = 0
      · subst X
        simp
      by_cases hXOne : X = 1
      · subst X
        have hLog : 0 ≤ Real.log V := Real.log_nonneg hV
        have hCoefficient : vaughanFourthCoefficient V 1 = 1 := by
          unfold vaughanFourthCoefficient
          rw [Nat.divisors_one]
          have hFilter :
              ({1} : Finset ℕ).filter (fun d : ℕ => (d : ℝ) ≤ V) = {1} := by
            apply Finset.filter_eq_self.mpr
            intro d hd
            simp only [Finset.mem_singleton] at hd
            subst d
            simpa only [Nat.cast_one] using hV
          rw [hFilter]
          simp
        norm_num [hCoefficient]
        nlinarith [sq_nonneg (Real.log V)]
      have hXTwo : 2 ≤ X := by omega
      have hHalfLt : X / 2 < X :=
        Nat.div_lt_self (Nat.zero_lt_of_lt hXTwo) (Nat.le_refl 2)
      have hLower := ih (X / 2) hHalfLt
      have hHalfReal : (1 : ℝ) ≤ (X : ℝ) / 2 := by
        apply (le_div_iff₀ (by norm_num : (0 : ℝ) < 2)).2
        exact_mod_cast hXTwo
      have hUpper := sum_sq_vaughanFourthCoefficient_dyadic_le
        (N := (X : ℝ) / 2) (V := V) hHalfReal hV
      have hFloorHalf : ⌊(X : ℝ) / 2⌋₊ = X / 2 := by
        simpa using (Nat.floor_div_natCast (K := ℝ) (X : ℝ) 2)
      have hTwiceHalf : (2 : ℝ) * ((X : ℝ) / 2) = X := by ring
      rw [hFloorHalf, hTwiceHalf, Nat.floor_natCast] at hUpper
      have hHalfLe : X / 2 ≤ X := Nat.div_le_self X 2
      have hDisjoint :
          Disjoint (Finset.Ioc 0 (X / 2)) (Finset.Ioc (X / 2) X) :=
        Finset.Ioc_disjoint_Ioc_of_le le_rfl
      have hSplit :
          (∑ n ∈ Finset.Ioc 0 X,
            (vaughanFourthCoefficient V n) ^ 2) =
            (∑ n ∈ Finset.Ioc 0 (X / 2),
              (vaughanFourthCoefficient V n) ^ 2) +
            ∑ n ∈ Finset.Ioc (X / 2) X,
              (vaughanFourthCoefficient V n) ^ 2 := by
        rw [← Finset.sum_union hDisjoint,
          Finset.Ioc_union_Ioc_eq_Ioc (Nat.zero_le _) hHalfLe]
      have hLength :
          ((X / 2 : ℕ) : ℝ) + (X : ℝ) / 2 ≤ (X : ℝ) := by
        have hFloorLe : ((X / 2 : ℕ) : ℝ) ≤ (X : ℝ) / 2 :=
          Nat.cast_div_le
        linarith
      have hFactorNonneg :
          0 ≤ (4 / 3 : ℝ) * (Real.log V + 3) ^ 2 :=
        mul_nonneg (by norm_num) (sq_nonneg _)
      rw [hSplit]
      calc
        (∑ n ∈ Finset.Ioc 0 (X / 2),
            (vaughanFourthCoefficient V n) ^ 2) +
            ∑ n ∈ Finset.Ioc (X / 2) X,
              (vaughanFourthCoefficient V n) ^ 2 ≤
            (4 / 3 : ℝ) * ((X / 2 : ℕ) : ℝ) *
                (Real.log V + 3) ^ 2 +
              (4 / 3 : ℝ) * ((X : ℝ) / 2) *
                (Real.log V + 3) ^ 2 := add_le_add hLower hUpper
        _ = ((4 / 3 : ℝ) * (Real.log V + 3) ^ 2) *
              (((X / 2 : ℕ) : ℝ) + (X : ℝ) / 2) := by ring
        _ ≤ ((4 / 3 : ℝ) * (Real.log V + 3) ^ 2) * (X : ℝ) :=
          mul_le_mul_of_nonneg_left hLength hFactorNonneg
        _ = (4 / 3 : ℝ) * (X : ℝ) * (Real.log V + 3) ^ 2 := by ring

theorem sum_norm_sq_vaughanFourthCoefficient_Ioc_le
    {V : ℝ} {x M : ℕ} (hV : 1 ≤ V) (hM : 0 < M) :
    (∑ k ∈ (Finset.Ioc 0 (x / M)).filter
      (fun k : ℕ => V < (k : ℝ)),
      ‖(vaughanFourthCoefficient V k : ℂ)‖ ^ 2) ≤
      4 * (x : ℝ) / (3 * (M : ℝ)) *
        (Real.log (Real.exp 3 * V)) ^ 2 := by
  have hSubset :
      (Finset.Ioc 0 (x / M)).filter (fun k : ℕ => V < (k : ℝ)) ⊆
        Finset.Ioc 0 (x / M) := Finset.filter_subset _ _
  have hPrefix := sum_sq_vaughanFourthCoefficient_prefix_le hV (x / M)
  have hRestricted :
      (∑ k ∈ (Finset.Ioc 0 (x / M)).filter
          (fun k : ℕ => V < (k : ℝ)),
          ‖(vaughanFourthCoefficient V k : ℂ)‖ ^ 2) ≤
        ∑ k ∈ Finset.Ioc 0 (x / M),
          (vaughanFourthCoefficient V k) ^ 2 := by
    calc
      (∑ k ∈ (Finset.Ioc 0 (x / M)).filter
          (fun k : ℕ => V < (k : ℝ)),
          ‖(vaughanFourthCoefficient V k : ℂ)‖ ^ 2) =
          ∑ k ∈ (Finset.Ioc 0 (x / M)).filter
            (fun k : ℕ => V < (k : ℝ)),
            (vaughanFourthCoefficient V k) ^ 2 := by
        apply Finset.sum_congr rfl
        intro k hk
        rw [Complex.norm_real, Real.norm_eq_abs, sq_abs]
      _ ≤ ∑ k ∈ Finset.Ioc 0 (x / M),
            (vaughanFourthCoefficient V k) ^ 2 := by
        apply Finset.sum_le_sum_of_subset_of_nonneg hSubset
        intro k hk hNot
        exact sq_nonneg _
  have hQuotient :
      (((x / M : ℕ) : ℝ)) ≤ (x : ℝ) / (M : ℝ) :=
    Nat.cast_div_le
  have hFactorNonneg :
      0 ≤ (4 / 3 : ℝ) * (Real.log V + 3) ^ 2 :=
    mul_nonneg (by norm_num) (sq_nonneg _)
  have hLog : Real.log (Real.exp 3 * V) = Real.log V + 3 := by
    rw [Real.log_mul (Real.exp_ne_zero 3) (ne_of_gt (zero_lt_one.trans_le hV)),
      Real.log_exp]
    ring
  calc
    (∑ k ∈ (Finset.Ioc 0 (x / M)).filter
        (fun k : ℕ => V < (k : ℝ)),
        ‖(vaughanFourthCoefficient V k : ℂ)‖ ^ 2) ≤
        ∑ k ∈ Finset.Ioc 0 (x / M),
          (vaughanFourthCoefficient V k) ^ 2 := hRestricted
    _ ≤ (4 / 3 : ℝ) * (((x / M : ℕ) : ℝ)) *
          (Real.log V + 3) ^ 2 := hPrefix
    _ = ((4 / 3 : ℝ) * (Real.log V + 3) ^ 2) *
          (((x / M : ℕ) : ℝ)) := by ring
    _ ≤ ((4 / 3 : ℝ) * (Real.log V + 3) ^ 2) *
          ((x : ℝ) / (M : ℝ)) :=
      mul_le_mul_of_nonneg_left hQuotient hFactorNonneg
    _ = 4 * (x : ℝ) / (3 * (M : ℝ)) *
          (Real.log (Real.exp 3 * V)) ^ 2 := by
      rw [hLog]
      have hMReal : (M : ℝ) ≠ 0 := by exact_mod_cast hM.ne'
      field_simp [hMReal]

theorem sqrt_sum_norm_sq_vaughanFourthCoefficient_dyadic_le
    {V : ℝ} {x alpha : ℕ} (hV : 1 ≤ V) :
    Real.sqrt (∑ k ∈ vaughanFourthDyadicKIndices V x alpha,
      ‖(vaughanFourthCoefficient V k : ℂ)‖ ^ 2) ≤
      2 / Real.sqrt 3 *
        Real.sqrt ((x : ℝ) / ((2 ^ alpha : ℕ) : ℝ)) *
        Real.log (Real.exp 3 * V) := by
  let M : ℕ := 2 ^ alpha
  have hM : 0 < M := by positivity
  have henergy := sum_norm_sq_vaughanFourthCoefficient_Ioc_le
    (V := V) (x := x) (M := M) hV hM
  have hLog : 0 ≤ Real.log (Real.exp 3 * V) := by
    apply Real.log_nonneg
    have hExp : 1 ≤ Real.exp (3 : ℝ) :=
      (Real.one_le_exp_iff).2 (by norm_num)
    nlinarith [mul_pos (Real.exp_pos 3) (zero_lt_one.trans_le hV)]
  have hBase : 0 ≤ 4 * (x : ℝ) / (3 * (M : ℝ)) := by positivity
  have hSqrt := Real.sqrt_le_sqrt henergy
  have hBaseEq :
      4 * (x : ℝ) / (3 * (M : ℝ)) =
        (4 / 3 : ℝ) * ((x : ℝ) / (M : ℝ)) := by ring
  have hSqrtFourThirds :
      Real.sqrt (4 / 3 : ℝ) = 2 / Real.sqrt 3 := by
    rw [Real.sqrt_div (by norm_num : (0 : ℝ) ≤ 4)]
    have hSqrtFour : Real.sqrt (4 : ℝ) = 2 := by
      rw [show (4 : ℝ) = 2 ^ 2 by norm_num,
        Real.sqrt_sq (by norm_num)]
    rw [hSqrtFour]
  rw [Real.sqrt_mul hBase, Real.sqrt_sq hLog, hBaseEq,
    Real.sqrt_mul (by norm_num : (0 : ℝ) ≤ 4 / 3),
    hSqrtFourThirds] at hSqrt
  simpa only [vaughanFourthDyadicKIndices, M] using hSqrt

/--
The conductor cutoff `⌊(log x) ^ D⌋₊` used to separate the small- and large-conductor estimates.
The natural floor makes the cutoff a nonnegative integer.
-/
noncomputable def siegelWalfiszConductorCutoff
    (D : ℝ) (x : ℕ) : ℕ :=
  Nat.floor (Real.log (x : ℝ) ^ D)

theorem natCast_siegelWalfiszConductorCutoff_le
    (D : ℝ) (x : ℕ) :
    ((siegelWalfiszConductorCutoff D x : ℕ) : ℝ) ≤
      Real.log (x : ℝ) ^ D := by
  unfold siegelWalfiszConductorCutoff
  exact Nat.floor_le
    (Real.rpow_nonneg (Real.log_natCast_nonneg x) D)

end

section
open scoped ContDiff

open scoped ArithmeticFunction.vonMangoldt
/--
The maximum norm of the centered twisted Chebyshev sum for a primitive character over integer
endpoints `2 ≤ y ≤ x`. Defined to be zero when `x < 2`.
-/
noncomputable def primitiveCenteredEndpointMaximum
    (x d : ℕ) (ψ : primitiveCharacters d) : ℝ :=
  if hx : 2 ≤ x then
    (Finset.Icc 2 x).sup' (weightedEndpointRange_nonempty hx)
      (fun y ↦ ‖centeredTwistedChebyshevSum y d ψ.1‖)
  else 0

/--
The centered endpoint maximum for the primitive character inducing `χ`, evaluated at its
conductor rather than at the original level `q`.
-/
noncomputable def inducingPrimitiveCenteredEndpointMaximum
    (x q : ℕ) (χ : DirichletCharacter ℂ q) : ℝ :=
  primitiveCenteredEndpointMaximum x χ.conductor
    ⟨χ.primitiveCharacter, χ.primitiveCharacter_isPrimitive⟩

theorem centeredProgressionEndpointMaximum_le_log_sq_add_primitive
    {x q a : ℕ} (hx : 2 ≤ x) (hq : 1 ≤ q)
    (ha : Nat.Coprime a q) :
    (Finset.Icc 2 x).sup' (weightedEndpointRange_nonempty hx) (fun y ↦
      |chebyshevProgressionSum y q a -
        Chebyshev.psi (y : ℝ) / (q.totient : ℝ)|) ≤
      (Real.log ((q * x : ℕ) : ℝ)) ^ 2 +
        (q.totient : ℝ)⁻¹ *
          ∑ χ : DirichletCharacter ℂ q,
            inducingPrimitiveCenteredEndpointMaximum x q χ := by
  have hq0 : q ≠ 0 := by omega
  let : NeZero q := ⟨hq0⟩
  apply Finset.sup'_le (weightedEndpointRange_nonempty hx)
  intro y hy
  have hyBounds : 2 ≤ y ∧ y ≤ x := Finset.mem_Icc.mp hy
  have hqyPos : 0 < q * y := Nat.mul_pos (by omega) (by omega)
  have hqyOne : 1 ≤ q * y := Nat.one_le_iff_ne_zero.mpr hqyPos.ne'
  have hlogNonneg : 0 ≤ Real.log ((q * y : ℕ) : ℝ) := by
    apply Real.log_nonneg
    exact_mod_cast hqyOne
  have hlogLe :
      Real.log ((q * y : ℕ) : ℝ) ≤
        Real.log ((q * x : ℕ) : ℝ) := by
    apply Real.log_le_log
    · exact_mod_cast hqyPos
    · exact_mod_cast Nat.mul_le_mul_left q hyBounds.2
  have hlogSq :
      (Real.log ((q * y : ℕ) : ℝ)) ^ 2 ≤
        (Real.log ((q * x : ℕ) : ℝ)) ^ 2 :=
    (sq_le_sq₀ hlogNonneg (hlogNonneg.trans hlogLe)).2 hlogLe
  have hprimitive (χ : DirichletCharacter ℂ q) :
      ‖centeredTwistedChebyshevSum
          y χ.conductor χ.primitiveCharacter‖ ≤
        inducingPrimitiveCenteredEndpointMaximum x q χ := by
    unfold inducingPrimitiveCenteredEndpointMaximum
      primitiveCenteredEndpointMaximum
    rw [dite_eq_left hx]
    exact Finset.le_sup'
      (fun z ↦ ‖centeredTwistedChebyshevSum
        z χ.conductor χ.primitiveCharacter‖) hy
  have hsum :
      (q.totient : ℝ)⁻¹ *
          ∑ χ : DirichletCharacter ℂ q,
            ‖centeredTwistedChebyshevSum
              y χ.conductor χ.primitiveCharacter‖ ≤
        (q.totient : ℝ)⁻¹ *
          ∑ χ : DirichletCharacter ℂ q,
            inducingPrimitiveCenteredEndpointMaximum x q χ := by
    apply mul_le_mul_of_nonneg_left
    · apply Finset.sum_le_sum
      intro χ hχ
      exact hprimitive χ
    · positivity
  exact
    (abs_chebyshevProgressionSum_sub_global_le_log_sq_add_primitive_average
      hyBounds.1 hq ha).trans (add_le_add hlogSq hsum)

theorem centeredProgressionResidueEndpointMaximum_le_log_sq_add_primitive
    {x q : ℕ} (hx : 2 ≤ x) (hq : 1 ≤ q) :
    (Finset.Icc 2 x).sup' (weightedEndpointRange_nonempty hx) (fun y ↦
      (coprimeResidues q).sup'
          (coprimeResidues_nonempty (by omega)) (fun a ↦
        |chebyshevProgressionSum y q a -
          Chebyshev.psi (y : ℝ) / (q.totient : ℝ)|)) ≤
      (Real.log ((q * x : ℕ) : ℝ)) ^ 2 +
        (q.totient : ℝ)⁻¹ *
          ∑ χ : DirichletCharacter ℂ q,
            inducingPrimitiveCenteredEndpointMaximum x q χ := by
  apply Finset.sup'_le (weightedEndpointRange_nonempty hx)
  intro y hy
  apply Finset.sup'_le (coprimeResidues_nonempty (by omega))
  intro a ha
  have haCoprime : Nat.Coprime a q := by
    unfold coprimeResidues at ha
    exact (Finset.mem_filter.mp ha).2
  exact (Finset.le_sup'
      (fun z ↦ |chebyshevProgressionSum z q a -
        Chebyshev.psi (z : ℝ) / (q.totient : ℝ)|) hy).trans
    (centeredProgressionEndpointMaximum_le_log_sq_add_primitive
      hx hq haCoprime)

theorem primitiveCenteredEndpointMaximum_one
    (x : ℕ) (ψ : primitiveCharacters 1) :
    primitiveCenteredEndpointMaximum x 1 ψ = 0 := by
  classical
  unfold primitiveCenteredEndpointMaximum
  split_ifs with hx
  · rw [Finset.sup'_eq_of_forall]
    intro y hy
    rw [show (ψ.1 : DirichletCharacter ℂ 1) = 1 by
      exact DirichletCharacter.level_one ψ.1]
    simp [centeredTwistedChebyshevSum_one]
  · rfl

theorem sum_primitiveCenteredEndpointMaximum_one (x : ℕ) :
    (∑ ψ : primitiveCharacters 1,
      primitiveCenteredEndpointMaximum x 1 ψ) = 0 := by
  apply Fintype.sum_eq_zero
  intro ψ
  exact primitiveCenteredEndpointMaximum_one x ψ

theorem primitiveCharacter_apply_eq_of_isPrimitive
    {d : ℕ} (ψ : primitiveCharacters d) (a : ℤ) :
    ψ.1.primitiveCharacter a = ψ.1 a := by
  by_cases hcop : IsCoprime a d
  · simpa using ψ.1.primitiveCharacter_apply_of_isCoprime hcop
  · have hcon : ψ.1.conductor = d :=
      (DirichletCharacter.isPrimitive_def ψ.1).mp ψ.2
    have hcop' : ¬IsCoprime a ψ.1.conductor := by
      simpa [hcon] using hcop
    have hzero1 : ψ.1.primitiveCharacter a = 0 :=
      (DirichletCharacter.apply_eq_zero_iff _ _).2 hcop'
    have hzero2 : ψ.1 a = 0 :=
      (DirichletCharacter.apply_eq_zero_iff _ _).2 hcop
    rw [hzero1, hzero2]

theorem centeredTwistedChebyshevSum_changeLevel_primitive
    {y q d : ℕ} (hq : 0 < q) (hd : d ∣ q)
    (ψ : primitiveCharacters d) :
    centeredTwistedChebyshevSum y
        (DirichletCharacter.changeLevel hd ψ.1).conductor
        (DirichletCharacter.changeLevel hd ψ.1).primitiveCharacter =
      centeredTwistedChebyshevSum y d ψ.1 := by
  let : NeZero q := ⟨by omega⟩
  have hcon :
      (DirichletCharacter.changeLevel hd ψ.1).conductor = d := by
    rw [DirichletCharacter.conductor_changeLevel]
    exact (DirichletCharacter.isPrimitive_def ψ.1).mp ψ.2
  have hval (n : ℕ) :
      (DirichletCharacter.changeLevel hd ψ.1).primitiveCharacter n =
        ψ.1 n := by
    have h₁ := DirichletCharacter.primitiveCharacter_changeLevel_apply hd ψ.1
      (n : ℤ)
    have h₂ := primitiveCharacter_apply_eq_of_isPrimitive ψ (n : ℤ)
    simpa using h₁.trans h₂
  have hprincipal :
      ((DirichletCharacter.changeLevel hd ψ.1).primitiveCharacter = 1) ↔
        (ψ.1 = 1) := by
    rw [primitiveCharacter_eq_one_iff]
    exact DirichletCharacter.changeLevel_eq_one_iff hd
  unfold centeredTwistedChebyshevSum
  congr 1
  · unfold twistedChebyshevSum
    apply Finset.sum_congr rfl
    intro n hn
    rw [hval]
  · by_cases h :
        (DirichletCharacter.changeLevel hd ψ.1).primitiveCharacter = 1
    · rw [ite_eq_left h, ite_eq_left (hprincipal.mp h)]
    · rw [ite_eq_right h, ite_eq_right (fun hp ↦ h (hprincipal.mpr hp))]

theorem inducingPrimitiveCenteredEndpointMaximum_changeLevel
    {x q d : ℕ} (hq : 0 < q) (hd : d ∣ q)
    (ψ : primitiveCharacters d) :
    inducingPrimitiveCenteredEndpointMaximum x q
        (DirichletCharacter.changeLevel hd ψ.1) =
      primitiveCenteredEndpointMaximum x d ψ := by
  classical
  unfold inducingPrimitiveCenteredEndpointMaximum
    primitiveCenteredEndpointMaximum
  split_ifs with hx
  · apply Finset.sup'_congr (weightedEndpointRange_nonempty hx) rfl
    intro y hy
    rw [centeredTwistedChebyshevSum_changeLevel_primitive hq hd ψ]
  · rfl

theorem sum_inducingPrimitiveCenteredEndpointMaximum_eq_divisors
    {x q : ℕ} (hq : 0 < q) :
    (∑ χ : DirichletCharacter ℂ q,
      inducingPrimitiveCenteredEndpointMaximum x q χ) =
      ∑ d : q.divisors,
        ∑ ψ : primitiveCharacters d.1,
          primitiveCenteredEndpointMaximum x d.1 ψ := by
  rw [sum_characters_eq_sum_divisor_primitive hq]
  apply Fintype.sum_congr
  intro d
  apply Fintype.sum_congr
  intro ψ
  exact inducingPrimitiveCenteredEndpointMaximum_changeLevel hq
    (Nat.dvd_of_mem_divisors d.2) ψ

theorem vaughanLambdaTwo_apply (V : ℝ) (n : ℕ) :
    (arithmeticFunctionLowCutoff V
        (ArithmeticFunction.moebius : ArithmeticFunction ℝ) *
        ArithmeticFunction.log) n =
      ∑ hd ∈ n.divisorsAntidiagonal.filter
        (fun hd : ℕ × ℕ ↦ (hd.2 : ℝ) ≤ V),
        (ArithmeticFunction.moebius hd.2 : ℝ) * Real.log hd.1 := by
  rw [show arithmeticFunctionLowCutoff V
        (ArithmeticFunction.moebius : ArithmeticFunction ℝ) *
          ArithmeticFunction.log =
      ArithmeticFunction.log *
        arithmeticFunctionLowCutoff V
          (ArithmeticFunction.moebius : ArithmeticFunction ℝ) by
    rw [mul_comm], ArithmeticFunction.mul_apply, Finset.sum_filter]
  apply Finset.sum_congr rfl
  intro hd _hhd
  by_cases hdV : (hd.2 : ℝ) ≤ V
  · simp [arithmeticFunctionLowCutoff, hdV, mul_comm]
  · simp [arithmeticFunctionLowCutoff, hdV]

/--
The first Vaughan contribution `∑ χ(n) Λ(n)` over positive integers `n ≤ y` satisfying `n ≤ U`.
-/
noncomputable def vaughanTwistedSumOne
    (U : ℝ) (y q : ℕ) (χ : DirichletCharacter ℂ q) : ℂ :=
  ∑ n ∈ (Finset.Icc 1 y).filter (fun n : ℕ ↦ (n : ℝ) ≤ U),
    χ n * (ArithmeticFunction.vonMangoldt n : ℂ)

/--
The second Vaughan contribution: the character-weighted convolution of `log` with the Möbius
function restricted to divisors `d ≤ V`, summed through `y`.
-/
noncomputable def vaughanTwistedSumTwo
    (V : ℝ) (y q : ℕ) (χ : DirichletCharacter ℂ q) : ℂ :=
  ∑ n ∈ Finset.Icc 1 y,
    χ n *
      ((∑ hd ∈ n.divisorsAntidiagonal.filter
          (fun hd : ℕ × ℕ ↦ (hd.2 : ℝ) ≤ V),
          (ArithmeticFunction.moebius hd.2 : ℝ) * Real.log hd.1 : ℝ) : ℂ)

/--
The negative third Vaughan contribution, obtained by convolving the restricted coefficient `Λ(m)
μ(d)` for `m ≤ U`, `d ≤ V` with the constant-one function and twisting by `χ` through `y`.
-/
noncomputable def vaughanTwistedSumThree
    (U V : ℝ) (y q : ℕ) (χ : DirichletCharacter ℂ q) : ℂ :=
  ∑ n ∈ Finset.Icc 1 y,
    χ n *
      ((-∑ tr ∈ n.divisorsAntidiagonal,
          ∑ md ∈ tr.1.divisorsAntidiagonal.filter
            (fun md : ℕ × ℕ ↦
              (md.1 : ℝ) ≤ U ∧ (md.2 : ℝ) ≤ V),
            ArithmeticFunction.vonMangoldt md.1 *
              (ArithmeticFunction.moebius : ArithmeticFunction ℝ) md.2 : ℝ) : ℂ)

/--
The negative fourth Vaughan contribution over `m * k ≤ y`, `m > U`, and `k > V`, with weight
`χ(m * k) Λ(m)` times the Möbius divisor sum of `k` truncated at `V`.
-/
noncomputable def vaughanTwistedSumFour
    (U V : ℝ) (y q : ℕ) (χ : DirichletCharacter ℂ q) : ℂ :=
  ∑ n ∈ Finset.Icc 1 y,
    χ n *
      ((-∑ mk ∈ n.divisorsAntidiagonal.filter
          (fun mk : ℕ × ℕ ↦
            U < (mk.1 : ℝ) ∧ V < (mk.2 : ℝ)),
          ArithmeticFunction.vonMangoldt mk.1 *
            ∑ d ∈ mk.2.divisors.filter
              (fun d : ℕ ↦ (d : ℝ) ≤ V),
              (ArithmeticFunction.moebius : ArithmeticFunction ℝ) d : ℝ) : ℂ)

theorem norm_vaughanTwistedSumOne_le_cutoffSum
    (U : ℝ) (y q : ℕ) (χ : DirichletCharacter ℂ q) :
    ‖vaughanTwistedSumOne U y q χ‖ ≤
      ∑ n ∈ (Finset.Icc 1 y).filter (fun n : ℕ ↦ (n : ℝ) ≤ U),
        ArithmeticFunction.vonMangoldt n := by
  unfold vaughanTwistedSumOne
  apply norm_sum_le_of_le
  intro n _hn
  rw [norm_mul, Complex.norm_real,
    Real.norm_of_nonneg ArithmeticFunction.vonMangoldt_nonneg]
  exact mul_le_of_le_one_left ArithmeticFunction.vonMangoldt_nonneg (χ.norm_le_one n)

theorem vaughanTwistedSumOne_cutoffSum_le_psi (U : ℝ) (y : ℕ) :
    (∑ n ∈ (Finset.Icc 1 y).filter (fun n : ℕ ↦ (n : ℝ) ≤ U),
      ArithmeticFunction.vonMangoldt n) ≤ Chebyshev.psi U := by
  rw [Chebyshev.psi]
  apply Finset.sum_le_sum_of_subset_of_nonneg
  · intro n hn
    have hn' := Finset.mem_filter.mp hn
    have hnBounds := Finset.mem_Icc.mp hn'.1
    exact Finset.mem_Ioc.mpr
      ⟨Nat.zero_lt_one.trans_le hnBounds.1, Nat.le_floor hn'.2⟩
  · intro n _hn _hnnot
    exact ArithmeticFunction.vonMangoldt_nonneg

theorem norm_vaughanTwistedSumOne_le_psi
    (U : ℝ) (y q : ℕ) (χ : DirichletCharacter ℂ q) :
    ‖vaughanTwistedSumOne U y q χ‖ ≤ Chebyshev.psi U :=
  (norm_vaughanTwistedSumOne_le_cutoffSum U y q χ).trans
    (vaughanTwistedSumOne_cutoffSum_le_psi U y)

/--
The maximum norm of the first Vaughan contribution over integer endpoints `1 ≤ y ≤ x`, with
value zero when `x = 0`.
-/
noncomputable def vaughanTwistedSumOneEndpointMaximum
    (U : ℝ) (x q : ℕ) (χ : DirichletCharacter ℂ q) : ℝ :=
  if hx : 1 ≤ x then
    (Finset.Icc 1 x).sup' ⟨1, Finset.mem_Icc.mpr ⟨le_rfl, hx⟩⟩
      (fun y ↦ ‖vaughanTwistedSumOne U y q χ‖)
  else 0

theorem vaughanTwistedSumOneEndpointMaximum_le_psi
    (U : ℝ) (x q : ℕ) (χ : DirichletCharacter ℂ q) :
    vaughanTwistedSumOneEndpointMaximum U x q χ ≤ Chebyshev.psi U := by
  unfold vaughanTwistedSumOneEndpointMaximum
  split_ifs with hx
  · apply Finset.sup'_le
    intro y _hy
    exact norm_vaughanTwistedSumOne_le_psi U y q χ
  · exact Chebyshev.psi_nonneg U

theorem sum_weightedPrimitiveVaughanTwistedSumOneEndpointMaximum_le
    {U B : ℝ} (hB : Chebyshev.psi U ≤ B) (x Q : ℕ) :
    (∑ q ∈ Finset.Ioc 0 Q,
      (q : ℝ) / (q.totient : ℝ) *
        ∑ χ : primitiveCharacters q,
          vaughanTwistedSumOneEndpointMaximum U x q χ.1) ≤
      B * (Q : ℝ) ^ 2 := by
  have hBnonneg : 0 ≤ B := (Chebyshev.psi_nonneg U).trans hB
  calc
    (∑ q ∈ Finset.Ioc 0 Q,
        (q : ℝ) / (q.totient : ℝ) *
          ∑ χ : primitiveCharacters q,
            vaughanTwistedSumOneEndpointMaximum U x q χ.1) ≤
        ∑ q ∈ Finset.Ioc 0 Q, (q : ℝ) * B := by
      apply Finset.sum_le_sum
      intro q hq
      have hqpos : 0 < q := (Finset.mem_Ioc.mp hq).1
      have hphi : 0 < (q.totient : ℝ) := by
        exact_mod_cast Nat.totient_pos.mpr hqpos
      have hmass :
          (∑ χ : primitiveCharacters q,
            vaughanTwistedSumOneEndpointMaximum U x q χ.1) ≤
            (q.totient : ℝ) * B := by
        calc
          (∑ χ : primitiveCharacters q,
              vaughanTwistedSumOneEndpointMaximum U x q χ.1) ≤
              ∑ _χ : primitiveCharacters q, B := by
            apply Finset.sum_le_sum
            intro χ _hχ
            exact (vaughanTwistedSumOneEndpointMaximum_le_psi
              U x q χ.1).trans hB
          _ = (Fintype.card (primitiveCharacters q) : ℝ) * B := by
            simp
          _ ≤ (q.totient : ℝ) * B := by
            gcongr
            exact_mod_cast card_primitiveCharacters_le_totient hqpos
      calc
        (q : ℝ) / (q.totient : ℝ) *
            (∑ χ : primitiveCharacters q,
              vaughanTwistedSumOneEndpointMaximum U x q χ.1) ≤
            (q : ℝ) / (q.totient : ℝ) *
              ((q.totient : ℝ) * B) := by
          gcongr
        _ = (q : ℝ) * B := by field_simp
    _ ≤ ∑ _q ∈ Finset.Ioc 0 Q, (Q : ℝ) * B := by
      apply Finset.sum_le_sum
      intro q hq
      gcongr
      exact_mod_cast (Finset.mem_Ioc.mp hq).2
    _ = B * (Q : ℝ) ^ 2 := by
      simp [Nat.card_Ioc]
      ring

theorem norm_twistedChebyshevSum_le_psi
    (y q : ℕ) (chi : DirichletCharacter ℂ q) :
    ‖twistedChebyshevSum y q chi‖ ≤ Chebyshev.psi y := by
  rw [twistedChebyshevSum, Chebyshev.psi, Nat.floor_natCast,
    ← Finset.Icc_succ_left_eq_Ioc]
  apply norm_sum_le_of_le
  intro n _hn
  rw [norm_mul, Complex.norm_real,
    Real.norm_of_nonneg ArithmeticFunction.vonMangoldt_nonneg]
  exact mul_le_of_le_one_left ArithmeticFunction.vonMangoldt_nonneg (chi.norm_le_one n)

theorem primitiveRawEndpointMaximum_le_psi
    (x q : ℕ) (chi : primitiveCharacters q) :
    primitiveRawEndpointMaximum x q chi ≤ Chebyshev.psi x := by
  unfold primitiveRawEndpointMaximum
  split_ifs with hx
  · apply Finset.sup'_le
    intro y hy
    exact (norm_twistedChebyshevSum_le_psi y q chi.1).trans
      (Chebyshev.psi_mono (by
        exact_mod_cast (Finset.mem_Icc.mp hy).2))
  · exact Chebyshev.psi_nonneg x

theorem sum_norm_sq_vonMangoldt_vaughanFourthDyadic_le_of_psi
    {A U V : ℝ} (_hA : 0 ≤ A)
    (hpsi : ∀ z : ℝ, 0 ≤ z → Chebyshev.psi z ≤ A * z)
    (x alpha : ℕ) :
    (∑ m ∈ vaughanFourthDyadicMIndices U V x alpha,
      ‖((ArithmeticFunction.vonMangoldt m : ℝ) : ℂ)‖ ^ 2) ≤
      2 * A * (2 ^ alpha : ℕ) *
        Real.log (2 * ((2 ^ alpha : ℕ) : ℝ)) := by
  let M : ℕ := 2 ^ alpha
  have hMpos : 0 < M := by
    dsimp only [M]
    positivity
  have hMnonneg : 0 ≤ (M : ℝ) := Nat.cast_nonneg M
  have hlogNonneg : 0 ≤ Real.log (2 * (M : ℝ)) := by
    apply Real.log_nonneg
    have hMoneNat : 1 ≤ M := by omega
    have hMone : (1 : ℝ) ≤ M := by exact_mod_cast hMoneNat
    nlinarith
  have hsupport (m : ℕ)
      (hm : m ∈ vaughanFourthDyadicMIndices U V x alpha) :
      0 < m ∧ m ≤ 2 * M := by
    rcases Finset.mem_filter.mp hm with ⟨hmBlock, _hmCutoffs⟩
    rcases Finset.mem_Ioc.mp hmBlock with ⟨hMlt, hmUpper⟩
    refine ⟨hMpos.trans hMlt, ?_⟩
    simpa only [M, dyadicBlock, pow_succ, Nat.succ_eq_add_one,
      Nat.mul_comm] using hmUpper
  have hpoint (m : ℕ)
      (hm : m ∈ vaughanFourthDyadicMIndices U V x alpha) :
      ‖((ArithmeticFunction.vonMangoldt m : ℝ) : ℂ)‖ ^ 2 ≤
        ArithmeticFunction.vonMangoldt m * Real.log (2 * (M : ℝ)) := by
    have hmBounds := hsupport m hm
    have hmPosReal : 0 < (m : ℝ) := by exact_mod_cast hmBounds.1
    have hmUpperReal : (m : ℝ) ≤ 2 * (M : ℝ) := by
      exact_mod_cast hmBounds.2
    simp only [Complex.norm_real,
      Real.norm_of_nonneg ArithmeticFunction.vonMangoldt_nonneg, pow_two]
    apply mul_le_mul_of_nonneg_left _ ArithmeticFunction.vonMangoldt_nonneg
    exact ArithmeticFunction.vonMangoldt_le_log.trans
      (Real.log_le_log hmPosReal hmUpperReal)
  have hprefix :
      (∑ m ∈ vaughanFourthDyadicMIndices U V x alpha,
        ArithmeticFunction.vonMangoldt m) ≤
        Chebyshev.psi ((2 * M : ℕ) : ℝ) := by
    rw [Chebyshev.psi, Nat.floor_natCast]
    apply Finset.sum_le_sum_of_subset_of_nonneg
    · intro m hm
      exact Finset.mem_Ioc.mpr (hsupport m hm)
    · intro m _hm _hmNot
      exact ArithmeticFunction.vonMangoldt_nonneg
  calc
    (∑ m ∈ vaughanFourthDyadicMIndices U V x alpha,
        ‖((ArithmeticFunction.vonMangoldt m : ℝ) : ℂ)‖ ^ 2) ≤
        ∑ m ∈ vaughanFourthDyadicMIndices U V x alpha,
          ArithmeticFunction.vonMangoldt m * Real.log (2 * (M : ℝ)) := by
      apply Finset.sum_le_sum
      intro m hm
      exact hpoint m hm
    _ = (∑ m ∈ vaughanFourthDyadicMIndices U V x alpha,
          ArithmeticFunction.vonMangoldt m) * Real.log (2 * (M : ℝ)) := by
      rw [Finset.sum_mul]
    _ ≤ Chebyshev.psi ((2 * M : ℕ) : ℝ) *
        Real.log (2 * (M : ℝ)) :=
      mul_le_mul_of_nonneg_right hprefix hlogNonneg
    _ ≤ (A * ((2 * M : ℕ) : ℝ)) * Real.log (2 * (M : ℝ)) := by
      apply mul_le_mul_of_nonneg_right _ hlogNonneg
      exact hpsi _ (by positivity)
    _ = 2 * A * (M : ℝ) * Real.log (2 * (M : ℝ)) := by
      push_cast
      ring
    _ = 2 * A * (2 ^ alpha : ℕ) *
        Real.log (2 * ((2 ^ alpha : ℕ) : ℝ)) := by
      rfl

theorem sqrt_sum_norm_sq_vonMangoldt_vaughanFourthDyadic_le_of_psi
    {A U V : ℝ} (hA : 0 ≤ A)
    (hpsi : ∀ z : ℝ, 0 ≤ z → Chebyshev.psi z ≤ A * z)
    (x alpha : ℕ) :
    Real.sqrt (∑ m ∈ vaughanFourthDyadicMIndices U V x alpha,
      ‖((ArithmeticFunction.vonMangoldt m : ℝ) : ℂ)‖ ^ 2) ≤
      Real.sqrt 2 * Real.sqrt A * Real.sqrt ((2 ^ alpha : ℕ) : ℝ) *
        Real.sqrt (Real.log (2 * ((2 ^ alpha : ℕ) : ℝ))) := by
  let M : ℕ := 2 ^ alpha
  have hMnonneg : 0 ≤ (M : ℝ) := Nat.cast_nonneg M
  have henergy :=
    sum_norm_sq_vonMangoldt_vaughanFourthDyadic_le_of_psi
      (A := A) (U := U) (V := V) hA hpsi x alpha
  change Real.sqrt (∑ m ∈ vaughanFourthDyadicMIndices U V x alpha,
      ‖((ArithmeticFunction.vonMangoldt m : ℝ) : ℂ)‖ ^ 2) ≤
    Real.sqrt 2 * Real.sqrt A * Real.sqrt (M : ℝ) *
      Real.sqrt (Real.log (2 * (M : ℝ)))
  change (∑ m ∈ vaughanFourthDyadicMIndices U V x alpha,
      ‖((ArithmeticFunction.vonMangoldt m : ℝ) : ℂ)‖ ^ 2) ≤
    2 * A * (M : ℝ) * Real.log (2 * (M : ℝ)) at henergy
  calc
    Real.sqrt (∑ m ∈ vaughanFourthDyadicMIndices U V x alpha,
        ‖((ArithmeticFunction.vonMangoldt m : ℝ) : ℂ)‖ ^ 2) ≤
        Real.sqrt (2 * A * (M : ℝ) * Real.log (2 * (M : ℝ))) :=
      Real.sqrt_le_sqrt henergy
    _ = Real.sqrt (2 * (A * ((M : ℝ) * Real.log (2 * (M : ℝ))))) := by
      congr 1
      ring
    _ = Real.sqrt 2 * Real.sqrt (A *
        ((M : ℝ) * Real.log (2 * (M : ℝ)))) := by
      rw [Real.sqrt_mul (by norm_num : (0 : ℝ) ≤ 2)]
    _ = Real.sqrt 2 * (Real.sqrt A *
        Real.sqrt ((M : ℝ) * Real.log (2 * (M : ℝ)))) := by
      rw [Real.sqrt_mul hA]
    _ = Real.sqrt 2 * Real.sqrt A * Real.sqrt (M : ℝ) *
        Real.sqrt (Real.log (2 * (M : ℝ))) := by
      rw [Real.sqrt_mul hMnonneg]
      ring

end

section
open scoped ContDiff

theorem maxCenteredProgressionDiscrepancyUpTo_le_log_sq_add_primitive
    {x q : ℕ} (hx : 2 ≤ x) (hq : 1 ≤ q) :
    maxCenteredProgressionDiscrepancyUpTo x q ≤
      Real.log ((q * x : ℕ) : ℝ) ^ 2 +
        (q.totient : ℝ)⁻¹ *
          ∑ χ : DirichletCharacter ℂ q,
            inducingPrimitiveCenteredEndpointMaximum x q χ := by
  rw [maxCenteredProgressionDiscrepancyUpTo_eq_sup_endpoint_residues
    hx (by omega)]
  exact
    centeredProgressionResidueEndpointMaximum_le_log_sq_add_primitive hx hq

/--
The total primitive centered endpoint mass over factor pairs `d * k ≤ Q` with nontrivial
conductor `d ≤ R`, weighted by `1 / φ(d * k)`.
-/
noncomputable def smallConductorCenteredMass
    (x Q R : ℕ) : ℝ :=
  ∑ p ∈ (positiveFactorPairs Q).filter (fun p ↦
      p.1 ≠ 1 ∧ p.1 ≤ R),
    ((p.1 * p.2).totient : ℝ)⁻¹ *
      ∑ ψ : primitiveCharacters p.1,
        primitiveCenteredEndpointMaximum x p.1 ψ

/--
The total primitive centered endpoint mass over factor pairs `d * k ≤ Q` with nontrivial
conductor `d > R`, weighted by `1 / φ(d * k)`.
-/
noncomputable def largeConductorCenteredMass
    (x Q R : ℕ) : ℝ :=
  ∑ p ∈ (positiveFactorPairs Q).filter (fun p ↦
      p.1 ≠ 1 ∧ R < p.1),
    ((p.1 * p.2).totient : ℝ)⁻¹ *
      ∑ ψ : primitiveCharacters p.1,
        primitiveCenteredEndpointMaximum x p.1 ψ

theorem sum_weightedInducingPrimitiveCenteredEndpointMaximum_eq_allFactorPairs
    (x Q : ℕ) :
    (∑ q ∈ Finset.Icc 1 Q,
      (q.totient : ℝ)⁻¹ *
        ∑ χ : DirichletCharacter ℂ q,
          inducingPrimitiveCenteredEndpointMaximum x q χ) =
      ∑ p ∈ (positiveFactorPairs Q).filter (fun p ↦ p.1 ≠ 1),
        ((p.1 * p.2).totient : ℝ)⁻¹ *
          ∑ ψ : primitiveCharacters p.1,
            primitiveCenteredEndpointMaximum x p.1 ψ := by
  classical
  have hindex : Finset.Icc 1 Q = Finset.Ioc 0 Q := by
    ext q
    simp only [Finset.mem_Icc, Finset.mem_Ioc]
    omega
  let F : ∀ {q d : ℕ}, d ∣ q → primitiveCharacters d → ℝ :=
    fun {q d} _ ψ ↦
      (q.totient : ℝ)⁻¹ * primitiveCenteredEndpointMaximum x d ψ
  let G : ℕ × ℕ → ℝ := fun p ↦
    ((p.1 * p.2).totient : ℝ)⁻¹ *
      ∑ ψ : primitiveCharacters p.1,
        primitiveCenteredEndpointMaximum x p.1 ψ
  have hleft :
      (∑ q ∈ Finset.Icc 1 Q,
        (q.totient : ℝ)⁻¹ *
          ∑ χ : DirichletCharacter ℂ q,
            inducingPrimitiveCenteredEndpointMaximum x q χ) =
        ∑ q ∈ Finset.Ioc 0 Q,
          ∑ d : q.divisors,
            ∑ ψ : primitiveCharacters d.1,
              F (Nat.dvd_of_mem_divisors d.2) ψ := by
    rw [hindex]
    apply Finset.sum_congr rfl
    intro q hq
    have hqpos : 0 < q := (Finset.mem_Ioc.mp hq).1
    rw [sum_inducingPrimitiveCenteredEndpointMaximum_eq_divisors hqpos]
    rw [Finset.mul_sum]
    apply Fintype.sum_congr
    intro d
    rw [Finset.mul_sum]
  have hreindex :
      (∑ q ∈ Finset.Ioc 0 Q,
        ∑ d : q.divisors,
          ∑ ψ : primitiveCharacters d.1,
            F (Nat.dvd_of_mem_divisors d.2) ψ) =
        ∑ p ∈ positiveFactorPairs Q,
          ∑ ψ : primitiveCharacters p.1,
            F (Nat.dvd_mul_right p.1 p.2) ψ :=
    sum_primitive_conductors_up_to_eq_sum_positiveFactorPairs F
  have hright :
      (∑ p ∈ positiveFactorPairs Q,
        ∑ ψ : primitiveCharacters p.1,
          F (Nat.dvd_mul_right p.1 p.2) ψ) =
        ∑ p ∈ positiveFactorPairs Q, G p := by
    apply Finset.sum_congr rfl
    intro p hp
    change (∑ ψ : primitiveCharacters p.1,
      ((p.1 * p.2).totient : ℝ)⁻¹ *
        primitiveCenteredEndpointMaximum x p.1 ψ) = G p
    unfold G
    rw [Finset.mul_sum]
  have hzero : ∀ p ∈ positiveFactorPairs Q, p.1 = 1 → G p = 0 := by
    intro p hp hp1
    rcases p with ⟨d, k⟩
    simp only at hp1 ⊢
    subst d
    apply mul_eq_zero_of_right
    exact sum_primitiveCenteredEndpointMaximum_one x
  have hfilter :
      (∑ p ∈ (positiveFactorPairs Q).filter (fun p ↦ p.1 ≠ 1), G p) =
        ∑ p ∈ positiveFactorPairs Q, G p := by
    apply Finset.sum_subset (Finset.filter_subset _ _)
    intro p hp hnot
    have hp1 : p.1 = 1 := by
      by_contra hpne
      exact hnot (Finset.mem_filter.mpr ⟨hp, hpne⟩)
    exact hzero p hp hp1
  exact hleft.trans (hreindex.trans (hright.trans hfilter.symm))

theorem allModulusCenteredCharacterMass_eq_small_add_large
    (x Q R : ℕ) :
    (∑ q ∈ Finset.Icc 1 Q,
      (q.totient : ℝ)⁻¹ *
        ∑ χ : DirichletCharacter ℂ q,
          inducingPrimitiveCenteredEndpointMaximum x q χ) =
      smallConductorCenteredMass x Q R +
        largeConductorCenteredMass x Q R := by
  classical
  rw [sum_weightedInducingPrimitiveCenteredEndpointMaximum_eq_allFactorPairs]
  unfold smallConductorCenteredMass largeConductorCenteredMass
  simpa only [Finset.filter_filter, not_le] using
    (Finset.sum_filter_add_sum_filter_not
      ((positiveFactorPairs Q).filter (fun p ↦ p.1 ≠ 1))
      (fun p ↦ p.1 ≤ R)
      (fun p ↦ ((p.1 * p.2).totient : ℝ)⁻¹ *
        ∑ ψ : primitiveCharacters p.1,
          primitiveCenteredEndpointMaximum x p.1 ψ)).symm

theorem
    sum_allModuli_maxCenteredProgressionDiscrepancyUpTo_le_log_sq_add_inducing
    (x Q : ℕ) (hx : 2 ≤ x) :
    (∑ q ∈ Finset.Icc 1 Q,
      maxCenteredProgressionDiscrepancyUpTo x q) ≤
      (Q : ℝ) * Real.log ((Q * x : ℕ) : ℝ) ^ 2 +
        ∑ q ∈ Finset.Icc 1 Q,
          (q.totient : ℝ)⁻¹ *
            ∑ χ : DirichletCharacter ℂ q,
              inducingPrimitiveCenteredEndpointMaximum x q χ := by
  calc
    (∑ q ∈ Finset.Icc 1 Q,
        maxCenteredProgressionDiscrepancyUpTo x q) ≤
        ∑ q ∈ Finset.Icc 1 Q,
          (Real.log ((q * x : ℕ) : ℝ) ^ 2 +
            (q.totient : ℝ)⁻¹ *
              ∑ χ : DirichletCharacter ℂ q,
                inducingPrimitiveCenteredEndpointMaximum x q χ) := by
      apply Finset.sum_le_sum
      intro q hq
      exact maxCenteredProgressionDiscrepancyUpTo_le_log_sq_add_primitive
        hx (Finset.mem_Icc.mp hq).1
    _ = (∑ q ∈ Finset.Icc 1 Q,
          Real.log ((q * x : ℕ) : ℝ) ^ 2) +
        ∑ q ∈ Finset.Icc 1 Q,
          (q.totient : ℝ)⁻¹ *
            ∑ χ : DirichletCharacter ℂ q,
              inducingPrimitiveCenteredEndpointMaximum x q χ := by
      rw [Finset.sum_add_distrib]
    _ ≤ (Q : ℝ) * Real.log ((Q * x : ℕ) : ℝ) ^ 2 +
        ∑ q ∈ Finset.Icc 1 Q,
          (q.totient : ℝ)⁻¹ *
            ∑ χ : DirichletCharacter ℂ q,
              inducingPrimitiveCenteredEndpointMaximum x q χ :=
      add_le_add (sum_allModuli_log_sq_le x Q hx) le_rfl

theorem
    sum_maxCenteredProgressionDiscrepancyUpTo_le_log_sq_add_small_add_large
    (x Q R : ℕ) (hx : 2 ≤ x) :
    (∑ q ∈ Finset.Icc 1 Q,
      maxCenteredProgressionDiscrepancyUpTo x q) ≤
      (Q : ℝ) * Real.log ((Q * x : ℕ) : ℝ) ^ 2 +
        smallConductorCenteredMass x Q R +
          largeConductorCenteredMass x Q R := by
  calc
    (∑ q ∈ Finset.Icc 1 Q,
        maxCenteredProgressionDiscrepancyUpTo x q) ≤
        (Q : ℝ) * Real.log ((Q * x : ℕ) : ℝ) ^ 2 +
          ∑ q ∈ Finset.Icc 1 Q,
            (q.totient : ℝ)⁻¹ *
              ∑ χ : DirichletCharacter ℂ q,
                inducingPrimitiveCenteredEndpointMaximum x q χ :=
      sum_allModuli_maxCenteredProgressionDiscrepancyUpTo_le_log_sq_add_inducing
        x Q hx
    _ = (Q : ℝ) * Real.log ((Q * x : ℕ) : ℝ) ^ 2 +
        smallConductorCenteredMass x Q R +
          largeConductorCenteredMass x Q R := by
      rw [allModulusCenteredCharacterMass_eq_small_add_large]
      ring

theorem sum_primitiveCenteredEndpointMaximum_nonneg (x d : ℕ) :
    0 ≤ ∑ ψ : primitiveCharacters d,
      primitiveCenteredEndpointMaximum x d ψ := by
  apply Finset.sum_nonneg
  intro ψ hψ
  unfold primitiveCenteredEndpointMaximum
  split_ifs with hx
  · exact (norm_nonneg _).trans (Finset.le_sup'
      (fun y ↦ ‖centeredTwistedChebyshevSum y d ψ.1‖)
      (weightedEndpointRange_nonempty hx).choose_spec)
  · rfl

theorem primitiveCenteredEndpointMaximum_eq_raw
    (x : ℕ) {d : ℕ} (hd : 1 < d)
    (ψ : primitiveCharacters d) :
    primitiveCenteredEndpointMaximum x d ψ =
      primitiveRawEndpointMaximum x d ψ := by
  classical
  unfold primitiveCenteredEndpointMaximum primitiveRawEndpointMaximum
  split_ifs with hx
  · apply Finset.sup'_congr (weightedEndpointRange_nonempty hx) rfl
    intro y hy
    rw [centeredTwistedChebyshevSum_eq_twisted_of_primitive hd ψ]
  · rfl

theorem sum_primitiveCenteredEndpointMaximum_eq_raw
    (x : ℕ) {d : ℕ} (hd : 1 < d) :
    (∑ ψ : primitiveCharacters d,
      primitiveCenteredEndpointMaximum x d ψ) =
      ∑ ψ : primitiveCharacters d,
        primitiveRawEndpointMaximum x d ψ := by
  apply Fintype.sum_congr
  intro ψ
  exact primitiveCenteredEndpointMaximum_eq_raw x hd ψ

theorem vaughanTwistedSumTwo_eq_divisorLogSums
    (V : ℝ) (y q : ℕ) (χ : DirichletCharacter ℂ q) :
    vaughanTwistedSumTwo V y q χ =
      ∑ d ∈ vaughanSecondTermIndices V y,
        ((ArithmeticFunction.moebius d : ℝ) : ℂ) * χ d *
          ∑ h ∈ Finset.Icc 1 (y / d),
            χ h * (Real.log h : ℂ) := by
  unfold vaughanTwistedSumTwo
  rw [show Finset.Icc 1 y = Finset.Ioc 0 y by
    simpa using Finset.Icc_succ_left_eq_Ioc 0 y]
  simp_rw [Complex.ofReal_sum, Complex.ofReal_mul, Finset.mul_sum]
  calc
    (∑ n ∈ Finset.Ioc 0 y,
        ∑ p ∈ n.divisorsAntidiagonal.filter
            (fun p : ℕ × ℕ ↦ (p.2 : ℝ) ≤ V),
          χ n *
            (((ArithmeticFunction.moebius p.2 : ℝ) : ℂ) *
              (Real.log p.1 : ℂ))) =
        ∑ n ∈ Finset.Ioc 0 y,
          ∑ p ∈ n.divisorsAntidiagonal,
            if (p.2 : ℝ) ≤ V then
              χ (p.1 * p.2) *
                (((ArithmeticFunction.moebius p.2 : ℝ) : ℂ) *
                  (Real.log p.1 : ℂ))
            else 0 := by
      apply Finset.sum_congr rfl
      intro n _hn
      rw [Finset.sum_filter]
      apply Finset.sum_congr rfl
      intro p hp
      rw [← (Nat.mem_divisorsAntidiagonal.mp hp).1]
      simp only [Nat.cast_mul]
    _ = ∑ p ∈ vaughanSecondTermFactorPairs y,
          if (p.2 : ℝ) ≤ V then
            χ (p.1 * p.2) *
              (((ArithmeticFunction.moebius p.2 : ℝ) : ℂ) *
                (Real.log p.1 : ℂ))
          else 0 :=
      sum_divisorsAntidiagonal_up_to_eq_sum_secondTermFactorPairs
        (fun h d ↦ if (d : ℝ) ≤ V then
          χ (h * d) *
            (((ArithmeticFunction.moebius d : ℝ) : ℂ) *
              (Real.log h : ℂ))
          else 0)
    _ = ∑ p ∈ (vaughanSecondTermFactorPairs y).filter
            (fun p ↦ (p.2 : ℝ) ≤ V),
          ((ArithmeticFunction.moebius p.2 : ℝ) : ℂ) * χ p.2 *
            (χ p.1 * (Real.log p.1 : ℂ)) := by
      rw [Finset.sum_filter]
      apply Finset.sum_congr rfl
      intro p _hp
      by_cases hpV : (p.2 : ℝ) ≤ V
      · rw [ite_eq_left hpV, ite_eq_left hpV, map_mul]
        ring
      · rw [ite_eq_right hpV, ite_eq_right hpV]
    _ = ∑ d ∈ vaughanSecondTermIndices V y,
          ∑ h ∈ Finset.Icc 1 (y / d),
            ((ArithmeticFunction.moebius d : ℝ) : ℂ) * χ d *
              (χ h * (Real.log h : ℂ)) :=
      Finset.sum_finset_product_right'
        ((vaughanSecondTermFactorPairs y).filter
          (fun p : ℕ × ℕ ↦ (p.2 : ℝ) ≤ V))
        (vaughanSecondTermIndices V y)
        (fun d ↦ Finset.Icc 1 (y / d))
        mem_secondTermFactorPairs_filter_iff
        (f := fun h d ↦
          ((ArithmeticFunction.moebius d : ℝ) : ℂ) * χ d *
            (χ h * (Real.log h : ℂ)))

theorem norm_vaughanTwistedSumTwo_le_log_mul_sum_suffixMaximum
    {V : ℝ} {y q : ℕ} (hy : 1 ≤ y)
    (χ : DirichletCharacter ℂ q) :
    ‖vaughanTwistedSumTwo V y q χ‖ ≤
      Real.log y *
        ∑ d ∈ vaughanSecondTermIndices V y,
          dirichletCharacterSuffixMaximum y (y / d) q χ := by
  rw [vaughanTwistedSumTwo_eq_divisorLogSums]
  conv_rhs => rw [Finset.mul_sum]
  apply norm_sum_le_of_le
  intro d _hd
  have hmu : ‖((ArithmeticFunction.moebius d : ℝ) : ℂ)‖ ≤ 1 := by
    rw [Complex.norm_real, Real.norm_eq_abs]
    exact_mod_cast ArithmeticFunction.abs_moebius_le_one (n := d)
  rw [norm_mul, norm_mul]
  exact (mul_le_of_le_one_left (norm_nonneg _)
    ((mul_le_of_le_one_left (norm_nonneg _) hmu).trans (χ.norm_le_one d))).trans
      (norm_sum_character_mul_log_le_log_mul_suffixMaximum
        (H := y / d) (x := y) (Nat.div_le_self y d) hy χ)

theorem norm_vaughanTwistedSumTwo_le_card_mul_of_intervalBound
    {V C : ℝ} {y q : ℕ} (hy : 1 ≤ y)
    (χ : DirichletCharacter ℂ q)
    (hinterval :
      ∀ d ∈ vaughanSecondTermIndices V y,
        ∀ a ∈ Finset.Icc 1 y,
          ‖dirichletCharacterIntervalSum a (y / d) q χ‖ ≤ C) :
    ‖vaughanTwistedSumTwo V y q χ‖ ≤
      Real.log y * ((vaughanSecondTermIndices V y).card : ℝ) * C := by
  have hlog : 0 ≤ Real.log y := Real.log_nonneg (by exact_mod_cast hy)
  have hmax (d : ℕ) (hd : d ∈ vaughanSecondTermIndices V y) :
      dirichletCharacterSuffixMaximum y (y / d) q χ ≤ C := by
    rw [dirichletCharacterSuffixMaximum, dite_eq_left hy]
    apply Finset.sup'_le
    intro a ha
    exact hinterval d hd a ha
  calc
    ‖vaughanTwistedSumTwo V y q χ‖ ≤
        Real.log y *
          ∑ d ∈ vaughanSecondTermIndices V y,
            dirichletCharacterSuffixMaximum y (y / d) q χ :=
      norm_vaughanTwistedSumTwo_le_log_mul_sum_suffixMaximum hy χ
    _ ≤ Real.log y *
        ∑ _d ∈ vaughanSecondTermIndices V y, C := by
      gcongr with d hd
      exact hmax d hd
    _ = Real.log y * ((vaughanSecondTermIndices V y).card : ℝ) * C := by
      simp [mul_assoc]

theorem norm_vaughanTwistedSumTwo_le_cutoff_mul_of_intervalBound
    {V C : ℝ} {y q : ℕ} (hV : 1 ≤ V) (hy : 1 ≤ y)
    (hC : 0 ≤ C) (χ : DirichletCharacter ℂ q)
    (hinterval :
      ∀ d ∈ vaughanSecondTermIndices V y,
        ∀ a ∈ Finset.Icc 1 y,
          ‖dirichletCharacterIntervalSum a (y / d) q χ‖ ≤ C) :
    ‖vaughanTwistedSumTwo V y q χ‖ ≤ V * Real.log y * C := by
  have hcard := norm_vaughanTwistedSumTwo_le_card_mul_of_intervalBound
    hy χ hinterval
  have hlog : 0 ≤ Real.log y := Real.log_nonneg (by exact_mod_cast hy)
  have hcardCut := card_vaughanSecondTermIndices_le_cutoff hV y
  calc
    ‖vaughanTwistedSumTwo V y q χ‖ ≤
        Real.log y * ((vaughanSecondTermIndices V y).card : ℝ) * C := hcard
    _ ≤ Real.log y * V * C :=
      mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_left hcardCut hlog) hC
    _ = V * Real.log y * C := by ring

theorem norm_vaughanTwistedSumTwo_level_one_le_endpoint_mul_log_mul_one_add_log
    {V : ℝ} {y : ℕ} (hV : 1 ≤ V) (hy : 1 ≤ y)
    (chi : DirichletCharacter ℂ 1) :
    ‖vaughanTwistedSumTwo V y 1 chi‖ ≤
      (y : ℝ) * Real.log (y : ℝ) * (1 + Real.log V) := by
  have hlogy : 0 ≤ Real.log (y : ℝ) :=
    Real.log_nonneg (by exact_mod_cast hy)
  have hsuffix (d : ℕ) (hd : d ∈ vaughanSecondTermIndices V y) :
      dirichletCharacterSuffixMaximum y (y / d) 1 chi ≤
        (y : ℝ) * ((d : ℝ))⁻¹ := by
    have hmax :
        dirichletCharacterSuffixMaximum y (y / d) 1 chi ≤
          ((y / d : ℕ) : ℝ) := by
      rw [dirichletCharacterSuffixMaximum, dite_eq_left hy]
      apply Finset.sup'_le
      intro a ha
      exact norm_dirichletCharacterIntervalSum_level_one_le_upper
        (Finset.mem_Icc.mp ha).1 chi
    calc
      dirichletCharacterSuffixMaximum y (y / d) 1 chi ≤
          ((y / d : ℕ) : ℝ) := hmax
      _ ≤ (y : ℝ) / (d : ℝ) := Nat.cast_div_le
      _ = (y : ℝ) * ((d : ℝ))⁻¹ := by rw [div_eq_mul_inv]
  calc
    ‖vaughanTwistedSumTwo V y 1 chi‖ ≤
        Real.log (y : ℝ) *
          ∑ d ∈ vaughanSecondTermIndices V y,
            dirichletCharacterSuffixMaximum y (y / d) 1 chi :=
      norm_vaughanTwistedSumTwo_le_log_mul_sum_suffixMaximum hy chi
    _ ≤ Real.log (y : ℝ) *
        ∑ d ∈ vaughanSecondTermIndices V y,
          (y : ℝ) * ((d : ℝ))⁻¹ := by
      gcongr with d hd
      exact hsuffix d hd
    _ = (y : ℝ) * Real.log (y : ℝ) *
        ∑ d ∈ vaughanSecondTermIndices V y, ((d : ℝ))⁻¹ := by
      rw [← Finset.mul_sum]
      ring
    _ ≤ (y : ℝ) * Real.log (y : ℝ) * (1 + Real.log V) := by
      gcongr
      exact sum_inv_vaughanSecondTermIndices_le_one_add_log hV y

theorem norm_vaughanTwistedSumTwo_level_one_lt_endpoint_mul_log_sq
    {V : ℝ} {x y : ℕ}
    (hx : 4 ≤ x) (hV : 1 ≤ V) (hyx : y ≤ x)
    (chi : DirichletCharacter ℂ 1) :
    ‖vaughanTwistedSumTwo V y 1 chi‖ <
      (x : ℝ) * (Real.log ((x : ℝ) * V)) ^ 2 := by
  have hxpos : (0 : ℝ) < x := by
    exact_mod_cast (show 0 < x by omega)
  have hxone : (1 : ℝ) < x := by
    exact_mod_cast (show 1 < x by omega)
  have hVpos : (0 : ℝ) < V := zero_lt_one.trans_le hV
  have hlogV : 0 ≤ Real.log V := Real.log_nonneg hV
  have hlogTwo : (2 / 3 : ℝ) < Real.log 2 := by
    convert Real.lt_log_one_add_of_pos (x := (1 : ℝ)) (by norm_num) using 1 <;>
      norm_num
  have hlogFour : (4 / 3 : ℝ) < Real.log 4 := by
    calc
      (4 / 3 : ℝ) = 2 * (2 / 3) := by ring
      _ < 2 * Real.log 2 := by nlinarith
      _ = Real.log 4 := by
        rw [show (4 : ℝ) = 2 * 2 by norm_num,
          Real.log_mul (by norm_num) (by norm_num)]
        ring
  have hlogFourLe : Real.log (4 : ℝ) ≤ Real.log (x : ℝ) :=
    Real.log_le_log (by norm_num) (by exact_mod_cast hx)
  have hlogx : 1 < Real.log (x : ℝ) := by linarith
  have hlogStrict :
      Real.log (x : ℝ) * (1 + Real.log V) <
        (Real.log ((x : ℝ) * V)) ^ 2 := by
    rw [Real.log_mul hxpos.ne' hVpos.ne']
    nlinarith [mul_pos (zero_lt_one.trans hlogx) (sub_pos.mpr hlogx),
      sq_nonneg (Real.log V)]
  by_cases hyzero : y = 0
  · subst y
    rw [vaughanTwistedSumTwo_eq_divisorLogSums]
    have hxle : (x : ℝ) ≤ (x : ℝ) * V := by nlinarith
    simpa [vaughanSecondTermIndices] using mul_pos hxpos
      (sq_pos_of_pos (Real.log_pos (hxone.trans_le hxle)))
  · have hy : 1 ≤ y := Nat.one_le_iff_ne_zero.mpr hyzero
    have hyReal : (y : ℝ) ≤ x := by exact_mod_cast hyx
    have hypos : (0 : ℝ) < y := by
      exact_mod_cast (show 0 < y by omega)
    have hlogy : 0 ≤ Real.log (y : ℝ) :=
      Real.log_nonneg (by exact_mod_cast hy)
    have hlogyx : Real.log (y : ℝ) ≤ Real.log (x : ℝ) :=
      Real.log_le_log hypos hyReal
    have hprefix :
        (y : ℝ) * Real.log (y : ℝ) * (1 + Real.log V) ≤
          (x : ℝ) * Real.log (x : ℝ) * (1 + Real.log V) := by
      have hylog :
          (y : ℝ) * Real.log (y : ℝ) ≤
            (x : ℝ) * Real.log (x : ℝ) :=
        mul_le_mul hyReal hlogyx hlogy (le_of_lt hxpos)
      exact mul_le_mul_of_nonneg_right hylog (by linarith)
    calc
      ‖vaughanTwistedSumTwo V y 1 chi‖ ≤
          (y : ℝ) * Real.log (y : ℝ) * (1 + Real.log V) :=
        norm_vaughanTwistedSumTwo_level_one_le_endpoint_mul_log_mul_one_add_log
          hV hy chi
      _ ≤ (x : ℝ) * Real.log (x : ℝ) * (1 + Real.log V) :=
        hprefix
      _ < (x : ℝ) * (Real.log ((x : ℝ) * V)) ^ 2 := by
        simpa only [mul_assoc] using mul_lt_mul_of_pos_left hlogStrict hxpos

theorem neg_vaughanTwistedSumThree_eq_allCoefficientPrefixSums
    (U V : ℝ) (y q : ℕ) (χ : DirichletCharacter ℂ q) :
    -vaughanTwistedSumThree U V y q χ =
      ∑ t ∈ Finset.Icc 1 y,
        ((vaughanThirdCoefficient U V t : ℝ) : ℂ) * χ t *
          dirichletCharacterIntervalSum 1 (y / t) q χ := by
  unfold vaughanTwistedSumThree
  change -(∑ n ∈ Finset.Icc 1 y,
      χ n * ((-∑ tr ∈ n.divisorsAntidiagonal,
        vaughanThirdCoefficient U V tr.1 : ℝ) : ℂ)) = _
  rw [← Finset.sum_neg_distrib]
  calc
    (∑ n ∈ Finset.Icc 1 y,
        -(χ n * ((-∑ tr ∈ n.divisorsAntidiagonal,
          vaughanThirdCoefficient U V tr.1 : ℝ) : ℂ))) =
        ∑ n ∈ Finset.Icc 1 y,
          ∑ tr ∈ n.divisorsAntidiagonal,
            χ n * ((vaughanThirdCoefficient U V tr.1 : ℝ) : ℂ) := by
      apply Finset.sum_congr rfl
      intro n _hn
      rw [Complex.ofReal_neg, Complex.ofReal_sum]
      simp only [mul_neg, neg_neg]
      rw [Finset.mul_sum]
    _ = ∑ n ∈ Finset.Ioc 0 y,
        ∑ tr ∈ n.divisorsAntidiagonal,
          χ (tr.1 * tr.2) *
            ((vaughanThirdCoefficient U V tr.1 : ℝ) : ℂ) := by
      rw [show Finset.Icc 1 y = Finset.Ioc 0 y by
        simpa using Finset.Icc_succ_left_eq_Ioc 0 y]
      apply Finset.sum_congr rfl
      intro n _hn
      apply Finset.sum_congr rfl
      intro tr htr
      rw [← (Nat.mem_divisorsAntidiagonal.mp htr).1]
      simp only [Nat.cast_mul]
    _ = ∑ tr ∈ positiveFactorPairs y,
        χ (tr.1 * tr.2) *
          ((vaughanThirdCoefficient U V tr.1 : ℝ) : ℂ) :=
      sum_divisorsAntidiagonal_up_to_eq_sum_positiveFactorPairs
        (fun t r ↦
          χ (t * r) * ((vaughanThirdCoefficient U V t : ℝ) : ℂ))
    _ = ∑ t ∈ Finset.Icc 1 y,
        ∑ r ∈ Finset.Icc 1 (y / t),
          χ (t * r) *
            ((vaughanThirdCoefficient U V t : ℝ) : ℂ) :=
      Finset.sum_finset_product
        (positiveFactorPairs y) (Finset.Icc 1 y)
        (fun t ↦ Finset.Icc 1 (y / t)) mem_positiveFactorPairs_iff
    _ = ∑ t ∈ Finset.Icc 1 y,
        ((vaughanThirdCoefficient U V t : ℝ) : ℂ) * χ t *
          dirichletCharacterIntervalSum 1 (y / t) q χ := by
      unfold dirichletCharacterIntervalSum
      apply Finset.sum_congr rfl
      intro t _ht
      rw [Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro r _hr
      rw [map_mul]
      ring

theorem neg_vaughanTwistedSumThree_eq_coefficientPrefixSums
    {U V : ℝ} (hU : 1 ≤ U) (hV : 1 ≤ V)
    (y q : ℕ) (χ : DirichletCharacter ℂ q) :
    -vaughanTwistedSumThree U V y q χ =
      ∑ t ∈ (Finset.Icc 1 y).filter
          (fun t : ℕ ↦ (t : ℝ) ≤ U * V),
        ((vaughanThirdCoefficient U V t : ℝ) : ℂ) * χ t *
          dirichletCharacterIntervalSum 1 (y / t) q χ := by
  rw [neg_vaughanTwistedSumThree_eq_allCoefficientPrefixSums]
  symm
  apply Finset.sum_filter_of_ne
  intro t _ht hterm
  by_contra htUV
  have hzero := vaughanThirdCoefficient_eq_zero_of_cutoffProduct_lt
    (zero_le_one.trans hU) (zero_le_one.trans hV) (lt_of_not_ge htUV)
  simp [hzero] at hterm

theorem neg_vaughanTwistedSumThree_eq_small_add_large
    {U V : ℝ} (hU : 1 ≤ U) (hV : 1 ≤ V)
    (y q : ℕ) (χ : DirichletCharacter ℂ q) :
    -vaughanTwistedSumThree U V y q χ =
      vaughanTwistedSumThreeSmall U V y q χ +
        vaughanTwistedSumThreeLarge U V y q χ := by
  let f : ℕ → ℂ := fun t ↦
    ((vaughanThirdCoefficient U V t : ℝ) : ℂ) * χ t *
      dirichletCharacterIntervalSum 1 (y / t) q χ
  have hUUV : U ≤ U * V := by
    calc
      U = U * 1 := (mul_one U).symm
      _ ≤ U * V := mul_le_mul_of_nonneg_left hV (zero_le_one.trans hU)
  have hunion :
      vaughanThirdSmallIndices U y ∪ vaughanThirdLargeIndices U V y =
        (Finset.Icc 1 y).filter (fun t : ℕ ↦ (t : ℝ) ≤ U * V) := by
    ext t
    simp only [vaughanThirdSmallIndices, vaughanThirdLargeIndices,
      Finset.mem_union, Finset.mem_filter]
    constructor
    · rintro (⟨ht, htU⟩ | ⟨ht, _htU, htUV⟩)
      · exact ⟨ht, htU.trans hUUV⟩
      · exact ⟨ht, htUV⟩
    · rintro ⟨ht, htUV⟩
      by_cases htU : (t : ℝ) ≤ U
      · exact Or.inl ⟨ht, htU⟩
      · exact Or.inr ⟨ht, lt_of_not_ge htU, htUV⟩
  have hdisjoint :
      Disjoint (vaughanThirdSmallIndices U y)
        (vaughanThirdLargeIndices U V y) := by
    rw [Finset.disjoint_left]
    intro t htSmall htLarge
    exact (not_lt_of_ge (Finset.mem_filter.mp htSmall).2)
      (Finset.mem_filter.mp htLarge).2.1
  rw [neg_vaughanTwistedSumThree_eq_coefficientPrefixSums hU hV]
  change (∑ t ∈ (Finset.Icc 1 y).filter
      (fun t : ℕ ↦ (t : ℝ) ≤ U * V), f t) = _
  rw [← hunion, Finset.sum_union hdisjoint]
  rfl

theorem vaughanTwistedSumFour_eq_sum_positiveFactorPairs
    (U V : ℝ) (y q : ℕ) (chi : DirichletCharacter ℂ q) :
    vaughanTwistedSumFour U V y q chi =
      -∑ mk ∈ vaughanFourthPairIndices U V y,
        ((ArithmeticFunction.vonMangoldt mk.1 : ℝ) : ℂ) *
          ((vaughanFourthCoefficient V mk.2 : ℝ) : ℂ) *
          chi (mk.1 * mk.2) := by
  let f : ℕ → ℕ → ℂ := fun m k ↦
    if U < (m : ℝ) ∧ V < (k : ℝ) then
      ((ArithmeticFunction.vonMangoldt m : ℝ) : ℂ) *
        ((vaughanFourthCoefficient V k : ℝ) : ℂ) * chi (m * k)
    else 0
  unfold vaughanTwistedSumFour
  calc
    (∑ n ∈ Finset.Icc 1 y,
        chi n *
          ((-∑ mk ∈ n.divisorsAntidiagonal.filter
              (fun mk : ℕ × ℕ ↦
                U < (mk.1 : ℝ) ∧ V < (mk.2 : ℝ)),
              ArithmeticFunction.vonMangoldt mk.1 *
                ∑ d ∈ mk.2.divisors.filter
                  (fun d : ℕ ↦ (d : ℝ) ≤ V),
                  (ArithmeticFunction.moebius : ArithmeticFunction ℝ) d : ℝ) : ℂ)) =
        -(∑ n ∈ Finset.Ioc 0 y,
          ∑ mk ∈ n.divisorsAntidiagonal, f mk.1 mk.2) := by
      rw [show Finset.Icc 1 y = Finset.Ioc 0 y by
        simpa using Finset.Icc_succ_left_eq_Ioc 0 y]
      rw [← Finset.sum_neg_distrib]
      apply Finset.sum_congr rfl
      intro n _hn
      rw [Complex.ofReal_neg, Complex.ofReal_sum, mul_neg, neg_inj,
        Finset.sum_filter, Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro mk hmk
      have hprod := (Nat.mem_divisorsAntidiagonal.mp hmk).1
      by_cases hcut : U < (mk.1 : ℝ) ∧ V < (mk.2 : ℝ)
      · simp only [ite_eq_left hcut, f]
        rw [← hprod, Complex.ofReal_mul,
          show (∑ d ∈ mk.2.divisors.filter (fun d : ℕ ↦ (d : ℝ) ≤ V),
              (ArithmeticFunction.moebius : ArithmeticFunction ℝ) d) =
              vaughanFourthCoefficient V mk.2 by rfl]
        simp only [Nat.cast_mul, map_mul]
        ring
      · simp only [f, ite_eq_right hcut]
        simp
    _ = -(∑ mk ∈ positiveFactorPairs y, f mk.1 mk.2) := by
      rw [sum_divisorsAntidiagonal_up_to_eq_sum_positiveFactorPairs f]
    _ = -∑ mk ∈ vaughanFourthPairIndices U V y,
        ((ArithmeticFunction.vonMangoldt mk.1 : ℝ) : ℂ) *
          ((vaughanFourthCoefficient V mk.2 : ℝ) : ℂ) *
          chi (mk.1 * mk.2) := by
      unfold vaughanFourthPairIndices
      rw [Finset.sum_filter]

theorem vaughanTwistedSumFour_eq_nestedFactorSum
    (U V : ℝ) (y q : ℕ) (chi : DirichletCharacter ℂ q) :
    vaughanTwistedSumFour U V y q chi =
      -∑ m ∈ (Finset.Icc 1 y).filter (fun m : ℕ ↦ U < (m : ℝ)),
        ∑ k ∈ (Finset.Icc 1 (y / m)).filter (fun k : ℕ ↦ V < (k : ℝ)),
          ((ArithmeticFunction.vonMangoldt m : ℝ) : ℂ) *
            ((vaughanFourthCoefficient V k : ℝ) : ℂ) * chi (m * k) := by
  rw [vaughanTwistedSumFour_eq_sum_positiveFactorPairs]
  apply congrArg Neg.neg
  let f : ℕ → ℕ → ℂ := fun m k ↦
    ((ArithmeticFunction.vonMangoldt m : ℝ) : ℂ) *
      ((vaughanFourthCoefficient V k : ℝ) : ℂ) * chi (m * k)
  change (∑ mk ∈ vaughanFourthPairIndices U V y, f mk.1 mk.2) = _
  rw [vaughanFourthPairIndices, Finset.sum_filter]
  calc
    (∑ mk ∈ positiveFactorPairs y,
        if U < (mk.1 : ℝ) ∧ V < (mk.2 : ℝ) then f mk.1 mk.2 else 0) =
        ∑ m ∈ Finset.Icc 1 y,
          ∑ k ∈ Finset.Icc 1 (y / m),
            if U < (m : ℝ) ∧ V < (k : ℝ) then f m k else 0 :=
      Finset.sum_finset_product
        (positiveFactorPairs y) (Finset.Icc 1 y)
        (fun m ↦ Finset.Icc 1 (y / m)) mem_positiveFactorPairs_iff
    _ = ∑ m ∈ (Finset.Icc 1 y).filter (fun m : ℕ ↦ U < (m : ℝ)),
        ∑ k ∈ (Finset.Icc 1 (y / m)).filter (fun k : ℕ ↦ V < (k : ℝ)),
          f m k := by
      simp only [Finset.sum_filter]
      apply Finset.sum_congr rfl
      intro m _hm
      by_cases hmU : U < (m : ℝ)
      · simp only [ite_true, hmU, true_and]
      · simp only [ite_false, hmU, false_and, Finset.sum_const_zero]

/--
The maximum norm of the fourth Vaughan contribution over integer endpoints `1 ≤ y ≤ x`. It is
zero when `x = 0`.
-/
noncomputable def vaughanTwistedSumFourEndpointMaximum
    (U V : ℝ) (x q : ℕ)
    (chi : DirichletCharacter ℂ q) : ℝ :=
  if hx : 1 ≤ x then
    (Finset.Icc 1 x).sup'
      ⟨1, Finset.mem_Icc.mpr ⟨le_rfl, hx⟩⟩
      (fun y ↦ ‖vaughanTwistedSumFour U V y q chi‖)
  else 0

theorem smallConductorCenteredMass_eq_sum_multipliers
    (x Q R : ℕ) :
    smallConductorCenteredMass x Q R =
      ∑ d ∈ Finset.Ioc 1 (min R Q),
        (∑ ψ : primitiveCharacters d,
          primitiveCenteredEndpointMaximum x d ψ) *
          ∑ k ∈ Finset.Ioc 0 (Q / d),
            ((d * k).totient : ℝ)⁻¹ := by
  classical
  unfold smallConductorCenteredMass
  have hreindex :
      (∑ p ∈ (positiveFactorPairs Q).filter (fun p ↦
          p.1 ≠ 1 ∧ p.1 ≤ R),
        ((p.1 * p.2).totient : ℝ)⁻¹ *
          ∑ ψ : primitiveCharacters p.1,
            primitiveCenteredEndpointMaximum x p.1 ψ) =
        ∑ d ∈ Finset.Ioc 0 Q with d ≠ 1 ∧ d ≤ R,
          ∑ k ∈ Finset.Ioc 0 (Q / d),
            ((d * k).totient : ℝ)⁻¹ *
              ∑ ψ : primitiveCharacters d,
                primitiveCenteredEndpointMaximum x d ψ := by
    simpa only using
      (sum_positiveFactorPairs_filter_fst_eq_sum_multipliers
        (Q := Q) (fun d ↦ d ≠ 1 ∧ d ≤ R)
        (fun d k ↦ ((d * k).totient : ℝ)⁻¹ *
          ∑ ψ : primitiveCharacters d,
            primitiveCenteredEndpointMaximum x d ψ))
  have hindex :
      (Finset.Ioc 0 Q).filter (fun d ↦ d ≠ 1 ∧ d ≤ R) =
        Finset.Ioc 1 (min R Q) := by
    ext d
    simp only [Finset.mem_filter, Finset.mem_Ioc]
    omega
  rw [hreindex, hindex]
  apply Finset.sum_congr rfl
  intro d _hd
  rw [Finset.mul_sum]
  apply Finset.sum_congr rfl
  intro k _hk
  rw [mul_comm]

theorem smallConductorCenteredMass_le_of_endpointMaximum
    {x Q R : ℕ} {B : ℝ} (hB : 0 ≤ B)
    (hendpoint : ∀ d : ℕ, 1 < d → d ≤ min R Q →
      ∀ ψ : primitiveCharacters d,
        primitiveCenteredEndpointMaximum x d ψ ≤ B) :
    smallConductorCenteredMass x Q R ≤
      4 * (((min R Q - 1 : ℕ) : ℝ)) *
        (1 + Real.log (Q : ℝ)) * B := by
  rw [smallConductorCenteredMass_eq_sum_multipliers]
  have hlogQ : 0 ≤ Real.log (Q : ℝ) := Real.log_natCast_nonneg Q
  calc
    (∑ d ∈ Finset.Ioc 1 (min R Q),
        (∑ ψ : primitiveCharacters d,
          primitiveCenteredEndpointMaximum x d ψ) *
          ∑ k ∈ Finset.Ioc 0 (Q / d),
            ((d * k).totient : ℝ)⁻¹) ≤
        ∑ _d ∈ Finset.Ioc 1 (min R Q),
          4 * (1 + Real.log (Q : ℝ)) * B := by
      apply Finset.sum_le_sum
      intro d hdmem
      have hdBounds := Finset.mem_Ioc.mp hdmem
      have hdpos : 0 < d := by omega
      have hdQ : d ≤ Q := hdBounds.2.trans (min_le_right R Q)
      have hQdiv : 0 < Q / d := Nat.div_pos hdQ hdpos
      have hphi : 0 < (d.totient : ℝ) := by
        exact_mod_cast Nat.totient_pos.mpr hdpos
      have hmass :
          (∑ ψ : primitiveCharacters d,
            primitiveCenteredEndpointMaximum x d ψ) ≤
            (d.totient : ℝ) * B := by
        calc
          (∑ ψ : primitiveCharacters d,
              primitiveCenteredEndpointMaximum x d ψ) ≤
              ∑ _ψ : primitiveCharacters d, B := by
            apply Finset.sum_le_sum
            intro ψ _hψ
            exact hendpoint d hdBounds.1 hdBounds.2 ψ
          _ = (Fintype.card (primitiveCharacters d) : ℝ) * B := by
            simp
          _ ≤ (d.totient : ℝ) * B := by
            apply mul_le_mul_of_nonneg_right _ hB
            exact_mod_cast card_primitiveCharacters_le_totient hdpos
      have hprefix :
          (∑ k ∈ Finset.Ioc 0 (Q / d),
            (k.totient : ℝ)⁻¹) ≤
            4 * (1 + Real.log ((Q / d : ℕ) : ℝ)) := by
        simpa [reciprocalTotientPrefix] using
          reciprocalTotientPrefix_le_four_mul_one_add_log hQdiv
      have hlogDiv :
          Real.log ((Q / d : ℕ) : ℝ) ≤ Real.log (Q : ℝ) := by
        apply Real.log_le_log
        · exact_mod_cast hQdiv
        · exact_mod_cast Nat.div_le_self Q d
      have hweight :
          (∑ k ∈ Finset.Ioc 0 (Q / d),
            ((d * k).totient : ℝ)⁻¹) ≤
            (d.totient : ℝ)⁻¹ *
              (4 * (1 + Real.log (Q : ℝ))) := by
        calc
          (∑ k ∈ Finset.Ioc 0 (Q / d),
              ((d * k).totient : ℝ)⁻¹) ≤
              (d.totient : ℝ)⁻¹ *
                ∑ k ∈ Finset.Ioc 0 (Q / d),
                  (k.totient : ℝ)⁻¹ :=
            sum_inv_totient_mul_le_inv_totient_mul_sum Q d hdpos
          _ ≤ (d.totient : ℝ)⁻¹ *
              (4 * (1 + Real.log ((Q / d : ℕ) : ℝ))) := by
            exact mul_le_mul_of_nonneg_left hprefix (by positivity)
          _ ≤ (d.totient : ℝ)⁻¹ *
              (4 * (1 + Real.log (Q : ℝ))) := by
            apply mul_le_mul_of_nonneg_left
            · gcongr
            · positivity
      calc
        (∑ ψ : primitiveCharacters d,
            primitiveCenteredEndpointMaximum x d ψ) *
            ∑ k ∈ Finset.Ioc 0 (Q / d),
              ((d * k).totient : ℝ)⁻¹ ≤
            (∑ ψ : primitiveCharacters d,
              primitiveCenteredEndpointMaximum x d ψ) *
              ((d.totient : ℝ)⁻¹ *
                (4 * (1 + Real.log (Q : ℝ)))) :=
          mul_le_mul_of_nonneg_left hweight
            (sum_primitiveCenteredEndpointMaximum_nonneg x d)
        _ ≤ ((d.totient : ℝ) * B) *
              ((d.totient : ℝ)⁻¹ *
                (4 * (1 + Real.log (Q : ℝ)))) := by
          apply mul_le_mul_of_nonneg_right hmass
          positivity
        _ = 4 * (1 + Real.log (Q : ℝ)) * B := by
          field_simp [ne_of_gt hphi]
    _ = 4 * (((min R Q - 1 : ℕ) : ℝ)) *
        (1 + Real.log (Q : ℝ)) * B := by
      rw [Finset.sum_const, nsmul_eq_mul, Nat.card_Ioc]
      ring

/--
The real cube-root scale `x ^ (1 / 3)` for a natural endpoint `x`, defined using real
exponentiation.
-/
noncomputable def vaughanCubeRoot (x : ℕ) : ℝ :=
  Real.rpow (x : ℝ) (1 / 3 : ℝ)

/--
The real sixth-root scale `x ^ (1 / 6)` for a natural endpoint `x`, defined using real
exponentiation.
-/
noncomputable def vaughanSixthRoot (x : ℕ) : ℝ :=
  Real.rpow (x : ℝ) (1 / 6 : ℝ)

theorem vaughanCubeRoot_nonneg (x : ℕ) :
    0 ≤ vaughanCubeRoot x :=
  Real.rpow_nonneg (Nat.cast_nonneg x) _

theorem vaughanSixthRoot_nonneg (x : ℕ) :
    0 ≤ vaughanSixthRoot x :=
  Real.rpow_nonneg (Nat.cast_nonneg x) _

theorem vaughanCubeRoot_pos {x : ℕ} (hx : 1 ≤ x) :
    0 < vaughanCubeRoot x := by
  apply Real.rpow_pos_of_pos
  exact_mod_cast (Nat.zero_lt_of_lt hx)

theorem vaughanSixthRoot_pos {x : ℕ} (hx : 1 ≤ x) :
    0 < vaughanSixthRoot x := by
  apply Real.rpow_pos_of_pos
  exact_mod_cast (Nat.zero_lt_of_lt hx)

theorem one_le_vaughanCubeRoot {x : ℕ} (hx : 1 ≤ x) :
    1 ≤ vaughanCubeRoot x :=
  Real.one_le_rpow (by exact_mod_cast hx) (by norm_num)

theorem one_le_vaughanSixthRoot {x : ℕ} (hx : 1 ≤ x) :
    1 ≤ vaughanSixthRoot x :=
  Real.one_le_rpow (by exact_mod_cast hx) (by norm_num)

theorem vaughanSixthRoot_sq (x : ℕ) :
    vaughanSixthRoot x ^ 2 = vaughanCubeRoot x := by
  convert (Real.rpow_mul_natCast (Nat.cast_nonneg x) (1 / 6 : ℝ) 2).symm using 1 <;>
    norm_num [vaughanSixthRoot, vaughanCubeRoot]

theorem vaughanSixthRoot_cube (x : ℕ) :
    vaughanSixthRoot x ^ 3 = Real.sqrt (x : ℝ) := by
  convert (Real.rpow_mul_natCast (Nat.cast_nonneg x) (1 / 6 : ℝ) 3).symm using 1 <;>
    norm_num [vaughanSixthRoot, Real.sqrt_eq_rpow]

theorem vaughanSixthRoot_pow_six (x : ℕ) :
    vaughanSixthRoot x ^ 6 = (x : ℝ) := by
  unfold vaughanSixthRoot
  calc
    Real.rpow (x : ℝ) (1 / 6 : ℝ) ^ 6 =
        Real.rpow (Real.rpow (x : ℝ) (1 / 6 : ℝ)) (6 : ℝ) :=
      (Real.rpow_natCast _ 6).symm
    _ = Real.rpow (x : ℝ) ((1 / 6 : ℝ) * 6) :=
      (Real.rpow_mul (Nat.cast_nonneg x) (1 / 6 : ℝ) 6).symm
    _ = (x : ℝ) := by norm_num [Real.rpow_one]

theorem vaughanSixthRoot_pow_four (x : ℕ) :
    vaughanSixthRoot x ^ 4 = vaughanCubeRoot x ^ 2 := by
  rw [show vaughanSixthRoot x ^ 4 = (vaughanSixthRoot x ^ 2) ^ 2 by ring,
    vaughanSixthRoot_sq]

theorem vaughanSixthRoot_pow_five (x : ℕ) :
    vaughanSixthRoot x ^ 5 =
      Real.sqrt (x : ℝ) * vaughanCubeRoot x := by
  rw [show vaughanSixthRoot x ^ 5 =
      vaughanSixthRoot x ^ 3 * vaughanSixthRoot x ^ 2 by ring,
    vaughanSixthRoot_cube, vaughanSixthRoot_sq]

theorem vaughanCubeRoot_cube (x : ℕ) :
    vaughanCubeRoot x ^ 3 = (x : ℝ) := by
  rw [← vaughanSixthRoot_sq]
  calc
    (vaughanSixthRoot x ^ 2) ^ 3 = vaughanSixthRoot x ^ 6 := by ring
    _ = (x : ℝ) := vaughanSixthRoot_pow_six x

theorem sqrt_natCast_le_vaughanCubeRoot_sq {x : ℕ} (hx : 1 ≤ x) :
    Real.sqrt (x : ℝ) ≤ vaughanCubeRoot x ^ 2 := by
  rw [← vaughanSixthRoot_cube, ← vaughanSixthRoot_pow_four]
  have hr := one_le_vaughanSixthRoot hx
  nlinarith [sq_nonneg (vaughanSixthRoot x),
    sq_nonneg (vaughanSixthRoot x - 1)]

theorem one_le_vaughanPrimitiveMeanHighCutoff
    {x : ℕ} {q : ℝ} (hx : 4 ≤ x)
    (hq : vaughanCubeRoot x ≤ q)
    (hqsqrt : q ≤ Real.sqrt (x : ℝ)) :
    1 ≤ vaughanCubeRoot x ^ 2 / q := by
  have hcpos : 0 < vaughanCubeRoot x := vaughanCubeRoot_pos (by omega)
  have hqpos : 0 < q := hcpos.trans_le hq
  rw [le_div_iff₀ hqpos, one_mul]
  exact hqsqrt.trans (sqrt_natCast_le_vaughanCubeRoot_sq (by omega))

/--
The algebraic factor `4x + 2√x q² + 6x^(2/3) q√q + 5x^(5/6) q` in the primitive-character
mean-value estimate. Fractional powers of `x` are expressed using its cube root and square root.
-/
noncomputable def vaughanPrimitiveMeanPolynomial
    (x : ℕ) (q : ℝ) : ℝ :=
  4 * (x : ℝ) + 2 * Real.sqrt (x : ℝ) * q ^ 2 +
    6 * vaughanCubeRoot x ^ 2 * (q * Real.sqrt q) +
    5 * (Real.sqrt (x : ℝ) * vaughanCubeRoot x) * q

theorem vaughanPrimitiveMeanPolynomial_nonneg
    (x : ℕ) {q : ℝ} (hq : 0 ≤ q) :
    0 ≤ vaughanPrimitiveMeanPolynomial x q := by
  have hc := vaughanCubeRoot_nonneg x
  unfold vaughanPrimitiveMeanPolynomial
  positivity

theorem vaughanPrimitiveMeanPolynomial_mono
    (x : ℕ) {q r : ℝ} (hq : 0 ≤ q) (hqr : q ≤ r) :
    vaughanPrimitiveMeanPolynomial x q ≤
      vaughanPrimitiveMeanPolynomial x r := by
  have hr : 0 ≤ r := hq.trans hqr
  have hsqrt : Real.sqrt q ≤ Real.sqrt r := Real.sqrt_le_sqrt hqr
  have hsq : q ^ 2 ≤ r ^ 2 := by nlinarith
  have hthreeHalves : q * Real.sqrt q ≤ r * Real.sqrt r :=
    mul_le_mul hqr hsqrt (Real.sqrt_nonneg q) hr
  have hc := vaughanCubeRoot_nonneg x
  unfold vaughanPrimitiveMeanPolynomial
  gcongr

/--
The logarithmic factor `(log x)³ √(log x)` in the first primitive-character mean-value bound.
-/
noncomputable def vaughanPrimitiveMeanLogPower
    (x : ℕ) : ℝ :=
  Real.log (x : ℝ) ^ 3 * Real.sqrt (Real.log (x : ℝ))

theorem vaughanPrimitiveMeanLogPower_nonneg (x : ℕ) :
    0 ≤ vaughanPrimitiveMeanLogPower x := by
  unfold vaughanPrimitiveMeanLogPower
  positivity

theorem one_le_log_natCast {x : ℕ} (hx : 4 ≤ x) :
    1 ≤ Real.log (x : ℝ) := by
  have hlogTwo : (1 / 2 : ℝ) < Real.log 2 :=
    (by norm_num : (1 / 2 : ℝ) < 0.6931471803).trans Real.log_two_gt_d9
  calc
    (1 : ℝ) ≤ 2 * Real.log 2 := by linarith
    _ = Real.log 4 := Real.log_four_eq.symm
    _ ≤ Real.log (x : ℝ) := by
      apply Real.log_le_log (by norm_num)
      exact_mod_cast hx

theorem one_le_vaughanPrimitiveMeanLogPower
    {x : ℕ} (hx : 4 ≤ x) :
    1 ≤ vaughanPrimitiveMeanLogPower x := by
  have hlog := one_le_log_natCast hx
  unfold vaughanPrimitiveMeanLogPower
  have hsqrt : 1 ≤ Real.sqrt (Real.log (x : ℝ)) :=
    Real.one_le_sqrt.mpr hlog
  have hcube : 1 ≤ Real.log (x : ℝ) ^ 3 := by
    simpa using pow_le_pow_left₀ (by norm_num : (0 : ℝ) ≤ 1) hlog 3
  simpa only [one_mul] using
    mul_le_mul hcube hsqrt (by norm_num : (0 : ℝ) ≤ 1) (by linarith)

/--
The nonnegative logarithmic scale `max 0 (log (2 * x / V))` used to bound the number and size of
fourth-term dyadic blocks.
-/
noncomputable def vaughanFourthScaleLog (V : ℝ) (x : ℕ) : ℝ :=
  max 0 (Real.log (2 * (x : ℝ) / V))

theorem vaughanFourthScaleLog_nonneg (V : ℝ) (x : ℕ) :
    0 ≤ vaughanFourthScaleLog V x :=
  le_max_left _ _

theorem card_vaughanFourthDyadicExponents_le_scaleLog
    {U V : ℝ} (hV : 1 ≤ V) (x : ℕ) :
    ((vaughanFourthDyadicExponents U V x).card : ℝ) ≤
      vaughanFourthScaleLog V x / Real.log 2 := by
  have hVpos : 0 < V := zero_lt_one.trans_le hV
  have hquotNonneg : 0 ≤ (x : ℝ) / V :=
    div_nonneg (Nat.cast_nonneg x) hVpos.le
  by_cases hfloorZero : ⌊(x : ℝ) / V⌋₊ = 0
  · have hempty : vaughanFourthDyadicExponents U V x = ∅ := by
      apply Finset.eq_empty_iff_forall_notMem.mpr
      intro alpha halpha
      rcases Finset.mem_filter.mp halpha with ⟨_halphaRange, halphaBounds⟩
      dsimp only at halphaBounds
      have hMfloor : 2 ^ alpha ≤ ⌊(x : ℝ) / V⌋₊ :=
        Nat.le_floor halphaBounds.2.le
      rw [hfloorZero] at hMfloor
      have hMpos : 0 < 2 ^ alpha := by positivity
      omega
    rw [hempty]
    simp only [Finset.card_empty, Nat.cast_zero]
    exact div_nonneg (vaughanFourthScaleLog_nonneg V x)
      (Real.log_pos (by norm_num)).le
  · have hfloorPos : 0 < ⌊(x : ℝ) / V⌋₊ :=
      Nat.pos_of_ne_zero hfloorZero
    have hfloorLe : ((⌊(x : ℝ) / V⌋₊ : ℕ) : ℝ) ≤ (x : ℝ) / V :=
      Nat.floor_le hquotNonneg
    have htwiceFloorLe :
        2 * ((⌊(x : ℝ) / V⌋₊ : ℕ) : ℝ) ≤ 2 * (x : ℝ) / V := by
      calc
        2 * ((⌊(x : ℝ) / V⌋₊ : ℕ) : ℝ) ≤
            2 * ((x : ℝ) / V) :=
          mul_le_mul_of_nonneg_left hfloorLe (by norm_num)
        _ = 2 * (x : ℝ) / V := by ring
    calc
      ((vaughanFourthDyadicExponents U V x).card : ℝ) ≤
          ((dyadicExponentRange ⌊(x : ℝ) / V⌋₊).card : ℝ) := by
        rw [vaughanFourthDyadicExponents]
        exact_mod_cast Finset.card_filter_le
          (dyadicExponentRange ⌊(x : ℝ) / V⌋₊) _
      _ ≤ Real.log (2 * ((⌊(x : ℝ) / V⌋₊ : ℕ) : ℝ)) /
          Real.log 2 :=
        card_dyadicExponentRange_le_log hfloorPos
      _ ≤ Real.log (2 * (x : ℝ) / V) / Real.log 2 := by
        apply div_le_div_of_nonneg_right _ (Real.log_pos (by norm_num)).le
        exact Real.log_le_log (by positivity) htwiceFloorLe
      _ ≤ vaughanFourthScaleLog V x / Real.log 2 := by
        apply div_le_div_of_nonneg_right _ (Real.log_pos (by norm_num)).le
        exact le_max_right _ _

/--
The explicit coefficient `2 * (7/6) * √(7/6) * (1/3 + 3/(2 log 2))` comparing the logarithmic
scale to `(log x)³ √(log x)` when both Vaughan cutoffs equal the cube root of `x`.
-/
noncomputable def vaughanPrimitiveMeanLowLogCoefficient : ℝ :=
  2 * (7 / 6 : ℝ) * Real.sqrt (7 / 6 : ℝ) *
    (1 / 3 + 3 / (2 * Real.log 2))

/--
The explicit coefficient `2 * (4/3) * √(4/3) * (1/3 + 3/(2 log 2))` for logarithmic comparison
when both cutoffs are `x^(2/3) / q`, with `x^(1/3) ≤ q ≤ √x`.
-/
noncomputable def vaughanPrimitiveMeanHighLogCoefficient : ℝ :=
  2 * (4 / 3 : ℝ) * Real.sqrt (4 / 3 : ℝ) *
    (1 / 3 + 3 / (2 * Real.log 2))

/--
The sum of the five algebraic factors arising from the first, second, small-third, large-third,
and fourth Vaughan estimates, before logarithmic factors and common constants are applied.
-/
noncomputable def vaughanPrimitiveMeanAlgebraicScale
    (U V : ℝ) (x : ℕ) (q : ℝ) : ℝ :=
  U * q ^ 2 +
    ((x : ℝ) + q ^ 2 * Real.sqrt q * V) +
    ((x : ℝ) + q ^ 2 * Real.sqrt q * U) +
    ((x : ℝ) + q * Real.sqrt ((x : ℝ) * U * V) +
      Real.sqrt 2 * q * (x : ℝ) / Real.sqrt U +
      q ^ 2 * Real.sqrt (x : ℝ)) +
    ((x : ℝ) + q * (x : ℝ) / Real.sqrt V +
      Real.sqrt 2 * q * (x : ℝ) / Real.sqrt U +
      q ^ 2 * Real.sqrt (x : ℝ))

/--
The maximum of the four logarithmic factors appearing in the nontrivial Vaughan contributions.
It permits a single logarithmic factor to be extracted from their combined estimate.
-/
noncomputable def vaughanPrimitiveMeanLogScale
    (U V : ℝ) (x : ℕ) : ℝ :=
  max ((Real.log ((x : ℝ) * V)) ^ 2)
    (max ((Real.log ((x : ℝ) * U)) ^ 2)
      (max ((Real.log (2 * U * V)) ^ 2 * Real.log (4 * (x : ℝ)))
        (vaughanFourthScaleLog V x *
          Real.sqrt (vaughanFourthScaleLog V x) *
          Real.log (Real.exp 3 * V) * Real.log (4 * (x : ℝ)))))

theorem vaughanPrimitiveMeanHighLogCoefficient_pos :
    0 < vaughanPrimitiveMeanHighLogCoefficient := by
  unfold vaughanPrimitiveMeanHighLogCoefficient
  positivity

theorem vaughanPrimitiveMeanLogScale_nonneg (U V : ℝ) (x : ℕ) :
    0 ≤ vaughanPrimitiveMeanLogScale U V x :=
  (sq_nonneg _).trans (le_max_left _ _)

theorem vaughanPrimitiveMeanLogScale_first_le (U V : ℝ) (x : ℕ) :
    Real.log ((x : ℝ) * V) ^ 2 ≤ vaughanPrimitiveMeanLogScale U V x :=
  le_max_left _ _

theorem vaughanPrimitiveMeanLogScale_second_le (U V : ℝ) (x : ℕ) :
    Real.log ((x : ℝ) * U) ^ 2 ≤ vaughanPrimitiveMeanLogScale U V x :=
  (le_max_left _ _).trans (le_max_right _ _)

theorem vaughanPrimitiveMeanLogScale_third_le (U V : ℝ) (x : ℕ) :
    Real.log (2 * U * V) ^ 2 * Real.log (4 * (x : ℝ)) ≤
      vaughanPrimitiveMeanLogScale U V x :=
  (le_max_left _ _).trans ((le_max_right _ _).trans (le_max_right _ _))

theorem vaughanPrimitiveMeanLogScale_fourth_le (U V : ℝ) (x : ℕ) :
    vaughanFourthScaleLog V x * Real.sqrt (vaughanFourthScaleLog V x) *
        Real.log (Real.exp 3 * V) * Real.log (4 * (x : ℝ)) ≤
      vaughanPrimitiveMeanLogScale U V x :=
  (le_max_right _ _).trans ((le_max_right _ _).trans (le_max_right _ _))

theorem one_le_vaughanPrimitiveMeanLogScale
    {U V : ℝ} {x : ℕ} (hx : 4 ≤ x) (hV : 1 ≤ V) :
    1 ≤ vaughanPrimitiveMeanLogScale U V x := by
  have hx0 : 0 ≤ (x : ℝ) := by positivity
  have hxpos : 0 < (x : ℝ) := by exact_mod_cast (show 0 < x by omega)
  have hxV : (x : ℝ) ≤ (x : ℝ) * V := by
    calc
      (x : ℝ) = (x : ℝ) * 1 := by ring
      _ ≤ (x : ℝ) * V := mul_le_mul_of_nonneg_left hV hx0
  have hlog : 1 ≤ Real.log ((x : ℝ) * V) :=
    (one_le_log_natCast hx).trans (Real.log_le_log hxpos hxV)
  have hsq : 1 ≤ Real.log ((x : ℝ) * V) ^ 2 := by nlinarith
  exact hsq.trans (vaughanPrimitiveMeanLogScale_first_le U V x)

theorem sqrt_vaughanCubeRoot (x : ℕ) :
    Real.sqrt (vaughanCubeRoot x) = vaughanSixthRoot x := by
  rw [← vaughanSixthRoot_sq x]
  exact Real.sqrt_sq (vaughanSixthRoot_nonneg x)

theorem sqrt_natCast_mul_vaughanCubeRoot_sq (x : ℕ) :
    Real.sqrt ((x : ℝ) * vaughanCubeRoot x * vaughanCubeRoot x) =
      Real.sqrt (x : ℝ) * vaughanCubeRoot x := by
  rw [mul_assoc, Real.sqrt_mul (Nat.cast_nonneg x),
    Real.sqrt_mul_self (vaughanCubeRoot_nonneg x)]

theorem natCast_div_vaughanSixthRoot {x : ℕ} (hx : 1 ≤ x) :
    (x : ℝ) / vaughanSixthRoot x =
      Real.sqrt (x : ℝ) * vaughanCubeRoot x := by
  rw [← vaughanSixthRoot_pow_five x,
    div_eq_iff (vaughanSixthRoot_pos hx).ne', ← pow_succ]
  exact (vaughanSixthRoot_pow_six x).symm

theorem sqrt_mul_mul_self
    {a u : ℝ} (ha : 0 ≤ a) (hu : 0 ≤ u) :
    Real.sqrt (a * u * u) = Real.sqrt a * u := by
  rw [mul_assoc, Real.sqrt_mul ha, Real.sqrt_mul_self hu]

theorem vaughanPrimitiveMeanAlgebraicScale_low_le
    {x : ℕ} {q : ℝ} (hx : 4 ≤ x)
    (hq0 : 0 ≤ q) (hq : q ≤ vaughanCubeRoot x) :
    vaughanPrimitiveMeanAlgebraicScale
        (vaughanCubeRoot x) (vaughanCubeRoot x) x q ≤
      4 * (x : ℝ) + 2 * Real.sqrt (x : ℝ) * q ^ 2 +
        3 * (q * Real.sqrt q) * vaughanCubeRoot x ^ 2 +
        (2 + 2 * Real.sqrt 2) * q *
          (Real.sqrt (x : ℝ) * vaughanCubeRoot x) := by
  have hx1 : 1 ≤ x := by omega
  have hc0 : 0 ≤ vaughanCubeRoot x := vaughanCubeRoot_nonneg x
  have hc1 : 1 ≤ vaughanCubeRoot x := one_le_vaughanCubeRoot hx1
  have hsqrtq0 : 0 ≤ Real.sqrt q := Real.sqrt_nonneg q
  have hsqrtq_le_c : Real.sqrt q ≤ vaughanCubeRoot x := by
    apply Real.sqrt_le_iff.mpr
    constructor
    · exact hc0
    · have hc_le_sq : vaughanCubeRoot x ≤ vaughanCubeRoot x ^ 2 := by
        nlinarith
      exact hq.trans hc_le_sq
  have hq_le_sqrtq_mul_c :
      q ≤ Real.sqrt q * vaughanCubeRoot x := by
    calc
      q = Real.sqrt q * Real.sqrt q := by
        nlinarith [Real.sq_sqrt hq0]
      _ ≤ Real.sqrt q * vaughanCubeRoot x :=
        mul_le_mul_of_nonneg_left hsqrtq_le_c hsqrtq0
  have hfirst :
      vaughanCubeRoot x * q ^ 2 ≤
        (q * Real.sqrt q) * vaughanCubeRoot x ^ 2 := by
    calc
      vaughanCubeRoot x * q ^ 2 =
          (q * vaughanCubeRoot x) * q := by ring
      _ ≤ (q * vaughanCubeRoot x) *
          (Real.sqrt q * vaughanCubeRoot x) :=
        mul_le_mul_of_nonneg_left hq_le_sqrtq_mul_c
          (mul_nonneg hq0 hc0)
      _ = (q * Real.sqrt q) * vaughanCubeRoot x ^ 2 := by ring
  have hsecond :
      q ^ 2 * Real.sqrt q * vaughanCubeRoot x ≤
        (q * Real.sqrt q) * vaughanCubeRoot x ^ 2 := by
    calc
      q ^ 2 * Real.sqrt q * vaughanCubeRoot x =
          (q * Real.sqrt q * vaughanCubeRoot x) * q := by ring
      _ ≤ (q * Real.sqrt q * vaughanCubeRoot x) *
          vaughanCubeRoot x :=
        mul_le_mul_of_nonneg_left hq
          (mul_nonneg (mul_nonneg hq0 hsqrtq0) hc0)
      _ = (q * Real.sqrt q) * vaughanCubeRoot x ^ 2 := by ring
  have hcollect :
      vaughanPrimitiveMeanAlgebraicScale
          (vaughanCubeRoot x) (vaughanCubeRoot x) x q =
        4 * (x : ℝ) + 2 * Real.sqrt (x : ℝ) * q ^ 2 +
          vaughanCubeRoot x * q ^ 2 +
          2 * (q ^ 2 * Real.sqrt q * vaughanCubeRoot x) +
          (2 + 2 * Real.sqrt 2) * q *
            (Real.sqrt (x : ℝ) * vaughanCubeRoot x) := by
    unfold vaughanPrimitiveMeanAlgebraicScale
    rw [sqrt_natCast_mul_vaughanCubeRoot_sq x, sqrt_vaughanCubeRoot x]
    simp only [mul_div_assoc]
    rw [natCast_div_vaughanSixthRoot hx1]
    ring
  rw [hcollect]
  nlinarith

theorem vaughanPrimitiveMeanAlgebraicScale_high_le
    {x : ℕ} {q : ℝ} (hx : 4 ≤ x)
    (hq : vaughanCubeRoot x ≤ q)
    (hqsqrt : q ≤ Real.sqrt (x : ℝ)) :
    vaughanPrimitiveMeanAlgebraicScale
        (vaughanCubeRoot x ^ 2 / q)
        (vaughanCubeRoot x ^ 2 / q) x q ≤
      4 * (x : ℝ) + 2 * Real.sqrt (x : ℝ) * q ^ 2 +
        (3 + 2 * Real.sqrt 2) * (q * Real.sqrt q) *
          vaughanCubeRoot x ^ 2 +
        2 * q * (Real.sqrt (x : ℝ) * vaughanCubeRoot x) := by
  have hx1 : 1 ≤ x := by omega
  have hc0 : 0 ≤ vaughanCubeRoot x := vaughanCubeRoot_nonneg x
  have hcpos : 0 < vaughanCubeRoot x := vaughanCubeRoot_pos hx1
  have hqpos : 0 < q := hcpos.trans_le hq
  have hq0 : 0 ≤ q := hqpos.le
  have hsqrtqpos : 0 < Real.sqrt q := Real.sqrt_pos.2 hqpos
  have hU0 : 0 ≤ vaughanCubeRoot x ^ 2 / q := by positivity
  have hsqrtU :
      Real.sqrt (vaughanCubeRoot x ^ 2 / q) =
        vaughanCubeRoot x / Real.sqrt q := by
    rw [Real.sqrt_div (sq_nonneg (vaughanCubeRoot x)) q,
      Real.sqrt_sq hc0]
  have hUqSq :
      (vaughanCubeRoot x ^ 2 / q) * q ^ 2 =
        vaughanCubeRoot x ^ 2 * q := by
    field_simp [ne_of_gt hqpos]
  have hqSqSqrtU :
      q ^ 2 * Real.sqrt q * (vaughanCubeRoot x ^ 2 / q) =
        (q * Real.sqrt q) * vaughanCubeRoot x ^ 2 := by
    field_simp [ne_of_gt hqpos]
  have hmixed :
      q * Real.sqrt ((x : ℝ) *
          (vaughanCubeRoot x ^ 2 / q) *
          (vaughanCubeRoot x ^ 2 / q)) =
        Real.sqrt (x : ℝ) * vaughanCubeRoot x ^ 2 := by
    rw [sqrt_mul_mul_self (Nat.cast_nonneg x) hU0]
    field_simp [ne_of_gt hqpos]
  have hplainDiv :
      q * (x : ℝ) /
          Real.sqrt (vaughanCubeRoot x ^ 2 / q) =
        (q * Real.sqrt q) * vaughanCubeRoot x ^ 2 := by
    rw [hsqrtU, ← vaughanCubeRoot_cube x]
    field_simp [ne_of_gt hcpos, ne_of_gt hsqrtqpos]
  have hsqrtTwoDiv :
      Real.sqrt 2 * q * (x : ℝ) /
          Real.sqrt (vaughanCubeRoot x ^ 2 / q) =
        Real.sqrt 2 * (q * Real.sqrt q) * vaughanCubeRoot x ^ 2 := by
    rw [hsqrtU, ← vaughanCubeRoot_cube x]
    field_simp [ne_of_gt hcpos, ne_of_gt hsqrtqpos]
  have hcollect :
      vaughanPrimitiveMeanAlgebraicScale
          (vaughanCubeRoot x ^ 2 / q)
          (vaughanCubeRoot x ^ 2 / q) x q =
        4 * (x : ℝ) + 2 * Real.sqrt (x : ℝ) * q ^ 2 +
          (3 + 2 * Real.sqrt 2) * (q * Real.sqrt q) *
            vaughanCubeRoot x ^ 2 +
          q * vaughanCubeRoot x ^ 2 +
          Real.sqrt (x : ℝ) * vaughanCubeRoot x ^ 2 := by
    unfold vaughanPrimitiveMeanAlgebraicScale
    rw [hUqSq, hqSqSqrtU, hmixed, hsqrtTwoDiv, hplainDiv]
    ring
  have hc_le_sqrt :
      vaughanCubeRoot x ≤ Real.sqrt (x : ℝ) :=
    hq.trans hqsqrt
  have hcSq_le :
      vaughanCubeRoot x ^ 2 ≤
        Real.sqrt (x : ℝ) * vaughanCubeRoot x := by
    simpa [pow_two] using mul_le_mul_of_nonneg_right hc_le_sqrt hc0
  have hlinearOne :
      q * vaughanCubeRoot x ^ 2 ≤
        q * (Real.sqrt (x : ℝ) * vaughanCubeRoot x) :=
    mul_le_mul_of_nonneg_left hcSq_le hq0
  have hlinearTwo :
      Real.sqrt (x : ℝ) * vaughanCubeRoot x ^ 2 ≤
        q * (Real.sqrt (x : ℝ) * vaughanCubeRoot x) := by
    calc
      Real.sqrt (x : ℝ) * vaughanCubeRoot x ^ 2 =
          (Real.sqrt (x : ℝ) * vaughanCubeRoot x) *
            vaughanCubeRoot x := by ring
      _ ≤ (Real.sqrt (x : ℝ) * vaughanCubeRoot x) * q :=
        mul_le_mul_of_nonneg_left hq
          (mul_nonneg (Real.sqrt_nonneg _) hc0)
      _ = q * (Real.sqrt (x : ℝ) * vaughanCubeRoot x) := by ring
  rw [hcollect]
  nlinarith

theorem two_add_two_sqrt_two_le_five :
    (2 : ℝ) + 2 * Real.sqrt 2 ≤ 5 := by
  nlinarith [Real.sq_sqrt (by norm_num : (0 : ℝ) ≤ 2),
    Real.sqrt_nonneg (2 : ℝ)]

theorem three_add_two_sqrt_two_le_six :
    (3 : ℝ) + 2 * Real.sqrt 2 ≤ 6 := by
  nlinarith [Real.sq_sqrt (by norm_num : (0 : ℝ) ≤ 2),
    Real.sqrt_nonneg (2 : ℝ)]

theorem vaughanPrimitiveMeanAlgebraicScale_low_le_polynomial
    {x : ℕ} {q : ℝ} (hx : 4 ≤ x)
    (hq0 : 0 ≤ q) (hq : q ≤ vaughanCubeRoot x) :
    vaughanPrimitiveMeanAlgebraicScale
        (vaughanCubeRoot x) (vaughanCubeRoot x) x q ≤
      vaughanPrimitiveMeanPolynomial x q := by
  have hbase := vaughanPrimitiveMeanAlgebraicScale_low_le hx hq0 hq
  have hthree : 0 ≤ (q * Real.sqrt q) * vaughanCubeRoot x ^ 2 := by
    positivity
  have hlinear :
      0 ≤ q * (Real.sqrt (x : ℝ) * vaughanCubeRoot x) :=
    mul_nonneg hq0
      (mul_nonneg (Real.sqrt_nonneg _) (vaughanCubeRoot_nonneg x))
  have hthreeCoeff :
      3 * ((q * Real.sqrt q) * vaughanCubeRoot x ^ 2) ≤
        6 * ((q * Real.sqrt q) * vaughanCubeRoot x ^ 2) := by
    nlinarith
  have hlinearCoeff :
      (2 + 2 * Real.sqrt 2) *
          (q * (Real.sqrt (x : ℝ) * vaughanCubeRoot x)) ≤
        5 * (q * (Real.sqrt (x : ℝ) * vaughanCubeRoot x)) :=
    mul_le_mul_of_nonneg_right two_add_two_sqrt_two_le_five hlinear
  unfold vaughanPrimitiveMeanPolynomial
  nlinarith

theorem vaughanPrimitiveMeanAlgebraicScale_high_le_polynomial
    {x : ℕ} {q : ℝ} (hx : 4 ≤ x)
    (hq : vaughanCubeRoot x ≤ q)
    (hqsqrt : q ≤ Real.sqrt (x : ℝ)) :
    vaughanPrimitiveMeanAlgebraicScale
        (vaughanCubeRoot x ^ 2 / q)
        (vaughanCubeRoot x ^ 2 / q) x q ≤
      vaughanPrimitiveMeanPolynomial x q := by
  have hbase := vaughanPrimitiveMeanAlgebraicScale_high_le hx hq hqsqrt
  have hq0 : 0 ≤ q :=
    (vaughanCubeRoot_nonneg x).trans hq
  have hthree : 0 ≤ (q * Real.sqrt q) * vaughanCubeRoot x ^ 2 := by
    positivity
  have hlinear :
      0 ≤ q * (Real.sqrt (x : ℝ) * vaughanCubeRoot x) :=
    mul_nonneg hq0
      (mul_nonneg (Real.sqrt_nonneg _) (vaughanCubeRoot_nonneg x))
  have hthreeCoeff :
      (3 + 2 * Real.sqrt 2) *
          ((q * Real.sqrt q) * vaughanCubeRoot x ^ 2) ≤
        6 * ((q * Real.sqrt q) * vaughanCubeRoot x ^ 2) :=
    mul_le_mul_of_nonneg_right three_add_two_sqrt_two_le_six hthree
  have hlinearCoeff :
      2 * (q * (Real.sqrt (x : ℝ) * vaughanCubeRoot x)) ≤
        5 * (q * (Real.sqrt (x : ℝ) * vaughanCubeRoot x)) := by
    nlinarith
  unfold vaughanPrimitiveMeanPolynomial
  nlinarith

theorem log_two_le_half_log_natCast
    {x : ℕ} (hx : 4 ≤ x) :
    Real.log 2 ≤ (1 / 2 : ℝ) * Real.log (x : ℝ) := by
  have hlogFour : Real.log 4 ≤ Real.log (x : ℝ) := by
    apply Real.log_le_log (by norm_num)
    exact_mod_cast hx
  rw [Real.log_four_eq] at hlogFour
  linarith

theorem log_natCast_mul_vaughanCubeRoot_eq
    {x : ℕ} (hx : 1 ≤ x) :
    Real.log ((x : ℝ) * vaughanCubeRoot x) =
      (4 / 3 : ℝ) * Real.log (x : ℝ) := by
  have hxpos : 0 < (x : ℝ) := by exact_mod_cast (Nat.zero_lt_of_lt hx)
  have hcpos := vaughanCubeRoot_pos hx
  have hlogCube : Real.log (vaughanCubeRoot x) =
      (1 / 3 : ℝ) * Real.log (x : ℝ) := by
    unfold vaughanCubeRoot
    exact Real.log_rpow hxpos _
  rw [Real.log_mul hxpos.ne' hcpos.ne', hlogCube]
  ring

theorem log_two_mul_vaughanCubeRoot_sq_eq
    {x : ℕ} (hx : 1 ≤ x) :
    Real.log (2 * vaughanCubeRoot x * vaughanCubeRoot x) =
      Real.log 2 + (2 / 3 : ℝ) * Real.log (x : ℝ) := by
  have hxpos : 0 < (x : ℝ) := by exact_mod_cast (Nat.zero_lt_of_lt hx)
  have hcpos := vaughanCubeRoot_pos hx
  have hlogCube : Real.log (vaughanCubeRoot x) =
      (1 / 3 : ℝ) * Real.log (x : ℝ) := by
    unfold vaughanCubeRoot
    exact Real.log_rpow hxpos _
  rw [Real.log_mul (mul_ne_zero (by norm_num) hcpos.ne') hcpos.ne',
    Real.log_mul (by norm_num) hcpos.ne', hlogCube]
  ring

theorem log_two_mul_vaughanCubeRoot_sq_le
    {x : ℕ} (hx : 4 ≤ x) :
    Real.log (2 * vaughanCubeRoot x * vaughanCubeRoot x) ≤
      (7 / 6 : ℝ) * Real.log (x : ℝ) := by
  rw [log_two_mul_vaughanCubeRoot_sq_eq (by omega : 1 ≤ x)]
  linarith [log_two_le_half_log_natCast hx]

theorem log_exp_three_mul_vaughanCubeRoot_eq
    {x : ℕ} (hx : 1 ≤ x) :
    Real.log (Real.exp 3 * vaughanCubeRoot x) =
      3 + (1 / 3 : ℝ) * Real.log (x : ℝ) := by
  have hxpos : 0 < (x : ℝ) := by exact_mod_cast (Nat.zero_lt_of_lt hx)
  have hcpos := vaughanCubeRoot_pos hx
  have hlogCube : Real.log (vaughanCubeRoot x) =
      (1 / 3 : ℝ) * Real.log (x : ℝ) := by
    unfold vaughanCubeRoot
    exact Real.log_rpow hxpos _
  rw [Real.log_mul (Real.exp_ne_zero 3) hcpos.ne', Real.log_exp,
    hlogCube]

theorem log_exp_three_mul_vaughanCubeRoot_le
    {x : ℕ} (hx : 4 ≤ x) :
    Real.log (Real.exp 3 * vaughanCubeRoot x) ≤
      (1 / 3 + 3 / (2 * Real.log 2)) * Real.log (x : ℝ) := by
  have hlogTwo : 0 < Real.log 2 := Real.log_pos (by norm_num)
  have hratio :
      1 ≤ Real.log (x : ℝ) / (2 * Real.log 2) := by
    rw [le_div_iff₀ (by positivity)]
    have hlogFour : Real.log 4 ≤ Real.log (x : ℝ) := by
      apply Real.log_le_log (by norm_num)
      exact_mod_cast hx
    rw [Real.log_four_eq] at hlogFour
    simpa only [one_mul] using hlogFour
  rw [log_exp_three_mul_vaughanCubeRoot_eq (by omega : 1 ≤ x)]
  have hthree : (3 : ℝ) ≤
      3 * (Real.log (x : ℝ) / (2 * Real.log 2)) := by
    nlinarith
  calc
    3 + (1 / 3 : ℝ) * Real.log (x : ℝ) ≤
        3 * (Real.log (x : ℝ) / (2 * Real.log 2)) +
          (1 / 3 : ℝ) * Real.log (x : ℝ) := by
      nlinarith [hthree]
    _ = (1 / 3 + 3 / (2 * Real.log 2)) * Real.log (x : ℝ) := by
      field_simp; ring

theorem log_four_mul_natCast_le
    {x : ℕ} (hx : 4 ≤ x) :
    Real.log (4 * (x : ℝ)) ≤ 2 * Real.log (x : ℝ) := by
  have hxpos : 0 < (x : ℝ) := by exact_mod_cast (show 0 < x by omega)
  rw [Real.log_mul (by norm_num) hxpos.ne']
  have hlogFour : Real.log 4 ≤ Real.log (x : ℝ) := by
    apply Real.log_le_log (by norm_num)
    exact_mod_cast hx
  linarith

theorem eleven_sixths_le_vaughan_log_coefficient_base :
    (11 / 6 : ℝ) ≤ 1 / 3 + 3 / (2 * Real.log 2) := by
  have hlogTwoPos : 0 < Real.log 2 := Real.log_pos (by norm_num)
  have hlogTwoLe : Real.log 2 ≤ 1 :=
    (le_of_lt Real.log_two_lt_d9).trans (by norm_num)
  have hfrac : (3 / 2 : ℝ) ≤ 3 / (2 * Real.log 2) := by
    rw [le_div_iff₀ (by positivity)]
    nlinarith
  linarith

theorem eleven_thirds_le_vaughanPrimitiveMeanLowLogCoefficient :
    (11 / 3 : ℝ) ≤ vaughanPrimitiveMeanLowLogCoefficient := by
  unfold vaughanPrimitiveMeanLowLogCoefficient
  calc
    (11 / 3 : ℝ) = 2 * 1 * 1 * (11 / 6 : ℝ) := by ring
    _ ≤ 2 * (7 / 6 : ℝ) * Real.sqrt (7 / 6 : ℝ) *
        (1 / 3 + 3 / (2 * Real.log 2)) := by
      gcongr
      · norm_num
      · exact Real.one_le_sqrt.mpr (by norm_num)
      · exact eleven_sixths_le_vaughan_log_coefficient_base

theorem sq_le_mul_cube_mul_sqrt_of_le_mul
    {ell z b C : ℝ} (hell : 1 ≤ ell) (hz0 : 0 ≤ z) (hb0 : 0 ≤ b)
    (hz : z ≤ b * ell) (hcoef : b ^ 2 ≤ C) :
    z ^ 2 ≤ C * (ell ^ 3 * Real.sqrt ell) := by
  have hsqrt : 1 ≤ Real.sqrt ell := Real.one_le_sqrt.mpr hell
  have htail : ell ^ 2 ≤ ell ^ 3 * Real.sqrt ell := by
    calc
      ell ^ 2 = ell ^ 2 * 1 := by ring
      _ ≤ ell ^ 2 * (ell * Real.sqrt ell) := by
        apply mul_le_mul_of_nonneg_left _ (sq_nonneg ell)
        nlinarith
      _ = ell ^ 3 * Real.sqrt ell := by ring
  calc
    z ^ 2 ≤ (b * ell) ^ 2 :=
      (sq_le_sq₀ hz0 (mul_nonneg hb0 (zero_le_one.trans hell))).2 hz
    _ = b ^ 2 * ell ^ 2 := by ring
    _ ≤ C * ell ^ 2 :=
      mul_le_mul_of_nonneg_right hcoef (sq_nonneg ell)
    _ ≤ C * (ell ^ 3 * Real.sqrt ell) :=
      mul_le_mul_of_nonneg_left htail ((sq_nonneg b).trans hcoef)

theorem sq_mul_le_mul_cube_mul_sqrt_of_le_mul
    {ell z b f C : ℝ} (hell : 1 ≤ ell) (hz0 : 0 ≤ z) (hb0 : 0 ≤ b)
    (hz : z ≤ b * ell) (hf0 : 0 ≤ f) (hf : f ≤ 2 * ell)
    (hcoef : 2 * b ^ 2 ≤ C) :
    z ^ 2 * f ≤ C * (ell ^ 3 * Real.sqrt ell) := by
  have hsqrt : 1 ≤ Real.sqrt ell := Real.one_le_sqrt.mpr hell
  have hzsq : z ^ 2 ≤ (b * ell) ^ 2 :=
    (sq_le_sq₀ hz0 (mul_nonneg hb0 (zero_le_one.trans hell))).2 hz
  calc
    z ^ 2 * f ≤ (b * ell) ^ 2 * (2 * ell) :=
      mul_le_mul hzsq hf hf0 (sq_nonneg _)
    _ = (2 * b ^ 2) * ell ^ 3 := by ring
    _ ≤ C * ell ^ 3 := by
      apply mul_le_mul_of_nonneg_right hcoef
      positivity
    _ ≤ C * (ell ^ 3 * Real.sqrt ell) := by
      apply mul_le_mul_of_nonneg_left _ ((mul_nonneg (by norm_num) (sq_nonneg b)).trans hcoef)
      calc
        ell ^ 3 = ell ^ 3 * 1 := by ring
        _ ≤ ell ^ 3 * Real.sqrt ell :=
          mul_le_mul_of_nonneg_left hsqrt (by positivity)

theorem mul_sqrt_mul_mul_le_log_envelope
    {ell scale b e D f : ℝ} (hell : 1 ≤ ell)
    (_hscale0 : 0 ≤ scale) (hscale : scale ≤ b * ell)
    (hb0 : 0 ≤ b) (he0 : 0 ≤ e) (he : e ≤ D * ell)
    (hD0 : 0 ≤ D) (hf0 : 0 ≤ f) (hf : f ≤ 2 * ell) :
    scale * Real.sqrt scale * e * f ≤
      (2 * b * Real.sqrt b * D) * (ell ^ 3 * Real.sqrt ell) := by
  have hell0 : 0 ≤ ell := zero_le_one.trans hell
  have hsqrt : Real.sqrt scale ≤ Real.sqrt (b * ell) :=
    Real.sqrt_le_sqrt hscale
  calc
    scale * Real.sqrt scale * e * f ≤
        (b * ell) * Real.sqrt (b * ell) * (D * ell) * (2 * ell) := by
      gcongr
    _ = (2 * b * Real.sqrt b * D) * (ell ^ 3 * Real.sqrt ell) := by
      rw [Real.sqrt_mul hb0]
      ring

theorem vaughanFourthScaleLog_low_le
    {x : ℕ} (hx : 4 ≤ x) :
    vaughanFourthScaleLog (vaughanCubeRoot x) x ≤
      (7 / 6 : ℝ) * Real.log (x : ℝ) := by
  have hcpos := vaughanCubeRoot_pos (by omega : 1 ≤ x)
  have harg :
      2 * (x : ℝ) / vaughanCubeRoot x =
        2 * vaughanCubeRoot x * vaughanCubeRoot x := by
    rw [← vaughanCubeRoot_cube x]
    field_simp [hcpos.ne']
  have hraw0 : 0 ≤ Real.log (2 * (x : ℝ) / vaughanCubeRoot x) := by
    rw [harg]
    apply Real.log_nonneg
    nlinarith [one_le_vaughanCubeRoot (by omega : 1 ≤ x),
      sq_nonneg (vaughanCubeRoot x)]
  rw [vaughanFourthScaleLog, max_eq_right hraw0, harg]
  exact log_two_mul_vaughanCubeRoot_sq_le hx

theorem vaughanPrimitiveMeanLogScale_low_le
    {x : ℕ} (hx : 4 ≤ x) :
    vaughanPrimitiveMeanLogScale
        (vaughanCubeRoot x) (vaughanCubeRoot x) x ≤
      vaughanPrimitiveMeanLowLogCoefficient *
        vaughanPrimitiveMeanLogPower x := by
  have hxone : 1 ≤ x := by omega
  have hell := one_le_log_natCast hx
  have hcpos := vaughanCubeRoot_pos hxone
  have hfirst0 : 0 ≤ Real.log ((x : ℝ) * vaughanCubeRoot x) :=
    Real.log_nonneg (one_le_mul_of_one_le_of_one_le
      (by exact_mod_cast hxone) (one_le_vaughanCubeRoot hxone))
  have hfirst : Real.log ((x : ℝ) * vaughanCubeRoot x) ≤
      (4 / 3 : ℝ) * Real.log (x : ℝ) := by
    rw [log_natCast_mul_vaughanCubeRoot_eq hxone]
  have hthird0 :
      0 ≤ Real.log (2 * vaughanCubeRoot x * vaughanCubeRoot x) := by
    apply Real.log_nonneg
    nlinarith [one_le_vaughanCubeRoot hxone,
      sq_nonneg (vaughanCubeRoot x)]
  have hthird := log_two_mul_vaughanCubeRoot_sq_le hx
  have hfourLog0 : 0 ≤ Real.log (4 * (x : ℝ)) := by
    apply Real.log_nonneg
    have hxReal : (1 : ℝ) ≤ (x : ℝ) := by exact_mod_cast hxone
    nlinarith
  have hfourLog := log_four_mul_natCast_le hx
  have hExp0 : 0 ≤ Real.log (Real.exp 3 * vaughanCubeRoot x) := by
    apply Real.log_nonneg
    exact one_le_mul_of_one_le_of_one_le (Real.one_le_exp (by norm_num))
      (one_le_vaughanCubeRoot hxone)
  have hExp := log_exp_three_mul_vaughanCubeRoot_le hx
  have hbase0 : 0 ≤ 1 / 3 + 3 / (2 * Real.log 2) := by positivity
  have hlowFirst : (4 / 3 : ℝ) ^ 2 ≤
      vaughanPrimitiveMeanLowLogCoefficient := by
    exact (by norm_num : (4 / 3 : ℝ) ^ 2 ≤ 11 / 3).trans
      eleven_thirds_le_vaughanPrimitiveMeanLowLogCoefficient
  have hlowThird : 2 * (7 / 6 : ℝ) ^ 2 ≤
      vaughanPrimitiveMeanLowLogCoefficient := by
    exact (by norm_num : 2 * (7 / 6 : ℝ) ^ 2 ≤ 11 / 3).trans
      eleven_thirds_le_vaughanPrimitiveMeanLowLogCoefficient
  unfold vaughanPrimitiveMeanLogScale
  apply max_le
  · exact sq_le_mul_cube_mul_sqrt_of_le_mul hell hfirst0 (by norm_num) hfirst hlowFirst
  · apply max_le
    · exact sq_le_mul_cube_mul_sqrt_of_le_mul hell hfirst0 (by norm_num) hfirst hlowFirst
    · apply max_le
      · exact sq_mul_le_mul_cube_mul_sqrt_of_le_mul hell hthird0 (by norm_num) hthird hfourLog0
          hfourLog hlowThird
      · unfold vaughanPrimitiveMeanLowLogCoefficient
        exact mul_sqrt_mul_mul_le_log_envelope hell
          (vaughanFourthScaleLog_nonneg (vaughanCubeRoot x) x)
          (vaughanFourthScaleLog_low_le hx) (by norm_num) hExp0 hExp hbase0
          hfourLog0 hfourLog

theorem vaughanPrimitiveMeanLowLogCoefficient_le_high :
    vaughanPrimitiveMeanLowLogCoefficient ≤
      vaughanPrimitiveMeanHighLogCoefficient := by
  unfold vaughanPrimitiveMeanLowLogCoefficient
    vaughanPrimitiveMeanHighLogCoefficient
  have hab : (7 / 6 : ℝ) ≤ 4 / 3 := by norm_num
  have hsqrt : Real.sqrt (7 / 6 : ℝ) ≤ Real.sqrt (4 / 3 : ℝ) :=
    Real.sqrt_le_sqrt hab
  have hD : 0 ≤ 1 / 3 + 3 / (2 * Real.log 2) := by positivity
  have hproduct :
      (7 / 6 : ℝ) * Real.sqrt (7 / 6 : ℝ) ≤
        (4 / 3 : ℝ) * Real.sqrt (4 / 3 : ℝ) :=
    mul_le_mul hab hsqrt (Real.sqrt_nonneg _) (by norm_num)
  apply mul_le_mul_of_nonneg_right _ hD
  simpa only [mul_assoc] using
    mul_le_mul_of_nonneg_left hproduct (by norm_num : (0 : ℝ) ≤ 2)

theorem vaughanCubeRoot_sq_div_pos
    {x : ℕ} {q : ℝ} (hx : 4 ≤ x)
    (hq : vaughanCubeRoot x ≤ q) :
    0 < vaughanCubeRoot x ^ 2 / q := by
  have hcpos := vaughanCubeRoot_pos (by omega : 1 ≤ x)
  have hqpos : 0 < q := hcpos.trans_le hq
  positivity

theorem vaughanCubeRoot_sq_div_le_vaughanCubeRoot
    {x : ℕ} {q : ℝ} (hx : 4 ≤ x)
    (hq : vaughanCubeRoot x ≤ q) :
    vaughanCubeRoot x ^ 2 / q ≤ vaughanCubeRoot x := by
  have hcpos := vaughanCubeRoot_pos (by omega : 1 ≤ x)
  have hqpos : 0 < q := hcpos.trans_le hq
  rw [div_le_iff₀ hqpos]
  nlinarith

theorem vaughanFourthScaleLog_high_le
    {x : ℕ} {q : ℝ} (hx : 4 ≤ x)
    (hq : vaughanCubeRoot x ≤ q)
    (hqsqrt : q ≤ Real.sqrt (x : ℝ)) :
    vaughanFourthScaleLog (vaughanCubeRoot x ^ 2 / q) x ≤
      (4 / 3 : ℝ) * Real.log (x : ℝ) := by
  have hxone : 1 ≤ x := by omega
  have hcpos := vaughanCubeRoot_pos hxone
  have hqpos : 0 < q := hcpos.trans_le hq
  have hcutpos := vaughanCubeRoot_sq_div_pos hx hq
  have hsqrtTwo : 2 ≤ Real.sqrt (x : ℝ) := by
    calc
      (2 : ℝ) = Real.sqrt 4 := by
        rw [show (4 : ℝ) = 2 ^ 2 by norm_num,
          Real.sqrt_sq (by norm_num : (0 : ℝ) ≤ 2)]
      _ ≤ Real.sqrt (x : ℝ) := Real.sqrt_le_sqrt (by exact_mod_cast hx)
  have htwoQ : 2 * q ≤ (x : ℝ) := by
    have hsqrtSq := Real.sq_sqrt (show 0 ≤ (x : ℝ) by positivity)
    nlinarith
  have hargEq :
      2 * (x : ℝ) / (vaughanCubeRoot x ^ 2 / q) =
        2 * vaughanCubeRoot x * q := by
    rw [← vaughanCubeRoot_cube x]
    field_simp [hcpos.ne', hqpos.ne']
  have hargLe :
      2 * (x : ℝ) / (vaughanCubeRoot x ^ 2 / q) ≤
        (x : ℝ) * vaughanCubeRoot x := by
    rw [hargEq]
    calc
      2 * vaughanCubeRoot x * q = vaughanCubeRoot x * (2 * q) := by ring
      _ ≤ vaughanCubeRoot x * (x : ℝ) :=
        mul_le_mul_of_nonneg_left htwoQ hcpos.le
      _ = (x : ℝ) * vaughanCubeRoot x := by ring
  have hraw0 :
      0 ≤ Real.log (2 * (x : ℝ) /
        (vaughanCubeRoot x ^ 2 / q)) := by
    rw [hargEq]
    apply Real.log_nonneg
    nlinarith [one_le_vaughanCubeRoot hxone]
  rw [vaughanFourthScaleLog, max_eq_right hraw0]
  exact (Real.log_le_log (by positivity) hargLe).trans_eq
    (log_natCast_mul_vaughanCubeRoot_eq hxone)

theorem vaughanPrimitiveMeanLogScale_high_le
    {x : ℕ} {q : ℝ} (hx : 4 ≤ x)
    (hq : vaughanCubeRoot x ≤ q)
    (hqsqrt : q ≤ Real.sqrt (x : ℝ)) :
    vaughanPrimitiveMeanLogScale
        (vaughanCubeRoot x ^ 2 / q)
        (vaughanCubeRoot x ^ 2 / q) x ≤
      vaughanPrimitiveMeanHighLogCoefficient *
        vaughanPrimitiveMeanLogPower x := by
  have hxone : 1 ≤ x := by omega
  have hcpos := vaughanCubeRoot_pos hxone
  have hqpos : 0 < q := hcpos.trans_le hq
  let U := vaughanCubeRoot x ^ 2 / q
  have hUpos : 0 < U := vaughanCubeRoot_sq_div_pos hx hq
  have hUone : 1 ≤ U :=
    one_le_vaughanPrimitiveMeanHighCutoff hx hq hqsqrt
  have hUle : U ≤ vaughanCubeRoot x := vaughanCubeRoot_sq_div_le_vaughanCubeRoot hx hq
  have hell := one_le_log_natCast hx
  have hxpos : 0 < (x : ℝ) := by positivity
  have hfirstArg : (x : ℝ) * U ≤ (x : ℝ) * vaughanCubeRoot x :=
    mul_le_mul_of_nonneg_left hUle (by positivity)
  have hfirst0 : 0 ≤ Real.log ((x : ℝ) * U) := by
    apply Real.log_nonneg
    exact one_le_mul_of_one_le_of_one_le (by exact_mod_cast hxone)
      hUone
  have hfirst : Real.log ((x : ℝ) * U) ≤
      (4 / 3 : ℝ) * Real.log (x : ℝ) :=
    (Real.log_le_log (by positivity) hfirstArg).trans_eq
      (log_natCast_mul_vaughanCubeRoot_eq hxone)
  have hthirdArg : 2 * U * U ≤
      2 * vaughanCubeRoot x * vaughanCubeRoot x := by
    nlinarith [hUpos.le, hcpos.le]
  have hthird0 : 0 ≤ Real.log (2 * U * U) := by
    apply Real.log_nonneg
    nlinarith [hUone]
  have hthird : Real.log (2 * U * U) ≤
      (7 / 6 : ℝ) * Real.log (x : ℝ) :=
    (Real.log_le_log (by positivity) hthirdArg).trans
      (log_two_mul_vaughanCubeRoot_sq_le hx)
  have hfourLog0 : 0 ≤ Real.log (4 * (x : ℝ)) :=
    Real.log_nonneg (by
      have : (1 : ℝ) ≤ (x : ℝ) := by exact_mod_cast hxone
      nlinarith)
  have hfourLog := log_four_mul_natCast_le hx
  have hExpArg : Real.exp 3 * U ≤
      Real.exp 3 * vaughanCubeRoot x :=
    mul_le_mul_of_nonneg_left hUle (Real.exp_pos 3).le
  have hExp0 : 0 ≤ Real.log (Real.exp 3 * U) := by
    apply Real.log_nonneg
    exact one_le_mul_of_one_le_of_one_le
      (Real.one_le_exp (by norm_num)) hUone
  have hExp : Real.log (Real.exp 3 * U) ≤
      (1 / 3 + 3 / (2 * Real.log 2)) * Real.log (x : ℝ) :=
    (Real.log_le_log (by positivity) hExpArg).trans
      (log_exp_three_mul_vaughanCubeRoot_le hx)
  have hbase0 : 0 ≤ 1 / 3 + 3 / (2 * Real.log 2) := by positivity
  have hhighFirst : (4 / 3 : ℝ) ^ 2 ≤
      vaughanPrimitiveMeanHighLogCoefficient :=
    (by norm_num : (4 / 3 : ℝ) ^ 2 ≤ 11 / 3).trans
      (eleven_thirds_le_vaughanPrimitiveMeanLowLogCoefficient.trans
        vaughanPrimitiveMeanLowLogCoefficient_le_high)
  have hhighThird : 2 * (7 / 6 : ℝ) ^ 2 ≤
      vaughanPrimitiveMeanHighLogCoefficient :=
    (by norm_num : 2 * (7 / 6 : ℝ) ^ 2 ≤ 11 / 3).trans
      (eleven_thirds_le_vaughanPrimitiveMeanLowLogCoefficient.trans
        vaughanPrimitiveMeanLowLogCoefficient_le_high)
  change vaughanPrimitiveMeanLogScale U U x ≤ _
  unfold vaughanPrimitiveMeanLogScale
  apply max_le
  · exact sq_le_mul_cube_mul_sqrt_of_le_mul hell hfirst0 (by norm_num) hfirst hhighFirst
  · apply max_le
    · exact sq_le_mul_cube_mul_sqrt_of_le_mul hell hfirst0 (by norm_num) hfirst hhighFirst
    · apply max_le
      · exact sq_mul_le_mul_cube_mul_sqrt_of_le_mul hell hthird0 (by norm_num) hthird hfourLog0
          hfourLog hhighThird
      · unfold vaughanPrimitiveMeanHighLogCoefficient
        exact mul_sqrt_mul_mul_le_log_envelope hell
          (vaughanFourthScaleLog_nonneg U x)
          (vaughanFourthScaleLog_high_le hx hq hqsqrt) (by norm_num)
          hExp0 hExp hbase0 hfourLog0 hfourLog

theorem one_le_vaughanPrimitiveMeanHighLogCoefficient :
    1 ≤ vaughanPrimitiveMeanHighLogCoefficient := by
  have hlogTwoPos : 0 < Real.log 2 := Real.log_pos (by norm_num)
  have hlogTwoLe : Real.log 2 ≤ 1 :=
    Real.log_two_lt_d9.le.trans (by norm_num)
  have hfrac : (1 : ℝ) ≤ 3 / (2 * Real.log 2) := by
    rw [le_div_iff₀ (by positivity)]
    nlinarith
  have hD : (1 : ℝ) ≤ 1 / 3 + 3 / (2 * Real.log 2) := by
    linarith
  have hsqrt : (1 : ℝ) ≤ Real.sqrt (4 / 3 : ℝ) :=
    Real.one_le_sqrt.mpr (by norm_num)
  unfold vaughanPrimitiveMeanHighLogCoefficient
  calc
    (1 : ℝ) ≤ 2 * 1 * 1 * 1 := by norm_num
    _ ≤ 2 * (4 / 3 : ℝ) * Real.sqrt (4 / 3 : ℝ) *
        (1 / 3 + 3 / (2 * Real.log 2)) := by
      gcongr
      norm_num

theorem natCast_le_vaughanPrimitiveMeanPolynomial
    (x : ℕ) {q : ℝ} (hq : 0 ≤ q) :
    (x : ℝ) ≤ vaughanPrimitiveMeanPolynomial x q := by
  have hc0 : 0 ≤ vaughanCubeRoot x := vaughanCubeRoot_nonneg x
  have hsecond : 0 ≤ 2 * Real.sqrt (x : ℝ) * q ^ 2 := by positivity
  have hthird :
      0 ≤ 6 * vaughanCubeRoot x ^ 2 * (q * Real.sqrt q) := by
    positivity
  have hfourth :
      0 ≤ 5 * (Real.sqrt (x : ℝ) * vaughanCubeRoot x) * q := by
    positivity
  unfold vaughanPrimitiveMeanPolynomial
  have hx0 : 0 ≤ (x : ℝ) := by positivity
  linarith

theorem exists_log_rpow_natCast_le_rpow
    (r s : ℝ) (hs : 0 < s) :
    ∃ X0 : ℕ, 4 ≤ X0 ∧ ∀ x : ℕ, X0 ≤ x →
      Real.rpow (Real.log (x : ℝ)) r ≤ Real.rpow (x : ℝ) s := by
  have hlittle := isLittleO_log_rpow_rpow_atTop r hs
  have hnat := (tendsto_natCast_atTop_atTop (R := ℝ)).eventually
    hlittle.eventuallyLE
  rw [Filter.eventually_atTop] at hnat
  obtain ⟨N, hN⟩ := hnat
  refine ⟨max 4 N, le_max_left _ _, ?_⟩
  intro x hx
  have hNx : N ≤ x := (le_max_right 4 N).trans hx
  have hx4 : 4 ≤ x := (le_max_left 4 N).trans hx
  have hxpos : (0 : ℝ) < (x : ℝ) := by positivity
  have hlogNonneg : 0 ≤ Real.log (x : ℝ) :=
    Real.log_nonneg (by exact_mod_cast (show 1 ≤ x by omega))
  simpa [Real.norm_eq_abs,
    abs_of_nonneg (Real.rpow_nonneg hlogNonneg r),
    abs_of_nonneg (Real.rpow_nonneg hxpos.le s)] using hN x hNx

theorem vaughanCubeRoot_sq_eq_rpow_two_thirds
    {x : ℕ} (hx : 1 ≤ x) :
    vaughanCubeRoot x ^ 2 = Real.rpow (x : ℝ) (2 / 3 : ℝ) := by
  have hxpos : (0 : ℝ) < x := by positivity
  norm_num [vaughanCubeRoot, Real.rpow_eq_pow, ← Real.rpow_natCast,
    ← Real.rpow_mul hxpos.le]

theorem sqrt_sqrt_natCast_eq_rpow_one_fourth
    {x : ℕ} (hx : 1 ≤ x) :
    Real.sqrt (Real.sqrt (x : ℝ)) =
      Real.rpow (x : ℝ) (1 / 4 : ℝ) := by
  have hxpos : (0 : ℝ) < x := by positivity
  norm_num [Real.sqrt_eq_rpow, ← Real.rpow_mul hxpos.le]

theorem vaughanCubeRoot_sq_mul_sqrt_le_rpow_eleven_twelfths
    {x Q : ℕ} (hx : 1 ≤ x)
    (hQ : (Q : ℝ) ≤ Real.sqrt (x : ℝ)) :
    vaughanCubeRoot x ^ 2 * Real.sqrt (Q : ℝ) ≤
      Real.rpow (x : ℝ) (11 / 12 : ℝ) := by
  calc
    _ ≤ vaughanCubeRoot x ^ 2 * Real.sqrt (Real.sqrt (x : ℝ)) :=
      mul_le_mul_of_nonneg_left (Real.sqrt_le_sqrt hQ) (sq_nonneg _)
    _ = Real.rpow (x : ℝ) (11 / 12 : ℝ) := by
      rw [vaughanCubeRoot_sq_eq_rpow_two_thirds hx,
        sqrt_sqrt_natCast_eq_rpow_one_fourth hx]
      norm_num [← Real.rpow_add (show (0 : ℝ) < x by positivity)]

theorem sqrt_mul_vaughanCubeRoot_eq_rpow_five_sixths
    {x : ℕ} (hx : 1 ≤ x) :
    Real.sqrt (x : ℝ) * vaughanCubeRoot x =
      Real.rpow (x : ℝ) (5 / 6 : ℝ) := by
  norm_num [vaughanCubeRoot, Real.sqrt_eq_rpow,
    ← Real.rpow_add (show (0 : ℝ) < x by positivity)]

end

section
open scoped ContDiff

open scoped Interval
/--
The explicit algebraic expression produced by Abel summation of the primitive mean-value bound
between `Q1` and `Q`, retaining the negative lower-endpoint terms.
-/
noncomputable def vaughanPrimitiveMeanAbelSharpPolynomial
    (x : ℕ) (Q1 Q : ℝ) : ℝ :=
  4 * (x : ℝ) / Q1 +
    4 * Real.sqrt (x : ℝ) * Q -
    2 * Real.sqrt (x : ℝ) * Q1 +
    18 * vaughanCubeRoot x ^ 2 * Real.sqrt Q -
    12 * vaughanCubeRoot x ^ 2 * Real.sqrt Q1 +
    5 * (Real.sqrt (x : ℝ) * vaughanCubeRoot x) *
      (1 + Real.log (Q / Q1))

/--
The simplified Abel-summation expression. For positive endpoints `Q1` and `Q`, it is obtained by
dropping the negative lower-endpoint terms from the sharp expression and rewriting `1 + log (Q /
Q1)` as `log (exp 1 * Q / Q1)`.
-/
noncomputable def vaughanPrimitiveMeanAbelEnvelope
    (x : ℕ) (Q1 Q : ℝ) : ℝ :=
  4 * (x : ℝ) / Q1 +
    4 * Real.sqrt (x : ℝ) * Q +
    18 * vaughanCubeRoot x ^ 2 * Real.sqrt Q +
    5 * (Real.sqrt (x : ℝ) * vaughanCubeRoot x) *
      Real.log (Real.exp 1 * Q / Q1)

theorem zero_notMem_uIcc {Q1 Q : ℝ}
    (hQ1 : 1 ≤ Q1) (hQ : Q1 ≤ Q) :
    (0 : ℝ) ∉ [[Q1, Q]] := by
  rw [Set.uIcc_of_le hQ]
  intro hzero
  linarith [hzero.1]

theorem vaughanPrimitiveMeanPolynomial_div_sq_eq
    (x : ℕ) {t : ℝ} (ht : 0 < t) :
    vaughanPrimitiveMeanPolynomial x t / t ^ 2 =
      (4 * (x : ℝ)) * t ^ (-2 : ℝ) +
        2 * Real.sqrt (x : ℝ) +
        (6 * vaughanCubeRoot x ^ 2) * t ^ (-(1 / 2) : ℝ) +
        (5 * (Real.sqrt (x : ℝ) * vaughanCubeRoot x)) * t⁻¹ := by
  rw [show (-2 : ℝ) = -(2 : ℝ) by norm_num, Real.rpow_neg ht.le,
    Real.rpow_two, Real.rpow_neg ht.le, ← Real.sqrt_eq_rpow]
  unfold vaughanPrimitiveMeanPolynomial
  have htne : t ≠ 0 := ne_of_gt ht
  have hsqrtne : Real.sqrt t ≠ 0 := ne_of_gt (Real.sqrt_pos.2 ht)
  field_simp
  ring_nf
  rw [Real.sq_sqrt ht.le]
  ring

theorem vaughanPrimitiveMeanPolynomial_div_sq_intervalIntegrable
    (x : ℕ) {Q1 Q : ℝ} (hQ1 : 1 ≤ Q1) (hQ : Q1 ≤ Q) :
    IntervalIntegrable
      (fun t ↦ vaughanPrimitiveMeanPolynomial x t / t ^ 2)
      volume Q1 Q := by
  apply ContinuousOn.intervalIntegrable
  apply ContinuousOn.div
  · unfold vaughanPrimitiveMeanPolynomial
    fun_prop
  · fun_prop
  · intro t ht
    rw [Set.uIcc_of_le hQ] at ht
    have htpos : 0 < t := zero_lt_one.trans_le (hQ1.trans ht.1)
    exact pow_ne_zero 2 htpos.ne'

theorem integral_vaughanPrimitiveMeanPolynomial_div_sq
    (x : ℕ) {Q1 Q : ℝ} (hQ1 : 1 ≤ Q1) (hQ : Q1 ≤ Q) :
    (∫ t in Set.Ioc Q1 Q,
      vaughanPrimitiveMeanPolynomial x t / t ^ 2) =
      4 * (x : ℝ) * (Q1⁻¹ - Q⁻¹) +
      2 * Real.sqrt (x : ℝ) * (Q - Q1) +
      12 * vaughanCubeRoot x ^ 2 *
        (Real.sqrt Q - Real.sqrt Q1) +
      5 * (Real.sqrt (x : ℝ) * vaughanCubeRoot x) *
        Real.log (Q / Q1) := by
  have hQ1pos : 0 < Q1 := zero_lt_one.trans_le hQ1
  have hQpos : 0 < Q := hQ1pos.trans_le hQ
  have hzero : (0 : ℝ) ∉ [[Q1, Q]] := zero_notMem_uIcc hQ1 hQ
  have hnegTwo : IntervalIntegrable (fun t : ℝ ↦ t ^ (-2 : ℝ)) volume Q1 Q :=
    intervalIntegral.intervalIntegrable_rpow (Or.inr hzero)
  have hnegHalf :
      IntervalIntegrable (fun t : ℝ ↦ t ^ (-(1 / 2) : ℝ)) volume Q1 Q :=
    intervalIntegral.intervalIntegrable_rpow' (by norm_num)
  have hinv : IntervalIntegrable (fun t : ℝ ↦ t⁻¹) volume Q1 Q :=
    intervalIntegral.intervalIntegrable_inv
      (fun t ht ↦ ne_of_mem_of_not_mem ht hzero) continuousOn_id
  have hfirst := hnegTwo.const_mul (4 * (x : ℝ))
  have hsecond : IntervalIntegrable
      (fun _ : ℝ ↦ 2 * Real.sqrt (x : ℝ)) volume Q1 Q :=
    intervalIntegrable_const
  have hthird := hnegHalf.const_mul (6 * vaughanCubeRoot x ^ 2)
  have hfourth := hinv.const_mul
    (5 * (Real.sqrt (x : ℝ) * vaughanCubeRoot x))
  have hnegTwoIntegral :
      (∫ t : ℝ in Q1..Q, t ^ (-2 : ℝ)) = Q1⁻¹ - Q⁻¹ := by
    rw [integral_rpow (Or.inr ⟨by norm_num, hzero⟩)]
    norm_num [Real.rpow_neg_one]
    ring
  have hnegHalfIntegral :
      (∫ t : ℝ in Q1..Q, t ^ (-(1 / 2) : ℝ)) =
        2 * (Real.sqrt Q - Real.sqrt Q1) := by
    rw [integral_rpow (Or.inl (by norm_num))]
    norm_num
    rw [← Real.sqrt_eq_rpow, ← Real.sqrt_eq_rpow]
    ring
  rw [← intervalIntegral.integral_of_le hQ]
  calc
    (∫ t : ℝ in Q1..Q,
        vaughanPrimitiveMeanPolynomial x t / t ^ 2) =
        ∫ t : ℝ in Q1..Q,
          (4 * (x : ℝ)) * t ^ (-2 : ℝ) +
            2 * Real.sqrt (x : ℝ) +
            (6 * vaughanCubeRoot x ^ 2) * t ^ (-(1 / 2) : ℝ) +
            (5 * (Real.sqrt (x : ℝ) * vaughanCubeRoot x)) * t⁻¹ := by
      apply intervalIntegral.integral_congr
      intro t ht
      rw [Set.uIcc_of_le hQ] at ht
      exact vaughanPrimitiveMeanPolynomial_div_sq_eq x
        (zero_lt_one.trans_le (hQ1.trans ht.1))
    _ = 4 * (x : ℝ) * (Q1⁻¹ - Q⁻¹) +
        2 * Real.sqrt (x : ℝ) * (Q - Q1) +
        12 * vaughanCubeRoot x ^ 2 *
          (Real.sqrt Q - Real.sqrt Q1) +
        5 * (Real.sqrt (x : ℝ) * vaughanCubeRoot x) *
          Real.log (Q / Q1) := by
      rw [intervalIntegral.integral_add ((hfirst.add hsecond).add hthird) hfourth,
        intervalIntegral.integral_add (hfirst.add hsecond) hthird,
        intervalIntegral.integral_add hfirst hsecond]
      simp only [intervalIntegral.integral_const_mul,
        intervalIntegral.integral_const, hnegTwoIntegral, hnegHalfIntegral,
        integral_inv_of_pos hQ1pos hQpos, smul_eq_mul]
      ring

theorem inv_mul_polynomial_add_integral_eq_abelSharp
    (x : ℕ) {Q1 Q : ℝ} (hQ1 : 1 ≤ Q1) (hQ : Q1 ≤ Q) :
    Q⁻¹ * vaughanPrimitiveMeanPolynomial x Q +
        ∫ t in Set.Ioc Q1 Q,
          vaughanPrimitiveMeanPolynomial x t / t ^ 2 =
      vaughanPrimitiveMeanAbelSharpPolynomial x Q1 Q := by
  have hQ1pos : 0 < Q1 := zero_lt_one.trans_le hQ1
  have hQpos : 0 < Q := hQ1pos.trans_le hQ
  rw [integral_vaughanPrimitiveMeanPolynomial_div_sq x hQ1 hQ]
  unfold vaughanPrimitiveMeanPolynomial
    vaughanPrimitiveMeanAbelSharpPolynomial
  field_simp [hQ1pos.ne', hQpos.ne']
  ring

theorem abelEnvelope_log_eq
    {Q1 Q : ℝ} (hQ1 : 1 ≤ Q1) (hQ : Q1 ≤ Q) :
    Real.log (Real.exp 1 * Q / Q1) = 1 + Real.log (Q / Q1) := by
  have hQ1pos : 0 < Q1 := zero_lt_one.trans_le hQ1
  have hQpos : 0 < Q := hQ1pos.trans_le hQ
  rw [Real.log_div (mul_ne_zero (Real.exp_ne_zero 1) hQpos.ne') hQ1pos.ne',
    Real.log_mul (Real.exp_ne_zero 1) hQpos.ne', Real.log_exp,
    Real.log_div hQpos.ne' hQ1pos.ne']
  ring

theorem vaughanPrimitiveMeanAbelSharpPolynomial_le_envelope
    (x : ℕ) {Q1 Q : ℝ} (hQ1 : 1 ≤ Q1) (hQ : Q1 ≤ Q) :
    vaughanPrimitiveMeanAbelSharpPolynomial x Q1 Q ≤
      vaughanPrimitiveMeanAbelEnvelope x Q1 Q := by
  have hQ10 : 0 ≤ Q1 := zero_le_one.trans hQ1
  have hlowerSqrt :
      0 ≤ 2 * Real.sqrt (x : ℝ) * Q1 := by positivity
  have hlowerCube :
      0 ≤ 12 * vaughanCubeRoot x ^ 2 * Real.sqrt Q1 := by positivity
  unfold vaughanPrimitiveMeanAbelSharpPolynomial
    vaughanPrimitiveMeanAbelEnvelope
  rw [abelEnvelope_log_eq hQ1 hQ]
  linarith

end

section
open scoped ContDiff

theorem log_exp_mul_sqrt_lt_five_fourths_mul_log
    {x : ℝ} (hx : 4 ≤ x) :
    Real.log (Real.exp 1 * Real.sqrt x) <
      (5 / 4 : ℝ) * Real.log x := by
  have hx0 : 0 < x := lt_of_lt_of_le (by norm_num) hx
  have hlogFourLe : Real.log (4 : ℝ) ≤ Real.log x :=
    Real.log_le_log (by norm_num) hx
  have hlogTwo : (2 / 3 : ℝ) < Real.log 2 := by
    convert Real.lt_log_one_add_of_pos (x := (1 : ℝ)) (by norm_num) using 1 <;>
      norm_num
  have hlogFour : (4 / 3 : ℝ) < Real.log 4 := by
    calc
      (4 / 3 : ℝ) = 2 * (2 / 3) := by ring
      _ < 2 * Real.log 2 := by nlinarith
      _ = Real.log 4 := by
        rw [show (4 : ℝ) = 2 * 2 by norm_num,
          Real.log_mul (by norm_num) (by norm_num)]
        ring
  have hfour : (4 : ℝ) < 3 * Real.log x := by
    nlinarith
  rw [Real.log_mul (Real.exp_ne_zero 1) (Real.sqrt_pos.2 hx0).ne',
    Real.log_exp, Real.log_sqrt hx0.le]
  nlinarith

theorem four_mul_one_add_log_lt_five_mul_log_of_le_sqrt
    {x K : ℕ} (hx : 4 ≤ x) (hK : 0 < K)
    (hKsqrt : (K : ℝ) ≤ Real.sqrt (x : ℝ)) :
    4 * (1 + Real.log (K : ℝ)) <
      5 * Real.log (x : ℝ) := by
  have hx0 : (0 : ℝ) < x := by
    exact_mod_cast (show 0 < x by omega)
  have hsource := log_exp_mul_sqrt_lt_five_fourths_mul_log
    (show (4 : ℝ) ≤ x by exact_mod_cast hx)
  rw [Real.log_mul (Real.exp_ne_zero 1) (Real.sqrt_pos.2 hx0).ne',
    Real.log_exp, Real.log_sqrt hx0.le] at hsource
  have hK0 : (0 : ℝ) < K := by
    exact_mod_cast hK
  have hlogK : Real.log (K : ℝ) ≤ Real.log (Real.sqrt (x : ℝ)) :=
    Real.log_le_log hK0 hKsqrt
  rw [Real.log_sqrt hx0.le] at hlogK
  nlinarith

theorem four_mul_one_add_log_natDiv_lt_five_mul_log
    {x Q d : ℕ} (hx : 4 ≤ x) (hd : 0 < d) (hdQ : d ≤ Q)
    (hQsqrt : (Q : ℝ) ≤ Real.sqrt (x : ℝ)) :
    4 * (1 + Real.log ((Q / d : ℕ) : ℝ)) <
      5 * Real.log (x : ℝ) := by
  apply four_mul_one_add_log_lt_five_mul_log_of_le_sqrt hx
    (Nat.div_pos hdQ hd)
  have hdivQ : ((Q / d : ℕ) : ℝ) ≤ (Q : ℝ) := by
    exact_mod_cast Nat.div_le_self Q d
  exact hdivQ.trans hQsqrt

end

section
open scoped ContDiff

attribute [local instance] PrimeGap186.realCutoffDecidableForMeanNormalization
/--
At level `q`, the sum of raw primitive-character endpoint maxima multiplied by the large-sieve
weight `q / φ(q)`.
-/
noncomputable def primitiveRawMeanValueWeight (x q : ℕ) : ℝ :=
  ((q : ℝ) / (q.totient : ℝ)) *
    ∑ ψ : primitiveCharacters q,
      primitiveRawEndpointMaximum x q ψ

theorem primitiveRawMeanValueWeight_zero (x : ℕ) :
    primitiveRawMeanValueWeight x 0 = 0 := by
  simp [primitiveRawMeanValueWeight]

theorem primitiveRawMeanValueWeight_nonneg (x q : ℕ) :
    0 ≤ primitiveRawMeanValueWeight x q := by
  unfold primitiveRawMeanValueWeight
  apply mul_nonneg
  · positivity
  · exact sum_primitiveRawEndpointMaximum_nonneg x q

theorem inv_totient_mul_sum_primitiveRawEndpointMaximum_eq_meanValueWeight_div
    {x q : ℕ} (hq : 0 < q) :
    (q.totient : ℝ)⁻¹ *
        (∑ ψ : primitiveCharacters q,
          primitiveRawEndpointMaximum x q ψ) =
      primitiveRawMeanValueWeight x q / (q : ℝ) := by
  have hq0 : (q : ℝ) ≠ 0 := by
    exact_mod_cast hq.ne'
  have hphi0 : (q.totient : ℝ) ≠ 0 := by
    exact_mod_cast (Nat.totient_pos.mpr hq).ne'
  unfold primitiveRawMeanValueWeight
  field_simp

theorem sum_interval_invTotient_primitiveRaw_eq_meanValueWeight_div
    (x Q : ℕ) (Q1 : ℝ) :
    (∑ q ∈ Finset.Ioc ⌊Q1⌋₊ Q,
      (q.totient : ℝ)⁻¹ *
        ∑ ψ : primitiveCharacters q,
          primitiveRawEndpointMaximum x q ψ) =
      ∑ q ∈ Finset.Ioc ⌊Q1⌋₊ Q,
        primitiveRawMeanValueWeight x q / (q : ℝ) := by
  apply Finset.sum_congr rfl
  intro q hqmem
  have hqpos : 0 < q :=
    (Nat.zero_le ⌊Q1⌋₊).trans_lt (Finset.mem_Ioc.mp hqmem).1
  exact inv_totient_mul_sum_primitiveRawEndpointMaximum_eq_meanValueWeight_div
    hqpos

end

section
open scoped ContDiff

/--
The cumulative raw primitive mean-value weight over natural levels `0 ≤ q ≤ ⌊t⌋₊`. Including
level zero is harmless because its weight is zero.
-/
noncomputable def primitiveRawMeanValueCumulative (x : ℕ) (t : ℝ) : ℝ :=
  ∑ q ∈ Finset.Icc 0 ⌊t⌋₊, primitiveRawMeanValueWeight x q

theorem primitiveRawMeanValueCumulative_nonneg (x : ℕ) (t : ℝ) :
    0 ≤ primitiveRawMeanValueCumulative x t := by
  unfold primitiveRawMeanValueCumulative
  exact Finset.sum_nonneg fun q _ ↦ primitiveRawMeanValueWeight_nonneg x q

theorem primitiveRawMeanValueCumulative_nat (x Q : ℕ) :
    primitiveRawMeanValueCumulative x (Q : ℝ) =
      ∑ q ∈ Finset.Icc 0 Q, primitiveRawMeanValueWeight x q := by
  simp [primitiveRawMeanValueCumulative]

theorem sum_meanValueWeight_div_eq_rawPrimitiveAbel
    (x : ℕ) (Q1 Q : ℝ) (hQ1 : 1 ≤ Q1) (hQ : Q1 ≤ Q) :
    (∑ q ∈ Finset.Ioc ⌊Q1⌋₊ ⌊Q⌋₊,
      primitiveRawMeanValueWeight x q / (q : ℝ)) =
      Q⁻¹ * primitiveRawMeanValueCumulative x Q -
        Q1⁻¹ * primitiveRawMeanValueCumulative x Q1 +
          ∫ t in Set.Ioc Q1 Q,
            primitiveRawMeanValueCumulative x t / t ^ 2 := by
  have hQ1pos : 0 < Q1 := zero_lt_one.trans_le hQ1
  have habel := sum_mul_eq_sub_sub_integral_mul
    (f := fun t : ℝ ↦ t⁻¹)
    (fun q ↦ primitiveRawMeanValueWeight x q)
    hQ1pos.le hQ
    (fun t ht ↦ differentiableAt_inv (ne_of_gt (hQ1pos.trans_le ht.1)))
    (by
      rw [show deriv (fun t : ℝ ↦ t⁻¹) = fun t ↦ -(t ^ 2)⁻¹ by
        funext t
        exact deriv_inv]
      exact (((continuousOn_id.pow 2).inv₀ (fun t ht ↦ by
        have htpos : 0 < t := hQ1pos.trans_le ht.1
        exact pow_ne_zero 2 htpos.ne')).neg).integrableOn_Icc)
  have habel' :
      (∑ q ∈ Finset.Ioc ⌊Q1⌋₊ ⌊Q⌋₊,
          (q : ℝ)⁻¹ * primitiveRawMeanValueWeight x q) =
        Q⁻¹ * primitiveRawMeanValueCumulative x Q -
          Q1⁻¹ * primitiveRawMeanValueCumulative x Q1 -
            ∫ t in Set.Ioc Q1 Q,
              deriv (fun y : ℝ ↦ y⁻¹) t *
                primitiveRawMeanValueCumulative x t := by
    simpa [primitiveRawMeanValueCumulative] using habel
  have hleft :
      (∑ q ∈ Finset.Ioc ⌊Q1⌋₊ ⌊Q⌋₊,
          primitiveRawMeanValueWeight x q / (q : ℝ)) =
        ∑ q ∈ Finset.Ioc ⌊Q1⌋₊ ⌊Q⌋₊,
          (q : ℝ)⁻¹ * primitiveRawMeanValueWeight x q := by
    apply Finset.sum_congr rfl
    intro q _
    rw [div_eq_mul_inv, mul_comm]
  have hintegrand :
      (fun t : ℝ ↦
          deriv (fun y : ℝ ↦ y⁻¹) t *
            primitiveRawMeanValueCumulative x t) =
        fun t ↦ -(primitiveRawMeanValueCumulative x t / t ^ 2) := by
    funext t
    rw [deriv_inv]
    ring
  rw [hleft, habel', hintegrand, MeasureTheory.integral_neg]
  ring

theorem sum_meanValueWeight_div_eq_rawPrimitiveAbel_natUpper
    (x Q : ℕ) (Q1 : ℝ) (hQ1 : 1 ≤ Q1)
    (hQ : Q1 ≤ (Q : ℝ)) :
    (∑ q ∈ Finset.Ioc ⌊Q1⌋₊ Q,
      primitiveRawMeanValueWeight x q / (q : ℝ)) =
      (Q : ℝ)⁻¹ * primitiveRawMeanValueCumulative x Q -
        Q1⁻¹ * primitiveRawMeanValueCumulative x Q1 +
          ∫ t in Set.Ioc Q1 (Q : ℝ),
            primitiveRawMeanValueCumulative x t / t ^ 2 := by
  simpa only [Nat.floor_natCast] using
    sum_meanValueWeight_div_eq_rawPrimitiveAbel
      x Q1 (Q : ℝ) hQ1 hQ

/--
The logarithmic factor `(log x)⁴ √(log x)` in the Abel-summed primitive mean-value estimate.
-/
noncomputable def vaughanProgressionMeanLogPower
    (x : ℕ) : ℝ :=
  Real.log (x : ℝ) ^ 4 * Real.sqrt (Real.log (x : ℝ))

theorem vaughanProgressionMeanLogPower_nonneg (x : ℕ) :
    0 ≤ vaughanProgressionMeanLogPower x := by
  unfold vaughanProgressionMeanLogPower
  positivity

theorem five_log_mul_vaughanPrimitiveMeanLogPower (x : ℕ) :
    (5 * Real.log (x : ℝ)) *
        vaughanPrimitiveMeanLogPower x =
      5 * vaughanProgressionMeanLogPower x := by
  unfold vaughanPrimitiveMeanLogPower
    vaughanProgressionMeanLogPower
  ring

theorem largeConductorCenteredMass_eq_sum_multipliers
    (x Q R : ℕ) (hR : 1 ≤ R) :
    largeConductorCenteredMass x Q R =
      ∑ d ∈ Finset.Ioc R Q,
        (∑ ψ : primitiveCharacters d,
          primitiveCenteredEndpointMaximum x d ψ) *
          ∑ k ∈ Finset.Ioc 0 (Q / d),
            ((d * k).totient : ℝ)⁻¹ := by
  classical
  unfold largeConductorCenteredMass
  let S : Finset (ℕ × ℕ) :=
    (positiveFactorPairs Q).filter (fun p ↦ p.1 ≠ 1 ∧ R < p.1)
  let T : Finset ((d : ℕ) × ℕ) :=
    Finset.sigma (Finset.Ioc R Q) (fun d ↦ Finset.Ioc 0 (Q / d))
  let F : ℕ × ℕ → ℝ := fun p ↦
    ((p.1 * p.2).totient : ℝ)⁻¹ *
      ∑ ψ : primitiveCharacters p.1,
        primitiveCenteredEndpointMaximum x p.1 ψ
  have hbij : (∑ p ∈ S, F p) = ∑ z ∈ T, F (z.1, z.2) := by
    apply Finset.sum_bij (fun p _hp ↦ ⟨p.1, p.2⟩)
    · intro p hp
      rcases Finset.mem_filter.mp hp with ⟨hpairs, _hdne, hRd⟩
      rcases Finset.mem_filter.mp hpairs with ⟨hprodmem, hprod⟩
      rcases Finset.mem_product.mp hprodmem with ⟨hdmem, hkmem⟩
      have hdpos : 0 < p.1 := (Finset.mem_Ioc.mp hdmem).1
      have hkdiv : p.2 ≤ Q / p.1 := by
        apply (Nat.le_div_iff_mul_le hdpos).2
        simpa [Nat.mul_comm] using hprod
      exact Finset.mem_sigma.mpr ⟨
        Finset.mem_Ioc.mpr ⟨hRd, (Finset.mem_Ioc.mp hdmem).2⟩,
        Finset.mem_Ioc.mpr ⟨(Finset.mem_Ioc.mp hkmem).1, hkdiv⟩⟩
    · intro p _hp p' _hp' heq
      apply Prod.ext
      · exact congrArg Sigma.fst heq
      · exact congrArg Sigma.snd heq
    · intro z hz
      rcases z with ⟨d, k⟩
      rcases Finset.mem_sigma.mp hz with ⟨hdmem, hkmem⟩
      have hdBounds := Finset.mem_Ioc.mp hdmem
      have hdpos : 0 < d := (Nat.zero_lt_one.trans_le hR).trans hdBounds.1
      have hkBounds := Finset.mem_Ioc.mp hkmem
      have hprod : d * k ≤ Q := by
        have h := (Nat.le_div_iff_mul_le hdpos).1 hkBounds.2
        simpa [Nat.mul_comm] using h
      have hkQ : k ≤ Q := hkBounds.2.trans (Nat.div_le_self Q d)
      have hpairs : (d, k) ∈ positiveFactorPairs Q := by
        apply Finset.mem_filter.mpr
        refine ⟨Finset.mem_product.mpr ⟨
          Finset.mem_Ioc.mpr ⟨hdpos, hdBounds.2⟩,
          Finset.mem_Ioc.mpr ⟨hkBounds.1, hkQ⟩⟩, hprod⟩
      refine ⟨(d, k), Finset.mem_filter.mpr ⟨hpairs, ?_, hdBounds.1⟩, ?_⟩
      · exact (hR.trans_lt hdBounds.1).ne'
      · rfl
    · intro p _hp
      rfl
  have hsum := Finset.sum_sigma' (Finset.Ioc R Q)
    (fun d ↦ Finset.Ioc 0 (Q / d)) (fun d k ↦ F (d, k))
  calc
    (∑ p ∈ S, F p) =
        ∑ d ∈ Finset.Ioc R Q,
          ∑ k ∈ Finset.Ioc 0 (Q / d),
            ((d * k).totient : ℝ)⁻¹ *
              ∑ ψ : primitiveCharacters d,
                primitiveCenteredEndpointMaximum x d ψ := by
      simpa [T, F] using hbij.trans hsum.symm
    _ = _ := by
      apply Finset.sum_congr rfl
      intro d _hd
      rw [Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro k _hk
      rw [mul_comm]

theorem largeConductorCenteredMass_le_five_log_meanValueInterval
    (x Q R : ℕ) (hx : 4 ≤ x)
    (hQsqrt : (Q : ℝ) ≤ Real.sqrt (x : ℝ)) (hR : 1 ≤ R) :
    largeConductorCenteredMass x Q R ≤
      (5 * Real.log (x : ℝ)) *
        ∑ d ∈ Finset.Ioc R Q,
          primitiveRawMeanValueWeight x d / (d : ℝ) := by
  rw [largeConductorCenteredMass_eq_sum_multipliers x Q R hR]
  calc
    (∑ d ∈ Finset.Ioc R Q,
        (∑ ψ : primitiveCharacters d,
          primitiveCenteredEndpointMaximum x d ψ) *
          ∑ k ∈ Finset.Ioc 0 (Q / d),
            ((d * k).totient : ℝ)⁻¹) ≤
        ∑ d ∈ Finset.Ioc R Q,
          (∑ ψ : primitiveCharacters d,
            primitiveCenteredEndpointMaximum x d ψ) *
            ((d.totient : ℝ)⁻¹ *
              ∑ k ∈ Finset.Ioc 0 (Q / d),
                (k.totient : ℝ)⁻¹) := by
      apply Finset.sum_le_sum
      intro d hdmem
      apply mul_le_mul_of_nonneg_left
      · exact sum_inv_totient_mul_le_inv_totient_mul_sum Q d
          ((Nat.zero_lt_one.trans_le hR).trans (Finset.mem_Ioc.mp hdmem).1)
      · exact sum_primitiveCenteredEndpointMaximum_nonneg x d
    _ ≤ ∑ d ∈ Finset.Ioc R Q,
          (∑ ψ : primitiveCharacters d,
            primitiveCenteredEndpointMaximum x d ψ) *
            ((d.totient : ℝ)⁻¹ * (5 * Real.log (x : ℝ))) := by
      apply Finset.sum_le_sum
      intro d hdmem
      have hdBounds := Finset.mem_Ioc.mp hdmem
      have hdpos : 0 < d := (Nat.zero_lt_one.trans_le hR).trans hdBounds.1
      have hK : 0 < Q / d := Nat.div_pos hdBounds.2 hdpos
      have hprefix :
          (∑ k ∈ Finset.Ioc 0 (Q / d), (k.totient : ℝ)⁻¹) ≤
            4 * (1 + Real.log ((Q / d : ℕ) : ℝ)) := by
        simpa [reciprocalTotientPrefix] using
          (reciprocalTotientPrefix_le_four_mul_one_add_log hK)
      have hlog := four_mul_one_add_log_natDiv_lt_five_mul_log
        hx hdpos hdBounds.2 hQsqrt
      apply mul_le_mul_of_nonneg_left
      · apply mul_le_mul_of_nonneg_left (hprefix.trans hlog.le)
        positivity
      · exact sum_primitiveCenteredEndpointMaximum_nonneg x d
    _ = (5 * Real.log (x : ℝ)) *
        ∑ d ∈ Finset.Ioc R Q,
          (d.totient : ℝ)⁻¹ *
            ∑ ψ : primitiveCharacters d,
              primitiveCenteredEndpointMaximum x d ψ := by
      rw [Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro d _hd
      ring
    _ = (5 * Real.log (x : ℝ)) *
        ∑ d ∈ Finset.Ioc R Q,
          (d.totient : ℝ)⁻¹ *
            ∑ ψ : primitiveCharacters d,
              primitiveRawEndpointMaximum x d ψ := by
      congr 1
      apply Finset.sum_congr rfl
      intro d hdmem
      rw [sum_primitiveCenteredEndpointMaximum_eq_raw x
        (hR.trans_lt (Finset.mem_Ioc.mp hdmem).1)]
    _ = (5 * Real.log (x : ℝ)) *
        ∑ d ∈ Finset.Ioc R Q,
          primitiveRawMeanValueWeight x d / (d : ℝ) := by
      congr 1
      simpa only [Nat.floor_natCast] using
        (sum_interval_invTotient_primitiveRaw_eq_meanValueWeight_div
          x Q (R : ℝ))

end

section
open scoped ContDiff

open scoped ArithmeticFunction ArithmeticFunction.Moebius
  ArithmeticFunction.zeta BigOperators
theorem arithmeticFunctionLowCutoff_apply_of_lt
    {U : ℝ} {f : ArithmeticFunction ℝ} {n : ℕ}
    (hn : U < (n : ℝ)) :
    arithmeticFunctionLowCutoff U f n = 0 := by
  simp [arithmeticFunctionLowCutoff, not_le_of_gt hn]

theorem arithmeticFunctionHighCutoff_apply_of_lt
    {U : ℝ} {f : ArithmeticFunction ℝ} {n : ℕ}
    (hn : U < (n : ℝ)) :
    arithmeticFunctionHighCutoff U f n = f n := by
  change f n - arithmeticFunctionLowCutoff U f n = f n
  rw [arithmeticFunctionLowCutoff_apply_of_lt hn]
  ring

theorem arithmeticFunctionLowCutoff_mul_zeta_apply
    (V : ℝ) (f : ArithmeticFunction ℝ) (k : ℕ) :
    (arithmeticFunctionLowCutoff V f *
      (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) k =
      ∑ d ∈ k.divisors.filter (fun d : ℕ ↦ (d : ℝ) ≤ V), f d := by
  rw [ArithmeticFunction.coe_mul_zeta_apply]
  simp only [arithmeticFunctionLowCutoff, ArithmeticFunction.coe_mk,
    Finset.sum_filter]

theorem moebiusLowCutoff_mul_zeta_apply_of_le
    {V : ℝ} {k : ℕ} (hk : (k : ℝ) ≤ V) :
    (arithmeticFunctionLowCutoff V
      (ArithmeticFunction.moebius : ArithmeticFunction ℝ) *
        (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) k =
      (1 : ArithmeticFunction ℝ) k := by
  by_cases hk0 : k = 0
  · subst k
    simp [arithmeticFunctionLowCutoff]
  calc
    (arithmeticFunctionLowCutoff V
        (ArithmeticFunction.moebius : ArithmeticFunction ℝ) *
          (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) k =
        ∑ d ∈ k.divisors,
          arithmeticFunctionLowCutoff V
            (ArithmeticFunction.moebius : ArithmeticFunction ℝ) d :=
      ArithmeticFunction.coe_mul_zeta_apply
    _ = ∑ d ∈ k.divisors,
          (ArithmeticFunction.moebius : ArithmeticFunction ℝ) d := by
      apply Finset.sum_congr rfl
      intro d hd
      apply arithmeticFunctionLowCutoff_apply_of_le
      exact (Nat.cast_le.mpr (Nat.le_of_dvd (Nat.pos_of_ne_zero hk0)
        (Nat.mem_divisors.mp hd).1)).trans hk
    _ = ((ArithmeticFunction.moebius : ArithmeticFunction ℝ) *
          (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) k :=
      ArithmeticFunction.coe_mul_zeta_apply.symm
    _ = (1 : ArithmeticFunction ℝ) k := by
      rw [ArithmeticFunction.coe_moebius_mul_coe_zeta]

theorem vaughanConvolutionIdentity (U V : ℝ) :
    arithmeticFunctionLowCutoff U ArithmeticFunction.vonMangoldt +
        arithmeticFunctionLowCutoff V
          (ArithmeticFunction.moebius : ArithmeticFunction ℝ) *
            ArithmeticFunction.log -
        arithmeticFunctionLowCutoff U ArithmeticFunction.vonMangoldt *
          arithmeticFunctionLowCutoff V
            (ArithmeticFunction.moebius : ArithmeticFunction ℝ) *
              (ArithmeticFunction.zeta : ArithmeticFunction ℝ) +
      (arithmeticFunctionHighCutoff U ArithmeticFunction.vonMangoldt -
        arithmeticFunctionHighCutoff U ArithmeticFunction.vonMangoldt *
          arithmeticFunctionLowCutoff V
            (ArithmeticFunction.moebius : ArithmeticFunction ℝ) *
              (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) =
      ArithmeticFunction.vonMangoldt := by
  rw [← ArithmeticFunction.vonMangoldt_mul_zeta]
  unfold arithmeticFunctionHighCutoff
  ring

theorem one_sub_moebiusLowCutoff_mul_zeta_apply
    {V : ℝ} (hV : 1 ≤ V) (k : ℕ) :
    (((1 : ArithmeticFunction ℝ) -
        arithmeticFunctionLowCutoff V
          (ArithmeticFunction.moebius : ArithmeticFunction ℝ) *
          (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) k =
      if V < (k : ℝ) then
        -∑ d ∈ k.divisors.filter (fun d : ℕ ↦ (d : ℝ) ≤ V),
          (ArithmeticFunction.moebius : ArithmeticFunction ℝ) d
      else 0) := by
  change (1 : ArithmeticFunction ℝ) k -
      (arithmeticFunctionLowCutoff V
        (ArithmeticFunction.moebius : ArithmeticFunction ℝ) *
          (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) k = _
  by_cases hk : (k : ℝ) ≤ V
  · rw [moebiusLowCutoff_mul_zeta_apply_of_le hk]
    simp [not_lt_of_ge hk]
  · have hk' : V < (k : ℝ) := lt_of_not_ge hk
    have hk1 : k ≠ 1 := by
      intro hk1
      subst k
      norm_num at hk'
      exact (not_lt_of_ge hV) hk'
    rw [ArithmeticFunction.one_apply_ne hk1,
      arithmeticFunctionLowCutoff_mul_zeta_apply, zero_sub, ite_eq_left hk']

theorem vaughanLambdaThree_apply
    {U V : ℝ} (_hU : 1 ≤ U) (_hV : 1 ≤ V) (n : ℕ) :
    (-(arithmeticFunctionLowCutoff U ArithmeticFunction.vonMangoldt *
        arithmeticFunctionLowCutoff V
          (ArithmeticFunction.moebius : ArithmeticFunction ℝ) *
        (ArithmeticFunction.zeta : ArithmeticFunction ℝ))) n =
      -∑ tr ∈ n.divisorsAntidiagonal,
        ∑ md ∈ tr.1.divisorsAntidiagonal.filter
          (fun md : ℕ × ℕ ↦
            (md.1 : ℝ) ≤ U ∧ (md.2 : ℝ) ≤ V),
          ArithmeticFunction.vonMangoldt md.1 *
            (ArithmeticFunction.moebius : ArithmeticFunction ℝ) md.2 := by
  rw [ArithmeticFunction.neg_apply, ArithmeticFunction.mul_apply]
  congr 1
  apply Finset.sum_congr rfl
  intro tr htr
  have hmem := Nat.mem_divisorsAntidiagonal.mp htr
  have htr2 : tr.2 ≠ 0 := by
    apply right_ne_zero_of_mul
    rw [hmem.1]
    exact hmem.2
  rw [ArithmeticFunction.natCoe_apply, ArithmeticFunction.zeta_apply,
    ite_eq_right htr2, Nat.cast_one, mul_one, ArithmeticFunction.mul_apply]
  simp only [Finset.sum_filter, arithmeticFunctionLowCutoff,
    ArithmeticFunction.coe_mk]
  apply Finset.sum_congr rfl
  intro md _hmd
  by_cases hm : (md.1 : ℝ) ≤ U
  · by_cases hd : (md.2 : ℝ) ≤ V
    · simp [hm, hd]
    · simp [hm, hd]
  · simp [hm]

theorem vaughanLambdaFour_apply
    {U V : ℝ} (_hU : 1 ≤ U) (hV : 1 ≤ V) (n : ℕ) :
    (arithmeticFunctionHighCutoff U ArithmeticFunction.vonMangoldt -
        arithmeticFunctionHighCutoff U ArithmeticFunction.vonMangoldt *
          arithmeticFunctionLowCutoff V
            (ArithmeticFunction.moebius : ArithmeticFunction ℝ) *
          (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n =
      -∑ mk ∈ n.divisorsAntidiagonal.filter
        (fun mk : ℕ × ℕ ↦
          U < (mk.1 : ℝ) ∧ V < (mk.2 : ℝ)),
        ArithmeticFunction.vonMangoldt mk.1 *
          ∑ d ∈ mk.2.divisors.filter
            (fun d : ℕ ↦ (d : ℝ) ≤ V),
            (ArithmeticFunction.moebius : ArithmeticFunction ℝ) d := by
  let H := arithmeticFunctionHighCutoff U ArithmeticFunction.vonMangoldt
  let M := arithmeticFunctionLowCutoff V
    (ArithmeticFunction.moebius : ArithmeticFunction ℝ)
  let Z := (ArithmeticFunction.zeta : ArithmeticFunction ℝ)
  have hrearrange : H - H * M * Z = H * (1 - M * Z) := by ring
  change (H - H * M * Z) n = _
  rw [hrearrange, ArithmeticFunction.mul_apply,
    ← Finset.sum_neg_distrib, Finset.sum_filter]
  apply Finset.sum_congr rfl
  intro mk _hmk
  change H mk.1 * ((1 : ArithmeticFunction ℝ) - M * Z) mk.2 = _
  rw [show ((1 : ArithmeticFunction ℝ) - M * Z) mk.2 =
      if V < (mk.2 : ℝ) then
        -∑ d ∈ mk.2.divisors.filter (fun d : ℕ ↦ (d : ℝ) ≤ V),
          (ArithmeticFunction.moebius : ArithmeticFunction ℝ) d
      else 0 by exact one_sub_moebiusLowCutoff_mul_zeta_apply hV mk.2]
  by_cases hm : U < (mk.1 : ℝ)
  · change arithmeticFunctionHighCutoff U
        ArithmeticFunction.vonMangoldt mk.1 * _ = _
    rw [arithmeticFunctionHighCutoff_apply_of_lt hm]
    by_cases hk : V < (mk.2 : ℝ)
    · simp [hm, hk]
    · simp [hm, hk]
  · have hmle : (mk.1 : ℝ) ≤ U := le_of_not_gt hm
    change arithmeticFunctionHighCutoff U
        ArithmeticFunction.vonMangoldt mk.1 * _ = _
    rw [arithmeticFunctionHighCutoff_apply_of_le hmle]
    simp [hm]

end

section
open scoped ContDiff

open scoped ArithmeticFunction.vonMangoldt

theorem twistedChebyshevSum_eq_vaughanTwistedSums
    {U V : ℝ} (hU : 1 ≤ U) (hV : 1 ≤ V)
    (y q : ℕ) (χ : DirichletCharacter ℂ q) :
    twistedChebyshevSum y q χ =
      vaughanTwistedSumOne U y q χ +
      vaughanTwistedSumTwo V y q χ +
      vaughanTwistedSumThree U V y q χ +
      vaughanTwistedSumFour U V y q χ := by
  unfold twistedChebyshevSum vaughanTwistedSumOne
    vaughanTwistedSumTwo vaughanTwistedSumThree vaughanTwistedSumFour
  rw [Finset.sum_filter]
  simp_rw [← vaughanLambdaTwo_apply,
    ← vaughanLambdaThree_apply hU hV,
    ← vaughanLambdaFour_apply hU hV]
  have hS1 :
      (∑ n ∈ Finset.Icc 1 y,
        if (n : ℝ) ≤ U then
          χ n * (ArithmeticFunction.vonMangoldt n : ℂ)
        else 0) =
      ∑ n ∈ Finset.Icc 1 y,
        χ n *
          (arithmeticFunctionLowCutoff U
            ArithmeticFunction.vonMangoldt n : ℂ) := by
    apply Finset.sum_congr rfl
    intro n _hn
    by_cases hnU : (n : ℝ) ≤ U
    · rw [ite_eq_left hnU, arithmeticFunctionLowCutoff_apply_of_le hnU]
    · rw [ite_eq_right hnU,
        arithmeticFunctionLowCutoff_apply_of_lt (lt_of_not_ge hnU)]
      simp
  rw [hS1, ← Finset.sum_add_distrib, ← Finset.sum_add_distrib,
    ← Finset.sum_add_distrib]
  apply Finset.sum_congr rfl
  intro n _hn
  rw [← mul_add, ← mul_add, ← mul_add]
  congr 1
  rw [← Complex.ofReal_add, ← Complex.ofReal_add,
    ← Complex.ofReal_add]
  simpa only [sub_eq_add_neg, ArithmeticFunction.add_apply,
    ArithmeticFunction.neg_apply] using
    (congrArg (fun f : ArithmeticFunction ℝ ↦ (f n : ℂ))
      (vaughanConvolutionIdentity U V)).symm

theorem twistedChebyshevSum_eq_vaughanFiveTerms
    {U V : ℝ} (hU : 1 ≤ U) (hV : 1 ≤ V)
    (y q : ℕ) (chi : DirichletCharacter ℂ q) :
    twistedChebyshevSum y q chi =
      vaughanTwistedSumOne U y q chi +
      vaughanTwistedSumTwo V y q chi -
      vaughanTwistedSumThreeSmall U V y q chi -
      vaughanTwistedSumThreeLarge U V y q chi +
      vaughanTwistedSumFour U V y q chi := by
  rw [twistedChebyshevSum_eq_vaughanTwistedSums hU hV]
  have hthree :
      vaughanTwistedSumThree U V y q chi =
        -(vaughanTwistedSumThreeSmall U V y q chi +
          vaughanTwistedSumThreeLarge U V y q chi) := by
    rw [← neg_vaughanTwistedSumThree_eq_small_add_large hU hV]
    simp
  rw [hthree]
  ring

end

section
open scoped ContDiff

theorem norm_vaughanTwistedSumTwo_lt_sqrt_mul_cutoff_mul_log_sq
    {Q V : ℝ} {x y q : ℕ}
    (hx : 4 ≤ x) (hV : 1 ≤ V) (hyx : y ≤ x)
    (hq : 1 < q) (hqQ : (q : ℝ) ≤ Q)
    (hQsqrt : Q ≤ Real.sqrt (x : ℝ))
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive) :
    ‖vaughanTwistedSumTwo V y q chi‖ <
      Real.sqrt (q : ℝ) * V *
        (Real.log ((x : ℝ) * V)) ^ 2 := by
  let : NeZero q := ⟨Nat.ne_zero_of_lt hq⟩
  have hqpos : (0 : ℝ) < q := by
    exact_mod_cast Nat.zero_lt_of_lt hq
  have hsqrtq : 0 < Real.sqrt (q : ℝ) := Real.sqrt_pos.2 hqpos
  have hlogq : 0 < Real.log (q : ℝ) :=
    Real.log_pos (by exact_mod_cast hq)
  have hC : 0 ≤ Real.sqrt (q : ℝ) * Real.log (q : ℝ) :=
    (mul_pos hsqrtq hlogq).le
  have hxReal : (1 : ℝ) < x := by exact_mod_cast (show 1 < x by omega)
  have hsqrtxlt : Real.sqrt (x : ℝ) < (x : ℝ) :=
    Real.sqrt_lt_self_iff.mpr hxReal
  have hxle : (x : ℝ) ≤ (x : ℝ) * V := by
    nlinarith [show (0 : ℝ) < x by positivity]
  have hq_lt_xV : (q : ℝ) < (x : ℝ) * V :=
    (hqQ.trans hQsqrt).trans_lt (hsqrtxlt.trans_le hxle)
  have hxVpos : 0 < (x : ℝ) * V := by positivity
  have hlogq_lt : Real.log (q : ℝ) < Real.log ((x : ℝ) * V) :=
    Real.strictMonoOn_log hqpos hxVpos hq_lt_xV
  have hlogxVpos : 0 < Real.log ((x : ℝ) * V) :=
    Real.log_pos (hxReal.trans_le hxle)
  by_cases hyzero : y = 0
  · subst y
    rw [vaughanTwistedSumTwo_eq_divisorLogSums]
    simpa [vaughanSecondTermIndices] using
      mul_pos (mul_pos hsqrtq (zero_lt_one.trans_le hV)) (sq_pos_of_pos hlogxVpos)
  have hy : 1 ≤ y := Nat.one_le_iff_ne_zero.mpr hyzero
  have hbase := norm_vaughanTwistedSumTwo_le_cutoff_mul_of_intervalBound
    hV hy hC chi (fun _d _hd a _ha ↦
      (norm_dirichletCharacterIntervalSum_lt_sqrt_mul_log
        hq chi hchi a (y / _d)).le)
  have hy_le_xV : (y : ℝ) ≤ (x : ℝ) * V := by
    exact (by exact_mod_cast hyx : (y : ℝ) ≤ x) |>.trans hxle
  have hlogy_le : Real.log (y : ℝ) ≤ Real.log ((x : ℝ) * V) :=
    Real.log_le_log (by exact_mod_cast (show 0 < y by omega)) hy_le_xV
  have hlogs :
      Real.log (y : ℝ) * Real.log (q : ℝ) <
        (Real.log ((x : ℝ) * V)) ^ 2 := by
    calc
      Real.log (y : ℝ) * Real.log (q : ℝ) ≤
          Real.log ((x : ℝ) * V) * Real.log (q : ℝ) :=
        mul_le_mul_of_nonneg_right hlogy_le hlogq.le
      _ < Real.log ((x : ℝ) * V) * Real.log ((x : ℝ) * V) :=
        mul_lt_mul_of_pos_left hlogq_lt hlogxVpos
      _ = (Real.log ((x : ℝ) * V)) ^ 2 := by ring
  calc
    ‖vaughanTwistedSumTwo V y q chi‖ ≤
        V * Real.log (y : ℝ) *
          (Real.sqrt (q : ℝ) * Real.log (q : ℝ)) := hbase
    _ = Real.sqrt (q : ℝ) * V *
        (Real.log (y : ℝ) * Real.log (q : ℝ)) := by ring
    _ < Real.sqrt (q : ℝ) * V *
        (Real.log ((x : ℝ) * V)) ^ 2 := by
      gcongr

end

section
open scoped ContDiff

attribute [local instance] PrimeGap186.primitiveCharactersOneUnique
/--
The maximum norm of the second Vaughan contribution over integer endpoints `1 ≤ y ≤ x`. Defined
to be zero at `x = 0`.
-/
noncomputable def vaughanTwistedSumTwoEndpointMaximum
    (V : ℝ) (x q : ℕ) (chi : DirichletCharacter ℂ q) : ℝ :=
  if hx : 1 ≤ x then
    (Finset.Icc 1 x).sup'
      ⟨1, Finset.mem_Icc.mpr ⟨le_rfl, hx⟩⟩
      (fun y ↦ ‖vaughanTwistedSumTwo V y q chi‖)
  else 0

theorem vaughanTwistedSumTwoEndpointMaximum_level_one_lt_endpoint_mul_log_sq
    {V : ℝ} {x : ℕ} (hx : 4 ≤ x) (hV : 1 ≤ V)
    (chi : DirichletCharacter ℂ 1) :
    vaughanTwistedSumTwoEndpointMaximum V x 1 chi <
      (x : ℝ) * (Real.log ((x : ℝ) * V)) ^ 2 := by
  unfold vaughanTwistedSumTwoEndpointMaximum
  rw [dite_eq_left (by omega)]
  apply (Finset.sup'_lt_iff _).mpr
  intro y hy
  exact norm_vaughanTwistedSumTwo_level_one_lt_endpoint_mul_log_sq
    hx hV (Finset.mem_Icc.mp hy).2 chi

theorem vaughanTwistedSumTwoEndpointMaximum_lt_sqrt_mul_cutoff_mul_log_sq
    {Q V : ℝ} {x q : ℕ}
    (hx : 4 ≤ x) (hV : 1 ≤ V)
    (hq : 1 < q) (hqQ : (q : ℝ) ≤ Q)
    (hQsqrt : Q ≤ Real.sqrt (x : ℝ))
    (chi : DirichletCharacter ℂ q) (hchi : chi.IsPrimitive) :
    vaughanTwistedSumTwoEndpointMaximum V x q chi <
      Real.sqrt (q : ℝ) * V *
        (Real.log ((x : ℝ) * V)) ^ 2 := by
  unfold vaughanTwistedSumTwoEndpointMaximum
  rw [dite_eq_left (by omega)]
  apply (Finset.sup'_lt_iff _).mpr
  intro y hy
  exact norm_vaughanTwistedSumTwo_lt_sqrt_mul_cutoff_mul_log_sq
    hx hV (Finset.mem_Icc.mp hy).2 hq hqQ hQsqrt chi hchi

theorem weightedPrimitiveVaughanTwistedSumTwoEndpointMaximum_le
    {V : ℝ} {x Q q : ℕ}
    (hx : 4 ≤ x) (hV : 1 ≤ V)
    (hq : 1 < q) (hqQ : q ≤ Q)
    (hQsqrt : (Q : ℝ) ≤ Real.sqrt (x : ℝ)) :
    (q : ℝ) / (q.totient : ℝ) *
        ∑ chi : primitiveCharacters q,
          vaughanTwistedSumTwoEndpointMaximum V x q chi.1 ≤
      (q : ℝ) * Real.sqrt (q : ℝ) * V *
        (Real.log ((x : ℝ) * V)) ^ 2 := by
  have hqpos : 0 < q := Nat.zero_lt_of_lt hq
  have hphi : 0 < (q.totient : ℝ) := by
    exact_mod_cast Nat.totient_pos.mpr hqpos
  have hboundNonneg :
      0 ≤ Real.sqrt (q : ℝ) * V *
        (Real.log ((x : ℝ) * V)) ^ 2 := by
    positivity
  have hmass :
      (∑ chi : primitiveCharacters q,
          vaughanTwistedSumTwoEndpointMaximum V x q chi.1) ≤
        (q.totient : ℝ) *
          (Real.sqrt (q : ℝ) * V *
            (Real.log ((x : ℝ) * V)) ^ 2) := by
    calc
      (∑ chi : primitiveCharacters q,
          vaughanTwistedSumTwoEndpointMaximum V x q chi.1) ≤
          ∑ _chi : primitiveCharacters q,
            Real.sqrt (q : ℝ) * V *
              (Real.log ((x : ℝ) * V)) ^ 2 := by
        apply Finset.sum_le_sum
        intro chi _hchi
        exact (vaughanTwistedSumTwoEndpointMaximum_lt_sqrt_mul_cutoff_mul_log_sq
          hx hV hq (by exact_mod_cast hqQ) hQsqrt chi.1 chi.2).le
      _ = (Fintype.card (primitiveCharacters q) : ℝ) *
          (Real.sqrt (q : ℝ) * V *
            (Real.log ((x : ℝ) * V)) ^ 2) := by
        simp
      _ ≤ (q.totient : ℝ) *
          (Real.sqrt (q : ℝ) * V *
            (Real.log ((x : ℝ) * V)) ^ 2) := by
        gcongr
        exact_mod_cast card_primitiveCharacters_le_totient hqpos
  calc
    (q : ℝ) / (q.totient : ℝ) *
        ∑ chi : primitiveCharacters q,
          vaughanTwistedSumTwoEndpointMaximum V x q chi.1 ≤
      (q : ℝ) / (q.totient : ℝ) *
        ((q.totient : ℝ) *
          (Real.sqrt (q : ℝ) * V *
            (Real.log ((x : ℝ) * V)) ^ 2)) := by
      gcongr
    _ = (q : ℝ) * Real.sqrt (q : ℝ) * V *
        (Real.log ((x : ℝ) * V)) ^ 2 := by
      field_simp

theorem sum_weightedPrimitiveVaughanTwistedSumTwoEndpointMaximum_rest_le
    {V : ℝ} {x Q : ℕ}
    (hx : 4 ≤ x) (hV : 1 ≤ V)
    (hQsqrt : (Q : ℝ) ≤ Real.sqrt (x : ℝ)) :
    (∑ q ∈ Finset.Ioc 1 Q,
      (q : ℝ) / (q.totient : ℝ) *
        ∑ chi : primitiveCharacters q,
          vaughanTwistedSumTwoEndpointMaximum V x q chi.1) ≤
      (Q : ℝ) ^ 2 * Real.sqrt (Q : ℝ) * V *
        (Real.log ((x : ℝ) * V)) ^ 2 := by
  have hVsqrtNonneg :
      0 ≤ Real.sqrt (Q : ℝ) * V *
        (Real.log ((x : ℝ) * V)) ^ 2 := by
    positivity
  calc
    (∑ q ∈ Finset.Ioc 1 Q,
        (q : ℝ) / (q.totient : ℝ) *
          ∑ chi : primitiveCharacters q,
            vaughanTwistedSumTwoEndpointMaximum V x q chi.1) ≤
        ∑ q ∈ Finset.Ioc 1 Q,
          (q : ℝ) * Real.sqrt (q : ℝ) * V *
            (Real.log ((x : ℝ) * V)) ^ 2 := by
      apply Finset.sum_le_sum
      intro q hq
      exact weightedPrimitiveVaughanTwistedSumTwoEndpointMaximum_le
        hx hV (Finset.mem_Ioc.mp hq).1 (Finset.mem_Ioc.mp hq).2 hQsqrt
    _ ≤ ∑ _q ∈ Finset.Ioc 1 Q,
        (Q : ℝ) * Real.sqrt (Q : ℝ) * V *
          (Real.log ((x : ℝ) * V)) ^ 2 := by
      apply Finset.sum_le_sum
      intro q hq
      have hqQ : (q : ℝ) ≤ Q := by
        exact_mod_cast (Finset.mem_Ioc.mp hq).2
      have hsqrt : Real.sqrt (q : ℝ) ≤ Real.sqrt (Q : ℝ) :=
        Real.sqrt_le_sqrt hqQ
      gcongr
    _ ≤ (Q : ℝ) ^ 2 * Real.sqrt (Q : ℝ) * V *
        (Real.log ((x : ℝ) * V)) ^ 2 := by
      rw [Finset.sum_const, nsmul_eq_mul]
      calc
        (Finset.Ioc 1 Q).card *
            ((Q : ℝ) * Real.sqrt (Q : ℝ) * V *
              (Real.log ((x : ℝ) * V)) ^ 2) ≤
            (Q : ℝ) *
              ((Q : ℝ) * Real.sqrt (Q : ℝ) * V *
                (Real.log ((x : ℝ) * V)) ^ 2) := by
          gcongr
          exact_mod_cast (show (Finset.Ioc 1 Q).card ≤ Q by
            simp [Nat.card_Ioc])
        _ = (Q : ℝ) ^ 2 * Real.sqrt (Q : ℝ) * V *
            (Real.log ((x : ℝ) * V)) ^ 2 := by ring

theorem sum_weightedPrimitiveVaughanTwistedSumTwoEndpointMaximum_lt
    {V : ℝ} {x Q : ℕ}
    (hx : 4 ≤ x) (hV : 1 ≤ V) (hQ : 2 ≤ Q)
    (hQsqrt : (Q : ℝ) ≤ Real.sqrt (x : ℝ)) :
    (∑ q ∈ Finset.Ioc 0 Q,
      (q : ℝ) / (q.totient : ℝ) *
        ∑ chi : primitiveCharacters q,
          vaughanTwistedSumTwoEndpointMaximum V x q chi.1) <
      ((x : ℝ) + (Q : ℝ) ^ 2 * Real.sqrt (Q : ℝ) * V) *
        (Real.log ((x : ℝ) * V)) ^ 2 := by
  have hone : 1 ∈ Finset.Ioc 0 Q := Finset.mem_Ioc.mpr ⟨by omega, by omega⟩
  have honeValue :
      (1 : ℝ) / ((1 : ℕ).totient : ℝ) *
          ∑ chi : primitiveCharacters 1,
            vaughanTwistedSumTwoEndpointMaximum V x 1 chi.1 <
        (x : ℝ) * (Real.log ((x : ℝ) * V)) ^ 2 := by
    simp only [Nat.totient_one, Nat.cast_one, div_one, one_mul]
    rw [Fintype.sum_unique]
    exact vaughanTwistedSumTwoEndpointMaximum_level_one_lt_endpoint_mul_log_sq
      hx hV primitiveCharacterOne.1
  have hsplit : Finset.Ioc 0 Q \ {1} = Finset.Ioc 1 Q := by
    ext q
    simp only [Finset.mem_sdiff, Finset.mem_Ioc, Finset.mem_singleton]
    omega
  calc
    (∑ q ∈ Finset.Ioc 0 Q,
        (q : ℝ) / (q.totient : ℝ) *
          ∑ chi : primitiveCharacters q,
            vaughanTwistedSumTwoEndpointMaximum V x q chi.1) =
        (1 : ℝ) / ((1 : ℕ).totient : ℝ) *
            ∑ chi : primitiveCharacters 1,
              vaughanTwistedSumTwoEndpointMaximum V x 1 chi.1 +
          ∑ q ∈ Finset.Ioc 1 Q,
            (q : ℝ) / (q.totient : ℝ) *
              ∑ chi : primitiveCharacters q,
                vaughanTwistedSumTwoEndpointMaximum V x q chi.1 := by
      rw [← hsplit, Finset.sdiff_singleton_eq_erase]
      simpa only [Nat.cast_one] using
        (Finset.add_sum_erase (M := ℝ) (Finset.Ioc 0 Q)
        (fun q : ℕ ↦
          (q : ℝ) / (q.totient : ℝ) *
            ∑ chi : primitiveCharacters q,
              vaughanTwistedSumTwoEndpointMaximum V x q chi.1) hone).symm
    _ < (x : ℝ) * (Real.log ((x : ℝ) * V)) ^ 2 +
        (Q : ℝ) ^ 2 * Real.sqrt (Q : ℝ) * V *
          (Real.log ((x : ℝ) * V)) ^ 2 :=
      add_lt_add_of_lt_of_le honeValue
        (sum_weightedPrimitiveVaughanTwistedSumTwoEndpointMaximum_rest_le
          hx hV hQsqrt)
    _ = ((x : ℝ) + (Q : ℝ) ^ 2 * Real.sqrt (Q : ℝ) * V) *
        (Real.log ((x : ℝ) * V)) ^ 2 := by ring

end

section
open scoped ContDiff

attribute [local instance] PrimeGap186.primitiveCharactersOneUnique
/--
The maximum norm of the small third Vaughan contribution over integer endpoints `1 ≤ y ≤ x`,
with value zero at `x = 0`.
-/
noncomputable def vaughanTwistedSumThreeSmallEndpointMaximum
    (U V : ℝ) (x q : ℕ) (χ : DirichletCharacter ℂ q) : ℝ :=
  if hx : 1 ≤ x then
    (Finset.Icc 1 x).sup'
      ⟨1, Finset.mem_Icc.mpr ⟨le_rfl, hx⟩⟩
      (fun y ↦ ‖vaughanTwistedSumThreeSmall U V y q χ‖)
  else 0

theorem vaughanTwistedSumThreeSmallEndpointMaximum_level_one_lt_endpoint_mul_log_sq
    {U V : ℝ} {x : ℕ} (hx : 4 ≤ x) (hU : 1 ≤ U)
    (χ : DirichletCharacter ℂ 1) :
    vaughanTwistedSumThreeSmallEndpointMaximum U V x 1 χ <
      (x : ℝ) * (Real.log ((x : ℝ) * U)) ^ 2 := by
  unfold vaughanTwistedSumThreeSmallEndpointMaximum
  rw [dite_eq_left (by omega)]
  apply (Finset.sup'_lt_iff _).mpr
  intro y hy
  exact norm_vaughanTwistedSumThreeSmall_level_one_lt_endpoint_mul_log_sq
    hx hU (Finset.mem_Icc.mp hy).2 χ

theorem vaughanTwistedSumThreeSmallEndpointMaximum_lt_sqrt_mul_cutoff_mul_log_sq
    {Q U V : ℝ} {x q : ℕ}
    (hx : 4 ≤ x) (hU : 1 ≤ U)
    (hq : 1 < q) (hqQ : (q : ℝ) ≤ Q)
    (hQsqrt : Q ≤ Real.sqrt (x : ℝ))
    (χ : DirichletCharacter ℂ q) (hχ : χ.IsPrimitive) :
    vaughanTwistedSumThreeSmallEndpointMaximum U V x q χ <
      Real.sqrt (q : ℝ) * U *
        (Real.log ((x : ℝ) * U)) ^ 2 := by
  unfold vaughanTwistedSumThreeSmallEndpointMaximum
  rw [dite_eq_left (by omega)]
  apply (Finset.sup'_lt_iff _).mpr
  intro y _hy
  exact norm_vaughanTwistedSumThreeSmall_lt_sqrt_mul_cutoff_mul_log_sq
    hx hU hq hqQ hQsqrt χ hχ

theorem weightedPrimitiveVaughanTwistedSumThreeSmallEndpointMaximum_le
    {U V : ℝ} {x Q q : ℕ}
    (hx : 4 ≤ x) (hU : 1 ≤ U)
    (hq : 1 < q) (hqQ : q ≤ Q)
    (hQsqrt : (Q : ℝ) ≤ Real.sqrt (x : ℝ)) :
    (q : ℝ) / (q.totient : ℝ) *
        ∑ χ : primitiveCharacters q,
          vaughanTwistedSumThreeSmallEndpointMaximum U V x q χ.1 ≤
      (q : ℝ) * Real.sqrt (q : ℝ) * U *
        (Real.log ((x : ℝ) * U)) ^ 2 := by
  have hqpos : 0 < q := Nat.zero_lt_of_lt hq
  have hphi : 0 < (q.totient : ℝ) := by
    exact_mod_cast Nat.totient_pos.mpr hqpos
  have hboundNonneg :
      0 ≤ Real.sqrt (q : ℝ) * U *
        (Real.log ((x : ℝ) * U)) ^ 2 := by
    positivity
  have hmass :
      (∑ χ : primitiveCharacters q,
          vaughanTwistedSumThreeSmallEndpointMaximum U V x q χ.1) ≤
        (q.totient : ℝ) *
          (Real.sqrt (q : ℝ) * U *
            (Real.log ((x : ℝ) * U)) ^ 2) := by
    calc
      (∑ χ : primitiveCharacters q,
          vaughanTwistedSumThreeSmallEndpointMaximum U V x q χ.1) ≤
          ∑ _χ : primitiveCharacters q,
            Real.sqrt (q : ℝ) * U *
              (Real.log ((x : ℝ) * U)) ^ 2 := by
        apply Finset.sum_le_sum
        intro χ _hχ
        exact
          (vaughanTwistedSumThreeSmallEndpointMaximum_lt_sqrt_mul_cutoff_mul_log_sq
            hx hU hq (by exact_mod_cast hqQ) hQsqrt χ.1 χ.2).le
      _ = (Fintype.card (primitiveCharacters q) : ℝ) *
          (Real.sqrt (q : ℝ) * U *
            (Real.log ((x : ℝ) * U)) ^ 2) := by
        simp
      _ ≤ (q.totient : ℝ) *
          (Real.sqrt (q : ℝ) * U *
            (Real.log ((x : ℝ) * U)) ^ 2) := by
        gcongr
        exact_mod_cast card_primitiveCharacters_le_totient hqpos
  calc
    (q : ℝ) / (q.totient : ℝ) *
        ∑ χ : primitiveCharacters q,
          vaughanTwistedSumThreeSmallEndpointMaximum U V x q χ.1 ≤
      (q : ℝ) / (q.totient : ℝ) *
        ((q.totient : ℝ) *
          (Real.sqrt (q : ℝ) * U *
            (Real.log ((x : ℝ) * U)) ^ 2)) := by
      gcongr
    _ = (q : ℝ) * Real.sqrt (q : ℝ) * U *
        (Real.log ((x : ℝ) * U)) ^ 2 := by
      field_simp

theorem sum_weightedPrimitiveVaughanTwistedSumThreeSmallEndpointMaximum_rest_le
    {U V : ℝ} {x Q : ℕ}
    (hx : 4 ≤ x) (hU : 1 ≤ U)
    (hQsqrt : (Q : ℝ) ≤ Real.sqrt (x : ℝ)) :
    (∑ q ∈ Finset.Ioc 1 Q,
      (q : ℝ) / (q.totient : ℝ) *
        ∑ χ : primitiveCharacters q,
          vaughanTwistedSumThreeSmallEndpointMaximum U V x q χ.1) ≤
      (Q : ℝ) ^ 2 * Real.sqrt (Q : ℝ) * U *
        (Real.log ((x : ℝ) * U)) ^ 2 := by
  have hUsqrtNonneg :
      0 ≤ Real.sqrt (Q : ℝ) * U *
        (Real.log ((x : ℝ) * U)) ^ 2 := by
    positivity
  calc
    (∑ q ∈ Finset.Ioc 1 Q,
        (q : ℝ) / (q.totient : ℝ) *
          ∑ χ : primitiveCharacters q,
            vaughanTwistedSumThreeSmallEndpointMaximum U V x q χ.1) ≤
        ∑ q ∈ Finset.Ioc 1 Q,
          (q : ℝ) * Real.sqrt (q : ℝ) * U *
            (Real.log ((x : ℝ) * U)) ^ 2 := by
      apply Finset.sum_le_sum
      intro q hq
      exact weightedPrimitiveVaughanTwistedSumThreeSmallEndpointMaximum_le
        hx hU (Finset.mem_Ioc.mp hq).1 (Finset.mem_Ioc.mp hq).2 hQsqrt
    _ ≤ ∑ _q ∈ Finset.Ioc 1 Q,
        (Q : ℝ) * Real.sqrt (Q : ℝ) * U *
          (Real.log ((x : ℝ) * U)) ^ 2 := by
      apply Finset.sum_le_sum
      intro q hq
      have hqQ : (q : ℝ) ≤ Q := by
        exact_mod_cast (Finset.mem_Ioc.mp hq).2
      have hsqrt : Real.sqrt (q : ℝ) ≤ Real.sqrt (Q : ℝ) :=
        Real.sqrt_le_sqrt hqQ
      gcongr
    _ ≤ (Q : ℝ) ^ 2 * Real.sqrt (Q : ℝ) * U *
        (Real.log ((x : ℝ) * U)) ^ 2 := by
      rw [Finset.sum_const, nsmul_eq_mul]
      calc
        (Finset.Ioc 1 Q).card *
            ((Q : ℝ) * Real.sqrt (Q : ℝ) * U *
              (Real.log ((x : ℝ) * U)) ^ 2) ≤
            (Q : ℝ) *
              ((Q : ℝ) * Real.sqrt (Q : ℝ) * U *
                (Real.log ((x : ℝ) * U)) ^ 2) := by
          gcongr
          exact_mod_cast (show (Finset.Ioc 1 Q).card ≤ Q by
            simp [Nat.card_Ioc])
        _ = (Q : ℝ) ^ 2 * Real.sqrt (Q : ℝ) * U *
            (Real.log ((x : ℝ) * U)) ^ 2 := by ring

theorem sum_weightedPrimitiveVaughanTwistedSumThreeSmallEndpointMaximum_lt
    {U V : ℝ} {x Q : ℕ}
    (hx : 4 ≤ x) (hU : 1 ≤ U) (hQ : 2 ≤ Q)
    (hQsqrt : (Q : ℝ) ≤ Real.sqrt (x : ℝ)) :
    (∑ q ∈ Finset.Ioc 0 Q,
      (q : ℝ) / (q.totient : ℝ) *
        ∑ χ : primitiveCharacters q,
          vaughanTwistedSumThreeSmallEndpointMaximum U V x q χ.1) <
      ((x : ℝ) + (Q : ℝ) ^ 2 * Real.sqrt (Q : ℝ) * U) *
        (Real.log ((x : ℝ) * U)) ^ 2 := by
  have hone : 1 ∈ Finset.Ioc 0 Q :=
    Finset.mem_Ioc.mpr ⟨by omega, by omega⟩
  have honeValue :
      (1 : ℝ) / ((1 : ℕ).totient : ℝ) *
          ∑ χ : primitiveCharacters 1,
            vaughanTwistedSumThreeSmallEndpointMaximum U V x 1 χ.1 <
        (x : ℝ) * (Real.log ((x : ℝ) * U)) ^ 2 := by
    simp only [Nat.totient_one, Nat.cast_one, div_one, one_mul]
    rw [Fintype.sum_unique]
    exact
      vaughanTwistedSumThreeSmallEndpointMaximum_level_one_lt_endpoint_mul_log_sq
        hx hU primitiveCharacterOne.1
  have hsplit : Finset.Ioc 0 Q \ {1} = Finset.Ioc 1 Q := by
    ext q
    simp only [Finset.mem_sdiff, Finset.mem_Ioc, Finset.mem_singleton]
    omega
  calc
    (∑ q ∈ Finset.Ioc 0 Q,
        (q : ℝ) / (q.totient : ℝ) *
          ∑ χ : primitiveCharacters q,
            vaughanTwistedSumThreeSmallEndpointMaximum U V x q χ.1) =
        (1 : ℝ) / ((1 : ℕ).totient : ℝ) *
            ∑ χ : primitiveCharacters 1,
              vaughanTwistedSumThreeSmallEndpointMaximum U V x 1 χ.1 +
          ∑ q ∈ Finset.Ioc 1 Q,
            (q : ℝ) / (q.totient : ℝ) *
              ∑ χ : primitiveCharacters q,
                vaughanTwistedSumThreeSmallEndpointMaximum U V x q χ.1 := by
      rw [← hsplit, Finset.sdiff_singleton_eq_erase]
      simpa only [Nat.cast_one] using
        (Finset.add_sum_erase (M := ℝ) (Finset.Ioc 0 Q)
        (fun q : ℕ ↦
          (q : ℝ) / (q.totient : ℝ) *
            ∑ χ : primitiveCharacters q,
              vaughanTwistedSumThreeSmallEndpointMaximum U V x q χ.1) hone).symm
    _ < (x : ℝ) * (Real.log ((x : ℝ) * U)) ^ 2 +
        (Q : ℝ) ^ 2 * Real.sqrt (Q : ℝ) * U *
          (Real.log ((x : ℝ) * U)) ^ 2 :=
      add_lt_add_of_lt_of_le honeValue
        (sum_weightedPrimitiveVaughanTwistedSumThreeSmallEndpointMaximum_rest_le
          hx hU hQsqrt)
    _ = ((x : ℝ) + (Q : ℝ) ^ 2 * Real.sqrt (Q : ℝ) * U) *
        (Real.log ((x : ℝ) * U)) ^ 2 := by ring

end

section
open scoped ContDiff

open Set
open scoped Interval

theorem abs_integral_mul_sinc_sub_sign_pi_div_two_le_inv
    {T Y : ℝ} (hT : 0 < T) (hY : Y ≠ 0) :
    |(∫ t in (0 : ℝ)..T, Y * Real.sinc (Y * t)) -
      Real.sign Y * (Real.pi / 2)| ≤ (T * |Y|) ^ (-1 : ℤ) := by
  have hTY : T * Y ≠ 0 := mul_ne_zero hT.ne' hY
  have h := abs_integral_sinc_sub_sign_pi_div_two_le_inv_abs hTY
  have hsign : Real.sign (T * Y) = Real.sign Y := by
    rcases lt_or_gt_of_ne hY with hYneg | hYpos
    · rw [Real.sign_of_neg (mul_neg_of_pos_of_neg hT hYneg), Real.sign_of_neg hYneg]
    · rw [Real.sign_of_pos (mul_pos hT hYpos), Real.sign_of_pos hYpos]
  have hsub : (∫ t in (0 : ℝ)..T, Y * Real.sinc (Y * t)) =
      ∫ u in (0 : ℝ)..(T * Y), Real.sinc u := by
    rw [intervalIntegral.integral_const_mul]
    have hchange := intervalIntegral.mul_integral_comp_mul_left (f := Real.sinc) Y
      (a := (0 : ℝ)) (b := T)
    simp only [mul_zero, mul_comm] at hchange
    exact hchange
  rw [← hsub] at h
  simpa [hsign, abs_mul, abs_of_pos hT, mul_assoc,
    mul_comm, mul_left_comm] using h

/--
The symmetric Perron kernel `exp (-i * t * alpha) * beta * sinc (beta * t)`, using the
continuously extended real sinc function at zero.
-/
noncomputable def symmetricPerronIntegrand (alpha beta t : ℝ) : ℂ :=
  Complex.exp (-Complex.I * ((t * alpha : ℝ) : ℂ)) *
    ((beta * Real.sinc (beta * t) : ℝ) : ℂ)

/--
The real paired sinc expression at frequencies `beta + alpha` and `beta - alpha`, arising by
combining the symmetric Perron integrand at `t` and `-t`.
-/
noncomputable def pairedSincIntegrand (alpha beta t : ℝ) : ℝ :=
  (beta + alpha) * Real.sinc ((beta + alpha) * t) +
    (beta - alpha) * Real.sinc ((beta - alpha) * t)

theorem neg_I_mul_ofReal (x : ℝ) :
    -Complex.I * (x : ℂ) = ((-x : ℝ) : ℂ) * Complex.I := by
  push_cast
  ring_nf

theorem mul_sinc_mul_eq (x t : ℝ) :
    x * Real.sinc (x * t) =
      if t = 0 then x else Real.sin (x * t) / t := by
  by_cases ht : t = 0
  · simp [ht]
  by_cases hx : x = 0
  · simp [hx, ht]
  rw [ite_eq_right ht, Real.sinc_of_ne_zero (mul_ne_zero hx ht)]
  field_simp

theorem symmetricPerronIntegrand_add_neg (alpha beta t : ℝ) :
    symmetricPerronIntegrand alpha beta t +
        symmetricPerronIntegrand alpha beta (-t) =
      (pairedSincIntegrand alpha beta t : ℂ) := by
  rw [symmetricPerronIntegrand, symmetricPerronIntegrand,
    pairedSincIntegrand]
  rw [neg_I_mul_ofReal, neg_I_mul_ofReal]
  simp only [neg_mul, mul_neg, neg_neg, Complex.exp_ofReal_mul_I, Real.cos_neg,
    Real.sin_neg, Real.sinc_neg]
  simp_rw [mul_sinc_mul_eq]
  by_cases ht : t = 0
  · simp [ht]
  simp only [ite_eq_right ht]
  apply Complex.ext
  · simp only [Complex.add_re, Complex.mul_re, Complex.ofReal_re,
      Complex.ofReal_im, Complex.I_re, Complex.I_im, mul_zero, sub_zero,
      mul_one, add_zero]
    field_simp [ht]
    calc
      Real.cos (t * alpha) * Real.sin (t * beta) * (1 + 1) =
          2 * Real.sin (t * beta) * Real.cos (t * alpha) := by ring_nf
      _ = Real.sin (t * beta - t * alpha) +
          Real.sin (t * beta + t * alpha) :=
        Real.two_mul_sin_mul_cos _ _
      _ = Real.sin (t * (beta + alpha)) +
          Real.sin (t * (beta - alpha)) := by
        rw [add_comm]
        congr 1 <;> ring_nf
  · simp only [Complex.add_im, Complex.mul_im, Complex.ofReal_re,
      Complex.ofReal_im, Complex.I_re, Complex.I_im, mul_zero, mul_one,
      add_zero]
    ring_nf

theorem continuous_symmetricPerronIntegrand (alpha beta : ℝ) :
    Continuous (symmetricPerronIntegrand alpha beta) := by
  unfold symmetricPerronIntegrand
  fun_prop

theorem integral_pairedSincIntegrand_eq (alpha beta T : ℝ) :
    (∫ t in (0 : ℝ)..T, pairedSincIntegrand alpha beta t) =
      (∫ t in (0 : ℝ)..T,
        (beta + alpha) * Real.sinc ((beta + alpha) * t)) +
      ∫ t in (0 : ℝ)..T,
        (beta - alpha) * Real.sinc ((beta - alpha) * t) := by
  unfold pairedSincIntegrand
  rw [intervalIntegral.integral_add]
  · exact (by fun_prop : Continuous fun t : ℝ ↦
      (beta + alpha) * Real.sinc ((beta + alpha) * t)).intervalIntegrable _ _
  · exact (by fun_prop : Continuous fun t : ℝ ↦
      (beta - alpha) * Real.sinc ((beta - alpha) * t)).intervalIntegrable _ _

theorem integral_symmetricPerronIntegrand_eq_sinc (alpha beta T : ℝ) :
    (∫ t in -T..T, symmetricPerronIntegrand alpha beta t) =
      Complex.ofReal
        ((∫ t in 0..T,
            (beta + alpha) * Real.sinc ((beta + alpha) * t)) +
          ∫ t in 0..T,
            (beta - alpha) * Real.sinc ((beta - alpha) * t)) := by
  have hcontinuous := continuous_symmetricPerronIntegrand alpha beta
  have hneg : IntervalIntegrable (symmetricPerronIntegrand alpha beta)
      volume (-T) 0 := hcontinuous.intervalIntegrable _ _
  have hpos : IntervalIntegrable (symmetricPerronIntegrand alpha beta)
      volume 0 T := hcontinuous.intervalIntegrable _ _
  have hcomp : IntervalIntegrable
      (fun t : ℝ ↦ symmetricPerronIntegrand alpha beta (-t)) volume 0 T :=
    (by fun_prop : Continuous fun t : ℝ ↦
      symmetricPerronIntegrand alpha beta (-t)).intervalIntegrable _ _
  calc
    (∫ t in -T..T, symmetricPerronIntegrand alpha beta t) =
        (∫ t in -T..(0 : ℝ), symmetricPerronIntegrand alpha beta t) +
          ∫ t in (0 : ℝ)..T, symmetricPerronIntegrand alpha beta t :=
      (intervalIntegral.integral_add_adjacent_intervals hneg hpos).symm
    _ = (∫ t in (0 : ℝ)..T, symmetricPerronIntegrand alpha beta (-t)) +
          ∫ t in (0 : ℝ)..T, symmetricPerronIntegrand alpha beta t := by
      rw [intervalIntegral.integral_comp_neg]
      simp
    _ = ∫ t in (0 : ℝ)..T,
          (symmetricPerronIntegrand alpha beta (-t) +
            symmetricPerronIntegrand alpha beta t) := by
      rw [intervalIntegral.integral_add hcomp hpos]
    _ = ∫ t in (0 : ℝ)..T,
          (symmetricPerronIntegrand alpha beta t +
            symmetricPerronIntegrand alpha beta (-t)) := by
      apply intervalIntegral.integral_congr
      intro t _
      exact add_comm _ _
    _ = ∫ t in (0 : ℝ)..T, (pairedSincIntegrand alpha beta t : ℂ) := by
      apply intervalIntegral.integral_congr
      intro t _
      exact symmetricPerronIntegrand_add_neg alpha beta t
    _ = (∫ t in (0 : ℝ)..T, pairedSincIntegrand alpha beta t : ℝ) :=
      intervalIntegral.integral_ofReal
    _ = Complex.ofReal
        ((∫ t in 0..T,
            (beta + alpha) * Real.sinc ((beta + alpha) * t)) +
          ∫ t in 0..T,
            (beta - alpha) * Real.sinc ((beta - alpha) * t)) :=
      congrArg Complex.ofReal
        (integral_pairedSincIntegrand_eq alpha beta T)

theorem inverse_sum_frequency_le_inverse_difference
    {alpha beta T : ℝ} (halpha : 0 ≤ alpha) (hbeta : 0 < beta)
    (hT : 0 < T) (hne : alpha ≠ beta) :
    (T * |beta + alpha|) ^ (-1 : ℤ) ≤
      (T * |alpha - beta|) ^ (-1 : ℤ) := by
  have hsum : 0 < |beta + alpha| :=
    abs_pos.mpr (ne_of_gt (add_pos_of_pos_of_nonneg hbeta halpha))
  have hdiff : 0 < |alpha - beta| :=
    abs_pos.mpr (sub_ne_zero.mpr hne)
  have habs : |alpha - beta| ≤ |beta + alpha| := by
    calc
      |alpha - beta| ≤ |alpha| + |beta| := abs_sub alpha beta
      _ = alpha + beta := by
        rw [abs_of_nonneg halpha, abs_of_pos hbeta]
      _ = |beta + alpha| := by
        rw [abs_of_pos (add_pos_of_pos_of_nonneg hbeta halpha)]
        ring_nf
  rw [zpow_neg_one, zpow_neg_one]
  exact (inv_le_inv₀ (mul_pos hT hsum) (mul_pos hT hdiff)).2
    (mul_le_mul_of_nonneg_left habs hT.le)

theorem abs_integral_pairedSincIntegrand_sub_step_le
    {alpha beta T : ℝ} (halpha : 0 ≤ alpha) (hbeta : 0 < beta)
    (hT : 0 < T) (hne : alpha ≠ beta) :
    |(∫ t in (0 : ℝ)..T, pairedSincIntegrand alpha beta t) -
        (if alpha < beta then Real.pi else 0)| ≤
      2 * (T * |alpha - beta|) ^ (-1 : ℤ) := by
  have hsum_ne : beta + alpha ≠ 0 :=
    ne_of_gt (add_pos_of_pos_of_nonneg hbeta halpha)
  have hsum := abs_integral_mul_sinc_sub_sign_pi_div_two_le_inv hT hsum_ne
  have hcompare :=
    inverse_sum_frequency_le_inverse_difference halpha hbeta hT hne
  have hsame :
      (T * |beta - alpha|) ^ (-1 : ℤ) =
        (T * |alpha - beta|) ^ (-1 : ℤ) := by
    rw [abs_sub_comm]
  rcases lt_or_gt_of_ne hne with hlt | hgt
  · have hdiff_ne : beta - alpha ≠ 0 := sub_ne_zero.mpr hlt.ne'
    have hdiff :=
      abs_integral_mul_sinc_sub_sign_pi_div_two_le_inv hT hdiff_ne
    rw [Real.sign_of_pos (add_pos_of_pos_of_nonneg hbeta halpha)] at hsum
    rw [Real.sign_of_pos (sub_pos.mpr hlt)] at hdiff
    rw [ite_eq_left hlt, integral_pairedSincIntegrand_eq]
    calc
      |((∫ t in (0 : ℝ)..T,
            (beta + alpha) * Real.sinc ((beta + alpha) * t)) +
          ∫ t in (0 : ℝ)..T,
            (beta - alpha) * Real.sinc ((beta - alpha) * t)) - Real.pi| =
          |((∫ t in (0 : ℝ)..T,
              (beta + alpha) * Real.sinc ((beta + alpha) * t)) - Real.pi / 2) +
            ((∫ t in (0 : ℝ)..T,
              (beta - alpha) * Real.sinc ((beta - alpha) * t)) - Real.pi / 2)| := by
        ring_nf
      _ ≤ |(∫ t in (0 : ℝ)..T,
              (beta + alpha) * Real.sinc ((beta + alpha) * t)) - Real.pi / 2| +
            |(∫ t in (0 : ℝ)..T,
              (beta - alpha) * Real.sinc ((beta - alpha) * t)) - Real.pi / 2| :=
        abs_add_le _ _
      _ ≤ (T * |beta + alpha|) ^ (-1 : ℤ) +
            (T * |beta - alpha|) ^ (-1 : ℤ) :=
        add_le_add (by simpa only [one_mul] using hsum)
          (by simpa only [one_mul] using hdiff)
      _ ≤ (T * |alpha - beta|) ^ (-1 : ℤ) +
            (T * |alpha - beta|) ^ (-1 : ℤ) :=
        add_le_add hcompare hsame.le
      _ = 2 * (T * |alpha - beta|) ^ (-1 : ℤ) := by
        ring_nf
  · have hdiff_ne : beta - alpha ≠ 0 := sub_ne_zero.mpr hgt.ne
    have hdiff :=
      abs_integral_mul_sinc_sub_sign_pi_div_two_le_inv hT hdiff_ne
    rw [Real.sign_of_pos (add_pos_of_pos_of_nonneg hbeta halpha)] at hsum
    rw [Real.sign_of_neg (sub_neg.mpr hgt)] at hdiff
    rw [ite_eq_right (not_lt_of_ge hgt.le), integral_pairedSincIntegrand_eq,
      sub_zero]
    calc
      |(∫ t in (0 : ℝ)..T,
            (beta + alpha) * Real.sinc ((beta + alpha) * t)) +
          ∫ t in (0 : ℝ)..T,
            (beta - alpha) * Real.sinc ((beta - alpha) * t)| =
          |((∫ t in (0 : ℝ)..T,
              (beta + alpha) * Real.sinc ((beta + alpha) * t)) - Real.pi / 2) +
            ((∫ t in (0 : ℝ)..T,
              (beta - alpha) * Real.sinc ((beta - alpha) * t)) + Real.pi / 2)| := by
        ring_nf
      _ ≤ |(∫ t in (0 : ℝ)..T,
              (beta + alpha) * Real.sinc ((beta + alpha) * t)) - Real.pi / 2| +
            |(∫ t in (0 : ℝ)..T,
              (beta - alpha) * Real.sinc ((beta - alpha) * t)) + Real.pi / 2| :=
        abs_add_le _ _
      _ ≤ (T * |beta + alpha|) ^ (-1 : ℤ) +
            (T * |beta - alpha|) ^ (-1 : ℤ) :=
        add_le_add (by simpa only [one_mul] using hsum)
          (by simpa only [neg_mul, one_mul, sub_neg_eq_add] using hdiff)
      _ ≤ (T * |alpha - beta|) ^ (-1 : ℤ) +
            (T * |alpha - beta|) ^ (-1 : ℤ) :=
        add_le_add hcompare hsame.le
      _ = 2 * (T * |alpha - beta|) ^ (-1 : ℤ) := by
        ring_nf

theorem norm_integral_symmetricPerronIntegrand_sub_step_le
    {alpha beta T : ℝ} (halpha : 0 ≤ alpha) (hbeta : 0 < beta)
    (hT : 0 < T) (hne : alpha ≠ beta) :
    ‖(∫ t in -T..T, symmetricPerronIntegrand alpha beta t) -
      (if alpha < beta then (Real.pi : ℂ) else 0)‖ ≤
      2 / (T * |alpha - beta|) := by
  rw [integral_symmetricPerronIntegrand_eq_sinc]
  rw [← integral_pairedSincIntegrand_eq]
  have hstep : (if alpha < beta then (Real.pi : ℂ) else 0) =
      ((if alpha < beta then Real.pi else 0 : ℝ) : ℂ) := by
    by_cases h : alpha < beta <;> simp [h]
  rw [hstep, ← Complex.ofReal_sub, Complex.norm_real, Real.norm_eq_abs]
  simpa [
    div_eq_mul_inv, zpow_neg_one] using
    abs_integral_pairedSincIntegrand_sub_step_le halpha hbeta hT hne

end

section
open scoped ContDiff

open scoped Interval

theorem log_four_div_three_div_le_abs_log_natCast_div_natCast_add_half
    {r k : ℕ} {L : ℝ} (hr : 0 < r) (hk : 0 < k) (hL : 0 < L)
    (hrL : (r : ℝ) ≤ L) (hkL : (k : ℝ) ≤ L) :
    Real.log (4 / 3 : ℝ) / L ≤
      |Real.log ((r : ℝ) / ((k : ℝ) + 1 / 2))| := by
  let y : ℝ := (k : ℝ) + 1 / 2
  have hrR : 0 < (r : ℝ) := by positivity
  have hy : 0 < y := by
    dsimp [y]
    positivity
  have hrone : (1 : ℝ) ≤ (r : ℝ) := by exact_mod_cast hr
  have hLone : (1 : ℝ) ≤ L := hrone.trans hrL
  have hlog_le : Real.log (4 / 3 : ℝ) ≤ 1 / 3 := by
    have h := Real.log_le_sub_one_of_pos (show (0 : ℝ) < 4 / 3 by norm_num)
    norm_num at h ⊢
    exact h
  have hbase : Real.log (4 / 3 : ℝ) / L ≤ 1 / (2 * L + 1) := by
    calc
      Real.log (4 / 3 : ℝ) / L ≤ (1 / 3 : ℝ) / L :=
        div_le_div_of_nonneg_right hlog_le hL.le
      _ = 1 / (3 * L) := by
        field_simp [hL.ne']
      _ ≤ 1 / (2 * L + 1) :=
        one_div_le_one_div_of_le (by positivity) (by nlinarith)
  apply hbase.trans
  by_cases hrk : r ≤ k
  · have hrkR : (r : ℝ) ≤ (k : ℝ) := by exact_mod_cast hrk
    have hry : (r : ℝ) < y := by
      dsimp [y]
      nlinarith
    have hloglt : Real.log (r : ℝ) < Real.log y :=
      Real.log_lt_log hrR hry
    have hratio : 0 < y / (r : ℝ) := div_pos hy hrR
    have hloglower := Real.one_sub_inv_le_log_of_pos hratio
    rw [Real.log_div hy.ne' hrR.ne'] at hloglower
    have hgap : (1 / 2 : ℝ) ≤ y - (r : ℝ) := by
      dsimp [y]
      nlinarith
    have hyL : y ≤ L + 1 / 2 := by
      dsimp [y]
      nlinarith
    have hone : 1 / (2 * L + 1) ≤ (1 / 2 : ℝ) / y := by
      rw [div_le_div_iff₀ (by positivity) hy]
      nlinarith
    have hinv : 1 - (y / (r : ℝ))⁻¹ = (y - (r : ℝ)) / y := by
      field_simp [hy.ne', hrR.ne']
    rw [hinv] at hloglower
    have hhalf : (1 / 2 : ℝ) / y ≤ (y - (r : ℝ)) / y :=
      div_le_div_of_nonneg_right hgap hy.le
    rw [Real.log_div hrR.ne' hy.ne', abs_of_neg (sub_neg.mpr hloglt)]
    simpa only [neg_sub] using hone.trans (hhalf.trans hloglower)
  · have hkr : k < r := lt_of_not_ge hrk
    have hk1r : k + 1 ≤ r := Nat.succ_le_iff.mpr hkr
    have hk1rR : ((k + 1 : ℕ) : ℝ) ≤ (r : ℝ) := by exact_mod_cast hk1r
    have hyr : y < (r : ℝ) := by
      dsimp [y]
      norm_num at hk1rR ⊢
      nlinarith
    have hloglt : Real.log y < Real.log (r : ℝ) :=
      Real.log_lt_log hy hyr
    have hratio : 0 < (r : ℝ) / y := div_pos hrR hy
    have hloglower := Real.one_sub_inv_le_log_of_pos hratio
    rw [Real.log_div hrR.ne' hy.ne'] at hloglower
    have hgap : (1 / 2 : ℝ) ≤ (r : ℝ) - y := by
      dsimp [y]
      norm_num at hk1rR ⊢
      nlinarith
    have hone : 1 / (2 * L + 1) ≤ (1 / 2 : ℝ) / (r : ℝ) := by
      rw [div_le_div_iff₀ (by positivity) hrR]
      nlinarith
    have hinv : 1 - ((r : ℝ) / y)⁻¹ = ((r : ℝ) - y) / (r : ℝ) := by
      field_simp [hy.ne', hrR.ne']
    rw [hinv] at hloglower
    have hhalf : (1 / 2 : ℝ) / (r : ℝ) ≤
        ((r : ℝ) - y) / (r : ℝ) :=
      div_le_div_of_nonneg_right hgap hrR.le
    rw [Real.log_div hrR.ne' hy.ne', abs_of_pos (sub_pos.mpr hloglt)]
    exact hone.trans (hhalf.trans hloglower)

theorem log_natCast_add_half_le_log_two_mul
    {k : ℕ} {L : ℝ} (hk : 0 < k) (hL : 0 < L)
    (hkL : (k : ℝ) ≤ L) :
    Real.log ((k : ℝ) + 1 / 2) ≤ Real.log (2 * L) := by
  have hkone : (1 : ℝ) ≤ (k : ℝ) := by exact_mod_cast hk
  have hLone : (1 : ℝ) ≤ L := hkone.trans hkL
  apply Real.log_le_log (by positivity)
  nlinarith

theorem norm_integral_log_natCast_halfIntegerPerron_sub_step_le_exact
    {r k : ℕ} {T : ℝ} (hr : 0 < r) (hk : 0 < k) (hT : 0 < T) :
    ‖(∫ t in -T..T,
        symmetricPerronIntegrand (Real.log (r : ℝ))
          (Real.log ((k : ℝ) + 1 / 2)) t) -
      (if r ≤ k then (Real.pi : ℂ) else 0)‖ ≤
      2 / (T * |Real.log ((r : ℝ) / ((k : ℝ) + 1 / 2))|) := by
  let y : ℝ := (k : ℝ) + 1 / 2
  have hrR : 0 < (r : ℝ) := by positivity
  have hy : 0 < y := by
    dsimp [y]
    positivity
  have hkone : (1 : ℝ) ≤ (k : ℝ) := by exact_mod_cast hk
  have hyone : 1 < y := by
    dsimp [y]
    nlinarith
  have halpha : 0 ≤ Real.log (r : ℝ) := by
    apply Real.log_nonneg
    exact_mod_cast hr
  have hbeta : 0 < Real.log y := Real.log_pos hyone
  have hcutoff : (r : ℝ) < y ↔ r ≤ k := by
    constructor
    · intro hry
      by_contra hrk
      have hk1r : k + 1 ≤ r := Nat.succ_le_iff.mpr (lt_of_not_ge hrk)
      have hk1rR : ((k + 1 : ℕ) : ℝ) ≤ (r : ℝ) := by exact_mod_cast hk1r
      dsimp [y] at hry
      norm_num at hk1rR
      nlinarith
    · intro hrk
      have hrkR : (r : ℝ) ≤ (k : ℝ) := by exact_mod_cast hrk
      dsimp [y]
      nlinarith
  have hlogcutoff : Real.log (r : ℝ) < Real.log y ↔ r ≤ k :=
    (Real.log_lt_log_iff hrR hy).trans hcutoff
  have hry_ne : (r : ℝ) ≠ y := by
    by_cases hrk : r ≤ k
    · exact ne_of_lt (hcutoff.mpr hrk)
    · have hk1r : k + 1 ≤ r := Nat.succ_le_iff.mpr (lt_of_not_ge hrk)
      have hk1rR : ((k + 1 : ℕ) : ℝ) ≤ (r : ℝ) := by exact_mod_cast hk1r
      dsimp [y]
      norm_num at hk1rR ⊢
      nlinarith
  have hlog_ne : Real.log (r : ℝ) ≠ Real.log y := by
    intro h
    apply hry_ne
    exact Real.log_injOn_pos (Set.mem_Ioi.2 hrR) (Set.mem_Ioi.2 hy) h
  have hkernel := norm_integral_symmetricPerronIntegrand_sub_step_le
    halpha hbeta hT hlog_ne
  rw [← Real.log_div hrR.ne' hy.ne'] at hkernel
  dsimp [y] at hlogcutoff hkernel ⊢
  simpa only [hlogcutoff] using hkernel

theorem norm_integral_log_natCast_halfIntegerPerron_sub_step_le
    {r k : ℕ} {L T : ℝ}
    (hr : 0 < r) (hk : 0 < k) (hL : 0 < L)
    (hrL : (r : ℝ) ≤ L) (hkL : (k : ℝ) ≤ L) (hT : 0 < T) :
    ‖(∫ t in -T..T,
        symmetricPerronIntegrand (Real.log (r : ℝ))
          (Real.log ((k : ℝ) + 1 / 2)) t) -
      (if r ≤ k then (Real.pi : ℂ) else 0)‖ ≤
      2 * L / (T * Real.log (4 / 3 : ℝ)) := by
  have hexact :=
    norm_integral_log_natCast_halfIntegerPerron_sub_step_le_exact hr hk hT
  have hsep := log_four_div_three_div_le_abs_log_natCast_div_natCast_add_half
    hr hk hL hrL hkL
  have hlog : 0 < Real.log (4 / 3 : ℝ) := Real.log_pos (by norm_num)
  have hsmall : 0 < Real.log (4 / 3 : ℝ) / L := div_pos hlog hL
  calc
    ‖(∫ t in -T..T,
        symmetricPerronIntegrand (Real.log (r : ℝ))
          (Real.log ((k : ℝ) + 1 / 2)) t) -
      (if r ≤ k then (Real.pi : ℂ) else 0)‖ ≤
        2 / (T * |Real.log ((r : ℝ) / ((k : ℝ) + 1 / 2))|) := hexact
    _ ≤ 2 / (T * (Real.log (4 / 3 : ℝ) / L)) :=
      div_le_div_of_nonneg_left (by positivity) (mul_pos hT hsmall)
        (mul_le_mul_of_nonneg_left hsep hT.le)
    _ = 2 * L / (T * Real.log (4 / 3 : ℝ)) := by
      field_simp [hT.ne', hlog.ne', hL.ne']

end

section
open scoped ContDiff

/--
The reciprocal envelope `1 / max |t| (1 / B)`, explicitly set to zero when `B = 0`. For positive
`B`, it bounds a Perron kernel by a flat central region and reciprocal decay.
-/
noncomputable def perronEnvelope (B t : ℝ) : ℝ :=
  if B = 0 then 0 else (max |t| B⁻¹)⁻¹

theorem perronEnvelope_zero {B : ℝ} (hB : 0 ≤ B) :
    perronEnvelope B 0 = B := by
  by_cases hB0 : B = 0
  · simp [perronEnvelope, hB0]
  · have hBpos : 0 < B := lt_of_le_of_ne hB (Ne.symm hB0)
    rw [perronEnvelope, ite_eq_right hB0, abs_zero,
      max_eq_right (inv_nonneg.mpr hBpos.le), inv_inv]

theorem perronEnvelope_of_ne {B t : ℝ} (hB : 0 ≤ B) (ht : t ≠ 0) :
    perronEnvelope B t = min |t|⁻¹ B := by
  by_cases hB0 : B = 0
  · simp [perronEnvelope, hB0, inv_nonneg]
  have hBpos : 0 < B := lt_of_le_of_ne hB (Ne.symm hB0)
  rw [perronEnvelope, ite_eq_right hB0]
  rcases le_total |t| B⁻¹ with h | h
  · rw [max_eq_right h, inv_inv, min_eq_right]
    exact (le_inv_comm₀ hBpos (abs_pos.mpr ht)).2 h
  · rw [max_eq_left h, min_eq_left]
    exact (inv_le_comm₀ (abs_pos.mpr ht) hBpos).2 h

theorem continuous_perronEnvelope {B : ℝ} (hB : 0 ≤ B) :
    Continuous (perronEnvelope B) := by
  by_cases hB0 : B = 0
  · subst B
    unfold perronEnvelope
    simpa using (continuous_const : Continuous (fun _ : ℝ => (0 : ℝ)))
  have hBpos : 0 < B := lt_of_le_of_ne hB (Ne.symm hB0)
  change Continuous (fun t => if B = 0 then 0 else (max |t| B⁻¹)⁻¹)
  simp only [ite_eq_right hB0]
  apply Continuous.inv₀ (continuous_abs.max continuous_const)
  intro t
  exact ne_of_gt ((inv_pos.mpr hBpos).trans_le (le_max_right _ _))

theorem abs_mul_sinc_le_self (beta t : ℝ) (hbeta : 0 ≤ beta) :
    |beta * Real.sinc (beta * t)| ≤ beta := by
  rw [abs_mul, abs_of_nonneg hbeta]
  exact mul_le_of_le_one_right hbeta (Real.abs_sinc_le_one _)

theorem abs_mul_sinc_le_inv (beta t : ℝ) (ht : t ≠ 0) :
    |beta * Real.sinc (beta * t)| ≤ |t|⁻¹ := by
  by_cases hb : beta = 0
  · simp [hb, abs_nonneg]
  rw [Real.sinc_of_ne_zero (mul_ne_zero hb ht)]
  have hrewrite : beta * (Real.sin (beta * t) / (beta * t)) =
      Real.sin (beta * t) / t := by
    field_simp
  rw [hrewrite, abs_div, div_eq_mul_inv]
  exact mul_le_of_le_one_left (inv_nonneg.mpr (abs_nonneg t))
    (Real.abs_sin_le_one _)

theorem abs_mul_sinc_le_perronEnvelope
    {beta B : ℝ} (hbeta : 0 ≤ beta) (hbetaB : beta ≤ B) (t : ℝ) :
    |beta * Real.sinc (beta * t)| ≤ perronEnvelope B t := by
  have hB : 0 ≤ B := hbeta.trans hbetaB
  by_cases ht : t = 0
  · subst t
    rw [perronEnvelope_zero hB]
    simpa [abs_of_nonneg hbeta] using hbetaB
  rw [perronEnvelope_of_ne hB ht]
  exact le_min (abs_mul_sinc_le_inv beta t ht)
    ((abs_mul_sinc_le_self beta t hbeta).trans hbetaB)

end

section
open scoped ContDiff

open scoped Interval

theorem norm_integral_finset_halfIntegerPerron_sub_steps_le
    {ι : Type*} (s : Finset ι) (r : ι → ℕ) (c : ι → ℂ)
    {k : ℕ} {L T : ℝ}
    (hr : ∀ i ∈ s, 0 < r i) (hk : 0 < k) (hL : 0 < L)
    (hrL : ∀ i ∈ s, (r i : ℝ) ≤ L) (hkL : (k : ℝ) ≤ L)
    (hT : 0 < T) :
    ‖(∫ t in -T..T, ∑ i ∈ s,
        c i * symmetricPerronIntegrand (Real.log (r i : ℝ))
          (Real.log ((k : ℝ) + 1 / 2)) t) -
      ∑ i ∈ s, c i * (if r i ≤ k then (Real.pi : ℂ) else 0)‖ ≤
      (2 * L / (T * Real.log (4 / 3 : ℝ))) *
        ∑ i ∈ s, ‖c i‖ := by
  have hint (i : ι) (hi : i ∈ s) :
      IntervalIntegrable
        (fun t : ℝ => c i *
          symmetricPerronIntegrand (Real.log (r i : ℝ))
            (Real.log ((k : ℝ) + 1 / 2)) t) volume (-T) T := by
    apply Continuous.intervalIntegrable
    unfold symmetricPerronIntegrand
    fun_prop
  rw [intervalIntegral.integral_finsetSum hint]
  simp_rw [intervalIntegral.integral_const_mul]
  rw [← Finset.sum_sub_distrib]
  calc
    ‖∑ i ∈ s,
        (c i * (∫ t in -T..T,
          symmetricPerronIntegrand (Real.log (r i : ℝ))
            (Real.log ((k : ℝ) + 1 / 2)) t) -
          c i * (if r i ≤ k then (Real.pi : ℂ) else 0))‖ ≤
        ∑ i ∈ s,
          ‖c i‖ * (2 * L / (T * Real.log (4 / 3 : ℝ))) := by
      apply norm_sum_le_of_le
      intro i hi
      rw [← mul_sub, norm_mul]
      exact mul_le_mul_of_nonneg_left
        (norm_integral_log_natCast_halfIntegerPerron_sub_step_le
          (hr i hi) hk hL (hrL i hi) hkL hT)
        (norm_nonneg _)
    _ = (2 * L / (T * Real.log (4 / 3 : ℝ))) *
        ∑ i ∈ s, ‖c i‖ := by
      rw [← Finset.sum_mul]
      ring

/--
The logarithmic phase `exp (-i * t * log n)`, equal to the usual imaginary-power twist for
positive `n`. Lean's convention `log 0 = 0` makes its value at `n = 0` equal to `1`.
-/
noncomputable def natLogTwist (n : ℕ) (t : ℝ) : ℂ :=
  Complex.exp (-Complex.I * ((t * Real.log (n : ℝ) : ℝ) : ℂ))

theorem natLogTwist_mul {m n : ℕ} (hm : 0 < m) (hn : 0 < n) (t : ℝ) :
    natLogTwist (m * n) t = natLogTwist m t * natLogTwist n t := by
  unfold natLogTwist
  rw [Nat.cast_mul, Real.log_mul (by positivity) (by positivity), mul_add]
  rw [← Complex.exp_add]
  congr 1
  push_cast
  ring

@[simp] theorem norm_natLogTwist (n : ℕ) (t : ℝ) :
    ‖natLogTwist n t‖ = 1 := by
  unfold natLogTwist
  have hphase : -Complex.I * ((t * Real.log (n : ℝ) : ℝ) : ℂ) =
      ((-(t * Real.log (n : ℝ)) : ℝ) : ℂ) * Complex.I := by
    push_cast
    ring
  rw [hphase, Complex.norm_exp_ofReal_mul_I]

theorem norm_integral_bilinearPerron_sub_cutoff_le
    (q : ℕ) (χ : DirichletCharacter ℂ q)
    (sm sn : Finset ℕ) (a b : ℕ → ℂ)
    {k : ℕ} {L T : ℝ}
    (hk : 0 < k) (hL : 0 < L) (hkL : (k : ℝ) ≤ L) (hT : 0 < T)
    (hmPos : ∀ m ∈ sm, 0 < m)
    (hnPos : ∀ n ∈ sn, 0 < n)
    (hprod : ∀ m ∈ sm, ∀ n ∈ sn, ((m * n : ℕ) : ℝ) ≤ L) :
    ‖(∫ t in -T..T,
        ((Real.log ((k : ℝ) + 1 / 2) *
          Real.sinc (Real.log ((k : ℝ) + 1 / 2) * t) : ℝ) : ℂ) *
          (∑ m ∈ sm, ∑ n ∈ sn,
            (a m * natLogTwist m t) * (b n * natLogTwist n t) * χ (m * n))) -
      (Real.pi : ℂ) *
        (∑ m ∈ sm, ∑ n ∈ sn.filter (fun n => m * n ≤ k),
          a m * b n * χ (m * n))‖ ≤
      2 * L / (T * Real.log (4 / 3 : ℝ)) *
        (∑ m ∈ sm, ‖a m‖) * (∑ n ∈ sn, ‖b n‖) := by
  classical
  let s := sm ×ˢ sn
  let r : ℕ × ℕ → ℕ := fun x => x.1 * x.2
  let c : ℕ × ℕ → ℂ := fun x => a x.1 * b x.2 * χ (x.1 * x.2)
  have hr : ∀ x ∈ s, 0 < r x := by
    intro x hx
    rw [Finset.mem_product] at hx
    exact Nat.mul_pos (hmPos x.1 hx.1) (hnPos x.2 hx.2)
  have hrL : ∀ x ∈ s, (r x : ℝ) ≤ L := by
    intro x hx
    rw [Finset.mem_product] at hx
    exact hprod x.1 hx.1 x.2 hx.2
  have hagg := norm_integral_finset_halfIntegerPerron_sub_steps_le
    s r c hr hk hL hrL hkL hT
  have hintegrand (t : ℝ) :
      (∑ x ∈ s, c x *
        symmetricPerronIntegrand (Real.log (r x : ℝ))
          (Real.log ((k : ℝ) + 1 / 2)) t) =
        ((Real.log ((k : ℝ) + 1 / 2) *
          Real.sinc (Real.log ((k : ℝ) + 1 / 2) * t) : ℝ) : ℂ) *
          (∑ m ∈ sm, ∑ n ∈ sn,
            (a m * natLogTwist m t) * (b n * natLogTwist n t) * χ (m * n)) := by
    rw [Finset.sum_product]
    rw [Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro m hmm
    rw [Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro n hnn
    simp only [c, r, symmetricPerronIntegrand]
    change (a m * b n * χ (m * n)) *
        (natLogTwist (m * n) t *
          ((Real.log ((k : ℝ) + 1 / 2) *
            Real.sinc (Real.log ((k : ℝ) + 1 / 2) * t) : ℝ) : ℂ)) = _
    rw [natLogTwist_mul (hmPos m hmm) (hnPos n hnn)]
    ring
  have hcutoff :
      (∑ x ∈ s, c x * (if r x ≤ k then (Real.pi : ℂ) else 0)) =
        (Real.pi : ℂ) *
          (∑ m ∈ sm, ∑ n ∈ sn.filter (fun n => m * n ≤ k),
            a m * b n * χ (m * n)) := by
    rw [Finset.sum_product, Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro m _hmm
    rw [Finset.mul_sum, Finset.sum_filter]
    apply Finset.sum_congr rfl
    intro n _hnn
    by_cases hmn : m * n ≤ k <;> simp [r, c, hmn]
    ring
  have hcoeff :
      (∑ x ∈ s, ‖c x‖) ≤
        (∑ m ∈ sm, ‖a m‖) * (∑ n ∈ sn, ‖b n‖) := by
    rw [Finset.sum_product, Finset.sum_mul_sum]
    apply Finset.sum_le_sum
    intro m _hmm
    apply Finset.sum_le_sum
    intro n _hnn
    simp only [c, norm_mul]
    calc
      ‖a m‖ * ‖b n‖ * ‖χ (m * n)‖ ≤ ‖a m‖ * ‖b n‖ * 1 :=
        mul_le_mul_of_nonneg_left (χ.norm_le_one _)
          (mul_nonneg (norm_nonneg _) (norm_nonneg _))
      _ = ‖a m‖ * ‖b n‖ := mul_one _
  have herror : 0 ≤ 2 * L / (T * Real.log (4 / 3 : ℝ)) := by positivity
  rw [intervalIntegral.integral_congr (fun t _ => hintegrand t), hcutoff] at hagg
  calc
    ‖(∫ t in -T..T,
        ((Real.log ((k : ℝ) + 1 / 2) *
          Real.sinc (Real.log ((k : ℝ) + 1 / 2) * t) : ℝ) : ℂ) *
          (∑ m ∈ sm, ∑ n ∈ sn,
            (a m * natLogTwist m t) * (b n * natLogTwist n t) * χ (m * n))) -
      (Real.pi : ℂ) *
        (∑ m ∈ sm, ∑ n ∈ sn.filter (fun n => m * n ≤ k),
          a m * b n * χ (m * n))‖ ≤
        2 * L / (T * Real.log (4 / 3 : ℝ)) * ∑ x ∈ s, ‖c x‖ := hagg
    _ ≤ 2 * L / (T * Real.log (4 / 3 : ℝ)) *
        ((∑ m ∈ sm, ‖a m‖) * (∑ n ∈ sn, ‖b n‖)) :=
      mul_le_mul_of_nonneg_left hcoeff herror
    _ = 2 * L / (T * Real.log (4 / 3 : ℝ)) *
        (∑ m ∈ sm, ‖a m‖) * (∑ n ∈ sn, ‖b n‖) := by ring

theorem pi_mul_norm_bilinearCutoff_le_integral_perronEnvelope_add
    (q : ℕ) (χ : DirichletCharacter ℂ q)
    (sm sn : Finset ℕ) (a b : ℕ → ℂ)
    {k : ℕ} {L T : ℝ}
    (hk : 0 < k) (hL : 0 < L) (hkL : (k : ℝ) ≤ L) (hT : 0 < T)
    (hmPos : ∀ m ∈ sm, 0 < m)
    (hnPos : ∀ n ∈ sn, 0 < n)
    (hprod : ∀ m ∈ sm, ∀ n ∈ sn, ((m * n : ℕ) : ℝ) ≤ L) :
    Real.pi *
        ‖∑ m ∈ sm, ∑ n ∈ sn.filter (fun n => m * n ≤ k),
          a m * b n * χ (m * n)‖ ≤
      (∫ t in -T..T,
        perronEnvelope (Real.log (2 * L)) t *
          ‖∑ m ∈ sm, ∑ n ∈ sn,
            (a m * natLogTwist m t) * (b n * natLogTwist n t) * χ (m * n)‖) +
      2 * L / (T * Real.log (4 / 3 : ℝ)) *
        (∑ m ∈ sm, ‖a m‖) * (∑ n ∈ sn, ‖b n‖) := by
  classical
  let beta : ℝ := Real.log ((k : ℝ) + 1 / 2)
  let B : ℝ := Real.log (2 * L)
  let rect : ℝ → ℂ := fun t =>
    ∑ m ∈ sm, ∑ n ∈ sn,
      (a m * natLogTwist m t) * (b n * natLogTwist n t) * χ (m * n)
  let cutoff : ℂ :=
    ∑ m ∈ sm, ∑ n ∈ sn.filter (fun n => m * n ≤ k),
      a m * b n * χ (m * n)
  let error : ℝ := 2 * L / (T * Real.log (4 / 3 : ℝ)) *
    (∑ m ∈ sm, ‖a m‖) * (∑ n ∈ sn, ‖b n‖)
  have hbeta : 0 < beta := by
    apply Real.log_pos
    have hkone : (1 : ℝ) ≤ (k : ℝ) := by exact_mod_cast hk
    linarith
  have hbetaB : beta ≤ B :=
    log_natCast_add_half_le_log_two_mul hk hL hkL
  have hB : 0 ≤ B := hbeta.le.trans hbetaB
  have hraw :
      ‖(∫ t in -T..T,
          ((beta * Real.sinc (beta * t) : ℝ) : ℂ) * rect t) -
        (Real.pi : ℂ) * cutoff‖ ≤ error := by
    simpa only [beta, rect, cutoff, error] using
      norm_integral_bilinearPerron_sub_cutoff_le
        q χ sm sn a b hk hL hkL hT hmPos hnPos hprod
  have hrect : Continuous rect := by
    dsimp only [rect, natLogTwist]
    fun_prop
  have hbound : IntervalIntegrable
      (fun t => perronEnvelope B t * ‖rect t‖) volume (-T) T :=
    ((continuous_perronEnvelope hB).mul hrect.norm).intervalIntegrable _ _
  have hintegral :
      ‖∫ t in -T..T,
        ((beta * Real.sinc (beta * t) : ℝ) : ℂ) * rect t‖ ≤
        ∫ t in -T..T, perronEnvelope B t * ‖rect t‖ := by
    apply intervalIntegral.norm_integral_le_of_norm_le (by linarith) _ hbound
    filter_upwards with t ht
    have hkernel := abs_mul_sinc_le_perronEnvelope hbeta.le hbetaB t
    simpa only [norm_mul, Complex.norm_real, Real.norm_eq_abs, abs_mul] using
      mul_le_mul_of_nonneg_right hkernel (norm_nonneg (rect t))
  let I : ℂ := ∫ t in -T..T,
    ((beta * Real.sinc (beta * t) : ℝ) : ℂ) * rect t
  have htriangle : ‖(Real.pi : ℂ) * cutoff‖ ≤
      ‖I‖ + ‖I - (Real.pi : ℂ) * cutoff‖ := by
    simpa only [sub_sub_cancel] using
      norm_sub_le I (I - (Real.pi : ℂ) * cutoff)
  calc
    Real.pi * ‖∑ m ∈ sm, ∑ n ∈ sn.filter (fun n => m * n ≤ k),
        a m * b n * χ (m * n)‖ = ‖(Real.pi : ℂ) * cutoff‖ := by
      rw [norm_mul, Complex.norm_real, Real.norm_of_nonneg Real.pi_pos.le]
    _ ≤ ‖I‖ + ‖I - (Real.pi : ℂ) * cutoff‖ := htriangle
    _ ≤ (∫ t in -T..T, perronEnvelope B t * ‖rect t‖) + error :=
      add_le_add (by simpa only [I] using hintegral)
        (by simpa only [I] using hraw)
    _ = (∫ t in -T..T,
        perronEnvelope (Real.log (2 * L)) t *
          ‖∑ m ∈ sm, ∑ n ∈ sn,
            (a m * natLogTwist m t) * (b n * natLogTwist n t) * χ (m * n)‖) +
        2 * L / (T * Real.log (4 / 3 : ℝ)) *
          (∑ m ∈ sm, ‖a m‖) * (∑ n ∈ sn, ‖b n‖) := by
      rfl

/--
The finite bilinear character sum `∑ a(m) b(n) χ(m * n)` over `m ∈ sm`, `n ∈ sn`, subject to the
product cutoff `m * n ≤ k`.
-/
noncomputable def bilinearProductCutoffSum
    (k q : ℕ) (χ : DirichletCharacter ℂ q)
    (sm sn : Finset ℕ) (a b : ℕ → ℂ) : ℂ :=
  ∑ m ∈ sm, ∑ n ∈ sn.filter (fun n => m * n ≤ k),
    a m * b n * χ (m * n)

/--
The maximum norm of the bilinear character sum over product cutoffs `1 ≤ k ≤ K`, with fixed
supports and coefficients. The value is zero for `K = 0`.
-/
noncomputable def bilinearProductCutoffMaximum
    (K q : ℕ) (χ : DirichletCharacter ℂ q)
    (sm sn : Finset ℕ) (a b : ℕ → ℂ) : ℝ :=
  if hK : 1 ≤ K then
    (Finset.Icc 1 K).sup' (Finset.nonempty_Icc.mpr hK)
      (fun k => ‖bilinearProductCutoffSum k q χ sm sn a b‖)
  else 0

theorem norm_bilinearProductCutoffSum_le_maximum
    (K q : ℕ) (χ : DirichletCharacter ℂ q)
    (sm sn : Finset ℕ) (a b : ℕ → ℂ)
    {k : ℕ} (hk : k ∈ Finset.Icc 1 K) :
    ‖bilinearProductCutoffSum k q χ sm sn a b‖ ≤
      bilinearProductCutoffMaximum K q χ sm sn a b := by
  have hK : 1 ≤ K := (Finset.mem_Icc.mp hk).1.trans (Finset.mem_Icc.mp hk).2
  rw [bilinearProductCutoffMaximum, dite_eq_left hK]
  exact Finset.le_sup'
    (fun j => ‖bilinearProductCutoffSum j q χ sm sn a b‖) hk

theorem pi_mul_bilinearProductCutoffMaximum_le_integral_perronEnvelope_add
    {K q : ℕ} (hK : 0 < K) (χ : DirichletCharacter ℂ q)
    (sm sn : Finset ℕ) (a b : ℕ → ℂ) {T : ℝ} (hT : 0 < T)
    (hmPos : ∀ m ∈ sm, 0 < m)
    (hnPos : ∀ n ∈ sn, 0 < n)
    (hprod : ∀ m ∈ sm, ∀ n ∈ sn, m * n ≤ K) :
    Real.pi * bilinearProductCutoffMaximum K q χ sm sn a b ≤
      (∫ t in -T..T,
        perronEnvelope (Real.log (2 * (K : ℝ))) t *
          ‖∑ m ∈ sm, ∑ n ∈ sn,
            (a m * natLogTwist m t) * (b n * natLogTwist n t) *
              χ (m * n)‖) +
      2 * (K : ℝ) / (T * Real.log (4 / 3 : ℝ)) *
        (∑ m ∈ sm, ‖a m‖) * (∑ n ∈ sn, ‖b n‖) := by
  let s := Finset.Icc 1 K
  let f : ℕ → ℝ := fun k => ‖bilinearProductCutoffSum k q χ sm sn a b‖
  have hKone : 1 ≤ K := hK
  have hs : s.Nonempty := ⟨1, Finset.mem_Icc.mpr ⟨le_rfl, hKone⟩⟩
  obtain ⟨k, hk, hmax⟩ := Finset.exists_mem_eq_sup' hs f
  have hkBounds := Finset.mem_Icc.mp hk
  have hkKReal : (k : ℝ) ≤ (K : ℝ) := by
    exact_mod_cast hkBounds.2
  have hprodReal :
      ∀ m ∈ sm, ∀ n ∈ sn, ((m * n : ℕ) : ℝ) ≤ (K : ℝ) := by
    intro m hm n hn
    exact_mod_cast hprod m hm n hn
  have hfixed :=
    pi_mul_norm_bilinearCutoff_le_integral_perronEnvelope_add
      q χ sm sn a b hkBounds.1 (by positivity) hkKReal hT
        hmPos hnPos hprodReal
  rw [bilinearProductCutoffMaximum, dite_eq_left hKone]
  change Real.pi * s.sup' hs f ≤ _
  rw [hmax]
  simpa only [f, bilinearProductCutoffSum] using hfixed

theorem sum_weighted_card_primitiveCharacters_le_sq (Q : ℕ) :
    (∑ q ∈ Finset.Ioc 0 Q,
      (q : ℝ) / (q.totient : ℝ) *
        (Fintype.card (primitiveCharacters q) : ℝ)) ≤ (Q : ℝ) ^ 2 := by
  calc
    (∑ q ∈ Finset.Ioc 0 Q,
        (q : ℝ) / (q.totient : ℝ) *
          (Fintype.card (primitiveCharacters q) : ℝ)) ≤
        ∑ q ∈ Finset.Ioc 0 Q, (q : ℝ) := by
      apply Finset.sum_le_sum
      intro q hq
      have hqpos : 0 < q := (Finset.mem_Ioc.mp hq).1
      have hphi : 0 < (q.totient : ℝ) := by
        exact_mod_cast Nat.totient_pos.mpr hqpos
      calc
        (q : ℝ) / (q.totient : ℝ) *
            (Fintype.card (primitiveCharacters q) : ℝ) ≤
            (q : ℝ) / (q.totient : ℝ) * (q.totient : ℝ) := by
          gcongr
          exact_mod_cast card_primitiveCharacters_le_totient hqpos
        _ = (q : ℝ) := by field_simp
    _ ≤ ∑ _q ∈ Finset.Ioc 0 Q, (Q : ℝ) := by
      apply Finset.sum_le_sum
      intro q hq
      exact_mod_cast (Finset.mem_Ioc.mp hq).2
    _ = (Q : ℝ) ^ 2 := by
      simp [Nat.card_Ioc]
      ring

theorem pi_mul_sum_weighted_bilinearProductCutoffMaximum_le
    {K : ℕ} (hK : 0 < K) (Q : ℕ)
    (sm sn : Finset ℕ) (a b : ℕ → ℂ) {T : ℝ} (hT : 0 < T)
    (hmPos : ∀ m ∈ sm, 0 < m)
    (hnPos : ∀ n ∈ sn, 0 < n)
    (hprod : ∀ m ∈ sm, ∀ n ∈ sn, m * n ≤ K) :
    Real.pi *
        (∑ q ∈ Finset.Ioc 0 Q,
          (q : ℝ) / (q.totient : ℝ) *
            ∑ ψ : primitiveCharacters q,
              bilinearProductCutoffMaximum K q ψ.1 sm sn a b) ≤
      (∫ t in -T..T,
        perronEnvelope (Real.log (2 * (K : ℝ))) t *
          ∑ q ∈ Finset.Ioc 0 Q,
            (q : ℝ) / (q.totient : ℝ) *
              ∑ ψ : primitiveCharacters q,
                ‖∑ m ∈ sm, ∑ n ∈ sn,
                  (a m * natLogTwist m t) *
                    (b n * natLogTwist n t) * ψ.1 (m * n)‖) +
      (2 * (K : ℝ) / (T * Real.log (4 / 3 : ℝ)) *
        (∑ m ∈ sm, ‖a m‖) * (∑ n ∈ sn, ‖b n‖)) * (Q : ℝ) ^ 2 := by
  let weight : ℕ → ℝ := fun q => (q : ℝ) / (q.totient : ℝ)
  let rect : (q : ℕ) → primitiveCharacters q → ℝ → ℂ :=
    fun _q ψ t => ∑ m ∈ sm, ∑ n ∈ sn,
      (a m * natLogTwist m t) * (b n * natLogTwist n t) * ψ.1 (m * n)
  let envelope : ℝ → ℝ := perronEnvelope (Real.log (2 * (K : ℝ)))
  let f : (q : ℕ) → primitiveCharacters q → ℝ → ℝ :=
    fun q ψ t => envelope t * ‖rect q ψ t‖
  let error : ℝ := 2 * (K : ℝ) / (T * Real.log (4 / 3 : ℝ)) *
    (∑ m ∈ sm, ‖a m‖) * (∑ n ∈ sn, ‖b n‖)
  have hB : 0 ≤ Real.log (2 * (K : ℝ)) := by
    apply Real.log_nonneg
    have hKone : (1 : ℝ) ≤ (K : ℝ) := by exact_mod_cast hK
    nlinarith
  have hrect (q : ℕ) (ψ : primitiveCharacters q) :
      Continuous (rect q ψ) := by
    dsimp only [rect, natLogTwist]
    fun_prop
  have hf (q : ℕ) (ψ : primitiveCharacters q) : Continuous (f q ψ) :=
    (continuous_perronEnvelope hB).mul (hrect q ψ).norm
  have hweight {q : ℕ} (hq : q ∈ Finset.Ioc 0 Q) : 0 ≤ weight q := by
    have hqpos : 0 < q := (Finset.mem_Ioc.mp hq).1
    have hphi : 0 < (q.totient : ℝ) := by
      exact_mod_cast Nat.totient_pos.mpr hqpos
    exact div_nonneg (Nat.cast_nonneg q) hphi.le
  have hfixed (q : ℕ) (_hq : q ∈ Finset.Ioc 0 Q)
      (ψ : primitiveCharacters q) :
      Real.pi * bilinearProductCutoffMaximum K q ψ.1 sm sn a b ≤
        (∫ t in -T..T, f q ψ t) + error := by
    simpa only [f, envelope, rect, error] using
      pi_mul_bilinearProductCutoffMaximum_le_integral_perronEnvelope_add
        hK ψ.1 sm sn a b hT hmPos hnPos hprod
  have hsum :
      (∑ q ∈ Finset.Ioc 0 Q, weight q *
        ∑ ψ : primitiveCharacters q,
          Real.pi * bilinearProductCutoffMaximum K q ψ.1 sm sn a b) ≤
      ∑ q ∈ Finset.Ioc 0 Q, weight q *
        ∑ ψ : primitiveCharacters q,
          ((∫ t in -T..T, f q ψ t) + error) := by
    apply Finset.sum_le_sum
    intro q hq
    apply mul_le_mul_of_nonneg_left _ (hweight hq)
    apply Finset.sum_le_sum
    intro ψ _hψ
    exact hfixed q hq ψ
  have hinterchange :
      (∑ q ∈ Finset.Ioc 0 Q, weight q *
        ∑ ψ : primitiveCharacters q, ∫ t in -T..T, f q ψ t) =
      ∫ t in -T..T,
        ∑ q ∈ Finset.Ioc 0 Q, weight q *
          ∑ ψ : primitiveCharacters q, f q ψ t := by
    symm
    rw [intervalIntegral.integral_finsetSum]
    · apply Finset.sum_congr rfl
      intro q _hq
      rw [intervalIntegral.integral_const_mul,
        intervalIntegral.integral_finsetSum]
      intro ψ _hψ
      exact (hf q ψ).intervalIntegrable _ _
    · intro q _hq
      have hsumContinuous : Continuous (fun t =>
          ∑ ψ : primitiveCharacters q, f q ψ t) :=
        continuous_finsetSum Finset.univ (fun ψ _hψ => hf q ψ)
      exact (continuous_const.mul hsumContinuous).intervalIntegrable _ _
  have hmass :
      (∑ q ∈ Finset.Ioc 0 Q, weight q *
        (Fintype.card (primitiveCharacters q) : ℝ)) ≤ (Q : ℝ) ^ 2 := by
    simpa only [weight] using sum_weighted_card_primitiveCharacters_le_sq Q
  have herror : 0 ≤ error := by
    dsimp only [error]
    positivity
  calc
    Real.pi *
        (∑ q ∈ Finset.Ioc 0 Q, weight q *
          ∑ ψ : primitiveCharacters q,
            bilinearProductCutoffMaximum K q ψ.1 sm sn a b) =
        ∑ q ∈ Finset.Ioc 0 Q, weight q *
          ∑ ψ : primitiveCharacters q,
            Real.pi * bilinearProductCutoffMaximum K q ψ.1 sm sn a b := by
      rw [Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro q _hq
      calc
        Real.pi * (weight q *
            ∑ ψ : primitiveCharacters q,
              bilinearProductCutoffMaximum K q ψ.1 sm sn a b) =
            weight q * (Real.pi *
              ∑ ψ : primitiveCharacters q,
                bilinearProductCutoffMaximum K q ψ.1 sm sn a b) := by
          ring
        _ = weight q *
            ∑ ψ : primitiveCharacters q,
              Real.pi * bilinearProductCutoffMaximum K q ψ.1 sm sn a b := by
          rw [Finset.mul_sum]
    _ ≤ ∑ q ∈ Finset.Ioc 0 Q, weight q *
          ∑ ψ : primitiveCharacters q,
            ((∫ t in -T..T, f q ψ t) + error) := hsum
    _ = (∑ q ∈ Finset.Ioc 0 Q, weight q *
          ∑ ψ : primitiveCharacters q, ∫ t in -T..T, f q ψ t) +
        error * (∑ q ∈ Finset.Ioc 0 Q, weight q *
          (Fintype.card (primitiveCharacters q) : ℝ)) := by
      simp_rw [Finset.sum_add_distrib, Finset.sum_const, nsmul_eq_mul,
        Finset.card_univ, mul_add]
      rw [Finset.sum_add_distrib]
      congr 1
      calc
        (∑ q ∈ Finset.Ioc 0 Q,
            weight q * ((Fintype.card (primitiveCharacters q) : ℝ) * error)) =
            ∑ q ∈ Finset.Ioc 0 Q,
              (weight q * (Fintype.card (primitiveCharacters q) : ℝ)) * error := by
          apply Finset.sum_congr rfl
          intro q _hq
          ring
        _ = (∑ q ∈ Finset.Ioc 0 Q,
              weight q * (Fintype.card (primitiveCharacters q) : ℝ)) * error := by
          rw [Finset.sum_mul]
        _ = error * (∑ q ∈ Finset.Ioc 0 Q,
              weight q * (Fintype.card (primitiveCharacters q) : ℝ)) := by ring
    _ = (∫ t in -T..T,
          ∑ q ∈ Finset.Ioc 0 Q, weight q *
            ∑ ψ : primitiveCharacters q, f q ψ t) +
        error * (∑ q ∈ Finset.Ioc 0 Q, weight q *
          (Fintype.card (primitiveCharacters q) : ℝ)) := by
      rw [hinterchange]
    _ ≤ (∫ t in -T..T,
          ∑ q ∈ Finset.Ioc 0 Q, weight q *
            ∑ ψ : primitiveCharacters q, f q ψ t) +
        error * (Q : ℝ) ^ 2 := by gcongr
    _ = _ := by
      dsimp only [weight, error]
      congr 1
      apply intervalIntegral.integral_congr
      intro t _ht
      dsimp only [f, envelope, rect]
      simp_rw [Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro q _hq
      apply Finset.sum_congr rfl
      intro ψ _hψ
      ring

theorem sum_weighted_bilinearProductCutoffMaximum_le
    {K : ℕ} (hK : 0 < K) (Q : ℕ)
    (sm sn : Finset ℕ) (a b : ℕ → ℂ) {T : ℝ} (hT : 0 < T)
    (hmPos : ∀ m ∈ sm, 0 < m)
    (hnPos : ∀ n ∈ sn, 0 < n)
    (hprod : ∀ m ∈ sm, ∀ n ∈ sn, m * n ≤ K) :
    (∑ q ∈ Finset.Ioc 0 Q,
      (q : ℝ) / (q.totient : ℝ) *
        ∑ ψ : primitiveCharacters q,
          bilinearProductCutoffMaximum K q ψ.1 sm sn a b) ≤
      1 / Real.pi *
        (∫ t in -T..T,
          perronEnvelope (Real.log (2 * (K : ℝ))) t *
            ∑ q ∈ Finset.Ioc 0 Q,
              (q : ℝ) / (q.totient : ℝ) *
                ∑ ψ : primitiveCharacters q,
                  ‖∑ m ∈ sm, ∑ n ∈ sn,
                    (a m * natLogTwist m t) *
                      (b n * natLogTwist n t) * ψ.1 (m * n)‖) +
      2 * (K : ℝ) * (Q : ℝ) ^ 2 /
          (Real.pi * Real.log (4 / 3 : ℝ) * T) *
        (∑ m ∈ sm, ‖a m‖) * (∑ n ∈ sn, ‖b n‖) := by
  let S : ℝ := ∑ q ∈ Finset.Ioc 0 Q,
    (q : ℝ) / (q.totient : ℝ) *
      ∑ ψ : primitiveCharacters q,
        bilinearProductCutoffMaximum K q ψ.1 sm sn a b
  let I : ℝ := ∫ t in -T..T,
    perronEnvelope (Real.log (2 * (K : ℝ))) t *
      ∑ q ∈ Finset.Ioc 0 Q,
        (q : ℝ) / (q.totient : ℝ) *
          ∑ ψ : primitiveCharacters q,
            ‖∑ m ∈ sm, ∑ n ∈ sn,
              (a m * natLogTwist m t) *
                (b n * natLogTwist n t) * ψ.1 (m * n)‖
  let A : ℝ := ∑ m ∈ sm, ‖a m‖
  let B : ℝ := ∑ n ∈ sn, ‖b n‖
  have hraw : Real.pi * S ≤
      I + (2 * (K : ℝ) / (T * Real.log (4 / 3 : ℝ)) * A * B) *
        (Q : ℝ) ^ 2 := by
    simpa only [S, I, A, B] using
      pi_mul_sum_weighted_bilinearProductCutoffMaximum_le
        hK Q sm sn a b hT hmPos hnPos hprod
  calc
    S ≤ (I + (2 * (K : ℝ) / (T * Real.log (4 / 3 : ℝ)) * A * B) *
        (Q : ℝ) ^ 2) / Real.pi := by
      rw [le_div_iff₀ Real.pi_pos]
      simpa only [mul_comm] using hraw
    _ = 1 / Real.pi * I +
        2 * (K : ℝ) * (Q : ℝ) ^ 2 /
            (Real.pi * Real.log (4 / 3 : ℝ) * T) * A * B := by
      have hlog : Real.log (4 / 3 : ℝ) ≠ 0 :=
        (Real.log_pos (by norm_num)).ne'
      field_simp [Real.pi_ne_zero, hT.ne', hlog]
    _ = _ := by rfl

theorem sum_weighted_bilinearProductCutoffMaximum_subset_Ioc_le
    (Q m0 M n0 N : ℕ) (hM : 0 < M) (hN : 0 < N)
    (sm sn : Finset ℕ)
    (hsm : sm ⊆ Finset.Ioc m0 (m0 + M))
    (hsn : sn ⊆ Finset.Ioc n0 (n0 + N))
    (a b : ℕ → ℂ) {T : ℝ} (hT : 0 < T) :
    (∑ q ∈ Finset.Ioc 0 Q,
      (q : ℝ) / (q.totient : ℝ) *
        ∑ ψ : primitiveCharacters q,
          bilinearProductCutoffMaximum
            ((m0 + M) * (n0 + N)) q ψ.1 sm sn a b) ≤
      1 / Real.pi *
        (∫ t in -T..T,
          perronEnvelope
              (Real.log (2 * (((m0 + M) * (n0 + N) : ℕ) : ℝ))) t *
            ∑ q ∈ Finset.Ioc 0 Q,
              (q : ℝ) / (q.totient : ℝ) *
                ∑ ψ : primitiveCharacters q,
                  ‖∑ m ∈ sm, ∑ n ∈ sn,
                    (a m * natLogTwist m t) *
                      (b n * natLogTwist n t) * ψ.1 (m * n)‖) +
      2 * (((m0 + M) * (n0 + N) : ℕ) : ℝ) * (Q : ℝ) ^ 2 /
          (Real.pi * Real.log (4 / 3 : ℝ) * T) *
        (∑ m ∈ sm, ‖a m‖) * (∑ n ∈ sn, ‖b n‖) := by
  have hmUpperPos : 0 < m0 + M := by omega
  have hnUpperPos : 0 < n0 + N := by omega
  have hK : 0 < (m0 + M) * (n0 + N) :=
    Nat.mul_pos hmUpperPos hnUpperPos
  have hmPos : ∀ m ∈ sm, 0 < m := by
    intro m hm
    have hmBounds := Finset.mem_Ioc.mp (hsm hm)
    omega
  have hnPos : ∀ n ∈ sn, 0 < n := by
    intro n hn
    have hnBounds := Finset.mem_Ioc.mp (hsn hn)
    omega
  have hprod :
      ∀ m ∈ sm, ∀ n ∈ sn, m * n ≤ (m0 + M) * (n0 + N) := by
    intro m hm n hn
    exact Nat.mul_le_mul
      (Finset.mem_Ioc.mp (hsm hm)).2
      (Finset.mem_Ioc.mp (hsn hn)).2
  exact sum_weighted_bilinearProductCutoffMaximum_le
    hK Q sm sn a b hT hmPos hnPos hprod

theorem sum_weighted_norm_bilinear_natLogTwists_subset_Ioc_le
    (Q m0 M n0 N : ℕ) (sm sn : Finset ℕ)
    (hsm : sm ⊆ Finset.Ioc m0 (m0 + M))
    (hsn : sn ⊆ Finset.Ioc n0 (n0 + N))
    (a b : ℕ → ℂ) (t : ℝ) :
    (∑ q ∈ Finset.Ioc 0 Q,
      (q : ℝ) / (q.totient : ℝ) *
        ∑ psi : primitiveCharacters q,
          ‖∑ m ∈ sm, ∑ n ∈ sn,
            (a m * natLogTwist m t) *
              (b n * natLogTwist n t) * psi.1 (m * n)‖) ≤
      Real.sqrt ((M : ℝ) + (Q : ℝ) ^ 2) *
        Real.sqrt ((N : ℝ) + (Q : ℝ) ^ 2) *
        Real.sqrt (∑ m ∈ sm, ‖a m‖ ^ 2) *
        Real.sqrt (∑ n ∈ sn, ‖b n‖ ^ 2) := by
  simpa only [norm_mul, norm_natLogTwist, mul_one] using
    sum_weighted_norm_bilinear_primitiveTwists_subset_Ioc_le
      Q m0 M n0 N sm sn hsm hsn
        (fun m ↦ a m * natLogTwist m t)
        (fun n ↦ b n * natLogTwist n t)

theorem sum_norm_le_sqrt_card_mul_sqrt_sum_sq
    {α : Type*} (s : Finset α) (a : α → ℂ) :
    (∑ x ∈ s, ‖a x‖) ≤
      Real.sqrt (s.card : ℝ) * Real.sqrt (∑ x ∈ s, ‖a x‖ ^ 2) := by
  have h := Real.sum_mul_le_sqrt_mul_sqrt s
    (fun x ↦ ‖a x‖) (fun _x ↦ (1 : ℝ))
  simpa only [mul_one, one_pow, Finset.sum_const_zero, Finset.sum_const,
    nsmul_eq_mul, mul_comm] using h

theorem sum_norm_le_sqrt_span_mul_sqrt_sum_sq
    {m0 M : ℕ} (s : Finset ℕ)
    (hs : s ⊆ Finset.Ioc m0 (m0 + M)) (a : ℕ → ℂ) :
    (∑ x ∈ s, ‖a x‖) ≤
      Real.sqrt (M : ℝ) * Real.sqrt (∑ x ∈ s, ‖a x‖ ^ 2) := by
  have hcardNat : s.card ≤ M := by
    have h := Finset.card_le_card hs
    simpa only [Nat.card_Ioc, Nat.add_sub_cancel_left] using h
  have hcardReal : (s.card : ℝ) ≤ (M : ℝ) := by
    exact_mod_cast hcardNat
  exact (sum_norm_le_sqrt_card_mul_sqrt_sum_sq s a).trans
    (mul_le_mul_of_nonneg_right (Real.sqrt_le_sqrt hcardReal)
      (Real.sqrt_nonneg _))

theorem sq_le_sqrt_add_sq_mul_sqrt_add_sq
    (M N Q : ℝ) (hM : 0 ≤ M) (hN : 0 ≤ N) (hQ : 0 ≤ Q) :
    Q ^ 2 ≤ Real.sqrt (M + Q ^ 2) * Real.sqrt (N + Q ^ 2) := by
  have hQM : Q ≤ Real.sqrt (M + Q ^ 2) := by
    rw [Real.le_sqrt hQ (by positivity)]
    linarith
  have hQN : Q ≤ Real.sqrt (N + Q ^ 2) := by
    rw [Real.le_sqrt hQ (by positivity)]
    linarith
  simpa only [pow_two] using
    mul_le_mul hQM hQN hQ (Real.sqrt_nonneg _)

theorem sqrt_mul_sqrt_le_sqrt_product_endpoints
    (m0 M n0 N : ℕ) :
    Real.sqrt (M : ℝ) * Real.sqrt (N : ℝ) ≤
      Real.sqrt (((m0 + M) * (n0 + N) : ℕ) : ℝ) := by
  rw [← Real.sqrt_mul (Nat.cast_nonneg M)]
  apply Real.sqrt_le_sqrt
  norm_cast
  exact Nat.mul_le_mul (by omega) (by omega)

/--
The explicit constant `(2 / π) * (2 + log (log 2 / log (4/3))) / log 2` in the Akbary–Hambrook
bilinear maximal estimate.
-/
noncomputable def akbaryHambrookBilinearConstant : ℝ :=
  2 / Real.pi *
    (2 + Real.log (Real.log 2 / Real.log (4 / 3 : ℝ))) /
      Real.log 2

/-- The Perron truncation time `P * √P / log (4/3)` used in the bilinear maximal estimate. -/
noncomputable def akbaryHambrookPerronTime (P : ℝ) : ℝ :=
  P * Real.sqrt P / Real.log (4 / 3 : ℝ)

theorem akbaryHambrookPerronTime_pos
    {P : ℝ} (hP : 1 ≤ P) :
    0 < akbaryHambrookPerronTime P := by
  unfold akbaryHambrookPerronTime
  positivity

theorem one_le_akbaryHambrookPerronTime_mul_log
    {P : ℝ} (hP : 1 ≤ P) :
    1 ≤ akbaryHambrookPerronTime P * Real.log (2 * P) := by
  have hc : 0 < Real.log (4 / 3 : ℝ) := Real.log_pos (by norm_num)
  have hsqrt : 1 ≤ Real.sqrt P := Real.one_le_sqrt.mpr hP
  have hscale : 1 ≤ P * Real.sqrt P := by
    simpa using mul_le_mul hP hsqrt (by norm_num : (0 : ℝ) ≤ 1) (by linarith)
  have harg : (4 / 3 : ℝ) ≤ 2 * P := by nlinarith
  have hlog : Real.log (4 / 3 : ℝ) ≤ Real.log (2 * P) :=
    Real.log_le_log (by norm_num) harg
  have hratio : 1 ≤ Real.log (2 * P) / Real.log (4 / 3 : ℝ) :=
    (le_div_iff₀ hc).2 (by simpa using hlog)
  unfold akbaryHambrookPerronTime
  calc
    P * Real.sqrt P / Real.log (4 / 3 : ℝ) * Real.log (2 * P) =
        (P * Real.sqrt P) *
          (Real.log (2 * P) / Real.log (4 / 3 : ℝ)) := by ring
    _ ≥ 1 * 1 := mul_le_mul hscale hratio (by norm_num) (by positivity)
    _ = 1 := one_mul 1

theorem add_log_div_le_of_le
    {A l x : ℝ} (hl : 0 < l) (hlx : l ≤ x)
    (hA : 1 ≤ A + Real.log l) :
    (A + Real.log x) / x ≤ (A + Real.log l) / l := by
  have hx : 0 < x := hl.trans_le hlx
  have hlog : Real.log x - Real.log l ≤ x / l - 1 := by
    rw [← Real.log_div hx.ne' hl.ne']
    exact Real.log_le_sub_one_of_pos (div_pos hx hl)
  have hlog' : l * (Real.log x - Real.log l) ≤ x - l := by
    calc
      l * (Real.log x - Real.log l) ≤ l * (x / l - 1) :=
        mul_le_mul_of_nonneg_left hlog hl.le
      _ = x - l := by field_simp
  have hdelta : 0 ≤ x - l := sub_nonneg.mpr hlx
  have hdelta' : x - l ≤ (x - l) * (A + Real.log l) :=
    le_mul_of_one_le_right hdelta hA
  rw [div_le_div_iff₀ hx hl]
  calc
    (A + Real.log x) * l =
        (A + Real.log l) * l + l * (Real.log x - Real.log l) := by ring
    _ ≤ (A + Real.log l) * l + (x - l) := by gcongr
    _ ≤ (A + Real.log l) * l + (x - l) * (A + Real.log l) := by gcongr
    _ = (A + Real.log l) * x := by ring

theorem one_le_akbaryHambrook_optimized_log_constant :
    1 ≤
      (2 - (3 / 2 : ℝ) * Real.log 2 - Real.log (Real.log (4 / 3 : ℝ))) +
        Real.log (Real.log 2) := by
  have hc : 0 < Real.log (4 / 3 : ℝ) := Real.log_pos (by norm_num)
  have hl : 0 < Real.log 2 := Real.log_pos (by norm_num)
  have htwoc : 2 * Real.log (4 / 3 : ℝ) ≤ Real.log 2 := by
    calc
      2 * Real.log (4 / 3 : ℝ) = Real.log ((4 / 3 : ℝ) ^ 2) := by
        rw [Real.log_pow]
        norm_num
      _ ≤ Real.log 2 := Real.log_le_log (by positivity) (by norm_num)
  have hratio : (2 : ℝ) ≤ Real.log 2 / Real.log (4 / 3 : ℝ) := by
    rw [le_div_iff₀ hc]
    exact htwoc
  have hlogratio : Real.log 2 ≤
      Real.log (Real.log 2 / Real.log (4 / 3 : ℝ)) :=
    Real.log_le_log (by norm_num) hratio
  have hl_one : Real.log 2 ≤ 1 := by
    nlinarith [Real.log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2)]
  calc
    1 ≤ 2 - (3 / 2 : ℝ) * Real.log 2 + Real.log 2 := by linarith
    _ ≤ 2 - (3 / 2 : ℝ) * Real.log 2 +
        Real.log (Real.log 2 / Real.log (4 / 3 : ℝ)) := by linarith
    _ = (2 - (3 / 2 : ℝ) * Real.log 2 -
          Real.log (Real.log (4 / 3 : ℝ))) +
        Real.log (Real.log 2) := by
      rw [Real.log_div hl.ne' hc.ne']
      ring

theorem akbaryHambrookPerronTime_error_le_bilinearConstant
    {P : ℝ} (hP : 1 ≤ P) :
    2 / Real.pi *
        (Real.log
            (Real.exp 1 * akbaryHambrookPerronTime P *
              Real.log (2 * P)) +
          P * Real.sqrt P /
            (Real.log (4 / 3 : ℝ) * akbaryHambrookPerronTime P)) /
        Real.log (2 * P) ≤
      akbaryHambrookBilinearConstant := by
  let c : ℝ := Real.log (4 / 3 : ℝ)
  let l : ℝ := Real.log 2
  let x : ℝ := Real.log (2 * P)
  let A : ℝ := 2 - (3 / 2 : ℝ) * l - Real.log c
  have hPpos : 0 < P := zero_lt_one.trans_le hP
  have hsqrt : 0 < Real.sqrt P := Real.sqrt_pos.2 hPpos
  have hc : 0 < c := Real.log_pos (by norm_num)
  have hl : 0 < l := Real.log_pos (by norm_num)
  have htwoP : (2 : ℝ) ≤ 2 * P := by nlinarith
  have hx : 0 < x := Real.log_pos (by nlinarith)
  have hlx : l ≤ x := Real.log_le_log (by norm_num) htwoP
  have hlogP : x = l + Real.log P := by
    dsimp only [x, l]
    rw [Real.log_mul (by norm_num) hPpos.ne']
  have hsecond :
      P * Real.sqrt P /
          (c * akbaryHambrookPerronTime P) = 1 := by
    dsimp only [akbaryHambrookPerronTime, c]
    field_simp
  have hlogTime :
      Real.log (akbaryHambrookPerronTime P) =
        Real.log P + Real.log (Real.sqrt P) - Real.log c := by
    rw [akbaryHambrookPerronTime,
      Real.log_div (mul_ne_zero hPpos.ne' hsqrt.ne') hc.ne',
      Real.log_mul hPpos.ne' hsqrt.ne']
  have hlogArg :
      Real.log (Real.exp 1 * akbaryHambrookPerronTime P * x) =
        1 + (3 / 2 : ℝ) * Real.log P - Real.log c + Real.log x := by
    rw [show Real.exp 1 * akbaryHambrookPerronTime P * x =
        Real.exp 1 * (akbaryHambrookPerronTime P * x) by ring,
      Real.log_mul (Real.exp_ne_zero 1)
        (mul_ne_zero (akbaryHambrookPerronTime_pos hP).ne' hx.ne'),
      Real.log_exp,
      Real.log_mul (akbaryHambrookPerronTime_pos hP).ne' hx.ne', hlogTime,
      Real.log_sqrt hPpos.le]
    ring
  have hnorm :
      Real.log (Real.exp 1 * akbaryHambrookPerronTime P * x) +
          P * Real.sqrt P /
            (c * akbaryHambrookPerronTime P) =
        (3 / 2 : ℝ) * x + A + Real.log x := by
    rw [hlogArg, hsecond]
    dsimp only [A]
    rw [hlogP]
    ring
  have hA : 1 ≤ A + Real.log l := by
    simpa only [A, l, c] using one_le_akbaryHambrook_optimized_log_constant
  have hmain : (A + Real.log x) / x ≤ (A + Real.log l) / l :=
    add_log_div_le_of_le hl hlx hA
  unfold akbaryHambrookBilinearConstant
  change 2 / Real.pi *
      (Real.log (Real.exp 1 * akbaryHambrookPerronTime P * x) +
        P * Real.sqrt P / (c * akbaryHambrookPerronTime P)) / x ≤ _
  rw [hnorm]
  calc
    2 / Real.pi * ((3 / 2 : ℝ) * x + A + Real.log x) / x =
        2 / Real.pi * ((3 / 2 : ℝ) + (A + Real.log x) / x) := by
      field_simp
      ring
    _ ≤ 2 / Real.pi * ((3 / 2 : ℝ) + (A + Real.log l) / l) := by
      gcongr
    _ = 2 / Real.pi *
        (2 + Real.log (Real.log 2 / Real.log (4 / 3 : ℝ))) /
          Real.log 2 := by
      dsimp only [A, l, c]
      rw [Real.log_div hl.ne' hc.ne']
      field_simp
      ring

theorem perronEnvelope_nonneg (B t : ℝ) :
    0 ≤ perronEnvelope B t := by
  simp only [perronEnvelope]
  split_ifs
  · positivity
  · exact inv_nonneg.mpr (le_max_of_le_left (abs_nonneg t))

theorem integral_perronEnvelope_eq_two_mul_log
    {B T : ℝ} (hB : 0 < B) (hT : 0 < T) (hBT : 1 ≤ T * B) :
    (∫ t in -T..T, perronEnvelope B t) =
      2 * Real.log (Real.exp 1 * T * B) := by
  have hinvT : B⁻¹ ≤ T := (inv_le_iff_one_le_mul₀ hB).2 hBT
  have hcont : Continuous (perronEnvelope B) := continuous_perronEnvelope hB.le
  have hzeroInv : (∫ t in 0..B⁻¹, perronEnvelope B t) = 1 := by
    rw [intervalIntegral.integral_congr (f := perronEnvelope B)
      (g := fun _ ↦ B)]
    · simp [hB.ne']
    · intro t ht
      rw [Set.uIcc_of_le (inv_nonneg.mpr hB.le)] at ht
      rw [perronEnvelope, ite_eq_right hB.ne', abs_of_nonneg ht.1,
        max_eq_right ht.2, inv_inv]
  have hinvTop : (∫ t in B⁻¹..T, perronEnvelope B t) =
      Real.log (T * B) := by
    rw [intervalIntegral.integral_congr (f := perronEnvelope B)
      (g := fun t ↦ t⁻¹)]
    · rw [integral_inv_of_pos (inv_pos.mpr hB) hT]
      congr 1
      field_simp
    · intro t ht
      rw [Set.uIcc_of_le hinvT] at ht
      have ht0 : 0 ≤ t := (inv_pos.mpr hB).le.trans ht.1
      rw [perronEnvelope, ite_eq_right hB.ne', abs_of_nonneg ht0,
        max_eq_left ht.1]
  have hzeroTop : (∫ t in 0..T, perronEnvelope B t) =
      1 + Real.log (T * B) := by
    rw [← intervalIntegral.integral_add_adjacent_intervals
      (hcont.intervalIntegrable _ _) (hcont.intervalIntegrable _ _),
      hzeroInv, hinvTop]
  have hneg : (∫ t in -T..0, perronEnvelope B t) =
      ∫ t in 0..T, perronEnvelope B t := by
    calc
      (∫ t in -T..0, perronEnvelope B t) =
          ∫ t in 0..T, perronEnvelope B (-t) := by
            symm
            have h := intervalIntegral.integral_comp_neg
              (a := 0) (b := T) (f := perronEnvelope B)
            rw [neg_zero] at h
            exact h
      _ = ∫ t in 0..T, perronEnvelope B t := by
        apply intervalIntegral.integral_congr
        intro t _ht
        simp [perronEnvelope]
  rw [← intervalIntegral.integral_add_adjacent_intervals
      (hcont.intervalIntegrable _ _) (hcont.intervalIntegrable _ _),
    hneg, hzeroTop]
  have hTB : T * B ≠ 0 := mul_ne_zero hT.ne' hB.ne'
  rw [show Real.exp 1 * T * B = Real.exp 1 * (T * B) by ring,
    Real.log_mul (Real.exp_ne_zero 1) hTB, Real.log_exp]
  ring

theorem sum_weighted_bilinearProductCutoffMaximum_subset_Ioc_le_preoptimized
    (Q m0 M n0 N : ℕ) (hM : 0 < M) (hN : 0 < N)
    (sm sn : Finset ℕ)
    (hsm : sm ⊆ Finset.Ioc m0 (m0 + M))
    (hsn : sn ⊆ Finset.Ioc n0 (n0 + N))
    (a b : ℕ → ℂ) {T : ℝ} (hT : 0 < T)
    (hregime :
      1 ≤ T * Real.log
        (2 * (((m0 + M) * (n0 + N) : ℕ) : ℝ))) :
    (∑ q ∈ Finset.Ioc 0 Q,
      (q : ℝ) / (q.totient : ℝ) *
        ∑ psi : primitiveCharacters q,
          bilinearProductCutoffMaximum
            ((m0 + M) * (n0 + N)) q psi.1 sm sn a b) ≤
      (Real.sqrt ((M : ℝ) + (Q : ℝ) ^ 2) *
        Real.sqrt ((N : ℝ) + (Q : ℝ) ^ 2) *
        Real.sqrt (∑ m ∈ sm, ‖a m‖ ^ 2) *
        Real.sqrt (∑ n ∈ sn, ‖b n‖ ^ 2)) *
      (2 / Real.pi * Real.log
          (Real.exp 1 * T *
            Real.log
              (2 * (((m0 + M) * (n0 + N) : ℕ) : ℝ))) +
        2 * (((m0 + M) * (n0 + N) : ℕ) : ℝ) *
            Real.sqrt (((m0 + M) * (n0 + N) : ℕ) : ℝ) /
          (Real.pi * Real.log (4 / 3 : ℝ) * T)) := by
  let K : ℕ := (m0 + M) * (n0 + N)
  let P : ℝ := (K : ℝ)
  let B : ℝ := Real.log (2 * P)
  let D : ℝ := Real.sqrt ((M : ℝ) + (Q : ℝ) ^ 2) *
    Real.sqrt ((N : ℝ) + (Q : ℝ) ^ 2)
  let EA : ℝ := Real.sqrt (∑ m ∈ sm, ‖a m‖ ^ 2)
  let EB : ℝ := Real.sqrt (∑ n ∈ sn, ‖b n‖ ^ 2)
  let G : ℝ := D * EA * EB
  let LA : ℝ := ∑ m ∈ sm, ‖a m‖
  let LB : ℝ := ∑ n ∈ sn, ‖b n‖
  let S : ℝ → ℝ := fun t ↦
    ∑ q ∈ Finset.Ioc 0 Q,
      (q : ℝ) / (q.totient : ℝ) *
        ∑ psi : primitiveCharacters q,
          ‖∑ m ∈ sm, ∑ n ∈ sn,
            (a m * natLogTwist m t) *
              (b n * natLogTwist n t) * psi.1 (m * n)‖
  let I : ℝ := ∫ t in -T..T, perronEnvelope B t * S t
  let L : ℝ := ∑ q ∈ Finset.Ioc 0 Q,
    (q : ℝ) / (q.totient : ℝ) *
      ∑ psi : primitiveCharacters q,
        bilinearProductCutoffMaximum K q psi.1 sm sn a b
  have hK : 0 < K := by
    exact Nat.mul_pos (by omega) (by omega)
  have hP : 1 ≤ P := by
    dsimp only [P]
    exact_mod_cast hK
  have hB : 0 < B := by
    dsimp only [B]
    exact Real.log_pos (by nlinarith)
  have hS : Continuous S := by
    dsimp only [S, natLogTwist]
    fun_prop
  have hphase (t : ℝ) : S t ≤ G := by
    simpa only [S, G, D, EA, EB] using
      sum_weighted_norm_bilinear_natLogTwists_subset_Ioc_le
        Q m0 M n0 N sm sn hsm hsn a b t
  have hI : I ≤ 2 * Real.log (Real.exp 1 * T * B) * G := by
    have hf : IntervalIntegrable (fun t ↦ perronEnvelope B t * S t)
        volume (-T) T :=
      ((continuous_perronEnvelope hB.le).mul hS).intervalIntegrable _ _
    have hg : IntervalIntegrable (fun t ↦ perronEnvelope B t * G)
        volume (-T) T :=
      ((continuous_perronEnvelope hB.le).mul continuous_const).intervalIntegrable _ _
    calc
      I ≤ ∫ t in -T..T, perronEnvelope B t * G := by
        dsimp only [I]
        exact intervalIntegral.integral_mono_on (by linarith) hf hg
          (fun t _ht ↦ mul_le_mul_of_nonneg_left (hphase t)
            (perronEnvelope_nonneg B t))
      _ = (∫ t in -T..T, perronEnvelope B t) * G := by
        rw [intervalIntegral.integral_mul_const]
      _ = 2 * Real.log (Real.exp 1 * T * B) * G := by
        rw [integral_perronEnvelope_eq_two_mul_log hB hT]
        simpa only [B, P, K] using hregime
  have hbase : L ≤
      1 / Real.pi * I +
        2 * P * (Q : ℝ) ^ 2 /
            (Real.pi * Real.log (4 / 3 : ℝ) * T) * LA * LB := by
    simpa only [L, I, S, B, P, K, LA, LB] using
      sum_weighted_bilinearProductCutoffMaximum_subset_Ioc_le
        Q m0 M n0 N hM hN sm sn hsm hsn a b hT
  have hmain : 1 / Real.pi * I ≤
      G * (2 / Real.pi * Real.log (Real.exp 1 * T * B)) := by
    calc
      1 / Real.pi * I ≤
          1 / Real.pi *
            (2 * Real.log (Real.exp 1 * T * B) * G) :=
        mul_le_mul_of_nonneg_left hI (by positivity)
      _ = G * (2 / Real.pi * Real.log (Real.exp 1 * T * B)) := by ring
  have hLA : LA ≤ Real.sqrt (M : ℝ) * EA := by
    simpa only [LA, EA] using
      sum_norm_le_sqrt_span_mul_sqrt_sum_sq sm hsm a
  have hLB : LB ≤ Real.sqrt (N : ℝ) * EB := by
    simpa only [LB, EB] using
      sum_norm_le_sqrt_span_mul_sqrt_sum_sq sn hsn b
  have hQL : (Q : ℝ) ^ 2 ≤ D := by
    simpa only [D] using sq_le_sqrt_add_sq_mul_sqrt_add_sq
      (M : ℝ) (N : ℝ) (Q : ℝ) (by positivity) (by positivity) (by positivity)
  have hspan : Real.sqrt (M : ℝ) * Real.sqrt (N : ℝ) ≤ Real.sqrt P := by
    simpa only [P, K] using sqrt_mul_sqrt_le_sqrt_product_endpoints m0 M n0 N
  have hLALB : LA * LB ≤
      Real.sqrt (M : ℝ) * Real.sqrt (N : ℝ) * EA * EB := by
    calc
      LA * LB ≤ (Real.sqrt (M : ℝ) * EA) *
          (Real.sqrt (N : ℝ) * EB) :=
        mul_le_mul hLA hLB (by positivity) (by positivity)
      _ = Real.sqrt (M : ℝ) * Real.sqrt (N : ℝ) * EA * EB := by ring
  have hcore : (Q : ℝ) ^ 2 * LA * LB ≤ D * Real.sqrt P * EA * EB := by
    calc
      (Q : ℝ) ^ 2 * LA * LB ≤ D *
          (Real.sqrt (M : ℝ) * Real.sqrt (N : ℝ) * EA * EB) := by
        calc
          (Q : ℝ) ^ 2 * LA * LB = (Q : ℝ) ^ 2 * (LA * LB) := by ring
          _ ≤ D * (Real.sqrt (M : ℝ) * Real.sqrt (N : ℝ) * EA * EB) :=
            mul_le_mul hQL hLALB (by positivity) (by positivity)
      _ ≤ D * (Real.sqrt P * EA * EB) := by gcongr
      _ = D * Real.sqrt P * EA * EB := by ring
  have herror :
      2 * P * (Q : ℝ) ^ 2 /
            (Real.pi * Real.log (4 / 3 : ℝ) * T) * LA * LB ≤
        G * (2 * P * Real.sqrt P /
          (Real.pi * Real.log (4 / 3 : ℝ) * T)) := by
    have hc : 0 ≤ 2 * P /
        (Real.pi * Real.log (4 / 3 : ℝ) * T) := by positivity
    calc
      2 * P * (Q : ℝ) ^ 2 /
            (Real.pi * Real.log (4 / 3 : ℝ) * T) * LA * LB =
          (2 * P / (Real.pi * Real.log (4 / 3 : ℝ) * T)) *
            ((Q : ℝ) ^ 2 * LA * LB) := by ring
      _ ≤ (2 * P / (Real.pi * Real.log (4 / 3 : ℝ) * T)) *
          (D * Real.sqrt P * EA * EB) :=
        mul_le_mul_of_nonneg_left hcore hc
      _ = G * (2 * P * Real.sqrt P /
          (Real.pi * Real.log (4 / 3 : ℝ) * T)) := by
        dsimp only [G]
        ring
  change L ≤ G *
    (2 / Real.pi * Real.log (Real.exp 1 * T * B) +
      2 * P * Real.sqrt P /
        (Real.pi * Real.log (4 / 3 : ℝ) * T))
  calc
    L ≤ 1 / Real.pi * I +
        2 * P * (Q : ℝ) ^ 2 /
          (Real.pi * Real.log (4 / 3 : ℝ) * T) * LA * LB := hbase
    _ ≤ G * (2 / Real.pi * Real.log (Real.exp 1 * T * B)) +
        G * (2 * P * Real.sqrt P /
          (Real.pi * Real.log (4 / 3 : ℝ) * T)) := add_le_add hmain herror
    _ = G *
        (2 / Real.pi * Real.log (Real.exp 1 * T * B) +
          2 * P * Real.sqrt P /
            (Real.pi * Real.log (4 / 3 : ℝ) * T)) := by ring

end

section
open scoped ContDiff

theorem akbaryHambrookBilinearConstant_pos : 0 < akbaryHambrookBilinearConstant := by
  have hlogTwo : 0 < Real.log 2 := Real.log_pos (by norm_num)
  have hlogFourThirds : 0 < Real.log (4 / 3 : ℝ) :=
    Real.log_pos (by norm_num)
  have hlogCompare : Real.log (4 / 3 : ℝ) < Real.log 2 :=
    Real.strictMonoOn_log (by norm_num) (by norm_num) (by norm_num)
  have hratio : 1 < Real.log 2 / Real.log (4 / 3 : ℝ) :=
    (one_lt_div hlogFourThirds).2 hlogCompare
  have hlogRatio : 0 <
      Real.log (Real.log 2 / Real.log (4 / 3 : ℝ)) :=
    Real.log_pos hratio
  unfold akbaryHambrookBilinearConstant
  positivity

theorem sum_weighted_bilinearProductCutoffMaximum_subset_Ioc_le_akbaryHambrookBilinearConstant
    (Q m0 M n0 N : ℕ) (hM : 0 < M) (hN : 0 < N)
    (sm sn : Finset ℕ)
    (hsm : sm ⊆ Finset.Ioc m0 (m0 + M))
    (hsn : sn ⊆ Finset.Ioc n0 (n0 + N))
    (a b : ℕ → ℂ) :
    (∑ q ∈ Finset.Ioc 0 Q,
      (q : ℝ) / (q.totient : ℝ) *
        ∑ psi : primitiveCharacters q,
          bilinearProductCutoffMaximum
            ((m0 + M) * (n0 + N)) q psi.1 sm sn a b) ≤
      akbaryHambrookBilinearConstant *
        Real.sqrt ((M : ℝ) + (Q : ℝ) ^ 2) *
        Real.sqrt ((N : ℝ) + (Q : ℝ) ^ 2) *
        Real.sqrt (∑ m ∈ sm, ‖a m‖ ^ 2) *
        Real.sqrt (∑ n ∈ sn, ‖b n‖ ^ 2) *
        Real.log
          (2 * (((m0 + M) * (n0 + N) : ℕ) : ℝ)) := by
  let K : ℕ := (m0 + M) * (n0 + N)
  let P : ℝ := (K : ℝ)
  let B : ℝ := Real.log (2 * P)
  let T : ℝ := akbaryHambrookPerronTime P
  let G : ℝ := Real.sqrt ((M : ℝ) + (Q : ℝ) ^ 2) *
    Real.sqrt ((N : ℝ) + (Q : ℝ) ^ 2) *
    Real.sqrt (∑ m ∈ sm, ‖a m‖ ^ 2) *
    Real.sqrt (∑ n ∈ sn, ‖b n‖ ^ 2)
  let L : ℝ := ∑ q ∈ Finset.Ioc 0 Q,
    (q : ℝ) / (q.totient : ℝ) *
      ∑ psi : primitiveCharacters q,
        bilinearProductCutoffMaximum K q psi.1 sm sn a b
  have hK : 0 < K := Nat.mul_pos (by omega) (by omega)
  have hP : 1 ≤ P := by
    dsimp only [P]
    exact_mod_cast hK
  have hB : 0 < B := by
    dsimp only [B]
    exact Real.log_pos (by nlinarith)
  have hT : 0 < T :=
    akbaryHambrookPerronTime_pos hP
  have hregime : 1 ≤ T * B :=
    one_le_akbaryHambrookPerronTime_mul_log hP
  have hpre :=
    sum_weighted_bilinearProductCutoffMaximum_subset_Ioc_le_preoptimized
      Q m0 M n0 N hM hN sm sn hsm hsn a b hT hregime
  change L ≤ G *
    (2 / Real.pi * Real.log (Real.exp 1 * T * B) +
      2 * P * Real.sqrt P /
        (Real.pi * Real.log (4 / 3 : ℝ) * T)) at hpre
  have heq := akbaryHambrookPerronTime_error_le_bilinearConstant hP
  change 2 / Real.pi *
      (Real.log (Real.exp 1 * T * B) +
        P * Real.sqrt P / (Real.log (4 / 3 : ℝ) * T)) / B ≤
    akbaryHambrookBilinearConstant at heq
  have hraw := (div_le_iff₀ hB).mp heq
  have hcoefficient :
      2 / Real.pi * Real.log (Real.exp 1 * T * B) +
          2 * P * Real.sqrt P /
            (Real.pi * Real.log (4 / 3 : ℝ) * T) ≤
        akbaryHambrookBilinearConstant * B := by
    calc
      2 / Real.pi * Real.log (Real.exp 1 * T * B) +
          2 * P * Real.sqrt P /
            (Real.pi * Real.log (4 / 3 : ℝ) * T) =
          2 / Real.pi *
            (Real.log (Real.exp 1 * T * B) +
              P * Real.sqrt P /
                (Real.log (4 / 3 : ℝ) * T)) := by ring
      _ ≤ akbaryHambrookBilinearConstant * B := hraw
  have hfinal : L ≤ akbaryHambrookBilinearConstant * G * B := by
    calc
      L ≤ G *
          (2 / Real.pi * Real.log (Real.exp 1 * T * B) +
            2 * P * Real.sqrt P /
              (Real.pi * Real.log (4 / 3 : ℝ) * T)) := hpre
      _ ≤ G * (akbaryHambrookBilinearConstant * B) :=
        mul_le_mul_of_nonneg_left hcoefficient (by positivity)
      _ = akbaryHambrookBilinearConstant * G * B := by ring
  simpa only [L, G, B, P, K, mul_assoc] using hfinal

theorem vaughanProgressionMeanLogPower_le_log_pow_five
    {x : ℕ} (hx : 4 ≤ x) :
    vaughanProgressionMeanLogPower x ≤
      Real.log (x : ℝ) ^ 5 := by
  have hlog := one_le_log_natCast hx
  have hsqrt : Real.sqrt (Real.log (x : ℝ)) ≤ Real.log (x : ℝ) :=
    Real.sqrt_le_self_iff.mpr (Or.inr hlog)
  unfold vaughanProgressionMeanLogPower
  calc
    Real.log (x : ℝ) ^ 4 * Real.sqrt (Real.log (x : ℝ)) ≤
        Real.log (x : ℝ) ^ 4 * Real.log (x : ℝ) :=
      mul_le_mul_of_nonneg_left hsqrt (by positivity)
    _ = Real.log (x : ℝ) ^ 5 := by ring

/--
The large-third Vaughan contribution restricted to dyadic block `alpha`, written as a bilinear
sum with product cutoff `y`, third-term coefficients on the first factor, and constant-one
coefficients on the second.
-/
noncomputable def vaughanTwistedSumThreeLargeDyadicBlock
    (U V : ℝ) (x y q alpha : ℕ)
    (chi : DirichletCharacter ℂ q) : ℂ :=
  bilinearProductCutoffSum y q chi
    (vaughanThirdLargeDyadicIndices U V x alpha)
    (vaughanThirdLargeDyadicRIndices x alpha)
    (fun t ↦ ((vaughanThirdCoefficient U V t : ℝ) : ℂ))
    (fun _ ↦ 1)

theorem vaughanTwistedSumThreeLarge_eq_sum_dyadicBlocks
    {U V : ℝ} (hU : 1 ≤ U) (_hV : 1 ≤ V)
    {x y q : ℕ} (hy : y ≤ x)
    (chi : DirichletCharacter ℂ q) :
    vaughanTwistedSumThreeLarge U V y q chi =
      ∑ alpha ∈ vaughanThirdLargeDyadicExponents U V x,
        vaughanTwistedSumThreeLargeDyadicBlock U V x y q alpha chi := by
  let f : ℕ → ℂ := fun t ↦
    ((vaughanThirdCoefficient U V t : ℝ) : ℂ) * chi t *
      dirichletCharacterIntervalSum 1 (y / t) q chi
  have hsupport : ∀ t ∈ vaughanThirdLargeIndices U V y,
      2 ≤ t ∧ t ≤ ⌊U * V⌋₊ := by
    intro t ht
    rcases Finset.mem_filter.mp ht with ⟨htIcc, htU, htUV⟩
    have htOneReal : (1 : ℝ) < t := hU.trans_lt htU
    have htOne : 1 < t := by exact_mod_cast htOneReal
    exact ⟨by omega, Nat.le_floor htUV⟩
  have hactive_of_mem {alpha t : ℕ}
      (ht : t ∈ vaughanThirdLargeIndices U V y)
      (htBlock : t ∈ dyadicBlock alpha) :
      alpha ∈ vaughanThirdLargeDyadicExponents U V x := by
    rcases Finset.mem_filter.mp ht with ⟨htIcc, htU, htUV⟩
    have htTwo := (hsupport t ht).1
    have htFloor := (hsupport t ht).2
    have hlog := (mem_dyadicBlock_iff_log_pred_eq htTwo).mp htBlock
    have hpredLe : t - 1 ≤ ⌊U * V⌋₊ := by omega
    have hlogLe : Nat.log 2 (t - 1) ≤ Nat.log 2 ⌊U * V⌋₊ :=
      Nat.log_mono_right hpredLe
    have halphaRange : alpha ∈ dyadicExponentRange ⌊U * V⌋₊ := by
      rw [dyadicExponentRange, Finset.mem_range]
      rw [hlog] at hlogLe
      exact Nat.lt_succ_of_le hlogLe
    have htBlockBounds := Finset.mem_Ioc.mp htBlock
    have htUpper : t ≤ 2 * 2 ^ alpha := by
      simpa only [pow_succ, Nat.succ_eq_add_one, Nat.mul_comm] using
        htBlockBounds.2
    have hMltTReal : ((2 ^ alpha : ℕ) : ℝ) < t := by
      exact_mod_cast htBlockBounds.1
    have htUpperReal : (t : ℝ) ≤ 2 * (2 ^ alpha : ℕ) := by
      exact_mod_cast htUpper
    rw [vaughanThirdLargeDyadicExponents, Finset.mem_filter]
    refine ⟨halphaRange, ?_⟩
    dsimp only
    refine ⟨by linarith, hMltTReal.le.trans htUV, ?_⟩
    exact htBlockBounds.1.trans_le ((Finset.mem_Icc.mp htIcc).2.trans hy)
  have hactiveSubset :
      vaughanThirdLargeDyadicExponents U V x ⊆
        dyadicExponentRange ⌊U * V⌋₊ := by
    intro alpha halpha
    exact (Finset.mem_filter.mp
      (by simpa only [vaughanThirdLargeDyadicExponents] using halpha)).1
  have hblock_eq (alpha : ℕ) :
      (∑ t ∈ (vaughanThirdLargeIndices U V y).filter
          (fun t ↦ t ∈ dyadicBlock alpha), f t) =
        vaughanTwistedSumThreeLargeDyadicBlock U V x y q alpha chi := by
    let M := 2 ^ alpha
    let sm := vaughanThirdLargeDyadicIndices U V x alpha
    let sy := (vaughanThirdLargeIndices U V y).filter
      (fun t ↦ t ∈ dyadicBlock alpha)
    let sn := vaughanThirdLargeDyadicRIndices x alpha
    have hsySubset : sy ⊆ sm := by
      intro t ht
      rcases Finset.mem_filter.mp ht with ⟨htLarge, htBlock⟩
      rcases Finset.mem_filter.mp htLarge with ⟨htIcc, htCutoffs⟩
      change t ∈ vaughanThirdLargeIndices U V x ∩ dyadicBlock alpha
      rw [Finset.mem_inter]
      refine ⟨Finset.mem_filter.mpr ⟨?_, htCutoffs⟩, htBlock⟩
      exact Finset.mem_Icc.mpr
        ⟨(Finset.mem_Icc.mp htIcc).1, (Finset.mem_Icc.mp htIcc).2.trans hy⟩
    have hinner (t : ℕ) (ht : t ∈ sm) :
        sn.filter (fun r ↦ t * r ≤ y) = Finset.Icc 1 (y / t) := by
      rcases Finset.mem_inter.mp
        (by simpa only [sm, vaughanThirdLargeDyadicIndices] using ht) with
        ⟨htLarge, htBlock⟩
      have htPos : 0 < t := (Finset.mem_Icc.mp
        (Finset.mem_filter.mp htLarge).1).1
      have hMPos : 0 < M := by
        dsimp only [M]
        positivity
      have hMltT : M < t := (Finset.mem_Ioc.mp
        (by simpa only [M, dyadicBlock] using htBlock)).1
      ext r
      simp only [Finset.mem_filter, Finset.mem_Icc, sn,
        vaughanThirdLargeDyadicRIndices]
      constructor
      · rintro ⟨⟨hrPos, _hrX⟩, htr⟩
        refine ⟨hrPos, ?_⟩
        exact (Nat.le_div_iff_mul_le htPos).mpr
          (by simpa only [Nat.mul_comm] using htr)
      · rintro ⟨hrPos, hry⟩
        have htr : t * r ≤ y := by
          simpa only [Nat.mul_comm] using
            (Nat.le_div_iff_mul_le htPos).mp hry
        have hMr : M * r ≤ x := by
          calc
            M * r ≤ t * r := Nat.mul_le_mul_right r hMltT.le
            _ ≤ y := htr
            _ ≤ x := hy
        refine ⟨⟨hrPos, ?_⟩, htr⟩
        exact (Nat.le_div_iff_mul_le hMPos).mpr
          (by simpa only [M, Nat.mul_comm] using hMr)
    have hsumInner (t : ℕ) (ht : t ∈ sm) :
        (∑ r ∈ sn.filter (fun r ↦ t * r ≤ y),
          ((vaughanThirdCoefficient U V t : ℝ) : ℂ) * 1 * chi (t * r)) =
          f t := by
      rw [hinner t ht]
      simp only [f, dirichletCharacterIntervalSum, mul_one, Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro r _hr
      rw [map_mul]
      ring
    have hsumSubset :
        (∑ t ∈ sm, f t) = ∑ t ∈ sy, f t := by
      symm
      apply Finset.sum_subset hsySubset
      intro t htSm htNotSy
      rcases Finset.mem_inter.mp
        (by simpa only [sm, vaughanThirdLargeDyadicIndices] using htSm) with
        ⟨htLarge, htBlock⟩
      have htNotLarge : t ∉ vaughanThirdLargeIndices U V y := by
        intro htLargeY
        exact htNotSy (Finset.mem_filter.mpr ⟨htLargeY, htBlock⟩)
      have hyt : y < t := by
        by_contra hnot
        apply htNotLarge
        rcases Finset.mem_filter.mp htLarge with ⟨htIcc, htCutoffs⟩
        exact Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr
          ⟨(Finset.mem_Icc.mp htIcc).1, Nat.le_of_not_gt hnot⟩, htCutoffs⟩
      simp only [f, dirichletCharacterIntervalSum, Nat.div_eq_of_lt hyt]
      simp
    symm
    calc
      vaughanTwistedSumThreeLargeDyadicBlock U V x y q alpha chi =
          ∑ t ∈ sm, ∑ r ∈ sn.filter (fun r ↦ t * r ≤ y),
            ((vaughanThirdCoefficient U V t : ℝ) : ℂ) * 1 * chi (t * r) := by
        rfl
      _ = ∑ t ∈ sm, f t := by
        apply Finset.sum_congr rfl
        intro t ht
        exact hsumInner t ht
      _ = ∑ t ∈ sy, f t := hsumSubset
      _ = ∑ t ∈ (vaughanThirdLargeIndices U V y).filter
          (fun t ↦ t ∈ dyadicBlock alpha), f t := rfl
  change (∑ t ∈ vaughanThirdLargeIndices U V y, f t) = _
  calc
    (∑ t ∈ vaughanThirdLargeIndices U V y, f t) =
        ∑ alpha ∈ dyadicExponentRange ⌊U * V⌋₊,
          ∑ t ∈ (vaughanThirdLargeIndices U V y).filter
            (fun t ↦ t ∈ dyadicBlock alpha), f t :=
      sum_eq_sum_dyadicBlocks (vaughanThirdLargeIndices U V y) hsupport f
    _ = ∑ alpha ∈ vaughanThirdLargeDyadicExponents U V x,
        ∑ t ∈ (vaughanThirdLargeIndices U V y).filter
          (fun t ↦ t ∈ dyadicBlock alpha), f t := by
      symm
      apply Finset.sum_subset hactiveSubset
      intro alpha halphaRange halphaNotActive
      apply Finset.sum_eq_zero
      intro t ht
      rcases Finset.mem_filter.mp ht with ⟨htLarge, htBlock⟩
      exact False.elim (halphaNotActive (hactive_of_mem htLarge htBlock))
    _ = ∑ alpha ∈ vaughanThirdLargeDyadicExponents U V x,
        vaughanTwistedSumThreeLargeDyadicBlock U V x y q alpha chi := by
      apply Finset.sum_congr rfl
      intro alpha _halpha
      exact hblock_eq alpha

/--
The maximal norm of a large-third dyadic bilinear sum over cutoffs up to `2 * M * (x / M)`,
where `M = 2 ^ alpha`. The supports remain those determined by `x` and the block.
-/
noncomputable def vaughanThirdLargeDyadicBlockMaximum
    (U V : ℝ) (x q alpha : ℕ)
    (chi : DirichletCharacter ℂ q) : ℝ :=
  let M := 2 ^ alpha
  let R := x / M
  bilinearProductCutoffMaximum ((M + M) * R) q chi
    (vaughanThirdLargeDyadicIndices U V x alpha)
    (vaughanThirdLargeDyadicRIndices x alpha)
    (fun t ↦ ((vaughanThirdCoefficient U V t : ℝ) : ℂ))
    (fun _ ↦ 1)

theorem norm_vaughanTwistedSumThreeLargeDyadicBlock_le_maximum
    {U V : ℝ} {x y q alpha : ℕ}
    (halpha : alpha ∈ vaughanThirdLargeDyadicExponents U V x)
    (hy : y ∈ Finset.Icc 1 x)
    (chi : DirichletCharacter ℂ q) :
    ‖vaughanTwistedSumThreeLargeDyadicBlock U V x y q alpha chi‖ ≤
      vaughanThirdLargeDyadicBlockMaximum U V x q alpha chi := by
  have hMlt : 2 ^ alpha < x := by
    rcases Finset.mem_filter.mp halpha with ⟨_halphaRange, halphaBounds⟩
    dsimp only at halphaBounds
    exact halphaBounds.2.2
  have hyCap : y ∈
      Finset.Icc 1 ((2 ^ alpha + 2 ^ alpha) * (x / 2 ^ alpha)) :=
    Finset.mem_Icc.mpr ⟨(Finset.mem_Icc.mp hy).1,
      (Finset.mem_Icc.mp hy).2.trans
        (le_two_mul_pow_two_mul_div_of_pow_two_lt hMlt)⟩
  simpa only [vaughanTwistedSumThreeLargeDyadicBlock,
      vaughanThirdLargeDyadicBlockMaximum] using
    norm_bilinearProductCutoffSum_le_maximum
      ((2 ^ alpha + 2 ^ alpha) * (x / 2 ^ alpha)) q chi
      (vaughanThirdLargeDyadicIndices U V x alpha)
      (vaughanThirdLargeDyadicRIndices x alpha)
      (fun t ↦ ((vaughanThirdCoefficient U V t : ℝ) : ℂ))
      (fun _ ↦ (1 : ℂ)) hyCap

theorem vaughanTwistedSumThreeLargeEndpointMaximum_le_sum_dyadicBlockMaximum
    {U V : ℝ} (hU : 1 ≤ U) (hV : 1 ≤ V)
    {x q : ℕ} (hx : 1 ≤ x)
    (chi : DirichletCharacter ℂ q) :
    vaughanTwistedSumThreeLargeEndpointMaximum U V x q chi ≤
      ∑ alpha ∈ vaughanThirdLargeDyadicExponents U V x,
        vaughanThirdLargeDyadicBlockMaximum U V x q alpha chi := by
  rw [vaughanTwistedSumThreeLargeEndpointMaximum, dite_eq_left hx]
  apply Finset.sup'_le
  intro y hy
  rw [vaughanTwistedSumThreeLarge_eq_sum_dyadicBlocks
    hU hV (Finset.mem_Icc.mp hy).2 chi]
  calc
    ‖∑ alpha ∈ vaughanThirdLargeDyadicExponents U V x,
        vaughanTwistedSumThreeLargeDyadicBlock U V x y q alpha chi‖ ≤
        ∑ alpha ∈ vaughanThirdLargeDyadicExponents U V x,
          ‖vaughanTwistedSumThreeLargeDyadicBlock U V x y q alpha chi‖ :=
      norm_sum_le _ _
    _ ≤ ∑ alpha ∈ vaughanThirdLargeDyadicExponents U V x,
        vaughanThirdLargeDyadicBlockMaximum U V x q alpha chi := by
      apply Finset.sum_le_sum
      intro alpha halpha
      exact norm_vaughanTwistedSumThreeLargeDyadicBlock_le_maximum
        halpha hy chi

/--
The negative fourth Vaughan contribution in dyadic block `alpha`, with product cutoff `y`, von
Mangoldt coefficients on the first factor, and truncated Möbius divisor coefficients on the
second.
-/
noncomputable def vaughanTwistedSumFourDyadicBlock
    (U V : ℝ) (x y q alpha : ℕ)
    (chi : DirichletCharacter ℂ q) : ℂ :=
  -bilinearProductCutoffSum y q chi
    (vaughanFourthDyadicMIndices U V x alpha)
    (vaughanFourthDyadicKIndices V x alpha)
    (fun m ↦ ((ArithmeticFunction.vonMangoldt m : ℝ) : ℂ))
    (fun k ↦ ((vaughanFourthCoefficient V k : ℝ) : ℂ))

theorem vaughanTwistedSumFour_eq_sum_dyadicBlocks
    {U V : ℝ} (hU : 1 ≤ U) (hV : 1 ≤ V)
    {x y q : ℕ} (hy : y ≤ x)
    (chi : DirichletCharacter ℂ q) :
    vaughanTwistedSumFour U V y q chi =
      ∑ alpha ∈ vaughanFourthDyadicExponents U V x,
        vaughanTwistedSumFourDyadicBlock U V x y q alpha chi := by
  let source : Finset ℕ :=
    (Finset.Icc 1 y).filter (fun m : ℕ ↦ U < (m : ℝ))
  let s : Finset ℕ :=
    (Finset.Icc 1 y).filter (fun m : ℕ ↦
      U < (m : ℝ) ∧ (m : ℝ) ≤ (x : ℝ) / V)
  let f : ℕ → ℕ → ℂ := fun m k ↦
    ((ArithmeticFunction.vonMangoldt m : ℝ) : ℂ) *
      ((vaughanFourthCoefficient V k : ℝ) : ℂ) * chi (m * k)
  let g : ℕ → ℂ := fun m ↦
    ∑ k ∈ (Finset.Icc 1 (y / m)).filter
      (fun k : ℕ ↦ V < (k : ℝ)), f m k
  have hVpos : 0 < V := zero_lt_one.trans_le hV
  have hs_eq :
      s = source.filter (fun m : ℕ ↦ (m : ℝ) ≤ (x : ℝ) / V) := by
    ext m
    simp only [s, source, Finset.mem_filter]
    tauto
  have hsource : (∑ m ∈ source, g m) = ∑ m ∈ s, g m := by
    rw [hs_eq]
    symm
    apply Finset.sum_filter_of_ne
    intro m hm hgm
    by_contra hmCap
    have hmPos : 0 < m := (Finset.mem_Icc.mp
      (Finset.mem_filter.mp (by simpa only [source] using hm)).1).1
    have hzero : g m = 0 := by
      apply Finset.sum_eq_zero
      intro k hk
      rcases Finset.mem_filter.mp hk with ⟨hkIcc, hkV⟩
      have hmk : m * k ≤ y := by
        simpa only [Nat.mul_comm] using
          (Nat.le_div_iff_mul_le hmPos).mp (Finset.mem_Icc.mp hkIcc).2
      have hmkReal : ((m * k : ℕ) : ℝ) ≤ (x : ℝ) := by
        exact_mod_cast hmk.trans hy
      have hmV : (m : ℝ) * V < ((m * k : ℕ) : ℝ) := by
        rw [Nat.cast_mul]
        exact mul_lt_mul_of_pos_left hkV (Nat.cast_pos.mpr hmPos)
      have hmLt : (m : ℝ) < (x : ℝ) / V :=
        (lt_div_iff₀ hVpos).2 (hmV.trans_le hmkReal)
      exact False.elim (hmCap hmLt.le)
    exact hgm hzero
  have hsupport : ∀ m ∈ s,
      2 ≤ m ∧ m ≤ ⌊(x : ℝ) / V⌋₊ := by
    intro m hm
    rcases Finset.mem_filter.mp (by simpa only [s] using hm) with
      ⟨hmIcc, hmU, hmCap⟩
    have hmOneReal : (1 : ℝ) < m := hU.trans_lt hmU
    have hmOne : 1 < m := by exact_mod_cast hmOneReal
    exact ⟨by omega, Nat.le_floor hmCap⟩
  have hactive_of_mem {alpha m : ℕ}
      (hm : m ∈ s) (hmBlock : m ∈ dyadicBlock alpha) :
      alpha ∈ vaughanFourthDyadicExponents U V x := by
    rcases Finset.mem_filter.mp (by simpa only [s] using hm) with
      ⟨_hmIcc, hmU, hmCap⟩
    have hmTwo := (hsupport m hm).1
    have hmFloor := (hsupport m hm).2
    have hlog := (mem_dyadicBlock_iff_log_pred_eq hmTwo).mp hmBlock
    have hpredLe : m - 1 ≤ ⌊(x : ℝ) / V⌋₊ := by omega
    have hlogLe :
        Nat.log 2 (m - 1) ≤ Nat.log 2 ⌊(x : ℝ) / V⌋₊ :=
      Nat.log_mono_right hpredLe
    have halphaRange :
        alpha ∈ dyadicExponentRange ⌊(x : ℝ) / V⌋₊ := by
      rw [dyadicExponentRange, Finset.mem_range]
      rw [hlog] at hlogLe
      exact Nat.lt_succ_of_le hlogLe
    have hmBlockBounds := Finset.mem_Ioc.mp hmBlock
    have hmUpper : m ≤ 2 * 2 ^ alpha := by
      simpa only [dyadicBlock, pow_succ, Nat.succ_eq_add_one,
        Nat.mul_comm] using hmBlockBounds.2
    have hMltMReal : ((2 ^ alpha : ℕ) : ℝ) < m := by
      exact_mod_cast hmBlockBounds.1
    have hmUpperReal : (m : ℝ) ≤ 2 * (2 ^ alpha : ℕ) := by
      exact_mod_cast hmUpper
    rw [vaughanFourthDyadicExponents, Finset.mem_filter]
    refine ⟨halphaRange, ?_⟩
    dsimp only
    exact ⟨by linarith, hMltMReal.trans_le hmCap⟩
  have hactiveSubset :
      vaughanFourthDyadicExponents U V x ⊆
        dyadicExponentRange ⌊(x : ℝ) / V⌋₊ := by
    intro alpha halpha
    exact (Finset.mem_filter.mp
      (by simpa only [vaughanFourthDyadicExponents] using halpha)).1
  have hblock_eq (alpha : ℕ) :
      -(∑ m ∈ s.filter (fun m ↦ m ∈ dyadicBlock alpha), g m) =
        vaughanTwistedSumFourDyadicBlock U V x y q alpha chi := by
    let M : ℕ := 2 ^ alpha
    let sm := vaughanFourthDyadicMIndices U V x alpha
    let sy := s.filter (fun m ↦ m ∈ dyadicBlock alpha)
    let sn := vaughanFourthDyadicKIndices V x alpha
    have hsySubset : sy ⊆ sm := by
      intro m hm
      rcases Finset.mem_filter.mp hm with ⟨hmS, hmBlock⟩
      rcases Finset.mem_filter.mp (by simpa only [s] using hmS) with
        ⟨_hmIcc, hmCuts⟩
      exact Finset.mem_filter.mpr ⟨hmBlock, hmCuts⟩
    have hinner (m : ℕ) (hm : m ∈ sm) :
        sn.filter (fun k ↦ m * k ≤ y) =
          (Finset.Icc 1 (y / m)).filter (fun k : ℕ ↦ V < (k : ℝ)) := by
      rcases Finset.mem_filter.mp
        (by simpa only [sm, vaughanFourthDyadicMIndices] using hm) with
        ⟨hmBlock, _hmCuts⟩
      have hMltM : M < m := (Finset.mem_Ioc.mp
        (by simpa only [M, dyadicBlock] using hmBlock)).1
      have hmPos : 0 < m := by
        have hMPos : 0 < M := by
          dsimp only [M]
          positivity
        exact hMPos.trans hMltM
      have hMPos : 0 < M := by
        dsimp only [M]
        positivity
      ext k
      simp only [Finset.mem_filter, Finset.mem_Ioc, Finset.mem_Icc,
        sn, vaughanFourthDyadicKIndices]
      constructor
      · rintro ⟨⟨⟨hkPos, _hkX⟩, hkV⟩, hmk⟩
        refine ⟨⟨hkPos, ?_⟩, hkV⟩
        exact (Nat.le_div_iff_mul_le hmPos).mpr
          (by simpa only [Nat.mul_comm] using hmk)
      · rintro ⟨⟨hkPos, hky⟩, hkV⟩
        have hmk : m * k ≤ y := by
          simpa only [Nat.mul_comm] using
            (Nat.le_div_iff_mul_le hmPos).mp hky
        have hMk : M * k ≤ x := by
          calc
            M * k ≤ m * k := Nat.mul_le_mul_right k hMltM.le
            _ ≤ y := hmk
            _ ≤ x := hy
        refine ⟨⟨⟨hkPos, ?_⟩, hkV⟩, hmk⟩
        exact (Nat.le_div_iff_mul_le hMPos).mpr
          (by simpa only [M, Nat.mul_comm] using hMk)
    have hsumInner (m : ℕ) (hm : m ∈ sm) :
        (∑ k ∈ sn.filter (fun k ↦ m * k ≤ y), f m k) = g m := by
      rw [hinner m hm]
    have hsumSubset : (∑ m ∈ sm, g m) = ∑ m ∈ sy, g m := by
      symm
      apply Finset.sum_subset hsySubset
      intro m hmSm hmNotSy
      rcases Finset.mem_filter.mp
        (by simpa only [sm, vaughanFourthDyadicMIndices] using hmSm) with
        ⟨hmBlock, hmCuts⟩
      have hmNotS : m ∉ s := by
        intro hmS
        exact hmNotSy (Finset.mem_filter.mpr ⟨hmS, hmBlock⟩)
      have hym : y < m := by
        by_contra hnot
        apply hmNotS
        exact Finset.mem_filter.mpr
          ⟨Finset.mem_Icc.mpr
            ⟨by
              have hMPos : 0 < (2 ^ alpha : ℕ) := by positivity
              exact hMPos.trans (Finset.mem_Ioc.mp
                (by simpa only [dyadicBlock] using hmBlock)).1,
              Nat.le_of_not_gt hnot⟩,
            hmCuts⟩
      simp only [g, Nat.div_eq_of_lt hym]
      simp
    symm
    calc
      vaughanTwistedSumFourDyadicBlock U V x y q alpha chi =
          -(∑ m ∈ sm, ∑ k ∈ sn.filter (fun k ↦ m * k ≤ y), f m k) := by
        rfl
      _ = -(∑ m ∈ sm, g m) := by
        apply congrArg Neg.neg
        apply Finset.sum_congr rfl
        intro m hm
        exact hsumInner m hm
      _ = -(∑ m ∈ sy, g m) := congrArg Neg.neg hsumSubset
      _ = -(∑ m ∈ s.filter (fun m ↦ m ∈ dyadicBlock alpha), g m) := rfl
  rw [vaughanTwistedSumFour_eq_nestedFactorSum]
  change -(∑ m ∈ source, g m) = _
  rw [hsource]
  calc
    -(∑ m ∈ s, g m) =
        ∑ alpha ∈ dyadicExponentRange ⌊(x : ℝ) / V⌋₊,
          -(∑ m ∈ s.filter (fun m ↦ m ∈ dyadicBlock alpha), g m) := by
      rw [sum_eq_sum_dyadicBlocks s hsupport g]
      rw [← Finset.sum_neg_distrib]
    _ = ∑ alpha ∈ vaughanFourthDyadicExponents U V x,
        -(∑ m ∈ s.filter (fun m ↦ m ∈ dyadicBlock alpha), g m) := by
      symm
      apply Finset.sum_subset hactiveSubset
      intro alpha halphaRange halphaNotActive
      apply neg_eq_zero.mpr
      apply Finset.sum_eq_zero
      intro m hm
      rcases Finset.mem_filter.mp hm with ⟨hmS, hmBlock⟩
      exact False.elim (halphaNotActive (hactive_of_mem hmS hmBlock))
    _ = ∑ alpha ∈ vaughanFourthDyadicExponents U V x,
        vaughanTwistedSumFourDyadicBlock U V x y q alpha chi := by
      apply Finset.sum_congr rfl
      intro alpha _halpha
      exact hblock_eq alpha

/--
The maximal norm of a fourth-term dyadic bilinear sum over cutoffs up to `2 * M * (x / M)`,
where `M = 2 ^ alpha`. The overall minus sign is omitted because it does not affect the norm.
-/
noncomputable def vaughanFourthDyadicBlockMaximum
    (U V : ℝ) (x q alpha : ℕ)
    (chi : DirichletCharacter ℂ q) : ℝ :=
  let M := 2 ^ alpha
  let R := x / M
  bilinearProductCutoffMaximum ((M + M) * R) q chi
    (vaughanFourthDyadicMIndices U V x alpha)
    (vaughanFourthDyadicKIndices V x alpha)
    (fun m ↦ ((ArithmeticFunction.vonMangoldt m : ℝ) : ℂ))
    (fun k ↦ ((vaughanFourthCoefficient V k : ℝ) : ℂ))

theorem norm_vaughanTwistedSumFourDyadicBlock_le_maximum
    {U V : ℝ} {x y q alpha : ℕ}
    (hV : 1 ≤ V)
    (halpha : alpha ∈ vaughanFourthDyadicExponents U V x)
    (hy : y ∈ Finset.Icc 1 x)
    (chi : DirichletCharacter ℂ q) :
    ‖vaughanTwistedSumFourDyadicBlock U V x y q alpha chi‖ ≤
      vaughanFourthDyadicBlockMaximum U V x q alpha chi := by
  have hMltReal : ((2 ^ alpha : ℕ) : ℝ) < (x : ℝ) := by
    rcases Finset.mem_filter.mp halpha with ⟨_halphaRange, halphaBounds⟩
    dsimp only at halphaBounds
    have hVpos : 0 < V := lt_of_lt_of_le zero_lt_one hV
    calc
      ((2 ^ alpha : ℕ) : ℝ) < (x : ℝ) / V := halphaBounds.2
      _ ≤ (x : ℝ) := by
        rw [div_le_iff₀ hVpos]
        nlinarith
  have hMlt : 2 ^ alpha < x := by exact_mod_cast hMltReal
  have hyCap : y ∈
      Finset.Icc 1 ((2 ^ alpha + 2 ^ alpha) * (x / 2 ^ alpha)) :=
    Finset.mem_Icc.mpr ⟨(Finset.mem_Icc.mp hy).1,
      (Finset.mem_Icc.mp hy).2.trans
        (le_two_mul_pow_two_mul_div_of_pow_two_lt hMlt)⟩
  simpa only [vaughanTwistedSumFourDyadicBlock,
      vaughanFourthDyadicBlockMaximum, norm_neg] using
    norm_bilinearProductCutoffSum_le_maximum
      ((2 ^ alpha + 2 ^ alpha) * (x / 2 ^ alpha)) q chi
      (vaughanFourthDyadicMIndices U V x alpha)
      (vaughanFourthDyadicKIndices V x alpha)
      (fun m ↦ ((ArithmeticFunction.vonMangoldt m : ℝ) : ℂ))
      (fun k ↦ ((vaughanFourthCoefficient V k : ℝ) : ℂ)) hyCap

theorem vaughanTwistedSumFourEndpointMaximum_le_sum_dyadicBlockMaximum
    {U V : ℝ} (hU : 1 ≤ U) (hV : 1 ≤ V)
    {x q : ℕ} (hx : 1 ≤ x)
    (chi : DirichletCharacter ℂ q) :
    vaughanTwistedSumFourEndpointMaximum U V x q chi ≤
      ∑ alpha ∈ vaughanFourthDyadicExponents U V x,
        vaughanFourthDyadicBlockMaximum U V x q alpha chi := by
  rw [vaughanTwistedSumFourEndpointMaximum, dite_eq_left hx]
  apply Finset.sup'_le
  intro y hy
  rw [vaughanTwistedSumFour_eq_sum_dyadicBlocks
    hU hV (Finset.mem_Icc.mp hy).2 chi]
  calc
    ‖∑ alpha ∈ vaughanFourthDyadicExponents U V x,
        vaughanTwistedSumFourDyadicBlock U V x y q alpha chi‖ ≤
        ∑ alpha ∈ vaughanFourthDyadicExponents U V x,
          ‖vaughanTwistedSumFourDyadicBlock U V x y q alpha chi‖ :=
      norm_sum_le _ _
    _ ≤ ∑ alpha ∈ vaughanFourthDyadicExponents U V x,
        vaughanFourthDyadicBlockMaximum U V x q alpha chi := by
      apply Finset.sum_le_sum
      intro alpha halpha
      exact norm_vaughanTwistedSumFourDyadicBlock_le_maximum
        hV halpha hy chi

/--
The coefficient `2 * √2 * √A * akbaryHambrookBilinearConstant / √3`
in the fourth-term dyadic estimate,
retaining dependence on the Chebyshev-bound parameter `A`.
-/
noncomputable def vaughanFourthBlockConstant (A : ℝ) : ℝ :=
  2 * Real.sqrt 2 * Real.sqrt A * akbaryHambrookBilinearConstant / Real.sqrt 3

theorem sum_weighted_vaughanFourthDyadicBlockMaximum_le_of_psi
    {A U V : ℝ} {x Q alpha : ℕ}
    (hA : 0 ≤ A)
    (hpsi : ∀ z : ℝ, 0 ≤ z → Chebyshev.psi z ≤ A * z)
    (_hx : 1 ≤ x) (_hU : 1 ≤ U) (hV : 1 ≤ V)
    (halpha : alpha ∈ vaughanFourthDyadicExponents U V x) :
    (∑ q ∈ Finset.Ioc 0 Q,
      (q : ℝ) / (q.totient : ℝ) *
        ∑ chi : primitiveCharacters q,
          vaughanFourthDyadicBlockMaximum U V x q alpha chi) ≤
      vaughanFourthBlockConstant A *
        ((x : ℝ) +
          (Q : ℝ) * Real.sqrt ((x : ℝ) * (2 ^ alpha : ℕ)) +
          (Q : ℝ) * (x : ℝ) /
            Real.sqrt ((2 ^ alpha : ℕ) : ℝ) +
          (Q : ℝ) ^ 2 * Real.sqrt (x : ℝ)) *
        Real.sqrt (Real.log (2 * ((2 ^ alpha : ℕ) : ℝ))) *
        Real.log (Real.exp 3 * V) * Real.log (4 * (x : ℝ)) := by
  classical
  let M : ℕ := 2 ^ alpha
  let R : ℕ := x / M
  have hM : 0 < M := by positivity
  have hMReal : 0 < (M : ℝ) := by exact_mod_cast hM
  rcases Finset.mem_filter.mp halpha with
    ⟨_halphaRange, _hMlower, hMupper⟩
  change (M : ℝ) < (x : ℝ) / V at hMupper
  have hVpos : 0 < V := zero_lt_one.trans_le hV
  have hQuotientLeX : (x : ℝ) / V ≤ (x : ℝ) := by
    apply (div_le_iff₀ hVpos).2
    nlinarith [show (0 : ℝ) ≤ (x : ℝ) by positivity]
  have hMltReal : (M : ℝ) < (x : ℝ) := hMupper.trans_le hQuotientLeX
  have hMlt : M < x := by exact_mod_cast hMltReal
  have hR : 0 < R := Nat.div_pos hMlt.le hM
  have hsm : vaughanFourthDyadicMIndices U V x alpha ⊆
      Finset.Ioc M (M + M) := by
    intro m hm
    have hmBlock := (Finset.mem_filter.mp hm).1
    rw [dyadicBlock, Finset.mem_Ioc] at hmBlock
    rw [Finset.mem_Ioc]
    constructor
    · simpa only [M] using hmBlock.1
    · calc
        m ≤ 2 ^ (alpha + 1) := hmBlock.2
        _ = M + M := by
          rw [pow_succ]
          dsimp only [M]
          omega
  have hsn : vaughanFourthDyadicKIndices V x alpha ⊆
      Finset.Ioc 0 (0 + R) := by
    intro k hk
    have hkIoc := (Finset.mem_filter.mp hk).1
    rw [Finset.mem_Ioc]
    constructor
    · exact (Finset.mem_Ioc.mp hkIoc).1
    · simpa only [vaughanFourthDyadicKIndices, R, M, zero_add] using
        (Finset.mem_Ioc.mp hkIoc).2
  have hblock :=
    sum_weighted_bilinearProductCutoffMaximum_subset_Ioc_le_akbaryHambrookBilinearConstant
      Q M M 0 R hM hR
      (vaughanFourthDyadicMIndices U V x alpha)
      (vaughanFourthDyadicKIndices V x alpha)
      hsm hsn
      (fun m ↦ (ArithmeticFunction.vonMangoldt m : ℂ))
      (fun k ↦ (vaughanFourthCoefficient V k : ℂ))
  have hraw :
      (∑ q ∈ Finset.Ioc 0 Q,
        (q : ℝ) / (q.totient : ℝ) *
          ∑ chi : primitiveCharacters q,
            vaughanFourthDyadicBlockMaximum U V x q alpha chi) ≤
        akbaryHambrookBilinearConstant *
          Real.sqrt ((M : ℝ) + (Q : ℝ) ^ 2) *
          Real.sqrt ((R : ℝ) + (Q : ℝ) ^ 2) *
          Real.sqrt (∑ m ∈ vaughanFourthDyadicMIndices U V x alpha,
            ‖(ArithmeticFunction.vonMangoldt m : ℂ)‖ ^ 2) *
          Real.sqrt (∑ k ∈ vaughanFourthDyadicKIndices V x alpha,
            ‖(vaughanFourthCoefficient V k : ℂ)‖ ^ 2) *
          Real.log (2 * (((M + M) * R : ℕ) : ℝ)) := by
    simpa only [vaughanFourthDyadicBlockMaximum, M, R, zero_add] using hblock
  have hmEnergy :=
    sqrt_sum_norm_sq_vonMangoldt_vaughanFourthDyadic_le_of_psi
      (A := A) (U := U) (V := V) hA hpsi x alpha
  have hkEnergy :=
    sqrt_sum_norm_sq_vaughanFourthCoefficient_dyadic_le
      (V := V) (x := x) (alpha := alpha) hV
  have hMRNat : M * R ≤ x := by
    simpa only [R, Nat.mul_comm] using Nat.div_mul_le_self x M
  have hMR : (M : ℝ) * (R : ℝ) ≤ (x : ℝ) := by exact_mod_cast hMRNat
  have hcap :
      2 * ((((M + M) * R : ℕ) : ℝ)) ≤ 4 * (x : ℝ) := by
    norm_num only [Nat.cast_mul, Nat.cast_add]
    nlinarith
  have hlogCap :
      Real.log (2 * ((((M + M) * R : ℕ) : ℝ))) ≤
        Real.log (4 * (x : ℝ)) :=
    Real.log_le_log (by positivity) hcap
  have hRle : (R : ℝ) ≤ (x : ℝ) / (M : ℝ) := by
    simpa only [R] using
      (Nat.cast_div_le (α := ℝ) (m := x) (n := M))
  have hsqrtR : Real.sqrt (R : ℝ) ≤
      Real.sqrt ((x : ℝ) / (M : ℝ)) := Real.sqrt_le_sqrt hRle
  have hsqrtAddM :
      Real.sqrt ((M : ℝ) + (Q : ℝ) ^ 2) ≤
        Real.sqrt (M : ℝ) + (Q : ℝ) := by
    simpa only [← Real.sqrt_eq_rpow, Real.sqrt_sq (Nat.cast_nonneg Q)] using
      Real.rpow_add_le_add_rpow (Nat.cast_nonneg M) (sq_nonneg (Q : ℝ))
        (by norm_num : (0 : ℝ) ≤ 1 / 2) (by norm_num)
  have hsqrtAddR :
      Real.sqrt ((R : ℝ) + (Q : ℝ) ^ 2) ≤
        Real.sqrt ((x : ℝ) / (M : ℝ)) + (Q : ℝ) := by
    refine le_trans ?_ (_root_.add_le_add hsqrtR le_rfl)
    simpa only [← Real.sqrt_eq_rpow, Real.sqrt_sq (Nat.cast_nonneg Q)] using
      Real.rpow_add_le_add_rpow (Nat.cast_nonneg R) (sq_nonneg (Q : ℝ))
        (by norm_num : (0 : ℝ) ≤ 1 / 2) (by norm_num)
  have hLogM : 0 ≤ Real.log (2 * (M : ℝ)) :=
    Real.log_nonneg (by exact_mod_cast (show 1 ≤ 2 * M by omega))
  have hLogV : 0 ≤ Real.log (Real.exp 3 * V) := by
    apply Real.log_nonneg
    have hExp : 1 ≤ Real.exp (3 : ℝ) :=
      (Real.one_le_exp_iff).2 (by norm_num)
    nlinarith [mul_pos (Real.exp_pos 3) hVpos]
  have hLogX : 0 ≤ Real.log (4 * (x : ℝ)) :=
    Real.log_nonneg (by exact_mod_cast (show 1 ≤ 4 * x by omega))
  have hLogK : 0 ≤
      Real.log (2 * ((((M + M) * R : ℕ) : ℝ))) :=
    Real.log_nonneg (by
      have hKpos : 0 < (M + M) * R := Nat.mul_pos (by omega) hR
      exact_mod_cast (show 1 ≤ 2 * ((M + M) * R) by omega))
  have hstage :
      (∑ q ∈ Finset.Ioc 0 Q,
        (q : ℝ) / (q.totient : ℝ) *
          ∑ chi : primitiveCharacters q,
            vaughanFourthDyadicBlockMaximum U V x q alpha chi) ≤
        akbaryHambrookBilinearConstant *
          (Real.sqrt (M : ℝ) + (Q : ℝ)) *
          (Real.sqrt ((x : ℝ) / (M : ℝ)) + (Q : ℝ)) *
          (Real.sqrt 2 * Real.sqrt A * Real.sqrt (M : ℝ) *
            Real.sqrt (Real.log (2 * (M : ℝ)))) *
          (2 / Real.sqrt 3 *
            Real.sqrt ((x : ℝ) / (M : ℝ)) *
            Real.log (Real.exp 3 * V)) *
          Real.log (4 * (x : ℝ)) := by
    calc
      _ ≤ akbaryHambrookBilinearConstant *
          Real.sqrt ((M : ℝ) + (Q : ℝ) ^ 2) *
          Real.sqrt ((R : ℝ) + (Q : ℝ) ^ 2) *
          (Real.sqrt 2 * Real.sqrt A * Real.sqrt (M : ℝ) *
            Real.sqrt (Real.log (2 * (M : ℝ)))) *
          (2 / Real.sqrt 3 *
            Real.sqrt ((x : ℝ) / (M : ℝ)) *
            Real.log (Real.exp 3 * V)) *
          Real.log (2 * ((((M + M) * R : ℕ) : ℝ))) := by
        exact hraw.trans (by
          gcongr
          all_goals positivity [akbaryHambrookBilinearConstant_pos])
      _ ≤ _ := by
        gcongr <;> positivity [akbaryHambrookBilinearConstant_pos]
  have hscalar :
      (Real.sqrt (M : ℝ) + (Q : ℝ)) *
          (Real.sqrt ((x : ℝ) / (M : ℝ)) + (Q : ℝ)) *
          Real.sqrt (M : ℝ) * Real.sqrt ((x : ℝ) / (M : ℝ)) =
        (x : ℝ) +
          (Q : ℝ) * Real.sqrt ((x : ℝ) * (M : ℝ)) +
          (Q : ℝ) * (x : ℝ) / Real.sqrt (M : ℝ) +
          (Q : ℝ) ^ 2 * Real.sqrt (x : ℝ) := by
    rw [Real.sqrt_div (Nat.cast_nonneg x), Real.sqrt_mul (Nat.cast_nonneg x)]
    field_simp [Real.sqrt_ne_zero'.2 hMReal]
    ring_nf
    rw [Real.sq_sqrt (Nat.cast_nonneg x)]
  calc
    _ ≤ akbaryHambrookBilinearConstant *
        (Real.sqrt (M : ℝ) + (Q : ℝ)) *
        (Real.sqrt ((x : ℝ) / (M : ℝ)) + (Q : ℝ)) *
        (Real.sqrt 2 * Real.sqrt A * Real.sqrt (M : ℝ) *
          Real.sqrt (Real.log (2 * (M : ℝ)))) *
        (2 / Real.sqrt 3 *
          Real.sqrt ((x : ℝ) / (M : ℝ)) *
          Real.log (Real.exp 3 * V)) *
        Real.log (4 * (x : ℝ)) := hstage
    _ = vaughanFourthBlockConstant A *
        ((x : ℝ) +
          (Q : ℝ) * Real.sqrt ((x : ℝ) * (M : ℝ)) +
          (Q : ℝ) * (x : ℝ) / Real.sqrt (M : ℝ) +
          (Q : ℝ) ^ 2 * Real.sqrt (x : ℝ)) *
        Real.sqrt (Real.log (2 * (M : ℝ))) *
        Real.log (Real.exp 3 * V) * Real.log (4 * (x : ℝ)) := by
      rw [← hscalar]
      unfold vaughanFourthBlockConstant
      ring
    _ = _ := by rfl

theorem sum_weightedPrimitiveVaughanTwistedSumFourEndpointMaximum_le_sum_dyadicBlockMaximum
    {U V : ℝ} {x Q : ℕ}
    (hx : 1 ≤ x) (hU : 1 ≤ U) (hV : 1 ≤ V) :
    (∑ q ∈ Finset.Ioc 0 Q,
      (q : ℝ) / (q.totient : ℝ) *
        ∑ chi : primitiveCharacters q,
          vaughanTwistedSumFourEndpointMaximum U V x q chi.1) ≤
      ∑ alpha ∈ vaughanFourthDyadicExponents U V x,
        ∑ q ∈ Finset.Ioc 0 Q,
          (q : ℝ) / (q.totient : ℝ) *
            ∑ chi : primitiveCharacters q,
              vaughanFourthDyadicBlockMaximum U V x q alpha chi.1 := by
  classical
  rw [Finset.sum_comm]
  refine Finset.sum_le_sum fun q _ ↦ ?_
  rw [← Finset.mul_sum, Finset.sum_comm]
  exact mul_le_mul_of_nonneg_left (Finset.sum_le_sum fun chi _ ↦
    vaughanTwistedSumFourEndpointMaximum_le_sum_dyadicBlockMaximum
      hU hV hx chi.1) (by positivity)

theorem sum_weightedPrimitiveVaughanTwistedSumFourEndpointMaximum_le_of_psi
    {A U V : ℝ} {x Q : ℕ}
    (hA : 0 ≤ A)
    (hpsi : ∀ z : ℝ, 0 ≤ z → Chebyshev.psi z ≤ A * z)
    (hx : 1 ≤ x) (hU : 1 ≤ U) (hV : 1 ≤ V) :
    (∑ q ∈ Finset.Ioc 0 Q,
      (q : ℝ) / (q.totient : ℝ) *
        ∑ chi : primitiveCharacters q,
          vaughanTwistedSumFourEndpointMaximum U V x q chi.1) ≤
      vaughanFourthBlockConstant A / Real.log 2 *
        ((x : ℝ) + (Q : ℝ) * (x : ℝ) / Real.sqrt V +
          Real.sqrt 2 * (Q : ℝ) * (x : ℝ) / Real.sqrt U +
          (Q : ℝ) ^ 2 * Real.sqrt (x : ℝ)) *
        (vaughanFourthScaleLog V x * Real.sqrt (vaughanFourthScaleLog V x)) *
        Real.log (Real.exp 3 * V) * Real.log (4 * (x : ℝ)) := by
  classical
  let scales := vaughanFourthDyadicExponents U V x
  let B : ℝ := (x : ℝ) + (Q : ℝ) * (x : ℝ) / Real.sqrt V +
    Real.sqrt 2 * (Q : ℝ) * (x : ℝ) / Real.sqrt U +
    (Q : ℝ) ^ 2 * Real.sqrt (x : ℝ)
  let L : ℝ := vaughanFourthScaleLog V x
  let Vlog : ℝ := Real.log (Real.exp 3 * V)
  let Xlog : ℝ := Real.log (4 * (x : ℝ))
  let C : ℝ := vaughanFourthBlockConstant A * B * Real.sqrt L * Vlog * Xlog
  have hxReal : 0 < (x : ℝ) := by exact_mod_cast hx
  have hxOneReal : (1 : ℝ) ≤ (x : ℝ) := by exact_mod_cast hx
  have hUpos : 0 < U := zero_lt_one.trans_le hU
  have hVpos : 0 < V := zero_lt_one.trans_le hV
  have hLnonneg : 0 ≤ L :=
    vaughanFourthScaleLog_nonneg V x
  have hVlogPos : 0 < Vlog := by
    dsimp only [Vlog]
    apply Real.log_pos
    have hExp : 1 < Real.exp (3 : ℝ) := (Real.one_lt_exp_iff).2 (by norm_num)
    nlinarith [mul_pos (Real.exp_pos 3) hVpos]
  have hXlogPos : 0 < Xlog := by
    dsimp only [Xlog]
    exact Real.log_pos (by nlinarith [hxOneReal])
  have hBnonneg : 0 ≤ B := by
    dsimp only [B]
    positivity
  have hConstantNonneg : 0 ≤ vaughanFourthBlockConstant A := by
    unfold vaughanFourthBlockConstant
    positivity [akbaryHambrookBilinearConstant_pos]
  have hCnonneg : 0 ≤ C := by
    dsimp only [C]
    positivity
  have hbridge :=
    sum_weightedPrimitiveVaughanTwistedSumFourEndpointMaximum_le_sum_dyadicBlockMaximum
      (U := U) (V := V) (x := x) (Q := Q) hx hU hV
  have hsum :
      (∑ q ∈ Finset.Ioc 0 Q,
        (q : ℝ) / (q.totient : ℝ) *
          ∑ chi : primitiveCharacters q,
            vaughanTwistedSumFourEndpointMaximum U V x q chi.1) ≤
        ∑ _alpha ∈ scales, C := by
    apply hbridge.trans
    apply Finset.sum_le_sum
    intro alpha halpha
    let M : ℕ := 2 ^ alpha
    have hMpos : 0 < M := by positivity
    have hMreal : 0 < (M : ℝ) := by exact_mod_cast hMpos
    rcases Finset.mem_filter.mp halpha with
      ⟨_halphaRange, hMlower, hMupper⟩
    change U / 2 < (M : ℝ) at hMlower
    change (M : ℝ) < (x : ℝ) / V at hMupper
    have hRoot :
        Real.sqrt ((x : ℝ) * (M : ℝ)) ≤
          (x : ℝ) / Real.sqrt V := by
      have hroot' : Real.sqrt ((x : ℝ) * (M : ℝ)) ≤
          Real.sqrt ((x : ℝ) * ((x : ℝ) / V)) := by
        apply Real.sqrt_le_sqrt
        exact mul_le_mul_of_nonneg_left hMupper.le hxReal.le
      have heq : Real.sqrt ((x : ℝ) * ((x : ℝ) / V)) =
          (x : ℝ) / Real.sqrt V := by
        rw [Real.sqrt_mul hxReal.le, Real.sqrt_div hxReal.le]
        rw [← mul_div_assoc, Real.mul_self_sqrt hxReal.le]
      rwa [heq] at hroot'
    have hUtwoM : U ≤ 2 * (M : ℝ) := by linarith
    have hsqrtUle : Real.sqrt U ≤ Real.sqrt 2 * Real.sqrt (M : ℝ) := by
      calc
        Real.sqrt U ≤ Real.sqrt (2 * (M : ℝ)) :=
          Real.sqrt_le_sqrt hUtwoM
        _ = Real.sqrt 2 * Real.sqrt (M : ℝ) := by
          rw [Real.sqrt_mul (by norm_num : (0 : ℝ) ≤ 2)]
    have hsqrtUpos : 0 < Real.sqrt U := Real.sqrt_pos.2 hUpos
    have hsqrtMpos : 0 < Real.sqrt (M : ℝ) := Real.sqrt_pos.2 hMreal
    have hInv : 1 / Real.sqrt (M : ℝ) ≤
        Real.sqrt 2 / Real.sqrt U := by
      apply (div_le_div_iff₀ hsqrtMpos hsqrtUpos).2
      simpa only [one_mul] using hsqrtUle
    have hRootTerm :
        (Q : ℝ) * Real.sqrt ((x : ℝ) * (M : ℝ)) ≤
          (Q : ℝ) * (x : ℝ) / Real.sqrt V := by
      calc
        _ ≤ (Q : ℝ) * ((x : ℝ) / Real.sqrt V) :=
          mul_le_mul_of_nonneg_left hRoot (Nat.cast_nonneg Q)
        _ = _ := by ring
    have hInvTerm :
        (Q : ℝ) * (x : ℝ) / Real.sqrt (M : ℝ) ≤
          Real.sqrt 2 * (Q : ℝ) * (x : ℝ) / Real.sqrt U := by
      calc
        _ = ((Q : ℝ) * (x : ℝ)) * (1 / Real.sqrt (M : ℝ)) := by ring
        _ ≤ ((Q : ℝ) * (x : ℝ)) *
            (Real.sqrt 2 / Real.sqrt U) :=
          mul_le_mul_of_nonneg_left hInv (by positivity)
        _ = _ := by ring
    have hBlockLe :
        (x : ℝ) +
            (Q : ℝ) * Real.sqrt ((x : ℝ) * (M : ℝ)) +
            (Q : ℝ) * (x : ℝ) / Real.sqrt (M : ℝ) +
            (Q : ℝ) ^ 2 * Real.sqrt (x : ℝ) ≤ B := by
      dsimp only [B]
      linarith
    have hLog : Real.log (2 * (M : ℝ)) ≤ L := by
      have hArg : 2 * (M : ℝ) ≤ 2 * (x : ℝ) / V := by
        calc
          2 * (M : ℝ) ≤ 2 * ((x : ℝ) / V) :=
            mul_le_mul_of_nonneg_left hMupper.le (by norm_num)
          _ = 2 * (x : ℝ) / V := by ring
      have hRaw := Real.log_le_log (by positivity) hArg
      dsimp only [L, vaughanFourthScaleLog]
      exact hRaw.trans (le_max_right _ _)
    have hSqrtLog : Real.sqrt (Real.log (2 * (M : ℝ))) ≤
        Real.sqrt L := Real.sqrt_le_sqrt hLog
    have hBlockNonneg : 0 ≤
        (x : ℝ) +
          (Q : ℝ) * Real.sqrt ((x : ℝ) * (M : ℝ)) +
          (Q : ℝ) * (x : ℝ) / Real.sqrt (M : ℝ) +
          (Q : ℝ) ^ 2 * Real.sqrt (x : ℝ) := by positivity
    have hBlock :=
      sum_weighted_vaughanFourthDyadicBlockMaximum_le_of_psi
        (A := A) (U := U) (V := V) (x := x) (Q := Q) (alpha := alpha)
        hA hpsi hx hU hV halpha
    apply hBlock.trans
    dsimp only [C]
    calc
      vaughanFourthBlockConstant A *
          ((x : ℝ) +
            (Q : ℝ) * Real.sqrt ((x : ℝ) * (M : ℝ)) +
            (Q : ℝ) * (x : ℝ) / Real.sqrt (M : ℝ) +
            (Q : ℝ) ^ 2 * Real.sqrt (x : ℝ)) *
          Real.sqrt (Real.log (2 * (M : ℝ))) * Vlog * Xlog ≤
          vaughanFourthBlockConstant A * B *
            Real.sqrt (Real.log (2 * (M : ℝ))) * Vlog * Xlog := by
        gcongr
      _ ≤ vaughanFourthBlockConstant A * B * Real.sqrt L * Vlog * Xlog := by
        gcongr
  have hcard := card_vaughanFourthDyadicExponents_le_scaleLog
    (U := U) hV x
  change ((scales.card : ℕ) : ℝ) ≤ L / Real.log 2 at hcard
  calc
    _ ≤ ∑ _alpha ∈ scales, C := hsum
    _ = (scales.card : ℝ) * C := by
      rw [Finset.sum_const, nsmul_eq_mul]
    _ ≤ (L / Real.log 2) * C :=
      mul_le_mul_of_nonneg_right hcard hCnonneg
    _ = vaughanFourthBlockConstant A / Real.log 2 * B *
        (L * Real.sqrt L) * Vlog * Xlog := by ring
    _ = _ := by rfl

theorem sum_weighted_vaughanThirdLargeDyadicBlockMaximum_le
    {U V : ℝ} {x Q alpha : ℕ}
    (_hx : 1 ≤ x) (_hU : 1 ≤ U) (_hV : 1 ≤ V)
    (halpha : alpha ∈ vaughanThirdLargeDyadicExponents U V x) :
    (∑ q ∈ Finset.Ioc 0 Q,
      (q : ℝ) / (q.totient : ℝ) *
        ∑ chi : primitiveCharacters q,
          vaughanThirdLargeDyadicBlockMaximum U V x q alpha chi) ≤
      akbaryHambrookBilinearConstant *
        ((x : ℝ) +
          (Q : ℝ) * Real.sqrt ((x : ℝ) * (2 ^ alpha : ℕ)) +
          (Q : ℝ) * (x : ℝ) /
            Real.sqrt ((2 ^ alpha : ℕ) : ℝ) +
          (Q : ℝ) ^ 2 * Real.sqrt (x : ℝ)) *
        Real.log (2 * ((2 ^ alpha : ℕ) : ℝ)) *
        Real.log (4 * (x : ℝ)) := by
  classical
  let M : ℕ := 2 ^ alpha
  let R : ℕ := x / M
  have hM : 0 < M := by positivity
  have hMlt : M < x := by
    rcases Finset.mem_filter.mp halpha with ⟨_halphaRange, halphaBounds⟩
    dsimp only [M] at halphaBounds
    exact halphaBounds.2.2
  have hR : 0 < R := Nat.div_pos hMlt.le hM
  have hsm : vaughanThirdLargeDyadicIndices U V x alpha ⊆
      Finset.Ioc M (M + M) := by
    intro t ht
    have htBlock := (Finset.mem_inter.mp ht).2
    rw [dyadicBlock, Finset.mem_Ioc] at htBlock
    rw [Finset.mem_Ioc]
    constructor
    · simpa only [M] using htBlock.1
    · calc
        t ≤ 2 ^ (alpha + 1) := htBlock.2
        _ = M + M := by
          rw [pow_succ]
          dsimp only [M]
          omega
  have hsn : vaughanThirdLargeDyadicRIndices x alpha ⊆
      Finset.Ioc 0 (0 + R) := by
    intro r hr
    rw [vaughanThirdLargeDyadicRIndices, Finset.mem_Icc] at hr
    rw [Finset.mem_Ioc]
    constructor
    · omega
    · simpa only [R, M, zero_add] using hr.2
  have hblock :=
    sum_weighted_bilinearProductCutoffMaximum_subset_Ioc_le_akbaryHambrookBilinearConstant
      Q M M 0 R hM hR
      (vaughanThirdLargeDyadicIndices U V x alpha)
      (vaughanThirdLargeDyadicRIndices x alpha)
      hsm hsn
      (fun t ↦ ((vaughanThirdCoefficient U V t : ℝ) : ℂ))
      (fun _ ↦ (1 : ℂ))
  have hcardR : (vaughanThirdLargeDyadicRIndices x alpha).card = R := by
    rw [vaughanThirdLargeDyadicRIndices, Nat.card_Icc]
    simp [R, M]
  have hraw :
      (∑ q ∈ Finset.Ioc 0 Q,
        (q : ℝ) / (q.totient : ℝ) *
          ∑ chi : primitiveCharacters q,
            vaughanThirdLargeDyadicBlockMaximum U V x q alpha chi) ≤
        akbaryHambrookBilinearConstant *
          Real.sqrt ((M : ℝ) + (Q : ℝ) ^ 2) *
          Real.sqrt ((R : ℝ) + (Q : ℝ) ^ 2) *
          Real.sqrt (∑ t ∈ vaughanThirdLargeDyadicIndices U V x alpha,
            ‖((vaughanThirdCoefficient U V t : ℝ) : ℂ)‖ ^ 2) *
          Real.sqrt (R : ℝ) *
          Real.log (2 * (((M + M) * R : ℕ) : ℝ)) := by
    simpa only [vaughanThirdLargeDyadicBlockMaximum, M, R, zero_add,
      norm_one, one_pow, Finset.sum_const, hcardR, Nat.cast_id,
      nsmul_eq_mul, mul_one] using hblock
  have henergy :=
    sqrt_sum_norm_sq_vaughanThirdCoefficient_dyadic_le U V x alpha
  have henergy' :
      Real.sqrt (∑ t ∈ vaughanThirdLargeDyadicIndices U V x alpha,
        ‖((vaughanThirdCoefficient U V t : ℝ) : ℂ)‖ ^ 2) ≤
        Real.sqrt (M : ℝ) * Real.log (2 * (M : ℝ)) := by
    simpa only [M] using henergy
  have hMRNat : M * R ≤ x := by
    simpa only [R, Nat.mul_comm] using Nat.div_mul_le_self x M
  have hMR : (M : ℝ) * (R : ℝ) ≤ (x : ℝ) := by
    exact_mod_cast hMRNat
  have hcap :
      2 * ((((M + M) * R : ℕ) : ℝ)) ≤ 4 * (x : ℝ) := by
    norm_num only [Nat.cast_mul, Nat.cast_add]
    nlinarith
  have hlogCap :
      Real.log (2 * ((((M + M) * R : ℕ) : ℝ))) ≤
        Real.log (4 * (x : ℝ)) := by
    exact Real.log_le_log (by positivity) hcap
  have hRle : (R : ℝ) ≤ (x : ℝ) / (M : ℝ) := by
    simpa only [R] using
      (Nat.cast_div_le (α := ℝ) (m := x) (n := M))
  have hsqrtR : Real.sqrt (R : ℝ) ≤
      Real.sqrt ((x : ℝ) / (M : ℝ)) := Real.sqrt_le_sqrt hRle
  have hsqrtAddM :
      Real.sqrt ((M : ℝ) + (Q : ℝ) ^ 2) ≤
        Real.sqrt (M : ℝ) + (Q : ℝ) := by
    simpa only [← Real.sqrt_eq_rpow, Real.sqrt_sq (Nat.cast_nonneg Q)] using
      Real.rpow_add_le_add_rpow (Nat.cast_nonneg M) (sq_nonneg (Q : ℝ))
        (by norm_num : (0 : ℝ) ≤ 1 / 2) (by norm_num)
  have hsqrtAddR :
      Real.sqrt ((R : ℝ) + (Q : ℝ) ^ 2) ≤
        Real.sqrt ((x : ℝ) / (M : ℝ)) + (Q : ℝ) := by
    refine le_trans ?_ (_root_.add_le_add hsqrtR le_rfl)
    simpa only [← Real.sqrt_eq_rpow, Real.sqrt_sq (Nat.cast_nonneg Q)] using
      Real.rpow_add_le_add_rpow (Nat.cast_nonneg R) (sq_nonneg (Q : ℝ))
        (by norm_num : (0 : ℝ) ≤ 1 / 2) (by norm_num)
  have hlogM : 0 ≤ Real.log (2 * (M : ℝ)) :=
    Real.log_nonneg (by
      exact_mod_cast (show 1 ≤ 2 * M by omega))
  have hlogX : 0 ≤ Real.log (4 * (x : ℝ)) :=
    Real.log_nonneg (by
      exact_mod_cast (show 1 ≤ 4 * x by omega))
  have hlogK : 0 ≤
      Real.log (2 * ((((M + M) * R : ℕ) : ℝ))) :=
    Real.log_nonneg (by
      have hKpos : 0 < (M + M) * R := Nat.mul_pos (by omega) hR
      exact_mod_cast (show 1 ≤ 2 * ((M + M) * R) by omega))
  have hstage :
      (∑ q ∈ Finset.Ioc 0 Q,
        (q : ℝ) / (q.totient : ℝ) *
          ∑ chi : primitiveCharacters q,
            vaughanThirdLargeDyadicBlockMaximum U V x q alpha chi) ≤
        akbaryHambrookBilinearConstant *
          (Real.sqrt (M : ℝ) + (Q : ℝ)) *
          (Real.sqrt ((x : ℝ) / (M : ℝ)) + (Q : ℝ)) *
          Real.sqrt (M : ℝ) *
          Real.sqrt ((x : ℝ) / (M : ℝ)) *
          Real.log (2 * (M : ℝ)) * Real.log (4 * (x : ℝ)) := by
    calc
      _ ≤ akbaryHambrookBilinearConstant *
          Real.sqrt ((M : ℝ) + (Q : ℝ) ^ 2) *
          Real.sqrt ((R : ℝ) + (Q : ℝ) ^ 2) *
          (Real.sqrt (M : ℝ) * Real.log (2 * (M : ℝ))) *
          Real.sqrt (R : ℝ) *
          Real.log (2 * ((((M + M) * R : ℕ) : ℝ))) := by
        exact hraw.trans (by
          gcongr
          positivity [akbaryHambrookBilinearConstant_pos])
      _ ≤ akbaryHambrookBilinearConstant *
          (Real.sqrt (M : ℝ) + (Q : ℝ)) *
          (Real.sqrt ((x : ℝ) / (M : ℝ)) + (Q : ℝ)) *
          (Real.sqrt (M : ℝ) * Real.log (2 * (M : ℝ))) *
          Real.sqrt ((x : ℝ) / (M : ℝ)) *
          Real.log (4 * (x : ℝ)) := by
        gcongr <;> positivity [akbaryHambrookBilinearConstant_pos]
      _ = akbaryHambrookBilinearConstant *
          (Real.sqrt (M : ℝ) + (Q : ℝ)) *
          (Real.sqrt ((x : ℝ) / (M : ℝ)) + (Q : ℝ)) *
          Real.sqrt (M : ℝ) *
          Real.sqrt ((x : ℝ) / (M : ℝ)) *
          Real.log (2 * (M : ℝ)) * Real.log (4 * (x : ℝ)) := by ring
  have hmReal : 0 < (M : ℝ) := by exact_mod_cast hM
  have hscalar :
      (Real.sqrt (M : ℝ) + (Q : ℝ)) *
          (Real.sqrt ((x : ℝ) / (M : ℝ)) + (Q : ℝ)) *
          Real.sqrt (M : ℝ) * Real.sqrt ((x : ℝ) / (M : ℝ)) =
        (x : ℝ) +
          (Q : ℝ) * Real.sqrt ((x : ℝ) * (M : ℝ)) +
          (Q : ℝ) * (x : ℝ) / Real.sqrt (M : ℝ) +
          (Q : ℝ) ^ 2 * Real.sqrt (x : ℝ) := by
    rw [Real.sqrt_div (Nat.cast_nonneg x), Real.sqrt_mul (Nat.cast_nonneg x)]
    field_simp [Real.sqrt_ne_zero'.2 hmReal]
    ring_nf
    rw [Real.sq_sqrt (Nat.cast_nonneg x)]
  calc
    _ ≤ akbaryHambrookBilinearConstant *
        ((x : ℝ) +
          (Q : ℝ) * Real.sqrt ((x : ℝ) * (M : ℝ)) +
          (Q : ℝ) * (x : ℝ) / Real.sqrt (M : ℝ) +
          (Q : ℝ) ^ 2 * Real.sqrt (x : ℝ)) *
        Real.log (2 * (M : ℝ)) * Real.log (4 * (x : ℝ)) := by
      rw [← hscalar]
      simpa only [mul_assoc] using hstage
    _ = _ := by rfl

theorem sum_weightedPrimitiveVaughanTwistedSumThreeLargeEndpointMaximum_le_sum_dyadicBlockMaximum
    {U V : ℝ} {x Q : ℕ}
    (hx : 1 ≤ x) (hU : 1 ≤ U) (hV : 1 ≤ V) :
    (∑ q ∈ Finset.Ioc 0 Q,
      (q : ℝ) / (q.totient : ℝ) *
        ∑ chi : primitiveCharacters q,
          vaughanTwistedSumThreeLargeEndpointMaximum U V x q chi.1) ≤
      ∑ alpha ∈ vaughanThirdLargeDyadicExponents U V x,
        ∑ q ∈ Finset.Ioc 0 Q,
          (q : ℝ) / (q.totient : ℝ) *
            ∑ chi : primitiveCharacters q,
              vaughanThirdLargeDyadicBlockMaximum U V x q alpha chi.1 := by
  classical
  rw [Finset.sum_comm]
  refine Finset.sum_le_sum fun q _ ↦ ?_
  rw [← Finset.mul_sum, Finset.sum_comm]
  exact mul_le_mul_of_nonneg_left (Finset.sum_le_sum fun chi _ ↦
    vaughanTwistedSumThreeLargeEndpointMaximum_le_sum_dyadicBlockMaximum
      hU hV hx chi.1) (by positivity)

theorem sum_weightedPrimitiveVaughanTwistedSumThreeLargeEndpointMaximum_le
    {U V : ℝ} {x Q : ℕ}
    (hx : 1 ≤ x) (hU : 1 ≤ U) (hV : 1 ≤ V) :
    (∑ q ∈ Finset.Ioc 0 Q,
      (q : ℝ) / (q.totient : ℝ) *
        ∑ chi : primitiveCharacters q,
          vaughanTwistedSumThreeLargeEndpointMaximum U V x q chi.1) ≤
      akbaryHambrookBilinearConstant / Real.log 2 *
        ((x : ℝ) +
          (Q : ℝ) * Real.sqrt ((x : ℝ) * U * V) +
          Real.sqrt 2 * (Q : ℝ) * (x : ℝ) / Real.sqrt U +
          (Q : ℝ) ^ 2 * Real.sqrt (x : ℝ)) *
        (Real.log (2 * U * V)) ^ 2 * Real.log (4 * (x : ℝ)) := by
  classical
  let scales := vaughanThirdLargeDyadicExponents U V x
  let A : ℝ := (x : ℝ) +
    (Q : ℝ) * Real.sqrt ((x : ℝ) * U * V) +
    Real.sqrt 2 * (Q : ℝ) * (x : ℝ) / Real.sqrt U +
    (Q : ℝ) ^ 2 * Real.sqrt (x : ℝ)
  let L : ℝ := Real.log (2 * U * V)
  let Xlog : ℝ := Real.log (4 * (x : ℝ))
  let C : ℝ := akbaryHambrookBilinearConstant * A * L * Xlog
  have hxReal : 0 < (x : ℝ) := by exact_mod_cast hx
  have hxOne : (1 : ℝ) ≤ (x : ℝ) := by exact_mod_cast hx
  have hUpos : 0 < U := zero_lt_one.trans_le hU
  have hVpos : 0 < V := zero_lt_one.trans_le hV
  have hLpos : 0 < L := by
    dsimp only [L]
    apply Real.log_pos
    nlinarith [mul_pos hUpos hVpos]
  have hXlogPos : 0 < Xlog := by
    dsimp only [Xlog]
    exact Real.log_pos (by nlinarith)
  have hAnonneg : 0 ≤ A := by
    dsimp only [A]
    positivity
  have hCnonneg : 0 ≤ C := by
    dsimp only [C]
    positivity [akbaryHambrookBilinearConstant_pos]
  have hbridge :=
    sum_weightedPrimitiveVaughanTwistedSumThreeLargeEndpointMaximum_le_sum_dyadicBlockMaximum
      (U := U) (V := V) (x := x) (Q := Q) hx hU hV
  have hsum :
      (∑ q ∈ Finset.Ioc 0 Q,
        (q : ℝ) / (q.totient : ℝ) *
          ∑ chi : primitiveCharacters q,
            vaughanTwistedSumThreeLargeEndpointMaximum U V x q chi.1) ≤
        ∑ _alpha ∈ scales, C := by
    apply hbridge.trans
    apply Finset.sum_le_sum
    intro alpha halpha
    let M : ℕ := 2 ^ alpha
    have hMpos : 0 < M := by positivity
    have hmReal : 0 < (M : ℝ) := by exact_mod_cast hMpos
    rcases Finset.mem_filter.mp halpha with
      ⟨_halphaRange, hMlower, hMupper, _hMx⟩
    change U / 2 < (M : ℝ) at hMlower
    change (M : ℝ) ≤ U * V at hMupper
    have hroot :
        Real.sqrt ((x : ℝ) * (M : ℝ)) ≤
          Real.sqrt ((x : ℝ) * U * V) := by
      apply Real.sqrt_le_sqrt
      calc
        (x : ℝ) * (M : ℝ) ≤ (x : ℝ) * (U * V) :=
          mul_le_mul_of_nonneg_left hMupper hxReal.le
        _ = (x : ℝ) * U * V := by ring
    have hUtwoM : U ≤ 2 * (M : ℝ) := by linarith
    have hsqrtUle : Real.sqrt U ≤ Real.sqrt 2 * Real.sqrt (M : ℝ) := by
      calc
        Real.sqrt U ≤ Real.sqrt (2 * (M : ℝ)) :=
          Real.sqrt_le_sqrt hUtwoM
        _ = Real.sqrt 2 * Real.sqrt (M : ℝ) := by
          rw [Real.sqrt_mul (by norm_num : (0 : ℝ) ≤ 2)]
    have hsqrtUpos : 0 < Real.sqrt U := Real.sqrt_pos.2 hUpos
    have hsqrtMpos : 0 < Real.sqrt (M : ℝ) := Real.sqrt_pos.2 hmReal
    have hinv : 1 / Real.sqrt (M : ℝ) ≤
        Real.sqrt 2 / Real.sqrt U := by
      apply (div_le_div_iff₀ hsqrtMpos hsqrtUpos).2
      simpa only [one_mul] using hsqrtUle
    have hrootTerm :
        (Q : ℝ) * Real.sqrt ((x : ℝ) * (M : ℝ)) ≤
          (Q : ℝ) * Real.sqrt ((x : ℝ) * U * V) :=
      mul_le_mul_of_nonneg_left hroot (Nat.cast_nonneg Q)
    have hinvTerm :
        (Q : ℝ) * (x : ℝ) / Real.sqrt (M : ℝ) ≤
          Real.sqrt 2 * (Q : ℝ) * (x : ℝ) / Real.sqrt U := by
      calc
        (Q : ℝ) * (x : ℝ) / Real.sqrt (M : ℝ) =
            ((Q : ℝ) * (x : ℝ)) *
              (1 / Real.sqrt (M : ℝ)) := by ring
        _ ≤ ((Q : ℝ) * (x : ℝ)) *
            (Real.sqrt 2 / Real.sqrt U) :=
          mul_le_mul_of_nonneg_left hinv (by positivity)
        _ = Real.sqrt 2 * (Q : ℝ) * (x : ℝ) / Real.sqrt U := by ring
    have hAblock :
        (x : ℝ) +
            (Q : ℝ) * Real.sqrt ((x : ℝ) * (M : ℝ)) +
            (Q : ℝ) * (x : ℝ) / Real.sqrt (M : ℝ) +
            (Q : ℝ) ^ 2 * Real.sqrt (x : ℝ) ≤ A := by
      dsimp only [A]
      linarith
    have hlog : Real.log (2 * (M : ℝ)) ≤ L := by
      dsimp only [L]
      apply Real.log_le_log (by positivity)
      nlinarith
    have hAblockNonneg : 0 ≤
        (x : ℝ) +
          (Q : ℝ) * Real.sqrt ((x : ℝ) * (M : ℝ)) +
          (Q : ℝ) * (x : ℝ) / Real.sqrt (M : ℝ) +
          (Q : ℝ) ^ 2 * Real.sqrt (x : ℝ) := by positivity
    have hlogMNonneg : 0 ≤ Real.log (2 * (M : ℝ)) :=
      Real.log_nonneg (by
        exact_mod_cast (show 1 ≤ 2 * M by omega))
    calc
      _ ≤ akbaryHambrookBilinearConstant *
          ((x : ℝ) +
            (Q : ℝ) * Real.sqrt ((x : ℝ) * (M : ℝ)) +
            (Q : ℝ) * (x : ℝ) / Real.sqrt (M : ℝ) +
            (Q : ℝ) ^ 2 * Real.sqrt (x : ℝ)) *
          Real.log (2 * (M : ℝ)) * Xlog := by
        simpa only [scales, M, Xlog] using
          (sum_weighted_vaughanThirdLargeDyadicBlockMaximum_le
            (U := U) (V := V) (x := x) (Q := Q) (alpha := alpha)
            hx hU hV halpha)
      _ ≤ C := by
        dsimp only [C]
        calc
          _ ≤ akbaryHambrookBilinearConstant * A * Real.log (2 * (M : ℝ)) * Xlog := by
            apply mul_le_mul_of_nonneg_right _ hXlogPos.le
            apply mul_le_mul_of_nonneg_right _ hlogMNonneg
            exact mul_le_mul_of_nonneg_left hAblock
              akbaryHambrookBilinearConstant_pos.le
          _ ≤ akbaryHambrookBilinearConstant * A * L * Xlog := by
            apply mul_le_mul_of_nonneg_right _ hXlogPos.le
            exact mul_le_mul_of_nonneg_left hlog
              (mul_nonneg akbaryHambrookBilinearConstant_pos.le hAnonneg)
  have hcard := card_vaughanThirdLargeDyadicExponents_le_log hU hV x
  change ((scales.card : ℕ) : ℝ) ≤ L / Real.log 2 at hcard
  calc
    _ ≤ ∑ _alpha ∈ scales, C := hsum
    _ = (scales.card : ℝ) * C := by
      rw [Finset.sum_const, nsmul_eq_mul]
    _ ≤ (L / Real.log 2) * C :=
      mul_le_mul_of_nonneg_right hcard hCnonneg
    _ = akbaryHambrookBilinearConstant / Real.log 2 * A * L ^ 2 * Xlog := by ring
    _ = _ := by rfl

theorem primitiveRawMeanValueCumulative_nat_eq_weightedRawEndpointMaximum
    (x Q : ℕ) :
    primitiveRawMeanValueCumulative x Q =
      ∑ q ∈ Finset.Ioc 0 Q,
        (q : ℝ) / (q.totient : ℝ) *
          ∑ chi : primitiveCharacters q,
            primitiveRawEndpointMaximum x q chi := by
  rw [primitiveRawMeanValueCumulative_nat]
  change (∑ q ∈ Finset.Icc 0 Q, primitiveRawMeanValueWeight x q) =
    ∑ q ∈ Finset.Ioc 0 Q, primitiveRawMeanValueWeight x q
  symm
  apply Finset.sum_subset
  · intro q hq
    exact Finset.mem_Icc.mpr ⟨Nat.zero_le q, (Finset.mem_Ioc.mp hq).2⟩
  · intro q hqIcc hqNotIoc
    have hqZero : q = 0 := by
      rcases Finset.mem_Icc.mp hqIcc with ⟨_hqNonneg, hqQ⟩
      by_contra hqNe
      exact hqNotIoc (Finset.mem_Ioc.mpr ⟨Nat.pos_of_ne_zero hqNe, hqQ⟩)
    subst q
    exact primitiveRawMeanValueWeight_zero x

theorem primitiveRawMeanValueCumulative_nat_le_psi_mul_sq
    (x Q : ℕ) :
    primitiveRawMeanValueCumulative x Q ≤
      Chebyshev.psi x * (Q : ℝ) ^ 2 := by
  rw [primitiveRawMeanValueCumulative_nat_eq_weightedRawEndpointMaximum]
  have hpsi : 0 ≤ Chebyshev.psi x := Chebyshev.psi_nonneg x
  calc
    (∑ q ∈ Finset.Ioc 0 Q,
        (q : ℝ) / (q.totient : ℝ) *
          ∑ chi : primitiveCharacters q,
            primitiveRawEndpointMaximum x q chi) ≤
        ∑ q ∈ Finset.Ioc 0 Q, (q : ℝ) * Chebyshev.psi x := by
      apply Finset.sum_le_sum
      intro q hq
      have hqpos : 0 < q := (Finset.mem_Ioc.mp hq).1
      have hphi : 0 < (q.totient : ℝ) := by
        exact_mod_cast Nat.totient_pos.mpr hqpos
      have hmass :
          (∑ chi : primitiveCharacters q,
              primitiveRawEndpointMaximum x q chi) ≤
            (q.totient : ℝ) * Chebyshev.psi x := by
        calc
          (∑ chi : primitiveCharacters q,
              primitiveRawEndpointMaximum x q chi) ≤
              ∑ _chi : primitiveCharacters q, Chebyshev.psi x := by
            apply Finset.sum_le_sum
            intro chi _hchi
            exact primitiveRawEndpointMaximum_le_psi x q chi
          _ = (Fintype.card (primitiveCharacters q) : ℝ) *
              Chebyshev.psi x := by simp
          _ ≤ (q.totient : ℝ) * Chebyshev.psi x := by
            apply mul_le_mul_of_nonneg_right _ hpsi
            exact_mod_cast card_primitiveCharacters_le_totient hqpos
      calc
        (q : ℝ) / (q.totient : ℝ) *
            (∑ chi : primitiveCharacters q,
              primitiveRawEndpointMaximum x q chi) ≤
            (q : ℝ) / (q.totient : ℝ) *
              ((q.totient : ℝ) * Chebyshev.psi x) := by
          exact mul_le_mul_of_nonneg_left hmass (by positivity)
        _ = (q : ℝ) * Chebyshev.psi x := by field_simp
    _ ≤ ∑ _q ∈ Finset.Ioc 0 Q,
        (Q : ℝ) * Chebyshev.psi x := by
      apply Finset.sum_le_sum
      intro q hq
      apply mul_le_mul_of_nonneg_right _ hpsi
      exact_mod_cast (Finset.mem_Ioc.mp hq).2
    _ = Chebyshev.psi x * (Q : ℝ) ^ 2 := by
      simp [Nat.card_Ioc]
      ring

/--
The explicit five-part majorant for the primitive-character mean of Vaughan's decomposition. It
retains the separate algebraic, logarithmic, and dyadic constants for the first, second, split
third, and fourth contributions.
-/
noncomputable def vaughanPrimitiveMeanMajorant
    (A U V : ℝ) (x Q : ℕ) : ℝ :=
  A * U * (Q : ℝ) ^ 2 +
    ((x : ℝ) + (Q : ℝ) ^ 2 * Real.sqrt (Q : ℝ) * V) *
      (Real.log ((x : ℝ) * V)) ^ 2 +
    ((x : ℝ) + (Q : ℝ) ^ 2 * Real.sqrt (Q : ℝ) * U) *
      (Real.log ((x : ℝ) * U)) ^ 2 +
    akbaryHambrookBilinearConstant / Real.log 2 *
      ((x : ℝ) + (Q : ℝ) * Real.sqrt ((x : ℝ) * U * V) +
        Real.sqrt 2 * (Q : ℝ) * (x : ℝ) / Real.sqrt U +
        (Q : ℝ) ^ 2 * Real.sqrt (x : ℝ)) *
      (Real.log (2 * U * V)) ^ 2 * Real.log (4 * (x : ℝ)) +
    vaughanFourthBlockConstant A / Real.log 2 *
      ((x : ℝ) + (Q : ℝ) * (x : ℝ) / Real.sqrt V +
        Real.sqrt 2 * (Q : ℝ) * (x : ℝ) / Real.sqrt U +
        (Q : ℝ) ^ 2 * Real.sqrt (x : ℝ)) *
      (vaughanFourthScaleLog V x * Real.sqrt (vaughanFourthScaleLog V x)) *
      Real.log (Real.exp 3 * V) * Real.log (4 * (x : ℝ))

theorem one_le_siegelWalfiszConductorCutoff
    {D : ℝ} (hD : 0 < D) {x : ℕ} (hx : 4 ≤ x) :
    1 ≤ siegelWalfiszConductorCutoff D x := by
  unfold siegelWalfiszConductorCutoff
  exact (Nat.one_le_floor_iff _).2
    (Real.one_le_rpow (one_le_log_natCast hx) hD.le)

theorem vaughanPrimitiveMeanElementaryCorrection_le_abelEnvelope
    (x Q : ℕ) (Q1 : ℝ) (hx : 4 ≤ x)
    (hQsqrt : (Q : ℝ) ≤ Real.sqrt (x : ℝ))
    (hQ1 : 1 ≤ Q1) (hQ : Q1 ≤ (Q : ℝ)) :
    (Q : ℝ) * Real.log ((Q * x : ℕ) : ℝ) ^ 2 ≤
      vaughanPrimitiveMeanAbelEnvelope x Q1 Q *
        vaughanProgressionMeanLogPower x := by
  have hxone : (1 : ℝ) ≤ (x : ℝ) := by
    exact_mod_cast (show 1 ≤ x by omega)
  have hxpos : (0 : ℝ) < (x : ℝ) := zero_lt_one.trans_le hxone
  have hQone : (1 : ℝ) ≤ (Q : ℝ) := hQ1.trans hQ
  have hQnonneg : (0 : ℝ) ≤ (Q : ℝ) := zero_le_one.trans hQone
  have hsqrt_le_x : Real.sqrt (x : ℝ) ≤ (x : ℝ) := by
    apply Real.sqrt_le_iff.mpr
    constructor
    · exact hxpos.le
    · nlinarith
  have hQleX : (Q : ℝ) ≤ (x : ℝ) := hQsqrt.trans hsqrt_le_x
  have hprod_one : (1 : ℝ) ≤ ((Q * x : ℕ) : ℝ) := by
    rw [Nat.cast_mul]
    nlinarith
  have hprod_le : ((Q * x : ℕ) : ℝ) ≤ (x : ℝ) ^ 2 := by
    rw [Nat.cast_mul]
    nlinarith
  have hlogX_nonneg : 0 ≤ Real.log (x : ℝ) := Real.log_nonneg hxone
  have hlogProd_nonneg : 0 ≤ Real.log ((Q * x : ℕ) : ℝ) :=
    Real.log_nonneg hprod_one
  have hlogProd_le :
      Real.log ((Q * x : ℕ) : ℝ) ≤ 2 * Real.log (x : ℝ) := by
    calc
      Real.log ((Q * x : ℕ) : ℝ) ≤ Real.log ((x : ℝ) ^ 2) :=
        Real.log_le_log (by positivity) hprod_le
      _ = 2 * Real.log (x : ℝ) := by rw [Real.log_pow]; norm_num
  have hlogSq :
      Real.log ((Q * x : ℕ) : ℝ) ^ 2 ≤
        4 * Real.log (x : ℝ) ^ 2 := by
    have hsquares := (sq_le_sq₀ hlogProd_nonneg (by positivity :
      0 ≤ 2 * Real.log (x : ℝ))).2 hlogProd_le
    nlinarith
  have hlogOne : 1 ≤ Real.log (x : ℝ) := one_le_log_natCast hx
  have hlogSq_le_fourth :
      Real.log (x : ℝ) ^ 2 ≤ Real.log (x : ℝ) ^ 4 := by
    calc
      Real.log (x : ℝ) ^ 2 = Real.log (x : ℝ) ^ 2 * 1 := by ring
      _ ≤ Real.log (x : ℝ) ^ 2 * Real.log (x : ℝ) ^ 2 :=
        mul_le_mul_of_nonneg_left (one_le_pow₀ hlogOne)
          (sq_nonneg (Real.log (x : ℝ)))
      _ = Real.log (x : ℝ) ^ 4 := by ring
  have hsqrtLogOne : 1 ≤ Real.sqrt (Real.log (x : ℝ)) :=
    Real.one_le_sqrt.mpr hlogOne
  have hlogSq_le_L9 :
      Real.log (x : ℝ) ^ 2 ≤
        vaughanProgressionMeanLogPower x := by
    unfold vaughanProgressionMeanLogPower
    calc
      Real.log (x : ℝ) ^ 2 ≤ Real.log (x : ℝ) ^ 4 := hlogSq_le_fourth
      _ = Real.log (x : ℝ) ^ 4 * 1 := by ring
      _ ≤ Real.log (x : ℝ) ^ 4 *
          Real.sqrt (Real.log (x : ℝ)) := by
        exact mul_le_mul_of_nonneg_left hsqrtLogOne (by positivity)
  have hsqrtXOne : 1 ≤ Real.sqrt (x : ℝ) := Real.one_le_sqrt.mpr hxone
  have hL9nonneg := vaughanProgressionMeanLogPower_nonneg x
  have hlogSq_le_sqrt_L9 :
      Real.log (x : ℝ) ^ 2 ≤ Real.sqrt (x : ℝ) *
        vaughanProgressionMeanLogPower x := by
    calc
      Real.log (x : ℝ) ^ 2 ≤
          vaughanProgressionMeanLogPower x := hlogSq_le_L9
      _ = 1 * vaughanProgressionMeanLogPower x := by ring
      _ ≤ Real.sqrt (x : ℝ) *
          vaughanProgressionMeanLogPower x :=
        mul_le_mul_of_nonneg_right hsqrtXOne hL9nonneg
  have hQ1pos : 0 < Q1 := zero_lt_one.trans_le hQ1
  have hexpQ : (Q : ℝ) ≤ Real.exp 1 * (Q : ℝ) := by
    calc
      (Q : ℝ) = 1 * (Q : ℝ) := by ring
      _ ≤ Real.exp 1 * (Q : ℝ) :=
        mul_le_mul_of_nonneg_right (Real.one_le_exp (by norm_num)) hQnonneg
  have hratioOne : 1 ≤ Real.exp 1 * (Q : ℝ) / Q1 := by
    apply (le_div_iff₀ hQ1pos).2
    simpa using hQ.trans hexpQ
  have hlogRatio : 0 ≤ Real.log (Real.exp 1 * (Q : ℝ) / Q1) :=
    Real.log_nonneg hratioOne
  have hcuberoot := vaughanCubeRoot_nonneg x
  have hfirst : 0 ≤ 4 * (x : ℝ) / Q1 := by positivity
  have hthird :
      0 ≤ 18 * vaughanCubeRoot x ^ 2 * Real.sqrt (Q : ℝ) := by
    positivity
  have hfourth :
      0 ≤ 5 * (Real.sqrt (x : ℝ) * vaughanCubeRoot x) *
        Real.log (Real.exp 1 * (Q : ℝ) / Q1) := by
    positivity
  have hcoefficient :
      4 * Real.sqrt (x : ℝ) * (Q : ℝ) ≤
        vaughanPrimitiveMeanAbelEnvelope x Q1 Q := by
    unfold vaughanPrimitiveMeanAbelEnvelope
    linarith
  calc
    (Q : ℝ) * Real.log ((Q * x : ℕ) : ℝ) ^ 2 ≤
        (Q : ℝ) * (4 * Real.log (x : ℝ) ^ 2) :=
      mul_le_mul_of_nonneg_left hlogSq hQnonneg
    _ ≤ (Q : ℝ) *
        (4 * (Real.sqrt (x : ℝ) *
          vaughanProgressionMeanLogPower x)) := by
      gcongr
    _ = (4 * Real.sqrt (x : ℝ) * (Q : ℝ)) *
        vaughanProgressionMeanLogPower x := by ring
    _ ≤ vaughanPrimitiveMeanAbelEnvelope x Q1 Q *
        vaughanProgressionMeanLogPower x :=
      mul_le_mul_of_nonneg_right hcoefficient hL9nonneg

end

section
open scoped ContDiff

open scoped ArithmeticFunction.vonMangoldt
/--
The sum of the five endpoint maxima from Vaughan's first, second, small-third, large-third, and
fourth contributions. For `1 ≤ U`, `1 ≤ V`, and `2 ≤ x`, the triangle inequality bounds the raw
primitive-character endpoint maximum by this sum.
-/
noncomputable def vaughanFiveTermEndpointMajorant
    (U V : ℝ) (x q : ℕ) (chi : DirichletCharacter ℂ q) : ℝ :=
  vaughanTwistedSumOneEndpointMaximum U x q chi +
    vaughanTwistedSumTwoEndpointMaximum V x q chi +
    vaughanTwistedSumThreeSmallEndpointMaximum U V x q chi +
    vaughanTwistedSumThreeLargeEndpointMaximum U V x q chi +
    vaughanTwistedSumFourEndpointMaximum U V x q chi

theorem primitiveRawEndpointMaximum_le_vaughanFiveTermEndpointMajorant
    {U V : ℝ} (hU : 1 ≤ U) (hV : 1 ≤ V)
    {x q : ℕ} (hx : 2 ≤ x) (chi : primitiveCharacters q) :
    primitiveRawEndpointMaximum x q chi ≤
      vaughanFiveTermEndpointMajorant U V x q chi.1 := by
  classical
  have hxOne : 1 ≤ x := by omega
  unfold primitiveRawEndpointMaximum
  rw [dite_eq_left hx]
  apply Finset.sup'_le
  intro y hy
  have hyBounds := Finset.mem_Icc.mp hy
  have hyComponent : y ∈ Finset.Icc 1 x :=
    Finset.mem_Icc.mpr ⟨by omega, hyBounds.2⟩
  have hOne :
      ‖vaughanTwistedSumOne U y q chi.1‖ ≤
        vaughanTwistedSumOneEndpointMaximum U x q chi.1 := by
    unfold vaughanTwistedSumOneEndpointMaximum
    rw [dite_eq_left hxOne]
    exact Finset.le_sup'
      (fun z ↦ ‖vaughanTwistedSumOne U z q chi.1‖) hyComponent
  have hTwo :
      ‖vaughanTwistedSumTwo V y q chi.1‖ ≤
        vaughanTwistedSumTwoEndpointMaximum V x q chi.1 := by
    unfold vaughanTwistedSumTwoEndpointMaximum
    rw [dite_eq_left hxOne]
    exact Finset.le_sup'
      (fun z ↦ ‖vaughanTwistedSumTwo V z q chi.1‖) hyComponent
  have hThreeSmall :
      ‖vaughanTwistedSumThreeSmall U V y q chi.1‖ ≤
        vaughanTwistedSumThreeSmallEndpointMaximum U V x q chi.1 := by
    unfold vaughanTwistedSumThreeSmallEndpointMaximum
    rw [dite_eq_left hxOne]
    exact Finset.le_sup'
      (fun z ↦ ‖vaughanTwistedSumThreeSmall U V z q chi.1‖) hyComponent
  have hThreeLarge :
      ‖vaughanTwistedSumThreeLarge U V y q chi.1‖ ≤
        vaughanTwistedSumThreeLargeEndpointMaximum U V x q chi.1 := by
    unfold vaughanTwistedSumThreeLargeEndpointMaximum
    rw [dite_eq_left hxOne]
    exact Finset.le_sup'
      (fun z ↦ ‖vaughanTwistedSumThreeLarge U V z q chi.1‖) hyComponent
  have hFour :
      ‖vaughanTwistedSumFour U V y q chi.1‖ ≤
        vaughanTwistedSumFourEndpointMaximum U V x q chi.1 := by
    unfold vaughanTwistedSumFourEndpointMaximum
    rw [dite_eq_left hxOne]
    exact Finset.le_sup'
      (fun z ↦ ‖vaughanTwistedSumFour U V z q chi.1‖) hyComponent
  rw [twistedChebyshevSum_eq_vaughanFiveTerms hU hV]
  unfold vaughanFiveTermEndpointMajorant
  calc
    ‖vaughanTwistedSumOne U y q chi.1 +
        vaughanTwistedSumTwo V y q chi.1 -
        vaughanTwistedSumThreeSmall U V y q chi.1 -
        vaughanTwistedSumThreeLarge U V y q chi.1 +
        vaughanTwistedSumFour U V y q chi.1‖ ≤
      ‖vaughanTwistedSumOne U y q chi.1 +
          vaughanTwistedSumTwo V y q chi.1 -
          vaughanTwistedSumThreeSmall U V y q chi.1 -
          vaughanTwistedSumThreeLarge U V y q chi.1‖ +
        ‖vaughanTwistedSumFour U V y q chi.1‖ :=
      norm_add_le _ _
    _ ≤
      (‖vaughanTwistedSumOne U y q chi.1 +
          vaughanTwistedSumTwo V y q chi.1 -
          vaughanTwistedSumThreeSmall U V y q chi.1‖ +
        ‖vaughanTwistedSumThreeLarge U V y q chi.1‖) +
        ‖vaughanTwistedSumFour U V y q chi.1‖ := by
      gcongr
      exact norm_sub_le _ _
    _ ≤
      ((‖vaughanTwistedSumOne U y q chi.1 +
          vaughanTwistedSumTwo V y q chi.1‖ +
        ‖vaughanTwistedSumThreeSmall U V y q chi.1‖) +
        ‖vaughanTwistedSumThreeLarge U V y q chi.1‖) +
        ‖vaughanTwistedSumFour U V y q chi.1‖ := by
      gcongr
      exact norm_sub_le _ _
    _ ≤
      (((‖vaughanTwistedSumOne U y q chi.1‖ +
          ‖vaughanTwistedSumTwo V y q chi.1‖) +
        ‖vaughanTwistedSumThreeSmall U V y q chi.1‖) +
        ‖vaughanTwistedSumThreeLarge U V y q chi.1‖) +
        ‖vaughanTwistedSumFour U V y q chi.1‖ := by
      gcongr
      exact norm_add_le _ _
    _ ≤ _ := by
      gcongr

end

section
open scoped ContDiff

theorem sum_weightedPrimitiveVaughanFiveTermEndpointMajorant_eq
    (U V : ℝ) (x Q : ℕ) :
    (∑ q ∈ Finset.Ioc 0 Q,
      (q : ℝ) / (q.totient : ℝ) *
        ∑ chi : primitiveCharacters q,
          vaughanFiveTermEndpointMajorant U V x q chi.1) =
      (∑ q ∈ Finset.Ioc 0 Q,
        (q : ℝ) / (q.totient : ℝ) *
          ∑ chi : primitiveCharacters q,
            vaughanTwistedSumOneEndpointMaximum U x q chi.1) +
      (∑ q ∈ Finset.Ioc 0 Q,
        (q : ℝ) / (q.totient : ℝ) *
          ∑ chi : primitiveCharacters q,
            vaughanTwistedSumTwoEndpointMaximum V x q chi.1) +
      (∑ q ∈ Finset.Ioc 0 Q,
        (q : ℝ) / (q.totient : ℝ) *
          ∑ chi : primitiveCharacters q,
            vaughanTwistedSumThreeSmallEndpointMaximum U V x q chi.1) +
      (∑ q ∈ Finset.Ioc 0 Q,
        (q : ℝ) / (q.totient : ℝ) *
          ∑ chi : primitiveCharacters q,
            vaughanTwistedSumThreeLargeEndpointMaximum U V x q chi.1) +
      (∑ q ∈ Finset.Ioc 0 Q,
        (q : ℝ) / (q.totient : ℝ) *
          ∑ chi : primitiveCharacters q,
            vaughanTwistedSumFourEndpointMaximum U V x q chi.1) := by
  simp_rw [vaughanFiveTermEndpointMajorant, Finset.sum_add_distrib, mul_add]
  repeat rw [Finset.sum_add_distrib]

theorem primitiveRawMeanValueCumulative_nat_le_vaughanFiveTermAggregate
    {U V : ℝ} (hU : 1 ≤ U) (hV : 1 ≤ V)
    {x Q : ℕ} (hx : 2 ≤ x) :
    primitiveRawMeanValueCumulative x Q ≤
      ∑ q ∈ Finset.Ioc 0 Q,
        (q : ℝ) / (q.totient : ℝ) *
          ∑ chi : primitiveCharacters q,
            vaughanFiveTermEndpointMajorant U V x q chi.1 := by
  rw [primitiveRawMeanValueCumulative_nat_eq_weightedRawEndpointMaximum]
  apply Finset.sum_le_sum
  intro q _hq
  apply mul_le_mul_of_nonneg_left
  · apply Finset.sum_le_sum
    intro chi _hchi
    exact primitiveRawEndpointMaximum_le_vaughanFiveTermEndpointMajorant
      hU hV hx chi
  · positivity

theorem primitiveRawMeanValueCumulative_nat_le_vaughanPrimitiveMeanMajorant_of_psi
    {A U V : ℝ}
    (hA : 0 ≤ A)
    (hpsi : ∀ z : ℝ, 0 ≤ z → Chebyshev.psi z ≤ A * z)
    {x Q : ℕ} (hx : 4 ≤ x) (hU : 1 ≤ U) (hV : 1 ≤ V)
    (hQ : 2 ≤ Q) (hQsqrt : (Q : ℝ) ≤ Real.sqrt (x : ℝ)) :
    primitiveRawMeanValueCumulative x Q ≤
      vaughanPrimitiveMeanMajorant A U V x Q := by
  have hpsiU : Chebyshev.psi U ≤ A * U :=
    hpsi U (zero_le_one.trans hU)
  have hOne :=
    sum_weightedPrimitiveVaughanTwistedSumOneEndpointMaximum_le
      hpsiU x Q
  have hTwo :=
    (sum_weightedPrimitiveVaughanTwistedSumTwoEndpointMaximum_lt
      (V := V) (x := x) (Q := Q) hx hV hQ hQsqrt).le
  have hThreeSmall :=
    (sum_weightedPrimitiveVaughanTwistedSumThreeSmallEndpointMaximum_lt
      (U := U) (V := V) (x := x) (Q := Q) hx hU hQ hQsqrt).le
  have hThreeLarge :=
    sum_weightedPrimitiveVaughanTwistedSumThreeLargeEndpointMaximum_le
      (U := U) (V := V) (x := x) (Q := Q) (by omega) hU hV
  have hFour :=
    sum_weightedPrimitiveVaughanTwistedSumFourEndpointMaximum_le_of_psi
      (A := A) (U := U) (V := V) (x := x) (Q := Q)
      hA hpsi (by omega) hU hV
  calc
    primitiveRawMeanValueCumulative x Q ≤
        ∑ q ∈ Finset.Ioc 0 Q,
          (q : ℝ) / (q.totient : ℝ) *
            ∑ chi : primitiveCharacters q,
              vaughanFiveTermEndpointMajorant U V x q chi.1 :=
      primitiveRawMeanValueCumulative_nat_le_vaughanFiveTermAggregate
        hU hV (by omega)
    _ =
        (∑ q ∈ Finset.Ioc 0 Q,
          (q : ℝ) / (q.totient : ℝ) *
            ∑ chi : primitiveCharacters q,
              vaughanTwistedSumOneEndpointMaximum U x q chi.1) +
        (∑ q ∈ Finset.Ioc 0 Q,
          (q : ℝ) / (q.totient : ℝ) *
            ∑ chi : primitiveCharacters q,
              vaughanTwistedSumTwoEndpointMaximum V x q chi.1) +
        (∑ q ∈ Finset.Ioc 0 Q,
          (q : ℝ) / (q.totient : ℝ) *
            ∑ chi : primitiveCharacters q,
              vaughanTwistedSumThreeSmallEndpointMaximum U V x q chi.1) +
        (∑ q ∈ Finset.Ioc 0 Q,
          (q : ℝ) / (q.totient : ℝ) *
            ∑ chi : primitiveCharacters q,
              vaughanTwistedSumThreeLargeEndpointMaximum U V x q chi.1) +
        (∑ q ∈ Finset.Ioc 0 Q,
          (q : ℝ) / (q.totient : ℝ) *
            ∑ chi : primitiveCharacters q,
              vaughanTwistedSumFourEndpointMaximum U V x q chi.1) :=
      sum_weightedPrimitiveVaughanFiveTermEndpointMajorant_eq U V x Q
    _ ≤ vaughanPrimitiveMeanMajorant A U V x Q := by
      unfold vaughanPrimitiveMeanMajorant
      linarith

/--
A common coefficient dominating `A` and the two dyadic constants after division by `log 2`, used
to factor the combined Vaughan majorant.
-/
noncomputable def vaughanPrimitiveMeanCoefficient (A : ℝ) : ℝ :=
  max A (max (akbaryHambrookBilinearConstant / Real.log 2)
    (vaughanFourthBlockConstant A / Real.log 2))

/--
The common Vaughan coefficient multiplied by the high-regime logarithmic comparison coefficient,
giving the constant in the first primitive mean-value estimate.
-/
noncomputable def vaughanPrimitiveMeanConstant (A : ℝ) : ℝ :=
  vaughanPrimitiveMeanCoefficient A *
    vaughanPrimitiveMeanHighLogCoefficient

theorem vaughanPrimitiveMeanCoefficient_nonneg (A : ℝ) :
    0 ≤ vaughanPrimitiveMeanCoefficient A := by
  have hc3 : 0 ≤ akbaryHambrookBilinearConstant / Real.log 2 := by
    positivity [akbaryHambrookBilinearConstant_pos]
  exact hc3.trans ((le_max_left _ _).trans (le_max_right _ _))

theorem self_le_vaughanPrimitiveMeanCoefficient (A : ℝ) :
    A ≤ vaughanPrimitiveMeanCoefficient A :=
  le_max_left _ _

theorem akbaryHambrookBilinearConstant_div_log_two_le_vaughanPrimitiveMeanCoefficient
    (A : ℝ) :
    akbaryHambrookBilinearConstant / Real.log 2 ≤
      vaughanPrimitiveMeanCoefficient A :=
  (le_max_left _ _).trans (le_max_right _ _)

theorem vaughanFourthBlockConstant_div_log_two_le_vaughanPrimitiveMeanCoefficient
    (A : ℝ) :
    vaughanFourthBlockConstant A / Real.log 2 ≤
      vaughanPrimitiveMeanCoefficient A :=
  (le_max_right _ _).trans (le_max_right _ _)

theorem one_le_vaughanPrimitiveMeanCoefficient
    {A : ℝ} (hA : 1 ≤ A) :
    1 ≤ vaughanPrimitiveMeanCoefficient A :=
  hA.trans (self_le_vaughanPrimitiveMeanCoefficient A)

theorem vaughanPrimitiveMeanConstant_nonneg (A : ℝ) :
    0 ≤ vaughanPrimitiveMeanConstant A := by
  unfold vaughanPrimitiveMeanConstant
  exact mul_nonneg (vaughanPrimitiveMeanCoefficient_nonneg A)
    vaughanPrimitiveMeanHighLogCoefficient_pos.le

theorem vaughanPrimitiveMeanMajorant_le_coefficient_mul_scales
    {A U V : ℝ} {x Q : ℕ}
    (hA : 1 ≤ A) (hx : 4 ≤ x) (hU : 1 ≤ U) (hV : 1 ≤ V) :
    vaughanPrimitiveMeanMajorant A U V x Q ≤
      vaughanPrimitiveMeanCoefficient A *
        vaughanPrimitiveMeanAlgebraicScale U V x (Q : ℝ) *
          vaughanPrimitiveMeanLogScale U V x := by
  let q : ℝ := Q
  let B1 : ℝ := U * q ^ 2
  let B2 : ℝ := (x : ℝ) + q ^ 2 * Real.sqrt q * V
  let B3 : ℝ := (x : ℝ) + q ^ 2 * Real.sqrt q * U
  let B4 : ℝ :=
    (x : ℝ) + q * Real.sqrt ((x : ℝ) * U * V) +
      Real.sqrt 2 * q * (x : ℝ) / Real.sqrt U +
      q ^ 2 * Real.sqrt (x : ℝ)
  let B5 : ℝ :=
    (x : ℝ) + q * (x : ℝ) / Real.sqrt V +
      Real.sqrt 2 * q * (x : ℝ) / Real.sqrt U +
      q ^ 2 * Real.sqrt (x : ℝ)
  let L1 : ℝ := Real.log ((x : ℝ) * V) ^ 2
  let L2 : ℝ := Real.log ((x : ℝ) * U) ^ 2
  let L3 : ℝ := Real.log (2 * U * V) ^ 2 * Real.log (4 * (x : ℝ))
  let L4 : ℝ :=
    vaughanFourthScaleLog V x * Real.sqrt (vaughanFourthScaleLog V x) *
      Real.log (Real.exp 3 * V) * Real.log (4 * (x : ℝ))
  let C : ℝ := vaughanPrimitiveMeanCoefficient A
  let L : ℝ := vaughanPrimitiveMeanLogScale U V x
  have hq : 0 ≤ q := by dsimp only [q]; positivity
  have hU0 : 0 ≤ U := zero_le_one.trans hU
  have hV0 : 0 ≤ V := zero_le_one.trans hV
  have hC0 : 0 ≤ C := vaughanPrimitiveMeanCoefficient_nonneg A
  have hCone : 1 ≤ C := one_le_vaughanPrimitiveMeanCoefficient hA
  have hL0 : 0 ≤ L := vaughanPrimitiveMeanLogScale_nonneg U V x
  have hLone : 1 ≤ L := one_le_vaughanPrimitiveMeanLogScale hx hV
  have hlogFourX : 0 ≤ Real.log (4 * (x : ℝ)) := by
    apply Real.log_nonneg
    have hxReal : (4 : ℝ) ≤ (x : ℝ) := by exact_mod_cast hx
    nlinarith
  have hlogExpV : 0 ≤ Real.log (Real.exp 3 * V) := by
    apply Real.log_nonneg
    have hexp : 1 ≤ Real.exp (3 : ℝ) := (Real.one_le_exp_iff).2 (by norm_num)
    calc
      (1 : ℝ) = 1 * 1 := by ring
      _ ≤ Real.exp 3 * V :=
        mul_le_mul hexp hV (by norm_num) (Real.exp_pos 3).le
  have hB1 : 0 ≤ B1 := by dsimp only [B1]; positivity
  have hB2 : 0 ≤ B2 := by dsimp only [B2]; positivity
  have hB3 : 0 ≤ B3 := by dsimp only [B3]; positivity
  have hB4 : 0 ≤ B4 := by dsimp only [B4]; positivity
  have hB5 : 0 ≤ B5 := by dsimp only [B5]; positivity
  have hL1 : 0 ≤ L1 := by dsimp only [L1]; positivity
  have hL2 : 0 ≤ L2 := by dsimp only [L2]; positivity
  have hL3 : 0 ≤ L3 := by dsimp only [L3]; positivity
  have hL4 : 0 ≤ L4 := by
    dsimp only [L4]
    exact mul_nonneg
      (mul_nonneg
        (mul_nonneg (vaughanFourthScaleLog_nonneg V x)
          (Real.sqrt_nonneg _)) hlogExpV) hlogFourX
  have hL1L : L1 ≤ L :=
    vaughanPrimitiveMeanLogScale_first_le U V x
  have hL2L : L2 ≤ L :=
    vaughanPrimitiveMeanLogScale_second_le U V x
  have hL3L : L3 ≤ L :=
    vaughanPrimitiveMeanLogScale_third_le U V x
  have hL4L : L4 ≤ L :=
    vaughanPrimitiveMeanLogScale_fourth_le U V x
  have hterm1 : A * B1 ≤ C * B1 * L := by
    calc
      A * B1 ≤ C * B1 :=
        mul_le_mul_of_nonneg_right
          (self_le_vaughanPrimitiveMeanCoefficient A) hB1
      _ = C * B1 * 1 := by ring
      _ ≤ C * B1 * L :=
        mul_le_mul_of_nonneg_left hLone (mul_nonneg hC0 hB1)
  have hterm2 : B2 * L1 ≤ C * B2 * L := by
    calc
      B2 * L1 ≤ B2 * L := mul_le_mul_of_nonneg_left hL1L hB2
      _ = 1 * (B2 * L) := by ring
      _ ≤ C * (B2 * L) :=
        mul_le_mul_of_nonneg_right hCone (mul_nonneg hB2 hL0)
      _ = C * B2 * L := by ring
  have hterm3 : B3 * L2 ≤ C * B3 * L := by
    calc
      B3 * L2 ≤ B3 * L := mul_le_mul_of_nonneg_left hL2L hB3
      _ = 1 * (B3 * L) := by ring
      _ ≤ C * (B3 * L) :=
        mul_le_mul_of_nonneg_right hCone (mul_nonneg hB3 hL0)
      _ = C * B3 * L := by ring
  have hterm4 :
      akbaryHambrookBilinearConstant / Real.log 2 * B4 * L3 ≤ C * B4 * L := by
    calc
      akbaryHambrookBilinearConstant / Real.log 2 * B4 * L3 =
          (akbaryHambrookBilinearConstant / Real.log 2) * (B4 * L3) := by ring
      _ ≤ C * (B4 * L3) := mul_le_mul_of_nonneg_right
        (akbaryHambrookBilinearConstant_div_log_two_le_vaughanPrimitiveMeanCoefficient A)
        (mul_nonneg hB4 hL3)
      _ = C * B4 * L3 := by ring
      _ ≤ C * B4 * L :=
        mul_le_mul_of_nonneg_left hL3L (mul_nonneg hC0 hB4)
  have hterm5 :
      vaughanFourthBlockConstant A / Real.log 2 * B5 * L4 ≤
        C * B5 * L := by
    calc
      vaughanFourthBlockConstant A / Real.log 2 * B5 * L4 =
          (vaughanFourthBlockConstant A / Real.log 2) * (B5 * L4) := by ring
      _ ≤ C * (B5 * L4) := mul_le_mul_of_nonneg_right
        (vaughanFourthBlockConstant_div_log_two_le_vaughanPrimitiveMeanCoefficient A)
        (mul_nonneg hB5 hL4)
      _ = C * B5 * L4 := by ring
      _ ≤ C * B5 * L :=
        mul_le_mul_of_nonneg_left hL4L (mul_nonneg hC0 hB5)
  have hmajorant :
      vaughanPrimitiveMeanMajorant A U V x Q =
        A * B1 + B2 * L1 + B3 * L2 +
          akbaryHambrookBilinearConstant / Real.log 2 * B4 * L3 +
          vaughanFourthBlockConstant A / Real.log 2 * B5 * L4 := by
    unfold vaughanPrimitiveMeanMajorant
    dsimp only [q, B1, B2, B3, B4, B5, L1, L2, L3, L4]
    ring
  have hscale :
      vaughanPrimitiveMeanAlgebraicScale U V x (Q : ℝ) =
        B1 + B2 + B3 + B4 + B5 := by
    unfold vaughanPrimitiveMeanAlgebraicScale
    dsimp only [q, B1, B2, B3, B4, B5]
  rw [hmajorant, hscale]
  change _ ≤ C * (B1 + B2 + B3 + B4 + B5) * L
  calc
    _ ≤ C * B1 * L + C * B2 * L + C * B3 * L +
        C * B4 * L + C * B5 * L := by linarith
    _ = C * (B1 + B2 + B3 + B4 + B5) * L := by ring

theorem vaughanPrimitiveMeanMajorant_low_le_polynomial_mul_logPower
    {A : ℝ} (hA : 1 ≤ A) {x Q : ℕ} (hx : 4 ≤ x)
    (hQ : (Q : ℝ) ≤ vaughanCubeRoot x) :
    vaughanPrimitiveMeanMajorant
        A (vaughanCubeRoot x) (vaughanCubeRoot x) x Q ≤
      vaughanPrimitiveMeanConstant A *
        vaughanPrimitiveMeanPolynomial x Q *
          vaughanPrimitiveMeanLogPower x := by
  have hx1 : 1 ≤ x := by omega
  have hc1 : 1 ≤ vaughanCubeRoot x := one_le_vaughanCubeRoot hx1
  have hcoefficient : 0 ≤ vaughanPrimitiveMeanCoefficient A :=
    vaughanPrimitiveMeanCoefficient_nonneg A
  have hscale : 0 ≤ vaughanPrimitiveMeanLogScale
      (vaughanCubeRoot x) (vaughanCubeRoot x) x :=
    vaughanPrimitiveMeanLogScale_nonneg _ _ _
  have hpolynomial : 0 ≤
      vaughanPrimitiveMeanPolynomial x (Q : ℝ) :=
    vaughanPrimitiveMeanPolynomial_nonneg x (by positivity)
  have hlogPower : 0 ≤ vaughanPrimitiveMeanLogPower x :=
    vaughanPrimitiveMeanLogPower_nonneg x
  have halgebraic :=
    vaughanPrimitiveMeanAlgebraicScale_low_le_polynomial
      hx (by positivity : (0 : ℝ) ≤ Q) hQ
  have hlog := vaughanPrimitiveMeanLogScale_low_le hx
  have hlogCoefficient :=
    vaughanPrimitiveMeanLowLogCoefficient_le_high
  calc
    vaughanPrimitiveMeanMajorant
        A (vaughanCubeRoot x) (vaughanCubeRoot x) x Q ≤
        vaughanPrimitiveMeanCoefficient A *
          vaughanPrimitiveMeanAlgebraicScale
            (vaughanCubeRoot x) (vaughanCubeRoot x) x (Q : ℝ) *
          vaughanPrimitiveMeanLogScale
            (vaughanCubeRoot x) (vaughanCubeRoot x) x :=
      vaughanPrimitiveMeanMajorant_le_coefficient_mul_scales
        hA hx hc1 hc1
    _ ≤ vaughanPrimitiveMeanCoefficient A *
          vaughanPrimitiveMeanPolynomial x Q *
          vaughanPrimitiveMeanLogScale
            (vaughanCubeRoot x) (vaughanCubeRoot x) x := by
      apply mul_le_mul_of_nonneg_right _ hscale
      exact mul_le_mul_of_nonneg_left halgebraic hcoefficient
    _ ≤ vaughanPrimitiveMeanCoefficient A *
          vaughanPrimitiveMeanPolynomial x Q *
          (vaughanPrimitiveMeanLowLogCoefficient *
            vaughanPrimitiveMeanLogPower x) :=
      mul_le_mul_of_nonneg_left hlog
        (mul_nonneg hcoefficient hpolynomial)
    _ ≤ vaughanPrimitiveMeanCoefficient A *
          vaughanPrimitiveMeanPolynomial x Q *
          (vaughanPrimitiveMeanHighLogCoefficient *
            vaughanPrimitiveMeanLogPower x) := by
      apply mul_le_mul_of_nonneg_left _
        (mul_nonneg hcoefficient hpolynomial)
      exact mul_le_mul_of_nonneg_right hlogCoefficient hlogPower
    _ = vaughanPrimitiveMeanConstant A *
          vaughanPrimitiveMeanPolynomial x Q *
          vaughanPrimitiveMeanLogPower x := by
      unfold vaughanPrimitiveMeanConstant
      ring

theorem vaughanPrimitiveMeanMajorant_high_le_polynomial_mul_logPower
    {A : ℝ} (hA : 1 ≤ A) {x Q : ℕ} (hx : 4 ≤ x)
    (hQ : vaughanCubeRoot x ≤ (Q : ℝ))
    (hQsqrt : (Q : ℝ) ≤ Real.sqrt (x : ℝ)) :
    vaughanPrimitiveMeanMajorant
        A (vaughanCubeRoot x ^ 2 / (Q : ℝ))
          (vaughanCubeRoot x ^ 2 / (Q : ℝ)) x Q ≤
      vaughanPrimitiveMeanConstant A *
        vaughanPrimitiveMeanPolynomial x Q *
          vaughanPrimitiveMeanLogPower x := by
  let U : ℝ := vaughanCubeRoot x ^ 2 / (Q : ℝ)
  have hU : 1 ≤ U :=
    one_le_vaughanPrimitiveMeanHighCutoff hx hQ hQsqrt
  have hcoefficient : 0 ≤ vaughanPrimitiveMeanCoefficient A :=
    vaughanPrimitiveMeanCoefficient_nonneg A
  have hscale : 0 ≤ vaughanPrimitiveMeanLogScale U U x :=
    vaughanPrimitiveMeanLogScale_nonneg _ _ _
  have hpolynomial : 0 ≤
      vaughanPrimitiveMeanPolynomial x (Q : ℝ) :=
    vaughanPrimitiveMeanPolynomial_nonneg x (by positivity)
  have halgebraic :=
    vaughanPrimitiveMeanAlgebraicScale_high_le_polynomial hx hQ hQsqrt
  have hlog := vaughanPrimitiveMeanLogScale_high_le hx hQ hQsqrt
  calc
    vaughanPrimitiveMeanMajorant A U U x Q ≤
        vaughanPrimitiveMeanCoefficient A *
          vaughanPrimitiveMeanAlgebraicScale U U x (Q : ℝ) *
          vaughanPrimitiveMeanLogScale U U x :=
      vaughanPrimitiveMeanMajorant_le_coefficient_mul_scales
        hA hx hU hU
    _ ≤ vaughanPrimitiveMeanCoefficient A *
          vaughanPrimitiveMeanPolynomial x Q *
          vaughanPrimitiveMeanLogScale U U x := by
      apply mul_le_mul_of_nonneg_right _ hscale
      exact mul_le_mul_of_nonneg_left halgebraic hcoefficient
    _ ≤ vaughanPrimitiveMeanCoefficient A *
          vaughanPrimitiveMeanPolynomial x Q *
          (vaughanPrimitiveMeanHighLogCoefficient *
            vaughanPrimitiveMeanLogPower x) :=
      mul_le_mul_of_nonneg_left hlog
        (mul_nonneg hcoefficient hpolynomial)
    _ = vaughanPrimitiveMeanConstant A *
          vaughanPrimitiveMeanPolynomial x Q *
          vaughanPrimitiveMeanLogPower x := by
      unfold vaughanPrimitiveMeanConstant
      ring

theorem self_le_vaughanPrimitiveMeanConstant
    (A : ℝ) :
    A ≤ vaughanPrimitiveMeanConstant A := by
  unfold vaughanPrimitiveMeanConstant
  calc
    A ≤ vaughanPrimitiveMeanCoefficient A :=
      self_le_vaughanPrimitiveMeanCoefficient A
    _ = vaughanPrimitiveMeanCoefficient A * 1 := by ring
    _ ≤ vaughanPrimitiveMeanCoefficient A *
        vaughanPrimitiveMeanHighLogCoefficient :=
      mul_le_mul_of_nonneg_left
        one_le_vaughanPrimitiveMeanHighLogCoefficient
        (vaughanPrimitiveMeanCoefficient_nonneg A)

theorem primitiveRawMeanValueCumulative_nat_le_vaughan_bound_of_psi
    {A : ℝ} (hA : 1 ≤ A)
    (hpsi : ∀ z : ℝ, 0 ≤ z → Chebyshev.psi z ≤ A * z)
    {x Q : ℕ} (hx : 4 ≤ x)
    (hQsqrt : (Q : ℝ) ≤ Real.sqrt (x : ℝ)) :
    primitiveRawMeanValueCumulative x Q ≤
      vaughanPrimitiveMeanConstant A *
        vaughanPrimitiveMeanPolynomial x Q *
          vaughanPrimitiveMeanLogPower x := by
  have hA0 : 0 ≤ A := zero_le_one.trans hA
  by_cases hQlarge : 2 ≤ Q
  · by_cases hQlow : (Q : ℝ) ≤ vaughanCubeRoot x
    · exact
        (primitiveRawMeanValueCumulative_nat_le_vaughanPrimitiveMeanMajorant_of_psi
          hA0 hpsi hx (one_le_vaughanCubeRoot (by omega))
            (one_le_vaughanCubeRoot (by omega)) hQlarge hQsqrt).trans
          (vaughanPrimitiveMeanMajorant_low_le_polynomial_mul_logPower hA hx hQlow)
    · have hQhigh : vaughanCubeRoot x ≤ (Q : ℝ) := le_of_not_ge hQlow
      have hcutoff : 1 ≤ vaughanCubeRoot x ^ 2 / (Q : ℝ) :=
        one_le_vaughanPrimitiveMeanHighCutoff hx hQhigh hQsqrt
      exact
        (primitiveRawMeanValueCumulative_nat_le_vaughanPrimitiveMeanMajorant_of_psi
          hA0 hpsi hx hcutoff hcutoff hQlarge hQsqrt).trans
          (vaughanPrimitiveMeanMajorant_high_le_polynomial_mul_logPower
            hA hx hQhigh hQsqrt)
  · have hQone : Q ≤ 1 := by omega
    have hQoneReal : (Q : ℝ) ≤ 1 := by exact_mod_cast hQone
    have hQsq : (Q : ℝ) ^ 2 ≤ 1 := by
      have hQ0 : (0 : ℝ) ≤ Q := by positivity
      nlinarith
    have hpsiX : Chebyshev.psi x ≤ A * (x : ℝ) :=
      hpsi (x : ℝ) (by positivity)
    have hsmall : primitiveRawMeanValueCumulative x Q ≤ A * (x : ℝ) := by
      calc
        primitiveRawMeanValueCumulative x Q ≤
            Chebyshev.psi x * (Q : ℝ) ^ 2 :=
          primitiveRawMeanValueCumulative_nat_le_psi_mul_sq x Q
        _ ≤ (A * (x : ℝ)) * (Q : ℝ) ^ 2 :=
          mul_le_mul_of_nonneg_right hpsiX (sq_nonneg _)
        _ ≤ A * (x : ℝ) := by
          simpa only [mul_one] using
            mul_le_mul_of_nonneg_left hQsq
              (mul_nonneg hA0 (by positivity : (0 : ℝ) ≤ x))
    have hconstant : A ≤ vaughanPrimitiveMeanConstant A :=
      self_le_vaughanPrimitiveMeanConstant A
    have hconstant0 : 0 ≤ vaughanPrimitiveMeanConstant A :=
      vaughanPrimitiveMeanConstant_nonneg A
    have hpolynomial : (x : ℝ) ≤
        vaughanPrimitiveMeanPolynomial x (Q : ℝ) :=
      natCast_le_vaughanPrimitiveMeanPolynomial x (by positivity)
    have hpolynomial0 : 0 ≤
        vaughanPrimitiveMeanPolynomial x (Q : ℝ) :=
      vaughanPrimitiveMeanPolynomial_nonneg x (by positivity)
    have hlogPower : 1 ≤ vaughanPrimitiveMeanLogPower x :=
      one_le_vaughanPrimitiveMeanLogPower hx
    apply hsmall.trans
    calc
      A * (x : ℝ) ≤
          vaughanPrimitiveMeanConstant A *
            vaughanPrimitiveMeanPolynomial x Q :=
        mul_le_mul hconstant hpolynomial (by positivity) hconstant0
      _ = vaughanPrimitiveMeanConstant A *
          vaughanPrimitiveMeanPolynomial x Q * 1 := by ring
      _ ≤ vaughanPrimitiveMeanConstant A *
          vaughanPrimitiveMeanPolynomial x Q *
            vaughanPrimitiveMeanLogPower x :=
        mul_le_mul_of_nonneg_left hlogPower
          (mul_nonneg hconstant0 hpolynomial0)

theorem primitiveRawMeanValueCumulative_le_vaughan_bound_of_psi
    {A t : ℝ} (hA : 1 ≤ A)
    (hpsi : ∀ z : ℝ, 0 ≤ z → Chebyshev.psi z ≤ A * z)
    {x : ℕ} (hx : 4 ≤ x) (ht0 : 0 ≤ t)
    (htsqrt : t ≤ Real.sqrt (x : ℝ)) :
    primitiveRawMeanValueCumulative x t ≤
      vaughanPrimitiveMeanConstant A *
        vaughanPrimitiveMeanPolynomial x t *
          vaughanPrimitiveMeanLogPower x := by
  have hfloor : (⌊t⌋₊ : ℝ) ≤ t := Nat.floor_le ht0
  have hfloorSqrt : (⌊t⌋₊ : ℝ) ≤ Real.sqrt (x : ℝ) :=
    hfloor.trans htsqrt
  have hnatural :=
    primitiveRawMeanValueCumulative_nat_le_vaughan_bound_of_psi
      hA hpsi hx hfloorSqrt
  have hpolynomial :=
    vaughanPrimitiveMeanPolynomial_mono x
      (Nat.cast_nonneg ⌊t⌋₊) hfloor
  have hconstant0 : 0 ≤ vaughanPrimitiveMeanConstant A :=
    vaughanPrimitiveMeanConstant_nonneg A
  have hlogPower0 : 0 ≤ vaughanPrimitiveMeanLogPower x :=
    vaughanPrimitiveMeanLogPower_nonneg x
  have henlarged :
      primitiveRawMeanValueCumulative x (⌊t⌋₊ : ℝ) ≤
        vaughanPrimitiveMeanConstant A *
          vaughanPrimitiveMeanPolynomial x t *
            vaughanPrimitiveMeanLogPower x := by
    apply hnatural.trans
    apply mul_le_mul_of_nonneg_right _ hlogPower0
    exact mul_le_mul_of_nonneg_left hpolynomial hconstant0
  simpa only [primitiveRawMeanValueCumulative, Nat.floor_natCast] using
    henlarged

theorem exists_vaughanPrimitiveMeanAbelEnvelope_mul_logPower_le_logSaving
    (A : ℝ) (hA : 0 ≤ A) :
    ∃ X0 : ℕ, 4 ≤ X0 ∧
      ∀ x : ℕ, X0 ≤ x →
        ∀ Q : ℕ, siegelWalfiszConductorCutoff (A + 5) x ≤ Q →
          (Q : ℝ) ≤ Real.sqrt (x : ℝ) /
              Real.rpow (Real.log (x : ℝ)) (A + 5) →
            vaughanPrimitiveMeanAbelEnvelope x
                (siegelWalfiszConductorCutoff (A + 5) x : ℝ) Q *
                vaughanProgressionMeanLogPower x ≤
              40 * (x : ℝ) /
                Real.rpow (Real.log (x : ℝ)) A := by
  obtain ⟨Xthird, hXthird, hthirdGrowth⟩ :=
    exists_log_rpow_natCast_le_rpow (A + 5) (1 / 12) (by norm_num)
  obtain ⟨Xfourth, hXfourth, hfourthGrowth⟩ :=
    exists_log_rpow_natCast_le_rpow (A + 6) (1 / 6) (by norm_num)
  refine ⟨max Xthird Xfourth,
    hXthird.trans (le_max_left Xthird Xfourth), ?_⟩
  intro x hx Q hRQ hQrange
  have hxThird : Xthird ≤ x :=
    (le_max_left Xthird Xfourth).trans hx
  have hxFourth : Xfourth ≤ x :=
    (le_max_right Xthird Xfourth).trans hx
  have hx4 : 4 ≤ x := hXthird.trans hxThird
  have hxone : 1 ≤ x := by omega
  have hxpos : (0 : ℝ) < (x : ℝ) := by positivity
  have hlogOne : 1 ≤ Real.log (x : ℝ) := one_le_log_natCast hx4
  have hlogPos : 0 < Real.log (x : ℝ) := zero_lt_one.trans_le hlogOne
  have hApFive : 0 < A + 5 := by linarith
  have hscaleOne :
      1 ≤ Real.rpow (Real.log (x : ℝ)) (A + 5) :=
    Real.one_le_rpow hlogOne hApFive.le
  have hscalePos :
      0 < Real.rpow (Real.log (x : ℝ)) (A + 5) :=
    Real.rpow_pos_of_pos hlogPos _
  have hsavePos : 0 < Real.rpow (Real.log (x : ℝ)) A :=
    Real.rpow_pos_of_pos hlogPos _
  have hRone : 1 ≤ siegelWalfiszConductorCutoff (A + 5) x :=
    one_le_siegelWalfiszConductorCutoff hApFive hx4
  have hRoneReal :
      (1 : ℝ) ≤ (siegelWalfiszConductorCutoff (A + 5) x : ℝ) := by
    exact_mod_cast hRone
  have hRpos :
      (0 : ℝ) < (siegelWalfiszConductorCutoff (A + 5) x : ℝ) :=
    zero_lt_one.trans_le hRoneReal
  have hRQReal :
      (siegelWalfiszConductorCutoff (A + 5) x : ℝ) ≤ (Q : ℝ) := by
    exact_mod_cast hRQ
  have hQnonneg : (0 : ℝ) ≤ (Q : ℝ) := Nat.cast_nonneg Q
  have hQsqrt : (Q : ℝ) ≤ Real.sqrt (x : ℝ) :=
    hQrange.trans (div_le_self (Real.sqrt_nonneg _) hscaleOne)
  have hlogPowerNonneg :=
    vaughanProgressionMeanLogPower_nonneg x
  have hlogPowerLe :=
    vaughanProgressionMeanLogPower_le_log_pow_five hx4
  have hscaleSplit :
      Real.rpow (Real.log (x : ℝ)) (A + 5) =
        Real.rpow (Real.log (x : ℝ)) A * Real.log (x : ℝ) ^ 5 := by
    simpa only [Real.rpow_eq_pow, Nat.cast_ofNat] using
      Real.rpow_add_natCast hlogPos.ne' A 5
  have hscaleSixSplit :
      Real.rpow (Real.log (x : ℝ)) (A + 6) =
        Real.rpow (Real.log (x : ℝ)) A * Real.log (x : ℝ) ^ 6 := by
    simpa only [Real.rpow_eq_pow, Nat.cast_ofNat] using
      Real.rpow_add_natCast hlogPos.ne' A 6
  have hfloor :
      Real.rpow (Real.log (x : ℝ)) (A + 5) / 2 <
        (siegelWalfiszConductorCutoff (A + 5) x : ℝ) :=
    Nat.div_two_lt_floor hscaleOne
  have hlogFifthDivFloor :
      Real.log (x : ℝ) ^ 5 /
          (siegelWalfiszConductorCutoff (A + 5) x : ℝ) ≤
        2 / Real.rpow (Real.log (x : ℝ)) A := by
    apply (div_le_div_iff₀ hRpos hsavePos).2
    rw [mul_comm, ← hscaleSplit]
    nlinarith
  have hfirst :
      (4 * (x : ℝ) /
          (siegelWalfiszConductorCutoff (A + 5) x : ℝ)) *
          vaughanProgressionMeanLogPower x ≤
        8 * ((x : ℝ) / Real.rpow (Real.log (x : ℝ)) A) := by
    have hp := mul_le_mul_of_nonneg_left hlogPowerLe
      (by positivity : 0 ≤ 4 * (x : ℝ) /
        (siegelWalfiszConductorCutoff (A + 5) x : ℝ))
    have hr := mul_le_mul_of_nonneg_left hlogFifthDivFloor
      (by positivity : 0 ≤ 4 * (x : ℝ))
    simp only [div_eq_mul_inv] at hp hr ⊢
    nlinarith only [hp, hr]
  have hQScale :
      (Q : ℝ) * Real.rpow (Real.log (x : ℝ)) (A + 5) ≤
        Real.sqrt (x : ℝ) :=
    (le_div_iff₀ hscalePos).1 hQrange
  have hQLogFifth :
      (Q : ℝ) * Real.log (x : ℝ) ^ 5 ≤
        Real.sqrt (x : ℝ) /
          Real.rpow (Real.log (x : ℝ)) A := by
    apply (le_div_iff₀ hsavePos).2
    simpa only [hscaleSplit, mul_comm, mul_left_comm, mul_assoc] using hQScale
  have hsecond :
      (4 * Real.sqrt (x : ℝ) * (Q : ℝ)) *
          vaughanProgressionMeanLogPower x ≤
        4 * ((x : ℝ) / Real.rpow (Real.log (x : ℝ)) A) := by
    have hp := mul_le_mul_of_nonneg_left hlogPowerLe
      (by positivity : 0 ≤ 4 * Real.sqrt (x : ℝ) * (Q : ℝ))
    have hq := mul_le_mul_of_nonneg_left hQLogFifth (Real.sqrt_nonneg (x : ℝ))
    rw [← mul_div_assoc, Real.mul_self_sqrt hxpos.le] at hq
    nlinarith only [hp, hq]
  have hthirdPower := hthirdGrowth x hxThird
  have hXElevenAdd :
      Real.rpow (x : ℝ) (11 / 12 : ℝ) *
          Real.rpow (x : ℝ) (1 / 12 : ℝ) = (x : ℝ) := by
    norm_num only [Real.rpow_eq_pow, ← Real.rpow_add hxpos, Real.rpow_one]
  have hthirdScale :
      Real.rpow (x : ℝ) (11 / 12 : ℝ) *
          Real.log (x : ℝ) ^ 5 ≤
        (x : ℝ) / Real.rpow (Real.log (x : ℝ)) A := by
    apply (le_div_iff₀ hsavePos).2
    have h := mul_le_mul_of_nonneg_left hthirdPower
      (show 0 ≤ Real.rpow (x : ℝ) (11 / 12 : ℝ) from
        Real.rpow_nonneg hxpos.le _)
    rw [hscaleSplit, hXElevenAdd] at h
    nlinarith only [h]
  have hthirdRoot :=
    vaughanCubeRoot_sq_mul_sqrt_le_rpow_eleven_twelfths hxone hQsqrt
  have hthird :
      (18 * vaughanCubeRoot x ^ 2 * Real.sqrt (Q : ℝ)) *
          vaughanProgressionMeanLogPower x ≤
        18 * ((x : ℝ) / Real.rpow (Real.log (x : ℝ)) A) := by
    have h := (mul_le_mul hthirdRoot hlogPowerLe hlogPowerNonneg
      (Real.rpow_nonneg hxpos.le _)).trans hthirdScale
    nlinarith only [h]
  have hQdivRone :
      (1 : ℝ) ≤ (Q : ℝ) /
          (siegelWalfiszConductorCutoff (A + 5) x : ℝ) :=
    (one_le_div hRpos).2 hRQReal
  have hargOne :
      (1 : ℝ) ≤ Real.exp 1 * (Q : ℝ) /
          (siegelWalfiszConductorCutoff (A + 5) x : ℝ) := by
    simpa only [mul_div_assoc] using
      one_le_mul_of_one_le_of_one_le (Real.one_le_exp (by norm_num)) hQdivRone
  have hargPos :
      0 < Real.exp 1 * (Q : ℝ) /
          (siegelWalfiszConductorCutoff (A + 5) x : ℝ) :=
    zero_lt_one.trans_le hargOne
  have hargLe :
      Real.exp 1 * (Q : ℝ) /
          (siegelWalfiszConductorCutoff (A + 5) x : ℝ) ≤
        Real.exp 1 * Real.sqrt (x : ℝ) :=
    (div_le_self
      (mul_nonneg (Real.exp_pos 1).le hQnonneg) hRoneReal).trans
      (mul_le_mul_of_nonneg_left hQsqrt (Real.exp_pos 1).le)
  have hlogRatio :
      Real.log (Real.exp 1 * (Q : ℝ) /
          (siegelWalfiszConductorCutoff (A + 5) x : ℝ)) ≤
        (5 / 4 : ℝ) * Real.log (x : ℝ) := by
    exact (Real.log_le_log hargPos hargLe).trans
      (log_exp_mul_sqrt_lt_five_fourths_mul_log
        (show (4 : ℝ) ≤ (x : ℝ) by exact_mod_cast hx4)).le
  have hfourthPower := hfourthGrowth x hxFourth
  have hXFiveAdd :
      Real.rpow (x : ℝ) (5 / 6 : ℝ) *
          Real.rpow (x : ℝ) (1 / 6 : ℝ) = (x : ℝ) := by
    norm_num only [Real.rpow_eq_pow, ← Real.rpow_add hxpos, Real.rpow_one]
  have hfourthScale :
      Real.rpow (x : ℝ) (5 / 6 : ℝ) *
          Real.log (x : ℝ) ^ 6 ≤
        (x : ℝ) / Real.rpow (Real.log (x : ℝ)) A := by
    apply (le_div_iff₀ hsavePos).2
    have h := mul_le_mul_of_nonneg_left hfourthPower
      (show 0 ≤ Real.rpow (x : ℝ) (5 / 6 : ℝ) from
        Real.rpow_nonneg hxpos.le _)
    rw [hscaleSixSplit, hXFiveAdd] at h
    nlinarith only [h]
  have hfourthRoot :=
    sqrt_mul_vaughanCubeRoot_eq_rpow_five_sixths hxone
  have hfourth :
      (5 * (Real.sqrt (x : ℝ) * vaughanCubeRoot x) *
          Real.log (Real.exp 1 * (Q : ℝ) /
            (siegelWalfiszConductorCutoff (A + 5) x : ℝ))) *
          vaughanProgressionMeanLogPower x ≤
        (25 / 4 : ℝ) * ((x : ℝ) /
          Real.rpow (Real.log (x : ℝ)) A) := by
    rw [hfourthRoot]
    have h := mul_le_mul_of_nonneg_left
      (mul_le_mul hlogRatio hlogPowerLe hlogPowerNonneg (by positivity))
      (show 0 ≤ 5 * Real.rpow (x : ℝ) (5 / 6 : ℝ) from
        mul_nonneg (by norm_num) (Real.rpow_nonneg hxpos.le _))
    nlinarith only [h, hfourthScale]
  have htargetNonneg :
      0 ≤ (x : ℝ) / Real.rpow (Real.log (x : ℝ)) A := by positivity
  unfold vaughanPrimitiveMeanAbelEnvelope
  simp only [div_eq_mul_inv] at hfirst hsecond hthird hfourth htargetNonneg ⊢
  nlinarith only [hfirst, hsecond, hthird, hfourth, htargetNonneg]

theorem primitiveRawMeanValueCumulative_measurable (x : ℕ) :
    Measurable (primitiveRawMeanValueCumulative x) := by
  unfold primitiveRawMeanValueCumulative
  change Measurable
    ((fun n : ℕ ↦ ∑ q ∈ Finset.Icc 0 n,
      primitiveRawMeanValueWeight x q) ∘ (Nat.floor : ℝ → ℕ))
  exact
    (measurable_of_countable
      (fun n : ℕ ↦ ∑ q ∈ Finset.Icc 0 n, primitiveRawMeanValueWeight x q)).comp
        (Nat.measurable_floor (R := ℝ))

theorem primitiveRawMeanValueCumulative_div_sq_le_of_psi
    {A : ℝ} (hA : 1 ≤ A)
    (hpsi : ∀ z : ℝ, 0 ≤ z → Chebyshev.psi z ≤ A * z)
    {x : ℕ} (hx : 4 ≤ x) {Q1 Q t : ℝ}
    (hQ1 : 1 ≤ Q1)
    (hQsqrt : Q ≤ Real.sqrt (x : ℝ)) (ht : t ∈ Set.Ioc Q1 Q) :
    primitiveRawMeanValueCumulative x t / t ^ 2 ≤
      (vaughanPrimitiveMeanConstant A *
          vaughanPrimitiveMeanLogPower x) *
        (vaughanPrimitiveMeanPolynomial x t / t ^ 2) := by
  have ht0 : 0 ≤ t := (zero_le_one.trans hQ1).trans ht.1.le
  have htsqrt : t ≤ Real.sqrt (x : ℝ) := ht.2.trans hQsqrt
  have hcumulative :=
    primitiveRawMeanValueCumulative_le_vaughan_bound_of_psi
      hA hpsi hx ht0 htsqrt
  calc
    primitiveRawMeanValueCumulative x t / t ^ 2 ≤
        (vaughanPrimitiveMeanConstant A *
          vaughanPrimitiveMeanPolynomial x t *
            vaughanPrimitiveMeanLogPower x) / t ^ 2 :=
      div_le_div_of_nonneg_right hcumulative (sq_nonneg t)
    _ = (vaughanPrimitiveMeanConstant A *
          vaughanPrimitiveMeanLogPower x) *
        (vaughanPrimitiveMeanPolynomial x t / t ^ 2) := by
      ring

theorem integrableOn_scaled_vaughanPrimitiveMeanPolynomial_div_sq
    (A : ℝ) (x : ℕ) {Q1 Q : ℝ} (hQ1 : 1 ≤ Q1) (hQ : Q1 ≤ Q) :
    IntegrableOn
      (fun t ↦ (vaughanPrimitiveMeanConstant A *
          vaughanPrimitiveMeanLogPower x) *
        (vaughanPrimitiveMeanPolynomial x t / t ^ 2))
      (Set.Ioc Q1 Q) := by
  have hbase : IntegrableOn
      (fun t ↦ vaughanPrimitiveMeanPolynomial x t / t ^ 2)
      (Set.Ioc Q1 Q) :=
    (intervalIntegrable_iff_integrableOn_Ioc_of_le hQ).mp
      (vaughanPrimitiveMeanPolynomial_div_sq_intervalIntegrable x hQ1 hQ)
  exact hbase.const_mul _

theorem integrableOn_primitiveRawMeanValueCumulative_div_sq_of_psi
    {A : ℝ} (hA : 1 ≤ A)
    (hpsi : ∀ z : ℝ, 0 ≤ z → Chebyshev.psi z ≤ A * z)
    {x : ℕ} (hx : 4 ≤ x) {Q1 Q : ℝ}
    (hQ1 : 1 ≤ Q1) (hQ : Q1 ≤ Q)
    (hQsqrt : Q ≤ Real.sqrt (x : ℝ)) :
    IntegrableOn
      (fun t ↦ primitiveRawMeanValueCumulative x t / t ^ 2)
      (Set.Ioc Q1 Q) := by
  have hscaled :=
    integrableOn_scaled_vaughanPrimitiveMeanPolynomial_div_sq
      A x hQ1 hQ
  have hmeasurable : Measurable
      (fun t ↦ primitiveRawMeanValueCumulative x t / t ^ 2) :=
    (primitiveRawMeanValueCumulative_measurable x).div
      (measurable_id.pow_const 2)
  apply Integrable.mono_nonneg hscaled
  · exact hmeasurable.aestronglyMeasurable.restrict
  · exact ae_restrict_of_forall_mem measurableSet_Ioc fun t _ ↦
      div_nonneg (primitiveRawMeanValueCumulative_nonneg x t) (sq_nonneg t)
  · exact ae_restrict_of_forall_mem measurableSet_Ioc fun _ ht ↦
      primitiveRawMeanValueCumulative_div_sq_le_of_psi
        hA hpsi hx hQ1 hQsqrt ht

theorem integral_primitiveRawMeanValueCumulative_div_sq_le_of_psi
    {A : ℝ} (hA : 1 ≤ A)
    (hpsi : ∀ z : ℝ, 0 ≤ z → Chebyshev.psi z ≤ A * z)
    {x : ℕ} (hx : 4 ≤ x) {Q1 Q : ℝ}
    (hQ1 : 1 ≤ Q1) (hQ : Q1 ≤ Q)
    (hQsqrt : Q ≤ Real.sqrt (x : ℝ)) :
    (∫ t in Set.Ioc Q1 Q,
      primitiveRawMeanValueCumulative x t / t ^ 2) ≤
      (vaughanPrimitiveMeanConstant A *
          vaughanPrimitiveMeanLogPower x) *
        ∫ t in Set.Ioc Q1 Q,
          vaughanPrimitiveMeanPolynomial x t / t ^ 2 := by
  have hcumulative :=
    integrableOn_primitiveRawMeanValueCumulative_div_sq_of_psi
      hA hpsi hx hQ1 hQ hQsqrt
  have hscaled :=
    integrableOn_scaled_vaughanPrimitiveMeanPolynomial_div_sq
      A x hQ1 hQ
  calc
    (∫ t in Set.Ioc Q1 Q,
        primitiveRawMeanValueCumulative x t / t ^ 2) ≤
        ∫ t in Set.Ioc Q1 Q,
          (vaughanPrimitiveMeanConstant A *
              vaughanPrimitiveMeanLogPower x) *
            (vaughanPrimitiveMeanPolynomial x t / t ^ 2) := by
      apply integral_mono_ae hcumulative hscaled
      exact ae_restrict_of_forall_mem measurableSet_Ioc fun _ ht ↦
        primitiveRawMeanValueCumulative_div_sq_le_of_psi
          hA hpsi hx hQ1 hQsqrt ht
    _ = (vaughanPrimitiveMeanConstant A *
          vaughanPrimitiveMeanLogPower x) *
        ∫ t in Set.Ioc Q1 Q,
          vaughanPrimitiveMeanPolynomial x t / t ^ 2 := by
      rw [integral_const_mul]

theorem primitiveRawMeanValue_lowerBoundary_nonpos
    (x : ℕ) {Q1 : ℝ} (hQ1 : 0 ≤ Q1) :
    -(Q1⁻¹ * primitiveRawMeanValueCumulative x Q1) ≤ 0 :=
  neg_nonpos.mpr
    (mul_nonneg (inv_nonneg.mpr hQ1)
      (primitiveRawMeanValueCumulative_nonneg x Q1))

theorem primitiveRawMeanValueAbelExpression_natUpper_le_sharp_of_psi
    {A : ℝ} (hA : 1 ≤ A)
    (hpsi : ∀ z : ℝ, 0 ≤ z → Chebyshev.psi z ≤ A * z)
    {x Q : ℕ} (hx : 4 ≤ x) {Q1 : ℝ}
    (hQ1 : 1 ≤ Q1) (hQ : Q1 ≤ (Q : ℝ))
    (hQsqrt : (Q : ℝ) ≤ Real.sqrt (x : ℝ)) :
    (Q : ℝ)⁻¹ * primitiveRawMeanValueCumulative x Q -
        Q1⁻¹ * primitiveRawMeanValueCumulative x Q1 +
        ∫ t in Set.Ioc Q1 (Q : ℝ),
          primitiveRawMeanValueCumulative x t / t ^ 2 ≤
      vaughanPrimitiveMeanConstant A *
          vaughanPrimitiveMeanAbelSharpPolynomial x Q1 (Q : ℝ) *
          vaughanPrimitiveMeanLogPower x -
        Q1⁻¹ * primitiveRawMeanValueCumulative x Q1 := by
  have hQ0 : 0 ≤ (Q : ℝ) := (zero_le_one.trans hQ1).trans hQ
  have hendpointBound :=
    primitiveRawMeanValueCumulative_le_vaughan_bound_of_psi
      hA hpsi hx hQ0 hQsqrt
  have hendpoint :
      (Q : ℝ)⁻¹ * primitiveRawMeanValueCumulative x Q ≤
        (Q : ℝ)⁻¹ *
          (vaughanPrimitiveMeanConstant A *
            vaughanPrimitiveMeanPolynomial x Q *
              vaughanPrimitiveMeanLogPower x) :=
    mul_le_mul_of_nonneg_left hendpointBound (inv_nonneg.mpr hQ0)
  have hintegral :=
    integral_primitiveRawMeanValueCumulative_div_sq_le_of_psi
      hA hpsi hx hQ1 hQ hQsqrt
  calc
    (Q : ℝ)⁻¹ * primitiveRawMeanValueCumulative x Q -
          Q1⁻¹ * primitiveRawMeanValueCumulative x Q1 +
          ∫ t in Set.Ioc Q1 (Q : ℝ),
            primitiveRawMeanValueCumulative x t / t ^ 2 ≤
        (Q : ℝ)⁻¹ *
            (vaughanPrimitiveMeanConstant A *
              vaughanPrimitiveMeanPolynomial x Q *
                vaughanPrimitiveMeanLogPower x) -
          Q1⁻¹ * primitiveRawMeanValueCumulative x Q1 +
          (vaughanPrimitiveMeanConstant A *
              vaughanPrimitiveMeanLogPower x) *
            ∫ t in Set.Ioc Q1 (Q : ℝ),
              vaughanPrimitiveMeanPolynomial x t / t ^ 2 := by
      linarith
    _ = vaughanPrimitiveMeanConstant A *
          ((Q : ℝ)⁻¹ *
              vaughanPrimitiveMeanPolynomial x Q +
            ∫ t in Set.Ioc Q1 (Q : ℝ),
              vaughanPrimitiveMeanPolynomial x t / t ^ 2) *
          vaughanPrimitiveMeanLogPower x -
        Q1⁻¹ * primitiveRawMeanValueCumulative x Q1 := by
      ring
    _ = vaughanPrimitiveMeanConstant A *
          vaughanPrimitiveMeanAbelSharpPolynomial x Q1 (Q : ℝ) *
          vaughanPrimitiveMeanLogPower x -
        Q1⁻¹ * primitiveRawMeanValueCumulative x Q1 := by
      rw [inv_mul_polynomial_add_integral_eq_abelSharp x hQ1 hQ]

theorem primitiveRawMeanValueAbelExpression_natUpper_le_envelope_of_psi
    {A : ℝ} (hA : 1 ≤ A)
    (hpsi : ∀ z : ℝ, 0 ≤ z → Chebyshev.psi z ≤ A * z)
    {x Q : ℕ} (hx : 4 ≤ x) {Q1 : ℝ}
    (hQ1 : 1 ≤ Q1) (hQ : Q1 ≤ (Q : ℝ))
    (hQsqrt : (Q : ℝ) ≤ Real.sqrt (x : ℝ)) :
    (Q : ℝ)⁻¹ * primitiveRawMeanValueCumulative x Q -
        Q1⁻¹ * primitiveRawMeanValueCumulative x Q1 +
        ∫ t in Set.Ioc Q1 (Q : ℝ),
          primitiveRawMeanValueCumulative x t / t ^ 2 ≤
      vaughanPrimitiveMeanConstant A *
        vaughanPrimitiveMeanAbelEnvelope x Q1 Q *
          vaughanPrimitiveMeanLogPower x := by
  have hsharp :=
    primitiveRawMeanValueAbelExpression_natUpper_le_sharp_of_psi
      hA hpsi hx hQ1 hQ hQsqrt
  have hlower := primitiveRawMeanValue_lowerBoundary_nonpos x
    (zero_le_one.trans hQ1)
  have henvelope :=
    vaughanPrimitiveMeanAbelSharpPolynomial_le_envelope x hQ1 hQ
  have hconstant : 0 ≤ vaughanPrimitiveMeanConstant A :=
    vaughanPrimitiveMeanConstant_nonneg A
  have hlogPower : 0 ≤ vaughanPrimitiveMeanLogPower x :=
    vaughanPrimitiveMeanLogPower_nonneg x
  calc
    (Q : ℝ)⁻¹ * primitiveRawMeanValueCumulative x Q -
          Q1⁻¹ * primitiveRawMeanValueCumulative x Q1 +
          ∫ t in Set.Ioc Q1 (Q : ℝ),
            primitiveRawMeanValueCumulative x t / t ^ 2 ≤
        vaughanPrimitiveMeanConstant A *
            vaughanPrimitiveMeanAbelSharpPolynomial x Q1 (Q : ℝ) *
            vaughanPrimitiveMeanLogPower x -
          Q1⁻¹ * primitiveRawMeanValueCumulative x Q1 := hsharp
    _ ≤ vaughanPrimitiveMeanConstant A *
        vaughanPrimitiveMeanAbelSharpPolynomial x Q1 (Q : ℝ) *
          vaughanPrimitiveMeanLogPower x := by
      linarith
    _ ≤ vaughanPrimitiveMeanConstant A *
        vaughanPrimitiveMeanAbelEnvelope x Q1 Q *
          vaughanPrimitiveMeanLogPower x :=
      mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_left henvelope hconstant) hlogPower

theorem largeConductorCenteredMass_le_abelEnvelope_of_psi
    {A : ℝ} (hA : 1 ≤ A)
    (hpsi : ∀ z : ℝ, 0 ≤ z → Chebyshev.psi z ≤ A * z)
    (x Q R : ℕ) (hx : 4 ≤ x)
    (hQsqrt : (Q : ℝ) ≤ Real.sqrt (x : ℝ))
    (hR : 1 ≤ R) (hRQ : R ≤ Q) :
    largeConductorCenteredMass x Q R ≤
      (5 * vaughanPrimitiveMeanConstant A) *
        vaughanPrimitiveMeanAbelEnvelope x (R : ℝ) Q *
          vaughanProgressionMeanLogPower x := by
  have hRreal : (1 : ℝ) ≤ (R : ℝ) := by exact_mod_cast hR
  have hRQreal : (R : ℝ) ≤ (Q : ℝ) := by exact_mod_cast hRQ
  have habelEq :
      (∑ d ∈ Finset.Ioc R Q,
          primitiveRawMeanValueWeight x d / (d : ℝ)) =
        (Q : ℝ)⁻¹ * primitiveRawMeanValueCumulative x Q -
          (R : ℝ)⁻¹ * primitiveRawMeanValueCumulative x R +
            ∫ t in Set.Ioc (R : ℝ) (Q : ℝ),
              primitiveRawMeanValueCumulative x t / t ^ 2 := by
    simpa only [Nat.floor_natCast] using
      (sum_meanValueWeight_div_eq_rawPrimitiveAbel_natUpper
        x Q (R : ℝ) hRreal hRQreal)
  have habelBound :=
    primitiveRawMeanValueAbelExpression_natUpper_le_envelope_of_psi
      hA hpsi hx hRreal hRQreal hQsqrt
  have hlog : 0 ≤ 5 * Real.log (x : ℝ) := by
    apply mul_nonneg (by norm_num)
    exact Real.log_nonneg (by exact_mod_cast (show 1 ≤ x by omega))
  calc
    largeConductorCenteredMass x Q R ≤
        (5 * Real.log (x : ℝ)) *
          ∑ d ∈ Finset.Ioc R Q,
            primitiveRawMeanValueWeight x d / (d : ℝ) :=
      largeConductorCenteredMass_le_five_log_meanValueInterval
        x Q R hx hQsqrt hR
    _ = (5 * Real.log (x : ℝ)) *
        ((Q : ℝ)⁻¹ * primitiveRawMeanValueCumulative x Q -
          (R : ℝ)⁻¹ * primitiveRawMeanValueCumulative x R +
            ∫ t in Set.Ioc (R : ℝ) (Q : ℝ),
              primitiveRawMeanValueCumulative x t / t ^ 2) := by rw [habelEq]
    _ ≤ (5 * Real.log (x : ℝ)) *
        (vaughanPrimitiveMeanConstant A *
          vaughanPrimitiveMeanAbelEnvelope x (R : ℝ) Q *
            vaughanPrimitiveMeanLogPower x) :=
      mul_le_mul_of_nonneg_left habelBound hlog
    _ = vaughanPrimitiveMeanConstant A *
        vaughanPrimitiveMeanAbelEnvelope x (R : ℝ) Q *
          ((5 * Real.log (x : ℝ)) *
            vaughanPrimitiveMeanLogPower x) := by ring
    _ = vaughanPrimitiveMeanConstant A *
        vaughanPrimitiveMeanAbelEnvelope x (R : ℝ) Q *
          (5 * vaughanProgressionMeanLogPower x) := by
      rw [five_log_mul_vaughanPrimitiveMeanLogPower]
    _ = (5 * vaughanPrimitiveMeanConstant A) *
        vaughanPrimitiveMeanAbelEnvelope x (R : ℝ) Q *
          vaughanProgressionMeanLogPower x := by ring

theorem largeConductorCenteredMass_le_abelEnvelope
    (x Q R : ℕ) (hx : 4 ≤ x)
    (hQsqrt : (Q : ℝ) ≤ Real.sqrt (x : ℝ))
    (hR : 1 ≤ R) (hRQ : R ≤ Q) :
    largeConductorCenteredMass x Q R ≤
      (5 * vaughanPrimitiveMeanConstant
          (Real.log 4 + 4)) *
        vaughanPrimitiveMeanAbelEnvelope x (R : ℝ) Q *
          vaughanProgressionMeanLogPower x := by
  refine largeConductorCenteredMass_le_abelEnvelope_of_psi
    (A := Real.log 4 + 4) ?_ ?_ x Q R hx hQsqrt hR hRQ
  · have hlog : 0 ≤ Real.log 4 := Real.log_nonneg (by norm_num)
    linarith
  · intro z hz
    exact Chebyshev.psi_le_const_mul_self hz

end

section
open scoped ContDiff

theorem exists_siegelWalfisz_primitiveCenteredEndpointMaximum_le :
    ∀ D : ℝ, 0 < D →
      ∃ C c : ℝ, 0 < C ∧ 0 < c ∧
        ∃ X0 : ℕ, 4 ≤ X0 ∧
          ∀ x : ℕ, X0 ≤ x →
            ∀ d : ℕ, 1 < d →
              (d : ℝ) ≤ Real.log (x : ℝ) ^ D →
                ∀ ψ : primitiveCharacters d,
                  primitiveCenteredEndpointMaximum x d ψ ≤
                    C * ((x : ℝ) * Real.exp
                      (-c * Real.sqrt (Real.log (x : ℝ)))) := by
  intro D hD
  obtain ⟨C0, c0, hC0, hc0, Xs, hXsFour, hpoint⟩ :=
    exists_siegelWalfisz_norm_twistedChebyshevSum_le
      (2 * D) (by positivity)
  let Kψ : ℝ := Real.log 4 + 4
  let C : ℝ := C0 + Kψ
  let c : ℝ := min (c0 / 2) 1
  have hKψ : 0 < Kψ := by
    dsimp [Kψ]
    positivity
  have hC : 0 < C := by
    dsimp [C]
    positivity
  have hc : 0 < c := by
    dsimp [c]
    exact lt_min (by positivity) zero_lt_one
  have hcC0 : c ≤ c0 / 2 :=
    min_le_left _ _
  have hcOne : c ≤ 1 :=
    min_le_right _ _
  have hlogTop : Tendsto
      (fun x : ℕ ↦ Real.log (x : ℝ)) atTop atTop :=
    Real.tendsto_log_atTop.comp tendsto_natCast_atTop_atTop
  have hevent : ∀ᶠ x : ℕ in atTop, 4 ≤ Real.log (x : ℝ) :=
    hlogTop.eventually (eventually_ge_atTop 4)
  rw [Filter.eventually_atTop] at hevent
  obtain ⟨Xlog, hXlog⟩ := hevent
  let X0 : ℕ := max 4 (max Xlog (Xs ^ 2))
  refine ⟨C, c, hC, hc, X0, by simp [X0], ?_⟩
  intro x hxX0 d hd hdLog ψ
  have hxFour : 4 ≤ x := by
    dsimp [X0] at hxX0
    omega
  have hXlogX : Xlog ≤ x := by
    dsimp [X0] at hxX0
    omega
  have hXsSqX : Xs ^ 2 ≤ x := by
    dsimp [X0] at hxX0
    omega
  have hLFour : 4 ≤ Real.log (x : ℝ) := hXlog x hXlogX
  have hxpos : (0 : ℝ) < x := by
    exact_mod_cast (show 0 < x by omega)
  have hxnonneg : (0 : ℝ) ≤ x := hxpos.le
  have hXsRoot : (Xs : ℝ) ≤ Real.sqrt (x : ℝ) := by
    have hsquares : (Xs : ℝ) ^ 2 ≤ (x : ℝ) := by
      exact_mod_cast hXsSqX
    have hsqrt := Real.sqrt_le_sqrt hsquares
    rw [Real.sqrt_sq (by positivity : (0 : ℝ) ≤ Xs)] at hsqrt
    exact hsqrt
  rw [primitiveCenteredEndpointMaximum_eq_raw x hd ψ]
  unfold primitiveRawEndpointMaximum
  rw [dite_eq_left (by omega : 2 ≤ x)]
  apply Finset.sup'_le
  intro y hy
  have hyBounds : 2 ≤ y ∧ y ≤ x := Finset.mem_Icc.mp hy
  have hypos : (0 : ℝ) < y := by
    exact_mod_cast (show 0 < y by omega)
  have hynonneg : (0 : ℝ) ≤ y := hypos.le
  by_cases hySmall : (y : ℝ) ≤ Real.sqrt (x : ℝ)
  · have hlinear :
        ‖twistedChebyshevSum y d ψ.1‖ ≤
          Kψ * Real.sqrt (x : ℝ) := by
      calc
        ‖twistedChebyshevSum y d ψ.1‖ ≤ Chebyshev.psi (y : ℝ) :=
          norm_twistedChebyshevSum_le_psi y d ψ.1
        _ ≤ Kψ * (y : ℝ) := by
          simpa [Kψ] using Chebyshev.psi_le_const_mul_self hynonneg
        _ ≤ Kψ * Real.sqrt (x : ℝ) :=
          mul_le_mul_of_nonneg_left hySmall hKψ.le
    let L : ℝ := Real.log (x : ℝ)
    let u : ℝ := Real.sqrt L
    have hLFour' : 4 ≤ L := by simpa [L] using hLFour
    have hLnonneg : 0 ≤ L := by linarith
    have huNonneg : 0 ≤ u := by dsimp [u]; positivity
    have huSq : u ^ 2 = L := by
      dsimp [u]
      exact Real.sq_sqrt hLnonneg
    have hTwoLeU : (2 : ℝ) ≤ u := by
      apply (sq_le_sq₀ (by norm_num) huNonneg).mp
      nlinarith
    have huLHalf : u ≤ L / 2 := by
      nlinarith [mul_nonneg huNonneg (sub_nonneg.mpr hTwoLeU)]
    have hcu : c * u ≤ L / 2 := by
      have hcu' : c * u ≤ 1 * u :=
        mul_le_mul_of_nonneg_right hcOne huNonneg
      nlinarith
    have hsqrtEnvelope :
        Real.sqrt (x : ℝ) ≤
          (x : ℝ) * Real.exp
            (-c * Real.sqrt (Real.log (x : ℝ))) := by
      calc
        Real.sqrt (x : ℝ) = Real.exp (L / 2) := by
          rw [Real.sqrt_eq_rpow, Real.rpow_def_of_pos hxpos]
          congr 1
          dsimp [L]
          ring
        _ ≤ Real.exp (L - c * u) := by
          apply Real.exp_monotone
          linarith
        _ = (x : ℝ) * Real.exp
            (-c * Real.sqrt (Real.log (x : ℝ))) := by
          rw [show L - c * u = L + (-c * u) by ring,
            Real.exp_add]
          dsimp [L, u]
          rw [Real.exp_log hxpos]
    have hKψC : Kψ ≤ C := by
      dsimp [C]
      linarith
    calc
      ‖twistedChebyshevSum y d ψ.1‖ ≤
          Kψ * Real.sqrt (x : ℝ) := hlinear
      _ ≤ Kψ * ((x : ℝ) * Real.exp
          (-c * Real.sqrt (Real.log (x : ℝ)))) :=
        mul_le_mul_of_nonneg_left hsqrtEnvelope hKψ.le
      _ ≤ C * ((x : ℝ) * Real.exp
          (-c * Real.sqrt (Real.log (x : ℝ)))) := by
        apply mul_le_mul_of_nonneg_right hKψC
        positivity
  · have hyLarge : Real.sqrt (x : ℝ) < (y : ℝ) :=
      lt_of_not_ge hySmall
    let L : ℝ := Real.log (x : ℝ)
    let l : ℝ := Real.log (y : ℝ)
    have hLFour' : 4 ≤ L := by simpa [L] using hLFour
    have hLnonneg : 0 ≤ L := by linarith
    have hsqrtPos : 0 < Real.sqrt (x : ℝ) := Real.sqrt_pos.2 hxpos
    have hlogHalf : L / 2 ≤ l := by
      calc
        L / 2 = Real.log (Real.sqrt (x : ℝ)) := by
          rw [Real.log_sqrt hxnonneg]
        _ ≤ Real.log (y : ℝ) :=
          Real.log_le_log hsqrtPos hyLarge.le
        _ = l := rfl
    have hlTwo : (2 : ℝ) ≤ l := by linarith
    have hlNonneg : 0 ≤ l := by linarith
    have hLleLSq : L ≤ l ^ 2 := by
      have hLleTwoL : L ≤ 2 * l := by linarith
      have hTwoLleSq : 2 * l ≤ l ^ 2 := by
        nlinarith [mul_nonneg hlNonneg (sub_nonneg.mpr hlTwo)]
      exact hLleTwoL.trans hTwoLleSq
    have hpower : L ^ D ≤ l ^ (2 * D) := by
      calc
        L ^ D ≤ (l ^ 2) ^ D :=
          Real.rpow_le_rpow hLnonneg hLleLSq hD.le
        _ = (l ^ (2 : ℝ)) ^ D := by rw [Real.rpow_two]
        _ = l ^ (2 * D) := (Real.rpow_mul hlNonneg 2 D).symm
    have hdLogY : (d : ℝ) ≤ Real.log (y : ℝ) ^ (2 * D) :=
      hdLog.trans (by simpa [L, l] using hpower)
    have hXsLtY : Xs < y := by
      exact_mod_cast hXsRoot.trans_lt hyLarge
    let : NeZero d := ⟨by omega⟩
    have hpointY := hpoint y (by omega) d ψ.1
      (primitiveCharacter_ne_one_of_one_lt hd ψ) hdLogY
    have hquarter : L / 4 ≤ l := by linarith
    have hhalfSqrt :
        Real.sqrt L / 2 ≤ Real.sqrt l := by
      apply (sq_le_sq₀ (by positivity) (Real.sqrt_nonneg l)).mp
      rw [div_pow, Real.sq_sqrt hLnonneg, Real.sq_sqrt hlNonneg]
      nlinarith
    have hdecayScale :
        c * Real.sqrt L ≤ c0 * Real.sqrt l := by
      calc
        c * Real.sqrt L ≤ (c0 / 2) * Real.sqrt L :=
          mul_le_mul_of_nonneg_right hcC0 (Real.sqrt_nonneg L)
        _ = c0 * (Real.sqrt L / 2) := by ring
        _ ≤ c0 * Real.sqrt l :=
          mul_le_mul_of_nonneg_left hhalfSqrt hc0.le
    have hdecay :
        Real.exp (-c0 * Real.sqrt l) ≤
          Real.exp (-c * Real.sqrt L) := by
      apply Real.exp_monotone
      linarith
    have hyCast : (y : ℝ) ≤ (x : ℝ) := by exact_mod_cast hyBounds.2
    have hC0C : C0 ≤ C := by
      dsimp [C]
      linarith
    calc
      ‖twistedChebyshevSum y d ψ.1‖ ≤
          C0 * ((y : ℝ) * Real.exp
            (-c0 * Real.sqrt (Real.log (y : ℝ)))) := hpointY
      _ ≤ C0 * ((x : ℝ) * Real.exp
          (-c * Real.sqrt (Real.log (x : ℝ)))) := by
        apply mul_le_mul_of_nonneg_left _ hC0.le
        apply mul_le_mul hyCast
        · simpa [L, l] using hdecay
        · positivity
        · positivity
      _ ≤ C * ((x : ℝ) * Real.exp
          (-c * Real.sqrt (Real.log (x : ℝ)))) := by
        apply mul_le_mul_of_nonneg_right hC0C
        positivity

end

section
open scoped ContDiff

theorem exists_siegelWalfisz_smallConductorCenteredMass_le :
    ∀ D : ℝ, 0 < D →
      ∃ C c : ℝ, 0 < C ∧ 0 < c ∧
        ∃ X0 : ℕ, 4 ≤ X0 ∧
          ∀ x : ℕ, X0 ≤ x →
            ∀ Q R : ℕ,
              ((min R Q : ℕ) : ℝ) ≤ Real.log (x : ℝ) ^ D →
                smallConductorCenteredMass x Q R ≤
                  4 * (((min R Q - 1 : ℕ) : ℝ)) *
                    (1 + Real.log (Q : ℝ)) *
                      (C * ((x : ℝ) * Real.exp
                        (-c * Real.sqrt (Real.log (x : ℝ))))) := by
  intro D hD
  obtain ⟨C, c, hC, hc, X0, hX0, hSiegelWalfisz⟩ :=
    exists_siegelWalfisz_primitiveCenteredEndpointMaximum_le D hD
  refine ⟨C, c, hC, hc, X0, hX0, ?_⟩
  intro x hx Q R hcutoff
  apply smallConductorCenteredMass_le_of_endpointMaximum
  · positivity
  · intro d hd hdCutoff ψ
    apply hSiegelWalfisz x hx d hd
    exact (by exact_mod_cast hdCutoff :
      (d : ℝ) ≤ ((min R Q : ℕ) : ℝ)).trans hcutoff

theorem
    exists_siegelWalfisz_sum_maxCenteredProgressionDiscrepancyUpTo_le_abelEnvelope :
    ∀ D : ℝ, 0 < D →
      ∃ C c : ℝ, 0 < C ∧ 0 < c ∧
        ∃ X0 : ℕ, 4 ≤ X0 ∧
          ∀ x : ℕ, X0 ≤ x →
            ∀ Q : ℕ, siegelWalfiszConductorCutoff D x ≤ Q →
              (Q : ℝ) ≤ Real.sqrt (x : ℝ) →
                (∑ q ∈ Finset.Icc 1 Q,
                  maxCenteredProgressionDiscrepancyUpTo x q) ≤
                  (Q : ℝ) * Real.log ((Q * x : ℕ) : ℝ) ^ 2 +
                    4 * (((siegelWalfiszConductorCutoff D x - 1 : ℕ) : ℝ)) *
                      (1 + Real.log (Q : ℝ)) *
                        (C * ((x : ℝ) * Real.exp
                          (-c * Real.sqrt (Real.log (x : ℝ))))) +
                    (5 * vaughanPrimitiveMeanConstant
                        (Real.log 4 + 4)) *
                      vaughanPrimitiveMeanAbelEnvelope x
                        (siegelWalfiszConductorCutoff D x : ℝ) Q *
                        vaughanProgressionMeanLogPower x := by
  intro D hD
  obtain ⟨C, c, hC, hc, X0, hX0, hsmall⟩ :=
    exists_siegelWalfisz_smallConductorCenteredMass_le D hD
  refine ⟨C, c, hC, hc, X0, hX0, ?_⟩
  intro x hx Q hcutoffQ hQsqrt
  let R := siegelWalfiszConductorCutoff D x
  have hx4 : 4 ≤ x := hX0.trans hx
  have hR : 1 ≤ R := by
    simpa only [R] using one_le_siegelWalfiszConductorCutoff hD hx4
  have hRQ : R ≤ Q := by
    simpa only [R] using hcutoffQ
  have hmin : min R Q = R := min_eq_left hRQ
  have hcutoff :
      ((min R Q : ℕ) : ℝ) ≤ Real.log (x : ℝ) ^ D := by
    rw [hmin]
    simpa only [R] using natCast_siegelWalfiszConductorCutoff_le D x
  have hsmallBound := hsmall x hx Q R hcutoff
  have hlargeBound := largeConductorCenteredMass_le_abelEnvelope
    x Q R hx4 hQsqrt hR hRQ
  have hsplit :=
    sum_maxCenteredProgressionDiscrepancyUpTo_le_log_sq_add_small_add_large
      x Q R (by omega)
  calc
    (∑ q ∈ Finset.Icc 1 Q,
        maxCenteredProgressionDiscrepancyUpTo x q) ≤
        (Q : ℝ) * Real.log ((Q * x : ℕ) : ℝ) ^ 2 +
          smallConductorCenteredMass x Q R +
            largeConductorCenteredMass x Q R := hsplit
    _ ≤ (Q : ℝ) * Real.log ((Q * x : ℕ) : ℝ) ^ 2 +
          4 * (((min R Q - 1 : ℕ) : ℝ)) *
            (1 + Real.log (Q : ℝ)) *
              (C * ((x : ℝ) * Real.exp
                (-c * Real.sqrt (Real.log (x : ℝ))))) +
          (5 * vaughanPrimitiveMeanConstant
              (Real.log 4 + 4)) *
            vaughanPrimitiveMeanAbelEnvelope x (R : ℝ) Q *
              vaughanProgressionMeanLogPower x :=
      add_le_add (add_le_add le_rfl hsmallBound) hlargeBound
    _ = _ := by simp only [hmin, R]

/--
The constant `1 + 5 * vaughanPrimitiveMeanConstant A` in the Abel-summed
progression estimate. The added `1` absorbs the elementary correction into the same envelope.
-/
noncomputable def vaughanProgressionMeanConstant
    (A : ℝ) : ℝ :=
  1 + 5 * vaughanPrimitiveMeanConstant A

theorem
    exists_siegelWalfisz_sum_maxCenteredProgressionDiscrepancyUpTo_le_small_add_vaughanBound :
    ∀ D : ℝ, 0 < D →
      ∃ C c : ℝ, 0 < C ∧ 0 < c ∧
        ∃ X0 : ℕ, 4 ≤ X0 ∧
          ∀ x : ℕ, X0 ≤ x →
            ∀ Q : ℕ, siegelWalfiszConductorCutoff D x ≤ Q →
              (Q : ℝ) ≤ Real.sqrt (x : ℝ) →
                (∑ q ∈ Finset.Icc 1 Q,
                  maxCenteredProgressionDiscrepancyUpTo x q) ≤
                  4 * (((siegelWalfiszConductorCutoff D x - 1 : ℕ) : ℝ)) *
                    (1 + Real.log (Q : ℝ)) *
                      (C * ((x : ℝ) * Real.exp
                        (-c * Real.sqrt (Real.log (x : ℝ))))) +
                    vaughanProgressionMeanConstant
                        (Real.log 4 + 4) *
                      vaughanPrimitiveMeanAbelEnvelope x
                        (siegelWalfiszConductorCutoff D x : ℝ) Q *
                        vaughanProgressionMeanLogPower x := by
  intro D hD
  obtain ⟨C, c, hC, hc, X0, hX0, hcomposition⟩ :=
    exists_siegelWalfisz_sum_maxCenteredProgressionDiscrepancyUpTo_le_abelEnvelope
      D hD
  refine ⟨C, c, hC, hc, X0, hX0, ?_⟩
  intro x hx Q hcutoffQ hQsqrt
  have hx4 : 4 ≤ x := hX0.trans hx
  have hcutoffOne : 1 ≤ siegelWalfiszConductorCutoff D x :=
    one_le_siegelWalfiszConductorCutoff hD hx4
  have hcutoffOneReal :
      (1 : ℝ) ≤ (siegelWalfiszConductorCutoff D x : ℝ) := by
    exact_mod_cast hcutoffOne
  have hcutoffQReal :
      (siegelWalfiszConductorCutoff D x : ℝ) ≤ (Q : ℝ) := by
    exact_mod_cast hcutoffQ
  have hcorrection := vaughanPrimitiveMeanElementaryCorrection_le_abelEnvelope
    x Q (siegelWalfiszConductorCutoff D x : ℝ) hx4 hQsqrt
      hcutoffOneReal hcutoffQReal
  have hbase := hcomposition x hx Q hcutoffQ hQsqrt
  calc
    (∑ q ∈ Finset.Icc 1 Q,
        maxCenteredProgressionDiscrepancyUpTo x q) ≤
        (Q : ℝ) * Real.log ((Q * x : ℕ) : ℝ) ^ 2 +
          4 * (((siegelWalfiszConductorCutoff D x - 1 : ℕ) : ℝ)) *
            (1 + Real.log (Q : ℝ)) *
              (C * ((x : ℝ) * Real.exp
                (-c * Real.sqrt (Real.log (x : ℝ))))) +
          (5 * vaughanPrimitiveMeanConstant
              (Real.log 4 + 4)) *
            vaughanPrimitiveMeanAbelEnvelope x
              (siegelWalfiszConductorCutoff D x : ℝ) Q *
              vaughanProgressionMeanLogPower x := hbase
    _ ≤ vaughanPrimitiveMeanAbelEnvelope x
            (siegelWalfiszConductorCutoff D x : ℝ) Q *
            vaughanProgressionMeanLogPower x +
          4 * (((siegelWalfiszConductorCutoff D x - 1 : ℕ) : ℝ)) *
            (1 + Real.log (Q : ℝ)) *
              (C * ((x : ℝ) * Real.exp
                (-c * Real.sqrt (Real.log (x : ℝ))))) +
          (5 * vaughanPrimitiveMeanConstant
              (Real.log 4 + 4)) *
            vaughanPrimitiveMeanAbelEnvelope x
              (siegelWalfiszConductorCutoff D x : ℝ) Q *
              vaughanProgressionMeanLogPower x :=
      add_le_add (add_le_add hcorrection le_rfl) le_rfl
    _ = _ := by
      unfold vaughanProgressionMeanConstant
      ring

theorem exists_vaughanProgressionMeanAbelTerm_le_logSaving
    (A : ℝ) (hA : 0 ≤ A) :
    ∃ X0 : ℕ, 4 ≤ X0 ∧
      ∀ x : ℕ, X0 ≤ x →
        ∀ Q : ℕ, siegelWalfiszConductorCutoff (A + 5) x ≤ Q →
          (Q : ℝ) ≤ Real.sqrt (x : ℝ) /
              Real.rpow (Real.log (x : ℝ)) (A + 5) →
            vaughanProgressionMeanConstant (Real.log 4 + 4) *
                vaughanPrimitiveMeanAbelEnvelope x
                  (siegelWalfiszConductorCutoff (A + 5) x : ℝ) Q *
                  vaughanProgressionMeanLogPower x ≤
              (40 * vaughanProgressionMeanConstant
                (Real.log 4 + 4)) * (x : ℝ) /
                  Real.rpow (Real.log (x : ℝ)) A := by
  obtain ⟨X0, hX0, hbound⟩ :=
    exists_vaughanPrimitiveMeanAbelEnvelope_mul_logPower_le_logSaving A hA
  refine ⟨X0, hX0, ?_⟩
  intro x hx Q hRQ hQrange
  have hbase := hbound x hx Q hRQ hQrange
  have hconstant :
      0 ≤ vaughanProgressionMeanConstant (Real.log 4 + 4) := by
    unfold vaughanProgressionMeanConstant
    have := vaughanPrimitiveMeanConstant_nonneg
      (Real.log 4 + 4)
    linarith
  calc
    vaughanProgressionMeanConstant (Real.log 4 + 4) *
          vaughanPrimitiveMeanAbelEnvelope x
            (siegelWalfiszConductorCutoff (A + 5) x : ℝ) Q *
          vaughanProgressionMeanLogPower x =
        vaughanProgressionMeanConstant (Real.log 4 + 4) *
          (vaughanPrimitiveMeanAbelEnvelope x
            (siegelWalfiszConductorCutoff (A + 5) x : ℝ) Q *
              vaughanProgressionMeanLogPower x) := by ring
    _ ≤ vaughanProgressionMeanConstant (Real.log 4 + 4) *
        (40 * (x : ℝ) /
          Real.rpow (Real.log (x : ℝ)) A) :=
      mul_le_mul_of_nonneg_left hbase hconstant
    _ = (40 * vaughanProgressionMeanConstant
          (Real.log 4 + 4)) * (x : ℝ) /
        Real.rpow (Real.log (x : ℝ)) A := by ring

end

section
open scoped ContDiff

theorem exists_five_mul_sqrtLog_rpow_le_exp
    (A c : ℝ) (hc : 0 < c) :
    ∃ X0 : ℕ, 4 ≤ X0 ∧
      ∀ x : ℕ, X0 ≤ x →
        5 * Real.rpow (Real.sqrt (Real.log (x : ℝ))) (4 * A + 12) ≤
          Real.exp (c * Real.sqrt (Real.log (x : ℝ))) := by
  have huTop : Tendsto
      (fun x : ℕ ↦ Real.sqrt (Real.log (x : ℝ))) atTop atTop :=
    Real.tendsto_sqrt_atTop.comp
      (Real.tendsto_log_atTop.comp tendsto_natCast_atTop_atTop)
  have hdom :=
    (((isLittleO_rpow_exp_pos_mul_atTop (4 * A + 12) hc).const_mul_left 5).comp_tendsto
      huTop).eventuallyLE
  rw [Filter.eventually_atTop] at hdom
  obtain ⟨N, hN⟩ := hdom
  refine ⟨max 4 N, le_max_left _ _, ?_⟩
  intro x hx
  have hNx : N ≤ x := (le_max_right 4 N).trans hx
  have huNonneg : 0 ≤ Real.sqrt (Real.log (x : ℝ)) := Real.sqrt_nonneg _
  have hleft :
      0 ≤ 5 * (Real.sqrt (Real.log (x : ℝ))) ^ (4 * A + 12) :=
    mul_nonneg (by norm_num) (Real.rpow_nonneg huNonneg _)
  have hbound := hN x hNx
  simp only [Function.comp_apply, Real.norm_eq_abs] at hbound
  rw [abs_of_nonneg hleft, abs_of_pos (Real.exp_pos _)] at hbound
  simpa only [Real.rpow_eq_pow] using hbound

theorem exists_siegelWalfiszSmallTerm_le_logSaving
    (A c : ℝ) (hA : 0 ≤ A) (hc : 0 < c) :
    ∃ X0 : ℕ, 4 ≤ X0 ∧
      ∀ C : ℝ, 0 ≤ C →
        ∀ x : ℕ, X0 ≤ x →
          ∀ Q : ℕ,
            siegelWalfiszConductorCutoff (A + 5) x ≤ Q →
              (Q : ℝ) ≤ Real.sqrt (x : ℝ) →
                4 * (((siegelWalfiszConductorCutoff (A + 5) x - 1 : ℕ) : ℝ)) *
                    (1 + Real.log (Q : ℝ)) *
                      (C * ((x : ℝ) * Real.exp
                        (-c * Real.sqrt (Real.log (x : ℝ))))) ≤
                  C * (x : ℝ) /
                    Real.rpow (Real.log (x : ℝ)) A := by
  obtain ⟨X0, hX0, hpolynomial⟩ :=
    exists_five_mul_sqrtLog_rpow_le_exp A c hc
  refine ⟨X0, hX0, ?_⟩
  intro C hC x hx Q hRQ hQsqrt
  have hx4 : 4 ≤ x := hX0.trans hx
  have hxpos : (0 : ℝ) < (x : ℝ) := by positivity
  have hlogOne : 1 ≤ Real.log (x : ℝ) := one_le_log_natCast hx4
  have hlogPos : 0 < Real.log (x : ℝ) := zero_lt_one.trans_le hlogOne
  have hlogNonneg : 0 ≤ Real.log (x : ℝ) := hlogPos.le
  have hApFive : 0 < A + 5 := by linarith
  have hRone : 1 ≤ siegelWalfiszConductorCutoff (A + 5) x :=
    one_le_siegelWalfiszConductorCutoff hApFive hx4
  have hQone : 1 ≤ Q := hRone.trans hRQ
  have hQpos : 0 < Q := Nat.zero_lt_of_lt hQone
  have hQoneReal : (1 : ℝ) ≤ (Q : ℝ) := by exact_mod_cast hQone
  have hRsubScale :
      (((siegelWalfiszConductorCutoff (A + 5) x - 1 : ℕ) : ℝ)) ≤
        Real.rpow (Real.log (x : ℝ)) (A + 5) := by
    calc
      (((siegelWalfiszConductorCutoff (A + 5) x - 1 : ℕ) : ℝ)) ≤
          (siegelWalfiszConductorCutoff (A + 5) x : ℝ) := by
        exact_mod_cast Nat.sub_le (siegelWalfiszConductorCutoff (A + 5) x) 1
      _ ≤ Real.rpow (Real.log (x : ℝ)) (A + 5) :=
        natCast_siegelWalfiszConductorCutoff_le (A + 5) x
  have hfourLog :
      4 * (1 + Real.log (Q : ℝ)) ≤ 5 * Real.log (x : ℝ) :=
    (four_mul_one_add_log_lt_five_mul_log_of_le_sqrt hx4 hQpos hQsqrt).le
  have hfourLogNonneg : 0 ≤ 4 * (1 + Real.log (Q : ℝ)) := by
    have : 0 ≤ Real.log (Q : ℝ) := Real.log_nonneg hQoneReal
    positivity
  have hprefix :
      4 * (((siegelWalfiszConductorCutoff (A + 5) x - 1 : ℕ) : ℝ)) *
          (1 + Real.log (Q : ℝ)) ≤
        5 * Real.rpow (Real.log (x : ℝ)) (A + 6) := by
    calc
      4 * (((siegelWalfiszConductorCutoff (A + 5) x - 1 : ℕ) : ℝ)) *
          (1 + Real.log (Q : ℝ)) =
        (((siegelWalfiszConductorCutoff (A + 5) x - 1 : ℕ) : ℝ)) *
          (4 * (1 + Real.log (Q : ℝ))) := by ring
      _ ≤ Real.rpow (Real.log (x : ℝ)) (A + 5) *
          (5 * Real.log (x : ℝ)) :=
        mul_le_mul hRsubScale hfourLog hfourLogNonneg
          (Real.rpow_nonneg hlogNonneg _)
      _ = 5 * (Real.rpow (Real.log (x : ℝ)) (A + 5) *
          Real.log (x : ℝ)) := by ring
      _ = 5 * (Real.rpow (Real.log (x : ℝ)) (A + 5) *
          Real.rpow (Real.log (x : ℝ)) (1 : ℝ)) :=
        congrArg
          (fun y : ℝ => 5 *
            (Real.rpow (Real.log (x : ℝ)) (A + 5) * y))
          (Real.rpow_one (Real.log (x : ℝ))).symm
      _ = 5 * Real.rpow (Real.log (x : ℝ)) ((A + 5) + 1) :=
        congrArg (fun y : ℝ => 5 * y)
          (Real.rpow_add hlogPos (A + 5) 1).symm
      _ = 5 * Real.rpow (Real.log (x : ℝ)) (A + 6) := by ring_nf
  have hsqrtSq : Real.sqrt (Real.log (x : ℝ)) ^ 2 =
      Real.log (x : ℝ) := Real.sq_sqrt hlogNonneg
  have hpowerIdentity :
      Real.rpow (Real.log (x : ℝ)) (2 * A + 6) =
        Real.rpow (Real.sqrt (Real.log (x : ℝ))) (4 * A + 12) := by
    calc
      Real.rpow (Real.log (x : ℝ)) (2 * A + 6) =
          Real.rpow (Real.sqrt (Real.log (x : ℝ)) ^ 2) (2 * A + 6) := by
        rw [hsqrtSq]
      _ = Real.rpow
          (Real.rpow (Real.sqrt (Real.log (x : ℝ))) (2 : ℝ))
            (2 * A + 6) :=
        congrArg (fun y : ℝ => Real.rpow y (2 * A + 6))
          (Real.rpow_two (Real.sqrt (Real.log (x : ℝ)))).symm
      _ = Real.rpow (Real.sqrt (Real.log (x : ℝ)))
          ((2 : ℝ) * (2 * A + 6)) :=
        (Real.rpow_mul (Real.sqrt_nonneg _) 2 (2 * A + 6)).symm
      _ = Real.rpow (Real.sqrt (Real.log (x : ℝ))) (4 * A + 12) := by
        ring_nf
  have hpolynomialAtX := hpolynomial x hx
  have hdecay :
      5 * Real.rpow (Real.log (x : ℝ)) (2 * A + 6) *
          Real.exp (-c * Real.sqrt (Real.log (x : ℝ))) ≤ 1 := by
    rw [hpowerIdentity]
    calc
      5 * Real.rpow (Real.sqrt (Real.log (x : ℝ))) (4 * A + 12) *
          Real.exp (-c * Real.sqrt (Real.log (x : ℝ))) ≤
        Real.exp (c * Real.sqrt (Real.log (x : ℝ))) *
          Real.exp (-c * Real.sqrt (Real.log (x : ℝ))) :=
        mul_le_mul_of_nonneg_right hpolynomialAtX (Real.exp_pos _).le
      _ = 1 := by
        rw [← Real.exp_add]
        convert Real.exp_zero using 1
        ring_nf
  have hscaleSplit :
      Real.rpow (Real.log (x : ℝ)) (2 * A + 6) =
        Real.rpow (Real.log (x : ℝ)) (A + 6) *
          Real.rpow (Real.log (x : ℝ)) A := by
    calc
      Real.rpow (Real.log (x : ℝ)) (2 * A + 6) =
          Real.rpow (Real.log (x : ℝ)) ((A + 6) + A) := by ring_nf
      _ = Real.rpow (Real.log (x : ℝ)) (A + 6) *
          Real.rpow (Real.log (x : ℝ)) A :=
        Real.rpow_add hlogPos (A + 6) A
  have hsavePos : 0 < Real.rpow (Real.log (x : ℝ)) A :=
    Real.rpow_pos_of_pos hlogPos _
  have hdecayDiv :
      5 * Real.rpow (Real.log (x : ℝ)) (A + 6) *
          Real.exp (-c * Real.sqrt (Real.log (x : ℝ))) ≤
        1 / Real.rpow (Real.log (x : ℝ)) A := by
    apply (le_div_iff₀ hsavePos).2
    calc
      5 * Real.rpow (Real.log (x : ℝ)) (A + 6) *
            Real.exp (-c * Real.sqrt (Real.log (x : ℝ))) *
          Real.rpow (Real.log (x : ℝ)) A =
        5 * Real.rpow (Real.log (x : ℝ)) (2 * A + 6) *
          Real.exp (-c * Real.sqrt (Real.log (x : ℝ))) := by
        rw [hscaleSplit]
        ring
      _ ≤ 1 := hdecay
  have htailNonneg :
      0 ≤ C * ((x : ℝ) *
        Real.exp (-c * Real.sqrt (Real.log (x : ℝ)))) := by positivity
  calc
    4 * (((siegelWalfiszConductorCutoff (A + 5) x - 1 : ℕ) : ℝ)) *
          (1 + Real.log (Q : ℝ)) *
            (C * ((x : ℝ) * Real.exp
              (-c * Real.sqrt (Real.log (x : ℝ))))) ≤
        (5 * Real.rpow (Real.log (x : ℝ)) (A + 6)) *
          (C * ((x : ℝ) * Real.exp
            (-c * Real.sqrt (Real.log (x : ℝ))))) :=
      mul_le_mul_of_nonneg_right hprefix htailNonneg
    _ = (C * (x : ℝ)) *
        (5 * Real.rpow (Real.log (x : ℝ)) (A + 6) *
          Real.exp (-c * Real.sqrt (Real.log (x : ℝ)))) := by ring
    _ ≤ (C * (x : ℝ)) *
        (1 / Real.rpow (Real.log (x : ℝ)) A) :=
      mul_le_mul_of_nonneg_left hdecayDiv (mul_nonneg hC hxpos.le)
    _ = C * (x : ℝ) /
        Real.rpow (Real.log (x : ℝ)) A := by ring

theorem
    exists_siegelWalfisz_sum_maxCenteredProgressionDiscrepancyUpTo_le_logSaving :
    ∀ A : ℝ, 0 ≤ A →
      ∃ C c : ℝ, 0 < C ∧ 0 < c ∧
        ∃ X0 : ℕ, 4 ≤ X0 ∧
          ∀ x : ℕ, X0 ≤ x →
            ∀ Q : ℕ,
              siegelWalfiszConductorCutoff (A + 5) x ≤ Q →
                (Q : ℝ) ≤ Real.sqrt (x : ℝ) /
                    Real.rpow (Real.log (x : ℝ)) (A + 5) →
                  (∑ q ∈ Finset.Icc 1 Q,
                    maxCenteredProgressionDiscrepancyUpTo x q) ≤
                    (C + 40 * vaughanProgressionMeanConstant
                      (Real.log 4 + 4)) * (x : ℝ) /
                        Real.rpow (Real.log (x : ℝ)) A := by
  intro A hA
  have hApFive : 0 < A + 5 := by linarith
  obtain ⟨C, c, hC, hc, Xbase, hXbase, hbase⟩ :=
    exists_siegelWalfisz_sum_maxCenteredProgressionDiscrepancyUpTo_le_small_add_vaughanBound
      (A + 5) hApFive
  obtain ⟨Xsmall, hXsmall, hsmall⟩ :=
    exists_siegelWalfiszSmallTerm_le_logSaving A c hA hc
  obtain ⟨Xabel, hXabel, habel⟩ :=
    exists_vaughanProgressionMeanAbelTerm_le_logSaving A hA
  refine ⟨C, c, hC, hc, max Xbase (max Xsmall Xabel),
    hXbase.trans (le_max_left _ _), ?_⟩
  intro x hx Q hRQ hQrange
  have hxBase : Xbase ≤ x := (le_max_left Xbase (max Xsmall Xabel)).trans hx
  have hxPair : max Xsmall Xabel ≤ x :=
    (le_max_right Xbase (max Xsmall Xabel)).trans hx
  have hxSmall : Xsmall ≤ x := (le_max_left Xsmall Xabel).trans hxPair
  have hxAbel : Xabel ≤ x := (le_max_right Xsmall Xabel).trans hxPair
  have hx4 : 4 ≤ x := hXbase.trans hxBase
  have hlogOne : 1 ≤ Real.log (x : ℝ) := one_le_log_natCast hx4
  have hscaleOne :
      1 ≤ Real.rpow (Real.log (x : ℝ)) (A + 5) :=
    Real.one_le_rpow hlogOne hApFive.le
  have hQsqrt : (Q : ℝ) ≤ Real.sqrt (x : ℝ) :=
    hQrange.trans (div_le_self (Real.sqrt_nonneg _) hscaleOne)
  have hbaseAtX := hbase x hxBase Q hRQ hQsqrt
  have hsmallAtX := hsmall C hC.le x hxSmall Q hRQ hQsqrt
  have habelAtX := habel x hxAbel Q hRQ hQrange
  calc
    (∑ q ∈ Finset.Icc 1 Q,
        maxCenteredProgressionDiscrepancyUpTo x q) ≤
        4 * (((siegelWalfiszConductorCutoff (A + 5) x - 1 : ℕ) : ℝ)) *
          (1 + Real.log (Q : ℝ)) *
            (C * ((x : ℝ) * Real.exp
              (-c * Real.sqrt (Real.log (x : ℝ))))) +
          vaughanProgressionMeanConstant (Real.log 4 + 4) *
            vaughanPrimitiveMeanAbelEnvelope x
              (siegelWalfiszConductorCutoff (A + 5) x : ℝ) Q *
              vaughanProgressionMeanLogPower x := hbaseAtX
    _ ≤ C * (x : ℝ) / Real.rpow (Real.log (x : ℝ)) A +
        (40 * vaughanProgressionMeanConstant
          (Real.log 4 + 4)) * (x : ℝ) /
            Real.rpow (Real.log (x : ℝ)) A :=
      add_le_add hsmallAtX habelAtX
    _ = (C + 40 * vaughanProgressionMeanConstant
          (Real.log 4 + 4)) * (x : ℝ) /
        Real.rpow (Real.log (x : ℝ)) A := by ring

theorem maxCenteredProgressionDiscrepancyUpTo_nonneg (x q : ℕ) :
    0 ≤ maxCenteredProgressionDiscrepancyUpTo x q := by
  by_cases hx : 2 ≤ x
  · by_cases hq : 0 < q
    · rw [maxCenteredProgressionDiscrepancyUpTo_eq_sup_endpoint_residues hx hq]
      let a := (coprimeResidues_nonempty hq).choose
      have ha : a ∈ coprimeResidues q := (coprimeResidues_nonempty hq).choose_spec
      exact Finset.le_sup'_of_le
        (fun y ↦
          (coprimeResidues q).sup' (coprimeResidues_nonempty hq) (fun b ↦
            |chebyshevProgressionSum y q b -
              Chebyshev.psi (y : ℝ) / (q.totient : ℝ)|))
        (Finset.mem_Icc.mpr ⟨le_rfl, hx⟩)
        (Finset.le_sup'_of_le
          (fun b ↦
            |chebyshevProgressionSum 2 q b -
              Chebyshev.psi (2 : ℝ) / (q.totient : ℝ)|)
          ha (abs_nonneg _))
    · simp [maxCenteredProgressionDiscrepancyUpTo,
        maxCenteredProgressionDiscrepancy, hx, hq]
  · simp [maxCenteredProgressionDiscrepancyUpTo, hx]

theorem exists_siegelWalfiszConductorCutoff_le_logReducedSqrt
    (A : ℝ) :
    ∃ X0 : ℕ, 4 ≤ X0 ∧
      ∀ x : ℕ, X0 ≤ x →
        (siegelWalfiszConductorCutoff (A + 5) x : ℝ) ≤
          Real.sqrt (x : ℝ) /
            Real.rpow (Real.log (x : ℝ)) (A + 5) := by
  have hdom :=
    ((isLittleO_log_rpow_rpow_atTop (2 * (A + 5))
      (show (0 : ℝ) < 1 / 2 by norm_num)).comp_tendsto
        tendsto_natCast_atTop_atTop).eventuallyLE
  rw [Filter.eventually_atTop] at hdom
  obtain ⟨N, hN⟩ := hdom
  refine ⟨max 4 N, le_max_left _ _, ?_⟩
  intro x hx
  have hNx : N ≤ x := (le_max_right 4 N).trans hx
  have hx4 : 4 ≤ x := (le_max_left 4 N).trans hx
  have hxpos : (0 : ℝ) < (x : ℝ) := by positivity
  have hlogOne : 1 ≤ Real.log (x : ℝ) := one_le_log_natCast hx4
  have hlogPos : 0 < Real.log (x : ℝ) := zero_lt_one.trans_le hlogOne
  have hscalePos :
      0 < Real.rpow (Real.log (x : ℝ)) (A + 5) :=
    Real.rpow_pos_of_pos hlogPos _
  have hgrowth := hN x hNx
  simp only [Function.comp_apply, Real.norm_eq_abs] at hgrowth
  rw [abs_of_nonneg (Real.rpow_nonneg hlogPos.le _),
    abs_of_nonneg (Real.rpow_nonneg hxpos.le _)] at hgrowth
  apply (le_div_iff₀ hscalePos).2
  calc
    (siegelWalfiszConductorCutoff (A + 5) x : ℝ) *
          Real.rpow (Real.log (x : ℝ)) (A + 5) ≤
        Real.rpow (Real.log (x : ℝ)) (A + 5) *
          Real.rpow (Real.log (x : ℝ)) (A + 5) :=
      mul_le_mul_of_nonneg_right
        (natCast_siegelWalfiszConductorCutoff_le (A + 5) x) hscalePos.le
    _ = Real.rpow (Real.log (x : ℝ)) ((A + 5) + (A + 5)) :=
      (Real.rpow_add hlogPos (A + 5) (A + 5)).symm
    _ = Real.rpow (Real.log (x : ℝ)) (2 * (A + 5)) := by ring_nf
    _ ≤ Real.rpow (x : ℝ) (1 / 2 : ℝ) := hgrowth
    _ = Real.sqrt (x : ℝ) := (Real.sqrt_eq_rpow (x : ℝ)).symm

theorem
    exists_siegelWalfisz_sum_maxCenteredProgressionDiscrepancyUpTo_le_logSaving_allCutoffs :
    ∀ A : ℝ, 0 ≤ A →
      ∃ C c : ℝ, 0 < C ∧ 0 < c ∧
        ∃ X0 : ℕ, 4 ≤ X0 ∧
          ∀ x : ℕ, X0 ≤ x →
            ∀ Q : ℕ,
              (Q : ℝ) ≤ Real.sqrt (x : ℝ) /
                  Real.rpow (Real.log (x : ℝ)) (A + 5) →
                (∑ q ∈ Finset.Icc 1 Q,
                  maxCenteredProgressionDiscrepancyUpTo x q) ≤
                  (C + 40 * vaughanProgressionMeanConstant
                    (Real.log 4 + 4)) * (x : ℝ) /
                      Real.rpow (Real.log (x : ℝ)) A := by
  intro A hA
  obtain ⟨C, c, hC, hc, Xbase, hXbase, hbase⟩ :=
    exists_siegelWalfisz_sum_maxCenteredProgressionDiscrepancyUpTo_le_logSaving
      A hA
  obtain ⟨Xrange, hXrange, hrange⟩ :=
    exists_siegelWalfiszConductorCutoff_le_logReducedSqrt A
  refine ⟨C, c, hC, hc, max Xbase Xrange,
    hXbase.trans (le_max_left _ _), ?_⟩
  intro x hx Q hQrange
  have hxBase : Xbase ≤ x := (le_max_left Xbase Xrange).trans hx
  have hxRange : Xrange ≤ x := (le_max_right Xbase Xrange).trans hx
  let R := siegelWalfiszConductorCutoff (A + 5) x
  have hRrange :
      (R : ℝ) ≤ Real.sqrt (x : ℝ) /
        Real.rpow (Real.log (x : ℝ)) (A + 5) := by
    simpa only [R] using hrange x hxRange
  by_cases hRQ : R ≤ Q
  · exact hbase x hxBase Q (by simpa only [R] using hRQ) hQrange
  · have hQR : Q ≤ R := (Nat.lt_of_not_ge hRQ).le
    calc
      (∑ q ∈ Finset.Icc 1 Q,
          maxCenteredProgressionDiscrepancyUpTo x q) ≤
          ∑ q ∈ Finset.Icc 1 R,
            maxCenteredProgressionDiscrepancyUpTo x q := by
        apply Finset.sum_le_sum_of_subset_of_nonneg
          (Finset.Icc_subset_Icc le_rfl hQR)
        intro q _ _
        exact maxCenteredProgressionDiscrepancyUpTo_nonneg x q
      _ ≤ (C + 40 * vaughanProgressionMeanConstant
            (Real.log 4 + 4)) * (x : ℝ) /
          Real.rpow (Real.log (x : ℝ)) A :=
        hbase x hxBase R le_rfl hRrange

end

theorem ae_sum_add_mul_eval_ne_pi
    {ι : Type} [Fintype ι] (ν : ι → Measure ℝ)
    [∀ i, IsProbabilityMeasure (ν i)] (j : ι) [NullSingletonClass (ν j)]
    (a b : ℝ) (ha : 0 ≤ a) :
    ∀ᵐ x ∂Measure.pi ν, (∑ i : ι, x i) + a * x j ≠ b := by
  classical
  let e := MeasurableEquiv.piEquivPiSubtypeProd (fun _ : ι => ℝ) (fun i => i = j)
  have he := measurePreserving_piEquivPiSubtypeProd ν (fun i => i = j)
  have hP : MeasurableSet {x : ι → ℝ | (∑ i : ι, x i) + a * x j ≠ b} :=
    (measurableSet_eq_fun
      ((Finset.measurable_sum Finset.univ fun i _ => measurable_pi_apply i).add
        (measurable_const.mul (measurable_pi_apply j))) measurable_const).compl
  rw [← he.symm.map_eq, ae_map_iff e.symm.measurable.aemeasurable hP]
  have hpair := hP.preimage e.symm.measurable
  rw [Set.preimage_ofPred_eq] at hpair
  apply (Measure.ae_prod_iff_ae_ae hpair).2
  apply (Measure.ae_ae_comm
    (p := fun z y => (∑ i : ι, e.symm (z, y) i) + a * e.symm (z, y) j ≠ b)
    hpair).2
  filter_upwards [] with y
  let : Fintype {i : ι // i = j} := Subtype.fintype (fun i => i = j)
  have hz : ∀ᵐ z ∂Measure.pi (fun i : {i : ι // i = j} => ν i),
      z ⟨j, rfl⟩ ≠ (b - ∑ i : {i : ι // ¬ i = j}, y i) / (1 + a) :=
    Measure.ae_eval_ne (fun i : {i : ι // i = j} => ν i) ⟨j, rfl⟩ _
  refine hz.mono ?_
  intro z hz
  have hj : e.symm (z, y) j = z ⟨j, rfl⟩ := by
    simp [e, MeasurableEquiv.piEquivPiSubtypeProd, Equiv.piEquivPiSubtypeProd]
  have hsum : (∑ i : ι, e.symm (z, y) i) =
      z ⟨j, rfl⟩ + ∑ i : {i : ι // ¬ i = j}, y i := by
    rw [← Fintype.sum_subtype_add_sum_subtype (fun i : ι => i = j)
      (fun i => e.symm (z, y) i)]
    congr 1
    · calc
        (∑ i : {i : ι // i = j}, e.symm (z, y) i) = ∑ i : {i : ι // i = j}, z i := by
          apply Finset.sum_congr rfl
          intro i _
          have hi : (⟨j, rfl⟩ : {i : ι // i = j}) = i := Subtype.ext i.property.symm
          simpa [e, MeasurableEquiv.piEquivPiSubtypeProd,
            Equiv.piEquivPiSubtypeProd, i.property] using congrArg z hi
        _ = z ⟨j, rfl⟩ := Fintype.sum_subsingleton _ _
    · apply Finset.sum_congr rfl
      intro i _
      simp [e, MeasurableEquiv.piEquivPiSubtypeProd,
        Equiv.piEquivPiSubtypeProd, i.property]
  intro h
  apply hz
  apply (eq_div_iff (by linarith : (1 : ℝ) + a ≠ 0)).2
  rw [hsum, hj] at h
  linarith only [h]

theorem ae_finset_sum_add_mul_eval_ne_infinitePi
    {ι : Type} (ν : ι → Measure ℝ) [∀ i, IsProbabilityMeasure (ν i)]
    (S : Finset ι) (j : ι) (hj : j ∈ S) [NullSingletonClass (ν j)]
    (a b : ℝ) (ha : 0 ≤ a) :
    ∀ᵐ x ∂Measure.infinitePi ν, (∑ i ∈ S, x i) + a * x j ≠ b := by
  classical
  have h := ae_sum_add_mul_eval_ne_pi (fun i : S => ν i) ⟨j, hj⟩ a b ha
  have hrestrict : MeasurePreserving S.restrict (Measure.infinitePi ν)
      (Measure.pi fun i : S => ν i) :=
    ⟨S.measurable_restrict, Measure.infinitePi_map_restrict ν⟩
  simpa only [Finset.restrict, Finset.sum_coe_sort] using
    hrestrict.quasiMeasurePreserving.ae h

theorem cappedDyadicIntensity_ae_marks_mem_bands_and_affine_ne
    (κ : ℝ) (d : ℕ) (a b : ℝ) (ha : 0 ≤ a) :
    let μ : ℤ → FiniteMeasure ℝ := cappedDyadicIntensity κ
    let ν : ℤ → Measure (ℕ × (ℕ → ℝ)) := fun k =>
      (ProbabilityTheory.poissonMeasure (μ k).mass).prod
        (Measure.infinitePi (fun _ : ℕ => ((μ k).normalize : Measure ℝ)))
    let ρ := Measure.infinitePi (fun u : Fin d × ℤ => ν u.2)
    ∀ᵐ Ω ∂ρ,
      (∀ (u : Fin d × ℤ) (n : ℕ), n < (Ω u).1 →
        (2 : ℝ) ^ u.2 < (Ω u).2 n ∧ (Ω u).2 n ≤ κ ∧
          (Ω u).2 n ≤ (2 : ℝ) ^ (u.2 + 1)) ∧
      ∀ (S : Finset ((Fin d × ℤ) × ℕ)) (j : (Fin d × ℤ) × ℕ),
        j ∈ S → j.2 < (Ω j.1).1 →
        (∑ v ∈ S, (Ω v.1).2 v.2) + a * (Ω j.1).2 j.2 ≠ b := by
  classical
  intro μ ν ρ
  let : ∀ k : ℤ, IsProbabilityMeasure (ν k) := fun k => by
    dsimp only [ν]
    infer_instance
  have hzero (k : ℤ) (hz : μ k = 0) : ∀ᵐ p ∂ν k, p.1 = 0 := by
    have hm : (μ k).mass = 0 := congrArg FiniteMeasure.mass hz
    have hc : ∀ᵐ n ∂ProbabilityTheory.poissonMeasure (μ k).mass, n = 0 := by
      rw [ae_iff]
      change ProbabilityTheory.poissonMeasure (μ k).mass ({0} : Set ℕ)ᶜ = 0
      rw [measure_compl (measurableSet_singleton 0) (measure_ne_top _ _), measure_univ]
      simp [hm, ProbabilityTheory.poissonMeasure_singleton]
    exact measurePreserving_fst.quasiMeasurePreserving.ae hc
  have hused : ∀ᵐ Ω ∂ρ,
      ∀ (u : Fin d × ℤ) (n : ℕ), n < (Ω u).1 →
        (2 : ℝ) ^ u.2 < (Ω u).2 n ∧ (Ω u).2 n ≤ κ ∧
          (Ω u).2 n ≤ (2 : ℝ) ^ (u.2 + 1) := by
    rw [ae_all_iff]
    intro u
    have hu : ∀ᵐ p ∂ν u.2, ∀ n : ℕ, n < p.1 →
        (2 : ℝ) ^ u.2 < p.2 n ∧ p.2 n ≤ κ ∧
          p.2 n ≤ (2 : ℝ) ^ (u.2 + 1) := by
      by_cases hz : μ u.2 = 0
      · filter_upwards [hzero u.2 hz] with p hp n hn
        omega
      · let B := Set.Ioc ((2 : ℝ) ^ u.2) (min κ ((2 : ℝ) ^ (u.2 + 1)))
        have hcap : (μ u.2 : Measure ℝ) Bᶜ = 0 :=
          (cappedDyadicIntensity_measure κ u.2).2
        have hm : ∀ᵐ t ∂((μ u.2).normalize : Measure ℝ), t ∈ B := by
          rw [ae_iff]
          change ((μ u.2).normalize : Measure ℝ) Bᶜ = 0
          rw [(μ u.2).toMeasure_normalize_eq_of_nonzero hz,
            Measure.smul_apply, hcap, smul_zero]
        have hs : ∀ᵐ z ∂Measure.infinitePi
            (fun _ : ℕ => ((μ u.2).normalize : Measure ℝ)), ∀ n : ℕ, z n ∈ B := by
          rw [ae_all_iff]
          intro n
          exact (measurePreserving_eval_infinitePi
            (fun _ : ℕ => ((μ u.2).normalize : Measure ℝ)) n).quasiMeasurePreserving.ae hm
        have hp : ∀ᵐ p ∂ν u.2, ∀ n : ℕ, p.2 n ∈ B :=
          measurePreserving_snd.quasiMeasurePreserving.ae hs
        filter_upwards [hp] with p hp n _
        exact ⟨(hp n).1, (le_min_iff.mp (hp n).2).1, (le_min_iff.mp (hp n).2).2⟩
    exact (measurePreserving_eval_infinitePi (fun u : Fin d × ℤ => ν u.2)
      u).quasiMeasurePreserving.ae hu
  let mark : ((Fin d × ℤ) → ℕ × (ℕ → ℝ)) → ((Fin d × ℤ) × ℕ) → ℝ :=
    fun Ω v => (Ω v.1).2 v.2
  have hm : Measurable mark :=
    measurable_pi_lambda _ fun v =>
      (measurable_pi_apply v.2).comp (measurable_snd.comp (measurable_pi_apply v.1))
  have hmarks : ρ.map (fun Ω u => (Ω u).2) =
      Measure.infinitePi (fun u : Fin d × ℤ =>
        Measure.infinitePi (fun _ : ℕ => ((μ u.2).normalize : Measure ℝ))) := by
    rw [Measure.infinitePi_map_pi _ (fun _ => measurable_snd)]
    simp only [ν, Measure.map_snd_prod, measure_univ, one_smul]
  have hsecond : Measurable
      (fun Ω : (Fin d × ℤ) → ℕ × (ℕ → ℝ) => fun u => (Ω u).2) :=
    measurable_pi_lambda _ fun u => measurable_snd.comp (measurable_pi_apply u)
  have hmarklaw : ρ.map mark =
      Measure.infinitePi
        (fun v : (Fin d × ℤ) × ℕ => ((μ v.1.2).normalize : Measure ℝ)) := by
    calc
      ρ.map mark = (ρ.map (fun Ω u => (Ω u).2)).map
          (MeasurableEquiv.curry (Fin d × ℤ) ℕ ℝ).symm :=
        (Measure.map_map (MeasurableEquiv.curry (Fin d × ℤ) ℕ ℝ).symm.measurable
          hsecond).symm
      _ = _ := by
        rw [hmarks, Measure.infinitePi_map_curry_symm]
  have hgeneral : ∀ᵐ Ω ∂ρ,
      ∀ (S : Finset ((Fin d × ℤ) × ℕ)) (j : (Fin d × ℤ) × ℕ),
        j ∈ S → j.2 < (Ω j.1).1 →
        (∑ v ∈ S, (Ω v.1).2 v.2) + a * (Ω j.1).2 j.2 ≠ b := by
    rw [ae_all_iff]
    intro S
    rw [ae_all_iff]
    intro j
    by_cases hj : j ∈ S
    · by_cases hz : μ j.1.2 = 0
      · have hc := (measurePreserving_eval_infinitePi
          (fun u : Fin d × ℤ => ν u.2) j.1).quasiMeasurePreserving.ae
            (hzero j.1.2 hz)
        filter_upwards [hc] with Ω hΩ _ hused
        have hzcount : (Ω j.1).1 = 0 := hΩ
        exact (Nat.not_lt_zero _ (hzcount ▸ hused)).elim
      · let : NullSingletonClass ((μ j.1.2).normalize : Measure ℝ) := by
          refine ⟨fun x => ?_⟩
          rw [(μ j.1.2).toMeasure_normalize_eq_of_nonzero hz,
            (cappedDyadicIntensity_measure κ j.1.2).1]
          simp [Measure.smul_apply]
        have h := ae_finset_sum_add_mul_eval_ne_infinitePi
          (fun v : (Fin d × ℤ) × ℕ => ((μ v.1.2).normalize : Measure ℝ)) S j hj a b ha
        have hmap : ∀ᵐ z ∂ρ.map mark, (∑ v ∈ S, z v) + a * z j ≠ b := by
          rw [hmarklaw]
          exact h
        filter_upwards [ae_of_ae_map hm.aemeasurable hmap] with Ω hΩ _ _
        exact hΩ
    · exact ae_of_all _ fun _ h => (hj h).elim
  filter_upwards [hused, hgeneral] with Ω hΩ hG
  exact ⟨hΩ, hG⟩

theorem exists_finset_sum_finiteFragments_restrict_Ioi_eq_sum_dirac
    (κ δ : ℝ) (hκ : 0 < κ) (hδ : 0 < δ) (d : ℕ)
    (Ω : (Fin d × ℤ) → ℕ × (ℕ → ℝ))
    (hΩ : ∀ (u : Fin d × ℤ) (n : ℕ), n < (Ω u).1 →
      (2 : ℝ) ^ u.2 < (Ω u).2 n ∧ (Ω u).2 n ≤ κ ∧
        (Ω u).2 n ≤ (2 : ℝ) ^ (u.2 + 1))
    (hfinite : ∀ i : Fin d, IsFiniteMeasure
      (Measure.sum (fun k : ℤ =>
        (weightedEmpirical (Ω (i, k)).1 (fun n => (Ω (i, k)).2 n.val) : Measure ℝ)))) :
    let X : Fin d → FiniteMeasure ℝ := fun i =>
      finiteFragments (fun k =>
        weightedEmpirical (Ω (i, k)).1 (fun n => (Ω (i, k)).2 n.val))
    ∃ S : Finset ((Fin d × ℤ) × ℕ),
      (∀ v ∈ S, v.2 < (Ω v.1).1 ∧ δ < (Ω v.1).2 v.2) ∧
      (∑ i : Fin d, (X i : Measure ℝ)).restrict (Set.Ioi δ) =
        ∑ v ∈ S, ENNReal.ofReal ((Ω v.1).2 v.2) • Measure.dirac ((Ω v.1).2 v.2) := by
  classical
  intro X
  let ξ (i : Fin d) (k : ℤ) :=
    weightedEmpirical (Ω (i, k)).1 (fun n => (Ω (i, k)).2 n.val)
  let M (i : Fin d) := Measure.sum (fun k : ℤ => (ξ i k : Measure ℝ))
  let mark (v : (Fin d × ℤ) × ℕ) := (Ω v.1).2 v.2
  let atom (u : ℝ) : Measure ℝ := ENNReal.ofReal u • Measure.dirac u
  have hX (i : Fin d) : (X i : Measure ℝ) = M i := by
    have hi : X i = (⟨M i, hfinite i⟩ : FiniteMeasure ℝ) := dite_eq_left (hfinite i)
    exact congrArg (fun Z : FiniteMeasure ℝ => (Z : Measure ℝ)) hi
  obtain ⟨lo, hlo⟩ := exists_mem_Ioc_zpow hδ (by norm_num : (1 : ℝ) < 2)
  obtain ⟨hi, hhi⟩ := exists_mem_Ioc_zpow hκ (by norm_num : (1 : ℝ) < 2)
  let W : Finset ℤ := Finset.Icc lo hi
  let A : Finset (Fin d × ℤ) := Finset.univ ×ˢ W
  let indices (u : Fin d × ℤ) : Finset ((Fin d × ℤ) × ℕ) :=
    (Finset.range (Ω u).1).image (fun n => (u, n))
  let R := A.biUnion indices
  let S := R.filter (fun v => δ < mark v)
  have hband (u : Fin d × ℤ) (n : ℕ) (hn : n < (Ω u).1)
      (hδn : δ < (Ω u).2 n) : u.2 ∈ W := by
    apply Finset.mem_Icc.mpr
    constructor
    · by_contra hlow
      have hle : u.2 + 1 ≤ lo := by omega
      have hupper : (Ω u).2 n ≤ (2 : ℝ) ^ lo :=
        (hΩ u n hn).2.2.trans (zpow_le_zpow_right₀ (by norm_num) hle)
      exact (lt_trans hlo.1 hδn).not_ge hupper
    · by_contra hhigh
      have hle : hi + 1 ≤ u.2 := by omega
      have hupper : κ ≤ (2 : ℝ) ^ u.2 :=
        hhi.2.trans (zpow_le_zpow_right₀ (by norm_num) hle)
      exact (lt_of_le_of_lt hupper (hΩ u n hn).1).not_ge (hΩ u n hn).2.1
  have hrestrict (u : Fin d × ℤ) :
      (ξ u.1 u.2 : Measure ℝ).restrict (Set.Ioi δ) =
        ∑ n ∈ Finset.range (Ω u).1,
          if δ < mark (u, n) then atom (mark (u, n)) else 0 := by
    rw [coe_weightedEmpirical]
    conv_lhs =>
      rw [← Measure.sum_fintype, Measure.restrict_sum _ measurableSet_Ioi,
        Measure.sum_fintype]
    rw [← Fin.sum_univ_eq_sum_range]
    apply Finset.sum_congr rfl
    intro n _
    simp only [Measure.restrict_smul, restrict_dirac, Set.mem_Ioi, atom, mark,
      smul_ite, smul_zero]
  have houtside (i : Fin d) (k : ℤ) (hk : k ∉ W) :
      (ξ i k : Measure ℝ).restrict (Set.Ioi δ) = 0 := by
    rw [hrestrict (i, k)]
    apply Finset.sum_eq_zero
    intro n hn
    have hz : ¬ δ < mark ((i, k), n) :=
      fun h => hk (hband (i, k) n (Finset.mem_range.mp hn) h)
    exact ite_eq_right hz
  have hcut (i : Fin d) :
      (M i).restrict (Set.Ioi δ) =
        ∑ k ∈ W, (ξ i k : Measure ℝ).restrict (Set.Ioi δ) := by
    apply Measure.ext
    intro s hs
    change (Measure.sum (fun k : ℤ => (ξ i k : Measure ℝ))).restrict (Set.Ioi δ) s = _
    rw [Measure.restrict_sum _ measurableSet_Ioi, Measure.sum_apply _ hs,
      Measure.finsetSum_apply]
    exact tsum_eq_sum (s := W) fun k hk => by simp [houtside i k hk]
  have hdis : Set.PairwiseDisjoint (A : Set (Fin d × ℤ)) indices := by
    intro u _ v _ huv
    apply Finset.disjoint_left.mpr
    intro z hzu hzv
    obtain ⟨n, _, rfl⟩ := Finset.mem_image.mp hzu
    obtain ⟨m, _, hm⟩ := Finset.mem_image.mp hzv
    exact huv (congrArg Prod.fst hm).symm
  have hused (v : (Fin d × ℤ) × ℕ) (hv : v ∈ R) :
      v.2 < (Ω v.1).1 := by
    obtain ⟨u, _, hu⟩ := Finset.mem_biUnion.mp hv
    obtain ⟨n, hn, rfl⟩ := Finset.mem_image.mp hu
    exact Finset.mem_range.mp hn
  refine ⟨S, ?_, ?_⟩
  · intro v hv
    exact ⟨hused v (Finset.mem_filter.mp hv).1, (Finset.mem_filter.mp hv).2⟩
  · calc
      (∑ i : Fin d, (X i : Measure ℝ)).restrict (Set.Ioi δ) =
          ∑ i : Fin d, (M i).restrict (Set.Ioi δ) := by
        simp_rw [hX]
        rw [← Measure.sum_fintype, Measure.restrict_sum _ measurableSet_Ioi,
          Measure.sum_fintype]
      _ = ∑ i : Fin d, ∑ k ∈ W, (ξ i k : Measure ℝ).restrict (Set.Ioi δ) :=
        Finset.sum_congr rfl fun i _ => hcut i
      _ = ∑ u ∈ A, (ξ u.1 u.2 : Measure ℝ).restrict (Set.Ioi δ) :=
        (Finset.sum_product Finset.univ W
          (fun u : Fin d × ℤ => (ξ u.1 u.2 : Measure ℝ).restrict (Set.Ioi δ))).symm
      _ = ∑ u ∈ A, ∑ n ∈ Finset.range (Ω u).1,
          if δ < mark (u, n) then atom (mark (u, n)) else 0 :=
        Finset.sum_congr rfl fun u _ => hrestrict u
      _ = ∑ v ∈ R, if δ < mark v then atom (mark v) else 0 := by
        rw [Finset.sum_biUnion hdis]
        apply Finset.sum_congr rfl
        intro u _
        rw [Finset.sum_image]
        intro n _ m _ hnm
        exact (Prod.mk.inj hnm).2
      _ = ∑ v ∈ S, atom (mark v) :=
        (Finset.sum_filter (s := R) (fun v => δ < mark v) (fun v => atom (mark v))).symm

end PrimeGap186

open scoped ContDiff Manifold in
theorem MeasureTheory.MemLp.exists_contDiff_tsupport_subset_eLpNorm_sub_le
    {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]
    [MeasurableSpace E] [BorelSpace E] {μ : MeasureTheory.Measure E}
    [MeasureTheory.IsFiniteMeasure μ] {f : E → ℝ}
    (hf : MeasureTheory.MemLp f 2 μ) {K U : Set E} (hK : IsCompact K)
    (hfK : Function.support f ⊆ K) (hU : IsOpen U) (hKU : K ⊆ U)
    {ε : ℝ} (hε : 0 < ε) :
    ∃ g : E → ℝ, ContDiff ℝ ∞ g ∧ HasCompactSupport g ∧ tsupport g ⊆ U ∧
      MeasureTheory.eLpNorm (f - g) 2 μ ≤ ENNReal.ofReal ε := by
  classical
  obtain ⟨V, hV, hKV, hVU, _⟩ :=
    exists_open_between_and_isCompact_closure hK hU hKU
  obtain ⟨θ, hθ0, hθ1, hθbounds⟩ :=
    exists_contMDiffMap_zero_one_of_isClosed (𝓘(ℝ, E)) (n := ⊤)
      hV.isClosed_compl hK.isClosed
      (Set.disjoint_left.mpr fun x hxV hxK ↦ hxV (hKV hxK))
  obtain ⟨g, hgCompact, hgSmooth, hgε⟩ :=
    hf.exist_eLpNorm_sub_le (by norm_num) (by norm_num) hε
  have hθsupp : Function.support (fun x : E ↦ θ x) ⊆ V := by
    intro x hx
    by_contra hxV
    exact hx (hθ0 hxV)
  have hθf (x : E) : θ x * f x = f x := by
    by_cases hx : f x = 0
    · simp [hx]
    · calc
        θ x * f x = 1 * f x := congrArg (fun r : ℝ ↦ r * f x) (hθ1 (hfK hx))
        _ = f x := one_mul _
  refine ⟨fun x ↦ θ x * g x, θ.contMDiff.contDiff.mul hgSmooth, hgCompact.mul_left,
    ?_, ?_⟩
  · exact (tsupport_mul_subset_left (f := fun x ↦ θ x) (g := g)).trans
      ((closure_mono hθsupp).trans hVU)
  · refine (MeasureTheory.eLpNorm_mono fun x ↦ ?_).trans hgε
    calc
      ‖f x - θ x * g x‖ = ‖θ x * (f x - g x)‖ := by rw [mul_sub, hθf x]
      _ = θ x * ‖f x - g x‖ := by
        rw [norm_mul, Real.norm_eq_abs, abs_of_nonneg (hθbounds x).1]
      _ ≤ ‖f x - g x‖ := mul_le_of_le_one_left (norm_nonneg _) (hθbounds x).2

section
open Polynomial

universe u v w

namespace PrimeGap186

open Classical in
theorem reciprocalUnitPhase_and_product_norm
    (q : ℕ) [NeZero q]
    (M : (p : q.primeFactors) → Finset (ZMod p.1))
    (a : (p : q.primeFactors) → ZMod p.1 → ZMod p.1) :
    (∀ c x : ZMod q,
      ‖reciprocalUnitPhase q c x‖ = if IsUnit x then 1 else 0) ∧
    (∀ x : ZMod q,
      ‖maskedReciprocalProduct q M a x‖ =
        if ∀ p : q.primeFactors, (x.val : ZMod p.1) ∉ M p then 1 else 0) ∧
    (∀ x : ZMod q, ‖maskedReciprocalProduct q M a x‖ ≤ 1) ∧
    (q = 1 → ∀ x : ZMod q, maskedReciprocalProduct q M a x = 1) ∧
    (∀ c x : ZMod 1, reciprocalUnitPhase 1 c x = 1) := by
  have hnproc (c x : ZMod q) : ‖reciprocalUnitPhase q c x‖ =
      if IsUnit x then 1 else 0 := by
    by_cases h : IsUnit x
    · rw [reciprocalUnitPhase, ite_eq_left h, ite_eq_left h, ZMod.stdAddChar_apply]
      exact Circle.norm_coe _
    · simp [reciprocalUnitPhase, h]
  have hnprod (x : ZMod q) : ‖maskedReciprocalProduct q M a x‖ =
      if ∀ p : q.primeFactors, (x.val : ZMod p.1) ∉ M p then 1 else 0 := by
    rw [maskedReciprocalProduct, norm_prod]
    have natt (u : q.primeFactors) : ‖@maskedReciprocalLocal u.1
      ⟨Nat.prime_of_mem_primeFactors u.2⟩ (M u) (a u) (x.val : ZMod u.1)‖ =
      if (x.val : ZMod u.1) ∈ M u then 0 else 1 :=
      @norm_maskedReciprocalLocal u.1 ⟨Nat.prime_of_mem_primeFactors u.2⟩ _ _ _
    simp_rw [natt]
    by_cases hall : ∀ p : q.primeFactors, (x.val : ZMod p.1) ∉ M p
    · rw [ite_eq_left hall]
      apply Finset.prod_eq_one
      intro i hi
      simp only [hall i, ite_false]
    · rw [ite_eq_right hall]
      push Not at hall
      obtain ⟨j, hj⟩ := hall
      apply Finset.prod_eq_zero (Finset.mem_univ j)
      have hxj : x.cast ∈ (M j) := by simpa [← ZMod.natCast_val] using hj
      simp [hxj]
  refine ⟨hnproc, hnprod, ?_, ?_, ?_⟩
  · intro x
    rw [hnprod x]
    split_ifs <;> norm_num
  · intro hq x
    subst q
    change (∏ p : (1 : ℕ).primeFactors, _) = _
    let : IsEmpty (1 : ℕ).primeFactors := by
      apply Set.isEmpty_coe_sort.2
      simp
    simp
  · intro c x
    rw [reciprocalUnitPhase, ite_eq_left (show IsUnit x by
      rw [Subsingleton.elim x (1 : ZMod 1)]; exact isUnit_one)]
    have hx : c * x⁻¹ = 0 := Subsingleton.elim _ 0
    simp [hx]

theorem exclusive_inv_product (q m n k : ℕ) [NeZero q] [NeZero m] [NeZero n]
    (hmq : m ∣ q) (hms : Squarefree m) :
    (∏ j : q.primeFactors,
      if j.1 ∣ m ∧ ¬j.1 ∣ n ∧ ¬j.1 ∣ k then (j.1 : ℝ)⁻¹ else 1) =
        (Nat.gcd k (m / m.gcd n) : ℝ) / (m / m.gcd n : ℕ) := by
  classical
  let δ := m / m.gcd n
  have hmpos : 0 < m := NeZero.pos m
  have hdpos : 0 < δ := Nat.div_pos (Nat.gcd_le_left n hmpos) (Nat.gcd_pos_of_pos_left n hmpos)
  let _ : NeZero δ := NeZero.mk (Nat.ne_of_gt hdpos)
  have hdq : δ ∣ q := (Nat.div_dvd_of_dvd (Nat.gcd_dvd_left m n)).trans hmq
  have hdS : Squarefree δ :=
    Squarefree.squarefree_of_dvd (Nat.div_dvd_of_dvd (Nat.gcd_dvd_left m n)) hms
  have hchar (u : q.primeFactors) : u.val ∣ δ ↔ u.val ∣ m ∧ ¬u.val ∣ n := by
    have hchr : u.1.Prime := Nat.prime_of_mem_primeFactors u.2
    have hdelta : u.1 ∈ δ.primeFactors ↔ u.1 ∣ δ :=
      (Nat.mem_primeFactors_of_ne_zero (NeZero.ne δ)).trans (by simp [hchr])
    rw [← hdelta]
    dsimp [δ]
    rw [Nat.primeFactors_div_gcd hms (NeZero.ne n), Finset.mem_sdiff,
      Nat.mem_primeFactors_of_ne_zero (NeZero.ne m), Nat.mem_primeFactors_of_ne_zero (NeZero.ne n)]
    simp [hchr]
  calc
    _ = ∏ u : q.primeFactors, if u.val ∣ δ then
        (if ¬u.val ∣ k then (u.val : ℝ)⁻¹ else 1) else 1 := by
      apply Finset.prod_congr rfl
      intro u hu
      split_ifs with h1 h2 h3 <;> simp_all only [not_false_eq_true, true_and]
      all_goals try { exfalso; tauto }
    _ = ∏ p : δ.primeFactors, if ¬p.val ∣ k then (p.val : ℝ)⁻¹ else 1 := by
      apply restrict_divisor_primes q δ hdq
    _ = (Nat.gcd k δ : ℝ) / (δ : ℝ) := by
      rw [show (∏ p : δ.primeFactors, if ¬p.val ∣ k then (p.val : ℝ)⁻¹ else 1) =
          ∏ p ∈ δ.primeFactors.filter (fun p => ¬p ∣ k), (p : ℝ)⁻¹ by
        rw [Finset.prod_coe_sort_eq_attach, Finset.prod_filter]
        exact Finset.prod_attach δ.primeFactors
          (fun p : ℕ => if ¬p ∣ k then (p : ℝ)⁻¹ else 1), inv_primes_not_dvd δ hdS k]
    _ = _ := rfl

theorem reciprocalUnitPhase_pair_mean_norm_le
    (q : ℕ) [NeZero q] (hq : Squarefree q)
    (d : Fin 2 → ℕ) (hd : ∀ i, d i ∣ q) (c ℓ : Fin 2 → ℤ) :
    let δ : Fin 2 → ℕ := fun i => d i / Nat.gcd (d 0) (d 1)
    ‖(∑ x : ZMod q, ∏ i : Fin 2,
        letI : NeZero (d i) :=
          ⟨ne_zero_of_dvd_ne_zero (NeZero.ne q) (hd i)⟩
        reciprocalUnitPhase (d i) (c i : ZMod (d i))
          ((x.val : ZMod (d i)) + (ℓ i : ZMod (d i)))) / (q : ℂ)‖ ≤
      ∏ i : Fin 2, (Nat.gcd (c i).natAbs (δ i) : ℝ) / (δ i : ℝ) := by
  classical
  let I : (p : q.primeFactors) → Finset (Fin 2) := fun p =>
    Finset.univ.filter (fun i => p.1 ∣ d i)
  let M (p : q.primeFactors) := (I p).image (fun i => -(ℓ i : ZMod p.1))
  let a (p : q.primeFactors) : ZMod p.1 → ZMod p.1 := fun z =>
    ∑ i ∈ I p, if -(ℓ i : ZMod p.1) = z then
      (c i : ZMod p.1) * (((d i / p.1 : ℕ) : ZMod p.1)⁻¹) else 0
  let U0 : Finset q.primeFactors := Finset.univ.filter
      (fun z => z.val ∣ d 0 ∧ ¬z.val ∣ d 1 ∧ ¬z.val ∣ (c 0).natAbs)
  let U1 : Finset q.primeFactors := Finset.univ.filter
      (fun z => z.val ∣ d 1 ∧ ¬z.val ∣ d 0 ∧ ¬z.val ∣ (c 1).natAbs)
  let E := U0 ∪ U1
  have hdis : Disjoint U0 U1 := by
    apply Finset.disjoint_left.mpr
    intro z hz h'z
    simp only [U0, U1, Finset.mem_filter, Finset.mem_univ, true_and] at hz h'z
    tauto
  have (p : q.primeFactors) : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
  have hco (p : q.primeFactors) (i : Fin 2) (hpi : p.1 ∣ d i) :
      (((d i / p.1 : ℕ) : ZMod p.1)⁻¹) ≠ 0 := by
    have hw := isUnit_cofactor_of_squarefree (hq.squarefree_of_dvd (hd i))
      ((Fact.out : Nat.Prime p.1).mem_primeFactors hpi
        (ne_zero_of_dvd_ne_zero (NeZero.ne q) (hd i)))
    exact inv_ne_zero ((isUnit_iff_ne_zero).mp hw)
  have honly (p : q.primeFactors) (i j : Fin 2) (hdiv : p.1 ∣ d i) (hn : ¬p.1 ∣ d j)
      (hnc : ¬p.1 ∣ (c i).natAbs) (hne : j ≠ i) :
      M p = {-(ℓ i : ZMod p.1)} ∧ a p (-(ℓ i : ZMod p.1)) ≠ 0 := by
    have heq : I p = {i} := by
      fin_cases i <;> fin_cases j <;> simp_all [I, Finset.ext_iff, Fin.forall_fin_succ]
    have hc : (c i : ZMod p.1) ≠ 0 := fun hc => hnc (Int.natCast_dvd.mp
      ((ZMod.intCast_zmod_eq_zero_iff_dvd (c i) p.1).mp hc))
    refine ⟨by simp [M, heq], ?_⟩
    simp [a, heq, hc, hco p i hdiv]
  have hbound (p : q.primeFactors) (hpe : p ∈ E) : ∃ v, M p = {v} ∧ a p v ≠ 0 := by
    rcases Finset.mem_union.mp hpe with (h0 | h1)
    · simp only [U0, Finset.mem_filter, Finset.mem_univ, true_and] at h0
      obtain ⟨h00, h01, hc0⟩ := h0
      exact ⟨-(ℓ 0 : ZMod p.1), honly p 0 1 h00 h01 hc0 (by decide)⟩
    · simp only [U1, Finset.mem_filter, Finset.mem_univ, true_and] at h1
      obtain ⟨h10, h11, hc1⟩ := h1
      exact ⟨-(ℓ 1 : ZMod p.1), honly p 1 0 h10 h11 hc1 (by decide)⟩
  let z (p : q.primeFactors) : ZMod p.1 := if hp : p ∈ E then (hbound p hp).choose else 0
  have hE (p : q.primeFactors) (hp : p ∈ E) : M p = {z p} ∧ a p (z p) ≠ 0 := by
    have hf := (hbound p hp).choose_spec
    simpa [z, hp] using hf
  have htem := (reciprocalUnitPhase_pair_eq_maskedReciprocalProduct q hq d hd c ℓ).2
  have ht := (maskedReciprocalProduct_exclusive_mean q hq M a E z hE).2
  simp_rw [htem]
  rw [Fin.prod_univ_two]
  calc
    _ ≤ ∏ p ∈ E, (p.1 : ℝ)⁻¹ := ht
    _ = _ := by
      let _ (i : Fin 2) : NeZero (d i) := ⟨ne_zero_of_dvd_ne_zero (NeZero.ne q) (hd i)⟩
      have hs (i : Fin 2) : Squarefree (d i) := hq.squarefree_of_dvd (hd i)
      rw [Finset.prod_union hdis]
      have h0 : (∏ p ∈ U0, (p.val : ℝ)⁻¹) =
          (Nat.gcd (c 0).natAbs (d 0 / Nat.gcd (d 0) (d 1)) : ℝ) /
            (d 0 / Nat.gcd (d 0) (d 1) : ℕ) := by
        have ht0 := exclusive_inv_product q (d 0) (d 1) (c 0).natAbs (hd 0) (hs 0)
        simpa only [U0, Finset.prod_filter] using ht0
      have h1 : (∏ p ∈ U1, (p.val : ℝ)⁻¹) =
          (Nat.gcd (c 1).natAbs (d 1 / Nat.gcd (d 0) (d 1)) : ℝ) /
            (d 1 / Nat.gcd (d 0) (d 1) : ℕ) := by
        have ht1 := exclusive_inv_product q (d 1) (d 0) (c 1).natAbs (hd 1) (hs 1)
        simpa only [U1, Finset.prod_filter, Nat.gcd_comm (d 1)] using ht1
      rw [h0, h1]

theorem maskedReciprocalProduct_correlation_exact
    (q : ℕ) [NeZero q] (hq : Squarefree q)
    (M : (p : q.primeFactors) → Finset (ZMod p.1))
    (a : (p : q.primeFactors) → ZMod p.1 → ZMod p.1)
    (h : ZMod q) :
    let C : ZMod q → ℂ := fun x =>
      maskedReciprocalProduct q M a (x + h) *
        star (maskedReciprocalProduct q M a x)
    let U : (p : q.primeFactors) → Finset (ZMod p.1) := fun p =>
      M p ∪ (M p).image (fun z => z - (h.val : ZMod p.1))
    let b : (p : q.primeFactors) → ZMod p.1 → ZMod p.1 := fun p z =>
      (if z + (h.val : ZMod p.1) ∈ M p then a p (z + (h.val : ZMod p.1)) else 0) -
        (if z ∈ M p then a p z else 0)
    (∀ p : q.primeFactors, (U p).card ≤ 2 * (M p).card) ∧
    (∀ x : ZMod q, C x = maskedReciprocalProduct q U b x) ∧
    (∀ ξ : ZMod q,
      ZMod.dft C ξ = ∏ p : q.primeFactors,
        letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
        ZMod.dft (fun u : ZMod p.1 =>
          maskedReciprocalLocal p.1 (M p) (a p) (u + (h.val : ZMod p.1)) *
            star (maskedReciprocalLocal p.1 (M p) (a p) u))
          (((q / p.1 : ℕ) : ZMod p.1)⁻¹ * (ξ.val : ZMod p.1))) ∧
    (h = 0 → ∀ ξ : ZMod q,
      ZMod.dft C ξ = ∏ p : q.primeFactors,
        letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
        let η : ZMod p.1 :=
          ((q / p.1 : ℕ) : ZMod p.1)⁻¹ * (ξ.val : ZMod p.1)
        (if η = 0 then (p.1 : ℂ) else 0) -
          ∑ z ∈ M p, ZMod.stdAddChar (-(z * η))) ∧
    (h = 0 → (∑ x : ZMod q, C x) =
      ∏ p : q.primeFactors, ((p.1 : ℂ) - ((M p).card : ℂ))) := by
  classical
  intro C U b
  let F : (p : q.primeFactors) → ZMod p.1 → ℂ := fun p u =>
    letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
    maskedReciprocalLocal p.1 (M p) (a p) (u + (h.val : ZMod p.1)) *
      star (maskedReciprocalLocal p.1 (M p) (a p) u)
  have hfactor : C = fun x : ZMod q =>
      ∏ p : q.primeFactors, F p (x.val : ZMod p.1) := by
    funext x
    dsimp only [C, F, maskedReciprocalProduct]
    rw [star_prod, ← Finset.prod_mul_distrib]
    apply Finset.prod_congr rfl
    intro p _
    have hpq := Nat.dvd_of_mem_primeFactors p.property
    congr 2
    rw [← zmod_castHom_apply_eq_natCast_val hpq, map_add,
      zmod_castHom_apply_eq_natCast_val hpq, zmod_castHom_apply_eq_natCast_val hpq]
  have hfourier (ξ : ZMod q) : ZMod.dft C ξ =
      ∏ p : q.primeFactors,
        letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
        ZMod.dft (F p)
          (((q / p.1 : ℕ) : ZMod p.1)⁻¹ * (ξ.val : ZMod p.1)) := by
    rw [hfactor]
    exact (squarefree_crt_character_dft_mean q hq F).2.1 ξ
  refine ⟨?_, ?_, hfourier, ?_, ?_⟩
  · intro p
    let : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
    exact (maskedReciprocalLocal_translate p.1 (M p) (a p)
      (h.val : ZMod p.1)).1
  · intro x
    rw [hfactor, maskedReciprocalProduct]
    apply Finset.prod_congr rfl
    intro p _
    let : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
    exact (maskedReciprocalLocal_translate p.1 (M p) (a p)
      (h.val : ZMod p.1)).2 (x.val : ZMod p.1)
  · intro hh ξ
    rw [hfourier]
    apply Finset.prod_congr rfl
    intro p _
    let : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
    simpa only [F, hh, ZMod.val_zero, Nat.cast_zero, add_zero] using
      (diag_dft_local p.1 (M p) (a p)
        (((q / p.1 : ℕ) : ZMod p.1)⁻¹ * (ξ.val : ZMod p.1)))
  · intro hh
    rw [← ZMod.dft_apply_zero, hfourier]
    apply Finset.prod_congr rfl
    intro p _
    let : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
    simpa only [F, hh, ZMod.val_zero, Nat.cast_zero, add_zero, mul_zero,
      neg_zero, ite_true, AddChar.map_zero_eq_one, Finset.sum_const,
      nsmul_eq_mul, mul_one] using
      (diag_dft_local p.1 (M p) (a p) (0 : ZMod p.1))

end PrimeGap186
end

namespace PrimeGap186

/-!
## Composite moduli and dispersion

Factor masked phases through the Chinese remainder theorem and use the local estimates in
dispersion sums.
-/

theorem pole_masked_phase_chineseRemainder
    (r s : ℕ) [NeZero r] [NeZero s] (hrs : r.Coprime s)
    (A L u v t : ZMod (r * s)) :
    let e := ZMod.chineseRemainder hrs
    (if IsUnit (u * v) then
      ZMod.stdAddChar (A * L * (u * v)⁻¹ + t)
    else 0) =
      (if IsUnit ((e u).1 * (e v).1) then
        ZMod.stdAddChar
          ((s : ZMod r)⁻¹ *
            ((e A).1 * (e L).1 * ((e u).1 * (e v).1)⁻¹ + (e t).1))
      else 0) *
      (if IsUnit ((e u).2 * (e v).2) then
        ZMod.stdAddChar
          ((r : ZMod s)⁻¹ *
            ((e A).2 * (e L).2 * ((e u).2 * (e v).2)⁻¹ + (e t).2))
      else 0) := by
  intro e
  have hbez : (r : ℤ) * Nat.gcdA r s + (s : ℤ) * Nat.gcdB r s = 1 := by
    simpa [hrs] using (Nat.gcd_eq_gcd_ab r s).symm
  have hinvr : (s : ZMod r)⁻¹ = (Nat.gcdB r s : ZMod r) := by
    apply ZMod.inv_eq_of_mul_eq_one
    simpa using congrArg (fun j : ℤ => (j : ZMod r)) hbez
  have hinvs : (r : ZMod s)⁻¹ = (Nat.gcdA r s : ZMod s) := by
    apply ZMod.inv_eq_of_mul_eq_one
    simpa using congrArg (fun j : ℤ => (j : ZMod s)) hbez
  have hchar (z : ZMod (r * s)) :
      ZMod.stdAddChar z =
        ZMod.stdAddChar ((s : ZMod r)⁻¹ * (e z).1) *
          ZMod.stdAddChar ((r : ZMod s)⁻¹ * (e z).2) := by
    obtain ⟨j, rfl⟩ := ZMod.intCast_surjective z
    rw [hinvr, hinvs]
    simp only [map_intCast, Prod.fst_intCast, Prod.snd_intCast,
      ← Int.cast_mul, ZMod.stdAddChar_coe]
    rw [← Complex.exp_add]
    congr 1
    push_cast
    have hbezC : (r : ℂ) * (Nat.gcdA r s : ℂ) +
        (s : ℂ) * (Nat.gcdB r s : ℂ) = 1 := by exact_mod_cast hbez
    field_simp [NeZero.ne (r : ℂ), NeZero.ne (s : ℂ)]
    linear_combination -(j : ℂ) * hbezC
  have hmask : IsUnit (u * v) ↔
      IsUnit ((e u).1 * (e v).1) ∧ IsUnit ((e u).2 * (e v).2) := by
    simpa only [map_mul, Prod.isUnit_iff, Prod.fst_mul, Prod.snd_mul] using
      (MulEquiv.isUnit_map e (x := u * v)).symm
  by_cases hD : IsUnit (u * v)
  · have hinv (m : ℕ) (φ : ZMod (r * s) →+* ZMod m) :
        φ ((u * v)⁻¹) = (φ (u * v))⁻¹ := by
      symm
      apply ZMod.inv_eq_of_mul_eq_one
      rw [← map_mul, ZMod.mul_inv_of_unit _ hD, map_one]
    obtain ⟨hr, hs⟩ := hmask.mp hD
    rw [ite_eq_left hD, ite_eq_left hr, ite_eq_left hs]
    have hi1 : (e ((u * v)⁻¹)).1 = ((e (u * v)).1)⁻¹ :=
      hinv r ((RingHom.fst (ZMod r) (ZMod s)).comp e.toRingHom)
    have hi2 : (e ((u * v)⁻¹)).2 = ((e (u * v)).2)⁻¹ :=
      hinv s ((RingHom.snd (ZMod r) (ZMod s)).comp e.toRingHom)
    simpa [map_add, map_mul, hi1, hi2] using hchar (A * L * (u * v)⁻¹ + t)
  · rcases not_and_or.mp (mt hmask.mpr hD) with hr | hs
    · simp only [ite_eq_right hD, ite_eq_right hr, zero_mul]
    · simp only [ite_eq_right hD, ite_eq_right hs, mul_zero]

theorem sum_pole_masked_affine_phase_chineseRemainder
    (r s : ℕ) [NeZero r] [NeZero s] (hrs : r.Coprime s)
    (A B L η₁ η₂ h k : ZMod (r * s)) :
    let e := ZMod.chineseRemainder hrs
    let F₁ : ZMod (r * s) → ZMod (r * s) → ZMod (r * s) :=
      fun n d => n + B * d + η₁
    let F₂ : ZMod (r * s) → ZMod (r * s) → ZMod (r * s) :=
      fun n d => n + (B + L) * d + η₂
    let F₁r : ZMod r → ZMod r → ZMod r :=
      fun n d => n + (e B).1 * d + (e η₁).1
    let F₂r : ZMod r → ZMod r → ZMod r :=
      fun n d => n + ((e B).1 + (e L).1) * d + (e η₂).1
    let F₁s : ZMod s → ZMod s → ZMod s :=
      fun n d => n + (e B).2 * d + (e η₁).2
    let F₂s : ZMod s → ZMod s → ZMod s :=
      fun n d => n + ((e B).2 + (e L).2) * d + (e η₂).2
    (∑ n : ZMod (r * s), ∑ d : ZMod (r * s),
      if IsUnit (F₁ n d * F₂ n d) then
        ZMod.stdAddChar (A * L * (F₁ n d * F₂ n d)⁻¹ + h * n + k * d)
      else 0) =
      (∑ n : ZMod r, ∑ d : ZMod r,
        if IsUnit (F₁r n d * F₂r n d) then
          ZMod.stdAddChar
            ((s : ZMod r)⁻¹ *
              ((e A).1 * (e L).1 * (F₁r n d * F₂r n d)⁻¹ +
                (e h).1 * n + (e k).1 * d))
        else 0) *
      (∑ n : ZMod s, ∑ d : ZMod s,
        if IsUnit (F₁s n d * F₂s n d) then
          ZMod.stdAddChar
            ((r : ZMod s)⁻¹ *
              ((e A).2 * (e L).2 * (F₁s n d * F₂s n d)⁻¹ +
                (e h).2 * n + (e k).2 * d))
        else 0) := by
  intro e F₁ F₂ F₁r F₂r F₁s F₂s
  simp_rw [Fintype.sum_mul_sum]
  conv_rhs => rw [← Fintype.sum_prod_type']
  apply Fintype.sum_equiv e
  intro n
  rw [← Fintype.sum_prod_type']
  apply Fintype.sum_equiv e
  intro d
  simpa [F₁, F₂, F₁r, F₂r, F₁s, F₂s, add_assoc] using
    pole_masked_phase_chineseRemainder r s hrs A L (F₁ n d) (F₂ n d) (h * n + k * d)

theorem sum_pole_masked_affine_phase_eq
    (p : ℕ) [Fact p.Prime] (A B L η₁ η₂ h k : ZMod p)
    (hAL : A * L ≠ 0) :
    let F₁ : ZMod p → ZMod p → ZMod p := fun n d => n + B * d + η₁
    let F₂ : ZMod p → ZMod p → ZMod p := fun n d => n + (B + L) * d + η₂
    let b : ZMod p := (k - h * B) / L
    let a : ZMod p := h - b
    (∑ n : ZMod p, ∑ d : ZMod p,
      if IsUnit (F₁ n d * F₂ n d) then
        ZMod.stdAddChar (A * L / (F₁ n d * F₂ n d) + h * n + k * d)
      else 0) =
      ZMod.stdAddChar (-(a * η₁ + b * η₂)) *
        ∑ u : (ZMod p)ˣ, ∑ v : (ZMod p)ˣ,
          ZMod.stdAddChar
            (A * L / ((u : ZMod p) * (v : ZMod p)) +
              a * (u : ZMod p) + b * (v : ZMod p)) := by
  intro F₁ F₂ b a
  have hL : L ≠ 0 := right_ne_zero_of_mul hAL
  have hb : b * L = k - h * B := div_mul_cancel₀ _ hL
  let e : ZMod p × ZMod p ≃ ZMod p × ZMod p :=
    (Equiv.prodCongrLeft fun d : ZMod p => Equiv.addRight (B * d + η₁)).trans
      (Equiv.prodCongrRight fun u : ZMod p =>
        (Equiv.mulLeft₀ L hL).trans (Equiv.addRight (u + η₂ - η₁)))
  have he (n d : ZMod p) : e (n, d) = (F₁ n d, F₂ n d) := by
    change (n + (B * d + η₁), L * d + (n + (B * d + η₁) + η₂ - η₁)) = _
    ext <;> dsimp only [F₁, F₂] <;> ring
  let f : ZMod p × ZMod p → ℂ := fun x =>
    if IsUnit (x.1 * x.2) then
      ZMod.stdAddChar (A * L / (x.1 * x.2) + a * x.1 + b * x.2)
    else 0
  have hphase (n d : ZMod p) :
      (if IsUnit (F₁ n d * F₂ n d) then
        ZMod.stdAddChar (A * L / (F₁ n d * F₂ n d) + h * n + k * d)
      else 0) = ZMod.stdAddChar (-(a * η₁ + b * η₂)) * f (e (n, d)) := by
    rw [he]
    dsimp only [f]
    split_ifs
    · rw [← AddChar.map_add_eq_mul]
      congr 1
      dsimp only [a, F₁, F₂]
      linear_combination -d * hb
    · rw [mul_zero]
  have hsum :
      (∑ u : (ZMod p)ˣ, ∑ v : (ZMod p)ˣ,
        ZMod.stdAddChar (A * L / ((u : ZMod p) * (v : ZMod p)) +
          a * (u : ZMod p) + b * (v : ZMod p))) = ∑ x : ZMod p × ZMod p, f x := by
    rw [← Finset.sum_product', Finset.univ_product_univ]
    refine Fintype.sum_of_injective
      (fun x : (ZMod p)ˣ × (ZMod p)ˣ => ((x.1 : ZMod p), (x.2 : ZMod p))) ?_ _ _ ?_ ?_
    · exact Units.val_injective.prodMap Units.val_injective
    · intro x hx
      have hunit : ¬ IsUnit (x.1 * x.2) := by
        intro hxunit
        obtain ⟨hu, hv⟩ := IsUnit.mul_iff.mp hxunit
        exact hx ⟨(Units.mk0 x.1 hu.ne_zero, Units.mk0 x.2 hv.ne_zero), rfl⟩
      exact ite_eq_right hunit
    · intro x
      exact (ite_eq_left (x.1.isUnit.mul x.2.isUnit)).symm
  calc
    _ = ZMod.stdAddChar (-(a * η₁ + b * η₂)) *
        ∑ n : ZMod p, ∑ d : ZMod p, f (e (n, d)) := by
      simp_rw [hphase, ← Finset.mul_sum]
    _ = ZMod.stdAddChar (-(a * η₁ + b * η₂)) * ∑ x : ZMod p × ZMod p, f x := by
      congr 1
      rw [← Finset.sum_product', Finset.univ_product_univ]
      exact e.sum_comp f
    _ = _ := by rw [← hsum]

theorem sum_torus_phase_eq_sum_rescaled
    (p : ℕ) [Fact p.Prime] (a b c : ZMod p)
    (ha : a ≠ 0) (hb : b ≠ 0) :
    (∑ u : (ZMod p)ˣ, ∑ v : (ZMod p)ˣ,
      ZMod.stdAddChar
        (c / ((u : ZMod p) * (v : ZMod p)) +
          a * (u : ZMod p) + b * (v : ZMod p))) =
      ∑ U : (ZMod p)ˣ, ∑ V : (ZMod p)ˣ,
        ZMod.stdAddChar
          ((U : ZMod p) + (V : ZMod p) +
            a * b * c / ((U : ZMod p) * (V : ZMod p))) := by
  let e : (ZMod p)ˣ × (ZMod p)ˣ ≃ (ZMod p)ˣ × (ZMod p)ˣ :=
    Equiv.prodCongr (Equiv.mulLeft (Units.mk0 a ha)) (Equiv.mulLeft (Units.mk0 b hb))
  let f : (ZMod p)ˣ × (ZMod p)ˣ → ℂ := fun x =>
    ZMod.stdAddChar ((x.1 : ZMod p) + (x.2 : ZMod p) +
      a * b * c / ((x.1 : ZMod p) * (x.2 : ZMod p)))
  have hphase (u v : (ZMod p)ˣ) :
      ZMod.stdAddChar (c / ((u : ZMod p) * (v : ZMod p)) +
        a * (u : ZMod p) + b * (v : ZMod p)) = f (e (u, v)) := by
    change ZMod.stdAddChar _ = ZMod.stdAddChar
      (a * (u : ZMod p) + b * (v : ZMod p) +
        a * b * c / ((a * (u : ZMod p)) * (b * (v : ZMod p))))
    congr 1
    field_simp [ha, hb, u.ne_zero, v.ne_zero]
    ring
  calc
    _ = ∑ u : (ZMod p)ˣ, ∑ v : (ZMod p)ˣ, f (e (u, v)) :=
      Finset.sum_congr rfl fun u _ => Finset.sum_congr rfl fun v _ => hphase u v
    _ = _ := by
      simpa only [← Finset.univ_product_univ, Finset.sum_product] using e.sum_comp f

theorem norm_sum_pole_masked_affine_phase_le_sq
    (m : ℕ) [NeZero m] (A B L η₁ η₂ h k : ZMod m) :
    let F₁ : ZMod m → ZMod m → ZMod m :=
      fun n d => n + B * d + η₁
    let F₂ : ZMod m → ZMod m → ZMod m :=
      fun n d => n + (B + L) * d + η₂
    ‖∑ n : ZMod m, ∑ d : ZMod m,
      if IsUnit (F₁ n d * F₂ n d) then
        ZMod.stdAddChar (A * L * (F₁ n d * F₂ n d)⁻¹ + h * n + k * d)
      else 0‖ ≤ (m : ℝ) ^ 2 := by
  intros
  rw [← Fintype.sum_prod_type']
  calc
    _ ≤ ∑ _ : ZMod m × ZMod m, (1 : ℝ) := by
      apply norm_sum_le_of_le
      intros
      split_ifs <;> simp
    _ = _ := by simp [pow_two]

theorem sum_torus_phase_of_zero_frequency
    (p : ℕ) [Fact p.Prime] (a b c : ZMod p) (hc : c ≠ 0)
    (hab : a = 0 ∨ b = 0) :
    (∑ u : (ZMod p)ˣ, ∑ v : (ZMod p)ˣ,
      ZMod.stdAddChar
        (c / ((u : ZMod p) * (v : ZMod p)) +
          a * (u : ZMod p) + b * (v : ZMod p))) =
      if a = 0 ∧ b = 0 then 1 - (p : ℂ) else 1 := by
  have hsum (t : ZMod p) :
      (∑ v : (ZMod p)ˣ, ZMod.stdAddChar (t * (v : ZMod p))) =
        if t = 0 then (p : ℂ) - 1 else -1 := by
    have hsplit := Fintype.sum_subtype_add_sum_subtype
      (fun x : ZMod p => x ≠ 0) (fun x => ZMod.stdAddChar (t * x))
    have heq := (unitsEquivNeZero (G₀ := ZMod p)).sum_comp
      fun v => ZMod.stdAddChar (t * (v : ZMod p))
    dsimp only [unitsEquivNeZero] at heq
    rw [← heq] at hsplit
    have hz :
        (∑ v : {x : ZMod p // ¬ x ≠ 0}, ZMod.stdAddChar (t * (v : ZMod p))) = 1 := by
      rw [Fintype.sum_eq_single (⟨0, by simp⟩ : {x : ZMod p // ¬ x ≠ 0})]
      · simp
      · intro v hv
        exact (hv (Subtype.ext (by simpa using v.property))).elim
    have hfull :
        (∑ x : ZMod p, ZMod.stdAddChar (t * x)) =
          if t = 0 then (p : ℂ) else 0 := by
      simpa [mul_comm, ZMod.card] using
        AddChar.sum_mulShift t (ZMod.isPrimitive_stdAddChar p)
    rw [hz, hfull] at hsplit
    simpa [ite_sub] using eq_sub_of_add_eq hsplit
  have hrec (v : (ZMod p)ˣ) :
      (∑ u : (ZMod p)ˣ,
        ZMod.stdAddChar (c / ((u : ZMod p) * (v : ZMod p)))) = -1 := by
    let e : (ZMod p)ˣ ≃ (ZMod p)ˣ :=
      (Equiv.mulRight v).trans (Equiv.divLeft (Units.mk0 c hc))
    calc
      _ = ∑ u : (ZMod p)ˣ, ZMod.stdAddChar (u : ZMod p) := by
        refine Fintype.sum_equiv e _ _ ?_
        intro u
        congr 1
        change c / ((u : ZMod p) * (v : ZMod p)) =
          ((Units.mk0 c hc / (u * v) : (ZMod p)ˣ) : ZMod p)
        simp only [Units.val_div_eq_div_val, Units.val_mk0, Units.val_mul]
      _ = -1 := by simpa using hsum (1 : ZMod p)
  have hleft (t : ZMod p) :
      (∑ u : (ZMod p)ˣ, ∑ v : (ZMod p)ˣ,
        ZMod.stdAddChar
          (c / ((u : ZMod p) * (v : ZMod p)) + t * (v : ZMod p))) =
        if t = 0 then 1 - (p : ℂ) else 1 := by
    calc
      _ = ∑ v : (ZMod p)ˣ, ZMod.stdAddChar (t * (v : ZMod p)) *
          ∑ u : (ZMod p)ˣ,
            ZMod.stdAddChar (c / ((u : ZMod p) * (v : ZMod p))) := by
        rw [Finset.sum_comm]
        apply Finset.sum_congr rfl
        intro v hv
        simp [AddChar.map_add_eq_mul, Finset.mul_sum, mul_comm]
      _ = -(∑ v : (ZMod p)ˣ, ZMod.stdAddChar (t * (v : ZMod p))) := by
        simp [hrec, Finset.sum_neg_distrib]
      _ = if t = 0 then 1 - (p : ℂ) else 1 := by
        simp only [hsum, neg_ite, neg_sub, neg_neg]
  rcases hab with ha | hb
  · subst a
    simpa using hleft b
  · subst b
    rw [Finset.sum_comm]
    simpa [mul_comm] using hleft a

/--
The complete sum of the standard additive character at `c / (u * v) + a * u + b * v` over pairs
of units modulo the prime `p`. No normalization factor is included.
-/
noncomputable def reciprocalProductCompleteSum (p : ℕ) [Fact p.Prime]
    (a b c : ZMod p) : ℂ :=
  ∑ u : (ZMod p)ˣ, ∑ v : (ZMod p)ˣ,
    ZMod.stdAddChar
      (c / ((u : ZMod p) * (v : ZMod p)) + a * (u : ZMod p) + b * (v : ZMod p))

open Classical in
/--
The standard additive character of `A * L / (F₁ * F₂)`, where `F₁ = n + B * d + η₁` and `F₂ = n
+ (B + L) * d + η₂`. The phase is extended by zero unless both affine factors are units modulo
`m`.
-/
noncomputable def affineReciprocalProductPhase (m : ℕ) [NeZero m]
    (A B L η₁ η₂ n d : ZMod m) : ℂ :=
  let F₁ : ZMod m := n + B * d + η₁
  let F₂ : ZMod m := n + (B + L) * d + η₂
  if IsUnit F₁ ∧ IsUnit F₂ then
    ZMod.stdAddChar (A * L * (F₁ * F₂)⁻¹)
  else 0

theorem sum_units_eq_sum_ite (p : ℕ) [Fact p.Prime] (f : ZMod p → ℂ) :
    (∑ u : (ZMod p)ˣ, f (u : ZMod p)) =
      ∑ x : ZMod p, if x ≠ 0 then f x else 0 := by
  classical
  calc
    (∑ u : (ZMod p)ˣ, f (u : ZMod p)) =
        ∑ x : {x : ZMod p // x ≠ 0}, f x :=
      Fintype.sum_equiv unitsEquivNeZero _ _ (fun _ => rfl)
    _ = ∑ x ∈ Finset.univ.filter (fun x : ZMod p => x ≠ 0), f x :=
      (Finset.sum_subtype _ (by simp) f).symm
    _ = ∑ x : ZMod p, if x ≠ 0 then f x else 0 := by
      rw [Finset.sum_filter]

theorem sum_units_eq_sum_sub_zero (p : ℕ) [Fact p.Prime]
    (f : ZMod p → ℂ) :
    (∑ u : (ZMod p)ˣ, f (u : ZMod p)) = (∑ x : ZMod p, f x) - f 0 := by
  classical
  rw [sum_units_eq_sum_ite, ← Finset.sum_filter, Finset.filter_ne']
  exact Finset.sum_erase_eq_sub (Finset.mem_univ (0 : ZMod p))

theorem stdAddChar_sum (p : ℕ) [Fact p.Prime] (t : ZMod p) :
    (∑ x : ZMod p, ZMod.stdAddChar (t * x)) = if t = 0 then (p : ℂ) else 0 := by
  simpa [mul_comm] using
    (AddChar.sum_mulShift (ψ := ZMod.stdAddChar) t (ZMod.isPrimitive_stdAddChar p))

theorem stdAddChar_sum_units (p : ℕ) [Fact p.Prime] (t : ZMod p) :
    (∑ u : (ZMod p)ˣ, ZMod.stdAddChar (t * (u : ZMod p))) =
      if t = 0 then (p : ℂ) - 1 else -1 := by
  classical
  rw [sum_units_eq_sum_sub_zero p (fun x : ZMod p => ZMod.stdAddChar (t * x))]
  simp only [mul_zero, map_zero_eq_one]
  rw [stdAddChar_sum]
  by_cases ht : t = 0 <;> simp [ht]

theorem stdAddChar_sum_units_div (p : ℕ) [Fact p.Prime] (t : ZMod p) :
    (∑ u : (ZMod p)ˣ, ZMod.stdAddChar (t / (u : ZMod p))) =
      if t = 0 then (p : ℂ) - 1 else -1 := by
  classical
  rw [← stdAddChar_sum_units p t]
  refine Fintype.sum_equiv (Equiv.inv ((ZMod p)ˣ))
    (fun u : (ZMod p)ˣ => ZMod.stdAddChar (t / (u : ZMod p)))
    (fun u : (ZMod p)ˣ => ZMod.stdAddChar (t * (u : ZMod p))) ?_
  intro u
  change ZMod.stdAddChar (t / (u : ZMod p)) =
    ZMod.stdAddChar (t * ((u⁻¹ : (ZMod p)ˣ) : ZMod p))
  rw [Units.val_inv_eq_inv_val, div_eq_mul_inv]

theorem normalizedKloosterman3_eq_doubleUnitSum
    (p : ℕ) [Fact p.Prime] (c : ZMod p) :
    normalizedKloosterman3 p c =
      (p : ℂ)⁻¹ * reciprocalProductCompleteSum p 1 1 c := by
  classical
  have hinner (u v : ZMod p) :
      (∑ w : ZMod p,
        if u * v * w = c then ZMod.stdAddChar (u + v + w) else 0) =
        if u ≠ 0 ∧ v ≠ 0 then ZMod.stdAddChar (u + v + c / (u * v)) else 0 := by
    by_cases huv : u * v = 0
    · have hmask : ¬(u ≠ 0 ∧ v ≠ 0) := by
        rintro ⟨hu, hv⟩
        exact mul_ne_zero hu hv huv
      rw [ite_eq_right hmask]
      by_cases hc : c = 0
      · subst c
        simp only [huv, zero_mul, ite_true]
        have hs : (∑ w : ZMod p, ZMod.stdAddChar w) = 0 := by
          simpa using stdAddChar_sum p 1
        calc
          (∑ w : ZMod p, ZMod.stdAddChar (u + v + w)) =
              ZMod.stdAddChar (u + v) * ∑ w : ZMod p, ZMod.stdAddChar w := by
            simp_rw [map_add_eq_mul]
            rw [Finset.mul_sum]
          _ = 0 := by rw [hs, mul_zero]
      · simp [huv, Ne.symm hc]
    · have hu : u ≠ 0 := left_ne_zero_of_mul huv
      have hv : v ≠ 0 := right_ne_zero_of_mul huv
      have hcond (w : ZMod p) : u * v * w = c ↔ w = c / (u * v) := by
        constructor
        · intro hw
          exact (eq_div_iff huv).mpr (by simpa [mul_comm] using hw)
        · intro hw
          simpa [mul_comm] using (eq_div_iff huv).mp hw
      simp [hcond, hu, hv]
  unfold normalizedKloosterman3 reciprocalProductCompleteSum
  congr 1
  calc
    (∑ u : ZMod p, ∑ v : ZMod p, ∑ w : ZMod p,
        if u * v * w = c then ZMod.stdAddChar (u + v + w) else 0) =
        ∑ u : ZMod p, ∑ v : ZMod p,
          if u ≠ 0 ∧ v ≠ 0 then ZMod.stdAddChar (u + v + c / (u * v)) else 0 := by
      simp_rw [hinner]
    _ = ∑ u : (ZMod p)ˣ, ∑ v : (ZMod p)ˣ,
          ZMod.stdAddChar
            (c / ((u : ZMod p) * (v : ZMod p)) + 1 * (u : ZMod p) +
              1 * (v : ZMod p)) := by
      rw [sum_units_eq_sum_ite p (fun u : ZMod p =>
        ∑ v : (ZMod p)ˣ,
          ZMod.stdAddChar (c / (u * (v : ZMod p)) + 1 * u + 1 * (v : ZMod p)))]
      apply Finset.sum_congr rfl
      intro u _
      by_cases hu : u = 0
      · simp [hu]
      · rw [ite_eq_left hu, sum_units_eq_sum_ite p (fun v : ZMod p =>
          ZMod.stdAddChar (c / (u * v) + 1 * u + 1 * v))]
        apply Finset.sum_congr rfl
        intro v _
        by_cases hv : v = 0
        · simp [hv]
        · rw [ite_eq_left ⟨hu, hv⟩, ite_eq_left hv]
          simp only [one_mul]
          congr 1
          ring

theorem normalizedKloosterman3_zero
    (p : ℕ) [Fact p.Prime] :
    normalizedKloosterman3 p 0 = (p : ℂ)⁻¹ := by
  classical
  rw [normalizedKloosterman3_eq_doubleUnitSum, reciprocalProductCompleteSum]
  simp only [zero_div, zero_add, one_mul]
  simp_rw [map_add_eq_mul]
  have h : (∑ u : (ZMod p)ˣ, ZMod.stdAddChar (u : ZMod p)) = -1 := by
    simpa using stdAddChar_sum_units p 1
  rw [← Finset.sum_mul_sum, h]
  ring

open Classical in
theorem reciprocalProductCompleteSum_classification
    (p : ℕ) [Fact p.Prime] (a b c : ZMod p) :
    reciprocalProductCompleteSum p a b c =
      if c = 0 then
        (if a = 0 then (p : ℂ) - 1 else -1) *
          (if b = 0 then (p : ℂ) - 1 else -1)
      else if a = 0 then
        if b = 0 then 1 - (p : ℂ) else 1
      else if b = 0 then 1
      else (p : ℂ) * normalizedKloosterman3 p (c * a * b) := by
  by_cases hc : c = 0
  · subst c
    simp only [ite_true, reciprocalProductCompleteSum, zero_div, zero_add]
    simp_rw [map_add_eq_mul]
    rw [← Finset.sum_mul_sum, stdAddChar_sum_units, stdAddChar_sum_units]
  · rw [ite_eq_right hc]
    have hleft (b : ZMod p) : reciprocalProductCompleteSum p 0 b c =
        -(if b = 0 then (p : ℂ) - 1 else -1) := by
      unfold reciprocalProductCompleteSum
      rw [Finset.sum_comm]
      have hinner (v : (ZMod p)ˣ) :
          (∑ u : (ZMod p)ˣ,
            ZMod.stdAddChar
              (c / ((u : ZMod p) * (v : ZMod p)) +
                0 * (u : ZMod p) + b * (v : ZMod p))) =
            -ZMod.stdAddChar (b * (v : ZMod p)) := by
        have hcv : c / (v : ZMod p) ≠ 0 := div_ne_zero hc v.ne_zero
        calc
          (∑ u : (ZMod p)ˣ,
              ZMod.stdAddChar
                (c / ((u : ZMod p) * (v : ZMod p)) +
                  0 * (u : ZMod p) + b * (v : ZMod p))) =
              (∑ u : (ZMod p)ˣ, ZMod.stdAddChar ((c / (v : ZMod p)) /
                (u : ZMod p))) * ZMod.stdAddChar (b * (v : ZMod p)) := by
            rw [Finset.sum_mul]
            apply Finset.sum_congr rfl
            intro u _
            rw [← map_add_eq_mul]
            congr 1
            field_simp [u.ne_zero, v.ne_zero]
            ring
          _ = -ZMod.stdAddChar (b * (v : ZMod p)) := by
            rw [stdAddChar_sum_units_div, ite_eq_right hcv]
            ring
      simp_rw [hinner]
      rw [Finset.sum_neg_distrib, stdAddChar_sum_units]
    have hsym : reciprocalProductCompleteSum p a b c =
        reciprocalProductCompleteSum p b a c := by
      unfold reciprocalProductCompleteSum
      rw [Finset.sum_comm]
      apply Finset.sum_congr rfl
      intro v _
      apply Finset.sum_congr rfl
      intro u _
      congr 1
      simp only [mul_comm (u : ZMod p) (v : ZMod p)]
      ring
    by_cases ha : a = 0
    · subst a
      rw [ite_eq_left rfl, hleft]
      by_cases hb : b = 0 <;> simp [hb]
    · rw [ite_eq_right ha]
      by_cases hb : b = 0
      · subst b
        rw [ite_eq_left rfl, hsym, hleft]
        simp [ha]
      · rw [ite_eq_right hb]
        have hp0 : (p : ℂ) ≠ 0 := by
          exact_mod_cast (Fact.out : p.Prime).ne_zero
        calc
          reciprocalProductCompleteSum p a b c =
              reciprocalProductCompleteSum p 1 1 (c * a * b) := by
            unfold reciprocalProductCompleteSum
            refine Fintype.sum_equiv (Equiv.mulLeft (Units.mk0 a ha)) _ _ ?_
            intro u
            refine Fintype.sum_equiv (Equiv.mulLeft (Units.mk0 b hb)) _ _ ?_
            intro v
            simp only [Equiv.coe_mulLeft, Units.val_mul, Units.val_mk0, one_mul]
            congr 1
            field_simp [ha, hb, u.ne_zero, v.ne_zero]
          _ = (p : ℂ) * normalizedKloosterman3 p (c * a * b) := by
            rw [normalizedKloosterman3_eq_doubleUnitSum]
            rw [← mul_assoc, mul_inv_cancel₀ hp0, one_mul]

open Classical in
theorem normalizedKloosterman3_unit_fourier
    (p : ℕ) [Fact p.Prime] (h : ZMod p) :
    (∑ c : (ZMod p)ˣ,
      normalizedKloosterman3 p (c : ZMod p) *
        ZMod.stdAddChar (h * (c : ZMod p))) =
      if h = 0 then -((p : ℂ)⁻¹)
      else unnormalizedKloosterman2 p (-(h⁻¹)) - (p : ℂ)⁻¹ := by
  have hp0 : (p : ℂ) ≠ 0 := by
    exact_mod_cast (Fact.out : p.Prime).ne_zero
  have heval (c : ZMod p) :
      normalizedKloosterman3 p c * ZMod.stdAddChar (h * c) =
        (p : ℂ)⁻¹ * ∑ u : (ZMod p)ˣ, ∑ v : (ZMod p)ˣ,
          ZMod.stdAddChar ((u : ZMod p) + (v : ZMod p)) *
            ZMod.stdAddChar
              ((((u : ZMod p) * (v : ZMod p))⁻¹ + h) * c) := by
    rw [normalizedKloosterman3_eq_doubleUnitSum, reciprocalProductCompleteSum]
    rw [mul_assoc]
    congr 1
    rw [Finset.sum_mul]
    apply Finset.sum_congr rfl
    intro u _
    rw [Finset.sum_mul]
    apply Finset.sum_congr rfl
    intro v _
    rw [← map_add_eq_mul, ← map_add_eq_mul]
    congr 1
    simp only [one_mul, div_eq_mul_inv]
    ring
  have hfull :
      (∑ c : ZMod p, normalizedKloosterman3 p c * ZMod.stdAddChar (h * c)) =
        ∑ u : (ZMod p)ˣ, ∑ v : (ZMod p)ˣ,
          if ((u : ZMod p) * (v : ZMod p))⁻¹ + h = 0 then
            ZMod.stdAddChar ((u : ZMod p) + (v : ZMod p)) else 0 := by
    simp_rw [heval]
    rw [← Finset.mul_sum, ← Finset.sum_comm_cycle]
    simp_rw [← Finset.mul_sum, stdAddChar_sum]
    simp_rw [Finset.mul_sum]
    refine Finset.sum_congr rfl fun u _ => Finset.sum_congr rfl fun v _ => ?_
    split_ifs <;> simp [hp0, mul_comm]
  rw [sum_units_eq_sum_sub_zero p (fun c : ZMod p =>
    normalizedKloosterman3 p c * ZMod.stdAddChar (h * c))]
  rw [normalizedKloosterman3_zero]
  simp only [mul_zero, map_zero_eq_one, mul_one]
  rw [hfull]
  by_cases hh : h = 0
  · subst h
    simp only [ite_true, add_zero, inv_eq_zero, mul_eq_zero, Units.ne_zero,
      or_self, ite_false, Finset.sum_const_zero, zero_sub]
  · rw [ite_eq_right hh]
    congr 1
    unfold unnormalizedKloosterman2
    apply Finset.sum_congr rfl
    intro u _
    let v₀ : (ZMod p)ˣ := Units.mk0 (-(h⁻¹) / (u : ZMod p))
      (div_ne_zero (neg_ne_zero.mpr (inv_ne_zero hh)) u.ne_zero)
    have hcond (v : (ZMod p)ˣ) :
        ((u : ZMod p) * (v : ZMod p))⁻¹ + h = 0 ↔ v = v₀ := by
      rw [add_eq_zero_iff_eq_neg, inv_eq_iff_eq_inv, inv_neg, ← Units.val_inj]
      change (u : ZMod p) * (v : ZMod p) = -(h⁻¹) ↔
        (v : ZMod p) = -(h⁻¹) / (u : ZMod p)
      rw [eq_div_iff u.ne_zero, mul_comm]
    simp only [hcond, Finset.sum_ite_eq', Finset.mem_univ, ite_true]
    rfl

open Classical in
theorem normalizedKloosterman3_unit_dft
    (p : ℕ) [Fact p.Prime] (ξ : ZMod p) :
    ZMod.dft (fun c : ZMod p =>
      if IsUnit c then normalizedKloosterman3 p c else 0) ξ =
      if ξ = 0 then -((p : ℂ)⁻¹)
      else unnormalizedKloosterman2 p (ξ⁻¹) - (p : ℂ)⁻¹ := by
  simp only [ZMod.dft_apply, smul_eq_mul]
  have hs :
      (∑ c : ZMod p, ZMod.stdAddChar (-(c * ξ)) *
        (if IsUnit c then normalizedKloosterman3 p c else 0)) =
        ∑ c : (ZMod p)ˣ, normalizedKloosterman3 p (c : ZMod p) *
          ZMod.stdAddChar ((-ξ) * (c : ZMod p)) := by
    rw [sum_units_eq_sum_ite p (fun c : ZMod p =>
      normalizedKloosterman3 p c * ZMod.stdAddChar ((-ξ) * c))]
    apply Finset.sum_congr rfl
    intro c _
    by_cases hc : c = 0
    · simp [hc]
    · rw [ite_eq_left (isUnit_iff_ne_zero.mpr hc), ite_eq_left hc]
      rw [mul_comm]
      congr 1
      congr 1
      ring
  rw [hs, normalizedKloosterman3_unit_fourier]
  by_cases hξ : ξ = 0 <;> simp [hξ]

theorem affineReciprocalProductPhase_complete_fourier
    (p : ℕ) [Fact p.Prime] (A B L η₁ η₂ h k : ZMod p) (hL : L ≠ 0) :
    (∑ n : ZMod p, ∑ d : ZMod p,
      affineReciprocalProductPhase p A B L η₁ η₂ n d *
        ZMod.stdAddChar (h * n + k * d)) =
      let b : ZMod p := (k - h * B) / L
      ZMod.stdAddChar (b * (η₁ - η₂) - h * η₁) *
        reciprocalProductCompleteSum p (h - b) b (A * L) := by
  classical
  let b : ZMod p := (k - h * B) / L
  let K : ZMod p → ZMod p → ℂ := fun u v =>
    ZMod.stdAddChar (A * L / (u * v) + (h - b) * u + b * v)
  let e : ZMod p × ZMod p ≃ ZMod p × ZMod p :=
    { toFun := fun z =>
        (z.1 + B * z.2 + η₁, z.1 + (B + L) * z.2 + η₂)
      invFun := fun z =>
        (z.1 - B * ((z.2 - z.1 + η₁ - η₂) / L) - η₁,
          (z.2 - z.1 + η₁ - η₂) / L)
      left_inv := by
        rintro ⟨n, d⟩
        apply Prod.ext <;> dsimp <;> field_simp [hL] <;> ring
      right_inv := by
        rintro ⟨u, v⟩
        apply Prod.ext <;> dsimp <;> field_simp [hL] <;> ring }
  have hphase (n d : ZMod p) :
      h * n + k * d =
        (h - b) * (n + B * d + η₁) +
          b * (n + (B + L) * d + η₂) +
            (b * (η₁ - η₂) - h * η₁) := by
    dsimp [b]
    field_simp [hL]
    ring
  have hpoint (n d : ZMod p) :
      affineReciprocalProductPhase p A B L η₁ η₂ n d *
          ZMod.stdAddChar (h * n + k * d) =
        ZMod.stdAddChar (b * (η₁ - η₂) - h * η₁) *
          (if (e (n, d)).1 ≠ 0 ∧ (e (n, d)).2 ≠ 0 then
            K (e (n, d)).1 (e (n, d)).2 else 0) := by
    change
      (if IsUnit (n + B * d + η₁) ∧ IsUnit (n + (B + L) * d + η₂) then
        ZMod.stdAddChar
          (A * L / ((n + B * d + η₁) * (n + (B + L) * d + η₂))) else 0) *
        ZMod.stdAddChar (h * n + k * d) =
      ZMod.stdAddChar (b * (η₁ - η₂) - h * η₁) *
        (if n + B * d + η₁ ≠ 0 ∧ n + (B + L) * d + η₂ ≠ 0 then
          ZMod.stdAddChar
            (A * L / ((n + B * d + η₁) * (n + (B + L) * d + η₂)) +
              (h - b) * (n + B * d + η₁) +
                b * (n + (B + L) * d + η₂)) else 0)
    simp only [isUnit_iff_ne_zero]
    by_cases hu : n + B * d + η₁ ≠ 0 ∧ n + (B + L) * d + η₂ ≠ 0
    · rw [ite_eq_left hu, ite_eq_left hu, hphase n d]
      rw [← map_add_eq_mul, ← map_add_eq_mul]
      congr 1
      ring
    · rw [ite_eq_right hu, ite_eq_right hu]
      simp
  have hmask :
      (∑ u : ZMod p, ∑ v : ZMod p, if u ≠ 0 ∧ v ≠ 0 then K u v else 0) =
        reciprocalProductCompleteSum p (h - b) b (A * L) := by
    change
      (∑ u : ZMod p, ∑ v : ZMod p, if u ≠ 0 ∧ v ≠ 0 then K u v else 0) =
        ∑ u : (ZMod p)ˣ, ∑ v : (ZMod p)ˣ, K (u : ZMod p) (v : ZMod p)
    rw [sum_units_eq_sum_ite p (fun u => ∑ v : (ZMod p)ˣ, K u (v : ZMod p))]
    apply Finset.sum_congr rfl
    intro u _
    by_cases hu : u ≠ 0
    · simpa [hu] using (sum_units_eq_sum_ite p (fun v => K u v)).symm
    · simp [hu]
  calc
    (∑ n : ZMod p, ∑ d : ZMod p,
        affineReciprocalProductPhase p A B L η₁ η₂ n d *
          ZMod.stdAddChar (h * n + k * d)) =
        ∑ z : ZMod p × ZMod p,
          ZMod.stdAddChar (b * (η₁ - η₂) - h * η₁) *
            (if (e z).1 ≠ 0 ∧ (e z).2 ≠ 0 then K (e z).1 (e z).2 else 0) := by
      rw [Fintype.sum_prod_type]
      apply Finset.sum_congr rfl
      intro n _
      apply Finset.sum_congr rfl
      intro d _
      exact hpoint n d
    _ = ∑ z : ZMod p × ZMod p,
          ZMod.stdAddChar (b * (η₁ - η₂) - h * η₁) *
            (if z.1 ≠ 0 ∧ z.2 ≠ 0 then K z.1 z.2 else 0) :=
      e.sum_comp (fun z : ZMod p × ZMod p =>
        (ZMod.stdAddChar (b * (η₁ - η₂) - h * η₁) *
          (if z.1 ≠ 0 ∧ z.2 ≠ 0 then K z.1 z.2 else 0) : ℂ))
    _ = ZMod.stdAddChar (b * (η₁ - η₂) - h * η₁) *
          ∑ u : ZMod p, ∑ v : ZMod p, if u ≠ 0 ∧ v ≠ 0 then K u v else 0 := by
      simp only [Fintype.sum_prod_type, Finset.mul_sum]
    _ = ZMod.stdAddChar (b * (η₁ - η₂) - h * η₁) *
          reciprocalProductCompleteSum p (h - b) b (A * L) := by
      rw [hmask]

theorem star_stdAddChar (p : ℕ) [Fact p.Prime] (x : ZMod p) :
    star (ZMod.stdAddChar x) = ZMod.stdAddChar (-x) := by
  simpa only [Complex.star_def] using
    (AddChar.map_neg_eq_conj ZMod.stdAddChar x).symm

theorem dft_pairing_twist (p : ℕ) [Fact p.Prime]
    (f g : ZMod p → ℂ) (c : ZMod p) :
    (∑ x : ZMod p, f x * star (g x) * ZMod.stdAddChar (c * x)) =
      (p : ℂ)⁻¹ * ∑ ξ : ZMod p, ZMod.dft f ξ * star (ZMod.dft g (ξ + c)) := by
  classical
  have hp : (p : ℂ) ≠ 0 := by exact_mod_cast (Fact.out : p.Prime).ne_zero
  have hsum :
      (∑ ξ : ZMod p, ZMod.dft f ξ * star (ZMod.dft g (ξ + c))) =
        (p : ℂ) * ∑ x : ZMod p, f x * star (g x) * ZMod.stdAddChar (c * x) := by
    simp only [ZMod.dft_apply, smul_eq_mul, star_sum, star_mul, star_stdAddChar,
      neg_neg]
    simp_rw [Finset.sum_mul, Finset.mul_sum]
    rw [Finset.sum_comm]
    apply Finset.sum_congr rfl
    intro x _
    rw [Finset.sum_comm]
    have hterm (y ξ : ZMod p) :
        (ZMod.stdAddChar (-(x * ξ)) * f x) *
            (star (g y) * ZMod.stdAddChar (y * (ξ + c))) =
          (f x * star (g y) * ZMod.stdAddChar (c * y)) *
            ZMod.stdAddChar ((y - x) * ξ) := by
      rw [show y * (ξ + c) = c * y + y * ξ by ring, map_add_eq_mul]
      rw [show -(x * ξ) = (-x) * ξ by ring]
      rw [show (y - x) * ξ = (-x) * ξ + y * ξ by ring, map_add_eq_mul]
      ring
    simp_rw [hterm, ← Finset.mul_sum, stdAddChar_sum]
    simp only [sub_eq_zero, mul_ite, mul_zero]
    simp
    ring
  rw [hsum, ← mul_assoc, inv_mul_cancel₀ hp, one_mul]

theorem unnormalizedKloosterman2_zero (p : ℕ) [Fact p.Prime] :
    unnormalizedKloosterman2 p 0 = -1 := by
  simpa [unnormalizedKloosterman2] using stdAddChar_sum_units p 1

theorem unnormalizedKloosterman2_star (p : ℕ) [Fact p.Prime]
    (a : ZMod p) :
    star (unnormalizedKloosterman2 p a) = unnormalizedKloosterman2 p a := by
  classical
  unfold unnormalizedKloosterman2
  rw [star_sum]
  refine Fintype.sum_equiv (Equiv.mulLeft (-1 : (ZMod p)ˣ)) _ _ ?_
  intro u
  simp only [star_stdAddChar, Equiv.coe_mulLeft, Units.val_neg,
    neg_one_mul, div_neg]
  congr 1
  ring

theorem unnormalizedKloosterman2_scaled_dft
    (p : ℕ) [Fact p.Prime] (a ξ : ZMod p) (ha : a ≠ 0) :
    ZMod.dft (fun x : ZMod p => unnormalizedKloosterman2 p (a * x)) ξ =
      if ξ = 0 then 0 else (p : ℂ) * ZMod.stdAddChar (a / ξ) := by
  classical
  have hexpand :
      ZMod.dft (fun x : ZMod p => unnormalizedKloosterman2 p (a * x)) ξ =
        ∑ u : (ZMod p)ˣ,
          ZMod.stdAddChar (u : ZMod p) *
            ∑ x : ZMod p, ZMod.stdAddChar ((a / (u : ZMod p) - ξ) * x) := by
    simp only [ZMod.dft_apply, smul_eq_mul, unnormalizedKloosterman2, Finset.mul_sum]
    rw [Finset.sum_comm]
    apply Finset.sum_congr rfl
    intro u _
    apply Finset.sum_congr rfl
    intro x _
    rw [← map_add_eq_mul, ← map_add_eq_mul]
    congr 1
    field_simp [u.ne_zero]
    ring
  rw [hexpand]
  simp_rw [stdAddChar_sum]
  by_cases hξ : ξ = 0
  · subst ξ
    have hne (u : (ZMod p)ˣ) : a / (u : ZMod p) ≠ 0 := div_ne_zero ha u.ne_zero
    simp [hne]
  · rw [ite_eq_right hξ]
    let u₀ : (ZMod p)ˣ := Units.mk0 (a / ξ) (div_ne_zero ha hξ)
    have hcond (u : (ZMod p)ˣ) :
        a / (u : ZMod p) - ξ = 0 ↔ u = u₀ := by
      constructor
      · intro h
        apply Units.ext
        change (u : ZMod p) = a / ξ
        apply (eq_div_iff hξ).2
        have h' := (div_eq_iff u.ne_zero).mp (sub_eq_zero.mp h)
        simpa only [mul_comm] using h'.symm
      · rintro rfl
        dsimp [u₀]
        field_simp [ha, hξ]
        ring
    simp only [hcond, mul_ite, mul_zero, Finset.sum_ite_eq', Finset.mem_univ,
      ite_true]
    change ZMod.stdAddChar (a / ξ) * (p : ℂ) = _
    ring

theorem normalizedKloosterman3_dft
    (p : ℕ) [Fact p.Prime] (ξ : ZMod p) :
    ZMod.dft (normalizedKloosterman3 p) ξ =
      if ξ = 0 then 0 else unnormalizedKloosterman2 p (ξ⁻¹) := by
  classical
  have hsum := sum_units_eq_sum_sub_zero p
    (fun x : ZMod p => normalizedKloosterman3 p x * ZMod.stdAddChar ((-ξ) * x))
  have hfull :
      ZMod.dft (normalizedKloosterman3 p) ξ =
        (∑ x : (ZMod p)ˣ, normalizedKloosterman3 p (x : ZMod p) *
          ZMod.stdAddChar ((-ξ) * (x : ZMod p))) + (p : ℂ)⁻¹ := by
    simp only [normalizedKloosterman3_zero, mul_zero, map_zero_eq_one, mul_one] at hsum
    rw [eq_sub_iff_add_eq] at hsum
    rw [hsum]
    simp only [ZMod.dft_apply, smul_eq_mul]
    apply Finset.sum_congr rfl
    intro x _
    rw [mul_comm]
    congr 1
    congr 1
    ring
  rw [hfull, normalizedKloosterman3_unit_fourier]
  by_cases hξ : ξ = 0 <;> simp [hξ]

theorem normalizedKloosterman3_scaled_dft
    (p : ℕ) [Fact p.Prime] (a ξ : ZMod p) (ha : a ≠ 0) :
    ZMod.dft (fun x : ZMod p => normalizedKloosterman3 p (a * x)) ξ =
      if ξ = 0 then 0 else unnormalizedKloosterman2 p (a / ξ) := by
  classical
  have hu := ZMod.dft_comp_unitMul (normalizedKloosterman3 p) (Units.mk0 a ha) ξ
  change ZMod.dft (fun x : ZMod p => normalizedKloosterman3 p (a * x)) ξ =
    ZMod.dft (normalizedKloosterman3 p) (a⁻¹ * ξ) at hu
  rw [hu, normalizedKloosterman3_dft]
  by_cases hξ : ξ = 0
  · simp [hξ]
  · rw [ite_eq_right (mul_ne_zero (inv_ne_zero ha) hξ), ite_eq_right hξ]
    congr 1
    field_simp [ha, hξ]

theorem sum_units_char_div (p : ℕ) [Fact p.Prime] (a : ZMod p) :
    (∑ u : (ZMod p)ˣ, ZMod.stdAddChar (a / (u : ZMod p))) =
      if a = 0 then (p : ℂ) - 1 else -1 :=
  stdAddChar_sum_units_div p a

theorem unnormalizedKloosterman2_unit_correlation
    (p : ℕ) [Fact p.Prime] (a b : ZMod p) (ha : a ≠ 0) (hb : b ≠ 0) :
    (∑ x : (ZMod p)ˣ,
      unnormalizedKloosterman2 p (a * (x : ZMod p)) *
        star (unnormalizedKloosterman2 p (b * (x : ZMod p)))) =
      (if a = b then (p : ℂ) ^ 2 else 0) - (p : ℂ) - 1 := by
  classical
  have hp : (p : ℂ) ≠ 0 := by exact_mod_cast (Fact.out : p.Prime).ne_zero
  have h := dft_pairing_twist p
    (fun x => unnormalizedKloosterman2 p (a * x))
    (fun x => unnormalizedKloosterman2 p (b * x)) 0
  simp only [zero_mul, map_zero_eq_one, mul_one, add_zero] at h
  simp_rw [unnormalizedKloosterman2_scaled_dft p a _ ha,
    unnormalizedKloosterman2_scaled_dft p b _ hb] at h
  have hs :
      (∑ ξ : ZMod p, (if ξ = 0 then 0 else (p : ℂ) * ZMod.stdAddChar (a / ξ)) *
        star (if ξ = 0 then 0 else (p : ℂ) * ZMod.stdAddChar (b / ξ))) =
        (p : ℂ) ^ 2 *
          (∑ u : (ZMod p)ˣ, ZMod.stdAddChar ((a - b) / (u : ZMod p))) := by
    rw [sum_units_eq_sum_ite p (fun ξ : ZMod p =>
      ZMod.stdAddChar ((a - b) / ξ)), Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro ξ _
    by_cases hξ : ξ = 0
    · simp [hξ]
    · simp only [ite_eq_right hξ, ite_eq_left hξ, star_mul, star_natCast,
        star_stdAddChar]
      have hchar : ZMod.stdAddChar (a / ξ) * ZMod.stdAddChar (-(b / ξ)) =
          ZMod.stdAddChar ((a - b) / ξ) := by
        rw [← map_add_eq_mul]
        congr 1
        ring
      calc
        _ = (p : ℂ) ^ 2 *
            (ZMod.stdAddChar (a / ξ) * ZMod.stdAddChar (-(b / ξ))) := by ring
        _ = _ := by rw [hchar]
  rw [hs, sum_units_char_div] at h
  rw [sum_units_eq_sum_sub_zero p (fun x : ZMod p =>
    unnormalizedKloosterman2 p (a * x) * star (unnormalizedKloosterman2 p (b * x)))]
  simp only [mul_zero, unnormalizedKloosterman2_zero, star_neg, star_one,
    neg_mul_neg, one_mul]
  rw [h]
  by_cases hab : a = b
  · simp [hab]
    field_simp
  · rw [ite_eq_right hab, ite_eq_right (sub_ne_zero.mpr hab)]
    field_simp
    ring

theorem inverse_frequency_correlation (p : ℕ) [Fact p.Prime]
    (f g : ZMod p → ℂ) :
    (∑ ξ : ZMod p, (if ξ = 0 then 0 else f ξ⁻¹) *
      star (if ξ = 0 then 0 else g ξ⁻¹)) =
      ∑ u : (ZMod p)ˣ, f (u : ZMod p) * star (g (u : ZMod p)) := by
  classical
  calc
    _ = ∑ u : (ZMod p)ˣ, f ((u : ZMod p)⁻¹) * star (g ((u : ZMod p)⁻¹)) := by
      rw [sum_units_eq_sum_ite p (fun ξ : ZMod p => f ξ⁻¹ * star (g ξ⁻¹))]
      apply Finset.sum_congr rfl
      intro ξ _
      by_cases hξ : ξ = 0 <;> simp [hξ]
    _ = _ := Fintype.sum_equiv (Equiv.inv ((ZMod p)ˣ)) _ _ (by
      intro u
      change f ((u : ZMod p)⁻¹) * star (g ((u : ZMod p)⁻¹)) =
        f ((u⁻¹ : (ZMod p)ˣ) : ZMod p) * star (g ((u⁻¹ : (ZMod p)ˣ) : ZMod p))
      rw [Units.val_inv_eq_inv_val])

theorem normalizedKloosterman3_unit_correlation_zero
    (p : ℕ) [Fact p.Prime] (a b : ZMod p) (ha : a ≠ 0) (hb : b ≠ 0) :
    (∑ x : (ZMod p)ˣ,
      normalizedKloosterman3 p (a * (x : ZMod p)) *
        star (normalizedKloosterman3 p (b * (x : ZMod p)))) =
      (if a = b then (p : ℂ) else 0) - 1 - (p : ℂ)⁻¹ - ((p : ℂ)⁻¹) ^ 2 := by
  classical
  have hp : (p : ℂ) ≠ 0 := by exact_mod_cast (Fact.out : p.Prime).ne_zero
  have h := dft_pairing_twist p
    (fun x => normalizedKloosterman3 p (a * x))
    (fun x => normalizedKloosterman3 p (b * x)) 0
  simp only [zero_mul, map_zero_eq_one, mul_one, add_zero] at h
  simp_rw [normalizedKloosterman3_scaled_dft p a _ ha,
    normalizedKloosterman3_scaled_dft p b _ hb, div_eq_mul_inv] at h
  rw [inverse_frequency_correlation p
    (fun x => unnormalizedKloosterman2 p (a * x))
    (fun x => unnormalizedKloosterman2 p (b * x))] at h
  rw [unnormalizedKloosterman2_unit_correlation p a b ha hb] at h
  rw [sum_units_eq_sum_sub_zero p (fun x : ZMod p =>
    normalizedKloosterman3 p (a * x) * star (normalizedKloosterman3 p (b * x)))]
  simp only [mul_zero, normalizedKloosterman3_zero, star_inv₀, star_natCast]
  rw [h]
  by_cases hab : a = b <;> simp only [hab, ite_true, ite_false]
  all_goals field_simp
  all_goals ring

theorem normalizedKloosterman3_unit_correlation_nonzero
    (p : ℕ) [Fact p.Prime] (a b c : ZMod p)
    (ha : a ≠ 0) (hb : b ≠ 0) (hc : c ≠ 0) :
    (∑ x : (ZMod p)ˣ,
      normalizedKloosterman3 p (a * (x : ZMod p)) *
        star (normalizedKloosterman3 p (b * (x : ZMod p))) *
          ZMod.stdAddChar (c * (x : ZMod p))) =
      (p : ℂ)⁻¹ *
        (∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
          unnormalizedKloosterman2 p (a / (c * t)) *
            unnormalizedKloosterman2 p (b / (c * (t + 1))) else 0) -
        ((p : ℂ)⁻¹) ^ 2 := by
  classical
  have h := dft_pairing_twist p
    (fun x => normalizedKloosterman3 p (a * x))
    (fun x => normalizedKloosterman3 p (b * x)) c
  simp_rw [normalizedKloosterman3_scaled_dft p a _ ha,
    normalizedKloosterman3_scaled_dft p b _ hb] at h
  have hs :
      (∑ ξ : ZMod p, (if ξ = 0 then 0 else unnormalizedKloosterman2 p (a / ξ)) *
        star (if ξ + c = 0 then 0 else unnormalizedKloosterman2 p (b / (ξ + c)))) =
        ∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
          unnormalizedKloosterman2 p (a / (c * t)) *
            unnormalizedKloosterman2 p (b / (c * (t + 1))) else 0 := by
    symm
    refine Fintype.sum_equiv (Equiv.mulLeft₀ c hc) _ _ ?_
    intro t
    have h0 : c * t = 0 ↔ t = 0 := mul_eq_zero.trans (or_iff_right hc)
    have h1 : c * t + c = 0 ↔ t = -1 := by
      rw [show c * t + c = c * (t + 1) by ring,
        mul_eq_zero, or_iff_right hc, add_eq_zero_iff_eq_neg]
    simp only [Equiv.mulLeft₀_apply, h0, h1]
    by_cases ht0 : t = 0
    · simp [ht0]
    · by_cases ht1 : t = -1
      · simp [ht1]
      · rw [ite_eq_left ⟨ht0, ht1⟩, ite_eq_right ht0, ite_eq_right ht1,
          unnormalizedKloosterman2_star]
        rw [show c * t + c = c * (t + 1) by ring]
  rw [hs] at h
  rw [sum_units_eq_sum_sub_zero p (fun x : ZMod p =>
    normalizedKloosterman3 p (a * x) * star (normalizedKloosterman3 p (b * x)) *
      ZMod.stdAddChar (c * x))]
  simp only [mul_zero, normalizedKloosterman3_zero, star_inv₀, star_natCast,
    map_zero_eq_one, mul_one]
  rw [h]
  ring

open Classical in
/--
The three-variable complete sum over `u * v * w = c` modulo `q`, with phase `u + v + w` and
normalization `1 / q`. The variables range over all residues, not just units.
-/
noncomputable def normalizedKloosterman3Mod (q : ℕ) [NeZero q]
    (c : ZMod q) : ℂ :=
  (q : ℂ)⁻¹ *
    ∑ u : ZMod q, ∑ v : ZMod q, ∑ w : ZMod q,
      if u * v * w = c then ZMod.stdAddChar (u + v + w) else 0

theorem normalizedKloosterman3Mod_eq_prime
    (p : ℕ) [Fact p.Prime] (c : ZMod p) :
    normalizedKloosterman3Mod p c = normalizedKloosterman3 p c := rfl

theorem normalizedKloosterman3Mod_one (c : ZMod 1) :
    normalizedKloosterman3Mod 1 c = 1 := by
  classical
  have hprod (u v w : ZMod 1) : u * v * w = c := Subsingleton.elim _ _
  have hchar (u v w : ZMod 1) : ZMod.stdAddChar (u + v + w) = 1 := by
    rw [Subsingleton.elim (u + v + w) (0 : ZMod 1)]
    exact map_zero_eq_one _
  simp [normalizedKloosterman3Mod, hprod, hchar]

theorem stdAddChar_coprime_crt
    (m n : ℕ) [NeZero m] [NeZero n] (hmn : m.Coprime n)
    (z : ZMod (m * n)) :
    ZMod.stdAddChar z =
      ZMod.stdAddChar ((n : ZMod m)⁻¹ * (ZMod.chineseRemainder hmn z).1) *
        ZMod.stdAddChar ((m : ZMod n)⁻¹ * (ZMod.chineseRemainder hmn z).2) := by
  have hbez : (m : ℤ) * Nat.gcdA m n + (n : ℤ) * Nat.gcdB m n = 1 := by
    simpa [hmn] using (Nat.gcd_eq_gcd_ab m n).symm
  have hinvm : (n : ZMod m)⁻¹ = (Nat.gcdB m n : ZMod m) := by
    apply ZMod.inv_eq_of_mul_eq_one
    simpa using congrArg (fun j : ℤ => (j : ZMod m)) hbez
  have hinvn : (m : ZMod n)⁻¹ = (Nat.gcdA m n : ZMod n) := by
    apply ZMod.inv_eq_of_mul_eq_one
    simpa using congrArg (fun j : ℤ => (j : ZMod n)) hbez
  obtain ⟨j, rfl⟩ := ZMod.intCast_surjective z
  rw [hinvm, hinvn]
  simp only [map_intCast, Prod.fst_intCast, Prod.snd_intCast,
    ← Int.cast_mul, ZMod.stdAddChar_coe]
  rw [← Complex.exp_add]
  congr 1
  push_cast
  have hbezC : (m : ℂ) * (Nat.gcdA m n : ℂ) +
      (n : ℂ) * (Nat.gcdB m n : ℂ) = 1 := by exact_mod_cast hbez
  field_simp [NeZero.ne (m : ℂ), NeZero.ne (n : ℂ)]
  linear_combination -(j : ℂ) * hbezC

theorem kloosterman3_sum_mul_unit
    (q : ℕ) [NeZero q] (c a : ZMod q) (ha : IsUnit a) :
    (∑ u : ZMod q, ∑ v : ZMod q, ∑ w : ZMod q,
      if u * v * w = c then ZMod.stdAddChar (a * (u + v + w)) else 0) =
    ∑ u : ZMod q, ∑ v : ZMod q, ∑ w : ZMod q,
      if u * v * w = c * a ^ 3 then ZMod.stdAddChar (u + v + w) else 0 := by
  classical
  have hb : Function.Bijective (a * ·) := IsUnit.isUnit_iff_mulLeft_bijective.mp ha
  refine Fintype.sum_bijective (a * ·) hb _ _ ?_
  intro u
  refine Fintype.sum_bijective (a * ·) hb _ _ ?_
  intro v
  refine Fintype.sum_bijective (a * ·) hb _ _ ?_
  intro w
  have hmask : (a * u) * (a * v) * (a * w) = c * a ^ 3 ↔ u * v * w = c := by
    rw [show (a * u) * (a * v) * (a * w) = a ^ 3 * (u * v * w) by ring,
      mul_comm c (a ^ 3)]
    exact (ha.pow 3).mul_right_inj
  simp only [hmask, mul_add]

theorem normalizedKloosterman3Mod_mul
    (m n : ℕ) [NeZero m] [NeZero n] (hmn : m.Coprime n)
    (c : ZMod (m * n)) :
    normalizedKloosterman3Mod (m * n) c =
      normalizedKloosterman3Mod m ((c.val : ZMod m) * ((n : ZMod m)⁻¹) ^ 3) *
        normalizedKloosterman3Mod n ((c.val : ZMod n) * ((m : ZMod n)⁻¹) ^ 3) := by
  classical
  let e := ZMod.chineseRemainder hmn
  let f (u v w : ZMod m) : ℂ :=
    if u * v * w = (e c).1 then
      ZMod.stdAddChar ((n : ZMod m)⁻¹ * (u + v + w)) else 0
  let g (u v w : ZMod n) : ℂ :=
    if u * v * w = (e c).2 then
      ZMod.stdAddChar ((m : ZMod n)⁻¹ * (u + v + w)) else 0
  have hterm (u v w : ZMod (m * n)) :
      (if u * v * w = c then ZMod.stdAddChar (u + v + w) else 0) =
        f (e u).1 (e v).1 (e w).1 * g (e u).2 (e v).2 (e w).2 := by
    have hmask : u * v * w = c ↔
        (e u).1 * (e v).1 * (e w).1 = (e c).1 ∧
          (e u).2 * (e v).2 * (e w).2 = (e c).2 := by
      rw [← e.injective.eq_iff]
      simp only [map_mul, Prod.ext_iff, Prod.fst_mul, Prod.snd_mul]
    by_cases h : u * v * w = c
    · rcases hmask.mp h with ⟨hm, hn⟩
      simp only [f, g, ite_eq_left h, ite_eq_left hm, ite_eq_left hn]
      simpa only [e, map_add, Prod.fst_add, Prod.snd_add] using
        stdAddChar_coprime_crt m n hmn (u + v + w)
    · rcases not_and_or.mp (mt hmask.mpr h) with hm | hn
      · simp only [f, g, ite_eq_right h, ite_eq_right hm, zero_mul]
      · simp only [f, g, ite_eq_right h, ite_eq_right hn, mul_zero]
  have hsum :
      (∑ u : ZMod (m * n), ∑ v : ZMod (m * n), ∑ w : ZMod (m * n),
        if u * v * w = c then ZMod.stdAddChar (u + v + w) else 0) =
      (∑ u : ZMod m, ∑ v : ZMod m, ∑ w : ZMod m, f u v w) *
        (∑ u : ZMod n, ∑ v : ZMod n, ∑ w : ZMod n, g u v w) := by
    calc
      _ = ∑ u : ZMod (m * n), ∑ v : ZMod (m * n), ∑ w : ZMod (m * n),
          f (e u).1 (e v).1 (e w).1 * g (e u).2 (e v).2 (e w).2 := by
        simp_rw [hterm]
      _ = ∑ u : ZMod m × ZMod n, ∑ v : ZMod m × ZMod n,
          ∑ w : ZMod m × ZMod n, f u.1 v.1 w.1 * g u.2 v.2 w.2 := by
        refine Fintype.sum_equiv e.toEquiv _ _ ?_
        intro u
        refine Fintype.sum_equiv e.toEquiv _ _ ?_
        intro v
        refine Fintype.sum_equiv e.toEquiv _ _ ?_
        intro w
        rfl
      _ = _ := by
        simp only [Fintype.sum_prod_type, ← Finset.mul_sum, ← Finset.sum_mul]
  have hmInv : IsUnit ((n : ZMod m)⁻¹) := by
    simpa only [← ZMod.inv_coe_unit, ZMod.coe_unitOfCoprime] using
      ((ZMod.unitOfCoprime n hmn.symm)⁻¹).isUnit
  have hnInv : IsUnit ((m : ZMod n)⁻¹) := by
    simpa only [← ZMod.inv_coe_unit, ZMod.coe_unitOfCoprime] using
      ((ZMod.unitOfCoprime m hmn)⁻¹).isUnit
  have hm := kloosterman3_sum_mul_unit m (e c).1 ((n : ZMod m)⁻¹) hmInv
  have hn := kloosterman3_sum_mul_unit n (e c).2 ((m : ZMod n)⁻¹) hnInv
  have hc1 : (e c).1 = (c.val : ZMod m) := by
    change (ZMod.cast c : ZMod m × ZMod n).1 = _
    rw [Prod.fst_zmod_cast, ← ZMod.natCast_val]
  have hc2 : (e c).2 = (c.val : ZMod n) := by
    change (ZMod.cast c : ZMod m × ZMod n).2 = _
    rw [Prod.snd_zmod_cast, ← ZMod.natCast_val]
  unfold normalizedKloosterman3Mod
  rw [hsum]
  dsimp only [f, g]
  rw [hm, hn, hc1, hc2, Nat.cast_mul, mul_inv_rev]
  ring

theorem sum_units_crt (m n : ℕ) [NeZero m] [NeZero n]
    (hmn : m.Coprime n) (f : ZMod m → ℂ) (g : ZMod n → ℂ) :
    (∑ h : (ZMod (m * n))ˣ,
      f ((h : ZMod (m * n)).val : ZMod m) *
        g ((h : ZMod (m * n)).val : ZMod n)) =
      (∑ h : (ZMod m)ˣ, f (h : ZMod m)) *
        (∑ h : (ZMod n)ˣ, g (h : ZMod n)) := by
  let e : (ZMod (m * n))ˣ ≃* (ZMod m)ˣ × (ZMod n)ˣ :=
    (Units.mapEquiv (ZMod.chineseRemainder hmn).toMulEquiv).trans MulEquiv.prodUnits
  calc
    _ = ∑ t : (ZMod m)ˣ × (ZMod n)ˣ,
        f (t.1 : ZMod m) * g (t.2 : ZMod n) := by
      refine Fintype.sum_equiv e.toEquiv _ _ ?_
      intro h
      exact (congrArg (fun z : ZMod m × ZMod n => f z.1 * g z.2)
        (ZMod.cast_eq_val (R := ZMod m × ZMod n) (h : ZMod (m * n)))).symm
    _ = _ := by
      rw [Fintype.sum_prod_type]
      exact (Fintype.sum_mul_sum (fun h : (ZMod m)ˣ => f (h : ZMod m))
        (fun h : (ZMod n)ˣ => g (h : ZMod n))).symm

theorem sum_units_mul (q : ℕ) [NeZero q] (f : ZMod q → ℂ)
    (a : ZMod q) (ha : IsUnit a) :
    (∑ h : (ZMod q)ˣ, f (a * (h : ZMod q))) =
      ∑ h : (ZMod q)ˣ, f (h : ZMod q) := by
  obtain ⟨a, rfl⟩ := ha
  exact Fintype.sum_equiv (Equiv.mulLeft a) _ _ (fun _ => rfl)

theorem isUnit_intCast_of_dvd (m n : ℕ) (hmn : m ∣ n)
    (a : ℤ) (ha : IsUnit (a : ZMod n)) : IsUnit (a : ZMod m) := by
  simpa only [map_intCast] using ha.map (ZMod.castHom hmn (ZMod m))

theorem cast_val_natCast (m n : ℕ) [NeZero m] (hnm : n ∣ m) (x : ℕ) :
    (((x : ZMod m).val : ℕ) : ZMod n) = (x : ZMod n) := by
  rw [ZMod.natCast_val, ZMod.cast_natCast hnm]

theorem isUnit_inv_cube (m n : ℕ) (hnm : n.Coprime m) :
    IsUnit (((n : ZMod m)⁻¹) ^ 3) := by
  have h : IsUnit ((n : ZMod m)⁻¹) := by
    simpa only [← ZMod.inv_coe_unit, ZMod.coe_unitOfCoprime] using
      ((ZMod.unitOfCoprime n hnm)⁻¹).isUnit
  exact h.pow 3

theorem kloosterman3Mod_int_mul_crt
    (m n : ℕ) [NeZero m] [NeZero n] (hmn : m.Coprime n)
    (a : ℤ) (x : ZMod (m * n)) :
    normalizedKloosterman3Mod (m * n) ((a : ZMod (m * n)) * x) =
      normalizedKloosterman3Mod m
          ((a : ZMod m) * (x.val : ZMod m) * ((n : ZMod m)⁻¹) ^ 3) *
        normalizedKloosterman3Mod n
          ((a : ZMod n) * (x.val : ZMod n) * ((m : ZMod n)⁻¹) ^ 3) := by
  have hm : m ∣ m * n := ⟨n, rfl⟩
  have hn : n ∣ m * n := ⟨m, Nat.mul_comm m n⟩
  simp only [normalizedKloosterman3Mod_mul m n hmn, ZMod.natCast_val,
    ZMod.cast_mul hm, ZMod.cast_intCast hm, ZMod.cast_mul hn, ZMod.cast_intCast hn]

theorem kloosterman3Mod_correlation_mul
    (m n : ℕ) [NeZero m] [NeZero n] (hmn : m.Coprime n) (a b : ℤ) :
    (∑ h : (ZMod (m * n))ˣ,
      normalizedKloosterman3Mod (m * n) ((a : ZMod (m * n)) * (h : ZMod (m * n))) *
        star (normalizedKloosterman3Mod (m * n)
          ((b : ZMod (m * n)) * (h : ZMod (m * n))))) =
      (∑ h : (ZMod m)ˣ,
        normalizedKloosterman3Mod m ((a : ZMod m) * (h : ZMod m)) *
          star (normalizedKloosterman3Mod m ((b : ZMod m) * (h : ZMod m)))) *
      (∑ h : (ZMod n)ˣ,
        normalizedKloosterman3Mod n ((a : ZMod n) * (h : ZMod n)) *
          star (normalizedKloosterman3Mod n ((b : ZMod n) * (h : ZMod n)))) := by
  let f (x : ZMod m) :=
    normalizedKloosterman3Mod m ((a : ZMod m) * x * ((n : ZMod m)⁻¹) ^ 3) *
      star (normalizedKloosterman3Mod m ((b : ZMod m) * x * ((n : ZMod m)⁻¹) ^ 3))
  let g (x : ZMod n) :=
    normalizedKloosterman3Mod n ((a : ZMod n) * x * ((m : ZMod n)⁻¹) ^ 3) *
      star (normalizedKloosterman3Mod n ((b : ZMod n) * x * ((m : ZMod n)⁻¹) ^ 3))
  calc
    _ = ∑ h : (ZMod (m * n))ˣ,
        f ((h : ZMod (m * n)).val : ZMod m) *
          g ((h : ZMod (m * n)).val : ZMod n) := by
      apply Finset.sum_congr rfl
      intro h _
      rw [kloosterman3Mod_int_mul_crt m n hmn,
        kloosterman3Mod_int_mul_crt m n hmn, star_mul]
      dsimp only [f, g]
      ring
    _ = (∑ h : (ZMod m)ˣ, f (h : ZMod m)) *
        (∑ h : (ZMod n)ˣ, g (h : ZMod n)) := sum_units_crt m n hmn f g
    _ = _ := by
      congr 1
      · simpa only [f, mul_assoc, mul_left_comm, mul_comm] using
          sum_units_mul m (fun x => normalizedKloosterman3Mod m ((a : ZMod m) * x) *
            star (normalizedKloosterman3Mod m ((b : ZMod m) * x)))
            (((n : ZMod m)⁻¹) ^ 3) (isUnit_inv_cube m n hmn.symm)
      · simpa only [g, mul_assoc, mul_left_comm, mul_comm] using
          sum_units_mul n (fun x => normalizedKloosterman3Mod n ((a : ZMod n) * x) *
            star (normalizedKloosterman3Mod n ((b : ZMod n) * x)))
            (((m : ZMod n)⁻¹) ^ 3) (isUnit_inv_cube n m hmn)

theorem normalizedKloosterman3Mod_unit_correlation_zero_eq_prod
    (q : ℕ) [NeZero q] (hq : Squarefree q) (a b : ℤ)
    (ha : IsUnit (a : ZMod q)) (hb : IsUnit (b : ZMod q)) :
    (∑ h : (ZMod q)ˣ,
      normalizedKloosterman3Mod q ((a : ZMod q) * (h : ZMod q)) *
        star (normalizedKloosterman3Mod q ((b : ZMod q) * (h : ZMod q)))) =
      ∏ p ∈ q.primeFactors,
        ((if (p : ℤ) ∣ a - b then (p : ℂ) else 0) - 1 -
          (p : ℂ)⁻¹ - ((p : ℂ)⁻¹) ^ 2) := by
  have hmain : ∀ n : ℕ, ∀ [NeZero n], Squarefree n → ∀ a b : ℤ,
      IsUnit (a : ZMod n) → IsUnit (b : ZMod n) →
      (∑ h : (ZMod n)ˣ,
        normalizedKloosterman3Mod n ((a : ZMod n) * (h : ZMod n)) *
          star (normalizedKloosterman3Mod n ((b : ZMod n) * (h : ZMod n)))) =
        ∏ p ∈ n.primeFactors,
          ((if (p : ℤ) ∣ a - b then (p : ℂ) else 0) - 1 -
            (p : ℂ)⁻¹ - ((p : ℂ)⁻¹) ^ 2) := by
    refine induction_on_primes ?_ ?_ ?_
    · intro _
      exact False.elim (NeZero.ne 0 rfl)
    · intro _ _ a b _ _
      simp [normalizedKloosterman3Mod_one]
    · intro p n hp ih _ hpn a b ha hb
      have hn : Squarefree n := hpn.of_mul_right
      let : NeZero n := ⟨hn.ne_zero⟩
      let : Fact p.Prime := ⟨hp⟩
      have hcop : p.Coprime n := Nat.coprime_of_squarefree_mul hpn
      have hap := isUnit_intCast_of_dvd p (p * n) ⟨n, rfl⟩ a ha
      have hbp := isUnit_intCast_of_dvd p (p * n) ⟨n, rfl⟩ b hb
      have han := isUnit_intCast_of_dvd n (p * n) ⟨p, Nat.mul_comm p n⟩ a ha
      have hbn := isUnit_intCast_of_dvd n (p * n) ⟨p, Nat.mul_comm p n⟩ b hb
      have heq : (a : ZMod p) = (b : ZMod p) ↔ (p : ℤ) ∣ a - b := by
        rw [← sub_eq_zero, ← Int.cast_sub, ZMod.intCast_zmod_eq_zero_iff_dvd]
      rw [kloosterman3Mod_correlation_mul p n hcop,
        ih hn a b han hbn, hcop.primeFactors_mul,
        Finset.prod_union hcop.disjoint_primeFactors, hp.primeFactors,
        Finset.prod_singleton]
      simp only [normalizedKloosterman3Mod_eq_prime]
      rw [normalizedKloosterman3_unit_correlation_zero p _ _ hap.ne_zero hbp.ne_zero]
      simp only [heq]
  exact hmain q hq a b ha hb

theorem kloosterman3_prime_factor_norm_le (p : ℕ) (hp : 2 ≤ p)
    (P : Prop) [Decidable P] :
    ‖(if P then (p : ℂ) else 0) - 1 - (p : ℂ)⁻¹ - ((p : ℂ)⁻¹) ^ 2‖ ≤
      2 * (if P then (p : ℝ) else 1) := by
  have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast hp
  have hp0 : (0 : ℝ) < p := lt_of_lt_of_le (by norm_num) hp2
  have hi0 : 0 ≤ (p : ℝ)⁻¹ := inv_nonneg.mpr hp0.le
  have hi2 : (p : ℝ)⁻¹ ≤ (1 / 2 : ℝ) := by
    simpa only [one_div] using
      (inv_le_inv₀ hp0 (show (0 : ℝ) < 2 by norm_num)).mpr hp2
  have hi_sq : ((p : ℝ)⁻¹) ^ 2 ≤ (1 / 4 : ℝ) := by nlinarith
  have hreal :
      (if P then (p : ℂ) else 0) - 1 - (p : ℂ)⁻¹ - ((p : ℂ)⁻¹) ^ 2 =
        (((if P then (p : ℝ) else 0) - 1 - (p : ℝ)⁻¹ -
          ((p : ℝ)⁻¹) ^ 2 : ℝ) : ℂ) := by
    split_ifs <;> push_cast <;> rfl
  rw [hreal, Complex.norm_real, Real.norm_eq_abs]
  by_cases hP : P
  · simp only [hP, ite_true]
    apply abs_le.mpr
    constructor <;> nlinarith [sq_nonneg ((p : ℝ)⁻¹)]
  · simp only [hP, ite_false, zero_sub]
    apply abs_le.mpr
    constructor <;> nlinarith [sq_nonneg ((p : ℝ)⁻¹)]

theorem prod_primeFactors_gcd (q : ℕ) (hq : Squarefree q) (z : ℤ) :
    (∏ p ∈ q.primeFactors, if (p : ℤ) ∣ z then (p : ℝ) else 1) =
      (Int.gcd z (q : ℤ) : ℝ) := by
  let d := Nat.gcd q z.natAbs
  have hd : d ∣ q := Nat.gcd_dvd_left q z.natAbs
  have hdsq : Squarefree d := hq.squarefree_of_dvd hd
  have hfilter : q.primeFactors.filter (fun p : ℕ => (p : ℤ) ∣ z) = d.primeFactors := by
    rw [← Nat.primeFactors_filter_dvd_of_dvd hq.ne_zero hd]
    apply Finset.filter_congr
    intro p hp
    simp only [d, Int.natCast_dvd, Nat.dvd_gcd_iff,
      Nat.dvd_of_mem_primeFactors hp, true_and]
  rw [← Finset.prod_filter, hfilter, ← Nat.cast_prod,
    Nat.prod_primeFactors_of_squarefree hdsq]
  simp only [d, Int.gcd_def, Int.natAbs_natCast, Nat.gcd_comm]

theorem normalizedKloosterman3Mod_unit_correlation_zero_norm_le
    (q : ℕ) [NeZero q] (hq : Squarefree q) (a b : ℤ)
    (ha : IsUnit (a : ZMod q)) (hb : IsUnit (b : ZMod q)) :
    ‖∑ h : (ZMod q)ˣ,
      normalizedKloosterman3Mod q ((a : ZMod q) * (h : ZMod q)) *
        star (normalizedKloosterman3Mod q ((b : ZMod q) * (h : ZMod q)))‖ ≤
      (2 : ℝ) ^ q.primeFactors.card * (Int.gcd (a - b) (q : ℤ) : ℝ) := by
  rw [normalizedKloosterman3Mod_unit_correlation_zero_eq_prod q hq a b ha hb,
    Complex.norm_prod]
  calc
    _ ≤ ∏ p ∈ q.primeFactors, 2 * (if (p : ℤ) ∣ a - b then (p : ℝ) else 1) := by
      apply Finset.prod_le_prod
      · intro p _
        exact norm_nonneg _
      · intro p hp
        exact kloosterman3_prime_factor_norm_le p
          (Nat.prime_of_mem_primeFactors hp).two_le ((p : ℤ) ∣ a - b)
    _ = (2 : ℝ) ^ q.primeFactors.card *
        ∏ p ∈ q.primeFactors, if (p : ℤ) ∣ a - b then (p : ℝ) else 1 := by
      rw [Finset.prod_mul_distrib, Finset.prod_const]
    _ = _ := by rw [prod_primeFactors_gcd q hq (a - b)]

theorem kloosterman3Mod_unit_sum_mul
    (m n : ℕ) [NeZero m] [NeZero n] (hmn : m.Coprime n) (a : ℤ) :
    (∑ h : (ZMod (m * n))ˣ,
      normalizedKloosterman3Mod (m * n) ((a : ZMod (m * n)) * (h : ZMod (m * n)))) =
      (∑ h : (ZMod m)ˣ, normalizedKloosterman3Mod m ((a : ZMod m) * (h : ZMod m))) *
        (∑ h : (ZMod n)ˣ, normalizedKloosterman3Mod n ((a : ZMod n) * (h : ZMod n))) := by
  let f (x : ZMod m) :=
    normalizedKloosterman3Mod m ((a : ZMod m) * x * ((n : ZMod m)⁻¹) ^ 3)
  let g (x : ZMod n) :=
    normalizedKloosterman3Mod n ((a : ZMod n) * x * ((m : ZMod n)⁻¹) ^ 3)
  calc
    _ = ∑ h : (ZMod (m * n))ˣ,
        f ((h : ZMod (m * n)).val : ZMod m) *
          g ((h : ZMod (m * n)).val : ZMod n) := by
      apply Finset.sum_congr rfl
      intro h _
      exact kloosterman3Mod_int_mul_crt m n hmn a (h : ZMod (m * n))
    _ = (∑ h : (ZMod m)ˣ, f (h : ZMod m)) *
        (∑ h : (ZMod n)ˣ, g (h : ZMod n)) := sum_units_crt m n hmn f g
    _ = _ := by
      congr 1
      · simpa only [f, mul_assoc, mul_left_comm, mul_comm] using
          sum_units_mul m (fun x => normalizedKloosterman3Mod m ((a : ZMod m) * x))
            (((n : ZMod m)⁻¹) ^ 3) (isUnit_inv_cube m n hmn.symm)
      · simpa only [g, mul_assoc, mul_left_comm, mul_comm] using
          sum_units_mul n (fun x => normalizedKloosterman3Mod n ((a : ZMod n) * x))
            (((m : ZMod n)⁻¹) ^ 3) (isUnit_inv_cube n m hmn)

theorem kloosterman3Mod_unit_sum_norm
    (q : ℕ) [NeZero q] (hq : Squarefree q) (a : ZMod q) (ha : IsUnit a) :
    ‖∑ h : (ZMod q)ˣ, normalizedKloosterman3Mod q (a * (h : ZMod q))‖ =
      (q : ℝ)⁻¹ := by
  rw [sum_units_mul q (normalizedKloosterman3Mod q) a ha]
  have hmain : ∀ n : ℕ, ∀ [NeZero n], Squarefree n →
      ‖∑ h : (ZMod n)ˣ, normalizedKloosterman3Mod n (h : ZMod n)‖ =
        (n : ℝ)⁻¹ := by
    refine induction_on_primes ?_ ?_ ?_
    · intro _
      exact False.elim (NeZero.ne 0 rfl)
    · intro _ _
      simp [normalizedKloosterman3Mod_one]
    · intro p n hp ih _ hpn
      have hn : Squarefree n := hpn.of_mul_right
      let : NeZero n := ⟨hn.ne_zero⟩
      let : Fact p.Prime := ⟨hp⟩
      have hcop : p.Coprime n := Nat.coprime_of_squarefree_mul hpn
      have hmul := kloosterman3Mod_unit_sum_mul p n hcop 1
      simp only [Int.cast_one, one_mul] at hmul
      have hprime : (∑ h : (ZMod p)ˣ,
          normalizedKloosterman3Mod p (h : ZMod p)) = -((p : ℂ)⁻¹) := by
        simpa only [normalizedKloosterman3Mod_eq_prime, zero_mul,
          map_zero_eq_one, mul_one, ite_true] using
          normalizedKloosterman3_unit_fourier p 0
      rw [hmul, norm_mul, hprime, norm_neg, norm_inv, Complex.norm_natCast,
        ih hn, Nat.cast_mul, mul_inv_rev]
      ring
  exact hmain q hq

theorem kloosterman3Mod_mixed_coprime_norm_le
    (c m n : ℕ) [NeZero c] [NeZero m] [NeZero n]
    (hc : Squarefree c) (hm : Squarefree m) (hn : Squarefree n)
    (hmn : m.Coprime n) (hmc : m.Coprime c) (hnc : n.Coprime c)
    (a b : ℤ) (ha : IsUnit (a : ZMod (m * c)))
    (hb : IsUnit (b : ZMod (n * c))) :
    ‖∑ h : (ZMod ((m * n) * c))ˣ,
      normalizedKloosterman3Mod (m * c)
          ((a : ZMod (m * c)) * ((h : ZMod ((m * n) * c)).val : ZMod (m * c))) *
        star (normalizedKloosterman3Mod (n * c)
          ((b : ZMod (n * c)) * ((h : ZMod ((m * n) * c)).val : ZMod (n * c))))‖ ≤
      (2 : ℝ) ^ c.primeFactors.card *
        (Int.gcd (b * (m : ℤ) ^ 3 - a * (n : ℤ) ^ 3) (c : ℤ) : ℝ) /
          ((m * n : ℕ) : ℝ) := by
  let f (x : ZMod m) :=
    normalizedKloosterman3Mod m ((a : ZMod m) * x * ((c : ZMod m)⁻¹) ^ 3)
  let g (x : ZMod n) :=
    star (normalizedKloosterman3Mod n ((b : ZMod n) * x * ((c : ZMod n)⁻¹) ^ 3))
  let k (x : ZMod c) :=
    normalizedKloosterman3Mod c ((a : ZMod c) * x * ((m : ZMod c)⁻¹) ^ 3) *
      star (normalizedKloosterman3Mod c ((b : ZMod c) * x * ((n : ZMod c)⁻¹) ^ 3))
  have hsum :
      (∑ h : (ZMod ((m * n) * c))ˣ,
        normalizedKloosterman3Mod (m * c)
            ((a : ZMod (m * c)) * ((h : ZMod ((m * n) * c)).val : ZMod (m * c))) *
          star (normalizedKloosterman3Mod (n * c)
            ((b : ZMod (n * c)) * ((h : ZMod ((m * n) * c)).val : ZMod (n * c))))) =
        (∑ h : (ZMod m)ˣ, f (h : ZMod m)) *
          (∑ h : (ZMod n)ˣ, g (h : ZMod n)) *
          (∑ h : (ZMod c)ˣ, k (h : ZMod c)) := by
    calc
      _ = ∑ h : (ZMod ((m * n) * c))ˣ,
          f ((h : ZMod ((m * n) * c)).val : ZMod m) *
            g ((h : ZMod ((m * n) * c)).val : ZMod n) *
            k ((h : ZMod ((m * n) * c)).val : ZMod c) := by
        apply Finset.sum_congr rfl
        intro h _
        rw [kloosterman3Mod_int_mul_crt m c hmc,
          kloosterman3Mod_int_mul_crt n c hnc, star_mul,
          cast_val_natCast (m * c) m ⟨c, rfl⟩,
          cast_val_natCast (m * c) c ⟨m, Nat.mul_comm m c⟩,
          cast_val_natCast (n * c) n ⟨c, rfl⟩,
          cast_val_natCast (n * c) c ⟨n, Nat.mul_comm n c⟩]
        dsimp only [f, g, k]
        ring
      _ = _ := by
        let fg (x : ZMod (m * n)) := f (x.val : ZMod m) * g (x.val : ZMod n)
        calc
          _ = ∑ h : (ZMod ((m * n) * c))ˣ,
              fg ((h : ZMod ((m * n) * c)).val : ZMod (m * n)) *
                k ((h : ZMod ((m * n) * c)).val : ZMod c) := by
            apply Finset.sum_congr rfl
            intro h _
            dsimp only [fg]
            rw [cast_val_natCast (m * n) m ⟨n, rfl⟩,
              cast_val_natCast (m * n) n ⟨m, Nat.mul_comm m n⟩]
          _ = (∑ h : (ZMod (m * n))ˣ, fg (h : ZMod (m * n))) *
              (∑ h : (ZMod c)ˣ, k (h : ZMod c)) :=
            sum_units_crt (m * n) c (hmc.mul_left hnc) fg k
          _ = _ := by
            dsimp only [fg]
            rw [sum_units_crt m n hmn f g]
  have ham : IsUnit (a : ZMod m) := isUnit_intCast_of_dvd m (m * c) ⟨c, rfl⟩ a ha
  have hbn : IsUnit (b : ZMod n) := isUnit_intCast_of_dvd n (n * c) ⟨c, rfl⟩ b hb
  have hac : IsUnit (a : ZMod c) :=
    isUnit_intCast_of_dvd c (m * c) ⟨m, Nat.mul_comm m c⟩ a ha
  have hbc : IsUnit (b : ZMod c) :=
    isUnit_intCast_of_dvd c (n * c) ⟨n, Nat.mul_comm n c⟩ b hb
  have hmu : IsUnit (m : ZMod c) := (ZMod.isUnit_iff_coprime m c).mpr hmc
  have hnu : IsUnit (n : ZMod c) := (ZMod.isUnit_iff_coprime n c).mpr hnc
  have hf : ‖∑ h : (ZMod m)ˣ, f (h : ZMod m)‖ = (m : ℝ)⁻¹ := by
    simpa only [f, mul_assoc, mul_left_comm, mul_comm] using
      kloosterman3Mod_unit_sum_norm m hm
        ((a : ZMod m) * ((c : ZMod m)⁻¹) ^ 3)
        (ham.mul (isUnit_inv_cube m c hmc.symm))
  have hg : ‖∑ h : (ZMod n)ˣ, g (h : ZMod n)‖ = (n : ℝ)⁻¹ := by
    have heq : (∑ h : (ZMod n)ˣ, g (h : ZMod n)) =
        star (∑ h : (ZMod n)ˣ,
          normalizedKloosterman3Mod n
            ((b : ZMod n) * (h : ZMod n) * ((c : ZMod n)⁻¹) ^ 3)) := by
      rw [star_sum]
    rw [heq, norm_star]
    simpa only [mul_assoc, mul_left_comm, mul_comm] using
      kloosterman3Mod_unit_sum_norm n hn
        ((b : ZMod n) * ((c : ZMod n)⁻¹) ^ 3)
        (hbn.mul (isUnit_inv_cube n c hnc.symm))
  let t : ZMod c := ((m : ZMod c) * (n : ZMod c)) ^ 3
  have ht : IsUnit t := (hmu.mul hnu).pow 3
  have hscale (v w z x : ZMod c) (hv : IsUnit v) :
      z * ((v * w) ^ 3 * x) * (v⁻¹) ^ 3 = z * w ^ 3 * x := by
    calc
      _ = (z * w ^ 3 * x) * ((v⁻¹) ^ 3 * v ^ 3) := by ring
      _ = _ := by
        rw [← mul_pow, ZMod.inv_mul_of_unit _ hv, one_pow, mul_one]
  have hk : (∑ h : (ZMod c)ˣ, k (h : ZMod c)) =
      ∑ h : (ZMod c)ˣ,
        normalizedKloosterman3Mod c (((a * (n : ℤ) ^ 3 : ℤ) : ZMod c) * (h : ZMod c)) *
          star (normalizedKloosterman3Mod c
            (((b * (m : ℤ) ^ 3 : ℤ) : ZMod c) * (h : ZMod c))) := by
    calc
      _ = ∑ h : (ZMod c)ˣ, k (t * (h : ZMod c)) := (sum_units_mul c k t ht).symm
      _ = _ := by
        apply Finset.sum_congr rfl
        intro h _
        dsimp only [k, t]
        rw [hscale _ _ _ _ hmu, mul_comm (m : ZMod c) (n : ZMod c),
          hscale _ _ _ _ hnu]
        simp only [Int.cast_mul, Int.cast_pow, Int.cast_natCast]
  have ha' : IsUnit ((a * (n : ℤ) ^ 3 : ℤ) : ZMod c) := by
    simpa only [Int.cast_mul, Int.cast_pow, Int.cast_natCast] using hac.mul (hnu.pow 3)
  have hb' : IsUnit ((b * (m : ℤ) ^ 3 : ℤ) : ZMod c) := by
    simpa only [Int.cast_mul, Int.cast_pow, Int.cast_natCast] using hbc.mul (hmu.pow 3)
  have hbound := normalizedKloosterman3Mod_unit_correlation_zero_norm_le c hc
    (a * (n : ℤ) ^ 3) (b * (m : ℤ) ^ 3) ha' hb'
  have hneg : a * (n : ℤ) ^ 3 - b * (m : ℤ) ^ 3 =
      -(b * (m : ℤ) ^ 3 - a * (n : ℤ) ^ 3) := by ring
  simp only [hneg, Int.gcd_def, Int.natAbs_neg] at hbound
  calc
    _ = (m : ℝ)⁻¹ * (n : ℝ)⁻¹ * ‖∑ h : (ZMod c)ˣ, k (h : ZMod c)‖ := by
      rw [hsum, norm_mul, norm_mul, hf, hg]
    _ ≤ (m : ℝ)⁻¹ * (n : ℝ)⁻¹ * ((2 : ℝ) ^ c.primeFactors.card *
        (Int.gcd (b * (m : ℤ) ^ 3 - a * (n : ℤ) ^ 3) (c : ℤ) : ℝ)) := by
      rw [hk]
      apply mul_le_mul_of_nonneg_left
      · simpa only [Int.gcd_def] using hbound
      · positivity
    _ = _ := by
      simp only [Nat.cast_mul, div_eq_mul_inv, mul_inv_rev]
      ring

theorem phaseCRT_map_inv {m n : ℕ} (f : ZMod m →+* ZMod n)
    {z : ZMod m} (hz : IsUnit z) : f z⁻¹ = (f z)⁻¹ := by
  symm
  apply ZMod.inv_eq_of_mul_eq_one
  rw [← map_mul, ZMod.mul_inv_of_unit z hz, map_one]

theorem affineReciprocalProductPhase_mul
    (q r : ℕ) [NeZero q] [NeZero r] (hqr : Nat.Coprime q r)
    (A B L η₁ η₂ n d : ZMod (q * r)) :
    affineReciprocalProductPhase (q * r) A B L η₁ η₂ n d =
      affineReciprocalProductPhase q
        ((A.val : ZMod q) * (r : ZMod q)⁻¹)
        (B.val : ZMod q) (L.val : ZMod q)
        (η₁.val : ZMod q) (η₂.val : ZMod q)
        (n.val : ZMod q) (d.val : ZMod q) *
      affineReciprocalProductPhase r
        ((A.val : ZMod r) * (q : ZMod r)⁻¹)
        (B.val : ZMod r) (L.val : ZMod r)
        (η₁.val : ZMod r) (η₂.val : ZMod r)
        (n.val : ZMod r) (d.val : ZMod r) := by
  classical
  let e := ZMod.chineseRemainder hqr
  let πq : ZMod (q * r) →+* ZMod q :=
    (RingHom.fst (ZMod q) (ZMod r)).comp e.toRingHom
  let πr : ZMod (q * r) →+* ZMod r :=
    (RingHom.snd (ZMod q) (ZMod r)).comp e.toRingHom
  have hcrt (z : ZMod (q * r)) :
      e z = ((z.val : ZMod q), (z.val : ZMod r)) := by
    change (ZMod.cast z : ZMod q × ZMod r) = _
    exact ZMod.cast_eq_val z
  have hπq (z : ZMod (q * r)) : πq z = (z.val : ZMod q) := by
    change (e z).1 = _
    rw [hcrt]
  have hπr (z : ZMod (q * r)) : πr z = (z.val : ZMod r) := by
    change (e z).2 = _
    rw [hcrt]
  have hunit (z : ZMod (q * r)) :
      IsUnit z ↔ IsUnit (πq z) ∧ IsUnit (πr z) := by
    change IsUnit z ↔ IsUnit (e z).1 ∧ IsUnit (e z).2
    rw [← Prod.isUnit_iff]
    exact (MulEquiv.isUnit_map e).symm
  let F₁ := n + B * d + η₁
  let F₂ := n + (B + L) * d + η₂
  have hq₁ : πq F₁ = πq n + πq B * πq d + πq η₁ := by
    simp only [F₁, map_add, map_mul]
  have hq₂ : πq F₂ = πq n + (πq B + πq L) * πq d + πq η₂ := by
    simp only [F₂, map_add, map_mul]
  have hr₁ : πr F₁ = πr n + πr B * πr d + πr η₁ := by
    simp only [F₁, map_add, map_mul]
  have hr₂ : πr F₂ = πr n + (πr B + πr L) * πr d + πr η₂ := by
    simp only [F₂, map_add, map_mul]
  have hmask : (IsUnit F₁ ∧ IsUnit F₂) ↔
      (IsUnit (πq F₁) ∧ IsUnit (πq F₂)) ∧
        (IsUnit (πr F₁) ∧ IsUnit (πr F₂)) := by
    rw [hunit, hunit]
    tauto
  suffices h : affineReciprocalProductPhase (q * r) A B L η₁ η₂ n d =
      affineReciprocalProductPhase q (πq A * (r : ZMod q)⁻¹)
        (πq B) (πq L) (πq η₁) (πq η₂) (πq n) (πq d) *
      affineReciprocalProductPhase r (πr A * (q : ZMod r)⁻¹)
        (πr B) (πr L) (πr η₁) (πr η₂) (πr n) (πr d) by
    simpa only [hπq, hπr] using h
  simp only [affineReciprocalProductPhase, ← hq₁, ← hq₂, ← hr₁, ← hr₂]
  change (if IsUnit F₁ ∧ IsUnit F₂ then ZMod.stdAddChar (A * L * (F₁ * F₂)⁻¹)
      else 0) =
    (if IsUnit (πq F₁) ∧ IsUnit (πq F₂) then
      ZMod.stdAddChar ((πq A * (r : ZMod q)⁻¹) * πq L * (πq F₁ * πq F₂)⁻¹)
      else 0) *
    (if IsUnit (πr F₁) ∧ IsUnit (πr F₂) then
      ZMod.stdAddChar ((πr A * (q : ZMod r)⁻¹) * πr L * (πr F₁ * πr F₂)⁻¹)
      else 0)
  by_cases h : IsUnit F₁ ∧ IsUnit F₂
  · obtain ⟨hq, hr⟩ := hmask.mp h
    rw [ite_eq_left h, ite_eq_left hq, ite_eq_left hr]
    have hprod : IsUnit (F₁ * F₂) := h.1.mul h.2
    have hchar := stdAddChar_coprime_crt q r hqr (A * L * (F₁ * F₂)⁻¹)
    change ZMod.stdAddChar (A * L * (F₁ * F₂)⁻¹) =
      ZMod.stdAddChar ((r : ZMod q)⁻¹ * πq (A * L * (F₁ * F₂)⁻¹)) *
      ZMod.stdAddChar ((q : ZMod r)⁻¹ * πr (A * L * (F₁ * F₂)⁻¹)) at hchar
    simpa only [map_mul, phaseCRT_map_inv πq hprod, phaseCRT_map_inv πr hprod,
      mul_comm, mul_left_comm, mul_assoc] using hchar
  · rw [ite_eq_right h]
    by_cases hq : IsUnit (πq F₁) ∧ IsUnit (πq F₂)
    · have hr : ¬ (IsUnit (πr F₁) ∧ IsUnit (πr F₂)) :=
        fun hr => h (hmask.mpr ⟨hq, hr⟩)
      rw [ite_eq_left hq, ite_eq_right hr, mul_zero]
    · rw [ite_eq_right hq, zero_mul]

theorem norm_affineReciprocalProductPhase_le_one
    (m : ℕ) [NeZero m] (A B L η₁ η₂ n d : ZMod m) :
    ‖affineReciprocalProductPhase m A B L η₁ η₂ n d‖ ≤ 1 := by
  classical
  dsimp only [affineReciprocalProductPhase]
  split_ifs <;> simp

theorem phaseConj_translate_scale
    (m : ℕ) [NeZero m] (t : ZMod m) (ht : IsUnit t)
    (A B L n₀ d₀ n d : ZMod m) :
    affineReciprocalProductPhase m A B L 0 0 (n₀ + t * n) (d₀ + t * d) =
      affineReciprocalProductPhase m (A * (t⁻¹) ^ 2) B L
        ((n₀ + B * d₀) * t⁻¹) ((n₀ + (B + L) * d₀) * t⁻¹) n d := by
  classical
  let u := n + B * d + (n₀ + B * d₀) * t⁻¹
  let v := n + (B + L) * d + (n₀ + (B + L) * d₀) * t⁻¹
  have htt : t * t⁻¹ = 1 := ZMod.mul_inv_of_unit t ht
  have hu : n₀ + t * n + B * (d₀ + t * d) + 0 = t * u := by
    dsimp only [u]
    linear_combination -(n₀ + B * d₀) * htt
  have hv : n₀ + t * n + (B + L) * (d₀ + t * d) + 0 = t * v := by
    dsimp only [v]
    linear_combination -(n₀ + (B + L) * d₀) * htt
  unfold affineReciprocalProductPhase
  rw [hu, hv]
  change (if IsUnit (t * u) ∧ IsUnit (t * v) then
    ZMod.stdAddChar (A * L * ((t * u) * (t * v))⁻¹) else 0) =
      if IsUnit u ∧ IsUnit v then ZMod.stdAddChar ((A * (t⁻¹) ^ 2) * L * (u * v)⁻¹)
      else 0
  simp only [IsUnit.mul_iff, ht, true_and]
  split_ifs with huv
  · have hinv : ((t * u) * (t * v))⁻¹ = (t⁻¹) ^ 2 * (u * v)⁻¹ := by
      apply ZMod.inv_eq_of_mul_eq_one
      calc
        ((t * u) * (t * v)) * ((t⁻¹) ^ 2 * (u * v)⁻¹) =
            (t * t⁻¹) ^ 2 * ((u * v) * (u * v)⁻¹) := by ring
        _ = 1 := by rw [htt, ZMod.mul_inv_of_unit _ (huv.1.mul huv.2)]; norm_num
    rw [hinv]
    congr 1
    ring
  · rfl

theorem affineReciprocalProductPhase_congruence_restriction
    (q r : ℕ) [NeZero q] [NeZero r] (hqr : Nat.Coprime q r)
    (A B L : ZMod (q * r)) (n₀ d₀ : ℤ) :
    let C : ℂ := affineReciprocalProductPhase q
      ((A.val : ZMod q) * (r : ZMod q)⁻¹)
      (B.val : ZMod q) (L.val : ZMod q) 0 0
      (n₀ : ZMod q) (d₀ : ZMod q)
    let A' : ZMod r := (A.val : ZMod r) * ((q : ZMod r)⁻¹) ^ 3
    let B' : ZMod r := (B.val : ZMod r)
    let L' : ZMod r := (L.val : ZMod r)
    let η₁ : ZMod r := ((n₀ : ZMod r) + B' * (d₀ : ZMod r)) * (q : ZMod r)⁻¹
    let η₂ : ZMod r := ((n₀ : ZMod r) + (B' + L') * (d₀ : ZMod r)) *
      (q : ZMod r)⁻¹
    ‖C‖ ≤ 1 ∧ ∀ n d : ℤ,
      affineReciprocalProductPhase (q * r) A B L 0 0
        ((n₀ + (q : ℤ) * n : ℤ) : ZMod (q * r))
        ((d₀ + (q : ℤ) * d : ℤ) : ZMod (q * r)) =
      C * affineReciprocalProductPhase r A' B' L' η₁ η₂
        (n : ZMod r) (d : ZMod r) := by
  dsimp only
  refine ⟨norm_affineReciprocalProductPhase_le_one _ _ _ _ _ _ _ _, ?_⟩
  intro n d
  have hredq (z : ℤ) : (((z : ZMod (q * r)).val : ℕ) : ZMod q) = (z : ZMod q) := by
    rw [ZMod.natCast_val, ZMod.cast_intCast (show q ∣ q * r from ⟨r, rfl⟩)]
  have hredr (z : ℤ) : (((z : ZMod (q * r)).val : ℕ) : ZMod r) = (z : ZMod r) := by
    rw [ZMod.natCast_val,
      ZMod.cast_intCast (show r ∣ q * r from ⟨q, Nat.mul_comm q r⟩)]
  rw [affineReciprocalProductPhase_mul q r hqr]
  rw [hredq, hredq, hredr, hredr]
  simp only [ZMod.val_zero, Nat.cast_zero, Int.cast_add, Int.cast_mul,
    Int.cast_natCast, ZMod.natCast_self, zero_mul, add_zero]
  congr 1
  have ht : IsUnit (q : ZMod r) := (ZMod.isUnit_iff_coprime q r).mpr hqr
  rw [phaseConj_translate_scale r (q : ZMod r) ht]
  congr 1
  ring

theorem doubleCompletion_congruence_scale
    (q r : ℕ) [NeZero q] [NeZero r] (D N : ℝ) :
    (Real.sqrt (r : ℝ) + (N / (q : ℝ)) / Real.sqrt (r : ℝ)) *
      (Real.sqrt (r : ℝ) + (D / (q : ℝ)) / Real.sqrt (r : ℝ)) =
      (1 / (q : ℝ)) *
        (Real.sqrt ((q * r : ℕ) : ℝ) + N / Real.sqrt ((q * r : ℕ) : ℝ)) *
        (Real.sqrt ((q * r : ℕ) : ℝ) + D / Real.sqrt ((q * r : ℕ) : ℝ)) := by
  have hq : (0 : ℝ) < q := by exact_mod_cast NeZero.pos q
  have hr : (0 : ℝ) < r := by exact_mod_cast NeZero.pos r
  have hprod : (0 : ℝ) < (q * r : ℕ) := by
    rw [Nat.cast_mul]
    exact mul_pos hq hr
  have hexpand (t U V : ℝ) (ht : 0 < t) :
      (Real.sqrt t + V / Real.sqrt t) * (Real.sqrt t + U / Real.sqrt t) =
        t + V + U + V * U / t := by
    have hs : Real.sqrt t ≠ 0 := (Real.sqrt_pos.mpr ht).ne'
    calc
      _ = (Real.sqrt t) ^ 2 + V + U + V * U / (Real.sqrt t) ^ 2 := by
        field_simp [hs]
        ring
      _ = _ := by rw [Real.sq_sqrt ht.le]
  calc
    _ = (r : ℝ) + N / (q : ℝ) + D / (q : ℝ) +
        (N / (q : ℝ)) * (D / (q : ℝ)) / (r : ℝ) :=
      hexpand (r : ℝ) (D / (q : ℝ)) (N / (q : ℝ)) hr
    _ = (1 / (q : ℝ)) *
        (((q * r : ℕ) : ℝ) + N + D + N * D / ((q * r : ℕ) : ℝ)) := by
      push_cast
      field_simp [hq.ne', hr.ne']
    _ = _ := by
      rw [← hexpand ((q * r : ℕ) : ℝ) D N hprod]
      ring

theorem affineReciprocalProductPhase_prime_fourier_norm_decomposition
    (p : ℕ) [Fact p.Prime] (A B L η₁ η₂ ξ η : ZMod p) :
    let α : ZMod p := (ξ - (B + L) * η) / L
    let β : ZMod p := (B * η - ξ) / L
    ‖∑ d : ZMod p, ∑ n : ZMod p,
      affineReciprocalProductPhase p A B L η₁ η₂ n d *
        ZMod.stdAddChar (-(d * ξ + n * η))‖ ≤
      if A * L = 0 then (p : ℝ) ^ 2
      else (p : ℝ) * max 1 ‖normalizedKloosterman3 p ((A * L) * α * β)‖ := by
  classical
  intro α β
  by_cases hc : A * L = 0
  · rw [ite_eq_left hc]
    calc
      _ ≤ ∑ d : ZMod p, ∑ n : ZMod p, (1 : ℝ) := by
        refine norm_sum_le_of_le _ fun d _ => ?_
        refine norm_sum_le_of_le _ fun n _ => ?_
        rw [norm_mul, AddChar.norm_apply, mul_one]
        exact norm_affineReciprocalProductPhase_le_one p A B L η₁ η₂ n d
      _ = (p : ℝ) ^ 2 := by simp [pow_two]
  · rw [ite_eq_right hc]
    have hL : L ≠ 0 := (mul_ne_zero_iff.mp hc).2
    have hβ : (-ξ - (-η) * B) / L = β := by
      dsimp only [β]
      congr 1
      ring
    have hα : -η - β = α := by
      dsimp only [α, β]
      field_simp [hL]
      ring
    have hphase := affineReciprocalProductPhase_complete_fourier
      p A B L η₁ η₂ (-η) (-ξ) hL
    dsimp only at hphase
    rw [hβ, hα] at hphase
    have hs : (∑ d : ZMod p, ∑ n : ZMod p,
        affineReciprocalProductPhase p A B L η₁ η₂ n d *
          ZMod.stdAddChar (-(d * ξ + n * η))) =
        ZMod.stdAddChar (β * (η₁ - η₂) - (-η) * η₁) *
          reciprocalProductCompleteSum p α β (A * L) := by
      rw [Finset.sum_comm]
      calc
        _ = ∑ n : ZMod p, ∑ d : ZMod p,
            affineReciprocalProductPhase p A B L η₁ η₂ n d *
              ZMod.stdAddChar ((-η) * n + (-ξ) * d) := by
          apply Finset.sum_congr rfl
          intro n hn
          apply Finset.sum_congr rfl
          intro d hd
          congr 2
          ring
        _ = _ := hphase
    rw [hs, norm_mul, AddChar.norm_apply, one_mul,
      reciprocalProductCompleteSum_classification, ite_eq_right hc]
    have hp1 : (1 : ℝ) ≤ p := by
      exact_mod_cast (Fact.out : p.Prime).one_lt.le
    have hpmax : (p : ℝ) ≤
        (p : ℝ) * max 1 ‖normalizedKloosterman3 p ((A * L) * α * β)‖ :=
      le_mul_of_one_le_right (Nat.cast_nonneg _) (le_max_left _ _)
    by_cases hα0 : α = 0
    · rw [ite_eq_left hα0]
      by_cases hβ0 : β = 0
      · rw [ite_eq_left hβ0]
        have hdiag : ‖(1 : ℂ) - (p : ℂ)‖ ≤ (p : ℝ) := by
          rw [show (1 : ℂ) - (p : ℂ) = ((1 - (p : ℝ) : ℝ) : ℂ) by simp,
            Complex.norm_real, Real.norm_eq_abs, abs_of_nonpos (by linarith)]
          linarith
        exact hdiag.trans hpmax
      · rw [ite_eq_right hβ0, norm_one]
        exact hp1.trans hpmax
    · rw [ite_eq_right hα0]
      by_cases hβ0 : β = 0
      · rw [ite_eq_left hβ0, norm_one]
        exact hp1.trans hpmax
      · rw [ite_eq_right hβ0, norm_mul, Complex.norm_natCast]
        exact mul_le_mul_of_nonneg_left (le_max_right _ _) (Nat.cast_nonneg _)

theorem affineReciprocalProductPhase_squarefree_factors
    (m : ℕ) [NeZero m] (hm : Squarefree m)
    (A B L η₁ η₂ n d : ZMod m) :
    affineReciprocalProductPhase m A B L η₁ η₂ n d =
      ∏ p : m.primeFactors,
        letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
        affineReciprocalProductPhase p.1
          ((A.val : ZMod p.1) * ((m / p.1 : ℕ) : ZMod p.1)⁻¹)
          (B.val : ZMod p.1) (L.val : ZMod p.1)
          (η₁.val : ZMod p.1) (η₂.val : ZMod p.1)
          (n.val : ZMod p.1) (d.val : ZMod p.1) := by
  classical
  have (p : m.primeFactors) : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
  let u : ZMod m := n + B * d + η₁
  let v : ZMod m := n + (B + L) * d + η₂
  have huval (p : m.primeFactors) :
      (u.val : ZMod p.1) =
        (n.val : ZMod p.1) + (B.val : ZMod p.1) * (d.val : ZMod p.1) +
          (η₁.val : ZMod p.1) := by
    rw [← zmod_castHom_apply_eq_natCast_val (Nat.dvd_of_mem_primeFactors p.2)]
    simp only [u, map_add, map_mul, zmod_castHom_apply_eq_natCast_val]
  have hvval (p : m.primeFactors) :
      (v.val : ZMod p.1) =
        (n.val : ZMod p.1) + ((B.val : ZMod p.1) + (L.val : ZMod p.1)) *
          (d.val : ZMod p.1) + (η₂.val : ZMod p.1) := by
    rw [← zmod_castHom_apply_eq_natCast_val (Nat.dvd_of_mem_primeFactors p.2)]
    simp only [v, map_add, map_mul, zmod_castHom_apply_eq_natCast_val]
  have hmask : (IsUnit u ∧ IsUnit v) ↔
      ∀ p : m.primeFactors, (u.val : ZMod p.1) ≠ 0 ∧ (v.val : ZMod p.1) ≠ 0 := by
    rw [unit_iff_prime_samples m u, unit_iff_prime_samples m v, forall_and]
  change (if IsUnit u ∧ IsUnit v then ZMod.stdAddChar (A * L * (u * v)⁻¹) else 0) = _
  by_cases h : IsUnit u ∧ IsUnit v
  · rw [ite_eq_left h, squarefree_character m hm (A * L * (u * v)⁻¹)]
    apply Finset.prod_congr rfl
    intro p hp
    let π := ZMod.castHom (Nat.dvd_of_mem_primeFactors p.2) (ZMod p.1)
    have hinv : π ((u * v)⁻¹) = (π (u * v))⁻¹ := by
      apply eq_inv_of_mul_eq_one_left
      rw [← map_mul, ZMod.inv_mul_of_unit (u * v) (h.1.mul h.2), map_one]
    have hphase : ((A * L * (u * v)⁻¹).val : ZMod p.1) =
        (A.val : ZMod p.1) * (L.val : ZMod p.1) *
          ((u.val : ZMod p.1) * (v.val : ZMod p.1))⁻¹ := by
      rw [← zmod_castHom_apply_eq_natCast_val (Nat.dvd_of_mem_primeFactors p.2)]
      change π (A * L * (u * v)⁻¹) = _
      rw [map_mul, map_mul, hinv, map_mul]
      simp only [π, zmod_castHom_apply_eq_natCast_val]
    dsimp only [affineReciprocalProductPhase]
    rw [← huval p, ← hvval p]
    rw [ite_eq_left ⟨isUnit_iff_ne_zero.mpr (hmask.mp h p).1,
      isUnit_iff_ne_zero.mpr (hmask.mp h p).2⟩, hphase]
    congr 1
    ring
  · rw [ite_eq_right h]
    obtain ⟨p, hp⟩ : ∃ p : m.primeFactors,
        ¬ ((u.val : ZMod p.1) ≠ 0 ∧ (v.val : ZMod p.1) ≠ 0) :=
      not_forall.mp (mt hmask.mpr h)
    symm
    apply Finset.prod_eq_zero (Finset.mem_univ p)
    dsimp only [affineReciprocalProductPhase]
    rw [← huval p, ← hvval p]
    apply ite_eq_right
    simpa only [isUnit_iff_ne_zero] using hp

theorem affineReciprocalProductPhase_squarefree_complete_fourier
    (m : ℕ) [NeZero m] (hm : Squarefree m)
    (A B L η₁ η₂ ξ η : ZMod m) :
    (∑ d : ZMod m, ∑ n : ZMod m,
      affineReciprocalProductPhase m A B L η₁ η₂ n d *
        ZMod.stdAddChar (-(d * ξ + n * η))) =
      ∏ p : m.primeFactors,
        letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
        let e : ZMod p.1 := ((m / p.1 : ℕ) : ZMod p.1)⁻¹
        ∑ d : ZMod p.1, ∑ n : ZMod p.1,
          affineReciprocalProductPhase p.1
            ((A.val : ZMod p.1) * e) (B.val : ZMod p.1) (L.val : ZMod p.1)
            (η₁.val : ZMod p.1) (η₂.val : ZMod p.1) n d *
              ZMod.stdAddChar
                (-(d * (e * (ξ.val : ZMod p.1)) + n * (e * (η.val : ZMod p.1)))) := by
  classical
  have (p : m.primeFactors) : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
  let f (p : m.primeFactors) (d n : ZMod p.1) : ℂ :=
    affineReciprocalProductPhase p.1
      ((A.val : ZMod p.1) * ((m / p.1 : ℕ) : ZMod p.1)⁻¹)
      (B.val : ZMod p.1) (L.val : ZMod p.1)
      (η₁.val : ZMod p.1) (η₂.val : ZMod p.1) n d *
        ZMod.stdAddChar
          (-(d * (((m / p.1 : ℕ) : ZMod p.1)⁻¹ * (ξ.val : ZMod p.1)) +
            n * (((m / p.1 : ℕ) : ZMod p.1)⁻¹ * (η.val : ZMod p.1))))
  change (∑ d : ZMod m, ∑ n : ZMod m,
    affineReciprocalProductPhase m A B L η₁ η₂ n d *
      ZMod.stdAddChar (-(d * ξ + n * η))) = ∏ p : m.primeFactors,
        ∑ d : ZMod p.1, ∑ n : ZMod p.1, f p d n
  have hpoint (d n : ZMod m) :
      affineReciprocalProductPhase m A B L η₁ η₂ n d *
        ZMod.stdAddChar (-(d * ξ + n * η)) =
      ∏ p : m.primeFactors, f p (d.val : ZMod p.1) (n.val : ZMod p.1) := by
    rw [affineReciprocalProductPhase_squarefree_factors m hm,
      squarefree_character m hm (-(d * ξ + n * η)), ← Finset.prod_mul_distrib]
    apply Finset.prod_congr rfl
    intro p hp
    dsimp only [f]
    congr 1
    have hproj : ((-(d * ξ + n * η)).val : ZMod p.1) =
        -((d.val : ZMod p.1) * (ξ.val : ZMod p.1) +
          (n.val : ZMod p.1) * (η.val : ZMod p.1)) := by
      rw [← zmod_castHom_apply_eq_natCast_val (Nat.dvd_of_mem_primeFactors p.2)]
      simp only [map_neg, map_add, map_mul, zmod_castHom_apply_eq_natCast_val]
    rw [hproj]
    congr 1
    ring
  simp_rw [hpoint, squarefree_coordinate_sum m hm]
  exact squarefree_coordinate_sum m hm (fun p d => ∑ n : ZMod p.1, f p d n)

theorem squarefree_exceptional_real_product
    (m k : ℕ) (hm : Squarefree m) :
    (∏ p : m.primeFactors, if (k : ZMod p.1) = 0 then (p.1 : ℝ) else 1) =
      (Nat.gcd m k : ℝ) := by
  classical
  calc
    _ = ∏ p ∈ (Finset.univ : Finset m.primeFactors).filter (fun p => p.1 ∣ k),
        (p.1 : ℝ) := by
      simp only [Finset.prod_filter, ZMod.natCast_eq_zero_iff]
    _ = ∏ p ∈ m.primeFactors.filter (fun p => p ∣ k), (p : ℝ) :=
      by
        simp only [Finset.prod_filter]
        exact Finset.prod_coe_sort (s := m.primeFactors)
          (f := fun p => if p ∣ k then (p : ℝ) else 1)
    _ = (Nat.gcd m k : ℝ) := by
      rw [← Nat.cast_prod, filter_dvd_gcd m k hm]

theorem affineReciprocalProductPhase_squarefree_fourier_max_decomposition
    (m : ℕ) [NeZero m] (hm : Squarefree m)
    (A B L η₁ η₂ : ZMod m) :
    let Fhat : ZMod m × ZMod m → ℂ := fun ζ =>
      ∑ d : ZMod m, ∑ n : ZMod m,
        affineReciprocalProductPhase m A B L η₁ η₂ n d *
          ZMod.stdAddChar (-(d * ζ.1 + n * ζ.2))
    let M : ℝ := (Finset.univ : Finset (ZMod m × ZMod m)).sup'
      Finset.univ_nonempty (fun ζ => ‖Fhat ζ‖)
    let K : (p : m.primeFactors) → ℝ := fun p =>
      letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
      (Finset.univ : Finset (ZMod p.1)).sup' Finset.univ_nonempty
        (fun c => ‖normalizedKloosterman3 p.1 c‖)
    M ≤ (m : ℝ) * (Nat.gcd m (A * L).val : ℝ) *
      ∏ p : m.primeFactors,
        if ((A * L).val : ZMod p.1) = 0 then 1 else max 1 (K p) := by
  classical
  intro Fhat M K
  have (p : m.primeFactors) : Fact p.1.Prime :=
    ⟨Nat.prime_of_mem_primeFactors p.2⟩
  have hK (p : m.primeFactors) (c : ZMod p.1) :
      ‖normalizedKloosterman3 p.1 c‖ ≤ K p :=
    Finset.le_sup' (fun c => ‖normalizedKloosterman3 p.1 c‖) (Finset.mem_univ c)
  have hprimes : (∏ p : m.primeFactors, (p.1 : ℝ)) = (m : ℝ) := by
    rw [← Nat.cast_prod, prod_primeFactors_subtype_eq_of_squarefree hm]
  apply Finset.sup'_le
  intro ζ hζ
  let e (p : m.primeFactors) : ZMod p.1 := ((m / p.1 : ℕ) : ZMod p.1)⁻¹
  let C (p : m.primeFactors) : ℂ :=
    ∑ d : ZMod p.1, ∑ n : ZMod p.1,
      affineReciprocalProductPhase p.1
        ((A.val : ZMod p.1) * e p) (B.val : ZMod p.1) (L.val : ZMod p.1)
        (η₁.val : ZMod p.1) (η₂.val : ZMod p.1) n d *
          ZMod.stdAddChar
            (-(d * (e p * (ζ.1.val : ZMod p.1)) + n * (e p * (ζ.2.val : ZMod p.1))))
  have hfactor : Fhat ζ = ∏ p : m.primeFactors, C p :=
    affineReciprocalProductPhase_squarefree_complete_fourier m hm A B L η₁ η₂ ζ.1 ζ.2
  have hlocal (p : m.primeFactors) : ‖C p‖ ≤
      (p.1 : ℝ) * (if ((A * L).val : ZMod p.1) = 0 then (p.1 : ℝ) else 1) *
        (if ((A * L).val : ZMod p.1) = 0 then 1 else max 1 (K p)) := by
    have he : e p ≠ 0 := inv_ne_zero (isUnit_cofactor_of_squarefree hm p.2).ne_zero
    have hproj : (A.val : ZMod p.1) * (L.val : ZMod p.1) =
        ((A * L).val : ZMod p.1) := by
      rw [← zmod_castHom_apply_eq_natCast_val (Nat.dvd_of_mem_primeFactors p.2) (A * L), map_mul,
        zmod_castHom_apply_eq_natCast_val (Nat.dvd_of_mem_primeFactors p.2) A,
        zmod_castHom_apply_eq_natCast_val (Nat.dvd_of_mem_primeFactors p.2) L]
    have hzero : (A.val : ZMod p.1) * e p * (L.val : ZMod p.1) = 0 ↔
        ((A * L).val : ZMod p.1) = 0 := by
      rw [show (A.val : ZMod p.1) * e p * (L.val : ZMod p.1) =
          e p * ((A * L).val : ZMod p.1) by rw [← hproj]; ring]
      exact mul_eq_zero.trans (or_iff_right he)
    have hb := affineReciprocalProductPhase_prime_fourier_norm_decomposition p.1
      ((A.val : ZMod p.1) * e p) (B.val : ZMod p.1) (L.val : ZMod p.1)
      (η₁.val : ZMod p.1) (η₂.val : ZMod p.1)
      (e p * (ζ.1.val : ZMod p.1)) (e p * (ζ.2.val : ZMod p.1))
    dsimp only at hb
    by_cases hz : ((A * L).val : ZMod p.1) = 0
    · rw [ite_eq_left (hzero.mpr hz)] at hb
      simpa only [ite_eq_left hz, mul_one, pow_two] using hb
    · rw [ite_eq_right ((not_congr hzero).mpr hz)] at hb
      apply hb.trans
      simp only [ite_eq_right hz, mul_one]
      exact mul_le_mul_of_nonneg_left (max_le_max le_rfl (hK p _)) (Nat.cast_nonneg _)
  rw [hfactor, norm_prod]
  calc
    _ ≤ ∏ p : m.primeFactors,
        (p.1 : ℝ) * (if ((A * L).val : ZMod p.1) = 0 then (p.1 : ℝ) else 1) *
          (if ((A * L).val : ZMod p.1) = 0 then 1 else max 1 (K p)) :=
      Finset.prod_le_prod (fun _ _ => norm_nonneg _) (fun p _ => hlocal p)
    _ = ((∏ p : m.primeFactors, (p.1 : ℝ)) *
        (∏ p : m.primeFactors,
          if ((A * L).val : ZMod p.1) = 0 then (p.1 : ℝ) else 1)) *
          ∏ p : m.primeFactors,
            if ((A * L).val : ZMod p.1) = 0 then 1 else max 1 (K p) := by
      rw [Finset.prod_mul_distrib, Finset.prod_mul_distrib]
    _ = _ := by
      rw [hprimes, squarefree_exceptional_real_product m (A * L).val hm]

theorem integerPair_congruence_hasSum_iff
    (q : ℕ) [NeZero q] (dStar nStar : ℤ) (F : ℤ × ℤ → ℂ) (S : ℂ) :
    HasSum (fun z : ℤ × ℤ =>
      if Int.ModEq (q : ℤ) dStar z.1 ∧ Int.ModEq (q : ℤ) nStar z.2
      then F z else 0) S ↔
      HasSum (fun z : ℤ × ℤ =>
        F (dStar + (q : ℤ) * z.1, nStar + (q : ℤ) * z.2)) S := by
  classical
  let ι : ℤ × ℤ → ℤ × ℤ := fun z =>
    (dStar + (q : ℤ) * z.1, nStar + (q : ℤ) * z.2)
  let G : ℤ × ℤ → ℂ := fun z =>
    if Int.ModEq (q : ℤ) dStar z.1 ∧ Int.ModEq (q : ℤ) nStar z.2
    then F z else 0
  have hι : Function.Injective ι := by
    intro x y h
    apply Prod.ext
    · have h₁ := congrArg Prod.fst h
      exact mul_left_cancel₀ (NeZero.ne (q : ℤ)) (add_left_cancel h₁)
    · have h₂ := congrArg Prod.snd h
      exact mul_left_cancel₀ (NeZero.ne (q : ℤ)) (add_left_cancel h₂)
  have hrange (z : ℤ × ℤ) : z ∈ Set.range ι ↔
      Int.ModEq (q : ℤ) dStar z.1 ∧ Int.ModEq (q : ℤ) nStar z.2 := by
    constructor
    · rintro ⟨w, rfl⟩
      exact ⟨Int.modEq_iff_add_fac.mpr ⟨w.1, rfl⟩,
        Int.modEq_iff_add_fac.mpr ⟨w.2, rfl⟩⟩
    · intro h
      obtain ⟨u, hu⟩ := Int.modEq_iff_add_fac.mp h.1
      obtain ⟨v, hv⟩ := Int.modEq_iff_add_fac.mp h.2
      exact ⟨(u, v), Prod.ext hu.symm hv.symm⟩
  have hzero (z : ℤ × ℤ) (hz : z ∉ Set.range ι) : G z = 0 :=
    ite_eq_right (fun h => hz ((hrange z).mpr h))
  have hcomp (z : ℤ × ℤ) : G (ι z) = F (ι z) :=
    ite_eq_left ((hrange (ι z)).mp ⟨z, rfl⟩)
  simpa only [Function.comp_def, hcomp] using
    (hι.hasSum_iff (f := G) (a := S) hzero).symm

theorem congruence_residual_numerator_gcd
    (q r : ℕ) [NeZero q] [NeZero r] (hqr : Nat.Coprime q r)
    (A L : ZMod (q * r)) :
    let A' : ZMod r := (A.val : ZMod r) * ((q : ZMod r)⁻¹) ^ 3
    Nat.gcd r (A' * (L.val : ZMod r)).val = Nat.gcd r (A * L).val ∧
      Nat.gcd r (A' * (L.val : ZMod r)).val ≤ Nat.gcd (q * r) (A * L).val := by
  dsimp only
  let u : ZMod r := ((q : ZMod r)⁻¹) ^ 3
  have hu : IsUnit u := by
    obtain ⟨v, hv⟩ := (ZMod.isUnit_iff_coprime q r).mpr hqr
    dsimp only [u]
    rw [← hv, ZMod.inv_coe_unit]
    exact IsUnit.pow 3 (v⁻¹).isUnit
  have hmod (k : ℕ) : Nat.gcd r (k % r) = Nat.gcd r k :=
    (Nat.gcd_comm r (k % r)).trans (Nat.gcd_rec r k).symm
  have hmul (x z : ZMod r) (hz : IsUnit z) :
      Nat.gcd r (x * z).val = Nat.gcd r x.val := by
    obtain ⟨v, rfl⟩ := hz
    rw [ZMod.val_mul, hmod]
    exact Nat.Coprime.gcd_mul_right_cancel_right x.val (ZMod.val_coe_unit_coprime v)
  have hrdiv : r ∣ q * r := ⟨q, Nat.mul_comm q r⟩
  have hred : ((A * L).val : ZMod r) =
      (A.val : ZMod r) * (L.val : ZMod r) := by
    simpa only [ZMod.natCast_val] using
      (ZMod.cast_mul hrdiv A L : (ZMod.cast (A * L) : ZMod r) =
        ZMod.cast A * ZMod.cast L)
  have hproduct : (A.val : ZMod r) * u * (L.val : ZMod r) =
      ((A * L).val : ZMod r) * u := by
    rw [hred]
    ring
  have heq : Nat.gcd r ((A.val : ZMod r) * u * (L.val : ZMod r)).val =
      Nat.gcd r (A * L).val := by
    rw [hproduct, hmul _ _ hu, ZMod.val_natCast, hmod]
  have hle : Nat.gcd r (A * L).val ≤ Nat.gcd (q * r) (A * L).val :=
    Nat.le_of_dvd (Nat.gcd_pos_of_pos_left _ (Nat.mul_pos (NeZero.pos q) (NeZero.pos r)))
      (Nat.gcd_dvd_gcd_of_dvd_left _ hrdiv)
  exact ⟨heq, heq.le.trans hle⟩

open Classical in
theorem reciprocalPairHypersurface_additive_fourier
    (p : ℕ) [Fact p.Prime] (α₁ α₂ h : ZMod p) :
    (∑ β : ZMod p,
      (∑ x : (ZMod p)ˣ, ∑ y : (ZMod p)ˣ,
        ∑ z : (ZMod p)ˣ, ∑ t : (ZMod p)ˣ,
          if α₁ / ((x : ZMod p) * (y : ZMod p)) +
              α₂ / ((z : ZMod p) * (t : ZMod p)) = β then
            ZMod.stdAddChar
              ((x : ZMod p) + (y : ZMod p) + (z : ZMod p) + (t : ZMod p))
          else 0) * ZMod.stdAddChar (h * β)) =
      (p : ℂ) ^ 2 * normalizedKloosterman3 p (α₁ * h) *
        normalizedKloosterman3 p (α₂ * h) := by
  have hp : (p : ℂ) ≠ 0 := NeZero.ne _
  let f (a : ZMod p) (x y : (ZMod p)ˣ) : ℂ :=
    ZMod.stdAddChar
      ((a * h) / ((x : ZMod p) * (y : ZMod p)) + (x : ZMod p) + (y : ZMod p))
  have hnorm (a : ZMod p) :
      (p : ℂ) * normalizedKloosterman3 p (a * h) =
        ∑ x : (ZMod p)ˣ, ∑ y : (ZMod p)ˣ, f a x y := by
    rw [normalizedKloosterman3_eq_doubleUnitSum]
    unfold reciprocalProductCompleteSum
    simp only [mul_inv_cancel_left₀ hp, one_mul, f]
  have hcollapse (x y z t : (ZMod p)ˣ) :
      (∑ β : ZMod p,
        (if α₁ / ((x : ZMod p) * (y : ZMod p)) +
            α₂ / ((z : ZMod p) * (t : ZMod p)) = β then
          ZMod.stdAddChar
            ((x : ZMod p) + (y : ZMod p) + (z : ZMod p) + (t : ZMod p))
        else 0) * ZMod.stdAddChar (h * β)) = f α₁ x y * f α₂ z t := by
    simp only [ite_mul, zero_mul, Finset.sum_ite_eq, Finset.mem_univ, ite_true, f]
    rw [← map_add_eq_mul, ← map_add_eq_mul]
    congr 1
    simp only [div_eq_mul_inv]
    ring
  calc
    _ = ∑ x : (ZMod p)ˣ, ∑ y : (ZMod p)ˣ,
        ∑ z : (ZMod p)ˣ, ∑ t : (ZMod p)ˣ,
          ∑ β : ZMod p,
            (if α₁ / ((x : ZMod p) * (y : ZMod p)) +
                α₂ / ((z : ZMod p) * (t : ZMod p)) = β then
              ZMod.stdAddChar
                ((x : ZMod p) + (y : ZMod p) + (z : ZMod p) + (t : ZMod p))
            else 0) * ZMod.stdAddChar (h * β) := by
      simp_rw [Finset.sum_mul,
        Finset.sum_comm (s := (Finset.univ : Finset (ZMod p)))]
    _ = (∑ x : (ZMod p)ˣ, ∑ y : (ZMod p)ˣ, f α₁ x y) *
        (∑ z : (ZMod p)ˣ, ∑ t : (ZMod p)ˣ, f α₂ z t) := by
      simp_rw [hcollapse, Finset.sum_mul, Finset.mul_sum]
    _ = (p : ℂ) ^ 2 * normalizedKloosterman3 p (α₁ * h) *
        normalizedKloosterman3 p (α₂ * h) := by
      rw [← hnorm α₁, ← hnorm α₂]
      ring

open Classical in
theorem normalizedKloosterman3_correlation_eq_hypersurface
    (p : ℕ) [Fact p.Prime] (a b h : ZMod p) :
    (∑ v : ZMod p,
      normalizedKloosterman3 p (a * v) *
        star (normalizedKloosterman3 p (b * v)) * ZMod.stdAddChar (h * v)) =
      (p : ℂ)⁻¹ *
        (∑ x : (ZMod p)ˣ, ∑ y : (ZMod p)ˣ,
          ∑ z : (ZMod p)ˣ, ∑ t : (ZMod p)ˣ,
            if a / ((x : ZMod p) * (y : ZMod p)) +
                (-b) / ((z : ZMod p) * (t : ZMod p)) = -h then
              ZMod.stdAddChar
                ((x : ZMod p) + (y : ZMod p) + (z : ZMod p) + (t : ZMod p))
            else 0) := by
  have hp : (p : ℂ) ≠ 0 := NeZero.ne _
  let S (β : ZMod p) : ℂ :=
    ∑ x : (ZMod p)ˣ, ∑ y : (ZMod p)ˣ,
      ∑ z : (ZMod p)ˣ, ∑ t : (ZMod p)ˣ,
        if a / ((x : ZMod p) * (y : ZMod p)) +
            (-b) / ((z : ZMod p) * (t : ZMod p)) = β then
          ZMod.stdAddChar
            ((x : ZMod p) + (y : ZMod p) + (z : ZMod p) + (t : ZMod p))
        else 0
  have hstar (c : ZMod p) :
      star (normalizedKloosterman3 p c) = normalizedKloosterman3 p (-c) := by
    rw [normalizedKloosterman3_eq_doubleUnitSum p c,
      normalizedKloosterman3_eq_doubleUnitSum p (-c)]
    unfold reciprocalProductCompleteSum
    simp only [star_mul', star_inv₀, star_natCast]
    congr 1
    simp only [star_sum]
    refine Fintype.sum_equiv (Equiv.mulLeft (-1 : (ZMod p)ˣ)) _ _ ?_
    intro x
    refine Fintype.sum_equiv (Equiv.mulLeft (-1 : (ZMod p)ˣ)) _ _ ?_
    intro y
    simp only [Complex.star_def, ← AddChar.map_neg_eq_conj, Equiv.coe_mulLeft,
      neg_one_mul, Units.val_neg, one_mul, neg_mul_neg, neg_div]
    congr 1
    ring
  have hfourier (ξ : ZMod p) :
      ZMod.dft S ξ =
        (p : ℂ) ^ 2 * normalizedKloosterman3 p (a * (-ξ)) *
          normalizedKloosterman3 p ((-b) * (-ξ)) := by
    simpa only [ZMod.dft_apply, smul_eq_mul, S, neg_mul, mul_neg, mul_comm] using
      reciprocalPairHypersurface_additive_fourier p a (-b) (-ξ)
  have hdouble :
      ZMod.dft (ZMod.dft S) h =
        (p : ℂ) ^ 2 *
          ∑ v : ZMod p, normalizedKloosterman3 p (a * v) *
            star (normalizedKloosterman3 p (b * v)) * ZMod.stdAddChar (h * v) := by
    rw [ZMod.dft_apply]
    simp only [smul_eq_mul, hfourier]
    rw [Finset.mul_sum]
    refine Fintype.sum_equiv (Equiv.neg (ZMod p)) _ _ ?_
    intro ξ
    simp only [Equiv.neg_apply, hstar, mul_neg, neg_mul, neg_neg]
    rw [mul_comm ξ h]
    ring
  change (∑ v : ZMod p, normalizedKloosterman3 p (a * v) *
      star (normalizedKloosterman3 p (b * v)) * ZMod.stdAddChar (h * v)) =
    (p : ℂ)⁻¹ * S (-h)
  apply (eq_inv_mul_iff_mul_eq₀ hp).2
  apply mul_left_cancel₀ hp
  simpa only [smul_eq_mul, pow_two, mul_assoc] using
    hdouble.symm.trans (congrFun (ZMod.dft_dft S) h)

open Classical in
theorem normalizedKloosterman3_unit_correlation_eq_hypersurface
    (p : ℕ) [Fact p.Prime] (a b h : ZMod p) :
    (∑ v : (ZMod p)ˣ,
      normalizedKloosterman3 p (a * (v : ZMod p)) *
        star (normalizedKloosterman3 p (b * (v : ZMod p))) *
          ZMod.stdAddChar (h * (v : ZMod p))) =
      (p : ℂ)⁻¹ *
        (∑ x : (ZMod p)ˣ, ∑ y : (ZMod p)ˣ,
          ∑ z : (ZMod p)ˣ, ∑ t : (ZMod p)ˣ,
            if a / ((x : ZMod p) * (y : ZMod p)) +
                (-b) / ((z : ZMod p) * (t : ZMod p)) = -h then
              ZMod.stdAddChar
                ((x : ZMod p) + (y : ZMod p) + (z : ZMod p) + (t : ZMod p))
            else 0) - ((p : ℂ)⁻¹) ^ 2 := by
  rw [sum_units_eq_sum_sub_zero p (fun v : ZMod p =>
    normalizedKloosterman3 p (a * v) *
      star (normalizedKloosterman3 p (b * v)) * ZMod.stdAddChar (h * v)),
    normalizedKloosterman3_correlation_eq_hypersurface]
  simp only [mul_zero, normalizedKloosterman3_zero, star_inv₀, star_natCast,
    map_zero_eq_one, mul_one, pow_two]

open Classical in
theorem unnormalizedKloosterman2_norm_le_two_mul_sqrt
    (p : ℕ) [Fact p.Prime] (c : ZMod p) (hc : c ≠ 0) :
    ‖unnormalizedKloosterman2 p c‖ ≤ 2 * Real.sqrt (p : ℝ) := by
  have hbound := masked_reciprocal_primeField_sum_norm_le p
    ({0} : Finset (ZMod p)) (fun _ : ZMod p => c) 1 0 ⟨0, by simp, hc⟩
  have hsum : unnormalizedKloosterman2 p c =
      ∑ x : ZMod p, if x = 0 then 0 else ZMod.stdAddChar (x + c / x) := by
    simpa only [unnormalizedKloosterman2, ite_not] using
      sum_units_eq_sum_ite p (fun x : ZMod p => ZMod.stdAddChar (x + c / x))
  rw [hsum]
  simpa [hc] using hbound

open Classical in
theorem normalizedKloosterman3_unit_fourier_norm_le_three_mul_sqrt
    (p : ℕ) [Fact p.Prime] (a h : ZMod p) (ha : a ≠ 0) :
    ‖∑ x : (ZMod p)ˣ,
      normalizedKloosterman3 p (a * (x : ZMod p)) *
        ZMod.stdAddChar (h * (x : ZMod p))‖ ≤ 3 * Real.sqrt (p : ℝ) := by
  have hp1 : (1 : ℝ) ≤ p := by exact_mod_cast (Fact.out : p.Prime).one_le
  have hinv : (p : ℝ)⁻¹ ≤ 1 := by
    simpa using inv_anti₀ zero_lt_one hp1
  have hsqrt : (1 : ℝ) ≤ Real.sqrt (p : ℝ) := Real.one_le_sqrt.mpr hp1
  have hscale :
      (∑ x : (ZMod p)ˣ,
        normalizedKloosterman3 p (a * (x : ZMod p)) *
          ZMod.stdAddChar (h * (x : ZMod p))) =
        ∑ x : (ZMod p)ˣ, normalizedKloosterman3 p (x : ZMod p) *
          ZMod.stdAddChar ((h / a) * (x : ZMod p)) := by
    refine Fintype.sum_equiv (Equiv.mulLeft (Units.mk0 a ha)) _ _ ?_
    intro x
    simp only [Equiv.coe_mulLeft, Units.val_mul, Units.val_mk0]
    congr 1
    apply congrArg ZMod.stdAddChar
    field_simp [ha]
  rw [hscale, normalizedKloosterman3_unit_fourier]
  by_cases hh : h / a = 0
  · rw [ite_eq_left hh]
    simp only [norm_neg, norm_inv, Complex.norm_natCast]
    linarith
  · rw [ite_eq_right hh]
    have hk := unnormalizedKloosterman2_norm_le_two_mul_sqrt p
      (-((h / a)⁻¹)) (neg_ne_zero.mpr (inv_ne_zero hh))
    calc
      _ ≤ ‖unnormalizedKloosterman2 p (-((h / a)⁻¹))‖ + ‖(p : ℂ)⁻¹‖ :=
        norm_sub_le _ _
      _ ≤ 2 * Real.sqrt (p : ℝ) + 1 :=
        add_le_add hk (by simpa only [norm_inv, Complex.norm_natCast] using hinv)
      _ ≤ 3 * Real.sqrt (p : ℝ) := by linarith

open Classical in
theorem normalizedKloosterman3_prime_local_bounds_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (p : ℕ) [Fact p.Prime] :
    (∀ c : ZMod p, ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ a h : ZMod p, a ≠ 0 →
        ‖∑ x : (ZMod p)ˣ,
          normalizedKloosterman3 p (a * (x : ZMod p)) *
            ZMod.stdAddChar (h * (x : ZMod p))‖ ≤ 3 * Real.sqrt (p : ℝ)) ∧
      (∀ a b h : ZMod p, a ≠ 0 → b ≠ 0 →
        ‖∑ x : (ZMod p)ˣ,
          normalizedKloosterman3 p (a * (x : ZMod p)) *
            star (normalizedKloosterman3 p (b * (x : ZMod p))) *
              ZMod.stdAddChar (h * (x : ZMod p))‖ ≤
          if h = 0 ∧ a = b then (p : ℝ) else 9 * Real.sqrt (p : ℝ)) := by
  have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast (Fact.out : p.Prime).two_le
  have hp0 : (0 : ℝ) < p := lt_of_lt_of_le (by norm_num) hp2
  have hi0 : 0 ≤ (p : ℝ)⁻¹ := inv_nonneg.mpr hp0.le
  have hi2 : (p : ℝ)⁻¹ ≤ (1 / 2 : ℝ) := by
    simpa using inv_anti₀ (by norm_num : (0 : ℝ) < 2) hp2
  have hisq : ((p : ℝ)⁻¹) ^ 2 ≤ (1 / 4 : ℝ) := by nlinarith
  have hsqrt : (1 : ℝ) ≤ Real.sqrt (p : ℝ) :=
    Real.one_le_sqrt.mpr (by linarith)
  refine ⟨?_, fun a h ha =>
    normalizedKloosterman3_unit_fourier_norm_le_three_mul_sqrt p a h ha, ?_⟩
  · intro c
    by_cases hc : c = 0
    · subst c
      rw [normalizedKloosterman3_zero]
      simp only [norm_inv, Complex.norm_natCast]
      linarith
    · exact hDeligne.1 p c hc
  · intro a b h ha hb
    by_cases hh : h = 0
    · subst h
      conv_lhs => simp only [zero_mul, map_zero_eq_one, mul_one]
      rw [normalizedKloosterman3_unit_correlation_zero p a b ha hb]
      have hreal :
          (if a = b then (p : ℂ) else 0) - 1 - (p : ℂ)⁻¹ - ((p : ℂ)⁻¹) ^ 2 =
            (((if a = b then (p : ℝ) else 0) - 1 - (p : ℝ)⁻¹ -
              ((p : ℝ)⁻¹) ^ 2 : ℝ) : ℂ) := by
        split_ifs <;> push_cast <;> rfl
      rw [hreal, Complex.norm_real, Real.norm_eq_abs]
      by_cases hab : a = b
      · rw [ite_eq_left hab, ite_eq_left (show (0 : ZMod p) = 0 ∧ a = b from ⟨rfl, hab⟩)]
        apply abs_le.mpr
        constructor <;> nlinarith [sq_nonneg ((p : ℝ)⁻¹)]
      · rw [ite_eq_right hab,
          ite_eq_right (show ¬ ((0 : ZMod p) = 0 ∧ a = b) from fun hd => hab hd.2)]
        apply abs_le.mpr
        constructor <;> nlinarith [sq_nonneg ((p : ℝ)⁻¹)]
    · rw [ite_eq_right (show ¬ (h = 0 ∧ a = b) from fun hd => hh hd.1),
        normalizedKloosterman3_unit_correlation_nonzero p a b h ha hb hh]
      let T : ℂ := ∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
        unnormalizedKloosterman2 p (a / (h * t)) *
          unnormalizedKloosterman2 p (b / (h * (t + 1))) else 0
      have hT : ‖T‖ ≤ 8 * (p : ℝ) * Real.sqrt (p : ℝ) := by
        simpa only [T, div_div] using
          hDeligne.2 p (a / h) (b / h) (div_ne_zero ha hh) (div_ne_zero hb hh)
      change ‖(p : ℂ)⁻¹ * T - ((p : ℂ)⁻¹) ^ 2‖ ≤ 9 * Real.sqrt (p : ℝ)
      calc
        _ ≤ ‖(p : ℂ)⁻¹ * T‖ + ‖((p : ℂ)⁻¹) ^ 2‖ := norm_sub_le _ _
        _ = (p : ℝ)⁻¹ * ‖T‖ + ((p : ℝ)⁻¹) ^ 2 := by
          simp only [norm_mul, norm_pow, norm_inv, Complex.norm_natCast]
        _ ≤ (p : ℝ)⁻¹ * (8 * (p : ℝ) * Real.sqrt (p : ℝ)) + ((p : ℝ)⁻¹) ^ 2 :=
          add_le_add (mul_le_mul_of_nonneg_left hT hi0) le_rfl
        _ = 8 * Real.sqrt (p : ℝ) + ((p : ℝ)⁻¹) ^ 2 := by
          field_simp [hp0.ne']
        _ ≤ 9 * Real.sqrt (p : ℝ) := by nlinarith

theorem sum_units_crt_twist
    (m n : ℕ) [NeZero m] [NeZero n] (hmn : m.Coprime n)
    (f : ZMod m → ℂ) (g : ZMod n → ℂ) (k : ℤ) :
    (∑ h : (ZMod (m * n))ˣ,
      f ((h : ZMod (m * n)).val : ZMod m) *
        g ((h : ZMod (m * n)).val : ZMod n) *
          ZMod.stdAddChar ((k : ZMod (m * n)) * (h : ZMod (m * n)))) =
      (∑ h : (ZMod m)ˣ,
        f (h : ZMod m) *
          ZMod.stdAddChar (((k : ZMod m) * (n : ZMod m)⁻¹) * (h : ZMod m))) *
      (∑ h : (ZMod n)ˣ,
        g (h : ZMod n) *
          ZMod.stdAddChar (((k : ZMod n) * (m : ZMod n)⁻¹) * (h : ZMod n))) := by
  have hchar (x : ZMod (m * n)) :
      ZMod.stdAddChar ((k : ZMod (m * n)) * x) =
        ZMod.stdAddChar (((k : ZMod m) * (n : ZMod m)⁻¹) * (x.val : ZMod m)) *
          ZMod.stdAddChar (((k : ZMod n) * (m : ZMod n)⁻¹) * (x.val : ZMod n)) := by
    have hm : (ZMod.chineseRemainder hmn x).1 = (x.val : ZMod m) := by
      change (ZMod.cast x : ZMod m × ZMod n).1 = _
      rw [Prod.fst_zmod_cast, ← ZMod.natCast_val]
    have hn : (ZMod.chineseRemainder hmn x).2 = (x.val : ZMod n) := by
      change (ZMod.cast x : ZMod m × ZMod n).2 = _
      rw [Prod.snd_zmod_cast, ← ZMod.natCast_val]
    simpa only [map_mul, map_intCast, Prod.fst_mul, Prod.snd_mul,
      Prod.fst_intCast, Prod.snd_intCast, hm, hn, mul_assoc, mul_left_comm, mul_comm] using
      stdAddChar_coprime_crt m n hmn ((k : ZMod (m * n)) * x)
  calc
    _ = ∑ h : (ZMod (m * n))ˣ,
        (f ((h : ZMod (m * n)).val : ZMod m) *
          ZMod.stdAddChar (((k : ZMod m) * (n : ZMod m)⁻¹) *
            ((h : ZMod (m * n)).val : ZMod m))) *
        (g ((h : ZMod (m * n)).val : ZMod n) *
          ZMod.stdAddChar (((k : ZMod n) * (m : ZMod n)⁻¹) *
            ((h : ZMod (m * n)).val : ZMod n))) := by
      apply Finset.sum_congr rfl
      intro h _
      rw [hchar]
      ring
    _ = _ := sum_units_crt m n hmn
      (fun x => f x * ZMod.stdAddChar (((k : ZMod m) * (n : ZMod m)⁻¹) * x))
      (fun x => g x * ZMod.stdAddChar (((k : ZMod n) * (m : ZMod n)⁻¹) * x))

theorem sum_units_inv_cube_twist
    (q r : ℕ) [NeZero q] (hrq : r.Coprime q) (f : ZMod q → ℂ) (k : ℤ) :
    (∑ h : (ZMod q)ˣ,
      f ((h : ZMod q) * ((r : ZMod q)⁻¹) ^ 3) *
        ZMod.stdAddChar (((k : ZMod q) * (r : ZMod q)⁻¹) * (h : ZMod q))) =
      ∑ h : (ZMod q)ˣ,
        f (h : ZMod q) *
          ZMod.stdAddChar (((k * (r : ℤ) ^ 2 : ℤ) : ZMod q) * (h : ZMod q)) := by
  have harg (x : ZMod q) :
      ((k * (r : ℤ) ^ 2 : ℤ) : ZMod q) * (((r : ZMod q)⁻¹) ^ 3 * x) =
        ((k : ZMod q) * (r : ZMod q)⁻¹) * x := by
    push_cast
    calc
      _ = ((k : ZMod q) * (r : ZMod q)⁻¹) * x *
          ((r : ZMod q) * (r : ZMod q)⁻¹) ^ 2 := by ring
      _ = _ := by rw [ZMod.coe_mul_inv_eq_one r hrq]; ring
  calc
    _ = ∑ h : (ZMod q)ˣ,
        f (((r : ZMod q)⁻¹) ^ 3 * (h : ZMod q)) *
          ZMod.stdAddChar (((k * (r : ℤ) ^ 2 : ℤ) : ZMod q) *
            (((r : ZMod q)⁻¹) ^ 3 * (h : ZMod q))) := by
      apply Finset.sum_congr rfl
      intro h _
      rw [harg]
      congr 2
      exact mul_comm _ _
    _ = _ := sum_units_mul q
      (fun x => f x * ZMod.stdAddChar (((k * (r : ℤ) ^ 2 : ℤ) : ZMod q) * x))
      (((r : ZMod q)⁻¹) ^ 3) (isUnit_inv_cube q r hrq)

theorem kl3Mod_single_twisted_mul
    (m n : ℕ) [NeZero m] [NeZero n] (hmn : m.Coprime n) (a k : ℤ) :
    (∑ h : (ZMod (m * n))ˣ,
      normalizedKloosterman3Mod (m * n) ((a : ZMod (m * n)) * (h : ZMod (m * n))) *
        ZMod.stdAddChar ((k : ZMod (m * n)) * (h : ZMod (m * n)))) =
      (∑ h : (ZMod m)ˣ,
        normalizedKloosterman3Mod m ((a : ZMod m) * (h : ZMod m)) *
          ZMod.stdAddChar (((k * (n : ℤ) ^ 2 : ℤ) : ZMod m) * (h : ZMod m))) *
      (∑ h : (ZMod n)ˣ,
        normalizedKloosterman3Mod n ((a : ZMod n) * (h : ZMod n)) *
          ZMod.stdAddChar (((k * (m : ℤ) ^ 2 : ℤ) : ZMod n) * (h : ZMod n))) := by
  let f (x : ZMod m) :=
    normalizedKloosterman3Mod m ((a : ZMod m) * x * ((n : ZMod m)⁻¹) ^ 3)
  let g (x : ZMod n) :=
    normalizedKloosterman3Mod n ((a : ZMod n) * x * ((m : ZMod n)⁻¹) ^ 3)
  calc
    _ = ∑ h : (ZMod (m * n))ˣ,
        f ((h : ZMod (m * n)).val : ZMod m) *
          g ((h : ZMod (m * n)).val : ZMod n) *
            ZMod.stdAddChar ((k : ZMod (m * n)) * (h : ZMod (m * n))) := by
      apply Finset.sum_congr rfl
      intro h _
      rw [kloosterman3Mod_int_mul_crt m n hmn]
    _ = (∑ h : (ZMod m)ˣ,
        f (h : ZMod m) *
          ZMod.stdAddChar (((k : ZMod m) * (n : ZMod m)⁻¹) * (h : ZMod m))) *
      (∑ h : (ZMod n)ˣ,
        g (h : ZMod n) *
          ZMod.stdAddChar (((k : ZMod n) * (m : ZMod n)⁻¹) * (h : ZMod n))) :=
      sum_units_crt_twist m n hmn f g k
    _ = _ := by
      congr 1
      · simpa only [f, mul_assoc] using sum_units_inv_cube_twist m n hmn.symm
          (fun x => normalizedKloosterman3Mod m ((a : ZMod m) * x)) k
      · simpa only [g, mul_assoc] using sum_units_inv_cube_twist n m hmn
          (fun x => normalizedKloosterman3Mod n ((a : ZMod n) * x)) k

theorem kl3Mod_pair_twisted_mul
    (m n : ℕ) [NeZero m] [NeZero n] (hmn : m.Coprime n) (a b k : ℤ) :
    (∑ h : (ZMod (m * n))ˣ,
      normalizedKloosterman3Mod (m * n) ((a : ZMod (m * n)) * (h : ZMod (m * n))) *
        star (normalizedKloosterman3Mod (m * n)
          ((b : ZMod (m * n)) * (h : ZMod (m * n)))) *
            ZMod.stdAddChar ((k : ZMod (m * n)) * (h : ZMod (m * n)))) =
      (∑ h : (ZMod m)ˣ,
        normalizedKloosterman3Mod m ((a : ZMod m) * (h : ZMod m)) *
          star (normalizedKloosterman3Mod m ((b : ZMod m) * (h : ZMod m))) *
            ZMod.stdAddChar (((k * (n : ℤ) ^ 2 : ℤ) : ZMod m) * (h : ZMod m))) *
      (∑ h : (ZMod n)ˣ,
        normalizedKloosterman3Mod n ((a : ZMod n) * (h : ZMod n)) *
          star (normalizedKloosterman3Mod n ((b : ZMod n) * (h : ZMod n))) *
            ZMod.stdAddChar (((k * (m : ℤ) ^ 2 : ℤ) : ZMod n) * (h : ZMod n))) := by
  let f (x : ZMod m) :=
    normalizedKloosterman3Mod m ((a : ZMod m) * x * ((n : ZMod m)⁻¹) ^ 3) *
      star (normalizedKloosterman3Mod m ((b : ZMod m) * x * ((n : ZMod m)⁻¹) ^ 3))
  let g (x : ZMod n) :=
    normalizedKloosterman3Mod n ((a : ZMod n) * x * ((m : ZMod n)⁻¹) ^ 3) *
      star (normalizedKloosterman3Mod n ((b : ZMod n) * x * ((m : ZMod n)⁻¹) ^ 3))
  calc
    _ = ∑ h : (ZMod (m * n))ˣ,
        f ((h : ZMod (m * n)).val : ZMod m) *
          g ((h : ZMod (m * n)).val : ZMod n) *
            ZMod.stdAddChar ((k : ZMod (m * n)) * (h : ZMod (m * n))) := by
      apply Finset.sum_congr rfl
      intro h _
      rw [kloosterman3Mod_int_mul_crt m n hmn,
        kloosterman3Mod_int_mul_crt m n hmn, star_mul]
      dsimp only [f, g]
      ring
    _ = (∑ h : (ZMod m)ˣ,
        f (h : ZMod m) *
          ZMod.stdAddChar (((k : ZMod m) * (n : ZMod m)⁻¹) * (h : ZMod m))) *
      (∑ h : (ZMod n)ˣ,
        g (h : ZMod n) *
          ZMod.stdAddChar (((k : ZMod n) * (m : ZMod n)⁻¹) * (h : ZMod n))) :=
      sum_units_crt_twist m n hmn f g k
    _ = _ := by
      congr 1
      · simpa only [f, mul_assoc] using sum_units_inv_cube_twist m n hmn.symm
          (fun x => normalizedKloosterman3Mod m ((a : ZMod m) * x) *
            star (normalizedKloosterman3Mod m ((b : ZMod m) * x))) k
      · simpa only [g, mul_assoc] using sum_units_inv_cube_twist n m hmn
          (fun x => normalizedKloosterman3Mod n ((a : ZMod n) * x) *
            star (normalizedKloosterman3Mod n ((b : ZMod n) * x))) k

theorem kl3Mod_single_twisted_norm_le
    (q : ℕ) [NeZero q] (hq : Squarefree q) (a k : ℤ)
    (ha : IsUnit (a : ZMod q)) :
    ‖∑ h : (ZMod q)ˣ,
      normalizedKloosterman3Mod q ((a : ZMod q) * (h : ZMod q)) *
        ZMod.stdAddChar ((k : ZMod q) * (h : ZMod q))‖ ≤
      (3 : ℝ) ^ q.primeFactors.card * Real.sqrt (q : ℝ) := by
  have hmain : ∀ n : ℕ, ∀ [NeZero n], Squarefree n → ∀ a k : ℤ,
      IsUnit (a : ZMod n) →
      ‖∑ h : (ZMod n)ˣ,
        normalizedKloosterman3Mod n ((a : ZMod n) * (h : ZMod n)) *
          ZMod.stdAddChar ((k : ZMod n) * (h : ZMod n))‖ ≤
        (3 : ℝ) ^ n.primeFactors.card * Real.sqrt (n : ℝ) := by
    refine induction_on_primes ?_ ?_ ?_
    · intro _
      exact False.elim (NeZero.ne 0 rfl)
    · intro _ _ a k _
      simp [normalizedKloosterman3Mod_one, Subsingleton.elim (k : ZMod 1) 0]
    · intro p n hp ih _ hpn a k ha
      have hn : Squarefree n := hpn.of_mul_right
      let : NeZero n := ⟨hn.ne_zero⟩
      let : Fact p.Prime := ⟨hp⟩
      have hcop : p.Coprime n := Nat.coprime_of_squarefree_mul hpn
      have hap := isUnit_intCast_of_dvd p (p * n) ⟨n, rfl⟩ a ha
      have han := isUnit_intCast_of_dvd n (p * n) ⟨p, Nat.mul_comm p n⟩ a ha
      have hprime := normalizedKloosterman3_unit_fourier_norm_le_three_mul_sqrt p
        (a : ZMod p) ((k * (n : ℤ) ^ 2 : ℤ) : ZMod p) hap.ne_zero
      have hrest := ih hn a (k * (p : ℤ) ^ 2) han
      rw [kl3Mod_single_twisted_mul p n hcop, norm_mul]
      calc
        _ ≤ (3 * Real.sqrt (p : ℝ)) *
            ((3 : ℝ) ^ n.primeFactors.card * Real.sqrt (n : ℝ)) := by
          apply mul_le_mul
          · simpa only [normalizedKloosterman3Mod_eq_prime] using hprime
          · exact hrest
          · exact norm_nonneg _
          · positivity
        _ = _ := by
          rw [hcop.primeFactors_mul, Finset.card_union_of_disjoint hcop.disjoint_primeFactors,
            hp.primeFactors, Finset.card_singleton, pow_add, pow_one,
            Nat.cast_mul, Real.sqrt_mul (Nat.cast_nonneg p)]
          ring
  exact hmain q hq a k ha

theorem kl3Mod_pair_twisted_norm_le
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (q : ℕ) [NeZero q] (hq : Squarefree q) (a b k : ℤ)
    (ha : IsUnit (a : ZMod q)) (hb : IsUnit (b : ZMod q)) :
    ‖∑ h : (ZMod q)ˣ,
      normalizedKloosterman3Mod q ((a : ZMod q) * (h : ZMod q)) *
        star (normalizedKloosterman3Mod q ((b : ZMod q) * (h : ZMod q))) *
        ZMod.stdAddChar ((k : ZMod q) * (h : ZMod q))‖ ≤
      (9 : ℝ) ^ q.primeFactors.card * Real.sqrt (q : ℝ) *
        Real.sqrt (Int.gcd (a - b) (q : ℤ) : ℝ) := by
  have hmain : ∀ n : ℕ, ∀ [NeZero n], Squarefree n → ∀ a b k : ℤ,
      IsUnit (a : ZMod n) → IsUnit (b : ZMod n) →
      ‖∑ h : (ZMod n)ˣ,
        normalizedKloosterman3Mod n ((a : ZMod n) * (h : ZMod n)) *
          star (normalizedKloosterman3Mod n ((b : ZMod n) * (h : ZMod n))) *
          ZMod.stdAddChar ((k : ZMod n) * (h : ZMod n))‖ ≤
        ∏ p ∈ n.primeFactors,
          9 * Real.sqrt (p : ℝ) * Real.sqrt (if (p : ℤ) ∣ a - b then (p : ℝ) else 1) := by
    refine induction_on_primes ?_ ?_ ?_
    · intro _
      exact False.elim (NeZero.ne 0 rfl)
    · intro _ _ a b k _ _
      simp [normalizedKloosterman3Mod_one, Subsingleton.elim (k : ZMod 1) 0]
    · intro p n hp ih _ hpn a b k ha hb
      have hn : Squarefree n := hpn.of_mul_right
      let : NeZero n := ⟨hn.ne_zero⟩
      let : Fact p.Prime := ⟨hp⟩
      have hcop : p.Coprime n := Nat.coprime_of_squarefree_mul hpn
      have hap := isUnit_intCast_of_dvd p (p * n) ⟨n, rfl⟩ a ha
      have hbp := isUnit_intCast_of_dvd p (p * n) ⟨n, rfl⟩ b hb
      have han := isUnit_intCast_of_dvd n (p * n) ⟨p, Nat.mul_comm p n⟩ a ha
      have hbn := isUnit_intCast_of_dvd n (p * n) ⟨p, Nat.mul_comm p n⟩ b hb
      have heq : (a : ZMod p) = (b : ZMod p) ↔ (p : ℤ) ∣ a - b := by
        rw [← sub_eq_zero, ← Int.cast_sub, ZMod.intCast_zmod_eq_zero_iff_dvd]
      have hsqrt : (1 : ℝ) ≤ Real.sqrt (p : ℝ) :=
        Real.one_le_sqrt.mpr (by exact_mod_cast hp.one_le)
      have hlocal := (normalizedKloosterman3_prime_local_bounds_of_deligne hDeligne p).2.2
        (a : ZMod p) (b : ZMod p) ((k * (n : ℤ) ^ 2 : ℤ) : ZMod p)
        hap.ne_zero hbp.ne_zero
      have hprime :
          ‖∑ h : (ZMod p)ˣ,
            normalizedKloosterman3Mod p ((a : ZMod p) * (h : ZMod p)) *
              star (normalizedKloosterman3Mod p ((b : ZMod p) * (h : ZMod p))) *
              ZMod.stdAddChar (((k * (n : ℤ) ^ 2 : ℤ) : ZMod p) * (h : ZMod p))‖ ≤
            9 * Real.sqrt (p : ℝ) *
              Real.sqrt (if (p : ℤ) ∣ a - b then (p : ℝ) else 1) := by
        simp only [normalizedKloosterman3Mod_eq_prime]
        by_cases hexc : ((k * (n : ℤ) ^ 2 : ℤ) : ZMod p) = 0 ∧ (a : ZMod p) = (b : ZMod p)
        · rw [ite_eq_left hexc] at hlocal
          rw [ite_eq_left (heq.mp hexc.2)]
          apply hlocal.trans
          nlinarith [Real.sq_sqrt (Nat.cast_nonneg p)]
        · rw [ite_eq_right hexc] at hlocal
          apply hlocal.trans
          apply le_mul_of_one_le_right (by positivity)
          split_ifs
          · exact hsqrt
          · norm_num
      rw [kl3Mod_pair_twisted_mul p n hcop, norm_mul,
        hcop.primeFactors_mul, Finset.prod_union hcop.disjoint_primeFactors,
        hp.primeFactors, Finset.prod_singleton]
      exact mul_le_mul hprime (ih hn a b (k * (p : ℤ) ^ 2) han hbn)
        (norm_nonneg _) (by positivity)
  have hprod : (∏ p ∈ q.primeFactors, (p : ℝ)) = (q : ℝ) := by
    rw [← Nat.cast_prod, Nat.prod_primeFactors_of_squarefree hq]
  calc
    _ ≤ ∏ p ∈ q.primeFactors,
        9 * Real.sqrt (p : ℝ) * Real.sqrt (if (p : ℤ) ∣ a - b then (p : ℝ) else 1) :=
      hmain q hq a b k ha hb
    _ = _ := by
      rw [Finset.prod_mul_distrib, Finset.prod_mul_distrib, Finset.prod_const,
        ← Real.sqrt_prod q.primeFactors (fun p _ => Nat.cast_nonneg p),
        ← Real.sqrt_prod q.primeFactors (fun p _ => by split_ifs <;> positivity),
        hprod, prod_primeFactors_gcd q hq (a - b)]

theorem kl3Mod_mixed_coprime_twisted_norm_le
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (c m n : ℕ) [NeZero c] [NeZero m] [NeZero n]
    (hc : Squarefree c) (hm : Squarefree m) (hn : Squarefree n)
    (hmn : m.Coprime n) (hmc : m.Coprime c) (hnc : n.Coprime c)
    (a b k : ℤ) (ha : IsUnit (a : ZMod (m * c)))
    (hb : IsUnit (b : ZMod (n * c))) :
    ‖∑ h : (ZMod ((m * n) * c))ˣ,
      normalizedKloosterman3Mod (m * c)
          ((a : ZMod (m * c)) * ((h : ZMod ((m * n) * c)).val : ZMod (m * c))) *
        star (normalizedKloosterman3Mod (n * c)
          ((b : ZMod (n * c)) * ((h : ZMod ((m * n) * c)).val : ZMod (n * c)))) *
        ZMod.stdAddChar ((k : ZMod ((m * n) * c)) * (h : ZMod ((m * n) * c)))‖ ≤
      (9 : ℝ) ^ ((m * n) * c).primeFactors.card * Real.sqrt (((m * n) * c : ℕ) : ℝ) *
        Real.sqrt (Int.gcd (b * (m : ℤ) ^ 3 - a * (n : ℤ) ^ 3) (c : ℤ) : ℝ) := by
  let f (x : ZMod m) :=
    normalizedKloosterman3Mod m ((a : ZMod m) * x * ((c : ZMod m)⁻¹) ^ 3)
  let g (x : ZMod n) :=
    star (normalizedKloosterman3Mod n ((b : ZMod n) * x * ((c : ZMod n)⁻¹) ^ 3))
  let v (x : ZMod c) :=
    normalizedKloosterman3Mod c ((a : ZMod c) * x * ((m : ZMod c)⁻¹) ^ 3) *
      star (normalizedKloosterman3Mod c ((b : ZMod c) * x * ((n : ZMod c)⁻¹) ^ 3))
  let fg (x : ZMod (m * n)) := f (x.val : ZMod m) * g (x.val : ZMod n)
  let frequency : ZMod (m * n) := (k : ZMod (m * n)) * (c : ZMod (m * n))⁻¹
  obtain ⟨j, hj⟩ := ZMod.intCast_surjective frequency
  let fm : ZMod m := (j : ZMod m) * (n : ZMod m)⁻¹
  let fn : ZMod n := (j : ZMod n) * (m : ZMod n)⁻¹
  let fc : ZMod c := (k : ZMod c) * ((m * n : ℕ) : ZMod c)⁻¹
  have hsum :
      (∑ h : (ZMod ((m * n) * c))ˣ,
        normalizedKloosterman3Mod (m * c)
            ((a : ZMod (m * c)) * ((h : ZMod ((m * n) * c)).val : ZMod (m * c))) *
          star (normalizedKloosterman3Mod (n * c)
            ((b : ZMod (n * c)) * ((h : ZMod ((m * n) * c)).val : ZMod (n * c)))) *
          ZMod.stdAddChar ((k : ZMod ((m * n) * c)) * (h : ZMod ((m * n) * c)))) =
        (∑ h : (ZMod m)ˣ, f (h : ZMod m) * ZMod.stdAddChar (fm * (h : ZMod m))) *
          (∑ h : (ZMod n)ˣ, g (h : ZMod n) * ZMod.stdAddChar (fn * (h : ZMod n))) *
          (∑ h : (ZMod c)ˣ, v (h : ZMod c) * ZMod.stdAddChar (fc * (h : ZMod c))) := by
    calc
      _ = ∑ h : (ZMod ((m * n) * c))ˣ,
          fg ((h : ZMod ((m * n) * c)).val : ZMod (m * n)) *
            v ((h : ZMod ((m * n) * c)).val : ZMod c) *
            ZMod.stdAddChar ((k : ZMod ((m * n) * c)) * (h : ZMod ((m * n) * c))) := by
        apply Finset.sum_congr rfl
        intro h _
        rw [kloosterman3Mod_int_mul_crt m c hmc,
          kloosterman3Mod_int_mul_crt n c hnc, star_mul]
        dsimp only [fg]
        rw [cast_val_natCast (m * c) m ⟨c, rfl⟩,
          cast_val_natCast (m * c) c ⟨m, Nat.mul_comm m c⟩,
          cast_val_natCast (n * c) n ⟨c, rfl⟩,
          cast_val_natCast (n * c) c ⟨n, Nat.mul_comm n c⟩,
          cast_val_natCast (m * n) m ⟨n, rfl⟩,
          cast_val_natCast (m * n) n ⟨m, Nat.mul_comm m n⟩]
        dsimp only [f, g, v]
        ring
      _ = (∑ h : (ZMod (m * n))ˣ,
          fg (h : ZMod (m * n)) * ZMod.stdAddChar (frequency * (h : ZMod (m * n)))) *
          (∑ h : (ZMod c)ˣ, v (h : ZMod c) * ZMod.stdAddChar (fc * (h : ZMod c))) :=
        sum_units_crt_twist (m * n) c (hmc.mul_left hnc) fg v k
      _ = _ := by
        rw [← hj]
        rw [sum_units_crt_twist m n hmn f g j]
  have ham := isUnit_intCast_of_dvd m (m * c) ⟨c, rfl⟩ a ha
  have hbn := isUnit_intCast_of_dvd n (n * c) ⟨c, rfl⟩ b hb
  have hac := isUnit_intCast_of_dvd c (m * c) ⟨m, Nat.mul_comm m c⟩ a ha
  have hbc := isUnit_intCast_of_dvd c (n * c) ⟨n, Nat.mul_comm n c⟩ b hb
  have hmu : IsUnit (m : ZMod c) := (ZMod.isUnit_iff_coprime m c).mpr hmc
  have hnu : IsUnit (n : ZMod c) := (ZMod.isUnit_iff_coprime n c).mpr hnc
  have hf : ‖∑ h : (ZMod m)ˣ, f (h : ZMod m) *
      ZMod.stdAddChar (fm * (h : ZMod m))‖ ≤
      (3 : ℝ) ^ m.primeFactors.card * Real.sqrt (m : ℝ) := by
    let a' : ZMod m := (a : ZMod m) * ((c : ZMod m)⁻¹) ^ 3
    obtain ⟨A', hA'⟩ := ZMod.intCast_surjective a'
    obtain ⟨K', hK'⟩ := ZMod.intCast_surjective fm
    have hunit : IsUnit (A' : ZMod m) := by
      rw [hA']
      exact ham.mul (isUnit_inv_cube m c hmc.symm)
    simpa only [hA', hK', a', f, mul_assoc, mul_left_comm, mul_comm] using
      kl3Mod_single_twisted_norm_le m hm A' K' hunit
  have hg : ‖∑ h : (ZMod n)ˣ, g (h : ZMod n) *
      ZMod.stdAddChar (fn * (h : ZMod n))‖ ≤
      (3 : ℝ) ^ n.primeFactors.card * Real.sqrt (n : ℝ) := by
    let b' : ZMod n := (b : ZMod n) * ((c : ZMod n)⁻¹) ^ 3
    obtain ⟨B', hB'⟩ := ZMod.intCast_surjective b'
    obtain ⟨K', hK'⟩ := ZMod.intCast_surjective (-fn)
    have hunit : IsUnit (B' : ZMod n) := by
      rw [hB']
      exact hbn.mul (isUnit_inv_cube n c hnc.symm)
    have hnorm := kl3Mod_single_twisted_norm_le n hn B' K' hunit
    have heq : (∑ h : (ZMod n)ˣ, g (h : ZMod n) * ZMod.stdAddChar (fn * (h : ZMod n))) =
        star (∑ h : (ZMod n)ˣ,
          normalizedKloosterman3Mod n (b' * (h : ZMod n)) *
            ZMod.stdAddChar ((-fn) * (h : ZMod n))) := by
      rw [star_sum]
      apply Finset.sum_congr rfl
      intro h _
      simp only [star_mul, Complex.star_def, ← AddChar.map_neg_eq_conj,
        mul_neg, neg_neg, g, b', mul_assoc, mul_comm]
    rw [heq, norm_star]
    simpa only [hB', hK'] using hnorm
  let t : ZMod c := ((m : ZMod c) * (n : ZMod c)) ^ 3
  have ht : IsUnit t := (hmu.mul hnu).pow 3
  have hscale (v₁ v₂ z x : ZMod c) (hv₁ : IsUnit v₁) :
      z * ((v₁ * v₂) ^ 3 * x) * (v₁⁻¹) ^ 3 = z * v₂ ^ 3 * x := by
    calc
      _ = (z * v₂ ^ 3 * x) * ((v₁⁻¹) ^ 3 * v₁ ^ 3) := by ring
      _ = _ := by rw [← mul_pow, ZMod.inv_mul_of_unit _ hv₁, one_pow, mul_one]
  obtain ⟨K', hK'⟩ := ZMod.intCast_surjective (fc * t)
  have hvEq : (∑ h : (ZMod c)ˣ, v (h : ZMod c) * ZMod.stdAddChar (fc * (h : ZMod c))) =
      ∑ h : (ZMod c)ˣ,
        normalizedKloosterman3Mod c (((a * (n : ℤ) ^ 3 : ℤ) : ZMod c) * (h : ZMod c)) *
          star (normalizedKloosterman3Mod c
            (((b * (m : ℤ) ^ 3 : ℤ) : ZMod c) * (h : ZMod c))) *
          ZMod.stdAddChar ((K' : ZMod c) * (h : ZMod c)) := by
    calc
      _ = ∑ h : (ZMod c)ˣ,
          v (t * (h : ZMod c)) * ZMod.stdAddChar (fc * (t * (h : ZMod c))) :=
        (sum_units_mul c (fun x => v x * ZMod.stdAddChar (fc * x)) t ht).symm
      _ = _ := by
        apply Finset.sum_congr rfl
        intro h _
        rw [hK']
        dsimp only [v, t]
        rw [hscale _ _ _ _ hmu, mul_comm (m : ZMod c) (n : ZMod c),
          hscale _ _ _ _ hnu]
        simp only [Int.cast_mul, Int.cast_pow, Int.cast_natCast, mul_assoc]
  have ha' : IsUnit ((a * (n : ℤ) ^ 3 : ℤ) : ZMod c) := by
    simpa only [Int.cast_mul, Int.cast_pow, Int.cast_natCast] using hac.mul (hnu.pow 3)
  have hb' : IsUnit ((b * (m : ℤ) ^ 3 : ℤ) : ZMod c) := by
    simpa only [Int.cast_mul, Int.cast_pow, Int.cast_natCast] using hbc.mul (hmu.pow 3)
  have hv := kl3Mod_pair_twisted_norm_le hDeligne c hc
    (a * (n : ℤ) ^ 3) (b * (m : ℤ) ^ 3) K' ha' hb'
  have hneg : a * (n : ℤ) ^ 3 - b * (m : ℤ) ^ 3 =
      -(b * (m : ℤ) ^ 3 - a * (n : ℤ) ^ 3) := by ring
  rw [hneg, Int.neg_gcd] at hv
  have hf9 := hf.trans (mul_le_mul_of_nonneg_right
    (pow_le_pow_left₀ (by norm_num : (0 : ℝ) ≤ 3) (by norm_num : (3 : ℝ) ≤ 9)
      m.primeFactors.card) (Real.sqrt_nonneg _))
  have hg9 := hg.trans (mul_le_mul_of_nonneg_right
    (pow_le_pow_left₀ (by norm_num : (0 : ℝ) ≤ 3) (by norm_num : (3 : ℝ) ≤ 9)
      n.primeFactors.card) (Real.sqrt_nonneg _))
  have hcard : ((m * n) * c).primeFactors.card =
      m.primeFactors.card + n.primeFactors.card + c.primeFactors.card := by
    rw [(hmc.mul_left hnc).primeFactors_mul,
      Finset.card_union_of_disjoint (hmc.mul_left hnc).disjoint_primeFactors,
      hmn.primeFactors_mul, Finset.card_union_of_disjoint hmn.disjoint_primeFactors]
  have hroot : Real.sqrt (((m * n) * c : ℕ) : ℝ) =
      Real.sqrt (m : ℝ) * Real.sqrt (n : ℝ) * Real.sqrt (c : ℝ) := by
    rw [Nat.cast_mul, Real.sqrt_mul (Nat.cast_nonneg (m * n)),
      Nat.cast_mul, Real.sqrt_mul (Nat.cast_nonneg m)]
  rw [hsum, norm_mul, norm_mul, hvEq]
  calc
    _ ≤ ((9 : ℝ) ^ m.primeFactors.card * Real.sqrt (m : ℝ)) *
        ((9 : ℝ) ^ n.primeFactors.card * Real.sqrt (n : ℝ)) *
        ((9 : ℝ) ^ c.primeFactors.card * Real.sqrt (c : ℝ) *
          Real.sqrt (Int.gcd (b * (m : ℤ) ^ 3 - a * (n : ℤ) ^ 3) (c : ℤ) : ℝ)) := by
      apply mul_le_mul
      · exact mul_le_mul hf9 hg9 (norm_nonneg _) (by positivity)
      · exact hv
      · exact norm_nonneg _
      · positivity
    _ = _ := by rw [hcard, pow_add, pow_add, hroot]; ring

section
open Polynomial

theorem profile_interval_hasSum (T N t₀ : ℝ) (hN : 0 < N)
    (ψ : ℝ → ℂ) (hsupp : Function.support ψ ⊆ Set.Icc (-T) T)
    (d : ℕ) (a : ℤ) (F : ℤ → ℂ) :
    HasSum (fun n : ℤ => if Int.ModEq (d : ℤ) n a
      then ψ (((n : ℝ) - t₀) / N) * F n else 0)
        (∑ n ∈ Finset.Icc (⌈t₀ - T * N⌉ : ℤ) (⌊t₀ + T * N⌋ : ℤ),
          if Int.ModEq (d : ℤ) n a then ψ (((n : ℝ) - t₀) / N) * F n else 0) := by
  apply hasSum_sum_of_ne_finset_zero
  intro n hn
  have hzero : ψ (((n : ℝ) - t₀) / N) = 0 := by
    by_contra he
    have hh := hsupp (show ((n : ℝ) - t₀) / N ∈ Function.support ψ from he)
    have hl : t₀ - T * N ≤ (n : ℝ) := by
      have := (le_div_iff₀ hN).1 hh.1
      linarith
    have hu : (n : ℝ) ≤ t₀ + T * N := by
      have := (div_le_iff₀ hN).1 hh.2
      linarith
    apply hn
    exact Finset.mem_Icc.mpr ⟨Int.ceil_le.mpr hl, Int.le_floor.mpr hu⟩
  simp only [hzero, zero_mul, ite_self]

theorem progression_sampling (ψ : ℝ → ℂ) (hψ : ContDiff ℝ 1 ψ)
    (D : ℝ) (hD : 0 ≤ D) (hb : ∀ x, ‖ψ x‖ ≤ D ∧ ‖deriv ψ x‖ ≤ D)
    (N t₀ : ℝ) (d : ℕ) (hd : 0 < d) (hNd : (d : ℝ) ≤ N)
    (U : ℝ) (hU : 1 ≤ U) (β : ℤ) (k : ℕ)
    (hk : (k : ℝ) ≤ (U - 1) * (N / (d : ℝ))) :
    let w : ℕ → ℂ := fun j => ψ ((((β + (d : ℤ) * (j : ℤ)) : ℝ) - t₀) / N)
    let V : ℝ := if k = 0 then 0 else
      ‖w (k - 1)‖ + ∑ j ∈ Finset.range (k - 1), ‖w (j + 1) - w j‖
    V ≤ U * D ∧ ‖∑ j ∈ Finset.range k, w j‖ ≤ U * D * (N / (d : ℝ)) ∧
      Real.sqrt (k : ℝ) ≤ U * Real.sqrt (N / (d : ℝ)) := by
  have hdR : (0 : ℝ) < d := by exact_mod_cast hd
  have hnR : 0 < N := lt_of_lt_of_le hdR hNd
  let X := N / (d : ℝ)
  have hX : 1 ≤ X := (le_div_iff₀ hdR).2 (by simpa using hNd)
  have hXpos : 0 < X := lt_of_lt_of_le zero_lt_one hX
  let w : ℕ → ℂ := fun j => ψ ((((β + (d : ℤ) * (j : ℤ)) : ℝ) - t₀) / N)
  have hw (j : ℕ) : ‖w j‖ ≤ D := (hb _).1
  have hadj (j : ℕ) : ‖w (j + 1) - w j‖ ≤ D / X := by
    have hm := Convex.norm_image_sub_le_of_norm_deriv_le
      (fun x _ => hψ.differentiable_one x) (fun x _ => (hb x).2)
      (convex_univ : Convex ℝ (Set.univ : Set ℝ))
      (Set.mem_univ ((((β + (d : ℤ) * (j : ℤ)) : ℝ) - t₀) / N))
      (Set.mem_univ ((((β + (d : ℤ) * ((j + 1 : ℕ) : ℤ)) : ℝ) - t₀) / N))
    change ‖w (j + 1) - w j‖ ≤ _ at hm
    have hslope : ((((β + (d : ℤ) * ((j + 1 : ℕ) : ℤ)) : ℝ) - t₀) / N) -
        ((((β + (d : ℤ) * (j : ℤ)) : ℝ) - t₀) / N) = (d : ℝ) / N := by
      push_cast
      ring
    simp only [hslope, Real.norm_eq_abs, abs_of_pos (div_pos hdR hnR)] at hm
    simpa [X, div_div, mul_comm, mul_left_comm, div_eq_mul_inv] using hm
  constructor
  · by_cases he : k = 0
    · simp [he, mul_nonneg (le_trans zero_le_one hU) hD]
    simp only [he, ↓reduceIte]
    have hsum : (∑ j ∈ Finset.range (k - 1), ‖w (j + 1) - w j‖) ≤
        (k : ℝ) * (D / X) := by
      calc
        _ ≤ ∑ _j ∈ Finset.range (k - 1), D / X := Finset.sum_le_sum (fun j _ => hadj j)
        _ = (k - 1 : ℕ) * (D / X) := by simp
        _ ≤ (k : ℝ) * (D / X) := mul_le_mul_of_nonneg_right
          (by exact_mod_cast Nat.sub_le k 1) (div_nonneg hD hXpos.le)
    have hquot : (k : ℝ) / X ≤ U - 1 := (div_le_iff₀ hXpos).2 hk
    have hterm : (k : ℝ) * (D / X) ≤ (U - 1) * D := by
      calc
        _ = (k : ℝ) / X * D := by ring
        _ ≤ (U - 1) * D := mul_le_mul_of_nonneg_right hquot hD
    linarith only [hw (k - 1), hsum, hterm]
  constructor
  · calc
      ‖∑ j ∈ Finset.range k, w j‖ ≤ ∑ j ∈ Finset.range k, ‖w j‖ := norm_sum_le _ _
      _ ≤ ∑ _j ∈ Finset.range k, D := Finset.sum_le_sum (fun j _ => hw j)
      _ = (k : ℝ) * D := by simp
      _ ≤ U * D * X := by
        have hk' : (k : ℝ) ≤ U * X := hk.trans (by nlinarith only [hXpos])
        nlinarith only [mul_le_mul_of_nonneg_right hk' hD]
  · calc
      Real.sqrt (k : ℝ) ≤ Real.sqrt ((U - 1) * X) := Real.sqrt_le_sqrt hk
      _ ≤ U * Real.sqrt X := by
        rw [Real.sqrt_mul (by linarith)]
        have hu : Real.sqrt (U - 1) ≤ U := by
          apply Real.sqrt_le_iff.mpr
          constructor
          · linarith
          · nlinarith
        exact mul_le_mul_of_nonneg_right hu (Real.sqrt_nonneg _)

end

theorem gcd_repartition_arithmetic (s r1 r2 : ℕ) :
    let d := Nat.gcd r1 r2
    let u1 := r1 / d
    let u2 := r2 / d
    r1 = u1 * d ∧ r2 = u2 * d ∧
      s * Nat.lcm r1 r2 = (s * d) * Nat.lcm u1 u2 := by
  intro d u1 u2
  have h1 : u1 * d = r1 := Nat.div_mul_cancel (Nat.gcd_dvd_left r1 r2)
  have h2 : u2 * d = r2 := Nat.div_mul_cancel (Nat.gcd_dvd_right r1 r2)
  refine ⟨h1.symm, h2.symm, ?_⟩
  rw [← h1, ← h2, Nat.lcm_mul_right]
  ac_rfl

theorem squarefree_gcd_repartition (s r1 r2 : ℕ)
    (hs : Squarefree s) (h1 : Squarefree r1) (h2 : Squarefree r2)
    (hcop : Nat.Coprime s (r1 * r2)) :
    let d := Nat.gcd r1 r2
    let u1 := r1 / d
    let u2 := r2 / d
    Squarefree (s * d) ∧ Squarefree u1 ∧ Squarefree u2 ∧
      Nat.Coprime u1 u2 ∧ Nat.Coprime (s * d) (u1 * u2) := by
  let d := Nat.gcd r1 r2
  let u1 := r1 / d
  let u2 := r2 / d
  change Squarefree (s * d) ∧ Squarefree u1 ∧ Squarefree u2 ∧
    Nat.Coprime u1 u2 ∧ Nat.Coprime (s * d) (u1 * u2)
  have hd1 : d ∣ r1 := Nat.gcd_dvd_left r1 r2
  have hd2 : d ∣ r2 := Nat.gcd_dvd_right r1 r2
  have hu1 : u1 ∣ r1 := Nat.div_dvd_of_dvd hd1
  have hu2 : u2 ∣ r2 := Nat.div_dvd_of_dvd hd2
  obtain ⟨hs1, hs2⟩ := Nat.coprime_mul_iff_right.mp hcop
  have hu1r2 : Nat.Coprime u1 r2 :=
    Nat.coprime_div_gcd_of_squarefree h1 h2.ne_zero
  have hu2r1 : Nat.Coprime u2 r1 := by
    simpa only [u2, d, Nat.gcd_comm] using
      (Nat.coprime_div_gcd_of_squarefree h2 h1.ne_zero)
  refine ⟨(Nat.squarefree_mul (hs1.of_dvd_right hd1)).2
      ⟨hs, h1.squarefree_of_dvd hd1⟩,
    h1.squarefree_of_dvd hu1, h2.squarefree_of_dvd hu2,
    hu1r2.of_dvd_right hu2, ?_⟩
  exact ((hs1.of_dvd_right hu1).mul_right (hs2.of_dvd_right hu2)).mul_left
    (((hu1r2.of_dvd_right hd2).symm).mul_right ((hu2r1.of_dvd_right hd1).symm))

theorem normalizedKloosterman3Mod_mixed_unit_correlation_zero_norm_le
    (s r₁ r₂ : ℕ) (hs : Squarefree s)
    (h₁ : Squarefree r₁) (h₂ : Squarefree r₂)
    (hcop : Nat.Coprime s (r₁ * r₂)) (a₁ a₂ : ℤ)
    (ha₁ : IsUnit (a₁ : ZMod (r₁ * s)))
    (ha₂ : IsUnit (a₂ : ZMod (r₂ * s))) :
    let q := s * Nat.lcm r₁ r₂
    let d := Nat.gcd r₁ r₂
    let u₁ := r₁ / d
    let u₂ := r₂ / d
    letI : NeZero (r₁ * s) := ⟨mul_ne_zero h₁.ne_zero hs.ne_zero⟩
    letI : NeZero (r₂ * s) := ⟨mul_ne_zero h₂.ne_zero hs.ne_zero⟩
    letI : NeZero q :=
      ⟨mul_ne_zero hs.ne_zero (Nat.lcm_ne_zero h₁.ne_zero h₂.ne_zero)⟩
    ‖∑ h : (ZMod q)ˣ,
      normalizedKloosterman3Mod (r₁ * s)
          ((a₁ : ZMod (r₁ * s)) * ((h : ZMod q).val : ZMod (r₁ * s))) *
        star (normalizedKloosterman3Mod (r₂ * s)
          ((a₂ : ZMod (r₂ * s)) * ((h : ZMod q).val : ZMod (r₂ * s))))‖ ≤
      (2 : ℝ) ^ (s * d).primeFactors.card *
        (Int.gcd (a₂ * (u₁ : ℤ) ^ 3 - a₁ * (u₂ : ℤ) ^ 3)
          ((s * d : ℕ) : ℤ) : ℝ) / ((u₁ * u₂ : ℕ) : ℝ) := by
  let q := s * Nat.lcm r₁ r₂
  let d := Nat.gcd r₁ r₂
  let m := r₁ / d
  let n := r₂ / d
  let c := s * d
  let : NeZero (r₁ * s) := ⟨mul_ne_zero h₁.ne_zero hs.ne_zero⟩
  let : NeZero (r₂ * s) := ⟨mul_ne_zero h₂.ne_zero hs.ne_zero⟩
  let : NeZero q :=
    ⟨mul_ne_zero hs.ne_zero (Nat.lcm_ne_zero h₁.ne_zero h₂.ne_zero)⟩
  have hr₁ : r₁ = m * d := (gcd_repartition_arithmetic s r₁ r₂).1
  have hr₂ : r₂ = n * d := (gcd_repartition_arithmetic s r₁ r₂).2.1
  have hq : q = c * Nat.lcm m n :=
    (gcd_repartition_arithmetic s r₁ r₂).2.2
  have hparts : Squarefree c ∧ Squarefree m ∧ Squarefree n ∧
      Nat.Coprime m n ∧ Nat.Coprime c (m * n) :=
    squarefree_gcd_repartition s r₁ r₂ hs h₁ h₂ hcop
  obtain ⟨hc, hm, hn, hmn, hcmn⟩ := hparts
  let : NeZero c := ⟨hc.ne_zero⟩
  let : NeZero m := ⟨hm.ne_zero⟩
  let : NeZero n := ⟨hn.ne_zero⟩
  have hq' : q = (m * n) * c := by rw [hq, hmn.lcm_eq_mul, Nat.mul_comm]
  have hr₁s : r₁ * s = m * c := by rw [hr₁]; dsimp only [c]; ring
  have hr₂s : r₂ * s = n * c := by rw [hr₂]; dsimp only [c]; ring
  have ha : IsUnit (a₁ : ZMod (m * c)) :=
    (congrArg (fun j : ℕ => IsUnit (a₁ : ZMod j)) hr₁s).mp ha₁
  have hb : IsUnit (a₂ : ZMod (n * c)) :=
    (congrArg (fun j : ℕ => IsUnit (a₂ : ZMod j)) hr₂s).mp ha₂
  have h := kloosterman3Mod_mixed_coprime_norm_le c m n hc hm hn hmn
    (Nat.coprime_mul_iff_right.mp hcmn).1.symm
    (Nat.coprime_mul_iff_right.mp hcmn).2.symm a₁ a₂ ha hb
  convert! h using 1
  congr!

open Classical in
theorem normalizedKloosterman3Mod_mixed_unit_fourier_norm_le_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (s r₁ r₂ : ℕ) (hs : Squarefree s)
    (h₁ : Squarefree r₁) (h₂ : Squarefree r₂)
    (hcop : Nat.Coprime s (r₁ * r₂)) (a₁ a₂ : ℤ)
    (ha₁ : IsUnit (a₁ : ZMod (r₁ * s)))
    (ha₂ : IsUnit (a₂ : ZMod (r₂ * s))) :
    let q := s * Nat.lcm r₁ r₂
    let d := Nat.gcd r₁ r₂
    let u₁ := r₁ / d
    let u₂ := r₂ / d
    letI : NeZero (r₁ * s) := ⟨mul_ne_zero h₁.ne_zero hs.ne_zero⟩
    letI : NeZero (r₂ * s) := ⟨mul_ne_zero h₂.ne_zero hs.ne_zero⟩
    letI : NeZero q :=
      ⟨mul_ne_zero hs.ne_zero (Nat.lcm_ne_zero h₁.ne_zero h₂.ne_zero)⟩
    ∀ k : ZMod q,
      ‖∑ h : (ZMod q)ˣ,
        normalizedKloosterman3Mod (r₁ * s)
            ((a₁ : ZMod (r₁ * s)) * ((h : ZMod q).val : ZMod (r₁ * s))) *
          star (normalizedKloosterman3Mod (r₂ * s)
            ((a₂ : ZMod (r₂ * s)) * ((h : ZMod q).val : ZMod (r₂ * s)))) *
          ZMod.stdAddChar (k * (h : ZMod q))‖ ≤
        (9 : ℝ) ^ q.primeFactors.card * Real.sqrt (q : ℝ) *
          (Real.sqrt (Int.gcd (a₂ * (u₁ : ℤ) ^ 3 - a₁ * (u₂ : ℤ) ^ 3) (d : ℤ) : ℝ) *
            Real.sqrt (Int.gcd (a₂ * (r₁ : ℤ) ^ 3 - a₁ * (r₂ : ℤ) ^ 3) (s : ℤ) : ℝ)) := by
  let q := s * Nat.lcm r₁ r₂
  let d := Nat.gcd r₁ r₂
  let m := r₁ / d
  let n := r₂ / d
  let c := s * d
  let Δ : ℤ := a₂ * (m : ℤ) ^ 3 - a₁ * (n : ℤ) ^ 3
  let T : ℤ := a₂ * (r₁ : ℤ) ^ 3 - a₁ * (r₂ : ℤ) ^ 3
  let : NeZero (r₁ * s) := ⟨mul_ne_zero h₁.ne_zero hs.ne_zero⟩
  let : NeZero (r₂ * s) := ⟨mul_ne_zero h₂.ne_zero hs.ne_zero⟩
  let : NeZero q :=
    ⟨mul_ne_zero hs.ne_zero (Nat.lcm_ne_zero h₁.ne_zero h₂.ne_zero)⟩
  have hr₁ : r₁ = m * d := (gcd_repartition_arithmetic s r₁ r₂).1
  have hr₂ : r₂ = n * d := (gcd_repartition_arithmetic s r₁ r₂).2.1
  have hq : q = c * Nat.lcm m n :=
    (gcd_repartition_arithmetic s r₁ r₂).2.2
  have hparts : Squarefree c ∧ Squarefree m ∧ Squarefree n ∧
      Nat.Coprime m n ∧ Nat.Coprime c (m * n) :=
    squarefree_gcd_repartition s r₁ r₂ hs h₁ h₂ hcop
  obtain ⟨hc, hm, hn, hmn, hcmn⟩ := hparts
  let : NeZero c := ⟨hc.ne_zero⟩
  let : NeZero m := ⟨hm.ne_zero⟩
  let : NeZero n := ⟨hn.ne_zero⟩
  have hq' : q = (m * n) * c := by rw [hq, hmn.lcm_eq_mul, Nat.mul_comm]
  have hr₁s : r₁ * s = m * c := by rw [hr₁]; dsimp only [c]; ring
  have hr₂s : r₂ * s = n * c := by rw [hr₂]; dsimp only [c]; ring
  have ha : IsUnit (a₁ : ZMod (m * c)) :=
    (congrArg (fun j : ℕ => IsUnit (a₁ : ZMod j)) hr₁s).mp ha₁
  have hb : IsUnit (a₂ : ZMod (n * c)) :=
    (congrArg (fun j : ℕ => IsUnit (a₂ : ZMod j)) hr₂s).mp ha₂
  have hsd : Nat.Coprime s d :=
    (Nat.coprime_mul_iff_right.mp hcop).1.of_dvd_right (Nat.gcd_dvd_left r₁ r₂)
  have hT : T = (d : ℤ) ^ 3 * Δ := by
    dsimp only [T, Δ]
    rw [hr₁, hr₂]
    push_cast
    ring
  have hdscop : Int.gcd ((d : ℤ) ^ 3) (s : ℤ) = 1 := by
    simpa only [Int.gcd_def, Int.natAbs_pow, Int.natAbs_natCast] using
      (hsd.symm.pow_left 3).gcd_eq_one
  have hcancel : Int.gcd T (s : ℤ) = Int.gcd Δ (s : ℤ) := by
    rw [hT]
    exact Int.gcd_mul_right_left_of_gcd_eq_one hdscop
  have hgcd : Int.gcd Δ (c : ℤ) = Int.gcd Δ (d : ℤ) * Int.gcd T (s : ℤ) := by
    rw [hcancel]
    simp only [Int.gcd_def, Int.natAbs_natCast, c]
    rw [hsd.gcd_mul Δ.natAbs, Nat.mul_comm]
  have hG : Real.sqrt (Int.gcd Δ (c : ℤ) : ℝ) =
      Real.sqrt (Int.gcd Δ (d : ℤ) : ℝ) * Real.sqrt (Int.gcd T (s : ℤ) : ℝ) := by
    rw [hgcd, Nat.cast_mul, Real.sqrt_mul (Nat.cast_nonneg _)]
  change ∀ k : ZMod q, _
  intro k
  obtain ⟨kZ, rfl⟩ := ZMod.intCast_surjective k
  have h := kl3Mod_mixed_coprime_twisted_norm_le hDeligne c m n hc hm hn hmn
    (Nat.coprime_mul_iff_right.mp hcmn).1.symm
    (Nat.coprime_mul_iff_right.mp hcmn).2.symm a₁ a₂ kZ ha hb
  convert! h using 1
  · congr!
  · rw [← hq', hG]

theorem compactProfile_fourier_l1_bound
    (m : ℕ) [NeZero m] (T Lw N t₀ : ℝ)
    (hT : 0 ≤ T) (hLw : 0 ≤ Lw) (hN : 0 < N)
    (ψ : ℝ → ℂ) (hψ : ContDiff ℝ 1 ψ)
    (hsupport : Function.support ψ ⊆ Set.Icc (-T) T)
    (hbound : ∀ t : ℝ, ‖ψ t‖ ≤ Lw ∧ ‖deriv ψ t‖ ≤ Lw) :
    let A : ℤ := ⌈t₀ - T * N⌉
    let K : ℕ := (⌊t₀ + T * N⌋ + 1 - A).toNat
    let W : ZMod m → ℂ := integerIntervalResidueWeight m A K
      (fun j => ψ (((A : ℝ) + (j : ℝ) - t₀) / N))
    (∀ ξ : ZMod m,
      HasSum (fun n : ℤ => ψ (((n : ℝ) - t₀) / N) *
        ZMod.stdAddChar (-((n : ZMod m) * ξ))) (ZMod.dft W ξ)) ∧
    (1 / (m : ℝ)) * ∑ ξ : ZMod m, ‖ZMod.dft W ξ‖ ≤
      (4 * T + 3) * Lw * (1 + Real.log (m : ℝ)) * (1 + N / (m : ℝ)) := by
  classical
  let A : ℤ := ⌈t₀ - T * N⌉
  let B : ℤ := ⌊t₀ + T * N⌋
  let K : ℕ := (B + 1 - A).toNat
  let w : ℕ → ℂ := fun j => ψ (((A : ℝ) + (j : ℝ) - t₀) / N)
  let W : ZMod m → ℂ := integerIntervalResidueWeight m A K w
  let V : ℝ := if K = 0 then 0 else
    ‖w (K - 1)‖ + ∑ j ∈ Finset.range (K - 1), ‖w (j + 1) - w j‖
  change (∀ ξ : ZMod m,
      HasSum (fun n : ℤ => ψ (((n : ℝ) - t₀) / N) *
        ZMod.stdAddChar (-((n : ZMod m) * ξ))) (ZMod.dft W ξ)) ∧ _
  have hA : t₀ - T * N ≤ (A : ℝ) := Int.le_ceil _
  have hB : (B : ℝ) ≤ t₀ + T * N := Int.floor_le _
  have hpred (hk : K ≠ 0) : ((K - 1 : ℕ) : ℝ) ≤ 2 * T * N := by
    have hab : A ≤ B := by
      dsimp only [K] at hk
      omega
    have hkz : (K : ℤ) = B + 1 - A := Int.toNat_of_nonneg (by omega)
    have hpz : ((K - 1 : ℕ) : ℤ) = B - A := by omega
    have hpr : ((K - 1 : ℕ) : ℝ) = (B : ℝ) - (A : ℝ) := by exact_mod_cast hpz
    rw [hpr]
    linarith
  have hcount : (K : ℝ) ≤ 2 * T * N + 1 := by
    by_cases hk : K = 0
    · simp only [hk, Nat.cast_zero]
      positivity
    · have he : (K : ℝ) = ((K - 1 : ℕ) : ℝ) + 1 := by
        exact_mod_cast (show K = K - 1 + 1 by omega)
      rw [he]
      linarith [hpred hk]
  have hstep (j : ℕ) : ‖w (j + 1) - w j‖ ≤ Lw / N := by
    have h := Convex.norm_image_sub_le_of_norm_deriv_le
      (fun x _ => hψ.differentiable_one x) (fun x _ => (hbound x).2)
      (convex_univ : Convex ℝ (Set.univ : Set ℝ))
      (Set.mem_univ (((A : ℝ) + (j : ℝ) - t₀) / N))
      (Set.mem_univ (((A : ℝ) + ((j + 1 : ℕ) : ℝ) - t₀) / N))
    change ‖w (j + 1) - w j‖ ≤ _ at h
    have hd : (((A : ℝ) + ((j + 1 : ℕ) : ℝ) - t₀) / N) -
        (((A : ℝ) + (j : ℝ) - t₀) / N) = 1 / N := by
      push_cast
      ring
    rw [hd, Real.norm_eq_abs, abs_of_pos (one_div_pos.mpr hN)] at h
    simpa only [div_eq_mul_inv, one_mul] using h
  have hV : V ≤ (2 * T + 1) * Lw := by
    by_cases hk : K = 0
    · simp only [V, hk, ↓reduceIte]
      positivity
    · simp only [V, hk, ↓reduceIte]
      calc
        _ ≤ Lw + ∑ _j ∈ Finset.range (K - 1), Lw / N :=
          add_le_add (hbound _).1 (Finset.sum_le_sum (fun j _ => hstep j))
        _ = Lw + ((K - 1 : ℕ) : ℝ) * (Lw / N) := by simp
        _ ≤ Lw + (2 * T * N) * (Lw / N) :=
          add_le_add le_rfl (mul_le_mul_of_nonneg_right (hpred hk)
            (div_nonneg hLw hN.le))
        _ = (2 * T + 1) * Lw := by field_simp; ring
  have hdft (ξ : ZMod m) : ZMod.dft W ξ =
      ∑ n ∈ Finset.Icc A B, ψ (((n : ℝ) - t₀) / N) *
        ZMod.stdAddChar (-((n : ZMod m) * ξ)) := by
    change ZMod.dft (integerIntervalResidueWeight m A K w) ξ = _
    rw [(integerIntervalResidueWeight_spec m A K w).2.1 ξ,
      Int.Icc_eq_finset_map, Finset.sum_map]
    apply Finset.sum_congr rfl
    intro j hj
    simp only [Function.Embedding.trans_apply, Nat.castEmbedding_apply,
      addLeftEmbedding_apply, Int.cast_add, Int.cast_natCast, w]
  have hcomplete (ξ : ZMod m) :
      HasSum (fun n : ℤ => ψ (((n : ℝ) - t₀) / N) *
        ZMod.stdAddChar (-((n : ZMod m) * ξ))) (ZMod.dft W ξ) := by
    rw [hdft ξ]
    apply hasSum_sum_of_ne_finset_zero
    intro n hn
    have hz : ψ (((n : ℝ) - t₀) / N) = 0 := by
      by_contra he
      have hh := hsupport (show ((n : ℝ) - t₀) / N ∈ Function.support ψ from he)
      have hlo : t₀ - T * N ≤ (n : ℝ) := by
        have := (le_div_iff₀ hN).1 hh.1
        linarith
      have hhi : (n : ℝ) ≤ t₀ + T * N := by
        have := (div_le_iff₀ hN).1 hh.2
        linarith
      apply hn
      exact Finset.mem_Icc.mpr ⟨Int.ceil_le.mpr hlo, Int.le_floor.mpr hhi⟩
    simp only [hz, zero_mul]
  have hm : (0 : ℝ) < m := by exact_mod_cast NeZero.pos m
  have hmone : (1 : ℝ) ≤ m := by exact_mod_cast NeZero.pos m
  have hlog : 1 ≤ 1 + Real.log (m : ℝ) :=
    le_add_of_nonneg_right (Real.log_nonneg hmone)
  have hx : 0 ≤ N / (m : ℝ) := div_nonneg hN.le hm.le
  have hfrequency : (1 / (m : ℝ)) *
      ∑ ξ ∈ (Finset.univ : Finset (ZMod m)).erase 0, ‖ZMod.dft W ξ‖ ≤
        2 * (2 * T + 1) * Lw * (1 + Real.log (m : ℝ)) := by
    have hv : (1 / (m : ℝ)) *
        ∑ ξ ∈ (Finset.univ : Finset (ZMod m)).erase 0, ‖ZMod.dft W ξ‖ ≤
          2 * V * (1 + Real.log (m : ℝ)) := by
      simpa [V, W] using
        (integerIntervalResidueWeight_variation_and_derivative m A K).1 w 1 (one_dvd m)
    calc
      _ ≤ 2 * V * (1 + Real.log (m : ℝ)) := hv
      _ ≤ 2 * ((2 * T + 1) * Lw) * (1 + Real.log (m : ℝ)) := by gcongr
      _ = _ := by ring
  have hzero : ‖ZMod.dft W 0‖ ≤ (2 * T * N + 1) * Lw := by
    change ‖ZMod.dft (integerIntervalResidueWeight m A K w) 0‖ ≤ _
    rw [ZMod.dft_apply_zero, (integerIntervalResidueWeight_spec m A K w).2.2.1]
    calc
      _ ≤ ∑ _j ∈ Finset.range K, Lw := norm_sum_le_of_le _ (fun j _ => (hbound _).1)
      _ = (K : ℝ) * Lw := by simp
      _ ≤ _ := mul_le_mul_of_nonneg_right hcount hLw
  have hzero' : (1 / (m : ℝ)) * ‖ZMod.dft W 0‖ ≤
      (2 * T * (N / (m : ℝ)) + 1) * Lw := by
    calc
      _ ≤ (1 / (m : ℝ)) * ((2 * T * N + 1) * Lw) :=
        mul_le_mul_of_nonneg_left hzero (by positivity)
      _ = (2 * T * (N / (m : ℝ)) + 1 / (m : ℝ)) * Lw := by ring
      _ ≤ _ := mul_le_mul_of_nonneg_right
        (add_le_add le_rfl ((div_le_one hm).2 hmone)) hLw
  refine ⟨hcomplete, ?_⟩
  rw [← Finset.sum_erase_add (Finset.univ : Finset (ZMod m)) _ (Finset.mem_univ 0),
    mul_add]
  calc
    _ ≤ 2 * (2 * T + 1) * Lw * (1 + Real.log (m : ℝ)) +
        (2 * T * (N / (m : ℝ)) + 1) * Lw := add_le_add hfrequency hzero'
    _ ≤ 2 * (2 * T + 1) * Lw * (1 + Real.log (m : ℝ)) +
        (2 * T * (N / (m : ℝ)) + 1) * Lw * (1 + Real.log (m : ℝ)) :=
      add_le_add le_rfl (le_mul_of_one_le_right
        (show 0 ≤ (2 * T * (N / (m : ℝ)) + 1) * Lw by positivity) hlog)
    _ = ((4 * T + 3) + 2 * T * (N / (m : ℝ))) * Lw *
        (1 + Real.log (m : ℝ)) := by ring
    _ ≤ ((4 * T + 3) * (1 + N / (m : ℝ))) * Lw *
        (1 + Real.log (m : ℝ)) := by
      apply mul_le_mul_of_nonneg_right _ (by linarith : 0 ≤ 1 + Real.log (m : ℝ))
      apply mul_le_mul_of_nonneg_right _ hLw
      nlinarith
    _ = _ := by ring

theorem full_weighted_sum_dft
    (m : ℕ) [NeZero m] (w F : ZMod m → ℂ) :
    (∑ x : ZMod m, w x * F x) =
      (m : ℂ)⁻¹ * ∑ ξ : ZMod m, ZMod.dft w ξ * ZMod.dft F (-ξ) := by
  classical
  have hinv (x : ZMod m) : w x = (m : ℂ)⁻¹ * ∑ ξ : ZMod m,
      ZMod.stdAddChar (ξ * x) * ZMod.dft w ξ := by
    simpa only [LinearEquiv.symm_apply_apply, smul_eq_mul] using
      ZMod.invDFT_apply (ZMod.dft w) x
  have hpair (ξ : ZMod m) : ZMod.dft F (-ξ) = ∑ x : ZMod m,
      ZMod.stdAddChar (ξ * x) * F x := by
    simp [ZMod.dft_apply, smul_eq_mul, mul_comm]
  calc
    _ = (m : ℂ)⁻¹ * ∑ x : ZMod m, ∑ ξ : ZMod m,
        ZMod.stdAddChar (ξ * x) * ZMod.dft w ξ * F x := by
      conv_lhs => simp only [hinv]
      simp only [Finset.mul_sum, Finset.sum_mul, mul_assoc]
    _ = (m : ℂ)⁻¹ * ∑ ξ : ZMod m, ZMod.dft w ξ * ZMod.dft F (-ξ) := by
      rw [Finset.sum_comm]
      simp_rw [hpair, Finset.mul_sum]
      simp only [mul_assoc, mul_left_comm, mul_comm]

theorem weighted_double_sum_fourier_completion
    (m : ℕ) [NeZero m] (wD wN : ZMod m → ℂ)
    (F : ZMod m → ZMod m → ℂ) :
    let Fhat : ZMod m × ZMod m → ℂ := fun ξ =>
      ∑ d : ZMod m, ∑ n : ZMod m,
        F n d * ZMod.stdAddChar (-(d * ξ.1 + n * ξ.2))
    let M : ℝ := (Finset.univ : Finset (ZMod m × ZMod m)).sup'
      Finset.univ_nonempty (fun ξ => ‖Fhat ξ‖)
    let S : ℂ := ∑ d : ZMod m, ∑ n : ZMod m, wD d * wN n * F n d
    S = (m : ℂ)⁻¹ ^ 2 * ∑ ξ : ZMod m, ∑ η : ZMod m,
        ZMod.dft wD ξ * ZMod.dft wN η * Fhat (-ξ, -η) ∧
      ‖S‖ ≤ M * ((1 / (m : ℝ)) * ∑ ξ : ZMod m, ‖ZMod.dft wD ξ‖) *
        ((1 / (m : ℝ)) * ∑ η : ZMod m, ‖ZMod.dft wN η‖) := by
  classical
  intro Fhat M S
  have hdouble (ξ η : ZMod m) :
      ZMod.dft (fun d => ZMod.dft (fun n => F n d) η) ξ = Fhat (ξ, η) := by
    dsimp only [Fhat]
    simp only [ZMod.dft_apply, smul_eq_mul, Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro d hd
    apply Finset.sum_congr rfl
    intro n hn
    rw [neg_add, AddChar.map_add_eq_mul]
    ring
  have hS : S = (m : ℂ)⁻¹ ^ 2 * ∑ ξ : ZMod m, ∑ η : ZMod m,
      ZMod.dft wD ξ * ZMod.dft wN η * Fhat (-ξ, -η) := by
    calc
      _ = ∑ d : ZMod m, wD d * (∑ n : ZMod m, wN n * F n d) := by
        simp only [S, Finset.mul_sum, mul_assoc]
      _ = ∑ d : ZMod m, wD d * ((m : ℂ)⁻¹ * ∑ η : ZMod m,
          ZMod.dft wN η * ZMod.dft (fun n => F n d) (-η)) := by
        simp_rw [full_weighted_sum_dft m wN]
      _ = (m : ℂ)⁻¹ * ∑ η : ZMod m, ZMod.dft wN η *
          (∑ d : ZMod m, wD d * ZMod.dft (fun n => F n d) (-η)) := by
        simp only [Finset.mul_sum]
        rw [Finset.sum_comm]
        apply Finset.sum_congr rfl
        intro η hη
        apply Finset.sum_congr rfl
        intro d hd
        ring
      _ = (m : ℂ)⁻¹ * ∑ η : ZMod m, ZMod.dft wN η *
          ((m : ℂ)⁻¹ * ∑ ξ : ZMod m, ZMod.dft wD ξ *
            ZMod.dft (fun d => ZMod.dft (fun n => F n d) (-η)) (-ξ)) := by
        simp_rw [full_weighted_sum_dft m wD]
      _ = (m : ℂ)⁻¹ ^ 2 * ∑ ξ : ZMod m, ∑ η : ZMod m,
          ZMod.dft wD ξ * ZMod.dft wN η * Fhat (-ξ, -η) := by
        simp only [hdouble, Finset.mul_sum]
        rw [Finset.sum_comm]
        apply Finset.sum_congr rfl
        intro ξ hξ
        apply Finset.sum_congr rfl
        intro η hη
        ring
  have hM (ξ η : ZMod m) : ‖Fhat (ξ, η)‖ ≤ M :=
    Finset.le_sup' (fun ζ => ‖Fhat ζ‖) (Finset.mem_univ (ξ, η))
  have hnorm : ‖∑ ξ : ZMod m, ∑ η : ZMod m,
      ZMod.dft wD ξ * ZMod.dft wN η * Fhat (-ξ, -η)‖ ≤
      ∑ ξ : ZMod m, ∑ η : ZMod m, ‖ZMod.dft wD ξ‖ * ‖ZMod.dft wN η‖ * M := by
    refine norm_sum_le_of_le _ fun ξ hξ => ?_
    refine norm_sum_le_of_le _ fun η hη => ?_
    rw [norm_mul, norm_mul]
    exact mul_le_mul_of_nonneg_left (hM (-ξ) (-η))
      (mul_nonneg (norm_nonneg _) (norm_nonneg _))
  refine ⟨hS, ?_⟩
  rw [hS]
  calc
    _ = (m : ℝ)⁻¹ ^ 2 * ‖∑ ξ : ZMod m, ∑ η : ZMod m,
        ZMod.dft wD ξ * ZMod.dft wN η * Fhat (-ξ, -η)‖ := by
      rw [norm_mul, norm_pow, norm_inv, Complex.norm_natCast]
    _ ≤ (m : ℝ)⁻¹ ^ 2 * (∑ ξ : ZMod m, ∑ η : ZMod m,
        ‖ZMod.dft wD ξ‖ * ‖ZMod.dft wN η‖ * M) :=
      mul_le_mul_of_nonneg_left hnorm (sq_nonneg _)
    _ = (m : ℝ)⁻¹ ^ 2 *
        ((∑ ξ : ZMod m, ‖ZMod.dft wD ξ‖) * (∑ η : ZMod m, ‖ZMod.dft wN η‖) * M) := by
      congr 1
      rw [Finset.sum_mul_sum]
      simp only [Finset.sum_mul]
    _ = M * ((1 / (m : ℝ)) * ∑ ξ : ZMod m, ‖ZMod.dft wD ξ‖) *
        ((1 / (m : ℝ)) * ∑ η : ZMod m, ‖ZMod.dft wN η‖) := by
      simp only [one_div]
      ring

theorem compactProfiles_double_fourier_completion
    (m : ℕ) [NeZero m] (TD TN LD LN D N d₀ n₀ : ℝ)
    (hTD : 0 ≤ TD) (hTN : 0 ≤ TN) (hLD : 0 ≤ LD) (hLN : 0 ≤ LN)
    (hD : 0 < D) (hN : 0 < N)
    (ψD ψN : ℝ → ℂ) (hψD : ContDiff ℝ 1 ψD) (hψN : ContDiff ℝ 1 ψN)
    (hsupportD : Function.support ψD ⊆ Set.Icc (-TD) TD)
    (hsupportN : Function.support ψN ⊆ Set.Icc (-TN) TN)
    (hboundD : ∀ t : ℝ, ‖ψD t‖ ≤ LD ∧ ‖deriv ψD t‖ ≤ LD)
    (hboundN : ∀ t : ℝ, ‖ψN t‖ ≤ LN ∧ ‖deriv ψN t‖ ≤ LN)
    (F : ZMod m → ZMod m → ℂ) :
    let AD : ℤ := ⌈d₀ - TD * D⌉
    let AN : ℤ := ⌈n₀ - TN * N⌉
    let KD : ℕ := (⌊d₀ + TD * D⌋ + 1 - AD).toNat
    let KN : ℕ := (⌊n₀ + TN * N⌋ + 1 - AN).toNat
    let WD : ZMod m → ℂ := integerIntervalResidueWeight m AD KD
      (fun j => ψD (((AD : ℝ) + (j : ℝ) - d₀) / D))
    let WN : ZMod m → ℂ := integerIntervalResidueWeight m AN KN
      (fun j => ψN (((AN : ℝ) + (j : ℝ) - n₀) / N))
    let Fhat : ZMod m × ZMod m → ℂ := fun ξ =>
      ∑ d : ZMod m, ∑ n : ZMod m,
        F n d * ZMod.stdAddChar (-(d * ξ.1 + n * ξ.2))
    let M : ℝ := (Finset.univ : Finset (ZMod m × ZMod m)).sup'
      Finset.univ_nonempty (fun ξ => ‖Fhat ξ‖)
    let G : ℤ × ℤ → ℂ := fun z =>
      ψD (((z.1 : ℝ) - d₀) / D) * ψN (((z.2 : ℝ) - n₀) / N) *
        F (z.2 : ZMod m) (z.1 : ZMod m)
    let S : ℂ := ∑ d : ZMod m, ∑ n : ZMod m, WD d * WN n * F n d
    HasSum G S ∧ (∑' z : ℤ × ℤ, G z) = S ∧
      ‖S‖ ≤ M * (4 * TD + 3) * LD * (4 * TN + 3) * LN *
        (1 + Real.log (m : ℝ)) ^ 2 * (1 + D / (m : ℝ)) * (1 + N / (m : ℝ)) := by
  classical
  let AD : ℤ := ⌈d₀ - TD * D⌉
  let AN : ℤ := ⌈n₀ - TN * N⌉
  let BD : ℤ := ⌊d₀ + TD * D⌋
  let BN : ℤ := ⌊n₀ + TN * N⌋
  let KD : ℕ := (BD + 1 - AD).toNat
  let KN : ℕ := (BN + 1 - AN).toNat
  let wD : ℕ → ℂ := fun j => ψD (((AD : ℝ) + (j : ℝ) - d₀) / D)
  let wN : ℕ → ℂ := fun j => ψN (((AN : ℝ) + (j : ℝ) - n₀) / N)
  let WD : ZMod m → ℂ := integerIntervalResidueWeight m AD KD wD
  let WN : ZMod m → ℂ := integerIntervalResidueWeight m AN KN wN
  let Fhat : ZMod m × ZMod m → ℂ := fun ξ =>
    ∑ d : ZMod m, ∑ n : ZMod m,
      F n d * ZMod.stdAddChar (-(d * ξ.1 + n * ξ.2))
  let M : ℝ := (Finset.univ : Finset (ZMod m × ZMod m)).sup'
    Finset.univ_nonempty (fun ξ => ‖Fhat ξ‖)
  let G : ℤ × ℤ → ℂ := fun z =>
    ψD (((z.1 : ℝ) - d₀) / D) * ψN (((z.2 : ℝ) - n₀) / N) *
      F (z.2 : ZMod m) (z.1 : ZMod m)
  let S : ℂ := ∑ d : ZMod m, ∑ n : ZMod m, WD d * WN n * F n d
  change HasSum G S ∧ (∑' z : ℤ × ℤ, G z) = S ∧ _
  have hbox : HasSum G
      (∑ z ∈ (Finset.Icc AD BD) ×ˢ (Finset.Icc AN BN), G z) := by
    apply hasSum_sum_of_ne_finset_zero
    intro z hz
    by_contra h
    change ψD (((z.1 : ℝ) - d₀) / D) * ψN (((z.2 : ℝ) - n₀) / N) *
      F (z.2 : ZMod m) (z.1 : ZMod m) ≠ 0 at h
    have hv := mul_ne_zero_iff.mp (mul_ne_zero_iff.mp h).1
    have hd := hsupportD hv.1
    have hn := hsupportN hv.2
    have hdlo := (le_div_iff₀ hD).1 hd.1
    have hdhi := (div_le_iff₀ hD).1 hd.2
    have hnlo := (le_div_iff₀ hN).1 hn.1
    have hnhi := (div_le_iff₀ hN).1 hn.2
    apply hz
    exact Finset.mem_product.mpr
      ⟨Finset.mem_Icc.mpr ⟨Int.ceil_le.mpr (by linarith), Int.le_floor.mpr (by linarith)⟩,
        Finset.mem_Icc.mpr ⟨Int.ceil_le.mpr (by linarith), Int.le_floor.mpr (by linarith)⟩⟩
  have hS : S = ∑ z ∈ (Finset.Icc AD BD) ×ˢ (Finset.Icc AN BN), G z := by
    calc
      S = ∑ d : ZMod m, WD d * (∑ n : ZMod m, WN n * F n d) := by
        simp only [S, Finset.mul_sum, mul_assoc]
      _ = ∑ j ∈ Finset.range KD, wD j *
          (∑ n : ZMod m, WN n * F n ((AD + j : ℤ) : ZMod m)) :=
        (integerIntervalResidueWeight_spec m AD KD wD).1
          (fun d => ∑ n : ZMod m, WN n * F n d)
      _ = ∑ j ∈ Finset.range KD, ∑ k ∈ Finset.range KN,
          wD j * wN k * F ((AN + k : ℤ) : ZMod m) ((AD + j : ℤ) : ZMod m) := by
        apply Finset.sum_congr rfl
        intro j hj
        rw [(integerIntervalResidueWeight_spec m AN KN wN).1
          (fun n => F n ((AD + j : ℤ) : ZMod m)), Finset.mul_sum]
        apply Finset.sum_congr rfl
        intro k hk
        ring
      _ = _ := by
        rw [Finset.sum_product]
        simp only [Int.Icc_eq_finset_map, Finset.sum_map]
        apply Finset.sum_congr rfl
        intro j hj
        apply Finset.sum_congr rfl
        intro k hk
        simp only [Function.Embedding.trans_apply, Nat.castEmbedding_apply,
          addLeftEmbedding_apply, G, wD, wN, Int.cast_add, Int.cast_natCast]
  have hsum : HasSum G S := hS.symm ▸ hbox
  have hM : 0 ≤ M := Finset.le_sup'_of_le (fun ξ => ‖Fhat ξ‖)
    (Finset.mem_univ (0, 0)) (norm_nonneg _)
  have hJ : 0 ≤ 1 + Real.log (m : ℝ) :=
    add_nonneg zero_le_one (Real.log_nonneg (by exact_mod_cast NeZero.pos m))
  have hWD : (1 / (m : ℝ)) * ∑ ξ : ZMod m, ‖ZMod.dft WD ξ‖ ≤
      (4 * TD + 3) * LD * (1 + Real.log (m : ℝ)) * (1 + D / (m : ℝ)) :=
    (compactProfile_fourier_l1_bound m TD LD D d₀ hTD hLD hD
      ψD hψD hsupportD hboundD).2
  have hWN : (1 / (m : ℝ)) * ∑ η : ZMod m, ‖ZMod.dft WN η‖ ≤
      (4 * TN + 3) * LN * (1 + Real.log (m : ℝ)) * (1 + N / (m : ℝ)) :=
    (compactProfile_fourier_l1_bound m TN LN N n₀ hTN hLN hN
      ψN hψN hsupportN hboundN).2
  refine ⟨hsum, hsum.tsum_eq, ?_⟩
  calc
    ‖S‖ ≤ M * ((1 / (m : ℝ)) * ∑ ξ : ZMod m, ‖ZMod.dft WD ξ‖) *
        ((1 / (m : ℝ)) * ∑ η : ZMod m, ‖ZMod.dft WN η‖) :=
      (weighted_double_sum_fourier_completion m WD WN F).2
    _ ≤ M * ((4 * TD + 3) * LD * (1 + Real.log (m : ℝ)) * (1 + D / (m : ℝ))) *
        ((4 * TN + 3) * LN * (1 + Real.log (m : ℝ)) * (1 + N / (m : ℝ))) :=
      mul_le_mul (mul_le_mul_of_nonneg_left hWD hM) hWN (by positivity) (by positivity)
    _ = _ := by ring

theorem poleMasked_compactProfiles_double_fourier_completion
    (m : ℕ) [NeZero m] (a b ℓ η₁ η₂ : ZMod m)
    (TD TN LD LN D N d₀ n₀ : ℝ)
    (hTD : 0 ≤ TD) (hTN : 0 ≤ TN) (hLD : 0 ≤ LD) (hLN : 0 ≤ LN)
    (hD : 0 < D) (hN : 0 < N)
    (ψD ψN : ℝ → ℂ) (hψD : ContDiff ℝ 1 ψD) (hψN : ContDiff ℝ 1 ψN)
    (hsupportD : Function.support ψD ⊆ Set.Icc (-TD) TD)
    (hsupportN : Function.support ψN ⊆ Set.Icc (-TN) TN)
    (hboundD : ∀ t : ℝ, ‖ψD t‖ ≤ LD ∧ ‖deriv ψD t‖ ≤ LD)
    (hboundN : ∀ t : ℝ, ‖ψN t‖ ≤ LN ∧ ‖deriv ψN t‖ ≤ LN) :
    let E : ZMod m → ZMod m → ℂ := fun n d =>
      let u := n + b * d + η₁
      let v := n + (b + ℓ) * d + η₂
      if IsUnit (u * v) then ZMod.stdAddChar (a * ℓ * (u * v)⁻¹) else 0
    let Ehat : ZMod m × ZMod m → ℂ := fun ξ =>
      ∑ d : ZMod m, ∑ n : ZMod m,
        E n d * ZMod.stdAddChar (-(d * ξ.1 + n * ξ.2))
    let M : ℝ := (Finset.univ : Finset (ZMod m × ZMod m)).sup'
      Finset.univ_nonempty (fun ξ => ‖Ehat ξ‖)
    let G : ℤ × ℤ → ℂ := fun z =>
      ψD (((z.1 : ℝ) - d₀) / D) * ψN (((z.2 : ℝ) - n₀) / N) *
        E (z.2 : ZMod m) (z.1 : ZMod m)
    HasSum G (∑' z : ℤ × ℤ, G z) ∧
      ‖∑' z : ℤ × ℤ, G z‖ ≤
        M * (4 * TD + 3) * LD * (4 * TN + 3) * LN *
          (1 + Real.log (m : ℝ)) ^ 2 * (1 + D / (m : ℝ)) * (1 + N / (m : ℝ)) := by
  let E : ZMod m → ZMod m → ℂ := fun n d =>
    let u := n + b * d + η₁
    let v := n + (b + ℓ) * d + η₂
    if IsUnit (u * v) then ZMod.stdAddChar (a * ℓ * (u * v)⁻¹) else 0
  have h := compactProfiles_double_fourier_completion m TD TN LD LN D N d₀ n₀
    hTD hTN hLD hLN hD hN ψD ψN hψD hψN hsupportD hsupportN hboundD hboundN E
  exact ⟨h.1.summable.hasSum, (congrArg norm h.2.1).le.trans h.2.2⟩

theorem compactProfile_second_difference_bounds
    (T Lw N t₀ : ℝ)
    (hT : 0 ≤ T) (hLw : 0 ≤ Lw) (hN : 0 < N)
    (ψ : ℝ → ℂ) (hψ : ContDiff ℝ 2 ψ)
    (hsupport : Function.support ψ ⊆ Set.Icc (-T) T)
    (hbound : ∀ t : ℝ,
      ‖ψ t‖ ≤ Lw ∧ ‖deriv ψ t‖ ≤ Lw ∧ ‖deriv (deriv ψ) t‖ ≤ Lw) :
    let A : ℤ := ⌈t₀ - T * N⌉
    let B : ℤ := ⌊t₀ + T * N⌋
    let a : ℤ → ℂ := fun n => ψ (((n : ℝ) - t₀) / N)
    let Δ₂ : ℤ → ℂ := fun n => a (n + 2) - 2 * a (n + 1) + a n
    (∀ n : ℤ, n ∉ Finset.Icc A B → a n = 0) ∧
    (∑ n ∈ Finset.Icc A B, ‖a n‖) ≤ (2 * T * N + 1) * Lw ∧
    (∀ n : ℤ, n ∉ Finset.Icc (A - 2) B → Δ₂ n = 0) ∧
    (∀ n : ℤ, ‖Δ₂ n‖ ≤ Lw / N ^ 2) ∧
    (∑ n ∈ Finset.Icc (A - 2) B, ‖Δ₂ n‖) ≤
      (2 * T * N + 3) * Lw / N ^ 2 := by
  classical
  intro A B a Δ₂
  have hA : t₀ - T * N ≤ (A : ℝ) := Int.le_ceil _
  have hB : (B : ℝ) ≤ t₀ + T * N := Int.floor_le _
  have hcard (j : ℕ) :
      ((Finset.Icc (A - (j : ℤ)) B).card : ℝ) ≤ 2 * T * N + (j : ℝ) + 1 := by
    have hab : A ≤ B + 1 :=
      (Int.ceil_mono (show t₀ - T * N ≤ t₀ + T * N by
        nlinarith [mul_nonneg hT hN.le])).trans (Int.ceil_le_floor_add_one _)
    have he : ((Finset.Icc (A - (j : ℤ)) B).card : ℝ) =
        (B : ℝ) + 1 - ((A : ℝ) - (j : ℝ)) := by
      exact_mod_cast (Int.card_Icc_of_le (A - (j : ℤ)) B (by omega))
    rw [he]
    linarith
  have hzero (n : ℤ) (hn : n ∉ Finset.Icc A B) : a n = 0 := by
    by_contra he
    have hh := hsupport (show ((n : ℝ) - t₀) / N ∈ Function.support ψ from he)
    have hlo : t₀ - T * N ≤ (n : ℝ) := by
      have := (le_div_iff₀ hN).mp hh.1
      linarith
    have hhi : (n : ℝ) ≤ t₀ + T * N := by
      have := (div_le_iff₀ hN).mp hh.2
      linarith
    exact hn (Finset.mem_Icc.mpr ⟨Int.ceil_le.mpr hlo, Int.le_floor.mpr hhi⟩)
  have hmass : (∑ n ∈ Finset.Icc A B, ‖a n‖) ≤ (2 * T * N + 1) * Lw := by
    calc
      _ ≤ ∑ _n ∈ Finset.Icc A B, Lw :=
        Finset.sum_le_sum (fun n hn => (hbound _).1)
      _ = ((Finset.Icc A B).card : ℝ) * Lw := by simp
      _ ≤ (2 * T * N + 1) * Lw := by
        apply mul_le_mul_of_nonneg_right _ hLw
        simpa only [Nat.cast_zero, sub_zero, add_zero] using hcard 0
  have hΔzero (n : ℤ) (hn : n ∉ Finset.Icc (A - 2) B) : Δ₂ n = 0 := by
    have hn₀ : n ∉ Finset.Icc A B := by
      simp only [Finset.mem_Icc] at hn ⊢
      omega
    have hn₁ : n + 1 ∉ Finset.Icc A B := by
      simp only [Finset.mem_Icc] at hn ⊢
      omega
    have hn₂ : n + 2 ∉ Finset.Icc A B := by
      simp only [Finset.mem_Icc] at hn ⊢
      omega
    simp only [Δ₂, hzero n hn₀, hzero (n + 1) hn₁, hzero (n + 2) hn₂,
      mul_zero, sub_self, add_zero]
  let h : ℝ := 1 / N
  have hh : 0 < h := one_div_pos.mpr hN
  have hψd : Differentiable ℝ ψ := hψ.differentiable (by norm_num)
  let g : ℝ → ℂ := fun x => ψ (x + h) - ψ x
  have hshift : Differentiable ℝ (fun x : ℝ => ψ (x + h)) :=
    hψd.comp (differentiable_id.add_const h)
  have hg : Differentiable ℝ g := hshift.sub hψd
  have hgderiv (x : ℝ) : deriv g x = deriv ψ (x + h) - deriv ψ x := by
    dsimp only [g]
    rw [deriv_fun_sub (hshift x) (hψd x), deriv_comp_add_const]
  have hgbound (x : ℝ) : ‖deriv g x‖ ≤ Lw * h := by
    rw [hgderiv]
    have hx := Convex.norm_image_sub_le_of_norm_deriv_le
      (fun y _ => hψ.differentiable_deriv_two y) (fun y _ => (hbound y).2.2)
      (convex_univ : Convex ℝ (Set.univ : Set ℝ))
      (Set.mem_univ x) (Set.mem_univ (x + h))
    simpa only [add_sub_cancel_left, Real.norm_eq_abs, abs_of_pos hh] using hx
  have hsecond (x : ℝ) :
      ‖ψ (x + 2 * h) - 2 * ψ (x + h) + ψ x‖ ≤ Lw * h ^ 2 := by
    have hx := Convex.norm_image_sub_le_of_norm_deriv_le
      (fun y _ => hg y) (fun y _ => hgbound y)
      (convex_univ : Convex ℝ (Set.univ : Set ℝ))
      (Set.mem_univ x) (Set.mem_univ (x + h))
    have he : g (x + h) - g x = ψ (x + 2 * h) - 2 * ψ (x + h) + ψ x := by
      dsimp only [g]
      rw [show x + h + h = x + 2 * h by ring]
      ring
    rw [he, add_sub_cancel_left, Real.norm_eq_abs, abs_of_pos hh] at hx
    calc
      _ ≤ (Lw * h) * h := hx
      _ = Lw * h ^ 2 := by ring
  have hΔbound (n : ℤ) : ‖Δ₂ n‖ ≤ Lw / N ^ 2 := by
    let x : ℝ := ((n : ℝ) - t₀) / N
    have h₁ : (((n + 1 : ℤ) : ℝ) - t₀) / N = x + h := by
      dsimp only [x, h]
      push_cast
      ring
    have h₂ : (((n + 2 : ℤ) : ℝ) - t₀) / N = x + 2 * h := by
      dsimp only [x, h]
      push_cast
      ring
    change ‖ψ ((((n + 2 : ℤ) : ℝ) - t₀) / N) -
      2 * ψ ((((n + 1 : ℤ) : ℝ) - t₀) / N) + ψ x‖ ≤ Lw / N ^ 2
    rw [h₁, h₂]
    calc
      _ ≤ Lw * h ^ 2 := hsecond x
      _ = Lw / N ^ 2 := by
        dsimp only [h]
        field_simp
  refine ⟨hzero, hmass, hΔzero, hΔbound, ?_⟩
  calc
    _ ≤ ∑ _n ∈ Finset.Icc (A - 2) B, Lw / N ^ 2 :=
      Finset.sum_le_sum (fun n hn => hΔbound n)
    _ = ((Finset.Icc (A - 2) B).card : ℝ) * (Lw / N ^ 2) := by simp
    _ ≤ (2 * T * N + (2 : ℝ) + 1) * (Lw / N ^ 2) :=
      mul_le_mul_of_nonneg_right (hcard 2) (div_nonneg hLw (sq_nonneg N))
    _ = (2 * T * N + 3) * Lw / N ^ 2 := by ring

theorem square_frequency_sum_bound
    (m : ℕ) [NeZero m] (N : ℝ) (hN : 0 < N) :
    (1 / (m : ℝ)) *
      (∑ ξ ∈ (Finset.univ : Finset (ZMod m)).erase 0,
        min N ((m : ℝ) ^ 2 /
          (N * ((min ξ.val (m - ξ.val) : ℕ) : ℝ) ^ 2))) ≤ 6 := by
  classical
  have hm : (0 : ℝ) < m := by exact_mod_cast NeZero.pos m
  let f : ℕ → ℝ := fun k => min N ((m : ℝ) ^ 2 / (N * (k : ℝ) ^ 2))
  let J : ℕ := ⌊(m : ℝ) / N⌋₊
  let lo := (Finset.Ico 1 m).filter (fun k => k ≤ J)
  let hi := (Finset.Ico 1 m).filter (fun k => ¬k ≤ J)
  have hf (k : ℕ) : 0 ≤ f k :=
    le_min hN.le (div_nonneg (sq_nonneg _) (mul_nonneg hN.le (sq_nonneg _)))
  have hJ : (J : ℝ) ≤ (m : ℝ) / N := Nat.floor_le (by positivity)
  have hJ' : (m : ℝ) / N < (J : ℝ) + 1 := Nat.lt_floor_add_one _
  have hJpos : (0 : ℝ) < (J : ℝ) + 1 := by positivity
  have hlocard : lo.card ≤ J := by
    calc
      lo.card ≤ (Finset.Icc 1 J).card := Finset.card_le_card (by
        intro k hk
        obtain ⟨hk, hkJ⟩ := Finset.mem_filter.mp hk
        exact Finset.mem_Icc.mpr ⟨(Finset.mem_Ico.mp hk).1, hkJ⟩)
      _ = J := by simp
  have hlo : (∑ k ∈ lo, f k) ≤ (m : ℝ) := by
    calc
      (∑ k ∈ lo, f k) ≤ ∑ _k ∈ lo, N :=
        Finset.sum_le_sum (fun k _ => min_le_left _ _)
      _ = (lo.card : ℝ) * N := by simp
      _ ≤ (J : ℝ) * N :=
        mul_le_mul_of_nonneg_right (by exact_mod_cast hlocard) hN.le
      _ ≤ (m : ℝ) := (le_div_iff₀ hN).mp hJ
  have hhi : hi = Finset.Ioo J m := by
    ext k
    simp only [hi, Finset.mem_filter, Finset.mem_Ico, Finset.mem_Ioo]
    omega
  have hhisum : (∑ k ∈ hi, f k) ≤ 2 * (m : ℝ) := by
    calc
      (∑ k ∈ hi, f k) ≤ ∑ k ∈ hi, (m : ℝ) ^ 2 / (N * (k : ℝ) ^ 2) :=
        Finset.sum_le_sum (fun k _ => min_le_right _ _)
      _ = ((m : ℝ) ^ 2 / N) *
          ∑ k ∈ Finset.Ioo J m, ((k : ℝ) ^ 2)⁻¹ := by
        rw [hhi, Finset.mul_sum]
        apply Finset.sum_congr rfl
        intro k _
        simp only [div_eq_mul_inv, mul_inv_rev]
        ring
      _ ≤ ((m : ℝ) ^ 2 / N) * (2 / ((J : ℝ) + 1)) :=
        mul_le_mul_of_nonneg_left (sum_Ioo_inv_sq_le J m)
          (div_nonneg (sq_nonneg _) hN.le)
      _ = (2 * (m : ℝ)) * (((m : ℝ) / N) / ((J : ℝ) + 1)) := by ring
      _ ≤ (2 * (m : ℝ)) * 1 :=
        mul_le_mul_of_nonneg_left ((div_le_one hJpos).mpr hJ'.le) (by positivity)
      _ = 2 * (m : ℝ) := mul_one _
  have hside : (∑ k ∈ Finset.Ico 1 m, f k) ≤ 3 * (m : ℝ) := by
    calc
      (∑ k ∈ Finset.Ico 1 m, f k) = (∑ k ∈ lo, f k) + ∑ k ∈ hi, f k :=
        (Finset.sum_filter_add_sum_filter_not (Finset.Ico 1 m) (fun k => k ≤ J) f).symm
      _ ≤ (m : ℝ) + 2 * (m : ℝ) := add_le_add hlo hhisum
      _ = 3 * (m : ℝ) := by ring
  have hreflect : (∑ k ∈ Finset.Ico 1 m, f (m - k)) =
      ∑ k ∈ Finset.Ico 1 m, f k := by
    simpa using (Finset.sum_Ico_reflect f 1 (m := m) (n := m) (Nat.le_succ m))
  have hmin (k : ℕ) : f (min k (m - k)) ≤ f k + f (m - k) := by
    by_cases hk : k ≤ m - k
    · rw [min_eq_left hk]
      exact le_add_of_nonneg_right (hf _)
    · rw [min_eq_right (le_of_not_ge hk)]
      exact le_add_of_nonneg_left (hf _)
  change (1 / (m : ℝ)) *
    (∑ ξ ∈ (Finset.univ : Finset (ZMod m)).erase 0,
      f (min ξ.val (m - ξ.val))) ≤ 6
  rw [sum_zmod_erase_zero_eq_sum_Ico m (fun k => f (min k (m - k)))]
  calc
    (1 / (m : ℝ)) * (∑ k ∈ Finset.Ico 1 m, f (min k (m - k))) ≤
        (1 / (m : ℝ)) * (∑ k ∈ Finset.Ico 1 m, (f k + f (m - k))) :=
      mul_le_mul_of_nonneg_left (Finset.sum_le_sum (fun k _ => hmin k)) (by positivity)
    _ = (1 / (m : ℝ)) * (2 * ∑ k ∈ Finset.Ico 1 m, f k) := by
      rw [Finset.sum_add_distrib, hreflect]
      ring
    _ ≤ (1 / (m : ℝ)) * (2 * (3 * (m : ℝ))) :=
      mul_le_mul_of_nonneg_left
        (mul_le_mul_of_nonneg_left hside (by norm_num)) (by positivity)
    _ = 6 := by field_simp [hm.ne']; ring

theorem hasSum_shift_character
    (m : ℕ) [NeZero m] (a : ℤ → ℂ) (ξ : ZMod m) (S : ℂ)
    (h : HasSum (fun n : ℤ => a n * ZMod.stdAddChar (-((n : ZMod m) * ξ))) S)
    (j : ℤ) :
    HasSum (fun n : ℤ => a (n + j) * ZMod.stdAddChar (-((n : ZMod m) * ξ)))
      (ZMod.stdAddChar ((j : ZMod m) * ξ) * S) := by
  have hs : HasSum
      (fun n : ℤ => a (n + j) * ZMod.stdAddChar (-(((n + j : ℤ) : ZMod m) * ξ)))
      S := ((Equiv.addRight j).hasSum_iff
        (f := fun n : ℤ => a n * ZMod.stdAddChar (-((n : ZMod m) * ξ)))).mpr h
  have hc (n : ℤ) :
      ZMod.stdAddChar ((j : ZMod m) * ξ) *
          ZMod.stdAddChar (-(((n + j : ℤ) : ZMod m) * ξ)) =
        ZMod.stdAddChar (-((n : ZMod m) * ξ)) := by
    rw [← AddChar.map_add_eq_mul]
    congr 1
    push_cast
    ring
  apply (hs.mul_left (ZMod.stdAddChar ((j : ZMod m) * ξ))).congr_fun
  intro n
  rw [mul_left_comm, hc]

theorem integer_second_difference_fourier_bound
    (m : ℕ) [NeZero m] (a : ℤ → ℂ) (ξ : ZMod m) (S : ℂ)
    (h : HasSum (fun n : ℤ => a n * ZMod.stdAddChar (-((n : ZMod m) * ξ))) S)
    (s : Finset ℤ)
    (hs : ∀ n : ℤ, n ∉ s → a (n + 2) - 2 * a (n + 1) + a n = 0) :
    ‖ZMod.stdAddChar ξ - 1‖ ^ 2 * ‖S‖ ≤
      ∑ n ∈ s, ‖a (n + 2) - 2 * a (n + 1) + a n‖ := by
  have htwo : ZMod.stdAddChar ((2 : ZMod m) * ξ) = ZMod.stdAddChar ξ ^ 2 := by
    rw [two_mul, AddChar.map_add_eq_mul, pow_two]
  have h1 := hasSum_shift_character m a ξ S h 1
  have h2 := hasSum_shift_character m a ξ S h 2
  simp only [Int.cast_one, one_mul] at h1
  simp only [Int.cast_ofNat, htwo] at h2
  have hd : HasSum
      (fun n : ℤ => (a (n + 2) - 2 * a (n + 1) + a n) *
        ZMod.stdAddChar (-((n : ZMod m) * ξ)))
      ((ZMod.stdAddChar ξ - 1) ^ 2 * S) := by
    have hsum := (h2.sub (h1.mul_left (2 : ℂ))).add h
    have hv : ZMod.stdAddChar ξ ^ 2 * S - 2 * (ZMod.stdAddChar ξ * S) + S =
        (ZMod.stdAddChar ξ - 1) ^ 2 * S := by ring
    rw [hv] at hsum
    exact hsum.congr_fun (fun n => by ring)
  have hn : HasSum
      (fun n : ℤ => ‖a (n + 2) - 2 * a (n + 1) + a n‖)
      (∑ n ∈ s, ‖a (n + 2) - 2 * a (n + 1) + a n‖) := by
    apply hasSum_sum_of_ne_finset_zero
    intro n hn
    rw [hs n hn, norm_zero]
  have hb := hd.norm_le_of_bounded hn (fun n => by simp)
  simpa only [norm_mul, norm_pow] using hb

theorem compactProfile_fourier_l1_bound_logfree
    (m : ℕ) [NeZero m] (T Lw N t₀ : ℝ)
    (hT : 0 ≤ T) (hLw : 0 ≤ Lw) (hN : 0 < N)
    (ψ : ℝ → ℂ) (hψ : ContDiff ℝ 2 ψ)
    (hsupport : Function.support ψ ⊆ Set.Icc (-T) T)
    (hbound : ∀ t : ℝ,
      ‖ψ t‖ ≤ Lw ∧ ‖deriv ψ t‖ ≤ Lw ∧ ‖deriv (deriv ψ) t‖ ≤ Lw) :
    let A : ℤ := ⌈t₀ - T * N⌉
    let K : ℕ := (⌊t₀ + T * N⌋ + 1 - A).toNat
    let W : ZMod m → ℂ := integerIntervalResidueWeight m A K
      (fun j => ψ (((A : ℝ) + (j : ℝ) - t₀) / N))
    (∀ ξ : ZMod m,
      HasSum (fun n : ℤ => ψ (((n : ℝ) - t₀) / N) *
        ZMod.stdAddChar (-((n : ZMod m) * ξ))) (ZMod.dft W ξ)) ∧
    (1 / (m : ℝ)) * ∑ ξ : ZMod m, ‖ZMod.dft W ξ‖ ≤
      (6 * (2 * T + 3)) * Lw * (1 + N / (m : ℝ)) := by
  classical
  let A : ℤ := ⌈t₀ - T * N⌉
  let B : ℤ := ⌊t₀ + T * N⌋
  let K : ℕ := (B + 1 - A).toNat
  let w : ℕ → ℂ := fun j => ψ (((A : ℝ) + (j : ℝ) - t₀) / N)
  let W : ZMod m → ℂ := integerIntervalResidueWeight m A K w
  let a : ℤ → ℂ := fun n => ψ (((n : ℝ) - t₀) / N)
  have controls := compactProfile_second_difference_bounds
    T Lw N t₀ hT hLw hN ψ hψ hsupport hbound
  change
    (∀ n : ℤ, n ∉ Finset.Icc A B → a n = 0) ∧
    (∑ n ∈ Finset.Icc A B, ‖a n‖) ≤ (2 * T * N + 1) * Lw ∧
    (∀ n : ℤ, n ∉ Finset.Icc (A - 2) B → a (n + 2) - 2 * a (n + 1) + a n = 0) ∧
    (∀ n : ℤ, ‖a (n + 2) - 2 * a (n + 1) + a n‖ ≤ Lw / N ^ 2) ∧
    (∑ n ∈ Finset.Icc (A - 2) B, ‖a (n + 2) - 2 * a (n + 1) + a n‖) ≤
      (2 * T * N + 3) * Lw / N ^ 2 at controls
  obtain ⟨hsupp, hmass, hsupp₂, _, hmass₂⟩ := controls
  have hdft (ξ : ZMod m) : ZMod.dft W ξ =
      ∑ n ∈ Finset.Icc A B, a n * ZMod.stdAddChar (-((n : ZMod m) * ξ)) := by
    change ZMod.dft (integerIntervalResidueWeight m A K w) ξ = _
    rw [(integerIntervalResidueWeight_spec m A K w).2.1 ξ,
      Int.Icc_eq_finset_map, Finset.sum_map]
    apply Finset.sum_congr rfl
    intro j hj
    simp only [Function.Embedding.trans_apply, Nat.castEmbedding_apply,
      addLeftEmbedding_apply, Int.cast_add, Int.cast_natCast, w, a]
  have hcomplete (ξ : ZMod m) :
      HasSum (fun n : ℤ => a n * ZMod.stdAddChar (-((n : ZMod m) * ξ)))
        (ZMod.dft W ξ) := by
    rw [hdft ξ]
    apply hasSum_sum_of_ne_finset_zero
    intro n hn
    rw [hsupp n hn, zero_mul]
  have hnorm (ξ : ZMod m) : ‖ZMod.dft W ξ‖ ≤ (2 * T * N + 1) * Lw := by
    rw [hdft ξ]
    calc
      _ ≤ ∑ n ∈ Finset.Icc A B, ‖a n‖ :=
        norm_sum_le_of_le _ (fun n _ => by simp)
      _ ≤ _ := hmass
  have hm : (0 : ℝ) < m := by exact_mod_cast NeZero.pos m
  have hx : 0 ≤ N / (m : ℝ) := div_nonneg hN.le hm.le
  change (∀ ξ : ZMod m,
      HasSum (fun n : ℤ => a n * ZMod.stdAddChar (-((n : ZMod m) * ξ)))
        (ZMod.dft W ξ)) ∧ _
  refine ⟨hcomplete, ?_⟩
  by_cases hsmall : N ≤ 1
  · calc
      _ ≤ (1 / (m : ℝ)) *
          ∑ _ξ : ZMod m, (2 * T * N + 1) * Lw := by
        apply mul_le_mul_of_nonneg_left (Finset.sum_le_sum (fun ξ _ => hnorm ξ))
        positivity
      _ = (2 * T * N + 1) * Lw := by
        simp only [Finset.sum_const, Finset.card_univ, ZMod.card, nsmul_eq_mul]
        field_simp [hm.ne']
      _ ≤ (2 * T + 1) * Lw :=
        mul_le_mul_of_nonneg_right (by nlinarith) hLw
      _ ≤ (6 * (2 * T + 3)) * Lw :=
        mul_le_mul_of_nonneg_right (by linarith) hLw
      _ ≤ _ := le_mul_of_one_le_right (by positivity) (le_add_of_nonneg_right hx)
  · have hlarge : 1 ≤ N := le_of_lt (lt_of_not_ge hsmall)
    let C₀ : ℝ := (2 * T + 3) * Lw
    have hC₀ : 0 ≤ C₀ := by dsimp [C₀]; positivity
    have hnormC (ξ : ZMod m) : ‖ZMod.dft W ξ‖ ≤ C₀ * N := by
      calc
        _ ≤ (2 * T * N + 1) * Lw := hnorm ξ
        _ ≤ ((2 * T + 3) * N) * Lw :=
          mul_le_mul_of_nonneg_right (by nlinarith) hLw
        _ = _ := by dsimp [C₀]; ring
    have hmassC :
        (∑ n ∈ Finset.Icc (A - 2) B, ‖a (n + 2) - 2 * a (n + 1) + a n‖) ≤
          C₀ / N := by
      calc
        _ ≤ (2 * T * N + 3) * Lw / N ^ 2 := hmass₂
        _ ≤ ((2 * T + 3) * N) * Lw / N ^ 2 := by
          apply div_le_div_of_nonneg_right
            (mul_le_mul_of_nonneg_right (by nlinarith) hLw) (sq_nonneg N)
        _ = C₀ / N := by dsimp [C₀]; field_simp
    have hfreq (ξ : ZMod m) (hξ : ξ ≠ 0) :
        ‖ZMod.dft W ξ‖ ≤ C₀ *
          min N ((m : ℝ) ^ 2 / (N * ((min ξ.val (m - ξ.val) : ℕ) : ℝ) ^ 2)) := by
      let k : ℝ := (min ξ.val (m - ξ.val) : ℕ)
      have hk : 0 < k := by
        dsimp [k]
        exact_mod_cast lt_min (ZMod.val_pos.mpr hξ)
          (Nat.sub_pos_of_lt (ZMod.val_lt ξ))
      have hchord : k / (m : ℝ) ≤ ‖ZMod.stdAddChar ξ - 1‖ := by
        calc
          _ ≤ 4 * k / (m : ℝ) := by
            apply div_le_div_of_nonneg_right _ hm.le
            linarith
          _ ≤ _ := by
            simpa only [k, Nat.cast_min, Nat.cast_sub (ZMod.val_lt ξ).le] using
              four_mul_min_val_div_le_norm_stdAddChar_sub_one m ξ
      have hsquare : (k / (m : ℝ)) ^ 2 ≤ ‖ZMod.stdAddChar ξ - 1‖ ^ 2 :=
        pow_le_pow_left₀ (by positivity) hchord 2
      have hscaled : (k / (m : ℝ)) ^ 2 * ‖ZMod.dft W ξ‖ ≤ C₀ / N := by
        calc
          _ ≤ ‖ZMod.stdAddChar ξ - 1‖ ^ 2 * ‖ZMod.dft W ξ‖ :=
            mul_le_mul_of_nonneg_right hsquare (norm_nonneg _)
          _ ≤ ∑ n ∈ Finset.Icc (A - 2) B,
              ‖a (n + 2) - 2 * a (n + 1) + a n‖ :=
            integer_second_difference_fourier_bound m a ξ (ZMod.dft W ξ)
              (hcomplete ξ) (Finset.Icc (A - 2) B) hsupp₂
          _ ≤ _ := hmassC
      have hhigh : ‖ZMod.dft W ξ‖ ≤ C₀ * ((m : ℝ) ^ 2 / (N * k ^ 2)) := by
        calc
          _ ≤ (C₀ / N) / (k / (m : ℝ)) ^ 2 :=
            (le_div_iff₀ (by positivity)).2 (by simpa [mul_comm] using hscaled)
          _ = _ := by field_simp
      rw [mul_min_of_nonneg _ _ hC₀]
      exact le_min (hnormC ξ) hhigh
    have hnonzero : (1 / (m : ℝ)) *
        ∑ ξ ∈ (Finset.univ : Finset (ZMod m)).erase 0, ‖ZMod.dft W ξ‖ ≤ 6 * C₀ := by
      calc
        _ ≤ (1 / (m : ℝ)) *
            ∑ ξ ∈ (Finset.univ : Finset (ZMod m)).erase 0,
              C₀ * min N ((m : ℝ) ^ 2 /
                (N * ((min ξ.val (m - ξ.val) : ℕ) : ℝ) ^ 2)) := by
          apply mul_le_mul_of_nonneg_left _ (by positivity)
          exact Finset.sum_le_sum (fun ξ hξ => hfreq ξ (Finset.mem_erase.mp hξ).1)
        _ = C₀ * ((1 / (m : ℝ)) *
            ∑ ξ ∈ (Finset.univ : Finset (ZMod m)).erase 0,
              min N ((m : ℝ) ^ 2 /
                (N * ((min ξ.val (m - ξ.val) : ℕ) : ℝ) ^ 2))) := by
          rw [← Finset.mul_sum]
          ring
        _ ≤ C₀ * 6 := mul_le_mul_of_nonneg_left (square_frequency_sum_bound m N hN) hC₀
        _ = _ := mul_comm _ _
    have hzero : (1 / (m : ℝ)) * ‖ZMod.dft W 0‖ ≤ C₀ * (N / (m : ℝ)) := by
      calc
        _ ≤ (1 / (m : ℝ)) * (C₀ * N) :=
          mul_le_mul_of_nonneg_left (hnormC 0) (by positivity)
        _ = _ := by ring
    rw [← Finset.sum_erase_add (Finset.univ : Finset (ZMod m)) _ (Finset.mem_univ 0),
      mul_add]
    calc
      _ ≤ 6 * C₀ + C₀ * (N / (m : ℝ)) := add_le_add hnonzero hzero
      _ ≤ 6 * C₀ * (1 + N / (m : ℝ)) := by nlinarith [mul_nonneg hC₀ hx]
      _ = _ := by dsimp [C₀]; ring

theorem sourcePhase_inv_mul {q : ℕ} (x y : ZMod q)
    (hx : IsUnit x) (hy : IsUnit y) : (x * y)⁻¹ = y⁻¹ * x⁻¹ := by
  rcases hx with ⟨u, rfl⟩
  rcases hy with ⟨v, rfl⟩
  simp only [← Units.val_mul, ZMod.inv_coe_unit, mul_inv_rev]

theorem sourcePhase_stdAddChar_three
    (r U V : ℕ) [NeZero r] [NeZero U] [NeZero V]
    (hru : Nat.Coprime r (U * V)) (huv : Nat.Coprime U V) (j : ℤ) :
    ZMod.stdAddChar (j : ZMod (r * (U * V))) =
      ZMod.stdAddChar (((U * V : ℕ) : ZMod r)⁻¹ * (j : ZMod r)) *
        ZMod.stdAddChar (((r * V : ℕ) : ZMod U)⁻¹ * (j : ZMod U)) *
        ZMod.stdAddChar (((r * U : ℕ) : ZMod V)⁻¹ * (j : ZMod V)) := by
  let πU : ZMod (U * V) →+* ZMod U :=
    (RingHom.fst (ZMod U) (ZMod V)).comp (ZMod.chineseRemainder huv).toRingHom
  let πV : ZMod (U * V) →+* ZMod V :=
    (RingHom.snd (ZMod U) (ZMod V)).comp (ZMod.chineseRemainder huv).toRingHom
  have hunit : IsUnit (r : ZMod (U * V)) :=
    (ZMod.isUnit_iff_coprime r (U * V)).mpr hru
  have hinvU : ((r * V : ℕ) : ZMod U)⁻¹ =
      (V : ZMod U)⁻¹ * (r : ZMod U)⁻¹ := by
    rw [Nat.cast_mul, sourcePhase_inv_mul (r : ZMod U) (V : ZMod U)
      ((ZMod.isUnit_iff_coprime r U).mpr hru.coprime_mul_right_right)
      ((ZMod.isUnit_iff_coprime V U).mpr huv.symm)]
  have hinvV : ((r * U : ℕ) : ZMod V)⁻¹ =
      (U : ZMod V)⁻¹ * (r : ZMod V)⁻¹ := by
    rw [Nat.cast_mul, sourcePhase_inv_mul (r : ZMod V) (U : ZMod V)
      ((ZMod.isUnit_iff_coprime r V).mpr hru.coprime_mul_left_right)
      ((ZMod.isUnit_iff_coprime U V).mpr huv)]
  have hinner :
      ZMod.stdAddChar ((r : ZMod (U * V))⁻¹ * (j : ZMod (U * V))) =
        ZMod.stdAddChar (((r * V : ℕ) : ZMod U)⁻¹ * (j : ZMod U)) *
          ZMod.stdAddChar (((r * U : ℕ) : ZMod V)⁻¹ * (j : ZMod V)) := by
    have hchar := stdAddChar_coprime_crt U V huv
      ((r : ZMod (U * V))⁻¹ * (j : ZMod (U * V)))
    change ZMod.stdAddChar ((r : ZMod (U * V))⁻¹ * (j : ZMod (U * V))) =
      ZMod.stdAddChar ((V : ZMod U)⁻¹ *
        πU ((r : ZMod (U * V))⁻¹ * (j : ZMod (U * V)))) *
      ZMod.stdAddChar ((U : ZMod V)⁻¹ *
        πV ((r : ZMod (U * V))⁻¹ * (j : ZMod (U * V)))) at hchar
    simpa only [map_mul, phaseCRT_map_inv πU hunit, phaseCRT_map_inv πV hunit,
      map_natCast, map_intCast, hinvU, hinvV, mul_assoc] using hchar
  have houter := stdAddChar_coprime_crt r (U * V) hru (j : ZMod (r * (U * V)))
  simp only [map_intCast, Prod.fst_intCast, Prod.snd_intCast] at houter
  rw [houter, hinner, mul_assoc]

theorem poleMasked_compactProfiles_congruence_completion
    (q r : ℕ) [NeZero q] [NeZero r] (hqr : Nat.Coprime q r)
    (A B L : ZMod (q * r)) (dStar nStar : ℤ)
    (TD TN LD LN D N d₀ n₀ : ℝ)
    (hTD : 0 ≤ TD) (hTN : 0 ≤ TN) (hLD : 0 ≤ LD) (hLN : 0 ≤ LN)
    (hD : 0 < D) (hN : 0 < N)
    (ψD ψN : ℝ → ℂ) (hψD : ContDiff ℝ 1 ψD) (hψN : ContDiff ℝ 1 ψN)
    (hsupportD : Function.support ψD ⊆ Set.Icc (-TD) TD)
    (hsupportN : Function.support ψN ⊆ Set.Icc (-TN) TN)
    (hboundD : ∀ t : ℝ, ‖ψD t‖ ≤ LD ∧ ‖deriv ψD t‖ ≤ LD)
    (hboundN : ∀ t : ℝ, ‖ψN t‖ ≤ LN ∧ ‖deriv ψN t‖ ≤ LN) :
    let C : ℂ := affineReciprocalProductPhase q
      ((A.val : ZMod q) * (r : ZMod q)⁻¹)
      (B.val : ZMod q) (L.val : ZMod q) 0 0
      (nStar : ZMod q) (dStar : ZMod q)
    let A' : ZMod r := (A.val : ZMod r) * ((q : ZMod r)⁻¹) ^ 3
    let B' : ZMod r := (B.val : ZMod r)
    let L' : ZMod r := (L.val : ZMod r)
    let η₁ : ZMod r := ((nStar : ZMod r) + B' * (dStar : ZMod r)) * (q : ZMod r)⁻¹
    let η₂ : ZMod r := ((nStar : ZMod r) + (B' + L') * (dStar : ZMod r)) *
      (q : ZMod r)⁻¹
    let E : ZMod r → ZMod r → ℂ := affineReciprocalProductPhase r A' B' L' η₁ η₂
    let Ehat : ZMod r × ZMod r → ℂ := fun ξ =>
      ∑ d : ZMod r, ∑ n : ZMod r,
        E n d * ZMod.stdAddChar (-(d * ξ.1 + n * ξ.2))
    let M : ℝ := (Finset.univ : Finset (ZMod r × ZMod r)).sup'
      Finset.univ_nonempty (fun ξ => ‖Ehat ξ‖)
    let H : ℤ × ℤ → ℂ := fun z =>
      ψD (((z.1 : ℝ) - (d₀ - (dStar : ℝ)) / (q : ℝ)) / (D / (q : ℝ))) *
        ψN (((z.2 : ℝ) - (n₀ - (nStar : ℝ)) / (q : ℝ)) / (N / (q : ℝ))) *
          E (z.2 : ZMod r) (z.1 : ZMod r)
    let G : ℤ × ℤ → ℂ := fun z =>
      if Int.ModEq (q : ℤ) dStar z.1 ∧ Int.ModEq (q : ℤ) nStar z.2 then
        ψD (((z.1 : ℝ) - d₀) / D) * ψN (((z.2 : ℝ) - n₀) / N) *
          affineReciprocalProductPhase (q * r) A B L 0 0
            (z.2 : ZMod (q * r)) (z.1 : ZMod (q * r))
      else 0
    HasSum H (∑' z : ℤ × ℤ, H z) ∧
      HasSum G (C * ∑' z : ℤ × ℤ, H z) ∧
      (∑' z : ℤ × ℤ, G z) = (C * ∑' z : ℤ × ℤ, H z) ∧
      ‖∑' z : ℤ × ℤ, G z‖ ≤
        (M / (r : ℝ)) * (4 * TD + 3) * LD * (4 * TN + 3) * LN *
          (1 + Real.log (r : ℝ)) ^ 2 * (1 / (q : ℝ)) *
          (Real.sqrt ((q * r : ℕ) : ℝ) + N / Real.sqrt ((q * r : ℕ) : ℝ)) *
          (Real.sqrt ((q * r : ℕ) : ℝ) + D / Real.sqrt ((q * r : ℕ) : ℝ)) := by
  classical
  intro C A' B' L' η₁ η₂ E Ehat M H G
  have hq : (0 : ℝ) < q := by exact_mod_cast NeZero.pos q
  have hr : (0 : ℝ) < r := by exact_mod_cast NeZero.pos r
  have hphase := affineReciprocalProductPhase_congruence_restriction
    q r hqr A B L nStar dStar
  have hcomplete := compactProfiles_double_fourier_completion r TD TN LD LN
    (D / (q : ℝ)) (N / (q : ℝ))
    ((d₀ - (dStar : ℝ)) / (q : ℝ)) ((n₀ - (nStar : ℝ)) / (q : ℝ))
    hTD hTN hLD hLN (div_pos hD hq) (div_pos hN hq)
    ψD ψN hψD hψN hsupportD hsupportN hboundD hboundN E
  have hH : HasSum H (∑' z : ℤ × ℤ, H z) := hcomplete.1.summable.hasSum
  have hboundH : ‖∑' z : ℤ × ℤ, H z‖ ≤
      M * (4 * TD + 3) * LD * (4 * TN + 3) * LN *
        (1 + Real.log (r : ℝ)) ^ 2 *
        (1 + (D / (q : ℝ)) / (r : ℝ)) * (1 + (N / (q : ℝ)) / (r : ℝ)) :=
    (congrArg norm hcomplete.2.1).le.trans hcomplete.2.2
  let F : ℤ × ℤ → ℂ := fun z =>
    ψD (((z.1 : ℝ) - d₀) / D) * ψN (((z.2 : ℝ) - n₀) / N) *
      affineReciprocalProductPhase (q * r) A B L 0 0
        (z.2 : ZMod (q * r)) (z.1 : ZMod (q * r))
  have harg (a : ℤ) (u t W : ℝ) (hW : 0 < W) :
      ((a : ℝ) + (q : ℝ) * t - u) / W =
        (t - (u - (a : ℝ)) / (q : ℝ)) / (W / (q : ℝ)) := by
    field_simp [hq.ne', hW.ne']
    ring
  have hcomp (z : ℤ × ℤ) :
      F (dStar + (q : ℤ) * z.1, nStar + (q : ℤ) * z.2) = C * H z := by
    dsimp only [F, H]
    rw [hphase.2 z.2 z.1]
    simp only [Int.cast_add, Int.cast_mul, Int.cast_natCast]
    rw [harg dStar d₀ (z.1 : ℝ) D hD, harg nStar n₀ (z.2 : ℝ) N hN]
    ring
  have hsum : HasSum G (C * ∑' z : ℤ × ℤ, H z) := by
    apply (integerPair_congruence_hasSum_iff q dStar nStar F _).mpr
    exact (hH.mul_left C).congr_fun hcomp
  have hnorm : ‖∑' z : ℤ × ℤ, G z‖ ≤ ‖∑' z : ℤ × ℤ, H z‖ := by
    rw [hsum.tsum_eq, norm_mul]
    simpa only [one_mul] using
      mul_le_mul_of_nonneg_right hphase.1 (norm_nonneg (∑' z : ℤ × ℤ, H z))
  refine ⟨hH, hsum, hsum.tsum_eq, hnorm.trans (hboundH.trans_eq ?_)⟩
  let K : ℝ := (4 * TD + 3) * LD * (4 * TN + 3) * LN *
    (1 + Real.log (r : ℝ)) ^ 2
  have hs : Real.sqrt (r : ℝ) ≠ 0 := (Real.sqrt_pos.mpr hr).ne'
  have hroot (U : ℝ) :
      Real.sqrt (r : ℝ) + U / Real.sqrt (r : ℝ) =
        ((r : ℝ) + U) / Real.sqrt (r : ℝ) := by
    rw [add_div]
    congr 1
    exact (eq_div_iff hs).mpr (Real.mul_self_sqrt hr.le)
  have hscale :
      (1 / (q : ℝ)) *
        (Real.sqrt ((q * r : ℕ) : ℝ) + N / Real.sqrt ((q * r : ℕ) : ℝ)) *
        (Real.sqrt ((q * r : ℕ) : ℝ) + D / Real.sqrt ((q * r : ℕ) : ℝ)) =
      (r : ℝ) * (1 + (D / (q : ℝ)) / (r : ℝ)) *
        (1 + (N / (q : ℝ)) / (r : ℝ)) := by
    rw [← doubleCompletion_congruence_scale q r D N, hroot, hroot,
      div_mul_div_comm, Real.mul_self_sqrt hr.le]
    field_simp [hq.ne', hr.ne']
  calc
    _ = (M / (r : ℝ)) * K *
        ((r : ℝ) * (1 + (D / (q : ℝ)) / (r : ℝ)) *
          (1 + (N / (q : ℝ)) / (r : ℝ))) := by
      dsimp only [K]
      field_simp [hr.ne']
    _ = (M / (r : ℝ)) * K *
        ((1 / (q : ℝ)) *
          (Real.sqrt ((q * r : ℕ) : ℝ) + N / Real.sqrt ((q * r : ℕ) : ℝ)) *
          (Real.sqrt ((q * r : ℕ) : ℝ) + D / Real.sqrt ((q * r : ℕ) : ℝ))) := by
      rw [hscale]
    _ = _ := by
      dsimp only [K]
      ring

theorem poleMasked_compactProfiles_squarefree_kl3_max_bound
    (m : ℕ) [NeZero m] (hm : Squarefree m)
    (A B L η₁ η₂ : ZMod m)
    (TD TN LD LN D N d₀ n₀ : ℝ)
    (hTD : 0 ≤ TD) (hTN : 0 ≤ TN) (hLD : 0 ≤ LD) (hLN : 0 ≤ LN)
    (hD : 0 < D) (hN : 0 < N)
    (ψD ψN : ℝ → ℂ) (hψD : ContDiff ℝ 1 ψD) (hψN : ContDiff ℝ 1 ψN)
    (hsupportD : Function.support ψD ⊆ Set.Icc (-TD) TD)
    (hsupportN : Function.support ψN ⊆ Set.Icc (-TN) TN)
    (hboundD : ∀ t : ℝ, ‖ψD t‖ ≤ LD ∧ ‖deriv ψD t‖ ≤ LD)
    (hboundN : ∀ t : ℝ, ‖ψN t‖ ≤ LN ∧ ‖deriv ψN t‖ ≤ LN) :
    let K : (p : m.primeFactors) → ℝ := fun p =>
      letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
      (Finset.univ : Finset (ZMod p.1)).sup' Finset.univ_nonempty
        (fun c => ‖normalizedKloosterman3 p.1 c‖)
    let G : ℤ × ℤ → ℂ := fun z =>
      ψD (((z.1 : ℝ) - d₀) / D) * ψN (((z.2 : ℝ) - n₀) / N) *
        affineReciprocalProductPhase m A B L η₁ η₂ (z.2 : ZMod m) (z.1 : ZMod m)
    HasSum G (∑' z : ℤ × ℤ, G z) ∧
      ‖∑' z : ℤ × ℤ, G z‖ ≤
        (Nat.gcd m (A * L).val : ℝ) * (∏ p : m.primeFactors, max 1 (K p)) *
          (4 * TD + 3) * LD * (4 * TN + 3) * LN * (1 + Real.log (m : ℝ)) ^ 2 *
          (Real.sqrt (m : ℝ) + N / Real.sqrt (m : ℝ)) *
          (Real.sqrt (m : ℝ) + D / Real.sqrt (m : ℝ)) := by
  classical
  intro K G
  let Fhat : ZMod m × ZMod m → ℂ := fun ξ =>
    ∑ d : ZMod m, ∑ n : ZMod m,
      affineReciprocalProductPhase m A B L η₁ η₂ n d *
        ZMod.stdAddChar (-(d * ξ.1 + n * ξ.2))
  let M : ℝ := (Finset.univ : Finset (ZMod m × ZMod m)).sup'
    Finset.univ_nonempty (fun ξ => ‖Fhat ξ‖)
  let P : ℝ := ∏ p : m.primeFactors, max 1 (K p)
  let C : ℝ := (4 * TD + 3) * LD * (4 * TN + 3) * LN *
    (1 + Real.log (m : ℝ)) ^ 2
  have hprod : (∏ p : m.primeFactors,
      if ((A * L).val : ZMod p.1) = 0 then 1 else max 1 (K p)) ≤ P := by
    exact Finset.prod_le_prod (fun _ _ => by positivity)
      (fun _ _ => by split_ifs <;> simp)
  have hmax : M ≤ (m : ℝ) * (Nat.gcd m (A * L).val : ℝ) * P :=
    (affineReciprocalProductPhase_squarefree_fourier_max_decomposition
      m hm A B L η₁ η₂).trans
        (mul_le_mul_of_nonneg_left hprod (by positivity))
  have hcomplete := compactProfiles_double_fourier_completion m TD TN LD LN D N d₀ n₀
    hTD hTN hLD hLN hD hN ψD ψN hψD hψN hsupportD hsupportN hboundD hboundN
      (affineReciprocalProductPhase m A B L η₁ η₂)
  have hbound : ‖∑' z : ℤ × ℤ, G z‖ ≤
      M * C * (1 + D / (m : ℝ)) * (1 + N / (m : ℝ)) := by
    simpa only [C, G, M, Fhat, mul_assoc] using
      (congrArg norm hcomplete.2.1).le.trans hcomplete.2.2
  have hscale :
      (m : ℝ) * (1 + D / (m : ℝ)) * (1 + N / (m : ℝ)) =
        (Real.sqrt (m : ℝ) + N / Real.sqrt (m : ℝ)) *
          (Real.sqrt (m : ℝ) + D / Real.sqrt (m : ℝ)) := by
    have h := doubleCompletion_congruence_scale m 1 D N
    simp only [Nat.mul_one, Nat.cast_one, Real.sqrt_one, div_one] at h
    calc
      _ = (m : ℝ) * ((1 + N / (m : ℝ)) * (1 + D / (m : ℝ))) := by ring
      _ = (m : ℝ) * ((1 / (m : ℝ)) *
          (Real.sqrt (m : ℝ) + N / Real.sqrt (m : ℝ)) *
          (Real.sqrt (m : ℝ) + D / Real.sqrt (m : ℝ))) := by rw [h]
      _ = _ := by field_simp [NeZero.ne (m : ℝ)]
  refine ⟨hcomplete.1.summable.hasSum, hbound.trans ?_⟩
  calc
    _ = M * (C * (1 + D / (m : ℝ)) * (1 + N / (m : ℝ))) := by ring
    _ ≤ ((m : ℝ) * (Nat.gcd m (A * L).val : ℝ) * P) *
        (C * (1 + D / (m : ℝ)) * (1 + N / (m : ℝ))) :=
      mul_le_mul_of_nonneg_right hmax (by dsimp only [C]; positivity)
    _ = (Nat.gcd m (A * L).val : ℝ) * P * C *
        ((m : ℝ) * (1 + D / (m : ℝ)) * (1 + N / (m : ℝ))) := by ring
    _ = _ := by rw [hscale]; dsimp only [C, P]; ring

theorem poleMasked_compactProfiles_congruence_kl3_max_bound
    (q r : ℕ) [NeZero q] [NeZero r] (hm : Squarefree (q * r))
    (A B L : ZMod (q * r)) (dStar nStar : ℤ)
    (TD TN LD LN D N d₀ n₀ : ℝ)
    (hTD : 0 ≤ TD) (hTN : 0 ≤ TN) (hLD : 0 ≤ LD) (hLN : 0 ≤ LN)
    (hD : 0 < D) (hN : 0 < N)
    (ψD ψN : ℝ → ℂ) (hψD : ContDiff ℝ 1 ψD) (hψN : ContDiff ℝ 1 ψN)
    (hsupportD : Function.support ψD ⊆ Set.Icc (-TD) TD)
    (hsupportN : Function.support ψN ⊆ Set.Icc (-TN) TN)
    (hboundD : ∀ t : ℝ, ‖ψD t‖ ≤ LD ∧ ‖deriv ψD t‖ ≤ LD)
    (hboundN : ∀ t : ℝ, ‖ψN t‖ ≤ LN ∧ ‖deriv ψN t‖ ≤ LN) :
    let K : (p : r.primeFactors) → ℝ := fun p =>
      letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
      (Finset.univ : Finset (ZMod p.1)).sup' Finset.univ_nonempty
        (fun c => ‖normalizedKloosterman3 p.1 c‖)
    let G : ℤ × ℤ → ℂ := fun z =>
      if Int.ModEq (q : ℤ) dStar z.1 ∧ Int.ModEq (q : ℤ) nStar z.2 then
        ψD (((z.1 : ℝ) - d₀) / D) * ψN (((z.2 : ℝ) - n₀) / N) *
          affineReciprocalProductPhase (q * r) A B L 0 0
            (z.2 : ZMod (q * r)) (z.1 : ZMod (q * r))
      else 0
    HasSum G (∑' z : ℤ × ℤ, G z) ∧
      ‖∑' z : ℤ × ℤ, G z‖ ≤
        (Nat.gcd (q * r) (A * L).val : ℝ) * (∏ p : r.primeFactors, max 1 (K p)) *
          (4 * TD + 3) * LD * (4 * TN + 3) * LN * (1 + Real.log (r : ℝ)) ^ 2 *
          (1 / (q : ℝ)) *
          (Real.sqrt ((q * r : ℕ) : ℝ) + N / Real.sqrt ((q * r : ℕ) : ℝ)) *
          (Real.sqrt ((q * r : ℕ) : ℝ) + D / Real.sqrt ((q * r : ℕ) : ℝ)) := by
  classical
  intro K G
  have hqr : Nat.Coprime q r := Nat.coprime_of_squarefree_mul hm
  have hr : Squarefree r := hm.of_mul_right
  have hrpos : (0 : ℝ) < r := by exact_mod_cast NeZero.pos r
  let A' : ZMod r := (A.val : ZMod r) * ((q : ZMod r)⁻¹) ^ 3
  let B' : ZMod r := (B.val : ZMod r)
  let L' : ZMod r := (L.val : ZMod r)
  let η₁ : ZMod r := ((nStar : ZMod r) + B' * (dStar : ZMod r)) * (q : ZMod r)⁻¹
  let η₂ : ZMod r := ((nStar : ZMod r) + (B' + L') * (dStar : ZMod r)) *
    (q : ZMod r)⁻¹
  let Fhat : ZMod r × ZMod r → ℂ := fun ξ =>
    ∑ d : ZMod r, ∑ n : ZMod r,
      affineReciprocalProductPhase r A' B' L' η₁ η₂ n d *
        ZMod.stdAddChar (-(d * ξ.1 + n * ξ.2))
  let M : ℝ := (Finset.univ : Finset (ZMod r × ZMod r)).sup'
    Finset.univ_nonempty (fun ξ => ‖Fhat ξ‖)
  let P : ℝ := ∏ p : r.primeFactors, max 1 (K p)
  let C : ℝ := (4 * TD + 3) * LD * (4 * TN + 3) * LN *
    (1 + Real.log (r : ℝ)) ^ 2
  have hprod : (∏ p : r.primeFactors,
      if ((A' * L').val : ZMod p.1) = 0 then 1 else max 1 (K p)) ≤ P := by
    exact Finset.prod_le_prod (fun _ _ => by positivity)
      (fun _ _ => by split_ifs <;> simp)
  have hmax : M ≤ (r : ℝ) * (Nat.gcd r (A' * L').val : ℝ) * P :=
    (affineReciprocalProductPhase_squarefree_fourier_max_decomposition
      r hr A' B' L' η₁ η₂).trans
        (mul_le_mul_of_nonneg_left hprod (by positivity))
  have hgcd : (Nat.gcd r (A' * L').val : ℝ) ≤
      (Nat.gcd (q * r) (A * L).val : ℝ) := by
    exact_mod_cast (congruence_residual_numerator_gcd q r hqr A L).2
  have hnormalized : M / (r : ℝ) ≤ (Nat.gcd (q * r) (A * L).val : ℝ) * P := by
    apply (div_le_iff₀' hrpos).mpr
    simpa only [mul_assoc] using hmax.trans
      (mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_left hgcd hrpos.le)
        (by dsimp only [P]; positivity))
  have hcomplete := poleMasked_compactProfiles_congruence_completion q r hqr A B L
    dStar nStar TD TN LD LN D N d₀ n₀ hTD hTN hLD hLN hD hN
    ψD ψN hψD hψN hsupportD hsupportN hboundD hboundN
  have hbound : ‖∑' z : ℤ × ℤ, G z‖ ≤ (M / (r : ℝ)) * C * (1 / (q : ℝ)) *
      (Real.sqrt ((q * r : ℕ) : ℝ) + N / Real.sqrt ((q * r : ℕ) : ℝ)) *
      (Real.sqrt ((q * r : ℕ) : ℝ) + D / Real.sqrt ((q * r : ℕ) : ℝ)) := by
    simpa only [C, G, M, Fhat, A', B', L', η₁, η₂, mul_assoc] using hcomplete.2.2.2
  refine ⟨hcomplete.2.1.summable.hasSum, hbound.trans ?_⟩
  simpa only [C, P, mul_assoc] using
    mul_le_mul_of_nonneg_right hnormalized
      (show 0 ≤ C * (1 / (q : ℝ)) *
        (Real.sqrt ((q * r : ℕ) : ℝ) + N / Real.sqrt ((q * r : ℕ) : ℝ)) *
        (Real.sqrt ((q * r : ℕ) : ℝ) + D / Real.sqrt ((q * r : ℕ) : ℝ)) by
          dsimp only [C]
          positivity)

theorem interval_modEq_card_le
    (A : ℤ) (N q : ℕ) (hq : 0 < q) (b : ℤ) :
    (((Finset.Ico A (A + (N : ℤ))).filter
      (fun n => Int.ModEq (q : ℤ) n b)).card : ℝ) ≤ (N : ℝ) / q + 1 := by
  have h := integer_interval_modEq_reindex_count A N q hq b
  have hc := congrArg Complex.re (h.1 (fun _ => 1))
  simp only [Finset.sum_boole, Finset.sum_const, Finset.card_range,
    nsmul_eq_mul, mul_one, Complex.natCast_re] at hc
  have he := h.2.2
  rw [← hc] at he
  have hcard :
      ((Finset.Ico A (A + (N : ℤ))).filter
        (fun n => Int.ModEq (q : ℤ) n b)).card =
      ((Finset.range N).filter
        (fun n : ℕ => Int.ModEq (q : ℤ) (A + (n : ℤ)) b)).card := by
    rw [Int.Ico_eq_finset_map, Finset.filter_map, Finset.card_map]
    simp only [add_sub_cancel_left, Int.toNat_natCast]
    rfl
  rw [hcard]
  linarith [(abs_le.mp he).2]

section
open scoped FourierTransform SchwartzMap ContDiff

theorem poisson_grid_reindex (m : ℕ) [NeZero m] (F : ℝ → ℂ)
    (hs : Summable (fun j : ℤ => ‖F ((j : ℝ) / (m : ℝ))‖)) :
    (∀ ξ : ZMod m,
      Summable (fun k : ℤ => ‖F ((k : ℝ) + (ξ.val : ℝ) / (m : ℝ))‖)) ∧
    (∑ ξ : ZMod m, ∑' k : ℤ,
      ‖F ((k : ℝ) + (ξ.val : ℝ) / (m : ℝ))‖) =
      ∑' j : ℤ, ‖F ((j : ℝ) / (m : ℝ))‖ := by
  cases m with
  | zero => exact (NeZero.ne 0 rfl).elim
  | succ m =>
    have hm : ((m + 1 : ℕ) : ℝ) ≠ 0 := by positivity
    have hpoint (p : ℤ × Fin (m + 1)) :
        (((Int.divModEquiv (m + 1)).symm p : ℤ) : ℝ) / ((m + 1 : ℕ) : ℝ) =
          (p.1 : ℝ) + (p.2.val : ℝ) / ((m + 1 : ℕ) : ℝ) := by
      rw [Int.divModEquiv_symm_apply]
      simp only [Int.cast_add, Int.cast_mul, Int.cast_natCast]
      rw [add_div, mul_div_cancel_right₀ _ hm]
    have he : Summable (fun p : ℤ × Fin (m + 1) =>
        ‖F ((((Int.divModEquiv (m + 1)).symm p : ℤ) : ℝ) /
          ((m + 1 : ℕ) : ℝ))‖) :=
      ((Int.divModEquiv (m + 1)).symm.summable_iff
        (f := fun j : ℤ => ‖F ((j : ℝ) / ((m + 1 : ℕ) : ℝ))‖)).mpr hs
    have hp : Summable (fun p : ℤ × Fin (m + 1) =>
        ‖F ((p.1 : ℝ) + (p.2.val : ℝ) / ((m + 1 : ℕ) : ℝ))‖) :=
      he.congr fun p => congrArg (fun t : ℝ => ‖F t‖) (hpoint p)
    refine ⟨fun ξ => hp.prod_symm.prod_factor ξ, ?_⟩
    calc
      (∑ ξ : Fin (m + 1), ∑' k : ℤ,
          ‖F ((k : ℝ) + (ξ.val : ℝ) / ((m + 1 : ℕ) : ℝ))‖) =
          ∑' p : ℤ × Fin (m + 1),
            ‖F ((p.1 : ℝ) + (p.2.val : ℝ) / ((m + 1 : ℕ) : ℝ))‖ := by
        simpa only [tsum_fintype] using
          (hp.tsum_comm (f := fun (k : ℤ) (ξ : Fin (m + 1)) =>
            ‖F ((k : ℝ) + (ξ.val : ℝ) / ((m + 1 : ℕ) : ℝ))‖)).trans
              hp.tsum_prod.symm
      _ = ∑' j : ℤ, ‖F ((j : ℝ) / ((m + 1 : ℕ) : ℝ))‖ := by
        simpa only [hpoint] using (Int.divModEquiv (m + 1)).symm.tsum_eq
          (fun j : ℤ => ‖F ((j : ℝ) / ((m + 1 : ℕ) : ℝ))‖)

theorem compactProfile_poisson_completion
    (m : ℕ) [NeZero m] (T N t₀ : ℝ)
    (hT : 0 ≤ T) (hN : 0 < N)
    (ψ : ℝ → ℂ) (hψ : ContDiff ℝ ∞ ψ)
    (hsupport : Function.support ψ ⊆ Set.Icc (-T) T) :
    let w : ℝ → ℂ := fun t => ψ ((t - t₀) / N)
    let A : ℤ := ⌈t₀ - T * N⌉
    let K : ℕ := (⌊t₀ + T * N⌋ + 1 - A).toNat
    let W : ZMod m → ℂ := integerIntervalResidueWeight m A K
      (fun j => w ((A : ℝ) + (j : ℝ)))
    Summable (fun j : ℤ => ‖𝓕 w ((j : ℝ) / (m : ℝ))‖) ∧
    (∀ ξ : ZMod m,
      HasSum (fun k : ℤ => 𝓕 w ((k : ℝ) + (ξ.val : ℝ) / (m : ℝ)))
        (ZMod.dft W ξ)) ∧
    (1 / (m : ℝ)) * ∑ ξ : ZMod m, ‖ZMod.dft W ξ‖ ≤
      (1 / (m : ℝ)) * ∑' j : ℤ, ‖𝓕 w ((j : ℝ) / (m : ℝ))‖ := by
  classical
  let w : ℝ → ℂ := fun t => ψ ((t - t₀) / N)
  let A : ℤ := ⌈t₀ - T * N⌉
  let B : ℤ := ⌊t₀ + T * N⌋
  let K : ℕ := (B + 1 - A).toNat
  let W : ZMod m → ℂ := integerIntervalResidueWeight m A K
    (fun j => w ((A : ℝ) + (j : ℝ)))
  have hm : (m : ℝ) ≠ 0 := Nat.cast_ne_zero.mpr (NeZero.ne m)
  have hwsupport : Function.support w ⊆ Set.Icc (t₀ - T * N) (t₀ + T * N) := by
    intro t ht
    have h := hsupport ht
    constructor <;> linarith [(le_div_iff₀ hN).mp h.1, (div_le_iff₀ hN).mp h.2]
  have hwcompact : HasCompactSupport w := by
    have ht : t₀ - T * N ≤ t₀ + T * N := by
      nlinarith [mul_nonneg hT hN.le]
    apply HasCompactSupport.of_support_subset_isCompact
      (isCompact_uIcc : IsCompact (Set.uIcc (t₀ - T * N) (t₀ + T * N)))
    simpa only [Set.uIcc_of_le ht] using hwsupport
  have hwsmooth : ContDiff ℝ ∞ w := hψ.comp (by fun_prop)
  let f : 𝓢(ℝ, ℂ) := hwcompact.toSchwartzMap hwsmooth
  let e : ℝ ≃L[ℝ] ℝ :=
    (ContinuousLinearEquiv.unitsEquivAut ℝ (Units.mk0 (m : ℝ) hm)).symm
  let G : 𝓢(ℝ, ℂ) := SchwartzMap.compCLMOfContinuousLinearEquiv ℂ e (𝓕 f)
  have hG (t : ℝ) : G t = 𝓕 w (t / (m : ℝ)) := by
    change 𝓕 w (e t) = _
    simp [e, div_eq_mul_inv]
  have hgrid : Summable (fun j : ℤ => ‖𝓕 w ((j : ℝ) / (m : ℝ))‖) := by
    have hs : Summable (fun j : ℤ => G (j : ℝ)) := by
      apply summable_of_isBigO (Real.summable_abs_int_rpow one_lt_two)
      simpa only [Function.comp_def, Real.norm_eq_abs] using
        (G.isBigO_cocompact_rpow (-2)).comp_tendsto Int.tendsto_coe_cofinite
    simpa only [hG] using hs.norm
  have hsample (n : ℤ) (hn : n ∉ Finset.Icc A B) : w (n : ℝ) = 0 := by
    by_contra he
    have ht := hwsupport he
    exact hn (Finset.mem_Icc.mpr ⟨Int.ceil_le.mpr ht.1, Int.le_floor.mpr ht.2⟩)
  have hdft (ξ : ZMod m) :
      HasSum (fun n : ℤ => w (n : ℝ) * ZMod.stdAddChar (-((n : ZMod m) * ξ)))
        (ZMod.dft W ξ) := by
    have hfinite : ZMod.dft W ξ =
        ∑ n ∈ Finset.Icc A B, w (n : ℝ) * ZMod.stdAddChar (-((n : ZMod m) * ξ)) := by
      rw [(integerIntervalResidueWeight_spec m A K _).2.1 ξ,
        Int.Icc_eq_finset_map, Finset.sum_map]
      apply Finset.sum_congr rfl
      intro j _
      simp only [Function.Embedding.trans_apply, Nat.castEmbedding_apply,
        addLeftEmbedding_apply, Int.cast_add, Int.cast_natCast]
    rw [hfinite]
    apply hasSum_sum_of_ne_finset_zero
    intro n hn
    rw [hsample n hn, zero_mul]
  obtain ⟨haliasnorm, hgrid_sum⟩ := poisson_grid_reindex m (𝓕 w) hgrid
  have halias (ξ : ZMod m) :
      HasSum (fun k : ℤ => 𝓕 w ((k : ℝ) + (ξ.val : ℝ) / (m : ℝ)))
        (ZMod.dft W ξ) := by
    let θ : ℝ := (ξ.val : ℝ) / (m : ℝ)
    let g : ℝ → ℂ := fun t =>
      w t * Complex.exp (((-2 * Real.pi * t * θ : ℝ) : ℂ) * Complex.I)
    have hgcompact : HasCompactSupport g := hwcompact.mul_right
    have hgsmooth : ContDiff ℝ ∞ g := by
      apply hwsmooth.mul
      apply ContDiff.cexp
      exact (Complex.ofRealCLM.contDiff.comp
        (show ContDiff ℝ ∞ (fun t : ℝ => -2 * Real.pi * t * θ) by fun_prop)).mul contDiff_const
    let gs : 𝓢(ℝ, ℂ) := hgcompact.toSchwartzMap hgsmooth
    have hfourier (y : ℝ) : 𝓕 g y = 𝓕 w (y + θ) := by
      rw [Real.fourier_real_eq_integral_exp_smul,
        Real.fourier_real_eq_integral_exp_smul]
      congr 1 with t
      simp only [g, smul_eq_mul]
      calc
        _ = Complex.exp (((-2 * Real.pi * t * y : ℝ) : ℂ) * Complex.I +
            ((-2 * Real.pi * t * θ : ℝ) : ℂ) * Complex.I) * w t := by
          rw [Complex.exp_add]
          ring
        _ = _ := by
          congr 2
          push_cast
          ring
    have hchar (n : ℤ) :
        g (n : ℝ) = w (n : ℝ) * ZMod.stdAddChar (-((n : ZMod m) * ξ)) := by
      have hz : -((n : ZMod m) * ξ) = ((-(n * (ξ.val : ℤ)) : ℤ) : ZMod m) := by
        simp
      simp only [g, hz, ZMod.stdAddChar_coe]
      congr 2
      dsimp only [θ]
      push_cast
      ring
    have hp := SchwartzMap.tsum_eq_tsum_fourier gs 0
    change (∑' n : ℤ, g (0 + (n : ℝ))) =
      ∑' k : ℤ, 𝓕 g (k : ℝ) * fourier k ((0 : ℝ) : UnitAddCircle) at hp
    simp only [zero_add, AddCircle.coe_zero, fourier_eval_zero, mul_one, hfourier] at hp
    exact (haliasnorm ξ).of_norm.hasSum_iff.mpr
      (hp.symm.trans ((hdft ξ).congr_fun hchar).tsum_eq)
  refine ⟨hgrid, halias, ?_⟩
  apply mul_le_mul_of_nonneg_left ?_ (by positivity)
  calc
    (∑ ξ : ZMod m, ‖ZMod.dft W ξ‖) ≤
        ∑ ξ : ZMod m, ∑' k : ℤ,
          ‖𝓕 w ((k : ℝ) + (ξ.val : ℝ) / (m : ℝ))‖ := by
      apply Finset.sum_le_sum
      intro ξ _
      rw [← (halias ξ).tsum_eq]
      exact norm_tsum_le_tsum_norm (haliasnorm ξ)
    _ = _ := hgrid_sum

end

section
open scoped FourierTransform RealInnerProductSpace

theorem reciprocalSquare_nat_tail
    (a b : ℝ) (ha : 0 < a) (hb : 0 < b) :
    Summable (fun n : ℕ => (b + a * ((n : ℝ) + 1))⁻¹ ^ 2) ∧
      (∑' n : ℕ, (b + a * ((n : ℝ) + 1))⁻¹ ^ 2) ≤ (a * b)⁻¹ := by
  let u : ℕ → ℝ := fun n => (b + a * (n : ℝ))⁻¹
  have hstep (n : ℕ) :
      (b + a * ((n : ℝ) + 1))⁻¹ ^ 2 ≤ a⁻¹ * (u n - u (n + 1)) := by
    have h0 : 0 < b + a * (n : ℝ) := by positivity
    have h1 : 0 < b + a * ((n : ℝ) + 1) := by positivity
    calc
      _ ≤ (b + a * (n : ℝ))⁻¹ * (b + a * ((n : ℝ) + 1))⁻¹ := by
        rw [pow_two]
        exact mul_le_mul_of_nonneg_right (inv_anti₀ h0 (by nlinarith))
          (inv_nonneg.mpr h1.le)
      _ = _ := by
        dsimp only [u]
        push_cast
        field_simp
        ring
  have hpartial (k : ℕ) :
      (∑ n ∈ Finset.range k, (b + a * ((n : ℝ) + 1))⁻¹ ^ 2) ≤ (a * b)⁻¹ := by
    calc
      _ ≤ ∑ n ∈ Finset.range k, a⁻¹ * (u n - u (n + 1)) :=
        Finset.sum_le_sum fun n _ => hstep n
      _ = a⁻¹ * (u 0 - u k) := by
        rw [← Finset.mul_sum, Finset.sum_range_sub']
      _ ≤ a⁻¹ * u 0 :=
        mul_le_mul_of_nonneg_left (sub_le_self _ (by dsimp [u]; positivity))
          (inv_nonneg.mpr ha.le)
      _ = (a * b)⁻¹ := by simp [u, mul_comm]
  have hs := summable_of_sum_range_le (fun n => sq_nonneg ((b + a * ((n : ℝ) + 1))⁻¹))
    hpartial
  exact ⟨hs, hs.tsum_le_of_sum_range_le hpartial⟩

theorem reciprocalSquare_integer_lattice_bounds
    (a : ℝ) (ha : 0 < a) :
    Summable (fun j : ℤ => (1 + a * |(j : ℝ)|)⁻¹ ^ 2) ∧
      (∑' j : ℤ, (1 + a * |(j : ℝ)|)⁻¹ ^ 2) ≤ 1 + 2 / a ∧
      ∀ J : ℕ,
        (∑' j : ℤ, if (J : ℝ) < |(j : ℝ)|
          then (1 + a * |(j : ℝ)|)⁻¹ ^ 2 else 0) ≤
            2 / (a * (1 + a * (J : ℝ))) := by
  let f : ℤ → ℝ := fun j => (1 + a * |(j : ℝ)|)⁻¹ ^ 2
  let P : ℝ := ∑' n : ℕ, (1 + a * ((n : ℝ) + 1))⁻¹ ^ 2
  have habs (n : ℕ) : |(n : ℝ) + 1| = (n : ℝ) + 1 := abs_of_nonneg (by positivity)
  have hp := reciprocalSquare_nat_tail a 1 ha zero_lt_one
  have hpos : HasSum (fun n : ℕ => f (n + 1)) P := by
    simpa only [f, P, Int.cast_add, Int.cast_natCast, Int.cast_one, habs] using hp.1.hasSum
  have hs := hpos.of_add_one_of_neg_add_one (f := f)
    (hpos.congr_fun fun n => by simp only [f, Int.cast_neg, abs_neg])
  refine ⟨hs.summable, ?_, ?_⟩
  · change (∑' j : ℤ, f j) ≤ _
    rw [hs.tsum_eq]
    simp only [f, Int.cast_zero, abs_zero, mul_zero, add_zero, inv_one, one_pow]
    rw [div_eq_mul_inv]
    linarith [show P ≤ a⁻¹ by simpa only [mul_one] using hp.2]
  · intro J
    let b : ℝ := 1 + a * (J : ℝ)
    let v : ℕ → ℝ := fun n =>
      if J ≤ n then (1 + a * ((n : ℝ) + 1))⁻¹ ^ 2 else 0
    let Q : ℝ := ∑' n : ℕ, (b + a * ((n : ℝ) + 1))⁻¹ ^ 2
    have htail := reciprocalSquare_nat_tail a b ha (by dsimp [b]; positivity)
    have hshift : HasSum (fun n : ℕ => v (n + J)) Q := by
      refine htail.1.hasSum.congr_fun fun n => ?_
      dsimp only [v]
      rw [ite_eq_left (Nat.le_add_left J n)]
      congr 2
      push_cast
      dsimp only [b]
      ring
    have hprefix : ∑ n ∈ Finset.range J, v n = 0 := by
      apply Finset.sum_eq_zero
      intro n hn
      simp [v, Nat.not_le.mpr (Finset.mem_range.mp hn)]
    have hv : HasSum v Q := by
      simpa only [hprefix, zero_add] using hshift.sum_range_add
    let g : ℤ → ℝ := fun j =>
      if (J : ℝ) < |(j : ℝ)| then f j else 0
    have hgpos : HasSum (fun n : ℕ => g (n + 1)) Q := by
      refine hv.congr_fun fun n => ?_
      have hcond : ((J : ℝ) < (n : ℝ) + 1) ↔ J ≤ n := by
        exact_mod_cast Nat.lt_succ_iff
      simp only [g, f, v, Int.cast_add, Int.cast_natCast, Int.cast_one, habs, hcond]
    have hgsum := hgpos.of_add_one_of_neg_add_one (f := g)
      (hgpos.congr_fun fun n => by simp only [g, f, Int.cast_neg, abs_neg])
    change (∑' j : ℤ, g j) ≤ _
    rw [hgsum.tsum_eq, show g 0 = 0 by simp [g]]
    simpa only [Q, b, zero_add, add_zero, div_eq_mul_inv, two_mul] using
      add_le_add htail.2 htail.2

theorem compactProfile_scaled_bounds
    (T Lw N t₀ : ℝ)
    (hT : 0 ≤ T) (hLw : 0 ≤ Lw) (hN : 0 < N)
    (ψ : ℝ → ℂ) (hψ : ContDiff ℝ 2 ψ)
    (hsupport : Function.support ψ ⊆ Set.Icc (-T) T)
    (hbound : ∀ t : ℝ,
      ‖ψ t‖ ≤ Lw ∧ ‖deriv ψ t‖ ≤ Lw ∧ ‖deriv (deriv ψ) t‖ ≤ Lw) :
    let w : ℝ → ℂ := fun x => ψ ((x - t₀) / N)
    MeasureTheory.Integrable w ∧ Differentiable ℝ w ∧
    MeasureTheory.Integrable (deriv w) ∧ Differentiable ℝ (deriv w) ∧
    MeasureTheory.Integrable (deriv (deriv w)) ∧
    (∫ x : ℝ, ‖w x‖) ≤ 2 * T * Lw * N ∧
    (∫ x : ℝ, ‖deriv (deriv w) x‖) ≤ 2 * T * Lw / N := by
  intro w
  let s : ℝ → ℝ := fun x => (x - t₀) / N
  have hsC : ContDiff ℝ 2 s := (contDiff_id.sub contDiff_const).div_const N
  have hwC : ContDiff ℝ 2 w := hψ.comp hsC
  have hwC' : ContDiff ℝ 1 (deriv w) := hwC.deriv'
  have hψd : Differentiable ℝ ψ := hψ.differentiable (by norm_num)
  have hsderiv (x : ℝ) : HasDerivAt s (1 / N) x :=
    ((hasDerivAt_id x).sub_const t₀).div_const N
  have hwderiv_fun : deriv w = fun x => (1 / N : ℝ) • deriv ψ (s x) := by
    funext x
    exact ((hψd (s x)).hasDerivAt.scomp x (hsderiv x)).deriv
  have hwderiv₂ (x : ℝ) : deriv (deriv w) x =
      (1 / N : ℝ) • ((1 / N : ℝ) • deriv (deriv ψ) (s x)) := by
    rw [hwderiv_fun]
    exact (((hψ.differentiable_deriv_two (s x)).hasDerivAt.scomp x
      (hsderiv x)).const_smul (1 / N : ℝ)).deriv
  have hsuppw : Function.support w ⊆ Set.Icc (t₀ - T * N) (t₀ + T * N) := by
    intro x hx
    have hh := hsupport (show (x - t₀) / N ∈ Function.support ψ from hx)
    constructor
    · have := (le_div_iff₀ hN).mp hh.1
      linarith
    · have := (div_le_iff₀ hN).mp hh.2
      linarith
  have htsw : tsupport w ⊆ Set.Icc (t₀ - T * N) (t₀ + T * N) :=
    closure_minimal hsuppw isClosed_Icc
  have hwcompact : HasCompactSupport w :=
    HasCompactSupport.of_support_subset_isCompact isCompact_Icc hsuppw
  have hsuppw₂ : Function.support (deriv (deriv w)) ⊆
      Set.Icc (t₀ - T * N) (t₀ + T * N) :=
    (support_deriv_subset (f := deriv w)).trans
      ((tsupport_deriv_subset (f := w)).trans htsw)
  have hwi : Integrable w := hwC.continuous.integrable_of_hasCompactSupport hwcompact
  have hwi' : Integrable (deriv w) :=
    hwC'.continuous.integrable_of_hasCompactSupport hwcompact.deriv
  have hwi'' : Integrable (deriv (deriv w)) :=
    hwC'.continuous_deriv_one.integrable_of_hasCompactSupport hwcompact.deriv.deriv
  have hwbound (x : ℝ) : ‖w x‖ ≤ Lw := (hbound _).1
  have hwbound₂ (x : ℝ) : ‖deriv (deriv w) x‖ ≤ Lw / N ^ 2 := by
    simp only [hwderiv₂, norm_smul, Real.norm_eq_abs,
      abs_of_pos (one_div_pos.mpr hN)]
    calc
      _ ≤ (1 / N) * ((1 / N) * Lw) := by
        apply mul_le_mul_of_nonneg_left _ (one_div_nonneg.mpr hN.le)
        simpa only [mul_comm] using
          mul_le_mul (hbound (s x)).2.2 (le_refl (1 / N))
            (one_div_nonneg.mpr hN.le) hLw
      _ = Lw / N ^ 2 := by ring
  have hab : t₀ - T * N ≤ t₀ + T * N := by
    nlinarith [mul_nonneg hT hN.le]
  have hmass (f : ℝ → ℂ) (hf : Integrable f) (C : ℝ)
      (hs : Function.support f ⊆ Set.Icc (t₀ - T * N) (t₀ + T * N))
      (hC : ∀ x : ℝ, ‖f x‖ ≤ C) :
      (∫ x : ℝ, ‖f x‖) ≤ (2 * T * N) * C := by
    have hz : ∀ x : ℝ, x ∉ Set.Icc (t₀ - T * N) (t₀ + T * N) → ‖f x‖ = 0 := by
      intro x hx
      rw [Function.support_subset_iff'.mp hs x hx, norm_zero]
    rw [← setIntegral_eq_integral_of_forall_compl_eq_zero hz]
    calc
      _ ≤ ∫ _x : ℝ in Set.Icc (t₀ - T * N) (t₀ + T * N), C :=
        setIntegral_mono_on hf.norm.integrableOn continuous_const.integrableOn_Icc
          measurableSet_Icc (fun x hx => hC x)
      _ = (2 * T * N) * C := by
        rw [setIntegral_const, Real.volume_real_Icc_of_le hab, smul_eq_mul]
        ring
  refine ⟨hwi, hwC.differentiable (by norm_num), hwi', hwC.differentiable_deriv_two,
    hwi'', ?_, ?_⟩
  · simpa only [mul_assoc, mul_left_comm, mul_comm] using
      hmass w hwi Lw hsuppw hwbound
  · calc
      _ ≤ (2 * T * N) * (Lw / N ^ 2) :=
        hmass (deriv (deriv w)) hwi'' (Lw / N ^ 2) hsuppw₂ hwbound₂
      _ = 2 * T * Lw / N := by
        field_simp

theorem compactProfile_fourier_decay_bound
    (T Lw N t₀ : ℝ)
    (hT : 0 ≤ T) (hLw : 0 ≤ Lw) (hN : 0 < N)
    (ψ : ℝ → ℂ) (hψ : ContDiff ℝ 2 ψ)
    (hsupport : Function.support ψ ⊆ Set.Icc (-T) T)
    (hbound : ∀ t : ℝ,
      ‖ψ t‖ ≤ Lw ∧ ‖deriv ψ t‖ ≤ Lw ∧ ‖deriv (deriv ψ) t‖ ≤ Lw) :
    let w : ℝ → ℂ := fun x => ψ ((x - t₀) / N)
    ∀ ξ : ℝ, ‖𝓕 w ξ‖ ≤ (8 * T) * Lw * N / (1 + N * |ξ|) ^ 2 := by
  intro w ξ
  obtain ⟨hw, hdw, hw₁, hdw₁, hw₂, hmass, hmass₂⟩ :=
    compactProfile_scaled_bounds T Lw N t₀ hT hLw hN ψ hψ hsupport hbound
  let F : ℝ := ‖𝓕 w ξ‖
  let y : ℝ := N * |ξ|
  let M : ℝ := 2 * T * Lw * N
  have hF : 0 ≤ F := norm_nonneg _
  have hy : 0 ≤ y := mul_nonneg hN.le (abs_nonneg _)
  have hnorm (f : ℝ → ℂ) : ‖𝓕 f ξ‖ ≤ ∫ x : ℝ, ‖f x‖ :=
    VectorFourier.norm_fourierIntegral_le_integral_norm
      Real.fourierChar volume (innerₗ ℝ) f ξ
  have hlow : F ≤ M := (hnorm w).trans hmass
  have hhigh : (2 * Real.pi * |ξ|) ^ 2 * F ≤ 2 * T * Lw / N := by
    have hD₁ := congrFun (Real.fourier_deriv hw hdw hw₁) ξ
    have hD₂ := congrFun (Real.fourier_deriv hw₁ hdw₁ hw₂) ξ
    have hDD : 𝓕 (deriv (deriv w)) ξ =
        (2 * (Real.pi : ℂ) * Complex.I * (ξ : ℂ)) ^ 2 • 𝓕 w ξ := by
      rw [hD₂, hD₁, smul_smul, pow_two]
    have hc : ‖2 * (Real.pi : ℂ) * Complex.I * (ξ : ℂ)‖ =
        2 * Real.pi * |ξ| := by
      simp [Real.norm_eq_abs, abs_of_pos Real.pi_pos]
    calc
      _ = ‖(2 * (Real.pi : ℂ) * Complex.I * (ξ : ℂ)) ^ 2 • 𝓕 w ξ‖ := by
        rw [norm_smul, norm_pow, hc]
      _ = ‖𝓕 (deriv (deriv w)) ξ‖ := congrArg norm hDD.symm
      _ ≤ ∫ x : ℝ, ‖deriv (deriv w) x‖ := hnorm _
      _ ≤ _ := hmass₂
  have hpi : 1 ≤ (2 * Real.pi) ^ 2 :=
    one_le_pow₀ (by linarith [Real.one_le_pi_div_two])
  have hweighted : y ^ 2 * F ≤ M := by
    have hh := mul_le_mul_of_nonneg_left hhigh (sq_nonneg N)
    have he : N ^ 2 * (2 * T * Lw / N) = M := by
      dsimp only [M]
      field_simp [hN.ne']
    have he' : N ^ 2 * ((2 * Real.pi * |ξ|) ^ 2 * F) =
        (2 * Real.pi) ^ 2 * (y ^ 2 * F) := by
      dsimp only [y]
      ring
    rw [he, he'] at hh
    exact (le_mul_of_one_le_left (mul_nonneg (sq_nonneg y) hF) hpi).trans hh
  have hquad : (1 + y) ^ 2 ≤ 2 * (1 + y ^ 2) := by
    simpa only [one_pow] using (add_sq_le (a := (1 : ℝ)) (b := y))
  have hfinal : (1 + y) ^ 2 * F ≤ 4 * M := by
    calc
      _ ≤ (2 * (1 + y ^ 2)) * F := mul_le_mul_of_nonneg_right hquad hF
      _ = 2 * F + 2 * (y ^ 2 * F) := by ring
      _ ≤ 2 * M + 2 * M := add_le_add
        (mul_le_mul_of_nonneg_left hlow (by norm_num))
        (mul_le_mul_of_nonneg_left hweighted (by norm_num))
      _ = _ := by ring
  change F ≤ (8 * T) * Lw * N / (1 + y) ^ 2
  apply (le_div_iff₀ (by positivity : (0 : ℝ) < (1 + y) ^ 2)).2
  calc
    _ = (1 + y) ^ 2 * F := mul_comm _ _
    _ ≤ 4 * M := hfinal
    _ = _ := by dsimp only [M]; ring

theorem compactProfile_fourier_grid_bound
    (m : ℕ) [NeZero m] (T Lw N t₀ : ℝ)
    (hT : 0 ≤ T) (hLw : 0 ≤ Lw) (hN : 0 < N)
    (ψ : ℝ → ℂ) (hψ : ContDiff ℝ 2 ψ)
    (hsupport : Function.support ψ ⊆ Set.Icc (-T) T)
    (hbound : ∀ t : ℝ,
      ‖ψ t‖ ≤ Lw ∧ ‖deriv ψ t‖ ≤ Lw ∧ ‖deriv (deriv ψ) t‖ ≤ Lw) :
    let w : ℝ → ℂ := fun t => ψ ((t - t₀) / N)
    Summable (fun j : ℤ => ‖𝓕 w ((j : ℝ) / (m : ℝ))‖) ∧
      (1 / (m : ℝ)) * (∑' j : ℤ, ‖𝓕 w ((j : ℝ) / (m : ℝ))‖) ≤
        8 * T * Lw * (2 + N / (m : ℝ)) ∧
      ∀ J : ℕ,
        (1 / (m : ℝ)) * (∑' j : ℤ, if (J : ℝ) < |(j : ℝ)|
          then ‖𝓕 w ((j : ℝ) / (m : ℝ))‖ else 0) ≤
            16 * T * Lw / (1 + (N / (m : ℝ)) * (J : ℝ)) := by
  intro w
  let a : ℝ := N / (m : ℝ)
  let C : ℝ := 8 * T * Lw * N
  let k : ℤ → ℝ := fun j => (1 + a * |(j : ℝ)|)⁻¹ ^ 2
  let F : ℤ → ℝ := fun j => ‖𝓕 w ((j : ℝ) / (m : ℝ))‖
  have hm : (0 : ℝ) < m := Nat.cast_pos.mpr (NeZero.pos m)
  have ha : 0 < a := div_pos hN hm
  have hC : 0 ≤ C := by dsimp only [C]; positivity
  obtain ⟨hk, hksum, hktail⟩ := reciprocalSquare_integer_lattice_bounds a ha
  have hpoint (j : ℤ) : F j ≤ C * k j := by
    simpa only [F, w, C, k, a, div_eq_mul_inv, abs_mul, abs_inv, abs_of_pos hm,
      inv_pow, mul_assoc, mul_left_comm, mul_comm] using
      compactProfile_fourier_decay_bound T Lw N t₀
        hT hLw hN ψ hψ hsupport hbound ((j : ℝ) / (m : ℝ))
  have hmajor : Summable (fun j : ℤ => C * k j) := hk.mul_left C
  have hF : Summable F := hmajor.of_nonneg_of_le (fun j => norm_nonneg _) hpoint
  have hsum := hF.tsum_le_tsum hpoint hmajor
  rw [tsum_mul_left] at hsum
  refine ⟨hF, ?_, ?_⟩
  · calc
      _ ≤ (1 / (m : ℝ)) * (C * ∑' j : ℤ, k j) :=
        mul_le_mul_of_nonneg_left hsum (one_div_nonneg.mpr hm.le)
      _ ≤ (1 / (m : ℝ)) * (C * (1 + 2 / a)) :=
        mul_le_mul_of_nonneg_left (mul_le_mul_of_nonneg_left hksum hC)
          (one_div_nonneg.mpr hm.le)
      _ = _ := by
        dsimp only [C, a]
        field_simp
        ring
  · intro J
    let fJ : ℤ → ℝ := fun j => if (J : ℝ) < |(j : ℝ)| then F j else 0
    let kJ : ℤ → ℝ := fun j => if (J : ℝ) < |(j : ℝ)| then k j else 0
    have hfJ : Summable fJ := hF.indicator {j | (J : ℝ) < |(j : ℝ)|}
    have hkJ : Summable kJ := hk.indicator {j | (J : ℝ) < |(j : ℝ)|}
    have hpointJ (j : ℤ) : fJ j ≤ C * kJ j := by
      dsimp only [fJ, kJ]
      split_ifs
      · exact hpoint j
      · simp
    have hsumJ := hfJ.tsum_le_tsum hpointJ (hkJ.mul_left C)
    rw [tsum_mul_left] at hsumJ
    calc
      _ ≤ (1 / (m : ℝ)) * (C * ∑' j : ℤ, kJ j) :=
        mul_le_mul_of_nonneg_left hsumJ (one_div_nonneg.mpr hm.le)
      _ ≤ (1 / (m : ℝ)) * (C * (2 / (a * (1 + a * (J : ℝ))))) :=
        mul_le_mul_of_nonneg_left (mul_le_mul_of_nonneg_left (hktail J) hC)
          (one_div_nonneg.mpr hm.le)
      _ = _ := by
        dsimp only [C, a]
        field_simp
        ring

end

section
open scoped FourierTransform SchwartzMap ContDiff RealInnerProductSpace

theorem compactProfile_fourier_decay_bound_order
    (k : ℕ) (T L N t₀ : ℝ)
    (hT : 0 ≤ T) (hL : 0 ≤ L) (hN : 0 < N)
    (ψ : ℝ → ℂ) (hψ : ContDiff ℝ k ψ)
    (hsupport : Function.support ψ ⊆ Set.Icc (-T) T)
    (hbound : ∀ t : ℝ, ‖ψ t‖ ≤ L ∧ ‖iteratedDeriv k ψ t‖ ≤ L) :
    let w : ℝ → ℂ := fun t => ψ ((t - t₀) / N)
    ∀ y : ℝ,
      ‖𝓕 w y‖ ≤ (2 : ℝ) ^ (k + 1) * T * L * N / (1 + N * |y|) ^ k := by
  intro w y
  have hwC : ContDiff ℝ k w :=
    hψ.comp ((contDiff_id.sub contDiff_const).div_const N)
  have hwderiv : iteratedDeriv k w =
      fun t => (N⁻¹ : ℝ) ^ k • iteratedDeriv k ψ ((t - t₀) / N) := by
    have hh := iteratedDeriv_comp_sub_const k (fun t : ℝ => ψ (N⁻¹ * t)) t₀
    rw [iteratedDeriv_comp_const_smul hψ (N⁻¹ : ℝ)] at hh
    simpa only [w, div_eq_mul_inv, mul_comm] using hh
  have hsuppw : Function.support w ⊆ Set.Icc (t₀ - T * N) (t₀ + T * N) := by
    intro t ht
    have hh := hsupport ht
    constructor <;> linarith [(le_div_iff₀ hN).mp hh.1, (div_le_iff₀ hN).mp hh.2]
  have htsw : tsupport w ⊆ Set.Icc (t₀ - T * N) (t₀ + T * N) :=
    closure_minimal hsuppw isClosed_Icc
  have hwcompact : HasCompactSupport w :=
    HasCompactSupport.of_support_subset_isCompact isCompact_Icc hsuppw
  have hwi (j : ℕ) (hj : j ≤ k) : Integrable (iteratedDeriv j w) := by
    apply (hwC.continuous_iteratedDeriv j (by exact_mod_cast hj)).integrable_of_hasCompactSupport
    rw [iteratedDeriv_eq_equiv_comp]
    exact (hwcompact.iteratedFDeriv j).comp_left (map_zero _)
  have hsuppD : Function.support (iteratedDeriv k w) ⊆
      Set.Icc (t₀ - T * N) (t₀ + T * N) := by
    rw [iteratedDeriv_eq_equiv_comp]
    exact (Function.support_comp_subset (map_zero _) _).trans
      ((support_iteratedFDeriv_subset (𝕜 := ℝ) (f := w) k).trans htsw)
  have hwbound (t : ℝ) : ‖w t‖ ≤ L := (hbound _).1
  have hwboundD (t : ℝ) : ‖iteratedDeriv k w t‖ ≤ L / N ^ k := by
    rw [hwderiv]
    simp only [norm_smul, norm_pow, Real.norm_eq_abs, abs_of_pos (inv_pos.mpr hN)]
    simpa only [mul_comm, inv_pow, div_eq_mul_inv] using
      mul_le_mul (hbound ((t - t₀) / N)).2 (le_refl ((N⁻¹ : ℝ) ^ k))
        (pow_nonneg (inv_nonneg.mpr hN.le) k) hL
  have hab : t₀ - T * N ≤ t₀ + T * N := by
    nlinarith [mul_nonneg hT hN.le]
  have hl1 (f : ℝ → ℂ) (C : ℝ)
      (hs : Function.support f ⊆ Set.Icc (t₀ - T * N) (t₀ + T * N))
      (hC : ∀ t : ℝ, ‖f t‖ ≤ C) :
      (∫ t : ℝ, ‖f t‖) ≤ (2 * T * N) * C := by
    have hz : ∀ t : ℝ, t ∉ Set.Icc (t₀ - T * N) (t₀ + T * N) → ‖f t‖ = 0 := by
      intro t ht
      rw [Function.support_subset_iff'.mp hs t ht, norm_zero]
    rw [← setIntegral_eq_integral_of_forall_compl_eq_zero hz]
    calc
      _ ≤ ∫ _t : ℝ in Set.Icc (t₀ - T * N) (t₀ + T * N), C :=
        integral_mono_of_nonneg (Filter.Eventually.of_forall fun _ => norm_nonneg _)
          continuous_const.integrableOn_Icc (Filter.Eventually.of_forall hC)
      _ = (2 * T * N) * C := by
        rw [setIntegral_const, Real.volume_real_Icc_of_le hab, smul_eq_mul]
        ring
  have hmass : (∫ t : ℝ, ‖w t‖) ≤ 2 * T * L * N := by
    simpa only [mul_assoc, mul_left_comm, mul_comm] using
      hl1 w L hsuppw hwbound
  have hmassD : (∫ t : ℝ, ‖iteratedDeriv k w t‖) ≤ (2 * T * L * N) / N ^ k := by
    calc
      _ ≤ (2 * T * N) * (L / N ^ k) :=
        hl1 (iteratedDeriv k w) (L / N ^ k) hsuppD hwboundD
      _ = (2 * T * L * N) / N ^ k := by ring
  let F : ℝ := ‖𝓕 w y‖
  let u : ℝ := N * |y|
  let M : ℝ := 2 * T * L * N
  have hF : 0 ≤ F := norm_nonneg _
  have hu : 0 ≤ u := mul_nonneg hN.le (abs_nonneg _)
  have hnorm (f : ℝ → ℂ) : ‖𝓕 f y‖ ≤ ∫ t : ℝ, ‖f t‖ :=
    VectorFourier.norm_fourierIntegral_le_integral_norm
      Real.fourierChar volume (innerₗ ℝ) f y
  have hlow : F ≤ M := (hnorm w).trans hmass
  have hhigh : (2 * Real.pi * |y|) ^ k * F ≤ M / N ^ k := by
    have hD := congrFun
      (Real.fourier_iteratedDeriv (N := k) hwC
        (fun j hj => hwi j (by exact_mod_cast hj)) (n := k) le_rfl) y
    have hc : ‖2 * (Real.pi : ℂ) * Complex.I * (y : ℂ)‖ =
        2 * Real.pi * |y| := by
      simp [Real.norm_eq_abs, abs_of_pos Real.pi_pos]
    calc
      _ = ‖(2 * (Real.pi : ℂ) * Complex.I * (y : ℂ)) ^ k • 𝓕 w y‖ := by
        rw [norm_smul, norm_pow, hc]
      _ = ‖𝓕 (iteratedDeriv k w) y‖ := congrArg norm hD.symm
      _ ≤ ∫ t : ℝ, ‖iteratedDeriv k w t‖ := hnorm _
      _ ≤ _ := hmassD
  have hpi : 1 ≤ (2 * Real.pi) ^ k :=
    one_le_pow₀ (by linarith [Real.one_le_pi_div_two])
  have hweighted : u ^ k * F ≤ M := by
    have hh := mul_le_mul_of_nonneg_left hhigh (pow_nonneg hN.le k)
    have he : N ^ k * (M / N ^ k) = M := by field_simp [hN.ne']
    have he' : N ^ k * ((2 * Real.pi * |y|) ^ k * F) =
        (2 * Real.pi) ^ k * (u ^ k * F) := by
      dsimp only [u]
      simp only [mul_pow]
      ring
    rw [he, he'] at hh
    exact (le_mul_of_one_le_left (mul_nonneg (pow_nonneg hu k) hF) hpi).trans hh
  have hfinal : (1 + u) ^ k * F ≤ (2 : ℝ) ^ k * M := by
    rcases le_total u 1 with hu₁ | h₁u
    · have hp : (1 + u) ^ k ≤ (2 : ℝ) ^ k :=
        pow_le_pow_left₀ (by positivity) (by linarith) k
      exact (mul_le_mul_of_nonneg_right hp hF).trans
        (mul_le_mul_of_nonneg_left hlow (pow_nonneg (by norm_num) k))
    · calc
        _ ≤ (2 * u) ^ k * F := mul_le_mul_of_nonneg_right
          (pow_le_pow_left₀ (by positivity) (by linarith) k) hF
        _ = (2 : ℝ) ^ k * (u ^ k * F) := by rw [mul_pow]; ring
        _ ≤ (2 : ℝ) ^ k * M :=
          mul_le_mul_of_nonneg_left hweighted (pow_nonneg (by norm_num) k)
  change F ≤ (2 : ℝ) ^ (k + 1) * T * L * N / (1 + u) ^ k
  apply (le_div_iff₀ (by positivity : (0 : ℝ) < (1 + u) ^ k)).2
  calc
    _ = (1 + u) ^ k * F := mul_comm _ _
    _ ≤ (2 : ℝ) ^ k * M := hfinal
    _ = _ := by dsimp only [M]; rw [pow_succ]; ring

open Classical in
theorem compactProfile_centered_fourier_truncation
    (k m : ℕ) [NeZero m] (T L N t₀ H : ℝ)
    (hT : 0 ≤ T) (hL : 0 ≤ L) (hN : 0 < N) (hH : 0 ≤ H)
    (ψ : ℝ → ℂ) (hψ : ContDiff ℝ ∞ ψ)
    (hsupport : Function.support ψ ⊆ Set.Icc (-T) T)
    (hbound : ∀ t : ℝ, ‖ψ t‖ ≤ L ∧ ‖iteratedDeriv (k + 2) ψ t‖ ≤ L) :
    let w : ℝ → ℂ := fun t => ψ ((t - t₀) / N)
    let A : ℤ := ⌈t₀ - T * N⌉
    let K : ℕ := (⌊t₀ + T * N⌋ + 1 - A).toNat
    let W : ZMod m → ℂ := integerIntervalResidueWeight m A K
      (fun j => w ((A : ℝ) + (j : ℝ)))
    let S : Finset (ZMod m) := Finset.univ.filter
      (fun ξ => ξ ≠ 0 ∧ |(ξ.valMinAbs : ℝ)| ≤ H)
    let C : ℝ := (2 : ℝ) ^ (k + 4) * T * L / (1 + (N / (m : ℝ)) * H) ^ k
    ((1 / (m : ℝ)) *
        ∑ ξ ∈ (Finset.univ : Finset (ZMod m)).filter
          (fun ξ => H < |(ξ.valMinAbs : ℝ)|), ‖ZMod.dft W ξ‖ ≤
      (1 / (m : ℝ)) * ∑' j : ℤ,
        if H < |(j : ℝ)| then ‖𝓕 w ((j : ℝ) / (m : ℝ))‖ else 0) ∧
    ((1 / (m : ℝ)) * ∑' j : ℤ,
        (if H < |(j : ℝ)| then ‖𝓕 w ((j : ℝ) / (m : ℝ))‖ else 0) ≤ C) ∧
    (∀ F : ZMod m → ℂ,
      ‖(∑ z : ZMod m, W z * F z) -
          (m : ℂ)⁻¹ * ((∑ z : ZMod m, W z) * (∑ z : ZMod m, F z) +
            ∑ ξ ∈ S, ZMod.dft W ξ * ZMod.dft F (-ξ))‖ ≤
        C * ∑ z : ZMod m, ‖F z‖) := by
  intro w A K W S C
  have hm : 0 < (m : ℝ) := Nat.cast_pos.mpr (NeZero.pos m)
  let a : ℝ := N / (m : ℝ)
  have ha : 0 < a := div_pos hN hm
  let D : Finset (ZMod m) := Finset.univ.filter
    (fun ξ => H < |(ξ.valMinAbs : ℝ)|)
  obtain ⟨hgrid, halias, _⟩ :=
    compactProfile_poisson_completion m T N t₀ hT hN ψ hψ hsupport
  change Summable (fun j : ℤ => ‖𝓕 w ((j : ℝ) / (m : ℝ))‖) at hgrid
  change ∀ ξ : ZMod m,
    HasSum (fun j : ℤ => 𝓕 w ((j : ℝ) + (ξ.val : ℝ) / (m : ℝ)))
      (ZMod.dft W ξ) at halias
  let G : ℝ → ℂ := fun y => if H < |(m : ℝ) * y| then 𝓕 w y else 0
  have hGgrid (j : ℤ) :
      ‖G ((j : ℝ) / (m : ℝ))‖ =
        if H < |(j : ℝ)| then ‖𝓕 w ((j : ℝ) / (m : ℝ))‖ else 0 := by
    dsimp only [G]
    rw [mul_div_cancel₀ _ hm.ne']
    split_ifs <;> simp
  have hGs : Summable (fun j : ℤ => ‖G ((j : ℝ) / (m : ℝ))‖) :=
    (hgrid.indicator {j : ℤ | H < |(j : ℝ)|}).congr fun j => (hGgrid j).symm
  obtain ⟨hrows, hreindex⟩ := poisson_grid_reindex m G hGs
  have hminimal (ξ : ZMod m) (j : ℤ) (hj : (j : ZMod m) = ξ) :
      |(ξ.valMinAbs : ℝ)| ≤ |(j : ℝ)| := by
    have h := ZMod.natAbs_min_of_le_div_two m ξ.valMinAbs j
      ((ZMod.coe_valMinAbs ξ).trans hj.symm) (ZMod.natAbs_valMinAbs_le ξ)
    have hr : (ξ.valMinAbs.natAbs : ℝ) ≤ (j.natAbs : ℝ) := by exact_mod_cast h
    simpa only [Nat.cast_natAbs, Int.cast_abs] using hr
  have hrow (ξ : ZMod m) (hξ : H < |(ξ.valMinAbs : ℝ)|) :
      ‖ZMod.dft W ξ‖ ≤
        ∑' j : ℤ, ‖G ((j : ℝ) + (ξ.val : ℝ) / (m : ℝ))‖ := by
    apply (halias ξ).norm_le_of_bounded (hrows ξ).hasSum
    intro j
    let b : ℤ := (m : ℤ) * j + (ξ.val : ℤ)
    have hb : (b : ZMod m) = ξ := by simp [b]
    have he : (m : ℝ) * ((j : ℝ) + (ξ.val : ℝ) / (m : ℝ)) = (b : ℝ) := by
      rw [mul_add, mul_div_cancel₀ _ hm.ne']
      simp only [b, Int.cast_add, Int.cast_mul, Int.cast_natCast]
    have hh : H < |(m : ℝ) * ((j : ℝ) + (ξ.val : ℝ) / (m : ℝ))| := by
      rw [he]
      exact hξ.trans_le (hminimal ξ b hb)
    simp only [G, ite_eq_left hh, le_refl]
  have hcompare :
      (1 / (m : ℝ)) * ∑ ξ ∈ D, ‖ZMod.dft W ξ‖ ≤
        (1 / (m : ℝ)) * ∑' j : ℤ,
          if H < |(j : ℝ)| then ‖𝓕 w ((j : ℝ) / (m : ℝ))‖ else 0 := by
    apply mul_le_mul_of_nonneg_left _ (one_div_nonneg.mpr hm.le)
    calc
      _ ≤ ∑ ξ ∈ D, ∑' j : ℤ,
          ‖G ((j : ℝ) + (ξ.val : ℝ) / (m : ℝ))‖ :=
        Finset.sum_le_sum fun ξ hξ => hrow ξ (Finset.mem_filter.mp hξ).2
      _ ≤ ∑ ξ : ZMod m, ∑' j : ℤ,
          ‖G ((j : ℝ) + (ξ.val : ℝ) / (m : ℝ))‖ :=
        Finset.sum_le_sum_of_subset_of_nonneg (Finset.subset_univ D)
          (fun _ _ _ => tsum_nonneg fun _ => norm_nonneg _)
      _ = _ := hreindex.trans (tsum_congr hGgrid)
  let q : ℤ → ℝ := fun j =>
    if (0 : ℝ) < |(j : ℝ)| then (1 + a * |(j : ℝ)|)⁻¹ ^ 2 else 0
  have hquad := reciprocalSquare_integer_lattice_bounds a ha
  have hqs : Summable q := hquad.1.indicator {j : ℤ | (0 : ℝ) < |(j : ℝ)|}
  have hq : (∑' j : ℤ, q j) ≤ 2 / a := by
    simpa only [q, Nat.cast_zero, mul_zero, add_zero, mul_one] using hquad.2.2 0
  let c : ℝ := (2 : ℝ) ^ (k + 3) * T * L * N / (1 + a * H) ^ k
  have hc : 0 ≤ c := by dsimp only [c]; positivity
  have htailPoint (j : ℤ) :
      (if H < |(j : ℝ)| then ‖𝓕 w ((j : ℝ) / (m : ℝ))‖ else 0) ≤ c * q j := by
    by_cases hj : H < |(j : ℝ)|
    · have hj0 : (0 : ℝ) < |(j : ℝ)| := hH.trans_lt hj
      simp only [ite_eq_left hj, q, ite_eq_left hj0]
      have hy : N * |(j : ℝ) / (m : ℝ)| = a * |(j : ℝ)| := by
        rw [abs_div, abs_of_pos hm]
        dsimp only [a]
        ring
      have hd : ‖𝓕 w ((j : ℝ) / (m : ℝ))‖ ≤
          (2 : ℝ) ^ (k + 3) * T * L * N / (1 + a * |(j : ℝ)|) ^ (k + 2) := by
        simpa only [Nat.add_assoc, hy] using
          compactProfile_fourier_decay_bound_order (k + 2) T L N t₀ hT hL hN ψ
            (hψ.of_le (by simp)) hsupport hbound ((j : ℝ) / (m : ℝ))
      have hb : 0 < 1 + a * |(j : ℝ)| := by positivity
      have hbH : 0 < 1 + a * H := by positivity
      have hpow : (1 + a * H) ^ k ≤ (1 + a * |(j : ℝ)|) ^ k := by
        gcongr
      calc
        _ ≤ (2 : ℝ) ^ (k + 3) * T * L * N /
            (1 + a * |(j : ℝ)|) ^ (k + 2) := hd
        _ ≤ (2 : ℝ) ^ (k + 3) * T * L * N /
            ((1 + a * H) ^ k * (1 + a * |(j : ℝ)|) ^ 2) := by
          apply div_le_div_of_nonneg_left (by positivity) (by positivity)
          rw [pow_add]
          exact mul_le_mul_of_nonneg_right hpow (sq_nonneg _)
        _ = c * (1 + a * |(j : ℝ)|)⁻¹ ^ 2 := by
          dsimp only [c]
          field_simp [hb.ne', hbH.ne']
    · rw [ite_eq_right hj]
      exact mul_nonneg hc (by dsimp only [q]; split_ifs <;> positivity)
  have htail :
      (1 / (m : ℝ)) * ∑' j : ℤ,
          (if H < |(j : ℝ)| then ‖𝓕 w ((j : ℝ) / (m : ℝ))‖ else 0) ≤ C := by
    have hs := hGs.congr hGgrid
    calc
      _ ≤ (1 / (m : ℝ)) * ∑' j : ℤ, c * q j :=
        mul_le_mul_of_nonneg_left (hs.tsum_le_tsum htailPoint (hqs.mul_left c))
          (one_div_nonneg.mpr hm.le)
      _ = (1 / (m : ℝ)) * (c * ∑' j : ℤ, q j) := by rw [tsum_mul_left]
      _ ≤ (1 / (m : ℝ)) * (c * (2 / a)) :=
        mul_le_mul_of_nonneg_left (mul_le_mul_of_nonneg_left hq hc)
          (one_div_nonneg.mpr hm.le)
      _ = C := by
        dsimp only [c, C, a]
        rw [show k + 4 = (k + 3) + 1 by omega, pow_succ]
        field_simp [hm.ne', hN.ne']
        ring
  refine ⟨hcompare, htail, ?_⟩
  intro F
  have hS : ((Finset.univ : Finset (ZMod m)).erase 0).filter
      (fun ξ => |(ξ.valMinAbs : ℝ)| ≤ H) = S := by
    ext ξ
    simp [S, Finset.mem_erase]
  have hD : ((Finset.univ : Finset (ZMod m)).erase 0).filter
      (fun ξ => H < |(ξ.valMinAbs : ℝ)|) = D := by
    rw [Finset.filter_erase]
    exact Finset.erase_eq_of_notMem (by simp [not_lt.mpr hH])
  have hsplit := Finset.sum_filter_add_sum_filter_not
    ((Finset.univ : Finset (ZMod m)).erase 0)
    (fun ξ => |(ξ.valMinAbs : ℝ)| ≤ H)
    (fun ξ => ZMod.dft W ξ * ZMod.dft F (-ξ))
  simp only [not_le, hS, hD] at hsplit
  have hdecomp :
      (∑ ξ : ZMod m, ZMod.dft W ξ * ZMod.dft F (-ξ)) =
        (∑ z : ZMod m, W z) * (∑ z : ZMod m, F z) +
          (∑ ξ ∈ S, ZMod.dft W ξ * ZMod.dft F (-ξ)) +
          ∑ ξ ∈ D, ZMod.dft W ξ * ZMod.dft F (-ξ) := by
    rw [← Finset.sum_erase_add (Finset.univ : Finset (ZMod m)) _ (Finset.mem_univ 0),
      ← hsplit, neg_zero, ZMod.dft_apply_zero, ZMod.dft_apply_zero]
    ring
  have herr :
      (∑ z : ZMod m, W z * F z) -
          (m : ℂ)⁻¹ * ((∑ z : ZMod m, W z) * (∑ z : ZMod m, F z) +
            ∑ ξ ∈ S, ZMod.dft W ξ * ZMod.dft F (-ξ)) =
        (m : ℂ)⁻¹ * ∑ ξ ∈ D, ZMod.dft W ξ * ZMod.dft F (-ξ) := by
    rw [full_weighted_sum_dft, hdecomp]
    ring
  have hF (ξ : ZMod m) : ‖ZMod.dft F ξ‖ ≤ ∑ z : ZMod m, ‖F z‖ := by
    rw [ZMod.dft_apply]
    exact norm_sum_le_of_le _ fun _ _ => by simp
  have hnorm : ‖∑ ξ ∈ D, ZMod.dft W ξ * ZMod.dft F (-ξ)‖ ≤
      (∑ ξ ∈ D, ‖ZMod.dft W ξ‖) * ∑ z : ZMod m, ‖F z‖ := by
    rw [Finset.sum_mul]
    exact norm_sum_le_of_le D fun ξ _ => by
      rw [norm_mul]
      exact mul_le_mul_of_nonneg_left (hF (-ξ)) (norm_nonneg _)
  rw [herr, norm_mul, norm_inv, Complex.norm_natCast]
  calc
    _ ≤ (m : ℝ)⁻¹ * ((∑ ξ ∈ D, ‖ZMod.dft W ξ‖) * ∑ z : ZMod m, ‖F z‖) :=
      mul_le_mul_of_nonneg_left hnorm (inv_nonneg.mpr hm.le)
    _ = ((1 / (m : ℝ)) * ∑ ξ ∈ D, ‖ZMod.dft W ξ‖) *
        ∑ z : ZMod m, ‖F z‖ := by rw [one_div]; ring
    _ ≤ C * ∑ z : ZMod m, ‖F z‖ :=
      mul_le_mul_of_nonneg_right (hcompare.trans htail)
        (Finset.sum_nonneg fun _ _ => norm_nonneg _)

open Classical in
theorem compactProfile_centered_fourier_truncation_power_saving
    (B ε : ℝ) (hB : 0 ≤ B) (hε : 0 < ε) :
    let k : ℕ := Nat.ceil ((B + 1) / ε)
    B + 1 ≤ ε * (k : ℝ) ∧
    ∀ (T L E : ℝ), 0 ≤ T → 0 ≤ L →
      ∃ X : ℝ, 2 ≤ X ∧
        ∀ (x : ℝ), X ≤ x →
        ∀ (m : ℕ) [NeZero m] (N t₀ : ℝ), 0 < N →
        ∀ (ψ : ℝ → ℂ), ContDiff ℝ ∞ ψ →
          Function.support ψ ⊆ Set.Icc (-T) T →
          (∀ t : ℝ,
            ‖ψ t‖ ≤ L * (Real.log x) ^ E ∧
            ‖iteratedDeriv (k + 2) ψ t‖ ≤ L * (Real.log x) ^ E) →
          let w : ℝ → ℂ := fun t => ψ ((t - t₀) / N)
          let A : ℤ := ⌈t₀ - T * N⌉
          let K : ℕ := (⌊t₀ + T * N⌋ + 1 - A).toNat
          let W : ZMod m → ℂ := integerIntervalResidueWeight m A K
            (fun j => w ((A : ℝ) + (j : ℝ)))
          let H : ℝ := x ^ ε * (m : ℝ) / N
          let S : Finset (ZMod m) := Finset.univ.filter
            (fun ξ => ξ ≠ 0 ∧ |(ξ.valMinAbs : ℝ)| ≤ H)
          ((1 / (m : ℝ)) *
              ∑ ξ ∈ (Finset.univ : Finset (ZMod m)).filter
                (fun ξ => H < |(ξ.valMinAbs : ℝ)|), ‖ZMod.dft W ξ‖ ≤
            (2 : ℝ) ^ (k + 4) * T * L * x ^ (-B)) ∧
          (∀ F : ZMod m → ℂ,
            ‖(∑ z : ZMod m, W z * F z) -
                (m : ℂ)⁻¹ * ((∑ z : ZMod m, W z) * (∑ z : ZMod m, F z) +
                  ∑ ξ ∈ S, ZMod.dft W ξ * ZMod.dft F (-ξ))‖ ≤
              (2 : ℝ) ^ (k + 4) * T * L * x ^ (-B) *
                ∑ z : ZMod m, ‖F z‖) := by
  let k : ℕ := Nat.ceil ((B + 1) / ε)
  change B + 1 ≤ ε * (k : ℝ) ∧ _
  have hk : B + 1 ≤ ε * (k : ℝ) := by
    simpa only [mul_comm] using (div_le_iff₀ hε).mp (Nat.le_ceil ((B + 1) / ε))
  refine ⟨hk, ?_⟩
  intro T L E hT hL
  obtain ⟨X, hX⟩ := Filter.eventually_atTop.1
    (isLittleO_log_rpow_rpow_atTop E zero_lt_one).eventuallyLE
  refine ⟨max 2 X, le_max_left _ _, ?_⟩
  intro x hx m inst N t₀ hN ψ hψ hsupport hbound
  have hx1 : (1 : ℝ) ≤ x := by linarith [le_max_left (2 : ℝ) X]
  have hx0 : 0 < x := by linarith
  have hlog0 : 0 ≤ (Real.log x) ^ E :=
    Real.rpow_nonneg (Real.log_nonneg hx1) E
  have hlog : (Real.log x) ^ E ≤ x := by
    simpa only [Real.rpow_one, Real.norm_of_nonneg hlog0,
      Real.norm_of_nonneg hx0.le] using hX x ((le_max_right 2 X).trans hx)
  have hden : x ^ (B + 1) ≤ (1 + x ^ ε) ^ k := by
    calc
      x ^ (B + 1) ≤ x ^ (ε * (k : ℝ)) :=
        Real.rpow_le_rpow_of_exponent_le hx1 hk
      _ = (x ^ ε) ^ k := Real.rpow_mul_natCast hx0.le ε k
      _ ≤ (1 + x ^ ε) ^ k :=
        pow_le_pow_left₀ (Real.rpow_nonneg hx0.le ε) (by linarith) k
  have hden0 : 0 < x ^ (B + 1) :=
    lt_of_lt_of_le zero_lt_one (Real.one_le_rpow hx1 (by linarith only [hB]))
  have hratio : (Real.log x) ^ E / (1 + x ^ ε) ^ k ≤ x ^ (-B) := by
    calc
      (Real.log x) ^ E / (1 + x ^ ε) ^ k ≤ x / x ^ (B + 1) :=
        div_le_div₀ hx0.le hlog hden0 hden
      _ = x ^ (-B) := by
        simpa only [Real.rpow_one, show (1 : ℝ) - (B + 1) = -B by ring] using
          (Real.rpow_sub hx0 1 (B + 1)).symm
  let H : ℝ := x ^ ε * (m : ℝ) / N
  have hm : 0 < (m : ℝ) := Nat.cast_pos.mpr (NeZero.pos m)
  have hH : 0 ≤ H := (div_pos (mul_pos (Real.rpow_pos_of_pos hx0 ε) hm) hN).le
  have hscale : (N / (m : ℝ)) * H = x ^ ε := by
    dsimp only [H]
    field_simp [hm.ne', hN.ne']
  have hC :
      (2 : ℝ) ^ (k + 4) * T * (L * (Real.log x) ^ E) /
          (1 + (N / (m : ℝ)) * H) ^ k ≤
        (2 : ℝ) ^ (k + 4) * T * L * x ^ (-B) := by
    rw [hscale, ← mul_assoc, mul_div_assoc]
    exact mul_le_mul_of_nonneg_left hratio (by positivity)
  obtain ⟨htail, hmass, hpair⟩ :=
    compactProfile_centered_fourier_truncation k m T (L * (Real.log x) ^ E)
      N t₀ H hT (mul_nonneg hL hlog0) hN hH ψ hψ hsupport hbound
  refine ⟨(htail.trans hmass).trans hC, ?_⟩
  intro F
  exact (hpair F).trans
    (mul_le_mul_of_nonneg_right hC (Finset.sum_nonneg fun z _ => norm_nonneg (F z)))

theorem typeZero_unitMean_norm_le
    (q : ℕ) [NeZero q] (W : ZMod q → ℂ) (z₀ : ℂ) (C : ℝ)
    (hC : 0 ≤ C) (hW : ∀ z : ZMod q, ‖W z - z₀‖ ≤ C)
    (a : (ZMod q)ˣ) :
    ‖W (a : ZMod q) -
        (q.totient : ℂ)⁻¹ * ∑ b : (ZMod q)ˣ, W (b : ZMod q)‖ ≤ 2 * C := by
  have hmean : ‖(q.totient : ℂ)⁻¹ *
      (∑ b : (ZMod q)ˣ, W (b : ZMod q)) - z₀‖ ≤ C := by
    have h := (RCLike.norm_expect_le (K := ℂ)
      (s := Finset.univ) (f := fun b : (ZMod q)ˣ => W (b : ZMod q) - z₀)).trans
      (Finset.expect_le Finset.univ_nonempty fun b _ =>
        (hW (b : ZMod q)).trans (le_abs_self C))
    simp only [Finset.expect_sub_distrib, Fintype.expect_const] at h
    simpa only [Fintype.expect_eq_sum_div_card, ZMod.card_units_eq_totient,
      div_eq_inv_mul, abs_of_nonneg hC] using h
  simpa only [sub_sub_sub_cancel_right, two_mul] using
    (norm_sub_le_of_le (hW (a : ZMod q)) hmean)

open Classical in
theorem compactProfile_primitive_discrepancy_le
    (k q : ℕ) [NeZero q] (T L N t₀ : ℝ)
    (hT : 0 ≤ T) (hL : 0 ≤ L) (hN : 0 < N)
    (ψ : ℝ → ℂ) (hψ : ContDiff ℝ ∞ ψ)
    (hsupport : Function.support ψ ⊆ Set.Icc (-T) T)
    (hbound : ∀ t : ℝ,
      ‖ψ t‖ ≤ L ∧ ‖iteratedDeriv (k + 2) ψ t‖ ≤ L)
    (a : (ZMod q)ˣ) :
    let w : ℝ → ℂ := fun t => ψ ((t - t₀) / N)
    let A : ℤ := ⌈t₀ - T * N⌉
    let K : ℕ := (⌊t₀ + T * N⌋ + 1 - A).toNat
    let W : ZMod q → ℂ := integerIntervalResidueWeight q A K
      (fun j => w ((A : ℝ) + (j : ℝ)))
    ‖W (a : ZMod q) -
        (q.totient : ℂ)⁻¹ * ∑ b : (ZMod q)ˣ, W (b : ZMod q)‖ ≤
      (2 : ℝ) ^ (k + 5) * T * L / (1 + N / (2 * (q : ℝ))) ^ k := by
  intro w A K W
  let C : ℝ := (2 : ℝ) ^ (k + 4) * T * L / (1 + N / (2 * (q : ℝ))) ^ k
  have hC : 0 ≤ C := by dsimp only [C]; positivity
  have hempty : (Finset.univ : Finset (ZMod q)).filter
      (fun ξ => ξ ≠ 0 ∧ |(ξ.valMinAbs : ℝ)| ≤ (1 / 2 : ℝ)) = ∅ := by
    apply Finset.filter_eq_empty_iff.mpr
    intro ξ _ hξ
    apply hξ.1
    apply (ZMod.valMinAbs_eq_zero ξ).mp
    apply Int.abs_lt_one_iff.mp
    exact_mod_cast hξ.2.trans_lt (show (1 / 2 : ℝ) < 1 by norm_num)
  obtain ⟨_, _, hpair⟩ := compactProfile_centered_fourier_truncation k q T L N t₀
    (1 / 2) hT hL hN (by norm_num) ψ hψ hsupport hbound
  have hscale : (N / (q : ℝ)) * (1 / 2) = N / (2 * (q : ℝ)) := by ring
  have hW (z : ZMod q) : ‖W z - (q : ℂ)⁻¹ * ∑ y : ZMod q, W y‖ ≤ C := by
    have h := hpair (fun y => if y = z then (1 : ℂ) else 0)
    rw [hempty, Finset.sum_empty, add_zero, hscale] at h
    simpa only [mul_ite, mul_one, mul_zero, Fintype.sum_ite_eq', apply_ite norm,
      norm_one, norm_zero] using h
  calc
    _ ≤ 2 * C := typeZero_unitMean_norm_le q W
      ((q : ℂ)⁻¹ * ∑ y : ZMod q, W y) C hC hW a
    _ = _ := by
      dsimp only [C]
      rw [show k + 5 = (k + 4) + 1 from rfl, pow_succ]
      ring

end

theorem compactProfile_natural_sample_mass_le
    (sm : Finset ℕ) (T L M t₀ : ℝ)
    (hT : 0 ≤ T) (hL : 0 ≤ L) (hM : 0 < M)
    (ψ : ℝ → ℝ) (hψ : ContDiff ℝ 2 ψ)
    (hsupport : Function.support ψ ⊆ Set.Icc (-T) T)
    (hbound : ∀ t : ℝ,
      |ψ t| ≤ L ∧ |deriv ψ t| ≤ L ∧ |deriv (deriv ψ) t| ≤ L) :
    (∑ n ∈ sm, |ψ (((n : ℝ) - t₀) / M)|) ≤ (2 * T * M + 1) * L ∧
    |∑ n ∈ sm, ψ (((n : ℝ) - t₀) / M)| ≤ (2 * T * M + 1) * L ∧
    (1 ≤ M → |∑ n ∈ sm, ψ (((n : ℝ) - t₀) / M)| ≤ (2 * T + 1) * L * M) := by
  classical
  let Ψ : ℝ → ℂ := fun t => (ψ t : ℂ)
  have hΨ : ContDiff ℝ 2 Ψ := Complex.ofRealCLM.contDiff.comp hψ
  have hΨsupport : Function.support Ψ ⊆ Set.Icc (-T) T :=
    (Function.support_comp_subset Complex.ofReal_zero ψ).trans hsupport
  have hderiv : deriv Ψ = fun t => ((deriv ψ t : ℝ) : ℂ) := by
    funext t
    exact ((hψ.differentiable (by norm_num) t).hasDerivAt.ofReal_comp).deriv
  have hderiv₂ : deriv (deriv Ψ) = fun t => ((deriv (deriv ψ) t : ℝ) : ℂ) := by
    rw [hderiv]
    funext t
    exact ((hψ.differentiable_deriv_two t).hasDerivAt.ofReal_comp).deriv
  have hΨbound : ∀ t : ℝ,
      ‖Ψ t‖ ≤ L ∧ ‖deriv Ψ t‖ ≤ L ∧ ‖deriv (deriv Ψ) t‖ ≤ L := by
    intro t
    refine ⟨?_, ?_, ?_⟩
    · simpa only [Ψ, Complex.norm_real, Real.norm_eq_abs] using (hbound t).1
    · rw [hderiv]
      simpa only [Complex.norm_real, Real.norm_eq_abs] using (hbound t).2.1
    · rw [hderiv₂]
      simpa only [Complex.norm_real, Real.norm_eq_abs] using (hbound t).2.2
  let I : Finset ℤ := Finset.Icc ⌈t₀ - T * M⌉ ⌊t₀ + T * M⌋
  let a : ℤ → ℂ := fun n => Ψ (((n : ℝ) - t₀) / M)
  obtain ⟨hzero, hfull, _⟩ := compactProfile_second_difference_bounds
    T L M t₀ hT hL hM Ψ hΨ hΨsupport hΨbound
  have hsubset : (sm.filter (fun n : ℕ => ‖a (n : ℤ)‖ ≠ 0)).image
      (fun n : ℕ => (n : ℤ)) ⊆ I := by
    intro z hz
    obtain ⟨n, hn, rfl⟩ := Finset.mem_image.mp hz
    by_contra h
    exact (Finset.mem_filter.mp hn).2 (norm_eq_zero.mpr (hzero _ h))
  have hmass : (∑ n ∈ sm, |ψ (((n : ℝ) - t₀) / M)|) ≤
      (2 * T * M + 1) * L := by
    have hcomparison :
        (∑ n ∈ sm.filter (fun n : ℕ => ‖a (n : ℤ)‖ ≠ 0), ‖a (n : ℤ)‖) ≤
          ∑ n ∈ I, ‖a n‖ :=
      Finset.sum_le_sum_of_injOn (fun n : ℕ => (n : ℤ))
        (fun _ _ _ _ h => Int.natCast_inj.mp h) hsubset
        (fun _ _ => le_rfl) (fun _ _ _ => norm_nonneg _)
    rw [Finset.sum_filter_ne_zero] at hcomparison
    simpa only [a, Ψ, Int.cast_natCast, Complex.norm_real, Real.norm_eq_abs]
      using hcomparison.trans hfull
  have hsigned : |∑ n ∈ sm, ψ (((n : ℝ) - t₀) / M)| ≤
      (2 * T * M + 1) * L :=
    (Finset.abs_sum_le_sum_abs (fun n : ℕ => ψ (((n : ℝ) - t₀) / M)) sm).trans hmass
  refine ⟨hmass, hsigned, fun hM₁ => hsigned.trans ?_⟩
  nlinarith [mul_nonneg hL (sub_nonneg.mpr hM₁)]

open Classical in
theorem corrected_diagonal_divisor_fiber_card_le
    (k c₁ c₂ : ℕ) (hk : 0 < k) (hcop : Nat.Coprime c₁ k)
    (M₀ M₁ n : ℤ) :
    (((Finset.Icc M₀ M₁).filter
      (fun m => (k : ℤ) ∣ (c₁ : ℤ) * m - (c₂ : ℤ) * n)).card : ℝ) ≤
        ((Finset.Icc M₀ M₁).card : ℝ) / (k : ℝ) + 1 := by
  let I := Finset.Icc M₀ M₁
  let S := I.filter (fun m => (k : ℤ) ∣ (c₁ : ℤ) * m - (c₂ : ℤ) * n)
  change (S.card : ℝ) ≤ (I.card : ℝ) / (k : ℝ) + 1
  by_cases hS : S.Nonempty
  · obtain ⟨m₀, hm₀⟩ := hS
    have hsub : S ⊆ I.filter (fun m => Int.ModEq (k : ℤ) m m₀) := by
      intro m hm
      refine Finset.mem_filter.mpr ⟨(Finset.mem_filter.mp hm).1, ?_⟩
      apply Int.modEq_iff_dvd.mpr
      have hdiff : (k : ℤ) ∣ (c₁ : ℤ) * (m₀ - m) := by
        simpa only [sub_sub_sub_cancel_right, ← mul_sub] using
          dvd_sub (Finset.mem_filter.mp hm₀).2 (Finset.mem_filter.mp hm).2
      exact hcop.isCoprime.symm.dvd_of_dvd_mul_left hdiff
    have hm₀I : M₀ ≤ m₀ ∧ m₀ ≤ M₁ :=
      Finset.mem_Icc.mp (Finset.mem_filter.mp hm₀).1
    have hlen : (I.card : ℤ) = M₁ + 1 - M₀ := by
      exact Int.card_Icc_of_le M₀ M₁ (by omega)
    have hend : M₀ + (I.card : ℤ) = M₁ + 1 := by omega
    have hcount := interval_modEq_card_le M₀ I.card k hk m₀
    rw [hend, Finset.Ico_add_one_right_eq_Icc] at hcount
    exact (show (S.card : ℝ) ≤
      ((I.filter (fun m => Int.ModEq (k : ℤ) m m₀)).card : ℝ) by
        exact_mod_cast Finset.card_le_card hsub).trans hcount
  · have hzero : S = ∅ := Finset.not_nonempty_iff_eq_empty.mp hS
    rw [hzero, Finset.card_empty, Nat.cast_zero]
    positivity

open Classical in
theorem corrected_common_prime_diagonal_interval_average
    (D c₁ c₂ : ℕ) (hD : 1 ≤ D) (hcop : Nat.Coprime c₁ D)
    (M₀ M₁ N₀ N₁ : ℤ) :
    let I := Finset.Icc M₀ M₁
    let J := Finset.Icc N₀ N₁
    (∑ m ∈ I, ∑ n ∈ J,
      Real.sqrt (Int.gcd ((c₁ : ℤ) * m - (c₂ : ℤ) * n) (D : ℤ) : ℝ)) ≤
        (D.divisors.card : ℝ) *
          ((I.card : ℝ) * (J.card : ℝ) + (J.card : ℝ) * Real.sqrt (D : ℝ)) := by
  let I := Finset.Icc M₀ M₁
  let J := Finset.Icc N₀ N₁
  change (∑ m ∈ I, ∑ n ∈ J,
    Real.sqrt (Int.gcd ((c₁ : ℤ) * m - (c₂ : ℤ) * n) (D : ℤ) : ℝ)) ≤
      (D.divisors.card : ℝ) *
        ((I.card : ℝ) * (J.card : ℝ) + (J.card : ℝ) * Real.sqrt (D : ℝ))
  have hDpos : 0 < D := hD
  have hmajor (z : ℤ) :
      Real.sqrt (Int.gcd z (D : ℤ) : ℝ) ≤
        ∑ k ∈ D.divisors, if (k : ℤ) ∣ z then Real.sqrt (k : ℝ) else 0 := by
    have hg : Int.gcd z (D : ℤ) ∈ D.divisors :=
      Nat.mem_divisors.mpr
        ⟨Int.natCast_dvd_natCast.mp (Int.gcd_dvd_right z (D : ℤ)), hDpos.ne'⟩
    simpa only [ite_eq_left (Int.gcd_dvd_left z (D : ℤ))] using
      (Finset.single_le_sum
        (f := fun k : ℕ => if (k : ℤ) ∣ z then Real.sqrt (k : ℝ) else 0)
        (fun k _ => by positivity) hg)
  have hcolumn (n : ℤ) :
      (∑ m ∈ I, Real.sqrt (Int.gcd ((c₁ : ℤ) * m - (c₂ : ℤ) * n) (D : ℤ) : ℝ)) ≤
        (D.divisors.card : ℝ) * ((I.card : ℝ) + Real.sqrt (D : ℝ)) := by
    calc
      _ ≤ ∑ m ∈ I, ∑ k ∈ D.divisors,
          if (k : ℤ) ∣ (c₁ : ℤ) * m - (c₂ : ℤ) * n then
            Real.sqrt (k : ℝ) else 0 :=
        Finset.sum_le_sum (fun m _ => hmajor ((c₁ : ℤ) * m - (c₂ : ℤ) * n))
      _ = ∑ k ∈ D.divisors, ∑ m ∈ I,
          if (k : ℤ) ∣ (c₁ : ℤ) * m - (c₂ : ℤ) * n then
            Real.sqrt (k : ℝ) else 0 := Finset.sum_comm
      _ = ∑ k ∈ D.divisors,
          ((I.filter (fun m => (k : ℤ) ∣ (c₁ : ℤ) * m - (c₂ : ℤ) * n)).card : ℝ) *
            Real.sqrt (k : ℝ) := by
        apply Finset.sum_congr rfl
        intro k _
        rw [← Finset.sum_filter]
        simp only [Finset.sum_const, nsmul_eq_mul]
      _ ≤ ∑ _k ∈ D.divisors, ((I.card : ℝ) + Real.sqrt (D : ℝ)) := by
        apply Finset.sum_le_sum
        intro k hk
        have hkpos : 0 < k := Nat.pos_of_mem_divisors hk
        have hkd : k ∣ D := Nat.dvd_of_mem_divisors hk
        have hkR : (0 : ℝ) < k := by exact_mod_cast hkpos
        have hkone : (1 : ℝ) ≤ k := by exact_mod_cast hkpos
        have hcount := corrected_diagonal_divisor_fiber_card_le k c₁ c₂ hkpos
          (hcop.of_dvd_right hkd) M₀ M₁ n
        have hroot : Real.sqrt (k : ℝ) / (k : ℝ) ≤ 1 :=
          (div_le_one hkR).mpr (Real.sqrt_le_self_iff.mpr (Or.inr hkone))
        have hrootD : Real.sqrt (k : ℝ) ≤ Real.sqrt (D : ℝ) :=
          Real.sqrt_le_sqrt (by exact_mod_cast Nat.le_of_dvd hDpos hkd)
        calc
          _ ≤ ((I.card : ℝ) / (k : ℝ) + 1) * Real.sqrt (k : ℝ) :=
            mul_le_mul_of_nonneg_right hcount (Real.sqrt_nonneg _)
          _ = (I.card : ℝ) * (Real.sqrt (k : ℝ) / (k : ℝ)) + Real.sqrt (k : ℝ) := by
            ring
          _ ≤ (I.card : ℝ) * 1 + Real.sqrt (D : ℝ) :=
            add_le_add (mul_le_mul_of_nonneg_left hroot (by positivity)) hrootD
          _ = (I.card : ℝ) + Real.sqrt (D : ℝ) := by ring
      _ = (D.divisors.card : ℝ) * ((I.card : ℝ) + Real.sqrt (D : ℝ)) := by
        simp only [Finset.sum_const, nsmul_eq_mul]
  calc
    _ = ∑ n ∈ J, ∑ m ∈ I,
        Real.sqrt (Int.gcd ((c₁ : ℤ) * m - (c₂ : ℤ) * n) (D : ℤ) : ℝ) :=
      Finset.sum_comm
    _ ≤ ∑ _n ∈ J, (D.divisors.card : ℝ) * ((I.card : ℝ) + Real.sqrt (D : ℝ)) :=
      Finset.sum_le_sum (fun n _ => hcolumn n)
    _ = _ := by simp only [Finset.sum_const, nsmul_eq_mul]; ring

open Classical in
theorem normalizedKloosterman3Mod_squarefree_pointwise_bound_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (q : ℕ) [NeZero q] (hq : Squarefree q) (c : ZMod q) :
    ‖normalizedKloosterman3Mod q c‖ ≤ (3 : ℝ) ^ q.primeFactors.card := by
  have hmain : ∀ (n : ℕ) [NeZero n], Squarefree n → ∀ c : ZMod n,
      ‖normalizedKloosterman3Mod n c‖ ≤ (3 : ℝ) ^ n.primeFactors.card := by
    refine induction_on_primes ?_ ?_ ?_
    · intro hn
      exact (hn.out rfl).elim
    · intro _ _ c
      simp [normalizedKloosterman3Mod_one]
    · intro p n hp ih _ hpn c
      let _ : Fact p.Prime := ⟨hp⟩
      let _ : NeZero n := ⟨hpn.of_mul_right.ne_zero⟩
      have hcop : p.Coprime n := Nat.coprime_of_squarefree_mul hpn
      rw [normalizedKloosterman3Mod_mul p n hcop, norm_mul]
      calc
        _ ≤ 3 * (3 : ℝ) ^ n.primeFactors.card := by
          apply mul_le_mul
          · simpa only [normalizedKloosterman3Mod_eq_prime] using
              (normalizedKloosterman3_prime_local_bounds_of_deligne hDeligne p).1
                ((c.val : ZMod p) * ((n : ZMod p)⁻¹) ^ 3)
          · exact ih hpn.of_mul_right _
          · exact norm_nonneg _
          · norm_num
        _ = _ := by
          rw [hcop.primeFactors_mul,
            Finset.card_union_of_disjoint hcop.disjoint_primeFactors,
            hp.primeFactors, Finset.card_singleton, pow_add, pow_one]
  exact hmain q hq c

open Classical in
/--
The complete additive-character sum on the product fiber `n₁ * n₂ * n₃ = a`, with linear
frequencies `h₁, h₂, h₃` and normalization `1 / q`. The target `a` is a unit.
-/
noncomputable def typeIIICompleteFiberSum (q : ℕ) [NeZero q]
    (h₁ h₂ h₃ : ZMod q) (a : (ZMod q)ˣ) : ℂ :=
  (q : ℂ)⁻¹ *
    ∑ n₁ : ZMod q, ∑ n₂ : ZMod q, ∑ n₃ : ZMod q,
      if n₁ * n₂ * n₃ = (a : ZMod q) then
        ZMod.stdAddChar (h₁ * n₁ + h₂ * n₂ + h₃ * n₃) else 0

open Classical in
theorem typeIII_productFiber_fourier_completion
    (q : ℕ) [NeZero q] (w₁ w₂ w₃ : ZMod q → ℂ) (a : (ZMod q)ˣ) :
    (∑ n₁ : ZMod q, ∑ n₂ : ZMod q, ∑ n₃ : ZMod q,
      if n₁ * n₂ * n₃ = (a : ZMod q) then w₁ n₁ * w₂ n₂ * w₃ n₃ else 0) =
      (q : ℂ)⁻¹ ^ 2 *
        ∑ h₁ : ZMod q, ∑ h₂ : ZMod q, ∑ h₃ : ZMod q,
          ZMod.dft w₁ h₁ * ZMod.dft w₂ h₂ * ZMod.dft w₃ h₃ *
            typeIIICompleteFiberSum q h₁ h₂ h₃ a := by
  have hinv (w : ZMod q → ℂ) (n : ZMod q) :
      w n = (q : ℂ)⁻¹ * ∑ h : ZMod q, ZMod.stdAddChar (h * n) * ZMod.dft w h := by
    simpa only [LinearEquiv.symm_apply_apply, smul_eq_mul] using
      ZMod.invDFT_apply (ZMod.dft w) n
  have hexpand (n₁ n₂ n₃ : ZMod q) :
      w₁ n₁ * w₂ n₂ * w₃ n₃ =
        (q : ℂ)⁻¹ ^ 3 * ∑ h₁ : ZMod q, ∑ h₂ : ZMod q, ∑ h₃ : ZMod q,
          ZMod.dft w₁ h₁ * ZMod.dft w₂ h₂ * ZMod.dft w₃ h₃ *
            ZMod.stdAddChar (h₁ * n₁ + h₂ * n₂ + h₃ * n₃) := by
    rw [hinv w₁ n₁, hinv w₂ n₂, hinv w₃ n₃]
    simp_rw [Finset.mul_sum, Finset.sum_mul, AddChar.map_add_eq_mul]
    rw [Finset.sum_comm_cycle]
    apply Finset.sum_congr rfl
    intro h₁ _
    rw [Finset.sum_comm]
    apply Finset.sum_congr rfl
    intro h₂ _
    apply Finset.sum_congr rfl
    intro h₃ _
    ring
  let S (h₁ h₂ h₃ : ZMod q) : ℂ :=
    ∑ n₁ : ZMod q, ∑ n₂ : ZMod q, ∑ n₃ : ZMod q,
      if n₁ * n₂ * n₃ = (a : ZMod q) then
        ZMod.stdAddChar (h₁ * n₁ + h₂ * n₂ + h₃ * n₃) else 0
  have hterm (n₁ n₂ n₃ : ZMod q) :
      (if n₁ * n₂ * n₃ = (a : ZMod q) then w₁ n₁ * w₂ n₂ * w₃ n₃ else 0) =
        (q : ℂ)⁻¹ ^ 3 * ∑ h₁ : ZMod q, ∑ h₂ : ZMod q, ∑ h₃ : ZMod q,
          if n₁ * n₂ * n₃ = (a : ZMod q) then
            ZMod.dft w₁ h₁ * ZMod.dft w₂ h₂ * ZMod.dft w₃ h₃ *
              ZMod.stdAddChar (h₁ * n₁ + h₂ * n₂ + h₃ * n₃) else 0 := by
    simp only [Finset.sum_ite_irrel, Finset.sum_const_zero, mul_ite, mul_zero,
      hexpand]
  have hswap (f : ZMod q → ZMod q → ZMod q → ZMod q → ZMod q → ZMod q → ℂ) :
      (∑ n₁ : ZMod q, ∑ n₂ : ZMod q, ∑ n₃ : ZMod q,
        ∑ h₁ : ZMod q, ∑ h₂ : ZMod q, ∑ h₃ : ZMod q, f n₁ n₂ n₃ h₁ h₂ h₃) =
      ∑ h₁ : ZMod q, ∑ h₂ : ZMod q, ∑ h₃ : ZMod q,
        ∑ n₁ : ZMod q, ∑ n₂ : ZMod q, ∑ n₃ : ZMod q, f n₁ n₂ n₃ h₁ h₂ h₃ := by
    simpa only [Fintype.sum_prod_type] using
      (Finset.sum_comm (s := Finset.univ) (t := Finset.univ)
        (f := fun (n h : ZMod q × ZMod q × ZMod q) =>
          f n.1 n.2.1 n.2.2 h.1 h.2.1 h.2.2))
  calc
    _ = (q : ℂ)⁻¹ ^ 3 * ∑ n₁ : ZMod q, ∑ n₂ : ZMod q, ∑ n₃ : ZMod q,
        ∑ h₁ : ZMod q, ∑ h₂ : ZMod q, ∑ h₃ : ZMod q,
          if n₁ * n₂ * n₃ = (a : ZMod q) then
            ZMod.dft w₁ h₁ * ZMod.dft w₂ h₂ * ZMod.dft w₃ h₃ *
              ZMod.stdAddChar (h₁ * n₁ + h₂ * n₂ + h₃ * n₃) else 0 := by
      simp_rw [hterm, Finset.mul_sum]
    _ = (q : ℂ)⁻¹ ^ 3 * ∑ h₁ : ZMod q, ∑ h₂ : ZMod q, ∑ h₃ : ZMod q,
        ∑ n₁ : ZMod q, ∑ n₂ : ZMod q, ∑ n₃ : ZMod q,
          if n₁ * n₂ * n₃ = (a : ZMod q) then
            ZMod.dft w₁ h₁ * ZMod.dft w₂ h₂ * ZMod.dft w₃ h₃ *
              ZMod.stdAddChar (h₁ * n₁ + h₂ * n₂ + h₃ * n₃) else 0 := by
      rw [hswap]
    _ = (q : ℂ)⁻¹ ^ 3 * ∑ h₁ : ZMod q, ∑ h₂ : ZMod q, ∑ h₃ : ZMod q,
        ZMod.dft w₁ h₁ * ZMod.dft w₂ h₂ * ZMod.dft w₃ h₃ * S h₁ h₂ h₃ := by
      simp only [S, Finset.mul_sum, mul_ite, mul_zero]
    _ = _ := by
      change (q : ℂ)⁻¹ ^ 3 * (∑ h₁ : ZMod q, ∑ h₂ : ZMod q, ∑ h₃ : ZMod q,
        ZMod.dft w₁ h₁ * ZMod.dft w₂ h₂ * ZMod.dft w₃ h₃ * S h₁ h₂ h₃) =
          (q : ℂ)⁻¹ ^ 2 * ∑ h₁ : ZMod q, ∑ h₂ : ZMod q, ∑ h₃ : ZMod q,
            ZMod.dft w₁ h₁ * ZMod.dft w₂ h₂ * ZMod.dft w₃ h₃ *
              ((q : ℂ)⁻¹ * S h₁ h₂ h₃)
      simp_rw [mul_left_comm _ (q : ℂ)⁻¹, ← Finset.mul_sum]
      ring

theorem typeIIICompleteFiberSum_eq_normalizedKloosterman3Mod
    (q : ℕ) [NeZero q] (h₁ h₂ h₃ : ZMod q) (a : (ZMod q)ˣ)
    (hh₁ : IsUnit h₁) (hh₂ : IsUnit h₂) (hh₃ : IsUnit h₃) :
    typeIIICompleteFiberSum q h₁ h₂ h₃ a =
      normalizedKloosterman3Mod q ((a : ZMod q) * h₁ * h₂ * h₃) := by
  classical
  unfold typeIIICompleteFiberSum normalizedKloosterman3Mod
  congr 1
  refine Fintype.sum_bijective (h₁ * ·) (IsUnit.isUnit_iff_mulLeft_bijective.mp hh₁) _ _ ?_
  intro n₁
  refine Fintype.sum_bijective (h₂ * ·) (IsUnit.isUnit_iff_mulLeft_bijective.mp hh₂) _ _ ?_
  intro n₂
  refine Fintype.sum_bijective (h₃ * ·) (IsUnit.isUnit_iff_mulLeft_bijective.mp hh₃) _ _ ?_
  intro n₃
  have hmask : (h₁ * n₁) * (h₂ * n₂) * (h₃ * n₃) =
      (a : ZMod q) * h₁ * h₂ * h₃ ↔ n₁ * n₂ * n₃ = (a : ZMod q) := by
    rw [show (h₁ * n₁) * (h₂ * n₂) * (h₃ * n₃) =
      (h₁ * h₂ * h₃) * (n₁ * n₂ * n₃) by ring,
      show (a : ZMod q) * h₁ * h₂ * h₃ = (h₁ * h₂ * h₃) * (a : ZMod q) by ring]
    exact ((hh₁.mul hh₂).mul hh₃).mul_right_inj
  simp only [hmask]

theorem typeIIICompleteFiberSum_eq_of_zero_coordinate
    (q : ℕ) [NeZero q] (h₁ h₂ h₃ : ZMod q) (a b : (ZMod q)ˣ)
    (hzero : h₁ = 0 ∨ h₂ = 0 ∨ h₃ = 0) :
    typeIIICompleteFiberSum q h₁ h₂ h₃ a =
      typeIIICompleteFiberSum q h₁ h₂ h₃ b := by
  classical
  let u : (ZMod q)ˣ := b * a⁻¹
  have hu : (u : ZMod q) * (a : ZMod q) = (b : ZMod q) :=
    Units.inv_mul_cancel_right (b : ZMod q) a
  have hmask (z : ZMod q) :
      (u : ZMod q) * z = (b : ZMod q) ↔ z = (a : ZMod q) := by
    rw [← hu, u.mul_right_inj]
  unfold typeIIICompleteFiberSum
  congr 1
  rcases hzero with rfl | rfl | rfl
  · refine Fintype.sum_equiv u.mulLeft _ _ ?_
    intro n₁
    apply Finset.sum_congr rfl
    intro n₂ _
    apply Finset.sum_congr rfl
    intro n₃ _
    simp only [Units.mulLeft_apply, zero_mul, zero_add, mul_assoc, hmask]
  · apply Finset.sum_congr rfl
    intro n₁ _
    refine Fintype.sum_equiv u.mulLeft _ _ ?_
    intro n₂
    apply Finset.sum_congr rfl
    intro n₃ _
    simp only [Units.mulLeft_apply, zero_mul, add_zero]
    simp only [show n₁ * ((u : ZMod q) * n₂) * n₃ =
      (u : ZMod q) * (n₁ * n₂ * n₃) by ring, hmask]
  · apply Finset.sum_congr rfl
    intro n₁ _
    apply Finset.sum_congr rfl
    intro n₂ _
    refine Fintype.sum_equiv u.mulLeft _ _ ?_
    intro n₃
    simp only [Units.mulLeft_apply, zero_mul, add_zero]
    simp only [show n₁ * n₂ * ((u : ZMod q) * n₃) =
      (u : ZMod q) * (n₁ * n₂ * n₃) by ring, hmask]

theorem typeIII_squarefree_good_bad_moduli
    (q : ℕ) (hq : Squarefree q) (h₁ h₂ h₃ : ℤ) :
    let H := h₁ * h₂ * h₃
    let b := Int.gcd H (q : ℤ)
    let d := q / b
    0 < b ∧ 0 < d ∧ b * d = q ∧ Squarefree b ∧ Squarefree d ∧
      b.Coprime d ∧ (b : ℤ) ∣ H ∧ d.Coprime H.natAbs ∧
      b.primeFactors = q.primeFactors.filter (fun p : ℕ => (p : ℤ) ∣ H) ∧
      d.primeFactors = q.primeFactors.filter (fun p : ℕ => ¬ (p : ℤ) ∣ H) ∧
      Int.gcd h₁ (b : ℤ) = Int.gcd h₁ (q : ℤ) ∧
      Int.gcd h₂ (b : ℤ) = Int.gcd h₂ (q : ℤ) ∧
      Int.gcd h₃ (b : ℤ) = Int.gcd h₃ (q : ℤ) := by
  intro H b d
  have hqpos : 0 < q := Nat.pos_of_ne_zero hq.ne_zero
  have hbq : b ∣ q := Nat.gcd_dvd_right _ _
  have hbd : b * d = q := Nat.mul_div_cancel' hbq
  have hcop : b.Coprime d := Nat.coprime_of_squarefree_mul (hbd.symm ▸ hq)
  have hgood : d.Coprime H.natAbs := by
    by_cases hH : H = 0
    · simp [d, b, hH, Nat.div_self hqpos]
    · simpa [d, b, Int.gcd_def, Nat.gcd_comm] using
        Nat.coprime_div_gcd_of_squarefree hq (Int.natAbs_ne_zero.mpr hH)
  have hbpf : b.primeFactors = q.primeFactors.filter (fun p : ℕ => (p : ℤ) ∣ H) := by
    rw [← Nat.primeFactors_filter_dvd_of_dvd hq.ne_zero hbq]
    apply Finset.filter_congr
    intro p hp
    change (p ∣ Int.gcd H (q : ℤ)) ↔ (p : ℤ) ∣ H
    rw [Int.dvd_gcd_iff]
    simp only [Int.natCast_dvd_natCast, Nat.dvd_of_mem_primeFactors hp, and_true]
  have hdpf : d.primeFactors = q.primeFactors.filter (fun p : ℕ => ¬ (p : ℤ) ∣ H) := by
    rw [Finset.filter_not, ← hbpf, ← hbd, hcop.primeFactors_mul,
      Finset.union_sdiff_cancel_left hcop.disjoint_primeFactors]
  have hgcd (h : ℤ) (hh : h ∣ H) : Int.gcd h (b : ℤ) = Int.gcd h (q : ℤ) := by
    change Int.gcd h (Int.gcd H (q : ℤ) : ℤ) = Int.gcd h (q : ℤ)
    rw [← Int.gcd_assoc, Int.gcd_eq_natAbs_left hh]
    simp only [Int.gcd_def, Int.natAbs_natCast]
  refine ⟨Nat.gcd_pos_of_pos_right _ hqpos, Nat.div_gcd_pos_of_pos_right _ hqpos,
    hbd, hq.squarefree_of_dvd hbq, hq.squarefree_of_dvd (Nat.div_dvd_of_dvd hbq),
    hcop, Int.gcd_dvd_left H (q : ℤ), hgood, hbpf, hdpf,
    hgcd h₁ ?_, hgcd h₂ ?_, hgcd h₃ ?_⟩
  · exact dvd_mul_of_dvd_left (dvd_mul_right h₁ h₂) h₃
  · exact dvd_mul_of_dvd_left (dvd_mul_left h₂ h₁) h₃
  · exact dvd_mul_left h₃ (h₁ * h₂)

/--
The indicator arithmetic function of nonzero integers whose prime factors are all at least the
real threshold `z`. It equals `1` at `n = 1` by the empty prime-factor condition and `0` at `n =
0`.
-/
noncomputable def roughWeight (z : ℝ) : ArithmeticFunction ℝ := by
  classical
  exact ⟨fun n =>
    if n ≠ 0 ∧ ∀ p ∈ n.primeFactors, z ≤ (p : ℝ) then 1 else 0, by simp⟩

theorem norm_masked_discrepancy_le
    (j X q a r₀ : ℕ) (hj : 2 ≤ j) (hX : 0 < X) (hq : 0 < q)
    (ha : Nat.Coprime a q) (V : ℝ) (hV : 0 ≤ V) (f : ℕ → ℂ)
    (hf : ∀ n ∈ Finset.Icc 1 X,
      ‖f n‖ ≤ (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ j) n : ℝ) * V) :
    ‖(∑ n ∈ Finset.Icc 1 X with Nat.ModEq q n a ∧ Nat.Coprime n r₀, f n) -
      (q.totient : ℂ)⁻¹ *
        (∑ n ∈ Finset.Icc 1 X with Nat.Coprime n q ∧ Nat.Coprime n r₀, f n)‖ ≤
      ((Nat.divisors q).card : ℝ) * V *
        (((j : ℝ) + 1) * ((X : ℝ) / (q : ℝ)) *
            (1 + Real.log (X : ℝ)) ^ (j - 1) +
          (j : ℝ) * (X : ℝ) ^ (1 - 1 / (j : ℝ)) *
            (1 + Real.log (X : ℝ)) ^ (j - 2)) := by
  classical
  let z (n : ℕ) : ℝ := (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ j) n : ℝ)
  let L := 1 + Real.log (X : ℝ)
  let M := (X : ℝ) / (q : ℝ) * L ^ (j - 1)
  let E := (X : ℝ) ^ (1 - 1 / (j : ℝ)) * L ^ (j - 2)
  let D : ℝ := ((Nat.divisors q).card : ℝ)
  have hL : 0 ≤ L := by
    dsimp [L]
    have hlog : 0 ≤ Real.log (X : ℝ) := Real.log_nonneg (by exact_mod_cast hX)
    linarith
  have hM : 0 ≤ M := by dsimp [M]; positivity
  have hE : 0 ≤ E := by dsimp [E]; positivity
  have hD : 1 ≤ D := by
    dsimp [D]
    exact_mod_cast Finset.one_le_card.mpr ⟨1, Nat.one_mem_divisors.mpr hq.ne'⟩
  have hφ : 0 < (q.totient : ℝ) := Nat.cast_pos.mpr (Nat.totient_pos.mpr hq)
  have hnorm (S : Finset ℕ) (hS : S ⊆ Finset.Icc 1 X) :
      ‖∑ n ∈ S, f n‖ ≤ V * ∑ n ∈ S, z n := by
    calc
      _ ≤ ∑ n ∈ S, ‖f n‖ := norm_sum_le S f
      _ ≤ ∑ n ∈ S, z n * V := Finset.sum_le_sum fun n hn => hf n (hS hn)
      _ = _ := by rw [← Finset.sum_mul, mul_comm]
  have hmean : (∑ n ∈ Finset.Icc 1 X, z n) ≤ (X : ℝ) * L ^ (j - 1) := by
    have hg := sum_zeta_pow_succ_le_mul_harmonic_pow (j - 1) X
    rw [Nat.sub_add_cancel (by omega : 1 ≤ j)] at hg
    refine hg.trans (mul_le_mul_of_nonneg_left ?_ (Nat.cast_nonneg X))
    exact pow_le_pow_left₀ (by unfold harmonic; positivity) (harmonic_le_one_add_log X) _
  have hres :
      ‖∑ n ∈ Finset.Icc 1 X with Nat.ModEq q n a ∧ Nat.Coprime n r₀, f n‖ ≤
        V * ((j : ℝ) * (M + E)) := by
    refine (hnorm _ (Finset.filter_subset _ _)).trans
      (mul_le_mul_of_nonneg_left ?_ hV)
    calc
      _ ≤ ∑ n ∈ Finset.Icc 1 X with Nat.ModEq q n a, z n := by
        apply Finset.sum_le_sum_of_subset_of_nonneg
        · intro n hn
          exact Finset.mem_filter.mpr ⟨(Finset.mem_filter.mp hn).1,
            (Finset.mem_filter.mp hn).2.1⟩
        · intro n _ _
          exact Nat.cast_nonneg _
      _ ≤ _ := sum_zeta_pow_modEq_le j X q a hj hX hq ha
  have hinv : (q.totient : ℝ)⁻¹ * (X : ℝ) ≤ D * ((X : ℝ) / (q : ℝ)) := by
    calc
      _ = ((q : ℝ) / (q.totient : ℝ)) * ((X : ℝ) / (q : ℝ)) := by
        have hqne : (q : ℝ) ≠ 0 := by exact_mod_cast hq.ne'
        field_simp
      _ ≤ _ := mul_le_mul_of_nonneg_right (div_totient_le_card_divisors q) (by positivity)
  have hcenter :
      ‖(q.totient : ℂ)⁻¹ *
        (∑ n ∈ Finset.Icc 1 X with Nat.Coprime n q ∧ Nat.Coprime n r₀, f n)‖ ≤
        D * V * M := by
    rw [norm_mul, norm_inv, Complex.norm_natCast]
    calc
      _ ≤ (q.totient : ℝ)⁻¹ * (V * ((X : ℝ) * L ^ (j - 1))) := by
        apply mul_le_mul_of_nonneg_left _ (le_of_lt (inv_pos.mpr hφ))
        refine (hnorm _ (Finset.filter_subset _ _)).trans
          (mul_le_mul_of_nonneg_left ?_ hV)
        exact (Finset.sum_le_sum_of_subset_of_nonneg (Finset.filter_subset _ _)
          (fun n _ _ => Nat.cast_nonneg _)).trans hmean
      _ = ((q.totient : ℝ)⁻¹ * (X : ℝ)) * (V * L ^ (j - 1)) := by ring
      _ ≤ (D * ((X : ℝ) / (q : ℝ))) * (V * L ^ (j - 1)) :=
        mul_le_mul_of_nonneg_right hinv (by positivity)
      _ = D * V * M := by dsimp [M]; ring
  calc
    _ ≤ ‖∑ n ∈ Finset.Icc 1 X with Nat.ModEq q n a ∧ Nat.Coprime n r₀, f n‖ +
        ‖(q.totient : ℂ)⁻¹ *
          (∑ n ∈ Finset.Icc 1 X with Nat.Coprime n q ∧ Nat.Coprime n r₀, f n)‖ :=
      norm_sub_le _ _
    _ ≤ V * ((j : ℝ) * (M + E)) + D * V * M := add_le_add hres hcenter
    _ ≤ D * (V * ((j : ℝ) * (M + E))) + D * V * M := by
      exact add_le_add (le_mul_of_one_le_left (by positivity) hD) le_rfl
    _ = _ := by dsimp [D, M, E, L]; ring

theorem eventually_large_modulus_masked_discrepancy_le
    (j : ℕ) (hj : 2 ≤ j) (R ε T C : ℝ)
    (hε : 0 < ε) (hT : 0 < T) :
    ∀ A : ℝ, 0 < A →
      ∃ B : ℝ, 0 < B ∧
        ∀ᶠ x : ℝ in Filter.atTop,
          ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
            ∀ q : ℕ, 0 < q → (Real.log x) ^ B < (q : ℝ) →
              ∀ a : ℕ, Nat.Coprime a q →
                ∀ r0 : ℕ, 0 < r0 →
                  ∀ f : ℕ → ℂ,
                    (∀ n ∈ Finset.Icc 1 ⌊T * N⌋₊,
                      ‖f n‖ ≤
                        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ j) n : ℝ) *
                          (Real.log x) ^ R) →
                    ‖(∑ n ∈ Finset.Icc 1 ⌊T * N⌋₊ with
                          Nat.ModEq q n a ∧ Nat.Coprime n r0, f n) -
                      (q.totient : ℂ)⁻¹ *
                        (∑ n ∈ Finset.Icc 1 ⌊T * N⌋₊ with
                          Nat.Coprime n q ∧ Nat.Coprime n r0, f n)‖ ≤
                      ((Nat.divisors q).card : ℝ) * N * (Real.log x) ^ (-A) := by
  have hscale :
      ∀ A : ℝ, 0 < A →
        ∃ B : ℝ, 0 < B ∧
          ∀ᶠ x : ℝ in Filter.atTop,
            ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
              ∀ q : ℕ, 0 < q → (Real.log x) ^ B < (q : ℝ) →
                (Real.log x) ^ R *
                    (((j : ℝ) + 1) * ((⌊T * N⌋₊ : ℕ) : ℝ) / (q : ℝ) *
                        (1 + Real.log ((⌊T * N⌋₊ : ℕ) : ℝ)) ^ (j - 1) +
                      (j : ℝ) * ((⌊T * N⌋₊ : ℕ) : ℝ) ^ (1 - 1 / (j : ℝ)) *
                        (1 + Real.log ((⌊T * N⌋₊ : ℕ) : ℝ)) ^ (j - 2)) ≤
                  N * (Real.log x) ^ (-A) := by
    let η : ℝ := 1 - 1 / (j : ℝ)
    let δ : ℝ := ε / (j : ℝ)
    let D : ℝ := 2 + |Real.log T| + |C|
    let s₁ : ℝ := R + ((j - 1 : ℕ) : ℝ)
    let s₂ : ℝ := R + ((j - 2 : ℕ) : ℝ)
    let K₁ : ℝ := ((j : ℝ) + 1) * T * D ^ (j - 1)
    let K₂ : ℝ := (j : ℝ) * T ^ η * D ^ (j - 2)
    have hjr : (2 : ℝ) ≤ (j : ℝ) := by exact_mod_cast hj
    have hJ : (0 : ℝ) < j := by linarith only [hjr]
    have hη : 0 ≤ η := by
      have h : 1 / (j : ℝ) ≤ 1 := (div_le_one hJ).mpr (by linarith only [hjr])
      exact sub_nonneg.mpr h
    have hδ : 0 < δ := div_pos hε hJ
    have hD : 0 < D := by dsimp [D]; positivity
    have hK₁ : 0 < K₁ := by dsimp [K₁]; positivity
    have hK₂ : 0 < K₂ := by dsimp [K₂]; positivity
    intro A _
    let B : ℝ := max 1 (A + R + (j : ℝ))
    refine ⟨B, lt_of_lt_of_le zero_lt_one (le_max_left _ _), ?_⟩
    have hsmall := (isLittleO_log_rpow_rpow_atTop (A + s₂) hδ).bound
      (by positivity : 0 < 1 / (2 * K₂))
    filter_upwards [Real.tendsto_log_atTop.eventually_ge_atTop 1,
      Real.tendsto_log_atTop.eventually_ge_atTop (2 * K₁),
      (tendsto_rpow_atTop hε).eventually_ge_atTop (1 / T),
      Filter.eventually_gt_atTop (1 : ℝ), hsmall] with x hL1 hLK hxT hx1 hxsmall
    intro N hlow hhigh q hq hqB
    let L : ℝ := Real.log x
    let X : ℕ := ⌊T * N⌋₊
    let H : ℝ := 1 + Real.log (X : ℝ)
    have hx : 0 < x := zero_lt_one.trans hx1
    have hL : 0 < L := Real.log_pos hx1
    have hN : 0 < N := (Real.rpow_pos_of_pos hx ε).trans_le hlow
    have hTN : 0 < T * N := mul_pos hT hN
    have hTN1 : 1 ≤ T * N := by
      simpa only [mul_comm] using (div_le_iff₀ hT).mp (hxT.trans hlow)
    have hX : 0 < X := Nat.floor_pos.mpr hTN1
    have hXr : (0 : ℝ) < X := Nat.cast_pos.mpr hX
    have hXle : (X : ℝ) ≤ T * N := Nat.floor_le hTN.le
    have hqR : (0 : ℝ) < q := Nat.cast_pos.mpr hq
    have hH : 0 ≤ H := by dsimp [H]; positivity
    have hlogN : Real.log N ≤ C * L := (Real.le_rpow_iff_log_le hN hx).mp hhigh
    have hlogX : H ≤ D * L := by
      have hXlog : Real.log (X : ℝ) ≤ Real.log T + Real.log N := by
        calc
          _ ≤ Real.log (T * N) := Real.log_le_log hXr hXle
          _ = _ := Real.log_mul hT.ne' hN.ne'
      have hTlog : Real.log T ≤ |Real.log T| * L :=
        (le_abs_self _).trans (le_mul_of_one_le_right (abs_nonneg _) hL1)
      have hClog : C * L ≤ |C| * L :=
        mul_le_mul_of_nonneg_right (le_abs_self C) hL.le
      dsimp [H, D]
      nlinarith only [hXlog, hlogN, hTlog, hClog, hL1]
    have hlogpow (k : ℕ) : H ^ k ≤ D ^ k * L ^ (k : ℝ) := by
      calc
        _ ≤ (D * L) ^ k := pow_le_pow_left₀ hH hlogX k
        _ = D ^ k * L ^ k := mul_pow _ _ _
        _ = _ := by rw [Real.rpow_natCast]
    have hNpower : N ^ η ≤ N * x ^ (-δ) := by
      calc
        _ = N * N ^ (-(1 / (j : ℝ))) := by
          rw [show η = 1 + -(1 / (j : ℝ)) by dsimp [η]; ring,
            Real.rpow_add hN, Real.rpow_one]
        _ ≤ N * (x ^ ε) ^ (-(1 / (j : ℝ))) :=
          mul_le_mul_of_nonneg_left
            (Real.rpow_le_rpow_of_nonpos (Real.rpow_pos_of_pos hx ε) hlow
              (neg_nonpos.mpr (one_div_nonneg.mpr hJ.le))) hN.le
        _ = N * x ^ (-δ) := by
          rw [← Real.rpow_mul hx.le]
          congr 2
          dsimp [δ]
          ring
    have hXpower : (X : ℝ) ^ η ≤ T ^ η * N * x ^ (-δ) := by
      calc
        _ ≤ (T * N) ^ η := Real.rpow_le_rpow hXr.le hXle hη
        _ = T ^ η * N ^ η := Real.mul_rpow hT.le hN.le
        _ ≤ T ^ η * (N * x ^ (-δ)) :=
          mul_le_mul_of_nonneg_left hNpower (Real.rpow_nonneg hT.le _)
        _ = _ := by ring
    have hfirst :
        ((j : ℝ) + 1) * (X : ℝ) / (q : ℝ) * H ^ (j - 1) ≤
          K₁ * N / (q : ℝ) * L ^ ((j - 1 : ℕ) : ℝ) := by
      calc
        _ ≤ (((j : ℝ) + 1) * (T * N) / (q : ℝ)) *
            (D ^ (j - 1) * L ^ ((j - 1 : ℕ) : ℝ)) :=
          mul_le_mul
            (div_le_div_of_nonneg_right
              (mul_le_mul_of_nonneg_left hXle (by positivity)) hqR.le)
            (hlogpow _) (by positivity) (by positivity)
        _ = _ := by dsimp [K₁]; ring
    have hsecond :
        (j : ℝ) * (X : ℝ) ^ η * H ^ (j - 2) ≤
          K₂ * N * x ^ (-δ) * L ^ ((j - 2 : ℕ) : ℝ) := by
      calc
        _ ≤ ((j : ℝ) * (T ^ η * N * x ^ (-δ))) *
            (D ^ (j - 2) * L ^ ((j - 2 : ℕ) : ℝ)) :=
          mul_le_mul (mul_le_mul_of_nonneg_left hXpower hJ.le) (hlogpow _)
            (by positivity) (by positivity)
        _ = _ := by dsimp [K₂]; ring
    have hBexp : s₁ - B ≤ -A - 1 := by
      have hd : ((j - 1 : ℕ) : ℝ) = (j : ℝ) - 1 := by
        rw [Nat.cast_sub (by omega : 1 ≤ j), Nat.cast_one]
      have h := le_max_right (1 : ℝ) (A + R + (j : ℝ))
      dsimp [s₁, B]
      rw [hd]
      linarith only [h]
    have hfrac : K₁ / L ≤ (1 / 2 : ℝ) :=
      (div_le_iff₀ hL).mpr (by linarith only [hLK])
    have hhalf₁ : K₁ * L ^ s₁ / (q : ℝ) ≤ (1 / 2 : ℝ) * L ^ (-A) := by
      calc
        _ ≤ K₁ * L ^ s₁ / L ^ B :=
          div_le_div_of_nonneg_left (by positivity) (Real.rpow_pos_of_pos hL _) hqB.le
        _ = K₁ * L ^ (s₁ - B) := by rw [Real.rpow_sub hL]; ring
        _ ≤ K₁ * L ^ (-A - 1) :=
          mul_le_mul_of_nonneg_left
            (Real.rpow_le_rpow_of_exponent_le hL1 hBexp) hK₁.le
        _ = (K₁ / L) * L ^ (-A) := by rw [Real.rpow_sub hL, Real.rpow_one]; ring
        _ ≤ _ := mul_le_mul_of_nonneg_right hfrac (Real.rpow_nonneg hL.le _)
    have hsmallx : L ^ (A + s₂) ≤ (1 / (2 * K₂)) * x ^ δ := by
      have h := hxsmall
      rw [Real.norm_of_nonneg (Real.rpow_nonneg hx.le δ)] at h
      exact (le_abs_self _).trans h
    have hhalf₂ : K₂ * x ^ (-δ) * L ^ s₂ ≤ (1 / 2 : ℝ) * L ^ (-A) := by
      have hpow : x ^ (-δ) * x ^ δ = 1 := by
        rw [← Real.rpow_add hx, neg_add_cancel, Real.rpow_zero]
      calc
        _ = K₂ * x ^ (-δ) * L ^ (A + s₂) * L ^ (-A) := by
          have h := Real.rpow_add hL (A + s₂) (-A)
          rw [show A + s₂ + -A = s₂ by ring] at h
          rw [h]
          ring
        _ ≤ (K₂ * x ^ (-δ) * ((1 / (2 * K₂)) * x ^ δ)) * L ^ (-A) :=
          mul_le_mul_of_nonneg_right
            (mul_le_mul_of_nonneg_left hsmallx (by positivity))
            (Real.rpow_nonneg hL.le _)
        _ = (1 / 2 : ℝ) * L ^ (-A) := by
          rw [show K₂ * x ^ (-δ) * ((1 / (2 * K₂)) * x ^ δ) =
              (1 / 2 : ℝ) * (x ^ (-δ) * x ^ δ) by field_simp,
            hpow, mul_one]
    change L ^ R *
      (((j : ℝ) + 1) * (X : ℝ) / (q : ℝ) * H ^ (j - 1) +
        (j : ℝ) * (X : ℝ) ^ η * H ^ (j - 2)) ≤ N * L ^ (-A)
    calc
      _ ≤ L ^ R *
          (K₁ * N / (q : ℝ) * L ^ ((j - 1 : ℕ) : ℝ) +
            K₂ * N * x ^ (-δ) * L ^ ((j - 2 : ℕ) : ℝ)) :=
        mul_le_mul_of_nonneg_left (add_le_add hfirst hsecond) (Real.rpow_nonneg hL.le _)
      _ = N * (K₁ * L ^ s₁ / (q : ℝ) + K₂ * x ^ (-δ) * L ^ s₂) := by
        dsimp [s₁, s₂]
        rw [Real.rpow_add hL, Real.rpow_add hL]
        ring
      _ ≤ N * ((1 / 2 : ℝ) * L ^ (-A) + (1 / 2 : ℝ) * L ^ (-A)) :=
        mul_le_mul_of_nonneg_left (add_le_add hhalf₁ hhalf₂) hN.le
      _ = N * L ^ (-A) := by ring
  intro A hA
  obtain ⟨B, hB, hscale⟩ := hscale A hA
  refine ⟨B, hB, ?_⟩
  filter_upwards [hscale, (tendsto_rpow_atTop hε).eventually_ge_atTop (1 / T),
    Filter.eventually_gt_atTop (1 : ℝ)] with x hxscale hxT hx1
  intro N hlow hhigh q hq hqB a ha r0 _ f hf
  have hTN1 : 1 ≤ T * N := by
    simpa only [mul_comm] using (div_le_iff₀ hT).mp (hxT.trans hlow)
  have hX : 0 < ⌊T * N⌋₊ := Nat.floor_pos.mpr hTN1
  have hnorm := norm_masked_discrepancy_le j ⌊T * N⌋₊ q a r0 hj hX hq ha
    ((Real.log x) ^ R) (Real.rpow_nonneg (Real.log_pos hx1).le R) f hf
  refine hnorm.trans ?_
  simpa only [mul_assoc, mul_div_assoc] using
    mul_le_mul_of_nonneg_left (hxscale N hlow hhigh q hq hqB)
      (Nat.cast_nonneg (Nat.divisors q).card)

theorem eventually_large_modulus_finsupp_discrepancy_le
    (C₀ D ε c T C : ℝ) (hε : 0 < ε) (hc : 0 < c) (hT : 0 < T) :
    ∀ A : ℝ, 0 < A →
      ∃ B : ℝ, 0 < B ∧
        ∀ᶠ x : ℝ in Filter.atTop,
          ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
            ∀ q : ℕ, 0 < q → (Real.log x) ^ B < (q : ℝ) →
              ∀ a : ℕ, Nat.Coprime a q →
                ∀ r₀ : ℕ, 0 < r₀ →
                  ∀ f : ℕ →₀ ℂ,
                    (∀ n ∈ f.support,
                      c * N ≤ (n : ℝ) ∧ (n : ℝ) ≤ T * N) →
                    (∀ n ∈ f.support,
                      ‖f n‖ ≤ D * ((Nat.divisors n).card : ℝ) ^ C₀ *
                        (Real.log x) ^ C₀) →
                    ‖(∑ n ∈ f.support with
                          Nat.ModEq q n a ∧ Nat.Coprime n r₀, f n) -
                      (q.totient : ℂ)⁻¹ *
                        (∑ n ∈ f.support with
                          Nat.Coprime n q ∧ Nat.Coprime n r₀, f n)‖ ≤
                      ((Nat.divisors q).card : ℝ) * N * (Real.log x) ^ (-A) := by
  obtain ⟨j, hj, hmajor⟩ := eventually_real_divisor_majorant C₀ D
  intro A hA
  obtain ⟨B, hB, hlarge⟩ :=
    eventually_large_modulus_masked_discrepancy_le j hj (C₀ + 1) ε T C hε hT A hA
  refine ⟨B, hB, ?_⟩
  filter_upwards [hmajor, hlarge, Filter.eventually_gt_atTop (1 : ℝ)]
    with x hmajorx hlargex hx1
  intro N hlow hhigh q hq hqB a ha r₀ hr₀ f hs hf
  have hN1 : 1 ≤ N := (Real.one_le_rpow hx1.le hε.le).trans hlow
  have hN : 0 < N := lt_of_lt_of_le zero_lt_one hN1
  have hsupport : f.support ⊆ Finset.Icc 1 ⌊T * N⌋₊ := by
    intro n hn
    exact Finset.mem_Icc.mpr
      ⟨Nat.cast_pos.mp ((mul_pos hc hN).trans_le (hs n hn).1),
        Nat.le_floor (hs n hn).2⟩
  have hbox (n : ℕ) (hn : n ∈ Finset.Icc 1 ⌊T * N⌋₊) :
      ‖f n‖ ≤ (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ j) n : ℝ) *
        (Real.log x) ^ (C₀ + 1) := by
    by_cases hmem : n ∈ f.support
    · exact (hf n hmem).trans (hmajorx n (Finset.mem_Icc.mp hn).1)
    · rw [Finsupp.notMem_support_iff.mp hmem, norm_zero]
      exact mul_nonneg (Nat.cast_nonneg _)
        (Real.rpow_nonneg (Real.log_pos hx1).le _)
  have hsum (P : ℕ → Prop) [DecidablePred P] :
      (∑ n ∈ f.support with P n, f n) =
        ∑ n ∈ Finset.Icc 1 ⌊T * N⌋₊ with P n, f n := by
    simpa only [Finsupp.sum, Finset.sum_filter] using
      f.sum_of_support_subset hsupport (fun n (z : ℂ) => if P n then z else 0)
        (by simp)
  rw [hsum (fun n => Nat.ModEq q n a ∧ Nat.Coprime n r₀),
    hsum (fun n => Nat.Coprime n q ∧ Nat.Coprime n r₀)]
  exact hlargex N hlow hhigh q hq hqB a ha r₀ hr₀ f hbox

theorem sorted_band_owner_le_of_pointwise_le
    (n : ℕ) (x y : Fin n → ℝ≥0) (φ : ℝ≥0 → ℝ≥0)
    (hφ : Monotone φ) (hxy : ∀ i, y i ≤ x i) :
    let xs := x ∘ Tuple.sort x
    let ys := y ∘ Tuple.sort y
    ((Finset.univ : Finset (Fin n)).filter (fun i => 0 < ys i)).sup
        (fun i => (Finset.Ici i).sum ys + φ (ys i)) ≤
      ((Finset.univ : Finset (Fin n)).filter (fun i => 0 < xs i)).sup
        (fun i => (Finset.Ici i).sum xs + φ (xs i)) := by
  classical
  dsimp only
  have hsorted (i : Fin n) : (y ∘ Tuple.sort y) i ≤ (x ∘ Tuple.sort x) i := by
    have hcard :
        ((Finset.univ : Finset (Fin n)).filter
          (fun j => (x ∘ Tuple.sort x) j ≤ (x ∘ Tuple.sort x) i)).card ≤
        ((Finset.univ : Finset (Fin n)).filter
          (fun j => (y ∘ Tuple.sort y) j ≤ (x ∘ Tuple.sort x) i)).card := by
      let e : Equiv.Perm (Fin n) := (Tuple.sort x).trans (Tuple.sort y).symm
      refine Finset.card_le_card_of_injOn e ?_ e.injective.injOn
      intro j hj
      refine Finset.mem_filter.mpr ⟨Finset.mem_univ _, ?_⟩
      simpa [e] using (hxy (Tuple.sort x j)).trans (Finset.mem_filter.mp hj).2
    apply (Tuple.lt_card_le_iff_apply_le_of_monotone
      (j := i) (a := (x ∘ Tuple.sort x) i) (Tuple.monotone_sort y)).mp
    exact lt_of_lt_of_le
      ((Tuple.lt_card_le_iff_apply_le_of_monotone
        (j := i) (Tuple.monotone_sort x)).mpr le_rfl) hcard
  refine Finset.sup_le fun i hi => Finset.le_sup_of_le
    (Finset.mem_filter.mpr ⟨Finset.mem_univ i,
      (Finset.mem_filter.mp hi).2.trans_le (hsorted i)⟩) ?_
  exact add_le_add (Finset.sum_le_sum fun j _ => hsorted j) (hφ (hsorted i))

theorem compressed_band_owner_le_of_coordinatewise_dvd
    (k b : ℕ) (R ξ : ℝ) (hR : 1 < R)
    (t : Fin (b + 1) → ℝ)
    (r d : Fin k → ℕ) (hr : ∀ i, 0 < r i)
    (hd : ∀ i, d i ∣ r i)
    (φ : ℝ≥0 → ℝ≥0) (hφ : Monotone φ) :
    let C : (Fin k → ℕ) → Fin (k * b) → ℕ := fun v a =>
      let ib := (finProdFinEquiv : Fin k × Fin b ≃ Fin (k * b)).symm a
      ∏ p ∈ (v ib.1).primeFactors.filter
        (fun p : ℕ => R ^ ξ < (p : ℝ) ∧
          t (ib.2.castSucc) < Real.logb R (p : ℝ) ∧
          Real.logb R (p : ℝ) ≤ t (ib.2.succ)), p
    let u : (Fin k → ℕ) → Fin (k * b) → ℝ≥0 := fun v a =>
      (Real.logb R (C v a : ℝ)).toNNReal
    let z : (Fin k → ℕ) → Fin (k * b) → ℝ≥0 := fun v =>
      u v ∘ Tuple.sort (u v)
    let A : (Fin k → ℕ) → Finset (Fin (k * b)) := fun v =>
      Finset.univ.filter (fun a => 0 < z v a)
    let w : (v : Fin k → ℕ) → Fin (A v).card → ℝ≥0 := fun v j =>
      z v ((A v).orderEmbOfFin rfl j)
    (∀ a, (u d a : ℝ) = Real.logb R (C d a : ℝ) ∧
      (u r a : ℝ) = Real.logb R (C r a : ℝ)) ∧
      (Finset.univ : Finset (Fin (A d).card)).sup
        (fun j => (Finset.Ici j).sum (w d) + φ (w d j)) ≤
      (Finset.univ : Finset (Fin (A r).card)).sup
        (fun j => (Finset.Ici j).sum (w r) + φ (w r j)) := by
  intro C u z A w
  have hCpos (v : Fin k → ℕ) (a : Fin (k * b)) : 0 < C v a := by
    refine Finset.prod_pos fun p hp => ?_
    exact Nat.pos_of_mem_primeFactors (Finset.mem_filter.mp hp).1
  have hnorm (v : Fin k → ℕ) (a : Fin (k * b)) :
      (u v a : ℝ) = Real.logb R (C v a : ℝ) :=
    Real.coe_toNNReal _ (Real.logb_nonneg hR (Nat.one_le_cast.mpr (hCpos v a)))
  have hCdvd (a : Fin (k * b)) : C d a ∣ C r a := by
    apply Finset.prod_dvd_prod_of_subset
    exact Finset.filter_subset_filter _ (Nat.primeFactors_mono (hd _) (hr _).ne')
  have hu (a : Fin (k * b)) : u d a ≤ u r a := by
    apply Real.toNNReal_mono
    apply Real.logb_le_logb_of_le hR
    · exact_mod_cast hCpos d a
    · exact_mod_cast Nat.le_of_dvd (hCpos r a) (hCdvd a)
  refine ⟨fun a => ⟨hnorm d a, hnorm r a⟩, ?_⟩
  have hcompress (v : Fin k → ℕ) :
      (A v).sup (fun i => (Finset.Ici i).sum (z v) + φ (z v i)) =
        (Finset.univ : Finset (Fin (A v).card)).sup
          (fun j => (Finset.Ici j).sum (w v) + φ (w v j)) := by
    let e : Fin (A v).card ↪o Fin (k * b) := (A v).orderEmbOfFin rfl
    have htail (j : Fin (A v).card) :
        (Finset.Ici j).sum (w v) = (Finset.Ici (e j)).sum (z v) := by
      refine Finset.sum_bij (fun l _ => e l) ?_ ?_ ?_ ?_
      · intro l hl
        exact Finset.mem_Ici.mpr (e.monotone (Finset.mem_Ici.mp hl))
      · intro l _ m _ hlm
        exact e.injective hlm
      · intro i hi
        have hej : 0 < z v (e j) :=
          (Finset.mem_filter.mp ((A v).orderEmbOfFin_mem rfl j)).2
        have hiA : i ∈ A v := Finset.mem_filter.mpr ⟨Finset.mem_univ _,
          hej.trans_le (Tuple.monotone_sort (u v) (Finset.mem_Ici.mp hi))⟩
        obtain ⟨l, hl⟩ := ((A v).orderIsoOfFin rfl).surjective ⟨i, hiA⟩
        have hel : e l = i := congrArg Subtype.val hl
        refine ⟨l, Finset.mem_Ici.mpr ?_, hel⟩
        apply e.le_iff_le.mp
        simpa only [hel] using Finset.mem_Ici.mp hi
      · intro l _
        rfl
    calc
      (A v).sup (fun i => (Finset.Ici i).sum (z v) + φ (z v i)) =
          (Finset.univ : Finset (Fin (A v).card)).sup
            (fun j => (Finset.Ici (e j)).sum (z v) + φ (z v (e j))) := by
        simpa only [e, Finset.map_orderEmbOfFin_univ, Function.comp_def,
          RelEmbedding.coe_toEmbedding] using
          (Finset.sup_map (Finset.univ : Finset (Fin (A v).card)) e.toEmbedding
            (fun i => (Finset.Ici i).sum (z v) + φ (z v i)))
      _ = _ := by
        refine Finset.sup_congr rfl fun j _ => ?_
        rw [← htail j]
  rw [← hcompress d, ← hcompress r]
  exact sorted_band_owner_le_of_pointwise_le (k * b) (u r) (u d) φ hφ hu

theorem denseDivisibility_succ_iff {r N : ℕ} {Y : Set.Ici (1 : ℝ)} :
    Nonempty (DenseDivisibilityWitness Y (r + 1) N) ↔
      0 < N ∧ ∀ j k : ℕ, j + k = r →
        ∀ X : ℝ, 1 ≤ X → X ≤ (Y : ℝ) * (N : ℝ) →
          ∃ u v : ℕ, N = u * v ∧ Nonempty (DenseDivisibilityWitness Y j u) ∧
            Nonempty (DenseDivisibilityWitness Y k v) ∧
            X / (Y : ℝ) ≤ (v : ℝ) ∧ (v : ℝ) ≤ X := by
  constructor
  · rintro ⟨h⟩
    cases h with
    | succ positive factor =>
      refine ⟨positive, ?_⟩
      intro j k hjk X hX hXY
      cases factor j k hjk X hX hXY with
      | intro u v product left right lower upper =>
        exact ⟨u, v, product, ⟨left⟩, ⟨right⟩, lower, upper⟩
  · rintro ⟨positive, factor⟩
    refine ⟨.succ positive fun j k hjk X hX hXY => Classical.choice ?_⟩
    obtain ⟨u, v, product, left, right, lower, upper⟩ := factor j k hjk X hX hXY
    exact ⟨.intro u v product (Classical.choice left) (Classical.choice right) lower upper⟩

theorem denseDivisibility_pos {r N : ℕ} {Y : Set.Ici (1 : ℝ)}
    (h : Nonempty (DenseDivisibilityWitness Y r N)) : 0 < N := by
  rcases h with ⟨h⟩
  cases h with
  | zero positive => exact positive
  | succ positive _ => exact positive

theorem denseDivisibility_one (r : ℕ) (Y : Set.Ici (1 : ℝ)) :
    Nonempty (DenseDivisibilityWitness Y r 1) := by
  induction r using Nat.strong_induction_on with
  | h r ih =>
    cases r with
    | zero => exact ⟨.zero Nat.zero_lt_one⟩
    | succ r =>
      apply denseDivisibility_succ_iff.mpr
      refine ⟨Nat.zero_lt_one, ?_⟩
      intro j k hjk X hX hXY
      refine ⟨1, 1, by simp, ih j (by omega), ih k (by omega), ?_, ?_⟩
      · apply (div_le_iff₀ (lt_of_lt_of_le zero_lt_one Y.property)).2
        simpa using hXY
      · simpa using hX

theorem denseDivisibility_pred {r N : ℕ} {Y : Set.Ici (1 : ℝ)}
    (h : Nonempty (DenseDivisibilityWitness Y (r + 1) N)) :
    Nonempty (DenseDivisibilityWitness Y r N) := by
  have hYpos : 0 < (Y : ℝ) := lt_of_lt_of_le zero_lt_one Y.property
  have hNone : (1 : ℝ) ≤ N := Nat.one_le_cast.mpr (denseDivisibility_pos h)
  have hYN : 1 ≤ (Y : ℝ) * (N : ℝ) :=
    one_le_mul_of_one_le_of_one_le Y.property hNone
  obtain ⟨u, v, huv, _, hv, hlo, _⟩ :=
    (denseDivisibility_succ_iff.mp h).2 0 r (by simp) _ hYN le_rfl
  have hNv : (N : ℝ) ≤ v := by simpa [hYpos.ne'] using hlo
  have hvN : v ≤ N := Nat.le_of_dvd (denseDivisibility_pos h)
    ⟨u, by simpa [Nat.mul_comm] using huv⟩
  have hvEq : v = N := Nat.le_antisymm hvN (Nat.cast_le.mp hNv)
  simpa [hvEq] using hv

theorem denseDivisibility_mono_order {r s N : ℕ} {Y : Set.Ici (1 : ℝ)}
    (h : Nonempty (DenseDivisibilityWitness Y r N)) (hsr : s ≤ r) :
    Nonempty (DenseDivisibilityWitness Y s N) :=
  Nat.decreasingInduction (fun _ _ => denseDivisibility_pred) h hsr

theorem denseDivisibility_succ_of_small_targets {r N : ℕ} {Y : Set.Ici (1 : ℝ)}
    (hN : 0 < N)
    (hlower : ∀ s ≤ r, Nonempty (DenseDivisibilityWitness Y s N))
    (htarget : ∀ j k : ℕ, j + k = r →
      ∀ X : ℝ, 1 ≤ X → X ≤ (N : ℝ) →
        ∃ u v : ℕ, N = u * v ∧ Nonempty (DenseDivisibilityWitness Y j u) ∧
          Nonempty (DenseDivisibilityWitness Y k v) ∧ X / (Y : ℝ) ≤ (v : ℝ) ∧ (v : ℝ) ≤ X) :
    Nonempty (DenseDivisibilityWitness Y (r + 1) N) := by
  apply denseDivisibility_succ_iff.mpr
  refine ⟨hN, ?_⟩
  intro j k hjk X hX hXY
  by_cases hXN : X ≤ (N : ℝ)
  · exact htarget j k hjk X hX hXN
  · refine ⟨1, N, by simp, denseDivisibility_one j Y, hlower k (by omega),
      ?_, le_of_not_ge hXN⟩
    exact (div_le_iff₀ (lt_of_lt_of_le zero_lt_one Y.property)).2
      (by simpa [mul_comm] using hXY)

theorem denseDivisibility_mul_insert {r N p : ℕ} {Y : Set.Ici (1 : ℝ)}
    (hN : Nonempty (DenseDivisibilityWitness Y r N)) (hp : 0 < p)
    (hbound : (p : ℝ) ≤ (Y : ℝ) ∨ (p : ℝ) ^ r ≤ (Y : ℝ) * (N : ℝ)) :
    Nonempty (DenseDivisibilityWitness Y r (N * p)) := by
  induction r using Nat.strong_induction_on generalizing N with
  | h r ih =>
    cases r with
    | zero => exact ⟨.zero (Nat.mul_pos (denseDivisibility_pos hN) hp)⟩
    | succ r =>
      have hYpos : 0 < (Y : ℝ) := lt_of_lt_of_le zero_lt_one Y.property
      have hpR : 0 < (p : ℝ) := by exact_mod_cast hp
      have hpOne : (1 : ℝ) ≤ p := Nat.one_le_cast.mpr hp
      have hNpos : 0 < N := denseDivisibility_pos hN
      have hNle : (N : ℝ) ≤ (Y : ℝ) * (N : ℝ) :=
        le_mul_of_one_le_left (Nat.cast_nonneg N) Y.property
      refine denseDivisibility_succ_of_small_targets (Nat.mul_pos hNpos hp) ?_ ?_
      · intro s hs
        apply ih s (by omega) (denseDivisibility_mono_order hN (by omega))
        rcases hbound with hsmall | hlarge
        · exact Or.inl hsmall
        · exact Or.inr ((pow_le_pow_right₀ hpOne (by omega)).trans hlarge)
      · intro j k hjk X hX hXNp
        have hXnonneg : 0 ≤ X := zero_le_one.trans hX
        have hpjpos : 0 < (p : ℝ) ^ j := pow_pos hpR j
        have hpjOne : (1 : ℝ) ≤ (p : ℝ) ^ j := one_le_pow₀ hpOne
        have hpkOne : (p : ℝ) ≤ (p : ℝ) ^ (k + 1) :=
          le_self_pow₀ hpOne (by omega)
        have hXNp' : X ≤ (N : ℝ) * (p : ℝ) := by
          simpa only [Nat.cast_mul] using hXNp
        have first : X ≤ (Y : ℝ) * (N : ℝ) →
            ((p : ℝ) ≤ (Y : ℝ) ∨ X * (p : ℝ) ^ j ≤ (Y : ℝ) * (N : ℝ)) →
            ∃ a b : ℕ, N * p = a * b ∧
              Nonempty (DenseDivisibilityWitness Y j a) ∧
              Nonempty (DenseDivisibilityWitness Y k b) ∧
              X / (Y : ℝ) ≤ (b : ℝ) ∧ (b : ℝ) ≤ X := by
          intro hXY hfirst
          obtain ⟨a, b, hab, ha, hb, hlo, hhi⟩ :=
            (denseDivisibility_succ_iff.mp hN).2 j k hjk X hX hXY
          have hbpos : 0 < (b : ℝ) := by exact_mod_cast denseDivisibility_pos hb
          have habR : (N : ℝ) = (a : ℝ) * (b : ℝ) := by exact_mod_cast hab
          have hinsert : (p : ℝ) ≤ (Y : ℝ) ∨ (p : ℝ) ^ j ≤ (Y : ℝ) * (a : ℝ) := by
            rcases hfirst with hsmall | hmul
            · exact Or.inl hsmall
            · right
              apply (mul_le_mul_iff_left₀ hbpos).1
              calc
                (p : ℝ) ^ j * (b : ℝ) ≤ (p : ℝ) ^ j * X :=
                  mul_le_mul_of_nonneg_left hhi hpjpos.le
                _ ≤ (Y : ℝ) * (N : ℝ) := by simpa [mul_comm] using hmul
                _ = ((Y : ℝ) * (a : ℝ)) * (b : ℝ) := by rw [habR, mul_assoc]
          refine ⟨a * p, b, ?_, ih j (by omega) ha hinsert, hb, hlo, hhi⟩
          rw [hab, Nat.mul_right_comm]
        have second : (p : ℝ) ≤ X →
            ((p : ℝ) ≤ (Y : ℝ) ∨ (p : ℝ) ^ (k + 1) ≤ X) →
            ∃ a b : ℕ, N * p = a * b ∧
              Nonempty (DenseDivisibilityWitness Y j a) ∧
              Nonempty (DenseDivisibilityWitness Y k b) ∧
              X / (Y : ℝ) ≤ (b : ℝ) ∧ (b : ℝ) ≤ X := by
          intro hpX hsecond
          have hXdivOne : 1 ≤ X / (p : ℝ) :=
            (le_div_iff₀ hpR).2 (by simpa using hpX)
          have hXdivN : X / (p : ℝ) ≤ (N : ℝ) := (div_le_iff₀ hpR).2 hXNp'
          obtain ⟨a, b, hab, ha, hb, hlo, hhi⟩ :=
            (denseDivisibility_succ_iff.mp hN).2 j k hjk (X / (p : ℝ))
              hXdivOne (hXdivN.trans hNle)
          have hXYb : X / (p : ℝ) ≤ (b : ℝ) * (Y : ℝ) :=
            (div_le_iff₀ hYpos).1 hlo
          have hinsert : (p : ℝ) ≤ (Y : ℝ) ∨ (p : ℝ) ^ k ≤ (Y : ℝ) * (b : ℝ) := by
            rcases hsecond with hsmall | hpow
            · exact Or.inl hsmall
            · right
              have hpow' : (p : ℝ) ^ k ≤ X / (p : ℝ) := by
                apply (le_div_iff₀ hpR).2
                simpa only [pow_succ] using hpow
              simpa [mul_comm] using hpow'.trans hXYb
          refine ⟨a, b * p, ?_, ha, ih k (by omega) hb hinsert, ?_, ?_⟩
          · rw [hab, Nat.mul_assoc]
          · apply (div_le_iff₀ hYpos).2
            have hmult : X ≤ ((b : ℝ) * (Y : ℝ)) * (p : ℝ) :=
              (div_le_iff₀ hpR).1 hXYb
            simpa [Nat.cast_mul, mul_assoc, mul_left_comm, mul_comm] using hmult
          · have hmult : (b : ℝ) * (p : ℝ) ≤ X := (le_div_iff₀ hpR).1 hhi
            simpa only [Nat.cast_mul] using hmult
        by_cases hsmall : (p : ℝ) ≤ (Y : ℝ)
        · by_cases hXY : X ≤ (Y : ℝ) * (N : ℝ)
          · exact first hXY (Or.inl hsmall)
          · have hYleYN : (Y : ℝ) ≤ (Y : ℝ) * (N : ℝ) :=
              le_mul_of_one_le_right hYpos.le (Nat.one_le_cast.mpr hNpos)
            exact second (hsmall.trans (hYleYN.trans (le_of_not_ge hXY)))
              (Or.inl hsmall)
        · have hlarge : (p : ℝ) ^ (r + 1) ≤ (Y : ℝ) * (N : ℝ) :=
            hbound.resolve_left hsmall
          by_cases hfirst : X * (p : ℝ) ^ j ≤ (Y : ℝ) * (N : ℝ)
          · have hXpow : X ≤ X * (p : ℝ) ^ j :=
              le_mul_of_one_le_right hXnonneg hpjOne
            exact first (hXpow.trans hfirst) (Or.inr hfirst)
          · have hprod : (p : ℝ) ^ j * (p : ℝ) ^ (k + 1) ≤
                (Y : ℝ) * (N : ℝ) := by
              rw [← pow_add]
              simpa only [show j + (k + 1) = r + 1 by omega] using hlarge
            have hpowX : (p : ℝ) ^ (k + 1) ≤ X := by
              have hlt : (p : ℝ) ^ j * (p : ℝ) ^ (k + 1) <
                  (p : ℝ) ^ j * X :=
                hprod.trans_lt (by simpa [mul_comm] using lt_of_not_ge hfirst)
              exact le_of_lt ((mul_lt_mul_iff_right₀ hpjpos).1 hlt)
            exact second (hpkOne.trans hpowX) (Or.inr hpowX)

theorem denseDivisibility_of_finset_chain (r : ℕ) (Y : Set.Ici (1 : ℝ))
    (s : Finset ℕ) (hpos : ∀ p ∈ s, 0 < p)
    (hchain : ∀ p ∈ s, (p : ℝ) ≤ (Y : ℝ) ∨
      (p : ℝ) ^ r ≤ (Y : ℝ) * (((s.filter (fun q => q < p)).prod id : ℕ) : ℝ)) :
    Nonempty (DenseDivisibilityWitness Y r (s.prod id)) := by
  revert hpos hchain
  refine Finset.induction_on_max s ?_ ?_
  · intro _ _
    simpa using denseDivisibility_one r Y
  · intro p s hmax ih hpos hchain
    have hpnot : p ∉ s := fun hp => (lt_irrefl p) (hmax p hp)
    have hchain_s : ∀ q ∈ s, (q : ℝ) ≤ (Y : ℝ) ∨
        (q : ℝ) ^ r ≤ (Y : ℝ) * (((s.filter (fun a => a < q)).prod id : ℕ) : ℝ) := by
      intro q hq
      have hnlt : ¬ p < q := not_lt_of_ge (hmax q hq).le
      simpa only [Finset.filter_insert, ite_eq_right hnlt] using
        hchain q (Finset.mem_insert_of_mem hq)
    have hpbound := hchain p (Finset.mem_insert_self p s)
    rw [Finset.filter_insert, ite_eq_right (lt_irrefl p),
      Finset.filter_eq_self.mpr hmax] at hpbound
    have hdense := denseDivisibility_mul_insert
      (ih (fun q hq => hpos q (Finset.mem_insert_of_mem hq)) hchain_s)
      (hpos p (Finset.mem_insert_self p s)) hpbound
    simpa only [Finset.prod_insert hpnot, id_eq, Nat.mul_comm] using hdense

theorem increasing_prime_criterion {r Q : ℕ} (Y : Set.Ici (1 : ℝ))
    (hQ : Squarefree Q)
    (hchain : ∀ p : ℕ, Nat.Prime p → p ∣ Q → (Y : ℝ) < (p : ℝ) →
      (p : ℝ) ^ r ≤ (Y : ℝ) *
        (((Q.primeFactors.filter (fun q => q < p)).prod id : ℕ) : ℝ)) :
    Nonempty (DenseDivisibilityWitness Y r Q) := by
  have hresult := denseDivisibility_of_finset_chain r Y Q.primeFactors
    (fun p hp => Nat.pos_of_mem_primeFactors hp) (by
      intro p hp
      by_cases hsmall : (p : ℝ) ≤ (Y : ℝ)
      · exact Or.inl hsmall
      · exact Or.inr (hchain p (Nat.prime_of_mem_primeFactors hp)
          (Nat.dvd_of_mem_primeFactors hp) (lt_of_not_ge hsmall)))
  simpa only [id_eq, Nat.prod_primeFactors_of_squarefree hQ] using hresult

theorem denseDivisibility_two_of_dense_divisors {N : ℕ} {Y : Set.Ici (1 : ℝ)}
    (hN : 0 < N)
    (hdiv : ∀ X : ℝ, 1 ≤ X → X ≤ (Y : ℝ) * (N : ℝ) →
      ∃ a b : ℕ, N = a * b ∧ Nonempty (DenseDivisibilityWitness Y 1 b) ∧
        X / (Y : ℝ) ≤ (b : ℝ) ∧ (b : ℝ) ≤ X) :
    Nonempty (DenseDivisibilityWitness Y 2 N) := by
  have hYpos : 0 < (Y : ℝ) := lt_of_lt_of_le zero_lt_one Y.property
  apply denseDivisibility_succ_iff.mpr
  refine ⟨hN, ?_⟩
  intro j k hjk X hX hXY
  rcases Nat.add_eq_one_iff.mp hjk with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩
  · obtain ⟨a, b, hab, hb, hlo, hhi⟩ := hdiv X hX hXY
    have ha : 0 < a := Nat.pos_of_mul_pos_right (hab ▸ hN)
    exact ⟨a, b, hab, ⟨.zero ha⟩, hb, hlo, hhi⟩
  · have hXpos : 0 < X := zero_lt_one.trans_le hX
    have htargetOne : 1 ≤ (Y : ℝ) * (N : ℝ) / X :=
      (le_div_iff₀ hXpos).2 (by simpa using hXY)
    have htargetTop : (Y : ℝ) * (N : ℝ) / X ≤ (Y : ℝ) * (N : ℝ) :=
      div_le_self (mul_nonneg hYpos.le (Nat.cast_nonneg N)) hX
    obtain ⟨a, b, hab, hb, hlo, hhi⟩ := hdiv _ htargetOne htargetTop
    have ha : 0 < a := Nat.pos_of_mul_pos_right (hab ▸ hN)
    have hbpos : 0 < (b : ℝ) := by exact_mod_cast denseDivisibility_pos hb
    have habR : (N : ℝ) = (a : ℝ) * (b : ℝ) := by exact_mod_cast hab
    refine ⟨b, a, ?_, hb, ⟨.zero ha⟩, ?_, ?_⟩
    · rw [hab, Nat.mul_comm]
    · apply (div_le_iff₀ hYpos).2
      apply (mul_le_mul_iff_right₀ hbpos).1
      calc
        (b : ℝ) * X ≤ (Y : ℝ) * (N : ℝ) := (le_div_iff₀ hXpos).1 hhi
        _ = (b : ℝ) * ((a : ℝ) * (Y : ℝ)) := by rw [habR]; ac_rfl
    · apply (mul_le_mul_iff_left₀ hbpos).1
      have hNX : (N : ℝ) / X ≤ (b : ℝ) := by
        simpa only [div_div, mul_comm X (Y : ℝ), mul_div_mul_left _ _ hYpos.ne'] using hlo
      simpa only [habR, mul_comm] using (div_le_iff₀ hXpos).1 hNX

theorem balanced_prime_insert {N p d : ℕ} (Y : Set.Ici (1 : ℝ))
    (hN : Nonempty (DenseDivisibilityWitness Y 2 N))
    (hp : Nat.Prime p) (hpN : ¬ p ∣ N) (hd : d ∣ N)
    (hdd : Nonempty (DenseDivisibilityWitness Y 1 d))
    (hleft : (p : ℝ) ≤ (Y : ℝ) * (d : ℝ))
    (hright : (p : ℝ) ≤ (Y : ℝ) * (N : ℝ) / (d : ℝ)) :
    Nonempty (DenseDivisibilityWitness Y 2 (N * p)) := by
  have hYpos : 0 < (Y : ℝ) := lt_of_lt_of_le zero_lt_one Y.property
  have hpR : 0 < (p : ℝ) := by exact_mod_cast hp.pos
  have hpOne : (1 : ℝ) ≤ p := Nat.one_le_cast.mpr hp.pos
  have hdpos : 0 < (d : ℝ) := by exact_mod_cast denseDivisibility_pos hdd
  have hNpos : 0 < N := Nat.pos_of_ne_zero fun h => hpN (by simp [h])
  obtain ⟨m, hm⟩ := hd
  have hdp : Nonempty (DenseDivisibilityWitness Y 1 (d * p)) :=
    denseDivisibility_mul_insert hdd hp.pos (Or.inr (by simpa only [pow_one] using hleft))
  apply denseDivisibility_two_of_dense_divisors (Nat.mul_pos hNpos hp.pos)
  intro X hX hXY
  by_cases hold : X ≤ (Y : ℝ) * (N : ℝ)
  · obtain ⟨a, b, hab, _, hb, hlo, hhi⟩ :=
      (denseDivisibility_succ_iff.mp hN).2 0 1 rfl X hX hold
    refine ⟨a * p, b, ?_, hb, hlo, hhi⟩
    rw [hab, Nat.mul_right_comm]
  · by_cases hp2X : (p : ℝ) ^ 2 ≤ X
    · have hpX : (p : ℝ) ≤ X :=
        (le_self_pow₀ hpOne two_ne_zero).trans hp2X
      have htargetOne : 1 ≤ X / (p : ℝ) :=
        (le_div_iff₀ hpR).2 (by simpa using hpX)
      have htargetTop : X / (p : ℝ) ≤ (Y : ℝ) * (N : ℝ) :=
        (div_le_iff₀ hpR).2 (by simpa [Nat.cast_mul, mul_assoc] using hXY)
      obtain ⟨a, b, hab, _, hb, hlo, hhi⟩ :=
        (denseDivisibility_succ_iff.mp hN).2 0 1 rfl (X / (p : ℝ))
          htargetOne htargetTop
      have hXdiv : X / (p : ℝ) ≤ (b : ℝ) * (Y : ℝ) := (div_le_iff₀ hYpos).1 hlo
      have hpb : (p : ℝ) ≤ (Y : ℝ) * (b : ℝ) := by
        have hpXdiv : (p : ℝ) ≤ X / (p : ℝ) :=
          (le_div_iff₀ hpR).2 (by simpa only [pow_two] using hp2X)
        simpa only [mul_comm] using hpXdiv.trans hXdiv
      have hbp : Nonempty (DenseDivisibilityWitness Y 1 (b * p)) :=
        denseDivisibility_mul_insert hb hp.pos (Or.inr (by simpa only [pow_one] using hpb))
      refine ⟨a, b * p, ?_, hbp, ?_, ?_⟩
      · rw [hab, Nat.mul_assoc]
      · apply (div_le_iff₀ hYpos).2
        have hmult := (div_le_iff₀ hpR).1 hXdiv
        simpa [Nat.cast_mul, mul_assoc, mul_left_comm, mul_comm] using hmult
      · have hmult := (le_div_iff₀ hpR).1 hhi
        simpa only [Nat.cast_mul] using hmult
    · refine ⟨m, d * p, ?_, hdp, ?_, ?_⟩
      · rw [hm]
        ac_rfl
      · apply (div_le_iff₀ hYpos).2
        have hp2 : (p : ℝ) ^ 2 ≤ ((d : ℝ) * (p : ℝ)) * (Y : ℝ) := by
          have hmul := mul_le_mul_of_nonneg_left hleft hpR.le
          simpa only [pow_two, mul_assoc, mul_left_comm, mul_comm] using hmul
        simpa only [Nat.cast_mul] using (le_of_not_ge hp2X).trans hp2
      · have hdpYN : (d : ℝ) * (p : ℝ) ≤ (Y : ℝ) * (N : ℝ) := by
          simpa only [mul_comm] using (le_div_iff₀ hdpos).1 hright
        simpa only [Nat.cast_mul] using hdpYN.trans (le_of_not_ge hold)

theorem prime_insert {r N p : ℕ} (Y : Set.Ici (1 : ℝ))
    (hr : 1 ≤ r) (hN : Nonempty (DenseDivisibilityWitness Y r N))
    (hp : Nat.Prime p) (hpN : ¬ p ∣ N)
    (hbound : (p : ℝ) ≤ (Y : ℝ) ∨ (p : ℝ) ^ r ≤ (Y : ℝ) * (N : ℝ)) :
    Nonempty (DenseDivisibilityWitness Y r (N * p)) := by
  obtain ⟨s, rfl⟩ := Nat.exists_eq_succ_of_ne_zero (Nat.ne_of_gt hr)
  have hN0 : N ≠ 0 := by
    intro h
    apply hpN
    simp [h]
  obtain ⟨h⟩ := denseDivisibility_mul_insert hN hp.pos hbound
  cases h with
  | succ _ factor => exact ⟨.succ (Nat.mul_pos (Nat.pos_of_ne_zero hN0) hp.pos) factor⟩

theorem single_dense_iff {Y : Set.Ici (1 : ℝ)} {n : ℕ} :
    Nonempty (DenseDivisibilityWitness Y 1 n) ↔
      0 < n ∧ ∀ X : ℝ, 1 ≤ X → X ≤ (n : ℝ) →
        ∃ d : ℕ, d ∣ n ∧ X / (Y : ℝ) ≤ (d : ℝ) ∧ (d : ℝ) ≤ X := by
  have hY : 0 < (Y : ℝ) := lt_of_lt_of_le zero_lt_one Y.property
  constructor
  · intro h
    refine ⟨denseDivisibility_pos h, ?_⟩
    intro X hX hXn
    have hXY : X ≤ (Y : ℝ) * n :=
      hXn.trans (le_mul_of_one_le_left (Nat.cast_nonneg n) Y.property)
    obtain ⟨u, d, hprod, _, _, hlow, hupp⟩ :=
      (denseDivisibility_succ_iff.mp h).2 0 0 rfl X hX hXY
    exact ⟨d, ⟨u, by simpa [mul_comm] using hprod⟩, hlow, hupp⟩
  · rintro ⟨hn, h⟩
    apply denseDivisibility_succ_iff.mpr
    refine ⟨hn, ?_⟩
    intro j k hjk X hX hXY
    obtain ⟨rfl, rfl⟩ := Nat.add_eq_zero_iff.mp hjk
    have hex : ∃ d : ℕ, d ∣ n ∧ X / (Y : ℝ) ≤ (d : ℝ) ∧ (d : ℝ) ≤ X := by
      by_cases hXn : X ≤ (n : ℝ)
      · exact h X hX hXn
      · refine ⟨n, dvd_rfl, ?_, le_of_not_ge hXn⟩
        exact (div_le_iff₀ hY).2 (by simpa [mul_comm] using hXY)
    obtain ⟨d, hd, hlow, hupp⟩ := hex
    have hdpos : 0 < d := Nat.pos_of_dvd_of_pos hd hn
    refine ⟨n / d, d, (Nat.div_mul_cancel hd).symm,
      ⟨.zero (Nat.div_pos (Nat.le_of_dvd hn hd) hdpos)⟩, ⟨.zero hdpos⟩, hlow, hupp⟩

theorem single_dense_div {Y Z : Set.Ici (1 : ℝ)} {n c : ℕ}
    (h : Nonempty (DenseDivisibilityWitness Y 1 n)) (hc : 0 < c) (hcn : c ∣ n)
    (hscale : (c : ℝ) * (Y : ℝ) ≤ (Z : ℝ)) :
    Nonempty (DenseDivisibilityWitness Z 1 (n / c)) := by
  obtain ⟨hn, hdense⟩ := single_dense_iff.mp h
  refine single_dense_iff.mpr ⟨Nat.div_pos (Nat.le_of_dvd hn hcn) hc, ?_⟩
  intro X hX hXn
  have hXold : X ≤ (n : ℝ) :=
    hXn.trans (by exact_mod_cast Nat.div_le_self n c)
  obtain ⟨d, hd, hlow, hupp⟩ := hdense X hX hXold
  have hdvd : d / d.gcd c ∣ n / c := by
    apply (Nat.dvd_div_iff_mul_dvd hcn).2
    rw [← Nat.mul_div_assoc c (Nat.gcd_dvd_left d c), Nat.mul_comm c d,
      ← Nat.lcm_eq_mul_div]
    exact Nat.lcm_dvd hd hcn
  have hquot : (d : ℝ) ≤ (d / d.gcd c : ℕ) * (c : ℝ) := by
    exact_mod_cast calc
      d = (d / d.gcd c) * d.gcd c := (Nat.div_mul_cancel (Nat.gcd_dvd_left d c)).symm
      _ ≤ (d / d.gcd c) * c := Nat.mul_le_mul_left _ (Nat.gcd_le_right d hc)
  have hY : 0 < (Y : ℝ) := lt_of_lt_of_le zero_lt_one Y.property
  have hZ : 0 < (Z : ℝ) := lt_of_lt_of_le zero_lt_one Z.property
  refine ⟨d / d.gcd c, hdvd, (div_le_iff₀ hZ).2 ?_, ?_⟩
  · calc
      X ≤ (d : ℝ) * (Y : ℝ) := (div_le_iff₀ hY).1 hlow
      _ ≤ ((d / d.gcd c : ℕ) : ℝ) * c * (Y : ℝ) :=
        mul_le_mul_of_nonneg_right hquot hY.le
      _ = ((d / d.gcd c : ℕ) : ℝ) * ((c : ℝ) * (Y : ℝ)) := by ring
      _ ≤ ((d / d.gcd c : ℕ) : ℝ) * (Z : ℝ) :=
        mul_le_mul_of_nonneg_left hscale (Nat.cast_nonneg _)
  · exact le_trans (by exact_mod_cast Nat.div_le_self d (d.gcd c)) hupp

theorem single_dense_mul {Y Z : Set.Ici (1 : ℝ)} {n c : ℕ}
    (h : Nonempty (DenseDivisibilityWitness Y 1 n)) (hc : 0 < c)
    (hscale : (c : ℝ) * (Y : ℝ) ≤ (Z : ℝ)) :
    Nonempty (DenseDivisibilityWitness Z 1 (n * c)) := by
  obtain ⟨hn, hdense⟩ := single_dense_iff.mp h
  have hcR : 0 < (c : ℝ) := by exact_mod_cast hc
  have hc1 : (1 : ℝ) ≤ c := by exact_mod_cast hc
  have hY : 0 < (Y : ℝ) := lt_of_lt_of_le zero_lt_one Y.property
  have hZ : 0 < (Z : ℝ) := lt_of_lt_of_le zero_lt_one Z.property
  refine single_dense_iff.mpr ⟨Nat.mul_pos hn hc, ?_⟩
  intro X hX hXn
  by_cases hXc : X < (c : ℝ)
  · refine ⟨1, one_dvd _, (div_le_iff₀ hZ).2 ?_, by simpa using hX⟩
    have hcY : (c : ℝ) ≤ (c : ℝ) * (Y : ℝ) :=
      le_mul_of_one_le_right hcR.le Y.property
    simpa using hXc.le.trans (hcY.trans hscale)
  · have htarget : X / (c : ℝ) ≤ (n : ℝ) :=
      (div_le_iff₀ hcR).2 (by simpa using hXn)
    obtain ⟨d, hd, hlow, hupp⟩ := hdense (X / c)
      ((one_le_div hcR).2 (le_of_not_gt hXc)) htarget
    refine ⟨d, dvd_mul_of_dvd_left hd c, (div_le_iff₀ hZ).2 ?_, ?_⟩
    · calc
        X ≤ (d : ℝ) * (Y : ℝ) * c :=
          (div_le_iff₀ hcR).1 ((div_le_iff₀ hY).1 hlow)
        _ = (d : ℝ) * ((c : ℝ) * (Y : ℝ)) := by ring
        _ ≤ (d : ℝ) * (Z : ℝ) :=
          mul_le_mul_of_nonneg_left hscale (Nat.cast_nonneg d)
    · exact hupp.trans (div_le_self (by linarith) hc1)

open scoped Classical in
theorem masked_discrepancy_eq_nonprincipal_character_sum
    (q r : ℕ) [NeZero q] (hr : 0 < r)
    (a : (ZMod q)ˣ) (f : ℕ →₀ ℂ) :
    (∑ n ∈ f.support,
        if Nat.Coprime n r ∧ (n : ZMod q) = (a : ZMod q) then f n else 0) -
      (q.totient : ℂ)⁻¹ *
        (∑ n ∈ f.support,
          if Nat.Coprime n r ∧ Nat.Coprime n q then f n else 0) =
      (q.totient : ℂ)⁻¹ *
        ∑ χ ∈ (Finset.univ : Finset (DirichletCharacter ℂ q)).erase 1,
          χ ((a : ZMod q)⁻¹) *
            ∑ n ∈ f.support,
              if Nat.Coprime n r then f n * χ (n : ZMod q) else 0 := by
  obtain ⟨s, rfl⟩ := Nat.exists_eq_succ_of_ne_zero (Nat.ne_of_gt hr)
  let S : ℂ := ∑ n ∈ f.support,
    if Nat.Coprime n (s + 1) ∧ (n : ZMod q) = (a : ZMod q) then f n else 0
  let M : ℂ := ∑ n ∈ f.support,
    if Nat.Coprime n (s + 1) ∧ Nat.Coprime n q then f n else 0
  let T : DirichletCharacter ℂ q → ℂ := fun χ =>
    χ ((a : ZMod q)⁻¹) *
      ∑ n ∈ f.support, if Nat.Coprime n (s + 1) then f n * χ (n : ZMod q) else 0
  have hall : ∑ χ, T χ = (q.totient : ℂ) * S := by
    simp only [T, S, Finset.mul_sum]
    rw [Finset.sum_comm]
    apply Finset.sum_congr rfl
    intro n hn
    by_cases hnr : Nat.Coprime n (s + 1)
    · simp_rw [ite_eq_left hnr]
      have hif : (if Nat.Coprime n (s + 1) ∧ (n : ZMod q) = (a : ZMod q)
          then f n else 0) = (if (n : ZMod q) = (a : ZMod q) then f n else 0) := by
        by_cases hna : (n : ZMod q) = (a : ZMod q)
        · rw [ite_eq_left ⟨hnr, hna⟩, ite_eq_left hna]
        · rw [ite_eq_right (fun h => hna h.2), ite_eq_right hna]
      rw [hif]
      calc
        (∑ χ : DirichletCharacter ℂ q,
            χ ((a : ZMod q)⁻¹) * (f n * χ (n : ZMod q))) =
            f n * ∑ χ : DirichletCharacter ℂ q,
              χ ((a : ZMod q)⁻¹) * χ (n : ZMod q) := by
          rw [Finset.mul_sum]
          apply Finset.sum_congr rfl
          intro χ hχ
          ring
        _ = f n * (if (a : ZMod q) = (n : ZMod q) then (q.totient : ℂ) else 0) := by
          rw [DirichletCharacter.sum_char_inv_mul_char_eq ℂ a.isUnit]
        _ = (q.totient : ℂ) *
            (if (n : ZMod q) = (a : ZMod q) then f n else 0) := by
          by_cases hna : (n : ZMod q) = (a : ZMod q)
          · simp [hna, mul_comm]
          · simp [hna, Ne.symm hna]
    · simp [hnr]
  have hone : T 1 = M := by
    simp only [T, M]
    rw [ZMod.inv_coe_unit, MulChar.one_apply_coe, one_mul]
    apply Finset.sum_congr rfl
    intro n hn
    by_cases hnr : Nat.Coprime n (s + 1)
    · rw [ite_eq_left hnr]
      by_cases hnq : Nat.Coprime n q
      · rw [ite_eq_left ⟨hnr, hnq⟩,
          MulChar.one_apply ((ZMod.isUnit_iff_coprime n q).2 hnq), mul_one]
      · have hnu : ¬ IsUnit (n : ZMod q) := by
          simpa only [ZMod.isUnit_iff_coprime] using hnq
        rw [ite_eq_right (fun h => hnq h.2), MulChar.map_nonunit _ hnu, mul_zero]
    · rw [ite_eq_right hnr, ite_eq_right (fun h => hnr h.1)]
  have hs : (∑ χ ∈ (Finset.univ : Finset (DirichletCharacter ℂ q)).erase 1, T χ) + M =
      (q.totient : ℂ) * S := by
    rw [← hone, Finset.sum_erase_add _ _ (Finset.mem_univ _), hall]
  have hφ : (q.totient : ℂ) ≠ 0 := Nat.cast_ne_zero.mpr (NeZero.ne q.totient)
  change S - (q.totient : ℂ)⁻¹ * M =
    (q.totient : ℂ)⁻¹ * ∑ χ ∈ (Finset.univ : Finset (DirichletCharacter ℂ q)).erase 1, T χ
  apply mul_left_cancel₀ hφ
  rw [mul_sub, ← mul_assoc, mul_inv_cancel₀ hφ, one_mul]
  rw [← mul_assoc, mul_inv_cancel₀ hφ, one_mul]
  linear_combination -hs

theorem masked_convolution_discrepancy
    (q : ℕ) [NeZero q] (r₀ : ℕ+) (a : (ZMod q)ˣ)
    (α β : MonoidAlgebra ℂ ℕ+) :
    ((∑ t ∈ (α * β).coeff.support,
        if Nat.Coprime (t : ℕ) (r₀ : ℕ) ∧
            ((t : ℕ) : ZMod q) = (a : ZMod q)
        then (α * β).coeff t else 0) -
      (Nat.totient q : ℂ)⁻¹ *
        ∑ t ∈ (α * β).coeff.support,
          if Nat.Coprime (t : ℕ) (r₀ : ℕ) ∧ Nat.Coprime (t : ℕ) q
          then (α * β).coeff t else 0) =
      ∑ m ∈ α.coeff.support with Nat.Coprime ((m : ℕ+) : ℕ) (q * (r₀ : ℕ)),
        α.coeff m *
          ((∑ n ∈ β.coeff.support,
              if Nat.Coprime (n : ℕ) (r₀ : ℕ) ∧
                  ((n : ℕ) : ZMod q) =
                    (a : ZMod q) * (((m : ℕ) : ZMod q)⁻¹)
              then β.coeff n else 0) -
            (Nat.totient q : ℂ)⁻¹ *
              ∑ n ∈ β.coeff.support,
                if Nat.Coprime (n : ℕ) (r₀ : ℕ) ∧ Nat.Coprime (n : ℕ) q
                then β.coeff n else 0) := by
  classical
  have hφ : (Nat.totient q : ℂ) ≠ 0 := by
    exact_mod_cast (NeZero.ne q.totient)
  let kernel (b : ZMod q) (t : ℕ+) : ℂ :=
    (if Nat.Coprime (t : ℕ) (r₀ : ℕ) ∧ ((t : ℕ) : ZMod q) = b then 1 else 0) -
      (Nat.totient q : ℂ)⁻¹ *
        (if Nat.Coprime (t : ℕ) (r₀ : ℕ) ∧ Nat.Coprime (t : ℕ) q then 1 else 0)
  let eval (b : ZMod q) : MonoidAlgebra ℂ ℕ+ →ₗ[ℂ] ℂ :=
    (Finsupp.linearCombination ℂ (kernel b)).comp
      (MonoidAlgebra.coeffLinearEquiv ℂ).toLinearMap
  have heval (f : MonoidAlgebra ℂ ℕ+) (b : ZMod q) :
      eval b f =
        (∑ t ∈ f.coeff.support,
          if Nat.Coprime (t : ℕ) (r₀ : ℕ) ∧ ((t : ℕ) : ZMod q) = b
          then f.coeff t else 0) -
        (Nat.totient q : ℂ)⁻¹ *
          ∑ t ∈ f.coeff.support,
            if Nat.Coprime (t : ℕ) (r₀ : ℕ) ∧ Nat.Coprime (t : ℕ) q
            then f.coeff t else 0 := by
    change (∑ t ∈ f.coeff.support, f.coeff t * kernel b t) = _
    apply mul_left_cancel₀ hφ
    simp only [kernel, mul_sub, Finset.sum_sub_distrib, Finset.mul_sum]
    congr 1 <;> apply Finset.sum_congr rfl <;> intro t _ <;> split_ifs <;>
      field_simp [hφ] <;> ring
  have hconv :
      eval (a : ZMod q) (α * β) =
        ∑ m ∈ α.coeff.support, ∑ n ∈ β.coeff.support,
          (α.coeff m * β.coeff n) * kernel (a : ZMod q) (m * n) := by
    rw [MonoidAlgebra.mul_def]
    simp only [map_finsuppSum]
    simp only [eval, LinearMap.comp_apply, LinearEquiv.coe_coe,
      MonoidAlgebra.coeffLinearEquiv_apply, MonoidAlgebra.coeff_single,
      Finsupp.linearCombination_single, smul_eq_mul, Finsupp.sum]
  have hkernel (m n : ℕ+) :
      kernel (a : ZMod q) (m * n) =
        if Nat.Coprime (m : ℕ) (q * (r₀ : ℕ))
        then kernel ((a : ZMod q) * (((m : ℕ) : ZMod q)⁻¹)) n else 0 := by
    by_cases hm : Nat.Coprime (m : ℕ) (q * (r₀ : ℕ))
    · obtain ⟨hmq, hmr⟩ := Nat.coprime_mul_iff_right.mp hm
      have hcop (c : ℕ) (hc : Nat.Coprime (m : ℕ) c) :
          Nat.Coprime ((m * n : ℕ+) : ℕ) c ↔ Nat.Coprime (n : ℕ) c :=
        ⟨Nat.Coprime.coprime_mul_left, hc.mul_left⟩
      have heq :
          (((m * n : ℕ+) : ℕ) : ZMod q) = (a : ZMod q) ↔
            ((n : ℕ) : ZMod q) = (a : ZMod q) * (((m : ℕ) : ZMod q)⁻¹) := by
        rw [PNat.mul_coe, Nat.cast_mul]
        let u := ZMod.unitOfCoprime (m : ℕ) hmq
        change (u : ZMod q) * ((n : ℕ) : ZMod q) = (a : ZMod q) ↔
          ((n : ℕ) : ZMod q) = (a : ZMod q) * (u : ZMod q)⁻¹
        rw [ZMod.inv_coe_unit, mul_comm (a : ZMod q)]
        exact (Units.eq_inv_mul_iff_mul_eq (b := u)).symm
      simp only [kernel, ite_eq_left hm, hcop _ hmr, hcop _ hmq, heq]
    · have hbad (hr : Nat.Coprime ((m * n : ℕ+) : ℕ) (r₀ : ℕ))
          (hq' : Nat.Coprime ((m * n : ℕ+) : ℕ) q) : False :=
        hm (hq'.coprime_mul_right.mul_right hr.coprime_mul_right)
      have hres : ¬ (Nat.Coprime ((m * n : ℕ+) : ℕ) (r₀ : ℕ) ∧
          (((m * n : ℕ+) : ℕ) : ZMod q) = (a : ZMod q)) := by
        rintro ⟨hr, heq⟩
        exact hbad hr ((ZMod.isUnit_iff_coprime ((m * n : ℕ+) : ℕ) q).mp
          (heq.symm ▸ a.isUnit))
      have hmean : ¬ (Nat.Coprime ((m * n : ℕ+) : ℕ) (r₀ : ℕ) ∧
          Nat.Coprime ((m * n : ℕ+) : ℕ) q) := fun h ↦ hbad h.1 h.2
      simp only [kernel, ite_eq_right hm, ite_eq_right hres, ite_eq_right hmean,
        mul_zero, sub_self]
  rw [← heval (α * β) (a : ZMod q), hconv, Finset.sum_filter]
  apply Finset.sum_congr rfl
  intro m _
  by_cases hm : Nat.Coprime (m : ℕ) (q * (r₀ : ℕ))
  · simp only [ite_eq_left hm]
    rw [← heval β ((a : ZMod q) * (((m : ℕ) : ZMod q)⁻¹))]
    simp only [hkernel, ite_eq_left hm, eval, LinearMap.comp_apply,
      LinearEquiv.coe_coe, MonoidAlgebra.coeffLinearEquiv_apply,
      Finsupp.linearCombination_apply, Finsupp.sum, smul_eq_mul,
      Finset.mul_sum, mul_assoc]
  · simp [hkernel, hm]

/--
The size of a natural number measured by its real logarithm to base `R`, with Mathlib's total
`Real.logb` conventions.
-/
noncomputable def logSize (R : ℝ) (n : ℕ) : ℝ := Real.logb R n

/--
The base-`R` logarithmic size of `q`, truncated below at zero and packaged as a nonnegative
real.
-/
noncomputable def logFragment (R : ℝ) (q : ℕ) : ℝ≥0 := (logSize R q).toNNReal

/-- The distinct prime factors `p` of `D` exceeding the real threshold `R ^ ξ`. -/
noncomputable def activatedPrimeFactors (R ξ : ℝ) (D : ℕ) : Finset ℕ :=
  D.primeFactors.filter (fun p => R ^ ξ < (p : ℝ))

/--
The sum of nonnegative logarithmic fragments of the distinct prime factors of `D` smaller than
`p`.
-/
noncomputable def primeFragmentPrefix (R : ℝ) (D p : ℕ) : ℝ≥0 :=
  (D.primeFactors.filter (fun q => q < p)).sum (logFragment R)

/--
The sum of nonnegative logarithmic fragments of the distinct prime factors of `D` greater than
`p`.
-/
noncomputable def primeFragmentSuffix (R : ℝ) (D p : ℕ) : ℝ≥0 :=
  (D.primeFactors.filter (fun q => p < q)).sum (logFragment R)

/--
The largest logarithmic fragment among activated prime factors of `D`, with value zero when no
prime is activated.
-/
noncomputable def maxActivatedPrimeFragment (R ξ : ℝ) (D : ℕ) : ℝ≥0 :=
  (activatedPrimeFactors R ξ D).sup (logFragment R)

/--
The maximum, over activated primes `p`, of the sum `after R D p + logFragment R p + φ
(logFragment R p)`. It combines the later-prime logarithmic mass, the current fragment, and its
allowance under `φ`, and is zero when no prime is activated.
-/
noncomputable def primeFragmentOwner (φ : ℝ≥0 → ℝ≥0) (R ξ : ℝ) (D : ℕ) : ℝ≥0 :=
  (activatedPrimeFactors R ξ D).sup
    (fun p => primeFragmentSuffix R D p + logFragment R p + φ (logFragment R p))

theorem coe_logFragment (R : ℝ) (hR : 1 < R) {q : ℕ} (hq : 0 < q) :
    (logFragment R q : ℝ) = logSize R q := by
  rw [logFragment, Real.coe_toNNReal]
  exact Real.logb_nonneg hR (by exact_mod_cast (show 1 ≤ q from hq))

theorem logSize_primeFactors_prefix (R : ℝ) (hR : 1 < R) (D p : ℕ) :
    logSize R ((D.primeFactors.filter (fun q => q < p)).prod id) =
      (primeFragmentPrefix R D p : ℝ) := by
  classical
  have hn : ∀ q ∈ D.primeFactors.filter (fun q => q < p), (q : ℝ) ≠ 0 := by
    intro q hq
    exact_mod_cast (Nat.pos_of_mem_primeFactors (Finset.mem_filter.mp hq).1).ne'
  simp only [logSize, Nat.cast_prod, id_eq]
  rw [Real.logb_prod _ _ hn]
  simp only [primeFragmentPrefix, NNReal.coe_sum]
  apply Finset.sum_congr rfl
  intro q hq
  exact (coe_logFragment R hR (Nat.pos_of_mem_primeFactors (Finset.mem_filter.mp hq).1)).symm

theorem sum_primeFactors_logFragment_eq_logSize (R : ℝ) (hR : 1 < R) {D : ℕ} (hD : Squarefree D) :
    ((D.primeFactors.sum (logFragment R) : ℝ≥0) : ℝ) = logSize R D := by
  classical
  have hfilter : D.primeFactors.filter (fun q => q < D + 1) = D.primeFactors :=
    Finset.filter_eq_self.mpr fun q hq => Nat.lt_succ_of_le (Nat.le_of_mem_primeFactors hq)
  simpa only [primeFragmentPrefix, hfilter, id_eq, Nat.prod_primeFactors_of_squarefree hD]
    using (logSize_primeFactors_prefix R hR D (D + 1)).symm

theorem primeFragmentPrefix_add_logSize_add_suffix (R : ℝ) (hR : 1 < R) {D p : ℕ}
    (hD : Squarefree D) (hpD : p ∈ D.primeFactors) :
    (primeFragmentPrefix R D p : ℝ) + logSize R p +
      (primeFragmentSuffix R D p : ℝ) = logSize R D := by
  classical
  have hall : (D.primeFactors.filter (fun q => q < p)).sum (logFragment R) +
      logFragment R p +
      (D.primeFactors.filter (fun q => p < q)).sum (logFragment R) =
      D.primeFactors.sum (logFragment R) := by
    rw [← Finset.sum_ite_eq_of_mem' D.primeFactors p (logFragment R) hpD]
    simp only [Finset.sum_filter, ← Finset.sum_add_distrib]
    apply Finset.sum_congr rfl
    intro q _
    rcases lt_trichotomy q p with h | rfl | h
    · simp [h, h.ne, not_lt_of_gt h]
    · simp
    · simp [h, h.ne', not_lt_of_gt h]
  calc
    (primeFragmentPrefix R D p : ℝ) + logSize R p + (primeFragmentSuffix R D p : ℝ) =
        ((primeFragmentPrefix R D p + logFragment R p + primeFragmentSuffix R D p : ℝ≥0) : ℝ) := by
      rw [NNReal.coe_add, NNReal.coe_add, coe_logFragment R hR
        (Nat.pos_of_mem_primeFactors hpD)]
    _ = ((D.primeFactors.sum (logFragment R) : ℝ≥0) : ℝ) := by
      simp only [primeFragmentPrefix, primeFragmentSuffix, hall]
    _ = _ := sum_primeFactors_logFragment_eq_logSize R hR hD

theorem allowance_add_logSize_le_of_primeFragmentOwner_le (R ξ : ℝ) (hR : 1 < R) {D p : ℕ}
    (hD : Squarefree D)
    (hp : p ∈ activatedPrimeFactors R ξ D) (φ : ℝ≥0 → ℝ≥0) {A : ℝ}
    (hH : (primeFragmentOwner φ R ξ D : ℝ) ≤ A) :
    (φ (logFragment R p) : ℝ) + logSize R D ≤ A + (primeFragmentPrefix R D p : ℝ) := by
  have hpD := (Finset.mem_filter.mp hp).1
  have hle : primeFragmentSuffix R D p + logFragment R p + φ (logFragment R p) ≤
      primeFragmentOwner φ R ξ D := by
    dsimp [primeFragmentOwner]
    exact Finset.le_sup
      (f := fun p => primeFragmentSuffix R D p + logFragment R p + φ (logFragment R p)) hp
  have hpart := primeFragmentPrefix_add_logSize_add_suffix R hR hD hpD
  have hsmall := coe_logFragment R hR (Nat.pos_of_mem_primeFactors hpD)
  have hineq : ((primeFragmentSuffix R D p + logFragment R p + φ (logFragment R p)) : ℝ) ≤ A :=
    le_trans (by exact_mod_cast hle) hH
  simp only [hsmall] at hineq
  linarith

theorem primeFragmentPrefix_add_le_logSize_gcd_add_prefix_lcm (R : ℝ)
    {D E p : ℕ} (hD : Squarefree D) (hE : Squarefree E)
    (hR : 1 < R) :
    (primeFragmentPrefix R D p : ℝ) + (primeFragmentPrefix R E p : ℝ) ≤
      logSize R (D.gcd E) + (primeFragmentPrefix R (D.lcm E) p : ℝ) := by
  classical
  have hd0 : D ≠ 0 := hD.ne_zero
  have he0 : E ≠ 0 := hE.ne_zero
  have hlcm : (D.lcm E).primeFactors = D.primeFactors ∪ E.primeFactors := by
    simpa only [Finsupp.support_sup, Nat.support_factorization] using
      congrArg Finsupp.support (Nat.factorization_lcm hd0 he0)
  have hinter : (D.gcd E).primeFactors = D.primeFactors ∩ E.primeFactors :=
    Nat.primeFactors_gcd hd0 he0
  have hover := Finset.sum_union_inter
    (s₁ := (D.primeFactors.filter (fun q => q < p)))
    (s₂ := (E.primeFactors.filter (fun q => q < p))) (f := logFragment R)
  have hsum : primeFragmentPrefix R (D.lcm E) p + primeFragmentPrefix R (D.gcd E) p =
      primeFragmentPrefix R D p + primeFragmentPrefix R E p := by
    simpa only [primeFragmentPrefix, hlcm, hinter, ← Finset.filter_union,
      ← Finset.filter_inter_distrib] using hover
  have hpart : (primeFragmentPrefix R (D.gcd E) p : ℝ) ≤ logSize R (D.gcd E) := by
    rw [← sum_primeFactors_logFragment_eq_logSize R hR
      (hD.squarefree_of_dvd (Nat.gcd_dvd_left D E))]
    dsimp only [primeFragmentPrefix]
    exact_mod_cast (Finset.sum_le_sum_of_subset (f := logFragment R)
      (Finset.filter_subset (fun q => q < p) (D.gcd E).primeFactors))
  have hre : (primeFragmentPrefix R (D.lcm E) p : ℝ) + (primeFragmentPrefix R (D.gcd E) p : ℝ) =
      (primeFragmentPrefix R D p : ℝ) + (primeFragmentPrefix R E p : ℝ) := by exact_mod_cast hsum
  linarith

theorem squarefree_lcm_nat {D E : ℕ} (hD : Squarefree D) (hE : Squarefree E) :
    Squarefree (D.lcm E) := by
  rw [Nat.squarefree_iff_factorization_le_one (Nat.lcm_ne_zero hD.ne_zero hE.ne_zero)]
  intro p
  rw [Nat.factorization_lcm hD.ne_zero hE.ne_zero]
  exact sup_le (hD.natFactorization_le_one p) (hE.natFactorization_le_one p)

theorem allowance_add_logSize_le_of_cross_owner_bounds (R ξ C : ℝ) (hR : 1 < R) {D E p : ℕ}
    (hE : Squarefree E) (hEp : p ∈ activatedPrimeFactors R ξ D)
    (φ : ℝ≥0 → ℝ≥0) (hmono : Monotone φ)
    (heOwn : (primeFragmentOwner φ R ξ E : ℝ) ≤ C)
    (hcCross : (φ (maxActivatedPrimeFragment R ξ D) : ℝ) ≤ C) :
    (φ (logFragment R p) : ℝ) + logSize R E ≤ C + (primeFragmentPrefix R E p : ℝ) := by
  classical
  let s := E.primeFactors.filter (fun q => p ≤ q)
  by_cases hs : s.Nonempty
  · let q := s.min' hs
    have hqmem : q ∈ s := Finset.min'_mem s hs
    have hqE := (Finset.mem_filter.mp hqmem).1
    have hpq := (Finset.mem_filter.mp hqmem).2
    have hpre : primeFragmentPrefix R E q = primeFragmentPrefix R E p := by
      have heq : E.primeFactors.filter (fun c => c < q) =
          E.primeFactors.filter (fun c => c < p) := by
        refine Finset.filter_congr fun c hc => ⟨?_, fun hcp => hcp.trans_le hpq⟩
        intro hcq
        exact lt_of_not_ge fun hpc =>
          (not_le_of_gt hcq) (Finset.min'_le s c (Finset.mem_filter.mpr ⟨hc, hpc⟩))
      simp only [primeFragmentPrefix, heq]
    have hqa : q ∈ activatedPrimeFactors R ξ E := Finset.mem_filter.mpr
      ⟨hqE, (Finset.mem_filter.mp hEp).2.trans_le (by exact_mod_cast hpq)⟩
    have chain := allowance_add_logSize_le_of_primeFragmentOwner_le R ξ hR hE hqa φ heOwn
    have hpqFrag : logFragment R p ≤ logFragment R q := by
      apply Real.toNNReal_mono
      apply Real.logb_le_logb_of_le hR
      · exact_mod_cast Nat.pos_of_mem_primeFactors (Finset.mem_filter.mp hEp).1
      · exact_mod_cast hpq
    rw [hpre] at chain
    calc
      (φ (logFragment R p) : ℝ) + logSize R E ≤
          (φ (logFragment R q) : ℝ) + logSize R E := by gcongr; exact hmono hpqFrag
      _ ≤ C + (primeFragmentPrefix R E p : ℝ) := chain
  · have hpre : E.primeFactors.filter (fun c => c < p) = E.primeFactors := by
      apply Finset.filter_eq_self.mpr
      intro c hc
      exact lt_of_not_ge (by intro h; apply hs; exact
        ⟨c, Finset.mem_filter.mpr ⟨hc, h⟩⟩)
    have hcs : (φ (logFragment R p) : ℝ) ≤ C :=
      le_trans (by exact_mod_cast hmono (Finset.le_sup (f := logFragment R) hEp)) hcCross
    have hpre' : logSize R E = (primeFragmentPrefix R E p : ℝ) := by
      simpa only [primeFragmentPrefix, hpre] using
        (sum_primeFactors_logFragment_eq_logSize R hR hE).symm
    linarith

theorem logSize_gcd_lcm_bounds {R B : ℝ} (hR : 1 < R) {D E : ℕ} (D0 : D ≠ 0) (E0 : E ≠ 0)
    (hQ : (R ^ B) < (D.lcm E : ℝ)) :
    let G := logSize R (D.gcd E)
    let Q := logSize R (D.lcm E)
    B < Q ∧ G + Q = logSize R D + logSize R E ∧ 0 ≤ G := by
  have hq0 := Nat.lcm_ne_zero D0 E0
  have hg0 := show D.gcd E ≠ 0 from Nat.gcd_ne_zero_left D0
  have hbq : B < logSize R (D.lcm E) := by
    apply (Real.lt_logb_iff_rpow_lt hR (by exact_mod_cast (Nat.pos_of_ne_zero hq0))).mpr hQ
  have hde : logSize R (D.gcd E) + logSize R (D.lcm E) = logSize R D + logSize R E := by
    unfold logSize
    rw [← Real.logb_mul (Nat.cast_ne_zero.mpr hg0) (Nat.cast_ne_zero.mpr hq0),
      ← Real.logb_mul (Nat.cast_ne_zero.mpr D0) (Nat.cast_ne_zero.mpr E0),
      ← Nat.cast_mul, ← Nat.cast_mul, Nat.gcd_mul_lcm]
  refine ⟨hbq, hde, ?_⟩
  exact Real.logb_nonneg hR (by exact_mod_cast Nat.one_le_iff_ne_zero.mpr hg0)

theorem denseDivisibility_lcm_three_of_nonlinear_owner_bounds
    {R ξ S T B ηD ηE : ℝ}
    (hR : 1 < R) (hξ : 0 ≤ ξ) {D E : ℕ} (hD : Squarefree D) (hE : Squarefree E)
    (hS : logSize R D ≤ S) (hT : logSize R E ≤ T)
    (φD φE : ℝ≥0 → ℝ≥0) (hmonoD : Monotone φD) (hmonoE : Monotone φE)
    (hsum : ∀ u : ℝ≥0, φD u + φE u = 3 * u)
    (hbudget : (B - T + ηD) + (B - S + ηE) ≤ B + ξ)
    (hDsupport : logSize R D ≤ B - T ∨
      ((primeFragmentOwner φD R ξ D : ℝ) ≤ B - T + ηD ∧
        (φE (maxActivatedPrimeFragment R ξ D) : ℝ) ≤ B - S + ηE))
    (hEsupport : logSize R E ≤ B - S ∨
      ((primeFragmentOwner φE R ξ E : ℝ) ≤ B - S + ηE ∧
        (φD (maxActivatedPrimeFragment R ξ E) : ℝ) ≤ B - T + ηD))
    (hQ : (R ^ B) < (D.lcm E : ℝ)) :
    Nonempty (DenseDivisibilityWitness (⟨R ^ ξ, Real.one_le_rpow hR.le hξ⟩) 3 (D.lcm E)) := by
  have hd0 : D ≠ 0 := hD.ne_zero
  have he0 : E ≠ 0 := hE.ne_zero
  obtain ⟨hbq, hde, hg⟩ := logSize_gcd_lcm_bounds hR hd0 he0 hQ
  have hDS : ¬ logSize R D ≤ B - T := by linarith
  have hES : ¬ logSize R E ≤ B - S := by linarith
  replace hDsupport := (hDsupport.resolve_left hDS)
  replace hEsupport := (hEsupport.resolve_left hES)
  apply increasing_prime_criterion _ (squarefree_lcm_nat hD hE)
  intro p hp hpQ hrough
  have hp1 : 0 < (p : ℝ) := by exact_mod_cast hp.pos
  have hchains : (φD (logFragment R p) : ℝ) + (φE (logFragment R p) : ℝ) +
          logSize R D + logSize R E ≤
          (B - T + ηD) + (B - S + ηE) +
            (primeFragmentPrefix R D p : ℝ) + (primeFragmentPrefix R E p : ℝ) := by
    rcases hp.dvd_or_dvd_of_dvd_lcm hpQ with hpIn | hpIn
    · have hpA : p ∈ activatedPrimeFactors R ξ D := Finset.mem_filter.mpr
        ⟨hp.mem_primeFactors hpIn hd0, by simpa using hrough⟩
      have hd_chain := allowance_add_logSize_le_of_primeFragmentOwner_le
        R ξ hR hD hpA φD hDsupport.1
      have he_chain := allowance_add_logSize_le_of_cross_owner_bounds
        R ξ _ hR hE hpA φE hmonoE hEsupport.1 hDsupport.2
      linarith
    · have hpA : p ∈ activatedPrimeFactors R ξ E := Finset.mem_filter.mpr
        ⟨hp.mem_primeFactors hpIn he0, by simpa using hrough⟩
      have he_chain := allowance_add_logSize_le_of_primeFragmentOwner_le
        R ξ hR hE hpA φE hEsupport.1
      have hd_chain := allowance_add_logSize_le_of_cross_owner_bounds
        R ξ _ hR hD hpA φD hmonoD hDsupport.1 hEsupport.2
      linarith
  have hp3 : (φD (logFragment R p) : ℝ) + (φE (logFragment R p) : ℝ) = 3 * logSize R p := by
    rw [← NNReal.coe_add, hsum, NNReal.coe_mul, coe_logFragment R hR hp.pos]
    norm_num
  have hgcap := primeFragmentPrefix_add_le_logSize_gcd_add_prefix_lcm R hD hE hR (p := p)
  have hlt : 3 * logSize R p < ξ + (primeFragmentPrefix R (D.lcm E) p : ℝ) := by linarith
  have hpr : 0 < (((((D.lcm E).primeFactors.filter (fun q => q < p)).prod id : ℕ) : ℝ)) :=
    Nat.cast_pos.mpr (Finset.prod_pos fun q hq =>
      Nat.pos_of_mem_primeFactors (Finset.mem_filter.mp hq).1)
  rw [← logSize_primeFactors_prefix R hR (D.lcm E) p] at hlt
  have hlog : Real.logb R ((p : ℝ) ^ (3 : ℕ)) ≤ ξ +
      logSize R (((D.lcm E).primeFactors.filter (fun q => q < p)).prod id) := by
    simpa only [Real.logb_pow, Nat.cast_ofNat, logSize] using hlt.le
  simpa only [Real.rpow_add (zero_lt_one.trans hR), logSize,
    Real.rpow_logb (zero_lt_one.trans hR) hR.ne' hpr] using
    (Real.logb_le_iff_le_rpow hR (pow_pos hp1 _)).mp hlog

theorem sourceSupport_dvd {R ξ a A C : ℝ} (hR : 1 < R) {D d : ℕ}
    (hd : d ∣ D) (hdpos : 0 < d) (hDpos : 0 < D)
    (φ ψ : ℝ≥0 → ℝ≥0) (hmonopsi : Monotone ψ)
    (hsrc : logSize R D ≤ a ∨
      ((primeFragmentOwner φ R ξ D : ℝ) ≤ A ∧ (ψ (maxActivatedPrimeFragment R ξ D) : ℝ) ≤ C)) :
    logSize R d ≤ a ∨
      ((primeFragmentOwner φ R ξ d : ℝ) ≤ A ∧ (ψ (maxActivatedPrimeFragment R ξ d) : ℝ) ≤ C) := by
  classical
  have hpf := Nat.primeFactors_mono hd hDpos.ne'
  have hactive : activatedPrimeFactors R ξ d ⊆ activatedPrimeFactors R ξ D :=
    Finset.filter_subset_filter _ hpf
  rcases hsrc with h | ⟨hH, hM⟩
  · left
    apply le_trans ?_ h
    exact Real.logb_le_logb_of_le hR (by exact_mod_cast hdpos)
      (by exact_mod_cast Nat.le_of_dvd hDpos hd)
  · right
    have hmax : maxActivatedPrimeFragment R ξ d ≤ maxActivatedPrimeFragment R ξ D :=
      Finset.sup_mono hactive
    have hmask : (ψ (maxActivatedPrimeFragment R ξ d) : ℝ) ≤ C :=
      le_trans (by exact_mod_cast hmonopsi hmax) hM
    refine ⟨?_, hmask⟩
    have hsup : primeFragmentOwner φ R ξ d ≤ primeFragmentOwner φ R ξ D := by
      apply (Finset.sup_mono_fun ?_).trans (Finset.sup_mono hactive)
      intro p _
      exact add_le_add_left (add_le_add_left
        (Finset.sum_le_sum_of_subset (Finset.filter_subset_filter _ hpf)) _) _
    exact le_trans (by exact_mod_cast hsup) hH

theorem physicalOwner_sum (L u : ℝ≥0) :
    physicalOuterOwner L u + physicalInnerOwner L u = 3 * u := by
  dsimp [physicalOuterOwner, physicalInnerOwner]
  rw [add_left_comm, add_comm (min _ _) (_ - _), tsub_add_min]
  ring

theorem physicalOwner_inner_eq (L u : ℝ≥0) :
    physicalInnerOwner L u = 3 * u - physicalOuterOwner L u := by
  apply eq_tsub_of_add_eq
  simpa only [add_comm] using physicalOwner_sum L u

theorem physicalOuter_mono (L : ℝ≥0) : Monotone (physicalOuterOwner L) :=
  fun _ _ h => min_le_min_right _ (mul_le_mul_of_nonneg_left h zero_le)

theorem physicalInner_mono (L : ℝ≥0) : Monotone (physicalInnerOwner L) := by
  intro u v huv
  dsimp [physicalInnerOwner]
  gcongr

theorem logSize_prime_le_prefix_of_owner_bound {R ξ c : ℝ} (hR : 1 < R) {D : ℕ}
    (hD : Squarefree D) (hcore : c < logSize R D)
    (hs : logSize R D ≤ c ∨
      (primeFragmentOwner id R ξ D : ℝ) ≤ c + ξ)
    {p : ℕ} (hpD : p ∈ D.primeFactors) :
    logSize R p ≤ ξ + (primeFragmentPrefix R D p : ℝ) := by
  by_cases ha : p ∈ activatedPrimeFactors R ξ D
  · have ho := allowance_add_logSize_le_of_primeFragmentOwner_le
      R ξ hR hD ha id (hs.resolve_left (not_le_of_gt hcore))
    rw [id_eq, coe_logFragment R hR (Nat.pos_of_mem_primeFactors hpD)] at ho
    linarith
  · have hsmall : (p : ℝ) ≤ R ^ ξ := by
      simpa only [activatedPrimeFactors, Finset.mem_filter, hpD, true_and, not_lt] using ha
    have hpsize : logSize R p ≤ ξ := (Real.logb_le_iff_le_rpow
      hR (by exact_mod_cast Nat.pos_of_mem_primeFactors hpD)).mpr hsmall
    exact hpsize.trans (le_add_of_nonneg_right (NNReal.coe_nonneg _))

theorem denseDivisibility_primeFactors_prefix_of_owner_bound {R ξ c : ℝ} (hR : 1 < R)
    (hξ : 0 ≤ ξ) {D : ℕ}
    (hD : Squarefree D) (hcore : c < logSize R D)
    (hs : logSize R D ≤ c ∨
      (primeFragmentOwner id R ξ D : ℝ) ≤ c + ξ) (p : ℕ) :
    Nonempty (DenseDivisibilityWitness (⟨R ^ ξ, Real.one_le_rpow hR.le hξ⟩) 1
      (((D.primeFactors.filter (fun q => q < p)).prod id : ℕ))) := by
  classical
  refine denseDivisibility_of_finset_chain 1 _ _
    (fun q hq => Nat.pos_of_mem_primeFactors (Finset.mem_filter.mp hq).1) ?_
  intro q hq
  right
  have hqp := (Finset.mem_filter.mp hq).2
  have heq : (D.primeFactors.filter (fun t => t < p)).filter (fun t => t < q) =
      D.primeFactors.filter (fun t => t < q) := by
    rw [Finset.filter_filter]
    exact Finset.filter_congr fun t _ => and_iff_right_of_imp (fun ht => ht.trans hqp)
  rw [heq, pow_one]
  have hchain := logSize_prime_le_prefix_of_owner_bound hR hD hcore hs (Finset.mem_filter.mp hq).1
  rw [← logSize_primeFactors_prefix R hR D q] at hchain
  have hprPos : 0 < (((D.primeFactors.filter (fun t => t < q)).prod id : ℕ) : ℝ) :=
    Nat.cast_pos.mpr (Finset.prod_pos fun t ht =>
      Nat.pos_of_mem_primeFactors (Finset.mem_filter.mp ht).1)
  simpa only [Real.rpow_add (zero_lt_one.trans hR), logSize,
    Real.rpow_logb (zero_lt_one.trans hR) hR.ne' hprPos] using
    (Real.logb_le_iff_le_rpow hR
      (by exact_mod_cast Nat.pos_of_mem_primeFactors (Finset.mem_filter.mp hq).1)).mp hchain

theorem logSize_prime_le_lcm_prefix_sub_prefix {R ξ S T B : ℝ} (hR : 1 < R) {D E : ℕ}
    (hD : Squarefree D) (hE : Squarefree E) (hguard : 2 * S - T ≤ B + ξ)
    (hS : logSize R D ≤ S)
    (hsD : (primeFragmentOwner id R ξ D : ℝ) ≤ B - T + ξ)
    (hsE : (primeFragmentOwner id R ξ E : ℝ) ≤ B - S + ξ)
    (hQ : R ^ B < (D.lcm E : ℝ)) {p : ℕ} (hpD : p ∈ D.primeFactors) :
    logSize R p ≤ ξ + (primeFragmentPrefix R (D.lcm E) p : ℝ) -
      (primeFragmentPrefix R D p : ℝ) := by
  classical
  have hbud := logSize_gcd_lcm_bounds hR hD.ne_zero hE.ne_zero hQ
  have hgcap := primeFragmentPrefix_add_le_logSize_gcd_add_prefix_lcm R hD hE hR (p := p)
  by_cases ha : p ∈ activatedPrimeFactors R ξ D
  · have hcap : (maxActivatedPrimeFragment R ξ D : ℝ) ≤ B - S + ξ := by
      obtain ⟨q, hq, hmax⟩ := Finset.exists_mem_eq_sup
        (activatedPrimeFactors R ξ D) ⟨p, ha⟩ (logFragment R)
      have hle : ((primeFragmentSuffix R D q + logFragment R q + logFragment R q : ℝ≥0) : ℝ) ≤
          B - T + ξ := by
        trans (primeFragmentOwner id R ξ D : ℝ)
        · exact_mod_cast (Finset.le_sup
            (f := fun t => primeFragmentSuffix R D t + logFragment R t + id (logFragment R t)) hq)
        · exact hsD
      have ht := NNReal.coe_nonneg (primeFragmentSuffix R D q)
      change maxActivatedPrimeFragment R ξ D = logFragment R q at hmax
      rw [hmax]
      simp only [NNReal.coe_add] at hle
      linarith
    have hcross := allowance_add_logSize_le_of_cross_owner_bounds
      R ξ (B - S + ξ) hR hE ha id monotone_id hsE hcap
    rw [id_eq, coe_logFragment R hR (Nat.pos_of_mem_primeFactors hpD)] at hcross
    linarith [hbud.1, hbud.2.1]
  · have hsmall : (p : ℝ) ≤ R ^ ξ := by
      simpa only [activatedPrimeFactors, Finset.mem_filter, hpD, true_and, not_lt] using ha
    have hx := (Real.logb_le_iff_le_rpow hR
      (by exact_mod_cast Nat.pos_of_mem_primeFactors hpD)).mpr hsmall
    have hq0 := Nat.lcm_ne_zero hD.ne_zero hE.ne_zero
    have hmono : primeFragmentPrefix R D p ≤ primeFragmentPrefix R (D.lcm E) p := by
      dsimp [primeFragmentPrefix]
      exact Finset.sum_le_sum_of_subset (Finset.filter_subset_filter _
        (Nat.primeFactors_mono (Nat.dvd_lcm_left _ _) hq0))
    have hm : (primeFragmentPrefix R D p : ℝ) ≤ primeFragmentPrefix R (D.lcm E) p := by
      exact_mod_cast hmono
    change logSize R p ≤ ξ + _ - _
    change logSize R p ≤ ξ at hx
    linarith

theorem natCast_le_rpow_mul_of_logSize_le_add {R ξ : ℝ} (hR : 1 < R)
    (p : ℕ) (hp0 : 0 < p) (N : ℕ) (hn0 : 0 < N)
    (hlog : logSize R p ≤ ξ + logSize R N) :
    (p : ℝ) ≤ (R ^ ξ : ℝ) * (N : ℝ) := by
  simpa only [Real.rpow_add (zero_lt_one.trans hR), logSize,
    Real.rpow_logb (zero_lt_one.trans hR) hR.ne' (Nat.cast_pos.mpr hn0)] using
    (Real.logb_le_iff_le_rpow hR (by exact_mod_cast hp0)).mp hlog

theorem natCast_le_rpow_mul_div_of_logSize_le_add_sub {R ξ : ℝ} (hR : 1 < R)
    (p : ℕ) (hp0 : 0 < p) (N d : ℕ)
    (hn0 : 0 < N) (hd0 : 0 < d) (hlog : logSize R p ≤ ξ + logSize R N - logSize R d) :
    (p : ℝ) ≤ (R ^ ξ : ℝ) * (N : ℝ) / d := by
  simpa only [Real.rpow_sub (zero_lt_one.trans hR), Real.rpow_add (zero_lt_one.trans hR),
    logSize, Real.rpow_logb (zero_lt_one.trans hR) hR.ne' (Nat.cast_pos.mpr hn0),
    Real.rpow_logb (zero_lt_one.trans hR) hR.ne' (Nat.cast_pos.mpr hd0)] using
    (Real.logb_le_iff_le_rpow hR (by exact_mod_cast hp0)).mp hlog

theorem denseDivisibility_lcm_two_of_owner_bounds {R ξ S T B : ℝ} (hR : 1 < R)
    (hξ : 0 ≤ ξ) {D E : ℕ}
    (hD : Squarefree D) (hE : Squarefree E)
    (hS : logSize R D ≤ S) (hT : logSize R E ≤ T)
    (hg1 : 2 * S - T ≤ B + ξ) (hg2 : 2 * T - S ≤ B + ξ)
    (hDs : logSize R D ≤ B - T ∨
      (primeFragmentOwner id R ξ D : ℝ) ≤ B - T + ξ)
    (hEs : logSize R E ≤ B - S ∨
      (primeFragmentOwner id R ξ E : ℝ) ≤ B - S + ξ)
    (hQ : R ^ B < (D.lcm E : ℝ)) : Nonempty (DenseDivisibilityWitness
      ⟨R ^ ξ, Real.one_le_rpow hR.le hξ⟩ 2 (D.lcm E)) := by
  classical
  have hqf : Squarefree (D.lcm E) := squarefree_lcm_nat hD hE
  have hb := logSize_gcd_lcm_bounds hR hD.ne_zero hE.ne_zero hQ
  have hcoreD : B - T < logSize R D := by linarith [hb.1, hb.2.1, hb.2.2]
  have hcoreE : B - S < logSize R E := by linarith [hb.1, hb.2.1, hb.2.2]
  have hsD := hDs.resolve_left (not_le_of_gt hcoreD)
  have hsE := hEs.resolve_left (not_le_of_gt hcoreE)
  let Q := D.lcm E
  have go : ∀ (s : Finset ℕ), (s ⊆ Q.primeFactors) →
      (∀ q ∈ s, ∀ q' ∈ Q.primeFactors, q' < q → q' ∈ s) →
      Nonempty (DenseDivisibilityWitness ⟨R ^ ξ, Real.one_le_rpow hR.le hξ⟩ 2 (s.prod id)) := by
    intro s
    refine Finset.induction_on_max s ?_ ?_
    · intro _ _; simpa using denseDivisibility_one 2 ⟨R ^ ξ, Real.one_le_rpow hR.le hξ⟩
    · intro p s hmax ih hs hdown
      have hpQ : p ∈ Q.primeFactors := hs (Finset.mem_insert_self ..)
      have hp : p.Prime := Nat.prime_of_mem_primeFactors hpQ
      have hpD_or : p ∣ D ∨ p ∣ E := hp.dvd_or_dvd_of_dvd_lcm (Nat.dvd_of_mem_primeFactors hpQ)
      have hpns : p ∉ s := fun h => (lt_irrefl p) (hmax p h)
      have hs' : s ⊆ Q.primeFactors := fun q hq => hs (Finset.mem_insert_of_mem hq)
      have hpre : s = Q.primeFactors.filter (fun q => q < p) := by
        ext q
        simp only [Finset.mem_filter]
        constructor
        · exact fun h => ⟨hs' h, hmax q h⟩
        · rintro ⟨hQq, hl⟩
          rcases Finset.mem_insert.mp (hdown _ (Finset.mem_insert_self ..) _ hQq hl) with hEq | hMem
          · omega
          · exact hMem
      have hlogN : logSize R (s.prod id) = (primeFragmentPrefix R Q p : ℝ) := by
        rw [hpre]
        exact logSize_primeFactors_prefix R hR Q p
      have hN := ih hs' (by
        rw [hpre]
        intro q hq q' hq' hlt
        exact Finset.mem_filter.mpr ⟨hq', hlt.trans (Finset.mem_filter.mp hq).2⟩)
      have hns0 : 0 < s.prod id := denseDivisibility_pos hN
      have hpns' : ¬ p ∣ s.prod id :=
        hp.prime.not_dvd_finsetProd fun q hq =>
          Nat.not_dvd_of_pos_of_lt (Nat.pos_of_mem_primeFactors (hs' hq)) (hmax q hq)
      have oneSide (X : ℕ) (hx : Squarefree X)
          (hsub : X.primeFactors ⊆ Q.primeFactors) (hxprime : p ∈ X.primeFactors)
          (hy : logSize R p ≤ ξ + (primeFragmentPrefix R Q p : ℝ) - (primeFragmentPrefix R X p : ℝ))
          (hc : ∃ c, c < logSize R X ∧ (logSize R X ≤ c ∨
            (primeFragmentOwner id R ξ X : ℝ) ≤ c + ξ)) :
          Nonempty (DenseDivisibilityWitness
            ⟨R ^ ξ, Real.one_le_rpow hR.le hξ⟩ 2 ((s.prod id) * p)) := by
        obtain ⟨c, hc, hrc⟩ := hc
        have hdense := denseDivisibility_primeFactors_prefix_of_owner_bound hR hξ hx hc hrc p
        let d := (X.primeFactors.filter (fun q => q < p)).prod id
        have ddvd : d ∣ s.prod id := by
          rw [hpre]
          exact Finset.prod_dvd_prod_of_subset _ _ _ (Finset.filter_subset_filter _ hsub)
        have hlogd : logSize R d = (primeFragmentPrefix R X p : ℝ) :=
          logSize_primeFactors_prefix R hR X p
        have hdPos : 0 < d := denseDivisibility_pos hdense
        have hp1 := logSize_prime_le_prefix_of_owner_bound hR hx hc hrc hxprime
        apply balanced_prime_insert ⟨R ^ ξ, Real.one_le_rpow hR.le hξ⟩ hN hp hpns' ddvd hdense
        · apply natCast_le_rpow_mul_of_logSize_le_add hR p hp.pos d hdPos
          rw [hlogd]
          exact hp1
        · apply natCast_le_rpow_mul_div_of_logSize_le_add_sub hR p hp.pos (s.prod id) d hns0 hdPos
          rw [hlogN, hlogd]
          exact hy
      rw [Finset.prod_insert hpns, mul_comm]
      rcases hpD_or with hpdm | hpem
      · refine oneSide D hD (Nat.primeFactors_mono (Nat.dvd_lcm_left _ _) hqf.ne_zero)
          (hp.mem_primeFactors hpdm hD.ne_zero) ?_ ⟨B - T, hcoreD, hDs⟩
        simpa only [Q] using
          logSize_prime_le_lcm_prefix_sub_prefix hR hD hE hg1 hS hsD hsE hQ
            (hp.mem_primeFactors hpdm hD.ne_zero)
      · refine oneSide E hE (Nat.primeFactors_mono (Nat.dvd_lcm_right _ _) hqf.ne_zero)
          (hp.mem_primeFactors hpem hE.ne_zero) ?_ ⟨B - S, hcoreE, hEs⟩
        have hsw : R ^ B < (E.lcm D : ℝ) := by simpa [Nat.lcm_comm] using hQ
        simpa [Q, Nat.lcm_comm] using (logSize_prime_le_lcm_prefix_sub_prefix hR hE hD hg2 hT hsE
          hsD hsw
          (hp.mem_primeFactors hpem hE.ne_zero))
  have htop := go Q.primeFactors (by rfl) (by aesop)
  simpa [Q, Nat.prod_primeFactors_of_squarefree hqf] using htop

theorem denseDivisibility_lcm_one_of_owner_bound {R ξ S T B : ℝ} (hR : 1 < R) (hξ : 0 ≤ ξ) {D E : ℕ}
    (hD : Squarefree D) (hE : Squarefree E)
    (_hS : logSize R D ≤ S) (hT : logSize R E ≤ T)
    (hguard : 2 * T ≤ B + ξ)
    (hDs : logSize R D ≤ B - T ∨
      (primeFragmentOwner id R ξ D : ℝ) ≤ B - T + ξ)
    (hQ : R ^ B < (D.lcm E : ℝ)) : Nonempty (DenseDivisibilityWitness
      ⟨R ^ ξ, Real.one_le_rpow hR.le hξ⟩ 1 (D.lcm E)) := by
  classical
  let Y : Set.Ici (1 : ℝ) := ⟨R ^ ξ, Real.one_le_rpow hR.le hξ⟩
  have hb := logSize_gcd_lcm_bounds hR hD.ne_zero hE.ne_zero hQ
  have hcore : B - T < logSize R D := by linarith [hb.1, hb.2.1, hb.2.2]
  have hwhole : Nonempty (DenseDivisibilityWitness Y 1 D) := by
    have hpre := denseDivisibility_primeFactors_prefix_of_owner_bound hR hξ hD hcore hDs (D+1)
    have hset : D.primeFactors.filter (fun q => q < D + 1) = D.primeFactors :=
      Finset.filter_eq_self.mpr fun q hq => Nat.lt_succ_of_le (Nat.le_of_mem_primeFactors hq)
    rw [hset] at hpre
    simpa only [id_eq, Nat.prod_primeFactors_of_squarefree hD] using hpre
  have hpush : (E : ℝ) ≤ (Y : ℝ) * (D : ℝ) := by
    apply natCast_le_rpow_mul_of_logSize_le_add (ξ := ξ) hR E (Nat.pos_of_ne_zero hE.ne_zero) D
      (Nat.pos_of_ne_zero hD.ne_zero)
    linarith [hT, hb.1, hb.2.1, hb.2.2]
  have hquot : 0 < E / D.gcd E :=
    Nat.div_gcd_pos_of_pos_right D (Nat.pos_of_ne_zero hE.ne_zero)
  have hbound : ((E / D.gcd E : ℕ) : ℝ) ≤ (Y : ℝ) * (D : ℝ) :=
    (Nat.cast_le.mpr (Nat.div_le_self E (D.gcd E))).trans hpush
  have hnew := denseDivisibility_mul_insert hwhole hquot
    (Or.inr (by simpa only [pow_one] using hbound))
  simpa only [Nat.lcm_eq_mul_div, Nat.mul_div_assoc D (Nat.gcd_dvd_right D E)] using hnew

theorem denseDivisibility_lcm_two_of_common_owner_bounds {R ξ T B : ℝ} (hR : 1 < R) (hξ : 0 ≤ ξ)
    (hg : 0 ≤ B - T + ξ)
    {D E : ℕ} (hD : Squarefree D) (hE : Squarefree E)
    (hS : logSize R D ≤ T) (hT : logSize R E ≤ T)
    (hsD : logSize R D ≤ B - T ∨
      (primeFragmentOwner id R ξ D : ℝ) ≤ B - T + ξ)
    (hsE : logSize R E ≤ B - T ∨
      (primeFragmentOwner id R ξ E : ℝ) ≤ B - T + ξ)
    (hQ : R ^ B < (D.lcm E : ℝ)) : Nonempty (DenseDivisibilityWitness
      ⟨R ^ ξ, Real.one_le_rpow hR.le hξ⟩ 2 (D.lcm E)) := by
  have ht : 2 * T - T ≤ B + ξ := by linarith
  exact denseDivisibility_lcm_two_of_owner_bounds hR hξ hD hE hS hT ht ht hsD hsE hQ

section
open Polynomial

theorem quotient_single_dense (q d : ℕ) (hq : 0 < q) (hd : d ∣ q)
    (y : ℝ) (hy : 1 ≤ y)
    (h : ∀ X : ℝ, 1 ≤ X → X ≤ y * (q : ℝ) →
      ∃ v : ℕ, v ∣ q ∧ X / y ≤ (v : ℝ) ∧ (v : ℝ) ≤ X) :
    ∀ Z : ℝ, 1 ≤ Z → Z ≤ (y * (d : ℝ)) * (q / d : ℕ) →
      ∃ w : ℕ, w ∣ q / d ∧ Z / (y * (d : ℝ)) ≤ (w : ℝ) ∧ (w : ℝ) ≤ Z := by
  have hd0 : 0 < d := Nat.pos_of_dvd_of_pos hd hq
  have hD : (0 : ℝ) < d := by exact_mod_cast hd0
  have hY : 0 < y := lt_of_lt_of_le zero_lt_one hy
  intro Z hZ hZ'
  have hyq : (y * (d : ℝ)) * (q / d : ℕ) = y * (q : ℝ) := by
    rw [mul_assoc, ← Nat.cast_mul, Nat.mul_div_cancel' hd]
  obtain ⟨v, hv, hlo, hhi⟩ := h Z hZ (hyq ▸ hZ')
  let w : ℕ := v / Nat.gcd v d
  have hwdvd : w ∣ q / d := by
    apply (Nat.dvd_div_iff_mul_dvd hd).2
    have heq : d * w = Nat.lcm d v := by
      dsimp only [w]
      rw [Nat.lcm_eq_mul_div, Nat.gcd_comm d v, Nat.mul_div_assoc _ (Nat.gcd_dvd_left v d)]
    rw [heq]
    exact Nat.lcm_dvd hd hv
  have hle : (w : ℝ) ≤ v := by exact_mod_cast Nat.div_le_self v (Nat.gcd v d)
  have hmul : (v : ℝ) ≤ (w : ℝ) * d := by
    have heq : w * Nat.gcd v d = v := Nat.div_mul_cancel (Nat.gcd_dvd_left v d)
    have hg : (Nat.gcd v d : ℝ) ≤ d := by exact_mod_cast Nat.gcd_le_right v hd0
    calc
      (v : ℝ) = (w : ℝ) * Nat.gcd v d := by exact_mod_cast heq.symm
      _ ≤ (w : ℝ) * d := mul_le_mul_of_nonneg_left hg (Nat.cast_nonneg _)
  refine ⟨w, hwdvd, ?_, hle.trans hhi⟩
  apply (div_le_iff₀ (mul_pos hY hD)).2
  have hh : Z ≤ y * (w : ℝ) * (d : ℝ) := by
    calc
      Z ≤ (v : ℝ) * y := (div_le_iff₀ hY).1 hlo
      _ ≤ (w : ℝ) * (d : ℝ) * y := mul_le_mul_of_nonneg_right hmul hY.le
      _ = y * (w : ℝ) * (d : ℝ) := by ring
  nlinarith only [hh]

theorem exists_coprime_factorization_of_dense_divisors (q d : ℕ) (hq : Squarefree q) (hd : d ∣ q)
    (y : ℝ) (hy : 1 ≤ y)
    (hdense : ∀ X : ℝ, 1 ≤ X → X ≤ y * (q : ℝ) →
      ∃ v : ℕ, v ∣ q ∧ X / y ≤ (v : ℝ) ∧ (v : ℝ) ≤ X) :
    ∃ r s : ℕ, Nat.Coprime r s ∧ r * s = q / d ∧
      Real.sqrt (r : ℝ) ≤ ((q : ℝ) * y) ^ (1 / 6 : ℝ) ∧
      Real.sqrt (Real.sqrt (s : ℝ)) ≤ ((q : ℝ) * y) ^ (1 / 6 : ℝ) := by
  have hqpos : 0 < q := Nat.pos_of_ne_zero hq.ne_zero
  have hdpos : 0 < d := Nat.pos_of_dvd_of_pos hd hqpos
  let t := q / d
  let Y := y * (d : ℝ)
  let P := (q : ℝ) * y
  let Z := P ^ (1 / 3 : ℝ)
  have hYP : Y * (t : ℝ) = P := by
    dsimp only [Y, t, P]
    rw [mul_assoc, ← Nat.cast_mul, Nat.mul_div_cancel' hd, mul_comm]
  have hpone : 1 ≤ P := one_le_mul_of_one_le_of_one_le (by exact_mod_cast hqpos) hy
  have hppos : 0 < P := lt_of_lt_of_le zero_lt_one hpone
  have hZlo : 1 ≤ Z := Real.one_le_rpow hpone (by norm_num)
  have hZhi : Z ≤ Y * (t : ℝ) := hYP ▸ Real.rpow_le_self_of_one_le hpone (by norm_num)
  obtain ⟨r, hr, hrlo, hrhi⟩ := quotient_single_dense q d hqpos hd y hy hdense Z hZlo hZhi
  let s : ℕ := t / r
  have hrs : r * s = t := Nat.mul_div_cancel' hr
  have htS : Squarefree t := hq.squarefree_of_dvd (Nat.div_dvd_of_dvd hd)
  have hcop : Nat.Coprime r s := Nat.coprime_of_squarefree_mul (by rwa [hrs])
  have hYpos : 0 < Y := mul_pos (lt_of_lt_of_le zero_lt_one hy) (by exact_mod_cast hdpos)
  have hZle : Z ≤ Y * (r : ℝ) := by
    simpa only [mul_comm] using ((div_le_iff₀ hYpos).1 hrlo)
  have hPlaw : Z * P ^ (2 / 3 : ℝ) = P := by
    rw [← Real.rpow_add hppos]
    norm_num [Z]
  have hsmul : Z * (s : ℝ) ≤ P := by
    calc
      _ ≤ Y * (r : ℝ) * (s : ℝ) := mul_le_mul_of_nonneg_right hZle (Nat.cast_nonneg _)
      _ = P := by rw [mul_assoc, ← Nat.cast_mul, hrs, hYP]
  have hsle : (s : ℝ) ≤ P ^ (2 / 3 : ℝ) := by
    apply le_of_mul_le_mul_left (b := (s : ℝ)) (c := P ^ (2 / 3 : ℝ)) ?_
      (lt_of_lt_of_le zero_lt_one hZlo)
    rwa [hPlaw]
  refine ⟨r, s, hcop, hrs, ?_, ?_⟩
  · calc
      Real.sqrt (r : ℝ) ≤ Real.sqrt Z := Real.sqrt_le_sqrt hrhi
      _ = P ^ (1 / 6 : ℝ) := by rw [Real.sqrt_eq_rpow, ← Real.rpow_mul hppos.le]; norm_num
  · calc
      Real.sqrt (Real.sqrt (s : ℝ)) ≤ Real.sqrt (Real.sqrt (P ^ (2 / 3 : ℝ))) :=
        Real.sqrt_le_sqrt (Real.sqrt_le_sqrt hsle)
      _ = P ^ (1 / 6 : ℝ) := by
        rw [Real.sqrt_eq_rpow, Real.sqrt_eq_rpow, ← Real.rpow_mul hppos.le,
          ← Real.rpow_mul hppos.le]
        norm_num

open Classical in
theorem smoothed_progression_bounds
    (m : Fin 2 → ℕ) (hm : ∀ i, Squarefree (m i))
    (d : ℕ) (hd : d ∣ Nat.lcm (m 0) (m 1)) (c ℓ : Fin 2 → ℤ)
    (β : ℤ) (K : ℕ) (w : ℕ → ℂ) (L : ℝ) (hL0 : 0 ≤ L)
    (U : ℝ) (hu : 3 ≤ U) (X : ℝ) (hX : 1 ≤ X) (P : ℝ) (hp : 0 ≤ P)
    (habs : L * ((12 : ℝ) ^ (Nat.lcm (m 0) (m 1)).primeFactors.card *
      (((Nat.lcm (m 0) (m 1)).divisors.card) : ℝ) * (1 + Real.log (Nat.lcm (m 0) (m 1)))) ≤ P)
    (y : ℝ) (hy : 1 ≤ y)
    (hdense : ∀ Z : ℝ, 1 ≤ Z → Z ≤ y * (Nat.lcm (m 0) (m 1) : ℝ) →
      ∃ v : ℕ, v ∣ Nat.lcm (m 0) (m 1) ∧ Z / y ≤ (v : ℝ) ∧ (v : ℝ) ≤ Z)
    (hv : (if K = 0 then 0 else ‖w (K - 1)‖ + ∑ j ∈ Finset.range (K - 1),
      ‖w (j + 1) - w j‖) ≤ U * L)
    (hw : ‖∑ j ∈ Finset.range K, w j‖ ≤ U * L * X)
    (hkroot : Real.sqrt (K : ℝ) ≤ U * Real.sqrt X) :
    let q : ℕ := Nat.lcm (m 0) (m 1)
    let F : ℤ → ℂ := fun t => ∏ i : Fin 2,
      letI : NeZero (m i) := ⟨(hm i).ne_zero⟩
      reciprocalUnitPhase (m i) (c i : ZMod (m i)) ((t + ℓ i : ℤ) : ZMod (m i))
    let δ : Fin 2 → ℕ := fun i => m i / Nat.gcd (m 0) (m 1)
    let δ' : Fin 2 → ℕ := fun i => δ i / Nat.gcd d (δ i)
    let B : ℝ := ∏ i : Fin 2, (Nat.gcd (c i).natAbs (δ' i) : ℝ) / (δ' i : ℝ)
    let sum : ℂ := ∑ j ∈ Finset.range K, w j * F (β + (d : ℤ) * (j : ℤ))
    (‖sum‖ ≤ (14 * U ^ 2 * P) * (Real.sqrt X * ((q : ℝ) * y) ^ (1 / 6 : ℝ) + X * B)) ∧
    (‖sum‖ ≤ (14 * U ^ 2 * P) * (Real.sqrt ((q / d : ℕ) : ℝ) + X * B)) := by
  let q := Nat.lcm (m 0) (m 1)
  let δ : Fin 2 → ℕ := fun i => m i / Nat.gcd (m 0) (m 1)
  let δ' : Fin 2 → ℕ := fun i => δ i / Nat.gcd d (δ i)
  let B : ℝ := ∏ i : Fin 2, (Nat.gcd (c i).natAbs (δ' i) : ℝ) / (δ' i : ℝ)
  let V : ℝ := if K = 0 then 0 else
    ‖w (K - 1)‖ + ∑ j ∈ Finset.range (K - 1), ‖w (j + 1) - w j‖
  let H := 1 + Real.log (q : ℝ)
  let loss := (12 : ℝ) ^ q.primeFactors.card * (q.divisors.card : ℝ) * H
  have hB : 0 ≤ B := Finset.prod_nonneg (fun _ _ => by positivity)
  have hv0 : 0 ≤ V := by dsimp only [V]; split_ifs <;> positivity
  have hq : Squarefree q := squarefree_lcm_pair (hm 0) (hm 1)
  have hqone : (1 : ℝ) ≤ q := by exact_mod_cast Nat.pos_of_ne_zero hq.ne_zero
  have hH : 1 ≤ H := by dsimp [H]; linarith [Real.log_nonneg hqone]
  have htau : (1 : ℝ) ≤ q.divisors.card := by
    exact_mod_cast Finset.one_le_card.mpr ⟨1, Nat.one_mem_divisors.mpr hq.ne_zero⟩
  have h6le : (6 : ℝ) ^ q.primeFactors.card * H ≤ loss := by
    have hpow : (6 : ℝ) ^ q.primeFactors.card ≤ (12 : ℝ) ^ q.primeFactors.card :=
      pow_le_pow_left₀ (by norm_num) (by norm_num) _
    calc
      (6 : ℝ) ^ q.primeFactors.card * H ≤
          (12 : ℝ) ^ q.primeFactors.card * H := mul_le_mul_of_nonneg_right hpow (by linarith)
      _ ≤ loss := mul_le_mul_of_nonneg_right
        (le_mul_of_one_le_right (by positivity) htau) (by linarith only [hH])
  have hloss : 1 ≤ loss := one_le_mul_of_one_le_of_one_le
    (one_le_mul_of_one_le_of_one_le (one_le_pow₀ (by norm_num)) htau) hH
  have hlabs : L ≤ P := le_trans (by nlinarith only [hloss, hL0]) habs
  obtain ⟨r, s, hco, hrs, hrroot, hsroot⟩ :=
    exists_coprime_factorization_of_dense_divisors q d hq hd y hy hdense
  have hbnd := reciprocalUnitPhase_pair_progression_bounds m hm d r s hd hco hrs c ℓ β K w
  have hmean : ‖∑ j ∈ Finset.range K, w j‖ * B ≤ U * P * X * B := by
    calc
      _ ≤ (U * L * X) * B := mul_le_mul_of_nonneg_right hw hB
      _ ≤ U * P * X * B := by gcongr
  constructor
  · calc
      _ ≤ 7 * V * loss * Real.sqrt (K : ℝ) *
            (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ))) +
            ‖∑ j ∈ Finset.range K, w j‖ * B := hbnd.2
      _ ≤ (14 * U ^ 2 * P) * (Real.sqrt X * ((q : ℝ) * y) ^ (1 / 6 : ℝ) + X * B) := by
        have hprod : V * loss * Real.sqrt (K : ℝ) ≤ U ^ 2 * P * Real.sqrt X := by
          calc
            _ ≤ (U * L) * loss * (U * Real.sqrt X) := by gcongr
            _ = U ^ 2 * (L * loss) * Real.sqrt X := by ring
            _ ≤ U ^ 2 * P * Real.sqrt X := by gcongr
        have hrr : Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ)) ≤
            2 * ((q : ℝ) * y) ^ (1 / 6 : ℝ) := by linarith only [hrroot, hsroot]
        have hdiff : 7 * V * loss * Real.sqrt (K : ℝ) *
              (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ))) ≤
              14 * U ^ 2 * P * (Real.sqrt X * (((q : ℝ) * y) ^ (1 / 6 : ℝ))) := by
          calc
            _ = 7 * (V * loss * Real.sqrt (K : ℝ)) *
                  (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ))) := by ring
            _ = 7 * (V * loss * Real.sqrt (K : ℝ)) *
                  (Real.sqrt (r : ℝ) + Real.sqrt (Real.sqrt (s : ℝ))) := by ring
            _ ≤ 7 * (U ^ 2 * P * Real.sqrt X) * (2 * (((q : ℝ) * y) ^ (1 / 6 : ℝ))) := by
              gcongr
            _ = _ := by ring
        have huu : U ≤ 14 * U ^ 2 := by nlinarith
        nlinarith only [hdiff, hmean,
          mul_le_mul_of_nonneg_right huu (mul_nonneg (mul_nonneg hp (by linarith only [hX])) hB)]
  · calc
      _ ≤ 3 * V * (6 : ℝ) ^ q.primeFactors.card * Real.sqrt ((q / d : ℕ) : ℝ) * H +
            ‖∑ j ∈ Finset.range K, w j‖ * B := hbnd.1
      _ ≤ (14 * U ^ 2 * P) * (Real.sqrt ((q / d : ℕ) : ℝ) + X * B) := by
        have hcomp : V * ((6 : ℝ) ^ q.primeFactors.card * H) ≤ U * P := by
          calc
            _ ≤ (U * L) * loss := by gcongr
            _ = U * (L * loss) := by ring
            _ ≤ _ := by gcongr
        have huu : 3 * U ≤ 14 * U ^ 2 := by nlinarith
        have huu1 : U ≤ 14 * U ^ 2 := by nlinarith
        nlinarith only [hmean,
          mul_le_mul_of_nonneg_right hcomp (mul_nonneg (by norm_num : (0 : ℝ) ≤ 3)
            (Real.sqrt_nonneg ((q / d : ℕ) : ℝ))),
          mul_le_mul_of_nonneg_right huu (mul_nonneg hp (Real.sqrt_nonneg ((q / d : ℕ) : ℝ))),
          mul_le_mul_of_nonneg_right huu1 (mul_nonneg (mul_nonneg hp (by linarith only [hX])) hB)]

open Classical in
theorem reciprocalUnitPhase_pair_smooth_dense_bounds
    (T E C₀ ε : ℝ) (hT : 1 ≤ T) (hE : 0 ≤ E)
    (hC₀ : 0 < C₀) (hε : 0 < ε) :
    ∃ C : ℝ, 0 < C ∧
      ∀ (m : Fin 2 → ℕ) (hm : ∀ i, Squarefree (m i)),
        let q : ℕ := Nat.lcm (m 0) (m 1)
        ∀ (y : ℝ), (hy : 1 ≤ y) →
          (hdense : ∀ X : ℝ, 1 ≤ X → X ≤ y * (q : ℝ) →
            ∃ r : ℕ, r ∣ q ∧ X / y ≤ (r : ℝ) ∧ (r : ℝ) ≤ X) →
          ∀ (d : ℕ), (hd : d ∣ q) → ∀ (c ℓ : Fin 2 → ℤ) (a : ℤ)
          (N t₀ : ℝ), (hNd : (d : ℝ) ≤ N) → (hN : N ≤ (q : ℝ) ^ C₀) →
          ∀ (ψ : ℝ → ℂ), (hψ : ContDiff ℝ 1 ψ) →
          (hψsupport : Function.support ψ ⊆ Set.Icc (-T) T) →
          (hψbounds : ∀ t : ℝ,
            ‖ψ t‖ ≤ (Real.log (2 * (q : ℝ) * N)) ^ E ∧
              ‖deriv ψ t‖ ≤ (Real.log (2 * (q : ℝ) * N)) ^ E) →
          let F : ℤ → ℂ := fun t => ∏ i : Fin 2,
            letI : NeZero (m i) := ⟨(hm i).ne_zero⟩
            reciprocalUnitPhase (m i) (c i : ZMod (m i))
              ((t + ℓ i : ℤ) : ZMod (m i))
          let δ : Fin 2 → ℕ := fun i => m i / Nat.gcd (m 0) (m 1)
          let δ' : Fin 2 → ℕ := fun i => δ i / Nat.gcd d (δ i)
          let B : ℝ := ∏ i : Fin 2,
            (Nat.gcd (c i).natAbs (δ' i) : ℝ) / (δ' i : ℝ)
          let G : ℤ → ℂ := fun n =>
            if Int.ModEq (d : ℤ) n a then
              ψ (((n : ℝ) - t₀) / N) * F n else 0
          let S : ℂ := ∑ n ∈ Finset.Icc
            (⌈t₀ - T * N⌉ : ℤ) (⌊t₀ + T * N⌋ : ℤ), G n
          (∑' n : ℤ, G n) = S ∧
            (‖S‖ ≤ C * (q : ℝ) ^ ε *
              (Real.sqrt (N / (d : ℝ)) * ((q : ℝ) * y) ^ (1 / 6 : ℝ) +
                (N / (d : ℝ)) * B)) ∧
            (‖S‖ ≤ C * (q : ℝ) ^ ε *
              (Real.sqrt ((q / d : ℕ) : ℝ) + (N / (d : ℝ)) * B)) := by
  obtain ⟨D, hDp, hD⟩ := ambient_reciprocal_loss E C₀ ε hE hC₀ hε
  let U := 2 * T + 3
  have hu : 3 ≤ U := by dsimp [U]; linarith
  let C := 14 * U ^ 2 * D
  have hC : 0 < C := mul_pos (by nlinarith) hDp
  refine ⟨C, hC, ?_⟩
  intro m hm q y hy hdense d hd c ℓ a N t₀ hNd hN ψ hψ hψsupport hψbounds
  let F : ℤ → ℂ := fun t => ∏ i : Fin 2,
    letI : NeZero (m i) := ⟨(hm i).ne_zero⟩
    reciprocalUnitPhase (m i) (c i : ZMod (m i)) ((t + ℓ i : ℤ) : ZMod (m i))
  let δ : Fin 2 → ℕ := fun i => m i / Nat.gcd (m 0) (m 1)
  let δ' : Fin 2 → ℕ := fun i => δ i / Nat.gcd d (δ i)
  let B : ℝ := ∏ i : Fin 2, (Nat.gcd (c i).natAbs (δ' i) : ℝ) / (δ' i : ℝ)
  let G : ℤ → ℂ := fun n => if Int.ModEq (d : ℤ) n a then ψ (((n : ℝ) - t₀) / N) * F n else 0
  let lo : ℤ := ⌈t₀ - T * N⌉
  let hi : ℤ := ⌊t₀ + T * N⌋
  let S : ℂ := ∑ n ∈ Finset.Icc lo hi, G n
  have hq : Squarefree q := squarefree_lcm_pair (hm 0) (hm 1)
  have hq0 : 0 < q := Nat.pos_of_ne_zero hq.ne_zero
  have hd0 : 0 < d := Nat.pos_of_dvd_of_pos hd hq0
  have hdd : (0 : ℝ) < d := by exact_mod_cast hd0
  have hNN : 0 < N := lt_of_lt_of_le hdd hNd
  have hNone : 1 ≤ N := le_trans (by exact_mod_cast hd0) hNd
  let X : ℝ := N / (d : ℝ)
  have hX : 1 ≤ X := (le_div_iff₀ hdd).2 (by simpa using hNd)
  let L := (Real.log (2 * (q : ℝ) * N)) ^ E
  have hL0 : 0 ≤ L := by
    apply Real.rpow_nonneg
    apply Real.log_nonneg
    have hqq : (1 : ℝ) ≤ q := by exact_mod_cast hq0
    nlinarith
  have hsum : (∑' n : ℤ, G n) = S := (profile_interval_hasSum T N t₀ hNN ψ hψsupport d a F).tsum_eq
  refine ⟨hsum, ?_⟩
  have hpTN : 1 ≤ T * N := one_le_mul_of_one_le_of_one_le hT hNone
  have hhilo : lo ≤ hi + 1 := by
    have l1 := Int.ceil_lt_add_one (t₀ - T * N)
    have h1 := Int.sub_one_lt_floor (t₀ + T * N)
    have : ((lo : ℝ)) ≤ (hi : ℝ) + 1 := by dsimp [lo, hi]; linarith
    exact_mod_cast this
  let M : ℕ := (hi + 1 - lo).toNat
  have hcastM : (M : ℝ) ≤ 2 * T * N + 1 := by
    have heq : ((M : ℕ) : ℤ) = hi + 1 - lo := Int.toNat_of_nonneg (by omega)
    have hlo := Int.le_ceil (t₀ - T * N)
    have hhi := Int.floor_le (t₀ + T * N)
    have heqR : (M : ℝ) = (hi : ℝ) + 1 - lo := by exact_mod_cast heq
    linarith
  let l : ℤ := ⌈((lo - a : ℤ) : ℚ) / (d : ℚ)⌉
  let u : ℤ := ⌈((lo + (M : ℤ) - a : ℤ) : ℚ) / (d : ℚ)⌉
  let K := (u - l).toNat
  let β := a + (d : ℤ) * l
  let w : ℕ → ℂ := fun j => ψ ((((β + (d : ℤ) * (j : ℤ)) : ℝ) - t₀) / N)
  have hire := integer_interval_modEq_reindex_count lo M d hd0 a
  have hK : (K : ℝ) ≤ (U - 1) * X := by
    have ht := (abs_le.mp hire.2.2).2
    calc
      (K : ℝ) ≤ (M : ℝ) / (d : ℝ) + 1 := by linarith
      _ ≤ (2 * T * N + 1) / (d : ℝ) + 1 := by gcongr
      _ ≤ (U - 1) * X := by
        have hdone : (1 : ℝ) ≤ d := by exact_mod_cast hd0
        dsimp only [U, X]
        field_simp
        nlinarith [hNd]
  have hS : S = ∑ j ∈ Finset.range K, w j * F (β + (d : ℤ) * (j : ℤ)) := by
    calc
      S = (∑ j ∈ Finset.range M,
        if Int.ModEq (d : ℤ) (lo + j) a then ψ (((((lo + (j : ℤ)) : ℤ) : ℝ) - t₀) / N) *
          F (lo + (j : ℤ)) else 0) := by
            dsimp only [S, M, lo, hi]
            rw [Int.Icc_eq_finset_map, Finset.sum_map]
            rfl
      _ = ∑ j ∈ Finset.range K, w j * F (β + (d : ℤ) * (j : ℤ)) := by
        simpa only [w, K, u, l, β, Int.cast_add, Int.cast_mul, Int.cast_natCast] using
          hire.1 (fun n : ℤ => ψ (((n : ℝ) - t₀) / N) * F n)
  let V : ℝ := if K = 0 then 0 else
    ‖w (K - 1)‖ + ∑ n ∈ Finset.range (K - 1), ‖w (n + 1) - w n‖
  have hsamp := progression_sampling ψ hψ L hL0 hψbounds N t₀ d hd0 hNd U (by linarith) β K hK
  have hv : V ≤ U * L := hsamp.1
  have hw : ‖∑ j ∈ Finset.range K, w j‖ ≤ U * L * X := hsamp.2.1
  have hkroot : Real.sqrt (K : ℝ) ≤ U * Real.sqrt X := hsamp.2.2
  have habs := hD q hq N hNone hN
  have hpq : 0 ≤ D * (q : ℝ) ^ ε := by positivity
  have hh := smoothed_progression_bounds m hm d hd c ℓ β K w L hL0 U hu X hX
    (D * (q : ℝ) ^ ε) hpq habs y hy hdense hv hw hkroot
  change (‖S‖ ≤ C * (q : ℝ) ^ ε * (Real.sqrt X * ((q : ℝ) * y) ^ (1 / 6 : ℝ) + X * B)) ∧
    (‖S‖ ≤ C * (q : ℝ) ^ ε * (Real.sqrt ((q / d : ℕ) : ℝ) + X * B))
  rw [hS]
  simpa only [C, mul_assoc] using hh

open Classical in
theorem reciprocalUnitPhase_pair_smooth_class_bounds
    (T A₀ A₁ E₀ E₁ Csrc ε : ℝ) (hT : 1 ≤ T) (ha0 : 0 ≤ A₀) (ha1 : 0 ≤ A₁) (hε : 0 < ε) :
    ∃ C : ℝ, 0 < C ∧
      ∀ (m : Fin 2 → ℕ) (hm : ∀ i, Squarefree (m i)),
        let q : ℕ := Nat.lcm (m 0) (m 1)
        ∀ (y : ℝ), (hy : 1 ≤ y) →
          (hdense : ∀ X : ℝ, 1 ≤ X → X ≤ y * (q : ℝ) →
            ∃ r : ℕ, r ∣ q ∧ X / y ≤ (r : ℝ) ∧ (r : ℝ) ≤ X) →
          ∀ (d : ℕ), (hd : d ∣ q) → ∀ (c ℓ : Fin 2 → ℤ) (a : ℤ)
          (N t₀ : ℝ), (hNd : (d : ℝ) ≤ N) → (hN : N ≤ (q : ℝ) ^ Csrc) →
          ∀ (ψ : ℝ → ℂ), (hψ : ContDiff ℝ 1 ψ) →
          (hψs : Function.support ψ ⊆ Set.Icc (-T) T) →
          (hψb : ∀ t : ℝ, ‖ψ t‖ ≤ A₀ * (Real.log (2 * (q : ℝ) * N)) ^ E₀ ∧
            ‖deriv ψ t‖ ≤ A₁ * (Real.log (2 * (q : ℝ) * N)) ^ E₁) →
          let F : ℤ → ℂ := fun t => ∏ i : Fin 2,
            letI : NeZero (m i) := ⟨(hm i).ne_zero⟩
            reciprocalUnitPhase (m i) (c i : ZMod (m i)) ((t + ℓ i : ℤ) : ZMod (m i))
          let δ : Fin 2 → ℕ := fun i => m i / Nat.gcd (m 0) (m 1)
          let δ' : Fin 2 → ℕ := fun i => δ i / Nat.gcd d (δ i)
          let B : ℝ := ∏ i : Fin 2, (Nat.gcd (c i).natAbs (δ' i) : ℝ) / (δ' i : ℝ)
          let G : ℤ → ℂ := fun n => if Int.ModEq (d : ℤ) n a
            then ψ (((n : ℝ) - t₀) / N) * F n else 0
          let S : ℂ := ∑ n ∈ Finset.Icc (⌈t₀ - T * N⌉ : ℤ) (⌊t₀ + T * N⌋ : ℤ), G n
          (∑' n : ℤ, G n) = S ∧
            (‖S‖ ≤ C * (q : ℝ) ^ ε * (Real.sqrt (N / (d : ℝ)) * ((q : ℝ) * y) ^ (1 / 6 : ℝ) +
              (N / (d : ℝ)) * B)) ∧ (‖S‖ ≤ C * (q : ℝ) ^ ε * (Real.sqrt ((q / d : ℕ) : ℝ) +
                (N / (d : ℝ)) * B)) := by
  let E := max 0 (max E₀ E₁)
  let C₀ := max 1 Csrc
  let A := max (1 : ℝ) (max (A₀ * max 1 ((Real.log 2) ^ (E₀ - E)))
    (A₁ * max 1 ((Real.log 2) ^ (E₁ - E))))
  have hpA : 0 < A := lt_of_lt_of_le zero_lt_one (le_max_left _ _)
  obtain ⟨C, hpC, hh⟩ := reciprocalUnitPhase_pair_smooth_dense_bounds T E C₀ ε hT
    (le_max_left _ _) (by dsimp [C₀]; linarith [le_max_left (1 : ℝ) Csrc]) hε
  refine ⟨A * C, mul_pos hpA hpC, fun m hm y hy hdense d hd c ℓ a N t₀ hNd hN ψ hψ hψs hψb => ?_⟩
  let q := Nat.lcm (m 0) (m 1)
  let F : ℤ → ℂ := fun t => ∏ i : Fin 2,
    letI : NeZero (m i) := ⟨(hm i).ne_zero⟩
    reciprocalUnitPhase (m i) (c i : ZMod (m i)) ((t + ℓ i : ℤ) : ZMod (m i))
  let δ : Fin 2 → ℕ := fun i => m i / Nat.gcd (m 0) (m 1)
  let δ' : Fin 2 → ℕ := fun i => δ i / Nat.gcd d (δ i)
  let B : ℝ := ∏ i : Fin 2, (Nat.gcd (c i).natAbs (δ' i) : ℝ) / (δ' i : ℝ)
  have hq : Squarefree q := squarefree_lcm_pair (hm 0) (hm 1)
  have hd0 : 0 < d := Nat.pos_of_dvd_of_pos hd (Nat.pos_of_ne_zero hq.ne_zero)
  have hNd0 : (1 : ℝ) ≤ N := le_trans (by exact_mod_cast hd0) hNd
  have hN0 : 0 < N := lt_of_lt_of_le zero_lt_one hNd0
  have hqone : (1 : ℝ) ≤ q := by exact_mod_cast Nat.pos_of_ne_zero hq.ne_zero
  have hsrc : N ≤ (q : ℝ) ^ C₀ :=
    hN.trans (Real.rpow_le_rpow_of_exponent_le hqone (le_max_right _ _))
  let R := Real.log (2 * (q : ℝ) * N)
  have hR : Real.log (2 : ℝ) ≤ R := by
    apply Real.log_le_log (by norm_num)
    nlinarith
  let f := A⁻¹ • ψ
  have hf : ContDiff ℝ 1 f := ContDiff.const_smul (A⁻¹) hψ
  have hfs : Function.support f ⊆ Set.Icc (-T) T :=
    (Function.support_const_smul_subset _ _).trans hψs
  have hsmall (t : ℝ) : ‖f t‖ ≤ R ^ E ∧ ‖deriv f t‖ ≤ R ^ E := by
    have hj0 := (hψb t).1
    have hj1 := (hψb t).2
    have hdiv0 := profile_bound_enlargement A₀ E₀ E R A ha0
      ((le_max_left _ _).trans (le_max_right (0 : ℝ) _)) hR
      ((le_max_left _ _).trans (le_max_right _ _))
    have hdiv1 := profile_bound_enlargement A₁ E₁ E R A ha1
      ((le_max_right _ _).trans (le_max_right (0 : ℝ) _)) hR
      ((le_max_right _ _).trans (le_max_right _ _))
    have hinv : 0 ≤ A⁻¹ := le_of_lt (inv_pos.mpr hpA)
    rw [show f = A⁻¹ • ψ from rfl, deriv_const_smul _ (hψ.differentiable_one t), Pi.smul_apply]
    simp only [norm_smul, Real.norm_of_nonneg hinv]
    constructor
    · simpa only [← mul_assoc, inv_mul_cancel₀ hpA.ne', one_mul] using
        mul_le_mul_of_nonneg_left (hj0.trans hdiv0) hinv
    · simpa only [← mul_assoc, inv_mul_cancel₀ hpA.ne', one_mul] using
        mul_le_mul_of_nonneg_left (hj1.trans hdiv1) hinv
  have hit := hh m hm y hy hdense d hd c ℓ a N t₀ hNd hsrc f hf hfs hsmall
  let g : ℤ → ℂ := fun n => if Int.ModEq (d : ℤ) n a then ψ (((n : ℝ) - t₀) / N) * F n else 0
  let g' : ℤ → ℂ := fun n => if Int.ModEq (d : ℤ) n a then f (((n : ℝ) - t₀) / N) * F n else 0
  let I := Finset.Icc (⌈t₀ - T * N⌉ : ℤ) (⌊t₀ + T * N⌋ : ℤ)
  have heq : g = A • g' := by
    funext n
    by_cases hn : Int.ModEq (d : ℤ) n a
    · simp only [g, g', hn, ↓reduceIte, Pi.smul_apply, f,
        smul_mul_assoc, smul_smul, mul_inv_cancel₀ hpA.ne', one_smul]
    · simp [g, g', hn]
  have summ := (profile_interval_hasSum T N t₀ hN0 f hfs d a F).summable
  have hsum := summ.tsum_const_smul A
  have hsfin : (∑ n ∈ I, g n) = A • (∑ n ∈ I, g' n) := by simp [heq, Finset.smul_sum]
  change (∑' n : ℤ, g' n) = (∑ n ∈ I, g' n) ∧
    (‖∑ n ∈ I, g' n‖ ≤ C * (q : ℝ) ^ ε * (Real.sqrt (N / (d : ℝ)) * ((q : ℝ) * y) ^ (1 / 6 : ℝ) +
        (N / (d : ℝ)) * B)) ∧
    (‖∑ n ∈ I, g' n‖ ≤ C * (q : ℝ) ^ ε * (Real.sqrt ((q / d : ℕ) : ℝ) + (N / (d : ℝ)) * B)) at hit
  change (∑' n : ℤ, g n) = (∑ n ∈ I, g n) ∧
    (‖∑ n ∈ I, g n‖ ≤ (A * C) * (q : ℝ) ^ ε *
      (Real.sqrt (N / (d : ℝ)) * ((q : ℝ) * y) ^ (1 / 6 : ℝ) + (N / (d : ℝ)) * B)) ∧
    (‖∑ n ∈ I, g n‖ ≤ (A * C) * (q : ℝ) ^ ε * (Real.sqrt ((q / d : ℕ) : ℝ) + (N / (d : ℝ)) * B))
  constructor
  · rw [hsfin, heq]
    simpa only [Pi.smul_apply, g'] using
      (hsum.trans (congrArg (fun z : ℂ => A • z) hit.1))
  rw [hsfin, norm_smul, Real.norm_of_nonneg hpA.le]
  constructor <;> nlinarith only [hit.2.1, hit.2.2,
    mul_le_mul_of_nonneg_left hit.2.1 hpA.le, mul_le_mul_of_nonneg_left hit.2.2 hpA.le]

end

/--
Representatives `0 ≤ b < G` of residue classes coprime to `G`; the set is empty for `G = 0`.
-/
def primitiveResidues (G : ℕ) : Finset ℕ :=
  (Finset.range G).filter (fun b => Nat.Coprime b G)

/--
The mass of the finitely supported complex sequence `f` on `n ≡ a` modulo `r`, restricted to
integers coprime to `q`.
-/
noncomputable def coprimeProgressionMass
    (f : ℕ →₀ ℂ) (q r a : ℕ) : ℂ :=
  ∑ n ∈ f.support,
    if n % r = a % r ∧ Nat.Coprime n q then f n else 0

/--
The mass of `f` on the intersection of the congruences `n ≡ a` modulo `r` and `n ≡ b` modulo
`q`, without a separate coprimality restriction.
-/
noncomputable def mixedProgressionMass
    (f : ℕ →₀ ℂ) (q r a b : ℕ) : ℂ :=
  ∑ n ∈ f.support,
    if n % r = a % r ∧ n % q = b % q then f n else 0

/--
The difference of mixed progression masses for residue classes `b₁` and `b₂` modulo `q`, keeping
the class `a` modulo `r` fixed.
-/
noncomputable def deltaZero
    (f : ℕ →₀ ℂ) (q r a b₁ b₂ : ℕ) : ℂ :=
  mixedProgressionMass f q r a b₁ -
    mixedProgressionMass f q r a b₂

/--
The mass in the class `a` modulo `q * r` minus the average, over reduced classes modulo `q`, of
the `q`-coprime mass in the class `a` modulo `r`.
-/
noncomputable def dispersionTerm
    (f : ℕ →₀ ℂ) (q r a : ℕ) : ℂ :=
  progressionMass f (q * r) a -
    coprimeProgressionMass f q r a / (q.totient : ℂ)

/--
The difference between the `q`-coprime progression average modulo `r` and the global
reduced-residue average modulo `q * r`. Together with the dispersion term, it recovers the full
progression discrepancy.
-/
noncomputable def meanTerm
    (f : ℕ →₀ ℂ) (q r a : ℕ) : ℂ :=
  coprimeProgressionMass f q r a / (q.totient : ℂ) -
    reducedMass f (q * r) / ((q * r).totient : ℂ)

theorem primitiveResidues_card (q : ℕ) :
    (primitiveResidues q).card = q.totient := by
  simpa [primitiveResidues, Nat.coprime_comm] using (Nat.totient_eq_card_coprime q).symm

theorem sum_units_eq_primitiveResidues {q : ℕ} [NeZero q] (F : ℕ → ℂ) :
    (∑ u : (ZMod q)ˣ, F (u : ZMod q).val) =
      ∑ b ∈ primitiveResidues q, F b := by
  classical
  refine Finset.sum_bij (fun u _ => (u : ZMod q).val) ?_ ?_ ?_ (fun _ _ => rfl)
  · intro u _
    exact Finset.mem_filter.mpr
      ⟨Finset.mem_range.mpr (ZMod.val_lt _), ZMod.val_coe_unit_coprime u⟩
  · intro u _ v _ huv
    exact Units.ext (ZMod.val_injective q huv)
  · intro b hb
    obtain ⟨hbq, hcop⟩ := Finset.mem_filter.mp hb
    refine ⟨ZMod.unitOfCoprime b hcop, Finset.mem_univ _, ?_⟩
    rw [ZMod.coe_unitOfCoprime, ZMod.val_natCast_of_lt (Finset.mem_range.mp hbq)]

theorem average_surjective_monoidHom {A B : Type*}
    [Group A] [Group B] [Fintype A] [Fintype B]
    (φ : A →* B) (hφ : Function.Surjective φ) (F : B → ℂ) :
    (∑ a, F (φ a)) / (Fintype.card A : ℂ) =
      (∑ b, F b) / (Fintype.card B : ℂ) := by
  classical
  let k := (Finset.univ.filter (fun a => φ a = 1)).card
  have hfiber (b : B) : (Finset.univ.filter (fun a => φ a = b)).card = k :=
    MonoidHom.card_fiber_eq_of_mem_range φ (hφ b) (hφ 1)
  have hsum (H : B → ℂ) : (∑ a, H (φ a)) = (k : ℂ) * ∑ b, H b := by
    rw [← Finset.sum_fiberwise' Finset.univ φ H]
    simp_rw [Finset.sum_const, hfiber, nsmul_eq_mul]
    rw [Finset.mul_sum]
  have hcard : (Fintype.card A : ℂ) = (k : ℂ) * (Fintype.card B : ℂ) := by
    simpa using hsum (fun _ => 1)
  apply (div_eq_div_iff
    (Nat.cast_ne_zero.mpr (Fintype.card_ne_zero (α := A)))
    (Nat.cast_ne_zero.mpr (Fintype.card_ne_zero (α := B)))).mpr
  rw [hsum, hcard]
  ring

theorem average_primitiveResidues_mod
    {G q : ℕ} (hG : 0 < G) (hqG : q ∣ G) (F : ℕ → ℂ) :
    (∑ b ∈ primitiveResidues G, F (b % q)) / (G.totient : ℂ) =
      (∑ b ∈ primitiveResidues q, F b) / (q.totient : ℂ) := by
  let : NeZero G := ⟨hG.ne'⟩
  let : NeZero q := ⟨(Nat.pos_of_dvd_of_pos hqG hG).ne'⟩
  have h := average_surjective_monoidHom (ZMod.unitsMap hqG)
    (ZMod.unitsMap_surjective hqG) (fun u => F (u : ZMod q).val)
  simpa only [ZMod.unitsMap_val, ZMod.cast_eq_val, ZMod.val_natCast,
    sum_units_eq_primitiveResidues (q := G) (fun b => F (b % q)),
    sum_units_eq_primitiveResidues (q := q) F, ZMod.card_units_eq_totient] using h

theorem fullDiscrepancy_eq_dispersion_add_mean
    (f : ℕ →₀ ℂ) (q r a : ℕ) :
    fullDiscrepancy f (q * r) a =
      dispersionTerm f q r a + meanTerm f q r a := by
  unfold fullDiscrepancy dispersionTerm meanTerm
  ring

theorem mixedProgressionMass_diag (f : ℕ →₀ ℂ)
    {q r : ℕ} (hqr : Nat.Coprime q r) (a : ℕ) :
    mixedProgressionMass f q r a a = progressionMass f (q * r) a := by
  unfold mixedProgressionMass progressionMass
  apply Finset.sum_congr rfl
  intro n _
  have hiff : (n % r = a % r ∧ n % q = a % q) ↔
      n % (q * r) = a % (q * r) := by
    change (Nat.ModEq r n a ∧ Nat.ModEq q n a) ↔ Nat.ModEq (q * r) n a
    rw [and_comm]
    exact Nat.modEq_and_modEq_iff_modEq_mul hqr
  simp only [hiff]

theorem sum_reduced_indicator {q : ℕ} (hq : 0 < q) (n : ℕ) (v : ℂ) :
    (∑ b ∈ primitiveResidues q, if n % q = b % q then v else 0) =
      if Nat.Coprime n q then v else 0 := by
  classical
  have hmem : n % q ∈ primitiveResidues q ↔ Nat.Coprime n q := by
    simp only [primitiveResidues, Finset.mem_filter, Finset.mem_range,
      Nat.mod_lt n hq, true_and, ZMod.coprime_mod_iff_coprime]
  calc
    _ = ∑ b ∈ primitiveResidues q, if n % q = b then v else 0 := by
      apply Finset.sum_congr rfl
      intro b hb
      rw [Nat.mod_eq_of_lt (Finset.mem_range.mp (Finset.mem_filter.mp hb).1)]
    _ = if n % q ∈ primitiveResidues q then v else 0 :=
      Finset.sum_ite_eq _ _ (fun _ => v)
    _ = _ := by simp only [hmem]

theorem sum_reduced_mixedProgressionMass (f : ℕ →₀ ℂ)
    {q : ℕ} (hq : 0 < q) (r a : ℕ) :
    (∑ b ∈ primitiveResidues q, mixedProgressionMass f q r a b) =
      coprimeProgressionMass f q r a := by
  classical
  unfold mixedProgressionMass coprimeProgressionMass
  rw [Finset.sum_comm]
  apply Finset.sum_congr rfl
  intro n _
  by_cases hr : n % r = a % r
  · simpa only [hr, true_and] using sum_reduced_indicator hq n (f n)
  · simp only [hr, false_and, ite_false, Finset.sum_const_zero]

theorem dispersionTerm_eq_global_average
    (f : ℕ →₀ ℂ) {G q r : ℕ}
    (hG : 0 < G) (hqr : Nat.Coprime q r) (hqG : q ∣ G) (a : ℕ) :
    dispersionTerm f q r a =
      (∑ b ∈ primitiveResidues G, deltaZero f q r a a b) /
        (G.totient : ℂ) := by
  have hq := Nat.pos_of_dvd_of_pos hqG hG
  have hphi : (G.totient : ℂ) ≠ 0 := by
    exact_mod_cast (Nat.totient_pos.mpr hG).ne'
  have havg : (∑ b ∈ primitiveResidues G, mixedProgressionMass f q r a b) /
      (G.totient : ℂ) = coprimeProgressionMass f q r a / (q.totient : ℂ) := by
    convert average_primitiveResidues_mod hG hqG (mixedProgressionMass f q r a) using 1
    · simp [mixedProgressionMass]
    · rw [sum_reduced_mixedProgressionMass f hq r a]
  calc
    dispersionTerm f q r a = mixedProgressionMass f q r a a -
        (∑ b ∈ primitiveResidues G, mixedProgressionMass f q r a b) /
          (G.totient : ℂ) := by
      rw [mixedProgressionMass_diag f hqr, havg]
      rfl
    _ = _ := by
      simp only [deltaZero, Finset.sum_sub_distrib, Finset.sum_const,
        nsmul_eq_mul, primitiveResidues_card, sub_div]
      field_simp [hphi]

theorem sum_norm_dispersion_le_global_average
    (f : ℕ →₀ ℂ) {G : ℕ} (hG : 0 < G)
    (S : Finset (ℕ × ℕ))
    (hS : ∀ p ∈ S, Nat.Coprime p.1 p.2 ∧ p.1 ∣ G) (a : ℕ) :
    (∑ p ∈ S, ‖dispersionTerm f p.1 p.2 a‖) ≤
      (∑ b ∈ primitiveResidues G,
        ∑ p ∈ S, ‖deltaZero f p.1 p.2 a a b‖) /
          (G.totient : ℝ) := by
  calc
    _ ≤ ∑ p ∈ S,
        (∑ b ∈ primitiveResidues G, ‖deltaZero f p.1 p.2 a a b‖) /
          (G.totient : ℝ) := by
      apply Finset.sum_le_sum
      intro p hp
      rw [dispersionTerm_eq_global_average f hG (hS p hp).1 (hS p hp).2 a,
        norm_div, Complex.norm_natCast]
      exact div_le_div_of_nonneg_right (norm_sum_le _ _) (Nat.cast_nonneg _)
    _ = _ := by rw [← Finset.sum_div, Finset.sum_comm]

/--
Multiplicative convolution of finitely supported complex sequences on `ℕ`, obtained from
multiplication in the monoid algebra. The coefficient at `k` sums `α(m) β(n)` over `m * n = k`.
-/
noncomputable def finiteConvolution (α β : ℕ →₀ ℂ) : ℕ →₀ ℂ :=
  ((MonoidAlgebra.ofCoeff α : MonoidAlgebra ℂ ℕ) *
    (MonoidAlgebra.ofCoeff β : MonoidAlgebra ℂ ℕ)).coeff

/--
The complex-valued indicator that `m` and `n` are both coprime to `q * r` and their product lies
in class `a` modulo `r` and class `b` modulo `q`.
-/
noncomputable def unitMixedKernel (q r a b m n : ℕ) : ℂ :=
  if Nat.Coprime m (q * r) ∧ Nat.Coprime n (q * r) ∧
      (m * n) % r = a % r ∧ (m * n) % q = b % q then 1 else 0

/--
The difference of the two unit-restricted product-congruence indicators for classes `b₁` and
`b₂` modulo `q`, at fixed class `a` modulo `r`.
-/
noncomputable def unitDeltaKernel (q r a b₁ b₂ m n : ℕ) : ℂ :=
  unitMixedKernel q r a b₁ m n - unitMixedKernel q r a b₂ m n

/--
For fixed `r` and `m`, the coefficient-weighted sum over pairs `(q, r) ∈ S` and `n` in the
support of `β` of the unit-restricted congruence difference between `b₁` and `b₂`.
-/
noncomputable def phaseResponse (S : Finset (ℕ × ℕ)) (β : ℕ →₀ ℂ)
    (c : ℕ × ℕ → ℂ) (r a b₁ b₂ m : ℕ) : ℂ :=
  ∑ p ∈ S.filter (fun p => p.2 = r),
    c p * ∑ n ∈ β.support, β n * unitDeltaKernel p.1 r a b₁ b₂ m n

/--
The sum of squared phase-response norms over `m ∈ sm` and second coordinates `r` occurring in
`S`, weighted by `w(m)`. Nonnegativity requires a corresponding assumption on the weights.
-/
noncomputable def dispersionEnergy (sm : Finset ℕ) (w : ℕ → ℝ)
    (S : Finset (ℕ × ℕ)) (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ)
    (a b₁ b₂ : ℕ) : ℝ :=
  ∑ r ∈ S.image Prod.snd, ∑ m ∈ sm,
    w m * ‖phaseResponse S β c r a b₁ b₂ m‖ ^ 2

/--
The elements `m ∈ sm` for which both product-congruence systems hold: `(m, n₁)` at moduli `(q₁,
r)` and `(m, n₂)` at `(q₂, r)`. Each system also requires both factors to be coprime to its
product modulus.
-/
def mixedFiber (sm : Finset ℕ) (q₁ q₂ r a b₁ b₂ n₁ n₂ : ℕ) : Finset ℕ :=
  sm.filter (fun m =>
    Nat.Coprime m (q₁ * r) ∧ Nat.Coprime n₁ (q₁ * r) ∧
    Nat.Coprime m (q₂ * r) ∧ Nat.Coprime n₂ (q₂ * r) ∧
    (m * n₁) % r = a % r ∧ (m * n₁) % q₁ = b₁ % q₁ ∧
    (m * n₂) % r = a % r ∧ (m * n₂) % q₂ = b₂ % q₂)

/--
The sum of real weights `w(m)` over the simultaneous unit-restricted product-congruence fiber
for `(n₁, q₁, b₁)` and `(n₂, q₂, b₂)`.
-/
noncomputable def mixedFiberMass (sm : Finset ℕ) (w : ℕ → ℝ)
    (q₁ q₂ r a b₁ b₂ n₁ n₂ : ℕ) : ℝ :=
  ∑ m ∈ mixedFiber sm q₁ q₂ r a b₁ b₂ n₁ n₂, w m

/--
The conjugate-paired correlation obtained by summing mixed-fiber masses over pairs of moduli
with a common second coordinate and pairs of coefficients of `β`. The first factors are
unstarred and the second factors are conjugated.
-/
noncomputable def mixedCorrelation (sm : Finset ℕ) (w : ℕ → ℝ)
    (S : Finset (ℕ × ℕ)) (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ)
    (a b₁ b₂ : ℕ) : ℂ :=
  ∑ r ∈ S.image Prod.snd,
    ∑ p₁ ∈ S.filter (fun p => p.2 = r),
      ∑ p₂ ∈ S.filter (fun p => p.2 = r),
        c p₁ * star (c p₂) *
          ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
            β n₁ * star (β n₂) *
              (mixedFiberMass sm w p₁.1 p₂.1 r a b₁ b₂ n₁ n₂ : ℂ)

theorem finiteConvolution_pairing (α β : ℕ →₀ ℂ) (K : ℕ → ℂ) :
    (∑ t ∈ (finiteConvolution α β).support, finiteConvolution α β t * K t) =
      ∑ m ∈ α.support, ∑ n ∈ β.support, α m * β n * K (m * n) := by
  change MonoidAlgebra.liftNC (AddMonoidHom.id ℂ) K
    ((MonoidAlgebra.ofCoeff α : MonoidAlgebra ℂ ℕ) * MonoidAlgebra.ofCoeff β) = _
  simp_rw [MonoidAlgebra.mul_def, map_finsuppSum, MonoidAlgebra.liftNC_single,
    AddMonoidHom.id_apply, Finsupp.sum]

theorem mixedProgressionMass_finiteConvolution_eq_unitKernel
    (α β : ℕ →₀ ℂ) (q r a b : ℕ)
    (ha : Nat.Coprime a r) (hb : Nat.Coprime b q) :
    mixedProgressionMass (finiteConvolution α β) q r a b =
      ∑ m ∈ α.support, α m *
        ∑ n ∈ β.support, β n * unitMixedKernel q r a b m n := by
  have hkernel (m n : ℕ) :
      (if (m * n) % r = a % r ∧ (m * n) % q = b % q then (1 : ℂ) else 0) =
        unitMixedKernel q r a b m n := by
    unfold unitMixedKernel
    refine if_congr ?_ rfl rfl
    constructor
    · rintro ⟨hr, hq⟩
      have hp : Nat.Coprime (m * n) (q * r) :=
        Nat.Coprime.mul_right
          ((show Nat.ModEq q (m * n) b from hq).gcd_eq.trans hb)
          ((show Nat.ModEq r (m * n) a from hr).gcd_eq.trans ha)
      exact ⟨hp.coprime_mul_right, hp.coprime_mul_left, hr, hq⟩
    · exact fun h => h.2.2
  simpa only [mixedProgressionMass, hkernel, Finset.mul_sum, mul_assoc,
    mul_ite, mul_one, mul_zero] using
    finiteConvolution_pairing α β
      (fun t => if t % r = a % r ∧ t % q = b % q then (1 : ℂ) else 0)

theorem deltaZero_finiteConvolution_eq_unitKernel
    (α β : ℕ →₀ ℂ) (q r a b₁ b₂ : ℕ)
    (ha : Nat.Coprime a r) (hb₁ : Nat.Coprime b₁ q)
    (hb₂ : Nat.Coprime b₂ q) :
    deltaZero (finiteConvolution α β) q r a b₁ b₂ =
      ∑ m ∈ α.support, α m *
        ∑ n ∈ β.support, β n * unitDeltaKernel q r a b₁ b₂ m n := by
  rw [deltaZero, mixedProgressionMass_finiteConvolution_eq_unitKernel α β q r a b₁ ha hb₁,
    mixedProgressionMass_finiteConvolution_eq_unitKernel α β q r a b₂ ha hb₂]
  simp only [unitDeltaKernel, mul_sub, Finset.sum_sub_distrib]

theorem exists_phases_deltaZero_mass_sq_le
    (α β : ℕ →₀ ℂ) (sm : Finset ℕ) (w : ℕ → ℝ)
    (hsm : α.support ⊆ sm) (hw₀ : ∀ m ∈ sm, 0 ≤ w m)
    (hw₁ : ∀ m ∈ α.support, 1 ≤ w m)
    (G : ℕ) (S : Finset (ℕ × ℕ))
    (hS : ∀ p ∈ S, p.1 * p.2 ∣ G)
    (a b₁ b₂ : ℕ) (ha : Nat.Coprime a G)
    (hb₁ : Nat.Coprime b₁ G) (hb₂ : Nat.Coprime b₂ G) :
    ∃ c : ℕ × ℕ → ℂ,
      (∀ p ∈ S, ‖c p‖ = 1) ∧
      ((∑ p ∈ S, ‖deltaZero (finiteConvolution α β) p.1 p.2 a b₁ b₂‖ : ℝ) : ℂ) =
        (∑ r ∈ S.image Prod.snd, ∑ m ∈ α.support,
          α m * phaseResponse S β c r a b₁ b₂ m) ∧
      (∑ p ∈ S, ‖deltaZero (finiteConvolution α β) p.1 p.2 a b₁ b₂‖) ^ 2 ≤
        (((S.image Prod.snd).card : ℝ) * ∑ m ∈ α.support, ‖α m‖ ^ 2) *
          dispersionEnergy sm w S β c a b₁ b₂ := by
  choose c hc using fun p : ℕ × ℕ => Complex.exists_norm_eq_mul_self
    (deltaZero (finiteConvolution α β) p.1 p.2 a b₁ b₂)
  let R := S.image Prod.snd
  have hlinear :
      ((∑ p ∈ S, ‖deltaZero (finiteConvolution α β) p.1 p.2 a b₁ b₂‖ : ℝ) : ℂ) =
        ∑ r ∈ R, ∑ m ∈ α.support, α m * phaseResponse S β c r a b₁ b₂ m := by
    calc
      _ = ∑ p ∈ S, c p * deltaZero (finiteConvolution α β) p.1 p.2 a b₁ b₂ := by
        rw [Complex.ofReal_sum]
        exact Finset.sum_congr rfl fun p _ => (hc p).2
      _ = ∑ r ∈ R, ∑ p ∈ S.filter (fun p => p.2 = r),
          c p * deltaZero (finiteConvolution α β) p.1 p.2 a b₁ b₂ :=
        (Finset.sum_fiberwise_of_maps_to (s := S) (t := R) (g := Prod.snd)
          (fun _ => Finset.mem_image_of_mem Prod.snd) _).symm
      _ = _ := by
        apply Finset.sum_congr rfl
        intro r _
        calc
          _ = ∑ p ∈ S.filter (fun p => p.2 = r), ∑ m ∈ α.support,
              α m * (c p * ∑ n ∈ β.support, β n * unitDeltaKernel p.1 r a b₁ b₂ m n) := by
            apply Finset.sum_congr rfl
            intro p hp
            rcases Finset.mem_filter.mp hp with ⟨hpS, hpr⟩
            have hpG := hS p hpS
            rw [deltaZero_finiteConvolution_eq_unitKernel α β p.1 p.2 a b₁ b₂
              (ha.of_dvd_right hpG).coprime_mul_left_right
              (hb₁.of_dvd_right hpG).coprime_mul_right_right
              (hb₂.of_dvd_right hpG).coprime_mul_right_right, hpr, Finset.mul_sum]
            simp only [mul_left_comm]
          _ = _ := by
            rw [Finset.sum_comm]
            simp only [phaseResponse, Finset.mul_sum]
  refine ⟨c, fun p _ => (hc p).1, hlinear, ?_⟩
  have hmass : 0 ≤ ∑ p ∈ S,
      ‖deltaZero (finiteConvolution α β) p.1 p.2 a b₁ b₂‖ :=
    Finset.sum_nonneg fun _ _ => norm_nonneg _
  have hcs := Finset.sum_mul_sq_le_sq_mul_sq (R ×ˢ α.support)
    (fun p => ‖α p.2‖) (fun p => ‖phaseResponse S β c p.1 a b₁ b₂ p.2‖)
  simp only [Finset.sum_product, Finset.sum_const, nsmul_eq_mul] at hcs
  calc
    _ ≤ (∑ r ∈ R, ∑ m ∈ α.support,
        ‖α m‖ * ‖phaseResponse S β c r a b₁ b₂ m‖) ^ 2 := by
      apply pow_le_pow_left₀ hmass
      calc
        _ = ‖∑ r ∈ R, ∑ m ∈ α.support,
            α m * phaseResponse S β c r a b₁ b₂ m‖ := by
          rw [← hlinear, Complex.norm_of_nonneg hmass]
        _ ≤ _ := norm_sum_le_of_le R fun r _ => by
          simpa only [norm_mul] using
            norm_sum_le α.support (fun m => α m * phaseResponse S β c r a b₁ b₂ m)
    _ ≤ _ := by
      refine hcs.trans (mul_le_mul_of_nonneg_left ?_
        (mul_nonneg (Nat.cast_nonneg _) (Finset.sum_nonneg fun _ _ => sq_nonneg _)))
      apply Finset.sum_le_sum
      intro r _
      calc
        _ ≤ ∑ m ∈ α.support, w m * ‖phaseResponse S β c r a b₁ b₂ m‖ ^ 2 :=
          Finset.sum_le_sum fun m hm => le_mul_of_one_le_left (sq_nonneg _) (hw₁ m hm)
        _ ≤ _ := Finset.sum_le_sum_of_subset_of_nonneg hsm
          (fun m hm _ => mul_nonneg (hw₀ m hm) (sq_nonneg _))

theorem dispersionEnergy_eq_four_mixedCorrelations
    (sm : Finset ℕ) (w : ℕ → ℝ) (S : Finset (ℕ × ℕ))
    (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ) (a b₁ b₂ : ℕ) :
    dispersionEnergy sm w S β c a b₁ b₂ =
      (mixedCorrelation sm w S β c a b₁ b₁ -
        mixedCorrelation sm w S β c a b₁ b₂ -
        mixedCorrelation sm w S β c a b₂ b₁ +
        mixedCorrelation sm w S β c a b₂ b₂).re := by
  let A (b r m : ℕ) : ℂ :=
    ∑ p ∈ S.filter (fun p => p.2 = r),
      c p * ∑ n ∈ β.support, β n * unitMixedKernel p.1 r a b m n
  have hcorr (x y : ℕ) :
      mixedCorrelation sm w S β c a x y =
        ∑ r ∈ S.image Prod.snd, ∑ m ∈ sm,
          (w m : ℂ) * (A x r m * star (A y r m)) := by
    unfold mixedCorrelation mixedFiberMass mixedFiber
    simp_rw [Complex.ofReal_sum, Finset.sum_filter (s := sm), Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro r _
    simp_rw [Finset.sum_comm (t := sm)]
    apply Finset.sum_congr rfl
    intro m _
    simp only [A, star_sum, star_mul']
    rw [Finset.sum_mul_sum, Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro p₁ _
    rw [Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro p₂ _
    rw [mul_mul_mul_comm (c p₁) _ (star (c p₂)) _, Finset.sum_mul_sum]
    simp only [Finset.mul_sum, unitMixedKernel]
    apply Finset.sum_congr rfl
    intro n₁ _
    apply Finset.sum_congr rfl
    intro n₂ _
    split_ifs <;> simp_all
    ac_rfl
  simp_rw [hcorr]
  simp only [← Finset.sum_sub_distrib, ← Finset.sum_add_distrib]
  simp only [dispersionEnergy, Complex.re_sum]
  apply Finset.sum_congr rfl
  intro r _
  apply Finset.sum_congr rfl
  intro m _
  simp only [phaseResponse, unitDeltaKernel, mul_sub, Finset.sum_sub_distrib]
  calc
    w m * ‖A b₁ r m - A b₂ r m‖ ^ 2 =
        ((w m : ℂ) * ((A b₁ r m - A b₂ r m) *
          star (A b₁ r m - A b₂ r m))).re := by
      rw [Complex.star_def, Complex.mul_conj, Complex.normSq_eq_norm_sq,
        ← Complex.ofReal_mul, Complex.ofReal_re]
    _ = _ := by
      congr 1
      rw [star_sub]
      ring

theorem mixedFiber_eq_empty_of_incompatible
    (sm : Finset ℕ) (q₁ q₂ r a b₁ b₂ n₁ n₂ : ℕ)
    (hbad : ¬Nat.ModEq r n₁ n₂ ∨
      ¬Nat.ModEq (Nat.gcd q₁ q₂) (b₁ * n₂) (b₂ * n₁)) :
    mixedFiber sm q₁ q₂ r a b₁ b₂ n₁ n₂ = ∅ := by
  apply Finset.eq_empty_iff_forall_notMem.mpr
  intro m hm
  rcases Finset.mem_filter.mp hm with ⟨_, hm₁, _, _, _, hr₁, hq₁, hr₂, hq₂⟩
  rcases hbad with hbad | hbad
  · exact hbad (Nat.ModEq.cancel_left_of_coprime
      hm₁.coprime_mul_left_right.symm (hr₁.trans hr₂.symm))
  · apply hbad
    calc
      b₁ * n₂ ≡ (m * n₁) * n₂ [MOD Nat.gcd q₁ q₂] :=
        (Nat.ModEq.of_dvd (Nat.gcd_dvd_left q₁ q₂) hq₁).symm.mul_right n₂
      _ = (m * n₂) * n₁ := by ac_rfl
      _ ≡ b₂ * n₁ [MOD Nat.gcd q₁ q₂] :=
        (Nat.ModEq.of_dvd (Nat.gcd_dvd_right q₁ q₂) hq₂).mul_right n₁

theorem fiberCRT_coprime_lcm {a b c : ℕ}
    (hab : Nat.Coprime a b) (hac : Nat.Coprime a c) :
    Nat.Coprime a (Nat.lcm b c) :=
  (hab.mul_right hac).of_dvd_right (Nat.lcm_dvd_mul b c)

theorem fiberCRT_inverseResidue_spec {q n b : ℕ} [NeZero q]
    (hn : Nat.Coprime n q) :
    Nat.ModEq q ((((b : ZMod q) * (n : ZMod q)⁻¹).val) * n) b := by
  apply (ZMod.natCast_eq_natCast_iff _ _ q).mp
  rw [Nat.cast_mul, ZMod.natCast_zmod_val, mul_assoc,
    ZMod.inv_mul_of_unit _ ((ZMod.isUnit_iff_coprime n q).mpr hn), mul_one]

theorem fiberCRT_coprime_of_mul_modEq {q m n b : ℕ}
    (h : Nat.ModEq q (m * n) b) (hb : Nat.Coprime b q) : Nat.Coprime m q :=
  (show Nat.Coprime (m * n) q from h.gcd_eq.trans hb).coprime_mul_right

theorem mixedFiber_progression_residue_exists_unique
    (q₁ q₂ r a b₁ b₂ n₁ n₂ : ℕ) [NeZero q₁] [NeZero q₂] [NeZero r]
    (hqr₁ : Nat.Coprime q₁ r) (hqr₂ : Nat.Coprime q₂ r)
    (ha : Nat.Coprime a r) (hb₁ : Nat.Coprime b₁ q₁)
    (hb₂ : Nat.Coprime b₂ q₂)
    (hn₁ : Nat.Coprime n₁ (q₁ * r)) (hn₂ : Nat.Coprime n₂ (q₂ * r))
    (hnr : Nat.ModEq r n₁ n₂)
    (hcompat : Nat.ModEq (Nat.gcd q₁ q₂) (b₁ * n₂) (b₂ * n₁)) :
    ∃! c : ℕ, c < r * Nat.lcm q₁ q₂ ∧ Nat.Coprime c (r * Nat.lcm q₁ q₂) ∧
      Nat.ModEq r (c * n₁) a ∧ Nat.ModEq q₁ (c * n₁) b₁ ∧
      Nat.ModEq r (c * n₂) a ∧ Nat.ModEq q₂ (c * n₂) b₂ := by
  have hn₁q : Nat.Coprime n₁ q₁ := hn₁.coprime_mul_right_right
  have hn₁r : Nat.Coprime n₁ r := hn₁.coprime_mul_left_right
  have hn₂q : Nat.Coprime n₂ q₂ := hn₂.coprime_mul_right_right
  let c₁ := ((b₁ : ZMod q₁) * (n₁ : ZMod q₁)⁻¹).val
  let c₂ := ((b₂ : ZMod q₂) * (n₂ : ZMod q₂)⁻¹).val
  let cᵣ := ((a : ZMod r) * (n₁ : ZMod r)⁻¹).val
  have hc₁ : Nat.ModEq q₁ (c₁ * n₁) b₁ :=
    fiberCRT_inverseResidue_spec (b := b₁) hn₁q
  have hc₂ : Nat.ModEq q₂ (c₂ * n₂) b₂ :=
    fiberCRT_inverseResidue_spec (b := b₂) hn₂q
  have hcᵣ : Nat.ModEq r (cᵣ * n₁) a :=
    fiberCRT_inverseResidue_spec (b := a) hn₁r
  have hcg : Nat.ModEq (Nat.gcd q₁ q₂) c₁ c₂ := by
    have hcross : Nat.ModEq (Nat.gcd q₁ q₂)
        ((c₁ * n₁) * n₂) ((c₂ * n₂) * n₁) :=
      ((hc₁.of_dvd (Nat.gcd_dvd_left q₁ q₂)).mul_right n₂).trans
        (hcompat.trans (((hc₂.of_dvd (Nat.gcd_dvd_right q₁ q₂)).mul_right n₁).symm))
    have hng : Nat.Coprime (n₁ * n₂) (Nat.gcd q₁ q₂) :=
      (hn₁q.of_dvd_right (Nat.gcd_dvd_left q₁ q₂)).mul_left
        (hn₂q.of_dvd_right (Nat.gcd_dvd_right q₁ q₂))
    apply Nat.ModEq.cancel_right_of_coprime hng.symm
    simpa only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm] using hcross
  let t := Nat.chineseRemainder' hcg
  have hrl : Nat.Coprime r (Nat.lcm q₁ q₂) :=
    fiberCRT_coprime_lcm hqr₁.symm hqr₂.symm
  let z := Nat.chineseRemainder hrl cᵣ (t : ℕ)
  have hzlt : (z : ℕ) < r * Nat.lcm q₁ q₂ :=
    Nat.chineseRemainder_lt_mul hrl cᵣ (t : ℕ) (NeZero.ne r)
      (Nat.lcm_ne_zero (NeZero.ne q₁) (NeZero.ne q₂))
  have hzr : Nat.ModEq r ((z : ℕ) * n₁) a :=
    (z.property.1.mul_right n₁).trans hcᵣ
  have hz₁ : Nat.ModEq q₁ ((z : ℕ) * n₁) b₁ :=
    (((z.property.2.of_dvd (Nat.dvd_lcm_left q₁ q₂)).trans t.property.1).mul_right n₁).trans hc₁
  have hz₂ : Nat.ModEq q₂ ((z : ℕ) * n₂) b₂ :=
    (((z.property.2.of_dvd (Nat.dvd_lcm_right q₁ q₂)).trans t.property.2).mul_right n₂).trans hc₂
  have hzrn₂ : Nat.ModEq r ((z : ℕ) * n₂) a :=
    (hnr.symm.mul_left (z : ℕ)).trans hzr
  have hzcop : Nat.Coprime (z : ℕ) (r * Nat.lcm q₁ q₂) :=
    (fiberCRT_coprime_of_mul_modEq hzr ha).mul_right
      (fiberCRT_coprime_lcm (fiberCRT_coprime_of_mul_modEq hz₁ hb₁)
        (fiberCRT_coprime_of_mul_modEq hz₂ hb₂))
  refine ⟨(z : ℕ), ⟨hzlt, hzcop, hzr, hz₁, hzrn₂, hz₂⟩, ?_⟩
  intro d hd
  obtain ⟨hdlt, _, hdr, hd₁, _, hd₂⟩ := hd
  have hdrz : Nat.ModEq r d (z : ℕ) :=
    Nat.ModEq.cancel_right_of_coprime hn₁r.symm (hdr.trans hzr.symm)
  have hd₁z : Nat.ModEq q₁ d (z : ℕ) :=
    Nat.ModEq.cancel_right_of_coprime hn₁q.symm (hd₁.trans hz₁.symm)
  have hd₂z : Nat.ModEq q₂ d (z : ℕ) :=
    Nat.ModEq.cancel_right_of_coprime hn₂q.symm (hd₂.trans hz₂.symm)
  exact ((Nat.modEq_and_modEq_iff_modEq_mul hrl).mp
    ⟨hdrz, Nat.mod_lcm hd₁z hd₂z⟩).eq_of_lt_of_lt hdlt hzlt

theorem mixedFiber_badGuard_zero
    (sm : Finset ℕ) (w : ℕ → ℝ)
    (q₁ q₂ r a b₁ b₂ n₁ n₂ : ℕ)
    (hbad : ¬ (Nat.Coprime n₁ (q₁ * r) ∧
      Nat.Coprime n₂ (q₂ * r) ∧ Nat.ModEq r n₁ n₂ ∧
      Nat.ModEq (Nat.gcd q₁ q₂) (b₁ * n₂) (b₂ * n₁))) :
    mixedFiber sm q₁ q₂ r a b₁ b₂ n₁ n₂ = ∅ ∧
      mixedFiberMass sm w q₁ q₂ r a b₁ b₂ n₁ n₂ = 0 := by
  have he : mixedFiber sm q₁ q₂ r a b₁ b₂ n₁ n₂ = ∅ := by
    apply Finset.filter_eq_empty_iff.mpr
    intro m _ hm
    rcases hm with ⟨hm₁, hn₁, _, hn₂, hr₁, hq₁, hr₂, hq₂⟩
    have hr : Nat.ModEq r n₁ n₂ :=
      Nat.ModEq.cancel_left_of_coprime hm₁.coprime_mul_left_right.symm (hr₁.trans hr₂.symm)
    have hq₁' : Nat.ModEq (Nat.gcd q₁ q₂) (m * n₁) b₁ :=
      (show Nat.ModEq q₁ (m * n₁) b₁ from hq₁).of_dvd (Nat.gcd_dvd_left q₁ q₂)
    have hq₂' : Nat.ModEq (Nat.gcd q₁ q₂) (m * n₂) b₂ :=
      (show Nat.ModEq q₂ (m * n₂) b₂ from hq₂).of_dvd (Nat.gcd_dvd_right q₁ q₂)
    have hq : Nat.ModEq (Nat.gcd q₁ q₂) (b₁ * n₂) (b₂ * n₁) := by
      calc
        b₁ * n₂ ≡ (m * n₁) * n₂ [MOD Nat.gcd q₁ q₂] := hq₁'.symm.mul_right n₂
        _ = (m * n₂) * n₁ := by ac_rfl
        _ ≡ b₂ * n₁ [MOD Nat.gcd q₁ q₂] := hq₂'.mul_right n₁
    exact hbad ⟨hn₁, hn₂, hr, hq⟩
  exact ⟨he, by simp [mixedFiberMass, he]⟩

theorem mixedFiberMass_progression_fourier
    (sm : Finset ℕ) (w : ℕ → ℝ)
    (q₁ q₂ r a b₁ b₂ n₁ n₂ : ℕ) [NeZero q₁] [NeZero q₂] [NeZero r]
    (hqr₁ : Nat.Coprime q₁ r) (hqr₂ : Nat.Coprime q₂ r)
    (ha : Nat.Coprime a r) (hb₁ : Nat.Coprime b₁ q₁)
    (hb₂ : Nat.Coprime b₂ q₂)
    (hn₁ : Nat.Coprime n₁ (q₁ * r)) (hn₂ : Nat.Coprime n₂ (q₂ * r))
    (hnr : Nat.ModEq r n₁ n₂) (c : ℕ)
    (hcr : Nat.ModEq r (c * n₁) a)
    (hc₁ : Nat.ModEq q₁ (c * n₁) b₁)
    (hc₂ : Nat.ModEq q₂ (c * n₂) b₂) :
    let Q : ℕ := r * Nat.lcm q₁ q₂
    let _ : NeZero Q := ⟨Nat.mul_ne_zero (NeZero.ne r)
      (Nat.lcm_ne_zero (NeZero.ne q₁) (NeZero.ne q₂))⟩
    let W : ZMod Q → ℂ := fun h =>
      ∑ m ∈ sm, (w m : ℂ) * ZMod.stdAddChar (-((m : ZMod Q) * h))
    (mixedFiber sm q₁ q₂ r a b₁ b₂ n₁ n₂ =
      sm.filter (fun m => Nat.ModEq Q m c)) ∧
    ((mixedFiberMass sm w q₁ q₂ r a b₁ b₂ n₁ n₂ : ℂ) =
      ((Q : ℂ)⁻¹ * ∑ h : ZMod Q,
        W h * ZMod.stdAddChar ((c : ZMod Q) * h))) ∧
    ((mixedFiberMass sm w q₁ q₂ r a b₁ b₂ n₁ n₂ : ℂ) =
      (((Nat.gcd q₁ q₂ : ℂ) / ((r * q₁ * q₂ : ℕ) : ℂ)) *
        (∑ m ∈ sm, (w m : ℂ)) +
      (Q : ℂ)⁻¹ * ∑ h ∈ (Finset.univ : Finset (ZMod Q)).erase 0,
        W h * ZMod.stdAddChar ((c : ZMod Q) * h))) := by
  dsimp only
  let Q : ℕ := r * Nat.lcm q₁ q₂
  let _ : NeZero Q := ⟨Nat.mul_ne_zero (NeZero.ne r)
    (Nat.lcm_ne_zero (NeZero.ne q₁) (NeZero.ne q₂))⟩
  let W : ZMod Q → ℂ := fun h =>
    ∑ m ∈ sm, (w m : ℂ) * ZMod.stdAddChar (-((m : ZMod Q) * h))
  have hcop : Nat.Coprime r (Nat.lcm q₁ q₂) :=
    fiberCRT_coprime_lcm hqr₁.symm hqr₂.symm
  have hn₁r : Nat.Coprime n₁ r := hn₁.coprime_mul_left_right
  have hn₁q : Nat.Coprime n₁ q₁ := hn₁.coprime_mul_right_right
  have hn₂q : Nat.Coprime n₂ q₂ := hn₂.coprime_mul_right_right
  have hfilter : mixedFiber sm q₁ q₂ r a b₁ b₂ n₁ n₂ =
      sm.filter (fun m => Nat.ModEq Q m c) := by
    ext m
    simp only [mixedFiber, Finset.mem_filter]
    constructor
    · rintro ⟨hm, _, _, _, _, hmr, hmq₁, _, hmq₂⟩
      refine ⟨hm, (Nat.modEq_and_modEq_iff_modEq_mul hcop).mp ?_⟩
      refine ⟨Nat.ModEq.cancel_right_of_coprime hn₁r.symm (hmr.trans hcr.symm), ?_⟩
      exact Nat.mod_lcm
        (Nat.ModEq.cancel_right_of_coprime hn₁q.symm (hmq₁.trans hc₁.symm))
        (Nat.ModEq.cancel_right_of_coprime hn₂q.symm (hmq₂.trans hc₂.symm))
    · rintro ⟨hm, hmc⟩
      have hmr : Nat.ModEq r m c := hmc.of_dvd (dvd_mul_right r (Nat.lcm q₁ q₂))
      have hmq₁ : Nat.ModEq q₁ m c := hmc.of_dvd
        ((Nat.dvd_lcm_left q₁ q₂).trans (dvd_mul_left (Nat.lcm q₁ q₂) r))
      have hmq₂ : Nat.ModEq q₂ m c := hmc.of_dvd
        ((Nat.dvd_lcm_right q₁ q₂).trans (dvd_mul_left (Nat.lcm q₁ q₂) r))
      have hr₁ : Nat.ModEq r (m * n₁) a := (hmr.mul_right n₁).trans hcr
      have hq₁ : Nat.ModEq q₁ (m * n₁) b₁ := (hmq₁.mul_right n₁).trans hc₁
      have hr₂ : Nat.ModEq r (m * n₂) a := (hnr.symm.mul_left m).trans hr₁
      have hq₂ : Nat.ModEq q₂ (m * n₂) b₂ := (hmq₂.mul_right n₂).trans hc₂
      have hmr' : Nat.Coprime m r := fiberCRT_coprime_of_mul_modEq hr₁ ha
      have hmq₁' : Nat.Coprime m q₁ := fiberCRT_coprime_of_mul_modEq hq₁ hb₁
      have hmq₂' : Nat.Coprime m q₂ := fiberCRT_coprime_of_mul_modEq hq₂ hb₂
      exact ⟨hm, hmq₁'.mul_right hmr', hn₁, hmq₂'.mul_right hmr', hn₂,
        hr₁, hq₁, hr₂, hq₂⟩
  have hQ : (Q : ℂ) ≠ 0 := by exact_mod_cast NeZero.ne Q
  have horth (m : ℕ) :
      (∑ h : ZMod Q, ZMod.stdAddChar (-((m : ZMod Q) * h)) *
        ZMod.stdAddChar ((c : ZMod Q) * h)) =
      if Nat.ModEq Q m c then (Q : ℂ) else 0 := by
    have heq : (c : ZMod Q) - (m : ZMod Q) = 0 ↔ Nat.ModEq Q m c := by
      rw [sub_eq_zero, ZMod.natCast_eq_natCast_iff]
      exact ⟨Nat.ModEq.symm, Nat.ModEq.symm⟩
    calc
      _ = ∑ h : ZMod Q,
          ZMod.stdAddChar (h * ((c : ZMod Q) - (m : ZMod Q))) := by
        apply Finset.sum_congr rfl
        intro h _
        rw [← AddChar.map_add_eq_mul]
        congr 1
        ring
      _ = _ := by
        rw [AddChar.sum_mulShift _ (ZMod.isPrimitive_stdAddChar Q)]
        simp only [ZMod.card, heq, Nat.cast_ite, Nat.cast_zero]
  have hsum :
      (∑ h : ZMod Q, W h * ZMod.stdAddChar ((c : ZMod Q) * h)) =
      (Q : ℂ) * ∑ m ∈ sm.filter (fun m => Nat.ModEq Q m c), (w m : ℂ) := by
    simp only [W, Finset.sum_mul]
    rw [Finset.sum_comm]
    calc
      (∑ m ∈ sm, ∑ h : ZMod Q, (w m : ℂ) *
        ZMod.stdAddChar (-((m : ZMod Q) * h)) *
        ZMod.stdAddChar ((c : ZMod Q) * h)) =
          ∑ m ∈ sm, (w m : ℂ) * (if Nat.ModEq Q m c then (Q : ℂ) else 0) := by
        apply Finset.sum_congr rfl
        intro m _
        simp only [mul_assoc]
        rw [← Finset.mul_sum, horth]
      _ = _ := by
        rw [Finset.sum_filter, Finset.mul_sum]
        apply Finset.sum_congr rfl
        intro m _
        by_cases hm : Nat.ModEq Q m c <;> simp [hm, mul_comm]
  have hfourier : (mixedFiberMass sm w q₁ q₂ r a b₁ b₂ n₁ n₂ : ℂ) =
      (Q : ℂ)⁻¹ * ∑ h : ZMod Q,
        W h * ZMod.stdAddChar ((c : ZMod Q) * h) := by
    rw [hsum, ← mul_assoc, inv_mul_cancel₀ hQ, one_mul]
    simp only [mixedFiberMass, hfilter, Complex.ofReal_sum]
  have hzero : W 0 * ZMod.stdAddChar ((c : ZMod Q) * 0) =
      ∑ m ∈ sm, (w m : ℂ) := by simp [W]
  have hden : ((r * q₁ * q₂ : ℕ) : ℂ) ≠ 0 := by
    exact_mod_cast Nat.mul_ne_zero (Nat.mul_ne_zero (NeZero.ne r) (NeZero.ne q₁))
      (NeZero.ne q₂)
  have hmul : (Nat.gcd q₁ q₂ : ℂ) * (Q : ℂ) = ((r * q₁ * q₂ : ℕ) : ℂ) := by
    have hn : Nat.gcd q₁ q₂ * Q = r * q₁ * q₂ := by
      dsimp [Q]
      calc
        Nat.gcd q₁ q₂ * (r * Nat.lcm q₁ q₂) =
            r * (Nat.gcd q₁ q₂ * Nat.lcm q₁ q₂) := by ring
        _ = r * q₁ * q₂ := by rw [Nat.gcd_mul_lcm]; ring
    exact_mod_cast hn
  have hinv : (Q : ℂ)⁻¹ =
      (Nat.gcd q₁ q₂ : ℂ) / ((r * q₁ * q₂ : ℕ) : ℂ) := by
    rw [← hmul, div_mul_eq_div_div,
      div_self (left_ne_zero_of_mul (hmul.trans_ne hden)), one_div]
  refine ⟨hfilter, hfourier, ?_⟩
  change (mixedFiberMass sm w q₁ q₂ r a b₁ b₂ n₁ n₂ : ℂ) =
    (Nat.gcd q₁ q₂ : ℂ) / ((r * q₁ * q₂ : ℕ) : ℂ) *
      (∑ m ∈ sm, (w m : ℂ)) +
    (Q : ℂ)⁻¹ * ∑ h ∈ (Finset.univ : Finset (ZMod Q)).erase 0,
      W h * ZMod.stdAddChar ((c : ZMod Q) * h)
  rw [hfourier, ← Finset.add_sum_erase (Finset.univ : Finset (ZMod Q))
    (fun h => W h * ZMod.stdAddChar ((c : ZMod Q) * h)) (Finset.mem_univ 0)]
  simp only [hzero, mul_add, hinv]

theorem finiteFamily_integer_representative_spec
    (S : Finset (ℕ × ℕ))
    (hS : ∀ p ∈ S, 0 < p.1 ∧ 0 < p.2) :
    let D : ℕ := ∏ p ∈ S, p.1 * p.2
    let ρ : ℤ → ℕ := fun z => (z % (D : ℤ)).toNat
    0 < D ∧ (∀ z : ℤ, ρ z < D) ∧
    (∀ d : ℕ, d ∣ D →
      (∀ z : ℤ,
        Int.ModEq (d : ℤ) (ρ z : ℤ) z ∧
        (ρ z : ZMod d) = (z : ZMod d) ∧
        Nat.gcd (ρ z) d = Int.gcd z (d : ℤ)) ∧
      (∀ a b₁ b₂ : ℤ,
        Nat.Coprime (ρ a * ρ b₁ * ρ b₂) d ↔
          Int.gcd (a * b₁ * b₂) (d : ℤ) = 1) ∧
      (∀ (b₁ b₂ : ℤ) (n₁ n₂ : ℕ),
        Nat.ModEq d (ρ b₁ * n₂) (ρ b₂ * n₁) ↔
          Int.ModEq (d : ℤ) (b₁ * (n₂ : ℤ)) (b₂ * (n₁ : ℤ)))) := by
  intro D ρ
  have hD : 0 < D := Finset.prod_pos fun p hp =>
    Nat.mul_pos (hS p hp).1 (hS p hp).2
  have hDz : (0 : ℤ) < (D : ℤ) := by exact_mod_cast hD
  have hrho (z : ℤ) : (ρ z : ℤ) = z % (D : ℤ) :=
    Int.toNat_of_nonneg (Int.emod_nonneg z hDz.ne')
  have hlt (z : ℤ) : ρ z < D :=
    (Int.toNat_lt' hD).mpr (Int.emod_lt_of_pos z hDz)
  have hcong (d : ℕ) (hd : d ∣ D) (z : ℤ) :
      Int.ModEq (d : ℤ) (ρ z : ℤ) z := by
    apply Int.ModEq.of_dvd (show (d : ℤ) ∣ (D : ℤ) by exact_mod_cast hd)
    rw [hrho]
    exact Int.mod_modEq z (D : ℤ)
  have hgcd (d : ℕ) (u v : ℤ) (huv : Int.ModEq (d : ℤ) u v) :
      Int.gcd u (d : ℤ) = Int.gcd v (d : ℤ) := by
    rw [← Int.gcd_emod u (d : ℤ), huv, Int.gcd_emod]
  refine ⟨hD, hlt, ?_⟩
  intro d hd
  refine ⟨?_, ?_, ?_⟩
  · intro z
    have hz := hcong d hd z
    refine ⟨hz, ?_, ?_⟩
    · simpa only [Int.cast_natCast] using
        (ZMod.intCast_eq_intCast_iff (ρ z : ℤ) z d).mpr hz
    · rw [← Int.gcd_natCast_natCast (ρ z) d]
      exact hgcd d (ρ z : ℤ) z hz
  · intro a b₁ b₂
    have hp : Int.ModEq (d : ℤ)
        ((ρ a : ℤ) * (ρ b₁ : ℤ) * (ρ b₂ : ℤ)) (a * b₁ * b₂) :=
      ((hcong d hd a).mul (hcong d hd b₁)).mul (hcong d hd b₂)
    have he : Nat.gcd (ρ a * ρ b₁ * ρ b₂) d =
        Int.gcd (a * b₁ * b₂) (d : ℤ) := by
      rw [← Int.gcd_natCast_natCast (ρ a * ρ b₁ * ρ b₂) d]
      apply hgcd
      simpa only [Nat.cast_mul] using hp
    change Nat.gcd (ρ a * ρ b₁ * ρ b₂) d = 1 ↔ _
    rw [he]
  · intro b₁ b₂ n₁ n₂
    have h₁ : Int.ModEq (d : ℤ) ((ρ b₁ : ℤ) * (n₂ : ℤ)) (b₁ * (n₂ : ℤ)) :=
      (hcong d hd b₁).mul_right (n₂ : ℤ)
    have h₂ : Int.ModEq (d : ℤ) ((ρ b₂ : ℤ) * (n₁ : ℤ)) (b₂ * (n₁ : ℤ)) :=
      (hcong d hd b₂).mul_right (n₁ : ℤ)
    constructor
    · intro h
      have hh : Int.ModEq (d : ℤ) ((ρ b₁ : ℤ) * (n₂ : ℤ))
          ((ρ b₂ : ℤ) * (n₁ : ℤ)) := by
        simpa only [Nat.cast_mul] using (Int.natCast_modEq_iff.mpr h)
      exact h₁.symm.trans (hh.trans h₂)
    · intro h
      apply Int.natCast_modEq_iff.mp
      simpa only [Nat.cast_mul] using h₁.trans (h.trans h₂.symm)

theorem mixedCorrelation_integer_parameter_adapter
    (S : Finset (ℕ × ℕ))
    (hS : ∀ p ∈ S, 0 < p.1 ∧ 0 < p.2)
    (a b₁ b₂ : ℤ) :
    let D : ℕ := ∏ p ∈ S, p.1 * p.2
    let ρ : ℤ → ℕ := fun z => (z % (D : ℤ)).toNat
    let F : Finset ℕ → ℕ → ℕ → ℕ → ℕ → ℕ → Finset ℕ :=
      fun sm q₁ q₂ r n₁ n₂ => sm.filter (fun m =>
        Nat.Coprime m (q₁ * r) ∧ Nat.Coprime n₁ (q₁ * r) ∧
        Nat.Coprime m (q₂ * r) ∧ Nat.Coprime n₂ (q₂ * r) ∧
        Int.ModEq (r : ℤ) ((m : ℤ) * (n₁ : ℤ)) a ∧
        Int.ModEq (q₁ : ℤ) ((m : ℤ) * (n₁ : ℤ)) b₁ ∧
        Int.ModEq (r : ℤ) ((m : ℤ) * (n₂ : ℤ)) a ∧
        Int.ModEq (q₂ : ℤ) ((m : ℤ) * (n₂ : ℤ)) b₂)
    (∀ r ∈ S.image Prod.snd,
      ∀ p₁ ∈ S.filter (fun p => p.2 = r),
      ∀ p₂ ∈ S.filter (fun p => p.2 = r),
      ∀ (sm : Finset ℕ) (n₁ n₂ : ℕ),
        mixedFiber sm p₁.1 p₂.1 r (ρ a) (ρ b₁) (ρ b₂) n₁ n₂ =
          F sm p₁.1 p₂.1 r n₁ n₂) ∧
    (∀ (sm : Finset ℕ) (w : ℕ → ℝ) (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ),
      mixedCorrelation sm w S β c (ρ a) (ρ b₁) (ρ b₂) =
        ∑ r ∈ S.image Prod.snd,
          ∑ p₁ ∈ S.filter (fun p => p.2 = r),
            ∑ p₂ ∈ S.filter (fun p => p.2 = r),
              c p₁ * star (c p₂) *
                ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                  β n₁ * star (β n₂) *
                    ∑ m ∈ F sm p₁.1 p₂.1 r n₁ n₂, (w m : ℂ)) := by
  intro D ρ F
  have hrep (d : ℕ) (hd : d ∣ D) (z : ℤ) :
      Int.ModEq (d : ℤ) (ρ z : ℤ) z :=
    (((finiteFamily_integer_representative_spec S hS).2.2 d hd).1 z).1
  have hcong (d : ℕ) (hd : d ∣ D) (u : ℕ) (z : ℤ) :
      u % d = ρ z % d ↔ Int.ModEq (d : ℤ) (u : ℤ) z := by
    change Nat.ModEq d u (ρ z) ↔ _
    rw [← Int.natCast_modEq_iff]
    exact ⟨fun h => h.trans (hrep d hd z), fun h => h.trans (hrep d hd z).symm⟩
  have hprod (p : ℕ × ℕ) (hp : p ∈ S) : p.1 * p.2 ∣ D :=
    Finset.dvd_prod_of_mem (fun p : ℕ × ℕ => p.1 * p.2) hp
  have hfiber : ∀ r ∈ S.image Prod.snd,
      ∀ p₁ ∈ S.filter (fun p => p.2 = r),
      ∀ p₂ ∈ S.filter (fun p => p.2 = r),
      ∀ (sm : Finset ℕ) (n₁ n₂ : ℕ),
        mixedFiber sm p₁.1 p₂.1 r (ρ a) (ρ b₁) (ρ b₂) n₁ n₂ =
          F sm p₁.1 p₂.1 r n₁ n₂ := by
    intro r _hr p₁ hp₁ p₂ hp₂ sm n₁ n₂
    have hq₁ : p₁.1 ∣ D :=
      (Nat.dvd_mul_right p₁.1 p₁.2).trans (hprod p₁ (Finset.mem_filter.mp hp₁).1)
    have hq₂ : p₂.1 ∣ D :=
      (Nat.dvd_mul_right p₂.1 p₂.2).trans (hprod p₂ (Finset.mem_filter.mp hp₂).1)
    have hr : r ∣ D := by
      rw [← (Finset.mem_filter.mp hp₁).2]
      exact (Nat.dvd_mul_left p₁.2 p₁.1).trans (hprod p₁ (Finset.mem_filter.mp hp₁).1)
    ext m
    simp only [mixedFiber, F, Finset.mem_filter,
      hcong r hr (m * n₁) a, hcong p₁.1 hq₁ (m * n₁) b₁,
      hcong r hr (m * n₂) a, hcong p₂.1 hq₂ (m * n₂) b₂, Nat.cast_mul]
  refine ⟨hfiber, ?_⟩
  intro sm w β c
  unfold mixedCorrelation
  apply Finset.sum_congr rfl
  intro r hr
  apply Finset.sum_congr rfl
  intro p₁ hp₁
  apply Finset.sum_congr rfl
  intro p₂ hp₂
  congr 1
  apply Finset.sum_congr rfl
  intro n₁ hn₁
  apply Finset.sum_congr rfl
  intro n₂ hn₂
  congr 1
  simp only [mixedFiberMass, hfiber r hr p₁ hp₁ p₂ hp₂ sm n₁ n₂, Complex.ofReal_sum]

open Classical in
theorem sourcePhase_moduli_and_guard
    (r q₀ u₁ v q₂ b₁ b₂ n₁ n₂ : ℕ)
    (hsq : Squarefree (r * q₀ * u₁ * v * q₂))
    (ℓ : ℤ) (hshift : (n₂ : ℤ) = (n₁ : ℤ) + ℓ * (r : ℤ)) :
    Nat.gcd (q₀ * u₁ * v) (q₀ * q₂) = q₀ ∧
    r * Nat.lcm (q₀ * u₁ * v) (q₀ * q₂) = r * q₀ * u₁ * v * q₂ ∧
    ((Nat.Coprime n₁ ((q₀ * u₁ * v) * r) ∧
        Nat.Coprime n₂ ((q₀ * q₂) * r) ∧ Nat.ModEq r n₁ n₂ ∧
        Nat.ModEq (Nat.gcd (q₀ * u₁ * v) (q₀ * q₂)) (b₁ * n₂) (b₂ * n₁)) ↔
      (Nat.Coprime n₁ (r * q₀ * u₁ * v) ∧ Nat.Coprime n₂ (q₀ * q₂) ∧
        (b₁ : ZMod q₀) * (n₁ : ZMod q₀)⁻¹ =
          (b₂ : ZMod q₀) * (n₂ : ZMod q₀)⁻¹)) := by
  have hcop : Nat.Coprime (u₁ * v) q₂ :=
    (Nat.coprime_of_squarefree_mul hsq).of_dvd_left ⟨r * q₀, by ac_rfl⟩
  have hgcd : Nat.gcd (q₀ * u₁ * v) (q₀ * q₂) = q₀ := by
    simp only [Nat.mul_assoc, Nat.gcd_mul_left, hcop.gcd_eq_one, Nat.mul_one]
  have hlcm : r * Nat.lcm (q₀ * u₁ * v) (q₀ * q₂) = r * q₀ * u₁ * v * q₂ := by
    simp only [Nat.mul_assoc, Nat.lcm_mul_left, hcop.lcm_eq_mul]
  have hnr : Nat.ModEq r n₁ n₂ := Int.natCast_modEq_iff.mp (by simp [hshift])
  have hinverse (hn₁ : Nat.Coprime n₁ q₀) (hn₂ : Nat.Coprime n₂ q₀) :
      Nat.ModEq q₀ (b₁ * n₂) (b₂ * n₁) ↔
        (b₁ : ZMod q₀) * (n₁ : ZMod q₀)⁻¹ =
          (b₂ : ZMod q₀) * (n₂ : ZMod q₀)⁻¹ := by
    simpa only [← ZMod.inv_coe_unit, ZMod.coe_unitOfCoprime,
      ← Nat.cast_mul, ZMod.natCast_eq_natCast_iff] using
      (Units.mul_inv_eq_mul_inv_iff (b₁ : ZMod q₀) (b₂ : ZMod q₀)
        (ZMod.unitOfCoprime n₁ hn₁) (ZMod.unitOfCoprime n₂ hn₂)).symm
  refine ⟨hgcd, hlcm, ?_⟩
  rw [hgcd, show r * q₀ * u₁ * v = (q₀ * u₁ * v) * r by ac_rfl]
  constructor
  · rintro ⟨hn₁, hn₂, _, hcross⟩
    exact ⟨hn₁, hn₂.coprime_mul_right_right,
      (hinverse
        hn₁.coprime_mul_right_right.coprime_mul_right_right.coprime_mul_right_right
        hn₂.coprime_mul_right_right.coprime_mul_right_right).mp hcross⟩
  · rintro ⟨hn₁, hn₂, he⟩
    have hn₂r : Nat.Coprime n₂ r :=
      hnr.gcd_eq.symm.trans hn₁.coprime_mul_left_right.gcd_eq_one
    exact ⟨hn₁, hn₂.mul_right hn₂r, hnr,
      (hinverse
        hn₁.coprime_mul_right_right.coprime_mul_right_right.coprime_mul_right_right
        hn₂.coprime_mul_right_right).mpr he⟩

theorem sourcePhase_fiber_singleton
    (q₁ q₂ r a b₁ b₂ n₁ n₂ : ℕ) [NeZero q₁] [NeZero q₂] [NeZero r]
    (hqr₁ : Nat.Coprime q₁ r) (hqr₂ : Nat.Coprime q₂ r)
    (ha : Nat.Coprime a r) (hb₁ : Nat.Coprime b₁ q₁)
    (hb₂ : Nat.Coprime b₂ q₂)
    (hn₁ : Nat.Coprime n₁ (q₁ * r)) (hn₂ : Nat.Coprime n₂ (q₂ * r))
    (hnr : Nat.ModEq r n₁ n₂)
    (hcompat : Nat.ModEq (Nat.gcd q₁ q₂) (b₁ * n₂) (b₂ * n₁)) :
    ∃ t : ℕ,
      mixedFiber (Finset.range (r * Nat.lcm q₁ q₂)) q₁ q₂ r a b₁ b₂ n₁ n₂ = {t} ∧
      Nat.ModEq r (t * n₁) a ∧ Nat.ModEq q₁ (t * n₁) b₁ ∧
        Nat.ModEq q₂ (t * n₂) b₂ := by
  obtain ⟨t, ⟨htlt, htunit, htr, htq₁, htr₂, htq₂⟩, hunique⟩ :=
    mixedFiber_progression_residue_exists_unique q₁ q₂ r a b₁ b₂ n₁ n₂
      hqr₁ hqr₂ ha hb₁ hb₂ hn₁ hn₂ hnr hcompat
  refine ⟨t, Finset.eq_singleton_iff_unique_mem.mpr ⟨?_, ?_⟩, htr, htq₁, htq₂⟩
  · refine Finset.mem_filter.mpr
      ⟨Finset.mem_range.mpr htlt, ?_, hn₁, ?_, hn₂, htr, htq₁, htr₂, htq₂⟩
    · exact (htunit.coprime_mul_left_right.of_dvd_right
        (Nat.dvd_lcm_left q₁ q₂)).mul_right htunit.coprime_mul_right_right
    · exact (htunit.coprime_mul_left_right.of_dvd_right
        (Nat.dvd_lcm_right q₁ q₂)).mul_right htunit.coprime_mul_right_right
  · intro m hm
    obtain ⟨hmrange, hm₁, _, hm₂, _, hmr, hmq₁, hmr₂, hmq₂⟩ := Finset.mem_filter.mp hm
    exact hunique m ⟨Finset.mem_range.mp hmrange,
      hm₁.coprime_mul_left_right.mul_right
        (fiberCRT_coprime_lcm hm₁.coprime_mul_right_right hm₂.coprime_mul_right_right),
      hmr, hmq₁, hmr₂, hmq₂⟩

theorem sourcePhase_character_reciprocal
    (q t n b k : ℕ) [NeZero q] (h : ℤ)
    (hn : Nat.Coprime n q) (hk : Nat.Coprime k q)
    (ht : Nat.ModEq q (t * n) b) :
    ZMod.stdAddChar ((k : ZMod q)⁻¹ * ((t : ZMod q) * (h : ZMod q))) =
      reciprocalUnitPhase q ((b : ZMod q) * (h : ZMod q))
        ((n : ZMod q) * (k : ZMod q)) := by
  classical
  have hun : IsUnit (n : ZMod q) := (ZMod.isUnit_iff_coprime n q).mpr hn
  have huk : IsUnit (k : ZMod q) := (ZMod.isUnit_iff_coprime k q).mpr hk
  have htn : (t : ZMod q) * (n : ZMod q) = (b : ZMod q) := by
    simpa only [Nat.cast_mul] using (ZMod.natCast_eq_natCast_iff _ _ q).mpr ht
  have ht' : (t : ZMod q) = (b : ZMod q) * (n : ZMod q)⁻¹ :=
    (Units.eq_mul_inv_iff_mul_eq (ZMod.unitOfCoprime n hn)).mpr htn
  rw [reciprocalUnitPhase, ite_eq_left (hun.mul huk),
    sourcePhase_inv_mul _ _ hun huk, ht']
  congr 1
  ac_rfl

theorem mixedCorrelation_outer_coefficient_mass_le
    (S : Finset (ℕ × ℕ)) (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ)
    (N Q R d : ℕ) (B H : ℝ) (hB : 0 ≤ B) (hH : 0 ≤ H)
    (hβ : β.support ⊆ Finset.Icc 1 N)
    (hc : ∀ p ∈ S, ‖c p‖ ≤ 1)
    (hS : ∀ p ∈ S, 1 ≤ p.1 ∧ p.1 ≤ Q ∧ 1 ≤ p.2 ∧ p.2 ≤ R)
    (henv : ∀ n ∈ β.support,
      ‖β n‖ ≤ B * ((Nat.divisors n).card : ℝ) ^ d * H) :
    (∑ r ∈ S.image Prod.snd,
      ∑ p₁ ∈ S.filter (fun p => p.2 = r),
        ∑ p₂ ∈ S.filter (fun p => p.2 = r),
          ‖c p₁‖ * ‖c p₂‖ *
            ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
              ‖β n₁‖ * ‖β n₂‖) ≤
      (R : ℝ) * (Q : ℝ) ^ 2 * (B * H * (N : ℝ) ^ (d + 1)) ^ 2 := by
  have hβcard : (β.support.card : ℝ) ≤ (N : ℝ) := by
    exact_mod_cast (show β.support.card ≤ N by
      simpa using Finset.card_le_card hβ)
  have hβpoint (n : ℕ) (hn : n ∈ β.support) :
      ‖β n‖ ≤ B * (N : ℝ) ^ d * H := by
    have hdiv : ((Nat.divisors n).card : ℝ) ≤ (N : ℝ) := by
      exact_mod_cast (Nat.le_trans (Nat.card_divisors_le_self n)
        (Finset.mem_Icc.mp (hβ hn)).2)
    exact (henv n hn).trans (mul_le_mul_of_nonneg_right
      (mul_le_mul_of_nonneg_left
        (pow_le_pow_left₀ (Nat.cast_nonneg _) hdiv d) hB) hH)
  have hβsum : (∑ n ∈ β.support, ‖β n‖) ≤
      B * H * (N : ℝ) ^ (d + 1) := by
    calc
      (∑ n ∈ β.support, ‖β n‖) ≤
          (β.support.card : ℝ) * (B * (N : ℝ) ^ d * H) := by
        simpa using Finset.sum_le_card_nsmul β.support _ _ hβpoint
      _ ≤ (N : ℝ) * (B * (N : ℝ) ^ d * H) :=
        mul_le_mul_of_nonneg_right hβcard (by positivity)
      _ = B * H * (N : ℝ) ^ (d + 1) := by rw [pow_succ]; ring
  have hβpairs :
      (∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support, ‖β n₁‖ * ‖β n₂‖) ≤
        (B * H * (N : ℝ) ^ (d + 1)) ^ 2 := by
    simpa only [pow_two, Finset.sum_mul_sum] using
      pow_le_pow_left₀ (Finset.sum_nonneg fun n _ => norm_nonneg (β n)) hβsum 2
  have hβpairs_nonneg :
      0 ≤ ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support, ‖β n₁‖ * ‖β n₂‖ :=
    Finset.sum_nonneg fun n₁ _ => Finset.sum_nonneg fun n₂ _ =>
      mul_nonneg (norm_nonneg (β n₁)) (norm_nonneg (β n₂))
  have hfiber (r : ℕ) :
      ((S.filter (fun p => p.2 = r)).card : ℝ) ≤ (Q : ℝ) := by
    have hcard : (S.filter (fun p => p.2 = r)).card ≤
        (Finset.Icc 1 Q).card := by
      apply Finset.card_le_card_of_injOn Prod.fst
      · intro p hp
        exact Finset.mem_Icc.mpr
          ⟨(hS p (Finset.mem_filter.mp hp).1).1,
            (hS p (Finset.mem_filter.mp hp).1).2.1⟩
      · intro p₁ hp₁ p₂ hp₂ heq
        exact Prod.ext heq
          ((Finset.mem_filter.mp hp₁).2.trans (Finset.mem_filter.mp hp₂).2.symm)
    exact_mod_cast (show (S.filter (fun p => p.2 = r)).card ≤ Q by
      simpa using hcard)
  have hrimage : S.image Prod.snd ⊆ Finset.Icc 1 R := by
    intro r hr
    obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hr
    exact Finset.mem_Icc.mpr ⟨(hS p hp).2.2.1, (hS p hp).2.2.2⟩
  have hrcard : ((S.image Prod.snd).card : ℝ) ≤ (R : ℝ) := by
    exact_mod_cast (show (S.image Prod.snd).card ≤ R by
      simpa using Finset.card_le_card hrimage)
  calc
    (∑ r ∈ S.image Prod.snd,
        ∑ p₁ ∈ S.filter (fun p => p.2 = r),
          ∑ p₂ ∈ S.filter (fun p => p.2 = r),
            ‖c p₁‖ * ‖c p₂‖ *
              ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                ‖β n₁‖ * ‖β n₂‖) ≤
        ∑ r ∈ S.image Prod.snd,
          ∑ _p₁ ∈ S.filter (fun p => p.2 = r),
            ∑ _p₂ ∈ S.filter (fun p => p.2 = r),
              (B * H * (N : ℝ) ^ (d + 1)) ^ 2 := by
      apply Finset.sum_le_sum
      intro r _hr
      apply Finset.sum_le_sum
      intro p₁ hp₁
      apply Finset.sum_le_sum
      intro p₂ hp₂
      have hcprod : ‖c p₁‖ * ‖c p₂‖ ≤ (1 : ℝ) :=
        (mul_le_of_le_one_left (norm_nonneg (c p₂))
          (hc p₁ (Finset.mem_filter.mp hp₁).1)).trans
          (hc p₂ (Finset.mem_filter.mp hp₂).1)
      exact (mul_le_of_le_one_left hβpairs_nonneg hcprod).trans hβpairs
    _ ≤ ∑ _r ∈ S.image Prod.snd,
        (Q : ℝ) ^ 2 * (B * H * (N : ℝ) ^ (d + 1)) ^ 2 := by
      apply Finset.sum_le_sum
      intro r _hr
      calc
        (∑ _p₁ ∈ S.filter (fun p => p.2 = r),
            ∑ _p₂ ∈ S.filter (fun p => p.2 = r),
              (B * H * (N : ℝ) ^ (d + 1)) ^ 2) =
            ((S.filter (fun p => p.2 = r)).card : ℝ) ^ 2 *
              (B * H * (N : ℝ) ^ (d + 1)) ^ 2 := by
          simp [pow_two, mul_assoc]
        _ ≤ (Q : ℝ) ^ 2 * (B * H * (N : ℝ) ^ (d + 1)) ^ 2 :=
          mul_le_mul_of_nonneg_right
            (pow_le_pow_left₀ (Nat.cast_nonneg _) (hfiber r) 2) (sq_nonneg _)
    _ = ((S.image Prod.snd).card : ℝ) *
        ((Q : ℝ) ^ 2 * (B * H * (N : ℝ) ^ (d + 1)) ^ 2) := by simp
    _ ≤ (R : ℝ) * ((Q : ℝ) ^ 2 * (B * H * (N : ℝ) ^ (d + 1)) ^ 2) :=
      mul_le_mul_of_nonneg_right hrcard (by positivity)
    _ = (R : ℝ) * (Q : ℝ) ^ 2 * (B * H * (N : ℝ) ^ (d + 1)) ^ 2 := by
      ring

theorem mixedCorrelation_outer_coefficient_mass_eventually_le_rpow
    (d : ℕ) (E κ B η : ℝ)
    (hκ : 0 ≤ κ) (hB : 0 ≤ B) (hη : 0 < η) :
    ∀ᶠ x : ℝ in Filter.atTop,
      ∀ (S : Finset (ℕ × ℕ)) (β : ℕ →₀ ℂ)
        (c : ℕ × ℕ → ℂ) (N : ℕ),
        β.support ⊆ Finset.Icc 1 N →
        (N : ℝ) ≤ x ^ κ →
        (∀ n ∈ β.support,
          ‖β n‖ ≤ B * ((Nat.divisors n).card : ℝ) ^ d * (Real.log x) ^ E) →
        (∀ p ∈ S, ‖c p‖ ≤ 1) →
        (∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧
          (p.1 : ℝ) ≤ x ^ κ ∧ (p.2 : ℝ) ≤ x ^ κ) →
        (∑ r ∈ S.image Prod.snd,
          ∑ p₁ ∈ S.filter (fun p => p.2 = r),
            ∑ p₂ ∈ S.filter (fun p => p.2 = r),
              ‖c p₁‖ * ‖c p₂‖ *
                ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                  ‖β n₁‖ * ‖β n₂‖) ≤
          x ^ ((((2 * d + 5 : ℕ) : ℝ) * κ) + η) := by
  have hsmall : ∀ᶠ x : ℝ in Filter.atTop,
      ‖B ^ 2 * (Real.log x) ^ (2 * E)‖ ≤ ‖x ^ η‖ := by
    simpa only [one_mul] using
      ((isLittleO_log_rpow_rpow_atTop (2 * E) hη).const_mul_left (B ^ 2)).bound
        (show (0 : ℝ) < 1 by norm_num)
  filter_upwards [hsmall, Filter.eventually_ge_atTop (Real.exp 1)] with x hxsmall hx
  intro S β c N hβ hN henv hc hS
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
  have hxone : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hx
  have hlog : 0 ≤ Real.log x := Real.log_nonneg hxone
  let X : ℝ := x ^ κ
  let U : ℕ := ⌊X⌋₊
  let H : ℝ := (Real.log x) ^ E
  have hX : 0 ≤ X := zero_le_one.trans (Real.one_le_rpow hxone hκ)
  have hU : (U : ℝ) ≤ X := Nat.floor_le hX
  have hH : 0 ≤ H := Real.rpow_nonneg hlog E
  have hbox : ∀ p ∈ S, 1 ≤ p.1 ∧ p.1 ≤ U ∧ 1 ≤ p.2 ∧ p.2 ≤ U := by
    intro p hp
    obtain ⟨hqpos, hrpos, hq, hr⟩ := hS p hp
    exact ⟨hqpos, Nat.le_floor hq, hrpos, Nat.le_floor hr⟩
  have hfinite := mixedCorrelation_outer_coefficient_mass_le S β c N U U d B H
    hB hH hβ hc hbox henv
  have hcoefficient : B * H * (N : ℝ) ^ (d + 1) ≤ B * H * X ^ (d + 1) :=
    mul_le_mul_of_nonneg_left (pow_le_pow_left₀ (Nat.cast_nonneg N) hN (d + 1))
      (mul_nonneg hB hH)
  have hpair : (U : ℝ) * (U : ℝ) ^ 2 ≤ X * X ^ 2 :=
    mul_le_mul hU (pow_le_pow_left₀ (Nat.cast_nonneg U) hU 2) (sq_nonneg _) hX
  have hpolynomial : X * X ^ 2 * (B * H * X ^ (d + 1)) ^ 2 =
      B ^ 2 * H ^ 2 * X ^ (2 * d + 5) := by
    calc
      _ = B ^ 2 * H ^ 2 * (X ^ 3 * (X ^ (d + 1)) ^ 2) := by ring
      _ = _ := by
        rw [← pow_mul, ← pow_add, show 3 + (d + 1) * 2 = 2 * d + 5 by omega]
  have hHpower : H ^ 2 = (Real.log x) ^ (2 * E) := by
    simpa only [H, Nat.cast_ofNat, mul_comm] using
      (Real.rpow_mul_natCast hlog E 2).symm
  have hXpower : X ^ (2 * d + 5) = x ^ (((2 * d + 5 : ℕ) : ℝ) * κ) := by
    simpa only [X, mul_comm] using
      (Real.rpow_mul_natCast hxpos.le κ (2 * d + 5)).symm
  have hscalar : B ^ 2 * (Real.log x) ^ (2 * E) ≤ x ^ η := by
    simpa only [Real.norm_of_nonneg (mul_nonneg (sq_nonneg B) (Real.rpow_nonneg hlog (2 * E))),
      Real.norm_of_nonneg (Real.rpow_nonneg hxpos.le η)] using hxsmall
  calc
    _ ≤ (U : ℝ) * (U : ℝ) ^ 2 * (B * H * (N : ℝ) ^ (d + 1)) ^ 2 := hfinite
    _ ≤ X * X ^ 2 * (B * H * X ^ (d + 1)) ^ 2 :=
      mul_le_mul hpair (pow_le_pow_left₀ (by positivity) hcoefficient 2)
        (sq_nonneg _) (mul_nonneg hX (sq_nonneg X))
    _ = B ^ 2 * (Real.log x) ^ (2 * E) * x ^ (((2 * d + 5 : ℕ) : ℝ) * κ) := by
      rw [hpolynomial, hHpower, hXpower]
    _ ≤ x ^ η * x ^ (((2 * d + 5 : ℕ) : ℝ) * κ) :=
      mul_le_mul_of_nonneg_right hscalar (Real.rpow_nonneg hxpos.le _)
    _ = _ := by rw [← Real.rpow_add hxpos, add_comm η]

theorem eventually_scale_dominates_cutoff_of_product_lower
    (c C σ ε K : ℝ) (hc : 0 < c) (hC : 0 < C) (hK : 0 < K)
    (hgap : σ + ε < 1) :
    ∀ᶠ x : ℝ in Filter.atTop, ∀ M N : ℝ,
      0 < N → N ≤ C * x ^ σ → c * x ≤ M * N → K * x ^ ε < M := by
  have hmargin : 0 < 1 - σ - ε := by linarith
  have hgrow : Filter.Tendsto (fun x : ℝ => c / C * x ^ (1 - σ - ε))
      Filter.atTop Filter.atTop :=
    Filter.Tendsto.const_mul_atTop (div_pos hc hC) (tendsto_rpow_atTop hmargin)
  filter_upwards [Filter.eventually_gt_atTop (0 : ℝ),
    hgrow.eventually_ge_atTop (2 * K)] with x hx hlarge
  intro M N hN hNupper hMN
  have hM : 0 < M :=
    pos_of_mul_pos_left ((mul_pos hc hx).trans_le hMN) hN.le
  have hstrict : K < c / C * x ^ (1 - σ - ε) := by linarith
  have hxε : 0 < x ^ ε := Real.rpow_pos_of_pos hx ε
  have hxσ : 0 < x ^ σ := Real.rpow_pos_of_pos hx σ
  calc
    K * x ^ ε < (c / C * x ^ (1 - σ - ε)) * x ^ ε :=
      mul_lt_mul_of_pos_right hstrict hxε
    _ = c * x / (C * x ^ σ) := by
      rw [Real.rpow_sub hx, Real.rpow_sub hx, Real.rpow_one]
      field_simp [hC.ne', hxε.ne', hxσ.ne']
    _ ≤ M := (div_le_iff₀ (mul_pos hC hxσ)).mpr
      (hMN.trans (mul_le_mul_of_nonneg_left hNupper hM.le))

/--
The discrete Fourier coefficient `M⁻¹ ∑' t : ℤ, ψM(t / M) * exp(-2πi * t * h / P)`. The
definition uses an integer `tsum`; summability is a separate hypothesis when needed.
-/
noncomputable def sourcePhi (ψM : ℝ → ℝ) (M : ℝ) (P : ℕ) (h : ℤ) : ℂ :=
  (M : ℂ)⁻¹ * ∑' t : ℤ, (ψM ((t : ℝ) / M) : ℂ) *
    (Real.fourierChar (-((t : ℝ) * (h : ℝ) / (P : ℝ))) : ℂ)

open Classical in
/--
The real indicator that `n * (n + ℓ * r)` is coprime to `q₀` and the inverse residue
prescriptions `b₁ / n` and `b₂ / (n + ℓ * r)` agree modulo `q₀`.
-/
noncomputable def sourceCompatibility
    (r q₀ b₁ b₂ : ℕ) (ℓ n : ℤ) : ℝ :=
  if Int.gcd (n * (n + ℓ * (r : ℤ))) (q₀ : ℤ) = 1 ∧
      (b₁ : ZMod q₀) * (n : ZMod q₀)⁻¹ =
        (b₂ : ZMod q₀) * ((n + ℓ * (r : ℤ) : ℤ) : ZMod q₀)⁻¹
  then 1 else 0

/--
The product of three reciprocal-unit phases at moduli `r`, `q₀ * u * v`, and `q₂`, encoding
frequencies `a * h`, `b₁ * h`, and `b₂ * h` with the appropriate complementary-modulus
denominators. It is zero if any of the three moduli is zero.
-/
noncomputable def sourceTheta
    (r q₀ u v q₂ a b₁ b₂ : ℕ) (ℓ n h : ℤ) : ℂ :=
  if hp : r ≠ 0 ∧ q₀ * u * v ≠ 0 ∧ q₂ ≠ 0 then
    let _ : NeZero r := ⟨hp.1⟩
    let _ : NeZero (q₀ * u * v) := ⟨hp.2.1⟩
    let _ : NeZero q₂ := ⟨hp.2.2⟩
    reciprocalUnitPhase r
      ((a : ZMod r) * (h : ZMod r))
      ((n : ZMod r) * ((q₀ * u * v * q₂ : ℕ) : ZMod r)) *
    reciprocalUnitPhase (q₀ * u * v)
      ((b₁ : ZMod (q₀ * u * v)) * (h : ZMod (q₀ * u * v)))
      ((n : ZMod (q₀ * u * v)) * ((r * q₂ : ℕ) : ZMod (q₀ * u * v))) *
    reciprocalUnitPhase q₂
      ((b₂ : ZMod q₂) * (h : ZMod q₂))
      (((n + ℓ * (r : ℤ) : ℤ) : ZMod q₂) *
        ((r * q₀ * u * v : ℕ) : ZMod q₂))
  else 0

open Classical in
/--
The sum of norms of weighted Fourier-phase correlations over pairs of tuples in `𝒜` that agree
in their first, second, and fourth coordinates. Each correlation sums over `h₁, h₂ ∈ J` and
integers `n`, imposing coprimality and inverse-residue compatibility before pairing one phase
with the conjugate of the other.
-/
noncomputable def sourceSigmaOne
    (𝒜 : Finset (ℕ × ℕ × ℕ × ℕ)) (J : Finset ℤ)
    (ψM wN : ℝ → ℝ) (M : ℝ) (q₀ a b₁ b₂ : ℕ) (ℓ : ℤ) : ℝ :=
  ∑ t₁ ∈ 𝒜,
    ∑ t₂ ∈ 𝒜.filter (fun t₂ =>
      t₂.1 = t₁.1 ∧ t₂.2.1 = t₁.2.1 ∧ t₂.2.2.2 = t₁.2.2.2),
      ‖∑ h₁ ∈ J, ∑ h₂ ∈ J, ∑' n : ℤ,
        if Int.gcd n
              ((t₁.1 * q₀ * t₁.2.1 * t₁.2.2.1 * t₂.2.2.1 : ℕ) : ℤ) = 1 ∧
            Int.gcd (n + ℓ * (t₁.1 : ℤ)) ((q₀ * t₁.2.2.2 : ℕ) : ℤ) = 1
        then (sourceCompatibility t₁.1 q₀ b₁ b₂ ℓ n : ℂ) *
          sourcePhi ψM M (t₁.1 * q₀ * t₁.2.1 * t₁.2.2.1 * t₁.2.2.2) h₁ *
          star (sourcePhi ψM M (t₁.1 * q₀ * t₁.2.1 * t₂.2.2.1 * t₁.2.2.2) h₂) *
          (wN (n : ℝ) : ℂ) *
          (sourceTheta t₁.1 q₀ t₁.2.1 t₁.2.2.1 t₁.2.2.2 a b₁ b₂ ℓ n h₁ *
            star (sourceTheta t₁.1 q₀ t₁.2.1 t₂.2.2.1 t₁.2.2.2 a b₁ b₂ ℓ n h₂))
        else 0‖

theorem sourceAssembly_gcd_factorization
    (q₁ q₂ r u₀ d : ℕ)
    (hq₁ : 0 < q₁) (hq₂ : 0 < q₂) (hr : 0 < r)
    (hsq₁ : Squarefree (q₁ * r)) (hsq₂ : Squarefree (q₂ * r))
    (hprim₁ : Nat.Coprime d (q₁ * r))
    (hprim₂ : Nat.Coprime d (q₂ * r))
    (hu₀ : 0 < u₀ ∧ u₀ ∣ q₁ / Nat.gcd q₁ q₂) :
    let g := Nat.gcd q₁ q₂
    let v := (q₁ / g) / u₀
    let k₂ := q₂ / g
    0 < g ∧ 0 < v ∧ 0 < k₂ ∧
      g * u₀ * v = q₁ ∧ g * k₂ = q₂ ∧
      r * Nat.lcm q₁ q₂ = r * g * u₀ * v * k₂ ∧
      Squarefree (r * g * u₀ * v * k₂) ∧
      Nat.Coprime (r * g * u₀ * v * k₂) d := by
  intro g v k₂
  have hv : 0 < v :=
    Nat.div_pos (Nat.le_of_dvd (Nat.div_gcd_pos_of_pos_left q₂ hq₁) hu₀.2) hu₀.1
  have hq₁' : g * u₀ * v = q₁ := by
    rw [Nat.mul_assoc, Nat.mul_div_cancel' hu₀.2,
      Nat.mul_div_cancel' (Nat.gcd_dvd_left q₁ q₂)]
  have hperiod : r * Nat.lcm q₁ q₂ = r * g * u₀ * v * k₂ := by
    rw [show Nat.lcm q₁ q₂ = q₁ * k₂ from
      Nat.mul_div_assoc q₁ (Nat.gcd_dvd_right q₁ q₂), ← hq₁']
    ring
  have hne₁ : q₁ * r ≠ 0 := by positivity
  have hne₂ : q₂ * r ≠ 0 := by positivity
  have hsquare : Squarefree (Nat.lcm (q₁ * r) (q₂ * r)) := by
    apply Nat.squarefree_of_factorization_le_one (Nat.lcm_ne_zero hne₁ hne₂)
    intro p
    rw [Nat.factorization_lcm hne₁ hne₂, Finsupp.sup_apply]
    exact max_le (hsq₁.natFactorization_le_one p) (hsq₂.natFactorization_le_one p)
  have hP : Nat.lcm (q₁ * r) (q₂ * r) = r * g * u₀ * v * k₂ := by
    rw [Nat.lcm_mul_right, Nat.mul_comm (Nat.lcm q₁ q₂) r]
    exact hperiod
  exact ⟨by positivity, hv, Nat.div_gcd_pos_of_pos_right q₁ hq₂, hq₁',
    Nat.mul_div_cancel' (Nat.gcd_dvd_right q₁ q₂), hperiod, hP ▸ hsquare,
    hP ▸ (fiberCRT_coprime_lcm hprim₁ hprim₂).symm⟩

theorem sourceAssembly_signed_support_reindex
    (β : ℕ →₀ ℂ) (r : ℕ) (hr : 0 < r)
    (F : ℕ → ℕ → ℂ)
    (hF : ∀ n₁ ∈ β.support, ∀ n₂ ∈ β.support,
      ¬ Nat.ModEq r n₁ n₂ → F n₁ n₂ = 0) :
    let γ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
    let L : Finset ℤ :=
      ((γ.support ×ˢ γ.support).filter
        (fun p => p.1 ≠ p.2 ∧ Int.ModEq (r : ℤ) p.1 p.2)).image
          (fun p => (p.2 - p.1) / (r : ℤ))
    (∀ ℓ ∈ L, ℓ ≠ 0 ∧
      ∃ n ∈ γ.support, n + ℓ * (r : ℤ) ∈ γ.support) ∧
    (∀ A N : ℕ, β.support ⊆ Finset.Icc A (A + N) →
      ∀ ℓ ∈ L, ℓ.natAbs * r ≤ N) ∧
    ((∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
        if n₁ = n₂ then 0 else β n₁ * star (β n₂) * F n₁ n₂) =
      ∑ ℓ ∈ L,
        ∑ n ∈ γ.support.filter (fun n => n + ℓ * (r : ℤ) ∈ γ.support),
          γ n * star (γ (n + ℓ * (r : ℤ))) *
            F n.toNat (n + ℓ * (r : ℤ)).toNat) := by
  intro γ L
  let D := (γ.support ×ˢ γ.support).filter
    (fun p => p.1 ≠ p.2 ∧ Int.ModEq (r : ℤ) p.1 p.2)
  let e : ℤ × ℤ → ℤ × ℤ := fun p => ((p.2 - p.1) / (r : ℤ), p.1)
  let T := (L ×ˢ γ.support).filter (fun p => p.2 + p.1 * (r : ℤ) ∈ γ.support)
  have hrZ : (r : ℤ) ≠ 0 := by positivity
  have hshift (p : ℤ × ℤ) (hp : p ∈ D) : p.1 + (e p).1 * (r : ℤ) = p.2 := by
    dsimp only [e]
    rw [Int.ediv_mul_cancel_of_dvd (Finset.mem_filter.mp hp).2.2.dvd, add_sub_cancel]
  have hL : ∀ ℓ ∈ L, ℓ ≠ 0 ∧
      ∃ n ∈ γ.support, n + ℓ * (r : ℤ) ∈ γ.support := by
    intro ℓ hℓ
    obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hℓ
    have hp' := Finset.mem_product.mp (Finset.mem_filter.mp hp).1
    refine ⟨?_, p.1, hp'.1, ?_⟩
    · change (e p).1 ≠ 0
      intro hz
      apply (Finset.mem_filter.mp hp).2.1
      simpa only [hz, zero_mul, add_zero] using hshift p hp
    · rw [hshift p hp]
      exact hp'.2
  have hwidth : ∀ A N : ℕ, β.support ⊆ Finset.Icc A (A + N) →
      ∀ ℓ ∈ L, ℓ.natAbs * r ≤ N := by
    intro A N hβ ℓ hℓ
    obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hℓ
    have hsupport (n : ℤ) (hn : n ∈ γ.support) :
        (A : ℤ) ≤ n ∧ n ≤ (A : ℤ) + (N : ℤ) := by
      obtain ⟨m, hm, rfl⟩ := Finset.mem_map.mp hn
      simp only [Nat.castEmbedding_apply]
      exact_mod_cast (Finset.mem_Icc.mp (hβ hm))
    have hp' := Finset.mem_product.mp (Finset.mem_filter.mp hp).1
    have hn₁ := hsupport p.1 hp'.1
    have hn₂ := hsupport p.2 hp'.2
    have hdiff : |p.2 - p.1| ≤ (N : ℤ) := abs_le.mpr ⟨by omega, by omega⟩
    have hmulNat := congrArg Int.natAbs (eq_sub_of_add_eq' (hshift p hp))
    rw [Int.natAbs_mul, Int.natAbs_natCast] at hmulNat
    simpa only [← Int.natCast_natAbs, Int.ofNat_le, ← hmulNat] using hdiff
  have hnat :
      (∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
        if n₁ = n₂ then 0 else β n₁ * star (β n₂) * F n₁ n₂) =
      ∑ p ∈ D, γ p.1 * star (γ p.2) * F p.1.toNat p.2.toNat := by
    have hemb (n : ℕ) :
        (Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β) (n : ℤ) = β n :=
      Finsupp.embDomain_apply_self (Nat.castEmbedding : ℕ ↪ ℤ) β n
    simp only [D, Finset.sum_filter, Finset.sum_product, γ,
      Finsupp.support_embDomain, Finset.sum_map, Nat.castEmbedding_apply,
      Int.toNat_natCast, Int.natCast_modEq_iff, hemb]
    apply Finset.sum_congr rfl
    intro n₁ hn₁
    apply Finset.sum_congr rfl
    intro n₂ hn₂
    by_cases hmod : Nat.ModEq r n₁ n₂
    · simp [hmod]
    · simp [hmod, hF n₁ hn₁ n₂ hn₂ hmod]
  have hsum :
      (∑ p ∈ D, γ p.1 * star (γ p.2) * F p.1.toNat p.2.toNat) =
      ∑ ℓ ∈ L,
        ∑ n ∈ γ.support.filter (fun n => n + ℓ * (r : ℤ) ∈ γ.support),
          γ n * star (γ (n + ℓ * (r : ℤ))) *
            F n.toNat (n + ℓ * (r : ℤ)).toNat := by
    calc
      _ = ∑ p ∈ T, γ p.2 * star (γ (p.2 + p.1 * (r : ℤ))) *
          F p.2.toNat (p.2 + p.1 * (r : ℤ)).toNat := by
        apply Finset.sum_nbij e
        · intro p hp
          have hp' := Finset.mem_product.mp (Finset.mem_filter.mp hp).1
          refine Finset.mem_filter.mpr ⟨Finset.mem_product.mpr
            ⟨Finset.mem_image_of_mem _ hp, hp'.1⟩, ?_⟩
          rw [hshift p hp]
          exact hp'.2
        · exact Set.LeftInvOn.injOn
            (f₁' := fun p : ℤ × ℤ => (p.2, p.2 + p.1 * (r : ℤ)))
            (fun p hp => Prod.ext rfl (hshift p hp))
        · intro t ht
          have ht' := Finset.mem_filter.mp ht
          have htp := Finset.mem_product.mp ht'.1
          refine ⟨(t.2, t.2 + t.1 * (r : ℤ)), ?_, ?_⟩
          · refine Finset.mem_filter.mpr
              ⟨Finset.mem_product.mpr ⟨htp.2, ht'.2⟩, ?_, ?_⟩
            · exact left_ne_add.mpr (mul_ne_zero (hL t.1 htp.1).1 hrZ)
            · exact Int.modEq_add_mul_modulus_iff.mpr Int.ModEq.rfl
          · simp only [e, add_sub_cancel_left, Int.mul_ediv_cancel t.1 hrZ]
        · intro p hp
          rw [hshift p hp]
      _ = _ := by simp only [T, Finset.sum_filter, Finset.sum_product]
  exact ⟨hL, hwidth, hnat.trans hsum⟩

theorem sourceAssembly_ordered_gcd_sum
    (S : Finset (ℕ × ℕ)) (u : ℕ → ℕ → ℕ)
    (F : ℕ → (ℕ × ℕ) → (ℕ × ℕ) → ℂ)
    (hu : ∀ p₁ ∈ S, ∀ p₂ ∈ S, p₁.2 = p₂.2 →
      let g := Nat.gcd p₁.1 p₂.1
      u g (p₁.1 / g) ∣ p₁.1 / g) :
    let Ω := (S ×ˢ S).filter (fun p => p.1.2 = p.2.2)
    let G := Ω.image (fun p => Nat.gcd p.1.1 p.2.1)
    let 𝒜 : ℕ → Finset (ℕ × ℕ × ℕ × ℕ) := fun g =>
      (Ω.filter (fun p => Nat.gcd p.1.1 p.2.1 = g)).image (fun p =>
        (p.1.2, u g (p.1.1 / g), (p.1.1 / g) / u g (p.1.1 / g), p.2.1 / g))
    (∑ r ∈ S.image Prod.snd,
      ∑ p₁ ∈ S.filter (fun p => p.2 = r),
        ∑ p₂ ∈ S.filter (fun p => p.2 = r), F r p₁ p₂) =
      ∑ g ∈ G, ∑ t ∈ 𝒜 g,
        F t.1 (g * t.2.1 * t.2.2.1, t.1) (g * t.2.2.2, t.1) := by
  intro Ω G 𝒜
  let φ : ℕ → (ℕ × ℕ) × (ℕ × ℕ) → ℕ × ℕ × ℕ × ℕ := fun g p =>
    (p.1.2, u g (p.1.1 / g), (p.1.1 / g) / u g (p.1.1 / g), p.2.1 / g)
  let ρ : ℕ → (ℕ × ℕ × ℕ × ℕ) → (ℕ × ℕ) × (ℕ × ℕ) := fun g t =>
    ((g * t.2.1 * t.2.2.1, t.1), (g * t.2.2.2, t.1))
  have hrec (g : ℕ) : Set.LeftInvOn (ρ g) (φ g)
      (Ω.filter (fun p => Nat.gcd p.1.1 p.2.1 = g)) := by
    intro p hp
    obtain ⟨hpΩ, hg⟩ := Finset.mem_filter.mp hp
    subst g
    obtain ⟨hpS, hr⟩ := Finset.mem_filter.mp hpΩ
    obtain ⟨hp₁, hp₂⟩ := Finset.mem_product.mp hpS
    dsimp only [ρ, φ]
    refine Prod.ext (Prod.ext ?_ rfl) (Prod.ext ?_ hr)
    · rw [Nat.mul_assoc, Nat.mul_div_cancel' (hu p.1 hp₁ p.2 hp₂ hr),
        Nat.mul_div_cancel' (Nat.gcd_dvd_left p.1.1 p.2.1)]
    · exact Nat.mul_div_cancel' (Nat.gcd_dvd_right p.1.1 p.2.1)
  calc
    _ = ∑ p ∈ Ω, F p.1.2 p.1 p.2 := by
      rw [Finset.sum_finset_product' (f := fun p₁ p₂ => F p₁.2 p₁ p₂) Ω S
        (fun p₁ => S.filter (fun p₂ => p₂.2 = p₁.2))
        (fun p => by simp only [Ω, Finset.mem_filter, Finset.mem_product, and_assoc, eq_comm])]
      rw [← Finset.sum_fiberwise_of_maps_to
        (s := S) (t := S.image Prod.snd) (g := Prod.snd)
        (fun _ hp => Finset.mem_image_of_mem _ hp)
        (fun p₁ => ∑ p₂ ∈ S.filter (fun p₂ => p₂.2 = p₁.2), F p₁.2 p₁ p₂)]
      apply Finset.sum_congr rfl
      intro r _
      apply Finset.sum_congr rfl
      intro p₁ hp₁
      rw [(Finset.mem_filter.mp hp₁).2]
    _ = ∑ g ∈ G, ∑ p ∈ Ω.filter (fun p => Nat.gcd p.1.1 p.2.1 = g),
        F p.1.2 p.1 p.2 :=
      (Finset.sum_fiberwise_of_maps_to
        (s := Ω) (t := G) (g := fun p => Nat.gcd p.1.1 p.2.1)
        (fun _ hp => Finset.mem_image_of_mem _ hp)
        (fun p => F p.1.2 p.1 p.2)).symm
    _ = ∑ g ∈ G, ∑ t ∈ 𝒜 g,
        F t.1 (g * t.2.1 * t.2.2.1, t.1) (g * t.2.2.2, t.1) := by
      apply Finset.sum_congr rfl
      intro g _
      change _ =
          ∑ t ∈ (Ω.filter (fun p => Nat.gcd p.1.1 p.2.1 = g)).image (φ g),
            F t.1 (ρ g t).1 (ρ g t).2
      rw [Finset.sum_image (hrec g).injOn]
      apply Finset.sum_congr rfl
      intro p hp
      rw [hrec g hp]

open Classical in
theorem sourceAssembly_grouped_coefficient_cauchy
    {ι κ ν : Type*} (A : Finset ι) (s : Finset ν) (base : ι → κ)
    (p : κ → ν → Prop) (a : ι → ℂ) (b : κ → ν → ℂ)
    (f : ι → ν → ℂ) (χ : ν → ℝ) (K : ℝ)
    (hK : 0 ≤ K) (ha : ∀ i ∈ A, ‖a i‖ ≤ K)
    (hχ : ∀ n ∈ s, 0 ≤ χ n)
    (hmajor : ∀ j ∈ A.image base, ∀ n ∈ s,
      p j n → b j n ≠ 0 → 1 ≤ χ n) :
    (∑ i ∈ A, ‖a i * ∑ n ∈ s.filter (p (base i)), b (base i) n * f i n‖) ^ 2 ≤
      K ^ 2 *
        (∑ j ∈ A.image base, ∑ n ∈ s.filter (p j), ‖b j n‖ ^ 2) *
          (∑ i₁ ∈ A, ∑ i₂ ∈ A.filter (fun i₂ => base i₂ = base i₁),
            ‖∑ n ∈ s.filter (p (base i₁)),
              (χ n : ℂ) * f i₁ n * star (f i₂ n)‖) := by
  let B := A.image base
  let I := (B ×ˢ s).filter (fun t => p t.1 t.2)
  let L : ℝ := ∑ i ∈ A,
    ‖a i * ∑ n ∈ s.filter (p (base i)), b (base i) n * f i n‖
  choose z hz using fun i : ι => Complex.exists_norm_eq_mul_self
    (a i * ∑ n ∈ s.filter (p (base i)), b (base i) n * f i n)
  let d : ι → ℂ := fun i => z i * a i
  let F : κ → ν → ℂ := fun j n =>
    ∑ i ∈ A.filter (fun i => base i = j), d i * f i n
  let G : ℝ := ∑ j ∈ B, ∑ n ∈ s.filter (p j), ‖b j n‖ ^ 2
  let E : ℝ := ∑ j ∈ B, ∑ n ∈ s.filter (p j), χ n * ‖F j n‖ ^ 2
  let H : ℝ := ∑ i₁ ∈ A, ∑ i₂ ∈ A.filter (fun i₂ => base i₂ = base i₁),
    ‖∑ n ∈ s.filter (p (base i₁)), (χ n : ℂ) * f i₁ n * star (f i₂ n)‖
  have hd (i : ι) (hi : i ∈ A) : ‖d i‖ ≤ K := by
    simpa only [d, norm_mul, (hz i).1, one_mul] using ha i hi
  have hlinear : (L : ℂ) =
      ∑ j ∈ B, ∑ n ∈ s.filter (p j), b j n * F j n := by
    calc
      (L : ℂ) = ∑ i ∈ A,
          d i * ∑ n ∈ s.filter (p (base i)), b (base i) n * f i n := by
        simp only [L, Complex.ofReal_sum]
        apply Finset.sum_congr rfl
        intro i _
        simpa only [d, mul_assoc] using (hz i).2
      _ = ∑ j ∈ B, ∑ i ∈ A.filter (fun i => base i = j),
          d i * ∑ n ∈ s.filter (p (base i)), b (base i) n * f i n :=
        (Finset.sum_fiberwise_of_maps_to (s := A) (t := B) (g := base)
          (fun i hi => Finset.mem_image_of_mem base hi) _).symm
      _ = _ := by
        apply Finset.sum_congr rfl
        intro j _
        calc
          _ = ∑ i ∈ A.filter (fun i => base i = j),
              ∑ n ∈ s.filter (p j), d i * (b j n * f i n) := by
            apply Finset.sum_congr rfl
            intro i hi
            rw [(Finset.mem_filter.mp hi).2, Finset.mul_sum]
          _ = ∑ n ∈ s.filter (p j),
              ∑ i ∈ A.filter (fun i => base i = j), d i * (b j n * f i n) :=
            Finset.sum_comm
          _ = _ := by
            simp only [F, Finset.mul_sum, mul_left_comm]
  have hL : 0 ≤ L := by positivity
  have hcs := Finset.sum_sq_le_sum_mul_sum_of_sq_le_mul I
    (r := fun t => ‖b t.1 t.2 * F t.1 t.2‖)
    (f := fun t => ‖b t.1 t.2‖ ^ 2)
    (g := fun t => χ t.2 * ‖F t.1 t.2‖ ^ 2)
    (fun _ _ => sq_nonneg _)
    (fun t ht => mul_nonneg
      (hχ t.2 (Finset.mem_product.mp (Finset.mem_filter.mp ht).1).2) (sq_nonneg _))
    (fun t ht => by
      by_cases hb : b t.1 t.2 = 0
      · simp [hb]
      · have hm := hmajor t.1
          (Finset.mem_product.mp (Finset.mem_filter.mp ht).1).1 t.2
          (Finset.mem_product.mp (Finset.mem_filter.mp ht).1).2
          (Finset.mem_filter.mp ht).2 hb
        simp only [norm_mul, mul_pow]
        exact mul_le_mul_of_nonneg_left
          (le_mul_of_one_le_left (sq_nonneg _) hm) (sq_nonneg _))
  have hLE : L ^ 2 ≤ G * E := by
    calc
      L ^ 2 ≤ (∑ t ∈ I, ‖b t.1 t.2 * F t.1 t.2‖) ^ 2 := by
        apply pow_le_pow_left₀ hL
        rw [← Complex.norm_of_nonneg hL, hlinear]
        simpa only [I, Finset.sum_filter, Finset.sum_product] using
          (norm_sum_le I (fun t => b t.1 t.2 * F t.1 t.2))
      _ ≤ G * E := by
        simpa only [G, E, I, Finset.sum_filter, Finset.sum_product] using hcs
  have hgram (j : κ) :
      ((∑ n ∈ s.filter (p j), χ n * ‖F j n‖ ^ 2 : ℝ) : ℂ) =
        ∑ i₁ ∈ A.filter (fun i => base i = j),
          ∑ i₂ ∈ A.filter (fun i => base i = j),
            d i₁ * star (d i₂) *
              ∑ n ∈ s.filter (p j), (χ n : ℂ) * f i₁ n * star (f i₂ n) := by
    calc
      _ = ∑ n ∈ s.filter (p j), (χ n : ℂ) * (F j n * star (F j n)) := by
        simp only [Complex.ofReal_sum, Complex.ofReal_mul, Complex.ofReal_pow,
          Complex.star_def, Complex.mul_conj']
      _ = ∑ n ∈ s.filter (p j),
          ∑ i₁ ∈ A.filter (fun i => base i = j),
            ∑ i₂ ∈ A.filter (fun i => base i = j),
              (d i₁ * star (d i₂)) * ((χ n : ℂ) * f i₁ n * star (f i₂ n)) := by
        simp only [F, star_sum, star_mul]
        simp_rw [Finset.sum_mul_sum]
        simp only [Finset.mul_sum, mul_assoc, mul_left_comm, mul_comm]
      _ = _ := by
        rw [← Finset.sum_comm_cycle]
        simp only [Finset.mul_sum]
  have hEj (j : κ) :
      (∑ n ∈ s.filter (p j), χ n * ‖F j n‖ ^ 2) ≤
        K ^ 2 * ∑ i₁ ∈ A.filter (fun i => base i = j),
          ∑ i₂ ∈ A.filter (fun i => base i = j),
            ‖∑ n ∈ s.filter (p j), (χ n : ℂ) * f i₁ n * star (f i₂ n)‖ := by
    have he : 0 ≤ ∑ n ∈ s.filter (p j), χ n * ‖F j n‖ ^ 2 :=
      Finset.sum_nonneg fun n hn =>
        mul_nonneg (hχ n (Finset.mem_filter.mp hn).1) (sq_nonneg _)
    rw [← Complex.norm_of_nonneg he, hgram]
    conv_rhs => simp only [Finset.mul_sum]
    refine norm_sum_le_of_le _ (fun i₁ hi₁ => ?_)
    refine norm_sum_le_of_le _ (fun i₂ hi₂ => ?_)
    simpa only [norm_mul, norm_star, pow_two] using
      mul_le_mul_of_nonneg_right
        (mul_le_mul
          (hd i₁ (Finset.mem_filter.mp hi₁).1)
          (hd i₂ (Finset.mem_filter.mp hi₂).1) (norm_nonneg _) hK)
        (norm_nonneg (∑ n ∈ s.filter (p j), (χ n : ℂ) * f i₁ n * star (f i₂ n)))
  have hgroup :
      (∑ j ∈ B, ∑ i₁ ∈ A.filter (fun i => base i = j),
        ∑ i₂ ∈ A.filter (fun i => base i = j),
          ‖∑ n ∈ s.filter (p j), (χ n : ℂ) * f i₁ n * star (f i₂ n)‖) = H := by
    calc
      _ = ∑ j ∈ B, ∑ i₁ ∈ A.filter (fun i => base i = j),
          ∑ i₂ ∈ A.filter (fun i₂ => base i₂ = base i₁),
            ‖∑ n ∈ s.filter (p (base i₁)),
              (χ n : ℂ) * f i₁ n * star (f i₂ n)‖ := by
        apply Finset.sum_congr rfl
        intro j _
        apply Finset.sum_congr rfl
        intro i₁ hi₁
        rw [(Finset.mem_filter.mp hi₁).2]
      _ = H := Finset.sum_fiberwise_of_maps_to (s := A) (t := B) (g := base)
        (fun i hi => Finset.mem_image_of_mem base hi) _
  have hE : E ≤ K ^ 2 * H := by
    simpa only [E, ← Finset.mul_sum, hgroup] using
      Finset.sum_le_sum (s := B) (fun j _ => hEj j)
  calc
    L ^ 2 ≤ G * E := hLE
    _ ≤ G * (K ^ 2 * H) := mul_le_mul_of_nonneg_left hE (by positivity)
    _ = _ := by ring

open Classical in
theorem sourceAssembly_sourceSigmaOne_eq_finite_gram
    (𝒜 : Finset (ℕ × ℕ × ℕ × ℕ)) (J : Finset ℤ)
    (ψM wN : ℝ → ℝ) (M : ℝ) (q₀ a b₁ b₂ : ℕ) (ℓ : ℤ)
    (s : Finset ℤ) (hsupport : ∀ n : ℤ, n ∉ s → wN (n : ℝ) = 0) :
    let base : (ℕ × ℕ × ℕ × ℕ) → ℕ × ℕ × ℕ :=
      fun t => (t.1, t.2.1, t.2.2.2)
    let p : (ℕ × ℕ × ℕ) → ℤ → Prop := fun t n =>
      Int.gcd n ((t.1 * q₀ * t.2.1 : ℕ) : ℤ) = 1 ∧
      Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2 : ℕ) : ℤ) = 1 ∧
      sourceCompatibility t.1 q₀ b₁ b₂ ℓ n = 1
    let f : (ℕ × ℕ × ℕ × ℕ) → ℤ → ℂ := fun t n =>
      if Int.gcd n (t.2.2.1 : ℤ) = 1 then
        ∑ h ∈ J,
          sourcePhi ψM M (t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2) h *
            sourceTheta t.1 q₀ t.2.1 t.2.2.1 t.2.2.2 a b₁ b₂ ℓ n h
      else 0
    sourceSigmaOne 𝒜 J ψM wN M q₀ a b₁ b₂ ℓ =
      ∑ t₁ ∈ 𝒜, ∑ t₂ ∈ 𝒜.filter (fun t₂ => base t₂ = base t₁),
        ‖∑ n ∈ s.filter (p (base t₁)),
          (wN (n : ℝ) : ℂ) * f t₁ n * star (f t₂ n)‖ := by
  dsimp only [sourceSigmaOne]
  simp only [Prod.mk.injEq]
  apply Finset.sum_congr rfl
  intro t₁ _
  apply Finset.sum_congr rfl
  intro t₂ ht₂
  obtain ⟨_, hr, hu, hq⟩ := Finset.mem_filter.mp ht₂
  rcases t₁ with ⟨r, u, v₁, q₂⟩
  rcases t₂ with ⟨r', u', v₂, q₂'⟩
  dsimp only at hr hu hq ⊢
  subst r'
  subst u'
  subst q₂'
  apply congrArg norm
  let A₁ : ℤ → ℤ → ℂ := fun n h =>
    sourcePhi ψM M (r * q₀ * u * v₁ * q₂) h *
      sourceTheta r q₀ u v₁ q₂ a b₁ b₂ ℓ n h
  let A₂ : ℤ → ℤ → ℂ := fun n h =>
    sourcePhi ψM M (r * q₀ * u * v₂ * q₂) h *
      sourceTheta r q₀ u v₂ q₂ a b₁ b₂ ℓ n h
  let U : ℤ → Prop := fun n =>
    Int.gcd n ((r * q₀ * u * v₁ * v₂ : ℕ) : ℤ) = 1 ∧
      Int.gcd (n + ℓ * (r : ℤ)) ((q₀ * q₂ : ℕ) : ℤ) = 1
  let E : ℤ → ℤ → ℤ → ℂ := fun h₁ h₂ n =>
    if U n then
      (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
        sourcePhi ψM M (r * q₀ * u * v₁ * q₂) h₁ *
        star (sourcePhi ψM M (r * q₀ * u * v₂ * q₂) h₂) *
        (wN (n : ℝ) : ℂ) *
        (sourceTheta r q₀ u v₁ q₂ a b₁ b₂ ℓ n h₁ *
          star (sourceTheta r q₀ u v₂ q₂ a b₁ b₂ ℓ n h₂))
    else 0
  change (∑ h₁ ∈ J, ∑ h₂ ∈ J, ∑' n : ℤ, E h₁ h₂ n) =
    ∑ n ∈ s.filter (fun n =>
        Int.gcd n ((r * q₀ * u : ℕ) : ℤ) = 1 ∧
          Int.gcd (n + ℓ * (r : ℤ)) ((q₀ * q₂ : ℕ) : ℤ) = 1 ∧
          sourceCompatibility r q₀ b₁ b₂ ℓ n = 1),
      (wN (n : ℝ) : ℂ) *
        (if Int.gcd n (v₁ : ℤ) = 1 then ∑ h ∈ J, A₁ n h else 0) *
        star (if Int.gcd n (v₂ : ℤ) = 1 then ∑ h ∈ J, A₂ n h else 0)
  have hfinite (h₁ h₂ : ℤ) :
      (∑' n : ℤ, E h₁ h₂ n) = ∑ n ∈ s, E h₁ h₂ n := by
    apply tsum_eq_sum
    intro n hn
    simp only [E, hsupport n hn, Complex.ofReal_zero, mul_zero, zero_mul, ite_self]
  have hmask (n : ℤ) : U n ↔
      (Int.gcd n ((r * q₀ * u : ℕ) : ℤ) = 1 ∧
        Int.gcd (n + ℓ * (r : ℤ)) ((q₀ * q₂ : ℕ) : ℤ) = 1) ∧
        Int.gcd n (v₁ : ℤ) = 1 ∧ Int.gcd n (v₂ : ℤ) = 1 := by
    simp only [U, Nat.cast_mul, ← Int.isCoprime_iff_gcd_eq_one,
      IsCoprime.mul_right_iff]
    tauto
  have hexpand (n : ℤ) :
      (∑ h₁ ∈ J, ∑ h₂ ∈ J, E h₁ h₂ n) =
        if U n then
          (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) * (wN (n : ℝ) : ℂ) *
            (∑ h ∈ J, A₁ n h) * star (∑ h ∈ J, A₂ n h)
        else 0 := by
    by_cases hm : U n
    · simp only [E, ite_eq_left hm]
      conv_rhs => rw [mul_assoc, star_sum, Finset.sum_mul_sum]
      simp only [Finset.mul_sum, A₁, A₂, star_mul,
        mul_assoc, mul_left_comm, mul_comm]
    · simp only [E, ite_eq_right hm, Finset.sum_const_zero]
  simp_rw [hfinite]
  calc
    (∑ h₁ ∈ J, ∑ h₂ ∈ J, ∑ n ∈ s, E h₁ h₂ n) =
        ∑ n ∈ s, ∑ h₁ ∈ J, ∑ h₂ ∈ J, E h₁ h₂ n :=
      Finset.sum_comm_cycle
    _ = _ := by
      rw [Finset.sum_filter]
      apply Finset.sum_congr rfl
      intro n _
      rw [hexpand]
      rcases (show sourceCompatibility r q₀ b₁ b₂ ℓ n = 1 ∨
          sourceCompatibility r q₀ b₁ b₂ ℓ n = 0 from
        ite_eq_or_eq _ _ _) with hc | hc
      · rw [apply_ite (star : ℂ → ℂ), star_zero,
          mul_ite_zero (Int.gcd n (v₁ : ℤ) = 1) (wN (n : ℝ) : ℂ)
            (∑ h ∈ J, A₁ n h), ite_zero_mul_ite_zero, ← ite_and]
        simp only [hc, Complex.ofReal_one, one_mul, and_true, hmask n]
      · simp [hc]

theorem natCast_add_one_le_geometric {b : ℝ} (hb : 1 < b) (k : ℕ) :
    (k : ℝ) + 1 ≤ (1 + (b - 1)⁻¹) * b ^ k := by
  calc
    (k : ℝ) + 1 ≤ b ^ k / (b - 1) + b ^ k :=
      add_le_add (Nat.cast_le_pow_div_sub hb k) (one_le_pow₀ hb.le)
    _ = _ := by ring

theorem exists_card_divisors_bound {epsilon : ℝ} (hepsilon : 0 < epsilon) :
    ∃ C : ℝ, 0 < C ∧ ∀ n : ℕ, n ≠ 0 →
      (n.divisors.card : ℝ) ≤ C * Real.rpow (n : ℝ) epsilon := by
  classical
  let eta : ℝ := epsilon / 2
  have heta : 0 < eta := by dsimp [eta]; positivity
  let b : ℝ := Real.rpow 2 eta
  have hb : 1 < b := Real.one_lt_rpow (by norm_num) heta
  let c : ℝ := 1 + (b - 1)⁻¹
  have hc : 1 ≤ c := by
    dsimp [c]
    exact le_add_of_nonneg_right (inv_nonneg.mpr (sub_nonneg.mpr hb.le))
  obtain ⟨C, hC, hCbound⟩ :=
    exists_primeFactors_power_bound hc heta
  refine ⟨C, hC, ?_⟩
  intro n hn
  have hn0 : (0 : ℝ) < n := by exact_mod_cast Nat.pos_of_ne_zero hn
  have hprime (p : ℕ) (hp : p ∈ n.primeFactors) (k : ℕ) :
      (k : ℝ) + 1 ≤ c * Real.rpow ((p : ℝ) ^ k) eta := by
    have hp2 : (2 : ℝ) ≤ p := by
      exact_mod_cast (Nat.prime_of_mem_primeFactors hp).two_le
    have hb_le : b ≤ Real.rpow (p : ℝ) eta :=
      Real.rpow_le_rpow (by norm_num) hp2 heta.le
    calc
      (k : ℝ) + 1 ≤ c * b ^ k := natCast_add_one_le_geometric hb k
      _ ≤ c * (Real.rpow (p : ℝ) eta) ^ k := by
        exact mul_le_mul_of_nonneg_left (pow_le_pow_left₀ (by positivity) hb_le k)
          (zero_le_one.trans hc)
      _ = _ := by
        simp only [Real.rpow_eq_pow]
        rw [Real.rpow_pow_comm (Nat.cast_nonneg p)]
  have hprod : (∏ p ∈ n.primeFactors, (p : ℝ) ^ n.factorization p) = (n : ℝ) := by
    exact_mod_cast (Nat.prod_primeFactors_pow_factorization hn).symm
  calc
    (n.divisors.card : ℝ) =
        ∏ p ∈ n.primeFactors, ((n.factorization p : ℝ) + 1) := by
      exact_mod_cast Nat.card_divisors hn
    _ ≤ ∏ p ∈ n.primeFactors,
        c * Real.rpow ((p : ℝ) ^ n.factorization p) eta := by
      apply Finset.prod_le_prod (fun p _ => by positivity)
      intro p hp
      exact hprime p hp _
    _ = c ^ n.primeFactors.card * Real.rpow (n : ℝ) eta := by
      simp only [Real.rpow_eq_pow]
      rw [Finset.prod_mul_distrib, Finset.prod_const,
        Real.finsetProd_rpow _ _ (fun p _ => pow_nonneg (Nat.cast_nonneg p) _), hprod]
    _ ≤ (C * Real.rpow (n : ℝ) eta) * Real.rpow (n : ℝ) eta :=
      mul_le_mul_of_nonneg_right (hCbound n hn) (Real.rpow_nonneg hn0.le _)
    _ = C * Real.rpow (n : ℝ) epsilon := by
      simp only [Real.rpow_eq_pow]
      rw [mul_assoc, ← Real.rpow_add hn0]
      congr 2
      dsimp [eta]
      ring

theorem exists_divisorPower_bound (D : ℕ) {epsilon : ℝ} (hepsilon : 0 < epsilon) :
    ∃ C : ℝ, 0 < C ∧ ∀ n : ℕ, n ≠ 0 →
      (n.divisors.card : ℝ) ^ D ≤ C * Real.rpow (n : ℝ) epsilon := by
  let eta : ℝ := epsilon / ((D : ℝ) + 1)
  have hden : (0 : ℝ) < (D : ℝ) + 1 := by positivity
  have heta : 0 < eta := div_pos hepsilon hden
  obtain ⟨C, hC, hbound⟩ := exists_card_divisors_bound heta
  refine ⟨C ^ D, pow_pos hC _, ?_⟩
  intro n hn
  have hn1 : (1 : ℝ) ≤ n := by exact_mod_cast Nat.one_le_iff_ne_zero.mpr hn
  have hexp : eta * (D : ℝ) ≤ epsilon := by
    have heq : eta * ((D : ℝ) + 1) = epsilon := by
      dsimp [eta]
      exact div_mul_cancel₀ _ hden.ne'
    nlinarith
  calc
    (n.divisors.card : ℝ) ^ D ≤ (C * Real.rpow (n : ℝ) eta) ^ D :=
      pow_le_pow_left₀ (Nat.cast_nonneg _) (hbound n hn) D
    _ = C ^ D * Real.rpow (n : ℝ) (eta * (D : ℝ)) := by
      simp only [Real.rpow_eq_pow]
      rw [mul_pow, Real.rpow_mul_natCast (by positivity)]
    _ ≤ C ^ D * Real.rpow (n : ℝ) epsilon :=
      mul_le_mul_of_nonneg_left
        (Real.rpow_le_rpow_of_exponent_le hn1 hexp) (pow_nonneg hC.le _)

open Classical in
theorem sourceCompatibility_fixed_shift_count_le
    (q₀ r b₁ b₂ N : ℕ) [NeZero q₀] (ℓ : ℤ)
    (hb₁ : Nat.Coprime b₁ q₀) (hr : Nat.Coprime r q₀) :
    (((Finset.Icc 1 N).filter (fun n : ℕ =>
      sourceCompatibility r q₀ b₁ b₂ ℓ (n : ℤ) = 1)).card : ℝ) ≤
        (Int.gcd (q₀ : ℤ) ℓ : ℝ) * (1 + (N : ℝ) / (q₀ : ℝ)) := by
  have hq : 0 < q₀ := Nat.pos_of_ne_zero (NeZero.ne q₀)
  have hqz : (0 : ℤ) < q₀ := by exact_mod_cast hq
  have hqr : (0 : ℝ) < q₀ := by exact_mod_cast hq
  let S := (Finset.Icc 1 N).filter (fun n : ℕ =>
    sourceCompatibility r q₀ b₁ b₂ ℓ (n : ℤ) = 1)
  let g : ℕ := Int.gcd (q₀ : ℤ) ℓ
  change (S.card : ℝ) ≤ (g : ℝ) * (1 + (N : ℝ) / (q₀ : ℝ))
  by_cases hS : S.Nonempty
  · obtain ⟨n₀, hn₀⟩ := hS
    have hlinear (n : ℤ) (hn : sourceCompatibility r q₀ b₁ b₂ ℓ n = 1) :
        Int.ModEq (q₀ : ℤ) (((b₁ : ℤ) - (b₂ : ℤ)) * n)
          (-((b₁ : ℤ) * ℓ * (r : ℤ))) := by
      have hcondition : Int.gcd (n * (n + ℓ * (r : ℤ))) (q₀ : ℤ) = 1 ∧
          (b₁ : ZMod q₀) * (n : ZMod q₀)⁻¹ =
            (b₂ : ZMod q₀) * ((n + ℓ * (r : ℤ) : ℤ) : ZMod q₀)⁻¹ :=
        (one_ne_zero : (1 : ℝ) ≠ 0).ite_eq_left_iff.mp hn
      have hcop : IsCoprime (n * (n + ℓ * (r : ℤ))) (q₀ : ℤ) :=
        Int.isCoprime_iff_gcd_eq_one.mpr hcondition.1
      have hninv : (n : ZMod q₀)⁻¹ * (n : ZMod q₀) = 1 :=
        ZMod.coe_int_inv_mul_eq_one hcop.of_mul_left_left
      have hshiftinv : ((n + ℓ * (r : ℤ) : ℤ) : ZMod q₀)⁻¹ *
          ((n + ℓ * (r : ℤ) : ℤ) : ZMod q₀) = 1 :=
        ZMod.coe_int_inv_mul_eq_one hcop.of_mul_left_right
      have hcross : (b₁ : ZMod q₀) * ((n + ℓ * (r : ℤ) : ℤ) : ZMod q₀) =
          (b₂ : ZMod q₀) * (n : ZMod q₀) := by
        calc
          _ = ((b₁ : ZMod q₀) * (n : ZMod q₀)⁻¹) * (n : ZMod q₀) *
              ((n + ℓ * (r : ℤ) : ℤ) : ZMod q₀) := by
            rw [mul_assoc (b₁ : ZMod q₀) (n : ZMod q₀)⁻¹ (n : ZMod q₀),
              hninv, mul_one]
          _ = ((b₂ : ZMod q₀) * ((n + ℓ * (r : ℤ) : ℤ) : ZMod q₀)⁻¹) *
              (n : ZMod q₀) * ((n + ℓ * (r : ℤ) : ℤ) : ZMod q₀) :=
            congrArg (fun z : ZMod q₀ => z * (n : ZMod q₀) *
              ((n + ℓ * (r : ℤ) : ℤ) : ZMod q₀)) hcondition.2
          _ = ((b₂ : ZMod q₀) * (n : ZMod q₀)) *
              (((n + ℓ * (r : ℤ) : ℤ) : ZMod q₀)⁻¹ *
                ((n + ℓ * (r : ℤ) : ℤ) : ZMod q₀)) := by ring
          _ = _ := by rw [hshiftinv, mul_one]
      have hcrossInt : Int.ModEq (q₀ : ℤ)
          ((b₁ : ℤ) * (n + ℓ * (r : ℤ))) ((b₂ : ℤ) * n) := by
        apply (ZMod.intCast_eq_intCast_iff _ _ q₀).mp
        simpa only [Int.cast_mul, Int.cast_natCast] using hcross
      apply Int.modEq_of_dvd
      convert hcrossInt.dvd using 1
      ring
    let d : ℕ := Int.gcd (q₀ : ℤ) ((b₁ : ℤ) - (b₂ : ℤ))
    let m : ℤ := (q₀ : ℤ) / (d : ℤ)
    have hgpos : 0 < g := Int.gcd_pos_of_ne_zero_left _ hqz.ne'
    have hdq : (d : ℤ) ∣ (q₀ : ℤ) := Int.gcd_dvd_left _ _
    have hdc : (d : ℤ) ∣ (b₁ : ℤ) - (b₂ : ℤ) := Int.gcd_dvd_right _ _
    have hmpos : 0 < m :=
      Int.ediv_pos_of_pos_of_dvd hqz (Int.natCast_nonneg d) hdq
    have hn₀compat : sourceCompatibility r q₀ b₁ b₂ ℓ (n₀ : ℤ) = 1 :=
      (Finset.mem_filter.mp hn₀).2
    have hdnegative : (d : ℤ) ∣ -((b₁ : ℤ) * ℓ * (r : ℤ)) := by
      have hsub := hdq.trans ((hlinear n₀ hn₀compat).dvd)
      have hmultiple : (d : ℤ) ∣ ((b₁ : ℤ) - (b₂ : ℤ)) * (n₀ : ℤ) :=
        dvd_mul_of_dvd_left hdc _
      simpa only [sub_add_cancel] using dvd_add hsub hmultiple
    have hdproduct : (d : ℤ) ∣ ((b₁ : ℤ) * (r : ℤ)) * ℓ := by
      simpa only [dvd_neg, mul_right_comm (b₁ : ℤ) ℓ (r : ℤ)] using hdnegative
    have hcopProduct : IsCoprime ((b₁ : ℤ) * (r : ℤ)) (q₀ : ℤ) :=
      hb₁.isCoprime.mul_left hr.isCoprime
    have hcopD : IsCoprime (d : ℤ) ((b₁ : ℤ) * (r : ℤ)) :=
      hcopProduct.symm.of_isCoprime_of_dvd_left hdq
    have hdell : (d : ℤ) ∣ ℓ := hcopD.dvd_of_dvd_mul_left hdproduct
    have hdg : d ∣ g := Int.dvd_gcd hdq hdell
    have hdgReal : (d : ℝ) ≤ (g : ℝ) := Nat.cast_le.mpr (Nat.le_of_dvd hgpos hdg)
    have hgOne : (1 : ℝ) ≤ (g : ℝ) := Nat.one_le_cast.mpr hgpos
    let T := (Finset.Ioc (0 : ℤ) (N : ℤ)).filter
      (fun n => Int.ModEq m n (n₀ : ℤ))
    have hcardST : S.card ≤ T.card := by
      apply Finset.card_le_card_of_injOn (fun n : ℕ => (n : ℤ))
      · intro n hn
        have hnr := Finset.mem_Icc.mp (Finset.mem_filter.mp hn).1
        refine Finset.mem_filter.mpr ⟨Finset.mem_Ioc.mpr ⟨?_, ?_⟩, ?_⟩
        · exact Int.natCast_pos.mpr hnr.1
        · exact Int.ofNat_le.mpr hnr.2
        · exact Int.ModEq.cancel_left_div_gcd hqz
            ((hlinear n (Finset.mem_filter.mp hn).2).trans
              (hlinear n₀ hn₀compat).symm)
      · intro n hn k hk heq
        exact Int.ofNat_inj.mp heq
    have hmq : (0 : ℚ) < m := by exact_mod_cast hmpos
    let upper : ℚ := ((N : ℚ) - (n₀ : ℚ)) / (m : ℚ)
    let lower : ℚ := (-(n₀ : ℚ)) / (m : ℚ)
    have hlowerUpper : lower ≤ upper := by
      dsimp [lower, upper]
      apply div_le_div_of_nonneg_right _ hmq.le
      have hN : (0 : ℚ) ≤ N := Nat.cast_nonneg N
      linarith
    have hfloorNonneg : 0 ≤ ⌊upper⌋ - ⌊lower⌋ :=
      sub_nonneg.mpr (Int.floor_mono hlowerUpper)
    have hcardInt : (T.card : ℤ) = ⌊upper⌋ - ⌊lower⌋ := by
      have h := Int.Ioc_filter_modEq_card (0 : ℤ) (N : ℤ) hmpos (n₀ : ℤ)
      simp only [Int.cast_zero, Int.cast_natCast, zero_sub] at h
      change (T.card : ℤ) = max (⌊upper⌋ - ⌊lower⌋) 0 at h
      rwa [max_eq_left hfloorNonneg] at h
    have hcardRat : (T.card : ℚ) = (⌊upper⌋ : ℚ) - (⌊lower⌋ : ℚ) := by
      exact_mod_cast hcardInt
    have hcountRat : (T.card : ℚ) ≤ (N : ℚ) / (m : ℚ) + 1 := by
      rw [hcardRat]
      have hu := Int.floor_le upper
      have hl := Int.lt_floor_add_one lower
      have hwidth : upper - lower = (N : ℚ) / (m : ℚ) := by
        dsimp [upper, lower]
        ring
      linarith
    have hcountReal : (T.card : ℝ) ≤ (N : ℝ) / (m : ℝ) + 1 := by
      exact_mod_cast hcountRat
    have hmReal : (m : ℝ) = (q₀ : ℝ) / (d : ℝ) := by
      simpa only [m, Int.cast_natCast] using (Int.cast_div_charZero (k := ℝ) hdq)
    have hwidthReal : (N : ℝ) / (m : ℝ) = (N : ℝ) * (d : ℝ) / (q₀ : ℝ) := by
      rw [hmReal, div_div_eq_mul_div]
    calc
      (S.card : ℝ) ≤ (T.card : ℝ) := by exact_mod_cast hcardST
      _ ≤ (N : ℝ) / (m : ℝ) + 1 := hcountReal
      _ = 1 + (N : ℝ) * (d : ℝ) / (q₀ : ℝ) := by rw [hwidthReal]; ring
      _ ≤ 1 + (N : ℝ) * (g : ℝ) / (q₀ : ℝ) :=
        add_le_add_right
          (div_le_div_of_nonneg_right
            (mul_le_mul_of_nonneg_left hdgReal (Nat.cast_nonneg N)) hqr.le) 1
      _ ≤ (g : ℝ) + (N : ℝ) * (g : ℝ) / (q₀ : ℝ) :=
        add_le_add_left hgOne _
      _ = (g : ℝ) * (1 + (N : ℝ) / (q₀ : ℝ)) := by ring
  · have hEmpty : S = ∅ := Finset.not_nonempty_iff_eq_empty.mp hS
    rw [hEmpty, Finset.card_empty, Nat.cast_zero]
    positivity

open Classical in
theorem sourceGamma_coefficient_moment_le
    (𝒜 : Finset (ℕ × ℕ × ℕ × ℕ)) (β : ℕ →₀ ℂ)
    (q₀ b₁ b₂ N : ℕ) [NeZero q₀] (ℓ : ℤ) (W : ℝ)
    (hW : 0 ≤ W) (hb₁ : Nat.Coprime b₁ q₀)
    (h𝒜 : ∀ t ∈ 𝒜, Nat.Coprime t.1 q₀)
    (hsupport : β.support ⊆ Finset.Icc 1 N)
    (hβ : ∀ n ∈ β.support, ‖β n‖ ≤ W) :
    let γ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
    let B : Finset (ℕ × ℕ × ℕ) := 𝒜.image (fun t => (t.1, t.2.1, t.2.2.2))
    let Γ : ℝ := ∑ t ∈ B, ∑ n ∈ γ.support,
      if Int.gcd n ((t.1 * q₀ * t.2.1 : ℕ) : ℤ) = 1 ∧
          Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2 : ℕ) : ℤ) = 1
      then sourceCompatibility t.1 q₀ b₁ b₂ ℓ n *
        ‖γ n * star (γ (n + ℓ * (t.1 : ℤ)))‖ ^ 2
      else 0
    Γ ≤ (B.card : ℝ) * (Int.gcd (q₀ : ℤ) ℓ : ℝ) *
      (1 + (N : ℝ) / (q₀ : ℝ)) * W ^ 4 := by
  let γ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
  let B : Finset (ℕ × ℕ × ℕ) := 𝒜.image (fun t => (t.1, t.2.1, t.2.2.2))
  have hγ (n : ℤ) : ‖γ n‖ ≤ W := by
    by_cases hn : n ∈ γ.support
    · change n ∈ β.support.map (Nat.castEmbedding : ℕ ↪ ℤ) at hn
      obtain ⟨m, hm, rfl⟩ := Finset.mem_map.mp hn
      simpa only [γ, Finsupp.embDomain_apply_self] using hβ m hm
    · rw [Finsupp.notMem_support_iff.mp hn, norm_zero]
      exact hW
  have hproduct (r : ℕ) (n : ℤ) :
      ‖γ n * star (γ (n + ℓ * (r : ℤ)))‖ ^ 2 ≤ W ^ 4 := by
    calc
      ‖γ n * star (γ (n + ℓ * (r : ℤ)))‖ ^ 2 =
          (‖γ n‖ * ‖γ (n + ℓ * (r : ℤ))‖) ^ 2 := by
        rw [norm_mul, norm_star]
      _ ≤ (W * W) ^ 2 :=
        pow_le_pow_left₀ (mul_nonneg (norm_nonneg _) (norm_nonneg _))
          (mul_le_mul (hγ n) (hγ (n + ℓ * (r : ℤ))) (norm_nonneg _) hW) 2
      _ = W ^ 4 := by ring
  calc
    (∑ t ∈ B, ∑ n ∈ γ.support,
      if Int.gcd n ((t.1 * q₀ * t.2.1 : ℕ) : ℤ) = 1 ∧
          Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2 : ℕ) : ℤ) = 1
      then sourceCompatibility t.1 q₀ b₁ b₂ ℓ n *
        ‖γ n * star (γ (n + ℓ * (t.1 : ℤ)))‖ ^ 2
      else 0) ≤
        ∑ _t ∈ B, (Int.gcd (q₀ : ℤ) ℓ : ℝ) *
          (1 + (N : ℝ) / (q₀ : ℝ)) * W ^ 4 := by
      apply Finset.sum_le_sum
      intro t ht
      have hr : Nat.Coprime t.1 q₀ := by
        obtain ⟨a, ha, rfl⟩ := Finset.mem_image.mp ht
        exact h𝒜 a ha
      calc
        (∑ n ∈ γ.support,
          if Int.gcd n ((t.1 * q₀ * t.2.1 : ℕ) : ℤ) = 1 ∧
              Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2 : ℕ) : ℤ) = 1
          then sourceCompatibility t.1 q₀ b₁ b₂ ℓ n *
            ‖γ n * star (γ (n + ℓ * (t.1 : ℤ)))‖ ^ 2
          else 0) ≤
            ∑ n ∈ γ.support,
              if sourceCompatibility t.1 q₀ b₁ b₂ ℓ n = 1 then W ^ 4 else 0 := by
          apply Finset.sum_le_sum
          intro n _
          have hc : sourceCompatibility t.1 q₀ b₁ b₂ ℓ n = 1 ∨
              sourceCompatibility t.1 q₀ b₁ b₂ ℓ n = 0 := ite_eq_or_eq _ _ _
          rcases hc with hc | hc
          · simp only [hc, one_mul]
            split_ifs
            · exact hproduct t.1 n
            · exact pow_nonneg hW 4
          · simp [hc]
        _ = ∑ n ∈ β.support,
            if sourceCompatibility t.1 q₀ b₁ b₂ ℓ (n : ℤ) = 1 then W ^ 4 else 0 := by
          simp [γ]
        _ ≤ ∑ n ∈ Finset.Icc 1 N,
            if sourceCompatibility t.1 q₀ b₁ b₂ ℓ (n : ℤ) = 1 then W ^ 4 else 0 :=
          Finset.sum_le_sum_of_subset_of_nonneg hsupport
            (fun _ _ _ => ite_nonneg (pow_nonneg hW 4) le_rfl)
        _ = (((Finset.Icc 1 N).filter (fun n : ℕ =>
              sourceCompatibility t.1 q₀ b₁ b₂ ℓ (n : ℤ) = 1)).card : ℝ) * W ^ 4 := by
          rw [← Finset.sum_filter, Finset.sum_const, nsmul_eq_mul]
        _ ≤ (Int.gcd (q₀ : ℤ) ℓ : ℝ) *
            (1 + (N : ℝ) / (q₀ : ℝ)) * W ^ 4 :=
          mul_le_mul_of_nonneg_right
            (sourceCompatibility_fixed_shift_count_le q₀ t.1 b₁ b₂ N ℓ hb₁ hr)
            (pow_nonneg hW 4)
    _ = (B.card : ℝ) * (Int.gcd (q₀ : ℤ) ℓ : ℝ) *
        (1 + (N : ℝ) / (q₀ : ℝ)) * W ^ 4 := by
      rw [Finset.sum_const, nsmul_eq_mul]
      ring

open Classical in
theorem sourceGamma_uniform_subpower_bound
    (d : ℕ) (E κ η B₀ Cβ Cr Cu Cq cMN cR CRQ ω δ ε : ℝ)
    (hκ : 0 ≤ κ) (hη : 0 < η) (hB₀ : 0 ≤ B₀)
    (hCβ : 0 < Cβ) (hCr : 0 < Cr) (hCu : 0 < Cu) (hCq : 0 < Cq)
    (hcMN : 0 < cMN) (hcR : 0 < cR) (hCRQ : 0 < CRQ)
    (hω : 0 < ω) (hδ : 0 < δ) (hε : 0 < ε) :
    ∀ᶠ x : ℝ in Filter.atTop,
      ∀ (𝒜 : Finset (ℕ × ℕ × ℕ × ℕ)) (β : ℕ →₀ ℂ)
        (q₀ b₁ b₂ : ℕ) (ℓ : ℤ) (M N R Q U : ℝ),
        0 < q₀ → Nat.Coprime b₁ q₀ →
        0 < M → 0 < N → 0 < R → 0 < Q → 0 < U →
        N ≤ x ^ κ →
        x ^ ((1 : ℝ) / 4 + 12 * ω + 4 * δ + 100 * ε) ≤ N →
        cMN * x ≤ M * N →
        cR * x ^ (-δ - 4 * ε) * N ≤ R →
        R * Q ≤ CRQ * x ^ ((1 : ℝ) / 2 + 2 * ω + ε) →
        1 ≤ x ^ ε * R * Q ^ 2 / ((q₀ : ℝ) * M) →
        (∀ n ∈ β.support, 0 < n ∧ (n : ℝ) ≤ Cβ * N) →
        (∀ n ∈ β.support,
          ‖β n‖ ≤ B₀ * (n.divisors.card : ℝ) ^ d * (Real.log x) ^ E) →
        (∀ t ∈ 𝒜,
          0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2.2 ∧
          Nat.Coprime t.1 q₀ ∧
          (t.1 : ℝ) ≤ Cr * R ∧ (t.2.1 : ℝ) ≤ Cu * U ∧
          ((q₀ * t.2.2.2 : ℕ) : ℝ) ≤ Cq * Q) →
        let γ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
        let B : Finset (ℕ × ℕ × ℕ) := 𝒜.image (fun t => (t.1, t.2.1, t.2.2.2))
        let Γ : ℝ := ∑ t ∈ B, ∑ n ∈ γ.support,
          if Int.gcd n ((t.1 * q₀ * t.2.1 : ℕ) : ℤ) = 1 ∧
              Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2 : ℕ) : ℤ) = 1
          then sourceCompatibility t.1 q₀ b₁ b₂ ℓ n *
            ‖γ n * star (γ (n + ℓ * (t.1 : ℤ)))‖ ^ 2
          else 0
        x ^ ((1 : ℝ) / 8) ≤ N / (q₀ : ℝ) ∧
          Γ ≤ x ^ η * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * R * Q * U * N / (q₀ : ℝ) ^ 2 := by
  let ρ : ℝ := η / (8 * (κ + 1))
  have hρ : 0 < ρ := by
    dsimp [ρ]
    positivity
  have hκρ : κ * ρ ≤ η / 8 := by
    have hidentity : ρ * (8 * (κ + 1)) = η := by
      dsimp [ρ]
      exact div_mul_cancel₀ η (by positivity)
    nlinarith
  obtain ⟨D, hD, hdivisor⟩ := exists_divisorPower_bound d hρ
  let L : ℝ := B₀ * D * Cβ ^ ρ
  let J : ℝ := Cr * Cu * Cq * (1 + Cβ) * L ^ 4
  let K : ℝ := CRQ ^ 2 / (cR * cMN)
  have hL : 0 ≤ L := by
    dsimp [L]
    positivity
  have hJ : 0 ≤ J := by
    dsimp [J]
    positivity
  have hsmall : ∀ᶠ x : ℝ in Filter.atTop,
      ‖J * (Real.log x) ^ (4 * E)‖ ≤ ‖x ^ (η / 2)‖ := by
    simpa only [one_mul] using
      ((isLittleO_log_rpow_rpow_atTop (4 * E)
        (by positivity : 0 < η / 2)).const_mul_left J).bound
          (show (0 : ℝ) < 1 by norm_num)
  have hlarge : ∀ᶠ x : ℝ in Filter.atTop, K ≤ x ^ ((1 : ℝ) / 8) :=
    (tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 8)).eventually_ge_atTop K
  filter_upwards [hsmall, hlarge, Filter.eventually_ge_atTop (Real.exp 1)]
    with x hxsmall hxlarge hx
  intro 𝒜 β q₀ b₁ b₂ ℓ M N R Q U hq₀ hb₁ hM hN hR hQ hU
    hNupper hNlower hMN hRlower hRQ hH hsupport hβ h𝒜
  let : NeZero q₀ := ⟨ne_of_gt hq₀⟩
  have hqreal : (0 : ℝ) < q₀ := Nat.cast_pos.mpr hq₀
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
  have hxone : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hx
  have hlog : 0 ≤ Real.log x := Real.log_nonneg hxone
  let s : ℝ := 4 * ω + δ + 7 * ε
  have hMRlower : cR * cMN * x ^ (1 - δ - 4 * ε) ≤ M * R := by
    calc
      _ = cR * x ^ (-δ - 4 * ε) * (cMN * x) := by
        rw [show (1 - δ - 4 * ε : ℝ) = (-δ - 4 * ε) + 1 by ring,
          Real.rpow_add_one hxpos.ne']
        ring
      _ ≤ cR * x ^ (-δ - 4 * ε) * (M * N) :=
        mul_le_mul_of_nonneg_left hMN
          (mul_nonneg hcR.le (Real.rpow_nonneg hxpos.le _))
      _ = M * (cR * x ^ (-δ - 4 * ε) * N) := by ring
      _ ≤ M * R := mul_le_mul_of_nonneg_left hRlower hM.le
  have hHmul : (q₀ : ℝ) * M ≤ x ^ ε * R * Q ^ 2 := by
    simpa only [one_mul] using (le_div_iff₀ (mul_pos hqreal hM)).mp hH
  have hMRupper :
      (q₀ : ℝ) * (M * R) ≤ CRQ ^ 2 * x ^ (1 + 4 * ω + 3 * ε) := by
    have hsquare : (R * Q) ^ 2 ≤
        (CRQ * x ^ ((1 : ℝ) / 2 + 2 * ω + ε)) ^ 2 :=
      (sq_le_sq₀ (mul_nonneg hR.le hQ.le)
        (mul_nonneg hCRQ.le (Real.rpow_nonneg hxpos.le _))).mpr hRQ
    calc
      _ = ((q₀ : ℝ) * M) * R := by ring
      _ ≤ (x ^ ε * R * Q ^ 2) * R :=
        mul_le_mul_of_nonneg_right hHmul hR.le
      _ = x ^ ε * (R * Q) ^ 2 := by ring
      _ ≤ x ^ ε * (CRQ * x ^ ((1 : ℝ) / 2 + 2 * ω + ε)) ^ 2 :=
        mul_le_mul_of_nonneg_left hsquare (Real.rpow_nonneg hxpos.le _)
      _ = CRQ ^ 2 *
          (x ^ ε * x ^ (((1 : ℝ) / 2 + 2 * ω + ε) * 2)) := by
        rw [mul_pow, ← Real.rpow_mul_natCast hxpos.le]
        ring_nf
      _ = _ := by
        rw [← Real.rpow_add hxpos]
        congr 2
        ring
  have hqbound : (q₀ : ℝ) ≤ K * x ^ s := by
    have hden : 0 < cR * cMN * x ^ (1 - δ - 4 * ε) := by positivity
    have hcombined :
        (q₀ : ℝ) * (cR * cMN * x ^ (1 - δ - 4 * ε)) ≤
          CRQ ^ 2 * x ^ (1 + 4 * ω + 3 * ε) :=
      (mul_le_mul_of_nonneg_left hMRlower hqreal.le).trans hMRupper
    calc
      _ ≤ (CRQ ^ 2 * x ^ (1 + 4 * ω + 3 * ε)) /
          (cR * cMN * x ^ (1 - δ - 4 * ε)) :=
        (le_div_iff₀ hden).mpr hcombined
      _ = K * x ^ s := by
        dsimp [K, s]
        rw [mul_div_mul_comm, ← Real.rpow_sub hxpos]
        congr 2
        ring
  have hscale : x ^ ((1 : ℝ) / 8) ≤ N / (q₀ : ℝ) := by
    apply (le_div_iff₀ hqreal).mpr
    calc
      _ ≤ x ^ ((1 : ℝ) / 8) * (K * x ^ s) :=
        mul_le_mul_of_nonneg_left hqbound (Real.rpow_nonneg hxpos.le _)
      _ ≤ x ^ ((1 : ℝ) / 8) * (x ^ ((1 : ℝ) / 8) * x ^ s) :=
        mul_le_mul_of_nonneg_left
          (mul_le_mul_of_nonneg_right hxlarge (Real.rpow_nonneg hxpos.le _))
          (Real.rpow_nonneg hxpos.le _)
      _ = x ^ ((1 : ℝ) / 4 + s) := by
        rw [← mul_assoc, ← Real.rpow_add hxpos, ← Real.rpow_add hxpos]
        congr 1
        ring
      _ ≤ x ^ ((1 : ℝ) / 4 + 12 * ω + 4 * δ + 100 * ε) :=
        Real.rpow_le_rpow_of_exponent_le hxone (by dsimp [s]; linarith)
      _ ≤ N := hNlower
  have hratio : 1 ≤ N / (q₀ : ℝ) :=
    (Real.one_le_rpow hxone (by norm_num : (0 : ℝ) ≤ 1 / 8)).trans hscale
  refine ⟨hscale, ?_⟩
  let T : ℕ := ⌊Cβ * N⌋₊
  let W : ℝ := L * x ^ (η / 8) * (Real.log x) ^ E
  let B : Finset (ℕ × ℕ × ℕ) := 𝒜.image (fun t => (t.1, t.2.1, t.2.2.2))
  let g : ℝ := (Int.gcd (q₀ : ℤ) ℓ : ℝ)
  let P : ℝ := g * R * Q * U * N / (q₀ : ℝ) ^ 2
  have hg : 0 ≤ g := Nat.cast_nonneg _
  have hP : 0 ≤ P := by
    dsimp [P]
    positivity
  have hW : 0 ≤ W :=
    mul_nonneg (mul_nonneg hL (Real.rpow_nonneg hxpos.le _))
      (Real.rpow_nonneg hlog E)
  have hT : (T : ℝ) ≤ Cβ * N := Nat.floor_le (mul_nonneg hCβ.le hN.le)
  have hsupportT : β.support ⊆ Finset.Icc 1 T := by
    intro n hn
    obtain ⟨hnpos, hnupper⟩ := hsupport n hn
    exact Finset.mem_Icc.mpr ⟨hnpos, Nat.le_floor hnupper⟩
  have hβW : ∀ n ∈ β.support, ‖β n‖ ≤ W := by
    intro n hn
    obtain ⟨hnpos, hnupper⟩ := hsupport n hn
    have hnscale : (n : ℝ) ≤ Cβ * x ^ κ :=
      hnupper.trans (mul_le_mul_of_nonneg_left hNupper hCβ.le)
    have hdiv : (n.divisors.card : ℝ) ^ d ≤ D * Cβ ^ ρ * x ^ (η / 8) := by
      calc
        _ ≤ D * (n : ℝ) ^ ρ := hdivisor n (ne_of_gt hnpos)
        _ ≤ D * (Cβ * x ^ κ) ^ ρ :=
          mul_le_mul_of_nonneg_left
            (Real.rpow_le_rpow (Nat.cast_nonneg n) hnscale hρ.le) hD.le
        _ = D * Cβ ^ ρ * x ^ (κ * ρ) := by
          rw [Real.mul_rpow hCβ.le (Real.rpow_nonneg hxpos.le κ),
            ← Real.rpow_mul hxpos.le κ ρ]
          ring
        _ ≤ D * Cβ ^ ρ * x ^ (η / 8) :=
          mul_le_mul_of_nonneg_left (Real.rpow_le_rpow_of_exponent_le hxone hκρ)
            (mul_nonneg hD.le (Real.rpow_nonneg hCβ.le ρ))
    calc
      _ ≤ B₀ * (n.divisors.card : ℝ) ^ d * (Real.log x) ^ E := hβ n hn
      _ ≤ B₀ * (D * Cβ ^ ρ * x ^ (η / 8)) * (Real.log x) ^ E :=
        mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_left hdiv hB₀)
          (Real.rpow_nonneg hlog E)
      _ = W := by
        dsimp [W, L]
        ring
  let rCap : ℕ := ⌊Cr * R⌋₊
  let uCap : ℕ := ⌊Cu * U⌋₊
  let qCap : ℕ := ⌊Cq * Q / (q₀ : ℝ)⌋₊
  have hbase : B ⊆ (Finset.Icc 1 rCap).product
      ((Finset.Icc 1 uCap).product (Finset.Icc 1 qCap)) := by
    intro t ht
    obtain ⟨a, ha, rfl⟩ := Finset.mem_image.mp ht
    obtain ⟨hrpos, hupos, hqpos, _hcop, hrbound, hubound, hqbound⟩ := h𝒜 a ha
    have hqbound' : (a.2.2.2 : ℝ) ≤ Cq * Q / (q₀ : ℝ) := by
      apply (le_div_iff₀ hqreal).mpr
      simpa only [Nat.cast_mul, mul_comm] using hqbound
    exact Finset.mem_product.mpr
      ⟨Finset.mem_Icc.mpr ⟨hrpos, Nat.le_floor hrbound⟩,
        Finset.mem_product.mpr
          ⟨Finset.mem_Icc.mpr ⟨hupos, Nat.le_floor hubound⟩,
            Finset.mem_Icc.mpr ⟨hqpos, Nat.le_floor hqbound'⟩⟩⟩
  have hcardNat : B.card ≤ rCap * (uCap * qCap) := by
    simpa using Finset.card_le_card hbase
  have hrCap : (rCap : ℝ) ≤ Cr * R := Nat.floor_le (mul_nonneg hCr.le hR.le)
  have huCap : (uCap : ℝ) ≤ Cu * U := Nat.floor_le (mul_nonneg hCu.le hU.le)
  have hqCap : (qCap : ℝ) ≤ Cq * Q / (q₀ : ℝ) :=
    Nat.floor_le (div_nonneg (mul_nonneg hCq.le hQ.le) hqreal.le)
  have hcard : (B.card : ℝ) ≤ Cr * Cu * Cq * R * U * Q / (q₀ : ℝ) := by
    calc
      _ ≤ (rCap : ℝ) * ((uCap : ℝ) * (qCap : ℝ)) := by exact_mod_cast hcardNat
      _ ≤ (Cr * R) * ((Cu * U) * (Cq * Q / (q₀ : ℝ))) :=
        mul_le_mul hrCap
          (mul_le_mul huCap hqCap (Nat.cast_nonneg qCap) (mul_nonneg hCu.le hU.le))
          (mul_nonneg (Nat.cast_nonneg uCap) (Nat.cast_nonneg qCap))
          (mul_nonneg hCr.le hR.le)
      _ = _ := by ring
  have hremainder :
      1 + (T : ℝ) / (q₀ : ℝ) ≤ (1 + Cβ) * N / (q₀ : ℝ) := by
    calc
      _ ≤ N / (q₀ : ℝ) + (Cβ * N) / (q₀ : ℝ) :=
        add_le_add hratio (div_le_div_of_nonneg_right hT hqreal.le)
      _ = _ := by ring
  have hfinite := sourceGamma_coefficient_moment_le 𝒜 β q₀ b₁ b₂ T ℓ W
    hW hb₁ (fun t ht => (h𝒜 t ht).2.2.2.1) hsupportT hβW
  have hWpower : W ^ 4 = L ^ 4 * x ^ (η / 2) * (Real.log x) ^ (4 * E) := by
    dsimp [W]
    rw [mul_pow, mul_pow, ← Real.rpow_mul_natCast hxpos.le,
      ← Real.rpow_mul_natCast hlog]
    simp only [Nat.cast_ofNat]
    rw [show η / 8 * (4 : ℝ) = η / 2 by ring, show E * (4 : ℝ) = 4 * E by ring]
  have htotal :
      (B.card : ℝ) * g * (1 + (T : ℝ) / (q₀ : ℝ)) * W ^ 4 ≤
        J * (Real.log x) ^ (4 * E) * x ^ (η / 2) * P := by
    calc
      _ ≤ (Cr * Cu * Cq * R * U * Q / (q₀ : ℝ)) * g *
          ((1 + Cβ) * N / (q₀ : ℝ)) * W ^ 4 :=
        mul_le_mul_of_nonneg_right
          (mul_le_mul (mul_le_mul_of_nonneg_right hcard hg) hremainder
            (by positivity) (by positivity)) (pow_nonneg hW 4)
      _ = _ := by
        rw [hWpower]
        dsimp [J, P]
        ring
  have hscalar : J * (Real.log x) ^ (4 * E) ≤ x ^ (η / 2) := by
    simpa only [Real.norm_of_nonneg
      (mul_nonneg hJ (Real.rpow_nonneg hlog (4 * E))),
      Real.norm_of_nonneg (Real.rpow_nonneg hxpos.le (η / 2))] using hxsmall
  have hfinal :
      (B.card : ℝ) * g * (1 + (T : ℝ) / (q₀ : ℝ)) * W ^ 4 ≤
        x ^ η * g * R * Q * U * N / (q₀ : ℝ) ^ 2 := by
    calc
      _ ≤ J * (Real.log x) ^ (4 * E) * x ^ (η / 2) * P := htotal
      _ ≤ x ^ (η / 2) * x ^ (η / 2) * P :=
        mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_right hscalar (Real.rpow_nonneg hxpos.le _)) hP
      _ = _ := by
        rw [← Real.rpow_add hxpos, show η / 2 + η / 2 = η by ring]
        dsimp [P]
        ring
  exact hfinite.trans hfinal

open Classical in
theorem mixedFiberMass_diagonal_divisor_majorant
    (sm : Finset ℕ) (w : ℕ → ℝ) (β : ℕ →₀ ℂ)
    (M N d : ℕ) (B W : ℝ) (hB : 0 ≤ B) (hW : 0 ≤ W)
    (hsm : sm ⊆ Finset.Icc 1 M)
    (hβsupport : β.support ⊆ Finset.Icc 1 N)
    (hβ : ∀ n ∈ β.support,
      ‖β n‖ ≤ B * ((Nat.divisors n).card : ℝ) ^ d)
    (hw : ∀ m ∈ sm, |w m| ≤ W)
    (q₁ q₂ r a b₁ b₂ : ℕ) :
    ‖∑ n ∈ β.support,
        β n * star (β n) * (mixedFiberMass sm w q₁ q₂ r a b₁ b₂ n n : ℂ)‖ ≤
      B ^ 2 * W *
        ∑ s ∈ Finset.Icc 1 (M * N),
          if Nat.Coprime s (q₁ * r) ∧ Nat.Coprime s (q₂ * r) ∧
              s % r = a % r ∧ s % q₁ = b₁ % q₁ ∧ s % q₂ = b₂ % q₂
          then ((Nat.divisors s).card : ℝ) ^ (2 * d + 1) else 0 := by
  let D : Finset (Σ _ : ℕ, ℕ) :=
    β.support.sigma fun n => mixedFiber sm q₁ q₂ r a b₁ b₂ n n
  let T : Finset (Σ _ : ℕ, ℕ) :=
    (Finset.Icc 1 (M * N)).sigma Nat.divisors
  let e : (Σ _ : ℕ, ℕ) → (Σ _ : ℕ, ℕ) := fun z => ⟨z.2 * z.1, z.1⟩
  let g : (Σ _ : ℕ, ℕ) → ℝ := fun z =>
    if Nat.Coprime z.1 (q₁ * r) ∧ Nat.Coprime z.1 (q₂ * r) ∧
        z.1 % r = a % r ∧ z.1 % q₁ = b₁ % q₁ ∧ z.1 % q₂ = b₂ % q₂
    then ((Nat.divisors z.1).card : ℝ) ^ (2 * d) else 0
  have hbounds (z : Σ _ : ℕ, ℕ) (hz : z ∈ D) :
      1 ≤ z.1 ∧ z.1 ≤ N ∧ 1 ≤ z.2 ∧ z.2 ≤ M := by
    have hn := Finset.mem_Icc.mp (hβsupport (Finset.mem_sigma.mp hz).1)
    have hm := Finset.mem_Icc.mp
      (hsm (Finset.mem_filter.mp (Finset.mem_sigma.mp hz).2).1)
    exact ⟨hn.1, hn.2, hm.1, hm.2⟩
  have he : Set.InjOn e D := by
    intro z hz z' _ h
    have hn : z.1 = z'.1 := congrArg (fun v : Σ _ : ℕ, ℕ => v.2) h
    have hp : z.2 * z.1 = z'.2 * z'.1 := congrArg Sigma.fst h
    have hm : z.2 = z'.2 :=
      Nat.mul_right_cancel (hbounds z hz).1 (by simpa only [← hn] using hp)
    exact Sigma.ext hn (heq_of_eq hm)
  have heT : D.image e ⊆ T := by
    apply Finset.image_subset_iff.mpr
    intro z hz
    rcases hbounds z hz with ⟨hn, hnN, hm, hmM⟩
    exact Finset.mem_sigma.mpr
      ⟨Finset.mem_Icc.mpr ⟨Nat.mul_pos hm hn, Nat.mul_le_mul hmM hnN⟩,
        Nat.mem_divisors.mpr ⟨Nat.dvd_mul_left _ _, (Nat.mul_pos hm hn).ne'⟩⟩
  have hmajor (z : Σ _ : ℕ, ℕ) (hz : z ∈ D) :
      ((Nat.divisors z.1).card : ℝ) ^ (2 * d) ≤ g (e z) := by
    rcases (Finset.mem_filter.mp (Finset.mem_sigma.mp hz).2).2 with
      ⟨h₁, h₂, h₃, h₄, hr, hq₁, _, hq₂⟩
    have hmask : Nat.Coprime (z.2 * z.1) (q₁ * r) ∧
        Nat.Coprime (z.2 * z.1) (q₂ * r) ∧
        (z.2 * z.1) % r = a % r ∧ (z.2 * z.1) % q₁ = b₁ % q₁ ∧
        (z.2 * z.1) % q₂ = b₂ % q₂ :=
      ⟨h₁.mul_left h₂, h₃.mul_left h₄, hr, hq₁, hq₂⟩
    dsimp only [g, e]
    rw [ite_eq_left hmask]
    exact_mod_cast Nat.pow_le_pow_left
      (Finset.card_le_card (Nat.divisors_subset_of_dvd
        (Nat.mul_pos (hbounds z hz).2.2.1 (hbounds z hz).1).ne'
        (Nat.dvd_mul_left z.1 z.2))) (2 * d)
  have hsum : (∑ z ∈ D, ((Nat.divisors z.1).card : ℝ) ^ (2 * d)) ≤
      ∑ z ∈ T, g z := by
    apply Finset.sum_le_sum_of_injOn e he heT hmajor
    intro z _ _
    dsimp only [g]
    split_ifs <;> positivity
  have htarget : (∑ z ∈ T, g z) =
      ∑ s ∈ Finset.Icc 1 (M * N),
        if Nat.Coprime s (q₁ * r) ∧ Nat.Coprime s (q₂ * r) ∧
            s % r = a % r ∧ s % q₁ = b₁ % q₁ ∧ s % q₂ = b₂ % q₂
        then ((Nat.divisors s).card : ℝ) ^ (2 * d + 1) else 0 := by
    simp only [T, Finset.sum_sigma, g, Finset.sum_const, nsmul_eq_mul,
      mul_ite_zero, pow_succ']
  have hcoef (n : ℕ) (hn : n ∈ β.support) :
      ‖β n‖ ^ 2 ≤ B ^ 2 * ((Nat.divisors n).card : ℝ) ^ (2 * d) := by
    simpa only [mul_pow, ← pow_mul'] using
      (sq_le_sq₀ (norm_nonneg _) (mul_nonneg hB (pow_nonneg (Nat.cast_nonneg _) _))).2
        (hβ n hn)
  calc
    ‖∑ n ∈ β.support,
        β n * star (β n) * (mixedFiberMass sm w q₁ q₂ r a b₁ b₂ n n : ℂ)‖ ≤
        ∑ n ∈ β.support, ∑ m ∈ mixedFiber sm q₁ q₂ r a b₁ b₂ n n,
          B ^ 2 * W * ((Nat.divisors n).card : ℝ) ^ (2 * d) := by
      apply norm_sum_le_of_le
      intro n hn
      rw [mixedFiberMass, Complex.ofReal_sum, Finset.mul_sum]
      apply norm_sum_le_of_le
      intro m hm
      calc
        ‖β n * star (β n) * (w m : ℂ)‖ = ‖β n‖ ^ 2 * |w m| := by
          simp only [norm_mul, norm_star, Complex.norm_real, Real.norm_eq_abs, pow_two]
        _ ≤ (B ^ 2 * ((Nat.divisors n).card : ℝ) ^ (2 * d)) * W :=
          mul_le_mul (hcoef n hn) (hw m (Finset.mem_filter.mp hm).1) (abs_nonneg _)
            (mul_nonneg (sq_nonneg _) (pow_nonneg (Nat.cast_nonneg _) _))
        _ = B ^ 2 * W * ((Nat.divisors n).card : ℝ) ^ (2 * d) := by ring
    _ = B ^ 2 * W * ∑ z ∈ D, ((Nat.divisors z.1).card : ℝ) ^ (2 * d) := by
      simp only [D, Finset.sum_sigma, Finset.mul_sum]
    _ ≤ B ^ 2 * W * ∑ z ∈ T, g z :=
      mul_le_mul_of_nonneg_left hsum (mul_nonneg (sq_nonneg _) hW)
    _ = _ := by rw [htarget]

open Classical in
theorem diagonal_product_indicator_card_le
    (X q₁ q₂ r a b₁ b₂ : ℕ)
    (hq₁ : 0 < q₁) (hq₂ : 0 < q₂) (hr : 0 < r)
    (hcop₁ : Nat.Coprime q₁ r) (hcop₂ : Nat.Coprime q₂ r) :
    (((Finset.Icc 1 X).filter (fun s =>
      Nat.Coprime s (q₁ * r) ∧ Nat.Coprime s (q₂ * r) ∧
        s % r = a % r ∧ s % q₁ = b₁ % q₁ ∧ s % q₂ = b₂ % q₂)).card : ℝ) ≤
      (X : ℝ) / ((r * Nat.lcm q₁ q₂ : ℕ) : ℝ) + 1 := by
  let P := r * Nat.lcm q₁ q₂
  let T := (Finset.Icc 1 X).filter (fun s =>
    Nat.Coprime s (q₁ * r) ∧ Nat.Coprime s (q₂ * r) ∧
      s % r = a % r ∧ s % q₁ = b₁ % q₁ ∧ s % q₂ = b₂ % q₂)
  have hcop : Nat.Coprime r (Nat.lcm q₁ q₂) :=
    (hcop₁.symm.mul_right hcop₂.symm).of_dvd_right (Nat.lcm_dvd_mul q₁ q₂)
  have hcard : T.card ≤ X / P + 1 := by
    rw [← Finset.card_range (X / P + 1)]
    apply Finset.card_le_card_of_injOn (fun s : ℕ => s / P)
    · intro s hs
      exact Finset.mem_range.mpr (Nat.div_lt_of_lt_mul
        ((Finset.mem_Icc.mp (Finset.mem_filter.mp hs).1).2.trans_lt
          (Nat.lt_mul_div_succ X (Nat.mul_pos hr (Nat.lcm_pos hq₁ hq₂)))))
    · intro s hs t ht he
      apply Nat.ext_div_modEq he
      have hs' := (Finset.mem_filter.mp hs).2
      have ht' := (Finset.mem_filter.mp ht).2
      exact (Nat.modEq_and_modEq_iff_modEq_mul hcop).mp
        ⟨hs'.2.2.1.trans ht'.2.2.1.symm,
          Nat.mod_lcm (hs'.2.2.2.1.trans ht'.2.2.2.1.symm)
            (hs'.2.2.2.2.trans ht'.2.2.2.2.symm)⟩
  change (T.card : ℝ) ≤ (X : ℝ) / (P : ℝ) + 1
  calc
    _ ≤ ((X / P : ℕ) : ℝ) + 1 := by exact_mod_cast hcard
    _ ≤ _ := add_le_add_left Nat.cast_div_le 1

open Classical in
theorem secondary_frequency_reduced_fiber
    (v₁ v₂ : ℕ) (hv₁ : 0 < v₁) (hv₂ : 0 < v₂) :
    let g : ℕ := Nat.gcd v₁ v₂
    let u₁ : ℕ := v₁ / g
    let u₂ : ℕ := v₂ / g
    let φ : ℤ × ℤ → ℤ := fun h => h.1 * (u₂ : ℤ) - h.2 * (u₁ : ℤ)
    (∀ h k : ℤ × ℤ,
      φ h = φ k ↔ ∃! t : ℤ,
        h.1 = k.1 + t * (u₁ : ℤ) ∧ h.2 = k.2 + t * (u₂ : ℤ)) ∧
    (∀ h : ℤ × ℤ,
      φ h = 0 ↔ h.1 * (v₂ : ℤ) = h.2 * (v₁ : ℤ)) := by
  let g : ℕ := Nat.gcd v₁ v₂
  let u₁ : ℕ := v₁ / g
  let u₂ : ℕ := v₂ / g
  let φ : ℤ × ℤ → ℤ := fun h => h.1 * (u₂ : ℤ) - h.2 * (u₁ : ℤ)
  have hg : 0 < g := Nat.gcd_pos_of_pos_right v₁ hv₂
  have hu₁ : 0 < u₁ := Nat.div_gcd_pos_of_pos_left v₂ hv₁
  have hu₁z : (u₁ : ℤ) ≠ 0 := by exact_mod_cast (ne_of_gt hu₁)
  have hcop : IsCoprime (u₁ : ℤ) (u₂ : ℤ) :=
    (Nat.coprime_div_gcd_div_gcd hg).isCoprime
  have hline : ∀ h k : ℤ × ℤ,
      φ h = φ k ↔ ∃! t : ℤ,
        h.1 = k.1 + t * (u₁ : ℤ) ∧ h.2 = k.2 + t * (u₂ : ℤ) := by
    intro h k
    constructor
    · intro heq
      have hprod : (h.1 - k.1) * (u₂ : ℤ) =
          (h.2 - k.2) * (u₁ : ℤ) := by
        dsimp [φ] at heq
        linear_combination heq
      have hdvd : (u₁ : ℤ) ∣ h.1 - k.1 :=
        hcop.dvd_of_dvd_mul_right (by rw [hprod]; exact dvd_mul_left _ _)
      obtain ⟨t, ht⟩ := hdvd
      have ht₁ : h.1 = k.1 + t * (u₁ : ℤ) := by linear_combination ht
      have ht₂ : h.2 = k.2 + t * (u₂ : ℤ) := by
        apply mul_right_cancel₀ hu₁z
        linear_combination -hprod + (u₂ : ℤ) * ht
      refine ⟨t, ⟨ht₁, ht₂⟩, ?_⟩
      intro s hs
      apply mul_right_cancel₀ hu₁z
      linear_combination ht₁ - hs.1
    · rintro ⟨t, ⟨ht₁, ht₂⟩, _⟩
      dsimp [φ]
      rw [ht₁, ht₂]
      ring
  have hv₁z : (v₁ : ℤ) = (u₁ : ℤ) * (g : ℤ) := by
    exact_mod_cast (Nat.div_mul_cancel (Nat.gcd_dvd_left v₁ v₂)).symm
  have hv₂z : (v₂ : ℤ) = (u₂ : ℤ) * (g : ℤ) := by
    exact_mod_cast (Nat.div_mul_cancel (Nat.gcd_dvd_right v₁ v₂)).symm
  have hdiag : ∀ h : ℤ × ℤ,
      φ h = 0 ↔ h.1 * (v₂ : ℤ) = h.2 * (v₁ : ℤ) := by
    intro h
    dsimp [φ]
    rw [sub_eq_zero, hv₁z, hv₂z, ← mul_assoc, ← mul_assoc,
      mul_left_inj' (by exact_mod_cast (ne_of_gt hg) : (g : ℤ) ≠ 0)]
  exact ⟨hline, hdiag⟩

open Classical in
theorem secondary_frequency_symmetric_window_counts
    (H v₁ v₂ : ℕ) (hv₁ : 0 < v₁) (hv₂ : 0 < v₂) :
    let g : ℕ := Nat.gcd v₁ v₂
    let u₁ : ℕ := v₁ / g
    let u₂ : ℕ := v₂ / g
    let m : ℕ := max u₁ u₂
    let J : Finset ℤ := (Finset.Icc (-(H : ℤ)) (H : ℤ)).filter (fun h => h ≠ 0)
    let P : Finset (ℤ × ℤ) := J.product J
    let φ : ℤ × ℤ → ℤ := fun h => h.1 * (u₂ : ℤ) - h.2 * (u₁ : ℤ)
    (∀ y : ℤ, (P.filter (fun h => φ h = y)).card ≤ (2 * H) / m + 1) ∧
    (P.filter (fun h => φ h = 0)).card = 2 * (H / m) ∧
    (∀ h ∈ P, (φ h).natAbs ≤ H * (u₁ + u₂)) ∧
    (∀ V : ℝ, 0 < V → V ≤ ((max v₁ v₂ : ℕ) : ℝ) →
      ∀ y : ℤ,
        ((P.filter (fun h => φ h = y)).card : ℝ) ≤
          1 + 2 * (g : ℝ) * (H : ℝ) / V) := by
  let g : ℕ := Nat.gcd v₁ v₂
  let u₁ : ℕ := v₁ / g
  let u₂ : ℕ := v₂ / g
  let m : ℕ := max u₁ u₂
  let J : Finset ℤ := (Finset.Icc (-(H : ℤ)) (H : ℤ)).filter (fun h => h ≠ 0)
  let P : Finset (ℤ × ℤ) := J.product J
  let φ : ℤ × ℤ → ℤ := fun h => h.1 * (u₂ : ℤ) - h.2 * (u₁ : ℤ)
  have hu₁ : 0 < u₁ := Nat.div_gcd_pos_of_pos_left v₂ hv₁
  have hu₂ : 0 < u₂ := Nat.div_gcd_pos_of_pos_right v₁ hv₂
  have hm : 0 < m := lt_of_lt_of_le hu₁ (le_max_left _ _)
  have hmz : (0 : ℤ) < m := by exact_mod_cast hm
  have hu₁z : (u₁ : ℤ) ≠ 0 := by exact_mod_cast (ne_of_gt hu₁)
  have hu₂z : (u₂ : ℤ) ≠ 0 := by exact_mod_cast (ne_of_gt hu₂)
  have hline : ∀ h k : ℤ × ℤ,
      φ h = φ k ↔ ∃! t : ℤ,
        h.1 = k.1 + t * (u₁ : ℤ) ∧ h.2 = k.2 + t * (u₂ : ℤ) :=
    (secondary_frequency_reduced_fiber v₁ v₂ hv₁ hv₂).1
  have hwindow (N : ℕ) (z : ℤ) :
      z ∈ (Finset.Icc (-(N : ℤ)) (N : ℤ)).filter (fun t => t ≠ 0) ↔
        z.natAbs ≤ N ∧ z ≠ 0 := by
    simp only [Finset.mem_filter, Finset.mem_Icc]
    rw [← Nat.cast_le (α := ℤ), Int.natCast_natAbs, abs_le]
  let coord : ℤ × ℤ → ℤ := fun h => if u₂ ≤ u₁ then h.1 else h.2
  have hcoord (h : ℤ × ℤ) (hh : h ∈ P) :
      -(H : ℤ) ≤ coord h ∧ coord h ≤ H := by
    rcases Finset.mem_product.mp hh with ⟨h₁, h₂⟩
    have hb₁ := Finset.mem_Icc.mp (Finset.mem_filter.mp h₁).1
    have hb₂ := Finset.mem_Icc.mp (Finset.mem_filter.mp h₂).1
    by_cases hle : u₂ ≤ u₁
    · simpa [coord, hle] using hb₁
    · simpa [coord, hle] using hb₂
  have hstep (h k : ℤ × ℤ) (t : ℤ)
      (ht₁ : h.1 = k.1 + t * (u₁ : ℤ))
      (ht₂ : h.2 = k.2 + t * (u₂ : ℤ)) :
      coord h = coord k + t * (m : ℤ) := by
    by_cases hle : u₂ ≤ u₁
    · simpa [coord, m, hle, max_eq_left hle] using ht₁
    · simpa [coord, m, hle, max_eq_right (le_of_not_ge hle)] using ht₂
  have hcount (y : ℤ) : (P.filter (fun h => φ h = y)).card ≤ (2 * H) / m + 1 := by
    let T : Finset (ℤ × ℤ) := P.filter (fun h => φ h = y)
    have hcard : T.card ≤ (Finset.Icc (0 : ℤ) (((2 * H) / m : ℕ) : ℤ)).card := by
      apply Finset.card_le_card_of_injOn (fun h => (coord h + H) / (m : ℤ))
      · intro h hh
        have hb := hcoord h (Finset.mem_filter.mp hh).1
        apply Finset.mem_Icc.mpr
        refine ⟨Int.ediv_nonneg (by omega) (le_of_lt hmz), ?_⟩
        calc
          (coord h + H) / (m : ℤ) ≤ ((2 * H : ℕ) : ℤ) / (m : ℤ) :=
            Int.ediv_le_ediv hmz (by omega)
          _ = (((2 * H) / m : ℕ) : ℤ) := (Int.natCast_ediv _ _).symm
      · intro h hh k hk heq
        have hφ : φ h = φ k :=
          (Finset.mem_filter.mp hh).2.trans (Finset.mem_filter.mp hk).2.symm
        obtain ⟨t, ⟨ht₁, ht₂⟩, _⟩ := (hline h k).mp hφ
        have ht := hstep h k t ht₁ ht₂
        have hmod : (coord h + H) ≡ (coord k + H) [ZMOD (m : ℤ)] := by
          apply Int.modEq_iff_dvd.mpr
          refine ⟨-t, ?_⟩
          rw [ht]
          ring
        have heq' : coord h + H = coord k + H := Int.ext_ediv_emod heq hmod
        have htzero : t = 0 := by
          apply mul_right_cancel₀ (ne_of_gt hmz)
          omega
        apply Prod.ext
        · simpa [htzero] using ht₁
        · simpa [htzero] using ht₂
    calc
      T.card ≤ (Finset.Icc (0 : ℤ) (((2 * H) / m : ℕ) : ℤ)).card := hcard
      _ = (2 * H) / m + 1 := by
        rw [Int.card_Icc, sub_zero]
        exact Int.toNat_natCast_add_one
  have hzero : (P.filter (fun h => φ h = 0)).card = 2 * (H / m) := by
    let W : Finset ℤ :=
      (Finset.Icc (-((H / m : ℕ) : ℤ)) ((H / m : ℕ) : ℤ)).filter (fun t => t ≠ 0)
    let f : ℤ → ℤ × ℤ := fun t => (t * (u₁ : ℤ), t * (u₂ : ℤ))
    have hset : P.filter (fun h => φ h = 0) = W.image f := by
      ext h
      constructor
      · intro hh
        rcases Finset.mem_filter.mp hh with ⟨hhP, hhφ⟩
        rcases Finset.mem_product.mp hhP with ⟨hh₁, hh₂⟩
        obtain ⟨t, ⟨ht₁, ht₂⟩, _⟩ := (hline h (0, 0)).mp (by simpa [φ] using hhφ)
        have ht₁' : h.1 = t * (u₁ : ℤ) := by simpa using ht₁
        have ht₂' : h.2 = t * (u₂ : ℤ) := by simpa using ht₂
        have hb₁ := (hwindow H h.1).mp hh₁
        have hb₂ := (hwindow H h.2).mp hh₂
        have hmul₁ : t.natAbs * u₁ ≤ H := by
          simpa only [ht₁', Int.natAbs_mul, Int.natAbs_natCast] using hb₁.1
        have hmul₂ : t.natAbs * u₂ ≤ H := by
          simpa only [ht₂', Int.natAbs_mul, Int.natAbs_natCast] using hb₂.1
        have hmul : t.natAbs * m ≤ H := by
          rw [← Nat.mul_max_mul_left]
          exact Nat.max_le.mpr ⟨hmul₁, hmul₂⟩
        have htne : t ≠ 0 := by
          intro htzero
          exact hb₁.2 (by simpa [htzero] using ht₁')
        apply Finset.mem_image.mpr
        refine ⟨t, (hwindow (H / m) t).mpr ⟨(Nat.le_div_iff_mul_le hm).mpr hmul, htne⟩, ?_⟩
        exact Prod.ext ht₁'.symm ht₂'.symm
      · rintro hh
        obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hh
        rcases (hwindow (H / m) t).mp ht with ⟨htbound, htne⟩
        have hmul := (Nat.le_div_iff_mul_le hm).mp htbound
        have hmul₁ : t.natAbs * u₁ ≤ H :=
          (Nat.mul_le_mul_left t.natAbs (le_max_left _ _)).trans hmul
        have hmul₂ : t.natAbs * u₂ ≤ H :=
          (Nat.mul_le_mul_left t.natAbs (le_max_right _ _)).trans hmul
        apply Finset.mem_filter.mpr
        constructor
        · apply Finset.mem_product.mpr
          constructor
          · apply (hwindow H (t * (u₁ : ℤ))).mpr
            exact ⟨by simpa only [Int.natAbs_mul, Int.natAbs_natCast] using hmul₁,
              mul_ne_zero htne hu₁z⟩
          · apply (hwindow H (t * (u₂ : ℤ))).mpr
            exact ⟨by simpa only [Int.natAbs_mul, Int.natAbs_natCast] using hmul₂,
              mul_ne_zero htne hu₂z⟩
        · dsimp [φ, f]
          ring
    have hf : Function.Injective f :=
      fun _ _ hts => mul_right_cancel₀ hu₁z (congrArg Prod.fst hts)
    have hN : (0 : ℤ) ≤ ((H / m : ℕ) : ℤ) := Int.natCast_nonneg _
    have hzmem : (0 : ℤ) ∈ Finset.Icc (-((H / m : ℕ) : ℤ)) ((H / m : ℕ) : ℤ) :=
      Finset.mem_Icc.mpr ⟨neg_nonpos.mpr hN, hN⟩
    rw [hset, Finset.card_image_of_injective W hf]
    change ((Finset.Icc (-((H / m : ℕ) : ℤ)) ((H / m : ℕ) : ℤ)).filter
      (fun t => t ≠ 0)).card = 2 * (H / m)
    rw [Finset.filter_ne', Finset.card_erase_of_mem hzmem, Int.card_Icc]
    omega
  have himage : ∀ h ∈ P, (φ h).natAbs ≤ H * (u₁ + u₂) := by
    intro h hh
    rcases Finset.mem_product.mp hh with ⟨hh₁, hh₂⟩
    have hb₁ := ((hwindow H h.1).mp hh₁).1
    have hb₂ := ((hwindow H h.2).mp hh₂).1
    calc
      (φ h).natAbs ≤ (h.1 * (u₂ : ℤ)).natAbs + (h.2 * (u₁ : ℤ)).natAbs :=
        Int.natAbs_sub_le _ _
      _ = h.1.natAbs * u₂ + h.2.natAbs * u₁ := by simp [Int.natAbs_mul]
      _ ≤ H * u₂ + H * u₁ :=
        Nat.add_le_add (Nat.mul_le_mul_right u₂ hb₁) (Nat.mul_le_mul_right u₁ hb₂)
      _ = H * (u₁ + u₂) := by ring
  have hreal : ∀ V : ℝ, 0 < V → V ≤ ((max v₁ v₂ : ℕ) : ℝ) →
      ∀ y : ℤ, ((P.filter (fun h => φ h = y)).card : ℝ) ≤
        1 + 2 * (g : ℝ) * (H : ℝ) / V := by
    intro V hV hmax y
    have hmg : m * g = max v₁ v₂ := by
      rw [← Nat.mul_max_mul_right, Nat.div_mul_cancel (Nat.gcd_dvd_left v₁ v₂),
        Nat.div_mul_cancel (Nat.gcd_dvd_right v₁ v₂)]
    have hmgR : (m : ℝ) * (g : ℝ) = ((max v₁ v₂ : ℕ) : ℝ) := by exact_mod_cast hmg
    have hmR : (0 : ℝ) < m := by exact_mod_cast hm
    have hVm : V ≤ (m : ℝ) * (g : ℝ) := hmax.trans_eq hmgR.symm
    have hfrac : 2 * (H : ℝ) / (m : ℝ) ≤ 2 * (g : ℝ) * (H : ℝ) / V := by
      apply (div_le_div_iff₀ hmR hV).mpr
      have hmul := mul_le_mul_of_nonneg_left hVm (by positivity : 0 ≤ 2 * (H : ℝ))
      convert hmul using 1
      ring
    have hdiv : (((2 * H) / m : ℕ) : ℝ) ≤ 2 * (H : ℝ) / (m : ℝ) := by
      simpa using (Nat.cast_div_le (α := ℝ) (m := 2 * H) (n := m))
    calc
      ((P.filter (fun h => φ h = y)).card : ℝ) ≤ (((2 * H) / m + 1 : ℕ) : ℝ) := by
        exact_mod_cast hcount y
      _ = (((2 * H) / m : ℕ) : ℝ) + 1 := by simp
      _ ≤ 2 * (H : ℝ) / (m : ℝ) + 1 := add_le_add hdiv le_rfl
      _ ≤ 2 * (g : ℝ) * (H : ℝ) / V + 1 := add_le_add hfrac le_rfl
      _ = 1 + 2 * (g : ℝ) * (H : ℝ) / V := by ring
  exact ⟨hcount, hzero, himage, hreal⟩

open Classical in
theorem secondary_frequency_labelled_regrouping
    {ι : Type*}
    (H v₁ v₂ : ℕ) (hv₁ : 0 < v₁) (hv₂ : 0 < v₂)
    (S : Finset ι) (h : ι → ℤ × ℤ)
    (hwindow : ∀ i ∈ S,
      (h i).1 ∈ (Finset.Icc (-(H : ℤ)) (H : ℤ)).filter (fun t => t ≠ 0) ∧
      (h i).2 ∈ (Finset.Icc (-(H : ℤ)) (H : ℤ)).filter (fun t => t ≠ 0))
    (c : ι → ℂ) (B : ℝ) (hB : 0 ≤ B) (hc : ∀ i ∈ S, ‖c i‖ ≤ B) :
    let g : ℕ := Nat.gcd v₁ v₂
    let u₁ : ℕ := v₁ / g
    let u₂ : ℕ := v₂ / g
    let φ : ℤ × ℤ → ℤ := fun p => p.1 * (u₂ : ℤ) - p.2 * (u₁ : ℤ)
    let Q : ℕ := (2 * H) / max u₁ u₂ + 1
    let R : ℕ := S.sup (fun i => (S.filter (fun j => h j = h i)).card)
    let A : ℤ → ℂ := fun y => ∑ i ∈ S.filter (fun i => φ (h i) = y), c i
    let Snonzero : Finset ι := S.filter (fun i => φ (h i) ≠ 0)
    let L : Finset ℤ := (S.image (fun i => φ (h i))).erase 0
    (∀ y : ℤ,
      (S.filter (fun i => φ (h i) = y)).card ≤ R * Q ∧
      ‖A y‖ ≤ ((R * Q : ℕ) : ℝ) * B) ∧
    (∀ F : ℤ → ℂ,
      (∑ i ∈ S, c i * F (φ (h i))) =
        A 0 * F 0 + ∑ y ∈ L, A y * F y) ∧
    (∀ K : ℤ → ℤ → ℂ,
      (∑ i ∈ Snonzero, ∑ j ∈ Snonzero,
        c i * star (c j) * K (φ (h i)) (φ (h j))) =
          (∑ y ∈ L, ∑ z ∈ L, A y * star (A z) * K y z) ∧
      ‖∑ i ∈ Snonzero, ∑ j ∈ Snonzero,
          c i * star (c j) * K (φ (h i)) (φ (h j))‖ ≤
        ((R * Q : ℕ) : ℝ) ^ 2 * B ^ 2 *
          ∑ y ∈ L, ∑ z ∈ L, ‖K y z‖) := by
  let g : ℕ := Nat.gcd v₁ v₂
  let u₁ : ℕ := v₁ / g
  let u₂ : ℕ := v₂ / g
  let φ : ℤ × ℤ → ℤ := fun p => p.1 * (u₂ : ℤ) - p.2 * (u₁ : ℤ)
  let Q : ℕ := (2 * H) / max u₁ u₂ + 1
  let R : ℕ := S.sup (fun i => (S.filter (fun j => h j = h i)).card)
  let A : ℤ → ℂ := fun y => ∑ i ∈ S.filter (fun i => φ (h i) = y), c i
  let Snonzero : Finset ι := S.filter (fun i => φ (h i) ≠ 0)
  let L : Finset ℤ := (S.image (fun i => φ (h i))).erase 0
  let f : ι → ℤ := fun i => φ (h i)
  let J : Finset ℤ := (Finset.Icc (-(H : ℤ)) (H : ℤ)).filter (fun t => t ≠ 0)
  let P : Finset (ℤ × ℤ) := J.product J
  have hpcount (y : ℤ) : (P.filter (fun p => φ p = y)).card ≤ Q :=
    (secondary_frequency_symmetric_window_counts H v₁ v₂ hv₁ hv₂).1 y
  have hcount (y : ℤ) : (S.filter (fun i => f i = y)).card ≤ R * Q := by
    let T : Finset ι := S.filter (fun i => f i = y)
    let U : Finset (ℤ × ℤ) := T.image h
    have hU : U ⊆ P.filter (fun p => φ p = y) := by
      intro p hp
      obtain ⟨i, hi, rfl⟩ := Finset.mem_image.mp hp
      rcases Finset.mem_filter.mp hi with ⟨hiS, hiy⟩
      exact Finset.mem_filter.mpr ⟨Finset.mem_product.mpr (hwindow i hiS), hiy⟩
    have hUcard : U.card ≤ Q := (Finset.card_le_card hU).trans (hpcount y)
    have hfiber (p : ℤ × ℤ) (hp : p ∈ U) :
        (T.filter (fun i => h i = p)).card ≤ R := by
      obtain ⟨i, hi, hpi⟩ := Finset.mem_image.mp hp
      have hsub : T.filter (fun j => h j = p) ⊆ S.filter (fun j => h j = h i) := by
        intro j hj
        rcases Finset.mem_filter.mp hj with ⟨hjT, hjp⟩
        exact Finset.mem_filter.mpr
          ⟨(Finset.mem_filter.mp hjT).1, hjp.trans hpi.symm⟩
      exact (Finset.card_le_card hsub).trans
        (Finset.le_sup (f := fun i => (S.filter (fun j => h j = h i)).card)
          (Finset.mem_filter.mp hi).1)
    exact (Finset.card_le_mul_card_image T R hfiber).trans
      (Nat.mul_le_mul_left R hUcard)
  have hA (y : ℤ) : ‖A y‖ ≤ ((R * Q : ℕ) : ℝ) * B := by
    calc
      ‖A y‖ ≤ ∑ i ∈ S.filter (fun i => f i = y), B :=
        norm_sum_le_of_le _ (fun i hi => hc i (Finset.mem_filter.mp hi).1)
      _ = ((S.filter (fun i => f i = y)).card : ℝ) * B := by simp
      _ ≤ ((R * Q : ℕ) : ℝ) * B :=
        mul_le_mul_of_nonneg_right (by exact_mod_cast hcount y) hB
  have hgroupNonzero (w : ι → ℂ) :
      (∑ i ∈ Snonzero, w i) = ∑ y ∈ L, ∑ i ∈ S.filter (fun i => f i = y), w i := by
    rw [Finset.sum_fiberwise_eq_sum_filter]
    apply Finset.sum_congr ?_ (fun _ _ => rfl)
    ext i
    simp only [Snonzero, Finset.mem_filter]
    exact and_congr_right fun hi =>
      (Finset.mem_erase.trans (and_iff_left (Finset.mem_image_of_mem f hi))).symm
  have hweighted (F : ℤ → ℂ) (y : ℤ) :
      (∑ i ∈ S.filter (fun i => f i = y), c i * F (f i)) = A y * F y := by
    rw [show A y * F y = ∑ i ∈ S.filter (fun i => f i = y), c i * F y by
      simp only [A, f, Finset.sum_mul]]
    exact Finset.sum_congr rfl (fun i hi => by rw [(Finset.mem_filter.mp hi).2])
  have hlinear (F : ℤ → ℂ) :
      (∑ i ∈ S, c i * F (f i)) = A 0 * F 0 + ∑ y ∈ L, A y * F y := by
    rw [← Finset.sum_filter_add_sum_filter_not S (fun i => f i = 0)
      (fun i => c i * F (f i)), hweighted F 0]
    rw [hgroupNonzero (fun i => c i * F (f i))]
    exact congrArg (fun z => A 0 * F 0 + z)
      (Finset.sum_congr rfl (fun y _ => hweighted F y))
  have hquadratic (K : ℤ → ℤ → ℂ) :
      (∑ i ∈ Snonzero, ∑ j ∈ Snonzero, c i * star (c j) * K (f i) (f j)) =
        ∑ y ∈ L, ∑ z ∈ L, A y * star (A z) * K y z := by
    rw [hgroupNonzero (fun i => ∑ j ∈ Snonzero, c i * star (c j) * K (f i) (f j))]
    apply Finset.sum_congr rfl
    intro y _
    calc
      (∑ i ∈ S.filter (fun i => f i = y),
          ∑ j ∈ Snonzero, c i * star (c j) * K (f i) (f j)) =
          ∑ i ∈ S.filter (fun i => f i = y), ∑ z ∈ L,
            ∑ j ∈ S.filter (fun j => f j = z),
              c i * star (c j) * K (f i) (f j) :=
        Finset.sum_congr rfl (fun i _ => hgroupNonzero (fun j =>
          c i * star (c j) * K (f i) (f j)))
      _ = ∑ z ∈ L, ∑ i ∈ S.filter (fun i => f i = y),
            ∑ j ∈ S.filter (fun j => f j = z),
              c i * star (c j) * K (f i) (f j) := Finset.sum_comm
      _ = ∑ z ∈ L, A y * star (A z) * K y z := by
        apply Finset.sum_congr rfl
        intro z _
        calc
          (∑ i ∈ S.filter (fun i => f i = y), ∑ j ∈ S.filter (fun j => f j = z),
              c i * star (c j) * K (f i) (f j)) =
              ∑ i ∈ S.filter (fun i => f i = y), ∑ j ∈ S.filter (fun j => f j = z),
                c i * star (c j) * K y z := by
            apply Finset.sum_congr rfl
            intro i hi
            apply Finset.sum_congr rfl
            intro j hj
            rw [(Finset.mem_filter.mp hi).2, (Finset.mem_filter.mp hj).2]
          _ = A y * star (A z) * K y z := by
            simp only [A, f, star_sum]
            rw [Finset.sum_mul_sum]
            simp only [Finset.sum_mul]
  have hquadratic_bound (K : ℤ → ℤ → ℂ) :
      ‖∑ i ∈ Snonzero, ∑ j ∈ Snonzero, c i * star (c j) * K (f i) (f j)‖ ≤
        ((R * Q : ℕ) : ℝ) ^ 2 * B ^ 2 * ∑ y ∈ L, ∑ z ∈ L, ‖K y z‖ := by
    rw [hquadratic K]
    calc
      ‖∑ y ∈ L, ∑ z ∈ L, A y * star (A z) * K y z‖ ≤
          ∑ y ∈ L, ∑ z ∈ L, ‖A y * star (A z) * K y z‖ :=
        norm_sum_le_of_le _ (fun _ _ => norm_sum_le _ _)
      _ ≤ ∑ y ∈ L, ∑ z ∈ L,
          (((R * Q : ℕ) : ℝ) ^ 2 * B ^ 2) * ‖K y z‖ := by
        apply Finset.sum_le_sum
        intro y _
        apply Finset.sum_le_sum
        intro z _
        rw [norm_mul, norm_mul, norm_star]
        calc
          ‖A y‖ * ‖A z‖ * ‖K y z‖ ≤
              (((R * Q : ℕ) : ℝ) * B) * (((R * Q : ℕ) : ℝ) * B) * ‖K y z‖ := by
            gcongr <;> exact hA _
          _ = (((R * Q : ℕ) : ℝ) ^ 2 * B ^ 2) * ‖K y z‖ := by ring
      _ = ((R * Q : ℕ) : ℝ) ^ 2 * B ^ 2 * ∑ y ∈ L, ∑ z ∈ L, ‖K y z‖ := by
        simp only [Finset.mul_sum]
  exact ⟨fun y => ⟨hcount y, hA y⟩, hlinear,
    fun K => ⟨hquadratic K, hquadratic_bound K⟩⟩

open Classical in
theorem secondary_frequency_pair_coefficient_regrouping
    {ι : Type*}
    (H v₁ v₂ : ℕ) (hv₁ : 0 < v₁) (hv₂ : 0 < v₂)
    (S : Finset ι) (h : ι → ℤ × ℤ)
    (hwindow : ∀ i ∈ S,
      (h i).1 ∈ (Finset.Icc (-(H : ℤ)) (H : ℤ)).filter (fun t => t ≠ 0) ∧
      (h i).2 ∈ (Finset.Icc (-(H : ℤ)) (H : ℤ)).filter (fun t => t ≠ 0))
    (c₂ : ι → ι → ℂ) (B₂ : ℝ) (hB₂ : 0 ≤ B₂)
    (hc₂ : ∀ i ∈ S, ∀ j ∈ S, ‖c₂ i j‖ ≤ B₂) :
    let g : ℕ := Nat.gcd v₁ v₂
    let u₁ : ℕ := v₁ / g
    let u₂ : ℕ := v₂ / g
    let φ : ℤ × ℤ → ℤ := fun p => p.1 * (u₂ : ℤ) - p.2 * (u₁ : ℤ)
    let Q : ℕ := (2 * H) / max u₁ u₂ + 1
    let R : ℕ := S.sup (fun i => (S.filter (fun j => h j = h i)).card)
    let C : ℤ → ℤ → ℂ := fun y z =>
      ∑ i ∈ S.filter (fun i => φ (h i) = y),
        ∑ j ∈ S.filter (fun j => φ (h j) = z), c₂ i j
    let Snonzero : Finset ι := S.filter (fun i => φ (h i) ≠ 0)
    let L : Finset ℤ := (S.image (fun i => φ (h i))).erase 0
    (∀ y z : ℤ, ‖C y z‖ ≤ B₂ * ((R * Q : ℕ) : ℝ) ^ 2) ∧
    (∀ K : ℤ → ℤ → ℂ,
      (∑ i ∈ Snonzero, ∑ j ∈ Snonzero,
        c₂ i j * K (φ (h i)) (φ (h j))) =
          (∑ y ∈ L, ∑ z ∈ L, C y z * K y z) ∧
      ‖∑ i ∈ Snonzero, ∑ j ∈ Snonzero,
          c₂ i j * K (φ (h i)) (φ (h j))‖ ≤
        B₂ * ((R * Q : ℕ) : ℝ) ^ 2 *
          ∑ y ∈ L, ∑ z ∈ L, ‖K y z‖) := by
  let g : ℕ := Nat.gcd v₁ v₂
  let u₁ : ℕ := v₁ / g
  let u₂ : ℕ := v₂ / g
  let φ : ℤ × ℤ → ℤ := fun p => p.1 * (u₂ : ℤ) - p.2 * (u₁ : ℤ)
  let Q : ℕ := (2 * H) / max u₁ u₂ + 1
  let R : ℕ := S.sup (fun i => (S.filter (fun j => h j = h i)).card)
  let C : ℤ → ℤ → ℂ := fun y z =>
    ∑ i ∈ S.filter (fun i => φ (h i) = y),
      ∑ j ∈ S.filter (fun j => φ (h j) = z), c₂ i j
  let Snonzero : Finset ι := S.filter (fun i => φ (h i) ≠ 0)
  let L : Finset ℤ := (S.image (fun i => φ (h i))).erase 0
  let f : ι → ℤ := fun i => φ (h i)
  have hcount (y : ℤ) : (S.filter (fun i => f i = y)).card ≤ R * Q :=
    ((secondary_frequency_labelled_regrouping H v₁ v₂ hv₁ hv₂ S h hwindow
      (fun _ => 0) 0 le_rfl (fun _ _ => by simp)).1 y).1
  have hC (y z : ℤ) : ‖C y z‖ ≤ B₂ * ((R * Q : ℕ) : ℝ) ^ 2 := by
    calc
      ‖C y z‖ ≤ ∑ i ∈ S.filter (fun i => f i = y),
          ∑ j ∈ S.filter (fun j => f j = z), B₂ :=
        norm_sum_le_of_le _ (fun i hi => norm_sum_le_of_le _ (fun j hj =>
          hc₂ i (Finset.mem_filter.mp hi).1 j (Finset.mem_filter.mp hj).1))
      _ = ((S.filter (fun i => f i = y)).card : ℝ) *
          ((S.filter (fun j => f j = z)).card : ℝ) * B₂ := by
        simp [mul_assoc]
      _ ≤ ((R * Q : ℕ) : ℝ) * ((R * Q : ℕ) : ℝ) * B₂ := by
        gcongr <;> exact_mod_cast hcount _
      _ = B₂ * ((R * Q : ℕ) : ℝ) ^ 2 := by ring
  have hgroupNonzero (w : ι → ℂ) :
      (∑ i ∈ Snonzero, w i) = ∑ y ∈ L, ∑ i ∈ S.filter (fun i => f i = y), w i := by
    rw [Finset.sum_fiberwise_eq_sum_filter]
    apply Finset.sum_congr ?_ (fun _ _ => rfl)
    ext i
    simp only [Snonzero, Finset.mem_filter]
    exact and_congr_right fun hi =>
      (Finset.mem_erase.trans (and_iff_left (Finset.mem_image_of_mem f hi))).symm
  have hgroup (K : ℤ → ℤ → ℂ) :
      (∑ i ∈ Snonzero, ∑ j ∈ Snonzero, c₂ i j * K (f i) (f j)) =
        ∑ y ∈ L, ∑ z ∈ L, C y z * K y z := by
    rw [hgroupNonzero (fun i => ∑ j ∈ Snonzero, c₂ i j * K (f i) (f j))]
    apply Finset.sum_congr rfl
    intro y _
    calc
      (∑ i ∈ S.filter (fun i => f i = y), ∑ j ∈ Snonzero, c₂ i j * K (f i) (f j)) =
          ∑ i ∈ S.filter (fun i => f i = y), ∑ z ∈ L,
            ∑ j ∈ S.filter (fun j => f j = z), c₂ i j * K (f i) (f j) :=
        Finset.sum_congr rfl (fun i _ => hgroupNonzero (fun j => c₂ i j * K (f i) (f j)))
      _ = ∑ z ∈ L, ∑ i ∈ S.filter (fun i => f i = y),
            ∑ j ∈ S.filter (fun j => f j = z), c₂ i j * K (f i) (f j) :=
        Finset.sum_comm
      _ = ∑ z ∈ L, C y z * K y z := by
        apply Finset.sum_congr rfl
        intro z _
        calc
          (∑ i ∈ S.filter (fun i => f i = y), ∑ j ∈ S.filter (fun j => f j = z),
              c₂ i j * K (f i) (f j)) =
              ∑ i ∈ S.filter (fun i => f i = y), ∑ j ∈ S.filter (fun j => f j = z),
                c₂ i j * K y z := by
            apply Finset.sum_congr rfl
            intro i hi
            apply Finset.sum_congr rfl
            intro j hj
            rw [(Finset.mem_filter.mp hi).2, (Finset.mem_filter.mp hj).2]
          _ = C y z * K y z := by simp only [C, f, Finset.sum_mul]
  have hbound (K : ℤ → ℤ → ℂ) :
      ‖∑ i ∈ Snonzero, ∑ j ∈ Snonzero, c₂ i j * K (f i) (f j)‖ ≤
        B₂ * ((R * Q : ℕ) : ℝ) ^ 2 * ∑ y ∈ L, ∑ z ∈ L, ‖K y z‖ := by
    rw [hgroup K]
    calc
      ‖∑ y ∈ L, ∑ z ∈ L, C y z * K y z‖ ≤
          ∑ y ∈ L, ∑ z ∈ L, ‖C y z * K y z‖ :=
        norm_sum_le_of_le _ (fun _ _ => norm_sum_le _ _)
      _ ≤ ∑ y ∈ L, ∑ z ∈ L, (B₂ * ((R * Q : ℕ) : ℝ) ^ 2) * ‖K y z‖ := by
        apply Finset.sum_le_sum
        intro y _
        apply Finset.sum_le_sum
        intro z _
        rw [norm_mul]
        exact mul_le_mul_of_nonneg_right (hC y z) (norm_nonneg _)
      _ = B₂ * ((R * Q : ℕ) : ℝ) ^ 2 * ∑ y ∈ L, ∑ z ∈ L, ‖K y z‖ := by
        simp only [Finset.mul_sum]
  exact ⟨hC, fun K => ⟨hgroup K, hbound K⟩⟩

/--
The lattice of integer pairs `(x, y)` satisfying `f₁ ∣ x`, `f₂ ∣ u * y + F * x`, and `f₃ ∣ v * y
+ G * x`. It is expressed as the intersection of three inverse images of principal ideals.
-/
def sourceTerminalMobiusLattice (f₁ f₂ f₃ : ℕ) (u v F G : ℤ) :
    Submodule ℤ (ℤ × ℤ) :=
  Submodule.comap (LinearMap.fst ℤ ℤ ℤ) (Ideal.span {(f₁ : ℤ)}) ⊓
    Submodule.comap (u • LinearMap.snd ℤ ℤ ℤ + F • LinearMap.fst ℤ ℤ ℤ)
      (Ideal.span {(f₂ : ℤ)}) ⊓
    Submodule.comap (v • LinearMap.snd ℤ ℤ ℤ + G • LinearMap.fst ℤ ℤ ℤ)
      (Ideal.span {(f₃ : ℤ)})

theorem sourceTerminalMobius_lattice_and_finite_reindex
    (m a w f₁ f₂ f₃ : ℕ) (ha : 0 < a) (hw : 0 < w)
    (hf₁ : f₁ ∣ a) (hf₂ : f₂ ∣ w) (hf₃ : f₃ ∣ w)
    (ham : Nat.Coprime a m) (hwm : Nat.Coprime w m)
    (u v F G : ℤ) :
    let K : Submodule ℤ (ℤ × ℤ) := sourceTerminalMobiusLattice f₁ f₂ f₃ u v F G
    let f : ℕ := Ideal.absNorm (K.map (LinearMap.fst ℤ ℤ ℤ))
    let w₃ : ℕ := Nat.lcm (f₂ / Int.gcd (f₂ : ℤ) u) (f₃ / Int.gcd (f₃ : ℤ) v)
    (∀ p : ℤ × ℤ, p ∈ K ↔
      (f₁ : ℤ) ∣ p.1 ∧ (f₂ : ℤ) ∣ u * p.2 + F * p.1 ∧
        (f₃ : ℤ) ∣ v * p.2 + G * p.1) ∧
      0 < f ∧ 0 < w₃ ∧ f₁ ∣ f ∧ f ∣ f₁ * w ∧ f ∣ a * w ∧ w₃ ∣ w ∧
      Nat.Coprime f m ∧ Nat.Coprime w₃ m ∧
      (Squarefree w → Squarefree w₃) ∧
      (∀ d : ℤ, (f : ℤ) ∣ d ↔ ∃ n : ℤ,
        (f₁ : ℤ) ∣ d ∧ (f₂ : ℤ) ∣ u * n + F * d ∧ (f₃ : ℤ) ∣ v * n + G * d) ∧
      (∀ n : ℤ, (w₃ : ℤ) ∣ n ↔ (f₂ : ℤ) ∣ u * n ∧ (f₃ : ℤ) ∣ v * n) ∧
      ∃! h : ℤ, 0 ≤ h ∧ h < (w₃ : ℤ) ∧
        (∀ d n : ℤ,
          ((f₁ : ℤ) ∣ d ∧ (f₂ : ℤ) ∣ u * n + F * d ∧
              (f₃ : ℤ) ∣ v * n + G * d) ↔
            ∃! p : ℤ × ℤ, d = (f : ℤ) * p.1 ∧ n = (w₃ : ℤ) * p.2 + h * p.1) ∧
        ∀ (S : Finset (ℤ × ℤ)) (W : ℤ → ℤ → ℂ),
          let T : Finset (ℤ × ℤ) := S.filter fun p =>
            (f₁ : ℤ) ∣ p.1 ∧ (f₂ : ℤ) ∣ u * p.2 + F * p.1 ∧
              (f₃ : ℤ) ∣ v * p.2 + G * p.1
          let V : Finset (ℤ × ℤ) := T.image fun p =>
            (p.1 / (f : ℤ), (p.2 - h * (p.1 / (f : ℤ))) / (w₃ : ℤ))
          (∑ p ∈ T, W p.1 p.2) =
            ∑ p ∈ V, W ((f : ℤ) * p.1) ((w₃ : ℤ) * p.2 + h * p.1) := by
  classical
  intro K f w₃
  have hK (p : ℤ × ℤ) : p ∈ K ↔
      (f₁ : ℤ) ∣ p.1 ∧ (f₂ : ℤ) ∣ u * p.2 + F * p.1 ∧
        (f₃ : ℤ) ∣ v * p.2 + G * p.1 := by
    simp only [K, sourceTerminalMobiusLattice, Submodule.mem_inf, Submodule.mem_comap,
      LinearMap.fst_apply, LinearMap.snd_apply, LinearMap.add_apply,
      LinearMap.smul_apply, smul_eq_mul, Ideal.mem_span_singleton, and_assoc]
  have hproj (d : ℤ) : (f : ℤ) ∣ d ↔ ∃ n : ℤ, (d, n) ∈ K := by
    rw [← Ideal.mem_span_singleton, Int.ideal_span_absNorm_eq_self]
    simp only [Submodule.mem_map, LinearMap.fst_apply, Prod.exists,
      exists_and_right, exists_eq_right]
  have hf₁pos : 0 < f₁ := Nat.pos_of_dvd_of_pos hf₁ ha
  have hf₂pos : 0 < f₂ := Nat.pos_of_dvd_of_pos hf₂ hw
  have hf₃pos : 0 < f₃ := Nat.pos_of_dvd_of_pos hf₃ hw
  have hlarge : ((f₁ : ℤ) * (w : ℤ), 0) ∈ K := by
    apply (hK _).2
    refine ⟨dvd_mul_right _ _, ?_, ?_⟩
    · simpa only [mul_zero, zero_add] using
        dvd_mul_of_dvd_right
          (dvd_mul_of_dvd_right (Int.natCast_dvd_natCast.mpr hf₂) (f₁ : ℤ)) F
    · simpa only [mul_zero, zero_add] using
        dvd_mul_of_dvd_right
          (dvd_mul_of_dvd_right (Int.natCast_dvd_natCast.mpr hf₃) (f₁ : ℤ)) G
  have hfdiv : f ∣ f₁ * w := by
    apply Int.natCast_dvd_natCast.mp
    simpa only [Nat.cast_mul] using (hproj _).2 ⟨0, hlarge⟩
  have hfpos : 0 < f := Nat.pos_of_dvd_of_pos hfdiv (Nat.mul_pos hf₁pos hw)
  have hfne : (f : ℤ) ≠ 0 := by exact_mod_cast hfpos.ne'
  obtain ⟨n₀, hn₀⟩ := (hproj (f : ℤ)).1 (dvd_refl _)
  have hf₁f : f₁ ∣ f := Int.natCast_dvd_natCast.mp ((hK _).1 hn₀).1
  have hfaw : f ∣ a * w := hfdiv.trans (mul_dvd_mul_right hf₁ w)
  have hquot (b : ℕ) (hb : 0 < b) (c n : ℤ) :
      ((b / Int.gcd (b : ℤ) c : ℕ) : ℤ) ∣ n ↔ (b : ℤ) ∣ c * n := by
    have hbne : (b : ℤ) ≠ 0 := by exact_mod_cast hb.ne'
    have hgne : (Int.gcd (b : ℤ) c : ℤ) ≠ 0 := by
      exact_mod_cast (Int.gcd_pos_of_ne_zero_left c hbne).ne'
    rw [Int.natCast_div,
      Int.ediv_dvd_iff_dvd_mul (Int.gcd_dvd_left (b : ℤ) c) hgne,
      Int.dvd_gcd_mul_iff_dvd_mul]
  have hperiod (n : ℤ) : (w₃ : ℤ) ∣ n ↔
      (f₂ : ℤ) ∣ u * n ∧ (f₃ : ℤ) ∣ v * n := by
    dsimp only [w₃]
    rw [← Int.lcm_natCast_natCast, Int.coe_lcm_dvd_iff,
      hquot f₂ hf₂pos u n, hquot f₃ hf₃pos v n]
  have hqpos (b : ℕ) (hb : 0 < b) (c : ℤ) :
      0 < b / Int.gcd (b : ℤ) c := by
    have hbne : (b : ℤ) ≠ 0 := by exact_mod_cast hb.ne'
    simpa only [Int.natAbs_natCast] using
      Int.natAbs_div_gcd_pos_of_ne_zero_left c hbne
  have hw₃pos : 0 < w₃ := Nat.lcm_pos (hqpos f₂ hf₂pos u) (hqpos f₃ hf₃pos v)
  have hw₃posz : (0 : ℤ) < w₃ := by exact_mod_cast hw₃pos
  have hw₃ne : (w₃ : ℤ) ≠ 0 := ne_of_gt hw₃posz
  have hqdiv (b : ℕ) (c : ℤ) : b / Int.gcd (b : ℤ) c ∣ b := by
    apply Nat.div_dvd_of_dvd
    simpa only [Int.natAbs_natCast] using Int.gcd_dvd_natAbs_left (b : ℤ) c
  have hw₃w : w₃ ∣ w := Nat.lcm_dvd ((hqdiv f₂ u).trans hf₂)
    ((hqdiv f₃ v).trans hf₃)
  have hfm : Nat.Coprime f m := Nat.Coprime.of_dvd_left hfaw (ham.mul_left hwm)
  have hw₃m : Nat.Coprime w₃ m := Nat.Coprime.of_dvd_left hw₃w hwm
  have hvertical (n : ℤ) : (0, n) ∈ K ↔ (w₃ : ℤ) ∣ n := by
    rw [hK]
    simpa only [dvd_zero, mul_zero, add_zero, true_and] using (hperiod n).symm
  have hbase : ((0 : ℤ), (w₃ : ℤ)) ∈ K := (hvertical _).2 (dvd_refl _)
  let h : ℤ := n₀ % (w₃ : ℤ)
  have hh₀ : 0 ≤ h := Int.emod_nonneg _ hw₃ne
  have hh₁ : h < (w₃ : ℤ) := Int.emod_lt_of_pos _ hw₃posz
  have hseed : ((f : ℤ), h) ∈ K := by
    have heq : ((f : ℤ), h) =
        ((f : ℤ), n₀) - (n₀ / (w₃ : ℤ)) • ((0 : ℤ), (w₃ : ℤ)) := by
      ext <;> simp [h, Int.emod_def, mul_comm]
    rw [heq]
    exact K.sub_mem hn₀ (K.smul_mem _ hbase)
  let γ : ℤ × ℤ → ℤ × ℤ := fun p =>
    ((f : ℤ) * p.1, (w₃ : ℤ) * p.2 + h * p.1)
  let ψ : ℤ × ℤ → ℤ × ℤ := fun p =>
    (p.1 / (f : ℤ), (p.2 - h * (p.1 / (f : ℤ))) / (w₃ : ℤ))
  have hγmem (p : ℤ × ℤ) : γ p ∈ K := by
    have heq : γ p = p.1 • ((f : ℤ), h) + p.2 • ((0 : ℤ), (w₃ : ℤ)) := by
      ext <;> simp [γ] <;> ring
    rw [heq]
    exact K.add_mem (K.smul_mem _ hseed) (K.smul_mem _ hbase)
  have hγinj : Function.Injective γ := by
    apply Function.LeftInverse.injective (g := ψ)
    rintro ⟨D, N⟩
    simp only [ψ, γ, Int.mul_ediv_cancel_left D hfne, add_sub_cancel_right,
      Int.mul_ediv_cancel_left N hw₃ne]
  have hback (p : ℤ × ℤ) (hp : p ∈ K) : γ (ψ p) = p := by
    have hfirst : (f : ℤ) * (p.1 / (f : ℤ)) = p.1 :=
      Int.mul_ediv_cancel' ((hproj _).2 ⟨p.2, hp⟩)
    have hdiff : ((0 : ℤ), p.2 - h * (p.1 / (f : ℤ))) ∈ K := by
      have heq : p - (p.1 / (f : ℤ)) • ((f : ℤ), h) =
          ((0 : ℤ), p.2 - h * (p.1 / (f : ℤ))) := by
        ext <;> simp <;> nlinarith [hfirst]
      rw [← heq]
      exact K.sub_mem hp (K.smul_mem _ hseed)
    apply Prod.ext hfirst
    change (w₃ : ℤ) * ((p.2 - h * (p.1 / (f : ℤ))) / (w₃ : ℤ)) +
      h * (p.1 / (f : ℤ)) = p.2
    rw [Int.mul_ediv_cancel' ((hvertical _).1 hdiff), sub_add_cancel]
  have hrepr (d n : ℤ) :
      ((f₁ : ℤ) ∣ d ∧ (f₂ : ℤ) ∣ u * n + F * d ∧
          (f₃ : ℤ) ∣ v * n + G * d) ↔
        ∃! p : ℤ × ℤ, d = (f : ℤ) * p.1 ∧ n = (w₃ : ℤ) * p.2 + h * p.1 := by
    constructor
    · intro hp
      have hmem : (d, n) ∈ K := (hK _).2 hp
      refine ⟨ψ (d, n), ?_, ?_⟩
      · have hb := hback (d, n) hmem
        exact ⟨(congrArg Prod.fst hb).symm, (congrArg Prod.snd hb).symm⟩
      · intro q hq
        apply hγinj
        exact (Prod.ext hq.1 hq.2 : (d, n) = γ q).symm.trans (hback _ hmem).symm
    · rintro ⟨p, hp, _⟩
      apply (hK (d, n)).1
      rw [show (d, n) = γ p from Prod.ext hp.1 hp.2]
      exact hγmem p
  have hsum (S : Finset (ℤ × ℤ)) (W : ℤ → ℤ → ℂ) :
      let T : Finset (ℤ × ℤ) := S.filter fun p =>
        (f₁ : ℤ) ∣ p.1 ∧ (f₂ : ℤ) ∣ u * p.2 + F * p.1 ∧
          (f₃ : ℤ) ∣ v * p.2 + G * p.1
      let V : Finset (ℤ × ℤ) := T.image fun p =>
        (p.1 / (f : ℤ), (p.2 - h * (p.1 / (f : ℤ))) / (w₃ : ℤ))
      (∑ p ∈ T, W p.1 p.2) =
        ∑ p ∈ V, W ((f : ℤ) * p.1) ((w₃ : ℤ) * p.2 + h * p.1) := by
    intro T V
    have hTK (p : ℤ × ℤ) (hp : p ∈ T) : p ∈ K :=
      (hK p).2 (Finset.mem_filter.mp hp).2
    have hψinj : Set.InjOn ψ T :=
      (show Set.LeftInvOn γ ψ T from fun p hp => hback p (hTK p hp)).injOn
    change (∑ p ∈ T, W p.1 p.2) = ∑ p ∈ T.image ψ, W (γ p).1 (γ p).2
    rw [Finset.sum_image hψinj]
    apply Finset.sum_congr rfl
    intro p hp
    rw [hback p (hTK p hp)]
  refine ⟨hK, hfpos, hw₃pos, hf₁f, hfdiv, hfaw, hw₃w, hfm, hw₃m, ?_, ?_,
    hperiod, h, ⟨hh₀, hh₁, hrepr, hsum⟩, ?_⟩
  · intro hsq
    exact hsq.squarefree_of_dvd hw₃w
  · intro d
    exact (hproj d).trans (exists_congr fun n => hK (d, n))
  · intro h' hh'
    obtain ⟨p, hp, _⟩ := (hh'.2.2.1 (f : ℤ) h).1 ((hK _).1 hseed)
    have hp₁ : p.1 = 1 := by
      apply mul_left_cancel₀ hfne
      simpa only [mul_one] using hp.1.symm
    have hemod : h % (w₃ : ℤ) = h' % (w₃ : ℤ) := by
      rw [hp.2, hp₁, mul_one]
      simp
    rw [Int.emod_eq_of_lt hh₀ hh₁, Int.emod_eq_of_lt hh'.1 hh'.2.1] at hemod
    exact hemod.symm

theorem sourceTerminalMobius_masked_phase
    (m w₂ f w₃ : ℕ) [NeZero m] (J h : ℤ)
    (hw₂J : (w₂ : ℤ) ∣ J) (hfm : Nat.Coprime f m) (hw₃m : Nat.Coprime w₃ m)
    (A₁ A₂ B : ZMod m) (hA₁ : IsUnit A₁) (hA₂ : IsUnit A₂) :
    let L : ZMod m := A₂ * ((J / (w₂ : ℤ) : ℤ) : ZMod m)
    let A₁' : ZMod m := A₁ * ((w₃ : ZMod m) * (f : ZMod m))⁻¹
    let A₂' : ZMod m := (f : ZMod m) * A₂ * (w₃ : ZMod m)⁻¹
    let B' : ZMod m := ((h : ZMod m) + B * (f : ZMod m)) * (w₃ : ZMod m)⁻¹
    let L' : ZMod m := A₂' * ((J / (w₂ : ℤ) : ℤ) : ZMod m)
    IsUnit A₁' ∧ IsUnit A₂' ∧
      Nat.gcd (((w₂ : ZMod m) * A₁' * L').val) m = Int.gcd J (m : ℤ) ∧
      ∀ D N : ℤ,
        let d : ZMod m := ((f : ℤ) * D : ℤ)
        let n : ZMod m := ((w₃ : ℤ) * N + h * D : ℤ)
        (IsUnit (n + B * d) ∧ IsUnit (n + (B + L) * d) ↔
          IsUnit ((N : ZMod m) + B' * (D : ZMod m)) ∧
            IsUnit ((N : ZMod m) + (B' + L') * (D : ZMod m))) ∧
        affineReciprocalProductPhase m ((w₂ : ZMod m) * A₁) B L 0 0 n d =
          affineReciprocalProductPhase m
            ((w₂ : ZMod m) * A₁') B' L' 0 0 (N : ZMod m) (D : ZMod m) := by
  classical
  intro L A₁' A₂' B' L'
  have hf : IsUnit (f : ZMod m) := (ZMod.isUnit_iff_coprime f m).mpr hfm
  have hw : IsUnit (w₃ : ZMod m) := (ZMod.isUnit_iff_coprime w₃ m).mpr hw₃m
  have hA₁' : IsUnit A₁' :=
    hA₁.mul (IsUnit.of_mul_eq_one _ (ZMod.inv_mul_of_unit _ (hw.mul hf)))
  have hA₂' : IsUnit A₂' :=
    (hf.mul hA₂).mul (IsUnit.of_mul_eq_one _ (ZMod.inv_mul_of_unit _ hw))
  have hwcancel := ZMod.mul_inv_of_unit (w₃ : ZMod m) hw
  have hwfcancel := ZMod.mul_inv_of_unit ((w₃ : ZMod m) * (f : ZMod m)) (hw.mul hf)
  have hwwcancel :=
    ZMod.mul_inv_of_unit ((w₃ : ZMod m) * (w₃ : ZMod m)) (hw.mul hw)
  have hJ : (w₂ : ZMod m) * ((J / (w₂ : ℤ) : ℤ) : ZMod m) = (J : ZMod m) := by
    simpa only [Int.cast_mul, Int.cast_natCast] using
      congrArg (fun z : ℤ => (z : ZMod m)) (Int.mul_ediv_cancel' hw₂J)
  have hcoeff : (w₂ : ZMod m) * A₁' * L' = (A₁' * A₂') * (J : ZMod m) := by
    dsimp only [L']
    linear_combination (A₁' * A₂') * hJ
  have hgcd : Nat.gcd (((w₂ : ZMod m) * A₁' * L').val) m = Int.gcd J (m : ℤ) := by
    have hCcop := ZMod.val_coe_unit_coprime (hA₁'.mul hA₂').unit
    rw [IsUnit.unit_spec] at hCcop
    rw [hcoeff, ZMod.val_mul, ← Nat.gcd_rec, Nat.gcd_comm,
      Nat.Coprime.gcd_mul_left_cancel _ hCcop, ← Int.gcd_natCast_natCast,
      ZMod.val_intCast, Int.gcd_emod]
  have hB : (w₃ : ZMod m) * B' = (h : ZMod m) + B * (f : ZMod m) := by
    dsimp only [B']
    linear_combination ((h : ZMod m) + B * (f : ZMod m)) * hwcancel
  have hL : (w₃ : ZMod m) * L' = (f : ZMod m) * L := by
    dsimp only [L', A₂', L]
    linear_combination
      ((f : ZMod m) * A₂ * ((J / (w₂ : ℤ) : ℤ) : ZMod m)) * hwcancel
  have hscale : ((w₃ : ZMod m) * (w₃ : ZMod m)) *
      ((w₂ : ZMod m) * A₁' * L') = (w₂ : ZMod m) * A₁ * L := by
    dsimp only [A₁', A₂', L', L]
    linear_combination
      ((w₂ : ZMod m) * A₁ * A₂ * ((J / (w₂ : ℤ) : ℤ) : ZMod m) *
        (w₃ : ZMod m) * (w₃ : ZMod m)⁻¹) * hwfcancel +
      ((w₂ : ZMod m) * A₁ * A₂ * ((J / (w₂ : ℤ) : ℤ) : ZMod m)) * hwcancel
  have hscaled : ((w₂ : ZMod m) * A₁ * L) *
      ((w₃ : ZMod m) * (w₃ : ZMod m))⁻¹ = (w₂ : ZMod m) * A₁' * L' := by
    rw [← hscale]
    linear_combination ((w₂ : ZMod m) * A₁' * L') * hwwcancel
  refine ⟨hA₁', hA₂', hgcd, ?_⟩
  intro D N d n
  let P₁ : ZMod m := (N : ZMod m) + B' * (D : ZMod m)
  let P₂ : ZMod m := (N : ZMod m) + (B' + L') * (D : ZMod m)
  have hn : n + B * d = (w₃ : ZMod m) * P₁ := by
    dsimp only [n, d, P₁]
    push_cast
    linear_combination -(D : ZMod m) * hB
  have hnt : n + (B + L) * d = (w₃ : ZMod m) * P₂ := by
    dsimp only [n, d, P₂]
    push_cast
    linear_combination -(D : ZMod m) * hB - (D : ZMod m) * hL
  have hmask :
      (IsUnit ((w₃ : ZMod m) * P₁) ∧ IsUnit ((w₃ : ZMod m) * P₂)) ↔
        IsUnit P₁ ∧ IsUnit P₂ := by
    rw [hw.mul_left_iff, hw.mul_left_iff]
  constructor
  · rw [hn, hnt]
    exact hmask
  · unfold affineReciprocalProductPhase
    simp only [add_zero]
    change (if IsUnit (n + B * d) ∧ IsUnit (n + (B + L) * d) then
        ZMod.stdAddChar (((w₂ : ZMod m) * A₁) * L *
          ((n + B * d) * (n + (B + L) * d))⁻¹) else 0) =
      if IsUnit P₁ ∧ IsUnit P₂ then
        ZMod.stdAddChar (((w₂ : ZMod m) * A₁') * L' * (P₁ * P₂)⁻¹) else 0
    simp only [hn, hnt, hmask]
    split_ifs with hP
    · have hinv : (((w₃ : ZMod m) * P₁) * ((w₃ : ZMod m) * P₂))⁻¹ =
          ((w₃ : ZMod m) * (w₃ : ZMod m))⁻¹ * (P₁ * P₂)⁻¹ := by
        apply ZMod.inv_eq_of_mul_eq_one
        linear_combination ((P₁ * P₂) * (P₁ * P₂)⁻¹) * hwwcancel +
          ZMod.mul_inv_of_unit _ (hP.1.mul hP.2)
      rw [hinv]
      congr 1
      linear_combination (P₁ * P₂)⁻¹ * hscaled
    · rfl

theorem sourceTerminalMobius_residue_classes
    (m q₀ f w₃ : ℕ)
    (hq₀ : q₀ ∣ m) (hfm : Nat.Coprime f m) (hw₃m : Nat.Coprime w₃ m)
    (u F h : ℤ) (hu : IsUnit (u : ZMod m)) (dstar nstar : ZMod q₀) :
    let dstar' : ZMod q₀ := (f : ZMod q₀)⁻¹ * dstar
    let nstar' : ZMod q₀ := ((u : ZMod q₀) * (w₃ : ZMod q₀))⁻¹ *
      (nstar - ((u * h + F * (f : ℤ) : ℤ) : ZMod q₀) * dstar')
    IsUnit (f : ZMod q₀) ∧ IsUnit (w₃ : ZMod q₀) ∧ IsUnit (u : ZMod q₀) ∧
      ∀ D N : ℤ,
        (Int.gcd ((f : ℤ) * D) (m : ℤ) = 1 ↔ Int.gcd D (m : ℤ) = 1) ∧
        ((((f : ℤ) * D : ℤ) : ZMod q₀) = dstar ∧
            ((u * ((w₃ : ℤ) * N + h * D) + F * ((f : ℤ) * D) : ℤ) : ZMod q₀) =
              nstar ↔
          (D : ZMod q₀) = dstar' ∧ (N : ZMod q₀) = nstar') := by
  intro dstar' nstar'
  have hf : IsUnit (f : ZMod q₀) :=
    (ZMod.isUnit_iff_coprime f q₀).mpr (hfm.of_dvd_right hq₀)
  have hw : IsUnit (w₃ : ZMod q₀) :=
    (ZMod.isUnit_iff_coprime w₃ q₀).mpr (hw₃m.of_dvd_right hq₀)
  have huq : IsUnit (u : ZMod q₀) := by
    simpa only [ZMod.castHom_apply, ZMod.cast_intCast hq₀] using
      hu.map (ZMod.castHom hq₀ (ZMod q₀))
  have hfgcd : Int.gcd (f : ℤ) (m : ℤ) = 1 := by
    simpa only [Int.gcd_natCast_natCast] using hfm.gcd_eq_one
  have hsolve (x y z : ZMod q₀) (hx : IsUnit x) : x * y = z ↔ y = x⁻¹ * z := by
    rcases hx with ⟨ux, rfl⟩
    simpa only [ZMod.inv_coe_unit, eq_comm] using
      (ux.inv_mul_eq_iff_eq_mul (b := z) (c := y)).symm
  refine ⟨hf, hw, huq, ?_⟩
  intro D N
  constructor
  · rw [Int.gcd_mul_right_left_of_gcd_eq_one hfgcd]
  · have hlin :
        ((u * ((w₃ : ℤ) * N + h * D) + F * ((f : ℤ) * D) : ℤ) : ZMod q₀) =
          ((u : ZMod q₀) * (w₃ : ZMod q₀)) * (N : ZMod q₀) +
            ((u * h + F * (f : ℤ) : ℤ) : ZMod q₀) * (D : ZMod q₀) := by
      push_cast
      ring
    rw [Int.cast_mul, Int.cast_natCast, hlin, hsolve _ _ _ hf]
    apply and_congr_right
    intro hD
    rw [hD, ← eq_sub_iff_add_eq, hsolve _ _ _ (huq.mul hw)]

theorem sourceTerminalMobius_finite_expansion
    (a w : ℕ) (ha : 0 < a) (hw : 0 < w)
    (u v F G : ℤ) (S : Finset (ℤ × ℤ)) (W : ℤ → ℤ → ℂ) :
    (∑ p ∈ S.filter (fun p =>
        Int.gcd p.1 (a : ℤ) = 1 ∧
          Int.gcd (u * p.2 + F * p.1) (w : ℤ) = 1 ∧
          Int.gcd (v * p.2 + G * p.1) (w : ℤ) = 1), W p.1 p.2) =
      ∑ f₁ ∈ a.divisors, ∑ f₂ ∈ w.divisors, ∑ f₃ ∈ w.divisors,
        ((ArithmeticFunction.moebius f₁ : ℤ) : ℂ) *
          ((ArithmeticFunction.moebius f₂ : ℤ) : ℂ) *
          ((ArithmeticFunction.moebius f₃ : ℤ) : ℂ) *
          ∑ p ∈ S.filter (fun p =>
            (f₁ : ℤ) ∣ p.1 ∧ (f₂ : ℤ) ∣ u * p.2 + F * p.1 ∧
              (f₃ : ℤ) ∣ v * p.2 + G * p.1), W p.1 p.2 := by
  classical
  have hmob (k : ℕ) (hk : 0 < k) (z : ℤ) :
      (∑ d ∈ k.divisors,
        if (d : ℤ) ∣ z then ((ArithmeticFunction.moebius d : ℤ) : ℂ) else 0) =
        if Int.gcd z (k : ℤ) = 1 then 1 else 0 := by
    have hg : Nat.gcd z.natAbs k ≠ 0 := (Nat.gcd_pos_of_pos_right z.natAbs hk).ne'
    have hfilter : k.divisors.filter (fun d : ℕ => (d : ℤ) ∣ z) =
        (Int.gcd z (k : ℤ)).divisors := by
      ext d
      simp [hk.ne', Int.gcd_def, hg, Nat.dvd_gcd_iff,
        Int.natCast_dvd, and_comm]
    rw [← Finset.sum_filter, hfilter]
    change (∑ d ∈ (Int.gcd z (k : ℤ)).divisors,
      (ArithmeticFunction.moebius : ArithmeticFunction ℂ) d) = _
    rw [← ArithmeticFunction.coe_mul_zeta_apply,
      ArithmeticFunction.coe_moebius_mul_coe_zeta, ArithmeticFunction.one_apply]
  have hpoint (p : ℤ × ℤ) :
      (if Int.gcd p.1 (a : ℤ) = 1 ∧
          Int.gcd (u * p.2 + F * p.1) (w : ℤ) = 1 ∧
          Int.gcd (v * p.2 + G * p.1) (w : ℤ) = 1 then W p.1 p.2 else 0) =
        (∑ f₁ ∈ a.divisors,
          if (f₁ : ℤ) ∣ p.1 then ((ArithmeticFunction.moebius f₁ : ℤ) : ℂ) else 0) *
        (∑ f₂ ∈ w.divisors,
          if (f₂ : ℤ) ∣ u * p.2 + F * p.1 then
            ((ArithmeticFunction.moebius f₂ : ℤ) : ℂ) else 0) *
        (∑ f₃ ∈ w.divisors,
          if (f₃ : ℤ) ∣ v * p.2 + G * p.1 then
            ((ArithmeticFunction.moebius f₃ : ℤ) : ℂ) else 0) * W p.1 p.2 := by
    rw [hmob a ha p.1, hmob w hw (u * p.2 + F * p.1),
      hmob w hw (v * p.2 + G * p.1)]
    rw [ite_zero_mul_ite_zero, ite_zero_mul_ite_zero]
    simp only [ite_mul, zero_mul, one_mul, and_assoc]
  simp_rw [Finset.sum_filter, Finset.mul_sum, Finset.sum_comm (t := S)]
  apply Finset.sum_congr rfl
  intro p _
  rw [hpoint p, mul_assoc, mul_assoc, Finset.sum_mul]
  apply Finset.sum_congr rfl
  intro f₁ _
  rw [← mul_assoc, Finset.mul_sum, Finset.sum_mul]
  apply Finset.sum_congr rfl
  intro f₂ _
  rw [← mul_assoc, Finset.mul_sum, Finset.sum_mul]
  apply Finset.sum_congr rfl
  intro f₃ _
  rw [ite_zero_mul_ite_zero, ite_zero_mul_ite_zero]
  simp only [ite_mul, mul_ite, zero_mul, mul_zero, and_assoc]

open Classical in
theorem sourceTerminalInsideModulus_residue_refinement
    (m q₀ c₁ c₂ e₀ e₁ e₂ e₃ e₄ f w₃ : ℕ) [NeZero m] [NeZero q₀]
    (hq₀ : q₀ ∣ m) (hc₁ : c₁ ∣ m) (hc₂ : c₂ ∣ m)
    (he₀ : e₀ ∣ m) (he₁ : e₁ ∣ c₁) (he₂ : e₂ ∣ c₁)
    (he₃ : e₃ ∣ c₂) (he₄ : e₄ ∣ c₂)
    (u v F G h ell dstar nstar : ℤ)
    (hu : IsUnit (u : ZMod m)) (hv : IsUnit (v : ZMod m))
    (hw₃ : Nat.Coprime w₃ m) :
    let F₁ : ℤ → ℤ → ℤ := fun d n =>
      u * (w₃ : ℤ) * n + (u * h + F * (f : ℤ)) * d
    let F₂ : ℤ → ℤ → ℤ := fun d n =>
      v * (w₃ : ℤ) * n + (v * h + G * (f : ℤ)) * d
    let F₃ : ℤ → ℤ → ℤ := fun d n =>
      u * (w₃ : ℤ) * n + (u * h + (F + ell) * (f : ℤ)) * d
    let F₄ : ℤ → ℤ → ℤ := fun d n =>
      v * (w₃ : ℤ) * n + (v * h + (G + ell) * (f : ℤ)) * d
    let g₂ : ℕ := Nat.lcm q₀ e₀
    let g₃ : ℕ := Nat.lcm q₀ (Nat.lcm e₁ (Nat.lcm e₂ (Nat.lcm e₃ e₄)))
    let g₁ : ℕ := Nat.lcm g₂ g₃
    let q₃ : ℕ := g₁ / q₀
    let R : Finset (Fin g₁ × Fin g₁) := Finset.univ.filter fun r =>
      Int.ModEq (q₀ : ℤ) (r.1.val : ℤ) dstar ∧
        Int.ModEq (q₀ : ℤ) (r.2.val : ℤ) nstar ∧
        (e₀ : ℤ) ∣ (r.1.val : ℤ) ∧
        (e₁ : ℤ) ∣ F₁ (r.1.val : ℤ) (r.2.val : ℤ) ∧
        (e₂ : ℤ) ∣ F₂ (r.1.val : ℤ) (r.2.val : ℤ) ∧
        (e₃ : ℤ) ∣ F₃ (r.1.val : ℤ) (r.2.val : ℤ) ∧
        (e₄ : ℤ) ∣ F₄ (r.1.val : ℤ) (r.2.val : ℤ)
    0 < g₁ ∧ 0 < q₃ ∧ q₀ * q₃ = g₁ ∧ g₁ ∣ m ∧ q₃ ∣ m / q₀ ∧
      R.card ≤ (g₁ / g₂) * (g₁ / g₃) ∧
      (g₁ / g₂) * (g₁ / g₃) = g₁ / Nat.gcd g₂ g₃ ∧
      (g₁ / g₂) * (g₁ / g₃) ≤ q₃ ∧
      (∀ d n : ℤ,
        (Int.ModEq (q₀ : ℤ) d dstar ∧ Int.ModEq (q₀ : ℤ) n nstar ∧
            (e₀ : ℤ) ∣ d ∧ (e₁ : ℤ) ∣ F₁ d n ∧ (e₂ : ℤ) ∣ F₂ d n ∧
            (e₃ : ℤ) ∣ F₃ d n ∧ (e₄ : ℤ) ∣ F₄ d n) ↔
          ∃! r : Fin g₁ × Fin g₁, r ∈ R ∧
            Int.ModEq (g₁ : ℤ) d (r.1.val : ℤ) ∧
            Int.ModEq (g₁ : ℤ) n (r.2.val : ℤ)) ∧
      ∀ (S : Finset (ℤ × ℤ)) (W : ℤ → ℤ → ℂ),
        (∑ p ∈ S.filter (fun p =>
            Int.ModEq (q₀ : ℤ) p.1 dstar ∧ Int.ModEq (q₀ : ℤ) p.2 nstar ∧
              (e₀ : ℤ) ∣ p.1 ∧ (e₁ : ℤ) ∣ F₁ p.1 p.2 ∧
              (e₂ : ℤ) ∣ F₂ p.1 p.2 ∧ (e₃ : ℤ) ∣ F₃ p.1 p.2 ∧
              (e₄ : ℤ) ∣ F₄ p.1 p.2), W p.1 p.2) =
          ∑ r ∈ R, ∑ p ∈ S.filter (fun p =>
            Int.ModEq (g₁ : ℤ) p.1 (r.1.val : ℤ) ∧
              Int.ModEq (g₁ : ℤ) p.2 (r.2.val : ℤ)), W p.1 p.2 := by
  intro F₁ F₂ F₃ F₄ g₂ g₃ g₁ q₃ R
  have he₁m : e₁ ∣ m := he₁.trans hc₁
  have he₂m : e₂ ∣ m := he₂.trans hc₁
  have he₃m : e₃ ∣ m := he₃.trans hc₂
  have he₄m : e₄ ∣ m := he₄.trans hc₂
  have hg₂m : g₂ ∣ m := Nat.lcm_dvd hq₀ he₀
  have hg₃m : g₃ ∣ m := Nat.lcm_dvd hq₀
    (Nat.lcm_dvd he₁m (Nat.lcm_dvd he₂m (Nat.lcm_dvd he₃m he₄m)))
  have hg₁m : g₁ ∣ m := Nat.lcm_dvd hg₂m hg₃m
  have hg₁pos : 0 < g₁ := Nat.pos_of_dvd_of_pos hg₁m (NeZero.pos m)
  have hqg₂ : q₀ ∣ g₂ := Nat.dvd_lcm_left _ _
  have hqg₃ : q₀ ∣ g₃ := Nat.dvd_lcm_left _ _
  have hg₂g₁ : g₂ ∣ g₁ := Nat.dvd_lcm_left _ _
  have hg₃g₁ : g₃ ∣ g₁ := Nat.dvd_lcm_right _ _
  have hqg₁ : q₀ ∣ g₁ := hqg₂.trans hg₂g₁
  have he₀g₁ : e₀ ∣ g₁ := (Nat.dvd_lcm_right _ _).trans hg₂g₁
  have he₁g₁ : e₁ ∣ g₁ :=
    ((Nat.dvd_lcm_left e₁ _).trans (Nat.dvd_lcm_right q₀ _)).trans hg₃g₁
  have he₂g₁ : e₂ ∣ g₁ :=
    (((Nat.dvd_lcm_left e₂ _).trans (Nat.dvd_lcm_right e₁ _)).trans
      (Nat.dvd_lcm_right q₀ _)).trans hg₃g₁
  have he₃g₁ : e₃ ∣ g₁ :=
    ((((Nat.dvd_lcm_left e₃ e₄).trans (Nat.dvd_lcm_right e₂ _)).trans
      (Nat.dvd_lcm_right e₁ _)).trans (Nat.dvd_lcm_right q₀ _)).trans hg₃g₁
  have he₄g₁ : e₄ ∣ g₁ :=
    ((((Nat.dvd_lcm_right e₃ e₄).trans (Nat.dvd_lcm_right e₂ _)).trans
      (Nat.dvd_lcm_right e₁ _)).trans (Nat.dvd_lcm_right q₀ _)).trans hg₃g₁
  have hq₃pos : 0 < q₃ :=
    Nat.div_pos (Nat.le_of_dvd hg₁pos hqg₁) (NeZero.pos q₀)
  have hprod : (g₁ / g₂) * (g₁ / g₃) = g₁ / Nat.gcd g₂ g₃ := by
    rw [Nat.div_mul_div_comm hg₂g₁ hg₃g₁]
    have hgl : Nat.gcd g₂ g₃ * g₁ = g₂ * g₃ := Nat.gcd_mul_lcm _ _
    rw [← hgl, Nat.mul_comm (Nat.gcd g₂ g₃) g₁,
      Nat.mul_div_mul_left _ _ hg₁pos]
  have hbound : (g₁ / g₂) * (g₁ / g₃) ≤ q₃ := by
    rw [hprod]
    exact Nat.le_of_dvd hq₃pos (Nat.div_dvd_div_left
      ((Nat.gcd_dvd_left g₂ g₃).trans hg₂g₁) (Nat.dvd_gcd hqg₂ hqg₃))
  have hcancel (e : ℕ) (hem : e ∣ m) (a b d n n' : ℤ)
      (ha : IsUnit (a : ZMod m))
      (hn : (e : ℤ) ∣ a * n + b * d) (hn' : (e : ℤ) ∣ a * n' + b * d) :
      Int.ModEq (e : ℤ) n n' := by
    have hae : IsUnit (a : ZMod e) := by
      simpa only [map_intCast] using ha.map (ZMod.castHom hem (ZMod e))
    apply (ZMod.intCast_eq_intCast_iff n n' e).mp
    apply hae.mul_left_cancel
    simpa only [Int.cast_mul] using
      (ZMod.intCast_eq_intCast_iff (a * n) (a * n') e).mpr
        (Int.ModEq.add_right_cancel' (b * d)
          (hn.modEq_zero_int.trans hn'.modEq_zero_int.symm))
  have huW : IsUnit ((u * (w₃ : ℤ) : ℤ) : ZMod m) := by
    simpa only [Int.cast_mul, Int.cast_natCast] using
      hu.mul ((ZMod.isUnit_iff_coprime w₃ m).mpr hw₃)
  have hvW : IsUnit ((v * (w₃ : ℤ) : ℤ) : ZMod m) := by
    simpa only [Int.cast_mul, Int.cast_natCast] using
      hv.mul ((ZMod.isUnit_iff_coprime w₃ m).mpr hw₃)
  have hcard : R.card ≤ (g₁ / g₂) * (g₁ / g₃) := by
    let Φ : R → Fin (g₁ / g₂) × Fin (g₁ / g₃) := fun r =>
      (⟨r.1.1.val / g₂, Nat.div_lt_div_of_lt_of_dvd hg₂g₁ r.1.1.isLt⟩,
        ⟨r.1.2.val / g₃, Nat.div_lt_div_of_lt_of_dvd hg₃g₁ r.1.2.isLt⟩)
    have hinj : Function.Injective Φ := by
      intro r t hrt
      obtain ⟨hrd, hrn, hr₀, hr₁, hr₂, hr₃, hr₄⟩ := (Finset.mem_filter.mp r.2).2
      obtain ⟨htd, htn, ht₀, ht₁, ht₂, ht₃, ht₄⟩ := (Finset.mem_filter.mp t.2).2
      have hdmod : Int.ModEq (g₂ : ℤ) (r.1.1.val : ℤ) (t.1.1.val : ℤ) := by
        simpa only [Int.lcm_natCast_natCast] using
          (Int.modEq_and_modEq_iff_modEq_lcm.mp
            ⟨hrd.trans htd.symm, hr₀.modEq_zero_int.trans ht₀.modEq_zero_int.symm⟩)
      have hddiv : r.1.1.val / g₂ = t.1.1.val / g₂ :=
        congrArg (fun x : Fin (g₁ / g₂) × Fin (g₁ / g₃) => x.1.val) hrt
      have hdval : r.1.1.val = t.1.1.val :=
        Nat.ext_div_modEq hddiv (Int.natCast_modEq_iff.mp hdmod)
      have hn₁ := hcancel e₁ he₁m (u * (w₃ : ℤ)) (u * h + F * (f : ℤ))
        (r.1.1.val : ℤ) (r.1.2.val : ℤ) (t.1.2.val : ℤ) huW hr₁
        (by simpa only [← hdval] using ht₁)
      have hn₂ := hcancel e₂ he₂m (v * (w₃ : ℤ)) (v * h + G * (f : ℤ))
        (r.1.1.val : ℤ) (r.1.2.val : ℤ) (t.1.2.val : ℤ) hvW hr₂
        (by simpa only [← hdval] using ht₂)
      have hn₃ := hcancel e₃ he₃m (u * (w₃ : ℤ)) (u * h + (F + ell) * (f : ℤ))
        (r.1.1.val : ℤ) (r.1.2.val : ℤ) (t.1.2.val : ℤ) huW hr₃
        (by simpa only [← hdval] using ht₃)
      have hn₄ := hcancel e₄ he₄m (v * (w₃ : ℤ)) (v * h + (G + ell) * (f : ℤ))
        (r.1.1.val : ℤ) (r.1.2.val : ℤ) (t.1.2.val : ℤ) hvW hr₄
        (by simpa only [← hdval] using ht₄)
      have hnmod : Int.ModEq (g₃ : ℤ) (r.1.2.val : ℤ) (t.1.2.val : ℤ) := by
        simpa only [Int.lcm_natCast_natCast] using
          (Int.modEq_and_modEq_iff_modEq_lcm.mp ⟨hrn.trans htn.symm,
            Int.modEq_and_modEq_iff_modEq_lcm.mp ⟨hn₁,
              Int.modEq_and_modEq_iff_modEq_lcm.mp ⟨hn₂,
                Int.modEq_and_modEq_iff_modEq_lcm.mp ⟨hn₃, hn₄⟩⟩⟩⟩)
      have hndiv : r.1.2.val / g₃ = t.1.2.val / g₃ :=
        congrArg (fun x : Fin (g₁ / g₂) × Fin (g₁ / g₃) => x.2.val) hrt
      have hnval : r.1.2.val = t.1.2.val :=
        Nat.ext_div_modEq hndiv (Int.natCast_modEq_iff.mp hnmod)
      exact Subtype.ext (Prod.ext (Fin.ext hdval) (Fin.ext hnval))
    simpa only [Fintype.card_coe, Fintype.card_prod, Fintype.card_fin] using
      Fintype.card_le_of_injective Φ hinj
  have hlinear (e : ℕ) (he : e ∣ g₁) (a b : ℤ) {d n d' n' : ℤ}
      (hd : Int.ModEq (g₁ : ℤ) d d') (hn : Int.ModEq (g₁ : ℤ) n n') :
      ((e : ℤ) ∣ a * n + b * d ↔ (e : ℤ) ∣ a * n' + b * d') :=
    (((hn.mul_left a).add (hd.mul_left b)).of_dvd
      (show (e : ℤ) ∣ (g₁ : ℤ) by exact_mod_cast he)).dvd_iff
  have hcond (d n d' n' : ℤ)
      (hd : Int.ModEq (g₁ : ℤ) d d') (hn : Int.ModEq (g₁ : ℤ) n n') :
      (Int.ModEq (q₀ : ℤ) d dstar ∧ Int.ModEq (q₀ : ℤ) n nstar ∧
        (e₀ : ℤ) ∣ d ∧ (e₁ : ℤ) ∣ F₁ d n ∧ (e₂ : ℤ) ∣ F₂ d n ∧
        (e₃ : ℤ) ∣ F₃ d n ∧ (e₄ : ℤ) ∣ F₄ d n) ↔
      (Int.ModEq (q₀ : ℤ) d' dstar ∧ Int.ModEq (q₀ : ℤ) n' nstar ∧
        (e₀ : ℤ) ∣ d' ∧ (e₁ : ℤ) ∣ F₁ d' n' ∧ (e₂ : ℤ) ∣ F₂ d' n' ∧
        (e₃ : ℤ) ∣ F₃ d' n' ∧ (e₄ : ℤ) ∣ F₄ d' n') := by
    have hdq := hd.of_dvd (show (q₀ : ℤ) ∣ (g₁ : ℤ) by exact_mod_cast hqg₁)
    have hnq := hn.of_dvd (show (q₀ : ℤ) ∣ (g₁ : ℤ) by exact_mod_cast hqg₁)
    have hd₀ := (hd.of_dvd
      (show (e₀ : ℤ) ∣ (g₁ : ℤ) by exact_mod_cast he₀g₁)).dvd_iff
    have hF₁ : (e₁ : ℤ) ∣ F₁ d n ↔ (e₁ : ℤ) ∣ F₁ d' n' :=
      hlinear e₁ he₁g₁ (u * (w₃ : ℤ)) (u * h + F * (f : ℤ)) hd hn
    have hF₂ : (e₂ : ℤ) ∣ F₂ d n ↔ (e₂ : ℤ) ∣ F₂ d' n' :=
      hlinear e₂ he₂g₁ (v * (w₃ : ℤ)) (v * h + G * (f : ℤ)) hd hn
    have hF₃ : (e₃ : ℤ) ∣ F₃ d n ↔ (e₃ : ℤ) ∣ F₃ d' n' :=
      hlinear e₃ he₃g₁ (u * (w₃ : ℤ)) (u * h + (F + ell) * (f : ℤ)) hd hn
    have hF₄ : (e₄ : ℤ) ∣ F₄ d n ↔ (e₄ : ℤ) ∣ F₄ d' n' :=
      hlinear e₄ he₄g₁ (v * (w₃ : ℤ)) (v * h + (G + ell) * (f : ℤ)) hd hn
    refine and_congr ?_ (and_congr ?_
      (and_congr hd₀ (and_congr hF₁ (and_congr hF₂ (and_congr hF₃ hF₄)))))
    · exact ⟨fun h' => hdq.symm.trans h', fun h' => hdq.trans h'⟩
    · exact ⟨fun h' => hnq.symm.trans h', fun h' => hnq.trans h'⟩
  let : NeZero g₁ := ⟨Nat.ne_of_gt hg₁pos⟩
  let rep (t : ℤ) : Fin g₁ := ⟨(t : ZMod g₁).val, ZMod.val_lt _⟩
  have hrep (t : ℤ) : Int.ModEq (g₁ : ℤ) t ((rep t).val : ℤ) := by
    apply (ZMod.intCast_eq_intCast_iff _ _ g₁).mp
    simp only [rep, Int.cast_natCast, ZMod.natCast_zmod_val]
  have huniq {a b : Fin g₁}
      (hab : Int.ModEq (g₁ : ℤ) (a.val : ℤ) (b.val : ℤ)) : a = b :=
    Fin.ext ((Int.natCast_modEq_iff.mp hab).eq_of_lt_of_lt a.isLt b.isLt)
  have hmem (d n : ℤ) : (rep d, rep n) ∈ R ↔
      (Int.ModEq (q₀ : ℤ) d dstar ∧ Int.ModEq (q₀ : ℤ) n nstar ∧
        (e₀ : ℤ) ∣ d ∧ (e₁ : ℤ) ∣ F₁ d n ∧ (e₂ : ℤ) ∣ F₂ d n ∧
        (e₃ : ℤ) ∣ F₃ d n ∧ (e₄ : ℤ) ∣ F₄ d n) := by
    simpa only [R, Finset.mem_filter, Finset.mem_univ, true_and] using
      (hcond d n ((rep d).val : ℤ) ((rep n).val : ℤ) (hrep d) (hrep n)).symm
  have hrepr (d n : ℤ) :
      (Int.ModEq (q₀ : ℤ) d dstar ∧ Int.ModEq (q₀ : ℤ) n nstar ∧
        (e₀ : ℤ) ∣ d ∧ (e₁ : ℤ) ∣ F₁ d n ∧ (e₂ : ℤ) ∣ F₂ d n ∧
        (e₃ : ℤ) ∣ F₃ d n ∧ (e₄ : ℤ) ∣ F₄ d n) ↔
      ∃! r : Fin g₁ × Fin g₁, r ∈ R ∧
        Int.ModEq (g₁ : ℤ) d (r.1.val : ℤ) ∧
        Int.ModEq (g₁ : ℤ) n (r.2.val : ℤ) := by
    constructor
    · intro hp
      refine ⟨(rep d, rep n), ⟨(hmem d n).mpr hp, hrep d, hrep n⟩, ?_⟩
      intro r hr
      exact Prod.ext (huniq (hr.2.1.symm.trans (hrep d)))
        (huniq (hr.2.2.symm.trans (hrep n)))
    · rintro ⟨r, hr, _⟩
      exact (hcond d n (r.1.val : ℤ) (r.2.val : ℤ) hr.2.1 hr.2.2).mpr
        (Finset.mem_filter.mp hr.1).2
  have hkey (p : ℤ × ℤ) (r : Fin g₁ × Fin g₁) :
      (rep p.1, rep p.2) = r ↔
        Int.ModEq (g₁ : ℤ) p.1 (r.1.val : ℤ) ∧
          Int.ModEq (g₁ : ℤ) p.2 (r.2.val : ℤ) := by
    constructor
    · rintro rfl
      exact ⟨hrep p.1, hrep p.2⟩
    · intro hr
      exact Prod.ext (huniq ((hrep p.1).symm.trans hr.1))
        (huniq ((hrep p.2).symm.trans hr.2))
  refine ⟨hg₁pos, hq₃pos, Nat.mul_div_cancel' hqg₁, hg₁m,
    Nat.div_dvd_div hqg₁ hg₁m, hcard, hprod, hbound, hrepr, ?_⟩
  intro S W
  simpa only [hkey, hmem] using
    (Finset.sum_fiberwise_eq_sum_filter S R (fun p : ℤ × ℤ => (rep p.1, rep p.2))
      (fun p : ℤ × ℤ => W p.1 p.2)).symm

open Classical in
theorem sourceTerminalInsideMobius_masked_reduction
    (m q₀ c₁ c₂ f w₃ : ℕ) [NeZero m] [NeZero q₀]
    (hq₀ : q₀ ∣ m) (hc₁ : c₁ ∣ m) (hc₂ : c₂ ∣ m)
    (u v F G h ell dstar nstar : ℤ)
    (hu : IsUnit (u : ZMod m)) (hv : IsUnit (v : ZMod m))
    (hw₃ : Nat.Coprime w₃ m)
    (A B L : ZMod m) (D N : Finset ℤ) (wD wN : ℤ → ℂ) :
    let F₁ : ℤ → ℤ → ℤ := fun d n =>
      u * (w₃ : ℤ) * n + (u * h + F * (f : ℤ)) * d
    let F₂ : ℤ → ℤ → ℤ := fun d n =>
      v * (w₃ : ℤ) * n + (v * h + G * (f : ℤ)) * d
    let F₃ : ℤ → ℤ → ℤ := fun d n =>
      u * (w₃ : ℤ) * n + (u * h + (F + ell) * (f : ℤ)) * d
    let F₄ : ℤ → ℤ → ℤ := fun d n =>
      v * (w₃ : ℤ) * n + (v * h + (G + ell) * (f : ℤ)) * d
    let W : ℤ → ℤ → ℂ := fun d n => wD d * wN n *
      affineReciprocalProductPhase m A B L 0 0 (n : ZMod m) (d : ZMod m)
    let total : ℂ :=
      ∑ d ∈ D.filter (fun d : ℤ =>
          Int.ModEq (q₀ : ℤ) d dstar ∧ Int.gcd d (m : ℤ) = 1),
        ∑ n ∈ N.filter (fun n : ℤ =>
          Int.ModEq (q₀ : ℤ) n nstar ∧
            Int.gcd (F₁ d n) (c₁ : ℤ) = 1 ∧ Int.gcd (F₂ d n) (c₁ : ℤ) = 1 ∧
            Int.gcd (F₃ d n) (c₂ : ℤ) = 1 ∧ Int.gcd (F₄ d n) (c₂ : ℤ) = 1), W d n
    let H : ℕ → ℕ → ℕ → ℕ → ℕ → ℂ := fun e₀ e₁ e₂ e₃ e₄ =>
      ∑ d ∈ D.filter (fun d : ℤ =>
          Int.ModEq (q₀ : ℤ) d dstar ∧ (e₀ : ℤ) ∣ d),
        ∑ n ∈ N.filter (fun n : ℤ =>
          Int.ModEq (q₀ : ℤ) n nstar ∧
            (e₁ : ℤ) ∣ F₁ d n ∧ (e₂ : ℤ) ∣ F₂ d n ∧
            (e₃ : ℤ) ∣ F₃ d n ∧ (e₄ : ℤ) ∣ F₄ d n), W d n
    total =
        (∑ e₀ ∈ m.divisors, ∑ e₁ ∈ c₁.divisors, ∑ e₂ ∈ c₁.divisors,
          ∑ e₃ ∈ c₂.divisors, ∑ e₄ ∈ c₂.divisors,
            ((ArithmeticFunction.moebius e₀ : ℤ) : ℂ) *
              ((ArithmeticFunction.moebius e₁ : ℤ) : ℂ) *
              ((ArithmeticFunction.moebius e₂ : ℤ) : ℂ) *
              ((ArithmeticFunction.moebius e₃ : ℤ) : ℂ) *
              ((ArithmeticFunction.moebius e₄ : ℤ) : ℂ) * H e₀ e₁ e₂ e₃ e₄) ∧
      ∃ e₀ ∈ m.divisors, ∃ e₁ ∈ c₁.divisors, ∃ e₂ ∈ c₁.divisors,
        ∃ e₃ ∈ c₂.divisors, ∃ e₄ ∈ c₂.divisors,
          let g₂ : ℕ := Nat.lcm q₀ e₀
          let g₃ : ℕ := Nat.lcm q₀ (Nat.lcm e₁ (Nat.lcm e₂ (Nat.lcm e₃ e₄)))
          let g₁ : ℕ := Nat.lcm g₂ g₃
          let q₃ : ℕ := g₁ / q₀
          0 < q₃ ∧ q₀ * q₃ = g₁ ∧ g₁ ∣ m ∧ q₃ ∣ m / q₀ ∧
            ∃ r : Fin (q₀ * q₃) × Fin (q₀ * q₃),
              Int.ModEq (q₀ : ℤ) (r.1.val : ℤ) dstar ∧
                Int.ModEq (q₀ : ℤ) (r.2.val : ℤ) nstar ∧
                ‖total‖ ≤
                  (m.divisors.card : ℝ) * (c₁.divisors.card : ℝ) ^ 2 *
                    (c₂.divisors.card : ℝ) ^ 2 * (q₃ : ℝ) *
                    ‖∑ d ∈ D.filter (fun d : ℤ =>
                        Int.ModEq ((q₀ * q₃ : ℕ) : ℤ) d (r.1.val : ℤ)),
                      ∑ n ∈ N.filter (fun n : ℤ =>
                        Int.ModEq ((q₀ * q₃ : ℕ) : ℤ) n (r.2.val : ℤ)), W d n‖ := by
  intro F₁ F₂ F₃ F₄ W total H
  have hm : 0 < m := NeZero.pos m
  have hc₁pos : 0 < c₁ := Nat.pos_of_dvd_of_pos hc₁ hm
  have hc₂pos : 0 < c₂ := Nat.pos_of_dvd_of_pos hc₂ hm
  have hrect (P : ℤ → Prop) (Q : ℤ → ℤ → Prop)
      [DecidablePred P] [∀ d, DecidablePred (Q d)] :
      (∑ p ∈ (D ×ˢ N).filter (fun p => P p.1 ∧ Q p.1 p.2), W p.1 p.2) =
        ∑ d ∈ D.filter P, ∑ n ∈ N.filter (Q d), W d n := by
    simp only [Finset.sum_filter, Finset.sum_product, ite_and, Finset.sum_ite_irrel,
      Finset.sum_const_zero]
  have hexp : total =
      ∑ e₀ ∈ m.divisors, ∑ e₁ ∈ c₁.divisors, ∑ e₂ ∈ c₁.divisors,
        ∑ e₃ ∈ c₂.divisors, ∑ e₄ ∈ c₂.divisors,
          ((ArithmeticFunction.moebius e₀ : ℤ) : ℂ) *
            ((ArithmeticFunction.moebius e₁ : ℤ) : ℂ) *
            ((ArithmeticFunction.moebius e₂ : ℤ) : ℂ) *
            ((ArithmeticFunction.moebius e₃ : ℤ) : ℂ) *
            ((ArithmeticFunction.moebius e₄ : ℤ) : ℂ) * H e₀ e₁ e₂ e₃ e₄ := by
    let T : Finset (ℤ × ℤ) := (D ×ˢ N).filter fun p =>
      Int.ModEq (q₀ : ℤ) p.1 dstar ∧ Int.ModEq (q₀ : ℤ) p.2 nstar ∧
        Int.gcd (F₃ p.1 p.2) (c₂ : ℤ) = 1 ∧ Int.gcd (F₄ p.1 p.2) (c₂ : ℤ) = 1
    have hfirst : total =
        ∑ e₀ ∈ m.divisors, ∑ e₁ ∈ c₁.divisors, ∑ e₂ ∈ c₁.divisors,
          ((ArithmeticFunction.moebius e₀ : ℤ) : ℂ) *
            ((ArithmeticFunction.moebius e₁ : ℤ) : ℂ) *
            ((ArithmeticFunction.moebius e₂ : ℤ) : ℂ) *
            ∑ p ∈ T.filter (fun p =>
              (e₀ : ℤ) ∣ p.1 ∧ (e₁ : ℤ) ∣ F₁ p.1 p.2 ∧
                (e₂ : ℤ) ∣ F₂ p.1 p.2), W p.1 p.2 := by
      calc
        total = ∑ p ∈ T.filter (fun p =>
            Int.gcd p.1 (m : ℤ) = 1 ∧ Int.gcd (F₁ p.1 p.2) (c₁ : ℤ) = 1 ∧
              Int.gcd (F₂ p.1 p.2) (c₁ : ℤ) = 1), W p.1 p.2 := by
          dsimp only [total]
          rw [← hrect (fun d => Int.ModEq (q₀ : ℤ) d dstar ∧ Int.gcd d (m : ℤ) = 1)
            (fun d n => Int.ModEq (q₀ : ℤ) n nstar ∧
              Int.gcd (F₁ d n) (c₁ : ℤ) = 1 ∧ Int.gcd (F₂ d n) (c₁ : ℤ) = 1 ∧
              Int.gcd (F₃ d n) (c₂ : ℤ) = 1 ∧ Int.gcd (F₄ d n) (c₂ : ℤ) = 1)]
          congr 1
          ext p
          simp only [T, Finset.mem_filter]
          tauto
        _ = _ := sourceTerminalMobius_finite_expansion m c₁ hm hc₁pos
          (u * (w₃ : ℤ)) (v * (w₃ : ℤ)) (u * h + F * (f : ℤ))
          (v * h + G * (f : ℤ)) T W
    rw [hfirst]
    apply Finset.sum_congr rfl
    intro e₀ _
    apply Finset.sum_congr rfl
    intro e₁ _
    apply Finset.sum_congr rfl
    intro e₂ _
    let U : Finset (ℤ × ℤ) := (D ×ˢ N).filter fun p =>
      Int.ModEq (q₀ : ℤ) p.1 dstar ∧ Int.ModEq (q₀ : ℤ) p.2 nstar ∧
        (e₀ : ℤ) ∣ p.1 ∧ (e₁ : ℤ) ∣ F₁ p.1 p.2 ∧ (e₂ : ℤ) ∣ F₂ p.1 p.2
    have hsecond :
        (∑ p ∈ T.filter (fun p =>
            (e₀ : ℤ) ∣ p.1 ∧ (e₁ : ℤ) ∣ F₁ p.1 p.2 ∧
              (e₂ : ℤ) ∣ F₂ p.1 p.2), W p.1 p.2) =
          ∑ e₃ ∈ c₂.divisors, ∑ e₄ ∈ c₂.divisors,
            ((ArithmeticFunction.moebius e₃ : ℤ) : ℂ) *
              ((ArithmeticFunction.moebius e₄ : ℤ) : ℂ) * H e₀ e₁ e₂ e₃ e₄ := by
      calc
        _ = ∑ p ∈ U.filter (fun p =>
            Int.gcd (F₃ p.1 p.2) (c₂ : ℤ) = 1 ∧
              Int.gcd (F₄ p.1 p.2) (c₂ : ℤ) = 1), W p.1 p.2 := by
          congr 1
          ext p
          simp only [T, U, Finset.mem_filter]
          tauto
        _ = ∑ e₃ ∈ c₂.divisors, ∑ e₄ ∈ c₂.divisors,
            ((ArithmeticFunction.moebius e₃ : ℤ) : ℂ) *
              ((ArithmeticFunction.moebius e₄ : ℤ) : ℂ) *
              ∑ p ∈ U.filter (fun p =>
                (e₃ : ℤ) ∣ F₃ p.1 p.2 ∧ (e₄ : ℤ) ∣ F₄ p.1 p.2), W p.1 p.2 := by
          have hD := sourceTerminalMobius_finite_expansion 1 c₂ Nat.zero_lt_one hc₂pos
            (u * (w₃ : ℤ)) (v * (w₃ : ℤ)) (u * h + (F + ell) * (f : ℤ))
            (v * h + (G + ell) * (f : ℤ)) U W
          simpa [F₃, F₄, ArithmeticFunction.moebius_apply_one] using hD
        _ = _ := by
          apply Finset.sum_congr rfl
          intro e₃ _
          apply Finset.sum_congr rfl
          intro e₄ _
          congr 1
          dsimp only [H]
          rw [← hrect (fun d => Int.ModEq (q₀ : ℤ) d dstar ∧ (e₀ : ℤ) ∣ d)
            (fun d n => Int.ModEq (q₀ : ℤ) n nstar ∧
              (e₁ : ℤ) ∣ F₁ d n ∧ (e₂ : ℤ) ∣ F₂ d n ∧
              (e₃ : ℤ) ∣ F₃ d n ∧ (e₄ : ℤ) ∣ F₄ d n)]
          congr 1
          ext p
          simp only [U, Finset.mem_filter]
          tauto
    rw [hsecond]
    simp only [Finset.mul_sum, mul_assoc]
  refine ⟨hexp, ?_⟩
  by_cases hzero : total = 0
  · refine ⟨1, Nat.one_mem_divisors.mpr hm.ne',
      1, Nat.one_mem_divisors.mpr hc₁pos.ne', 1, Nat.one_mem_divisors.mpr hc₁pos.ne',
      1, Nat.one_mem_divisors.mpr hc₂pos.ne', 1, Nat.one_mem_divisors.mpr hc₂pos.ne', ?_⟩
    intro g₂ g₃ g₁ q₃
    have hg : g₁ = q₀ := by
      simp only [g₁, g₂, g₃, Nat.lcm_one_right, Nat.lcm_self]
    have hq : q₃ = 1 := by
      dsimp only [q₃]
      rw [hg]
      exact Nat.div_self (NeZero.pos q₀)
    have hsize : q₀ * q₃ = q₀ := by rw [hq, Nat.mul_one]
    have hqpos : 0 < (q₀ : ℤ) := by exact_mod_cast NeZero.pos q₀
    obtain ⟨dr, hdr, hdc⟩ := Int.existsUnique_equiv_nat dstar hqpos
    obtain ⟨nr, hnr, hnc⟩ := Int.existsUnique_equiv_nat nstar hqpos
    let r : Fin (q₀ * q₃) × Fin (q₀ * q₃) :=
      (⟨dr, by rw [hsize]; exact_mod_cast hdr⟩,
        ⟨nr, by rw [hsize]; exact_mod_cast hnr⟩)
    refine ⟨?_, ?_, ?_, ?_, r, hdc, hnc, ?_⟩
    · rw [hq]
      exact Nat.zero_lt_one
    · rw [hsize, hg]
    · rw [hg]
      exact hq₀
    · rw [hq]
      exact one_dvd _
    · rw [hzero, norm_zero]
      exact mul_nonneg
        (mul_nonneg (mul_nonneg (mul_nonneg (Nat.cast_nonneg _) (sq_nonneg _))
          (sq_nonneg _)) (Nat.cast_nonneg _)) (norm_nonneg _)
  let E : Finset (ℕ × ℕ × ℕ × ℕ × ℕ) :=
    m.divisors ×ˢ (c₁.divisors ×ˢ (c₁.divisors ×ˢ (c₂.divisors ×ˢ c₂.divisors)))
  let K : (ℕ × ℕ × ℕ × ℕ × ℕ) → ℂ := fun e =>
    H e.1 e.2.1 e.2.2.1 e.2.2.2.1 e.2.2.2.2
  let M : (ℕ × ℕ × ℕ × ℕ × ℕ) → ℂ := fun e =>
    ((ArithmeticFunction.moebius e.1 : ℤ) : ℂ) *
      ((ArithmeticFunction.moebius e.2.1 : ℤ) : ℂ) *
      ((ArithmeticFunction.moebius e.2.2.1 : ℤ) : ℂ) *
      ((ArithmeticFunction.moebius e.2.2.2.1 : ℤ) : ℂ) *
      ((ArithmeticFunction.moebius e.2.2.2.2 : ℤ) : ℂ)
  have hE : E.Nonempty := by
    simpa only [E, Finset.nonempty_product, Nat.nonempty_divisors] using
      And.intro hm.ne' ⟨hc₁pos.ne', hc₁pos.ne', hc₂pos.ne', hc₂pos.ne'⟩
  have hEexp : total = ∑ e ∈ E, M e * K e := by
    simpa only [E, M, K, Finset.sum_product] using hexp
  have hEcard : (E.card : ℝ) =
      (m.divisors.card : ℝ) * (c₁.divisors.card : ℝ) ^ 2 *
        (c₂.divisors.card : ℝ) ^ 2 := by
    simp only [E, Finset.card_product, Nat.cast_mul, pow_two, mul_assoc]
  have hmu (e : ℕ) : ‖((ArithmeticFunction.moebius e : ℤ) : ℂ)‖ ≤ 1 := by
    rw [Complex.norm_intCast]
    exact_mod_cast (ArithmeticFunction.abs_moebius_le_one (n := e))
  obtain ⟨e, he, hmax⟩ := Finset.exists_max_image E (fun e => ‖K e‖) hE
  have hglobal : ‖total‖ ≤ (E.card : ℝ) * ‖K e‖ := by
    rw [hEexp]
    calc
      ‖∑ e' ∈ E, M e' * K e'‖ ≤ ∑ _e' ∈ E, ‖K e‖ := by
        apply norm_sum_le_of_le
        intro e' he'
        have hM : ‖M e'‖ ≤ 1 := by
          dsimp only [M]
          simp only [norm_mul]
          exact (mul_le_of_le_one_left (norm_nonneg _)
            ((mul_le_of_le_one_left (norm_nonneg _)
              ((mul_le_of_le_one_left (norm_nonneg _)
                ((mul_le_of_le_one_left (norm_nonneg _) (hmu e'.1)).trans
                  (hmu e'.2.1))).trans (hmu e'.2.2.1))).trans
                (hmu e'.2.2.2.1))).trans (hmu e'.2.2.2.2)
        rw [norm_mul]
        exact (mul_le_mul_of_nonneg_right hM (norm_nonneg _)).trans
          (by simpa only [one_mul] using hmax e' he')
      _ = _ := by simp
  have hKe : K e ≠ 0 := by
    intro hKe
    rw [hKe, norm_zero, mul_zero] at hglobal
    exact (not_le_of_gt (norm_pos_iff.mpr hzero)) hglobal
  rcases e with ⟨e₀, e₁, e₂, e₃, e₄⟩
  simp only [E, Finset.mem_product] at he
  rcases he with ⟨he₀, he₁, he₂, he₃, he₄⟩
  change H e₀ e₁ e₂ e₃ e₄ ≠ 0 at hKe
  change ‖total‖ ≤ (E.card : ℝ) * ‖H e₀ e₁ e₂ e₃ e₄‖ at hglobal
  let g₂ : ℕ := Nat.lcm q₀ e₀
  let g₃ : ℕ := Nat.lcm q₀ (Nat.lcm e₁ (Nat.lcm e₂ (Nat.lcm e₃ e₄)))
  let g₁ : ℕ := Nat.lcm g₂ g₃
  let q₃ : ℕ := g₁ / q₀
  let R : Finset (Fin g₁ × Fin g₁) := Finset.univ.filter fun r =>
    Int.ModEq (q₀ : ℤ) (r.1.val : ℤ) dstar ∧
      Int.ModEq (q₀ : ℤ) (r.2.val : ℤ) nstar ∧ (e₀ : ℤ) ∣ (r.1.val : ℤ) ∧
      (e₁ : ℤ) ∣ F₁ (r.1.val : ℤ) (r.2.val : ℤ) ∧
      (e₂ : ℤ) ∣ F₂ (r.1.val : ℤ) (r.2.val : ℤ) ∧
      (e₃ : ℤ) ∣ F₃ (r.1.val : ℤ) (r.2.val : ℤ) ∧
      (e₄ : ℤ) ∣ F₄ (r.1.val : ℤ) (r.2.val : ℤ)
  obtain ⟨_hg₁, hq₃pos, hqeq, hg₁m, hq₃m, hcard, _hcount, hcountle, _hrep, hpart⟩ :=
    sourceTerminalInsideModulus_residue_refinement m q₀ c₁ c₂ e₀ e₁ e₂ e₃ e₄ f w₃
      hq₀ hc₁ hc₂ (Nat.dvd_of_mem_divisors he₀) (Nat.dvd_of_mem_divisors he₁)
      (Nat.dvd_of_mem_divisors he₂) (Nat.dvd_of_mem_divisors he₃)
      (Nat.dvd_of_mem_divisors he₄) u v F G h ell dstar nstar hu hv hw₃
  change R.card ≤ (g₁ / g₂) * (g₁ / g₃) at hcard
  change (g₁ / g₂) * (g₁ / g₃) ≤ q₃ at hcountle
  change q₀ * q₃ = g₁ at hqeq
  let cell : (Fin g₁ × Fin g₁) → ℂ := fun r =>
    ∑ d ∈ D.filter (fun d : ℤ => Int.ModEq (g₁ : ℤ) d (r.1.val : ℤ)),
      ∑ n ∈ N.filter (fun n : ℤ => Int.ModEq (g₁ : ℤ) n (r.2.val : ℤ)), W d n
  have hpartition : H e₀ e₁ e₂ e₃ e₄ = ∑ r ∈ R, cell r := by
    calc
      H e₀ e₁ e₂ e₃ e₄ =
          ∑ p ∈ (D ×ˢ N).filter (fun p =>
            Int.ModEq (q₀ : ℤ) p.1 dstar ∧ Int.ModEq (q₀ : ℤ) p.2 nstar ∧
              (e₀ : ℤ) ∣ p.1 ∧ (e₁ : ℤ) ∣ F₁ p.1 p.2 ∧
              (e₂ : ℤ) ∣ F₂ p.1 p.2 ∧ (e₃ : ℤ) ∣ F₃ p.1 p.2 ∧
              (e₄ : ℤ) ∣ F₄ p.1 p.2), W p.1 p.2 := by
        dsimp only [H]
        rw [← hrect (fun d => Int.ModEq (q₀ : ℤ) d dstar ∧ (e₀ : ℤ) ∣ d)
          (fun d n => Int.ModEq (q₀ : ℤ) n nstar ∧
            (e₁ : ℤ) ∣ F₁ d n ∧ (e₂ : ℤ) ∣ F₂ d n ∧
            (e₃ : ℤ) ∣ F₃ d n ∧ (e₄ : ℤ) ∣ F₄ d n)]
        congr 1
        ext p
        simp only [Finset.mem_filter]
        tauto
      _ = ∑ r ∈ R, ∑ p ∈ (D ×ˢ N).filter (fun p =>
          Int.ModEq (g₁ : ℤ) p.1 (r.1.val : ℤ) ∧
            Int.ModEq (g₁ : ℤ) p.2 (r.2.val : ℤ)), W p.1 p.2 := hpart (D ×ˢ N) W
      _ = _ := by
        apply Finset.sum_congr rfl
        intro r _
        exact hrect (fun d => Int.ModEq (g₁ : ℤ) d (r.1.val : ℤ))
          (fun _ n => Int.ModEq (g₁ : ℤ) n (r.2.val : ℤ))
  have hR : R.Nonempty := Finset.nonempty_of_sum_ne_zero (hpartition ▸ hKe)
  obtain ⟨r, hr, hrmax⟩ := Finset.exists_max_image R (fun r => ‖cell r‖) hR
  have hcell : ‖H e₀ e₁ e₂ e₃ e₄‖ ≤ (q₃ : ℝ) * ‖cell r‖ := by
    rw [hpartition]
    calc
      ‖∑ r' ∈ R, cell r'‖ ≤ ∑ _r' ∈ R, ‖cell r‖ := norm_sum_le_of_le R hrmax
      _ = (R.card : ℝ) * ‖cell r‖ := by simp
      _ ≤ (q₃ : ℝ) * ‖cell r‖ := mul_le_mul_of_nonneg_right
        (by exact_mod_cast hcard.trans hcountle) (norm_nonneg _)
  have hfinal : ‖total‖ ≤ (m.divisors.card : ℝ) * (c₁.divisors.card : ℝ) ^ 2 *
      (c₂.divisors.card : ℝ) ^ 2 * (q₃ : ℝ) * ‖cell r‖ := by
    calc
      ‖total‖ ≤ (E.card : ℝ) * ‖H e₀ e₁ e₂ e₃ e₄‖ := hglobal
      _ ≤ (E.card : ℝ) * ((q₃ : ℝ) * ‖cell r‖) :=
        mul_le_mul_of_nonneg_left hcell (Nat.cast_nonneg _)
      _ = _ := by simp only [hEcard, mul_assoc]
  refine ⟨e₀, he₀, e₁, he₁, e₂, he₂, e₃, he₃, e₄, he₄, ?_⟩
  change 0 < q₃ ∧ q₀ * q₃ = g₁ ∧ g₁ ∣ m ∧ q₃ ∣ m / q₀ ∧ _
  refine ⟨hq₃pos, hqeq, hg₁m, hq₃m, ?_⟩
  have hrall := (Finset.mem_filter.mp hr).2
  dsimp only [g₂, g₃, g₁, q₃] at hqeq
  refine ⟨(Fin.cast hqeq.symm r.1, Fin.cast hqeq.symm r.2), hrall.1, hrall.2.1, ?_⟩
  simpa only [Fin.val_cast, hqeq, cell] using hfinal

theorem terminal_truncated_gcd_sum_le_divisor_card
    (m : ℕ) (hm : 0 < m) (a b : ℤ) (K T : ℝ)
    (hK : 0 ≤ K) (hT : max 1 K ≤ T) :
    (∑ j ∈ (Finset.Icc (Int.ceil (-K)) (Int.floor K)).filter
        (fun j => (Int.gcd (a * j + b) (m : ℤ) : ℝ) ≤ T),
      (Int.gcd (a * j + b) (m : ℤ) : ℝ)) ≤
      3 * (m.divisors.card : ℝ) * (Int.gcd a (m : ℤ) : ℝ) * T := by
  classical
  let S := (Finset.Icc (Int.ceil (-K)) (Int.floor K)).filter
    (fun j => (Int.gcd (a * j + b) (m : ℤ) : ℝ) ≤ T)
  let G := Int.gcd a (m : ℤ)
  have hmZ : (m : ℤ) ≠ 0 := by exact_mod_cast hm.ne'
  have hGpos : 0 < G := Int.gcd_pos_of_ne_zero_right a hmZ
  have hG1 : (1 : ℝ) ≤ G := by exact_mod_cast hGpos
  have hT1 : 1 ≤ T := (le_max_left 1 K).trans hT
  have hT0 : 0 ≤ T := zero_le_one.trans hT1
  have hKT : K ≤ T := (le_max_right 1 K).trans hT
  have hS (j : ℤ) (hj : j ∈ S) : -K ≤ (j : ℝ) ∧ (j : ℝ) ≤ K := by
    have hI := Finset.mem_Icc.mp (Finset.mem_filter.mp hj).1
    exact ⟨Int.ceil_le.mp hI.1, Int.le_floor.mp hI.2⟩
  have hmaps (j : ℤ) (_hj : j ∈ S) : Int.gcd (a * j + b) (m : ℤ) ∈ m.divisors :=
    Nat.mem_divisors.mpr
      ⟨Int.natCast_dvd_natCast.mp (Int.gcd_dvd_right (a * j + b) (m : ℤ)), hm.ne'⟩
  have hfiber (e : ℕ) (he : e ∈ m.divisors) :
      (∑ j ∈ S.filter (fun j => Int.gcd (a * j + b) (m : ℤ) = e), (e : ℝ)) ≤
        3 * (G : ℝ) * T := by
    let F := S.filter (fun j => Int.gcd (a * j + b) (m : ℤ) = e)
    change (∑ j ∈ F, (e : ℝ)) ≤ 3 * (G : ℝ) * T
    by_cases hF : F.Nonempty
    · let j₀ := F.min' hF
      have hj₀ : j₀ ∈ F := Finset.min'_mem F hF
      have hFS (j : ℤ) (hj : j ∈ F) : j ∈ S := (Finset.mem_filter.mp hj).1
      have hFe (j : ℤ) (hj : j ∈ F) : Int.gcd (a * j + b) (m : ℤ) = e :=
        (Finset.mem_filter.mp hj).2
      have heT : (e : ℝ) ≤ T := by
        simpa only [hFe j₀ hj₀] using (Finset.mem_filter.mp (hFS j₀ hj₀)).2
      have heZ : (0 : ℤ) < e := by exact_mod_cast Nat.pos_of_mem_divisors he
      let g := Int.gcd (e : ℤ) a
      let q : ℤ := (e : ℤ) / (g : ℤ)
      have hge : (g : ℤ) ∣ (e : ℤ) := Int.gcd_dvd_left (e : ℤ) a
      have hqpos : 0 < q :=
        Int.ediv_pos_of_pos_of_dvd heZ (Int.natCast_nonneg g) hge
      have hqR : (0 : ℝ) < q := by exact_mod_cast hqpos
      have heq : q * (g : ℤ) = (e : ℤ) := Int.ediv_mul_cancel hge
      have heqR : (q : ℝ) * (g : ℝ) = (e : ℝ) := by exact_mod_cast heq
      have hgG : g ∣ G := by
        change Int.gcd (e : ℤ) a ∣ Int.gcd a (m : ℤ)
        rw [Int.gcd_comm (e : ℤ) a]
        exact Int.gcd_dvd_gcd_of_dvd_right a
          (Int.natCast_dvd_natCast.mpr (Nat.mem_divisors.mp he).1)
      have hgGle : (g : ℝ) ≤ G := by
        exact_mod_cast Nat.le_of_dvd hGpos hgG
      have hdiv (j : ℤ) (hj : j ∈ F) : q ∣ j - j₀ := by
        have hd (k : ℤ) (hk : k ∈ F) : (e : ℤ) ∣ a * k + b := by
          rw [← hFe k hk]
          exact Int.gcd_dvd_left (a * k + b) (m : ℤ)
        have hmod : a * j₀ ≡ a * j [ZMOD (e : ℤ)] := by
          apply Int.modEq_iff_dvd.mpr
          simpa only [Int.add_sub_add_right] using dvd_sub (hd j hj) (hd j₀ hj₀)
        exact (Int.ModEq.cancel_left_div_gcd heZ hmod).dvd
      let U := Finset.Icc (0 : ℤ) (Int.floor (2 * K / (q : ℝ)))
      have hinto (j : ℤ) (hj : j ∈ F) : (j - j₀) / q ∈ U := by
        have hjmin : j₀ ≤ j := Finset.min'_le F j hj
        apply Finset.mem_Icc.mpr
        refine ⟨Int.ediv_nonneg (sub_nonneg.mpr hjmin) hqpos.le, ?_⟩
        apply Int.le_floor.mpr
        rw [Int.cast_div (hdiv j hj) hqR.ne', Int.cast_sub]
        apply div_le_div_of_nonneg_right _ hqR.le
        have hleft := (hS j₀ (hFS j₀ hj₀)).1
        have hright := (hS j (hFS j hj)).2
        linarith
      have hinj : Set.InjOn (fun j : ℤ => (j - j₀) / q) (F : Set ℤ) := by
        intro i hi j hj hij
        exact (Int.sub_left_inj j₀).mp
          ((Int.ediv_left_inj (hdiv i hi) (hdiv j hj)).mp hij)
      have hfloor0 : (0 : ℤ) ≤ Int.floor (2 * K / (q : ℝ)) :=
        Int.floor_nonneg.mpr (div_nonneg (mul_nonneg (by norm_num) hK) hqR.le)
      have hcardR : (U.card : ℝ) = (Int.floor (2 * K / (q : ℝ)) : ℝ) + 1 := by
        norm_cast
        simpa only [U, sub_zero] using
          (Int.card_Icc_of_le (a := 0) (b := Int.floor (2 * K / (q : ℝ))) (by omega))
      have hcard : (F.card : ℝ) ≤ 2 * K / (q : ℝ) + 1 := by
        calc
          (F.card : ℝ) ≤ (U.card : ℝ) := by
            exact_mod_cast Finset.card_le_card_of_injOn
              (fun j : ℤ => (j - j₀) / q) hinto hinj
          _ = (Int.floor (2 * K / (q : ℝ)) : ℝ) + 1 := hcardR
          _ ≤ 2 * K / (q : ℝ) + 1 := add_le_add (Int.floor_le _) le_rfl
      have hweighted : (F.card : ℝ) * (e : ℝ) ≤ 3 * (G : ℝ) * T := by
        calc
          (F.card : ℝ) * (e : ℝ) ≤ (2 * K / (q : ℝ) + 1) * (e : ℝ) :=
            mul_le_mul_of_nonneg_right hcard (Nat.cast_nonneg e)
          _ = 2 * K * (g : ℝ) + (e : ℝ) := by
            rw [← heqR, add_mul, one_mul, ← mul_assoc,
              div_mul_cancel₀ _ hqR.ne']
          _ ≤ 2 * T * (G : ℝ) + T := by gcongr
          _ ≤ 3 * (G : ℝ) * T := by
            nlinarith [le_mul_of_one_le_left hT0 hG1]
      simpa only [Finset.sum_const, nsmul_eq_mul] using hweighted
    · rw [Finset.not_nonempty_iff_eq_empty.mp hF, Finset.sum_empty]
      positivity
  change (∑ j ∈ S, (Int.gcd (a * j + b) (m : ℤ) : ℝ)) ≤
    3 * (m.divisors.card : ℝ) * (G : ℝ) * T
  calc
    (∑ j ∈ S, (Int.gcd (a * j + b) (m : ℤ) : ℝ)) =
        ∑ e ∈ m.divisors,
          ∑ j ∈ S.filter (fun j => Int.gcd (a * j + b) (m : ℤ) = e), (e : ℝ) :=
      (Finset.sum_fiberwise_of_maps_to' hmaps (fun e : ℕ => (e : ℝ))).symm
    _ ≤ ∑ _e ∈ m.divisors, 3 * (G : ℝ) * T := Finset.sum_le_sum hfiber
    _ = 3 * (m.divisors.card : ℝ) * (G : ℝ) * T := by
      simp only [Finset.sum_const, nsmul_eq_mul]
      ring

theorem terminal_truncated_gcd_sum_mul_reindex
    (m w : ℕ) (hw : 0 < w) (a b : ℤ) (K T : ℝ) :
    (∑ k ∈ (Finset.Icc (Int.ceil (-K)) (Int.floor K)).filter
        (fun k => (w : ℤ) ∣ k ∧
          (Int.gcd (a * k + b) (m : ℤ) : ℝ) ≤ T),
      (Int.gcd (a * k + b) (m : ℤ) : ℝ)) =
    ∑ j ∈ (Finset.Icc (Int.ceil (-(K / (w : ℝ))))
        (Int.floor (K / (w : ℝ)))).filter
        (fun j => (Int.gcd ((a * (w : ℤ)) * j + b) (m : ℤ) : ℝ) ≤ T),
      (Int.gcd ((a * (w : ℤ)) * j + b) (m : ℤ) : ℝ) := by
  classical
  have hwR : (0 : ℝ) < w := by exact_mod_cast hw
  have hwZ : (w : ℤ) ≠ 0 := by exact_mod_cast (ne_of_gt hw)
  have hinterval (j : ℤ) :
      (w : ℤ) * j ∈ Finset.Icc (Int.ceil (-K)) (Int.floor K) ↔
      j ∈ Finset.Icc (Int.ceil (-(K / (w : ℝ)))) (Int.floor (K / (w : ℝ))) := by
    simp only [Finset.mem_Icc, Int.ceil_le, Int.le_floor, Int.cast_mul,
      Int.cast_natCast, ← div_le_iff₀' hwR, ← le_div_iff₀' hwR, neg_div]
  symm
  refine Finset.sum_bij (fun j _ => (w : ℤ) * j) ?_ ?_ ?_ ?_
  · intro j hj
    rcases Finset.mem_filter.mp hj with ⟨hj, hgj⟩
    refine Finset.mem_filter.mpr ⟨(hinterval j).mpr hj, ⟨⟨j, rfl⟩, ?_⟩⟩
    simpa [mul_assoc] using hgj
  · intro i _ j _ hij
    exact mul_left_cancel₀ hwZ hij
  · intro k hk
    rcases Finset.mem_filter.mp hk with ⟨hk, hkw, hgk⟩
    obtain ⟨j, rfl⟩ := hkw
    refine ⟨j, Finset.mem_filter.mpr ⟨(hinterval j).mp hk, ?_⟩, rfl⟩
    simpa [mul_assoc] using hgk
  · intro j _
    simp [mul_assoc]

theorem terminal_truncated_gcd_weights_uniform
    (ε P M₀ : ℝ) (hε : 0 < ε) (hP : 0 ≤ P) (hM₀ : 1 ≤ M₀) :
    ∃ C : ℝ, 0 < C ∧
      ∀ x : ℝ, 1 ≤ x →
      ∀ (m w : ℕ) (s b : ℤ) (K T : ℝ),
        0 < m → 0 < w → Int.gcd s (m : ℤ) = 1 →
        (m : ℝ) ≤ M₀ * Real.rpow x P →
        0 ≤ K → K / (w : ℝ) ≤ T →
        (∑ k ∈ (Finset.Icc (Int.ceil (-K)) (Int.floor K)).filter
            (fun k => (w : ℤ) ∣ k ∧
              (Int.gcd (s * k + b) (m : ℤ) : ℝ) ≤ T),
          (Int.gcd (s * k + b) (m : ℤ) : ℝ) /
            (Real.rpow x ε * (Nat.gcd w m : ℝ) * T)) ≤ C := by
  classical
  let ρ : ℝ := ε / (P + 1)
  have hden : 0 < P + 1 := by linarith
  have hρ : 0 < ρ := div_pos hε hden
  have hρP : P * ρ ≤ ε := by
    have heq : ρ * (P + 1) = ε := by
      dsimp [ρ]
      exact div_mul_cancel₀ _ hden.ne'
    nlinarith
  have hM₀pos : 0 < M₀ := lt_of_lt_of_le zero_lt_one hM₀
  obtain ⟨Cρ, hCρ, hdivisors⟩ := exists_card_divisors_bound hρ
  have hC : 0 < 3 * Cρ * Real.rpow M₀ ρ :=
    mul_pos (mul_pos (by norm_num) hCρ) (Real.rpow_pos_of_pos hM₀pos _)
  refine ⟨3 * Cρ * Real.rpow M₀ ρ, hC, ?_⟩
  intro x hx m w s b K T hm hw hsm hm_bound hK hKT
  rw [← Finset.sum_div]
  by_cases hT : 1 ≤ T
  · have hxpos : 0 < x := lt_of_lt_of_le zero_lt_one hx
    have hTpos : 0 < T := lt_of_lt_of_le zero_lt_one hT
    have hgpos : (0 : ℝ) < Nat.gcd w m := by
      exact_mod_cast Nat.gcd_pos_of_pos_right w hm
    have hgcd : Int.gcd (s * (w : ℤ)) (m : ℤ) = Nat.gcd w m := by
      rw [Int.gcd_mul_right_left_of_gcd_eq_one hsm, Int.gcd_natCast_natCast]
    have hcard : (m.divisors.card : ℝ) ≤
        Cρ * Real.rpow M₀ ρ * Real.rpow x ε := by
      calc
        (m.divisors.card : ℝ) ≤ Cρ * Real.rpow (m : ℝ) ρ :=
          hdivisors m hm.ne'
        _ ≤ Cρ * Real.rpow (M₀ * Real.rpow x P) ρ :=
          mul_le_mul_of_nonneg_left
            (Real.rpow_le_rpow (Nat.cast_nonneg m) hm_bound hρ.le) hCρ.le
        _ = Cρ * Real.rpow M₀ ρ * Real.rpow x (P * ρ) := by
          simp only [Real.rpow_eq_pow]
          rw [Real.mul_rpow hM₀pos.le (Real.rpow_nonneg hxpos.le _),
            ← Real.rpow_mul hxpos.le]
          ring
        _ ≤ Cρ * Real.rpow M₀ ρ * Real.rpow x ε :=
          mul_le_mul_of_nonneg_left (Real.rpow_le_rpow_of_exponent_le hx hρP)
            (mul_nonneg hCρ.le (Real.rpow_nonneg hM₀pos.le _))
    apply (div_le_iff₀
      (mul_pos (mul_pos (Real.rpow_pos_of_pos hxpos _) hgpos) hTpos)).2
    rw [terminal_truncated_gcd_sum_mul_reindex m w hw s b K T]
    have hsum := terminal_truncated_gcd_sum_le_divisor_card m hm (s * (w : ℤ)) b
      (K / (w : ℝ)) T (div_nonneg hK (Nat.cast_nonneg w)) (max_le hT hKT)
    rw [hgcd] at hsum
    calc
      _ ≤ 3 * (m.divisors.card : ℝ) * (Nat.gcd w m : ℝ) * T := hsum
      _ ≤ 3 * (Cρ * Real.rpow M₀ ρ * Real.rpow x ε) * (Nat.gcd w m : ℝ) * T := by
        gcongr
      _ = _ := by
        simp only [Real.rpow_eq_pow]
        ring
  · have hmZ : (m : ℤ) ≠ 0 := by exact_mod_cast hm.ne'
    have hempty : (Finset.Icc (Int.ceil (-K)) (Int.floor K)).filter
        (fun k => (w : ℤ) ∣ k ∧
          (Int.gcd (s * k + b) (m : ℤ) : ℝ) ≤ T) = ∅ := by
      apply Finset.filter_eq_empty_iff.mpr
      intro k _ hk
      have hg : (1 : ℝ) ≤ Int.gcd (s * k + b) (m : ℤ) := by
        exact_mod_cast Int.gcd_pos_of_ne_zero_right (s * k + b) hmZ
      exact hT (hg.trans hk.2)
    rw [hempty, Finset.sum_empty, zero_div]
    exact hC.le

theorem sourceTerminal_gcd_weight_application
    (ω δ ε CK CΛ CX CR CQ CΔ Cm : ℝ)
    (hω : 0 < ω) (hδ : 0 < δ) (hε : 0 < ε)
    (hCK : 1 ≤ CK) (hCΛ : 1 ≤ CΛ) (hCX : 1 ≤ CX)
    (hCR : 1 ≤ CR) (hCQ : 1 ≤ CQ) (hCΔ : 1 ≤ CΔ) (hCm : 1 ≤ Cm) :
    ∃ C X₀ : ℝ, 0 < C ∧ 1 ≤ X₀ ∧
      ∀ x : ℝ, X₀ ≤ x →
      ∀ (m q₀ g w₁ w₂ z₁ : ℕ),
        Squarefree m → q₀ ∣ m → 0 < g → Squarefree w₁ → 0 < w₂ →
        0 < z₁ → w₁ ∣ z₁ → Nat.Coprime z₁ m →
      ∀ (M N R₀ Q H Δ₁ Λ γ : ℝ),
        0 < M → 0 < R₀ → 0 < Q → 1 ≤ H → 0 < Δ₁ → Λ ≠ 0 →
        N = Real.rpow x γ →
        (1 / 4 : ℝ) + 12 * ω + 4 * δ + 100 * ε ≤ γ →
        x / CX ≤ M * N → M * N ≤ CX * x →
        N ≤ CR * Real.rpow x (δ + 4 * ε) * R₀ →
        R₀ * Q ≤ CQ * Real.rpow x ((1 / 2 : ℝ) + 2 * ω + ε) →
        H = Real.rpow x ε * R₀ * Q ^ 2 / ((q₀ : ℝ) * M) →
        N ≤ CΔ * Real.rpow x (δ + 55 * ε) * H ^ 2 * Δ₁ →
        (m : ℝ) ≤ Cm * Real.rpow x δ * R₀ * Q ^ 2 * H /
          ((q₀ : ℝ) * (g : ℝ) * Δ₁) →
        |Λ| ≤ CΛ * Real.rpow x (δ + 5 * ε) * H ^ 2 /
          ((w₁ : ℝ) * (g : ℝ)) →
      ∀ (lam lamTilde B : ℤ),
      let M₀ : ℝ := Cm * CΔ * CX ^ 5 * CR ^ 4 * CQ ^ 8
      let s : ℤ := ((z₁ / w₁ : ℕ) : ℤ)
      let s₂ : ℕ := Nat.gcd w₂ m
      let J : ℤ → ℤ := fun k => s * k + (lam - lamTilde) * B
      let Klam : ℝ := (w₁ : ℝ) * |Λ| * N / (Real.rpow x (5 * ε) * Δ₁)
      let K : ℝ := CK * Klam
      let T : ℝ := max ((s₂ : ℝ)⁻¹) H⁻¹ *
        (Real.rpow x (δ + 100 * ε) * H ^ 2 * N / ((g : ℝ) * Δ₁))
      let S : Finset ℤ := (Finset.Icc (Int.ceil (-K)) (Int.floor K)).filter
        (fun k => (w₂ : ℤ) ∣ k ∧ (Int.gcd (J k) (m : ℤ) : ℝ) ≤ T)
      let ξ : ℤ → ℝ := fun k =>
        (Int.gcd (J k) (m : ℤ) : ℝ) / (Real.rpow x ε * (s₂ : ℝ) * T)
      let Δstar : ℝ := min (N / (|Λ| * Real.rpow x (5 * ε))) Δ₁
      let R : ℝ :=
        (Real.rpow x (4 * ε) * (s₂ : ℝ) * T / (q₀ : ℝ)) * (Δ₁ / Δstar) *
          (N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
          (Δstar / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ))
      1 ≤ M₀ ∧
        H ≤ (CX * CR * CQ ^ 2) * Real.rpow x (4 * ω + δ + 7 * ε) / (q₀ : ℝ) ∧
        (m : ℝ) ≤ M₀ * Real.rpow x (1 / 2 : ℝ) ∧
        Int.gcd s (m : ℤ) = 1 ∧
        Int.gcd (s * (w₂ : ℤ)) (m : ℤ) = s₂ ∧
        0 < Klam ∧ 0 < T ∧ 0 < Δstar ∧
        Real.rpow x (100 * ε) * (Klam / (w₂ : ℝ)) ≤ CΛ * T ∧
        K / (w₂ : ℝ) ≤ T ∧
        (T < 1 → S = ∅) ∧
        (S.Nonempty → max 1 (K / (w₂ : ℝ)) ≤ T) ∧
        (∀ k : ℤ, 0 ≤ ξ k) ∧
        (∀ k : ℤ,
          ξ k * R =
            (Real.rpow x (3 * ε) * (Int.gcd (J k) (m : ℤ) : ℝ) / (q₀ : ℝ)) *
              (Δ₁ / Δstar) *
              (N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
              (Δstar / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ))) ∧
        (∀ k : ℤ, Real.rpow x (3 * ε) ≤ ξ k * R) ∧
        (∑ k ∈ S, ξ k) ≤ C ∧
        (∑ k ∈ S,
          (Real.rpow x (3 * ε) * (Int.gcd (J k) (m : ℤ) : ℝ) / (q₀ : ℝ)) *
            (Δ₁ / Δstar) *
            (N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
            (Δstar / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ))) ≤ C * R := by
  classical
  let M₀ : ℝ := Cm * CΔ * CX ^ 5 * CR ^ 4 * CQ ^ 8
  have hM₀ : 1 ≤ M₀ :=
    one_le_mul_of_one_le_of_one_le
      (one_le_mul_of_one_le_of_one_le
        (one_le_mul_of_one_le_of_one_le
          (one_le_mul_of_one_le_of_one_le hCm hCΔ) (one_le_pow₀ hCX))
        (one_le_pow₀ hCR)) (one_le_pow₀ hCQ)
  obtain ⟨C, hC, hUniform⟩ :=
    terminal_truncated_gcd_weights_uniform ε (1 / 2) M₀ hε (by norm_num) hM₀
  let X₀ : ℝ := max 1 (Real.rpow (CK * CΛ) (100 * ε)⁻¹)
  refine ⟨C, X₀, hC, le_max_left _ _, ?_⟩
  intro x hxX m q₀ g w₁ w₂ z₁ hm hq₀ hg hw₁ hw₂ hz₁ hw₁z hzm
    M N R₀ Q H Δ₁ Λ γ hM hR₀ hQ hH hΔ₁ hΛ hN hγ
    hMNlo hMNhi hNR hRQ hHdef hΔscale hmupper hΛupper lam lamTilde B
  dsimp only
  let s : ℤ := ((z₁ / w₁ : ℕ) : ℤ)
  let s₂ : ℕ := Nat.gcd w₂ m
  let J : ℤ → ℤ := fun k => s * k + (lam - lamTilde) * B
  let Klam : ℝ := (w₁ : ℝ) * |Λ| * N / (Real.rpow x (5 * ε) * Δ₁)
  let K : ℝ := CK * Klam
  let T : ℝ := max ((s₂ : ℝ)⁻¹) H⁻¹ *
    (Real.rpow x (δ + 100 * ε) * H ^ 2 * N / ((g : ℝ) * Δ₁))
  let S : Finset ℤ := (Finset.Icc (Int.ceil (-K)) (Int.floor K)).filter
    (fun k => (w₂ : ℤ) ∣ k ∧ (Int.gcd (J k) (m : ℤ) : ℝ) ≤ T)
  let ξ : ℤ → ℝ := fun k =>
    (Int.gcd (J k) (m : ℤ) : ℝ) / (Real.rpow x ε * (s₂ : ℝ) * T)
  let Δstar : ℝ := min (N / (|Λ| * Real.rpow x (5 * ε))) Δ₁
  let R : ℝ :=
    (Real.rpow x (4 * ε) * (s₂ : ℝ) * T / (q₀ : ℝ)) * (Δ₁ / Δstar) *
      (N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
      (Δstar / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ))
  have hx : 1 ≤ x := (show 1 ≤ X₀ from le_max_left _ _).trans hxX
  have hxpos : 0 < x := lt_of_lt_of_le zero_lt_one hx
  have hpow (a : ℝ) : 0 < Real.rpow x a := Real.rpow_pos_of_pos hxpos a
  have hCXpos : 0 < CX := lt_of_lt_of_le zero_lt_one hCX
  have hCRpos : 0 < CR := lt_of_lt_of_le zero_lt_one hCR
  have hCQpos : 0 < CQ := lt_of_lt_of_le zero_lt_one hCQ
  have hCΔpos : 0 < CΔ := lt_of_lt_of_le zero_lt_one hCΔ
  have hCmpos : 0 < Cm := lt_of_lt_of_le zero_lt_one hCm
  have hmpos : 0 < m := Nat.pos_of_ne_zero hm.ne_zero
  have hqnat : 0 < q₀ := Nat.pos_of_dvd_of_pos hq₀ hmpos
  have hqpos : 0 < (q₀ : ℝ) := by exact_mod_cast hqnat
  have hqone : (1 : ℝ) ≤ (q₀ : ℝ) := by exact_mod_cast hqnat
  have hgpos : 0 < (g : ℝ) := by exact_mod_cast hg
  have hgone : (1 : ℝ) ≤ (g : ℝ) := by exact_mod_cast hg
  have hw₁pos : 0 < (w₁ : ℝ) := by
    exact_mod_cast Nat.pos_of_ne_zero hw₁.ne_zero
  have hw₂pos : 0 < (w₂ : ℝ) := by exact_mod_cast hw₂
  have hs₂pos : 0 < (s₂ : ℝ) := by
    exact_mod_cast Nat.gcd_pos_of_pos_right w₂ hmpos
  have hNpos : 0 < N := hN.symm ▸ hpow γ
  have hHpos : 0 < H := lt_of_lt_of_le zero_lt_one hH
  have hΛpos : 0 < |Λ| := abs_pos.mpr hΛ
  have hsm : Int.gcd s (m : ℤ) = 1 :=
    (Int.gcd_natCast_natCast (z₁ / w₁) m).trans
      (hzm.coprime_div_left hw₁z).gcd_eq_one
  have hswm : Int.gcd (s * (w₂ : ℤ)) (m : ℤ) = s₂ := by
    rw [Int.gcd_mul_right_left_of_gcd_eq_one hsm, Int.gcd_natCast_natCast]
  have hlarge : CK * CΛ ≤ Real.rpow x (100 * ε) := by
    apply (Real.rpow_inv_le_iff_of_pos (by positivity) hxpos.le (by positivity)).mp
    exact (show Real.rpow (CK * CΛ) (100 * ε)⁻¹ ≤ X₀ from le_max_right _ _).trans hxX
  let CH : ℝ := CX * CR * CQ ^ 2
  let E : ℝ := 4 * ω + δ + 7 * ε
  have hCHpos : 0 < CH := by dsimp [CH]; positivity
  have hpow_nat (a : ℝ) (n : ℕ) :
      (Real.rpow x a) ^ n = Real.rpow x (a * (n : ℝ)) :=
    (Real.rpow_mul_natCast hxpos.le a n).symm
  have hHproduct : H * ((q₀ : ℝ) * M) = Real.rpow x ε * R₀ * Q ^ 2 :=
    (eq_div_iff (mul_ne_zero hqpos.ne' hM.ne')).mp hHdef
  have hRQsq : (R₀ * Q) ^ 2 ≤
      (CQ * Real.rpow x ((1 / 2 : ℝ) + 2 * ω + ε)) ^ 2 := by
    gcongr
  have hHX : H * (q₀ : ℝ) * x ≤ CH * Real.rpow x E * x := by
    calc
      H * (q₀ : ℝ) * x ≤ H * (q₀ : ℝ) * (CX * (M * N)) :=
        mul_le_mul_of_nonneg_left ((div_le_iff₀' hCXpos).mp hMNlo) (by positivity)
      _ = CX * Real.rpow x ε * (R₀ * Q ^ 2) * N := by
        calc
          _ = CX * (H * ((q₀ : ℝ) * M)) * N := by ring
          _ = _ := by rw [hHproduct]; ring
      _ ≤ CX * Real.rpow x ε * (R₀ * Q ^ 2) *
          (CR * Real.rpow x (δ + 4 * ε) * R₀) :=
        mul_le_mul_of_nonneg_left hNR (by simp only [Real.rpow_eq_pow]; positivity)
      _ = CX * CR * Real.rpow x ε * Real.rpow x (δ + 4 * ε) *
          (R₀ * Q) ^ 2 := by ring
      _ ≤ CX * CR * Real.rpow x ε * Real.rpow x (δ + 4 * ε) *
          (CQ * Real.rpow x ((1 / 2 : ℝ) + 2 * ω + ε)) ^ 2 :=
        mul_le_mul_of_nonneg_left hRQsq (by simp only [Real.rpow_eq_pow]; positivity)
      _ = CH * (Real.rpow x ε * Real.rpow x (δ + 4 * ε) *
          Real.rpow x (((1 / 2 : ℝ) + 2 * ω + ε) * 2)) := by
        rw [mul_pow, hpow_nat]
        dsimp [CH]
        ring
      _ = CH * Real.rpow x (ε + (δ + 4 * ε) +
          ((1 / 2 : ℝ) + 2 * ω + ε) * 2) := by
        simp only [Real.rpow_eq_pow]
        rw [← Real.rpow_add hxpos ε (δ + 4 * ε),
          ← Real.rpow_add hxpos (ε + (δ + 4 * ε))
            (((1 / 2 : ℝ) + 2 * ω + ε) * 2)]
      _ = CH * Real.rpow x (E + 1) := by
        congr 2
        dsimp [E]
        ring
      _ = CH * Real.rpow x E * x := by
        simp only [Real.rpow_eq_pow]
        rw [Real.rpow_add hxpos E 1, Real.rpow_one]
        ring
  have hHbound : H ≤ (CX * CR * CQ ^ 2) *
      Real.rpow x (4 * ω + δ + 7 * ε) / (q₀ : ℝ) := by
    apply (le_div_iff₀ hqpos).mpr
    exact (mul_le_mul_iff_left₀ hxpos).mp hHX
  have hHsimple : H ≤ CH * Real.rpow x E :=
    hHbound.trans (div_le_self (by simp only [Real.rpow_eq_pow]; positivity) hqone)
  have hRQeq : R₀ * Q ^ 2 = H * (q₀ : ℝ) * M / Real.rpow x ε := by
    apply (eq_div_iff (hpow ε).ne').mpr
    nlinarith only [hHproduct]
  have hmfirst : (m : ℝ) ≤
      Cm * Real.rpow x (δ - ε) * M * H ^ 2 / ((g : ℝ) * Δ₁) := by
    calc
      (m : ℝ) ≤ Cm * Real.rpow x δ * R₀ * Q ^ 2 * H /
          ((q₀ : ℝ) * (g : ℝ) * Δ₁) := hmupper
      _ = Cm * Real.rpow x δ * (R₀ * Q ^ 2) * H /
          ((q₀ : ℝ) * (g : ℝ) * Δ₁) := by ring
      _ = Cm * (Real.rpow x δ / Real.rpow x ε) * M * H ^ 2 /
          ((g : ℝ) * Δ₁) := by
        rw [hRQeq]
        simp only [Real.rpow_eq_pow]
        field_simp (disch := positivity)
      _ = Cm * Real.rpow x (δ - ε) * M * H ^ 2 /
          ((g : ℝ) * Δ₁) := by
        simp only [Real.rpow_eq_pow]
        rw [Real.rpow_sub hxpos]
  have hΔinv : 1 / Δ₁ ≤ CΔ * Real.rpow x (δ + 55 * ε) * H ^ 2 / N := by
    apply (div_le_div_iff₀ hΔ₁ hNpos).mpr
    simpa only [one_mul] using hΔscale
  have hmsecond : (m : ℝ) ≤
      Cm * CΔ * Real.rpow x (2 * δ + 54 * ε) * M * H ^ 4 /
        ((g : ℝ) * N) := by
    calc
      (m : ℝ) ≤ Cm * Real.rpow x (δ - ε) * M * H ^ 2 /
          ((g : ℝ) * Δ₁) := hmfirst
      _ = (Cm * Real.rpow x (δ - ε) * M * H ^ 2 / (g : ℝ)) *
          (1 / Δ₁) := by
        simp only [div_eq_mul_inv, mul_inv_rev]
        ring
      _ ≤ (Cm * Real.rpow x (δ - ε) * M * H ^ 2 / (g : ℝ)) *
          (CΔ * Real.rpow x (δ + 55 * ε) * H ^ 2 / N) :=
        mul_le_mul_of_nonneg_left hΔinv (by simp only [Real.rpow_eq_pow]; positivity)
      _ = Cm * CΔ * Real.rpow x (2 * δ + 54 * ε) * M * H ^ 4 /
          ((g : ℝ) * N) := by
        rw [show 2 * δ + 54 * ε = (δ - ε) + (δ + 55 * ε) by ring]
        simp only [Real.rpow_eq_pow]
        rw [Real.rpow_add hxpos (δ - ε) (δ + 55 * ε)]
        field_simp (disch := positivity)
  have hMupper : M ≤ CX * x / N := (le_div_iff₀ hNpos).mpr hMNhi
  have hpowers : Real.rpow x (2 * δ + 54 * ε) * x * (Real.rpow x E) ^ 4 =
      Real.rpow x ((2 * δ + 54 * ε) + 1 + E * 4) := by
    calc
      _ = Real.rpow x (2 * δ + 54 * ε) * Real.rpow x 1 *
          Real.rpow x (E * 4) := by
        rw [hpow_nat]
        norm_num only [Nat.cast_ofNat, Real.rpow_eq_pow, Real.rpow_one]
      _ = _ := by
        simp only [Real.rpow_eq_pow]
        rw [← Real.rpow_add hxpos (2 * δ + 54 * ε) 1,
          ← Real.rpow_add hxpos ((2 * δ + 54 * ε) + 1) (E * 4)]
  have hNsq : N ^ 2 = Real.rpow x (γ * 2) := by
    rw [hN, hpow_nat]
    norm_num
  have hmcap : (m : ℝ) ≤ M₀ * Real.rpow x (1 / 2 : ℝ) := by
    calc
      (m : ℝ) ≤ Cm * CΔ * Real.rpow x (2 * δ + 54 * ε) * M * H ^ 4 /
          ((g : ℝ) * N) := hmsecond
      _ = (Cm * CΔ * Real.rpow x (2 * δ + 54 * ε) * M * H ^ 4 / N) /
          (g : ℝ) := by
        simp only [div_eq_mul_inv, mul_inv_rev]
        ring
      _ ≤ Cm * CΔ * Real.rpow x (2 * δ + 54 * ε) * M * H ^ 4 / N :=
        div_le_self (by simp only [Real.rpow_eq_pow]; positivity) hgone
      _ ≤ Cm * CΔ * Real.rpow x (2 * δ + 54 * ε) * M *
          (CH * Real.rpow x E) ^ 4 / N := by
        simp only [Real.rpow_eq_pow]
        gcongr
        simpa only [Real.rpow_eq_pow] using hHsimple
      _ ≤ Cm * CΔ * Real.rpow x (2 * δ + 54 * ε) * (CX * x / N) *
          (CH * Real.rpow x E) ^ 4 / N := by
        simp only [Real.rpow_eq_pow]
        gcongr
      _ = M₀ * (Real.rpow x (2 * δ + 54 * ε) * x *
          (Real.rpow x E) ^ 4 / N ^ 2) := by
        dsimp [M₀, CH]
        field_simp (disch := positivity)
      _ = M₀ * (Real.rpow x ((2 * δ + 54 * ε) + 1 + E * 4) /
          Real.rpow x (γ * 2)) := by rw [hpowers, hNsq]
      _ = M₀ * Real.rpow x (((2 * δ + 54 * ε) + 1 + E * 4) - γ * 2) := by
        simp only [Real.rpow_eq_pow]
        rw [Real.rpow_sub hxpos]
      _ ≤ M₀ * Real.rpow x (1 / 2 : ℝ) := by
        apply mul_le_mul_of_nonneg_left
          (Real.rpow_le_rpow_of_exponent_le hx ?_) (zero_le_one.trans hM₀)
        dsimp [E]
        linarith only [hγ, hω, hδ, hε]
  have hKlampos : 0 < Klam :=
    div_pos (mul_pos (mul_pos hw₁pos hΛpos) hNpos)
      (mul_pos (hpow (5 * ε)) hΔ₁)
  have hΔstarpos : 0 < Δstar :=
    lt_min (div_pos hNpos (mul_pos hΛpos (hpow (5 * ε)))) hΔ₁
  let U : ℝ := Real.rpow x (δ + 100 * ε) * H ^ 2 * N / ((g : ℝ) * Δ₁)
  have hUpos : 0 < U :=
    div_pos (mul_pos (mul_pos (hpow (δ + 100 * ε)) (pow_pos hHpos 2)) hNpos)
      (mul_pos hgpos hΔ₁)
  have hTpos : 0 < T := by
    change 0 < max ((s₂ : ℝ)⁻¹) H⁻¹ * U
    exact mul_pos ((inv_pos.mpr hs₂pos).trans_le (le_max_left _ _)) hUpos
  have hKlam_bound : Klam ≤ CΛ * Real.rpow x δ * H ^ 2 * N / ((g : ℝ) * Δ₁) := by
    calc
      Klam ≤ (w₁ : ℝ) *
          (CΛ * Real.rpow x (δ + 5 * ε) * H ^ 2 / ((w₁ : ℝ) * (g : ℝ))) * N /
          (Real.rpow x (5 * ε) * Δ₁) :=
        div_le_div_of_nonneg_right
          (mul_le_mul_of_nonneg_right
            (mul_le_mul_of_nonneg_left hΛupper hw₁pos.le) hNpos.le)
          (mul_pos (hpow (5 * ε)) hΔ₁).le
      _ = CΛ * Real.rpow x δ * H ^ 2 * N / ((g : ℝ) * Δ₁) := by
        simp only [Real.rpow_eq_pow]
        rw [Real.rpow_add hxpos δ (5 * ε)]
        field_simp (disch := positivity)
  have hs₂le : (s₂ : ℝ) ≤ w₂ := by
    change (Nat.gcd w₂ m : ℝ) ≤ w₂
    exact_mod_cast Nat.gcd_le_left m hw₂
  have hinv : (w₂ : ℝ)⁻¹ ≤ (s₂ : ℝ)⁻¹ :=
    (inv_le_inv₀ hw₂pos hs₂pos).mpr hs₂le
  have hcutoff : Real.rpow x (100 * ε) * (Klam / (w₂ : ℝ)) ≤ CΛ * T := by
    calc
      Real.rpow x (100 * ε) * (Klam / (w₂ : ℝ)) ≤
          Real.rpow x (100 * ε) *
            ((CΛ * Real.rpow x δ * H ^ 2 * N / ((g : ℝ) * Δ₁)) / (w₂ : ℝ)) :=
        mul_le_mul_of_nonneg_left
          (div_le_div_of_nonneg_right hKlam_bound hw₂pos.le) (hpow (100 * ε)).le
      _ = CΛ * ((w₂ : ℝ)⁻¹ * U) := by
        dsimp only [U]
        simp only [Real.rpow_eq_pow]
        rw [Real.rpow_add hxpos δ (100 * ε)]
        field_simp (disch := positivity)
      _ ≤ CΛ * ((s₂ : ℝ)⁻¹ * U) :=
        mul_le_mul_of_nonneg_left (mul_le_mul_of_nonneg_right hinv hUpos.le)
          (zero_le_one.trans hCΛ)
      _ ≤ CΛ * T := by
        change CΛ * ((s₂ : ℝ)⁻¹ * U) ≤ CΛ * (max ((s₂ : ℝ)⁻¹) H⁻¹ * U)
        exact mul_le_mul_of_nonneg_left
          (mul_le_mul_of_nonneg_right (le_max_left _ _) hUpos.le)
          (zero_le_one.trans hCΛ)
  have hKpos : 0 < K := mul_pos (zero_lt_one.trans_le hCK) hKlampos
  have hKT : K / (w₂ : ℝ) ≤ T := by
    have hscaled : CΛ * (K / (w₂ : ℝ)) ≤ CΛ * T := by
      calc
        CΛ * (K / (w₂ : ℝ)) = (CK * CΛ) * (Klam / (w₂ : ℝ)) := by
          dsimp only [K]
          ring
        _ ≤ Real.rpow x (100 * ε) * (Klam / (w₂ : ℝ)) :=
          mul_le_mul_of_nonneg_right hlarge (div_nonneg hKlampos.le hw₂pos.le)
        _ ≤ CΛ * T := hcutoff
    exact (mul_le_mul_iff_right₀ (zero_lt_one.trans_le hCΛ)).mp hscaled
  have hmZ : (m : ℤ) ≠ 0 := by exact_mod_cast hmpos.ne'
  have hgcdone (k : ℤ) : (1 : ℝ) ≤ Int.gcd (J k) (m : ℤ) := by
    exact_mod_cast Int.gcd_pos_of_ne_zero_right (J k) hmZ
  have hempty (hsmall : T < 1) : S = ∅ := by
    dsimp only [S]
    apply Finset.filter_eq_empty_iff.mpr
    intro k _ hk
    exact (not_le_of_gt hsmall) ((hgcdone k).trans hk.2)
  have hnonempty (hS : S.Nonempty) : max 1 (K / (w₂ : ℝ)) ≤ T := by
    obtain ⟨k, hk⟩ := hS
    exact max_le ((hgcdone k).trans (Finset.mem_filter.mp hk).2.2) hKT
  have hξnonneg (k : ℤ) : 0 ≤ ξ k :=
    div_nonneg (Nat.cast_nonneg _)
      (mul_nonneg (mul_nonneg (hpow ε).le hs₂pos.le) hTpos.le)
  have hsqrtpos : 0 < Real.sqrt (m : ℝ) :=
    Real.sqrt_pos.mpr (by exact_mod_cast hmpos)
  have hξproduct (k : ℤ) :
      ξ k * R =
        (Real.rpow x (3 * ε) * (Int.gcd (J k) (m : ℤ) : ℝ) / (q₀ : ℝ)) *
          (Δ₁ / Δstar) *
          (N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
          (Δstar / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) := by
    dsimp only [ξ, R]
    simp only [Real.rpow_eq_pow]
    rw [show 4 * ε = ε + 3 * ε by ring, Real.rpow_add hxpos ε (3 * ε)]
    field_simp (disch := positivity)
  let F₁ : ℝ := N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)
  let F₂ : ℝ := Δstar / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)
  have hF₁ : 0 ≤ F₁ := add_nonneg (div_nonneg hNpos.le hsqrtpos.le) hsqrtpos.le
  have hF₂ : 0 ≤ F₂ := add_nonneg (div_nonneg hΔstarpos.le hsqrtpos.le) hsqrtpos.le
  have hgeom : (m : ℝ) ≤ F₁ * F₂ := by
    calc
      (m : ℝ) = Real.sqrt (m : ℝ) * Real.sqrt (m : ℝ) :=
        (Real.mul_self_sqrt (Nat.cast_nonneg m)).symm
      _ ≤ F₁ * F₂ :=
        mul_le_mul (le_add_of_nonneg_left (div_nonneg hNpos.le hsqrtpos.le))
          (le_add_of_nonneg_left (div_nonneg hΔstarpos.le hsqrtpos.le)) hsqrtpos.le hF₁
  have hΔratio : 1 ≤ Δ₁ / Δstar :=
    (one_le_div hΔstarpos).mpr (min_le_right _ _)
  have hqle : (q₀ : ℝ) ≤ m := by exact_mod_cast Nat.le_of_dvd hmpos hq₀
  have hRnonneg : 0 ≤ R :=
    mul_nonneg
      (mul_nonneg
        (mul_nonneg
          (div_nonneg (mul_nonneg (mul_nonneg (hpow (4 * ε)).le hs₂pos.le) hTpos.le)
            hqpos.le)
          (div_nonneg hΔ₁.le hΔstarpos.le)) hF₁) hF₂
  have hfloor (k : ℤ) : Real.rpow x (3 * ε) ≤ ξ k * R := by
    have hqgeom : (q₀ : ℝ) ≤ (Int.gcd (J k) (m : ℤ) : ℝ) * (F₁ * F₂) :=
      (hqle.trans hgeom).trans
        (le_mul_of_one_le_left (mul_nonneg hF₁ hF₂) (hgcdone k))
    have hbase : 1 ≤ ((Int.gcd (J k) (m : ℤ) : ℝ) / (q₀ : ℝ)) * (F₁ * F₂) := by
      calc
        1 ≤ ((Int.gcd (J k) (m : ℤ) : ℝ) * (F₁ * F₂)) / (q₀ : ℝ) :=
          (one_le_div hqpos).mpr hqgeom
        _ = ((Int.gcd (J k) (m : ℤ) : ℝ) / (q₀ : ℝ)) * (F₁ * F₂) := by ring
    have hunit :
        1 ≤ ((Int.gcd (J k) (m : ℤ) : ℝ) / (q₀ : ℝ)) * (Δ₁ / Δstar) * F₁ * F₂ := by
      calc
        1 ≤ ((Int.gcd (J k) (m : ℤ) : ℝ) / (q₀ : ℝ)) * (F₁ * F₂) := hbase
        _ ≤ (((Int.gcd (J k) (m : ℤ) : ℝ) / (q₀ : ℝ)) * (Δ₁ / Δstar)) *
            (F₁ * F₂) :=
          mul_le_mul_of_nonneg_right
            (le_mul_of_one_le_right (div_nonneg (Nat.cast_nonneg _) hqpos.le) hΔratio)
            (mul_nonneg hF₁ hF₂)
        _ = _ := by ring
    rw [hξproduct]
    change Real.rpow x (3 * ε) ≤
      (Real.rpow x (3 * ε) * (Int.gcd (J k) (m : ℤ) : ℝ) / (q₀ : ℝ)) *
        (Δ₁ / Δstar) * F₁ * F₂
    calc
      Real.rpow x (3 * ε) ≤ Real.rpow x (3 * ε) *
          (((Int.gcd (J k) (m : ℤ) : ℝ) / (q₀ : ℝ)) * (Δ₁ / Δstar) * F₁ * F₂) :=
        le_mul_of_one_le_right (hpow (3 * ε)).le hunit
      _ = _ := by ring
  have hsum : (∑ k ∈ S, ξ k) ≤ C := by
    simpa only [S, ξ, J, s₂] using
      hUniform x hx m w₂ s ((lam - lamTilde) * B) K T hmpos hw₂ hsm hmcap hKpos.le hKT
  refine ⟨hM₀, hHbound, hmcap, hsm, hswm, hKlampos, hTpos, hΔstarpos,
    hcutoff, hKT, hempty, hnonempty, hξnonneg, hξproduct, hfloor, hsum, ?_⟩
  simpa only [Finset.sum_mul, hξproduct] using
    mul_le_mul_of_nonneg_right hsum hRnonneg

/-- The product of two real scales at least one, packaged with the same lower bound. -/
def inflatedScale (Y Z : Set.Ici (1 : ℝ)) : Set.Ici (1 : ℝ) :=
  ⟨(Y : ℝ) * (Z : ℝ), by
    change (1 : ℝ) ≤ (Y : ℝ) * (Z : ℝ)
    exact one_le_mul_of_one_le_of_one_le Y.property Z.property⟩

/--
Positive moduli at most `cutoff` that divide the product of `P` and admit a depth-three
dense-divisibility witness at scale `Y`.
-/
noncomputable def tripleSourceModuli
    (Y : Set.Ici (1 : ℝ)) (cutoff : ℕ) (P : Finset ℕ) : Finset ℕ := by
  classical
  exact (Finset.Icc 1 cutoff).filter (fun n =>
    n ∣ (∏ p ∈ P, p) ∧ Nonempty (DenseDivisibilityWitness Y 3 n))

/-- The depth-three source moduli lying in the closed dyadic interval `[D, 2 * D]`. -/
noncomputable def dyadicTripleSourceModuli
    (Y : Set.Ici (1 : ℝ)) (cutoff D : ℕ) (P : Finset ℕ) : Finset ℕ :=
  (tripleSourceModuli Y cutoff P).filter (fun n => D ≤ n ∧ n ≤ 2 * D)

/--
Positive factor pairs bounded by `U` and `V` whose product is a dyadic depth-three source
modulus with small-prime part at most `Z`. The first factor divides the product of elements of
`P` greater than `B`, the second lies in `[T / Y, T * Z]`, and both admit depth-one
dense-divisibility witnesses at scale `Y * Z`.
-/
noncomputable def roughTripleFactorPairs
    (Y Z : Set.Ici (1 : ℝ)) (B cutoff D U V : ℕ)
    (T : ℝ) (P : Finset ℕ) : Finset (ℕ × ℕ) := by
  classical
  exact ((Finset.Ioc 0 U) ×ˢ (Finset.Ioc 0 V)).filter (fun p =>
    p.1 * p.2 ∈ dyadicTripleSourceModuli Y cutoff D P ∧
    (smallPrimePart B (p.1 * p.2) : ℝ) ≤ (Z : ℝ) ∧
    p.1 ∣ (∏ v ∈ P.filter (fun v => B < v), v) ∧
    T / (Y : ℝ) ≤ (p.2 : ℝ) ∧
    (p.2 : ℝ) ≤ T * (Z : ℝ) ∧
    Nonempty (DenseDivisibilityWitness (inflatedScale Y Z) 1 p.1) ∧
    Nonempty (DenseDivisibilityWitness (inflatedScale Y Z) 1 p.2))

theorem primeProduct_squarefree {P : Finset ℕ}
    (hP : ∀ p ∈ P, Nat.Prime p) : Squarefree (∏ p ∈ P, p) := by
  refine Finset.squarefree_prod_of_pairwise_isCoprime (fun p hp q hq hpq => ?_)
    (fun p hp => (hP p hp).squarefree)
  exact Nat.coprime_iff_isRelPrime.mp ((Nat.coprime_primes (hP p hp) (hP q hq)).2 hpq)

theorem exists_roughTripleFactorPair
    (Y Z : Set.Ici (1 : ℝ)) (B cutoff D U V : ℕ)
    (T : ℝ) (P : Finset ℕ) (hP : ∀ p ∈ P, Nat.Prime p)
    (hT : 1 ≤ T) (hTD : T ≤ (D : ℝ))
    (hU : 2 * (D : ℝ) * (Y : ℝ) / T ≤ (U : ℝ))
    (hV : T * (Z : ℝ) ≤ (V : ℝ))
    {n : ℕ} (hn : n ∈ dyadicTripleSourceModuli Y cutoff D P)
    (hnsmall : (smallPrimePart B n : ℝ) ≤ (Z : ℝ)) :
    ∃ p ∈ roughTripleFactorPairs Y Z B cutoff D U V T P,
      p.1 * p.2 = n := by
  classical
  obtain ⟨hsource, hDn, hnD⟩ := Finset.mem_filter.mp hn
  obtain ⟨_, hnP, hdd⟩ := Finset.mem_filter.mp hsource
  have hYpos : 0 < (Y : ℝ) := zero_lt_one.trans_le Y.property
  have hTpos : 0 < T := zero_lt_one.trans_le hT
  have hnsf : Squarefree n := (primeProduct_squarefree hP).squarefree_of_dvd hnP
  have hTlarge : T ≤ (Y : ℝ) * (n : ℝ) := by
    calc
      T ≤ (D : ℝ) := hTD
      _ ≤ (n : ℝ) := by exact_mod_cast hDn
      _ ≤ (Y : ℝ) * (n : ℝ) := by
        simpa using mul_le_mul_of_nonneg_right Y.property (Nat.cast_nonneg n : (0 : ℝ) ≤ n)
  obtain ⟨q₀, r₀, hnqr, hq₀, hr₀, hrlo, hrhi⟩ :=
    (denseDivisibility_succ_iff.mp hdd).2 1 1 rfl T hT hTlarge
  have hq₀pos : 0 < q₀ := denseDivisibility_pos hq₀
  have hr₀pos : 0 < r₀ := denseDivisibility_pos hr₀
  have hq₀dvd : q₀ ∣ n := ⟨r₀, hnqr⟩
  have hq₀sf : Squarefree q₀ := hnsf.squarefree_of_dvd hq₀dvd
  let s := smallPrimePart B n
  let g := q₀.gcd s
  let q := q₀ / g
  let r := r₀ * g
  have hspos : 0 < s :=
    Finset.prod_pos fun p hp =>
      Nat.pos_of_mem_primeFactors (Finset.mem_filter.mp hp).1
  have hgpos : 0 < g := Nat.gcd_pos_of_pos_left s hq₀pos
  have hqpos : 0 < q := Nat.div_gcd_pos_of_pos_left s hq₀pos
  have hrpos : 0 < r := Nat.mul_pos hr₀pos hgpos
  have hqg : q * g = q₀ := Nat.div_mul_cancel (Nat.gcd_dvd_left q₀ s)
  have hprod : n = q * r := by
    calc
      n = q₀ * r₀ := hnqr
      _ = (q * g) * r₀ := by rw [hqg]
      _ = q * r := by dsimp only [r]; ac_rfl
  have hqdvd : q ∣ n := ⟨r, hprod⟩
  have hqsf : Squarefree q := hnsf.squarefree_of_dvd hqdvd
  have hsFactors : s.primeFactors = n.primeFactors.filter (fun p => p ≤ B) :=
    Nat.primeFactors_prod fun p hp =>
      Nat.prime_of_mem_primeFactors (Finset.mem_filter.mp hp).1
  have hqFactors : q.primeFactors = q₀.primeFactors \ s.primeFactors :=
    Nat.primeFactors_div_gcd hq₀sf hspos.ne'
  have hnFactors : n.primeFactors ⊆ P := by
    have h := Nat.primeFactors_mono hnP (primeProduct_squarefree hP).ne_zero
    simpa only [Nat.primeFactors_prod hP] using h
  have hroughFactors : q.primeFactors ⊆ P.filter (fun p => B < p) := by
    intro p hp
    rw [hqFactors] at hp
    obtain ⟨hpq₀, hpnotS⟩ := Finset.mem_sdiff.mp hp
    have hpn : p ∈ n.primeFactors :=
      Nat.primeFactors_mono hq₀dvd hnsf.ne_zero hpq₀
    have hBp : B < p := by
      by_contra hnot
      apply hpnotS
      rw [hsFactors]
      exact Finset.mem_filter.mpr ⟨hpn, Nat.le_of_not_gt hnot⟩
    exact Finset.mem_filter.mpr ⟨hnFactors hpn, hBp⟩
  have hqrough : q ∣ (∏ p ∈ P.filter (fun p => B < p), p) := by
    have h := Finset.prod_dvd_prod_of_subset _ _ (fun p : ℕ => p) hroughFactors
    simpa only [Nat.prod_primeFactors_of_squarefree hqsf] using h
  have hgOne : (1 : ℝ) ≤ (g : ℝ) := by exact_mod_cast hgpos
  have hgSmall : (g : ℝ) ≤ (Z : ℝ) := by
    exact (show (g : ℝ) ≤ (s : ℝ) by exact_mod_cast Nat.gcd_le_right q₀ hspos).trans
      hnsmall
  have hscale : (g : ℝ) * (Y : ℝ) ≤ (inflatedScale Y Z : ℝ) := by
    change (g : ℝ) * (Y : ℝ) ≤ (Y : ℝ) * (Z : ℝ)
    simpa only [mul_comm] using mul_le_mul_of_nonneg_right hgSmall hYpos.le
  have hqdense : Nonempty (DenseDivisibilityWitness (inflatedScale Y Z) 1 q) :=
    single_dense_div hq₀ hgpos (Nat.gcd_dvd_left q₀ s) hscale
  have hrdense : Nonempty (DenseDivisibilityWitness (inflatedScale Y Z) 1 r) :=
    single_dense_mul hr₀ hgpos hscale
  have hrLower : T / (Y : ℝ) ≤ (r : ℝ) := by
    calc
      T / (Y : ℝ) ≤ (r₀ : ℝ) := hrlo
      _ ≤ (r₀ : ℝ) * (g : ℝ) := by
        simpa using mul_le_mul_of_nonneg_left hgOne (Nat.cast_nonneg r₀ : (0 : ℝ) ≤ r₀)
      _ = (r : ℝ) := by simp only [r, Nat.cast_mul]
  have hrUpper : (r : ℝ) ≤ T * (Z : ℝ) := by
    calc
      (r : ℝ) = (r₀ : ℝ) * (g : ℝ) := by simp only [r, Nat.cast_mul]
      _ ≤ T * (g : ℝ) := mul_le_mul_of_nonneg_right hrhi (Nat.cast_nonneg g)
      _ ≤ T * (Z : ℝ) := mul_le_mul_of_nonneg_left hgSmall hTpos.le
  have hqT : (q : ℝ) * T ≤ 2 * (D : ℝ) * (Y : ℝ) := by
    calc
      (q : ℝ) * T ≤ (q : ℝ) * ((r : ℝ) * (Y : ℝ)) :=
        mul_le_mul_of_nonneg_left ((div_le_iff₀ hYpos).mp hrLower) (Nat.cast_nonneg q)
      _ = (n : ℝ) * (Y : ℝ) := by simp only [hprod, Nat.cast_mul, mul_assoc]
      _ ≤ (2 * (D : ℝ)) * (Y : ℝ) :=
        mul_le_mul_of_nonneg_right (by exact_mod_cast hnD) hYpos.le
  have hqU : q ≤ U := by exact_mod_cast ((le_div_iff₀ hTpos).mpr hqT).trans hU
  have hrV : r ≤ V := by exact_mod_cast hrUpper.trans hV
  refine ⟨(q, r), ?_, hprod.symm⟩
  apply Finset.mem_filter.mpr
  refine ⟨Finset.mem_product.mpr
    ⟨Finset.mem_Ioc.mpr ⟨hqpos, hqU⟩, Finset.mem_Ioc.mpr ⟨hrpos, hrV⟩⟩, ?_⟩
  exact ⟨by simpa only [← hprod] using hn,
    by simpa only [← hprod] using hnsmall, hqrough, hrLower, hrUpper, hqdense, hrdense⟩

theorem dyadicTripleSourceError_le_exceptional_mean_global_average
    (Y Z : Set.Ici (1 : ℝ)) (B cutoff D U V : ℕ)
    (T : ℝ) (P : Finset ℕ) (hP : ∀ p ∈ P, Nat.Prime p)
    (hT : 1 ≤ T) (hTD : T ≤ (D : ℝ))
    (hU : 2 * (D : ℝ) * (Y : ℝ) / T ≤ (U : ℝ))
    (hV : T * (Z : ℝ) ≤ (V : ℝ))
    (a : ℕ) (f : ℕ →₀ ℂ) :
    (∑ n ∈ dyadicTripleSourceModuli Y cutoff D P,
      ‖fullDiscrepancy f n a‖) ≤
      (∑ n ∈ dyadicTripleSourceModuli Y cutoff D P
          with (Z : ℝ) < (smallPrimePart B n : ℝ),
        ‖fullDiscrepancy f n a‖) +
      (∑ p ∈ roughTripleFactorPairs Y Z B cutoff D U V T P,
        ‖meanTerm f p.1 p.2 a‖) +
      (∑ b ∈ primitiveResidues (∏ v ∈ P, v),
        ∑ p ∈ roughTripleFactorPairs Y Z B cutoff D U V T P,
          ‖deltaZero f p.1 p.2 a a b‖) /
        ((∏ v ∈ P, v).totient : ℝ) := by
  classical
  let S := dyadicTripleSourceModuli Y cutoff D P
  let R := roughTripleFactorPairs Y Z B cutoff D U V T P
  let N := S.filter (fun n => (smallPrimePart B n : ℝ) ≤ (Z : ℝ))
  have hex : ∀ n : ℕ, ∃ p : ℕ × ℕ,
      n ∈ N → p ∈ R ∧ p.1 * p.2 = n := by
    intro n
    by_cases hn : n ∈ N
    · obtain ⟨hs, hsmall⟩ := Finset.mem_filter.mp hn
      obtain ⟨p, hp, hprod⟩ :=
        exists_roughTripleFactorPair Y Z B cutoff D U V T P hP hT hTD hU hV hs hsmall
      exact ⟨p, fun _ => ⟨hp, hprod⟩⟩
    · exact ⟨(0, 0), fun h => (hn h).elim⟩
  choose pick hpick using hex
  have hinj : Set.InjOn pick N := by
    intro n hn m hm hnm
    exact (hpick n hn).2.symm.trans
      ((congrArg (fun p : ℕ × ℕ => p.1 * p.2) hnm).trans (hpick m hm).2)
  have himage : N.image pick ⊆ R := by
    intro p hp
    obtain ⟨n, hn, rfl⟩ := Finset.mem_image.mp hp
    exact (hpick n hn).1
  have hnon : (∑ n ∈ N, ‖fullDiscrepancy f n a‖) ≤
      ∑ p ∈ R, ‖fullDiscrepancy f (p.1 * p.2) a‖ := by
    apply Finset.sum_le_sum_of_injOn pick hinj himage
    · intro n hn
      rw [(hpick n hn).2]
    · exact fun _ _ _ => norm_nonneg _
  have htriangle : (∑ p ∈ R, ‖fullDiscrepancy f (p.1 * p.2) a‖) ≤
      (∑ p ∈ R, ‖dispersionTerm f p.1 p.2 a‖) +
        ∑ p ∈ R, ‖meanTerm f p.1 p.2 a‖ := by
    rw [← Finset.sum_add_distrib]
    apply Finset.sum_le_sum
    intro p _
    rw [fullDiscrepancy_eq_dispersion_add_mean]
    exact norm_add_le _ _
  have hG : 0 < ∏ p ∈ P, p := Finset.prod_pos fun p hp => (hP p hp).pos
  have hS : ∀ p ∈ R, Nat.Coprime p.1 p.2 ∧ p.1 ∣ (∏ v ∈ P, v) := by
    intro p hp
    have hpSource := (Finset.mem_filter.mp hp).2.1
    have hpTriple := (Finset.mem_filter.mp hpSource).1
    have hprodDiv := (Finset.mem_filter.mp hpTriple).2.1
    exact ⟨Nat.coprime_of_squarefree_mul
      ((primeProduct_squarefree hP).squarefree_of_dvd hprodDiv),
      (show p.1 ∣ p.1 * p.2 from ⟨p.2, rfl⟩).trans hprodDiv⟩
  have havg := sum_norm_dispersion_le_global_average f hG R hS a
  have hsplit := Finset.sum_filter_add_sum_filter_not S
    (fun n => (Z : ℝ) < (smallPrimePart B n : ℝ)) (fun n => ‖fullDiscrepancy f n a‖)
  have hN : S.filter (fun n => ¬ (Z : ℝ) < (smallPrimePart B n : ℝ)) = N := by
    ext n
    simp only [N, Finset.mem_filter, not_lt]
  rw [hN] at hsplit
  change (∑ n ∈ S, ‖fullDiscrepancy f n a‖) ≤
    (∑ n ∈ S with (Z : ℝ) < (smallPrimePart B n : ℝ), ‖fullDiscrepancy f n a‖) +
    (∑ p ∈ R, ‖meanTerm f p.1 p.2 a‖) +
    (∑ b ∈ primitiveResidues (∏ v ∈ P, v),
      ∑ p ∈ R, ‖deltaZero f p.1 p.2 a a b‖) / ((∏ v ∈ P, v).totient : ℝ)
  linarith

theorem affine_congruence_card_le
    (q L : ℕ) (hq : 0 < q) (a c : ℤ) (hc : IsCoprime c (q : ℤ)) :
    (((Finset.Icc (-(L : ℤ)) (L : ℤ)).filter
      (fun ℓ => Int.ModEq (q : ℤ) (a + c * ℓ) 0)).card : ℝ) ≤
      2 * (1 + (L : ℝ) / (q : ℝ)) := by
  let S := (Finset.Icc (-(L : ℤ)) (L : ℤ)).filter
    (fun ℓ => Int.ModEq (q : ℤ) (a + c * ℓ) 0)
  change (S.card : ℝ) ≤ _
  by_cases hS : S.Nonempty
  · obtain ⟨ℓ₀, hℓ₀⟩ := hS
    have hsub : S ⊆ (Finset.Icc (-(L : ℤ)) (L : ℤ)).filter
        (fun ℓ => Int.ModEq (q : ℤ) ℓ ℓ₀) := by
      intro ℓ hℓ
      have hm := (Finset.mem_filter.mp hℓ).2
      have hm₀ := (Finset.mem_filter.mp hℓ₀).2
      refine Finset.mem_filter.mpr ⟨(Finset.mem_filter.mp hℓ).1, ?_⟩
      have hd := (hm.trans hm₀.symm).dvd
      have heq : a + c * ℓ₀ - (a + c * ℓ) = c * (ℓ₀ - ℓ) := by ring
      rw [heq] at hd
      exact Int.modEq_iff_dvd.mpr (hc.symm.dvd_of_dvd_mul_left hd)
    have hcount := interval_modEq_card_le (-(L : ℤ)) (2 * L + 1) q hq ℓ₀
    have hend : -(L : ℤ) + ((2 * L + 1 : ℕ) : ℤ) = (L : ℤ) + 1 := by omega
    rw [hend, Finset.Ico_add_one_right_eq_Icc] at hcount
    have hqR : (0 : ℝ) < q := by exact_mod_cast hq
    have hq1 : (1 : ℝ) ≤ q := by exact_mod_cast hq
    have hi : (1 : ℝ) / q ≤ 1 := (div_le_one hqR).mpr hq1
    calc
      (S.card : ℝ) ≤
          (((Finset.Icc (-(L : ℤ)) (L : ℤ)).filter
            (fun ℓ => Int.ModEq (q : ℤ) ℓ ℓ₀)).card : ℝ) := by
        exact_mod_cast Finset.card_le_card hsub
      _ ≤ ((2 * L + 1 : ℕ) : ℝ) / q + 1 := hcount
      _ = 2 * ((L : ℝ) / q) + ((1 : ℝ) / q + 1) := by push_cast; ring
      _ ≤ 2 * (1 + (L : ℝ) / q) := by linarith
  · have hzero : S = ∅ := Finset.not_nonempty_iff_eq_empty.mp hS
    rw [hzero, Finset.card_empty, Nat.cast_zero]
    positivity

theorem primitive_shifted_coefficient_moment_le
    (β : ℤ →₀ ℂ) (q L : ℕ) (hq : 0 < q)
    (b₁ b₂ r : ℤ) (hprim : Int.gcd (b₁ * b₂ * r) (q : ℤ) = 1)
    (C : ℤ → ℤ → ℝ)
    (hC0 : ∀ n ℓ, 0 ≤ C n ℓ)
    (hC1 : ∀ n ℓ, C n ℓ ≤
      if Int.ModEq (q : ℤ) (b₁ * (n + ℓ * r)) (b₂ * n) then 1 else 0) :
    (∑ ℓ ∈ Finset.Icc (-(L : ℤ)) (L : ℤ),
      ∑ n ∈ β.support.filter (fun n => n + ℓ * r ∈ β.support),
        ‖β n‖ * ‖β (n + ℓ * r)‖ * C n ℓ) ≤
      2 * (1 + (L : ℝ) / (q : ℝ)) * ∑ n ∈ β.support, ‖β n‖ ^ 2 := by
  let I := Finset.Icc (-(L : ℤ)) (L : ℤ)
  let B : ℝ := 2 * (1 + (L : ℝ) / q)
  let E : ℝ := ∑ n ∈ β.support, ‖β n‖ ^ 2
  have hp : IsCoprime (b₁ * b₂ * r) (q : ℤ) :=
    Int.isCoprime_iff_gcd_eq_one.mpr hprim
  have hb₁ : IsCoprime (b₁ * r) (q : ℤ) :=
    hp.of_mul_left_left.of_mul_left_left.mul_left hp.of_mul_left_right
  have hb₂ : IsCoprime (b₂ * r) (q : ℤ) :=
    hp.of_mul_left_left.of_mul_left_right.mul_left hp.of_mul_left_right
  have hmod (n ℓ : ℤ) :
      Int.ModEq (q : ℤ) (b₁ * (n + ℓ * r)) (b₂ * n) ↔
        Int.ModEq (q : ℤ) ((b₁ - b₂) * n + (b₁ * r) * ℓ) 0 := by
    rw [Int.modEq_iff_dvd, Int.modEq_iff_dvd]
    have heq : b₂ * n - b₁ * (n + ℓ * r) =
        0 - ((b₁ - b₂) * n + (b₁ * r) * ℓ) := by ring
    rw [heq]
  have hbound (c : ℤ) (hc : IsCoprime c (q : ℤ)) :
      (∑ ℓ ∈ I, ∑ n ∈ β.support,
        if Int.ModEq (q : ℤ) ((b₁ - b₂) * n + c * ℓ) 0
        then ‖β n‖ ^ 2 else 0) ≤ B * E := by
    rw [Finset.sum_comm]
    calc
      _ = ∑ n ∈ β.support,
          (((I.filter (fun ℓ =>
            Int.ModEq (q : ℤ) ((b₁ - b₂) * n + c * ℓ) 0)).card : ℝ) *
              ‖β n‖ ^ 2) := by
        apply Finset.sum_congr rfl
        intro n _
        rw [← Finset.sum_filter]
        simp only [Finset.sum_const, nsmul_eq_mul]
      _ ≤ ∑ n ∈ β.support, B * ‖β n‖ ^ 2 := by
        apply Finset.sum_le_sum
        intro n _
        exact mul_le_mul_of_nonneg_right
          (affine_congruence_card_le q L hq ((b₁ - b₂) * n) c hc) (sq_nonneg _)
      _ = B * E := (Finset.mul_sum _ _ _).symm
  have hfirst :
      (∑ ℓ ∈ I,
        ∑ n ∈ β.support.filter (fun n => n + ℓ * r ∈ β.support),
          if Int.ModEq (q : ℤ) (b₁ * (n + ℓ * r)) (b₂ * n)
          then ‖β n‖ ^ 2 else 0) ≤ B * E := by
    calc
      _ ≤ ∑ ℓ ∈ I, ∑ n ∈ β.support,
          if Int.ModEq (q : ℤ) (b₁ * (n + ℓ * r)) (b₂ * n)
          then ‖β n‖ ^ 2 else 0 := by
        apply Finset.sum_le_sum
        intro ℓ _
        apply Finset.sum_le_sum_of_subset_of_nonneg (Finset.filter_subset _ _)
        intro n _ _
        split_ifs <;> positivity
      _ = ∑ ℓ ∈ I, ∑ n ∈ β.support,
          if Int.ModEq (q : ℤ) ((b₁ - b₂) * n + (b₁ * r) * ℓ) 0
          then ‖β n‖ ^ 2 else 0 := by simp_rw [hmod]
      _ ≤ B * E := hbound (b₁ * r) hb₁
  have hshift (ℓ : ℤ) :
      (∑ n ∈ β.support.filter (fun n => n + ℓ * r ∈ β.support),
        if Int.ModEq (q : ℤ) (b₁ * (n + ℓ * r)) (b₂ * n)
        then ‖β (n + ℓ * r)‖ ^ 2 else 0) =
      ∑ m ∈ β.support.filter (fun m => m - ℓ * r ∈ β.support),
        if Int.ModEq (q : ℤ) ((b₁ - b₂) * m + (b₂ * r) * ℓ) 0
        then ‖β m‖ ^ 2 else 0 := by
    refine Finset.sum_equiv (Equiv.addRight (ℓ * r)) ?_ ?_
    · intro n
      simp only [Equiv.coe_addRight, Finset.mem_filter, add_sub_cancel_right, and_comm]
    · intro n _
      have heq : (b₁ - b₂) * (n + ℓ * r) + (b₂ * r) * ℓ =
          (b₁ - b₂) * n + (b₁ * r) * ℓ := by ring
      simp only [Equiv.coe_addRight, heq, hmod]
  have hsecond :
      (∑ ℓ ∈ I,
        ∑ n ∈ β.support.filter (fun n => n + ℓ * r ∈ β.support),
          if Int.ModEq (q : ℤ) (b₁ * (n + ℓ * r)) (b₂ * n)
          then ‖β (n + ℓ * r)‖ ^ 2 else 0) ≤ B * E := by
    simp_rw [hshift]
    calc
      _ ≤ ∑ ℓ ∈ I, ∑ m ∈ β.support,
          if Int.ModEq (q : ℤ) ((b₁ - b₂) * m + (b₂ * r) * ℓ) 0
          then ‖β m‖ ^ 2 else 0 := by
        apply Finset.sum_le_sum
        intro ℓ _
        apply Finset.sum_le_sum_of_subset_of_nonneg (Finset.filter_subset _ _)
        intro m _ _
        split_ifs <;> positivity
      _ ≤ B * E := hbound (b₂ * r) hb₂
  have hterm (n ℓ : ℤ) :
      2 * (‖β n‖ * ‖β (n + ℓ * r)‖ * C n ℓ) ≤
        (if Int.ModEq (q : ℤ) (b₁ * (n + ℓ * r)) (b₂ * n)
          then ‖β n‖ ^ 2 else 0) +
        (if Int.ModEq (q : ℤ) (b₁ * (n + ℓ * r)) (b₂ * n)
          then ‖β (n + ℓ * r)‖ ^ 2 else 0) := by
    by_cases hm : Int.ModEq (q : ℤ) (b₁ * (n + ℓ * r)) (b₂ * n)
    · have hC : C n ℓ ≤ 1 := by simpa only [hm, ite_true] using hC1 n ℓ
      have hmul := mul_le_mul_of_nonneg_left hC
        (mul_nonneg (norm_nonneg (β n)) (norm_nonneg (β (n + ℓ * r))))
      simp only [hm, ite_true]
      nlinarith [two_mul_le_add_sq ‖β n‖ ‖β (n + ℓ * r)‖]
    · have hC : C n ℓ = 0 := le_antisymm
        (by simpa only [hm, ite_false] using hC1 n ℓ) (hC0 n ℓ)
      simp only [hm, ite_false, hC, mul_zero, add_zero, le_refl]
  have htotal := Finset.sum_le_sum fun ℓ (_ : ℓ ∈ I) =>
    Finset.sum_le_sum fun n
        (_ : n ∈ β.support.filter (fun n => n + ℓ * r ∈ β.support)) =>
      hterm n ℓ
  simp only [← Finset.mul_sum, Finset.sum_add_distrib] at htotal
  change _ ≤ B * E
  linarith

theorem harmonic_shift_factor_sum_le
    (D Q : ℕ) (hD : 2 ≤ D) (L : ℝ) (hL : 0 ≤ L) :
    (∑ q ∈ Finset.Icc D Q,
      (q : ℝ)⁻¹ * (1 + L / (q : ℝ))) ≤
      1 + Real.log (Q : ℝ) + L / ((D - 1 : ℕ) : ℝ) := by
  have hharm : (∑ q ∈ Finset.Icc D Q, (q : ℝ)⁻¹) ≤
      1 + Real.log (Q : ℝ) := by
    calc
      _ ≤ ∑ q ∈ Finset.Icc 1 Q, (q : ℝ)⁻¹ := by
        exact Finset.sum_le_sum_of_subset_of_nonneg
          (Finset.Icc_subset_Icc_left (by omega : 1 ≤ D))
          (fun q _ _ => inv_nonneg.mpr (Nat.cast_nonneg q))
      _ ≤ 1 + Real.log (Q : ℝ) := by
        simpa only [harmonic_eq_sum_Icc, Rat.cast_sum, Rat.cast_inv,
          Rat.cast_natCast] using harmonic_le_one_add_log Q
  have htail : (∑ q ∈ Finset.Icc D Q, ((q : ℝ) ^ 2)⁻¹) ≤
      ((D - 1 : ℕ) : ℝ)⁻¹ := by
    by_cases hDQ : D ≤ Q
    · simpa only [← Finset.Icc_add_one_left_eq_Ioc,
        Nat.sub_add_cancel (by omega : 1 ≤ D)] using
          (sum_Ioc_inv_sq_le_sub (α := ℝ)
            (k := D - 1) (n := Q) (by omega) (by omega)).trans
              (sub_le_self _ (inv_nonneg.mpr (Nat.cast_nonneg Q)))
    · rw [Finset.Icc_eq_empty_of_lt (Nat.lt_of_not_ge hDQ), Finset.sum_empty]
      exact inv_nonneg.mpr (Nat.cast_nonneg (D - 1))
  calc
    _ = (∑ q ∈ Finset.Icc D Q, (q : ℝ)⁻¹) +
        L * (∑ q ∈ Finset.Icc D Q, ((q : ℝ) ^ 2)⁻¹) := by
      rw [Finset.mul_sum, ← Finset.sum_add_distrib]
      apply Finset.sum_congr rfl
      intro q _
      simp only [div_eq_mul_inv, ← inv_pow]
      ring
    _ ≤ (1 + Real.log (Q : ℝ)) + L * ((D - 1 : ℕ) : ℝ)⁻¹ :=
      add_le_add hharm (mul_le_mul_of_nonneg_left htail hL)
    _ = _ := by rw [div_eq_mul_inv]

theorem initial_zero_frequency_uniform_log_saving
    (A C ε K η : ℝ) (hε : 0 < ε) (hK : 0 ≤ K) (hη : 0 < η) :
    ∀ᶠ x : ℝ in Filter.atTop, ∀ N R : ℝ,
      0 < N → 0 ≤ R → R ≤ K * x ^ (-2 * ε) * N →
      (Real.log x) ^ C *
          (R / N + (Real.exp ((Real.log x) ^ (1 / 3 : ℝ)))⁻¹) ≤
        η * (Real.log x) ^ (-A) := by
  have htwoε : 0 < 2 * ε := by positivity
  have hpoly : Filter.Tendsto
      (fun x : ℝ => (Real.log x) ^ (A + C) / x ^ (2 * ε))
      Filter.atTop (𝓝 0) :=
    (isLittleO_log_rpow_rpow_atTop (A + C) htwoε).tendsto_div_nhds_zero
  have hpolyK : Filter.Tendsto
      (fun x : ℝ => (Real.log x) ^ (A + C) * (K * x ^ (-2 * ε)))
      Filter.atTop (𝓝 0) := by
    have hscaled : Filter.Tendsto
        (fun x : ℝ => K * ((Real.log x) ^ (A + C) / x ^ (2 * ε)))
        Filter.atTop (𝓝 0) := by
      simpa only [mul_zero] using hpoly.const_mul K
    refine Filter.Tendsto.congr' ?_ hscaled
    filter_upwards [Filter.eventually_gt_atTop (0 : ℝ)] with x hx
    rw [show -2 * ε = -(2 * ε) by ring, Real.rpow_neg hx.le (2 * ε),
      div_eq_mul_inv]
    ring
  have hroot : Filter.Tendsto
      (fun x : ℝ => (Real.log x) ^ (1 / 3 : ℝ)) Filter.atTop Filter.atTop :=
    (tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 3)).comp
      Real.tendsto_log_atTop
  have hexpBase :=
    (tendsto_rpow_mul_exp_neg_mul_atTop_nhds_zero
      (3 * (A + C)) 1 zero_lt_one).comp hroot
  have hexp : Filter.Tendsto
      (fun x : ℝ => (Real.log x) ^ (A + C) *
        (Real.exp ((Real.log x) ^ (1 / 3 : ℝ)))⁻¹)
      Filter.atTop (𝓝 0) := by
    refine Filter.Tendsto.congr' ?_ hexpBase
    filter_upwards [Filter.eventually_gt_atTop (1 : ℝ)] with x hx
    dsimp only [Function.comp_apply]
    rw [← Real.rpow_mul (Real.log_pos hx).le,
      show (1 / 3 : ℝ) * (3 * (A + C)) = A + C by ring]
    simp only [neg_one_mul, Real.exp_neg]
  have henv : Filter.Tendsto
      (fun x : ℝ => (Real.log x) ^ (A + C) *
        (K * x ^ (-2 * ε) + (Real.exp ((Real.log x) ^ (1 / 3 : ℝ)))⁻¹))
      Filter.atTop (𝓝 0) := by
    simpa only [mul_add, zero_add] using hpolyK.add hexp
  filter_upwards [henv.eventually_le_const hη,
    Filter.eventually_gt_atTop (1 : ℝ)] with x hsmallx hx
  intro N R hN _ hRange
  have hlog : 0 < Real.log x := Real.log_pos hx
  have hratio : R / N ≤ K * x ^ (-2 * ε) :=
    (div_le_iff₀ hN).mpr hRange
  have hbudget0 : 0 ≤ K * x ^ (-2 * ε) +
      (Real.exp ((Real.log x) ^ (1 / 3 : ℝ)))⁻¹ :=
    add_nonneg
      (mul_nonneg hK (Real.rpow_nonneg (zero_lt_one.trans hx).le _))
      (inv_nonneg.mpr (Real.exp_pos _).le)
  calc
    (Real.log x) ^ C *
        (R / N + (Real.exp ((Real.log x) ^ (1 / 3 : ℝ)))⁻¹) ≤
        (Real.log x) ^ C *
          (K * x ^ (-2 * ε) + (Real.exp ((Real.log x) ^ (1 / 3 : ℝ)))⁻¹) := by
      simpa only [mul_comm] using
        mul_le_mul (add_le_add hratio le_rfl)
          (le_refl ((Real.log x) ^ C))
          (Real.rpow_nonneg hlog.le C) hbudget0
    _ = ((Real.log x) ^ (A + C) *
          (K * x ^ (-2 * ε) + (Real.exp ((Real.log x) ^ (1 / 3 : ℝ)))⁻¹)) *
        (Real.log x) ^ (-A) := by
      rw [mul_right_comm, ← Real.rpow_add hlog,
        show A + C + -A = C by ring]
    _ ≤ η * (Real.log x) ^ (-A) :=
      mul_le_mul_of_nonneg_right hsmallx (Real.rpow_nonneg hlog.le _)

theorem dyadicTripleSourceError_le_exceptional_mean_quadratic
    (Y Z : Set.Ici (1 : ℝ)) (B cutoff D U V : ℕ)
    (T : ℝ) (P : Finset ℕ) (hP : ∀ p ∈ P, Nat.Prime p)
    (hT : 1 ≤ T) (hTD : T ≤ (D : ℝ))
    (hU : 2 * (D : ℝ) * (Y : ℝ) / T ≤ (U : ℝ))
    (hV : T * (Z : ℝ) ≤ (V : ℝ))
    (a : ℕ) (ha : Nat.Coprime a (∏ v ∈ P, v))
    (α β : ℕ →₀ ℂ) (sm : Finset ℕ) (w : ℕ → ℝ)
    (hsm : α.support ⊆ sm) (hw₀ : ∀ m ∈ sm, 0 ≤ w m)
    (hw₁ : ∀ m ∈ α.support, 1 ≤ w m) :
    ∃ c : ℕ → ℕ × ℕ → ℂ,
      (∀ b ∈ primitiveResidues (∏ v ∈ P, v),
        ∀ p ∈ roughTripleFactorPairs Y Z B cutoff D U V T P, ‖c b p‖ = 1) ∧
      (∑ n ∈ dyadicTripleSourceModuli Y cutoff D P,
        ‖fullDiscrepancy (finiteConvolution α β) n a‖) ≤
        (∑ n ∈ dyadicTripleSourceModuli Y cutoff D P
            with (Z : ℝ) < (smallPrimePart B n : ℝ),
          ‖fullDiscrepancy (finiteConvolution α β) n a‖) +
        (∑ p ∈ roughTripleFactorPairs Y Z B cutoff D U V T P,
          ‖meanTerm (finiteConvolution α β) p.1 p.2 a‖) +
        (∑ b ∈ primitiveResidues (∏ v ∈ P, v),
          Real.sqrt
            ((((roughTripleFactorPairs Y Z B cutoff D U V T P).image Prod.snd).card : ℝ) *
              (∑ m ∈ α.support, ‖α m‖ ^ 2) *
              dispersionEnergy sm w
                (roughTripleFactorPairs Y Z B cutoff D U V T P) β (c b) a a b)) /
          ((∏ v ∈ P, v).totient : ℝ) := by
  classical
  let G := ∏ v ∈ P, v
  choose! c hc _ hbound using fun b (hb : b ∈ primitiveResidues G) =>
    exists_phases_deltaZero_mass_sq_le α β sm w hsm hw₀ hw₁ G
      (roughTripleFactorPairs Y Z B cutoff D U V T P)
      (fun _ hp => (Finset.mem_filter.mp
        (Finset.mem_filter.mp (Finset.mem_filter.mp hp).2.1).1).2.1)
      a a b ha ha (Finset.mem_filter.mp hb).2
  refine ⟨c, hc, ?_⟩
  apply (dyadicTripleSourceError_le_exceptional_mean_global_average
    Y Z B cutoff D U V T P hP hT hTD hU hV a (finiteConvolution α β)).trans
  apply add_le_add le_rfl
  apply div_le_div_of_nonneg_right _ (Nat.cast_nonneg _)
  exact Finset.sum_le_sum fun b hb => Real.le_sqrt_of_sq_le (hbound b hb)

/--
The frequency-`h` contribution obtained by multiplying the negative-frequency transform of `w`
on `sm` by the positive-frequency character sum over the mixed fiber. The normalization is `1 /
Q`, where `Q = r * lcm q₁ q₂`; the value is zero when `Q = 0`.
-/
noncomputable def mixedFiberFourierCoefficient (sm : Finset ℕ) (w : ℕ → ℝ)
    (q₁ q₂ r a b₁ b₂ n₁ n₂ h : ℕ) : ℂ :=
  let Q : ℕ := r * Nat.lcm q₁ q₂
  if hQ : Q = 0 then 0 else
    let _ : NeZero Q := ⟨hQ⟩
    (Q : ℂ)⁻¹ *
      (∑ m ∈ sm, (w m : ℂ) *
        ZMod.stdAddChar (-((m : ZMod Q) * (h : ZMod Q)))) *
      ∑ t ∈ mixedFiber (Finset.range Q) q₁ q₂ r a b₁ b₂ n₁ n₂,
        ZMod.stdAddChar ((t : ZMod Q) * (h : ZMod Q))

/--
The zero-frequency contribution from distinct support indices of `β` and pairs of moduli with a
common second component and nontrivial gcd of their first components. The coefficient weights
are `c p₁ * star (c p₂)` and `β n₁ * star (β n₂)`.
-/
noncomputable def noncoprimeOffDiagonalZeroMode (sm : Finset ℕ) (w : ℕ → ℝ)
    (S : Finset (ℕ × ℕ)) (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ)
    (a b₁ b₂ : ℕ) : ℂ :=
  ∑ r ∈ S.image Prod.snd,
    ∑ p₁ ∈ S.filter (fun p => p.2 = r),
      ∑ p₂ ∈ S.filter (fun p => p.2 = r ∧ 1 < Nat.gcd p₁.1 p.1),
        c p₁ * star (c p₂) *
          ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support.filter (fun n₂ => n₁ ≠ n₂),
            β n₁ * star (β n₂) *
              mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b₁ b₂ n₁ n₂ 0

theorem sum_zmod_eq_sum_range_natCast (Q : ℕ) [NeZero Q] (f : ZMod Q → ℂ) :
    (∑ h : ZMod Q, f h) = ∑ h ∈ Finset.range Q, f (h : ZMod Q) := by
  classical
  cases Q with
  | zero => exact (NeZero.ne 0 rfl).elim
  | succ Q =>
      have hsum := Fin.sum_univ_eq_sum_range (fun h : ℕ => f (h : ZMod (Q + 1))) (Q + 1)
      change (∑ h : ZMod (Q + 1), f (h.val : ZMod (Q + 1))) = _ at hsum
      simpa only [ZMod.natCast_zmod_val] using hsum

theorem mixedFiberFourierCoefficient_zero_and_sum
    (sm : Finset ℕ) (w : ℕ → ℝ)
    (q₁ q₂ r a b₁ b₂ n₁ n₂ : ℕ)
    [NeZero q₁] [NeZero q₂] [NeZero r]
    (hqr₁ : Nat.Coprime q₁ r) (hqr₂ : Nat.Coprime q₂ r)
    (ha : Nat.Coprime a r) (hb₁ : Nat.Coprime b₁ q₁)
    (hb₂ : Nat.Coprime b₂ q₂) :
    (mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂ 0 =
      if Nat.Coprime n₁ (q₁ * r) ∧ Nat.Coprime n₂ (q₂ * r) ∧
          Nat.ModEq r n₁ n₂ ∧
          Nat.ModEq (Nat.gcd q₁ q₂) (b₁ * n₂) (b₂ * n₁)
      then (∑ m ∈ sm, (w m : ℂ)) / ((r * Nat.lcm q₁ q₂ : ℕ) : ℂ)
      else 0) ∧
    ((mixedFiberMass sm w q₁ q₂ r a b₁ b₂ n₁ n₂ : ℂ) =
      ∑ h ∈ Finset.range (r * Nat.lcm q₁ q₂),
        mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂ h) := by
  classical
  let Q : ℕ := r * Nat.lcm q₁ q₂
  have hQ : Q ≠ 0 := Nat.mul_ne_zero (NeZero.ne r)
    (Nat.lcm_ne_zero (NeZero.ne q₁) (NeZero.ne q₂))
  let _ : NeZero Q := ⟨hQ⟩
  by_cases hg : Nat.Coprime n₁ (q₁ * r) ∧ Nat.Coprime n₂ (q₂ * r) ∧
      Nat.ModEq r n₁ n₂ ∧
      Nat.ModEq (Nat.gcd q₁ q₂) (b₁ * n₂) (b₂ * n₁)
  · have hn₁ := hg.1
    have hn₂ := hg.2.1
    have hnr := hg.2.2.1
    have hcompat := hg.2.2.2
    obtain ⟨t, ⟨ht, _, hcr, hc₁, _, hc₂⟩, _⟩ :=
      mixedFiber_progression_residue_exists_unique q₁ q₂ r a b₁ b₂ n₁ n₂
        hqr₁ hqr₂ ha hb₁ hb₂ hn₁ hn₂ hnr hcompat
    have hsingle : mixedFiber (Finset.range Q) q₁ q₂ r a b₁ b₂ n₁ n₂ = {t} := by
      rw [(mixedFiberMass_progression_fourier (Finset.range Q) w q₁ q₂ r a b₁ b₂
        n₁ n₂ hqr₁ hqr₂ ha hb₁ hb₂ hn₁ hn₂ hnr t hcr hc₁ hc₂).1]
      ext m
      simp only [Finset.mem_filter, Finset.mem_range, Finset.mem_singleton]
      constructor
      · rintro ⟨hm, hmt⟩
        exact hmt.eq_of_lt_of_lt hm ht
      · rintro rfl
        exact ⟨ht, rfl⟩
    have hcoef (h : ℕ) :
        mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂ h =
          (Q : ℂ)⁻¹ *
            (∑ m ∈ sm, (w m : ℂ) *
              ZMod.stdAddChar (-((m : ZMod Q) * (h : ZMod Q)))) *
            ZMod.stdAddChar ((t : ZMod Q) * (h : ZMod Q)) := by
      dsimp only [Q] at hQ hsingle ⊢
      simp only [mixedFiberFourierCoefficient, dite_eq_right hQ, hsingle,
        Finset.sum_singleton]
    refine ⟨?_, ?_⟩
    · rw [ite_eq_left hg, hcoef]
      simp [Q, div_eq_mul_inv, mul_comm]
    · have hf := (mixedFiberMass_progression_fourier sm w q₁ q₂ r a b₁ b₂
          n₁ n₂ hqr₁ hqr₂ ha hb₁ hb₂ hn₁ hn₂ hnr t hcr hc₁ hc₂).2.1
      change (mixedFiberMass sm w q₁ q₂ r a b₁ b₂ n₁ n₂ : ℂ) =
        (Q : ℂ)⁻¹ * ∑ h : ZMod Q,
          (∑ m ∈ sm, (w m : ℂ) * ZMod.stdAddChar (-((m : ZMod Q) * h))) *
            ZMod.stdAddChar ((t : ZMod Q) * h) at hf
      rw [hf, sum_zmod_eq_sum_range_natCast, Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro h _
      rw [hcoef]
      simp only [mul_assoc]
  · have he := (mixedFiber_badGuard_zero (Finset.range Q) w
        q₁ q₂ r a b₁ b₂ n₁ n₂ hg).1
    have hz (h : ℕ) :
        mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂ h = 0 := by
      dsimp only [Q] at hQ he ⊢
      simp only [mixedFiberFourierCoefficient, dite_eq_right hQ, he, Finset.sum_empty,
        mul_zero]
    refine ⟨?_, ?_⟩
    · simp only [hz, ite_eq_right hg]
    · rw [(mixedFiber_badGuard_zero sm w q₁ q₂ r a b₁ b₂ n₁ n₂ hg).2]
      simp only [Complex.ofReal_zero, hz, Finset.sum_const_zero]

theorem mixedCorrelation_noncoprime_zero_frequency_expansion
    (sm : Finset ℕ) (w : ℕ → ℝ) (S : Finset (ℕ × ℕ))
    (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ) (a b₁ b₂ : ℕ)
    (hS : ∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Nat.Coprime p.1 p.2)
    (hprim : ∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2)) :
    (∀ r ∈ S.image Prod.snd,
      ∀ p₁ ∈ S.filter (fun p => p.2 = r),
      ∀ p₂ ∈ S.filter (fun p => p.2 = r), ∀ n₁ n₂ : ℕ,
        mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b₁ b₂ n₁ n₂ 0 =
          if Nat.Coprime n₁ (p₁.1 * r) ∧ Nat.Coprime n₂ (p₂.1 * r) ∧
              Nat.ModEq r n₁ n₂ ∧
              Nat.ModEq (Nat.gcd p₁.1 p₂.1) (b₁ * n₂) (b₂ * n₁)
          then (∑ m ∈ sm, (w m : ℂ)) / ((r * Nat.lcm p₁.1 p₂.1 : ℕ) : ℂ)
          else 0) ∧
    (mixedCorrelation sm w S β c a b₁ b₂ =
      (∑ r ∈ S.image Prod.snd,
        ∑ p₁ ∈ S.filter (fun p => p.2 = r),
          ∑ p₂ ∈ S.filter (fun p => p.2 = r),
            c p₁ * star (c p₂) *
              ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                if n₁ = n₂ ∨ Nat.gcd p₁.1 p₂.1 = 1
                then β n₁ * star (β n₂) *
                  (mixedFiberMass sm w p₁.1 p₂.1 r a b₁ b₂ n₁ n₂ : ℂ)
                else 0) +
      noncoprimeOffDiagonalZeroMode sm w S β c a b₁ b₂ +
      (∑ r ∈ S.image Prod.snd,
        ∑ p₁ ∈ S.filter (fun p => p.2 = r),
          ∑ p₂ ∈ S.filter (fun p => p.2 = r ∧ 1 < Nat.gcd p₁.1 p.1),
            c p₁ * star (c p₂) *
              ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support.filter (fun n₂ => n₁ ≠ n₂),
                β n₁ * star (β n₂) *
                  ∑ h ∈ Finset.Ico 1 (r * Nat.lcm p₁.1 p₂.1),
                    mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b₁ b₂ n₁ n₂ h)) := by
  classical
  have hlocal (r : ℕ) (p₁ : ℕ × ℕ) (hp₁ : p₁ ∈ S.filter (fun p => p.2 = r))
      (p₂ : ℕ × ℕ) (hp₂ : p₂ ∈ S.filter (fun p => p.2 = r)) (n₁ n₂ : ℕ) :
      (mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b₁ b₂ n₁ n₂ 0 =
        if Nat.Coprime n₁ (p₁.1 * r) ∧ Nat.Coprime n₂ (p₂.1 * r) ∧
            Nat.ModEq r n₁ n₂ ∧
            Nat.ModEq (Nat.gcd p₁.1 p₂.1) (b₁ * n₂) (b₂ * n₁)
        then (∑ m ∈ sm, (w m : ℂ)) / ((r * Nat.lcm p₁.1 p₂.1 : ℕ) : ℂ)
        else 0) ∧
      ((mixedFiberMass sm w p₁.1 p₂.1 r a b₁ b₂ n₁ n₂ : ℂ) =
        ∑ h ∈ Finset.range (r * Nat.lcm p₁.1 p₂.1),
          mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b₁ b₂ n₁ n₂ h) := by
    obtain ⟨hp₁S, hp₁r⟩ := Finset.mem_filter.mp hp₁
    obtain ⟨hp₂S, hp₂r⟩ := Finset.mem_filter.mp hp₂
    obtain ⟨hq₁, hr₁, hqr₁⟩ := hS p₁ hp₁S
    obtain ⟨hq₂, _, hqr₂⟩ := hS p₂ hp₂S
    have hr : 0 < r := by simpa only [hp₁r] using hr₁
    have hqr₁' : Nat.Coprime p₁.1 r := by simpa only [hp₁r] using hqr₁
    have hqr₂' : Nat.Coprime p₂.1 r := by simpa only [hp₂r] using hqr₂
    have hab₁ : Nat.Coprime (a * b₁ * b₂) (p₁.1 * r) := by
      simpa only [hp₁r] using hprim p₁ hp₁S
    have hab₂ : Nat.Coprime (a * b₁ * b₂) (p₂.1 * r) := by
      simpa only [hp₂r] using hprim p₂ hp₂S
    let _ : NeZero p₁.1 := ⟨Nat.ne_of_gt hq₁⟩
    let _ : NeZero p₂.1 := ⟨Nat.ne_of_gt hq₂⟩
    let _ : NeZero r := ⟨Nat.ne_of_gt hr⟩
    exact mixedFiberFourierCoefficient_zero_and_sum sm w p₁.1 p₂.1 r a b₁ b₂ n₁ n₂
      hqr₁' hqr₂'
      hab₁.coprime_mul_right.coprime_mul_right.coprime_mul_left_right
      hab₁.coprime_mul_right.coprime_mul_left.coprime_mul_right_right
      hab₂.coprime_mul_left.coprime_mul_right_right
  refine ⟨?_, ?_⟩
  · intro r _ p₁ hp₁ p₂ hp₂ n₁ n₂
    exact (hlocal r p₁ hp₁ p₂ hp₂ n₁ n₂).1
  · unfold mixedCorrelation noncoprimeOffDiagonalZeroMode
    simp only [Finset.sum_filter]
    rw [← Finset.sum_add_distrib, ← Finset.sum_add_distrib]
    apply Finset.sum_congr rfl
    intro r _
    rw [← Finset.sum_add_distrib, ← Finset.sum_add_distrib]
    apply Finset.sum_congr rfl
    intro p₁ hp₁
    by_cases hp₁r : p₁.2 = r
    · simp only [hp₁r, ite_true]
      rw [← Finset.sum_add_distrib, ← Finset.sum_add_distrib]
      apply Finset.sum_congr rfl
      intro p₂ hp₂
      by_cases hp₂r : p₂.2 = r
      · simp only [hp₂r, true_and, ite_true]
        by_cases hg : Nat.gcd p₁.1 p₂.1 = 1
        · simp [hg]
        · have hgpos : 0 < Nat.gcd p₁.1 p₂.1 :=
            Nat.gcd_pos_of_pos_left _ (hS p₁ hp₁).1
          have hgt : 1 < Nat.gcd p₁.1 p₂.1 := by omega
          simp only [hgt, ite_true]
          rw [← mul_add, ← mul_add]
          congr 1
          rw [← Finset.sum_add_distrib, ← Finset.sum_add_distrib]
          apply Finset.sum_congr rfl
          intro n₁ _
          rw [← Finset.sum_add_distrib, ← Finset.sum_add_distrib]
          apply Finset.sum_congr rfl
          intro n₂ _
          by_cases hnn : n₁ = n₂
          · simp [hnn]
          · have hf := (hlocal r p₁ (Finset.mem_filter.mpr ⟨hp₁, hp₁r⟩)
                p₂ (Finset.mem_filter.mpr ⟨hp₂, hp₂r⟩) n₁ n₂).2
            have hr : 0 < r := by simpa only [hp₁r] using (hS p₁ hp₁).2.1
            have hQ : 0 < r * Nat.lcm p₁.1 p₂.1 :=
              Nat.mul_pos hr (Nat.lcm_pos (hS p₁ hp₁).1 (hS p₂ hp₂).1)
            rw [Finset.sum_range_eq_add_Ico _ hQ] at hf
            simp only [hnn, hg, or_false, ite_false, ne_eq, not_false_eq_true,
              ite_true, zero_add]
            rw [hf, mul_add]
      · simp [hp₂r]
    · simp [hp₁r]

theorem congruence_pair_moment_le_l2
    (β : ℕ →₀ ℂ) (A N R r g b₁ b₂ : ℕ)
    (hR : 0 < R) (hRr : R ≤ r) (hg : 0 < g)
    (hβ : β.support ⊆ Finset.Icc A (A + N))
    (hprim : Nat.Coprime (b₁ * b₂ * r) g) :
    (∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
      if Nat.ModEq r n₁ n₂ ∧ Nat.ModEq g (b₁ * n₂) (b₂ * n₁)
      then ‖β n₁‖ * ‖β n₂‖ else 0) ≤
      2 * (1 + ((N / R : ℕ) : ℝ) / (g : ℝ)) *
        ∑ n ∈ β.support, ‖β n‖ ^ 2 := by
  classical
  let γ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
  let I := Finset.Icc (-((N / R : ℕ) : ℤ)) ((N / R : ℕ) : ℤ)
  let S := (γ.support ×ˢ γ.support).filter fun p =>
    Int.ModEq (r : ℤ) p.1 p.2 ∧
      Int.ModEq (g : ℤ) ((b₁ : ℤ) * p.2) ((b₂ : ℤ) * p.1)
  let e : ℤ × ℤ → ℤ × ℤ := fun p => ((p.2 - p.1) / (r : ℤ), p.1)
  let T := (I ×ˢ γ.support).filter fun p =>
    p.2 + p.1 * (r : ℤ) ∈ γ.support
  let C : ℤ → ℤ → ℝ := fun n ℓ =>
    if Int.ModEq (g : ℤ) ((b₁ : ℤ) * (n + ℓ * (r : ℤ))) ((b₂ : ℤ) * n)
    then 1 else 0
  have hsupport (n : ℤ) (hn : n ∈ γ.support) :
      (A : ℤ) ≤ n ∧ n ≤ (A : ℤ) + (N : ℤ) := by
    change n ∈ β.support.map (Nat.castEmbedding : ℕ ↪ ℤ) at hn
    obtain ⟨m, hm, rfl⟩ := Finset.mem_map.mp hn
    have hm' := Finset.mem_Icc.mp (hβ hm)
    simp only [Nat.castEmbedding_apply]
    constructor
    · exact_mod_cast hm'.1
    · exact_mod_cast hm'.2
  have hshift (p : ℤ × ℤ) (hp : p ∈ S) :
      p.1 + (e p).1 * (r : ℤ) = p.2 := by
    have hd : (r : ℤ) ∣ p.2 - p.1 := (Finset.mem_filter.mp hp).2.1.dvd
    dsimp [e]
    rw [Int.ediv_mul_cancel hd]
    ring
  have hradius (p : ℤ × ℤ) (hp : p ∈ S) : (e p).1 ∈ I := by
    have hp' := Finset.mem_product.mp (Finset.mem_filter.mp hp).1
    have hn₁ := hsupport p.1 hp'.1
    have hn₂ := hsupport p.2 hp'.2
    have hdiff : |p.2 - p.1| ≤ (N : ℤ) :=
      abs_le.mpr ⟨by omega, by omega⟩
    have hdiffNat : (p.2 - p.1).natAbs ≤ N := by
      have hcast : ((p.2 - p.1).natAbs : ℤ) ≤ (N : ℤ) := by
        simpa only [Int.natCast_natAbs] using hdiff
      exact_mod_cast hcast
    have hmul : (e p).1 * (r : ℤ) = p.2 - p.1 := by
      have hs := hshift p hp
      omega
    have hmulNat : (e p).1.natAbs * r ≤ N := by
      have heq := congrArg Int.natAbs hmul
      rw [Int.natAbs_mul, Int.natAbs_natCast] at heq
      rw [heq]
      exact hdiffNat
    have hL : (e p).1.natAbs ≤ N / R :=
      (Nat.le_div_iff_mul_le hR).mpr
        ((Nat.mul_le_mul_left (e p).1.natAbs hRr).trans hmulNat)
    have habs : |(e p).1| ≤ ((N / R : ℕ) : ℤ) := by
      rw [← Int.natCast_natAbs]
      exact_mod_cast hL
    exact Finset.mem_Icc.mpr (abs_le.mp habs)
  have hsum :
      (∑ p ∈ S, ‖γ p.1‖ * ‖γ p.2‖) ≤
        ∑ p ∈ T,
          ‖γ p.2‖ * ‖γ (p.2 + p.1 * (r : ℤ))‖ * C p.2 p.1 := by
    refine Finset.sum_le_sum_of_injOn e ?_ ?_ ?_ ?_
    · intro p hp q hq heq
      have hn : p.1 = q.1 := congrArg Prod.snd heq
      have hℓ : (e p).1 = (e q).1 := congrArg Prod.fst heq
      refine Prod.ext hn ?_
      calc
        p.2 = p.1 + (e p).1 * (r : ℤ) := (hshift p hp).symm
        _ = q.1 + (e q).1 * (r : ℤ) := by rw [hn, hℓ]
        _ = q.2 := hshift q hq
    · intro q hq
      obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hq
      have hp' := Finset.mem_product.mp (Finset.mem_filter.mp hp).1
      refine Finset.mem_filter.mpr
        ⟨Finset.mem_product.mpr ⟨hradius p hp, hp'.1⟩, ?_⟩
      change p.1 + (e p).1 * (r : ℤ) ∈ γ.support
      rw [hshift p hp]
      exact hp'.2
    · intro p hp
      have hm := (Finset.mem_filter.mp hp).2.2
      change ‖γ p.1‖ * ‖γ p.2‖ ≤
        ‖γ p.1‖ * ‖γ (p.1 + (e p).1 * (r : ℤ))‖ * C p.1 (e p).1
      dsimp [C]
      rw [hshift p hp]
      simp only [hm, ite_true, mul_one, le_refl]
    · intro p _ _
      dsimp [C]
      split_ifs <;> positivity
  have hprimZ : Int.gcd ((b₁ : ℤ) * (b₂ : ℤ) * (r : ℤ)) (g : ℤ) = 1 := by
    simpa only [← Nat.cast_mul, Int.gcd_natCast_natCast] using hprim.gcd_eq_one
  have hmoment := primitive_shifted_coefficient_moment_le γ g (N / R) hg
    (b₁ : ℤ) (b₂ : ℤ) (r : ℤ) hprimZ C
    (by intro n ℓ; dsimp [C]; split_ifs <;> norm_num)
    (by intro n ℓ; exact le_rfl)
  calc
    (∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
        if Nat.ModEq r n₁ n₂ ∧ Nat.ModEq g (b₁ * n₂) (b₂ * n₁)
        then ‖β n₁‖ * ‖β n₂‖ else 0) =
        ∑ p ∈ S, ‖γ p.1‖ * ‖γ p.2‖ := by
      simp only [S, Finset.sum_filter, Finset.sum_product, γ,
        Finsupp.support_embDomain, Finset.sum_map, Finsupp.embDomain_apply_self]
      simp only [Nat.castEmbedding_apply, ← Nat.cast_mul, Int.natCast_modEq_iff]
    _ ≤ ∑ p ∈ T,
        ‖γ p.2‖ * ‖γ (p.2 + p.1 * (r : ℤ))‖ * C p.2 p.1 := hsum
    _ = ∑ ℓ ∈ I,
        ∑ n ∈ γ.support.filter (fun n => n + ℓ * (r : ℤ) ∈ γ.support),
          ‖γ n‖ * ‖γ (n + ℓ * (r : ℤ))‖ * C n ℓ := by
      simp only [T, Finset.sum_filter, Finset.sum_product]
    _ ≤ 2 * (1 + ((N / R : ℕ) : ℝ) / (g : ℝ)) *
        ∑ n ∈ γ.support, ‖γ n‖ ^ 2 := hmoment
    _ = 2 * (1 + ((N / R : ℕ) : ℝ) / (g : ℝ)) *
        ∑ n ∈ β.support, ‖β n‖ ^ 2 := by
      simp only [γ, Finsupp.support_embDomain, Finset.sum_map,
        Finsupp.embDomain_apply_self]

theorem mixedFiberFourierCoefficient_offDiagonal_zero_norm_le
    (sm : Finset ℕ) (w : ℕ → ℝ) (β : ℕ →₀ ℂ)
    (A N R q₁ q₂ r a b₁ b₂ : ℕ) (hR : 0 < R) (hRr : R ≤ r)
    (hq₁ : 0 < q₁) (hq₂ : 0 < q₂)
    (hqr₁ : Nat.Coprime q₁ r) (hqr₂ : Nat.Coprime q₂ r)
    (ha : Nat.Coprime a r) (hb₁ : Nat.Coprime b₁ q₁) (hb₂ : Nat.Coprime b₂ q₂)
    (hβ : β.support ⊆ Finset.Icc A (A + N)) :
    ‖∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support.filter (fun n₂ => n₁ ≠ n₂),
      β n₁ * star (β n₂) *
        mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂ 0‖ ≤
      (2 * |∑ m ∈ sm, w m| * (∑ n ∈ β.support, ‖β n‖ ^ 2)) *
        (r : ℝ)⁻¹ * (Nat.lcm q₁ q₂ : ℝ)⁻¹ *
          (1 + ((N / R : ℕ) : ℝ) / (Nat.gcd q₁ q₂ : ℝ)) := by
  classical
  have hr : 0 < r := hR.trans_le hRr
  let : NeZero q₁ := ⟨hq₁.ne'⟩
  let : NeZero q₂ := ⟨hq₂.ne'⟩
  let : NeZero r := ⟨hr.ne'⟩
  let W : ℝ := |∑ m ∈ sm, w m|
  let V : ℕ → ℕ → ℝ := fun n₁ n₂ =>
    if Nat.ModEq r n₁ n₂ ∧
      Nat.ModEq (Nat.gcd q₁ q₂) (b₁ * n₂) (b₂ * n₁)
    then ‖β n₁‖ * ‖β n₂‖ else 0
  have hV (n₁ n₂ : ℕ) : 0 ≤ V n₁ n₂ := by
    dsimp [V]
    split_ifs <;> positivity
  have hW : 0 ≤ W := abs_nonneg _
  have hterm (n₁ n₂ : ℕ) :
      ‖β n₁ * star (β n₂) *
          mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂ 0‖ ≤
        W * ((r * Nat.lcm q₁ q₂ : ℕ) : ℝ)⁻¹ * V n₁ n₂ := by
    rw [(mixedFiberFourierCoefficient_zero_and_sum sm w q₁ q₂ r a b₁ b₂ n₁ n₂
      hqr₁ hqr₂ ha hb₁ hb₂).1]
    split_ifs with hg
    · have hp := hg.2.2
      simp only [V, hp, norm_mul, norm_star, norm_div,
        ← Complex.ofReal_sum, Complex.norm_real, Real.norm_eq_abs,
        Complex.norm_natCast]
      dsimp [W]
      rw [div_eq_mul_inv]
      exact le_of_eq (by ring)
    · simp only [mul_zero, norm_zero]
      exact mul_nonneg (mul_nonneg hW (inv_nonneg.mpr (Nat.cast_nonneg _))) (hV _ _)
  have hprim : Nat.Coprime (b₁ * b₂ * r) (Nat.gcd q₁ q₂) :=
    ((Nat.Coprime.of_dvd_right (Nat.gcd_dvd_left q₁ q₂) hb₁).mul_left
      (Nat.Coprime.of_dvd_right (Nat.gcd_dvd_right q₁ q₂) hb₂)).mul_left
        (Nat.Coprime.of_dvd_right (Nat.gcd_dvd_left q₁ q₂) hqr₁.symm)
  have hmoment := congruence_pair_moment_le_l2 β A N R r (Nat.gcd q₁ q₂) b₁ b₂
    hR hRr (Nat.gcd_pos_of_pos_left q₂ hq₁) hβ hprim
  calc
    _ ≤ ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support.filter (fun n₂ => n₁ ≠ n₂),
        ‖β n₁ * star (β n₂) *
          mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂ 0‖ :=
      (norm_sum_le _ _).trans (Finset.sum_le_sum fun _ _ => norm_sum_le _ _)
    _ ≤ ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support.filter (fun n₂ => n₁ ≠ n₂),
        W * ((r * Nat.lcm q₁ q₂ : ℕ) : ℝ)⁻¹ * V n₁ n₂ :=
      Finset.sum_le_sum fun n₁ _ => Finset.sum_le_sum fun n₂ _ => hterm n₁ n₂
    _ ≤ ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
        W * ((r * Nat.lcm q₁ q₂ : ℕ) : ℝ)⁻¹ * V n₁ n₂ := by
      apply Finset.sum_le_sum
      intro n₁ _
      exact Finset.sum_le_sum_of_subset_of_nonneg (Finset.filter_subset _ _)
        (fun n₂ _ _ => mul_nonneg
          (mul_nonneg hW (inv_nonneg.mpr (Nat.cast_nonneg _))) (hV n₁ n₂))
    _ = W * ((r * Nat.lcm q₁ q₂ : ℕ) : ℝ)⁻¹ *
        (∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support, V n₁ n₂) := by
      simp only [Finset.mul_sum]
    _ ≤ W * ((r * Nat.lcm q₁ q₂ : ℕ) : ℝ)⁻¹ *
        (2 * (1 + ((N / R : ℕ) : ℝ) / (Nat.gcd q₁ q₂ : ℝ)) *
          ∑ n ∈ β.support, ‖β n‖ ^ 2) :=
      mul_le_mul_of_nonneg_left hmoment
        (mul_nonneg hW (inv_nonneg.mpr (Nat.cast_nonneg _)))
    _ = _ := by
      dsimp [W]
      rw [Nat.cast_mul, mul_inv_rev]
      ring

theorem rough_moduli_noncoprime_lcm_sum_le
    (T : Finset (ℕ × ℕ)) (r Q D : ℕ) (L : ℝ) (hL : 0 ≤ L)
    (hD : 2 ≤ D)
    (hT : ∀ p ∈ T, 1 ≤ p.1 ∧ p.1 ≤ Q ∧ p.2 = r)
    (hrough : ∀ p ∈ T, ∀ t : ℕ, Nat.Prime t → t ∣ p.1 → D ≤ t) :
    (∑ p₁ ∈ T, ∑ p₂ ∈ T.filter (fun p₂ => 1 < Nat.gcd p₁.1 p₂.1),
      (Nat.lcm p₁.1 p₂.1 : ℝ)⁻¹ *
        (1 + L / (Nat.gcd p₁.1 p₂.1 : ℝ))) ≤
      (1 + Real.log (Q : ℝ)) ^ 2 *
        (1 + Real.log (Q : ℝ) + L / ((D - 1 : ℕ) : ℝ)) := by
  classical
  let U := (T ×ˢ T).filter (fun z => 1 < Nat.gcd z.1.1 z.2.1)
  let J := Finset.Icc D Q ×ˢ (Finset.Icc 1 Q ×ˢ Finset.Icc 1 Q)
  let e : (ℕ × ℕ) × (ℕ × ℕ) → ℕ × ℕ × ℕ := fun z =>
    (Nat.gcd z.1.1 z.2.1,
      z.1.1 / Nat.gcd z.1.1 z.2.1, z.2.1 / Nat.gcd z.1.1 z.2.1)
  let F : ℕ × ℕ × ℕ → ℝ := fun z =>
    (z.1 : ℝ)⁻¹ * (1 + L / (z.1 : ℝ)) *
      (z.2.1 : ℝ)⁻¹ * (z.2.2 : ℝ)⁻¹
  have heinj : Set.InjOn e U := by
    intro x hx y hy he
    have hxT := Finset.mem_product.mp (Finset.mem_filter.mp hx).1
    have hyT := Finset.mem_product.mp (Finset.mem_filter.mp hy).1
    have hg := congrArg Prod.fst he
    have hu := congrArg (fun z : ℕ × ℕ × ℕ => z.2.1) he
    have hv := congrArg (fun z : ℕ × ℕ × ℕ => z.2.2) he
    have hq₁ : x.1.1 = y.1.1 := by
      calc
        _ = Nat.gcd x.1.1 x.2.1 * (x.1.1 / Nat.gcd x.1.1 x.2.1) :=
          (Nat.mul_div_cancel' (Nat.gcd_dvd_left _ _)).symm
        _ = Nat.gcd y.1.1 y.2.1 * (y.1.1 / Nat.gcd y.1.1 y.2.1) :=
          congrArg₂ Nat.mul hg hu
        _ = _ := Nat.mul_div_cancel' (Nat.gcd_dvd_left _ _)
    have hq₂ : x.2.1 = y.2.1 := by
      calc
        _ = Nat.gcd x.1.1 x.2.1 * (x.2.1 / Nat.gcd x.1.1 x.2.1) :=
          (Nat.mul_div_cancel' (Nat.gcd_dvd_right _ _)).symm
        _ = Nat.gcd y.1.1 y.2.1 * (y.2.1 / Nat.gcd y.1.1 y.2.1) :=
          congrArg₂ Nat.mul hg hv
        _ = _ := Nat.mul_div_cancel' (Nat.gcd_dvd_right _ _)
    exact Prod.ext
      (Prod.ext hq₁ ((hT _ hxT.1).2.2.trans (hT _ hyT.1).2.2.symm))
      (Prod.ext hq₂ ((hT _ hxT.2).2.2.trans (hT _ hyT.2).2.2.symm))
  have hemem : U.image e ⊆ J := by
    intro z hz
    obtain ⟨x, hx, rfl⟩ := Finset.mem_image.mp hz
    have hxT := Finset.mem_product.mp (Finset.mem_filter.mp hx).1
    have hg1 := (Finset.mem_filter.mp hx).2
    have hq₁ := hT _ hxT.1
    have hq₂ := hT _ hxT.2
    have hg : 0 < Nat.gcd x.1.1 x.2.1 := by omega
    have hmin := Nat.minFac_prime (by omega : Nat.gcd x.1.1 x.2.1 ≠ 1)
    have hDg : D ≤ Nat.gcd x.1.1 x.2.1 :=
      (hrough x.1 hxT.1 _ hmin
        ((Nat.minFac_dvd _).trans (Nat.gcd_dvd_left _ _))).trans
          (Nat.le_of_dvd hg (Nat.minFac_dvd _))
    dsimp [J, e]
    refine Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨hDg, ?_⟩,
      Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨?_, ?_⟩,
        Finset.mem_Icc.mpr ⟨?_, ?_⟩⟩⟩
    · exact (Nat.gcd_le_left _ (by omega)).trans hq₁.2.1
    · exact Nat.div_gcd_pos_of_pos_left _ (by omega)
    · exact (Nat.div_le_self _ _).trans hq₁.2.1
    · exact Nat.div_gcd_pos_of_pos_right _ (by omega)
    · exact (Nat.div_le_self _ _).trans hq₂.2.1
  have heweight (x : (ℕ × ℕ) × (ℕ × ℕ)) :
      (Nat.lcm x.1.1 x.2.1 : ℝ)⁻¹ *
        (1 + L / (Nat.gcd x.1.1 x.2.1 : ℝ)) = F (e x) := by
    have heq : Nat.lcm x.1.1 x.2.1 = Nat.gcd x.1.1 x.2.1 *
        (x.1.1 / Nat.gcd x.1.1 x.2.1) * (x.2.1 / Nat.gcd x.1.1 x.2.1) := by
      rw [Nat.mul_div_cancel' (Nat.gcd_dvd_left _ _), Nat.lcm_eq_mul_div,
        Nat.mul_div_assoc _ (Nat.gcd_dvd_right _ _)]
    dsimp [F, e]
    rw [heq]
    push_cast
    simp only [mul_inv_rev]
    ring
  have hF (z : ℕ × ℕ × ℕ) : 0 ≤ F z := by
    dsimp [F]
    positivity
  have hrect :
      (∑ p₁ ∈ T, ∑ p₂ ∈ T.filter (fun p₂ => 1 < Nat.gcd p₁.1 p₂.1),
        (Nat.lcm p₁.1 p₂.1 : ℝ)⁻¹ *
          (1 + L / (Nat.gcd p₁.1 p₂.1 : ℝ))) ≤ ∑ z ∈ J, F z := by
    calc
      _ = ∑ z ∈ U, (Nat.lcm z.1.1 z.2.1 : ℝ)⁻¹ *
          (1 + L / (Nat.gcd z.1.1 z.2.1 : ℝ)) := by
        simp only [U, Finset.sum_filter, Finset.sum_product]
      _ ≤ ∑ z ∈ J, F z := Finset.sum_le_sum_of_injOn e heinj hemem
        (fun x _ => le_of_eq (heweight x)) (fun z _ _ => hF z)
  let H : ℝ := ∑ u ∈ Finset.Icc 1 Q, (u : ℝ)⁻¹
  let G : ℝ := ∑ g ∈ Finset.Icc D Q, (g : ℝ)⁻¹ * (1 + L / (g : ℝ))
  have hH0 : 0 ≤ H := Finset.sum_nonneg fun _ _ => inv_nonneg.mpr (Nat.cast_nonneg _)
  have hG0 : 0 ≤ G := Finset.sum_nonneg fun _ _ => by positivity
  have hH : H ≤ 1 + Real.log (Q : ℝ) := by
    simpa only [H, harmonic_eq_sum_Icc, Rat.cast_sum, Rat.cast_inv,
      Rat.cast_natCast] using harmonic_le_one_add_log Q
  have hG : G ≤ 1 + Real.log (Q : ℝ) + L / ((D - 1 : ℕ) : ℝ) :=
    harmonic_shift_factor_sum_le D Q hD L hL
  have hsep : (∑ z ∈ J, F z) = H ^ 2 * G := by
    calc
      _ = ∑ g ∈ Finset.Icc D Q, ∑ u ∈ Finset.Icc 1 Q, ∑ v ∈ Finset.Icc 1 Q,
          (g : ℝ)⁻¹ * (1 + L / (g : ℝ)) * (u : ℝ)⁻¹ * (v : ℝ)⁻¹ := by
        simp only [J, F, Finset.sum_product]
      _ = ∑ g ∈ Finset.Icc D Q,
          (g : ℝ)⁻¹ * (1 + L / (g : ℝ)) * H * H := by
        apply Finset.sum_congr rfl
        intro g _
        calc
          _ = ∑ u ∈ Finset.Icc 1 Q,
              ((g : ℝ)⁻¹ * (1 + L / (g : ℝ)) * (u : ℝ)⁻¹) * H := by
            apply Finset.sum_congr rfl
            intro u _
            exact (Finset.mul_sum _ _ _).symm
          _ = _ := by rw [← Finset.sum_mul, ← Finset.mul_sum]
      _ = G * H * H := by rw [← Finset.sum_mul, ← Finset.sum_mul]
      _ = _ := by ring
  calc
    _ ≤ ∑ z ∈ J, F z := hrect
    _ = H ^ 2 * G := hsep
    _ ≤ (1 + Real.log (Q : ℝ)) ^ 2 *
        (1 + Real.log (Q : ℝ) + L / ((D - 1 : ℕ) : ℝ)) :=
      mul_le_mul (pow_le_pow_left₀ hH0 hH 2) hG hG0 (sq_nonneg _)

theorem sum_inv_le_two_of_subset_dyadic_Icc
    (I : Finset ℕ) (R : ℕ) (hR : 0 < R)
    (hI : I ⊆ Finset.Icc R (2 * R)) :
    (∑ r ∈ I, (r : ℝ)⁻¹) ≤ 2 := by
  have hRreal : (0 : ℝ) < R := by exact_mod_cast hR
  calc
    _ ≤ ∑ r ∈ Finset.Icc R (2 * R), (r : ℝ)⁻¹ :=
      Finset.sum_le_sum_of_subset_of_nonneg hI
        (fun _ _ _ => inv_nonneg.mpr (Nat.cast_nonneg _))
    _ ≤ ∑ _r ∈ Finset.Icc R (2 * R), (R : ℝ)⁻¹ := by
      apply Finset.sum_le_sum
      intro r hr
      simpa only [one_div] using one_div_le_one_div_of_le hRreal
        (by exact_mod_cast (Finset.mem_Icc.mp hr).1)
    _ = ((R + 1 : ℕ) : ℝ) * (R : ℝ)⁻¹ := by
      rw [Finset.sum_const, nsmul_eq_mul, Nat.card_Icc,
        show 2 * R + 1 - R = R + 1 by omega]
    _ ≤ 2 := by
      rw [← div_eq_mul_inv]
      apply (div_le_iff₀ hRreal).2
      have : (1 : ℝ) ≤ R := by exact_mod_cast hR
      push_cast
      linarith

theorem noncoprimeOffDiagonalZeroMode_norm_le
    (sm : Finset ℕ) (w : ℕ → ℝ) (S : Finset (ℕ × ℕ))
    (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ) (a b₁ b₂ : ℕ)
    (A N R Q D : ℕ) (hR : 0 < R) (hQ : 0 < Q) (hD : 2 ≤ D)
    (hβ : β.support ⊆ Finset.Icc A (A + N))
    (hc : ∀ p ∈ S, ‖c p‖ ≤ 1)
    (hS : ∀ p ∈ S, 1 ≤ p.1 ∧ p.1 ≤ Q ∧ R ≤ p.2 ∧ p.2 ≤ 2 * R ∧
      Nat.Coprime p.1 p.2)
    (hprim : ∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2))
    (hrough : ∀ p ∈ S, ∀ t : ℕ, Nat.Prime t → t ∣ p.1 → D ≤ t) :
    ‖noncoprimeOffDiagonalZeroMode sm w S β c a b₁ b₂‖ ≤
      4 * |∑ m ∈ sm, w m| * (∑ n ∈ β.support, ‖β n‖ ^ 2) *
        (1 + Real.log (Q : ℝ)) ^ 2 *
        (1 + Real.log (Q : ℝ) + ((N / R : ℕ) : ℝ) / ((D - 1 : ℕ) : ℝ)) := by
  classical
  let E : ℝ := ∑ n ∈ β.support, ‖β n‖ ^ 2
  let W : ℝ := |∑ m ∈ sm, w m|
  let K : ℝ := 2 * W * E
  let B : ℝ := (1 + Real.log (Q : ℝ)) ^ 2 *
    (1 + Real.log (Q : ℝ) + ((N / R : ℕ) : ℝ) / ((D - 1 : ℕ) : ℝ))
  have hE : 0 ≤ E := Finset.sum_nonneg fun _ _ => sq_nonneg _
  have hW : 0 ≤ W := abs_nonneg _
  have hK : 0 ≤ K := by dsimp [K]; positivity
  have hlog : 0 ≤ Real.log (Q : ℝ) := Real.log_nonneg (by exact_mod_cast hQ)
  have hB : 0 ≤ B := by dsimp [B]; positivity
  have hpair (r : ℕ) (p₁ : ℕ × ℕ)
      (hp₁ : p₁ ∈ S.filter (fun p => p.2 = r)) (p₂ : ℕ × ℕ)
      (hp₂ : p₂ ∈ S.filter (fun p => p.2 = r ∧ 1 < Nat.gcd p₁.1 p.1)) :
      ‖c p₁ * star (c p₂) *
          ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support.filter (fun n₂ => n₁ ≠ n₂),
            β n₁ * star (β n₂) *
              mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b₁ b₂ n₁ n₂ 0‖ ≤
        K * (r : ℝ)⁻¹ * (Nat.lcm p₁.1 p₂.1 : ℝ)⁻¹ *
          (1 + ((N / R : ℕ) : ℝ) / (Nat.gcd p₁.1 p₂.1 : ℝ)) := by
    have hp₁S := (Finset.mem_filter.mp hp₁).1
    have hp₂S := (Finset.mem_filter.mp hp₂).1
    have hp₁r := (Finset.mem_filter.mp hp₁).2
    have hp₂r := (Finset.mem_filter.mp hp₂).2.1
    have hs₁ := hS p₁ hp₁S
    have hs₂ := hS p₂ hp₂S
    have hq₁ : 0 < p₁.1 := hs₁.1
    have hq₂ : 0 < p₂.1 := hs₂.1
    have hRr : R ≤ r := hp₁r ▸ hs₁.2.2.1
    have hqr₁ : Nat.Coprime p₁.1 r := hp₁r ▸ hs₁.2.2.2.2
    have hqr₂ : Nat.Coprime p₂.1 r := hp₂r ▸ hs₂.2.2.2.2
    have ha : Nat.Coprime a r := by
      have h := (hprim p₁ hp₁S).coprime_mul_right.coprime_mul_right
      exact hp₁r ▸ h.coprime_mul_left_right
    have hb₁ : Nat.Coprime b₁ p₁.1 :=
      (hprim p₁ hp₁S).coprime_mul_right.coprime_mul_left.coprime_mul_right_right
    have hb₂ : Nat.Coprime b₂ p₂.1 :=
      (hprim p₂ hp₂S).coprime_mul_left.coprime_mul_right_right
    have hcprod : ‖c p₁ * star (c p₂)‖ ≤ 1 := by
      rw [norm_mul, norm_star]
      simpa using mul_le_mul (hc p₁ hp₁S) (hc p₂ hp₂S)
        (norm_nonneg _) zero_le_one
    calc
      _ ≤ ‖∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support.filter (fun n₂ => n₁ ≠ n₂),
          β n₁ * star (β n₂) *
            mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b₁ b₂ n₁ n₂ 0‖ := by
        rw [norm_mul]
        exact mul_le_of_le_one_left (norm_nonneg _) hcprod
      _ ≤ _ := mixedFiberFourierCoefficient_offDiagonal_zero_norm_le sm w β A N R
        p₁.1 p₂.1 r a b₁ b₂
        hR hRr hq₁ hq₂ hqr₁ hqr₂ ha hb₁ hb₂ hβ
  have hblock (r : ℕ) :
      (∑ p₁ ∈ S.filter (fun p => p.2 = r),
        ∑ p₂ ∈ S.filter (fun p => p.2 = r ∧ 1 < Nat.gcd p₁.1 p.1),
          (Nat.lcm p₁.1 p₂.1 : ℝ)⁻¹ *
            (1 + ((N / R : ℕ) : ℝ) / (Nat.gcd p₁.1 p₂.1 : ℝ))) ≤ B := by
    have h := rough_moduli_noncoprime_lcm_sum_le (S.filter (fun p => p.2 = r)) r Q D
      ((N / R : ℕ) : ℝ) (Nat.cast_nonneg _) hD
      (fun p hp => ⟨(hS p (Finset.mem_filter.mp hp).1).1,
        (hS p (Finset.mem_filter.mp hp).1).2.1, (Finset.mem_filter.mp hp).2⟩)
      (fun p hp => hrough p (Finset.mem_filter.mp hp).1)
    simpa only [Finset.filter_filter, B] using h
  have hrange : S.image Prod.snd ⊆ Finset.Icc R (2 * R) := by
    intro r hr
    obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hr
    exact Finset.mem_Icc.mpr ⟨(hS p hp).2.2.1, (hS p hp).2.2.2.1⟩
  have hrsum := sum_inv_le_two_of_subset_dyadic_Icc (S.image Prod.snd) R hR hrange
  calc
    ‖noncoprimeOffDiagonalZeroMode sm w S β c a b₁ b₂‖ ≤
        ∑ r ∈ S.image Prod.snd,
          ∑ p₁ ∈ S.filter (fun p => p.2 = r),
            ∑ p₂ ∈ S.filter (fun p => p.2 = r ∧ 1 < Nat.gcd p₁.1 p.1),
              ‖c p₁ * star (c p₂) *
                ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support.filter (fun n₂ => n₁ ≠ n₂),
                  β n₁ * star (β n₂) *
                    mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b₁ b₂ n₁ n₂ 0‖ := by
      unfold noncoprimeOffDiagonalZeroMode
      exact (norm_sum_le _ _).trans (Finset.sum_le_sum fun _ _ =>
        (norm_sum_le _ _).trans (Finset.sum_le_sum fun _ _ => norm_sum_le _ _))
    _ ≤ ∑ r ∈ S.image Prod.snd,
        ∑ p₁ ∈ S.filter (fun p => p.2 = r),
          ∑ p₂ ∈ S.filter (fun p => p.2 = r ∧ 1 < Nat.gcd p₁.1 p.1),
            K * (r : ℝ)⁻¹ * (Nat.lcm p₁.1 p₂.1 : ℝ)⁻¹ *
              (1 + ((N / R : ℕ) : ℝ) / (Nat.gcd p₁.1 p₂.1 : ℝ)) :=
      Finset.sum_le_sum fun r _ => Finset.sum_le_sum fun p₁ hp₁ =>
        Finset.sum_le_sum fun p₂ hp₂ => hpair r p₁ hp₁ p₂ hp₂
    _ = ∑ r ∈ S.image Prod.snd, K * (r : ℝ)⁻¹ *
        (∑ p₁ ∈ S.filter (fun p => p.2 = r),
          ∑ p₂ ∈ S.filter (fun p => p.2 = r ∧ 1 < Nat.gcd p₁.1 p.1),
            (Nat.lcm p₁.1 p₂.1 : ℝ)⁻¹ *
              (1 + ((N / R : ℕ) : ℝ) / (Nat.gcd p₁.1 p₂.1 : ℝ))) := by
      simp only [Finset.mul_sum, mul_assoc]
    _ ≤ ∑ r ∈ S.image Prod.snd, K * (r : ℝ)⁻¹ * B :=
      Finset.sum_le_sum fun r _ => mul_le_mul_of_nonneg_left (hblock r)
        (mul_nonneg hK (inv_nonneg.mpr (Nat.cast_nonneg r)))
    _ = K * B * (∑ r ∈ S.image Prod.snd, (r : ℝ)⁻¹) := by
      rw [Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro r _
      ring
    _ ≤ K * B * 2 := mul_le_mul_of_nonneg_left hrsum (mul_nonneg hK hB)
    _ = _ := by dsimp [K, B, E, W]; ring

theorem sum_norm_sq_le_of_divisor_power_bound (β : ℕ →₀ ℂ) (N k : ℕ) (B H : ℝ)
    (hB : 0 ≤ B) (hH : 0 ≤ H) (hβ : β.support ⊆ Finset.Icc 1 N)
    (henv : ∀ n ∈ β.support,
      ‖β n‖ ≤ B * ((Nat.divisors n).card : ℝ) ^ k * H) :
    (∑ n ∈ β.support, ‖β n‖ ^ 2) ≤
      B ^ 2 * H ^ 2 * (N : ℝ) * (1 + Real.log (N : ℝ)) ^ (2 ^ (2 * k) - 1) := by
  have hBH : 0 ≤ B ^ 2 * H ^ 2 := mul_nonneg (sq_nonneg B) (sq_nonneg H)
  calc
    _ ≤ ∑ n ∈ β.support,
        B ^ 2 * H ^ 2 * ((Nat.divisors n).card : ℝ) ^ (2 * k) := by
      apply Finset.sum_le_sum
      intro n hn
      calc
        ‖β n‖ ^ 2 ≤ (B * ((Nat.divisors n).card : ℝ) ^ k * H) ^ 2 :=
          (sq_le_sq₀ (norm_nonneg _) (mul_nonneg
            (mul_nonneg hB (pow_nonneg (Nat.cast_nonneg _) _)) hH)).2 (henv n hn)
        _ = _ := by
          rw [mul_pow, mul_pow, ← pow_mul, Nat.mul_comm k 2]
          ring
    _ = B ^ 2 * H ^ 2 *
        ∑ n ∈ β.support, ((Nat.divisors n).card : ℝ) ^ (2 * k) := by
      rw [Finset.mul_sum]
    _ ≤ B ^ 2 * H ^ 2 *
        ∑ n ∈ Finset.Icc 1 N, ((Nat.divisors n).card : ℝ) ^ (2 * k) :=
      mul_le_mul_of_nonneg_left
        (Finset.sum_le_sum_of_subset_of_nonneg hβ fun n _ _ =>
          pow_nonneg (Nat.cast_nonneg _) _) hBH
    _ ≤ B ^ 2 * H ^ 2 *
        ((N : ℝ) * (1 + Real.log (N : ℝ)) ^ (2 ^ (2 * k) - 1)) :=
      mul_le_mul_of_nonneg_left
        (sum_card_divisors_pow_le_mul_log_pow (2 * k) N) hBH
    _ = _ := by ring

theorem zero_mode_scale_factorization (W B u ℓ e N R T : ℝ) (d : ℕ)
    (hN : N ≠ 0) (hR : R ≠ 0) :
    4 * W * (B ^ 2 * e ^ 2 * N * (u * ℓ) ^ d) * (u * ℓ) ^ 2 *
        (2 * (u * ℓ) * (1 + (N / R) * T)) =
      (8 * B ^ 2 * u ^ (d + 3)) * (W * N ^ 2 / R) *
        (e ^ 2 * ℓ ^ (d + 3)) * (R / N + T) := by
  simp only [mul_pow, pow_succ, pow_zero]
  field_simp [hR, hN]
  ring

theorem noncoprimeOffDiagonalZeroMode_uniform_log_saving
    (A E κ ε K B η : ℝ) (k : ℕ)
    (hκ : 0 ≤ κ) (hε : 0 < ε) (hK : 0 ≤ K) (hB : 0 ≤ B) (hη : 0 < η) :
    ∀ᶠ x : ℝ in Filter.atTop,
      ∀ (sm : Finset ℕ) (w : ℕ → ℝ) (S : Finset (ℕ × ℕ))
        (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ) (N R Q a b₁ b₂ : ℕ),
        0 < N → 0 < R → 0 < Q →
        β.support ⊆ Finset.Icc 1 N →
        (∀ n ∈ β.support,
          ‖β n‖ ≤ B * ((Nat.divisors n).card : ℝ) ^ k * (Real.log x) ^ E) →
        (∀ p ∈ S, ‖c p‖ ≤ 1) →
        (∀ p ∈ S, 1 ≤ p.1 ∧ p.1 ≤ Q ∧ R ≤ p.2 ∧ p.2 ≤ 2 * R ∧
          Nat.Coprime p.1 p.2) →
        (∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2)) →
        (∀ p ∈ S, ∀ t : ℕ, Nat.Prime t → t ∣ p.1 →
          Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (t : ℝ)) →
        (N : ℝ) ≤ x ^ κ → (Q : ℝ) ≤ x ^ κ →
        (R : ℝ) ≤ K * x ^ (-2 * ε) * (N : ℝ) →
        ‖noncoprimeOffDiagonalZeroMode sm w S β c a b₁ b₂‖ ≤
          η * (|∑ m ∈ sm, w m| * (N : ℝ) ^ 2 / (R : ℝ)) *
            (Real.log x) ^ (-A) := by
  let d : ℕ := 2 ^ (2 * k) - 1
  let C : ℝ := 2 * E + ((d + 3 : ℕ) : ℝ)
  let H : ℝ := 8 * B ^ 2 * (κ + 1) ^ (d + 3)
  have hκ1 : 1 ≤ κ + 1 := by linarith only [hκ]
  have hH : 0 ≤ H := by dsimp [H]; positivity
  have hη' : 0 < η / (H + 1) := div_pos hη (by linarith only [hH])
  have hsmall := initial_zero_frequency_uniform_log_saving A C ε K
    (η / (H + 1)) hε hK hη'
  have hDlim : Filter.Tendsto
      (fun x : ℝ => Real.exp ((Real.log x) ^ (1 / 3 : ℝ)))
      Filter.atTop Filter.atTop :=
    Real.tendsto_exp_atTop.comp
      ((tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 3)).comp
        Real.tendsto_log_atTop)
  filter_upwards [hsmall, Filter.eventually_ge_atTop (Real.exp 1),
    hDlim.eventually (Filter.eventually_ge_atTop (2 : ℝ))] with x hxsmall hxlarge hxD
  intro sm w S β c N R Q a b₁ b₂ hN hR hQ hβ hcoeff hc hS hprim hrough hNx hQx hRN
  let ℓ : ℝ := Real.log x
  let D₀ : ℝ := Real.exp (ℓ ^ (1 / 3 : ℝ))
  let D : ℕ := ⌊D₀⌋₊ + 1
  let V : ℝ := (κ + 1) * ℓ
  let W : ℝ := |∑ m ∈ sm, w m|
  let Z : ℝ := W * (N : ℝ) ^ 2 / (R : ℝ)
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxlarge
  have hℓ : 1 ≤ ℓ := by
    simpa only [ℓ, Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hxlarge
  have hℓpos : 0 < ℓ := zero_lt_one.trans_le hℓ
  have hD₀ : 2 ≤ D₀ := hxD
  have hD₀pos : 0 < D₀ := Real.exp_pos _
  have hNr : (0 : ℝ) < N := by exact_mod_cast hN
  have hRr : (0 : ℝ) < R := by exact_mod_cast hR
  have hQr : (0 : ℝ) < Q := by exact_mod_cast hQ
  have hW : 0 ≤ W := abs_nonneg _
  have hZ : 0 ≤ Z := by dsimp [Z]; positivity
  have hV : 1 ≤ V := one_le_mul_of_one_le_of_one_le hκ1 hℓ
  have hV0 : 0 ≤ V := zero_le_one.trans hV
  have hHN0 : 0 ≤ 1 + Real.log (N : ℝ) := by
    have hn1 : (1 : ℝ) ≤ N := by exact_mod_cast hN
    linarith only [Real.log_nonneg hn1]
  have hHQ0 : 0 ≤ 1 + Real.log (Q : ℝ) := by
    have hq1 : (1 : ℝ) ≤ Q := by exact_mod_cast hQ
    linarith only [Real.log_nonneg hq1]
  have hHN : 1 + Real.log (N : ℝ) ≤ V := by
    have hnlog := Real.log_le_log hNr hNx
    rw [Real.log_rpow hxpos κ] at hnlog
    change 1 + Real.log (N : ℝ) ≤ (κ + 1) * ℓ
    change Real.log (N : ℝ) ≤ κ * ℓ at hnlog
    nlinarith only [hnlog, hℓ]
  have hHQ : 1 + Real.log (Q : ℝ) ≤ V := by
    have hqlog := Real.log_le_log hQr hQx
    rw [Real.log_rpow hxpos κ] at hqlog
    change 1 + Real.log (Q : ℝ) ≤ (κ + 1) * ℓ
    change Real.log (Q : ℝ) ≤ κ * ℓ at hqlog
    nlinarith only [hqlog, hℓ]
  have hfloor1 : 1 ≤ ⌊D₀⌋₊ := (Nat.one_le_floor_iff D₀).2 (by linarith only [hD₀])
  have hD : 2 ≤ D := by dsimp [D]; omega
  have hDen : (0 : ℝ) < ((D - 1 : ℕ) : ℝ) := by
    exact_mod_cast (show 0 < D - 1 by omega)
  have hroughD : ∀ p ∈ S, ∀ t : ℕ, Nat.Prime t → t ∣ p.1 → D ≤ t := by
    intro p hp t ht htp
    exact Nat.succ_le_of_lt ((Nat.floor_lt hD₀pos.le).2 (hrough p hp t ht htp))
  have hcut : (((D - 1 : ℕ) : ℝ))⁻¹ ≤ 2 * D₀⁻¹ := by
    have hf : D₀ < (((D - 1 : ℕ) : ℝ)) + 1 := by
      simpa [D] using Nat.lt_floor_add_one D₀
    have hh : D₀ ≤ 2 * (((D - 1 : ℕ) : ℝ)) := by linarith only [hf, hD₀]
    have hd : (1 : ℝ) / (((D - 1 : ℕ) : ℝ)) ≤ 2 / D₀ :=
      (div_le_div_iff₀ hDen hD₀pos).2 (by simpa using hh)
    simpa only [one_div, div_eq_mul_inv, one_mul] using hd
  have hLD : ((N / R : ℕ) : ℝ) / ((D - 1 : ℕ) : ℝ) ≤
      2 * ((N : ℝ) / (R : ℝ)) * D₀⁻¹ := by
    calc
      _ = ((N / R : ℕ) : ℝ) * (((D - 1 : ℕ) : ℝ))⁻¹ := div_eq_mul_inv _ _
      _ ≤ ((N : ℝ) / (R : ℝ)) * (2 * D₀⁻¹) :=
        mul_le_mul Nat.cast_div_le hcut (inv_nonneg.mpr hDen.le)
          (div_nonneg hNr.le hRr.le)
      _ = _ := by ring
  have hβ0 : β.support ⊆ Finset.Icc 0 (0 + N) := by
    intro n hn
    have hn' := Finset.mem_Icc.mp (hβ hn)
    exact Finset.mem_Icc.mpr ⟨Nat.zero_le n, by simpa using hn'.2⟩
  have henergy := sum_norm_sq_le_of_divisor_power_bound β N k B (ℓ ^ E) hB
    (Real.rpow_nonneg hℓpos.le E) hβ hcoeff
  have henergyV : (∑ n ∈ β.support, ‖β n‖ ^ 2) ≤
      B ^ 2 * (ℓ ^ E) ^ 2 * (N : ℝ) * V ^ d := by
    exact henergy.trans (mul_le_mul_of_nonneg_left
      (pow_le_pow_left₀ hHN0 hHN d) (by positivity))
  have hHQsq : (1 + Real.log (Q : ℝ)) ^ 2 ≤ V ^ 2 :=
    pow_le_pow_left₀ hHQ0 hHQ 2
  have hsecond :
      1 + Real.log (Q : ℝ) + ((N / R : ℕ) : ℝ) / ((D - 1 : ℕ) : ℝ) ≤
        V + 2 * ((N : ℝ) / (R : ℝ)) * D₀⁻¹ := add_le_add hHQ hLD
  have hbig : ‖noncoprimeOffDiagonalZeroMode sm w S β c a b₁ b₂‖ ≤
      4 * W * (B ^ 2 * (ℓ ^ E) ^ 2 * (N : ℝ) * V ^ d) * V ^ 2 *
        (V + 2 * ((N : ℝ) / (R : ℝ)) * D₀⁻¹) := by
    refine (noncoprimeOffDiagonalZeroMode_norm_le sm w S β c a b₁ b₂
      0 N R Q D hR hQ hD hβ0 hc hS hprim hroughD).trans ?_
    exact mul_le_mul
      (mul_le_mul (mul_le_mul_of_nonneg_left henergyV (by positivity))
        hHQsq (sq_nonneg _) (by positivity))
      hsecond (by positivity) (by positivity)
  have hsecond' : V + 2 * ((N : ℝ) / (R : ℝ)) * D₀⁻¹ ≤
      2 * V * (1 + ((N : ℝ) / (R : ℝ)) * D₀⁻¹) := by
    have hz : 0 ≤ ((N : ℝ) / (R : ℝ)) * D₀⁻¹ := by positivity
    nlinarith only [hV, hz, mul_nonneg (sub_nonneg.mpr hV) hz]
  have hpow : ℓ ^ C = (ℓ ^ E) ^ 2 * ℓ ^ (d + 3) := by
    dsimp [C]
    have hEpow : ℓ ^ (2 * E) = (ℓ ^ E) ^ 2 := by
      simpa only [Nat.cast_ofNat, mul_comm E (2 : ℝ)] using
        Real.rpow_mul_natCast hℓpos.le E 2
    rw [Real.rpow_add hℓpos, Real.rpow_natCast, hEpow]
  have hfactor :
      4 * W * (B ^ 2 * (ℓ ^ E) ^ 2 * (N : ℝ) * V ^ d) * V ^ 2 *
          (2 * V * (1 + ((N : ℝ) / (R : ℝ)) * D₀⁻¹)) =
        H * Z * ℓ ^ C * ((R : ℝ) / (N : ℝ) + D₀⁻¹) := by
    rw [hpow]
    exact zero_mode_scale_factorization W B (κ + 1) ℓ (ℓ ^ E) (N : ℝ) (R : ℝ)
      D₀⁻¹ d hNr.ne' hRr.ne'
  have hscaled : ‖noncoprimeOffDiagonalZeroMode sm w S β c a b₁ b₂‖ ≤
      H * Z * ℓ ^ C * ((R : ℝ) / (N : ℝ) + D₀⁻¹) := by
    rw [← hfactor]
    exact hbig.trans (mul_le_mul_of_nonneg_left hsecond' (by positivity))
  have hsave := hxsmall (N : ℝ) (R : ℝ) hNr hRr.le hRN
  have hηbound : H * (η / (H + 1)) ≤ η := by
    rw [← mul_div_assoc]
    apply (div_le_iff₀ (show 0 < H + 1 by linarith only [hH])).2
    nlinarith only [hη]
  calc
    _ ≤ H * Z * ℓ ^ C * ((R : ℝ) / (N : ℝ) + D₀⁻¹) := hscaled
    _ = (H * Z) * (ℓ ^ C * ((R : ℝ) / (N : ℝ) + D₀⁻¹)) := by ring
    _ ≤ (H * Z) * ((η / (H + 1)) * ℓ ^ (-A)) :=
      mul_le_mul_of_nonneg_left hsave (mul_nonneg hH hZ)
    _ = (H * (η / (H + 1))) * Z * ℓ ^ (-A) := by ring
    _ ≤ η * Z * ℓ ^ (-A) :=
      mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_right hηbound hZ)
        (Real.rpow_nonneg hℓpos.le (-A))

theorem noncoprimeOffDiagonalZeroMode_four_sign_uniform_log_saving
    (A E κ ε K B η : ℝ) (k : ℕ)
    (hκ : 0 ≤ κ) (hε : 0 < ε) (hK : 0 ≤ K) (hB : 0 ≤ B) (hη : 0 < η) :
    ∀ᶠ x : ℝ in Filter.atTop,
      ∀ (sm : Finset ℕ) (w : ℕ → ℝ) (S : Finset (ℕ × ℕ))
        (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ) (N R Q a b₁ b₂ : ℕ),
        0 < N → 0 < R → 0 < Q →
        β.support ⊆ Finset.Icc 1 N →
        (∀ n ∈ β.support,
          ‖β n‖ ≤ B * ((Nat.divisors n).card : ℝ) ^ k * (Real.log x) ^ E) →
        (∀ p ∈ S, ‖c p‖ ≤ 1) →
        (∀ p ∈ S, 1 ≤ p.1 ∧ p.1 ≤ Q ∧ R ≤ p.2 ∧ p.2 ≤ 2 * R ∧
          Nat.Coprime p.1 p.2) →
        (∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2)) →
        (∀ p ∈ S, ∀ t : ℕ, Nat.Prime t → t ∣ p.1 →
          Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (t : ℝ)) →
        (N : ℝ) ≤ x ^ κ → (Q : ℝ) ≤ x ^ κ →
        (R : ℝ) ≤ K * x ^ (-2 * ε) * (N : ℝ) →
        ‖noncoprimeOffDiagonalZeroMode sm w S β c a b₁ b₁ -
            noncoprimeOffDiagonalZeroMode sm w S β c a b₁ b₂ -
            noncoprimeOffDiagonalZeroMode sm w S β c a b₂ b₁ +
            noncoprimeOffDiagonalZeroMode sm w S β c a b₂ b₂‖ ≤
          η * (|∑ m ∈ sm, w m| * (N : ℝ) ^ 2 / (R : ℝ)) *
            (Real.log x) ^ (-A) := by
  have hη₄ : 0 < η / 4 := by positivity
  filter_upwards [noncoprimeOffDiagonalZeroMode_uniform_log_saving
    A E κ ε K B (η / 4) k hκ hε hK hB hη₄] with x hx
  intro sm w S β c N R Q a b₁ b₂ hN hR hQ hβ hcoeff hc hS hprim hrough hNx hQx hRN
  have hclasses (p : ℕ × ℕ) (hp : p ∈ S) :
      Nat.Coprime a (p.1 * p.2) ∧ Nat.Coprime b₁ (p.1 * p.2) ∧
        Nat.Coprime b₂ (p.1 * p.2) :=
    ⟨(hprim p hp).coprime_mul_right.coprime_mul_right,
      (hprim p hp).coprime_mul_right.coprime_mul_left,
      (hprim p hp).coprime_mul_left⟩
  have hprim₁₁ : ∀ p ∈ S, Nat.Coprime (a * b₁ * b₁) (p.1 * p.2) := by
    intro p hp
    obtain ⟨ha, hb₁, _⟩ := hclasses p hp
    exact (ha.mul_left hb₁).mul_left hb₁
  have hprim₂₁ : ∀ p ∈ S, Nat.Coprime (a * b₂ * b₁) (p.1 * p.2) := by
    intro p hp
    obtain ⟨ha, hb₁, hb₂⟩ := hclasses p hp
    exact (ha.mul_left hb₂).mul_left hb₁
  have hprim₂₂ : ∀ p ∈ S, Nat.Coprime (a * b₂ * b₂) (p.1 * p.2) := by
    intro p hp
    obtain ⟨ha, _, hb₂⟩ := hclasses p hp
    exact (ha.mul_left hb₂).mul_left hb₂
  let V : ℝ := (η / 4) * (|∑ m ∈ sm, w m| * (N : ℝ) ^ 2 / (R : ℝ)) *
    (Real.log x) ^ (-A)
  have h₁₁ : ‖noncoprimeOffDiagonalZeroMode sm w S β c a b₁ b₁‖ ≤ V :=
    hx sm w S β c N R Q a b₁ b₁ hN hR hQ hβ hcoeff hc hS hprim₁₁
      hrough hNx hQx hRN
  have h₁₂ : ‖noncoprimeOffDiagonalZeroMode sm w S β c a b₁ b₂‖ ≤ V :=
    hx sm w S β c N R Q a b₁ b₂ hN hR hQ hβ hcoeff hc hS hprim
      hrough hNx hQx hRN
  have h₂₁ : ‖noncoprimeOffDiagonalZeroMode sm w S β c a b₂ b₁‖ ≤ V :=
    hx sm w S β c N R Q a b₂ b₁ hN hR hQ hβ hcoeff hc hS hprim₂₁
      hrough hNx hQx hRN
  have h₂₂ : ‖noncoprimeOffDiagonalZeroMode sm w S β c a b₂ b₂‖ ≤ V :=
    hx sm w S β c N R Q a b₂ b₂ hN hR hQ hβ hcoeff hc hS hprim₂₂
      hrough hNx hQx hRN
  calc
    _ ≤ V + V + V + V :=
      norm_add_le_of_le (norm_sub_le_of_le (norm_sub_le_of_le h₁₁ h₁₂) h₂₁) h₂₂
    _ = _ := by dsimp only [V]; ring

theorem compactProfile_noncoprimeOffDiagonalZeroMode_four_sign_log_saving
    (A E F κ ε K B T Cψ η : ℝ) (k : ℕ)
    (hκ : 0 ≤ κ) (hε : 0 < ε) (hK : 0 ≤ K) (hB : 0 ≤ B)
    (hT : 0 ≤ T) (hCψ : 0 ≤ Cψ) (hη : 0 < η) :
    ∀ᶠ x : ℝ in Filter.atTop,
      ∀ (sm : Finset ℕ) (S : Finset (ℕ × ℕ))
        (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ) (M t₀ : ℝ) (ψ : ℝ → ℝ)
        (N R Q a b₁ b₂ : ℕ),
        1 ≤ M → ContDiff ℝ 2 ψ →
        Function.support ψ ⊆ Set.Icc (-T) T →
        (∀ t : ℝ,
          |ψ t| ≤ Cψ * (Real.log x) ^ F ∧
          |deriv ψ t| ≤ Cψ * (Real.log x) ^ F ∧
          |deriv (deriv ψ) t| ≤ Cψ * (Real.log x) ^ F) →
        0 < N → 0 < R → 0 < Q →
        β.support ⊆ Finset.Icc 1 N →
        (∀ n ∈ β.support,
          ‖β n‖ ≤ B * ((Nat.divisors n).card : ℝ) ^ k * (Real.log x) ^ E) →
        (∀ p ∈ S, ‖c p‖ ≤ 1) →
        (∀ p ∈ S, 1 ≤ p.1 ∧ p.1 ≤ Q ∧ R ≤ p.2 ∧ p.2 ≤ 2 * R ∧
          Nat.Coprime p.1 p.2) →
        (∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2)) →
        (∀ p ∈ S, ∀ t : ℕ, Nat.Prime t → t ∣ p.1 →
          Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (t : ℝ)) →
        (N : ℝ) ≤ x ^ κ → (Q : ℝ) ≤ x ^ κ →
        (R : ℝ) ≤ K * x ^ (-2 * ε) * (N : ℝ) →
        let w : ℕ → ℝ := fun n => ψ (((n : ℝ) - t₀) / M)
        ‖noncoprimeOffDiagonalZeroMode sm w S β c a b₁ b₁ -
            noncoprimeOffDiagonalZeroMode sm w S β c a b₁ b₂ -
            noncoprimeOffDiagonalZeroMode sm w S β c a b₂ b₁ +
            noncoprimeOffDiagonalZeroMode sm w S β c a b₂ b₂‖ ≤
          η * (M * (N : ℝ) ^ 2 / (R : ℝ)) * (Real.log x) ^ (-A) := by
  let C₀ : ℝ := (2 * T + 1) * Cψ
  have hC₀ : 0 ≤ C₀ := by dsimp [C₀]; positivity
  have hden : 0 < C₀ + 1 := by linarith only [hC₀]
  let δ : ℝ := η / (C₀ + 1)
  have hδ : 0 < δ := div_pos hη hden
  have hδC : δ * C₀ ≤ η := by
    dsimp only [δ]
    rw [div_mul_eq_mul_div, div_le_iff₀ hden]
    nlinarith
  have hmain := noncoprimeOffDiagonalZeroMode_four_sign_uniform_log_saving
    (A + F) E κ ε K B δ k hκ hε hK hB hδ
  filter_upwards [hmain, Filter.eventually_gt_atTop (1 : ℝ)] with x hx hx1
  intro sm S β c M t₀ ψ N R Q a b₁ b₂ hM hψ hsupport hprofile
    hN hR hQ hβ hcoeff hc hS hprim hrough hNx hQx hRN
  let w : ℕ → ℝ := fun n => ψ (((n : ℝ) - t₀) / M)
  have hMpos : 0 < M := zero_lt_one.trans_le hM
  have hRr : (0 : ℝ) < R := by exact_mod_cast hR
  have hlog : 0 < Real.log x := Real.log_pos hx1
  have hL : 0 ≤ Cψ * (Real.log x) ^ F :=
    mul_nonneg hCψ (Real.rpow_nonneg hlog.le F)
  have hmass := (compactProfile_natural_sample_mass_le
    sm T (Cψ * (Real.log x) ^ F) M t₀ hT hL hMpos ψ hψ hsupport hprofile).2.2 hM
  have hW : |∑ m ∈ sm, w m| ≤ C₀ * M * (Real.log x) ^ F := by
    calc
      _ ≤ (2 * T + 1) * (Cψ * (Real.log x) ^ F) * M := hmass
      _ = _ := by dsimp [C₀]; ring
  have hfour := hx sm w S β c N R Q a b₁ b₂ hN hR hQ
    hβ hcoeff hc hS hprim hrough hNx hQx hRN
  have hpow : (Real.log x) ^ F * (Real.log x) ^ (-(A + F)) =
      (Real.log x) ^ (-A) := by
    rw [← Real.rpow_add hlog]
    congr 1
    ring
  have hscale : 0 ≤ M * (N : ℝ) ^ 2 / (R : ℝ) := by positivity
  calc
    _ ≤ δ * (|∑ m ∈ sm, w m| * (N : ℝ) ^ 2 / (R : ℝ)) *
        (Real.log x) ^ (-(A + F)) := hfour
    _ ≤ δ * ((C₀ * M * (Real.log x) ^ F) * (N : ℝ) ^ 2 / (R : ℝ)) *
        (Real.log x) ^ (-(A + F)) :=
      mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_left
          (div_le_div_of_nonneg_right
            (mul_le_mul_of_nonneg_right hW (sq_nonneg _)) hRr.le) hδ.le)
        (Real.rpow_nonneg hlog.le (-(A + F)))
    _ = (δ * C₀) * (M * (N : ℝ) ^ 2 / (R : ℝ)) *
        (Real.log x) ^ (-A) := by
      rw [← hpow]
      ring
    _ ≤ η * (M * (N : ℝ) ^ 2 / (R : ℝ)) * (Real.log x) ^ (-A) :=
      mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_right hδC hscale)
        (Real.rpow_nonneg hlog.le (-A))

/--
The zero-frequency contribution from distinct support indices of `β`, summed over all pairs in
`S` with the same second component. Both the modulus coefficients and sequence coefficients
enter as conjugate products.
-/
noncomputable def offDiagonalZeroMode (sm : Finset ℕ) (w : ℕ → ℝ)
    (S : Finset (ℕ × ℕ)) (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ)
    (a b₁ b₂ : ℕ) : ℂ :=
  ∑ r ∈ S.image Prod.snd,
    ∑ p₁ ∈ S.filter (fun p => p.2 = r),
      ∑ p₂ ∈ S.filter (fun p => p.2 = r),
        c p₁ * star (c p₂) *
          ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support.filter (fun n₂ => n₁ ≠ n₂),
            β n₁ * star (β n₂) *
              mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b₁ b₂ n₁ n₂ 0

theorem mixedFiberFourierCoefficient_zero_of_coprime
    (sm : Finset ℕ) (w : ℕ → ℝ)
    (q₁ q₂ r a b₁ b₂ n₁ n₂ : ℕ)
    [NeZero q₁] [NeZero q₂] [NeZero r]
    (hq : Nat.Coprime q₁ q₂)
    (hqr₁ : Nat.Coprime q₁ r) (hqr₂ : Nat.Coprime q₂ r)
    (ha : Nat.Coprime a r) (hb₁ : Nat.Coprime b₁ q₁)
    (hb₂ : Nat.Coprime b₂ q₂) :
    mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂ 0 =
      if Nat.Coprime n₁ (q₁ * r) ∧ Nat.Coprime n₂ (q₂ * r) ∧
          Nat.ModEq r n₁ n₂
      then (∑ m ∈ sm, (w m : ℂ)) / ((r * q₁ * q₂ : ℕ) : ℂ)
      else 0 := by
  simpa [hq.gcd_eq_one, Nat.modEq_one, hq.lcm_eq_mul, Nat.mul_assoc] using
    (mixedFiberFourierCoefficient_zero_and_sum sm w q₁ q₂ r a b₁ b₂ n₁ n₂
      hqr₁ hqr₂ ha hb₁ hb₂).1

theorem coprimeOffDiagonalZeroMode_independent_and_four_sign_zero
    (sm : Finset ℕ) (w : ℕ → ℝ) (S : Finset (ℕ × ℕ))
    (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ) (a b₁ b₂ : ℕ)
    (hS : ∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Nat.Coprime p.1 p.2)
    (hprim : ∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2)) :
    let Z : ℕ → ℕ → ℂ := fun u v =>
      ∑ r ∈ S.image Prod.snd,
        ∑ p₁ ∈ S.filter (fun p => p.2 = r),
          ∑ p₂ ∈ S.filter (fun p => p.2 = r ∧ Nat.gcd p₁.1 p.1 = 1),
            c p₁ * star (c p₂) *
              ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support.filter (fun n₂ => n₁ ≠ n₂),
                β n₁ * star (β n₂) *
                  mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a u v n₁ n₂ 0
    let X : ℂ :=
      ∑ r ∈ S.image Prod.snd,
        ∑ p₁ ∈ S.filter (fun p => p.2 = r),
          ∑ p₂ ∈ S.filter (fun p => p.2 = r ∧ Nat.gcd p₁.1 p.1 = 1),
            c p₁ * star (c p₂) *
              ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support.filter (fun n₂ => n₁ ≠ n₂),
                β n₁ * star (β n₂) *
                  (if Nat.Coprime n₁ (p₁.1 * r) ∧
                      Nat.Coprime n₂ (p₂.1 * r) ∧ Nat.ModEq r n₁ n₂
                    then (∑ m ∈ sm, (w m : ℂ)) / ((r * p₁.1 * p₂.1 : ℕ) : ℂ)
                    else 0)
    (∀ u v : ℕ,
      (∀ p ∈ S, Nat.Coprime (a * u * v) (p.1 * p.2)) → Z u v = X) ∧
      (Z b₁ b₁ - Z b₁ b₂ - Z b₂ b₁ + Z b₂ b₂ = 0) := by
  intro Z X
  have hind (u v : ℕ)
      (huv : ∀ p ∈ S, Nat.Coprime (a * u * v) (p.1 * p.2)) : Z u v = X := by
    apply Finset.sum_congr rfl
    intro r _
    apply Finset.sum_congr rfl
    intro p₁ hp₁
    rcases Finset.mem_filter.mp hp₁ with ⟨hp₁S, hp₁r⟩
    apply Finset.sum_congr rfl
    intro p₂ hp₂
    rcases Finset.mem_filter.mp hp₂ with ⟨hp₂S, hp₂r, hg⟩
    have h₁ := hS p₁ hp₁S
    have h₂ := hS p₂ hp₂S
    have hprim₁ := huv p₁ hp₁S
    have hprim₂ := huv p₂ hp₂S
    rw [hp₁r] at h₁ hprim₁
    rw [hp₂r] at h₂ hprim₂
    have := NeZero.of_pos h₁.1
    have := NeZero.of_pos h₂.1
    have := NeZero.of_pos h₁.2.1
    simp_rw [mixedFiberFourierCoefficient_zero_of_coprime sm w p₁.1 p₂.1 r a u v _ _
      hg h₁.2.2 h₂.2.2
      hprim₁.coprime_mul_right.coprime_mul_right.coprime_mul_left_right
      hprim₁.coprime_mul_right.coprime_mul_left.coprime_mul_right_right
      hprim₂.coprime_mul_left.coprime_mul_right_right]
  refine ⟨hind, ?_⟩
  simp [hind b₁ b₁ (fun p hp =>
      let h := hprim p hp
      h.coprime_mul_right.mul_left h.coprime_mul_right.coprime_mul_left),
    hind b₁ b₂ hprim,
    hind b₂ b₁ (fun p hp => by
      simpa only [Nat.mul_right_comm] using hprim p hp),
    hind b₂ b₂ (fun p hp =>
      let h := hprim p hp
      (h.coprime_mul_right.coprime_mul_right.mul_left h.coprime_mul_left).mul_left
        h.coprime_mul_left)]

theorem offDiagonalZeroMode_four_sign_eq_noncoprime
    (sm : Finset ℕ) (w : ℕ → ℝ) (S : Finset (ℕ × ℕ))
    (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ) (a b₁ b₂ : ℕ)
    (hS : ∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Nat.Coprime p.1 p.2)
    (hprim : ∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2)) :
    offDiagonalZeroMode sm w S β c a b₁ b₁ -
        offDiagonalZeroMode sm w S β c a b₁ b₂ -
        offDiagonalZeroMode sm w S β c a b₂ b₁ +
        offDiagonalZeroMode sm w S β c a b₂ b₂ =
      noncoprimeOffDiagonalZeroMode sm w S β c a b₁ b₁ -
        noncoprimeOffDiagonalZeroMode sm w S β c a b₁ b₂ -
        noncoprimeOffDiagonalZeroMode sm w S β c a b₂ b₁ +
        noncoprimeOffDiagonalZeroMode sm w S β c a b₂ b₂ := by
  let Z : ℕ → ℕ → ℂ := fun u v =>
    ∑ r ∈ S.image Prod.snd,
      ∑ p₁ ∈ S.filter (fun p => p.2 = r),
        ∑ p₂ ∈ S.filter (fun p => p.2 = r ∧ Nat.gcd p₁.1 p.1 = 1),
          c p₁ * star (c p₂) *
            ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support.filter (fun n₂ => n₁ ≠ n₂),
              β n₁ * star (β n₂) *
                mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a u v n₁ n₂ 0
  have hsplit (u v : ℕ) :
      offDiagonalZeroMode sm w S β c a u v =
        Z u v + noncoprimeOffDiagonalZeroMode sm w S β c a u v := by
    unfold offDiagonalZeroMode noncoprimeOffDiagonalZeroMode
    dsimp only [Z]
    simp_rw [← Finset.sum_add_distrib]
    apply Finset.sum_congr rfl
    intro r _
    apply Finset.sum_congr rfl
    intro p₁ hp₁
    rw [← Finset.sum_filter_add_sum_filter_not
      (S.filter (fun p => p.2 = r)) (fun p => Nat.gcd p₁.1 p.1 = 1)]
    simp [Finset.filter_filter, Nat.one_lt_iff_ne_zero_and_ne_one,
      Nat.ne_of_gt (hS p₁ (Finset.mem_filter.mp hp₁).1).1]
  simp only [hsplit]
  linear_combination
    (coprimeOffDiagonalZeroMode_independent_and_four_sign_zero
      sm w S β c a b₁ b₂ hS hprim).2

section
open scoped FourierTransform SchwartzMap ContDiff RealInnerProductSpace
open Classical in
theorem compactProfile_nat_sampling_boundary
    (sm : Finset ℕ) (w : ℕ → ℝ) (T M t₀ : ℝ)
    (hT : 0 ≤ T) (hM : 0 < M) (ψ : ℝ → ℂ)
    (hsupport : Function.support ψ ⊆ Set.Icc (-T) T) :
    let f : ℝ → ℂ := fun t => ψ ((t - t₀) / M)
    let A : ℤ := ⌈t₀ - T * M⌉
    let K : ℕ := (⌊t₀ + T * M⌋ + 1 - A).toNat
    let J : Finset ℕ := (Finset.range K).filter
      (fun j => A + (j : ℤ) < 0 ∨ (A + (j : ℤ)).toNat ∉ sm)
    ∀ (q : ℕ) (F : ZMod q → ℂ),
      (∑ n ∈ sm, (w n : ℂ) * F (n : ZMod q)) =
        (∑ j ∈ Finset.range K,
          f ((A : ℝ) + (j : ℝ)) * F ((A + (j : ℤ) : ℤ) : ZMod q)) +
        (∑ n ∈ sm, ((w n : ℂ) - f (n : ℝ)) * F (n : ZMod q)) -
        ∑ j ∈ J,
          f ((A : ℝ) + (j : ℝ)) * F ((A + (j : ℤ) : ℤ) : ZMod q) := by
  intro f A K J q F
  let B : ℤ := ⌊t₀ + T * M⌋
  let g : ℕ → ℂ := fun j =>
    f ((A : ℝ) + (j : ℝ)) * F ((A + (j : ℤ) : ℤ) : ZMod q)
  let G : Finset ℕ := (Finset.range K).filter
    (fun j => ¬ (A + (j : ℤ) < 0 ∨ (A + (j : ℤ)).toNat ∉ sm))
  have hAB : A ≤ B + 1 :=
    (Int.ceil_mono (show t₀ - T * M ≤ t₀ + T * M by
      nlinarith [mul_nonneg hT hM.le])).trans (Int.ceil_le_floor_add_one _)
  have hK : (K : ℤ) = B + 1 - A := Int.toNat_of_nonneg (by omega)
  have hsample (z : ℤ) (hz : f (z : ℝ) ≠ 0) : A ≤ z ∧ z ≤ B := by
    have h := hsupport hz
    constructor
    · apply Int.ceil_le.mpr
      linarith [(le_div_iff₀ hM).mp h.1]
    · apply Int.le_floor.mpr
      linarith [(div_le_iff₀ hM).mp h.2]
  have hgood (j : ℕ) (hj : j ∈ G) :
      0 ≤ A + (j : ℤ) ∧ (A + (j : ℤ)).toNat ∈ sm := by
    simpa only [not_or, not_lt, not_not] using (Finset.mem_filter.mp hj).2
  have hpoint (j : ℕ) (hj : 0 ≤ A + (j : ℤ)) :
      g j = f (((A + (j : ℤ)).toNat : ℕ) : ℝ) *
        F ((A + (j : ℤ)).toNat : ZMod q) := by
    simpa only [g, Int.cast_add, Int.cast_natCast] using
      congrArg (fun z : ℤ => f (z : ℝ) * F (z : ZMod q)) (Int.toNat_of_nonneg hj).symm
  have hcore : (∑ j ∈ G, g j) = ∑ n ∈ sm, f (n : ℝ) * F (n : ZMod q) := by
    refine Finset.sum_bij_ne_zero (fun j _ _ => (A + (j : ℤ)).toNat)
      ?_ ?_ ?_ ?_
    · intro j hj _
      exact (hgood j hj).2
    · intro j₁ hj₁ _ j₂ hj₂ _ he
      have h₁ := Int.toNat_of_nonneg (hgood j₁ hj₁).1
      have h₂ := Int.toNat_of_nonneg (hgood j₂ hj₂).1
      omega
    · intro n hn hn₀
      have hnI : A ≤ (n : ℤ) ∧ (n : ℤ) ≤ B :=
        hsample n (by simpa only [Int.cast_natCast] using left_ne_zero_of_mul hn₀)
      let j : ℕ := ((n : ℤ) - A).toNat
      have hjeq : A + (j : ℤ) = (n : ℤ) := by
        simp only [j, Int.toNat_of_nonneg (sub_nonneg.mpr hnI.1), add_sub_cancel]
      have hjrange : j ∈ Finset.range K := Finset.mem_range.mpr (by omega)
      have hjnonneg : 0 ≤ A + (j : ℤ) := by omega
      have hjnat : (A + (j : ℤ)).toNat = n := by rw [hjeq]; simp
      have hjG : j ∈ G := by
        apply Finset.mem_filter.mpr
        refine ⟨hjrange, ?_⟩
        rw [hjnat]
        exact not_or.mpr ⟨not_lt.mpr hjnonneg, not_not.mpr hn⟩
      refine ⟨j, hjG, ?_, hjnat⟩
      simpa only [hpoint j hjnonneg, hjnat] using hn₀
    · intro j hj _
      exact hpoint j (hgood j hj).1
  have hsplit : (∑ j ∈ J, g j) + (∑ j ∈ G, g j) =
      ∑ j ∈ Finset.range K, g j :=
    Finset.sum_filter_add_sum_filter_not (Finset.range K)
      (fun j => A + (j : ℤ) < 0 ∨ (A + (j : ℤ)).toNat ∉ sm) g
  rw [hcore] at hsplit
  rw [← hsplit]
  simp only [sub_mul, Finset.sum_sub_distrib]
  ring

open Classical in
theorem positiveCompactProfile_complete_nat_sampling
    (c T M : ℝ) (hc : 0 < c) (hcT : c ≤ T) (hM : 0 < M)
    (ψ : ℝ → ℝ) (hsupport : Function.support ψ ⊆ Set.Icc c T) :
    let sm : Finset ℕ := Finset.Icc 1 ⌊T * M⌋₊
    let w : ℕ → ℝ := fun n => ψ ((n : ℝ) / M)
    ∀ z : ℤ,
      (if 0 ≤ z ∧ z.toNat ∈ sm then (w z.toNat : ℂ) else 0) =
        (ψ ((z : ℝ) / M) : ℂ) := by
  dsimp only
  intro z
  split_ifs with hz
  · have hcast : (z.toNat : ℝ) = (z : ℝ) := by
      exact_mod_cast Int.toNat_of_nonneg hz.1
    rw [hcast]
  · symm
    apply Complex.ofReal_eq_zero.mpr
    by_contra hne
    have hs := hsupport hne
    have hzpos : 0 < (z : ℝ) :=
      (mul_pos hc hM).trans_le ((le_div_iff₀ hM).mp hs.1)
    have hzi : 0 < z := by exact_mod_cast hzpos
    apply hz
    refine ⟨hzi.le, Finset.mem_Icc.mpr ⟨by omega, ?_⟩⟩
    apply (Nat.le_floor_iff (mul_nonneg (hc.le.trans hcT) hM.le)).mpr
    have hcast : (z.toNat : ℝ) = (z : ℝ) := by
      exact_mod_cast Int.toNat_of_nonneg hzi.le
    rw [hcast]
    exact (div_le_iff₀ hM).mp hs.2

open Classical in
theorem mixedFiberMass_centered_smooth_truncation
    (k : ℕ) (sm : Finset ℕ) (w : ℕ → ℝ) (T L M t₀ H : ℝ)
    (hT : 0 ≤ T) (hL : 0 ≤ L) (hM : 0 < M) (hH : 0 ≤ H)
    (ψ : ℝ → ℂ) (hψ : ContDiff ℝ ∞ ψ)
    (hsupport : Function.support ψ ⊆ Set.Icc (-T) T)
    (hbound : ∀ t : ℝ, ‖ψ t‖ ≤ L ∧ ‖iteratedDeriv (k + 2) ψ t‖ ≤ L)
    (q₁ q₂ r a b₁ b₂ n₁ n₂ : ℕ) [NeZero q₁] [NeZero q₂] [NeZero r]
    (hqr₁ : Nat.Coprime q₁ r) (hqr₂ : Nat.Coprime q₂ r)
    (ha : Nat.Coprime a r) (hb₁ : Nat.Coprime b₁ q₁)
    (hb₂ : Nat.Coprime b₂ q₂) :
    let f : ℝ → ℂ := fun t => ψ ((t - t₀) / M)
    let A : ℤ := ⌈t₀ - T * M⌉
    let K : ℕ := (⌊t₀ + T * M⌋ + 1 - A).toNat
    let J : Finset ℕ := (Finset.range K).filter
      (fun j => A + (j : ℤ) < 0 ∨ (A + (j : ℤ)).toNat ∉ sm)
    let E : ℝ := (∑ n ∈ sm, ‖(w n : ℂ) - f (n : ℝ)‖) +
      ∑ j ∈ J, ‖f ((A : ℝ) + (j : ℝ))‖
    let P : ℕ := r * Nat.lcm q₁ q₂
    let S : Finset ℕ := (Finset.range P).filter
      (fun h => h ≠ 0 ∧ |((h : ZMod P).valMinAbs : ℝ)| ≤ H)
    let C : ℝ := (2 : ℝ) ^ (k + 4) * T * L /
      (1 + (M / (P : ℝ)) * H) ^ k
    ‖(mixedFiberMass sm w q₁ q₂ r a b₁ b₂ n₁ n₂ : ℂ) -
        (mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂ 0 +
          ∑ h ∈ S,
            mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂ h)‖ ≤
      if Nat.Coprime n₁ (q₁ * r) ∧ Nat.Coprime n₂ (q₂ * r) ∧
          Nat.ModEq r n₁ n₂ ∧
          Nat.ModEq (Nat.gcd q₁ q₂) (b₁ * n₂) (b₂ * n₁)
      then C + 2 * E else 0 := by
  intro f A K J E P S C
  have hP : P ≠ 0 := Nat.mul_ne_zero (NeZero.ne r)
    (Nat.lcm_ne_zero (NeZero.ne q₁) (NeZero.ne q₂))
  let _ : NeZero P := ⟨hP⟩
  have hPR : 0 < (P : ℝ) := Nat.cast_pos.mpr (NeZero.pos P)
  have hE : 0 ≤ E := add_nonneg
    (Finset.sum_nonneg fun _ _ => norm_nonneg _)
    (Finset.sum_nonneg fun _ _ => norm_nonneg _)
  by_cases hg : Nat.Coprime n₁ (q₁ * r) ∧ Nat.Coprime n₂ (q₂ * r) ∧
      Nat.ModEq r n₁ n₂ ∧
      Nat.ModEq (Nat.gcd q₁ q₂) (b₁ * n₂) (b₂ * n₁)
  · rw [ite_eq_left hg]
    obtain ⟨t, ⟨ht, _, hcr, hc₁, _, hc₂⟩, _⟩ :=
      mixedFiber_progression_residue_exists_unique q₁ q₂ r a b₁ b₂ n₁ n₂
        hqr₁ hqr₂ ha hb₁ hb₂ hg.1 hg.2.1 hg.2.2.1 hg.2.2.2
    have hsingle : mixedFiber (Finset.range P) q₁ q₂ r a b₁ b₂ n₁ n₂ = {t} := by
      rw [(mixedFiberMass_progression_fourier (Finset.range P) w q₁ q₂ r a b₁ b₂
        n₁ n₂ hqr₁ hqr₂ ha hb₁ hb₂ hg.1 hg.2.1 hg.2.2.1 t hcr hc₁ hc₂).1]
      ext m
      simp only [Finset.mem_filter, Finset.mem_range, Finset.mem_singleton]
      constructor
      · rintro ⟨hm, hmt⟩
        exact hmt.eq_of_lt_of_lt hm ht
      · rintro rfl
        exact ⟨ht, rfl⟩
    let b : ℕ → ℂ := fun j => f ((A : ℝ) + (j : ℝ))
    let W : ZMod P → ℂ := integerIntervalResidueWeight P A K b
    let B : ZMod P → ℂ := fun ξ =>
      ∑ n ∈ sm, (w n : ℂ) * ZMod.stdAddChar (-((n : ZMod P) * ξ))
    let v : ℕ → ℂ :=
      mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂
    let D : Finset ℕ := (Finset.range P).filter
      (fun h => H < |((h : ZMod P).valMinAbs : ℝ)|)
    have hdiff (ξ : ZMod P) : ‖B ξ - ZMod.dft W ξ‖ ≤ E := by
      let F : ZMod P → ℂ := fun z => ZMod.stdAddChar (-(z * ξ))
      let U : ℂ := ∑ n ∈ sm, ((w n : ℂ) - f (n : ℝ)) * F (n : ZMod P)
      let V : ℂ := ∑ j ∈ J, b j * F ((A + (j : ℤ) : ℤ) : ZMod P)
      have hb := compactProfile_nat_sampling_boundary sm w T M t₀ hT hM ψ hsupport P F
      have hd := (integerIntervalResidueWeight_spec P A K b).2.1 ξ
      rw [← hd] at hb
      change B ξ = ZMod.dft W ξ + U - V at hb
      have hU : ‖U‖ ≤ ∑ n ∈ sm, ‖(w n : ℂ) - f (n : ℝ)‖ := by
        apply norm_sum_le_of_le sm
        intro n _
        simp only [F, norm_mul, AddChar.norm_apply, mul_one, le_refl]
      have hV : ‖V‖ ≤ ∑ j ∈ J, ‖b j‖ := by
        apply norm_sum_le_of_le J
        intro j _
        simp only [F, norm_mul, AddChar.norm_apply, mul_one, le_refl]
      calc
        ‖B ξ - ZMod.dft W ξ‖ = ‖U - V‖ := by rw [hb]; congr 1; ring
        _ ≤ ‖U‖ + ‖V‖ := norm_sub_le _ _
        _ ≤ E := add_le_add hU hV
    have hcoef (h : ℕ) :
        v h = (P : ℂ)⁻¹ * B (h : ZMod P) *
          ZMod.stdAddChar ((t : ZMod P) * (h : ZMod P)) := by
      dsimp only [v, B]
      dsimp only [P] at hP hsingle ⊢
      simp only [mixedFiberFourierCoefficient, dite_eq_right hP, hsingle,
        Finset.sum_singleton]
    have hnorm (h : ℕ) :
        ‖v h‖ ≤ (P : ℝ)⁻¹ * (‖ZMod.dft W (h : ZMod P)‖ + E) := by
      rw [hcoef]
      simp only [norm_mul, norm_inv, Complex.norm_natCast, AddChar.norm_apply, mul_one]
      apply mul_le_mul_of_nonneg_left _ (inv_nonneg.mpr hPR.le)
      exact (norm_le_norm_add_norm_sub' (B (h : ZMod P))
        (ZMod.dft W (h : ZMod P))).trans
          (add_le_add le_rfl (hdiff (h : ZMod P)))
    have hS : ((Finset.range P).erase 0).filter
        (fun h : ℕ => |((h : ZMod P).valMinAbs : ℝ)| ≤ H) = S := by
      ext h
      simp only [S, Finset.mem_filter, Finset.mem_erase, and_assoc, and_left_comm]
    have hD : ((Finset.range P).erase 0).filter
        (fun h : ℕ => H < |((h : ZMod P).valMinAbs : ℝ)|) = D := by
      rw [Finset.filter_erase]
      exact Finset.erase_eq_of_notMem (by simp [not_lt.mpr hH])
    have hsplit := Finset.sum_filter_add_sum_filter_not ((Finset.range P).erase 0)
      (fun h => |((h : ZMod P).valMinAbs : ℝ)| ≤ H) v
    simp only [not_le, hS, hD] at hsplit
    have hsum := (mixedFiberFourierCoefficient_zero_and_sum sm w q₁ q₂ r a b₁ b₂ n₁ n₂
      hqr₁ hqr₂ ha hb₁ hb₂).2
    have herr :
        (mixedFiberMass sm w q₁ q₂ r a b₁ b₂ n₁ n₂ : ℂ) -
            (v 0 + ∑ h ∈ S, v h) = ∑ h ∈ D, v h := by
      rw [hsum, ← Finset.add_sum_erase (Finset.range P) v
        (Finset.mem_range.mpr (NeZero.pos P)), ← hsplit]
      ring
    have htail_reindex :
        (∑ ξ ∈ (Finset.univ : Finset (ZMod P)).filter
          (fun ξ => H < |(ξ.valMinAbs : ℝ)|), ‖ZMod.dft W ξ‖) =
          ∑ h ∈ D, ‖ZMod.dft W (h : ZMod P)‖ := by
      simp only [D, Finset.sum_filter]
      simpa only [Complex.re_sum, apply_ite, Complex.ofReal_re, Complex.zero_re] using
        congrArg Complex.re (sum_zmod_eq_sum_range_natCast P (fun ξ =>
          if H < |(ξ.valMinAbs : ℝ)| then (‖ZMod.dft W ξ‖ : ℂ) else 0))
    obtain ⟨htail, hmass, _⟩ :=
      compactProfile_centered_fourier_truncation k P T L M t₀ H
        hT hL hM hH ψ hψ hsupport hbound
    have hsmall : (P : ℝ)⁻¹ * ∑ h ∈ D, ‖ZMod.dft W (h : ZMod P)‖ ≤ C := by
      rw [← htail_reindex]
      simpa only [one_div] using htail.trans hmass
    have hcard : (D.card : ℝ) ≤ (P : ℝ) := by
      exact_mod_cast (Finset.card_filter_le (Finset.range P) _).trans (Finset.card_range P).le
    rw [herr]
    calc
      ‖∑ h ∈ D, v h‖ ≤ ∑ h ∈ D, ‖v h‖ := norm_sum_le _ _
      _ ≤ ∑ h ∈ D, (P : ℝ)⁻¹ * (‖ZMod.dft W (h : ZMod P)‖ + E) :=
        Finset.sum_le_sum fun h _ => hnorm h
      _ = (P : ℝ)⁻¹ * (∑ h ∈ D, ‖ZMod.dft W (h : ZMod P)‖) +
          ((D.card : ℝ) / (P : ℝ)) * E := by
        rw [← Finset.mul_sum, Finset.sum_add_distrib, Finset.sum_const, nsmul_eq_mul]
        ring
      _ ≤ C + E := add_le_add hsmall
        (mul_le_of_le_one_left hE ((div_le_one hPR).mpr hcard))
      _ ≤ C + 2 * E := by linarith
  · rw [ite_eq_right hg, (mixedFiber_badGuard_zero sm w q₁ q₂ r a b₁ b₂ n₁ n₂ hg).2]
    have he := (mixedFiber_badGuard_zero (Finset.range P) w
      q₁ q₂ r a b₁ b₂ n₁ n₂ hg).1
    have hz (h : ℕ) :
        mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂ h = 0 := by
      dsimp only [P] at hP he ⊢
      simp only [mixedFiberFourierCoefficient, dite_eq_right hP, he,
        Finset.sum_empty, mul_zero]
    simp only [Complex.ofReal_zero, hz, Finset.sum_const_zero, zero_add, sub_self,
      norm_zero, le_refl]

open Classical in
theorem mixedCorrelation_centered_smooth_truncation
    (k : ℕ) (sm : Finset ℕ) (w : ℕ → ℝ)
    (S : Finset (ℕ × ℕ)) (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ)
    (a b₁ b₂ : ℕ) (T L M t₀ : ℝ) (H : ℕ → ℕ → ℕ → ℝ)
    (hT : 0 ≤ T) (hL : 0 ≤ L) (hM : 0 < M)
    (ψ : ℝ → ℂ) (hψ : ContDiff ℝ ∞ ψ)
    (hsupport : Function.support ψ ⊆ Set.Icc (-T) T)
    (hbound : ∀ t : ℝ, ‖ψ t‖ ≤ L ∧ ‖iteratedDeriv (k + 2) ψ t‖ ≤ L)
    (hS : ∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Nat.Coprime p.1 p.2)
    (hprim : ∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2))
    (hH : ∀ r ∈ S.image Prod.snd,
      ∀ p₁ ∈ S.filter (fun p => p.2 = r),
      ∀ p₂ ∈ S.filter (fun p => p.2 = r), 0 ≤ H r p₁.1 p₂.1) :
    let f : ℝ → ℂ := fun t => ψ ((t - t₀) / M)
    let A : ℤ := ⌈t₀ - T * M⌉
    let K : ℕ := (⌊t₀ + T * M⌋ + 1 - A).toNat
    let J : Finset ℕ := (Finset.range K).filter
      (fun j => A + (j : ℤ) < 0 ∨ (A + (j : ℤ)).toNat ∉ sm)
    let E : ℝ := (∑ n ∈ sm, ‖(w n : ℂ) - f (n : ℝ)‖) +
      ∑ j ∈ J, ‖f ((A : ℝ) + (j : ℝ))‖
    let P : ℕ → ℕ → ℕ → ℕ := fun r q₁ q₂ => r * Nat.lcm q₁ q₂
    let I : ℕ → ℕ → ℕ → Finset ℕ := fun r q₁ q₂ =>
      (Finset.range (P r q₁ q₂)).filter
        (fun h => h ≠ 0 ∧
          |((h : ZMod (P r q₁ q₂)).valMinAbs : ℝ)| ≤ H r q₁ q₂)
    let C : ℕ → ℕ → ℕ → ℝ := fun r q₁ q₂ =>
      (2 : ℝ) ^ (k + 4) * T * L /
        (1 + (M / (P r q₁ q₂ : ℝ)) * H r q₁ q₂) ^ k + 2 * E
    let V : ℕ → ℕ → ℕ → ℕ → ℕ → ℂ := fun r q₁ q₂ n₁ n₂ =>
      if n₁ = n₂ then (mixedFiberMass sm w q₁ q₂ r a b₁ b₂ n₁ n₂ : ℂ)
      else mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂ 0 +
        ∑ h ∈ I r q₁ q₂,
          mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂ h
    ‖mixedCorrelation sm w S β c a b₁ b₂ -
        (∑ r ∈ S.image Prod.snd,
          ∑ p₁ ∈ S.filter (fun p => p.2 = r),
            ∑ p₂ ∈ S.filter (fun p => p.2 = r),
              c p₁ * star (c p₂) *
                ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                  β n₁ * star (β n₂) * V r p₁.1 p₂.1 n₁ n₂)‖ ≤
      ∑ r ∈ S.image Prod.snd,
        ∑ p₁ ∈ S.filter (fun p => p.2 = r),
          ∑ p₂ ∈ S.filter (fun p => p.2 = r),
            ‖c p₁‖ * ‖c p₂‖ *
              ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                ‖β n₁‖ * ‖β n₂‖ *
                  if n₁ ≠ n₂ ∧ Nat.Coprime n₁ (p₁.1 * r) ∧
                      Nat.Coprime n₂ (p₂.1 * r) ∧ Nat.ModEq r n₁ n₂ ∧
                      Nat.ModEq (Nat.gcd p₁.1 p₂.1) (b₁ * n₂) (b₂ * n₁)
                  then C r p₁.1 p₂.1 else 0 := by
  intro f A K J E P I C V
  simp only [mixedCorrelation, ← Finset.sum_sub_distrib, ← mul_sub]
  apply norm_sum_le_of_le
  intro r hrS
  apply norm_sum_le_of_le
  intro p₁ hp₁
  apply norm_sum_le_of_le
  intro p₂ hp₂
  rw [norm_mul, norm_mul, norm_star]
  apply mul_le_mul_of_nonneg_left _ (mul_nonneg (norm_nonneg _) (norm_nonneg _))
  apply norm_sum_le_of_le
  intro n₁ _
  apply norm_sum_le_of_le
  intro n₂ _
  rw [norm_mul, norm_mul, norm_star]
  apply mul_le_mul_of_nonneg_left _ (mul_nonneg (norm_nonneg _) (norm_nonneg _))
  by_cases hn : n₁ = n₂
  · simp [V, hn]
  · obtain ⟨hp₁S, hp₁r⟩ := Finset.mem_filter.mp hp₁
    obtain ⟨hp₂S, hp₂r⟩ := Finset.mem_filter.mp hp₂
    obtain ⟨hq₁, hr₁, hqr₁⟩ := hS p₁ hp₁S
    obtain ⟨hq₂, _, hqr₂⟩ := hS p₂ hp₂S
    have hr : 0 < r := by simpa only [hp₁r] using hr₁
    have hqr₁' : Nat.Coprime p₁.1 r := by simpa only [hp₁r] using hqr₁
    have hqr₂' : Nat.Coprime p₂.1 r := by simpa only [hp₂r] using hqr₂
    have hab₁ : Nat.Coprime (a * b₁ * b₂) (p₁.1 * r) := by
      simpa only [hp₁r] using hprim p₁ hp₁S
    have hab₂ : Nat.Coprime (a * b₁ * b₂) (p₂.1 * r) := by
      simpa only [hp₂r] using hprim p₂ hp₂S
    let _ : NeZero p₁.1 := ⟨Nat.ne_of_gt hq₁⟩
    let _ : NeZero p₂.1 := ⟨Nat.ne_of_gt hq₂⟩
    let _ : NeZero r := ⟨Nat.ne_of_gt hr⟩
    simpa only [V, ite_eq_right hn, ne_eq, hn, not_false_eq_true, true_and] using
      mixedFiberMass_centered_smooth_truncation k sm w T L M t₀
        (H r p₁.1 p₂.1) hT hL hM (hH r hrS p₁ hp₁ p₂ hp₂)
        ψ hψ hsupport hbound p₁.1 p₂.1 r a b₁ b₂ n₁ n₂ hqr₁' hqr₂'
        hab₁.coprime_mul_right.coprime_mul_right.coprime_mul_left_right
        hab₁.coprime_mul_right.coprime_mul_left.coprime_mul_right_right
        hab₂.coprime_mul_left.coprime_mul_right_right

open Classical in
theorem centered_residue_sum_eq_signed
    (P : ℕ) [NeZero P] (H : ℝ) (hH : 0 ≤ H) (f : ℕ → ℂ) :
    let S : Finset ℕ := (Finset.range P).filter
      (fun h => h ≠ 0 ∧ |((h : ZMod P).valMinAbs : ℝ)| ≤ H)
    let J : Finset ℤ := (Finset.Icc (-⌊H⌋) ⌊H⌋).filter (fun h => h ≠ 0)
    ((∑ h ∈ S, f h) =
      ∑ h ∈ J.filter (fun h => -(P : ℤ) < 2 * h ∧ 2 * h ≤ (P : ℤ)),
        f ((h : ZMod P).val)) ∧
    (2 * H < (P : ℝ) →
      (∑ h ∈ S, f h) = ∑ h ∈ J, f ((h : ZMod P).val)) := by
  intro S J
  have hcut (z : ℤ) :
      z ∈ Finset.Icc (-⌊H⌋) ⌊H⌋ ↔ |(z : ℝ)| ≤ H := by
    rw [Finset.mem_Icc, ← abs_le, ← Int.natCast_floor_eq_floor hH, Int.abs_eq_natAbs,
      Int.ofNat_le, Nat.le_floor_iff hH, Nat.cast_natAbs, Int.cast_abs]
  have hsum : (∑ h ∈ S, f h) =
      ∑ h ∈ J.filter (fun h => -(P : ℤ) < 2 * h ∧ 2 * h ≤ (P : ℤ)),
        f ((h : ZMod P).val) := by
    refine Finset.sum_bij (fun h _ => (h : ZMod P).valMinAbs) ?_ ?_ ?_ ?_
    · intro h hh
      obtain ⟨hrange, hnz, habs⟩ := Finset.mem_filter.mp hh
      have hlt : h < P := Finset.mem_range.mp hrange
      have hzmod : (h : ZMod P) ≠ 0 :=
        (ZMod.val_ne_zero _).mp (by simpa only [ZMod.val_natCast_of_lt hlt] using hnz)
      refine Finset.mem_filter.mpr ⟨?_, ?_⟩
      · exact Finset.mem_filter.mpr ⟨(hcut _).mpr habs,
          fun hz => hzmod ((ZMod.valMinAbs_eq_zero _).mp hz)⟩
      · simpa only [Set.mem_Ioc, mul_comm] using ZMod.valMinAbs_mem_Ioc (h : ZMod P)
    · intro h hh k hk heq
      have hlt : h < P := Finset.mem_range.mp (Finset.mem_filter.mp hh).1
      have hkt : k < P := Finset.mem_range.mp (Finset.mem_filter.mp hk).1
      simpa only [ZMod.val_natCast_of_lt hlt, ZMod.val_natCast_of_lt hkt] using
        congrArg (fun x : ZMod P => x.val) (ZMod.injective_valMinAbs heq)
    · intro z hz
      obtain ⟨hzJ, hcanonical⟩ := Finset.mem_filter.mp hz
      obtain ⟨hzrange, hznz⟩ := Finset.mem_filter.mp hzJ
      have hspec : (z : ZMod P).valMinAbs = z :=
        (ZMod.valMinAbs_spec (z : ZMod P) z).mpr
          ⟨rfl, by simpa only [Set.mem_Ioc, mul_comm] using hcanonical⟩
      refine ⟨(z : ZMod P).val, ?_, ?_⟩
      · refine Finset.mem_filter.mpr
          ⟨Finset.mem_range.mpr (ZMod.val_lt (z : ZMod P)), ?_, ?_⟩
        · rw [ZMod.val_ne_zero, ne_eq, ← ZMod.valMinAbs_eq_zero (z : ZMod P), hspec]
          exact hznz
        · rw [ZMod.natCast_zmod_val, hspec]
          exact (hcut z).mp hzrange
      · rw [ZMod.natCast_zmod_val, hspec]
    · intro h hh
      congr 1
      rw [ZMod.coe_valMinAbs,
        ZMod.val_natCast_of_lt (Finset.mem_range.mp (Finset.mem_filter.mp hh).1)]
  refine ⟨hsum, ?_⟩
  intro hshort
  have hfilter : J.filter (fun h => -(P : ℤ) < 2 * h ∧ 2 * h ≤ (P : ℤ)) = J := by
    apply Finset.filter_eq_self.mpr
    intro z hz
    have habs := (hcut z).mp (Finset.mem_filter.mp hz).1
    obtain ⟨hlo, hhi⟩ := abs_le.mp habs
    have hlo' : -(P : ℝ) < 2 * (z : ℝ) := by linarith
    have hhi' : 2 * (z : ℝ) ≤ (P : ℝ) := by linarith
    exact ⟨by exact_mod_cast hlo', by exact_mod_cast hhi'⟩
  rw [hsum, hfilter]

theorem mixedPeriod_dyadic_common_cutoff
    (q₁ q₂ r : ℕ) [NeZero q₁] [NeZero q₂] [NeZero r]
    (Q R x ε M : ℝ) (hQ : 0 < Q) (hR : 0 < R)
    (hx : 1 ≤ x) (hM : 0 < M)
    (hq₁ : Q ≤ (q₁ : ℝ) ∧ (q₁ : ℝ) ≤ 2 * Q)
    (hq₂ : Q ≤ (q₂ : ℝ) ∧ (q₂ : ℝ) ≤ 2 * Q)
    (hr : R ≤ (r : ℝ) ∧ (r : ℝ) ≤ 2 * R) :
    let g : ℕ := Nat.gcd q₁ q₂
    let P : ℕ := r * Nat.lcm q₁ q₂
    let H : ℝ := x ^ ε * R * Q ^ 2 / ((g : ℝ) * M)
    ((P : ℝ) = (r : ℝ) * (q₁ : ℝ) * (q₂ : ℝ) / (g : ℝ)) ∧
    (R * Q ^ 2 / (g : ℝ) ≤ (P : ℝ)) ∧
    ((P : ℝ) ≤ 8 * R * Q ^ 2 / (g : ℝ)) ∧
    (x ^ ε / 8 ≤ (M / (P : ℝ)) * H) ∧
    (2 * x ^ ε < M → 2 * H < (P : ℝ)) ∧
    (∀ (k : ℕ) (T L : ℝ), 0 ≤ T → 0 ≤ L →
      (2 : ℝ) ^ (k + 4) * T * L / (1 + (M / (P : ℝ)) * H) ^ k ≤
        (2 : ℝ) ^ (4 * k + 4) * T * L * x ^ (-((k : ℝ) * ε))) := by
  intro g P H
  have hg : 0 < (g : ℝ) := by
    exact_mod_cast Nat.gcd_pos_of_pos_left q₂ (NeZero.pos q₁)
  have hPpos : 0 < (P : ℝ) := by
    exact_mod_cast Nat.mul_pos (NeZero.pos r)
      (Nat.lcm_pos (NeZero.pos q₁) (NeZero.pos q₂))
  have hP : (P : ℝ) = (r : ℝ) * (q₁ : ℝ) * (q₂ : ℝ) / (g : ℝ) := by
    apply (eq_div_iff hg.ne').2
    exact_mod_cast (show P * g = r * q₁ * q₂ by
      simp only [P, g, Nat.mul_assoc, Nat.lcm_mul_gcd])
  have hlo : R * Q ^ 2 ≤ (r : ℝ) * (q₁ : ℝ) * (q₂ : ℝ) := by
    calc
      R * Q ^ 2 = R * Q * Q := by ring
      _ ≤ (r : ℝ) * (q₁ : ℝ) * (q₂ : ℝ) :=
        mul_le_mul
          (mul_le_mul hr.1 hq₁.1 hQ.le (Nat.cast_nonneg r))
          hq₂.1 hQ.le (mul_nonneg (Nat.cast_nonneg r) (Nat.cast_nonneg q₁))
  have hhi : (r : ℝ) * (q₁ : ℝ) * (q₂ : ℝ) ≤ 8 * R * Q ^ 2 := by
    calc
      (r : ℝ) * (q₁ : ℝ) * (q₂ : ℝ) ≤ (2 * R) * (2 * Q) * (2 * Q) :=
        mul_le_mul
          (mul_le_mul hr.2 hq₁.2 (Nat.cast_nonneg q₁) (by positivity))
          hq₂.2 (Nat.cast_nonneg q₂) (by positivity)
      _ = 8 * R * Q ^ 2 := by ring
  have hPlow : R * Q ^ 2 / (g : ℝ) ≤ (P : ℝ) := by
    simpa only [hP] using div_le_div_of_nonneg_right hlo hg.le
  have hPupper : (P : ℝ) ≤ 8 * R * Q ^ 2 / (g : ℝ) := by
    simpa only [hP] using div_le_div_of_nonneg_right hhi hg.le
  let D : ℝ := R * Q ^ 2 / (g : ℝ)
  let X : ℝ := x ^ ε
  have hD : 0 < D := by
    dsimp only [D]
    positivity
  have hxpos : 0 < x := zero_lt_one.trans_le hx
  have hX : 0 < X := Real.rpow_pos_of_pos hxpos ε
  have hDupper : (P : ℝ) ≤ 8 * D := by
    simpa only [D, mul_div_assoc, mul_assoc] using hPupper
  have hH : H = X * D / M := by
    dsimp only [H, X, D]
    field_simp [hg.ne', hM.ne']
  have hscale : (M / (P : ℝ)) * H = X * D / (P : ℝ) := by
    rw [hH]
    field_simp [hM.ne', hPpos.ne']
  have hcut : X / 8 ≤ (M / (P : ℝ)) * H := by
    rw [hscale]
    apply (div_le_div_iff₀ (by norm_num : 0 < (8 : ℝ)) hPpos).2
    nlinarith [mul_le_mul_of_nonneg_left hDupper hX.le]
  refine ⟨hP, hPlow, hPupper, hcut, ?_, ?_⟩
  · intro hshort
    calc
      2 * H = (2 * X / M) * D := by rw [hH]; ring
      _ < D := by
        simpa only [one_mul] using
          mul_lt_mul_of_pos_right ((div_lt_one hM).2 hshort) hD
      _ ≤ (P : ℝ) := hPlow
  · intro k T L hT hL
    have hbase : 0 < X / 8 := div_pos hX (by norm_num)
    have hden : (X / 8) ^ k ≤ (1 + (M / (P : ℝ)) * H) ^ k :=
      pow_le_pow_left₀ hbase.le (by linarith only [hcut]) k
    have hconstant : (2 : ℝ) ^ (k + 4) * (8 : ℝ) ^ k =
        (2 : ℝ) ^ (4 * k + 4) := by
      rw [show (8 : ℝ) = (2 : ℝ) ^ 3 by norm_num, ← pow_mul, ← pow_add]
      congr 1
      omega
    have hXpow : (X ^ k)⁻¹ = x ^ (-((k : ℝ) * ε)) := by
      dsimp only [X]
      rw [Real.rpow_neg hxpos.le, mul_comm (k : ℝ) ε,
        Real.rpow_mul_natCast hxpos.le ε k]
    calc
      (2 : ℝ) ^ (k + 4) * T * L / (1 + (M / (P : ℝ)) * H) ^ k ≤
          (2 : ℝ) ^ (k + 4) * T * L / (X / 8) ^ k :=
        div_le_div_of_nonneg_left (by positivity) (pow_pos hbase k) hden
      _ = ((2 : ℝ) ^ (k + 4) * (8 : ℝ) ^ k) * T * L * (X ^ k)⁻¹ := by
        rw [div_pow, div_div_eq_mul_div, div_eq_mul_inv]
        ring
      _ = (2 : ℝ) ^ (4 * k + 4) * T * L * x ^ (-((k : ℝ) * ε)) := by
        rw [hconstant, hXpow]

open Classical in
theorem positiveCompactProfile_nat_boundary_error_zero
    (c₀ T M : ℝ) (hc₀ : 0 < c₀) (hcT : c₀ ≤ T) (hM : 0 < M)
    (ψ : ℝ → ℝ) (hsupport : Function.support ψ ⊆ Set.Icc c₀ T) :
    let sm : Finset ℕ := Finset.Icc 1 ⌊T * M⌋₊
    let w : ℕ → ℝ := fun n => ψ ((n : ℝ) / M)
    let f : ℝ → ℂ := fun t => (ψ (t / M) : ℂ)
    let A : ℤ := ⌈-T * M⌉
    let K : ℕ := (⌊T * M⌋ + 1 - A).toNat
    let J : Finset ℕ := (Finset.range K).filter
      (fun j => A + (j : ℤ) < 0 ∨ (A + (j : ℤ)).toNat ∉ sm)
    (∑ n ∈ sm, ‖(w n : ℂ) - f (n : ℝ)‖) +
      (∑ j ∈ J, ‖f ((A : ℝ) + (j : ℝ))‖) = 0 := by
  intro sm w f A K J
  simp only [w, f, sub_self, norm_zero, Finset.sum_const_zero, zero_add]
  apply Finset.sum_eq_zero
  intro j hj
  have hbad : ¬ (0 ≤ A + (j : ℤ) ∧ (A + (j : ℤ)).toNat ∈ sm) := by
    simpa only [not_and_or, not_le] using (Finset.mem_filter.mp hj).2
  have hs := positiveCompactProfile_complete_nat_sampling
    c₀ T M hc₀ hcT hM ψ hsupport (A + (j : ℤ))
  rw [ite_eq_right hbad] at hs
  simpa only [Int.cast_add, Int.cast_natCast, norm_zero] using congrArg norm hs.symm

open Classical in
theorem mixedCorrelation_positive_smooth_truncation_uniform
    (d : ℕ) (Eβ κ Bβ ε A : ℝ)
    (hκ : 0 ≤ κ) (hBβ : 0 ≤ Bβ) (hε : 0 < ε) (hA : 0 ≤ A) :
    let γ : ℝ := ((2 * d + 5 : ℕ) : ℝ) * κ
    let k : ℕ := Nat.ceil ((A + γ + 2) / ε)
    A + γ + 2 ≤ ε * (k : ℝ) ∧
    ∀ (c₀ T L Eψ : ℝ), 0 < c₀ → c₀ ≤ T → 0 ≤ L →
      ∀ᶠ x : ℝ in Filter.atTop,
        ∀ (S : Finset (ℕ × ℕ)) (β : ℕ →₀ ℂ)
          (c : ℕ × ℕ → ℂ) (N : ℕ) (M Q R : ℝ),
          0 < M → 0 < Q → 0 < R →
          β.support ⊆ Finset.Icc 1 N → (N : ℝ) ≤ x ^ κ →
          (∀ n ∈ β.support,
            ‖β n‖ ≤ Bβ * ((Nat.divisors n).card : ℝ) ^ d * (Real.log x) ^ Eβ) →
          (∀ p ∈ S, ‖c p‖ ≤ 1) →
          (∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Nat.Coprime p.1 p.2 ∧
            Q ≤ (p.1 : ℝ) ∧ (p.1 : ℝ) ≤ 2 * Q ∧
            R ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ 2 * R ∧
            (p.1 : ℝ) ≤ x ^ κ ∧ (p.2 : ℝ) ≤ x ^ κ) →
          ∀ (a b₁ b₂ : ℕ),
            (∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2)) →
          ∀ (ψ : ℝ → ℝ), ContDiff ℝ ∞ ψ →
            Function.support ψ ⊆ Set.Icc c₀ T →
            (∀ t : ℝ,
              ‖ψ t‖ ≤ L * (Real.log x) ^ Eψ ∧
              ‖iteratedDeriv (k + 2) ψ t‖ ≤ L * (Real.log x) ^ Eψ) →
            let sm : Finset ℕ := Finset.Icc 1 ⌊T * M⌋₊
            let w : ℕ → ℝ := fun n => ψ ((n : ℝ) / M)
            let P : ℕ → ℕ → ℕ → ℕ := fun r q₁ q₂ => r * Nat.lcm q₁ q₂
            let H : ℕ → ℕ → ℕ → ℝ := fun _ q₁ q₂ =>
              x ^ ε * R * Q ^ 2 / ((Nat.gcd q₁ q₂ : ℝ) * M)
            let I : ℕ → ℕ → ℕ → Finset ℕ := fun r q₁ q₂ =>
              (Finset.range (P r q₁ q₂)).filter
                (fun h => h ≠ 0 ∧
                  |((h : ZMod (P r q₁ q₂)).valMinAbs : ℝ)| ≤ H r q₁ q₂)
            let J : ℕ → ℕ → ℕ → Finset ℤ := fun r q₁ q₂ =>
              (Finset.Icc (-⌊H r q₁ q₂⌋) ⌊H r q₁ q₂⌋).filter (fun h => h ≠ 0)
            let V : ℕ → ℕ → ℕ → ℕ → ℕ → ℂ := fun r q₁ q₂ n₁ n₂ =>
              if n₁ = n₂ then (mixedFiberMass sm w q₁ q₂ r a b₁ b₂ n₁ n₂ : ℂ)
              else mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂ 0 +
                ∑ h ∈ I r q₁ q₂,
                  mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂ h
            let Vℤ : ℕ → ℕ → ℕ → ℕ → ℕ → ℂ := fun r q₁ q₂ n₁ n₂ =>
              if n₁ = n₂ then (mixedFiberMass sm w q₁ q₂ r a b₁ b₂ n₁ n₂ : ℂ)
              else mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂ 0 +
                ∑ h ∈ J r q₁ q₂,
                  mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂
                    ((h : ZMod (P r q₁ q₂)).val)
            ‖mixedCorrelation sm w S β c a b₁ b₂ -
                (∑ r ∈ S.image Prod.snd,
                  ∑ p₁ ∈ S.filter (fun p => p.2 = r),
                    ∑ p₂ ∈ S.filter (fun p => p.2 = r),
                      c p₁ * star (c p₂) *
                        ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                          β n₁ * star (β n₂) * V r p₁.1 p₂.1 n₁ n₂)‖ ≤ x ^ (-A) ∧
            (2 * x ^ ε < M →
              ‖mixedCorrelation sm w S β c a b₁ b₂ -
                  (∑ r ∈ S.image Prod.snd,
                    ∑ p₁ ∈ S.filter (fun p => p.2 = r),
                      ∑ p₂ ∈ S.filter (fun p => p.2 = r),
                        c p₁ * star (c p₂) *
                          ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                            β n₁ * star (β n₂) * Vℤ r p₁.1 p₂.1 n₁ n₂)‖ ≤ x ^ (-A)) := by
  intro γ k
  have hkpos : 0 < k := Nat.ceil_pos.mpr (by positivity)
  have hk : A + γ + 2 ≤ ε * (k : ℝ) := by
    simpa only [mul_comm] using
      (div_le_iff₀ hε).mp ((Nat.ceil_eq_iff (Nat.ne_of_gt hkpos)).mp rfl).2
  refine ⟨hk, ?_⟩
  intro c₀ T L Eψ hc₀ hcT hL
  have hT : 0 ≤ T := hc₀.le.trans hcT
  let K₀ : ℝ := (2 : ℝ) ^ (4 * k + 4) * T * L
  have hK₀ : 0 ≤ K₀ := by positivity
  have hsmall := ((isLittleO_log_rpow_rpow_atTop Eψ zero_lt_one).const_mul_left K₀).eventuallyLE
  filter_upwards [mixedCorrelation_outer_coefficient_mass_eventually_le_rpow
    d Eβ κ Bβ 1 hκ hBβ zero_lt_one, hsmall,
    Filter.eventually_ge_atTop (Real.exp 1)] with x hmass hsmall hx
  intro S β c N M Q R hM hQ hR hβ hN henv hc hS a b₁ b₂ hprim ψ hψ hsupport hbound
    sm w P H I J V Vℤ
  have hx₀ : 0 < x := (Real.exp_pos 1).trans_le hx
  have hx₁ : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hx
  have hlog : 0 ≤ (Real.log x) ^ Eψ := Real.rpow_nonneg (Real.log_nonneg hx₁) Eψ
  have hLx : 0 ≤ L * (Real.log x) ^ Eψ := mul_nonneg hL hlog
  have hconstant : K₀ * (Real.log x) ^ Eψ ≤ x := by
    simpa only [Real.rpow_one, Real.norm_of_nonneg (mul_nonneg hK₀ hlog),
      Real.norm_of_nonneg hx₀.le] using hsmall
  have houter := hmass S β c N hβ hN henv hc (fun p hp => by
    obtain ⟨hq, hr, _, _, _, _, _, hqx, hrx⟩ := hS p hp
    exact ⟨hq, hr, hqx, hrx⟩)
  let δ : ℝ := x ^ (1 - (k : ℝ) * ε)
  have hδ : 0 ≤ δ := Real.rpow_nonneg hx₀.le _
  let ψℂ : ℝ → ℂ := fun t => (ψ t : ℂ)
  have hψℂ : ContDiff ℝ ∞ ψℂ := Complex.ofRealCLM.contDiff.comp hψ
  have hsℂ : Function.support ψℂ ⊆ Set.Icc (-T) T :=
    ((Function.support_comp_subset (g := Complex.ofReal) Complex.ofReal_zero ψ).trans
      hsupport).trans (Set.Icc_subset_Icc_left ((neg_nonpos.mpr hT).trans hc₀.le))
  have hbℂ (t : ℝ) :
      ‖ψℂ t‖ ≤ L * (Real.log x) ^ Eψ ∧
        ‖iteratedDeriv (k + 2) ψℂ t‖ ≤ L * (Real.log x) ^ Eψ := by
    refine ⟨by simpa only [ψℂ, Complex.norm_real] using (hbound t).1, ?_⟩
    have he : ‖iteratedDeriv (k + 2) ψℂ t‖ = ‖iteratedDeriv (k + 2) ψ t‖ := by
      simpa only [norm_iteratedFDeriv_eq_norm_iteratedDeriv, ψℂ,
        Function.comp_def, Complex.ofRealLI_apply] using
        Complex.ofRealLI.norm_iteratedFDeriv_comp_left
          (x := t) (i := k + 2) hψ.contDiffAt (by simp)
    exact he.trans_le (hbound t).2
  have hlocal (r : ℕ)
      (p₁ : ℕ × ℕ) (hp₁ : p₁ ∈ S.filter (fun p => p.2 = r))
      (p₂ : ℕ × ℕ) (hp₂ : p₂ ∈ S.filter (fun p => p.2 = r)) :
      0 ≤ H r p₁.1 p₂.1 ∧
      (2 * x ^ ε < M → 2 * H r p₁.1 p₂.1 < (P r p₁.1 p₂.1 : ℝ)) ∧
      (2 : ℝ) ^ (k + 4) * T * (L * (Real.log x) ^ Eψ) /
        (1 + (M / (P r p₁.1 p₂.1 : ℝ)) * H r p₁.1 p₂.1) ^ k ≤ δ := by
    obtain ⟨hp₁S, hp₁r⟩ := Finset.mem_filter.mp hp₁
    obtain ⟨hp₂S, _⟩ := Finset.mem_filter.mp hp₂
    obtain ⟨hq₁, hr₁, _, hlo₁, hhi₁, hrl, hru, _, _⟩ := hS p₁ hp₁S
    obtain ⟨hq₂, _, _, hlo₂, hhi₂, _, _, _, _⟩ := hS p₂ hp₂S
    have hr : 0 < r := by simpa only [hp₁r] using hr₁
    have hrange : R ≤ (r : ℝ) ∧ (r : ℝ) ≤ 2 * R := by
      simpa only [hp₁r] using And.intro hrl hru
    have : NeZero p₁.1 := NeZero.of_pos hq₁
    have : NeZero p₂.1 := NeZero.of_pos hq₂
    have : NeZero r := NeZero.of_pos hr
    obtain ⟨_, _, _, _, hshort, hpower⟩ := mixedPeriod_dyadic_common_cutoff
      p₁.1 p₂.1 r Q R x ε M hQ hR hx₁ hM ⟨hlo₁, hhi₁⟩ ⟨hlo₂, hhi₂⟩ hrange
    refine ⟨by dsimp only [H]; positivity, hshort, ?_⟩
    calc
      _ ≤ (2 : ℝ) ^ (4 * k + 4) * T * (L * (Real.log x) ^ Eψ) *
          x ^ (-((k : ℝ) * ε)) := hpower k T (L * (Real.log x) ^ Eψ) hT hLx
      _ = (K₀ * (Real.log x) ^ Eψ) * x ^ (-((k : ℝ) * ε)) := by
        simp only [K₀, mul_assoc]
      _ ≤ x * x ^ (-((k : ℝ) * ε)) :=
        mul_le_mul_of_nonneg_right hconstant (Real.rpow_nonneg hx₀.le _)
      _ = δ := by
        simpa only [δ, sub_eq_add_neg, Real.rpow_one] using
          (Real.rpow_add hx₀ 1 (-((k : ℝ) * ε))).symm
  have hE := positiveCompactProfile_nat_boundary_error_zero c₀ T M hc₀ hcT hM ψ hsupport
  dsimp only at hE
  have htrunc := mixedCorrelation_centered_smooth_truncation k sm w S β c a b₁ b₂
    T (L * (Real.log x) ^ Eψ) M 0 H hT hLx hM ψℂ hψℂ hsℂ hbℂ
    (fun p hp => ⟨(hS p hp).1, (hS p hp).2.1, (hS p hp).2.2.1⟩) hprim
    (fun r _ p₁ hp₁ p₂ hp₂ => (hlocal r p₁ hp₁ p₂ hp₂).1)
  dsimp only at htrunc
  simp only [ψℂ, sub_zero, zero_sub, zero_add, ← neg_mul, sm, w,
    hE, mul_zero, add_zero] at htrunc
  have hresult := htrunc.trans (show _ ≤ x ^ (-A) from by
    calc
      _ ≤ ∑ r ∈ S.image Prod.snd,
          ∑ p₁ ∈ S.filter (fun p => p.2 = r),
            ∑ p₂ ∈ S.filter (fun p => p.2 = r),
              ‖c p₁‖ * ‖c p₂‖ *
                ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                  ‖β n₁‖ * ‖β n₂‖ * δ := by
        gcongr with r hr p₁ hp₁ p₂ hp₂ n₁ hn₁ n₂ hn₂
        split_ifs
        · exact (hlocal r p₁ hp₁ p₂ hp₂).2.2
        · exact hδ
      _ = δ * (∑ r ∈ S.image Prod.snd,
          ∑ p₁ ∈ S.filter (fun p => p.2 = r),
            ∑ p₂ ∈ S.filter (fun p => p.2 = r),
              ‖c p₁‖ * ‖c p₂‖ *
                ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                  ‖β n₁‖ * ‖β n₂‖) := by
        simp only [Finset.mul_sum, mul_assoc, mul_left_comm, mul_comm]
      _ ≤ δ * x ^ (γ + 1) := mul_le_mul_of_nonneg_left houter hδ
      _ = x ^ (γ + 2 - (k : ℝ) * ε) := by
        dsimp only [δ]
        rw [← Real.rpow_add hx₀]
        congr 1
        ring
      _ ≤ x ^ (-A) := Real.rpow_le_rpow_of_exponent_le hx₁ (by nlinarith only [hk]))
  refine ⟨hresult, ?_⟩
  intro hshort
  refine (le_of_eq ?_).trans hresult
  apply congrArg (fun z : ℂ => ‖mixedCorrelation sm w S β c a b₁ b₂ - z‖)
  refine Finset.sum_congr rfl fun r _ =>
    Finset.sum_congr rfl fun p₁ hp₁ =>
      Finset.sum_congr rfl fun p₂ hp₂ => ?_
  apply congrArg (fun z : ℂ => c p₁ * star (c p₂) * z)
  refine Finset.sum_congr rfl fun n₁ _ => Finset.sum_congr rfl fun n₂ _ => ?_
  apply congrArg (fun z : ℂ => β n₁ * star (β n₂) * z)
  by_cases hn : n₁ = n₂
  · simp only [Vℤ, ite_eq_left hn]
    rfl
  · simp only [Vℤ, ite_eq_right hn]
    apply congrArg (fun z : ℂ =>
      mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b₁ b₂ n₁ n₂ 0 + z)
    have hq₁ := (hS p₁ (Finset.mem_filter.mp hp₁).1).1
    have hq₂ := (hS p₂ (Finset.mem_filter.mp hp₂).1).1
    have hrpos : 0 < r := by
      simpa only [(Finset.mem_filter.mp hp₁).2] using
        (hS p₁ (Finset.mem_filter.mp hp₁).1).2.1
    have : NeZero (P r p₁.1 p₂.1) :=
      NeZero.of_pos (Nat.mul_pos hrpos (Nat.lcm_pos hq₁ hq₂))
    exact ((centered_residue_sum_eq_signed (P r p₁.1 p₂.1)
      (H r p₁.1 p₂.1) (hlocal r p₁ hp₁ p₂ hp₂).1
      (fun h => mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b₁ b₂ n₁ n₂ h)).2
        ((hlocal r p₁ hp₁ p₂ hp₂).2.1 hshort)).symm

/--
The finitely supported sequence sampling `ψ ((n - t₀) / N)` at positive integers through `⌊t₀ +
T * N⌋₊`, with zero values outside this interval. No support assumption on `ψ` is built into the
definition.
-/
noncomputable def positiveCompactProfileSequence
    (ψ : ℝ → ℂ) (T N t₀ : ℝ) : ℕ →₀ ℂ :=
  ∑ n ∈ Finset.Icc 1 ⌊t₀ + T * N⌋₊,
    Finsupp.single n (ψ (((n : ℝ) - t₀) / N))

theorem typeZero_positive_sample_pairing
    (q : ℕ) [NeZero q] (c T N t₀ : ℝ)
    (hc : 0 < c) (hcT : c ≤ T) (hN : 0 < N)
    (hpositive : 0 < t₀ + c * N)
    (ψ : ℝ → ℂ) (hsupport : Function.support ψ ⊆ Set.Icc c T)
    (F : ZMod q → ℂ) :
    let β : ℕ →₀ ℂ := positiveCompactProfileSequence ψ T N t₀
    let w : ℝ → ℂ := fun t => ψ ((t - t₀) / N)
    let A : ℤ := ⌈t₀ - T * N⌉
    let K : ℕ := (⌊t₀ + T * N⌋ + 1 - A).toNat
    let W : ZMod q → ℂ := integerIntervalResidueWeight q A K
      (fun j => w ((A : ℝ) + (j : ℝ)))
    (∑ n ∈ β.support, β n * F (n : ZMod q)) = ∑ z : ZMod q, W z * F z := by
  extract_lets β w A K W
  let B : ℤ := ⌊t₀ + T * N⌋
  let s : Finset ℕ := Finset.Icc 1 ⌊t₀ + T * N⌋₊
  have hwindow (t : ℝ) (ht : w t ≠ 0) :
      0 < t ∧ t₀ - T * N ≤ t ∧ t ≤ t₀ + T * N := by
    have hs := hsupport ht
    have hl : c * N ≤ t - t₀ := (le_div_iff₀ hN).mp hs.1
    have hu : t - t₀ ≤ T * N := (div_le_iff₀ hN).mp hs.2
    have hcN : 0 ≤ c * N := mul_nonneg hc.le hN.le
    have hTN : 0 ≤ T * N := mul_nonneg (hc.le.trans hcT) hN.le
    exact ⟨by linarith, by linarith, by linarith⟩
  have hmemS (n : ℕ) (hn : w (n : ℝ) ≠ 0) : n ∈ s := by
    have h := hwindow (n : ℝ) hn
    exact Finset.mem_Icc.mpr ⟨Nat.cast_pos.mp h.1, Nat.le_floor h.2.2⟩
  have hmemI (z : ℤ) (hz : w (z : ℝ) ≠ 0) : z ∈ Finset.Icc A B := by
    have h := hwindow (z : ℝ) hz
    exact Finset.mem_Icc.mpr
      ⟨Int.ceil_le.mpr h.2.1, Int.le_floor.mpr h.2.2⟩
  have hnat :
      (∑ n ∈ β.support, β n * F (n : ZMod q)) =
        ∑ n ∈ s, w (n : ℝ) * F (n : ZMod q) := by
    change (∑ n ∈ s, Finsupp.single n (w (n : ℝ))).sum
      (fun n z => z * F (n : ZMod q)) = _
    rw [← Finsupp.indicator_eq_sum_single]
    exact Finsupp.sum_indicator_index _ (fun _ _ => zero_mul _)
  have hreindex :
      (∑ n ∈ s, w (n : ℝ) * F (n : ZMod q)) =
        ∑ z ∈ Finset.Icc A B, w (z : ℝ) * F (z : ZMod q) := by
    refine Finset.sum_bij_ne_zero (fun n _ _ => (n : ℤ)) ?_ ?_ ?_ ?_
    · intro n _ hn
      apply hmemI
      simpa only [Int.cast_natCast] using
        (left_ne_zero_of_mul hn : w (n : ℝ) ≠ 0)
    · intro n₁ _ _ n₂ _ _ he
      exact Int.ofNat.inj he
    · intro z _ hz
      have hw : w (z : ℝ) ≠ 0 := left_ne_zero_of_mul hz
      have hzpos : 0 < z := by exact_mod_cast (hwindow (z : ℝ) hw).1
      lift z to ℕ using hzpos.le with n
      simp only [Int.cast_natCast] at hw hz ⊢
      exact ⟨n, hmemS _ hw, hz, rfl⟩
    · intro n _ _
      simp only [Int.cast_natCast]
  have hint :
      (∑ z ∈ Finset.Icc A B, w (z : ℝ) * F (z : ZMod q)) =
        ∑ z : ZMod q, W z * F z := by
    rw [(integerIntervalResidueWeight_spec q A K _).1 F,
      Int.Icc_eq_finset_map, Finset.sum_map]
    simp only [Function.Embedding.trans_apply, Nat.castEmbedding_apply,
      addLeftEmbedding_apply, Int.cast_add, Int.cast_natCast, B, K]
  exact hnat.trans (hreindex.trans hint)

theorem typeZero_fullDiscrepancy_convolution
    (q : ℕ) [NeZero q] (α β : ℕ →₀ ℂ)
    (a : ℕ) (ha : Nat.Coprime a q) :
    fullDiscrepancy (finiteConvolution α β) q a =
      ∑ m ∈ α.support with Nat.Coprime m q,
        α m * fullDiscrepancy β q (((a : ZMod q) * (m : ZMod q)⁻¹).val) := by
  let K (b n : ℕ) : ℂ :=
    (if n % q = b % q then 1 else 0) -
      (if Nat.Coprime n q then 1 else 0) / (q.totient : ℂ)
  have hfull (f : ℕ →₀ ℂ) (b : ℕ) :
      fullDiscrepancy f q b = ∑ n ∈ f.support, f n * K b n := by
    simp only [fullDiscrepancy, progressionMass, reducedMass, K,
      div_eq_mul_inv, mul_sub, mul_ite, ite_mul, one_mul, mul_one,
      zero_mul, mul_zero, Finset.sum_sub_distrib, Finset.sum_mul]
  have hkernel (m n : ℕ) :
      K a (m * n) =
        if Nat.Coprime m q then K (((a : ZMod q) * (m : ZMod q)⁻¹).val) n
        else 0 := by
    by_cases hm : Nat.Coprime m q
    · have hmod : (m * n) % q = a % q ↔
          n % q = (((a : ZMod q) * (m : ZMod q)⁻¹).val) % q := by
        rw [← ZMod.natCast_eq_natCast_iff', ← ZMod.natCast_eq_natCast_iff',
          ZMod.natCast_zmod_val, Nat.cast_mul]
        let u := ZMod.unitOfCoprime m hm
        change (u : ZMod q) * (n : ZMod q) = (a : ZMod q) ↔
          (n : ZMod q) = (a : ZMod q) * (u : ZMod q)⁻¹
        rw [ZMod.inv_coe_unit, mul_comm (a : ZMod q)]
        exact (Units.eq_inv_mul_iff_mul_eq (b := u)).symm
      have hcop : Nat.Coprime (m * n) q ↔ Nat.Coprime n q :=
        ⟨Nat.Coprime.coprime_mul_left, hm.mul_left⟩
      simp only [ite_eq_left hm, K, hmod, hcop]
    · have hprod : ¬ Nat.Coprime (m * n) q :=
        fun h => hm h.coprime_mul_right
      have hres : ¬ (m * n) % q = a % q := by
        intro h
        exact hprod ((show Nat.ModEq q (m * n) a from h).gcd_eq.trans ha)
      simp only [ite_eq_right hm, K, ite_eq_right hres, ite_eq_right hprod,
        zero_div, sub_self]
  rw [hfull, finiteConvolution_pairing, Finset.sum_filter]
  simp only [hkernel, mul_ite, mul_zero, Finset.sum_ite_irrel,
    Finset.sum_const_zero, hfull, Finset.mul_sum, mul_assoc]

theorem positiveCompactProfile_convolution_discrepancy_le
    (k q : ℕ) [NeZero q] (c T L N t₀ : ℝ)
    (hc : 0 < c) (hcT : c ≤ T) (hL : 0 ≤ L) (hN : 0 < N)
    (hpositive : 0 < t₀ + c * N)
    (ψ : ℝ → ℂ) (hψ : ContDiff ℝ ∞ ψ)
    (hsupport : Function.support ψ ⊆ Set.Icc c T)
    (hbound : ∀ t : ℝ,
      ‖ψ t‖ ≤ L ∧ ‖iteratedDeriv (k + 2) ψ t‖ ≤ L)
    (α : ℕ →₀ ℂ) (a : ℕ) (ha : Nat.Coprime a q) :
    ‖fullDiscrepancy
        (finiteConvolution α (positiveCompactProfileSequence ψ T N t₀)) q a‖ ≤
      ((2 : ℝ) ^ (k + 5) * T * L / (1 + N / (2 * (q : ℝ))) ^ k) *
        ∑ m ∈ α.support with Nat.Coprime m q, ‖α m‖ := by
  let β := positiveCompactProfileSequence ψ T N t₀
  let w : ℝ → ℂ := fun t => ψ ((t - t₀) / N)
  let A : ℤ := ⌈t₀ - T * N⌉
  let K : ℕ := (⌊t₀ + T * N⌋ + 1 - A).toNat
  let W : ZMod q → ℂ := integerIntervalResidueWeight q A K
    (fun j => w ((A : ℝ) + (j : ℝ)))
  let C : ℝ := (2 : ℝ) ^ (k + 5) * T * L / (1 + N / (2 * (q : ℝ))) ^ k
  have hT : 0 ≤ T := hc.le.trans hcT
  have hsupport' : Function.support ψ ⊆ Set.Icc (-T) T :=
    hsupport.trans (Set.Icc_subset_Icc (by linarith) le_rfl)
  have hprog (r : ℕ) : progressionMass β q r = W (r : ZMod q) := by
    have h := typeZero_positive_sample_pairing q c T N t₀ hc hcT hN hpositive ψ
      hsupport (fun z => if z = (r : ZMod q) then (1 : ℂ) else 0)
    simpa [progressionMass, ZMod.natCast_eq_natCast_iff', mul_ite] using h
  have hunit : (∑ z : ZMod q, if Nat.Coprime z.val q then W z else 0) =
      ∑ b : (ZMod q)ˣ, W (b : ZMod q) := by
    rw [← Finset.sum_filter]
    calc
      _ = ∑ z : {z : ZMod q // Nat.Coprime z.val q}, W z.1 :=
        Finset.sum_subtype _ (by simp) W
      _ = _ := by
        symm
        apply Fintype.sum_equiv (ZMod.unitsEquivCoprime (n := q))
        intro b
        rfl
  have hred : reducedMass β q = ∑ b : (ZMod q)ˣ, W (b : ZMod q) := by
    rw [← hunit]
    have h := typeZero_positive_sample_pairing q c T N t₀ hc hcT hN hpositive ψ
      hsupport (fun z => if Nat.Coprime z.val q then (1 : ℂ) else 0)
    simpa only [reducedMass, mul_ite, mul_one, mul_zero, ZMod.val_natCast,
      ZMod.coprime_mod_iff_coprime] using h
  have hsingle (u : (ZMod q)ˣ) :
      ‖fullDiscrepancy β q (u : ZMod q).val‖ ≤ C := by
    have h := compactProfile_primitive_discrepancy_le k q T L N t₀
      hT hL hN ψ hψ hsupport' hbound u
    change ‖W (u : ZMod q) -
      (q.totient : ℂ)⁻¹ * ∑ b : (ZMod q)ˣ, W (b : ZMod q)‖ ≤ C at h
    simpa only [fullDiscrepancy, hprog, hred, ZMod.natCast_zmod_val,
      div_eq_mul_inv, mul_comm] using h
  change ‖fullDiscrepancy (finiteConvolution α β) q a‖ ≤ C * _
  rw [typeZero_fullDiscrepancy_convolution q α β a ha]
  calc
    _ ≤ ∑ m ∈ α.support with Nat.Coprime m q, ‖α m‖ * C := by
      apply norm_sum_le_of_le
      intro m hm
      have hmq := (Finset.mem_filter.mp hm).2
      let u : (ZMod q)ˣ := ZMod.unitOfCoprime a ha * (ZMod.unitOfCoprime m hmq)⁻¹
      simpa only [u, Units.val_mul, ← ZMod.inv_coe_unit, ZMod.coe_unitOfCoprime] using
        norm_mul_le_of_le (le_refl ‖α m‖) (hsingle u)
    _ = C * ∑ m ∈ α.support with Nat.Coprime m q, ‖α m‖ := by
      rw [← Finset.sum_mul, mul_comm]

theorem positiveCompactProfile_typeZero_uniform_log_saving
    (A D ε : ℝ) (hD : 0 ≤ D) (hε : 0 < ε) :
    let k : ℕ := Nat.ceil ((D + 1) / ε)
    D + 1 ≤ ε * (k : ℝ) ∧
    ∀ (c T L E F : ℝ), 0 < c → c ≤ T → 0 ≤ L →
      ∃ X : ℝ, 2 ≤ X ∧
        ∀ x : ℝ, X ≤ x →
        ∀ (S : Finset ℕ), (∀ q ∈ S, 0 < q) →
        ∀ (weight : ℕ → ℝ), (∀ q ∈ S, 0 ≤ weight q) →
        ∀ (α : ℕ → (ℕ →₀ ℂ)),
          (∑ q ∈ S, weight q * ∑ m ∈ (α q).support, ‖α q m‖) ≤
            x ^ D * (Real.log x) ^ F →
        ∀ (N t₀ : ℕ → ℝ),
          (∀ q ∈ S, 0 < N q) →
          (∀ q ∈ S, x ^ ε * (q : ℝ) ≤ N q) →
          (∀ q ∈ S, 0 < t₀ q + c * N q) →
        ∀ (ψ : ℕ → ℝ → ℂ),
          (∀ q ∈ S, ContDiff ℝ ∞ (ψ q)) →
          (∀ q ∈ S, Function.support (ψ q) ⊆ Set.Icc c T) →
          (∀ q ∈ S, ∀ t : ℝ,
            ‖ψ q t‖ ≤ L * (Real.log x) ^ E ∧
            ‖iteratedDeriv (k + 2) (ψ q) t‖ ≤ L * (Real.log x) ^ E) →
        ∀ (a : ℕ → ℕ), (∀ q ∈ S, Nat.Coprime (a q) q) →
          (∑ q ∈ S, weight q *
            ‖fullDiscrepancy
              (finiteConvolution (α q)
                (positiveCompactProfileSequence (ψ q) T (N q) (t₀ q))) q (a q)‖) ≤
            x * (Real.log x) ^ (-A) := by
  let k : ℕ := Nat.ceil ((D + 1) / ε)
  change D + 1 ≤ ε * (k : ℝ) ∧ _
  have hk : D + 1 ≤ ε * (k : ℝ) := by
    simpa only [mul_comm] using (div_le_iff₀ hε).mp (Nat.le_ceil ((D + 1) / ε))
  refine ⟨hk, ?_⟩
  intro c T L E F hc hcT hL
  have hT : 0 ≤ T := hc.le.trans hcT
  let C : ℝ := (2 : ℝ) ^ (2 * k + 5) * T * L
  have hC : 0 ≤ C := by dsimp only [C]; positivity
  have ho := isLittleO_log_rpow_rpow_atTop (A + E + F) (by norm_num : 0 < (2 : ℝ))
  obtain ⟨X, hX⟩ := Filter.eventually_atTop.1 (ho.const_mul_left C).eventuallyLE
  refine ⟨max 2 X, le_max_left _ _, ?_⟩
  intro x hx S hS weight hweight α hbudget N t₀ hN hlarge hpositive ψ hψ hsupport hbound a ha
  have hx2 : (2 : ℝ) ≤ x := (le_max_left _ _).trans hx
  have hx1 : (1 : ℝ) ≤ x := by linarith
  have hx0 : 0 < x := by linarith
  have hlog : 0 < Real.log x := Real.log_pos (by linarith)
  have hpow : 0 < x ^ (D + 1) :=
    lt_of_lt_of_le zero_lt_one (Real.one_le_rpow hx1 (by linarith only [hD]))
  have htwo : 0 < (2 : ℝ) ^ k := by positivity
  have hpoly : C * (Real.log x) ^ (A + E + F) ≤ x ^ 2 := by
    simpa only [Real.rpow_two, Real.norm_of_nonneg (sq_nonneg x),
      Real.norm_of_nonneg (mul_nonneg hC (Real.rpow_nonneg hlog.le _))] using
      hX x ((le_max_right 2 X).trans hx)
  let B : ℝ := C * (Real.log x) ^ E / x ^ (D + 1)
  have hB : 0 ≤ B := by dsimp only [B]; positivity
  have hqbound (q : ℕ) (hq : q ∈ S) :
      ‖fullDiscrepancy
        (finiteConvolution (α q)
          (positiveCompactProfileSequence (ψ q) T (N q) (t₀ q))) q (a q)‖ ≤
        B * ∑ m ∈ (α q).support, ‖α q m‖ := by
    let : NeZero q := ⟨(hS q hq).ne'⟩
    have hqr : 0 < (q : ℝ) := Nat.cast_pos.mpr (hS q hq)
    have hscale : x ^ ε / 2 ≤ N q / (2 * (q : ℝ)) := by
      apply (div_le_div_iff₀ (by norm_num : (0 : ℝ) < 2) (by positivity)).mpr
      nlinarith [hlarge q hq]
    have hden : x ^ (D + 1) / (2 : ℝ) ^ k ≤
        (1 + N q / (2 * (q : ℝ))) ^ k := by
      calc
        _ ≤ (x ^ ε) ^ k / (2 : ℝ) ^ k := by
          apply div_le_div_of_nonneg_right _ htwo.le
          rw [← Real.rpow_mul_natCast hx0.le]
          exact Real.rpow_le_rpow_of_exponent_le hx1 hk
        _ = (x ^ ε / 2) ^ k := (div_pow _ _ _).symm
        _ ≤ _ := pow_le_pow_left₀ (by positivity) (by linarith) k
    have hratio : (2 : ℝ) ^ (k + 5) * T * (L * (Real.log x) ^ E) /
        (1 + N q / (2 * (q : ℝ))) ^ k ≤ B := by
      calc
        _ ≤ (2 : ℝ) ^ (k + 5) * T * (L * (Real.log x) ^ E) /
            (x ^ (D + 1) / (2 : ℝ) ^ k) :=
          div_le_div_of_nonneg_left (by positivity) (div_pos hpow htwo) hden
        _ = B := by
          dsimp only [B, C]
          rw [show 2 * k + 5 = (k + 5) + k by omega, pow_add]
          field_simp [hpow.ne', htwo.ne']
          ring
    have hfiltered : (∑ m ∈ (α q).support with Nat.Coprime m q, ‖α q m‖) ≤
        ∑ m ∈ (α q).support, ‖α q m‖ :=
      Finset.sum_le_sum_of_subset_of_nonneg (Finset.filter_subset _ _)
        (fun _ _ _ => norm_nonneg _)
    have hfinite := positiveCompactProfile_convolution_discrepancy_le k q c T
      (L * (Real.log x) ^ E) (N q) (t₀ q) hc hcT (by positivity) (hN q hq)
      (hpositive q hq) (ψ q) (hψ q hq) (hsupport q hq) (hbound q hq) (α q) (a q) (ha q hq)
    exact hfinite.trans ((mul_le_mul_of_nonneg_right hratio
      (Finset.sum_nonneg fun _ _ => norm_nonneg _)).trans
        (mul_le_mul_of_nonneg_left hfiltered hB))
  calc
    _ ≤ ∑ q ∈ S, weight q * (B * ∑ m ∈ (α q).support, ‖α q m‖) :=
      Finset.sum_le_sum fun q hq =>
        mul_le_mul_of_nonneg_left (hqbound q hq) (hweight q hq)
    _ = B * ∑ q ∈ S, weight q * ∑ m ∈ (α q).support, ‖α q m‖ := by
      simpa only [mul_left_comm] using
        (Finset.mul_sum S (fun q => weight q * ∑ m ∈ (α q).support, ‖α q m‖) B).symm
    _ ≤ B * (x ^ D * (Real.log x) ^ F) := mul_le_mul_of_nonneg_left hbudget hB
    _ = C * (Real.log x) ^ (E + F) / x := by
      dsimp only [B]
      rw [Real.rpow_add_one hx0.ne' D, Real.rpow_add hlog E F]
      field_simp [hx0.ne', (Real.rpow_pos_of_pos hx0 D).ne']
    _ ≤ x * (Real.log x) ^ (-A) := by
      calc
        _ = (C * (Real.log x) ^ (A + E + F)) / (x * (Real.log x) ^ A) := by
          rw [show A + E + F = (E + F) + A by ring, Real.rpow_add hlog (E + F) A]
          field_simp [hx0.ne', (Real.rpow_pos_of_pos hlog A).ne']
        _ ≤ x ^ 2 / (x * (Real.log x) ^ A) :=
          div_le_div_of_nonneg_right hpoly (by positivity)
        _ = _ := by
          rw [Real.rpow_neg hlog.le]
          field_simp [hx0.ne', (Real.rpow_pos_of_pos hlog A).ne']

end

theorem sourcePhase_sample_transform
    (c T M : ℝ) (hc : 0 < c) (hcT : c ≤ T) (hM : 0 < M)
    (ψ : ℝ → ℝ) (hsupport : Function.support ψ ⊆ Set.Icc c T)
    (P : ℕ) [NeZero P] (h : ℤ) :
    (∑ m ∈ Finset.Icc 1 ⌊T * M⌋₊,
      (ψ ((m : ℝ) / M) : ℂ) *
        ZMod.stdAddChar (-((m : ZMod P) * (h : ZMod P)))) =
      ∑' t : ℤ, (ψ ((t : ℝ) / M) : ℂ) *
        (Real.fourierChar (-((t : ℝ) * (h : ℝ) / (P : ℝ))) : ℂ) := by
  classical
  let sm : Finset ℕ := Finset.Icc 1 ⌊T * M⌋₊
  let g : ℤ → ℂ := fun t => (ψ ((t : ℝ) / M) : ℂ) *
    (Real.fourierChar (-((t : ℝ) * (h : ℝ) / (P : ℝ))) : ℂ)
  have hchar (t : ℤ) :
      ZMod.stdAddChar (-((t : ZMod P) * (h : ZMod P))) =
        (Real.fourierChar (-((t : ℝ) * (h : ℝ) / (P : ℝ))) : ℂ) := by
    rw [show -((t : ZMod P) * (h : ZMod P)) =
      ((-(t * h) : ℤ) : ZMod P) by simp,
      ZMod.stdAddChar_coe, Real.fourierChar_apply]
    congr 1
    push_cast
    ring
  have hsum : (∑' t : ℤ, g t) =
      ∑ t ∈ sm.map (Nat.castEmbedding (R := ℤ)), g t := by
    apply tsum_eq_sum
    intro t ht
    have hbad : ¬ (0 ≤ t ∧ t.toNat ∈ sm) := by
      intro hgood
      apply ht
      exact Finset.mem_map.mpr ⟨t.toNat, hgood.2, by
        simpa only [Nat.castEmbedding_apply] using Int.toNat_of_nonneg hgood.1⟩
    have hs :
        (if 0 ≤ t ∧ t.toNat ∈ sm then (ψ ((t.toNat : ℝ) / M) : ℂ) else 0) =
          (ψ ((t : ℝ) / M) : ℂ) :=
      positiveCompactProfile_complete_nat_sampling c T M hc hcT hM ψ hsupport t
    rw [ite_eq_right hbad] at hs
    dsimp only [g]
    rw [← hs, zero_mul]
  calc
    _ = ∑ m ∈ sm, g (m : ℤ) := by
      apply Finset.sum_congr rfl
      intro m _
      simpa only [g, Int.cast_natCast] using
        congrArg (fun z : ℂ => (ψ ((m : ℝ) / M) : ℂ) * z) (hchar (m : ℤ))
    _ = ∑ t ∈ sm.map (Nat.castEmbedding (R := ℤ)), g t :=
      (Finset.sum_map sm (Nat.castEmbedding (R := ℤ)) g).symm
    _ = _ := hsum.symm

open Classical in
theorem mixedFiberFourierCoefficient_sourcePhiTheta
    (c T M : ℝ) (hc : 0 < c) (hcT : c ≤ T) (hM : 0 < M)
    (ψ : ℝ → ℝ) (hsupport : Function.support ψ ⊆ Set.Icc c T)
    (r q₀ u₁ v q₂ a b₁ b₂ n₁ n₂ : ℕ)
    [NeZero r] [NeZero q₀] [NeZero u₁] [NeZero v] [NeZero q₂]
    (hsq : Squarefree (r * q₀ * u₁ * v * q₂))
    (hprim : Nat.Coprime (r * q₀ * u₁ * v * q₂) (a * b₁ * b₂))
    (ℓ h : ℤ) (hshift : (n₂ : ℤ) = (n₁ : ℤ) + ℓ * (r : ℤ)) :
    let sm : Finset ℕ := Finset.Icc 1 ⌊T * M⌋₊
    let w : ℕ → ℝ := fun n => ψ ((n : ℝ) / M)
    let P : ℕ := r * q₀ * u₁ * v * q₂
    let Φ : ℂ := (M : ℂ)⁻¹ *
      ∑' t : ℤ, (ψ ((t : ℝ) / M) : ℂ) *
        (Real.fourierChar (-((t : ℝ) * (h : ℝ) / (P : ℝ))) : ℂ)
    let C : ℂ := if Nat.Coprime (n₁ * n₂) q₀ ∧
        (b₁ : ZMod q₀) * (n₁ : ZMod q₀)⁻¹ =
          (b₂ : ZMod q₀) * (n₂ : ZMod q₀)⁻¹ then 1 else 0
    let Θ : ℂ :=
      reciprocalUnitPhase r
        ((a : ZMod r) * (h : ZMod r))
        ((n₁ : ZMod r) * ((q₀ * u₁ * v * q₂ : ℕ) : ZMod r)) *
      reciprocalUnitPhase (q₀ * u₁ * v)
        ((b₁ : ZMod (q₀ * u₁ * v)) * (h : ZMod (q₀ * u₁ * v)))
        ((n₁ : ZMod (q₀ * u₁ * v)) * ((r * q₂ : ℕ) : ZMod (q₀ * u₁ * v))) *
      reciprocalUnitPhase q₂
        ((b₂ : ZMod q₂) * (h : ZMod q₂))
        ((n₂ : ZMod q₂) * ((r * q₀ * u₁ * v : ℕ) : ZMod q₂))
    mixedFiberFourierCoefficient sm w (q₀ * u₁ * v) (q₀ * q₂)
      r a b₁ b₂ n₁ n₂ ((h : ZMod P).val) =
      ((M : ℂ) / (P : ℂ)) * C * Φ * Θ := by
  extract_lets sm w P Φ C Θ
  let U : ℕ := q₀ * u₁ * v
  have hsq' : Squarefree (r * (U * q₂)) := by
    simpa only [U, Nat.mul_assoc] using hsq
  have hru : Nat.Coprime r (U * q₂) := Nat.coprime_of_squarefree_mul hsq'
  have huv : Nat.Coprime U q₂ := Nat.coprime_of_squarefree_mul hsq'.of_mul_right
  have hrU : Nat.Coprime r U := hru.coprime_mul_right_right
  have hrV : Nat.Coprime r q₂ := hru.coprime_mul_left_right
  have hq₀U : q₀ ∣ U := ⟨u₁ * v, by simp only [U, Nat.mul_assoc]⟩
  have hrq₀ : Nat.Coprime r q₀ := hrU.of_dvd_right hq₀U
  have hmod := sourcePhase_moduli_and_guard r q₀ u₁ v q₂ b₁ b₂ n₁ n₂ hsq ℓ hshift
  have hperiod : r * Nat.lcm U (q₀ * q₂) = P := hmod.2.1
  have ha : Nat.Coprime a r := by
    have hd : r ∣ P := ⟨q₀ * u₁ * v * q₂, by simp only [P, Nat.mul_assoc]⟩
    exact (hprim.of_dvd_left hd).coprime_mul_right_right.coprime_mul_right_right.symm
  have hb₁ : Nat.Coprime b₁ U := by
    have hd : U ∣ P := ⟨r * q₂, by dsimp only [P, U]; ac_rfl⟩
    exact (hprim.of_dvd_left hd).coprime_mul_right_right.coprime_mul_left_right.symm
  have hb₂ : Nat.Coprime b₂ (q₀ * q₂) := by
    have hd : q₀ * q₂ ∣ P := ⟨r * u₁ * v, by dsimp only [P]; ac_rfl⟩
    exact (hprim.of_dvd_left hd).coprime_mul_left_right.symm
  have hΘ : Θ =
      reciprocalUnitPhase r ((a : ZMod r) * (h : ZMod r))
        ((n₁ : ZMod r) * ((U * q₂ : ℕ) : ZMod r)) *
      reciprocalUnitPhase U ((b₁ : ZMod U) * (h : ZMod U))
        ((n₁ : ZMod U) * ((r * q₂ : ℕ) : ZMod U)) *
      reciprocalUnitPhase q₂ ((b₂ : ZMod q₂) * (h : ZMod q₂))
        ((n₂ : ZMod q₂) * ((r * U : ℕ) : ZMod q₂)) := by
    simp only [Θ, U, Nat.mul_assoc]
  have hcomplete :
      (∑ t ∈ mixedFiber (Finset.range P) U (q₀ * q₂) r a b₁ b₂ n₁ n₂,
        ZMod.stdAddChar ((t : ZMod P) * (h : ZMod P))) = C * Θ := by
    by_cases hg : Nat.Coprime n₁ (U * r) ∧
        Nat.Coprime n₂ ((q₀ * q₂) * r) ∧ Nat.ModEq r n₁ n₂ ∧
        Nat.ModEq (Nat.gcd U (q₀ * q₂)) (b₁ * n₂) (b₂ * n₁)
    · obtain ⟨t, hf, htr, htU, htV⟩ := sourcePhase_fiber_singleton
        U (q₀ * q₂) r a b₁ b₂ n₁ n₂ hrU.symm
        (hrq₀.mul_right hrV).symm ha hb₁ hb₂
        hg.1 hg.2.1 hg.2.2.1 hg.2.2.2
      rw [hperiod] at hf
      rw [hf, Finset.sum_singleton]
      have hsrc := hmod.2.2.mp hg
      have hn₁r : Nat.Coprime n₁ r := hg.1.coprime_mul_left_right
      have hn₁U : Nat.Coprime n₁ U := hg.1.coprime_mul_right_right
      have hn₂V : Nat.Coprime n₂ q₂ :=
        hg.2.1.coprime_mul_right_right.coprime_mul_left_right
      have hn₁q₀ : Nat.Coprime n₁ q₀ := hn₁U.of_dvd_right hq₀U
      have hn₂q₀ : Nat.Coprime n₂ q₀ :=
        hg.2.1.coprime_mul_right_right.coprime_mul_right_right
      have hC : C = 1 := ite_eq_left ⟨hn₁q₀.mul_left hn₂q₀, hsrc.2.2⟩
      rw [hC, one_mul]
      have htriple := sourcePhase_stdAddChar_three
        r U q₂ hru huv ((t : ℤ) * h)
      rw [ZMod.stdAddChar_coe] at htriple
      have htriple' :
          ZMod.stdAddChar ((t : ZMod P) * (h : ZMod P)) =
            ZMod.stdAddChar (((U * q₂ : ℕ) : ZMod r)⁻¹ *
              ((t : ZMod r) * (h : ZMod r))) *
            ZMod.stdAddChar (((r * q₂ : ℕ) : ZMod U)⁻¹ *
              ((t : ZMod U) * (h : ZMod U))) *
            ZMod.stdAddChar (((r * U : ℕ) : ZMod q₂)⁻¹ *
              ((t : ZMod q₂) * (h : ZMod q₂))) := by
        have hcast : (t : ZMod P) * (h : ZMod P) =
            (((t : ℤ) * h : ℤ) : ZMod P) := by
          simp only [Int.cast_mul, Int.cast_natCast]
        rw [hcast, ZMod.stdAddChar_coe]
        simpa only [P, U, Nat.mul_assoc, Int.cast_mul, Int.cast_natCast] using htriple
      rw [htriple',
        sourcePhase_character_reciprocal r t n₁ a (U * q₂) h hn₁r hru.symm htr,
        sourcePhase_character_reciprocal U t n₁ b₁ (r * q₂) h hn₁U
          (hrU.mul_left huv.symm) htU,
        sourcePhase_character_reciprocal q₂ t n₂ b₂ (r * U) h hn₂V
          (hrV.mul_left huv) (htV.of_dvd (dvd_mul_left q₂ q₀))]
      simp only [Θ, U, Nat.mul_assoc]
    · have hf := (mixedFiber_badGuard_zero (Finset.range P) w
        U (q₀ * q₂) r a b₁ b₂ n₁ n₂ hg).1
      rw [hf, Finset.sum_empty]
      by_cases hC : Nat.Coprime (n₁ * n₂) q₀ ∧
          (b₁ : ZMod q₀) * (n₁ : ZMod q₀)⁻¹ =
            (b₂ : ZMod q₀) * (n₂ : ZMod q₀)⁻¹
      · have hC1 : C = 1 := ite_eq_left hC
        rw [hC1, one_mul, hΘ]
        by_cases hur : IsUnit ((n₁ : ZMod r) * ((U * q₂ : ℕ) : ZMod r))
        · by_cases huU : IsUnit ((n₁ : ZMod U) * ((r * q₂ : ℕ) : ZMod U))
          · by_cases huV : IsUnit ((n₂ : ZMod q₂) * ((r * U : ℕ) : ZMod q₂))
            · have hn₁r : Nat.Coprime n₁ r :=
                (ZMod.isUnit_iff_coprime n₁ r).mp (isUnit_of_mul_isUnit_left hur)
              have hn₁U : Nat.Coprime n₁ U :=
                (ZMod.isUnit_iff_coprime n₁ U).mp (isUnit_of_mul_isUnit_left huU)
              have hn₂V : Nat.Coprime n₂ q₂ :=
                (ZMod.isUnit_iff_coprime n₂ q₂).mp (isUnit_of_mul_isUnit_left huV)
              exfalso
              apply hg
              apply hmod.2.2.mpr
              refine ⟨?_, hC.1.coprime_mul_left.mul_right hn₂V, hC.2⟩
              simpa only [U, Nat.mul_assoc] using hn₁r.mul_right hn₁U
            · simp only [reciprocalUnitPhase, ite_eq_right huV, mul_zero]
          · simp only [reciprocalUnitPhase, ite_eq_right huU,
              mul_zero, zero_mul]
        · simp only [reciprocalUnitPhase, ite_eq_right hur, zero_mul]
      · have hC0 : C = 0 := ite_eq_right hC
        rw [hC0, zero_mul]
  have hsample :
      (∑ m ∈ sm, (w m : ℂ) *
        ZMod.stdAddChar (-((m : ZMod P) * (h : ZMod P)))) = (M : ℂ) * Φ := by
    simpa only [Φ, mul_inv_cancel_left₀ (Complex.ofReal_ne_zero.mpr hM.ne')] using
      sourcePhase_sample_transform c T M hc hcT hM ψ hsupport P h
  change mixedFiberFourierCoefficient sm w U (q₀ * q₂)
    r a b₁ b₂ n₁ n₂ ((h : ZMod P).val) = _
  have hform (Q : ℕ) [NeZero Q] (hQ : r * Nat.lcm U (q₀ * q₂) = Q) :
      mixedFiberFourierCoefficient sm w U (q₀ * q₂)
          r a b₁ b₂ n₁ n₂ ((h : ZMod Q).val) =
        (Q : ℂ)⁻¹ *
          (∑ m ∈ sm, (w m : ℂ) *
            ZMod.stdAddChar (-((m : ZMod Q) * (h : ZMod Q)))) *
          ∑ t ∈ mixedFiber (Finset.range Q) U (q₀ * q₂) r a b₁ b₂ n₁ n₂,
            ZMod.stdAddChar ((t : ZMod Q) * (h : ZMod Q)) := by
    subst Q
    simp only [mixedFiberFourierCoefficient,
      dite_eq_right (NeZero.ne (r * Nat.lcm U (q₀ * q₂))), ZMod.natCast_zmod_val]
  rw [hform P hperiod, hcomplete, hsample]
  simp only [div_eq_mul_inv]
  ac_rfl

open Classical in
theorem mixedFiberFourierCoefficient_pair_sourcePhiPsi
    (c T M : ℝ) (hc : 0 < c) (hcT : c ≤ T) (hM : 0 < M)
    (ψ : ℝ → ℝ) (hsupport : Function.support ψ ⊆ Set.Icc c T)
    (r q₀ u₁ v₁ v₂ q₂ a b₁ b₂ n₁ n₂ : ℕ)
    [NeZero r] [NeZero q₀] [NeZero u₁] [NeZero v₁] [NeZero v₂] [NeZero q₂]
    (hsq₁ : Squarefree (r * q₀ * u₁ * v₁ * q₂))
    (hsq₂ : Squarefree (r * q₀ * u₁ * v₂ * q₂))
    (hprim : Nat.Coprime (r * q₀ * u₁ * v₁ * v₂ * q₂) (a * b₁ * b₂))
    (ℓ h₁ h₂ : ℤ) (hshift : (n₂ : ℤ) = (n₁ : ℤ) + ℓ * (r : ℤ)) :
    let sm : Finset ℕ := Finset.Icc 1 ⌊T * M⌋₊
    let w : ℕ → ℝ := fun n => ψ ((n : ℝ) / M)
    let P₁ : ℕ := r * q₀ * u₁ * v₁ * q₂
    let P₂ : ℕ := r * q₀ * u₁ * v₂ * q₂
    let Φ₁ : ℂ := (M : ℂ)⁻¹ *
      ∑' t : ℤ, (ψ ((t : ℝ) / M) : ℂ) *
        (Real.fourierChar (-((t : ℝ) * (h₁ : ℝ) / (P₁ : ℝ))) : ℂ)
    let Φ₂ : ℂ := (M : ℂ)⁻¹ *
      ∑' t : ℤ, (ψ ((t : ℝ) / M) : ℂ) *
        (Real.fourierChar (-((t : ℝ) * (h₂ : ℝ) / (P₂ : ℝ))) : ℂ)
    let C : ℂ := if Nat.Coprime (n₁ * n₂) q₀ ∧
        (b₁ : ZMod q₀) * (n₁ : ZMod q₀)⁻¹ =
          (b₂ : ZMod q₀) * (n₂ : ZMod q₀)⁻¹ then 1 else 0
    let Θ₁ : ℂ :=
      reciprocalUnitPhase r
        ((a : ZMod r) * (h₁ : ZMod r))
        ((n₁ : ZMod r) * ((q₀ * u₁ * v₁ * q₂ : ℕ) : ZMod r)) *
      reciprocalUnitPhase (q₀ * u₁ * v₁)
        ((b₁ : ZMod (q₀ * u₁ * v₁)) * (h₁ : ZMod (q₀ * u₁ * v₁)))
        ((n₁ : ZMod (q₀ * u₁ * v₁)) * ((r * q₂ : ℕ) : ZMod (q₀ * u₁ * v₁))) *
      reciprocalUnitPhase q₂
        ((b₂ : ZMod q₂) * (h₁ : ZMod q₂))
        ((n₂ : ZMod q₂) * ((r * q₀ * u₁ * v₁ : ℕ) : ZMod q₂))
    let Θ₂ : ℂ :=
      reciprocalUnitPhase r
        ((a : ZMod r) * (h₂ : ZMod r))
        ((n₁ : ZMod r) * ((q₀ * u₁ * v₂ * q₂ : ℕ) : ZMod r)) *
      reciprocalUnitPhase (q₀ * u₁ * v₂)
        ((b₁ : ZMod (q₀ * u₁ * v₂)) * (h₂ : ZMod (q₀ * u₁ * v₂)))
        ((n₁ : ZMod (q₀ * u₁ * v₂)) * ((r * q₂ : ℕ) : ZMod (q₀ * u₁ * v₂))) *
      reciprocalUnitPhase q₂
        ((b₂ : ZMod q₂) * (h₂ : ZMod q₂))
        ((n₂ : ZMod q₂) * ((r * q₀ * u₁ * v₂ : ℕ) : ZMod q₂))
    mixedFiberFourierCoefficient sm w (q₀ * u₁ * v₁) (q₀ * q₂)
        r a b₁ b₂ n₁ n₂ ((h₁ : ZMod P₁).val) *
      star (mixedFiberFourierCoefficient sm w (q₀ * u₁ * v₂) (q₀ * q₂)
        r a b₁ b₂ n₁ n₂ ((h₂ : ZMod P₂).val)) =
      ((M : ℂ) ^ 2 / ((P₁ : ℂ) * (P₂ : ℂ))) *
        C * Φ₁ * star Φ₂ * (Θ₁ * star Θ₂) := by
  extract_lets sm w P₁ P₂ Φ₁ Φ₂ C Θ₁ Θ₂
  have hprim₁ : Nat.Coprime P₁ (a * b₁ * b₂) :=
    hprim.of_dvd_left ⟨v₂, by dsimp only [P₁]; ac_rfl⟩
  have hprim₂ : Nat.Coprime P₂ (a * b₁ * b₂) :=
    hprim.of_dvd_left ⟨v₁, by dsimp only [P₂]; ac_rfl⟩
  have hcoef₁ :
      mixedFiberFourierCoefficient sm w (q₀ * u₁ * v₁) (q₀ * q₂)
          r a b₁ b₂ n₁ n₂ ((h₁ : ZMod P₁).val) =
        ((M : ℂ) / (P₁ : ℂ)) * C * Φ₁ * Θ₁ :=
    mixedFiberFourierCoefficient_sourcePhiTheta c T M hc hcT hM ψ hsupport
      r q₀ u₁ v₁ q₂ a b₁ b₂ n₁ n₂ hsq₁ hprim₁ ℓ h₁ hshift
  have hcoef₂ :
      mixedFiberFourierCoefficient sm w (q₀ * u₁ * v₂) (q₀ * q₂)
          r a b₁ b₂ n₁ n₂ ((h₂ : ZMod P₂).val) =
        ((M : ℂ) / (P₂ : ℂ)) * C * Φ₂ * Θ₂ :=
    mixedFiberFourierCoefficient_sourcePhiTheta c T M hc hcT hM ψ hsupport
      r q₀ u₁ v₂ q₂ a b₁ b₂ n₁ n₂ hsq₂ hprim₂ ℓ h₂ hshift
  have hC : C * star C = C := by
    dsimp only [C]
    split_ifs <;> simp
  have hstarM : star (M : ℂ) = (M : ℂ) := Complex.conj_ofReal M
  rw [hcoef₁, hcoef₂]
  simp only [star_mul, star_div₀, star_natCast, hstarM]
  calc
    _ = ((M : ℂ) ^ 2 / ((P₁ : ℂ) * (P₂ : ℂ))) *
        (C * star C) * Φ₁ * star Φ₂ * (Θ₁ * star Θ₂) := by
      simp only [div_eq_mul_inv, mul_inv_rev]
      ring
    _ = _ := by rw [hC]

open Classical in
theorem mixedFourier_offDiagonal_gcd_shift_factorization
    (sm : Finset ℕ) (w : ℕ → ℝ) (S : Finset (ℕ × ℕ))
    (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ) (a b₁ b₂ : ℕ)
    (J : ℕ → Finset ℤ) (u : ℕ → ℕ → ℕ)
    (hS : ∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Squarefree (p.1 * p.2))
    (hprim : ∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2))
    (hu : ∀ p₁ ∈ S, ∀ p₂ ∈ S, p₁.2 = p₂.2 →
      let g := Nat.gcd p₁.1 p₂.1
      0 < u g (p₁.1 / g) ∧ u g (p₁.1 / g) ∣ p₁.1 / g) :
    let Ω := (S ×ˢ S).filter (fun p => p.1.2 = p.2.2)
    let G := Ω.image (fun p => Nat.gcd p.1.1 p.2.1)
    let 𝒜 : ℕ → Finset (ℕ × ℕ × ℕ × ℕ) := fun g =>
      (Ω.filter (fun p => Nat.gcd p.1.1 p.2.1 = g)).image (fun p =>
        (p.1.2, u g (p.1.1 / g), (p.1.1 / g) / u g (p.1.1 / g), p.2.1 / g))
    let γ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
    let L : ℕ → Finset ℤ := fun r =>
      ((γ.support ×ˢ γ.support).filter
        (fun p => p.1 ≠ p.2 ∧ Int.ModEq (r : ℤ) p.1 p.2)).image
          (fun p => (p.2 - p.1) / (r : ℤ))
    (∀ g ∈ G, 0 < g ∧ ∀ t ∈ 𝒜 g,
      0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
      (g * t.2.1 * t.2.2.1, t.1) ∈ S ∧ (g * t.2.2.2, t.1) ∈ S ∧
      Nat.gcd (g * t.2.1 * t.2.2.1) (g * t.2.2.2) = g ∧
      t.1 * Nat.lcm (g * t.2.1 * t.2.2.1) (g * t.2.2.2) =
        t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2 ∧
      Squarefree (t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2) ∧
      Nat.Coprime (t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2) (a * b₁ * b₂)) ∧
    (∀ r ∈ S.image Prod.snd, ∀ ℓ ∈ L r,
      ℓ ≠ 0 ∧ ∃ n ∈ γ.support, n + ℓ * (r : ℤ) ∈ γ.support) ∧
    (∀ A N : ℕ, β.support ⊆ Finset.Icc A (A + N) →
      ∀ r ∈ S.image Prod.snd, ∀ ℓ ∈ L r, ℓ.natAbs * r ≤ N) ∧
    ((∑ r ∈ S.image Prod.snd,
        ∑ p₁ ∈ S.filter (fun p => p.2 = r),
          ∑ p₂ ∈ S.filter (fun p => p.2 = r),
            c p₁ * star (c p₂) *
              ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                if n₁ = n₂ then 0 else
                  β n₁ * star (β n₂) *
                    ∑ h ∈ J (Nat.gcd p₁.1 p₂.1),
                      mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b₁ b₂ n₁ n₂
                        ((h : ZMod (r * Nat.lcm p₁.1 p₂.1)).val)) =
      ∑ g ∈ G, ∑ t ∈ 𝒜 g,
        c (g * t.2.1 * t.2.2.1, t.1) * star (c (g * t.2.2.2, t.1)) *
          ∑ ℓ ∈ L t.1,
            ∑ n ∈ γ.support.filter (fun n => n + ℓ * (t.1 : ℤ) ∈ γ.support),
              γ n * star (γ (n + ℓ * (t.1 : ℤ))) *
                ∑ h ∈ J g,
                  mixedFiberFourierCoefficient sm w
                    (g * t.2.1 * t.2.2.1) (g * t.2.2.2) t.1 a b₁ b₂
                    n.toNat (n + ℓ * (t.1 : ℤ)).toNat
                    ((h : ZMod (t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2)).val)) := by
  intro Ω G 𝒜 γ L
  have hpos : ∀ r ∈ S.image Prod.snd, 0 < r :=
    Finset.forall_mem_image.mpr (fun p hp => (hS p hp).2.1)
  have hmeta : ∀ g ∈ G, 0 < g ∧ ∀ t ∈ 𝒜 g,
      0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
      (g * t.2.1 * t.2.2.1, t.1) ∈ S ∧ (g * t.2.2.2, t.1) ∈ S ∧
      Nat.gcd (g * t.2.1 * t.2.2.1) (g * t.2.2.2) = g ∧
      t.1 * Nat.lcm (g * t.2.1 * t.2.2.1) (g * t.2.2.2) =
        t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2 ∧
      Squarefree (t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2) ∧
      Nat.Coprime (t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2) (a * b₁ * b₂) := by
    intro g hg
    obtain ⟨p, hp, hpg⟩ := Finset.mem_image.mp hg
    have hp' := Finset.mem_product.mp (Finset.mem_filter.mp hp).1
    refine ⟨hpg ▸ Nat.gcd_pos_of_pos_left p.2.1 (hS p.1 hp'.1).1, ?_⟩
    intro t ht
    obtain ⟨q, hq, rfl⟩ := Finset.mem_image.mp ht
    have hqg := (Finset.mem_filter.mp hq).2
    have hqΩ := Finset.mem_filter.mp (Finset.mem_filter.mp hq).1
    have hqS := Finset.mem_product.mp hqΩ.1
    have huq := hu q.1 hqS.1 q.2 hqS.2 hqΩ.2
    have hf := sourceAssembly_gcd_factorization q.1.1 q.2.1 q.1.2
      (u (Nat.gcd q.1.1 q.2.1) (q.1.1 / Nat.gcd q.1.1 q.2.1)) (a * b₁ * b₂)
      (hS q.1 hqS.1).1 (hS q.2 hqS.2).1 (hS q.1 hqS.1).2.1
      (hS q.1 hqS.1).2.2 (by simpa only [hqΩ.2] using (hS q.2 hqS.2).2.2)
      (hprim q.1 hqS.1) (by simpa only [hqΩ.2] using hprim q.2 hqS.2) huq
    simp only [hqg] at hf huq
    rcases hf with ⟨_, hv, hk₂, hrec₁, hrec₂, hperiod, hsq, hprimitive⟩
    refine ⟨(hS q.1 hqS.1).2.1, huq.1, hv, hk₂, ?_, ?_, ?_, ?_, hsq, hprimitive⟩
    · simpa only [hrec₁] using hqS.1
    · simpa only [hrec₂, hqΩ.2] using hqS.2
    · simpa only [hrec₁, hrec₂] using hqg
    · simpa only [hrec₁, hrec₂] using hperiod
  refine ⟨hmeta, ?_, ?_, ?_⟩
  · intro r hr
    exact (sourceAssembly_signed_support_reindex β r (hpos r hr)
      (fun _ _ => 0) (by simp)).1
  · intro A N hβ r hr
    exact (sourceAssembly_signed_support_reindex β r (hpos r hr)
      (fun _ _ => 0) (by simp)).2.1 A N hβ
  · let K : ℕ → (ℕ × ℕ) → (ℕ × ℕ) → ℂ := fun r p₁ p₂ =>
      c p₁ * star (c p₂) *
        ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
          if n₁ = n₂ then 0 else β n₁ * star (β n₂) *
            ∑ h ∈ J (Nat.gcd p₁.1 p₂.1),
              mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b₁ b₂ n₁ n₂
                ((h : ZMod (r * Nat.lcm p₁.1 p₂.1)).val)
    refine (sourceAssembly_ordered_gcd_sum S u K
      (fun p₁ hp₁ p₂ hp₂ heq => (hu p₁ hp₁ p₂ hp₂ heq).2)).trans ?_
    apply Finset.sum_congr rfl
    intro g hg
    apply Finset.sum_congr rfl
    intro t ht
    rcases (hmeta g hg).2 t ht with ⟨hrt, _, _, _, _, _, hgd, hper, _, _⟩
    dsimp only [K]
    rw [hgd, hper]
    congr 1
    let F : ℕ → ℕ → ℂ := fun n₁ n₂ =>
      ∑ h ∈ J g,
        mixedFiberFourierCoefficient sm w
          (g * t.2.1 * t.2.2.1) (g * t.2.2.2) t.1 a b₁ b₂ n₁ n₂
          ((h : ZMod (t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2)).val)
    have hF : ∀ n₁ ∈ β.support, ∀ n₂ ∈ β.support,
        ¬ Nat.ModEq t.1 n₁ n₂ → F n₁ n₂ = 0 := by
      intro n₁ _ n₂ _ hbad
      have he := (mixedFiber_badGuard_zero
        (Finset.range (t.1 * Nat.lcm (g * t.2.1 * t.2.2.1) (g * t.2.2.2))) w
        (g * t.2.1 * t.2.2.1) (g * t.2.2.2) t.1 a b₁ b₂ n₁ n₂
        (by intro hguard; exact hbad hguard.2.2.1)).1
      dsimp only [F, mixedFiberFourierCoefficient]
      simp [he]
    exact (sourceAssembly_signed_support_reindex β t.1 hrt F hF).2.2

open Classical in
theorem factoredMixedFourier_sourcePhiTheta
    (cM TM M : ℝ) (hcM : 0 < cM) (hcMT : cM ≤ TM) (hM : 0 < M)
    (ψM : ℝ → ℝ) (hsupport : Function.support ψM ⊆ Set.Icc cM TM)
    (𝒜 : Finset (ℕ × ℕ × ℕ × ℕ)) (β : ℕ →₀ ℂ)
    (c : ℕ × ℕ → ℂ) (q₀ a b₁ b₂ : ℕ) [NeZero q₀]
    (ℓ : ℤ) (J : Finset ℤ)
    (h𝒜 : ∀ t ∈ 𝒜,
      0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
      Squarefree (t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2) ∧
      Nat.Coprime (t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2) (a * b₁ * b₂)) :
    let sm : Finset ℕ := Finset.Icc 1 ⌊TM * M⌋₊
    let w : ℕ → ℝ := fun n => ψM ((n : ℝ) / M)
    let γ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
    let P : (ℕ × ℕ × ℕ × ℕ) → ℕ := fun t =>
      t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2
    (∑ t ∈ 𝒜,
      c (q₀ * t.2.1 * t.2.2.1, t.1) * star (c (q₀ * t.2.2.2, t.1)) *
        ∑ n ∈ γ.support.filter (fun n => n + ℓ * (t.1 : ℤ) ∈ γ.support),
          γ n * star (γ (n + ℓ * (t.1 : ℤ))) *
            ∑ h ∈ J,
              mixedFiberFourierCoefficient sm w
                (q₀ * t.2.1 * t.2.2.1) (q₀ * t.2.2.2) t.1 a b₁ b₂
                n.toNat (n + ℓ * (t.1 : ℤ)).toNat ((h : ZMod (P t)).val)) =
      ∑ t ∈ 𝒜,
        c (q₀ * t.2.1 * t.2.2.1, t.1) * star (c (q₀ * t.2.2.2, t.1)) *
          ((M : ℂ) / (P t : ℂ)) *
            ∑ n ∈ γ.support.filter (fun n =>
              Int.gcd n ((t.1 * q₀ * t.2.1 * t.2.2.1 : ℕ) : ℤ) = 1 ∧
              Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2.2 : ℕ) : ℤ) = 1),
              γ n * star (γ (n + ℓ * (t.1 : ℤ))) *
                (sourceCompatibility t.1 q₀ b₁ b₂ ℓ n : ℂ) *
                  ∑ h ∈ J, sourcePhi ψM M (P t) h *
                    sourceTheta t.1 q₀ t.2.1 t.2.2.1 t.2.2.2 a b₁ b₂ ℓ n h := by
  extract_lets sm w γ P
  have hγcast (n : ℤ) (hn : n ∈ γ.support) : ((n.toNat : ℕ) : ℤ) = n := by
    obtain ⟨k, _, rfl⟩ := Finset.mem_map.mp hn
    simp
  have hcastZ (m : ℕ) (z : ℤ) (hz : ((z.toNat : ℕ) : ℤ) = z) :
      (z.toNat : ZMod m) = (z : ZMod m) := by
    conv_rhs => rw [← hz, Int.cast_natCast]
  have hgcdcast (z : ℤ) (hz : ((z.toNat : ℕ) : ℤ) = z) (m : ℕ) :
      Int.gcd z (m : ℤ) = 1 ↔ Nat.Coprime z.toNat m := by
    conv_lhs => rw [← hz, Int.gcd_natCast_natCast]
  apply Finset.sum_congr rfl
  intro t ht
  obtain ⟨hr, hu, hv, hq₂, hsq, hprim⟩ := h𝒜 t ht
  let : NeZero t.1 := NeZero.of_gt hr
  let : NeZero t.2.1 := NeZero.of_gt hu
  let : NeZero t.2.2.1 := NeZero.of_gt hv
  let : NeZero t.2.2.2 := NeZero.of_gt hq₂
  have hp : t.1 ≠ 0 ∧ q₀ * t.2.1 * t.2.2.1 ≠ 0 ∧ t.2.2.2 ≠ 0 :=
    ⟨NeZero.ne _, NeZero.ne _, NeZero.ne _⟩
  let ρ : ℂ := (M : ℂ) / (P t : ℂ)
  let good : ℤ → Prop := fun n =>
    Int.gcd n ((t.1 * q₀ * t.2.1 * t.2.2.1 : ℕ) : ℤ) = 1 ∧
      Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2.2 : ℕ) : ℤ) = 1
  let leftTerm : ℤ → ℂ := fun n =>
    γ n * star (γ (n + ℓ * (t.1 : ℤ))) *
      ∑ h ∈ J, mixedFiberFourierCoefficient sm w
        (q₀ * t.2.1 * t.2.2.1) (q₀ * t.2.2.2) t.1 a b₁ b₂
        n.toNat (n + ℓ * (t.1 : ℤ)).toNat ((h : ZMod (P t)).val)
  let rightTerm : ℤ → ℂ := fun n =>
    γ n * star (γ (n + ℓ * (t.1 : ℤ))) *
      (sourceCompatibility t.1 q₀ b₁ b₂ ℓ n : ℂ) *
        ∑ h ∈ J, sourcePhi ψM M (P t) h *
          sourceTheta t.1 q₀ t.2.1 t.2.2.1 t.2.2.2 a b₁ b₂ ℓ n h
  have hphase (n : ℤ) (hn : n ∈ γ.support)
      (hn₂ : n + ℓ * (t.1 : ℤ) ∈ γ.support) (h : ℤ) :
      mixedFiberFourierCoefficient sm w
        (q₀ * t.2.1 * t.2.2.1) (q₀ * t.2.2.2) t.1 a b₁ b₂
        n.toNat (n + ℓ * (t.1 : ℤ)).toNat ((h : ZMod (P t)).val) =
      ρ * (sourceCompatibility t.1 q₀ b₁ b₂ ℓ n : ℂ) *
        sourcePhi ψM M (P t) h *
          sourceTheta t.1 q₀ t.2.1 t.2.2.1 t.2.2.2 a b₁ b₂ ℓ n h := by
    have hncast := hγcast n hn
    have hn₂cast := hγcast (n + ℓ * (t.1 : ℤ)) hn₂
    have hcoprod :
        Nat.Coprime (n.toNat * (n + ℓ * (t.1 : ℤ)).toNat) q₀ ↔
          Int.gcd (n * (n + ℓ * (t.1 : ℤ))) (q₀ : ℤ) = 1 := by
      rw [Nat.coprime_iff_gcd_eq_one, ← Int.gcd_natCast_natCast,
        Nat.cast_mul, hncast, hn₂cast]
    dsimp only [sourcePhi, sourceTheta, sourceCompatibility]
    simpa only [sm, w, P, ρ,
      dite_eq_left hp, apply_ite Complex.ofReal, Complex.ofReal_one, Complex.ofReal_zero,
      hcoprod, hcastZ q₀ n hncast,
      hcastZ q₀ (n + ℓ * (t.1 : ℤ)) hn₂cast,
      hcastZ t.1 n hncast, hcastZ (q₀ * t.2.1 * t.2.2.1) n hncast,
      hcastZ t.2.2.2 (n + ℓ * (t.1 : ℤ)) hn₂cast] using
      (mixedFiberFourierCoefficient_sourcePhiTheta
        cM TM M hcM hcMT hM ψM hsupport
        t.1 q₀ t.2.1 t.2.2.1 t.2.2.2 a b₁ b₂
        n.toNat (n + ℓ * (t.1 : ℤ)).toNat hsq hprim ℓ h
        (by rw [hncast, hn₂cast]))
  have hpoint (n : ℤ) (hn : n ∈ γ.support)
      (hn₂ : n + ℓ * (t.1 : ℤ) ∈ γ.support) :
      leftTerm n = if good n then ρ * rightTerm n else 0 := by
    by_cases hg : good n
    · rw [ite_eq_left hg]
      dsimp only [leftTerm, rightTerm]
      simp_rw [hphase n hn hn₂]
      simp only [Finset.mul_sum, mul_assoc, mul_left_comm]
    · rw [ite_eq_right hg]
      have he := (mixedFiber_badGuard_zero
        (Finset.range (t.1 * Nat.lcm (q₀ * t.2.1 * t.2.2.1) (q₀ * t.2.2.2))) w
        (q₀ * t.2.1 * t.2.2.1) (q₀ * t.2.2.2) t.1 a b₁ b₂
        n.toNat (n + ℓ * (t.1 : ℤ)).toNat (by
          intro hguard
          apply hg
          exact ⟨(hgcdcast n (hγcast n hn) _).mpr (by
              simpa only [Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm] using hguard.1),
            (hgcdcast (n + ℓ * (t.1 : ℤ)) (hγcast _ hn₂) _).mpr
              hguard.2.1.coprime_mul_right_right⟩)).1
      dsimp only [leftTerm, mixedFiberFourierCoefficient]
      simp [he]
  have hsum :
      (∑ n ∈ γ.support.filter (fun n => n + ℓ * (t.1 : ℤ) ∈ γ.support), leftTerm n) =
        ρ * ∑ n ∈ γ.support.filter good, rightTerm n := by
    rw [Finset.sum_filter, Finset.sum_filter, Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro n hn
    by_cases hn₂ : n + ℓ * (t.1 : ℤ) ∈ γ.support
    · rw [ite_eq_left hn₂, hpoint n hn hn₂, mul_ite_zero]
    · have hz : γ (n + ℓ * (t.1 : ℤ)) = 0 := Finsupp.notMem_support_iff.mp hn₂
      simp [hn₂, rightTerm, hz]
  dsimp only [leftTerm, rightTerm, good, ρ] at hsum
  rw [hsum]
  ring

open Classical in
theorem sourceSigmaOne_coefficient_cauchy
    (𝒜 : Finset (ℕ × ℕ × ℕ × ℕ)) (β : ℕ →₀ ℂ)
    (c : ℕ × ℕ → ℂ) (q₀ a b₁ b₂ : ℕ) [NeZero q₀]
    (ℓ : ℤ) (J : Finset ℤ) (ψM χ : ℝ → ℝ)
    (cN TN M N R Q : ℝ)
    (hcN : 0 < cN) (hcNT : cN ≤ TN)
    (hM : 0 < M) (hN : 0 < N) (hR : 0 < R) (hQ : 0 < Q)
    (hχsupport : Function.support χ ⊆ Set.Icc cN TN)
    (hχnonneg : ∀ t : ℝ, 0 ≤ χ t)
    (hχmajor : ∀ n ∈ β.support, 1 ≤ χ ((n : ℝ) / N))
    (h𝒜 : ∀ t ∈ 𝒜,
      0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
      R ≤ (t.1 : ℝ) ∧ Q ≤ ((q₀ * t.2.1 * t.2.2.1 : ℕ) : ℝ) ∧
      Q ≤ ((q₀ * t.2.2.2 : ℕ) : ℝ))
    (hc : ∀ t ∈ 𝒜,
      ‖c (q₀ * t.2.1 * t.2.2.1, t.1)‖ ≤ 1 ∧
      ‖c (q₀ * t.2.2.2, t.1)‖ ≤ 1) :
    let γ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
    let P : (ℕ × ℕ × ℕ × ℕ) → ℕ := fun t =>
      t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2
    let B : Finset (ℕ × ℕ × ℕ) := 𝒜.image (fun t => (t.1, t.2.1, t.2.2.2))
    let Γ : ℝ := ∑ t ∈ B, ∑ n ∈ γ.support,
      if Int.gcd n ((t.1 * q₀ * t.2.1 : ℕ) : ℤ) = 1 ∧
          Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2 : ℕ) : ℤ) = 1
      then sourceCompatibility t.1 q₀ b₁ b₂ ℓ n *
        ‖γ n * star (γ (n + ℓ * (t.1 : ℤ)))‖ ^ 2
      else 0
    (∑ t ∈ 𝒜,
      ‖c (q₀ * t.2.1 * t.2.2.1, t.1) * star (c (q₀ * t.2.2.2, t.1)) *
        ((M : ℂ) / (P t : ℂ)) *
          ∑ n ∈ γ.support.filter (fun n =>
            Int.gcd n ((t.1 * q₀ * t.2.1 * t.2.2.1 : ℕ) : ℤ) = 1 ∧
            Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2.2 : ℕ) : ℤ) = 1),
            γ n * star (γ (n + ℓ * (t.1 : ℤ))) *
              (sourceCompatibility t.1 q₀ b₁ b₂ ℓ n : ℂ) *
                ∑ h ∈ J, sourcePhi ψM M (P t) h *
                  sourceTheta t.1 q₀ t.2.1 t.2.2.1 t.2.2.2 a b₁ b₂ ℓ n h‖) ^ 2 ≤
      (M * (q₀ : ℝ) / (R * Q ^ 2)) ^ 2 * Γ *
        sourceSigmaOne 𝒜 J ψM (fun t => χ (t / N)) M q₀ a b₁ b₂ ℓ := by
  extract_lets γ P B Γ
  let base : (ℕ × ℕ × ℕ × ℕ) → ℕ × ℕ × ℕ :=
    fun t => (t.1, t.2.1, t.2.2.2)
  let p : (ℕ × ℕ × ℕ) → ℤ → Prop := fun t n =>
    Int.gcd n ((t.1 * q₀ * t.2.1 : ℕ) : ℤ) = 1 ∧
    Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2 : ℕ) : ℤ) = 1 ∧
    sourceCompatibility t.1 q₀ b₁ b₂ ℓ n = 1
  let pair : (ℕ × ℕ × ℕ) → ℤ → ℂ := fun t n =>
    γ n * star (γ (n + ℓ * (t.1 : ℤ)))
  let f : (ℕ × ℕ × ℕ × ℕ) → ℤ → ℂ := fun t n =>
    if Int.gcd n (t.2.2.1 : ℤ) = 1 then
      ∑ h ∈ J, sourcePhi ψM M (P t) h *
        sourceTheta t.1 q₀ t.2.1 t.2.2.1 t.2.2.2 a b₁ b₂ ℓ n h
    else 0
  let d : (ℕ × ℕ × ℕ × ℕ) → ℂ := fun t =>
    c (q₀ * t.2.1 * t.2.2.1, t.1) * star (c (q₀ * t.2.2.2, t.1)) *
      ((M : ℂ) / (P t : ℂ))
  let K : ℝ := M * (q₀ : ℝ) / (R * Q ^ 2)
  let χN : ℤ → ℝ := fun n => χ ((n : ℝ) / N)
  let sn : Finset ℕ := Finset.Icc 1 ⌊TN * N⌋₊
  let s : Finset ℤ := γ.support ∪ sn.map (Nat.castEmbedding : ℕ ↪ ℤ)
  have hγs : γ.support ⊆ s := Finset.subset_union_left
  have hsχ (n : ℤ) (hn : n ∉ s) : χ ((n : ℝ) / N) = 0 := by
    have hbad : ¬ (0 ≤ n ∧ n.toNat ∈ sn) := by
      rintro ⟨hn0, hsn⟩
      apply hn
      exact Finset.mem_union_right _ (Finset.mem_map.mpr
        ⟨n.toNat, hsn, Int.toNat_of_nonneg hn0⟩)
    dsimp only [sn] at hbad
    apply Complex.ofReal_eq_zero.mp
    simpa only [ite_eq_right hbad] using
      (positiveCompactProfile_complete_nat_sampling
        cN TN N hcN hcNT hN χ hχsupport n).symm
  have hcompat (r : ℕ) (n : ℤ) :
      sourceCompatibility r q₀ b₁ b₂ ℓ n = 0 ∨
        sourceCompatibility r q₀ b₁ b₂ ℓ n = 1 :=
    Or.symm (ite_eq_or_eq _ _ _)
  have hunit (t : ℕ × ℕ × ℕ × ℕ) (n : ℤ) :
      Int.gcd n ((t.1 * q₀ * t.2.1 * t.2.2.1 : ℕ) : ℤ) = 1 ↔
        Int.gcd n ((t.1 * q₀ * t.2.1 : ℕ) : ℤ) = 1 ∧
        Int.gcd n (t.2.2.1 : ℤ) = 1 := by
    simp only [← Int.isCoprime_iff_gcd_eq_one, Nat.cast_mul,
      IsCoprime.mul_right_iff]
  have hinner (t : ℕ × ℕ × ℕ × ℕ) :
      (∑ n ∈ γ.support.filter (fun n =>
        Int.gcd n ((t.1 * q₀ * t.2.1 * t.2.2.1 : ℕ) : ℤ) = 1 ∧
          Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2.2 : ℕ) : ℤ) = 1),
        γ n * star (γ (n + ℓ * (t.1 : ℤ))) *
          (sourceCompatibility t.1 q₀ b₁ b₂ ℓ n : ℂ) *
            ∑ h ∈ J, sourcePhi ψM M (P t) h *
              sourceTheta t.1 q₀ t.2.1 t.2.2.1 t.2.2.2 a b₁ b₂ ℓ n h) =
        ∑ n ∈ s.filter (p (base t)), pair (base t) n * f t n := by
    calc
      _ = ∑ n ∈ γ.support.filter (p (base t)), pair (base t) n * f t n := by
        simp only [Finset.sum_filter]
        apply Finset.sum_congr rfl
        intro n _
        simp only [hunit t n]
        rcases hcompat t.1 n with hC | hC
        · simp [p, base, hC]
        · by_cases hv : Int.gcd n (t.2.2.1 : ℤ) = 1
          · simp [p, pair, f, base, hC, hv]
          · simp [p, f, base, hC, hv]
      _ = _ := by
        simpa only [Finsupp.sum, Finset.sum_filter, pair, base] using
          γ.sum_of_support_subset hγs
            (fun n z => if p (base t) n then
              z * star (γ (n + ℓ * (t.1 : ℤ))) * f t n else 0)
            (fun n _ => by simp)
  have henergy :
      (∑ j ∈ 𝒜.image base, ∑ n ∈ s.filter (p j), ‖pair j n‖ ^ 2) = Γ := by
    apply Finset.sum_congr rfl
    intro j _
    calc
      _ = ∑ n ∈ γ.support.filter (p j), ‖pair j n‖ ^ 2 := by
        symm
        simpa only [Finsupp.sum, Finset.sum_filter, pair] using
          γ.sum_of_support_subset hγs
            (fun n z => if p j n then
              ‖z * star (γ (n + ℓ * (j.1 : ℤ)))‖ ^ 2 else 0)
            (fun n _ => by simp)
      _ = _ := by
        simp only [Finset.sum_filter]
        apply Finset.sum_congr rfl
        intro n _
        rcases hcompat j.1 n with hC | hC
        · simp [p, hC]
        · simp [p, pair, hC]
  have hq₀ : 0 < q₀ := NeZero.pos q₀
  have hd (t : ℕ × ℕ × ℕ × ℕ) (ht : t ∈ 𝒜) : ‖d t‖ ≤ K := by
    rcases h𝒜 t ht with ⟨hr, hu, hv, hq₂, hRr, hQ₁, hQ₂⟩
    have hP : 0 < (P t : ℝ) := by positivity
    have hqq : Q ^ 2 ≤
        ((q₀ * t.2.1 * t.2.2.1 : ℕ) : ℝ) *
          ((q₀ * t.2.2.2 : ℕ) : ℝ) := by
      simpa only [pow_two] using
        mul_le_mul hQ₁ hQ₂ hQ.le (hQ.le.trans hQ₁)
    have hden : R * Q ^ 2 ≤ (P t : ℝ) * (q₀ : ℝ) := by
      simpa only [P, Nat.cast_mul, mul_assoc, mul_left_comm, mul_comm] using
        mul_le_mul hRr hqq (sq_nonneg _) (Nat.cast_nonneg _)
    have hscale : M / (P t : ℝ) ≤ K := by
      apply (div_le_div_iff₀ hP (mul_pos hR (pow_pos hQ 2))).mpr
      simpa only [mul_assoc, mul_left_comm, mul_comm] using
        mul_le_mul_of_nonneg_left hden hM.le
    calc
      ‖d t‖ ≤ M / (P t : ℝ) := by
        dsimp only [d]
        simp only [norm_mul, norm_star, norm_div,
          Complex.norm_of_nonneg hM.le, Complex.norm_natCast]
        exact mul_le_of_le_one_left (div_nonneg hM.le hP.le)
          ((mul_le_of_le_one_left (norm_nonneg _) (hc t ht).1).trans (hc t ht).2)
      _ ≤ K := hscale
  have hmajor : ∀ j ∈ 𝒜.image base, ∀ n ∈ s,
      p j n → pair j n ≠ 0 → 1 ≤ χN n := by
    intro j _ n _ _ hpair
    have hnγ : n ∈ γ.support :=
      Finsupp.mem_support_iff.mpr (left_ne_zero_of_mul hpair)
    obtain ⟨m, hm, rfl⟩ := Finset.mem_map.mp hnγ
    simpa only [χN, Nat.castEmbedding_apply, Int.cast_natCast] using hχmajor m hm
  have hgram := sourceAssembly_sourceSigmaOne_eq_finite_gram
    𝒜 J ψM (fun t => χ (t / N)) M q₀ a b₁ b₂ ℓ s hsχ
  change sourceSigmaOne 𝒜 J ψM (fun t => χ (t / N)) M q₀ a b₁ b₂ ℓ =
    (∑ t₁ ∈ 𝒜, ∑ t₂ ∈ 𝒜.filter (fun t₂ => base t₂ = base t₁),
      ‖∑ n ∈ s.filter (p (base t₁)), (χN n : ℂ) * f t₁ n * star (f t₂ n)‖) at hgram
  have himage :
      @Finset.image (ℕ × ℕ × ℕ × ℕ) (ℕ × ℕ × ℕ)
        (fun x y => Classical.propDecidable (x = y)) base 𝒜 = 𝒜.image base := by
    congr; exact Subsingleton.elim _ _
  have hfilter (j : ℕ × ℕ × ℕ) :
      @Finset.filter ℤ (p j) (fun n => Classical.propDecidable (p j n)) s =
        s.filter (p j) :=
    Finset.filter_congr_decidable s (p j) _
  have hbasefilter (t : ℕ × ℕ × ℕ × ℕ) :
      @Finset.filter (ℕ × ℕ × ℕ × ℕ) (fun u => base u = base t)
        (fun u => Classical.propDecidable (base u = base t)) 𝒜 =
          𝒜.filter (fun u => base u = base t) :=
    Finset.filter_congr_decidable 𝒜 (fun u => base u = base t) _
  have hbound := sourceAssembly_grouped_coefficient_cauchy
    𝒜 s base p d pair f χN K (by positivity) hd (fun n _ => hχnonneg ((n : ℝ) / N))
      (by simpa only [Finset.mem_image] using hmajor)
  simp_rw [himage, hfilter, hbasefilter] at hbound
  rw [henergy, ← hgram] at hbound
  simpa only [d, K, ← hinner] using hbound

open Classical in
theorem diagonal_product_indicator_family_sum_le
    (S : Finset (ℕ × ℕ)) (X U V a b₁ b₂ : ℕ)
    (hS : ∀ p ∈ S, 1 ≤ p.1 ∧ p.1 ≤ U ∧ 1 ≤ p.2 ∧ p.2 ≤ V)
    (hcop : ∀ p ∈ S, Nat.Coprime p.1 p.2) :
    (∑ r ∈ S.image Prod.snd,
      ∑ p₁ ∈ S.filter (fun p => p.2 = r),
        ∑ p₂ ∈ S.filter (fun p => p.2 = r),
          (((Finset.Icc 1 X).filter (fun s =>
            Nat.Coprime s (p₁.1 * r) ∧ Nat.Coprime s (p₂.1 * r) ∧
              s % r = a % r ∧ s % p₁.1 = b₁ % p₁.1 ∧
                s % p₂.1 = b₂ % p₂.1)).card : ℝ)) ≤
      (X : ℝ) * (1 + Real.log (V : ℝ)) *
        (1 + Real.log (U : ℝ)) ^ 2 * (2 + Real.log (U : ℝ)) +
          (V : ℝ) * (U : ℝ) ^ 2 := by
  let I := S.image Prod.snd
  let H : ℝ := 1 + Real.log (U : ℝ)
  let K : ℝ := H ^ 2 * (H + 1)
  let C : ℕ → (ℕ × ℕ) → (ℕ × ℕ) → ℝ := fun r p₁ p₂ =>
    (((Finset.Icc 1 X).filter (fun s =>
      Nat.Coprime s (p₁.1 * r) ∧ Nat.Coprime s (p₂.1 * r) ∧
        s % r = a % r ∧ s % p₁.1 = b₁ % p₁.1 ∧
          s % p₂.1 = b₂ % p₂.1)).card : ℝ)
  have hharm (n : ℕ) : (∑ q ∈ Finset.Icc 1 n, (q : ℝ)⁻¹) ≤
      1 + Real.log (n : ℝ) := by
    simpa only [harmonic_eq_sum_Icc, Rat.cast_sum, Rat.cast_inv,
      Rat.cast_natCast] using harmonic_le_one_add_log n
  have hI : I ⊆ Finset.Icc 1 V :=
    Finset.image_subset_iff.mpr fun p hp =>
      Finset.mem_Icc.mpr ⟨(hS p hp).2.2.1, (hS p hp).2.2.2⟩
  have hIcard : I.card ≤ V := by
    simpa using Finset.card_le_card hI
  have hIinv : (∑ r ∈ I, (r : ℝ)⁻¹) ≤ 1 + Real.log (V : ℝ) := by
    calc
      _ ≤ ∑ r ∈ Finset.Icc 1 V, (r : ℝ)⁻¹ :=
        Finset.sum_le_sum_of_subset_of_nonneg hI
          (fun _ _ _ => by positivity)
      _ ≤ _ := hharm V
  have hfiber (r : ℕ) (hr : r ∈ I) :
      (∑ p₁ ∈ S.filter (fun p => p.2 = r),
        ∑ p₂ ∈ S.filter (fun p => p.2 = r), C r p₁ p₂) ≤
          (X : ℝ) / (r : ℝ) * K + (U : ℝ) ^ 2 := by
    let T := S.filter (fun p => p.2 = r)
    have hT : ∀ p ∈ T, 1 ≤ p.1 ∧ p.1 ≤ U ∧ p.2 = r := by
      intro p hp
      have hp' := Finset.mem_filter.mp hp
      exact ⟨(hS p hp'.1).1, (hS p hp'.1).2.1, hp'.2⟩
    have hTcop (p : ℕ × ℕ) (hp : p ∈ T) : Nat.Coprime p.1 r := by
      simpa only [(hT p hp).2.2] using hcop p (Finset.mem_filter.mp hp).1
    have hinj : Set.InjOn Prod.fst (T : Set (ℕ × ℕ)) := by
      intro p hp q hq he
      exact Prod.ext he ((hT p hp).2.2.trans (hT q hq).2.2.symm)
    have himage : T.image Prod.fst ⊆ Finset.Icc 1 U :=
      Finset.image_subset_iff.mpr fun p hp =>
        Finset.mem_Icc.mpr ⟨(hT p hp).1, (hT p hp).2.1⟩
    have hcardT : T.card ≤ U := by
      simpa [Finset.card_image_of_injOn hinj] using Finset.card_le_card himage
    have hTsum : (∑ p ∈ T, (p.1 : ℝ)⁻¹) ≤ H := by
      calc
        _ ≤ ∑ q ∈ Finset.Icc 1 U, (q : ℝ)⁻¹ :=
          Finset.sum_le_sum_of_injOn Prod.fst hinj himage
            (fun _ _ => le_rfl) (fun _ _ _ => by positivity)
        _ ≤ _ := hharm U
    have hpair : (∑ p₁ ∈ T, ∑ p₂ ∈ T, (Nat.lcm p₁.1 p₂.1 : ℝ)⁻¹) ≤ K := by
      calc
        _ ≤ ∑ p₁ ∈ T, ∑ p₂ ∈ T,
            ((p₁.1 : ℝ)⁻¹ * (p₂.1 : ℝ)⁻¹ +
              if 1 < Nat.gcd p₁.1 p₂.1 then (Nat.lcm p₁.1 p₂.1 : ℝ)⁻¹ else 0) := by
          apply Finset.sum_le_sum
          intro p₁ hp₁
          apply Finset.sum_le_sum
          intro p₂ _
          by_cases hg : 1 < Nat.gcd p₁.1 p₂.1
          · rw [ite_eq_left hg]
            exact le_add_of_nonneg_left (by positivity)
          · have hcopair : Nat.Coprime p₁.1 p₂.1 :=
              (Nat.le_of_not_gt hg).antisymm (Nat.gcd_pos_of_pos_left _ (hT p₁ hp₁).1)
            simp [hg, hcopair.lcm_eq_mul, mul_comm]
        _ = (∑ p ∈ T, (p.1 : ℝ)⁻¹) ^ 2 +
            ∑ p₁ ∈ T, ∑ p₂ ∈ T.filter (fun p₂ => 1 < Nat.gcd p₁.1 p₂.1),
              (Nat.lcm p₁.1 p₂.1 : ℝ)⁻¹ := by
          simp only [Finset.sum_add_distrib, ← Finset.sum_filter, pow_two,
            Finset.sum_mul_sum]
        _ ≤ H ^ 2 + H ^ 2 * H :=
          add_le_add (pow_le_pow_left₀ (by positivity) hTsum 2) (by
            simpa only [H, zero_div, add_zero, mul_one] using
              rough_moduli_noncoprime_lcm_sum_le T r U 2 0 le_rfl le_rfl hT
                (fun _ _ _ ht _ => ht.two_le))
        _ = K := by dsimp [K]; ring
    change (∑ p₁ ∈ T, ∑ p₂ ∈ T, C r p₁ p₂) ≤ _
    calc
      _ ≤ ∑ p₁ ∈ T, ∑ p₂ ∈ T,
          ((X : ℝ) / (r : ℝ) * (Nat.lcm p₁.1 p₂.1 : ℝ)⁻¹ + 1) := by
        apply Finset.sum_le_sum
        intro p₁ hp₁
        apply Finset.sum_le_sum
        intro p₂ hp₂
        calc
          C r p₁ p₂ ≤ (X : ℝ) / ((r * Nat.lcm p₁.1 p₂.1 : ℕ) : ℝ) + 1 :=
            diagonal_product_indicator_card_le X p₁.1 p₂.1 r a b₁ b₂
              (hT p₁ hp₁).1 (hT p₂ hp₂).1 (Finset.mem_Icc.mp (hI hr)).1
              (hTcop p₁ hp₁) (hTcop p₂ hp₂)
          _ = _ := by rw [Nat.cast_mul, div_mul_eq_div_mul_one_div, one_div]
      _ = (X : ℝ) / (r : ℝ) *
          (∑ p₁ ∈ T, ∑ p₂ ∈ T, (Nat.lcm p₁.1 p₂.1 : ℝ)⁻¹) +
            (T.card : ℝ) ^ 2 := by
        simp only [Finset.sum_add_distrib, ← Finset.mul_sum, Finset.sum_const,
          nsmul_eq_mul, mul_one]
        ring
      _ ≤ (X : ℝ) / (r : ℝ) * K + (U : ℝ) ^ 2 :=
        add_le_add (mul_le_mul_of_nonneg_left hpair (by positivity))
          (pow_le_pow_left₀ (Nat.cast_nonneg _) (by exact_mod_cast hcardT) 2)
  change (∑ r ∈ I, ∑ p₁ ∈ S.filter (fun p => p.2 = r),
    ∑ p₂ ∈ S.filter (fun p => p.2 = r), C r p₁ p₂) ≤ _
  calc
    _ ≤ ∑ r ∈ I, ((X : ℝ) / (r : ℝ) * K + (U : ℝ) ^ 2) :=
      Finset.sum_le_sum hfiber
    _ = (X : ℝ) * K * (∑ r ∈ I, (r : ℝ)⁻¹) +
        (I.card : ℝ) * (U : ℝ) ^ 2 := by
      simp only [Finset.sum_add_distrib, Finset.sum_const, nsmul_eq_mul,
        div_eq_mul_inv, ← Finset.sum_mul, ← Finset.mul_sum]
      ring
    _ ≤ (X : ℝ) * K * (1 + Real.log (V : ℝ)) +
        (V : ℝ) * (U : ℝ) ^ 2 :=
      add_le_add (mul_le_mul_of_nonneg_left hIinv (by dsimp [K, H]; positivity))
        (mul_le_mul_of_nonneg_right (by exact_mod_cast hIcard) (sq_nonneg _))
    _ = _ := by dsimp [K, H]; ring

open Classical in
theorem mixedFiberMass_diagonal_family_subpower_majorant
    (d : ℕ) (ρ : ℝ) (hρ : 0 < ρ) :
    ∃ C : ℝ, 0 < C ∧
      ∀ (S : Finset (ℕ × ℕ)) (sm : Finset ℕ) (w : ℕ → ℝ)
        (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ)
        (M N U V : ℕ) (B W : ℝ),
        0 ≤ B → 0 ≤ W →
        sm ⊆ Finset.Icc 1 M → β.support ⊆ Finset.Icc 1 N →
        (∀ n ∈ β.support, ‖β n‖ ≤ B * (n.divisors.card : ℝ) ^ d) →
        (∀ m ∈ sm, |w m| ≤ W) → (∀ p ∈ S, ‖c p‖ ≤ 1) →
        (∀ p ∈ S, 1 ≤ p.1 ∧ p.1 ≤ U ∧ 1 ≤ p.2 ∧ p.2 ≤ V) →
        (∀ p ∈ S, Nat.Coprime p.1 p.2) →
        ∀ a b₁ b₂ : ℕ,
          (∑ r ∈ S.image Prod.snd,
            ∑ p₁ ∈ S.filter (fun p => p.2 = r),
              ∑ p₂ ∈ S.filter (fun p => p.2 = r),
                ‖c p₁ * star (c p₂) *
                  (∑ n ∈ β.support, β n * star (β n) *
                    (mixedFiberMass sm w p₁.1 p₂.1 r a b₁ b₂ n n : ℂ))‖) ≤
            C * B ^ 2 * W * ((M * N : ℕ) : ℝ) ^ ρ *
              (((M * N : ℕ) : ℝ) * (1 + Real.log (V : ℝ)) *
                (1 + Real.log (U : ℝ)) ^ 2 * (2 + Real.log (U : ℝ)) +
                (V : ℝ) * (U : ℝ) ^ 2) := by
  obtain ⟨C, hC, hdiv⟩ := exists_divisorPower_bound (2 * d + 1) hρ
  refine ⟨C, hC, ?_⟩
  intro S sm w β c M N U V B W hB hW hsm hsupport hβ hw hc hS hcop a b₁ b₂
  let X : ℕ := M * N
  let count : ℕ → (ℕ × ℕ) → (ℕ × ℕ) → ℝ := fun r p₁ p₂ =>
    (((Finset.Icc 1 X).filter (fun s =>
      Nat.Coprime s (p₁.1 * r) ∧ Nat.Coprime s (p₂.1 * r) ∧
        s % r = a % r ∧ s % p₁.1 = b₁ % p₁.1 ∧ s % p₂.1 = b₂ % p₂.1)).card : ℝ)
  let K : ℝ := C * B ^ 2 * W * (X : ℝ) ^ ρ
  have hK : 0 ≤ K := by dsimp [K]; positivity
  have hpair (r : ℕ) (p₁ p₂ : ℕ × ℕ) (hp₁ : p₁ ∈ S) (hp₂ : p₂ ∈ S) :
      ‖c p₁ * star (c p₂) *
        (∑ n ∈ β.support, β n * star (β n) *
          (mixedFiberMass sm w p₁.1 p₂.1 r a b₁ b₂ n n : ℂ))‖ ≤ K * count r p₁ p₂ := by
    have hcoef : ‖c p₁ * star (c p₂)‖ ≤ 1 := by
      rw [norm_mul, norm_star]
      exact (mul_le_of_le_one_left (norm_nonneg _) (hc p₁ hp₁)).trans (hc p₂ hp₂)
    have hsum :
        (∑ s ∈ Finset.Icc 1 X,
          if Nat.Coprime s (p₁.1 * r) ∧ Nat.Coprime s (p₂.1 * r) ∧
              s % r = a % r ∧ s % p₁.1 = b₁ % p₁.1 ∧ s % p₂.1 = b₂ % p₂.1
          then (s.divisors.card : ℝ) ^ (2 * d + 1) else 0) ≤
          (C * (X : ℝ) ^ ρ) * count r p₁ p₂ := by
      rw [← Finset.sum_filter]
      refine (Finset.sum_le_card_nsmul _ _ (C * (X : ℝ) ^ ρ) ?_).trans_eq ?_
      · intro s hs
        have hsI := Finset.mem_Icc.mp (Finset.mem_filter.mp hs).1
        exact (hdiv s (Nat.ne_of_gt hsI.1)).trans
          (mul_le_mul_of_nonneg_left
            (Real.rpow_le_rpow (Nat.cast_nonneg s)
              (Nat.cast_le.mpr hsI.2) hρ.le) hC.le)
      · simp only [nsmul_eq_mul, count, mul_comm]
    calc
      _ = ‖c p₁ * star (c p₂)‖ *
          ‖∑ n ∈ β.support, β n * star (β n) *
            (mixedFiberMass sm w p₁.1 p₂.1 r a b₁ b₂ n n : ℂ)‖ := norm_mul _ _
      _ ≤ ‖∑ n ∈ β.support, β n * star (β n) *
          (mixedFiberMass sm w p₁.1 p₂.1 r a b₁ b₂ n n : ℂ)‖ :=
        mul_le_of_le_one_left (norm_nonneg _) hcoef
      _ ≤ B ^ 2 * W * ∑ s ∈ Finset.Icc 1 X,
          if Nat.Coprime s (p₁.1 * r) ∧ Nat.Coprime s (p₂.1 * r) ∧
              s % r = a % r ∧ s % p₁.1 = b₁ % p₁.1 ∧ s % p₂.1 = b₂ % p₂.1
          then (s.divisors.card : ℝ) ^ (2 * d + 1) else 0 :=
        mixedFiberMass_diagonal_divisor_majorant
          sm w β M N d B W hB hW hsm hsupport hβ hw p₁.1 p₂.1 r a b₁ b₂
      _ ≤ B ^ 2 * W * ((C * (X : ℝ) ^ ρ) * count r p₁ p₂) :=
        mul_le_mul_of_nonneg_left hsum (mul_nonneg (sq_nonneg B) hW)
      _ = K * count r p₁ p₂ := by dsimp [K]; ring
  calc
    _ ≤ ∑ r ∈ S.image Prod.snd,
        ∑ p₁ ∈ S.filter (fun p => p.2 = r),
          ∑ p₂ ∈ S.filter (fun p => p.2 = r), K * count r p₁ p₂ :=
      Finset.sum_le_sum fun r _ =>
        Finset.sum_le_sum fun p₁ hp₁ =>
          Finset.sum_le_sum fun p₂ hp₂ =>
            hpair r p₁ p₂ (Finset.mem_filter.mp hp₁).1 (Finset.mem_filter.mp hp₂).1
    _ = K * (∑ r ∈ S.image Prod.snd,
        ∑ p₁ ∈ S.filter (fun p => p.2 = r),
          ∑ p₂ ∈ S.filter (fun p => p.2 = r), count r p₁ p₂) := by
      simp only [Finset.mul_sum]
    _ ≤ K * ((X : ℝ) * (1 + Real.log (V : ℝ)) *
        (1 + Real.log (U : ℝ)) ^ 2 * (2 + Real.log (U : ℝ)) +
          (V : ℝ) * (U : ℝ) ^ 2) :=
      mul_le_mul_of_nonneg_left
        (diagonal_product_indicator_family_sum_le S X U V a b₁ b₂ hS hcop) hK

open Classical in
theorem mixedCorrelation_diagonal_paper_scale_uniform
    (d : ℕ) (ω δ ε K T Bβ L Eβ Eψ A : ℝ)
    (hω : 0 < ω) (hδ : 0 < δ) (hε : 0 < ε)
    (hK : 1 ≤ K) (hT : 0 < T) (hBβ : 0 ≤ Bβ) (hL : 0 ≤ L)
    (hA : 0 ≤ A) :
    ∀ᶠ x : ℝ in Filter.atTop,
      ∀ (γ M Q R : ℝ) (N : ℕ),
        max (1 / 4 + 12 * ω + 4 * δ + 100 * ε)
          (32 * ω + 10 * δ + 400 * ε) ≤ γ →
        γ ≤ 1 / 2 - 4 * ω - 2 * δ - 50 * ε →
        0 < M → 0 < Q → 0 < R →
        x / K ≤ M * x ^ γ → M * x ^ γ ≤ K * x →
        x ^ (-δ - 4 * ε) * x ^ γ / K ≤ R →
        R ≤ K * x ^ (-2 * ε) * x ^ γ →
        R * Q ≤ K * x ^ (1 / 2 + 2 * ω + ε) →
        (N : ℝ) ≤ K * x ^ γ →
        ∀ (S : Finset (ℕ × ℕ)) (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ),
          β.support ⊆ Finset.Icc 1 N →
          (∀ n ∈ β.support,
            ‖β n‖ ≤ Bβ * (n.divisors.card : ℝ) ^ d * (Real.log x) ^ Eβ) →
          (∀ p ∈ S, ‖c p‖ ≤ 1) →
          (∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Nat.Coprime p.1 p.2 ∧
            Q ≤ (p.1 : ℝ) ∧ (p.1 : ℝ) ≤ 2 * Q ∧
            R ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ 2 * R) →
          ∀ (a b₁ b₂ : ℕ) (ψ : ℝ → ℝ),
            (∀ t : ℝ, |ψ t| ≤ L * (Real.log x) ^ Eψ) →
            let sm : Finset ℕ := Finset.Icc 1 ⌊T * M⌋₊
            let w : ℕ → ℝ := fun n => ψ ((n : ℝ) / M)
            (∑ r ∈ S.image Prod.snd,
              ∑ p₁ ∈ S.filter (fun p => p.2 = r),
                ∑ p₂ ∈ S.filter (fun p => p.2 = r),
                  ‖c p₁ * star (c p₂) *
                    (∑ n ∈ β.support, β n * star (β n) *
                      (mixedFiberMass sm w p₁.1 p₂.1 r a b₁ b₂ n n : ℂ))‖) ≤
              M * (x ^ γ) ^ 2 / R * (Real.log x) ^ (-A) := by
  have hKpos : 0 < K := zero_lt_one.trans_le hK
  obtain ⟨C, hC, hfinite⟩ := mixedFiberMass_diagonal_family_subpower_majorant d ε hε
  let F : ℝ := T * K ^ 2
  let H : ℝ := 24 * F + 8 * K ^ 3
  let D : ℝ := C * Bβ ^ 2 * L * F ^ ε * H
  let E : ℝ := 2 * Eβ + Eψ + 4
  have hF : 0 < F := by dsimp [F]; positivity
  have hsmall : ∀ᶠ x : ℝ in Filter.atTop,
      ‖D * K ^ 2 * (Real.log x) ^ (E + A)‖ ≤ ‖x ^ ε‖ :=
    ((isLittleO_log_rpow_rpow_atTop (E + A) hε).const_mul_left
      (D * K ^ 2)).eventuallyLE
  have hlarge : ∀ᶠ x : ℝ in Filter.atTop, 2 * K ^ 2 ≤ x ^ ((1 : ℝ) / 2) :=
    (tendsto_rpow_atTop one_half_pos).eventually_ge_atTop _
  filter_upwards [hsmall, hlarge, Filter.eventually_ge_atTop (Real.exp 1)]
    with x hxsmall hxlarge hx
  intro γ M Q R N hγlower hγupper hM hQ hR hMNlower hMNupper hRlower hRupper hRQ hN
    S β c hsupport hβ hc hS a b₁ b₂ ψ hψ sm w
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
  have hxone : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hx
  have hlogone : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hx
  have hlog : 0 ≤ Real.log x := zero_le_one.trans hlogone
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlogone
  have hdecay : 0 ≤ (Real.log x) ^ (-A) := by
    rw [Real.rpow_neg hlog]
    exact inv_nonneg.mpr (zero_le_one.trans (Real.one_le_rpow hlogone hA))
  have hxγ : 0 < x ^ γ := Real.rpow_pos_of_pos hxpos γ
  have hγ₂ : 32 * ω + 10 * δ + 400 * ε ≤ γ :=
    (le_max_right _ _).trans hγlower
  let U : ℕ := ⌊2 * Q⌋₊
  let V : ℕ := ⌊2 * R⌋₊
  let X : ℕ := ⌊T * M⌋₊ * N
  have hUcap : (U : ℝ) ≤ 2 * Q := Nat.floor_le (by positivity)
  have hVcap : (V : ℝ) ≤ 2 * R := Nat.floor_le (by positivity)
  have hX : (X : ℝ) ≤ F * x := by
    calc
      _ = (⌊T * M⌋₊ : ℝ) * (N : ℝ) := Nat.cast_mul _ _
      _ ≤ (T * M) * (K * x ^ γ) :=
        mul_le_mul (Nat.floor_le (by positivity)) hN
          (Nat.cast_nonneg N) (mul_nonneg hT.le hM.le)
      _ = T * K * (M * x ^ γ) := by ring
      _ ≤ T * K * (K * x) :=
        mul_le_mul_of_nonneg_left hMNupper (mul_nonneg hT.le hKpos.le)
      _ = F * x := by dsimp [F]; ring
  have hQbound : Q ≤ K ^ 2 * x ^ (1 / 2 + 2 * ω + δ + 5 * ε - γ) := by
    calc
      _ ≤ (K * x ^ (1 / 2 + 2 * ω + ε)) /
          (x ^ (-δ - 4 * ε) * x ^ γ / K) := by
        apply (le_div_iff₀ (by positivity)).mpr
        simpa only [mul_comm] using
          (mul_le_mul_of_nonneg_right hRlower hQ.le).trans hRQ
      _ = K ^ 2 *
          (x ^ (1 / 2 + 2 * ω + ε) / (x ^ (-δ - 4 * ε) * x ^ γ)) := by
        rw [div_div_eq_mul_div]
        ring
      _ = K ^ 2 * x ^ (1 / 2 + 2 * ω + δ + 5 * ε - γ) := by
        rw [← Real.rpow_add hxpos, ← Real.rpow_sub hxpos]
        congr 2
        ring
  have hQhalf : Q ≤ K ^ 2 * x ^ ((1 : ℝ) / 2) :=
    hQbound.trans (mul_le_mul_of_nonneg_left
      (Real.rpow_le_rpow_of_exponent_le hxone (by linarith)) (sq_nonneg K))
  have hRhalf : R ≤ K ^ 2 * x ^ ((1 : ℝ) / 2) := by
    calc
      _ ≤ K * x ^ (-2 * ε) * x ^ γ := hRupper
      _ = K * x ^ (γ - 2 * ε) := by
        rw [mul_assoc, ← Real.rpow_add hxpos]
        congr 2
        ring
      _ ≤ K * x ^ ((1 : ℝ) / 2) :=
        mul_le_mul_of_nonneg_left
          (Real.rpow_le_rpow_of_exponent_le hxone (by linarith)) hKpos.le
      _ ≤ K ^ 2 * x ^ ((1 : ℝ) / 2) :=
        mul_le_mul_of_nonneg_right (le_self_pow₀ hK two_ne_zero)
          (Real.rpow_nonneg hxpos.le _)
  have hcap (u : ℝ) (hu : u ≤ K ^ 2 * x ^ ((1 : ℝ) / 2)) : 2 * u ≤ x := by
    calc
      _ ≤ 2 * (K ^ 2 * x ^ ((1 : ℝ) / 2)) :=
        mul_le_mul_of_nonneg_left hu zero_le_two
      _ = (2 * K ^ 2) * x ^ ((1 : ℝ) / 2) := by ring
      _ ≤ x ^ ((1 : ℝ) / 2) * x ^ ((1 : ℝ) / 2) :=
        mul_le_mul_of_nonneg_right hxlarge (Real.rpow_nonneg hxpos.le _)
      _ = x := by rw [← Real.rpow_add hxpos]; norm_num
  have hU : (U : ℝ) ≤ x := hUcap.trans (hcap Q hQhalf)
  have hV : (V : ℝ) ≤ x := hVcap.trans (hcap R hRhalf)
  have hlogcap (n : ℕ) (hn : (n : ℝ) ≤ x) : Real.log (n : ℝ) ≤ Real.log x := by
    by_cases hn0 : n = 0
    · simpa only [hn0, Nat.cast_zero, Real.log_zero] using hlog
    · exact Real.log_le_log (Nat.cast_pos.mpr (Nat.pos_of_ne_zero hn0)) hn
  have hu : 1 + Real.log (U : ℝ) ≤ 2 * Real.log x := by
    linarith [hlogcap U hU]
  have hv : 1 + Real.log (V : ℝ) ≤ 2 * Real.log x := by
    linarith [hlogcap V hV]
  have hu₃ : 2 + Real.log (U : ℝ) ≤ 3 * Real.log x := by
    linarith [hlogcap U hU]
  have hlogs :
      (1 + Real.log (V : ℝ)) * (1 + Real.log (U : ℝ)) ^ 2 *
        (2 + Real.log (U : ℝ)) ≤ 24 * (Real.log x) ^ 4 := by
    calc
      _ ≤ (2 * Real.log x) * (2 * Real.log x) ^ 2 * (3 * Real.log x) :=
        mul_le_mul
          (mul_le_mul hv (pow_le_pow_left₀ (by positivity) hu 2)
            (sq_nonneg _) (by positivity))
          hu₃ (by positivity) (by positivity)
      _ = _ := by ring
  have hendpoint : (V : ℝ) * (U : ℝ) ^ 2 ≤ 8 * K ^ 3 * x := by
    calc
      _ ≤ (2 * R) * (2 * Q) ^ 2 :=
        mul_le_mul hVcap (pow_le_pow_left₀ (Nat.cast_nonneg U) hUcap 2)
          (sq_nonneg _) (by positivity)
      _ = 8 * (R * Q) * Q := by ring
      _ ≤ 8 * (K * x ^ (1 / 2 + 2 * ω + ε)) *
          (K ^ 2 * x ^ (1 / 2 + 2 * ω + δ + 5 * ε - γ)) :=
        mul_le_mul (mul_le_mul_of_nonneg_left hRQ (by norm_num)) hQbound
          hQ.le (by positivity)
      _ = 8 * K ^ 3 *
          (x ^ (1 / 2 + 2 * ω + ε) * x ^ (1 / 2 + 2 * ω + δ + 5 * ε - γ)) := by
        ring
      _ = 8 * K ^ 3 * x ^ (1 + 4 * ω + δ + 6 * ε - γ) := by
        rw [← Real.rpow_add hxpos]
        congr 2
        ring
      _ ≤ 8 * K ^ 3 * x := by
        apply mul_le_mul_of_nonneg_left _ (by positivity)
        simpa only [Real.rpow_one] using
          Real.rpow_le_rpow_of_exponent_le hxone
            (show 1 + 4 * ω + δ + 6 * ε - γ ≤ 1 by linarith)
  have hcount :
      (X : ℝ) * (1 + Real.log (V : ℝ)) * (1 + Real.log (U : ℝ)) ^ 2 *
        (2 + Real.log (U : ℝ)) + (V : ℝ) * (U : ℝ) ^ 2 ≤
          H * x * (Real.log x) ^ 4 := by
    calc
      _ = (X : ℝ) * ((1 + Real.log (V : ℝ)) * (1 + Real.log (U : ℝ)) ^ 2 *
          (2 + Real.log (U : ℝ))) + (V : ℝ) * (U : ℝ) ^ 2 := by ring
      _ ≤ (F * x) * (24 * (Real.log x) ^ 4) + 8 * K ^ 3 * x :=
        add_le_add (mul_le_mul hX hlogs (by positivity) (by positivity)) hendpoint
      _ ≤ (F * x) * (24 * (Real.log x) ^ 4) +
          (8 * K ^ 3 * x) * (Real.log x) ^ 4 :=
        add_le_add le_rfl (le_mul_of_one_le_right (by positivity : 0 ≤ 8 * K ^ 3 * x)
          (one_le_pow₀ hlogone))
      _ = H * x * (Real.log x) ^ 4 := by dsimp [H]; ring
  have hXp : (X : ℝ) ^ ε ≤ F ^ ε * x ^ ε :=
    (Real.rpow_le_rpow (Nat.cast_nonneg X) hX hε.le).trans_eq
      (Real.mul_rpow hF.le hxpos.le)
  have hscale :
      x ^ (1 + 2 * ε) / K ^ 2 ≤ M * (x ^ γ) ^ 2 / R := by
    calc
      _ = (x / K * x ^ γ) / (K * x ^ (-2 * ε) * x ^ γ) := by
        calc
          _ = (1 / K ^ 2) * (x ^ ((1 : ℝ) - (-2 * ε))) := by
            rw [neg_mul, sub_neg_eq_add]
            ring
          _ = (x / K) / (K * x ^ (-2 * ε)) := by
            rw [Real.rpow_sub hxpos, Real.rpow_one]
            ring
          _ = _ := (mul_div_mul_right _ _ hxγ.ne').symm
      _ ≤ (M * x ^ γ * x ^ γ) / R :=
        div_le_div₀ (by positivity)
          (mul_le_mul_of_nonneg_right hMNlower hxγ.le) hR hRupper
      _ = _ := by ring
  have hfinite' := hfinite S sm w β c ⌊T * M⌋₊ N U V
    (Bβ * (Real.log x) ^ Eβ) (L * (Real.log x) ^ Eψ)
    (by positivity) (by positivity) Finset.Subset.rfl hsupport
    (fun n hn => by simpa only [mul_right_comm] using hβ n hn)
    (fun n _ => hψ ((n : ℝ) / M)) hc
    (fun p hp => by
      rcases hS p hp with ⟨hp₁, hp₂, _, _, hpQ, _, hpR⟩
      exact ⟨hp₁, Nat.le_floor hpQ, hp₂, Nat.le_floor hpR⟩)
    (fun p hp => (hS p hp).2.2.1) a b₁ b₂
  have hlogpower :
      ((Real.log x) ^ Eβ) ^ 2 * (Real.log x) ^ Eψ * (Real.log x) ^ 4 =
        (Real.log x) ^ E := by
    rw [← Real.rpow_mul_natCast hlog, ← Real.rpow_natCast,
      ← Real.rpow_add hlogpos, ← Real.rpow_add hlogpos]
    congr 1
    norm_num [E, mul_comm]
  have henvelope :
      C * (Bβ * (Real.log x) ^ Eβ) ^ 2 * (L * (Real.log x) ^ Eψ) *
        (X : ℝ) ^ ε *
        ((X : ℝ) * (1 + Real.log (V : ℝ)) * (1 + Real.log (U : ℝ)) ^ 2 *
          (2 + Real.log (U : ℝ)) + (V : ℝ) * (U : ℝ) ^ 2) ≤
        D * x ^ (1 + ε) * (Real.log x) ^ E := by
    calc
      _ ≤ C * (Bβ * (Real.log x) ^ Eβ) ^ 2 * (L * (Real.log x) ^ Eψ) *
          (F ^ ε * x ^ ε) * (H * x * (Real.log x) ^ 4) :=
        mul_le_mul (mul_le_mul_of_nonneg_left hXp (by positivity)) hcount
          (by positivity) (by positivity)
      _ = (C * Bβ ^ 2 * L * F ^ ε * H) * (x * x ^ ε) *
          (((Real.log x) ^ Eβ) ^ 2 * (Real.log x) ^ Eψ * (Real.log x) ^ 4) := by
        ring
      _ = D * x ^ (1 + ε) * (Real.log x) ^ E := by
        rw [hlogpower, Real.rpow_add hxpos, Real.rpow_one]
  have hsmall' : D * K ^ 2 * (Real.log x) ^ (E + A) ≤ x ^ ε :=
    (Real.le_norm_self _).trans
      (hxsmall.trans_eq (Real.norm_of_nonneg (Real.rpow_nonneg hxpos.le ε)))
  have hlogcancel : (Real.log x) ^ (E + A) * (Real.log x) ^ (-A) =
      (Real.log x) ^ E := by
    rw [← Real.rpow_add hlogpos, add_neg_cancel_right]
  have hscalar : D * (Real.log x) ^ E ≤
      (x ^ ε / K ^ 2) * (Real.log x) ^ (-A) := by
    calc
      _ = (D * K ^ 2 * (Real.log x) ^ (E + A)) / K ^ 2 *
          (Real.log x) ^ (-A) := by
        rw [mul_right_comm D (K ^ 2), mul_div_cancel_right₀ _ (pow_ne_zero 2 hKpos.ne'),
          mul_assoc D ((Real.log x) ^ (E + A)), hlogcancel]
      _ ≤ _ :=
        mul_le_mul_of_nonneg_right
          (div_le_div_of_nonneg_right hsmall' (sq_nonneg K))
          hdecay
  calc
    _ ≤ C * (Bβ * (Real.log x) ^ Eβ) ^ 2 * (L * (Real.log x) ^ Eψ) *
        (X : ℝ) ^ ε *
        ((X : ℝ) * (1 + Real.log (V : ℝ)) * (1 + Real.log (U : ℝ)) ^ 2 *
          (2 + Real.log (U : ℝ)) + (V : ℝ) * (U : ℝ) ^ 2) := hfinite'
    _ ≤ D * x ^ (1 + ε) * (Real.log x) ^ E := henvelope
    _ = x ^ (1 + ε) * (D * (Real.log x) ^ E) := by ring
    _ ≤ x ^ (1 + ε) * ((x ^ ε / K ^ 2) * (Real.log x) ^ (-A)) :=
      mul_le_mul_of_nonneg_left hscalar (Real.rpow_nonneg hxpos.le _)
    _ = (x ^ (1 + 2 * ε) / K ^ 2) * (Real.log x) ^ (-A) := by
      calc
        _ = (x ^ (1 + ε) * x ^ ε) / K ^ 2 * (Real.log x) ^ (-A) := by ring
        _ = _ := by
          rw [← Real.rpow_add hxpos, two_mul, add_assoc]
    _ ≤ _ := mul_le_mul_of_nonneg_right hscale hdecay

/-- The lower exponent endpoint `9519 / 50000` of the four-dimensional prime box. -/
noncomputable def exceptionalExponentLower : ℝ := 9519 / 50000

/-- The upper exponent endpoint `6 / 25` of the four-dimensional prime box. -/
noncomputable def exceptionalExponentUpper : ℝ := 6 / 25

section

local notation "box" => (Set.Icc (fun _ : Fin 4 => exceptionalExponentLower)
    (fun _ : Fin 4 => exceptionalExponentUpper))
/--
The coordinatewise base-`x` logarithms of a four-tuple of natural numbers, converting prime
sizes to exponent coordinates.
-/
noncomputable def primeQuadrupleExponents (x : ℝ) (p : Fin 4 → ℕ) : Fin 4 → ℝ :=
  fun i => Real.logb x (p i : ℝ)

end

theorem convolution_vanishes_le_mul {R : Type*} [Semiring R]
    {U V : ℝ} {f g : ArithmeticFunction R} (hU : 0 ≤ U) (hV : 0 ≤ V)
    (hf : ∀ n : ℕ, (n : ℝ) ≤ U → f n = 0)
    (hg : ∀ n : ℕ, (n : ℝ) ≤ V → g n = 0) :
    ∀ n : ℕ, (n : ℝ) ≤ U * V → (f * g) n = 0 := by
  intro n hn
  rw [ArithmeticFunction.mul_apply]
  apply Finset.sum_eq_zero
  rintro ⟨a, b⟩ hab
  by_cases ha : (a : ℝ) ≤ U
  · rw [hf a ha, zero_mul]
  by_cases hb : (b : ℝ) ≤ V
  · rw [hg b hb, mul_zero]
  have ha' : U < (a : ℝ) := lt_of_not_ge ha
  have hb' : V < (b : ℝ) := lt_of_not_ge hb
  have hab' : a * b = n := (Nat.mem_divisorsAntidiagonal.mp hab).1
  have hcast : (a : ℝ) * (b : ℝ) = (n : ℝ) := by exact_mod_cast hab'
  have hprod : U * V < (a : ℝ) * (b : ℝ) :=
    mul_lt_mul_of_nonneg ha' hb' hU hV
  exact (not_lt_of_ge hn (hprod.trans_eq hcast)).elim

theorem convolution_vanishes_le_mul_right {R : Type*} [Semiring R]
    {U : ℝ} {f : ArithmeticFunction R}
    (hf : ∀ n : ℕ, (n : ℝ) ≤ U → f n = 0) (g : ArithmeticFunction R) :
    ∀ n : ℕ, (n : ℝ) ≤ U → (f * g) n = 0 := by
  intro n hn
  rw [ArithmeticFunction.mul_apply]
  apply Finset.sum_eq_zero
  rintro ⟨a, b⟩ hab
  obtain ⟨hab', hn0⟩ := Nat.mem_divisorsAntidiagonal.mp hab
  have ha : a ≤ n := Nat.le_of_dvd (Nat.pos_of_ne_zero hn0) ⟨b, hab'.symm⟩
  rw [hf a ((Nat.cast_le.mpr ha).trans hn), zero_mul]

theorem convolution_pow_vanishes_le {R : Type*} [Semiring R]
    {U : ℝ} {f : ArithmeticFunction R} (hU : 0 ≤ U)
    (hf : ∀ n : ℕ, (n : ℝ) ≤ U → f n = 0) {K : ℕ} (hK : 0 < K) :
    ∀ n : ℕ, (n : ℝ) ≤ U ^ K → (f ^ K) n = 0 := by
  obtain ⟨k, rfl⟩ := Nat.exists_eq_succ_of_ne_zero hK.ne'
  clear hK
  induction k with
  | zero => simpa using hf
  | succ k ih =>
    simpa only [Nat.succ_eq_add_one, pow_succ] using
      convolution_vanishes_le_mul (pow_nonneg hU _) hU ih hf

theorem one_sub_one_sub_pow {R : Type*} [CommRing R] (z : R) (K : ℕ) :
    1 - (1 - z) ^ K =
      ∑ j ∈ Finset.range K, (-1 : R) ^ j * (K.choose (j + 1) : R) * z ^ (j + 1) := by
  have hexpand : (1 - z) ^ K =
      ∑ j ∈ Finset.range (K + 1), (-1 : R) ^ j * z ^ j * (K.choose j : R) := by
    simpa only [neg_add_eq_sub, one_pow, mul_one, neg_pow z]
      using (_root_.add_pow (-z) (1 : R) K)
  have hsign : (∑ j ∈ Finset.range K,
      (-1 : R) ^ (j + 1) * z ^ (j + 1) * (K.choose (j + 1) : R)) =
      -(∑ j ∈ Finset.range K,
        (-1 : R) ^ j * (K.choose (j + 1) : R) * z ^ (j + 1)) := by
    rw [← Finset.sum_neg_distrib]
    apply Finset.sum_congr rfl
    intro j _
    rw [pow_succ]
    ring
  rw [Finset.sum_range_succ'] at hexpand
  simp only [pow_zero, Nat.choose_zero_right, Nat.cast_one, mul_one] at hexpand
  rw [hsign] at hexpand
  rw [hexpand, neg_add_eq_sub, sub_sub_cancel]

theorem convolution_binomial_remainder {R : Type*} [CommRing R]
    (K : ℕ) (M z L lambda : R) (hz : z * lambda = L) :
    lambda -
      (∑ j ∈ Finset.range K, (-1 : R) ^ j * (K.choose (j + 1) : R) *
        (M ^ (j + 1) * z ^ j * L)) =
      (1 - M * z) ^ K * lambda := by
  have hterm (j : ℕ) : (M * z) ^ (j + 1) * lambda =
      M ^ (j + 1) * z ^ j * L := by
    simp only [mul_pow, pow_succ z, mul_assoc, hz]
  have h := congrArg (fun t : R => t * lambda) (one_sub_one_sub_pow (M * z) K)
  rw [Finset.sum_mul] at h
  simp_rw [mul_assoc, hterm] at h
  simp only [mul_assoc] at h ⊢
  linear_combination h

/-!
## Heath–Brown decomposition and localized dispersion
-/

/--
The `K`-term Heath–Brown convolution sum with the Möbius factors cut off at `U`. Its term
indexed by `j < K` has coefficient `(-1)^j * choose K (j + 1)` and convolution factors
consisting of `j + 1` truncated Möbius functions, `j` zeta functions, and the logarithm.
-/
noncomputable def heathBrownSum (K : ℕ) (U : ℝ) : ArithmeticFunction ℝ :=
  ∑ j ∈ Finset.range K,
    ((-1 : ℝ) ^ j * (K.choose (j + 1) : ℝ)) •
      ((arithmeticFunctionLowCutoff U
          (ArithmeticFunction.moebius : ArithmeticFunction ℝ)) ^ (j + 1) *
        (ArithmeticFunction.zeta : ArithmeticFunction ℝ) ^ j * ArithmeticFunction.log)

theorem heathBrown_remainder {K : ℕ} (hK : 0 < K) (U : ℝ) :
    ArithmeticFunction.vonMangoldt - heathBrownSum K U =
      arithmeticFunctionHighCutoff U
          (ArithmeticFunction.moebius : ArithmeticFunction ℝ) ^ K *
        (ArithmeticFunction.zeta : ArithmeticFunction ℝ) ^ (K - 1) *
          ArithmeticFunction.log := by
  let M := arithmeticFunctionLowCutoff U
    (ArithmeticFunction.moebius : ArithmeticFunction ℝ)
  let z : ArithmeticFunction ℝ := ArithmeticFunction.zeta
  let mu : ArithmeticFunction ℝ := ArithmeticFunction.moebius
  have hz : z * ArithmeticFunction.vonMangoldt = ArithmeticFunction.log :=
    ArithmeticFunction.zeta_mul_vonMangoldt
  have hmu : mu * z = 1 := ArithmeticFunction.coe_moebius_mul_coe_zeta
  have hsum : heathBrownSum K U =
      ∑ j ∈ Finset.range K, (-1 : ArithmeticFunction ℝ) ^ j *
        (K.choose (j + 1) : ArithmeticFunction ℝ) *
          (M ^ (j + 1) * z ^ j * ArithmeticFunction.log) := by
    simp only [heathBrownSum, Algebra.smul_def, map_mul, map_pow, map_neg,
      map_one, map_natCast]
    rfl
  have hzpow : z ^ K * ArithmeticFunction.vonMangoldt =
      z ^ (K - 1) * ArithmeticFunction.log := by
    calc
      _ = (z ^ (K - 1) * z) * ArithmeticFunction.vonMangoldt := by
        rw [← pow_succ, Nat.sub_add_cancel hK]
      _ = _ := by rw [mul_assoc, hz]
  rw [hsum, convolution_binomial_remainder K M z ArithmeticFunction.log
    ArithmeticFunction.vonMangoldt hz]
  have hfactor : 1 - M * z = (mu - M) * z := by rw [sub_mul, hmu]
  rw [hfactor, mul_pow, mul_assoc, hzpow]
  simp only [arithmeticFunctionHighCutoff, M, z, mu, mul_assoc]

theorem heathBrown_identity {K : ℕ} (hK : 0 < K)
    {U : ℝ} (hU : 0 ≤ U) {n : ℕ} (hn : (n : ℝ) ≤ U ^ K) :
    ArithmeticFunction.vonMangoldt n = heathBrownSum K U n := by
  have hcut : ∀ m : ℕ, (m : ℝ) ≤ U ^ K →
      (arithmeticFunctionHighCutoff U
        (ArithmeticFunction.moebius : ArithmeticFunction ℝ) ^ K) m = 0 :=
    convolution_pow_vanishes_le hU
      (fun m hm => arithmeticFunctionHighCutoff_apply_of_le hm) hK
  have hvanish := convolution_vanishes_le_mul_right
    (convolution_vanishes_le_mul_right hcut
      ((ArithmeticFunction.zeta : ArithmeticFunction ℝ) ^ (K - 1)))
    ArithmeticFunction.log n hn
  have h := congrArg (fun f : ArithmeticFunction ℝ => f n) (heathBrown_remainder hK U)
  change ArithmeticFunction.vonMangoldt n - heathBrownSum K U n = _ at h
  exact sub_eq_zero.mp (h.trans hvanish)

theorem partition_subset_gap {n : ℕ} {sigma : ℝ} {t : Fin n → ℝ}
    (ht : ∑ i, t i = 1)
    (hnot : ¬ ∃ S T : Finset (Fin n), Disjoint S T ∧ S ∪ T = Finset.univ ∧
      1 / 2 - sigma < (∑ i ∈ S, t i) ∧
      (∑ i ∈ S, t i) ≤ (∑ i ∈ T, t i) ∧
      (∑ i ∈ T, t i) < 1 / 2 + sigma) :
    ∀ S : Finset (Fin n), (∑ i ∈ S, t i) ≤ 1 / 2 - sigma ∨
      1 / 2 + sigma ≤ (∑ i ∈ S, t i) := by
  intro S
  by_cases hs : (∑ i ∈ S, t i) ≤ 1 / 2 - sigma
  · exact Or.inl hs
  right
  by_contra hl
  apply hnot
  have hlo := lt_of_not_ge hs
  have hhi := lt_of_not_ge hl
  have hc := Finset.sum_add_sum_compl S t
  by_cases horder : (∑ i ∈ S, t i) ≤ (∑ i ∈ Sᶜ, t i)
  · refine ⟨S, Sᶜ, disjoint_compl_right, Finset.union_compl S, hlo, horder, ?_⟩
    linarith
  · refine ⟨Sᶜ, S, disjoint_compl_left, compl_sup_eq_top,
      ?_, le_of_not_ge horder, hhi⟩
    linarith

theorem partition_union_small {n : ℕ} {sigma : ℝ} {t : Fin n → ℝ}
    (hgap : ∀ S : Finset (Fin n), (∑ i ∈ S, t i) ≤ 1 / 2 - sigma ∨
      1 / 2 + sigma ≤ (∑ i ∈ S, t i))
    {S P : Finset (Fin n)} (hs : (∑ i ∈ S, t i) ≤ 1 / 2 - sigma)
    (hP : ∀ i ∈ P, ¬ ∃ T : Finset (Fin n), i ∉ T ∧
      (∑ j ∈ T, t j) ≤ 1 / 2 - sigma ∧
      1 / 2 + sigma ≤ (∑ j ∈ insert i T, t j)) :
    (∑ i ∈ S ∪ P, t i) ≤ 1 / 2 - sigma := by
  induction P using Finset.induction_on with
  | empty => simpa only [Finset.union_empty] using hs
  | @insert i P _ ih =>
    rw [Finset.union_insert]
    have hsUnion := ih (fun j hj => hP j (Finset.mem_insert_of_mem hj))
    by_cases hiS : i ∈ S ∪ P
    · simpa only [Finset.insert_eq_of_mem hiS] using hsUnion
    rcases hgap (insert i (S ∪ P)) with hsmall | hlarge
    · exact hsmall
    · exact (hP i (Finset.mem_insert_self i P)
        ⟨S ∪ P, hiS, hsUnion, hlarge⟩).elim

theorem partition_large_has_two {n : ℕ} {sigma : ℝ} {t : Fin n → ℝ}
    (hsigma : 0 < sigma) (hnonneg : ∀ i, 0 ≤ t i)
    (hsingle : ∀ i, t i ≤ 1 / 2 - sigma)
    {S : Finset (Fin n)} (hS : 1 / 2 + sigma ≤ (∑ i ∈ S, t i)) :
    ∃ i ∈ S, ∃ j ∈ S, i ≠ j := by
  obtain ⟨i, hi, _⟩ :=
    (Finset.sum_pos_iff_of_nonneg (fun j _ => hnonneg j)).mp
      ((show (0 : ℝ) < 1 / 2 + sigma by linarith).trans_le hS)
  obtain ⟨j, hj, hji⟩ : ∃ j ∈ S, j ≠ i := by
    by_contra! h
    have hSi : S = {i} := Finset.eq_singleton_iff_unique_mem.mpr ⟨hi, h⟩
    rw [hSi, Finset.sum_singleton] at hS
    linarith [hsingle i]
  exact ⟨i, hi, j, hj, hji.symm⟩

theorem partition_jump_lower {n : ℕ} {sigma : ℝ} {t : Fin n → ℝ}
    {i : Fin n}
    (hi : ∃ S : Finset (Fin n), i ∉ S ∧
      (∑ j ∈ S, t j) ≤ 1 / 2 - sigma ∧
      1 / 2 + sigma ≤ (∑ j ∈ insert i S, t j)) :
    2 * sigma ≤ t i := by
  obtain ⟨S, hiS, hs, hl⟩ := hi
  rw [Finset.sum_insert hiS] at hl
  linarith

theorem partition_jump_pair_large {n : ℕ} {sigma : ℝ} {t : Fin n → ℝ}
    (hsigma : (1 / 10 : ℝ) < sigma)
    (hgap : ∀ S : Finset (Fin n), (∑ i ∈ S, t i) ≤ 1 / 2 - sigma ∨
      1 / 2 + sigma ≤ (∑ i ∈ S, t i))
    {i j : Fin n}
    (hi : ∃ S : Finset (Fin n), i ∉ S ∧
      (∑ k ∈ S, t k) ≤ 1 / 2 - sigma ∧
      1 / 2 + sigma ≤ (∑ k ∈ insert i S, t k))
    (hj : ∃ S : Finset (Fin n), j ∉ S ∧
      (∑ k ∈ S, t k) ≤ 1 / 2 - sigma ∧
      1 / 2 + sigma ≤ (∑ k ∈ insert j S, t k)) (hij : i ≠ j) :
    1 / 2 + sigma ≤ t i + t j := by
  rcases hgap {i, j} with hs | hl
  · have hsmall : t i + t j ≤ 1 / 2 - sigma := by
      simpa only [Finset.sum_pair hij] using hs
    have hli := partition_jump_lower hi
    have hlj := partition_jump_lower hj
    linarith
  · simpa only [Finset.sum_pair hij] using hl

theorem partition_exists_three_jumps {n : ℕ} {sigma : ℝ} {t : Fin n → ℝ}
    (hsigma0 : 0 < sigma) (hsigmaHalf : sigma < 1 / 2)
    (ht : ∑ i, t i = 1) (hnonneg : ∀ i, 0 ≤ t i)
    (hgap : ∀ S : Finset (Fin n), (∑ i ∈ S, t i) ≤ 1 / 2 - sigma ∨
      1 / 2 + sigma ≤ (∑ i ∈ S, t i))
    (hsingle : ∀ i, t i ≤ 1 / 2 - sigma) :
    ∃ i j k : Fin n,
      (∃ S : Finset (Fin n), i ∉ S ∧
        (∑ l ∈ S, t l) ≤ 1 / 2 - sigma ∧
        1 / 2 + sigma ≤ (∑ l ∈ insert i S, t l)) ∧
      (∃ S : Finset (Fin n), j ∉ S ∧
        (∑ l ∈ S, t l) ≤ 1 / 2 - sigma ∧
        1 / 2 + sigma ≤ (∑ l ∈ insert j S, t l)) ∧
      (∃ S : Finset (Fin n), k ∉ S ∧
        (∑ l ∈ S, t l) ≤ 1 / 2 - sigma ∧
        1 / 2 + sigma ≤ (∑ l ∈ insert k S, t l)) ∧
      i ≠ j ∧ i ≠ k ∧ j ≠ k := by
  classical
  let P : Finset (Fin n) := Finset.univ.filter (fun i =>
    ¬ ∃ S : Finset (Fin n), i ∉ S ∧
      (∑ j ∈ S, t j) ≤ 1 / 2 - sigma ∧
      1 / 2 + sigma ≤ (∑ j ∈ insert i S, t j))
  have hP : ∀ i ∈ P, ¬ ∃ S : Finset (Fin n), i ∉ S ∧
      (∑ j ∈ S, t j) ≤ 1 / 2 - sigma ∧
      1 / 2 + sigma ≤ (∑ j ∈ insert i S, t j) := by
    intro i hi
    exact (Finset.mem_filter.mp hi).2
  have hsmallEmpty : (∑ i ∈ (∅ : Finset (Fin n)), t i) ≤ 1 / 2 - sigma := by
    simpa only [Finset.sum_empty] using sub_nonneg.mpr hsigmaHalf.le
  have hsmallP : (∑ i ∈ P, t i) ≤ 1 / 2 - sigma := by
    simpa only [Finset.empty_union] using partition_union_small hgap hsmallEmpty hP
  obtain ⟨i, hi⟩ : ∃ i : Fin n, ∃ S : Finset (Fin n), i ∉ S ∧
      (∑ j ∈ S, t j) ≤ 1 / 2 - sigma ∧
      1 / 2 + sigma ≤ (∑ j ∈ insert i S, t j) := by
    by_contra h
    have hPeq : P = Finset.univ := by
      ext i
      simp only [P, Finset.mem_filter, Finset.mem_univ, true_and, iff_true]
      exact fun hi => h ⟨i, hi⟩
    have hbad : (1 : ℝ) ≤ 1 / 2 - sigma := by
      simpa only [hPeq, ht] using hsmallP
    linarith
  have hsmallI : (∑ j ∈ ({i} ∪ P : Finset (Fin n)), t j) ≤ 1 / 2 - sigma :=
    partition_union_small hgap
      (by simpa only [Finset.sum_singleton] using hsingle i) hP
  have hlargeC : 1 / 2 + sigma ≤ (∑ j ∈ ({i} ∪ P)ᶜ, t j) := by
    linarith only [ht, hsmallI, Finset.sum_add_sum_compl ({i} ∪ P) t]
  obtain ⟨j, hj, k, hk, hjk⟩ := partition_large_has_two hsigma0 hnonneg hsingle hlargeC
  have hj' : j ≠ i ∧ ∃ S : Finset (Fin n), j ∉ S ∧
      (∑ l ∈ S, t l) ≤ 1 / 2 - sigma ∧
      1 / 2 + sigma ≤ (∑ l ∈ insert j S, t l) := by
    simpa [P] using hj
  have hk' : k ≠ i ∧ ∃ S : Finset (Fin n), k ∉ S ∧
      (∑ l ∈ S, t l) ≤ 1 / 2 - sigma ∧
      1 / 2 + sigma ≤ (∑ l ∈ insert k S, t l) := by
    simpa [P] using hk
  exact ⟨i, j, k, hi, hj'.2, hk'.2, hj'.1.symm, hk'.1.symm, hjk⟩

theorem partition_order_three {n : ℕ} (t : Fin n → ℝ)
    {P : Fin n → Prop} {a b c : Fin n}
    (ha : P a) (hb : P b) (hc : P c) (hab : a ≠ b) (hac : a ≠ c) (hbc : b ≠ c) :
    ∃ i j k : Fin n, P i ∧ P j ∧ P k ∧ i ≠ j ∧ i ≠ k ∧ j ≠ k ∧
      t i ≤ t j ∧ t j ≤ t k := by
  rcases le_total (t a) (t b) with hab' | hba'
  · rcases le_total (t b) (t c) with hbc' | hcb'
    · exact ⟨a, b, c, ha, hb, hc, hab, hac, hbc, hab', hbc'⟩
    · rcases le_total (t a) (t c) with hac' | hca'
      · exact ⟨a, c, b, ha, hc, hb, hac, hab, hbc.symm, hac', hcb'⟩
      · exact ⟨c, a, b, hc, ha, hb, hac.symm, hbc.symm, hab, hca', hab'⟩
  · rcases le_total (t a) (t c) with hac' | hca'
    · exact ⟨b, a, c, hb, ha, hc, hab.symm, hbc, hac, hba', hac'⟩
    · rcases le_total (t b) (t c) with hbc' | hcb'
      · exact ⟨b, c, a, hb, hc, ha, hbc, hab.symm, hac.symm, hbc', hca'⟩
      · exact ⟨c, b, a, hc, hb, ha, hbc.symm, hac.symm, hab.symm, hcb', hba'⟩

/--
The partition trichotomy of Polymath8a, Lemma 3.1: a nonnegative unit-mass sequence has a large
coordinate, a balanced bipartition, or three ordered large coordinates.
-/
theorem partition_trichotomy_of_sum_eq_one {n : ℕ} {sigma : ℝ}
    (hsigma : (1 / 10 : ℝ) < sigma) (hsigmaHalf : sigma < 1 / 2)
    (t : Fin n → ℝ) (hnonneg : ∀ i, 0 ≤ t i) (ht : ∑ i, t i = 1) :
    (∃ i : Fin n, 1 / 2 + sigma ≤ t i) ∨
    (∃ S T : Finset (Fin n), Disjoint S T ∧ S ∪ T = Finset.univ ∧
      1 / 2 - sigma < (∑ i ∈ S, t i) ∧
      (∑ i ∈ S, t i) ≤ (∑ i ∈ T, t i) ∧
      (∑ i ∈ T, t i) < 1 / 2 + sigma) ∨
    (∃ i j k : Fin n, i ≠ j ∧ i ≠ k ∧ j ≠ k ∧
      2 * sigma ≤ t i ∧ t i ≤ t j ∧ t j ≤ t k ∧
      t k ≤ 1 / 2 - sigma ∧
      1 / 2 + sigma ≤ t i + t j ∧
      1 / 2 + sigma ≤ t i + t k ∧
      1 / 2 + sigma ≤ t j + t k) := by
  classical
  by_cases hzero : ∃ i : Fin n, 1 / 2 + sigma ≤ t i
  · exact Or.inl hzero
  by_cases hbilinear : ∃ S T : Finset (Fin n),
      Disjoint S T ∧ S ∪ T = Finset.univ ∧
      1 / 2 - sigma < (∑ i ∈ S, t i) ∧
      (∑ i ∈ S, t i) ≤ (∑ i ∈ T, t i) ∧
      (∑ i ∈ T, t i) < 1 / 2 + sigma
  · exact Or.inr (Or.inl hbilinear)
  right
  right
  have hgap := partition_subset_gap ht hbilinear
  have hsingle : ∀ i : Fin n, t i ≤ 1 / 2 - sigma := by
    intro i
    rcases hgap {i} with hs | hl
    · simpa only [Finset.sum_singleton] using hs
    · exact (hzero ⟨i, by simpa only [Finset.sum_singleton] using hl⟩).elim
  obtain ⟨a, b, c, ha, hb, hc, hab, hac, hbc⟩ :=
    partition_exists_three_jumps (by linarith) hsigmaHalf ht hnonneg hgap hsingle
  obtain ⟨i, j, k, hi, hj, hk, hij, hik, hjk, htij, htjk⟩ :=
    partition_order_three t
      (P := fun i => ∃ S : Finset (Fin n), i ∉ S ∧
        (∑ j ∈ S, t j) ≤ 1 / 2 - sigma ∧
        1 / 2 + sigma ≤ (∑ j ∈ insert i S, t j))
      ha hb hc hab hac hbc
  exact ⟨i, j, k, hij, hik, hjk, partition_jump_lower hi, htij, htjk, hsingle k,
    partition_jump_pair_large hsigma hgap hi hj hij,
    partition_jump_pair_large hsigma hgap hi hk hik,
    partition_jump_pair_large hsigma hgap hj hk hjk⟩

theorem polymath8a_partition_without_typeIII {n : ℕ} {sigma : ℝ}
    (hsigma : (1 / 6 : ℝ) < sigma) (hsigmaHalf : sigma < 1 / 2)
    (t : Fin n → ℝ) (hnonneg : ∀ i, 0 ≤ t i) (ht : ∑ i, t i = 1) :
    (∃ i : Fin n, 1 / 2 + sigma ≤ t i) ∨
    (∃ S T : Finset (Fin n), Disjoint S T ∧ S ∪ T = Finset.univ ∧
      1 / 2 - sigma < (∑ i ∈ S, t i) ∧
      (∑ i ∈ S, t i) ≤ (∑ i ∈ T, t i) ∧
      (∑ i ∈ T, t i) < 1 / 2 + sigma) := by
  rcases partition_trichotomy_of_sum_eq_one (by linarith) hsigmaHalf t hnonneg ht with h0 | h12 | h3
  · exact Or.inl h0
  · exact Or.inr h12
  · obtain ⟨i, j, k, _, _, _, hi, hij, hjk, hk, _, _, _⟩ := h3
    exfalso
    linarith

theorem norm_convolution_le_sum
    {R : Type*} [SeminormedRing R]
    (f g : ArithmeticFunction R) (F G : ℕ → ℝ)
    (hf : ∀ n, ‖f n‖ ≤ F n)
    (hg : ∀ n, ‖g n‖ ≤ G n) (n : ℕ) :
    ‖(f * g) n‖ ≤
      ∑ p ∈ n.divisorsAntidiagonal, F p.1 * G p.2 := by
  rw [ArithmeticFunction.mul_apply]
  exact (norm_sum_le _ _).trans
    (Finset.sum_le_sum fun p _ => norm_mul_le_of_le (hf p.1) (hg p.2))

theorem norm_convolution_pow_le
    {R : Type*} [SeminormedRing R] [NormOneClass R]
    (f : ArithmeticFunction R) (F : ArithmeticFunction ℝ)
    (hf : ∀ n, ‖f n‖ ≤ F n) (k n : ℕ) :
    ‖(f ^ k) n‖ ≤ (F ^ k) n := by
  induction k generalizing n with
  | zero =>
    by_cases hn : n = 1 <;> simp [hn]
  | succ k ih =>
    simpa only [pow_succ, ArithmeticFunction.mul_apply] using
      norm_convolution_le_sum (f ^ k) f (fun m => (F ^ k) m) F ih hf n

theorem convolution_growth_bound {R : Type*} [SeminormedRing R]
    (f g : ArithmeticFunction R)
    {C D L : ℝ} (hC : 0 ≤ C) (hD : 0 ≤ D) (hL : 0 ≤ L)
    (a b e fexp : ℕ)
    (hf : ∀ n, ‖f n‖ ≤ C * (n.divisors.card : ℝ) ^ a * L ^ e)
    (hg : ∀ n, ‖g n‖ ≤ D * (n.divisors.card : ℝ) ^ b * L ^ fexp)
    (n : ℕ) :
    ‖(f * g) n‖ ≤
      C * D * (n.divisors.card : ℝ) ^ (a + b + 1) * L ^ (e + fexp) := by
  calc
    ‖(f * g) n‖ ≤ ∑ p ∈ n.divisorsAntidiagonal,
        (C * (p.1.divisors.card : ℝ) ^ a * L ^ e) *
          (D * (p.2.divisors.card : ℝ) ^ b * L ^ fexp) :=
      norm_convolution_le_sum f g
        (fun d ↦ C * (d.divisors.card : ℝ) ^ a * L ^ e)
        (fun d ↦ D * (d.divisors.card : ℝ) ^ b * L ^ fexp) hf hg n
    _ ≤ ∑ _p ∈ n.divisorsAntidiagonal,
        C * D * (n.divisors.card : ℝ) ^ (a + b) * L ^ (e + fexp) := by
      apply Finset.sum_le_sum
      intro p hp
      have hn := (Nat.mem_divisorsAntidiagonal.mp hp).2
      have hleft := Nat.dvd_of_mem_divisors (Nat.fst_mem_divisors_of_mem_antidiagonal hp)
      have hright := Nat.dvd_of_mem_divisors (Nat.snd_mem_divisors_of_mem_antidiagonal hp)
      calc
        _ ≤ (C * (n.divisors.card : ℝ) ^ a * L ^ e) *
            (D * (n.divisors.card : ℝ) ^ b * L ^ fexp) := by gcongr
        _ = _ := by rw [pow_add, pow_add]; ring
    _ = _ := by
      rw [Finset.sum_const, nsmul_eq_mul, ← Nat.map_div_right_divisors,
        Finset.card_map, pow_succ]
      ring

theorem zeta_pow_log_le_card_divisors_pow (k n : ℕ) :
    (((ArithmeticFunction.zeta : ArithmeticFunction ℝ) ^ k) *
        ArithmeticFunction.log) n ≤
      (n.divisors.card : ℝ) ^ k * Real.log (n : ℝ) := by
  induction k generalizing n with
  | zero => simp
  | succ k ih =>
    rw [pow_succ', mul_assoc, ArithmeticFunction.coe_zeta_mul_apply]
    calc
      _ ≤ ∑ d ∈ n.divisors, (d.divisors.card : ℝ) ^ k * Real.log (d : ℝ) :=
        Finset.sum_le_sum (fun d _ => ih d)
      _ ≤ ∑ _d ∈ n.divisors, (n.divisors.card : ℝ) ^ k * Real.log (n : ℝ) := by
        apply Finset.sum_le_sum
        intro d hd
        rcases Nat.mem_divisors.mp hd with ⟨hdn, hn⟩
        gcongr
        · exact_mod_cast Nat.pos_of_mem_divisors hd
        · exact_mod_cast Nat.divisor_le hd
      _ = _ := by
        simp only [Finset.sum_const, nsmul_eq_mul, pow_succ]
        ring

theorem abs_truncated_moebius_pow_mul_zeta_pow_mul_log_le
    (U : ℝ) (a b n : ℕ) :
    |((arithmeticFunctionLowCutoff U
          (ArithmeticFunction.moebius : ArithmeticFunction ℝ)) ^ a *
        (ArithmeticFunction.zeta : ArithmeticFunction ℝ) ^ b *
        ArithmeticFunction.log) n| ≤
      (n.divisors.card : ℝ) ^ (a + b) * Real.log (n : ℝ) := by
  let M := arithmeticFunctionLowCutoff U
    (ArithmeticFunction.moebius : ArithmeticFunction ℝ)
  let Z : ArithmeticFunction ℝ := ArithmeticFunction.zeta
  have hM (m : ℕ) : ‖M m‖ ≤ Z m := by
    by_cases hm : m = 0
    · simp [hm]
    change ‖if (m : ℝ) ≤ U then
      (ArithmeticFunction.moebius : ArithmeticFunction ℝ) m else 0‖ ≤
        (ArithmeticFunction.zeta m : ℝ)
    rw [ArithmeticFunction.zeta_apply_ne hm, Nat.cast_one]
    split_ifs
    · change |(ArithmeticFunction.moebius m : ℝ)| ≤ 1
      exact_mod_cast (ArithmeticFunction.abs_moebius_le_one (n := m))
    · simp
  have hprod (m : ℕ) : ‖(M ^ a * Z ^ b) m‖ ≤ (Z ^ (a + b)) m := by
    simpa only [pow_add, ArithmeticFunction.mul_apply] using
      norm_convolution_le_sum (M ^ a) (Z ^ b)
        (fun m => (Z ^ a) m) (fun m => (Z ^ b) m)
        (norm_convolution_pow_le M Z hM a)
        (norm_convolution_pow_le Z Z (fun _ => (Real.norm_natCast _).le) b) m
  refine le_trans ?_ (zeta_pow_log_le_card_divisors_pow (a + b) n)
  simpa only [M, Z, Real.norm_eq_abs, ArithmeticFunction.mul_apply] using
    norm_convolution_le_sum (M ^ a * Z ^ b) ArithmeticFunction.log
      (fun m => (Z ^ (a + b)) m) ArithmeticFunction.log hprod
      (fun m => (Real.norm_of_nonneg (Real.log_natCast_nonneg m)).le) n

theorem abs_heathBrownSum_le (K : ℕ) (U : ℝ) (n : ℕ) :
    |heathBrownSum K U n| ≤
      ((2 : ℝ) ^ K - 1) * (n.divisors.card : ℝ) ^ (2 * K - 1) *
        Real.log (n : ℝ) := by
  by_cases hn : n = 0
  · simp [hn]
  have htau : (1 : ℝ) ≤ n.divisors.card := by
    exact_mod_cast (Finset.one_le_card.mpr ⟨1, Nat.one_mem_divisors.mpr hn⟩)
  have hcoeff : (∑ j ∈ Finset.range K, (K.choose (j + 1) : ℝ)) =
      (2 : ℝ) ^ K - 1 := by
    have htotal : (∑ j ∈ Finset.range (K + 1), (K.choose j : ℝ)) =
        (2 : ℝ) ^ K := by
      exact_mod_cast Nat.sum_range_choose K
    rw [Finset.sum_range_succ'] at htotal
    simp only [Nat.choose_zero_right, Nat.cast_one] at htotal
    linarith
  let ev : ArithmeticFunction ℝ →+ ℝ :=
    AddMonoidHom.mk' (fun f => f n) (fun _ _ => rfl)
  change |ev (heathBrownSum K U)| ≤ _
  rw [heathBrownSum, map_sum]
  change |∑ j ∈ Finset.range K, ((-1 : ℝ) ^ j * (K.choose (j + 1) : ℝ)) *
    ((arithmeticFunctionLowCutoff U
        (ArithmeticFunction.moebius : ArithmeticFunction ℝ)) ^ (j + 1) *
      (ArithmeticFunction.zeta : ArithmeticFunction ℝ) ^ j * ArithmeticFunction.log) n| ≤ _
  refine (Finset.abs_sum_le_sum_abs _ _).trans ?_
  calc
    _ ≤ ∑ j ∈ Finset.range K, (K.choose (j + 1) : ℝ) *
        ((n.divisors.card : ℝ) ^ (2 * K - 1) * Real.log (n : ℝ)) := by
      apply Finset.sum_le_sum
      intro j hj
      simp only [abs_mul, abs_pow, abs_neg, abs_one, one_pow, one_mul, Nat.abs_cast]
      apply mul_le_mul_of_nonneg_left ?_ (Nat.cast_nonneg _)
      have hj' := Finset.mem_range.mp hj
      refine (abs_truncated_moebius_pow_mul_zeta_pow_mul_log_le U (j + 1) j n).trans ?_
      gcongr
      omega
    _ = _ := by
      rw [← Finset.sum_mul, hcoeff, mul_assoc]

theorem secondaryPhase_stdAddChar_inflate
    (q Q : ℕ) [NeZero q] [NeZero Q] (hqQ : q ∣ Q) (z : ZMod Q) :
    ZMod.stdAddChar (ZMod.castHom hqQ (ZMod q) z) =
      ZMod.stdAddChar (((Q / q : ℕ) : ZMod Q) * z) := by
  obtain ⟨j, rfl⟩ := ZMod.intCast_surjective z
  rw [map_intCast, ← Int.cast_natCast (Q / q), ← Int.cast_mul,
    ZMod.stdAddChar_coe, ZMod.stdAddChar_coe]
  congr 1
  simp only [Int.cast_mul, Int.cast_natCast, Nat.cast_div_charZero hqQ]
  field_simp [NeZero.ne (q : ℂ), NeZero.ne (Q : ℂ)]

theorem sourceSecondaryCRT_classes_exists_unique
    (r₁ q₀ u₁ v₁ v₂ q₂ : ℕ)
    [NeZero r₁] [NeZero q₀] [NeZero u₁] [NeZero v₁] [NeZero v₂] [NeZero q₂]
    (hsq : Squarefree (r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂))
    (a b₁ b₂ ℓ : ℤ)
    (hprim : IsCoprime ((r₁ * q₀ * u₁ * v₁ * v₂ * q₂ : ℕ) : ℤ)
      (a * b₁ * b₂)) :
    let m : ℕ := r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂
    ∃! AB : Fin m × Fin m,
      (AB.1.val : ZMod r₁) = (a : ZMod r₁) ∧
      (AB.1.val : ZMod (q₀ * u₁ * Nat.lcm v₁ v₂)) =
        (b₁ : ZMod (q₀ * u₁ * Nat.lcm v₁ v₂)) ∧
      (AB.1.val : ZMod q₂) = (b₂ : ZMod q₂) ∧
      (AB.2.val : ZMod r₁) = 0 ∧
      (AB.2.val : ZMod (q₀ * u₁ * Nat.lcm v₁ v₂)) = 0 ∧
      (AB.2.val : ZMod q₂) = ((ℓ * (r₁ : ℤ)) : ZMod q₂) ∧
      Nat.Coprime AB.1.val m := by
  dsimp only
  let W : ℕ := q₀ * u₁ * Nat.lcm v₁ v₂
  let : NeZero (Nat.lcm v₁ v₂) :=
    ⟨Nat.lcm_ne_zero (NeZero.ne v₁) (NeZero.ne v₂)⟩
  have hm : r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂ = r₁ * (W * q₂) := by
    simp [W, Nat.mul_assoc]
  rw [hm]
  have hsq' : Squarefree (r₁ * (W * q₂)) := hm ▸ hsq
  have hr : Nat.Coprime r₁ (W * q₂) := Nat.coprime_of_squarefree_mul hsq'
  have hWq : Nat.Coprime W q₂ := Nat.coprime_of_squarefree_mul hsq'.of_mul_right
  let e : Fin (r₁ * (W * q₂)) ≃+* ZMod r₁ × ZMod W × ZMod q₂ :=
    (ZMod.finEquiv _).trans ((ZMod.chineseRemainder hr).trans
      ((RingEquiv.refl _).prodCongr (ZMod.chineseRemainder hWq)))
  have he (X : Fin (r₁ * (W * q₂))) :
      e X = ((X.val : ZMod r₁), (X.val : ZMod W), (X.val : ZMod q₂)) := by
    let : CommRing (Fin (r₁ * (W * q₂))) := Fin.instCommRing _
    simpa only [Fin.cast_val_eq_self, Prod.ext_iff,
      Prod.fst_natCast, Prod.snd_natCast] using map_natCast e X.val
  obtain ⟨A, hA⟩ := e.surjective ((a : ZMod r₁), (b₁ : ZMod W), (b₂ : ZMod q₂))
  obtain ⟨B, hB⟩ := e.surjective (0, 0, ((ℓ * (r₁ : ℤ)) : ZMod q₂))
  simp only [he, Prod.mk.injEq] at hA hB
  rcases hA with ⟨hAr, hAW, hAq⟩
  rcases hB with ⟨hBr, hBW, hBq⟩
  have hdiv : r₁ * (W * q₂) ∣ r₁ * q₀ * u₁ * v₁ * v₂ * q₂ := by
    simpa only [W, Nat.mul_assoc] using
      Nat.mul_dvd_mul_right
        (Nat.mul_dvd_mul_left (r₁ * q₀ * u₁) (Nat.lcm_dvd_mul v₁ v₂)) q₂
  have hprim' : IsCoprime ((r₁ * (W * q₂) : ℕ) : ℤ) (a * b₁ * b₂) :=
    hprim.of_isCoprime_of_dvd_left (Int.natCast_dvd_natCast.mpr hdiv)
  rw [Nat.cast_mul, Nat.cast_mul] at hprim'
  refine ⟨(A, B), ⟨hAr, hAW, hAq, hBr, hBW, hBq, ?_⟩, ?_⟩
  · refine ((ZMod.isUnit_iff_coprime A.val r₁).mp ?_).mul_right
      (((ZMod.isUnit_iff_coprime A.val W).mp ?_).mul_right
        ((ZMod.isUnit_iff_coprime A.val q₂).mp ?_))
    · rw [hAr]
      exact (ZMod.coe_int_isUnit_iff_isCoprime a r₁).mpr
        hprim'.of_mul_left_left.of_mul_right_left.of_mul_right_left
    · rw [hAW]
      exact (ZMod.coe_int_isUnit_iff_isCoprime b₁ W).mpr
        hprim'.of_mul_left_right.of_mul_left_left.of_mul_right_left.of_mul_right_right
    · rw [hAq]
      exact (ZMod.coe_int_isUnit_iff_isCoprime b₂ q₂).mpr
        hprim'.of_mul_left_right.of_mul_left_right.of_mul_right_right
  · rintro ⟨A', B'⟩ ⟨hAr', hAW', hAq', hBr', hBW', hBq', _⟩
    apply Prod.ext <;> apply e.injective
    · simp only [he, hAr', hAW', hAq', hAr, hAW, hAq]
    · simp only [he, hBr', hBW', hBq', hBr, hBW, hBq]

theorem sourcePsi_secondaryCRT_factorization
    (d r₁ q₀ u₁ v₁ v₂ q₂ : ℕ)
    [NeZero d] [NeZero r₁] [NeZero q₀] [NeZero u₁]
    [NeZero v₁] [NeZero v₂] [NeZero q₂]
    (hsq : Squarefree (r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂))
    (hdm : Nat.Coprime d (r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂))
    (a b₁ b₂ ℓ n h₁ h₂ : ℤ)
    (A B : Fin (r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂))
    (hA : (A.val : ZMod r₁) = (a : ZMod r₁) ∧
      (A.val : ZMod (q₀ * u₁ * Nat.lcm v₁ v₂)) =
        (b₁ : ZMod (q₀ * u₁ * Nat.lcm v₁ v₂)) ∧
      (A.val : ZMod q₂) = (b₂ : ZMod q₂))
    (hB : (B.val : ZMod r₁) = 0 ∧
      (B.val : ZMod (q₀ * u₁ * Nat.lcm v₁ v₂)) = 0 ∧
      (B.val : ZMod q₂) = ((ℓ * (r₁ : ℤ)) : ZMod q₂))
    (hn : IsCoprime n ((d * r₁ * q₀ * u₁ * v₁ * v₂ : ℕ) : ℤ))
    (hnshift : IsCoprime (n + ℓ * ((d * r₁ : ℕ) : ℤ))
      ((q₀ * q₂ : ℕ) : ℤ)) :
    let _ : NeZero (Nat.lcm v₁ v₂) :=
      ⟨Nat.lcm_ne_zero (NeZero.ne v₁) (NeZero.ne v₂)⟩
    let r : ℕ := d * r₁
    let g : ℕ := Nat.gcd v₁ v₂
    let m : ℕ := r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂
    let y : ℤ := h₁ * ((v₂ / g : ℕ) : ℤ) - h₂ * ((v₁ / g : ℕ) : ℤ)
    let Θ₁ : ℂ :=
      reciprocalUnitPhase r
        ((a : ZMod r) * (h₁ : ZMod r))
        ((n : ZMod r) * ((q₀ * u₁ * v₁ * q₂ : ℕ) : ZMod r)) *
      reciprocalUnitPhase (q₀ * u₁ * v₁)
        ((b₁ : ZMod (q₀ * u₁ * v₁)) * (h₁ : ZMod (q₀ * u₁ * v₁)))
        ((n : ZMod (q₀ * u₁ * v₁)) * ((r * q₂ : ℕ) : ZMod (q₀ * u₁ * v₁))) *
      reciprocalUnitPhase q₂
        ((b₂ : ZMod q₂) * (h₁ : ZMod q₂))
        (((n + ℓ * (r : ℤ)) : ZMod q₂) * ((r * q₀ * u₁ * v₁ : ℕ) : ZMod q₂))
    let Θ₂ : ℂ :=
      reciprocalUnitPhase r
        ((a : ZMod r) * (h₂ : ZMod r))
        ((n : ZMod r) * ((q₀ * u₁ * v₂ * q₂ : ℕ) : ZMod r)) *
      reciprocalUnitPhase (q₀ * u₁ * v₂)
        ((b₁ : ZMod (q₀ * u₁ * v₂)) * (h₂ : ZMod (q₀ * u₁ * v₂)))
        ((n : ZMod (q₀ * u₁ * v₂)) * ((r * q₂ : ℕ) : ZMod (q₀ * u₁ * v₂))) *
      reciprocalUnitPhase q₂
        ((b₂ : ZMod q₂) * (h₂ : ZMod q₂))
        (((n + ℓ * (r : ℤ)) : ZMod q₂) * ((r * q₀ * u₁ * v₂ : ℕ) : ZMod q₂))
    IsUnit ((n : ZMod d) * (m : ZMod d)) ∧
    IsUnit ((d : ZMod m) * ((n : ZMod m) + (B.val : ZMod m) * (d : ZMod m))) ∧
    Θ₁ * star Θ₂ =
      reciprocalUnitPhase d
        ((a : ZMod d) * (y : ZMod d))
        ((n : ZMod d) * (m : ZMod d)) *
      reciprocalUnitPhase m
        ((A.val : ZMod m) * (y : ZMod m))
        ((d : ZMod m) * ((n : ZMod m) + (B.val : ZMod m) * (d : ZMod m))) := by
  extract_lets lcmInst r g m y Θ₁ Θ₂
  let : NeZero (Nat.lcm v₁ v₂) := lcmInst
  let W : ℕ := q₀ * u₁ * Nat.lcm v₁ v₂
  let P : ℕ := d * m
  let N : ℕ := d * r₁ * q₀ * u₁ * v₁ * v₂
  let s : ℤ := n + (B.val : ℤ) * (d : ℤ)
  have hm : m = r₁ * (W * q₂) := by simp [m, W, Nat.mul_assoc]
  have hsq' : Squarefree (r₁ * (W * q₂)) := hm ▸ hsq
  have hr₁ : Nat.Coprime r₁ (W * q₂) := Nat.coprime_of_squarefree_mul hsq'
  have hWq : Nat.Coprime W q₂ := Nat.coprime_of_squarefree_mul hsq'.of_mul_right
  have hr₁m : r₁ ∣ m := ⟨W * q₂, hm⟩
  have hr : Nat.Coprime r (W * q₂) :=
    (hdm.of_dvd_right ⟨r₁, by dsimp only [W]; ac_rfl⟩).mul_left hr₁
  have hnu (q : ℕ) (hq : q ∣ N) : IsUnit (n : ZMod q) := by
    simpa only [ZMod.coe_unitOfIsCoprime, map_intCast] using
      (ZMod.unitOfIsCoprime n hn).isUnit.map (ZMod.castHom hq (ZMod q))
  have hnd : IsUnit (n : ZMod d) :=
    hnu d ⟨r₁ * q₀ * u₁ * v₁ * v₂, by dsimp only [N]; ac_rfl⟩
  have hnr₁ : IsUnit (n : ZMod r₁) :=
    hnu r₁ ⟨d * q₀ * u₁ * v₁ * v₂, by dsimp only [N]; ac_rfl⟩
  have hnr : IsUnit (n : ZMod r) :=
    hnu r ⟨q₀ * u₁ * v₁ * v₂, by dsimp only [N, r]; ac_rfl⟩
  have hnW : IsUnit (n : ZMod W) :=
    hnu W ((Nat.mul_dvd_mul_left (q₀ * u₁) (Nat.lcm_dvd_mul v₁ v₂)).trans
      ⟨d * r₁, by dsimp only [N]; ac_rfl⟩)
  have hnsq : IsUnit ((n + ℓ * (r : ℤ)) : ZMod q₂) := by
    simpa only [ZMod.coe_unitOfIsCoprime, Int.cast_add, Int.cast_mul, map_add, map_mul,
      map_intCast] using (ZMod.unitOfIsCoprime (n + ℓ * (r : ℤ)) hnshift).isUnit.map
        (ZMod.castHom (dvd_mul_left q₂ q₀) (ZMod q₂))
  have hs {q : ℕ} (hBq : (B.val : ZMod q) = 0) :
      (s : ZMod q) = (n : ZMod q) := by
    simp [s, hBq]
  have hsr₁ := hs hB.1
  have hsW := hs hB.2.1
  have hsq₂ : (s : ZMod q₂) = ((n + ℓ * (r : ℤ)) : ZMod q₂) := by
    simp [s, r, hB.2.2, mul_comm, mul_left_comm]
  have hsm : IsUnit (s : ZMod m) := by
    apply (MulEquiv.isUnit_map ((ZMod.ringEquivCongr hm).trans
      ((ZMod.chineseRemainder hr₁).trans
        ((RingEquiv.refl _).prodCongr (ZMod.chineseRemainder hWq))))).mp
    simpa only [map_intCast, Prod.isUnit_iff, Prod.fst_intCast, Prod.snd_intCast,
      hsr₁, hsW, hsq₂] using And.intro hnr₁ (And.intro hnW hnsq)
  have hmd : IsUnit (m : ZMod d) := (ZMod.unitOfCoprime m hdm.symm).isUnit
  have hdm' : IsUnit (d : ZMod m) := (ZMod.unitOfCoprime d hdm).isUnit
  have hud : IsUnit ((n : ZMod d) * (m : ZMod d)) := hnd.mul hmd
  have hum : IsUnit ((d : ZMod m) * (s : ZMod m)) := hdm'.mul hsm
  let E := ZMod.chineseRemainder hdm
  obtain ⟨j, hj⟩ := ZMod.intCast_surjective
    (E.symm ((a : ZMod d) * (n : ZMod d)⁻¹, (A.val : ZMod m) * (s : ZMod m)⁻¹))
  have hjE := (congrArg E hj).trans (E.apply_symm_apply _)
  simp only [map_intCast, Prod.ext_iff, Prod.fst_intCast, Prod.snd_intCast] at hjE
  obtain ⟨hjd, hjm⟩ := hjE
  have hjq (q : ℕ) (hq : q ∣ m) :
      (j : ZMod q) = (A.val : ZMod q) * (s : ZMod q)⁻¹ := by
    let f := ZMod.castHom hq (ZMod q)
    simpa only [map_intCast, map_mul, map_natCast,
      phaseCRT_map_inv f hsm] using congrArg f hjm
  have hjr : (j : ZMod r) = (a : ZMod r) * (n : ZMod r)⁻¹ := by
    let e := ZMod.chineseRemainder (hdm.of_dvd_right hr₁m)
    apply e.injective
    apply Prod.ext
    · let f : ZMod r →+* ZMod d :=
        (RingHom.fst (ZMod d) (ZMod r₁)).comp e.toRingHom
      change f (j : ZMod r) = f ((a : ZMod r) * (n : ZMod r)⁻¹)
      simpa only [map_intCast, map_mul, phaseCRT_map_inv f hnr] using hjd
    · let f : ZMod r →+* ZMod r₁ :=
        (RingHom.snd (ZMod d) (ZMod r₁)).comp e.toRingHom
      change f (j : ZMod r) = f ((a : ZMod r) * (n : ZMod r)⁻¹)
      simpa only [map_intCast, map_mul, phaseCRT_map_inv f hnr, hA.1,
        hsr₁] using hjq r₁ hr₁m
  have hrecip {q : ℕ} (b h n k : ZMod q) (hn : IsUnit n) (hk : IsUnit k) :
      k⁻¹ * (b * n⁻¹ * h) = (b * h) * (n * k)⁻¹ := by
    rw [sourcePhase_inv_mul _ _ hn hk]
    ac_rfl
  have hphase (v : ℕ) [NeZero v] (hv : v ∣ Nat.lcm v₁ v₂) (h : ℤ) :
      reciprocalUnitPhase r
        ((a : ZMod r) * (h : ZMod r))
        ((n : ZMod r) * ((q₀ * u₁ * v * q₂ : ℕ) : ZMod r)) *
      reciprocalUnitPhase (q₀ * u₁ * v)
        ((b₁ : ZMod (q₀ * u₁ * v)) * (h : ZMod (q₀ * u₁ * v)))
        ((n : ZMod (q₀ * u₁ * v)) * ((r * q₂ : ℕ) : ZMod (q₀ * u₁ * v))) *
      reciprocalUnitPhase q₂
        ((b₂ : ZMod q₂) * (h : ZMod q₂))
        (((n + ℓ * (r : ℤ)) : ZMod q₂) * ((r * q₀ * u₁ * v : ℕ) : ZMod q₂)) =
        ZMod.stdAddChar (((Nat.lcm v₁ v₂ / v : ℕ) : ZMod P) *
          ((j : ZMod P) * (h : ZMod P))) := by
    let U : ℕ := q₀ * u₁ * v
    have hUW : U ∣ W := Nat.mul_dvd_mul_left (q₀ * u₁) hv
    let f := ZMod.castHom hUW (ZMod U)
    have hnU : IsUnit (n : ZMod U) := by
      simpa only [map_intCast] using hnW.map f
    have hjU : (j : ZMod U) = (b₁ : ZMod U) * (n : ZMod U)⁻¹ := by
      simpa only [map_intCast, map_mul, phaseCRT_map_inv f hnW, hA.2.1, hsW]
        using congrArg f (hjq W ⟨r₁ * q₂, by rw [hm]; ac_rfl⟩)
    have hru : Nat.Coprime r (U * q₂) :=
      hr.of_dvd_right (Nat.mul_dvd_mul_right hUW q₂)
    have huq : Nat.Coprime U q₂ := hWq.of_dvd_left hUW
    have hUqr : IsUnit ((q₀ * u₁ * v * q₂ : ℕ) : ZMod r) :=
      (ZMod.unitOfCoprime (U * q₂) hru.symm).isUnit
    have hrqU : IsUnit ((r * q₂ : ℕ) : ZMod U) :=
      (ZMod.unitOfCoprime (r * q₂)
        (hru.coprime_mul_right_right.mul_left huq.symm)).isUnit
    have hrUq : IsUnit ((r * U : ℕ) : ZMod q₂) :=
      (ZMod.unitOfCoprime (r * U)
        (hru.coprime_mul_left_right.mul_left huq)).isUnit
    have hrUq' : IsUnit ((r * q₀ * u₁ * v : ℕ) : ZMod q₂) := by
      simpa only [U, Nat.mul_assoc] using hrUq
    have hperiod : P = (r * (U * q₂)) * (Nat.lcm v₁ v₂ / v) := by
      calc
        P = d * (r₁ * q₀ * u₁ * (v * (Nat.lcm v₁ v₂ / v)) * q₂) :=
          congrArg (fun k : ℕ => d * (r₁ * q₀ * u₁ * k * q₂))
            (Nat.mul_div_cancel' hv).symm
        _ = _ := by dsimp only [r, U]; ac_rfl
    have hquot : P / (r * (U * q₂)) = Nat.lcm v₁ v₂ / v :=
      Nat.div_eq_of_eq_mul_right (NeZero.pos _) hperiod
    have hchar := sourcePhase_stdAddChar_three r U q₂ hru huq (j * h)
    simp only [Int.cast_mul, hjr, hjU, hjq q₂ ⟨r₁ * W, by rw [hm]; ac_rfl⟩, hA.2.2, hsq₂,
      hrecip (a : ZMod r) h n (U * q₂ : ℕ) hnr hUqr,
      hrecip (b₁ : ZMod U) h n (r * q₂ : ℕ) hnU hrqU,
      hrecip (b₂ : ZMod q₂) h (n + ℓ * (r : ℤ)) (r * U : ℕ) hnsq hrUq] at hchar
    calc
      _ = ZMod.stdAddChar ((j * h : ℤ) : ZMod (r * (U * q₂))) := by
        simp only [reciprocalUnitPhase, ite_eq_left (hnr.mul hUqr),
          ite_eq_left (hnU.mul hrqU), ite_eq_left (hnsq.mul hrUq')]
        simpa only [U, Nat.mul_assoc, Int.cast_mul] using hchar.symm
      _ = ZMod.stdAddChar (((Nat.lcm v₁ v₂ / v : ℕ) : ZMod P) *
          ((j : ZMod P) * (h : ZMod P))) := by
        simpa only [hquot, map_mul, map_intCast, Int.cast_mul] using
          secondaryPhase_stdAddChar_inflate (r * (U * q₂)) P
            ⟨Nat.lcm v₁ v₂ / v, hperiod⟩ ((j : ZMod P) * (h : ZMod P))
  have hc₁ : Nat.lcm v₁ v₂ / v₁ = v₂ / g :=
    Nat.div_eq_of_eq_mul_right (NeZero.pos v₁)
      (Nat.mul_div_assoc _ (Nat.gcd_dvd_right v₁ v₂))
  have hc₂ : Nat.lcm v₁ v₂ / v₂ = v₁ / g := by
    apply Nat.div_eq_of_eq_mul_right (NeZero.pos v₂)
    rw [Nat.lcm_comm, Nat.lcm_eq_mul_div,
      Nat.mul_div_assoc _ (Nat.gcd_dvd_right v₂ v₁), Nat.gcd_comm]
  have hpair : Θ₁ * star Θ₂ = ZMod.stdAddChar ((j * y : ℤ) : ZMod P) := by
    dsimp only [Θ₁, Θ₂]
    rw [hphase v₁ (Nat.dvd_lcm_left v₁ v₂) h₁, hphase v₂ (Nat.dvd_lcm_right v₁ v₂) h₂,
      RCLike.star_def, ← AddChar.map_neg_eq_conj, ← AddChar.map_add_eq_mul]
    congr 1
    simp only [hc₁, hc₂, y, Int.cast_mul, Int.cast_sub, Int.cast_natCast]
    ring
  have hfinal : ZMod.stdAddChar ((j * y : ℤ) : ZMod P) =
      reciprocalUnitPhase d ((a : ZMod d) * (y : ZMod d))
        ((n : ZMod d) * (m : ZMod d)) *
      reciprocalUnitPhase m ((A.val : ZMod m) * (y : ZMod m))
        ((d : ZMod m) * (s : ZMod m)) := by
    simp only [reciprocalUnitPhase, ite_eq_left hud, ite_eq_left hum,
      sourcePhase_inv_mul _ _ hnd hmd,
      sourcePhase_inv_mul _ _ hdm' hsm]
    have hchar := stdAddChar_coprime_crt d m hdm
      ((j * y : ℤ) : ZMod P)
    simp only [map_intCast, Prod.fst_intCast, Prod.snd_intCast] at hchar
    simpa only [Int.cast_mul, hjd, hjm, mul_assoc, mul_comm, mul_left_comm] using hchar
  simpa only [s, Int.cast_add, Int.cast_mul, Int.cast_natCast] using
    And.intro hud (And.intro hum (hpair.trans hfinal))

theorem sourceTerminalLinearization_residue_transport
    (q₀ m w₂ : ℕ)
    (lam lamTilde s k : ℤ) (hqm : q₀ ∣ m) (hw₂ : 0 < w₂)
    (hlam : (w₂ : ℤ) ∣ lam) (hlamTilde : (w₂ : ℤ) ∣ lamTilde)
    (hk : (w₂ : ℤ) ∣ k)
    (hu : IsUnit ((lam / (w₂ : ℤ) : ℤ) : ZMod m))
    (hv : IsUnit ((lamTilde / (w₂ : ℤ) : ℤ) : ZMod m)) :
    let a : ZMod q₀ := ((lam / (w₂ : ℤ) : ℤ) : ZMod q₀)
    let b : ZMod q₀ := ((lamTilde / (w₂ : ℤ) : ℤ) : ZMod q₀)
    let c : ZMod q₀ := ((s * (k / (w₂ : ℤ)) : ℤ) : ZMod q₀)
    IsUnit a ∧ IsUnit b ∧
      ∀ n d : ℤ, lam ∣ lamTilde * n + s * k * d →
        let nt : ℤ := (lamTilde * n + s * k * d) / lam
        (lam / (w₂ : ℤ)) * nt =
            (lamTilde / (w₂ : ℤ)) * n + s * (k / (w₂ : ℤ)) * d ∧
          (nt : ZMod q₀) = a⁻¹ * (b * (n : ZMod q₀) + c * (d : ZMod q₀)) := by
  have hunit (t : ℤ) (ht : IsUnit (t : ZMod m)) : IsUnit (t : ZMod q₀) := by
    simpa only [map_intCast] using ht.map (ZMod.castHom hqm (ZMod q₀))
  have ha := hunit (lam / (w₂ : ℤ)) hu
  refine ⟨ha, hunit (lamTilde / (w₂ : ℤ)) hv, ?_⟩
  intro n d hdiv nt
  have hlinear : (lam / (w₂ : ℤ)) * nt =
      (lamTilde / (w₂ : ℤ)) * n + s * (k / (w₂ : ℤ)) * d := by
    apply mul_left_cancel₀ (Int.ofNat_ne_zero.mpr (Nat.ne_of_gt hw₂))
    calc
      (w₂ : ℤ) * ((lam / (w₂ : ℤ)) * nt) = lam * nt := by
        rw [← mul_assoc, Int.mul_ediv_cancel_of_dvd hlam]
      _ = lamTilde * n + s * k * d := Int.mul_ediv_cancel_of_dvd hdiv
      _ = (w₂ : ℤ) * ((lamTilde / (w₂ : ℤ)) * n + s * (k / (w₂ : ℤ)) * d) := by
        conv_lhs =>
          rw [← Int.mul_ediv_cancel_of_dvd hlamTilde, ← Int.mul_ediv_cancel_of_dvd hk]
        ring
  refine ⟨hlinear, ?_⟩
  simpa only [Int.cast_add, Int.cast_mul, ← mul_assoc,
    ZMod.inv_mul_of_unit _ ha, one_mul] using
    congrArg (fun z : ℤ => ((lam / (w₂ : ℤ) : ℤ) : ZMod q₀)⁻¹ * (z : ZMod q₀)) hlinear

open Classical in
theorem sourceTerminalCompatibility_pair_class_indicator
    (q₀ m w₂ z₁ r₁ b₁ b₂ : ℕ) [NeZero q₀]
    (lam lamTilde s k ℓ n d : ℤ) (hqm : q₀ ∣ m) (hw₂ : 0 < w₂)
    (hlam : (w₂ : ℤ) ∣ lam) (hlamTilde : (w₂ : ℤ) ∣ lamTilde)
    (hk : (w₂ : ℤ) ∣ k)
    (hu : IsUnit ((lam / (w₂ : ℤ) : ℤ) : ZMod m))
    (hv : IsUnit ((lamTilde / (w₂ : ℤ) : ℤ) : ZMod m))
    (hd : Int.gcd d ((m : ℤ) * lam * lamTilde) = 1)
    (hdiv : lam ∣ lamTilde * n + s * k * d) :
    let a : ZMod q₀ := ((lam / (w₂ : ℤ) : ℤ) : ZMod q₀)
    let b : ZMod q₀ := ((lamTilde / (w₂ : ℤ) : ℤ) : ZMod q₀)
    let c : ZMod q₀ := ((s * (k / (w₂ : ℤ)) : ℤ) : ZMod q₀)
    let F : ZMod q₀ → ZMod q₀ → ZMod q₀ := fun D X => a⁻¹ * (b * X + c * D)
    let C : ZMod q₀ → ZMod q₀ → ℝ := fun D X =>
      sourceCompatibility (z₁ * r₁) q₀ b₁ b₂ (ℓ * (D.val : ℤ)) (X.val : ℤ)
    let R : Finset (ZMod q₀ × ZMod q₀) :=
      Finset.univ.filter fun p => IsUnit p.1 ∧ C p.1 p.2 = 1 ∧ C p.1 (F p.1 p.2) = 1
    let nt : ℤ := (lamTilde * n + s * k * d) / lam
    sourceCompatibility (z₁ * r₁) q₀ b₁ b₂ (ℓ * d) n *
        sourceCompatibility (z₁ * r₁) q₀ b₁ b₂ (ℓ * d) nt =
      if ((d : ZMod q₀), (n : ZMod q₀)) ∈ R then 1 else 0 := by
  intro a b c F C R nt
  have hunit_iff (x : ℤ) : Int.gcd x (q₀ : ℤ) = 1 ↔ IsUnit (x : ZMod q₀) := by
    rw [ZMod.coe_int_isUnit_iff_isCoprime, Int.isCoprime_iff_gcd_eq_one, Int.gcd_comm]
  have hperiod (d' n' : ℤ) :
      sourceCompatibility (z₁ * r₁) q₀ b₁ b₂ (ℓ * d') n' =
        C (d' : ZMod q₀) (n' : ZMod q₀) := by
    dsimp only [C, sourceCompatibility]
    simp only [hunit_iff, Int.cast_mul, Int.cast_add,
      Int.cast_natCast, ZMod.natCast_zmod_val]
  have hdm : IsCoprime d (m : ℤ) :=
    (Int.isCoprime_iff_gcd_eq_one.mpr hd).of_mul_right_left.of_mul_right_left
  have hdunit : IsUnit (d : ZMod q₀) := by
    apply (ZMod.coe_int_isUnit_iff_isCoprime d q₀).mpr
    exact (hdm.of_isCoprime_of_dvd_right (by exact_mod_cast hqm)).symm
  have hnt : (nt : ZMod q₀) = F (d : ZMod q₀) (n : ZMod q₀) :=
    (sourceTerminalLinearization_residue_transport q₀ m w₂ lam lamTilde s k hqm hw₂
      hlam hlamTilde hk hu hv).2.2 n d hdiv |>.2
  rw [hperiod d n, hperiod d nt, hnt]
  simp only [R, Finset.mem_filter, Finset.mem_univ, true_and, hdunit]
  dsimp only [C, sourceCompatibility]
  simp only [ite_zero_mul_ite_zero, one_mul,
    Ne.ite_eq_left_iff (one_ne_zero : (1 : ℝ) ≠ 0)]

open Classical in
theorem sourceTerminalCompatibility_relevant_class_count
    (q₀ w₂ z₁ r₁ b₁ b₂ : ℕ) [NeZero q₀]
    (lam lamTilde s k ℓ : ℤ)
    (hb₁ : Nat.Coprime b₁ q₀) (hzr : Nat.Coprime (z₁ * r₁) q₀) :
    let a : ZMod q₀ := ((lam / (w₂ : ℤ) : ℤ) : ZMod q₀)
    let b : ZMod q₀ := ((lamTilde / (w₂ : ℤ) : ℤ) : ZMod q₀)
    let c : ZMod q₀ := ((s * (k / (w₂ : ℤ)) : ℤ) : ZMod q₀)
    let F : ZMod q₀ → ZMod q₀ → ZMod q₀ := fun D X => a⁻¹ * (b * X + c * D)
    let C : ZMod q₀ → ZMod q₀ → ℝ := fun D X =>
      sourceCompatibility (z₁ * r₁) q₀ b₁ b₂ (ℓ * (D.val : ℤ)) (X.val : ℤ)
    let R : Finset (ZMod q₀ × ZMod q₀) :=
      Finset.univ.filter fun p => IsUnit p.1 ∧ C p.1 p.2 = 1 ∧ C p.1 (F p.1 p.2) = 1
    R.card ≤ q₀ * Int.gcd (q₀ : ℤ) ℓ := by
  intro a b c F C R
  have hlinear (D X : ZMod q₀) (hCX : C D X = 1) :
      ((b₁ : ZMod q₀) - b₂) * X =
        -(ℓ : ZMod q₀) * ((b₁ : ZMod q₀) * ((z₁ * r₁ : ℕ) : ZMod q₀) * D) := by
    dsimp only [C, sourceCompatibility] at hCX
    have h := (Ne.ite_eq_left_iff (one_ne_zero : (1 : ℝ) ≠ 0)).mp hCX
    rw [← Int.isCoprime_iff_gcd_eq_one, isCoprime_comm,
      ← ZMod.coe_int_isUnit_iff_isCoprime] at h
    simp only [Int.cast_mul, Int.cast_add, Int.cast_natCast,
      ZMod.natCast_zmod_val] at h
    obtain ⟨hX, hY⟩ := IsUnit.mul_iff.mp h.1
    have hcross := (Units.mul_inv_eq_mul_inv_iff
      (b₁ : ZMod q₀) (b₂ : ZMod q₀) hX.unit hY.unit).mp (by
        simpa only [← ZMod.inv_coe_unit, IsUnit.unit_spec] using h.2)
    simp only [IsUnit.unit_spec] at hcross
    linear_combination hcross
  let K := (nsmulAddMonoidHom ℓ.natAbs : ZMod q₀ →+ ZMod q₀).ker
  have hK : Nat.card K = Int.gcd (q₀ : ℤ) ℓ := by
    simpa only [K, Nat.card_zmod, Int.gcd_def, Int.natAbs_natCast] using
      IsAddCyclic.card_nsmulAddMonoidHom_ker (ZMod q₀) ℓ.natAbs
  have hbound : R.card ≤ Int.gcd (q₀ : ℤ) ℓ *
      (Finset.univ : Finset (ZMod q₀)).card := by
    apply Finset.card_le_mul_card_image_of_maps_to (f := Prod.snd) (s := R)
      (t := Finset.univ)
      (fun _ _ => Finset.mem_univ _) (Int.gcd (q₀ : ℤ) ℓ)
    intro X _
    let S := R.filter fun p => p.2 = X
    change S.card ≤ Int.gcd (q₀ : ℤ) ℓ
    obtain hS | ⟨p₀, hp₀⟩ := S.eq_empty_or_nonempty
    · simp [hS]
    · obtain ⟨hp₀R, hp₀X⟩ := Finset.mem_filter.mp hp₀
      have hB : IsUnit ((b₁ : ZMod q₀) * ((z₁ * r₁ : ℕ) : ZMod q₀)) :=
        ((ZMod.isUnit_iff_coprime b₁ q₀).2 hb₁).mul
          ((ZMod.isUnit_iff_coprime (z₁ * r₁) q₀).2 hzr)
      have h₀ := hlinear p₀.1 X (hp₀X ▸ (Finset.mem_filter.mp hp₀R).2.2.1)
      let f : S → K := fun p =>
        ⟨p.1.1 - p₀.1, by
          change ℓ.natAbs • (p.1.1 - p₀.1) = 0
          apply natAbs_nsmul_eq_zero.mpr
          obtain ⟨hpR, hpX⟩ := Finset.mem_filter.mp p.2
          have hp := hlinear p.1.1 X (hpX ▸ (Finset.mem_filter.mp hpR).2.2.1)
          rw [zsmul_eq_mul]
          apply hB.mul_left_cancel
          rw [mul_zero]
          linear_combination hp - h₀⟩
      have hf : Function.Injective f := by
        intro p p' heq
        apply Subtype.ext
        apply Prod.ext
        · exact sub_left_inj.mp (congrArg (fun z : K => (z : ZMod q₀)) heq)
        · exact (Finset.mem_filter.mp p.2).2.trans
            (Finset.mem_filter.mp p'.2).2.symm
      calc
        S.card ≤ Nat.card K := by
          simpa only [Nat.card_eq_finsetCard] using Nat.card_le_card_of_injective f hf
        _ = Int.gcd (q₀ : ℤ) ℓ := hK
  simpa only [Finset.card_univ, ZMod.card, Nat.mul_comm] using hbound

theorem sourceTerminalHomogeneous_sign_normalization
    (m : ℕ) [NeZero m] (lam lamTilde s k A B : ℤ) (hlam : lam ≠ 0) :
    let ε : ℤ := if 0 < lam then 1 else -1
    let J : ℤ := s * k + (lam - lamTilde) * B
    let Jε : ℤ := s * (ε * k) + (ε * lam - ε * lamTilde) * B
    ε ^ 2 = 1 ∧ 0 < ε * lam ∧
      Int.gcd (ε * lam) (ε * lamTilde) = Int.gcd lam lamTilde ∧
      Jε = ε * J ∧ Int.gcd Jε (m : ℤ) = Int.gcd J (m : ℤ) ∧
      ∀ n d : ℤ,
        (ε * lam ∣ (ε * lamTilde) * n + s * (ε * k) * d ↔
          lam ∣ lamTilde * n + s * k * d) ∧
        (lam ∣ lamTilde * n + s * k * d →
          let nt : ℤ := (lamTilde * n + s * k * d) / lam
          let ntε : ℤ := ((ε * lamTilde) * n + s * (ε * k) * d) / (ε * lam)
          ntε = nt ∧
            reciprocalUnitPhase m
                (((ε * A : ℤ) : ZMod m) * (Jε : ZMod m))
                (((n + B * d : ℤ) : ZMod m) * ((ntε + B * d : ℤ) : ZMod m)) =
              reciprocalUnitPhase m ((A : ZMod m) * (J : ZMod m))
                (((n + B * d : ℤ) : ZMod m) * ((nt + B * d : ℤ) : ZMod m))) := by
  intro ε J Jε
  by_cases h : 0 < lam
  · simp [ε, J, Jε, h]
  · have hε : ε = -1 := ite_eq_right h
    have hJ : Jε = ε * J := by
      dsimp only [Jε, J]
      ring
    refine ⟨?_, ?_, ?_, hJ, ?_, ?_⟩
    · norm_num [hε]
    · rw [hε, neg_one_mul]
      omega
    · simp [hε]
    · rw [hJ, hε, neg_one_mul]
      exact Int.neg_gcd
    · intro n d
      have hnum : (ε * lamTilde) * n + s * (ε * k) * d =
          ε * (lamTilde * n + s * k * d) := by ring
      refine ⟨?_, ?_⟩
      · rw [hnum, hε]
        simp only [neg_one_mul, Int.neg_dvd, Int.dvd_neg]
      · intro hdiv nt ntε
        have hquot : ntε = nt := by
          change ((ε * lamTilde) * n + s * (ε * k) * d) / (ε * lam) =
            (lamTilde * n + s * k * d) / lam
          rw [hnum]
          exact EuclideanDomain.mul_div_mul_cancel (by simp [hε]) hdiv
        refine ⟨hquot, ?_⟩
        simp only [hquot, hJ, hε, neg_one_mul, Int.cast_neg, neg_mul_neg]

theorem sourceTerminalHomogeneous_integer_lattice
    (lam lamTilde s k : ℤ) (hlam : 0 < lam) :
    let g : ℕ := Int.gcd lam lamTilde
    let u : ℤ := lam / (g : ℤ)
    let v : ℤ := lamTilde / (g : ℤ)
    let t : ℤ := (s * k) / (g : ℤ)
    0 < g ∧ 0 < u ∧ Int.gcd u v = 1 ∧
      (∀ d n : ℤ, Int.gcd d (lam * lamTilde) = 1 →
        ¬ (g : ℤ) ∣ s * k → ¬ lam ∣ lamTilde * n + s * k * d) ∧
      ((g : ℤ) ∣ s * k →
        ∃! F : ℤ,
          0 ≤ F ∧ F < u ∧ Int.ModEq u (v * F) (-t) ∧
            let G : ℤ := (v * F + t) / u
            u ∣ v * F + t ∧ u * G - v * F = t ∧
              ∀ d n nt : ℤ,
                (lam * nt - lamTilde * n = s * k * d ↔
                  ∃! n₁ : ℤ, n = u * n₁ + F * d ∧ nt = v * n₁ + G * d)) := by
  intro g u v t
  have hgpos : 0 < g := Int.gcd_pos_of_ne_zero_left lamTilde hlam.ne'
  have hg0 : (g : ℤ) ≠ 0 := by exact_mod_cast hgpos.ne'
  have hgdiv : (g : ℤ) ∣ lam := Int.gcd_dvd_left lam lamTilde
  have hgTdiv : (g : ℤ) ∣ lamTilde := Int.gcd_dvd_right lam lamTilde
  have hupos : 0 < u :=
    Int.ediv_pos_of_pos_of_dvd hlam (Int.natCast_nonneg g) hgdiv
  have huv : Int.gcd u v = 1 := Int.gcd_ediv_gcd_ediv_gcd_of_ne_zero_left hlam.ne'
  have hgu : (g : ℤ) * u = lam := Int.mul_ediv_cancel' hgdiv
  have hgv : (g : ℤ) * v = lamTilde := Int.mul_ediv_cancel' hgTdiv
  refine ⟨hgpos, hupos, huv, ?_, ?_⟩
  · intro d n hcop hnot hdiv
    apply hnot
    have hgd : Int.gcd (g : ℤ) d = 1 := by
      apply Nat.dvd_one.mp
      rw [Int.gcd_comm, ← hcop]
      exact Int.gcd_dvd_gcd_of_dvd_right d (dvd_mul_of_dvd_left hgdiv lamTilde)
    apply Int.dvd_of_dvd_mul_left_of_gcd_one (c := d) _ hgd
    simpa using dvd_sub (hgdiv.trans hdiv) (dvd_mul_of_dvd_left hgTdiv n)
  · intro hgsk
    have hgt : (g : ℤ) * t = s * k := Int.mul_ediv_cancel' hgsk
    have hbez : u * Int.gcdA u v + v * Int.gcdB u v = 1 := by
      simpa [huv] using (Int.gcd_eq_gcd_ab u v).symm
    obtain ⟨F, hF0, hFu, hFrep⟩ :=
      Int.existsUnique_equiv (-t * Int.gcdB u v) hupos
    have hFmod : Int.ModEq u (v * F) (-t) := by
      refine (hFrep.mul_left v).trans (Int.modEq_of_dvd ⟨-t * Int.gcdA u v, ?_⟩)
      linear_combination t * hbez
    refine ⟨F, ⟨hF0, hFu, hFmod, ?_⟩, ?_⟩
    · intro G
      have hGdiv : u ∣ v * F + t := by
        simpa only [sub_neg_eq_add] using hFmod.symm.dvd
      have hG : u * G - v * F = t :=
        Int.sub_eq_iff_eq_add'.2 (Int.mul_ediv_cancel' hGdiv)
      refine ⟨hGdiv, hG, ?_⟩
      intro d n nt
      constructor
      · intro hrel
        have hred : u * nt - v * n = t * d := by
          apply mul_left_cancel₀ hg0
          linear_combination hrel + nt * hgu - n * hgv - d * hgt
        have hdiv : u ∣ v * (n - F * d) := by
          refine ⟨nt - G * d, ?_⟩
          linear_combination d * hG - hred
        obtain ⟨n₁, hn₁⟩ := Int.dvd_of_dvd_mul_right_of_gcd_one hdiv huv
        have hn := Int.sub_eq_iff_eq_add.mp hn₁
        have hnt : nt = v * n₁ + G * d := by
          apply mul_left_cancel₀ hupos.ne'
          linear_combination hred + v * hn - d * hG
        refine ⟨n₁, ⟨hn, hnt⟩, ?_⟩
        intro n₂ hn₂
        exact mul_left_cancel₀ hupos.ne' (add_right_cancel (hn₂.1.symm.trans hn))
      · rintro ⟨n₁, hn₁, _⟩
        rw [hn₁.1, hn₁.2, ← hgu, ← hgv, ← hgt]
        linear_combination (g : ℤ) * d * hG
    · intro F' hF'
      have hmod : Int.ModEq u F' F := by
        simpa [huv] using
          Int.ModEq.cancel_left_div_gcd hupos (hF'.2.2.1.trans hFmod.symm)
      simpa only [Int.emod_eq_of_lt hF'.1 hF'.2.1, Int.emod_eq_of_lt hF0 hFu]
        using hmod.eq

theorem sourceTerminalHomogeneous_units_and_slopes
    (m w₂ : ℕ) [NeZero m] (hw₂ : 0 < w₂)
    (lam lamTilde s k B : ℤ) (hlam : lam ≠ 0)
    (hwlam : (w₂ : ℤ) ∣ lam) (hwlamTilde : (w₂ : ℤ) ∣ lamTilde)
    (huold : IsUnit ((lam / (w₂ : ℤ) : ℤ) : ZMod m))
    (hvold : IsUnit ((lamTilde / (w₂ : ℤ) : ℤ) : ZMod m))
    (hgsk : (Int.gcd lam lamTilde : ℤ) ∣ s * k) :
    let g : ℕ := Int.gcd lam lamTilde
    let u : ℤ := lam / (g : ℤ)
    let v : ℤ := lamTilde / (g : ℤ)
    let t : ℤ := (g : ℤ) / (w₂ : ℤ)
    let J : ℤ := s * k + (lam - lamTilde) * B
    w₂ ∣ g ∧
      lam / (w₂ : ℤ) = t * u ∧ lamTilde / (w₂ : ℤ) = t * v ∧
      IsUnit (u : ZMod m) ∧ IsUnit (v : ZMod m) ∧ IsUnit (t : ZMod m) ∧
      (g : ℤ) ∣ J ∧ (w₂ : ℤ) ∣ J ∧
      J / (g : ℤ) = (s * k) / (g : ℤ) + (u - v) * B ∧
      J / (w₂ : ℤ) = t * (J / (g : ℤ)) ∧
      ∀ F G : ℤ, u * G - v * F = (s * k) / (g : ℤ) →
        (((G + B : ℤ) : ZMod m) * (v : ZMod m)⁻¹ -
            ((F + B : ℤ) : ZMod m) * (u : ZMod m)⁻¹) =
          ((u : ZMod m) * (v : ZMod m))⁻¹ * ((J / (g : ℤ) : ℤ) : ZMod m) ∧
        ((u : ZMod m) * (v : ZMod m))⁻¹ * ((J / (g : ℤ) : ℤ) : ZMod m) =
          ((t : ZMod m) * (u : ZMod m) * (v : ZMod m))⁻¹ *
            ((J / (w₂ : ℤ) : ℤ) : ZMod m) := by
  intro g u v t J
  have hgzero : (g : ℤ) ≠ 0 := by
    exact_mod_cast Int.gcd_ne_zero_left (b := lamTilde) hlam
  have hwzero : (w₂ : ℤ) ≠ 0 := by exact_mod_cast hw₂.ne'
  have hglam : (g : ℤ) ∣ lam := Int.gcd_dvd_left lam lamTilde
  have hglamTilde : (g : ℤ) ∣ lamTilde := Int.gcd_dvd_right lam lamTilde
  have hwg : w₂ ∣ g := Int.dvd_gcd hwlam hwlamTilde
  have hwgI : (w₂ : ℤ) ∣ (g : ℤ) := by exact_mod_cast hwg
  have hgu : (g : ℤ) * u = lam := Int.mul_ediv_cancel' hglam
  have hgv : (g : ℤ) * v = lamTilde := Int.mul_ediv_cancel' hglamTilde
  have hwt : (w₂ : ℤ) * t = (g : ℤ) := Int.mul_ediv_cancel' hwgI
  have hlamw : lam / (w₂ : ℤ) = t * u := by
    rw [← hgu, Int.mul_ediv_assoc' u hwgI]
  have hlamTildew : lamTilde / (w₂ : ℤ) = t * v := by
    rw [← hgv, Int.mul_ediv_assoc' v hwgI]
  rw [hlamw, Int.cast_mul, IsUnit.mul_iff] at huold
  rw [hlamTildew, Int.cast_mul, IsUnit.mul_iff] at hvold
  rcases huold with ⟨ht, hu⟩
  have hv : IsUnit (v : ZMod m) := hvold.2
  have hgJ : (g : ℤ) ∣ J :=
    dvd_add hgsk (dvd_mul_of_dvd_left (dvd_sub hglam hglamTilde) B)
  have hwJ : (w₂ : ℤ) ∣ J := hwgI.trans hgJ
  have hJg : J / (g : ℤ) = (s * k) / (g : ℤ) + (u - v) * B := by
    apply Int.ediv_eq_of_eq_mul_right hgzero
    dsimp only [J]
    rw [mul_add, ← mul_assoc, mul_sub, hgu, hgv, Int.mul_ediv_cancel' hgsk]
  have hJw : J / (w₂ : ℤ) = t * (J / (g : ℤ)) := by
    apply Int.ediv_eq_of_eq_mul_right hwzero
    rw [← mul_assoc, hwt, Int.mul_ediv_cancel' hgJ]
  refine ⟨hwg, hlamw, hlamTildew, hu, hv, ht, hgJ, hwJ, hJg, hJw, ?_⟩
  intro F G hFG
  have huinv := ZMod.mul_inv_of_unit (u : ZMod m) hu
  have hvinv := ZMod.mul_inv_of_unit (v : ZMod m) hv
  have huvinv := ZMod.mul_inv_of_unit ((u : ZMod m) * (v : ZMod m)) (hu.mul hv)
  have htuvinv := ZMod.mul_inv_of_unit
    ((t : ZMod m) * (u : ZMod m) * (v : ZMod m)) ((ht.mul hu).mul hv)
  have hnumI : u * (G + B) - v * (F + B) = J / (g : ℤ) := by
    rw [hJg]
    linear_combination hFG
  have hnum : (u : ZMod m) * ((G + B : ℤ) : ZMod m) -
      (v : ZMod m) * ((F + B : ℤ) : ZMod m) = ((J / (g : ℤ) : ℤ) : ZMod m) := by
    simpa only [Int.cast_mul, Int.cast_sub] using
      congrArg (fun z : ℤ => (z : ZMod m)) hnumI
  constructor
  · apply (hu.mul hv).mul_left_cancel
    linear_combination hnum +
      ((u : ZMod m) * ((G + B : ℤ) : ZMod m)) * hvinv -
      ((v : ZMod m) * ((F + B : ℤ) : ZMod m)) * huinv -
      ((J / (g : ℤ) : ℤ) : ZMod m) * huvinv
  · rw [hJw, Int.cast_mul]
    apply ((ht.mul hu).mul hv).mul_left_cancel
    linear_combination
      ((t : ZMod m) * ((J / (g : ℤ) : ℤ) : ZMod m)) * huvinv -
      ((t : ZMod m) * ((J / (g : ℤ) : ℤ) : ZMod m)) * htuvinv

theorem sourceTerminalHomogeneous_masked_phase
    (m w₂ : ℕ) [NeZero m] (hw₂ : 0 < w₂)
    (lam lamTilde s k A B F G : ℤ) (hlam : lam ≠ 0)
    (hwlam : (w₂ : ℤ) ∣ lam) (hwlamTilde : (w₂ : ℤ) ∣ lamTilde)
    (huold : IsUnit ((lam / (w₂ : ℤ) : ℤ) : ZMod m))
    (hvold : IsUnit ((lamTilde / (w₂ : ℤ) : ℤ) : ZMod m))
    (hA : IsUnit (A : ZMod m))
    (hgsk : (Int.gcd lam lamTilde : ℤ) ∣ s * k)
    (hFG : (lam / (Int.gcd lam lamTilde : ℤ)) * G -
      (lamTilde / (Int.gcd lam lamTilde : ℤ)) * F =
        (s * k) / (Int.gcd lam lamTilde : ℤ)) :
    let g : ℕ := Int.gcd lam lamTilde
    let u : ℤ := lam / (g : ℤ)
    let v : ℤ := lamTilde / (g : ℤ)
    let t : ℤ := (g : ℤ) / (w₂ : ℤ)
    let J : ℤ := s * k + (lam - lamTilde) * B
    let A₁ : ZMod m := (A : ZMod m) * (t : ZMod m)
    let A₂ : ZMod m := ((t : ZMod m) * (u : ZMod m) * (v : ZMod m))⁻¹
    let B₁ : ZMod m := ((F + B : ℤ) : ZMod m) * (u : ZMod m)⁻¹
    let L₁ : ZMod m := A₂ * ((J / (w₂ : ℤ) : ℤ) : ZMod m)
    IsUnit A₁ ∧ IsUnit A₂ ∧
      Nat.gcd (((w₂ : ZMod m) * A₁ * L₁).val) m = Int.gcd J (m : ℤ) ∧
      ∀ n₁ d : ℤ,
        let n : ℤ := u * n₁ + F * d
        let nt : ℤ := v * n₁ + G * d
        (IsUnit (((n + B * d : ℤ) : ZMod m) * ((nt + B * d : ℤ) : ZMod m)) ↔
          IsUnit ((n₁ : ZMod m) + B₁ * (d : ZMod m)) ∧
            IsUnit ((n₁ : ZMod m) + (B₁ + L₁) * (d : ZMod m))) ∧
        reciprocalUnitPhase m ((A : ZMod m) * (J : ZMod m))
            (((n + B * d : ℤ) : ZMod m) * ((nt + B * d : ℤ) : ZMod m)) =
          affineReciprocalProductPhase m
            ((w₂ : ZMod m) * A₁) B₁ L₁ 0 0 (n₁ : ZMod m) (d : ZMod m) := by
  intro g u v t J A₁ A₂ B₁ L₁
  rcases sourceTerminalHomogeneous_units_and_slopes m w₂ hw₂ lam lamTilde s k B
      hlam hwlam hwlamTilde huold hvold hgsk with
    ⟨_, _, _, hu, hv, ht, _, hwJ, _, _, hslopes⟩
  have hB : B₁ + L₁ = ((G + B : ℤ) : ZMod m) * (v : ZMod m)⁻¹ :=
    (eq_add_of_sub_eq' ((hslopes F G hFG).1.trans (hslopes F G hFG).2)).symm
  have huinv := ZMod.mul_inv_of_unit (u : ZMod m) hu
  have hvinv := ZMod.mul_inv_of_unit (v : ZMod m) hv
  have huvinv := ZMod.mul_inv_of_unit ((u : ZMod m) * (v : ZMod m)) (hu.mul hv)
  have htuvinv : ((t : ZMod m) * (u : ZMod m) * (v : ZMod m)) * A₂ = 1 :=
    ZMod.mul_inv_of_unit _ ((ht.mul hu).mul hv)
  have hJ : (w₂ : ZMod m) * ((J / (w₂ : ℤ) : ℤ) : ZMod m) = (J : ZMod m) := by
    simpa only [Int.cast_mul, Int.cast_natCast] using
      congrArg (fun z : ℤ => (z : ZMod m)) (Int.mul_ediv_cancel' hwJ)
  have hcoeff : (w₂ : ZMod m) * A₁ * L₁ =
      (A : ZMod m) * ((u : ZMod m) * (v : ZMod m))⁻¹ * (J : ZMod m) := by
    apply (hu.mul hv).mul_left_cancel
    dsimp only [A₁, L₁]
    linear_combination
      ((A : ZMod m) * (w₂ : ZMod m) * ((J / (w₂ : ℤ) : ℤ) : ZMod m)) * htuvinv +
      (A : ZMod m) * hJ - ((A : ZMod m) * (J : ZMod m)) * huvinv
  have hgcd : Nat.gcd (((w₂ : ZMod m) * A₁ * L₁).val) m = Int.gcd J (m : ℤ) := by
    let C : ZMod m := (A : ZMod m) * ((u : ZMod m) * (v : ZMod m))⁻¹
    have hC : IsUnit C := hA.mul (IsUnit.of_mul_eq_one_right _ huvinv)
    have hCcop := ZMod.val_coe_unit_coprime hC.unit
    rw [IsUnit.unit_spec] at hCcop
    rw [hcoeff]
    change Nat.gcd ((C * (J : ZMod m)).val) m = Int.gcd J (m : ℤ)
    rw [ZMod.val_mul, ← Nat.gcd_rec, Nat.gcd_comm,
      Nat.Coprime.gcd_mul_left_cancel _ hCcop, ← Int.gcd_natCast_natCast,
      ZMod.val_intCast, Int.gcd_emod]
  refine ⟨hA.mul ht, IsUnit.of_mul_eq_one_right _ htuvinv, hgcd, ?_⟩
  intro n₁ d
  dsimp only
  let P₁ : ZMod m := (n₁ : ZMod m) + B₁ * (d : ZMod m)
  let P₂ : ZMod m := (n₁ : ZMod m) + (B₁ + L₁) * (d : ZMod m)
  have hn : ((u * n₁ + F * d + B * d : ℤ) : ZMod m) = (u : ZMod m) * P₁ := by
    dsimp only [P₁, B₁]
    push_cast
    linear_combination -(((F : ZMod m) + (B : ZMod m)) * (d : ZMod m)) * huinv
  have hnt : ((v * n₁ + G * d + B * d : ℤ) : ZMod m) = (v : ZMod m) * P₂ := by
    dsimp only [P₂]
    rw [hB]
    push_cast
    linear_combination -(((G : ZMod m) + (B : ZMod m)) * (d : ZMod m)) * hvinv
  have hmask :
      IsUnit (((u : ZMod m) * P₁) * ((v : ZMod m) * P₂)) ↔ IsUnit P₁ ∧ IsUnit P₂ := by
    rw [IsUnit.mul_iff, hu.mul_left_iff, hv.mul_left_iff]
  constructor
  · rw [hn, hnt]
    exact hmask
  · unfold reciprocalUnitPhase affineReciprocalProductPhase
    simp only [add_zero, hn, hnt, hmask]
    split_ifs with hP
    · have hinv : (((u : ZMod m) * P₁) * ((v : ZMod m) * P₂))⁻¹ =
          ((u : ZMod m) * (v : ZMod m))⁻¹ * (P₁ * P₂)⁻¹ := by
        rw [mul_mul_mul_comm (u : ZMod m) P₁ (v : ZMod m) P₂]
        apply ZMod.inv_eq_of_mul_eq_one
        rw [mul_mul_mul_comm, huvinv,
          ZMod.mul_inv_of_unit _ (hP.1.mul hP.2), one_mul]
      rw [hinv, hcoeff]
      congr 1
      ring
    · rfl

open Classical in
theorem sourceSecondaryResidue_fiber_grouping
    {ι : Type*} (S : Finset ι) (n y : ι → ℤ) (w : ι → ℂ)
    (d m : ℕ) [NeZero d] [NeZero m] (hdm : Nat.Coprime d m)
    (a A B : ℤ) :
    let η : ι → ℂ := fun i =>
      reciprocalUnitPhase d
        ((a : ZMod d) * (y i : ZMod d))
        ((n i : ZMod d) * (m : ZMod d))
    let θ : ι → ℂ := fun i =>
      reciprocalUnitPhase m
        ((A : ZMod m) * (y i : ZMod m))
        ((d : ZMod m) * ((n i : ZMod m) + (B : ZMod m) * (d : ZMod m)))
    let U : Finset ι := S.filter (fun i => IsUnit (n i : ZMod d))
    let r : ι → ZMod d := fun i => (y i : ZMod d) * (n i : ZMod d)⁻¹
    let F : ZMod d → ℂ := fun c =>
      ∑ i ∈ U.filter (fun i => r i = c), w i * θ i
    let χ : ZMod d → ℂ := fun c =>
      ZMod.stdAddChar ((a : ZMod d) * c * (m : ZMod d)⁻¹)
    (∑ i ∈ S, w i * η i * θ i) = ∑ c : ZMod d, χ c * F c ∧
    (∀ c : ZMod d,
      ‖∑ i ∈ U.filter (fun i => r i = c), w i * η i * θ i‖ = ‖F c‖) ∧
    ‖∑ i ∈ S, w i * η i * θ i‖ ≤ ∑ c : ZMod d, ‖F c‖ := by
  intro η θ U r F χ
  have hm : IsUnit (m : ZMod d) := (ZMod.isUnit_iff_coprime m d).2 hdm.symm
  have hη (i : ι) (hi : IsUnit (n i : ZMod d)) : η i = χ (r i) := by
    have hinv : ((n i : ZMod d) * (m : ZMod d))⁻¹ =
        (m : ZMod d)⁻¹ * (n i : ZMod d)⁻¹ := by
      rw [← hi.unit_spec, ← hm.unit_spec, ← Units.val_mul, ZMod.inv_coe_unit,
        mul_inv_rev, ZMod.inv_coe_unit, ZMod.inv_coe_unit]
      rfl
    dsimp [η, χ, r, reciprocalUnitPhase]
    rw [ite_eq_left (hi.mul hm), hinv]
    congr 1
    ring
  have hsum : (∑ i ∈ U, w i * η i * θ i) = ∑ i ∈ S, w i * η i * θ i := by
    apply Finset.sum_filter_of_ne
    intro i _ hi
    by_contra hn
    dsimp only [η, reciprocalUnitPhase] at hi
    simp [hn] at hi
  have hfiber (c : ZMod d) :
      (∑ i ∈ U.filter (fun i => r i = c), w i * η i * θ i) = χ c * F c := by
    dsimp only [F]
    rw [Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro i hi
    rcases Finset.mem_filter.mp hi with ⟨hi, hri⟩
    rw [hη i (Finset.mem_filter.mp hi).2, hri]
    ring
  have hwhole : (∑ i ∈ S, w i * η i * θ i) = ∑ c : ZMod d, χ c * F c := by
    rw [← hsum, ← Finset.sum_fiberwise U r (fun i => w i * η i * θ i)]
    exact Finset.sum_congr rfl (fun c _ => hfiber c)
  refine ⟨hwhole, ?_, ?_⟩
  · intro c
    simpa [χ] using congrArg norm (hfiber c)
  · rw [hwhole]
    simpa [χ] using (norm_sum_le Finset.univ (fun c : ZMod d => χ c * F c))

theorem sourceSecondaryPairPhase_integer_quotient
    (d m : ℕ) [NeZero m] (hdm : Nat.Coprime d m)
    (A B n₁ n₂ y₁ y₂ : ℤ)
    (hcong : Int.ModEq (d : ℤ) (y₁ * n₂) (y₂ * n₁)) :
    let J : ℤ :=
      (y₁ * (n₂ + B * (d : ℤ)) - y₂ * (n₁ + B * (d : ℤ))) / (d : ℤ)
    (d : ℤ) ∣ y₁ * (n₂ + B * (d : ℤ)) - y₂ * (n₁ + B * (d : ℤ)) ∧
    y₁ * (n₂ + B * (d : ℤ)) - y₂ * (n₁ + B * (d : ℤ)) = (d : ℤ) * J ∧
    reciprocalUnitPhase m
        ((A : ZMod m) * (y₁ : ZMod m))
        ((d : ZMod m) * ((n₁ : ZMod m) + (B : ZMod m) * (d : ZMod m))) *
      star (reciprocalUnitPhase m
        ((A : ZMod m) * (y₂ : ZMod m))
        ((d : ZMod m) * ((n₂ : ZMod m) + (B : ZMod m) * (d : ZMod m)))) =
      reciprocalUnitPhase m ((A : ZMod m) * (J : ZMod m))
        (((n₁ : ZMod m) + (B : ZMod m) * (d : ZMod m)) *
          ((n₂ : ZMod m) + (B : ZMod m) * (d : ZMod m))) := by
  intro J
  have hdvd : (d : ℤ) ∣
      y₁ * (n₂ + B * (d : ℤ)) - y₂ * (n₁ + B * (d : ℤ)) := by
    rw [show y₁ * (n₂ + B * (d : ℤ)) - y₂ * (n₁ + B * (d : ℤ)) =
      (y₁ * n₂ - y₂ * n₁) + (d : ℤ) * (B * (y₁ - y₂)) by ring]
    exact dvd_add hcong.symm.dvd (dvd_mul_right _ _)
  have hJ : y₁ * (n₂ + B * (d : ℤ)) - y₂ * (n₁ + B * (d : ℤ)) =
      (d : ℤ) * J := (Int.mul_ediv_cancel' hdvd).symm
  refine ⟨hdvd, hJ, ?_⟩
  let δ : ZMod m := d
  let a' : ZMod m := A
  let z₁ : ZMod m := (n₁ : ZMod m) + (B : ZMod m) * δ
  let z₂ : ZMod m := (n₂ : ZMod m) + (B : ZMod m) * δ
  change reciprocalUnitPhase m (a' * (y₁ : ZMod m)) (δ * z₁) *
      star (reciprocalUnitPhase m (a' * (y₂ : ZMod m)) (δ * z₂)) =
    reciprocalUnitPhase m (a' * (J : ZMod m)) (z₁ * z₂)
  have hδ : IsUnit δ := (ZMod.isUnit_iff_coprime d m).mpr hdm
  by_cases h₁ : IsUnit z₁
  · by_cases h₂ : IsUnit z₂
    · have hinv (x y : ZMod m) (hx : IsUnit x) (hy : IsUnit y) :
          (x * y)⁻¹ = y⁻¹ * x⁻¹ := by
        rw [← hx.unit_spec, ← hy.unit_spec, ← Units.val_mul, ZMod.inv_coe_unit,
          mul_inv_rev, ZMod.inv_coe_unit, ZMod.inv_coe_unit]
        rfl
      have hcross : (y₁ : ZMod m) * z₂ - (y₂ : ZMod m) * z₁ =
          δ * (J : ZMod m) := by
        simpa only [Int.cast_sub, Int.cast_mul, Int.cast_add, Int.cast_natCast,
          z₁, z₂, δ] using congrArg (fun t : ℤ => (t : ZMod m)) hJ
      have harg : a' * (y₁ : ZMod m) * (δ * z₁)⁻¹ -
          a' * (y₂ : ZMod m) * (δ * z₂)⁻¹ =
          a' * (J : ZMod m) * (z₁ * z₂)⁻¹ := by
        rw [hinv δ z₁ hδ h₁, hinv δ z₂ hδ h₂, hinv z₁ z₂ h₁ h₂]
        linear_combination
          a' * δ⁻¹ * z₁⁻¹ * z₂⁻¹ * hcross -
          a' * (y₁ : ZMod m) * δ⁻¹ * z₁⁻¹ * (ZMod.mul_inv_of_unit z₂ h₂) +
          a' * (y₂ : ZMod m) * δ⁻¹ * z₂⁻¹ * (ZMod.mul_inv_of_unit z₁ h₁) +
          a' * (J : ZMod m) * z₁⁻¹ * z₂⁻¹ * (ZMod.mul_inv_of_unit δ hδ)
      dsimp only [reciprocalUnitPhase]
      simp only [ite_eq_left (hδ.mul h₁), ite_eq_left (hδ.mul h₂),
        ite_eq_left (h₁.mul h₂)]
      rw [RCLike.star_def, ← AddChar.map_neg_eq_conj, ← AddChar.map_add_eq_mul,
        ← sub_eq_add_neg, harg]
    · dsimp only [reciprocalUnitPhase]
      simp [h₂]
  · dsimp only [reciprocalUnitPhase]
    simp [h₁]

open Classical in
theorem sourceSecondaryResidue_energy_eq_constrained_gram
    {ι : Type*} (S : Finset ι) (n y : ι → ℤ) (w : ι → ℂ)
    (d m : ℕ) [NeZero d] [NeZero m] (hdm : Nat.Coprime d m)
    (A B : ℤ) :
    let U : Finset ι := S.filter (fun i => IsUnit (n i : ZMod d))
    let r : ι → ZMod d := fun i => (y i : ZMod d) * (n i : ZMod d)⁻¹
    let θ : ι → ℂ := fun i =>
      reciprocalUnitPhase m
        ((A : ZMod m) * (y i : ZMod m))
        ((d : ZMod m) * ((n i : ZMod m) + (B : ZMod m) * (d : ZMod m)))
    let F : ZMod d → ℂ := fun c =>
      ∑ i ∈ U.filter (fun i => r i = c), w i * θ i
    let J : ι → ι → ℤ := fun i j =>
      (y i * (n j + B * (d : ℤ)) - y j * (n i + B * (d : ℤ))) / (d : ℤ)
    ((∑ c : ZMod d, ‖F c‖ ^ 2 : ℝ) : ℂ) =
      ∑ i ∈ U,
        ∑ j ∈ U.filter (fun j => Int.ModEq (d : ℤ) (y i * n j) (y j * n i)),
          w i * star (w j) *
            reciprocalUnitPhase m ((A : ZMod m) * (J i j : ZMod m))
              (((n i : ZMod m) + (B : ZMod m) * (d : ZMod m)) *
                ((n j : ZMod m) + (B : ZMod m) * (d : ZMod m))) := by
  intro U r θ F J
  have hratio (i : ι) (hi : i ∈ U) (j : ι) (hj : j ∈ U) :
      r j = r i ↔ Int.ModEq (d : ℤ) (y i * n j) (y j * n i) := by
    obtain ⟨u, hu⟩ := (Finset.mem_filter.mp hi).2
    obtain ⟨v, hv⟩ := (Finset.mem_filter.mp hj).2
    calc
      r j = r i ↔ (y i : ZMod d) * (n j : ZMod d) =
          (y j : ZMod d) * (n i : ZMod d) := by
        dsimp only [r]
        rw [eq_comm, ← hu, ← hv, ZMod.inv_coe_unit, ZMod.inv_coe_unit]
        exact Units.mul_inv_eq_mul_inv_iff _ _ u v
      _ ↔ Int.ModEq (d : ℤ) (y i * n j) (y j * n i) := by
        simpa only [Int.cast_mul] using
          (ZMod.intCast_eq_intCast_iff (y i * n j) (y j * n i) d)
  have hgram : ((∑ c : ZMod d, ‖F c‖ ^ 2 : ℝ) : ℂ) =
      ∑ i ∈ U, ∑ j ∈ U.filter (fun j => r j = r i),
        (w i * θ i) * star (w j * θ j) := by
    calc
      _ = ∑ c : ZMod d, F c * star (F c) := by
        simp only [Complex.ofReal_sum, Complex.ofReal_pow, Complex.star_def, Complex.mul_conj']
      _ = ∑ c : ZMod d, ∑ i ∈ U.filter (fun i => r i = c),
          (w i * θ i) * star (F (r i)) := by
        apply Finset.sum_congr rfl
        intro c _
        change (∑ i ∈ U.filter (fun i => r i = c), w i * θ i) * star (F c) = _
        rw [Finset.sum_mul]
        apply Finset.sum_congr rfl
        intro i hi
        rw [(Finset.mem_filter.mp hi).2]
      _ = ∑ i ∈ U, (w i * θ i) * star (F (r i)) :=
        Finset.sum_fiberwise U r (fun i => (w i * θ i) * star (F (r i)))
      _ = _ := by simp only [F, star_sum, Finset.mul_sum]
  rw [hgram]
  apply Finset.sum_congr rfl
  intro i hi
  rw [Finset.filter_congr (fun j hj => hratio i hi j hj)]
  apply Finset.sum_congr rfl
  intro j hj
  calc
    _ = (w i * star (w j)) * (θ i * star (θ j)) := by rw [star_mul]; ring
    _ = _ := by
      rw [(sourceSecondaryPairPhase_integer_quotient d m hdm A B
        (n i) (n j) (y i) (y j) (Finset.mem_filter.mp hj).2).2.2]

open Classical in
theorem sourceSecondaryResidue_weighted_cauchy
    {ι : Type*} (D : Finset ℕ+) (m : ℕ) [NeZero m]
    (hdm : ∀ d ∈ D, Nat.Coprime (d : ℕ) m)
    (S : ℕ+ → Finset ι) (n y : ι → ℤ) (w : ℕ+ → ι → ℂ)
    (ρ : ℕ+ → ℝ) (hρ : ∀ d ∈ D, 0 ≤ ρ d) (a A B : ℤ) :
    let η : ℕ+ → ι → ℂ := fun d i =>
      reciprocalUnitPhase (d : ℕ)
        ((a : ZMod (d : ℕ)) * (y i : ZMod (d : ℕ)))
        ((n i : ZMod (d : ℕ)) * (m : ZMod (d : ℕ)))
    let θ : ℕ+ → ι → ℂ := fun d i =>
      reciprocalUnitPhase m
        ((A : ZMod m) * (y i : ZMod m))
        (((d : ℕ) : ZMod m) *
          ((n i : ZMod m) + (B : ZMod m) * ((d : ℕ) : ZMod m)))
    let U : ℕ+ → Finset ι := fun d =>
      (S d).filter (fun i => IsUnit (n i : ZMod (d : ℕ)))
    let J : ℕ+ → ι → ι → ℤ := fun d i j =>
      (y i * (n j + B * ((d : ℕ) : ℤ)) -
        y j * (n i + B * ((d : ℕ) : ℤ))) / ((d : ℕ) : ℤ)
    let G : ℕ+ → ℂ := fun d =>
      ∑ i ∈ U d,
        ∑ j ∈ (U d).filter
            (fun j => Int.ModEq ((d : ℕ) : ℤ) (y i * n j) (y j * n i)),
          w d i * star (w d j) *
            reciprocalUnitPhase m
              ((A : ZMod m) * (J d i j : ZMod m))
              (((n i : ZMod m) + (B : ZMod m) * ((d : ℕ) : ZMod m)) *
                ((n j : ZMod m) + (B : ZMod m) * ((d : ℕ) : ZMod m)))
    (∑ d ∈ D, ρ d * ‖∑ i ∈ S d, w d i * η d i * θ d i‖) ^ 2 ≤
      (∑ d ∈ D, ρ d * ((d : ℕ) : ℝ)) * (∑ d ∈ D, ρ d * (G d).re) := by
  intro η θ U J G
  let F (d : ℕ+) (c : ZMod (d : ℕ)) : ℂ :=
    ∑ i ∈ (U d).filter (fun i =>
      (y i : ZMod (d : ℕ)) * (n i : ZMod (d : ℕ))⁻¹ = c), w d i * θ d i
  let E (d : ℕ+) : ℝ := ∑ c : ZMod (d : ℕ), ‖F d c‖ ^ 2
  have hG (d : ℕ+) (hd : d ∈ D) : (G d).re = E d :=
    (congrArg Complex.re (sourceSecondaryResidue_energy_eq_constrained_gram
      (S d) n y (w d) (d : ℕ) m (hdm d hd) A B)).symm
  have hpoint (d : ℕ+) (hd : d ∈ D) :
      ‖∑ i ∈ S d, w d i * η d i * θ d i‖ ^ 2 ≤ ((d : ℕ) : ℝ) * E d := by
    calc
      _ ≤ (∑ c : ZMod (d : ℕ), ‖F d c‖) ^ 2 :=
        pow_le_pow_left₀ (norm_nonneg _) (sourceSecondaryResidue_fiber_grouping
          (S d) n y (w d) (d : ℕ) m (hdm d hd) a A B).2.2 2
      _ ≤ ((d : ℕ) : ℝ) * E d := by
        simpa [E] using
          (Finset.sum_mul_sq_le_sq_mul_sq (Finset.univ : Finset (ZMod (d : ℕ)))
            (fun _ => (1 : ℝ)) (fun c => ‖F d c‖))
  apply Finset.sum_sq_le_sum_mul_sum_of_sq_le_mul D
  · intro d hd
    exact mul_nonneg (hρ d hd) (Nat.cast_nonneg _)
  · intro d hd
    rw [hG d hd]
    exact mul_nonneg (hρ d hd) (Finset.sum_nonneg (fun _ _ => sq_nonneg _))
  · intro d hd
    calc
      (ρ d * ‖∑ i ∈ S d, w d i * η d i * θ d i‖) ^ 2 =
          (ρ d) ^ 2 * ‖∑ i ∈ S d, w d i * η d i * θ d i‖ ^ 2 := mul_pow _ _ 2
      _ ≤ (ρ d) ^ 2 * (((d : ℕ) : ℝ) * E d) :=
        mul_le_mul_of_nonneg_left (hpoint d hd) (sq_nonneg _)
      _ = (ρ d * ((d : ℕ) : ℝ)) * (ρ d * (G d).re) := by rw [hG d hd]; ring

theorem sourceSecondaryGcd_quotient_unit_iff
    (w₁ q : ℕ) (hwq : Nat.Coprime w₁ q)
    (y : ℤ) :
    Int.gcd y ((w₁ * q : ℕ) : ℤ) = w₁ ↔
      (w₁ : ℤ) ∣ y ∧ IsUnit (y : ZMod q) := by
  simp only [ZMod.coe_int_isUnit_iff_isCoprime, Int.isCoprime_iff_gcd_eq_one,
    Int.gcd_eq_natAbs_gcd_natAbs, Int.natAbs_natCast, Int.natCast_dvd]
  constructor
  · intro h
    refine ⟨?_, ?_⟩
    · simpa only [h] using Nat.gcd_dvd_left y.natAbs (w₁ * q)
    · have hg := congrArg (fun t => Nat.gcd t q) h
      rw [Nat.gcd_assoc, Nat.gcd_mul_left_left, hwq.gcd_eq_one] at hg
      exact (Nat.gcd_comm q y.natAbs).trans hg
  · rintro ⟨hy, hq⟩
    rw [Nat.Coprime.gcd_mul_right_cancel_right w₁ hq, Nat.gcd_eq_right hy]

theorem sourceSecondaryQuotientRatio_cross_congruence
    (w₁ q : ℕ) (hwq : Nat.Coprime w₁ q)
    (y₁ y₂ n₁ n₂ : ℤ)
    (hy₁ : Int.gcd y₁ ((w₁ * q : ℕ) : ℤ) = w₁)
    (hy₂ : Int.gcd y₂ ((w₁ * q : ℕ) : ℤ) = w₁) :
    (n₁ : ZMod q) * (y₁ : ZMod q)⁻¹ =
        (n₂ : ZMod q) * (y₂ : ZMod q)⁻¹ ↔
      Int.ModEq ((w₁ * q : ℕ) : ℤ) (y₁ * n₂) (y₂ * n₁) := by
  obtain ⟨hwy₁, huy₁⟩ := (sourceSecondaryGcd_quotient_unit_iff w₁ q hwq y₁).mp hy₁
  obtain ⟨hwy₂, huy₂⟩ := (sourceSecondaryGcd_quotient_unit_iff w₁ q hwq y₂).mp hy₂
  have hw : Int.ModEq (w₁ : ℤ) (y₁ * n₂) (y₂ * n₁) :=
    Int.modEq_iff_dvd.mpr
      (dvd_sub (dvd_mul_of_dvd_left hwy₂ n₁) (dvd_mul_of_dvd_left hwy₁ n₂))
  calc
    (n₁ : ZMod q) * (y₁ : ZMod q)⁻¹ = (n₂ : ZMod q) * (y₂ : ZMod q)⁻¹ ↔
        (y₁ : ZMod q) * (n₂ : ZMod q) = (y₂ : ZMod q) * (n₁ : ZMod q) := by
      obtain ⟨u₁, hu₁⟩ := huy₁
      obtain ⟨u₂, hu₂⟩ := huy₂
      rw [← hu₁, ← hu₂, ZMod.inv_coe_unit, ZMod.inv_coe_unit,
        Units.mul_inv_eq_mul_inv_iff]
      constructor <;> intro h <;> simpa only [mul_comm] using h.symm
    _ ↔ Int.ModEq (q : ℤ) (y₁ * n₂) (y₂ * n₁) := by
      simpa only [Int.cast_mul] using
        (ZMod.intCast_eq_intCast_iff (y₁ * n₂) (y₂ * n₁) q)
    _ ↔ Int.ModEq ((w₁ * q : ℕ) : ℤ) (y₁ * n₂) (y₂ * n₁) := by
      have hcrt := Int.modEq_and_modEq_iff_modEq_mul
        (a := y₁ * n₂) (b := y₂ * n₁) (m := (w₁ : ℤ)) (n := (q : ℤ))
        (by simpa only [Int.natAbs_natCast] using hwq)
      simpa only [hw, true_and, Int.natCast_mul] using hcrt

open Classical in
theorem sourceSecondaryQuotientRatio_unit_relaxation
    {ι : Type*} (S : Finset ι) (n y : ι → ℤ) (weight : ι → ℂ)
    (w₁ q : ℕ) [NeZero w₁] [NeZero q] (hwq : Nat.Coprime w₁ q)
    (hy : ∀ i ∈ S, Int.gcd (y i) ((w₁ * q : ℕ) : ℤ) = w₁) :
    let U : Finset ι := S.filter (fun i => IsUnit (n i : ZMod (w₁ * q)))
    let V : Finset ι := S.filter (fun i => IsUnit (n i : ZMod w₁))
    let r₀ : ι → ZMod (w₁ * q) := fun i =>
      (y i : ZMod (w₁ * q)) * (n i : ZMod (w₁ * q))⁻¹
    let r₁ : ι → ZMod q := fun i => (n i : ZMod q) * (y i : ZMod q)⁻¹
    let F : ZMod (w₁ * q) → ℂ := fun c =>
      ∑ i ∈ U.filter (fun i => r₀ i = c), weight i
    let G : ZMod q → ℂ := fun c =>
      ∑ i ∈ V.filter (fun i => r₁ i = c), weight i
    let C : Finset (ZMod q) := Finset.univ.filter (fun c => ¬IsUnit c)
    (∑ c : ZMod q, ‖G c‖) =
        (∑ c : ZMod (w₁ * q), ‖F c‖) + (∑ c ∈ C, ‖G c‖) ∧
    (∑ c : ZMod q, ‖G c‖ ^ 2) =
        (∑ c : ZMod (w₁ * q), ‖F c‖ ^ 2) + (∑ c ∈ C, ‖G c‖ ^ 2) ∧
    (∑ c : ZMod (w₁ * q), ‖F c‖) ≤ (∑ c : ZMod q, ‖G c‖) ∧
    (∑ c : ZMod (w₁ * q), ‖F c‖ ^ 2) ≤ (∑ c : ZMod q, ‖G c‖ ^ 2) := by
  intro U V r₀ r₁ F G C
  let e := ZMod.chineseRemainder hwq
  let πw : ZMod (w₁ * q) →+* ZMod w₁ :=
    (RingHom.fst (ZMod w₁) (ZMod q)).comp e.toRingHom
  let πq : ZMod (w₁ * q) →+* ZMod q :=
    (RingHom.snd (ZMod w₁) (ZMod q)).comp e.toRingHom
  let T : Finset (ZMod q) := Finset.univ.filter IsUnit
  let γ : ZMod q → ZMod (w₁ * q) := fun c => e.symm (0, c⁻¹)
  have hunit (z : ℤ) : IsUnit (z : ZMod (w₁ * q)) ↔
      IsUnit (z : ZMod w₁) ∧ IsUnit (z : ZMod q) := by
    simp only [ZMod.coe_int_isUnit_iff_isCoprime, Int.natCast_mul,
      IsCoprime.mul_left_iff]
  have hmapinv {a b : ℕ} (f : ZMod a →+* ZMod b) (z : ZMod a)
      (hz : IsUnit z) : f z⁻¹ = (f z)⁻¹ := by
    symm
    apply ZMod.inv_eq_of_mul_eq_one
    rw [← map_mul, ZMod.mul_inv_of_unit z hz, map_one]
  have hydata (i : ι) (hi : i ∈ S) :
      (w₁ : ℤ) ∣ y i ∧ IsUnit (y i : ZMod q) :=
    (sourceSecondaryGcd_quotient_unit_iff w₁ q hwq (y i)).mp (hy i hi)
  have hU (i : ι) (hi : i ∈ S) : i ∈ U ↔ i ∈ V ∧ IsUnit (r₁ i) := by
    have hyinv := ZMod.isUnit_inv (hydata i hi).2
    simp only [U, V, Finset.mem_filter, hi, true_and, hunit, r₁,
      IsUnit.mul_iff, hyinv, and_true]
  have hγinj {c d : ZMod q} (hc : IsUnit c) (hd : IsUnit d)
      (h : γ c = γ d) : c = d := by
    have h' : c⁻¹ = d⁻¹ := by
      have h' := congrArg (fun z : ZMod (w₁ * q) => (e z).2) h
      simpa only [γ, RingEquiv.apply_symm_apply] using h'
    rcases hc with ⟨u, rfl⟩
    rcases hd with ⟨v, rfl⟩
    simpa only [ZMod.inv_coe_unit, Units.val_inv_inj] using h'
  have hr₀ (i : ι) (hi : i ∈ U) : r₀ i = γ (r₁ i) := by
    have hSi := (Finset.mem_filter.mp hi).1
    have hni := (Finset.mem_filter.mp hi).2
    have hniq := (hunit (n i)).mp hni |>.2
    have hyi := hydata i hSi
    have hyzero : (y i : ZMod w₁) = 0 :=
      (ZMod.intCast_zmod_eq_zero_iff_dvd (y i) w₁).mpr hyi.1
    apply e.injective
    change e (r₀ i) = e (e.symm (0, (r₁ i)⁻¹))
    rw [e.apply_symm_apply]
    apply Prod.ext
    · change πw (r₀ i) = 0
      simp only [r₀, map_mul, map_intCast, hyzero, zero_mul]
    · change πq (r₀ i) = (r₁ i)⁻¹
      rw [show πq (r₀ i) = (y i : ZMod q) * (n i : ZMod q)⁻¹ by
        simp only [r₀, map_mul, hmapinv πq (n i : ZMod (w₁ * q)) hni,
          map_intCast]]
      symm
      apply ZMod.inv_eq_of_mul_eq_one
      change ((n i : ZMod q) * (y i : ZMod q)⁻¹) *
        ((y i : ZMod q) * (n i : ZMod q)⁻¹) = 1
      calc
        _ = ((n i : ZMod q) * (n i : ZMod q)⁻¹) *
            ((y i : ZMod q)⁻¹ * (y i : ZMod q)) := by ring
        _ = 1 := by
          rw [ZMod.mul_inv_of_unit _ hniq, ZMod.inv_mul_of_unit _ hyi.2, one_mul]
  have hFG (c : ZMod q) (hc : IsUnit c) : F (γ c) = G c := by
    change (∑ i ∈ U.filter (fun i => r₀ i = γ c), weight i) =
      ∑ i ∈ V.filter (fun i => r₁ i = c), weight i
    apply congrArg (fun s : Finset ι => ∑ i ∈ s, weight i)
    ext i
    constructor
    · intro hi
      obtain ⟨hiU, hir⟩ := Finset.mem_filter.mp hi
      obtain ⟨hiV, hirunit⟩ := (hU i (Finset.mem_filter.mp hiU).1).mp hiU
      exact Finset.mem_filter.mpr
        ⟨hiV, hγinj hirunit hc ((hr₀ i hiU).symm.trans hir)⟩
    · intro hi
      obtain ⟨hiV, hir⟩ := Finset.mem_filter.mp hi
      have hiU : i ∈ U := (hU i (Finset.mem_filter.mp hiV).1).mpr
        ⟨hiV, hir.symm ▸ hc⟩
      exact Finset.mem_filter.mpr ⟨hiU, (hr₀ i hiU).trans (congrArg γ hir)⟩
  have hFzero (z : ZMod (w₁ * q)) (hz : z ∉ T.image γ) : F z = 0 := by
    apply Finset.sum_eq_zero
    intro i hi
    obtain ⟨hiU, hir⟩ := Finset.mem_filter.mp hi
    have hirunit := ((hU i (Finset.mem_filter.mp hiU).1).mp hiU).2
    exact (hz (Finset.mem_image.mpr
      ⟨r₁ i, Finset.mem_filter.mpr ⟨Finset.mem_univ _, hirunit⟩,
        (hr₀ i hiU).symm.trans hir⟩)).elim
  have hblocks (Φ : ℂ → ℝ) (hΦ : Φ 0 = 0) :
      (∑ c : ZMod q, Φ (G c)) =
        (∑ z : ZMod (w₁ * q), Φ (F z)) + ∑ c ∈ C, Φ (G c) := by
    calc
      _ = (∑ c ∈ T, Φ (G c)) + ∑ c ∈ C, Φ (G c) :=
        (Finset.sum_filter_add_sum_filter_not Finset.univ IsUnit
          (fun c : ZMod q => Φ (G c))).symm
      _ = _ := by
        apply congrArg (fun x : ℝ => x + ∑ c ∈ C, Φ (G c))
        refine Finset.sum_of_injOn γ ?_ (fun _ _ => Finset.mem_univ _) ?_ ?_
        · intro c hc d hd h
          exact hγinj (Finset.mem_filter.mp hc).2 (Finset.mem_filter.mp hd).2 h
        · intro z _ hz
          rw [hFzero z (by
            simpa only [← Finset.coe_image, Finset.mem_coe] using hz), hΦ]
        · intro c hc
          rw [hFG c (Finset.mem_filter.mp hc).2]
  have hnorm := hblocks (fun z => ‖z‖) (norm_zero : ‖(0 : ℂ)‖ = 0)
  have hsquare := hblocks (fun z => ‖z‖ ^ 2) (by simp)
  refine ⟨hnorm, hsquare, ?_, ?_⟩
  · rw [hnorm]
    exact le_add_of_nonneg_right (Finset.sum_nonneg fun c _ => norm_nonneg (G c))
  · rw [hsquare]
    exact le_add_of_nonneg_right (Finset.sum_nonneg fun c _ => sq_nonneg ‖G c‖)

open Classical in
theorem sourceSecondaryQuotientRatio_relaxed_gram
    {ι : Type*} (S : Finset ι) (n y : ι → ℤ) (weight : ι → ℂ)
    (w₁ q m : ℕ) [NeZero w₁] [NeZero q] [NeZero m]
    (hwq : Nat.Coprime w₁ q) (hdm : Nat.Coprime (w₁ * q) m)
    (hy : ∀ i ∈ S, Int.gcd (y i) ((w₁ * q : ℕ) : ℤ) = w₁)
    (A B : ℤ) :
    let V : Finset ι := S.filter (fun i => IsUnit (n i : ZMod w₁))
    let r : ι → ZMod q := fun i => (n i : ZMod q) * (y i : ZMod q)⁻¹
    let θ : ι → ℂ := fun i =>
      reciprocalUnitPhase m
        ((A : ZMod m) * (y i : ZMod m))
        (((w₁ * q : ℕ) : ZMod m) *
          ((n i : ZMod m) + (B : ZMod m) * ((w₁ * q : ℕ) : ZMod m)))
    let F : ZMod q → ℂ := fun c =>
      ∑ i ∈ V.filter (fun i => r i = c), weight i * θ i
    let J : ι → ι → ℤ := fun i j =>
      (y i * (n j + B * ((w₁ * q : ℕ) : ℤ)) -
        y j * (n i + B * ((w₁ * q : ℕ) : ℤ))) / ((w₁ * q : ℕ) : ℤ)
    let G : ℂ :=
      ∑ i ∈ V,
        ∑ j ∈ V.filter (fun j =>
            Int.ModEq ((w₁ * q : ℕ) : ℤ) (y i * n j) (y j * n i)),
          weight i * star (weight j) *
            reciprocalUnitPhase m ((A : ZMod m) * (J i j : ZMod m))
              (((n i : ZMod m) + (B : ZMod m) * ((w₁ * q : ℕ) : ZMod m)) *
                ((n j : ZMod m) + (B : ZMod m) * ((w₁ * q : ℕ) : ZMod m)))
    ((∑ c : ZMod q, ‖F c‖ ^ 2 : ℝ) : ℂ) = G ∧ 0 ≤ G.re := by
  intro V r θ F J G
  have hgram : ((∑ c : ZMod q, ‖F c‖ ^ 2 : ℝ) : ℂ) =
      ∑ i ∈ V, ∑ j ∈ V.filter (fun j => r j = r i),
        (weight i * θ i) * star (weight j * θ j) := by
    calc
      _ = ∑ c : ZMod q, F c * star (F c) := by
        simp only [Complex.ofReal_sum, Complex.ofReal_pow, Complex.star_def,
          Complex.mul_conj']
      _ = ∑ c : ZMod q, ∑ i ∈ V.filter (fun i => r i = c),
          (weight i * θ i) * star (F (r i)) := by
        apply Finset.sum_congr rfl
        intro c _
        change (∑ i ∈ V.filter (fun i => r i = c), weight i * θ i) * star (F c) = _
        rw [Finset.sum_mul]
        apply Finset.sum_congr rfl
        intro i hi
        rw [(Finset.mem_filter.mp hi).2]
      _ = ∑ i ∈ V, (weight i * θ i) * star (F (r i)) :=
        Finset.sum_fiberwise V r (fun i => (weight i * θ i) * star (F (r i)))
      _ = _ := by
        apply Finset.sum_congr rfl
        intro i _
        dsimp only [F]
        rw [star_sum, Finset.mul_sum]
  have hG : ((∑ c : ZMod q, ‖F c‖ ^ 2 : ℝ) : ℂ) = G := by
    rw [hgram]
    dsimp only [G]
    apply Finset.sum_congr rfl
    intro i hi
    have hfilter : V.filter (fun j => r j = r i) =
        V.filter (fun j => Int.ModEq ((w₁ * q : ℕ) : ℤ) (y i * n j) (y j * n i)) :=
      Finset.filter_congr (fun j hj => by
        change (n j : ZMod q) * (y j : ZMod q)⁻¹ =
          (n i : ZMod q) * (y i : ZMod q)⁻¹ ↔ _
        rw [eq_comm]
        exact sourceSecondaryQuotientRatio_cross_congruence w₁ q hwq
          (y i) (y j) (n i) (n j)
          (hy i (Finset.mem_filter.mp hi).1) (hy j (Finset.mem_filter.mp hj).1))
    rw [hfilter]
    apply Finset.sum_congr rfl
    intro j hj
    have hphase := (sourceSecondaryPairPhase_integer_quotient (w₁ * q) m hdm A B
      (n i) (n j) (y i) (y j) (Finset.mem_filter.mp hj).2).2.2
    change θ i * star (θ j) =
      reciprocalUnitPhase m ((A : ZMod m) * (J i j : ZMod m))
        (((n i : ZMod m) + (B : ZMod m) * ((w₁ * q : ℕ) : ZMod m)) *
          ((n j : ZMod m) + (B : ZMod m) * ((w₁ * q : ℕ) : ZMod m))) at hphase
    calc
      _ = (weight i * star (weight j)) * (θ i * star (θ j)) := by
        rw [star_mul]
        ring
      _ = _ := by rw [hphase]
  refine ⟨hG, ?_⟩
  rw [← hG, Complex.ofReal_re]
  exact Finset.sum_nonneg fun _ _ => sq_nonneg _

theorem sourceTerminalDictionary_arithmetic
    (w z d m : ℕ) [NeZero w] (hwz : w ∣ z)
    (lam lamTilde n nt : ℤ) :
    let s : ℕ := z / w
    w * s = z ∧ (z * d) / w = s * d ∧
    ((m : ℤ) * ((w : ℤ) * lam) * ((w : ℤ) * lamTilde)) / (w : ℤ) ^ 2 =
      (m : ℤ) * lam * lamTilde ∧
    (Int.gcd (((z * d) / w : ℕ) : ℤ)
        (((m : ℤ) * ((w : ℤ) * lam) * ((w : ℤ) * lamTilde)) / (w : ℤ) ^ 2) = 1 ↔
      Int.gcd (s : ℤ) ((m : ℤ) * lam * lamTilde) = 1 ∧
        Int.gcd (d : ℤ) ((m : ℤ) * lam * lamTilde) = 1) ∧
    (Int.ModEq ((z * d : ℕ) : ℤ) (((w : ℤ) * lam) * nt)
        (((w : ℤ) * lamTilde) * n) ↔
      Int.ModEq ((s * d : ℕ) : ℤ) (lam * nt) (lamTilde * n)) := by
  dsimp only
  have hw : (w : ℤ) ≠ 0 := by exact_mod_cast (NeZero.ne w)
  have hs : w * (z / w) = z := Nat.mul_div_cancel' hwz
  have hd : (z * d) / w = (z / w) * d := by
    simpa only [Nat.mul_comm] using Nat.mul_div_assoc d hwz
  have hq : ((m : ℤ) * ((w : ℤ) * lam) * ((w : ℤ) * lamTilde)) /
      (w : ℤ) ^ 2 = (m : ℤ) * lam * lamTilde :=
    Int.ediv_eq_of_eq_mul_right (pow_ne_zero 2 hw) (by ring)
  refine ⟨hs, hd, hq, ?_, ?_⟩
  · simp only [hd, hq, Nat.cast_mul, ← Int.isCoprime_iff_gcd_eq_one,
      IsCoprime.mul_left_iff]
  · have hmod : ((z * d : ℕ) : ℤ) =
        (w : ℤ) * (((z / w) * d : ℕ) : ℤ) := by
      exact_mod_cast (show z * d = w * ((z / w) * d) by rw [← Nat.mul_assoc, hs])
    rw [hmod]
    simpa only [mul_assoc] using
      (Int.ModEq.mul_left_cancel_iff' (a := lam * nt) (b := lamTilde * n)
        (m := (((z / w) * d : ℕ) : ℤ)) hw)

theorem sourceTerminalDictionary_quotient_phase
    (w z d m : ℕ) [NeZero w] [NeZero z] [NeZero d] [NeZero m]
    (hwz : w ∣ z) (hzm : Nat.Coprime z m)
    (Ao Bo An Bn lam lamTilde n nt : ℤ)
    (hA : (An : ZMod m) =
      (Ao : ZMod m) * (w : ZMod m) * (z : ZMod m)⁻¹)
    (hB : Int.ModEq (m : ℤ) Bn (Bo * (z : ℤ)))
    (hcong : Int.ModEq ((z * d : ℕ) : ℤ)
      (((w : ℤ) * lam) * nt) (((w : ℤ) * lamTilde) * n)) :
    let s : ℕ := z / w
    let Jo : ℤ :=
      (((w : ℤ) * lam) * (nt + Bo * ((z * d : ℕ) : ℤ)) -
        ((w : ℤ) * lamTilde) * (n + Bo * ((z * d : ℕ) : ℤ))) /
          ((z * d : ℕ) : ℤ)
    let Jn : ℤ :=
      (lam * (nt + Bn * (d : ℤ)) - lamTilde * (n + Bn * (d : ℤ))) / (d : ℤ)
    ((z * d : ℕ) : ℤ) ∣
        ((w : ℤ) * lam) * (nt + Bo * ((z * d : ℕ) : ℤ)) -
          ((w : ℤ) * lamTilde) * (n + Bo * ((z * d : ℕ) : ℤ)) ∧
    (d : ℤ) ∣ lam * (nt + Bn * (d : ℤ)) - lamTilde * (n + Bn * (d : ℤ)) ∧
    Jn = (s : ℤ) * Jo + (lam - lamTilde) * (Bn - Bo * (z : ℤ)) ∧
    Int.ModEq (m : ℤ) Jn ((s : ℤ) * Jo) ∧
    Int.gcd Jn (m : ℤ) = Int.gcd Jo (m : ℤ) ∧
    (((n + Bo * ((z * d : ℕ) : ℤ) : ℤ) : ZMod m) *
        ((nt + Bo * ((z * d : ℕ) : ℤ) : ℤ) : ZMod m)) =
      (((n + Bn * (d : ℤ) : ℤ) : ZMod m) *
        ((nt + Bn * (d : ℤ) : ℤ) : ZMod m)) ∧
    reciprocalUnitPhase m ((Ao : ZMod m) * (Jo : ZMod m))
        (((n + Bo * ((z * d : ℕ) : ℤ) : ℤ) : ZMod m) *
          ((nt + Bo * ((z * d : ℕ) : ℤ) : ℤ) : ZMod m)) =
      reciprocalUnitPhase m ((An : ZMod m) * (Jn : ZMod m))
        (((n + Bn * (d : ℤ) : ℤ) : ZMod m) *
          ((nt + Bn * (d : ℤ) : ℤ) : ZMod m)) := by
  intro s Jo Jn
  have hws : w * s = z := Nat.mul_div_cancel' hwz
  have hzI : (z : ℤ) = (w : ℤ) * (s : ℤ) := by exact_mod_cast hws.symm
  have hscong : Int.ModEq ((s * d : ℕ) : ℤ) (lam * nt) (lamTilde * n) :=
    (sourceTerminalDictionary_arithmetic w z d m hwz lam lamTilde n nt).2.2.2.2.mp hcong
  obtain ⟨k, hk⟩ := Int.modEq_iff_dvd.mp hscong.symm
  rw [Nat.cast_mul] at hk
  have hJoNum :
      ((w : ℤ) * lam) * (nt + Bo * ((z * d : ℕ) : ℤ)) -
          ((w : ℤ) * lamTilde) * (n + Bo * ((z * d : ℕ) : ℤ)) =
        ((z * d : ℕ) : ℤ) * (k + (w : ℤ) * (lam - lamTilde) * Bo) := by
    simp only [Nat.cast_mul, hzI]
    linear_combination (w : ℤ) * hk
  have hJnNum : lam * (nt + Bn * (d : ℤ)) - lamTilde * (n + Bn * (d : ℤ)) =
      (d : ℤ) * ((s : ℤ) * k + (lam - lamTilde) * Bn) := by
    linear_combination hk
  have hJo : Jo = k + (w : ℤ) * (lam - lamTilde) * Bo :=
    Int.ediv_eq_of_eq_mul_right (NeZero.ne ((z * d : ℕ) : ℤ)) hJoNum
  have hJn : Jn = (s : ℤ) * k + (lam - lamTilde) * Bn :=
    Int.ediv_eq_of_eq_mul_right (NeZero.ne (d : ℤ)) hJnNum
  have hcorr : Jn = (s : ℤ) * Jo + (lam - lamTilde) * (Bn - Bo * (z : ℤ)) := by
    rw [hJo, hJn, hzI]
    ring
  have hmod : Int.ModEq (m : ℤ) Jn ((s : ℤ) * Jo) := by
    rw [hcorr]
    simpa only [sub_self, mul_zero, add_zero] using
      (((hB.sub_right (Bo * (z : ℤ))).mul_left (lam - lamTilde)).add_left
        ((s : ℤ) * Jo))
  have hsG : Int.gcd (s : ℤ) (m : ℤ) = 1 := by
    simpa only [Int.gcd_natCast_natCast] using (hzm.coprime_div_left hwz).gcd_eq_one
  have hgcd : Int.gcd Jn (m : ℤ) = Int.gcd Jo (m : ℤ) := by
    simpa only [Int.gcd_emod, Int.gcd_mul_right_left_of_gcd_eq_one hsG] using
      congrArg (fun a : ℤ => Int.gcd a (m : ℤ)) hmod.eq
  have hBc : (Bn : ZMod m) = (Bo : ZMod m) * (z : ZMod m) := by
    simpa only [Int.cast_mul, Int.cast_natCast] using
      (ZMod.intCast_eq_intCast_iff Bn (Bo * (z : ℤ)) m).mpr hB
  have hden :
      (((n + Bo * ((z * d : ℕ) : ℤ) : ℤ) : ZMod m) *
          ((nt + Bo * ((z * d : ℕ) : ℤ) : ℤ) : ZMod m)) =
        (((n + Bn * (d : ℤ) : ℤ) : ZMod m) *
          ((nt + Bn * (d : ℤ) : ℤ) : ZMod m)) := by
    simp only [Int.cast_add, Int.cast_mul, Int.cast_natCast, Nat.cast_mul, hBc, mul_assoc]
  have hJc : (Jn : ZMod m) = (s : ZMod m) * (Jo : ZMod m) := by
    simpa only [Int.cast_mul, Int.cast_natCast] using
      (ZMod.intCast_eq_intCast_iff Jn ((s : ℤ) * Jo) m).mpr hmod
  have hsz : (w : ZMod m) * (s : ZMod m) = (z : ZMod m) := by
    simpa only [Nat.cast_mul] using congrArg (fun a : ℕ => (a : ZMod m)) hws
  have hAS : (An : ZMod m) * (s : ZMod m) = (Ao : ZMod m) := by
    rw [hA, mul_right_comm _ _ (s : ZMod m),
      mul_assoc (Ao : ZMod m) (w : ZMod m), hsz, mul_assoc,
      ZMod.mul_inv_of_unit _ ((ZMod.isUnit_iff_coprime z m).mpr hzm), mul_one]
  have hcoeff : (Ao : ZMod m) * (Jo : ZMod m) = (An : ZMod m) * (Jn : ZMod m) := by
    rw [hJc, ← mul_assoc, hAS]
  exact ⟨⟨_, hJoNum⟩, ⟨_, hJnNum⟩, hcorr, hmod, hgcd, hden,
    congrArg₂ (reciprocalUnitPhase m) hcoeff hden⟩

theorem sourceTerminalDictionary_finite_kernel
    (w z m : ℕ) [NeZero w] [NeZero z] [NeZero m]
    (hwz : w ∣ z) (hzm : Nat.Coprime z m)
    (r₁ q₀ u₁ v₁ v₂ q₂ : ℕ) (ℓ Ao Bo An Bn lam lamTilde d₀ : ℤ)
    (hA : (An : ZMod m) =
      (Ao : ZMod m) * (w : ZMod m) * (z : ZMod m)⁻¹)
    (hB : Int.ModEq (m : ℤ) Bn (Bo * (z : ℤ)))
    (D : Finset ℕ) (P : Finset (ℤ × ℤ)) (T : ℝ)
    (ψD ψN : ℤ → ℂ) (C : ℤ → ℕ → ℂ) :
    let s : ℕ := z / w
    let Dn : Finset ℕ :=
      (D.filter fun dₒ => 0 < dₒ ∧ z ∣ dₒ).image fun dₒ => dₒ / z
    let Jo : ℕ → ℤ × ℤ → ℤ := fun dₒ p =>
      (((w : ℤ) * lam) * (p.2 + Bo * (dₒ : ℤ)) -
        ((w : ℤ) * lamTilde) * (p.1 + Bo * (dₒ : ℤ))) / (dₒ : ℤ)
    let Jn : ℕ → ℤ × ℤ → ℤ := fun d p =>
      (lam * (p.2 + Bn * (d : ℤ)) - lamTilde * (p.1 + Bn * (d : ℤ))) / (d : ℤ)
    let H₄ : ℂ :=
      ∑ dₒ ∈ D.filter (fun dₒ =>
          0 < dₒ ∧ z ∣ dₒ ∧
            Int.gcd ((dₒ / w : ℕ) : ℤ)
              (((m : ℤ) * ((w : ℤ) * lam) * ((w : ℤ) * lamTilde)) / (w : ℤ) ^ 2) = 1),
        ψD ((dₒ : ℤ) - d₀) *
          ∑ p ∈ P.filter (fun p =>
              Int.ModEq (dₒ : ℤ) (((w : ℤ) * lam) * p.2) (((w : ℤ) * lamTilde) * p.1) ∧
                Int.gcd (p.1 * p.2) ((w * r₁ * q₀ * u₁ * v₁ * v₂ : ℕ) : ℤ) = 1 ∧
                Int.gcd ((p.1 + ℓ * (dₒ : ℤ) * (r₁ : ℤ)) *
                  (p.2 + ℓ * (dₒ : ℤ) * (r₁ : ℤ))) ((q₀ * q₂ : ℕ) : ℤ) = 1 ∧
                (Int.gcd (Jo dₒ p) (m : ℤ) : ℝ) ≤ T),
            C p.1 dₒ * C p.2 dₒ * ψN p.1 * ψN p.2 *
              reciprocalUnitPhase m
                ((Ao : ZMod m) * (Jo dₒ p : ZMod m))
                ((((p.1 + Bo * (dₒ : ℤ) : ℤ) : ZMod m)) *
                  (((p.2 + Bo * (dₒ : ℤ) : ℤ) : ZMod m)))
    let H₅ : ℂ :=
      ∑ d ∈ Dn.filter (fun d : ℕ => Int.gcd (d : ℤ) ((m : ℤ) * lam * lamTilde) = 1),
        ψD (((z * d : ℕ) : ℤ) - d₀) *
          ∑ p ∈ P.filter (fun p =>
              Int.ModEq ((s * d : ℕ) : ℤ) (lam * p.2) (lamTilde * p.1) ∧
                Int.gcd (p.1 * p.2)
                  ((w * (r₁ * q₀ * u₁ * Nat.lcm v₁ v₂) : ℕ) : ℤ) = 1 ∧
                Int.gcd ((p.1 + (ℓ * (z : ℤ) * (r₁ : ℤ)) * (d : ℤ)) *
                  (p.2 + (ℓ * (z : ℤ) * (r₁ : ℤ)) * (d : ℤ)))
                    ((q₀ * q₂ : ℕ) : ℤ) = 1 ∧
                (Int.gcd (Jn d p) (m : ℤ) : ℝ) ≤ T),
            C p.1 (z * d) * C p.2 (z * d) * ψN p.1 * ψN p.2 *
              reciprocalUnitPhase m
                ((An : ZMod m) * (Jn d p : ZMod m))
                ((((p.1 + Bn * (d : ℤ) : ℤ) : ZMod m)) *
                  (((p.2 + Bn * (d : ℤ) : ℤ) : ZMod m)))
    H₄ = (if Int.gcd (s : ℤ) ((m : ℤ) * lam * lamTilde) = 1 then H₅ else 0) ∧
      ‖H₄‖ = (if Int.gcd (s : ℤ) ((m : ℤ) * lam * lamTilde) = 1 then ‖H₅‖ else 0) := by
  intro s Dn Jo Jn H₄ H₅
  classical
  have hlcm (a : ℕ) : Nat.Coprime a (v₁ * v₂) ↔ Nat.Coprime a (Nat.lcm v₁ v₂) := by
    constructor
    · exact fun h => h.of_dvd_right (Nat.lcm_dvd_mul v₁ v₂)
    · intro h
      exact Nat.coprime_mul_iff_right.mpr
        ⟨h.of_dvd_right (Nat.dvd_lcm_left v₁ v₂),
          h.of_dvd_right (Nat.dvd_lcm_right v₁ v₂)⟩
  have hcop (x : ℤ) :
      Int.gcd x ((w * r₁ * q₀ * u₁ * v₁ * v₂ : ℕ) : ℤ) = 1 ↔
        Int.gcd x ((w * (r₁ * q₀ * u₁ * Nat.lcm v₁ v₂) : ℕ) : ℤ) = 1 := by
    simp only [Int.gcd_eq_natAbs_gcd_natAbs, Int.natAbs_natCast,
      ← Nat.coprime_iff_gcd_eq_one, Nat.coprime_mul_iff_right]
    rw [← hlcm x.natAbs, Nat.coprime_mul_iff_right]
    tauto
  by_cases hs : Int.gcd (s : ℤ) ((m : ℤ) * lam * lamTilde) = 1
  · have hH : H₄ = H₅ := by
      dsimp only [H₄, H₅, Dn]
      rw [Finset.filter_image, Finset.sum_image]
      · apply Finset.sum_congr
        · rw [Finset.filter_filter]
          apply Finset.filter_congr
          intro dₒ _
          simp only [and_assoc]
          apply and_congr_right
          intro _
          apply and_congr_right
          intro hdiv
          have hzd : z * (dₒ / z) = dₒ := Nat.mul_div_cancel' hdiv
          have hdict :=
            (sourceTerminalDictionary_arithmetic w z (dₒ / z) m hwz
              lam lamTilde 0 0).2.2.2.1
          simpa only [hzd] using hdict.trans (and_iff_right hs)
        · intro dₒ hdₒ
          obtain ⟨hbase, _⟩ := Finset.mem_filter.mp hdₒ
          obtain ⟨_, hpos, hdiv⟩ := Finset.mem_filter.mp hbase
          let d : ℕ := dₒ / z
          have hzd : z * d = dₒ := Nat.mul_div_cancel' hdiv
          have hd : 0 < d := Nat.div_pos (Nat.le_of_dvd hpos hdiv) (NeZero.pos z)
          conv_lhs => rw [← hzd]
          apply congrArg (fun t => ψD (((z * d : ℕ) : ℤ) - d₀) * t)
          let : NeZero d := ⟨Nat.ne_of_gt hd⟩
          apply Finset.sum_congr
          · apply Finset.filter_congr
            intro p _
            have hmod :=
              (sourceTerminalDictionary_arithmetic w z d m hwz lam lamTilde p.1 p.2).2.2.2.2
            have hshift :
                (p.1 + ℓ * ((z * d : ℕ) : ℤ) * (r₁ : ℤ)) *
                    (p.2 + ℓ * ((z * d : ℕ) : ℤ) * (r₁ : ℤ)) =
                  (p.1 + (ℓ * (z : ℤ) * (r₁ : ℤ)) * (d : ℤ)) *
                    (p.2 + (ℓ * (z : ℤ) * (r₁ : ℤ)) * (d : ℤ)) := by
              simp only [Nat.cast_mul]
              ring
            rw [← hmod, ← hcop (p.1 * p.2), ← hshift]
            apply and_congr_right
            intro hc
            have hgcd :=
              (sourceTerminalDictionary_quotient_phase w z d m hwz hzm
                Ao Bo An Bn lam lamTilde p.1 p.2 hA hB hc).2.2.2.2.1
            change Int.gcd (Jn d p) (m : ℤ) = Int.gcd (Jo (z * d) p) (m : ℤ) at hgcd
            rw [hgcd]
          · intro p hp
            have hc :=
              (sourceTerminalDictionary_arithmetic w z d m hwz lam lamTilde p.1 p.2).2.2.2.2.mpr
                (Finset.mem_filter.mp hp).2.1
            have hphase :=
              (sourceTerminalDictionary_quotient_phase w z d m hwz hzm
                Ao Bo An Bn lam lamTilde p.1 p.2 hA hB hc).2.2.2.2.2.2
            exact congrArg (fun t => C p.1 (z * d) * C p.2 (z * d) * ψN p.1 * ψN p.2 * t)
              hphase
      · intro a ha b hb hab
        exact (Nat.div_left_inj
          (Finset.mem_filter.mp (Finset.mem_filter.mp ha).1).2.2
          (Finset.mem_filter.mp (Finset.mem_filter.mp hb).1).2.2).mp hab
    exact ⟨by simpa only [ite_eq_left hs] using hH,
      by simpa only [ite_eq_left hs] using congrArg norm hH⟩
  · have hH : H₄ = 0 := by
      dsimp only [H₄]
      apply Finset.sum_eq_zero
      intro dₒ hdₒ
      obtain ⟨_, _, hdiv, hgcd⟩ := Finset.mem_filter.mp hdₒ
      have hzd : z * (dₒ / z) = dₒ := Nat.mul_div_cancel' hdiv
      have hdict :=
        (sourceTerminalDictionary_arithmetic w z (dₒ / z) m hwz
          lam lamTilde 0 0).2.2.2.1
      exact (hs (hdict.mp (by simpa only [hzd] using hgcd)).1).elim
    exact ⟨by simpa only [ite_eq_right hs] using hH,
      by simpa only [ite_eq_right hs, norm_zero] using congrArg norm hH⟩

theorem sourceTerminalLinearization_exact
    (s d m : ℕ) [NeZero s] [NeZero d] [NeZero m]
    (lam lamTilde n nt A B : ℤ) (hlam : lam ≠ 0) :
    let Jn : ℤ :=
      (lam * (nt + B * (d : ℤ)) - lamTilde * (n + B * (d : ℤ))) / (d : ℤ)
    (Int.ModEq ((s * d : ℕ) : ℤ) (lam * nt) (lamTilde * n) ↔
      ∃! k : ℤ,
        lam ∣ lamTilde * n + (s : ℤ) * k * (d : ℤ) ∧
          (lamTilde * n + (s : ℤ) * k * (d : ℤ)) / lam = nt) ∧
    (∀ k : ℤ,
      lam ∣ lamTilde * n + (s : ℤ) * k * (d : ℤ) →
      (lamTilde * n + (s : ℤ) * k * (d : ℤ)) / lam = nt →
      lam * nt - lamTilde * n = (s : ℤ) * k * (d : ℤ) ∧
      Jn = (s : ℤ) * k + (lam - lamTilde) * B ∧
      reciprocalUnitPhase m ((A : ZMod m) * (Jn : ZMod m))
          (((n + B * (d : ℤ) : ℤ) : ZMod m) *
            ((nt + B * (d : ℤ) : ℤ) : ZMod m)) =
        reciprocalUnitPhase m
          ((A : ZMod m) * (((s : ℤ) * k + (lam - lamTilde) * B : ℤ) : ZMod m))
          (((n + B * (d : ℤ) : ℤ) : ZMod m) *
            (((lamTilde * n + (s : ℤ) * k * (d : ℤ)) / lam + B * (d : ℤ) : ℤ) : ZMod m))) := by
  intro Jn
  have hguard (k : ℤ) :
      (lam ∣ lamTilde * n + (s : ℤ) * k * (d : ℤ) ∧
        (lamTilde * n + (s : ℤ) * k * (d : ℤ)) / lam = nt) ↔
      lam * nt - lamTilde * n = (s : ℤ) * k * (d : ℤ) := by
    rw [and_congr_right (fun hdiv => Int.ediv_eq_iff_eq_mul_right hlam hdiv)]
    refine (and_iff_right_of_imp ?_).trans (eq_comm.trans Int.sub_eq_iff_eq_add'.symm)
    exact fun h => ⟨nt, h⟩
  constructor
  · constructor
    · intro hcong
      obtain ⟨k, hk⟩ := Int.modEq_iff_dvd.mp hcong.symm
      have hrel : lam * nt - lamTilde * n = (s : ℤ) * k * (d : ℤ) := by
        simpa only [Nat.cast_mul, mul_assoc, mul_comm, mul_left_comm] using hk
      refine ⟨k, (hguard k).mpr hrel, ?_⟩
      intro j hj
      have hmul : (s : ℤ) * j * (d : ℤ) = (s : ℤ) * k * (d : ℤ) :=
        ((hguard j).mp hj).symm.trans hrel
      exact mul_left_cancel₀ (NeZero.ne (s : ℤ))
        (mul_right_cancel₀ (NeZero.ne (d : ℤ)) hmul)
    · rintro ⟨k, hk, _⟩
      have hdiv : ((s * d : ℕ) : ℤ) ∣ lam * nt - lamTilde * n := by
        refine ⟨k, ?_⟩
        simpa only [Nat.cast_mul, mul_assoc, mul_comm, mul_left_comm]
          using (hguard k).mp hk
      exact (Int.modEq_iff_dvd.mpr hdiv).symm
  · intro k hdiv hquot
    have hrel := (hguard k).mp ⟨hdiv, hquot⟩
    have hJn : Jn = (s : ℤ) * k + (lam - lamTilde) * B := by
      apply Int.ediv_eq_of_eq_mul_left (NeZero.ne (d : ℤ))
      linear_combination hrel
    refine ⟨hrel, hJn, ?_⟩
    rw [hJn, hquot]

theorem sourceTerminalLinearization_supported_part_dvd
    (s d m w₂ : ℕ) [NeZero m]
    (lam lamTilde n nt k : ℤ) (hlam : lam ≠ 0) (hlamTilde : lamTilde ≠ 0)
    (hw₂ : w₂ = ∏ p ∈ m.primeFactors, p ^ (lam.natAbs.factorization p))
    (hw₂Tilde : w₂ = ∏ p ∈ m.primeFactors, p ^ (lamTilde.natAbs.factorization p))
    (hsm : Nat.Coprime s m)
    (hd : Int.gcd (d : ℤ) ((m : ℤ) * lam * lamTilde) = 1)
    (hlinear : lam * nt - lamTilde * n = (s : ℤ) * k * (d : ℤ)) :
    0 < w₂ ∧ Nat.Coprime w₂ (s * d) ∧ (w₂ : ℤ) ∣ k ∧
      IsUnit (((lam / (w₂ : ℤ)) : ℤ) : ZMod m) ∧
      IsUnit (((lamTilde / (w₂ : ℤ)) : ℤ) : ZMod m) := by
  have hA := primeFactors_prod_pow_factorization_dvd_and_coprime_div m lam.natAbs (NeZero.ne m)
    (Int.natAbs_ne_zero.mpr hlam)
  have hATilde := primeFactors_prod_pow_factorization_dvd_and_coprime_div m lamTilde.natAbs
    (NeZero.ne m)
    (Int.natAbs_ne_zero.mpr hlamTilde)
  simp only [← hw₂] at hA
  simp only [← hw₂Tilde] at hATilde
  rcases hA with ⟨hwpos, hwdvd, _, hwquot, _⟩
  rcases hATilde with ⟨_, hwTildeDvd, _, hwTildeQuot, _⟩
  have hdwhole : Nat.Coprime d (m * lam.natAbs * lamTilde.natAbs) := by
    simpa only [Int.gcd_def, Int.natAbs_mul, Int.natAbs_natCast] using hd
  have hsdm : Nat.Coprime (s * d) m :=
    hsm.mul_left hdwhole.coprime_mul_right_right.coprime_mul_right_right
  have hwcop : Nat.Coprime w₂ (s * d) := by
    rw [hw₂, Nat.coprime_prod_left_iff]
    exact fun p hp ↦ (hsdm.of_dvd_right (Nat.dvd_of_mem_primeFactors hp)).symm.pow_left _
  have hwlam : (w₂ : ℤ) ∣ lam := Int.natCast_dvd.mpr hwdvd
  have hwlamTilde : (w₂ : ℤ) ∣ lamTilde := Int.natCast_dvd.mpr hwTildeDvd
  have hkdvd : (w₂ : ℤ) ∣ k := by
    refine Int.dvd_of_dvd_mul_left_of_gcd_one (c := ((s * d : ℕ) : ℤ)) ?_ ?_
    · have hpair : (w₂ : ℤ) ∣ lam * nt - lamTilde * n :=
        dvd_sub (dvd_mul_of_dvd_left hwlam nt) (dvd_mul_of_dvd_left hwlamTilde n)
      rw [hlinear] at hpair
      simpa only [Nat.cast_mul, mul_comm, mul_left_comm, mul_assoc] using hpair
    · simpa only [Int.gcd_natCast_natCast] using hwcop.gcd_eq_one
  have hunit (u : ℤ) (hwu : (w₂ : ℤ) ∣ u) (hquot : Nat.Coprime (u.natAbs / w₂) m) :
      IsUnit (((u / (w₂ : ℤ)) : ℤ) : ZMod m) := by
    rw [ZMod.coe_int_isUnit_iff_isCoprime, Int.isCoprime_iff_gcd_eq_one,
      Int.gcd_def, Int.natAbs_natCast, Int.natAbs_ediv_of_dvd hwu,
      Int.natAbs_natCast]
    exact hquot.symm.gcd_eq_one
  exact ⟨hwpos, hwcop, hkdvd, hunit lam hwlam hwquot,
    hunit lamTilde hwlamTilde hwTildeQuot⟩

theorem sourceTerminalLinearization_support_bound
    (cD CD cN CN c₀ : ℝ)
    (hcD : 0 < cD) (hcN : 0 < cN) (hCN : 0 < CN) (hc₀ : 0 < c₀)
    (x ε Δ₁ N Λ : ℝ) (hx : 1 < x) (hΔ₁ : 0 < Δ₁) (hN : 0 < N) (hΛ : Λ ≠ 0)
    (w₁ z₁ d : ℕ) (hw₁ : 0 < w₁) (hz₁ : 0 < z₁) (hwz : w₁ ∣ z₁)
    (d₀ lam lamTilde n nt k : ℤ)
    (hd₀ : c₀ * x ^ (5 * ε) * Δ₁ ≤ (d₀ : ℝ))
    (hlam : 1 ≤ (lam : ℝ) / Λ ∧ (lam : ℝ) / Λ < 2)
    (hlamTilde : 1 ≤ (lamTilde : ℝ) / Λ ∧ (lamTilde : ℝ) / Λ < 2)
    (ψD ψN : ℝ → ℂ)
    (hψD : Function.support ψD ⊆ Set.Icc cD CD)
    (hψN : Function.support ψN ⊆ Set.Icc cN CN)
    (hlinear : lam * nt - lamTilde * n = ((z₁ / w₁ : ℕ) : ℤ) * k * (d : ℤ)) :
    let Klam : ℝ := (w₁ : ℝ) * |Λ| * N / (x ^ (5 * ε) * Δ₁)
    let C : ℝ := 2 * CN / c₀
    let W : ℂ :=
      ψD (((z₁ : ℝ) * (d : ℝ) - (d₀ : ℝ)) / Δ₁) *
        ψN ((n : ℝ) / N) * ψN ((nt : ℝ) / N)
    0 < C ∧
      (W ≠ 0 → 0 < d ∧ |(k : ℝ)| ≤ C * Klam) ∧
      W = (if |(k : ℝ)| ≤ C * Klam then W else 0) := by
  intro Klam C W
  have hC : 0 < C := div_pos (mul_pos (by norm_num) hCN) hc₀
  have hmain : W ≠ 0 → 0 < d ∧ |(k : ℝ)| ≤ C * Klam := by
    intro hW
    have hweights :
        ψD (((z₁ : ℝ) * (d : ℝ) - (d₀ : ℝ)) / Δ₁) ≠ 0 ∧
          ψN ((n : ℝ) / N) ≠ 0 ∧ ψN ((nt : ℝ) / N) ≠ 0 := by
      simpa only [W, mul_ne_zero_iff, and_assoc] using hW
    have hD :
        ((z₁ : ℝ) * (d : ℝ) - (d₀ : ℝ)) / Δ₁ ∈ Set.Icc cD CD :=
      hψD hweights.1
    have hn : (n : ℝ) / N ∈ Set.Icc cN CN := hψN hweights.2.1
    have hnt : (nt : ℝ) / N ∈ Set.Icc cN CN := hψN hweights.2.2
    have hpow : 0 < x ^ (5 * ε) :=
      Real.rpow_pos_of_pos (lt_trans zero_lt_one hx) _
    have hE : 0 < x ^ (5 * ε) * Δ₁ := mul_pos hpow hΔ₁
    have hshift : cD * Δ₁ ≤ (z₁ : ℝ) * (d : ℝ) - (d₀ : ℝ) :=
      (le_div_iff₀ hΔ₁).mp hD.1
    have hzd : c₀ * (x ^ (5 * ε) * Δ₁) ≤ (z₁ : ℝ) * (d : ℝ) := by
      nlinarith [mul_pos hcD hΔ₁]
    have hzR : 0 < (z₁ : ℝ) := by exact_mod_cast hz₁
    have hwR : 0 < (w₁ : ℝ) := by exact_mod_cast hw₁
    have hdR : 0 < (d : ℝ) :=
      (mul_pos_iff_of_pos_left hzR).mp ((mul_pos hc₀ hE).trans_le hzd)
    have hnhi : (n : ℝ) ≤ CN * N := (div_le_iff₀ hN).mp hn.2
    have hnthi : (nt : ℝ) ≤ CN * N := (div_le_iff₀ hN).mp hnt.2
    have hnpos : 0 < (n : ℝ) :=
      (mul_pos hcN hN).trans_le ((le_div_iff₀ hN).mp hn.1)
    have hntpos : 0 < (nt : ℝ) :=
      (mul_pos hcN hN).trans_le ((le_div_iff₀ hN).mp hnt.1)
    have hleft_nonneg : 0 ≤ ((lam : ℝ) / Λ) * (nt : ℝ) :=
      mul_nonneg (zero_le_one.trans hlam.1) hntpos.le
    have hleft_le : ((lam : ℝ) / Λ) * (nt : ℝ) ≤ 2 * CN * N := by
      simpa only [mul_assoc] using mul_le_mul hlam.2.le hnthi hntpos.le (by norm_num)
    have hright_nonneg : 0 ≤ ((lamTilde : ℝ) / Λ) * (n : ℝ) :=
      mul_nonneg (zero_le_one.trans hlamTilde.1) hnpos.le
    have hright_le : ((lamTilde : ℝ) / Λ) * (n : ℝ) ≤ 2 * CN * N := by
      simpa only [mul_assoc] using mul_le_mul hlamTilde.2.le hnhi hnpos.le (by norm_num)
    have hdiff :=
      abs_sub_le_of_nonneg_of_le hleft_nonneg hleft_le hright_nonneg hright_le
    have hraw :
        |(lam : ℝ) * (nt : ℝ) - (lamTilde : ℝ) * (n : ℝ)| ≤
          |Λ| * (2 * CN * N) := by
      rw [mul_comm |Λ| _, ← div_le_iff₀ (abs_pos.mpr hΛ), ← abs_div]
      simpa only [sub_div, div_mul_eq_mul_div] using hdiff
    have hlinR :
        (lam : ℝ) * (nt : ℝ) - (lamTilde : ℝ) * (n : ℝ) =
          ((z₁ / w₁ : ℕ) : ℝ) * (k : ℝ) * (d : ℝ) := by
      simpa only [Int.cast_sub, Int.cast_mul, Int.cast_natCast] using
        congrArg (fun t : ℤ => (t : ℝ)) hlinear
    have hquotR : (w₁ : ℝ) * ((z₁ / w₁ : ℕ) : ℝ) = (z₁ : ℝ) := by
      exact_mod_cast (Nat.mul_div_cancel' hwz)
    have hmul :
        (w₁ : ℝ) * ((lam : ℝ) * (nt : ℝ) - (lamTilde : ℝ) * (n : ℝ)) =
          (z₁ : ℝ) * (d : ℝ) * (k : ℝ) := by
      calc
        _ = (w₁ : ℝ) * (((z₁ / w₁ : ℕ) : ℝ) * (k : ℝ) * (d : ℝ)) :=
          congrArg (fun t : ℝ => (w₁ : ℝ) * t) hlinR
        _ = ((w₁ : ℝ) * ((z₁ / w₁ : ℕ) : ℝ)) * (d : ℝ) * (k : ℝ) := by ring
        _ = _ := by rw [hquotR]
    have habs := congrArg (fun t : ℝ => |t|) hmul
    simp only [abs_mul, abs_of_pos hwR, abs_of_pos hzR, abs_of_pos hdR] at habs
    have hkE :
        |(k : ℝ)| * (c₀ * (x ^ (5 * ε) * Δ₁)) ≤
          (w₁ : ℝ) * |Λ| * (2 * CN * N) := by
      calc
        _ ≤ |(k : ℝ)| * ((z₁ : ℝ) * (d : ℝ)) :=
          mul_le_mul_of_nonneg_left hzd (abs_nonneg _)
        _ = (w₁ : ℝ) * |(lam : ℝ) * (nt : ℝ) - (lamTilde : ℝ) * (n : ℝ)| := by
          simpa only [mul_assoc, mul_comm, mul_left_comm] using habs.symm
        _ ≤ (w₁ : ℝ) * (|Λ| * (2 * CN * N)) :=
          mul_le_mul_of_nonneg_left hraw hwR.le
        _ = _ := by ring
    refine ⟨by exact_mod_cast hdR, ?_⟩
    calc
      |(k : ℝ)| ≤
          ((w₁ : ℝ) * |Λ| * (2 * CN * N)) / (c₀ * (x ^ (5 * ε) * Δ₁)) :=
        (le_div_iff₀ (mul_pos hc₀ hE)).mpr hkE
      _ = C * Klam := by
        simp only [C, Klam, div_mul_div_comm, mul_assoc, mul_left_comm, mul_comm]
  refine ⟨hC, hmain, ?_⟩
  by_cases hW : W = 0
  · simp [hW]
  · rw [ite_eq_left (hmain hW).2]

section
open scoped ContDiff

theorem sourceTerminalTaylor_finite_separation
    (J : ℕ) (φ ψ : ℝ → ℂ) (hψ : ContDiff ℝ (J + 1) ψ)
    (Δ₁ N : ℝ) (hΔ₁ : 0 < Δ₁) (hN : 0 < N)
    (w₁ z₁ : ℕ) (hw₁ : 0 < w₁) (hz₁ : 0 < z₁) (hwz : w₁ ∣ z₁)
    (lam lamTilde d₀ : ℤ) (hlam : lam ≠ 0)
    (K : Finset ℤ) (D : Finset ℕ) (I : Finset ℤ)
    (A : ℤ → ℕ → ℤ → ℂ) :
    let τ : ℕ → ℝ := fun d => ((z₁ : ℝ) * (d : ℝ) - (d₀ : ℝ)) / Δ₁
    let ρ : ℝ := (lamTilde : ℝ) / (lam : ℝ)
    let σ : ℤ → ℝ := fun k => (k : ℝ) * (d₀ : ℝ) / ((w₁ : ℝ) * (lam : ℝ) * N)
    let η : ℤ → ℝ := fun k => (k : ℝ) * Δ₁ / ((w₁ : ℝ) * (lam : ℝ) * N)
    let a : ℤ → ℤ → ℝ := fun k n => ρ * ((n : ℝ) / N) + σ k
    let nStar : ℕ → ℤ → ℝ → ℂ := fun j k u =>
      ψ u * iteratedDeriv j ψ (ρ * u + σ k)
    let dStar : ℕ → ℤ → ℝ → ℂ := fun j k u =>
      ((η k * u) ^ j / (Nat.factorial j : ℝ)) • φ u
    let R : ℤ → ℕ → ℤ → ℂ := fun k d n =>
      ((η k * τ d) ^ (J + 1) / (Nat.factorial J : ℝ)) •
        ∫ u : ℝ in (0 : ℝ)..1,
          (1 - u) ^ J • iteratedDeriv (J + 1) ψ (a k n + u * (η k * τ d))
    (∀ (j : ℕ) (k : ℤ),
      Function.support (nStar j k) ⊆ Function.support ψ ∧
      Function.support (dStar j k) ⊆ Function.support φ) ∧
    (∑ k ∈ K, ∑ d ∈ D, ∑ n ∈ I,
      A k d n * φ (τ d) * ψ ((n : ℝ) / N) *
        ψ (((lamTilde * n + ((z₁ / w₁ : ℕ) : ℤ) * k * (d : ℤ) : ℤ) : ℝ) /
          ((lam : ℝ) * N))) =
      (∑ j ∈ Finset.range (J + 1), ∑ k ∈ K, ∑ d ∈ D, ∑ n ∈ I,
        A k d n * dStar j k (τ d) * nStar j k ((n : ℝ) / N)) +
      ∑ k ∈ K, ∑ d ∈ D, ∑ n ∈ I,
        A k d n * φ (τ d) * ψ ((n : ℝ) / N) * R k d n := by
  intro τ ρ σ η a nStar dStar R
  constructor
  · intro j k
    exact ⟨Function.support_mul_subset_left _ _,
      Function.support_smul_subset_right
        (fun u : ℝ => (η k * u) ^ j / (Nat.factorial j : ℝ)) φ⟩
  · have harg (k : ℤ) (d : ℕ) (n : ℤ) :
        (((lamTilde * n + ((z₁ / w₁ : ℕ) : ℤ) * k * (d : ℤ) : ℤ) : ℝ) /
          ((lam : ℝ) * N)) = a k n + η k * τ d := by
      dsimp only [a, ρ, σ, η, τ]
      simp only [Int.cast_add, Int.cast_mul, Int.cast_natCast,
        Nat.cast_div (K := ℝ) hwz (by
          exact_mod_cast (Nat.ne_of_gt (Nat.pos_of_dvd_of_pos hwz hz₁)))]
      field_simp [(Nat.cast_ne_zero (R := ℝ)).mpr (Nat.ne_of_gt hw₁),
        (Int.cast_ne_zero (α := ℝ)).mpr hlam, ne_of_gt hN, ne_of_gt hΔ₁]
      ring
    have htaylor (b h : ℝ) :
        ψ (b + h) =
          (∑ j ∈ Finset.range (J + 1),
            (h ^ j / (Nat.factorial j : ℝ)) • iteratedDeriv j ψ b) +
          (h ^ (J + 1) / (Nat.factorial J : ℝ)) •
            ∫ u : ℝ in (0 : ℝ)..1,
              (1 - u) ^ J • iteratedDeriv (J + 1) ψ (b + u * h) := by
      have hT := map_add_eq_sum_add_integral_iteratedFDeriv
        (f := ψ) (x := b) (y := h) (n := J) (fun _ _ => hψ.contDiffAt)
      simp only [iteratedFDeriv_apply_eq_iteratedDeriv_mul_prod, Fin.prod_const,
        smul_eq_mul] at hT
      simp_rw [← smul_comm (h ^ (J + 1)) (_ : ℝ) (_ : ℂ),
        intervalIntegral.integral_smul] at hT
      simpa only [smul_smul, div_eq_mul_inv, mul_comm] using hT
    have hpoint (k : ℤ) (d : ℕ) (n : ℤ) :
        A k d n * φ (τ d) * ψ ((n : ℝ) / N) *
            ψ (((lamTilde * n + ((z₁ / w₁ : ℕ) : ℤ) * k * (d : ℤ) : ℤ) : ℝ) /
              ((lam : ℝ) * N)) =
          (∑ j ∈ Finset.range (J + 1),
            A k d n * dStar j k (τ d) * nStar j k ((n : ℝ) / N)) +
          A k d n * φ (τ d) * ψ ((n : ℝ) / N) * R k d n := by
      rw [harg k d n, htaylor (a k n) (η k * τ d), mul_add, Finset.mul_sum]
      congr 1
      apply Finset.sum_congr rfl
      intro j _
      simp only [dStar, nStar, a, mul_smul_comm, smul_mul_assoc, mul_assoc]
    simp_rw [hpoint, Finset.sum_add_distrib]
    congr 1
    simp_rw [Finset.sum_comm_cycle (s := D) (t := I) (u := Finset.range (J + 1))]
    exact Finset.sum_comm

theorem sourceTerminalTaylor_uniform_star_profiles
    (J : ℕ) (cD CD cN CN : ℝ)
    (Cφ Eφ Cψ Eψ : ℕ → ℝ)
    (hCφ : ∀ r, 0 ≤ Cφ r) (hCψ : ∀ r, 0 ≤ Cψ r) :
    ∃ Cstar Estar : ℕ → ℝ,
      (∀ r, 0 < Cstar r ∧ 0 ≤ Estar r) ∧
      ∀ (x : ℝ), Real.exp 1 ≤ x →
      ∀ (φ ψ : ℝ → ℂ), ContDiff ℝ ∞ φ → ContDiff ℝ ∞ ψ →
      Function.support φ ⊆ Set.Icc cD CD →
      Function.support ψ ⊆ Set.Icc cN CN →
      (∀ (r : ℕ) (u : ℝ), ‖iteratedDeriv r φ u‖ ≤ Cφ r * (Real.log x) ^ Eφ r) →
      (∀ (r : ℕ) (u : ℝ), ‖iteratedDeriv r ψ u‖ ≤ Cψ r * (Real.log x) ^ Eψ r) →
      ∀ (ρ σ η : ℝ), |ρ| ≤ 2 → |η| ≤ 1 →
      ∀ (j : ℕ), j ≤ J →
      let nStar : ℝ → ℂ := fun u => ψ u * iteratedDeriv j ψ (ρ * u + σ)
      let dStar : ℝ → ℂ := fun u => ((η * u) ^ j / (Nat.factorial j : ℝ)) • φ u
      ContDiff ℝ ∞ nStar ∧ ContDiff ℝ ∞ dStar ∧
      Function.support nStar ⊆ Set.Icc cN CN ∧
      Function.support dStar ⊆ Set.Icc cD CD ∧
      (∀ (r : ℕ) (u : ℝ),
        ‖iteratedDeriv r nStar u‖ ≤ Cstar r * (Real.log x) ^ Estar r ∧
        ‖iteratedDeriv r dStar u‖ ≤ Cstar r * (Real.log x) ^ Estar r) := by
  let T : ℝ := max 1 (max |cD| |CD|)
  let aN : ℕ → ℕ → ℕ → ℝ := fun r j i =>
    (r.choose i : ℝ) * Cψ i * (2 : ℝ) ^ (r - i) * Cψ (j + r - i)
  let aD : ℕ → ℕ → ℕ → ℝ := fun r j i =>
    (r.choose i : ℝ) * (j.descFactorial i : ℝ) * T ^ (j - i) /
      (Nat.factorial j : ℝ) * Cφ (r - i)
  let c : ℕ → ℝ := fun r =>
    1 + ∑ j ∈ Finset.range (J + 1), ∑ i ∈ Finset.range (r + 1),
      (aN r j i + aD r j i)
  let e₀ : ℕ → ℝ := fun r =>
    ∑ q ∈ Finset.range (J + r + 1), (|Eφ q| + |Eψ q|)
  let e : ℕ → ℝ := fun r => 2 * e₀ r
  have hT : 0 ≤ T := le_trans zero_le_one (le_max_left _ _)
  have haN (r j i : ℕ) : 0 ≤ aN r j i := by
    have h₁ := hCψ i
    have h₂ := hCψ (j + r - i)
    dsimp [aN]
    positivity
  have haD (r j i : ℕ) : 0 ≤ aD r j i := by
    have h₁ := hCφ (r - i)
    dsimp [aD]
    positivity
  have he₀ (r : ℕ) : 0 ≤ e₀ r :=
    Finset.sum_nonneg fun q _ => add_nonneg (abs_nonneg _) (abs_nonneg _)
  have hc (r : ℕ) : 0 < c r := by
    have hs : 0 ≤ ∑ j ∈ Finset.range (J + 1),
        ∑ i ∈ Finset.range (r + 1), (aN r j i + aD r j i) :=
      Finset.sum_nonneg fun j _ =>
        Finset.sum_nonneg fun i _ => add_nonneg (haN r j i) (haD r j i)
    exact add_pos_of_pos_of_nonneg zero_lt_one hs
  have he (r q : ℕ) (hq : q ≤ J + r) : Eφ q ≤ e₀ r ∧ Eψ q ≤ e₀ r := by
    have hs : |Eφ q| + |Eψ q| ≤ e₀ r :=
      Finset.single_le_sum
        (fun t _ => add_nonneg (abs_nonneg (Eφ t)) (abs_nonneg (Eψ t)))
        (Finset.mem_range.mpr (Nat.lt_succ_of_le hq))
    constructor
    · exact (le_abs_self _).trans
        ((le_add_of_nonneg_right (abs_nonneg _)).trans hs)
    · exact (le_abs_self _).trans
        ((le_add_of_nonneg_left (abs_nonneg _)).trans hs)
  refine ⟨c, e, ?_, ?_⟩
  · intro r
    exact ⟨hc r, mul_nonneg (by norm_num) (he₀ r)⟩
  intro x hx φ ψ hφ hψ hsupportφ hsupportψ hboundφ hboundψ ρ σ η hρ hη j hj
  have hψj : ContDiff ℝ ∞ (iteratedDeriv j ψ) := by
    simpa only [iteratedDeriv_eq_iterate] using ContDiff.iterate_deriv j hψ
  have hiter (m : ℕ) :
      iteratedDeriv m (iteratedDeriv j ψ) = iteratedDeriv (m + j) ψ := by
    simp only [iteratedDeriv_eq_iterate, Function.iterate_add_apply]
  let L : ℝ := Real.log x
  have hL : 1 ≤ L := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hx
  have hLpos : 0 < L := lt_of_lt_of_le zero_lt_one hL
  have hLnonneg : 0 ≤ L := hLpos.le
  let F : ℝ → ℂ := fun v => iteratedDeriv j ψ (ρ * v + σ)
  let G : ℝ → ℝ := fun v => (η * v) ^ j / (Nat.factorial j : ℝ)
  let P : ℝ → ℂ := fun v => ψ v * F v
  let Q : ℝ → ℂ := fun v => G v • φ v
  change ContDiff ℝ ∞ P ∧ ContDiff ℝ ∞ Q ∧
    Function.support P ⊆ Set.Icc cN CN ∧
    Function.support Q ⊆ Set.Icc cD CD ∧
    ∀ r u, ‖iteratedDeriv r P u‖ ≤ c r * L ^ e r ∧
      ‖iteratedDeriv r Q u‖ ≤ c r * L ^ e r
  have hF : ContDiff ℝ ∞ F := hψj.comp (by fun_prop)
  have hG : ContDiff ℝ ∞ G := by dsimp [G]; fun_prop
  have hsupportQ : Function.support Q ⊆ Set.Icc cD CD :=
    (Function.support_smul_subset_right G φ).trans hsupportφ
  have hsupp (m : ℕ) :
      Function.support (iteratedDeriv m Q) ⊆ Set.Icc cD CD := by
    rw [iteratedDeriv_eq_equiv_comp]
    exact (Function.support_comp_subset (map_zero _) _).trans
      ((support_iteratedFDeriv_subset (𝕜 := ℝ) (f := Q) m).trans
        (closure_minimal hsupportQ isClosed_Icc))
  have hAffine (m : ℕ) (v : ℝ) :
      iteratedDeriv m F v = ρ ^ m • iteratedDeriv (m + j) ψ (ρ * v + σ) := by
    have hg : ContDiff ℝ m (fun w : ℝ => iteratedDeriv j ψ (w + σ)) :=
      contDiff_infty.mp (hψj.comp (by fun_prop)) m
    have hscale := congrFun (iteratedDeriv_comp_const_smul hg ρ) v
    simpa only [F, iteratedDeriv_comp_add_const, hiter] using hscale
  have hFnorm (m : ℕ) (v : ℝ) :
      ‖iteratedDeriv m F v‖ ≤
        (2 : ℝ) ^ m * (Cψ (m + j) * L ^ Eψ (m + j)) := by
    rw [hAffine, norm_smul, Real.norm_eq_abs, abs_pow]
    exact mul_le_mul (pow_le_pow_left₀ (abs_nonneg ρ) hρ m)
      (hboundψ (m + j) (ρ * v + σ)) (norm_nonneg _) (pow_nonneg (by norm_num) _)
  have hGnorm (m : ℕ) (v : ℝ) (hv : |v| ≤ T) :
      ‖iteratedDeriv m G v‖ ≤
        (j.descFactorial m : ℝ) * T ^ (j - m) / (Nat.factorial j : ℝ) := by
    simp only [G, mul_pow, iteratedDeriv_div_const, iteratedDeriv_const_mul_field,
      iteratedDeriv_pow, Real.norm_eq_abs, abs_div, abs_mul, abs_pow, Nat.abs_cast]
    calc
      _ ≤ (1 * ((j.descFactorial m : ℝ) * T ^ (j - m))) / (Nat.factorial j : ℝ) := by
        gcongr
        exact pow_le_one₀ (abs_nonneg η) hη
      _ = _ := by rw [one_mul]
  refine ⟨hψ.mul hF, hG.smul hφ,
    (Function.support_mul_subset_left ψ F).trans hsupportψ, hsupportQ, ?_⟩
  intro r u
  have hsum : (∑ i ∈ Finset.range (r + 1), (aN r j i + aD r j i)) ≤ c r := by
    have hb : (∑ i ∈ Finset.range (r + 1), (aN r j i + aD r j i)) ≤
        ∑ t ∈ Finset.range (J + 1),
          ∑ i ∈ Finset.range (r + 1), (aN r t i + aD r t i) :=
      Finset.single_le_sum
        (fun t _ => Finset.sum_nonneg fun i _ => add_nonneg (haN r t i) (haD r t i))
        (Finset.mem_range.mpr (Nat.lt_succ_of_le hj))
    exact hb.trans (le_add_of_nonneg_left zero_le_one)
  have hcN : (∑ i ∈ Finset.range (r + 1), aN r j i) ≤ c r :=
    (Finset.sum_le_sum fun i _ => le_add_of_nonneg_right (haD r j i)).trans hsum
  have hcD : (∑ i ∈ Finset.range (r + 1), aD r j i) ≤ c r :=
    (Finset.sum_le_sum fun i _ => le_add_of_nonneg_left (haN r j i)).trans hsum
  constructor
  · have hnorm : ‖iteratedDeriv r P u‖ ≤
        ∑ i ∈ Finset.range (r + 1), (r.choose i : ℝ) *
          ‖iteratedDeriv i ψ u‖ * ‖iteratedDeriv (r - i) F u‖ := by
      simpa only [norm_iteratedFDeriv_eq_norm_iteratedDeriv] using
        norm_iteratedFDeriv_mul_le (𝕜 := ℝ) (n := r) hψ hF u (by simp)
    have hterms (i : ℕ) (hi : i ∈ Finset.range (r + 1)) :
        (r.choose i : ℝ) * ‖iteratedDeriv i ψ u‖ *
          ‖iteratedDeriv (r - i) F u‖ ≤ aN r j i * L ^ e r := by
      have hir : i ≤ r := Nat.le_of_lt_succ (Finset.mem_range.mp hi)
      have hord : r - i + j = j + r - i := by omega
      have hf := hFnorm (r - i) u
      rw [hord] at hf
      have hpow : L ^ (Eψ i + Eψ (j + r - i)) ≤ L ^ e r := by
        apply Real.rpow_le_rpow_of_exponent_le hL
        simpa only [e, two_mul] using
          add_le_add (he r i (by omega)).2 (he r (j + r - i) (by omega)).2
      have hci : 0 ≤ (r.choose i : ℝ) := Nat.cast_nonneg _
      calc
        (r.choose i : ℝ) * ‖iteratedDeriv i ψ u‖ *
            ‖iteratedDeriv (r - i) F u‖ ≤
            (r.choose i : ℝ) * (Cψ i * L ^ Eψ i) *
              ((2 : ℝ) ^ (r - i) * (Cψ (j + r - i) * L ^ Eψ (j + r - i))) :=
          mul_le_mul (mul_le_mul_of_nonneg_left (hboundψ i u) hci) hf
            (norm_nonneg _) (mul_nonneg hci (mul_nonneg (hCψ i)
              (Real.rpow_nonneg hLnonneg _)))
        _ = aN r j i * L ^ (Eψ i + Eψ (j + r - i)) := by
          rw [Real.rpow_add hLpos]
          dsimp [aN]
          ac_rfl
        _ ≤ aN r j i * L ^ e r := mul_le_mul_of_nonneg_left hpow (haN r j i)
    calc
      ‖iteratedDeriv r P u‖ ≤
          ∑ i ∈ Finset.range (r + 1), aN r j i * L ^ e r :=
        hnorm.trans (Finset.sum_le_sum hterms)
      _ = (∑ i ∈ Finset.range (r + 1), aN r j i) * L ^ e r := by
        rw [Finset.sum_mul]
      _ ≤ c r * L ^ e r :=
        mul_le_mul_of_nonneg_right hcN (Real.rpow_nonneg hLnonneg _)
  · by_cases hu : u ∈ Set.Icc cD CD
    · have huT : |u| ≤ T :=
        (abs_le_max_abs_abs hu.1 hu.2).trans (le_max_right _ _)
      have hnorm : ‖iteratedDeriv r Q u‖ ≤
          ∑ i ∈ Finset.range (r + 1), (r.choose i : ℝ) *
            ‖iteratedDeriv i G u‖ * ‖iteratedDeriv (r - i) φ u‖ := by
        simpa only [norm_iteratedFDeriv_eq_norm_iteratedDeriv] using
          norm_iteratedFDeriv_smul_le (𝕜 := ℝ) (n := r) hG hφ u (by simp)
      have hterms (i : ℕ) (_hi : i ∈ Finset.range (r + 1)) :
          (r.choose i : ℝ) * ‖iteratedDeriv i G u‖ *
            ‖iteratedDeriv (r - i) φ u‖ ≤ aD r j i * L ^ e r := by
        have hpow : L ^ Eφ (r - i) ≤ L ^ e r := by
          apply Real.rpow_le_rpow_of_exponent_le hL
          simpa only [e, two_mul] using
            (he r (r - i) (by omega)).1.trans (le_add_of_nonneg_right (he₀ r))
        have hci : 0 ≤ (r.choose i : ℝ) := Nat.cast_nonneg _
        have hp : 0 ≤ (j.descFactorial i : ℝ) * T ^ (j - i) / (Nat.factorial j : ℝ) := by
          positivity
        calc
          (r.choose i : ℝ) * ‖iteratedDeriv i G u‖ *
              ‖iteratedDeriv (r - i) φ u‖ ≤
              (r.choose i : ℝ) *
                ((j.descFactorial i : ℝ) * T ^ (j - i) / (Nat.factorial j : ℝ)) *
                (Cφ (r - i) * L ^ Eφ (r - i)) :=
            mul_le_mul (mul_le_mul_of_nonneg_left (hGnorm i u huT) hci)
              (hboundφ (r - i) u) (norm_nonneg _) (mul_nonneg hci hp)
          _ = aD r j i * L ^ Eφ (r - i) := by
            simp only [aD, div_eq_mul_inv, mul_assoc]
          _ ≤ aD r j i * L ^ e r := mul_le_mul_of_nonneg_left hpow (haD r j i)
      calc
        ‖iteratedDeriv r Q u‖ ≤
            ∑ i ∈ Finset.range (r + 1), aD r j i * L ^ e r :=
          hnorm.trans (Finset.sum_le_sum hterms)
        _ = (∑ i ∈ Finset.range (r + 1), aD r j i) * L ^ e r := by
          rw [Finset.sum_mul]
        _ ≤ c r * L ^ e r :=
          mul_le_mul_of_nonneg_right hcD (Real.rpow_nonneg hLnonneg _)
    · rw [Function.support_subset_iff'.mp (hsupp r) u hu, norm_zero]
      exact mul_nonneg (hc r).le (Real.rpow_nonneg hLnonneg _)

theorem sourceTerminalTaylor_uniform_finite_remainder
    (ε B CK cD CD cN CN : ℝ)
    (hε : 0 < ε) (hB : 0 < B) (hCK : 0 ≤ CK)
    (Cφ Eφ Cψ Eψ : ℕ → ℝ)
    (hCφ : ∀ r, 0 ≤ Cφ r) (hCψ : ∀ r, 0 ≤ Cψ r) :
    let J : ℕ := ⌈(B + 1) / (5 * ε)⌉₊
    ∃ X₀ : ℝ, Real.exp 1 ≤ X₀ ∧
      ∀ (x : ℝ), X₀ ≤ x →
      ∀ (φ ψ : ℝ → ℂ), ContDiff ℝ ∞ φ → ContDiff ℝ ∞ ψ →
      Function.support φ ⊆ Set.Icc cD CD →
      Function.support ψ ⊆ Set.Icc cN CN →
      (∀ (r : ℕ) (u : ℝ), ‖iteratedDeriv r φ u‖ ≤ Cφ r * (Real.log x) ^ Eφ r) →
      (∀ (r : ℕ) (u : ℝ), ‖iteratedDeriv r ψ u‖ ≤ Cψ r * (Real.log x) ^ Eψ r) →
      ∀ (Δ₁ N Λ : ℝ), 0 < Δ₁ → 0 < N → Λ ≠ 0 →
      ∀ (w₁ z₁ : ℕ), 0 < w₁ → 0 < z₁ → w₁ ∣ z₁ →
      ∀ (lam lamTilde d₀ : ℤ),
      (1 ≤ (lam : ℝ) / Λ ∧ (lam : ℝ) / Λ < 2) →
      (1 ≤ (lamTilde : ℝ) / Λ ∧ (lamTilde : ℝ) / Λ < 2) →
      ∀ (K : Finset ℤ) (D : Finset ℕ) (I : Finset ℤ)
        (A : ℤ → ℕ → ℤ → ℂ),
      let Klam : ℝ := (w₁ : ℝ) * |Λ| * N / (x ^ (5 * ε) * Δ₁)
      let Kcut : Finset ℤ := K.filter fun k => |(k : ℝ)| ≤ CK * Klam
      let τ : ℕ → ℝ := fun d => ((z₁ : ℝ) * (d : ℝ) - (d₀ : ℝ)) / Δ₁
      let ρ : ℝ := (lamTilde : ℝ) / (lam : ℝ)
      let σ : ℤ → ℝ := fun k => (k : ℝ) * (d₀ : ℝ) / ((w₁ : ℝ) * (lam : ℝ) * N)
      let η : ℤ → ℝ := fun k => (k : ℝ) * Δ₁ / ((w₁ : ℝ) * (lam : ℝ) * N)
      let RD : ℝ := max |cD| |CD|
      let nStar : ℕ → ℤ → ℝ → ℂ := fun j k u =>
        ψ u * iteratedDeriv j ψ (ρ * u + σ k)
      let dStar : ℕ → ℤ → ℝ → ℂ := fun j k u =>
        ((η k * u) ^ j / (Nat.factorial j : ℝ)) • φ u
      |ρ| ≤ 2 ∧
      (∀ k ∈ Kcut, |η k| ≤ 1 ∧
        ∀ d : ℕ, φ (τ d) ≠ 0 →
          |η k * τ d| ≤ CK * RD * x ^ (-(5 * ε))) ∧
      ‖(∑ k ∈ Kcut, ∑ d ∈ D, ∑ n ∈ I,
          A k d n * φ (τ d) * ψ ((n : ℝ) / N) *
            ψ (((lamTilde * n + ((z₁ / w₁ : ℕ) : ℤ) * k * (d : ℤ) : ℤ) : ℝ) /
              ((lam : ℝ) * N))) -
        (∑ j ∈ Finset.range (J + 1), ∑ k ∈ Kcut, ∑ d ∈ D, ∑ n ∈ I,
          A k d n * dStar j k (τ d) * nStar j k ((n : ℝ) / N))‖ ≤
        x ^ (-B) * ∑ k ∈ Kcut, ∑ d ∈ D, ∑ n ∈ I, ‖A k d n‖ := by
  intro J
  let RD : ℝ := max |cD| |CD|
  let Q : ℝ := Cφ 0 * Cψ 0 * Cψ (J + 1) * (CK * RD) ^ (J + 1) / (Nat.factorial J : ℝ)
  let E : ℝ := Eφ 0 + Eψ 0 + Eψ (J + 1)
  let α : ℝ := 5 * ε * ((J + 1 : ℕ) : ℝ)
  have hRD : 0 ≤ RD := (abs_nonneg cD).trans (le_max_left _ _)
  have hfact : 0 ≤ (Nat.factorial J : ℝ) := Nat.cast_nonneg _
  have hQ : 0 ≤ Q :=
    div_nonneg
      (mul_nonneg (mul_nonneg (mul_nonneg (hCφ 0) (hCψ 0)) (hCψ (J + 1)))
        (pow_nonneg (mul_nonneg hCK hRD) _)) hfact
  have hscale : 0 < 5 * ε := by positivity
  have hceil : B + 1 ≤ (J : ℝ) * (5 * ε) :=
    (div_le_iff₀ hscale).mp (Nat.le_ceil _)
  have hgap : 0 < α - B := by
    dsimp only [α]
    push_cast
    nlinarith
  have hthreshold :
      ∀ᶠ x : ℝ in Filter.atTop, Real.exp 1 ≤ x ∧ CK ≤ x ^ (5 * ε) ∧
        Q * (Real.log x) ^ E ≤ x ^ (α - B) := by
    filter_upwards [Filter.eventually_ge_atTop (Real.exp 1),
      (tendsto_rpow_atTop hscale).eventually_ge_atTop CK,
      ((isLittleO_log_rpow_rpow_atTop E hgap).const_mul_left Q).eventuallyLE] with x hx hcut herr
    have hx0 : 0 < x := (Real.exp_pos 1).trans_le hx
    have hlog1 : 1 ≤ Real.log x := by
      simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hx
    refine ⟨hx, hcut, ?_⟩
    simpa only [Real.norm_of_nonneg
      (mul_nonneg hQ (Real.rpow_nonneg (zero_le_one.trans hlog1) _)),
      Real.norm_of_nonneg (Real.rpow_nonneg hx0.le _)] using herr
  obtain ⟨X₀, hX₀⟩ := Filter.eventually_atTop.mp hthreshold
  refine ⟨X₀ + B, (hX₀ X₀ le_rfl).1.trans (le_add_of_nonneg_right hB.le), ?_⟩
  intro x hx φ ψ hφsmooth hψsmooth hφsupport hψsupport hφbound hψbound
    Δ₁ N Λ hΔ₁ hN hΛ w₁ z₁ hw₁ hz₁ hwz lam lamTilde d₀ hlam hlamTilde K D I A
    Klam Kcut τ ρ σ η RD' nStar dStar
  have hx : X₀ ≤ x := (le_add_of_nonneg_right hB.le).trans hx
  have hxexp : Real.exp 1 ≤ x := (hX₀ x hx).1
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hlog1 : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hxexp
  have hlog0 : 0 ≤ Real.log x := zero_le_one.trans hlog1
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlog1
  have hlam0 : lam ≠ 0 := by
    intro heq
    norm_num [heq] at hlam
  have hlamReal : (lam : ℝ) ≠ 0 := by exact_mod_cast hlam0
  have hΛabs : 0 < |Λ| := abs_pos.mpr hΛ
  have hdyadicAbs : |Λ| ≤ |(lam : ℝ)| := by
    have hratio : 1 ≤ |(lam : ℝ)| / |Λ| := by
      rw [← abs_div, abs_of_nonneg (le_trans zero_le_one hlam.1)]
      exact hlam.1
    simpa only [one_mul] using (le_div_iff₀ hΛabs).mp hratio
  have hdyadicTildeAbs : |(lamTilde : ℝ)| ≤ 2 * |Λ| := by
    apply (div_le_iff₀ hΛabs).mp
    rw [← abs_div, abs_of_nonneg (le_trans zero_le_one hlamTilde.1)]
    exact le_of_lt hlamTilde.2
  have hrho : |ρ| ≤ 2 := by
    dsimp only [ρ]
    rw [abs_div]
    apply (div_le_iff₀ (abs_pos.mpr hlamReal)).mpr
    exact hdyadicTildeAbs.trans (mul_le_mul_of_nonneg_left hdyadicAbs zero_le_two)
  have hwReal : 0 < (w₁ : ℝ) := by exact_mod_cast hw₁
  have hscalePow : 0 < x ^ (5 * ε) := Real.rpow_pos_of_pos hx0 _
  have hdenAbs : 0 < (w₁ : ℝ) * |(lam : ℝ)| * N :=
    mul_pos (mul_pos hwReal (abs_pos.mpr hlamReal)) hN
  have heta : ∀ k ∈ Kcut, |η k| ≤ CK * x ^ (-(5 * ε)) := by
    intro k hk
    have hkcut : |(k : ℝ)| ≤
        CK * ((w₁ : ℝ) * |Λ| * N) / (x ^ (5 * ε) * Δ₁) := by
      simpa only [Klam, ← mul_div_assoc] using (Finset.mem_filter.mp hk).2
    have hnum := (le_div_iff₀ (mul_pos hscalePow hΔ₁)).mp hkcut
    have hcross : |(k : ℝ)| * Δ₁ * x ^ (5 * ε) ≤
        CK * ((w₁ : ℝ) * |(lam : ℝ)| * N) := by
      calc
        _ = |(k : ℝ)| * (x ^ (5 * ε) * Δ₁) := by ac_rfl
        _ ≤ CK * ((w₁ : ℝ) * |Λ| * N) := hnum
        _ ≤ _ := mul_le_mul_of_nonneg_left
          (mul_le_mul_of_nonneg_right
            (mul_le_mul_of_nonneg_left hdyadicAbs hwReal.le) hN.le) hCK
    have hfrac : |η k| ≤ CK / x ^ (5 * ε) := by
      simpa only [η, abs_div, abs_mul, abs_of_pos hΔ₁, abs_of_pos hwReal,
        abs_of_pos hN] using (div_le_div_iff₀ hdenAbs hscalePow).mpr hcross
    simpa only [Real.rpow_neg hx0.le, div_eq_mul_inv] using hfrac
  have hone : ∀ k ∈ Kcut, |η k| ≤ 1 := by
    intro k hk
    refine (heta k hk).trans ?_
    rw [Real.rpow_neg hx0.le, ← div_eq_mul_inv]
    exact (div_le_one₀ hscalePow).mpr (hX₀ x hx).2.1
  have hsmall : ∀ k ∈ Kcut, ∀ d : ℕ, φ (τ d) ≠ 0 →
      |η k * τ d| ≤ CK * RD * x ^ (-(5 * ε)) := by
    intro k hk d hd
    have hsupport : τ d ∈ Set.Icc cD CD := hφsupport hd
    have htau : |τ d| ≤ RD := abs_le_max_abs_abs hsupport.1 hsupport.2
    calc
      |η k * τ d| = |η k| * |τ d| := abs_mul _ _
      _ ≤ (CK * x ^ (-(5 * ε))) * RD :=
        mul_le_mul (heta k hk) htau (abs_nonneg _)
          (mul_nonneg hCK (Real.rpow_nonneg hx0.le _))
      _ = CK * RD * x ^ (-(5 * ε)) := mul_right_comm _ _ _
  let a : ℤ → ℤ → ℝ := fun k n => ρ * ((n : ℝ) / N) + σ k
  let R : ℤ → ℕ → ℤ → ℂ := fun k d n =>
    ((η k * τ d) ^ (J + 1) / (Nat.factorial J : ℝ)) •
      ∫ u : ℝ in (0 : ℝ)..1,
        (1 - u) ^ J • iteratedDeriv (J + 1) ψ (a k n + u * (η k * τ d))
  let BP : ℝ := Cψ (J + 1) * (Real.log x) ^ Eψ (J + 1)
  have hBP : 0 ≤ BP := mul_nonneg (hCψ (J + 1)) (Real.rpow_nonneg hlog0 _)
  have hint (k : ℤ) (d : ℕ) (n : ℤ) :
      ‖∫ u : ℝ in (0 : ℝ)..1,
        (1 - u) ^ J • iteratedDeriv (J + 1) ψ (a k n + u * (η k * τ d))‖ ≤ BP := by
    calc
      _ ≤ BP * |(1 : ℝ) - 0| := by
        apply intervalIntegral.norm_integral_le_of_norm_le_const
        intro u hu
        have hu' : u ∈ Set.Ioc (0 : ℝ) 1 := by
          simpa only [Set.uIoc_of_le (show (0 : ℝ) ≤ 1 by norm_num)] using hu
        have hu0 : 0 ≤ 1 - u := sub_nonneg.mpr hu'.2
        have hu1 : 1 - u ≤ 1 := sub_le_self _ hu'.1.le
        rw [norm_smul, Real.norm_eq_abs, abs_of_nonneg (pow_nonneg hu0 J)]
        calc
          _ ≤ (1 - u) ^ J * BP := mul_le_mul_of_nonneg_left
            (hψbound (J + 1) _) (pow_nonneg hu0 J)
          _ ≤ 1 * BP := mul_le_mul_of_nonneg_right (pow_le_one₀ hu0 hu1) hBP
          _ = BP := one_mul _
      _ = BP := by simp
  have hRnorm (k : ℤ) (d : ℕ) (n : ℤ) :
      ‖R k d n‖ ≤ (|η k * τ d| ^ (J + 1) / (Nat.factorial J : ℝ)) * BP := by
    dsimp only [R]
    rw [norm_smul, Real.norm_eq_abs, abs_div, abs_pow, Nat.abs_cast]
    exact mul_le_mul_of_nonneg_left (hint k d n)
      (div_nonneg (pow_nonneg (abs_nonneg _) _) hfact)
  have hpowx : (x ^ (-(5 * ε))) ^ (J + 1) = x ^ (-α) := by
    simpa only [α, neg_mul] using
      (Real.rpow_mul_natCast hx0.le (-(5 * ε)) (J + 1)).symm
  have hp0 : 0 ≤ Cφ 0 * (Real.log x) ^ Eφ 0 :=
    mul_nonneg (hCφ 0) (Real.rpow_nonneg hlog0 _)
  have hn0 : 0 ≤ Cψ 0 * (Real.log x) ^ Eψ 0 :=
    mul_nonneg (hCψ 0) (Real.rpow_nonneg hlog0 _)
  have herr (k : ℤ) (hk : k ∈ Kcut) (d : ℕ) (n : ℤ) :
      ‖φ (τ d) * ψ ((n : ℝ) / N) * R k d n‖ ≤ x ^ (-B) := by
    by_cases hd : φ (τ d) = 0
    · simpa only [hd, zero_mul, norm_zero] using Real.rpow_nonneg hx0.le (-B)
    · have hφ0 : ‖φ (τ d)‖ ≤ Cφ 0 * (Real.log x) ^ Eφ 0 := by
        simpa only [iteratedDeriv_zero] using hφbound 0 (τ d)
      have hψ0 : ‖ψ ((n : ℝ) / N)‖ ≤ Cψ 0 * (Real.log x) ^ Eψ 0 := by
        simpa only [iteratedDeriv_zero] using hψbound 0 ((n : ℝ) / N)
      calc
        _ = ‖φ (τ d)‖ * ‖ψ ((n : ℝ) / N)‖ * ‖R k d n‖ := by
          rw [norm_mul, norm_mul]
        _ ≤ (Cφ 0 * (Real.log x) ^ Eφ 0) * (Cψ 0 * (Real.log x) ^ Eψ 0) *
            ((|η k * τ d| ^ (J + 1) / (Nat.factorial J : ℝ)) * BP) :=
          mul_le_mul (mul_le_mul hφ0 hψ0 (norm_nonneg _) hp0)
            (hRnorm k d n) (norm_nonneg _) (mul_nonneg hp0 hn0)
        _ ≤ (Cφ 0 * (Real.log x) ^ Eφ 0) * (Cψ 0 * (Real.log x) ^ Eψ 0) *
            (((CK * RD * x ^ (-(5 * ε))) ^ (J + 1) / (Nat.factorial J : ℝ)) * BP) :=
          mul_le_mul_of_nonneg_left
            (mul_le_mul_of_nonneg_right
              (div_le_div_of_nonneg_right
                (pow_le_pow_left₀ (abs_nonneg _) (hsmall k hk d hd) _) hfact) hBP)
            (mul_nonneg hp0 hn0)
        _ = Q * (Real.log x) ^ E * x ^ (-α) := by
          rw [mul_pow, hpowx]
          dsimp only [Q, BP]
          calc
            _ = (Cφ 0 * Cψ 0 * Cψ (J + 1) * (CK * RD) ^ (J + 1) / (Nat.factorial J : ℝ)) *
                ((Real.log x) ^ Eφ 0 * (Real.log x) ^ Eψ 0 *
                  (Real.log x) ^ Eψ (J + 1)) * x ^ (-α) := by
              simp only [div_eq_mul_inv]
              ac_rfl
            _ = _ := by simp only [E, Real.rpow_add hlogpos]
        _ ≤ x ^ (α - B) * x ^ (-α) :=
          mul_le_mul_of_nonneg_right (hX₀ x hx).2.2 (Real.rpow_nonneg hx0.le _)
        _ = x ^ (-B) := by
          rw [← Real.rpow_add hx0, sub_eq_add_neg, add_neg_cancel_comm]
  have hid :=
    (sourceTerminalTaylor_finite_separation J φ ψ
      ((contDiff_infty.mp hψsmooth) (J + 1)) Δ₁ N hΔ₁ hN w₁ z₁ hw₁ hz₁ hwz
      lam lamTilde d₀ hlam0 Kcut D I A).2
  refine ⟨hrho, fun k hk => ⟨hone k hk, hsmall k hk⟩, ?_⟩
  rw [hid, add_sub_cancel_left]
  calc
    ‖∑ k ∈ Kcut, ∑ d ∈ D, ∑ n ∈ I,
        A k d n * φ (τ d) * ψ ((n : ℝ) / N) * R k d n‖ ≤
        ∑ k ∈ Kcut, ∑ d ∈ D, ∑ n ∈ I, x ^ (-B) * ‖A k d n‖ := by
      refine norm_sum_le_of_le _ fun k hk =>
        norm_sum_le_of_le _ fun d _ =>
          norm_sum_le_of_le _ fun n _ => ?_
      calc
        _ = ‖A k d n‖ * ‖φ (τ d) * ψ ((n : ℝ) / N) * R k d n‖ := by
          simp only [norm_mul, mul_assoc]
        _ ≤ ‖A k d n‖ * x ^ (-B) :=
          mul_le_mul_of_nonneg_left (herr k hk d n) (norm_nonneg _)
        _ = x ^ (-B) * ‖A k d n‖ := mul_comm _ _
    _ = x ^ (-B) * ∑ k ∈ Kcut, ∑ d ∈ D, ∑ n ∈ I, ‖A k d n‖ := by
      simp only [Finset.mul_sum]

end

section
open scoped ContDiff
/--
The integer-sample Fourier transform of `ψM (t / M)` at frequency `h / (d * R)`, normalized by
`1 / M` and using the negative Fourier phase. The dilation factor `d` is real rather than
restricted to an integer modulus.
-/
noncomputable def sourcePhiRealFactor
    (ψM : ℝ → ℝ) (M : ℝ) (R : ℕ) (h : ℤ) (d : ℝ) : ℂ :=
  (M : ℂ)⁻¹ * ∑' t : ℤ, (ψM ((t : ℝ) / M) : ℂ) *
    (Real.fourierChar (-((t : ℝ) * (h : ℝ) / (d * (R : ℝ)))) : ℂ)

theorem sourcePhiRealFactor_sampling_and_norm
    (c T M L : ℝ) (hc : 0 < c) (hcT : c ≤ T) (hM : 0 < M) (hL : 0 ≤ L)
    (ψ : ℝ → ℝ) (hsupport : Function.support ψ ⊆ Set.Icc c T)
    (hbound : ∀ t : ℝ, |ψ t| ≤ L) (R : ℕ) (h : ℤ) :
    let sm : Finset ℕ := Finset.Icc 1 ⌊T * M⌋₊
    (∀ d : ℝ, sourcePhiRealFactor ψ M R h d =
      (M : ℂ)⁻¹ * ∑ t ∈ sm, (ψ ((t : ℝ) / M) : ℂ) *
        (Real.fourierChar (-((t : ℝ) * (h : ℝ) / (d * (R : ℝ)))) : ℂ)) ∧
    (∀ d : ℕ, sourcePhiRealFactor ψ M R h (d : ℝ) =
      sourcePhi ψ M (d * R) h) ∧
    ∀ d : ℝ, ‖sourcePhiRealFactor ψ M R h d‖ ≤ T * L := by
  intro sm
  have hsample (d : ℝ) : sourcePhiRealFactor ψ M R h d =
      (M : ℂ)⁻¹ * ∑ t ∈ sm, (ψ ((t : ℝ) / M) : ℂ) *
        (Real.fourierChar (-((t : ℝ) * (h : ℝ) / (d * (R : ℝ)))) : ℂ) := by
    unfold sourcePhiRealFactor
    congr 1
    calc
      (∑' t : ℤ, (ψ ((t : ℝ) / M) : ℂ) *
          (Real.fourierChar (-((t : ℝ) * (h : ℝ) / (d * (R : ℝ)))) : ℂ)) =
          ∑ t ∈ sm.map (Nat.castEmbedding (R := ℤ)),
            (ψ ((t : ℝ) / M) : ℂ) *
              (Real.fourierChar (-((t : ℝ) * (h : ℝ) / (d * (R : ℝ)))) : ℂ) := by
        apply tsum_eq_sum
        intro t ht
        have hbad : ¬(0 ≤ t ∧ t.toNat ∈ sm) := by
          intro hgood
          apply ht
          exact Finset.mem_map.mpr ⟨t.toNat, hgood.2, by
            simpa only [Nat.castEmbedding_apply] using Int.toNat_of_nonneg hgood.1⟩
        rw [← positiveCompactProfile_complete_nat_sampling c T M hc hcT hM
          ψ hsupport t, ite_eq_right hbad, zero_mul]
      _ = _ := by
        simp only [Finset.sum_map, Nat.castEmbedding_apply, Int.cast_natCast]
  refine ⟨hsample, ?_, ?_⟩
  · intro d
    delta sourcePhiRealFactor sourcePhi
    rw [Nat.cast_mul]
  · intro d
    have hsum :
        ‖∑ t ∈ sm, (ψ ((t : ℝ) / M) : ℂ) *
          (Real.fourierChar (-((t : ℝ) * (h : ℝ) / (d * (R : ℝ)))) : ℂ)‖ ≤
          (sm.card : ℝ) * L := by
      calc
        _ ≤ ∑ _t ∈ sm, L := norm_sum_le_of_le sm fun t _ => by
          simpa only [norm_mul, Complex.norm_real, Real.norm_eq_abs,
            Circle.norm_coe, mul_one] using hbound ((t : ℝ) / M)
        _ = _ := by simp
    have hcard : (sm.card : ℝ) ≤ T * M := by
      simpa [sm, Nat.card_Icc] using
        Nat.floor_le (mul_nonneg (hc.le.trans hcT) hM.le)
    rw [hsample d, norm_mul, norm_inv, Complex.norm_of_nonneg hM.le]
    calc
      _ ≤ M⁻¹ * ((sm.card : ℝ) * L) :=
        mul_le_mul_of_nonneg_left hsum (inv_nonneg.mpr hM.le)
      _ ≤ M⁻¹ * ((T * M) * L) :=
        mul_le_mul_of_nonneg_left (mul_le_mul_of_nonneg_right hcard hL)
          (inv_nonneg.mpr hM.le)
      _ = (M⁻¹ * M) * (T * L) := by ring
      _ = T * L := by rw [inv_mul_cancel₀ hM.ne', one_mul]

theorem sourcePhiRealFactor_iteratedDeriv_bound
    (j : ℕ) (c T M H L : ℝ)
    (hc : 0 < c) (hcT : c ≤ T) (hM : 0 < M) (hH : 0 ≤ H) (hL : 0 ≤ L)
    (ψ : ℝ → ℝ) (hsupport : Function.support ψ ⊆ Set.Icc c T)
    (hbound : ∀ t : ℝ, |ψ t| ≤ L)
    (R : ℕ) (hR : 0 < R) (h : ℤ) (hh : |(h : ℝ)| ≤ H) :
    ContDiffOn ℝ ∞ (sourcePhiRealFactor ψ M R h) (Set.Ioi 0) ∧
    ∀ d : ℝ, 0 < d →
      d ^ j * ‖iteratedDeriv j (sourcePhiRealFactor ψ M R h) d‖ ≤
        (T * L) * (j.factorial : ℝ) ^ (j + 1) * (1 + 2 * Real.pi) ^ j *
          (1 + T * M * H / (d * (R : ℝ))) ^ j := by
  let χ : ℝ → ℂ := fun x => (Real.fourierChar x : ℂ)
  let κ : ℂ := (2 * Real.pi : ℂ) * Complex.I
  have hχsmooth : ContDiff ℝ ∞ χ := by
    change ContDiff ℝ ∞ (fun x : ℝ =>
      Complex.exp (Complex.ofRealCLM (2 * Real.pi * x) * Complex.I))
    fun_prop
  have hχiter : ∀ i : ℕ, ∀ x : ℝ,
      iteratedDeriv i χ x = κ ^ i * χ x := by
    intro i
    induction i with
    | zero => simp
    | succ i hi =>
        intro x
        rw [iteratedDeriv_succ, funext hi]
        simpa only [χ, κ, pow_succ, mul_assoc] using
          ((Real.hasDerivAt_fourierChar x).const_mul (κ ^ i)).deriv
  have htwoπ : 0 ≤ 2 * Real.pi := by positivity
  have hκnorm : ‖κ‖ = 2 * Real.pi := by
    simp only [κ, norm_mul, Complex.norm_ofNat, Complex.norm_real,
      Real.norm_eq_abs, abs_of_pos Real.pi_pos, Complex.norm_I, mul_one]
  have hχbound (i : ℕ) (hij : i ≤ j) (x : ℝ) :
      ‖iteratedDeriv i χ x‖ ≤ (1 + 2 * Real.pi) ^ j := by
    rw [hχiter i x, norm_mul, norm_pow, hκnorm, Circle.norm_coe, mul_one]
    calc
      (2 * Real.pi) ^ i ≤ (1 + 2 * Real.pi) ^ i :=
        pow_le_pow_left₀ htwoπ (le_add_of_nonneg_left zero_le_one) i
      _ ≤ (1 + 2 * Real.pi) ^ j :=
        pow_le_pow_right₀ (le_add_of_nonneg_right htwoπ) hij
  have hinvSmooth (a : ℝ) :
      ContDiffOn ℝ ∞ (fun d : ℝ => a / d) (Set.Ioi 0) :=
    contDiffOn_const.div contDiffOn_id (fun _ hd => ne_of_gt hd)
  have hrecip (i : ℕ) (a d : ℝ) (hd : 0 < d) :
      ‖iteratedDeriv i (fun x : ℝ => a / x) d‖ =
        (i.factorial : ℝ) * (|a| / d) / d ^ i := by
    rw [funext (div_eq_mul_inv a), iteratedDeriv_const_mul_field,
      iteratedDeriv_eq_iterate, iter_deriv_inv, zpow_sub₀ hd.ne',
      zpow_neg_one, zpow_natCast]
    simp only [norm_mul, norm_pow, norm_neg, norm_one, one_pow, one_mul,
      norm_div, norm_inv, Real.norm_eq_abs, abs_of_pos hd, Nat.abs_cast]
    simp only [div_eq_mul_inv]
    ring
  have hjfac : (1 : ℝ) ≤ (j.factorial : ℝ) :=
    Nat.one_le_cast.mpr (Nat.factorial_pos j)
  have hinner (a d : ℝ) (hd : 0 < d) (i : ℕ) (hi : 1 ≤ i) (hij : i ≤ j) :
      ‖iteratedDeriv i (fun x : ℝ => a / x) d‖ ≤
        ((j.factorial : ℝ) * (1 + |a| / d) / d) ^ i := by
    have hv : 0 ≤ |a| / d := div_nonneg (abs_nonneg a) hd.le
    have hfac : (i.factorial : ℝ) ≤ (j.factorial : ℝ) ^ i :=
      (Nat.cast_le.mpr (Nat.factorial_le hij)).trans (Bound.le_self_pow_of_pos hjfac hi)
    have hvpow : |a| / d ≤ (1 + |a| / d) ^ i :=
      (le_add_of_nonneg_left zero_le_one).trans
        (Bound.le_self_pow_of_pos (le_add_of_nonneg_right hv) hi)
    rw [hrecip i a d hd]
    calc
      _ ≤ ((j.factorial : ℝ) ^ i * (1 + |a| / d) ^ i) / d ^ i :=
        div_le_div_of_nonneg_right
          (mul_le_mul hfac hvpow hv (pow_nonneg (Nat.cast_nonneg _) _))
          (pow_nonneg hd.le i)
      _ = _ := by rw [div_pow, mul_pow]
  have hcharacter (a d : ℝ) (hd : 0 < d) :
      d ^ j * ‖iteratedDeriv j (fun x : ℝ => χ (a / x)) d‖ ≤
        (j.factorial : ℝ) ^ (j + 1) * (1 + 2 * Real.pi) ^ j *
          (1 + |a| / d) ^ j := by
    have hcomp :
        ‖iteratedFDerivWithin ℝ j (χ ∘ fun x : ℝ => a / x) (Set.Ioi 0) d‖ ≤
          (j.factorial : ℝ) * (1 + 2 * Real.pi) ^ j *
            ((j.factorial : ℝ) * (1 + |a| / d) / d) ^ j := by
      apply norm_iteratedFDerivWithin_comp_le hχsmooth.contDiffOn (hinvSmooth a)
        (by simp) uniqueDiffOn_univ (uniqueDiffOn_Ioi 0) (Set.mapsTo_univ _ _) hd
      · intro i hij
        rw [iteratedFDerivWithin_univ, norm_iteratedFDeriv_eq_norm_iteratedDeriv]
        exact hχbound i hij (a / d)
      · intro i hi hij
        rw [norm_iteratedFDerivWithin_eq_norm_iteratedDerivWithin,
          iteratedDerivWithin_of_isOpen isOpen_Ioi hd]
        exact hinner a d hd i hi hij
    rw [norm_iteratedFDerivWithin_eq_norm_iteratedDerivWithin,
      iteratedDerivWithin_of_isOpen isOpen_Ioi hd] at hcomp
    calc
      _ ≤ d ^ j * ((j.factorial : ℝ) * (1 + 2 * Real.pi) ^ j *
          ((j.factorial : ℝ) * (1 + |a| / d) / d) ^ j) :=
        mul_le_mul_of_nonneg_left hcomp (pow_nonneg hd.le j)
      _ = ((j.factorial : ℝ) * (1 + 2 * Real.pi) ^ j) *
          ((j.factorial : ℝ) * (1 + |a| / d)) ^ j := by
        rw [div_pow, ← mul_div_assoc, ← mul_div_assoc,
          mul_div_cancel_left₀ _ (pow_ne_zero j hd.ne')]
      _ = _ := by rw [mul_pow, pow_succ]; ring
  let sm : Finset ℕ := Finset.Icc 1 ⌊T * M⌋₊
  let a : ℕ → ℝ := fun t => -((t : ℝ) * (h : ℝ) / (R : ℝ))
  have hphase (t : ℕ) (d : ℝ) :
      -((t : ℝ) * (h : ℝ) / (d * (R : ℝ))) = a t / d := by
    simp only [a, neg_div, div_div, mul_comm]
  have hPhi : sourcePhiRealFactor ψ M R h = fun d : ℝ =>
      (M : ℂ)⁻¹ * ∑ t ∈ sm, (ψ ((t : ℝ) / M) : ℂ) * χ (a t / d) := by
    funext d
    simpa only [hphase] using
      (sourcePhiRealFactor_sampling_and_norm c T M L hc hcT hM hL ψ hsupport
        hbound R h).1 d
  have hsmooth (t : ℕ) : ContDiffOn ℝ ∞
      (fun d : ℝ => (ψ ((t : ℝ) / M) : ℂ) * χ (a t / d)) (Set.Ioi 0) :=
    contDiffOn_const.mul (hχsmooth.comp_contDiffOn (hinvSmooth (a t)))
  refine ⟨?_, ?_⟩
  · rw [hPhi]
    exact contDiffOn_const.mul (ContDiffOn.sum fun t _ => hsmooth t)
  · intro d hd
    have hTM : 0 ≤ T * M := mul_nonneg (hc.le.trans hcT) hM.le
    have hRreal : (0 : ℝ) < (R : ℝ) := Nat.cast_pos.mpr hR
    let E : ℝ := (j.factorial : ℝ) ^ (j + 1) * (1 + 2 * Real.pi) ^ j *
      (1 + T * M * H / (d * (R : ℝ))) ^ j
    have hE : 0 ≤ E := by dsimp [E]; positivity
    have hterm (t : ℕ) (ht : t ∈ sm) :
        d ^ j * ‖iteratedDeriv j (fun x : ℝ => χ (a t / x)) d‖ ≤ E := by
      have htM : (t : ℝ) ≤ T * M :=
        (Nat.le_floor_iff hTM).mp (Finset.mem_Icc.mp ht).2
      have hab : |a t| ≤ T * M * H / (R : ℝ) := by
        simp only [a, abs_neg, abs_div, abs_mul, Nat.abs_cast, abs_of_pos hRreal]
        exact div_le_div_of_nonneg_right
          (mul_le_mul htM hh (abs_nonneg _) hTM) hRreal.le
      have habd : |a t| / d ≤ T * M * H / (d * (R : ℝ)) := by
        simpa only [div_div, mul_comm (R : ℝ) d] using
          div_le_div_of_nonneg_right hab hd.le
      exact (hcharacter (a t) d hd).trans
        (mul_le_mul_of_nonneg_left
          (pow_le_pow_left₀ (by positivity) (add_le_add_right habd 1) j)
          (by positivity))
    have hcard : (sm.card : ℝ) ≤ T * M := by
      simpa [sm, Nat.card_Icc] using Nat.floor_le hTM
    have hdiff (t : ℕ) (_ht : t ∈ sm) : ContDiffAt ℝ j
        (fun x : ℝ => (ψ ((t : ℝ) / M) : ℂ) * χ (a t / x)) d :=
      ((hsmooth t).contDiffAt (isOpen_Ioi.mem_nhds hd)).of_le (by simp)
    rw [hPhi, iteratedDeriv_const_mul_field, iteratedDeriv_fun_sum hdiff]
    simp only [iteratedDeriv_const_mul_field]
    rw [norm_mul, norm_inv, Complex.norm_of_nonneg hM.le]
    calc
      _ ≤ d ^ j * (M⁻¹ * ∑ t ∈ sm,
          ‖(ψ ((t : ℝ) / M) : ℂ) *
            iteratedDeriv j (fun x : ℝ => χ (a t / x)) d‖) :=
        mul_le_mul_of_nonneg_left
          (mul_le_mul_of_nonneg_left (norm_sum_le _ _) (inv_nonneg.mpr hM.le))
          (pow_nonneg hd.le j)
      _ = M⁻¹ * ∑ t ∈ sm, |ψ ((t : ℝ) / M)| *
          (d ^ j * ‖iteratedDeriv j (fun x : ℝ => χ (a t / x)) d‖) := by
        simp only [norm_mul, Complex.norm_real, Real.norm_eq_abs,
          Finset.mul_sum, mul_left_comm]
      _ ≤ M⁻¹ * ∑ _t ∈ sm, L * E :=
        mul_le_mul_of_nonneg_left
          (Finset.sum_le_sum fun t ht =>
            mul_le_mul (hbound ((t : ℝ) / M)) (hterm t ht)
              (mul_nonneg (pow_nonneg hd.le j) (norm_nonneg _)) hL)
          (inv_nonneg.mpr hM.le)
      _ = M⁻¹ * ((sm.card : ℝ) * (L * E)) := by simp
      _ ≤ M⁻¹ * ((T * M) * (L * E)) :=
        mul_le_mul_of_nonneg_left
          (mul_le_mul_of_nonneg_right hcard (mul_nonneg hL hE))
          (inv_nonneg.mpr hM.le)
      _ = (M⁻¹ * M) * ((T * L) * E) := by ring
      _ = (T * L) * E := by rw [inv_mul_cancel₀ hM.ne', one_mul]
      _ = _ := by dsimp [E]; ring

theorem sourcePhi_fourfold_common_cutoff_taylor (J : ℕ) :
    ∃ C : ℝ, 0 < C ∧
      ∀ (ι : Type*) [DecidableEq ι] (I : Finset ι)
        (c T M H L d₀ δ D : ℝ)
        (_ : 0 < c) (_ : c ≤ T) (_ : 0 < M)
        (_ : 0 ≤ H) (_ : 0 ≤ L) (_ : 0 < d₀) (_ : 0 < δ) (_ : 0 ≤ D)
        (ψ : ℝ → ℝ) (_ : Function.support ψ ⊆ Set.Icc c T)
        (_ : ∀ t : ℝ, |ψ t| ≤ L)
        (r₁ q₀ u₁ v₁ v₂ q₂ : ℕ)
        (_ : 0 < r₁ * q₀ * u₁ * v₁ * q₂ ∧
          0 < r₁ * q₀ * u₁ * v₂ * q₂)
        (h : ι → Fin 4 → ℤ) (_ : ∀ a ∈ I, ∀ i, |(h a i : ℝ)| ≤ H),
      let R₁ : ℕ := r₁ * q₀ * u₁ * v₁ * q₂
      let R₂ : ℕ := r₁ * q₀ * u₁ * v₂ * q₂
      let F : ι → ℝ → ℂ := fun a d =>
        sourcePhiRealFactor ψ M R₁ (h a 0) d *
          star (sourcePhiRealFactor ψ M R₂ (h a 1) d) *
          star (sourcePhiRealFactor ψ M R₁ (h a 2) d) *
          sourcePhiRealFactor ψ M R₂ (h a 3) d
      let S : ℝ := δ / d₀ *
        (1 + T * M * H / d₀ * ((R₁ : ℝ)⁻¹ + (R₂ : ℝ)⁻¹))
      let coeff : ι → ℕ → ℂ := fun a j =>
        (δ ^ j / (j.factorial : ℝ)) • iteratedDeriv j (F a) d₀
      (∀ a ∈ I, ∀ j ≤ J, ‖coeff a j‖ ≤ C * (T * L) ^ 4 * S ^ j) ∧
      ∀ (χ : ℝ → ℝ) (_ : Function.support χ ⊆ Set.Icc 0 (D * δ))
        (A : ℝ → ι → ℂ) (d : ℝ),
        ‖(χ (d - d₀) : ℂ) * (∑ a ∈ I, A d a * F a d) -
          ∑ j ∈ Finset.range (J + 1),
            ((χ (d - d₀) * ((d - d₀) / δ) ^ j : ℝ) : ℂ) *
              (∑ a ∈ I, A d a * coeff a j)‖ ≤
          |χ (d - d₀)| * C * (T * L) ^ 4 * (D * S) ^ (J + 1) *
            (∑ a ∈ I, ‖A d a‖) := by
  let N : ℕ := J + 1
  let K : ℝ := (N.factorial : ℝ) ^ (N + 1) * (1 + 2 * Real.pi) ^ N
  let C : ℝ := 4 ^ N * K ^ 4
  have hKpos : 0 < K := by dsimp [K]; positivity
  have hCpos : 0 < C := by dsimp [C]; positivity
  refine ⟨C, hCpos, ?_⟩
  intro ι _ I c T M H L d₀ δ D hc hcT hM hH hL hd₀ hδ hD ψ hsupport
    hbound r₁ q₀ u₁ v₁ v₂ q₂ hperiods h hh R₁ R₂ F S coeff
  have hT : 0 < T := hc.trans_le hcT
  have hTL : 0 ≤ T * L := mul_nonneg hT.le hL
  have hTMH : 0 ≤ T * M * H := by positivity
  have hR₁ : 0 < (R₁ : ℝ) := Nat.cast_pos.mpr hperiods.1
  have hR₂ : 0 < (R₂ : ℝ) := Nat.cast_pos.mpr hperiods.2
  let G : ℝ := 1 + T * M * H / d₀ * ((R₁ : ℝ)⁻¹ + (R₂ : ℝ)⁻¹)
  let Z : ℝ := G / d₀
  have hGpos : 0 < G := by dsimp [G]; positivity
  have hZpos : 0 < Z := div_pos hGpos hd₀
  have hS : S = δ * Z := by dsimp [S, Z, G]; ring
  have hfac (j : ℕ) : (1 : ℝ) ≤ (j.factorial : ℝ) :=
    Nat.one_le_cast.mpr (Nat.factorial_pos j)
  have hKbound (j : ℕ) (hj : j ≤ N) :
      (j.factorial : ℝ) ^ (j + 1) * (1 + 2 * Real.pi) ^ j ≤ K := by
    have hjN : (j.factorial : ℝ) ≤ (N.factorial : ℝ) :=
      Nat.cast_le.mpr (Nat.factorial_le hj)
    calc
      _ ≤ (N.factorial : ℝ) ^ (j + 1) * (1 + 2 * Real.pi) ^ j := by gcongr
      _ ≤ (N.factorial : ℝ) ^ (N + 1) * (1 + 2 * Real.pi) ^ N :=
        mul_le_mul (pow_le_pow_right₀ (hfac N) (Nat.add_le_add_right hj 1))
          (pow_le_pow_right₀ (by linarith [Real.pi_pos]) hj) (by positivity) (by positivity)
  have hmul (f g : ℝ → ℂ) (U V P Q x : ℝ)
      (hf : ContDiffAt ℝ ∞ f x) (hg : ContDiffAt ℝ ∞ g x)
      (hbf : ∀ i ≤ N, ‖iteratedDeriv i f x‖ ≤ U * P ^ i)
      (hbg : ∀ i ≤ N, ‖iteratedDeriv i g x‖ ≤ V * Q ^ i) :
      ∀ j ≤ N, ‖iteratedDeriv j (fun y => f y * g y) x‖ ≤
        U * V * (P + Q) ^ j := by
    intro j hj
    rw [iteratedDeriv_fun_mul (n := j) (hf.of_le (by simp)) (hg.of_le (by simp))]
    calc
      _ ≤ ∑ i ∈ Finset.range (j + 1),
          (j.choose i : ℝ) * (U * P ^ i) * (V * Q ^ (j - i)) := by
        apply norm_sum_le_of_le
        intro i hi
        have hij : i ≤ j := Nat.le_of_lt_succ (Finset.mem_range.mp hi)
        exact norm_mul_le_of_le
          (norm_mul_le_of_le (le_of_eq (Complex.norm_natCast (j.choose i)))
            (hbf i (hij.trans hj)))
          (hbg (j - i) ((Nat.sub_le j i).trans hj))
      _ = U * V * (P + Q) ^ j := by
        rw [add_pow, Finset.mul_sum]
        apply Finset.sum_congr rfl
        intro i _
        ring
  have hstar (f : ℝ → ℂ) (x : ℝ) (j : ℕ) :
      ‖iteratedDeriv j (fun y => star (f y)) x‖ = ‖iteratedDeriv j f x‖ := by
    simpa only [Function.comp_def, Complex.conjLIE_apply, Complex.star_def,
      norm_iteratedFDeriv_eq_norm_iteratedDeriv] using
      Complex.conjLIE.norm_iteratedFDeriv_comp_left f x j
  have hphase (R : ℕ) (hR : 0 < R)
      (hRi : (R : ℝ)⁻¹ ≤ (R₁ : ℝ)⁻¹ + (R₂ : ℝ)⁻¹)
      (k : ℤ) (hk : |(k : ℝ)| ≤ H) :
      ContDiffOn ℝ ∞ (sourcePhiRealFactor ψ M R k) (Set.Ioi 0) ∧
      ∀ x : ℝ, d₀ ≤ x → ∀ j ≤ N,
        ‖iteratedDeriv j (sourcePhiRealFactor ψ M R k) x‖ ≤ T * L * K * Z ^ j := by
    refine ⟨(sourcePhiRealFactor_iteratedDeriv_bound 0 c T M H L hc hcT hM hH hL
      ψ hsupport hbound R hR k hk).1, ?_⟩
    intro x hx j hj
    have hxpos : 0 < x := hd₀.trans_le hx
    have hRpos : 0 < (R : ℝ) := Nat.cast_pos.mpr hR
    have hratio : 1 + T * M * H / (x * (R : ℝ)) ≤ G := by
      have hden : T * M * H / (x * (R : ℝ)) ≤
          T * M * H / d₀ * ((R₁ : ℝ)⁻¹ + (R₂ : ℝ)⁻¹) := by
        calc
          _ = T * M * H * x⁻¹ * (R : ℝ)⁻¹ := by
            simp only [div_eq_mul_inv, mul_inv_rev]
            ring
          _ ≤ T * M * H * d₀⁻¹ * (R : ℝ)⁻¹ :=
            mul_le_mul_of_nonneg_right
              (mul_le_mul_of_nonneg_left (inv_anti₀ hd₀ hx) hTMH)
              (inv_nonneg.mpr hRpos.le)
          _ ≤ T * M * H * d₀⁻¹ * ((R₁ : ℝ)⁻¹ + (R₂ : ℝ)⁻¹) :=
            mul_le_mul_of_nonneg_left hRi (mul_nonneg hTMH (inv_nonneg.mpr hd₀.le))
          _ = _ := by rw [div_eq_mul_inv]
      exact add_le_add_right hden 1
    have hraw := (sourcePhiRealFactor_iteratedDeriv_bound j c T M H L hc hcT hM
      hH hL ψ hsupport hbound R hR k hk).2 x hxpos
    have hscaled :
        d₀ ^ j * ‖iteratedDeriv j (sourcePhiRealFactor ψ M R k) x‖ ≤
          T * L * K * G ^ j := by
      calc
        _ ≤ x ^ j * ‖iteratedDeriv j (sourcePhiRealFactor ψ M R k) x‖ :=
          mul_le_mul_of_nonneg_right (pow_le_pow_left₀ hd₀.le hx j) (norm_nonneg _)
        _ ≤ T * L * (j.factorial : ℝ) ^ (j + 1) * (1 + 2 * Real.pi) ^ j *
            (1 + T * M * H / (x * (R : ℝ))) ^ j := hraw
        _ = T * L * ((j.factorial : ℝ) ^ (j + 1) * (1 + 2 * Real.pi) ^ j) *
            (1 + T * M * H / (x * (R : ℝ))) ^ j := by ring
        _ ≤ T * L * K * G ^ j :=
          mul_le_mul (mul_le_mul_of_nonneg_left (hKbound j hj) hTL)
            (pow_le_pow_left₀ (by positivity) hratio j) (by positivity) (by positivity)
    dsimp only [Z]
    rw [div_pow, ← mul_div_assoc]
    exact (le_div_iff₀ (pow_pos hd₀ j)).2 (by simpa [mul_comm] using hscaled)
  have hF :
      ∀ a ∈ I, ContDiffOn ℝ ∞ (F a) (Set.Ioi 0) ∧
        ∀ x : ℝ, d₀ ≤ x → ∀ j ≤ N,
          ‖iteratedDeriv j (F a) x‖ ≤ C * (T * L) ^ 4 * Z ^ j := by
    intro a ha
    let f₀ : ℝ → ℂ := sourcePhiRealFactor ψ M R₁ (h a 0)
    let f₁ : ℝ → ℂ := sourcePhiRealFactor ψ M R₂ (h a 1)
    let f₂ : ℝ → ℂ := sourcePhiRealFactor ψ M R₁ (h a 2)
    let f₃ : ℝ → ℂ := sourcePhiRealFactor ψ M R₂ (h a 3)
    rcases hphase R₁ hperiods.1 (le_add_of_nonneg_right (inv_nonneg.mpr hR₂.le))
      (h a 0) (hh a ha 0) with ⟨hf₀, hb₀⟩
    rcases hphase R₂ hperiods.2 (le_add_of_nonneg_left (inv_nonneg.mpr hR₁.le))
      (h a 1) (hh a ha 1) with ⟨hf₁, hb₁⟩
    rcases hphase R₁ hperiods.1 (le_add_of_nonneg_right (inv_nonneg.mpr hR₂.le))
      (h a 2) (hh a ha 2) with ⟨hf₂, hb₂⟩
    rcases hphase R₂ hperiods.2 (le_add_of_nonneg_left (inv_nonneg.mpr hR₁.le))
      (h a 3) (hh a ha 3) with ⟨hf₃, hb₃⟩
    have hs₁ : ContDiffOn ℝ ∞ (fun x => star (f₁ x)) (Set.Ioi 0) := by
      simpa only [Function.comp_def, Complex.conjCLE_apply, Complex.star_def] using
        Complex.conjCLE.contDiff.comp_contDiffOn hf₁
    have hs₂ : ContDiffOn ℝ ∞ (fun x => star (f₂ x)) (Set.Ioi 0) := by
      simpa only [Function.comp_def, Complex.conjCLE_apply, Complex.star_def] using
        Complex.conjCLE.contDiff.comp_contDiffOn hf₂
    refine ⟨((hf₀.mul hs₁).mul hs₂).mul hf₃, ?_⟩
    intro x hx j hj
    have hxpos : 0 < x := hd₀.trans_le hx
    have hat₀ := hf₀.contDiffAt (isOpen_Ioi.mem_nhds hxpos)
    have hat₁ := hs₁.contDiffAt (isOpen_Ioi.mem_nhds hxpos)
    have hat₂ := hs₂.contDiffAt (isOpen_Ioi.mem_nhds hxpos)
    have hat₃ := hf₃.contDiffAt (isOpen_Ioi.mem_nhds hxpos)
    have hsbound₁ : ∀ i ≤ N,
        ‖iteratedDeriv i (fun y => star (f₁ y)) x‖ ≤ T * L * K * Z ^ i := by
      intro i hi
      rw [hstar]
      exact hb₁ x hx i hi
    have hsbound₂ : ∀ i ≤ N,
        ‖iteratedDeriv i (fun y => star (f₂ y)) x‖ ≤ T * L * K * Z ^ i := by
      intro i hi
      rw [hstar]
      exact hb₂ x hx i hi
    have hb₀₁ := hmul f₀ (fun y => star (f₁ y)) (T * L * K) (T * L * K) Z Z x
      hat₀ hat₁ (hb₀ x hx) hsbound₁
    have hb₂₃ := hmul (fun y => star (f₂ y)) f₃ (T * L * K) (T * L * K) Z Z x
      hat₂ hat₃ hsbound₂ (hb₃ x hx)
    have hfour := hmul (fun y => f₀ y * star (f₁ y))
      (fun y => star (f₂ y) * f₃ y) ((T * L * K) * (T * L * K))
      ((T * L * K) * (T * L * K)) (Z + Z) (Z + Z) x
      (hat₀.mul hat₁) (hat₂.mul hat₃) hb₀₁ hb₂₃ j hj
    calc
      _ ≤ ((T * L * K) * (T * L * K)) *
          ((T * L * K) * (T * L * K)) * ((Z + Z) + (Z + Z)) ^ j := by
        simpa only [F, f₀, f₁, f₂, f₃, mul_assoc] using hfour
      _ = (T * L) ^ 4 * K ^ 4 * (4 : ℝ) ^ j * Z ^ j := by
        rw [show (Z + Z) + (Z + Z) = 4 * Z by ring, mul_pow]
        ring
      _ ≤ (T * L) ^ 4 * K ^ 4 * (4 : ℝ) ^ N * Z ^ j := by
        have hfourpow : (4 : ℝ) ^ j ≤ 4 ^ N := pow_le_pow_right₀ (by norm_num) hj
        exact mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left hfourpow (by positivity)) (by positivity)
      _ = C * (T * L) ^ 4 * Z ^ j := by dsimp [C]; ring
  refine ⟨?_, ?_⟩
  · intro a ha j hj
    have hb := (hF a ha).2 d₀ le_rfl j (hj.trans (Nat.le_succ J))
    dsimp only [coeff]
    rw [norm_smul_of_nonneg (by positivity)]
    calc
      _ ≤ δ ^ j * (C * (T * L) ^ 4 * Z ^ j) :=
        mul_le_mul (div_le_self (pow_nonneg hδ.le j) (hfac j)) hb
          (norm_nonneg _) (pow_nonneg hδ.le j)
      _ = C * (T * L) ^ 4 * S ^ j := by
        rw [hS, mul_pow δ Z j]
        exact mul_left_comm (δ ^ j) (C * (T * L) ^ 4) (Z ^ j)
  · intro χ hχ A d
    by_cases hχd : χ (d - d₀) = 0
    · simp [hχd]
    have hsχ : d - d₀ ∈ Set.Icc 0 (D * δ) := hχ hχd
    have hstep : 0 ≤ d - d₀ := hsχ.1
    let b : ℝ := d₀ + (D + 1) * δ
    have hb : d₀ < b := by
      dsimp [b]
      exact lt_add_of_pos_right d₀ (mul_pos (by linarith) hδ)
    have hd : d ∈ Set.Icc d₀ b := by
      refine ⟨sub_nonneg.mp hsχ.1, ?_⟩
      dsimp [b]
      nlinarith [hsχ.2]
    have hwithin (a : ι) (ha : a ∈ I) (j : ℕ) (y : ℝ)
        (hy : y ∈ Set.Icc d₀ b) :
        iteratedDerivWithin j (F a) (Set.Icc d₀ b) y = iteratedDeriv j (F a) y :=
      iteratedDerivWithin_eq_iteratedDeriv (uniqueDiffOn_Icc hb)
        (((hF a ha).1.contDiffAt
          (isOpen_Ioi.mem_nhds (hd₀.trans_le hy.1))).of_le (by simp)) hy
    have htaylor (a : ι) (ha : a ∈ I) :
        ‖F a d - taylorWithinEval (F a) J (Set.Icc d₀ b) d₀ d‖ ≤
          C * (T * L) ^ 4 * (D * S) ^ (J + 1) := by
      have hf : ContDiffOn ℝ (J + 1) (F a) (Set.Icc d₀ b) :=
        ((hF a ha).1.mono (fun y hy => hd₀.trans_le hy.1)).of_le (by simp)
      have hderiv : ∀ y ∈ Set.Icc d₀ b,
          ‖iteratedDerivWithin (J + 1) (F a) (Set.Icc d₀ b) y‖ ≤
            C * (T * L) ^ 4 * Z ^ (J + 1) := by
        intro y hy
        rw [hwithin a ha (J + 1) y hy]
        exact (hF a ha).2 y hy.1 (J + 1) le_rfl
      have hraw := taylor_mean_remainder_bound hb.le hf hd hderiv
      calc
        _ ≤ C * (T * L) ^ 4 * Z ^ (J + 1) * (d - d₀) ^ (J + 1) /
            (J.factorial : ℝ) := hraw
        _ ≤ C * (T * L) ^ 4 * Z ^ (J + 1) * (d - d₀) ^ (J + 1) :=
          div_le_self (by positivity) (hfac J)
        _ ≤ C * (T * L) ^ 4 * Z ^ (J + 1) * (D * δ) ^ (J + 1) := by
          gcongr
          exact hsχ.2
        _ = C * (T * L) ^ 4 * (D * S) ^ (J + 1) := by
          rw [hS]
          simp only [mul_pow]
          ring
    have hpoly (a : ι) (ha : a ∈ I) :
        taylorWithinEval (F a) J (Set.Icc d₀ b) d₀ d =
          ∑ j ∈ Finset.range (J + 1), (((d - d₀) / δ) ^ j : ℝ) • coeff a j := by
      rw [taylor_within_apply]
      apply Finset.sum_congr rfl
      intro j _
      rw [hwithin a ha j d₀ ⟨le_rfl, hb.le⟩]
      dsimp only [coeff]
      rw [smul_smul]
      congr 1
      rw [div_pow, div_mul_div_cancel₀ (pow_ne_zero j hδ.ne'),
        div_eq_mul_inv, mul_comm]
    have hsum :
        (∑ j ∈ Finset.range (J + 1),
          ((χ (d - d₀) * ((d - d₀) / δ) ^ j : ℝ) : ℂ) *
            (∑ a ∈ I, A d a * coeff a j)) =
          (χ (d - d₀) : ℂ) *
            ∑ a ∈ I, A d a * taylorWithinEval (F a) J (Set.Icc d₀ b) d₀ d := by
      simp_rw [Complex.ofReal_mul, Finset.mul_sum]
      rw [Finset.sum_comm]
      apply Finset.sum_congr rfl
      intro a ha
      rw [hpoly a ha]
      simp only [Finset.mul_sum, Complex.real_smul, mul_assoc, mul_left_comm]
    rw [hsum, ← mul_sub, ← Finset.sum_sub_distrib]
    simp_rw [← mul_sub]
    rw [norm_mul, Complex.norm_real, Real.norm_eq_abs]
    calc
      _ ≤ |χ (d - d₀)| * ∑ a ∈ I, ‖A d a‖ *
          (C * (T * L) ^ 4 * (D * S) ^ (J + 1)) := by
        apply mul_le_mul_of_nonneg_left _ (abs_nonneg _)
        apply norm_sum_le_of_le
        intro a ha
        exact norm_mul_le_of_le le_rfl (htaylor a ha)
      _ = |χ (d - d₀)| * C * (T * L) ^ 4 * (D * S) ^ (J + 1) *
          (∑ a ∈ I, ‖A d a‖) := by
        rw [← Finset.sum_mul]
        ring

theorem sourceShortShearTaylor_finite_separation
    (J : ℕ) (φ ψ : ℝ → ℂ) (hψ : ContDiff ℝ (J + 1) ψ)
    (TD TN : ℝ) (hTD : 0 ≤ TD) (hTN : 0 ≤ TN)
    (hφsupport : Function.support φ ⊆ Set.Icc (-TD) TD)
    (hψsupport : Function.support ψ ⊆ Set.Icc (-TN) TN)
    (f z₁ w₃ Δstar S : ℝ)
    (hf : 0 < f) (hz₁ : 0 < z₁) (hw₃ : 0 < w₃)
    (hΔstar : 0 < Δstar) (hS : 0 < S)
    (h x₀ y₀ : ℝ)
    (heta : |h * (Δstar / (z₁ * f)) / S| ≤ 1)
    (D I : Finset ℤ) (A : ℤ → ℤ → ℂ) :
    let D₂ : ℝ := Δstar / (z₁ * f)
    let N₂ : ℝ := S / w₃
    let dcenter : ℝ := y₀ / f
    let ncenter : ℝ := (x₀ - h * y₀ / f) / w₃
    let τ : ℤ → ℝ := fun d => ((d : ℝ) - dcenter) / D₂
    let σ : ℤ → ℝ := fun n => ((n : ℝ) - ncenter) / N₂
    let η : ℝ := h * D₂ / S
    let dStar : ℕ → ℝ → ℂ := fun j t =>
      ((η * t) ^ j / (Nat.factorial j : ℝ)) • φ t
    let nStar : ℕ → ℝ → ℂ := fun j s => iteratedDeriv j ψ s
    let BD : Finset ℤ :=
      Finset.Icc ⌈dcenter - TD * D₂⌉ ⌊dcenter + TD * D₂⌋
    let BI : Finset ℤ :=
      Finset.Icc ⌈ncenter - (TN + TD) * N₂⌉ ⌊ncenter + (TN + TD) * N₂⌋
    let R : ℤ → ℤ → ℂ := fun d n =>
      ((η * τ d) ^ (J + 1) / (Nat.factorial J : ℝ)) •
        ∫ u : ℝ in (0 : ℝ)..1,
          (1 - u) ^ J • iteratedDeriv (J + 1) ψ (σ n + u * (η * τ d))
    0 < D₂ ∧ 0 < N₂ ∧
      (∀ d n : ℤ,
        (f * (d : ℝ) - y₀) / (Δstar / z₁) = τ d ∧
          (w₃ * (n : ℝ) + h * (d : ℝ) - x₀) / S = σ n + η * τ d) ∧
      (∀ j : ℕ, j ≤ J →
        Function.support (dStar j) ⊆ Set.Icc (-TD) TD ∧
          Function.support (nStar j) ⊆ Set.Icc (-TN) TN) ∧
      (BD.card : ℝ) ≤ 2 * TD * D₂ + 1 ∧
      (BI.card : ℝ) ≤ 2 * (TN + TD) * N₂ + 1 ∧
      (∀ d n : ℤ, d ∉ BD ∨ n ∉ BI →
        φ ((f * (d : ℝ) - y₀) / (Δstar / z₁)) *
            ψ ((w₃ * (n : ℝ) + h * (d : ℝ) - x₀) / S) = 0 ∧
          (∀ j : ℕ, j ≤ J → dStar j (τ d) * nStar j (σ n) = 0) ∧
          φ (τ d) * R d n = 0) ∧
      (∑ d ∈ D, ∑ n ∈ I,
          A d n * φ ((f * (d : ℝ) - y₀) / (Δstar / z₁)) *
            ψ ((w₃ * (n : ℝ) + h * (d : ℝ) - x₀) / S)) =
        (∑ j ∈ Finset.range (J + 1), ∑ d ∈ D, ∑ n ∈ I,
          A d n * dStar j (τ d) * nStar j (σ n)) +
        ∑ d ∈ D, ∑ n ∈ I, A d n * φ (τ d) * R d n := by
  classical
  intro D₂ N₂ dcenter ncenter τ σ η dStar nStar BD BI R
  have hD₂ : 0 < D₂ := div_pos hΔstar (mul_pos hz₁ hf)
  have hN₂ : 0 < N₂ := div_pos hS hw₃
  have harg (d n : ℤ) :
      (f * (d : ℝ) - y₀) / (Δstar / z₁) = τ d ∧
        (w₃ * (n : ℝ) + h * (d : ℝ) - x₀) / S = σ n + η * τ d := by
    constructor
    · dsimp only [τ, dcenter, D₂]
      field_simp (disch := positivity)
    · dsimp only [σ, η, τ, ncenter, dcenter, N₂, D₂]
      field_simp (disch := positivity)
      ring
  have hsuppD (j : ℕ) : Function.support (dStar j) ⊆ Set.Icc (-TD) TD :=
    (Function.support_smul_subset_right
      (fun t : ℝ => (η * t) ^ j / (Nat.factorial j : ℝ)) φ).trans hφsupport
  have hsuppN (j : ℕ) : Function.support (nStar j) ⊆ Set.Icc (-TN) TN := by
    dsimp only [nStar]
    rw [iteratedDeriv_eq_equiv_comp]
    exact (Function.support_comp_subset (map_zero _) _).trans
      ((support_iteratedFDeriv_subset (𝕜 := ℝ) (f := ψ) j).trans
        (closure_minimal hψsupport isClosed_Icc))
  have box_card (c T L : ℝ) (hT : 0 ≤ T) (hL : 0 < L) :
      ((Finset.Icc ⌈c - T * L⌉ ⌊c + T * L⌋).card : ℝ) ≤
        2 * T * L + 1 := by
    have hend : c - T * L ≤ c + T * L := by
      nlinarith [mul_nonneg hT hL.le]
    have hgap : ⌈c - T * L⌉ ≤ ⌊c + T * L⌋ + 1 :=
      (Int.ceil_mono hend).trans (Int.ceil_le_floor_add_one _)
    have hcard :
        ((Finset.Icc ⌈c - T * L⌉ ⌊c + T * L⌋).card : ℝ) =
          (⌊c + T * L⌋ : ℝ) + 1 - (⌈c - T * L⌉ : ℝ) := by
      exact_mod_cast (Int.card_Icc_of_le _ _ hgap)
    rw [hcard]
    nlinarith [Int.floor_le (c + T * L), Int.le_ceil (c - T * L)]
  have mem_box (c T L : ℝ) (hL : 0 < L) (n : ℤ) :
      n ∈ Finset.Icc ⌈c - T * L⌉ ⌊c + T * L⌋ ↔
        |((n : ℝ) - c) / L| ≤ T := by
    rw [← Int.cast_mem_Icc_iff, Set.mem_Icc, abs_le,
      le_div_iff₀ hL, div_le_iff₀ hL]
    constructor <;> rintro ⟨h₁, h₂⟩ <;> constructor <;> nlinarith
  have htaylor (b v : ℝ) :
      ψ (b + v) =
        (∑ j ∈ Finset.range (J + 1),
          (v ^ j / (Nat.factorial j : ℝ)) • iteratedDeriv j ψ b) +
        (v ^ (J + 1) / (Nat.factorial J : ℝ)) •
          ∫ u : ℝ in (0 : ℝ)..1,
            (1 - u) ^ J • iteratedDeriv (J + 1) ψ (b + u * v) := by
    have hT := map_add_eq_sum_add_integral_iteratedFDeriv
      (f := ψ) (x := b) (y := v) (n := J) (fun _ _ => hψ.contDiffAt)
    simp only [iteratedFDeriv_apply_eq_iteratedDeriv_mul_prod, Fin.prod_const,
      smul_eq_mul] at hT
    simp_rw [← smul_comm (v ^ (J + 1)) (_ : ℝ) (_ : ℂ),
      intervalIntegral.integral_smul] at hT
    simpa only [smul_smul, div_eq_mul_inv, mul_comm] using hT
  have hpoint (d n : ℤ) :
      φ ((f * (d : ℝ) - y₀) / (Δstar / z₁)) *
          ψ ((w₃ * (n : ℝ) + h * (d : ℝ) - x₀) / S) =
        (∑ j ∈ Finset.range (J + 1), dStar j (τ d) * nStar j (σ n)) +
          φ (τ d) * R d n := by
    rw [(harg d n).1, (harg d n).2, htaylor (σ n) (η * τ d),
      mul_add, Finset.mul_sum]
    simp only [dStar, nStar, R, mul_smul_comm, smul_mul_assoc]
  have hzero (d n : ℤ) (hout : d ∉ BD ∨ n ∉ BI) :
      φ ((f * (d : ℝ) - y₀) / (Δstar / z₁)) *
          ψ ((w₃ * (n : ℝ) + h * (d : ℝ) - x₀) / S) = 0 ∧
        ∀ j : ℕ, j ≤ J → dStar j (τ d) * nStar j (σ n) = 0 := by
    by_cases hφ : φ (τ d) = 0
    · constructor
      · rw [(harg d n).1, hφ, zero_mul]
      · intro j _
        dsimp only [dStar]
        rw [hφ, smul_zero, zero_mul]
    · have hτ : |τ d| ≤ TD := abs_le.mpr (hφsupport hφ)
      have hd : d ∈ BD := (mem_box dcenter TD D₂ hD₂ d).mpr hτ
      have hn : n ∉ BI := hout.resolve_left (fun hd' => hd' hd)
      have hshift : |η * τ d| ≤ TD := by
        rw [abs_mul]
        exact (mul_le_mul_of_nonneg_right heta (abs_nonneg (τ d))).trans
          (by simpa only [one_mul] using hτ)
      have hψzero : ψ (σ n + η * τ d) = 0 := by
        by_contra hψne
        apply hn
        apply (mem_box ncenter (TN + TD) N₂ hN₂ n).mpr
        apply abs_le.mpr
        have hψbound := hψsupport hψne
        have hshiftbound := abs_le.mp hshift
        constructor <;>
          linarith [hψbound.1, hψbound.2, hshiftbound.1, hshiftbound.2]
      constructor
      · rw [(harg d n).2, hψzero, mul_zero]
      · intro j _
        have hnzero : nStar j (σ n) = 0 := by
          by_contra hj
          apply hn
          apply (mem_box ncenter (TN + TD) N₂ hN₂ n).mpr
          exact (abs_le.mpr (hsuppN j hj)).trans (le_add_of_nonneg_right hTD)
        rw [hnzero, mul_zero]
  refine ⟨hD₂, hN₂, harg, fun j _ => ⟨hsuppD j, hsuppN j⟩,
    box_card dcenter TD D₂ hTD hD₂,
    box_card ncenter (TN + TD) N₂ (add_nonneg hTN hTD) hN₂, ?_, ?_⟩
  · intro d n hout
    obtain ⟨hmixed, hsep⟩ := hzero d n hout
    refine ⟨hmixed, hsep, ?_⟩
    have hsum : (∑ j ∈ Finset.range (J + 1),
        dStar j (τ d) * nStar j (σ n)) = 0 :=
      Finset.sum_eq_zero fun j hj =>
        hsep j (Nat.le_of_lt_succ (Finset.mem_range.mp hj))
    have hp := hpoint d n
    rw [hmixed, hsum, zero_add] at hp
    exact hp.symm
  · simp_rw [mul_assoc, hpoint, mul_add, Finset.mul_sum, Finset.sum_add_distrib]
    congr 1
    exact Finset.sum_comm_cycle

theorem sourceShortShearTaylor_uniform_star_profiles
    (J : ℕ) (TD TN : ℝ) (hTD : 0 ≤ TD)
    (Cφ Eφ Cψ Eψ : ℕ → ℝ)
    (hCφ : ∀ r, 0 ≤ Cφ r) (hCψ : ∀ r, 0 ≤ Cψ r) :
    ∃ Cstar Estar : ℕ → ℝ,
      (∀ r, 0 < Cstar r ∧ 0 ≤ Estar r) ∧
      ∀ (x : ℝ), Real.exp 1 ≤ x →
      ∀ (φ ψ : ℝ → ℂ), ContDiff ℝ ∞ φ → ContDiff ℝ ∞ ψ →
      Function.support φ ⊆ Set.Icc (-TD) TD →
      Function.support ψ ⊆ Set.Icc (-TN) TN →
      (∀ (r : ℕ) (t : ℝ), ‖iteratedDeriv r φ t‖ ≤ Cφ r * (Real.log x) ^ Eφ r) →
      (∀ (r : ℕ) (t : ℝ), ‖iteratedDeriv r ψ t‖ ≤ Cψ r * (Real.log x) ^ Eψ r) →
      ∀ (η : ℝ), |η| ≤ 1 → ∀ (j : ℕ), j ≤ J →
      let dStar : ℝ → ℂ := fun t => ((η * t) ^ j / (Nat.factorial j : ℝ)) • φ t
      let nStar : ℝ → ℂ := fun s => iteratedDeriv j ψ s
      ContDiff ℝ ∞ dStar ∧ ContDiff ℝ ∞ nStar ∧
        Function.support dStar ⊆ Set.Icc (-TD) TD ∧
        Function.support nStar ⊆ Set.Icc (-TN) TN ∧
        (∀ (r : ℕ) (t : ℝ),
          ‖iteratedDeriv r dStar t‖ ≤ Cstar r * (Real.log x) ^ Estar r ∧
            ‖iteratedDeriv r nStar t‖ ≤ Cstar r * (Real.log x) ^ Estar r) ∧
        ∀ (D₂ N₂ dcenter ncenter : ℝ), 0 < D₂ → 0 < N₂ →
          ∀ (r : ℕ) (t : ℝ),
            ‖iteratedDeriv r (fun u : ℝ => dStar ((u - dcenter) / D₂)) t‖ ≤
                Cstar r * (Real.log x) ^ Estar r / D₂ ^ r ∧
              ‖iteratedDeriv r (fun u : ℝ => nStar ((u - ncenter) / N₂)) t‖ ≤
                Cstar r * (Real.log x) ^ Estar r / N₂ ^ r := by
  let aD : ℕ → ℕ → ℕ → ℝ := fun r j i =>
    (r.choose i : ℝ) * (j.descFactorial i : ℝ) * TD ^ (j - i) /
      (Nat.factorial j : ℝ) * Cφ (r - i)
  let c : ℕ → ℝ := fun r =>
    1 + ∑ j ∈ Finset.range (J + 1),
      (Cψ (j + r) + ∑ i ∈ Finset.range (r + 1), aD r j i)
  let e : ℕ → ℝ := fun r =>
    ∑ q ∈ Finset.range (J + r + 1), (|Eφ q| + |Eψ q|)
  have haD (r j i : ℕ) : 0 ≤ aD r j i := by
    have h₁ := hCφ (r - i)
    dsimp [aD]
    positivity
  have he₀ (r : ℕ) : 0 ≤ e r :=
    Finset.sum_nonneg fun q _ => add_nonneg (abs_nonneg _) (abs_nonneg _)
  have hc (r : ℕ) : 0 < c r := by
    have hs : 0 ≤ ∑ j ∈ Finset.range (J + 1),
        (Cψ (j + r) + ∑ i ∈ Finset.range (r + 1), aD r j i) :=
      Finset.sum_nonneg fun j _ =>
        add_nonneg (hCψ (j + r)) (Finset.sum_nonneg fun i _ => haD r j i)
    exact add_pos_of_pos_of_nonneg zero_lt_one hs
  have he (r q : ℕ) (hq : q ≤ J + r) : Eφ q ≤ e r ∧ Eψ q ≤ e r := by
    have hs : |Eφ q| + |Eψ q| ≤ e r :=
      Finset.single_le_sum
        (fun t _ => add_nonneg (abs_nonneg (Eφ t)) (abs_nonneg (Eψ t)))
        (Finset.mem_range.mpr (Nat.lt_succ_of_le hq))
    constructor
    · exact (le_abs_self _).trans
        ((le_add_of_nonneg_right (abs_nonneg _)).trans hs)
    · exact (le_abs_self _).trans
        ((le_add_of_nonneg_left (abs_nonneg _)).trans hs)
  refine ⟨c, e, fun r => ⟨hc r, he₀ r⟩, ?_⟩
  intro x hx φ ψ hφ hψ hsupportφ hsupportψ hboundφ hboundψ η hη j hj
  let L : ℝ := Real.log x
  have hL : 1 ≤ L := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hx
  have hLnonneg : 0 ≤ L := zero_le_one.trans hL
  let G : ℝ → ℝ := fun v => (η * v) ^ j / (Nat.factorial j : ℝ)
  let Q : ℝ → ℂ := fun v => G v • φ v
  let P : ℝ → ℂ := iteratedDeriv j ψ
  change ContDiff ℝ ∞ Q ∧ ContDiff ℝ ∞ P ∧
    Function.support Q ⊆ Set.Icc (-TD) TD ∧
    Function.support P ⊆ Set.Icc (-TN) TN ∧
    (∀ r t, ‖iteratedDeriv r Q t‖ ≤ c r * L ^ e r ∧
      ‖iteratedDeriv r P t‖ ≤ c r * L ^ e r) ∧
    ∀ D₂ N₂ dcenter ncenter : ℝ, 0 < D₂ → 0 < N₂ → ∀ r t,
      ‖iteratedDeriv r (fun u : ℝ => Q ((u - dcenter) / D₂)) t‖ ≤
          c r * L ^ e r / D₂ ^ r ∧
        ‖iteratedDeriv r (fun u : ℝ => P ((u - ncenter) / N₂)) t‖ ≤
          c r * L ^ e r / N₂ ^ r
  have hG : ContDiff ℝ ∞ G := by dsimp [G]; fun_prop
  have hQ : ContDiff ℝ ∞ Q := hG.smul hφ
  have hP : ContDiff ℝ ∞ P := by
    simpa only [P, iteratedDeriv_eq_iterate] using ContDiff.iterate_deriv j hψ
  have hsupportQ : Function.support Q ⊆ Set.Icc (-TD) TD :=
    (Function.support_smul_subset_right G φ).trans hsupportφ
  have hsupp (H : ℝ → ℂ) (T : ℝ)
      (hH : Function.support H ⊆ Set.Icc (-T) T) (m : ℕ) :
      Function.support (iteratedDeriv m H) ⊆ Set.Icc (-T) T := by
    rw [iteratedDeriv_eq_equiv_comp]
    exact (Function.support_comp_subset (map_zero _) _).trans
      ((support_iteratedFDeriv_subset (𝕜 := ℝ) (f := H) m).trans
        (closure_minimal hH isClosed_Icc))
  have hGnorm (m : ℕ) (v : ℝ) (hv : |v| ≤ TD) :
      ‖iteratedDeriv m G v‖ ≤
        (j.descFactorial m : ℝ) * TD ^ (j - m) / (Nat.factorial j : ℝ) := by
    simp only [G, mul_pow, iteratedDeriv_div_const, iteratedDeriv_const_mul_field,
      iteratedDeriv_pow, Real.norm_eq_abs, abs_div, abs_mul, abs_pow, Nat.abs_cast]
    calc
      _ ≤ (1 * ((j.descFactorial m : ℝ) * TD ^ (j - m))) / (Nat.factorial j : ℝ) := by
        gcongr
        exact pow_le_one₀ (abs_nonneg η) hη
      _ = _ := by rw [one_mul]
  have hpart (r : ℕ) :
      Cψ (j + r) + (∑ i ∈ Finset.range (r + 1), aD r j i) ≤ c r := by
    have hb : Cψ (j + r) + (∑ i ∈ Finset.range (r + 1), aD r j i) ≤
        ∑ t ∈ Finset.range (J + 1),
          (Cψ (t + r) + ∑ i ∈ Finset.range (r + 1), aD r t i) :=
      Finset.single_le_sum
        (fun t _ => add_nonneg (hCψ (t + r))
          (Finset.sum_nonneg fun i _ => haD r t i))
        (Finset.mem_range.mpr (Nat.lt_succ_of_le hj))
    exact hb.trans (le_add_of_nonneg_left zero_le_one)
  have hcN (r : ℕ) : Cψ (j + r) ≤ c r :=
    (le_add_of_nonneg_right (Finset.sum_nonneg fun i _ => haD r j i)).trans (hpart r)
  have hcD (r : ℕ) : (∑ i ∈ Finset.range (r + 1), aD r j i) ≤ c r :=
    (le_add_of_nonneg_left (hCψ (j + r))).trans (hpart r)
  have hPnorm (r : ℕ) (u : ℝ) : ‖iteratedDeriv r P u‖ ≤ c r * L ^ e r := by
    change ‖iteratedDeriv r (iteratedDeriv j ψ) u‖ ≤ c r * L ^ e r
    rw [iteratedDeriv_eq_iterate, iteratedDeriv_eq_iterate,
      ← Function.iterate_add_apply, ← iteratedDeriv_eq_iterate]
    have hpow : L ^ Eψ (r + j) ≤ L ^ e r :=
      Real.rpow_le_rpow_of_exponent_le hL (he r (r + j) (by omega)).2
    calc
      ‖iteratedDeriv (r + j) ψ u‖ ≤ Cψ (r + j) * L ^ Eψ (r + j) :=
        hboundψ (r + j) u
      _ ≤ Cψ (r + j) * L ^ e r :=
        mul_le_mul_of_nonneg_left hpow (hCψ (r + j))
      _ ≤ c r * L ^ e r :=
        mul_le_mul_of_nonneg_right (by simpa only [Nat.add_comm r j] using hcN r)
          (Real.rpow_nonneg hLnonneg _)
  have hQnorm (r : ℕ) (u : ℝ) : ‖iteratedDeriv r Q u‖ ≤ c r * L ^ e r := by
    by_cases hu : u ∈ Set.Icc (-TD) TD
    · have huTD : |u| ≤ TD := abs_le.mpr hu
      have hnorm : ‖iteratedDeriv r Q u‖ ≤
          ∑ i ∈ Finset.range (r + 1), (r.choose i : ℝ) *
            ‖iteratedDeriv i G u‖ * ‖iteratedDeriv (r - i) φ u‖ := by
        simpa only [norm_iteratedFDeriv_eq_norm_iteratedDeriv] using
          norm_iteratedFDeriv_smul_le (𝕜 := ℝ) (n := r) hG hφ u (by simp)
      have hterms (i : ℕ) (_hi : i ∈ Finset.range (r + 1)) :
          (r.choose i : ℝ) * ‖iteratedDeriv i G u‖ *
            ‖iteratedDeriv (r - i) φ u‖ ≤ aD r j i * L ^ e r := by
        have hpow : L ^ Eφ (r - i) ≤ L ^ e r :=
          Real.rpow_le_rpow_of_exponent_le hL (he r (r - i) (by omega)).1
        have hci : 0 ≤ (r.choose i : ℝ) := Nat.cast_nonneg _
        have hp : 0 ≤ (j.descFactorial i : ℝ) * TD ^ (j - i) /
            (Nat.factorial j : ℝ) := by positivity
        calc
          (r.choose i : ℝ) * ‖iteratedDeriv i G u‖ *
              ‖iteratedDeriv (r - i) φ u‖ ≤
              (r.choose i : ℝ) *
                ((j.descFactorial i : ℝ) * TD ^ (j - i) / (Nat.factorial j : ℝ)) *
                (Cφ (r - i) * L ^ Eφ (r - i)) :=
            mul_le_mul (mul_le_mul_of_nonneg_left (hGnorm i u huTD) hci)
              (hboundφ (r - i) u) (norm_nonneg _) (mul_nonneg hci hp)
          _ = aD r j i * L ^ Eφ (r - i) := by
            simp only [aD, div_eq_mul_inv, mul_assoc]
          _ ≤ aD r j i * L ^ e r := mul_le_mul_of_nonneg_left hpow (haD r j i)
      calc
        ‖iteratedDeriv r Q u‖ ≤
            ∑ i ∈ Finset.range (r + 1), aD r j i * L ^ e r :=
          hnorm.trans (Finset.sum_le_sum hterms)
        _ = (∑ i ∈ Finset.range (r + 1), aD r j i) * L ^ e r := by
          rw [Finset.sum_mul]
        _ ≤ c r * L ^ e r :=
          mul_le_mul_of_nonneg_right (hcD r) (Real.rpow_nonneg hLnonneg _)
    · rw [Function.support_subset_iff'.mp (hsupp Q TD hsupportQ r) u hu, norm_zero]
      exact mul_nonneg (hc r).le (Real.rpow_nonneg hLnonneg _)
  have hphysical (H : ℝ → ℂ) (hH : ContDiff ℝ ∞ H)
      (hboundH : ∀ r t, ‖iteratedDeriv r H t‖ ≤ c r * L ^ e r)
      (D : ℝ) (hD : 0 < D) (center : ℝ) (r : ℕ) (t : ℝ) :
      ‖iteratedDeriv r (fun u : ℝ => H ((u - center) / D)) t‖ ≤
        c r * L ^ e r / D ^ r := by
    have hformula : iteratedDeriv r (fun u : ℝ => H ((u - center) / D)) t =
        (D⁻¹) ^ r • iteratedDeriv r H ((t - center) / D) := by
      have hs := congrFun
        (iteratedDeriv_comp_const_smul (contDiff_infty.mp hH r) D⁻¹) (t - center)
      have ht := congrFun
        (iteratedDeriv_comp_sub_const r (fun u : ℝ => H (D⁻¹ * u)) center) t
      rw [hs] at ht
      simpa only [div_eq_mul_inv, mul_comm] using ht
    rw [hformula, norm_smul, Real.norm_eq_abs,
      abs_of_nonneg (pow_nonneg (inv_nonneg.mpr hD.le) r), inv_pow]
    simpa only [div_eq_mul_inv, mul_comm] using
      div_le_div_of_nonneg_right (hboundH r ((t - center) / D)) (pow_nonneg hD.le r)
  refine ⟨hQ, hP, hsupportQ, hsupp ψ TN hsupportψ j, ?_, ?_⟩
  · exact fun r t => ⟨hQnorm r t, hPnorm r t⟩
  · intro D₂ N₂ dcenter ncenter hD₂ hN₂ r t
    exact ⟨hphysical Q hQ hQnorm D₂ hD₂ dcenter r t,
      hphysical P hP hPnorm N₂ hN₂ ncenter r t⟩

theorem sourceShortShearTaylor_uniform_finite_remainder
    (ε B C TD TN : ℝ)
    (hε : 0 < ε) (hB : 0 < B) (hC : 0 ≤ C)
    (hTD : 0 ≤ TD) (hTN : 0 ≤ TN)
    (Cφ Eφ Cψ Eψ : ℕ → ℝ)
    (hCφ : ∀ r, 0 ≤ Cφ r) (hCψ : ∀ r, 0 ≤ Cψ r) :
    let J : ℕ := ⌈(B + 2 * C + 2) / (5 * ε)⌉₊
    ∃ X₀ : ℝ, Real.exp 1 ≤ X₀ ∧
      ∀ (x : ℝ), X₀ ≤ x →
      ∀ (φ ψ : ℝ → ℂ), ContDiff ℝ ∞ φ → ContDiff ℝ ∞ ψ →
      Function.support φ ⊆ Set.Icc (-TD) TD →
      Function.support ψ ⊆ Set.Icc (-TN) TN →
      (∀ (r : ℕ) (t : ℝ), ‖iteratedDeriv r φ t‖ ≤ Cφ r * (Real.log x) ^ Eφ r) →
      (∀ (r : ℕ) (t : ℝ), ‖iteratedDeriv r ψ t‖ ≤ Cψ r * (Real.log x) ^ Eψ r) →
      ∀ (f z₁ w₃ Δstar S : ℝ), 0 < f → 0 < z₁ → 0 < w₃ →
      0 < Δstar → 0 < S →
      ∀ (h x₀ y₀ : ℝ),
      Δstar / (z₁ * f) ≤ x ^ C → S / w₃ ≤ x ^ C →
      |h * (Δstar / (z₁ * f)) / S| ≤ 2 * x ^ (-(5 * ε)) →
      ∀ (D I : Finset ℤ) (A : ℤ → ℤ → ℂ),
      (∀ d ∈ D, ∀ n ∈ I, ‖A d n‖ ≤ 1) →
      let D₂ : ℝ := Δstar / (z₁ * f)
      let N₂ : ℝ := S / w₃
      let dcenter : ℝ := y₀ / f
      let ncenter : ℝ := (x₀ - h * y₀ / f) / w₃
      let τ : ℤ → ℝ := fun d => ((d : ℝ) - dcenter) / D₂
      let σ : ℤ → ℝ := fun n => ((n : ℝ) - ncenter) / N₂
      let η : ℝ := h * D₂ / S
      let dStar : ℕ → ℝ → ℂ := fun j t =>
        ((η * t) ^ j / (Nat.factorial j : ℝ)) • φ t
      let nStar : ℕ → ℝ → ℂ := fun j s => iteratedDeriv j ψ s
      |η| ≤ 1 ∧
        ‖(∑ d ∈ D, ∑ n ∈ I,
            A d n * φ ((f * (d : ℝ) - y₀) / (Δstar / z₁)) *
              ψ ((w₃ * (n : ℝ) + h * (d : ℝ) - x₀) / S)) -
          (∑ j ∈ Finset.range (J + 1), ∑ d ∈ D, ∑ n ∈ I,
            A d n * dStar j (τ d) * nStar j (σ n))‖ ≤ x ^ (-B) := by
  classical
  intro J
  let α : ℝ := 5 * ε * ((J + 1 : ℕ) : ℝ)
  let Q : ℝ := Cφ 0 * Cψ (J + 1) * (2 * TD) ^ (J + 1) / (Nat.factorial J : ℝ)
  let E : ℝ := Eφ 0 + Eψ (J + 1)
  let H : ℝ := (2 * TD + 1) * (2 * (TN + TD) + 1)
  have hfact : 0 ≤ (Nat.factorial J : ℝ) := Nat.cast_nonneg _
  have hQ : 0 ≤ Q :=
    div_nonneg
      (mul_nonneg (mul_nonneg (hCφ 0) (hCψ (J + 1)))
        (pow_nonneg (mul_nonneg zero_le_two hTD) _)) hfact
  have hH : 0 ≤ H :=
    mul_nonneg (add_nonneg (mul_nonneg zero_le_two hTD) zero_le_one)
      (add_nonneg (mul_nonneg zero_le_two (add_nonneg hTN hTD)) zero_le_one)
  have hscale : 0 < 5 * ε := by positivity
  have hceil : B + 2 * C + 2 ≤ (J : ℝ) * (5 * ε) :=
    (div_le_iff₀ hscale).mp (Nat.le_ceil _)
  have hgap : 0 < α - B - 2 * C := by
    dsimp only [α]
    push_cast
    nlinarith
  have hthreshold :
      ∀ᶠ x : ℝ in Filter.atTop, Real.exp 1 ≤ x ∧ 2 ≤ x ^ (5 * ε) ∧
        (H * Q) * (Real.log x) ^ E ≤ x ^ (α - B - 2 * C) := by
    filter_upwards [Filter.eventually_ge_atTop (Real.exp 1),
      (tendsto_rpow_atTop hscale).eventually_ge_atTop 2,
      ((isLittleO_log_rpow_rpow_atTop E hgap).const_mul_left (H * Q)).eventuallyLE]
      with x hx hcut herr
    have hx0 : 0 < x := (Real.exp_pos 1).trans_le hx
    have hlog1 : 1 ≤ Real.log x := by
      simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hx
    refine ⟨hx, hcut, ?_⟩
    simpa only [Real.norm_of_nonneg
      (mul_nonneg (mul_nonneg hH hQ)
        (Real.rpow_nonneg (zero_le_one.trans hlog1) _)),
      Real.norm_of_nonneg (Real.rpow_nonneg hx0.le _)] using herr
  obtain ⟨X₀, hX₀⟩ := Filter.eventually_atTop.mp hthreshold
  refine ⟨X₀ + B, (hX₀ X₀ le_rfl).1.trans (le_add_of_nonneg_right hB.le), ?_⟩
  intro x hx φ ψ hφsmooth hψsmooth hφsupport hψsupport hφbound hψbound
    f z₁ w₃ Δstar S hf hz₁ hw₃ hΔstar hS h x₀ y₀ hDpow hNpow hη
    D I A hA D₂ N₂ dcenter ncenter τ σ η dStar nStar
  have hx : X₀ ≤ x := (le_add_of_nonneg_right hB.le).trans hx
  have hxexp : Real.exp 1 ≤ x := (hX₀ x hx).1
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hx1 : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hxexp
  have hlog1 : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hxexp
  have hlog0 : 0 ≤ Real.log x := zero_le_one.trans hlog1
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlog1
  have heta : |η| ≤ 2 * x ^ (-(5 * ε)) := hη
  have hone : |η| ≤ 1 := by
    refine heta.trans ?_
    rw [Real.rpow_neg hx0.le, ← div_eq_mul_inv]
    exact (div_le_one₀ (Real.rpow_pos_of_pos hx0 _)).mpr (hX₀ x hx).2.1
  let BD : Finset ℤ :=
    Finset.Icc ⌈dcenter - TD * D₂⌉ ⌊dcenter + TD * D₂⌋
  let BI : Finset ℤ :=
    Finset.Icc ⌈ncenter - (TN + TD) * N₂⌉ ⌊ncenter + (TN + TD) * N₂⌋
  let R : ℤ → ℤ → ℂ := fun d n =>
    ((η * τ d) ^ (J + 1) / (Nat.factorial J : ℝ)) •
      ∫ u : ℝ in (0 : ℝ)..1,
        (1 - u) ^ J • iteratedDeriv (J + 1) ψ (σ n + u * (η * τ d))
  obtain ⟨_, _, _, _, hBDcard, hBIcard, hzero, hidentity⟩ :=
    sourceShortShearTaylor_finite_separation J φ ψ
      ((contDiff_infty.mp hψsmooth) (J + 1)) TD TN hTD hTN hφsupport hψsupport
      f z₁ w₃ Δstar S hf hz₁ hw₃ hΔstar hS h x₀ y₀ hone D I A
  change (BD.card : ℝ) ≤ 2 * TD * D₂ + 1 at hBDcard
  change (BI.card : ℝ) ≤ 2 * (TN + TD) * N₂ + 1 at hBIcard
  have hsmall (d : ℤ) (hd : φ (τ d) ≠ 0) :
      |η * τ d| ≤ 2 * TD * x ^ (-(5 * ε)) := by
    have ht : |τ d| ≤ TD := abs_le.mpr (hφsupport hd)
    calc
      |η * τ d| = |η| * |τ d| := abs_mul _ _
      _ ≤ (2 * x ^ (-(5 * ε))) * TD :=
        mul_le_mul heta ht (abs_nonneg _)
          (mul_nonneg zero_le_two (Real.rpow_nonneg hx0.le _))
      _ = 2 * TD * x ^ (-(5 * ε)) := by ring
  let BP : ℝ := Cψ (J + 1) * (Real.log x) ^ Eψ (J + 1)
  have hBP : 0 ≤ BP := mul_nonneg (hCψ (J + 1)) (Real.rpow_nonneg hlog0 _)
  have hint (d n : ℤ) :
      ‖∫ u : ℝ in (0 : ℝ)..1,
        (1 - u) ^ J • iteratedDeriv (J + 1) ψ (σ n + u * (η * τ d))‖ ≤ BP := by
    calc
      _ ≤ BP * |(1 : ℝ) - 0| := by
        apply intervalIntegral.norm_integral_le_of_norm_le_const
        intro u hu
        have hu' : u ∈ Set.Ioc (0 : ℝ) 1 := by
          simpa only [Set.uIoc_of_le (show (0 : ℝ) ≤ 1 by norm_num)] using hu
        have hu0 : 0 ≤ 1 - u := sub_nonneg.mpr hu'.2
        have hu1 : 1 - u ≤ 1 := sub_le_self _ hu'.1.le
        rw [norm_smul, Real.norm_eq_abs, abs_of_nonneg (pow_nonneg hu0 J)]
        calc
          _ ≤ (1 - u) ^ J * BP :=
            mul_le_mul_of_nonneg_left (hψbound (J + 1) _) (pow_nonneg hu0 J)
          _ ≤ 1 * BP :=
            mul_le_mul_of_nonneg_right (pow_le_one₀ hu0 hu1) hBP
          _ = BP := one_mul _
      _ = BP := by simp
  have hRnorm (d n : ℤ) :
      ‖R d n‖ ≤ (|η * τ d| ^ (J + 1) / (Nat.factorial J : ℝ)) * BP := by
    dsimp only [R]
    rw [norm_smul, Real.norm_eq_abs, abs_div, abs_pow, Nat.abs_cast]
    exact mul_le_mul_of_nonneg_left (hint d n)
      (div_nonneg (pow_nonneg (abs_nonneg _) _) hfact)
  have hpowx : (x ^ (-(5 * ε))) ^ (J + 1) = x ^ (-α) := by
    simpa only [α, neg_mul] using
      (Real.rpow_mul_natCast hx0.le (-(5 * ε)) (J + 1)).symm
  have hφ0nonneg : 0 ≤ Cφ 0 * (Real.log x) ^ Eφ 0 :=
    mul_nonneg (hCφ 0) (Real.rpow_nonneg hlog0 _)
  let P : ℝ := Q * (Real.log x) ^ E * x ^ (-α)
  have hP : 0 ≤ P :=
    mul_nonneg (mul_nonneg hQ (Real.rpow_nonneg hlog0 _))
      (Real.rpow_nonneg hx0.le _)
  have herr (d n : ℤ) : ‖φ (τ d) * R d n‖ ≤ P := by
    by_cases hd : φ (τ d) = 0
    · simpa only [hd, zero_mul, norm_zero] using hP
    · have hφ0 : ‖φ (τ d)‖ ≤ Cφ 0 * (Real.log x) ^ Eφ 0 := by
        simpa only [iteratedDeriv_zero] using hφbound 0 (τ d)
      calc
        _ = ‖φ (τ d)‖ * ‖R d n‖ := norm_mul _ _
        _ ≤ (Cφ 0 * (Real.log x) ^ Eφ 0) *
            ((|η * τ d| ^ (J + 1) / (Nat.factorial J : ℝ)) * BP) :=
          mul_le_mul hφ0 (hRnorm d n) (norm_nonneg _) hφ0nonneg
        _ ≤ (Cφ 0 * (Real.log x) ^ Eφ 0) *
            (((2 * TD * x ^ (-(5 * ε))) ^ (J + 1) /
              (Nat.factorial J : ℝ)) * BP) :=
          mul_le_mul_of_nonneg_left
            (mul_le_mul_of_nonneg_right
              (div_le_div_of_nonneg_right
                (pow_le_pow_left₀ (abs_nonneg _) (hsmall d hd) _) hfact) hBP)
            hφ0nonneg
        _ = P := by
          rw [mul_pow, hpowx]
          dsimp only [P, Q, BP, E]
          rw [Real.rpow_add hlogpos]
          ring
  have hCpow : 1 ≤ x ^ C := Real.one_le_rpow hx1 hC
  have hBD : (BD.card : ℝ) ≤ (2 * TD + 1) * x ^ C := by
    refine hBDcard.trans ?_
    calc
      2 * TD * D₂ + 1 ≤ 2 * TD * x ^ C + x ^ C :=
        add_le_add (mul_le_mul_of_nonneg_left hDpow
          (mul_nonneg zero_le_two hTD)) hCpow
      _ = (2 * TD + 1) * x ^ C := by ring
  have hBI : (BI.card : ℝ) ≤ (2 * (TN + TD) + 1) * x ^ C := by
    refine hBIcard.trans ?_
    calc
      2 * (TN + TD) * N₂ + 1 ≤ 2 * (TN + TD) * x ^ C + x ^ C :=
        add_le_add (mul_le_mul_of_nonneg_left hNpow
          (mul_nonneg zero_le_two (add_nonneg hTN hTD))) hCpow
      _ = (2 * (TN + TD) + 1) * x ^ C := by ring
  have harea : (BD.card : ℝ) * (BI.card : ℝ) ≤ H * x ^ (2 * C) := by
    calc
      _ ≤ ((2 * TD + 1) * x ^ C) * ((2 * (TN + TD) + 1) * x ^ C) :=
        mul_le_mul hBD hBI (Nat.cast_nonneg _)
          (mul_nonneg (add_nonneg (mul_nonneg zero_le_two hTD) zero_le_one)
            (Real.rpow_nonneg hx0.le _))
      _ = H * x ^ (2 * C) := by
        dsimp only [H]
        rw [show (2 : ℝ) * C = C + C by ring, Real.rpow_add hx0]
        ring
  have hrestrict :
      (∑ d ∈ D, ∑ n ∈ I, A d n * φ (τ d) * R d n) =
        ∑ d ∈ D ∩ BD, ∑ n ∈ I ∩ BI, A d n * φ (τ d) * R d n := by
    symm
    calc
      _ = ∑ d ∈ D ∩ BD, ∑ n ∈ I, A d n * φ (τ d) * R d n := by
        refine Finset.sum_congr rfl fun d _ => Finset.sum_subset Finset.inter_subset_left ?_
        intro n hn hnI
        have hnB : n ∉ BI := fun hnB => hnI (Finset.mem_inter.mpr ⟨hn, hnB⟩)
        have hz : φ (τ d) * R d n = 0 := (hzero d n (Or.inr hnB)).2.2
        simp only [mul_assoc, hz, mul_zero]
      _ = ∑ d ∈ D, ∑ n ∈ I, A d n * φ (τ d) * R d n := by
        refine Finset.sum_subset Finset.inter_subset_left ?_
        intro d hd hdD
        have hdB : d ∉ BD := fun hdB => hdD (Finset.mem_inter.mpr ⟨hd, hdB⟩)
        apply Finset.sum_eq_zero
        intro n _
        have hz : φ (τ d) * R d n = 0 := (hzero d n (Or.inl hdB)).2.2
        simp only [mul_assoc, hz, mul_zero]
  have hDcard : ((D ∩ BD).card : ℝ) ≤ (BD.card : ℝ) := by
    exact_mod_cast Finset.card_le_card (Finset.inter_subset_right : D ∩ BD ⊆ BD)
  have hIcard : ((I ∩ BI).card : ℝ) ≤ (BI.card : ℝ) := by
    exact_mod_cast Finset.card_le_card (Finset.inter_subset_right : I ∩ BI ⊆ BI)
  refine ⟨hone, ?_⟩
  rw [hidentity, add_sub_cancel_left, hrestrict]
  calc
    ‖∑ d ∈ D ∩ BD, ∑ n ∈ I ∩ BI, A d n * φ (τ d) * R d n‖ ≤
        ∑ d ∈ D ∩ BD, ∑ n ∈ I ∩ BI, P := by
      refine norm_sum_le_of_le _ fun d hd => norm_sum_le_of_le _ fun n hn => ?_
      calc
        _ = ‖A d n‖ * ‖φ (τ d) * R d n‖ := by rw [mul_assoc, norm_mul]
        _ ≤ 1 * P :=
          mul_le_mul (hA d (Finset.mem_inter.mp hd).1 n (Finset.mem_inter.mp hn).1)
            (herr d n) (norm_nonneg _) zero_le_one
        _ = P := one_mul _
    _ = ((D ∩ BD).card : ℝ) * ((I ∩ BI).card : ℝ) * P := by
      simp only [Finset.sum_const, nsmul_eq_mul, mul_assoc]
    _ ≤ ((BD.card : ℝ) * (BI.card : ℝ)) * P :=
      mul_le_mul_of_nonneg_right
        (mul_le_mul hDcard hIcard (Nat.cast_nonneg _) (Nat.cast_nonneg _)) hP
    _ ≤ (H * x ^ (2 * C)) * P := mul_le_mul_of_nonneg_right harea hP
    _ = ((H * Q) * (Real.log x) ^ E) * x ^ (2 * C) * x ^ (-α) := by
      dsimp only [P]
      ring
    _ ≤ x ^ (α - B - 2 * C) * x ^ (2 * C) * x ^ (-α) :=
      mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_right (hX₀ x hx).2.2 (Real.rpow_nonneg hx0.le _))
        (Real.rpow_nonneg hx0.le _)
    _ = x ^ (-B) := by
      rw [← Real.rpow_add hx0, ← Real.rpow_add hx0]
      congr 1
      ring

theorem sourceShortSmoothPartition_kernel :
    let χ : ℝ → ℝ := fun t => Real.smoothTransition (t + 1) - Real.smoothTransition t
    ContDiff ℝ ∞ χ ∧
      Function.support χ = Set.Ioo (-1) 1 ∧
      (∀ t : ℝ, 0 ≤ χ t ∧ χ t ≤ 1) ∧
      (∀ (K : ℕ) (t : ℝ), 0 ≤ t → t ≤ (K : ℝ) →
        ∑ j ∈ Finset.range (K + 1), χ (t - (j : ℝ)) = 1) ∧
      ∃ Cχ : ℕ → ℝ, (∀ r : ℕ, 0 < Cχ r) ∧
        ∀ (r : ℕ) (t : ℝ), ‖iteratedDeriv r χ t‖ ≤ Cχ r := by
  classical
  let χ : ℝ → ℝ := fun t => Real.smoothTransition (t + 1) - Real.smoothTransition t
  have hχsmooth : ContDiff ℝ ∞ χ :=
    (Real.smoothTransition.contDiff.comp (contDiff_id.add contDiff_const)).sub
      Real.smoothTransition.contDiff
  have hz (t : ℝ) (ht : t ≤ -1 ∨ 1 ≤ t) : χ t = 0 := by
    rcases ht with ht | ht
    · simp only [χ, Real.smoothTransition.zero_of_nonpos (show t + 1 ≤ 0 by linarith),
        Real.smoothTransition.zero_of_nonpos (show t ≤ 0 by linarith), sub_self]
    · simp only [χ, Real.smoothTransition.one_of_one_le (show 1 ≤ t + 1 by linarith),
        Real.smoothTransition.one_of_one_le ht, sub_self]
  have hχsupport : Function.support χ = Set.Ioo (-1) 1 := by
    ext t
    change χ t ≠ 0 ↔ -1 < t ∧ t < 1
    constructor
    · intro ht
      exact ⟨lt_of_not_ge (fun h => ht (hz t (Or.inl h))),
        lt_of_not_ge (fun h => ht (hz t (Or.inr h)))⟩
    · rintro ⟨hlo, hhi⟩
      apply ne_of_gt
      dsimp only [χ]
      rcases le_or_gt t 0 with ht | ht
      · rw [Real.smoothTransition.zero_of_nonpos ht, sub_zero]
        exact Real.smoothTransition.pos_of_pos (by linarith)
      · rw [Real.smoothTransition.one_of_one_le (show 1 ≤ t + 1 by linarith)]
        exact sub_pos.mpr (Real.smoothTransition.lt_one_of_lt_one hhi)
  have hχrange (t : ℝ) : 0 ≤ χ t ∧ χ t ≤ 1 := by
    constructor
    · exact sub_nonneg.mpr (Real.smoothTransition.monotone (by linarith))
    · dsimp only [χ]
      linarith [Real.smoothTransition.le_one (t + 1), Real.smoothTransition.nonneg t]
  have hχsum (K : ℕ) (t : ℝ) (ht : 0 ≤ t) (hK : t ≤ (K : ℝ)) :
      ∑ j ∈ Finset.range (K + 1), χ (t - (j : ℝ)) = 1 := by
    have htel : (∑ j ∈ Finset.range (K + 1), χ (t - (j : ℝ))) =
        Real.smoothTransition (t + 1) - Real.smoothTransition (t - (K : ℝ)) := by
      calc
        _ = ∑ j ∈ Finset.range (K + 1),
            (Real.smoothTransition (t + 1 - (j : ℝ)) -
              Real.smoothTransition (t + 1 - ((j + 1 : ℕ) : ℝ))) := by
          apply Finset.sum_congr rfl
          intro j hj
          dsimp only [χ]
          congr 2 <;> push_cast <;> ring
        _ = _ := by
          rw [Finset.sum_range_sub']
          simp only [Nat.cast_zero, sub_zero, Nat.cast_add, Nat.cast_one]
          congr 2
          ring
    rw [htel, Real.smoothTransition.one_of_one_le (by linarith),
      Real.smoothTransition.zero_of_nonpos (by linarith)]
    norm_num
  have hcompact : HasCompactSupport χ :=
    HasCompactSupport.of_support_subset_isCompact isCompact_Icc
      (by rw [hχsupport]; exact Set.Ioo_subset_Icc_self)
  have hb (r : ℕ) : ∃ B : ℝ, 0 < B ∧ ∀ t : ℝ, ‖iteratedDeriv r χ t‖ ≤ B := by
    have hc : HasCompactSupport (iteratedDeriv r χ) := by
      rw [iteratedDeriv_eq_equiv_comp]
      exact (hcompact.iteratedFDeriv r).comp_left (map_zero _)
    simpa using (hc.isCompact_range
      (hχsmooth.continuous_iteratedDeriv r (by simp))).isBounded.exists_pos_norm_le
  choose Cχ hCχ hbound using hb
  exact ⟨hχsmooth, hχsupport, hχrange, hχsum, Cχ, hCχ, hbound⟩

theorem sourceShortSmoothPartition_finite_decomposition
    (R Δ₁ Δstar z₁ d₀ : ℝ)
    (hR : 0 ≤ R) (hΔ₁ : 0 < Δ₁) (hΔstar : 0 < Δstar)
    (hshort : Δstar ≤ Δ₁) (hz₁ : 0 < z₁)
    (ψ : ℝ → ℂ) (hψsupport : Function.support ψ ⊆ Set.Icc (-R) R) :
    let χ : ℝ → ℝ := fun t => Real.smoothTransition (t + 1) - Real.smoothTransition t
    let ρ : ℝ := Δstar / Δ₁
    let J : Finset ℕ := Finset.range (⌈4 * R * Δ₁ / Δstar⌉₊ + 1)
    let center : ℕ → ℝ := fun j => (d₀ - R * Δ₁ + Δstar * (j : ℝ) / 2) / z₁
    let τ : ℕ → ℝ → ℂ := fun j t => χ (2 * t) • ψ (-R + ρ * (t + (j : ℝ) / 2))
    0 < Δstar / z₁ ∧ J.Nonempty ∧
      (J.card : ℝ) ≤ (4 * R + 2) * Δ₁ / Δstar ∧
      (∀ j ∈ J, |center j| ≤ (|d₀| + (R + 1) * Δ₁) / z₁) ∧
      (∀ j : ℕ, Function.support (τ j) ⊆ Set.Ioo (-(1 / 2 : ℝ)) (1 / 2)) ∧
      (∀ (j : ℕ) (t : ℝ),
        τ j ((t - center j) / (Δstar / z₁)) =
          χ (2 * ((z₁ * t - d₀ + R * Δ₁) / Δstar) - (j : ℝ)) •
            ψ ((z₁ * t - d₀) / Δ₁)) ∧
      (∀ t : ℝ, ψ ((z₁ * t - d₀) / Δ₁) =
        ∑ j ∈ J, τ j ((t - center j) / (Δstar / z₁))) ∧
      ∀ (D I : Finset ℤ) (A : ℤ → ℤ → ℂ),
        ((∑ d ∈ D, ∑ n ∈ I, A d n * ψ ((z₁ * (d : ℝ) - d₀) / Δ₁)) =
          ∑ j ∈ J, ∑ d ∈ D, ∑ n ∈ I,
            A d n * τ j (((d : ℝ) - center j) / (Δstar / z₁))) ∧
        ∃ j ∈ J,
          ‖∑ d ∈ D, ∑ n ∈ I, A d n * ψ ((z₁ * (d : ℝ) - d₀) / Δ₁)‖ ≤
            ((4 * R + 2) * Δ₁ / Δstar) *
              ‖∑ d ∈ D, ∑ n ∈ I,
                A d n * τ j (((d : ℝ) - center j) / (Δstar / z₁))‖ := by
  classical
  let χ : ℝ → ℝ := fun t => Real.smoothTransition (t + 1) - Real.smoothTransition t
  let ρ : ℝ := Δstar / Δ₁
  let K : ℕ := ⌈4 * R * Δ₁ / Δstar⌉₊
  let J : Finset ℕ := Finset.range (K + 1)
  let center : ℕ → ℝ := fun j => (d₀ - R * Δ₁ + Δstar * (j : ℝ) / 2) / z₁
  let τ : ℕ → ℝ → ℂ := fun j t => χ (2 * t) • ψ (-R + ρ * (t + (j : ℝ) / 2))
  obtain ⟨_, hχsupport, _, hχsum, _⟩ := sourceShortSmoothPartition_kernel
  have hJ : J.Nonempty := ⟨0, by simp [J]⟩
  have hKlt : (K : ℝ) < 4 * R * Δ₁ / Δstar + 1 :=
    Nat.ceil_lt_add_one (by positivity)
  have hratio : 1 ≤ Δ₁ / Δstar := (one_le_div₀ hΔstar).mpr hshort
  have hcard : (J.card : ℝ) ≤ (4 * R + 2) * Δ₁ / Δstar := by
    calc
      (J.card : ℝ) = (K : ℝ) + 1 := by simp [J]
      _ ≤ 4 * R * Δ₁ / Δstar + 2 := by linarith
      _ ≤ (4 * R + 2) * Δ₁ / Δstar := by
        nlinarith [show (4 * R + 2) * Δ₁ / Δstar =
            4 * R * Δ₁ / Δstar + 2 * (Δ₁ / Δstar) by ring]
  have hcenter (j : ℕ) (hj : j ∈ J) :
      |center j| ≤ (|d₀| + (R + 1) * Δ₁) / z₁ := by
    have hjreal : (j : ℝ) ≤ K :=
      Nat.cast_le.mpr (Nat.le_of_lt_succ (Finset.mem_range.mp hj))
    have hjstep : Δstar * (j : ℝ) ≤ 4 * R * Δ₁ + Δstar := by
      calc
        _ ≤ Δstar * (4 * R * Δ₁ / Δstar + 1) :=
          mul_le_mul_of_nonneg_left (hjreal.trans hKlt.le) hΔstar.le
        _ = _ := by field_simp [hΔstar.ne']
    have hshift : |-R * Δ₁ + Δstar * (j : ℝ) / 2| ≤ (R + 1) * Δ₁ := by
      rw [abs_le]
      constructor <;> nlinarith [mul_nonneg hR hΔ₁.le,
        mul_nonneg hΔstar.le (Nat.cast_nonneg j)]
    calc
      |center j| = |d₀ + (-R * Δ₁ + Δstar * (j : ℝ) / 2)| / z₁ := by
        dsimp only [center]
        rw [abs_div, abs_of_pos hz₁]
        congr 2
        ring
      _ ≤ (|d₀| + (R + 1) * Δ₁) / z₁ :=
        div_le_div_of_nonneg_right
          ((abs_add_le _ _).trans (add_le_add (le_refl _) hshift)) hz₁.le
  have hτsupport (j : ℕ) :
      Function.support (τ j) ⊆ Set.Ioo (-(1 / 2 : ℝ)) (1 / 2) := by
    intro t ht
    have hh : 2 * t ∈ Set.Ioo (-1 : ℝ) 1 := by
      rw [← hχsupport]
      exact left_ne_zero_of_smul ht
    constructor <;> linarith [hh.1, hh.2]
  have hformula (j : ℕ) (t : ℝ) :
      τ j ((t - center j) / (Δstar / z₁)) =
        χ (2 * ((z₁ * t - d₀ + R * Δ₁) / Δstar) - (j : ℝ)) •
          ψ ((z₁ * t - d₀) / Δ₁) := by
    dsimp only [τ, center, ρ]
    congr 2
    · field_simp [hΔstar.ne', hz₁.ne']
      ring
    · field_simp [hΔ₁.ne', hΔstar.ne', hz₁.ne']
      ring
  have hdecomp (t : ℝ) : ψ ((z₁ * t - d₀) / Δ₁) =
      ∑ j ∈ J, τ j ((t - center j) / (Δstar / z₁)) := by
    simp_rw [hformula]
    rw [← Finset.sum_smul]
    by_cases hzero : ψ ((z₁ * t - d₀) / Δ₁) = 0
    · simp only [hzero, smul_zero]
    · have hband := hψsupport hzero
      have hlo := (le_div_iff₀ hΔ₁).mp hband.1
      have hhi := (div_le_iff₀ hΔ₁).mp hband.2
      have hylo : 0 ≤ 2 * ((z₁ * t - d₀ + R * Δ₁) / Δstar) :=
        mul_nonneg (by norm_num) (div_nonneg (by nlinarith) hΔstar.le)
      have hyhi : 2 * ((z₁ * t - d₀ + R * Δ₁) / Δstar) ≤ (K : ℝ) := by
        calc
          _ ≤ 4 * R * Δ₁ / Δstar := by
            rw [← mul_div_assoc]
            exact (div_le_div_iff_of_pos_right hΔstar).mpr (by nlinarith)
          _ ≤ K := Nat.le_ceil _
      rw [show (∑ j ∈ J,
          χ (2 * ((z₁ * t - d₀ + R * Δ₁) / Δstar) - (j : ℝ))) = 1 from
        hχsum K _ hylo hyhi, one_smul]
  refine ⟨div_pos hΔstar hz₁, hJ, hcard, hcenter, hτsupport, hformula, hdecomp, ?_⟩
  intro D I A
  have hs : (∑ d ∈ D, ∑ n ∈ I, A d n * ψ ((z₁ * (d : ℝ) - d₀) / Δ₁)) =
      ∑ j ∈ J, ∑ d ∈ D, ∑ n ∈ I,
        A d n * τ j (((d : ℝ) - center j) / (Δstar / z₁)) := by
    simp_rw [hdecomp, Finset.mul_sum]
    exact Finset.sum_comm_cycle
  let F : ℕ → ℂ := fun j => ∑ d ∈ D, ∑ n ∈ I,
    A d n * τ j (((d : ℝ) - center j) / (Δstar / z₁))
  obtain ⟨j, hj, hmax⟩ := J.exists_max_image (fun j => ‖F j‖) hJ
  refine ⟨hs, j, hj, ?_⟩
  rw [hs]
  calc
    ‖∑ j ∈ J, F j‖ ≤ (J.card : ℝ) * ‖F j‖ := by
      simpa only [Finset.sum_const, nsmul_eq_mul] using norm_sum_le_of_le J hmax
    _ ≤ ((4 * R + 2) * Δ₁ / Δstar) * ‖F j‖ :=
      mul_le_mul_of_nonneg_right hcard (norm_nonneg _)

theorem sourceShortSmoothPartition_uniform_source_profiles
    (R : ℝ) (hR : 0 ≤ R) (C E : ℕ → ℝ) (hC : ∀ r : ℕ, 0 ≤ C r) :
    ∃ Cshort Eshort : ℕ → ℝ,
      (∀ r : ℕ, 0 < Cshort r ∧ 0 ≤ Eshort r) ∧
      ∀ (x : ℝ), Real.exp 1 ≤ x →
      ∀ (ψ : ℝ → ℂ), ContDiff ℝ ∞ ψ →
      Function.support ψ ⊆ Set.Icc (-R) R →
      (∀ (r : ℕ) (t : ℝ), ‖iteratedDeriv r ψ t‖ ≤ C r * (Real.log x) ^ E r) →
      ∀ (N Λ Δ₁ d₀ ε : ℝ), 0 < N → Λ ≠ 0 → 0 < Δ₁ →
      ∀ (z₁ : ℕ), 0 < z₁ →
      let Δstar : ℝ := min (N / (|Λ| * x ^ (5 * ε))) Δ₁
      let Dshort : ℝ := Δstar / (z₁ : ℝ)
      let χ : ℝ → ℝ := fun t => Real.smoothTransition (t + 1) - Real.smoothTransition t
      let ρ : ℝ := Δstar / Δ₁
      let J : Finset ℕ := Finset.range (⌈4 * R * Δ₁ / Δstar⌉₊ + 1)
      let center : ℕ → ℝ := fun j =>
        (d₀ - R * Δ₁ + Δstar * (j : ℝ) / 2) / (z₁ : ℝ)
      let τ : ℕ → ℝ → ℂ := fun j t =>
        χ (2 * t) • ψ (-R + ρ * (t + (j : ℝ) / 2))
      0 < Δstar ∧ Δstar ≤ Δ₁ ∧ 0 < Dshort ∧ Dshort ≤ Δ₁ ∧
        (∀ j : ℕ, ContDiff ℝ ∞ (τ j) ∧
          Function.support (τ j) ⊆ Set.Icc (-(1 / 2 : ℝ)) (1 / 2) ∧
          ∀ (r : ℕ) (t : ℝ),
            ‖iteratedDeriv r (τ j) t‖ ≤ Cshort r * (Real.log x) ^ Eshort r ∧
              ‖iteratedDeriv r
                (fun u : ℝ => τ j ((u - center j) / Dshort)) t‖ ≤
                Cshort r * (Real.log x) ^ Eshort r / Dshort ^ r) ∧
        (∀ j ∈ J, |center j| ≤ |d₀| + (R + 1) * Δ₁) ∧
        (∀ (P : ℝ), |d₀| ≤ x ^ P → Δ₁ ≤ x ^ P →
          ∀ j ∈ J, |center j| ≤ (R + 2) * x ^ P) := by
  classical
  let χ : ℝ → ℝ := fun t => Real.smoothTransition (t + 1) - Real.smoothTransition t
  obtain ⟨hχ, _, _, _, Cχ, hCχ, hboundχ⟩ := sourceShortSmoothPartition_kernel
  let a : ℕ → ℕ → ℝ := fun r i =>
    (r.choose i : ℝ) * (2 : ℝ) ^ i * Cχ i * C (r - i)
  let c : ℕ → ℝ := fun r => 1 + ∑ i ∈ Finset.range (r + 1), a r i
  let e : ℕ → ℝ := fun r => ∑ i ∈ Finset.range (r + 1), max 0 (E i)
  have ha (r i : ℕ) : 0 ≤ a r i :=
    mul_nonneg
      (mul_nonneg (mul_nonneg (Nat.cast_nonneg _) (pow_nonneg (by norm_num) i))
        (hCχ i).le) (hC (r - i))
  have hc (r : ℕ) : 0 < c r :=
    add_pos_of_pos_of_nonneg zero_lt_one (Finset.sum_nonneg' (ha r))
  have he₀ (r : ℕ) : 0 ≤ e r :=
    Finset.sum_nonneg' fun i => le_max_left 0 (E i)
  have he (r i : ℕ) (hi : i ≤ r) : E i ≤ e r :=
    (le_max_right 0 (E i)).trans
      (Finset.single_le_sum (fun q _ => le_max_left 0 (E q))
        (Finset.mem_range.mpr (Nat.lt_succ_of_le hi)))
  refine ⟨c, e, fun r => ⟨hc r, he₀ r⟩, ?_⟩
  intro x hx ψ hψ hsupport hbound N Λ Δ₁ d₀ ε hN hΛ hΔ₁ z₁ hz₁
  let L : ℝ := Real.log x
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
  have hL : 1 ≤ L := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hx
  let δ : ℝ := min (N / (|Λ| * x ^ (5 * ε))) Δ₁
  let D : ℝ := δ / (z₁ : ℝ)
  let ρ : ℝ := δ / Δ₁
  let J : Finset ℕ := Finset.range (⌈4 * R * Δ₁ / δ⌉₊ + 1)
  let center : ℕ → ℝ := fun j =>
    (d₀ - R * Δ₁ + δ * (j : ℝ) / 2) / (z₁ : ℝ)
  let G : ℝ → ℝ := fun t => χ (2 * t)
  let P : ℕ → ℝ → ℂ := fun j t => ψ (-R + ρ * (t + (j : ℝ) / 2))
  let τ : ℕ → ℝ → ℂ := fun j t => G t • P j t
  have hδ : 0 < δ :=
    lt_min (div_pos hN (mul_pos (abs_pos.mpr hΛ) (Real.rpow_pos_of_pos hxpos _))) hΔ₁
  have hδle : δ ≤ Δ₁ := min_le_right _ _
  have hz : (0 : ℝ) < z₁ := Nat.cast_pos.mpr hz₁
  have hzOne : (1 : ℝ) ≤ z₁ := Nat.one_le_cast.mpr hz₁
  have hD : 0 < D := div_pos hδ hz
  have hDle : D ≤ Δ₁ := (div_le_self hδ.le hzOne).trans hδle
  have hρ : 0 < ρ := div_pos hδ hΔ₁
  have hρle : ρ ≤ 1 := (div_le_one hΔ₁).2 hδle
  obtain ⟨_, _, _, hcenter, hsupportτ, _, _, _⟩ :=
    sourceShortSmoothPartition_finite_decomposition
      R Δ₁ δ (z₁ : ℝ) d₀ hR hΔ₁ hδ hδle hz ψ hsupport
  have hG : ContDiff ℝ ∞ G := hχ.comp (contDiff_const.mul contDiff_id)
  have hP (j : ℕ) : ContDiff ℝ ∞ (P j) :=
    hψ.comp (contDiff_const.add
      (contDiff_const.mul (contDiff_id.add contDiff_const)))
  have hτ (j : ℕ) : ContDiff ℝ ∞ (τ j) := hG.smul (hP j)
  have hGnorm (r : ℕ) (t : ℝ) :
      ‖iteratedDeriv r G t‖ ≤ (2 : ℝ) ^ r * Cχ r := by
    have hformula : iteratedDeriv r G t =
        (2 : ℝ) ^ r • iteratedDeriv r χ (2 * t) :=
      congrFun (iteratedDeriv_comp_const_smul (contDiff_infty.mp hχ r) (2 : ℝ)) t
    rw [hformula, norm_smul, Real.norm_eq_abs,
      abs_of_nonneg (pow_nonneg (by norm_num : (0 : ℝ) ≤ 2) r)]
    exact mul_le_mul_of_nonneg_left (hboundχ r (2 * t)) (pow_nonneg (by norm_num) r)
  have hPnorm (j r : ℕ) (t : ℝ) :
      ‖iteratedDeriv r (P j) t‖ ≤ C r * L ^ E r := by
    have hformula : iteratedDeriv r (P j) t =
        ρ ^ r • iteratedDeriv r ψ (-R + ρ * (t + (j : ℝ) / 2)) := by
      have hs : ContDiff ℝ r (fun v : ℝ => ψ (-R + v)) :=
        (contDiff_infty.mp hψ r).comp (contDiff_const.add contDiff_id)
      dsimp only [P]
      rw [iteratedDeriv_comp_add_const r (fun v : ℝ => ψ (-R + ρ * v)),
        iteratedDeriv_comp_const_smul hs ρ, iteratedDeriv_comp_const_add]
    rw [hformula, norm_smul, Real.norm_eq_abs, abs_of_nonneg (pow_nonneg hρ.le r)]
    exact (mul_le_of_le_one_left (norm_nonneg _) (pow_le_one₀ hρ.le hρle)).trans
      (hbound r _)
  have hτnorm (j r : ℕ) (t : ℝ) :
      ‖iteratedDeriv r (τ j) t‖ ≤ c r * L ^ e r := by
    have hnorm : ‖iteratedDeriv r (τ j) t‖ ≤
        ∑ i ∈ Finset.range (r + 1), (r.choose i : ℝ) *
          ‖iteratedDeriv i G t‖ * ‖iteratedDeriv (r - i) (P j) t‖ := by
      simpa only [norm_iteratedFDeriv_eq_norm_iteratedDeriv] using
        norm_iteratedFDeriv_smul_le (𝕜 := ℝ) (n := r) hG (hP j) t (by simp)
    have hterms (i : ℕ) :
        (r.choose i : ℝ) * ‖iteratedDeriv i G t‖ *
          ‖iteratedDeriv (r - i) (P j) t‖ ≤ a r i * L ^ e r := by
      have hci : 0 ≤ (r.choose i : ℝ) := Nat.cast_nonneg _
      have hp : 0 ≤ (2 : ℝ) ^ i * Cχ i :=
        mul_nonneg (pow_nonneg (by norm_num) i) (hCχ i).le
      have hpow : L ^ E (r - i) ≤ L ^ e r :=
        Real.rpow_le_rpow_of_exponent_le hL (he r (r - i) (Nat.sub_le _ _))
      calc
        (r.choose i : ℝ) * ‖iteratedDeriv i G t‖ *
            ‖iteratedDeriv (r - i) (P j) t‖ ≤
            (r.choose i : ℝ) * ((2 : ℝ) ^ i * Cχ i) *
              (C (r - i) * L ^ E (r - i)) :=
          mul_le_mul (mul_le_mul_of_nonneg_left (hGnorm i t) hci)
            (hPnorm j (r - i) t) (norm_nonneg _) (mul_nonneg hci hp)
        _ = a r i * L ^ E (r - i) := by simp only [a, mul_assoc]
        _ ≤ a r i * L ^ e r := mul_le_mul_of_nonneg_left hpow (ha r i)
    calc
      ‖iteratedDeriv r (τ j) t‖ ≤
          ∑ i ∈ Finset.range (r + 1), a r i * L ^ e r :=
        hnorm.trans (Finset.sum_le_sum fun i _ => hterms i)
      _ = (∑ i ∈ Finset.range (r + 1), a r i) * L ^ e r := by rw [Finset.sum_mul]
      _ ≤ c r * L ^ e r :=
        mul_le_mul_of_nonneg_right (le_add_of_nonneg_left zero_le_one)
          (Real.rpow_nonneg (zero_le_one.trans hL) _)
  have hphysical (j r : ℕ) (t : ℝ) :
      ‖iteratedDeriv r (fun u : ℝ => τ j ((u - center j) / D)) t‖ ≤
        c r * L ^ e r / D ^ r := by
    have hformula :
        iteratedDeriv r (fun u : ℝ => τ j ((u - center j) / D)) t =
          (D⁻¹) ^ r • iteratedDeriv r (τ j) ((t - center j) / D) := by
      have ht := congrFun
        (iteratedDeriv_comp_sub_const r (fun u : ℝ => τ j (D⁻¹ * u)) (center j)) t
      rw [iteratedDeriv_comp_const_smul (contDiff_infty.mp (hτ j) r) D⁻¹] at ht
      simpa only [div_eq_mul_inv, mul_comm] using ht
    rw [hformula, norm_smul, Real.norm_eq_abs,
      abs_of_nonneg (pow_nonneg (inv_nonneg.mpr hD.le) r), inv_pow]
    simpa only [div_eq_mul_inv, mul_comm] using
      div_le_div_of_nonneg_right (hτnorm j r ((t - center j) / D))
        (pow_nonneg hD.le r)
  have hcenters (j : ℕ) (hj : j ∈ J) :
      |center j| ≤ |d₀| + (R + 1) * Δ₁ :=
    (hcenter j hj).trans (div_le_self (by positivity) hzOne)
  refine ⟨hδ, hδle, hD, hDle, ?_, hcenters, ?_⟩
  · intro j
    refine ⟨hτ j, (hsupportτ j).trans Set.Ioo_subset_Icc_self, ?_⟩
    exact fun r t => ⟨hτnorm j r t, hphysical j r t⟩
  · intro q hd hΔ j hj
    calc
      |center j| ≤ |d₀| + (R + 1) * Δ₁ := hcenters j hj
      _ ≤ x ^ q + (R + 1) * x ^ q :=
        add_le_add hd (mul_le_mul_of_nonneg_left hΔ (by linarith))
      _ = (R + 2) * x ^ q := by ring

end

section
open scoped ContDiff
open Classical in
theorem sourceTerminalSigma5_finite_linearization
    (s : ℕ) (hs : 0 < s) (lam lamTilde : ℤ) (hlam : lam ≠ 0)
    (D : Finset ℕ) (hD : ∀ d ∈ D, 0 < d) (I : Finset ℤ)
    (φ : ℕ → ℂ) (ψ : ℤ → ℂ) (hI : ∀ n : ℤ, ψ n ≠ 0 → n ∈ I)
    (U : ℕ → ℤ → ℤ → ℂ) :
    let kOf : ℕ × (ℤ × ℤ) → ℤ := fun p =>
      (lam * p.2.2 - lamTilde * p.2.1) / ((s : ℤ) * (p.1 : ℤ))
    let ntOf : ℤ → ℕ → ℤ → ℤ := fun k d n =>
      (lamTilde * n + (s : ℤ) * k * (d : ℤ)) / lam
    let T : Finset (ℕ × (ℤ × ℤ)) := (D ×ˢ (I ×ˢ I)).filter fun p =>
      Int.ModEq ((s * p.1 : ℕ) : ℤ) (lam * p.2.2) (lamTilde * p.2.1) ∧
        U p.1 p.2.1 p.2.2 * φ p.1 * ψ p.2.1 * ψ p.2.2 ≠ 0
    let K : Finset ℤ := T.image kOf
    K.card ≤ D.card * I.card ^ 2 ∧
      (∀ k ∈ K, ∃ d ∈ D, ∃ n ∈ I, ∃ nt ∈ I,
        lam * nt - lamTilde * n = (s : ℤ) * k * (d : ℤ) ∧
          lam ∣ lamTilde * n + (s : ℤ) * k * (d : ℤ) ∧
          ntOf k d n = nt ∧ U d n nt * φ d * ψ n * ψ nt ≠ 0) ∧
      (∀ (k : ℤ) (d : ℕ) (n : ℤ), ntOf k d n ∉ I →
        U d n (ntOf k d n) * φ d * ψ n * ψ (ntOf k d n) = 0) ∧
      (∑ d ∈ D, ∑ n ∈ I, ∑ nt ∈ I,
        if Int.ModEq ((s * d : ℕ) : ℤ) (lam * nt) (lamTilde * n) then
          U d n nt * φ d * ψ n * ψ nt else 0) =
        ∑ k ∈ K, ∑ d ∈ D, ∑ n ∈ I,
          if lam ∣ lamTilde * n + (s : ℤ) * k * (d : ℤ) then
            U d n (ntOf k d n) * φ d * ψ n * ψ (ntOf k d n) else 0 := by
  intro kOf ntOf T K
  let : NeZero s := ⟨Nat.ne_of_gt hs⟩
  have hforward (d : ℕ) (n nt : ℤ)
      (hc : Int.ModEq ((s * d : ℕ) : ℤ) (lam * nt) (lamTilde * n)) :
      lam * nt - lamTilde * n = (s : ℤ) * kOf (d, n, nt) * (d : ℤ) ∧
        lam ∣ lamTilde * n + (s : ℤ) * kOf (d, n, nt) * (d : ℤ) ∧
        ntOf (kOf (d, n, nt)) d n = nt := by
    have hdiv : (s : ℤ) * (d : ℤ) ∣ lam * nt - lamTilde * n := by
      simpa only [Nat.cast_mul] using Int.modEq_iff_dvd.mp hc.symm
    have hrel : lam * nt - lamTilde * n =
        (s : ℤ) * kOf (d, n, nt) * (d : ℤ) := by
      dsimp only [kOf]
      simpa only [mul_assoc, mul_left_comm, mul_comm] using
        (Int.mul_ediv_cancel_of_dvd hdiv).symm
    have hnum : lamTilde * n + (s : ℤ) * kOf (d, n, nt) * (d : ℤ) =
        lam * nt :=
      (Int.sub_eq_iff_eq_add'.mp hrel).symm
    exact ⟨hrel, ⟨nt, hnum⟩, Int.ediv_eq_of_eq_mul_right hlam hnum⟩
  have hback (d : ℕ) (hd : d ∈ D) (n k : ℤ)
      (hdiv : lam ∣ lamTilde * n + (s : ℤ) * k * (d : ℤ)) :
      Int.ModEq ((s * d : ℕ) : ℤ) (lam * ntOf k d n) (lamTilde * n) ∧
        kOf (d, n, ntOf k d n) = k := by
    let : NeZero d := ⟨Nat.ne_of_gt (hD d hd)⟩
    have hrel := ((sourceTerminalLinearization_exact s d 1 lam lamTilde n
      (ntOf k d n) 0 0 hlam).2 k hdiv rfl).1
    refine ⟨?_, ?_⟩
    · refine (Int.modEq_iff_dvd.mpr ⟨k, ?_⟩).symm
      simpa only [Nat.cast_mul, mul_assoc, mul_left_comm, mul_comm] using hrel
    · dsimp only [kOf]
      apply Int.ediv_eq_of_eq_mul_right
        (mul_ne_zero (NeZero.ne (s : ℤ)) (NeZero.ne (d : ℤ)))
      simpa only [mul_assoc, mul_left_comm, mul_comm] using hrel
  have hcard : K.card ≤ D.card * I.card ^ 2 := by
    calc
      K.card ≤ T.card := Finset.card_image_le
      _ ≤ (D ×ˢ (I ×ˢ I)).card := Finset.card_filter_le _ _
      _ = D.card * I.card ^ 2 := by simp only [Finset.card_product, pow_two]
  have hK : ∀ k ∈ K, ∃ d ∈ D, ∃ n ∈ I, ∃ nt ∈ I,
      lam * nt - lamTilde * n = (s : ℤ) * k * (d : ℤ) ∧
        lam ∣ lamTilde * n + (s : ℤ) * k * (d : ℤ) ∧
        ntOf k d n = nt ∧ U d n nt * φ d * ψ n * ψ nt ≠ 0 := by
    intro k hk
    obtain ⟨⟨d, n, nt⟩, hp, rfl⟩ := Finset.mem_image.mp hk
    rcases Finset.mem_filter.mp hp with ⟨hp, hc, hw⟩
    rcases Finset.mem_product.mp hp with ⟨hd, hnnt⟩
    rcases Finset.mem_product.mp hnnt with ⟨hn, hnt⟩
    have hlin := hforward d n nt hc
    exact ⟨d, hd, n, hn, nt, hnt, hlin.1, hlin.2.1, hlin.2.2, hw⟩
  have hzero : ∀ (k : ℤ) (d : ℕ) (n : ℤ), ntOf k d n ∉ I →
      U d n (ntOf k d n) * φ d * ψ n * ψ (ntOf k d n) = 0 := by
    intro k d n hnt
    rw [not_imp_comm.mp (hI (ntOf k d n)) hnt, mul_zero]
  let f : ℕ × (ℤ × ℤ) → ℂ := fun p =>
    if Int.ModEq ((s * p.1 : ℕ) : ℤ) (lam * p.2.2) (lamTilde * p.2.1) then
      U p.1 p.2.1 p.2.2 * φ p.1 * ψ p.2.1 * ψ p.2.2 else 0
  let g : ℤ × (ℕ × ℤ) → ℂ := fun p =>
    if lam ∣ lamTilde * p.2.2 + (s : ℤ) * p.1 * (p.2.1 : ℤ) then
      U p.2.1 p.2.2 (ntOf p.1 p.2.1 p.2.2) * φ p.2.1 * ψ p.2.2 *
        ψ (ntOf p.1 p.2.1 p.2.2) else 0
  have hnonzero (p : ℕ × (ℤ × ℤ)) (hp : f p ≠ 0) :
      Int.ModEq ((s * p.1 : ℕ) : ℤ) (lam * p.2.2) (lamTilde * p.2.1) ∧
        U p.1 p.2.1 p.2.2 * φ p.1 * ψ p.2.1 * ψ p.2.2 ≠ 0 :=
    ite_ne_right_iff.mp hp
  have hsum : (∑ p ∈ D ×ˢ (I ×ˢ I), f p) =
      ∑ p ∈ K ×ˢ (D ×ˢ I), g p := by
    refine Finset.sum_bij_ne_zero
      (fun p _ _ => (kOf p, p.1, p.2.1)) ?_ ?_ ?_ ?_
    · intro p hp hfp
      have hpT : p ∈ T := Finset.mem_filter.mpr ⟨hp, hnonzero p hfp⟩
      exact Finset.mem_product.mpr
        ⟨Finset.mem_image_of_mem kOf hpT, Finset.mem_product.mpr
          ⟨(Finset.mem_product.mp hp).1,
            (Finset.mem_product.mp (Finset.mem_product.mp hp).2).1⟩⟩
    · intro p _ hfp q _ hfq heq
      have hkEq : kOf p = kOf q := congrArg Prod.fst heq
      have hdEq : p.1 = q.1 :=
        congrArg (fun r : ℤ × (ℕ × ℤ) => r.2.1) heq
      have hnEq : p.2.1 = q.2.1 :=
        congrArg (fun r : ℤ × (ℕ × ℤ) => r.2.2) heq
      have hpnt := (hforward p.1 p.2.1 p.2.2 (hnonzero p hfp).1).2.2
      have hqnt := (hforward q.1 q.2.1 q.2.2 (hnonzero q hfq).1).2.2
      have hntEq : p.2.2 = q.2.2 := by
        calc
          p.2.2 = ntOf (kOf p) p.1 p.2.1 := hpnt.symm
          _ = ntOf (kOf q) q.1 q.2.1 := by rw [hkEq, hdEq, hnEq]
          _ = q.2.2 := hqnt
      exact Prod.ext hdEq (Prod.ext hnEq hntEq)
    · intro q hq hgq
      rcases ite_ne_right_iff.mp hgq with ⟨hdiv, hweight⟩
      rcases Finset.mem_product.mp (Finset.mem_product.mp hq).2 with ⟨hd, hn⟩
      have hnt : ntOf q.1 q.2.1 q.2.2 ∈ I :=
        hI _ (mul_ne_zero_iff.mp hweight).2
      have hb := hback q.2.1 hd q.2.2 q.1 hdiv
      refine ⟨(q.2.1, q.2.2, ntOf q.1 q.2.1 q.2.2), ?_, ?_, ?_⟩
      · exact Finset.mem_product.mpr ⟨hd, Finset.mem_product.mpr ⟨hn, hnt⟩⟩
      · simpa only [f, ite_eq_left hb.1] using hweight
      · exact Prod.ext hb.2 (Prod.ext rfl rfl)
    · intro p _ hfp
      have hc := (hnonzero p hfp).1
      have hh := hforward p.1 p.2.1 p.2.2 hc
      simp only [f, g, ite_eq_left hc, ite_eq_left hh.2.1, hh.2.2]
  refine ⟨hcard, hK, hzero, ?_⟩
  simpa only [f, g, Finset.sum_product] using hsum

open Classical in
theorem sourceTerminalSigma6_class_partition
    (q₀ m w₂ g₀ : ℕ) [NeZero q₀]
    (lam lamTilde s k : ℤ) (hqm : q₀ ∣ m) (hw₂ : 0 < w₂)
    (hlam : (w₂ : ℤ) ∣ lam) (hlamTilde : (w₂ : ℤ) ∣ lamTilde)
    (hk : (w₂ : ℤ) ∣ k)
    (hu : IsUnit ((lam / (w₂ : ℤ) : ℤ) : ZMod m))
    (hv : IsUnit ((lamTilde / (w₂ : ℤ) : ℤ) : ZMod m))
    (E : ZMod q₀ → Finset (ZMod q₀)) (hE : ∀ r, (E r).card ≤ g₀)
    (D : Finset ℕ) (I : Finset ℤ) (W : ℕ → ℤ → ℂ) :
    let a : ZMod q₀ := ((lam / (w₂ : ℤ) : ℤ) : ZMod q₀)
    let b : ZMod q₀ := ((lamTilde / (w₂ : ℤ) : ℤ) : ZMod q₀)
    let c : ZMod q₀ := ((s * (k / (w₂ : ℤ)) : ℤ) : ZMod q₀)
    let F : ZMod q₀ → ZMod q₀ → ZMod q₀ := fun r n => a⁻¹ * (b * n + c * r)
    let C : ℕ → ℤ → ℂ := fun d n => if (n : ZMod q₀) ∈ E (d : ZMod q₀) then 1 else 0
    let ntOf : ℕ → ℤ → ℤ := fun d n => (lamTilde * n + s * k * (d : ℤ)) / lam
    let V : Finset (ℕ × ℤ) := (D ×ˢ I).filter fun p =>
      Int.gcd (p.1 : ℤ) ((m : ℤ) * lam * lamTilde) = 1 ∧
        lam ∣ lamTilde * p.2 + s * k * (p.1 : ℤ)
    let R : Finset (ZMod q₀ × ZMod q₀) := Finset.univ.filter fun r =>
      IsUnit r.1 ∧ r.2 ∈ E r.1 ∧ F r.1 r.2 ∈ E r.1
    let fiber : ZMod q₀ × ZMod q₀ → ℂ := fun r =>
      ∑ p ∈ V.filter (fun p : ℕ × ℤ =>
        (p.1 : ZMod q₀) = r.1 ∧ (p.2 : ZMod q₀) = r.2), W p.1 p.2
    let maxFiber : ℝ≥0 := (Finset.univ : Finset (ZMod q₀ × ZMod q₀)).sup
      fun r => ‖fiber r‖₊
    R.card ≤ q₀ * g₀ ∧
      (∀ p ∈ V, C p.1 p.2 * C p.1 (ntOf p.1 p.2) =
        if ((p.1 : ZMod q₀), (p.2 : ZMod q₀)) ∈ R then 1 else 0) ∧
      (∑ p ∈ V, C p.1 p.2 * C p.1 (ntOf p.1 p.2) * W p.1 p.2) =
        (∑ r ∈ R, fiber r) ∧
      (∀ r : ZMod q₀ × ZMod q₀, ‖fiber r‖ ≤ (maxFiber : ℝ)) ∧
      (∃ r : ZMod q₀ × ZMod q₀, maxFiber = ‖fiber r‖₊) ∧
      ‖∑ p ∈ V, C p.1 p.2 * C p.1 (ntOf p.1 p.2) * W p.1 p.2‖ ≤
        ((q₀ * g₀ : ℕ) : ℝ) * (maxFiber : ℝ) := by
  intro a b c F C ntOf V R fiber maxFiber
  have hRcard : R.card ≤ q₀ * g₀ := by
    have hbound : R.card ≤ g₀ * (Finset.univ : Finset (ZMod q₀)).card := by
      apply Finset.card_le_mul_card_image_of_maps_to
        (f := Prod.fst) (s := R) (t := Finset.univ)
        (fun _ _ => Finset.mem_univ _) g₀
      intro r _
      refine le_trans ?_ (hE r)
      apply Finset.card_le_card_of_injOn (f := Prod.snd)
      · intro p hp
        rcases Finset.mem_filter.mp hp with ⟨hpR, hpr⟩
        have hpE := (Finset.mem_filter.mp hpR).2.2.1
        simpa only [Finset.mem_coe, hpr] using hpE
      · intro p hp q hq hpq
        exact Prod.ext
          ((Finset.mem_filter.mp hp).2.trans (Finset.mem_filter.mp hq).2.symm) hpq
    simpa only [Finset.card_univ, ZMod.card, Nat.mul_comm] using hbound
  have htransport :=
    sourceTerminalLinearization_residue_transport q₀ m w₂ lam lamTilde s k hqm hw₂
      hlam hlamTilde hk hu hv
  have hclass : ∀ p ∈ V, C p.1 p.2 * C p.1 (ntOf p.1 p.2) =
      if ((p.1 : ZMod q₀), (p.2 : ZMod q₀)) ∈ R then 1 else 0 := by
    intro p hp
    have hconditions := (Finset.mem_filter.mp hp).2
    have hdm : IsCoprime (p.1 : ℤ) (m : ℤ) :=
      (Int.isCoprime_iff_gcd_eq_one.mpr hconditions.1).of_mul_right_left.of_mul_right_left
    have hdunit : IsUnit (p.1 : ZMod q₀) := by
      simpa only [Int.cast_natCast] using
        (ZMod.coe_int_isUnit_iff_isCoprime (p.1 : ℤ) q₀).mpr
          (hdm.of_isCoprime_of_dvd_right (by exact_mod_cast hqm)).symm
    have hnt : (ntOf p.1 p.2 : ZMod q₀) =
        F (p.1 : ZMod q₀) (p.2 : ZMod q₀) := by
      simpa only [ntOf, F, a, b, c, Int.cast_natCast] using
        (htransport.2.2 p.2 (p.1 : ℤ) hconditions.2).2
    simp only [C, hnt, R, Finset.mem_filter, Finset.mem_univ, true_and,
      hdunit, ite_zero_mul_ite_zero, one_mul]
  have hpartition :
      (∑ p ∈ V, C p.1 p.2 * C p.1 (ntOf p.1 p.2) * W p.1 p.2) =
        ∑ r ∈ R, fiber r := by
    calc
      _ = ∑ p ∈ V,
          if ((p.1 : ZMod q₀), (p.2 : ZMod q₀)) ∈ R then W p.1 p.2 else 0 := by
        apply Finset.sum_congr rfl
        intro p hp
        rw [hclass p hp, boole_mul]
      _ = ∑ r ∈ R, fiber r := by
        simpa only [fiber, Finset.sum_filter, Prod.ext_iff] using
          (Finset.sum_fiberwise_eq_sum_filter V R
            (fun p : ℕ × ℤ => ((p.1 : ZMod q₀), (p.2 : ZMod q₀)))
            (fun p : ℕ × ℤ => W p.1 p.2)).symm
  have hmax (r : ZMod q₀ × ZMod q₀) : ‖fiber r‖ ≤ (maxFiber : ℝ) :=
    NNReal.coe_le_coe.mpr
      (Finset.le_sup (f := fun r => ‖fiber r‖₊) (Finset.mem_univ r))
  refine ⟨hRcard, hclass, hpartition, hmax, ?_, ?_⟩
  · obtain ⟨r, _, hr⟩ := Finset.exists_mem_eq_sup
      (Finset.univ : Finset (ZMod q₀ × ZMod q₀))
      ⟨(0, 0), Finset.mem_univ _⟩ (fun r => ‖fiber r‖₊)
    exact ⟨r, hr⟩
  · calc
      ‖∑ p ∈ V, C p.1 p.2 * C p.1 (ntOf p.1 p.2) * W p.1 p.2‖ =
          ‖∑ r ∈ R, fiber r‖ := congrArg norm hpartition
      _ ≤ ∑ _r ∈ R, (maxFiber : ℝ) :=
        norm_sum_le_of_le R fun r _ => hmax r
      _ = (R.card : ℝ) * (maxFiber : ℝ) := by simp
      _ ≤ ((q₀ * g₀ : ℕ) : ℝ) * (maxFiber : ℝ) :=
        mul_le_mul_of_nonneg_right (by exact_mod_cast hRcard) maxFiber.2

open Classical in
theorem sourceTerminalSigma5_uniform_reduction
    (ε Berr cD CD cN CN c₀ AD AN κD κN : ℝ)
    (hε : 0 < ε) (hBerr : 0 < Berr)
    (hcD : 0 < cD) (hcN : 0 < cN) (hCN : 0 < CN) (hc₀ : 0 < c₀)
    (hAD : 0 ≤ AD) (hAN : 0 ≤ AN) (hκD : 0 ≤ κD) (hκN : 0 ≤ κN)
    (Cφ Eφ Cψ Eψ : ℕ → ℝ)
    (hCφ : ∀ r, 0 ≤ Cφ r) (hCψ : ∀ r, 0 ≤ Cψ r) :
    let P : ℝ := 2 * κD + 3 * κN
    let CM : ℝ := (1 + max 0 (CD - cD) * AD) ^ 2 *
      (1 + max 0 (CN - cN) * AN) ^ 3
    let J : ℕ := ⌈(Berr + P + 2) / (5 * ε)⌉₊
    let CK : ℝ := 2 * CN / c₀
    ∃ Cstar Estar : ℕ → ℝ,
      (∀ r, 0 < Cstar r ∧ 0 ≤ Estar r) ∧
      ∃ X₀ : ℝ, Real.exp 1 ≤ X₀ ∧
        ∀ (x : ℝ), X₀ ≤ x →
        ∀ (φ ψ : ℝ → ℂ), ContDiff ℝ ∞ φ → ContDiff ℝ ∞ ψ →
        Function.support φ ⊆ Set.Icc cD CD →
        Function.support ψ ⊆ Set.Icc cN CN →
        (∀ (r : ℕ) (u : ℝ), ‖iteratedDeriv r φ u‖ ≤ Cφ r * (Real.log x) ^ Eφ r) →
        (∀ (r : ℕ) (u : ℝ), ‖iteratedDeriv r ψ u‖ ≤ Cψ r * (Real.log x) ^ Eψ r) →
        ∀ (Δ₁ N Λ : ℝ), 0 < Δ₁ → 0 < N → Λ ≠ 0 →
        Δ₁ ≤ AD * x ^ κD → N ≤ AN * x ^ κN →
        ∀ (m q₀ w₁ z₁ w₂ c₁ c₂ : ℕ) [NeZero m] [NeZero q₀],
        q₀ ∣ m → 0 < w₁ → 0 < z₁ → w₁ ∣ z₁ →
        ∀ (lam lamTilde d₀ l ℓ aPhase Bshift : ℤ) (Tcut : ℝ),
        (1 ≤ (lam : ℝ) / Λ ∧ (lam : ℝ) / Λ < 2) →
        (1 ≤ (lamTilde : ℝ) / Λ ∧ (lamTilde : ℝ) / Λ < 2) →
        c₀ * x ^ (5 * ε) * Δ₁ ≤ (d₀ : ℝ) →
        Int.gcd ((z₁ / w₁ : ℕ) : ℤ) ((m : ℤ) * lam * lamTilde) = 1 →
        w₂ = (∏ p ∈ m.primeFactors, p ^ (lam.natAbs.factorization p)) →
        w₂ = (∏ p ∈ m.primeFactors, p ^ (lamTilde.natAbs.factorization p)) →
        ∀ (E : ZMod q₀ → Finset (ZMod q₀)),
        (∀ r, (E r).card ≤ Int.gcd (q₀ : ℤ) ℓ) →
        let s : ℕ := z₁ / w₁
        let g₀ : ℕ := Int.gcd (q₀ : ℤ) ℓ
        let τ : ℕ → ℝ := fun d => ((z₁ : ℝ) * (d : ℝ) - (d₀ : ℝ)) / Δ₁
        let D : Finset ℕ :=
          (Finset.Icc 1 ⌊((d₀ : ℝ) + CD * Δ₁) / (z₁ : ℝ)⌋₊).filter
            fun d : ℕ => φ (τ d) ≠ 0
        let I : Finset ℤ := (Finset.Icc ⌈cN * N⌉ ⌊CN * N⌋).filter
          fun n : ℤ => ψ ((n : ℝ) / N) ≠ 0
        let C : ℕ → ℤ → ℂ := fun d n =>
          if (n : ZMod q₀) ∈ E (d : ZMod q₀) then 1 else 0
        let Jn : ℕ → ℤ → ℤ → ℤ := fun d n nt =>
          (lam * (nt + Bshift * (d : ℤ)) -
            lamTilde * (n + Bshift * (d : ℤ))) / (d : ℤ)
        let U₅ : ℕ → ℤ → ℤ → ℂ := fun d n nt =>
          if Int.gcd (d : ℤ) ((m : ℤ) * lam * lamTilde) = 1 ∧
              Int.gcd (n * nt) ((w₁ * c₁ : ℕ) : ℤ) = 1 ∧
              Int.gcd ((n + l * (d : ℤ)) * (nt + l * (d : ℤ))) (c₂ : ℤ) = 1 ∧
              (Int.gcd (Jn d n nt) (m : ℤ) : ℝ) ≤ Tcut then
            C d n * C d nt *
              reciprocalUnitPhase m ((aPhase : ZMod m) * (Jn d n nt : ZMod m))
                (((n + Bshift * (d : ℤ) : ℤ) : ZMod m) *
                  ((nt + Bshift * (d : ℤ) : ℤ) : ZMod m))
          else 0
        let term₅ : ℕ → ℤ → ℤ → ℂ := fun d n nt =>
          if Int.ModEq ((s * d : ℕ) : ℤ) (lam * nt) (lamTilde * n) then
            U₅ d n nt * φ (τ d) * ψ ((n : ℝ) / N) * ψ ((nt : ℝ) / N)
          else 0
        let S₅ : ℂ := ∑ d ∈ D, ∑ n ∈ I, ∑ nt ∈ I, term₅ d n nt
        let kOf : ℕ × (ℤ × ℤ) → ℤ := fun p =>
          (lam * p.2.2 - lamTilde * p.2.1) / ((s : ℤ) * (p.1 : ℤ))
        let originalSupport : Finset (ℕ × (ℤ × ℤ)) :=
          (D ×ˢ (I ×ˢ I)).filter fun p =>
            Int.ModEq ((s * p.1 : ℕ) : ℤ) (lam * p.2.2) (lamTilde * p.2.1) ∧
              U₅ p.1 p.2.1 p.2.2 * φ (τ p.1) *
                ψ ((p.2.1 : ℝ) / N) * ψ ((p.2.2 : ℝ) / N) ≠ 0
        let K : Finset ℤ := originalSupport.image kOf
        let Jk : ℤ → ℤ := fun k => (s : ℤ) * k + (lam - lamTilde) * Bshift
        let nk : ℤ → ℕ → ℤ → ℤ := fun k d n =>
          (lamTilde * n + (s : ℤ) * k * (d : ℤ)) / lam
        let Klam : ℝ := (w₁ : ℝ) * |Λ| * N / (x ^ (5 * ε) * Δ₁)
        let Kadm : Finset ℤ := (Finset.Icc (-⌊CK * Klam⌋) ⌊CK * Klam⌋).filter
          fun k : ℤ => (w₂ : ℤ) ∣ k ∧ (Int.gcd (Jk k) (m : ℤ) : ℝ) ≤ Tcut
        let Acoef : ℤ → ℕ → ℤ → ℂ := fun k d n =>
          if lam ∣ lamTilde * n + (s : ℤ) * k * (d : ℤ) ∧
              Int.gcd (d : ℤ) ((m : ℤ) * lam * lamTilde) = 1 ∧
              Int.gcd (n * nk k d n) ((w₁ * c₁ : ℕ) : ℤ) = 1 ∧
              Int.gcd ((n + l * (d : ℤ)) * (nk k d n + l * (d : ℤ))) (c₂ : ℤ) = 1 ∧
              (Int.gcd (Jk k) (m : ℤ) : ℝ) ≤ Tcut then
            C d n * C d (nk k d n) *
              reciprocalUnitPhase m ((aPhase : ZMod m) * (Jk k : ZMod m))
                (((n + Bshift * (d : ℤ) : ℤ) : ZMod m) *
                  ((nk k d n + Bshift * (d : ℤ) : ℤ) : ZMod m))
          else 0
        let ρ : ℝ := (lamTilde : ℝ) / (lam : ℝ)
        let σ : ℤ → ℝ := fun k => (k : ℝ) * (d₀ : ℝ) / ((w₁ : ℝ) * (lam : ℝ) * N)
        let η : ℤ → ℝ := fun k => (k : ℝ) * Δ₁ / ((w₁ : ℝ) * (lam : ℝ) * N)
        let nStar : ℕ → ℤ → ℝ → ℂ := fun j k u =>
          ψ u * iteratedDeriv j ψ (ρ * u + σ k)
        let dRaw : ℕ → ℤ → ℝ → ℂ := fun j k u =>
          ((η k * u) ^ j / (Nat.factorial j : ℝ)) • φ u
        let dStar : ℕ → ℤ → ℝ → ℂ := fun j k u =>
          ((J + 1 : ℕ) : ℝ) • dRaw j k u
        let term₆ : ℤ → (ℝ → ℂ) → (ℝ → ℂ) → ZMod q₀ → ZMod q₀ → ℕ → ℤ → ℂ :=
          fun k φstar ψstar dstar nstar d n =>
            if (d : ZMod q₀) = dstar ∧ (n : ZMod q₀) = nstar ∧
                Int.gcd (d : ℤ) ((m : ℤ) * lam * lamTilde) = 1 ∧
                lam ∣ lamTilde * n + (s : ℤ) * k * (d : ℤ) ∧
                Int.gcd (n * nk k d n) ((w₁ * c₁ : ℕ) : ℤ) = 1 ∧
                Int.gcd ((n + l * (d : ℤ)) * (nk k d n + l * (d : ℤ))) (c₂ : ℤ) = 1 then
              φstar (τ d) * ψstar ((n : ℝ) / N) *
                reciprocalUnitPhase m ((aPhase : ZMod m) * (Jk k : ZMod m))
                  (((n + Bshift * (d : ℤ) : ℤ) : ZMod m) *
                    ((nk k d n + Bshift * (d : ℤ) : ℤ) : ZMod m))
            else 0
        let S₆ : ℤ → (ℝ → ℂ) → (ℝ → ℂ) → ZMod q₀ → ZMod q₀ → ℂ :=
          fun k φstar ψstar dstar nstar =>
            ∑ d ∈ D, ∑ n ∈ I, term₆ k φstar ψstar dstar nstar d n
        let maxS₆ : ℤ → ℝ≥0 := fun k =>
          (Finset.univ : Finset (Fin (J + 1) × (ZMod q₀ × ZMod q₀))).sup fun r =>
            ‖S₆ k (dStar r.1.val k) (nStar r.1.val k) r.2.1 r.2.2‖₊
        (∀ d : ℕ, d ∈ D ↔ φ (τ d) ≠ 0) ∧
          (∀ d : ℤ,
            φ (((z₁ : ℝ) * (d : ℝ) - (d₀ : ℝ)) / Δ₁) ≠ 0 → 0 < d) ∧
          (∀ d ∈ D, 0 < d) ∧
          (∀ n : ℤ, n ∈ I ↔ ψ ((n : ℝ) / N) ≠ 0) ∧
          S₅ = (∑' d : ℕ, ∑' n : ℤ, ∑' nt : ℤ, term₅ d n nt) ∧
          (D.card : ℝ) ≤ 1 + max 0 (CD - cD) * Δ₁ / (z₁ : ℝ) ∧
          (I.card : ℝ) ≤ 1 + max 0 (CN - cN) * N ∧
          K.card ≤ D.card * I.card ^ 2 ∧ K ⊆ Kadm ∧
          (∀ k : ℤ, k ∈ Kadm ↔ |(k : ℝ)| ≤ CK * Klam ∧
            (w₂ : ℤ) ∣ k ∧ (Int.gcd (Jk k) (m : ℤ) : ℝ) ≤ Tcut) ∧
          (∀ (k : ℤ) (d : ℕ) (n : ℤ), ‖Acoef k d n‖ ≤ 1) ∧
          (∑ k ∈ K, ∑ d ∈ D, ∑ n ∈ I, ‖Acoef k d n‖) ≤
            (D.card : ℝ) ^ 2 * (I.card : ℝ) ^ 3 ∧
          (∑ k ∈ K, ∑ d ∈ D, ∑ n ∈ I, ‖Acoef k d n‖) ≤ CM * x ^ P ∧
          S₅ = (∑ k ∈ K, ∑ d ∈ D, ∑ n ∈ I,
            Acoef k d n * φ (τ d) * ψ ((n : ℝ) / N) *
              ψ (((lamTilde * n + (s : ℤ) * k * (d : ℤ) : ℤ) : ℝ) /
                ((lam : ℝ) * N))) ∧
          ‖S₅ - (∑ j ∈ Finset.range (J + 1), ∑ k ∈ K, ∑ d ∈ D, ∑ n ∈ I,
            Acoef k d n * dRaw j k (τ d) * nStar j k ((n : ℝ) / N))‖ ≤ x ^ (-Berr) ∧
          (∀ k ∈ Kadm, ∀ j : ℕ, j ≤ J →
            ContDiff ℝ ∞ (nStar j k) ∧ ContDiff ℝ ∞ (dStar j k) ∧
            Function.support (nStar j k) ⊆ Set.Icc cN CN ∧
            Function.support (dStar j k) ⊆ Set.Icc cD CD ∧
            (∀ (r : ℕ) (u : ℝ),
              ‖iteratedDeriv r (nStar j k) u‖ ≤ Cstar r * (Real.log x) ^ Estar r ∧
              ‖iteratedDeriv r (dStar j k) u‖ ≤ Cstar r * (Real.log x) ^ Estar r)) ∧
          (∀ (k : ℤ) (j : ℕ) (dstar nstar : ZMod q₀),
            S₆ k (dStar j k) (nStar j k) dstar nstar =
              ∑' d : ℕ, ∑' n : ℤ,
                term₆ k (dStar j k) (nStar j k) dstar nstar d n) ∧
          (∀ k : ℤ, ∃ r : Fin (J + 1) × (ZMod q₀ × ZMod q₀),
            maxS₆ k = ‖S₆ k (dStar r.1.val k) (nStar r.1.val k) r.2.1 r.2.2‖₊) ∧
          ‖S₅‖ ≤ ((q₀ * g₀ : ℕ) : ℝ) * (∑ k ∈ Kadm, (maxS₆ k : ℝ)) + x ^ (-Berr) := by
  intro P CM J CK
  have hP : 0 ≤ P := by dsimp [P]; positivity
  have hCM : 0 ≤ CM := by dsimp [CM]; positivity
  have hCK : 0 < CK := by dsimp [CK]; positivity
  obtain ⟨Cs, Es, hCs, hprofiles⟩ :=
    sourceTerminalTaylor_uniform_star_profiles J cD CD cN CN Cφ Eφ Cψ Eψ hCφ hCψ
  let L : ℝ := ((J + 1 : ℕ) : ℝ)
  have hL : 0 < L := by dsimp [L]; positivity
  have hLone : 1 ≤ L := by dsimp [L]; exact_mod_cast Nat.succ_le_succ (Nat.zero_le J)
  refine ⟨fun r => L * Cs r, Es, ?_, ?_⟩
  · intro r
    exact ⟨mul_pos hL (hCs r).1, (hCs r).2⟩
  let B' : ℝ := Berr + P + 1
  have hB' : 0 < B' := by dsimp [B']; positivity
  have hdegree : ⌈(B' + 1) / (5 * ε)⌉₊ = J := by
    simp [B', J, add_assoc, one_add_one_eq_two]
  obtain ⟨X, hX, htail⟩ :=
    sourceTerminalTaylor_uniform_finite_remainder ε B' CK cD CD cN CN
      hε hB' hCK.le Cφ Eφ Cψ Eψ hCφ hCψ
  simp only [hdegree] at htail
  have hXnonneg : 0 ≤ X := (Real.exp_pos 1).le.trans hX
  refine ⟨X + CM, hX.trans (le_add_of_nonneg_right hCM), ?_⟩
  intro x hx φ ψ hφsmooth hψsmooth hφsupport hψsupport hφbound hψbound
    Δ₁ N Λ hΔ₁ hN hΛ hΔbound hNbound m q₀ w₁ z₁ w₂ c₁ c₂
    instM instQ hqm hw₁ hz₁ hwz lam lamTilde d₀ l ℓ aPhase Bshift Tcut
    hlam hlamTilde hd₀ hfixed hw₂ hw₂Tilde E hE
    s g₀ τ D I C Jn U₅ term₅ S₅ kOf originalSupport K Jk nk Klam Kadm Acoef
    ρ σ η nStar dRaw dStar term₆ S₆ maxS₆
  have hXx : X ≤ x := (le_add_of_nonneg_right hCM).trans hx
  have hCMx : CM ≤ x := (le_add_of_nonneg_left hXnonneg).trans hx
  have hxexp : Real.exp 1 ≤ x := hX.trans hXx
  have hx1 : 1 < x := (Real.one_lt_exp_iff.mpr zero_lt_one).trans_le hxexp
  have hx0 : 0 < x := zero_lt_one.trans hx1
  have hlog : 0 ≤ Real.log x := Real.log_nonneg hx1.le
  have hzReal : 0 < (z₁ : ℝ) := by exact_mod_cast hz₁
  have hzOne : 1 ≤ (z₁ : ℝ) := by exact_mod_cast hz₁
  have hs : 0 < s := Nat.div_pos (Nat.le_of_dvd hz₁ hwz) hw₁
  let : NeZero s := ⟨Nat.ne_of_gt hs⟩
  have hlam0 : lam ≠ 0 := by
    intro hzero
    norm_num [hzero] at hlam
  have hlamTilde0 : lamTilde ≠ 0 := by
    intro hzero
    norm_num [hzero] at hlamTilde
  have hlamReal : (lam : ℝ) ≠ 0 := by exact_mod_cast hlam0
  have hd₀pos : 0 < (d₀ : ℝ) :=
    (mul_pos (mul_pos hc₀ (Real.rpow_pos_of_pos hx0 _)) hΔ₁).trans_le hd₀
  have hDint (d : ℤ)
      (hd : φ (((z₁ : ℝ) * (d : ℝ) - (d₀ : ℝ)) / Δ₁) ≠ 0) : 0 < d := by
    have hlow := (le_div_iff₀ hΔ₁).mp (hφsupport hd).1
    have hprod : 0 < (z₁ : ℝ) * (d : ℝ) :=
      (add_pos (mul_pos hcD hΔ₁) hd₀pos).trans_le (le_sub_iff_add_le.mp hlow)
    exact_mod_cast (mul_pos_iff_of_pos_left hzReal).mp hprod
  have hDmem (d : ℕ) : d ∈ D ↔ φ (τ d) ≠ 0 := by
    constructor
    · exact fun hd => (Finset.mem_filter.mp hd).2
    · intro hd
      have hdpos : 0 < d := by
        exact_mod_cast hDint (d : ℤ) (by simpa only [Int.cast_natCast] using hd)
      have hup : (d : ℝ) ≤ ((d₀ : ℝ) + CD * Δ₁) / (z₁ : ℝ) := by
        apply (le_div_iff₀ hzReal).mpr
        simpa only [mul_comm] using
          sub_le_iff_le_add'.mp ((div_le_iff₀ hΔ₁).mp (hφsupport hd).2)
      exact Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr
        ⟨hdpos, (Nat.le_floor_iff' (Nat.ne_of_gt hdpos)).mpr hup⟩, hd⟩
  have hDpos (d : ℕ) (hd : d ∈ D) : 0 < d :=
    (Finset.mem_Icc.mp (Finset.mem_filter.mp hd).1).1
  have hImem (n : ℤ) : n ∈ I ↔ ψ ((n : ℝ) / N) ≠ 0 := by
    constructor
    · exact fun hn => (Finset.mem_filter.mp hn).2
    · intro hn
      have hsupport := hψsupport hn
      exact Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr
        ⟨Int.ceil_le.mpr ((le_div_iff₀ hN).mp hsupport.1),
          Int.le_floor.mpr ((div_le_iff₀ hN).mp hsupport.2)⟩, hn⟩
  have hDzero (d : ℕ) (hd : d ∉ D) : φ (τ d) = 0 :=
    (hDmem d).not_left.mp hd
  have hIzero (n : ℤ) (hn : n ∉ I) : ψ ((n : ℝ) / N) = 0 :=
    (hImem n).not_left.mp hn
  have hS₅tsum : S₅ = ∑' d : ℕ, ∑' n : ℤ, ∑' nt : ℤ, term₅ d n nt := by
    symm
    rw [tsum_eq_sum (s := D) (fun d hd => by simp [term₅, hDzero d hd])]
    apply Finset.sum_congr rfl
    intro d _
    rw [tsum_eq_sum (s := I) (fun n hn => by simp [term₅, hIzero n hn])]
    apply Finset.sum_congr rfl
    intro n _
    exact tsum_eq_sum (s := I) (fun nt hnt => by simp [term₅, hIzero nt hnt])
  have hgrid (T : Finset ℤ) (a b : ℝ)
      (hT : ∀ n ∈ T, a ≤ (n : ℝ) ∧ (n : ℝ) ≤ b) :
      (T.card : ℝ) ≤ 1 + max 0 (b - a) := by
    by_cases hne : T.Nonempty
    · have hsub : T ⊆ Finset.Icc ⌈a⌉ ⌊b⌋ := by
        intro n hn
        exact Finset.mem_Icc.mpr
          ⟨Int.ceil_le.mpr (hT n hn).1, Int.le_floor.mpr (hT n hn).2⟩
      obtain ⟨n, hn⟩ := hne
      have hends : ⌈a⌉ ≤ ⌊b⌋ :=
        (Finset.mem_Icc.mp (hsub hn)).1.trans (Finset.mem_Icc.mp (hsub hn)).2
      have hcard : ((Finset.Icc ⌈a⌉ ⌊b⌋).card : ℝ) =
          (⌊b⌋ : ℝ) + 1 - (⌈a⌉ : ℝ) := by
        exact_mod_cast Int.card_Icc_of_le ⌈a⌉ ⌊b⌋ (Int.le_add_one hends)
      calc
        (T.card : ℝ) ≤ ((Finset.Icc ⌈a⌉ ⌊b⌋).card : ℝ) :=
          Nat.cast_le.mpr (Finset.card_le_card hsub)
        _ = (⌊b⌋ : ℝ) + 1 - (⌈a⌉ : ℝ) := hcard
        _ ≤ 1 + max 0 (b - a) := by
          have h := (sub_le_sub (Int.floor_le b) (Int.le_ceil a)).trans
            (le_max_right 0 (b - a))
          simpa only [← add_sub_assoc, add_comm (1 : ℝ) (⌊b⌋ : ℝ)] using
            add_le_add_right h (1 : ℝ)
    · rw [Finset.not_nonempty_iff_eq_empty.mp hne, Finset.card_empty, Nat.cast_zero]
      positivity
  have hDcard : (D.card : ℝ) ≤
      1 + max 0 (CD - cD) * Δ₁ / (z₁ : ℝ) := by
    have h := hgrid (D.image fun d : ℕ => (d : ℤ))
      (((d₀ : ℝ) + cD * Δ₁) / (z₁ : ℝ))
      (((d₀ : ℝ) + CD * Δ₁) / (z₁ : ℝ)) (by
        intro n hn
        obtain ⟨d, hd, rfl⟩ := Finset.mem_image.mp hn
        have hp := hφsupport ((hDmem d).mp hd)
        constructor
        · apply (div_le_iff₀ hzReal).mpr
          simpa only [Int.cast_natCast, mul_comm] using
            le_sub_iff_add_le'.mp ((le_div_iff₀ hΔ₁).mp hp.1)
        · apply (le_div_iff₀ hzReal).mpr
          simpa only [Int.cast_natCast, mul_comm] using
            sub_le_iff_le_add'.mp ((div_le_iff₀ hΔ₁).mp hp.2))
    simpa only [Finset.card_image_of_injective D
      (Nat.cast_injective : Function.Injective (fun d : ℕ => (d : ℤ))),
      ← sub_div, add_sub_add_left_eq_sub, ← sub_mul,
      max_mul_of_nonneg 0 (CD - cD) hΔ₁.le, ← max_div_div_right hzReal.le,
      zero_mul, zero_div] using h
  have hIcard : (I.card : ℝ) ≤ 1 + max 0 (CN - cN) * N := by
    have h := hgrid I (cN * N) (CN * N) (fun n hn => by
      have hp := hψsupport ((hImem n).mp hn)
      exact ⟨(le_div_iff₀ hN).mp hp.1, (div_le_iff₀ hN).mp hp.2⟩)
    simpa only [← sub_mul, max_mul_of_nonneg 0 (CN - cN) hN.le, zero_mul] using h
  have hlin := sourceTerminalSigma5_finite_linearization s hs lam lamTilde hlam0
    D hDpos I (fun d => φ (τ d)) (fun n => ψ ((n : ℝ) / N))
    (fun n hn => (hImem n).mpr hn) U₅
  rcases hlin with ⟨hKcard, hKwitness, _, hKreindex⟩
  have hsmWhole : Nat.Coprime s (m * lam.natAbs * lamTilde.natAbs) := by
    simpa only [Int.gcd_def, Int.natAbs_mul, Int.natAbs_natCast] using hfixed
  have hsm : Nat.Coprime s m :=
    hsmWhole.coprime_mul_right_right.coprime_mul_right_right
  have hpart := primeFactors_prod_pow_factorization_dvd_and_coprime_div m lam.natAbs
    (NeZero.ne m) (Int.natAbs_ne_zero.mpr hlam0)
  have hpartTilde := primeFactors_prod_pow_factorization_dvd_and_coprime_div m lamTilde.natAbs
    (NeZero.ne m) (Int.natAbs_ne_zero.mpr hlamTilde0)
  simp only [← hw₂] at hpart
  simp only [← hw₂Tilde] at hpartTilde
  have hwpos : 0 < w₂ := hpart.1
  have hwlam : (w₂ : ℤ) ∣ lam := Int.natCast_dvd.mpr hpart.2.1
  have hwlamTilde : (w₂ : ℤ) ∣ lamTilde := Int.natCast_dvd.mpr hpartTilde.2.1
  have hunit (u : ℤ) (hwu : (w₂ : ℤ) ∣ u)
      (hquot : Nat.Coprime (u.natAbs / w₂) m) :
      IsUnit (((u / (w₂ : ℤ)) : ℤ) : ZMod m) := by
    rw [ZMod.coe_int_isUnit_iff_isCoprime, Int.isCoprime_iff_gcd_eq_one,
      Int.gcd_def, Int.natAbs_natCast, Int.natAbs_ediv_of_dvd hwu, Int.natAbs_natCast]
    exact hquot.symm.gcd_eq_one
  have hu := hunit lam hwlam hpart.2.2.2.1
  have hv := hunit lamTilde hwlamTilde hpartTilde.2.2.2.1
  clear hpart hpartTilde hunit
  have hJn (k : ℤ) (d : ℕ) (hd : d ∈ D) (n : ℤ)
      (hdiv : lam ∣ lamTilde * n + (s : ℤ) * k * (d : ℤ)) :
      Jn d n (nk k d n) = Jk k := by
    let : NeZero d := ⟨Nat.ne_of_gt (hDpos d hd)⟩
    exact ((sourceTerminalLinearization_exact s d m lam lamTilde n (nk k d n)
      aPhase Bshift hlam0).2 k hdiv rfl).2.1
  have hKadm (k : ℤ) : k ∈ Kadm ↔ |(k : ℝ)| ≤ CK * Klam ∧
      (w₂ : ℤ) ∣ k ∧ (Int.gcd (Jk k) (m : ℤ) : ℝ) ≤ Tcut := by
    have hwindow : -⌊CK * Klam⌋ ≤ k ∧ k ≤ ⌊CK * Klam⌋ ↔
        |(k : ℝ)| ≤ CK * Klam := by
      rw [← Int.ceil_neg, Int.ceil_le, Int.le_floor, abs_le]
    simp only [Kadm, Finset.mem_filter, Finset.mem_Icc, hwindow]
  have hKsub : K ⊆ Kadm := by
    intro k hk
    obtain ⟨d, hd, n, _, nt, _, hlinear, hdiv, hquot, hnonzero⟩ := hKwitness k hk
    have hparts : U₅ d n nt ≠ 0 ∧ φ (τ d) ≠ 0 ∧
        ψ ((n : ℝ) / N) ≠ 0 ∧ ψ ((nt : ℝ) / N) ≠ 0 := by
      simpa only [mul_ne_zero_iff, and_assoc] using hnonzero
    have hguard : Int.gcd (d : ℤ) ((m : ℤ) * lam * lamTilde) = 1 ∧
        Int.gcd (n * nt) ((w₁ * c₁ : ℕ) : ℤ) = 1 ∧
        Int.gcd ((n + l * (d : ℤ)) * (nt + l * (d : ℤ))) (c₂ : ℤ) = 1 ∧
        (Int.gcd (Jn d n nt) (m : ℤ) : ℝ) ≤ Tcut :=
      (ite_ne_right_iff.mp hparts.1).1
    have hW : φ (τ d) * ψ ((n : ℝ) / N) * ψ ((nt : ℝ) / N) ≠ 0 :=
      mul_ne_zero (mul_ne_zero hparts.2.1 hparts.2.2.1) hparts.2.2.2
    have hbound :=
      (sourceTerminalLinearization_support_bound cD CD cN CN c₀ hcD hcN hCN hc₀
        x ε Δ₁ N Λ hx1 hΔ₁ hN hΛ w₁ z₁ d hw₁ hz₁ hwz
        d₀ lam lamTilde n nt k hd₀ hlam hlamTilde φ ψ hφsupport hψsupport hlinear).2.1 hW
    have hdivk := (sourceTerminalLinearization_supported_part_dvd s d m w₂
      lam lamTilde n nt k hlam0 hlamTilde0 hw₂ hw₂Tilde hsm hguard.1 hlinear).2.2.1
    have hJn' : Jn d n nt = Jk k := by
      rw [← hquot]
      exact hJn k d hd n hdiv
    exact (hKadm k).mpr ⟨hbound.2, hdivk, hJn' ▸ hguard.2.2.2⟩
  clear hKwitness
  have hCnorm (d : ℕ) (n : ℤ) : ‖C d n‖ ≤ 1 := by
    dsimp only [C]
    split_ifs <;> simp
  have hphase (a z : ZMod m) : ‖reciprocalUnitPhase m a z‖ ≤ 1 := by
    dsimp only [reciprocalUnitPhase]
    split_ifs <;> simp
  have hAnorm (k : ℤ) (d : ℕ) (n : ℤ) : ‖Acoef k d n‖ ≤ 1 := by
    dsimp only [Acoef]
    split_ifs
    · rw [norm_mul, norm_mul]
      exact (mul_le_of_le_one_left (norm_nonneg _)
        ((mul_le_of_le_one_left (norm_nonneg _) (hCnorm d n)).trans
          (hCnorm d (nk k d n)))).trans (hphase _ _)
    · simp
  have hmass : (∑ k ∈ K, ∑ d ∈ D, ∑ n ∈ I, ‖Acoef k d n‖) ≤
      (D.card : ℝ) ^ 2 * (I.card : ℝ) ^ 3 := by
    have hcardReal : (K.card : ℝ) ≤ (D.card : ℝ) * (I.card : ℝ) ^ 2 := by
      exact_mod_cast hKcard
    calc
      _ ≤ ∑ k ∈ K, ∑ d ∈ D, ∑ n ∈ I, (1 : ℝ) :=
        Finset.sum_le_sum fun k _ => Finset.sum_le_sum fun d _ =>
          Finset.sum_le_sum fun n _ => hAnorm k d n
      _ = (K.card : ℝ) * (D.card : ℝ) * (I.card : ℝ) := by
        simp [mul_assoc]
      _ ≤ ((D.card : ℝ) * (I.card : ℝ) ^ 2) * (D.card : ℝ) * (I.card : ℝ) :=
        mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_right hcardReal (Nat.cast_nonneg _)) (Nat.cast_nonneg _)
      _ = (D.card : ℝ) ^ 2 * (I.card : ℝ) ^ 3 := by ring
  have hDpoly : (D.card : ℝ) ≤ (1 + max 0 (CD - cD) * AD) * x ^ κD := by
    have hdiv : Δ₁ / (z₁ : ℝ) ≤ Δ₁ := div_le_self hΔ₁.le hzOne
    have hp := Real.one_le_rpow hx1.le hκD
    calc
      _ ≤ 1 + max 0 (CD - cD) * (Δ₁ / (z₁ : ℝ)) := by
        simpa only [mul_div_assoc] using hDcard
      _ ≤ 1 + max 0 (CD - cD) * (AD * x ^ κD) :=
        add_le_add_right
          (mul_le_mul_of_nonneg_left (hdiv.trans hΔbound) (le_max_left _ _)) 1
      _ ≤ (1 + max 0 (CD - cD) * AD) * x ^ κD := by
        simpa only [add_mul, one_mul, mul_assoc] using
          add_le_add_left hp (max 0 (CD - cD) * (AD * x ^ κD))
  have hIpoly : (I.card : ℝ) ≤ (1 + max 0 (CN - cN) * AN) * x ^ κN := by
    have hp := Real.one_le_rpow hx1.le hκN
    calc
      _ ≤ 1 + max 0 (CN - cN) * N := hIcard
      _ ≤ 1 + max 0 (CN - cN) * (AN * x ^ κN) :=
        add_le_add_right (mul_le_mul_of_nonneg_left hNbound (le_max_left _ _)) 1
      _ ≤ (1 + max 0 (CN - cN) * AN) * x ^ κN := by
        simpa only [add_mul, one_mul, mul_assoc] using
          add_le_add_left hp (max 0 (CN - cN) * (AN * x ^ κN))
  have hmassPoly : (∑ k ∈ K, ∑ d ∈ D, ∑ n ∈ I, ‖Acoef k d n‖) ≤ CM * x ^ P := by
    have hpow : (x ^ κD) ^ 2 * (x ^ κN) ^ 3 = x ^ P := by
      rw [← Real.rpow_mul_natCast hx0.le, ← Real.rpow_mul_natCast hx0.le,
        ← Real.rpow_add hx0]
      simp [P, mul_comm]
    calc
      _ ≤ (D.card : ℝ) ^ 2 * (I.card : ℝ) ^ 3 := hmass
      _ ≤ ((1 + max 0 (CD - cD) * AD) * x ^ κD) ^ 2 *
          ((1 + max 0 (CN - cN) * AN) * x ^ κN) ^ 3 :=
        mul_le_mul (pow_le_pow_left₀ (Nat.cast_nonneg _) hDpoly 2)
          (pow_le_pow_left₀ (Nat.cast_nonneg _) hIpoly 3)
          (pow_nonneg (Nat.cast_nonneg _) _) (by positivity)
      _ = CM * ((x ^ κD) ^ 2 * (x ^ κN) ^ 3) := by dsimp [CM]; ring
      _ = CM * x ^ P := by rw [hpow]
  have hcoef (k : ℤ) (d : ℕ) (hd : d ∈ D) (n : ℤ) :
      (if lam ∣ lamTilde * n + (s : ℤ) * k * (d : ℤ) then
        U₅ d n (nk k d n) else 0) = Acoef k d n := by
    by_cases hdiv : lam ∣ lamTilde * n + (s : ℤ) * k * (d : ℤ)
    · simp only [hdiv, ite_true, Acoef, true_and, U₅, hJn k d hd n hdiv]
    · simp only [hdiv, ite_false, Acoef, false_and]
  have hReindex : S₅ = ∑ k ∈ K, ∑ d ∈ D, ∑ n ∈ I,
      Acoef k d n * φ (τ d) * ψ ((n : ℝ) / N) *
        ψ (((lamTilde * n + (s : ℤ) * k * (d : ℤ) : ℤ) : ℝ) /
          ((lam : ℝ) * N)) := by
    calc
      S₅ = ∑ k ∈ K, ∑ d ∈ D, ∑ n ∈ I,
          if lam ∣ lamTilde * n + (s : ℤ) * k * (d : ℤ) then
            U₅ d n (nk k d n) * φ (τ d) * ψ ((n : ℝ) / N) *
              ψ ((nk k d n : ℝ) / N) else 0 := hKreindex
      _ = _ := by
        apply Finset.sum_congr rfl
        intro k _
        apply Finset.sum_congr rfl
        intro d hd
        apply Finset.sum_congr rfl
        intro n _
        by_cases hdiv : lam ∣ lamTilde * n + (s : ℤ) * k * (d : ℤ)
        · have huc : U₅ d n (nk k d n) = Acoef k d n := by
            simpa only [hdiv, ite_true] using hcoef k d hd n
          have harg : (nk k d n : ℝ) / N =
              (((lamTilde * n + (s : ℤ) * k * (d : ℤ) : ℤ) : ℝ) /
                ((lam : ℝ) * N)) := by
            change (((lamTilde * n + (s : ℤ) * k * (d : ℤ)) / lam : ℤ) : ℝ) / N = _
            rw [Int.cast_div hdiv hlamReal, div_div]
          simp only [hdiv, ite_true, huc, harg]
        · simp only [hdiv, ite_false, Acoef, false_and, zero_mul]
  clear hKreindex
  have hKcut : K.filter (fun k : ℤ => |(k : ℝ)| ≤
      CK * ((w₁ : ℝ) * |Λ| * N / (x ^ (5 * ε) * Δ₁))) = K :=
    Finset.filter_eq_self.mpr fun k hk => ((hKadm k).mp (hKsub hk)).1
  have hTK := htail x hXx φ ψ hφsmooth hψsmooth hφsupport hψsupport hφbound hψbound
    Δ₁ N Λ hΔ₁ hN hΛ w₁ z₁ hw₁ hz₁ hwz lam lamTilde d₀ hlam hlamTilde K D I Acoef
  have hTA := htail x hXx φ ψ hφsmooth hψsmooth hφsupport hψsupport hφbound hψbound
    Δ₁ N Λ hΔ₁ hN hΛ w₁ z₁ hw₁ hz₁ hwz lam lamTilde d₀ hlam hlamTilde
    Kadm (∅ : Finset ℕ) (∅ : Finset ℤ) (fun (_ : ℤ) (_ : ℕ) (_ : ℤ) => (0 : ℂ))
  have hrho : |ρ| ≤ 2 := hTK.1
  have heta (k : ℤ) (hk : k ∈ Kadm) : |η k| ≤ 1 :=
    (hTA.2.1 k (Finset.mem_filter.mpr ⟨hk, ((hKadm k).mp hk).1⟩)).1
  have herrorRaw :
      ‖S₅ - (∑ j ∈ Finset.range (J + 1), ∑ k ∈ K, ∑ d ∈ D, ∑ n ∈ I,
        Acoef k d n * dRaw j k (τ d) * nStar j k ((n : ℝ) / N))‖ ≤
        x ^ (-B') * ∑ k ∈ K, ∑ d ∈ D, ∑ n ∈ I, ‖Acoef k d n‖ := by
    rw [hReindex]
    simpa only [hKcut] using hTK.2.2
  clear hTK hTA htail
  have herror :
      ‖S₅ - (∑ j ∈ Finset.range (J + 1), ∑ k ∈ K, ∑ d ∈ D, ∑ n ∈ I,
        Acoef k d n * dRaw j k (τ d) * nStar j k ((n : ℝ) / N))‖ ≤ x ^ (-Berr) := by
    calc
      _ ≤ x ^ (-B') *
          (∑ k ∈ K, ∑ d ∈ D, ∑ n ∈ I, ‖Acoef k d n‖) := herrorRaw
      _ ≤ x ^ (-B') * (CM * x ^ P) :=
        mul_le_mul_of_nonneg_left hmassPoly (Real.rpow_nonneg hx0.le _)
      _ = CM * x ^ (-(Berr + 1)) := by
        have hexp : -B' + P = -(Berr + 1) := by dsimp only [B']; ring
        rw [mul_left_comm, ← Real.rpow_add hx0, hexp]
      _ ≤ x * x ^ (-(Berr + 1)) :=
        mul_le_mul_of_nonneg_right hCMx (Real.rpow_nonneg hx0.le _)
      _ = x ^ (-Berr) := by
        rw [mul_comm, ← Real.rpow_add_one hx0.ne', neg_add, neg_add_cancel_right]
  have hstar (k : ℤ) (hk : k ∈ Kadm) (j : ℕ) (hj : j ≤ J) :
      ContDiff ℝ ∞ (nStar j k) ∧ ContDiff ℝ ∞ (dStar j k) ∧
      Function.support (nStar j k) ⊆ Set.Icc cN CN ∧
      Function.support (dStar j k) ⊆ Set.Icc cD CD ∧
      ∀ (r : ℕ) (u : ℝ),
        ‖iteratedDeriv r (nStar j k) u‖ ≤ (L * Cs r) * (Real.log x) ^ Es r ∧
        ‖iteratedDeriv r (dStar j k) u‖ ≤ (L * Cs r) * (Real.log x) ^ Es r := by
    obtain ⟨hncont, hdcont, hnsupp, hdsupp, hb⟩ :=
      hprofiles x hxexp φ ψ hφsmooth hψsmooth hφsupport hψsupport hφbound hψbound
        ρ (σ k) (η k) hrho (heta k hk) j hj
    refine ⟨hncont, hdcont.const_smul L, hnsupp,
      (Function.support_smul_subset_right (fun _ : ℝ => L) (dRaw j k)).trans hdsupp, ?_⟩
    intro r u
    constructor
    · exact (hb r u).1.trans (by
        simpa only [mul_assoc] using le_mul_of_one_le_left
          (mul_nonneg (hCs r).1.le (Real.rpow_nonneg hlog (Es r))) hLone)
    · change ‖iteratedDeriv r (fun v => L • dRaw j k v) u‖ ≤
        (L * Cs r) * (Real.log x) ^ Es r
      rw [iteratedDeriv_fun_const_smul_field, norm_smul, Real.norm_eq_abs,
        abs_of_nonneg hL.le]
      simpa only [mul_assoc] using mul_le_mul_of_nonneg_left (hb r u).2 hL.le
  clear hprofiles
  have hS₆tsum (k : ℤ) (j : ℕ) (dstar nstar : ZMod q₀) :
      S₆ k (dStar j k) (nStar j k) dstar nstar =
        ∑' d : ℕ, ∑' n : ℤ, term₆ k (dStar j k) (nStar j k) dstar nstar d n := by
    symm
    rw [tsum_eq_sum (s := D) (fun d hd => by
      simp [term₆, dStar, dRaw, hDzero d hd])]
    apply Finset.sum_congr rfl
    intro d _
    exact tsum_eq_sum (s := I) (fun n hn => by
      simp [term₆, nStar, hIzero n hn])
  have hmaxAttain (k : ℤ) :
      ∃ r : Fin (J + 1) × (ZMod q₀ × ZMod q₀),
        maxS₆ k = ‖S₆ k (dStar r.1.val k) (nStar r.1.val k) r.2.1 r.2.2‖₊ := by
    obtain ⟨r, _, hr⟩ := Finset.exists_mem_eq_sup
      (Finset.univ : Finset (Fin (J + 1) × (ZMod q₀ × ZMod q₀)))
      ⟨(⟨0, Nat.succ_pos J⟩, (0, 0)), Finset.mem_univ _⟩
      (fun r => ‖S₆ k (dStar r.1.val k) (nStar r.1.val k) r.2.1 r.2.2‖₊)
    exact ⟨r, hr⟩
  have hclass (k : ℤ) (hk : k ∈ Kadm) (φstar ψstar : ℝ → ℂ) :
      ‖∑ d ∈ D, ∑ n ∈ I, Acoef k d n * φstar (τ d) * ψstar ((n : ℝ) / N)‖ ≤
        ((q₀ * g₀ : ℕ) : ℝ) *
          ((Finset.univ : Finset (ZMod q₀ × ZMod q₀)).sup
            (fun r => ‖S₆ k φstar ψstar r.1 r.2‖₊) : ℝ≥0) := by
    have hkdiv := ((hKadm k).mp hk).2.1
    have hkcut := ((hKadm k).mp hk).2.2
    let W : ℕ → ℤ → ℂ := fun d n =>
      if Int.gcd (n * nk k d n) ((w₁ * c₁ : ℕ) : ℤ) = 1 ∧
          Int.gcd ((n + l * (d : ℤ)) * (nk k d n + l * (d : ℤ))) (c₂ : ℤ) = 1 then
        φstar (τ d) * ψstar ((n : ℝ) / N) *
          reciprocalUnitPhase m ((aPhase : ZMod m) * (Jk k : ZMod m))
            (((n + Bshift * (d : ℤ) : ℤ) : ZMod m) *
              ((nk k d n + Bshift * (d : ℤ) : ℤ) : ZMod m))
      else 0
    let V : Finset (ℕ × ℤ) := (D ×ˢ I).filter fun p =>
      Int.gcd (p.1 : ℤ) ((m : ℤ) * lam * lamTilde) = 1 ∧
        lam ∣ lamTilde * p.2 + (s : ℤ) * k * (p.1 : ℤ)
    let fiber : ZMod q₀ × ZMod q₀ → ℂ := fun r =>
      ∑ p ∈ V.filter (fun p : ℕ × ℤ =>
        (p.1 : ZMod q₀) = r.1 ∧ (p.2 : ZMod q₀) = r.2), W p.1 p.2
    have hleft :
        (∑ p ∈ V, C p.1 p.2 * C p.1 (nk k p.1 p.2) * W p.1 p.2) =
          ∑ d ∈ D, ∑ n ∈ I, Acoef k d n * φstar (τ d) * ψstar ((n : ℝ) / N) := by
      simp only [V, Finset.sum_filter, Finset.sum_product]
      apply Finset.sum_congr rfl
      intro d _
      apply Finset.sum_congr rfl
      intro n _
      simp only [W, Acoef, mul_ite_zero, ite_zero_mul, ← ite_and]
      refine if_congr ?_ ?_ rfl
      · constructor
        · rintro ⟨⟨ho, hvd⟩, h₁, h₂⟩
          exact ⟨hvd, ho, h₁, h₂, hkcut⟩
        · rintro ⟨hvd, ho, h₁, h₂, _⟩
          exact ⟨⟨ho, hvd⟩, h₁, h₂⟩
      · have hmul (a b c d e : ℂ) : a * b * (c * d * e) = a * b * e * c * d := by
          rw [mul_comm (c * d) e, ← mul_assoc, ← mul_assoc]
        exact hmul _ _ _ _ _
    have hfiber (r : ZMod q₀ × ZMod q₀) : fiber r = S₆ k φstar ψstar r.1 r.2 := by
      simp only [fiber, V, Finset.sum_filter, Finset.sum_product, S₆]
      apply Finset.sum_congr rfl
      intro d _
      apply Finset.sum_congr rfl
      intro n _
      simp only [W, term₆, ← ite_and]
      refine if_congr ?_ rfl rfl
      constructor
      · rintro ⟨⟨ho, hvd⟩, ⟨hrd, hrn⟩, h₁, h₂⟩
        exact ⟨hrd, hrn, ho, hvd, h₁, h₂⟩
      · rintro ⟨hrd, hrn, ho, hvd, h₁, h₂⟩
        exact ⟨⟨ho, hvd⟩, ⟨hrd, hrn⟩, h₁, h₂⟩
    have hbound := (sourceTerminalSigma6_class_partition q₀ m w₂ g₀ lam lamTilde
      (s : ℤ) k hqm hwpos hwlam hwlamTilde hkdiv hu hv E hE D I W).2.2.2.2.2
    change ‖∑ p ∈ V, C p.1 p.2 * C p.1 (nk k p.1 p.2) * W p.1 p.2‖ ≤
      ((q₀ * g₀ : ℕ) : ℝ) *
        (((Finset.univ : Finset (ZMod q₀ × ZMod q₀)).sup fun r => ‖fiber r‖₊ : ℝ≥0) : ℝ)
      at hbound
    rw [hleft] at hbound
    simpa only [hfiber] using hbound
  have hscaled (j : ℕ) (k : ℤ) :
      (∑ d ∈ D, ∑ n ∈ I, Acoef k d n * dStar j k (τ d) * nStar j k ((n : ℝ) / N)) =
        L • (∑ d ∈ D, ∑ n ∈ I,
          Acoef k d n * dRaw j k (τ d) * nStar j k ((n : ℝ) / N)) := by
    simp only [dStar, L, Finset.smul_sum, mul_smul_comm, smul_mul_assoc]
  have hterm (j : ℕ) (hj : j ∈ Finset.range (J + 1)) (k : ℤ) (hk : k ∈ K) :
      L * ‖∑ d ∈ D, ∑ n ∈ I,
        Acoef k d n * dRaw j k (τ d) * nStar j k ((n : ℝ) / N)‖ ≤
        ((q₀ * g₀ : ℕ) : ℝ) * (maxS₆ k : ℝ) := by
    have hbound := hclass k (hKsub hk) (dStar j k) (nStar j k)
    have hmax :
        (Finset.univ : Finset (ZMod q₀ × ZMod q₀)).sup
          (fun r => ‖S₆ k (dStar j k) (nStar j k) r.1 r.2‖₊) ≤ maxS₆ k := by
      have hsup (i : Fin (J + 1)) (F : Fin (J + 1) × (ZMod q₀ × ZMod q₀) → ℝ≥0) :
          (Finset.univ : Finset (ZMod q₀ × ZMod q₀)).sup (fun r => F (i, r)) ≤
            (Finset.univ : Finset (Fin (J + 1) × (ZMod q₀ × ZMod q₀))).sup F :=
        Finset.sup_le fun r _ => Finset.le_sup (f := F) (Finset.mem_univ (i, r))
      exact hsup ⟨j, Finset.mem_range.mp hj⟩ (fun t =>
        ‖S₆ k (dStar t.1.val k) (nStar t.1.val k) t.2.1 t.2.2‖₊)
    rw [hscaled, norm_smul, Real.norm_eq_abs, abs_of_nonneg hL.le] at hbound
    exact hbound.trans (mul_le_mul_of_nonneg_left
      (NNReal.coe_le_coe.mpr hmax) (Nat.cast_nonneg _))
  have hsumj (k : ℤ) (hk : k ∈ K) :
      ‖∑ j ∈ Finset.range (J + 1), ∑ d ∈ D, ∑ n ∈ I,
        Acoef k d n * dRaw j k (τ d) * nStar j k ((n : ℝ) / N)‖ ≤
        ((q₀ * g₀ : ℕ) : ℝ) * (maxS₆ k : ℝ) := by
    calc
      _ ≤ ∑ _j ∈ Finset.range (J + 1),
          ((q₀ * g₀ : ℕ) : ℝ) * (maxS₆ k : ℝ) / L :=
        norm_sum_le_of_le _ fun j hj => (le_div_iff₀' hL).mpr (hterm j hj k hk)
      _ = ((q₀ * g₀ : ℕ) : ℝ) * (maxS₆ k : ℝ) := by
        simp only [Finset.sum_const, Finset.card_range, nsmul_eq_mul]
        exact mul_div_cancel₀ _ hL.ne'
  have hpoly :
      ‖∑ j ∈ Finset.range (J + 1), ∑ k ∈ K, ∑ d ∈ D, ∑ n ∈ I,
        Acoef k d n * dRaw j k (τ d) * nStar j k ((n : ℝ) / N)‖ ≤
        ((q₀ * g₀ : ℕ) : ℝ) * ∑ k ∈ Kadm, (maxS₆ k : ℝ) := by
    calc
      _ = ‖∑ k ∈ K, ∑ j ∈ Finset.range (J + 1), ∑ d ∈ D, ∑ n ∈ I,
          Acoef k d n * dRaw j k (τ d) * nStar j k ((n : ℝ) / N)‖ := by
        rw [Finset.sum_comm]
      _ ≤ ∑ k ∈ K, ((q₀ * g₀ : ℕ) : ℝ) * (maxS₆ k : ℝ) :=
        norm_sum_le_of_le _ fun k hk => hsumj k hk
      _ = ((q₀ * g₀ : ℕ) : ℝ) * ∑ k ∈ K, (maxS₆ k : ℝ) := by
        rw [Finset.mul_sum]
      _ ≤ ((q₀ * g₀ : ℕ) : ℝ) * ∑ k ∈ Kadm, (maxS₆ k : ℝ) :=
        mul_le_mul_of_nonneg_left
          (Finset.sum_le_sum_of_subset_of_nonneg hKsub fun k _ _ => NNReal.coe_nonneg _)
          (Nat.cast_nonneg _)
  refine ⟨hDmem, hDint, hDpos, hImem, hS₅tsum, hDcard, hIcard, hKcard, hKsub,
    hKadm, hAnorm, hmass, hmassPoly, hReindex, herror, hstar, hS₆tsum, hmaxAttain, ?_⟩
  exact (norm_le_norm_add_norm_sub' S₅
    (∑ j ∈ Finset.range (J + 1), ∑ k ∈ K, ∑ d ∈ D, ∑ n ∈ I,
      Acoef k d n * dRaw j k (τ d) * nStar j k ((n : ℝ) / N))).trans
    (add_le_add hpoly herror)

end

section
open Filter Asymptotics
open Classical in
theorem sourceTerminalInsideMobius_smooth_kl3_max_bound
    (m q₀ c₁ c₂ f w₃ : ℕ) [NeZero m] (hm : Squarefree m)
    (hq₀ : q₀ ∣ m) (hc₁ : c₁ ∣ m) (hc₂ : c₂ ∣ m)
    (u v F G h ell dstar nstar : ℤ)
    (hu : IsUnit (u : ZMod m)) (hv : IsUnit (v : ZMod m))
    (hw₃ : Nat.Coprime w₃ m) (A B L : ZMod m)
    (TD TN LD LN D N d₀ n₀ : ℝ)
    (hTD : 0 ≤ TD) (hTN : 0 ≤ TN) (hLD : 0 ≤ LD) (hLN : 0 ≤ LN)
    (hD : 0 < D) (hN : 0 < N)
    (ψD ψN : ℝ → ℂ) (hψD : ContDiff ℝ 1 ψD) (hψN : ContDiff ℝ 1 ψN)
    (hsupportD : Function.support ψD ⊆ Set.Icc (-TD) TD)
    (hsupportN : Function.support ψN ⊆ Set.Icc (-TN) TN)
    (hboundD : ∀ t : ℝ, ‖ψD t‖ ≤ LD ∧ ‖deriv ψD t‖ ≤ LD)
    (hboundN : ∀ t : ℝ, ‖ψN t‖ ≤ LN ∧ ‖deriv ψN t‖ ≤ LN) :
    let F₁ : ℤ → ℤ → ℤ := fun d n =>
      u * (w₃ : ℤ) * n + (u * h + F * (f : ℤ)) * d
    let F₂ : ℤ → ℤ → ℤ := fun d n =>
      v * (w₃ : ℤ) * n + (v * h + G * (f : ℤ)) * d
    let F₃ : ℤ → ℤ → ℤ := fun d n =>
      u * (w₃ : ℤ) * n + (u * h + (F + ell) * (f : ℤ)) * d
    let F₄ : ℤ → ℤ → ℤ := fun d n =>
      v * (w₃ : ℤ) * n + (v * h + (G + ell) * (f : ℤ)) * d
    let K : (p : m.primeFactors) → ℝ := fun p =>
      letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
      (Finset.univ : Finset (ZMod p.1)).sup' Finset.univ_nonempty
        (fun c => ‖normalizedKloosterman3 p.1 c‖)
    let BD : Finset ℤ := Finset.Icc ⌈d₀ - TD * D⌉ ⌊d₀ + TD * D⌋
    let BN : Finset ℤ := Finset.Icc ⌈n₀ - TN * N⌉ ⌊n₀ + TN * N⌋
    let H : ℤ × ℤ → ℂ := fun z =>
      if Int.ModEq (q₀ : ℤ) z.1 dstar ∧ Int.ModEq (q₀ : ℤ) z.2 nstar ∧
          Int.gcd z.1 (m : ℤ) = 1 ∧
          Int.gcd (F₁ z.1 z.2) (c₁ : ℤ) = 1 ∧
          Int.gcd (F₂ z.1 z.2) (c₁ : ℤ) = 1 ∧
          Int.gcd (F₃ z.1 z.2) (c₂ : ℤ) = 1 ∧
          Int.gcd (F₄ z.1 z.2) (c₂ : ℤ) = 1 then
        ψD (((z.1 : ℝ) - d₀) / D) * ψN (((z.2 : ℝ) - n₀) / N) *
          affineReciprocalProductPhase m A B L 0 0
            (z.2 : ZMod m) (z.1 : ZMod m)
      else 0
    let total : ℂ := ∑ d ∈ BD, ∑ n ∈ BN, H (d, n)
    HasSum H total ∧
      ‖total‖ ≤
        (m.divisors.card : ℝ) * (c₁.divisors.card : ℝ) ^ 2 *
          (c₂.divisors.card : ℝ) ^ 2 *
          (Nat.gcd m (A * L).val : ℝ) * (∏ p : m.primeFactors, max 1 (K p)) *
          (4 * TD + 3) * LD * (4 * TN + 3) * LN *
          (1 + Real.log (m : ℝ)) ^ 2 * (1 / (q₀ : ℝ)) *
          (Real.sqrt (m : ℝ) + N / Real.sqrt (m : ℝ)) *
          (Real.sqrt (m : ℝ) + D / Real.sqrt (m : ℝ)) := by
  intro F₁ F₂ F₃ F₄ K BD BN H total
  let W : ℤ → ℤ → ℂ := fun d n =>
    ψD (((d : ℝ) - d₀) / D) * ψN (((n : ℝ) - n₀) / N) *
      affineReciprocalProductPhase m A B L 0 0
        (n : ZMod m) (d : ZMod m)
  let P : ℝ := ∏ p : m.primeFactors, max 1 (K p)
  let V : ℝ := (4 * TD + 3) * LD * (4 * TN + 3) * LN
  let S : ℝ := (Real.sqrt (m : ℝ) + N / Real.sqrt (m : ℝ)) *
    (Real.sqrt (m : ℝ) + D / Real.sqrt (m : ℝ))
  let C : ℝ := (Nat.gcd m (A * L).val : ℝ) * P * V *
    (1 + Real.log (m : ℝ)) ^ 2 * S
  let T : ℝ := (m.divisors.card : ℝ) * (c₁.divisors.card : ℝ) ^ 2 *
    (c₂.divisors.card : ℝ) ^ 2
  have hWzero {d n : ℤ} (hz : (d, n) ∉ BD ×ˢ BN) : W d n = 0 := by
    by_contra hw
    change ψD (((d : ℝ) - d₀) / D) * ψN (((n : ℝ) - n₀) / N) *
      affineReciprocalProductPhase m A B L 0 0
        (n : ZMod m) (d : ZMod m) ≠ 0 at hw
    have hv := mul_ne_zero_iff.mp (mul_ne_zero_iff.mp hw).1
    have hd := hsupportD hv.1
    have hn := hsupportN hv.2
    have hdlo := (le_div_iff₀ hD).1 hd.1
    have hdhi := (div_le_iff₀ hD).1 hd.2
    have hnlo := (le_div_iff₀ hN).1 hn.1
    have hnhi := (div_le_iff₀ hN).1 hn.2
    apply hz
    exact Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr
      ⟨Int.ceil_le.mpr (by linarith), Int.le_floor.mpr (by linarith)⟩,
      Finset.mem_Icc.mpr
        ⟨Int.ceil_le.mpr (by linarith), Int.le_floor.mpr (by linarith)⟩⟩
  have hsum : HasSum H total := by
    have hbox : HasSum H (∑ z ∈ BD ×ˢ BN, H z) := by
      apply hasSum_sum_of_ne_finset_zero
      intro z hz
      change (if _ then W z.1 z.2 else 0) = 0
      simp only [hWzero hz, ite_self]
    simpa only [total, Finset.sum_product] using hbox
  have htotal : total =
      ∑ d ∈ BD.filter (fun d : ℤ =>
          Int.ModEq (q₀ : ℤ) d dstar ∧ Int.gcd d (m : ℤ) = 1),
        ∑ n ∈ BN.filter (fun n : ℤ =>
          Int.ModEq (q₀ : ℤ) n nstar ∧
            Int.gcd (F₁ d n) (c₁ : ℤ) = 1 ∧ Int.gcd (F₂ d n) (c₁ : ℤ) = 1 ∧
            Int.gcd (F₃ d n) (c₂ : ℤ) = 1 ∧ Int.gcd (F₄ d n) (c₂ : ℤ) = 1),
          W d n := by
    have hpoint (d n : ℤ) : H (d, n) =
        if (Int.ModEq (q₀ : ℤ) d dstar ∧ Int.gcd d (m : ℤ) = 1) ∧
            (Int.ModEq (q₀ : ℤ) n nstar ∧
              Int.gcd (F₁ d n) (c₁ : ℤ) = 1 ∧
              Int.gcd (F₂ d n) (c₁ : ℤ) = 1 ∧
              Int.gcd (F₃ d n) (c₂ : ℤ) = 1 ∧
              Int.gcd (F₄ d n) (c₂ : ℤ) = 1) then W d n else 0 := by
      dsimp only [H, W]
      congr 1
      apply propext
      tauto
    simp only [total, hpoint, Finset.sum_filter, ite_and, Finset.sum_ite_irrel,
      Finset.sum_const_zero]
  have hcomplete (q r : ℕ) (hq : 0 < q) (hr : 0 < r) (hqr : q * r = m)
      (ds ns : ℤ) :
      ‖∑ d ∈ BD.filter (fun d : ℤ => Int.ModEq (q : ℤ) d ds),
        ∑ n ∈ BN.filter (fun n : ℤ => Int.ModEq (q : ℤ) n ns), W d n‖ ≤
        C * (1 / (q : ℝ)) := by
    let : NeZero q := ⟨hq.ne'⟩
    let : NeZero r := ⟨hr.ne'⟩
    let Kᵣ : (p : r.primeFactors) → ℝ := fun p =>
      letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
      (Finset.univ : Finset (ZMod p.1)).sup' Finset.univ_nonempty
        (fun c => ‖normalizedKloosterman3 p.1 c‖)
    let Pᵣ : ℝ := ∏ p : r.primeFactors, max 1 (Kᵣ p)
    let Gc : ℤ × ℤ → ℂ := fun z =>
      if Int.ModEq (q : ℤ) ds z.1 ∧ Int.ModEq (q : ℤ) ns z.2 then W z.1 z.2 else 0
    have hGsum : HasSum Gc
        (∑ d ∈ BD.filter (fun d : ℤ => Int.ModEq (q : ℤ) d ds),
          ∑ n ∈ BN.filter (fun n : ℤ => Int.ModEq (q : ℤ) n ns), W d n) := by
      have hbox : HasSum Gc (∑ z ∈ BD ×ˢ BN, Gc z) := by
        apply hasSum_sum_of_ne_finset_zero
        intro z hz
        simp only [Gc, hWzero hz, ite_self]
      have hpoint (d n : ℤ) : Gc (d, n) =
          if Int.ModEq (q : ℤ) d ds ∧ Int.ModEq (q : ℤ) n ns then W d n else 0 := by
        dsimp only [Gc]
        simp only [Int.modEq_comm (a := ds) (b := d),
          Int.modEq_comm (a := ns) (b := n)]
      simpa only [Finset.sum_product, hpoint, Finset.sum_filter, ite_and,
        Finset.sum_ite_irrel, Finset.sum_const_zero] using hbox
    have hestimate : ‖∑' z : ℤ × ℤ, Gc z‖ ≤
        (Nat.gcd m (A * L).val : ℝ) * Pᵣ * V *
          (1 + Real.log (r : ℝ)) ^ 2 * (1 / (q : ℝ)) * S := by
      subst m
      simpa only [Kᵣ, Pᵣ, Gc, W, V, S, mul_assoc] using
        (poleMasked_compactProfiles_congruence_kl3_max_bound
          q r hm A B L ds ns TD TN LD LN D N d₀ n₀ hTD hTN hLD hLN hD hN
          ψD ψN hψD hψN hsupportD hsupportN hboundD hboundN).2
    have hrdvd : r ∣ m := ⟨q, hqr.symm.trans (Nat.mul_comm q r)⟩
    have hsubset : r.primeFactors ⊆ m.primeFactors :=
      Nat.primeFactors_mono hrdvd (NeZero.ne m)
    have hprod : Pᵣ ≤ P := by
      let e : r.primeFactors → m.primeFactors := fun p => ⟨p.1, hsubset p.2⟩
      exact Finset.prod_le_prod_of_injOn e
        (fun p _ q _ hpq =>
          Subtype.ext (congrArg (fun x : m.primeFactors => x.1) hpq))
        (Finset.subset_univ _) (fun _ _ => le_rfl)
        (fun _ _ => zero_le_one.trans (le_max_left _ _)) (fun _ _ _ => le_max_left _ _)
    have hPnonneg : 0 ≤ P := by
      dsimp only [P]
      positivity
    have hrreal : (0 : ℝ) < r := by exact_mod_cast hr
    have hrle : (r : ℝ) ≤ m := by
      exact_mod_cast Nat.le_of_dvd (NeZero.pos m) hrdvd
    have hlogr : 0 ≤ 1 + Real.log (r : ℝ) :=
      add_nonneg zero_le_one (Real.log_nonneg (by exact_mod_cast hr))
    have hlogm : 0 ≤ 1 + Real.log (m : ℝ) :=
      add_nonneg zero_le_one (Real.log_nonneg (by exact_mod_cast NeZero.pos m))
    have hlogs : (1 + Real.log (r : ℝ)) ^ 2 ≤
        (1 + Real.log (m : ℝ)) ^ 2 :=
      (sq_le_sq₀ hlogr hlogm).mpr (add_le_add_right (Real.log_le_log hrreal hrle) 1)
    have hprodlog : Pᵣ * (1 + Real.log (r : ℝ)) ^ 2 ≤
        P * (1 + Real.log (m : ℝ)) ^ 2 :=
      mul_le_mul hprod hlogs (sq_nonneg _) hPnonneg
    have hrest : 0 ≤ (Nat.gcd m (A * L).val : ℝ) * V * (1 / (q : ℝ)) * S := by
      dsimp only [V, S]
      positivity
    calc
      _ = ‖∑' z : ℤ × ℤ, Gc z‖ := congrArg norm hGsum.tsum_eq.symm
      _ ≤ (Nat.gcd m (A * L).val : ℝ) * Pᵣ * V *
          (1 + Real.log (r : ℝ)) ^ 2 * (1 / (q : ℝ)) * S := hestimate
      _ ≤ C * (1 / (q : ℝ)) := by
        have hmono := mul_le_mul_of_nonneg_left hprodlog hrest
        simpa only [C, mul_assoc, mul_left_comm, mul_comm] using hmono
  have hq₀pos : 0 < q₀ := Nat.pos_of_dvd_of_pos hq₀ (NeZero.pos m)
  let : NeZero q₀ := ⟨hq₀pos.ne'⟩
  have hselection := (sourceTerminalInsideMobius_masked_reduction
    m q₀ c₁ c₂ f w₃ hq₀ hc₁ hc₂ u v F G h ell dstar nstar hu hv hw₃
    A B L BD BN
    (fun d : ℤ => ψD (((d : ℝ) - d₀) / D))
    (fun n : ℤ => ψN (((n : ℝ) - n₀) / N))).2
  rcases hselection with ⟨e₀, _he₀, e₁, _he₁, e₂, _he₂, e₃, _he₃, e₄, _he₄,
    hselection⟩
  let g₂ : ℕ := Nat.lcm q₀ e₀
  let g₃ : ℕ := Nat.lcm q₀ (Nat.lcm e₁ (Nat.lcm e₂ (Nat.lcm e₃ e₄)))
  let g₁ : ℕ := Nat.lcm g₂ g₃
  let q₃ : ℕ := g₁ / q₀
  change 0 < q₃ ∧ q₀ * q₃ = g₁ ∧ g₁ ∣ m ∧ q₃ ∣ m / q₀ ∧ _ at hselection
  rcases hselection with ⟨hq₃pos, hqeq, hg₁m, _hq₃m, r, _hdr, _hnr, hselected⟩
  have hqdiv : q₀ * q₃ ∣ m := hqeq.symm ▸ hg₁m
  have hqpos : 0 < q₀ * q₃ := Nat.mul_pos hq₀pos hq₃pos
  have hrpos : 0 < m / (q₀ * q₃) :=
    Nat.div_pos (Nat.le_of_dvd (NeZero.pos m) hqdiv) hqpos
  have hcell := hcomplete (q₀ * q₃) (m / (q₀ * q₃)) hqpos hrpos
    (Nat.mul_div_cancel' hqdiv) (r.1.val : ℤ) (r.2.val : ℤ)
  have hcancel : (q₃ : ℝ) * (1 / ((q₀ * q₃ : ℕ) : ℝ)) = 1 / (q₀ : ℝ) := by
    have hq₃real : (q₃ : ℝ) ≠ 0 := by exact_mod_cast hq₃pos.ne'
    simp only [Nat.cast_mul, one_div, mul_inv_rev, mul_inv_cancel_left₀ hq₃real]
  refine ⟨hsum, ?_⟩
  calc
    ‖total‖ ≤ T * (q₃ : ℝ) *
        ‖∑ d ∈ BD.filter (fun d : ℤ =>
            Int.ModEq ((q₀ * q₃ : ℕ) : ℤ) d (r.1.val : ℤ)),
          ∑ n ∈ BN.filter (fun n : ℤ =>
            Int.ModEq ((q₀ * q₃ : ℕ) : ℤ) n (r.2.val : ℤ)), W d n‖ := by
      rw [htotal]
      simpa only [T, W, F₁, F₂, F₃, F₄] using hselected
    _ ≤ T * (q₃ : ℝ) * (C * (1 / ((q₀ * q₃ : ℕ) : ℝ))) :=
      mul_le_mul_of_nonneg_left hcell (by dsimp only [T]; positivity)
    _ = T * C * ((q₃ : ℝ) * (1 / ((q₀ * q₃ : ℕ) : ℝ))) := by ring
    _ = T * C * (1 / (q₀ : ℝ)) := by rw [hcancel]
    _ = _ := by dsimp only [T, C, P, V, S]; ring

open Classical in
theorem sourceTerminalInsideMobius_uniform_kl3_max_bound
    (Csrc ε TD TN CD CN ED EN : ℝ)
    (hCsrc : 0 ≤ Csrc) (hε : 0 < ε)
    (hTD : 0 ≤ TD) (hTN : 0 ≤ TN) (hCD : 0 ≤ CD) (hCN : 0 ≤ CN) :
    ∃ X₀ : ℝ, Real.exp 1 ≤ X₀ ∧
      ∀ (x : ℝ), X₀ ≤ x →
      ∀ (m q₀ c₁ c₂ f w₃ : ℕ) (hm : Squarefree m), (m : ℝ) ≤ x ^ Csrc →
      (hq₀ : q₀ ∣ m) → (hc₁ : c₁ ∣ m) → (hc₂ : c₂ ∣ m) →
      ∀ (u v F G h ell dstar nstar : ℤ),
      (hu : IsUnit (u : ZMod m)) → (hv : IsUnit (v : ZMod m)) →
      (hw₃ : Nat.Coprime w₃ m) → ∀ (A B L : ZMod m),
      ∀ (D N d₀ n₀ : ℝ), (hD : 0 < D) → (hN : 0 < N) →
      ∀ (ψD ψN : ℝ → ℂ), ContDiff ℝ 1 ψD → ContDiff ℝ 1 ψN →
      Function.support ψD ⊆ Set.Icc (-TD) TD →
      Function.support ψN ⊆ Set.Icc (-TN) TN →
      (∀ t : ℝ, ‖ψD t‖ ≤ CD * (Real.log x) ^ ED ∧
        ‖deriv ψD t‖ ≤ CD * (Real.log x) ^ ED) →
      (∀ t : ℝ, ‖ψN t‖ ≤ CN * (Real.log x) ^ EN ∧
        ‖deriv ψN t‖ ≤ CN * (Real.log x) ^ EN) →
      letI : NeZero m := ⟨hm.ne_zero⟩
      let F₁ : ℤ → ℤ → ℤ := fun d n =>
        u * (w₃ : ℤ) * n + (u * h + F * (f : ℤ)) * d
      let F₂ : ℤ → ℤ → ℤ := fun d n =>
        v * (w₃ : ℤ) * n + (v * h + G * (f : ℤ)) * d
      let F₃ : ℤ → ℤ → ℤ := fun d n =>
        u * (w₃ : ℤ) * n + (u * h + (F + ell) * (f : ℤ)) * d
      let F₄ : ℤ → ℤ → ℤ := fun d n =>
        v * (w₃ : ℤ) * n + (v * h + (G + ell) * (f : ℤ)) * d
      let K : (p : m.primeFactors) → ℝ := fun p =>
        letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
        (Finset.univ : Finset (ZMod p.1)).sup' Finset.univ_nonempty
          (fun c => ‖normalizedKloosterman3 p.1 c‖)
      let BD : Finset ℤ := Finset.Icc ⌈d₀ - TD * D⌉ ⌊d₀ + TD * D⌋
      let BN : Finset ℤ := Finset.Icc ⌈n₀ - TN * N⌉ ⌊n₀ + TN * N⌋
      let H : ℤ × ℤ → ℂ := fun z =>
        if Int.ModEq (q₀ : ℤ) z.1 dstar ∧ Int.ModEq (q₀ : ℤ) z.2 nstar ∧
            Int.gcd z.1 (m : ℤ) = 1 ∧
            Int.gcd (F₁ z.1 z.2) (c₁ : ℤ) = 1 ∧
            Int.gcd (F₂ z.1 z.2) (c₁ : ℤ) = 1 ∧
            Int.gcd (F₃ z.1 z.2) (c₂ : ℤ) = 1 ∧
            Int.gcd (F₄ z.1 z.2) (c₂ : ℤ) = 1 then
          ψD (((z.1 : ℝ) - d₀) / D) * ψN (((z.2 : ℝ) - n₀) / N) *
            affineReciprocalProductPhase m A B L 0 0
              (z.2 : ZMod m) (z.1 : ZMod m)
        else 0
      let total : ℂ := ∑ d ∈ BD, ∑ n ∈ BN, H (d, n)
      HasSum H total ∧
        ‖total‖ ≤ x ^ ε *
          (Nat.gcd m (A * L).val : ℝ) * (∏ p : m.primeFactors, max 1 (K p)) *
          (1 / (q₀ : ℝ)) *
          (Real.sqrt (m : ℝ) + N / Real.sqrt (m : ℝ)) *
          (Real.sqrt (m : ℝ) + D / Real.sqrt (m : ℝ)) := by
  obtain ⟨C₀, hC₀, hC₀bound⟩ := prime_factor_logarithmic_loss
    32 (Csrc + 1) 2 0 (ε / 2) (by norm_num) (by linarith)
    (by norm_num) (by norm_num) (half_pos hε)
  let P : ℝ := (4 * TD + 3) * CD * (4 * TN + 3) * CN
  have hP : 0 ≤ P := by dsimp [P]; positivity
  have hC₀P : 0 ≤ C₀ * P := mul_nonneg hC₀.le hP
  obtain ⟨b, hb⟩ := Filter.eventually_atTop.1
    (((isLittleO_log_rpow_rpow_atTop (ED + EN) (half_pos hε)).const_mul_left
      (C₀ * P)).bound (show (0 : ℝ) < 1 by norm_num))
  refine ⟨max (Real.exp 1) (max 2 b), le_max_left _ _, ?_⟩
  intro x hx m q₀ c₁ c₂ f w₃ hm hmx hq₀ hc₁ hc₂ u v F G h ell dstar nstar
    hu hv hw₃ A B L D N d₀ n₀ hD hN ψD ψN hψD hψN hsupportD hsupportN hboundD hboundN
  let : NeZero m := ⟨hm.ne_zero⟩
  have hx2 : 2 ≤ x := (le_max_left 2 b).trans ((le_max_right _ _).trans hx)
  have hxb : b ≤ x := (le_max_right 2 b).trans ((le_max_right _ _).trans hx)
  have hx1 : 1 ≤ x := by linarith
  have hx0 : 0 < x := by linarith
  have hlog : 0 < Real.log x := Real.log_pos (by linarith)
  have hprofile : C₀ * P * (Real.log x) ^ (ED + EN) ≤ x ^ (ε / 2) := by
    simpa only [Real.norm_of_nonneg
      (mul_nonneg hC₀P (Real.rpow_nonneg hlog.le (ED + EN))),
      Real.norm_of_nonneg (Real.rpow_nonneg hx0.le (ε / 2)), one_mul] using hb x hxb
  have hdivisorLog :
      (32 : ℝ) ^ m.primeFactors.card * (1 + Real.log (m : ℝ)) ^ 2 ≤
        C₀ * x ^ (ε / 2) := by
    have hmx' : (m : ℝ) ≤ x ^ (Csrc + 1) :=
      hmx.trans (Real.rpow_le_rpow_of_exponent_le hx1 (by linarith))
    simpa only [Real.rpow_zero, mul_one, Real.rpow_two] using
      hC₀bound x hx2 m hm.ne_zero hmx'
  have hc₁card : (c₁.divisors.card : ℝ) ≤ m.divisors.card := by
    exact_mod_cast Finset.card_le_card (Nat.divisors_subset_of_dvd hm.ne_zero hc₁)
  have hc₂card : (c₂.divisors.card : ℝ) ≤ m.divisors.card := by
    exact_mod_cast Finset.card_le_card (Nat.divisors_subset_of_dvd hm.ne_zero hc₂)
  have hcards :
      (m.divisors.card : ℝ) * (c₁.divisors.card : ℝ) ^ 2 *
        (c₂.divisors.card : ℝ) ^ 2 ≤ (32 : ℝ) ^ m.primeFactors.card := by
    calc
      _ ≤ (m.divisors.card : ℝ) * (m.divisors.card : ℝ) ^ 2 *
          (m.divisors.card : ℝ) ^ 2 := by
        gcongr
      _ = (m.divisors.card : ℝ) ^ 5 := by ring
      _ = (32 : ℝ) ^ m.primeFactors.card := by
        rw [squarefree_card_divisors m hm]
        push_cast
        rw [pow_right_comm]
        norm_num
  have hdivisorProfile :
      (m.divisors.card : ℝ) * (c₁.divisors.card : ℝ) ^ 2 *
        (c₂.divisors.card : ℝ) ^ 2 * (4 * TD + 3) *
        (CD * (Real.log x) ^ ED) * (4 * TN + 3) * (CN * (Real.log x) ^ EN) *
        (1 + Real.log (m : ℝ)) ^ 2 ≤ x ^ ε := by
    have hdivisorLog' :=
      (mul_le_mul_of_nonneg_right hcards (sq_nonneg (1 + Real.log (m : ℝ)))).trans
        hdivisorLog
    calc
      _ = ((m.divisors.card : ℝ) * (c₁.divisors.card : ℝ) ^ 2 *
          (c₂.divisors.card : ℝ) ^ 2 * (1 + Real.log (m : ℝ)) ^ 2) *
          (P * (Real.log x) ^ (ED + EN)) := by
        rw [Real.rpow_add hlog]
        dsimp [P]
        ring
      _ ≤ (C₀ * x ^ (ε / 2)) * (P * (Real.log x) ^ (ED + EN)) :=
        mul_le_mul_of_nonneg_right hdivisorLog'
          (mul_nonneg hP (Real.rpow_nonneg hlog.le (ED + EN)))
      _ = x ^ (ε / 2) * (C₀ * P * (Real.log x) ^ (ED + EN)) := by ring
      _ ≤ x ^ (ε / 2) * x ^ (ε / 2) :=
        mul_le_mul_of_nonneg_left hprofile (Real.rpow_nonneg hx0.le (ε / 2))
      _ = x ^ ε := by
        rw [← Real.rpow_add hx0, show ε / 2 + ε / 2 = ε by ring]
  have hLD : 0 ≤ CD * (Real.log x) ^ ED :=
    mul_nonneg hCD (Real.rpow_nonneg hlog.le ED)
  have hLN : 0 ≤ CN * (Real.log x) ^ EN :=
    mul_nonneg hCN (Real.rpow_nonneg hlog.le EN)
  have hbound := sourceTerminalInsideMobius_smooth_kl3_max_bound
    m q₀ c₁ c₂ f w₃ hm hq₀ hc₁ hc₂ u v F G h ell dstar nstar hu hv hw₃ A B L
    TD TN (CD * (Real.log x) ^ ED) (CN * (Real.log x) ^ EN) D N d₀ n₀
    hTD hTN hLD hLN hD hN ψD ψN hψD hψN hsupportD hsupportN hboundD hboundN
  let K : (p : m.primeFactors) → ℝ := fun p =>
    letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
    (Finset.univ : Finset (ZMod p.1)).sup' Finset.univ_nonempty
      (fun c => ‖normalizedKloosterman3 p.1 c‖)
  let R : ℝ :=
    (Nat.gcd m (A * L).val : ℝ) * (∏ p : m.primeFactors, max 1 (K p)) *
      (1 / (q₀ : ℝ)) * (Real.sqrt (m : ℝ) + N / Real.sqrt (m : ℝ)) *
      (Real.sqrt (m : ℝ) + D / Real.sqrt (m : ℝ))
  have hR : 0 ≤ R := by
    dsimp [R]
    positivity
  refine ⟨hbound.1, hbound.2.trans ?_⟩
  calc
    _ = ((m.divisors.card : ℝ) * (c₁.divisors.card : ℝ) ^ 2 *
        (c₂.divisors.card : ℝ) ^ 2 * (4 * TD + 3) *
        (CD * (Real.log x) ^ ED) * (4 * TN + 3) * (CN * (Real.log x) ^ EN) *
        (1 + Real.log (m : ℝ)) ^ 2) * R := by dsimp [R, K]; ring
    _ ≤ x ^ ε * R := mul_le_mul_of_nonneg_right hdivisorProfile hR
    _ = _ := by dsimp [R, K]; ring

end

theorem sourceTerminal_full_supported_part_mask
    (m w₂ : ℕ) (lam lamTilde : ℤ)
    (hm : m ≠ 0) (hlam : lam ≠ 0) (hlamTilde : lamTilde ≠ 0)
    (hwlam : w₂ = ∏ p ∈ m.primeFactors, p ^ (lam.natAbs.factorization p))
    (hwlamTilde :
      w₂ = ∏ p ∈ m.primeFactors, p ^ (lamTilde.natAbs.factorization p)) :
    let a : ℕ := ((lam / (w₂ : ℤ)) * (lamTilde / (w₂ : ℤ))).natAbs
    0 < a ∧ Nat.Coprime a m ∧
      ∀ d : ℤ,
        (Int.gcd d ((m : ℤ) * lam * lamTilde) = 1 ↔
          Int.gcd d (m : ℤ) = 1 ∧ Int.gcd d (a : ℤ) = 1) := by
  intro a
  have hA := primeFactors_prod_pow_factorization_dvd_and_coprime_div m lam.natAbs hm
    (Int.natAbs_ne_zero.mpr hlam)
  have hATilde := primeFactors_prod_pow_factorization_dvd_and_coprime_div m lamTilde.natAbs hm
    (Int.natAbs_ne_zero.mpr hlamTilde)
  simp only [← hwlam] at hA
  simp only [← hwlamTilde] at hATilde
  obtain ⟨hwpos, hwdvd, -, hwquot, -⟩ := hA
  obtain ⟨-, hwTildeDvd, -, hwTildeQuot, -⟩ := hATilde
  have hwlamInt : (w₂ : ℤ) ∣ lam := Int.natCast_dvd.mpr hwdvd
  have hwlamTildeInt : (w₂ : ℤ) ∣ lamTilde := Int.natCast_dvd.mpr hwTildeDvd
  have ha : a = (lam.natAbs / w₂) * (lamTilde.natAbs / w₂) := by
    simp only [a, Int.natAbs_mul, Int.natAbs_ediv_of_dvd hwlamInt,
      Int.natAbs_ediv_of_dvd hwlamTildeInt, Int.natAbs_natCast]
  refine ⟨?_, ?_, ?_⟩
  · rw [ha]
    exact Nat.mul_pos
      (Nat.div_pos (Nat.le_of_dvd (Int.natAbs_pos.mpr hlam) hwdvd) hwpos)
      (Nat.div_pos (Nat.le_of_dvd (Int.natAbs_pos.mpr hlamTilde) hwTildeDvd) hwpos)
  · rw [ha]
    exact hwquot.mul_left hwTildeQuot
  · intro d
    have hdw (hdm : Nat.Coprime d.natAbs m) : Nat.Coprime d.natAbs w₂ := by
      rw [hwlam, Nat.coprime_prod_right_iff]
      exact fun p hp ↦
        (hdm.of_dvd_right (Nat.dvd_of_mem_primeFactors hp)).pow_right _
    have hwhole : m * lam.natAbs * lamTilde.natAbs =
        m * (w₂ * (lam.natAbs / w₂)) * (w₂ * (lamTilde.natAbs / w₂)) := by
      rw [Nat.mul_div_cancel' hwdvd, Nat.mul_div_cancel' hwTildeDvd]
    simp only [Int.gcd_def, Int.natAbs_mul, Int.natAbs_natCast]
    change Nat.Coprime d.natAbs (m * lam.natAbs * lamTilde.natAbs) ↔
      Nat.Coprime d.natAbs m ∧ Nat.Coprime d.natAbs a
    rw [ha, hwhole]
    simp only [Nat.coprime_mul_iff_right]
    constructor
    · rintro ⟨⟨hdm, -, hq⟩, -, hqTilde⟩
      exact ⟨hdm, hq, hqTilde⟩
    · rintro ⟨hdm, hq, hqTilde⟩
      exact ⟨⟨hdm, hdw hdm, hq⟩, hdw hdm, hqTilde⟩

theorem source_mpz3_parameter_choice
    (ω δ : ℝ) (hω : 0 < ω) (hδ : 0 < δ) (h : 240 * ω + 80 * δ < 3) :
    let u : ℝ := 3 - 240 * ω - 80 * δ
    let σ : ℝ := 1 / 10 + u / 40
    0 < u ∧ u < 3 ∧
      1 - 72 * ω - 24 * δ = 1 / 10 + 3 * u / 10 ∧
      1 - 48 * ω - 16 * δ - 4 * σ = u / 10 ∧
      1 - 64 * ω - 20 * δ - 2 * σ = 13 * u / 60 + 4 * δ / 3 ∧
      72 * ω + 24 * δ < 1 ∧
      48 * ω + 16 * δ + 4 * σ < 1 ∧
      64 * ω + 20 * δ + 2 * σ < 1 ∧
      1 / 18 + 28 * ω / 9 + 2 * δ / 9 =
        17 / 180 - 7 * u / 540 - 22 * δ / 27 ∧
      1 / 18 + 28 * ω / 9 + 2 * δ / 9 < 17 / 180 ∧
      (17 / 180 : ℝ) < 1 / 10 ∧ 1 / 10 < σ ∧ σ < 1 / 2 ∧
      ω < 1 / 80 ∧ ω < 1 / 12 ∧ δ < 3 / 80 ∧ δ < 1 / 4 + ω ∧
      σ - 2 * ω = 3 / 40 + u / 30 + 2 * δ / 3 ∧ 2 * ω < σ ∧
      ∃ ω' δ' : ℝ, ω < ω' ∧ δ < δ' ∧ 240 * ω' + 80 * δ' < 3 := by
  dsimp only
  refine ⟨by linarith, by linarith, by ring, by ring, by ring,
    by linarith, by linarith, by linarith, by ring, by linarith,
    by norm_num, by linarith, by linarith, by linarith, by linarith,
    by linarith, by linarith, by ring, by linarith, ?_⟩
  refine ⟨ω + (3 - 240 * ω - 80 * δ) / 640,
    δ + (3 - 240 * ω - 80 * δ) / 640, ?_, ?_, ?_⟩ <;> linarith

theorem source_typeI_II_working_ranges
    (ω₀ δ₀ σ : ℝ) (hω₀ : 0 < ω₀) (hδ₀ : 0 < δ₀) (_ : 0 < σ)
    (hA : 72 * ω₀ + 24 * δ₀ < 1)
    (hB : 48 * ω₀ + 16 * δ₀ + 4 * σ < 1)
    (hC : 64 * ω₀ + 20 * δ₀ + 2 * σ < 1) :
    ∃ ω δ : ℝ, ω₀ < ω ∧ δ₀ < δ ∧
      72 * ω + 24 * δ < 1 ∧
      48 * ω + 16 * δ + 4 * σ < 1 ∧
      64 * ω + 20 * δ + 2 * σ < 1 ∧
      ∀ η : ℝ, 0 < η → ∃ ε : ℝ, 0 < ε ∧ ε < η ∧ ε < δ / (10 : ℝ) ^ 100 ∧
        let L : ℝ := max (1 / 4 + 12 * ω + 4 * δ + 100 * ε)
          (32 * ω + 10 * δ + 400 * ε)
        let U : ℝ := 1 / 2 - 4 * ω - 2 * δ - 50 * ε
        L < 1 / 2 - σ ∧ 1 / 4 + 14 * ω + 4 * δ < U ∧
          1 - 68 * ω - 14 * δ > 0 ∧
          ∀ γ : ℝ, 1 / 2 - σ ≤ γ → γ ≤ 1 / 2 →
            (L ≤ γ ∧ γ ≤ U) ∨
              (1 / 4 + 14 * ω + 4 * δ ≤ γ ∧ γ ≤ 1 / 2) := by
  have hp : 0 < min ((1 - 72 * ω₀ - 24 * δ₀) / 1000)
      (min ((1 - 48 * ω₀ - 16 * δ₀ - 4 * σ) / 1000)
        ((1 - 64 * ω₀ - 20 * δ₀ - 2 * σ) / 1000)) := by
    simp only [lt_min_iff]
    exact ⟨by linarith, by linarith, by linarith⟩
  obtain ⟨t, ht0, ht⟩ := exists_between hp
  simp only [lt_min_iff] at ht
  obtain ⟨htA, htB, htC⟩ := ht
  let ω : ℝ := ω₀ + t
  let δ : ℝ := δ₀ + t
  have hω : 0 < ω := add_pos hω₀ ht0
  have hδ : 0 < δ := add_pos hδ₀ ht0
  have hA' : 72 * ω + 24 * δ < 1 := by dsimp only [ω, δ]; linarith
  have hB' : 48 * ω + 16 * δ + 4 * σ < 1 := by dsimp only [ω, δ]; linarith
  have hC' : 64 * ω + 20 * δ + 2 * σ < 1 := by dsimp only [ω, δ]; linarith
  refine ⟨ω, δ, lt_add_of_pos_right _ ht0, lt_add_of_pos_right _ ht0,
    hA', hB', hC', ?_⟩
  intro η hη
  have hcap : 0 < min η (min (δ / (10 : ℝ) ^ 100)
      (min ((1 - 72 * ω - 24 * δ) / 200)
        (min ((1 - 48 * ω - 16 * δ - 4 * σ) / 400)
          ((1 - 64 * ω - 20 * δ - 2 * σ) / 800)))) := by
    simp only [lt_min_iff]
    exact ⟨hη, by positivity, by linarith, by linarith, by linarith⟩
  obtain ⟨ε, hε0, hεcap⟩ := exists_between hcap
  simp only [lt_min_iff] at hεcap
  obtain ⟨hεη, hεδ, hεA, hεB, hεC⟩ := hεcap
  refine ⟨ε, hε0, hεη, hεδ, ?_⟩
  dsimp only
  have hsmall : max (1 / 4 + 12 * ω + 4 * δ + 100 * ε)
      (32 * ω + 10 * δ + 400 * ε) < 1 / 2 - σ :=
    max_lt_iff.mpr ⟨by linarith, by linarith⟩
  have hoverlap : 1 / 4 + 14 * ω + 4 * δ <
      1 / 2 - 4 * ω - 2 * δ - 50 * ε := by linarith
  refine ⟨hsmall, hoverlap, by linarith, ?_⟩
  intro γ hγlow hγhigh
  by_cases hγ : γ ≤ 1 / 2 - 4 * ω - 2 * δ - 50 * ε
  · exact Or.inl ⟨hsmall.le.trans hγlow, hγ⟩
  · exact Or.inr ⟨(hoverlap.trans (lt_of_not_ge hγ)).le, hγhigh⟩

theorem source_terminal_three_power_bounds
    (x ω δ ε γ : ℝ) (hx : 1 ≤ x) (hω : 0 < ω) (_ : 0 < δ) (hε : 0 < ε)
    (hγlow : max (1 / 4 + 12 * ω + 4 * δ + 100 * ε)
      (32 * ω + 10 * δ + 400 * ε) ≤ γ)
    (hγhigh : γ ≤ 1 / 2 - 4 * ω - 2 * δ - 50 * ε) :
    x ^ (-1 + 2 * γ) *
        max (x ^ (4 * ω + 3 * δ + 94 * ε))
          (x ^ (8 * ω + 3 * δ + 91 * ε)) ≤ x ^ (-δ) ∧
      x ^ (-γ) *
        max (x ^ (28 * ω + 10 * δ + 245 * ε))
          (x ^ (32 * ω + 10 * δ + 242 * ε)) ≤ 1 ∧
      x ^ (1 - 4 * γ) *
        max (x ^ (44 * ω + 16 * δ + 327 * ε))
          (x ^ (48 * ω + 16 * δ + 324 * ε)) ≤ 1 := by
  have hx0 : 0 < x := zero_lt_one.trans_le hx
  obtain ⟨hγ₁, hγ₂⟩ := max_le_iff.mp hγlow
  refine ⟨?_, ?_⟩
  · rw [mul_max_of_nonneg _ _ (Real.rpow_nonneg hx0.le _)]
    apply max_le <;> rw [← Real.rpow_add hx0] <;>
      exact Real.rpow_le_rpow_of_exponent_le hx (by linarith)
  · constructor <;> rw [mul_max_of_nonneg _ _ (Real.rpow_nonneg hx0.le _)] <;>
      apply max_le <;> rw [← Real.rpow_add hx0] <;>
        exact Real.rpow_le_one_of_one_le_of_nonpos hx (by linarith)

theorem source_terminal_modulus_resource_transport
    (δ ε cₘ Cₘ CΔ : ℝ) (_ : 0 < δ) (_ : 0 < ε)
    (hcₘ : 0 < cₘ) (_ : 0 < Cₘ) (hCΔ : 0 < CΔ) :
    ∀ x M N R₀ Q H κ q₀ g Δ₁ m : ℝ,
      1 ≤ x → 0 < M → 0 < N → 0 < R₀ → 0 < Q →
      1 ≤ H → 1 ≤ κ → 1 ≤ q₀ → 1 ≤ g → 0 < Δ₁ → 0 < m →
      H = x ^ ε * R₀ * Q ^ 2 / (q₀ * M) →
      Δ₁ ≤ CΔ * N / (x ^ (55 * ε) * H ^ 2) →
      cₘ * (R₀ * Q ^ 2 * H) / (q₀ * g * κ * Δ₁) ≤ m →
      m ≤ Cₘ * x ^ δ * R₀ * Q ^ 2 * H / (q₀ * g * Δ₁) →
      R₀ * Q ^ 2 = x ^ (-ε) * q₀ * M * H ∧
        (cₘ / CΔ) * x ^ (54 * ε) * M * H ^ 4 / (g * N * κ) ≤ m ∧
        m ≤ Cₘ * x ^ (δ - ε) * M * H ^ 2 / (g * Δ₁) := by
  intro x M N R₀ Q H κ q₀ g Δ₁ m hx hM hN _hR₀ _hQ hH hκ hq hg hΔ _hm
    hHdef hΔupper hmlower hmupper
  have hx0 : 0 < x := zero_lt_one.trans_le hx
  have hRQ : R₀ * Q ^ 2 = x ^ (-ε) * q₀ * M * H := by
    rw [Real.rpow_neg hx0.le]
    field_simp (disch := positivity) at hHdef ⊢
    nlinarith only [hHdef]
  have hΔinv : x ^ (55 * ε) * H ^ 2 / (CΔ * N) ≤ 1 / Δ₁ := by
    simpa only [one_div_div] using one_div_le_one_div_of_le hΔ hΔupper
  refine ⟨hRQ, ?_, ?_⟩
  · calc
      (cₘ / CΔ) * x ^ (54 * ε) * M * H ^ 4 / (g * N * κ) =
          (cₘ * x ^ (-ε) * M * H ^ 2 / (g * κ)) *
            (x ^ (55 * ε) * H ^ 2 / (CΔ * N)) := by
        rw [show 54 * ε = -ε + 55 * ε by ring, Real.rpow_add hx0 (-ε) (55 * ε)]
        field_simp (disch := positivity)
      _ ≤ (cₘ * x ^ (-ε) * M * H ^ 2 / (g * κ)) * (1 / Δ₁) :=
        mul_le_mul_of_nonneg_left hΔinv (by positivity)
      _ = cₘ * (R₀ * Q ^ 2 * H) / (q₀ * g * κ * Δ₁) := by
        rw [hRQ]
        field_simp (disch := positivity)
      _ ≤ m := hmlower
  · calc
      m ≤ Cₘ * x ^ δ * R₀ * Q ^ 2 * H / (q₀ * g * Δ₁) := hmupper
      _ = Cₘ * x ^ δ * (R₀ * Q ^ 2) * H / (q₀ * g * Δ₁) := by ring
      _ = Cₘ * x ^ (δ - ε) * M * H ^ 2 / (g * Δ₁) := by
        rw [hRQ, Real.rpow_sub hx0, Real.rpow_neg hx0.le]
        field_simp (disch := positivity)

theorem source_terminal_decisive_cancellation
    (Cκ CH : ℝ) (_ : 0 < Cκ) (_ : 0 < CH) :
    ∀ κ H H₀ q₀ : ℝ,
      1 ≤ κ → 1 ≤ H → 0 < H₀ → 1 ≤ q₀ →
      κ ≤ Cκ * q₀ → H ≤ CH * H₀ / q₀ →
      κ ^ 3 * H / (q₀ ^ 2 * H₀) =
          (κ / q₀) ^ 3 * (q₀ * H / H₀) ∧
        κ ^ 3 * H ^ 2 / (q₀ ^ 2 * H₀ ^ 2) =
          (κ / q₀) ^ 3 * (q₀ * H / H₀) ^ 2 * (1 / q₀) ∧
        κ ^ 3 * H / q₀ ^ 2 ≤ Cκ ^ 3 * CH * H₀ ∧
        κ ^ 3 * H ^ 2 / q₀ ^ 2 ≤ Cκ ^ 3 * CH ^ 2 * H₀ ^ 2 := by
  intro κ H H₀ q₀ hκ hH hH₀ hq hκbound hHbound
  have hκq : κ / q₀ ≤ Cκ := (div_le_iff₀ (by positivity)).mpr hκbound
  have hqH : q₀ * H / H₀ ≤ CH := by
    apply (div_le_iff₀ hH₀).mpr
    simpa only [mul_comm] using (le_div_iff₀ (by positivity)).mp hHbound
  refine ⟨?_, ?_, ?_, ?_⟩
  · field_simp (disch := positivity)
  · field_simp (disch := positivity)
  · calc
      κ ^ 3 * H / q₀ ^ 2 = ((κ / q₀) ^ 3 * (q₀ * H / H₀)) * H₀ := by
        field_simp (disch := positivity)
      _ ≤ (Cκ ^ 3 * CH) * H₀ := by gcongr
  · calc
      κ ^ 3 * H ^ 2 / q₀ ^ 2 =
          ((κ / q₀) ^ 3 * (q₀ * H / H₀) ^ 2) * H₀ ^ 2 / q₀ := by
        field_simp (disch := positivity)
      _ ≤ (Cκ ^ 3 * CH ^ 2) * H₀ ^ 2 / q₀ := by gcongr
      _ ≤ Cκ ^ 3 * CH ^ 2 * H₀ ^ 2 := div_le_self (by positivity) hq

theorem source_terminal_three_ratios_of_resources
    (ω δ ε Cκ CH CX cΔ₁ cΔstar cₘ Cₘ : ℝ)
    (_ : 0 < ω) (_ : 0 < δ) (_ : 0 < ε)
    (hCκ : 0 < Cκ) (hCH : 0 < CH) (hCX : 0 < CX)
    (hcΔ₁ : 0 < cΔ₁) (hcΔstar : 0 < cΔstar)
    (hcₘ : 0 < cₘ) (hCₘ : 0 < Cₘ) :
    let CA : ℝ := CX * Cκ ^ 3 * max CH (CH ^ 2) / cₘ
    let CB : ℝ := Cκ ^ 2 * max (CH ^ 7) (CH ^ 8) / cΔstar
    let CC : ℝ := CX * Cₘ * Cκ ^ 2 * max (CH ^ 11) (CH ^ 12) /
      (cΔ₁ * cΔstar)
    0 < CA ∧ 0 < CB ∧ 0 < CC ∧
      ∀ x γ M N H κ q₀ g g₀ Δ₁ Δstar m : ℝ,
        1 ≤ x → 0 < M → 0 < N → 1 ≤ H → 1 ≤ κ →
        1 ≤ q₀ → 1 ≤ g → 1 ≤ g₀ → 0 < Δ₁ → 0 < Δstar → 0 < m →
        N = x ^ γ → x / CX ≤ M * N → M * N ≤ CX * x →
        κ ≤ Cκ * q₀ → H ≤ CH * x ^ (4 * ω + δ + 7 * ε) / q₀ →
        cΔ₁ * N / (x ^ (δ + 55 * ε) * H ^ 2) ≤ Δ₁ →
        cΔstar * N / (x ^ (δ + 55 * ε) * H ^ 2) ≤ Δstar →
        cₘ * x ^ (54 * ε) * M * H ^ 4 / (g * N * κ) ≤ m →
        m ≤ Cₘ * x ^ (δ - ε) * M * H ^ 2 / (g * Δ₁) →
        let W : ℝ := max (x ^ (δ + 10 * ε) * H ^ 5) (H ^ 6)
        H ^ 2 * max (x ^ (δ + 10 * ε) * H ^ 3) (H ^ 4) = W ∧
          κ ^ 2 * x ^ (δ + 131 * ε) * W / (g * q₀ ^ 2 * g₀ * m) ≤
            CA * (x ^ (-1 + 2 * γ) *
              max (x ^ (4 * ω + 3 * δ + 94 * ε))
                (x ^ (8 * ω + 3 * δ + 91 * ε))) ∧
          κ ^ 2 * x ^ (δ + 131 * ε) * W / (g * q₀ ^ 2 * g₀ * Δstar) ≤
            CB * (x ^ (-γ) *
              max (x ^ (28 * ω + 10 * δ + 245 * ε))
                (x ^ (32 * ω + 10 * δ + 242 * ε))) ∧
          κ ^ 2 * x ^ (δ + 131 * ε) * m * W /
              (g * q₀ ^ 2 * g₀ * N * Δstar) ≤
            CC * (x ^ (1 - 4 * γ) *
              max (x ^ (44 * ω + 16 * δ + 327 * ε))
                (x ^ (48 * ω + 16 * δ + 324 * ε))) := by
  dsimp only
  refine ⟨by positivity, by positivity, by positivity, ?_⟩
  intro x γ M N H κ q₀ g g₀ Δ₁ Δstar m hx hM hN hH hκ hq hg hg₀ hΔ₁ hΔstar hm
    hNdef hMNlower hMNupper hκbound hHbound hΔ₁lower hΔstarlower hmlower hmupper
  have hx0 : 0 < x := zero_lt_one.trans_le hx
  let E : ℝ := 4 * ω + δ + 7 * ε
  let W : ℝ := max (x ^ (δ + 10 * ε) * H ^ 5) (H ^ 6)
  have hHsimple : H ≤ CH * x ^ E :=
    hHbound.trans (div_le_self (by positivity) hq)
  have hκ2 : κ ^ 2 / q₀ ^ 2 ≤ Cκ ^ 2 := by
    rw [← div_pow]
    exact pow_le_pow_left₀ (by positivity) ((div_le_iff₀ (by positivity)).mpr hκbound) 2
  obtain ⟨_, _, hκH, hκH2⟩ := source_terminal_decisive_cancellation Cκ CH hCκ hCH
    κ H (x ^ E) q₀ hκ hH (by positivity) hq hκbound hHbound
  have hΔ₁inv : 1 / Δ₁ ≤ x ^ (δ + 55 * ε) * H ^ 2 / (cΔ₁ * N) := by
    simpa only [one_div_div] using one_div_le_one_div_of_le (by positivity) hΔ₁lower
  have hΔstarinv : 1 / Δstar ≤ x ^ (δ + 55 * ε) * H ^ 2 / (cΔstar * N) := by
    simpa only [one_div_div] using one_div_le_one_div_of_le (by positivity) hΔstarlower
  have hminv : 1 / m ≤ g * N * κ / (cₘ * x ^ (54 * ε) * M * H ^ 4) := by
    simpa only [one_div_div] using one_div_le_one_div_of_le (by positivity) hmlower
  have hNM : N / M ≤ CX * N ^ 2 / x := by
    field_simp (disch := positivity) at hMNlower ⊢
    nlinarith only [hMNlower]
  have hMN3 : M / N ^ 3 ≤ CX * x / N ^ 4 := by
    field_simp (disch := positivity)
    nlinarith only [hMNupper]
  have hNx2 : N ^ 2 / x = x ^ (-1 + 2 * γ) := by
    rw [hNdef, ← Real.rpow_mul_natCast hx0.le]
    rw [show -1 + 2 * γ = γ * 2 - 1 by ring, Real.rpow_sub_one hx0.ne']
    norm_num
  have hNx4 : x / N ^ 4 = x ^ (1 - 4 * γ) := by
    rw [hNdef, ← Real.rpow_mul_natCast hx0.le]
    rw [show 1 - 4 * γ = 1 - γ * 4 by ring, Real.rpow_sub hx0, Real.rpow_one]
    norm_num
  have hAW : κ ^ 3 * W / (q₀ ^ 2 * H ^ 4) ≤
      Cκ ^ 3 * max CH (CH ^ 2) *
        max (x ^ (δ + 10 * ε) * x ^ E) ((x ^ E) ^ 2) := by
    dsimp only [W]
    rw [mul_max_of_nonneg _ _ (by positivity),
      ← max_div_div_right (by positivity : 0 ≤ q₀ ^ 2 * H ^ 4)]
    apply max_le
    · calc
        κ ^ 3 * (x ^ (δ + 10 * ε) * H ^ 5) / (q₀ ^ 2 * H ^ 4) =
            x ^ (δ + 10 * ε) * (κ ^ 3 * H / q₀ ^ 2) := by
          field_simp (disch := positivity)
        _ ≤ x ^ (δ + 10 * ε) * (Cκ ^ 3 * CH * x ^ E) :=
          mul_le_mul_of_nonneg_left hκH (by positivity)
        _ = (Cκ ^ 3 * CH) * (x ^ (δ + 10 * ε) * x ^ E) := by ring
        _ ≤ Cκ ^ 3 * max CH (CH ^ 2) *
            max (x ^ (δ + 10 * ε) * x ^ E) ((x ^ E) ^ 2) :=
          mul_le_mul (mul_le_mul_of_nonneg_left (le_max_left _ _) (by positivity))
            (le_max_left _ _) (by positivity) (by positivity)
    · calc
        κ ^ 3 * H ^ 6 / (q₀ ^ 2 * H ^ 4) = κ ^ 3 * H ^ 2 / q₀ ^ 2 := by
          field_simp (disch := positivity)
        _ ≤ Cκ ^ 3 * CH ^ 2 * (x ^ E) ^ 2 := hκH2
        _ ≤ Cκ ^ 3 * max CH (CH ^ 2) *
            max (x ^ (δ + 10 * ε) * x ^ E) ((x ^ E) ^ 2) :=
          mul_le_mul (mul_le_mul_of_nonneg_left (le_max_right _ _) (by positivity))
            (le_max_right _ _) (by positivity) (by positivity)
  have hWH (n : ℕ) : W * H ^ n ≤
      max (CH ^ (5 + n)) (CH ^ (6 + n)) *
        max (x ^ ((δ + 10 * ε) + E * ((5 + n : ℕ) : ℝ)))
          (x ^ (E * ((6 + n : ℕ) : ℝ))) := by
    dsimp only [W]
    rw [max_mul_of_nonneg _ _ (by positivity)]
    apply max_le
    · calc
        x ^ (δ + 10 * ε) * H ^ 5 * H ^ n = x ^ (δ + 10 * ε) * H ^ (5 + n) := by
          rw [mul_assoc, ← pow_add]
        _ ≤ x ^ (δ + 10 * ε) * (CH * x ^ E) ^ (5 + n) :=
          mul_le_mul_of_nonneg_left (pow_le_pow_left₀ (by positivity) hHsimple _) (by positivity)
        _ = CH ^ (5 + n) * x ^ ((δ + 10 * ε) + E * ((5 + n : ℕ) : ℝ)) := by
          rw [mul_pow, ← Real.rpow_mul_natCast hx0.le,
            Real.rpow_add hx0 (δ + 10 * ε) (E * ((5 + n : ℕ) : ℝ))]
          ring
        _ ≤ max (CH ^ (5 + n)) (CH ^ (6 + n)) *
            max (x ^ ((δ + 10 * ε) + E * ((5 + n : ℕ) : ℝ)))
              (x ^ (E * ((6 + n : ℕ) : ℝ))) :=
          mul_le_mul (le_max_left _ _) (le_max_left _ _) (by positivity) (by positivity)
    · calc
        H ^ 6 * H ^ n = H ^ (6 + n) := (pow_add H 6 n).symm
        _ ≤ (CH * x ^ E) ^ (6 + n) := pow_le_pow_left₀ (by positivity) hHsimple _
        _ = CH ^ (6 + n) * x ^ (E * ((6 + n : ℕ) : ℝ)) := by
          rw [mul_pow, Real.rpow_mul_natCast hx0.le]
        _ ≤ max (CH ^ (5 + n)) (CH ^ (6 + n)) *
            max (x ^ ((δ + 10 * ε) + E * ((5 + n : ℕ) : ℝ)))
              (x ^ (E * ((6 + n : ℕ) : ℝ))) :=
          mul_le_mul (le_max_right _ _) (le_max_right _ _) (by positivity) (by positivity)
  have hW2 := hWH 2
  have hW6 := hWH 6
  norm_num at hW2 hW6
  have hPA : x ^ (δ + 77 * ε) *
      max (x ^ (δ + 10 * ε) * x ^ E) ((x ^ E) ^ 2) =
      max (x ^ (4 * ω + 3 * δ + 94 * ε)) (x ^ (8 * ω + 3 * δ + 91 * ε)) := by
    rw [← Real.rpow_add hx0 (δ + 10 * ε) E, ← Real.rpow_mul_natCast hx0.le E 2,
      mul_max_of_nonneg _ _ (by positivity)]
    congr 1 <;> rw [← Real.rpow_add hx0] <;> congr 1 <;> dsimp only [E] <;> ring
  have hPB : x ^ (2 * δ + 186 * ε) *
      max (x ^ ((δ + 10 * ε) + E * 7)) (x ^ (E * 8)) =
      max (x ^ (28 * ω + 10 * δ + 245 * ε)) (x ^ (32 * ω + 10 * δ + 242 * ε)) := by
    rw [mul_max_of_nonneg _ _ (by positivity)]
    congr 1 <;> rw [← Real.rpow_add hx0] <;> congr 1 <;> dsimp only [E] <;> ring
  have hPC : x ^ (4 * δ + 240 * ε) *
      max (x ^ ((δ + 10 * ε) + E * 11)) (x ^ (E * 12)) =
      max (x ^ (44 * ω + 16 * δ + 327 * ε)) (x ^ (48 * ω + 16 * δ + 324 * ε)) := by
    rw [mul_max_of_nonneg _ _ (by positivity)]
    congr 1 <;> rw [← Real.rpow_add hx0] <;> congr 1 <;> dsimp only [E] <;> ring
  have hmcap : m ≤ Cₘ * x ^ (2 * δ + 54 * ε) * M * H ^ 4 / (g * cΔ₁ * N) := by
    calc
      m ≤ Cₘ * x ^ (δ - ε) * M * H ^ 2 / (g * Δ₁) := hmupper
      _ = (Cₘ * x ^ (δ - ε) * M * H ^ 2 / g) * (1 / Δ₁) := by ring
      _ ≤ (Cₘ * x ^ (δ - ε) * M * H ^ 2 / g) *
          (x ^ (δ + 55 * ε) * H ^ 2 / (cΔ₁ * N)) :=
        mul_le_mul_of_nonneg_left hΔ₁inv (by positivity)
      _ = Cₘ * x ^ (2 * δ + 54 * ε) * M * H ^ 4 / (g * cΔ₁ * N) := by
        rw [show 2 * δ + 54 * ε = (δ - ε) + (δ + 55 * ε) by ring,
          Real.rpow_add hx0 (δ - ε) (δ + 55 * ε)]
        field_simp (disch := positivity)
  refine ⟨?_, ?_, ?_, ?_⟩
  · rw [mul_max_of_nonneg _ _ (by positivity)]
    congr 1 <;> ring
  · calc
      κ ^ 2 * x ^ (δ + 131 * ε) * W / (g * q₀ ^ 2 * g₀ * m) =
          (κ ^ 2 * x ^ (δ + 131 * ε) * W / (g * q₀ ^ 2 * g₀)) * (1 / m) := by ring
      _ ≤ (κ ^ 2 * x ^ (δ + 131 * ε) * W / (g * q₀ ^ 2 * g₀)) *
          (g * N * κ / (cₘ * x ^ (54 * ε) * M * H ^ 4)) :=
        mul_le_mul_of_nonneg_left hminv (by positivity)
      _ = ((x ^ (δ + 77 * ε) * (N / M) / cₘ) *
          (κ ^ 3 * W / (q₀ ^ 2 * H ^ 4))) / g₀ := by
        rw [show δ + 131 * ε = (δ + 77 * ε) + 54 * ε by ring,
          Real.rpow_add hx0 (δ + 77 * ε) (54 * ε)]
        field_simp (disch := positivity)
      _ ≤ (x ^ (δ + 77 * ε) * (N / M) / cₘ) *
          (κ ^ 3 * W / (q₀ ^ 2 * H ^ 4)) := div_le_self (by positivity) hg₀
      _ ≤ (x ^ (δ + 77 * ε) * (CX * N ^ 2 / x) / cₘ) *
          (Cκ ^ 3 * max CH (CH ^ 2) *
            max (x ^ (δ + 10 * ε) * x ^ E) ((x ^ E) ^ 2)) := by gcongr
      _ = (CX * Cκ ^ 3 * max CH (CH ^ 2) / cₘ) * (N ^ 2 / x) *
          (x ^ (δ + 77 * ε) * max (x ^ (δ + 10 * ε) * x ^ E) ((x ^ E) ^ 2)) := by ring
      _ = (CX * Cκ ^ 3 * max CH (CH ^ 2) / cₘ) *
          (x ^ (-1 + 2 * γ) * max (x ^ (4 * ω + 3 * δ + 94 * ε))
            (x ^ (8 * ω + 3 * δ + 91 * ε))) := by rw [hNx2, hPA]; ring
  · calc
      κ ^ 2 * x ^ (δ + 131 * ε) * W / (g * q₀ ^ 2 * g₀ * Δstar) =
          (κ ^ 2 * x ^ (δ + 131 * ε) * W / (g * q₀ ^ 2 * g₀)) * (1 / Δstar) := by ring
      _ ≤ (κ ^ 2 * x ^ (δ + 131 * ε) * W / (g * q₀ ^ 2 * g₀)) *
          (x ^ (δ + 55 * ε) * H ^ 2 / (cΔstar * N)) :=
        mul_le_mul_of_nonneg_left hΔstarinv (by positivity)
      _ = ((κ ^ 2 / q₀ ^ 2) * (x ^ (2 * δ + 186 * ε) / N) *
          (W * H ^ 2) / cΔstar) / (g * g₀) := by
        rw [show 2 * δ + 186 * ε = (δ + 131 * ε) + (δ + 55 * ε) by ring,
          Real.rpow_add hx0 (δ + 131 * ε) (δ + 55 * ε)]
        field_simp (disch := positivity)
      _ ≤ (κ ^ 2 / q₀ ^ 2) * (x ^ (2 * δ + 186 * ε) / N) *
          (W * H ^ 2) / cΔstar :=
        div_le_self (by positivity) (one_le_mul_of_one_le_of_one_le hg hg₀)
      _ ≤ Cκ ^ 2 * (x ^ (2 * δ + 186 * ε) / N) *
          (max (CH ^ 7) (CH ^ 8) *
            max (x ^ ((δ + 10 * ε) + E * 7)) (x ^ (E * 8))) / cΔstar := by gcongr
      _ = (Cκ ^ 2 * max (CH ^ 7) (CH ^ 8) / cΔstar) * (1 / N) *
          (x ^ (2 * δ + 186 * ε) *
            max (x ^ ((δ + 10 * ε) + E * 7)) (x ^ (E * 8))) := by ring
      _ = (Cκ ^ 2 * max (CH ^ 7) (CH ^ 8) / cΔstar) *
          (x ^ (-γ) * max (x ^ (28 * ω + 10 * δ + 245 * ε))
            (x ^ (32 * ω + 10 * δ + 242 * ε))) := by rw [hPB, hNdef, Real.rpow_neg hx0.le]; ring
  · calc
      κ ^ 2 * x ^ (δ + 131 * ε) * m * W / (g * q₀ ^ 2 * g₀ * N * Δstar) =
          (κ ^ 2 * x ^ (δ + 131 * ε) * W / (g * q₀ ^ 2 * g₀ * N)) * m *
            (1 / Δstar) := by ring
      _ ≤ (κ ^ 2 * x ^ (δ + 131 * ε) * W / (g * q₀ ^ 2 * g₀ * N)) *
          (Cₘ * x ^ (2 * δ + 54 * ε) * M * H ^ 4 / (g * cΔ₁ * N)) *
            (x ^ (δ + 55 * ε) * H ^ 2 / (cΔstar * N)) := by gcongr
      _ = ((κ ^ 2 / q₀ ^ 2) * (Cₘ / (cΔ₁ * cΔstar)) * x ^ (4 * δ + 240 * ε) *
          (M / N ^ 3) * (W * H ^ 6)) / (g ^ 2 * g₀) := by
        rw [show 4 * δ + 240 * ε =
          ((δ + 131 * ε) + (2 * δ + 54 * ε)) + (δ + 55 * ε) by ring,
          Real.rpow_add hx0 ((δ + 131 * ε) + (2 * δ + 54 * ε)) (δ + 55 * ε),
          Real.rpow_add hx0 (δ + 131 * ε) (2 * δ + 54 * ε)]
        field_simp (disch := positivity)
      _ ≤ (κ ^ 2 / q₀ ^ 2) * (Cₘ / (cΔ₁ * cΔstar)) * x ^ (4 * δ + 240 * ε) *
          (M / N ^ 3) * (W * H ^ 6) :=
        div_le_self (by positivity)
          (one_le_mul_of_one_le_of_one_le (one_le_pow₀ hg) hg₀)
      _ ≤ Cκ ^ 2 * (Cₘ / (cΔ₁ * cΔstar)) * x ^ (4 * δ + 240 * ε) *
          (CX * x / N ^ 4) * (max (CH ^ 11) (CH ^ 12) *
            max (x ^ ((δ + 10 * ε) + E * 11)) (x ^ (E * 12))) := by gcongr
      _ = (CX * Cₘ * Cκ ^ 2 * max (CH ^ 11) (CH ^ 12) / (cΔ₁ * cΔstar)) *
          (x / N ^ 4) * (x ^ (4 * δ + 240 * ε) *
            max (x ^ ((δ + 10 * ε) + E * 11)) (x ^ (E * 12))) := by ring
      _ = (CX * Cₘ * Cκ ^ 2 * max (CH ^ 11) (CH ^ 12) / (cΔ₁ * cΔstar)) *
          (x ^ (1 - 4 * γ) * max (x ^ (44 * ω + 16 * δ + 327 * ε))
            (x ^ (48 * ω + 16 * δ + 324 * ε))) := by rw [hNx4, hPC]; ring

open Classical in
/--
The dispersion correlation over frequency pairs in `E` and integer shifts `n`, weighted by `wN`,
the compatibility indicator, and the two Fourier factors. Terms failing either coprimality
condition vanish; the second Fourier factor and reciprocal phase are conjugated.
-/
noncomputable def sourceDispersionFrequencyBlock
    (E : Finset (ℤ × ℤ)) (ψM wN : ℝ → ℝ) (M : ℝ)
    (r q₀ u v₁ v₂ q₂ a b₁ b₂ : ℕ) (ℓ : ℤ) : ℂ :=
  ∑ h ∈ E, ∑' n : ℤ,
    if Int.gcd n ((r * q₀ * u * v₁ * v₂ : ℕ) : ℤ) = 1 ∧
        Int.gcd (n + ℓ * (r : ℤ)) ((q₀ * q₂ : ℕ) : ℤ) = 1 then
      (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
        sourcePhi ψM M (r * q₀ * u * v₁ * q₂) h.1 *
        star (sourcePhi ψM M (r * q₀ * u * v₂ * q₂) h.2) *
        (wN (n : ℝ) : ℂ) *
        (sourceTheta r q₀ u v₁ q₂ a b₁ b₂ ℓ n h.1 *
          star (sourceTheta r q₀ u v₂ q₂ a b₁ b₂ ℓ n h.2))
    else 0

open Classical in
/--
The `ψD`-weighted sum of norms of dispersion blocks with `r = d * r₁`, restricted to squarefree
`d` coprime to `r₁ * q₀ * u * lcm v₁ v₂ * q₂`. The frequency pairs lie in `J × J` and exclude
the proportional diagonal `h₁ * v₂ = h₂ * v₁`.
-/
noncomputable def sourceSigmaTwo
    (J : Finset ℤ) (ψM wN ψD : ℝ → ℝ) (M Δ₁ d₀ : ℝ)
    (r₁ q₀ u v₁ v₂ q₂ a b₁ b₂ : ℕ) (ℓ : ℤ) : ℝ :=
  let m : ℕ := r₁ * q₀ * u * Nat.lcm v₁ v₂ * q₂
  let E := (J ×ˢ J).filter
    (fun h => h.1 * (v₂ : ℤ) ≠ h.2 * (v₁ : ℤ))
  ∑' d : ℕ,
    if Squarefree d ∧ Nat.Coprime d m then
      ψD (((d : ℝ) - d₀) / Δ₁) *
        ‖sourceDispersionFrequencyBlock E ψM wN M
          (d * r₁) q₀ u v₁ v₂ q₂ a b₁ b₂ ℓ‖
    else 0

theorem sourceTheta_norm_le_one
    (r q₀ u v q₂ a b₁ b₂ : ℕ) (ℓ n h : ℤ) :
    ‖sourceTheta r q₀ u v q₂ a b₁ b₂ ℓ n h‖ ≤ 1 := by
  have hphase (q : ℕ) [NeZero q] (c x : ZMod q) :
      ‖reciprocalUnitPhase q c x‖ ≤ 1 := by
    rw [(reciprocalUnitPhase_and_product_norm q
      (fun _ => ∅) (fun _ _ => 0)).1 c x]
    split_ifs <;> norm_num
  unfold sourceTheta
  split_ifs with hp
  · let : NeZero r := ⟨hp.1⟩
    let : NeZero (q₀ * u * v) := ⟨hp.2.1⟩
    let : NeZero q₂ := ⟨hp.2.2⟩
    dsimp only
    rw [norm_mul, norm_mul]
    exact (mul_le_of_le_one_left (norm_nonneg _)
      ((mul_le_of_le_one_left (norm_nonneg _) (hphase _ _ _)).trans
        (hphase _ _ _))).trans (hphase _ _ _)
  · simp

open Classical in
theorem sourceSigmaOne_pairFamily_eq
    (𝒜 : Finset (ℕ × ℕ × ℕ × ℕ)) (J : Finset ℤ)
    (ψM wN : ℝ → ℝ) (M : ℝ) (q₀ a b₁ b₂ : ℕ) (ℓ : ℤ) :
    let Ω := (𝒜 ×ˢ 𝒜).filter (fun p =>
      p.2.1 = p.1.1 ∧ p.2.2.1 = p.1.2.1 ∧
        p.2.2.2.2 = p.1.2.2.2)
    let encode : (ℕ × ℕ × ℕ × ℕ) × (ℕ × ℕ × ℕ × ℕ) →
        ℕ × ℕ × ℕ × ℕ × ℕ := fun p =>
      (p.1.1, p.1.2.1, p.1.2.2.1, p.2.2.2.1, p.1.2.2.2)
    let 𝒯 := Ω.image encode
    Set.InjOn encode (↑Ω : Set ((ℕ × ℕ × ℕ × ℕ) ×
      (ℕ × ℕ × ℕ × ℕ))) ∧
    (∀ r u v₁ v₂ q₂ : ℕ,
      (r, u, v₁, v₂, q₂) ∈ 𝒯 ↔
        (r, u, v₁, q₂) ∈ 𝒜 ∧ (r, u, v₂, q₂) ∈ 𝒜) ∧
    sourceSigmaOne 𝒜 J ψM wN M q₀ a b₁ b₂ ℓ =
      ∑ t ∈ 𝒯,
        ‖sourceDispersionFrequencyBlock (J ×ˢ J) ψM wN M
          t.1 q₀ t.2.1 t.2.2.1 t.2.2.2.1 t.2.2.2.2 a b₁ b₂ ℓ‖ := by
  intro Ω encode 𝒯
  let decode : (ℕ × ℕ × ℕ × ℕ × ℕ) →
      (ℕ × ℕ × ℕ × ℕ) × (ℕ × ℕ × ℕ × ℕ) := fun t =>
    ((t.1, t.2.1, t.2.2.1, t.2.2.2.2),
      (t.1, t.2.1, t.2.2.2.1, t.2.2.2.2))
  have hdecode (p) (hp : p ∈ Ω) : decode (encode p) = p := by
    rcases p with ⟨⟨r, u, v₁, q₂⟩, ⟨r', u', v₂, q₂'⟩⟩
    rcases (Finset.mem_filter.mp hp).2 with ⟨hr, hu, hq⟩
    dsimp only at hr hu hq
    simp only [decode, encode, hr, hu, hq]
  have hinj : Set.InjOn encode (↑Ω : Set ((ℕ × ℕ × ℕ × ℕ) ×
      (ℕ × ℕ × ℕ × ℕ))) := Set.LeftInvOn.injOn hdecode
  refine ⟨hinj, ?_, ?_⟩
  · intro r u v₁ v₂ q₂
    constructor
    · intro ht
      rcases Finset.mem_image.mp ht with ⟨p, hp, he⟩
      have hp' : p = ((r, u, v₁, q₂), (r, u, v₂, q₂)) :=
        (hdecode p hp).symm.trans (congrArg decode he)
      simpa only [hp'] using Finset.mem_product.mp (Finset.mem_filter.mp hp).1
    · intro ht
      refine Finset.mem_image.mpr ⟨((r, u, v₁, q₂), (r, u, v₂, q₂)), ?_, rfl⟩
      exact Finset.mem_filter.mpr ⟨Finset.mem_product.mpr ht, rfl, rfl, rfl⟩
  · rw [Finset.sum_image hinj]
    simp only [Ω, encode, Finset.sum_filter, Finset.sum_product,
      sourceSigmaOne, sourceDispersionFrequencyBlock]

open Classical in
theorem sourceSigmaOne_selectedFactor_fibers
    (𝒜 : Finset (ℕ × ℕ × ℕ × ℕ)) (J : Finset ℤ)
    (ψM wN : ℝ → ℝ) (M : ℝ) (q₀ a b₁ b₂ : ℕ) (ℓ : ℤ)
    (d : ℕ → ℕ)
    (hr : ∀ t ∈ 𝒜, 0 < t.1)
    (hd : ∀ r ∈ 𝒜.image Prod.fst, 0 < d r ∧ d r ∣ r) :
    let Ω := (𝒜 ×ˢ 𝒜).filter (fun p =>
      p.2.1 = p.1.1 ∧ p.2.2.1 = p.1.2.1 ∧
        p.2.2.2.2 = p.1.2.2.2)
    let 𝒯 : Finset (ℕ × ℕ × ℕ × ℕ × ℕ) := Ω.image (fun p =>
      (p.1.1, p.1.2.1, p.1.2.2.1, p.2.2.2.1, p.1.2.2.2))
    let key : (ℕ × ℕ × ℕ × ℕ × ℕ) → ℕ × ℕ × ℕ :=
      fun t => (t.1 / d t.1, t.2.1, t.2.2.2.2)
    let B := 𝒯.image key
    let F : (ℕ × ℕ × ℕ) → Finset (ℕ × ℕ × ℕ) := fun b =>
      (𝒯.filter (fun t => key t = b)).image
        (fun t => (d t.1, t.2.2.1, t.2.2.2.1))
    (∀ b ∈ B, 0 < b.1) ∧
    (∀ b ∈ B, ∀ d₁ v₁ v₂ : ℕ,
      (d₁, v₁, v₂) ∈ F b ↔
        (d₁ * b.1, b.2.1, v₁, b.2.2) ∈ 𝒜 ∧
        (d₁ * b.1, b.2.1, v₂, b.2.2) ∈ 𝒜 ∧
        d (d₁ * b.1) = d₁) ∧
    sourceSigmaOne 𝒜 J ψM wN M q₀ a b₁ b₂ ℓ =
      ∑ b ∈ B, ∑ p ∈ F b,
        ‖sourceDispersionFrequencyBlock (J ×ˢ J) ψM wN M
          (p.1 * b.1) q₀ b.2.1 p.2.1 p.2.2 b.2.2 a b₁ b₂ ℓ‖ := by
  intro Ω 𝒯 key B F
  have hmem : ∀ r u v₁ v₂ q₂ : ℕ,
      (r, u, v₁, v₂, q₂) ∈ 𝒯 ↔
        (r, u, v₁, q₂) ∈ 𝒜 ∧ (r, u, v₂, q₂) ∈ 𝒜 :=
    (sourceSigmaOne_pairFamily_eq 𝒜 J ψM wN M q₀ a b₁ b₂ ℓ).2.1
  have hselector (t : ℕ × ℕ × ℕ × ℕ × ℕ) (ht : t ∈ 𝒯) :
      0 < d t.1 ∧ d t.1 ∣ t.1 := by
    have ht₁ := (hmem t.1 t.2.1 t.2.2.1 t.2.2.2.1 t.2.2.2.2).mp ht
    exact hd t.1 (Finset.mem_image_of_mem Prod.fst ht₁.1)
  have hfactor (t : ℕ × ℕ × ℕ × ℕ × ℕ) (ht : t ∈ 𝒯) :
      0 < t.1 / d t.1 ∧ d t.1 * (t.1 / d t.1) = t.1 := by
    have hsel := hselector t ht
    have ht₁ := (hmem t.1 t.2.1 t.2.2.1 t.2.2.2.1 t.2.2.2.2).mp ht
    exact ⟨Nat.div_pos (Nat.le_of_dvd (hr _ ht₁.1) hsel.2) hsel.1,
      Nat.mul_div_cancel' hsel.2⟩
  let encode : (ℕ × ℕ × ℕ × ℕ × ℕ) → ℕ × ℕ × ℕ := fun t =>
    (d t.1, t.2.2.1, t.2.2.2.1)
  let decode : (ℕ × ℕ × ℕ) → (ℕ × ℕ × ℕ) → ℕ × ℕ × ℕ × ℕ × ℕ :=
    fun b p => (p.1 * b.1, b.2.1, p.2.1, p.2.2, b.2.2)
  have hdecode (b : ℕ × ℕ × ℕ) (t) (ht : t ∈ 𝒯.filter (fun t => key t = b)) :
      decode b (encode t) = t := by
    rcases Finset.mem_filter.mp ht with ⟨ht, hkey⟩
    rw [← hkey]
    change (d t.1 * (t.1 / d t.1), t.2.1, t.2.2.1, t.2.2.2.1,
      t.2.2.2.2) = t
    rw [(hfactor t ht).2]
  refine ⟨?_, ?_, ?_⟩
  · intro b hb
    rcases Finset.mem_image.mp hb with ⟨t, ht, rfl⟩
    exact (hfactor t ht).1
  · intro b _ d₁ v₁ v₂
    constructor
    · intro hp
      rcases Finset.mem_image.mp hp with ⟨t, ht, he⟩
      change encode t = (d₁, v₁, v₂) at he
      have ht' : t = (d₁ * b.1, b.2.1, v₁, v₂, b.2.2) :=
        (hdecode b t ht).symm.trans (congrArg (decode b) he)
      have htA := (hmem t.1 t.2.1 t.2.2.1 t.2.2.2.1 t.2.2.2.2).mp
        (Finset.mem_filter.mp ht).1
      have hselected : d t.1 = d₁ := congrArg Prod.fst he
      simpa only [ht'] using And.intro htA.1 (And.intro htA.2 hselected)
    · rintro ⟨ht₁, ht₂, hselected⟩
      let t : ℕ × ℕ × ℕ × ℕ × ℕ := (d₁ * b.1, b.2.1, v₁, v₂, b.2.2)
      have ht : t ∈ 𝒯 := (hmem _ _ _ _ _).mpr ⟨ht₁, ht₂⟩
      have hd₁ : 0 < d₁ := by
        simpa only [t, hselected] using (hselector t ht).1
      have hkey : key t = b := by
        change (d₁ * b.1 / d (d₁ * b.1), b.2.1, b.2.2) = b
        rw [hselected, Nat.mul_div_cancel_left b.1 hd₁]
      refine Finset.mem_image.mpr ⟨t, Finset.mem_filter.mpr ⟨ht, hkey⟩, ?_⟩
      change (d (d₁ * b.1), v₁, v₂) = (d₁, v₁, v₂)
      rw [hselected]
  · let f : (ℕ × ℕ × ℕ × ℕ × ℕ) → ℝ := fun t =>
      ‖sourceDispersionFrequencyBlock (J ×ˢ J) ψM wN M
        t.1 q₀ t.2.1 t.2.2.1 t.2.2.2.1 t.2.2.2.2 a b₁ b₂ ℓ‖
    calc
      sourceSigmaOne 𝒜 J ψM wN M q₀ a b₁ b₂ ℓ = ∑ t ∈ 𝒯, f t :=
        (sourceSigmaOne_pairFamily_eq 𝒜 J ψM wN M q₀ a b₁ b₂ ℓ).2.2
      _ = ∑ b ∈ B, ∑ t ∈ 𝒯.filter (fun t => key t = b), f t :=
        (Finset.sum_fiberwise_of_maps_to (s := 𝒯) (t := B) (g := key)
          (fun t ht => Finset.mem_image_of_mem key ht) f).symm
      _ = ∑ b ∈ B, ∑ p ∈ F b,
          ‖sourceDispersionFrequencyBlock (J ×ˢ J) ψM wN M
            (p.1 * b.1) q₀ b.2.1 p.2.1 p.2.2 b.2.2 a b₁ b₂ ℓ‖ := by
        apply Finset.sum_congr rfl
        intro b _
        have hinj : Set.InjOn encode (↑(𝒯.filter (fun t => key t = b)) :
            Set (ℕ × ℕ × ℕ × ℕ × ℕ)) := Set.LeftInvOn.injOn (hdecode b)
        rw [Finset.sum_image hinj]
        apply Finset.sum_congr rfl
        intro t ht
        change f t = f (decode b (encode t))
        rw [hdecode b t ht]

open Classical in
theorem sourceDispersion_positive_support_eq_finite
    (E : Finset (ℤ × ℤ)) (J : Finset ℤ)
    (ψM ψN ψD : ℝ → ℝ) (M N Δ₁ d₀ cN TN cD TD : ℝ)
    (hN : 0 < N) (hΔ : 0 < Δ₁) (_ : 0 ≤ d₀)
    (_ : 0 < cN) (_ : cN ≤ TN)
    (_ : 0 < cD) (_ : cD ≤ TD)
    (hsN : Function.support ψN ⊆ Set.Icc cN TN)
    (hsD : Function.support ψD ⊆ Set.Icc cD TD)
    (r r₁ q₀ u v₁ v₂ q₂ a b₁ b₂ : ℕ) (ℓ : ℤ) :
    let wN : ℝ → ℝ := fun t => ψN (t / N)
    let sN : Finset ℤ := Finset.Icc ⌈cN * N⌉ ⌊TN * N⌋
    let sD : Finset ℕ :=
      Finset.Icc ⌈d₀ + cD * Δ₁⌉₊ ⌊d₀ + TD * Δ₁⌋₊
    let m : ℕ := r₁ * q₀ * u * Nat.lcm v₁ v₂ * q₂
    let Eoff := (J ×ˢ J).filter
      (fun h => h.1 * (v₂ : ℤ) ≠ h.2 * (v₁ : ℤ))
    (∀ n : ℤ, n ∉ sN → wN (n : ℝ) = 0) ∧
    (∀ d : ℕ, d ∉ sD → ψD (((d : ℝ) - d₀) / Δ₁) = 0) ∧
    (sourceDispersionFrequencyBlock E ψM wN M
        r q₀ u v₁ v₂ q₂ a b₁ b₂ ℓ =
      ∑ h ∈ E, ∑ n ∈ sN,
        if Int.gcd n ((r * q₀ * u * v₁ * v₂ : ℕ) : ℤ) = 1 ∧
            Int.gcd (n + ℓ * (r : ℤ)) ((q₀ * q₂ : ℕ) : ℤ) = 1 then
          (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
            sourcePhi ψM M (r * q₀ * u * v₁ * q₂) h.1 *
            star (sourcePhi ψM M (r * q₀ * u * v₂ * q₂) h.2) *
            (wN (n : ℝ) : ℂ) *
            (sourceTheta r q₀ u v₁ q₂ a b₁ b₂ ℓ n h.1 *
              star (sourceTheta r q₀ u v₂ q₂ a b₁ b₂ ℓ n h.2))
        else 0) ∧
    sourceSigmaTwo J ψM wN ψD M Δ₁ d₀
        r₁ q₀ u v₁ v₂ q₂ a b₁ b₂ ℓ =
      ∑ d ∈ sD.filter (fun d => Squarefree d ∧ Nat.Coprime d m),
        ψD (((d : ℝ) - d₀) / Δ₁) *
          ‖sourceDispersionFrequencyBlock Eoff ψM wN M
            (d * r₁) q₀ u v₁ v₂ q₂ a b₁ b₂ ℓ‖ := by
  intro wN sN sD m Eoff
  have hnzero : ∀ n : ℤ, n ∉ sN → wN (n : ℝ) = 0 := by
    intro n hn
    by_contra hne
    have hb := hsN (show ψN ((n : ℝ) / N) ≠ 0 from hne)
    apply hn
    exact Finset.mem_Icc.mpr
      ⟨Int.ceil_le.mpr ((le_div_iff₀ hN).mp hb.1),
        Int.le_floor.mpr ((div_le_iff₀ hN).mp hb.2)⟩
  have hdzero : ∀ d : ℕ, d ∉ sD → ψD (((d : ℝ) - d₀) / Δ₁) = 0 := by
    intro d hd
    by_contra hne
    have hb := hsD hne
    have hlo := (le_div_iff₀ hΔ).mp hb.1
    have hhi := (div_le_iff₀ hΔ).mp hb.2
    apply hd
    exact Finset.mem_Icc.mpr
      ⟨Nat.ceil_le.mpr (by linarith), Nat.le_floor (by linarith)⟩
  refine ⟨hnzero, hdzero, ?_, ?_⟩
  · unfold sourceDispersionFrequencyBlock
    apply Finset.sum_congr rfl
    intro h _
    apply tsum_eq_sum
    intro n hn
    simp [hnzero n hn]
  · unfold sourceSigmaTwo
    rw [Finset.sum_filter]
    apply tsum_eq_sum
    intro d hd
    simp [hdzero d hd]

open Classical in
theorem sourceDispersionFrequencyBlock_diagonal_norm_le
    (J : Finset ℤ) (s : Finset ℤ) (H : ℕ)
    (hJ : J ⊆ (Finset.Icc (-(H : ℤ)) (H : ℤ)).filter (fun h => h ≠ 0))
    (ψM wN : ℝ → ℝ) (c T M L : ℝ)
    (hc : 0 < c) (hcT : c ≤ T) (hM : 0 < M) (hL : 0 ≤ L)
    (hsM : Function.support ψM ⊆ Set.Icc c T)
    (hbM : ∀ t : ℝ, |ψM t| ≤ L)
    (hsN : ∀ n : ℤ, n ∉ s → wN (n : ℝ) = 0)
    (r q₀ u v₁ v₂ q₂ a b₁ b₂ : ℕ) (ℓ : ℤ)
    (hv₁ : 0 < v₁) (hv₂ : 0 < v₂) :
    let g := Nat.gcd v₁ v₂
    let Ediag := (J ×ˢ J).filter
      (fun h => h.1 * (v₂ : ℤ) = h.2 * (v₁ : ℤ))
    ‖sourceDispersionFrequencyBlock Ediag ψM wN M
      r q₀ u v₁ v₂ q₂ a b₁ b₂ ℓ‖ ≤
        ((2 * (H / max (v₁ / g) (v₂ / g)) : ℕ) : ℝ) *
          (T * L) ^ 2 * ∑ n ∈ s, |wN (n : ℝ)| := by
  intro g Ediag
  let W := (Finset.Icc (-(H : ℤ)) (H : ℤ)).filter (fun h => h ≠ 0)
  let φ : ℤ × ℤ → ℤ := fun h =>
    h.1 * ((v₂ / g : ℕ) : ℤ) - h.2 * ((v₁ / g : ℕ) : ℤ)
  have hg : (g : ℤ) ≠ 0 := by
    exact_mod_cast (Nat.gcd_pos_of_pos_left v₂ hv₁).ne'
  have hv₁g : ((v₁ / g : ℕ) : ℤ) * (g : ℤ) = (v₁ : ℤ) := by
    exact_mod_cast Nat.div_mul_cancel (Nat.gcd_dvd_left v₁ v₂)
  have hv₂g : ((v₂ / g : ℕ) : ℤ) * (g : ℤ) = (v₂ : ℤ) := by
    exact_mod_cast Nat.div_mul_cancel (Nat.gcd_dvd_right v₁ v₂)
  have hsubset : Ediag ⊆ (W ×ˢ W).filter (fun h => φ h = 0) := by
    intro h hh
    rcases Finset.mem_filter.mp hh with ⟨hhJ, hhdiag⟩
    rcases Finset.mem_product.mp hhJ with ⟨hh₁, hh₂⟩
    refine Finset.mem_filter.mpr ⟨Finset.mem_product.mpr ⟨hJ hh₁, hJ hh₂⟩, ?_⟩
    have hmul : φ h * (g : ℤ) = 0 := by
      calc
        φ h * (g : ℤ) = h.1 * (v₂ : ℤ) - h.2 * (v₁ : ℤ) := by
          dsimp only [φ]
          rw [sub_mul, mul_assoc, mul_assoc, hv₂g, hv₁g]
        _ = 0 := sub_eq_zero.mpr hhdiag
    exact (mul_eq_zero.mp hmul).resolve_right hg
  have hcard : (Ediag.card : ℝ) ≤
      ((2 * (H / max (v₁ / g) (v₂ / g)) : ℕ) : ℝ) := by
    have hc := (Finset.card_le_card hsubset).trans_eq
      (secondary_frequency_symmetric_window_counts H v₁ v₂ hv₁ hv₂).2.1
    exact_mod_cast hc
  have hTL : 0 ≤ T * L := mul_nonneg (hc.le.trans hcT) hL
  have hPhi (v : ℕ) (h : ℤ) :
      ‖sourcePhi ψM M (r * q₀ * u * v * q₂) h‖ ≤ T * L := by
    have hb := sourcePhiRealFactor_sampling_and_norm c T M L hc hcT hM hL
      ψM hsM hbM (r * q₀ * u * v * q₂) h
    have heq := hb.2.1 1
    simp only [Nat.cast_one, Nat.one_mul] at heq
    simpa only [heq] using hb.2.2 (1 : ℝ)
  let f : (ℤ × ℤ) → ℤ → ℂ := fun h n =>
    if Int.gcd n ((r * q₀ * u * v₁ * v₂ : ℕ) : ℤ) = 1 ∧
        Int.gcd (n + ℓ * (r : ℤ)) ((q₀ * q₂ : ℕ) : ℤ) = 1 then
      (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
        sourcePhi ψM M (r * q₀ * u * v₁ * q₂) h.1 *
        star (sourcePhi ψM M (r * q₀ * u * v₂ * q₂) h.2) *
        (wN (n : ℝ) : ℂ) *
        (sourceTheta r q₀ u v₁ q₂ a b₁ b₂ ℓ n h.1 *
          star (sourceTheta r q₀ u v₂ q₂ a b₁ b₂ ℓ n h.2))
    else 0
  have hfinite (h : ℤ × ℤ) : (∑' n : ℤ, f h n) = ∑ n ∈ s, f h n := by
    apply tsum_eq_sum
    intro n hn
    simp [f, hsN n hn]
  have hterm (h : ℤ × ℤ) (n : ℤ) : ‖f h n‖ ≤ (T * L) ^ 2 * |wN (n : ℝ)| := by
    have hC : |sourceCompatibility r q₀ b₁ b₂ ℓ n| ≤ 1 := by
      unfold sourceCompatibility
      split <;> norm_num
    have hCPhi : |sourceCompatibility r q₀ b₁ b₂ ℓ n| *
        ‖sourcePhi ψM M (r * q₀ * u * v₁ * q₂) h.1‖ *
        ‖sourcePhi ψM M (r * q₀ * u * v₂ * q₂) h.2‖ ≤ (T * L) ^ 2 := by
      calc
        _ ≤ 1 * (T * L) * (T * L) :=
          mul_le_mul (mul_le_mul hC (hPhi v₁ h.1) (norm_nonneg _) zero_le_one)
            (hPhi v₂ h.2) (norm_nonneg _) (by simpa using hTL)
        _ = _ := by ring
    have hTheta : ‖sourceTheta r q₀ u v₁ q₂ a b₁ b₂ ℓ n h.1‖ *
        ‖sourceTheta r q₀ u v₂ q₂ a b₁ b₂ ℓ n h.2‖ ≤ 1 :=
      (mul_le_of_le_one_left (norm_nonneg _)
        (sourceTheta_norm_le_one r q₀ u v₁ q₂ a b₁ b₂ ℓ n h.1)).trans
        (sourceTheta_norm_le_one r q₀ u v₂ q₂ a b₁ b₂ ℓ n h.2)
    dsimp [f]
    split
    · simp only [norm_mul, Complex.norm_conj, Complex.norm_real, Real.norm_eq_abs]
      exact (mul_le_mul
        (mul_le_mul_of_nonneg_right hCPhi (abs_nonneg (wN (n : ℝ)))) hTheta
        (mul_nonneg (norm_nonneg _) (norm_nonneg _))
        (mul_nonneg (sq_nonneg _) (abs_nonneg _))).trans_eq (mul_one _)
    · simpa only [norm_zero] using mul_nonneg (sq_nonneg (T * L)) (abs_nonneg _)
  change ‖∑ h ∈ Ediag, ∑' n : ℤ, f h n‖ ≤ _
  simp_rw [hfinite]
  calc
    ‖∑ h ∈ Ediag, ∑ n ∈ s, f h n‖ ≤
        ∑ _h ∈ Ediag, ∑ n ∈ s, (T * L) ^ 2 * |wN (n : ℝ)| :=
      norm_sum_le_of_le Ediag fun h _ => norm_sum_le_of_le s fun n _ => hterm h n
    _ = (Ediag.card : ℝ) * (T * L) ^ 2 * ∑ n ∈ s, |wN (n : ℝ)| := by
      simp only [← Finset.mul_sum, Finset.sum_const, nsmul_eq_mul]
      ring
    _ ≤ _ := mul_le_mul_of_nonneg_right
      (mul_le_mul_of_nonneg_right hcard (sq_nonneg _))
      (Finset.sum_nonneg fun n _ => abs_nonneg (wN (n : ℝ)))

open Classical in
theorem sourceSelectedBlock_le_diagonal_add_sigmaTwo
    {ι : Type*}
    (F : Finset (ℕ × ℕ × ℕ)) (D : Finset ℕ)
    (C : Finset ι) (d₀ : ι → ℝ) (J : Finset ℤ) (s : Finset ℤ)
    (H K : ℕ) (V c T M L Δ₁ cD TD : ℝ)
    (ψM wN ψD : ℝ → ℝ)
    (r₁ q₀ u q₂ a b₁ b₂ : ℕ) (ℓ : ℤ)
    (_ : 0 < r₁) (_ : 0 < q₀) (_ : 0 < u) (_ : 0 < q₂)
    (hV : 0 < V) (hc : 0 < c) (hcT : c ≤ T)
    (hM : 0 < M) (hL : 0 ≤ L)
    (hsM : Function.support ψM ⊆ Set.Icc c T)
    (hbM : ∀ t : ℝ, |ψM t| ≤ L)
    (hsN : ∀ n : ℤ, n ∉ s → wN (n : ℝ) = 0)
    (hJ : J ⊆ (Finset.Icc (-(H : ℤ)) (H : ℤ)).filter (fun h => h ≠ 0))
    (hΔ : 0 < Δ₁) (hcD : 0 < cD) (hcDT : cD ≤ TD)
    (hsD : Function.support ψD ⊆ Set.Icc cD TD)
    (hDnonneg : ∀ t : ℝ, 0 ≤ ψD t)
    (hDmajor : ∀ t ∈ Set.Icc (1 : ℝ) 2, 1 ≤ ψD t)
    (hd₀ : ∀ i ∈ C, 0 ≤ d₀ i)
    (hcover : ∀ d ∈ D, ∃ i ∈ C,
      Δ₁ ≤ (d : ℝ) - d₀ i ∧ (d : ℝ) - d₀ i ≤ 2 * Δ₁)
    (hF : ∀ p ∈ F,
      p.1 ∈ D ∧ p.2.1 ∈ Finset.Icc 1 K ∧ p.2.2 ∈ Finset.Icc 1 K ∧
      V ≤ ((max p.2.1 p.2.2 : ℕ) : ℝ) ∧
      Squarefree ((p.1 * r₁) * q₀ * u * p.2.1 * q₂) ∧
      Squarefree ((p.1 * r₁) * q₀ * u * p.2.2 * q₂) ∧
      Nat.Coprime ((p.1 * r₁) * q₀ * u * p.2.1 * p.2.2 * q₂)
        (a * b₁ * b₂)) :
    let 𝒱 : Finset (ℕ × ℕ) := F.image Prod.snd
    (∀ v ∈ 𝒱,
      Squarefree (r₁ * q₀ * u * Nat.lcm v.1 v.2 * q₂) ∧
      Nat.Coprime (r₁ * q₀ * u * Nat.lcm v.1 v.2 * q₂) (a * b₁ * b₂)) ∧
    (∑ p ∈ F,
      ‖sourceDispersionFrequencyBlock (J ×ˢ J) ψM wN M
        (p.1 * r₁) q₀ u p.2.1 p.2.2 q₂ a b₁ b₂ ℓ‖) ≤
      (D.card : ℝ) * (T * L) ^ 2 * (∑ n ∈ s, |wN (n : ℝ)|) *
        (2 * (H : ℝ) / V) * (K : ℝ) ^ 2 * (1 + Real.log (K : ℝ)) +
      ∑ v ∈ 𝒱, ∑ i ∈ C,
        sourceSigmaTwo J ψM wN ψD M Δ₁ (d₀ i)
          r₁ q₀ u v.1 v.2 q₂ a b₁ b₂ ℓ := by
  let 𝒱 : Finset (ℕ × ℕ) := F.image Prod.snd
  let A : ℕ := r₁ * q₀ * u * q₂
  let m : ℕ × ℕ → ℕ := fun v => r₁ * q₀ * u * Nat.lcm v.1 v.2 * q₂
  let Ediag : ℕ × ℕ → Finset (ℤ × ℤ) := fun v =>
    (J ×ˢ J).filter (fun h => h.1 * (v.2 : ℤ) = h.2 * (v.1 : ℤ))
  let Eoff : ℕ × ℕ → Finset (ℤ × ℤ) := fun v =>
    (J ×ˢ J).filter (fun h => h.1 * (v.2 : ℤ) ≠ h.2 * (v.1 : ℤ))
  let Bdiag : ℕ × ℕ × ℕ → ℝ := fun p =>
    ‖sourceDispersionFrequencyBlock (Ediag p.2) ψM wN M
      (p.1 * r₁) q₀ u p.2.1 p.2.2 q₂ a b₁ b₂ ℓ‖
  let Boff : ℕ × ℕ × ℕ → ℝ := fun p =>
    ‖sourceDispersionFrequencyBlock (Eoff p.2) ψM wN M
      (p.1 * r₁) q₀ u p.2.1 p.2.2 q₂ a b₁ b₂ ℓ‖
  let W : ℝ := ∑ n ∈ s, |wN (n : ℝ)|
  let R : ℝ := (T * L) ^ 2 * W * (2 * (H : ℝ) / V)
  have hW : 0 ≤ W := Finset.sum_nonneg fun _ _ => abs_nonneg _
  have hR : 0 ≤ R := by dsimp [R]; positivity
  have harith (p : ℕ × ℕ × ℕ) (hp : p ∈ F) :
      Squarefree p.1 ∧ Nat.Coprime p.1 (m p.2) ∧ Squarefree (m p.2) ∧
        Nat.Coprime (m p.2) (a * b₁ * b₂) := by
    obtain ⟨_, _, _, _, hx, hy, hprim⟩ := hF p hp
    have hx' : Squarefree ((p.1 * A) * p.2.1) := by
      simpa only [A, mul_assoc, mul_left_comm, mul_comm] using hx
    have hy' : Squarefree ((p.1 * A) * p.2.2) := by
      simpa only [A, mul_assoc, mul_left_comm, mul_comm] using hy
    have hl : Squarefree (Nat.lcm ((p.1 * A) * p.2.1) ((p.1 * A) * p.2.2)) := by
      apply Nat.squarefree_of_factorization_le_one (Nat.lcm_ne_zero hx'.ne_zero hy'.ne_zero)
      intro t
      rw [Nat.factorization_lcm hx'.ne_zero hy'.ne_zero]
      exact max_le (hx'.natFactorization_le_one t) (hy'.natFactorization_le_one t)
    have heq : Nat.lcm ((p.1 * A) * p.2.1) ((p.1 * A) * p.2.2) = p.1 * m p.2 := by
      rw [Nat.lcm_mul_left]
      dsimp [m, A]
      ring
    have hdm : Squarefree (p.1 * m p.2) := by simpa only [heq] using hl
    obtain ⟨hdm, hd, hm⟩ := Nat.squarefree_mul_iff.mp hdm
    have hmdiv : m p.2 ∣ (p.1 * r₁) * q₀ * u * p.2.1 * p.2.2 * q₂ := by
      simpa only [m, A, mul_assoc, mul_left_comm, mul_comm] using
        dvd_mul_of_dvd_left (Nat.mul_dvd_mul_left A (Nat.lcm_dvd_mul p.2.1 p.2.2)) p.1
    exact ⟨hd, hdm, hm, hprim.coprime_dvd_left hmdiv⟩
  dsimp only
  refine ⟨?_, ?_⟩
  · intro v hv
    obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hv
    exact (harith p hp).2.2
  have hpoint (p : ℕ × ℕ × ℕ) (hp : p ∈ F) :
      Bdiag p ≤ R * (Nat.gcd p.2.1 p.2.2 : ℝ) := by
    obtain ⟨_, hp₁, hp₂, hmax, _, _, _⟩ := hF p hp
    have hv₁ : 0 < p.2.1 := (Finset.mem_Icc.mp hp₁).1
    have hv₂ : 0 < p.2.2 := (Finset.mem_Icc.mp hp₂).1
    let g := Nat.gcd p.2.1 p.2.2
    let k := max (p.2.1 / g) (p.2.2 / g)
    have hk : 0 < k :=
      lt_of_lt_of_le (Nat.div_gcd_pos_of_pos_left p.2.2 hv₁) (le_max_left _ _)
    have hkR : (0 : ℝ) < k := Nat.cast_pos.mpr hk
    have hkg : k * g = max p.2.1 p.2.2 := by
      dsimp [k, g]
      rw [← Nat.mul_max_mul_right, Nat.div_mul_cancel (Nat.gcd_dvd_left _ _),
        Nat.div_mul_cancel (Nat.gcd_dvd_right _ _)]
    have hkgR : (k : ℝ) * (g : ℝ) = ((max p.2.1 p.2.2 : ℕ) : ℝ) := by
      exact_mod_cast hkg
    have hfrac : 2 * (H : ℝ) / (k : ℝ) ≤ 2 * (g : ℝ) * (H : ℝ) / V := by
      apply (div_le_div_iff₀ hkR hV).mpr
      have hmul := mul_le_mul_of_nonneg_left (hmax.trans_eq hkgR.symm)
        (by positivity : 0 ≤ 2 * (H : ℝ))
      convert hmul using 1
      ring
    have hcount : ((2 * (H / k) : ℕ) : ℝ) ≤
        (2 * (H : ℝ) / V) * (g : ℝ) := by
      calc
        ((2 * (H / k) : ℕ) : ℝ) = 2 * ((H / k : ℕ) : ℝ) := by norm_cast
        _ ≤ 2 * ((H : ℝ) / (k : ℝ)) :=
          mul_le_mul_of_nonneg_left Nat.cast_div_le (by norm_num)
        _ = 2 * (H : ℝ) / (k : ℝ) := by ring
        _ ≤ 2 * (g : ℝ) * (H : ℝ) / V := hfrac
        _ = (2 * (H : ℝ) / V) * (g : ℝ) := by ring
    calc
      Bdiag p ≤ ((2 * (H / k) : ℕ) : ℝ) * (T * L) ^ 2 * W :=
        sourceDispersionFrequencyBlock_diagonal_norm_le J s H hJ ψM wN c T M L
          hc hcT hM hL hsM hbM hsN (p.1 * r₁) q₀ u p.2.1 p.2.2 q₂ a b₁ b₂ ℓ hv₁ hv₂
      _ ≤ ((2 * (H : ℝ) / V) * (g : ℝ)) * (T * L) ^ 2 * W :=
        mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_right hcount (sq_nonneg _)) hW
      _ = R * (Nat.gcd p.2.1 p.2.2 : ℝ) := by dsimp [R, g]; ring
  have hgcd : (∑ v₁ ∈ Finset.Icc 1 K, ∑ v₂ ∈ Finset.Icc 1 K,
      (Nat.gcd v₁ v₂ : ℝ)) ≤ (K : ℝ) ^ 2 * (1 + Real.log (K : ℝ)) := by
    calc
      _ ≤ ∑ v₁ ∈ Finset.Icc 1 K, (K : ℝ) * (v₁.divisors.card : ℝ) := by
        apply Finset.sum_le_sum
        intro v hv
        exact (reciprocal_differencing_gcd_sums v K
          (Finset.mem_Icc.mp hv).1).1
      _ = (K : ℝ) * ∑ v₁ ∈ Finset.Icc 1 K, (v₁.divisors.card : ℝ) :=
        (Finset.mul_sum _ _ _).symm
      _ ≤ (K : ℝ) * ((K : ℝ) * (1 + Real.log (K : ℝ))) := by
        apply mul_le_mul_of_nonneg_left _ (Nat.cast_nonneg K)
        simpa using sum_card_divisors_pow_le_mul_log_pow 1 K
      _ = _ := by ring
  have hsubset : F ⊆ D ×ˢ (Finset.Icc 1 K ×ˢ Finset.Icc 1 K) := by
    intro p hp
    exact Finset.mem_product.mpr ⟨(hF p hp).1,
      Finset.mem_product.mpr ⟨(hF p hp).2.1, (hF p hp).2.2.1⟩⟩
  have hsumg : (∑ p ∈ F, (Nat.gcd p.2.1 p.2.2 : ℝ)) ≤
      (D.card : ℝ) * ((K : ℝ) ^ 2 * (1 + Real.log (K : ℝ))) := by
    calc
      _ ≤ ∑ p ∈ D ×ˢ (Finset.Icc 1 K ×ˢ Finset.Icc 1 K),
          (Nat.gcd p.2.1 p.2.2 : ℝ) :=
        Finset.sum_le_sum_of_subset_of_nonneg hsubset (fun _ _ _ => Nat.cast_nonneg _)
      _ = (D.card : ℝ) *
          (∑ v₁ ∈ Finset.Icc 1 K, ∑ v₂ ∈ Finset.Icc 1 K, (Nat.gcd v₁ v₂ : ℝ)) := by
        simp only [Finset.sum_product, Finset.sum_const, nsmul_eq_mul]
      _ ≤ _ := mul_le_mul_of_nonneg_left hgcd (Nat.cast_nonneg _)
  have hdiag : (∑ p ∈ F, Bdiag p) ≤
      (D.card : ℝ) * (T * L) ^ 2 * W * (2 * (H : ℝ) / V) *
        (K : ℝ) ^ 2 * (1 + Real.log (K : ℝ)) := by
    calc
      _ ≤ ∑ p ∈ F, R * (Nat.gcd p.2.1 p.2.2 : ℝ) := Finset.sum_le_sum hpoint
      _ = R * ∑ p ∈ F, (Nat.gcd p.2.1 p.2.2 : ℝ) := (Finset.mul_sum _ _ _).symm
      _ ≤ R * ((D.card : ℝ) * ((K : ℝ) ^ 2 * (1 + Real.log (K : ℝ)))) :=
        mul_le_mul_of_nonneg_left hsumg hR
      _ = _ := by dsimp [R]; ring
  let f : (ℕ × ℕ) → ι → ℕ → ℝ := fun v i d =>
    if Squarefree d ∧ Nat.Coprime d (m v) then
      ψD (((d : ℝ) - d₀ i) / Δ₁) * Boff (d, v)
    else 0
  have hf (v : ℕ × ℕ) (i : ι) (d : ℕ) : 0 ≤ f v i d := by
    dsimp only [f]
    split_ifs
    · exact mul_nonneg (hDnonneg _) (norm_nonneg _)
    · exact le_rfl
  have hlocal (v : ℕ × ℕ) (i : ι) (hi : i ∈ C) :
      (∑ d ∈ D, f v i d) ≤
        sourceSigmaTwo J ψM wN ψD M Δ₁ (d₀ i) r₁ q₀ u v.1 v.2 q₂ a b₁ b₂ ℓ := by
    let sD : Finset ℕ :=
      Finset.Icc ⌈d₀ i + cD * Δ₁⌉₊ ⌊d₀ i + TD * Δ₁⌋₊
    have hupper₀ : 0 ≤ d₀ i + TD * Δ₁ :=
      add_nonneg (hd₀ i hi) (mul_nonneg (hcD.le.trans hcDT) hΔ.le)
    have hvanish (d : ℕ) (hd : d ∉ sD) : f v i d = 0 := by
      have hw : ψD (((d : ℝ) - d₀ i) / Δ₁) = 0 := by
        by_contra hw
        have hs := hsD (show ((d : ℝ) - d₀ i) / Δ₁ ∈ Function.support ψD from hw)
        have hlo := (le_div_iff₀ hΔ).mp hs.1
        have hhi := (div_le_iff₀ hΔ).mp hs.2
        apply hd
        exact Finset.mem_Icc.mpr ⟨Nat.ceil_le.mpr (by linarith),
          (Nat.le_floor_iff hupper₀).mpr (by linarith)⟩
      simp [f, hw]
    change (∑ d ∈ D, f v i d) ≤ ∑' d : ℕ, f v i d
    exact (summable_of_ne_finset_zero hvanish).sum_le_tsum D (fun d _ => hf v i d)
  have hcoverpoint (p : ℕ × ℕ × ℕ) (hp : p ∈ F) :
      Boff p ≤ ∑ i ∈ C, f p.2 i p.1 := by
    obtain ⟨i, hi, hlo, hhi⟩ := hcover p.1 (hF p hp).1
    have hweight : 1 ≤ ψD (((p.1 : ℝ) - d₀ i) / Δ₁) := by
      apply hDmajor
      exact ⟨(one_le_div hΔ).mpr hlo, (div_le_iff₀ hΔ).mpr hhi⟩
    have hpmod : Squarefree p.1 ∧ Nat.Coprime p.1 (m p.2) :=
      ⟨(harith p hp).1, (harith p hp).2.1⟩
    calc
      Boff p ≤ ψD (((p.1 : ℝ) - d₀ i) / Δ₁) * Boff p :=
        le_mul_of_one_le_left (norm_nonneg _) hweight
      _ = f p.2 i p.1 := by simp only [f, ite_eq_left hpmod]
      _ ≤ ∑ i ∈ C, f p.2 i p.1 := Finset.single_le_sum (fun j _ => hf p.2 j p.1) hi
  have hsubsetV : F ⊆ D ×ˢ 𝒱 := by
    intro p hp
    exact Finset.mem_product.mpr ⟨(hF p hp).1, Finset.mem_image_of_mem Prod.snd hp⟩
  have hoff : (∑ p ∈ F, Boff p) ≤
      ∑ v ∈ 𝒱, ∑ i ∈ C,
        sourceSigmaTwo J ψM wN ψD M Δ₁ (d₀ i)
          r₁ q₀ u v.1 v.2 q₂ a b₁ b₂ ℓ := by
    calc
      _ ≤ ∑ p ∈ F, ∑ i ∈ C, f p.2 i p.1 := Finset.sum_le_sum hcoverpoint
      _ ≤ ∑ p ∈ D ×ˢ 𝒱, ∑ i ∈ C, f p.2 i p.1 :=
        Finset.sum_le_sum_of_subset_of_nonneg hsubsetV
          (fun p _ _ => Finset.sum_nonneg fun i _ => hf p.2 i p.1)
      _ = ∑ v ∈ 𝒱, ∑ i ∈ C, ∑ d ∈ D, f v i d := by
        rw [Finset.sum_product_right]
        exact Finset.sum_congr rfl fun _ _ => Finset.sum_comm
      _ ≤ _ := Finset.sum_le_sum fun v _ => Finset.sum_le_sum fun i hi => hlocal v i hi
  have hsplit (p : ℕ × ℕ × ℕ) :
      ‖sourceDispersionFrequencyBlock (J ×ˢ J) ψM wN M
        (p.1 * r₁) q₀ u p.2.1 p.2.2 q₂ a b₁ b₂ ℓ‖ ≤ Bdiag p + Boff p := by
    dsimp only [Bdiag, Boff, Ediag, Eoff, sourceDispersionFrequencyBlock]
    rw [← Finset.sum_filter_add_sum_filter_not (J ×ˢ J)
      (fun h : ℤ × ℤ => h.1 * (p.2.2 : ℤ) = h.2 * (p.2.1 : ℤ))]
    exact norm_add_le _ _
  calc
    _ ≤ ∑ p ∈ F, (Bdiag p + Boff p) := Finset.sum_le_sum fun p _ => hsplit p
    _ = (∑ p ∈ F, Bdiag p) + ∑ p ∈ F, Boff p := Finset.sum_add_distrib
    _ ≤ _ := add_le_add hdiag hoff

theorem sourceDispersion_commonResidues
    (P : ℕ) [NeZero P] (a b₁ b₂ : ℤ) :
    let aN : ℕ := (a : ZMod P).val
    let b₁N : ℕ := (b₁ : ZMod P).val
    let b₂N : ℕ := (b₂ : ZMod P).val
    ∀ q : ℕ, q ∣ P →
      (aN : ZMod q) = (a : ZMod q) ∧
      (b₁N : ZMod q) = (b₁ : ZMod q) ∧
      (b₂N : ZMod q) = (b₂ : ZMod q) ∧
      (Nat.Coprime (aN * b₁N * b₂N) q ↔
        Int.gcd (a * b₁ * b₂) (q : ℤ) = 1) := by
  dsimp only
  intro q hq
  have hcast (z : ℤ) : ((z : ZMod P).val : ZMod q) = (z : ZMod q) := by
    have hz := congrArg (ZMod.castHom hq (ZMod q))
      (ZMod.natCast_zmod_val (z : ZMod P))
    simpa only [map_natCast, map_intCast] using hz
  refine ⟨hcast a, hcast b₁, hcast b₂, ?_⟩
  rw [← ZMod.isUnit_iff_coprime, Nat.cast_mul, Nat.cast_mul,
    hcast a, hcast b₁, hcast b₂, ← Int.cast_mul, ← Int.cast_mul,
    ZMod.coe_int_isUnit_iff_isCoprime, isCoprime_comm,
    Int.isCoprime_iff_gcd_eq_one]

theorem int_finset_card_le_of_mem_real_Icc : ∀ (S : Finset ℤ) (u v : ℝ), u ≤ v →
    (∀ n ∈ S, u ≤ (n : ℝ) ∧ (n : ℝ) ≤ v) →
    (S.card : ℝ) ≤ 1 + v - u := by
  classical
  intro S u v huv hS
  have hsub : S ⊆ Finset.Icc ⌈u⌉ ⌊v⌋ := by
    intro n hn
    exact Finset.mem_Icc.mpr
      ⟨Int.ceil_le.mpr (hS n hn).1, Int.le_floor.mpr (hS n hn).2⟩
  have huv' : ⌈u⌉ ≤ ⌊v⌋ + 1 :=
    (Int.ceil_le_floor_add_one u).trans (add_le_add (Int.floor_mono huv) (le_refl (1 : ℤ)))
  have hc : (S.card : ℤ) ≤ ((Finset.Icc ⌈u⌉ ⌊v⌋).card : ℤ) := by
    exact_mod_cast Finset.card_le_card hsub
  rw [Int.card_Icc_of_le ⌈u⌉ ⌊v⌋ huv'] at hc
  have hc' : (S.card : ℝ) ≤ (⌊v⌋ : ℝ) + 1 - (⌈u⌉ : ℝ) := by
    exact_mod_cast hc
  linarith only [hc', Int.floor_le v, Int.le_ceil u]

theorem int_linear_image_dvd_card_le : ∀ (C H : ℝ), 1 ≤ C → 1 ≤ H →
    ∀ (a b s : ℕ), a.Coprime b → 0 < s →
    ∀ (J : Finset ℤ), (∀ h ∈ J, |(h : ℝ)| ≤ C * H) →
    (((((J ×ˢ J).image (fun p : ℤ × ℤ => (a : ℤ) * p.1 - (b : ℤ) * p.2)).filter
      (fun y : ℤ => (s : ℤ) ∣ y)).card) : ℝ) ≤
      (4 * C ^ 2 + 4 * C + 1) * (H ^ 2 / (s : ℝ) + H) := by
  classical
  have hap : ∀ (S : Finset ℤ) (u v : ℝ) (k a : ℤ), 0 < k → u ≤ v →
      (∀ n ∈ S, u ≤ (n : ℝ) ∧ (n : ℝ) ≤ v) →
      (∀ n ∈ S, Int.ModEq k n a) →
      (S.card : ℝ) ≤ 1 + (v - u) / (k : ℝ) := by
    intro S u v k a hk huv hS hmod
    have hkR : 0 < (k : ℝ) := by exact_mod_cast hk
    have hd : ∀ n ∈ S, k ∣ n - a := fun n hn => (hmod n hn).symm.dvd
    have hinj : Set.InjOn (fun n : ℤ => (n - a) / k) (S : Set ℤ) := by
      intro n hn m hm hnm
      exact (Int.sub_left_inj a).mp
        ((Int.ediv_left_inj (hd n hn) (hd m hm)).mp hnm)
    have hQ := int_finset_card_le_of_mem_real_Icc (S.image (fun n : ℤ => (n - a) / k))
      ((u - (a : ℝ)) / (k : ℝ)) ((v - (a : ℝ)) / (k : ℝ))
      (div_le_div_of_nonneg_right (sub_le_sub_right huv _) hkR.le) (by
        intro q hq
        obtain ⟨n, hn, rfl⟩ := Finset.mem_image.mp hq
        rw [Int.cast_div (hd n hn) hkR.ne', Int.cast_sub]
        exact ⟨div_le_div_of_nonneg_right (sub_le_sub_right (hS n hn).1 _) hkR.le,
          div_le_div_of_nonneg_right (sub_le_sub_right (hS n hn).2 _) hkR.le⟩)
    calc
      (S.card : ℝ) = ((S.image (fun n : ℤ => (n - a) / k)).card : ℝ) := by
        rw [Finset.card_image_of_injOn hinj]
      _ ≤ 1 + (v - (a : ℝ)) / (k : ℝ) -
          (u - (a : ℝ)) / (k : ℝ) := hQ
      _ = 1 + (v - u) / (k : ℝ) := by ring
  intro C H hC hH a b s hab hs J hJ
  have hC0 : 0 ≤ C := le_trans (by norm_num) hC
  have hH0 : 0 ≤ H := le_trans (by norm_num) hH
  have hsI : 0 < (s : ℤ) := by exact_mod_cast hs
  have hsR : 0 < (s : ℝ) := by exact_mod_cast hs
  let e : ℕ := Nat.gcd s b
  let k : ℤ := (s : ℤ) / (e : ℤ)
  have he : 0 < e := Nat.gcd_pos_of_pos_left b hs
  have heI : 0 < (e : ℤ) := by exact_mod_cast he
  have hes : (e : ℤ) ∣ (s : ℤ) := by
    exact_mod_cast Nat.gcd_dvd_left s b
  have heb : (e : ℤ) ∣ (b : ℤ) := by
    exact_mod_cast Nat.gcd_dvd_right s b
  have hk : 0 < k := Int.ediv_pos_of_pos_of_dvd hsI heI.le hes
  have hkR : 0 < (k : ℝ) := by exact_mod_cast hk
  have he1 : 1 ≤ (e : ℝ) := by exact_mod_cast (show 1 ≤ e by omega)
  have hk1 : 1 ≤ (k : ℝ) := by exact_mod_cast (show 1 ≤ k by omega)
  have hke : (k : ℝ) * (e : ℝ) = (s : ℝ) := by
    have hki : k * (e : ℤ) = (s : ℤ) := Int.ediv_mul_cancel hes
    simpa only [Int.cast_mul, Int.cast_natCast] using
      congrArg (fun z : ℤ => (z : ℝ)) hki
  have hcop : Int.gcd (e : ℤ) (a : ℤ) = 1 := by
    rw [Int.gcd_natCast_natCast]
    exact hab.symm.of_dvd_left (Nat.gcd_dvd_right s b)
  have hfirst_dvd : ∀ h₁ h₂ : ℤ,
      (s : ℤ) ∣ (a : ℤ) * h₁ - (b : ℤ) * h₂ → (e : ℤ) ∣ h₁ := by
    intro h₁ h₂ hd
    have hsum := dvd_add (hes.trans hd) (dvd_mul_of_dvd_left heb h₂)
    have hea : (e : ℤ) ∣ (a : ℤ) * h₁ := by
      simpa only [sub_add_cancel] using hsum
    exact Int.dvd_of_dvd_mul_right_of_gcd_one hea hcop
  let R : Finset ℤ := J.filter (fun h : ℤ => (e : ℤ) ∣ h)
  let rows : ℤ → Finset ℤ := fun h₁ =>
    J.filter (fun h₂ : ℤ => (s : ℤ) ∣ (a : ℤ) * h₁ - (b : ℤ) * h₂)
  have hfirst : (R.card : ℝ) ≤ 1 + 2 * C * H / (e : ℝ) := by
    have hc := hap R (-(C * H)) (C * H) (e : ℤ) 0 heI
      (neg_le_self (mul_nonneg hC0 hH0)) (by
        intro h hh
        exact abs_le.mp (hJ h (Finset.mem_filter.mp hh).1)) (by
        intro h hh
        exact Int.modEq_zero_iff_dvd.mpr (Finset.mem_filter.mp hh).2)
    calc
      (R.card : ℝ) ≤ 1 + (C * H - -(C * H)) / ((e : ℤ) : ℝ) := hc
      _ = 1 + 2 * C * H / (e : ℝ) := by push_cast; ring
  have hrow : ∀ h₁ : ℤ, ((rows h₁).card : ℝ) ≤ 1 + 2 * C * H / (k : ℝ) := by
    intro h₁
    rcases (rows h₁).eq_empty_or_nonempty with hempty | ⟨h₀, hh₀⟩
    · rw [hempty, Finset.card_empty, Nat.cast_zero]
      positivity
    have hmod : ∀ h₂ ∈ rows h₁, Int.ModEq k h₂ h₀ := by
      intro h₂ hh₂
      have hm₂ : Int.ModEq (s : ℤ) ((b : ℤ) * h₂) ((a : ℤ) * h₁) :=
        Int.modEq_iff_dvd.mpr (Finset.mem_filter.mp hh₂).2
      have hm₀ : Int.ModEq (s : ℤ) ((b : ℤ) * h₀) ((a : ℤ) * h₁) :=
        Int.modEq_iff_dvd.mpr (Finset.mem_filter.mp hh₀).2
      have hc := Int.ModEq.cancel_left_div_gcd hsI (hm₂.trans hm₀.symm)
      simpa only [Int.gcd_natCast_natCast] using hc
    have hc := hap (rows h₁) (-(C * H)) (C * H) k h₀ hk
      (neg_le_self (mul_nonneg hC0 hH0)) (by
        intro h hh
        exact abs_le.mp (hJ h (Finset.mem_filter.mp hh).1)) hmod
    calc
      ((rows h₁).card : ℝ) ≤ 1 + (C * H - -(C * H)) / (k : ℝ) := hc
      _ = 1 + 2 * C * H / (k : ℝ) := by ring
  let L : Finset ℤ :=
    ((J ×ˢ J).image (fun p : ℤ × ℤ => (a : ℤ) * p.1 - (b : ℤ) * p.2)).filter
      (fun y : ℤ => (s : ℤ) ∣ y)
  have hcover : L ⊆ R.biUnion (fun h₁ =>
      (rows h₁).image (fun h₂ => (a : ℤ) * h₁ - (b : ℤ) * h₂)) := by
    intro y hy
    obtain ⟨hy, hd⟩ := Finset.mem_filter.mp hy
    obtain ⟨⟨h₁, h₂⟩, hp, rfl⟩ := Finset.mem_image.mp hy
    obtain ⟨hh₁, hh₂⟩ := Finset.mem_product.mp hp
    apply Finset.mem_biUnion.mpr
    refine ⟨h₁, Finset.mem_filter.mpr ⟨hh₁, hfirst_dvd h₁ h₂ hd⟩, ?_⟩
    exact Finset.mem_image.mpr ⟨h₂, Finset.mem_filter.mpr ⟨hh₂, hd⟩, rfl⟩
  have hcount : L.card ≤ ∑ h₁ ∈ R, (rows h₁).card :=
    (Finset.card_le_card hcover).trans (Finset.card_biUnion_le.trans
      (Finset.sum_le_sum fun h₁ _ => Finset.card_image_le))
  have hcountR : (L.card : ℝ) ≤ ∑ h₁ ∈ R, ((rows h₁).card : ℝ) := by
    exact_mod_cast hcount
  have hpair : (L.card : ℝ) ≤
      (1 + 2 * C * H / (e : ℝ)) * (1 + 2 * C * H / (k : ℝ)) := calc
    (L.card : ℝ) ≤ ∑ h₁ ∈ R, ((rows h₁).card : ℝ) := hcountR
    _ ≤ (R.card : ℝ) * (1 + 2 * C * H / (k : ℝ)) := by
      simpa only [nsmul_eq_mul] using
        Finset.sum_le_card_nsmul R _ _ (fun h₁ _ => hrow h₁)
    _ ≤ (1 + 2 * C * H / (e : ℝ)) * (1 + 2 * C * H / (k : ℝ)) :=
      mul_le_mul_of_nonneg_right hfirst (by positivity)
  have hAe : 2 * C * H / (e : ℝ) ≤ 2 * C * H :=
    div_le_self (by positivity) he1
  have hAk : 2 * C * H / (k : ℝ) ≤ 2 * C * H :=
    div_le_self (by positivity) hk1
  have hproduct : (2 * C * H / (e : ℝ)) * (2 * C * H / (k : ℝ)) =
      4 * C ^ 2 * H ^ 2 / (s : ℝ) := by
    rw [div_mul_div_comm, mul_comm (e : ℝ) (k : ℝ), hke]
    ring
  have hmid : (L.card : ℝ) ≤ 4 * C ^ 2 * H ^ 2 / (s : ℝ) + (4 * C + 1) * H := by
    linear_combination hpair + hAe + hAk + hH + hproduct
  have haux₁ : 0 ≤ (4 * C + 1) * (H ^ 2 / (s : ℝ)) := by positivity
  have haux₂ : 0 ≤ 4 * C ^ 2 * H := by positivity
  change (L.card : ℝ) ≤ _
  linear_combination hmid + haux₁ + haux₂

theorem int_nonzero_dvd_card_le : ∀ (S : Finset ℤ) (U : ℝ), 0 ≤ U →
    ∀ (k : ℤ), 0 < k →
    (∀ n ∈ S, |(n : ℝ)| ≤ U ∧ n ≠ 0 ∧ k ∣ n) →
    (S.card : ℝ) ≤ 2 * U / (k : ℝ) := by
  classical
  intro S U hU k hk hS
  have hkR : 0 < (k : ℝ) := by exact_mod_cast hk
  let Q : Finset ℤ := S.image (fun n : ℤ => n / k)
  have hinj : Set.InjOn (fun n : ℤ => n / k) (S : Set ℤ) := by
    intro n hn m hm hnm
    exact (Int.ediv_left_inj (hS n hn).2.2 (hS m hm).2.2).mp hnm
  have hcard : Q.card = S.card := Finset.card_image_of_injOn hinj
  have hQ : ∀ q ∈ Q, |(q : ℝ)| ≤ U / (k : ℝ) ∧ q ≠ 0 := by
    intro q hq
    obtain ⟨n, hn, rfl⟩ := Finset.mem_image.mp hq
    constructor
    · rw [Int.cast_div (hS n hn).2.2 hkR.ne', abs_div, abs_of_pos hkR]
      exact div_le_div_of_nonneg_right (hS n hn).1 hkR.le
    · exact fun hz =>
        (hS n hn).2.1 (Int.eq_zero_of_ediv_eq_zero (hS n hn).2.2 hz)
  by_cases hV : 1 ≤ U / (k : ℝ)
  · let Qp : Finset ℤ := Q.filter (fun q : ℤ => 0 < q)
    let Qn : Finset ℤ := Q.filter (fun q : ℤ => ¬0 < q)
    have hp : (Qp.card : ℝ) ≤ U / (k : ℝ) := by
      have hc := int_finset_card_le_of_mem_real_Icc Qp 1 (U / (k : ℝ)) hV (by
        intro q hq
        obtain ⟨hq, hpos⟩ := Finset.mem_filter.mp hq
        refine ⟨?_, (abs_le.mp (hQ q hq).1).2⟩
        exact_mod_cast (show (1 : ℤ) ≤ q by omega))
      linarith only [hc]
    have hn : (Qn.card : ℝ) ≤ U / (k : ℝ) := by
      have hc := int_finset_card_le_of_mem_real_Icc Qn
        (-(U / (k : ℝ))) (-1) (by linarith only [hV]) (by
          intro q hq
          obtain ⟨hq, hneg⟩ := Finset.mem_filter.mp hq
          refine ⟨(abs_le.mp (hQ q hq).1).1, ?_⟩
          have hq0 := (hQ q hq).2
          exact_mod_cast (show q ≤ (-1 : ℤ) by omega))
      linarith only [hc]
    have heq : (Qp.card : ℝ) + (Qn.card : ℝ) = (Q.card : ℝ) := by
      exact_mod_cast (Finset.card_filter_add_card_filter_not
        (s := Q) (fun q : ℤ => 0 < q))
    rw [← hcard]
    linear_combination hp + hn - heq
  · have hQempty : Q = ∅ := by
      apply Finset.eq_empty_iff_forall_notMem.mpr
      intro q hq
      have hqabsR : (1 : ℝ) ≤ |(q : ℝ)| := by
        exact_mod_cast Int.one_le_abs (hQ q hq).2
      exact hV (hqabsR.trans (hQ q hq).1)
    rw [← hcard, hQempty, Finset.card_empty, Nat.cast_zero]
    exact div_nonneg (mul_nonneg zero_le_two hU) hkR.le

theorem int_bilinear_quotient_radius (d q : ℕ) (B y y' n n' : ℤ)
    (Δ C₀ TN₀ Yabs N₀ : ℝ) (hq : 0 < q)
    (hΔ : 0 < Δ) (hC₀ : 1 ≤ C₀) (hTN₀ : 0 < TN₀)
    (hYabs : 0 ≤ Yabs) (hN₀ : 0 < N₀)
    (hd : Δ / C₀ ≤ (d : ℝ))
    (hy : |(y : ℝ)| ≤ 2 * Yabs) (hy' : |(y' : ℝ)| ≤ 2 * Yabs)
    (hn : |(n : ℝ)| ≤ TN₀ * N₀) (hn' : |(n' : ℝ)| ≤ TN₀ * N₀)
    (hdiv : (d : ℤ) * (q : ℤ) ∣
      y * (n' + B * (d : ℤ)) - y' * (n + B * (d : ℤ))) :
    let k : ℤ :=
      (y * (n' + B * (d : ℤ)) - y' * (n + B * (d : ℤ))) /
        ((d : ℤ) * (q : ℤ))
    0 < d ∧
      |(k : ℝ) - (B : ℝ) * ((y - y' : ℤ) : ℝ) / (q : ℝ)| ≤
        4 * C₀ * TN₀ * Yabs * N₀ / (Δ * (q : ℝ)) := by
  intro k
  have hCpos : 0 < C₀ := zero_lt_one.trans_le hC₀
  have hdpos : 0 < (d : ℝ) := (div_pos hΔ hCpos).trans_le hd
  have hqpos : 0 < (q : ℝ) := by exact_mod_cast hq
  have hdq : 0 < (d : ℝ) * (q : ℝ) := mul_pos hdpos hqpos
  have hkInt : k * ((d : ℤ) * (q : ℤ)) =
      y * (n' + B * (d : ℤ)) - y' * (n + B * (d : ℤ)) :=
    Int.ediv_mul_cancel hdiv
  have hkReal : (k : ℝ) * ((d : ℝ) * (q : ℝ)) =
      (y : ℝ) * ((n' : ℝ) + (B : ℝ) * (d : ℝ)) -
        (y' : ℝ) * ((n : ℝ) + (B : ℝ) * (d : ℝ)) := by
    exact_mod_cast hkInt
  have hcenter : (k : ℝ) - (B : ℝ) * ((y - y' : ℤ) : ℝ) / (q : ℝ) =
      ((y : ℝ) * (n' : ℝ) - (y' : ℝ) * (n : ℝ)) /
        ((d : ℝ) * (q : ℝ)) := by
    apply (eq_div_iff hdq.ne').mpr
    calc
      _ = (k : ℝ) * ((d : ℝ) * (q : ℝ)) -
          (d : ℝ) * (((B : ℝ) * ((y - y' : ℤ) : ℝ) / (q : ℝ)) * (q : ℝ)) := by
        ring
      _ = (k : ℝ) * ((d : ℝ) * (q : ℝ)) -
          (d : ℝ) * ((B : ℝ) * ((y - y' : ℤ) : ℝ)) := by
        rw [div_mul_cancel₀ _ hqpos.ne']
      _ = _ := by rw [hkReal]; push_cast; ring
  have hnum : |(y : ℝ) * (n' : ℝ) - (y' : ℝ) * (n : ℝ)| ≤
      4 * TN₀ * Yabs * N₀ := by
    calc
      _ ≤ |(y : ℝ) * (n' : ℝ)| + |(y' : ℝ) * (n : ℝ)| := abs_sub _ _
      _ = |(y : ℝ)| * |(n' : ℝ)| + |(y' : ℝ)| * |(n : ℝ)| := by
        rw [abs_mul, abs_mul]
      _ ≤ (2 * Yabs) * (TN₀ * N₀) + (2 * Yabs) * (TN₀ * N₀) :=
        add_le_add
          (mul_le_mul hy hn' (abs_nonneg _) (by positivity))
          (mul_le_mul hy' hn (abs_nonneg _) (by positivity))
      _ = _ := by ring
  have hdscale : Δ ≤ C₀ * (d : ℝ) := by
    simpa only [mul_comm] using (div_le_iff₀ hCpos).mp hd
  refine ⟨by exact_mod_cast hdpos, ?_⟩
  calc
    _ = |(y : ℝ) * (n' : ℝ) - (y' : ℝ) * (n : ℝ)| /
        ((d : ℝ) * (q : ℝ)) := by rw [hcenter, abs_div, abs_of_pos hdq]
    _ ≤ (4 * TN₀ * Yabs * N₀) / ((d : ℝ) * (q : ℝ)) :=
      div_le_div_of_nonneg_right hnum hdq.le
    _ ≤ 4 * C₀ * TN₀ * Yabs * N₀ / (Δ * (q : ℝ)) := by
      apply (div_le_div_iff₀ hdq (mul_pos hΔ hqpos)).mpr
      linear_combination (4 * TN₀ * Yabs * N₀ * (q : ℝ)) * hdscale

theorem int_bilinear_congruence_card_le
    (F : Finset ((ℤ × ℤ) × ℕ × ℤ × ℤ))
    (D : Finset ℕ) (I Z : Finset ℤ) (q : ℕ) (B : ℤ)
    (Δ C₀ TN₀ Yabs N₀ τmax : ℝ) (hq : 0 < q)
    (hΔ : 0 < Δ) (hC₀ : 1 ≤ C₀) (hTN₀ : 0 < TN₀)
    (hYabs : 0 ≤ Yabs) (hN₀ : 0 < N₀) (hτmax : 0 ≤ τmax)
    (hF : ∀ t ∈ F,
      t.2.1 ∈ D ∧ Δ / C₀ ≤ (t.2.1 : ℝ) ∧ t.2.2.2 ∈ I ∧
      t.1.1 - t.1.2 ∈ Z ∧ t.1.2 ≠ 0 ∧ t.2.2.2 - t.2.2.1 ≠ 0 ∧
      |(t.1.1 : ℝ)| ≤ 2 * Yabs ∧ |(t.1.2 : ℝ)| ≤ 2 * Yabs ∧
      |(t.2.2.1 : ℝ)| ≤ TN₀ * N₀ ∧ |(t.2.2.2 : ℝ)| ≤ TN₀ * N₀ ∧
      (t.2.1 : ℤ) * (q : ℤ) ∣
        t.1.1 * (t.2.2.2 + B * (t.2.1 : ℤ)) -
          t.1.2 * (t.2.2.1 + B * (t.2.1 : ℤ)))
    (hτ : ∀ t ∈ F,
      ((t.1.2 * (t.2.2.2 - t.2.2.1)).natAbs.divisors.card : ℝ) ≤ τmax) :
    (F.card : ℝ) ≤ (D.card : ℝ) * (I.card : ℝ) * (Z.card : ℝ) *
      (1 + 8 * C₀ * TN₀ * Yabs * N₀ / (Δ * (q : ℝ))) * (2 * τmax) := by
  classical
  have hsignedFactorPairs (S : Finset (ℤ × ℤ)) (R : ℤ) (hR : R ≠ 0)
      (hS : ∀ p ∈ S, p.1 * p.2 = R) :
      S.card ≤ 2 * R.natAbs.divisors.card := by
    have hcount : S.card ≤ R.divisors.card := by
      apply Finset.card_le_card_of_injOn Prod.fst
      · intro p hp
        exact Int.mem_divisors.mpr ⟨⟨p.2, (hS p hp).symm⟩, hR⟩
      · intro p hp r hr hpr
        apply Prod.ext hpr
        apply mul_left_cancel₀ (left_ne_zero_of_mul ((hS p hp).trans_ne hR))
        simpa only [hpr] using (hS p hp).trans (hS r hr).symm
    simpa only [Int.divisors, Finset.card_disjUnion, Finset.card_map, two_mul] using hcount
  let W : ℝ := 4 * C₀ * TN₀ * Yabs * N₀ / (Δ * (q : ℝ))
  have hW : 0 ≤ W := by dsimp only [W]; positivity
  let κ : ((ℤ × ℤ) × ℕ × ℤ × ℤ) → ℤ := fun t =>
    (t.1.1 * (t.2.2.2 + B * (t.2.1 : ℤ)) -
      t.1.2 * (t.2.2.1 + B * (t.2.1 : ℤ))) / ((t.2.1 : ℤ) * (q : ℤ))
  have hκ : ∀ t ∈ F,
      |(κ t : ℝ) -
        (B : ℝ) * ((t.1.1 - t.1.2 : ℤ) : ℝ) / (q : ℝ)| ≤ W := by
    intro t ht
    obtain ⟨_, hd, _, _, _, _, hy, hy', hn, hn', hdiv⟩ := hF t ht
    exact (int_bilinear_quotient_radius t.2.1 q B t.1.1 t.1.2 t.2.2.1 t.2.2.2
      Δ C₀ TN₀ Yabs N₀ hq hΔ hC₀ hTN₀ hYabs hN₀ hd hy hy' hn hn' hdiv).2
  let key : ((ℤ × ℤ) × ℕ × ℤ × ℤ) → ℕ × ℤ × ℤ := fun t =>
    (t.2.1, t.2.2.2, t.1.1 - t.1.2)
  have hmap : ∀ t ∈ F, key t ∈ D ×ˢ (I ×ˢ Z) := by
    intro t ht
    obtain ⟨hd, _, hn', hz, _⟩ := hF t ht
    exact Finset.mem_product.mpr ⟨hd, Finset.mem_product.mpr ⟨hn', hz⟩⟩
  have houter (a : ℕ × ℤ × ℤ) (_ha : a ∈ D ×ˢ (I ×ˢ Z)) :
      ((F.filter (fun t => key t = a)).card : ℝ) ≤ (1 + 2 * W) * (2 * τmax) := by
    let S := F.filter (fun t => key t = a)
    let center : ℝ := (B : ℝ) * (a.2.2 : ℝ) / (q : ℝ)
    have hkcard : ((S.image κ).card : ℝ) ≤ 1 + 2 * W := by
      have h := int_finset_card_le_of_mem_real_Icc (S.image κ)
        (center - W) (center + W) (by linarith only [hW]) (by
        intro k hk
        obtain ⟨t, ht, hkt⟩ := Finset.mem_image.mp hk
        obtain ⟨htF, hkey⟩ := Finset.mem_filter.mp ht
        have hz : t.1.1 - t.1.2 = a.2.2 :=
          congrArg (fun r : ℕ × ℤ × ℤ => r.2.2) hkey
        have h := hκ t htF
        rw [hkt, hz] at h
        exact Set.mem_Icc_iff_abs_le.mp (by
          simpa only [center, abs_sub_comm] using h))
      linarith
    have hfiber (k : ℤ) (hk : k ∈ S.image κ) :
        ((S.filter (fun t => κ t = k)).card : ℝ) ≤ 2 * τmax := by
      let R : ℤ := k * (a.1 : ℤ) * (q : ℤ) -
        (B * (a.1 : ℤ) + a.2.1) * a.2.2
      have hprod (t : (ℤ × ℤ) × ℕ × ℤ × ℤ)
          (ht : t ∈ S.filter (fun t => κ t = k)) :
          t.1.2 * (t.2.2.2 - t.2.2.1) = R := by
        obtain ⟨htS, hkt⟩ := Finset.mem_filter.mp ht
        obtain ⟨htF, hkey⟩ := Finset.mem_filter.mp htS
        obtain ⟨hd, hrest⟩ := Prod.mk.inj hkey
        obtain ⟨hn', hz⟩ := Prod.mk.inj hrest
        have hkInt : κ t * ((t.2.1 : ℤ) * (q : ℤ)) =
            t.1.1 * (t.2.2.2 + B * (t.2.1 : ℤ)) -
              t.1.2 * (t.2.2.1 + B * (t.2.1 : ℤ)) :=
          by
            obtain ⟨_, _, _, _, _, _, _, _, _, _, hdiv⟩ := hF t htF
            exact Int.ediv_mul_cancel hdiv
        dsimp only [R]
        rw [← hd, ← hn', ← hz, ← hkt]
        linear_combination -hkInt
      obtain ⟨t₀, ht₀S, hkt₀⟩ := Finset.mem_image.mp hk
      have ht₀ : t₀ ∈ S.filter (fun t => κ t = k) :=
        Finset.mem_filter.mpr ⟨ht₀S, hkt₀⟩
      have ht₀F : t₀ ∈ F := (Finset.mem_filter.mp ht₀S).1
      have hR : R ≠ 0 := by
        rw [← hprod t₀ ht₀]
        exact mul_ne_zero (hF t₀ ht₀F).2.2.2.2.1 (hF t₀ ht₀F).2.2.2.2.2.1
      have hτR : (R.natAbs.divisors.card : ℝ) ≤ τmax := by
        rw [← hprod t₀ ht₀]
        exact hτ t₀ ht₀F
      let factor : ((ℤ × ℤ) × ℕ × ℤ × ℤ) → ℤ × ℤ := fun t =>
        (t.1.2, t.2.2.2 - t.2.2.1)
      let Pairs := (S.filter (fun t => κ t = k)).image factor
      have hinj : (S.filter (fun t => κ t = k) : Set ((ℤ × ℤ) × ℕ × ℤ × ℤ)).InjOn factor := by
        intro t ht u hu htu
        have htkey := (Finset.mem_filter.mp (Finset.mem_filter.mp ht).1).2
        have hukey := (Finset.mem_filter.mp (Finset.mem_filter.mp hu).1).2
        have hkey : key t = key u := htkey.trans hukey.symm
        obtain ⟨hd, hrest⟩ := Prod.mk.inj hkey
        obtain ⟨hn', hz⟩ := Prod.mk.inj hrest
        obtain ⟨hy', hn⟩ := Prod.mk.inj htu
        exact Prod.ext (Prod.ext (by omega) hy') (Prod.ext hd (Prod.ext (by omega) hn'))
      have hcount : (S.filter (fun t => κ t = k)).card ≤ 2 * R.natAbs.divisors.card := by
        calc
          _ = Pairs.card := (Finset.card_image_of_injOn hinj).symm
          _ ≤ _ := hsignedFactorPairs Pairs R hR (by
            intro p hp
            obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hp
            exact hprod t ht)
      calc
        ((S.filter (fun t => κ t = k)).card : ℝ) ≤ 2 * (R.natAbs.divisors.card : ℝ) := by
          exact_mod_cast hcount
        _ ≤ 2 * τmax := mul_le_mul_of_nonneg_left hτR zero_le_two
    calc
      (S.card : ℝ) = ∑ k ∈ S.image κ,
          ((S.filter (fun t => κ t = k)).card : ℝ) := by
        exact_mod_cast Finset.card_eq_sum_card_image κ S
      _ ≤ ((S.image κ).card : ℝ) * (2 * τmax) := by
        simpa only [nsmul_eq_mul] using Finset.sum_le_card_nsmul _ _ _ hfiber
      _ ≤ (1 + 2 * W) * (2 * τmax) :=
        mul_le_mul_of_nonneg_right hkcard (mul_nonneg zero_le_two hτmax)
  calc
    (F.card : ℝ) = ∑ a ∈ D ×ˢ (I ×ˢ Z),
        ((F.filter (fun t => key t = a)).card : ℝ) := by
      exact_mod_cast Finset.card_eq_sum_card_fiberwise hmap
    _ ≤ ((D ×ˢ (I ×ˢ Z)).card : ℝ) * ((1 + 2 * W) * (2 * τmax)) := by
      simpa only [nsmul_eq_mul] using Finset.sum_le_card_nsmul _ _ _ houter
    _ = _ := by
      simp only [Finset.card_product, Nat.cast_mul]
      dsimp only [W]
      ring

theorem finiteConvolution_filter_coprime
    (α β : ℕ →₀ ℂ) (h : ℕ) :
    (finiteConvolution α β).filter (fun n : ℕ => Nat.Coprime n h) =
      finiteConvolution
        (α.filter (fun n : ℕ => Nat.Coprime n h))
        (β.filter (fun n : ℕ => Nat.Coprime n h)) := by
  apply Finsupp.ext
  intro k
  simp only [finiteConvolution, Finsupp.filter_apply, MonoidAlgebra.coeff_mul,
    Finsupp.sum, Finsupp.support_filter, Finset.sum_filter,
    Finset.ite_sum_zero]
  apply Finset.sum_congr rfl
  intro m _
  apply Finset.sum_congr rfl
  intro n _
  by_cases hprod : m * n = k
  · subst k
    simp only [Nat.coprime_mul_iff_left]
    simp +contextual [Nat.Coprime, ite_and]
  · simp [hprod]

theorem meanTerm_eq_fullDiscrepancy_filter_coprime
    (f : ℕ →₀ ℂ) (q r a : ℕ) (hqr : Nat.Coprime q r) :
    meanTerm f q r a =
      fullDiscrepancy (f.filter (fun n : ℕ => Nat.Coprime n q)) r a /
        (q.totient : ℂ) := by
  have hprogress :
      progressionMass (f.filter (fun n : ℕ => Nat.Coprime n q)) r a =
        coprimeProgressionMass f q r a := by
    simp +contextual [progressionMass, coprimeProgressionMass, Finsupp.filter_apply,
      Finset.sum_filter, Nat.Coprime, ← ite_and, and_comm]
  have hreduced :
      reducedMass (f.filter (fun n : ℕ => Nat.Coprime n q)) r =
        reducedMass f (q * r) := by
    simp only [reducedMass, Finsupp.support_filter, Finsupp.filter_apply,
      Finset.sum_filter, Nat.coprime_mul_iff_right]
    simp +contextual [Nat.Coprime, ite_and]
  rw [meanTerm, fullDiscrepancy, hprogress, hreduced, Nat.totient_mul hqr,
    Nat.cast_mul, sub_div, div_right_comm, div_div]

theorem sum_signed_dyadic_shells {A : Type*} [AddCommMonoid A]
    (k : ℕ) (f : ℤ → A) :
    (∑ h ∈ (Finset.Ioo (-((2 : ℤ) ^ k)) ((2 : ℤ) ^ k)).erase 0, f h) =
      ∑ j ∈ Finset.range k,
        ((∑ h ∈ Finset.Ico ((2 : ℤ) ^ j) ((2 : ℤ) ^ (j + 1)), f h) +
          ∑ h ∈ Finset.Ioc (-((2 : ℤ) ^ (j + 1))) (-((2 : ℤ) ^ j)), f h) := by
  induction k with
  | zero => norm_num [Int.Ioo_eq_finset_map]
  | succ k ih =>
      have hp : 0 < (2 : ℤ) ^ k := by positivity
      have hnext : (2 : ℤ) ^ k ≤ (2 : ℤ) ^ (k + 1) :=
        pow_le_pow_right₀ (by norm_num) (Nat.le_succ k)
      have he :
          (Finset.Ioo (-((2 : ℤ) ^ (k + 1))) ((2 : ℤ) ^ (k + 1))).erase 0 =
            ((Finset.Ioo (-((2 : ℤ) ^ k)) ((2 : ℤ) ^ k)).erase 0 ∪
              Finset.Ico ((2 : ℤ) ^ k) ((2 : ℤ) ^ (k + 1))) ∪
                Finset.Ioc (-((2 : ℤ) ^ (k + 1))) (-((2 : ℤ) ^ k)) := by
        ext z
        simp only [Finset.mem_erase, Finset.mem_Ioo, Finset.mem_union,
          Finset.mem_Ico, Finset.mem_Ioc]
        omega
      have hd₁ : Disjoint
          ((Finset.Ioo (-((2 : ℤ) ^ k)) ((2 : ℤ) ^ k)).erase 0)
          (Finset.Ico ((2 : ℤ) ^ k) ((2 : ℤ) ^ (k + 1))) :=
        (Finset.Ico_disjoint_Ico_consecutive _ _ _).mono_left
          ((Finset.erase_subset _ _).trans Finset.Ioo_subset_Ico_self)
      have hd₂ : Disjoint
          ((Finset.Ioo (-((2 : ℤ) ^ k)) ((2 : ℤ) ^ k)).erase 0 ∪
            Finset.Ico ((2 : ℤ) ^ k) ((2 : ℤ) ^ (k + 1)))
          (Finset.Ioc (-((2 : ℤ) ^ (k + 1))) (-((2 : ℤ) ^ k))) := by
        rw [Finset.disjoint_left]
        intro z hz hz'
        simp only [Finset.mem_union, Finset.mem_erase, Finset.mem_Ioo,
          Finset.mem_Ico, Finset.mem_Ioc] at hz hz'
        omega
      rw [he, Finset.sum_union hd₂, Finset.sum_union hd₁, ih,
        Finset.sum_range_succ, add_assoc]

theorem padded_dyadic_cutoff_bounds (H : ℝ) (hH : 1 ≤ H) :
    let L : ℕ := ⌊H⌋₊
    let k : ℕ := Nat.log 2 L + 1
    let B : ℕ := 2 ^ k - 1
    1 ≤ k ∧ 1 ≤ B ∧ L ≤ B ∧ H / 2 ≤ (B : ℝ) ∧ (B : ℝ) < 2 * H ∧
      (k : ℝ) ≤ 1 + Real.log H / Real.log 2 ∧
      ∀ j ∈ Finset.range k, (1 : ℝ) ≤ (2 : ℝ) ^ j ∧ (2 : ℝ) ^ j ≤ H := by
  let L : ℕ := ⌊H⌋₊
  let k : ℕ := Nat.log 2 L + 1
  let B : ℕ := 2 ^ k - 1
  have hL : 0 < L := Nat.floor_pos.mpr hH
  have hfloor : (L : ℝ) ≤ H := Nat.floor_le (zero_le_one.trans hH)
  have hhigh : L < 2 ^ k := Nat.lt_pow_succ_log_self (by decide : 1 < 2) L
  have hLB : L ≤ B := Nat.le_sub_one_of_lt hhigh
  refine ⟨by simp, hL.trans_le hLB, hLB, ?_, ?_, ?_, ?_⟩
  · have htop : H < (L : ℝ) + 1 := Nat.lt_floor_add_one H
    have hLreal : (1 : ℝ) ≤ L := Nat.one_le_cast.mpr hL
    have hLBreal : (L : ℝ) ≤ B := Nat.cast_le.mpr hLB
    linarith
  · have hlow : 2 ^ Nat.log 2 L ≤ L := Nat.pow_log_le_self 2 hL.ne'
    have hpow : 2 ^ k = 2 ^ Nat.log 2 L * 2 := by simp [k, pow_succ]
    have hBlt : B < 2 * L := by dsimp only [B]; omega
    have hb : (B : ℝ) < 2 * (L : ℝ) := by exact_mod_cast hBlt
    linarith
  · simpa [L, Real.logb, add_comm] using add_le_add_right
      ((Real.natLog_le_logb L 2).trans
        (Real.logb_le_logb_of_le (by norm_num) (Nat.cast_pos.mpr hL) hfloor)) 1
  · intro j hj
    have hjlog : j ≤ Nat.log 2 L := Nat.lt_succ_iff.mp (Finset.mem_range.mp hj)
    have hpowj : (2 : ℝ) ^ j ≤ L := by
      exact_mod_cast (Nat.pow_le_of_le_log hL.ne' hjlog)
    exact ⟨one_le_pow₀ (by norm_num), hpowj.trans hfloor⟩

theorem signed_dyadic_profile_window (j : ℕ) :
    let H : ℝ := (2 : ℝ) ^ j
    let B : ℕ := ⌊2 * |H|⌋₊
    ((Finset.Icc (-(B : ℤ)) (B : ℤ)).filter
        (fun h : ℤ => 1 ≤ (h : ℝ) / H ∧ (h : ℝ) / H < 2)) =
      Finset.Ico ((2 : ℤ) ^ j) ((2 : ℤ) ^ (j + 1)) ∧
    ((Finset.Icc (-(B : ℤ)) (B : ℤ)).filter
        (fun h : ℤ => 1 ≤ (h : ℝ) / (-H) ∧ (h : ℝ) / (-H) < 2)) =
      Finset.Ioc (-((2 : ℤ) ^ (j + 1))) (-((2 : ℤ) ^ j)) := by
  let H : ℝ := (2 : ℝ) ^ j
  let B : ℕ := ⌊2 * |H|⌋₊
  have hH : 0 < H := pow_pos (by norm_num) j
  have hpow : (2 : ℝ) ^ (j + 1) = 2 * H := by simp [H, pow_succ']
  have hB : B = 2 ^ (j + 1) := by
    dsimp only [B]
    rw [abs_of_pos hH, ← hpow]
    simpa only [Nat.cast_pow, Nat.cast_ofNat] using
      (Nat.floor_natCast (R := ℝ) (2 ^ (j + 1)))
  have hb : (B : ℝ) = 2 * H := by
    rw [hB]
    simpa only [Nat.cast_pow, Nat.cast_ofNat] using hpow
  have hp₀ : (((2 : ℤ) ^ j : ℤ) : ℝ) = H := by simp [H]
  have hp₁ : (((2 : ℤ) ^ (j + 1) : ℤ) : ℝ) = 2 * H := by simpa using hpow
  change
    ((Finset.Icc (-(B : ℤ)) (B : ℤ)).filter
        (fun h : ℤ => 1 ≤ (h : ℝ) / H ∧ (h : ℝ) / H < 2)) = _ ∧
      ((Finset.Icc (-(B : ℤ)) (B : ℤ)).filter
        (fun h : ℤ => 1 ≤ (h : ℝ) / (-H) ∧ (h : ℝ) / (-H) < 2)) = _
  constructor
  · ext z
    simp only [Finset.mem_filter, Finset.mem_Icc, Finset.mem_Ico,
      ← Int.cast_le (R := ℝ), ← Int.cast_lt (R := ℝ), Int.cast_neg,
      Int.cast_natCast, hp₀, hp₁, hb]
    rw [one_le_div hH, div_lt_iff₀ hH]
    refine and_iff_right_of_imp ?_
    rintro ⟨hl, hu⟩
    exact ⟨by linarith, hu.le⟩
  · ext z
    simp only [Finset.mem_filter, Finset.mem_Icc, Finset.mem_Ioc,
      ← Int.cast_le (R := ℝ), ← Int.cast_lt (R := ℝ), Int.cast_neg,
      Int.cast_natCast, hp₀, hp₁, hb]
    rw [one_le_div_of_neg (neg_neg_of_pos hH),
      div_lt_iff_of_neg (neg_neg_of_pos hH), mul_neg]
    refine (and_iff_right_of_imp ?_).trans and_comm
    rintro ⟨hu, hl⟩
    exact ⟨hl.le, by linarith⟩

open scoped Classical in
theorem balanced_bv_large_conductor (u v : ℕ →₀ ℂ) (P R Q F r U : ℕ)
    (hu : u.support ⊆ Finset.Ioc 0 P) (hv : v.support ⊆ Finset.Ioc 0 R)
    (hQ : 1 ≤ Q) (hF : 1 ≤ F) (hU : U ≤ Q) :
    (∑ f ∈ (Finset.Ioc 1 U).filter (fun f => F < f),
      (f.totient : ℝ)⁻¹ *
        ∑ ψ ∈ (Finset.univ : Finset (DirichletCharacter ℂ f)).filter
            (fun ψ => ψ.IsPrimitive),
          ‖(∑ m ∈ u.support,
              if Nat.Coprime m r then u m * ψ (m : ZMod f) else 0) *
            (∑ n ∈ v.support,
              if Nat.Coprime n r then v n * ψ (n : ZMod f) else 0)‖) ≤
      ((Nat.log 2 Q + 1 : ℕ) : ℝ) *
        Real.sqrt (∑ m ∈ u.support, ‖u m‖ ^ 2) *
        Real.sqrt (∑ n ∈ v.support, ‖v n‖ ^ 2) *
        (2 * Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ) / (F : ℝ) +
          2 * (Real.sqrt (P : ℝ) + Real.sqrt (R : ℝ)) + 4 * (Q : ℝ)) := by
  classical
  let a : ℕ → ℂ := fun m => if Nat.Coprime m r then u m else 0
  let b : ℕ → ℂ := fun n => if Nat.Coprime n r then v n else 0
  let Eu := Real.sqrt (∑ m ∈ u.support, ‖u m‖ ^ 2)
  let Ev := Real.sqrt (∑ n ∈ v.support, ‖v n‖ ^ 2)
  let D := 2 * Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ) / (F : ℝ) +
    2 * (Real.sqrt (P : ℝ) + Real.sqrt (R : ℝ)) + 4 * (Q : ℝ)
  let Z (f : ℕ) : ℝ :=
    ∑ ψ ∈ (Finset.univ : Finset (DirichletCharacter ℂ f)).filter
        (fun ψ => ψ.IsPrimitive),
      ‖(∑ m ∈ u.support,
          if Nat.Coprime m r then u m * ψ (m : ZMod f) else 0) *
        (∑ n ∈ v.support,
          if Nat.Coprime n r then v n * ψ (n : ZMod f) else 0)‖
  have hEu : 0 ≤ Eu := Real.sqrt_nonneg _
  have hEv : 0 ≤ Ev := Real.sqrt_nonneg _
  have hQ0 : (0 : ℝ) ≤ Q := by
    exact_mod_cast (le_trans (Nat.zero_le 1) hQ)
  have hD : 0 ≤ D :=
    add_nonneg
      (add_nonneg (div_nonneg (by positivity) (Nat.cast_nonneg F))
        (by positivity))
      (mul_nonneg (by norm_num) hQ0)
  have hZ (f : ℕ) : 0 ≤ Z f :=
    Finset.sum_nonneg fun _ _ => norm_nonneg _
  have henergy (w : ℕ →₀ ℂ) :
      Real.sqrt (∑ m ∈ w.support,
        ‖if Nat.Coprime m r then w m else 0‖ ^ 2) ≤
        Real.sqrt (∑ m ∈ w.support, ‖w m‖ ^ 2) := by
    apply Real.sqrt_le_sqrt
    apply Finset.sum_le_sum
    intro m _
    by_cases hm : Nat.Coprime m r
    · exact (congrArg (fun z : ℂ => ‖z‖ ^ 2) (ite_eq_left hm)).le
    · simp [hm]
  have hZu (f : ℕ) :
      (∑ ψ : primitiveCharacters f,
        ‖∑ m ∈ u.support, ∑ n ∈ v.support,
          a m * b n * ψ.1 (m * n)‖) = Z f := by
    rw [← Finset.sum_subtype
      (p := fun ψ : DirichletCharacter ℂ f => ψ.IsPrimitive)
      (F := primitiveCharactersFintype f)
      ((Finset.univ : Finset (DirichletCharacter ℂ f)).filter
        (fun ψ => ψ.IsPrimitive))
      (by intro ψ; simp)
      (fun ψ : DirichletCharacter ℂ f =>
        ‖∑ m ∈ u.support, ∑ n ∈ v.support,
          a m * b n * ψ (m * n)‖)]
    apply Finset.sum_congr rfl
    intro ψ _
    rw [show (∑ m ∈ u.support, ∑ n ∈ v.support,
        a m * b n * ψ (m * n)) =
        (∑ m ∈ u.support, a m * ψ m) *
          (∑ n ∈ v.support, b n * ψ n) by
      simp only [Finset.sum_mul_sum, map_mul, mul_mul_mul_comm]]
    simp only [a, b, ite_mul, zero_mul]
  have hrectangle (L : ℕ) :
      (∑ f ∈ Finset.Ioc 0 L, (f : ℝ) / (f.totient : ℝ) * Z f) ≤
        Real.sqrt ((P : ℝ) + (L : ℝ) ^ 2) *
          Real.sqrt ((R : ℝ) + (L : ℝ) ^ 2) * Eu * Ev := by
    have hraw :=
      sum_weighted_norm_bilinear_primitiveTwists_subset_Ioc_le
        L 0 P 0 R u.support v.support
        (by simpa using hu) (by simpa using hv) a b
    have hEa : Real.sqrt (∑ m ∈ u.support, ‖a m‖ ^ 2) ≤ Eu := by
      simpa only [a, Eu] using henergy u
    have hEb : Real.sqrt (∑ n ∈ v.support, ‖b n‖ ^ 2) ≤ Ev := by
      simpa only [b, Ev] using henergy v
    calc
      (∑ f ∈ Finset.Ioc 0 L, (f : ℝ) / (f.totient : ℝ) * Z f) =
          ∑ f ∈ Finset.Ioc 0 L, (f : ℝ) / (f.totient : ℝ) *
            ∑ ψ : primitiveCharacters f,
              ‖∑ m ∈ u.support, ∑ n ∈ v.support,
                a m * b n * ψ.1 (m * n)‖ := by
        apply Finset.sum_congr rfl
        intro f _
        rw [hZu f]
      _ ≤ Real.sqrt ((P : ℝ) + (L : ℝ) ^ 2) *
          Real.sqrt ((R : ℝ) + (L : ℝ) ^ 2) *
          Real.sqrt (∑ m ∈ u.support, ‖a m‖ ^ 2) *
          Real.sqrt (∑ n ∈ v.support, ‖b n‖ ^ 2) := hraw
      _ ≤ Real.sqrt ((P : ℝ) + (L : ℝ) ^ 2) *
          Real.sqrt ((R : ℝ) + (L : ℝ) ^ 2) * Eu * Ev :=
        mul_le_mul (mul_le_mul_of_nonneg_left hEa (by positivity)) hEb
          (Real.sqrt_nonneg _) (by positivity)
  let S := (Finset.Ioc 1 U).filter (fun f => F < f)
  let exponent : ℕ → ℕ := fun f => Nat.log 2 (f - 1)
  have hS (f : ℕ) (hf : f ∈ S) : 2 ≤ f ∧ f ≤ Q := by
    have hfU := Finset.mem_Ioc.mp (Finset.mem_filter.mp hf).1
    exact ⟨by omega, hfU.2.trans hU⟩
  have hmaps : ∀ f ∈ S,
      exponent f ∈ Finset.range (Nat.log 2 Q + 1) := by
    intro f hf
    rw [Finset.mem_range]
    exact Nat.lt_succ_of_le
      (Nat.log_mono_right ((Nat.sub_le f 1).trans (hS f hf).2))
  have hpartition (w : ℕ → ℝ) :
      (∑ f ∈ S, w f) =
        ∑ j ∈ Finset.range (Nat.log 2 Q + 1),
          ∑ f ∈ S.filter (fun f => exponent f = j), w f :=
    (Finset.sum_fiberwise_of_maps_to hmaps w).symm
  have hsqrt (K L : ℕ) :
      Real.sqrt ((K : ℝ) + (L : ℝ) ^ 2) ≤
        Real.sqrt (K : ℝ) + (L : ℝ) := by
    refine Real.sqrt_le_iff.mpr ⟨by positivity, ?_⟩
    nlinarith [Real.sq_sqrt (Nat.cast_nonneg K : (0 : ℝ) ≤ K),
      mul_nonneg (Real.sqrt_nonneg (K : ℝ)) (Nat.cast_nonneg L : (0 : ℝ) ≤ L)]
  have hband (j : ℕ) :
      (∑ f ∈ S.filter (fun f => exponent f = j),
        (f.totient : ℝ)⁻¹ * Z f) ≤ Eu * Ev * D := by
    let T := S.filter (fun f => exponent f = j)
    change (∑ f ∈ T, (f.totient : ℝ)⁻¹ * Z f) ≤ Eu * Ev * D
    by_cases hT : T = ∅
    · simpa [hT] using mul_nonneg (mul_nonneg hEu hEv) hD
    obtain ⟨f₀, hf₀⟩ := Finset.nonempty_iff_ne_empty.mpr hT
    let V := 2 ^ j
    have hVnat : 0 < V := by dsimp [V]; positivity
    have hV : (0 : ℝ) < V := by exact_mod_cast hVnat
    have hb (f : ℕ) (hf : f ∈ T) : V < f ∧ f ≤ 2 * V := by
      have hfS := (Finset.mem_filter.mp hf).1
      have hj := (Finset.mem_filter.mp hf).2
      have hf2 := (hS f hfS).1
      have hlo := Nat.pow_log_le_self 2 (show f - 1 ≠ 0 by omega)
      have hhi := Nat.lt_pow_succ_log_self Nat.one_lt_two (f - 1)
      change Nat.log 2 (f - 1) = j at hj
      rw [hj] at hlo hhi
      constructor
      · dsimp [V]
        omega
      · have hupper : f ≤ 2 ^ (j + 1) := by
          simpa only [Nat.succ_eq_add_one] using
            (show f ≤ 2 ^ j.succ by omega)
        simpa only [pow_succ, Nat.mul_comm, V] using hupper
    have hFV : F < 2 * V :=
      lt_of_lt_of_le (Finset.mem_filter.mp (Finset.mem_filter.mp hf₀).1).2
        (hb f₀ hf₀).2
    have hVQ : V ≤ Q := (Nat.le_of_lt (hb f₀ hf₀).1).trans
      (hS f₀ (Finset.mem_filter.mp hf₀).1).2
    have hFpos : (0 : ℝ) < F := by
      exact_mod_cast (lt_of_lt_of_le Nat.zero_lt_one hF)
    have hVQreal : (V : ℝ) ≤ Q := by exact_mod_cast hVQ
    have hinv : 1 / (V : ℝ) ≤ 2 / (F : ℝ) := by
      rw [div_le_div_iff₀ hV hFpos, one_mul]
      exact_mod_cast hFV.le
    have hmain : Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ) / (V : ℝ) ≤
        2 * Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ) / (F : ℝ) := by
      calc
        Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ) / (V : ℝ) =
            (Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ)) * (1 / (V : ℝ)) := by ring
        _ ≤ (Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ)) * (2 / (F : ℝ)) :=
          mul_le_mul_of_nonneg_left hinv
            (mul_nonneg (Real.sqrt_nonneg (P : ℝ)) (Real.sqrt_nonneg (R : ℝ)))
        _ = 2 * Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ) / (F : ℝ) := by ring
    have hscalar :
        (V : ℝ)⁻¹ *
          (Real.sqrt ((P : ℝ) + ((2 * V : ℕ) : ℝ) ^ 2) *
            Real.sqrt ((R : ℝ) + ((2 * V : ℕ) : ℝ) ^ 2)) ≤ D := by
      have hP : Real.sqrt ((P : ℝ) + ((2 * V : ℕ) : ℝ) ^ 2) ≤
          Real.sqrt (P : ℝ) + 2 * (V : ℝ) := by
        simpa only [Nat.cast_mul, Nat.cast_ofNat] using hsqrt P (2 * V)
      have hR : Real.sqrt ((R : ℝ) + ((2 * V : ℕ) : ℝ) ^ 2) ≤
          Real.sqrt (R : ℝ) + 2 * (V : ℝ) := by
        simpa only [Nat.cast_mul, Nat.cast_ofNat] using hsqrt R (2 * V)
      calc
        (V : ℝ)⁻¹ *
            (Real.sqrt ((P : ℝ) + ((2 * V : ℕ) : ℝ) ^ 2) *
              Real.sqrt ((R : ℝ) + ((2 * V : ℕ) : ℝ) ^ 2)) ≤
            (V : ℝ)⁻¹ *
              ((Real.sqrt (P : ℝ) + 2 * (V : ℝ)) *
                (Real.sqrt (R : ℝ) + 2 * (V : ℝ))) :=
          mul_le_mul_of_nonneg_left
            (mul_le_mul hP hR (Real.sqrt_nonneg _) (by positivity))
            (inv_nonneg.mpr hV.le)
        _ = Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ) / (V : ℝ) +
            2 * (Real.sqrt (P : ℝ) + Real.sqrt (R : ℝ)) + 4 * (V : ℝ) := by
          calc
            _ = Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ) / (V : ℝ) +
                2 * (Real.sqrt (P : ℝ) + Real.sqrt (R : ℝ)) *
                  ((V : ℝ)⁻¹ * (V : ℝ)) +
                4 * (V : ℝ) * ((V : ℝ)⁻¹ * (V : ℝ)) := by ring
            _ = _ := by rw [inv_mul_cancel₀ hV.ne', mul_one, mul_one]
        _ ≤ D := by
          dsimp only [D]
          linarith
    have hsubset : T ⊆ Finset.Ioc 0 (2 * V) := by
      intro f hf
      exact Finset.mem_Ioc.mpr ⟨hVnat.trans (hb f hf).1, (hb f hf).2⟩
    calc
      (∑ f ∈ T, (f.totient : ℝ)⁻¹ * Z f) ≤
          (V : ℝ)⁻¹ * ∑ f ∈ T, (f : ℝ) / (f.totient : ℝ) * Z f := by
        rw [Finset.mul_sum]
        apply Finset.sum_le_sum
        intro f hf
        have hVf : (V : ℝ) ≤ f := by exact_mod_cast (hb f hf).1.le
        have hw := mul_le_mul_of_nonneg_right hVf
          (mul_nonneg (inv_nonneg.mpr (Nat.cast_nonneg f.totient)) (hZ f))
        calc
          (f.totient : ℝ)⁻¹ * Z f =
              (V : ℝ)⁻¹ * ((V : ℝ) * ((f.totient : ℝ)⁻¹ * Z f)) := by
            rw [← mul_assoc, inv_mul_cancel₀ hV.ne', one_mul]
          _ ≤ (V : ℝ)⁻¹ * ((f : ℝ) * ((f.totient : ℝ)⁻¹ * Z f)) :=
            mul_le_mul_of_nonneg_left hw (inv_nonneg.mpr hV.le)
          _ = (V : ℝ)⁻¹ * ((f : ℝ) / (f.totient : ℝ) * Z f) := by
            rw [div_eq_mul_inv]
            ring
      _ ≤ (V : ℝ)⁻¹ *
          ∑ f ∈ Finset.Ioc 0 (2 * V), (f : ℝ) / (f.totient : ℝ) * Z f := by
        apply mul_le_mul_of_nonneg_left _ (inv_nonneg.mpr hV.le)
        exact Finset.sum_le_sum_of_subset_of_nonneg hsubset fun f _ _ =>
          mul_nonneg (div_nonneg (Nat.cast_nonneg f) (Nat.cast_nonneg f.totient))
            (hZ f)
      _ ≤ (V : ℝ)⁻¹ *
          (Real.sqrt ((P : ℝ) + ((2 * V : ℕ) : ℝ) ^ 2) *
            Real.sqrt ((R : ℝ) + ((2 * V : ℕ) : ℝ) ^ 2) * Eu * Ev) :=
        mul_le_mul_of_nonneg_left (hrectangle (2 * V)) (inv_nonneg.mpr hV.le)
      _ = Eu * Ev *
          ((V : ℝ)⁻¹ *
            (Real.sqrt ((P : ℝ) + ((2 * V : ℕ) : ℝ) ^ 2) *
              Real.sqrt ((R : ℝ) + ((2 * V : ℕ) : ℝ) ^ 2))) := by ring
      _ ≤ Eu * Ev * D :=
        mul_le_mul_of_nonneg_left hscalar (mul_nonneg hEu hEv)
  change (∑ f ∈ S, (f.totient : ℝ)⁻¹ * Z f) ≤
    ((Nat.log 2 Q + 1 : ℕ) : ℝ) * Eu * Ev * D
  calc
    (∑ f ∈ S, (f.totient : ℝ)⁻¹ * Z f) =
        ∑ j ∈ Finset.range (Nat.log 2 Q + 1),
          ∑ f ∈ S.filter (fun f => exponent f = j), (f.totient : ℝ)⁻¹ * Z f :=
      hpartition _
    _ ≤ ∑ _j ∈ Finset.range (Nat.log 2 Q + 1), Eu * Ev * D :=
      Finset.sum_le_sum fun j _ => hband j
    _ = ((Nat.log 2 Q + 1 : ℕ) : ℝ) * Eu * Ev * D := by
      simp only [Finset.sum_const, Finset.card_range, nsmul_eq_mul]
      ring

open scoped Classical in
theorem balanced_bv_twist_bound (q : ℕ) (hq : 0 < q) (g : ℕ →₀ ℂ)
    (ψ : DirichletCharacter ℂ q) (hψ : ψ ≠ 1)
    (D : ℝ) (hD : 0 ≤ D)
    (hg : ∀ a : ℕ, Nat.Coprime a q →
      ‖fullDiscrepancy g q a‖ ≤ D) :
    ‖∑ n ∈ g.support, g n * ψ (n : ZMod q)‖ ≤ (q : ℝ) * D := by
  classical
  let : NeZero q := ⟨Nat.ne_of_gt hq⟩
  have hprogression :
      (∑ a : ZMod q, ψ a * progressionMass g q a.val) =
        ∑ n ∈ g.support, g n * ψ (n : ZMod q) := by
    simp only [progressionMass, Finset.mul_sum]
    rw [Finset.sum_comm]
    apply Finset.sum_congr rfl
    intro n _
    have hres (a : ZMod q) :
        n % q = a.val % q ↔ (n : ZMod q) = a := by
      rw [← ZMod.natCast_eq_natCast_iff', ZMod.natCast_zmod_val]
    calc
      (∑ a : ZMod q, ψ a * (if n % q = a.val % q then g n else 0)) =
          ψ (n : ZMod q) *
            (if n % q = (n : ZMod q).val % q then g n else 0) :=
        Finset.sum_eq_single_of_mem _ (Finset.mem_univ _) (by
          intro a _ hne
          rw [ite_eq_right (fun h => hne ((hres a).1 h).symm), mul_zero])
      _ = g n * ψ (n : ZMod q) := by
        rw [ite_eq_left ((hres _).2 rfl)]
        exact mul_comm _ _
  have hmean :
      (∑ a : ZMod q, ψ a * (reducedMass g q / (q.totient : ℂ))) = 0 := by
    rw [← Finset.sum_mul, MulChar.sum_eq_zero_of_ne_one hψ, zero_mul]
  have hidentity :
      (∑ a : ZMod q, ψ a * fullDiscrepancy g q a.val) =
        ∑ n ∈ g.support, g n * ψ (n : ZMod q) := by
    simp only [fullDiscrepancy, mul_sub, Finset.sum_sub_distrib]
    rw [hprogression, hmean, sub_zero]
  rw [← hidentity]
  calc
    ‖∑ a : ZMod q, ψ a * fullDiscrepancy g q a.val‖ ≤
        ∑ a : ZMod q, ‖ψ a * fullDiscrepancy g q a.val‖ :=
      norm_sum_le _ _
    _ ≤ ∑ _a : ZMod q, D := by
      apply Finset.sum_le_sum
      intro a _
      by_cases ha : IsUnit a
      · have hcop : Nat.Coprime a.val q :=
          (ZMod.isUnit_iff_coprime a.val q).1
            (by simpa only [ZMod.natCast_zmod_val] using ha)
        rw [norm_mul]
        calc
          ‖ψ a‖ * ‖fullDiscrepancy g q a.val‖ ≤
              1 * ‖fullDiscrepancy g q a.val‖ :=
            mul_le_mul_of_nonneg_right (ψ.norm_le_one a) (norm_nonneg _)
          _ ≤ D := by simpa only [one_mul] using hg a.val hcop
      · rw [MulChar.map_nonunit ψ ha, zero_mul, norm_zero]
        exact hD
    _ = (q : ℝ) * D := by
      simp only [Finset.sum_const, Finset.card_univ, ZMod.card, nsmul_eq_mul]

open scoped Classical in
theorem balanced_bv_small_conductor (s : ℕ) (u v : ℕ →₀ ℂ) (F U e h : ℕ)
    (Lα K N₀ : ℝ) (hF : 1 ≤ F) (he : 0 < e) (hh : 0 < h)
    (hLα : 0 ≤ Lα) (hK : 0 ≤ K) (hN₀ : 0 ≤ N₀)
    (hu : (∑ n ∈ u.support, ‖u n‖) ≤ Lα)
    (hv : ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
      ‖fullDiscrepancy (v.filter (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
        K * ((q * r).divisors.card : ℝ) ^ s * N₀) :
    (∑ f ∈ (Finset.Ioc 1 U).filter (fun f => f ≤ F), (f.totient : ℝ)⁻¹ *
      ∑ ψ ∈ (Finset.univ : Finset (DirichletCharacter ℂ f)).filter
          (fun ψ => ψ.IsPrimitive),
        ‖(∑ m ∈ u.support,
            if Nat.Coprime m (e * h) then u m * ψ (m : ZMod f) else 0) *
          (∑ n ∈ v.support,
            if Nat.Coprime n (e * h) then v n * ψ (n : ZMod f) else 0)‖) ≤
      Lα * K * N₀ * (e.divisors.card : ℝ) ^ s * (h.divisors.card : ℝ) ^ s *
        (F : ℝ) ^ (s + 2) := by
  classical
  have htwist_bound := balanced_bv_twist_bound
  have htau_mul (a b : ℕ) :
      ((a * b).divisors.card : ℝ) ≤
        (a.divisors.card : ℝ) * (b.divisors.card : ℝ) := by
    have hn : (a * b).divisors.card ≤ a.divisors.card * b.divisors.card := by
      rw [Nat.divisors_mul]
      exact Finset.card_mul_le
    exact_mod_cast hn
  let S : Finset ℕ := (Finset.Ioc 1 U).filter (fun f => f ≤ F)
  let T : ℝ :=
    Lα * K * N₀ * (e.divisors.card : ℝ) ^ s * (h.divisors.card : ℝ) ^ s
  have hT : 0 ≤ T := by
    dsimp only [T]
    positivity
  have hFR : 0 ≤ (F : ℝ) :=
    (Nat.cast_pos.mpr (lt_of_lt_of_le Nat.zero_lt_one hF)).le
  have hmask (f : ℕ) (ψ : DirichletCharacter ℂ f) :
      (∑ n ∈ (v.filter (fun n : ℕ => Nat.Coprime n (e * h))).support,
        (v.filter (fun n : ℕ => Nat.Coprime n (e * h))) n *
          ψ (n : ZMod f)) =
        ∑ n ∈ v.support,
          if Nat.Coprime n (e * h) then v n * ψ (n : ZMod f) else 0 := by
    rw [Finsupp.support_filter, Finset.sum_filter]
    apply Finset.sum_congr rfl
    intro n _
    by_cases hn : Nat.Coprime n (e * h)
    · rw [ite_eq_left hn, Finsupp.filter_apply, ite_eq_left hn, ite_eq_left hn]
    · rw [ite_eq_right hn, ite_eq_right hn]
  have hleft (f : ℕ) (ψ : DirichletCharacter ℂ f) :
      ‖∑ m ∈ u.support,
        if Nat.Coprime m (e * h) then u m * ψ (m : ZMod f) else 0‖ ≤ Lα := by
    calc
      ‖∑ m ∈ u.support,
          if Nat.Coprime m (e * h) then u m * ψ (m : ZMod f) else 0‖ ≤
          ∑ m ∈ u.support,
            ‖if Nat.Coprime m (e * h) then u m * ψ (m : ZMod f) else 0‖ :=
        norm_sum_le _ _
      _ ≤ ∑ m ∈ u.support, ‖u m‖ := by
        apply Finset.sum_le_sum
        intro m _
        by_cases hm : Nat.Coprime m (e * h)
        · rw [ite_eq_left hm, norm_mul]
          exact mul_le_of_le_one_right (norm_nonneg _) (ψ.norm_le_one _)
        · rw [ite_eq_right hm, norm_zero]
          exact norm_nonneg _
      _ ≤ Lα := hu
  have hpoint (f : ℕ) (hf : f ∈ S) :
      (f.totient : ℝ)⁻¹ *
        (∑ ψ ∈ (Finset.univ : Finset (DirichletCharacter ℂ f)).filter
            (fun ψ => ψ.IsPrimitive),
          ‖(∑ m ∈ u.support,
              if Nat.Coprime m (e * h) then u m * ψ (m : ZMod f) else 0) *
            (∑ n ∈ v.support,
              if Nat.Coprime n (e * h) then v n * ψ (n : ZMod f) else 0)‖) ≤
        T * (F : ℝ) ^ (s + 1) := by
    have hf1 : 1 < f := (Finset.mem_Ioc.mp (Finset.mem_filter.mp hf).1).1
    have hfF : f ≤ F := (Finset.mem_filter.mp hf).2
    have hfpos : 0 < f := lt_trans Nat.zero_lt_one hf1
    let : NeZero f := ⟨Nat.ne_of_gt hfpos⟩
    have hφ : 0 < (f.totient : ℝ) :=
      Nat.cast_pos.mpr (Nat.totient_pos.mpr hfpos)
    have htau :
        ((f * (e * h)).divisors.card : ℝ) ^ s ≤
          (f : ℝ) ^ s * (e.divisors.card : ℝ) ^ s *
            (h.divisors.card : ℝ) ^ s := by
      have hfcard : (f.divisors.card : ℝ) ≤ (f : ℝ) := by
        exact_mod_cast Nat.card_divisors_le_self f
      have hbase :
          ((f * (e * h)).divisors.card : ℝ) ≤
            (f : ℝ) * (e.divisors.card : ℝ) * (h.divisors.card : ℝ) := by
        calc
          ((f * (e * h)).divisors.card : ℝ) ≤
              (f.divisors.card : ℝ) * ((e * h).divisors.card : ℝ) :=
            htau_mul f (e * h)
          _ ≤ (f : ℝ) * ((e.divisors.card : ℝ) * (h.divisors.card : ℝ)) :=
            mul_le_mul hfcard (htau_mul e h) (Nat.cast_nonneg _) (Nat.cast_nonneg _)
          _ = (f : ℝ) * (e.divisors.card : ℝ) * (h.divisors.card : ℝ) :=
            (mul_assoc _ _ _).symm
      simpa only [mul_pow] using
        pow_le_pow_left₀ (Nat.cast_nonneg _) hbase s
    have hterm (ψ : DirichletCharacter ℂ f) (hψ : ψ.IsPrimitive) :
        ‖(∑ m ∈ u.support,
            if Nat.Coprime m (e * h) then u m * ψ (m : ZMod f) else 0) *
          (∑ n ∈ v.support,
            if Nat.Coprime n (e * h) then v n * ψ (n : ZMod f) else 0)‖ ≤
          T * (F : ℝ) ^ (s + 1) := by
      have hψne : ψ ≠ 1 := by
        intro hψone
        have hc := (DirichletCharacter.isPrimitive_def ψ).mp hψ
        rw [hψone, DirichletCharacter.conductor_one] at hc
        omega
      have hright :
          ‖∑ n ∈ v.support,
            if Nat.Coprime n (e * h) then v n * ψ (n : ZMod f) else 0‖ ≤
            (f : ℝ) * (K * ((f * (e * h)).divisors.card : ℝ) ^ s * N₀) := by
        rw [← hmask f ψ]
        exact htwist_bound f hfpos
          (v.filter (fun n : ℕ => Nat.Coprime n (e * h))) ψ hψne
          (K * ((f * (e * h)).divisors.card : ℝ) ^ s * N₀) (by positivity)
          (fun a ha => hv f (e * h) a hfpos (Nat.mul_pos he hh) ha)
      rw [norm_mul]
      calc
        ‖∑ m ∈ u.support,
            if Nat.Coprime m (e * h) then u m * ψ (m : ZMod f) else 0‖ *
            ‖∑ n ∈ v.support,
              if Nat.Coprime n (e * h) then v n * ψ (n : ZMod f) else 0‖ ≤
            Lα * ((f : ℝ) *
              (K * ((f * (e * h)).divisors.card : ℝ) ^ s * N₀)) :=
          mul_le_mul (hleft f ψ) hright (norm_nonneg _) hLα
        _ ≤ Lα * ((f : ℝ) *
            (K * ((f : ℝ) ^ s * (e.divisors.card : ℝ) ^ s *
              (h.divisors.card : ℝ) ^ s) * N₀)) := by
          apply mul_le_mul_of_nonneg_left _ hLα
          apply mul_le_mul_of_nonneg_left _ (Nat.cast_nonneg f)
          apply mul_le_mul_of_nonneg_right _ hN₀
          exact mul_le_mul_of_nonneg_left htau hK
        _ = T * (f : ℝ) ^ (s + 1) := by
          dsimp only [T]
          rw [pow_succ]
          ring
        _ ≤ T * (F : ℝ) ^ (s + 1) :=
          mul_le_mul_of_nonneg_left
            (pow_le_pow_left₀ (Nat.cast_nonneg f) (Nat.cast_le.mpr hfF) _) hT
    let P : Finset (DirichletCharacter ℂ f) :=
      Finset.univ.filter (fun ψ => ψ.IsPrimitive)
    have hcard : (P.card : ℝ) ≤ (f.totient : ℝ) := by
      have hnat : P.card ≤ f.totient := by
        calc
          P.card ≤ Fintype.card (DirichletCharacter ℂ f) := by
            simpa only [P, Finset.card_univ] using
              Finset.card_filter_le
                (Finset.univ : Finset (DirichletCharacter ℂ f)) (fun ψ => ψ.IsPrimitive)
          _ = f.totient := by
            rw [← Nat.card_eq_fintype_card]
            exact DirichletCharacter.card_eq_totient_of_hasEnoughRootsOfUnity ℂ f
      exact_mod_cast hnat
    have hsum :
        (∑ ψ ∈ P,
          ‖(∑ m ∈ u.support,
              if Nat.Coprime m (e * h) then u m * ψ (m : ZMod f) else 0) *
            (∑ n ∈ v.support,
              if Nat.Coprime n (e * h) then v n * ψ (n : ZMod f) else 0)‖) ≤
          (f.totient : ℝ) * (T * (F : ℝ) ^ (s + 1)) := by
      calc
        (∑ ψ ∈ P,
            ‖(∑ m ∈ u.support,
                if Nat.Coprime m (e * h) then u m * ψ (m : ZMod f) else 0) *
              (∑ n ∈ v.support,
                if Nat.Coprime n (e * h) then v n * ψ (n : ZMod f) else 0)‖) ≤
            ∑ _ψ ∈ P, T * (F : ℝ) ^ (s + 1) :=
          Finset.sum_le_sum fun ψ hψ => hterm ψ (Finset.mem_filter.mp hψ).2
        _ = (P.card : ℝ) * (T * (F : ℝ) ^ (s + 1)) := by
          rw [Finset.sum_const, nsmul_eq_mul]
        _ ≤ (f.totient : ℝ) * (T * (F : ℝ) ^ (s + 1)) :=
          mul_le_mul_of_nonneg_right hcard (mul_nonneg hT (pow_nonneg hFR _))
    calc
      (f.totient : ℝ)⁻¹ *
          (∑ ψ ∈ P,
            ‖(∑ m ∈ u.support,
                if Nat.Coprime m (e * h) then u m * ψ (m : ZMod f) else 0) *
              (∑ n ∈ v.support,
                if Nat.Coprime n (e * h) then v n * ψ (n : ZMod f) else 0)‖) ≤
          (f.totient : ℝ)⁻¹ *
            ((f.totient : ℝ) * (T * (F : ℝ) ^ (s + 1))) :=
        mul_le_mul_of_nonneg_left hsum (inv_nonneg.mpr hφ.le)
      _ = T * (F : ℝ) ^ (s + 1) := by
        rw [← mul_assoc, inv_mul_cancel₀ hφ.ne', one_mul]
  have hcardS : (S.card : ℝ) ≤ (F : ℝ) := by
    have hsub : S ⊆ Finset.Ioc 0 F := by
      intro f hf
      have hm := Finset.mem_filter.mp hf
      exact Finset.mem_Ioc.mpr
        ⟨lt_trans Nat.zero_lt_one (Finset.mem_Ioc.mp hm.1).1, hm.2⟩
    have hnat : S.card ≤ F := by
      simpa only [Nat.card_Ioc, Nat.sub_zero] using Finset.card_le_card hsub
    exact_mod_cast hnat
  change (∑ f ∈ S, (f.totient : ℝ)⁻¹ *
    ∑ ψ ∈ (Finset.univ : Finset (DirichletCharacter ℂ f)).filter
        (fun ψ => ψ.IsPrimitive),
      ‖(∑ m ∈ u.support,
          if Nat.Coprime m (e * h) then u m * ψ (m : ZMod f) else 0) *
        (∑ n ∈ v.support,
          if Nat.Coprime n (e * h) then v n * ψ (n : ZMod f) else 0)‖) ≤
    T * (F : ℝ) ^ (s + 2)
  calc
    (∑ f ∈ S, (f.totient : ℝ)⁻¹ *
        ∑ ψ ∈ (Finset.univ : Finset (DirichletCharacter ℂ f)).filter
            (fun ψ => ψ.IsPrimitive),
          ‖(∑ m ∈ u.support,
              if Nat.Coprime m (e * h) then u m * ψ (m : ZMod f) else 0) *
            (∑ n ∈ v.support,
              if Nat.Coprime n (e * h) then v n * ψ (n : ZMod f) else 0)‖) ≤
        ∑ _f ∈ S, T * (F : ℝ) ^ (s + 1) :=
      Finset.sum_le_sum hpoint
    _ = (S.card : ℝ) * (T * (F : ℝ) ^ (s + 1)) := by
      rw [Finset.sum_const, nsmul_eq_mul]
    _ ≤ (F : ℝ) * (T * (F : ℝ) ^ (s + 1)) :=
      mul_le_mul_of_nonneg_right hcardS (mul_nonneg hT (pow_nonneg hFR _))
    _ = T * (F : ℝ) ^ (s + 2) := by
      rw [show s + 2 = (s + 1) + 1 by omega, pow_succ]
      ring

open scoped Classical in
theorem balanced_bv_large_geometry (C η : ℝ) (hCpos : 0 < C)
    (x M₀ N₀ : ℝ) (P R Q F : ℕ) (D : ℝ)
    (hx : Real.exp 1 ≤ x) (hD : 0 ≤ D) (hMN : M₀ * N₀ ≤ C * x)
    (hM : x ^ η ≤ M₀) (hN : x ^ η ≤ N₀)
    (hP : (P : ℝ) ≤ 2 * C * M₀) (hR : (R : ℝ) ≤ 2 * C * N₀)
    (hF : (Real.log x) ^ D / 2 ≤ (F : ℝ))
    (hQ : (Q : ℝ) ≤ Real.sqrt x / (Real.log x) ^ D)
    (hlog : (Real.log x) ^ D ≤ x ^ (η / 2)) :
    Real.sqrt M₀ * Real.sqrt N₀ *
        (2 * Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ) / (F : ℝ) +
          2 * (Real.sqrt (P : ℝ) + Real.sqrt (R : ℝ)) + 4 * (Q : ℝ)) ≤
      (8 * C ^ 2 + 4 * C * Real.sqrt (2 * C) + 4 * Real.sqrt C) * x /
        (Real.log x) ^ D := by
  classical
  let L := (Real.log x) ^ D
  let S := Real.sqrt M₀ * Real.sqrt N₀
  let T := Real.sqrt (2 * C)
  have hxpos : 0 < x := lt_of_lt_of_le (Real.exp_pos 1) hx
  have hlog1 : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hx
  have hL1 : 1 ≤ L := Real.one_le_rpow hlog1 hD
  have hL : 0 < L := lt_of_lt_of_le zero_lt_one hL1
  have hMpos : 0 < M₀ := (Real.rpow_pos_of_pos hxpos η).trans_le hM
  have hNpos : 0 < N₀ := (Real.rpow_pos_of_pos hxpos η).trans_le hN
  have hS : 0 ≤ S := mul_nonneg (Real.sqrt_nonneg _) (Real.sqrt_nonneg _)
  have hT : 0 ≤ T := Real.sqrt_nonneg _
  have h2C : 0 ≤ 2 * C := mul_nonneg (by norm_num) hCpos.le
  have hpower : Real.sqrt (x ^ η) = x ^ (η / 2) := by
    rw [Real.sqrt_eq_rpow, ← Real.rpow_mul hxpos.le, mul_one_div]
  change L / 2 ≤ (F : ℝ) at hF
  change (Q : ℝ) ≤ Real.sqrt x / L at hQ
  change L ≤ x ^ (η / 2) at hlog
  have hLM : L ≤ Real.sqrt M₀ :=
    hlog.trans (hpower.symm.trans_le (Real.sqrt_le_sqrt hM))
  have hLN : L ≤ Real.sqrt N₀ :=
    hlog.trans (hpower.symm.trans_le (Real.sqrt_le_sqrt hN))
  have hFpos : (0 : ℝ) < F :=
    (div_pos hL (by norm_num : (0 : ℝ) < 2)).trans_le hF
  have hLF : L / (F : ℝ) ≤ 2 := by
    apply (div_le_iff₀ hFpos).2
    linarith
  have hQL : (Q : ℝ) * L ≤ Real.sqrt x := (le_div_iff₀ hL).mp hQ
  have hP' : Real.sqrt (P : ℝ) ≤ T * Real.sqrt M₀ :=
    (Real.sqrt_le_sqrt hP).trans_eq (Real.sqrt_mul h2C M₀)
  have hR' : Real.sqrt (R : ℝ) ≤ T * Real.sqrt N₀ :=
    (Real.sqrt_le_sqrt hR).trans_eq (Real.sqrt_mul h2C N₀)
  have hPR : Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ) ≤ 2 * C * S := by
    calc
      Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ) ≤
          (T * Real.sqrt M₀) * (T * Real.sqrt N₀) :=
        mul_le_mul hP' hR' (Real.sqrt_nonneg _) (mul_nonneg hT (Real.sqrt_nonneg _))
      _ = 2 * C * S := by
        dsimp only [T, S]
        rw [mul_mul_mul_comm, Real.mul_self_sqrt h2C]
  have hSsq : S ^ 2 = M₀ * N₀ := by
    dsimp only [S]
    rw [mul_pow, Real.sq_sqrt hMpos.le, Real.sq_sqrt hNpos.le]
  have hSx : S ≤ Real.sqrt C * Real.sqrt x := by
    calc
      S = Real.sqrt (M₀ * N₀) := (Real.sqrt_mul hMpos.le N₀).symm
      _ ≤ Real.sqrt (C * x) := Real.sqrt_le_sqrt hMN
      _ = Real.sqrt C * Real.sqrt x := Real.sqrt_mul hCpos.le x
  have hfirst :
      S * (2 * Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ) / (F : ℝ)) * L ≤
        8 * C ^ 2 * x := by
    calc
      S * (2 * Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ) / (F : ℝ)) * L =
          (2 * S * (Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ))) * (L / (F : ℝ)) :=
        by ring
      _ ≤ (2 * S * (Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ))) * 2 :=
        mul_le_mul_of_nonneg_left hLF (by positivity)
      _ = 4 * S * (Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ)) := by ring
      _ ≤ 4 * S * (2 * C * S) :=
        mul_le_mul_of_nonneg_left hPR (mul_nonneg (by norm_num) hS)
      _ = 8 * C * (M₀ * N₀) := by rw [← hSsq]; ring
      _ ≤ 8 * C * (C * x) :=
        mul_le_mul_of_nonneg_left hMN (by positivity)
      _ = 8 * C ^ 2 * x := by ring
  have hLP : L * Real.sqrt (P : ℝ) ≤ T * S := by
    calc
      L * Real.sqrt (P : ℝ) ≤ L * (T * Real.sqrt M₀) :=
        mul_le_mul_of_nonneg_left hP' hL.le
      _ = (T * Real.sqrt M₀) * L := by ring
      _ ≤ (T * Real.sqrt M₀) * Real.sqrt N₀ :=
        mul_le_mul_of_nonneg_left hLN (mul_nonneg hT (Real.sqrt_nonneg _))
      _ = T * S := by dsimp only [S]; ring
  have hLR : L * Real.sqrt (R : ℝ) ≤ T * S := by
    calc
      L * Real.sqrt (R : ℝ) ≤ L * (T * Real.sqrt N₀) :=
        mul_le_mul_of_nonneg_left hR' hL.le
      _ = (T * Real.sqrt N₀) * L := by ring
      _ ≤ (T * Real.sqrt N₀) * Real.sqrt M₀ :=
        mul_le_mul_of_nonneg_left hLM (mul_nonneg hT (Real.sqrt_nonneg _))
      _ = T * S := by dsimp only [S]; ring
  have hsum : L * (Real.sqrt (P : ℝ) + Real.sqrt (R : ℝ)) ≤ 2 * T * S := by
    linarith
  have hmiddle :
      S * (2 * (Real.sqrt (P : ℝ) + Real.sqrt (R : ℝ))) * L ≤ 4 * C * T * x := by
    calc
      S * (2 * (Real.sqrt (P : ℝ) + Real.sqrt (R : ℝ))) * L =
          2 * S * (L * (Real.sqrt (P : ℝ) + Real.sqrt (R : ℝ))) := by ring
      _ ≤ 2 * S * (2 * T * S) :=
        mul_le_mul_of_nonneg_left hsum (mul_nonneg (by norm_num) hS)
      _ = 4 * T * (M₀ * N₀) := by rw [← hSsq]; ring
      _ ≤ 4 * T * (C * x) :=
        mul_le_mul_of_nonneg_left hMN (mul_nonneg (by norm_num) hT)
      _ = 4 * C * T * x := by ring
  have hlast : S * (4 * (Q : ℝ)) * L ≤ 4 * Real.sqrt C * x := by
    calc
      S * (4 * (Q : ℝ)) * L = 4 * S * ((Q : ℝ) * L) := by ring
      _ ≤ 4 * S * Real.sqrt x :=
        mul_le_mul_of_nonneg_left hQL (mul_nonneg (by norm_num) hS)
      _ ≤ 4 * (Real.sqrt C * Real.sqrt x) * Real.sqrt x :=
        mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left hSx (by norm_num)) (Real.sqrt_nonneg _)
      _ = 4 * Real.sqrt C * (Real.sqrt x * Real.sqrt x) := by ring
      _ = 4 * Real.sqrt C * x := by rw [Real.mul_self_sqrt hxpos.le]
  change S *
      (2 * Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ) / (F : ℝ) +
        2 * (Real.sqrt (P : ℝ) + Real.sqrt (R : ℝ)) + 4 * (Q : ℝ)) ≤
    (8 * C ^ 2 + 4 * C * T + 4 * Real.sqrt C) * x / L
  apply (le_div_iff₀ hL).2
  calc
    S *
        (2 * Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ) / (F : ℝ) +
          2 * (Real.sqrt (P : ℝ) + Real.sqrt (R : ℝ)) + 4 * (Q : ℝ)) * L =
        S * (2 * Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ) / (F : ℝ)) * L +
          S * (2 * (Real.sqrt (P : ℝ) + Real.sqrt (R : ℝ))) * L +
          S * (4 * (Q : ℝ)) * L := by ring
    _ ≤ 8 * C ^ 2 * x + 4 * C * T * x + 4 * Real.sqrt C * x :=
      add_le_add (add_le_add hfirst hmiddle) hlast
    _ = (8 * C ^ 2 + 4 * C * T + 4 * Real.sqrt C) * x := by ring

theorem sum_norm_meanTerm_le_harmonic_of_masked_bv
    (f : ℕ →₀ ℂ) (U V s : ℕ) (K : ℝ) (hK : 0 ≤ K)
    (S : Finset (ℕ × ℕ)) (a : ℕ)
    (hS : ∀ p ∈ S, 0 < p.1 ∧ p.1 ≤ U ∧ 0 < p.2 ∧ p.2 ≤ V ∧
      Nat.Coprime p.1 p.2 ∧ Nat.Coprime a (p.1 * p.2))
    (hBV : ∀ q : ℕ, 0 < q → q ≤ U →
      (∑ r ∈ Finset.Ioc 0 V,
        ⨆ b : (ZMod r)ˣ,
          ‖fullDiscrepancy (f.filter (fun n => Nat.Coprime n q))
            r (b : ZMod r).val‖) ≤ K * (q.divisors.card : ℝ) ^ s) :
    (∑ p ∈ S, ‖meanTerm f p.1 p.2 a‖) ≤
      K * (harmonic U : ℝ) ^ (2 ^ (s + 1)) := by
  classical
  let H (q r : ℕ) : ℝ :=
    ⨆ b : (ZMod r)ˣ,
      ‖fullDiscrepancy (f.filter (fun n => Nat.Coprime n q)) r (b : ZMod r).val‖
  have hmax (q r b : ℕ) (hr : 0 < r) (hb : Nat.Coprime b r) :
      ‖fullDiscrepancy (f.filter (fun n => Nat.Coprime n q)) r b‖ ≤ H q r := by
    let : NeZero r := ⟨hr.ne'⟩
    have hrep :
        fullDiscrepancy (f.filter (fun n => Nat.Coprime n q)) r
            (ZMod.unitOfCoprime b hb : ZMod r).val =
          fullDiscrepancy (f.filter (fun n => Nat.Coprime n q)) r b := by
      simp only [fullDiscrepancy, progressionMass, ZMod.coe_unitOfCoprime,
        ZMod.val_natCast, Nat.mod_mod]
    exact Finite.le_ciSup_of_le (ZMod.unitOfCoprime b hb)
      (le_of_eq (congrArg norm hrep.symm))
  have hH (q r : ℕ) (hr : 0 < r) : 0 ≤ H q r :=
    (norm_nonneg _).trans (hmax q r 1 hr (Nat.coprime_one_left r))
  have hsubset : S ⊆ (Finset.Ioc 0 U).product (Finset.Ioc 0 V) := by
    intro p hp
    obtain ⟨hq, hqU, hr, hrV, _, _⟩ := hS p hp
    exact Finset.mem_product.mpr
      ⟨Finset.mem_Ioc.mpr ⟨hq, hqU⟩, Finset.mem_Ioc.mpr ⟨hr, hrV⟩⟩
  have hpoint (p : ℕ × ℕ) (hp : p ∈ S) :
      ‖meanTerm f p.1 p.2 a‖ ≤ H p.1 p.2 / (p.1.totient : ℝ) := by
    obtain ⟨_, _, hr, _, hqr, ha⟩ := hS p hp
    rw [meanTerm_eq_fullDiscrepancy_filter_coprime f p.1 p.2 a hqr,
      norm_div, Complex.norm_natCast]
    exact div_le_div_of_nonneg_right
      (hmax p.1 p.2 a hr (Nat.coprime_mul_iff_right.mp ha).2)
      (Nat.cast_nonneg p.1.totient)
  have hmoment :
      (∑ q ∈ Finset.Ioc 0 U, (q.divisors.card : ℝ) ^ s / (q.totient : ℝ)) ≤
        (harmonic U : ℝ) ^ (2 ^ (s + 1)) := by
    rw [← Finset.Icc_succ_left_eq_Ioc (0 : ℕ) U]
    calc
      (∑ q ∈ Finset.Icc 1 U, (q.divisors.card : ℝ) ^ s / (q.totient : ℝ)) ≤
          ∑ q ∈ Finset.Icc 1 U, (q.divisors.card : ℝ) ^ (s + 1) / (q : ℝ) := by
        apply Finset.sum_le_sum
        intro q hq
        have hqpos : 0 < q := (Finset.mem_Icc.mp hq).1
        have hqR : 0 < (q : ℝ) := Nat.cast_pos.mpr hqpos
        have hφ : 0 < (q.totient : ℝ) := Nat.cast_pos.mpr (Nat.totient_pos.mpr hqpos)
        calc
          (q.divisors.card : ℝ) ^ s / (q.totient : ℝ) =
              ((q.divisors.card : ℝ) ^ s * ((q : ℝ) / q.totient)) / q := by
            field_simp [hqR.ne', hφ.ne']
          _ ≤ ((q.divisors.card : ℝ) ^ s * (q.divisors.card : ℝ)) / q :=
            div_le_div_of_nonneg_right
              (mul_le_mul_of_nonneg_left
                (div_totient_le_card_divisors q)
                (pow_nonneg (Nat.cast_nonneg _) _)) hqR.le
          _ = (q.divisors.card : ℝ) ^ (s + 1) / q := by rw [pow_succ]
      _ ≤ ∑ q ∈ Finset.Icc 1 U,
          (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (2 ^ (s + 1))) q : ℝ) /
            (q : ℝ) := by
        apply Finset.sum_le_sum
        intro q hq
        apply div_le_div_of_nonneg_right _ (Nat.cast_nonneg q)
        exact_mod_cast card_divisors_pow_le_zeta_pow (s + 1) q
          (Finset.mem_Icc.mp hq).1
      _ ≤ (harmonic U : ℝ) ^ (2 ^ (s + 1)) :=
        sum_zeta_pow_div_le_harmonic_pow (2 ^ (s + 1)) U
  calc
    (∑ p ∈ S, ‖meanTerm f p.1 p.2 a‖) ≤
        ∑ p ∈ S, H p.1 p.2 / (p.1.totient : ℝ) := Finset.sum_le_sum hpoint
    _ ≤ ∑ p ∈ (Finset.Ioc 0 U).product (Finset.Ioc 0 V),
        H p.1 p.2 / (p.1.totient : ℝ) := by
      apply Finset.sum_le_sum_of_subset_of_nonneg hsubset
      intro p hp _
      exact div_nonneg (hH p.1 p.2 (Finset.mem_Ioc.mp (Finset.mem_product.mp hp).2).1)
        (Nat.cast_nonneg p.1.totient)
    _ = ∑ q ∈ Finset.Ioc 0 U,
        ∑ r ∈ Finset.Ioc 0 V, H q r / (q.totient : ℝ) := Finset.sum_product _ _ _
    _ ≤ ∑ q ∈ Finset.Ioc 0 U, K * (q.divisors.card : ℝ) ^ s / (q.totient : ℝ) := by
      apply Finset.sum_le_sum
      intro q hq
      rw [← Finset.sum_div]
      exact div_le_div_of_nonneg_right
        (hBV q (Finset.mem_Ioc.mp hq).1 (Finset.mem_Ioc.mp hq).2)
        (Nat.cast_nonneg q.totient)
    _ = K * ∑ q ∈ Finset.Ioc 0 U, (q.divisors.card : ℝ) ^ s / (q.totient : ℝ) := by
      rw [Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro q _
      ring
    _ ≤ K * (harmonic U : ℝ) ^ (2 ^ (s + 1)) :=
      mul_le_mul_of_nonneg_left hmoment hK

theorem source_typeI_II_parameter_retreat
    (ω δ σ : ℝ) (hω : 0 < ω) (hδ : 0 < δ)
    (hI : 72 * ω + 24 * δ < 1)
    (hII : 48 * ω + 16 * δ + 4 * σ < 1)
    (hIII : 64 * ω + 20 * δ + 2 * σ < 1) :
    ∃ ω' δ' ε : ℝ, ω < ω' ∧ δ < δ' ∧ 0 < ε ∧
      ε < δ' / (10 : ℝ) ^ 100 ∧
      2 * ε < ω' - ω ∧ 2 * ε < δ' - δ ∧
      72 * ω' + 24 * δ' < 1 ∧
      48 * ω' + 16 * δ' + 4 * σ < 1 ∧
      64 * ω' + 20 * δ' + 2 * σ < 1 ∧
      max (1 / 4 + 12 * ω' + 4 * δ' + 100 * ε)
        (32 * ω' + 10 * δ' + 400 * ε) < 1 / 2 - σ ∧
      1 / 4 + 14 * ω' + 4 * δ' + 100 * ε < 1 / 2 - 4 * ω' - 2 * δ' - 50 * ε ∧
      σ < 1 / 4 ∧ 0 < 1 / 2 - σ ∧
      0 < 1 / 2 - 4 * ω' - 2 * δ' - 50 * ε ∧
      ω' < 1 / 72 ∧ δ' < 1 / 24 := by
  let a : ℝ := 1 - 72 * ω - 24 * δ
  let b : ℝ := 1 - 48 * ω - 16 * δ - 4 * σ
  let c : ℝ := 1 - 64 * ω - 20 * δ - 2 * σ
  have ha : 0 < a := by dsimp only [a]; linarith only [hI]
  have hb : 0 < b := by dsimp only [b]; linarith only [hII]
  have hc : 0 < c := by dsimp only [c]; linarith only [hIII]
  let t : ℝ := min (min a b) c / 10000
  have ht : 0 < t := div_pos (lt_min (lt_min ha hb) hc) (by norm_num)
  have hta : 10000 * t ≤ a := by
    have hm := (min_le_left (min a b) c).trans (min_le_left a b)
    dsimp only [t]
    linarith only [hm]
  have htb : 10000 * t ≤ b := by
    have hm := (min_le_left (min a b) c).trans (min_le_right a b)
    dsimp only [t]
    linarith only [hm]
  have htc : 10000 * t ≤ c := by
    have hm := min_le_right (min a b) c
    dsimp only [t]
    linarith only [hm]
  let ω' : ℝ := ω + t
  let δ' : ℝ := δ + t
  have hω' : 0 < ω' := add_pos hω ht
  have hδ' : 0 < δ' := add_pos hδ ht
  have hd : 0 < δ' / (10 : ℝ) ^ 100 := div_pos hδ' (pow_pos (by norm_num) _)
  let ε : ℝ := min t (δ' / (10 : ℝ) ^ 100) / 4
  have hε : 0 < ε := div_pos (lt_min ht hd) (by norm_num)
  have hεt : ε < t := by
    have hm := min_le_left t (δ' / (10 : ℝ) ^ 100)
    dsimp only [ε]
    linarith only [hm, lt_min ht hd]
  have hεδ : ε < δ' / (10 : ℝ) ^ 100 := by
    have hm := min_le_right t (δ' / (10 : ℝ) ^ 100)
    dsimp only [ε]
    linarith only [hm, lt_min ht hd]
  have hεdouble : 2 * ε < t := by
    have hm := min_le_left t (δ' / (10 : ℝ) ^ 100)
    dsimp only [ε]
    linarith only [hm, ht]
  have hworkI : 72 * ω' + 24 * δ' < 1 := by
    dsimp only [ω', δ', a] at *
    linarith only [hta, ht]
  have hworkII : 48 * ω' + 16 * δ' + 4 * σ < 1 := by
    dsimp only [ω', δ', b] at *
    linarith only [htb, ht]
  have hworkIII : 64 * ω' + 20 * δ' + 2 * σ < 1 := by
    dsimp only [ω', δ', c] at *
    linarith only [htc, ht]
  have hlo₁ : 1 / 4 + 12 * ω' + 4 * δ' + 100 * ε < 1 / 2 - σ := by
    dsimp only [ω', δ', b] at *
    linarith only [htb, hεt, ht]
  have hlo₂ : 32 * ω' + 10 * δ' + 400 * ε < 1 / 2 - σ := by
    dsimp only [ω', δ', c] at *
    linarith only [htc, hεt, ht]
  have hoverlap :
      1 / 4 + 14 * ω' + 4 * δ' + 100 * ε < 1 / 2 - 4 * ω' - 2 * δ' - 50 * ε := by
    dsimp only [ω', δ', a] at *
    linarith only [hta, hεt, ht]
  have hσquarter : σ < 1 / 4 := by linarith only [hII, hω, hδ]
  refine ⟨ω', δ', ε, ?_, ?_, hε, hεδ, ?_, ?_, hworkI, hworkII, hworkIII,
    max_lt_iff.mpr ⟨hlo₁, hlo₂⟩, hoverlap, hσquarter, ?_, ?_, ?_, ?_⟩
  · dsimp only [ω']; linarith only [ht]
  · dsimp only [δ']; linarith only [ht]
  · dsimp only [ω']; linarith only [hεdouble]
  · dsimp only [δ']; linarith only [hεdouble]
  · linarith only [hσquarter]
  · linarith only [hoverlap, hω', hδ']
  · linarith only [hworkI, hδ']
  · linarith only [hworkI, hω']

section
open scoped ContDiff
open Classical in
theorem sourceTerminalSigma6_outside_uniform_bound
    (Csrc ε TD TN : ℝ) (hCsrc : 0 ≤ Csrc) (hε : 0 < ε)
    (hTD : 0 ≤ TD) (hTN : 0 ≤ TN)
    (Cφ Eφ Cψ Eψ : ℕ → ℝ)
    (hCφ : ∀ r : ℕ, 0 ≤ Cφ r) (hCψ : ∀ r : ℕ, 0 ≤ Cψ r) :
    ∃ COut X₀ : ℝ, 0 < COut ∧ Real.exp 1 ≤ X₀ ∧
      ∀ (x : ℝ), X₀ ≤ x →
      ∀ (m q₀ c₁ c₂ a w w₂ : ℕ) (hm : Squarefree m),
      (m : ℝ) ≤ x ^ Csrc → q₀ ∣ m → c₁ ∣ m → c₂ ∣ m →
      0 < a → 0 < w → Nat.Coprime a m → Nat.Coprime w m →
      (a : ℝ) ≤ 4 * x ^ (2 * Csrc) → (w : ℝ) ≤ x ^ Csrc →
      ∀ (u v F G ell dstar nstar Jnum : ℤ),
      IsUnit (u : ZMod m) → IsUnit (v : ZMod m) → (w₂ : ℤ) ∣ Jnum →
      ∀ (A₁ A₂ B : ZMod m), IsUnit A₁ → IsUnit A₂ →
      ∀ (D N d₀ n₀ : ℝ), 0 < D → 0 < N →
      D ≤ x ^ Csrc → N ≤ x ^ Csrc →
      (w : ℝ) * D / N ≤ 2 * x ^ (-(5 * ε)) →
      ∀ (φ ψ : ℝ → ℂ), ContDiff ℝ ∞ φ → ContDiff ℝ ∞ ψ →
      Function.support φ ⊆ Set.Icc (-TD) TD →
      Function.support ψ ⊆ Set.Icc (-TN) TN →
      (∀ (r : ℕ) (t : ℝ), ‖iteratedDeriv r φ t‖ ≤ Cφ r * (Real.log x) ^ Eφ r) →
      (∀ (r : ℕ) (t : ℝ), ‖iteratedDeriv r ψ t‖ ≤ Cψ r * (Real.log x) ^ Eψ r) →
      letI : NeZero m := ⟨hm.ne_zero⟩
      let L : ZMod m := A₂ * ((Jnum / (w₂ : ℤ) : ℤ) : ZMod m)
      let K : (p : m.primeFactors) → ℝ := fun p =>
        letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
        (Finset.univ : Finset (ZMod p.1)).sup' Finset.univ_nonempty
          (fun c => ‖normalizedKloosterman3 p.1 c‖)
      let BD : Finset ℤ := Finset.Icc ⌈d₀ - TD * D⌉ ⌊d₀ + TD * D⌋
      let BN : Finset ℤ := Finset.Icc ⌈n₀ - TN * N⌉ ⌊n₀ + TN * N⌋
      let H : ℤ × ℤ → ℂ := fun z =>
        if Int.ModEq (q₀ : ℤ) z.1 dstar ∧
            Int.ModEq (q₀ : ℤ) (u * z.2 + F * z.1) nstar ∧
            Int.gcd z.1 (m : ℤ) = 1 ∧ Int.gcd z.1 (a : ℤ) = 1 ∧
            Int.gcd (u * z.2 + F * z.1) (w : ℤ) = 1 ∧
            Int.gcd (v * z.2 + G * z.1) (w : ℤ) = 1 ∧
            Int.gcd (u * z.2 + F * z.1) (c₁ : ℤ) = 1 ∧
            Int.gcd (v * z.2 + G * z.1) (c₁ : ℤ) = 1 ∧
            Int.gcd (u * z.2 + (F + ell) * z.1) (c₂ : ℤ) = 1 ∧
            Int.gcd (v * z.2 + (G + ell) * z.1) (c₂ : ℤ) = 1 then
          φ (((z.1 : ℝ) - d₀) / D) * ψ (((z.2 : ℝ) - n₀) / N) *
            affineReciprocalProductPhase m ((w₂ : ZMod m) * A₁) B L 0 0
              (z.2 : ZMod m) (z.1 : ZMod m)
        else 0
      let total : ℂ := ∑ d ∈ BD, ∑ n ∈ BN, H (d, n)
      HasSum H total ∧
        ‖total‖ ≤ COut * x ^ (2 * ε) * (Int.gcd Jnum (m : ℤ) : ℝ) *
          (∏ p : m.primeFactors, max 1 (K p)) * (1 / (q₀ : ℝ)) *
          (N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
          (D / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) := by
  let b : ℝ := 1 + ε
  let J : ℕ := ⌈(b + 2 * Csrc + 2) / (5 * ε)⌉₊
  have hb : 0 < b := by dsimp [b]; positivity
  obtain ⟨Cs, Es, hCs, hstar⟩ := sourceShortShearTaylor_uniform_star_profiles
    J TD TN hTD Cφ Eφ Cψ Eψ hCφ hCψ
  let C : ℝ := max (Cs 0) (Cs 1)
  let E : ℝ := max (Es 0) (Es 1)
  have hC : 0 ≤ C := (hCs 0).1.le.trans (le_max_left _ _)
  obtain ⟨XR, hXR, hrem⟩ := sourceShortShearTaylor_uniform_finite_remainder
    ε b Csrc TD TN hε hb hCsrc hTD hTN Cφ Eφ Cψ Eψ hCφ hCψ
  obtain ⟨XC, -, hcomplete⟩ := sourceTerminalInsideMobius_uniform_kl3_max_bound
    Csrc ε TD TN C C E E hCsrc hε hTD hTN hC hC
  let δ : ℝ := ε / (8 * (Csrc + 1))
  have hδ : 0 < δ := by dsimp [δ]; positivity
  have hgap : 0 < ε - 4 * Csrc * δ := by
    have hden : 0 < 8 * (Csrc + 1) := by positivity
    have hδeq : δ * (8 * (Csrc + 1)) = ε := by
      dsimp [δ]
      exact div_mul_cancel₀ _ hden.ne'
    nlinarith
  obtain ⟨Cτ, hCτ, hτ⟩ := exists_card_divisors_bound hδ
  obtain ⟨XT, hXT⟩ := Filter.eventually_atTop.mp
    ((tendsto_rpow_atTop hgap).eventually_ge_atTop (Cτ ^ 3 * (4 : ℝ) ^ δ))
  refine ⟨(J : ℝ) + 2, max XR (max XC XT), by positivity,
    hXR.trans (le_max_left _ _), ?_⟩
  intro x hx m q₀ c₁ c₂ a w w₂ hm hmx hq₀ hc₁ hc₂ ha hw ham hwm hax hwx
    u v F G ell dstar nstar Jnum hu hv hw₂J A₁ A₂ B hA₁ hA₂
    D N d₀ n₀ hD hN hDx hNx hsmall φ ψ hφ hψ hφsupp hψsupp hφbound hψbound
  let : NeZero m := ⟨hm.ne_zero⟩
  have hqpos : 0 < q₀ := Nat.pos_of_dvd_of_pos hq₀ (NeZero.pos m)
  let : NeZero q₀ := ⟨hqpos.ne'⟩
  have hxR : XR ≤ x := (le_max_left XR _).trans hx
  have hxC : XC ≤ x := (le_max_left XC XT).trans ((le_max_right XR _).trans hx)
  have hxT : XT ≤ x := (le_max_right XC XT).trans ((le_max_right XR _).trans hx)
  have hxexp : Real.exp 1 ≤ x := hXR.trans hxR
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hx1 : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hxexp
  have hlog1 : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hxexp
  have hlog0 : 0 ≤ Real.log x := zero_le_one.trans hlog1
  have hmR : (0 : ℝ) < m := by exact_mod_cast NeZero.pos m
  have hqR : (0 : ℝ) < q₀ := by exact_mod_cast hqpos
  have hsqrt : 0 < Real.sqrt (m : ℝ) := Real.sqrt_pos.2 hmR
  let L : ZMod m := A₂ * ((Jnum / (w₂ : ℤ) : ℤ) : ZMod m)
  let K : (p : m.primeFactors) → ℝ := fun p =>
    letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
    (Finset.univ : Finset (ZMod p.1)).sup' Finset.univ_nonempty
      (fun c => ‖normalizedKloosterman3 p.1 c‖)
  let P : ℝ := ∏ p : m.primeFactors, max 1 (K p)
  let R : ℝ := (Int.gcd Jnum (m : ℤ) : ℝ) * P * (1 / (q₀ : ℝ)) *
    (N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
    (D / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ))
  let BD : Finset ℤ := Finset.Icc ⌈d₀ - TD * D⌉ ⌊d₀ + TD * D⌋
  let BN : Finset ℤ := Finset.Icc ⌈n₀ - TN * N⌉ ⌊n₀ + TN * N⌋
  let coeff : ℤ → ℤ → ℂ := fun d n =>
    if Int.ModEq (q₀ : ℤ) d dstar ∧ Int.ModEq (q₀ : ℤ) (u * n + F * d) nstar ∧
        Int.gcd d (m : ℤ) = 1 ∧
        Int.gcd (u * n + F * d) (c₁ : ℤ) = 1 ∧
        Int.gcd (v * n + G * d) (c₁ : ℤ) = 1 ∧
        Int.gcd (u * n + (F + ell) * d) (c₂ : ℤ) = 1 ∧
        Int.gcd (v * n + (G + ell) * d) (c₂ : ℤ) = 1 then
      affineReciprocalProductPhase m ((w₂ : ZMod m) * A₁) B L 0 0
        (n : ZMod m) (d : ZMod m)
    else 0
  let W : ℤ → ℤ → ℂ := fun d n =>
    coeff d n * φ (((d : ℝ) - d₀) / D) * ψ (((n : ℝ) - n₀) / N)
  let H : ℤ × ℤ → ℂ := fun z =>
    if Int.ModEq (q₀ : ℤ) z.1 dstar ∧
        Int.ModEq (q₀ : ℤ) (u * z.2 + F * z.1) nstar ∧
        Int.gcd z.1 (m : ℤ) = 1 ∧ Int.gcd z.1 (a : ℤ) = 1 ∧
        Int.gcd (u * z.2 + F * z.1) (w : ℤ) = 1 ∧
        Int.gcd (v * z.2 + G * z.1) (w : ℤ) = 1 ∧
        Int.gcd (u * z.2 + F * z.1) (c₁ : ℤ) = 1 ∧
        Int.gcd (v * z.2 + G * z.1) (c₁ : ℤ) = 1 ∧
        Int.gcd (u * z.2 + (F + ell) * z.1) (c₂ : ℤ) = 1 ∧
        Int.gcd (v * z.2 + (G + ell) * z.1) (c₂ : ℤ) = 1 then
      φ (((z.1 : ℝ) - d₀) / D) * ψ (((z.2 : ℝ) - n₀) / N) *
        affineReciprocalProductPhase m ((w₂ : ZMod m) * A₁) B L 0 0
          (z.2 : ZMod m) (z.1 : ZMod m)
    else 0
  let total : ℂ := ∑ d ∈ BD, ∑ n ∈ BN, H (d, n)
  change HasSum H total ∧ ‖total‖ ≤ ((J : ℝ) + 2) * x ^ (2 * ε) *
    (Int.gcd Jnum (m : ℤ) : ℝ) * P * (1 / (q₀ : ℝ)) *
    (N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
    (D / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ))
  have hWzero (z : ℤ × ℤ) (hz : z ∉ BD ×ˢ BN) : W z.1 z.2 = 0 := by
    by_contra hne
    have hφne := (mul_ne_zero_iff.mp (mul_ne_zero_iff.mp hne).1).2
    have hψne := (mul_ne_zero_iff.mp hne).2
    have hd := hφsupp hφne
    have hn := hψsupp hψne
    have hdlo := (le_div_iff₀ hD).mp hd.1
    have hdhi := (div_le_iff₀ hD).mp hd.2
    have hnlo := (le_div_iff₀ hN).mp hn.1
    have hnhi := (div_le_iff₀ hN).mp hn.2
    apply hz
    exact Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr
      ⟨Int.ceil_le.mpr (by linarith), Int.le_floor.mpr (by linarith)⟩,
      Finset.mem_Icc.mpr
        ⟨Int.ceil_le.mpr (by linarith), Int.le_floor.mpr (by linarith)⟩⟩
  have hHpoint (z : ℤ × ℤ) : H z =
      if Int.gcd z.1 (a : ℤ) = 1 ∧
          Int.gcd (u * z.2 + F * z.1) (w : ℤ) = 1 ∧
          Int.gcd (v * z.2 + G * z.1) (w : ℤ) = 1 then W z.1 z.2 else 0 := by
    have hguard :
        (Int.ModEq (q₀ : ℤ) z.1 dstar ∧
          Int.ModEq (q₀ : ℤ) (u * z.2 + F * z.1) nstar ∧
          Int.gcd z.1 (m : ℤ) = 1 ∧ Int.gcd z.1 (a : ℤ) = 1 ∧
          Int.gcd (u * z.2 + F * z.1) (w : ℤ) = 1 ∧
          Int.gcd (v * z.2 + G * z.1) (w : ℤ) = 1 ∧
          Int.gcd (u * z.2 + F * z.1) (c₁ : ℤ) = 1 ∧
          Int.gcd (v * z.2 + G * z.1) (c₁ : ℤ) = 1 ∧
          Int.gcd (u * z.2 + (F + ell) * z.1) (c₂ : ℤ) = 1 ∧
          Int.gcd (v * z.2 + (G + ell) * z.1) (c₂ : ℤ) = 1) ↔
        (Int.gcd z.1 (a : ℤ) = 1 ∧
          Int.gcd (u * z.2 + F * z.1) (w : ℤ) = 1 ∧
          Int.gcd (v * z.2 + G * z.1) (w : ℤ) = 1) ∧
        (Int.ModEq (q₀ : ℤ) z.1 dstar ∧
          Int.ModEq (q₀ : ℤ) (u * z.2 + F * z.1) nstar ∧
          Int.gcd z.1 (m : ℤ) = 1 ∧
          Int.gcd (u * z.2 + F * z.1) (c₁ : ℤ) = 1 ∧
          Int.gcd (v * z.2 + G * z.1) (c₁ : ℤ) = 1 ∧
          Int.gcd (u * z.2 + (F + ell) * z.1) (c₂ : ℤ) = 1 ∧
          Int.gcd (v * z.2 + (G + ell) * z.1) (c₂ : ℤ) = 1) := by
      constructor
      · rintro ⟨hd, hn, hm', ha', hnw, htw, hnc, htc, hnℓ, htℓ⟩
        exact ⟨⟨ha', hnw, htw⟩, hd, hn, hm', hnc, htc, hnℓ, htℓ⟩
      · rintro ⟨⟨ha', hnw, htw⟩, hd, hn, hm', hnc, htc, hnℓ, htℓ⟩
        exact ⟨hd, hn, hm', ha', hnw, htw, hnc, htc, hnℓ, htℓ⟩
    by_cases hOut : Int.gcd z.1 (a : ℤ) = 1 ∧
        Int.gcd (u * z.2 + F * z.1) (w : ℤ) = 1 ∧
        Int.gcd (v * z.2 + G * z.1) (w : ℤ) = 1
    · by_cases hIn : Int.ModEq (q₀ : ℤ) z.1 dstar ∧
          Int.ModEq (q₀ : ℤ) (u * z.2 + F * z.1) nstar ∧
          Int.gcd z.1 (m : ℤ) = 1 ∧
          Int.gcd (u * z.2 + F * z.1) (c₁ : ℤ) = 1 ∧
          Int.gcd (v * z.2 + G * z.1) (c₁ : ℤ) = 1 ∧
          Int.gcd (u * z.2 + (F + ell) * z.1) (c₂ : ℤ) = 1 ∧
          Int.gcd (v * z.2 + (G + ell) * z.1) (c₂ : ℤ) = 1
      · have hAll := hguard.mpr ⟨hOut, hIn⟩
        simp only [H, W, coeff, ite_eq_left hAll, ite_eq_left hOut, ite_eq_left hIn]
        ac_rfl
      · have hAll := fun h => hIn (hguard.mp h).2
        simp only [H, W, coeff, ite_eq_right hAll, ite_eq_left hOut,
          ite_eq_right hIn, zero_mul]
    · have hAll := fun h => hOut (hguard.mp h).1
      simp only [H, ite_eq_right hAll, ite_eq_right hOut]
  have hsum : HasSum H total := by
    have hs : HasSum H (∑ z ∈ BD ×ˢ BN, H z) :=
      hasSum_sum_of_ne_finset_zero fun z hz => by
        simp only [hHpoint z, hWzero z hz, ite_self]
    simpa only [total, Finset.sum_product] using hs
  have hP : 1 ≤ P := Finset.one_le_prod fun p _ => le_max_left _ _
  have hg : (1 : ℝ) ≤ Int.gcd Jnum (m : ℤ) := by
    exact_mod_cast Int.gcd_pos_of_ne_zero_right Jnum (by exact_mod_cast hm.ne_zero)
  have hqle : (q₀ : ℝ) ≤ m := by exact_mod_cast Nat.le_of_dvd (NeZero.pos m) hq₀
  have hR : 1 ≤ R := by
    have hgeom : (m : ℝ) ≤
        (N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
          (D / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) := by
      calc
        (m : ℝ) = Real.sqrt (m : ℝ) * Real.sqrt (m : ℝ) :=
          (Real.mul_self_sqrt hmR.le).symm
        _ ≤ _ := mul_le_mul
          (le_add_of_nonneg_left (div_nonneg hN.le hsqrt.le))
          (le_add_of_nonneg_left (div_nonneg hD.le hsqrt.le)) hsqrt.le
          (by positivity)
    calc
      1 ≤ (m : ℝ) / q₀ := (one_le_div hqR).mpr hqle
      _ ≤ (Int.gcd Jnum (m : ℤ) : ℝ) * P *
          ((N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
            (D / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ))) / q₀ := by
        apply div_le_div_of_nonneg_right _ hqR.le
        calc
          (m : ℝ) ≤ (1 * 1) *
              ((N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
                (D / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ))) := by simpa using hgeom
          _ ≤ _ := mul_le_mul_of_nonneg_right
            (mul_le_mul hg hP zero_le_one (zero_le_one.trans hg)) (by positivity)
      _ = R := by simp only [R, div_eq_mul_inv, one_mul]; ac_rfl
  have hτcount : (a.divisors.card : ℝ) * (w.divisors.card : ℝ) ^ 2 ≤ x ^ ε := by
    calc
      _ ≤ (Cτ * (a : ℝ) ^ δ) * (Cτ * (w : ℝ) ^ δ) ^ 2 := by
        gcongr
        · exact hτ a ha.ne'
        · exact hτ w hw.ne'
      _ ≤ (Cτ * (4 * x ^ (2 * Csrc)) ^ δ) * (Cτ * (x ^ Csrc) ^ δ) ^ 2 := by
        gcongr
      _ = (Cτ ^ 3 * (4 : ℝ) ^ δ) * x ^ (4 * Csrc * δ) := by
        rw [Real.mul_rpow (by norm_num) (Real.rpow_nonneg hx0.le _),
          ← Real.rpow_mul hx0.le, ← Real.rpow_mul hx0.le, mul_pow,
          ← Real.rpow_mul_natCast hx0.le]
        rw [show 4 * Csrc * δ = 2 * Csrc * δ + Csrc * δ * (2 : ℝ) by ring,
          Real.rpow_add hx0]
        norm_num only [Nat.cast_ofNat]
        ring
      _ ≤ x ^ (ε - 4 * Csrc * δ) * x ^ (4 * Csrc * δ) :=
        mul_le_mul_of_nonneg_right (hXT x hxT) (Real.rpow_nonneg hx0.le _)
      _ = x ^ ε := by rw [← Real.rpow_add hx0, sub_add_cancel]
  have hprofile (f : ℝ → ℂ)
      (hf : ∀ r t, ‖iteratedDeriv r f t‖ ≤ Cs r * (Real.log x) ^ Es r) :
      ∀ t, ‖f t‖ ≤ C * (Real.log x) ^ E ∧
        ‖deriv f t‖ ≤ C * (Real.log x) ^ E := by
    intro t
    have hzero := hf 0 t
    have hone := hf 1 t
    simp only [iteratedDeriv_zero, iteratedDeriv_one] at hzero hone
    constructor
    · exact hzero.trans (mul_le_mul (le_max_left _ _)
        (Real.rpow_le_rpow_of_exponent_le hlog1 (le_max_left _ _))
        (Real.rpow_nonneg hlog0 _) hC)
    · exact hone.trans (mul_le_mul (le_max_right _ _)
        (Real.rpow_le_rpow_of_exponent_le hlog1 (le_max_right _ _))
        (Real.rpow_nonneg hlog0 _) hC)
  have hdivisor (f₁ : ℕ) (hf₁ : f₁ ∈ a.divisors)
      (f₂ : ℕ) (hf₂ : f₂ ∈ w.divisors) (f₃ : ℕ) (hf₃ : f₃ ∈ w.divisors) :
      ‖∑ z ∈ (BD ×ˢ BN).filter (fun z : ℤ × ℤ =>
          (f₁ : ℤ) ∣ z.1 ∧ (f₂ : ℤ) ∣ u * z.2 + F * z.1 ∧
            (f₃ : ℤ) ∣ v * z.2 + G * z.1), W z.1 z.2‖ ≤
        ((J : ℝ) + 1) * x ^ ε * R + x ^ (-b) := by
    obtain ⟨-, hf, hw₃, -, -, -, hw₃w, hfm, hw₃m, -, -, -, hhex⟩ :=
      sourceTerminalMobius_lattice_and_finite_reindex m a w f₁ f₂ f₃ ha hw
        (Nat.mem_divisors.mp hf₁).1 (Nat.mem_divisors.mp hf₂).1
        (Nat.mem_divisors.mp hf₃).1 ham hwm u v F G
    let f : ℕ := Ideal.absNorm
      ((sourceTerminalMobiusLattice f₁ f₂ f₃ u v F G).map (LinearMap.fst ℤ ℤ ℤ))
    let w₃ : ℕ := Nat.lcm (f₂ / Int.gcd (f₂ : ℤ) u) (f₃ / Int.gcd (f₃ : ℤ) v)
    change 0 < f at hf
    change 0 < w₃ at hw₃
    change w₃ ∣ w at hw₃w
    change Nat.Coprime f m at hfm
    change Nat.Coprime w₃ m at hw₃m
    obtain ⟨h, ⟨hh0, hhw, hbij, -⟩, -⟩ := hhex
    change h < (w₃ : ℤ) at hhw
    change ∀ d n : ℤ, _ ↔ ∃! p : ℤ × ℤ,
      d = (f : ℤ) * p.1 ∧ n = (w₃ : ℤ) * p.2 + h * p.1 at hbij
    have hfI : (f : ℤ) ≠ 0 := by exact_mod_cast hf.ne'
    have hwI : (w₃ : ℤ) ≠ 0 := by exact_mod_cast hw₃.ne'
    have hfR : (0 : ℝ) < f := by exact_mod_cast hf
    have hwR : (0 : ℝ) < w₃ := by exact_mod_cast hw₃
    have hf1 : (1 : ℝ) ≤ f := by exact_mod_cast hf
    have hw1 : (1 : ℝ) ≤ w₃ := by exact_mod_cast hw₃
    have hww : (w₃ : ℝ) ≤ w := by exact_mod_cast Nat.le_of_dvd hw hw₃w
    have hhR0 : (0 : ℝ) ≤ h := by exact_mod_cast hh0
    have hhRw : (h : ℝ) ≤ w :=
      (show (h : ℝ) ≤ w₃ by exact_mod_cast hhw.le).trans hww
    let T : ℤ × ℤ → ℤ × ℤ := fun z =>
      ((f : ℤ) * z.1, (w₃ : ℤ) * z.2 + h * z.1)
    have hTinj : Function.Injective T := by
      intro z z' heq
      have hd : z.1 = z'.1 := mul_left_cancel₀ hfI (congrArg Prod.fst heq)
      have hn := congrArg Prod.snd heq
      dsimp only [T] at hn
      rw [hd] at hn
      exact Prod.ext hd (mul_left_cancel₀ hwI (add_right_cancel hn))
    have hTdiv (z : ℤ × ℤ) :
        (f₁ : ℤ) ∣ (T z).1 ∧ (f₂ : ℤ) ∣ u * (T z).2 + F * (T z).1 ∧
          (f₃ : ℤ) ∣ v * (T z).2 + G * (T z).1 := by
      apply (hbij _ _).2
      refine ⟨z, ⟨rfl, rfl⟩, ?_⟩
      intro z' hz'
      apply hTinj
      exact Prod.ext hz'.1.symm hz'.2.symm
    let Hdiv : ℤ × ℤ → ℂ := fun z =>
      if (f₁ : ℤ) ∣ z.1 ∧ (f₂ : ℤ) ∣ u * z.2 + F * z.1 ∧
          (f₃ : ℤ) ∣ v * z.2 + G * z.1 then W z.1 z.2 else 0
    let V : ℂ := ∑ z ∈ (BD ×ˢ BN).filter (fun z : ℤ × ℤ =>
      (f₁ : ℤ) ∣ z.1 ∧ (f₂ : ℤ) ∣ u * z.2 + F * z.1 ∧
        (f₃ : ℤ) ∣ v * z.2 + G * z.1), W z.1 z.2
    have hV : HasSum Hdiv V := by
      have hs : HasSum Hdiv (∑ z ∈ BD ×ˢ BN, Hdiv z) :=
        hasSum_sum_of_ne_finset_zero fun z hz => by
          simp only [Hdiv, hWzero z hz, ite_self]
      simpa only [V, Hdiv, Finset.sum_filter] using hs
    have hoff (z : ℤ × ℤ) (hz : z ∉ Set.range T) : Hdiv z = 0 := by
      dsimp only [Hdiv]
      split_ifs with hdiv
      · obtain ⟨p, hp, -⟩ := (hbij z.1 z.2).1 hdiv
        exact (hz ⟨p, Prod.ext hp.1.symm hp.2.symm⟩).elim
      · rfl
    have htrans : HasSum (Hdiv ∘ T) V := (hTinj.hasSum_iff hoff).2 hV
    obtain ⟨-, -, hgcd, hphase⟩ :=
      sourceTerminalMobius_masked_phase m w₂ f w₃ Jnum h hw₂J hfm hw₃m A₁ A₂ B hA₁ hA₂
    let A₁' : ZMod m := A₁ * ((w₃ : ZMod m) * (f : ZMod m))⁻¹
    let A₂' : ZMod m := (f : ZMod m) * A₂ * (w₃ : ZMod m)⁻¹
    let B' : ZMod m := ((h : ZMod m) + B * (f : ZMod m)) * (w₃ : ZMod m)⁻¹
    let L' : ZMod m := A₂' * ((Jnum / (w₂ : ℤ) : ℤ) : ZMod m)
    change Nat.gcd (((w₂ : ZMod m) * A₁' * L').val) m = Int.gcd Jnum (m : ℤ) at hgcd
    let ds : ZMod q₀ := (f : ZMod q₀)⁻¹ * (dstar : ZMod q₀)
    let ns : ZMod q₀ := ((u : ZMod q₀) * (w₃ : ZMod q₀))⁻¹ *
      ((nstar : ZMod q₀) - ((u * h + F * (f : ℤ) : ℤ) : ZMod q₀) * ds)
    obtain ⟨-, -, -, hclasses⟩ := sourceTerminalMobius_residue_classes
      m q₀ f w₃ hq₀ hfm hw₃m u F h hu (dstar : ZMod q₀) (nstar : ZMod q₀)
    let coeff' : ℤ → ℤ → ℂ := fun d n =>
      if Int.ModEq (q₀ : ℤ) d (ds.val : ℤ) ∧ Int.ModEq (q₀ : ℤ) n (ns.val : ℤ) ∧
          Int.gcd d (m : ℤ) = 1 ∧
          Int.gcd (u * (w₃ : ℤ) * n + (u * h + F * (f : ℤ)) * d) (c₁ : ℤ) = 1 ∧
          Int.gcd (v * (w₃ : ℤ) * n + (v * h + G * (f : ℤ)) * d) (c₁ : ℤ) = 1 ∧
          Int.gcd (u * (w₃ : ℤ) * n + (u * h + (F + ell) * (f : ℤ)) * d)
            (c₂ : ℤ) = 1 ∧
          Int.gcd (v * (w₃ : ℤ) * n + (v * h + (G + ell) * (f : ℤ)) * d)
            (c₂ : ℤ) = 1 then
        affineReciprocalProductPhase m ((w₂ : ZMod m) * A₁') B' L' 0 0
          (n : ZMod m) (d : ZMod m)
      else 0
    have hcoeff' (d n : ℤ) : ‖coeff' d n‖ ≤ 1 := by
      dsimp only [coeff']
      split_ifs
      · exact norm_affineReciprocalProductPhase_le_one _ _ _ _ _ _ _ _
      · simp
    have hpoint (z : ℤ × ℤ) : (Hdiv ∘ T) z =
        coeff' z.1 z.2 * φ (((f : ℝ) * (z.1 : ℝ) - d₀) / D) *
          ψ (((w₃ : ℝ) * (z.2 : ℝ) + (h : ℝ) * (z.1 : ℝ) - n₀) / N) := by
      have hclass := (hclasses z.1 z.2).2
      change (((((f : ℤ) * z.1 : ℤ) : ZMod q₀) = (dstar : ZMod q₀) ∧
          ((u * ((w₃ : ℤ) * z.2 + h * z.1) + F * ((f : ℤ) * z.1) : ℤ) :
            ZMod q₀) = (nstar : ZMod q₀)) ↔
        (z.1 : ZMod q₀) = ds ∧ (z.2 : ZMod q₀) = ns) at hclass
      have hclass' :
          (Int.ModEq (q₀ : ℤ) ((f : ℤ) * z.1) dstar ∧
            Int.ModEq (q₀ : ℤ) (u * ((w₃ : ℤ) * z.2 + h * z.1) +
              F * ((f : ℤ) * z.1)) nstar) ↔
          Int.ModEq (q₀ : ℤ) z.1 (ds.val : ℤ) ∧
            Int.ModEq (q₀ : ℤ) z.2 (ns.val : ℤ) := by
        simpa only [← ZMod.intCast_eq_intCast_iff, Int.cast_natCast, ZMod.natCast_zmod_val]
          using hclass
      have hg := (hclasses z.1 z.2).1
      have hph := (hphase z.1 z.2).2
      change affineReciprocalProductPhase m ((w₂ : ZMod m) * A₁) B L 0 0
          (((w₃ : ℤ) * z.2 + h * z.1 : ℤ) : ZMod m) (((f : ℤ) * z.1 : ℤ) : ZMod m) =
        affineReciprocalProductPhase m ((w₂ : ZMod m) * A₁') B' L' 0 0
          (z.2 : ZMod m) (z.1 : ZMod m) at hph
      dsimp only [Function.comp_apply, Hdiv]
      rw [ite_eq_left (hTdiv z)]
      dsimp only [W, coeff, T, coeff']
      simp only [← and_assoc, hclass', hg]
      simp only [mul_add, add_mul, mul_assoc, add_assoc]
      split_ifs
      · rw [hph]
        simp only [Int.cast_mul, Int.cast_natCast, Int.cast_add]
      · simp only [zero_mul]
    let D₂ : ℝ := D / (f : ℝ)
    let N₂ : ℝ := N / (w₃ : ℝ)
    let dc : ℝ := d₀ / (f : ℝ)
    let nc : ℝ := (n₀ - (h : ℝ) * d₀ / (f : ℝ)) / (w₃ : ℝ)
    let η : ℝ := (h : ℝ) * D₂ / N
    let BD₂ : Finset ℤ := Finset.Icc ⌈dc - TD * D₂⌉ ⌊dc + TD * D₂⌋
    let BI₂ : Finset ℤ := Finset.Icc ⌈nc - (TN + TD) * N₂⌉ ⌊nc + (TN + TD) * N₂⌋
    have hD₂ : 0 < D₂ := div_pos hD hfR
    have hN₂ : 0 < N₂ := div_pos hN hwR
    have hD₂D : D₂ ≤ D := div_le_self hD.le hf1
    have hN₂N : N₂ ≤ N := div_le_self hN.le hw1
    have hη : |η| ≤ 2 * x ^ (-(5 * ε)) := by
      rw [abs_of_nonneg (by dsimp only [η]; positivity)]
      calc
        η ≤ (w : ℝ) * D / N :=
          div_le_div_of_nonneg_right
            (mul_le_mul hhRw hD₂D hD₂.le (Nat.cast_nonneg _)) hN.le
        _ ≤ _ := hsmall
    obtain ⟨hηone, herr⟩ := hrem x hxR φ ψ hφ hψ hφsupp hψsupp hφbound hψbound
      (f : ℝ) 1 (w₃ : ℝ) D N hfR zero_lt_one hwR hD hN
      (h : ℝ) n₀ d₀ (by simpa using hD₂D.trans hDx) (hN₂N.trans hNx)
      (by simpa [η, D₂] using hη) BD₂ BI₂ coeff' (fun d _ n _ => hcoeff' d n)
    simp only [one_mul] at hηone
    simp only [one_mul, div_one] at herr
    let dStar : ℕ → ℝ → ℂ := fun j t =>
      ((η * t) ^ j / (Nat.factorial j : ℝ)) • φ t
    let nStar : ℕ → ℝ → ℂ := fun j t => iteratedDeriv j ψ t
    let M : ℤ × ℤ → ℂ := fun z => coeff' z.1 z.2 *
      φ (((f : ℝ) * (z.1 : ℝ) - d₀) / D) *
        ψ (((w₃ : ℝ) * (z.2 : ℝ) + (h : ℝ) * (z.1 : ℝ) - n₀) / N)
    let S : ℕ → ℤ × ℤ → ℂ := fun j z => coeff' z.1 z.2 *
      dStar j (((z.1 : ℝ) - dc) / D₂) * nStar j (((z.2 : ℝ) - nc) / N₂)
    have hMsum : HasSum M V := htrans.congr_fun fun z => (hpoint z).symm
    obtain ⟨-, -, -, -, -, -, hzero, -⟩ := sourceShortShearTaylor_finite_separation
      J φ ψ ((contDiff_infty.mp hψ) (J + 1)) TD TN hTD hTN hφsupp hψsupp
      (f : ℝ) 1 (w₃ : ℝ) D N hfR zero_lt_one hwR hD hN
      (h : ℝ) n₀ d₀ (by simpa [η, D₂] using hηone) BD₂ BI₂ coeff'
    have hMzero (z : ℤ × ℤ) (hz : z ∉ BD₂ ×ˢ BI₂) : M z = 0 := by
      have hz' : z.1 ∉ BD₂ ∨ z.2 ∉ BI₂ := by
        simpa only [Finset.mem_product, not_and_or] using hz
      have heq := (hzero z.1 z.2 (by simpa [BD₂, BI₂, dc, nc, D₂, N₂] using hz')).1
      dsimp only [M]
      rw [mul_assoc]
      simpa only [div_one, one_mul, mul_zero] using congrArg (coeff' z.1 z.2 * ·) heq
    have hMbox : HasSum M (∑ d ∈ BD₂, ∑ n ∈ BI₂, M (d, n)) := by
      simpa only [Finset.sum_product] using hasSum_sum_of_ne_finset_zero hMzero
    have hVbox : V = ∑ d ∈ BD₂, ∑ n ∈ BI₂, M (d, n) := hMsum.unique hMbox
    change ‖(∑ d ∈ BD₂, ∑ n ∈ BI₂, M (d, n)) -
      ∑ j ∈ Finset.range (J + 1), ∑ d ∈ BD₂, ∑ n ∈ BI₂, S j (d, n)‖ ≤ x ^ (-b) at herr
    have hterm (j : ℕ) (hj : j ∈ Finset.range (J + 1)) :
        ‖∑ d ∈ BD₂, ∑ n ∈ BI₂, S j (d, n)‖ ≤ x ^ ε * R := by
      have hjJ : j ≤ J := Nat.lt_succ_iff.mp (Finset.mem_range.mp hj)
      obtain ⟨hdsm, hnsm, hdsup, hnsup, hsb, -⟩ :=
        hstar x hxexp φ ψ hφ hψ hφsupp hψsupp hφbound hψbound η hηone j hjJ
      change ContDiff ℝ ∞ (dStar j) at hdsm
      change ContDiff ℝ ∞ (nStar j) at hnsm
      have hdsb : ∀ r t, ‖iteratedDeriv r (dStar j) t‖ ≤ Cs r * (Real.log x) ^ Es r :=
        fun r t => (hsb r t).1
      have hnsb : ∀ r t, ‖iteratedDeriv r (nStar j) t‖ ≤ Cs r * (Real.log x) ^ Es r :=
        fun r t => (hsb r t).2
      have hc := hcomplete x hxC m q₀ c₁ c₂ f w₃ hm hmx hq₀ hc₁ hc₂
        u v F G h ell (ds.val : ℤ) (ns.val : ℤ) hu hv hw₃m
        ((w₂ : ZMod m) * A₁') B' L' D₂ N₂ dc nc hD₂ hN₂
        (dStar j) (nStar j) ((contDiff_infty.mp hdsm) 1)
        ((contDiff_infty.mp hnsm) 1) hdsup hnsup
        (hprofile _ hdsb) (hprofile _ hnsb)
      have hSzero (z : ℤ × ℤ) (hz : z ∉ BD₂ ×ˢ BI₂) : S j z = 0 := by
        have hz' : z.1 ∉ BD₂ ∨ z.2 ∉ BI₂ := by
          simpa only [Finset.mem_product, not_and_or] using hz
        have heq := (hzero z.1 z.2 (by simpa [BD₂, BI₂, dc, nc, D₂, N₂] using hz')).2.1 j hjJ
        dsimp only [S]
        rw [mul_assoc]
        simpa only [one_mul, mul_zero] using congrArg (coeff' z.1 z.2 * ·) heq
      have hs : HasSum (S j) (∑ d ∈ BD₂, ∑ n ∈ BI₂, S j (d, n)) := by
        simpa only [Finset.sum_product] using hasSum_sum_of_ne_finset_zero hSzero
      have hcs : HasSum (S j) _ := hc.1.congr_fun fun z => by
        dsimp only [S, coeff']
        split_ifs
        · ac_rfl
        · simp only [zero_mul]
      have heq := hs.unique hcs
      rw [heq]
      refine hc.2.trans ?_
      rw [Nat.gcd_comm m, hgcd]
      change x ^ ε * (Int.gcd Jnum (m : ℤ) : ℝ) * P * (1 / (q₀ : ℝ)) *
          (Real.sqrt (m : ℝ) + N₂ / Real.sqrt (m : ℝ)) *
          (Real.sqrt (m : ℝ) + D₂ / Real.sqrt (m : ℝ)) ≤ x ^ ε * R
      have hgeom :
          (Real.sqrt (m : ℝ) + N₂ / Real.sqrt (m : ℝ)) *
              (Real.sqrt (m : ℝ) + D₂ / Real.sqrt (m : ℝ)) ≤
            (Real.sqrt (m : ℝ) + N / Real.sqrt (m : ℝ)) *
              (Real.sqrt (m : ℝ) + D / Real.sqrt (m : ℝ)) :=
        mul_le_mul
          (add_le_add le_rfl (div_le_div_of_nonneg_right hN₂N hsqrt.le))
          (add_le_add le_rfl (div_le_div_of_nonneg_right hD₂D hsqrt.le))
          (by positivity) (by positivity)
      calc
        _ = (x ^ ε * (Int.gcd Jnum (m : ℤ) : ℝ) * P * (1 / (q₀ : ℝ))) *
            ((Real.sqrt (m : ℝ) + N₂ / Real.sqrt (m : ℝ)) *
              (Real.sqrt (m : ℝ) + D₂ / Real.sqrt (m : ℝ))) := by ac_rfl
        _ ≤ _ := mul_le_mul_of_nonneg_left hgeom (by positivity)
        _ = x ^ ε * R := by
          dsimp only [R]
          rw [add_comm (N / _), add_comm (D / _)]
          ac_rfl
    change ‖V‖ ≤ _
    rw [hVbox]
    calc
      _ ≤ ‖∑ j ∈ Finset.range (J + 1), ∑ d ∈ BD₂, ∑ n ∈ BI₂, S j (d, n)‖ +
          ‖(∑ d ∈ BD₂, ∑ n ∈ BI₂, M (d, n)) -
            ∑ j ∈ Finset.range (J + 1), ∑ d ∈ BD₂, ∑ n ∈ BI₂, S j (d, n)‖ :=
        norm_le_norm_add_norm_sub' _ _
      _ ≤ (∑ j ∈ Finset.range (J + 1), x ^ ε * R) + x ^ (-b) :=
        add_le_add (norm_sum_le_of_le _ hterm) herr
      _ = ((J : ℝ) + 1) * x ^ ε * R + x ^ (-b) := by
        simp only [Finset.sum_const, Finset.card_range, nsmul_eq_mul, Nat.cast_add,
          Nat.cast_one, mul_assoc]
  have htotal : total =
      ∑ f₁ ∈ a.divisors, ∑ f₂ ∈ w.divisors, ∑ f₃ ∈ w.divisors,
        ((ArithmeticFunction.moebius f₁ : ℤ) : ℂ) *
          ((ArithmeticFunction.moebius f₂ : ℤ) : ℂ) *
          ((ArithmeticFunction.moebius f₃ : ℤ) : ℂ) *
          ∑ z ∈ (BD ×ˢ BN).filter (fun z : ℤ × ℤ =>
            (f₁ : ℤ) ∣ z.1 ∧ (f₂ : ℤ) ∣ u * z.2 + F * z.1 ∧
              (f₃ : ℤ) ∣ v * z.2 + G * z.1), W z.1 z.2 := by
    rw [← sourceTerminalMobius_finite_expansion a w ha hw u v F G (BD ×ˢ BN) W]
    simp only [total, ← Finset.sum_product, hHpoint, Finset.sum_filter]
  have hμ (n : ℕ) : ‖((ArithmeticFunction.moebius n : ℤ) : ℂ)‖ ≤ 1 := by
    rw [Complex.norm_intCast]
    exact_mod_cast (ArithmeticFunction.abs_moebius_le_one (n := n))
  have hmajor0 : 0 ≤ ((J : ℝ) + 1) * x ^ ε * R + x ^ (-b) := by positivity
  have hbound : ‖total‖ ≤ (a.divisors.card : ℝ) * (w.divisors.card : ℝ) ^ 2 *
      (((J : ℝ) + 1) * x ^ ε * R + x ^ (-b)) := by
    rw [htotal]
    calc
      _ ≤ ∑ f₁ ∈ a.divisors, ∑ f₂ ∈ w.divisors, ∑ f₃ ∈ w.divisors,
          (((J : ℝ) + 1) * x ^ ε * R + x ^ (-b)) := by
        refine norm_sum_le_of_le _ fun f₁ hf₁ => norm_sum_le_of_le _ fun f₂ hf₂ =>
          norm_sum_le_of_le _ fun f₃ hf₃ => ?_
        rw [norm_mul, norm_mul, norm_mul]
        calc
          _ ≤ (1 * 1 * 1) * (((J : ℝ) + 1) * x ^ ε * R + x ^ (-b)) := by
            exact mul_le_mul
              (mul_le_mul (mul_le_mul (hμ f₁) (hμ f₂) (norm_nonneg _) zero_le_one)
                (hμ f₃) (norm_nonneg _) (by norm_num))
              (hdivisor f₁ hf₁ f₂ hf₂ f₃ hf₃) (norm_nonneg _) (by norm_num)
          _ = _ := by simp only [one_mul]
      _ = _ := by simp only [Finset.sum_const, nsmul_eq_mul, pow_two, mul_assoc]
  refine ⟨hsum, ?_⟩
  calc
    ‖total‖ ≤ x ^ ε * (((J : ℝ) + 1) * x ^ ε * R + x ^ (-b)) :=
      hbound.trans (mul_le_mul_of_nonneg_right hτcount hmajor0)
    _ = ((J : ℝ) + 1) * x ^ (2 * ε) * R + x ^ (ε - b) := by
      rw [two_mul ε, Real.rpow_add hx0,
        Real.rpow_sub hx0, Real.rpow_neg hx0.le]
      ring
    _ ≤ ((J : ℝ) + 2) * x ^ (2 * ε) * R := by
      have hsmallpow : x ^ (ε - b) ≤ 1 :=
        Real.rpow_le_one_of_one_le_of_nonpos hx1 (by dsimp [b]; linarith)
      have hone : 1 ≤ x ^ (2 * ε) * R :=
        one_le_mul_of_one_le_of_one_le (Real.one_le_rpow hx1 (by positivity)) hR
      nlinarith only [hsmallpow, hone]
    _ = _ := by dsimp only [R]; ac_rfl

open Classical in
theorem sourceTerminalSigma6_uniform_kl3_max_bound
    (Csrc ε cD CD cN CN : ℝ)
    (hCsrc : 0 ≤ Csrc) (hε : 0 < ε)
    (hcD : 0 < cD) (hCD : cD ≤ CD) (hcN : 0 < cN) (hCN : cN ≤ CN)
    (Cφ Eφ Cψ Eψ : ℕ → ℝ)
    (hCφ : ∀ r : ℕ, 0 ≤ Cφ r) (hCψ : ∀ r : ℕ, 0 ≤ Cψ r) :
    ∃ «CΣ» X₀ : ℝ, 0 < «CΣ» ∧ Real.exp 1 ≤ X₀ ∧
      ∀ (x : ℝ), X₀ ≤ x →
      ∀ (m q₀ c₁ c₂ w₁ w₂ z₁ : ℕ) (hm : Squarefree m),
      (m : ℝ) ≤ x ^ Csrc →
      q₀ ∣ m → c₁ ∣ m → c₂ ∣ m →
      0 < w₁ → Squarefree w₁ → 0 < z₁ → w₁ ∣ z₁ → Nat.Coprime z₁ m →
      (w₁ : ℝ) ≤ x ^ Csrc →
      ∀ (lam lamTilde k ell A B d₀ dstar nstar : ℤ),
      ∀ (Λ Δ₁ N : ℝ), Λ ≠ 0 → 0 < Δ₁ → 0 < N → 0 ≤ d₀ →
      |Λ| ≤ x ^ Csrc → Δ₁ ≤ x ^ Csrc → N ≤ x ^ Csrc →
      (1 ≤ (lam : ℝ) / Λ ∧ (lam : ℝ) / Λ < 2) →
      (1 ≤ (lamTilde : ℝ) / Λ ∧ (lamTilde : ℝ) / Λ < 2) →
      w₂ = ∏ p ∈ m.primeFactors, p ^ (lam.natAbs.factorization p) →
      w₂ = ∏ p ∈ m.primeFactors, p ^ (lamTilde.natAbs.factorization p) →
      Int.gcd (((z₁ / w₁ : ℕ) : ℤ)) ((m : ℤ) * lam * lamTilde) = 1 →
      IsUnit (A : ZMod m) →
      ∀ (φ ψ : ℝ → ℂ), ContDiff ℝ ∞ φ → ContDiff ℝ ∞ ψ →
      Function.support φ ⊆ Set.Icc cD CD →
      Function.support ψ ⊆ Set.Icc cN CN →
      (∀ (r : ℕ) (t : ℝ), ‖iteratedDeriv r φ t‖ ≤ Cφ r * (Real.log x) ^ Eφ r) →
      (∀ (r : ℕ) (t : ℝ), ‖iteratedDeriv r ψ t‖ ≤ Cψ r * (Real.log x) ^ Eψ r) →
      letI : NeZero m := ⟨hm.ne_zero⟩
      let s : ℤ := ((z₁ / w₁ : ℕ) : ℤ)
      let g : ℕ := Int.gcd lam lamTilde
      let Jk : ℤ := s * k + (lam - lamTilde) * B
      let nk : ℤ → ℤ → ℤ := fun n d => (lamTilde * n + s * k * d) / lam
      let Δstar : ℝ := min (N / (|Λ| * x ^ (5 * ε))) Δ₁
      let K : (p : m.primeFactors) → ℝ := fun p =>
        letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
        (Finset.univ : Finset (ZMod p.1)).sup' Finset.univ_nonempty
          (fun c => ‖normalizedKloosterman3 p.1 c‖)
      let BD : Finset ℤ :=
        Finset.Icc ⌈((d₀ : ℝ) + cD * Δ₁) / (z₁ : ℝ)⌉
          ⌊((d₀ : ℝ) + CD * Δ₁) / (z₁ : ℝ)⌋
      let BN : Finset ℤ := Finset.Icc ⌈cN * N⌉ ⌊CN * N⌋
      let H : ℤ × ℤ → ℂ := fun z =>
        if Int.ModEq (q₀ : ℤ) z.1 dstar ∧ Int.ModEq (q₀ : ℤ) z.2 nstar ∧
            Int.gcd z.1 ((m : ℤ) * lam * lamTilde) = 1 ∧
            lam ∣ lamTilde * z.2 + s * k * z.1 ∧
            Int.gcd (z.2 * nk z.2 z.1) ((w₁ * c₁ : ℕ) : ℤ) = 1 ∧
            Int.gcd ((z.2 + ell * z.1) * (nk z.2 z.1 + ell * z.1)) (c₂ : ℤ) = 1
        then
          φ (((z₁ : ℝ) * (z.1 : ℝ) - (d₀ : ℝ)) / Δ₁) * ψ ((z.2 : ℝ) / N) *
            reciprocalUnitPhase m ((A : ZMod m) * (Jk : ZMod m))
              (((z.2 + B * z.1 : ℤ) : ZMod m) *
                ((nk z.2 z.1 + B * z.1 : ℤ) : ZMod m))
        else 0
      let total : ℂ := ∑ d ∈ BD, ∑ n ∈ BN, H (d, n)
      HasSum H total ∧
        (¬ (g : ℤ) ∣ s * k → total = 0) ∧
        ‖total‖ ≤ «CΣ» * x ^ (3 * ε) * (Int.gcd Jk (m : ℤ) : ℝ) *
          (∏ p : m.primeFactors, max 1 (K p)) * (1 / (q₀ : ℝ)) *
          (Δ₁ / Δstar) *
          (N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
          (Δstar / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) := by
  have hCD0 : 0 < CD := hcD.trans_le hCD
  have hCN0 : 0 < CN := hcN.trans_le hCN
  let b : ℝ := 1 + ε
  let J : ℕ := ⌈(b + 2 * Csrc + 2) / (5 * ε)⌉₊
  have hb : 0 < b := by dsimp [b]; positivity
  obtain ⟨Cp, Ep, hCp, hpartProfiles⟩ :=
    sourceShortSmoothPartition_uniform_source_profiles CD hCD0.le Cφ Eφ hCφ
  obtain ⟨Cs, Es, hCs, hstar⟩ := sourceShortShearTaylor_uniform_star_profiles
    J (1 / 2) CN (by norm_num) Cp Ep Cψ Eψ (fun r => (hCp r).1.le) hCψ
  obtain ⟨XR, hXR, hrem⟩ := sourceShortShearTaylor_uniform_finite_remainder
    ε b Csrc (1 / 2) CN hε hb hCsrc (by norm_num) hCN0.le
    Cp Ep Cψ Eψ (fun r => (hCp r).1.le) hCψ
  obtain ⟨CO, XO, hCO, -, houtside⟩ := sourceTerminalSigma6_outside_uniform_bound
    Csrc ε (1 / 2) CN hCsrc hε (by norm_num) hCN0.le
    Cs Es Cs Es (fun r => (hCs r).1.le) (fun r => (hCs r).1.le)
  let «CΣ» : ℝ := (4 * CD + 2) * (((J : ℝ) + 1) * CO + 1)
  have hSigmaPos : 0 < «CΣ» := by dsimp only [«CΣ»]; positivity
  refine ⟨«CΣ», max XR XO, hSigmaPos, hXR.trans (le_max_left _ _), ?_⟩
  intro x hx m q₀ c₁ c₂ w₁ w₂ z₁ hm hmx hq₀ hc₁ hc₂ hw₁ hsfw₁ hz₁ hwz hzm hwx
    lam lamTilde k ell A B d₀ dstar nstar Λ Δ₁ N hΛ hΔ₁ hN hd₀ hΛx hΔx hNx
    hlamRange hlamTildeRange hwlamSource hwlamTildeSource hsm hA
    φ ψ hφ hψ hφsupp hψsupp hφbound hψbound
  let : NeZero m := ⟨hm.ne_zero⟩
  have hxR : XR ≤ x := (le_max_left XR XO).trans hx
  have hxO : XO ≤ x := (le_max_right XR XO).trans hx
  have hxexp : Real.exp 1 ≤ x := hXR.trans hxR
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hx1 : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hxexp
  have hzR : (0 : ℝ) < z₁ := by exact_mod_cast hz₁
  have hz1 : (1 : ℝ) ≤ z₁ := by exact_mod_cast hz₁
  have hwzR : (w₁ : ℝ) ≤ z₁ := by exact_mod_cast Nat.le_of_dvd hz₁ hwz
  have hwm : Nat.Coprime w₁ m := hzm.of_dvd_left hwz
  have hΛabs : 0 < |Λ| := abs_pos.mpr hΛ
  have hlam : lam ≠ 0 := by
    intro heq
    simp only [heq, Int.cast_zero, zero_div] at hlamRange
    linarith [hlamRange.1]
  have hlamTilde : lamTilde ≠ 0 := by
    intro heq
    simp only [heq, Int.cast_zero, zero_div] at hlamTildeRange
    linarith [hlamTildeRange.1]
  have hlamAbsBound : |(lam : ℝ)| < 2 * |Λ| := by
    have hrat : |(lam : ℝ)| / |Λ| < 2 := by
      rw [← abs_div, abs_of_nonneg (zero_le_one.trans hlamRange.1)]
      exact hlamRange.2
    exact (div_lt_iff₀ hΛabs).mp hrat
  have hlamTildeAbsBound : |(lamTilde : ℝ)| < 2 * |Λ| := by
    have hrat : |(lamTilde : ℝ)| / |Λ| < 2 := by
      rw [← abs_div, abs_of_nonneg (zero_le_one.trans hlamTildeRange.1)]
      exact hlamTildeRange.2
    exact (div_lt_iff₀ hΛabs).mp hrat
  let s : ℤ := ((z₁ / w₁ : ℕ) : ℤ)
  let g : ℕ := Int.gcd lam lamTilde
  let Jk : ℤ := s * k + (lam - lamTilde) * B
  let nk : ℤ → ℤ → ℤ := fun n d => (lamTilde * n + s * k * d) / lam
  let Δstar : ℝ := min (N / (|Λ| * x ^ (5 * ε))) Δ₁
  let K : (p : m.primeFactors) → ℝ := fun p =>
    letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
    (Finset.univ : Finset (ZMod p.1)).sup' Finset.univ_nonempty
      (fun c => ‖normalizedKloosterman3 p.1 c‖)
  let P : ℝ := ∏ p : m.primeFactors, max 1 (K p)
  have hP : 1 ≤ P := Finset.one_le_prod fun p _ => le_max_left _ _
  let BD : Finset ℤ := Finset.Icc
    ⌈((d₀ : ℝ) + cD * Δ₁) / (z₁ : ℝ)⌉ ⌊((d₀ : ℝ) + CD * Δ₁) / (z₁ : ℝ)⌋
  let BN : Finset ℤ := Finset.Icc ⌈cN * N⌉ ⌊CN * N⌋
  let H : ℤ × ℤ → ℂ := fun z =>
    if Int.ModEq (q₀ : ℤ) z.1 dstar ∧ Int.ModEq (q₀ : ℤ) z.2 nstar ∧
        Int.gcd z.1 ((m : ℤ) * lam * lamTilde) = 1 ∧
        lam ∣ lamTilde * z.2 + s * k * z.1 ∧
        Int.gcd (z.2 * nk z.2 z.1) ((w₁ * c₁ : ℕ) : ℤ) = 1 ∧
        Int.gcd ((z.2 + ell * z.1) * (nk z.2 z.1 + ell * z.1)) (c₂ : ℤ) = 1 then
      φ (((z₁ : ℝ) * (z.1 : ℝ) - (d₀ : ℝ)) / Δ₁) * ψ ((z.2 : ℝ) / N) *
        reciprocalUnitPhase m ((A : ZMod m) * (Jk : ZMod m))
          (((z.2 + B * z.1 : ℤ) : ZMod m) *
            ((nk z.2 z.1 + B * z.1 : ℤ) : ZMod m))
    else 0
  let total : ℂ := ∑ d ∈ BD, ∑ n ∈ BN, H (d, n)
  let R : ℝ := (Int.gcd Jk (m : ℤ) : ℝ) * P * (1 / (q₀ : ℝ)) *
    (N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
    (Δstar / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ))
  change HasSum H total ∧ (¬ (g : ℤ) ∣ s * k → total = 0) ∧
    ‖total‖ ≤ «CΣ» * x ^ (3 * ε) * (Int.gcd Jk (m : ℤ) : ℝ) * P *
      (1 / (q₀ : ℝ)) * (Δ₁ / Δstar) *
      (N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
      (Δstar / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ))
  have hφbox : Function.support φ ⊆ Set.Icc (-CD) CD :=
    hφsupp.trans (Set.Icc_subset_Icc_left
      ((neg_nonpos.mpr hCD0.le).trans hcD.le))
  have hψbox : Function.support ψ ⊆ Set.Icc (-CN) CN :=
    hψsupp.trans (Set.Icc_subset_Icc_left
      ((neg_nonpos.mpr hCN0.le).trans hcN.le))
  have hweightsBox (d n : ℤ)
      (hd : φ (((z₁ : ℝ) * (d : ℝ) - (d₀ : ℝ)) / Δ₁) ≠ 0)
      (hn : ψ ((n : ℝ) / N) ≠ 0) : (d, n) ∈ BD ×ˢ BN := by
    have hd' := hφsupp hd
    have hn' := hψsupp hn
    have hdl := (le_div_iff₀ hΔ₁).mp hd'.1
    have hdu := (div_le_iff₀ hΔ₁).mp hd'.2
    have hnl := (le_div_iff₀ hN).mp hn'.1
    have hnu := (div_le_iff₀ hN).mp hn'.2
    exact Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr
      ⟨Int.ceil_le.mpr ((div_le_iff₀ hzR).mpr (by linarith)),
        Int.le_floor.mpr ((le_div_iff₀ hzR).mpr (by linarith))⟩,
      Finset.mem_Icc.mpr
        ⟨Int.ceil_le.mpr hnl, Int.le_floor.mpr hnu⟩⟩
  have hsum : HasSum H total := by
    have hs : HasSum H (∑ z ∈ BD ×ˢ BN, H z) := by
      apply hasSum_sum_of_ne_finset_zero
      intro z hz
      dsimp only [H]
      split_ifs
      · by_contra hne
        have hweights := mul_ne_zero_iff.mp (mul_ne_zero_iff.mp hne).1
        exact hz (hweightsBox z.1 z.2 hweights.1 hweights.2)
      · rfl
    simpa only [total, Finset.sum_product] using hs
  let σ : ℤ := if 0 < lam then 1 else -1
  let la : ℤ := σ * lam
  let lt : ℤ := σ * lamTilde
  let ks : ℤ := σ * k
  let As : ℤ := σ * A
  let Js : ℤ := s * ks + (la - lt) * B
  let nts : ℤ → ℤ → ℤ := fun n d => (lt * n + s * ks * d) / la
  obtain ⟨hσsq, hla, hgsgn, -, hJgcd, hsign⟩ :=
    sourceTerminalHomogeneous_sign_normalization m lam lamTilde s k A B hlam
  change σ ^ 2 = 1 at hσsq
  change 0 < la at hla
  change Int.gcd la lt = g at hgsgn
  change Int.gcd Js (m : ℤ) = Int.gcd Jk (m : ℤ) at hJgcd
  have hσne : σ ≠ 0 := by intro heq; simp [heq] at hσsq
  have hlt : lt ≠ 0 := mul_ne_zero hσne hlamTilde
  have hlaAbs : la.natAbs = lam.natAbs := by
    dsimp only [la, σ]
    split_ifs <;> simp
  have hltAbs : lt.natAbs = lamTilde.natAbs := by
    dsimp only [lt, σ]
    split_ifs <;> simp
  have hlaR : (0 : ℝ) < la := by exact_mod_cast hla
  have hlaBound : (la : ℝ) < 2 * |Λ| := by
    have hcast : (la : ℝ) = |(lam : ℝ)| := by
      have hh := congrArg (fun n : ℕ => (n : ℝ)) hlaAbs
      simpa only [Nat.cast_natAbs, Int.cast_abs, abs_of_pos hlaR] using hh
    simpa only [hcast] using hlamAbsBound
  have hproduct : (m : ℤ) * la * lt = (m : ℤ) * lam * lamTilde := by
    dsimp only [la, lt]
    linear_combination (m : ℤ) * lam * lamTilde * hσsq
  have hgsign : (g : ℤ) ∣ s * ks ↔ (g : ℤ) ∣ s * k := by
    dsimp only [ks, σ]
    split_ifs <;> simp
  have hAs : IsUnit (As : ZMod m) := by
    dsimp only [As, σ]
    split_ifs <;> simpa using hA
  have hwla : w₂ = ∏ p ∈ m.primeFactors, p ^ la.natAbs.factorization p := by
    simpa only [hlaAbs] using hwlamSource
  have hwlt : w₂ = ∏ p ∈ m.primeFactors, p ^ lt.natAbs.factorization p := by
    simpa only [hltAbs] using hwlamTildeSource
  let a : ℕ := ((la / (w₂ : ℤ)) * (lt / (w₂ : ℤ))).natAbs
  obtain ⟨ha, ham, hmask⟩ :=
    sourceTerminal_full_supported_part_mask m w₂ la lt hm.ne_zero hla.ne' hlt hwla hwlt
  change 0 < a at ha
  change Nat.Coprime a m at ham
  change ∀ d : ℤ, Int.gcd d ((m : ℤ) * la * lt) = 1 ↔
    Int.gcd d (m : ℤ) = 1 ∧ Int.gcd d (a : ℤ) = 1 at hmask
  obtain ⟨hw₂, hwlaNat, -, hlaCop, -⟩ :=
    primeFactors_prod_pow_factorization_dvd_and_coprime_div m la.natAbs hm.ne_zero
      (Int.natAbs_ne_zero.mpr hla.ne')
  obtain ⟨-, hwltNat, -, hltCop, -⟩ :=
    primeFactors_prod_pow_factorization_dvd_and_coprime_div m lt.natAbs hm.ne_zero
      (Int.natAbs_ne_zero.mpr hlt)
  rw [← hwla] at hw₂ hwlaNat hlaCop
  rw [← hwlt] at hwltNat hltCop
  have hwlaI : (w₂ : ℤ) ∣ la := Int.natCast_dvd.mpr hwlaNat
  have hwltI : (w₂ : ℤ) ∣ lt := Int.natCast_dvd.mpr hwltNat
  have hunit (z : ℤ) (hwz : (w₂ : ℤ) ∣ z)
      (hc : Nat.Coprime (z.natAbs / w₂) m) : IsUnit ((z / (w₂ : ℤ) : ℤ) : ZMod m) := by
    rw [ZMod.coe_int_isUnit_iff_isCoprime, Int.isCoprime_iff_gcd_eq_one,
      Int.gcd_def, Int.natAbs_natCast, Int.natAbs_ediv_of_dvd hwz, Int.natAbs_natCast]
    exact hc.symm.gcd_eq_one
  have hlaUnit := hunit la hwlaI hlaCop
  have hltUnit := hunit lt hwltI hltCop
  have hax : (a : ℝ) ≤ 4 * x ^ (2 * Csrc) := by
    have hqla : (la / (w₂ : ℤ)).natAbs ≤ la.natAbs := by
      rw [Int.natAbs_ediv_of_dvd hwlaI, Int.natAbs_natCast]
      exact Nat.div_le_self _ _
    have hqlt : (lt / (w₂ : ℤ)).natAbs ≤ lt.natAbs := by
      rw [Int.natAbs_ediv_of_dvd hwltI, Int.natAbs_natCast]
      exact Nat.div_le_self _ _
    have hqlaR : ((la / (w₂ : ℤ)).natAbs : ℝ) ≤ |(lam : ℝ)| := by
      calc
        ((la / (w₂ : ℤ)).natAbs : ℝ) ≤ (lam.natAbs : ℝ) := by
          exact_mod_cast hqla.trans_eq hlaAbs
        _ = |(lam : ℝ)| := by rw [Nat.cast_natAbs, Int.cast_abs]
    have hqltR : ((lt / (w₂ : ℤ)).natAbs : ℝ) ≤ |(lamTilde : ℝ)| := by
      calc
        ((lt / (w₂ : ℤ)).natAbs : ℝ) ≤ (lamTilde.natAbs : ℝ) := by
          exact_mod_cast hqlt.trans_eq hltAbs
        _ = |(lamTilde : ℝ)| := by rw [Nat.cast_natAbs, Int.cast_abs]
    calc
      (a : ℝ) ≤ |(lam : ℝ)| * |(lamTilde : ℝ)| := by
        dsimp only [a]
        rw [Int.natAbs_mul, Nat.cast_mul]
        exact mul_le_mul hqlaR hqltR (Nat.cast_nonneg _) (abs_nonneg _)
      _ ≤ (2 * |Λ|) * (2 * |Λ|) :=
        mul_le_mul hlamAbsBound.le hlamTildeAbsBound.le (abs_nonneg _) (by positivity)
      _ ≤ (2 * x ^ Csrc) * (2 * x ^ Csrc) := by gcongr
      _ = 4 * x ^ (2 * Csrc) := by
        rw [two_mul Csrc, Real.rpow_add hx0]
        ring
  let Cn : ℤ → ℤ → ℂ := fun d n =>
    if Int.ModEq (q₀ : ℤ) d dstar ∧ Int.ModEq (q₀ : ℤ) n nstar ∧
        Int.gcd d ((m : ℤ) * la * lt) = 1 ∧
        la ∣ lt * n + s * ks * d ∧
        Int.gcd (n * nts n d) ((w₁ * c₁ : ℕ) : ℤ) = 1 ∧
        Int.gcd ((n + ell * d) * (nts n d + ell * d)) (c₂ : ℤ) = 1 then
      reciprocalUnitPhase m ((As : ZMod m) * (Js : ZMod m))
        (((n + B * d : ℤ) : ZMod m) * ((nts n d + B * d : ℤ) : ZMod m))
    else 0
  have hnormalized (d n : ℤ) : H (d, n) =
      Cn d n * φ (((z₁ : ℝ) * (d : ℝ) - (d₀ : ℝ)) / Δ₁) * ψ ((n : ℝ) / N) := by
    have hdiv := (hsign n d).1
    change (la ∣ lt * n + s * ks * d ↔ lam ∣ lamTilde * n + s * k * d) at hdiv
    by_cases hd : lam ∣ lamTilde * n + s * k * d
    · obtain ⟨hnt, hph⟩ := (hsign n d).2 hd
      change nts n d = nk n d at hnt
      change reciprocalUnitPhase m ((As : ZMod m) * (Js : ZMod m))
          (((n + B * d : ℤ) : ZMod m) * ((nts n d + B * d : ℤ) : ZMod m)) =
        reciprocalUnitPhase m ((A : ZMod m) * (Jk : ZMod m))
          (((n + B * d : ℤ) : ZMod m) * ((nk n d + B * d : ℤ) : ZMod m)) at hph
      have hnd : la ∣ lt * n + s * ks * d := hdiv.mpr hd
      simp only [hnt] at hph
      simp only [H, Cn, hproduct, hd, hnd, true_and, hnt, hph]
      split_ifs
      · ac_rfl
      · simp only [zero_mul]
    · have hnd : ¬ la ∣ lt * n + s * ks * d := fun h => hd (hdiv.mp h)
      simp only [H, Cn, hd, hnd, and_false, false_and, ite_false, zero_mul]
  obtain ⟨-, hupos, -, hzero, hF⟩ :=
    sourceTerminalHomogeneous_integer_lattice la lt s ks hla
  let u : ℤ := la / (g : ℤ)
  let v : ℤ := lt / (g : ℤ)
  let t : ℤ := (s * ks) / (g : ℤ)
  rw [hgsgn] at hupos hzero hF
  change 0 < u at hupos
  have hzeroCn (hnot : ¬ (g : ℤ) ∣ s * k) (d n : ℤ) : Cn d n = 0 := by
    dsimp only [Cn]
    split_ifs with hguard
    · have hcop : Int.gcd d (la * lt) = 1 := by
        apply Nat.dvd_one.mp
        rw [← hguard.2.2.1]
        exact Int.gcd_dvd_gcd_of_dvd_right d ⟨(m : ℤ), by ac_rfl⟩
      exact (hzero d n hcop (fun hgs => hnot (hgsign.mp hgs)) hguard.2.2.2.1).elim
    · rfl
  have hzeroTotal (hnot : ¬ (g : ℤ) ∣ s * k) : total = 0 := by
    apply Finset.sum_eq_zero
    intro d _
    apply Finset.sum_eq_zero
    intro n _
    rw [hnormalized, hzeroCn hnot, zero_mul, zero_mul]
  have hΔstar : 0 < Δstar := lt_min (div_pos hN (mul_pos hΛabs
    (Real.rpow_pos_of_pos hx0 _))) hΔ₁
  have hshort : Δstar ≤ Δ₁ := min_le_right _ _
  have hshortN : Δstar ≤ N / (|Λ| * x ^ (5 * ε)) := min_le_left _ _
  have hR0 : 0 ≤ R := by dsimp only [R]; positivity
  refine ⟨hsum, hzeroTotal, ?_⟩
  by_cases hgsk : (g : ℤ) ∣ s * k
  · have hgks : (g : ℤ) ∣ s * ks := hgsign.mpr hgsk
    obtain ⟨F, ⟨hF0, hFu, -, -, hFG, hlinear⟩, -⟩ := hF hgks
    let G : ℤ := (v * F + t) / u
    change u * G - v * F = t at hFG
    change ∀ d n nt : ℤ, la * nt - lt * n = s * ks * d ↔
      ∃! n₁ : ℤ, n = u * n₁ + F * d ∧ nt = v * n₁ + G * d at hlinear
    have huR : (0 : ℝ) < u := by exact_mod_cast hupos
    have hu1 : (1 : ℝ) ≤ u := by exact_mod_cast hupos
    have huLa : u ≤ la := Int.ediv_le_self (g : ℤ) hla.le
    have huBound : (u : ℝ) < 2 * |Λ| :=
      (show (u : ℝ) ≤ la by exact_mod_cast huLa).trans_lt hlaBound
    have hFR0 : (0 : ℝ) ≤ F := by exact_mod_cast hF0
    have hFuR : (F : ℝ) ≤ u := by exact_mod_cast hFu.le
    have hFG' : (la / (Int.gcd la lt : ℤ)) * G -
        (lt / (Int.gcd la lt : ℤ)) * F = (s * ks) / (Int.gcd la lt : ℤ) := by
      simpa only [hgsgn] using hFG
    obtain ⟨-, -, -, hu, hv, -, -, hwJs, -, -, -⟩ :=
      sourceTerminalHomogeneous_units_and_slopes m w₂ hw₂ la lt s ks B hla.ne'
        hwlaI hwltI hlaUnit hltUnit (by simpa only [hgsgn] using hgks)
    simp only [hgsgn] at hu hv
    change IsUnit (u : ZMod m) at hu
    change IsUnit (v : ZMod m) at hv
    change (w₂ : ℤ) ∣ Js at hwJs
    let A₁ : ZMod m := (As : ZMod m) * (((g : ℤ) / (w₂ : ℤ) : ℤ) : ZMod m)
    let A₂ : ZMod m :=
      ((((g : ℤ) / (w₂ : ℤ) : ℤ) : ZMod m) * (u : ZMod m) * (v : ZMod m))⁻¹
    let B₁ : ZMod m := ((F + B : ℤ) : ZMod m) * (u : ZMod m)⁻¹
    let L₁ : ZMod m := A₂ * ((Js / (w₂ : ℤ) : ℤ) : ZMod m)
    obtain ⟨hA₁, hA₂, -, hphase⟩ :=
      sourceTerminalHomogeneous_masked_phase m w₂ hw₂ la lt s ks As B F G hla.ne'
        hwlaI hwltI hlaUnit hltUnit hAs (by simpa only [hgsgn] using hgks) hFG'
    simp only [hgsgn] at hA₁ hA₂ hphase
    change IsUnit A₁ at hA₁
    change IsUnit A₂ at hA₂
    let C₁ : ℤ → ℤ → ℂ := fun d n =>
      if Int.ModEq (q₀ : ℤ) d dstar ∧ Int.ModEq (q₀ : ℤ) (u * n + F * d) nstar ∧
          Int.gcd d (m : ℤ) = 1 ∧ Int.gcd d (a : ℤ) = 1 ∧
          Int.gcd (u * n + F * d) (w₁ : ℤ) = 1 ∧
          Int.gcd (v * n + G * d) (w₁ : ℤ) = 1 ∧
          Int.gcd (u * n + F * d) (c₁ : ℤ) = 1 ∧
          Int.gcd (v * n + G * d) (c₁ : ℤ) = 1 ∧
          Int.gcd (u * n + (F + ell) * d) (c₂ : ℤ) = 1 ∧
          Int.gcd (v * n + (G + ell) * d) (c₂ : ℤ) = 1 then
        affineReciprocalProductPhase m ((w₂ : ZMod m) * A₁) B₁ L₁ 0 0
          (n : ZMod m) (d : ZMod m)
      else 0
    have hC₁ (d n : ℤ) : ‖C₁ d n‖ ≤ 1 := by
      dsimp only [C₁]
      split_ifs
      · exact norm_affineReciprocalProductPhase_le_one _ _ _ _ _ _ _ _
      · simp
    let T : ℤ × ℤ → ℤ × ℤ := fun z => (z.1, u * z.2 + F * z.1)
    have hTinj : Function.Injective T := by
      intro z z' heq
      have hd := congrArg Prod.fst heq
      have hn := congrArg Prod.snd heq
      dsimp only [T] at hd hn
      rw [hd] at hn
      exact Prod.ext hd (mul_left_cancel₀ hupos.ne' (add_right_cancel hn))
    have hTnt (d n : ℤ) :
        la ∣ lt * (u * n + F * d) + s * ks * d ∧
          nts (u * n + F * d) d = v * n + G * d := by
      have hrel : la * (v * n + G * d) - lt * (u * n + F * d) = s * ks * d := by
        apply (hlinear d _ _).2
        refine ⟨n, ⟨rfl, rfl⟩, ?_⟩
        intro n' hn'
        exact mul_left_cancel₀ hupos.ne' (add_right_cancel hn'.1.symm)
      have hnum : lt * (u * n + F * d) + s * ks * d = la * (v * n + G * d) :=
        (Int.sub_eq_iff_eq_add'.mp hrel).symm
      refine ⟨⟨v * n + G * d, hnum⟩, ?_⟩
      dsimp only [nts]
      rw [hnum, Int.mul_ediv_cancel_left _ hla.ne']
    have hCtransport (d n : ℤ) : Cn d (u * n + F * d) = C₁ d n := by
      have hnt := hTnt d n
      have hph := (hphase n d).2
      change reciprocalUnitPhase m ((As : ZMod m) * (Js : ZMod m))
          ((((u * n + F * d) + B * d : ℤ) : ZMod m) *
            (((v * n + G * d) + B * d : ℤ) : ZMod m)) =
        affineReciprocalProductPhase m ((w₂ : ZMod m) * A₁) B₁ L₁ 0 0
          (n : ZMod m) (d : ZMod m) at hph
      simp only [Cn, C₁, hnt.2, hnt.1, hmask d, true_and, hph, and_assoc]
      simp only [Nat.cast_mul, ← Int.isCoprime_iff_gcd_eq_one, IsCoprime.mul_right_iff]
      simp only [IsCoprime.mul_left_iff, and_assoc]
      simp only [add_mul, add_assoc]
    let D₁ : ℝ := Δstar / (z₁ : ℝ)
    let N₁ : ℝ := N / (u : ℝ)
    let χ : ℝ → ℝ := fun t => Real.smoothTransition (t + 1) - Real.smoothTransition t
    let ρ : ℝ := Δstar / Δ₁
    let center : ℕ → ℝ := fun j =>
      ((d₀ : ℝ) - CD * Δ₁ + Δstar * (j : ℝ) / 2) / (z₁ : ℝ)
    let τ : ℕ → ℝ → ℂ := fun j t =>
      χ (2 * t) • φ (-CD + ρ * (t + (j : ℝ) / 2))
    obtain ⟨-, -, -, -, -, hdict, -, hfinite⟩ :=
      sourceShortSmoothPartition_finite_decomposition CD Δ₁ Δstar (z₁ : ℝ) (d₀ : ℝ)
        hCD0.le hΔ₁ hΔstar hshort hzR φ hφbox
    obtain ⟨-, -, hD₁, hD₁cap, hτprofiles, -, -⟩ :=
      hpartProfiles x hxexp φ hφ hφbox hφbound N Λ Δ₁ (d₀ : ℝ) ε hN hΛ hΔ₁ z₁ hz₁
    change 0 < D₁ at hD₁
    change D₁ ≤ Δ₁ at hD₁cap
    have hN₁ : 0 < N₁ := div_pos hN huR
    have hN₁N : N₁ ≤ N := div_le_self hN.le hu1
    have hD₁Δ : D₁ ≤ Δstar := div_le_self hΔstar.le hz1
    have hbase : |Λ| * Δstar / N ≤ x ^ (-(5 * ε)) := by
      rw [Real.rpow_neg hx0.le]
      apply (div_le_iff₀ hN).2
      rw [mul_comm ((x ^ (5 * ε))⁻¹) N, ← div_eq_mul_inv]
      apply (le_div_iff₀ (Real.rpow_pos_of_pos hx0 _)).2
      have hh := (le_div_iff₀ (mul_pos hΛabs (Real.rpow_pos_of_pos hx0 _))).1 hshortN
      simpa only [mul_assoc, mul_comm, mul_left_comm] using hh
    have hηsmall : |(F : ℝ) * D₁ / N| ≤ 2 * x ^ (-(5 * ε)) := by
      rw [abs_of_nonneg (by positivity)]
      calc
        (F : ℝ) * D₁ / N ≤ (2 * |Λ|) * Δstar / N := by
          gcongr
          exact hFuR.trans huBound.le
        _ = 2 * (|Λ| * Δstar / N) := by rw [mul_assoc, mul_div_assoc]
        _ ≤ _ := mul_le_mul_of_nonneg_left hbase zero_le_two
    have hsecondSmall : (w₁ : ℝ) * D₁ / N₁ ≤ 2 * x ^ (-(5 * ε)) := by
      have hwzdiv : (w₁ : ℝ) / z₁ ≤ 1 := (div_le_one₀ hzR).mpr hwzR
      calc
        (w₁ : ℝ) * D₁ / N₁ = ((w₁ : ℝ) / z₁) * ((u : ℝ) * Δstar / N) := by
          dsimp only [D₁, N₁]
          rw [div_div_eq_mul_div]
          simp only [div_eq_mul_inv]
          ac_rfl
        _ ≤ 1 * ((2 * |Λ|) * Δstar / N) := by
          apply mul_le_mul hwzdiv _ (by positivity) zero_le_one
          exact div_le_div_of_nonneg_right
            (mul_le_mul_of_nonneg_right huBound.le hΔstar.le) hN.le
        _ = 2 * (|Λ| * Δstar / N) := by rw [one_mul, mul_assoc, mul_div_assoc]
        _ ≤ 2 * x ^ (-(5 * ε)) := mul_le_mul_of_nonneg_left hbase zero_le_two
    let AP : ℤ → ℤ → ℂ := fun d n => Cn d n * ψ ((n : ℝ) / N)
    have htotalOrder : total =
        ∑ d ∈ BD, ∑ n ∈ BN, AP d n * φ (((z₁ : ℝ) * (d : ℝ) - (d₀ : ℝ)) / Δ₁) := by
      apply Finset.sum_congr rfl
      intro d _
      apply Finset.sum_congr rfl
      intro n _
      rw [hnormalized]
      dsimp only [AP]
      ac_rfl
    obtain ⟨jP, -, hpiece⟩ := (hfinite BD BN AP).2
    change ‖∑ d ∈ BD, ∑ n ∈ BN,
        AP d n * φ (((z₁ : ℝ) * (d : ℝ) - (d₀ : ℝ)) / Δ₁)‖ ≤
      ((4 * CD + 2) * Δ₁ / Δstar) *
        ‖∑ d ∈ BD, ∑ n ∈ BN, AP d n * τ jP (((d : ℝ) - center jP) / D₁)‖ at hpiece
    rw [← htotalOrder] at hpiece
    let y₀ : ℝ := center jP
    let n₀ : ℝ := -((F : ℝ) * y₀) / (u : ℝ)
    let η : ℝ := (F : ℝ) * D₁ / N
    let BD₁ : Finset ℤ := Finset.Icc ⌈y₀ - (1 / 2 : ℝ) * D₁⌉ ⌊y₀ + (1 / 2 : ℝ) * D₁⌋
    let BI₁ : Finset ℤ := Finset.Icc
      ⌈n₀ - (CN + 1 / 2) * N₁⌉ ⌊n₀ + (CN + 1 / 2) * N₁⌋
    let Hj : ℤ × ℤ → ℂ := fun z =>
      Cn z.1 z.2 * τ jP (((z.1 : ℝ) - y₀) / D₁) * ψ ((z.2 : ℝ) / N)
    let V : ℂ := ∑ d ∈ BD, ∑ n ∈ BN, Hj (d, n)
    have hpiece' : ‖total‖ ≤ ((4 * CD + 2) * Δ₁ / Δstar) * ‖V‖ := by
      convert hpiece using 1
      congr 2
      apply Finset.sum_congr rfl
      intro d _
      apply Finset.sum_congr rfl
      intro n _
      dsimp only [V, Hj, AP, y₀]
      ac_rfl
    obtain ⟨hτsmooth, hτsupp, hτbound⟩ := hτprofiles jP
    have hτb : ∀ r t, ‖iteratedDeriv r (τ jP) t‖ ≤ Cp r * (Real.log x) ^ Ep r :=
      fun r t => (hτbound r t).1
    have hHjsum : HasSum Hj V := by
      have hs : HasSum Hj (∑ z ∈ BD ×ˢ BN, Hj z) := by
        apply hasSum_sum_of_ne_finset_zero
        intro z hz
        by_contra hne
        have hτne := (mul_ne_zero_iff.mp (mul_ne_zero_iff.mp hne).1).2
        have hψne := (mul_ne_zero_iff.mp hne).2
        have hφne : φ (((z₁ : ℝ) * (z.1 : ℝ) - (d₀ : ℝ)) / Δ₁) ≠ 0 := by
          intro heq
          have hdict' := hdict jP (z.1 : ℝ)
          change τ jP (((z.1 : ℝ) - y₀) / D₁) = _ at hdict'
          rw [heq, smul_zero] at hdict'
          exact hτne hdict'
        exact hz (hweightsBox z.1 z.2 hφne hψne)
      simpa only [V, Finset.sum_product] using hs
    have hoff (z : ℤ × ℤ) (hz : z ∉ Set.range T) : Hj z = 0 := by
      dsimp only [Hj, Cn]
      split_ifs with hguard
      · have hrel : la * nts z.2 z.1 - lt * z.2 = s * ks * z.1 := by
          dsimp only [nts]
          rw [Int.mul_ediv_cancel' hguard.2.2.2.1, add_sub_cancel_left]
        obtain ⟨n₁, hn, -⟩ := (hlinear z.1 z.2 (nts z.2 z.1)).1 hrel
        exact (hz ⟨(z.1, n₁), Prod.ext rfl hn.1.symm⟩).elim
      · simp only [zero_mul]
    have htrans := (hTinj.hasSum_iff hoff).2 hHjsum
    let M : ℤ × ℤ → ℂ := fun z =>
      C₁ z.1 z.2 * τ jP (((z.1 : ℝ) - y₀) / D₁) *
        ψ (((u : ℝ) * (z.2 : ℝ) + (F : ℝ) * (z.1 : ℝ)) / N)
    have hMsum : HasSum M V := htrans.congr_fun fun z => by
      dsimp only [M, Function.comp_apply, Hj, T]
      rw [hCtransport]
      push_cast
      rfl
    obtain ⟨hηone, herr⟩ := hrem x hxR (τ jP) ψ hτsmooth hψ hτsupp hψbox hτb hψbound
      1 (z₁ : ℝ) (u : ℝ) Δstar N zero_lt_one hzR huR hΔstar hN
      (F : ℝ) 0 y₀ (by simpa using hD₁cap.trans hΔx) (hN₁N.trans hNx)
      (by simpa [η, D₁] using hηsmall) BD₁ BI₁ C₁ (fun d _ n _ => hC₁ d n)
    simp only [mul_one] at hηone
    simp only [one_mul, mul_one, div_one, sub_zero, zero_sub] at herr
    let dStar : ℕ → ℝ → ℂ := fun j t =>
      ((η * t) ^ j / (Nat.factorial j : ℝ)) • τ jP t
    let nStar : ℕ → ℝ → ℂ := fun j t => iteratedDeriv j ψ t
    let S : ℕ → ℤ × ℤ → ℂ := fun j z => C₁ z.1 z.2 *
      dStar j (((z.1 : ℝ) - y₀) / D₁) * nStar j (((z.2 : ℝ) - n₀) / N₁)
    obtain ⟨-, -, -, -, -, -, hzeroBox, -⟩ := sourceShortShearTaylor_finite_separation
      J (τ jP) ψ ((contDiff_infty.mp hψ) (J + 1)) (1 / 2) CN (by norm_num) hCN0.le
      hτsupp hψbox 1 (z₁ : ℝ) (u : ℝ) Δstar N zero_lt_one hzR huR hΔstar hN
      (F : ℝ) 0 y₀ (by simpa [η, D₁] using hηone) BD₁ BI₁ C₁
    have hMzero (z : ℤ × ℤ) (hz : z ∉ BD₁ ×ˢ BI₁) : M z = 0 := by
      have hz' : z.1 ∉ BD₁ ∨ z.2 ∉ BI₁ := by
        simpa only [Finset.mem_product, not_and_or] using hz
      have heq := (hzeroBox z.1 z.2
        (by simpa [BD₁, BI₁, n₀, D₁, N₁, neg_mul] using hz')).1
      dsimp only [M]
      rw [mul_assoc]
      simpa only [one_mul, div_one, sub_zero, mul_zero] using congrArg (C₁ z.1 z.2 * ·) heq
    have hMbox : HasSum M (∑ d ∈ BD₁, ∑ n ∈ BI₁, M (d, n)) := by
      simpa only [Finset.sum_product] using hasSum_sum_of_ne_finset_zero hMzero
    have hVbox : V = ∑ d ∈ BD₁, ∑ n ∈ BI₁, M (d, n) := hMsum.unique hMbox
    change ‖(∑ d ∈ BD₁, ∑ n ∈ BI₁, M (d, n)) -
      ∑ j ∈ Finset.range (J + 1), ∑ d ∈ BD₁, ∑ n ∈ BI₁, S j (d, n)‖ ≤ x ^ (-b) at herr
    have hterm (j : ℕ) (hj : j ∈ Finset.range (J + 1)) :
        ‖∑ d ∈ BD₁, ∑ n ∈ BI₁, S j (d, n)‖ ≤ CO * x ^ (2 * ε) * R := by
      have hjJ : j ≤ J := Nat.lt_succ_iff.mp (Finset.mem_range.mp hj)
      obtain ⟨hdsm, hnsm, hdsup, hnsup, hsb, -⟩ :=
        hstar x hxexp (τ jP) ψ hτsmooth hψ hτsupp hψbox hτb hψbound η hηone j hjJ
      change ContDiff ℝ ∞ (dStar j) at hdsm
      change ContDiff ℝ ∞ (nStar j) at hnsm
      have hdsb : ∀ r t, ‖iteratedDeriv r (dStar j) t‖ ≤ Cs r * (Real.log x) ^ Es r :=
        fun r t => (hsb r t).1
      have hnsb : ∀ r t, ‖iteratedDeriv r (nStar j) t‖ ≤ Cs r * (Real.log x) ^ Es r :=
        fun r t => (hsb r t).2
      have ho := houtside x hxO m q₀ c₁ c₂ a w₁ w₂ hm hmx hq₀ hc₁ hc₂
        ha hw₁ ham hwm hax hwx u v F G ell dstar nstar Js hu hv hwJs
        A₁ A₂ B₁ hA₁ hA₂ D₁ N₁ y₀ n₀ hD₁ hN₁ (hD₁cap.trans hΔx) (hN₁N.trans hNx)
        hsecondSmall (dStar j) (nStar j) hdsm hnsm hdsup hnsup hdsb hnsb
      have hSzero (z : ℤ × ℤ) (hz : z ∉ BD₁ ×ˢ BI₁) : S j z = 0 := by
        have hz' : z.1 ∉ BD₁ ∨ z.2 ∉ BI₁ := by
          simpa only [Finset.mem_product, not_and_or] using hz
        have heq := (hzeroBox z.1 z.2
          (by simpa [BD₁, BI₁, n₀, D₁, N₁, neg_mul] using hz')).2.1 j hjJ
        dsimp only [S]
        rw [mul_assoc]
        simpa only [mul_one, div_one, zero_sub, mul_zero] using congrArg (C₁ z.1 z.2 * ·) heq
      have hs : HasSum (S j) (∑ d ∈ BD₁, ∑ n ∈ BI₁, S j (d, n)) := by
        simpa only [Finset.sum_product] using hasSum_sum_of_ne_finset_zero hSzero
      have hso : HasSum (S j) _ := ho.1.congr_fun fun z => by
        dsimp only [S, C₁]
        split_ifs
        · ac_rfl
        · simp only [zero_mul]
      have heq := hs.unique hso
      rw [heq]
      refine ho.2.trans ?_
      rw [hJgcd]
      change CO * x ^ (2 * ε) * (Int.gcd Jk (m : ℤ) : ℝ) * P * (1 / (q₀ : ℝ)) *
        (N₁ / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
        (D₁ / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) ≤ CO * x ^ (2 * ε) * R
      have hgeom :
          (N₁ / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
              (D₁ / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) ≤
            (N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
              (Δstar / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) :=
        mul_le_mul
          (add_le_add (div_le_div_of_nonneg_right hN₁N (Real.sqrt_nonneg _)) le_rfl)
          (add_le_add (div_le_div_of_nonneg_right hD₁Δ (Real.sqrt_nonneg _)) le_rfl)
          (by positivity) (by positivity)
      calc
        _ = (CO * x ^ (2 * ε) * (Int.gcd Jk (m : ℤ) : ℝ) * P * (1 / (q₀ : ℝ))) *
            ((N₁ / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
              (D₁ / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ))) := by ac_rfl
        _ ≤ _ := mul_le_mul_of_nonneg_left hgeom
          (mul_nonneg (mul_nonneg (mul_nonneg (mul_nonneg hCO.le
            (Real.rpow_nonneg hx0.le _)) (Nat.cast_nonneg _)) (zero_le_one.trans hP))
            (div_nonneg zero_le_one (Nat.cast_nonneg _)))
        _ = CO * x ^ (2 * ε) * R := by dsimp only [R]; ac_rfl
    have hVbound : ‖V‖ ≤ ((J : ℝ) + 1) * CO * x ^ (2 * ε) * R + x ^ (-b) := by
      rw [hVbox]
      calc
        _ ≤ ‖∑ j ∈ Finset.range (J + 1), ∑ d ∈ BD₁, ∑ n ∈ BI₁, S j (d, n)‖ +
            ‖(∑ d ∈ BD₁, ∑ n ∈ BI₁, M (d, n)) -
              ∑ j ∈ Finset.range (J + 1), ∑ d ∈ BD₁, ∑ n ∈ BI₁, S j (d, n)‖ :=
          norm_le_norm_add_norm_sub' _ _
        _ ≤ (∑ j ∈ Finset.range (J + 1), CO * x ^ (2 * ε) * R) + x ^ (-b) :=
          add_le_add (norm_sum_le_of_le _ hterm) herr
        _ = _ := by
          simp only [Finset.sum_const, Finset.card_range, nsmul_eq_mul,
            Nat.cast_add, Nat.cast_one, mul_assoc]
    have hqpos : 0 < q₀ := Nat.pos_of_dvd_of_pos hq₀ (NeZero.pos m)
    have hqR : (0 : ℝ) < q₀ := by exact_mod_cast hqpos
    have hmR : (0 : ℝ) < m := by exact_mod_cast NeZero.pos m
    have hsqrt : 0 < Real.sqrt (m : ℝ) := Real.sqrt_pos.2 hmR
    have hgcd1 : (1 : ℝ) ≤ Int.gcd Jk (m : ℤ) := by
      exact_mod_cast Int.gcd_pos_of_ne_zero_right Jk (by exact_mod_cast hm.ne_zero)
    have hqle : (q₀ : ℝ) ≤ m := by exact_mod_cast Nat.le_of_dvd (NeZero.pos m) hq₀
    have hR1 : 1 ≤ R := by
      have hgeom : (m : ℝ) ≤
          (N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
            (Δstar / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) := by
        calc
          (m : ℝ) = Real.sqrt (m : ℝ) * Real.sqrt (m : ℝ) :=
            (Real.mul_self_sqrt hmR.le).symm
          _ ≤ _ := mul_le_mul
            (le_add_of_nonneg_left (div_nonneg hN.le hsqrt.le))
            (le_add_of_nonneg_left (div_nonneg hΔstar.le hsqrt.le)) hsqrt.le (by positivity)
      calc
        1 ≤ (m : ℝ) / q₀ := (one_le_div hqR).mpr hqle
        _ ≤ (Int.gcd Jk (m : ℤ) : ℝ) * P *
            ((N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
              (Δstar / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ))) / q₀ := by
          apply div_le_div_of_nonneg_right _ hqR.le
          calc
            (m : ℝ) ≤ (1 * 1) *
                ((N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
                  (Δstar / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ))) := by simpa using hgeom
            _ ≤ _ := mul_le_mul_of_nonneg_right
              (mul_le_mul hgcd1 hP zero_le_one (zero_le_one.trans hgcd1)) (by positivity)
        _ = R := by simp only [R, div_eq_mul_inv, one_mul]; ac_rfl
    have hVfinal : ‖V‖ ≤ (((J : ℝ) + 1) * CO + 1) * x ^ (3 * ε) * R := by
      have herr1 : x ^ (-b) ≤ 1 :=
        Real.rpow_le_one_of_one_le_of_nonpos hx1 (neg_nonpos.mpr hb.le)
      have hpow : x ^ (2 * ε) ≤ x ^ (3 * ε) :=
        Real.rpow_le_rpow_of_exponent_le hx1
          (mul_le_mul_of_nonneg_right (by norm_num : (2 : ℝ) ≤ 3) hε.le)
      have hone : 1 ≤ x ^ (3 * ε) * R :=
        one_le_mul_of_one_le_of_one_le
          (Real.one_le_rpow hx1 (mul_nonneg (by norm_num) hε.le)) hR1
      calc
        ‖V‖ ≤ ((J : ℝ) + 1) * CO * x ^ (2 * ε) * R + x ^ (-b) := hVbound
        _ ≤ ((J : ℝ) + 1) * CO * x ^ (3 * ε) * R + 1 :=
          add_le_add (mul_le_mul_of_nonneg_right
            (mul_le_mul_of_nonneg_left hpow
              (mul_nonneg (add_nonneg (Nat.cast_nonneg J) zero_le_one) hCO.le)) hR0) herr1
        _ ≤ ((J : ℝ) + 1) * CO * x ^ (3 * ε) * R + x ^ (3 * ε) * R :=
          add_le_add le_rfl hone
        _ = _ := by simp only [add_mul, one_mul]
    calc
      ‖total‖ ≤ ((4 * CD + 2) * Δ₁ / Δstar) * ‖V‖ := hpiece'
      _ ≤ ((4 * CD + 2) * Δ₁ / Δstar) *
          ((((J : ℝ) + 1) * CO + 1) * x ^ (3 * ε) * R) :=
        mul_le_mul_of_nonneg_left hVfinal
          (div_nonneg (mul_nonneg
            (add_nonneg (mul_nonneg (by norm_num) hCD0.le) zero_le_two) hΔ₁.le) hΔstar.le)
      _ = _ := by simp only [«CΣ», R, div_eq_mul_inv]; ac_rfl
  · rw [hzeroTotal hgsk, norm_zero]
    calc
      0 ≤ «CΣ» * x ^ (3 * ε) * (Δ₁ / Δstar) * R :=
        mul_nonneg (mul_nonneg
          (mul_nonneg hSigmaPos.le (Real.rpow_nonneg hx0.le _))
          (div_nonneg hΔ₁.le hΔstar.le)) hR0
      _ = _ := by dsimp only [R]; ac_rfl

open Classical in
theorem sourceTerminalSigma6_uniform_bound_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (Csrc ε cD CD cN CN : ℝ)
    (hCsrc : 0 ≤ Csrc) (hε : 0 < ε)
    (hcD : 0 < cD) (hCD : cD ≤ CD) (hcN : 0 < cN) (hCN : cN ≤ CN)
    (Cφ Eφ Cψ Eψ : ℕ → ℝ)
    (hCφ : ∀ r : ℕ, 0 ≤ Cφ r) (hCψ : ∀ r : ℕ, 0 ≤ Cψ r) :
    ∃ «CΣ» X₀ : ℝ, 0 < «CΣ» ∧ Real.exp 1 ≤ X₀ ∧
      ∀ (x : ℝ), X₀ ≤ x →
      ∀ (m q₀ c₁ c₂ w₁ w₂ z₁ : ℕ) (hm : Squarefree m),
      (m : ℝ) ≤ x ^ Csrc →
      q₀ ∣ m → c₁ ∣ m → c₂ ∣ m →
      0 < w₁ → Squarefree w₁ → 0 < z₁ → w₁ ∣ z₁ → Nat.Coprime z₁ m →
      (w₁ : ℝ) ≤ x ^ Csrc →
      ∀ (lam lamTilde k ell A B d₀ dstar nstar : ℤ),
      ∀ (Λ Δ₁ N : ℝ), Λ ≠ 0 → 0 < Δ₁ → 0 < N → 0 ≤ d₀ →
      |Λ| ≤ x ^ Csrc → Δ₁ ≤ x ^ Csrc → N ≤ x ^ Csrc →
      (1 ≤ (lam : ℝ) / Λ ∧ (lam : ℝ) / Λ < 2) →
      (1 ≤ (lamTilde : ℝ) / Λ ∧ (lamTilde : ℝ) / Λ < 2) →
      w₂ = ∏ p ∈ m.primeFactors, p ^ (lam.natAbs.factorization p) →
      w₂ = ∏ p ∈ m.primeFactors, p ^ (lamTilde.natAbs.factorization p) →
      Int.gcd (((z₁ / w₁ : ℕ) : ℤ)) ((m : ℤ) * lam * lamTilde) = 1 →
      IsUnit (A : ZMod m) →
      ∀ (φ ψ : ℝ → ℂ), ContDiff ℝ ∞ φ → ContDiff ℝ ∞ ψ →
      Function.support φ ⊆ Set.Icc cD CD →
      Function.support ψ ⊆ Set.Icc cN CN →
      (∀ (r : ℕ) (t : ℝ), ‖iteratedDeriv r φ t‖ ≤ Cφ r * (Real.log x) ^ Eφ r) →
      (∀ (r : ℕ) (t : ℝ), ‖iteratedDeriv r ψ t‖ ≤ Cψ r * (Real.log x) ^ Eψ r) →
      letI : NeZero m := ⟨hm.ne_zero⟩
      let s : ℤ := ((z₁ / w₁ : ℕ) : ℤ)
      let g : ℕ := Int.gcd lam lamTilde
      let Jk : ℤ := s * k + (lam - lamTilde) * B
      let nk : ℤ → ℤ → ℤ := fun n d => (lamTilde * n + s * k * d) / lam
      let Δstar : ℝ := min (N / (|Λ| * x ^ (5 * ε))) Δ₁
      let BD : Finset ℤ :=
        Finset.Icc ⌈((d₀ : ℝ) + cD * Δ₁) / (z₁ : ℝ)⌉
          ⌊((d₀ : ℝ) + CD * Δ₁) / (z₁ : ℝ)⌋
      let BN : Finset ℤ := Finset.Icc ⌈cN * N⌉ ⌊CN * N⌋
      let H : ℤ × ℤ → ℂ := fun z =>
        if Int.ModEq (q₀ : ℤ) z.1 dstar ∧ Int.ModEq (q₀ : ℤ) z.2 nstar ∧
            Int.gcd z.1 ((m : ℤ) * lam * lamTilde) = 1 ∧
            lam ∣ lamTilde * z.2 + s * k * z.1 ∧
            Int.gcd (z.2 * nk z.2 z.1) ((w₁ * c₁ : ℕ) : ℤ) = 1 ∧
            Int.gcd ((z.2 + ell * z.1) * (nk z.2 z.1 + ell * z.1)) (c₂ : ℤ) = 1
        then
          φ (((z₁ : ℝ) * (z.1 : ℝ) - (d₀ : ℝ)) / Δ₁) * ψ ((z.2 : ℝ) / N) *
            reciprocalUnitPhase m ((A : ZMod m) * (Jk : ZMod m))
              (((z.2 + B * z.1 : ℤ) : ZMod m) *
                ((nk z.2 z.1 + B * z.1 : ℤ) : ZMod m))
        else 0
      let total : ℂ := ∑ d ∈ BD, ∑ n ∈ BN, H (d, n)
      HasSum H total ∧
        (¬ (g : ℤ) ∣ s * k → total = 0) ∧
        ‖total‖ ≤ «CΣ» * x ^ (3 * ε) * (Int.gcd Jk (m : ℤ) : ℝ) *
          (1 / (q₀ : ℝ)) * (Δ₁ / Δstar) *
          (N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
          (Δstar / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) := by
  obtain ⟨C₀, X₀, hC₀, hX₀, hSigma⟩ :=
    sourceTerminalSigma6_uniform_kl3_max_bound Csrc (ε / 2) cD CD cN CN
      hCsrc (half_pos hε) hcD hCD hcN hCN Cφ Eφ Cψ Eψ hCφ hCψ
  obtain ⟨CL, hCL, hL⟩ := prime_factor_logarithmic_loss
    3 (Csrc + 1) 0 0 ε (by norm_num) (by linarith) (by norm_num)
      (by norm_num) hε
  refine ⟨C₀ * CL, max X₀ 2, mul_pos hC₀ hCL,
    hX₀.trans (le_max_left _ _), ?_⟩
  intro x hx m q₀ c₁ c₂ w₁ w₂ z₁ hm hmcap hq₀ hc₁ hc₂
    hw₁ hw₁sq hz₁ hwz hzm hwcap lam lamTilde k ell A B d₀ dstar nstar
    Λ Δ₁ N hΛ hΔ hN hd₀ hΛcap hΔcap hNcap hlam hlamTilde hw₂ hw₂Tilde
    hscop hA φ ψ hφ hψ hsφ hsψ heφ heψ
  have hxSigma : X₀ ≤ x := (le_max_left X₀ 2).trans hx
  have hx2 : (2 : ℝ) ≤ x := (le_max_right X₀ 2).trans hx
  have hx1 : (1 : ℝ) ≤ x := by linarith
  have hx0 : 0 < x := by linarith
  have hraw := hSigma x hxSigma m q₀ c₁ c₂ w₁ w₂ z₁ hm hmcap hq₀ hc₁ hc₂
    hw₁ hw₁sq hz₁ hwz hzm hwcap lam lamTilde k ell A B d₀ dstar nstar
    Λ Δ₁ N hΛ hΔ hN hd₀ hΛcap hΔcap hNcap hlam hlamTilde hw₂ hw₂Tilde
    hscop hA φ ψ hφ hψ hsφ hsψ heφ heψ
  let Jk : ℤ := ((z₁ / w₁ : ℕ) : ℤ) * k + (lam - lamTilde) * B
  let Δstar : ℝ := min (N / (|Λ| * x ^ (5 * ε))) Δ₁
  let Δhalf : ℝ := min (N / (|Λ| * x ^ (5 * (ε / 2)))) Δ₁
  let K : (p : m.primeFactors) → ℝ := fun p =>
    letI : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
    (Finset.univ : Finset (ZMod p.1)).sup' Finset.univ_nonempty
      (fun c => ‖normalizedKloosterman3 p.1 c‖)
  let Pm : ℝ := ∏ p : m.primeFactors, max 1 (K p)
  let S : ℝ := Real.sqrt (m : ℝ)
  have hK (p : m.primeFactors) : K p ≤ 3 := by
    let : Fact p.1.Prime := ⟨Nat.prime_of_mem_primeFactors p.2⟩
    apply Finset.sup'_le
    intro c _
    exact (normalizedKloosterman3_prime_local_bounds_of_deligne
      hDeligne p.1).1 c
  have hPm : Pm ≤ (3 : ℝ) ^ m.primeFactors.card := by
    calc
      Pm ≤ ∏ _p : m.primeFactors, (3 : ℝ) := by
        apply Finset.prod_le_prod
        · intro p _
          exact (zero_le_one : (0 : ℝ) ≤ 1).trans (le_max_left _ _)
        · intro p _
          exact max_le (by norm_num) (hK p)
      _ = (3 : ℝ) ^ m.primeFactors.card := by simp
  have hmcap' : (m : ℝ) ≤ x ^ (Csrc + 1) :=
    hmcap.trans (Real.rpow_le_rpow_of_exponent_le hx1 (by linarith))
  have hPloss : Pm ≤ CL * x ^ ε := hPm.trans (by
    simpa only [Real.rpow_zero, mul_one] using hL x hx2 m hm.ne_zero hmcap')
  have hS : 0 < S := Real.sqrt_pos.mpr (by exact_mod_cast Nat.pos_of_ne_zero hm.ne_zero)
  have hΔstar : 0 < Δstar :=
    lt_min (div_pos hN (mul_pos (abs_pos.mpr hΛ) (Real.rpow_pos_of_pos hx0 _))) hΔ
  have hΔcompare : Δstar ≤ Δhalf := by
    apply min_le_min _ le_rfl
    apply div_le_div_of_nonneg_left hN.le
      (mul_pos (abs_pos.mpr hΛ) (Real.rpow_pos_of_pos hx0 _))
    exact mul_le_mul_of_nonneg_left
      (Real.rpow_le_rpow_of_exponent_le hx1 (by linarith)) (abs_nonneg Λ)
  have hΔhalf : 0 < Δhalf := hΔstar.trans_le hΔcompare
  have hgeometry :
      (Δ₁ / Δhalf) * (Δhalf / S + S) ≤ (Δ₁ / Δstar) * (Δstar / S + S) := by
    calc
      (Δ₁ / Δhalf) * (Δhalf / S + S) = Δ₁ / S + Δ₁ * S / Δhalf := by
        field_simp [hΔhalf.ne', hS.ne']
      _ ≤ Δ₁ / S + Δ₁ * S / Δstar :=
        add_le_add le_rfl
          (div_le_div_of_nonneg_left (mul_nonneg hΔ.le hS.le) hΔstar hΔcompare)
      _ = (Δ₁ / Δstar) * (Δstar / S + S) := by
        field_simp [hΔstar.ne', hS.ne']
  have hscalar : x ^ (3 * (ε / 2)) * Pm ≤ CL * x ^ (3 * ε) := by
    calc
      x ^ (3 * (ε / 2)) * Pm ≤ x ^ (3 * (ε / 2)) * (CL * x ^ ε) :=
        mul_le_mul_of_nonneg_left hPloss (Real.rpow_nonneg hx0.le _)
      _ = CL * x ^ (3 * (ε / 2) + ε) := by
        rw [Real.rpow_add hx0]
        ring
      _ ≤ CL * x ^ (3 * ε) :=
        mul_le_mul_of_nonneg_left
          (Real.rpow_le_rpow_of_exponent_le hx1 (by linarith)) hCL.le
  let R : ℝ := (Int.gcd Jk (m : ℤ) : ℝ) * (1 / (q₀ : ℝ)) * (N / S + S)
  have hR : 0 ≤ R := by positivity
  refine ⟨hraw.1, hraw.2.1, ?_⟩
  calc
    _ ≤ C₀ * x ^ (3 * (ε / 2)) * (Int.gcd Jk (m : ℤ) : ℝ) *
        Pm * (1 / (q₀ : ℝ)) * (Δ₁ / Δhalf) * (N / S + S) *
          (Δhalf / S + S) := hraw.2.2
    _ = C₀ * (x ^ (3 * (ε / 2)) * Pm) * R *
        ((Δ₁ / Δhalf) * (Δhalf / S + S)) := by
      dsimp only [R]
      ring
    _ ≤ C₀ * (CL * x ^ (3 * ε)) * R *
        ((Δ₁ / Δstar) * (Δstar / S + S)) := by
      apply mul_le_mul
      · exact mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left hscalar hC₀.le) hR
      · exact hgeometry
      · positivity
      · positivity
    _ = (C₀ * CL) * x ^ (3 * ε) * (Int.gcd Jk (m : ℤ) : ℝ) *
        (1 / (q₀ : ℝ)) * (Δ₁ / Δstar) * (N / S + S) *
          (Δstar / S + S) := by
      dsimp only [R]
      ring

open Classical in
theorem sourceTerminalSigma6_source_ranges_bound_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    («ω» δ ε cD CD cN CN : ℝ)
    (hω : 0 ≤ «ω») (hδ : 0 ≤ δ) (hε : 0 < ε)
    (hcD : 0 < cD) (hCD : cD ≤ CD) (hcN : 0 < cN) (hCN : cN ≤ CN)
    (CMN CH Cm cΔ CΔ CΛ Cw : ℝ)
    (hCMN : 0 < CMN) (hCH : 0 < CH) (hCm : 0 < Cm) (hcΔ : 0 < cΔ)
    (hCΔ : 0 < CΔ) (hCΛ : 0 < CΛ) (hCw : 0 < Cw)
    (Cφ Eφ Cψ Eψ : ℕ → ℝ)
    (hCφ : ∀ r : ℕ, 0 ≤ Cφ r) (hCψ : ∀ r : ℕ, 0 ≤ Cψ r) :
    ∃ «CΣ» X₀ : ℝ, 0 < «CΣ» ∧ Real.exp 1 ≤ X₀ ∧
      ∀ (x : ℝ), X₀ ≤ x →
      ∀ (m q₀ c₁ c₂ w₁ w₂ z₁ gV : ℕ) (hm : Squarefree m),
      q₀ ∣ m → c₁ ∣ m → c₂ ∣ m → 0 < gV →
      0 < w₁ → Squarefree w₁ → 0 < z₁ → w₁ ∣ z₁ → Nat.Coprime z₁ m →
      ∀ (lam lamTilde k ell A B d₀ dstar nstar : ℤ),
      ∀ (Λ Δ₁ N M Hscale γ : ℝ),
      Λ ≠ 0 → 0 < Δ₁ → 0 < N → 0 < M → 1 ≤ Hscale → 0 ≤ d₀ →
      0 ≤ γ → γ ≤ 1 → N = x ^ γ → M * N ≤ CMN * x →
      Hscale ≤ CH * x ^ (4 * «ω» + δ + 7 * ε) / (q₀ : ℝ) →
      cΔ * N / (x ^ (δ + 55 * ε) * Hscale ^ 2) ≤ Δ₁ →
      Δ₁ ≤ CΔ * N / (x ^ (55 * ε) * Hscale ^ 2) →
      (m : ℝ) ≤ Cm * x ^ (δ - ε) * M * Hscale ^ 2 / ((gV : ℝ) * Δ₁) →
      (w₁ : ℝ) ≤ Cw * x ^ (5 * ε) * Δ₁ →
      |Λ| ≤ CΛ * x ^ (δ + 5 * ε) * Hscale ^ 2 / ((w₁ : ℝ) * (gV : ℝ)) →
      (1 ≤ (lam : ℝ) / Λ ∧ (lam : ℝ) / Λ < 2) →
      (1 ≤ (lamTilde : ℝ) / Λ ∧ (lamTilde : ℝ) / Λ < 2) →
      w₂ = ∏ p ∈ m.primeFactors, p ^ (lam.natAbs.factorization p) →
      w₂ = ∏ p ∈ m.primeFactors, p ^ (lamTilde.natAbs.factorization p) →
      Int.gcd (((z₁ / w₁ : ℕ) : ℤ)) ((m : ℤ) * lam * lamTilde) = 1 →
      IsUnit (A : ZMod m) →
      ∀ (φ ψ : ℝ → ℂ), ContDiff ℝ ∞ φ → ContDiff ℝ ∞ ψ →
      Function.support φ ⊆ Set.Icc cD CD →
      Function.support ψ ⊆ Set.Icc cN CN →
      (∀ (r : ℕ) (t : ℝ), ‖iteratedDeriv r φ t‖ ≤ Cφ r * (Real.log x) ^ Eφ r) →
      (∀ (r : ℕ) (t : ℝ), ‖iteratedDeriv r ψ t‖ ≤ Cψ r * (Real.log x) ^ Eψ r) →
      letI : NeZero m := ⟨hm.ne_zero⟩
      let s : ℤ := ((z₁ / w₁ : ℕ) : ℤ)
      let g : ℕ := Int.gcd lam lamTilde
      let Jk : ℤ := s * k + (lam - lamTilde) * B
      let nk : ℤ → ℤ → ℤ := fun n d => (lamTilde * n + s * k * d) / lam
      let Δstar : ℝ := min (N / (|Λ| * x ^ (5 * ε))) Δ₁
      let BD : Finset ℤ :=
        Finset.Icc ⌈((d₀ : ℝ) + cD * Δ₁) / (z₁ : ℝ)⌉
          ⌊((d₀ : ℝ) + CD * Δ₁) / (z₁ : ℝ)⌋
      let BN : Finset ℤ := Finset.Icc ⌈cN * N⌉ ⌊CN * N⌋
      let H : ℤ × ℤ → ℂ := fun z =>
        if Int.ModEq (q₀ : ℤ) z.1 dstar ∧ Int.ModEq (q₀ : ℤ) z.2 nstar ∧
            Int.gcd z.1 ((m : ℤ) * lam * lamTilde) = 1 ∧
            lam ∣ lamTilde * z.2 + s * k * z.1 ∧
            Int.gcd (z.2 * nk z.2 z.1) ((w₁ * c₁ : ℕ) : ℤ) = 1 ∧
            Int.gcd ((z.2 + ell * z.1) * (nk z.2 z.1 + ell * z.1)) (c₂ : ℤ) = 1
        then
          φ (((z₁ : ℝ) * (z.1 : ℝ) - (d₀ : ℝ)) / Δ₁) * ψ ((z.2 : ℝ) / N) *
            reciprocalUnitPhase m ((A : ZMod m) * (Jk : ZMod m))
              (((z.2 + B * z.1 : ℤ) : ZMod m) *
                ((nk z.2 z.1 + B * z.1 : ℤ) : ZMod m))
        else 0
      let total : ℂ := ∑ d ∈ BD, ∑ n ∈ BN, H (d, n)
      HasSum H total ∧
        (¬ (g : ℤ) ∣ s * k → total = 0) ∧
        ‖total‖ ≤ «CΣ» * x ^ (3 * ε) * (Int.gcd Jk (m : ℤ) : ℝ) *
          (1 / (q₀ : ℝ)) * (Δ₁ / Δstar) *
          (N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
          (Δstar / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) := by
  let E : ℝ := 4 * «ω» + δ + 7 * ε
  let U : ℝ := 2 * δ + 54 * ε
  let Csrc : ℝ := 2 + 16 * «ω» + 6 * δ + 82 * ε
  let Km : ℝ := Cm * CMN * CH ^ 4 / cΔ
  have hCsrc2 : 2 ≤ Csrc := by dsimp only [Csrc]; linarith
  have hCsrc : 0 ≤ Csrc := le_trans (by norm_num) hCsrc2
  obtain ⟨«CΣ», Y, hSigma, hY, huniform⟩ :=
    sourceTerminalSigma6_uniform_bound_of_deligne hDeligne
      Csrc ε cD CD cN CN hCsrc hε hcD hCD hcN hCN
      Cφ Eφ Cψ Eψ hCφ hCψ
  let X : ℝ := max Y (max 2 (max Km (max (Cw * CΔ) (max CΔ (CΛ * CH ^ 2)))))
  refine ⟨«CΣ», X, hSigma, hY.trans (le_max_left _ _), ?_⟩
  intro x hx m q₀ c₁ c₂ w₁ w₂ z₁ gV hm hq₀ hc₁ hc₂ hgV
    hw₁ hsw₁ hz₁ hwz hzm lam lamTilde k ell A B d₀ dstar nstar
    Λ Δ₁ N M Hscale γ hΛ hΔ₁ hN hM hHscale hd₀ hγ0 hγ1 hNγ hMN
    hHupper hΔlower hΔupper hmupper hwupper hΛupper hdyadic hdyadicTilde
    hw₂ hw₂Tilde hprimitive hA
  have hthreshold : Y ≤ x ∧ 2 ≤ x ∧ Km ≤ x ∧ Cw * CΔ ≤ x ∧
      CΔ ≤ x ∧ CΛ * CH ^ 2 ≤ x := by
    simpa only [X, max_le_iff] using hx
  obtain ⟨hxY, hx2, hxKm, hxw, hxΔ, hxΛ⟩ := hthreshold
  have hx1 : 1 ≤ x := le_trans (by norm_num) hx2
  have hx0 : 0 < x := lt_of_lt_of_le zero_lt_one hx1
  have hpow (a : ℝ) : 0 < x ^ a := Real.rpow_pos_of_pos hx0 a
  have htimes (a : ℝ) : x * x ^ a = x ^ (1 + a) := by
    rw [Real.rpow_add hx0 1 a, Real.rpow_one]
  have hqone : (1 : ℝ) ≤ q₀ := by
    exact_mod_cast Nat.pos_of_dvd_of_pos hq₀ (Nat.pos_of_ne_zero hm.ne_zero)
  have hgone : (1 : ℝ) ≤ gV := by exact_mod_cast hgV
  have hgpos : (0 : ℝ) < gV := by exact_mod_cast hgV
  have hwone : (1 : ℝ) ≤ w₁ := by exact_mod_cast hw₁
  have hHpos : 0 < Hscale := lt_of_lt_of_le zero_lt_one hHscale
  have hHsqpos : 0 < Hscale ^ 2 := pow_pos hHpos 2
  have hHsqone : 1 ≤ Hscale ^ 2 := one_le_pow₀ hHscale
  have hNone : 1 ≤ N := by
    rw [hNγ]
    exact Real.one_le_rpow hx1 hγ0
  have hNx : N ≤ x := by
    rw [hNγ]
    simpa only [Real.rpow_one] using Real.rpow_le_rpow_of_exponent_le hx1 hγ1
  have hMx : M ≤ CMN * x :=
    (le_mul_of_one_le_right hM.le hNone).trans hMN
  have hHsimple : Hscale ≤ CH * x ^ E :=
    hHupper.trans (div_le_self (by positivity) hqone)
  have hHpower (r : ℕ) : Hscale ^ r ≤ CH ^ r * x ^ (E * (r : ℝ)) := by
    calc
      _ ≤ (CH * x ^ E) ^ r := pow_le_pow_left₀ hHpos.le hHsimple r
      _ = _ := by rw [mul_pow, Real.rpow_mul_natCast hx0.le]
  have hΔinv : 1 / Δ₁ ≤ x ^ (δ + 55 * ε) * Hscale ^ 2 / (cΔ * N) := by
    apply (div_le_div_iff₀ hΔ₁ (mul_pos hcΔ hN)).mpr
    have h := (div_le_iff₀ (mul_pos (hpow (δ + 55 * ε)) hHsqpos)).mp hΔlower
    simpa only [one_mul, mul_one, mul_comm] using h
  have hmsecond : (m : ℝ) ≤
      (Cm / cΔ) * x ^ U * M * Hscale ^ 4 / ((gV : ℝ) * N) := by
    calc
      _ ≤ Cm * x ^ (δ - ε) * M * Hscale ^ 2 / ((gV : ℝ) * Δ₁) := hmupper
      _ = (Cm * x ^ (δ - ε) * M * Hscale ^ 2 / (gV : ℝ)) * (1 / Δ₁) := by
        simp only [div_eq_mul_inv, mul_inv_rev]
        ring
      _ ≤ (Cm * x ^ (δ - ε) * M * Hscale ^ 2 / (gV : ℝ)) *
          (x ^ (δ + 55 * ε) * Hscale ^ 2 / (cΔ * N)) :=
        mul_le_mul_of_nonneg_left hΔinv (by positivity)
      _ = _ := by
        have hexp : U = (δ - ε) + (δ + 55 * ε) := by dsimp only [U]; ring
        rw [hexp, Real.rpow_add hx0 (δ - ε) (δ + 55 * ε)]
        field_simp [hgpos.ne', hcΔ.ne', hN.ne']
  have hmfixed : (m : ℝ) ≤ Km * x ^ (Csrc - 1) := by
    calc
      _ ≤ (Cm / cΔ) * x ^ U * M * Hscale ^ 4 / ((gV : ℝ) * N) := hmsecond
      _ ≤ (Cm / cΔ) * x ^ U * M * Hscale ^ 4 :=
        div_le_self (by positivity) (one_le_mul_of_one_le_of_one_le hgone hNone)
      _ ≤ (Cm / cΔ) * x ^ U * (CMN * x) * (CH ^ 4 * x ^ (E * 4)) := by
        apply mul_le_mul
        · exact mul_le_mul_of_nonneg_left hMx (by positivity)
        · exact hHpower 4
        · exact pow_nonneg hHpos.le 4
        · positivity
      _ = Km * x ^ (U + 1 + E * 4) := by
        dsimp only [Km]
        rw [Real.rpow_add hx0 (U + 1) (E * 4), Real.rpow_add hx0 U 1,
          Real.rpow_one]
        ring
      _ = Km * x ^ (Csrc - 1) := by
        have hexp : U + 1 + E * 4 = Csrc - 1 := by dsimp only [U, E, Csrc]; ring
        rw [hexp]
  have hmcap : (m : ℝ) ≤ x ^ Csrc := by
    calc
      _ ≤ Km * x ^ (Csrc - 1) := hmfixed
      _ ≤ x * x ^ (Csrc - 1) :=
        mul_le_mul_of_nonneg_right hxKm (hpow (Csrc - 1)).le
      _ = x ^ (1 + (Csrc - 1)) := htimes _
      _ = x ^ Csrc := by congr 1; ring
  have hdenone : 1 ≤ x ^ (55 * ε) * Hscale ^ 2 :=
    one_le_mul_of_one_le_of_one_le (Real.one_le_rpow hx1 (by linarith)) hHsqone
  have hΔx : Δ₁ ≤ CΔ * x := by
    calc
      _ ≤ CΔ * N / (x ^ (55 * ε) * Hscale ^ 2) := hΔupper
      _ ≤ CΔ * N := div_le_self (by positivity) hdenone
      _ ≤ CΔ * x := mul_le_mul_of_nonneg_left hNx hCΔ.le
  have hdecay : x ^ (5 * ε) ≤ x ^ (55 * ε) * Hscale ^ 2 := by
    calc
      _ ≤ x ^ (55 * ε) := Real.rpow_le_rpow_of_exponent_le hx1 (by linarith)
      _ ≤ x ^ (55 * ε) * Hscale ^ 2 :=
        le_mul_of_one_le_right (hpow (55 * ε)).le hHsqone
  have hwx : (w₁ : ℝ) ≤ (Cw * CΔ) * x := by
    calc
      _ ≤ Cw * x ^ (5 * ε) * Δ₁ := hwupper
      _ ≤ Cw * x ^ (5 * ε) * (CΔ * N / (x ^ (55 * ε) * Hscale ^ 2)) :=
        mul_le_mul_of_nonneg_left hΔupper (by positivity)
      _ = (Cw * CΔ * N) * (x ^ (5 * ε) / (x ^ (55 * ε) * Hscale ^ 2)) := by ring
      _ ≤ (Cw * CΔ * N) * 1 :=
        mul_le_mul_of_nonneg_left
          ((div_le_one (mul_pos (hpow (55 * ε)) hHsqpos)).mpr hdecay) (by positivity)
      _ = (Cw * CΔ) * N := by ring
      _ ≤ (Cw * CΔ) * x := mul_le_mul_of_nonneg_left hNx (mul_nonneg hCw.le hCΔ.le)
  have hxx : x * x ≤ x ^ Csrc := by
    calc
      _ = x ^ (2 : ℝ) := by rw [Real.rpow_two, pow_two]
      _ ≤ _ := Real.rpow_le_rpow_of_exponent_le hx1 hCsrc2
  have hwcap : (w₁ : ℝ) ≤ x ^ Csrc :=
    (hwx.trans (mul_le_mul_of_nonneg_right hxw hx0.le)).trans hxx
  have hΔcap : Δ₁ ≤ x ^ Csrc :=
    (hΔx.trans (mul_le_mul_of_nonneg_right hxΔ hx0.le)).trans hxx
  have hΛsmall : |Λ| ≤ (CΛ * CH ^ 2) * x ^ (δ + 5 * ε + E * 2) := by
    calc
      _ ≤ CΛ * x ^ (δ + 5 * ε) * Hscale ^ 2 / ((w₁ : ℝ) * (gV : ℝ)) := hΛupper
      _ ≤ CΛ * x ^ (δ + 5 * ε) * Hscale ^ 2 :=
        div_le_self (by positivity) (one_le_mul_of_one_le_of_one_le hwone hgone)
      _ ≤ CΛ * x ^ (δ + 5 * ε) * (CH ^ 2 * x ^ (E * 2)) :=
        mul_le_mul_of_nonneg_left (hHpower 2) (by positivity)
      _ = _ := by rw [Real.rpow_add hx0 (δ + 5 * ε) (E * 2)]; ring
  have hΛcap : |Λ| ≤ x ^ Csrc := by
    calc
      _ ≤ (CΛ * CH ^ 2) * x ^ (δ + 5 * ε + E * 2) := hΛsmall
      _ ≤ x * x ^ (δ + 5 * ε + E * 2) :=
        mul_le_mul_of_nonneg_right hxΛ (hpow _).le
      _ = x ^ (1 + (δ + 5 * ε + E * 2)) := htimes _
      _ ≤ x ^ Csrc := Real.rpow_le_rpow_of_exponent_le hx1 (by
        dsimp only [E, Csrc]
        linarith)
  have hNcap : N ≤ x ^ Csrc := hNx.trans (by
    simpa only [Real.rpow_one] using
      Real.rpow_le_rpow_of_exponent_le hx1 (show (1 : ℝ) ≤ Csrc by linarith))
  exact huniform x hxY m q₀ c₁ c₂ w₁ w₂ z₁ hm hmcap hq₀ hc₁ hc₂
    hw₁ hsw₁ hz₁ hwz hzm hwcap
    lam lamTilde k ell A B d₀ dstar nstar Λ Δ₁ N hΛ hΔ₁ hN hd₀
    hΛcap hΔcap hNcap hdyadic hdyadicTilde hw₂ hw₂Tilde hprimitive hA

theorem exists_source_positive_cutoff :
    ∃ ψ : ℝ → ℝ, ContDiff ℝ ∞ ψ ∧
      Function.support ψ ⊆ Set.Icc (1 / 2 : ℝ) (5 / 2) ∧
      (∀ t : ℝ, 0 ≤ ψ t ∧ ψ t ≤ 1) ∧
      (∀ t ∈ Set.Icc (1 : ℝ) 2, ψ t = 1) ∧
      ∀ r : ℕ, ∃ C : ℝ, 0 < C ∧ ∀ t : ℝ, ‖iteratedDeriv r ψ t‖ ≤ C := by
  let f : ContDiffBump (3 / 2 : ℝ) :=
    ⟨1 / 2, 1, by norm_num, by norm_num⟩
  have hs : ContDiff ℝ ∞ (f : ℝ → ℝ) := f.contDiff
  refine ⟨f, hs, ?_, fun _ => ⟨f.nonneg, f.le_one⟩, ?_, ?_⟩
  · norm_num [f.support_eq, Real.ball_eq_Ioo, f, Set.Ioo_subset_Icc_self]
  · intro t ht
    apply f.one_of_mem_closedBall
    convert ht using 1
    norm_num [Real.closedBall_eq_Icc, f]
  · intro r
    have hc : HasCompactSupport (iteratedDeriv r (f : ℝ → ℝ)) := by
      rw [iteratedDeriv_eq_equiv_comp]
      exact (f.hasCompactSupport.iteratedFDeriv r).comp_left (map_zero _)
    simpa using (hc.isCompact_range
      (hs.continuous_iteratedDeriv r (by simp))).isBounded.exists_pos_norm_le

theorem source_positive_short_cover
    (Δ δ : ℝ) (hδ : 0 < δ) (hshort : 2 * δ ≤ Δ) :
    let C : Finset ℕ := Finset.range (⌈Δ / δ⌉₊ + 1)
    let center : ℕ → ℝ := fun i => Δ - δ + (i : ℝ) * δ
    C.Nonempty ∧ (C.card : ℝ) ≤ Δ / δ + 2 ∧
      (∀ i ∈ C, Δ / 2 ≤ center i ∧ center i ≤ 2 * Δ) ∧
      (∀ t ∈ Set.Icc Δ (2 * Δ), ∃ i ∈ C,
        δ ≤ t - center i ∧ t - center i ≤ 2 * δ) ∧
      ∀ ψ : ℝ → ℝ, (∀ t : ℝ, 0 ≤ ψ t) →
        (∀ t ∈ Set.Icc (1 : ℝ) 2, 1 ≤ ψ t) →
        ∀ t ∈ Set.Icc Δ (2 * Δ),
          1 ≤ ∑ i ∈ C, ψ ((t - center i) / δ) := by
  intro C center
  have hq : 0 ≤ Δ / δ := div_nonneg (by linarith) hδ.le
  have hcard : (C.card : ℝ) ≤ Δ / δ + 2 := by
    dsimp only [C]
    rw [Finset.card_range, Nat.cast_add, Nat.cast_one]
    linarith [Nat.ceil_lt_add_one hq]
  have hcent (i : ℕ) (hi : i ∈ C) :
      Δ / 2 ≤ center i ∧ center i ≤ 2 * Δ := by
    have hiq : (i : ℝ) ≤ Δ / δ + 1 :=
      (Nat.cast_le.mpr (Finset.mem_range_succ_iff.mp hi)).trans
        (Nat.ceil_lt_add_one hq).le
    have hprod : (i : ℝ) * δ ≤ Δ + δ := by
      simpa only [add_mul, div_mul_cancel₀ _ hδ.ne', one_mul] using
        mul_le_mul_of_nonneg_right hiq hδ.le
    dsimp only [center]
    constructor
    · nlinarith [mul_nonneg (Nat.cast_nonneg i) hδ.le]
    · linarith
  have hcover (t : ℝ) (ht : t ∈ Set.Icc Δ (2 * Δ)) :
      ∃ i ∈ C, δ ≤ t - center i ∧ t - center i ≤ 2 * δ := by
    have hy0 : 0 ≤ (t - Δ) / δ := div_nonneg (sub_nonneg.mpr ht.1) hδ.le
    have hyq : (t - Δ) / δ ≤ Δ / δ :=
      div_le_div_of_nonneg_right (by linarith [ht.2]) hδ.le
    let i : ℕ := ⌊(t - Δ) / δ⌋₊
    refine ⟨i, Finset.mem_range_succ_iff.mpr
      ((Nat.floor_mono hyq).trans (Nat.floor_le_ceil _)), ?_, ?_⟩
    · have hl : (i : ℝ) * δ ≤ t - Δ := (le_div_iff₀ hδ).mp (Nat.floor_le hy0)
      dsimp only [center]
      linarith
    · have hu : t - Δ < ((i : ℝ) + 1) * δ :=
        (div_lt_iff₀ hδ).mp (Nat.lt_floor_add_one ((t - Δ) / δ))
      dsimp only [center]
      nlinarith
  refine ⟨Finset.nonempty_range_add_one, hcard, hcent, hcover, ?_⟩
  intro ψ hψ hψone t ht
  obtain ⟨i, hi, hlo, hhi⟩ := hcover t ht
  have harg : (t - center i) / δ ∈ Set.Icc (1 : ℝ) 2 :=
    ⟨(one_le_div hδ).mpr hlo, (div_le_iff₀ hδ).mpr hhi⟩
  exact (hψone _ harg).trans (Finset.single_le_sum (fun j _ => hψ ((t - center j) / δ)) hi)

open Classical in
/--
The dispersion frequency correlation with integer residue parameters `a`, `b₁`, and `b₂`,
retaining the compatibility and coprimality restrictions. Each reciprocal phase is the product
of its three local factors and is defined to be zero if one of their moduli vanishes.
-/
noncomputable def sourceSignedDispersionFrequencyBlock
    (E : Finset (ℤ × ℤ)) (ψM wN : ℝ → ℝ) (M : ℝ)
    (r q₀ u v₁ v₂ q₂ : ℕ) (a b₁ b₂ ℓ : ℤ) : ℂ :=
  let Θ : ℕ → ℤ → ℤ → ℂ := fun v n h =>
    if hp : r ≠ 0 ∧ q₀ * u * v ≠ 0 ∧ q₂ ≠ 0 then
      let _ : NeZero r := ⟨hp.1⟩
      let _ : NeZero (q₀ * u * v) := ⟨hp.2.1⟩
      let _ : NeZero q₂ := ⟨hp.2.2⟩
      reciprocalUnitPhase r
        ((a : ZMod r) * (h : ZMod r))
        ((n : ZMod r) * ((q₀ * u * v * q₂ : ℕ) : ZMod r)) *
      reciprocalUnitPhase (q₀ * u * v)
        ((b₁ : ZMod (q₀ * u * v)) * (h : ZMod (q₀ * u * v)))
        ((n : ZMod (q₀ * u * v)) * ((r * q₂ : ℕ) : ZMod (q₀ * u * v))) *
      reciprocalUnitPhase q₂
        ((b₂ : ZMod q₂) * (h : ZMod q₂))
        (((n + ℓ * (r : ℤ) : ℤ) : ZMod q₂) *
          ((r * q₀ * u * v : ℕ) : ZMod q₂))
    else 0
  ∑ h ∈ E, ∑' n : ℤ,
    if Int.gcd n ((r * q₀ * u * v₁ * v₂ : ℕ) : ℤ) = 1 ∧
        Int.gcd (n + ℓ * (r : ℤ)) ((q₀ * q₂ : ℕ) : ℤ) = 1 then
      ((if Int.gcd (n * (n + ℓ * (r : ℤ))) (q₀ : ℤ) = 1 ∧
          (b₁ : ZMod q₀) * (n : ZMod q₀)⁻¹ =
            (b₂ : ZMod q₀) * ((n + ℓ * (r : ℤ) : ℤ) : ZMod q₀)⁻¹
        then (1 : ℝ) else 0) : ℂ) *
        sourcePhi ψM M (r * q₀ * u * v₁ * q₂) h.1 *
        star (sourcePhi ψM M (r * q₀ * u * v₂ * q₂) h.2) *
        (wN (n : ℝ) : ℂ) * (Θ v₁ n h.1 * star (Θ v₂ n h.2))
    else 0

theorem sourceDispersionFrequencyBlock_common_signed
    (P : ℕ) [NeZero P] (r q₀ u v₁ v₂ q₂ : ℕ)
    (hfull : r * q₀ * u * v₁ * v₂ * q₂ ∣ P) (a b₁ b₂ : ℤ) :
    let aN : ℕ := (a : ZMod P).val
    let b₁N : ℕ := (b₁ : ZMod P).val
    let b₂N : ℕ := (b₂ : ZMod P).val
    (Nat.Coprime (r * q₀ * u * v₁ * v₂ * q₂) (aN * b₁N * b₂N) ↔
      Int.gcd (a * b₁ * b₂) ((r * q₀ * u * v₁ * v₂ * q₂ : ℕ) : ℤ) = 1) ∧
    ∀ (E : Finset (ℤ × ℤ)) (ψM wN : ℝ → ℝ) (M : ℝ) (ℓ : ℤ),
      sourceDispersionFrequencyBlock E ψM wN M
        r q₀ u v₁ v₂ q₂ aN b₁N b₂N ℓ =
      sourceSignedDispersionFrequencyBlock E ψM wN M r q₀ u v₁ v₂ q₂ a b₁ b₂ ℓ := by
  dsimp only
  have hcast (q : ℕ) (hq : q ∣ r * q₀ * u * v₁ * v₂ * q₂) :=
    sourceDispersion_commonResidues P a b₁ b₂ q (hq.trans hfull)
  have hcompat := hcast q₀ ⟨r * u * v₁ * v₂ * q₂, by ring⟩
  constructor
  · exact Nat.coprime_comm.trans (hcast _ dvd_rfl).2.2.2
  · intro E ψM wN M ℓ
    simp only [sourceDispersionFrequencyBlock, sourceSignedDispersionFrequencyBlock,
      sourceCompatibility, sourceTheta, (hcast r (by simp [mul_assoc])).1,
      hcompat.2.1, hcompat.2.2.1,
      (hcast (q₀ * u * v₁) ⟨r * v₂ * q₂, by ring⟩).2.1,
      (hcast (q₀ * u * v₂) ⟨r * v₁ * q₂, by ring⟩).2.1,
      (hcast q₂ (dvd_mul_left _ _)).2.2.1, apply_ite Complex.ofReal, Complex.ofReal_zero]

open Classical in
theorem sourceSigmaTwo_cutoff_common_modulus
    {ι : Type*} (F : Finset (ℕ × ℕ × ℕ)) (C : Finset ι) (d₀ : ι → ℝ)
    (r₁ q₀ u q₂ : ℕ) (hr₁ : 0 < r₁) (hq₀ : 0 < q₀)
    (hu : 0 < u) (hq₂ : 0 < q₂)
    (hF : ∀ p ∈ F, 0 < p.1 ∧ 0 < p.2.1 ∧ 0 < p.2.2)
    (Δ₁ : ℝ) (hΔ₁ : 0 < Δ₁) (ψD : ℝ → ℝ)
    (hsD : Function.support ψD ⊆ Set.Icc (1 / 2 : ℝ) (5 / 2)) :
    let 𝒱 : Finset (ℕ × ℕ) := F.image Prod.snd
    let D : Finset ℕ := C.biUnion
      (fun i => Finset.Icc 1 ⌊d₀ i + (5 / 2 : ℝ) * Δ₁⌋₊)
    let G : Finset (ℕ × ℕ × ℕ) := F ∪ (D ×ˢ 𝒱)
    let full : ℕ × ℕ × ℕ → ℕ := fun p =>
      (p.1 * r₁) * q₀ * u * p.2.1 * p.2.2 * q₂
    let P : ℕ := ∏ p ∈ G, full p
    0 < P ∧ (F = ∅ → P = 1) ∧
      (∀ p ∈ G, 0 < full p ∧ full p ∣ P) ∧
      ∀ a b₁ b₂ : ℤ,
        let aN : ℕ := (a : ZMod P).val
        let b₁N : ℕ := (b₁ : ZMod P).val
        let b₂N : ℕ := (b₂ : ZMod P).val
        (∀ p ∈ G,
          Nat.Coprime (full p) (aN * b₁N * b₂N) ↔
            Int.gcd (a * b₁ * b₂) (full p : ℤ) = 1) ∧
        (∀ (E : Finset (ℤ × ℤ)) (ψM wN : ℝ → ℝ) (M : ℝ) (ℓ : ℤ),
          ∀ p ∈ F,
            sourceDispersionFrequencyBlock E ψM wN M
              (p.1 * r₁) q₀ u p.2.1 p.2.2 q₂ aN b₁N b₂N ℓ =
            sourceSignedDispersionFrequencyBlock E ψM wN M
              (p.1 * r₁) q₀ u p.2.1 p.2.2 q₂ a b₁ b₂ ℓ) ∧
        ∀ (J : Finset ℤ) (ψM wN : ℝ → ℝ) (M : ℝ) (ℓ : ℤ),
          ∀ v ∈ 𝒱, ∀ i ∈ C,
            let m : ℕ := r₁ * q₀ * u * Nat.lcm v.1 v.2 * q₂
            let E := (J ×ˢ J).filter
              (fun h => h.1 * (v.2 : ℤ) ≠ h.2 * (v.1 : ℤ))
            sourceSigmaTwo J ψM wN ψD M Δ₁ (d₀ i)
              r₁ q₀ u v.1 v.2 q₂ aN b₁N b₂N ℓ =
            ∑' d : ℕ,
              if Squarefree d ∧ Nat.Coprime d m then
                ψD (((d : ℝ) - d₀ i) / Δ₁) *
                  ‖sourceSignedDispersionFrequencyBlock E ψM wN M
                    (d * r₁) q₀ u v.1 v.2 q₂ a b₁ b₂ ℓ‖
              else 0 := by
  intro 𝒱 D G full P
  have hfullpos (p : ℕ × ℕ × ℕ) (hp : p ∈ G) : 0 < full p := by
    have hcoords : 0 < p.1 ∧ 0 < p.2.1 ∧ 0 < p.2.2 := by
      rcases Finset.mem_union.mp hp with hp | hp
      · exact hF p hp
      · obtain ⟨hd, hv⟩ := Finset.mem_product.mp hp
        obtain ⟨q, hq, hqv⟩ := Finset.mem_image.mp hv
        obtain ⟨_, _, hdi⟩ := Finset.mem_biUnion.mp hd
        exact ⟨(Finset.mem_Icc.mp hdi).1, hqv ▸ (hF q hq).2⟩
    rcases hcoords with ⟨hd, hv₁, hv₂⟩
    dsimp only [full]
    positivity
  have hP : 0 < P := Finset.prod_pos hfullpos
  have hdvd (p : ℕ × ℕ × ℕ) (hp : p ∈ G) : full p ∣ P :=
    Finset.dvd_prod_of_mem full hp
  refine ⟨hP, ?_, fun p hp => ⟨hfullpos p hp, hdvd p hp⟩, ?_⟩
  · intro hFempty
    simp [P, G, 𝒱, hFempty]
  · let : NeZero P := ⟨hP.ne'⟩
    intro a b₁ b₂ aN b₁N b₂N
    have htransport (p : ℕ × ℕ × ℕ) (hp : p ∈ G) :=
      sourceDispersionFrequencyBlock_common_signed P
        (p.1 * r₁) q₀ u p.2.1 p.2.2 q₂ (hdvd p hp) a b₁ b₂
    refine ⟨fun p hp => (htransport p hp).1, ?_, ?_⟩
    · intro E ψM wN M ℓ p hp
      exact (htransport p (Finset.mem_union_left _ hp)).2 E ψM wN M ℓ
    · intro J ψM wN M ℓ v hv i hi m E
      dsimp only [sourceSigmaTwo]
      apply tsum_congr
      intro d
      by_cases hd : Squarefree d ∧ Nat.Coprime d m <;> dsimp only [m] at hd ⊢
      · simp only [ite_eq_left hd]
        by_cases hw : ψD (((d : ℝ) - d₀ i) / Δ₁) = 0
        · simp only [hw, zero_mul]
        · have hbound := (div_le_iff₀ hΔ₁).mp (hsD hw).2
          have hdD : d ∈ D := Finset.mem_biUnion.mpr
            ⟨i, hi, Finset.mem_Icc.mpr
              ⟨Nat.pos_of_ne_zero hd.1.ne_zero, Nat.le_floor (by linarith)⟩⟩
          have hdG : (d, v) ∈ G :=
            Finset.mem_union_right _ (Finset.mk_mem_product hdD hv)
          rw [(htransport (d, v) hdG).2 E ψM wN M ℓ]
      · simp only [ite_eq_right hd]

theorem exists_source_scale_positive_short_cover :
    ∃ ψ : ℝ → ℝ, ∃ B : ℕ → ℝ,
      ContDiff ℝ ∞ ψ ∧
      Function.support ψ ⊆ Set.Icc (1 / 2 : ℝ) (5 / 2) ∧
      (∀ t : ℝ, 0 ≤ ψ t ∧ ψ t ≤ 1) ∧
      (∀ t ∈ Set.Icc (1 : ℝ) 2, ψ t = 1) ∧
      (∀ j : ℕ, 0 < B j) ∧
      (∀ (j : ℕ) (t : ℝ), ‖iteratedDeriv j ψ t‖ ≤ B j) ∧
      ∀ ε : ℝ, 0 < ε →
        ∃ X : ℝ, 1 ≤ X ∧ ∀ x : ℝ, X ≤ x → ∀ Δ : ℝ, 0 < Δ →
          let Δ₁ : ℝ := x ^ (-5 * ε) * Δ
          let C : Finset ℕ := Finset.range (⌈Δ / Δ₁⌉₊ + 1)
          let center : ℕ → ℝ := fun i => Δ - Δ₁ + (i : ℝ) * Δ₁
          0 < Δ₁ ∧ 2 * Δ₁ ≤ Δ ∧ Δ / Δ₁ = x ^ (5 * ε) ∧
            C.Nonempty ∧ (C.card : ℝ) ≤ x ^ (5 * ε) + 2 ∧
            (C.card : ℝ) ≤ 3 * x ^ (5 * ε) ∧
            (∀ i ∈ C, Δ / 2 ≤ center i ∧ center i ≤ 2 * Δ) ∧
            (∀ t ∈ Set.Icc Δ (2 * Δ), ∃ i ∈ C,
              Δ₁ ≤ t - center i ∧ t - center i ≤ 2 * Δ₁) ∧
            (∀ t ∈ Set.Icc Δ (2 * Δ),
              1 ≤ ∑ i ∈ C, ψ ((t - center i) / Δ₁)) ∧
            ∀ i ∈ C,
              Function.support (fun t : ℝ => ψ ((t - center i) / Δ₁)) ⊆
                Set.Icc (center i + Δ₁ / 2) (center i + (5 / 2 : ℝ) * Δ₁) ∧
              ContDiff ℝ ∞ (fun t : ℝ => ψ ((t - center i) / Δ₁)) ∧
              (∀ t ∈ Set.Icc (center i + Δ₁) (center i + 2 * Δ₁),
                ψ ((t - center i) / Δ₁) = 1) ∧
              ∀ (j : ℕ) (t : ℝ),
                ‖iteratedDeriv j (fun z : ℝ => ψ ((z - center i) / Δ₁)) t‖ ≤
                  B j / Δ₁ ^ j := by
  obtain ⟨ψ, hψ, hsψ, hψbounds, hψone, hderiv⟩ := exists_source_positive_cutoff
  choose B hBpos hBbound using hderiv
  refine ⟨ψ, B, hψ, hsψ, hψbounds, hψone, hBpos, hBbound, ?_⟩
  intro ε hε
  have hεpos : 0 < 5 * ε := by positivity
  have hsmall : ∀ᶠ x : ℝ in Filter.atTop, x ^ (-(5 * ε)) ≤ (1 / 2 : ℝ) :=
    (tendsto_rpow_neg_atTop hεpos).eventually_le_const (by norm_num)
  obtain ⟨X₀, hX₀⟩ := hsmall.exists_forall_of_atTop
  refine ⟨max 1 X₀, le_max_left _ _, ?_⟩
  intro x hx Δ hΔ
  have hxone : 1 ≤ x := (le_max_left 1 X₀).trans hx
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  have hxsmall : x ^ (-5 * ε) ≤ (1 / 2 : ℝ) := by
    simpa only [neg_mul] using hX₀ x ((le_max_right 1 X₀).trans hx)
  intro Δ₁ C center
  have hΔ₁ : 0 < Δ₁ := mul_pos (Real.rpow_pos_of_pos hxpos _) hΔ
  have hshort : 2 * Δ₁ ≤ Δ := by
    dsimp only [Δ₁]
    nlinarith [mul_le_mul_of_nonneg_right hxsmall hΔ.le]
  have hratio : Δ / Δ₁ = x ^ (5 * ε) := by
    dsimp only [Δ₁]
    rw [div_mul_cancel_right₀ hΔ.ne', neg_mul, Real.rpow_neg hxpos.le, inv_inv]
  obtain ⟨hC, hcard, hcenter, hcover, hmajor⟩ :=
    source_positive_short_cover Δ Δ₁ hΔ₁ hshort
  have hcard' : (C.card : ℝ) ≤ x ^ (5 * ε) + 2 :=
    hcard.trans_eq (congrArg (· + 2) hratio)
  refine ⟨hΔ₁, hshort, hratio, hC, hcard', ?_, hcenter, hcover, ?_, ?_⟩
  · linarith [Real.one_le_rpow hxone hεpos.le]
  · exact hmajor ψ (fun t => (hψbounds t).1)
      (fun t ht => (hψone t ht).ge)
  · intro i _
    refine ⟨?_, ?_, ?_, ?_⟩
    · intro t ht
      have hlo := (le_div_iff₀ hΔ₁).mp (hsψ ht).1
      have hhi := (div_le_iff₀ hΔ₁).mp (hsψ ht).2
      constructor <;> linarith
    · exact hψ.comp (by fun_prop)
    · intro t ht
      apply hψone
      exact ⟨(one_le_div hΔ₁).mpr (by linarith [ht.1]),
        (div_le_iff₀ hΔ₁).mpr (by linarith [ht.2])⟩
    · intro j t
      have hψj : ContDiff ℝ j ψ := hψ.of_le (by simp)
      have hscaled :
          iteratedDeriv j (fun z : ℝ => ψ ((z - center i) / Δ₁)) t =
            Δ₁⁻¹ ^ j * iteratedDeriv j ψ ((t - center i) / Δ₁) := by
        simpa only [div_eq_mul_inv, mul_comm] using
          (congrFun (iteratedDeriv_comp_sub_const j
            (fun y : ℝ => ψ (Δ₁⁻¹ * y)) (center i)) t).trans
              (congrFun (iteratedDeriv_comp_const_mul hψj Δ₁⁻¹) (t - center i))
      have hfactor : 0 ≤ Δ₁⁻¹ ^ j := by positivity
      rw [hscaled, norm_mul, Real.norm_of_nonneg hfactor]
      simpa only [inv_pow, div_eq_mul_inv, mul_comm] using
        mul_le_mul_of_nonneg_left (hBbound j ((t - center i) / Δ₁)) hfactor

theorem source_terminal_sigma5_ratio_comparison
    (x δ ε N H κ q₀ g g₀ s₂ Δ₁ Δstar m T : ℝ)
    (hx : 0 < x) (hN : 0 < N) (hH : 0 < H) (hκ : 0 < κ)
    (hq₀ : 0 < q₀) (hg : 0 < g) (hg₀ : 0 < g₀) (hs₂ : 0 < s₂)
    (hΔ₁ : 0 < Δ₁) (hΔstar : 0 < Δstar) (hm : 0 < m)
    (hT : 0 ≤ T) (hΔstarN : Δstar ≤ N)
    (hTupper : T ≤ x ^ (δ + 100 * ε) * H ^ 2 * N / (g * Δ₁)) :
    let Rtarget : ℝ := max (x ^ (δ + 10 * ε) * H ^ 3) (H ^ 4)
    let W : ℝ := max (x ^ (δ + 10 * ε) * H ^ 5) (H ^ 6)
    let target : ℝ := s₂ * q₀ ^ 2 * g₀ ^ 2 * N ^ 2 /
      (κ ^ 2 * x ^ (27 * ε) * Rtarget)
    let ratioA : ℝ := κ ^ 2 * x ^ (δ + 131 * ε) * W /
      (g * q₀ ^ 2 * g₀ * m)
    let ratioB : ℝ := κ ^ 2 * x ^ (δ + 131 * ε) * W /
      (g * q₀ ^ 2 * g₀ * Δstar)
    let ratioC : ℝ := κ ^ 2 * x ^ (δ + 131 * ε) * m * W /
      (g * q₀ ^ 2 * g₀ * N * Δstar)
    (q₀ * g₀) *
        ((x ^ (4 * ε) * s₂ * T / q₀) * (Δ₁ / Δstar) *
          (N / Real.sqrt m + Real.sqrt m) *
          (Δstar / Real.sqrt m + Real.sqrt m)) ≤
      target * (ratioA + 2 * ratioB + ratioC) := by
  intro Rtarget W target ratioA ratioB ratioC
  have hpow (a : ℝ) : 0 < x ^ a := Real.rpow_pos_of_pos hx a
  have hRtarget : 0 < Rtarget := lt_max_of_lt_right (pow_pos hH 4)
  have hW : W = H ^ 2 * Rtarget := by
    dsimp only [W, Rtarget]
    rw [mul_max_of_nonneg _ _ (sq_nonneg H)]
    congr 1 <;> ring
  have hsqrt : 0 < Real.sqrt m := Real.sqrt_pos.mpr hm
  have hgeometry :
      (N / Real.sqrt m + Real.sqrt m) *
          (Δstar / Real.sqrt m + Real.sqrt m) =
        N * Δstar / m + N + Δstar + m := by
    calc
      (N / Real.sqrt m + Real.sqrt m) *
          (Δstar / Real.sqrt m + Real.sqrt m) =
          N * Δstar / (Real.sqrt m) ^ 2 + N + Δstar + (Real.sqrt m) ^ 2 := by
        field_simp [hsqrt.ne']
        ring
      _ = N * Δstar / m + N + Δstar + m := by
        rw [Real.sq_sqrt hm.le]
  have hpower104 : x ^ (4 * ε) * x ^ (δ + 100 * ε) = x ^ (δ + 104 * ε) := by
    rw [← Real.rpow_add hx]
    congr 1
    ring
  have hpower131 : x ^ (δ + 131 * ε) = x ^ (δ + 104 * ε) * x ^ (27 * ε) := by
    rw [← Real.rpow_add hx]
    congr 1
    ring
  let F : ℝ := s₂ * g₀ * x ^ (δ + 104 * ε) * H ^ 2 * N / (g * Δstar)
  have hweight :
      x ^ (4 * ε) * s₂ * T / q₀ ≤
        x ^ (4 * ε) * s₂ *
          (x ^ (δ + 100 * ε) * H ^ 2 * N / (g * Δ₁)) / q₀ :=
    div_le_div_of_nonneg_right
      (mul_le_mul le_rfl hTupper hT (mul_nonneg (hpow _).le hs₂.le)) hq₀.le
  calc
    (q₀ * g₀) *
        ((x ^ (4 * ε) * s₂ * T / q₀) * (Δ₁ / Δstar) *
          (N / Real.sqrt m + Real.sqrt m) *
          (Δstar / Real.sqrt m + Real.sqrt m)) ≤
        (q₀ * g₀) *
          ((x ^ (4 * ε) * s₂ *
              (x ^ (δ + 100 * ε) * H ^ 2 * N / (g * Δ₁)) / q₀) *
            (Δ₁ / Δstar) * (N / Real.sqrt m + Real.sqrt m) *
            (Δstar / Real.sqrt m + Real.sqrt m)) := by
      rel [hweight]
    _ = F * (N * Δstar / m + N + Δstar + m) := by
      rw [mul_assoc (x ^ (4 * ε) * s₂ *
        (x ^ (δ + 100 * ε) * H ^ 2 * N / (g * Δ₁)) / q₀ * (Δ₁ / Δstar)),
        hgeometry]
      dsimp only [F]
      rw [← hpower104]
      field_simp [hq₀.ne', hg.ne', hΔ₁.ne', hΔstar.ne', hm.ne']
    _ ≤ F * (N * Δstar / m + 2 * N + m) :=
      mul_le_mul_of_nonneg_left (by linarith only [hΔstarN]) (by dsimp only [F]; positivity)
    _ = target * (ratioA + 2 * ratioB + ratioC) := by
      dsimp only [F, target, ratioA, ratioB, ratioC]
      simp only [hW, hpower131]
      field_simp [hκ.ne', hq₀.ne', hg.ne', hg₀.ne', hN.ne', hΔstar.ne',
        hm.ne', hRtarget.ne', (hpow (27 * ε)).ne']

open Classical in
theorem positive_profile_localization_preserves_samples
    (C : ℝ) (hC : 1 ≤ C) (J : ℕ) :
    ∃ K : ℝ, 0 < K ∧
      ∀ ψ : ℝ → ℂ, ContDiff ℝ ∞ ψ →
      ∃ ψpos : ℝ → ℂ,
        ContDiff ℝ ∞ ψpos ∧
        Function.support ψpos ⊆
          Function.support ψ ∩ Set.Icc (1 / (2 * C)) (2 * C) ∧
        (∀ t ∈ Set.Icc (1 / C) C, ψpos t = ψ t) ∧
        (∀ L : ℝ, 0 ≤ L →
          (∀ r : ℕ, r ≤ J → ∀ t : ℝ, ‖iteratedDeriv r ψ t‖ ≤ L) →
          ∀ r : ℕ, r ≤ J → ∀ t : ℝ, ‖iteratedDeriv r ψpos t‖ ≤ K * L) ∧
        ∀ N : ℝ, 1 ≤ N → ∀ β : ℕ →₀ ℂ,
          (∀ n ∈ β.support, N / C ≤ (n : ℝ) ∧ (n : ℝ) ≤ C * N) →
          (∀ n : ℕ, 0 < n → β n = ψ ((n : ℝ) / N)) →
          β = positiveCompactProfileSequence ψpos (2 * C) N 0 := by
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hinvpos : 0 < 1 / C := one_div_pos.mpr hCpos
  have hinvle : 1 / C ≤ 1 := (div_le_one hCpos).mpr hC
  let c : ℝ := (C + 1 / C) / 2
  let χ : ContDiffBump c :=
    { rIn := C / 2 - 1 / (4 * C)
      rOut := C / 2
      rIn_pos := by rw [div_mul_eq_div_div_swap]; linarith
      rIn_lt_rOut := by rw [div_mul_eq_div_div_swap]; linarith }
  let χc : ℝ → ℂ := fun t => (χ t : ℂ)
  have hχsmooth : ContDiff ℝ ∞ χc :=
    Complex.ofRealCLM.contDiff.comp χ.contDiff
  have hχcompact : HasCompactSupport χc :=
    χ.hasCompactSupport.comp_left (g := Complex.ofReal) Complex.ofReal_zero
  have hχone (t : ℝ) (ht : t ∈ Set.Icc (1 / C) C) : χ t = 1 := by
    apply χ.one_of_mem_closedBall
    rw [Real.closedBall_eq_Icc]
    dsimp only [χ, c]
    rw [div_mul_eq_div_div_swap]
    constructor <;> linarith [ht.1, ht.2]
  have hχsupport (t : ℝ) (ht : χc t ≠ 0) :
      t ∈ Set.Icc (1 / (2 * C)) (2 * C) := by
    have hmem : t ∈ Function.support (χ : ℝ → ℝ) := by
      change χ t ≠ 0
      exact Complex.ofReal_ne_zero.mp ht
    rw [χ.support_eq, Real.ball_eq_Ioo] at hmem
    dsimp only [χ, c] at hmem
    constructor
    · rw [div_mul_eq_div_div_swap]
      linarith [hmem.1]
    · linarith [hmem.2]
  have hχbound (i : ℕ) :
      ∃ B : ℝ, ∀ t : ℝ, ‖iteratedDeriv i χc t‖ ≤ B := by
    simpa only [norm_iteratedFDeriv_eq_norm_iteratedDeriv] using
      (hχsmooth.continuous_iteratedFDeriv
        (m := i) (by exact_mod_cast le_top)).bounded_above_of_compact_support
        (hχcompact.iteratedFDeriv (𝕜 := ℝ) i)
  choose B hB using hχbound
  obtain ⟨M, hM⟩ := Finset.exists_le (insert (1 : ℝ) ((Finset.range (J + 1)).image B))
  have hMpos : 0 < M := zero_lt_one.trans_le (hM _ (Finset.mem_insert_self _ _))
  have hBM (i : ℕ) (hi : i ≤ J) : B i ≤ M :=
    hM _ (Finset.mem_insert_of_mem
      (Finset.mem_image_of_mem B (Finset.mem_range_succ_iff.mpr hi)))
  refine ⟨(2 : ℝ) ^ J * M, by positivity, ?_⟩
  intro ψ hψ
  let ψpos : ℝ → ℂ := fun t => χc t * ψ t
  have hψone (t : ℝ) (ht : t ∈ Set.Icc (1 / C) C) : ψpos t = ψ t := by
    simp only [ψpos, χc, hχone t ht, Complex.ofReal_one, one_mul]
  refine ⟨ψpos, hχsmooth.mul hψ, ?_, hψone, ?_, ?_⟩
  · intro t ht
    change χc t * ψ t ≠ 0 at ht
    exact ⟨right_ne_zero_of_mul ht, hχsupport t (left_ne_zero_of_mul ht)⟩
  · intro L hL hderiv r hr t
    calc
      ‖iteratedDeriv r ψpos t‖ ≤ ∑ i ∈ Finset.range (r + 1),
          (r.choose i : ℝ) * ‖iteratedDeriv i χc t‖ * ‖iteratedDeriv (r - i) ψ t‖ := by
        simpa only [norm_iteratedFDeriv_eq_norm_iteratedDeriv, ψpos] using
          norm_iteratedFDeriv_mul_le hχsmooth hψ t (n := r) (by exact_mod_cast le_top)
      _ ≤ ∑ i ∈ Finset.range (r + 1), (r.choose i : ℝ) * M * L := by
        gcongr with i hi
        · exact (hB i t).trans (hBM i ((Finset.mem_range_succ_iff.mp hi).trans hr))
        · exact hderiv (r - i) ((Nat.sub_le r i).trans hr) t
      _ = (2 : ℝ) ^ r * M * L := by
        simp only [← Finset.sum_mul, ← Nat.cast_sum, Nat.sum_range_choose,
          Nat.cast_pow, Nat.cast_ofNat]
      _ ≤ (2 : ℝ) ^ J * M * L := by
        gcongr
        norm_num
  · intro N hN β hloc hsample
    have hNpos : 0 < N := zero_lt_one.trans_le hN
    let s : Finset ℕ := Finset.Icc 1 ⌊(2 * C) * N⌋₊
    have hβsupport : β.support ⊆ s := by
      intro n hn
      obtain ⟨hlo, hhi⟩ := hloc n hn
      exact Finset.mem_Icc.mpr ⟨Nat.cast_pos.mp ((div_pos hNpos hCpos).trans_le hlo), Nat.le_floor
        (hhi.trans (mul_le_mul_of_nonneg_right (by linarith : C ≤ 2 * C) hNpos.le))⟩
    have hsamples (n : ℕ) (hn : 0 < n) : ψpos ((n : ℝ) / N) = β n := by
      by_cases hbn : β n = 0
      · dsimp only [ψpos]
        rw [← hsample n hn, hbn, mul_zero]
      · have hlocn := hloc n (Finsupp.mem_support_iff.mpr hbn)
        have hratio : (n : ℝ) / N ∈ Set.Icc (1 / C) C := by
          constructor
          · exact (le_div_iff₀ hNpos).mpr (by simpa only [one_div_mul_eq_div] using hlocn.1)
          · exact (div_le_iff₀ hNpos).mpr hlocn.2
        exact (hψone _ hratio).trans (hsample n hn).symm
    calc
      β = ∑ n ∈ s, Finsupp.single n (β n) := by
        simpa only [Finsupp.indicator_eq_sum_single] using
          ((Finsupp.eq_indicator_self_iff s).mpr hβsupport)
      _ = ∑ n ∈ s, Finsupp.single n (ψpos ((n : ℝ) / N)) := by
        apply Finset.sum_congr rfl
        intro n hn
        rw [hsamples n (Finset.mem_Icc.mp hn).1]
      _ = positiveCompactProfileSequence ψpos (2 * C) N 0 := by
        simp only [positiveCompactProfileSequence, s, zero_add, sub_zero]

open Classical in
/--
A secondary correlation summand for `n` and `n'`, with smooth weights, residue-fiber indicators,
and a reciprocal phase involving the divided determinant `J`. It vanishes unless the determinant
congruence, both coprimality conditions, and `gcd J m ≤ T` hold, and is also zero for `m = 0`.
-/
noncomputable def sourceSecondaryPairTerm
    (m r₁ q₀ u₁ v₁ v₂ q₂ w₁ : ℕ) (A B ℓ : ℤ)
    (E : ZMod q₀ → Finset (ZMod q₀)) (ψN : ℝ → ℝ) (N : ℝ)
    (y y' : ℤ) (T : WithTop ℝ) (d : ℕ) (n n' : ℤ) : ℂ :=
  if hm : m = 0 then 0 else
    letI : NeZero m := ⟨hm⟩
    let J : ℤ :=
      (y * (n' + B * (d : ℤ)) - y' * (n + B * (d : ℤ))) / (d : ℤ)
    if Int.ModEq (d : ℤ) (y * n') (y' * n) ∧
        Int.gcd (n * n') ((w₁ * r₁ * q₀ * u₁ * v₁ * v₂ : ℕ) : ℤ) = 1 ∧
        Int.gcd ((n + ℓ * (d : ℤ) * (r₁ : ℤ)) *
          (n' + ℓ * (d : ℤ) * (r₁ : ℤ))) ((q₀ * q₂ : ℕ) : ℤ) = 1 ∧
        ((Int.gcd J (m : ℤ) : ℝ) : WithTop ℝ) ≤ T then
      (if (n : ZMod q₀) ∈ E (d : ZMod q₀) then (1 : ℂ) else 0) *
        (if (n' : ZMod q₀) ∈ E (d : ZMod q₀) then (1 : ℂ) else 0) *
        (ψN ((n : ℝ) / N) : ℂ) * (ψN ((n' : ℝ) / N) : ℂ) *
        reciprocalUnitPhase m
          ((A : ZMod m) * (J : ZMod m))
          (((n + B * (d : ℤ) : ℤ) : ZMod m) *
            ((n' + B * (d : ℤ) : ℤ) : ZMod m))
    else 0

open Classical in
/--
The `d`-indexed secondary correlation, obtained by summing the pair terms over both integer
variables and multiplying by the localized `j`th moment of `ψD`. Only positive multiples of `w₀
* w₁` satisfying the displayed quotient-coprimality condition contribute.
-/
noncomputable def sourceSecondaryDTerm
    (m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁ : ℕ) (A B ℓ : ℤ)
    (E : ZMod q₀ → Finset (ZMod q₀)) (ψN ψD : ℝ → ℝ)
    (N Δ₁ d₀ : ℝ) (j : ℕ) (y y' : ℤ) (T : WithTop ℝ) (d : ℕ) : ℂ :=
  if 0 < d ∧ w₀ * w₁ ∣ d ∧
      Int.gcd ((d / w₁ : ℕ) : ℤ)
        (((m : ℤ) * y * y') / (w₁ : ℤ) ^ 2) = 1 then
    ((ψD (((d : ℝ) - d₀) / Δ₁) * (((d : ℝ) - d₀) / Δ₁) ^ j : ℝ) : ℂ) *
      ∑' n : ℤ, ∑' n' : ℤ,
        sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁ A B ℓ E ψN N
          y y' T d n n'
  else 0

open Classical in
/--
The sum of norms of secondary `d`-correlations over pairs from `L` whose normalized coordinates
lie in `[1, 2)`. Both coordinates must be divisible by `w₁` and have prime-power part supported
on the primes of `m` equal to `w₂`; the gcd cutoff in the inner correlation is unrestricted.
-/
noncomputable def sourceSigmaThree
    (m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁ w₂ : ℕ) (A B ℓ : ℤ)
    (E : ZMod q₀ → Finset (ZMod q₀)) (L : Finset ℤ)
    (ψN ψD : ℝ → ℝ) (N Δ₁ d₀ Y : ℝ) (j : ℕ) : ℝ :=
  let P : Finset (ℤ × ℤ) := (L ×ˢ L).filter (fun p =>
    1 ≤ (p.1 : ℝ) / Y ∧ (p.1 : ℝ) / Y < 2 ∧
    1 ≤ (p.2 : ℝ) / Y ∧ (p.2 : ℝ) / Y < 2 ∧
    (w₁ : ℤ) ∣ p.1 ∧ (w₁ : ℤ) ∣ p.2 ∧
    (∏ q ∈ m.primeFactors, q ^ p.1.natAbs.factorization q) = w₂ ∧
    (∏ q ∈ m.primeFactors, q ^ p.2.natAbs.factorization q) = w₂)
  ∑ p ∈ P, ‖∑' d : ℕ,
    sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁ A B ℓ E ψN ψD
      N Δ₁ d₀ j p.1 p.2 ⊤ d‖

open Classical in
theorem sourceSecondary_polynomial_profile_envelopes
    (cD TD : ℝ) (hcD : 0 < cD) (CD ED : ℕ → ℝ)
    (hCD : ∀ j : ℕ, 0 ≤ CD j) :
    ∃ CDpoly EDpoly : ℕ → ℕ → ℝ,
      (∀ j k : ℕ, 0 ≤ CDpoly j k) ∧
      ∀ (x : ℝ), Real.exp 1 ≤ x →
      ∀ ψD : ℝ → ℝ,
      ContDiff ℝ ∞ ψD →
      Function.support ψD ⊆ Set.Icc cD TD →
      (∀ t : ℝ, 0 ≤ ψD t) →
      (∀ (k : ℕ) (t : ℝ),
        |iteratedDeriv k ψD t| ≤ CD k * (Real.log x) ^ ED k) →
      ∀ j : ℕ,
        ContDiff ℝ ∞ (fun t : ℝ => ψD t * t ^ j) ∧
        Function.support (fun t : ℝ => ψD t * t ^ j) ⊆ Set.Icc cD TD ∧
        (∀ t : ℝ, 0 ≤ ψD t * t ^ j) ∧
        ∀ (k : ℕ) (t : ℝ),
          |iteratedDeriv k (fun u : ℝ => ψD u * u ^ j) t| ≤
            CDpoly j k * (Real.log x) ^ EDpoly j k := by
  have hcastnorm (f : ℝ → ℝ) (hf : ContDiff ℝ ∞ f) (k : ℕ) (t : ℝ) :
      ‖iteratedDeriv k (fun u : ℝ => (f u : ℂ)) t‖ =
        |iteratedDeriv k f t| := by
    simpa only [norm_iteratedFDeriv_eq_norm_iteratedDeriv, Function.comp_def,
      Complex.ofRealLI_apply, Real.norm_eq_abs] using
      Complex.ofRealLI.norm_iteratedFDeriv_comp_left
        (x := t) (i := k) hf.contDiffAt (by simp)
  choose Cstar Estar hstarpos hstarbound using
    fun j : ℕ => sourceTerminalTaylor_uniform_star_profiles j cD TD 0 0
      CD ED (fun _ => 0) (fun _ => 0)
      hCD (fun _ => le_rfl)
  refine ⟨fun j k => (j.factorial : ℝ) * Cstar j k, Estar, ?_, ?_⟩
  · intro j k
    exact mul_nonneg (Nat.cast_nonneg _) (hstarpos j k).1.le
  intro x hx ψD hψD hsD hnD hbD j
  have hF : ContDiff ℝ ∞ (fun t : ℝ => ψD t * t ^ j) :=
    hψD.mul (contDiff_id.pow j)
  refine ⟨hF,
    (Function.support_mul_subset_left ψD (fun t : ℝ => t ^ j)).trans hsD, ?_, ?_⟩
  · intro t
    by_cases ht : ψD t = 0
    · simp [ht]
    · exact mul_nonneg (hnD t) (pow_nonneg (hcD.trans_le (hsD ht).1).le j)
  let φ : ℝ → ℂ := fun t => (ψD t : ℂ)
  obtain ⟨_, _, _, _, hb⟩ :=
    hstarbound j x hx φ (fun _ : ℝ => (0 : ℂ))
      (Complex.ofRealCLM.contDiff.comp hψD) contDiff_const
      ((Function.support_comp_subset (g := Complex.ofReal) Complex.ofReal_zero ψD).trans hsD)
      (by simp) (fun k t => (hcastnorm ψD hψD k t).trans_le (hbD k t))
      (by intro k t; simp) 0 0 1 (by norm_num) (by norm_num) j le_rfl
  let Q : ℝ → ℂ := fun u => (u ^ j / (j.factorial : ℝ)) • φ u
  have hfac : (j.factorial : ℝ) ≠ 0 := Nat.cast_ne_zero.mpr (Nat.factorial_ne_zero j)
  have hscale : (fun u : ℝ => ((ψD u * u ^ j : ℝ) : ℂ)) =
      fun u : ℝ => (j.factorial : ℝ) • Q u := by
    funext u
    dsimp only [Q]
    rw [smul_smul, mul_div_cancel₀ _ hfac]
    simp [φ, Complex.real_smul, mul_comm]
  intro k t
  calc
    |iteratedDeriv k (fun u : ℝ => ψD u * u ^ j) t| =
        (j.factorial : ℝ) * ‖iteratedDeriv k Q t‖ := by
      rw [← hcastnorm _ hF k t, hscale, iteratedDeriv_fun_const_smul_field,
        norm_smul, Real.norm_of_nonneg (Nat.cast_nonneg _)]
    _ ≤ (j.factorial : ℝ) * (Cstar j k * (Real.log x) ^ Estar j k) :=
      mul_le_mul_of_nonneg_left
        (by simpa only [Q, one_mul] using (hb k t).2) (Nat.cast_nonneg _)
    _ = ((j.factorial : ℝ) * Cstar j k) * (Real.log x) ^ Estar j k :=
      (mul_assoc _ _ _).symm

open Classical in
theorem sourceSecondary_literal_finite_support (m r₁ q₀ u₁ v₁ v₂ q₂ a b₁ b₂ : ℕ) (A B ℓ : ℤ)
    (E : ZMod q₀ → Finset (ZMod q₀)) (J L : Finset ℤ)
    (ψM ψN ψD : ℝ → ℝ) (M N Δ₁ d₀ cN TN cD TD : ℝ)
    (hN : 0 < N) (hΔ : 0 < Δ₁) (hd₀ : 0 ≤ d₀)
    (hcN : 0 < cN) (hNT : cN ≤ TN) (hcD : 0 < cD) (hDT : cD ≤ TD)
    (hsN : Function.support ψN ⊆ Set.Icc cN TN)
    (hsD : Function.support ψD ⊆ Set.Icc cD TD) :
    let I : Finset ℤ := Finset.Icc ⌈cN * N⌉ ⌊TN * N⌋
    let D : Finset ℕ := Finset.Icc 1 ⌊d₀ + TD * Δ₁⌋₊
    let sigmaTwoTerm : ℕ → ℝ := fun d =>
      if Squarefree d ∧ Nat.Coprime d (r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂) then
        ψD (((d : ℝ) - d₀) / Δ₁) *
          ‖sourceDispersionFrequencyBlock
            ((J ×ˢ J).filter (fun h => h.1 * (v₂ : ℤ) ≠ h.2 * (v₁ : ℤ)))
            ψM (fun t => ψN (t / N)) M (d * r₁) q₀ u₁ v₁ v₂ q₂ a b₁ b₂ ℓ‖
      else 0
    (∀ (w₁ : ℕ) (y y' : ℤ) (T : WithTop ℝ) (d : ℕ),
      (∀ n n' : ℤ, n ∉ I ∨ n' ∉ I →
        sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
          A B ℓ E ψN N y y' T d n n' = 0) ∧
      (∀ n : ℤ, HasSum
        (fun n' : ℤ => sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
          A B ℓ E ψN N y y' T d n n')
        (∑ n' ∈ I, sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
          A B ℓ E ψN N y y' T d n n')) ∧
      HasSum
        (fun n : ℤ => ∑' n' : ℤ,
          sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
            A B ℓ E ψN N y y' T d n n')
        (∑ n ∈ I, ∑ n' ∈ I,
          sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
            A B ℓ E ψN N y y' T d n n')) ∧
    (∀ (w₀ w₁ : ℕ) (j : ℕ) (y y' : ℤ) (T : WithTop ℝ),
      (∀ d ∉ D, sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
        A B ℓ E ψN ψD N Δ₁ d₀ j y y' T d = 0) ∧
      HasSum
        (sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
          A B ℓ E ψN ψD N Δ₁ d₀ j y y' T)
        (∑ d ∈ D, sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
          A B ℓ E ψN ψD N Δ₁ d₀ j y y' T d)) ∧
    HasSum sigmaTwoTerm (∑ d ∈ D, sigmaTwoTerm d) ∧
    sourceSigmaTwo J ψM (fun t => ψN (t / N)) ψD M Δ₁ d₀
      r₁ q₀ u₁ v₁ v₂ q₂ a b₁ b₂ ℓ = ∑ d ∈ D, sigmaTwoTerm d ∧
    (∀ (w₀ w₁ w₂ : ℕ) (Y : ℝ) (j : ℕ),
      let P : Finset (ℤ × ℤ) := (L ×ˢ L).filter (fun p =>
        1 ≤ (p.1 : ℝ) / Y ∧ (p.1 : ℝ) / Y < 2 ∧
        1 ≤ (p.2 : ℝ) / Y ∧ (p.2 : ℝ) / Y < 2 ∧
        (w₁ : ℤ) ∣ p.1 ∧ (w₁ : ℤ) ∣ p.2 ∧
        (∏ q ∈ m.primeFactors, q ^ p.1.natAbs.factorization q) = w₂ ∧
        (∏ q ∈ m.primeFactors, q ^ p.2.natAbs.factorization q) = w₂)
      sourceSigmaThree m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁ w₂
        A B ℓ E L ψN ψD N Δ₁ d₀ Y j =
        ∑ p ∈ P, ‖∑ d ∈ D,
          sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
            A B ℓ E ψN ψD N Δ₁ d₀ j p.1 p.2 ⊤ d‖) := by
  intro I D sigmaTwoTerm
  have hold := sourceDispersion_positive_support_eq_finite ∅ J ψM ψN ψD
    M N Δ₁ d₀ cN TN cD TD hN hΔ hd₀ hcN hNT hcD hDT hsN hsD
    r₁ r₁ q₀ u₁ v₁ v₂ q₂ a b₁ b₂ ℓ
  have hDzero (d : ℕ) (hd : d ∉ D) : ψD (((d : ℝ) - d₀) / Δ₁) = 0 := by
    apply hold.2.1 d
    intro hm
    obtain ⟨hlo, hhi⟩ := Finset.mem_Icc.mp hm
    apply hd
    refine Finset.mem_Icc.mpr ⟨?_, hhi⟩
    exact (Nat.succ_le_of_lt (Nat.ceil_pos.mpr
      (add_pos_of_nonneg_of_pos hd₀ (mul_pos hcD hΔ)))).trans hlo
  have hDterm (w₀ w₁ : ℕ) (j : ℕ) (y y' : ℤ) (T : WithTop ℝ) :
      (∀ d ∉ D, sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
        A B ℓ E ψN ψD N Δ₁ d₀ j y y' T d = 0) ∧
      HasSum
        (sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
          A B ℓ E ψN ψD N Δ₁ d₀ j y y' T)
        (∑ d ∈ D, sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
          A B ℓ E ψN ψD N Δ₁ d₀ j y y' T d) := by
    have hz (d : ℕ) (hd : d ∉ D) :
        sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
          A B ℓ E ψN ψD N Δ₁ d₀ j y y' T d = 0 := by
      simp [sourceSecondaryDTerm, hDzero d hd]
    exact ⟨hz, hasSum_sum_of_ne_finset_zero hz⟩
  have hsigma : HasSum sigmaTwoTerm (∑ d ∈ D, sigmaTwoTerm d) :=
    hasSum_sum_of_ne_finset_zero fun d hd => by
      simp [sigmaTwoTerm, hDzero d hd]
  refine ⟨?_, hDterm, hsigma, hsigma.tsum_eq, ?_⟩
  · intro w₁ y y' T d
    let f : ℤ → ℤ → ℂ :=
      sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁ A B ℓ E ψN N y y' T d
    have hz (n n' : ℤ) (hn : n ∉ I ∨ n' ∉ I) : f n n' = 0 := by
      rcases hn with hn | hn <;> simp [f, sourceSecondaryPairTerm, hold.1 _ hn]
    have hs (n : ℤ) : HasSum (f n) (∑ n' ∈ I, f n n') :=
      hasSum_sum_of_ne_finset_zero fun n' hn' => hz n n' (Or.inr hn')
    refine ⟨hz, hs, ?_⟩
    have ho : HasSum (fun n : ℤ => ∑' n' : ℤ, f n n')
        (∑ n ∈ I, ∑' n' : ℤ, f n n') := by
      apply hasSum_sum_of_ne_finset_zero
      intro n hn
      simpa only [tsum_zero] using
        (tsum_congr fun n' => hz n n' (Or.inl hn))
    change HasSum (fun n : ℤ => ∑' n' : ℤ, f n n') (∑ n ∈ I, ∑ n' ∈ I, f n n')
    simpa only [fun n : ℤ => (hs n).tsum_eq] using ho
  · intro w₀ w₁ w₂ Y j P
    dsimp only [sourceSigmaThree]
    apply Finset.sum_congr rfl
    intro p _
    exact congrArg norm (hDterm w₀ w₁ j p.1 p.2 ⊤).2.tsum_eq

open Classical in
theorem sourceSecondary_coarse_parameter_bounds
    («ω» δ ε C : ℝ) (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε)
    (hworking : 72 * «ω» + 24 * δ < 1) (hC : 1 ≤ C)
    (hεbound : ε < 1 / 1000)
    (x M N R₀ Q U V H Δ r q u v v' q' : ℝ)
    (hx3 : 3 ≤ x) (hCx : C ≤ x)
    (hM : 0 < M) (hN : 1 ≤ N) (hNx : N ≤ x)
    (hR : 0 < R₀) (hQ : 0 < Q) (hU : 0 < U) (hV : 0 < V)
    (hH : 1 ≤ H) (hΔ : 0 < Δ) (hr : 0 ≤ r) (hq : 1 ≤ q) (hq' : 0 ≤ q')
    (hMNlo : x ≤ C * M * N) (hMNhi : M * N ≤ C * x)
    (hRlo : N ≤ C * x ^ (δ + 4 * ε) * R₀) (hRhi : R₀ ≤ C * N)
    (hRQ : R₀ * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε))
    (hHdef : H * q * M = x ^ ε * R₀ * Q ^ 2)
    (hUhi : U * H ≤ C * Q) (hVhi : V ≤ C * x ^ (δ + 5 * ε) * H)
    (hΔlo : N ≤ C * x ^ (δ + 50 * ε) * H ^ 2 * Δ) (hΔhi : Δ ≤ C * N)
    (hrhi : r * Δ ≤ C * R₀) (hqhi : q ≤ C * Q)
    (huhi : u ≤ C * U) (hvhi : v ≤ C * V) (hv'hi : v' ≤ C * V)
    (hq'hi : q' * q ≤ C * Q) :
    M ≤ x ^ 2 ∧ 1 ≤ x * M ∧ R₀ ≤ x ^ 2 ∧ 1 ≤ x ^ 2 * R₀ ∧
    Q ≤ x ^ 4 ∧ H ≤ x ^ 12 ∧ U ≤ x ^ 5 ∧ V ≤ x ^ 14 ∧
    Δ ≤ x ^ 2 ∧ 1 ≤ x ^ 26 * Δ ∧ r ≤ x ^ 29 ∧ q ≤ x ^ 5 ∧
    u ≤ x ^ 6 ∧ v ≤ x ^ 15 ∧ v' ≤ x ^ 15 ∧ q' ≤ x ^ 5 := by
  have hx : 1 ≤ x := by linarith
  have hx0 : 0 < x := by linarith
  have hC0 : 0 < C := zero_lt_one.trans_le hC
  have hN0 : 0 ≤ N := zero_le_one.trans hN
  have hH0 : 0 ≤ H := zero_le_one.trans hH
  have hpow (t : ℝ) (ht : t ≤ 1) : x ^ t ≤ x :=
    Real.rpow_le_self_of_one_le hx ht
  have hpe : x ^ ε ≤ x := hpow ε (by linarith)
  have hpr : x ^ (δ + 4 * ε) ≤ x := hpow _ (by linarith)
  have hpq : x ^ (1 / 2 + 2 * «ω» + ε) ≤ x := hpow _ (by linarith)
  have hpv : x ^ (δ + 5 * ε) ≤ x := hpow _ (by linarith)
  have hpd : x ^ (δ + 50 * ε) ≤ x := hpow _ (by linarith)
  have hCN : C * N ≤ x ^ 2 := by
    calc
      _ ≤ x * x := mul_le_mul hCx hNx hN0 hx0.le
      _ = _ := by ring
  have hMhi : M ≤ x ^ 2 := by
    calc
      M ≤ M * N := le_mul_of_one_le_right hM.le hN
      _ ≤ C * x := hMNhi
      _ ≤ x * x := mul_le_mul_of_nonneg_right hCx hx0.le
      _ = _ := by ring
  have hMlo : 1 ≤ x * M := by
    apply (mul_le_mul_iff_right₀ hx0).mp
    calc
      x * 1 = x := mul_one _
      _ ≤ C * M * N := hMNlo
      _ = M * (C * N) := by ring
      _ ≤ M * x ^ 2 := mul_le_mul_of_nonneg_left hCN hM.le
      _ = x * (x * M) := by ring
  have hRupper : R₀ ≤ x ^ 2 := hRhi.trans hCN
  have hRlower : 1 ≤ x ^ 2 * R₀ := by
    calc
      1 ≤ N := hN
      _ ≤ C * x ^ (δ + 4 * ε) * R₀ := hRlo
      _ ≤ x * x * R₀ := by gcongr
      _ = _ := by ring
  have hRQupper : R₀ * Q ≤ x ^ 2 := by
    calc
      _ ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) := hRQ
      _ ≤ x * x := mul_le_mul hCx hpq (Real.rpow_nonneg hx0.le _) hx0.le
      _ = _ := by ring
  have hQupper : Q ≤ x ^ 4 := by
    calc
      Q ≤ Q * (x ^ 2 * R₀) := le_mul_of_one_le_right hQ.le hRlower
      _ = x ^ 2 * (R₀ * Q) := by ring
      _ ≤ x ^ 2 * x ^ 2 := mul_le_mul_of_nonneg_left hRQupper (sq_nonneg x)
      _ = _ := by ring
  have hCQ : C * Q ≤ x ^ 5 := by
    calc
      C * Q ≤ x * x ^ 4 := mul_le_mul hCx hQupper hQ.le hx0.le
      _ = _ := by ring
  have hden : 1 ≤ x * q * M := by
    calc
      1 ≤ x * M := hMlo
      _ ≤ (x * M) * q := le_mul_of_one_le_right (mul_nonneg hx0.le hM.le) hq
      _ = _ := by ring
  have hHupper : H ≤ x ^ 12 := by
    calc
      H ≤ H * (x * q * M) := le_mul_of_one_le_right hH0 hden
      _ = x * (H * q * M) := by ring
      _ = x * (x ^ ε * R₀ * Q ^ 2) := by rw [hHdef]
      _ ≤ x * (x * x ^ 2 * (x ^ 4) ^ 2) := by gcongr
      _ = _ := by ring
  have hUupper : U ≤ x ^ 5 := by
    calc
      U ≤ U * H := le_mul_of_one_le_right hU.le hH
      _ ≤ C * Q := hUhi
      _ ≤ x ^ 5 := hCQ
  have hVupper : V ≤ x ^ 14 := by
    calc
      V ≤ C * x ^ (δ + 5 * ε) * H := hVhi
      _ ≤ x * x * x ^ 12 := by gcongr
      _ = _ := by ring
  have hCV : C * V ≤ x ^ 15 := by
    calc
      C * V ≤ x * x ^ 14 := mul_le_mul hCx hVupper hV.le hx0.le
      _ = _ := by ring
  have hΔupper : Δ ≤ x ^ 2 := hΔhi.trans hCN
  have hΔlower : 1 ≤ x ^ 26 * Δ := by
    calc
      1 ≤ N := hN
      _ ≤ C * x ^ (δ + 50 * ε) * H ^ 2 * Δ := hΔlo
      _ ≤ x * x * (x ^ 12) ^ 2 * Δ := by gcongr
      _ = _ := by ring
  have hrupper : r ≤ x ^ 29 := by
    calc
      r ≤ r * (x ^ 26 * Δ) := le_mul_of_one_le_right hr hΔlower
      _ = x ^ 26 * (r * Δ) := by ring
      _ ≤ x ^ 26 * (C * R₀) := mul_le_mul_of_nonneg_left hrhi (by positivity)
      _ ≤ x ^ 26 * (x * x ^ 2) := by gcongr
      _ = _ := by ring
  have hqupper : q ≤ x ^ 5 := hqhi.trans hCQ
  have huupper : u ≤ x ^ 6 := by
    calc
      u ≤ C * U := huhi
      _ ≤ x * x ^ 5 := mul_le_mul hCx hUupper hU.le hx0.le
      _ = _ := by ring
  have hvupper : v ≤ x ^ 15 := hvhi.trans hCV
  have hv'upper : v' ≤ x ^ 15 := hv'hi.trans hCV
  have hq'upper : q' ≤ x ^ 5 := by
    calc
      q' ≤ q' * q := le_mul_of_one_le_right hq' hq
      _ ≤ C * Q := hq'hi
      _ ≤ x ^ 5 := hCQ
  exact ⟨hMhi, hMlo, hRupper, hRlower, hQupper, hHupper, hUupper,
    hVupper, hΔupper, hΔlower, hrupper, hqupper, huupper, hvupper, hv'upper, hq'upper⟩

open Classical in
theorem sourceSecondary_signed_mobius_expansion
    (J₀ Dmax m r₁ q₀ u₁ v₁ v₂ q₂ : ℕ) (A B : Fin m) (ℓ : ℤ)
    (E : ZMod q₀ → Finset (ZMod q₀)) (ψN ψD : ℝ → ℝ)
    (N Δ₁ d₀ : ℝ) (Freq : Finset (ℤ × ℤ)) (L : Finset ℤ)
    (φ : (ℤ × ℤ) → ℤ) (I : Finset ℤ)
    (Four : (ℤ × ℤ) → (ℤ × ℤ) → ℝ → ℂ)
    (coeff : (ℤ × ℤ) → (ℤ × ℤ) → ℕ → ℂ)
    (hφmem : ∀ h ∈ Freq, φ h ∈ L)
    (hPairSum : ∀ (w₁ : ℕ) (y y' : ℤ) (T : WithTop ℝ) (d : ℕ),
      (∑' n : ℤ, ∑' n' : ℤ,
        sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
          (A.val : ℤ) (B.val : ℤ) ℓ E ψN N y y' T d n n') =
        ∑ n ∈ I, ∑ n' ∈ I,
          sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
            (A.val : ℤ) (B.val : ℤ) ℓ E ψN N y y' T d n n') :
    let D : Finset ℕ := Finset.Icc 1 Dmax
    let supported : ℤ → ℕ := fun y =>
      ∏ p ∈ m.primeFactors, p ^ y.natAbs.factorization p
    let W : Finset ℕ := D.filter (fun w => Squarefree w ∧ Nat.Coprime w m)
    let W₂ : Finset ℕ := L.image supported
    let Ys : Finset ℤ := L.image (fun y =>
      Int.sign y * ((2 ^ Nat.log 2 y.natAbs : ℕ) : ℤ))
    let Blocks : Finset (ℕ × ℕ × ℤ) := W ×ˢ W₂ ×ˢ Ys
    let Ypairs : ℕ → ℕ → ℤ → Finset (ℤ × ℤ) := fun w₁ w₂ Y =>
      (L ×ˢ L).filter (fun p =>
        1 ≤ (p.1 : ℝ) / (Y : ℝ) ∧ (p.1 : ℝ) / (Y : ℝ) < 2 ∧
        1 ≤ (p.2 : ℝ) / (Y : ℝ) ∧ (p.2 : ℝ) / (Y : ℝ) < 2 ∧
        (w₁ : ℤ) ∣ p.1 ∧ (w₁ : ℤ) ∣ p.2 ∧
        supported p.1 = w₂ ∧ supported p.2 = w₂)
    let Fblock : ℕ → ℕ → ℤ → Finset (ℤ × ℤ) := fun w₁ w₂ Y =>
      Freq.filter (fun h =>
        (w₁ : ℤ) ∣ φ h ∧ supported (φ h) = w₂ ∧
        1 ≤ (φ h : ℝ) / (Y : ℝ) ∧ (φ h : ℝ) / (Y : ℝ) < 2)
    let Γ : ℕ → ℤ → ℤ → ℂ := fun j y y' =>
      ∑ h ∈ Freq.filter (fun h => φ h = y),
        ∑ h' ∈ Freq.filter (fun h' => φ h' = y'), coeff h h' j
    let kernel : ℕ → ℕ → ℤ → ℤ → ℂ := fun w₁ d y y' =>
      ∑ n ∈ I, ∑ n' ∈ I,
        sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
          (A.val : ℤ) (B.val : ℤ) ℓ E ψN N y y' ⊤ d n n'
    let energyTerm : ℕ → ℕ → ℤ → ℕ → ℂ := fun w₁ w₂ Y d =>
      if w₁ ∣ d ∧ Nat.Coprime (d / w₁) w₁ then
        (ψD (((d : ℝ) - d₀) / Δ₁) : ℂ) *
          ∑ h ∈ Fblock w₁ w₂ Y, ∑ h' ∈ Fblock w₁ w₂ Y,
            if Int.gcd ((d / w₁ : ℕ) : ℤ)
                (((m : ℤ) * φ h * φ h') / (w₁ : ℤ) ^ 2) = 1 then
              kernel w₁ d (φ h) (φ h') * Four h h' (d : ℝ)
            else 0
      else 0
    let energy : ℕ → ℕ → ℤ → ℂ := fun w₁ w₂ Y =>
      ∑ d ∈ D, energyTerm w₁ w₂ Y d
    let remainder : ℕ → ℕ → ℤ → ℕ → ℂ := fun w₁ w₂ Y d =>
      if w₁ ∣ d ∧ Nat.Coprime (d / w₁) w₁ then
        (ψD (((d : ℝ) - d₀) / Δ₁) : ℂ) *
          ∑ h ∈ Fblock w₁ w₂ Y, ∑ h' ∈ Fblock w₁ w₂ Y,
            if Int.gcd ((d / w₁ : ℕ) : ℤ)
                (((m : ℤ) * φ h * φ h') / (w₁ : ℤ) ^ 2) = 1 then
              kernel w₁ d (φ h) (φ h') *
                (Four h h' (d : ℝ) -
                  ∑ j ∈ Finset.range (J₀ + 1),
                    ((((d : ℝ) - d₀) / Δ₁) ^ j : ℝ) • coeff h h' j)
            else 0
      else 0
    let expansion : ℕ → ℕ → ℤ → ℂ := fun w₁ w₂ Y =>
      ∑ j ∈ Finset.range (J₀ + 1), ∑ w₀ ∈ w₁.divisors,
        (ArithmeticFunction.moebius w₀ : ℂ) *
          ∑ p ∈ Ypairs w₁ w₂ Y, Γ j p.1 p.2 *
            ∑ d ∈ D,
              sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
                (A.val : ℤ) (B.val : ℤ) ℓ E ψN ψD N Δ₁ d₀ j p.1 p.2 ⊤ d
    ∀ b ∈ Blocks,
      energy b.1 b.2.1 b.2.2 - expansion b.1 b.2.1 b.2.2 =
        ∑ d ∈ D, remainder b.1 b.2.1 b.2.2 d := by
  intro D supported W W₂ Ys Blocks Ypairs Fblock Γ kernel energyTerm energy remainder expansion
  have hmob (w : ℕ) (hw : 0 < w) (d : ℕ) :
      (∑ w₀ ∈ w.divisors,
        if w₀ * w ∣ d then (ArithmeticFunction.moebius w₀ : ℂ) else 0) =
        if w ∣ d ∧ Nat.Coprime (d / w) w then 1 else 0 := by
    by_cases hwd : w ∣ d
    · have hdiv (w₀ : ℕ) : w₀ * w ∣ d ↔ w₀ ∣ d / w := by
        simpa only [Nat.mul_comm] using
          (Nat.dvd_div_iff_mul_dvd (a := w₀) hwd).symm
      have hfilter : w.divisors.filter (fun w₀ => w₀ ∣ d / w) =
          (Nat.gcd w (d / w)).divisors := by
        rw [← Nat.divisors_filter_dvd_of_dvd hw.ne' (Nat.gcd_dvd_left w (d / w))]
        ext w₀
        simp +contextual [Nat.dvd_gcd_iff]
      calc
        (∑ w₀ ∈ w.divisors,
            if w₀ * w ∣ d then (ArithmeticFunction.moebius w₀ : ℂ) else 0) =
            ∑ w₀ ∈ w.divisors.filter (fun w₀ => w₀ ∣ d / w),
              (ArithmeticFunction.moebius w₀ : ℂ) := by
          simp_rw [hdiv]
          rw [Finset.sum_filter]
        _ = ∑ w₀ ∈ (Nat.gcd w (d / w)).divisors,
              (ArithmeticFunction.moebius w₀ : ℂ) := by rw [hfilter]
        _ = ((ArithmeticFunction.moebius : ArithmeticFunction ℂ) *
              (ArithmeticFunction.zeta : ArithmeticFunction ℂ)) (Nat.gcd w (d / w)) := by
          simp only [ArithmeticFunction.coe_mul_zeta_apply, ArithmeticFunction.intCoe_apply]
        _ = (1 : ArithmeticFunction ℂ) (Nat.gcd w (d / w)) := by
          rw [ArithmeticFunction.coe_moebius_mul_coe_zeta]
        _ = if w ∣ d ∧ Nat.Coprime (d / w) w then 1 else 0 := by
          change (if Nat.gcd w (d / w) = 1 then (1 : ℂ) else 0) =
            if w ∣ d ∧ Nat.gcd (d / w) w = 1 then 1 else 0
          simp only [Nat.gcd_comm w (d / w), hwd, true_and]
    · have hzero (w₀ : ℕ) : ¬w₀ * w ∣ d := by
        intro h
        exact hwd ((show w ∣ w₀ * w from ⟨w₀, Nat.mul_comm _ _⟩).trans h)
      simp [hwd, hzero]
  have hregroup (w₁ w₂ : ℕ) (Y : ℤ) (j : ℕ) (Kpair : ℤ → ℤ → ℂ) :
      (∑ p ∈ Ypairs w₁ w₂ Y, Γ j p.1 p.2 * Kpair p.1 p.2) =
        ∑ h ∈ Fblock w₁ w₂ Y, ∑ h' ∈ Fblock w₁ w₂ Y,
          coeff h h' j * Kpair (φ h) (φ h') := by
    have hfiber (p : ℤ × ℤ) : Γ j p.1 p.2 * Kpair p.1 p.2 =
        ∑ z ∈ (Freq ×ˢ Freq).filter (fun z => (φ z.1, φ z.2) = p),
          coeff z.1 z.2 j * Kpair (φ z.1) (φ z.2) := by
      rcases p with ⟨y, y'⟩
      have hfilter :
          (Freq ×ˢ Freq).filter (fun z => (φ z.1, φ z.2) = (y, y')) =
            (Freq.filter (fun h => φ h = y)) ×ˢ
              (Freq.filter (fun h' => φ h' = y')) := by
        simpa only [Prod.mk.injEq] using
          (Finset.filter_product (s := Freq) (t := Freq)
            (fun h => φ h = y) (fun h' => φ h' = y'))
      rw [hfilter, Finset.sum_product]
      simp only [Γ, Finset.sum_mul]
      apply Finset.sum_congr rfl
      intro h hh
      apply Finset.sum_congr rfl
      intro h' hh'
      rw [(Finset.mem_filter.mp hh).2, (Finset.mem_filter.mp hh').2]
    have hpreimage :
        (Freq ×ˢ Freq).filter (fun z => (φ z.1, φ z.2) ∈ Ypairs w₁ w₂ Y) =
          (Fblock w₁ w₂ Y) ×ˢ (Fblock w₁ w₂ Y) := by
      ext z
      rcases z with ⟨h, h'⟩
      simp only [Ypairs, Fblock, Finset.mem_filter, Finset.mem_product]
      constructor
      · rintro ⟨⟨hh, hh'⟩, ⟨_, _⟩,
          hlo, hhi, hlo', hhi', hdiv, hdiv', hsup, hsup'⟩
        exact ⟨⟨hh, hdiv, hsup, hlo, hhi⟩, ⟨hh', hdiv', hsup', hlo', hhi'⟩⟩
      · rintro ⟨⟨hh, hdiv, hsup, hlo, hhi⟩, ⟨hh', hdiv', hsup', hlo', hhi'⟩⟩
        exact ⟨⟨hh, hh'⟩, ⟨hφmem h hh, hφmem h' hh'⟩,
          hlo, hhi, hlo', hhi', hdiv, hdiv', hsup, hsup'⟩
    calc
      (∑ p ∈ Ypairs w₁ w₂ Y, Γ j p.1 p.2 * Kpair p.1 p.2) =
          ∑ p ∈ Ypairs w₁ w₂ Y,
            ∑ z ∈ (Freq ×ˢ Freq).filter (fun z => (φ z.1, φ z.2) = p),
              coeff z.1 z.2 j * Kpair (φ z.1) (φ z.2) :=
        Finset.sum_congr rfl (fun p _ => hfiber p)
      _ = ∑ z ∈ (Freq ×ˢ Freq).filter
            (fun z => (φ z.1, φ z.2) ∈ Ypairs w₁ w₂ Y),
            coeff z.1 z.2 j * Kpair (φ z.1) (φ z.2) :=
        Finset.sum_fiberwise_eq_sum_filter (Freq ×ˢ Freq) (Ypairs w₁ w₂ Y)
          (fun z => (φ z.1, φ z.2))
          (fun z => coeff z.1 z.2 j * Kpair (φ z.1) (φ z.2))
      _ = ∑ h ∈ Fblock w₁ w₂ Y, ∑ h' ∈ Fblock w₁ w₂ Y,
            coeff h h' j * Kpair (φ h) (φ h') := by
        rw [hpreimage, Finset.sum_product]
  intro b hb
  have hwW : b.1 ∈ W := (Finset.mem_product.mp hb).1
  have hwD : b.1 ∈ D := (Finset.mem_filter.mp hwW).1
  have hwpos : 0 < b.1 := (Finset.mem_Icc.mp hwD).1
  let F : Finset (ℤ × ℤ) := Fblock b.1 b.2.1 b.2.2
  let tD : ℕ → ℝ := fun d => ((d : ℝ) - d₀) / Δ₁
  let Tj : ℕ → ℕ → ℤ → ℤ → ℂ := fun d j y y' =>
    if b.1 ∣ d ∧ Nat.Coprime (d / b.1) b.1 then
      if Int.gcd ((d / b.1 : ℕ) : ℤ)
          (((m : ℤ) * y * y') / (b.1 : ℤ) ^ 2) = 1 then
        ((ψD (tD d) * (tD d) ^ j : ℝ) : ℂ) * kernel b.1 d y y'
      else 0
    else 0
  have hDT (d : ℕ) (hd : d ∈ D) (j : ℕ) (y y' : ℤ) :
      (∑ w₀ ∈ b.1.divisors, (ArithmeticFunction.moebius w₀ : ℂ) *
        sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ b.1
          (A.val : ℤ) (B.val : ℤ) ℓ E ψN ψD N Δ₁ d₀ j y y' ⊤ d) =
        Tj d j y y' := by
    have hdpos : 0 < d := (Finset.mem_Icc.mp hd).1
    let V : ℂ := ((ψD (tD d) * (tD d) ^ j : ℝ) : ℂ) * kernel b.1 d y y'
    have hterm (w₀ : ℕ) :
        (ArithmeticFunction.moebius w₀ : ℂ) *
            sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ b.1
              (A.val : ℤ) (B.val : ℤ) ℓ E ψN ψD N Δ₁ d₀ j y y' ⊤ d =
          (if w₀ * b.1 ∣ d then (ArithmeticFunction.moebius w₀ : ℂ) else 0) *
            (if Int.gcd ((d / b.1 : ℕ) : ℤ)
                (((m : ℤ) * y * y') / (b.1 : ℤ) ^ 2) = 1 then V else 0) := by
      rw [sourceSecondaryDTerm, hPairSum b.1 y y' ⊤ d]
      change (ArithmeticFunction.moebius w₀ : ℂ) *
          (if 0 < d ∧ w₀ * b.1 ∣ d ∧
              Int.gcd ((d / b.1 : ℕ) : ℤ)
                (((m : ℤ) * y * y') / (b.1 : ℤ) ^ 2) = 1 then V else 0) = _
      simp only [hdpos, true_and, ite_and, mul_ite, ite_mul, mul_zero, zero_mul]
      simp only [← ite_and, and_comm]
    calc
      (∑ w₀ ∈ b.1.divisors, (ArithmeticFunction.moebius w₀ : ℂ) *
          sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ b.1
            (A.val : ℤ) (B.val : ℤ) ℓ E ψN ψD N Δ₁ d₀ j y y' ⊤ d) =
          (∑ w₀ ∈ b.1.divisors,
            if w₀ * b.1 ∣ d then (ArithmeticFunction.moebius w₀ : ℂ) else 0) *
            (if Int.gcd ((d / b.1 : ℕ) : ℤ)
                (((m : ℤ) * y * y') / (b.1 : ℤ) ^ 2) = 1 then V else 0) := by
        simp only [hterm, Finset.sum_mul]
      _ = Tj d j y y' := by
        rw [hmob b.1 hwpos d]
        simp only [Tj, ite_mul, one_mul, zero_mul, V]
  have hpoint (d : ℕ) :
      energyTerm b.1 b.2.1 b.2.2 d - remainder b.1 b.2.1 b.2.2 d =
        ∑ j ∈ Finset.range (J₀ + 1), ∑ h ∈ F, ∑ h' ∈ F,
          coeff h h' j * Tj d j (φ h) (φ h') := by
    by_cases hgate : b.1 ∣ d ∧ Nat.Coprime (d / b.1) b.1
    · have hterm (h h' : ℤ × ℤ) :
          (ψD (tD d) : ℂ) *
              (if Int.gcd ((d / b.1 : ℕ) : ℤ)
                  (((m : ℤ) * φ h * φ h') / (b.1 : ℤ) ^ 2) = 1 then
                kernel b.1 d (φ h) (φ h') *
                  (∑ j ∈ Finset.range (J₀ + 1), ((tD d) ^ j : ℝ) • coeff h h' j)
              else 0) =
            ∑ j ∈ Finset.range (J₀ + 1), coeff h h' j * Tj d j (φ h) (φ h') := by
        simp only [Tj, ite_eq_left hgate, mul_ite, mul_zero, Finset.sum_ite_irrel,
          Finset.sum_const_zero, Finset.mul_sum, Complex.real_smul, Complex.ofReal_mul,
          mul_assoc, mul_left_comm, mul_comm]
      calc
        energyTerm b.1 b.2.1 b.2.2 d - remainder b.1 b.2.1 b.2.2 d =
            (ψD (tD d) : ℂ) * ∑ h ∈ F, ∑ h' ∈ F,
              if Int.gcd ((d / b.1 : ℕ) : ℤ)
                  (((m : ℤ) * φ h * φ h') / (b.1 : ℤ) ^ 2) = 1 then
                kernel b.1 d (φ h) (φ h') *
                  (∑ j ∈ Finset.range (J₀ + 1), ((tD d) ^ j : ℝ) • coeff h h' j)
              else 0 := by
          simp only [energyTerm, remainder, ite_eq_left hgate, F,
            ← mul_sub, ← Finset.sum_sub_distrib]
          simp only [tD, ite_sub_ite, sub_self, mul_sub, sub_sub_self]
        _ = ∑ h ∈ F, ∑ h' ∈ F, ∑ j ∈ Finset.range (J₀ + 1),
              coeff h h' j * Tj d j (φ h) (φ h') := by
          simp_rw [← hterm, ← Finset.mul_sum]
        _ = ∑ j ∈ Finset.range (J₀ + 1), ∑ h ∈ F, ∑ h' ∈ F,
              coeff h h' j * Tj d j (φ h) (φ h') := Finset.sum_comm_cycle
    · simp [energyTerm, remainder, Tj, hgate]
  have hswap : expansion b.1 b.2.1 b.2.2 =
      ∑ d ∈ D, ∑ j ∈ Finset.range (J₀ + 1), ∑ p ∈ Ypairs b.1 b.2.1 b.2.2,
        Γ j p.1 p.2 *
          (∑ w₀ ∈ b.1.divisors, (ArithmeticFunction.moebius w₀ : ℂ) *
            sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ b.1
              (A.val : ℤ) (B.val : ℤ) ℓ E ψN ψD N Δ₁ d₀ j p.1 p.2 ⊤ d) := by
    dsimp only [expansion]
    simp_rw [Finset.mul_sum]
    simp_rw [Finset.sum_comm_cycle (s := b.1.divisors)
      (t := Ypairs b.1 b.2.1 b.2.2) (u := D)]
    rw [Finset.sum_comm]
    apply Finset.sum_congr rfl
    intro d _
    apply Finset.sum_congr rfl
    intro j _
    rw [Finset.sum_comm]
    apply Finset.sum_congr rfl
    intro p _
    apply Finset.sum_congr rfl
    intro w₀ _
    exact mul_left_comm _ _ _
  have hexpand : expansion b.1 b.2.1 b.2.2 =
      ∑ d ∈ D, (energyTerm b.1 b.2.1 b.2.2 d - remainder b.1 b.2.1 b.2.2 d) := by
    rw [hswap]
    apply Finset.sum_congr rfl
    intro d hd
    calc
      (∑ j ∈ Finset.range (J₀ + 1), ∑ p ∈ Ypairs b.1 b.2.1 b.2.2,
          Γ j p.1 p.2 *
            (∑ w₀ ∈ b.1.divisors, (ArithmeticFunction.moebius w₀ : ℂ) *
              sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ b.1
                (A.val : ℤ) (B.val : ℤ) ℓ E ψN ψD N Δ₁ d₀ j p.1 p.2 ⊤ d)) =
          ∑ j ∈ Finset.range (J₀ + 1), ∑ p ∈ Ypairs b.1 b.2.1 b.2.2,
            Γ j p.1 p.2 * Tj d j p.1 p.2 := by
        simp only [hDT d hd]
      _ = ∑ j ∈ Finset.range (J₀ + 1), ∑ h ∈ F, ∑ h' ∈ F,
            coeff h h' j * Tj d j (φ h) (φ h') :=
        Finset.sum_congr rfl (fun j _ => hregroup b.1 b.2.1 b.2.2 j (Tj d j))
      _ = energyTerm b.1 b.2.1 b.2.2 d - remainder b.1 b.2.1 b.2.2 d :=
        (hpoint d).symm
  change (∑ d ∈ D, energyTerm b.1 b.2.1 b.2.2 d) -
      expansion b.1 b.2.1 b.2.2 = ∑ d ∈ D, remainder b.1 b.2.1 b.2.2 d
  rw [hexpand, ← Finset.sum_sub_distrib]
  simp only [sub_sub_self]

open Classical in
theorem sourceSecondary_pair_kernel_gram_identity
    (m r₁ q₀ u₁ v₁ v₂ q₂ w d : ℕ) [NeZero m]
    (A B ℓ : ℤ) (E : ZMod q₀ → Finset (ZMod q₀))
    (ψN : ℝ → ℝ) (N : ℝ) (F : Finset (ℤ × ℤ)) (I : Finset ℤ)
    (φ : (ℤ × ℤ) → ℤ) (amplitude : (ℤ × ℤ) → ℂ)
    (Four : (ℤ × ℤ) → (ℤ × ℤ) → ℂ)
    (hFour : ∀ h h' : ℤ × ℤ, amplitude h * star (amplitude h') = Four h h') :
    let base : ℕ := r₁ * q₀ * u₁ * v₁ * v₂
    let aN : ℤ → ℂ := fun n =>
      if Int.gcd n (base : ℤ) = 1 ∧
          Int.gcd (n + ℓ * (d : ℤ) * (r₁ : ℤ)) ((q₀ * q₂ : ℕ) : ℤ) = 1 then
        (if (n : ZMod q₀) ∈ E (d : ZMod q₀) then (1 : ℂ) else 0) *
          (ψN ((n : ℝ) / N) : ℂ)
      else 0
    let S : Finset ((ℤ × ℤ) × ℤ) := F ×ˢ I
    let weight : ((ℤ × ℤ) × ℤ) → ℂ := fun i => aN i.2 * amplitude i.1
    let pairPhase : ((ℤ × ℤ) × ℤ) → ((ℤ × ℤ) × ℤ) → ℂ := fun i j =>
      reciprocalUnitPhase m
        ((A : ZMod m) *
          (((φ i.1 * (j.2 + B * (d : ℤ)) -
              φ j.1 * (i.2 + B * (d : ℤ))) / (d : ℤ) : ℤ) : ZMod m))
        (((i.2 : ZMod m) + (B : ZMod m) * (d : ZMod m)) *
          ((j.2 : ZMod m) + (B : ZMod m) * (d : ZMod m)))
    let Vset : Finset ((ℤ × ℤ) × ℤ) := S.filter (fun i => IsUnit (i.2 : ZMod w))
    let gram : ℂ := ∑ i ∈ Vset, ∑ j ∈ Vset.filter (fun j =>
        Int.ModEq (d : ℤ) (φ i.1 * j.2) (φ j.1 * i.2)),
      weight i * star (weight j) * pairPhase i j
    gram = ∑ h ∈ F, ∑ h' ∈ F,
      (∑ n ∈ I, ∑ n' ∈ I,
        sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w
          A B ℓ E ψN N (φ h) (φ h') ⊤ d n n') * Four h h' := by
  intro base aN S weight pairPhase Vset gram
  let mask : ℤ → Prop := fun n =>
    Int.gcd n (base : ℤ) = 1 ∧
      Int.gcd (n + ℓ * (d : ℤ) * (r₁ : ℤ)) ((q₀ * q₂ : ℕ) : ℤ) = 1
  have hwbase : ((w * r₁ * q₀ * u₁ * v₁ * v₂ : ℕ) : ℤ) =
      (w : ℤ) * (base : ℤ) := by simp [base, Nat.cast_mul, mul_assoc]
  have hpairMask (n n' : ℤ) :
      (Int.gcd (n * n') ((w * r₁ * q₀ * u₁ * v₁ * v₂ : ℕ) : ℤ) = 1 ∧
        Int.gcd ((n + ℓ * (d : ℤ) * (r₁ : ℤ)) *
          (n' + ℓ * (d : ℤ) * (r₁ : ℤ))) ((q₀ * q₂ : ℕ) : ℤ) = 1) ↔
          IsUnit (n : ZMod w) ∧ IsUnit (n' : ZMod w) ∧ mask n ∧ mask n' := by
    rw [hwbase]
    simp only [mask, ZMod.coe_int_isUnit_iff_isCoprime,
      ← Int.isCoprime_iff_gcd_eq_one, IsCoprime.mul_left_iff, IsCoprime.mul_right_iff]
    rw [isCoprime_comm (x := (w : ℤ)) (y := n),
      isCoprime_comm (x := (w : ℤ)) (y := n')]
    tauto
  have haN (n : ℤ) : aN n =
      if mask n then
        (if (n : ZMod q₀) ∈ E (d : ZMod q₀) then (1 : ℂ) else 0) *
          (ψN ((n : ℝ) / N) : ℂ)
      else 0 := rfl
  have hstarN (n : ℤ) : star (aN n) = aN n := by
    simp [aN, apply_ite (star : ℂ → ℂ)]
  have hweightPair (h h' : ℤ × ℤ) (n n' : ℤ) :
      weight (h, n) * star (weight (h', n')) = aN n * aN n' * Four h h' := by
    rw [← hFour]
    simp only [weight, star_mul', hstarN]
    exact mul_mul_mul_comm _ _ _ _
  have hPairScalar (h h' : ℤ × ℤ) (n n' : ℤ) :
      sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w
          A B ℓ E ψN N (φ h) (φ h') ⊤ d n n' *
        Four h h' =
      if IsUnit (n : ZMod w) ∧ IsUnit (n' : ZMod w) ∧
          Int.ModEq (d : ℤ) (φ h * n') (φ h' * n) then
        weight (h, n) * star (weight (h', n')) * pairPhase (h, n) (h', n')
      else 0 := by
    clear * - hpairMask hweightPair haN
    rw [hweightPair]
    simp only [sourceSecondaryPairTerm, dite_eq_right (NeZero.ne m),
      le_top, and_true, hpairMask, pairPhase, Int.cast_add, Int.cast_mul, Int.cast_natCast]
    simp only [haN, ite_mul, mul_ite, zero_mul, mul_zero]
    simp only [← ite_and, one_mul, mul_assoc, mul_left_comm, mul_comm,
      and_assoc, and_left_comm, and_comm]
  simp only [gram, Vset, S, Finset.sum_filter, Finset.sum_product,
    Finset.ite_sum_zero, ← ite_and]
  apply Finset.sum_congr rfl
  intro h _
  rw [Finset.sum_comm]
  apply Finset.sum_congr rfl
  intro h' _
  rw [Finset.sum_mul]
  apply Finset.sum_congr rfl
  intro n _
  rw [Finset.sum_mul]
  apply Finset.sum_congr rfl
  intro n' _
  exact (hPairScalar h h' n n').symm

open Classical in
theorem sourceSecondary_quotient_gram_cauchy {ι : Type}
    (S : Finset ι) (n y : ι → ℤ) (weight : ι → ℂ)
    (w₁ q m : ℕ) [NeZero w₁] [NeZero q] [NeZero m]
    (hwq : Nat.Coprime w₁ q) (hdm : Nat.Coprime (w₁ * q) m)
    (hy : ∀ i ∈ S, Int.gcd (y i) ((w₁ * q : ℕ) : ℤ) = w₁)
    (a A B : ℤ) :
    let V : Finset ι := S.filter (fun i => IsUnit (n i : ZMod w₁))
    let η : ι → ℂ := fun i => reciprocalUnitPhase (w₁ * q)
      ((a : ZMod (w₁ * q)) * (y i : ZMod (w₁ * q)))
      ((n i : ZMod (w₁ * q)) * (m : ZMod (w₁ * q)))
    let θ : ι → ℂ := fun i => reciprocalUnitPhase m
      ((A : ZMod m) * (y i : ZMod m))
      (((w₁ * q : ℕ) : ZMod m) *
        ((n i : ZMod m) + (B : ZMod m) * ((w₁ * q : ℕ) : ZMod m)))
    let F : ZMod q → ℂ := fun c =>
      ∑ i ∈ V.filter (fun i => (n i : ZMod q) * (y i : ZMod q)⁻¹ = c),
        weight i * θ i
    let gram : ℂ :=
      ∑ i ∈ V, ∑ j ∈ V.filter (fun j =>
          Int.ModEq ((w₁ * q : ℕ) : ℤ) (y i * n j) (y j * n i)),
        weight i * star (weight j) *
          reciprocalUnitPhase m
            ((A : ZMod m) *
              (((y i * (n j + B * ((w₁ * q : ℕ) : ℤ)) -
                  y j * (n i + B * ((w₁ * q : ℕ) : ℤ))) /
                ((w₁ * q : ℕ) : ℤ) : ℤ) : ZMod m))
            (((n i : ZMod m) + (B : ZMod m) * ((w₁ * q : ℕ) : ZMod m)) *
              ((n j : ZMod m) + (B : ZMod m) * ((w₁ * q : ℕ) : ZMod m)))
    ((∑ c : ZMod q, ‖F c‖ ^ 2 : ℝ) : ℂ) = gram ∧
      gram.im = 0 ∧ 0 ≤ gram.re ∧
      ‖∑ i ∈ S, weight i * η i * θ i‖ ^ 2 ≤ (q : ℝ) * gram.re := by
  intro V η θ F gram
  have hgram := sourceSecondaryQuotientRatio_relaxed_gram
    S n y weight w₁ q m hwq hdm hy A B
  change ((∑ c : ZMod q, ‖F c‖ ^ 2 : ℝ) : ℂ) = gram ∧ 0 ≤ gram.re at hgram
  refine ⟨hgram.1, ?_, hgram.2, ?_⟩
  · rw [← hgram.1]
    exact Complex.ofReal_im _
  · calc
      _ ≤ (∑ c : ZMod q, ‖F c‖) ^ 2 :=
        pow_le_pow_left₀ (norm_nonneg _)
          ((sourceSecondaryResidue_fiber_grouping S n y weight
            (w₁ * q) m hdm a A B).2.2.trans
            (sourceSecondaryQuotientRatio_unit_relaxation
              S n y (fun i => weight i * θ i) w₁ q hwq hy).2.2.1) 2
      _ ≤ (q : ℝ) * ∑ c : ZMod q, ‖F c‖ ^ 2 := by
        simpa only [Finset.card_univ, ZMod.card] using
          (sq_sum_le_card_mul_sum_sq
            (s := Finset.univ) (f := fun c : ZMod q => ‖F c‖))
      _ = (q : ℝ) * gram.re := by
        rw [← hgram.1, Complex.ofReal_re]

open Classical in
theorem sourceSecondary_phase_block_identification
    (r₁ q₀ u₁ v₁ v₂ q₂ a b₁ b₂ : ℕ)
    (hpos : 0 < r₁ ∧ 0 < q₀ ∧ 0 < u₁ ∧ 0 < v₁ ∧ 0 < v₂ ∧ 0 < q₂)
    (hsq : Squarefree (r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂)) (ℓ : ℤ) :
    let m : ℕ := r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂
    ∀ (A B : Fin m) (E : ZMod q₀ → Finset (ZMod q₀)) (d : ℕ),
      (hdpos : 0 < d) → Nat.Coprime d m →
      (A.val : ZMod r₁) = (a : ZMod r₁) →
      (A.val : ZMod (q₀ * u₁ * Nat.lcm v₁ v₂)) =
        (b₁ : ZMod (q₀ * u₁ * Nat.lcm v₁ v₂)) →
      (A.val : ZMod q₂) = (b₂ : ZMod q₂) →
      (B.val : ZMod r₁) = 0 →
      (B.val : ZMod (q₀ * u₁ * Nat.lcm v₁ v₂)) = 0 →
      (B.val : ZMod q₂) = ((ℓ * (r₁ : ℤ)) : ZMod q₂) →
      (∀ n : ℤ, sourceCompatibility (d * r₁) q₀ b₁ b₂ ℓ n =
        if (n : ZMod q₀) ∈ E (d : ZMod q₀) then 1 else 0) →
      ∀ (M N cM TM cN TN LM : ℝ),
        0 < M → 0 < N → 0 < cM → cM ≤ TM → 0 < cN → cN ≤ TN → 0 ≤ LM →
        ∀ (ψM ψN : ℝ → ℝ),
          Function.support ψM ⊆ Set.Icc cM TM →
          Function.support ψN ⊆ Set.Icc cN TN →
          (∀ t : ℝ, |ψM t| ≤ LM) →
          ∀ F : Finset (ℤ × ℤ),
            let g : ℕ := Nat.gcd v₁ v₂
            let φ : ℤ × ℤ → ℤ := fun h =>
              h.1 * ((v₂ / g : ℕ) : ℤ) - h.2 * ((v₁ / g : ℕ) : ℤ)
            let R₁ : ℕ := r₁ * q₀ * u₁ * v₁ * q₂
            let R₂ : ℕ := r₁ * q₀ * u₁ * v₂ * q₂
            let I : Finset ℤ := Finset.Icc ⌈cN * N⌉ ⌊TN * N⌋
            let base : ℕ := r₁ * q₀ * u₁ * v₁ * v₂
            let aN : ℤ → ℂ := fun n =>
              if Int.gcd n (base : ℤ) = 1 ∧
                  Int.gcd (n + ℓ * (d : ℤ) * (r₁ : ℤ)) ((q₀ * q₂ : ℕ) : ℤ) = 1 then
                (if (n : ZMod q₀) ∈ E (d : ZMod q₀) then (1 : ℂ) else 0) *
                  (ψN ((n : ℝ) / N) : ℂ)
              else 0
            let amplitude : (ℤ × ℤ) → ℂ := fun h =>
              sourcePhiRealFactor ψM M R₁ h.1 (d : ℝ) *
                star (sourcePhiRealFactor ψM M R₂ h.2 (d : ℝ))
            let S : Finset ((ℤ × ℤ) × ℤ) := F ×ˢ I
            let weight : ((ℤ × ℤ) × ℤ) → ℂ := fun i => aN i.2 * amplitude i.1
            let η : ((ℤ × ℤ) × ℤ) → ℂ := fun i =>
              @reciprocalUnitPhase d ⟨hdpos.ne'⟩
                (((a : ℤ) : ZMod d) * (φ i.1 : ZMod d))
                ((i.2 : ZMod d) * (m : ZMod d))
            let θ : ((ℤ × ℤ) × ℤ) → ℂ := fun i =>
              @reciprocalUnitPhase m ⟨hsq.ne_zero⟩
                (((A.val : ℤ) : ZMod m) * (φ i.1 : ZMod m))
                ((d : ZMod m) * ((i.2 : ZMod m) +
                  ((B.val : ℤ) : ZMod m) * (d : ZMod m)))
            sourceDispersionFrequencyBlock F ψM (fun t => ψN (t / N)) M
              (d * r₁) q₀ u₁ v₁ v₂ q₂ a b₁ b₂ ℓ =
                ∑ i ∈ S, weight i * η i * θ i := by
  intro m A B E d hdpos hdm hAr hAW hAq hBr hBW hBq hCompat
    M N cM TM cN TN LM hM hN hcM hMT hcN hNT hLM
    ψM ψN hsM hsN hMzero F g φ R₁ R₂ I base aN amplitude S weight η θ
  let : NeZero r₁ := ⟨hpos.1.ne'⟩
  let : NeZero q₀ := ⟨hpos.2.1.ne'⟩
  let : NeZero u₁ := ⟨hpos.2.2.1.ne'⟩
  let : NeZero v₁ := ⟨hpos.2.2.2.1.ne'⟩
  let : NeZero v₂ := ⟨hpos.2.2.2.2.1.ne'⟩
  let : NeZero q₂ := ⟨hpos.2.2.2.2.2.ne'⟩
  let : NeZero d := ⟨hdpos.ne'⟩
  let mask : ℤ → Prop := fun n =>
    Int.gcd n (base : ℤ) = 1 ∧
      Int.gcd (n + ℓ * (d : ℤ) * (r₁ : ℤ)) ((q₀ * q₂ : ℕ) : ℤ) = 1
  have hdbase : ((d * r₁ * q₀ * u₁ * v₁ * v₂ : ℕ) : ℤ) =
      (d : ℤ) * (base : ℤ) := by simp [base, Nat.cast_mul, mul_assoc]
  have hshift (n : ℤ) : n + ℓ * ((d * r₁ : ℕ) : ℤ) =
      n + ℓ * (d : ℤ) * (r₁ : ℤ) := by simp [Nat.cast_mul, mul_assoc]
  have hsourceGuard (n : ℤ) :
      (Int.gcd n ((d * r₁ * q₀ * u₁ * v₁ * v₂ : ℕ) : ℤ) = 1 ∧
        Int.gcd (n + ℓ * ((d * r₁ : ℕ) : ℤ)) ((q₀ * q₂ : ℕ) : ℤ) = 1) ↔
          IsUnit (n : ZMod d) ∧ mask n := by
    clear * - hdbase hshift
    rw [hdbase, hshift]
    simp only [mask, ZMod.coe_int_isUnit_iff_isCoprime,
      ← Int.isCoprime_iff_gcd_eq_one, IsCoprime.mul_right_iff]
    rw [isCoprime_comm (x := (d : ℤ)) (y := n)]
    tauto
  have hsample (R : ℕ) (h : ℤ) :
      sourcePhiRealFactor ψM M R h (d : ℝ) = sourcePhi ψM M (d * R) h := by
    delta sourcePhiRealFactor sourcePhi
    rw [Nat.cast_mul]
  have hPhi₁ (h : ℤ) :
      sourcePhi ψM M ((d * r₁) * q₀ * u₁ * v₁ * q₂) h =
        sourcePhiRealFactor ψM M R₁ h (d : ℝ) := by
    simpa only [R₁, Nat.mul_assoc] using (hsample R₁ h).symm
  have hPhi₂ (h : ℤ) :
      sourcePhi ψM M ((d * r₁) * q₀ * u₁ * v₂ * q₂) h =
        sourcePhiRealFactor ψM M R₂ h (d : ℝ) := by
    simpa only [R₂, Nat.mul_assoc] using (hsample R₂ h).symm
  have hp₁ : d * r₁ ≠ 0 ∧ q₀ * u₁ * v₁ ≠ 0 ∧ q₂ ≠ 0 :=
    ⟨NeZero.ne _, NeZero.ne _, NeZero.ne _⟩
  have hp₂ : d * r₁ ≠ 0 ∧ q₀ * u₁ * v₂ ≠ 0 ∧ q₂ ≠ 0 :=
    ⟨NeZero.ne _, NeZero.ne _, NeZero.ne _⟩
  have hBlockScalar (h : ℤ × ℤ) (n : ℤ) :
      (if Int.gcd n ((d * r₁ * q₀ * u₁ * v₁ * v₂ : ℕ) : ℤ) = 1 ∧
          Int.gcd (n + ℓ * ((d * r₁ : ℕ) : ℤ)) ((q₀ * q₂ : ℕ) : ℤ) = 1 then
        (sourceCompatibility (d * r₁) q₀ b₁ b₂ ℓ n : ℂ) *
          sourcePhi ψM M ((d * r₁) * q₀ * u₁ * v₁ * q₂) h.1 *
          star (sourcePhi ψM M ((d * r₁) * q₀ * u₁ * v₂ * q₂) h.2) *
          (ψN ((n : ℝ) / N) : ℂ) *
          (sourceTheta (d * r₁) q₀ u₁ v₁ q₂ a b₁ b₂ ℓ n h.1 *
            star (sourceTheta (d * r₁) q₀ u₁ v₂ q₂ a b₁ b₂ ℓ n h.2))
      else 0) = weight (h, n) * η (h, n) * θ (h, n) := by
    change _ = (if mask n then
      (if (n : ZMod q₀) ∈ E (d : ZMod q₀) then (1 : ℂ) else 0) *
        (ψN ((n : ℝ) / N) : ℂ) else 0) * amplitude h * η (h, n) * θ (h, n)
    by_cases hnd : IsUnit (n : ZMod d)
    · by_cases hn : mask n
      · have hgn := (hsourceGuard n).mpr ⟨hnd, hn⟩
        have hcrt := (sourcePsi_secondaryCRT_factorization d r₁ q₀ u₁ v₁ v₂ q₂
          hsq hdm (a : ℤ) (b₁ : ℤ) (b₂ : ℤ) ℓ n h.1 h.2 A B
          (by simpa only [Int.cast_natCast] using And.intro hAr (And.intro hAW hAq))
          (by simpa only [Int.cast_natCast] using And.intro hBr (And.intro hBW hBq))
          (Int.isCoprime_iff_gcd_eq_one.mpr hgn.1)
          (Int.isCoprime_iff_gcd_eq_one.mpr hgn.2)).2.2
        have hphase :
            sourceTheta (d * r₁) q₀ u₁ v₁ q₂ a b₁ b₂ ℓ n h.1 *
              star (sourceTheta (d * r₁) q₀ u₁ v₂ q₂ a b₁ b₂ ℓ n h.2) =
                η (h, n) * θ (h, n) := by
          simpa only [sourceTheta, dite_eq_left hp₁, dite_eq_left hp₂,
            Int.cast_add, Int.cast_mul, Int.cast_natCast, η, θ] using hcrt
        rw [ite_eq_left hgn, hCompat n, hPhi₁, hPhi₂, hphase]
        by_cases he : (n : ZMod q₀) ∈ E (d : ZMod q₀)
        · simp only [ite_eq_left hn, ite_eq_left he, Complex.ofReal_one,
            one_mul, amplitude]
          ring
        · simp only [ite_eq_left hn, ite_eq_right he, Complex.ofReal_zero, zero_mul]
      · rw [ite_eq_right (fun hg => hn ((hsourceGuard n).mp hg).2)]
        simp only [ite_eq_right hn, zero_mul]
    · rw [ite_eq_right (fun hg => hnd ((hsourceGuard n).mp hg).1)]
      have hz : η (h, n) = 0 := by
        simp [η, reciprocalUnitPhase, IsUnit.mul_iff, hnd]
      simp only [hz, mul_zero, zero_mul]
  have hf := (sourceDispersion_positive_support_eq_finite F ∅ ψM ψN (fun _ => 0)
    M N 1 0 cN TN 1 1 hN zero_lt_one le_rfl hcN hNT zero_lt_one le_rfl hsN
    (by simp) (d * r₁) r₁ q₀ u₁ v₁ v₂ q₂ a b₁ b₂ ℓ).2.2.1
  rw [hf]
  change (∑ h ∈ F, ∑ n ∈ I, _) = ∑ i ∈ F ×ˢ I, weight i * η i * θ i
  rw [Finset.sum_product]
  apply Finset.sum_congr rfl
  intro h _
  apply Finset.sum_congr rfl
  intro n _
  exact hBlockScalar h n

open Classical in
theorem sourceSecondary_masked_physical_gram
    (r₁ q₀ u₁ v₁ v₂ q₂ a b₁ b₂ : ℕ)
    (hpos : 0 < r₁ ∧ 0 < q₀ ∧ 0 < u₁ ∧ 0 < v₁ ∧ 0 < v₂ ∧ 0 < q₂)
    (hsq : Squarefree (r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂)) (ℓ : ℤ) :
    let m : ℕ := r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂
    ∀ (A B : Fin m) (E : ZMod q₀ → Finset (ZMod q₀)),
      (A.val : ZMod r₁) = (a : ZMod r₁) →
      (A.val : ZMod (q₀ * u₁ * Nat.lcm v₁ v₂)) =
        (b₁ : ZMod (q₀ * u₁ * Nat.lcm v₁ v₂)) →
      (A.val : ZMod q₂) = (b₂ : ZMod q₂) →
      (B.val : ZMod r₁) = 0 →
      (B.val : ZMod (q₀ * u₁ * Nat.lcm v₁ v₂)) = 0 →
      (B.val : ZMod q₂) = ((ℓ * (r₁ : ℤ)) : ZMod q₂) →
      (∀ (d : ℕ), Nat.Coprime d q₀ → ∀ n : ℤ,
        sourceCompatibility (d * r₁) q₀ b₁ b₂ ℓ n =
          if (n : ZMod q₀) ∈ E (d : ZMod q₀) then 1 else 0) →
      ∀ (M N Δ₁ d₀ cM TM cN TN cD TD LM : ℝ),
        0 < M → 0 < N → 0 < Δ₁ → 0 < d₀ →
        0 < cM → cM ≤ TM → 0 < cN → cN ≤ TN → 0 < cD → cD ≤ TD →
        0 ≤ LM →
        ∀ (ψM ψN ψD : ℝ → ℝ),
          Function.support ψM ⊆ Set.Icc cM TM →
          Function.support ψN ⊆ Set.Icc cN TN →
          Function.support ψD ⊆ Set.Icc cD TD →
          (∀ t : ℝ, 0 ≤ ψD t) →
          (∀ t : ℝ, |ψM t| ≤ LM) →
          ∀ J : Finset ℤ,
            let g : ℕ := Nat.gcd v₁ v₂
            let φ : ℤ × ℤ → ℤ := fun h =>
              h.1 * ((v₂ / g : ℕ) : ℤ) - h.2 * ((v₁ / g : ℕ) : ℤ)
            let Freq : Finset (ℤ × ℤ) := (J ×ˢ J).filter
              (fun h => h.1 * (v₂ : ℤ) ≠ h.2 * (v₁ : ℤ))
            let L : Finset ℤ := ((J ×ˢ J).image φ).erase 0
            let Dmax : ℕ := ⌊d₀ + TD * Δ₁⌋₊
            let D : Finset ℕ := Finset.Icc 1 Dmax
            let I : Finset ℤ := Finset.Icc ⌈cN * N⌉ ⌊TN * N⌋
            let supported : ℤ → ℕ := fun y =>
              ∏ p ∈ m.primeFactors, p ^ y.natAbs.factorization p
            let W : Finset ℕ := D.filter (fun w => Squarefree w ∧ Nat.Coprime w m)
            let W₂ : Finset ℕ := L.image supported
            let Ys : Finset ℤ := L.image (fun y =>
              Int.sign y * ((2 ^ Nat.log 2 y.natAbs : ℕ) : ℤ))
            let Blocks : Finset (ℕ × ℕ × ℤ) := W ×ˢ W₂ ×ˢ Ys
            let Fblock : ℕ → ℕ → ℤ → Finset (ℤ × ℤ) := fun w₁ w₂ Y =>
              Freq.filter (fun h =>
                (w₁ : ℤ) ∣ φ h ∧ supported (φ h) = w₂ ∧
                1 ≤ (φ h : ℝ) / (Y : ℝ) ∧ (φ h : ℝ) / (Y : ℝ) < 2)
            let R₁ : ℕ := r₁ * q₀ * u₁ * v₁ * q₂
            let R₂ : ℕ := r₁ * q₀ * u₁ * v₂ * q₂
            let Four : (ℤ × ℤ) → (ℤ × ℤ) → ℝ → ℂ := fun h h' d =>
              sourcePhiRealFactor ψM M R₁ h.1 d *
                star (sourcePhiRealFactor ψM M R₂ h.2 d) *
                star (sourcePhiRealFactor ψM M R₁ h'.1 d) *
                sourcePhiRealFactor ψM M R₂ h'.2 d
            let kernel : ℕ → ℕ → ℤ → ℤ → ℂ := fun w₁ d y y' =>
              ∑ n ∈ I, ∑ n' ∈ I,
                sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
                  (A.val : ℤ) (B.val : ℤ) ℓ E ψN N y y' ⊤ d n n'
            let energyTerm : ℕ → ℕ → ℤ → ℕ → ℂ := fun w₁ w₂ Y d =>
              if w₁ ∣ d ∧ Nat.Coprime (d / w₁) w₁ then
                (ψD (((d : ℝ) - d₀) / Δ₁) : ℂ) *
                  ∑ h ∈ Fblock w₁ w₂ Y, ∑ h' ∈ Fblock w₁ w₂ Y,
                    if Int.gcd ((d / w₁ : ℕ) : ℤ)
                        (((m : ℤ) * φ h * φ h') / (w₁ : ℤ) ^ 2) = 1 then
                      kernel w₁ d (φ h) (φ h') * Four h h' (d : ℝ)
                    else 0
              else 0
            let block (w₁ w₂ : ℕ) (Y : ℤ) (d : ℕ) : ℂ :=
              sourceDispersionFrequencyBlock
                ((Fblock w₁ w₂ Y).filter (fun h => Int.gcd (φ h) (d : ℤ) = w₁))
                ψM (fun t => ψN (t / N)) M (d * r₁) q₀ u₁ v₁ v₂ q₂ a b₁ b₂ ℓ
            ∀ b ∈ Blocks, ∀ d ∈ D,
              (energyTerm b.1 b.2.1 b.2.2 d).im = 0 ∧
              0 ≤ (energyTerm b.1 b.2.1 b.2.2 d).re ∧
              (Squarefree d ∧ Nat.Coprime d m →
                (ψD (((d : ℝ) - d₀) / Δ₁) * ‖block b.1 b.2.1 b.2.2 d‖) ^ 2 ≤
                  (if b.1 ∣ d then ψD (((d : ℝ) - d₀) / Δ₁) * ((d / b.1 : ℕ) : ℝ)
                    else 0) * (energyTerm b.1 b.2.1 b.2.2 d).re) := by
  have hQuotientGcd (m w q : ℕ) (hw : 0 < w)
      (hwq : Nat.Coprime w q) (y y' : ℤ)
      (hwy : (w : ℤ) ∣ y) (hwy' : (w : ℤ) ∣ y') :
      Int.gcd (q : ℤ) (((m : ℤ) * y * y') / (w : ℤ) ^ 2) = 1 ↔
        Nat.Coprime q m ∧ IsUnit (y : ZMod q) ∧ IsUnit (y' : ZMod q) := by
    clear * - hw hwq hwy hwy'
    have hw0 : (w : ℤ) ≠ 0 := by exact_mod_cast hw.ne'
    rcases hwy with ⟨a, rfl⟩
    rcases hwy' with ⟨b, rfl⟩
    have hquot :
        ((m : ℤ) * ((w : ℤ) * a) * ((w : ℤ) * b)) / (w : ℤ) ^ 2 =
          (m : ℤ) * a * b := by
      rw [show (m : ℤ) * ((w : ℤ) * a) * ((w : ℤ) * b) =
          (w : ℤ) ^ 2 * ((m : ℤ) * a * b) by ring,
        Int.mul_ediv_cancel_left _ (pow_ne_zero 2 hw0)]
    rw [hquot, ← Int.isCoprime_iff_gcd_eq_one,
      ← ZMod.coe_int_isUnit_iff_isCoprime]
    simp only [Int.cast_mul, Int.cast_natCast, IsUnit.mul_iff,
      (ZMod.isUnit_iff_coprime w q).mpr hwq, true_and,
      ZMod.isUnit_iff_coprime, and_assoc, Nat.coprime_comm]
  intro m A B E hAr hAW hAq hBr hBW hBq hCompat
    M N Δ₁ d₀ cM TM cN TN cD TD LM hM hN hΔ₁pos hd₀pos
    hcM hMT hcN hNT hcD hDT hLM ψM ψN ψD hsM hsN hsD hDnonneg hMzero J
    g φ Freq L Dmax D I supported W W₂ Ys Blocks Fblock R₁ R₂ Four kernel energyTerm block
  let : NeZero m := ⟨hsq.ne_zero⟩
  intro b hb d hd
  rcases b with ⟨w, w₂, Y⟩
  have hwW : w ∈ W := (Finset.mem_product.mp hb).1
  have hwpos : 0 < w := (Finset.mem_Icc.mp (Finset.mem_filter.mp hwW).1).1
  have hwcop : Nat.Coprime w m := (Finset.mem_filter.mp hwW).2.2
  have hdpos : 0 < d := (Finset.mem_Icc.mp hd).1
  let : NeZero w := ⟨hwpos.ne'⟩
  let : NeZero d := ⟨hdpos.ne'⟩
  let T : Finset (ℤ × ℤ) := Fblock w w₂ Y
  let F : Finset (ℤ × ℤ) := T.filter (fun h => Int.gcd (φ h) (d : ℤ) = w)
  let ρ : ℝ := ψD (((d : ℝ) - d₀) / Δ₁)
  have hwy (h : ℤ × ℤ) (hh : h ∈ T) : (w : ℤ) ∣ φ h :=
    (Finset.mem_filter.mp hh).2.1
  have hblockZero (hndiv : ¬w ∣ d) : block w w₂ Y d = 0 := by
    have hF : F = ∅ := by
      apply Finset.eq_empty_of_forall_notMem
      intro h hh
      have hz := Int.gcd_dvd_right (φ h) (d : ℤ)
      rw [(Finset.mem_filter.mp hh).2] at hz
      exact hndiv (by exact_mod_cast hz)
    change sourceDispersionFrequencyBlock F ψM (fun t => ψN (t / N)) M
      (d * r₁) q₀ u₁ v₁ v₂ q₂ a b₁ b₂ ℓ = 0
    simp only [hF, sourceDispersionFrequencyBlock, Finset.sum_empty]
  by_cases hgate : w ∣ d ∧ Nat.Coprime (d / w) w
  · let q : ℕ := d / w
    have hqpos : 0 < q := Nat.div_pos (Nat.le_of_dvd hdpos hgate.1) hwpos
    let : NeZero q := ⟨hqpos.ne'⟩
    have hwd : w * q = d := Nat.mul_div_cancel' hgate.1
    have hwq : Nat.Coprime w q := hgate.2.symm
    by_cases hqm : Nat.Coprime q m
    · have hdmw : Nat.Coprime (w * q) m := Nat.coprime_mul_iff_left.mpr ⟨hwcop, hqm⟩
      have hdm : Nat.Coprime d m := by simpa only [hwd] using hdmw
      have hdq₀ : Nat.Coprime d q₀ := by
        have hh : Nat.Coprime d (r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂) := hdm
        simp only [Nat.coprime_mul_iff_right] at hh
        exact hh.1.1.1.2
      have hFy (h : ℤ × ℤ) (hh : h ∈ T) :
          Int.gcd (φ h) (d : ℤ) = w ↔ IsUnit (φ h : ZMod q) := by
        simpa only [hwd, hwy h hh, true_and] using
          sourceSecondaryGcd_quotient_unit_iff w q hwq (φ h)
      have hPairFreq (h : ℤ × ℤ) (hh : h ∈ T) (h' : ℤ × ℤ) (hh' : h' ∈ T) :
          Int.gcd (q : ℤ) (((m : ℤ) * φ h * φ h') / (w : ℤ) ^ 2) = 1 ↔
            Int.gcd (φ h) (d : ℤ) = w ∧ Int.gcd (φ h') (d : ℤ) = w := by
        simpa only [← hFy h hh, ← hFy h' hh'] using
          (hQuotientGcd m w q hwpos hwq
            (φ h) (φ h') (hwy h hh) (hwy h' hh')).trans (and_iff_right hqm)
      let base : ℕ := r₁ * q₀ * u₁ * v₁ * v₂
      let mask : ℤ → Prop := fun n =>
        Int.gcd n (base : ℤ) = 1 ∧
          Int.gcd (n + ℓ * (d : ℤ) * (r₁ : ℤ)) ((q₀ * q₂ : ℕ) : ℤ) = 1
      let aN : ℤ → ℂ := fun n => if mask n then
        (if (n : ZMod q₀) ∈ E (d : ZMod q₀) then (1 : ℂ) else 0) *
          (ψN ((n : ℝ) / N) : ℂ) else 0
      let amplitude : (ℤ × ℤ) → ℂ := fun h =>
        sourcePhiRealFactor ψM M R₁ h.1 (d : ℝ) *
          star (sourcePhiRealFactor ψM M R₂ h.2 (d : ℝ))
      let S : Finset ((ℤ × ℤ) × ℤ) := F ×ˢ I
      let weight : ((ℤ × ℤ) × ℤ) → ℂ := fun i => aN i.2 * amplitude i.1
      let η : ((ℤ × ℤ) × ℤ) → ℂ := fun i =>
        reciprocalUnitPhase d
          (((a : ℤ) : ZMod d) * (φ i.1 : ZMod d))
          ((i.2 : ZMod d) * (m : ZMod d))
      let θ : ((ℤ × ℤ) × ℤ) → ℂ := fun i =>
        reciprocalUnitPhase m
          (((A.val : ℤ) : ZMod m) * (φ i.1 : ZMod m))
          ((d : ZMod m) * ((i.2 : ZMod m) + ((B.val : ℤ) : ZMod m) * (d : ZMod m)))
      let pairPhase : ((ℤ × ℤ) × ℤ) → ((ℤ × ℤ) × ℤ) → ℂ := fun i j =>
        reciprocalUnitPhase m
          (((A.val : ℤ) : ZMod m) *
            (((φ i.1 * (j.2 + (B.val : ℤ) * (d : ℤ)) -
                φ j.1 * (i.2 + (B.val : ℤ) * (d : ℤ))) / (d : ℤ) : ℤ) : ZMod m))
          (((i.2 : ZMod m) + ((B.val : ℤ) : ZMod m) * (d : ZMod m)) *
            ((j.2 : ZMod m) + ((B.val : ℤ) : ZMod m) * (d : ZMod m)))
      let Vset : Finset ((ℤ × ℤ) × ℤ) := S.filter (fun i => IsUnit (i.2 : ZMod w))
      let gram : ℂ := ∑ i ∈ Vset, ∑ j ∈ Vset.filter (fun j =>
          Int.ModEq (d : ℤ) (φ i.1 * j.2) (φ j.1 * i.2)),
        weight i * star (weight j) * pairPhase i j
      have hFour (h h' : ℤ × ℤ) :
          amplitude h * star (amplitude h') = Four h h' (d : ℝ) := by
        simp [amplitude, Four, mul_assoc]
      have hgramSum : gram = ∑ h ∈ F, ∑ h' ∈ F,
          kernel w d (φ h) (φ h') * Four h h' (d : ℝ) := by
        clear * - hFour
        have hRaw := sourceSecondary_pair_kernel_gram_identity
          m r₁ q₀ u₁ v₁ v₂ q₂ w d (A.val : ℤ) (B.val : ℤ) ℓ E ψN N F I φ
          amplitude (fun h h' => Four h h' (d : ℝ)) hFour
        have hfilter (s : Finset ((ℤ × ℤ) × ℤ))
            (dec : DecidablePred (fun i : (ℤ × ℤ) × ℤ => IsUnit (i.2 : ZMod w))) :
            @Finset.filter ((ℤ × ℤ) × ℤ) (fun i => IsUnit (i.2 : ZMod w)) dec s =
              @Finset.filter ((ℤ × ℤ) × ℤ) (fun i => IsUnit (i.2 : ZMod w))
                (fun i => Classical.propDecidable (IsUnit (i.2 : ZMod w))) s :=
          @Finset.filter_congr_decidable ((ℤ × ℤ) × ℤ) s
            (fun i => IsUnit (i.2 : ZMod w)) dec
            (fun i => Classical.propDecidable (IsUnit (i.2 : ZMod w)))
        simpa only [gram, Vset, S, weight, aN, mask, pairPhase, kernel, base, hfilter] using hRaw
      have hEnergy : energyTerm w w₂ Y d = (ρ : ℂ) * gram := by
        dsimp only [energyTerm]
        rw [ite_eq_left hgate, hgramSum]
        congr 1
        change (∑ h ∈ T, ∑ h' ∈ T,
          if Int.gcd (q : ℤ) (((m : ℤ) * φ h * φ h') / (w : ℤ) ^ 2) = 1 then
            kernel w d (φ h) (φ h') * Four h h' (d : ℝ) else 0) =
          ∑ h ∈ T.filter (fun h => Int.gcd (φ h) (d : ℤ) = w),
            ∑ h' ∈ T.filter (fun h' => Int.gcd (φ h') (d : ℤ) = w),
              kernel w d (φ h) (φ h') * Four h h' (d : ℝ)
        simp only [Finset.sum_filter (s := T), Finset.ite_sum_zero]
        apply Finset.sum_congr rfl
        intro h hh
        apply Finset.sum_congr rfl
        intro h' hh'
        simp only [hPairFreq h hh h' hh', ite_and]
      have hyS (i : (ℤ × ℤ) × ℤ) (hi : i ∈ S) :
          Int.gcd (φ i.1) ((w * q : ℕ) : ℤ) = w := by
        simpa only [hwd] using
          (Finset.mem_filter.mp (Finset.mem_product.mp hi).1).2
      have hpoint : gram.im = 0 ∧ 0 ≤ gram.re ∧
          ‖∑ i ∈ S, weight i * η i * θ i‖ ^ 2 ≤ (q : ℝ) * gram.re := by
        clear_value S weight φ q
        clear * - hyS hwd hwq hdmw
        subst d
        have hRawPoint := (sourceSecondary_quotient_gram_cauchy S
          (fun i : (ℤ × ℤ) × ℤ => i.2)
          (fun i : (ℤ × ℤ) × ℤ => φ i.1) weight
          w q m hwq hdmw hyS (a : ℤ) (A.val : ℤ) (B.val : ℤ)).2
        exact hRawPoint
      have hblock : block w w₂ Y d = ∑ i ∈ S, weight i * η i * θ i :=
        sourceSecondary_phase_block_identification
          r₁ q₀ u₁ v₁ v₂ q₂ a b₁ b₂ hpos hsq ℓ A B E d hdpos hdm
          hAr hAW hAq hBr hBW hBq (hCompat d hdq₀)
          M N cM TM cN TN LM hM hN hcM hMT hcN hNT hLM
          ψM ψN hsM hsN hMzero F
      have hEre : (energyTerm w w₂ Y d).re = ρ * gram.re := by
        rw [hEnergy, Complex.re_ofReal_mul]
      refine ⟨?_, ?_, ?_⟩
      · rw [hEnergy, Complex.im_ofReal_mul, hpoint.1, mul_zero]
      · rw [hEre]
        exact mul_nonneg (hDnonneg _) hpoint.2.1
      · intro _
        rw [hEre, ite_eq_left hgate.1]
        change (ρ * ‖block w w₂ Y d‖) ^ 2 ≤ ρ * (q : ℝ) * (ρ * gram.re)
        rw [hblock, mul_pow]
        exact (mul_le_mul_of_nonneg_left hpoint.2.2 (sq_nonneg ρ)).trans_eq (by ring)
    · have he0 : energyTerm w w₂ Y d = 0 := by
        dsimp only [energyTerm]
        rw [ite_eq_left hgate]
        change (ρ : ℂ) * (∑ h ∈ T, ∑ h' ∈ T,
          if Int.gcd (q : ℤ) (((m : ℤ) * φ h * φ h') / (w : ℤ) ^ 2) = 1 then
            kernel w d (φ h) (φ h') * Four h h' (d : ℝ) else 0) = 0
        apply mul_eq_zero_of_right
        apply Finset.sum_eq_zero
        intro h hh
        apply Finset.sum_eq_zero
        intro h' hh'
        apply ite_eq_right
        intro hc
        exact hqm ((hQuotientGcd m w q hwpos hwq (φ h) (φ h')
          (hwy h hh) (hwy h' hh')).mp hc).1
      refine ⟨by simp [he0], by simp [he0], ?_⟩
      intro hs
      exact (hqm (Nat.Coprime.of_dvd_left (Nat.div_dvd_of_dvd hgate.1) hs.2)).elim
  · have he0 : energyTerm w w₂ Y d = 0 := by
      simp only [energyTerm, ite_eq_right hgate]
    refine ⟨by simp [he0], by simp [he0], ?_⟩
    intro hs
    by_cases hwd : w ∣ d
    · exact (hgate ⟨hwd, (Nat.coprime_of_squarefree_mul (by
        simpa only [Nat.mul_div_cancel' hwd] using hs.1)).symm⟩).elim
    · simp [hblockZero hwd, hwd, he0]

open Classical in
theorem sourceSecondary_uniform_loss_packet
    (ε AM EM AN EN AD ED K KR C TD : ℝ) (J₀ : ℕ) (hε : 0 < ε) :
    ∀ᶠ x : ℝ in Filter.atTop,
      Real.exp 1 ≤ x ∧
      (∀ m : ℕ, 0 < m → (m : ℝ) ≤ x ^ (100 : ℝ) →
        ∀ L : Finset ℤ, (∀ y ∈ L, y ≠ 0 ∧ (y.natAbs : ℝ) ≤ x ^ (100 : ℝ)) →
          ((L.image (fun y => ∏ p ∈ m.primeFactors,
            p ^ y.natAbs.factorization p)).card : ℝ) ≤ x ^ (ε / 4)) ∧
      (∀ w : ℕ, Squarefree w → (w : ℝ) ≤ x ^ (100 : ℝ) →
        (w.divisors.card : ℝ) ≤ x ^ (ε / 2)) ∧
      (Real.log x) ^ (4 * max 0 EM) ≤ x ^ ε ∧
      AM * (Real.log x) ^ EM ≤ x ∧
      AN * (Real.log x) ^ EN ≤ x ∧
      AD * (Real.log x) ^ ED ≤ x ∧
      AD * (Real.log x) ^ ED ≤ x ^ (ε / 2) ∧
      C + TD ≤ x ^ (ε / 2) ∧
      KR ≤ x ∧
      K * (J₀ + 1) ≤ x ^ (ε / 4) ∧
      K ≤ x ∧
      (∀ L : Finset ℤ,
        (∀ y ∈ L, y ≠ 0 ∧ (y.natAbs : ℝ) ≤ x ^ (100 : ℝ)) →
          ((L.image (fun y =>
            Int.sign y * ((2 ^ Nat.log 2 y.natAbs : ℕ) : ℤ))).card : ℝ) ≤
              x ^ (ε / 4)) ∧
      (∀ (Dmax : ℕ) (W : Finset ℕ), W ⊆ Finset.Icc 1 Dmax →
        (Dmax : ℝ) ≤ x ^ (100 : ℝ) →
          (∑ w ∈ W, (w : ℝ)⁻¹) ≤ x ^ (ε / 4)) := by
  have hDyadicCount (x : ℝ) (hx : Real.exp 1 ≤ x) (L : Finset ℤ)
      (hL : ∀ y ∈ L, y ≠ 0 ∧ (y.natAbs : ℝ) ≤ x ^ (100 : ℝ)) :
      let Ys : Finset ℤ := L.image (fun y =>
        Int.sign y * ((2 ^ Nat.log 2 y.natAbs : ℕ) : ℤ))
      (Ys.card : ℝ) ≤ (4 + 400 / Real.log 2) * Real.log x := by
    intro Ys
    have hx0 : 0 < x := (Real.exp_pos 1).trans_le hx
    have hlogx : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hx
    have hlog2 : 0 < Real.log 2 := Real.log_pos (by norm_num)
    let K : ℕ := ⌊100 * Real.log x / Real.log 2⌋₊
    let S : Finset (ℤ × ℕ) := ({-1, 1} : Finset ℤ) ×ˢ Finset.range (K + 1)
    let f : ℤ × ℕ → ℤ := fun p => p.1 * ((2 ^ p.2 : ℕ) : ℤ)
    have hsub : Ys ⊆ S.image f := by
      apply Finset.image_subset_iff.mpr
      intro y hy
      have hy0 : 0 < (y.natAbs : ℝ) := by
        exact_mod_cast Int.natAbs_pos.mpr (hL y hy).1
      have hk : Nat.log 2 y.natAbs ≤ K := by
        apply Nat.le_floor
        refine (Real.natLog_le_logb y.natAbs 2).trans ?_
        change Real.log (y.natAbs : ℝ) / Real.log 2 ≤ 100 * Real.log x / Real.log 2
        apply div_le_div_of_nonneg_right _ hlog2.le
        simpa only [Real.log_rpow hx0] using Real.log_le_log hy0 (hL y hy).2
      refine Finset.mem_image.mpr ⟨(Int.sign y, Nat.log 2 y.natAbs), ?_, rfl⟩
      apply Finset.mem_product.mpr
      constructor
      · simpa only [Finset.mem_insert, Finset.mem_singleton,
          Int.sign_eq_neg_one_iff_neg, Int.sign_eq_one_iff_pos] using
          (lt_or_gt_of_ne (hL y hy).1)
      · exact Finset.mem_range.mpr (Nat.lt_succ_of_le hk)
    have hcard : Ys.card ≤ 2 * (K + 1) := by
      calc
        Ys.card ≤ (S.image f).card := Finset.card_le_card hsub
        _ ≤ S.card := Finset.card_image_le
        _ = 2 * (K + 1) := by norm_num [S]
    have hcardR : (Ys.card : ℝ) ≤ 2 * ((K + 1 : ℕ) : ℝ) := by
      exact_mod_cast hcard
    have hA : 0 ≤ 100 * Real.log x / Real.log 2 :=
      div_nonneg (mul_nonneg (by norm_num) (zero_le_one.trans hlogx)) hlog2.le
    have hfloor : (K : ℝ) ≤ 100 * Real.log x / Real.log 2 := Nat.floor_le hA
    calc
      (Ys.card : ℝ) ≤ 2 * ((K : ℝ) + 1) := by
        simpa only [Nat.cast_add, Nat.cast_one] using hcardR
      _ ≤ 2 * (100 * Real.log x / Real.log 2 + 1) :=
        mul_le_mul_of_nonneg_left (add_le_add_left hfloor 1) (by norm_num)
      _ ≤ (4 + 400 / Real.log 2) * Real.log x := by
        simp only [div_eq_mul_inv] at hA ⊢
        nlinarith only [hlogx, hA]
  have hlogAbsorb (A B η : ℝ) (hη : 0 < η) :
      ∀ᶠ x : ℝ in Filter.atTop, A * (Real.log x) ^ B ≤ x ^ η := by
    filter_upwards [((isLittleO_log_rpow_rpow_atTop B hη).const_mul_left A).eventuallyLE,
      Filter.eventually_ge_atTop (0 : ℝ)] with x hx hx0
    exact (le_abs_self (A * (Real.log x) ^ B)).trans (by
      simpa only [Real.norm_eq_abs,
        abs_of_nonneg (Real.rpow_nonneg hx0 η)] using hx)
  have hHarmonic (x : ℝ) (hx : 1 ≤ x) (Dmax : ℕ) (W : Finset ℕ)
      (hW : W ⊆ Finset.Icc 1 Dmax) (hD : (Dmax : ℝ) ≤ x ^ (100 : ℝ)) :
      (∑ w ∈ W, (w : ℝ)⁻¹) ≤ 1 + 100 * Real.log x := by
    have hsum : (∑ w ∈ W, (w : ℝ)⁻¹) ≤ (harmonic Dmax : ℝ) := by
      calc
        _ ≤ ∑ w ∈ Finset.Icc 1 Dmax, (w : ℝ)⁻¹ :=
          Finset.sum_le_sum_of_subset_of_nonneg hW
            (fun w _ _ => inv_nonneg.mpr (Nat.cast_nonneg w))
        _ = _ := by
          simp only [harmonic_eq_sum_Icc, Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast]
    have hlog : Real.log (Dmax : ℝ) ≤ 100 * Real.log x := by
      by_cases hzero : Dmax = 0
      · simp only [hzero, Nat.cast_zero, Real.log_zero]
        exact mul_nonneg (by norm_num) (Real.log_nonneg hx)
      · have hp : 0 < (Dmax : ℝ) := Nat.cast_pos.mpr (Nat.pos_of_ne_zero hzero)
        have ht := Real.log_le_log hp hD
        simpa only [Real.log_rpow (zero_lt_one.trans_le hx)] using ht
    exact hsum.trans ((harmonic_le_one_add_log Dmax).trans (add_le_add_right hlog 1))
  have hTau : ∀ᶠ x : ℝ in Filter.atTop, ∀ w : ℕ,
      Squarefree w → (w : ℝ) ≤ x ^ (100 : ℝ) →
      (w.divisors.card : ℝ) ≤ x ^ (ε / 2) := by
    obtain ⟨Ct, hCt, hcount⟩ := exists_primeFactors_power_bound
      (a := (2 : ℝ)) (by norm_num) (show 0 < ε / 400 by positivity)
    filter_upwards [hlogAbsorb Ct 0 (ε / 4) (by positivity),
      Filter.eventually_ge_atTop (1 : ℝ)] with x hcx hx
    intro w hw hwx
    have hdivcard : w.divisors.card = 2 ^ w.primeFactors.card := by
      rw [Nat.card_divisors hw.ne_zero, ← Finset.prod_const]
      apply Finset.prod_congr rfl
      intro p hp
      rw [Nat.factorization_eq_one_of_squarefree hw
        (Nat.prime_of_mem_primeFactors hp) (Nat.dvd_of_mem_primeFactors hp)]
    have hx0 : 0 < x := zero_lt_one.trans_le hx
    have hwp : (w : ℝ) ^ (ε / 400) ≤ x ^ (ε / 4) := by
      have hp := Real.rpow_le_rpow (Nat.cast_nonneg w) hwx
        (show 0 ≤ ε / 400 by positivity)
      rw [← Real.rpow_mul hx0.le] at hp
      convert hp using 1
      ring_nf
    have hCbound : Ct ≤ x ^ (ε / 4) := by simpa only [Real.rpow_zero, mul_one] using hcx
    calc
      (w.divisors.card : ℝ) = (2 : ℝ) ^ w.primeFactors.card := by
        rw [hdivcard, Nat.cast_pow, Nat.cast_ofNat]
      _ ≤ Ct * (w : ℝ) ^ (ε / 400) := hcount w hw.ne_zero
      _ ≤ x ^ (ε / 4) * x ^ (ε / 4) :=
        mul_le_mul hCbound hwp (Real.rpow_nonneg (Nat.cast_nonneg _) _) (Real.rpow_nonneg hx0.le _)
      _ = x ^ (ε / 2) := by rw [← Real.rpow_add hx0]; congr 1; ring
  have hW₂event := eventually_full_supported_parts_card_subpower
    100 (ε / 4) (by norm_num) (by positivity)
  have hevent := hW₂event.and (hTau.and
    ((hlogAbsorb 1 (4 * max 0 EM) ε hε).and
    ((hlogAbsorb AM EM 1 zero_lt_one).and
    ((hlogAbsorb AN EN 1 zero_lt_one).and
    ((hlogAbsorb AD ED 1 zero_lt_one).and
    ((hlogAbsorb AD ED (ε / 2) (by positivity)).and
    ((hlogAbsorb (4 + 400 / Real.log 2) 1 (ε / 4) (by positivity)).and
    ((hlogAbsorb 101 1 (ε / 4) (by positivity)).and
    ((hlogAbsorb (C + TD) 0 (ε / 2) (by positivity)).and
    ((hlogAbsorb KR 0 1 zero_lt_one).and
    ((hlogAbsorb (K * (J₀ + 1)) 0 (ε / 4) (by positivity)).and
      (hlogAbsorb K 0 1 zero_lt_one))))))))))))
  filter_upwards [hevent, Filter.eventually_ge_atTop (Real.exp 1)] with x hx hxe
  obtain ⟨hW₂x, hTaux, hlogFx, hAMx, hANx, hADx, hADsmall,
    hYsSmall, hHarmSmall, hDSmall, hKRSmall, hFinalSmall, hKSmall⟩ := hx
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le hxe
  have hlogx : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hxe
  have hx1 : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hxe
  refine ⟨hxe, hW₂x, hTaux, ?_, ?_, ?_, ?_, hADsmall, ?_, ?_, ?_, ?_, ?_, ?_⟩
  · simpa only [one_mul] using hlogFx
  · simpa only [Real.rpow_one] using hAMx
  · simpa only [Real.rpow_one] using hANx
  · simpa only [Real.rpow_one] using hADx
  · simpa only [Real.rpow_zero, mul_one] using hDSmall
  · simpa only [Real.rpow_zero, mul_one, Real.rpow_one] using hKRSmall
  · simpa only [Real.rpow_zero, mul_one] using hFinalSmall
  · simpa only [Real.rpow_zero, mul_one, Real.rpow_one] using hKSmall
  · intro L hL
    exact (hDyadicCount x hxe L hL).trans (by
      simpa only [Real.rpow_one] using hYsSmall)
  · intro Dmax W hW hD
    calc
      _ ≤ 1 + 100 * Real.log x := hHarmonic x hx1 Dmax W hW hD
      _ ≤ 101 * Real.log x := by linarith only [hlogx]
      _ ≤ x ^ (ε / 4) := by simpa only [Real.rpow_one] using hHarmSmall

open Classical in
theorem sourceSecondary_literal_support_census
    (x C H Hstar Δ Δ₁ d₀ TD : ℝ)
    (r₁ q₀ u₁ v₁ v₂ q₂ : ℕ)
    (hx3 : 3 ≤ x) (hC : 1 ≤ C) (hCx : C ≤ x) (hTDx : TD ≤ x)
    (hΔ : 0 < Δ) (hΔ₁ : 0 < Δ₁) (hd₀ : 0 < d₀) (hTD : 0 < TD)
    (hΔ₁le : Δ₁ ≤ Δ) (hd₀hi : d₀ ≤ C * Δ) (hΔupper : Δ ≤ x ^ (2 : ℕ))
    (hH : 0 ≤ H) (hHupper : H ≤ x ^ (12 : ℕ)) (hHshi : |Hstar| ≤ C * H)
    (hv₁ : 0 < v₁) (hv₂ : 0 < v₂)
    (hrupper : (r₁ : ℝ) ≤ x ^ (29 : ℕ))
    (hqupper : (q₀ : ℝ) ≤ x ^ (5 : ℕ))
    (huupper : (u₁ : ℝ) ≤ x ^ (6 : ℕ))
    (hvupper : (v₁ : ℝ) ≤ x ^ (15 : ℕ))
    (hv'upper : (v₂ : ℝ) ≤ x ^ (15 : ℕ))
    (hq'upper : (q₂ : ℝ) ≤ x ^ (5 : ℕ)) :
    let m : ℕ := r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂
    let g : ℕ := Nat.gcd v₁ v₂
    let Hbound : ℕ := ⌊2 * |Hstar|⌋₊
    let J : Finset ℤ := (Finset.Icc (-(Hbound : ℤ)) (Hbound : ℤ)).filter
      (fun h => 1 ≤ (h : ℝ) / Hstar ∧ (h : ℝ) / Hstar < 2)
    let φ : ℤ × ℤ → ℤ := fun h =>
      h.1 * ((v₂ / g : ℕ) : ℤ) - h.2 * ((v₁ / g : ℕ) : ℤ)
    let Freq : Finset (ℤ × ℤ) := (J ×ˢ J).filter
      (fun h => h.1 * (v₂ : ℤ) ≠ h.2 * (v₁ : ℤ))
    let L : Finset ℤ := ((J ×ˢ J).image φ).erase 0
    let Dmax : ℕ := ⌊d₀ + TD * Δ₁⌋₊
    (Dmax : ℝ) ≤ (C + TD) * Δ ∧
    (Dmax : ℝ) ≤ x ^ (4 : ℕ) ∧
    (Dmax : ℝ) ≤ x ^ (100 : ℝ) ∧
    (m : ℝ) ≤ x ^ (100 : ℝ) ∧
    (∀ h ∈ Freq, φ h ∈ L) ∧
    (Hbound : ℝ) ≤ 2 * C * H ∧
    (∀ h ∈ J, |(h : ℝ)| ≤ (Hbound : ℝ) ∧ h ≠ 0) ∧
    (Freq.card : ℝ) ≤ x ^ (30 : ℕ) ∧
    (∀ y ∈ L, y ≠ 0 ∧ (y.natAbs : ℝ) ≤ x ^ (100 : ℝ)) := by
  intro m g Hbound J φ Freq L Dmax
  have hx1 : 1 ≤ x := (by norm_num : (1 : ℝ) ≤ 3).trans hx3
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hDmax : (Dmax : ℝ) ≤ (C + TD) * Δ := by
    calc
      (Dmax : ℝ) ≤ d₀ + TD * Δ₁ := Nat.floor_le (by positivity)
      _ ≤ C * Δ + TD * Δ := add_le_add hd₀hi (mul_le_mul_of_nonneg_left hΔ₁le hTD.le)
      _ = _ := by ring
  have hDsize : (Dmax : ℝ) ≤ x ^ 4 := by
    calc
      (Dmax : ℝ) ≤ (C + TD) * Δ := hDmax
      _ ≤ (x + x) * x ^ 2 := by gcongr
      _ = 2 * x ^ 3 := by ring
      _ ≤ x * x ^ 3 := mul_le_mul_of_nonneg_right (by linarith only [hx3]) (by positivity)
      _ = _ := by ring
  have hDhundred : (Dmax : ℝ) ≤ x ^ (100 : ℝ) := by
    apply hDsize.trans
    rw [← Real.rpow_natCast]
    exact Real.rpow_le_rpow_of_exponent_le hx1 (by norm_num)
  have hmBound : (m : ℝ) ≤ x ^ (100 : ℝ) := by
    have hlcm : (Nat.lcm v₁ v₂ : ℝ) ≤ (v₁ : ℝ) * (v₂ : ℝ) := by
      exact_mod_cast Nat.lcm_le_mul hv₁ hv₂
    calc
      (m : ℝ) = (r₁ : ℝ) * q₀ * u₁ * (Nat.lcm v₁ v₂ : ℝ) * q₂ := by
        simp only [m, Nat.cast_mul]
      _ ≤ (r₁ : ℝ) * q₀ * u₁ * ((v₁ : ℝ) * v₂) * q₂ := by gcongr
      _ ≤ x ^ 29 * x ^ 5 * x ^ 6 * (x ^ 15 * x ^ 15) * x ^ 5 := by gcongr
      _ = x ^ 75 := by ring
      _ ≤ x ^ (100 : ℝ) := by
        rw [← Real.rpow_natCast]
        exact Real.rpow_le_rpow_of_exponent_le hx1 (by norm_num)
  have hg₁ : (g : ℤ) * ((v₁ / g : ℕ) : ℤ) = (v₁ : ℤ) := by
    exact_mod_cast Nat.mul_div_cancel' (Nat.gcd_dvd_left v₁ v₂)
  have hg₂ : (g : ℤ) * ((v₂ / g : ℕ) : ℤ) = (v₂ : ℤ) := by
    exact_mod_cast Nat.mul_div_cancel' (Nat.gcd_dvd_right v₁ v₂)
  have hφscale (h : ℤ × ℤ) : (g : ℤ) * φ h = h.1 * (v₂ : ℤ) - h.2 * (v₁ : ℤ) := by
    dsimp only [φ]
    linear_combination h.1 * hg₂ - h.2 * hg₁
  have hφmem (h : ℤ × ℤ) (hh : h ∈ Freq) : φ h ∈ L := by
    obtain ⟨hhJ, hne⟩ := Finset.mem_filter.mp hh
    have hn : φ h ≠ 0 := by
      intro hz
      have he := hφscale h
      rw [hz, mul_zero] at he
      exact hne (sub_eq_zero.mp he.symm)
    exact Finset.mem_erase.mpr ⟨hn, Finset.mem_image_of_mem φ hhJ⟩
  have hHbound : (Hbound : ℝ) ≤ 2 * C * H := by
    calc
      (Hbound : ℝ) ≤ 2 * |Hstar| := Nat.floor_le (by positivity)
      _ ≤ 2 * (C * H) := mul_le_mul_of_nonneg_left hHshi (by norm_num)
      _ = _ := by ring
  have hHBsize : (Hbound : ℝ) ≤ x ^ 14 := by
    calc
      (Hbound : ℝ) ≤ 2 * C * H := hHbound
      _ ≤ 2 * x * x ^ 12 := by gcongr
      _ = 2 * x ^ 13 := by ring
      _ ≤ x * x ^ 13 := mul_le_mul_of_nonneg_right
        ((by norm_num : (2 : ℝ) ≤ 3).trans hx3) (pow_nonneg hx0.le _)
      _ = _ := by ring
  have hJdata (h : ℤ) (hh : h ∈ J) : |(h : ℝ)| ≤ (Hbound : ℝ) ∧ h ≠ 0 := by
    obtain ⟨hwindow, hband⟩ := Finset.mem_filter.mp hh
    constructor
    · have hb : |h| ≤ (Hbound : ℤ) := abs_le.mpr (Finset.mem_Icc.mp hwindow)
      exact_mod_cast hb
    · intro hz
      have hbad : (1 : ℝ) ≤ 0 := by simpa only [hz, Int.cast_zero, zero_div] using hband.1
      norm_num at hbad
  have hJcard : (J.card : ℝ) ≤ x ^ 15 := by
    clear * - hx1 hx3 hHBsize
    have hcard : (Finset.Icc (-(Hbound : ℤ)) (Hbound : ℤ)).card = 2 * Hbound + 1 := by
      rw [Int.card_Icc]
      omega
    have hj : (J.card : ℝ) ≤ 2 * (Hbound : ℝ) + 1 := by
      have ht := Finset.card_filter_le (Finset.Icc (-(Hbound : ℤ)) (Hbound : ℤ))
        (fun h : ℤ => 1 ≤ (h : ℝ) / Hstar ∧ (h : ℝ) / Hstar < 2)
      rw [hcard] at ht
      exact_mod_cast ht
    have hx14 : 1 ≤ x ^ (14 : ℕ) := one_le_pow₀ hx1
    calc
      (J.card : ℝ) ≤ 2 * (Hbound : ℝ) + 1 := hj
      _ ≤ 2 * x ^ 14 + 1 := by gcongr
      _ ≤ 3 * x ^ 14 := by linarith only [hx14]
      _ ≤ x * x ^ 14 := mul_le_mul_of_nonneg_right hx3 (by positivity)
      _ = _ := by ring
  have hFreqcard : (Freq.card : ℝ) ≤ x ^ 30 := by
    clear * - hJcard hx0
    have hf : Freq.card ≤ J.card * J.card := by
      simpa only [Finset.card_product] using
        Finset.card_filter_le (J ×ˢ J)
          (fun h : ℤ × ℤ => h.1 * (v₂ : ℤ) ≠ h.2 * (v₁ : ℤ))
    calc
      (Freq.card : ℝ) ≤ (J.card : ℝ) * J.card := by exact_mod_cast hf
      _ ≤ x ^ 15 * x ^ 15 := by gcongr
      _ = _ := by ring
  have hLdata (y : ℤ) (hy : y ∈ L) : y ≠ 0 ∧ (y.natAbs : ℝ) ≤ x ^ (100 : ℝ) := by
    refine ⟨(Finset.mem_erase.mp hy).1, ?_⟩
    obtain ⟨h, hh, rfl⟩ := Finset.mem_image.mp (Finset.mem_erase.mp hy).2
    obtain ⟨hh₁, hh₂⟩ := Finset.mem_product.mp hh
    have hg₁le : ((v₁ / g : ℕ) : ℝ) ≤ v₁ := by exact_mod_cast Nat.div_le_self v₁ g
    have hg₂le : ((v₂ / g : ℕ) : ℝ) ≤ v₂ := by exact_mod_cast Nat.div_le_self v₂ g
    rw [Nat.cast_natAbs, Int.cast_abs]
    simp only [φ, Int.cast_sub, Int.cast_mul, Int.cast_natCast]
    calc
      _ ≤ |(h.1 : ℝ)| * ((v₂ / g : ℕ) : ℝ) +
          |(h.2 : ℝ)| * ((v₁ / g : ℕ) : ℝ) := by
        simpa only [abs_mul, abs_of_nonneg (show (0 : ℝ) ≤ (v₂ / g : ℕ) from Nat.cast_nonneg _),
          abs_of_nonneg (show (0 : ℝ) ≤ (v₁ / g : ℕ) from Nat.cast_nonneg _)] using
          abs_sub ((h.1 : ℝ) * ((v₂ / g : ℕ) : ℝ)) ((h.2 : ℝ) * ((v₁ / g : ℕ) : ℝ))
      _ ≤ (Hbound : ℝ) * ((v₂ : ℝ) + v₁) := by
        have h₁ := (hJdata h.1 hh₁).1
        have h₂ := (hJdata h.2 hh₂).1
        nlinarith only [mul_le_mul h₁ hg₂le (Nat.cast_nonneg _) (Nat.cast_nonneg Hbound),
          mul_le_mul h₂ hg₁le (Nat.cast_nonneg _) (Nat.cast_nonneg Hbound)]
      _ ≤ x ^ 14 * (x ^ 15 + x ^ 15) := by gcongr
      _ = 2 * x ^ 29 := by ring
      _ ≤ x * x ^ 29 := mul_le_mul_of_nonneg_right (by linarith) (by positivity)
      _ = x ^ 30 := by ring
      _ ≤ x ^ (100 : ℝ) := by
        rw [← Real.rpow_natCast]
        exact Real.rpow_le_rpow_of_exponent_le hx1 (by norm_num)
  exact ⟨hDmax, hDsize, hDhundred, hmBound, hφmem, hHbound, hJdata, hFreqcard, hLdata⟩

open Classical in
theorem sourceSecondary_fourfold_taylor_certificate
    (J₀ Dmax Hbound m r₁ q₀ u₁ v₁ v₂ q₂ : ℕ) (A B : Fin m) (ℓ : ℤ)
    (E : ZMod q₀ → Finset (ZMod q₀))
    (CF KS x C ε Bsave cM TM cN TN cD TD M N H V Δ₁ d₀ AM EM : ℝ)
    (hCF : 0 < CF) (hKS : 1 ≤ KS) (hxe : Real.exp 1 ≤ x)
    (hC : 1 ≤ C) (hε : 0 < ε) (hBsave : 0 < Bsave)
    (hM : 0 < M) (hN : 0 < N) (hH : 0 ≤ H) (hV : 0 < V)
    (hΔ₁ : 0 < Δ₁) (hd₀ : 0 < d₀)
    (hcM : 0 < cM) (hMT : cM ≤ TM)
    (hcN : 0 < cN) (hNT : cN ≤ TN) (hcD : 0 < cD) (hDT : cD ≤ TD)
    (hAM : 0 ≤ AM) (hm : 0 < m)
    (hpos : 0 < r₁ ∧ 0 < q₀ ∧ 0 < u₁ ∧ 0 < v₁ ∧ 0 < v₂ ∧ 0 < q₂)
    (hTNx : TN ≤ x) (hNupper : N ≤ x)
    (ψM ψN ψD : ℝ → ℝ)
    (hsM : Function.support ψM ⊆ Set.Icc cM TM)
    (hsD : Function.support ψD ⊆ Set.Icc cD TD)
    (hMzero : ∀ t : ℝ, |ψM t| ≤ AM * (Real.log x) ^ EM)
    (hAMx : AM * (Real.log x) ^ EM ≤ x)
    (hNpoint : ∀ t : ℝ, |ψN t| ≤ x)
    (hDpoint : ∀ t : ℝ, |ψD t| ≤ x)
    (J : Finset ℤ)
    (hJwindow : ∀ h ∈ J, h ∈ Finset.Icc (-(Hbound : ℤ)) (Hbound : ℤ) ∧ h ≠ 0)
    (hHbound : (Hbound : ℝ) ≤ 2 * C * H)
    (hv₁lo : V / C ≤ (v₁ : ℝ))
    (hLogFourth : (Real.log x) ^ (4 * max 0 EM) ≤ x ^ ε)
    (hJlarge : 2 * Bsave + 1000 < ε * (J₀ : ℝ))
    (hTaylor :
      ∀ (ι : Type) [DecidableEq ι] (I : Finset ι)
        (c T M H L d₀ δ D : ℝ)
        (_ : 0 < c) (_ : c ≤ T) (_ : 0 < M)
        (_ : 0 ≤ H) (_ : 0 ≤ L) (_ : 0 < d₀) (_ : 0 < δ) (_ : 0 ≤ D)
        (ψ : ℝ → ℝ) (_ : Function.support ψ ⊆ Set.Icc c T)
        (_ : ∀ t : ℝ, |ψ t| ≤ L)
        (r₁ q₀ u₁ v₁ v₂ q₂ : ℕ)
        (_ : 0 < r₁ * q₀ * u₁ * v₁ * q₂ ∧
          0 < r₁ * q₀ * u₁ * v₂ * q₂)
        (h : ι → Fin 4 → ℤ) (_ : ∀ a ∈ I, ∀ i, |(h a i : ℝ)| ≤ H),
      let R₁ : ℕ := r₁ * q₀ * u₁ * v₁ * q₂
      let R₂ : ℕ := r₁ * q₀ * u₁ * v₂ * q₂
      let F : ι → ℝ → ℂ := fun a d =>
        sourcePhiRealFactor ψ M R₁ (h a 0) d *
          star (sourcePhiRealFactor ψ M R₂ (h a 1) d) *
          star (sourcePhiRealFactor ψ M R₁ (h a 2) d) *
          sourcePhiRealFactor ψ M R₂ (h a 3) d
      let S : ℝ := δ / d₀ *
        (1 + T * M * H / d₀ * ((R₁ : ℝ)⁻¹ + (R₂ : ℝ)⁻¹))
      let coeff : ι → ℕ → ℂ := fun a j =>
        (δ ^ j / (j.factorial : ℝ)) • iteratedDeriv j (F a) d₀
      (∀ a ∈ I, ∀ j ≤ J₀, ‖coeff a j‖ ≤ CF * (T * L) ^ 4 * S ^ j) ∧
      ∀ (χ : ℝ → ℝ) (_ : Function.support χ ⊆ Set.Icc 0 (D * δ))
        (A : ℝ → ι → ℂ) (d : ℝ),
        ‖(χ (d - d₀) : ℂ) * (∑ a ∈ I, A d a * F a d) -
          ∑ j ∈ Finset.range (J₀ + 1),
            ((χ (d - d₀) * ((d - d₀) / δ) ^ j : ℝ) : ℂ) *
              (∑ a ∈ I, A d a * coeff a j)‖ ≤
          |χ (d - d₀)| * CF * (T * L) ^ 4 * (D * S) ^ (J₀ + 1) *
            (∑ a ∈ I, ‖A d a‖)) :
    let g : ℕ := Nat.gcd v₁ v₂
    let κ : ℝ := max 1 (x ^ (5 * ε) * H / V)
    let φ : ℤ × ℤ → ℤ := fun h =>
      h.1 * ((v₂ / g : ℕ) : ℤ) - h.2 * ((v₁ / g : ℕ) : ℤ)
    let Freq : Finset (ℤ × ℤ) := (J ×ˢ J).filter
      (fun h => h.1 * (v₂ : ℤ) ≠ h.2 * (v₁ : ℤ))
    let L : Finset ℤ := ((J ×ˢ J).image φ).erase 0
    let D : Finset ℕ := Finset.Icc 1 Dmax
    let I : Finset ℤ := Finset.Icc ⌈cN * N⌉ ⌊TN * N⌋
    let supported : ℤ → ℕ := fun y =>
      ∏ p ∈ m.primeFactors, p ^ y.natAbs.factorization p
    let W : Finset ℕ := D.filter (fun w => Squarefree w ∧ Nat.Coprime w m)
    let W₂ : Finset ℕ := L.image supported
    let Ys : Finset ℤ := L.image (fun y =>
      Int.sign y * ((2 ^ Nat.log 2 y.natAbs : ℕ) : ℤ))
    let Blocks : Finset (ℕ × ℕ × ℤ) := W ×ˢ W₂ ×ˢ Ys
    let Fblock : ℕ → ℕ → ℤ → Finset (ℤ × ℤ) := fun w₁ w₂ Y =>
      Freq.filter (fun h =>
        (w₁ : ℤ) ∣ φ h ∧ supported (φ h) = w₂ ∧
        1 ≤ (φ h : ℝ) / (Y : ℝ) ∧ (φ h : ℝ) / (Y : ℝ) < 2)
    let R₁ : ℕ := r₁ * q₀ * u₁ * v₁ * q₂
    let R₂ : ℕ := r₁ * q₀ * u₁ * v₂ * q₂
    let Four : (ℤ × ℤ) → (ℤ × ℤ) → ℝ → ℂ := fun h h' d =>
      sourcePhiRealFactor ψM M R₁ h.1 d *
        star (sourcePhiRealFactor ψM M R₂ h.2 d) *
        star (sourcePhiRealFactor ψM M R₁ h'.1 d) *
        sourcePhiRealFactor ψM M R₂ h'.2 d
    let ST : ℝ := Δ₁ / d₀ *
      (1 + TM * M * (2 * C * H) / d₀ * ((R₁ : ℝ)⁻¹ + (R₂ : ℝ)⁻¹))
    let coeff : (ℤ × ℤ) → (ℤ × ℤ) → ℕ → ℂ := fun h h' j =>
      (Δ₁ ^ j / (j.factorial : ℝ)) • iteratedDeriv j (Four h h') d₀
    let Γ : ℕ → ℤ → ℤ → ℂ := fun j y y' =>
      ∑ h ∈ Freq.filter (fun h => φ h = y),
        ∑ h' ∈ Freq.filter (fun h' => φ h' = y'), coeff h h' j
    let kernel : ℕ → ℕ → ℤ → ℤ → ℂ := fun w₁ d y y' =>
      ∑ n ∈ I, ∑ n' ∈ I,
        sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
          (A.val : ℤ) (B.val : ℤ) ℓ E ψN N y y' ⊤ d n n'
    let remainder : ℕ → ℕ → ℤ → ℕ → ℂ := fun w₁ w₂ Y d =>
      if w₁ ∣ d ∧ Nat.Coprime (d / w₁) w₁ then
        (ψD (((d : ℝ) - d₀) / Δ₁) : ℂ) *
          ∑ h ∈ Fblock w₁ w₂ Y, ∑ h' ∈ Fblock w₁ w₂ Y,
            if Int.gcd ((d / w₁ : ℕ) : ℤ)
                (((m : ℤ) * φ h * φ h') / (w₁ : ℤ) ^ 2) = 1 then
              kernel w₁ d (φ h) (φ h') *
                (Four h h' (d : ℝ) -
                  ∑ j ∈ Finset.range (J₀ + 1),
                    ((((d : ℝ) - d₀) / Δ₁) ^ j : ℝ) • coeff h h' j)
            else 0
      else 0
    let KF : ℝ := CF * (TM * AM) ^ 4 * KS ^ J₀
    let K : ℝ := 1 + KF * (1 + 4 * C ^ 2) ^ 2
    let KR : ℝ := CF * TM ^ 4 * (TD * KS) ^ (J₀ + 1)
    (Freq.card : ℝ) ≤ x ^ (30 : ℕ) →
    ST ≤ KS * x ^ (-4 * ε) →
    (Dmax : ℝ) ≤ x ^ (4 : ℕ) →
    KR ≤ x →
      (∀ h ∈ Freq, ∀ h' ∈ Freq, ∀ j ≤ J₀,
        ‖coeff h h' j‖ ≤ K * (Real.log x) ^ (4 * max 0 EM) *
          x ^ (-4 * (j : ℝ) * ε)) ∧
      (∀ j ≤ J₀, ∀ y ∈ L, ∀ y' ∈ L,
        ‖Γ j y y'‖ ≤ K * x ^ ε * ((g : ℝ) * κ) ^ 2) ∧
      (∀ b ∈ Blocks,
        (∑ d ∈ D, ‖remainder b.1 b.2.1 b.2.2 d‖) ≤
          K * x ^ (-2 * Bsave - 100)) := by
  intro g κ φ Freq L D I supported W W₂ Ys Blocks Fblock R₁ R₂ Four ST coeff Γ
    kernel remainder KF K KR hFreqcard hST hDsize hKRSmall
  let : NeZero m := ⟨hm.ne'⟩
  have hTMpos : 0 < TM := hcM.trans_le hMT
  have hTNpos : 0 < TN := hcN.trans_le hNT
  have hTDpos : 0 < TD := hcD.trans_le hDT
  have hx1 : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hxe
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hlogx : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hxe
  have hR₁pos : 0 < R₁ :=
    Nat.mul_pos (Nat.mul_pos (Nat.mul_pos (Nat.mul_pos hpos.1 hpos.2.1)
      hpos.2.2.1) hpos.2.2.2.1) hpos.2.2.2.2.2
  have hR₂pos : 0 < R₂ :=
    Nat.mul_pos (Nat.mul_pos (Nat.mul_pos (Nat.mul_pos hpos.1 hpos.2.1)
      hpos.2.2.1) hpos.2.2.2.2.1) hpos.2.2.2.2.2
  have hKF : 0 ≤ KF :=
    mul_nonneg (mul_nonneg hCF.le (pow_nonneg (mul_nonneg hTMpos.le hAM) _))
      (pow_nonneg (zero_le_one.trans hKS) _)
  have hKone : 1 ≤ K :=
    le_add_of_nonneg_right (mul_nonneg hKF (sq_nonneg _))
  have hKFK : KF ≤ K := by
    have hfac : 1 ≤ (1 + 4 * C ^ 2) ^ 2 :=
      one_le_pow₀ (le_add_of_nonneg_right (mul_nonneg (by norm_num) (sq_nonneg C)))
    exact (le_mul_of_one_le_right hKF hfac).trans (le_add_of_nonneg_left zero_le_one)
  have hJabs (h : ℤ) (hh : h ∈ J) : |(h : ℝ)| ≤ (Hbound : ℝ) := by
    have hbounds := Finset.mem_Icc.mp (hJwindow h hh).1
    exact_mod_cast (abs_le.mpr hbounds : |h| ≤ (Hbound : ℤ))
  have hSTnonneg : 0 ≤ ST := by dsimp only [ST]; positivity
  have hκone : 1 ≤ κ := le_max_left _ _
  have hκHV : H / V ≤ κ := by
    have hp : 1 ≤ x ^ (5 * ε) := Real.one_le_rpow hx1 (by positivity)
    have hmul : H ≤ x ^ (5 * ε) * H := le_mul_of_one_le_left hH hp
    exact (div_le_div_of_nonneg_right hmul hV.le).trans (le_max_right _ _)
  have hTaylorSet (F : Finset (ℤ × ℤ)) (hF : F ⊆ Freq) :=
    hTaylor ((ℤ × ℤ) × (ℤ × ℤ)) (F ×ˢ F) cM TM M (2 * C * H)
      (AM * (Real.log x) ^ EM) d₀ Δ₁ TD hcM hMT hM (by positivity)
      (mul_nonneg hAM (Real.rpow_nonneg (zero_le_one.trans hlogx) _))
      hd₀ hΔ₁ hTDpos.le ψM hsM hMzero r₁ q₀ u₁ v₁ v₂ q₂
      ⟨hR₁pos, hR₂pos⟩
      (fun p => ![p.1.1, p.1.2, p.2.1, p.2.2]) (by
        intro p hp i
        obtain ⟨hp₁, hp₂⟩ := Finset.mem_product.mp hp
        have hh₁ := (Finset.mem_product.mp (Finset.mem_filter.mp (hF hp₁)).1)
        have hh₂ := (Finset.mem_product.mp (Finset.mem_filter.mp (hF hp₂)).1)
        fin_cases i
        · exact (hJabs p.1.1 hh₁.1).trans hHbound
        · exact (hJabs p.1.2 hh₁.2).trans hHbound
        · exact (hJabs p.2.1 hh₂.1).trans hHbound
        · exact (hJabs p.2.2 hh₂.2).trans hHbound)
  have hCoeffSharp : ∀ h ∈ Freq, ∀ h' ∈ Freq, ∀ j ≤ J₀,
      ‖coeff h h' j‖ ≤ KF * (Real.log x) ^ (4 * max 0 (EM)) *
        x ^ (-4 * (j : ℝ) * ε) := by
    intro h hh h' hh' j hj
    clear * - hTaylorSet hCF hKS hSTnonneg hST hlogx hx0 hKF hTMpos hAM hh hh' hj
    have ht := (hTaylorSet Freq Finset.Subset.rfl).1 (h, h')
      (Finset.mem_product.mpr ⟨hh, hh'⟩) j hj
    change ‖coeff h h' j‖ ≤ CF * (TM * (AM * (Real.log x) ^ EM)) ^ 4 * ST ^ j at ht
    have hp : ST ^ j ≤ KS ^ J₀ * x ^ (-4 * (j : ℝ) * ε) := by
      calc
        ST ^ j ≤ (KS * x ^ (-4 * ε)) ^ j := pow_le_pow_left₀ hSTnonneg hST j
        _ = KS ^ j * x ^ ((-4 * ε) * (j : ℝ)) := by
          rw [mul_pow, ← Real.rpow_mul_natCast hx0.le]
        _ ≤ KS ^ J₀ * x ^ ((-4 * ε) * (j : ℝ)) :=
          mul_le_mul_of_nonneg_right (pow_le_pow_right₀ hKS hj)
            (Real.rpow_nonneg hx0.le _)
        _ = _ := by congr 2; ring
    have hl : ((Real.log x) ^ EM) ^ (4 : ℕ) ≤
        (Real.log x) ^ (4 * max 0 (EM)) := by
      rw [← Real.rpow_mul_natCast (by positivity)]
      apply Real.rpow_le_rpow_of_exponent_le hlogx
      have he := le_max_right 0 (EM)
      norm_num
      linarith only [he]
    calc
      ‖coeff h h' j‖ ≤ CF * (TM * (AM * (Real.log x) ^ EM)) ^ 4 * ST ^ j := ht
      _ ≤ CF * ((TM * AM) ^ 4 * (Real.log x) ^ (4 * max 0 (EM))) *
          (KS ^ J₀ * x ^ (-4 * (j : ℝ) * ε)) := by
        have he : (TM * (AM * (Real.log x) ^ EM)) ^ 4 =
            (TM * AM) ^ 4 * ((Real.log x) ^ EM) ^ 4 := by ring
        rw [he]
        gcongr
      _ = _ := by dsimp only [KF]; ring
  have hCoeff : ∀ h ∈ Freq, ∀ h' ∈ Freq, ∀ j ≤ J₀,
      ‖coeff h h' j‖ ≤ K * (Real.log x) ^ (4 * max 0 (EM)) *
        x ^ (-4 * (j : ℝ) * ε) := by
    intro h hh h' hh' j hj
    exact (hCoeffSharp h hh h' hh' j hj).trans (by gcongr)
  have hIpositive (n : ℤ) (hn : n ∈ I) : 0 < n := by
    have hnlo : cN * N ≤ (n : ℝ) :=
      (Int.le_ceil _).trans (by exact_mod_cast (Finset.mem_Icc.mp hn).1)
    exact_mod_cast (mul_pos hcN hN).trans_le hnlo
  have hIcard : (I.card : ℝ) ≤ x ^ 2 := by
    clear * - hIpositive hTNpos hN hTNx hNupper hx0
    have hsub : I ⊆ Finset.Icc (1 : ℤ) ⌊TN * N⌋ := by
      intro n hn
      exact Finset.mem_Icc.mpr ⟨hIpositive n hn, (Finset.mem_Icc.mp hn).2⟩
    have hfloor : (0 : ℤ) ≤ ⌊TN * N⌋ := Int.floor_nonneg.mpr (by positivity)
    have hc : (I.card : ℤ) ≤ ⌊TN * N⌋ := by
      calc
        (I.card : ℤ) ≤ ((Finset.Icc (1 : ℤ) ⌊TN * N⌋).card : ℤ) := by
          exact_mod_cast Finset.card_le_card hsub
        _ = ⌊TN * N⌋ := by
          rw [Int.card_Icc_of_le (a := (1 : ℤ)) (b := ⌊TN * N⌋) (by omega)]
          omega
    calc
      (I.card : ℝ) ≤ (⌊TN * N⌋ : ℤ) := by exact_mod_cast hc
      _ ≤ TN * N := Int.floor_le _
      _ ≤ x * x := by gcongr
      _ = _ := by ring
  have hPhaseNorm (c z : ZMod m) : ‖reciprocalUnitPhase m c z‖ ≤ 1 := by
    by_cases hz : IsUnit z <;> simp [reciprocalUnitPhase, hz]
  have hPairNorm (w₁ d : ℕ) (y y' n n' : ℤ) :
      ‖sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
        (A.val : ℤ) (B.val : ℤ) ℓ E ψN N y y' ⊤ d n n'‖ ≤ x ^ 2 := by
    dsimp only [sourceSecondaryPairTerm]
    simp only [dite_eq_right hm.ne']
    split_ifs <;> try simp only [zero_mul, mul_zero, norm_zero, sq_nonneg]
    simp only [one_mul, norm_mul, Complex.norm_real, Real.norm_eq_abs]
    calc
      _ ≤ x * x * 1 := by
        exact mul_le_mul
          (mul_le_mul (hNpoint _) (hNpoint _) (abs_nonneg _) hx0.le)
          (hPhaseNorm _ _) (norm_nonneg _) (by positivity)
      _ = _ := by ring
  have hKernelNorm (w₁ d : ℕ) (y y' : ℤ) : ‖kernel w₁ d y y'‖ ≤ x ^ 6 := by
    calc
      ‖kernel w₁ d y y'‖ ≤ ∑ n ∈ I, ∑ n' ∈ I, x ^ (2 : ℕ) := by
        apply norm_sum_le_of_le
        intro n _
        exact norm_sum_le_of_le I (fun n' _ => hPairNorm w₁ d y y' n n')
      _ = (I.card : ℝ) ^ 2 * x ^ 2 := by simp only [Finset.sum_const, nsmul_eq_mul]; ring
      _ ≤ (x ^ 2) ^ 2 * x ^ 2 := by gcongr
      _ = _ := by ring
  have hCutoffSupport : Function.support (fun t : ℝ => ψD (t / Δ₁)) ⊆
      Set.Icc 0 (TD * Δ₁) := by
    intro t ht
    have hh := hsD ht
    refine ⟨?_, ?_⟩
    · have hq : 0 ≤ t / Δ₁ := hcD.le.trans hh.1
      simpa only [zero_mul] using (le_div_iff₀ hΔ₁).mp hq
    · simpa only [mul_comm] using (div_le_iff₀ hΔ₁).mp hh.2
  have hRemainderPoint (b : ℕ × ℕ × ℤ) (d : ℕ) :
      ‖remainder b.1 b.2.1 b.2.2 d‖ ≤
        KR * x ^ (71 : ℕ) * x ^ (-4 * ε * ((J₀ + 1 : ℕ) : ℝ)) := by
    clear * - hTaylorSet hKernelNorm hCutoffSupport hFreqcard hAMx hDpoint
      hSTnonneg hST hCF hTDpos hTMpos hKS hAM hlogx hx0
    let F := Fblock b.1 b.2.1 b.2.2
    let aa : ℝ → ((ℤ × ℤ) × (ℤ × ℤ)) → ℂ := fun _ p =>
      if Int.gcd ((d / b.1 : ℕ) : ℤ)
          (((m : ℤ) * φ p.1 * φ p.2) / (b.1 : ℤ) ^ 2) = 1 then
        kernel b.1 d (φ p.1) (φ p.2)
      else 0
    have hF : F ⊆ Freq := Finset.filter_subset _ _
    have hAnorm (p : (ℤ × ℤ) × (ℤ × ℤ)) : ‖aa d p‖ ≤ x ^ (6 : ℕ) := by
      dsimp only [aa]
      split_ifs
      · exact hKernelNorm _ _ _ _
      · simp only [norm_zero, pow_nonneg hx0.le]
    have hAsum : (∑ p ∈ F ×ˢ F, ‖aa d p‖) ≤ x ^ (66 : ℕ) := by
      calc
        _ ≤ ∑ _p ∈ F ×ˢ F, x ^ (6 : ℕ) := Finset.sum_le_sum (fun p _ => hAnorm p)
        _ = (F.card : ℝ) ^ 2 * x ^ 6 := by
          simp only [Finset.sum_const, nsmul_eq_mul, Finset.card_product, Nat.cast_mul]
          ring
        _ ≤ (Freq.card : ℝ) ^ 2 * x ^ 6 := by
          gcongr
        _ ≤ (x ^ 30) ^ 2 * x ^ 6 := by gcongr
        _ = _ := by ring
    have ht := (hTaylorSet F hF).2 (fun t : ℝ => ψD (t / Δ₁))
      hCutoffSupport aa d
    change ‖(ψD (((d : ℝ) - d₀) / Δ₁) : ℂ) *
        (∑ p ∈ F ×ˢ F, aa d p * Four p.1 p.2 d) -
        ∑ j ∈ Finset.range (J₀ + 1),
          ((ψD (((d : ℝ) - d₀) / Δ₁) * (((d : ℝ) - d₀) / Δ₁) ^ j : ℝ) : ℂ) *
            (∑ p ∈ F ×ˢ F, aa d p * coeff p.1 p.2 j)‖ ≤
      |ψD (((d : ℝ) - d₀) / Δ₁)| * CF *
        (TM * (AM * (Real.log x) ^ EM)) ^ 4 * (TD * ST) ^ (J₀ + 1) *
          (∑ p ∈ F ×ˢ F, ‖aa d p‖) at ht
    have hpoly : (TD * ST) ^ (J₀ + 1) ≤
        (TD * KS) ^ (J₀ + 1) * x ^ (-4 * ε * ((J₀ + 1 : ℕ) : ℝ)) := by
      calc
        _ ≤ (TD * (KS * x ^ (-4 * ε))) ^ (J₀ + 1) := by gcongr
        _ = (TD * KS) ^ (J₀ + 1) *
            x ^ (-4 * ε * ((J₀ + 1 : ℕ) : ℝ)) := by
          rw [← mul_assoc, mul_pow, ← Real.rpow_mul_natCast hx0.le]
    have hright : |ψD (((d : ℝ) - d₀) / Δ₁)| * CF *
        (TM * (AM * (Real.log x) ^ EM)) ^ 4 * (TD * ST) ^ (J₀ + 1) *
          (∑ p ∈ F ×ˢ F, ‖aa d p‖) ≤
        KR * x ^ 71 * x ^ (-4 * ε * ((J₀ + 1 : ℕ) : ℝ)) := by
      calc
        _ ≤ x * CF * (TM * x) ^ 4 *
            ((TD * KS) ^ (J₀ + 1) * x ^ (-4 * ε * ((J₀ + 1 : ℕ) : ℝ))) * x ^ 66 := by
          gcongr
          exact hDpoint _
        _ = _ := by dsimp only [KR]; ring
    by_cases hg : b.1 ∣ d ∧ Nat.Coprime (d / b.1) b.1
    · have hid : remainder b.1 b.2.1 b.2.2 d =
          (ψD (((d : ℝ) - d₀) / Δ₁) : ℂ) *
            (∑ p ∈ F ×ˢ F, aa d p * Four p.1 p.2 d) -
          ∑ j ∈ Finset.range (J₀ + 1),
            ((ψD (((d : ℝ) - d₀) / Δ₁) * (((d : ℝ) - d₀) / Δ₁) ^ j : ℝ) : ℂ) *
              (∑ p ∈ F ×ˢ F, aa d p * coeff p.1 p.2 j) := by
        have hpoint (p : (ℤ × ℤ) × (ℤ × ℤ)) :
            (if Int.gcd ((d / b.1 : ℕ) : ℤ)
                (((m : ℤ) * φ p.1 * φ p.2) / (b.1 : ℤ) ^ 2) = 1 then
              kernel b.1 d (φ p.1) (φ p.2) *
                (Four p.1 p.2 d - ∑ j ∈ Finset.range (J₀ + 1),
                  ((((d : ℝ) - d₀) / Δ₁) ^ j : ℝ) • coeff p.1 p.2 j)
            else 0) = aa d p * Four p.1 p.2 d -
              ∑ j ∈ Finset.range (J₀ + 1),
                (((((d : ℝ) - d₀) / Δ₁) ^ j : ℝ) : ℂ) * (aa d p * coeff p.1 p.2 j) := by
          dsimp only [aa]
          split_ifs
          · rw [mul_sub, Finset.mul_sum]
            congr 1
            apply Finset.sum_congr rfl
            intro j _
            simp only [Complex.real_smul]
            ring
          · simp only [zero_mul, mul_zero, Finset.sum_const_zero, sub_self]
        calc
          remainder b.1 b.2.1 b.2.2 d =
              (ψD (((d : ℝ) - d₀) / Δ₁) : ℂ) *
                ∑ p ∈ F ×ˢ F, (aa d p * Four p.1 p.2 d -
                  ∑ j ∈ Finset.range (J₀ + 1),
                    (((((d : ℝ) - d₀) / Δ₁) ^ j : ℝ) : ℂ) *
                      (aa d p * coeff p.1 p.2 j)) := by
            simp only [remainder, ite_eq_left hg, Finset.sum_product]
            apply congrArg ((ψD (((d : ℝ) - d₀) / Δ₁) : ℂ) * ·)
            apply Finset.sum_congr rfl
            intro h _
            exact Finset.sum_congr rfl (fun h' _ => hpoint (h, h'))
          _ = (ψD (((d : ℝ) - d₀) / Δ₁) : ℂ) *
                (∑ p ∈ F ×ˢ F, aa d p * Four p.1 p.2 d) -
              (ψD (((d : ℝ) - d₀) / Δ₁) : ℂ) *
                ∑ p ∈ F ×ˢ F, ∑ j ∈ Finset.range (J₀ + 1),
                  (((((d : ℝ) - d₀) / Δ₁) ^ j : ℝ) : ℂ) *
                    (aa d p * coeff p.1 p.2 j) := by
            rw [Finset.sum_sub_distrib, mul_sub]
          _ = _ := by
            congr 1
            rw [Finset.sum_comm, Finset.mul_sum]
            apply Finset.sum_congr rfl
            intro j _
            rw [← Finset.mul_sum, Complex.ofReal_mul]
            ring
      rw [hid]
      exact ht.trans hright
    · simp only [remainder, ite_eq_right hg, norm_zero]
      dsimp only [KR]
      positivity
  have hRemainder : ∀ b ∈ Blocks,
      (∑ d ∈ D, ‖remainder b.1 b.2.1 b.2.2 d‖) ≤ K * x ^ (-2 * Bsave - 100) := by
    intro b _
    have hDcard : (D.card : ℝ) ≤ x ^ 4 := by
      simpa only [D, Nat.card_Icc, Nat.add_sub_cancel] using hDsize
    calc
      _ ≤ ∑ _d ∈ D, KR * x ^ (71 : ℕ) *
          x ^ (-4 * ε * ((J₀ + 1 : ℕ) : ℝ)) :=
        Finset.sum_le_sum (fun d _ => hRemainderPoint b d)
      _ = (D.card : ℝ) * (KR * x ^ 71 * x ^ (-4 * ε * ((J₀ + 1 : ℕ) : ℝ))) := by
        simp only [Finset.sum_const, nsmul_eq_mul]
      _ ≤ x ^ 4 * (x * x ^ 71 * x ^ (-4 * ε * ((J₀ + 1 : ℕ) : ℝ))) := by
        gcongr
      _ = x ^ (76 - 4 * ε * ((J₀ + 1 : ℕ) : ℝ)) := by
        rw [show (x ^ 4 * (x * x ^ 71 * x ^ (-4 * ε * ((J₀ + 1 : ℕ) : ℝ)))) =
          x ^ (76 : ℕ) * x ^ (-4 * ε * ((J₀ + 1 : ℕ) : ℝ)) by ring,
          ← Real.rpow_natCast, ← Real.rpow_add hx0]
        congr 1
        ring
      _ ≤ x ^ (-2 * Bsave - 100) := by
        apply Real.rpow_le_rpow_of_exponent_le hx1
        push_cast
        nlinarith only [hJlarge, hε, hBsave]
      _ ≤ K * x ^ (-2 * Bsave - 100) :=
        le_mul_of_one_le_left (Real.rpow_nonneg hx0.le _) hKone
  have hFrequencyCoeff (C H V κ : ℝ) (hC : 1 ≤ C) (hV : 0 < V)
      (hκ : 1 ≤ κ) (hHV : H / V ≤ κ) (Hbound v₁ v₂ : ℕ)
      (hv₁ : 0 < v₁) (hv₂ : 0 < v₂) (hHb : (Hbound : ℝ) ≤ 2 * C * H)
      (hvsize : V / C ≤ (v₁ : ℝ)) (J : Finset ℤ)
      (hJ : ∀ h ∈ J, h ∈ Finset.Icc (-(Hbound : ℤ)) (Hbound : ℤ) ∧ h ≠ 0) :
      let g : ℕ := Nat.gcd v₁ v₂
      let φ : ℤ × ℤ → ℤ := fun h =>
        h.1 * ((v₂ / g : ℕ) : ℤ) - h.2 * ((v₁ / g : ℕ) : ℤ)
      let Freq : Finset (ℤ × ℤ) := (J ×ˢ J).filter
        (fun h => h.1 * (v₂ : ℤ) ≠ h.2 * (v₁ : ℤ))
      ∀ (c₂ : (ℤ × ℤ) → (ℤ × ℤ) → ℂ) (B₂ : ℝ), 0 ≤ B₂ →
        (∀ h ∈ Freq, ∀ h' ∈ Freq, ‖c₂ h h'‖ ≤ B₂) →
        let Γ : ℤ → ℤ → ℂ := fun y y' =>
          ∑ h ∈ Freq.filter (fun h => φ h = y),
            ∑ h' ∈ Freq.filter (fun h' => φ h' = y'), c₂ h h'
        ∀ y y' : ℤ, ‖Γ y y'‖ ≤
          B₂ * (1 + 4 * C ^ 2) ^ 2 * ((g : ℝ) * κ) ^ 2 := by
    intro g φ Freq
    clear * - hC hV hκ hHV hv₁ hv₂ hHb hvsize hJ
    let Q : ℝ := 2 * (Hbound : ℝ) / ((max (v₁ / g) (v₂ / g) : ℕ) : ℝ) + 1
    have hC0 : 0 < C := zero_lt_one.trans_le hC
    have hg : 0 < g := Nat.gcd_pos_of_pos_left v₂ hv₁
    have hgr : 0 < (g : ℝ) := by exact_mod_cast hg
    have hg1 : (1 : ℝ) ≤ g := by exact_mod_cast Nat.succ_le_of_lt hg
    let U : ℕ := max (v₁ / g) (v₂ / g)
    have hU : 0 < U := (Nat.div_gcd_pos_of_pos_left v₂ hv₁).trans_le (le_max_left _ _)
    have hUr : 0 < (U : ℝ) := by exact_mod_cast hU
    have hv₁g : (v₁ : ℝ) = ((v₁ / g : ℕ) : ℝ) * (g : ℝ) := by
      exact_mod_cast (Nat.div_mul_cancel (Nat.gcd_dvd_left v₁ v₂)).symm
    have hVU : V ≤ C * (g : ℝ) * (U : ℝ) := by
      calc
        V ≤ (v₁ : ℝ) * C := (div_le_iff₀ hC0).mp hvsize
        _ = C * (g : ℝ) * ((v₁ / g : ℕ) : ℝ) := by rw [hv₁g]; ring
        _ ≤ C * (g : ℝ) * (U : ℝ) :=
          mul_le_mul_of_nonneg_left (by exact_mod_cast (le_max_left (v₁ / g) (v₂ / g)))
            (mul_nonneg hC0.le hgr.le)
    have hnum : 2 * (Hbound : ℝ) ≤ (4 * C ^ 2 * (g : ℝ) * κ) * (U : ℝ) := by
      calc
        2 * (Hbound : ℝ) ≤ 4 * C * H := by nlinarith only [hHb]
        _ ≤ 4 * C * (κ * V) :=
          mul_le_mul_of_nonneg_left ((div_le_iff₀ hV).mp hHV) (by positivity)
        _ = (4 * C * κ) * V := by ring
        _ ≤ (4 * C * κ) * (C * (g : ℝ) * (U : ℝ)) :=
          mul_le_mul_of_nonneg_left hVU (by positivity)
        _ = (4 * C ^ 2 * (g : ℝ) * κ) * (U : ℝ) := by ring
    have hquot : 2 * (Hbound : ℝ) / (U : ℝ) ≤ 4 * C ^ 2 * (g : ℝ) * κ :=
      (div_le_iff₀ hUr).mpr hnum
    have hgκ : 1 ≤ (g : ℝ) * κ := one_le_mul_of_one_le_of_one_le hg1 hκ
    have hQ : Q ≤ (1 + 4 * C ^ 2) * (g : ℝ) * κ := by
      change 2 * (Hbound : ℝ) / (U : ℝ) + 1 ≤ (1 + 4 * C ^ 2) * (g : ℝ) * κ
      nlinarith only [hquot, hgκ]
    let q : ℕ := (2 * Hbound) / U + 1
    have hq : (q : ℝ) ≤ Q := by
      have hd := Nat.cast_div_le (α := ℝ) (m := 2 * Hbound) (n := U)
      simpa [q, Q, U] using add_le_add_left hd 1
    let R : ℕ := Freq.sup (fun h => (Freq.filter (fun h' => h' = h)).card)
    have hR : R ≤ 1 := by
      apply Finset.sup_le
      intro h hh
      simp [Finset.filter_eq', hh]
    have hRq : ((R * q : ℕ) : ℝ) ≤ (q : ℝ) := by
      exact_mod_cast (mul_le_of_le_one_left (Nat.zero_le q) hR)
    have hwindow (h : ℤ × ℤ) (hh : h ∈ Freq) :
        h.1 ∈ (Finset.Icc (-(Hbound : ℤ)) (Hbound : ℤ)).filter (fun t => t ≠ 0) ∧
        h.2 ∈ (Finset.Icc (-(Hbound : ℤ)) (Hbound : ℤ)).filter (fun t => t ≠ 0) := by
      obtain ⟨h₁, h₂⟩ := Finset.mem_product.mp (Finset.mem_filter.mp hh).1
      exact ⟨Finset.mem_filter.mpr (hJ h.1 h₁), Finset.mem_filter.mpr (hJ h.2 h₂)⟩
    intro c₂ B₂ hB₂ hc₂ Γ y y'
    have hbound := (secondary_frequency_pair_coefficient_regrouping
      Hbound v₁ v₂ hv₁ hv₂ Freq id hwindow c₂ B₂ hB₂ hc₂).1 y y'
    change ‖Γ y y'‖ ≤ B₂ * (((R * q : ℕ) : ℝ) ^ 2) at hbound
    calc
      ‖Γ y y'‖ ≤ B₂ * (((R * q : ℕ) : ℝ) ^ 2) := hbound
      _ ≤ B₂ * ((1 + 4 * C ^ 2) * (g : ℝ) * κ) ^ 2 :=
        mul_le_mul_of_nonneg_left
          (pow_le_pow_left₀ (Nat.cast_nonneg _) (hRq.trans (hq.trans hQ)) 2) hB₂
      _ = B₂ * (1 + 4 * C ^ 2) ^ 2 * ((g : ℝ) * κ) ^ 2 := by ring
  have hGammaBound : ∀ j ≤ J₀, ∀ y ∈ L, ∀ y' ∈ L,
      ‖Γ j y y'‖ ≤ K * x ^ ε * ((g : ℝ) * κ) ^ 2 := by
    intro j hj y _ y' _
    have hf := (hFrequencyCoeff C H V κ hC hV hκone hκHV Hbound v₁ v₂
      hpos.2.2.2.1 hpos.2.2.2.2.1 hHbound hv₁lo J hJwindow)
      (fun h h' => coeff h h' j) (KF * x ^ ε) (by positivity) (by
        intro h hh h' hh'
        calc
          ‖coeff h h' j‖ ≤ KF * (Real.log x) ^ (4 * max 0 (EM)) *
              x ^ (-4 * (j : ℝ) * ε) := hCoeffSharp h hh h' hh' j hj
          _ ≤ KF * x ^ ε * 1 := by
            gcongr
            exact Real.rpow_le_one_of_one_le_of_nonpos hx1 (by
              nlinarith only [hε, (Nat.cast_nonneg j : (0 : ℝ) ≤ (j : ℝ))])
          _ = _ := mul_one _) y y'
    change ‖Γ j y y'‖ ≤ (KF * x ^ ε) * (1 + 4 * C ^ 2) ^ 2 *
      ((g : ℝ) * κ) ^ 2 at hf
    calc
      ‖Γ j y y'‖ ≤ (KF * x ^ ε) * (1 + 4 * C ^ 2) ^ 2 * ((g : ℝ) * κ) ^ 2 := hf
      _ = (KF * (1 + 4 * C ^ 2) ^ 2) * x ^ ε * ((g : ℝ) * κ) ^ 2 := by ring
      _ ≤ K * x ^ ε * ((g : ℝ) * κ) ^ 2 := by
        gcongr
        exact le_add_of_nonneg_left zero_le_one
  exact ⟨hCoeff, hGammaBound, hRemainder⟩

open Classical in
theorem sourceSecondary_positive_block_cauchy
    (x ε K C Δ : ℝ) (hx : 1 ≤ x) (hε : 0 < ε)
    (hK : 1 ≤ K) (hC : 1 ≤ C) (hΔ : 0 < Δ)
    (r₁ q₀ u₁ v₁ v₂ q₂ a b₁ b₂ : ℕ)
    (hpos : 0 < r₁ ∧ 0 < q₀ ∧ 0 < u₁ ∧ 0 < v₁ ∧ 0 < v₂ ∧ 0 < q₂)
    (hsq : Squarefree (r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂)) (ℓ : ℤ) :
    let m : ℕ := r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂
    ∀ (A B : Fin m) (E : ZMod q₀ → Finset (ZMod q₀)),
      (A.val : ZMod r₁) = (a : ZMod r₁) →
      (A.val : ZMod (q₀ * u₁ * Nat.lcm v₁ v₂)) =
        (b₁ : ZMod (q₀ * u₁ * Nat.lcm v₁ v₂)) →
      (A.val : ZMod q₂) = (b₂ : ZMod q₂) →
      (B.val : ZMod r₁) = 0 →
      (B.val : ZMod (q₀ * u₁ * Nat.lcm v₁ v₂)) = 0 →
      (B.val : ZMod q₂) = ((ℓ * (r₁ : ℤ)) : ZMod q₂) →
      (∀ (d : ℕ), Nat.Coprime d q₀ → ∀ n : ℤ,
        sourceCompatibility (d * r₁) q₀ b₁ b₂ ℓ n =
          if (n : ZMod q₀) ∈ E (d : ZMod q₀) then 1 else 0) →
      ∀ (M N Δ₁ d₀ cM TM cN TN cD TD LM : ℝ),
        0 < M → 0 < N → 0 < Δ₁ → 0 < d₀ →
        0 < cM → cM ≤ TM → 0 < cN → cN ≤ TN → 0 < cD → cD ≤ TD →
        0 ≤ LM →
        ∀ (ψM ψN ψD : ℝ → ℝ),
          Function.support ψM ⊆ Set.Icc cM TM →
          Function.support ψN ⊆ Set.Icc cN TN →
          Function.support ψD ⊆ Set.Icc cD TD →
          (∀ t : ℝ, 0 ≤ ψD t) →
          (∀ t : ℝ, |ψM t| ≤ LM) →
          (∀ t : ℝ, ψD t ≤ x ^ (ε / 2)) →
          ∀ J : Finset ℤ,
            let g : ℕ := Nat.gcd v₁ v₂
            let φ : ℤ × ℤ → ℤ := fun h =>
              h.1 * ((v₂ / g : ℕ) : ℤ) - h.2 * ((v₁ / g : ℕ) : ℤ)
            let Freq : Finset (ℤ × ℤ) := (J ×ˢ J).filter
              (fun h => h.1 * (v₂ : ℤ) ≠ h.2 * (v₁ : ℤ))
            let L : Finset ℤ := ((J ×ˢ J).image φ).erase 0
            let Dmax : ℕ := ⌊d₀ + TD * Δ₁⌋₊
            let D : Finset ℕ := Finset.Icc 1 Dmax
            let I : Finset ℤ := Finset.Icc ⌈cN * N⌉ ⌊TN * N⌋
            let supported : ℤ → ℕ := fun y =>
              ∏ p ∈ m.primeFactors, p ^ y.natAbs.factorization p
            let W : Finset ℕ := D.filter (fun w => Squarefree w ∧ Nat.Coprime w m)
            let W₂ : Finset ℕ := L.image supported
            let Ys : Finset ℤ := L.image (fun y =>
              Int.sign y * ((2 ^ Nat.log 2 y.natAbs : ℕ) : ℤ))
            let Blocks : Finset (ℕ × ℕ × ℤ) := W ×ˢ W₂ ×ˢ Ys
            let Fblock : ℕ → ℕ → ℤ → Finset (ℤ × ℤ) := fun w₁ w₂ Y =>
              Freq.filter (fun h =>
                (w₁ : ℤ) ∣ φ h ∧ supported (φ h) = w₂ ∧
                1 ≤ (φ h : ℝ) / (Y : ℝ) ∧ (φ h : ℝ) / (Y : ℝ) < 2)
            let R₁ : ℕ := r₁ * q₀ * u₁ * v₁ * q₂
            let R₂ : ℕ := r₁ * q₀ * u₁ * v₂ * q₂
            let Four : (ℤ × ℤ) → (ℤ × ℤ) → ℝ → ℂ := fun h h' d =>
              sourcePhiRealFactor ψM M R₁ h.1 d *
                star (sourcePhiRealFactor ψM M R₂ h.2 d) *
                star (sourcePhiRealFactor ψM M R₁ h'.1 d) *
                sourcePhiRealFactor ψM M R₂ h'.2 d
            let kernel : ℕ → ℕ → ℤ → ℤ → ℂ := fun w₁ d y y' =>
              ∑ n ∈ I, ∑ n' ∈ I,
                sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
                  (A.val : ℤ) (B.val : ℤ) ℓ E ψN N y y' ⊤ d n n'
            let energyTerm : ℕ → ℕ → ℤ → ℕ → ℂ := fun w₁ w₂ Y d =>
              if w₁ ∣ d ∧ Nat.Coprime (d / w₁) w₁ then
                (ψD (((d : ℝ) - d₀) / Δ₁) : ℂ) *
                  ∑ h ∈ Fblock w₁ w₂ Y, ∑ h' ∈ Fblock w₁ w₂ Y,
                    if Int.gcd ((d / w₁ : ℕ) : ℤ)
                        (((m : ℤ) * φ h * φ h') / (w₁ : ℤ) ^ 2) = 1 then
                      kernel w₁ d (φ h) (φ h') * Four h h' (d : ℝ)
                    else 0
              else 0
            let energy : ℕ → ℕ → ℤ → ℂ := fun w₁ w₂ Y =>
              ∑ d ∈ D, energyTerm w₁ w₂ Y d
            let maxEnergy : ℝ :=
              ((Blocks.sup (fun b => Real.toNNReal (energy b.1 b.2.1 b.2.2).re) : NNReal) : ℝ)
            (∀ h ∈ Freq, φ h ∈ L) →
            (W₂.card : ℝ) ≤ x ^ (ε / 4) →
            (Ys.card : ℝ) ≤ x ^ (ε / 4) →
            (Dmax : ℝ) ≤ (C + TD) * Δ →
            C + TD ≤ x ^ (ε / 2) →
            (∑ w ∈ W, (w : ℝ)⁻¹) ≤ x ^ (ε / 4) →
              (∀ b ∈ Blocks,
                (energy b.1 b.2.1 b.2.2).im = 0 ∧
                  0 ≤ (energy b.1 b.2.1 b.2.2).re) ∧
              sourceSigmaTwo J ψM (fun t => ψN (t / N)) ψD M Δ₁ d₀
                r₁ q₀ u₁ v₁ v₂ q₂ a b₁ b₂ ℓ ≤
                  K * x ^ (5 * ε / 2) * Δ * Real.sqrt maxEnergy := by
  have hMultipleMass (Dmax w : ℕ) (ρ : ℕ → ℝ) (B : ℝ)
      (hB : 0 ≤ B) (hρ : ∀ d ∈ Finset.Icc 1 Dmax, ρ d ≤ B) :
      (∑ d ∈ (Finset.Icc 1 Dmax).filter (fun d => w ∣ d),
        ρ d * ((d / w : ℕ) : ℝ)) ≤ B * ((Dmax : ℝ) / (w : ℝ)) ^ 2 := by
    let S := (Finset.Icc 1 Dmax).filter (fun d => w ∣ d)
    have hcard : S.card ≤ Dmax / w := by
      simpa only [S, Nat.Icc_eq_range', Nat.Ioc_eq_range', Nat.zero_add,
        Nat.add_sub_cancel, Nat.sub_zero] using (Nat.Ioc_filter_dvd_card_eq_div Dmax w).le
    have hdiv : ((Dmax / w : ℕ) : ℝ) ≤ (Dmax : ℝ) / (w : ℝ) := Nat.cast_div_le
    change (∑ d ∈ S, ρ d * ((d / w : ℕ) : ℝ)) ≤ _
    calc
      _ ≤ ∑ _d ∈ S, B * ((Dmax / w : ℕ) : ℝ) := by
        apply Finset.sum_le_sum
        intro d hd
        have hdD := (Finset.mem_filter.mp hd).1
        exact mul_le_mul (hρ d hdD)
          (Nat.cast_le.mpr (Nat.div_le_div_right (Finset.mem_Icc.mp hdD).2))
          (Nat.cast_nonneg _) hB
      _ = (S.card : ℝ) * B * ((Dmax / w : ℕ) : ℝ) := by
        simp [mul_assoc]
      _ ≤ ((Dmax / w : ℕ) : ℝ) * B * ((Dmax / w : ℕ) : ℝ) := by
        gcongr
      _ ≤ ((Dmax : ℝ) / (w : ℝ)) * B * ((Dmax : ℝ) / (w : ℝ)) := by
        gcongr
      _ = _ := by ring
  intro m A B E hAr hAW hAq hBr hBW hBq hCompat
    M N Δ₁ d₀ cM TM cN TN cD TD LM hM hN hΔ₁pos hd₀pos
    hcM hMT hcN hNT hcD hDT hLM ψM ψN ψD hsM hsN hsD hDnonneg hMzero hDsmall J
    g φ Freq L Dmax D I supported W W₂ Ys Blocks Fblock R₁ R₂ Four kernel
    energyTerm energy maxEnergy hφmem hW₂small hYssmall hDmax hDSmall hWsum
  have hx0 : 0 < x := zero_lt_one.trans_le hx
  have hTDpos : 0 < TD := hcD.trans_le hDT
  let sigmaTwoTerm : ℕ → ℝ := fun d =>
    if Squarefree d ∧ Nat.Coprime d m then
      ψD (((d : ℝ) - d₀) / Δ₁) *
        ‖sourceDispersionFrequencyBlock Freq ψM (fun t => ψN (t / N)) M
          (d * r₁) q₀ u₁ v₁ v₂ q₂ a b₁ b₂ ℓ‖
    else 0
  have hfin := sourceSecondary_literal_finite_support m r₁ q₀ u₁ v₁ v₂ q₂ a b₁ b₂
    (A.val : ℤ) (B.val : ℤ) ℓ E J L ψM ψN ψD M N Δ₁ d₀ cN TN cD TD
    hN hΔ₁pos hd₀pos.le hcN hNT hcD hDT hsN hsD
  let dy : ℤ → ℤ := fun y =>
    Int.sign y * ((2 ^ Nat.log 2 y.natAbs : ℕ) : ℤ)
  have hdyRatio (y z : ℤ) (hy : y ≠ 0) (hs : Int.sign y = Int.sign z) :
      (y : ℝ) / (dy z : ℝ) =
        (y.natAbs : ℝ) / ((2 ^ Nat.log 2 z.natAbs : ℕ) : ℝ) := by
    have hsign : Int.sign z ≠ 0 := fun hz =>
      hy (Int.eq_zero_of_sign_eq_zero (hs.trans hz))
    have hsignR : (Int.sign z : ℝ) ≠ 0 := by exact_mod_cast hsign
    have hyreal : (y : ℝ) = (Int.sign y : ℝ) * (y.natAbs : ℝ) := by
      simpa only [Int.cast_mul, Int.cast_natCast] using
        congrArg (fun t : ℤ => (t : ℝ)) (Int.sign_mul_natAbs y).symm
    rw [hyreal]
    simp only [dy, Int.cast_mul, Int.cast_natCast]
    rw [hs]
    exact mul_div_mul_left _ _ hsignR
  have hdyBand (y : ℤ) (hy : y ≠ 0) :
      1 ≤ (y : ℝ) / (dy y : ℝ) ∧ (y : ℝ) / (dy y : ℝ) < 2 := by
    have hlo : 2 ^ Nat.log 2 y.natAbs ≤ y.natAbs :=
      Nat.pow_log_le_self 2 (Int.natAbs_ne_zero.mpr hy)
    have hhi : y.natAbs < 2 * 2 ^ Nat.log 2 y.natAbs := by
      simpa only [pow_succ, Nat.mul_comm] using
        Nat.lt_pow_succ_log_self (by decide : 1 < (2 : ℕ)) y.natAbs
    have hpowR : 0 < ((2 ^ Nat.log 2 y.natAbs : ℕ) : ℝ) := by positivity
    rw [hdyRatio y y hy rfl]
    constructor
    · apply (le_div_iff₀ hpowR).2
      simpa only [one_mul] using
        (show ((2 ^ Nat.log 2 y.natAbs : ℕ) : ℝ) ≤ (y.natAbs : ℝ) from
          by exact_mod_cast hlo)
    · apply (div_lt_iff₀ hpowR).2
      exact_mod_cast hhi
  have hdyUnique (y : ℤ) (hy : y ≠ 0) (Y : ℤ) (hY : Y ∈ Ys) :
      (1 ≤ (y : ℝ) / (Y : ℝ) ∧ (y : ℝ) / (Y : ℝ) < 2) ↔ Y = dy y := by
    constructor
    · intro hband
      change Y ∈ L.image dy at hY
      obtain ⟨z, _, rfl⟩ := Finset.mem_image.mp hY
      have hpow : (2 ^ Nat.log 2 z.natAbs : ℕ) ≠ 0 :=
        pow_ne_zero _ (by decide : (2 : ℕ) ≠ 0)
      have hsignDy : Int.sign (dy z) = Int.sign z := by
        simp only [dy, Int.sign_mul, Int.sign_sign,
          Int.sign_natCast_of_ne_zero hpow, mul_one]
      have hsignBand : Int.sign y = Int.sign (dy z) := by
        rcases div_pos_iff.mp (lt_of_lt_of_le zero_lt_one hband.1) with
          ⟨hypos, hYpos⟩ | ⟨hyneg, hYneg⟩
        · rw [Int.sign_eq_one_of_pos (a := y) (by exact_mod_cast hypos),
            Int.sign_eq_one_of_pos (a := dy z) (by exact_mod_cast hYpos)]
        · rw [Int.sign_eq_neg_one_of_neg (a := y) (by exact_mod_cast hyneg),
            Int.sign_eq_neg_one_of_neg (a := dy z) (by exact_mod_cast hYneg)]
      have hs : Int.sign y = Int.sign z := hsignBand.trans hsignDy
      rw [hdyRatio y z hy hs] at hband
      have hpowR : 0 < ((2 ^ Nat.log 2 z.natAbs : ℕ) : ℝ) := by positivity
      have hloR : ((2 ^ Nat.log 2 z.natAbs : ℕ) : ℝ) ≤ (y.natAbs : ℝ) := by
        simpa only [one_mul] using (le_div_iff₀ hpowR).mp hband.1
      have hhiR : (y.natAbs : ℝ) < 2 * ((2 ^ Nat.log 2 z.natAbs : ℕ) : ℝ) :=
        (div_lt_iff₀ hpowR).mp hband.2
      have hlo : 2 ^ Nat.log 2 z.natAbs ≤ y.natAbs := by exact_mod_cast hloR
      have hhi : y.natAbs < 2 ^ (Nat.log 2 z.natAbs + 1) := by
        have h : y.natAbs < 2 * 2 ^ Nat.log 2 z.natAbs := by exact_mod_cast hhiR
        simpa only [pow_succ, Nat.mul_comm] using h
      have hlog : Nat.log 2 y.natAbs = Nat.log 2 z.natAbs :=
        Nat.log_eq_of_pow_le_of_lt_pow hlo hhi
      simp only [dy, hs, hlog]
    · rintro rfl
      exact hdyBand y hy
  have hFreqPartition (d : ℕ) (hd : d ∈ D) (hsd : Squarefree d)
      (hdm : Nat.Coprime d m) (Z : ℤ × ℤ → ℂ) :
      (∑ h ∈ Freq, Z h) = ∑ b ∈ Blocks,
        ∑ h ∈ (Fblock b.1 b.2.1 b.2.2).filter
          (fun h => Int.gcd (φ h) (d : ℤ) = b.1), Z h := by
    let label : ℤ × ℤ → ℕ × ℕ × ℤ := fun h =>
      (Int.gcd (φ h) (d : ℤ), supported (φ h), dy (φ h))
    have hmap (h : ℤ × ℤ) (hh : h ∈ Freq) : label h ∈ Blocks := by
      have hgdiv : Int.gcd (φ h) (d : ℤ) ∣ d :=
        Int.natCast_dvd_natCast.mp (Int.gcd_dvd_right _ _)
      have hgp : 0 < Int.gcd (φ h) (d : ℤ) :=
        Nat.pos_of_dvd_of_pos hgdiv (Finset.mem_Icc.mp hd).1
      have hgD : Int.gcd (φ h) (d : ℤ) ∈ D := Finset.mem_Icc.mpr
        ⟨hgp, (Nat.le_of_dvd (Finset.mem_Icc.mp hd).1 hgdiv).trans (Finset.mem_Icc.mp hd).2⟩
      exact Finset.mem_product.mpr ⟨Finset.mem_filter.mpr
        ⟨hgD, hsd.squarefree_of_dvd hgdiv, hdm.of_dvd_left hgdiv⟩,
        Finset.mem_product.mpr ⟨Finset.mem_image_of_mem supported (hφmem h hh),
          Finset.mem_image_of_mem dy (hφmem h hh)⟩⟩
    have hfiber (b : ℕ × ℕ × ℤ) (hb : b ∈ Blocks) :
        Freq.filter (fun h => label h = b) =
          (Fblock b.1 b.2.1 b.2.2).filter
            (fun h => Int.gcd (φ h) (d : ℤ) = b.1) := by
      ext h
      constructor
      · intro hh
        obtain ⟨hhF, he⟩ := Finset.mem_filter.mp hh
        have hg : Int.gcd (φ h) (d : ℤ) = b.1 := congrArg Prod.fst he
        have hs : supported (φ h) = b.2.1 := congrArg (fun z => z.2.1) he
        have hY : dy (φ h) = b.2.2 := congrArg (fun z => z.2.2) he
        have hdiv : (b.1 : ℤ) ∣ φ h := by
          rw [← hg]
          exact Int.gcd_dvd_left _ _
        have hband := hdyBand (φ h) ((Finset.mem_erase.mp (hφmem h hhF)).1)
        rw [hY] at hband
        exact Finset.mem_filter.mpr ⟨Finset.mem_filter.mpr
          ⟨hhF, hdiv, hs, hband⟩, hg⟩
      · intro hh
        obtain ⟨hhB, hg⟩ := Finset.mem_filter.mp hh
        obtain ⟨hhF, _, hs, hband⟩ := Finset.mem_filter.mp hhB
        have hY := (hdyUnique (φ h) ((Finset.mem_erase.mp (hφmem h hhF)).1) b.2.2
          (Finset.mem_product.mp (Finset.mem_product.mp hb).2).2).mp hband
        exact Finset.mem_filter.mpr ⟨hhF, Prod.ext hg (Prod.ext hs hY.symm)⟩
    calc
      (∑ h ∈ Freq, Z h) = ∑ b ∈ Blocks, ∑ h ∈ Freq.filter (fun h => label h = b), Z h :=
        (Finset.sum_fiberwise_of_maps_to hmap Z).symm
      _ = _ := Finset.sum_congr rfl (fun b hb => by rw [hfiber b hb])
  have hDCS (w : ℕ) (e r : ℕ → ℝ)
      (he : ∀ d ∈ D, 0 ≤ e d)
      (hr : ∀ d ∈ D, r d ^ 2 ≤
        (if w ∣ d then ψD (((d : ℝ) - d₀) / Δ₁) * ((d / w : ℕ) : ℝ) else 0) * e d) :
      (∑ d ∈ D, r d) ≤ (Dmax : ℝ) / (w : ℝ) * x ^ (ε / 4) *
        Real.sqrt (∑ d ∈ D, e d) := by
    let f : ℕ → ℝ := fun d =>
      if w ∣ d then ψD (((d : ℝ) - d₀) / Δ₁) * ((d / w : ℕ) : ℝ) else 0
    have hf (d : ℕ) (_ : d ∈ D) : 0 ≤ f d := by
      dsimp only [f]
      split_ifs
      · exact mul_nonneg (hDnonneg _) (Nat.cast_nonneg _)
      · exact le_rfl
    have hmass : (∑ d ∈ D, f d) ≤ x ^ (ε / 2) * ((Dmax : ℝ) / (w : ℝ)) ^ 2 := by
      change (∑ d ∈ D, if w ∣ d then
        ψD (((d : ℝ) - d₀) / Δ₁) * ((d / w : ℕ) : ℝ) else 0) ≤ _
      rw [← Finset.sum_filter]
      exact hMultipleMass Dmax w (fun d => ψD (((d : ℝ) - d₀) / Δ₁))
        (x ^ (ε / 2)) (Real.rpow_nonneg hx0.le _) (by
          intro d _
          exact hDsmall _)
    have hc := Finset.sum_sq_le_sum_mul_sum_of_sq_le_mul D hf he hr
    have heSum : 0 ≤ ∑ d ∈ D, e d := Finset.sum_nonneg he
    have hsquare :
        ((Dmax : ℝ) / (w : ℝ) * x ^ (ε / 4) * Real.sqrt (∑ d ∈ D, e d)) ^ 2 =
          (x ^ (ε / 2) * ((Dmax : ℝ) / (w : ℝ)) ^ 2) * ∑ d ∈ D, e d := by
      rw [mul_pow, mul_pow, Real.sq_sqrt heSum, ← Real.rpow_mul_natCast hx0.le]
      have he : (ε / 4) * (2 : ℕ) = ε / 2 := by norm_num; ring
      rw [he]
      ring
    apply le_of_sq_le_sq _ (by positivity)
    rw [hsquare]
    exact hc.trans (mul_le_mul_of_nonneg_right hmass heSum)
  let block (w₁ w₂ : ℕ) (Y : ℤ) (d : ℕ) : ℂ :=
    sourceDispersionFrequencyBlock
      ((Fblock w₁ w₂ Y).filter (fun h => Int.gcd (φ h) (d : ℤ) = w₁))
      ψM (fun t => ψN (t / N)) M (d * r₁) q₀ u₁ v₁ v₂ q₂ a b₁ b₂ ℓ
  have hEnergyPoint := sourceSecondary_masked_physical_gram
    r₁ q₀ u₁ v₁ v₂ q₂ a b₁ b₂ hpos hsq ℓ A B E
    hAr hAW hAq hBr hBW hBq hCompat
    M N Δ₁ d₀ cM TM cN TN cD TD LM
    hM hN hΔ₁pos hd₀pos hcM hMT hcN hNT hcD hDT hLM
    ψM ψN ψD hsM hsN hsD hDnonneg hMzero J
  have hEnergyLe (b : ℕ × ℕ × ℤ) (hb : b ∈ Blocks) :
      (energy b.1 b.2.1 b.2.2).re ≤ maxEnergy := by
    have hs := Finset.le_sup
      (f := fun b => Real.toNNReal (energy b.1 b.2.1 b.2.2).re) hb
    have hr := Real.toNNReal_le_iff_le_coe.mp hs
    exact hr
  have hBlockSum (b : ℕ × ℕ × ℤ) (hb : b ∈ Blocks) :
      (∑ d ∈ D, if Squarefree d ∧ Nat.Coprime d m then
        ψD (((d : ℝ) - d₀) / Δ₁) * ‖block b.1 b.2.1 b.2.2 d‖ else 0) ≤
        (Dmax : ℝ) / (b.1 : ℝ) * x ^ (ε / 4) * Real.sqrt maxEnergy := by
    have hcs := hDCS b.1 (fun d => (energyTerm b.1 b.2.1 b.2.2 d).re)
      (fun d => if Squarefree d ∧ Nat.Coprime d m then
        ψD (((d : ℝ) - d₀) / Δ₁) * ‖block b.1 b.2.1 b.2.2 d‖ else 0)
      (fun d hd => (hEnergyPoint b hb d hd).2.1) (by
        intro d hd
        by_cases hgood : Squarefree d ∧ Nat.Coprime d m
        · rw [ite_eq_left hgood]
          exact (hEnergyPoint b hb d hd).2.2 hgood
        · rw [ite_eq_right hgood, zero_pow (by decide : (2 : ℕ) ≠ 0)]
          apply mul_nonneg _ (hEnergyPoint b hb d hd).2.1
          split_ifs
          · exact mul_nonneg (hDnonneg _) (Nat.cast_nonneg _)
          · exact le_rfl)
    have hs : (∑ d ∈ D, (energyTerm b.1 b.2.1 b.2.2 d).re) =
        (energy b.1 b.2.1 b.2.2).re :=
      (Complex.re_sum D (energyTerm b.1 b.2.1 b.2.2)).symm
    rw [hs] at hcs
    exact hcs.trans (mul_le_mul_of_nonneg_left
      (Real.sqrt_le_sqrt (hEnergyLe b hb)) (by positivity))
  have hBlockPartition (d : ℕ) (hd : d ∈ D) (hsd : Squarefree d) (hdm : Nat.Coprime d m) :
      sourceDispersionFrequencyBlock Freq ψM (fun t => ψN (t / N)) M
        (d * r₁) q₀ u₁ v₁ v₂ q₂ a b₁ b₂ ℓ =
          ∑ b ∈ Blocks, block b.1 b.2.1 b.2.2 d :=
    hFreqPartition d hd hsd hdm _
  constructor
  · intro b hb
    constructor
    · rw [show energy b.1 b.2.1 b.2.2 = ∑ d ∈ D, energyTerm b.1 b.2.1 b.2.2 d from rfl,
        Complex.im_sum]
      exact Finset.sum_eq_zero (fun d hd => (hEnergyPoint b hb d hd).1)
    · rw [show energy b.1 b.2.1 b.2.2 = ∑ d ∈ D, energyTerm b.1 b.2.1 b.2.2 d from rfl,
        Complex.re_sum]
      exact Finset.sum_nonneg (fun d hd => (hEnergyPoint b hb d hd).2.1)
  · rw [hfin.2.2.2.1]
    calc
      (∑ d ∈ D, sigmaTwoTerm d) ≤ ∑ d ∈ D, ∑ b ∈ Blocks,
          if Squarefree d ∧ Nat.Coprime d m then
            ψD (((d : ℝ) - d₀) / Δ₁) * ‖block b.1 b.2.1 b.2.2 d‖ else 0 := by
        apply Finset.sum_le_sum
        intro d hd
        by_cases hgood : Squarefree d ∧ Nat.Coprime d m
        · simp only [sigmaTwoTerm, ite_eq_left hgood]
          rw [hBlockPartition d hd hgood.1 hgood.2, ← Finset.mul_sum]
          exact mul_le_mul_of_nonneg_left (norm_sum_le _ _) (hDnonneg _)
        · simp only [sigmaTwoTerm, ite_eq_right hgood, Finset.sum_const_zero, le_refl]
      _ = ∑ b ∈ Blocks, ∑ d ∈ D,
          if Squarefree d ∧ Nat.Coprime d m then
            ψD (((d : ℝ) - d₀) / Δ₁) * ‖block b.1 b.2.1 b.2.2 d‖ else 0 :=
        Finset.sum_comm
      _ ≤ ∑ b ∈ Blocks,
          (Dmax : ℝ) / (b.1 : ℝ) * x ^ (ε / 4) * Real.sqrt maxEnergy :=
        Finset.sum_le_sum (fun b hb => hBlockSum b hb)
      _ = (W₂.card : ℝ) * (Ys.card : ℝ) * (Dmax : ℝ) * x ^ (ε / 4) *
          Real.sqrt maxEnergy * ∑ w ∈ W, (w : ℝ)⁻¹ := by
        simp only [Blocks, Finset.sum_product, Finset.sum_const, nsmul_eq_mul,
          Finset.card_product, Nat.cast_mul, div_eq_mul_inv, Finset.mul_sum]
        apply Finset.sum_congr rfl
        intro w _
        ring
      _ ≤ x ^ (ε / 4) * x ^ (ε / 4) * ((C + TD) * Δ) * x ^ (ε / 4) *
          Real.sqrt maxEnergy * x ^ (ε / 4) := by gcongr
      _ ≤ x ^ (ε / 4) * x ^ (ε / 4) * (x ^ (ε / 2) * Δ) * x ^ (ε / 4) *
          Real.sqrt maxEnergy * x ^ (ε / 4) := by gcongr
      _ = (x ^ (ε / 4) * x ^ (ε / 4) * x ^ (ε / 2) * x ^ (ε / 4) * x ^ (ε / 4)) *
          Δ * Real.sqrt maxEnergy := by ring
      _ = x ^ (3 * ε / 2) * Δ * Real.sqrt maxEnergy := by
        rw [← Real.rpow_add hx0, ← Real.rpow_add hx0, ← Real.rpow_add hx0,
          ← Real.rpow_add hx0]
        congr 2
        ring_nf
      _ ≤ K * x ^ (5 * ε / 2) * Δ * Real.sqrt maxEnergy := by
        gcongr
        calc
          x ^ (3 * ε / 2) ≤ x ^ (5 * ε / 2) :=
            Real.rpow_le_rpow_of_exponent_le hx (by linarith)
          _ ≤ K * x ^ (5 * ε / 2) :=
            le_mul_of_one_le_left (Real.rpow_nonneg hx0.le _) hK

open Classical in
theorem sourceSecondary_sqrt_error_absorption
    (x ε B K Δ E S G : ℝ) (J₀ : ℕ)
    (hx : 1 ≤ x) (hε : 0 < ε) (hεbound : ε < 1 / 1000)
    (hK : 1 ≤ K) (hΔ : 0 < Δ) (hΔupper : Δ ≤ x ^ (2 : ℕ))
    (hS : 0 ≤ S) (hG : 0 ≤ G)
    (hE : E ≤ K * (J₀ + 1) * x ^ (3 * ε / 2) * G ^ 2 * S +
      K * x ^ (-2 * B - 100))
    (hfixed : K * (J₀ + 1) ≤ x ^ (ε / 4)) (hKx : K ≤ x) :
    K * x ^ (5 * ε / 2) * Δ * Real.sqrt E ≤
      K * x ^ (7 * ε / 2) * G * Δ * Real.sqrt S + K * x ^ (-B) := by
  have hx0 : 0 < x := zero_lt_one.trans_le hx
  have hKpos : 0 < K := zero_lt_one.trans_le hK
  have hKJ : 0 ≤ K * (J₀ + 1) := by positivity
  let main : ℝ := Real.sqrt (K * (J₀ + 1)) * x ^ (3 * ε / 4) * G * Real.sqrt S
  let err : ℝ := Real.sqrt K * x ^ (-B - 50)
  have hmain : 0 ≤ main := by dsimp only [main]; positivity
  have herr : 0 ≤ err := by dsimp only [err]; positivity
  have hmainPow : (x ^ (3 * ε / 4)) ^ (2 : ℕ) = x ^ (3 * ε / 2) := by
    rw [← Real.rpow_mul_natCast hx0.le]
    congr 1
    ring
  have hmainSq : main ^ 2 = K * (J₀ + 1) * x ^ (3 * ε / 2) * G ^ 2 * S := by
    dsimp only [main]
    rw [mul_pow, mul_pow, mul_pow, Real.sq_sqrt hKJ, Real.sq_sqrt hS, hmainPow]
  have herrPow : (x ^ (-B - 50)) ^ (2 : ℕ) = x ^ (-2 * B - 100) := by
    rw [← Real.rpow_mul_natCast hx0.le]
    congr 1
    ring
  have herrSq : err ^ 2 = K * x ^ (-2 * B - 100) := by
    dsimp only [err]
    rw [mul_pow, Real.sq_sqrt hKpos.le, herrPow]
  have hsqrt : Real.sqrt E ≤ main + err := by
    apply Real.sqrt_le_iff.mpr
    refine ⟨add_nonneg hmain herr, ?_⟩
    nlinarith only [hE, hmainSq, herrSq, mul_nonneg hmain herr]
  have hcoeff : Real.sqrt (K * (J₀ + 1)) ≤ x ^ (ε / 4) :=
    (Real.sqrt_le_sqrt hfixed).trans
      (Real.sqrt_le_self_iff.mpr (Or.inr (Real.one_le_rpow hx (by positivity))))
  have hmainBound : K * x ^ (5 * ε / 2) * Δ * main ≤
      K * x ^ (7 * ε / 2) * G * Δ * Real.sqrt S := by
    calc
      _ ≤ K * x ^ (5 * ε / 2) * Δ *
          (x ^ (ε / 4) * x ^ (3 * ε / 4) * G * Real.sqrt S) := by
        dsimp only [main]
        gcongr
      _ = K * (x ^ (5 * ε / 2) * x ^ (ε / 4) * x ^ (3 * ε / 4)) *
          G * Δ * Real.sqrt S := by ring
      _ = _ := by
        have hp : x ^ (5 * ε / 2) * x ^ (ε / 4) * x ^ (3 * ε / 4) =
            x ^ (7 * ε / 2) := by
          rw [← Real.rpow_add hx0, ← Real.rpow_add hx0]
          congr 1
          ring
        rw [hp]
  have hsqrtK : Real.sqrt K ≤ x :=
    (Real.sqrt_le_self_iff.mpr (Or.inr hK)).trans hKx
  have herrBound : K * x ^ (5 * ε / 2) * Δ * err ≤ K * x ^ (-B) := by
    calc
      _ ≤ K * x ^ (5 * ε / 2) * x ^ (2 : ℕ) * (x * x ^ (-B - 50)) := by
        dsimp only [err]
        gcongr
      _ = K * (x ^ (5 * ε / 2) * x ^ (3 : ℕ) * x ^ (-B - 50)) := by ring
      _ = K * x ^ (5 * ε / 2 + 3 - B - 50) := by
        have hp : x ^ (5 * ε / 2) * x ^ (3 : ℕ) * x ^ (-B - 50) =
            x ^ (5 * ε / 2 + 3 - B - 50) := by
          rw [← Real.rpow_natCast, ← Real.rpow_add hx0, ← Real.rpow_add hx0]
          congr 1
          ring
        rw [hp]
      _ ≤ K * x ^ (-B) :=
        mul_le_mul_of_nonneg_left
          (Real.rpow_le_rpow_of_exponent_le hx (by linarith only [hεbound])) hKpos.le
  calc
    K * x ^ (5 * ε / 2) * Δ * Real.sqrt E ≤
        K * x ^ (5 * ε / 2) * Δ * (main + err) :=
      mul_le_mul_of_nonneg_left hsqrt (by positivity)
    _ = K * x ^ (5 * ε / 2) * Δ * main + K * x ^ (5 * ε / 2) * Δ * err := by ring
    _ ≤ _ := add_le_add hmainBound herrBound

theorem sourceSigmaOne_modulus_resources :
    ∀ (x δ ε C R₀ Q U V H Δ : ℝ),
    1 ≤ x → 1 ≤ C → 0 ≤ δ → 0 ≤ ε →
    0 < R₀ → 0 < Q → 0 < U → 0 < V → 0 < H → 0 < Δ →
    ∀ (r₁ q₀ u v₁ v₂ q₂ : ℕ),
    0 < r₁ → 0 < q₀ → 0 < u → 0 < v₁ → 0 < v₂ → 0 < q₂ →
    R₀ / C ≤ (r₁ : ℝ) * Δ → (r₁ : ℝ) * Δ ≤ C * R₀ →
    U / C ≤ (u : ℝ) → (u : ℝ) ≤ C * U →
    V / C ≤ (v₁ : ℝ) → (v₁ : ℝ) ≤ C * V →
    V / C ≤ (v₂ : ℝ) → (v₂ : ℝ) ≤ C * V →
    Q / (C * (q₀ : ℝ)) ≤ (q₂ : ℝ) → (q₂ : ℝ) ≤ C * Q / (q₀ : ℝ) →
    Q / (q₀ : ℝ) ≤ C * U * V → U * V ≤ C * Q / (q₀ : ℝ) →
    x ^ (5 * ε) * H / (q₀ : ℝ) ≤ C * V →
    V ≤ C * x ^ (δ + 5 * ε) * H →
    let g : ℕ := Nat.gcd v₁ v₂
    let κ : ℝ := max 1 (x ^ (5 * ε) * H / V)
    let Δ₁ : ℝ := x ^ (-5 * ε) * Δ
    let m : ℕ := r₁ * q₀ * u * Nat.lcm v₁ v₂ * q₂
    0 < g ∧ 1 ≤ κ ∧ κ ≤ C * (q₀ : ℝ) ∧ 0 < Δ₁ ∧
      (1 / C ^ 6) * (R₀ * Q ^ 2 * H) /
          ((q₀ : ℝ) * (g : ℝ) * κ * Δ₁) ≤ (m : ℝ) ∧
      (m : ℝ) ≤ C ^ 7 * x ^ δ * R₀ * Q ^ 2 * H /
          ((q₀ : ℝ) * (g : ℝ) * Δ₁) := by
  intro x δ ε C R₀ Q U V H Δ hx hC _ _ hR₀ hQ hU hV _ hΔ
    r₁ q₀ u v₁ v₂ q₂ hr₁Nat hq₀Nat huNat hv₁Nat hv₂Nat hq₂Nat
    hrlo hrhi hulo huhi hv₁lo hv₁hi hv₂lo hv₂hi hq₂lo hq₂hi
    hUVlo hUVhi hVlo hVhi
  dsimp only
  let g : ℕ := Nat.gcd v₁ v₂
  let κ : ℝ := max 1 (x ^ (5 * ε) * H / V)
  let Δ₁ : ℝ := x ^ (-5 * ε) * Δ
  let m : ℕ := r₁ * q₀ * u * Nat.lcm v₁ v₂ * q₂
  change 0 < g ∧ 1 ≤ κ ∧ κ ≤ C * (q₀ : ℝ) ∧ 0 < Δ₁ ∧
    (1 / C ^ 6) * (R₀ * Q ^ 2 * H) /
        ((q₀ : ℝ) * (g : ℝ) * κ * Δ₁) ≤ (m : ℝ) ∧
    (m : ℝ) ≤ C ^ 7 * x ^ δ * R₀ * Q ^ 2 * H /
        ((q₀ : ℝ) * (g : ℝ) * Δ₁)
  have hxpos : 0 < x := lt_of_lt_of_le zero_lt_one hx
  have hCpos : 0 < C := lt_of_lt_of_le zero_lt_one hC
  have hr₁ : 0 < (r₁ : ℝ) := by exact_mod_cast hr₁Nat
  have hq₀ : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀Nat
  have hu : 0 < (u : ℝ) := by exact_mod_cast huNat
  have hv₁ : 0 < (v₁ : ℝ) := by exact_mod_cast hv₁Nat
  have hv₂ : 0 < (v₂ : ℝ) := by exact_mod_cast hv₂Nat
  have hq₂ : 0 < (q₂ : ℝ) := by exact_mod_cast hq₂Nat
  have hgNat : 0 < g := Nat.gcd_pos_of_pos_left v₂ hv₁Nat
  have hg : 0 < (g : ℝ) := by exact_mod_cast hgNat
  have hq₀one : (1 : ℝ) ≤ q₀ := by exact_mod_cast Nat.succ_le_of_lt hq₀Nat
  have hκone : 1 ≤ κ := le_max_left _ _
  have hκ : 0 < κ := lt_of_lt_of_le zero_lt_one hκone
  have hκupper : κ ≤ C * (q₀ : ℝ) := by
    apply max_le
    · calc
        (1 : ℝ) = 1 * 1 := by ring
        _ ≤ C * (q₀ : ℝ) := mul_le_mul hC hq₀one zero_le_one hCpos.le
    · apply (div_le_iff₀ hV).2
      have h := (div_le_iff₀ hq₀).1 hVlo
      simpa only [mul_assoc, mul_comm, mul_left_comm] using h
  have hΔ₁ : 0 < Δ₁ := mul_pos (Real.rpow_pos_of_pos hxpos _) hΔ
  have hX : 0 < x ^ (5 * ε) := Real.rpow_pos_of_pos hxpos _
  have hscale : x ^ (5 * ε) * Δ₁ = Δ := by
    dsimp only [Δ₁]
    rw [← mul_assoc, ← Real.rpow_add hxpos,
      show 5 * ε + -5 * ε = 0 by ring, Real.rpow_zero, one_mul]
  have hVκ : x ^ (5 * ε) * H ≤ κ * V :=
    (div_le_iff₀ hV).1 (le_max_right _ _)
  have hVpower : V ≤ C * x ^ δ * x ^ (5 * ε) * H := by
    simpa only [Real.rpow_add hxpos, mul_assoc] using hVhi
  have hlcm : (Nat.lcm v₁ v₂ : ℝ) * (g : ℝ) = (v₁ : ℝ) * (v₂ : ℝ) := by
    dsimp only [g]
    exact_mod_cast Nat.lcm_mul_gcd v₁ v₂
  have hmg : (m : ℝ) * (g : ℝ) * Δ =
      ((r₁ : ℝ) * Δ) * (u : ℝ) * (v₁ : ℝ) * (v₂ : ℝ) *
        ((q₀ : ℝ) * (q₂ : ℝ)) := by
    simp only [m, Nat.cast_mul]
    calc
      (r₁ : ℝ) * (q₀ : ℝ) * (u : ℝ) * (Nat.lcm v₁ v₂ : ℝ) *
          (q₂ : ℝ) * (g : ℝ) * Δ =
          ((r₁ : ℝ) * Δ) * (u : ℝ) *
            ((Nat.lcm v₁ v₂ : ℝ) * (g : ℝ)) * ((q₀ : ℝ) * (q₂ : ℝ)) := by
        ring
      _ = ((r₁ : ℝ) * Δ) * (u : ℝ) * (v₁ : ℝ) * (v₂ : ℝ) *
          ((q₀ : ℝ) * (q₂ : ℝ)) := by rw [hlcm]; ring
  have hrLower : R₀ ≤ C * ((r₁ : ℝ) * Δ) := by
    simpa only [mul_comm] using (div_le_iff₀ hCpos).1 hrlo
  have huLower : U ≤ C * (u : ℝ) := by
    simpa only [mul_comm] using (div_le_iff₀ hCpos).1 hulo
  have hv₁Lower : V ≤ C * (v₁ : ℝ) := by
    simpa only [mul_comm] using (div_le_iff₀ hCpos).1 hv₁lo
  have hv₂Lower : V ≤ C * (v₂ : ℝ) := by
    simpa only [mul_comm] using (div_le_iff₀ hCpos).1 hv₂lo
  have hq₂Lower : Q ≤ C * ((q₀ : ℝ) * (q₂ : ℝ)) := by
    simpa only [mul_assoc, mul_comm, mul_left_comm] using
      (div_le_iff₀ (mul_pos hCpos hq₀)).1 hq₂lo
  have hq₂Upper : (q₀ : ℝ) * (q₂ : ℝ) ≤ C * Q := by
    simpa only [mul_comm] using (le_div_iff₀ hq₀).1 hq₂hi
  have hproductLower : R₀ * U * V * V * Q ≤ C ^ 5 * ((m : ℝ) * (g : ℝ) * Δ) := by
    calc
      R₀ * U * V * V * Q ≤
          (C * ((r₁ : ℝ) * Δ)) * (C * (u : ℝ)) *
            (C * (v₁ : ℝ)) * (C * (v₂ : ℝ)) *
              (C * ((q₀ : ℝ) * (q₂ : ℝ))) := by
        exact mul_le_mul
          (mul_le_mul
            (mul_le_mul
              (mul_le_mul hrLower huLower hU.le (by positivity))
              hv₁Lower hV.le (by positivity))
            hv₂Lower hV.le (by positivity))
          hq₂Lower hQ.le (by positivity)
      _ = C ^ 5 * ((m : ℝ) * (g : ℝ) * Δ) := by rw [hmg]; ring
  have hproductUpper : (m : ℝ) * (g : ℝ) * Δ ≤ C ^ 5 * (R₀ * U * V * V * Q) := by
    rw [hmg]
    calc
      ((r₁ : ℝ) * Δ) * (u : ℝ) * (v₁ : ℝ) * (v₂ : ℝ) *
          ((q₀ : ℝ) * (q₂ : ℝ)) ≤
          (C * R₀) * (C * U) * (C * V) * (C * V) * (C * Q) := by
        exact mul_le_mul
          (mul_le_mul
            (mul_le_mul
              (mul_le_mul hrhi huhi hu.le (by positivity))
              hv₁hi hv₁.le (by positivity))
            hv₂hi hv₂.le (by positivity))
          hq₂Upper (mul_pos hq₀ hq₂).le (by positivity)
      _ = C ^ 5 * (R₀ * U * V * V * Q) := by ring
  have hbaseLower : R₀ * Q ^ 2 * V ≤
      C ^ 6 * (q₀ : ℝ) * (m : ℝ) * (g : ℝ) * Δ := by
    calc
      R₀ * Q ^ 2 * V = (R₀ * Q * V) * Q := by ring
      _ ≤ (R₀ * Q * V) * ((C * U * V) * (q₀ : ℝ)) :=
        mul_le_mul_of_nonneg_left ((div_le_iff₀ hq₀).1 hUVlo) (by positivity)
      _ = (C * (q₀ : ℝ)) * (R₀ * U * V * V * Q) := by ring
      _ ≤ (C * (q₀ : ℝ)) * (C ^ 5 * ((m : ℝ) * (g : ℝ) * Δ)) :=
        mul_le_mul_of_nonneg_left hproductLower (mul_pos hCpos hq₀).le
      _ = C ^ 6 * (q₀ : ℝ) * (m : ℝ) * (g : ℝ) * Δ := by ring
  have hbaseUpper : (m : ℝ) * (g : ℝ) * Δ * (q₀ : ℝ) ≤
      C ^ 6 * R₀ * Q ^ 2 * V := by
    calc
      (m : ℝ) * (g : ℝ) * Δ * (q₀ : ℝ) ≤
          (C ^ 5 * (R₀ * U * V * V * Q)) * (q₀ : ℝ) :=
        mul_le_mul_of_nonneg_right hproductUpper hq₀.le
      _ = (C ^ 5 * R₀ * V * Q) * ((U * V) * (q₀ : ℝ)) := by ring
      _ ≤ (C ^ 5 * R₀ * V * Q) * (C * Q) :=
        mul_le_mul_of_nonneg_left ((le_div_iff₀ hq₀).1 hUVhi) (by positivity)
      _ = C ^ 6 * R₀ * Q ^ 2 * V := by ring
  have hLower : R₀ * Q ^ 2 * H ≤
      C ^ 6 * ((q₀ : ℝ) * (g : ℝ) * κ * Δ₁) * (m : ℝ) := by
    apply (mul_le_mul_iff_of_pos_left hX).1
    calc
      x ^ (5 * ε) * (R₀ * Q ^ 2 * H) =
          (R₀ * Q ^ 2) * (x ^ (5 * ε) * H) := by ring
      _ ≤ (R₀ * Q ^ 2) * (κ * V) :=
        mul_le_mul_of_nonneg_left hVκ (by positivity)
      _ = κ * (R₀ * Q ^ 2 * V) := by ring
      _ ≤ κ * (C ^ 6 * (q₀ : ℝ) * (m : ℝ) * (g : ℝ) * Δ) :=
        mul_le_mul_of_nonneg_left hbaseLower hκ.le
      _ = x ^ (5 * ε) *
          (C ^ 6 * ((q₀ : ℝ) * (g : ℝ) * κ * Δ₁) * (m : ℝ)) := by
        rw [← hscale]
        ring
  have hUpper : (m : ℝ) * ((q₀ : ℝ) * (g : ℝ) * Δ₁) ≤
      C ^ 7 * x ^ δ * R₀ * Q ^ 2 * H := by
    apply (mul_le_mul_iff_of_pos_left hX).1
    calc
      x ^ (5 * ε) * ((m : ℝ) * ((q₀ : ℝ) * (g : ℝ) * Δ₁)) =
          (m : ℝ) * (g : ℝ) * Δ * (q₀ : ℝ) := by
        rw [← hscale]
        ring
      _ ≤ C ^ 6 * R₀ * Q ^ 2 * V := hbaseUpper
      _ ≤ (C ^ 6 * R₀ * Q ^ 2) * (C * x ^ δ * x ^ (5 * ε) * H) :=
        mul_le_mul_of_nonneg_left hVpower (by positivity)
      _ = x ^ (5 * ε) * (C ^ 7 * x ^ δ * R₀ * Q ^ 2 * H) := by ring
  refine ⟨hgNat, hκone, hκupper, hΔ₁, ?_, ?_⟩
  · apply (div_le_iff₀ (by positivity :
        0 < (q₀ : ℝ) * (g : ℝ) * κ * Δ₁)).2
    rw [one_div, inv_mul_eq_div]
    apply (div_le_iff₀ (pow_pos hCpos 6)).2
    simpa only [mul_assoc, mul_comm, mul_left_comm] using hLower
  · exact (le_div_iff₀ (by positivity :
        0 < (q₀ : ℝ) * (g : ℝ) * Δ₁)).2 hUpper

theorem sourceSigmaOne_divisor_target_resources :
    ∀ (C «ω» δ ε : ℝ), 1 ≤ C → 0 < «ω» → 0 < δ → 0 < ε →
    72 * «ω» + 24 * δ < 1 → ε < δ / 10 ^ 100 →
    ∃ X₀ : ℝ, Real.exp 1 ≤ X₀ ∧
      ∀ (x : ℝ), X₀ ≤ x → ∀ (q₀ : ℕ), 0 < q₀ →
      ∀ (M N R₀ Q H γ : ℝ),
      0 < M → 0 < N → 0 < R₀ → 0 < Q → 1 ≤ H →
      N = x ^ γ →
      1 / 4 + 12 * «ω» + 4 * δ + 100 * ε ≤ γ →
      γ ≤ 1 / 2 - 4 * «ω» - 2 * δ - 50 * ε →
      x / C ≤ M * N → N ≤ C * x ^ (δ + 4 * ε) * R₀ →
      R₀ * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) →
      H = x ^ ε * R₀ * Q ^ 2 / ((q₀ : ℝ) * M) →
      let Dtarget : ℝ := N / (x ^ (50 * ε) * H ^ 2)
      H ≤ C ^ 4 * x ^ (4 * «ω» + δ + 7 * ε) / (q₀ : ℝ) ∧
        1 ≤ N ∧ N ≤ x ∧ 0 < Dtarget ∧ 1 ≤ Dtarget ∧ Dtarget ≤ N ∧
        1 ≤ x ^ δ ∧
        ∀ (r : ℕ), R₀ / C ≤ (r : ℝ) → Dtarget ≤ x ^ δ * (r : ℝ) := by
  intro C «ω» δ ε hC hω hδ hε _ _
  obtain ⟨X₁, hX₁⟩ := Filter.eventually_atTop.1
    ((_root_.tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 4)).eventually_ge_atTop
      (C ^ 8))
  obtain ⟨X₂, hX₂⟩ := Filter.eventually_atTop.1
    ((_root_.tendsto_rpow_atTop (by positivity : 0 < 46 * ε)).eventually_ge_atTop
      (C ^ 2))
  refine ⟨max (Real.exp 1) (max X₁ X₂), le_max_left _ _, ?_⟩
  intro x hxX q₀ hq₀Nat M N R₀ Q H γ hM hN hR₀ hQ hH hNγ
    hγlo hγhi hMNlo hNR hRQ hHdef
  dsimp only
  let Dtarget : ℝ := N / (x ^ (50 * ε) * H ^ 2)
  change H ≤ C ^ 4 * x ^ (4 * «ω» + δ + 7 * ε) / (q₀ : ℝ) ∧
    1 ≤ N ∧ N ≤ x ∧ 0 < Dtarget ∧ 1 ≤ Dtarget ∧ Dtarget ≤ N ∧
    1 ≤ x ^ δ ∧
    ∀ (r : ℕ), R₀ / C ≤ (r : ℝ) → Dtarget ≤ x ^ δ * (r : ℝ)
  have hxe : Real.exp 1 ≤ x := (le_max_left _ _).trans hxX
  have hx : 1 ≤ x := (Real.one_le_exp (by norm_num : (0 : ℝ) ≤ 1)).trans hxe
  have hxpos : 0 < x := zero_lt_one.trans_le hx
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hHpos : 0 < H := zero_lt_one.trans_le hH
  have hq₀ : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀Nat
  have hq₀one : (1 : ℝ) ≤ q₀ := by exact_mod_cast Nat.succ_le_of_lt hq₀Nat
  have hpow (a : ℝ) : 0 < x ^ a := Real.rpow_pos_of_pos hxpos a
  have hpowNat (a : ℝ) (n : ℕ) : (x ^ a) ^ n = x ^ (a * (n : ℝ)) :=
    (Real.rpow_mul_natCast hxpos.le a n).symm
  have hCX₈ : C ^ 8 ≤ x ^ (1 / 4 : ℝ) :=
    hX₁ x ((le_max_left _ _).trans ((le_max_right _ _).trans hxX))
  have hCX₂ : C ^ 2 ≤ x ^ (46 * ε) :=
    hX₂ x ((le_max_right _ _).trans ((le_max_right _ _).trans hxX))
  have hNlower : 1 ≤ N := by
    rw [hNγ]
    exact Real.one_le_rpow hx (by linarith only [hγlo, hω, hδ, hε])
  have hNupper : N ≤ x := by
    rw [hNγ]
    simpa only [Real.rpow_one] using
      Real.rpow_le_rpow_of_exponent_le hx
        (show γ ≤ 1 by linarith only [hγhi, hω, hδ, hε])
  have hHproduct : H * ((q₀ : ℝ) * M) = x ^ ε * R₀ * Q ^ 2 :=
    (eq_div_iff (mul_ne_zero hq₀.ne' hM.ne')).1 hHdef
  have hRQsq : (R₀ * Q) ^ 2 ≤ (C * x ^ (1 / 2 + 2 * «ω» + ε)) ^ 2 :=
    (sq_le_sq₀ (mul_pos hR₀ hQ).le
      (mul_pos hCpos (hpow (1 / 2 + 2 * «ω» + ε))).le).2 hRQ
  have hHX : H * (q₀ : ℝ) * x ≤ C ^ 4 * x ^ (4 * «ω» + δ + 7 * ε) * x := by
    calc
      H * (q₀ : ℝ) * x ≤ H * (q₀ : ℝ) * (C * (M * N)) :=
        mul_le_mul_of_nonneg_left ((div_le_iff₀' hCpos).1 hMNlo)
          (mul_pos hHpos hq₀).le
      _ = C * x ^ ε * (R₀ * Q ^ 2) * N := by
        calc
          _ = C * (H * ((q₀ : ℝ) * M)) * N := by ring
          _ = _ := by rw [hHproduct]; ring
      _ ≤ C * x ^ ε * (R₀ * Q ^ 2) * (C * x ^ (δ + 4 * ε) * R₀) :=
        mul_le_mul_of_nonneg_left hNR (by positivity)
      _ = C ^ 2 * x ^ ε * x ^ (δ + 4 * ε) * (R₀ * Q) ^ 2 := by ring
      _ ≤ C ^ 2 * x ^ ε * x ^ (δ + 4 * ε) *
          (C * x ^ (1 / 2 + 2 * «ω» + ε)) ^ 2 :=
        mul_le_mul_of_nonneg_left hRQsq (by positivity)
      _ = C ^ 4 * (x ^ ε * x ^ (δ + 4 * ε) *
          x ^ ((1 / 2 + 2 * «ω» + ε) * 2)) := by
        rw [mul_pow, hpowNat]
        ring_nf
      _ = C ^ 4 * x ^ (ε + (δ + 4 * ε) + (1 / 2 + 2 * «ω» + ε) * 2) := by
        rw [← Real.rpow_add hxpos ε (δ + 4 * ε),
          ← Real.rpow_add hxpos (ε + (δ + 4 * ε)) ((1 / 2 + 2 * «ω» + ε) * 2)]
      _ = C ^ 4 * x ^ ((4 * «ω» + δ + 7 * ε) + 1) := by
        rw [show ε + (δ + 4 * ε) + (1 / 2 + 2 * «ω» + ε) * 2 =
          (4 * «ω» + δ + 7 * ε) + 1 by ring]
      _ = C ^ 4 * x ^ (4 * «ω» + δ + 7 * ε) * x := by
        rw [Real.rpow_add hxpos (4 * «ω» + δ + 7 * ε) 1, Real.rpow_one]
        ring
  have hHbound : H ≤ C ^ 4 * x ^ (4 * «ω» + δ + 7 * ε) / (q₀ : ℝ) := by
    apply (le_div_iff₀ hq₀).2
    exact (mul_le_mul_iff_of_pos_right hxpos).1 hHX
  have hHrough : H ≤ C ^ 4 * x ^ (4 * «ω» + δ + 7 * ε) :=
    hHbound.trans (div_le_self (by positivity) hq₀one)
  have hHsq : H ^ 2 ≤ (C ^ 4 * x ^ (4 * «ω» + δ + 7 * ε)) ^ 2 :=
    (sq_le_sq₀ hHpos.le (by positivity)).2 hHrough
  have hdenUpper : x ^ (50 * ε) * H ^ 2 ≤ C ^ 8 * x ^ (8 * «ω» + 2 * δ + 64 * ε) := by
    calc
      x ^ (50 * ε) * H ^ 2 ≤
          x ^ (50 * ε) * (C ^ 4 * x ^ (4 * «ω» + δ + 7 * ε)) ^ 2 :=
        mul_le_mul_of_nonneg_left hHsq (hpow (50 * ε)).le
      _ = C ^ 8 * (x ^ (50 * ε) * x ^ ((4 * «ω» + δ + 7 * ε) * 2)) := by
        rw [mul_pow, hpowNat]
        ring_nf
      _ = C ^ 8 * x ^ (50 * ε + (4 * «ω» + δ + 7 * ε) * 2) := by
        rw [Real.rpow_add hxpos (50 * ε) ((4 * «ω» + δ + 7 * ε) * 2)]
      _ = C ^ 8 * x ^ (8 * «ω» + 2 * δ + 64 * ε) := by
        rw [show 50 * ε + (4 * «ω» + δ + 7 * ε) * 2 =
          8 * «ω» + 2 * δ + 64 * ε by ring]
  have hdenN : x ^ (50 * ε) * H ^ 2 ≤ N := by
    calc
      x ^ (50 * ε) * H ^ 2 ≤ C ^ 8 * x ^ (8 * «ω» + 2 * δ + 64 * ε) := hdenUpper
      _ ≤ x ^ (1 / 4 : ℝ) * x ^ (8 * «ω» + 2 * δ + 64 * ε) :=
        mul_le_mul_of_nonneg_right hCX₈ (hpow (8 * «ω» + 2 * δ + 64 * ε)).le
      _ = x ^ (1 / 4 + 8 * «ω» + 2 * δ + 64 * ε) := by
        rw [← Real.rpow_add hxpos,
          show (1 / 4 : ℝ) + (8 * «ω» + 2 * δ + 64 * ε) =
            1 / 4 + 8 * «ω» + 2 * δ + 64 * ε by ring]
      _ ≤ x ^ γ := Real.rpow_le_rpow_of_exponent_le hx
        (by linarith only [hγlo, hω, hδ, hε])
      _ = N := hNγ.symm
  have hdenPos : 0 < x ^ (50 * ε) * H ^ 2 :=
    mul_pos (hpow (50 * ε)) (pow_pos hHpos 2)
  have hHsqone : 1 ≤ H ^ 2 := one_le_pow₀ hH
  have hdenOne : 1 ≤ x ^ (50 * ε) * H ^ 2 :=
    one_le_mul_of_one_le_of_one_le
      (Real.one_le_rpow hx (by positivity : 0 ≤ 50 * ε)) hHsqone
  refine ⟨hHbound, hNlower, hNupper, div_pos hN hdenPos,
    (one_le_div hdenPos).2 hdenN, div_le_self hN.le hdenOne,
    Real.one_le_rpow hx hδ.le, ?_⟩
  intro r hr
  have hRr : R₀ ≤ C * (r : ℝ) := (div_le_iff₀' hCpos).1 hr
  have hNtarget : N ≤ (x ^ δ * (r : ℝ)) * x ^ (50 * ε) := by
    calc
      N ≤ C * x ^ (δ + 4 * ε) * R₀ := hNR
      _ ≤ C * x ^ (δ + 4 * ε) * (C * (r : ℝ)) :=
        mul_le_mul_of_nonneg_left hRr (mul_pos hCpos (hpow (δ + 4 * ε))).le
      _ = C ^ 2 * (x ^ (δ + 4 * ε) * (r : ℝ)) := by ring
      _ ≤ x ^ (46 * ε) * (x ^ (δ + 4 * ε) * (r : ℝ)) :=
        mul_le_mul_of_nonneg_right hCX₂ (by positivity)
      _ = (x ^ δ * (r : ℝ)) * x ^ (50 * ε) := by
        rw [← mul_assoc, ← Real.rpow_add hxpos (46 * ε) (δ + 4 * ε),
          show 46 * ε + (δ + 4 * ε) = δ + 50 * ε by ring,
          Real.rpow_add hxpos δ (50 * ε)]
        ring
  apply (div_le_iff₀ hdenPos).2
  calc
    N ≤ (x ^ δ * (r : ℝ)) * x ^ (50 * ε) := hNtarget
    _ ≤ ((x ^ δ * (r : ℝ)) * x ^ (50 * ε)) * H ^ 2 :=
      le_mul_of_one_le_right (by positivity) hHsqone
    _ = (x ^ δ * (r : ℝ)) * (x ^ (50 * ε) * H ^ 2) := by ring

theorem sourceSigmaOne_fixed_fiber_bound {ι : Type*}
    (F : Finset (ℕ × ℕ × ℕ)) (D : Finset ℕ)
    (grid : Finset ι) (center : ι → ℝ) (J s : Finset ℤ)
    (Hbound Kv : ℕ) (x ε C Δ Δ₁ N V H cM TM M AM EM AN EN K₂ g₀ : ℝ)
    (ψM wN ψD : ℝ → ℝ) (r₁ q₀ u q₂ a b₁ b₂ : ℕ) (ℓ : ℤ)
    (hx : Real.exp 1 ≤ x) (_ : 0 < ε) (hC : 1 ≤ C)
    (hΔ : 0 < Δ) (hN : 0 < N) (hV : 0 < V) (_ : 0 < H)
    (hΔ₁ : Δ₁ = x ^ (-5 * ε) * Δ)
    (hr₁ : 0 < r₁) (hq₀ : 0 < q₀) (hu : 0 < u) (hq₂ : 0 < q₂)
    (hcM : 0 < cM) (hcMT : cM ≤ TM) (hM : 0 < M)
    (hAM : 0 ≤ AM) (hAN : 0 ≤ AN) (hEM : 0 ≤ EM) (hEN : 0 ≤ EN)
    (hK₂ : 0 < K₂) (hg₀ : 1 ≤ g₀)
    (hsM : Function.support ψM ⊆ Set.Icc cM TM)
    (hbM : ∀ t : ℝ, |ψM t| ≤ AM * (Real.log x) ^ EM)
    (hsN : ∀ n : ℤ, n ∉ s → wN (n : ℝ) = 0)
    (hmass : (∑ n ∈ s, |wN (n : ℝ)|) ≤ AN * N * (Real.log x) ^ EN)
    (hJ : J ⊆ (Finset.Icc (-(Hbound : ℤ)) (Hbound : ℤ)).filter
      (fun h => h ≠ 0))
    (hsD : Function.support ψD ⊆ Set.Icc (1 / 2 : ℝ) (5 / 2))
    (hDnonneg : ∀ t : ℝ, 0 ≤ ψD t)
    (hDmajor : ∀ t ∈ Set.Icc (1 : ℝ) 2, 1 ≤ ψD t)
    (hcenter : ∀ i ∈ grid, 0 ≤ center i)
    (hcover : ∀ d ∈ D, ∃ i ∈ grid,
      Δ₁ ≤ (d : ℝ) - center i ∧ (d : ℝ) - center i ≤ 2 * Δ₁)
    (hF : ∀ p ∈ F,
      p.1 ∈ D ∧ p.2.1 ∈ Finset.Icc 1 Kv ∧ p.2.2 ∈ Finset.Icc 1 Kv ∧
      V / C ≤ ((max p.2.1 p.2.2 : ℕ) : ℝ) ∧
      Squarefree ((p.1 * r₁) * q₀ * u * p.2.1 * q₂) ∧
      Squarefree ((p.1 * r₁) * q₀ * u * p.2.2 * q₂) ∧
      Nat.Coprime ((p.1 * r₁) * q₀ * u * p.2.1 * p.2.2 * q₂)
        (a * b₁ * b₂))
    (hDcard : (D.card : ℝ) ≤ 2 * Δ)
    (hgrid : (grid.card : ℝ) ≤ 3 * x ^ (5 * ε))
    (hHbound : (Hbound : ℝ) ≤ 2 * C * H)
    (hKv : (Kv : ℝ) ≤ C * V)
    (hlogKv : 1 + Real.log (Kv : ℝ) ≤ 16 * Real.log x)
    (hHV : H / V ≤ C * (q₀ : ℝ) * x ^ (-5 * ε))
    (hSigmaTwo : ∀ v ∈ F.image Prod.snd, ∀ i ∈ grid,
      sourceSigmaTwo J ψM wN ψD M Δ₁ (center i)
        r₁ q₀ u v.1 v.2 q₂ a b₁ b₂ ℓ ≤
          K₂ * (q₀ : ℝ) * g₀ * Δ * N * (Nat.gcd v.1 v.2 : ℝ) *
            x ^ (-10 * ε)) :
    (∑ p ∈ F, ‖sourceDispersionFrequencyBlock (J ×ˢ J) ψM wN M
      (p.1 * r₁) q₀ u p.2.1 p.2.2 q₂ a b₁ b₂ ℓ‖) ≤
      (128 * C ^ 5 * (TM * AM) ^ 2 * AN + 48 * K₂ * C ^ 2) *
        (q₀ : ℝ) * g₀ * Δ * N * V ^ 2 * x ^ (-5 * ε) *
          (Real.log x) ^ (2 * EM + EN + 1) := by
  classical
  have hGcdAverage (K : ℕ) :
      (∑ v₁ ∈ Finset.Icc 1 K, ∑ v₂ ∈ Finset.Icc 1 K,
        (Nat.gcd v₁ v₂ : ℝ)) ≤ (K : ℝ) ^ 2 * (1 + Real.log (K : ℝ)) := by
    clear * -
    calc
      _ ≤ ∑ v₁ ∈ Finset.Icc 1 K, (K : ℝ) * (v₁.divisors.card : ℝ) :=
        Finset.sum_le_sum fun v hv =>
          (reciprocal_differencing_gcd_sums v K (Finset.mem_Icc.mp hv).1).1
      _ = (K : ℝ) * ∑ v₁ ∈ Finset.Icc 1 K, (v₁.divisors.card : ℝ) :=
        (Finset.mul_sum _ _ _).symm
      _ ≤ (K : ℝ) * ((K : ℝ) * (1 + Real.log (K : ℝ))) := by
        apply mul_le_mul_of_nonneg_left _ (Nat.cast_nonneg K)
        simpa using sum_card_divisors_pow_le_mul_log_pow 1 K
      _ = _ := by ring
  clear * - hGcdAverage hx hC hΔ hN hV hΔ₁ hr₁ hq₀ hu hq₂ hcM hcMT hM
    hAM hAN hEM hEN hK₂ hg₀ hsM hbM hsN hmass hJ hsD hDnonneg hDmajor hcenter
    hcover hF hDcard hgrid hHbound hKv hlogKv hHV hSigmaTwo
  let L := Real.log x
  let E := 2 * EM + EN + 1
  let W := ∑ n ∈ s, |wN (n : ℝ)|
  let S := F.image Prod.snd
  let Z := K₂ * (q₀ : ℝ) * g₀ * Δ * N * x ^ (-10 * ε)
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
  have hL : 1 ≤ L := (Real.le_log_iff_exp_le hxpos).2 hx
  have hLpos : 0 < L := zero_lt_one.trans_le hL
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hg : 0 < g₀ := zero_lt_one.trans_le hg₀
  have hΔ₁pos : 0 < Δ₁ := by
    rw [hΔ₁]
    exact mul_pos (Real.rpow_pos_of_pos hxpos _) hΔ
  have hW : 0 ≤ W := Finset.sum_nonneg fun _ _ => abs_nonneg _
  have hZ : 0 ≤ Z := by dsimp [Z]; positivity
  have hlogK : 0 ≤ 1 + Real.log (Kv : ℝ) := by
    by_cases hzero : Kv = 0
    · simp [hzero]
    · have hpositive : (1 : ℝ) ≤ Kv := by
        exact_mod_cast Nat.one_le_iff_ne_zero.mpr hzero
      linarith [Real.log_nonneg hpositive]
  have hKvSquared : (Kv : ℝ) ^ 2 ≤ (C * V) ^ 2 :=
    pow_le_pow_left₀ (Nat.cast_nonneg _) hKv 2
  have hfrequency : 2 * (Hbound : ℝ) / (V / C) ≤
      4 * C ^ 3 * (q₀ : ℝ) * x ^ (-5 * ε) := by
    calc
      2 * (Hbound : ℝ) / (V / C) = 2 * C * (Hbound : ℝ) / V := by
        field_simp [ne_of_gt hV, ne_of_gt hCpos]
      _ ≤ 2 * C * (2 * C * H) / V :=
        div_le_div_of_nonneg_right
          (mul_le_mul_of_nonneg_left hHbound (by positivity)) hV.le
      _ = 4 * C ^ 2 * (H / V) := by ring
      _ ≤ 4 * C ^ 2 * (C * (q₀ : ℝ) * x ^ (-5 * ε)) :=
        mul_le_mul_of_nonneg_left hHV (by positivity)
      _ = 4 * C ^ 3 * (q₀ : ℝ) * x ^ (-5 * ε) := by ring
  have hlogPowers : (L ^ EM) ^ 2 * L ^ EN * L = L ^ E := by
    have htwo : L ^ (2 * EM) = (L ^ EM) ^ 2 := by
      simpa only [Nat.cast_ofNat, mul_comm] using
        Real.rpow_mul_natCast hLpos.le EM 2
    dsimp only [E]
    rw [Real.rpow_add hLpos, Real.rpow_add hLpos, Real.rpow_one, htwo]
  have hlogEnlarge : L ≤ L ^ E := by
    calc
      L = L ^ (1 : ℝ) := (Real.rpow_one L).symm
      _ ≤ L ^ E := Real.rpow_le_rpow_of_exponent_le hL (by dsimp [E]; linarith)
  have hxPowers : x ^ (5 * ε) * x ^ (-10 * ε) = x ^ (-5 * ε) := by
    rw [← Real.rpow_add hxpos]
    congr 1
    ring
  have hbase := (sourceSelectedBlock_le_diagonal_add_sigmaTwo F D grid center J s
    Hbound Kv (V / C) cM TM M (AM * L ^ EM) Δ₁ (1 / 2) (5 / 2)
    ψM wN ψD r₁ q₀ u q₂ a b₁ b₂ ℓ hr₁ hq₀ hu hq₂
    (div_pos hV hCpos) hcM hcMT hM (by positivity) hsM hbM hsN hJ
    hΔ₁pos (by norm_num) (by norm_num) hsD hDnonneg hDmajor hcenter hcover hF).2
  have hdiagonal :
      (D.card : ℝ) * (TM * (AM * L ^ EM)) ^ 2 * W *
        (2 * (Hbound : ℝ) / (V / C)) * (Kv : ℝ) ^ 2 *
          (1 + Real.log (Kv : ℝ)) ≤
      128 * C ^ 5 * (TM * AM) ^ 2 * AN * (q₀ : ℝ) * g₀ * Δ * N *
        V ^ 2 * x ^ (-5 * ε) * L ^ E := by
    calc
      (D.card : ℝ) * (TM * (AM * L ^ EM)) ^ 2 * W *
          (2 * (Hbound : ℝ) / (V / C)) * (Kv : ℝ) ^ 2 *
            (1 + Real.log (Kv : ℝ)) ≤
          (2 * Δ) * (TM * (AM * L ^ EM)) ^ 2 * (AN * N * L ^ EN) *
            (4 * C ^ 3 * (q₀ : ℝ) * x ^ (-5 * ε)) * (C * V) ^ 2 * (16 * L) := by
        rel [hDcard, hmass, hfrequency, hKvSquared, hlogKv]
      _ = 128 * C ^ 5 * (TM * AM) ^ 2 * AN * (q₀ : ℝ) * Δ * N *
          V ^ 2 * x ^ (-5 * ε) * L ^ E := by
        rw [← hlogPowers]
        ring
      _ ≤ (128 * C ^ 5 * (TM * AM) ^ 2 * AN * (q₀ : ℝ) * Δ * N *
          V ^ 2 * x ^ (-5 * ε) * L ^ E) * g₀ :=
        le_mul_of_one_le_right (by positivity) hg₀
      _ = 128 * C ^ 5 * (TM * AM) ^ 2 * AN * (q₀ : ℝ) * g₀ * Δ * N *
          V ^ 2 * x ^ (-5 * ε) * L ^ E := by ring
  have hsubset : S ⊆ Finset.Icc 1 Kv ×ˢ Finset.Icc 1 Kv := by
    intro v hv
    obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hv
    exact Finset.mem_product.mpr ⟨(hF p hp).2.1, (hF p hp).2.2.1⟩
  have hsumGcd : (∑ v ∈ S, (Nat.gcd v.1 v.2 : ℝ)) ≤
      16 * C ^ 2 * V ^ 2 * L := by
    calc
      (∑ v ∈ S, (Nat.gcd v.1 v.2 : ℝ)) ≤
          ∑ v ∈ Finset.Icc 1 Kv ×ˢ Finset.Icc 1 Kv, (Nat.gcd v.1 v.2 : ℝ) :=
        Finset.sum_le_sum_of_subset_of_nonneg hsubset (fun _ _ _ => Nat.cast_nonneg _)
      _ = ∑ v₁ ∈ Finset.Icc 1 Kv, ∑ v₂ ∈ Finset.Icc 1 Kv,
          (Nat.gcd v₁ v₂ : ℝ) :=
        Finset.sum_product (Finset.Icc 1 Kv) (Finset.Icc 1 Kv)
          (fun v : ℕ × ℕ => (Nat.gcd v.1 v.2 : ℝ))
      _ ≤ (Kv : ℝ) ^ 2 * (1 + Real.log (Kv : ℝ)) := hGcdAverage Kv
      _ ≤ (C * V) ^ 2 * (16 * L) :=
        mul_le_mul hKvSquared hlogKv hlogK (sq_nonneg _)
      _ = 16 * C ^ 2 * V ^ 2 * L := by ring
  have hoffdiagonal :
      (∑ v ∈ S, ∑ i ∈ grid,
        sourceSigmaTwo J ψM wN ψD M Δ₁ (center i)
          r₁ q₀ u v.1 v.2 q₂ a b₁ b₂ ℓ) ≤
      48 * K₂ * C ^ 2 * (q₀ : ℝ) * g₀ * Δ * N * V ^ 2 *
        x ^ (-5 * ε) * L ^ E := by
    calc
      (∑ v ∈ S, ∑ i ∈ grid,
          sourceSigmaTwo J ψM wN ψD M Δ₁ (center i)
            r₁ q₀ u v.1 v.2 q₂ a b₁ b₂ ℓ) ≤
          ∑ v ∈ S, ∑ _i ∈ grid, Z * (Nat.gcd v.1 v.2 : ℝ) := by
        apply Finset.sum_le_sum
        intro v hv
        apply Finset.sum_le_sum
        intro i hi
        exact (hSigmaTwo v hv i hi).trans_eq (by dsimp [Z]; ring)
      _ = (grid.card : ℝ) * Z * ∑ v ∈ S, (Nat.gcd v.1 v.2 : ℝ) := by
        simp only [Finset.sum_const, nsmul_eq_mul, ← Finset.mul_sum]
        ring
      _ ≤ (3 * x ^ (5 * ε)) * Z * (16 * C ^ 2 * V ^ 2 * L) :=
        mul_le_mul (mul_le_mul_of_nonneg_right hgrid hZ) hsumGcd
          (Finset.sum_nonneg fun _ _ => Nat.cast_nonneg _)
          (mul_nonneg (by positivity) hZ)
      _ = 48 * K₂ * C ^ 2 * (q₀ : ℝ) * g₀ * Δ * N * V ^ 2 *
          (x ^ (5 * ε) * x ^ (-10 * ε)) * L := by
        dsimp [Z]
        ring
      _ = 48 * K₂ * C ^ 2 * (q₀ : ℝ) * g₀ * Δ * N * V ^ 2 *
          x ^ (-5 * ε) * L := by rw [hxPowers]
      _ ≤ 48 * K₂ * C ^ 2 * (q₀ : ℝ) * g₀ * Δ * N * V ^ 2 *
          x ^ (-5 * ε) * L ^ E :=
        mul_le_mul_of_nonneg_left hlogEnlarge (by positivity)
  calc
    (∑ p ∈ F, ‖sourceDispersionFrequencyBlock (J ×ˢ J) ψM wN M
        (p.1 * r₁) q₀ u p.2.1 p.2.2 q₂ a b₁ b₂ ℓ‖) ≤
        (D.card : ℝ) * (TM * (AM * L ^ EM)) ^ 2 * W *
          (2 * (Hbound : ℝ) / (V / C)) * (Kv : ℝ) ^ 2 *
            (1 + Real.log (Kv : ℝ)) +
        ∑ v ∈ S, ∑ i ∈ grid,
          sourceSigmaTwo J ψM wN ψD M Δ₁ (center i)
            r₁ q₀ u v.1 v.2 q₂ a b₁ b₂ ℓ := hbase
    _ ≤ 128 * C ^ 5 * (TM * AM) ^ 2 * AN * (q₀ : ℝ) * g₀ * Δ * N *
        V ^ 2 * x ^ (-5 * ε) * L ^ E +
        48 * K₂ * C ^ 2 * (q₀ : ℝ) * g₀ * Δ * N * V ^ 2 *
          x ^ (-5 * ε) * L ^ E := add_le_add hdiagonal hoffdiagonal
    _ = (128 * C ^ 5 * (TM * AM) ^ 2 * AN + 48 * K₂ * C ^ 2) *
        (q₀ : ℝ) * g₀ * Δ * N * V ^ 2 * x ^ (-5 * ε) *
          (Real.log x) ^ (2 * EM + EN + 1) := by
      dsimp only [L, E]
      ring

theorem sourceSigmaOne_total_fiber_bound (T : Finset (ℕ × ℕ × ℕ × ℕ × ℕ)) (d : ℕ → ℕ)
    (C R₀ Q N U V g₀ x ε E A : ℝ) (q₀ : ℕ)
    (hC : 1 ≤ C) (hR : 0 < R₀) (hQ : 0 < Q) (hN : 0 < N)
    (hU : 0 < U) (hV : 0 < V) (hg₀ : 1 ≤ g₀) (hq₀ : 0 < q₀)
    (hx : Real.exp 1 ≤ x) (_ : 0 < ε) (_ : 0 ≤ E) (hA : 0 ≤ A)
    (hT : ∀ t ∈ T,
      0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2.2.2 ∧ 0 < d t.1 ∧ d t.1 ∣ t.1 ∧
      (t.1 : ℝ) ≤ C * R₀ ∧ (t.2.1 : ℝ) ≤ C * U ∧
      (t.2.2.2.2 : ℝ) ≤ C * Q / (q₀ : ℝ) ∧ (d t.1 : ℝ) ≤ x)
    (f : (ℕ × ℕ × ℕ × ℕ × ℕ) → ℝ) :
    let key : (ℕ × ℕ × ℕ × ℕ × ℕ) → ℕ := fun t => Nat.log2 (d t.1)
    let aKey : (ℕ × ℕ × ℕ × ℕ × ℕ) → ℕ × ℕ × ℕ :=
      fun t => (t.1 / d t.1, t.2.1, t.2.2.2.2)
    let value : (ℕ × ℕ × ℕ × ℕ × ℕ) → ℕ × ℕ × ℕ :=
      fun t => (d t.1, t.2.2.1, t.2.2.2.1)
    let reconstruct : (ℕ × ℕ × ℕ) → (ℕ × ℕ × ℕ) →
        ℕ × ℕ × ℕ × ℕ × ℕ :=
      fun a p => (p.1 * a.1, a.2.1, p.2.1, p.2.2, a.2.2)
    let Ks := T.image key
    let As : ℕ → Finset (ℕ × ℕ × ℕ) :=
      fun k => (T.filter fun t => key t = k).image aKey
    let Fs : ℕ → (ℕ × ℕ × ℕ) → Finset (ℕ × ℕ × ℕ) :=
      fun k a => (T.filter fun t => key t = k ∧ aKey t = a).image value
    (∀ k ∈ Ks, ∀ a ∈ As k,
      (∑ p ∈ Fs k a, f (reconstruct a p)) ≤
        A * (q₀ : ℝ) * g₀ * ((2 ^ k : ℕ) : ℝ) * N * V ^ 2 *
          x ^ (-5 * ε) * (Real.log x) ^ E) →
    (∑ t ∈ T, f t) ≤
      C ^ 3 * A * (1 + 1 / Real.log 2) * g₀ * R₀ * Q * N * U * V ^ 2 *
        x ^ (-5 * ε) * (Real.log x) ^ (E + 1) := by
  classical
  have hFinitePartition (T : Finset (ℕ × ℕ × ℕ × ℕ × ℕ)) (d : ℕ → ℕ)
      (hdvd : ∀ t ∈ T, d t.1 ∣ t.1) :
      let key : (ℕ × ℕ × ℕ × ℕ × ℕ) → ℕ := fun t => Nat.log2 (d t.1)
      let aKey : (ℕ × ℕ × ℕ × ℕ × ℕ) → ℕ × ℕ × ℕ :=
        fun t => (t.1 / d t.1, t.2.1, t.2.2.2.2)
      let value : (ℕ × ℕ × ℕ × ℕ × ℕ) → ℕ × ℕ × ℕ :=
        fun t => (d t.1, t.2.2.1, t.2.2.2.1)
      let reconstruct : (ℕ × ℕ × ℕ) → (ℕ × ℕ × ℕ) →
          ℕ × ℕ × ℕ × ℕ × ℕ :=
        fun a p => (p.1 * a.1, a.2.1, p.2.1, p.2.2, a.2.2)
      let Ks := T.image key
      let As : ℕ → Finset (ℕ × ℕ × ℕ) :=
        fun k => (T.filter fun t => key t = k).image aKey
      let Fs : ℕ → (ℕ × ℕ × ℕ) → Finset (ℕ × ℕ × ℕ) :=
        fun k a => (T.filter fun t => key t = k ∧ aKey t = a).image value
      (∀ t ∈ T, reconstruct (aKey t) (value t) = t) ∧
      (∀ k a, Set.InjOn value
        (↑(T.filter fun t => key t = k ∧ aKey t = a) : Set _)) ∧
      (∀ f : (ℕ × ℕ × ℕ × ℕ × ℕ) → ℝ,
        (∑ t ∈ T, f t) =
          ∑ k ∈ Ks, ∑ a ∈ As k, ∑ p ∈ Fs k a, f (reconstruct a p)) := by
    clear * - hdvd
    classical
    let key : (ℕ × ℕ × ℕ × ℕ × ℕ) → ℕ := fun t => Nat.log2 (d t.1)
    let aKey : (ℕ × ℕ × ℕ × ℕ × ℕ) → ℕ × ℕ × ℕ :=
      fun t => (t.1 / d t.1, t.2.1, t.2.2.2.2)
    let value : (ℕ × ℕ × ℕ × ℕ × ℕ) → ℕ × ℕ × ℕ :=
      fun t => (d t.1, t.2.2.1, t.2.2.2.1)
    let reconstruct : (ℕ × ℕ × ℕ) → (ℕ × ℕ × ℕ) →
        ℕ × ℕ × ℕ × ℕ × ℕ :=
      fun a p => (p.1 * a.1, a.2.1, p.2.1, p.2.2, a.2.2)
    let Ks := T.image key
    let As : ℕ → Finset (ℕ × ℕ × ℕ) :=
      fun k => (T.filter fun t => key t = k).image aKey
    let Fs : ℕ → (ℕ × ℕ × ℕ) → Finset (ℕ × ℕ × ℕ) :=
      fun k a => (T.filter fun t => key t = k ∧ aKey t = a).image value
    change (∀ t ∈ T, reconstruct (aKey t) (value t) = t) ∧
      (∀ k a, Set.InjOn value
        (↑(T.filter fun t => key t = k ∧ aKey t = a) : Set _)) ∧
      (∀ f : (ℕ × ℕ × ℕ × ℕ × ℕ) → ℝ,
        (∑ t ∈ T, f t) =
          ∑ k ∈ Ks, ∑ a ∈ As k, ∑ p ∈ Fs k a, f (reconstruct a p))
    have hreconstruct : ∀ t ∈ T, reconstruct (aKey t) (value t) = t := by
      intro t ht
      rcases t with ⟨r, u, v₁, v₂, q₂⟩
      change (d r * (r / d r), u, v₁, v₂, q₂) = (r, u, v₁, v₂, q₂)
      rw [Nat.mul_div_cancel' (hdvd (r, u, v₁, v₂, q₂) ht)]
    have hinjective : ∀ k a, Set.InjOn value
        (↑(T.filter fun t => key t = k ∧ aKey t = a) : Set _) := by
      intro k a s hs t ht hst
      have hs' := Finset.mem_filter.mp hs
      have ht' := Finset.mem_filter.mp ht
      calc
        s = reconstruct a (value s) := by
          simpa only [hs'.2.2] using (hreconstruct s hs'.1).symm
        _ = reconstruct a (value t) := congrArg (reconstruct a) hst
        _ = t := by simpa only [ht'.2.2] using hreconstruct t ht'.1
    refine ⟨hreconstruct, hinjective, ?_⟩
    intro f
    have hinner (k : ℕ) (a : ℕ × ℕ × ℕ) :
        (∑ p ∈ Fs k a, f (reconstruct a p)) =
          ∑ t ∈ T.filter (fun t => key t = k ∧ aKey t = a), f t := by
      change (∑ p ∈ (T.filter fun t => key t = k ∧ aKey t = a).image value,
        f (reconstruct a p)) = _
      rw [Finset.sum_image (hinjective k a)]
      apply Finset.sum_congr rfl
      intro t ht
      have ht' := Finset.mem_filter.mp ht
      apply congrArg f
      simpa only [ht'.2.2] using hreconstruct t ht'.1
    calc
      (∑ t ∈ T, f t) = ∑ k ∈ Ks, ∑ t ∈ T.filter (fun t => key t = k), f t :=
        (Finset.sum_fiberwise_of_maps_to (s := T) (t := Ks) (g := key)
          (fun t ht => Finset.mem_image_of_mem key ht) f).symm
      _ = ∑ k ∈ Ks, ∑ a ∈ As k,
          ∑ t ∈ T.filter (fun t => key t = k ∧ aKey t = a), f t := by
        apply Finset.sum_congr rfl
        intro k _
        symm
        simpa only [Finset.filter_filter] using
          (Finset.sum_fiberwise_of_maps_to
            (s := T.filter fun t => key t = k) (t := As k) (g := aKey)
            (fun t ht => Finset.mem_image_of_mem aKey ht) f)
      _ = ∑ k ∈ Ks, ∑ a ∈ As k, ∑ p ∈ Fs k a, f (reconstruct a p) := by
        apply Finset.sum_congr rfl
        intro k _
        apply Finset.sum_congr rfl
        intro a _
        exact (hinner k a).symm
  have hPositiveTripleCard (A : Finset (ℕ × ℕ × ℕ)) (L₁ L₂ L₃ : ℝ)
      (hL₁ : 0 ≤ L₁) (hL₂ : 0 ≤ L₂) (hL₃ : 0 ≤ L₃)
      (hA : ∀ a ∈ A, 0 < a.1 ∧ 0 < a.2.1 ∧ 0 < a.2.2 ∧
        (a.1 : ℝ) ≤ L₁ ∧ (a.2.1 : ℝ) ≤ L₂ ∧ (a.2.2 : ℝ) ≤ L₃) :
      (A.card : ℝ) ≤ L₁ * L₂ * L₃ := by
    clear * - hL₁ hL₂ hL₃ hA
    have hsubset : A ⊆
        (Finset.Icc 1 ⌊L₁⌋₊) ×ˢ ((Finset.Icc 1 ⌊L₂⌋₊) ×ˢ
          (Finset.Icc 1 ⌊L₃⌋₊)) := by
      intro a ha
      obtain ⟨ha₁, ha₂, ha₃, hb₁, hb₂, hb₃⟩ := hA a ha
      exact Finset.mem_product.mpr
        ⟨Finset.mem_Icc.mpr ⟨ha₁, Nat.le_floor hb₁⟩,
          Finset.mem_product.mpr
            ⟨Finset.mem_Icc.mpr ⟨ha₂, Nat.le_floor hb₂⟩,
              Finset.mem_Icc.mpr ⟨ha₃, Nat.le_floor hb₃⟩⟩⟩
    calc
      (A.card : ℝ) ≤
          (((Finset.Icc 1 ⌊L₁⌋₊) ×ˢ ((Finset.Icc 1 ⌊L₂⌋₊) ×ˢ
            (Finset.Icc 1 ⌊L₃⌋₊))).card : ℝ) := by
        exact_mod_cast Finset.card_le_card hsubset
      _ = (⌊L₁⌋₊ : ℝ) * (⌊L₂⌋₊ : ℝ) * (⌊L₃⌋₊ : ℝ) := by
        simp only [Finset.card_product, Nat.card_Icc, Nat.add_sub_cancel_right,
          Nat.cast_mul, mul_assoc]
      _ ≤ L₁ * L₂ * L₃ :=
        mul_le_mul
          (mul_le_mul (Nat.floor_le hL₁) (Nat.floor_le hL₂)
            (Nat.cast_nonneg _) hL₁)
          (Nat.floor_le hL₃) (Nat.cast_nonneg _) (mul_nonneg hL₁ hL₂)
  have hFiberCard (T : Finset (ℕ × ℕ × ℕ × ℕ × ℕ)) (d : ℕ → ℕ)
      (C R₀ U Q : ℝ) (q₀ : ℕ) (hC : 0 ≤ C) (hR : 0 < R₀)
      (hU : 0 < U) (hQ : 0 < Q) (hq₀ : 0 < q₀)
      (hT : ∀ t ∈ T, 0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2.2.2 ∧
        0 < d t.1 ∧ d t.1 ∣ t.1 ∧ (t.1 : ℝ) ≤ C * R₀ ∧
        (t.2.1 : ℝ) ≤ C * U ∧ (t.2.2.2.2 : ℝ) ≤ C * Q / (q₀ : ℝ))
      (k : ℕ) :
      let Δ : ℝ := (2 ^ k : ℕ)
      let As := (T.filter fun t => Nat.log2 (d t.1) = k).image
        (fun t => (t.1 / d t.1, t.2.1, t.2.2.2.2))
      (As.card : ℝ) ≤ C ^ 3 * R₀ * U * Q / ((q₀ : ℝ) * Δ) := by
    clear * - hPositiveTripleCard hC hR hU hQ hq₀ hT
    let Δ : ℝ := (2 ^ k : ℕ)
    let As := (T.filter fun t => Nat.log2 (d t.1) = k).image
      (fun t => (t.1 / d t.1, t.2.1, t.2.2.2.2))
    change (As.card : ℝ) ≤ C ^ 3 * R₀ * U * Q / ((q₀ : ℝ) * Δ)
    have hΔ : 0 < Δ := by dsimp [Δ]; positivity
    have hq : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀
    have hb : ∀ a ∈ As, 0 < a.1 ∧ 0 < a.2.1 ∧ 0 < a.2.2 ∧
        (a.1 : ℝ) ≤ C * R₀ / Δ ∧ (a.2.1 : ℝ) ≤ C * U ∧
          (a.2.2 : ℝ) ≤ C * Q / (q₀ : ℝ) := by
      intro a ha
      obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp ha
      have ht' := Finset.mem_filter.mp ht
      obtain ⟨hr, hu, hq₂, hd, hdvd, hrbound, hubound, hqbound⟩ := hT t ht'.1
      refine ⟨Nat.div_pos (Nat.le_of_dvd hr hdvd) hd, hu, hq₂, ?_, hubound, hqbound⟩
      have hlower : Δ ≤ (d t.1 : ℝ) := by
        have hn : 2 ^ k ≤ d t.1 := by
          rw [← ht'.2]
          exact Nat.log2_self_le (Nat.ne_of_gt hd)
        change ((2 ^ k : ℕ) : ℝ) ≤ (d t.1 : ℝ)
        exact_mod_cast hn
      apply (le_div_iff₀ hΔ).2
      calc
        (t.1 / d t.1 : ℕ) * Δ ≤ (t.1 / d t.1 : ℕ) * (d t.1 : ℝ) :=
          mul_le_mul_of_nonneg_left hlower (Nat.cast_nonneg _)
        _ = (t.1 : ℝ) := by exact_mod_cast Nat.div_mul_cancel hdvd
        _ ≤ C * R₀ := hrbound
    calc
      (As.card : ℝ) ≤ (C * R₀ / Δ) * (C * U) * (C * Q / (q₀ : ℝ)) :=
        hPositiveTripleCard As (C * R₀ / Δ) (C * U) (C * Q / (q₀ : ℝ))
          (by positivity) (mul_nonneg hC hU.le) (by positivity) hb
      _ = C ^ 3 * R₀ * U * Q / ((q₀ : ℝ) * Δ) := by
        field_simp [ne_of_gt hΔ, ne_of_gt hq]
  have hShellCard (T : Finset (ℕ × ℕ × ℕ × ℕ × ℕ)) (d : ℕ → ℕ)
      (x : ℝ) (hx : 1 ≤ x)
      (hd : ∀ t ∈ T, 0 < d t.1 ∧ (d t.1 : ℝ) ≤ x) :
      ((T.image fun t => Nat.log2 (d t.1)).card : ℝ) ≤
        1 + Real.log x / Real.log 2 := by
    clear * - hx hd
    have hlogtwo : 0 < Real.log 2 := Real.log_pos (by norm_num)
    have hL : 0 ≤ Real.log x / Real.log 2 :=
      div_nonneg (Real.log_nonneg hx) hlogtwo.le
    have hsubset : (T.image fun t => Nat.log2 (d t.1)) ⊆
        Finset.Icc 0 ⌊Real.log x / Real.log 2⌋₊ := by
      intro k hk
      obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hk
      obtain ⟨hdpos, hdle⟩ := hd t ht
      refine Finset.mem_Icc.mpr ⟨Nat.zero_le _, Nat.le_floor ?_⟩
      calc
        (Nat.log2 (d t.1) : ℝ) ≤ Real.logb 2 (d t.1) := Real.log2_le_logb _
        _ ≤ Real.logb 2 x :=
          Real.logb_le_logb_of_le (by norm_num) (by exact_mod_cast hdpos) hdle
        _ = Real.log x / Real.log 2 := rfl
    calc
      ((T.image fun t => Nat.log2 (d t.1)).card : ℝ) ≤
          ((Finset.Icc 0 ⌊Real.log x / Real.log 2⌋₊).card : ℝ) := by
        exact_mod_cast Finset.card_le_card hsubset
      _ = (⌊Real.log x / Real.log 2⌋₊ : ℝ) + 1 := by simp
      _ ≤ 1 + Real.log x / Real.log 2 := by linarith [Nat.floor_le hL]
  clear * - hFinitePartition hFiberCard hShellCard hC hR hQ hN hU hV hg₀ hq₀ hx hA hT
  intro key aKey value reconstruct Ks As Fs hFibers
  let L := Real.log x
  let B := C ^ 3 * A * g₀ * R₀ * Q * N * U * V ^ 2 * x ^ (-5 * ε) * L ^ E
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
  have hxone : 1 ≤ x := (Real.one_lt_exp_iff.mpr zero_lt_one).le.trans hx
  have hL : 1 ≤ L := (Real.le_log_iff_exp_le hxpos).2 hx
  have hLpos : 0 < L := zero_lt_one.trans_le hL
  have hCnonneg : 0 ≤ C := zero_le_one.trans hC
  have hg : 0 < g₀ := zero_lt_one.trans_le hg₀
  have hq : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀
  have hB : 0 ≤ B := by dsimp [B]; positivity
  have hdvd : ∀ t ∈ T, d t.1 ∣ t.1 := by
    intro t ht
    exact (hT t ht).2.2.2.2.1
  have hpartition : (∑ t ∈ T, f t) =
      ∑ k ∈ Ks, ∑ a ∈ As k, ∑ p ∈ Fs k a, f (reconstruct a p) :=
    (hFinitePartition T d hdvd).2.2 f
  have hcardA (k : ℕ) : ((As k).card : ℝ) ≤
      C ^ 3 * R₀ * U * Q / ((q₀ : ℝ) * ((2 ^ k : ℕ) : ℝ)) := by
    refine hFiberCard T d C R₀ U Q q₀ hCnonneg hR hU hQ hq₀ ?_ k
    intro t ht
    obtain ⟨hr, hu, hq₂, hd, hd', hrbound, hubound, hqbound, _⟩ := hT t ht
    exact ⟨hr, hu, hq₂, hd, hd', hrbound, hubound, hqbound⟩
  have hcardK : (Ks.card : ℝ) ≤ 1 + L / Real.log 2 := by
    apply hShellCard T d x hxone
    intro t ht
    obtain ⟨_, _, _, hd, _, _, _, _, hdmax⟩ := hT t ht
    exact ⟨hd, hdmax⟩
  have hsumFiber (k : ℕ) (hk : k ∈ Ks) :
      (∑ a ∈ As k, ∑ p ∈ Fs k a, f (reconstruct a p)) ≤ B := by
    have hΔ : 0 < ((2 ^ k : ℕ) : ℝ) := by positivity
    have hterm : 0 ≤ A * (q₀ : ℝ) * g₀ * ((2 ^ k : ℕ) : ℝ) * N * V ^ 2 *
        x ^ (-5 * ε) * L ^ E := by positivity
    calc
      (∑ a ∈ As k, ∑ p ∈ Fs k a, f (reconstruct a p)) ≤
          ∑ _a ∈ As k,
            A * (q₀ : ℝ) * g₀ * ((2 ^ k : ℕ) : ℝ) * N * V ^ 2 *
              x ^ (-5 * ε) * L ^ E :=
        Finset.sum_le_sum fun a ha => hFibers k hk a ha
      _ = ((As k).card : ℝ) *
          (A * (q₀ : ℝ) * g₀ * ((2 ^ k : ℕ) : ℝ) * N * V ^ 2 *
            x ^ (-5 * ε) * L ^ E) := by
        simp only [Finset.sum_const, nsmul_eq_mul]
      _ ≤ (C ^ 3 * R₀ * U * Q / ((q₀ : ℝ) * ((2 ^ k : ℕ) : ℝ))) *
          (A * (q₀ : ℝ) * g₀ * ((2 ^ k : ℕ) : ℝ) * N * V ^ 2 *
            x ^ (-5 * ε) * L ^ E) :=
        mul_le_mul_of_nonneg_right (hcardA k) hterm
      _ = B := by
        dsimp only [B]
        field_simp [ne_of_gt hq, ne_of_gt hΔ]
  have hcount : 1 + L / Real.log 2 ≤ (1 + 1 / Real.log 2) * L := by
    calc
      1 + L / Real.log 2 ≤ L + L / Real.log 2 := add_le_add hL le_rfl
      _ = (1 + 1 / Real.log 2) * L := by ring
  calc
    (∑ t ∈ T, f t) =
        ∑ k ∈ Ks, ∑ a ∈ As k, ∑ p ∈ Fs k a, f (reconstruct a p) := hpartition
    _ ≤ ∑ _k ∈ Ks, B := Finset.sum_le_sum hsumFiber
    _ = (Ks.card : ℝ) * B := by simp only [Finset.sum_const, nsmul_eq_mul]
    _ ≤ (1 + L / Real.log 2) * B := mul_le_mul_of_nonneg_right hcardK hB
    _ ≤ ((1 + 1 / Real.log 2) * L) * B := mul_le_mul_of_nonneg_right hcount hB
    _ = C ^ 3 * A * (1 + 1 / Real.log 2) * g₀ * R₀ * Q * N * U * V ^ 2 *
        x ^ (-5 * ε) * (Real.log x) ^ (E + 1) := by
      change ((1 + 1 / Real.log 2) * L) * B =
        C ^ 3 * A * (1 + 1 / Real.log 2) * g₀ * R₀ * Q * N * U * V ^ 2 *
          x ^ (-5 * ε) * L ^ (E + 1)
      rw [Real.rpow_add_one hLpos.ne']
      dsimp only [B]
      ring

theorem sourceSigmaOne_global_cutoff_residues (K : Finset ℕ) (As : ℕ → Finset (ℕ × ℕ × ℕ))
    (Fs : ℕ → (ℕ × ℕ × ℕ) → Finset (ℕ × ℕ × ℕ)) (D : ℕ → Finset ℕ)
    (q₀ : ℕ) (hq₀ : 0 < q₀)
    (hAs : ∀ k ∈ K, ∀ a₀ ∈ As k, 0 < a₀.1 ∧ 0 < a₀.2.1 ∧ 0 < a₀.2.2)
    (hFs : ∀ k ∈ K, ∀ a₀ ∈ As k, ∀ p ∈ Fs k a₀,
      0 < p.1 ∧ 0 < p.2.1 ∧ 0 < p.2.2)
    (hD : ∀ k ∈ K, ∀ d ∈ D k, 0 < d) :
    ∃ P : ℕ, 0 < P ∧ (K = ∅ → P = 1) ∧
      ∀ a b₁ b₂ : ℤ,
        let aN : ℕ := (a : ZMod P).val
        let b₁N : ℕ := (b₁ : ZMod P).val
        let b₂N : ℕ := (b₂ : ZMod P).val
        ∀ k ∈ K, ∀ a₀ ∈ As k,
          ∀ p ∈ Fs k a₀ ∪ (D k ×ˢ (Fs k a₀).image Prod.snd),
            (p.1 * a₀.1) * q₀ * a₀.2.1 * p.2.1 * p.2.2 * a₀.2.2 ∣ P ∧
            (Nat.Coprime
              ((p.1 * a₀.1) * q₀ * a₀.2.1 * p.2.1 * p.2.2 * a₀.2.2)
              (aN * b₁N * b₂N) ↔
              Int.gcd (a * b₁ * b₂)
                (((p.1 * a₀.1) * q₀ * a₀.2.1 * p.2.1 * p.2.2 * a₀.2.2 : ℕ) : ℤ) = 1) ∧
            ∀ (E : Finset (ℤ × ℤ)) (ψM wN : ℝ → ℝ) (M : ℝ) (ℓ : ℤ),
              sourceDispersionFrequencyBlock E ψM wN M
                (p.1 * a₀.1) q₀ a₀.2.1 p.2.1 p.2.2 a₀.2.2 aN b₁N b₂N ℓ =
              sourceSignedDispersionFrequencyBlock E ψM wN M
                (p.1 * a₀.1) q₀ a₀.2.1 p.2.1 p.2.2 a₀.2.2 a b₁ b₂ ℓ := by
  classical
  have hGlobalFamilyResidues (G : Finset (ℕ × ℕ × ℕ × ℕ × ℕ × ℕ))
      (hG : ∀ p ∈ G,
        0 < p.1 ∧ 0 < p.2.1 ∧ 0 < p.2.2.1 ∧ 0 < p.2.2.2.1 ∧
          0 < p.2.2.2.2.1 ∧ 0 < p.2.2.2.2.2) :
      let full : (ℕ × ℕ × ℕ × ℕ × ℕ × ℕ) → ℕ := fun p =>
        p.1 * p.2.1 * p.2.2.1 * p.2.2.2.1 * p.2.2.2.2.1 * p.2.2.2.2.2
      let P : ℕ := ∏ p ∈ G, full p
      0 < P ∧ (G = ∅ → P = 1) ∧ (∀ p ∈ G, full p ∣ P) ∧
        ∀ a b₁ b₂ : ℤ,
          let aN : ℕ := (a : ZMod P).val
          let b₁N : ℕ := (b₁ : ZMod P).val
          let b₂N : ℕ := (b₂ : ZMod P).val
          (∀ p ∈ G, Nat.Coprime (full p) (aN * b₁N * b₂N) ↔
            Int.gcd (a * b₁ * b₂) (full p : ℤ) = 1) ∧
          (∀ (E : Finset (ℤ × ℤ)) (ψM wN : ℝ → ℝ) (M : ℝ) (ℓ : ℤ),
            ∀ p ∈ G,
              sourceDispersionFrequencyBlock E ψM wN M
                p.1 p.2.1 p.2.2.1 p.2.2.2.1 p.2.2.2.2.1 p.2.2.2.2.2
                aN b₁N b₂N ℓ =
              sourceSignedDispersionFrequencyBlock E ψM wN M
                p.1 p.2.1 p.2.2.1 p.2.2.2.1 p.2.2.2.2.1 p.2.2.2.2.2
                a b₁ b₂ ℓ) := by
    clear * - hG
    classical
    intro full P
    have hfull (p : ℕ × ℕ × ℕ × ℕ × ℕ × ℕ) (hp : p ∈ G) : 0 < full p := by
      obtain ⟨hr, hq₀, hu, hv₁, hv₂, hq₂⟩ := hG p hp
      dsimp only [full]
      positivity
    have hP : 0 < P := Finset.prod_pos hfull
    have hdvd (p : ℕ × ℕ × ℕ × ℕ × ℕ × ℕ) (hp : p ∈ G) : full p ∣ P :=
      Finset.dvd_prod_of_mem full hp
    refine ⟨hP, ?_, hdvd, ?_⟩
    · intro hGempty
      simp only [P, hGempty, Finset.prod_empty]
    · let : NeZero P := ⟨hP.ne'⟩
      intro a b₁ b₂ aN b₁N b₂N
      have htransport (p : ℕ × ℕ × ℕ × ℕ × ℕ × ℕ) (hp : p ∈ G) :=
        sourceDispersionFrequencyBlock_common_signed P
          p.1 p.2.1 p.2.2.1 p.2.2.2.1 p.2.2.2.2.1 p.2.2.2.2.2
          (hdvd p hp) a b₁ b₂
      exact ⟨fun p hp => (htransport p hp).1,
        fun E ψM wN M ℓ p hp => (htransport p hp).2 E ψM wN M ℓ⟩
  let enlarged : ℕ → (ℕ × ℕ × ℕ) → Finset (ℕ × ℕ × ℕ) := fun k a₀ =>
    Fs k a₀ ∪ (D k ×ˢ (Fs k a₀).image Prod.snd)
  let lift : (ℕ × ℕ × ℕ) → (ℕ × ℕ × ℕ) → ℕ × ℕ × ℕ × ℕ × ℕ × ℕ :=
    fun a₀ p => (p.1 * a₀.1, q₀, a₀.2.1, p.2.1, p.2.2, a₀.2.2)
  let G := K.biUnion fun k => (As k).biUnion fun a₀ =>
    (enlarged k a₀).image (lift a₀)
  let full : (ℕ × ℕ × ℕ × ℕ × ℕ × ℕ) → ℕ := fun p =>
    p.1 * p.2.1 * p.2.2.1 * p.2.2.2.1 * p.2.2.2.2.1 * p.2.2.2.2.2
  let P : ℕ := ∏ p ∈ G, full p
  have henlarged (k : ℕ) (hk : k ∈ K) (a₀ : ℕ × ℕ × ℕ) (ha₀ : a₀ ∈ As k)
      (p : ℕ × ℕ × ℕ) (hp : p ∈ enlarged k a₀) :
      0 < p.1 ∧ 0 < p.2.1 ∧ 0 < p.2.2 := by
    rcases Finset.mem_union.mp hp with hp | hp
    · exact hFs k hk a₀ ha₀ p hp
    · obtain ⟨hd, hv⟩ := Finset.mem_product.mp hp
      obtain ⟨q, hq, hqv⟩ := Finset.mem_image.mp hv
      exact ⟨hD k hk p.1 hd, hqv ▸ (hFs k hk a₀ ha₀ q hq).2⟩
  have hmember (k : ℕ) (hk : k ∈ K) (a₀ : ℕ × ℕ × ℕ) (ha₀ : a₀ ∈ As k)
      (p : ℕ × ℕ × ℕ) (hp : p ∈ enlarged k a₀) : lift a₀ p ∈ G :=
    Finset.mem_biUnion.mpr ⟨k, hk,
      Finset.mem_biUnion.mpr ⟨a₀, ha₀, Finset.mem_image_of_mem (lift a₀) hp⟩⟩
  have hG : ∀ p ∈ G,
      0 < p.1 ∧ 0 < p.2.1 ∧ 0 < p.2.2.1 ∧ 0 < p.2.2.2.1 ∧
        0 < p.2.2.2.2.1 ∧ 0 < p.2.2.2.2.2 := by
    intro p hp
    obtain ⟨k, hk, ha⟩ := Finset.mem_biUnion.mp hp
    obtain ⟨a₀, ha₀, hp⟩ := Finset.mem_biUnion.mp ha
    obtain ⟨q, hq, rfl⟩ := Finset.mem_image.mp hp
    obtain ⟨hr₁, hu, hq₂⟩ := hAs k hk a₀ ha₀
    obtain ⟨hd, hv₁, hv₂⟩ := henlarged k hk a₀ ha₀ q hq
    exact ⟨mul_pos hd hr₁, hq₀, hu, hv₁, hv₂, hq₂⟩
  have hglobal := hGlobalFamilyResidues G hG
  refine ⟨P, hglobal.1, ?_, ?_⟩
  · intro hKempty
    apply hglobal.2.1
    simp only [G, hKempty, Finset.biUnion_empty]
  · let : NeZero P := ⟨hglobal.1.ne'⟩
    intro a b₁ b₂ aN b₁N b₂N k hk a₀ ha₀ p hp
    have hpG : lift a₀ p ∈ G := hmember k hk a₀ ha₀ p hp
    have htransport := hglobal.2.2.2 a b₁ b₂
    exact ⟨hglobal.2.2.1 (lift a₀ p) hpG,
      htransport.1 (lift a₀ p) hpG,
      fun E ψM wN M ℓ => htransport.2 E ψM wN M ℓ (lift a₀ p) hpG⟩

theorem sourceSigmaOne_dyadic_source_geometry :
    ∀ (C x δ ε N H R₀ : ℝ), 1 ≤ C → 1 ≤ x → 0 < δ → 0 < ε →
    0 < N → 0 < H → 0 < R₀ →
    let Dtarget : ℝ := N / (x ^ (50 * ε) * H ^ 2)
    ∀ (r d r₁ : ℕ), 0 < r → 0 < d → 0 < r₁ → r = d * r₁ →
    R₀ / C ≤ (r : ℝ) → (r : ℝ) ≤ C * R₀ →
    Dtarget / x ^ δ ≤ (d : ℝ) → (d : ℝ) ≤ Dtarget →
    let k : ℕ := Nat.log2 d
    let Δ : ℝ := (2 ^ k : ℕ)
    let D : Finset ℕ := Finset.Icc (2 ^ k) (2 * 2 ^ k)
    1 ≤ Δ ∧ 2 ^ k ≤ d ∧ d ≤ 2 * 2 ^ k ∧
      R₀ / (2 * C) ≤ (r₁ : ℝ) * Δ ∧ (r₁ : ℝ) * Δ ≤ (2 * C) * R₀ ∧
      N ≤ (2 * C) * x ^ (δ + 50 * ε) * H ^ 2 * Δ ∧
      Δ ≤ (2 * C) * N / (x ^ (50 * ε) * H ^ 2) ∧
      (D.card : ℝ) ≤ 2 * Δ
:= by
  have hDyadicWindow (d : ℕ) (hd : 0 < d) (Y D : ℝ) (hY : 0 < Y)
      (hlower : D / Y ≤ (d : ℝ)) (hupper : (d : ℝ) ≤ D) :
      let Δ : ℝ := (2 ^ Nat.log2 d : ℕ)
      0 < Δ ∧ Δ ≤ (d : ℝ) ∧ (d : ℝ) < 2 * Δ ∧
        D / (2 * Y) < Δ ∧ Δ ≤ D := by
    let Δ : ℝ := (2 ^ Nat.log2 d : ℕ)
    change 0 < Δ ∧ Δ ≤ (d : ℝ) ∧ (d : ℝ) < 2 * Δ ∧
      D / (2 * Y) < Δ ∧ Δ ≤ D
    have hΔ : 0 < Δ := by dsimp [Δ]; positivity
    have hlow : Δ ≤ (d : ℝ) := by
      change ((2 ^ Nat.log2 d : ℕ) : ℝ) ≤ (d : ℝ)
      exact_mod_cast Nat.log2_self_le (Nat.ne_of_gt hd)
    have hhigh : (d : ℝ) < 2 * Δ := by
      have hnat : d < 2 * 2 ^ Nat.log2 d := by
        simpa only [pow_succ, mul_comm] using (Nat.lt_log2_self (n := d))
      change (d : ℝ) < 2 * ((2 ^ Nat.log2 d : ℕ) : ℝ)
      exact_mod_cast hnat
    refine ⟨hΔ, hlow, hhigh, ?_, hlow.trans hupper⟩
    apply (div_lt_iff₀ (mul_pos (by norm_num : (0 : ℝ) < 2) hY)).2
    calc
      D ≤ (d : ℝ) * Y := (div_le_iff₀ hY).1 hlower
      _ < (2 * Δ) * Y := mul_lt_mul_of_pos_right hhigh hY
      _ = Δ * (2 * Y) := by ring
  intro C x δ ε N H R₀ hC hx _ _ hN hH hR₀ Dtarget
    r d r₁ _ hd hr₁ hproduct hrlo hrhi hdlo hdhi k Δ D
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hxpos : 0 < x := zero_lt_one.trans_le hx
  have hpow (a : ℝ) : 0 < x ^ a := Real.rpow_pos_of_pos hxpos a
  have hden : 0 < x ^ (50 * ε) * H ^ 2 :=
    mul_pos (hpow (50 * ε)) (pow_pos hH 2)
  have hDtarget : 0 < Dtarget := div_pos hN hden
  have hr₁real : 0 < (r₁ : ℝ) := by exact_mod_cast hr₁
  have hrEq : (r : ℝ) = (d : ℝ) * (r₁ : ℝ) := by exact_mod_cast hproduct
  obtain ⟨_, hΔd, hdΔ, hDΔ, hΔD⟩ :=
    hDyadicWindow d hd (x ^ δ) Dtarget (hpow δ) hdlo hdhi
  have hkpos : 0 < (2 ^ k : ℕ) := pow_pos (by norm_num) k
  have hΔone : 1 ≤ Δ := by
    change (1 : ℝ) ≤ ((2 ^ k : ℕ) : ℝ)
    exact_mod_cast Nat.succ_le_of_lt hkpos
  have hΔnat : 2 ^ k ≤ d := by exact_mod_cast hΔd
  have hdΔnat : d ≤ 2 * 2 ^ k := by exact_mod_cast hdΔ.le
  have htwoC : 2 ≤ 2 * C := by linarith only [hC]
  have honeTwoC : 1 ≤ 2 * C := (by norm_num : (1 : ℝ) ≤ 2).trans htwoC
  have hrlower : R₀ / (2 * C) ≤ (r₁ : ℝ) * Δ := by
    apply (div_le_iff₀' (mul_pos (by norm_num : (0 : ℝ) < 2) hCpos)).2
    calc
      R₀ ≤ C * (r : ℝ) := (div_le_iff₀' hCpos).1 hrlo
      _ = C * ((d : ℝ) * (r₁ : ℝ)) := by rw [hrEq]
      _ ≤ C * ((2 * Δ) * (r₁ : ℝ)) :=
        mul_le_mul_of_nonneg_left
          (mul_le_mul_of_nonneg_right hdΔ.le hr₁real.le) hCpos.le
      _ = (2 * C) * ((r₁ : ℝ) * Δ) := by ring
  have hrupper : (r₁ : ℝ) * Δ ≤ (2 * C) * R₀ := by
    calc
      (r₁ : ℝ) * Δ ≤ (r₁ : ℝ) * (d : ℝ) :=
        mul_le_mul_of_nonneg_left hΔd hr₁real.le
      _ = (r : ℝ) := by rw [hrEq]; ring
      _ ≤ C * R₀ := hrhi
      _ ≤ (2 * C) * R₀ :=
        mul_le_mul_of_nonneg_right (by linarith only [hCpos]) hR₀.le
  have hDupper : Dtarget ≤ (2 * x ^ δ) * Δ := by
    have h := (div_lt_iff₀ (mul_pos (by norm_num : (0 : ℝ) < 2) (hpow δ))).1 hDΔ
    simpa only [mul_assoc, mul_comm, mul_left_comm] using h.le
  have hNscale : N ≤ (2 * C) * x ^ (δ + 50 * ε) * H ^ 2 * Δ := by
    calc
      N = Dtarget * (x ^ (50 * ε) * H ^ 2) := by
        dsimp only [Dtarget]
        rw [div_mul_cancel₀ _ hden.ne']
      _ ≤ ((2 * x ^ δ) * Δ) * (x ^ (50 * ε) * H ^ 2) :=
        mul_le_mul_of_nonneg_right hDupper hden.le
      _ = 2 * (x ^ (δ + 50 * ε) * H ^ 2 * Δ) := by
        rw [Real.rpow_add hxpos δ (50 * ε)]
        ring
      _ ≤ (2 * C) * (x ^ (δ + 50 * ε) * H ^ 2 * Δ) :=
        mul_le_mul_of_nonneg_right htwoC (by positivity)
      _ = (2 * C) * x ^ (δ + 50 * ε) * H ^ 2 * Δ := by ring
  have hΔupper : Δ ≤ (2 * C) * N / (x ^ (50 * ε) * H ^ 2) := by
    calc
      Δ ≤ Dtarget := hΔD
      _ ≤ (2 * C) * Dtarget := le_mul_of_one_le_left hDtarget.le honeTwoC
      _ = (2 * C) * N / (x ^ (50 * ε) * H ^ 2) := by
        dsimp only [Dtarget]
        ring
  have hcardNat : D.card ≤ 2 * 2 ^ k := by
    dsimp only [D]
    rw [Nat.card_Icc]
    omega
  have hcard : (D.card : ℝ) ≤ 2 * Δ := by
    change (D.card : ℝ) ≤ 2 * ((2 ^ k : ℕ) : ℝ)
    exact_mod_cast hcardNat
  exact ⟨hΔone, hΔnat, hdΔnat, hrlower, hrupper, hNscale, hΔupper, hcard⟩

open Classical in
theorem opening_majorant (c T : ℝ) (hc : 0 < c) (hcT : c ≤ T) :
    ∃ ψ : ℝ → ℝ, ContDiff ℝ ∞ ψ ∧
      Function.support ψ ⊆ Set.Icc (c / 2) (2 * T) ∧
      (∀ t : ℝ, 0 ≤ ψ t) ∧
      (∀ t ∈ Set.Icc c T, 1 ≤ ψ t) ∧
      ∀ j : ℕ, ∃ Cj : ℝ, 0 ≤ Cj ∧
        ∀ t : ℝ, ‖iteratedDeriv j ψ t‖ ≤ Cj := by
  let f : ContDiffBump ((c + T) / 2 : ℝ) :=
    ⟨(2 * T - c) / 4, T / 2, by linarith, by linarith⟩
  have hsmooth : ContDiff ℝ ∞ (f : ℝ → ℝ) := f.contDiff
  refine ⟨f, hsmooth, ?_, fun _ => f.nonneg, ?_, ?_⟩
  · intro t ht
    rw [f.support_eq, Real.ball_eq_Ioo] at ht
    change (c + T) / 2 - T / 2 < t ∧ t < (c + T) / 2 + T / 2 at ht
    exact ⟨by linarith [ht.1], by linarith [ht.2]⟩
  · intro t ht
    have hft : f t = 1 := f.one_of_mem_closedBall (by
      rw [Real.closedBall_eq_Icc]
      change (c + T) / 2 - (2 * T - c) / 4 ≤ t ∧
        t ≤ (c + T) / 2 + (2 * T - c) / 4
      exact ⟨by linarith [ht.1], by linarith [ht.2]⟩)
    exact le_of_eq hft.symm
  · intro j
    have hcompact : HasCompactSupport (iteratedDeriv j (f : ℝ → ℝ)) := by
      rw [iteratedDeriv_eq_equiv_comp]
      exact (f.hasCompactSupport.iteratedFDeriv j).comp_left (map_zero _)
    obtain ⟨Cj, hCj, hbound⟩ :=
      (hcompact.isCompact_range
        (hsmooth.continuous_iteratedDeriv j (by simp))).isBounded.exists_pos_norm_le
    exact ⟨Cj, hCj.le, fun t => hbound _ ⟨t, rfl⟩⟩

open Classical in
theorem opening_moment (d : ℕ) (E C T : ℝ) (hC : 0 ≤ C) (hT : 0 < T) :
    ∃ K F : ℝ, 0 < K ∧
      ∀ᶠ x : ℝ in Filter.atTop, ∀ (M : ℝ), 0 < M → M ≤ x ^ 2 →
        ∀ α : ℕ →₀ ℂ,
          (∀ n ∈ α.support, 0 < n ∧ (n : ℝ) ≤ T * M ∧
            ‖α n‖ ≤ C * (n.divisors.card : ℝ) ^ d * (Real.log x) ^ E) →
          (∑ n ∈ α.support, ‖α n‖ ^ 2) ≤ K * M * (Real.log x) ^ F := by
  let L : ℕ := 2 ^ (2 * d) - 1
  have hCpow : 0 ≤ C ^ 2 := pow_nonneg hC 2
  have hconstant : 0 ≤ C ^ 2 * T * (4 : ℝ) ^ L :=
    mul_nonneg (mul_nonneg hCpow hT.le) (pow_nonneg (by norm_num) L)
  refine ⟨C ^ 2 * T * (4 : ℝ) ^ L + 1, 2 * E + (L : ℝ),
    by linarith, ?_⟩
  filter_upwards [Filter.eventually_ge_atTop (max (Real.exp 1) T)] with x hx
  have hxe : Real.exp 1 ≤ x := (le_max_left _ _).trans hx
  have hTx : T ≤ x := (le_max_right _ _).trans hx
  have hlogone : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hxe
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlogone
  intro M hM hMupper α hα
  let Z : ℕ := ⌊T * M⌋₊
  have hZfloor : (Z : ℝ) ≤ T * M := Nat.floor_le (mul_pos hT hM).le
  have hsupport : α.support ⊆ Finset.Icc 1 Z := by
    intro n hn
    exact Finset.mem_Icc.mpr
      ⟨Nat.succ_le_of_lt (hα n hn).1, Nat.le_floor (hα n hn).2.1⟩
  have hZcube : (Z : ℝ) ≤ x ^ 3 := by
    calc
      (Z : ℝ) ≤ T * M := hZfloor
      _ ≤ T * x ^ 2 := mul_le_mul_of_nonneg_left hMupper hT.le
      _ ≤ x * x ^ 2 := mul_le_mul_of_nonneg_right hTx (sq_nonneg x)
      _ = x ^ 3 := by ring
  have hZlog : Real.log (Z : ℝ) ≤ 3 * Real.log x := by
    by_cases hZ : Z = 0
    · simp only [hZ, Nat.cast_zero, Real.log_zero]
      positivity
    · have hZpos : 0 < (Z : ℝ) := by exact_mod_cast Nat.pos_of_ne_zero hZ
      simpa only [Real.log_pow, Nat.cast_ofNat] using Real.log_le_log hZpos hZcube
  have hlogZnonneg : 0 ≤ 1 + Real.log (Z : ℝ) :=
    add_nonneg zero_le_one (Real.log_natCast_nonneg Z)
  have hlogZupper : 1 + Real.log (Z : ℝ) ≤ 4 * Real.log x := by
    linarith only [hZlog, hlogone]
  have hlogPower : ((Real.log x) ^ E) ^ (2 : ℕ) = (Real.log x) ^ (2 * E) := by
    simpa only [Nat.cast_ofNat, mul_comm] using
      (Real.rpow_mul_natCast hlogpos.le E 2).symm
  let A : ℝ := C ^ 2 * (Real.log x) ^ (2 * E)
  have hA : 0 ≤ A := mul_nonneg hCpow (Real.rpow_nonneg hlogpos.le _)
  have hpoint : ∀ n ∈ α.support,
      ‖α n‖ ^ 2 ≤ A * (n.divisors.card : ℝ) ^ (2 * d) := by
    intro n hn
    have hdivisorPower : ((n.divisors.card : ℝ) ^ d) ^ (2 : ℕ) =
        (n.divisors.card : ℝ) ^ (2 * d) := by
      rw [← pow_mul, Nat.mul_comm d 2]
    calc
      ‖α n‖ ^ 2 ≤
          (C * (n.divisors.card : ℝ) ^ d * (Real.log x) ^ E) ^ 2 :=
        pow_le_pow_left₀ (norm_nonneg _) (hα n hn).2.2 2
      _ = A * (n.divisors.card : ℝ) ^ (2 * d) := by
        rw [mul_pow, mul_pow, hdivisorPower, hlogPower]
        dsimp only [A]
        ring
  calc
    (∑ n ∈ α.support, ‖α n‖ ^ 2) ≤
        ∑ n ∈ α.support, A * (n.divisors.card : ℝ) ^ (2 * d) :=
      Finset.sum_le_sum hpoint
    _ = A * ∑ n ∈ α.support, (n.divisors.card : ℝ) ^ (2 * d) := by
      rw [Finset.mul_sum]
    _ ≤ A * ∑ n ∈ Finset.Icc 1 Z, (n.divisors.card : ℝ) ^ (2 * d) :=
      mul_le_mul_of_nonneg_left
        (Finset.sum_le_sum_of_subset_of_nonneg hsupport
          (fun n _ _ => pow_nonneg (Nat.cast_nonneg _) _)) hA
    _ ≤ A * ((Z : ℝ) * (1 + Real.log (Z : ℝ)) ^ L) :=
      mul_le_mul_of_nonneg_left
        (sum_card_divisors_pow_le_mul_log_pow (2 * d) Z) hA
    _ ≤ A * ((T * M) * (4 * Real.log x) ^ L) :=
      mul_le_mul_of_nonneg_left
        (mul_le_mul hZfloor (pow_le_pow_left₀ hlogZnonneg hlogZupper L)
          (pow_nonneg hlogZnonneg L) (mul_pos hT hM).le) hA
    _ = (C ^ 2 * T * (4 : ℝ) ^ L) * M * (Real.log x) ^ (2 * E + (L : ℝ)) := by
      simp only [A, mul_pow, Real.rpow_add hlogpos, Real.rpow_natCast]
      ring
    _ ≤ (C ^ 2 * T * (4 : ℝ) ^ L + 1) * M *
        (Real.log x) ^ (2 * E + (L : ℝ)) := by
      apply mul_le_mul_of_nonneg_right _ (Real.rpow_nonneg hlogpos.le _)
      exact mul_le_mul_of_nonneg_right (le_add_of_nonneg_right zero_le_one) hM.le

open Classical in
theorem opening_padded_truncation
    (d : ℕ) (Eβ κ Bβ ε A : ℝ)
    (hκ : 0 ≤ κ) (hBβ : 0 ≤ Bβ) (hε : 0 < ε) (hA : 0 ≤ A) :
    let γ : ℝ := ((2 * d + 5 : ℕ) : ℝ) * κ
    let k : ℕ := Nat.ceil ((A + γ + 2) / ε)
    A + γ + 2 ≤ ε * (k : ℝ) ∧
    ∀ (c₀ T L Eψ : ℝ), 0 < c₀ → c₀ ≤ T → 0 ≤ L →
      ∀ᶠ x : ℝ in Filter.atTop,
        ∀ (S : Finset (ℕ × ℕ)) (β : ℕ →₀ ℂ)
          (c : ℕ × ℕ → ℂ) (N : ℕ) (M Q R : ℝ),
          0 < M → 0 < Q → 0 < R →
          β.support ⊆ Finset.Icc 1 N → (N : ℝ) ≤ x ^ κ →
          (∀ n ∈ β.support,
            ‖β n‖ ≤ Bβ * ((Nat.divisors n).card : ℝ) ^ d * (Real.log x) ^ Eβ) →
          (∀ p ∈ S, ‖c p‖ ≤ 1) →
          (∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Nat.Coprime p.1 p.2 ∧
            Q ≤ (p.1 : ℝ) ∧ (p.1 : ℝ) ≤ 2 * Q ∧
            R ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ 2 * R ∧
            (p.1 : ℝ) ≤ x ^ κ ∧ (p.2 : ℝ) ≤ x ^ κ) →
          ∀ (a b₁ b₂ : ℕ),
            (∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2)) →
          ∀ (ψ : ℝ → ℝ), ContDiff ℝ ∞ ψ →
            Function.support ψ ⊆ Set.Icc c₀ T →
            (∀ t : ℝ,
              ‖ψ t‖ ≤ L * (Real.log x) ^ Eψ ∧
              ‖iteratedDeriv (k + 2) ψ t‖ ≤ L * (Real.log x) ^ Eψ) →
            4 * x ^ ε < M →
            let sm : Finset ℕ := Finset.Icc 1 ⌊T * M⌋₊
            let w : ℕ → ℝ := fun n => ψ ((n : ℝ) / M)
            let P : ℕ → ℕ → ℕ → ℕ := fun r q₁ q₂ => r * Nat.lcm q₁ q₂
            let H : ℕ → ℕ → ℕ → ℝ := fun _ q₁ q₂ =>
              x ^ ε * R * Q ^ 2 / ((Nat.gcd q₁ q₂ : ℝ) * M)
            let B : ℕ → ℕ → ℕ → ℝ := fun r q₁ q₂ =>
              if H r q₁ q₂ < 1 then 1 / 2
              else ((2 ^ (Nat.log 2 ⌊H r q₁ q₂⌋₊ + 1) - 1 : ℕ) : ℝ)
            let J : ℕ → ℕ → ℕ → Finset ℤ := fun r q₁ q₂ =>
              (Finset.Icc (-⌊B r q₁ q₂⌋) ⌊B r q₁ q₂⌋).filter (fun h => h ≠ 0)
            let Vℤ : ℕ → ℕ → ℕ → ℕ → ℕ → ℂ := fun r q₁ q₂ n₁ n₂ =>
              if n₁ = n₂ then (mixedFiberMass sm w q₁ q₂ r a b₁ b₂ n₁ n₂ : ℂ)
              else mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂ 0 +
                ∑ h ∈ J r q₁ q₂,
                  mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂
                    ((h : ZMod (P r q₁ q₂)).val)
            ‖mixedCorrelation sm w S β c a b₁ b₂ -
                (∑ r ∈ S.image Prod.snd,
                  ∑ p₁ ∈ S.filter (fun p => p.2 = r),
                    ∑ p₂ ∈ S.filter (fun p => p.2 = r),
                      c p₁ * star (c p₂) *
                        ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                          β n₁ * star (β n₂) * Vℤ r p₁.1 p₂.1 n₁ n₂)‖ ≤
              x ^ (-A) := by
  intro γ k
  have hkpos : 0 < k := Nat.ceil_pos.mpr (by positivity)
  have hk : A + γ + 2 ≤ ε * (k : ℝ) := by
    simpa only [mul_comm] using
      (div_le_iff₀ hε).mp ((Nat.ceil_eq_iff (Nat.ne_of_gt hkpos)).mp rfl).2
  refine ⟨hk, ?_⟩
  intro c₀ T L Eψ hc₀ hcT hL
  have hT : 0 ≤ T := hc₀.le.trans hcT
  let K₀ : ℝ := (2 : ℝ) ^ (5 * k + 4) * T * L
  have hK₀ : 0 ≤ K₀ := by positivity
  have hsmall :=
    ((isLittleO_log_rpow_rpow_atTop Eψ zero_lt_one).const_mul_left K₀).eventuallyLE
  filter_upwards [mixedCorrelation_outer_coefficient_mass_eventually_le_rpow
    d Eβ κ Bβ 1 hκ hBβ zero_lt_one, hsmall,
    Filter.eventually_ge_atTop (Real.exp 1)] with x hmass hsmall hx
  intro S β c N M Q R hM hQ hR hβ hN henv hc hS a b₁ b₂ hprim ψ hψ
    hsupport hbound hshort sm w P H B J Vℤ
  have hx₀ : 0 < x := (Real.exp_pos 1).trans_le hx
  have hx₁ : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hx
  have hlog : 0 ≤ (Real.log x) ^ Eψ := Real.rpow_nonneg (Real.log_nonneg hx₁) Eψ
  have hLx : 0 ≤ L * (Real.log x) ^ Eψ := mul_nonneg hL hlog
  have hconstant : K₀ * (Real.log x) ^ Eψ ≤ x := by
    simpa only [Real.rpow_one, Real.norm_of_nonneg (mul_nonneg hK₀ hlog),
      Real.norm_of_nonneg hx₀.le] using hsmall
  have houter := hmass S β c N hβ hN henv hc (fun p hp => by
    obtain ⟨hq, hr, _, _, _, _, _, hqx, hrx⟩ := hS p hp
    exact ⟨hq, hr, hqx, hrx⟩)
  let δ : ℝ := x ^ (1 - (k : ℝ) * ε)
  have hδ : 0 ≤ δ := Real.rpow_nonneg hx₀.le _
  let ψℂ : ℝ → ℂ := fun t => (ψ t : ℂ)
  have hψℂ : ContDiff ℝ ∞ ψℂ := Complex.ofRealCLM.contDiff.comp hψ
  have hsℂ : Function.support ψℂ ⊆ Set.Icc (-T) T :=
    ((Function.support_comp_subset (g := Complex.ofReal) Complex.ofReal_zero ψ).trans
      hsupport).trans (Set.Icc_subset_Icc_left ((neg_nonpos.mpr hT).trans hc₀.le))
  have hbℂ (t : ℝ) :
      ‖ψℂ t‖ ≤ L * (Real.log x) ^ Eψ ∧
        ‖iteratedDeriv (k + 2) ψℂ t‖ ≤ L * (Real.log x) ^ Eψ := by
    refine ⟨by simpa only [ψℂ, Complex.norm_real] using (hbound t).1, ?_⟩
    have he : ‖iteratedDeriv (k + 2) ψℂ t‖ = ‖iteratedDeriv (k + 2) ψ t‖ := by
      simpa only [norm_iteratedFDeriv_eq_norm_iteratedDeriv, ψℂ,
        Function.comp_def, Complex.ofRealLI_apply] using
        Complex.ofRealLI.norm_iteratedFDeriv_comp_left
          (x := t) (i := k + 2) hψ.contDiffAt (by simp)
    exact he.trans_le (hbound t).2
  have hlocal (r : ℕ)
      (p₁ : ℕ × ℕ) (hp₁ : p₁ ∈ S.filter (fun p => p.2 = r))
      (p₂ : ℕ × ℕ) (hp₂ : p₂ ∈ S.filter (fun p => p.2 = r)) :
      0 ≤ B r p₁.1 p₂.1 ∧
      (1 ≤ H r p₁.1 p₂.1 → 2 * B r p₁.1 p₂.1 < (P r p₁.1 p₂.1 : ℝ)) ∧
      (2 : ℝ) ^ (k + 4) * T * (L * (Real.log x) ^ Eψ) /
        (1 + (M / (P r p₁.1 p₂.1 : ℝ)) * B r p₁.1 p₂.1) ^ k ≤ δ := by
    obtain ⟨hp₁S, hp₁r⟩ := Finset.mem_filter.mp hp₁
    obtain ⟨hp₂S, _⟩ := Finset.mem_filter.mp hp₂
    obtain ⟨hq₁, hr₁, _, hlo₁, hhi₁, hrl, hru, _, _⟩ := hS p₁ hp₁S
    obtain ⟨hq₂, _, _, hlo₂, hhi₂, _, _, _, _⟩ := hS p₂ hp₂S
    have hr : 0 < r := by simpa only [hp₁r] using hr₁
    have hrange : R ≤ (r : ℝ) ∧ (r : ℝ) ≤ 2 * R := by
      simpa only [hp₁r] using And.intro hrl hru
    have : NeZero p₁.1 := NeZero.of_pos hq₁
    have : NeZero p₂.1 := NeZero.of_pos hq₂
    have : NeZero r := NeZero.of_pos hr
    have hg : 0 < (Nat.gcd p₁.1 p₂.1 : ℝ) := by
      exact_mod_cast Nat.gcd_pos_of_pos_left p₂.1 hq₁
    have hP : 0 < (P r p₁.1 p₂.1 : ℝ) := by
      exact_mod_cast Nat.mul_pos hr (Nat.lcm_pos hq₁ hq₂)
    obtain ⟨_, hPlow, _, hcut, _, _⟩ := mixedPeriod_dyadic_common_cutoff
      p₁.1 p₂.1 r Q R x ε M hQ hR hx₁ hM ⟨hlo₁, hhi₁⟩ ⟨hlo₂, hhi₂⟩ hrange
    have hB : 0 ≤ B r p₁.1 p₂.1 ∧
        H r p₁.1 p₂.1 / 2 ≤ B r p₁.1 p₂.1 ∧
        (1 ≤ H r p₁.1 p₂.1 → B r p₁.1 p₂.1 < 2 * H r p₁.1 p₂.1) := by
      by_cases hh : H r p₁.1 p₂.1 < 1
      · simp only [B, ite_eq_left hh]
        exact ⟨by norm_num, by linarith only [hh], fun hh' => by linarith only [hh, hh']⟩
      · have hb := padded_dyadic_cutoff_bounds (H r p₁.1 p₂.1) (le_of_not_gt hh)
        refine ⟨?_, ?_, ?_⟩
        · simp only [B, ite_eq_right hh]
          exact Nat.cast_nonneg _
        · simpa only [B, ite_eq_right hh] using hb.2.2.2.1
        · intro _
          simpa only [B, ite_eq_right hh] using hb.2.2.2.2.1
    have hfour : 4 * H r p₁.1 p₂.1 < (P r p₁.1 p₂.1 : ℝ) := by
      have hD : 0 < R * Q ^ 2 / (Nat.gcd p₁.1 p₂.1 : ℝ) := by positivity
      calc
        4 * H r p₁.1 p₂.1 =
            (4 * x ^ ε / M) * (R * Q ^ 2 / (Nat.gcd p₁.1 p₂.1 : ℝ)) := by
          dsimp only [H]
          field_simp [hg.ne', hM.ne']
        _ < R * Q ^ 2 / (Nat.gcd p₁.1 p₂.1 : ℝ) := by
          simpa only [one_mul] using
            mul_lt_mul_of_pos_right ((div_lt_one hM).mpr hshort) hD
        _ ≤ (P r p₁.1 p₂.1 : ℝ) := hPlow
    have hcutB : x ^ ε / 16 ≤ (M / (P r p₁.1 p₂.1 : ℝ)) * B r p₁.1 p₂.1 := by
      have hh : (M / (P r p₁.1 p₂.1 : ℝ)) * H r p₁.1 p₂.1 / 2 ≤
          (M / (P r p₁.1 p₂.1 : ℝ)) * B r p₁.1 p₂.1 := by
        simpa only [mul_div_assoc] using
          mul_le_mul_of_nonneg_left hB.2.1 (div_pos hM hP).le
      linarith only [hcut, hh]
    refine ⟨hB.1, fun hh => by linarith only [hB.2.2 hh, hfour], ?_⟩
    have hbase : 0 < x ^ ε / 16 := by positivity
    have hden : (x ^ ε / 16) ^ k ≤
        (1 + (M / (P r p₁.1 p₂.1 : ℝ)) * B r p₁.1 p₂.1) ^ k :=
      pow_le_pow_left₀ hbase.le (by linarith only [hcutB]) k
    have hpower : (2 : ℝ) ^ (k + 4) * (16 : ℝ) ^ k =
        (2 : ℝ) ^ (5 * k + 4) := by
      rw [show (16 : ℝ) = (2 : ℝ) ^ 4 by norm_num, ← pow_mul, ← pow_add]
      congr 1
      omega
    have hXpow : ((x ^ ε) ^ k)⁻¹ = x ^ (-((k : ℝ) * ε)) := by
      rw [Real.rpow_neg hx₀.le, mul_comm (k : ℝ) ε,
        Real.rpow_mul_natCast hx₀.le ε k]
    calc
      _ ≤ (2 : ℝ) ^ (k + 4) * T * (L * (Real.log x) ^ Eψ) / (x ^ ε / 16) ^ k :=
        div_le_div_of_nonneg_left (by positivity) (pow_pos hbase k) hden
      _ = ((2 : ℝ) ^ (k + 4) * (16 : ℝ) ^ k) * T *
          (L * (Real.log x) ^ Eψ) * ((x ^ ε) ^ k)⁻¹ := by
        rw [div_pow, div_div_eq_mul_div, div_eq_mul_inv]
        ring
      _ = (K₀ * (Real.log x) ^ Eψ) * x ^ (-((k : ℝ) * ε)) := by
        rw [hpower, hXpow]
        simp only [K₀, mul_assoc]
      _ ≤ x * x ^ (-((k : ℝ) * ε)) :=
        mul_le_mul_of_nonneg_right hconstant (Real.rpow_nonneg hx₀.le _)
      _ = δ := by
        simpa only [δ, sub_eq_add_neg, Real.rpow_one] using
          (Real.rpow_add hx₀ 1 (-((k : ℝ) * ε))).symm
  have hE := positiveCompactProfile_nat_boundary_error_zero c₀ T M hc₀ hcT hM ψ hsupport
  dsimp only at hE
  have htrunc := mixedCorrelation_centered_smooth_truncation k sm w S β c a b₁ b₂
    T (L * (Real.log x) ^ Eψ) M 0 B hT hLx hM ψℂ hψℂ hsℂ hbℂ
    (fun p hp => ⟨(hS p hp).1, (hS p hp).2.1, (hS p hp).2.2.1⟩) hprim
    (fun r _ p₁ hp₁ p₂ hp₂ => (hlocal r p₁ hp₁ p₂ hp₂).1)
  dsimp only at htrunc
  simp only [ψℂ, sub_zero, zero_sub, zero_add, ← neg_mul, sm, w,
    hE, mul_zero, add_zero] at htrunc
  have hresult := htrunc.trans (show _ ≤ x ^ (-A) from by
    calc
      _ ≤ ∑ r ∈ S.image Prod.snd,
          ∑ p₁ ∈ S.filter (fun p => p.2 = r),
            ∑ p₂ ∈ S.filter (fun p => p.2 = r),
              ‖c p₁‖ * ‖c p₂‖ *
                ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                  ‖β n₁‖ * ‖β n₂‖ * δ := by
        gcongr with r hr p₁ hp₁ p₂ hp₂ n₁ hn₁ n₂ hn₂
        split_ifs
        · exact (hlocal r p₁ hp₁ p₂ hp₂).2.2
        · exact hδ
      _ = δ * (∑ r ∈ S.image Prod.snd,
          ∑ p₁ ∈ S.filter (fun p => p.2 = r),
            ∑ p₂ ∈ S.filter (fun p => p.2 = r),
              ‖c p₁‖ * ‖c p₂‖ *
                ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                  ‖β n₁‖ * ‖β n₂‖) := by
        simp only [Finset.mul_sum, mul_assoc, mul_left_comm, mul_comm]
      _ ≤ δ * x ^ (γ + 1) := mul_le_mul_of_nonneg_left houter hδ
      _ = x ^ (γ + 2 - (k : ℝ) * ε) := by
        dsimp only [δ]
        rw [← Real.rpow_add hx₀]
        congr 1
        ring
      _ ≤ x ^ (-A) := Real.rpow_le_rpow_of_exponent_le hx₁ (by nlinarith only [hk]))
  refine (le_of_eq ?_).trans hresult
  apply congrArg (fun z : ℂ => ‖mixedCorrelation sm w S β c a b₁ b₂ - z‖)
  refine Finset.sum_congr rfl fun r _ =>
    Finset.sum_congr rfl fun p₁ hp₁ =>
      Finset.sum_congr rfl fun p₂ hp₂ => ?_
  apply congrArg (fun z : ℂ => c p₁ * star (c p₂) * z)
  refine Finset.sum_congr rfl fun n₁ _ => Finset.sum_congr rfl fun n₂ _ => ?_
  apply congrArg (fun z : ℂ => β n₁ * star (β n₂) * z)
  by_cases hn : n₁ = n₂
  · simp only [Vℤ, ite_eq_left hn]
    rfl
  · simp only [Vℤ, ite_eq_right hn]
    apply congrArg (fun z : ℂ =>
      mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b₁ b₂ n₁ n₂ 0 + z)
    have hq₁ := (hS p₁ (Finset.mem_filter.mp hp₁).1).1
    have hq₂ := (hS p₂ (Finset.mem_filter.mp hp₂).1).1
    have hrpos : 0 < r := by
      simpa only [(Finset.mem_filter.mp hp₁).2] using
        (hS p₁ (Finset.mem_filter.mp hp₁).1).2.1
    have : NeZero (P r p₁.1 p₂.1) :=
      NeZero.of_pos (Nat.mul_pos hrpos (Nat.lcm_pos hq₁ hq₂))
    have he := centered_residue_sum_eq_signed (P r p₁.1 p₂.1)
      (B r p₁.1 p₂.1) (hlocal r p₁ hp₁ p₂ hp₂).1
      (fun h => mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b₁ b₂ n₁ n₂ h)
    by_cases hh : H r p₁.1 p₂.1 < 1
    · have hJ : J r p₁.1 p₂.1 = ∅ := by
        norm_num [J, B, hh]
      have he' := he.1
      have hJ' := hJ
      dsimp only [J] at hJ'
      simpa only [hJ, hJ', Finset.filter_empty, Finset.sum_empty] using he'.symm
    · exact (he.2 ((hlocal r p₁ hp₁ p₂ hp₂).2.1 (le_of_not_gt hh))).symm

open Classical in
theorem opening_selector_target_lower (C x «ω» δ ε M N R Q H γ : ℝ) (g : ℕ)
    (hC : 1 ≤ C) (hx : 1 ≤ x) (hM : 0 < M) (hN : 0 < N)
    (hR : 0 < R) (hQ : 0 < Q) (hg : 0 < g)
    (hMN : x / C ≤ M * N) (hNγ : N = x ^ γ)
    (hγ : γ ≤ 1 / 2 - 4 * «ω» - 2 * δ - 50 * ε)
    (hRQ : R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε))
    (hH : H = x ^ ε * R * Q ^ 2 / ((g : ℝ) * M)) :
    (g : ℝ) / C ^ 2 * x ^ (2 * «ω» + 2 * δ + 43 * ε) ≤
      x ^ (-5 * ε) * Q / H := by
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hxpos : 0 < x := zero_lt_one.trans_le hx
  have hgpos : 0 < (g : ℝ) := by exact_mod_cast hg
  have hp (a : ℝ) : 0 < x ^ a := Real.rpow_pos_of_pos hxpos a
  let X : ℝ := x ^ (-5 * ε) * Q / H
  let k : ℝ := 2 * «ω» + 2 * δ + 43 * ε
  let t : ℝ := 1 / 2 - 4 * «ω» - 2 * δ - 50 * ε
  let s : ℝ := 1 / 2 + 2 * «ω» + 7 * ε
  have hHpos : 0 < H := by rw [hH]; positivity
  have hXpos : 0 < X := by dsimp only [X]; positivity
  have hNupper : N ≤ x ^ t := by
    rw [hNγ]
    exact Real.rpow_le_rpow_of_exponent_le hx hγ
  have hXidentity : X * (R * Q) * x ^ (6 * ε) = (g : ℝ) * M := by
    have hpow6 : x ^ (6 * ε) = x ^ (5 * ε) * x ^ ε := by
      rw [← Real.rpow_add hxpos]
      congr 1
      ring
    dsimp only [X]
    rw [hH, show -5 * ε = -(5 * ε) by ring,
      Real.rpow_neg hxpos.le, hpow6]
    field_simp [hM.ne', hR.ne', hQ.ne', hgpos.ne', (hp ε).ne', (hp (5 * ε)).ne']
  have hDen : (R * Q) * x ^ (6 * ε) ≤ C * x ^ s := by
    calc
      (R * Q) * x ^ (6 * ε) ≤
          (C * x ^ (1 / 2 + 2 * «ω» + ε)) * x ^ (6 * ε) :=
        mul_le_mul_of_nonneg_right hRQ (hp (6 * ε)).le
      _ = C * x ^ s := by
        rw [mul_assoc, ← Real.rpow_add hxpos]
        congr 2
        dsimp only [s]
        ring
  have hMain : (g : ℝ) * x ≤ C ^ 2 * X * x ^ t * x ^ s := by
    calc
      (g : ℝ) * x ≤ (g : ℝ) * (C * (M * N)) :=
        mul_le_mul_of_nonneg_left
          (by simpa only [mul_comm] using (div_le_iff₀ hCpos).1 hMN) hgpos.le
      _ = C * X * ((R * Q) * x ^ (6 * ε)) * N := by
        rw [show C * X * ((R * Q) * x ^ (6 * ε)) * N =
            C * (X * (R * Q) * x ^ (6 * ε)) * N by ring,
          hXidentity]
        ring
      _ ≤ C * X * (C * x ^ s) * N :=
        mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left hDen (mul_pos hCpos hXpos).le) hN.le
      _ ≤ C * X * (C * x ^ s) * x ^ t :=
        mul_le_mul_of_nonneg_left hNupper (by positivity)
      _ = C ^ 2 * X * x ^ t * x ^ s := by ring
  have hPowers : x ^ k * (x ^ t * x ^ s) = x := by
    rw [← Real.rpow_add hxpos, ← Real.rpow_add hxpos]
    convert Real.rpow_one x using 1
    dsimp only [k, t, s]
    ring_nf
  have hLower : (g : ℝ) * x ^ k ≤ C ^ 2 * X := by
    refine le_of_mul_le_mul_right ?_ (mul_pos (hp t) (hp s))
    calc
      ((g : ℝ) * x ^ k) * (x ^ t * x ^ s) = (g : ℝ) * x := by
        rw [mul_assoc, hPowers]
      _ ≤ C ^ 2 * X * x ^ t * x ^ s := hMain
      _ = (C ^ 2 * X) * (x ^ t * x ^ s) := by ring
  have hdiv : ((g : ℝ) * x ^ k) / C ^ 2 ≤ X :=
    (div_le_iff₀ (pow_pos hCpos 2)).2 (by simpa only [mul_comm] using hLower)
  simpa only [X, k, div_mul_eq_mul_div] using hdiv

open Classical in
theorem opening_selector_target_window (C x ε Q H κ : ℝ) (g : ℕ)
    (hC : 1 ≤ C) (hx : 1 ≤ x) (hε : 0 ≤ ε) (hQ : 0 < Q) (hH : 1 ≤ H)
    (hg : 0 < g) (hthreshold : C ^ 2 ≤ x ^ κ)
    (hlower : (g : ℝ) / C ^ 2 * x ^ κ ≤ x ^ (-5 * ε) * Q / H) :
    1 ≤ x ^ (-5 * ε) * Q / H ∧ x ^ (-5 * ε) * Q / H ≤ Q := by
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hgpos : 0 < (g : ℝ) := by exact_mod_cast hg
  have hHpos : 0 < H := zero_lt_one.trans_le hH
  constructor
  · calc
      (1 : ℝ) ≤ g := by exact_mod_cast Nat.succ_le_of_lt hg
      _ = (g : ℝ) / C ^ 2 * C ^ 2 := by rw [div_mul_cancel₀ _ (pow_ne_zero _ hCpos.ne')]
      _ ≤ (g : ℝ) / C ^ 2 * x ^ κ :=
        mul_le_mul_of_nonneg_left hthreshold (div_pos hgpos (pow_pos hCpos 2)).le
      _ ≤ x ^ (-5 * ε) * Q / H := hlower
  · apply (div_le_iff₀ hHpos).2
    calc
      x ^ (-5 * ε) * Q ≤ Q :=
        mul_le_of_le_one_left hQ.le
          (Real.rpow_le_one_of_one_le_of_nonpos hx (by linarith only [hε]))
      _ ≤ Q * H := le_mul_of_one_le_right hQ.le hH

open Classical in
theorem opening_dense_quotient_selector (Y : Set.Ici (1 : ℝ)) (Q X : ℝ)
    (hQ : 0 < Q) (hX : 1 ≤ X) (hXQ : X ≤ Q) (g q : ℕ)
    (hg : 0 < g) (hgq : g ∣ q) (hqlo : Q ≤ (q : ℝ))
    (hqhi : (q : ℝ) ≤ 2 * Q)
    (hdense : Nonempty (DenseDivisibilityWitness Y 1 q)) :
    ∃ u : ℕ, let v := (q / g) / u
      0 < u ∧ 0 < v ∧ u ∣ q / g ∧ g * u * v = q ∧
      X / ((g : ℝ) * (Y : ℝ)) ≤ (u : ℝ) ∧ (u : ℝ) ≤ X ∧
      Q / ((g : ℝ) * X) ≤ (v : ℝ) ∧
      (v : ℝ) ≤ 2 * Q * (Y : ℝ) / X := by
  have hgpos : 0 < (g : ℝ) := by exact_mod_cast hg
  have hgOne : (1 : ℝ) ≤ g := by exact_mod_cast Nat.succ_le_of_lt hg
  have hYpos : 0 < (Y : ℝ) := zero_lt_one.trans_le Y.property
  have hqpos : 0 < q := by exact_mod_cast hQ.trans_le hqlo
  have hnpos : 0 < q / g := Nat.div_pos (Nat.le_of_dvd hqpos hgq) hg
  have hXpos : 0 < X := zero_lt_one.trans_le hX
  let Z : Set.Ici (1 : ℝ) := ⟨(g : ℝ) * (Y : ℝ),
    hgOne.trans (le_mul_of_one_le_right hgpos.le Y.property)⟩
  have hquot := single_dense_div (Z := Z)
    hdense hg hgq (le_refl ((g : ℝ) * (Y : ℝ)))
  obtain ⟨u, hu, hulo, huhi⟩ :
      ∃ u : ℕ, u ∣ q / g ∧ X / ((g : ℝ) * (Y : ℝ)) ≤ (u : ℝ) ∧
        (u : ℝ) ≤ X := by
    by_cases hXn : X ≤ (q / g : ℕ)
    · exact (single_dense_iff.mp hquot).2 X hX hXn
    · refine ⟨q / g, dvd_rfl, ?_, (lt_of_not_ge hXn).le⟩
      apply (div_le_iff₀ (mul_pos hgpos hYpos)).2
      calc
        X ≤ Q := hXQ
        _ ≤ (q : ℝ) := hqlo
        _ = (q / g : ℕ) * (g : ℝ) := by
          exact_mod_cast (Nat.div_mul_cancel hgq).symm
        _ ≤ ((q / g : ℕ) : ℝ) * ((g : ℝ) * (Y : ℝ)) := by
          simpa only [mul_assoc] using
            le_mul_of_one_le_right (mul_nonneg (Nat.cast_nonneg _) hgpos.le) Y.property
  let v : ℕ := (q / g) / u
  have hupos : 0 < u := Nat.pos_of_dvd_of_pos hu hnpos
  have hvpos : 0 < v := Nat.div_pos (Nat.le_of_dvd hnpos hu) hupos
  have huv : u * v = q / g := by
    dsimp only [v]
    simpa only [Nat.mul_comm] using Nat.div_mul_cancel hu
  have hproduct : g * u * v = q := by
    rw [Nat.mul_assoc, huv, Nat.mul_comm]
    exact Nat.div_mul_cancel hgq
  have hreal : (g : ℝ) * (u : ℝ) * (v : ℝ) = (q : ℝ) := by
    exact_mod_cast hproduct
  have hvlo : Q / ((g : ℝ) * X) ≤ (v : ℝ) := by
    apply (div_le_iff₀ (mul_pos hgpos hXpos)).2
    calc
      Q ≤ (q : ℝ) := hqlo
      _ = (v : ℝ) * ((g : ℝ) * (u : ℝ)) := by rw [← hreal]; ring
      _ ≤ (v : ℝ) * ((g : ℝ) * X) :=
        mul_le_mul_of_nonneg_left
          (mul_le_mul_of_nonneg_left huhi hgpos.le) (Nat.cast_nonneg v)
  have hvhi : (v : ℝ) ≤ 2 * Q * (Y : ℝ) / X := by
    apply (le_div_iff₀ hXpos).2
    calc
      (v : ℝ) * X ≤ (v : ℝ) * ((u : ℝ) * ((g : ℝ) * (Y : ℝ))) :=
        mul_le_mul_of_nonneg_left
          ((div_le_iff₀ (mul_pos hgpos hYpos)).1 hulo) (Nat.cast_nonneg v)
      _ = (q : ℝ) * (Y : ℝ) := by rw [← hreal]; ring
      _ ≤ (2 * Q) * (Y : ℝ) := mul_le_mul_of_nonneg_right hqhi hYpos.le
  exact ⟨u, hupos, hvpos, hu, hproduct, hulo, huhi, hvlo, hvhi⟩

open Classical in
theorem opening_coherent_dense_selector (Y : Set.Ici (1 : ℝ)) (Q : ℝ) (hQ : 0 < Q)
    (X : ℕ → ℝ) :
    ∃ u : ℕ → ℕ → ℕ, ∀ (g q : ℕ),
      0 < g → g ∣ q → Q ≤ (q : ℝ) → (q : ℝ) ≤ 2 * Q →
      Nonempty (DenseDivisibilityWitness Y 1 q) →
      1 ≤ X g → X g ≤ Q →
      let v := (q / g) / u g q
      0 < u g q ∧ 0 < v ∧ u g q ∣ q / g ∧ g * u g q * v = q ∧
      X g / ((g : ℝ) * (Y : ℝ)) ≤ (u g q : ℝ) ∧ (u g q : ℝ) ≤ X g ∧
      Q / ((g : ℝ) * X g) ≤ (v : ℝ) ∧
      (v : ℝ) ≤ 2 * Q * (Y : ℝ) / X g := by
  have hex (g q : ℕ) : ∃ u : ℕ,
      0 < g → g ∣ q → Q ≤ (q : ℝ) → (q : ℝ) ≤ 2 * Q →
      Nonempty (DenseDivisibilityWitness Y 1 q) →
      1 ≤ X g → X g ≤ Q →
      let v := (q / g) / u
      0 < u ∧ 0 < v ∧ u ∣ q / g ∧ g * u * v = q ∧
      X g / ((g : ℝ) * (Y : ℝ)) ≤ (u : ℝ) ∧ (u : ℝ) ≤ X g ∧
      Q / ((g : ℝ) * X g) ≤ (v : ℝ) ∧
      (v : ℝ) ≤ 2 * Q * (Y : ℝ) / X g := by
    by_cases h : 0 < g ∧ g ∣ q ∧ Q ≤ (q : ℝ) ∧ (q : ℝ) ≤ 2 * Q ∧
        Nonempty (DenseDivisibilityWitness Y 1 q) ∧
        1 ≤ X g ∧ X g ≤ Q
    · obtain ⟨hg, hgq, hqlo, hqhi, hdense, hX, hXQ⟩ := h
      obtain ⟨u, hu⟩ := opening_dense_quotient_selector Y Q (X g) hQ hX hXQ g q
        hg hgq hqlo hqhi hdense
      exact ⟨u, fun _ _ _ _ _ _ _ => hu⟩
    · refine ⟨1, ?_⟩
      intro hg hgq hqlo hqhi hdense hX hXQ
      exact (h ⟨hg, hgq, hqlo, hqhi, hdense, hX, hXQ⟩).elim
  choose u hu using hex
  exact ⟨u, hu⟩

open Classical in
theorem opening_selected_dyadic_log_budget (x : ℝ) (hx : 1 ≤ x) (u : ℕ) (hu : 0 < u)
    (hux : (u : ℝ) ≤ x ^ 2) :
    Nat.log2 u ∈ Finset.range (⌊2 * Real.log x / Real.log 2⌋₊ + 1) ∧
    ((Finset.range (⌊2 * Real.log x / Real.log 2⌋₊ + 1)).card : ℝ) ≤
      2 * Real.log x / Real.log 2 + 1 := by
  have hlog2 : 0 < Real.log 2 := Real.log_pos (by norm_num)
  have hlogx : 0 ≤ Real.log x := Real.log_nonneg hx
  have hlog : Real.log (u : ℝ) ≤ 2 * Real.log x := by
    simpa only [Real.log_pow, Nat.cast_ofNat] using
      Real.log_le_log (by exact_mod_cast hu) hux
  have hindex : (Nat.log2 u : ℝ) ≤ 2 * Real.log x / Real.log 2 := by
    calc
      (Nat.log2 u : ℝ) ≤ Real.logb 2 (u : ℝ) := Real.log2_le_logb u
      _ ≤ 2 * Real.log x / Real.log 2 :=
        div_le_div_of_nonneg_right hlog hlog2.le
  refine ⟨Finset.mem_range.mpr (Nat.lt_succ_of_le (Nat.le_floor hindex)), ?_⟩
  have harg : 0 ≤ 2 * Real.log x / Real.log 2 :=
    div_nonneg (mul_nonneg (by norm_num) hlogx) hlog2.le
  simpa only [Finset.card_range, Nat.cast_add, Nat.cast_one] using
    add_le_add_left (Nat.floor_le harg) 1

open Classical in
theorem opening_one_bin_geometry (x δ ε Q H U : ℝ) (g u v : ℕ)
    (hx : 1 ≤ x) (hQ : 0 < Q) (hH : 0 < H) (hU : 0 < U) (hg : 0 < g)
    (huLo : U ≤ (u : ℝ)) (huHi : (u : ℝ) ≤ 2 * U)
    (hqLo : Q ≤ (g : ℝ) * u * v) (hqHi : (g : ℝ) * u * v ≤ 2 * Q)
    (hSelectedLo : (x ^ (-5 * ε) * Q / H) / ((g : ℝ) * x ^ δ) ≤ (u : ℝ))
    (hSelectedHi : (u : ℝ) ≤ x ^ (-5 * ε) * Q / H) :
    let V : ℝ := Q / ((g : ℝ) * U)
    0 < U ∧ 0 < V ∧ U * V = Q / (g : ℝ) ∧
    U ≤ (u : ℝ) ∧ (u : ℝ) ≤ 2 * U ∧
    V / 2 ≤ (v : ℝ) ∧ (v : ℝ) ≤ 2 * V ∧
    x ^ (-δ - 5 * ε) * Q / ((g : ℝ) * H) ≤ 2 * U ∧
    U ≤ x ^ (-5 * ε) * Q / H ∧
    x ^ (5 * ε) * H / (g : ℝ) ≤ V ∧
    V ≤ 2 * x ^ (δ + 5 * ε) * H := by
  have hxpos : 0 < x := zero_lt_one.trans_le hx
  have hgpos : 0 < (g : ℝ) := by exact_mod_cast hg
  have hgu : 0 < (g : ℝ) * U := mul_pos hgpos hU
  have hp (a : ℝ) : 0 < x ^ a := Real.rpow_pos_of_pos hxpos a
  let X : ℝ := x ^ (-5 * ε) * Q / H
  have hXpos : 0 < X := by dsimp only [X]; positivity
  have hUX : U ≤ X := huLo.trans hSelectedHi
  intro V
  have hVpos : 0 < V := div_pos hQ hgu
  have hProduct : ((g : ℝ) * U) * V = Q := by
    dsimp only [V]
    rw [mul_div_cancel₀ _ hgu.ne']
  have hUV : U * V = Q / (g : ℝ) := by
    apply (eq_div_iff hgpos.ne').2
    simpa only [mul_assoc, mul_comm, mul_left_comm] using hProduct
  have hvLower : V / 2 ≤ (v : ℝ) := by
    apply (div_le_iff₀ (by norm_num : (0 : ℝ) < 2)).2
    refine le_of_mul_le_mul_left ?_ hgu
    calc
      ((g : ℝ) * U) * V = Q := hProduct
      _ ≤ (g : ℝ) * u * v := hqLo
      _ ≤ ((g : ℝ) * (2 * U)) * v :=
        mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left huHi hgpos.le) (Nat.cast_nonneg v)
      _ = ((g : ℝ) * U) * ((v : ℝ) * 2) := by ring
  have hvUpper : (v : ℝ) ≤ 2 * V := by
    refine le_of_mul_le_mul_left ?_ hgu
    calc
      ((g : ℝ) * U) * v ≤ (g : ℝ) * u * v :=
        mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left huLo hgpos.le) (Nat.cast_nonneg v)
      _ ≤ 2 * Q := hqHi
      _ = ((g : ℝ) * U) * (2 * V) := by rw [← hProduct]; ring
  have hUIdentity : X / ((g : ℝ) * x ^ δ) =
      x ^ (-δ - 5 * ε) * Q / ((g : ℝ) * H) := by
    dsimp only [X]
    rw [show -δ - 5 * ε = (-5 * ε) - δ by ring, Real.rpow_sub hxpos]
    field_simp [hgpos.ne', hH.ne', (hp δ).ne']
  have hVLowIdentity : Q / ((g : ℝ) * X) =
      x ^ (5 * ε) * H / (g : ℝ) := by
    dsimp only [X]
    rw [show -5 * ε = -(5 * ε) by ring, Real.rpow_neg hxpos.le]
    field_simp [hgpos.ne', hQ.ne', hH.ne', (hp (5 * ε)).ne']
  have hVHighIdentity : 2 * Q * x ^ δ / X = 2 * x ^ (δ + 5 * ε) * H := by
    dsimp only [X]
    rw [Real.rpow_add hxpos, show -5 * ε = -(5 * ε) by ring,
      Real.rpow_neg hxpos.le]
    field_simp [hQ.ne', hH.ne', (hp (5 * ε)).ne']
  have hSourceVLower : x ^ (5 * ε) * H / (g : ℝ) ≤ V := by
    rw [← hVLowIdentity]
    exact div_le_div_of_nonneg_left hQ.le hgu
      (mul_le_mul_of_nonneg_left hUX hgpos.le)
  have hSourceVUpper : V ≤ 2 * x ^ (δ + 5 * ε) * H := by
    rw [← hVHighIdentity]
    apply (le_div_iff₀ hXpos).2
    calc
      V * X ≤ V * ((u : ℝ) * ((g : ℝ) * x ^ δ)) :=
        mul_le_mul_of_nonneg_left
          ((div_le_iff₀ (mul_pos hgpos (hp δ))).1 hSelectedLo) hVpos.le
      _ ≤ V * ((2 * U) * ((g : ℝ) * x ^ δ)) :=
        mul_le_mul_of_nonneg_left
          (mul_le_mul_of_nonneg_right huHi (mul_pos hgpos (hp δ)).le) hVpos.le
      _ = 2 * Q * x ^ δ := by rw [← hProduct]; ring
  exact ⟨hU, hVpos, hUV, huLo, huHi, hvLower, hvUpper,
    (by rw [← hUIdentity]; exact hSelectedLo.trans huHi), hUX,
    hSourceVLower, hSourceVUpper⟩

open Classical in
theorem opening_band_cauchy
    (𝒜 : Finset (ℕ × ℕ × ℕ × ℕ)) (β : ℕ →₀ ℂ)
    (c : ℕ × ℕ → ℂ) (q₀ a b₁ b₂ : ℕ) (ℓ : ℤ) (J : Finset ℤ)
    (ψM χ : ℝ → ℝ) (C K x ε cN TN M N R Q U V : ℝ)
    (hq₀ : 0 < q₀) (hC : 0 ≤ C) (hK : 0 ≤ K) (hx : 0 < x)
    (hcN : 0 < cN) (hcNT : cN ≤ TN)
    (hM : 0 < M) (hN : 0 < N) (hR : 0 < R) (hQ : 0 < Q)
    (hU : 0 ≤ U) (hV : 0 ≤ V)
    (hUV : U * V ≤ C * Q / (q₀ : ℝ))
    (hχsupport : Function.support χ ⊆ Set.Icc cN TN)
    (hχnonneg : ∀ t : ℝ, 0 ≤ χ t)
    (hχmajor : ∀ n ∈ β.support, 1 ≤ χ ((n : ℝ) / N))
    (h𝒜 : ∀ t ∈ 𝒜,
      0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
      R ≤ (t.1 : ℝ) ∧ Q ≤ ((q₀ * t.2.1 * t.2.2.1 : ℕ) : ℝ) ∧
      Q ≤ ((q₀ * t.2.2.2 : ℕ) : ℝ))
    (hc : ∀ t ∈ 𝒜,
      ‖c (q₀ * t.2.1 * t.2.2.1, t.1)‖ ≤ 1 ∧
      ‖c (q₀ * t.2.2.2, t.1)‖ ≤ 1) :
    let γ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
    let P : (ℕ × ℕ × ℕ × ℕ) → ℕ := fun t =>
      t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2
    let B : Finset (ℕ × ℕ × ℕ) :=
      𝒜.image (fun t => (t.1, t.2.1, t.2.2.2))
    let Γ : ℝ := ∑ t ∈ B, ∑ n ∈ γ.support,
      if Int.gcd n ((t.1 * q₀ * t.2.1 : ℕ) : ℤ) = 1 ∧
          Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2 : ℕ) : ℤ) = 1
      then sourceCompatibility t.1 q₀ b₁ b₂ ℓ n *
        ‖γ n * star (γ (n + ℓ * (t.1 : ℤ)))‖ ^ 2
      else 0
    let Ω := (𝒜 ×ˢ 𝒜).filter (fun p =>
      p.2.1 = p.1.1 ∧ p.2.2.1 = p.1.2.1 ∧
        p.2.2.2.2 = p.1.2.2.2)
    let 𝒯 : Finset (ℕ × ℕ × ℕ × ℕ × ℕ) := Ω.image (fun p =>
      (p.1.1, p.1.2.1, p.1.2.2.1, p.2.2.2.1, p.1.2.2.2))
    Γ ≤ x ^ ε * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * R * Q * U * N /
        (q₀ : ℝ) ^ 2 →
    (∑ t ∈ 𝒯,
      ‖sourceSignedDispersionFrequencyBlock (J ×ˢ J)
        ψM (fun z => χ (z / N)) M
        t.1 q₀ t.2.1 t.2.2.1 t.2.2.2.1 t.2.2.2.2
        (a : ℤ) (b₁ : ℤ) (b₂ : ℤ) ℓ‖) ≤
      K * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * R * Q * N * U * V ^ 2 *
        x ^ (-4 * ε) →
    (∑ t ∈ 𝒜,
      ‖c (q₀ * t.2.1 * t.2.2.1, t.1) *
        star (c (q₀ * t.2.2.2, t.1)) * ((M : ℂ) / (P t : ℂ)) *
          ∑ n ∈ γ.support.filter (fun n =>
            Int.gcd n ((t.1 * q₀ * t.2.1 * t.2.2.1 : ℕ) : ℤ) = 1 ∧
            Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2.2 : ℕ) : ℤ) = 1),
            γ n * star (γ (n + ℓ * (t.1 : ℤ))) *
              (sourceCompatibility t.1 q₀ b₁ b₂ ℓ n : ℂ) *
                ∑ h ∈ J, sourcePhi ψM M (P t) h *
                  sourceTheta t.1 q₀ t.2.1 t.2.2.1 t.2.2.2
                    a b₁ b₂ ℓ n h‖) ≤
      C * Real.sqrt K * M * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) /
        (q₀ : ℝ) * x ^ (-3 * ε / 2) := by
  intro γ P B Γ Ω 𝒯 hΓ hSigned
  let : NeZero q₀ := ⟨hq₀.ne'⟩
  have hqreal : (0 : ℝ) < q₀ := Nat.cast_pos.mpr hq₀
  have hPair :=
    (sourceSigmaOne_pairFamily_eq 𝒜 J ψM (fun z => χ (z / N))
      M q₀ a b₁ b₂ ℓ).2.2
  change sourceSigmaOne 𝒜 J ψM (fun z => χ (z / N)) M q₀ a b₁ b₂ ℓ =
    ∑ t ∈ 𝒯, ‖sourceDispersionFrequencyBlock (J ×ˢ J)
      ψM (fun z => χ (z / N)) M
      t.1 q₀ t.2.1 t.2.2.1 t.2.2.2.1 t.2.2.2.2 a b₁ b₂ ℓ‖ at hPair
  have hNaturalSigned :
      sourceSigmaOne 𝒜 J ψM (fun z => χ (z / N)) M q₀ a b₁ b₂ ℓ =
        ∑ t ∈ 𝒯, ‖sourceSignedDispersionFrequencyBlock (J ×ˢ J)
          ψM (fun z => χ (z / N)) M
          t.1 q₀ t.2.1 t.2.2.1 t.2.2.2.1 t.2.2.2.2
          (a : ℤ) (b₁ : ℤ) (b₂ : ℤ) ℓ‖ := by
    rw [hPair]
    apply Finset.sum_congr rfl
    intro t _
    congr 1
    simp only [sourceDispersionFrequencyBlock, sourceSignedDispersionFrequencyBlock,
      sourceCompatibility, sourceTheta, Int.cast_natCast,
      apply_ite Complex.ofReal, Complex.ofReal_zero]
  have hSigmanonneg :
      0 ≤ sourceSigmaOne 𝒜 J ψM (fun z => χ (z / N)) M q₀ a b₁ b₂ ℓ := by
    rw [hPair]
    exact Finset.sum_nonneg fun _ _ => norm_nonneg _
  have hSigma :
      sourceSigmaOne 𝒜 J ψM (fun z => χ (z / N)) M q₀ a b₁ b₂ ℓ ≤
        K * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * R * Q * N * U * V ^ 2 *
          x ^ (-4 * ε) := by
    rw [hNaturalSigned]
    exact hSigned
  have hUVsq : (U * V) ^ 2 ≤ (C * Q / (q₀ : ℝ)) ^ 2 :=
    (sq_le_sq₀ (mul_nonneg hU hV)
      (div_nonneg (mul_nonneg hC hQ.le) hqreal.le)).mpr hUV
  have hPower : x ^ ε * x ^ (-4 * ε) = x ^ (-3 * ε) := by
    rw [← Real.rpow_add hx]
    congr 1
    ring
  have hHalfPower : (x ^ (-3 * ε / 2)) ^ 2 = x ^ (-3 * ε) := by
    rw [← Real.rpow_mul_natCast hx.le]
    congr 1
    ring
  apply (sq_le_sq₀ (Finset.sum_nonneg fun _ _ => norm_nonneg _)
    (by positivity)).mp
  calc
    _ ≤ (M * (q₀ : ℝ) / (R * Q ^ 2)) ^ 2 * Γ *
        sourceSigmaOne 𝒜 J ψM (fun z => χ (z / N)) M q₀ a b₁ b₂ ℓ :=
      sourceSigmaOne_coefficient_cauchy 𝒜 β c q₀ a b₁ b₂ ℓ J ψM χ
        cN TN M N R Q hcN hcNT hM hN hR hQ
        hχsupport hχnonneg hχmajor h𝒜 hc
    _ ≤ (M * (q₀ : ℝ) / (R * Q ^ 2)) ^ 2 *
        ((x ^ ε * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * R * Q * U * N /
          (q₀ : ℝ) ^ 2) *
        (K * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * R * Q * N * U * V ^ 2 *
          x ^ (-4 * ε))) := by
      rw [mul_assoc]
      exact mul_le_mul_of_nonneg_left
        (mul_le_mul hΓ hSigma hSigmanonneg (by positivity)) (sq_nonneg _)
    _ = K * (M * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) / Q) ^ 2 *
        (U * V) ^ 2 * x ^ (-3 * ε) := by
      calc
        _ = K * (M * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) / Q) ^ 2 *
            (U * V) ^ 2 * (x ^ ε * x ^ (-4 * ε)) := by
          field_simp [hR.ne', hQ.ne', hqreal.ne']
        _ = _ := by rw [hPower]
    _ ≤ K * (M * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) / Q) ^ 2 *
        (C * Q / (q₀ : ℝ)) ^ 2 * x ^ (-3 * ε) :=
      mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_left hUVsq (mul_nonneg hK (sq_nonneg _)))
        (Real.rpow_nonneg hx.le _)
    _ = (C * Real.sqrt K * M * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) /
        (q₀ : ℝ) * x ^ (-3 * ε / 2)) ^ 2 := by
      simp only [mul_pow, div_pow, Real.sq_sqrt hK, hHalfPower]
      field_simp [hQ.ne', hqreal.ne']

open Classical in
theorem opening_gcd_average (G : Finset ℕ) (Q L : ℕ)
    (hG : ∀ g ∈ G, 0 < g ∧ g ≤ Q) :
    (∑ g ∈ G, ∑ ℓ ∈ (Finset.Icc (-(L : ℤ)) (L : ℤ)).erase 0,
      (Int.gcd (g : ℤ) ℓ : ℝ) / (g : ℝ)) ≤
      2 * (L : ℝ) * (harmonic Q : ℝ) ^ 2 := by
  have hwindow :
      (Finset.Icc (-(L : ℤ)) (L : ℤ)).erase 0 =
        Finset.Icc (1 : ℤ) (L : ℤ) ∪ Finset.Icc (-(L : ℤ)) (-1) := by
    ext ℓ
    simp only [Finset.mem_erase, Finset.mem_Icc, Finset.mem_union]
    omega
  have hdisjoint : Disjoint (Finset.Icc (1 : ℤ) (L : ℤ))
      (Finset.Icc (-(L : ℤ)) (-1)) := by
    rw [Finset.disjoint_left]
    intro ℓ hpos hneg
    simp only [Finset.mem_Icc] at hpos hneg
    omega
  have hSigned (g : ℕ) :
      (∑ ℓ ∈ (Finset.Icc (-(L : ℤ)) (L : ℤ)).erase 0,
        (Int.gcd (g : ℤ) ℓ : ℝ) / (g : ℝ)) =
        2 * ((∑ h ∈ Finset.Icc 1 L, (Nat.gcd g h : ℝ)) / (g : ℝ)) := by
    have hpos :
        (∑ h ∈ Finset.Icc 1 L, (Nat.gcd g h : ℝ) / (g : ℝ)) =
          ∑ ℓ ∈ Finset.Icc (1 : ℤ) (L : ℤ),
            (Int.gcd (g : ℤ) ℓ : ℝ) / (g : ℝ) := by
      refine Finset.sum_bij (fun h _ => (h : ℤ)) ?_ ?_ ?_ ?_
      · intro h hh
        exact Finset.mem_Icc.mpr
          ⟨by exact_mod_cast (Finset.mem_Icc.mp hh).1,
            by exact_mod_cast (Finset.mem_Icc.mp hh).2⟩
      · intro h₁ _ h₂ _ he
        exact_mod_cast he
      · intro ℓ hℓ
        have hℓbounds := Finset.mem_Icc.mp hℓ
        have hℓcast : (ℓ.toNat : ℤ) = ℓ :=
          Int.toNat_of_nonneg (by omega)
        refine ⟨ℓ.toNat, Finset.mem_Icc.mpr ⟨?_, ?_⟩, hℓcast⟩ <;> omega
      · intro h _
        simp only [Int.gcd_natCast_natCast]
    have hneg :
        (∑ ℓ ∈ Finset.Icc (-(L : ℤ)) (-1),
          (Int.gcd (g : ℤ) ℓ : ℝ) / (g : ℝ)) =
          ∑ ℓ ∈ Finset.Icc (1 : ℤ) (L : ℤ),
            (Int.gcd (g : ℤ) ℓ : ℝ) / (g : ℝ) := by
      refine Finset.sum_bij (fun ℓ _ => -ℓ) ?_ ?_ ?_ ?_
      · intro ℓ hℓ
        simp only [Finset.mem_Icc] at hℓ ⊢
        omega
      · intro ℓ₁ _ ℓ₂ _ he
        exact neg_injective he
      · intro ℓ hℓ
        refine ⟨-ℓ, ?_, neg_neg ℓ⟩
        simp only [Finset.mem_Icc] at hℓ ⊢
        omega
      · intro ℓ _
        simp only [Int.gcd_neg]
    rw [hwindow, Finset.sum_union hdisjoint, hneg]
    simp_rw [← hpos, ← Finset.sum_div]
    ring
  have hsubset : G ⊆ Finset.Icc 1 Q := by
    intro g hg
    exact Finset.mem_Icc.mpr (hG g hg)
  calc
    _ ≤ ∑ g ∈ G, 2 * (L : ℝ) * ((g.divisors.card : ℝ) / (g : ℝ)) := by
      apply Finset.sum_le_sum
      intro g hg
      rw [hSigned]
      calc
        _ ≤ 2 * (((L : ℝ) * (g.divisors.card : ℝ)) / (g : ℝ)) :=
          mul_le_mul_of_nonneg_left
            (div_le_div_of_nonneg_right
              (reciprocal_differencing_gcd_sums g L (hG g hg).1).1
              (Nat.cast_nonneg g)) (by norm_num)
        _ = _ := by ring
    _ ≤ ∑ g ∈ Finset.Icc 1 Q,
        2 * (L : ℝ) * ((g.divisors.card : ℝ) / (g : ℝ)) :=
      Finset.sum_le_sum_of_subset_of_nonneg hsubset (fun _ _ _ => by positivity)
    _ = 2 * (L : ℝ) *
        ∑ g ∈ Finset.Icc 1 Q, (g.divisors.card : ℝ) / (g : ℝ) := by
      rw [Finset.mul_sum]
    _ ≤ 2 * (L : ℝ) *
        ∑ g ∈ Finset.Icc 1 Q,
          (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 2) g : ℝ) /
            (g : ℝ) := by
      apply mul_le_mul_of_nonneg_left _ (by positivity)
      apply Finset.sum_le_sum
      intro g hg
      have hcard : g.divisors.card ≤
          ((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 2) g := by
        simpa only [pow_one] using
          card_divisors_pow_le_zeta_pow 1 g
            (Finset.mem_Icc.mp hg).1
      have hcardReal : (g.divisors.card : ℝ) ≤
          (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 2) g : ℝ) := by
        exact_mod_cast hcard
      exact div_le_div_of_nonneg_right hcardReal (Nat.cast_nonneg g)
    _ ≤ _ := mul_le_mul_of_nonneg_left
      (sum_zeta_pow_div_le_harmonic_pow 2 Q)
      (by positivity)

open Classical in
theorem opening_harmonic_log (x : ℝ) (hx : Real.exp 1 ≤ x) (Q : ℕ)
    (hQ : (Q : ℝ) ≤ x ^ 2) :
    (harmonic Q : ℝ) ≤ 3 * Real.log x := by
  have hlog : 1 ≤ Real.log x := by
    calc
      1 = Real.log (Real.exp 1) := (Real.log_exp 1).symm
      _ ≤ Real.log x := Real.log_le_log (Real.exp_pos 1) hx
  by_cases hQzero : Q = 0
  · subst Q
    simpa using (show (0 : ℝ) ≤ 3 * Real.log x by linarith only [hlog])
  · have hlogQ : Real.log (Q : ℝ) ≤ 2 * Real.log x := by
      calc
        _ ≤ Real.log (x ^ 2) :=
          Real.log_le_log (Nat.cast_pos.mpr (Nat.pos_of_ne_zero hQzero)) hQ
        _ = _ := by rw [Real.log_pow]; norm_num
    exact (harmonic_le_one_add_log Q).trans (by linarith only [hlog, hlogQ])

open Classical in
theorem opening_scale_resources (C «ω» δ ε : ℝ)
    (hC : 1 ≤ C) (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε)
    (hworking : 72 * «ω» + 24 * δ < 1) (hsmall : ε < δ / 10 ^ 100) :
    ∀ᶠ x : ℝ in Filter.atTop,
      Real.exp 1 ≤ x ∧ 2 ≤ x ∧ C ^ 2 ≤ x ^ (2 * «ω» + 2 * δ + 43 * ε) ∧
      ∀ M N R Q γ : ℝ,
        0 < M → 0 < N → 0 < R → 0 < Q →
        x / C ≤ M * N → M * N ≤ C * x → N = x ^ γ →
        max (1 / 4 + 12 * «ω» + 4 * δ + 100 * ε)
          (32 * «ω» + 10 * δ + 400 * ε) ≤ γ →
        γ ≤ 1 / 2 - 4 * «ω» - 2 * δ - 50 * ε →
        N ≤ C * x ^ (δ + 4 * ε) * R →
        R ≤ C * x ^ (-2 * ε) * N →
        R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) →
        1 ≤ N ∧ N ≤ x ∧ 1 ≤ M ∧ M ≤ x ^ 2 ∧ R ≤ x ∧ Q ≤ x ∧
          4 * x ^ ε < M := by
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hεδ : ε < δ :=
    hsmall.trans_le (div_le_self hδ.le (by norm_num))
  have hεhalf : ε < 1 / 2 := by
    linarith only [hεδ, hworking, hω]
  have hmargin : 0 < 2 * «ω» + 2 * δ + 43 * ε := by positivity
  have hCmargin : ∀ᶠ x : ℝ in Filter.atTop,
      C ^ 2 ≤ x ^ (2 * «ω» + 2 * δ + 43 * ε) :=
    (tendsto_rpow_atTop hmargin).eventually_ge_atTop (C ^ 2)
  have hCquarter : ∀ᶠ x : ℝ in Filter.atTop, C ^ 2 ≤ x ^ (1 / 4 : ℝ) :=
    (tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 4)).eventually_ge_atTop
      (C ^ 2)
  have hCutoff := eventually_scale_dominates_cutoff_of_product_lower
    (1 / C) 1 (1 / 2) ε 4 (by positivity) (by norm_num) (by norm_num)
    (by linarith only [hεhalf])
  filter_upwards [Filter.eventually_ge_atTop (Real.exp 1),
    Filter.eventually_ge_atTop (2 : ℝ), hCmargin, hCquarter, hCutoff]
    with x hxe hx2 hCmarginAt hCquarterAt hCutoffAt
  refine ⟨hxe, hx2, hCmarginAt, ?_⟩
  intro M N R Q γ hM hN _hR hQ hMNlo hMNhi hNγ hγlo hγhi hNR hRupper hRQ
  have hxone : 1 ≤ x := (by norm_num : (1 : ℝ) ≤ 2).trans hx2
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  have hγlower : 1 / 4 + 12 * «ω» + 4 * δ + 100 * ε ≤ γ :=
    (le_max_left _ _).trans hγlo
  have hγnonneg : 0 ≤ γ := by linarith only [hγlower, hω, hδ, hε]
  have hγhalf : γ ≤ 1 / 2 := by linarith only [hγhi, hω, hδ, hε]
  have hNhalf : N ≤ x ^ (1 / 2 : ℝ) := by
    rw [hNγ]
    exact Real.rpow_le_rpow_of_exponent_le hxone hγhalf
  have hhalf : x ^ (1 / 2 : ℝ) ≤ x := by
    simpa only [Real.rpow_one] using
      Real.rpow_le_rpow_of_exponent_le hxone (by norm_num : (1 / 2 : ℝ) ≤ 1)
  have hNone : 1 ≤ N := by
    rw [hNγ]
    exact Real.one_le_rpow hxone hγnonneg
  have hCpow : C ≤ C ^ 2 := by
    simpa only [mul_one, pow_two] using mul_le_mul_of_nonneg_left hC hCpos.le
  have hCquarterBound : C ≤ x ^ (1 / 4 : ℝ) := hCpow.trans hCquarterAt
  have hChalf : C ≤ x ^ (1 / 2 : ℝ) := hCquarterBound.trans
    (Real.rpow_le_rpow_of_exponent_le hxone (by norm_num : (1 / 4 : ℝ) ≤ 1 / 2))
  have hCx : C ≤ x := hChalf.trans hhalf
  have hMcut : 4 * x ^ ε < M := hCutoffAt M N hN
    (by simpa only [one_mul] using hNhalf)
    (by simpa only [one_div, div_eq_mul_inv, mul_comm, mul_one] using hMNlo)
  have hMone : 1 ≤ M := by
    have hxeone : 1 ≤ x ^ ε := Real.one_le_rpow hxone hε.le
    linarith only [hMcut, hxeone]
  have hMupper : M ≤ x ^ 2 := by
    calc
      M ≤ M * N := le_mul_of_one_le_right hM.le hNone
      _ ≤ C * x := hMNhi
      _ ≤ x * x := mul_le_mul_of_nonneg_right hCx hxpos.le
      _ = x ^ 2 := (pow_two x).symm
  have hRsmall : R ≤ x := by
    have hxnegative : x ^ (-2 * ε) ≤ 1 :=
      Real.rpow_le_one_of_one_le_of_nonpos hxone (by linarith only [hε])
    calc
      R ≤ C * x ^ (-2 * ε) * N := hRupper
      _ ≤ C * 1 * N := mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_left hxnegative hCpos.le) hN.le
      _ = C * N := by ring
      _ ≤ x ^ (1 / 2 : ℝ) * x ^ (1 / 2 : ℝ) :=
        mul_le_mul hChalf hNhalf hN.le (Real.rpow_nonneg hxpos.le _)
      _ = x := by rw [← Real.rpow_add hxpos]; norm_num
  have hQN : Q * N ≤ C ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε) := by
    calc
      Q * N ≤ Q * (C * x ^ (δ + 4 * ε) * R) :=
        mul_le_mul_of_nonneg_left hNR hQ.le
      _ = (C * x ^ (δ + 4 * ε)) * (R * Q) := by ring
      _ ≤ (C * x ^ (δ + 4 * ε)) * (C * x ^ (1 / 2 + 2 * «ω» + ε)) :=
        mul_le_mul_of_nonneg_left hRQ (by positivity)
      _ = C ^ 2 * (x ^ (δ + 4 * ε) * x ^ (1 / 2 + 2 * «ω» + ε)) := by ring
      _ = C ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε) := by
        rw [← Real.rpow_add hxpos,
          show δ + 4 * ε + (1 / 2 + 2 * «ω» + ε) =
            1 / 2 + 2 * «ω» + δ + 5 * ε by ring]
  have hQsmall : Q ≤ x := by
    have hpower : 1 / 2 + 2 * «ω» + δ + 5 * ε - γ ≤ 1 / 4 := by
      linarith only [hγlower, hω, hδ, hε]
    calc
      Q ≤ (C ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε)) / N :=
        (le_div_iff₀ hN).mpr hQN
      _ = C ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε - γ) := by
        rw [hNγ, mul_div_assoc, ← Real.rpow_sub hxpos]
      _ ≤ C ^ 2 * x ^ (1 / 4 : ℝ) := mul_le_mul_of_nonneg_left
        (Real.rpow_le_rpow_of_exponent_le hxone hpower) (sq_nonneg C)
      _ ≤ x ^ (1 / 4 : ℝ) * x ^ (1 / 4 : ℝ) :=
        mul_le_mul_of_nonneg_right hCquarterAt (Real.rpow_nonneg hxpos.le _)
      _ = x ^ (1 / 2 : ℝ) := by rw [← Real.rpow_add hxpos]; norm_num
      _ ≤ x := hhalf
  exact ⟨hNone, hNhalf.trans hhalf, hMone, hMupper, hRsmall, hQsmall, hMcut⟩

open Classical in
theorem opening_frequency_cutoff_power_bounds (x ε M R Q : ℝ) (g : ℕ)
    (hx : 2 ≤ x) (hε : ε ≤ 1) (hM : 1 ≤ M)
    (hR : 0 ≤ R) (hQ : 0 ≤ Q) (hRupper : R ≤ x) (hQupper : Q ≤ x)
    (hg : 0 < g) :
    x ^ ε * R * Q ^ 2 / ((g : ℝ) * M) ≤ x ^ 4 ∧ 2 * Q ≤ x ^ 2 := by
  have hxone : 1 ≤ x := (by norm_num : (1 : ℝ) ≤ 2).trans hx
  have hxnonneg : 0 ≤ x := zero_le_one.trans hxone
  have hden : 1 ≤ (g : ℝ) * M :=
    one_le_mul_of_one_le_of_one_le (by exact_mod_cast hg) hM
  have hpower : x ^ ε ≤ x := by
    simpa only [Real.rpow_one] using
      Real.rpow_le_rpow_of_exponent_le hxone hε
  constructor
  · calc
      _ ≤ x ^ ε * R * Q ^ 2 := div_le_self (by positivity) hden
      _ ≤ x * x * x ^ 2 := mul_le_mul
        (mul_le_mul hpower hRupper hR hxnonneg)
        (pow_le_pow_left₀ hQ hQupper 2) (sq_nonneg Q) (mul_nonneg hxnonneg hxnonneg)
      _ = x ^ 4 := by ring
  · calc
      2 * Q ≤ 2 * x := mul_le_mul_of_nonneg_left hQupper (by norm_num)
      _ ≤ x * x := mul_le_mul_of_nonneg_right hx hxnonneg
      _ = x ^ 2 := (pow_two x).symm

open Classical in
theorem opening_padded_window (H : ℝ) :
    let k : ℕ := if H < 1 then 0 else Nat.log 2 ⌊H⌋₊ + 1
    let B : ℝ := if H < 1 then 1 / 2 else ((2 ^ (Nat.log 2 ⌊H⌋₊ + 1) - 1 : ℕ) : ℝ)
    (Finset.Icc (-⌊B⌋) ⌊B⌋).filter (fun h : ℤ => h ≠ 0) =
      (Finset.Ioo (-((2 : ℤ) ^ k)) ((2 : ℤ) ^ k)).erase 0 := by
  intro k B
  by_cases hH : H < 1
  · norm_num [k, B, hH, Int.Ioo_eq_finset_map]
  · have hp : 0 < (2 : ℕ) ^ (Nat.log 2 ⌊H⌋₊ + 1) := pow_pos (by decide) _
    have hb : ⌊B⌋ = (2 : ℤ) ^ k - 1 := by
      dsimp only [B, k]
      simp only [ite_eq_right hH]
      rw [Int.floor_natCast, Nat.cast_sub (Nat.one_le_iff_ne_zero.mpr hp.ne'),
        Nat.cast_pow, Nat.cast_ofNat, Nat.cast_one]
    rw [hb]
    ext z
    simp only [Finset.mem_filter, Finset.mem_Icc, Finset.mem_erase, Finset.mem_Ioo]
    omega

open Classical in
theorem opening_padded_count (x H : ℝ) (hx : Real.exp 1 ≤ x) (hH : H ≤ x ^ (4 : ℝ)) :
    let k : ℕ := if H < 1 then 0 else Nat.log 2 ⌊H⌋₊ + 1
    (k : ℝ) ≤ (2 + 4 / Real.log 2) * Real.log x := by
  intro k
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le hx
  have hlog : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hx
  have htwo : 0 < Real.log 2 := Real.log_pos (by norm_num)
  by_cases hh : H < 1
  · simp only [k, ite_eq_left hh, Nat.cast_zero]
    positivity
  · have hh1 : 1 ≤ H := le_of_not_gt hh
    have hcount := (padded_dyadic_cutoff_bounds H hh1).2.2.2.2.2.1
    have hlogs : Real.log H ≤ 4 * Real.log x := by
      simpa only [Real.log_rpow hx0] using
        Real.log_le_log (zero_lt_one.trans_le hh1) hH
    dsimp only [k]
    rw [ite_eq_right hh]
    calc
      ((Nat.log 2 ⌊H⌋₊ + 1 : ℕ) : ℝ) ≤ 1 + Real.log H / Real.log 2 := hcount
      _ ≤ 1 + (4 * Real.log x) / Real.log 2 :=
        add_le_add_right (div_le_div_of_nonneg_right hlogs htwo.le) 1
      _ ≤ 2 * Real.log x + (4 * Real.log x) / Real.log 2 := by linarith only [hlog]
      _ = (2 + 4 / Real.log 2) * Real.log x := by ring

open Classical in
theorem opening_summed_bands (x ε K D TN M N R : ℝ)
    (hx : Real.exp 1 ≤ x) (hK : 0 ≤ K) (hD : 0 ≤ D)
    (hTN : 0 ≤ TN) (hM : 0 ≤ M) (hN : 0 ≤ N) (hR : 0 < R)
    (G : Finset ℕ) (Q L : ℕ) (bins : ℕ → Finset ℕ) (k : ℕ → ℕ)
    (F : ℕ → ℤ → ℕ → ℕ → Bool → ℂ)
    (hG : ∀ g ∈ G, 0 < g ∧ g ≤ Q)
    (hQ : (Q : ℝ) ≤ x ^ 2) (hL : (L : ℝ) ≤ TN * N / R)
    (hbins : ∀ g ∈ G, ((bins g).card : ℝ) ≤ D * Real.log x)
    (hk : ∀ g ∈ G, (k g : ℝ) ≤ D * Real.log x)
    (hF : ∀ g ∈ G, ∀ ℓ ∈ (Finset.Icc (-(L : ℤ)) (L : ℤ)).erase 0,
      ∀ i ∈ bins g, ∀ j ∈ Finset.range (k g), ∀ b : Bool,
        ‖F g ℓ i j b‖ ≤ K * M * N * (Int.gcd (g : ℤ) ℓ : ℝ) /
          (g : ℝ) * x ^ (-3 * ε / 2)) :
    (∑ g ∈ G, ∑ ℓ ∈ (Finset.Icc (-(L : ℤ)) (L : ℤ)).erase 0,
      ∑ i ∈ bins g, ∑ j ∈ Finset.range (k g),
        (‖F g ℓ i j false‖ + ‖F g ℓ i j true‖)) ≤
      36 * K * D ^ 2 * TN * (M * N ^ 2 / R) *
        (Real.log x) ^ 4 * x ^ (-3 * ε / 2) := by
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le hx
  have hlog : 0 ≤ Real.log x :=
    (show (0 : ℝ) ≤ 1 by norm_num).trans ((Real.le_log_iff_exp_le hx0).mpr hx)
  let P : ℝ := K * M * N * x ^ (-3 * ε / 2)
  have hP : 0 ≤ P := by dsimp only [P]; positivity
  have hpoint (g : ℕ) (hg : g ∈ G) (ℓ : ℤ)
      (hℓ : ℓ ∈ (Finset.Icc (-(L : ℤ)) (L : ℤ)).erase 0) :
      (∑ i ∈ bins g, ∑ j ∈ Finset.range (k g),
        (‖F g ℓ i j false‖ + ‖F g ℓ i j true‖)) ≤
        2 * P * (D * Real.log x) ^ 2 *
          ((Int.gcd (g : ℤ) ℓ : ℝ) / (g : ℝ)) := by
    have hg0 : (0 : ℝ) < g := Nat.cast_pos.mpr (hG g hg).1
    have hgcd : 0 ≤ (Int.gcd (g : ℤ) ℓ : ℝ) / (g : ℝ) := by positivity
    have hcard : ((bins g).card : ℝ) * (k g : ℝ) ≤ (D * Real.log x) ^ 2 := by
      simpa only [pow_two] using mul_le_mul (hbins g hg) (hk g hg)
        (Nat.cast_nonneg _) (mul_nonneg hD hlog)
    calc
      _ ≤ ∑ _i ∈ bins g, ∑ _j ∈ Finset.range (k g),
          2 * P * ((Int.gcd (g : ℤ) ℓ : ℝ) / (g : ℝ)) := by
        apply Finset.sum_le_sum
        intro i hi
        apply Finset.sum_le_sum
        intro j hj
        have hfalse := hF g hg ℓ hℓ i hi j hj false
        have htrue := hF g hg ℓ hℓ i hi j hj true
        calc
          _ ≤ 2 * (K * M * N * (Int.gcd (g : ℤ) ℓ : ℝ) /
              (g : ℝ) * x ^ (-3 * ε / 2)) := by linarith
          _ = _ := by dsimp only [P]; ring
      _ = (((bins g).card : ℝ) * (k g : ℝ)) *
          (2 * P * ((Int.gcd (g : ℤ) ℓ : ℝ) / (g : ℝ))) := by
        simp only [Finset.sum_const, Finset.card_range, nsmul_eq_mul]
        ring
      _ ≤ (D * Real.log x) ^ 2 *
          (2 * P * ((Int.gcd (g : ℤ) ℓ : ℝ) / (g : ℝ))) :=
        mul_le_mul_of_nonneg_right hcard (by positivity)
      _ = _ := by ring
  have hsum := opening_gcd_average G Q L hG
  have hharm := opening_harmonic_log x hx Q hQ
  have hHarmonicNonneg : 0 ≤ (harmonic Q : ℝ) := by
    simp only [harmonic, Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast]
    exact Finset.sum_nonneg fun _ _ => by positivity
  have hharmsq : (harmonic Q : ℝ) ^ 2 ≤ (3 * Real.log x) ^ 2 :=
    (sq_le_sq₀ hHarmonicNonneg (mul_nonneg (by norm_num) hlog)).mpr hharm
  calc
    _ ≤ ∑ g ∈ G, ∑ ℓ ∈ (Finset.Icc (-(L : ℤ)) (L : ℤ)).erase 0,
        2 * P * (D * Real.log x) ^ 2 *
          ((Int.gcd (g : ℤ) ℓ : ℝ) / (g : ℝ)) :=
      Finset.sum_le_sum fun g hg => Finset.sum_le_sum fun ℓ hℓ => hpoint g hg ℓ hℓ
    _ = (2 * P * (D * Real.log x) ^ 2) *
        (∑ g ∈ G, ∑ ℓ ∈ (Finset.Icc (-(L : ℤ)) (L : ℤ)).erase 0,
          (Int.gcd (g : ℤ) ℓ : ℝ) / (g : ℝ)) := by
      simp only [Finset.mul_sum]
    _ ≤ (2 * P * (D * Real.log x) ^ 2) *
        (2 * (L : ℝ) * (harmonic Q : ℝ) ^ 2) :=
      mul_le_mul_of_nonneg_left hsum (by positivity)
    _ ≤ (2 * P * (D * Real.log x) ^ 2) *
        (2 * (TN * N / R) * (3 * Real.log x) ^ 2) := by
      apply mul_le_mul_of_nonneg_left _ (by positivity)
      exact mul_le_mul (mul_le_mul_of_nonneg_left hL (by norm_num)) hharmsq
        (sq_nonneg _) (by positivity)
    _ = _ := by dsimp only [P]; ring

open Classical in
theorem opening_off_diagonal_split
    (cM TM M : ℝ) (hcM : 0 < cM) (hcMT : cM ≤ TM) (hM : 0 < M)
    (ψM : ℝ → ℝ) (hsupport : Function.support ψM ⊆ Set.Icc cM TM)
    (S : Finset (ℕ × ℕ)) (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ)
    (a b₁ b₂ : ℕ) (k : ℕ → ℕ) (u : ℕ → ℕ → ℕ)
    (hS : ∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Squarefree (p.1 * p.2))
    (hprim : ∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2))
    (hu : ∀ p₁ ∈ S, ∀ p₂ ∈ S, p₁.2 = p₂.2 →
      let g := Nat.gcd p₁.1 p₂.1
      0 < u g (p₁.1 / g) ∧ u g (p₁.1 / g) ∣ p₁.1 / g) :
    let sm : Finset ℕ := Finset.Icc 1 ⌊TM * M⌋₊
    let w : ℕ → ℝ := fun n => ψM ((n : ℝ) / M)
    let J : ℕ → Finset ℤ := fun g =>
      (Finset.Ioo (-((2 : ℤ) ^ k g)) ((2 : ℤ) ^ k g)).erase 0
    let Ω := (S ×ˢ S).filter (fun p => p.1.2 = p.2.2)
    let G := Ω.image (fun p => Nat.gcd p.1.1 p.2.1)
    let 𝒜 : ℕ → Finset (ℕ × ℕ × ℕ × ℕ) := fun g =>
      (Ω.filter (fun p => Nat.gcd p.1.1 p.2.1 = g)).image (fun p =>
        (p.1.2, u g (p.1.1 / g), (p.1.1 / g) / u g (p.1.1 / g), p.2.1 / g))
    let γ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
    let L : ℕ → Finset ℤ := fun r =>
      ((γ.support ×ˢ γ.support).filter
        (fun p => p.1 ≠ p.2 ∧ Int.ModEq (r : ℤ) p.1 p.2)).image
          (fun p => (p.2 - p.1) / (r : ℤ))
    ∀ (Lall : Finset ℤ), (∀ r ∈ S.image Prod.snd, L r ⊆ Lall) →
      let bins : ℕ → Finset ℕ := fun g =>
        (𝒜 g).image (fun t => Nat.log 2 t.2.1)
      let block : ℕ → ℤ → ℕ → Finset (ℕ × ℕ × ℕ × ℕ) := fun g ℓ i =>
        (𝒜 g).filter (fun t => ℓ ∈ L t.1 ∧ Nat.log 2 t.2.1 = i)
      let F : ℕ → ℤ → Finset (ℕ × ℕ × ℕ × ℕ) → Finset ℤ → ℂ :=
        fun g ℓ D J' =>
          ∑ t ∈ D,
            c (g * t.2.1 * t.2.2.1, t.1) * star (c (g * t.2.2.2, t.1)) *
              ((M : ℂ) / ((t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2 : ℕ) : ℂ)) *
                ∑ n ∈ γ.support.filter (fun n =>
                  Int.gcd n ((t.1 * g * t.2.1 * t.2.2.1 : ℕ) : ℤ) = 1 ∧
                  Int.gcd (n + ℓ * (t.1 : ℤ)) ((g * t.2.2.2 : ℕ) : ℤ) = 1),
                  γ n * star (γ (n + ℓ * (t.1 : ℤ))) *
                    (sourceCompatibility t.1 g b₁ b₂ ℓ n : ℂ) *
                      ∑ h ∈ J', sourcePhi ψM M
                        (t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2) h *
                          sourceTheta t.1 g t.2.1 t.2.2.1 t.2.2.2 a b₁ b₂ ℓ n h
      let Jpos : ℕ → Finset ℤ := fun j =>
        Finset.Ico ((2 : ℤ) ^ j) ((2 : ℤ) ^ (j + 1))
      let Jneg : ℕ → Finset ℤ := fun j =>
        Finset.Ioc (-((2 : ℤ) ^ (j + 1))) (-((2 : ℤ) ^ j))
      ‖∑ r ∈ S.image Prod.snd,
        ∑ p₁ ∈ S.filter (fun p => p.2 = r),
          ∑ p₂ ∈ S.filter (fun p => p.2 = r),
            c p₁ * star (c p₂) *
              ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                if n₁ = n₂ then 0 else
                  β n₁ * star (β n₂) *
                    ∑ h ∈ J (Nat.gcd p₁.1 p₂.1),
                      mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b₁ b₂ n₁ n₂
                        ((h : ZMod (r * Nat.lcm p₁.1 p₂.1)).val)‖ ≤
        ∑ g ∈ G, ∑ ℓ ∈ Lall, ∑ i ∈ bins g, ∑ j ∈ Finset.range (k g),
          (‖F g ℓ (block g ℓ i) (Jpos j)‖ +
            ‖F g ℓ (block g ℓ i) (Jneg j)‖) := by
  intro sm w J Ω G 𝒜 γ L Lall hLall bins block F Jpos Jneg
  have hfactor := mixedFourier_offDiagonal_gcd_shift_factorization
    sm w S β c a b₁ b₂ J u hS hprim hu
  let K : ℕ → ℤ → (ℕ × ℕ × ℕ × ℕ) → ℂ := fun g ℓ t =>
    c (g * t.2.1 * t.2.2.1, t.1) * star (c (g * t.2.2.2, t.1)) *
      ∑ n ∈ γ.support.filter (fun n => n + ℓ * (t.1 : ℤ) ∈ γ.support),
        γ n * star (γ (n + ℓ * (t.1 : ℤ))) *
          ∑ h ∈ J g,
            mixedFiberFourierCoefficient sm w
              (g * t.2.1 * t.2.2.1) (g * t.2.2.2) t.1 a b₁ b₂
              n.toNat (n + ℓ * (t.1 : ℤ)).toNat
              ((h : ZMod (t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2)).val)
  have hreorder (g : ℕ) (hg : g ∈ G) :
      (∑ t ∈ 𝒜 g, ∑ ℓ ∈ L t.1, K g ℓ t) =
        ∑ ℓ ∈ Lall, ∑ i ∈ bins g, ∑ t ∈ block g ℓ i, K g ℓ t := by
    calc
      _ = ∑ t ∈ 𝒜 g, ∑ ℓ ∈ Lall,
          if ℓ ∈ L t.1 then K g ℓ t else 0 := by
        refine Finset.sum_congr rfl fun t ht => ?_
        obtain ⟨_, _, _, _, htS, _, _, _, _, _⟩ := (hfactor.1 g hg).2 t ht
        have hrS : t.1 ∈ S.image Prod.snd :=
          Finset.mem_image_of_mem Prod.snd htS
        have hsub := hLall t.1 hrS
        rw [← Finset.sum_filter]
        refine Finset.sum_congr ?_ (fun _ _ => rfl)
        ext ℓ
        simp only [Finset.mem_filter]
        exact ⟨fun h => ⟨hsub h, h⟩, fun h => h.2⟩
      _ = ∑ ℓ ∈ Lall, ∑ t ∈ (𝒜 g).filter (fun t => ℓ ∈ L t.1), K g ℓ t := by
        rw [Finset.sum_comm]
        simp only [Finset.sum_filter]
      _ = _ := by
        refine Finset.sum_congr rfl fun ℓ _ => ?_
        have hfiber := Finset.sum_fiberwise_of_maps_to
          (s := (𝒜 g).filter (fun t => ℓ ∈ L t.1)) (t := bins g)
          (g := fun t => Nat.log 2 t.2.1)
          (fun t ht => Finset.mem_image_of_mem (fun t => Nat.log 2 t.2.1)
            (Finset.mem_filter.mp ht).1) (K g ℓ)
        simpa only [block, Finset.filter_filter] using hfiber.symm
  have hconvert (g : ℕ) (hg : g ∈ G) (ℓ : ℤ) (i : ℕ) :
      (∑ t ∈ block g ℓ i, K g ℓ t) = F g ℓ (block g ℓ i) (J g) := by
    have : NeZero g := NeZero.of_pos (hfactor.1 g hg).1
    have hblock : ∀ t ∈ block g ℓ i,
        0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
        Squarefree (t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2) ∧
        Nat.Coprime (t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2) (a * b₁ * b₂) := by
      intro t ht
      obtain ⟨hr, hu, hv, hq₂, _, _, _, _, hsq, hp⟩ :=
        (hfactor.1 g hg).2 t (Finset.mem_filter.mp ht).1
      exact ⟨hr, hu, hv, hq₂, hsq, hp⟩
    simpa only [K, F] using factoredMixedFourier_sourcePhiTheta
      cM TM M hcM hcMT hM ψM hsupport (block g ℓ i) β c g a b₁ b₂ ℓ (J g) hblock
  have hlinear (g : ℕ) (ℓ : ℤ) (D : Finset (ℕ × ℕ × ℕ × ℕ)) (J' : Finset ℤ) :
      F g ℓ D J' = ∑ h ∈ J', F g ℓ D {h} := by
    dsimp only [F]
    simp only [Finset.sum_singleton, Finset.mul_sum]
    exact (Finset.sum_congr rfl (fun _ _ => Finset.sum_comm)).trans Finset.sum_comm
  have hshell (g : ℕ) (ℓ : ℤ) (D : Finset (ℕ × ℕ × ℕ × ℕ)) :
      F g ℓ D (J g) = ∑ j ∈ Finset.range (k g),
        (F g ℓ D (Jpos j) + F g ℓ D (Jneg j)) := by
    calc
      _ = ∑ h ∈ J g, F g ℓ D {h} := hlinear g ℓ D (J g)
      _ = ∑ j ∈ Finset.range (k g),
          ((∑ h ∈ Jpos j, F g ℓ D {h}) +
            ∑ h ∈ Jneg j, F g ℓ D {h}) :=
        sum_signed_dyadic_shells (k g) (fun h => F g ℓ D {h})
      _ = _ := Finset.sum_congr rfl fun j _ =>
        congrArg₂ (· + ·) (hlinear g ℓ D (Jpos j)).symm (hlinear g ℓ D (Jneg j)).symm
  rw [hfactor.2.2.2]
  apply norm_sum_le_of_le
  intro g hg
  have hgroup :
      (∑ t ∈ 𝒜 g,
        c (g * t.2.1 * t.2.2.1, t.1) * star (c (g * t.2.2.2, t.1)) *
          ∑ ℓ ∈ L t.1,
            ∑ n ∈ γ.support.filter (fun n => n + ℓ * (t.1 : ℤ) ∈ γ.support),
              γ n * star (γ (n + ℓ * (t.1 : ℤ))) *
                ∑ h ∈ J g,
                  mixedFiberFourierCoefficient sm w
                    (g * t.2.1 * t.2.2.1) (g * t.2.2.2) t.1 a b₁ b₂
                    n.toNat (n + ℓ * (t.1 : ℤ)).toNat
                    ((h : ZMod (t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2)).val)) =
        ∑ ℓ ∈ Lall, ∑ i ∈ bins g, F g ℓ (block g ℓ i) (J g) := by
    calc
      _ = ∑ t ∈ 𝒜 g, ∑ ℓ ∈ L t.1, K g ℓ t := by
        simp only [K, Finset.mul_sum]
      _ = ∑ ℓ ∈ Lall, ∑ i ∈ bins g, ∑ t ∈ block g ℓ i, K g ℓ t := hreorder g hg
      _ = _ := Finset.sum_congr rfl fun ℓ _ =>
        Finset.sum_congr rfl fun i _ => hconvert g hg ℓ i
  rw [hgroup]
  apply norm_sum_le_of_le
  intro ℓ _
  apply norm_sum_le_of_le
  intro i _
  rw [hshell]
  exact norm_sum_le_of_le _ (fun j _ => norm_add_le _ _)

open Classical in
theorem opening_truncated_identity
    (sm : Finset ℕ) (w : ℕ → ℝ) (S : Finset (ℕ × ℕ))
    (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ) (a b₁ b₂ : ℕ) (J : ℕ → Finset ℤ) :
    let V : ℕ → ℕ → ℕ → ℕ → ℕ → ℂ := fun r q₁ q₂ n₁ n₂ =>
      if n₁ = n₂ then (mixedFiberMass sm w q₁ q₂ r a b₁ b₂ n₁ n₂ : ℂ)
      else mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂ 0 +
        ∑ h ∈ J (Nat.gcd q₁ q₂),
          mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂
            ((h : ZMod (r * Nat.lcm q₁ q₂)).val)
    let D : ℂ := ∑ r ∈ S.image Prod.snd,
      ∑ p₁ ∈ S.filter (fun p => p.2 = r),
        ∑ p₂ ∈ S.filter (fun p => p.2 = r),
          c p₁ * star (c p₂) *
            ∑ n ∈ β.support, β n * star (β n) *
              (mixedFiberMass sm w p₁.1 p₂.1 r a b₁ b₂ n n : ℂ)
    let O : ℂ := ∑ r ∈ S.image Prod.snd,
      ∑ p₁ ∈ S.filter (fun p => p.2 = r),
        ∑ p₂ ∈ S.filter (fun p => p.2 = r),
          c p₁ * star (c p₂) *
            ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
              if n₁ = n₂ then 0 else
                β n₁ * star (β n₂) *
                  ∑ h ∈ J (Nat.gcd p₁.1 p₂.1),
                    mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b₁ b₂ n₁ n₂
                      ((h : ZMod (r * Nat.lcm p₁.1 p₂.1)).val)
    (∑ r ∈ S.image Prod.snd,
      ∑ p₁ ∈ S.filter (fun p => p.2 = r),
        ∑ p₂ ∈ S.filter (fun p => p.2 = r),
          c p₁ * star (c p₂) *
            ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
              β n₁ * star (β n₂) * V r p₁.1 p₂.1 n₁ n₂) =
      D + offDiagonalZeroMode sm w S β c a b₁ b₂ + O := by
  intro V D O
  have hinner (r q₁ q₂ : ℕ) :
      (∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
        β n₁ * star (β n₂) * V r q₁ q₂ n₁ n₂) =
        (∑ n ∈ β.support, β n * star (β n) *
          (mixedFiberMass sm w q₁ q₂ r a b₁ b₂ n n : ℂ)) +
        (∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support.filter (fun n₂ => n₁ ≠ n₂),
          β n₁ * star (β n₂) *
            mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂ 0) +
        (∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
          if n₁ = n₂ then 0 else β n₁ * star (β n₂) *
            ∑ h ∈ J (Nat.gcd q₁ q₂),
              mixedFiberFourierCoefficient sm w q₁ q₂ r a b₁ b₂ n₁ n₂
                ((h : ZMod (r * Nat.lcm q₁ q₂)).val)) := by
    simp only [Finset.sum_filter, ← Finset.sum_add_distrib]
    refine Finset.sum_congr rfl fun n₁ hn₁ => ?_
    have hdiag : β n₁ * star (β n₁) *
        (mixedFiberMass sm w q₁ q₂ r a b₁ b₂ n₁ n₁ : ℂ) =
        ∑ n₂ ∈ β.support, if n₁ = n₂ then β n₁ * star (β n₂) *
          (mixedFiberMass sm w q₁ q₂ r a b₁ b₂ n₁ n₂ : ℂ) else 0 := by
      simp [hn₁]
    rw [hdiag, ← Finset.sum_add_distrib, ← Finset.sum_add_distrib]
    refine Finset.sum_congr rfl fun n₂ _ => ?_
    by_cases hn : n₁ = n₂
    · simp [V, hn]
    · simp [V, hn, mul_add]
  dsimp only [D, O, offDiagonalZeroMode]
  simp_rw [hinner]
  simp only [mul_add, Finset.sum_add_distrib]

open Classical in
theorem opening_four_energy
    (sm : Finset ℕ) (w : ℕ → ℝ) (S : Finset (ℕ × ℕ))
    (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ) (a b₁ b₂ : ℕ)
    (E : ℝ) (D O : ℕ → ℕ → ℂ)
    (hparts : ∀ b ∈ ({b₁, b₂} : Finset ℕ), ∀ b' ∈ ({b₁, b₂} : Finset ℕ),
      ‖mixedCorrelation sm w S β c a b b' -
          (D b b' + offDiagonalZeroMode sm w S β c a b b' + O b b')‖ ≤ E ∧
        ‖D b b'‖ ≤ E ∧ ‖O b b'‖ ≤ E)
    (hzero : ‖offDiagonalZeroMode sm w S β c a b₁ b₁ -
        offDiagonalZeroMode sm w S β c a b₁ b₂ -
        offDiagonalZeroMode sm w S β c a b₂ b₁ +
        offDiagonalZeroMode sm w S β c a b₂ b₂‖ ≤ E) :
    dispersionEnergy sm w S β c a b₁ b₂ ≤ 13 * E := by
  let C : ℕ → ℕ → ℂ := fun b b' => mixedCorrelation sm w S β c a b b'
  let Z : ℕ → ℕ → ℂ := fun b b' => offDiagonalZeroMode sm w S β c a b b'
  let T : ℕ → ℕ → ℂ := fun b b' => C b b' - (D b b' + Z b b' + O b b')
  let four : (ℕ → ℕ → ℂ) → ℂ := fun F =>
    F b₁ b₁ - F b₁ b₂ - F b₂ b₁ + F b₂ b₂
  have hfour (F : ℕ → ℕ → ℂ)
      (hF : ∀ b ∈ ({b₁, b₂} : Finset ℕ), ∀ b' ∈ ({b₁, b₂} : Finset ℕ),
        ‖F b b'‖ ≤ E) : ‖four F‖ ≤ 4 * E := by
    have h₁₁ := hF b₁ (by simp) b₁ (by simp)
    have h₁₂ := hF b₁ (by simp) b₂ (by simp)
    have h₂₁ := hF b₂ (by simp) b₁ (by simp)
    have h₂₂ := hF b₂ (by simp) b₂ (by simp)
    calc
      _ ≤ E + E + E + E :=
        norm_add_le_of_le (norm_sub_le_of_le (norm_sub_le_of_le h₁₁ h₁₂) h₂₁) h₂₂
      _ = 4 * E := by ring
  have hT : ‖four T‖ ≤ 4 * E :=
    hfour T (fun b hb b' hb' => (hparts b hb b' hb').1)
  have hD : ‖four D‖ ≤ 4 * E :=
    hfour D (fun b hb b' hb' => (hparts b hb b' hb').2.1)
  have hO : ‖four O‖ ≤ 4 * E :=
    hfour O (fun b hb b' hb' => (hparts b hb b' hb').2.2)
  have heq : four C = four T + four D + four Z + four O := by
    dsimp only [four, T, C, Z]
    ring
  rw [dispersionEnergy_eq_four_mixedCorrelations]
  change (four C).re ≤ 13 * E
  calc
    (four C).re ≤ ‖four C‖ := Complex.re_le_norm _
    _ = ‖four T + four D + four Z + four O‖ := congrArg norm heq
    _ ≤ 4 * E + 4 * E + E + 4 * E :=
      norm_add_le_of_le (norm_add_le_of_le (norm_add_le_of_le hT hD) hzero) hO
    _ = 13 * E := by ring

open Classical in
theorem opening_zero_mode (d : ℕ) (E C TN T L ε B : ℝ)
    (hC : 0 < C) (hTN : 0 < TN) (hT : 0 < T) (hL : 0 ≤ L) (hε : 0 < ε)
    (ψ : ℝ → ℝ) (hψ : ContDiff ℝ 2 ψ)
    (hψsupport : Function.support ψ ⊆ Set.Icc (-T) T)
    (hψbounds : ∀ t : ℝ,
      |ψ t| ≤ L ∧ |deriv ψ t| ≤ L ∧ |deriv (deriv ψ) t| ≤ L) :
    ∀ᶠ x : ℝ in Filter.atTop,
      ∀ (M N R Q : ℝ), 0 < M → 0 < N → 0 < R → 0 < Q →
        1 ≤ M → N ≤ x → Q ≤ x → R ≤ C * x ^ (-2 * ε) * N →
        ∀ (sm : Finset ℕ) (S : Finset (ℕ × ℕ))
          (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ) (a b₁ b₂ : ℕ),
          (∀ n ∈ β.support, 0 < n ∧ (n : ℝ) ≤ TN * N ∧
            ‖β n‖ ≤ C * (n.divisors.card : ℝ) ^ d * (Real.log x) ^ E) →
          (∀ p ∈ S, ‖c p‖ ≤ 1) →
          (∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Nat.Coprime p.1 p.2 ∧
            R ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ 2 * R ∧ (p.1 : ℝ) ≤ 2 * Q) →
          (∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2)) →
          (∀ p ∈ S, ∀ t ∈ p.1.primeFactors,
            Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (t : ℝ)) →
          let w : ℕ → ℝ := fun n => ψ ((n : ℝ) / M)
          ‖offDiagonalZeroMode sm w S β c a b₁ b₁ -
              offDiagonalZeroMode sm w S β c a b₁ b₂ -
              offDiagonalZeroMode sm w S β c a b₂ b₁ +
              offDiagonalZeroMode sm w S β c a b₂ b₂‖ ≤
            M * N ^ 2 / R * (Real.log x) ^ (-B) := by
  have hmain := compactProfile_noncoprimeOffDiagonalZeroMode_four_sign_log_saving
    B E 0 2 ε (6 * C / TN) C T L (1 / TN ^ 2) d
    (by norm_num) hε (by positivity) hC.le hT.le hL (by positivity)
  filter_upwards [hmain, Filter.eventually_ge_atTop (max TN (2 : ℝ))] with x hx hxlarge
  have hTNx : TN ≤ x := (le_max_left _ _).trans hxlarge
  have hxtwo : 2 ≤ x := (le_max_right _ _).trans hxlarge
  have hxpos : 0 < x := by linarith
  have hlogpos : 0 < Real.log x := Real.log_pos (by linarith)
  intro M N R Q hM hN hR hQ hMone hNx hQx hRN
    sm S β c a b₁ b₂ hβ hc hS hprim hrough w
  by_cases hSempty : S = ∅
  · simp only [offDiagonalZeroMode, hSempty, Finset.image_empty, Finset.sum_empty,
      sub_self, zero_add, norm_zero]
    positivity
  by_cases hβempty : β.support = ∅
  · simp only [offDiagonalZeroMode, hβempty, Finset.sum_empty, mul_zero,
      Finset.sum_const_zero, sub_self, zero_add, norm_zero]
    positivity
  obtain ⟨p₀, hp₀⟩ := Finset.nonempty_iff_ne_empty.mpr hSempty
  obtain ⟨n₀, hn₀⟩ := Finset.nonempty_iff_ne_empty.mpr hβempty
  obtain ⟨hp₀q, hp₀r, _, _, hp₀rhi, hp₀qhi⟩ := hS p₀ hp₀
  let NI : ℕ := ⌊TN * N⌋₊
  let RI : ℕ := ⌈R⌉₊
  let QI : ℕ := ⌊2 * Q⌋₊
  have hNI : 0 < NI :=
    (hβ n₀ hn₀).1.trans_le (Nat.le_floor (hβ n₀ hn₀).2.1)
  have hRI : 0 < RI := Nat.ceil_pos.mpr hR
  have hQI : 0 < QI := hp₀q.trans_le (Nat.le_floor hp₀qhi)
  have hNIreal : 0 < (NI : ℝ) := by exact_mod_cast hNI
  have hRIreal : 0 < (RI : ℝ) := by exact_mod_cast hRI
  have hNIfloor : (NI : ℝ) ≤ TN * N := Nat.floor_le (mul_pos hTN hN).le
  have hRIceil : R ≤ (RI : ℝ) := Nat.le_ceil R
  have hQIfloor : (QI : ℝ) ≤ 2 * Q := Nat.floor_le (by positivity)
  have hRhalf : (1 / 2 : ℝ) ≤ R := by
    have hprone : (1 : ℝ) ≤ (p₀.2 : ℝ) := by
      exact_mod_cast Nat.succ_le_of_lt hp₀r
    linarith only [hprone, hp₀rhi]
  have hRIupper : (RI : ℝ) ≤ 3 * R := by
    have hceil : (RI : ℝ) < R + 1 := Nat.ceil_lt_add_one hR.le
    linarith only [hceil, hRhalf]
  have hNIhalf : TN * N / 2 ≤ (NI : ℝ) := by
    have hNIone : (1 : ℝ) ≤ (NI : ℝ) := by
      exact_mod_cast Nat.succ_le_of_lt hNI
    have hfloor : TN * N < (NI : ℝ) + 1 := Nat.lt_floor_add_one (TN * N)
    linarith only [hNIone, hfloor]
  have hNIx : (NI : ℝ) ≤ x ^ (2 : ℝ) := by
    rw [Real.rpow_two]
    calc
      (NI : ℝ) ≤ TN * N := hNIfloor
      _ ≤ TN * x := mul_le_mul_of_nonneg_left hNx hTN.le
      _ ≤ x * x := mul_le_mul_of_nonneg_right hTNx hxpos.le
      _ = x ^ 2 := by ring
  have hQIx : (QI : ℝ) ≤ x ^ (2 : ℝ) := by
    rw [Real.rpow_two]
    calc
      (QI : ℝ) ≤ 2 * Q := hQIfloor
      _ ≤ 2 * x := mul_le_mul_of_nonneg_left hQx (by norm_num)
      _ ≤ x * x := mul_le_mul_of_nonneg_right hxtwo hxpos.le
      _ = x ^ 2 := by ring
  have hRIN : (RI : ℝ) ≤ (6 * C / TN) * x ^ (-2 * ε) * (NI : ℝ) := by
    calc
      (RI : ℝ) ≤ 3 * R := hRIupper
      _ ≤ 3 * (C * x ^ (-2 * ε) * N) :=
        mul_le_mul_of_nonneg_left hRN (by norm_num)
      _ = (6 * C / TN) * x ^ (-2 * ε) * (TN * N / 2) := by
        field_simp [hTN.ne']
        ring
      _ ≤ (6 * C / TN) * x ^ (-2 * ε) * (NI : ℝ) :=
        mul_le_mul_of_nonneg_left hNIhalf (by positivity)
  have hβsupport : β.support ⊆ Finset.Icc 1 NI := by
    intro n hn
    exact Finset.mem_Icc.mpr
      ⟨Nat.succ_le_of_lt (hβ n hn).1, Nat.le_floor (hβ n hn).2.1⟩
  have hSinteger : ∀ p ∈ S,
      1 ≤ p.1 ∧ p.1 ≤ QI ∧ RI ≤ p.2 ∧ p.2 ≤ 2 * RI ∧ Nat.Coprime p.1 p.2 := by
    intro p hp
    obtain ⟨hpq, _, hcop, hrlower, hrupper, hqupper⟩ := hS p hp
    refine ⟨Nat.succ_le_of_lt hpq, Nat.le_floor hqupper, Nat.ceil_le.mpr hrlower,
      ?_, hcop⟩
    have hupper : (p.2 : ℝ) ≤ 2 * (RI : ℝ) :=
      hrupper.trans (mul_le_mul_of_nonneg_left hRIceil (by norm_num))
    exact_mod_cast hupper
  have hroughInteger : ∀ p ∈ S, ∀ t : ℕ, Nat.Prime t → t ∣ p.1 →
      Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (t : ℝ) := by
    intro p hp t ht htdvd
    exact hrough p hp t (ht.mem_primeFactors htdvd (Nat.ne_of_gt (hS p hp).1))
  have hprofile : ∀ t : ℝ,
      |ψ t| ≤ L * (Real.log x) ^ (0 : ℝ) ∧
      |deriv ψ t| ≤ L * (Real.log x) ^ (0 : ℝ) ∧
      |deriv (deriv ψ) t| ≤ L * (Real.log x) ^ (0 : ℝ) := by
    intro t
    simpa only [Real.rpow_zero, mul_one] using hψbounds t
  have hsave := hx sm S β c M 0 ψ NI RI QI a b₁ b₂
    hMone hψ hψsupport hprofile hNI hRI hQI hβsupport
    (fun n hn => (hβ n hn).2.2) hc hSinteger hprim hroughInteger hNIx hQIx hRIN
  have hscale : (1 / TN ^ 2) * (M * (NI : ℝ) ^ 2 / (RI : ℝ)) ≤ M * N ^ 2 / R := by
    calc
      (1 / TN ^ 2) * (M * (NI : ℝ) ^ 2 / (RI : ℝ)) ≤
          (1 / TN ^ 2) * (M * (TN * N) ^ 2 / (RI : ℝ)) :=
        mul_le_mul_of_nonneg_left
          (div_le_div_of_nonneg_right
            (mul_le_mul_of_nonneg_left
              (pow_le_pow_left₀ hNIreal.le hNIfloor 2) hM.le) hRIreal.le)
          (by positivity)
      _ ≤ (1 / TN ^ 2) * (M * (TN * N) ^ 2 / R) :=
        mul_le_mul_of_nonneg_left
          (div_le_div_of_nonneg_left (by positivity) hR hRIceil) (by positivity)
      _ = M * N ^ 2 / R := by
        field_simp [hTN.ne', hR.ne']
  rw [offDiagonalZeroMode_four_sign_eq_noncoprime sm w S β c a b₁ b₂
    (fun p hp => ⟨(hS p hp).1, (hS p hp).2.1, (hS p hp).2.2.1⟩) hprim]
  calc
    _ ≤ (1 / TN ^ 2) * (M * (NI : ℝ) ^ 2 / (RI : ℝ)) * (Real.log x) ^ (-B) := by
      simpa only [w, sub_zero] using hsave
    _ ≤ M * N ^ 2 / R * (Real.log x) ^ (-B) :=
      mul_le_mul_of_nonneg_right hscale (Real.rpow_nonneg hlogpos.le _)

open Classical in
theorem opening_final_cauchy (α β : ℕ →₀ ℂ) (S : Finset (ℕ × ℕ)) (sm : Finset ℕ)
    (w : ℕ → ℝ) (a b₁ b₂ : ℕ) (R E : ℝ) (hR : 0 < R) (hE : 0 ≤ E)
    (hS : ∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ (p.2 : ℝ) ≤ 2 * R)
    (hprim : ∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2))
    (hsm : α.support ⊆ sm) (hw₀ : ∀ m ∈ sm, 0 ≤ w m)
    (hw₁ : ∀ m ∈ α.support, 1 ≤ w m)
    (henergy : ∀ c : ℕ × ℕ → ℂ, (∀ p ∈ S, ‖c p‖ = 1) →
      dispersionEnergy sm w S β c a b₁ b₂ ≤ E) :
    (∑ p ∈ S, ‖deltaZero (finiteConvolution α β) p.1 p.2 a b₁ b₂‖) ^ 2 ≤
      2 * R * (∑ m ∈ α.support, ‖α m‖ ^ 2) * E := by
  let G : ℕ := ∏ p ∈ S, p.1 * p.2
  have hGdata : ∀ p ∈ S, p.1 * p.2 ∣ G := fun p hp =>
    Finset.dvd_prod_of_mem (fun p : ℕ × ℕ => p.1 * p.2) hp
  have hGcoprime : Nat.Coprime (a * b₁ * b₂) G :=
    Nat.coprime_prod_right_iff.mpr hprim
  have haG : Nat.Coprime a G := hGcoprime.coprime_mul_right.coprime_mul_right
  have hb₁G : Nat.Coprime b₁ G := hGcoprime.coprime_mul_right.coprime_mul_left
  have hb₂G : Nat.Coprime b₂ G := hGcoprime.coprime_mul_left
  obtain ⟨c, hc, _, hCauchy⟩ := exists_phases_deltaZero_mass_sq_le
    α β sm w hsm hw₀ hw₁ G S hGdata a b₁ b₂ haG hb₁G hb₂G
  have hrange : S.image Prod.snd ⊆ Finset.Icc 1 ⌊2 * R⌋₊ := by
    intro r hr
    obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hr
    exact Finset.mem_Icc.mpr
      ⟨Nat.succ_le_of_lt (hS p hp).2.1, Nat.le_floor (hS p hp).2.2⟩
  have hcardNat : (S.image Prod.snd).card ≤ ⌊2 * R⌋₊ := by
    simpa only [Nat.card_Icc, Nat.add_sub_cancel] using Finset.card_le_card hrange
  have hcard : ((S.image Prod.snd).card : ℝ) ≤ 2 * R := by
    calc
      ((S.image Prod.snd).card : ℝ) ≤ (⌊2 * R⌋₊ : ℝ) := by exact_mod_cast hcardNat
      _ ≤ 2 * R := Nat.floor_le (by positivity)
  refine hCauchy.trans ((mul_le_mul_of_nonneg_left (henergy c hc) (by positivity)).trans ?_)
  gcongr

theorem opening_cauchy_logarithmic_absorption
    {x M N R K F A η u T : ℝ}
    (hM : 0 < M) (hN : 0 < N) (hR : 0 < R) (hK : 0 < K) (hη : 0 < η)
    (hlog1 : 1 ≤ Real.log x)
    (hlarge : Real.exp (max 1 (26 * K / η ^ 2)) ≤ x)
    (hu : 0 ≤ u) (hT : T ≤ K * M * (Real.log x) ^ F)
    (hCauchy : u ^ 2 ≤ 2 * R * T *
      (13 * ((M * N ^ 2 / R) * (Real.log x) ^ (-(2 * A + |F| + 2))))) :
    u ≤ η * (M * N) * (Real.log x) ^ (-A) := by
  have hx0 : 0 < x := (Real.exp_pos _).trans_le hlarge
  have hlog0 : 0 < Real.log x := zero_lt_one.trans_le hlog1
  let D : ℝ := 2 * A + |F| + 2
  have hlogConstant : 26 * K ≤ η ^ 2 * (Real.log x) ^ 2 := by
    have hdiv : 26 * K / η ^ 2 ≤ Real.log x :=
      (le_max_right _ _).trans ((Real.le_log_iff_exp_le hx0).mpr hlarge)
    have hfirst : 26 * K ≤ η ^ 2 * Real.log x := by
      simpa only [mul_comm] using (div_le_iff₀ (pow_pos hη 2)).mp hdiv
    exact hfirst.trans (mul_le_mul_of_nonneg_left
      (by nlinarith only [hlog1] : Real.log x ≤ (Real.log x) ^ 2) (sq_nonneg η))
  have hFinalWeight : 26 * K * (Real.log x) ^ F * (Real.log x) ^ (-D) ≤
      η ^ 2 * (Real.log x) ^ (-2 * A) := by
    have hpower : (Real.log x) ^ F * (Real.log x) ^ (-D) ≤
        (Real.log x) ^ (-2 * A - 2) := by
      rw [← Real.rpow_add hlog0]
      apply Real.rpow_le_rpow_of_exponent_le hlog1
      dsimp only [D]
      linarith only [le_abs_self F]
    calc
      _ ≤ 26 * K * (Real.log x) ^ (-2 * A - 2) := by
        rw [mul_assoc]
        exact mul_le_mul_of_nonneg_left hpower (by positivity)
      _ = 26 * K * ((Real.log x) ^ (-2 * A) / (Real.log x) ^ 2) := by
        rw [Real.rpow_sub hlog0, Real.rpow_two]
      _ ≤ (η ^ 2 * (Real.log x) ^ 2) *
          ((Real.log x) ^ (-2 * A) / (Real.log x) ^ 2) :=
        mul_le_mul_of_nonneg_right hlogConstant (by positivity)
      _ = _ := by field_simp [hlog0.ne']
  apply (sq_le_sq₀ hu (by positivity)).mp
  calc
    _ ≤ 2 * R * T * (13 * ((M * N ^ 2 / R) * (Real.log x) ^ (-D))) := hCauchy
    _ ≤ 2 * R * (K * M * (Real.log x) ^ F) *
        (13 * ((M * N ^ 2 / R) * (Real.log x) ^ (-D))) :=
      mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_left hT (by positivity)) (by positivity)
    _ = (M * N) ^ 2 * (26 * K * (Real.log x) ^ F * (Real.log x) ^ (-D)) := by
      field_simp [hR.ne']
      ring
    _ ≤ (M * N) ^ 2 * (η ^ 2 * (Real.log x) ^ (-2 * A)) :=
      mul_le_mul_of_nonneg_left hFinalWeight (sq_nonneg _)
    _ = (η * (M * N) * (Real.log x) ^ (-A)) ^ 2 := by
      have hpower : (Real.log x) ^ (-2 * A) =
          ((Real.log x) ^ (-A)) ^ (2 : ℕ) := by
        rw [← Real.rpow_mul_natCast hlog0.le]
        congr 1
        ring
      rw [hpower]
      ring

open Classical in
theorem sourceTheta_finite_weighted_cauchy
    {ι ν : Type*} (A : Finset ι) (s : Finset ν)
    (b : ν → ℂ) (f : ι → ν → ℂ) (χ : ν → ℝ)
    (hχ : ∀ n ∈ s, 0 ≤ χ n)
    (hmajor : ∀ n ∈ s, b n ≠ 0 → 1 ≤ χ n) :
    (∑ i ∈ A, ‖∑ n ∈ s, b n * f i n‖) ^ 2 ≤
      (∑ n ∈ s, ‖b n‖ ^ 2) *
        ∑ i ∈ A, ∑ j ∈ A,
          ‖∑ n ∈ s, (χ n : ℂ) * f i n * star (f j n)‖ := by
  choose z hz using fun i : ι =>
    Complex.exists_norm_eq_mul_self (∑ n ∈ s, b n * f i n)
  let F : ν → ℂ := fun n => ∑ i ∈ A, z i * f i n
  let L : ℝ := ∑ i ∈ A, ‖∑ n ∈ s, b n * f i n‖
  let E : ℝ := ∑ n ∈ s, χ n * ‖F n‖ ^ 2
  have hL : 0 ≤ L := by positivity
  have hlinear : (L : ℂ) = ∑ n ∈ s, b n * F n := by
    calc
      (L : ℂ) = ∑ i ∈ A, z i * ∑ n ∈ s, b n * f i n := by
        simp only [L, Complex.ofReal_sum]
        exact Finset.sum_congr rfl (fun i _ => (hz i).2)
      _ = _ := by
        simp only [F, Finset.mul_sum]
        rw [Finset.sum_comm]
        apply Finset.sum_congr rfl
        intro n _
        exact Finset.sum_congr rfl (fun i _ => by ring)
  have hcs := Finset.sum_sq_le_sum_mul_sum_of_sq_le_mul s
    (r := fun n => ‖b n * F n‖)
    (f := fun n => ‖b n‖ ^ 2)
    (g := fun n => χ n * ‖F n‖ ^ 2)
    (fun _ _ => sq_nonneg _)
    (fun n hn => mul_nonneg (hχ n hn) (sq_nonneg _))
    (fun n hn => by
      by_cases hb : b n = 0
      · simp [hb]
      · simp only [norm_mul, mul_pow]
        exact mul_le_mul_of_nonneg_left
          (le_mul_of_one_le_left (sq_nonneg _) (hmajor n hn hb)) (sq_nonneg _))
  have hLE : L ^ 2 ≤ (∑ n ∈ s, ‖b n‖ ^ 2) * E := by
    calc
      L ^ 2 ≤ (∑ n ∈ s, ‖b n * F n‖) ^ 2 := by
        apply pow_le_pow_left₀ hL
        rw [← Complex.norm_of_nonneg hL, hlinear]
        exact norm_sum_le _ _
      _ ≤ _ := hcs
  have hgram : (E : ℂ) =
      ∑ i ∈ A, ∑ j ∈ A,
        z i * star (z j) *
          ∑ n ∈ s, (χ n : ℂ) * f i n * star (f j n) := by
    calc
      (E : ℂ) = ∑ n ∈ s, (χ n : ℂ) * (F n * star (F n)) := by
        simp only [E, Complex.ofReal_sum, Complex.ofReal_mul, Complex.ofReal_pow,
          Complex.star_def, Complex.mul_conj']
      _ = ∑ n ∈ s, ∑ i ∈ A, ∑ j ∈ A,
          (z i * star (z j)) * ((χ n : ℂ) * f i n * star (f j n)) := by
        simp only [F, star_sum, star_mul]
        simp_rw [Finset.sum_mul_sum]
        simp only [Finset.mul_sum, mul_assoc, mul_left_comm, mul_comm]
      _ = _ := by
        rw [← Finset.sum_comm_cycle]
        simp only [Finset.mul_sum]
  have hE : E ≤ ∑ i ∈ A, ∑ j ∈ A,
      ‖∑ n ∈ s, (χ n : ℂ) * f i n * star (f j n)‖ := by
    have hE0 : 0 ≤ E := Finset.sum_nonneg fun n hn =>
      mul_nonneg (hχ n hn) (sq_nonneg _)
    rw [← Complex.norm_of_nonneg hE0, hgram]
    refine norm_sum_le_of_le _ (fun i _ => ?_)
    refine norm_sum_le_of_le _ (fun j _ => ?_)
    simp only [norm_mul, norm_star, (hz i).1, (hz j).1, one_mul, le_refl]
  exact hLE.trans (mul_le_mul_of_nonneg_left hE (by positivity))

theorem sourceHighGamma_scale_envelopes
    («ω» δ ε C x M N R Q H q γ : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε)
    (hworking : 72 * «ω» + 24 * δ < 1)
    (hsmall : ε < δ / 10 ^ 100) (hC : 1 ≤ C) (hx : 1 ≤ x)
    (hM : 0 < M) (hN : 0 < N) (hR : 0 < R) (hQ : 0 < Q)
    (hq : 1 ≤ q) (hMN : x / C ≤ M * N) (hNγ : N = x ^ γ)
    (hNR : N ≤ C * x ^ (δ + 4 * ε) * R)
    (hRN : R ≤ C * x ^ (-2 * ε) * N)
    (hRQ : R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε))
    (hH : H = x ^ ε * R * Q ^ 2 / (q * M)) (hγhi : γ ≤ 1 / 2) :
    (1 / 2 - 2 * «ω» - δ / 2 ≤ γ →
      H ^ 2 * Q ^ 2 * R ^ (1 / 2 : ℝ) / N ≤ C ^ 12 * x ^ (-ε) ∧
      H ^ 2 / R ≤ C ^ 12 * x ^ (-ε) ∧
      H / Q ^ 2 ≤ C ^ 12 * x ^ (-ε)) ∧
    (1 / 4 + 14 * «ω» + 4 * δ + 100 * ε ≤ γ →
      γ ≤ 1 / 2 - 2 * «ω» - δ / 2 →
      C ^ (-2 : ℝ) * x ^ (δ / 2 - 7 * ε) ≤ x ^ (-5 * ε) * Q / H ∧
      ∀ V : ℝ, 0 < V → x ^ (5 * ε) * H / q ≤ C * V →
        H ^ (13 / 6 : ℝ) * Q ^ (1 / 3 : ℝ) * R ^ (1 / 6 : ℝ) *
            x ^ (δ / 3 + 5 * ε / 6) / N ^ (1 / 2 : ℝ) ≤
          C ^ 12 * x ^ (-5 * ε) ∧
        H ^ 2 / R ≤ C ^ 12 * x ^ (-5 * ε) ∧
        H / (V * q) ≤ C ^ 12 * x ^ (-5 * ε)) := by
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hxpos : 0 < x := zero_lt_one.trans_le hx
  have hqpos : 0 < q := zero_lt_one.trans_le hq
  have hHpos : 0 < H := by rw [hH]; positivity
  have hlogx : 0 ≤ Real.log x := Real.log_nonneg hx
  have hlogC : 0 ≤ Real.log C := Real.log_nonneg hC
  have hlogq : 0 ≤ Real.log q := Real.log_nonneg hq
  have hεδ : 1000 * ε ≤ δ := by
    have hpow : (1000 : ℝ) ≤ 10 ^ 100 := by norm_num
    have hs := (lt_div_iff₀ (by positivity : (0 : ℝ) < 10 ^ 100)).mp hsmall
    nlinarith only [hpow, hs, hε]
  have hlogMN : Real.log x - Real.log C ≤ Real.log M + Real.log N := by
    have hh := Real.log_le_log (by positivity : 0 < x / C) hMN
    simpa (disch := positivity) only [Real.log_div, Real.log_mul] using hh
  have hlogN : Real.log N = γ * Real.log x := by
    rw [hNγ, Real.log_rpow hxpos]
  have hlogNR : Real.log N ≤
      Real.log C + (δ + 4 * ε) * Real.log x + Real.log R := by
    have hh := Real.log_le_log hN hNR
    simpa (disch := positivity) only [Real.log_mul, Real.log_rpow] using hh
  have hlogRN : Real.log R ≤
      Real.log C + (-2 * ε) * Real.log x + Real.log N := by
    have hh := Real.log_le_log hR hRN
    simpa (disch := positivity) only [Real.log_mul, Real.log_rpow] using hh
  have hlogRQ : Real.log R + Real.log Q ≤
      Real.log C + (1 / 2 + 2 * «ω» + ε) * Real.log x := by
    have hh := Real.log_le_log (mul_pos hR hQ) hRQ
    simpa (disch := positivity) only [Real.log_mul, Real.log_rpow] using hh
  have hlogH : Real.log H = ε * Real.log x + Real.log R +
      2 * Real.log Q - Real.log q - Real.log M := by
    rw [hH]
    simp (disch := positivity) only [Real.log_div, Real.log_mul,
      Real.log_rpow, Real.log_pow]
    ring
  have hbound {z p : ℝ} (hz : 0 < z)
      (hlog : Real.log z ≤ 12 * Real.log C + p * Real.log x) :
      z ≤ C ^ 12 * x ^ p := by
    apply (Real.log_le_log_iff hz (by positivity)).mp
    simpa (disch := positivity) only [Real.log_mul, Real.log_pow,
      Real.log_rpow, Nat.cast_ofNat] using hlog
  have htwo : Real.log (H ^ 2 / R) ≤ 9 * Real.log C +
      (8 * «ω» + 3 * δ + 18 * ε - γ) * Real.log x := by
    simp (disch := positivity) only [Real.log_div, Real.log_pow, Nat.cast_ofNat]
    nlinarith only [hlogMN, hlogNR, hlogRQ, hlogH, hlogN, hlogq]
  constructor
  · intro hγlo
    have he₁ : 1 + 12 * «ω» + 7 * δ / 2 + 22 * ε - 5 * γ / 2 ≤ -ε := by
      linarith only [hworking, hγlo, hεδ, hω, hε]
    have he₂ : 8 * «ω» + 3 * δ + 18 * ε - γ ≤ -ε := by
      linarith only [hworking, hγlo, hεδ, hω, hδ]
    have he₃ : 2 * γ - 1 - ε ≤ -ε := by linarith only [hγhi]
    refine ⟨hbound (by positivity) ?_, hbound (by positivity) ?_,
      hbound (by positivity) ?_⟩
    · have hfirst : Real.log (H ^ 2 * Q ^ 2 * R ^ (1 / 2 : ℝ) / N) ≤
          (23 / 2 : ℝ) * Real.log C +
            (1 + 12 * «ω» + 7 * δ / 2 + 22 * ε - 5 * γ / 2) * Real.log x := by
        simp (disch := positivity) only [Real.log_div, Real.log_mul,
          Real.log_pow, Real.log_rpow, Nat.cast_ofNat]
        nlinarith only [hlogMN, hlogNR, hlogRQ, hlogH, hlogN, hlogq]
      nlinarith only [hfirst, mul_le_mul_of_nonneg_right he₁ hlogx, hlogC]
    · nlinarith only [htwo, mul_le_mul_of_nonneg_right he₂ hlogx, hlogC]
    · have hthird : Real.log (H / Q ^ 2) ≤
          2 * Real.log C + (2 * γ - 1 - ε) * Real.log x := by
        simp (disch := positivity) only [Real.log_div, Real.log_pow, Nat.cast_ofNat]
        nlinarith only [hlogMN, hlogRN, hlogH, hlogN, hlogq]
      nlinarith only [hthird, mul_le_mul_of_nonneg_right he₃ hlogx, hlogC]
  · intro hγlo hγcut
    constructor
    · apply (Real.log_le_log_iff (by positivity) (by positivity)).mp
      simp (disch := positivity) only [Real.log_mul, Real.log_div, Real.log_rpow]
      have hcut := mul_le_mul_of_nonneg_right hγcut hlogx
      nlinarith only [hlogMN, hlogRQ, hlogH, hlogN, hlogq, hcut]
    · intro V hV hVlo
      have he₁ : 1 / 6 + 28 * «ω» / 3 + 8 * δ / 3 + 17 * ε -
          2 * γ / 3 ≤ -5 * ε := by linarith only [hγlo, hε]
      have he₂ : 8 * «ω» + 3 * δ + 18 * ε - γ ≤ -5 * ε := by
        linarith only [hγlo, hε, hω, hδ]
      have hlogV : 5 * ε * Real.log x + Real.log H - Real.log q ≤
          Real.log C + Real.log V := by
        have hh := Real.log_le_log (by positivity : 0 < x ^ (5 * ε) * H / q) hVlo
        simpa (disch := positivity) only [Real.log_div, Real.log_mul,
          Real.log_rpow] using hh
      refine ⟨hbound (by positivity) ?_, hbound (by positivity) ?_,
        hbound (by positivity) ?_⟩
      · have hfirst :
            Real.log (H ^ (13 / 6 : ℝ) * Q ^ (1 / 3 : ℝ) * R ^ (1 / 6 : ℝ) *
              x ^ (δ / 3 + 5 * ε / 6) / N ^ (1 / 2 : ℝ)) ≤
            (55 / 6 : ℝ) * Real.log C +
              (1 / 6 + 28 * «ω» / 3 + 8 * δ / 3 + 17 * ε - 2 * γ / 3) *
                Real.log x := by
          simp (disch := positivity) only [Real.log_div, Real.log_mul, Real.log_rpow]
          nlinarith only [hlogMN, hlogNR, hlogRQ, hlogH, hlogN, hlogq]
        nlinarith only [hfirst, mul_le_mul_of_nonneg_right he₁ hlogx, hlogC]
      · nlinarith only [htwo, mul_le_mul_of_nonneg_right he₂ hlogx, hlogC]
      · simp (disch := positivity) only [Real.log_div, Real.log_mul]
        nlinarith only [hlogV, hlogC]

open Classical in
theorem sourceSignedProduct_pair_gcd_sum_le
    (r H K : ℕ) (hr : 0 < r)
    (J : Finset ℤ) (F : Finset (ℕ × ℕ))
    (hJ : ∀ h ∈ J, h ≠ 0 ∧ -(H : ℤ) ≤ h ∧ h ≤ (H : ℤ))
    (hF : ∀ t ∈ F, 0 < t.1 ∧ 0 < t.2 ∧ t.1 * t.2 ≤ K) :
    let D : ℕ := (Finset.Icc 1 (H * K)).sup (fun n => n.divisors.card ^ 2)
    (∑ h ∈ J, ∑ t ∈ F, ∑ k ∈ J, ∑ s ∈ F,
      (Int.gcd (h * (t.1 : ℤ) * (t.2 : ℤ) -
        k * (s.1 : ℤ) * (s.2 : ℤ)) (r : ℤ) : ℝ)) ≤
      3 * (J.card : ℝ) * (F.card : ℝ) * (D : ℝ) *
        (r.divisors.card : ℝ) * ((H : ℝ) * (K : ℝ) + (r : ℝ)) := by
  intro D
  let S : Finset (ℤ × (ℕ × ℕ)) := J ×ˢ F
  let f : (ℤ × (ℕ × ℕ)) → ℤ := fun p =>
    p.1 * (p.2.1 : ℤ) * (p.2.2 : ℤ)
  let I : Finset ℤ := Finset.Icc (-((H * K : ℕ) : ℤ)) ((H * K : ℕ) : ℤ)
  have hpoint (p : ℤ × (ℕ × ℕ)) (hp : p ∈ S) :
      f p ≠ 0 ∧ (f p).natAbs ≤ H * K := by
    obtain ⟨hpJ, hpF⟩ := Finset.mem_product.mp hp
    obtain ⟨hpne, hplo, hphi⟩ := hJ p.1 hpJ
    obtain ⟨hp₁, hp₂, hpK⟩ := hF p.2 hpF
    have habs : p.1.natAbs ≤ H := by omega
    refine ⟨mul_ne_zero (mul_ne_zero hpne (by exact_mod_cast hp₁.ne'))
      (by exact_mod_cast hp₂.ne'), ?_⟩
    simp only [f, Int.natAbs_mul, Int.natAbs_natCast]
    calc
      p.1.natAbs * p.2.1 * p.2.2 = p.1.natAbs * (p.2.1 * p.2.2) := by ring
      _ ≤ H * K := Nat.mul_le_mul habs hpK
  have hmaps (p : ℤ × (ℕ × ℕ)) (hp : p ∈ S) : f p ∈ I := by
    have hh := (hpoint p hp).2
    apply Finset.mem_Icc.mpr
    omega
  have hfiber (z : ℤ) : (S.filter (fun p => f p = z)).card ≤ D := by
    let A := S.filter (fun p => f p = z)
    change A.card ≤ D
    by_cases hA : A.Nonempty
    · obtain ⟨p₀, hp₀⟩ := hA
      have hp₀S : p₀ ∈ S := (Finset.mem_filter.mp hp₀).1
      have hp₀z : f p₀ = z := (Finset.mem_filter.mp hp₀).2
      have hz : z ≠ 0 := hp₀z ▸ (hpoint p₀ hp₀S).1
      have hzn : z.natAbs ∈ Finset.Icc 1 (H * K) :=
        Finset.mem_Icc.mpr ⟨Int.natAbs_pos.mpr hz, hp₀z ▸ (hpoint p₀ hp₀S).2⟩
      have hinto (p : ℤ × (ℕ × ℕ)) (hp : p ∈ A) :
          p.2 ∈ z.natAbs.divisors ×ˢ z.natAbs.divisors := by
        have hpz : f p = z := (Finset.mem_filter.mp hp).2
        have heq : z.natAbs = p.1.natAbs * p.2.1 * p.2.2 := by
          rw [← hpz]
          simp only [f, Int.natAbs_mul, Int.natAbs_natCast]
        apply Finset.mem_product.mpr
        constructor
        · apply Nat.mem_divisors.mpr
          refine ⟨?_, Int.natAbs_ne_zero.mpr hz⟩
          rw [heq]
          exact dvd_mul_of_dvd_left (dvd_mul_left _ _) _
        · apply Nat.mem_divisors.mpr
          refine ⟨?_, Int.natAbs_ne_zero.mpr hz⟩
          rw [heq]
          exact dvd_mul_left _ _
      have hinj : Set.InjOn (fun p : ℤ × (ℕ × ℕ) => p.2) (A : Set _) := by
        intro p hp q hq hpq
        apply Prod.ext ?_ hpq
        have hpz := (Finset.mem_filter.mp hp).2
        have hqz := (Finset.mem_filter.mp hq).2
        have hpF := (Finset.mem_product.mp (Finset.mem_filter.mp hp).1).2
        have hp₁ : (p.2.1 : ℤ) ≠ 0 := by exact_mod_cast (hF p.2 hpF).1.ne'
        have hp₂ : (p.2.2 : ℤ) ≠ 0 := by exact_mod_cast (hF p.2 hpF).2.1.ne'
        have heq : p.1 * (p.2.1 : ℤ) * (p.2.2 : ℤ) =
            q.1 * (p.2.1 : ℤ) * (p.2.2 : ℤ) := by
          simpa only [f, hpq] using hpz.trans hqz.symm
        exact mul_right_cancel₀ hp₁ (mul_right_cancel₀ hp₂ heq)
      calc
        A.card ≤ (z.natAbs.divisors ×ˢ z.natAbs.divisors).card :=
          Finset.card_le_card_of_injOn (fun p : ℤ × (ℕ × ℕ) => p.2) hinto hinj
        _ = z.natAbs.divisors.card ^ 2 := by rw [Finset.card_product, pow_two]
        _ ≤ D := Finset.le_sup (f := fun n : ℕ => n.divisors.card ^ 2) hzn
    · rw [Finset.not_nonempty_iff_eq_empty.mp hA, Finset.card_empty]
      exact Nat.zero_le _
  have hgcd (u : ℤ) :
      (∑ z ∈ I, (Int.gcd (u - z) (r : ℤ) : ℝ)) ≤
        3 * (r.divisors.card : ℝ) * ((H : ℝ) * (K : ℝ) + (r : ℝ)) := by
    have hrZ : (r : ℤ) ≠ 0 := by exact_mod_cast hr.ne'
    have hG (z : ℤ) : (Int.gcd (-1 * z + u) (r : ℤ) : ℝ) ≤
        (H : ℝ) * (K : ℝ) + (r : ℝ) := by
      have hh : Int.gcd (-1 * z + u) (r : ℤ) ≤ r := by
        simpa only [Int.natAbs_natCast] using Int.gcd_le_natAbs_right (-1 * z + u) hrZ
      exact (Nat.cast_le.mpr hh).trans (le_add_of_nonneg_left (by positivity))
    have hfilter :
        ((Finset.Icc (Int.ceil (-((H : ℝ) * (K : ℝ))))
          (Int.floor ((H : ℝ) * (K : ℝ)))).filter
          (fun z => (Int.gcd (-1 * z + u) (r : ℤ) : ℝ) ≤
            (H : ℝ) * (K : ℝ) + (r : ℝ))) = I := by
      rw [Finset.filter_eq_self.mpr (fun z _ => hG z)]
      simp only [I, ← Nat.cast_mul, Int.ceil_neg, Int.floor_natCast]
    have hT : max 1 ((H : ℝ) * (K : ℝ)) ≤
        (H : ℝ) * (K : ℝ) + (r : ℝ) := by
      apply max_le
      · have hrone : (1 : ℝ) ≤ r := by exact_mod_cast hr
        nlinarith [show (0 : ℝ) ≤ (H : ℝ) * (K : ℝ) by positivity]
      · exact le_add_of_nonneg_right (Nat.cast_nonneg r)
    have hraw := terminal_truncated_gcd_sum_le_divisor_card r hr (-1) u
      ((H : ℝ) * (K : ℝ)) ((H : ℝ) * (K : ℝ) + (r : ℝ))
      (by positivity) hT
    rw [hfilter] at hraw
    simpa only [neg_one_mul, neg_add_eq_sub, Int.neg_gcd,
      Int.gcd_one_left, Nat.cast_one, mul_one] using hraw
  have hrow (p : ℤ × (ℕ × ℕ)) :
      (∑ q ∈ S, (Int.gcd (f p - f q) (r : ℤ) : ℝ)) ≤
        (D : ℝ) * (3 * (r.divisors.card : ℝ) *
          ((H : ℝ) * (K : ℝ) + (r : ℝ))) := by
    calc
      _ = ∑ z ∈ I, ∑ q ∈ S.filter (fun q => f q = z),
          (Int.gcd (f p - z) (r : ℤ) : ℝ) :=
        (Finset.sum_fiberwise_of_maps_to' hmaps
          (fun z : ℤ => (Int.gcd (f p - z) (r : ℤ) : ℝ))).symm
      _ ≤ ∑ z ∈ I, (D : ℝ) * (Int.gcd (f p - z) (r : ℤ) : ℝ) := by
        apply Finset.sum_le_sum
        intro z _
        rw [Finset.sum_const, nsmul_eq_mul]
        exact mul_le_mul_of_nonneg_right (Nat.cast_le.mpr (hfiber z)) (Nat.cast_nonneg _)
      _ = (D : ℝ) * ∑ z ∈ I, (Int.gcd (f p - z) (r : ℤ) : ℝ) :=
        (Finset.mul_sum _ _ _).symm
      _ ≤ _ := mul_le_mul_of_nonneg_left (hgcd (f p)) (Nat.cast_nonneg D)
  calc
    _ = ∑ p ∈ S, ∑ q ∈ S, (Int.gcd (f p - f q) (r : ℤ) : ℝ) := by
      simp only [S, Finset.sum_product, f]
    _ ≤ ∑ _p ∈ S, (D : ℝ) * (3 * (r.divisors.card : ℝ) *
          ((H : ℝ) * (K : ℝ) + (r : ℝ))) := Finset.sum_le_sum fun p _ => hrow p
    _ = _ := by
      simp only [Finset.sum_const, nsmul_eq_mul, S, Finset.card_product, Nat.cast_mul]
      ring

open Classical in
theorem sourceSignedProduct_pair_gcd_sum_uniform
    (κ ε : ℝ) (hκ : 0 < κ) (hε : 0 < ε) :
    ∃ X₀ : ℝ, 1 ≤ X₀ ∧ ∀ x : ℝ, X₀ ≤ x →
      ∀ r H K : ℕ, 0 < r → (r : ℝ) ≤ x ^ κ →
      (H : ℝ) * (K : ℝ) ≤ x ^ κ →
      ∀ (J : Finset ℤ) (F : Finset (ℕ × ℕ)),
      (∀ h ∈ J, h ≠ 0 ∧ -(H : ℤ) ≤ h ∧ h ≤ (H : ℤ)) →
      (∀ t ∈ F, 0 < t.1 ∧ 0 < t.2 ∧ t.1 * t.2 ≤ K) →
      (∑ h ∈ J, ∑ t ∈ F, ∑ k ∈ J, ∑ s ∈ F,
        (Int.gcd (h * (t.1 : ℤ) * (t.2 : ℤ) -
          k * (s.1 : ℤ) * (s.2 : ℤ)) (r : ℤ) : ℝ)) ≤
        x ^ ε * (J.card : ℝ) * (F.card : ℝ) *
          ((H : ℝ) * (K : ℝ) + (r : ℝ)) := by
  let ρ : ℝ := ε / (4 * κ)
  have hρ : 0 < ρ := by dsimp [ρ]; positivity
  have hκρ : κ * ρ = ε / 4 := by dsimp [ρ]; field_simp [hκ.ne']
  obtain ⟨C, hC, hdivisor⟩ := exists_card_divisors_bound hρ
  obtain ⟨X, hX⟩ := Filter.eventually_atTop.mp
    ((tendsto_rpow_atTop (by positivity : 0 < ε / 4)).eventually_ge_atTop (3 * C ^ 3))
  refine ⟨max 1 X, le_max_left _ _, ?_⟩
  intro x hx r H K hr hrx hHKx J F hJ hF
  have hxone : 1 ≤ x := (le_max_left _ _).trans hx
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  have hxC : 3 * C ^ 3 ≤ x ^ (ε / 4) := hX x ((le_max_right _ _).trans hx)
  let A : ℝ := C * x ^ (ε / 4)
  have hA : 0 ≤ A := by dsimp [A]; positivity
  have hτ (n : ℕ) (hn : 0 < n) (hnx : (n : ℝ) ≤ x ^ κ) :
      (n.divisors.card : ℝ) ≤ A := by
    calc
      _ ≤ C * (n : ℝ) ^ ρ := hdivisor n hn.ne'
      _ ≤ C * (x ^ κ) ^ ρ := mul_le_mul_of_nonneg_left
        (Real.rpow_le_rpow (Nat.cast_nonneg n) hnx hρ.le) hC.le
      _ = A := by rw [← Real.rpow_mul hxpos.le, hκρ]
  let D : ℕ := (Finset.Icc 1 (H * K)).sup (fun n => n.divisors.card ^ 2)
  have hD : (D : ℝ) ≤ A ^ 2 := by
    change (((Finset.Icc 1 (H * K)).sup (fun n : ℕ => n.divisors.card ^ 2) : ℕ) : ℝ) ≤ A ^ 2
    by_cases hI : (Finset.Icc 1 (H * K)).Nonempty
    · obtain ⟨n, hn, heq⟩ := Finset.exists_mem_eq_sup
        (Finset.Icc 1 (H * K)) hI (fun n => n.divisors.card ^ 2)
      rw [heq, Nat.cast_pow]
      apply pow_le_pow_left₀ (Nat.cast_nonneg _) (hτ n (Finset.mem_Icc.mp hn).1 ?_) 2
      exact (Nat.cast_le.mpr (Finset.mem_Icc.mp hn).2).trans
        (by simpa only [Nat.cast_mul] using hHKx)
    · rw [Finset.not_nonempty_iff_eq_empty.mp hI]
      rw [Finset.sup_empty]
      simpa only [Nat.bot_eq_zero, Nat.cast_zero] using sq_nonneg A
  have hτr : (r.divisors.card : ℝ) ≤ A := hτ r hr hrx
  have hcoefficient : 3 * (D : ℝ) * (r.divisors.card : ℝ) ≤ x ^ ε := by
    calc
      3 * (D : ℝ) * (r.divisors.card : ℝ) ≤ 3 * A ^ 2 * A := by
        gcongr
      _ = (3 * C ^ 3) * x ^ (3 * ε / 4) := by
        dsimp [A]
        rw [show (3 * ε / 4 : ℝ) = ε / 4 * (3 : ℕ) by norm_num; ring,
          Real.rpow_mul_natCast hxpos.le (ε / 4) 3]
        ring
      _ ≤ x ^ (ε / 4) * x ^ (3 * ε / 4) :=
        mul_le_mul_of_nonneg_right hxC (Real.rpow_nonneg hxpos.le _)
      _ = x ^ ε := by rw [← Real.rpow_add hxpos]; congr 1; ring
  have hfinite := sourceSignedProduct_pair_gcd_sum_le r H K hr J F hJ hF
  change _ ≤ 3 * (J.card : ℝ) * (F.card : ℝ) * (D : ℝ) *
    (r.divisors.card : ℝ) * ((H : ℝ) * (K : ℝ) + (r : ℝ)) at hfinite
  calc
    _ ≤ 3 * (J.card : ℝ) * (F.card : ℝ) * (D : ℝ) *
        (r.divisors.card : ℝ) * ((H : ℝ) * (K : ℝ) + (r : ℝ)) := hfinite
    _ = (3 * (D : ℝ) * (r.divisors.card : ℝ)) *
        ((J.card : ℝ) * (F.card : ℝ) * ((H : ℝ) * (K : ℝ) + (r : ℝ))) := by ring
    _ ≤ x ^ ε * ((J.card : ℝ) * (F.card : ℝ) *
        ((H : ℝ) * (K : ℝ) + (r : ℝ))) :=
      mul_le_mul_of_nonneg_right hcoefficient (by positivity)
    _ = _ := by ring

open Classical in
theorem sourceTheta_compatibility_pole_mask
    (r q₀ u v q₂ a b₁ b₂ : ℕ) (ℓ n h : ℤ) :
    (if Int.gcd n ((r * q₀ * u * v : ℕ) : ℤ) = 1 ∧
        Int.gcd (n + ℓ * (r : ℤ)) ((q₀ * q₂ : ℕ) : ℤ) = 1 then
      (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
        sourceTheta r q₀ u v q₂ a b₁ b₂ ℓ n h
    else 0) =
      (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
        sourceTheta r q₀ u v q₂ a b₁ b₂ ℓ n h := by
  by_cases hz : (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
      sourceTheta r q₀ u v q₂ a b₁ b₂ ℓ n h = 0
  · simp only [hz, ite_self]
  have hC : sourceCompatibility r q₀ b₁ b₂ ℓ n ≠ 0 := by
    intro hzero
    exact hz (by simp only [hzero, Complex.ofReal_zero, zero_mul])
  have hΘ : sourceTheta r q₀ u v q₂ a b₁ b₂ ℓ n h ≠ 0 :=
    right_ne_zero_of_mul hz
  have hp : r ≠ 0 ∧ q₀ * u * v ≠ 0 ∧ q₂ ≠ 0 := by
    by_contra hbad
    exact hΘ (by simp only [sourceTheta, dite_eq_right hbad])
  let : NeZero r := ⟨hp.1⟩
  let : NeZero (q₀ * u * v) := ⟨hp.2.1⟩
  let : NeZero q₂ := ⟨hp.2.2⟩
  have hphase (m : ℕ) [NeZero m] (c z : ZMod m)
      (hnonzero : reciprocalUnitPhase m c z ≠ 0) : IsUnit z := by
    by_contra hbad
    exact hnonzero (by simp only [reciprocalUnitPhase, ite_eq_right hbad])
  rw [sourceTheta, dite_eq_left hp] at hΘ
  dsimp only at hΘ
  have h₁ := hphase r ((a : ZMod r) * (h : ZMod r))
    ((n : ZMod r) * ((q₀ * u * v * q₂ : ℕ) : ZMod r))
    (left_ne_zero_of_mul (left_ne_zero_of_mul hΘ))
  have h₂ := hphase (q₀ * u * v)
    ((b₁ : ZMod (q₀ * u * v)) * (h : ZMod (q₀ * u * v)))
    ((n : ZMod (q₀ * u * v)) * ((r * q₂ : ℕ) : ZMod (q₀ * u * v)))
    (right_ne_zero_of_mul (left_ne_zero_of_mul hΘ))
  have h₃ := hphase q₂ ((b₂ : ZMod q₂) * (h : ZMod q₂))
    (((n + ℓ * (r : ℤ) : ℤ) : ZMod q₂) *
      ((r * q₀ * u * v : ℕ) : ZMod q₂)) (right_ne_zero_of_mul hΘ)
  have hn₁ : Int.gcd n (r : ℤ) = 1 := by
    rw [← Int.isCoprime_iff_gcd_eq_one]
    exact ((ZMod.coe_int_isUnit_iff_isCoprime n r).mp (IsUnit.mul_iff.mp h₁).1).symm
  have hn₂ : Int.gcd n ((q₀ * u * v : ℕ) : ℤ) = 1 := by
    rw [← Int.isCoprime_iff_gcd_eq_one]
    exact ((ZMod.coe_int_isUnit_iff_isCoprime n (q₀ * u * v)).mp (IsUnit.mul_iff.mp h₂).1).symm
  have hn₃ : Int.gcd (n + ℓ * (r : ℤ)) (q₂ : ℤ) = 1 := by
    rw [← Int.isCoprime_iff_gcd_eq_one]
    exact ((ZMod.coe_int_isUnit_iff_isCoprime (n + ℓ * (r : ℤ)) q₂).mp
      (IsUnit.mul_iff.mp h₃).1).symm
  have hcompat : Int.gcd (n * (n + ℓ * (r : ℤ))) (q₀ : ℤ) = 1 := by
    by_contra hbad
    exact hC (by simp [sourceCompatibility, hbad])
  have hgood : Int.gcd n ((r * q₀ * u * v : ℕ) : ℤ) = 1 ∧
      Int.gcd (n + ℓ * (r : ℤ)) ((q₀ * q₂ : ℕ) : ℤ) = 1 := by
    simp only [← Int.isCoprime_iff_gcd_eq_one, Nat.cast_mul,
      IsCoprime.mul_right_iff] at hn₁ hn₂ hn₃ ⊢
    rw [← Int.isCoprime_iff_gcd_eq_one, IsCoprime.mul_left_iff] at hcompat
    exact ⟨⟨⟨⟨hn₁, hn₂.1.1⟩, hn₂.1.2⟩, hn₂.2⟩, hcompat.2, hn₃⟩
  rw [ite_eq_left hgood]

theorem sourceHighGamma_four_sum_affine
    {ι κ : Type*} (F : Finset ι) (J : Finset κ) (D B A : ℝ)
    (f : ι → ι → κ → κ → ℝ) :
    (∑ v ∈ F, ∑ w ∈ F, ∑ h ∈ J, ∑ k ∈ J, D * (B + A * f v w h k)) =
      D * ((J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * B +
        A * ∑ v ∈ F, ∑ w ∈ F, ∑ h ∈ J, ∑ k ∈ J, f v w h k) := by
  simp only [mul_add, Finset.sum_add_distrib, Finset.sum_const, nsmul_eq_mul,
    ← Finset.mul_sum]
  ring

theorem sourceHighGamma_normalized_completion_envelope
    (H N R Q r q E : ℝ)
    (hH : 0 ≤ H) (hN : 0 < N) (hR : 0 < R) (hQ : 0 < Q)
    (hr : R ≤ r) (hq : 1 ≤ q)
    (h₁ : H ^ 2 * Q ^ 2 * Real.sqrt R / N ≤ E)
    (h₂ : H ^ 2 / R ≤ E) (h₃ : H / Q ^ 2 ≤ E) :
    (N / q) *
        ((5 * H) ^ 2 * (4 * Q ^ 2 / q ^ 2) ^ 2 *
            (6 * Real.sqrt R * Q ^ 2 / q ^ 2) +
          (N / q / r) * (5 * H) * (4 * Q ^ 2 / q ^ 2) *
            (8 * H * Q ^ 2 / q ^ 2 + 2 * R)) ≤
      2600 * (Q ^ 2 * N / q ^ 2) ^ 2 * E := by
  have hrpos : 0 < r := hR.trans_le hr
  have hqpos : 0 < q := zero_lt_one.trans_le hq
  have hq₂ : 1 ≤ q ^ 2 := one_le_pow₀ hq
  have hq₃ : 1 ≤ q ^ 3 := one_le_pow₀ hq
  have hfirst : H ^ 2 * Q ^ 2 * Real.sqrt R / N / q ^ 3 ≤ E := by
    exact (div_le_self (by positivity) hq₃).trans h₁
  have hsecond : H ^ 2 / (q ^ 2 * r) ≤ E := by
    apply le_trans ?_ h₂
    apply div_le_div_of_nonneg_left (sq_nonneg _) hR
    exact hr.trans (le_mul_of_one_le_left hrpos.le hq₂)
  have hthird : H * R / (Q ^ 2 * r) ≤ E := by
    apply le_trans ?_ h₃
    apply (div_le_div_iff₀ (by positivity : 0 < Q ^ 2 * r) (sq_pos_of_pos hQ)).mpr
    nlinarith only [mul_le_mul_of_nonneg_left hr (mul_nonneg hH (sq_nonneg Q))]
  calc
    _ = (Q ^ 2 * N / q ^ 2) ^ 2 *
        (2400 * (H ^ 2 * Q ^ 2 * Real.sqrt R / N / q ^ 3) +
          160 * (H ^ 2 / (q ^ 2 * r)) + 40 * (H * R / (Q ^ 2 * r))) := by
      field_simp [hqpos.ne', hN.ne', hQ.ne', hrpos.ne']
      ring
    _ ≤ (Q ^ 2 * N / q ^ 2) ^ 2 * (2400 * E + 160 * E + 40 * E) := by
      gcongr
    _ = _ := by ring

open Classical in
theorem sourceHighGamma_near_geometry
    («ω» δ ε C x M N R Q H γ : ℝ) (r q₀ : ℕ)
    (F : Finset (ℕ × ℕ)) (J : Finset ℤ)
    (hC : 1 ≤ C) (hxone : 1 ≤ x) (hxlarge : 100 * C ≤ x ^ (1 / 100 : ℝ))
    (hε : 0 < ε) (hεsmall : ε ≤ 1 / 100)
    (hδsmall : δ + 4 * ε ≤ 1 / 12)
    (hRQexponent : 1 / 2 + 2 * «ω» + ε ≤ 7 / 12)
    (hM : 0 < M) (hN : 0 < N) (hR : 0 < R) (hQ : 0 < Q)
    (hMN : x / C ≤ M * N) (hNγ : N = x ^ γ)
    (hNR : N ≤ C * x ^ (δ + 4 * ε) * R)
    (hRN : R ≤ C * x ^ (-2 * ε) * N)
    (hRQ : R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε))
    (hγlower : 5 / 12 ≤ γ) (hγhi : γ ≤ 1 / 2)
    (hRr : R ≤ (r : ℝ)) (hrR : (r : ℝ) ≤ 2 * R)
    (hH : H = x ^ ε * R * Q ^ 2 / ((q₀ : ℝ) * M)) (hHone : 1 ≤ H)
    (hFnonempty : F.Nonempty)
    (hF : ∀ q ∈ F,
      Squarefree (r * q₀ * q.1 * q.2) ∧
      Q ≤ (q₀ * q.1 : ℕ) ∧ (q₀ * q.1 : ℕ) ≤ 2 * Q ∧
      Q ≤ (q₀ * q.2 : ℕ) ∧ (q₀ * q.2 : ℕ) ≤ 2 * Q)
    (hJ : ∀ h ∈ J, h ≠ 0 ∧ |(h : ℝ)| ≤ 2 * H) :
    let P : (ℕ × ℕ) → (ℕ × ℕ) → ℕ := fun t s =>
      Nat.lcm (r * q₀ * t.1 * t.2) (r * q₀ * s.1 * s.2)
    let HN : ℕ := ⌊2 * H⌋₊
    let KN : ℕ := ⌊4 * Q ^ 2 / (q₀ : ℝ) ^ 2⌋₊
    0 < q₀ ∧ (q₀ : ℝ) ≤ N ∧ (r : ℝ) ≤ x ^ (10 : ℝ) ∧
      (∀ t ∈ F, ∀ s ∈ F,
        N ≤ (P t s : ℝ) ^ (3 : ℝ) ∧ (P t s : ℝ) ≤ x ^ (10 : ℝ) ∧
        Real.sqrt ((P t s / q₀ : ℕ) : ℝ) ≤
          6 * Real.sqrt R * Q ^ 2 / (q₀ : ℝ) ^ 2) ∧
      (J.card : ℝ) ≤ 5 * H ∧ (F.card : ℝ) ≤ 4 * Q ^ 2 / (q₀ : ℝ) ^ 2 ∧
      (HN : ℝ) * (KN : ℝ) ≤ 8 * H * Q ^ 2 / (q₀ : ℝ) ^ 2 ∧
      (HN : ℝ) * (KN : ℝ) ≤ x ^ (10 : ℝ) ∧
      (∀ h ∈ J, h ≠ 0 ∧ -(HN : ℤ) ≤ h ∧ h ≤ (HN : ℤ)) ∧
      (∀ t ∈ F, 0 < t.1 ∧ 0 < t.2 ∧ t.1 * t.2 ≤ KN) := by
  intro P HN KN
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  obtain ⟨q, hqF⟩ := hFnonempty
  have hrq : Squarefree (r * q₀) := (hF q hqF).1.of_mul_left.of_mul_left
  have hq₀ : 0 < q₀ := Nat.pos_of_ne_zero hrq.of_mul_right.ne_zero
  have hq₀R : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀
  have hq₀one : 1 ≤ (q₀ : ℝ) := by exact_mod_cast hq₀
  have hrpos : 0 < (r : ℝ) := hR.trans_le hRr
  have hrnat : 0 < r := by exact_mod_cast hrpos
  have hHpos : 0 < H := zero_lt_one.trans_le hHone
  have hlogx : 0 ≤ Real.log x := Real.log_nonneg hxone
  have hlogq : 0 ≤ Real.log (q₀ : ℝ) := Real.log_nonneg hq₀one
  have hconst (z : ℝ) (hz : 0 < z) (hzC : z ≤ 100 * C) :
      Real.log z ≤ (1 / 100 : ℝ) * Real.log x := by
    have hh := Real.log_le_log hz (hzC.trans hxlarge)
    simpa only [Real.log_rpow hxpos] using hh
  have hlogC : Real.log C ≤ (1 / 100 : ℝ) * Real.log x :=
    hconst C hCpos (by nlinarith only [hCpos])
  have hlog2 : Real.log 2 ≤ (1 / 100 : ℝ) * Real.log x :=
    hconst 2 (by norm_num) (by linarith only [hC])
  have hlog8 : Real.log 8 ≤ (1 / 100 : ℝ) * Real.log x :=
    hconst 8 (by norm_num) (by linarith only [hC])
  have hlog32 : Real.log 32 ≤ (1 / 100 : ℝ) * Real.log x :=
    hconst 32 (by norm_num) (by linarith only [hC])
  have hlogN : Real.log N = γ * Real.log x := by rw [hNγ, Real.log_rpow hxpos]
  have hlogNlo : (5 / 12 : ℝ) * Real.log x ≤ Real.log N := by
    rw [hlogN]
    exact mul_le_mul_of_nonneg_right hγlower hlogx
  have hlogNhi : Real.log N ≤ (1 / 2 : ℝ) * Real.log x := by
    rw [hlogN]
    exact mul_le_mul_of_nonneg_right hγhi hlogx
  have hlogMN : Real.log x - Real.log C ≤ Real.log M + Real.log N := by
    have hh := Real.log_le_log (by positivity : 0 < x / C) hMN
    simpa (disch := positivity) only [Real.log_div, Real.log_mul] using hh
  have hlogNR : Real.log N ≤
      Real.log C + (δ + 4 * ε) * Real.log x + Real.log R := by
    have hh := Real.log_le_log hN hNR
    simpa (disch := positivity) only [Real.log_mul, Real.log_rpow] using hh
  have hlogRN : Real.log R ≤
      Real.log C + (-2 * ε) * Real.log x + Real.log N := by
    have hh := Real.log_le_log hR hRN
    simpa (disch := positivity) only [Real.log_mul, Real.log_rpow] using hh
  have hlogRQ : Real.log R + Real.log Q ≤
      Real.log C + (1 / 2 + 2 * «ω» + ε) * Real.log x := by
    have hh := Real.log_le_log (mul_pos hR hQ) hRQ
    simpa (disch := positivity) only [Real.log_mul, Real.log_rpow] using hh
  have hlogRlo : (3 / 10 : ℝ) * Real.log x ≤ Real.log R := by
    nlinarith only [hlogNlo, hlogNR, hlogC,
      mul_le_mul_of_nonneg_right hδsmall hlogx, hlogx]
  have hlogRhi : Real.log R ≤ (51 / 100 : ℝ) * Real.log x := by
    nlinarith only [hlogRN, hlogC, hlogNhi, hε, hlogx]
  have hlogQ : Real.log Q ≤ (1 / 3 : ℝ) * Real.log x := by
    nlinarith only [hlogRQ, hlogRlo, hlogC,
      mul_le_mul_of_nonneg_right hRQexponent hlogx, hlogx]
  have hlogM : 0 ≤ Real.log M := by nlinarith only [hlogMN, hlogC, hlogNhi, hlogx]
  have hbound {z p : ℝ} (hz : 0 < z) (hh : Real.log z ≤ p * Real.log x) : z ≤ x ^ p := by
    apply (Real.log_le_log_iff hz (Real.rpow_pos_of_pos hxpos _)).mp
    simpa only [Real.log_rpow hxpos] using hh
  have hrx : (r : ℝ) ≤ x ^ (10 : ℝ) := by
    apply hbound hrpos
    have hh := Real.log_le_log hrpos hrR
    rw [Real.log_mul (by norm_num) hR.ne'] at hh
    nlinarith only [hh, hlog2, hlogRhi, hlogx]
  have hlogH : Real.log H = ε * Real.log x + Real.log R +
      2 * Real.log Q - Real.log (q₀ : ℝ) - Real.log M := by
    rw [hH]
    simp (disch := positivity) only [Real.log_div, Real.log_mul,
      Real.log_rpow, Real.log_pow]
    ring
  have hlogHhi : Real.log H ≤ 2 * Real.log x := by
    nlinarith only [hlogH, hlogRhi, hlogQ, hlogq, hlogM,
      mul_le_mul_of_nonneg_right hεsmall hlogx, hlogx]
  have hpositive (t : ℕ × ℕ) (ht : t ∈ F) : 0 < t.1 ∧ 0 < t.2 :=
    ⟨Nat.pos_of_ne_zero (hF t ht).1.of_mul_left.of_mul_right.ne_zero,
      Nat.pos_of_ne_zero (hF t ht).1.of_mul_right.ne_zero⟩
  have hcoordinate (t : ℕ × ℕ) (ht : t ∈ F) :
      (t.1 : ℝ) ≤ 2 * Q / (q₀ : ℝ) ∧ (t.2 : ℝ) ≤ 2 * Q / (q₀ : ℝ) := by
    constructor
    · apply (le_div_iff₀ hq₀R).mpr
      simpa only [Nat.cast_mul, mul_comm] using (hF t ht).2.2.1
    · apply (le_div_iff₀ hq₀R).mpr
      simpa only [Nat.cast_mul, mul_comm] using (hF t ht).2.2.2.2
  have hq₀Q : (q₀ : ℝ) ≤ 2 * Q := by
    have hq₁ : (1 : ℝ) ≤ (q.1 : ℝ) := by exact_mod_cast (hpositive q hqF).1
    have hh := (hF q hqF).2.2.1
    simp only [Nat.cast_mul] at hh
    nlinarith only [hh, mul_le_mul_of_nonneg_left hq₁ hq₀R.le]
  have hq₀N : (q₀ : ℝ) ≤ N := by
    apply (Real.log_le_log_iff hq₀R hN).mp
    have hh := Real.log_le_log hq₀R hq₀Q
    rw [Real.log_mul (by norm_num) hQ.ne'] at hh
    nlinarith only [hh, hlog2, hlogQ, hlogNlo, hlogx]
  have hP (t : ℕ × ℕ) (ht : t ∈ F) (s : ℕ × ℕ) (hs : s ∈ F) :
      0 < P t s ∧ (r : ℝ) ≤ (P t s : ℝ) ∧
      (P t s : ℝ) ≤ 32 * R * Q ^ 4 / (q₀ : ℝ) ^ 3 := by
    obtain ⟨ht₁, ht₂⟩ := hpositive t ht
    obtain ⟨hs₁, hs₂⟩ := hpositive s hs
    have hp : 0 < P t s := Nat.pos_of_ne_zero
      (Nat.lcm_ne_zero (hF t ht).1.ne_zero (hF s hs).1.ne_zero)
    have hdr : r ∣ P t s :=
      (show r ∣ r * q₀ * t.1 * t.2 from ⟨q₀ * t.1 * t.2, by ring⟩).trans
        (Nat.dvd_lcm_left _ _)
    have hpdvd : P t s ∣ r * q₀ * t.1 * t.2 * s.1 * s.2 := by
      apply Nat.lcm_dvd
      · exact ⟨s.1 * s.2, by ring⟩
      · exact ⟨t.1 * t.2, by ring⟩
    refine ⟨hp, by exact_mod_cast Nat.le_of_dvd hp hdr, ?_⟩
    calc
      (P t s : ℝ) ≤ (r : ℝ) * (q₀ : ℝ) * (t.1 : ℝ) * (t.2 : ℝ) * (s.1 : ℝ) * (s.2 : ℝ) := by
        exact_mod_cast Nat.le_of_dvd (by positivity : 0 < r * q₀ * t.1 * t.2 * s.1 * s.2) hpdvd
      _ ≤ (2 * R) * (q₀ : ℝ) * (2 * Q / (q₀ : ℝ)) * (2 * Q / (q₀ : ℝ)) *
          (2 * Q / (q₀ : ℝ)) * (2 * Q / (q₀ : ℝ)) := by
        gcongr
        · exact (hcoordinate t ht).1
        · exact (hcoordinate t ht).2
        · exact (hcoordinate s hs).1
        · exact (hcoordinate s hs).2
      _ = _ := by field_simp [hq₀R.ne']; ring
  have hPscale (t : ℕ × ℕ) (ht : t ∈ F) (s : ℕ × ℕ) (hs : s ∈ F) :
      N ≤ (P t s : ℝ) ^ (3 : ℝ) ∧ (P t s : ℝ) ≤ x ^ (10 : ℝ) := by
    have hp : 0 < (P t s : ℝ) := by exact_mod_cast (hP t ht s hs).1
    constructor
    · apply (Real.log_le_log_iff hN (Real.rpow_pos_of_pos hp _)).mp
      rw [Real.log_rpow hp]
      have hh := Real.log_le_log hR (hRr.trans (hP t ht s hs).2.1)
      nlinarith only [hh, hlogRlo, hlogNhi, hlogx]
    · apply hbound hp
      have hh := Real.log_le_log hp (hP t ht s hs).2.2
      simp (disch := positivity) only [Real.log_div, Real.log_mul, Real.log_pow,
        Nat.cast_ofNat] at hh
      nlinarith only [hh, hlog32, hlogRhi, hlogQ, hlogq, hlogx]
  have hPsqrt (t : ℕ × ℕ) (ht : t ∈ F) (s : ℕ × ℕ) (hs : s ∈ F) :
      Real.sqrt ((P t s / q₀ : ℕ) : ℝ) ≤ 6 * Real.sqrt R * Q ^ 2 / (q₀ : ℝ) ^ 2 := by
    apply (Real.sqrt_le_iff).mpr
    refine ⟨by positivity, ?_⟩
    calc
      ((P t s / q₀ : ℕ) : ℝ) ≤ (P t s : ℝ) / (q₀ : ℝ) := Nat.cast_div_le
      _ ≤ (32 * R * Q ^ 4 / (q₀ : ℝ) ^ 3) / (q₀ : ℝ) :=
        div_le_div_of_nonneg_right (hP t ht s hs).2.2 hq₀R.le
      _ ≤ (6 * Real.sqrt R * Q ^ 2 / (q₀ : ℝ) ^ 2) ^ 2 := by
        calc
          _ = 32 * (R * Q ^ 4 / (q₀ : ℝ) ^ 4) := by field_simp [hq₀R.ne']
          _ ≤ 36 * (R * Q ^ 4 / (q₀ : ℝ) ^ 4) := by
            have hh : 0 ≤ R * Q ^ 4 / (q₀ : ℝ) ^ 4 := by positivity
            nlinarith only [hh]
          _ = _ := by
            rw [div_pow]
            simp only [mul_pow, Real.sq_sqrt hR.le]
            ring
  have hHN : (HN : ℝ) ≤ 2 * H := Nat.floor_le (by positivity)
  have hKN : (KN : ℝ) ≤ 4 * Q ^ 2 / (q₀ : ℝ) ^ 2 := Nat.floor_le (by positivity)
  have hJnat (h : ℤ) (hh : h ∈ J) : h ≠ 0 ∧ -(HN : ℤ) ≤ h ∧ h ≤ (HN : ℤ) := by
    have hcast : (h.natAbs : ℝ) = |(h : ℝ)| := by
      rw [Nat.cast_natAbs, Int.cast_abs]
    have hreal : (h.natAbs : ℝ) ≤ 2 * H := by rw [hcast]; exact (hJ h hh).2
    have habs : h.natAbs ≤ HN :=
      (Nat.le_floor_iff (by positivity : (0 : ℝ) ≤ 2 * H)).mpr
        hreal
    exact ⟨(hJ h hh).1, by omega, by omega⟩
  have hFnat (t : ℕ × ℕ) (ht : t ∈ F) : 0 < t.1 ∧ 0 < t.2 ∧ t.1 * t.2 ≤ KN := by
    refine ⟨(hpositive t ht).1, (hpositive t ht).2, ?_⟩
    apply (Nat.le_floor_iff (by positivity : (0 : ℝ) ≤ 4 * Q ^ 2 / (q₀ : ℝ) ^ 2)).mpr
    calc
      ((t.1 * t.2 : ℕ) : ℝ) = (t.1 : ℝ) * (t.2 : ℝ) := Nat.cast_mul _ _
      _ ≤ (2 * Q / (q₀ : ℝ)) * (2 * Q / (q₀ : ℝ)) :=
        mul_le_mul (hcoordinate t ht).1 (hcoordinate t ht).2 (Nat.cast_nonneg _) (by positivity)
      _ = _ := by ring
  have hHK : (HN : ℝ) * (KN : ℝ) ≤ 8 * H * Q ^ 2 / (q₀ : ℝ) ^ 2 := by
    calc
      _ ≤ (2 * H) * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) :=
        mul_le_mul hHN hKN (Nat.cast_nonneg _) (by positivity)
      _ = _ := by ring
  have hHKx : (HN : ℝ) * (KN : ℝ) ≤ x ^ (10 : ℝ) := by
    apply hHK.trans
    apply hbound (by positivity)
    simp (disch := positivity) only [Real.log_div, Real.log_mul, Real.log_pow, Nat.cast_ofNat]
    nlinarith only [hlog8, hlogHhi, hlogQ, hlogq, hlogx]
  have hJcard : (J.card : ℝ) ≤ 5 * H := by
    have hsub : J ⊆ Finset.Icc (-(HN : ℤ)) (HN : ℤ) :=
      fun h hh => Finset.mem_Icc.mpr (hJnat h hh).2
    have hcard : ((Finset.Icc (-(HN : ℤ)) (HN : ℤ)).card : ℝ) = 2 * (HN : ℝ) + 1 := by
      have hh := Int.card_Icc_of_le (a := -(HN : ℤ)) (b := (HN : ℤ)) (by omega)
      have hh' : ((Finset.Icc (-(HN : ℤ)) (HN : ℤ)).card : ℝ) =
          (HN : ℝ) + 1 - (-(HN : ℝ)) := by exact_mod_cast hh
      linarith only [hh']
    calc
      (J.card : ℝ) ≤ ((Finset.Icc (-(HN : ℤ)) (HN : ℤ)).card : ℝ) := by
        exact_mod_cast Finset.card_le_card hsub
      _ = 2 * (HN : ℝ) + 1 := hcard
      _ ≤ 5 * H := by linarith only [hHN, hHone]
  have hFcard : (F.card : ℝ) ≤ 4 * Q ^ 2 / (q₀ : ℝ) ^ 2 := by
    let QN : ℕ := ⌊2 * Q / (q₀ : ℝ)⌋₊
    have hsub : F ⊆ (Finset.Icc 1 QN) ×ˢ (Finset.Icc 1 QN) := by
      intro t ht
      apply Finset.mem_product.mpr
      constructor
      · exact Finset.mem_Icc.mpr ⟨(hpositive t ht).1,
          (Nat.le_floor_iff (by positivity)).mpr (hcoordinate t ht).1⟩
      · exact Finset.mem_Icc.mpr ⟨(hpositive t ht).2,
          (Nat.le_floor_iff (by positivity)).mpr (hcoordinate t ht).2⟩
    have hcard : F.card ≤ QN ^ 2 := by
      simpa only [Finset.card_product, Nat.card_Icc, Nat.add_sub_cancel, pow_two] using
        Finset.card_le_card hsub
    calc
      (F.card : ℝ) ≤ (QN : ℝ) ^ 2 := by exact_mod_cast hcard
      _ ≤ (2 * Q / (q₀ : ℝ)) ^ 2 :=
        pow_le_pow_left₀ (Nat.cast_nonneg _) (Nat.floor_le (by positivity)) 2
      _ = _ := by ring
  refine ⟨hq₀, hq₀N, hrx, ?_, hJcard, hFcard, hHK, hHKx, hJnat, hFnat⟩
  intro t ht s hs
  exact ⟨(hPscale t ht s hs).1, (hPscale t ht s hs).2, hPsqrt t ht s hs⟩

theorem sourceHighGamma_split_normalized_envelope
    (δ ε C x H N R Q V r q P Y E : ℝ)
    (hC : 1 ≤ C) (hx : 1 ≤ x) (hH : 0 < H) (hN : 0 < N)
    (hR : 0 < R) (hQ : 0 < Q) (hV : 0 < V) (hr : R ≤ r) (hq : 1 ≤ q)
    (hP : 0 < P) (hY : 0 < Y) (hYx : Y ≤ x ^ δ)
    (hPupper : P ≤ 2 * C ^ 4 * R * Q ^ 2 * V / q)
    (hVupper : V ≤ C * x ^ (δ + 5 * ε) * H)
    (h₁ : H ^ (13 / 6 : ℝ) * Q ^ (1 / 3 : ℝ) * R ^ (1 / 6 : ℝ) *
      x ^ (δ / 3 + 5 * ε / 6) / N ^ (1 / 2 : ℝ) ≤ E)
    (h₂ : H ^ 2 / R ≤ E) (h₃ : H / (V * q) ≤ E) :
    (N / q) *
        ((5 * H) ^ 2 * (C * V) ^ 2 *
            (Real.sqrt (N / q) * (P * Y) ^ (1 / 6 : ℝ)) +
          (N / q / r) * (5 * H) * (C * V) * (2 * C * H * V + r)) ≤
      65 * C ^ 3 * (N * V) ^ 2 * E := by
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hxpos : 0 < x := zero_lt_one.trans_le hx
  have hrpos : 0 < r := hR.trans_le hr
  have hqpos : 0 < q := zero_lt_one.trans_le hq
  have hlogC : 0 ≤ Real.log C := Real.log_nonneg hC
  have hlogq : 0 ≤ Real.log q := Real.log_nonneg hq
  have hlog2 : 0 ≤ Real.log 2 := Real.log_nonneg (by norm_num)
  have hlogP := Real.log_le_log hP hPupper
  have hlogV := Real.log_le_log hV hVupper
  have hlogY := Real.log_le_log hY hYx
  simp (disch := positivity) only [Real.log_div, Real.log_mul, Real.log_pow,
    Real.log_rpow, Nat.cast_ofNat] at hlogP hlogV hlogY
  have hdeep : (N / q) * (5 * H) ^ 2 * (C * V) ^ 2 *
      (Real.sqrt (N / q) * (P * Y) ^ (1 / 6 : ℝ)) ≤
        50 * C ^ 3 * (N * V) ^ 2 *
          (H ^ (13 / 6 : ℝ) * Q ^ (1 / 3 : ℝ) * R ^ (1 / 6 : ℝ) *
            x ^ (δ / 3 + 5 * ε / 6) / N ^ (1 / 2 : ℝ)) := by
    apply (Real.log_le_log_iff (by positivity) (by positivity)).mp
    have hlog50 : Real.log 50 = Real.log 2 + 2 * Real.log 5 := by
      rw [show (50 : ℝ) = 2 * 5 ^ 2 by norm_num, Real.log_mul (by norm_num) (by norm_num),
        Real.log_pow]
      norm_num
    simp (disch := positivity) only [Real.sqrt_eq_rpow, Real.log_div, Real.log_mul,
      Real.log_pow, Real.log_rpow, Nat.cast_ofNat, hlog50]
    nlinarith only [hlogP, hlogV, hlogY, hlogC, hlogq, hlog2]
  have hq₂ : 1 ≤ q ^ 2 := one_le_pow₀ hq
  have hsecond : H ^ 2 / (q ^ 2 * r) ≤ E := by
    apply le_trans ?_ h₂
    exact div_le_div_of_nonneg_left (sq_nonneg _) hR
      (hr.trans (le_mul_of_one_le_left hrpos.le hq₂))
  have hthird : H / (q ^ 2 * V) ≤ E := by
    apply le_trans ?_ h₃
    apply div_le_div_of_nonneg_left hH.le (by positivity)
    nlinarith only [mul_le_mul_of_nonneg_left hq (mul_nonneg hqpos.le hV.le)]
  have hmean : (N / q) * (N / q / r) * (5 * H) * (C * V) *
      (2 * C * H * V + r) ≤ (N * V) ^ 2 * (10 * C ^ 2 * E + 5 * C * E) := by
    calc
      _ = (N * V) ^ 2 *
          (10 * C ^ 2 * (H ^ 2 / (q ^ 2 * r)) + 5 * C * (H / (q ^ 2 * V))) := by
        field_simp [hqpos.ne', hrpos.ne', hV.ne']
        ring
      _ ≤ _ := by gcongr
  have hE : 0 ≤ E := (div_nonneg (sq_nonneg H) hR.le).trans h₂
  have hC₂ : C ^ 2 ≤ C ^ 3 := by nlinarith only [mul_le_mul_of_nonneg_left hC (sq_nonneg C)]
  have hC₃ : C ≤ C ^ 3 := by
    have hh : C ≤ C ^ 2 := by nlinarith only [mul_le_mul_of_nonneg_left hC hCpos.le]
    exact hh.trans hC₂
  calc
    _ = (N / q) * (5 * H) ^ 2 * (C * V) ^ 2 *
        (Real.sqrt (N / q) * (P * Y) ^ (1 / 6 : ℝ)) +
          (N / q) * (N / q / r) * (5 * H) * (C * V) * (2 * C * H * V + r) := by ring
    _ ≤ 50 * C ^ 3 * (N * V) ^ 2 * E + (N * V) ^ 2 * (10 * C ^ 2 * E + 5 * C * E) :=
      add_le_add (hdeep.trans (mul_le_mul_of_nonneg_left h₁ (by positivity))) hmean
    _ ≤ 50 * C ^ 3 * (N * V) ^ 2 * E + (N * V) ^ 2 * (10 * C ^ 3 * E + 5 * C ^ 3 * E) := by
      gcongr
    _ = _ := by ring

open Classical in
theorem sourceHighGamma_split_geometry
    («ω» δ ε C x M N R Q H V γ : ℝ) (r q₀ u q₂ : ℕ)
    (hω : 0 ≤ «ω») (hδ : 0 ≤ δ)
    (hC : 1 ≤ C) (hx : 1 ≤ x) (hxlarge : 100 * C ≤ x ^ (1 / 100 : ℝ))
    (hε : 0 < ε) (hεsmall : ε ≤ 1 / 100)
    (hδsmall : δ + 4 * ε ≤ 1 / 12) (hδ₅ : δ + 5 * ε ≤ 1 / 10)
    (hRQexponent : 1 / 2 + 2 * «ω» + ε ≤ 7 / 12)
    (hM : 0 < M) (hN : 0 < N) (hR : 0 < R) (hQ : 0 < Q) (hV : 0 < V)
    (hq₀ : 0 < q₀) (hu : 0 < u) (hq₂ : 0 < q₂)
    (hMN : x / C ≤ M * N) (hNγ : N = x ^ γ)
    (hNR : N ≤ C * x ^ (δ + 4 * ε) * R)
    (hRN : R ≤ C * x ^ (-2 * ε) * N)
    (hRQ : R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε))
    (hγlo : 1 / 4 + 14 * «ω» + 4 * δ + 100 * ε ≤ γ)
    (hγlower : 1 / 4 ≤ γ) (hγhi : γ ≤ 1 / 2)
    (hRr : R ≤ (r : ℝ)) (hrR : (r : ℝ) ≤ 2 * R)
    (hH : H = x ^ ε * R * Q ^ 2 / ((q₀ : ℝ) * M)) (hHone : 1 ≤ H)
    (huV : (u : ℝ) * V ≤ C * Q / (q₀ : ℝ))
    (hq₂Q : (q₀ : ℝ) * (q₂ : ℝ) ≤ C * Q)
    (hVupper : V ≤ C * x ^ (δ + 5 * ε) * H) :
    let HN : ℕ := ⌊2 * H⌋₊
    let KN : ℕ := ⌊C * V⌋₊
    let P₀ : ℝ := (r : ℝ) * (q₀ : ℝ) * (u : ℝ) * (KN : ℝ) ^ 2 * (q₂ : ℝ)
    (q₀ : ℝ) ≤ N ∧ N ≤ (r : ℝ) ^ (3 : ℝ) ∧ (r : ℝ) ≤ x ^ (10 : ℝ) ∧
      (HN : ℝ) * (KN : ℝ) ≤ x ^ (10 : ℝ) ∧ P₀ ≤ x ^ (10 : ℝ) ∧
      P₀ ≤ 2 * C ^ 4 * R * Q ^ 2 * V / (q₀ : ℝ) ∧
      (HN : ℝ) * (KN : ℝ) ≤ 2 * C * H * V := by
  intro HN KN P₀
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hxpos : 0 < x := zero_lt_one.trans_le hx
  have hqpos : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀
  have hqone : 1 ≤ (q₀ : ℝ) := by exact_mod_cast hq₀
  have hrpos : 0 < (r : ℝ) := hR.trans_le hRr
  have hHpos : 0 < H := zero_lt_one.trans_le hHone
  have hlogx : 0 ≤ Real.log x := Real.log_nonneg hx
  have hlogq : 0 ≤ Real.log (q₀ : ℝ) := Real.log_nonneg hqone
  have hlogH0 : 0 ≤ Real.log H := Real.log_nonneg hHone
  have hlogC : Real.log C ≤ (1 / 100 : ℝ) * Real.log x := by
    have hh := Real.log_le_log hCpos ((show C ≤ 100 * C by nlinarith only [hCpos]).trans hxlarge)
    simpa only [Real.log_rpow hxpos] using hh
  have hlog2 : Real.log 2 ≤ (1 / 100 : ℝ) * Real.log x := by
    have hh := Real.log_le_log (by norm_num : (0 : ℝ) < 2)
      ((show (2 : ℝ) ≤ 100 * C by linarith only [hC]).trans hxlarge)
    simpa only [Real.log_rpow hxpos] using hh
  have hlogN : Real.log N = γ * Real.log x := by rw [hNγ, Real.log_rpow hxpos]
  have hlogNlo : (1 / 4 : ℝ) * Real.log x ≤ Real.log N := by
    rw [hlogN]; exact mul_le_mul_of_nonneg_right hγlower hlogx
  have hlogNhi : Real.log N ≤ (1 / 2 : ℝ) * Real.log x := by
    rw [hlogN]; exact mul_le_mul_of_nonneg_right hγhi hlogx
  have hlogMN : Real.log x - Real.log C ≤ Real.log M + Real.log N := by
    have hh := Real.log_le_log (by positivity : 0 < x / C) hMN
    simpa (disch := positivity) only [Real.log_div, Real.log_mul] using hh
  have hlogNR : Real.log N ≤ Real.log C + (δ + 4 * ε) * Real.log x + Real.log R := by
    have hh := Real.log_le_log hN hNR
    simpa (disch := positivity) only [Real.log_mul, Real.log_rpow] using hh
  have hlogRN : Real.log R ≤ Real.log C + (-2 * ε) * Real.log x + Real.log N := by
    have hh := Real.log_le_log hR hRN
    simpa (disch := positivity) only [Real.log_mul, Real.log_rpow] using hh
  have hlogRQ : Real.log R + Real.log Q ≤ Real.log C +
      (1 / 2 + 2 * «ω» + ε) * Real.log x := by
    have hh := Real.log_le_log (mul_pos hR hQ) hRQ
    simpa (disch := positivity) only [Real.log_mul, Real.log_rpow] using hh
  have hlogRlo : (3 / 20 : ℝ) * Real.log x ≤ Real.log R := by
    nlinarith only [hlogNlo, hlogNR, hlogC,
      mul_le_mul_of_nonneg_right hδsmall hlogx, hlogx]
  have hlogRhi : Real.log R ≤ (51 / 100 : ℝ) * Real.log x := by
    nlinarith only [hlogRN, hlogC, hlogNhi, hε, hlogx]
  have hlogQ : Real.log Q ≤ (1 / 2 : ℝ) * Real.log x := by
    nlinarith only [hlogRQ, hlogRlo, hlogC,
      mul_le_mul_of_nonneg_right hRQexponent hlogx, hlogx]
  have hlogM : 0 ≤ Real.log M := by nlinarith only [hlogMN, hlogC, hlogNhi, hlogx]
  have hlogH : Real.log H = ε * Real.log x + Real.log R +
      2 * Real.log Q - Real.log (q₀ : ℝ) - Real.log M := by
    rw [hH]
    simp (disch := positivity) only [Real.log_div, Real.log_mul, Real.log_rpow, Real.log_pow]
    ring
  have hlogHhi : Real.log H ≤ 2 * Real.log x := by
    nlinarith only [hlogH, hlogRhi, hlogQ, hlogq, hlogM,
      mul_le_mul_of_nonneg_right hεsmall hlogx, hlogx]
  have hlogV : Real.log V ≤ 3 * Real.log x := by
    have hh := Real.log_le_log hV hVupper
    simp (disch := positivity) only [Real.log_mul, Real.log_rpow] at hh
    nlinarith only [hh, hlogHhi, hlogC, mul_le_mul_of_nonneg_right hδ₅ hlogx, hlogx]
  have hbound {z p : ℝ} (hz : 0 < z) (hh : Real.log z ≤ p * Real.log x) : z ≤ x ^ p := by
    apply (Real.log_le_log_iff hz (Real.rpow_pos_of_pos hxpos _)).mp
    simpa only [Real.log_rpow hxpos] using hh
  have hqN : (q₀ : ℝ) ≤ N := by
    apply (Real.log_le_log_iff hqpos hN).mp
    have hgamma := mul_le_mul_of_nonneg_right hγlo hlogx
    nlinarith only [hlogH, hlogH0, hlogMN, hlogRQ, hlogNR, hlogC, hlogN, hgamma,
      mul_nonneg hω hlogx, mul_nonneg hδ hlogx, mul_nonneg hε.le hlogx, hlogx]
  have hNr : N ≤ (r : ℝ) ^ (3 : ℝ) := by
    apply (Real.log_le_log_iff hN (Real.rpow_pos_of_pos hrpos _)).mp
    rw [Real.log_rpow hrpos]
    have hh := Real.log_le_log hR hRr
    nlinarith only [hh, hlogNR, hlogNlo, hlogC,
      mul_le_mul_of_nonneg_right hδsmall hlogx, hlogx]
  have hrx : (r : ℝ) ≤ x ^ (10 : ℝ) := by
    apply hbound hrpos
    have hh := Real.log_le_log hrpos hrR
    rw [Real.log_mul (by norm_num) hR.ne'] at hh
    nlinarith only [hh, hlog2, hlogRhi, hlogx]
  have hHN : (HN : ℝ) ≤ 2 * H := Nat.floor_le (by positivity)
  have hKN : (KN : ℝ) ≤ C * V := Nat.floor_le (by positivity)
  have hHK : (HN : ℝ) * (KN : ℝ) ≤ 2 * C * H * V := by
    calc
      _ ≤ (2 * H) * (C * V) := mul_le_mul hHN hKN (Nat.cast_nonneg _) (by positivity)
      _ = _ := by ring
  have hHKx : (HN : ℝ) * (KN : ℝ) ≤ x ^ (10 : ℝ) := by
    apply hHK.trans
    apply hbound (by positivity)
    simp (disch := positivity) only [Real.log_mul]
    nlinarith only [hlog2, hlogC, hlogHhi, hlogV, hlogx]
  have hP : P₀ ≤ 2 * C ^ 4 * R * Q ^ 2 * V / (q₀ : ℝ) := by
    have hq₂bound : (q₂ : ℝ) ≤ C * Q / (q₀ : ℝ) := by
      apply (le_div_iff₀ hqpos).mpr
      simpa only [mul_comm] using hq₂Q
    calc
      P₀ ≤ (2 * R) * (q₀ : ℝ) * (u : ℝ) * (C * V) ^ 2 * (C * Q / (q₀ : ℝ)) := by
        dsimp only [P₀]
        gcongr
      _ = (2 * C ^ 3 * R * Q * V) * ((u : ℝ) * V) := by field_simp [hqpos.ne']
      _ ≤ (2 * C ^ 3 * R * Q * V) * (C * Q / (q₀ : ℝ)) :=
        mul_le_mul_of_nonneg_left huV (by positivity)
      _ = _ := by ring
  have hPx : P₀ ≤ x ^ (10 : ℝ) := by
    apply hP.trans
    apply hbound (by positivity)
    simp (disch := positivity) only [Real.log_div, Real.log_mul, Real.log_pow, Nat.cast_ofNat]
    nlinarith only [hlog2, hlogC, hlogRhi, hlogQ, hlogV, hlogq, hlogx]
  exact ⟨hqN, hNr, hrx, hHKx, hPx, hP, hHK⟩

theorem sourceHighGamma_split_energy_finish
    (C₀ C TN L x ε N V q U g m S E : ℝ)
    (hC₀ : 0 < C₀) (hC : 1 ≤ C) (hTN : 1 ≤ TN)
    (hx : 1 ≤ x) (hε : 0 < ε) (hN : 0 < N) (hV : 0 < V) (hq : 0 < q)
    (hU : 0 ≤ U) (hg : 0 ≤ g) (hS : 0 ≤ S) :
    let D : ℝ := x ^ (ε / 100)
    U ^ 2 ≤ C₀ * D ^ 4 * g ^ 2 * m * L ^ 2 * D * S →
    m ≤ (1 + TN) * N / q →
    S ≤ D * E →
    (N / q) * E ≤ 65 * C ^ 3 * (N * V) ^ 2 * (C ^ 12 * x ^ (-5 * ε)) →
    U ≤ Real.sqrt (65 * C₀ * (1 + TN) * L ^ 2 * C ^ 15 + 1) *
      g * N * V * x ^ (-2 * ε) := by
  intro D hbound hmass hbracket hnormalized
  have hxpos : 0 < x := zero_lt_one.trans_le hx
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hTNpos : 0 < TN := zero_lt_one.trans_le hTN
  have hDpos : 0 < D := Real.rpow_pos_of_pos hxpos _
  let K := Real.sqrt (65 * C₀ * (1 + TN) * L ^ 2 * C ^ 15 + 1)
  let Z := g * N * V
  have hK : 0 < K := by dsimp only [K]; positivity
  have hZ : 0 ≤ Z := by dsimp only [Z]; positivity
  have hfinalsq : U ^ 2 ≤
      (65 * C₀ * (1 + TN) * L ^ 2 * C ^ 15) * Z ^ 2 * D ^ 6 * x ^ (-5 * ε) := by
    apply hbound.trans
    calc
      _ ≤ C₀ * D ^ 4 * g ^ 2 * ((1 + TN) * N / q) * L ^ 2 * D * (D * E) := by
        have hpref : C₀ * D ^ 4 * g ^ 2 * m * L ^ 2 * D ≤
            C₀ * D ^ 4 * g ^ 2 * ((1 + TN) * N / q) * L ^ 2 * D :=
          mul_le_mul_of_nonneg_right
            (mul_le_mul_of_nonneg_right
              (mul_le_mul_of_nonneg_left hmass (by positivity)) (sq_nonneg L)) hDpos.le
        exact mul_le_mul hpref hbracket hS (by positivity)
      _ = (C₀ * (1 + TN) * L ^ 2 * g ^ 2 * D ^ 6) * ((N / q) * E) := by ring
      _ ≤ (C₀ * (1 + TN) * L ^ 2 * g ^ 2 * D ^ 6) *
          (65 * C ^ 3 * (N * V) ^ 2 * (C ^ 12 * x ^ (-5 * ε))) :=
        mul_le_mul_of_nonneg_left hnormalized (by positivity)
      _ = _ := by dsimp only [Z]; ring
  have hpower : D ^ 6 * x ^ (-5 * ε) ≤ x ^ (-4 * ε) := by
    calc
      D ^ 6 * x ^ (-5 * ε) = x ^ (6 * (ε / 100) - 5 * ε) := by
        dsimp only [D]
        rw [← Real.rpow_mul_natCast hxpos.le, ← Real.rpow_add hxpos]
        congr 1
        ring
      _ ≤ x ^ (-4 * ε) := Real.rpow_le_rpow_of_exponent_le hx (by linarith only [hε])
  have hKsq : K ^ 2 = 65 * C₀ * (1 + TN) * L ^ 2 * C ^ 15 + 1 := Real.sq_sqrt (by positivity)
  have hxpow : (x ^ (-2 * ε)) ^ 2 = x ^ (-4 * ε) := by
    rw [← Real.rpow_mul_natCast hxpos.le]
    congr 1
    ring
  have hsq : U ^ 2 ≤ (K * Z * x ^ (-2 * ε)) ^ 2 := by
    calc
      U ^ 2 ≤ (65 * C₀ * (1 + TN) * L ^ 2 * C ^ 15) * Z ^ 2 * (D ^ 6 * x ^ (-5 * ε)) := by
        simpa only [mul_assoc] using hfinalsq
      _ ≤ K ^ 2 * Z ^ 2 * x ^ (-4 * ε) := by
        gcongr
        rw [hKsq]
        linarith
      _ = _ := by
        simp only [mul_pow, hxpow]
  have hfinal := (sq_le_sq₀ hU (show 0 ≤ K * Z * x ^ (-2 * ε) by positivity)).mp hsq
  simpa only [K, Z, mul_assoc] using hfinal

theorem source_single_dense_mul_same
    (Y : Set.Ici (1 : ℝ)) (m n : ℕ)
    (hm : Nonempty (DenseDivisibilityWitness Y 1 m))
    (hn : Nonempty (DenseDivisibilityWitness Y 1 n)) :
    Nonempty (DenseDivisibilityWitness Y 1 (m * n)) := by
  obtain ⟨hmpos, hmd⟩ := single_dense_iff.mp hm
  obtain ⟨hnpos, hnd⟩ := single_dense_iff.mp hn
  have hmR : 0 < (m : ℝ) := by exact_mod_cast hmpos
  have hYR : 0 < (Y : ℝ) := zero_lt_one.trans_le Y.property
  apply single_dense_iff.mpr
  refine ⟨Nat.mul_pos hmpos hnpos, ?_⟩
  intro X hX hXmn
  by_cases hXm : X ≤ (m : ℝ)
  · obtain ⟨d, hdm, hdlo, hdhi⟩ := hmd X hX hXm
    exact ⟨d, dvd_mul_of_dvd_left hdm n, hdlo, hdhi⟩
  have htarget : 1 ≤ X / (m : ℝ) :=
    (one_le_div hmR).mpr (le_of_not_ge hXm)
  have htargetn : X / (m : ℝ) ≤ (n : ℝ) := by
    apply (div_le_iff₀ hmR).mpr
    simpa only [Nat.cast_mul, mul_comm] using hXmn
  obtain ⟨d, hdn, hdlo, hdhi⟩ := hnd (X / (m : ℝ)) htarget htargetn
  refine ⟨m * d, Nat.mul_dvd_mul_left m hdn, ?_, ?_⟩
  · have hh := mul_le_mul_of_nonneg_left hdlo hmR.le
    calc
      X / (Y : ℝ) = (m : ℝ) * (X / (m : ℝ) / (Y : ℝ)) := by
        field_simp [hmR.ne', hYR.ne']
      _ ≤ (m : ℝ) * (d : ℝ) := hh
      _ = ((m * d : ℕ) : ℝ) := (Nat.cast_mul _ _).symm
  · have hh := mul_le_mul_of_nonneg_left hdhi hmR.le
    simpa only [Nat.cast_mul, mul_div_cancel₀ X hmR.ne'] using hh

open Classical in
theorem sourceHighGamma_weighted_row_norm
    (r q₀ u v q₂ a b₁ b₂ : ℕ) (ℓ : ℤ)
    (M R Q : ℝ) (hM : 0 < M) (hR : 0 < R) (hQ : 0 < Q)
    (hr : 0 < r) (hq₀ : 0 < q₀) (hu : 0 < u) (hv : 0 < v) (hq₂ : 0 < q₂)
    (hRr : R ≤ (r : ℝ)) (hQ₁ : Q ≤ (q₀ * u * v : ℕ))
    (hQ₂ : Q ≤ (q₀ * q₂ : ℕ))
    (ν₁ ν₂ : ℂ) (hν₁ : ‖ν₁‖ ≤ 1) (hν₂ : ‖ν₂‖ ≤ 1)
    (S J : Finset ℤ) (β : ℤ → ℂ) (c : ℤ → ℂ) :
    let P : ℕ := r * q₀ * u * v * q₂
    ‖ν₁ * star ν₂ * ((M : ℂ) / (P : ℂ)) *
      ∑ n ∈ S.filter (fun n =>
        Int.gcd n ((r * q₀ * u * v : ℕ) : ℤ) = 1 ∧
        Int.gcd (n + ℓ * (r : ℤ)) ((q₀ * q₂ : ℕ) : ℤ) = 1),
        β n * star (β (n + ℓ * (r : ℤ))) *
          (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
            ∑ h ∈ J, c h * sourceTheta r q₀ u v q₂ a b₁ b₂ ℓ n h‖ ≤
      (M * (q₀ : ℝ) / (R * Q ^ 2)) *
        ‖∑ n ∈ S, β n * star (β (n + ℓ * (r : ℤ))) *
          (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
            ∑ h ∈ J, c h * sourceTheta r q₀ u v q₂ a b₁ b₂ ℓ n h‖ := by
  intro P
  have hsum :
      (∑ n ∈ S.filter (fun n =>
        Int.gcd n ((r * q₀ * u * v : ℕ) : ℤ) = 1 ∧
        Int.gcd (n + ℓ * (r : ℤ)) ((q₀ * q₂ : ℕ) : ℤ) = 1),
        β n * star (β (n + ℓ * (r : ℤ))) *
          (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
            ∑ h ∈ J, c h * sourceTheta r q₀ u v q₂ a b₁ b₂ ℓ n h) =
      ∑ n ∈ S, β n * star (β (n + ℓ * (r : ℤ))) *
        (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
          ∑ h ∈ J, c h * sourceTheta r q₀ u v q₂ a b₁ b₂ ℓ n h := by
    rw [Finset.sum_filter]
    apply Finset.sum_congr rfl
    intro n _
    by_cases hn : Int.gcd n ((r * q₀ * u * v : ℕ) : ℤ) = 1 ∧
        Int.gcd (n + ℓ * (r : ℤ)) ((q₀ * q₂ : ℕ) : ℤ) = 1
    · simp only [ite_eq_left hn]
    · have hz (h : ℤ) : (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
          sourceTheta r q₀ u v q₂ a b₁ b₂ ℓ n h = 0 := by
        have hh := sourceTheta_compatibility_pole_mask r q₀ u v q₂ a b₁ b₂ ℓ n h
        simpa only [ite_eq_right hn] using hh.symm
      have heq : β n * star (β (n + ℓ * (r : ℤ))) *
          (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
            ∑ h ∈ J, c h * sourceTheta r q₀ u v q₂ a b₁ b₂ ℓ n h = 0 := by
        rw [Finset.mul_sum]
        apply Finset.sum_eq_zero
        intro h _
        calc
          _ = (β n * star (β (n + ℓ * (r : ℤ))) * c h) *
              ((sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
                sourceTheta r q₀ u v q₂ a b₁ b₂ ℓ n h) := by ring
          _ = 0 := by rw [hz h, mul_zero]
      simp only [ite_eq_right hn, heq]
  have hP : 0 < (P : ℝ) := by dsimp only [P]; positivity
  have hqq : Q ^ 2 ≤ ((q₀ * u * v : ℕ) : ℝ) * ((q₀ * q₂ : ℕ) : ℝ) := by
    simpa only [pow_two] using mul_le_mul hQ₁ hQ₂ hQ.le (hQ.le.trans hQ₁)
  have hden : R * Q ^ 2 ≤ (P : ℝ) * (q₀ : ℝ) := by
    simpa only [P, Nat.cast_mul, mul_assoc, mul_left_comm, mul_comm] using
      mul_le_mul hRr hqq (sq_nonneg _) (Nat.cast_nonneg _)
  have hscale : M / (P : ℝ) ≤ M * (q₀ : ℝ) / (R * Q ^ 2) := by
    apply (div_le_div_iff₀ hP (mul_pos hR (pow_pos hQ 2))).mpr
    simpa only [mul_assoc, mul_left_comm, mul_comm] using
      mul_le_mul_of_nonneg_left hden hM.le
  have hcoefficient : ‖ν₁ * star ν₂ * ((M : ℂ) / (P : ℂ))‖ ≤
      M * (q₀ : ℝ) / (R * Q ^ 2) := by
    apply le_trans ?_ hscale
    simp only [norm_mul, norm_star, norm_div, Complex.norm_of_nonneg hM.le, Complex.norm_natCast]
    exact mul_le_of_le_one_left (div_nonneg hM.le hP.le)
      ((mul_le_of_le_one_left (norm_nonneg _) hν₁).trans hν₂)
  rw [hsum, norm_mul]
  exact mul_le_mul_of_nonneg_right hcoefficient (norm_nonneg _)

open Classical in
theorem opening_high_scale_resources (C «ω» δ ε : ℝ)
    (hC : 1 ≤ C) (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε)
    (hworking : 72 * «ω» + 24 * δ < 1) (hsmall : ε < δ / 10 ^ 100) :
    ∀ᶠ x : ℝ in Filter.atTop,
      Real.exp 1 ≤ x ∧ 2 ≤ x ∧ C ^ 2 ≤ x ^ (δ / 2 - 7 * ε) ∧
      ∀ M N R Q γ : ℝ,
        0 < M → 0 < N → 0 < R → 0 < Q →
        x / C ≤ M * N → M * N ≤ C * x → N = x ^ γ →
        1 / 4 + 14 * «ω» + 4 * δ + 100 * ε ≤ γ →
        γ ≤ 1 / 2 →
        N ≤ C * x ^ (δ + 4 * ε) * R →
        R ≤ C * x ^ (-2 * ε) * N →
        R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) →
        1 ≤ N ∧ N ≤ x ∧ 1 ≤ M ∧ M ≤ x ^ 2 ∧ R ≤ x ∧ Q ≤ x ∧
          4 * x ^ ε < M := by
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hεδ : ε < δ :=
    hsmall.trans_le (div_le_self hδ.le (by norm_num))
  have hεhalf : ε < 1 / 2 := by
    linarith only [hεδ, hworking, hω]
  have hmargin : 0 < δ / 2 - 7 * ε := by
    have hs := (lt_div_iff₀ (by positivity : (0 : ℝ) < 10 ^ 100)).mp hsmall
    have hn : (100 : ℝ) ≤ 10 ^ 100 := by norm_num
    nlinarith only [hs, hn, hε]
  have hCmargin : ∀ᶠ x : ℝ in Filter.atTop,
      C ^ 2 ≤ x ^ (δ / 2 - 7 * ε) :=
    (tendsto_rpow_atTop hmargin).eventually_ge_atTop (C ^ 2)
  have hCquarter : ∀ᶠ x : ℝ in Filter.atTop, C ^ 2 ≤ x ^ (1 / 4 : ℝ) :=
    (tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 4)).eventually_ge_atTop
      (C ^ 2)
  have hCutoff := eventually_scale_dominates_cutoff_of_product_lower
    (1 / C) 1 (1 / 2) ε 4 (by positivity) (by norm_num) (by norm_num)
    (by linarith only [hεhalf])
  filter_upwards [Filter.eventually_ge_atTop (Real.exp 1),
    Filter.eventually_ge_atTop (2 : ℝ), hCmargin, hCquarter, hCutoff]
    with x hxe hx2 hCmarginAt hCquarterAt hCutoffAt
  refine ⟨hxe, hx2, hCmarginAt, ?_⟩
  intro M N R Q γ hM hN _hR hQ hMNlo hMNhi hNγ hγlo hγhi hNR hRupper hRQ
  have hxone : 1 ≤ x := (by norm_num : (1 : ℝ) ≤ 2).trans hx2
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  have hγlower : 1 / 4 + 14 * «ω» + 4 * δ + 100 * ε ≤ γ := hγlo
  have hγnonneg : 0 ≤ γ := by linarith only [hγlower, hω, hδ, hε]
  have hγhalf : γ ≤ 1 / 2 := by linarith only [hγhi, hω, hδ, hε]
  have hNhalf : N ≤ x ^ (1 / 2 : ℝ) := by
    rw [hNγ]
    exact Real.rpow_le_rpow_of_exponent_le hxone hγhalf
  have hhalf : x ^ (1 / 2 : ℝ) ≤ x := by
    simpa only [Real.rpow_one] using
      Real.rpow_le_rpow_of_exponent_le hxone (by norm_num : (1 / 2 : ℝ) ≤ 1)
  have hNone : 1 ≤ N := by
    rw [hNγ]
    exact Real.one_le_rpow hxone hγnonneg
  have hCpow : C ≤ C ^ 2 := by
    simpa only [mul_one, pow_two] using mul_le_mul_of_nonneg_left hC hCpos.le
  have hCquarterBound : C ≤ x ^ (1 / 4 : ℝ) := hCpow.trans hCquarterAt
  have hChalf : C ≤ x ^ (1 / 2 : ℝ) := hCquarterBound.trans
    (Real.rpow_le_rpow_of_exponent_le hxone (by norm_num : (1 / 4 : ℝ) ≤ 1 / 2))
  have hCx : C ≤ x := hChalf.trans hhalf
  have hMcut : 4 * x ^ ε < M := hCutoffAt M N hN
    (by simpa only [one_mul] using hNhalf)
    (by simpa only [one_div, div_eq_mul_inv, mul_comm, mul_one] using hMNlo)
  have hMone : 1 ≤ M := by
    have hxeone : 1 ≤ x ^ ε := Real.one_le_rpow hxone hε.le
    linarith only [hMcut, hxeone]
  have hMupper : M ≤ x ^ 2 := by
    calc
      M ≤ M * N := le_mul_of_one_le_right hM.le hNone
      _ ≤ C * x := hMNhi
      _ ≤ x * x := mul_le_mul_of_nonneg_right hCx hxpos.le
      _ = x ^ 2 := (pow_two x).symm
  have hRsmall : R ≤ x := by
    have hxnegative : x ^ (-2 * ε) ≤ 1 :=
      Real.rpow_le_one_of_one_le_of_nonpos hxone (by linarith only [hε])
    calc
      R ≤ C * x ^ (-2 * ε) * N := hRupper
      _ ≤ C * 1 * N := mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_left hxnegative hCpos.le) hN.le
      _ = C * N := by ring
      _ ≤ x ^ (1 / 2 : ℝ) * x ^ (1 / 2 : ℝ) :=
        mul_le_mul hChalf hNhalf hN.le (Real.rpow_nonneg hxpos.le _)
      _ = x := by rw [← Real.rpow_add hxpos]; norm_num
  have hQN : Q * N ≤ C ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε) := by
    calc
      Q * N ≤ Q * (C * x ^ (δ + 4 * ε) * R) :=
        mul_le_mul_of_nonneg_left hNR hQ.le
      _ = (C * x ^ (δ + 4 * ε)) * (R * Q) := by ring
      _ ≤ (C * x ^ (δ + 4 * ε)) * (C * x ^ (1 / 2 + 2 * «ω» + ε)) :=
        mul_le_mul_of_nonneg_left hRQ (by positivity)
      _ = C ^ 2 * (x ^ (δ + 4 * ε) * x ^ (1 / 2 + 2 * «ω» + ε)) := by ring
      _ = C ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε) := by
        rw [← Real.rpow_add hxpos,
          show δ + 4 * ε + (1 / 2 + 2 * «ω» + ε) =
            1 / 2 + 2 * «ω» + δ + 5 * ε by ring]
  have hQsmall : Q ≤ x := by
    have hpower : 1 / 2 + 2 * «ω» + δ + 5 * ε - γ ≤ 1 / 4 := by
      linarith only [hγlower, hω, hδ, hε]
    calc
      Q ≤ (C ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε)) / N :=
        (le_div_iff₀ hN).mpr hQN
      _ = C ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε - γ) := by
        rw [hNγ, mul_div_assoc, ← Real.rpow_sub hxpos]
      _ ≤ C ^ 2 * x ^ (1 / 4 : ℝ) := mul_le_mul_of_nonneg_left
        (Real.rpow_le_rpow_of_exponent_le hxone hpower) (sq_nonneg C)
      _ ≤ x ^ (1 / 4 : ℝ) * x ^ (1 / 4 : ℝ) :=
        mul_le_mul_of_nonneg_right hCquarterAt (Real.rpow_nonneg hxpos.le _)
      _ = x ^ (1 / 2 : ℝ) := by rw [← Real.rpow_add hxpos]; norm_num
      _ ≤ x := hhalf
  exact ⟨hNone, hNhalf.trans hhalf, hMone, hMupper, hRsmall, hQsmall, hMcut⟩

open Classical in
theorem opening_high_diagonal
    (d : ℕ) («ω» δ ε K T Bβ L Eβ Eψ A : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε)
    (hK : 1 ≤ K) (hT : 0 < T) (hBβ : 0 ≤ Bβ) (hL : 0 ≤ L)
    (hA : 0 ≤ A) :
    ∀ᶠ x : ℝ in Filter.atTop,
      ∀ (γ M Q R : ℝ) (N : ℕ),
        1 / 4 + 14 * «ω» + 4 * δ + 100 * ε ≤ γ →
        γ ≤ 1 / 2 →
        0 < M → 0 < Q → 0 < R →
        x / K ≤ M * x ^ γ → M * x ^ γ ≤ K * x →
        x ^ (-δ - 4 * ε) * x ^ γ / K ≤ R →
        R ≤ K * x ^ (-2 * ε) * x ^ γ →
        R * Q ≤ K * x ^ (1 / 2 + 2 * «ω» + ε) →
        (N : ℝ) ≤ K * x ^ γ →
        ∀ (S : Finset (ℕ × ℕ)) (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ),
          β.support ⊆ Finset.Icc 1 N →
          (∀ n ∈ β.support,
            ‖β n‖ ≤ Bβ * (n.divisors.card : ℝ) ^ d * (Real.log x) ^ Eβ) →
          (∀ p ∈ S, ‖c p‖ ≤ 1) →
          (∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Nat.Coprime p.1 p.2 ∧
            Q ≤ (p.1 : ℝ) ∧ (p.1 : ℝ) ≤ 2 * Q ∧
            R ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ 2 * R) →
          ∀ (a b₁ b₂ : ℕ) (ψ : ℝ → ℝ),
            (∀ t : ℝ, |ψ t| ≤ L * (Real.log x) ^ Eψ) →
            let sm : Finset ℕ := Finset.Icc 1 ⌊T * M⌋₊
            let w : ℕ → ℝ := fun n => ψ ((n : ℝ) / M)
            (∑ r ∈ S.image Prod.snd,
              ∑ p₁ ∈ S.filter (fun p => p.2 = r),
                ∑ p₂ ∈ S.filter (fun p => p.2 = r),
                  ‖c p₁ * star (c p₂) *
                    (∑ n ∈ β.support, β n * star (β n) *
                      (mixedFiberMass sm w p₁.1 p₂.1 r a b₁ b₂ n n : ℂ))‖) ≤
              M * (x ^ γ) ^ 2 / R * (Real.log x) ^ (-A) := by
  have hKpos : 0 < K := zero_lt_one.trans_le hK
  obtain ⟨C, hC, hfinite⟩ := mixedFiberMass_diagonal_family_subpower_majorant d ε hε
  let F : ℝ := T * K ^ 2
  let H : ℝ := 24 * F + 8 * K ^ 3
  let D : ℝ := C * Bβ ^ 2 * L * F ^ ε * H
  let E : ℝ := 2 * Eβ + Eψ + 4
  have hF : 0 < F := by dsimp [F]; positivity
  have hsmall : ∀ᶠ x : ℝ in Filter.atTop,
      ‖D * K ^ 2 * (Real.log x) ^ (E + A)‖ ≤ ‖x ^ ε‖ :=
    ((isLittleO_log_rpow_rpow_atTop (E + A) hε).const_mul_left
      (D * K ^ 2)).eventuallyLE
  have hlarge : ∀ᶠ x : ℝ in Filter.atTop, 2 * K ^ 2 ≤ x ^ ((1 : ℝ) / 2) :=
    (tendsto_rpow_atTop one_half_pos).eventually_ge_atTop _
  filter_upwards [hsmall, hlarge, Filter.eventually_ge_atTop (Real.exp 1)]
    with x hxsmall hxlarge hx
  intro γ M Q R N hγlower hγupper hM hQ hR hMNlower hMNupper hRlower hRupper hRQ hN
    S β c hsupport hβ hc hS a b₁ b₂ ψ hψ sm w
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
  have hxone : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hx
  have hlogone : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hx
  have hlog : 0 ≤ Real.log x := zero_le_one.trans hlogone
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlogone
  have hdecay : 0 ≤ (Real.log x) ^ (-A) := by
    rw [Real.rpow_neg hlog]
    exact inv_nonneg.mpr (zero_le_one.trans (Real.one_le_rpow hlogone hA))
  have hxγ : 0 < x ^ γ := Real.rpow_pos_of_pos hxpos γ
  let U : ℕ := ⌊2 * Q⌋₊
  let V : ℕ := ⌊2 * R⌋₊
  let X : ℕ := ⌊T * M⌋₊ * N
  have hUcap : (U : ℝ) ≤ 2 * Q := Nat.floor_le (by positivity)
  have hVcap : (V : ℝ) ≤ 2 * R := Nat.floor_le (by positivity)
  have hX : (X : ℝ) ≤ F * x := by
    calc
      _ = (⌊T * M⌋₊ : ℝ) * (N : ℝ) := Nat.cast_mul _ _
      _ ≤ (T * M) * (K * x ^ γ) :=
        mul_le_mul (Nat.floor_le (by positivity)) hN
          (Nat.cast_nonneg N) (mul_nonneg hT.le hM.le)
      _ = T * K * (M * x ^ γ) := by ring
      _ ≤ T * K * (K * x) :=
        mul_le_mul_of_nonneg_left hMNupper (mul_nonneg hT.le hKpos.le)
      _ = F * x := by dsimp [F]; ring
  have hQbound : Q ≤ K ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε - γ) := by
    calc
      _ ≤ (K * x ^ (1 / 2 + 2 * «ω» + ε)) /
          (x ^ (-δ - 4 * ε) * x ^ γ / K) := by
        apply (le_div_iff₀ (by positivity)).mpr
        simpa only [mul_comm] using
          (mul_le_mul_of_nonneg_right hRlower hQ.le).trans hRQ
      _ = K ^ 2 *
          (x ^ (1 / 2 + 2 * «ω» + ε) / (x ^ (-δ - 4 * ε) * x ^ γ)) := by
        rw [div_div_eq_mul_div]
        ring
      _ = K ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε - γ) := by
        rw [← Real.rpow_add hxpos, ← Real.rpow_sub hxpos]
        congr 2
        ring
  have hQhalf : Q ≤ K ^ 2 * x ^ ((1 : ℝ) / 2) :=
    hQbound.trans (mul_le_mul_of_nonneg_left
      (Real.rpow_le_rpow_of_exponent_le hxone (by linarith)) (sq_nonneg K))
  have hRhalf : R ≤ K ^ 2 * x ^ ((1 : ℝ) / 2) := by
    calc
      _ ≤ K * x ^ (-2 * ε) * x ^ γ := hRupper
      _ = K * x ^ (γ - 2 * ε) := by
        rw [mul_assoc, ← Real.rpow_add hxpos]
        congr 2
        ring
      _ ≤ K * x ^ ((1 : ℝ) / 2) :=
        mul_le_mul_of_nonneg_left
          (Real.rpow_le_rpow_of_exponent_le hxone (by linarith)) hKpos.le
      _ ≤ K ^ 2 * x ^ ((1 : ℝ) / 2) :=
        mul_le_mul_of_nonneg_right (le_self_pow₀ hK two_ne_zero)
          (Real.rpow_nonneg hxpos.le _)
  have hcap (u : ℝ) (hu : u ≤ K ^ 2 * x ^ ((1 : ℝ) / 2)) : 2 * u ≤ x := by
    calc
      _ ≤ 2 * (K ^ 2 * x ^ ((1 : ℝ) / 2)) :=
        mul_le_mul_of_nonneg_left hu zero_le_two
      _ = (2 * K ^ 2) * x ^ ((1 : ℝ) / 2) := by ring
      _ ≤ x ^ ((1 : ℝ) / 2) * x ^ ((1 : ℝ) / 2) :=
        mul_le_mul_of_nonneg_right hxlarge (Real.rpow_nonneg hxpos.le _)
      _ = x := by rw [← Real.rpow_add hxpos]; norm_num
  have hU : (U : ℝ) ≤ x := hUcap.trans (hcap Q hQhalf)
  have hV : (V : ℝ) ≤ x := hVcap.trans (hcap R hRhalf)
  have hlogcap (n : ℕ) (hn : (n : ℝ) ≤ x) : Real.log (n : ℝ) ≤ Real.log x := by
    by_cases hn0 : n = 0
    · simpa only [hn0, Nat.cast_zero, Real.log_zero] using hlog
    · exact Real.log_le_log (Nat.cast_pos.mpr (Nat.pos_of_ne_zero hn0)) hn
  have hu : 1 + Real.log (U : ℝ) ≤ 2 * Real.log x := by
    linarith [hlogcap U hU]
  have hv : 1 + Real.log (V : ℝ) ≤ 2 * Real.log x := by
    linarith [hlogcap V hV]
  have hu₃ : 2 + Real.log (U : ℝ) ≤ 3 * Real.log x := by
    linarith [hlogcap U hU]
  have hlogs :
      (1 + Real.log (V : ℝ)) * (1 + Real.log (U : ℝ)) ^ 2 *
        (2 + Real.log (U : ℝ)) ≤ 24 * (Real.log x) ^ 4 := by
    calc
      _ ≤ (2 * Real.log x) * (2 * Real.log x) ^ 2 * (3 * Real.log x) :=
        mul_le_mul
          (mul_le_mul hv (pow_le_pow_left₀ (by positivity) hu 2)
            (sq_nonneg _) (by positivity))
          hu₃ (by positivity) (by positivity)
      _ = _ := by ring
  have hendpoint : (V : ℝ) * (U : ℝ) ^ 2 ≤ 8 * K ^ 3 * x := by
    calc
      _ ≤ (2 * R) * (2 * Q) ^ 2 :=
        mul_le_mul hVcap (pow_le_pow_left₀ (Nat.cast_nonneg U) hUcap 2)
          (sq_nonneg _) (by positivity)
      _ = 8 * (R * Q) * Q := by ring
      _ ≤ 8 * (K * x ^ (1 / 2 + 2 * «ω» + ε)) *
          (K ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε - γ)) :=
        mul_le_mul (mul_le_mul_of_nonneg_left hRQ (by norm_num)) hQbound
          hQ.le (by positivity)
      _ = 8 * K ^ 3 *
          (x ^ (1 / 2 + 2 * «ω» + ε) * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε - γ)) := by
        ring
      _ = 8 * K ^ 3 * x ^ (1 + 4 * «ω» + δ + 6 * ε - γ) := by
        rw [← Real.rpow_add hxpos]
        congr 2
        ring
      _ ≤ 8 * K ^ 3 * x := by
        apply mul_le_mul_of_nonneg_left _ (by positivity)
        simpa only [Real.rpow_one] using
          Real.rpow_le_rpow_of_exponent_le hxone
            (show 1 + 4 * «ω» + δ + 6 * ε - γ ≤ 1 by linarith)
  have hcount :
      (X : ℝ) * (1 + Real.log (V : ℝ)) * (1 + Real.log (U : ℝ)) ^ 2 *
        (2 + Real.log (U : ℝ)) + (V : ℝ) * (U : ℝ) ^ 2 ≤
          H * x * (Real.log x) ^ 4 := by
    calc
      _ = (X : ℝ) * ((1 + Real.log (V : ℝ)) * (1 + Real.log (U : ℝ)) ^ 2 *
          (2 + Real.log (U : ℝ))) + (V : ℝ) * (U : ℝ) ^ 2 := by ring
      _ ≤ (F * x) * (24 * (Real.log x) ^ 4) + 8 * K ^ 3 * x :=
        add_le_add (mul_le_mul hX hlogs (by positivity) (by positivity)) hendpoint
      _ ≤ (F * x) * (24 * (Real.log x) ^ 4) +
          (8 * K ^ 3 * x) * (Real.log x) ^ 4 :=
        add_le_add le_rfl (le_mul_of_one_le_right (by positivity : 0 ≤ 8 * K ^ 3 * x)
          (one_le_pow₀ hlogone))
      _ = H * x * (Real.log x) ^ 4 := by dsimp [H]; ring
  have hXp : (X : ℝ) ^ ε ≤ F ^ ε * x ^ ε :=
    (Real.rpow_le_rpow (Nat.cast_nonneg X) hX hε.le).trans_eq
      (Real.mul_rpow hF.le hxpos.le)
  have hscale :
      x ^ (1 + 2 * ε) / K ^ 2 ≤ M * (x ^ γ) ^ 2 / R := by
    calc
      _ = (x / K * x ^ γ) / (K * x ^ (-2 * ε) * x ^ γ) := by
        calc
          _ = (1 / K ^ 2) * (x ^ ((1 : ℝ) - (-2 * ε))) := by
            rw [neg_mul, sub_neg_eq_add]
            ring
          _ = (x / K) / (K * x ^ (-2 * ε)) := by
            rw [Real.rpow_sub hxpos, Real.rpow_one]
            ring
          _ = _ := (mul_div_mul_right _ _ hxγ.ne').symm
      _ ≤ (M * x ^ γ * x ^ γ) / R :=
        div_le_div₀ (by positivity)
          (mul_le_mul_of_nonneg_right hMNlower hxγ.le) hR hRupper
      _ = _ := by ring
  have hfinite' := hfinite S sm w β c ⌊T * M⌋₊ N U V
    (Bβ * (Real.log x) ^ Eβ) (L * (Real.log x) ^ Eψ)
    (by positivity) (by positivity) Finset.Subset.rfl hsupport
    (fun n hn => by simpa only [mul_right_comm] using hβ n hn)
    (fun n _ => hψ ((n : ℝ) / M)) hc
    (fun p hp => by
      rcases hS p hp with ⟨hp₁, hp₂, _, _, hpQ, _, hpR⟩
      exact ⟨hp₁, Nat.le_floor hpQ, hp₂, Nat.le_floor hpR⟩)
    (fun p hp => (hS p hp).2.2.1) a b₁ b₂
  have hlogpower :
      ((Real.log x) ^ Eβ) ^ 2 * (Real.log x) ^ Eψ * (Real.log x) ^ 4 =
        (Real.log x) ^ E := by
    rw [← Real.rpow_mul_natCast hlog, ← Real.rpow_natCast,
      ← Real.rpow_add hlogpos, ← Real.rpow_add hlogpos]
    congr 1
    norm_num [E, mul_comm]
  have henvelope :
      C * (Bβ * (Real.log x) ^ Eβ) ^ 2 * (L * (Real.log x) ^ Eψ) *
        (X : ℝ) ^ ε *
        ((X : ℝ) * (1 + Real.log (V : ℝ)) * (1 + Real.log (U : ℝ)) ^ 2 *
          (2 + Real.log (U : ℝ)) + (V : ℝ) * (U : ℝ) ^ 2) ≤
        D * x ^ (1 + ε) * (Real.log x) ^ E := by
    calc
      _ ≤ C * (Bβ * (Real.log x) ^ Eβ) ^ 2 * (L * (Real.log x) ^ Eψ) *
          (F ^ ε * x ^ ε) * (H * x * (Real.log x) ^ 4) :=
        mul_le_mul (mul_le_mul_of_nonneg_left hXp (by positivity)) hcount
          (by positivity) (by positivity)
      _ = (C * Bβ ^ 2 * L * F ^ ε * H) * (x * x ^ ε) *
          (((Real.log x) ^ Eβ) ^ 2 * (Real.log x) ^ Eψ * (Real.log x) ^ 4) := by
        ring
      _ = D * x ^ (1 + ε) * (Real.log x) ^ E := by
        rw [hlogpower, Real.rpow_add hxpos, Real.rpow_one]
  have hsmall' : D * K ^ 2 * (Real.log x) ^ (E + A) ≤ x ^ ε :=
    (Real.le_norm_self _).trans
      (hxsmall.trans_eq (Real.norm_of_nonneg (Real.rpow_nonneg hxpos.le ε)))
  have hlogcancel : (Real.log x) ^ (E + A) * (Real.log x) ^ (-A) =
      (Real.log x) ^ E := by
    rw [← Real.rpow_add hlogpos, add_neg_cancel_right]
  have hscalar : D * (Real.log x) ^ E ≤
      (x ^ ε / K ^ 2) * (Real.log x) ^ (-A) := by
    calc
      _ = (D * K ^ 2 * (Real.log x) ^ (E + A)) / K ^ 2 *
          (Real.log x) ^ (-A) := by
        rw [mul_right_comm D (K ^ 2), mul_div_cancel_right₀ _ (pow_ne_zero 2 hKpos.ne'),
          mul_assoc D ((Real.log x) ^ (E + A)), hlogcancel]
      _ ≤ _ :=
        mul_le_mul_of_nonneg_right
          (div_le_div_of_nonneg_right hsmall' (sq_nonneg K))
          hdecay
  calc
    _ ≤ C * (Bβ * (Real.log x) ^ Eβ) ^ 2 * (L * (Real.log x) ^ Eψ) *
        (X : ℝ) ^ ε *
        ((X : ℝ) * (1 + Real.log (V : ℝ)) * (1 + Real.log (U : ℝ)) ^ 2 *
          (2 + Real.log (U : ℝ)) + (V : ℝ) * (U : ℝ) ^ 2) := hfinite'
    _ ≤ D * x ^ (1 + ε) * (Real.log x) ^ E := henvelope
    _ = x ^ (1 + ε) * (D * (Real.log x) ^ E) := by ring
    _ ≤ x ^ (1 + ε) * ((x ^ ε / K ^ 2) * (Real.log x) ^ (-A)) :=
      mul_le_mul_of_nonneg_left hscalar (Real.rpow_nonneg hxpos.le _)
    _ = (x ^ (1 + 2 * ε) / K ^ 2) * (Real.log x) ^ (-A) := by
      calc
        _ = (x ^ (1 + ε) * x ^ ε) / K ^ 2 * (Real.log x) ^ (-A) := by ring
        _ = _ := by
          rw [← Real.rpow_add hxpos, two_mul, add_assoc]
    _ ≤ _ := mul_le_mul_of_nonneg_right hscale hdecay

open Classical in
theorem opening_high_beta_subpower (d : ℕ) (E C T ε : ℝ)
    (hC : 0 ≤ C) (hT : 0 < T) (hε : 0 < ε) :
    ∀ᶠ x : ℝ in Filter.atTop, ∀ n : ℕ, 0 < n → (n : ℝ) ≤ T * x →
      C * (n.divisors.card : ℝ) ^ d * (Real.log x) ^ E ≤ x ^ (ε / 100) := by
  let ρ : ℝ := ε / 200
  let σ : ℝ := ρ / ((d : ℝ) + 1)
  have hρ : 0 < ρ := by dsimp only [ρ]; positivity
  have hσ : 0 < σ := by dsimp only [σ]; positivity
  obtain ⟨D, hD, hdivisor⟩ := exists_card_divisors_bound hσ
  let K : ℝ := C * D ^ d * T ^ ρ
  have hlog := ((isLittleO_log_rpow_rpow_atTop E hρ).const_mul_left K).eventuallyLE
  filter_upwards [hlog, Filter.eventually_ge_atTop (Real.exp 1)] with x hx hxexp
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le
    ((Real.le_log_iff_exp_le hxpos).mpr hxexp)
  have hsmall : K * (Real.log x) ^ E ≤ x ^ ρ :=
    (le_abs_self _).trans (by
      simpa only [Real.norm_eq_abs, abs_of_nonneg (Real.rpow_nonneg hxpos.le ρ)] using hx)
  intro n hn hnT
  have hn1 : (1 : ℝ) ≤ n := by exact_mod_cast hn
  have hn0 : (0 : ℝ) ≤ n := Nat.cast_nonneg n
  have hσd : σ * (d : ℝ) ≤ ρ := by
    have heq : σ * ((d : ℝ) + 1) = ρ := by
      dsimp only [σ]
      exact div_mul_cancel₀ _ (by positivity)
    nlinarith only [heq, hσ]
  have hpower : (n.divisors.card : ℝ) ^ d ≤ D ^ d * (n : ℝ) ^ ρ := by
    calc
      _ ≤ (D * (n : ℝ) ^ σ) ^ d :=
        pow_le_pow_left₀ (Nat.cast_nonneg _) (hdivisor n hn.ne') d
      _ = D ^ d * (n : ℝ) ^ (σ * (d : ℝ)) := by
        rw [mul_pow, ← Real.rpow_mul_natCast hn0]
      _ ≤ D ^ d * (n : ℝ) ^ ρ :=
        mul_le_mul_of_nonneg_left
          (Real.rpow_le_rpow_of_exponent_le hn1 hσd) (pow_nonneg hD.le _)
  calc
    _ ≤ C * (D ^ d * (n : ℝ) ^ ρ) * (Real.log x) ^ E :=
      mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_left hpower hC)
        (Real.rpow_nonneg hlogpos.le _)
    _ ≤ C * (D ^ d * (T * x) ^ ρ) * (Real.log x) ^ E := by
      gcongr
    _ = (K * (Real.log x) ^ E) * x ^ ρ := by
      rw [Real.mul_rpow hT.le hxpos.le]
      dsimp only [K]
      ring
    _ ≤ x ^ ρ * x ^ ρ := mul_le_mul_of_nonneg_right hsmall
      (Real.rpow_nonneg hxpos.le _)
    _ = x ^ (ε / 100) := by
      rw [← Real.rpow_add hxpos]
      congr 1
      dsimp only [ρ]
      ring

end

section
open scoped ContDiff
open Classical in
theorem sourceTerminalSigma6_xi_uniform_bounds_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    («ω» δ ε CK cD CD cN CN : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε) (hCK : 1 ≤ CK)
    (hcD : 0 < cD) (hCD : cD ≤ CD) (hcN : 0 < cN) (hCN : cN ≤ CN)
    (CX CR CQ CΔlo CΔhi Cm CΛ Cw : ℝ)
    (hCX : 1 ≤ CX) (hCR : 1 ≤ CR) (hCQ : 1 ≤ CQ)
    (hCΔlo : 1 ≤ CΔlo) (hCΔhi : 1 ≤ CΔhi) (hCm : 1 ≤ Cm)
    (hCΛ : 1 ≤ CΛ) (hCw : 1 ≤ Cw)
    (Cφ Eφ Cψ Eψ : ℕ → ℝ)
    (hCφ : ∀ r : ℕ, 0 ≤ Cφ r) (hCψ : ∀ r : ℕ, 0 ≤ Cψ r) :
    ∃ Cweight Csum X₀ : ℝ, 0 < Cweight ∧ 0 < Csum ∧ Real.exp 1 ≤ X₀ ∧
      ∀ (x : ℝ), X₀ ≤ x →
      ∀ (m q₀ c₁ c₂ w₁ w₂ z₁ gV : ℕ) (hm : Squarefree m),
      q₀ ∣ m → c₁ ∣ m → c₂ ∣ m → 0 < gV →
      0 < w₁ → Squarefree w₁ → 0 < z₁ → w₁ ∣ z₁ → Nat.Coprime z₁ m →
      ∀ (M N R₀ Q Hscale Δ₁ Λ γ : ℝ),
      0 < M → 0 < R₀ → 0 < Q → 1 ≤ Hscale → 0 < Δ₁ → Λ ≠ 0 →
      N = x ^ γ → (1 / 4 : ℝ) + 12 * «ω» + 4 * δ + 100 * ε ≤ γ → γ ≤ 1 →
      x / CX ≤ M * N → M * N ≤ CX * x →
      N ≤ CR * x ^ (δ + 4 * ε) * R₀ →
      R₀ * Q ≤ CQ * x ^ ((1 / 2 : ℝ) + 2 * «ω» + ε) →
      Hscale = x ^ ε * R₀ * Q ^ 2 / ((q₀ : ℝ) * M) →
      N ≤ CΔlo * x ^ (δ + 55 * ε) * Hscale ^ 2 * Δ₁ →
      Δ₁ ≤ CΔhi * N / (x ^ (55 * ε) * Hscale ^ 2) →
      (m : ℝ) ≤ Cm * x ^ δ * R₀ * Q ^ 2 * Hscale /
        ((q₀ : ℝ) * (gV : ℝ) * Δ₁) →
      (w₁ : ℝ) ≤ Cw * x ^ (5 * ε) * Δ₁ →
      |Λ| ≤ CΛ * x ^ (δ + 5 * ε) * Hscale ^ 2 / ((w₁ : ℝ) * (gV : ℝ)) →
      ∀ (lam lamTilde ell A B d₀ : ℤ), 0 ≤ d₀ →
      (1 ≤ (lam : ℝ) / Λ ∧ (lam : ℝ) / Λ < 2) →
      (1 ≤ (lamTilde : ℝ) / Λ ∧ (lamTilde : ℝ) / Λ < 2) →
      w₂ = ∏ p ∈ m.primeFactors, p ^ (lam.natAbs.factorization p) →
      w₂ = ∏ p ∈ m.primeFactors, p ^ (lamTilde.natAbs.factorization p) →
      Int.gcd (((z₁ / w₁ : ℕ) : ℤ)) ((m : ℤ) * lam * lamTilde) = 1 →
      IsUnit (A : ZMod m) →
      letI : NeZero m := ⟨hm.ne_zero⟩
      let s : ℤ := ((z₁ / w₁ : ℕ) : ℤ)
      let s₂ : ℕ := Nat.gcd w₂ m
      let Jk : ℤ → ℤ := fun k => s * k + (lam - lamTilde) * B
      let Klam : ℝ := (w₁ : ℝ) * |Λ| * N / (x ^ (5 * ε) * Δ₁)
      let K : ℝ := CK * Klam
      let T : ℝ := max ((s₂ : ℝ)⁻¹) Hscale⁻¹ *
        (x ^ (δ + 100 * ε) * Hscale ^ 2 * N / ((gV : ℝ) * Δ₁))
      let S : Finset ℤ := (Finset.Icc ⌈-K⌉ ⌊K⌋).filter
        fun k : ℤ => (w₂ : ℤ) ∣ k ∧ (Int.gcd (Jk k) (m : ℤ) : ℝ) ≤ T
      let ξ : ℤ → ℝ := fun k =>
        (Int.gcd (Jk k) (m : ℤ) : ℝ) / (x ^ ε * (s₂ : ℝ) * T)
      let Δstar : ℝ := min (N / (|Λ| * x ^ (5 * ε))) Δ₁
      let R : ℝ :=
        (x ^ (4 * ε) * (s₂ : ℝ) * T / (q₀ : ℝ)) * (Δ₁ / Δstar) *
          (N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
          (Δstar / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ))
      Int.gcd s (m : ℤ) = 1 ∧
        Int.gcd (s * (w₂ : ℤ)) (m : ℤ) = s₂ ∧
        0 < Klam ∧ 0 < T ∧ 0 < Δstar ∧
        T ≤ x ^ (δ + 100 * ε) * Hscale ^ 2 * N / ((gV : ℝ) * Δ₁) ∧
        x ^ (100 * ε) * (Klam / (w₂ : ℝ)) ≤ CΛ * T ∧
        K / (w₂ : ℝ) ≤ T ∧
        (T < 1 → S = ∅) ∧
        (S.Nonempty → max 1 (K / (w₂ : ℝ)) ≤ T) ∧
        (∀ k : ℤ, 0 ≤ ξ k) ∧
        (∑ k ∈ S, ξ k) ≤ Cweight ∧
        (∀ k : ℤ,
          ξ k * R =
            (x ^ (3 * ε) * (Int.gcd (Jk k) (m : ℤ) : ℝ) / (q₀ : ℝ)) *
              (Δ₁ / Δstar) *
              (N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
              (Δstar / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ))) ∧
        ∀ (φ ψ : ℝ → ℂ), ContDiff ℝ ∞ φ → ContDiff ℝ ∞ ψ →
          Function.support φ ⊆ Set.Icc cD CD →
          Function.support ψ ⊆ Set.Icc cN CN →
          (∀ (r : ℕ) (t : ℝ), ‖iteratedDeriv r φ t‖ ≤ Cφ r * (Real.log x) ^ Eφ r) →
          (∀ (r : ℕ) (t : ℝ), ‖iteratedDeriv r ψ t‖ ≤ Cψ r * (Real.log x) ^ Eψ r) →
        ∀ (k dstar nstar : ℤ),
          let nk : ℤ → ℤ → ℤ := fun n d => (lamTilde * n + s * k * d) / lam
          let BD : Finset ℤ :=
            Finset.Icc ⌈((d₀ : ℝ) + cD * Δ₁) / (z₁ : ℝ)⌉
              ⌊((d₀ : ℝ) + CD * Δ₁) / (z₁ : ℝ)⌋
          let BN : Finset ℤ := Finset.Icc ⌈cN * N⌉ ⌊CN * N⌋
          let H : ℤ × ℤ → ℂ := fun z =>
            if Int.ModEq (q₀ : ℤ) z.1 dstar ∧ Int.ModEq (q₀ : ℤ) z.2 nstar ∧
                Int.gcd z.1 ((m : ℤ) * lam * lamTilde) = 1 ∧
                lam ∣ lamTilde * z.2 + s * k * z.1 ∧
                Int.gcd (z.2 * nk z.2 z.1) ((w₁ * c₁ : ℕ) : ℤ) = 1 ∧
                Int.gcd ((z.2 + ell * z.1) * (nk z.2 z.1 + ell * z.1)) (c₂ : ℤ) = 1
            then
              φ (((z₁ : ℝ) * (z.1 : ℝ) - (d₀ : ℝ)) / Δ₁) * ψ ((z.2 : ℝ) / N) *
                reciprocalUnitPhase m ((A : ZMod m) * (Jk k : ZMod m))
                  (((z.2 + B * z.1 : ℤ) : ZMod m) *
                    ((nk z.2 z.1 + B * z.1 : ℤ) : ZMod m))
            else 0
          let total : ℂ := ∑ d ∈ BD, ∑ n ∈ BN, H (d, n)
          HasSum H total ∧
            (¬ (Int.gcd lam lamTilde : ℤ) ∣ s * k → total = 0) ∧
            ‖total‖ ≤ Csum * ξ k * R := by
  have hCXpos : 0 < CX := zero_lt_one.trans_le hCX
  have hCΔloPos : 0 < CΔlo := zero_lt_one.trans_le hCΔlo
  obtain ⟨Cweight, Xweight, hCweight, _, hweight⟩ :=
    sourceTerminal_gcd_weight_application «ω» δ ε CK CΛ CX CR CQ CΔlo Cm
      hω hδ hε hCK hCΛ hCX hCR hCQ hCΔlo hCm
  obtain ⟨Csum, Xsum, hCsum, hXsum, hSigma⟩ :=
    sourceTerminalSigma6_source_ranges_bound_of_deligne hDeligne
      «ω» δ ε cD CD cN CN hω.le hδ.le hε hcD hCD hcN hCN
      CX (CX * CR * CQ ^ 2) Cm (1 / CΔlo) CΔhi CΛ Cw
      hCXpos
      (mul_pos (mul_pos hCXpos (zero_lt_one.trans_le hCR))
        (pow_pos (zero_lt_one.trans_le hCQ) 2))
      (zero_lt_one.trans_le hCm) (one_div_pos.mpr hCΔloPos)
      (zero_lt_one.trans_le hCΔhi) (zero_lt_one.trans_le hCΛ)
      (zero_lt_one.trans_le hCw) Cφ Eφ Cψ Eψ hCφ hCψ
  refine ⟨Cweight, Csum, max Xweight Xsum, hCweight, hCsum,
    hXsum.trans (le_max_right _ _), ?_⟩
  intro x hx m q₀ c₁ c₂ w₁ w₂ z₁ gV hm hq₀ hc₁ hc₂ hgV
    hw₁ hsw₁ hz₁ hwz hzm M N R₀ Q Hscale Δ₁ Λ γ
    hM hR₀ hQ hH hΔ₁ hΛ hNγ hγlower hγupper hMNlo hMNhi hNR hRQ
    hHdef hΔlower hΔupper hmupper hwupper hΛupper
    lam lamTilde ell A B d₀ hd₀ hdyadic hdyadicTilde hw₂ hw₂Tilde hscop hA
  dsimp only
  have hxweight : Xweight ≤ x := (le_max_left _ _).trans hx
  have hxsum : Xsum ≤ x := (le_max_right _ _).trans hx
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le (hXsum.trans hxsum)
  have hpow (a : ℝ) : 0 < x ^ a := Real.rpow_pos_of_pos hxpos a
  have hNpos : 0 < N := hNγ.symm ▸ hpow γ
  have hHpos : 0 < Hscale := zero_lt_one.trans_le hH
  have hqpos : 0 < (q₀ : ℝ) := by
    exact_mod_cast Nat.pos_of_dvd_of_pos hq₀ (Nat.pos_of_ne_zero hm.ne_zero)
  have hgVpos : 0 < (gV : ℝ) := by exact_mod_cast hgV
  have hlam0 : lam ≠ 0 := by
    intro hzero
    norm_num [hzero] at hdyadic
  have hw₂pos : 0 < w₂ := by
    rw [hw₂]
    exact (primeFactors_prod_pow_factorization_dvd_and_coprime_div m lam.natAbs hm.ne_zero
      (Int.natAbs_ne_zero.mpr hlam0)).1
  obtain ⟨_, hHbound, _, hsm, hswm, hKlam, hT, hΔstar, hcutoff, hKT,
      hempty, hnonempty, hξnonneg, hξproduct, _, hξsum, _⟩ :=
    hweight x hxweight m q₀ gV w₁ w₂ z₁ hm hq₀ hgV hsw₁ hw₂pos hz₁ hwz hzm
      M N R₀ Q Hscale Δ₁ Λ γ hM hR₀ hQ hH hΔ₁ hΛ hNγ hγlower
      hMNlo hMNhi hNR hRQ hHdef hΔlower hmupper hΛupper lam lamTilde B
  have hΔlower' :
      (1 / CΔlo) * N / (x ^ (δ + 55 * ε) * Hscale ^ 2) ≤ Δ₁ := by
    apply (div_le_iff₀ (mul_pos (hpow (δ + 55 * ε)) (pow_pos hHpos 2))).mpr
    calc
      (1 / CΔlo) * N = N / CΔlo := by ring
      _ ≤ Δ₁ * (x ^ (δ + 55 * ε) * Hscale ^ 2) :=
        (div_le_iff₀ hCΔloPos).mpr (by
          simpa only [mul_assoc, mul_left_comm, mul_comm] using hΔlower)
  have hHproduct :
      Hscale * ((q₀ : ℝ) * M) = x ^ ε * R₀ * Q ^ 2 :=
    (eq_div_iff (mul_ne_zero hqpos.ne' hM.ne')).mp hHdef
  have hRQeq : R₀ * Q ^ 2 = Hscale * (q₀ : ℝ) * M / x ^ ε := by
    apply (eq_div_iff (hpow ε).ne').mpr
    nlinarith only [hHproduct]
  have hmnormalized : (m : ℝ) ≤
      Cm * x ^ (δ - ε) * M * Hscale ^ 2 / ((gV : ℝ) * Δ₁) := by
    calc
      (m : ℝ) ≤ Cm * x ^ δ * R₀ * Q ^ 2 * Hscale /
          ((q₀ : ℝ) * (gV : ℝ) * Δ₁) := hmupper
      _ = Cm * x ^ δ * (R₀ * Q ^ 2) * Hscale /
          ((q₀ : ℝ) * (gV : ℝ) * Δ₁) := by ring
      _ = Cm * (x ^ δ / x ^ ε) * M * Hscale ^ 2 / ((gV : ℝ) * Δ₁) := by
        rw [hRQeq]
        field_simp (disch := positivity)
      _ = Cm * x ^ (δ - ε) * M * Hscale ^ 2 / ((gV : ℝ) * Δ₁) := by
        rw [Real.rpow_sub hxpos]
  have hs₂one : (1 : ℝ) ≤ (Nat.gcd w₂ m : ℝ) := by
    exact_mod_cast Nat.gcd_pos_of_pos_right w₂ (Nat.pos_of_ne_zero hm.ne_zero)
  have hTupper :
      max ((Nat.gcd w₂ m : ℝ)⁻¹) Hscale⁻¹ *
          (x ^ (δ + 100 * ε) * Hscale ^ 2 * N / ((gV : ℝ) * Δ₁)) ≤
        x ^ (δ + 100 * ε) * Hscale ^ 2 * N / ((gV : ℝ) * Δ₁) := by
    exact mul_le_of_le_one_left (by positivity)
      (max_le (inv_le_one_of_one_le₀ hs₂one) (inv_le_one_of_one_le₀ hH))
  refine ⟨hsm, hswm, hKlam, hT, hΔstar, hTupper, hcutoff, hKT,
    hempty, hnonempty, hξnonneg, hξsum, hξproduct, ?_⟩
  intro φ ψ hφ hψ hsφ hsψ heφ heψ k dstar nstar
  have hγnonneg : 0 ≤ γ := by linarith only [hγlower, hω, hδ, hε]
  have hraw :=
    hSigma x hxsum m q₀ c₁ c₂ w₁ w₂ z₁ gV hm hq₀ hc₁ hc₂ hgV
      hw₁ hsw₁ hz₁ hwz hzm lam lamTilde k ell A B d₀ dstar nstar
      Λ Δ₁ N M Hscale γ hΛ hΔ₁ hNpos hM hH hd₀ hγnonneg hγupper
      hNγ hMNhi hHbound hΔlower' hΔupper hmnormalized hwupper hΛupper
      hdyadic hdyadicTilde hw₂ hw₂Tilde hscop hA φ ψ hφ hψ hsφ hsψ heφ heψ
  refine ⟨hraw.1, hraw.2.1, hraw.2.2.trans_eq ?_⟩
  simpa only [Real.rpow_eq_pow, div_eq_mul_inv, one_mul, mul_assoc] using
    congrArg (fun t : ℝ => Csum * t) (hξproduct k).symm

open Classical in
theorem sourceTerminalSigma5_uniform_bound_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    («ω» δ ε Berr cD CD cN CN c₀ : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε) (hBerr : 0 < Berr)
    (hcD : 0 < cD) (hCD : cD ≤ CD) (hcN : 0 < cN) (hCN : cN ≤ CN)
    (hc₀ : 0 < c₀)
    (CX CR CQ CΔlo CΔhi Cm CΛ Cw : ℝ)
    (hCX : 1 ≤ CX) (hCR : 1 ≤ CR) (hCQ : 1 ≤ CQ)
    (hCΔlo : 1 ≤ CΔlo) (hCΔhi : 1 ≤ CΔhi) (hCm : 1 ≤ Cm)
    (hCΛ : 1 ≤ CΛ) (hCw : 1 ≤ Cw)
    (Cφ Eφ Cψ Eψ : ℕ → ℝ)
    (hCφ : ∀ r : ℕ, 0 ≤ Cφ r) (hCψ : ∀ r : ℕ, 0 ≤ Cψ r) :
    ∃ Csum X₀ : ℝ, 0 < Csum ∧ Real.exp 1 ≤ X₀ ∧
      ∀ (x : ℝ), X₀ ≤ x →
      ∀ (m q₀ c₁ c₂ w₁ w₂ z₁ gV : ℕ) (hm : Squarefree m),
      q₀ ∣ m → c₁ ∣ m → c₂ ∣ m → 0 < gV →
      0 < w₁ → Squarefree w₁ → 0 < z₁ → w₁ ∣ z₁ → Nat.Coprime z₁ m →
      ∀ (M N R₀ Q Hscale Δ₁ Λ γ : ℝ),
      0 < M → 0 < R₀ → 0 < Q → 1 ≤ Hscale → 0 < Δ₁ → Λ ≠ 0 →
      N = x ^ γ → (1 / 4 : ℝ) + 12 * «ω» + 4 * δ + 100 * ε ≤ γ → γ ≤ 1 →
      x / CX ≤ M * N → M * N ≤ CX * x →
      N ≤ CR * x ^ (δ + 4 * ε) * R₀ →
      R₀ * Q ≤ CQ * x ^ ((1 / 2 : ℝ) + 2 * «ω» + ε) →
      Hscale = x ^ ε * R₀ * Q ^ 2 / ((q₀ : ℝ) * M) →
      N ≤ CΔlo * x ^ (δ + 55 * ε) * Hscale ^ 2 * Δ₁ →
      Δ₁ ≤ CΔhi * N / (x ^ (55 * ε) * Hscale ^ 2) →
      (m : ℝ) ≤ Cm * x ^ δ * R₀ * Q ^ 2 * Hscale /
        ((q₀ : ℝ) * (gV : ℝ) * Δ₁) →
      (w₁ : ℝ) ≤ Cw * x ^ (5 * ε) * Δ₁ →
      |Λ| ≤ CΛ * x ^ (δ + 5 * ε) * Hscale ^ 2 / ((w₁ : ℝ) * (gV : ℝ)) →
      ∀ (lam lamTilde l ℓ aPhase Bshift d₀ : ℤ),
      c₀ * x ^ (5 * ε) * Δ₁ ≤ (d₀ : ℝ) →
      (1 ≤ (lam : ℝ) / Λ ∧ (lam : ℝ) / Λ < 2) →
      (1 ≤ (lamTilde : ℝ) / Λ ∧ (lamTilde : ℝ) / Λ < 2) →
      w₂ = ∏ p ∈ m.primeFactors, p ^ (lam.natAbs.factorization p) →
      w₂ = ∏ p ∈ m.primeFactors, p ^ (lamTilde.natAbs.factorization p) →
      Int.gcd (((z₁ / w₁ : ℕ) : ℤ)) ((m : ℤ) * lam * lamTilde) = 1 →
      IsUnit (aPhase : ZMod m) →
      ∀ (E : ZMod q₀ → Finset (ZMod q₀)),
      (∀ r, (E r).card ≤ Int.gcd (q₀ : ℤ) ℓ) →
      ∀ (φ ψ : ℝ → ℂ), ContDiff ℝ ∞ φ → ContDiff ℝ ∞ ψ →
      Function.support φ ⊆ Set.Icc cD CD →
      Function.support ψ ⊆ Set.Icc cN CN →
      (∀ (r : ℕ) (t : ℝ), ‖iteratedDeriv r φ t‖ ≤ Cφ r * (Real.log x) ^ Eφ r) →
      (∀ (r : ℕ) (t : ℝ), ‖iteratedDeriv r ψ t‖ ≤ Cψ r * (Real.log x) ^ Eψ r) →
      letI : NeZero m := ⟨hm.ne_zero⟩
      let s : ℕ := z₁ / w₁
      let s₂ : ℕ := Nat.gcd w₂ m
      let g₀ : ℕ := Int.gcd (q₀ : ℤ) ℓ
      let T : ℝ := max ((s₂ : ℝ)⁻¹) Hscale⁻¹ *
        (x ^ (δ + 100 * ε) * Hscale ^ 2 * N / ((gV : ℝ) * Δ₁))
      let Δstar : ℝ := min (N / (|Λ| * x ^ (5 * ε))) Δ₁
      let R : ℝ :=
        (x ^ (4 * ε) * (s₂ : ℝ) * T / (q₀ : ℝ)) * (Δ₁ / Δstar) *
          (N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
          (Δstar / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ))
      let τ : ℕ → ℝ := fun d => ((z₁ : ℝ) * (d : ℝ) - (d₀ : ℝ)) / Δ₁
      let D : Finset ℕ :=
        (Finset.Icc 1 ⌊((d₀ : ℝ) + CD * Δ₁) / (z₁ : ℝ)⌋₊).filter
          fun d : ℕ => φ (τ d) ≠ 0
      let I : Finset ℤ := (Finset.Icc ⌈cN * N⌉ ⌊CN * N⌋).filter
        fun n : ℤ => ψ ((n : ℝ) / N) ≠ 0
      let C : ℕ → ℤ → ℂ := fun d n =>
        if (n : ZMod q₀) ∈ E (d : ZMod q₀) then 1 else 0
      let Jn : ℕ → ℤ → ℤ → ℤ := fun d n nt =>
        (lam * (nt + Bshift * (d : ℤ)) -
          lamTilde * (n + Bshift * (d : ℤ))) / (d : ℤ)
      let U₅ : ℕ → ℤ → ℤ → ℂ := fun d n nt =>
        if Int.gcd (d : ℤ) ((m : ℤ) * lam * lamTilde) = 1 ∧
            Int.gcd (n * nt) ((w₁ * c₁ : ℕ) : ℤ) = 1 ∧
            Int.gcd ((n + l * (d : ℤ)) * (nt + l * (d : ℤ))) (c₂ : ℤ) = 1 ∧
            (Int.gcd (Jn d n nt) (m : ℤ) : ℝ) ≤ T then
          C d n * C d nt *
            reciprocalUnitPhase m ((aPhase : ZMod m) * (Jn d n nt : ZMod m))
              (((n + Bshift * (d : ℤ) : ℤ) : ZMod m) *
                ((nt + Bshift * (d : ℤ) : ℤ) : ZMod m))
        else 0
      let term₅ : ℕ → ℤ → ℤ → ℂ := fun d n nt =>
        if Int.ModEq ((s * d : ℕ) : ℤ) (lam * nt) (lamTilde * n) then
          U₅ d n nt * φ (τ d) * ψ ((n : ℝ) / N) * ψ ((nt : ℝ) / N)
        else 0
      let S₅ : ℂ := ∑ d ∈ D, ∑ n ∈ I, ∑ nt ∈ I, term₅ d n nt
      S₅ = (∑' d : ℕ, ∑' n : ℤ, ∑' nt : ℤ, term₅ d n nt) ∧
        ‖S₅‖ ≤ Csum * ((q₀ * g₀ : ℕ) : ℝ) * R + x ^ (-Berr) := by
  obtain ⟨Cstar, Estar, hstarConst, Xred, hXred, hred⟩ :=
    sourceTerminalSigma5_uniform_reduction ε Berr cD CD cN CN c₀
      CΔhi 1 1 1 hε hBerr hcD hcN (hcN.trans_le hCN) hc₀
      (zero_le_one.trans hCΔhi) (by norm_num) (by norm_num) (by norm_num)
      Cφ Eφ Cψ Eψ hCφ hCψ
  have hCstar (r : ℕ) : 0 ≤ Cstar r := (hstarConst r).1.le
  obtain ⟨Cweight, C₆, Xsix, hCweight, hC₆, hXsix, hsix⟩ :=
    sourceTerminalSigma6_xi_uniform_bounds_of_deligne hDeligne
      «ω» δ ε (max 1 (2 * CN / c₀)) cD CD cN CN
      hω hδ hε (le_max_left _ _) hcD hCD hcN hCN
      CX CR CQ CΔlo CΔhi Cm CΛ Cw
      hCX hCR hCQ hCΔlo hCΔhi hCm hCΛ hCw
      Cstar Estar Cstar Estar hCstar hCstar
  refine ⟨C₆ * Cweight, max Xred Xsix, mul_pos hC₆ hCweight,
    hXred.trans (le_max_left _ _), ?_⟩
  intro x hx m q₀ c₁ c₂ w₁ w₂ z₁ gV hm hq₀ hc₁ hc₂ hgV
    hw₁ hw₁sq hz₁ hwz hzm M N R₀ Q Hscale Δ₁ Λ γ
    hM hR₀ hQ hHscale hΔ₁ hΛ hNγ hγlo hγhi hMNlo hMNhi hNR hRQ
    hHdef hΔlower hΔupper hmupper hwupper hΛupper
    lam lamTilde l ℓ aPhase Bshift d₀ hd₀ hlam hlamTilde hw₂ hw₂Tilde
    hprimitive hA E hE φ ψ hφ hψ hsφ hsψ hbφ hbψ
    s s₂ g₀ T Δstar R τ D I C Jn U₅ term₅ S₅
  have hxred : Xred ≤ x := (le_max_left _ _).trans hx
  have hxsix : Xsix ≤ x := (le_max_right _ _).trans hx
  have hx1 : 1 ≤ x :=
    (Real.one_lt_exp_iff.mpr zero_lt_one).le.trans (hXred.trans hxred)
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hN : 0 < N := hNγ.symm ▸ Real.rpow_pos_of_pos hx0 γ
  have hNcap : N ≤ x := hNγ.symm ▸ Real.rpow_le_self_of_one_le hx1 hγhi
  have hden : 1 ≤ x ^ (55 * ε) * Hscale ^ 2 :=
    one_le_mul_of_one_le_of_one_le
      (Real.one_le_rpow hx1 (by positivity)) (one_le_pow₀ hHscale)
  have hΔcap : Δ₁ ≤ CΔhi * x := by
    calc
      Δ₁ ≤ CΔhi * N / (x ^ (55 * ε) * Hscale ^ 2) := hΔupper
      _ ≤ CΔhi * N := div_le_self (by positivity) hden
      _ ≤ CΔhi * x := mul_le_mul_of_nonneg_left hNcap (zero_le_one.trans hCΔhi)
  have hd₀nonneg : 0 ≤ d₀ := by
    have hpos : 0 < (d₀ : ℝ) :=
      (mul_pos (mul_pos hc₀ (Real.rpow_pos_of_pos hx0 _)) hΔ₁).trans_le hd₀
    exact_mod_cast hpos.le
  let : NeZero m := ⟨hm.ne_zero⟩
  have hqpos : 0 < q₀ := Nat.pos_of_dvd_of_pos hq₀ (Nat.pos_of_ne_zero hm.ne_zero)
  let : NeZero q₀ := ⟨Nat.ne_of_gt hqpos⟩
  let J : ℕ := ⌈(Berr + (2 * (1 : ℝ) + 3 * 1) + 2) / (5 * ε)⌉₊
  let CK : ℝ := 2 * CN / c₀
  let Jk : ℤ → ℤ := fun k => (s : ℤ) * k + (lam - lamTilde) * Bshift
  let nk : ℤ → ℕ → ℤ → ℤ := fun k d n =>
    (lamTilde * n + (s : ℤ) * k * (d : ℤ)) / lam
  let Klam : ℝ := (w₁ : ℝ) * |Λ| * N / (x ^ (5 * ε) * Δ₁)
  let Kadm : Finset ℤ := (Finset.Icc (-⌊CK * Klam⌋) ⌊CK * Klam⌋).filter
    fun k : ℤ => (w₂ : ℤ) ∣ k ∧ (Int.gcd (Jk k) (m : ℤ) : ℝ) ≤ T
  let S : Finset ℤ := (Finset.Icc ⌈-(max 1 CK * Klam)⌉ ⌊max 1 CK * Klam⌋).filter
    fun k : ℤ => (w₂ : ℤ) ∣ k ∧ (Int.gcd (Jk k) (m : ℤ) : ℝ) ≤ T
  let ξ : ℤ → ℝ := fun k =>
    (Int.gcd (Jk k) (m : ℤ) : ℝ) / (x ^ ε * (s₂ : ℝ) * T)
  let ρ : ℝ := (lamTilde : ℝ) / (lam : ℝ)
  let σ : ℤ → ℝ := fun k => (k : ℝ) * (d₀ : ℝ) / ((w₁ : ℝ) * (lam : ℝ) * N)
  let η : ℤ → ℝ := fun k => (k : ℝ) * Δ₁ / ((w₁ : ℝ) * (lam : ℝ) * N)
  let nStar : ℕ → ℤ → ℝ → ℂ := fun j k u =>
    ψ u * iteratedDeriv j ψ (ρ * u + σ k)
  let dRaw : ℕ → ℤ → ℝ → ℂ := fun j k u =>
    ((η k * u) ^ j / (Nat.factorial j : ℝ)) • φ u
  let dStar : ℕ → ℤ → ℝ → ℂ := fun j k u =>
    ((J + 1 : ℕ) : ℝ) • dRaw j k u
  let term₆ : ℤ → ℕ → ZMod q₀ → ZMod q₀ → ℕ → ℤ → ℂ :=
    fun k j dstar nstar d n =>
      if (d : ZMod q₀) = dstar ∧ (n : ZMod q₀) = nstar ∧
          Int.gcd (d : ℤ) ((m : ℤ) * lam * lamTilde) = 1 ∧
          lam ∣ lamTilde * n + (s : ℤ) * k * (d : ℤ) ∧
          Int.gcd (n * nk k d n) ((w₁ * c₁ : ℕ) : ℤ) = 1 ∧
          Int.gcd ((n + l * (d : ℤ)) * (nk k d n + l * (d : ℤ))) (c₂ : ℤ) = 1 then
        dStar j k (τ d) * nStar j k ((n : ℝ) / N) *
          reciprocalUnitPhase m ((aPhase : ZMod m) * (Jk k : ZMod m))
            (((n + Bshift * (d : ℤ) : ℤ) : ZMod m) *
              ((nk k d n + Bshift * (d : ℤ) : ℤ) : ZMod m))
      else 0
  let S₆ : ℤ → ℕ → ZMod q₀ → ZMod q₀ → ℂ := fun k j dstar nstar =>
    ∑ d ∈ D, ∑ n ∈ I, term₆ k j dstar nstar d n
  let maxS₆ : ℤ → ℝ≥0 := fun k =>
    (Finset.univ : Finset (Fin (J + 1) × (ZMod q₀ × ZMod q₀))).sup fun r =>
      ‖S₆ k r.1.val r.2.1 r.2.2‖₊
  have hReduction := hred x hxred φ ψ hφ hψ hsφ hsψ hbφ hbψ
    Δ₁ N Λ hΔ₁ hN hΛ
    (by simpa only [Real.rpow_one] using hΔcap)
    (by simpa only [Real.rpow_one, one_mul] using hNcap)
    m q₀ w₁ z₁ w₂ c₁ c₂ hq₀ hw₁ hz₁ hwz
    lam lamTilde d₀ l ℓ aPhase Bshift T
    hlam hlamTilde hd₀ hprimitive hw₂ hw₂Tilde E hE
  rcases hReduction with
    ⟨hDmem, hDint, _, hImem, hS₅tsum, _, _, _, _, hKadm, _, _, _, _, _,
      hstar, _, hmaxAttain, hbound⟩
  change (∀ k : ℤ, ∃ r : Fin (J + 1) × (ZMod q₀ × ZMod q₀),
    maxS₆ k = ‖S₆ k r.1.val r.2.1 r.2.2‖₊) at hmaxAttain
  have hXi := hsix x hxsix m q₀ c₁ c₂ w₁ w₂ z₁ gV hm hq₀ hc₁ hc₂ hgV
    hw₁ hw₁sq hz₁ hwz hzm M N R₀ Q Hscale Δ₁ Λ γ
    hM hR₀ hQ hHscale hΔ₁ hΛ hNγ hγlo hγhi hMNlo hMNhi hNR hRQ
    hHdef hΔlower hΔupper hmupper hwupper hΛupper
    lam lamTilde l aPhase Bshift d₀ hd₀nonneg hlam hlamTilde hw₂ hw₂Tilde
    hprimitive hA
  rcases hXi with
    ⟨_, _, hKlam, hT, hΔstar, _, _, _, _, _, hξ, hξsum, _, hPointwise⟩
  change 0 < Klam at hKlam
  change 0 < T at hT
  change 0 < Δstar at hΔstar
  change (∀ k : ℤ, 0 ≤ ξ k) at hξ
  change (∑ k ∈ S, ξ k) ≤ Cweight at hξsum
  have hR : 0 ≤ R := by positivity
  have hKsub : Kadm ⊆ S := by
    intro k hk
    obtain ⟨hkabs, hkw, hkgcd⟩ := (hKadm k).mp hk
    have hbig : |(k : ℝ)| ≤ max 1 CK * Klam :=
      hkabs.trans (mul_le_mul_of_nonneg_right (le_max_right _ _) hKlam.le)
    exact Finset.mem_filter.mpr
      ⟨Finset.mem_Icc.mpr ⟨Int.ceil_le.mpr (abs_le.mp hbig).1,
        Int.le_floor.mpr (abs_le.mp hbig).2⟩, hkw, hkgcd⟩
  have hmass : (∑ k ∈ Kadm, ξ k) ≤ Cweight :=
    (Finset.sum_le_sum_of_subset_of_nonneg hKsub (fun k _ _ => hξ k)).trans hξsum
  have hStarBound (k : ℤ) (hk : k ∈ Kadm) (j : ℕ) (hj : j ≤ J)
      (dstar nstar : ZMod q₀) :
      ‖S₆ k j dstar nstar‖ ≤ C₆ * ξ k * R := by
    obtain ⟨hnSmooth, hdSmooth, hnSupport, hdSupport, hderiv⟩ := hstar k hk j hj
    have hComplete := hPointwise (dStar j k) (nStar j k)
      hdSmooth hnSmooth hdSupport hnSupport
      (fun r u => (hderiv r u).2) (fun r u => (hderiv r u).1)
      k (dstar.val : ℤ) (nstar.val : ℤ)
    let HInt : ℤ × ℤ → ℂ := fun z =>
      let nt : ℤ := (lamTilde * z.2 + (s : ℤ) * k * z.1) / lam
      if Int.ModEq (q₀ : ℤ) z.1 (dstar.val : ℤ) ∧
          Int.ModEq (q₀ : ℤ) z.2 (nstar.val : ℤ) ∧
          Int.gcd z.1 ((m : ℤ) * lam * lamTilde) = 1 ∧
          lam ∣ lamTilde * z.2 + (s : ℤ) * k * z.1 ∧
          Int.gcd (z.2 * nt) ((w₁ * c₁ : ℕ) : ℤ) = 1 ∧
          Int.gcd ((z.2 + l * z.1) * (nt + l * z.1)) (c₂ : ℤ) = 1 then
        dStar j k (((z₁ : ℝ) * (z.1 : ℝ) - (d₀ : ℝ)) / Δ₁) *
          nStar j k ((z.2 : ℝ) / N) *
          reciprocalUnitPhase m ((aPhase : ZMod m) * (Jk k : ZMod m))
            (((z.2 + Bshift * z.1 : ℤ) : ZMod m) *
              ((nt + Bshift * z.1 : ℤ) : ZMod m))
      else 0
    let BD : Finset ℤ :=
      Finset.Icc ⌈((d₀ : ℝ) + cD * Δ₁) / (z₁ : ℝ)⌉
        ⌊((d₀ : ℝ) + CD * Δ₁) / (z₁ : ℝ)⌋
    let BN : Finset ℤ := Finset.Icc ⌈cN * N⌉ ⌊CN * N⌋
    let total : ℂ := ∑ d ∈ BD, ∑ n ∈ BN, HInt (d, n)
    rcases hComplete with ⟨hCompleteSum, _, hCompleteNorm⟩
    change HasSum HInt total at hCompleteSum
    change ‖total‖ ≤ C₆ * ξ k * R at hCompleteNorm
    let F : ℕ × ℤ → ℂ := fun z => term₆ k j dstar nstar z.1 z.2
    have hFzero (z : ℕ × ℤ) (hz : z ∉ D ×ˢ I) : F z = 0 := by
      by_cases hd : z.1 ∈ D
      · have hn : z.2 ∉ I := fun hn => hz (Finset.mem_product.mpr ⟨hd, hn⟩)
        have hzero : ψ ((z.2 : ℝ) / N) = 0 := (hImem z.2).not_left.mp hn
        simp [F, term₆, nStar, hzero]
      · have hzero : φ (τ z.1) = 0 := (hDmem z.1).not_left.mp hd
        simp [F, term₆, dStar, dRaw, hzero]
    have hNatSum : HasSum F (S₆ k j dstar nstar) := by
      simpa only [Finset.sum_product, F, S₆] using
        (hasSum_sum_of_ne_finset_zero hFzero)
    let f : ℕ × ℤ → ℤ × ℤ := fun z => ((z.1 : ℤ), z.2)
    have hf : Function.Injective f :=
      (Nat.cast_injective : Function.Injective (fun d : ℕ => (d : ℤ))).prodMap
        Function.injective_id
    have hrep (z : ℤ) (r : ZMod q₀) :
        Int.ModEq (q₀ : ℤ) z (r.val : ℤ) ↔ (z : ZMod q₀) = r := by
      rw [← ZMod.intCast_eq_intCast_iff]
      simp only [Int.cast_natCast, ZMod.natCast_zmod_val]
    have heq (z : ℕ × ℤ) : HInt (f z) = F z := by
      simp only [HInt, f, F, term₆, nk, τ, hrep, Int.cast_natCast]
    have hOutside (z : ℤ × ℤ) (hz : z ∉ Set.range f) : HInt z = 0 := by
      have hdneg : z.1 < 0 := by
        by_contra hnot
        have hd : 0 ≤ z.1 := le_of_not_gt hnot
        apply hz
        refine ⟨(z.1.toNat, z.2), ?_⟩
        exact Prod.ext (Int.toNat_of_nonneg hd) rfl
      have hzero : φ (((z₁ : ℝ) * (z.1 : ℝ) - (d₀ : ℝ)) / Δ₁) = 0 := by
        by_contra hne
        exact (not_lt_of_ge hdneg.le) (hDint z.1 hne)
      simp [HInt, dStar, dRaw, hzero]
    have hOldSum : HasSum HInt (S₆ k j dstar nstar) :=
      (hf.hasSum_iff hOutside).mp (hNatSum.congr_fun heq)
    have htotal : S₆ k j dstar nstar = total := hOldSum.unique hCompleteSum
    rw [htotal]
    exact hCompleteNorm
  have hmaxBound (k : ℤ) (hk : k ∈ Kadm) :
      (maxS₆ k : ℝ) ≤ C₆ * ξ k * R := by
    obtain ⟨r, hr⟩ := hmaxAttain k
    rw [hr]
    exact hStarBound k hk r.1.val (Nat.le_of_lt_succ r.1.isLt) r.2.1 r.2.2
  have hsumBound : (∑ k ∈ Kadm, (maxS₆ k : ℝ)) ≤ C₆ * Cweight * R := by
    calc
      _ ≤ ∑ k ∈ Kadm, C₆ * ξ k * R := Finset.sum_le_sum hmaxBound
      _ = C₆ * (∑ k ∈ Kadm, ξ k) * R := by
        simp only [Finset.mul_sum, Finset.sum_mul]
      _ ≤ C₆ * Cweight * R :=
        mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_left hmass hC₆.le) hR
  refine ⟨hS₅tsum, hbound.trans ?_⟩
  calc
    _ ≤ ((q₀ * g₀ : ℕ) : ℝ) * (C₆ * Cweight * R) + x ^ (-Berr) :=
      add_le_add (mul_le_mul_of_nonneg_left hsumBound (Nat.cast_nonneg (q₀ * g₀))) le_rfl
    _ = (C₆ * Cweight) * ((q₀ * g₀ : ℕ) : ℝ) * R + x ^ (-Berr) := by ring

end

/-!
## Uniform progression estimates and convolution bounds

Convert character-sum bounds into uniform progression estimates and propagate the savings
through arithmetic convolutions.
-/

theorem exists_nonprincipal_vonMangoldt_prefix_bound
    (D : ℝ) (hD : 0 < D) :
    ∃ C c : ℝ, 0 < C ∧ 0 < c ∧
      ∃ X0 : ℕ, 4 ≤ X0 ∧
        ∀ X : ℕ, X0 ≤ X →
          ∀ (q : ℕ) [NeZero q] (χ : DirichletCharacter ℂ q), χ ≠ 1 →
            (q : ℝ) ≤ Real.log (X : ℝ) ^ D →
              ∀ y : ℕ, y ≤ X →
                ‖∑ n ∈ Finset.Icc 1 y,
                    χ (n : ZMod q) * (ArithmeticFunction.vonMangoldt n : ℂ)‖ ≤
                  C * ((X : ℝ) * Real.exp
                    (-c * Real.sqrt (Real.log (X : ℝ)))) := by
  obtain ⟨C0, c0, hC0, hc0, Xs, _, hpoint⟩ :=
    exists_siegelWalfisz_norm_twistedChebyshevSum_le (2 * D) (by positivity)
  let K : ℝ := Real.log 4 + 4
  let C : ℝ := C0 + K
  let c : ℝ := min (c0 / 2) 1
  have hK : 0 < K := by
    dsimp [K]
    positivity
  have hC : 0 < C := by
    dsimp [C]
    positivity
  have hc : 0 < c := lt_min (by positivity) zero_lt_one
  have hcC0 : c ≤ c0 / 2 := min_le_left _ _
  have hcOne : c ≤ 1 := min_le_right _ _
  have hlogTop : Tendsto (fun X : ℕ ↦ Real.log (X : ℝ)) atTop atTop :=
    Real.tendsto_log_atTop.comp tendsto_natCast_atTop_atTop
  obtain ⟨Xlog, hXlog⟩ := Filter.eventually_atTop.mp
    (hlogTop.eventually_ge_atTop 4)
  let X0 : ℕ := max 4 (max Xlog (Xs ^ 2))
  refine ⟨C, c, hC, hc, X0, by simp [X0], ?_⟩
  intro X hX q _ χ hχ hq y hy
  change ‖twistedChebyshevSum y q χ‖ ≤
    C * ((X : ℝ) * Real.exp (-c * Real.sqrt (Real.log (X : ℝ))))
  obtain ⟨hXFour, htail⟩ := max_le_iff.mp hX
  obtain ⟨hXlogX, hXsSqX⟩ := max_le_iff.mp htail
  let L : ℝ := Real.log (X : ℝ)
  have hLFour : 4 ≤ L := hXlog X hXlogX
  have hLnonneg : 0 ≤ L := by linarith
  have hXpos : (0 : ℝ) < X := by
    exact_mod_cast (show 0 < X by omega)
  by_cases hySmall : (y : ℝ) ≤ Real.sqrt (X : ℝ)
  · have hlinear : ‖twistedChebyshevSum y q χ‖ ≤ K * Real.sqrt (X : ℝ) := by
      calc
        ‖twistedChebyshevSum y q χ‖ ≤
            ∑ n ∈ Finset.Icc 1 y,
              ‖χ (n : ZMod q) * (ArithmeticFunction.vonMangoldt n : ℂ)‖ :=
          norm_sum_le _ _
        _ ≤ ∑ n ∈ Finset.Icc 1 y, ArithmeticFunction.vonMangoldt n := by
          apply Finset.sum_le_sum
          intro n _
          rw [norm_mul, Complex.norm_real,
            Real.norm_of_nonneg ArithmeticFunction.vonMangoldt_nonneg]
          exact mul_le_of_le_one_left ArithmeticFunction.vonMangoldt_nonneg
            (χ.norm_le_one (n : ZMod q))
        _ = Chebyshev.psi (y : ℝ) := by
          rw [Chebyshev.psi]
          simp only [Nat.floor_natCast]
          rw [show Finset.Icc 1 y = Finset.Ioc 0 y by
            simpa using (Finset.Icc_succ_left_eq_Ioc (0 : ℕ) y)]
        _ ≤ K * (y : ℝ) := Chebyshev.psi_le_const_mul_self (Nat.cast_nonneg y)
        _ ≤ K * Real.sqrt (X : ℝ) := mul_le_mul_of_nonneg_left hySmall hK.le
    let u : ℝ := Real.sqrt L
    have huNonneg : 0 ≤ u := Real.sqrt_nonneg L
    have huSq : u ^ 2 = L := Real.sq_sqrt hLnonneg
    have hTwoLeU : (2 : ℝ) ≤ u := by
      apply (sq_le_sq₀ (by norm_num) huNonneg).mp
      nlinarith
    have huLHalf : u ≤ L / 2 := by
      nlinarith [mul_nonneg huNonneg (sub_nonneg.mpr hTwoLeU)]
    have hcu : c * u ≤ L / 2 :=
      (mul_le_of_le_one_left huNonneg hcOne).trans huLHalf
    have hsqrtEnvelope : Real.sqrt (X : ℝ) ≤
        (X : ℝ) * Real.exp (-c * Real.sqrt (Real.log (X : ℝ))) := by
      calc
        Real.sqrt (X : ℝ) = Real.exp (L / 2) := by
          rw [Real.exp_half]
          simp [L, Real.exp_log hXpos]
        _ ≤ Real.exp (L - c * u) := by
          apply Real.exp_monotone
          linarith
        _ = (X : ℝ) * Real.exp (-c * Real.sqrt (Real.log (X : ℝ))) := by
          rw [sub_eq_add_neg, ← neg_mul, Real.exp_add]
          dsimp [L, u]
          rw [Real.exp_log hXpos]
    have hKC : K ≤ C := by
      dsimp [C]
      linarith
    exact hlinear.trans (mul_le_mul hKC hsqrtEnvelope (Real.sqrt_nonneg _) hC.le)
  · have hyLarge : Real.sqrt (X : ℝ) < (y : ℝ) := lt_of_not_ge hySmall
    have hXsRoot : (Xs : ℝ) ≤ Real.sqrt (X : ℝ) :=
      Real.le_sqrt_of_sq_le (by exact_mod_cast hXsSqX)
    let l : ℝ := Real.log (y : ℝ)
    have hlogHalf : L / 2 ≤ l := by
      calc
        L / 2 = Real.log (Real.sqrt (X : ℝ)) := by
          rw [Real.log_sqrt (Nat.cast_nonneg X)]
        _ ≤ Real.log (y : ℝ) :=
          Real.log_le_log (Real.sqrt_pos.mpr hXpos) hyLarge.le
        _ = l := rfl
    have hlTwo : (2 : ℝ) ≤ l := by linarith
    have hlNonneg : 0 ≤ l := by linarith
    have hLleLSq : L ≤ l ^ 2 := by
      nlinarith [mul_nonneg hlNonneg (sub_nonneg.mpr hlTwo)]
    have hpower : L ^ D ≤ l ^ (2 * D) := by
      calc
        L ^ D ≤ (l ^ 2) ^ D := Real.rpow_le_rpow hLnonneg hLleLSq hD.le
        _ = (l ^ (2 : ℝ)) ^ D := by rw [Real.rpow_two]
        _ = l ^ (2 * D) := (Real.rpow_mul hlNonneg 2 D).symm
    have hqLogY : (q : ℝ) ≤ Real.log (y : ℝ) ^ (2 * D) :=
      hq.trans hpower
    have hXsLtY : Xs < y := by exact_mod_cast hXsRoot.trans_lt hyLarge
    have hpointY := hpoint y hXsLtY.le q χ hχ hqLogY
    have hhalfSqrt : Real.sqrt L / 2 ≤ Real.sqrt l := by
      apply (sq_le_sq₀ (by positivity) (Real.sqrt_nonneg l)).mp
      rw [div_pow, Real.sq_sqrt hLnonneg, Real.sq_sqrt hlNonneg]
      nlinarith
    have hdecayScale : c * Real.sqrt L ≤ c0 * Real.sqrt l := by
      calc
        c * Real.sqrt L ≤ (c0 / 2) * Real.sqrt L :=
          mul_le_mul_of_nonneg_right hcC0 (Real.sqrt_nonneg L)
        _ = c0 * (Real.sqrt L / 2) := by ring
        _ ≤ c0 * Real.sqrt l := mul_le_mul_of_nonneg_left hhalfSqrt hc0.le
    have hdecay : Real.exp (-c0 * Real.sqrt l) ≤ Real.exp (-c * Real.sqrt L) := by
      apply Real.exp_monotone
      linarith
    have hyCast : (y : ℝ) ≤ (X : ℝ) := by exact_mod_cast hy
    have hC0C : C0 ≤ C := by
      dsimp [C]
      linarith
    calc
      ‖twistedChebyshevSum y q χ‖ ≤
          C0 * ((y : ℝ) * Real.exp (-c0 * Real.sqrt (Real.log (y : ℝ)))) := hpointY
      _ ≤ C0 * ((X : ℝ) * Real.exp (-c * Real.sqrt (Real.log (X : ℝ)))) := by
        apply mul_le_mul_of_nonneg_left _ hC0.le
        exact mul_le_mul hyCast hdecay (Real.exp_pos _).le (Nat.cast_nonneg X)
      _ ≤ C * ((X : ℝ) * Real.exp (-c * Real.sqrt (Real.log (X : ℝ)))) := by
        apply mul_le_mul_of_nonneg_right hC0C
        positivity

theorem exists_nonprincipal_prime_prefix_bound
    (D : ℝ) (hD : 0 < D) :
    ∃ C c : ℝ, 0 < C ∧ 0 < c ∧
      ∃ X0 : ℕ, 4 ≤ X0 ∧
        ∀ X : ℕ, X0 ≤ X →
          ∀ (q : ℕ) [NeZero q] (χ : DirichletCharacter ℂ q), χ ≠ 1 →
            (q : ℝ) ≤ Real.log (X : ℝ) ^ D →
              ∀ y : ℕ, y ≤ X →
                ‖∑ p ∈ Finset.Icc 1 y with Nat.Prime p,
                    χ (p : ZMod q)‖ ≤
                  C * ((X : ℝ) * Real.exp
                    (-c * Real.sqrt (Real.log (X : ℝ)))) := by
  obtain ⟨C0, c0, hC0, hc0, Xs, hXs4, hprefix⟩ :=
    exists_nonprincipal_vonMangoldt_prefix_bound D hD
  let c : ℝ := min c0 1
  let C : ℝ := (C0 + 1) / Real.log 2
  have hc : 0 < c := lt_min hc0 zero_lt_one
  have hC : 0 < C := by
    dsimp [C]
    positivity
  have hlogTop : Tendsto (fun X : ℕ ↦ Real.log (X : ℝ)) atTop atTop :=
    Real.tendsto_log_atTop.comp tendsto_natCast_atTop_atTop
  obtain ⟨Xlog, hXlog⟩ := Filter.eventually_atTop.mp
    (hlogTop.eventually_ge_atTop 64)
  let X0 : ℕ := max Xs Xlog
  refine ⟨C, c, hC, hc, X0, hXs4.trans (le_max_left _ _), ?_⟩
  intro X hX q _ χ hχ hq y hy
  have hXsX : Xs ≤ X := (le_max_left _ _).trans hX
  have hlog64 : 64 ≤ Real.log (X : ℝ) := hXlog X ((le_max_right _ _).trans hX)
  have hX4 : 4 ≤ X := hXs4.trans hXsX
  have hXpos : (0 : ℝ) < X := by exact_mod_cast (show 0 < X by omega)
  let E : ℝ := (X : ℝ) * Real.exp (-c * Real.sqrt (Real.log (X : ℝ)))
  have hEnonneg : 0 ≤ E := by dsimp [E]; positivity
  have hdecay :
      C0 * ((X : ℝ) * Real.exp (-c0 * Real.sqrt (Real.log (X : ℝ)))) ≤ C0 * E := by
    dsimp [E]
    apply mul_le_mul_of_nonneg_left _ hC0.le
    apply mul_le_mul_of_nonneg_left _ (Nat.cast_nonneg X)
    apply Real.exp_monotone
    simpa only [neg_mul] using neg_le_neg
      (mul_le_mul_of_nonneg_right (min_le_left c0 1)
        (Real.sqrt_nonneg (Real.log (X : ℝ))))
  have herror : 2 * Real.sqrt (X : ℝ) * Real.log (X : ℝ) ≤ E :=
    prime_power_error_le_envelope hXpos hlog64 (min_le_right _ _)
  by_cases hy2 : 2 ≤ y
  · have hbound (k : ℕ) (hk : k ∈ Finset.Icc 2 y) :
        ‖∑ p ∈ Finset.Icc 1 k with Nat.Prime p,
          χ (p : ZMod q) * (Real.log (p : ℝ) : ℂ)‖ ≤ (C0 + 1) * E := by
      obtain ⟨hk2, hky⟩ := Finset.mem_Icc.mp hk
      have hkX : k ≤ X := hky.trans hy
      let A : ℂ := ∑ n ∈ Finset.Icc 1 k,
        χ (n : ZMod q) * (ArithmeticFunction.vonMangoldt n : ℂ)
      let P : ℂ := ∑ p ∈ Finset.Icc 1 k with Nat.Prime p,
        χ (p : ZMod q) * (Real.log (p : ℝ) : ℂ)
      have hA : ‖A‖ ≤ C0 * E :=
        (hprefix X hXsX q χ hχ hq k hkX).trans hdecay
      have hmono : 2 * Real.sqrt (k : ℝ) * Real.log (k : ℝ) ≤
          2 * Real.sqrt (X : ℝ) * Real.log (X : ℝ) := by
        apply mul_le_mul
        · exact mul_le_mul_of_nonneg_left
            (Real.sqrt_le_sqrt (by exact_mod_cast hkX)) (by norm_num)
        · exact Real.log_le_log (by exact_mod_cast (show 0 < k by omega))
            (by exact_mod_cast hkX)
        · exact (Real.log_pos (by exact_mod_cast (show 1 < k by omega))).le
        · positivity
      calc
        _ ≤ ‖A‖ + ‖A - P‖ := norm_le_norm_add_norm_sub A P
        _ ≤ C0 * E + E := add_le_add hA
          ((norm_sum_vonMangoldt_sub_sum_prime_log_le k q χ).trans (hmono.trans herror))
        _ = (C0 + 1) * E := by ring
    calc
      _ ≤ ((C0 + 1) * E) / Real.log 2 :=
        norm_sum_prime_le_of_prime_log_prefix_bound (fun n => χ (n : ZMod q))
          y hy2 ((C0 + 1) * E) hbound
      _ = C * ((X : ℝ) * Real.exp (-c * Real.sqrt (Real.log (X : ℝ)))) := by
        dsimp [C, E]
        ring
  · have hempty : (Finset.Icc 1 y).filter Nat.Prime = ∅ := by
      apply Finset.filter_eq_empty_iff.mpr
      intro p hp hprime
      have hpy := (Finset.mem_Icc.mp hp).2
      have := hprime.two_le
      omega
    rw [hempty, Finset.sum_empty, norm_zero]
    exact mul_nonneg hC.le hEnonneg

theorem exists_masked_prime_prefix_discrepancy_bound
    (D : ℝ) (hD : 0 < D) :
    ∃ C c : ℝ, 0 < C ∧ 0 < c ∧
      ∃ X0 : ℕ, 4 ≤ X0 ∧
        ∀ X : ℕ, X0 ≤ X →
          ∀ (q : ℕ) [NeZero q],
            (q : ℝ) ≤ Real.log (X : ℝ) ^ D →
              ∀ r0 : ℕ, 0 < r0 →
                ∀ a : (ZMod q)ˣ,
                  ∀ y : ℕ, y ≤ X →
                    ‖(((Finset.Icc 1 y).filter (fun p =>
                          Nat.Prime p ∧ Nat.Coprime p r0 ∧
                            (p : ZMod q) = (a : ZMod q))).card : ℂ) -
                      (q.totient : ℂ)⁻¹ *
                        (((Finset.Icc 1 y).filter (fun p =>
                          Nat.Prime p ∧ Nat.Coprime p r0 ∧
                            Nat.Coprime p q)).card : ℂ)‖ ≤
                      C * (r0.divisors.card : ℝ) *
                        ((X : ℝ) * Real.exp
                          (-c * Real.sqrt (Real.log (X : ℝ)))) := by
  classical
  obtain ⟨C0, c0, hC0, hc0, Xs, hXs4, hprefix⟩ :=
    exists_nonprincipal_prime_prefix_bound D hD
  let c : ℝ := min c0 1
  have hc : 0 < c := lt_min hc0 zero_lt_one
  have hlogTop : Tendsto (fun X : ℕ ↦ Real.log (X : ℝ)) atTop atTop :=
    Real.tendsto_log_atTop.comp tendsto_natCast_atTop_atTop
  obtain ⟨Xlog, hXlog⟩ := Filter.eventually_atTop.mp
    (hlogTop.eventually_ge_atTop 1)
  let X0 : ℕ := max Xs Xlog
  refine ⟨C0 + 1, c, by positivity, hc, X0, hXs4.trans (le_max_left _ _), ?_⟩
  intro X hX q _ hq r0 hr0 a y hy
  have hXsX : Xs ≤ X := (le_max_left _ _).trans hX
  have hLone : 1 ≤ Real.log (X : ℝ) := hXlog X ((le_max_right _ _).trans hX)
  have hX4 : 4 ≤ X := hXs4.trans hXsX
  have hXpos : (0 : ℝ) < X := by exact_mod_cast (show 0 < X by omega)
  let E : ℝ := (X : ℝ) * Real.exp (-c * Real.sqrt (Real.log (X : ℝ)))
  have hEone : 1 ≤ E := by
    have hsqrt : Real.sqrt (Real.log (X : ℝ)) ≤ Real.log (X : ℝ) :=
      Real.sqrt_le_self_iff.mpr (Or.inr hLone)
    have hmul : c * Real.sqrt (Real.log (X : ℝ)) ≤ Real.log (X : ℝ) :=
      (mul_le_of_le_one_left (Real.sqrt_nonneg _) (min_le_right c0 1)).trans hsqrt
    calc
      1 ≤ Real.exp (Real.log (X : ℝ) + -c * Real.sqrt (Real.log (X : ℝ))) :=
        Real.one_le_exp_iff.mpr (by linarith)
      _ = E := by rw [Real.exp_add, Real.exp_log hXpos]
  have hEnonneg : 0 ≤ E := zero_le_one.trans hEone
  have hdecay :
      C0 * ((X : ℝ) * Real.exp (-c0 * Real.sqrt (Real.log (X : ℝ)))) ≤ C0 * E := by
    dsimp [E]
    apply mul_le_mul_of_nonneg_left _ hC0.le
    apply mul_le_mul_of_nonneg_left _ (Nat.cast_nonneg X)
    apply Real.exp_monotone
    simpa only [neg_mul] using neg_le_neg
      (mul_le_mul_of_nonneg_right (min_le_left c0 1)
        (Real.sqrt_nonneg (Real.log (X : ℝ))))
  let S : Finset ℕ := (Finset.Icc 1 y).filter Nat.Prime
  let T : DirichletCharacter ℂ q → ℂ := fun χ =>
    ∑ p ∈ S with Nat.Coprime p r0, χ (p : ZMod q)
  let B : ℝ := C0 * E + (r0.primeFactors.card : ℝ)
  have hBnonneg : 0 ≤ B := by dsimp [B]; positivity
  have hdeleted : S.filter (fun p => ¬ Nat.Coprime p r0) ⊆ r0.primeFactors := by
    intro p hp
    obtain ⟨hpS, hcop⟩ := Finset.mem_filter.mp hp
    have hprime : Nat.Prime p := (Finset.mem_filter.mp hpS).2
    have hdiv : p ∣ r0 := hprime.dvd_iff_not_coprime.mpr hcop
    exact hprime.mem_primeFactors hdiv hr0.ne'
  have hT (χ : DirichletCharacter ℂ q) (hχ : χ ≠ 1) : ‖T χ‖ ≤ B := by
    have hfull : ‖∑ p ∈ S, χ (p : ZMod q)‖ ≤ C0 * E :=
      (hprefix X hXsX q χ hχ hq y hy).trans hdecay
    have hdel : ‖∑ p ∈ S with ¬ Nat.Coprime p r0, χ (p : ZMod q)‖ ≤
        (r0.primeFactors.card : ℝ) := by
      calc
        _ ≤ ∑ p ∈ S with ¬ Nat.Coprime p r0, (1 : ℝ) :=
          norm_sum_le_of_le _ fun p _ => χ.norm_le_one _
        _ = ((S.filter (fun p => ¬ Nat.Coprime p r0)).card : ℝ) := by simp
        _ ≤ (r0.primeFactors.card : ℝ) := by exact_mod_cast Finset.card_le_card hdeleted
    have hsplit : T χ = (∑ p ∈ S, χ (p : ZMod q)) -
        ∑ p ∈ S with ¬ Nat.Coprime p r0, χ (p : ZMod q) :=
      eq_sub_of_add_eq (Finset.sum_filter_add_sum_filter_not S
        (fun p => Nat.Coprime p r0) (fun p => χ (p : ZMod q)))
    rw [hsplit]
    exact (norm_sub_le _ _).trans (add_le_add hfull hdel)
  have hωτ : (r0.primeFactors.card : ℝ) ≤ (r0.divisors.card : ℝ) := by
    rw [Nat.primeFactors_eq_to_filter_divisors_prime]
    exact_mod_cast Finset.card_filter_le r0.divisors Nat.Prime
  have hτone : (1 : ℝ) ≤ r0.divisors.card :=
    Nat.one_le_cast.mpr (Finset.card_pos.mpr (Nat.nonempty_divisors.mpr hr0.ne'))
  have hBfinal : B ≤ (C0 + 1) * (r0.divisors.card : ℝ) * E := by
    calc
      B ≤ C0 * ((r0.divisors.card : ℝ) * E) + (r0.divisors.card : ℝ) * E :=
        add_le_add
          (mul_le_mul_of_nonneg_left (le_mul_of_one_le_left hEnonneg hτone) hC0.le)
          (hωτ.trans (le_mul_of_one_le_right (Nat.cast_nonneg _) hEone))
      _ = _ := by ring
  let f : ℕ →₀ ℂ := Finsupp.indicator S (fun _ _ => (1 : ℂ))
  have hsupport : f.support = S := by
    ext n
    simp [f, Finsupp.mem_support_iff, Finsupp.indicator_apply]
  have hf (n : ℕ) (hn : n ∈ S) : f n = 1 :=
    Finsupp.indicator_of_mem hn (fun _ _ => (1 : ℂ))
  have hcount (P : ℕ → Prop) [DecidablePred P] :
      (∑ n ∈ S, if P n then f n else 0) =
        (((Finset.Icc 1 y).filter (fun n => Nat.Prime n ∧ P n)).card : ℂ) := by
    calc
      _ = ∑ n ∈ S, if P n then (1 : ℂ) else 0 := by
        apply Finset.sum_congr rfl
        intro n hn
        rw [hf n hn]
      _ = _ := by
        rw [Finset.sum_boole]
        simp only [S, Finset.filter_filter]
  have htwist (χ : DirichletCharacter ℂ q) :
      (∑ n ∈ S, if Nat.Coprime n r0 then f n * χ (n : ZMod q) else 0) = T χ := by
    dsimp only [T]
    conv_rhs => rw [Finset.sum_filter]
    apply Finset.sum_congr rfl
    intro n hn
    rw [hf n hn, one_mul]
  have hid := masked_discrepancy_eq_nonprincipal_character_sum
    q r0 hr0 a f
  simp_rw [hsupport, hcount, htwist] at hid
  have hcharCard :
      ((Finset.univ : Finset (DirichletCharacter ℂ q)).erase 1).card ≤ q.totient := by
    simpa only [Finset.card_univ, ← Nat.card_eq_fintype_card,
      DirichletCharacter.card_eq_totient_of_hasEnoughRootsOfUnity] using
      (Finset.card_erase_le (s := Finset.univ) (a := (1 : DirichletCharacter ℂ q)))
  have hφpos : (0 : ℝ) < q.totient :=
    Nat.cast_pos.mpr (NeZero.pos q.totient)
  have havg :
      ‖(q.totient : ℂ)⁻¹ *
        ∑ χ ∈ (Finset.univ : Finset (DirichletCharacter ℂ q)).erase 1,
          χ ((a : ZMod q)⁻¹) * T χ‖ ≤ B := by
    calc
      _ = (q.totient : ℝ)⁻¹ *
          ‖∑ χ ∈ (Finset.univ : Finset (DirichletCharacter ℂ q)).erase 1,
            χ ((a : ZMod q)⁻¹) * T χ‖ := by
        rw [norm_mul, norm_inv, Complex.norm_natCast]
      _ ≤ (q.totient : ℝ)⁻¹ *
          ∑ _χ ∈ (Finset.univ : Finset (DirichletCharacter ℂ q)).erase 1, B := by
        apply mul_le_mul_of_nonneg_left _ (inv_nonneg.mpr hφpos.le)
        apply norm_sum_le_of_le
        intro χ hχ
        calc
          ‖χ ((a : ZMod q)⁻¹) * T χ‖ =
              ‖χ ((a : ZMod q)⁻¹)‖ * ‖T χ‖ := norm_mul _ _
          _ ≤ ‖T χ‖ := mul_le_of_le_one_left (norm_nonneg _) (χ.norm_le_one _)
          _ ≤ B := hT χ (Finset.mem_erase.mp hχ).1
      _ = (q.totient : ℝ)⁻¹ *
          (((Finset.univ : Finset (DirichletCharacter ℂ q)).erase 1).card : ℝ) * B := by
        rw [Finset.sum_const, nsmul_eq_mul, mul_assoc]
      _ ≤ (q.totient : ℝ)⁻¹ * (q.totient : ℝ) * B := by
        apply mul_le_mul_of_nonneg_right _ hBnonneg
        exact mul_le_mul_of_nonneg_left (Nat.cast_le.mpr hcharCard) (inv_nonneg.mpr hφpos.le)
      _ = B := by rw [inv_mul_cancel₀ hφpos.ne', one_mul]
  rw [hid]
  exact havg.trans hBfinal

section
open scoped ContDiff
open Classical in
theorem sourceCompatibility_residueFamily_exact
    (q₀ r₁ b₁ b₂ : ℕ) [NeZero q₀] (ℓ : ℤ)
    (hprimitive : Nat.Coprime (r₁ * b₁ * b₂) q₀) :
    let E : ZMod q₀ → Finset (ZMod q₀) := fun r =>
      if IsUnit r then
        Finset.univ.filter (fun n : ZMod q₀ =>
          IsUnit (n * (n + (ℓ : ZMod q₀) * r * (r₁ : ZMod q₀))) ∧
            (b₁ : ZMod q₀) * n⁻¹ =
              (b₂ : ZMod q₀) * (n + (ℓ : ZMod q₀) * r * (r₁ : ZMod q₀))⁻¹)
      else ∅
    (∀ r : ZMod q₀, (E r).card ≤ Int.gcd (q₀ : ℤ) ℓ) ∧
      (∀ r : ZMod q₀, ¬IsUnit r → E r = ∅) ∧
      ∀ d : ℕ, Nat.Coprime d q₀ → ∀ n : ℤ,
        sourceCompatibility (d * r₁) q₀ b₁ b₂ ℓ n =
          if (n : ZMod q₀) ∈ E (d : ZMod q₀) then 1 else 0 := by
  intro E
  have hcompat (d : ℕ) (hd : Nat.Coprime d q₀) (n : ℤ) :
      sourceCompatibility (d * r₁) q₀ b₁ b₂ ℓ n =
        if (n : ZMod q₀) ∈ E (d : ZMod q₀) then 1 else 0 := by
    have hu := ZMod.coe_int_isUnit_iff_isCoprime
      (n * (n + ℓ * ((d * r₁ : ℕ) : ℤ))) q₀
    rw [isCoprime_comm, Int.isCoprime_iff_gcd_eq_one] at hu
    simp only [Int.cast_mul, Int.cast_add, Int.cast_natCast, Nat.cast_mul] at hu
    simp only [sourceCompatibility, E,
      ite_eq_left ((ZMod.isUnit_iff_coprime d q₀).mpr hd), Finset.mem_filter,
      Finset.mem_univ, true_and, Int.cast_mul, Int.cast_add, Int.cast_natCast,
      Nat.cast_mul, mul_assoc, hu]
  refine ⟨?_, ?_, hcompat⟩
  · intro r
    by_cases hr : IsUnit r
    · have hrval : Nat.Coprime r.val q₀ :=
        (ZMod.isUnit_iff_coprime _ _).mp
          (by simpa only [ZMod.natCast_zmod_val] using hr)
      let g : ℕ := Int.gcd (q₀ : ℤ) ℓ
      let k : ℕ := g + 1
      let f : ZMod q₀ × ℕ → ℕ :=
        fun z => q₀ * z.2 + (z.1 - 1).val + 1
      let T : Finset ℕ := (Finset.Icc 1 (k * q₀)).filter fun n =>
        sourceCompatibility (r.val * r₁) q₀ b₁ b₂ ℓ (n : ℤ) = 1
      have hfcast (z : ZMod q₀ × ℕ) : (f z : ZMod q₀) = z.1 := by
        simp [f]
      have hfinj : Function.Injective f := by
        intro u v huv
        apply ((Equiv.subRight (1 : ZMod q₀)).prodCongr (Equiv.refl ℕ)).injective
        apply (Nat.residueClassesEquiv q₀).symm.injective
        change (u.1 - 1).val + q₀ * u.2 = (v.1 - 1).val + q₀ * v.2
        simpa only [Nat.add_comm] using Nat.add_right_cancel huv
      have hmap : Set.MapsTo f ((E r).product (Finset.range k)) T := by
        intro z hz
        obtain ⟨hzE, hzj⟩ := Finset.mem_product.mp hz
        have hj : z.2 < k := Finset.mem_range.mp hzj
        have hv : (z.1 - 1).val + 1 ≤ q₀ :=
          Nat.succ_le_of_lt (ZMod.val_lt _)
        refine Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr ⟨?_, ?_⟩, ?_⟩
        · dsimp only [f]
          omega
        · dsimp only [f]
          nlinarith [Nat.mul_le_mul_left q₀ (Nat.succ_le_of_lt hj)]
        · rw [hcompat r.val hrval, Int.cast_natCast, hfcast,
            ZMod.natCast_zmod_val, ite_eq_left hzE]
      have hcard : (E r).card * k ≤ T.card := by
        simpa only [Finset.product_eq_sprod, Finset.card_product, Finset.card_range] using
          Finset.card_le_card_of_injOn f hmap hfinj.injOn
      have hcardR : ((E r).card : ℝ) * (k : ℝ) ≤ (T.card : ℝ) := by
        exact_mod_cast hcard
      have hbound : (T.card : ℝ) ≤ (g : ℝ) * (1 + (k : ℝ)) := by
        simpa only [Nat.cast_mul, mul_div_cancel_right₀ _ (NeZero.ne (q₀ : ℝ))] using
          sourceCompatibility_fixed_shift_count_le q₀ (r.val * r₁) b₁ b₂
            (k * q₀) ℓ hprimitive.coprime_mul_right.coprime_mul_left
            (hrval.mul_left hprimitive.coprime_mul_right.coprime_mul_right)
      change (E r).card ≤ g
      by_contra h
      have hlarge : (g : ℝ) + 1 ≤ ((E r).card : ℝ) := by
        exact_mod_cast Nat.succ_le_of_lt (Nat.lt_of_not_ge h)
      have hk : (k : ℝ) = (g : ℝ) + 1 := by simp [k]
      nlinarith [mul_le_mul_of_nonneg_right hlarge (Nat.cast_nonneg k)]
    · simp [E, hr]
  · intro r hr
    simp [E, hr]

theorem source_positive_profile_floor_center_transport
    (cD CD d₀ Δ₁ : ℝ) (φ : ℝ → ℂ)
    (_hcD : 0 < cD) (_hCD : cD ≤ CD)
    (hd₀ : 2 ≤ d₀) (hΔ₁ : 1 ≤ Δ₁)
    (hφ : ContDiff ℝ ∞ φ)
    (hsφ : Function.support φ ⊆ Set.Icc cD CD) :
    let k : ℤ := ⌊d₀⌋
    let θ : ℝ := (d₀ - (k : ℝ)) / Δ₁
    let φ₀ : ℝ → ℂ := fun t => φ (t - θ)
    0 < k ∧ d₀ / 2 ≤ (k : ℝ) ∧ (k : ℝ) ≤ d₀ ∧
      0 ≤ θ ∧ θ < 1 ∧
      ContDiff ℝ ∞ φ₀ ∧
      Function.support φ₀ ⊆ Set.Icc cD (CD + 1) ∧
      (∀ (j : ℕ) (t : ℝ),
        iteratedDeriv j φ₀ t = iteratedDeriv j φ (t - θ)) ∧
      ∀ z d : ℝ,
        φ₀ ((z * d - (k : ℝ)) / Δ₁) = φ ((z * d - d₀) / Δ₁) := by
  intro k θ φ₀
  have hΔpos : 0 < Δ₁ := zero_lt_one.trans_le hΔ₁
  have hkpos : 0 < k := Int.floor_pos.mpr (by linarith)
  have hkle : (k : ℝ) ≤ d₀ := Int.floor_le d₀
  have hklt : d₀ < (k : ℝ) + 1 := Int.lt_floor_add_one d₀
  have hkhalf : d₀ / 2 ≤ (k : ℝ) := by linarith
  have hθnonneg : 0 ≤ θ := div_nonneg (sub_nonneg.mpr hkle) hΔpos.le
  have hθlt : θ < 1 := by
    apply (div_lt_one hΔpos).mpr
    linarith
  refine ⟨hkpos, hkhalf, hkle, hθnonneg, hθlt, ?_, ?_, ?_, ?_⟩
  · exact hφ.comp (contDiff_id.sub contDiff_const)
  · intro t ht
    obtain ⟨hlo, hhi⟩ := hsφ ht
    constructor <;> linarith
  · intro j t
    exact congrFun (iteratedDeriv_comp_sub_const j φ θ) t
  · intro z d
    dsimp only [φ₀, θ]
    congr 1
    ring

end

open Classical in
theorem typeIIICompleteFiberSum_prime_degenerate_value
    (p : ℕ) [Fact p.Prime] (h₁ h₂ h₃ : ZMod p) (a : (ZMod p)ˣ)
    (hzero : h₁ * h₂ * h₃ = 0) :
    let R : ZMod p → ℂ := fun h => if h = 0 then (p : ℂ) - 1 else -1
    typeIIICompleteFiberSum p h₁ h₂ h₃ a =
      (p : ℂ)⁻¹ *
        (if h₃ = 0 then R h₁ * R h₂
        else if h₂ = 0 then R h₁ * R h₃ else R h₂ * R h₃) := by
  intro R
  have hthird (x y : ZMod p) :
      typeIIICompleteFiberSum p x y 0 a = (p : ℂ)⁻¹ * (R x * R y) := by
    have hinner (u v : ZMod p) :
        (∑ w : ZMod p, if u * v * w = (a : ZMod p) then
          ZMod.stdAddChar (x * u + y * v) else 0) =
        if u ≠ 0 ∧ v ≠ 0 then ZMod.stdAddChar (x * u + y * v) else 0 := by
      simp only [← mul_ne_zero_iff]
      by_cases huv : u * v = 0
      · simp [huv, Ne.symm a.ne_zero]
      · simp [← eq_inv_mul_iff_mul_eq₀ huv, huv]
    have hdouble :
        (∑ u : ZMod p, ∑ v : ZMod p,
          if u ≠ 0 ∧ v ≠ 0 then ZMod.stdAddChar (x * u + y * v) else 0) =
        (∑ u : (ZMod p)ˣ, ZMod.stdAddChar (x * (u : ZMod p))) *
          ∑ v : (ZMod p)ˣ, ZMod.stdAddChar (y * (v : ZMod p)) := by
      rw [sum_units_eq_sum_ite p (fun u => ZMod.stdAddChar (x * u)),
        sum_units_eq_sum_ite p (fun v => ZMod.stdAddChar (y * v)), Finset.sum_mul_sum]
      simp only [AddChar.map_add_eq_mul, ite_mul, mul_ite, zero_mul, mul_zero,
        ← ite_and, and_comm]
    simp only [typeIIICompleteFiberSum, zero_mul, add_zero, hinner, hdouble,
      stdAddChar_sum_units, R]
  have hcycle (x y z : ZMod p) :
      typeIIICompleteFiberSum p x y z a = typeIIICompleteFiberSum p z x y a := by
    unfold typeIIICompleteFiberSum
    congr 1
    rw [Finset.sum_comm_cycle]
    simp only [mul_comm, mul_left_comm, add_assoc, add_comm, add_left_comm]
  by_cases h₃zero : h₃ = 0
  · simpa only [h₃zero, ite_true] using hthird h₁ h₂
  by_cases h₂zero : h₂ = 0
  · simp only [h₃zero, h₂zero, ite_false, ite_true]
    rw [hcycle h₁ 0 h₃, hthird, mul_comm (R h₃) (R h₁)]
  have h₁zero : h₁ = 0 := by
    simpa only [mul_eq_zero, h₂zero, h₃zero, or_false] using hzero
  simp only [h₁zero, h₂zero, h₃zero, ite_false]
  rw [← hcycle h₂ h₃ 0, hthird]

open Classical in
theorem typeIIICompleteFiberSum_prime_degenerate_bounds
    (p : ℕ) [Fact p.Prime] (h₁ h₂ h₃ : ZMod p) (a : (ZMod p)ˣ)
    (hzero : h₁ * h₂ * h₃ = 0) :
    ‖typeIIICompleteFiberSum p h₁ h₂ h₃ a‖ ≤
        ((if h₁ = 0 then (p : ℝ) else 1) *
          (if h₂ = 0 then (p : ℝ) else 1) *
          (if h₃ = 0 then (p : ℝ) else 1)) / (p : ℝ) ^ 2 ∧
      ∀ (b u₁ u₂ u₃ : (ZMod p)ˣ),
        typeIIICompleteFiberSum p ((u₁ : ZMod p) * h₁)
          ((u₂ : ZMod p) * h₂) ((u₃ : ZMod p) * h₃) b =
            typeIIICompleteFiberSum p h₁ h₂ h₃ a := by
  have hp : (2 : ℝ) ≤ p := by exact_mod_cast (Fact.out : p.Prime).two_le
  have hp0 : 0 < (p : ℝ) := zero_lt_two.trans_le hp
  have hnorm : ‖(p : ℂ) - 1‖ = (p : ℝ) - 1 := by
    simpa using Complex.norm_of_nonneg (sub_nonneg.mpr (one_le_two.trans hp))
  constructor
  · rw [typeIIICompleteFiberSum_prime_degenerate_value p h₁ h₂ h₃ a hzero]
    by_cases h₁zero : h₁ = 0 <;> by_cases h₂zero : h₂ = 0 <;>
      by_cases h₃zero : h₃ = 0
    all_goals
      simp only [h₁zero, h₂zero, h₃zero, ite_true, ite_false,
        norm_mul, norm_inv, norm_neg, norm_one, hnorm, Complex.norm_natCast]
    all_goals
      try exact False.elim ((mul_ne_zero (mul_ne_zero h₁zero h₂zero) h₃zero) hzero)
    all_goals
      field_simp
      nlinarith
  · intro b u₁ u₂ u₃
    have hz : ((u₁ : ZMod p) * h₁) * ((u₂ : ZMod p) * h₂) *
        ((u₃ : ZMod p) * h₃) = 0 := by
      simpa only [mul_eq_zero, Units.ne_zero, false_or] using hzero
    rw [typeIIICompleteFiberSum_prime_degenerate_value p _ _ _ b hz,
      typeIIICompleteFiberSum_prime_degenerate_value p h₁ h₂ h₃ a hzero]
    simp only [Units.mul_right_eq_zero]

theorem typeIIICompleteFiberSum_coprime_crt
    (m n : ℕ) [NeZero m] [NeZero n] (hmn : m.Coprime n)
    (h₁ h₂ h₃ : ZMod (m * n)) (a : (ZMod (m * n))ˣ) :
    let e := ZMod.chineseRemainder hmn
    let aₘ : (ZMod m)ˣ :=
      Units.map (((RingHom.fst (ZMod m) (ZMod n)).comp e.toRingHom).toMonoidHom) a
    let aₙ : (ZMod n)ˣ :=
      Units.map (((RingHom.snd (ZMod m) (ZMod n)).comp e.toRingHom).toMonoidHom) a
    typeIIICompleteFiberSum (m * n) h₁ h₂ h₃ a =
      typeIIICompleteFiberSum m ((n : ZMod m)⁻¹ * (e h₁).1)
        ((n : ZMod m)⁻¹ * (e h₂).1) ((n : ZMod m)⁻¹ * (e h₃).1) aₘ *
      typeIIICompleteFiberSum n ((m : ZMod n)⁻¹ * (e h₁).2)
        ((m : ZMod n)⁻¹ * (e h₂).2) ((m : ZMod n)⁻¹ * (e h₃).2) aₙ := by
  intro e aₘ aₙ
  let f (u v w : ZMod m) : ℂ :=
    if u * v * w = (aₘ : ZMod m) then
      ZMod.stdAddChar ((n : ZMod m)⁻¹ *
        ((e h₁).1 * u + (e h₂).1 * v + (e h₃).1 * w)) else 0
  let g (u v w : ZMod n) : ℂ :=
    if u * v * w = (aₙ : ZMod n) then
      ZMod.stdAddChar ((m : ZMod n)⁻¹ *
        ((e h₁).2 * u + (e h₂).2 * v + (e h₃).2 * w)) else 0
  have hterm (u v w : ZMod (m * n)) :
      (if u * v * w = (a : ZMod (m * n)) then
        ZMod.stdAddChar (h₁ * u + h₂ * v + h₃ * w) else 0) =
      f (e u).1 (e v).1 (e w).1 * g (e u).2 (e v).2 (e w).2 := by
    have hmask : u * v * w = (a : ZMod (m * n)) ↔
        (e u).1 * (e v).1 * (e w).1 = (aₘ : ZMod m) ∧
          (e u).2 * (e v).2 * (e w).2 = (aₙ : ZMod n) := by
      rw [← e.injective.eq_iff]
      simp only [map_mul, Prod.ext_iff, Prod.fst_mul, Prod.snd_mul]
      rfl
    simp only [f, g, hmask]
    rw [stdAddChar_coprime_crt m n hmn]
    simp only [e, map_add, map_mul, Prod.fst_add, Prod.snd_add,
      Prod.fst_mul, Prod.snd_mul, ite_mul, mul_ite, zero_mul, mul_zero,
      ← ite_and, and_comm]
  have hsum :
      (∑ u : ZMod (m * n), ∑ v : ZMod (m * n), ∑ w : ZMod (m * n),
        if u * v * w = (a : ZMod (m * n)) then
          ZMod.stdAddChar (h₁ * u + h₂ * v + h₃ * w) else 0) =
      (∑ u : ZMod m, ∑ v : ZMod m, ∑ w : ZMod m, f u v w) *
        (∑ u : ZMod n, ∑ v : ZMod n, ∑ w : ZMod n, g u v w) := by
    simp_rw [hterm]
    calc
      _ = ∑ u : ZMod m × ZMod n, ∑ v : ZMod m × ZMod n,
          ∑ w : ZMod m × ZMod n, f u.1 v.1 w.1 * g u.2 v.2 w.2 := by
        simp_rw [← e.toEquiv.sum_comp]
        rfl
      _ = _ := by
        simp only [Fintype.sum_prod_type, ← Finset.mul_sum, ← Finset.sum_mul]
  unfold typeIIICompleteFiberSum
  rw [hsum, Nat.cast_mul, mul_inv_rev]
  simp only [f, g, mul_add, mul_assoc]
  ring

theorem typeIIICompleteFiberSum_squarefree_degenerate_bounds
    (q : ℕ) [NeZero q] (hq : Squarefree q) (h₁ h₂ h₃ : ℤ)
    (hzero : (q : ℤ) ∣ h₁ * h₂ * h₃) (a : (ZMod q)ˣ) :
    ‖typeIIICompleteFiberSum q (h₁ : ZMod q) (h₂ : ZMod q) (h₃ : ZMod q) a‖ ≤
        ((Int.gcd h₁ (q : ℤ) : ℝ) * (Int.gcd h₂ (q : ℤ) : ℝ) *
          (Int.gcd h₃ (q : ℤ) : ℝ)) / (q : ℝ) ^ 2 ∧
      ∀ (b u₁ u₂ u₃ : (ZMod q)ˣ),
        typeIIICompleteFiberSum q ((u₁ : ZMod q) * (h₁ : ZMod q))
          ((u₂ : ZMod q) * (h₂ : ZMod q)) ((u₃ : ZMod q) * (h₃ : ZMod q)) b =
            typeIIICompleteFiberSum q (h₁ : ZMod q) (h₂ : ZMod q) (h₃ : ZMod q) a := by
  let F (p : ℕ) : ℂ :=
    if hp : p.Prime then
      let _ : Fact p.Prime := ⟨hp⟩
      typeIIICompleteFiberSum p (h₁ : ZMod p) (h₂ : ZMod p) (h₃ : ZMod p) 1
    else 1
  have hzero_mod (n : ℕ) (hn : (n : ℤ) ∣ h₁ * h₂ * h₃) :
      (h₁ : ZMod n) * (h₂ : ZMod n) * (h₃ : ZMod n) = 0 := by
    simpa only [Int.cast_mul] using
      (ZMod.intCast_zmod_eq_zero_iff_dvd (h₁ * h₂ * h₃) n).2 hn
  have hprod : ∀ (n : ℕ) [NeZero n], Squarefree n →
      ((n : ℤ) ∣ h₁ * h₂ * h₃) →
      ∀ (b u₁ u₂ u₃ : (ZMod n)ˣ),
        typeIIICompleteFiberSum n ((u₁ : ZMod n) * (h₁ : ZMod n))
          ((u₂ : ZMod n) * (h₂ : ZMod n)) ((u₃ : ZMod n) * (h₃ : ZMod n)) b =
            ∏ p ∈ n.primeFactors, F p := by
    refine induction_on_primes ?_ ?_ ?_
    · intro hn
      exact (hn.out rfl).elim
    · intro _ _ _ b u₁ u₂ u₃
      have hz (z : ZMod 1) : z = 0 := Subsingleton.elim _ _
      simp [typeIIICompleteFiberSum, hz]
    · intro p n hp ih _ hsq hd b u₁ u₂ u₃
      let _ : Fact p.Prime := ⟨hp⟩
      let _ : NeZero n := ⟨hsq.of_mul_right.ne_zero⟩
      have hpn : p.Coprime n := Nat.coprime_of_squarefree_mul hsq
      have hd' : (p : ℤ) * (n : ℤ) ∣ h₁ * h₂ * h₃ := by
        simpa only [Nat.cast_mul] using hd
      let e := ZMod.chineseRemainder hpn
      let fp : ZMod (p * n) →+* ZMod p :=
        (RingHom.fst (ZMod p) (ZMod n)).comp e.toRingHom
      let fn : ZMod (p * n) →+* ZMod n :=
        (RingHom.snd (ZMod p) (ZMod n)).comp e.toRingHom
      let vp (u : (ZMod (p * n))ˣ) : (ZMod p)ˣ :=
        (ZMod.unitOfCoprime n hpn.symm)⁻¹ * Units.map fp.toMonoidHom u
      let vn (u : (ZMod (p * n))ˣ) : (ZMod n)ˣ :=
        (ZMod.unitOfCoprime p hpn)⁻¹ * Units.map fn.toMonoidHom u
      have hpval :=
        (typeIIICompleteFiberSum_prime_degenerate_bounds p
          (h₁ : ZMod p) (h₂ : ZMod p) (h₃ : ZMod p) 1
          (hzero_mod p ((dvd_mul_right (p : ℤ) (n : ℤ)).trans hd'))).2
          (Units.map fp.toMonoidHom b) (vp u₁) (vp u₂) (vp u₃)
      have hnval := ih hsq.of_mul_right
        ((dvd_mul_left (n : ℤ) (p : ℤ)).trans hd')
        (Units.map fn.toMonoidHom b) (vn u₁) (vn u₂) (vn u₃)
      have hcrt := typeIIICompleteFiberSum_coprime_crt p n hpn
        ((u₁ : ZMod (p * n)) * (h₁ : ZMod (p * n)))
        ((u₂ : ZMod (p * n)) * (h₂ : ZMod (p * n)))
        ((u₃ : ZMod (p * n)) * (h₃ : ZMod (p * n))) b
      have hvalues := congrArg₂ (· * ·) hpval hnval
      simp only [vp, vn, Units.val_mul, Units.coe_map, mul_assoc] at hvalues
      dsimp only [fp, fn, e] at hvalues
      simp only [map_mul, map_intCast, Prod.fst_mul, Prod.snd_mul,
        Prod.fst_intCast, Prod.snd_intCast] at hcrt
      rw [hpn.primeFactors_mul, Finset.prod_union hpn.disjoint_primeFactors,
        hp.primeFactors, Finset.prod_singleton]
      simpa only [F, dite_eq_left hp] using! hcrt.trans hvalues
  have hbase :
      typeIIICompleteFiberSum q (h₁ : ZMod q) (h₂ : ZMod q) (h₃ : ZMod q) a =
        ∏ p ∈ q.primeFactors, F p := by
    simpa only [Units.val_one, one_mul] using hprod q hq hzero a 1 1 1
  have hbound (p : ℕ) (hp : p ∈ q.primeFactors) :
      ‖F p‖ ≤
        ((if (p : ℤ) ∣ h₁ then (p : ℝ) else 1) *
          (if (p : ℤ) ∣ h₂ then (p : ℝ) else 1) *
          (if (p : ℤ) ∣ h₃ then (p : ℝ) else 1)) / (p : ℝ) ^ 2 := by
    have hp' := Nat.prime_of_mem_primeFactors hp
    let _ : Fact p.Prime := ⟨hp'⟩
    simpa only [F, dite_eq_left hp', ZMod.intCast_zmod_eq_zero_iff_dvd] using
      (typeIIICompleteFiberSum_prime_degenerate_bounds p
        (h₁ : ZMod p) (h₂ : ZMod p) (h₃ : ZMod p) 1
        (hzero_mod p ((Int.natCast_dvd_natCast.mpr
          (Nat.dvd_of_mem_primeFactors hp)).trans hzero))).1
  constructor
  · rw [hbase, norm_prod]
    calc
      _ ≤ _ := Finset.prod_le_prod (fun p _ => norm_nonneg (F p)) hbound
      _ = _ := by
        rw [Finset.prod_div_distrib, Finset.prod_mul_distrib,
          Finset.prod_mul_distrib, Finset.prod_pow,
          prod_primeFactors_gcd q hq h₁, prod_primeFactors_gcd q hq h₂,
          prod_primeFactors_gcd q hq h₃, ← Nat.cast_prod,
          Nat.prod_primeFactors_of_squarefree hq]
  · intro b u₁ u₂ u₃
    exact (hprod q hq hzero b u₁ u₂ u₃).trans hbase.symm

open Classical in
theorem typeIII_mixed_reciprocal_compactProfile_norm_le_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (s r₁ r₂ : ℕ) (hs : Squarefree s)
    (h₁ : Squarefree r₁) (h₂ : Squarefree r₂)
    (hcop : Nat.Coprime s (r₁ * r₂)) (A m₁ m₂ : ℤ)
    (hA : IsUnit (A : ZMod (s * Nat.lcm r₁ r₂)))
    (hm₁ : IsUnit (m₁ : ZMod (r₁ * s)))
    (hm₂ : IsUnit (m₂ : ZMod (r₂ * s)))
    (T Lw H : ℝ) (hT : 0 ≤ T) (hLw : 0 ≤ Lw) (hH : 0 < H)
    (ψ : ℝ → ℂ) (hψ : ContDiff ℝ 2 ψ)
    (hsupport : Function.support ψ ⊆ Set.Icc (-T) T)
    (hbound : ∀ t : ℝ,
      ‖ψ t‖ ≤ Lw ∧ ‖deriv ψ t‖ ≤ Lw ∧ ‖deriv (deriv ψ) t‖ ≤ Lw) :
    let q := s * Nat.lcm r₁ r₂
    let d := Nat.gcd r₁ r₂
    let u₁ := r₁ / d
    let u₂ := r₂ / d
    letI : NeZero (r₁ * s) := ⟨mul_ne_zero h₁.ne_zero hs.ne_zero⟩
    letI : NeZero (r₂ * s) := ⟨mul_ne_zero h₂.ne_zero hs.ne_zero⟩
    ‖∑ ℓ ∈ Finset.Icc (Int.ceil (-T * H)) (Int.floor (T * H)),
      if IsUnit (ℓ : ZMod q) then
        ψ ((ℓ : ℝ) / H) *
          normalizedKloosterman3Mod (r₁ * s)
            (((A : ZMod (r₁ * s)) * (m₁ : ZMod (r₁ * s))⁻¹) *
              (ℓ : ZMod (r₁ * s))) *
          star (normalizedKloosterman3Mod (r₂ * s)
            (((A : ZMod (r₂ * s)) * (m₂ : ZMod (r₂ * s))⁻¹) *
              (ℓ : ZMod (r₂ * s)))) else 0‖ ≤
      (6 * (2 * T + 3)) * Lw * (1 + H / (q : ℝ)) *
        (9 : ℝ) ^ q.primeFactors.card * Real.sqrt (q : ℝ) *
        (Real.sqrt (Int.gcd ((u₁ : ℤ) ^ 3 * m₁ - (u₂ : ℤ) ^ 3 * m₂)
            (d : ℤ) : ℝ) *
          Real.sqrt (Int.gcd ((r₁ : ℤ) ^ 3 * m₁ - (r₂ : ℤ) ^ 3 * m₂)
            (s : ℤ) : ℝ)) := by
  have hpairing (n : ℕ) [NeZero n] (F W : ZMod n → ℂ) (K : ℝ)
      (hF : ∀ k : ZMod n,
        ‖∑ x : ZMod n, F x * ZMod.stdAddChar (k * x)‖ ≤ K) :
      ‖∑ x : ZMod n, W x * F x‖ ≤
        ((1 / (n : ℝ)) * ∑ k : ZMod n, ‖ZMod.dft W k‖) * K := by
    rw [full_weighted_sum_dft, norm_mul, norm_inv, Complex.norm_natCast]
    calc
      _ ≤ (n : ℝ)⁻¹ * ∑ k : ZMod n, ‖ZMod.dft W k‖ * K := by
        apply mul_le_mul_of_nonneg_left _ (inv_nonneg.mpr (Nat.cast_nonneg n))
        refine norm_sum_le_of_le _ fun k _ => ?_
        rw [norm_mul]
        apply mul_le_mul_of_nonneg_left _ (norm_nonneg _)
        simpa [ZMod.dft_apply, smul_eq_mul, mul_comm] using hF k
      _ = _ := by rw [← Finset.sum_mul]; simp only [one_div, mul_assoc]
  have hcompletion (n : ℕ) [NeZero n] (f : ZMod n → ℂ) (K : ℝ) (hK : 0 ≤ K)
      (hf : ∀ k : ZMod n,
        ‖∑ x : (ZMod n)ˣ, f (x : ZMod n) *
          ZMod.stdAddChar (k * (x : ZMod n))‖ ≤ K) :
      ‖∑ ℓ ∈ Finset.Icc (Int.ceil (-T * H)) (Int.floor (T * H)),
        if IsUnit (ℓ : ZMod n) then ψ ((ℓ : ℝ) / H) * f (ℓ : ZMod n)
        else 0‖ ≤ (6 * (2 * T + 3)) * Lw * (1 + H / (n : ℝ)) * K := by
    let F : ZMod n → ℂ := fun x => if IsUnit x then f x else 0
    have hF (k : ZMod n) :
        ‖∑ x : ZMod n, F x * ZMod.stdAddChar (k * x)‖ ≤ K := by
      have hsum :
          (∑ x : (ZMod n)ˣ, f (x : ZMod n) *
            ZMod.stdAddChar (k * (x : ZMod n))) =
          ∑ x : ZMod n, F x * ZMod.stdAddChar (k * x) := by
        refine Fintype.sum_of_injective
          (fun x : (ZMod n)ˣ => (x : ZMod n)) Units.val_injective
          (fun x : (ZMod n)ˣ => f (x : ZMod n) *
            ZMod.stdAddChar (k * (x : ZMod n)))
          (fun x : ZMod n => F x * ZMod.stdAddChar (k * x)) ?_ ?_
        · intro x hx
          have hx' : ¬ IsUnit x := hx
          simp only [F, ite_eq_right hx', zero_mul]
        · intro x
          simp only [F, ite_eq_left x.isUnit]
      calc
        _ = ‖∑ x : (ZMod n)ˣ, f (x : ZMod n) *
            ZMod.stdAddChar (k * (x : ZMod n))‖ := congrArg norm hsum.symm
        _ ≤ K := hf k
    let lo : ℤ := Int.ceil (-T * H)
    let hi : ℤ := Int.floor (T * H)
    let N : ℕ := (hi + 1 - lo).toNat
    let w : ℕ → ℂ := fun j => ψ (((lo : ℝ) + (j : ℝ)) / H)
    let W : ZMod n → ℂ := integerIntervalResidueWeight n lo N w
    have hl1 : (1 / (n : ℝ)) * ∑ k : ZMod n, ‖ZMod.dft W k‖ ≤
        (6 * (2 * T + 3)) * Lw * (1 + H / (n : ℝ)) := by
      simpa only [W, N, lo, hi, w, zero_sub, zero_add, sub_zero, neg_mul] using
        (compactProfile_fourier_l1_bound_logfree n T Lw H 0
          hT hLw hH ψ hψ hsupport hbound).2
    have hperiod :
        (∑ x : ZMod n, W x * F x) =
          ∑ ℓ ∈ Finset.Icc lo hi,
            if IsUnit (ℓ : ZMod n) then ψ ((ℓ : ℝ) / H) * f (ℓ : ZMod n)
            else 0 := by
      change (∑ x : ZMod n, integerIntervalResidueWeight n lo N w x * F x) = _
      rw [(integerIntervalResidueWeight_spec n lo N w).1 F,
        Int.Icc_eq_finset_map, Finset.sum_map]
      apply Finset.sum_congr rfl
      intro j _
      simp only [Function.Embedding.trans_apply, Nat.castEmbedding_apply,
        addLeftEmbedding_apply, w, F, Int.cast_add, Int.cast_natCast]
      split_ifs <;> simp only [mul_zero]
    have hbound' :
        ‖∑ x : ZMod n, W x * F x‖ ≤
          (6 * (2 * T + 3)) * Lw * (1 + H / (n : ℝ)) * K :=
      (hpairing n F W K hF).trans (mul_le_mul_of_nonneg_right hl1 hK)
    rw [hperiod] at hbound'
    exact hbound'
  let q := s * Nat.lcm r₁ r₂
  let d := Nat.gcd r₁ r₂
  let u₁ := r₁ / d
  let u₂ := r₂ / d
  let : NeZero (r₁ * s) := ⟨mul_ne_zero h₁.ne_zero hs.ne_zero⟩
  let : NeZero (r₂ * s) := ⟨mul_ne_zero h₂.ne_zero hs.ne_zero⟩
  let : NeZero q :=
    ⟨mul_ne_zero hs.ne_zero (Nat.lcm_ne_zero h₁.ne_zero h₂.ne_zero)⟩
  let G : ℝ := (9 : ℝ) ^ q.primeFactors.card * Real.sqrt (q : ℝ) *
    (Real.sqrt (Int.gcd ((u₁ : ℤ) ^ 3 * m₁ - (u₂ : ℤ) ^ 3 * m₂)
      (d : ℤ) : ℝ) *
    Real.sqrt (Int.gcd ((r₁ : ℤ) ^ 3 * m₁ - (r₂ : ℤ) ^ 3 * m₂)
      (s : ℤ) : ℝ))
  have hG : 0 ≤ G := by dsimp only [G]; positivity
  let C : ℝ := (6 * (2 * T + 3)) * Lw * (1 + H / (q : ℝ))
  let S : ℂ := ∑ ℓ ∈ Finset.Icc (Int.ceil (-T * H)) (Int.floor (T * H)),
    if IsUnit (ℓ : ZMod q) then
      ψ ((ℓ : ℝ) / H) *
        normalizedKloosterman3Mod (r₁ * s)
          (((A : ZMod (r₁ * s)) * (m₁ : ZMod (r₁ * s))⁻¹) *
            (ℓ : ZMod (r₁ * s))) *
        star (normalizedKloosterman3Mod (r₂ * s)
          (((A : ZMod (r₂ * s)) * (m₂ : ZMod (r₂ * s))⁻¹) *
            (ℓ : ZMod (r₂ * s)))) else 0
  suffices hmain : ‖S‖ ≤ C * G by
    simpa only [S, C, G, q, d, u₁, u₂, mul_assoc] using hmain
  have hq₁ : r₁ * s ∣ q := by
    simpa [q, Nat.mul_comm] using
      mul_dvd_mul (Nat.dvd_lcm_left r₁ r₂) (dvd_refl s)
  have hq₂ : r₂ * s ∣ q := by
    simpa [q, Nat.mul_comm] using
      mul_dvd_mul (Nat.dvd_lcm_right r₁ r₂) (dvd_refl s)
  have hA₁ := isUnit_intCast_of_dvd (r₁ * s) q hq₁ A hA
  have hA₂ := isUnit_intCast_of_dvd (r₂ * s) q hq₂ A hA
  obtain ⟨a₁, ha₁⟩ := ZMod.intCast_surjective
    ((A : ZMod (r₁ * s)) * (m₁ : ZMod (r₁ * s))⁻¹)
  obtain ⟨a₂, ha₂⟩ := ZMod.intCast_surjective
    ((A : ZMod (r₂ * s)) * (m₂ : ZMod (r₂ * s))⁻¹)
  have ha₁unit : IsUnit (a₁ : ZMod (r₁ * s)) := by
    rw [ha₁]
    exact hA₁.mul (ZMod.isUnit_inv hm₁)
  have ha₂unit : IsUnit (a₂ : ZMod (r₂ * s)) := by
    rw [ha₂]
    exact hA₂.mul (ZMod.isUnit_inv hm₂)
  have ha₁mul : (a₁ : ZMod (r₁ * s)) * (m₁ : ZMod (r₁ * s)) =
      (A : ZMod (r₁ * s)) := by
    rw [ha₁, mul_assoc, ZMod.inv_mul_of_unit _ hm₁, mul_one]
  have ha₂mul : (a₂ : ZMod (r₂ * s)) * (m₂ : ZMod (r₂ * s)) =
      (A : ZMod (r₂ * s)) := by
    rw [ha₂, mul_assoc, ZMod.inv_mul_of_unit _ hm₂, mul_one]
  have hgcd_congr (D : ℕ) (z w : ℤ)
      (hzw : (z : ZMod D) = (w : ZMod D)) :
      Int.gcd z (D : ℤ) = Int.gcd w (D : ℤ) := by
    have hmod := (ZMod.intCast_eq_intCast_iff' z w D).mp hzw
    simpa only [Int.gcd_emod] using
      congrArg (fun t : ℤ => Int.gcd t (D : ℤ)) hmod
  have hgcd_cancel (D : ℕ) (v z : ℤ) (hv : IsUnit (v : ZMod D)) :
      Int.gcd (v * z) (D : ℤ) = Int.gcd z (D : ℤ) := by
    have hv' : Int.gcd v (D : ℤ) = 1 :=
      Int.isCoprime_iff_gcd_eq_one.mp
        ((ZMod.coe_int_isUnit_iff_isCoprime v D).mp hv).symm
    exact Int.gcd_mul_right_left_of_gcd_eq_one hv'
  have hcoeff (D : ℕ) (hD₁ : D ∣ r₁ * s) (hD₂ : D ∣ r₂ * s)
      (v₁ v₂ : ℤ) :
      Int.gcd (a₂ * v₁ - a₁ * v₂) (D : ℤ) =
        Int.gcd (v₁ * m₁ - v₂ * m₂) (D : ℤ) := by
    have ha₁D : (a₁ : ZMod D) * (m₁ : ZMod D) = (A : ZMod D) := by
      simpa only [map_mul, map_intCast] using
        congrArg (ZMod.castHom hD₁ (ZMod D)) ha₁mul
    have ha₂D : (a₂ : ZMod D) * (m₂ : ZMod D) = (A : ZMod D) := by
      simpa only [map_mul, map_intCast] using
        congrArg (ZMod.castHom hD₂ (ZMod D)) ha₂mul
    have hmD : IsUnit ((m₁ * m₂ : ℤ) : ZMod D) := by
      simpa only [Int.cast_mul] using
        (isUnit_intCast_of_dvd D (r₁ * s) hD₁ m₁ hm₁).mul
          (isUnit_intCast_of_dvd D (r₂ * s) hD₂ m₂ hm₂)
    have hAD : IsUnit (A : ZMod D) :=
      isUnit_intCast_of_dvd D q (dvd_trans hD₁ hq₁) A hA
    have hcong :
        (((m₁ * m₂) * (a₂ * v₁ - a₁ * v₂) : ℤ) : ZMod D) =
          ((A * (v₁ * m₁ - v₂ * m₂) : ℤ) : ZMod D) := by
      push_cast
      calc
        _ = ((a₂ : ZMod D) * (m₂ : ZMod D)) *
              ((v₁ : ZMod D) * (m₁ : ZMod D)) -
            ((a₁ : ZMod D) * (m₁ : ZMod D)) *
              ((v₂ : ZMod D) * (m₂ : ZMod D)) := by ring
        _ = _ := by rw [ha₁D, ha₂D]; ring
    calc
      _ = Int.gcd ((m₁ * m₂) * (a₂ * v₁ - a₁ * v₂)) (D : ℤ) :=
        (hgcd_cancel D (m₁ * m₂) (a₂ * v₁ - a₁ * v₂) hmD).symm
      _ = Int.gcd (A * (v₁ * m₁ - v₂ * m₂)) (D : ℤ) :=
        hgcd_congr D _ _ hcong
      _ = _ := hgcd_cancel D A (v₁ * m₁ - v₂ * m₂) hAD
  have hd₁ : d ∣ r₁ * s :=
    dvd_trans (Nat.gcd_dvd_left r₁ r₂) ⟨s, rfl⟩
  have hd₂ : d ∣ r₂ * s :=
    dvd_trans (Nat.gcd_dvd_right r₁ r₂) ⟨s, rfl⟩
  have hs₁ : s ∣ r₁ * s := ⟨r₁, Nat.mul_comm r₁ s⟩
  have hs₂ : s ∣ r₂ * s := ⟨r₂, Nat.mul_comm r₂ s⟩
  have hgd := hcoeff d hd₁ hd₂ ((u₁ : ℤ) ^ 3) ((u₂ : ℤ) ^ 3)
  have hgs := hcoeff s hs₁ hs₂ ((r₁ : ℤ) ^ 3) ((r₂ : ℤ) ^ 3)
  let f : ZMod q → ℂ := fun x =>
    normalizedKloosterman3Mod (r₁ * s)
        ((a₁ : ZMod (r₁ * s)) * (x.val : ZMod (r₁ * s))) *
      star (normalizedKloosterman3Mod (r₂ * s)
        ((a₂ : ZMod (r₂ * s)) * (x.val : ZMod (r₂ * s))))
  have hGcoeff :
      (9 : ℝ) ^ q.primeFactors.card * Real.sqrt (q : ℝ) *
        (Real.sqrt (Int.gcd (a₂ * (u₁ : ℤ) ^ 3 - a₁ * (u₂ : ℤ) ^ 3)
          (d : ℤ) : ℝ) *
        Real.sqrt (Int.gcd (a₂ * (r₁ : ℤ) ^ 3 - a₁ * (r₂ : ℤ) ^ 3)
          (s : ℤ) : ℝ)) = G := by
    dsimp only [G]
    rw [hgd, hgs]
  have hdonor (k : ZMod q) :
      ‖∑ x : (ZMod q)ˣ, f (x : ZMod q) *
        ZMod.stdAddChar (k * (x : ZMod q))‖ ≤ G := by
    calc
      _ ≤ (9 : ℝ) ^ q.primeFactors.card * Real.sqrt (q : ℝ) *
          (Real.sqrt (Int.gcd (a₂ * (u₁ : ℤ) ^ 3 - a₁ * (u₂ : ℤ) ^ 3)
            (d : ℤ) : ℝ) *
          Real.sqrt (Int.gcd (a₂ * (r₁ : ℤ) ^ 3 - a₁ * (r₂ : ℤ) ^ 3)
            (s : ℤ) : ℝ)) :=
        normalizedKloosterman3Mod_mixed_unit_fourier_norm_le_of_deligne
          hDeligne s r₁ r₂ hs h₁ h₂ hcop a₁ a₂ ha₁unit ha₂unit k
      _ = G := hGcoeff
  have hflift (ℓ : ℤ) :
      f (ℓ : ZMod q) =
        normalizedKloosterman3Mod (r₁ * s)
            (((A : ZMod (r₁ * s)) * (m₁ : ZMod (r₁ * s))⁻¹) *
              (ℓ : ZMod (r₁ * s))) *
          star (normalizedKloosterman3Mod (r₂ * s)
            (((A : ZMod (r₂ * s)) * (m₂ : ZMod (r₂ * s))⁻¹) *
              (ℓ : ZMod (r₂ * s)))) := by
    simp only [f, ha₁, ha₂, ZMod.natCast_val,
      ZMod.cast_intCast hq₁, ZMod.cast_intCast hq₂]
  have hS :
      S = ∑ ℓ ∈ Finset.Icc (Int.ceil (-T * H)) (Int.floor (T * H)),
        if IsUnit (ℓ : ZMod q) then ψ ((ℓ : ℝ) / H) * f (ℓ : ZMod q)
        else 0 := by
    dsimp only [S]
    apply Finset.sum_congr rfl
    intro ℓ _
    split_ifs
    · rw [hflift ℓ]
      simp only [mul_assoc]
    · rfl
  calc
    ‖S‖ = ‖∑ ℓ ∈ Finset.Icc (Int.ceil (-T * H)) (Int.floor (T * H)),
        if IsUnit (ℓ : ZMod q) then ψ ((ℓ : ℝ) / H) * f (ℓ : ZMod q)
        else 0‖ := congrArg norm hS
    _ ≤ C * G := hcompletion q f G hG hdonor

open Classical in
theorem typeIII_offDiagonal_cubic_gcd_average
    (r₁ r₂ K : ℕ) (h₁ : Squarefree r₁) (h₂ : Squarefree r₂)
    (M₀ M₁ N₀ N₁ : ℤ) (w : ℤ → ℤ → ℕ → ℂ)
    (W : ℝ) (hW : 0 ≤ W)
    (hw : ∀ m ∈ Finset.Icc M₀ M₁, ∀ n ∈ Finset.Icc N₀ N₁,
      ∀ s ∈ Finset.Icc 1 K, ‖w m n s‖ ≤ W) :
    let I := Finset.Icc M₀ M₁
    let J := Finset.Icc N₀ N₁
    let d := Nat.gcd r₁ r₂
    let u₁ := r₁ / d
    let u₂ := r₂ / d
    let τΔ := (I ×ˢ J).sup (fun mn : ℤ × ℤ =>
      (((r₁ : ℤ) ^ 3 * mn.1 - (r₂ : ℤ) ^ 3 * mn.2).natAbs).divisors.card)
    (∑ m ∈ I, ∑ n ∈ J,
      if (r₁ : ℤ) ^ 3 * m - (r₂ : ℤ) ^ 3 * n ≠ 0 then
        ∑ s ∈ Finset.Icc 1 K,
          ‖w m n s‖ *
            Real.sqrt (Int.gcd ((u₁ : ℤ) ^ 3 * m - (u₂ : ℤ) ^ 3 * n)
              (d : ℤ) : ℝ) *
            Real.sqrt (Int.gcd ((r₁ : ℤ) ^ 3 * m - (r₂ : ℤ) ^ 3 * n)
              (s : ℤ) : ℝ)
      else 0) ≤
      W * (K : ℝ) * (τΔ : ℝ) * (d.divisors.card : ℝ) *
        ((I.card : ℝ) * (J.card : ℝ) + (J.card : ℝ) * Real.sqrt (d : ℝ)) := by
  intro I J d u₁ u₂ τΔ
  let Δ (m n : ℤ) : ℤ := (r₁ : ℤ) ^ 3 * m - (r₂ : ℤ) ^ 3 * n
  let g (m n : ℤ) : ℝ :=
    Real.sqrt (Int.gcd ((u₁ : ℤ) ^ 3 * m - (u₂ : ℤ) ^ 3 * n) (d : ℤ) : ℝ)
  have hg (m n : ℤ) : 0 ≤ g m n := Real.sqrt_nonneg _
  have hcoeff : 0 ≤ W * (K : ℝ) * (τΔ : ℝ) := by positivity
  have hsqrt_sum (z : ℤ) (hz : z ≠ 0) :
      (∑ s ∈ Finset.Icc 1 K, Real.sqrt (Int.gcd z (s : ℤ) : ℝ)) ≤
        (K : ℝ) * (z.natAbs.divisors.card : ℝ) := by
    calc
      _ ≤ ∑ s ∈ Finset.Icc 1 K, (Int.gcd z (s : ℤ) : ℝ) := by
        apply Finset.sum_le_sum
        intro s _
        exact Real.sqrt_le_self_iff.mpr
          (Or.inr (Nat.one_le_cast.mpr (Int.gcd_pos_of_ne_zero_left (s : ℤ) hz)))
      _ ≤ _ := by
        simpa only [Int.gcd_def, Int.natAbs_natCast] using
          (reciprocal_differencing_gcd_sums z.natAbs K (Int.natAbs_pos.mpr hz)).1
  have hpair (m : ℤ) (hm : m ∈ I) (n : ℤ) (hn : n ∈ J) :
      (if Δ m n ≠ 0 then
        ∑ s ∈ Finset.Icc 1 K,
          ‖w m n s‖ * g m n * Real.sqrt (Int.gcd (Δ m n) (s : ℤ) : ℝ)
      else 0) ≤ W * (K : ℝ) * (τΔ : ℝ) * g m n := by
    by_cases hΔ : Δ m n ≠ 0
    · rw [ite_eq_left hΔ]
      have hτ : (Δ m n).natAbs.divisors.card ≤ τΔ :=
        Finset.le_sup
          (f := fun mn : ℤ × ℤ => (Δ mn.1 mn.2).natAbs.divisors.card)
          (Finset.mk_mem_product hm hn)
      have hs :
          (∑ s ∈ Finset.Icc 1 K, Real.sqrt (Int.gcd (Δ m n) (s : ℤ) : ℝ)) ≤
            (K : ℝ) * (τΔ : ℝ) :=
        (hsqrt_sum (Δ m n) hΔ).trans
          (mul_le_mul_of_nonneg_left (Nat.cast_le.mpr hτ) (Nat.cast_nonneg K))
      calc
        _ ≤ ∑ s ∈ Finset.Icc 1 K,
            W * g m n * Real.sqrt (Int.gcd (Δ m n) (s : ℤ) : ℝ) := by
          apply Finset.sum_le_sum
          intro s hs
          exact mul_le_mul_of_nonneg_right
            (mul_le_mul_of_nonneg_right (hw m hm n hn s hs) (hg m n))
            (Real.sqrt_nonneg _)
        _ = W * g m n *
            (∑ s ∈ Finset.Icc 1 K, Real.sqrt (Int.gcd (Δ m n) (s : ℤ) : ℝ)) := by
          rw [Finset.mul_sum]
        _ ≤ W * g m n * ((K : ℝ) * (τΔ : ℝ)) :=
          mul_le_mul_of_nonneg_left hs (mul_nonneg hW (hg m n))
        _ = _ := by ring
    · rw [ite_eq_right hΔ]
      exact mul_nonneg hcoeff (hg m n)
  have hd : 1 ≤ d := Nat.gcd_pos_of_pos_left r₂ h₁.ne_zero.bot_lt
  have hcop : Nat.Coprime (u₁ ^ 3) d :=
    ((Nat.coprime_div_gcd_of_squarefree h₁ h₂.ne_zero).of_dvd_right
      (Nat.gcd_dvd_right r₁ r₂)).pow_left 3
  have havg :
      (∑ m ∈ I, ∑ n ∈ J, g m n) ≤
        (d.divisors.card : ℝ) *
          ((I.card : ℝ) * (J.card : ℝ) + (J.card : ℝ) * Real.sqrt (d : ℝ)) := by
    have h := corrected_common_prime_diagonal_interval_average
      d (u₁ ^ 3) (u₂ ^ 3) hd hcop M₀ M₁ N₀ N₁
    change (∑ m ∈ I, ∑ n ∈ J,
      Real.sqrt (Int.gcd (((u₁ ^ 3 : ℕ) : ℤ) * m -
        ((u₂ ^ 3 : ℕ) : ℤ) * n) (d : ℤ) : ℝ)) ≤ _ at h
    rw [Nat.cast_pow, Nat.cast_pow] at h
    exact h
  change (∑ m ∈ I, ∑ n ∈ J,
    if Δ m n ≠ 0 then
      ∑ s ∈ Finset.Icc 1 K,
        ‖w m n s‖ * g m n * Real.sqrt (Int.gcd (Δ m n) (s : ℤ) : ℝ)
    else 0) ≤ _
  calc
    _ ≤ ∑ m ∈ I, ∑ n ∈ J, W * (K : ℝ) * (τΔ : ℝ) * g m n :=
      Finset.sum_le_sum (fun m hm => Finset.sum_le_sum (fun n hn => hpair m hm n hn))
    _ = (W * (K : ℝ) * (τΔ : ℝ)) * (∑ m ∈ I, ∑ n ∈ J, g m n) := by
      simp only [Finset.mul_sum]
    _ ≤ (W * (K : ℝ) * (τΔ : ℝ)) *
        ((d.divisors.card : ℝ) *
          ((I.card : ℝ) * (J.card : ℝ) + (J.card : ℝ) * Real.sqrt (d : ℝ))) :=
      mul_le_mul_of_nonneg_left havg hcoeff
    _ = _ := by ring

open Classical in
theorem typeIII_comparable_lcm_kernel_bound
    (R : ℕ) (hR : 0 < R) (M H Q b : ℝ)
    (hM : 0 ≤ M) (hH : 0 ≤ H) (hQ : 0 < Q) (hb : 0 < b) :
    let I := Finset.Ico R (4 * R)
    let τR := I.sup (fun r : ℕ => r.divisors.card)
    (∑ r₁ ∈ I, ∑ r₂ ∈ I,
      ((M ^ 2 + M * Real.sqrt (Nat.gcd r₁ r₂ : ℝ)) / (r₁ : ℝ) ^ 2) *
        (H * Real.sqrt (b * (r₁ : ℝ)) /
            Real.sqrt (Q * (Nat.lcm r₁ r₂ : ℝ)) +
          Real.sqrt (Q * (Nat.lcm r₁ r₂ : ℝ)) /
            Real.sqrt (b * (r₁ : ℝ)))) ≤
      (M ^ 2 + M) *
        (12 * (τR : ℝ) * H * Real.sqrt b /
            (Real.sqrt Q * Real.sqrt (R : ℝ)) +
          18 * Real.sqrt Q * Real.sqrt (R : ℝ) / Real.sqrt b) := by
  intro I τR
  have hRreal : 0 < (R : ℝ) := Nat.cast_pos.mpr hR
  have hsR : 0 < Real.sqrt (R : ℝ) := Real.sqrt_pos.2 hRreal
  have hsQ : 0 < Real.sqrt Q := Real.sqrt_pos.2 hQ
  have hsb : 0 < Real.sqrt b := Real.sqrt_pos.2 hb
  have hcard : I.card = 3 * R := by
    dsimp only [I]
    rw [Nat.card_Ico]
    omega
  have hmem (r : ℕ) (hr : r ∈ I) :
      0 < r ∧ (R : ℝ) ≤ r ∧ (r : ℝ) ≤ 4 * R := by
    obtain ⟨hr₀, hr₁⟩ := Finset.mem_Ico.mp hr
    refine ⟨hR.trans_le hr₀, ?_, ?_⟩
    · exact_mod_cast hr₀
    · exact_mod_cast hr₁.le
  have hgcdsum : (∑ r₁ ∈ I, ∑ r₂ ∈ I, (Nat.gcd r₁ r₂ : ℝ)) ≤
      12 * (R : ℝ) ^ 2 * τR := by
    calc
      _ ≤ ∑ _r₁ ∈ I, (4 * R : ℝ) * τR := by
        apply Finset.sum_le_sum
        intro r₁ hr₁
        calc
          _ ≤ ∑ r₂ ∈ Finset.Icc 1 (4 * R), (Nat.gcd r₁ r₂ : ℝ) := by
            apply Finset.sum_le_sum_of_subset_of_nonneg
            · intro r₂ hr₂
              obtain ⟨hr₂₀, hr₂₁⟩ := Finset.mem_Ico.mp hr₂
              exact Finset.mem_Icc.mpr ⟨hR.trans_le hr₂₀, hr₂₁.le⟩
            · intro r₂ _ _
              exact Nat.cast_nonneg _
          _ ≤ (4 * R : ℕ) * (r₁.divisors.card : ℝ) :=
            (reciprocal_differencing_gcd_sums r₁ (4 * R) (hmem r₁ hr₁).1).1
          _ ≤ (4 * R : ℝ) * τR := by
            have hτ : (r₁.divisors.card : ℝ) ≤ τR := by
              exact_mod_cast (Finset.le_sup (f := fun r : ℕ => r.divisors.card) hr₁ :
                r₁.divisors.card ≤ τR)
            push_cast
            exact mul_le_mul_of_nonneg_left hτ (by positivity)
      _ = _ := by
        simp only [Finset.sum_const, nsmul_eq_mul, hcard, Nat.cast_mul, Nat.cast_ofNat]
        ring
  let U : ℝ := (M ^ 2 + M) * H * Real.sqrt b /
    ((R : ℝ) ^ 2 * Real.sqrt Q * Real.sqrt (R : ℝ))
  let V : ℝ := 2 * (M ^ 2 + M) * Real.sqrt Q * Real.sqrt (R : ℝ) /
    ((R : ℝ) ^ 2 * Real.sqrt b)
  have hU : 0 ≤ U := by dsimp only [U]; positivity
  have hpoint (r₁ : ℕ) (hr₁ : r₁ ∈ I) (r₂ : ℕ) (hr₂ : r₂ ∈ I) :
      ((M ^ 2 + M * Real.sqrt (Nat.gcd r₁ r₂ : ℝ)) / (r₁ : ℝ) ^ 2) *
        (H * Real.sqrt (b * (r₁ : ℝ)) /
            Real.sqrt (Q * (Nat.lcm r₁ r₂ : ℝ)) +
          Real.sqrt (Q * (Nat.lcm r₁ r₂ : ℝ)) /
            Real.sqrt (b * (r₁ : ℝ))) ≤
      U * (Nat.gcd r₁ r₂ : ℝ) + V := by
    obtain ⟨hr₁pos, hR₁, _⟩ := hmem r₁ hr₁
    obtain ⟨hr₂pos, hR₂, hr₂upper⟩ := hmem r₂ hr₂
    have ha : 0 < (r₁ : ℝ) := by exact_mod_cast hr₁pos
    have hc : 0 < (r₂ : ℝ) := by exact_mod_cast hr₂pos
    have hg : 0 < (Nat.gcd r₁ r₂ : ℝ) := by
      exact_mod_cast Nat.gcd_pos_of_pos_left r₂ hr₁pos
    have hl : 0 < (Nat.lcm r₁ r₂ : ℝ) := by
      exact_mod_cast Nat.lcm_pos hr₁pos hr₂pos
    have hsc : 0 < Real.sqrt (r₂ : ℝ) := Real.sqrt_pos.2 hc
    have hsl : 0 < Real.sqrt (Nat.lcm r₁ r₂ : ℝ) := Real.sqrt_pos.2 hl
    have hg₁ : (1 : ℝ) ≤ Nat.gcd r₁ r₂ := by
      exact_mod_cast Nat.gcd_pos_of_pos_left r₂ hr₁pos
    have hsg₁ : 1 ≤ Real.sqrt (Nat.gcd r₁ r₂ : ℝ) := Real.one_le_sqrt.2 hg₁
    have hsgle : Real.sqrt (Nat.gcd r₁ r₂ : ℝ) ≤ Nat.gcd r₁ r₂ :=
      Real.sqrt_le_self_iff.2 (Or.inr hg₁)
    have hroots : Real.sqrt (Nat.gcd r₁ r₂ : ℝ) *
        Real.sqrt (Nat.lcm r₁ r₂ : ℝ) =
        Real.sqrt (r₁ : ℝ) * Real.sqrt (r₂ : ℝ) := by
      rw [← Real.sqrt_mul hg.le, ← Real.sqrt_mul ha.le]
      congr 1
      exact_mod_cast Nat.gcd_mul_lcm r₁ r₂
    have hratio₁ : Real.sqrt (b * (r₁ : ℝ)) /
        Real.sqrt (Q * (Nat.lcm r₁ r₂ : ℝ)) =
        Real.sqrt b * Real.sqrt (Nat.gcd r₁ r₂ : ℝ) /
          (Real.sqrt Q * Real.sqrt (r₂ : ℝ)) := by
      rw [Real.sqrt_mul hb.le, Real.sqrt_mul hQ.le]
      apply (div_eq_div_iff (ne_of_gt (mul_pos hsQ hsl))
        (ne_of_gt (mul_pos hsQ hsc))).2
      calc
        _ = (Real.sqrt b * Real.sqrt Q) *
            (Real.sqrt (r₁ : ℝ) * Real.sqrt (r₂ : ℝ)) := by ring
        _ = (Real.sqrt b * Real.sqrt Q) *
            (Real.sqrt (Nat.gcd r₁ r₂ : ℝ) *
              Real.sqrt (Nat.lcm r₁ r₂ : ℝ)) := by rw [hroots]
        _ = _ := by ring
    have hratio₂ : Real.sqrt (Q * (Nat.lcm r₁ r₂ : ℝ)) /
        Real.sqrt (b * (r₁ : ℝ)) =
        Real.sqrt Q * Real.sqrt (r₂ : ℝ) /
          (Real.sqrt b * Real.sqrt (Nat.gcd r₁ r₂ : ℝ)) := by
      rw [← inv_div, hratio₁, inv_div]
    have hnum₁ : (M ^ 2 + M * Real.sqrt (Nat.gcd r₁ r₂ : ℝ)) *
        Real.sqrt (Nat.gcd r₁ r₂ : ℝ) ≤ (M ^ 2 + M) * (Nat.gcd r₁ r₂ : ℝ) := by
      calc
        _ = M ^ 2 * Real.sqrt (Nat.gcd r₁ r₂ : ℝ) +
            M * Real.sqrt (Nat.gcd r₁ r₂ : ℝ) ^ 2 := by ring
        _ = M ^ 2 * Real.sqrt (Nat.gcd r₁ r₂ : ℝ) +
            M * (Nat.gcd r₁ r₂ : ℝ) := by rw [Real.sq_sqrt hg.le]
        _ ≤ M ^ 2 * (Nat.gcd r₁ r₂ : ℝ) + M * (Nat.gcd r₁ r₂ : ℝ) :=
          add_le_add (mul_le_mul_of_nonneg_left hsgle (sq_nonneg M)) le_rfl
        _ = _ := by ring
    have hnum₂ : M ^ 2 / Real.sqrt (Nat.gcd r₁ r₂ : ℝ) + M ≤ M ^ 2 + M :=
      add_le_add (div_le_self (sq_nonneg M) hsg₁) le_rfl
    have hpow : (R : ℝ) ^ 2 ≤ (r₁ : ℝ) ^ 2 :=
      pow_le_pow_left₀ hRreal.le hR₁ 2
    have hden₁ : (R : ℝ) ^ 2 * Real.sqrt Q * Real.sqrt (R : ℝ) ≤
        (r₁ : ℝ) ^ 2 * Real.sqrt Q * Real.sqrt (r₂ : ℝ) :=
      mul_le_mul (mul_le_mul_of_nonneg_right hpow hsQ.le)
        (Real.sqrt_le_sqrt hR₂) hsR.le (by positivity)
    have hscupper : Real.sqrt (r₂ : ℝ) ≤ 2 * Real.sqrt (R : ℝ) := by
      calc
        _ ≤ Real.sqrt (4 * (R : ℝ)) := Real.sqrt_le_sqrt hr₂upper
        _ = _ := by rw [Real.sqrt_mul (by norm_num : (0 : ℝ) ≤ 4)]; norm_num
    have hfirst : ((M ^ 2 + M * Real.sqrt (Nat.gcd r₁ r₂ : ℝ)) *
        Real.sqrt (Nat.gcd r₁ r₂ : ℝ)) * H * Real.sqrt b /
          ((r₁ : ℝ) ^ 2 * Real.sqrt Q * Real.sqrt (r₂ : ℝ)) ≤
        U * (Nat.gcd r₁ r₂ : ℝ) := by
      calc
        _ ≤ ((M ^ 2 + M) * (Nat.gcd r₁ r₂ : ℝ)) * H * Real.sqrt b /
            ((r₁ : ℝ) ^ 2 * Real.sqrt Q * Real.sqrt (r₂ : ℝ)) :=
          div_le_div_of_nonneg_right
            (mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_right hnum₁ hH) hsb.le)
            (by positivity)
        _ ≤ ((M ^ 2 + M) * (Nat.gcd r₁ r₂ : ℝ)) * H * Real.sqrt b /
            ((R : ℝ) ^ 2 * Real.sqrt Q * Real.sqrt (R : ℝ)) :=
          div_le_div_of_nonneg_left (by positivity) (by positivity) hden₁
        _ = _ := by dsimp only [U]; ring
    have hsecond : (M ^ 2 / Real.sqrt (Nat.gcd r₁ r₂ : ℝ) + M) *
        Real.sqrt Q * Real.sqrt (r₂ : ℝ) / ((r₁ : ℝ) ^ 2 * Real.sqrt b) ≤ V := by
      calc
        _ ≤ (M ^ 2 + M) * Real.sqrt Q * (2 * Real.sqrt (R : ℝ)) /
            ((r₁ : ℝ) ^ 2 * Real.sqrt b) :=
          div_le_div_of_nonneg_right
            (mul_le_mul (mul_le_mul_of_nonneg_right hnum₂ hsQ.le)
              hscupper hsc.le (by positivity)) (by positivity)
        _ ≤ (M ^ 2 + M) * Real.sqrt Q * (2 * Real.sqrt (R : ℝ)) /
            ((R : ℝ) ^ 2 * Real.sqrt b) :=
          div_le_div_of_nonneg_left (by positivity) (by positivity)
            (mul_le_mul_of_nonneg_right hpow hsb.le)
        _ = V := by dsimp only [V]; ring
    calc
      _ = ((M ^ 2 + M * Real.sqrt (Nat.gcd r₁ r₂ : ℝ)) *
            Real.sqrt (Nat.gcd r₁ r₂ : ℝ)) * H * Real.sqrt b /
              ((r₁ : ℝ) ^ 2 * Real.sqrt Q * Real.sqrt (r₂ : ℝ)) +
            (M ^ 2 / Real.sqrt (Nat.gcd r₁ r₂ : ℝ) + M) *
              Real.sqrt Q * Real.sqrt (r₂ : ℝ) /
                ((r₁ : ℝ) ^ 2 * Real.sqrt b) := by
        rw [mul_div_assoc H, hratio₁, hratio₂]
        field_simp
      _ ≤ _ := add_le_add hfirst hsecond
  calc
    _ ≤ ∑ r₁ ∈ I, ∑ r₂ ∈ I, (U * (Nat.gcd r₁ r₂ : ℝ) + V) :=
      Finset.sum_le_sum fun r₁ hr₁ => Finset.sum_le_sum fun r₂ hr₂ =>
        hpoint r₁ hr₁ r₂ hr₂
    _ = U * (∑ r₁ ∈ I, ∑ r₂ ∈ I, (Nat.gcd r₁ r₂ : ℝ)) +
        (I.card : ℝ) ^ 2 * V := by
      simp only [Finset.sum_add_distrib, ← Finset.mul_sum,
        Finset.sum_const, nsmul_eq_mul]
      ring
    _ ≤ U * (12 * (R : ℝ) ^ 2 * τR) + (I.card : ℝ) ^ 2 * V :=
      add_le_add (mul_le_mul_of_nonneg_left hgcdsum hU) le_rfl
    _ = _ := by
      dsimp only [U, V]
      rw [hcard]
      push_cast
      field_simp
      ring

open Classical in
theorem typeIII_exactDiagonal_positive_fiber_card_le_divisors
    (r₁ m₁ : ℕ) (hr₁ : 0 < r₁) (hm₁ : 0 < m₁)
    (R I : Finset ℕ) :
    (((R ×ˢ I).filter (fun rm : ℕ × ℕ =>
      (r₁ : ℤ) ^ 3 * (m₁ : ℤ) - (rm.1 : ℤ) ^ 3 * (rm.2 : ℤ) = 0)).card) ≤
      (r₁ ^ 3 * m₁).divisors.card := by
  let F := (R ×ˢ I).filter (fun rm : ℕ × ℕ =>
    (r₁ : ℤ) ^ 3 * (m₁ : ℤ) - (rm.1 : ℤ) ^ 3 * (rm.2 : ℤ) = 0)
  let N := r₁ ^ 3 * m₁
  have hN : N ≠ 0 := mul_ne_zero (pow_ne_zero 3 hr₁.ne') hm₁.ne'
  have heq (rm : ℕ × ℕ) (hrm : rm ∈ F) : rm.1 ^ 3 * rm.2 = N := by
    exact_mod_cast (sub_eq_zero.mp (Finset.mem_filter.mp hrm).2).symm
  change F.card ≤ N.divisors.card
  apply Finset.card_le_card_of_injOn (fun rm : ℕ × ℕ => rm.1)
  · intro rm hrm
    refine Nat.mem_divisors.mpr ⟨?_, hN⟩
    rw [← heq rm hrm]
    exact dvd_mul_of_dvd_left (dvd_pow_self rm.1 (by norm_num : 3 ≠ 0)) rm.2
  · intro rm hrm rn hrn hsame
    change rm.1 = rn.1 at hsame
    apply Prod.ext hsame
    apply mul_left_cancel₀ (left_ne_zero_of_mul ((heq rm hrm).trans_ne hN))
    simpa only [hsame] using (heq rm hrm).trans (heq rn hrn).symm

open Classical in
theorem typeIII_mixed_reciprocal_compactProfile_elementary_norm_le_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (s r₁ r₂ : ℕ) (hs : Squarefree s)
    (h₁ : Squarefree r₁) (h₂ : Squarefree r₂)
    (hcop : Nat.Coprime s (r₁ * r₂)) (A m₁ m₂ : ℤ)
    (_hA : IsUnit (A : ZMod (s * Nat.lcm r₁ r₂)))
    (_hm₁ : IsUnit (m₁ : ZMod (r₁ * s)))
    (_hm₂ : IsUnit (m₂ : ZMod (r₂ * s)))
    (T Lw H : ℝ) (_hT : 0 ≤ T) (hLw : 0 ≤ Lw) (_hH : 0 < H)
    (ψ : ℝ → ℂ) (_hsupport : Function.support ψ ⊆ Set.Icc (-T) T)
    (hbound : ∀ t : ℝ, ‖ψ t‖ ≤ Lw) :
    let L := Finset.Icc (Int.ceil (-T * H)) (Int.floor (T * H))
    let q := s * Nat.lcm r₁ r₂
    letI : NeZero (r₁ * s) := ⟨mul_ne_zero h₁.ne_zero hs.ne_zero⟩
    letI : NeZero (r₂ * s) := ⟨mul_ne_zero h₂.ne_zero hs.ne_zero⟩
    ‖∑ ℓ ∈ L, if IsUnit (ℓ : ZMod q) then
      ψ ((ℓ : ℝ) / H) *
        normalizedKloosterman3Mod (r₁ * s)
          (((A : ZMod (r₁ * s)) * (m₁ : ZMod (r₁ * s))⁻¹) *
            (ℓ : ZMod (r₁ * s))) *
        star (normalizedKloosterman3Mod (r₂ * s)
          (((A : ZMod (r₂ * s)) * (m₂ : ZMod (r₂ * s))⁻¹) *
            (ℓ : ZMod (r₂ * s)))) else 0‖ ≤
      Lw * (L.card : ℝ) *
        (3 : ℝ) ^ ((r₁ * s).primeFactors.card + (r₂ * s).primeFactors.card) := by
  intro L q
  let _ : NeZero (r₁ * s) := ⟨mul_ne_zero h₁.ne_zero hs.ne_zero⟩
  let _ : NeZero (r₂ * s) := ⟨mul_ne_zero h₂.ne_zero hs.ne_zero⟩
  have hsq₁ : Squarefree (r₁ * s) :=
    (Nat.squarefree_mul (Nat.coprime_mul_iff_right.mp hcop).1.symm).2 ⟨h₁, hs⟩
  have hsq₂ : Squarefree (r₂ * s) :=
    (Nat.squarefree_mul (Nat.coprime_mul_iff_right.mp hcop).2.symm).2 ⟨h₂, hs⟩
  calc
    _ ≤ ∑ _ℓ ∈ L, Lw *
        (3 : ℝ) ^ ((r₁ * s).primeFactors.card + (r₂ * s).primeFactors.card) := by
      apply norm_sum_le_of_le
      intro ℓ _
      split_ifs
      · simp only [norm_mul, norm_star, pow_add, ← mul_assoc]
        gcongr
        · exact hbound _
        · exact normalizedKloosterman3Mod_squarefree_pointwise_bound_of_deligne
            hDeligne (r₁ * s) hsq₁ _
        · exact normalizedKloosterman3Mod_squarefree_pointwise_bound_of_deligne
            hDeligne (r₂ * s) hsq₂ _
      · simp only [norm_zero]
        positivity
    _ = _ := by
      simp only [Finset.sum_const, nsmul_eq_mul]
      ring

open Classical in
theorem typeIII_exactDiagonal_weighted_compactProfile_sum_le_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (R I : Finset ℕ) (S : ℕ → Finset ℕ)
    (hR : ∀ r ∈ R, Squarefree r)
    (hI : ∀ m ∈ I, 0 < m)
    (hS : ∀ r ∈ R, ∀ s ∈ S r, Squarefree s)
    (hcop : ∀ r ∈ R, ∀ s ∈ S r, Nat.Coprime r s)
    (A : ℤ)
    (hA : ∀ r₁ ∈ R, ∀ r₂ ∈ R, ∀ s ∈ S r₁, s ∈ S r₂ →
      IsUnit (A : ZMod (s * Nat.lcm r₁ r₂)))
    (α : ℕ → ℂ) (η : ℕ → ℕ → ℂ)
    (Wα Wη : ℝ) (hWα : 0 ≤ Wα) (hWη : 0 ≤ Wη)
    (hα : ∀ m ∈ I, ‖α m‖ ≤ Wα)
    (hη : ∀ r ∈ R, ∀ s ∈ S r, ‖η r s‖ ≤ Wη)
    (T Lw H : ℝ) (hT : 0 ≤ T) (hLw : 0 ≤ Lw) (hH : 0 < H)
    (ψ : ℝ → ℂ) (hsupport : Function.support ψ ⊆ Set.Icc (-T) T)
    (hbound : ∀ t : ℝ, ‖ψ t‖ ≤ Lw) :
    let L := Finset.Icc (Int.ceil (-T * H)) (Int.floor (T * H))
    let τ := (R ×ˢ I).sup (fun rm : ℕ × ℕ => (rm.1 ^ 3 * rm.2).divisors.card)
    let Ω := R.sup (fun r => (S r).sup (fun s => (r * s).primeFactors.card))
    let U (r₁ r₂ : {r : ℕ // r ∈ R})
        (s : {s : ℕ // s ∈ S r₁.val}) (m₁ m₂ : ℕ) : ℂ :=
      letI : NeZero (r₁.val * s.val) :=
        ⟨mul_ne_zero (hR r₁.val r₁.property).ne_zero
          (hS r₁.val r₁.property s.val s.property).ne_zero⟩
      letI : NeZero (r₂.val * s.val) :=
        ⟨mul_ne_zero (hR r₂.val r₂.property).ne_zero
          (hS r₁.val r₁.property s.val s.property).ne_zero⟩
      ∑ ℓ ∈ L, if IsUnit (ℓ : ZMod (s.val * Nat.lcm r₁.val r₂.val)) then
        ψ ((ℓ : ℝ) / H) *
          normalizedKloosterman3Mod (r₁.val * s.val)
            (((A : ZMod (r₁.val * s.val)) * (m₁ : ZMod (r₁.val * s.val))⁻¹) *
              (ℓ : ZMod (r₁.val * s.val))) *
          star (normalizedKloosterman3Mod (r₂.val * s.val)
            (((A : ZMod (r₂.val * s.val)) * (m₂ : ZMod (r₂.val * s.val))⁻¹) *
              (ℓ : ZMod (r₂.val * s.val)))) else 0
    (∑ r₁ : {r : ℕ // r ∈ R}, ∑ m₁ ∈ I,
      ∑ s : {s : ℕ // s ∈ S r₁.val},
      ∑ r₂ : {r : ℕ // r ∈ R}, ∑ m₂ ∈ I,
        if s.val ∈ S r₂.val ∧
            IsUnit (m₁ : ZMod (r₁.val * s.val)) ∧
            IsUnit (m₂ : ZMod (r₂.val * s.val)) ∧
            (r₁.val : ℤ) ^ 3 * (m₁ : ℤ) - (r₂.val : ℤ) ^ 3 * (m₂ : ℤ) = 0
        then (s.val : ℝ) * ‖η r₁.val s.val‖ * ‖η r₂.val s.val‖ *
          ‖α m₁‖ * ‖α m₂‖ * ‖U r₁ r₂ s m₁ m₂‖ else 0) ≤
      Wη ^ 2 * Wα ^ 2 * Lw * (L.card : ℝ) * (9 : ℝ) ^ Ω *
        (τ : ℝ) * (I.card : ℝ) *
          ∑ r ∈ R, ((S r).card : ℝ) * (((S r).sup id : ℕ) : ℝ) := by
  intro L τ Ω
  let K := Wη ^ 2 * Wα ^ 2 * Lw * (L.card : ℝ) * (9 : ℝ) ^ Ω
  have hK : 0 ≤ K := by positivity
  have hfiber (r₁ : R) (m₁ : ℕ) (hm₁ : m₁ ∈ I)
      (f : R → ℕ → ℝ) (c : ℝ) (hc : 0 ≤ c)
      (hf : ∀ r₂ : R, ∀ m₂ ∈ I,
        f r₂ m₂ ≤ if (r₁.val : ℤ) ^ 3 * (m₁ : ℤ) -
          (r₂.val : ℤ) ^ 3 * (m₂ : ℤ) = 0 then c else 0) :
      (∑ r₂ : R, ∑ m₂ ∈ I, f r₂ m₂) ≤ c * (τ : ℝ) := by
    let D := (R ×ˢ I).filter (fun rm : ℕ × ℕ =>
      (r₁.val : ℤ) ^ 3 * (m₁ : ℤ) - (rm.1 : ℤ) ^ 3 * (rm.2 : ℤ) = 0)
    have hcard : D.card ≤ τ :=
      Finset.le_sup_of_le (s := R ×ˢ I) (b := (r₁.val, m₁))
        (f := fun rm : ℕ × ℕ => (rm.1 ^ 3 * rm.2).divisors.card)
        (Finset.mem_product.mpr ⟨r₁.property, hm₁⟩)
        (typeIII_exactDiagonal_positive_fiber_card_le_divisors
          r₁.val m₁ (Nat.pos_of_ne_zero (hR r₁.val r₁.property).ne_zero)
          (hI m₁ hm₁) R I)
    calc
      _ ≤ ∑ r₂ : R, ∑ m₂ ∈ I,
          if (r₁.val : ℤ) ^ 3 * (m₁ : ℤ) -
            (r₂.val : ℤ) ^ 3 * (m₂ : ℤ) = 0 then c else 0 :=
        Finset.sum_le_sum (fun r₂ _ => Finset.sum_le_sum (fun m₂ hm₂ => hf r₂ m₂ hm₂))
      _ = (D.card : ℝ) * c := by
        rw [Finset.sum_coe_sort (s := R) (f := fun r₂ : ℕ => ∑ m₂ ∈ I,
          if (r₁.val : ℤ) ^ 3 * (m₁ : ℤ) - (r₂ : ℤ) ^ 3 * (m₂ : ℤ) = 0
            then c else 0), ← Finset.sum_product', ← Finset.sum_filter]
        simp only [Finset.sum_const, nsmul_eq_mul, D]
      _ ≤ (τ : ℝ) * c :=
        mul_le_mul_of_nonneg_right (Nat.cast_le.mpr hcard) hc
      _ = c * (τ : ℝ) := mul_comm _ _
  intro U
  have hΩ (r s : ℕ) (hr : r ∈ R) (hs : s ∈ S r) :
      (r * s).primeFactors.card ≤ Ω :=
    (Finset.le_sup (s := S r) (b := s) (f := fun s => (r * s).primeFactors.card) hs).trans
      (Finset.le_sup (s := R) (b := r) (f := fun r => (S r).sup
        (fun s => (r * s).primeFactors.card)) hr)
  have hU (r₁ r₂ : R) (s : S r₁.val) (m₁ m₂ : ℕ)
      (hs₂ : s.val ∈ S r₂.val)
      (hm₁ : IsUnit (m₁ : ZMod (r₁.val * s.val)))
      (hm₂ : IsUnit (m₂ : ZMod (r₂.val * s.val))) :
      ‖U r₁ r₂ s m₁ m₂‖ ≤ Lw * (L.card : ℝ) * (9 : ℝ) ^ Ω := by
    have hc : Nat.Coprime s.val (r₁.val * r₂.val) :=
      (hcop r₁.val r₁.property s.val s.property).symm.mul_right
        (hcop r₂.val r₂.property s.val hs₂).symm
    calc
      _ ≤ Lw * (L.card : ℝ) *
          (3 : ℝ) ^ ((r₁.val * s.val).primeFactors.card +
            (r₂.val * s.val).primeFactors.card) := by
        simpa only [U, L, Int.cast_natCast] using
          typeIII_mixed_reciprocal_compactProfile_elementary_norm_le_of_deligne
            hDeligne s.val r₁.val r₂.val
            (hS r₁.val r₁.property s.val s.property)
            (hR r₁.val r₁.property) (hR r₂.val r₂.property) hc
            A (m₁ : ℤ) (m₂ : ℤ)
            (hA r₁.val r₁.property r₂.val r₂.property s.val s.property hs₂)
            (by simpa only [Int.cast_natCast] using hm₁)
            (by simpa only [Int.cast_natCast] using hm₂)
            T Lw H hT hLw hH ψ hsupport hbound
      _ ≤ Lw * (L.card : ℝ) * (3 : ℝ) ^ (Ω + Ω) :=
        mul_le_mul_of_nonneg_left
          (pow_le_pow_right₀ (by norm_num)
            (Nat.add_le_add
              (hΩ r₁.val s.val r₁.property s.property)
              (hΩ r₂.val s.val r₂.property hs₂)))
          (mul_nonneg hLw (Nat.cast_nonneg _))
      _ = _ := by
        rw [pow_add, ← mul_pow]
        norm_num
  clear_value U
  calc
    _ ≤ ∑ r₁ : R, ∑ _m₁ ∈ I, ∑ s : S r₁.val,
        (s.val : ℝ) * K * (τ : ℝ) := by
      apply Finset.sum_le_sum
      intro r₁ _
      apply Finset.sum_le_sum
      intro m₁ hm₁
      apply Finset.sum_le_sum
      intro s _
      apply hfiber r₁ m₁ hm₁ _ ((s.val : ℝ) * K)
        (mul_nonneg (Nat.cast_nonneg _) hK)
      intro r₂ m₂ hm₂
      by_cases h : s.val ∈ S r₂.val ∧
          IsUnit (m₁ : ZMod (r₁.val * s.val)) ∧
          IsUnit (m₂ : ZMod (r₂.val * s.val)) ∧
          (r₁.val : ℤ) ^ 3 * (m₁ : ℤ) - (r₂.val : ℤ) ^ 3 * (m₂ : ℤ) = 0
      · rw [ite_eq_left h, ite_eq_left h.2.2.2]
        calc
          _ ≤ (s.val : ℝ) * Wη * Wη * Wα * Wα *
              (Lw * (L.card : ℝ) * (9 : ℝ) ^ Ω) := by
            gcongr
            · exact hη r₁.val r₁.property s.val s.property
            · exact hη r₂.val r₂.property s.val h.1
            · exact hα m₁ hm₁
            · exact hα m₂ hm₂
            · exact hU r₁ r₂ s m₁ m₂ h.1 h.2.1 h.2.2.1
          _ = (s.val : ℝ) * K := by ring
      · rw [ite_eq_right h]
        positivity
    _ = (I.card : ℝ) * (K * (τ : ℝ)) *
        ∑ r ∈ R, ∑ s ∈ S r, (s : ℝ) := by
      calc
        _ = ∑ r : R, ∑ _m ∈ I, ∑ s ∈ S r.val,
            (s : ℝ) * K * (τ : ℝ) := by
          apply Finset.sum_congr rfl
          intro r _
          apply Finset.sum_congr rfl
          intro _ _
          exact Finset.sum_coe_sort (s := S r.val)
            (f := fun s : ℕ => (s : ℝ) * K * (τ : ℝ))
        _ = ∑ r ∈ R, ∑ _m ∈ I, ∑ s ∈ S r,
            (s : ℝ) * K * (τ : ℝ) :=
          Finset.sum_coe_sort (s := R) (f := fun r : ℕ =>
            ∑ _m ∈ I, ∑ s ∈ S r, (s : ℝ) * K * (τ : ℝ))
        _ = _ := by
          simp_rw [← Finset.sum_mul]
          simp only [Finset.sum_const, nsmul_eq_mul]
          simp_rw [← Finset.mul_sum]
          ring
    _ ≤ (I.card : ℝ) * (K * (τ : ℝ)) *
        ∑ r ∈ R, ((S r).card : ℝ) * (((S r).sup id : ℕ) : ℝ) := by
      apply mul_le_mul_of_nonneg_left _ (by positivity)
      apply Finset.sum_le_sum
      intro r _
      simpa only [nsmul_eq_mul] using
        Finset.sum_le_card_nsmul (S r) (fun s : ℕ => (s : ℝ))
          (((S r).sup id : ℕ) : ℝ)
          (fun s hs => Nat.cast_le.mpr (Finset.le_sup (f := id) hs))
    _ = _ := by ring

theorem typeIII_first_moment_le_log_bound
    (Hb S : ℝ) (hHb : 0 < Hb) (hS : 1 ≤ S)
    (𝒮 : Finset ℕ+) (h𝒮 : ∀ s ∈ 𝒮, (s : ℝ) ≤ S) :
    let L : Finset ℤ :=
      (Finset.Icc (Int.ceil (-Hb)) (Int.floor Hb)).filter (fun ℓ => ℓ ≠ 0)
    let τ₃ : ℤ → ℝ := fun ℓ =>
      (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 3) ℓ.natAbs : ℝ)
    let T₁ : ℝ := ∑ s ∈ 𝒮, (1 / (s : ℝ)) * ∑ ℓ ∈ L, τ₃ ℓ ^ 2
    T₁ ≤ 2 * Hb * (1 + Real.log (max 1 Hb)) ^ 15 * (1 + Real.log S) := by
  intro L τ₃ T₁
  let I : Finset ℕ := Finset.Icc 1 ⌊Hb⌋₊
  have hsum : (∑ ℓ ∈ L, τ₃ ℓ ^ 2) =
      2 * ∑ n ∈ I, (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 3) n : ℝ) ^ 2 := by
    rw [Finset.sum_filter_of_ne (by
      rintro ℓ _ hℓ rfl
      simp [τ₃] at hℓ),
      Int.ceil_neg, ← Int.natCast_floor_eq_floor hHb.le,
      Finset.sum_Icc_of_even_eq_range (by intro ℓ; simp [τ₃]),
      Finset.sum_range_eq_add_Ico _ (Nat.succ_pos _), Nat.succ_eq_add_one,
      Finset.Ico_add_one_right_eq_Icc]
    simp [τ₃, I, two_mul]
  have htwo (n : ℕ) :
      ((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 2) n = n.divisors.card := by
    rw [← ArithmeticFunction.sigma_zero_apply, ← ArithmeticFunction.zeta_mul_pow_eq_sigma,
      ArithmeticFunction.pow_zero_eq_zeta, pow_two]
  have hthree (n : ℕ) (hn : n ≠ 0) :
      ((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 3) n ≤ n.divisors.card ^ 2 := by
    rw [pow_succ' (ArithmeticFunction.zeta : ArithmeticFunction ℕ) 2,
      ArithmeticFunction.zeta_mul_apply]
    simp_rw [htwo]
    simpa only [Nat.nsmul_eq_mul, pow_two] using
      Finset.sum_le_card_nsmul n.divisors (fun d => d.divisors.card) n.divisors.card
        (fun d hd =>
          Finset.card_le_card (Nat.divisors_subset_of_dvd hn (Nat.dvd_of_mem_divisors hd)))
  have hnatural :
      (∑ n ∈ I, (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 3) n : ℝ) ^ 2) ≤
        Hb * (1 + Real.log (max 1 Hb)) ^ 15 := by
    by_cases hlarge : 1 ≤ Hb
    · have hfloor : 0 < ⌊Hb⌋₊ := Nat.floor_pos.mpr hlarge
      have hfloorlog : 0 ≤ 1 + Real.log (⌊Hb⌋₊ : ℝ) :=
        add_nonneg zero_le_one
          (Real.log_nonneg (show (1 : ℝ) ≤ ⌊Hb⌋₊ by exact_mod_cast hfloor))
      have hlogle : 1 + Real.log (⌊Hb⌋₊ : ℝ) ≤ 1 + Real.log (max 1 Hb) :=
        add_le_add_right (Real.log_le_log (by exact_mod_cast hfloor)
          ((Nat.floor_le hHb.le).trans (le_max_right (1 : ℝ) Hb))) 1
      calc
        _ ≤ ∑ n ∈ I, (n.divisors.card : ℝ) ^ 4 := by
          apply Finset.sum_le_sum
          intro n hn
          exact_mod_cast
            (Nat.pow_le_pow_left (hthree n (Nat.ne_of_gt (Finset.mem_Icc.mp hn).1)) 2).trans_eq
              (pow_mul _ 2 2).symm
        _ ≤ (⌊Hb⌋₊ : ℝ) * (1 + Real.log (⌊Hb⌋₊ : ℝ)) ^ 15 :=
          sum_card_divisors_pow_le_mul_log_pow 4 ⌊Hb⌋₊
        _ ≤ Hb * (1 + Real.log (max 1 Hb)) ^ 15 :=
          mul_le_mul (Nat.floor_le hHb.le) (pow_le_pow_left₀ hfloorlog hlogle 15)
            (pow_nonneg hfloorlog _) hHb.le
    · have hI : I = ∅ := by
        simp [I, Nat.floor_eq_zero.mpr (lt_of_not_ge hlarge)]
      rw [hI, Finset.sum_empty]
      exact mul_nonneg hHb.le (pow_nonneg
        (add_nonneg zero_le_one (Real.log_nonneg (le_max_left _ _))) _)
  have hinner : (∑ ℓ ∈ L, τ₃ ℓ ^ 2) ≤
      2 * Hb * (1 + Real.log (max 1 Hb)) ^ 15 := by
    simpa only [hsum, mul_assoc] using
      mul_le_mul_of_nonneg_left hnatural (by norm_num : (0 : ℝ) ≤ 2)
  have hreciprocal : (∑ s ∈ 𝒮, (1 : ℝ) / (s : ℝ)) ≤ 1 + Real.log S := by
    calc
      _ ≤ ∑ n ∈ Finset.Icc 1 ⌊S⌋₊, (1 : ℝ) / n := by
        refine Finset.sum_le_sum_of_injOn (fun s : ℕ+ => (s : ℕ))
          PNat.coe_injective.injOn ?_ (fun _ _ => le_rfl) ?_
        · intro n hn
          obtain ⟨s, hs, rfl⟩ := Finset.mem_image.mp hn
          exact Finset.mem_Icc.mpr ⟨s.pos, Nat.le_floor (h𝒮 s hs)⟩
        · intro n _ _
          positivity
      _ = (harmonic ⌊S⌋₊ : ℝ) := by
        simp only [harmonic_eq_sum_Icc, Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast, one_div]
      _ ≤ 1 + Real.log S := harmonic_floor_le_one_add_log S hS
  calc
    T₁ = (∑ s ∈ 𝒮, (1 : ℝ) / (s : ℝ)) * ∑ ℓ ∈ L, τ₃ ℓ ^ 2 := by
      rw [Finset.sum_mul]
    _ ≤ (1 + Real.log S) * (2 * Hb * (1 + Real.log (max 1 Hb)) ^ 15) :=
      mul_le_mul hreciprocal hinner (Finset.sum_nonneg fun _ _ => sq_nonneg _)
        (add_nonneg zero_le_one (Real.log_nonneg hS))
    _ = 2 * Hb * (1 + Real.log (max 1 Hb)) ^ 15 * (1 + Real.log S) := by ring

theorem typeIII_first_moment_le_rpow
    (K ε : ℝ) (hK : 0 < K) (hε : 0 < ε) :
    ∃ X : ℝ, 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ Hb S : ℝ, 0 < Hb → Hb ≤ x ^ K → 1 ≤ S → S ≤ x ^ K →
      ∀ 𝒮 : Finset ℕ+, (∀ s ∈ 𝒮, (s : ℝ) ≤ S) →
        let L : Finset ℤ :=
          (Finset.Icc (Int.ceil (-Hb)) (Int.floor Hb)).filter (fun ℓ => ℓ ≠ 0)
        let τ₃ : ℤ → ℝ := fun ℓ =>
          (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 3) ℓ.natAbs : ℝ)
        let T₁ : ℝ := ∑ s ∈ 𝒮, (1 / (s : ℝ)) * ∑ ℓ ∈ L, τ₃ ℓ ^ 2
        T₁ ≤ x ^ ε * Hb := by
  have hthreshold :
      ∀ᶠ x : ℝ in Filter.atTop, 1 ≤ x ∧ 1 ≤ Real.log x ∧
        2 * (1 + K) ^ 16 * (Real.log x) ^ 16 ≤ x ^ ε := by
    filter_upwards [Filter.eventually_ge_atTop (1 : ℝ),
      Real.tendsto_log_atTop.eventually_ge_atTop 1,
      ((isLittleO_log_rpow_rpow_atTop (16 : ℝ) hε).const_mul_left
        (2 * (1 + K) ^ 16)).eventuallyLE] with x hx hlog hbound
    refine ⟨hx, hlog, ?_⟩
    simpa only [Real.rpow_ofNat, Real.norm_of_nonneg
      (mul_nonneg (by positivity : 0 ≤ (2 : ℝ) * (1 + K) ^ 16)
        (pow_nonneg (zero_le_one.trans hlog) 16)),
      Real.norm_of_nonneg (Real.rpow_nonneg (zero_le_one.trans hx) ε)] using hbound
  obtain ⟨X, hX⟩ := hthreshold.exists_forall_of_atTop
  refine ⟨X, (hX X le_rfl).1, ?_⟩
  intro x hx Hb S hHb hHbX hS hSX 𝒮 h𝒮 L τ₃ T₁
  obtain ⟨hx1, hlogx, hsmall⟩ := hX x hx
  have hlogHb := Real.log_le_log
    (zero_lt_one.trans_le (le_max_left (1 : ℝ) Hb))
    (max_le (Real.one_le_rpow hx1 hK.le) hHbX)
  have hlogS := Real.log_le_log (zero_lt_one.trans_le hS) hSX
  rw [Real.log_rpow (zero_lt_one.trans_le hx1) K] at hlogHb hlogS
  have hU0 : 0 ≤ 1 + K * Real.log x :=
    add_nonneg zero_le_one (mul_nonneg hK.le (zero_le_one.trans hlogx))
  have hlogs :
      (1 + Real.log (max 1 Hb)) ^ 15 * (1 + Real.log S) ≤
        (1 + K * Real.log x) ^ 16 := by
    calc
      _ ≤ (1 + K * Real.log x) ^ 15 * (1 + K * Real.log x) :=
        mul_le_mul
          (pow_le_pow_left₀
            (add_nonneg zero_le_one (Real.log_nonneg (le_max_left _ _)))
            (add_le_add_right hlogHb 1) 15)
          (add_le_add_right hlogS 1)
          (add_nonneg zero_le_one (Real.log_nonneg hS)) (pow_nonneg hU0 15)
      _ = (1 + K * Real.log x) ^ 16 := (pow_succ _ 15).symm
  have hU : 1 + K * Real.log x ≤ (1 + K) * Real.log x := by
    nlinarith only [hlogx]
  have hpower : 2 * (1 + K * Real.log x) ^ 16 ≤ x ^ ε := by
    calc
      _ ≤ 2 * ((1 + K) * Real.log x) ^ 16 :=
        mul_le_mul_of_nonneg_left (pow_le_pow_left₀ hU0 hU 16) (by norm_num)
      _ = 2 * (1 + K) ^ 16 * (Real.log x) ^ 16 := by
        simp only [mul_pow, mul_assoc]
      _ ≤ x ^ ε := hsmall
  calc
    T₁ ≤ 2 * Hb * (1 + Real.log (max 1 Hb)) ^ 15 * (1 + Real.log S) :=
      typeIII_first_moment_le_log_bound Hb S hHb hS 𝒮 h𝒮
    _ ≤ (2 * Hb) * (1 + K * Real.log x) ^ 16 := by
      simpa only [mul_assoc] using
        mul_le_mul_of_nonneg_left hlogs (by positivity : 0 ≤ 2 * Hb)
    _ = (2 * (1 + K * Real.log x) ^ 16) * Hb := by ring
    _ ≤ x ^ ε * Hb := mul_le_mul_of_nonneg_right hpower hHb.le

theorem typeIII_balancing_source_ranges_eventually
    (qExp δ ε C : ℝ) (hδ : 0 < δ) (hε : 0 < ε) (hC : 1 ≤ C)
    (hgap : 3 * qExp + 3 * ε < 2 + δ) :
    ∃ X : ℝ, 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
        C * x ^ (-ε) ≤ (1 : ℝ) / 3 ∧
        ∀ M N Qcenter b B : ℝ,
          0 < M → 0 < N → 0 < Qcenter → 1 ≤ b → b ≤ B → b ≤ 2 * Qcenter →
          x / C ≤ M * N → Qcenter ≤ C * x ^ qExp →
            let Y : ℝ := x ^ δ
            let H : ℝ := Qcenter ^ 3 / N
            let Hb : ℝ := x ^ (3 * ε / 2) * H / B
            let Qlo : ℝ := Qcenter * (1 - C * x ^ (-ε))
            0 < Qlo ∧ Qcenter / 2 ≤ Qlo ∧ Qlo ≤ Qcenter ∧
              (∀ q : ℝ,
                Qcenter * (1 - C * x ^ (-ε)) ≤ q →
                q ≤ Qcenter * (1 + C * x ^ (-ε)) →
                  Qlo ≤ q ∧ q ≤ 2 * Qlo) ∧
              0 < Hb ∧ 1 ≤ Y ∧ 2 ≤ Y * Qcenter ∧
              Hb ^ 2 ≤ (Qcenter / b) ^ 4 * (b * Y) * M ^ 2
    := by
  let ν : ℝ := 2 + δ - 3 * ε - 3 * qExp
  have hν : 0 < ν := by dsimp only [ν]; linarith only [hgap]
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have he := (tendsto_rpow_atTop hε).eventually_ge_atTop (3 * C)
  have hd := (tendsto_rpow_atTop hδ).eventually_ge_atTop (4 : ℝ)
  have hn := (tendsto_rpow_atTop hν).eventually_ge_atTop (2 * C ^ 5)
  have hbounds : ∀ᶠ x : ℝ in Filter.atTop,
      1 ≤ x ∧ 3 * C ≤ x ^ ε ∧ 4 ≤ x ^ δ ∧ 2 * C ^ 5 ≤ x ^ ν :=
    (Filter.eventually_ge_atTop 1).and (he.and (hd.and hn))
  obtain ⟨X, hX⟩ := Filter.eventually_atTop.mp hbounds
  refine ⟨X, (hX X le_rfl).1, ?_⟩
  intro x hx
  obtain ⟨hxone, hxe, hxd, hxn⟩ := hX x hx
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  have htsmall : C * x ^ (-ε) ≤ (1 : ℝ) / 3 := by
    rw [Real.rpow_neg hxpos.le, ← div_eq_mul_inv]
    apply (div_le_iff₀ (Real.rpow_pos_of_pos hxpos ε)).mpr
    linarith only [hxe]
  refine ⟨htsmall, ?_⟩
  intro M N Qcenter b B hM hN hQ hb hbB hbQ hMN hQmax Y H Hb Qlo
  have hbpos : 0 < b := zero_lt_one.trans_le hb
  have hBpos : 0 < B := hbpos.trans_le hbB
  have hsmallQ := mul_le_mul_of_nonneg_left htsmall hQ.le
  have hQhalf : Qcenter / 2 ≤ Qlo := by
    dsimp only [Qlo]
    nlinarith only [hsmallQ, hQ.le]
  have hQlopos : 0 < Qlo := (half_pos hQ).trans_le hQhalf
  have hQlole : Qlo ≤ Qcenter :=
    mul_le_of_le_one_right hQ.le (sub_le_self _ (by positivity))
  have hband : Qcenter * (1 + C * x ^ (-ε)) ≤ 2 * Qlo := by
    dsimp only [Qlo]
    nlinarith only [hsmallQ]
  have hHbpos : 0 < Hb := by
    dsimp only [Hb, H]
    positivity
  have hYone : 1 ≤ Y := by linarith only [hxd]
  have hQhalfpos : (1 : ℝ) / 2 ≤ Qcenter := by linarith only [hb, hbQ]
  have hcap : 2 ≤ Y * Qcenter := by
    nlinarith only [mul_le_mul hxd hQhalfpos (by norm_num) (by positivity)]
  let z : ℝ := x ^ (3 * ε / 2)
  let w : ℝ := x ^ qExp
  have hwpos : 0 < w := Real.rpow_pos_of_pos hxpos _
  have hpowers : x ^ ν * (z ^ 2 * w ^ 3) = Y * x ^ 2 := by
    dsimp only [z, w, Y]
    rw [← Real.rpow_mul_natCast hxpos.le (3 * ε / 2) 2,
      ← Real.rpow_mul_natCast hxpos.le qExp 3,
      ← Real.rpow_add hxpos, ← Real.rpow_add hxpos,
      ← Real.rpow_natCast x 2, ← Real.rpow_add hxpos]
    congr 1
    dsimp only [ν]
    ring
  have hgrowth : 2 * C ^ 5 * (z ^ 2 * w ^ 3) ≤ Y * x ^ 2 :=
    (mul_le_mul_of_nonneg_right hxn (by positivity)).trans_eq hpowers
  have hMNpow : x ^ 2 ≤ C ^ 2 * (M * N) ^ 2 := by
    simpa only [mul_pow, mul_comm (C ^ 2)] using
      pow_le_pow_left₀ hxpos.le ((div_le_iff₀ hCpos).mp hMN) 2
  have hQpow : Qcenter ^ 3 ≤ C ^ 3 * w ^ 3 := by
    simpa only [mul_pow] using pow_le_pow_left₀ hQ.le hQmax 3
  have hcore : z ^ 2 * Qcenter ^ 2 * b ≤ Y * (M * N) ^ 2 := by
    apply (mul_le_mul_iff_right₀ (pow_pos hCpos 2)).mp
    calc
      C ^ 2 * (z ^ 2 * Qcenter ^ 2 * b) ≤
          C ^ 2 * (z ^ 2 * Qcenter ^ 2 * (2 * Qcenter)) := by gcongr
      _ = (2 * C ^ 2 * z ^ 2) * Qcenter ^ 3 := by ring
      _ ≤ (2 * C ^ 2 * z ^ 2) * (C ^ 3 * w ^ 3) :=
        mul_le_mul_of_nonneg_left hQpow (by positivity)
      _ = 2 * C ^ 5 * (z ^ 2 * w ^ 3) := by ring
      _ ≤ Y * x ^ 2 := hgrowth
      _ ≤ Y * (C ^ 2 * (M * N) ^ 2) :=
        mul_le_mul_of_nonneg_left hMNpow (by positivity)
      _ = C ^ 2 * (Y * (M * N) ^ 2) := by ring
  refine ⟨hQlopos, hQhalf, hQlole, ?_, hHbpos, hYone, hcap, ?_⟩
  · intro q hlow hhigh
    exact ⟨hlow, hhigh.trans hband⟩
  · calc
      Hb ^ 2 = (z ^ 2 * Qcenter ^ 2 * b) *
          (Qcenter ^ 4 / (N ^ 2 * B ^ 2 * b)) := by
        change (z * (Qcenter ^ 3 / N) / B) ^ 2 = _
        field_simp [hN.ne', hBpos.ne', hbpos.ne']
      _ ≤ (Y * (M * N) ^ 2) * (Qcenter ^ 4 / (N ^ 2 * B ^ 2 * b)) :=
        mul_le_mul_of_nonneg_right hcore (by positivity)
      _ = Qcenter ^ 4 * Y * M ^ 2 / (B ^ 2 * b) := by
        field_simp [hN.ne', hBpos.ne', hbpos.ne']
      _ ≤ Qcenter ^ 4 * Y * M ^ 2 / (b ^ 2 * b) :=
        div_le_div_of_nonneg_left (by positivity) (by positivity) (by gcongr)
      _ = (Qcenter / b) ^ 4 * (b * Y) * M ^ 2 := by
        field_simp [hbpos.ne']

theorem typeIII_second_moment_scales_balanced
    (b Qlo Qcenter Y M Hb Tψ Lw Wη Wα : ℝ) (τ Ω : ℕ)
    (hb : 0 < b) (hQlo : 0 < Qlo) (hQcenter : Qlo ≤ Qcenter)
    (hQhalf : Qcenter / 2 ≤ Qlo)
    (hY : 1 ≤ Y) (hM : 1 ≤ M) (hHb : 1 ≤ Hb)
    (hTψ : 1 ≤ Tψ) (hLw : 0 ≤ Lw) (hWη : 0 ≤ Wη) (hWα : 0 ≤ Wα)
    (hτ : 1 ≤ τ) (hcap : 2 ≤ Y * Qcenter)
    (hbalance : Hb ^ 2 ≤ (Qcenter / b) ^ 4 * (b * Y) * M ^ 2) :
    let S : ℝ :=
      min ((Qcenter / b) ^ ((4 : ℝ) / 3) *
        (b * Y) ^ ((1 : ℝ) / 3) * M ^ ((2 : ℝ) / 3) /
          Hb ^ ((2 : ℝ) / 3)) ((b * Y) * Qcenter / (2 * b))
    let Dscale : ℝ :=
      2 * Wη ^ 2 * Wα ^ 2 * Lw * (2 * Tψ * Hb + 1) *
        (9 : ℝ) ^ Ω * (τ : ℝ) * (M + 1) * Qlo * S / b
    let Oscale : ℝ :=
      (6 * (2 * Tψ + 3)) * Lw * Wη ^ 2 * Wα ^ 2 *
        (9 : ℝ) ^ (2 * Ω) * (τ : ℝ) ^ 2 * ((M + 1) ^ 2 + (M + 1)) *
          (768 * (τ : ℝ) * Hb * Qlo * Real.sqrt S / b +
            576 * Real.sqrt (2 * b * Y) * Qlo ^ 3 /
              (b ^ 3 * Real.sqrt S))
    let Loss : ℝ :=
      (2 * Tψ + 3) * Lw * Wη ^ 2 * Wα ^ 2 *
        (9 : ℝ) ^ (2 * Ω) * (τ : ℝ) ^ 3
    1 ≤ S ∧ S ≤ Y * Qcenter / 2 ∧ S ≤ Y * Qlo ∧
      Dscale + Oscale ≤ 82944 * Loss *
        ((b * Y) ^ ((1 : ℝ) / 3) * Hb ^ ((1 : ℝ) / 3) *
            M ^ ((5 : ℝ) / 3) * (Qcenter / b) ^ ((7 : ℝ) / 3) +
          (b * Y) ^ ((1 : ℝ) / 6) * Hb ^ ((2 : ℝ) / 3) *
            M ^ ((7 : ℝ) / 3) * (Qcenter / b) ^ ((5 : ℝ) / 3) +
          M ^ 2 * (Qcenter / b) ^ ((5 : ℝ) / 2))
    := by
  intro S Dscale Oscale Loss
  let a : ℝ := Qcenter / b
  let y : ℝ := b * Y
  let U : ℝ := a ^ ((4 : ℝ) / 3) * y ^ ((1 : ℝ) / 3) *
    M ^ ((2 : ℝ) / 3) / Hb ^ ((2 : ℝ) / 3)
  let V : ℝ := y * a / 2
  have hYpos : 0 < Y := zero_lt_one.trans_le hY
  have ha : 0 < a := div_pos (hQlo.trans_le hQcenter) hb
  have hy : 0 < y := mul_pos hb hYpos
  have hUpos : 0 < U := by dsimp only [U]; positivity
  have hS : S = min U V := by
    dsimp only [S, U, V, a, y]
    congr 1
    rw [div_mul_eq_div_div]
    ring
  have hV : V = Y * Qcenter / 2 := by
    dsimp only [V, a, y]
    field_simp [hb.ne']
  have hUcube : U ^ 3 = a ^ 4 * y * M ^ 2 / Hb ^ 2 := by
    apply Real.log_injOn_pos (Set.mem_Ioi.mpr (by positivity))
      (Set.mem_Ioi.mpr (by positivity))
    dsimp only [U]
    simp (disch := positivity) only [Real.log_mul, Real.log_div,
      Real.log_rpow, Real.log_pow]
    ring
  have hUone : 1 ≤ U := by
    apply (one_le_pow_iff_of_nonneg hUpos.le (by decide : (3 : ℕ) ≠ 0)).mp
    rw [hUcube, one_le_div (by positivity : 0 < Hb ^ 2)]
    exact hbalance
  have hVone : 1 ≤ V := by rw [hV]; linarith only [hcap]
  have hSone : 1 ≤ S := by rw [hS]; exact le_min hUone hVone
  have hSU : S ≤ U := hS.trans_le (min_le_left U V)
  have hScap : S ≤ Y * Qcenter / 2 := hS.trans_le ((min_le_right U V).trans_eq hV)
  have hSlow : S ≤ Y * Qlo := hScap.trans (by
    simpa only [mul_div_assoc] using mul_le_mul_of_nonneg_left hQhalf hYpos.le)
  refine ⟨hSone, hScap, hSlow, ?_⟩
  let Bstar : ℝ := y ^ ((1 : ℝ) / 3) * Hb ^ ((1 : ℝ) / 3) *
    M ^ ((5 : ℝ) / 3) * a ^ ((7 : ℝ) / 3)
  let Dstar : ℝ := y ^ ((1 : ℝ) / 6) * Hb ^ ((2 : ℝ) / 3) *
    M ^ ((7 : ℝ) / 3) * a ^ ((5 : ℝ) / 3)
  let Cstar : ℝ := M ^ 2 * a ^ ((5 : ℝ) / 2)
  let X₁ : ℝ := Hb * M * a * S
  let X₂ : ℝ := Hb * M ^ 2 * a * Real.sqrt S
  let X₃ : ℝ := Real.sqrt y * M ^ 2 * a ^ 3 / Real.sqrt S
  have hBstar : 0 ≤ Bstar := by dsimp only [Bstar]; positivity
  have hDstar : 0 ≤ Dstar := by dsimp only [Dstar]; positivity
  have hCstar : 0 ≤ Cstar := by dsimp only [Cstar]; positivity
  have hX₁ : 0 ≤ X₁ := by dsimp only [X₁]; positivity
  have hX₂ : 0 ≤ X₂ := by dsimp only [X₂]; positivity
  have hsqrt2 : Real.sqrt (2 : ℝ) ≤ 2 := by norm_num [Real.sqrt_le_iff]
  have hfirst : Hb * M * a * U = Bstar := by
    dsimp only [U, Bstar]
    apply Real.log_injOn_pos (Set.mem_Ioi.mpr (by positivity))
      (Set.mem_Ioi.mpr (by positivity))
    simp (disch := positivity) only [Real.log_mul, Real.log_div, Real.log_rpow]
    ring
  have hsecond : Hb * M ^ 2 * a * Real.sqrt U = Dstar := by
    dsimp only [U, Dstar]
    apply Real.log_injOn_pos (Set.mem_Ioi.mpr (by positivity))
      (Set.mem_Ioi.mpr (by positivity))
    simp (disch := positivity) only [Real.log_mul, Real.log_div,
      Real.log_rpow, Real.log_pow, Real.log_sqrt]
    ring
  have hthirdU : Real.sqrt y * M ^ 2 * a ^ 3 / Real.sqrt U = Bstar := by
    dsimp only [U, Bstar]
    apply Real.log_injOn_pos (Set.mem_Ioi.mpr (by positivity))
      (Set.mem_Ioi.mpr (by positivity))
    simp (disch := positivity) only [Real.log_mul, Real.log_div,
      Real.log_rpow, Real.log_pow, Real.log_sqrt]
    ring
  have hthirdV : Real.sqrt y * M ^ 2 * a ^ 3 / Real.sqrt V =
      Real.sqrt 2 * Cstar := by
    dsimp only [V, Cstar]
    apply Real.log_injOn_pos (Set.mem_Ioi.mpr (by positivity))
      (Set.mem_Ioi.mpr (by positivity))
    simp (disch := positivity) only [Real.log_mul, Real.log_div,
      Real.log_rpow, Real.log_pow, Real.log_sqrt]
    ring
  have hfirst_le : X₁ ≤ Bstar :=
    (mul_le_mul_of_nonneg_left hSU (by positivity)).trans_eq hfirst
  have hsecond_le : X₂ ≤ Dstar :=
    (mul_le_mul_of_nonneg_left (Real.sqrt_le_sqrt hSU) (by positivity)).trans_eq hsecond
  have hthird_le : X₃ ≤ Bstar + 2 * Cstar := by
    dsimp only [X₃]
    rw [hS]
    rcases min_choice U V with h | h
    · rw [h, hthirdU]
      linarith only [hCstar]
    · rw [h, hthirdV]
      linarith only [mul_le_mul_of_nonneg_right hsqrt2 hCstar, hBstar]
  have hsum : X₁ + X₂ + X₃ ≤ 2 * (Bstar + Dstar + Cstar) := by
    linarith only [hfirst_le, hsecond_le, hthird_le, hDstar]
  let E : ℝ := Lw * Wη ^ 2 * Wα ^ 2
  let P : ℝ := (2 * Tψ + 3) * E * (9 : ℝ) ^ (2 * Ω)
  let R : ℝ := Qlo / b
  let F : ℝ := (M + 1) ^ 2 + (M + 1)
  have hE : 0 ≤ E :=
    mul_nonneg (mul_nonneg hLw (pow_nonneg hWη 2)) (pow_nonneg hWα 2)
  have hP : 0 ≤ P := by dsimp only [P]; positivity
  have hR : 0 < R := div_pos hQlo hb
  have hRa : R ≤ a := div_le_div_of_nonneg_right hQcenter hb.le
  have hLoss : Loss = P * (τ : ℝ) ^ 3 := by dsimp only [Loss, P, E]; ring
  have hLoss0 : 0 ≤ Loss := by rw [hLoss]; positivity
  have hτR : (1 : ℝ) ≤ τ := by exact_mod_cast hτ
  have hτ₁₃ : (τ : ℝ) ≤ (τ : ℝ) ^ 3 := le_self_pow₀ hτR (by decide)
  have hτ₂₃ : (τ : ℝ) ^ 2 ≤ (τ : ℝ) ^ 3 :=
    pow_le_pow_right₀ hτR (by decide : 2 ≤ 3)
  have hΩ : (9 : ℝ) ^ Ω ≤ (9 : ℝ) ^ (2 * Ω) :=
    pow_le_pow_right₀ (by norm_num : (1 : ℝ) ≤ 9) (by omega)
  have hTscale : 2 * Tψ * Hb + 1 ≤ (2 * Tψ + 3) * Hb := by
    nlinarith only [hHb]
  have hMplus : M + 1 ≤ 2 * M := by linarith only [hM]
  have hF : F ≤ 6 * M ^ 2 := by
    dsimp only [F]
    nlinarith only [hM, sq_nonneg (M - 1)]
  have hroot : Real.sqrt (2 * y) ≤ 2 * Real.sqrt y := by
    rw [Real.sqrt_mul (by norm_num : (0 : ℝ) ≤ 2) y]
    exact mul_le_mul_of_nonneg_right hsqrt2 (Real.sqrt_nonneg y)
  have hdiag : Dscale ≤ 4 * Loss * X₁ := by
    calc
      Dscale = 2 * E * (2 * Tψ * Hb + 1) *
          ((9 : ℝ) ^ Ω * (τ : ℝ)) * (M + 1) * R * S := by
        dsimp only [Dscale, E, R]
        ring
      _ ≤ 2 * E * ((2 * Tψ + 3) * Hb) *
          ((9 : ℝ) ^ (2 * Ω) * (τ : ℝ) ^ 3) * (2 * M) * a * S := by
        gcongr
      _ = 4 * Loss * X₁ := by dsimp only [Loss, E, X₁]; ring
  have hoff : Oscale =
      4608 * P * (τ : ℝ) ^ 3 * F * Hb * R * Real.sqrt S +
        3456 * P * (τ : ℝ) ^ 2 * F * Real.sqrt (2 * y) * R ^ 3 / Real.sqrt S := by
    dsimp only [Oscale, P, E, F, R, y]
    simp only [div_pow, div_mul_eq_div_div, mul_assoc]
    ring
  have hoff₁ : 4608 * P * (τ : ℝ) ^ 3 * F * Hb * R * Real.sqrt S ≤
      27648 * Loss * X₂ := by
    calc
      _ ≤ 4608 * P * (τ : ℝ) ^ 3 * (6 * M ^ 2) * Hb * a * Real.sqrt S := by
        gcongr
      _ = 27648 * Loss * X₂ := by rw [hLoss]; dsimp only [X₂]; ring
  have hoff₂ : 3456 * P * (τ : ℝ) ^ 2 * F * Real.sqrt (2 * y) * R ^ 3 / Real.sqrt S ≤
      41472 * Loss * X₃ := by
    calc
      _ ≤ 3456 * P * (τ : ℝ) ^ 3 * (6 * M ^ 2) *
          (2 * Real.sqrt y) * a ^ 3 / Real.sqrt S := by
        gcongr
      _ = 41472 * Loss * X₃ := by rw [hLoss]; dsimp only [X₃]; ring
  change Dscale + Oscale ≤ 82944 * Loss * (Bstar + Dstar + Cstar)
  calc
    _ ≤ 4 * Loss * X₁ + (27648 * Loss * X₂ + 41472 * Loss * X₃) := by
      rw [hoff]
      exact add_le_add hdiag (add_le_add hoff₁ hoff₂)
    _ ≤ 41472 * Loss * (X₁ + X₂ + X₃) := by
      nlinarith only [mul_nonneg hLoss0 hX₁, mul_nonneg hLoss0 hX₂]
    _ ≤ 41472 * Loss * (2 * (Bstar + Dstar + Cstar)) :=
      mul_le_mul_of_nonneg_left hsum (by positivity)
    _ = _ := by ring

open Classical in
theorem typeIII_finite_divisor_primeFactor_loss_le_rpow
    (K η : ℝ) (hK : 0 < K) (hη : 0 < η) :
    ∃ X : ℝ, 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ (D : Finset ℕ+) (M₀ M₁ : ℤ),
        (∀ d ∈ D, (d : ℝ) ≤ x ^ K) →
        (∀ m ∈ Finset.Icc M₀ M₁, |(m : ℝ)| ≤ x ^ K) →
          let I : Finset ℤ := Finset.Icc M₀ M₁
          let Dmax : ℕ := D.sup (fun d : ℕ+ => (d : ℕ))
          let Mmax : ℕ := I.sup (fun m : ℤ => m.natAbs)
          let Nτ : ℕ := max (4 * Dmax) (2 * Dmax ^ 3 * Mmax)
          let τ : ℕ := max 1 ((Finset.Icc 1 Nτ).sup (fun n : ℕ => n.divisors.card))
          let Ω : ℕ := D.sup (fun d : ℕ+ => (d : ℕ).primeFactors.card)
          (9 : ℝ) ^ (2 * Ω) * (τ : ℝ) ^ 3 ≤ x ^ η
    := by
  let ζ : ℝ := η / (80 * K)
  have hζ : 0 < ζ := by dsimp [ζ]; positivity
  obtain ⟨C, _, hCbound⟩ := exists_card_divisors_bound hζ
  let A : ℝ := max 1 C * (4 : ℝ) ^ ζ
  have hA : 1 ≤ A := one_le_mul_of_one_le_of_one_le (le_max_left 1 C)
    (Real.one_le_rpow (by norm_num) hζ.le)
  let X : ℝ := max 1 ((A ^ 10) ^ (η / 2)⁻¹)
  refine ⟨X, le_max_left _ _, ?_⟩
  intro x hx D M₀ M₁ hD hM
  have hx1 : 1 ≤ x := (le_max_left _ _).trans hx
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hxK : 1 ≤ x ^ K := Real.one_le_rpow hx1 hK.le
  have hxK0 : 0 ≤ x ^ K := zero_le_one.trans hxK
  have hconstant : A ^ 10 ≤ x ^ (η / 2) :=
    (Real.rpow_inv_le_iff_of_pos (by positivity) hx0.le
      (by positivity : 0 < η / 2)).mp ((le_max_right _ _).trans hx)
  intro I Dmax Mmax Nτ τ Ω
  have hsup {α : Type} (s : Finset α) (f : α → ℕ) {a : ℝ}
      (ha : 0 ≤ a) (hf : ∀ i ∈ s, (f i : ℝ) ≤ a) : ((s.sup f : ℕ) : ℝ) ≤ a :=
    (Nat.cast_le.mpr (Finset.sup_le fun i hi => Nat.le_floor (hf i hi))).trans (Nat.floor_le ha)
  have hDmax : (Dmax : ℝ) ≤ x ^ K :=
    hsup D (fun d : ℕ+ => (d : ℕ)) hxK0 hD
  have hMmax : (Mmax : ℝ) ≤ x ^ K := by
    apply hsup I (fun m : ℤ => m.natAbs) hxK0
    intro m hm
    simpa only [Nat.cast_natAbs, Int.cast_abs] using hM m hm
  have hpower4 : (x ^ K) ^ 4 = x ^ (4 * K) := by
    simpa only [Nat.cast_ofNat, mul_comm] using (Real.rpow_mul_natCast hx0.le K 4).symm
  have hNτ : (Nτ : ℝ) ≤ 4 * x ^ (4 * K) := by
    rw [← hpower4]
    simp only [Nτ, Nat.cast_max, Nat.cast_mul, Nat.cast_pow, Nat.cast_ofNat]
    apply max_le
    · nlinarith only [hDmax, le_self_pow₀ hxK (by decide : (4 : ℕ) ≠ 0)]
    · calc
        2 * (Dmax : ℝ) ^ 3 * (Mmax : ℝ) ≤ 2 * (x ^ K) ^ 3 * (x ^ K) := by gcongr
        _ ≤ 4 * (x ^ K) ^ 4 := by nlinarith only [pow_nonneg hxK0 4]
  have hscalar : 1 ≤ A * x ^ (4 * K * ζ) :=
    one_le_mul_of_one_le_of_one_le hA (Real.one_le_rpow hx1 (by positivity))
  have hτ : (τ : ℝ) ≤ A * x ^ (4 * K * ζ) := by
    have hdiv : ∀ n ∈ Finset.Icc 1 Nτ,
        (n.divisors.card : ℝ) ≤ A * x ^ (4 * K * ζ) := by
      intro n hn
      have hnN : (n : ℝ) ≤ 4 * x ^ (4 * K) :=
        (show (n : ℝ) ≤ (Nτ : ℝ) by exact_mod_cast (Finset.mem_Icc.mp hn).2).trans hNτ
      calc
        (n.divisors.card : ℝ) ≤ C * (n : ℝ) ^ ζ := hCbound n (Nat.ne_of_gt (Finset.mem_Icc.mp hn).1)
        _ ≤ max 1 C * (4 * x ^ (4 * K)) ^ ζ := by gcongr; exact le_max_right _ _
        _ = A * x ^ (4 * K * ζ) := by
          dsimp only [A]
          rw [Real.mul_rpow (by norm_num) (Real.rpow_nonneg hx0.le (4 * K)),
            ← Real.rpow_mul hx0.le]
          ring
    change ((max 1 ((Finset.Icc 1 Nτ).sup (fun n : ℕ => n.divisors.card)) : ℕ) : ℝ) ≤ _
    rw [Nat.cast_max, Nat.cast_one]
    exact max_le hscalar
      (hsup (Finset.Icc 1 Nτ) (fun n : ℕ => n.divisors.card)
        (zero_le_one.trans hscalar) hdiv)
  have hprime (n : ℕ) (hn : n ≠ 0) : 2 ^ n.primeFactors.card ≤ n.divisors.card := by
    rw [Nat.card_divisors hn, ← Finset.prod_const]
    apply Finset.prod_le_prod'
    intro p hp
    exact Nat.succ_le_succ ((Nat.prime_of_mem_primeFactors hp).factorization_pos_of_dvd hn
      (Nat.dvd_of_mem_primeFactors hp))
  have htwo : (2 : ℕ) ^ Ω ≤ τ := by
    rcases D.eq_empty_or_nonempty with hDe | hDne
    · simp only [Ω, hDe, Finset.sup_empty]
      exact le_max_left _ _
    · obtain ⟨d, hd, heq⟩ := Finset.sup_mem_of_nonempty
        (f := fun d : ℕ+ => (d : ℕ).primeFactors.card) hDne
      have hdmax : (d : ℕ) ≤ Dmax := Finset.le_sup hd
      have hdN : (d : ℕ) ≤ Nτ := hdmax.trans (by dsimp only [Nτ]; omega)
      have hdt : (d : ℕ).divisors.card ≤ τ :=
        (Finset.le_sup (s := Finset.Icc 1 Nτ) (f := fun n : ℕ => n.divisors.card)
          (Finset.mem_Icc.mpr ⟨d.pos, hdN⟩)).trans (le_max_right _ _)
      simpa only [Ω, ← heq] using (hprime (d : ℕ) d.ne_zero).trans hdt
  have htwoR : (2 : ℝ) ^ Ω ≤ (τ : ℝ) := by exact_mod_cast htwo
  have hloss : (9 : ℝ) ^ (2 * Ω) * (τ : ℝ) ^ 3 ≤ (τ : ℝ) ^ 10 := by
    calc
      (9 : ℝ) ^ (2 * Ω) * (τ : ℝ) ^ 3 = (81 : ℝ) ^ Ω * (τ : ℝ) ^ 3 := by
        rw [pow_mul]
        norm_num
      _ ≤ (128 : ℝ) ^ Ω * (τ : ℝ) ^ 3 := by gcongr; norm_num
      _ = ((2 : ℝ) ^ Ω) ^ 7 * (τ : ℝ) ^ 3 := by
        rw [← pow_mul, Nat.mul_comm Ω 7, pow_mul]
        norm_num
      _ ≤ (τ : ℝ) ^ 7 * (τ : ℝ) ^ 3 := by gcongr
      _ = (τ : ℝ) ^ 10 := by ring
  have hexp : (4 * K * ζ) * 10 = η / 2 := by
    dsimp only [ζ]
    field_simp [hK.ne']
    norm_num
  calc
    (9 : ℝ) ^ (2 * Ω) * (τ : ℝ) ^ 3 ≤ (τ : ℝ) ^ 10 := hloss
    _ ≤ (A * x ^ (4 * K * ζ)) ^ 10 := by gcongr
    _ = A ^ 10 * x ^ (η / 2) := by
      rw [mul_pow, ← Real.rpow_mul_natCast hx0.le (4 * K * ζ) 10, Nat.cast_ofNat, hexp]
    _ ≤ x ^ (η / 2) * x ^ (η / 2) := by gcongr
    _ = x ^ η := by rw [← Real.rpow_add hx0, add_halves]

section
open UniqueFactorizationMonoid

theorem sum_inv_sqrt_factoredNumbers_le_divisors_sq
    (t : ℕ) (ht : t ≠ 0) (S : Finset ℕ)
    (hS : ∀ u ∈ S, u ∈ Nat.factoredNumbers t.primeFactors) :
    (∑ u ∈ S, (Real.sqrt (u : ℝ))⁻¹) ≤ (t.divisors.card : ℝ) ^ 2 := by
  let f : ℕ → ℝ := fun n => (n : ℝ) ^ (-(1 / 2 : ℝ))
  have hf_nonneg (n : ℕ) : 0 ≤ f n := Real.rpow_nonneg (Nat.cast_nonneg n) _
  have hf_sqrt (n : ℕ) : f n = (Real.sqrt (n : ℝ))⁻¹ := by
    dsimp only [f]
    rw [Real.rpow_neg (Nat.cast_nonneg n), Real.sqrt_eq_rpow]
  have hf_mul {m n : ℕ} (_ : Nat.Coprime m n) : f (m * n) = f m * f n := by
    dsimp only [f]
    rw [Nat.cast_mul, Real.mul_rpow (Nat.cast_nonneg m) (Nat.cast_nonneg n)]
  have hseries (p : ℕ) (hp : p.Prime) :
      HasSum (fun e : ℕ => f (p ^ e)) (1 - f p)⁻¹ := by
    have hr : ‖f p‖ < 1 := by
      rw [Real.norm_of_nonneg (hf_nonneg p)]
      exact Real.rpow_lt_one_of_one_lt_of_neg
        (by exact_mod_cast hp.one_lt) (by norm_num)
    simpa only [f, Nat.cast_pow, ← Real.rpow_pow_comm (Nat.cast_nonneg p)] using
      hasSum_geometric_of_norm_lt_one hr
  have heuler :=
    (EulerProduct.summable_and_hasSum_factoredNumbers_prod_filter_prime_tsum
      (by simp [f]) hf_mul (fun {p} hp => (hseries p hp).summable.norm) t.primeFactors).2
  have hsum : (∑ u ∈ S, f u) ≤ ∏ p ∈ t.primeFactors, (1 - f p)⁻¹ := by
    have hfinite := sum_le_hasSum (S.subtype (· ∈ Nat.factoredNumbers t.primeFactors))
      (fun u _ => hf_nonneg u) heuler
    rw [Finset.sum_subtype_of_mem f hS,
      Finset.filter_true_of_mem (fun p hp => Nat.prime_of_mem_primeFactors hp)] at hfinite
    exact hfinite.trans_eq (Finset.prod_congr rfl fun p hp =>
      (hseries p (Nat.prime_of_mem_primeFactors hp)).tsum_eq)
  have hfactor (p : ℕ) (hp : p ∈ t.primeFactors) :
      0 ≤ (1 - f p)⁻¹ ∧ (1 - f p)⁻¹ ≤ ((t.factorization p : ℝ) + 1) ^ 2 := by
    have hpprime := Nat.prime_of_mem_primeFactors hp
    have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast hpprime.two_le
    have hsqrt : (4 / 3 : ℝ) ≤ Real.sqrt (p : ℝ) :=
      Real.le_sqrt_of_sq_le (by nlinarith)
    have hfp : f p ≤ (3 / 4 : ℝ) := by
      calc
        f p = (Real.sqrt (p : ℝ))⁻¹ := hf_sqrt p
        _ ≤ (4 / 3 : ℝ)⁻¹ := inv_anti₀ (by norm_num) hsqrt
        _ = 3 / 4 := by norm_num
    have hden : 0 < 1 - f p := by linarith
    have hfac : (1 : ℝ) ≤ (t.factorization p : ℝ) := by
      exact_mod_cast Nat.succ_le_of_lt
        (hpprime.factorization_pos_of_dvd ht (Nat.dvd_of_mem_primeFactors hp))
    refine ⟨inv_nonneg.mpr hden.le, ?_⟩
    calc
      (1 - f p)⁻¹ ≤ (1 / 4 : ℝ)⁻¹ := inv_anti₀ (by norm_num) (by linarith)
      _ = 4 := by norm_num
      _ ≤ ((t.factorization p : ℝ) + 1) ^ 2 := by
        nlinarith [sq_nonneg ((t.factorization p : ℝ) - 1)]
  calc
    (∑ u ∈ S, (Real.sqrt (u : ℝ))⁻¹) = ∑ u ∈ S, f u := by simp only [hf_sqrt]
    _ ≤ ∏ p ∈ t.primeFactors, (1 - f p)⁻¹ := hsum
    _ ≤ ∏ p ∈ t.primeFactors, ((t.factorization p : ℝ) + 1) ^ 2 :=
      Finset.prod_le_prod (fun p hp => (hfactor p hp).1) (fun p hp => (hfactor p hp).2)
    _ = (t.divisors.card : ℝ) ^ 2 := by
      rw [Finset.prod_pow]
      congr 1
      exact_mod_cast (Nat.card_divisors ht).symm

theorem sum_radical_div_sqrt_le_of_radical_dvd
    (b : ℕ) (hb : b ≠ 0) (S : Finset ℕ)
    (hS : ∀ n ∈ S, 0 < n ∧ radical n ∣ b) :
    (∑ n ∈ S, ((radical n : ℕ) : ℝ) / Real.sqrt (n : ℝ)) ≤
      Real.sqrt (b : ℝ) * (b.divisors.card : ℝ) ^ 3 := by
  have hfiber (t : ℕ) (ht : t ∈ b.divisors) :
      (∑ n ∈ S.filter (fun n : ℕ => radical n = t),
        ((radical n : ℕ) : ℝ) / Real.sqrt (n : ℝ)) ≤
        Real.sqrt (b : ℝ) * (b.divisors.card : ℝ) ^ 2 := by
    let F : Finset ℕ := S.filter (fun n : ℕ => radical n = t)
    let U : Finset ℕ := F.image (fun n : ℕ => n / t)
    have htpos : 0 < t := Nat.pos_of_mem_divisors ht
    have hF (n : ℕ) (hn : n ∈ F) : 0 < n ∧ radical n = t :=
      ⟨(hS n (Finset.mem_filter.mp hn).1).1, (Finset.mem_filter.mp hn).2⟩
    have hdvd (n : ℕ) (hn : n ∈ F) : t ∣ n := by
      rw [← (hF n hn).2]
      exact radical_dvd_self
    have hinj : Set.InjOn (fun n : ℕ => n / t) (↑F : Set ℕ) :=
      fun n hn m hm hnm => (Nat.div_left_inj (hdvd n hn) (hdvd m hm)).mp hnm
    have hU : ∀ u ∈ U, u ∈ Nat.factoredNumbers t.primeFactors := by
      intro u hu
      obtain ⟨n, hn, rfl⟩ := Finset.mem_image.mp hu
      refine Nat.mem_factoredNumbers_of_dvd
        (Nat.mem_factoredNumbers_of_primeFactors_subset (hF n hn).1.ne' ?_)
        (Nat.div_dvd_of_dvd (hdvd n hn))
      exact Finset.subset_of_eq (by
        simpa only [(hF n hn).2] using (Nat.primeFactors_radical n).symm)
    have hsum :
        (∑ n ∈ F, ((radical n : ℕ) : ℝ) / Real.sqrt (n : ℝ)) =
          Real.sqrt (t : ℝ) * ∑ u ∈ U, (Real.sqrt (u : ℝ))⁻¹ := by
      calc
        _ = ∑ n ∈ F,
            Real.sqrt (t : ℝ) * (Real.sqrt ((n / t : ℕ) : ℝ))⁻¹ := by
          apply Finset.sum_congr rfl
          intro n hn
          have hnR : (n : ℝ) = (t : ℝ) * ((n / t : ℕ) : ℝ) := by
            exact_mod_cast (Nat.mul_div_cancel' (hdvd n hn)).symm
          rw [(hF n hn).2, hnR, Real.sqrt_mul (Nat.cast_nonneg t),
            div_mul_eq_div_div, Real.div_sqrt, div_eq_mul_inv]
        _ = _ := by
          dsimp only [U]
          rw [Finset.sum_image hinj, Finset.mul_sum]
    have hsqrt : Real.sqrt (t : ℝ) ≤ Real.sqrt (b : ℝ) :=
      Real.sqrt_le_sqrt (Nat.cast_le.mpr (Nat.divisor_le ht))
    have hcard : (t.divisors.card : ℝ) ≤ (b.divisors.card : ℝ) :=
      Nat.cast_le.mpr (Finset.card_le_card
        (Nat.divisors_subset_of_dvd hb (Nat.dvd_of_mem_divisors ht)))
    calc
      _ = Real.sqrt (t : ℝ) * ∑ u ∈ U, (Real.sqrt (u : ℝ))⁻¹ := hsum
      _ ≤ Real.sqrt (t : ℝ) * (t.divisors.card : ℝ) ^ 2 :=
        mul_le_mul_of_nonneg_left
          (sum_inv_sqrt_factoredNumbers_le_divisors_sq t htpos.ne' U hU)
          (Real.sqrt_nonneg _)
      _ ≤ Real.sqrt (b : ℝ) * (b.divisors.card : ℝ) ^ 2 :=
        mul_le_mul hsqrt (pow_le_pow_left₀ (Nat.cast_nonneg _) hcard 2)
          (sq_nonneg _) (Real.sqrt_nonneg _)
  calc
    _ = ∑ t ∈ b.divisors, ∑ n ∈ S.filter (fun n : ℕ => radical n = t),
          ((radical n : ℕ) : ℝ) / Real.sqrt (n : ℝ) :=
      (Finset.sum_fiberwise_of_maps_to
        (fun n hn => Nat.mem_divisors.mpr ⟨(hS n hn).2, hb⟩)
        (fun n : ℕ => ((radical n : ℕ) : ℝ) / Real.sqrt (n : ℝ))).symm
    _ ≤ ∑ _t ∈ b.divisors, Real.sqrt (b : ℝ) * (b.divisors.card : ℝ) ^ 2 :=
      Finset.sum_le_sum hfiber
    _ = Real.sqrt (b : ℝ) * (b.divisors.card : ℝ) ^ 3 := by
      simp only [Finset.sum_const, nsmul_eq_mul]
      ring

theorem exists_typeIII_bad_weight_sum_bound :
    ∃ C : ℝ, 0 < C ∧ ∀ S : Finset (ℕ × ℕ × ℕ),
      (∀ v ∈ S, 0 < v.1 ∧ 0 < v.2.1 ∧ 0 < v.2.2) →
        (∑ v ∈ S,
          (((radical v.1 : ℕ) : ℝ) * ((radical v.2.1 : ℕ) : ℝ) * ((radical v.2.2 : ℕ) : ℝ)) /
            (Real.sqrt ((v.1 * v.2.1 * v.2.2 : ℕ) : ℝ) *
              ((radical (v.1 * v.2.1 * v.2.2) : ℕ) : ℝ) ^ 3)) ≤ C := by
  obtain ⟨A, hA, hdiv⟩ := exists_divisorPower_bound 9
    (show (0 : ℝ) < 1 / 4 from by norm_num)
  have hseries : Summable (fun n : ℕ => (n : ℝ) ^ (-(5 / 4 : ℝ))) :=
    Real.summable_nat_rpow.mpr (by norm_num)
  have hseries₀ : 0 ≤ ∑' n : ℕ, (n : ℝ) ^ (-(5 / 4 : ℝ)) :=
    tsum_nonneg fun n => Real.rpow_nonneg (Nat.cast_nonneg n) _
  refine ⟨1 + A * ∑' n : ℕ, (n : ℝ) ^ (-(5 / 4 : ℝ)), by positivity, ?_⟩
  intro S hS
  let r : ℕ × ℕ × ℕ → ℕ := fun v => radical (v.1 * v.2.1 * v.2.2)
  let f : ℕ → ℝ := fun n => ((radical n : ℕ) : ℝ) / Real.sqrt (n : ℝ)
  let w : ℕ × ℕ × ℕ → ℝ := fun v =>
    (((radical v.1 : ℕ) : ℝ) * ((radical v.2.1 : ℕ) : ℝ) * ((radical v.2.2 : ℕ) : ℝ)) /
      (Real.sqrt ((v.1 * v.2.1 * v.2.2 : ℕ) : ℝ) * (r v : ℝ) ^ 3)
  let R : Finset ℕ := S.image r
  have hf₀ (n : ℕ) : 0 ≤ f n :=
    div_nonneg (Nat.cast_nonneg _) (Real.sqrt_nonneg _)
  have hfiber (b : ℕ) (hb : b ∈ R) :
      (∑ v ∈ S.filter (fun v => r v = b), w v) ≤ A * (b : ℝ) ^ (-(5 / 4 : ℝ)) := by
    have hbpos : 0 < b := by
      obtain ⟨v, _, rfl⟩ := Finset.mem_image.mp hb
      exact Nat.radical_pos _
    have hbR : (0 : ℝ) < b := Nat.cast_pos.mpr hbpos
    let F := S.filter (fun v => r v = b)
    let S₁ := F.image Prod.fst
    let S₂ := F.image (fun v => v.2.1)
    let S₃ := F.image (fun v => v.2.2)
    let Q : ℝ := Real.sqrt (b : ℝ) * (b.divisors.card : ℝ) ^ 3
    have hQ : 0 ≤ Q := by dsimp [Q]; positivity
    have hcoord (g : ℕ × ℕ × ℕ → ℕ)
        (hg : ∀ v ∈ F, 0 < g v ∧ g v ∣ v.1 * v.2.1 * v.2.2) :
        (∑ n ∈ F.image g, f n) ≤ Q := by
      apply sum_radical_div_sqrt_le_of_radical_dvd b hbpos.ne'
      intro n hn
      obtain ⟨v, hv, rfl⟩ := Finset.mem_image.mp hn
      have hvpos := hS v (Finset.mem_filter.mp hv).1
      have hvprod : v.1 * v.2.1 * v.2.2 ≠ 0 :=
        (mul_pos (mul_pos hvpos.1 hvpos.2.1) hvpos.2.2).ne'
      refine ⟨(hg v hv).1, ?_⟩
      exact (radical_dvd_radical (hg v hv).2 hvprod).trans
        (dvd_of_eq (Finset.mem_filter.mp hv).2)
    have h₁ : (∑ n ∈ S₁, f n) ≤ Q := by
      apply hcoord Prod.fst
      intro v hv
      exact ⟨(hS v (Finset.mem_filter.mp hv).1).1, (dvd_mul_right _ _).mul_right _⟩
    have h₂ : (∑ n ∈ S₂, f n) ≤ Q := by
      apply hcoord (fun v => v.2.1)
      intro v hv
      exact ⟨(hS v (Finset.mem_filter.mp hv).1).2.1, (dvd_mul_left _ _).mul_right _⟩
    have h₃ : (∑ n ∈ S₃, f n) ≤ Q := by
      apply hcoord (fun v => v.2.2)
      intro v hv
      exact ⟨(hS v (Finset.mem_filter.mp hv).1).2.2, dvd_mul_left _ _⟩
    have hsubset : F ⊆ S₁ ×ˢ (S₂ ×ˢ S₃) := by
      simpa only [S₁, S₂, S₃, Finset.image_image, Function.comp_def] using
        (Finset.subset_product (s := F)).trans
          (Finset.product_subset_product_right
            (Finset.subset_product (s := F.image Prod.snd)))
    have hw (v : ℕ × ℕ × ℕ) (hv : v ∈ F) :
        w v = f v.1 * f v.2.1 * f v.2.2 / (b : ℝ) ^ 3 := by
      dsimp only [w, f]
      rw [(Finset.mem_filter.mp hv).2, Nat.cast_mul, Real.sqrt_mul (Nat.cast_nonneg _),
        Nat.cast_mul, Real.sqrt_mul (Nat.cast_nonneg _)]
      simp only [div_eq_mul_inv, mul_inv_rev]
      ring
    have hprod : (∑ n ∈ S₁, f n) * (∑ n ∈ S₂, f n) * (∑ n ∈ S₃, f n) ≤ Q ^ 3 := by
      calc
        _ ≤ Q * Q * Q :=
          mul_le_mul (mul_le_mul h₁ h₂ (Finset.sum_nonneg fun n _ => hf₀ n) hQ)
            h₃ (Finset.sum_nonneg fun n _ => hf₀ n) (mul_nonneg hQ hQ)
        _ = _ := by ring
    have hpower : Real.sqrt (b : ℝ) ^ 3 / (b : ℝ) ^ 3 =
        (b : ℝ) ^ (-(3 / 2 : ℝ)) := by
      rw [Real.sqrt_eq_rpow, ← Real.rpow_mul_natCast hbR.le,
        ← Real.rpow_sub_natCast hbR.ne']
      norm_num
    calc
      (∑ v ∈ F, w v) = (∑ v ∈ F, f v.1 * f v.2.1 * f v.2.2) / (b : ℝ) ^ 3 := by
        rw [Finset.sum_div]
        exact Finset.sum_congr rfl hw
      _ ≤ (∑ v ∈ S₁ ×ˢ (S₂ ×ˢ S₃), f v.1 * f v.2.1 * f v.2.2) /
          (b : ℝ) ^ 3 := by
        apply div_le_div_of_nonneg_right _ (pow_nonneg hbR.le _)
        exact Finset.sum_le_sum_of_subset_of_nonneg hsubset
          (fun v _ _ => mul_nonneg (mul_nonneg (hf₀ _) (hf₀ _)) (hf₀ _))
      _ = ((∑ n ∈ S₁, f n) * (∑ n ∈ S₂, f n) * (∑ n ∈ S₃, f n)) /
          (b : ℝ) ^ 3 := by
        simp only [Finset.sum_product, ← Finset.mul_sum, ← Finset.sum_mul]
      _ ≤ Q ^ 3 / (b : ℝ) ^ 3 :=
        div_le_div_of_nonneg_right hprod (pow_nonneg hbR.le _)
      _ = (b.divisors.card : ℝ) ^ 9 * (b : ℝ) ^ (-(3 / 2 : ℝ)) := by
        dsimp only [Q]
        calc
          _ = (b.divisors.card : ℝ) ^ 9 * (Real.sqrt (b : ℝ) ^ 3 / (b : ℝ) ^ 3) := by ring
          _ = _ := by rw [hpower]
      _ ≤ (A * (b : ℝ) ^ (1 / 4 : ℝ)) * (b : ℝ) ^ (-(3 / 2 : ℝ)) :=
        mul_le_mul_of_nonneg_right (hdiv b hbpos.ne') (Real.rpow_nonneg hbR.le _)
      _ = A * (b : ℝ) ^ (-(5 / 4 : ℝ)) := by
        rw [mul_assoc, ← Real.rpow_add hbR]
        norm_num
  calc
    (∑ v ∈ S, w v) = ∑ b ∈ R, ∑ v ∈ S.filter (fun v => r v = b), w v :=
      (Finset.sum_fiberwise_of_maps_to (s := S) (t := R) (g := r)
        (fun v hv => Finset.mem_image_of_mem r hv) w).symm
    _ ≤ ∑ b ∈ R, A * (b : ℝ) ^ (-(5 / 4 : ℝ)) := Finset.sum_le_sum hfiber
    _ = A * ∑ b ∈ R, (b : ℝ) ^ (-(5 / 4 : ℝ)) := (Finset.mul_sum _ _ _).symm
    _ ≤ A * ∑' n : ℕ, (n : ℝ) ^ (-(5 / 4 : ℝ)) :=
      mul_le_mul_of_nonneg_left
        (Summable.sum_le_tsum R (fun n _ => Real.rpow_nonneg (Nat.cast_nonneg n) _) hseries) hA.le
    _ ≤ 1 + A * ∑' n : ℕ, (n : ℝ) ^ (-(5 / 4 : ℝ)) :=
      le_add_of_nonneg_left zero_le_one

end

theorem typeIIICompleteFiberSum_good_bad_factorization
    (b d : ℕ) [NeZero b] [NeZero d] (hbd : Squarefree (b * d))
    (h₁ h₂ h₃ : ℤ)
    (hb : b = Int.gcd (h₁ * h₂ * h₃) ((b * d : ℕ) : ℤ))
    (a : (ZMod (b * d))ˣ) :
    let a_d : (ZMod d)ˣ :=
      Units.map ((ZMod.castHom (Nat.dvd_mul_left d b) (ZMod d)).toMonoidHom) a
    let c : ZMod d := (a_d : ZMod d) * (h₁ : ZMod d) * (h₂ : ZMod d) *
      (h₃ : ZMod d) * ((b : ZMod d)⁻¹) ^ 3
    typeIIICompleteFiberSum (b * d)
        (h₁ : ZMod (b * d)) (h₂ : ZMod (b * d)) (h₃ : ZMod (b * d)) a =
      typeIIICompleteFiberSum b (h₁ : ZMod b) (h₂ : ZMod b) (h₃ : ZMod b) 1 *
        normalizedKloosterman3Mod d c ∧
      IsUnit c ∧
      ‖typeIIICompleteFiberSum b (h₁ : ZMod b) (h₂ : ZMod b) (h₃ : ZMod b) 1‖ ≤
        ((Int.gcd h₁ ((b * d : ℕ) : ℤ) : ℝ) *
          (Int.gcd h₂ ((b * d : ℕ) : ℤ) : ℝ) *
          (Int.gcd h₃ ((b * d : ℕ) : ℤ) : ℝ)) / (b : ℝ) ^ 2 := by
  intro a_d c
  obtain ⟨_, _, _, hbsq, _, hcop, hbH, hdH, _, _, hg₁, hg₂, hg₃⟩ :=
    typeIII_squarefree_good_bad_moduli (b * d) hbd h₁ h₂ h₃
  simp only [← hb, Nat.mul_div_cancel_left d (Nat.pos_of_ne_zero (NeZero.ne b))]
    at hbsq hcop hbH hdH hg₁ hg₂ hg₃
  let e := ZMod.chineseRemainder hcop
  let fb : ZMod (b * d) →+* ZMod b :=
    (RingHom.fst (ZMod b) (ZMod d)).comp e.toRingHom
  let fd : ZMod (b * d) →+* ZMod d :=
    (RingHom.snd (ZMod b) (ZMod d)).comp e.toRingHom
  have ha_d : Units.map fd.toMonoidHom a = a_d :=
    congrArg (fun f : ZMod (b * d) →+* ZMod d => Units.map f.toMonoidHom a)
      (RingHom.ext_zmod _ _)
  let ub : (ZMod b)ˣ := (ZMod.unitOfCoprime d hcop.symm)⁻¹
  have hinv : IsUnit ((b : ZMod d)⁻¹) := ((ZMod.unitOfCoprime b hcop)⁻¹).isUnit
  have hhprod : IsUnit ((h₁ : ZMod d) * (h₂ : ZMod d) * (h₃ : ZMod d)) := by
    simpa only [Int.cast_mul] using
      (ZMod.coe_int_isUnit_iff_isCoprime (h₁ * h₂ * h₃) d).2
        (Int.isCoprime_iff_gcd_eq_one.2 hdH)
  obtain ⟨hh₁₂, hh₃⟩ := IsUnit.mul_iff.mp hhprod
  obtain ⟨hh₁, hh₂⟩ := IsUnit.mul_iff.mp hh₁₂
  have hbad := typeIIICompleteFiberSum_squarefree_degenerate_bounds
    b hbsq h₁ h₂ h₃ hbH 1
  have hbad_eq :
      typeIIICompleteFiberSum b ((d : ZMod b)⁻¹ * (h₁ : ZMod b))
        ((d : ZMod b)⁻¹ * (h₂ : ZMod b)) ((d : ZMod b)⁻¹ * (h₃ : ZMod b))
        (Units.map fb.toMonoidHom a) =
      typeIIICompleteFiberSum b (h₁ : ZMod b) (h₂ : ZMod b) (h₃ : ZMod b) 1 :=
    hbad.2 (Units.map fb.toMonoidHom a) ub ub ub
  have hgood_eq :
      typeIIICompleteFiberSum d ((b : ZMod d)⁻¹ * (h₁ : ZMod d))
        ((b : ZMod d)⁻¹ * (h₂ : ZMod d)) ((b : ZMod d)⁻¹ * (h₃ : ZMod d)) a_d =
      normalizedKloosterman3Mod d c := by
    rw [typeIIICompleteFiberSum_eq_normalizedKloosterman3Mod d _ _ _ a_d
      (hinv.mul hh₁) (hinv.mul hh₂) (hinv.mul hh₃)]
    congr 1
    dsimp only [c]
    ring
  dsimp only [e, fb, fd] at ha_d hbad_eq
  refine ⟨?_, ?_, ?_⟩
  · simpa only [map_intCast, Prod.fst_intCast, Prod.snd_intCast, ha_d,
      hbad_eq, hgood_eq] using!
      typeIIICompleteFiberSum_coprime_crt b d hcop
        (h₁ : ZMod (b * d)) (h₂ : ZMod (b * d)) (h₃ : ZMod (b * d)) a
  · exact (((a_d.isUnit.mul hh₁).mul hh₂).mul hh₃).mul (hinv.pow 3)
  · simpa only [hg₁, hg₂, hg₃] using hbad.1

open Classical in
theorem typeIIICompleteFiberSum_good_bad_uniform_bound_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (ε : ℝ) (hε : 0 < ε) :
    ∃ C : ℝ, 0 < C ∧ ∀ (q : ℕ) [NeZero q], Squarefree q →
      ∀ (h₁ h₂ h₃ : ℤ) (a : (ZMod q)ˣ),
        let b := Int.gcd (h₁ * h₂ * h₃) (q : ℤ)
        let d := q / b
        ‖typeIIICompleteFiberSum q (h₁ : ZMod q) (h₂ : ZMod q) (h₃ : ZMod q) a‖ ≤
            (3 : ℝ) ^ d.primeFactors.card *
              ((Int.gcd h₁ (q : ℤ) : ℝ) * (Int.gcd h₂ (q : ℤ) : ℝ) *
                (Int.gcd h₃ (q : ℤ) : ℝ)) / (b : ℝ) ^ 2 ∧
          ‖typeIIICompleteFiberSum q (h₁ : ZMod q) (h₂ : ZMod q) (h₃ : ZMod q) a‖ ≤
            C * (q : ℝ) ^ ε *
              ((Int.gcd h₁ (q : ℤ) : ℝ) * (Int.gcd h₂ (q : ℤ) : ℝ) *
                (Int.gcd h₃ (q : ℤ) : ℝ)) / (b : ℝ) ^ 2 := by
  obtain ⟨C, hC, hcount⟩ :=
    exists_primeFactors_power_bound (by norm_num : (1 : ℝ) ≤ 3) hε
  refine ⟨C, hC, ?_⟩
  intro q _ hq h₁ h₂ h₃ a b d
  obtain ⟨hbpos, hdpos, hbd, _, hdsq, _⟩ :=
    typeIII_squarefree_good_bad_moduli q hq h₁ h₂ h₃
  let _ : NeZero b := ⟨hbpos.ne'⟩
  let _ : NeZero d := ⟨hdpos.ne'⟩
  have hfamily (n : ℕ) [NeZero n] (hn : b * d = n) :
      ∀ a₀ : (ZMod n)ˣ,
        ‖typeIIICompleteFiberSum n (h₁ : ZMod n) (h₂ : ZMod n) (h₃ : ZMod n) a₀‖ ≤
          (3 : ℝ) ^ d.primeFactors.card *
            ((Int.gcd h₁ (n : ℤ) : ℝ) * (Int.gcd h₂ (n : ℤ) : ℝ) *
              (Int.gcd h₃ (n : ℤ) : ℝ)) / (b : ℝ) ^ 2 := by
    subst n
    intro a₀
    obtain ⟨heq, _, hbad⟩ :=
      typeIIICompleteFiberSum_good_bad_factorization b d (hbd.symm ▸ hq)
        h₁ h₂ h₃ (by rw [hbd]) a₀
    rw [heq, norm_mul, mul_div_assoc, mul_comm ((3 : ℝ) ^ d.primeFactors.card)]
    exact mul_le_mul hbad
      (normalizedKloosterman3Mod_squarefree_pointwise_bound_of_deligne
        hDeligne d hdsq _) (norm_nonneg _) (by positivity)
  have hfirst := hfamily q hbd a
  have hsubpower : (3 : ℝ) ^ d.primeFactors.card ≤ C * (q : ℝ) ^ ε :=
    (hcount d hdpos.ne').trans
      (mul_le_mul_of_nonneg_left
        (Real.rpow_le_rpow (Nat.cast_nonneg d)
          (Nat.cast_le.mpr (Nat.div_le_self q b)) hε.le) hC.le)
  refine ⟨hfirst, hfirst.trans ?_⟩
  exact div_le_div_of_nonneg_right
    (mul_le_mul_of_nonneg_right hsubpower (by positivity)) (sq_nonneg (b : ℝ))

section
open UniqueFactorizationMonoid

theorem typeIII_signed_supported_prime_part
    (q : ℕ) (hq : Squarefree q) (h : ℤ) (hh : h ≠ 0) :
    let B : ℕ := ∏ p ∈ q.primeFactors, p ^ (h.natAbs.factorization p)
    let ℓ : ℤ := h / (B : ℤ)
    0 < B ∧ (B : ℤ) * ℓ = h ∧ ℓ ≠ 0 ∧
      Int.sign ℓ = Int.sign h ∧ Int.gcd ℓ (q : ℤ) = 1 ∧
      B ∈ Nat.factoredNumbers q.primeFactors ∧
      (radical B : ℕ) = Int.gcd h (q : ℤ) ∧
      h.natAbs = B * ℓ.natAbs ∧
      (∀ T : ℝ, (h.natAbs : ℝ) ≤ T ↔ (ℓ.natAbs : ℝ) ≤ T / (B : ℝ)) := by
  intro B ℓ
  obtain ⟨hB, hBd, hBp, hcop, _⟩ :=
    primeFactors_prod_pow_factorization_dvd_and_coprime_div q h.natAbs
      hq.ne_zero (Int.natAbs_ne_zero.mpr hh)
  have hdiv : (B : ℤ) ∣ h := Int.natCast_dvd.mpr hBd
  have hrec : (B : ℤ) * ℓ = h := Int.mul_ediv_cancel' hdiv
  have hℓ : ℓ ≠ 0 := right_ne_zero_of_mul (hrec.symm ▸ hh)
  have hsign : Int.sign ℓ = Int.sign h := by
    rw [← hrec, Int.sign_mul, Int.sign_natCast_of_ne_zero hB.ne', one_mul]
  have hℓq : Int.gcd ℓ (q : ℤ) = 1 := by
    simpa only [ℓ, Int.gcd_def, Int.natAbs_natCast, Int.natAbs_ediv_of_dvd hdiv] using hcop
  have hmem : B ∈ Nat.factoredNumbers q.primeFactors := by
    apply Nat.mem_factoredNumbers_of_primeFactors_subset hB.ne'
    rw [hBp]
    exact Finset.inter_subset_right
  have hrad : (radical B : ℕ) = Int.gcd h (q : ℤ) := by
    rw [Nat.radical_eq_prod_primeFactors, hBp, Int.gcd_def, Int.natAbs_natCast,
      ← Nat.primeFactors_gcd (Int.natAbs_ne_zero.mpr hh) hq.ne_zero]
    exact Nat.prod_primeFactors_of_squarefree
      (hq.squarefree_of_dvd (Nat.gcd_dvd_right _ _))
  have habs : h.natAbs = B * ℓ.natAbs := by
    simpa only [Int.natAbs_mul, Int.natAbs_natCast] using congrArg Int.natAbs hrec.symm
  refine ⟨hB, hrec, hℓ, hsign, hℓq, hmem, hrad, habs, ?_⟩
  intro T
  have hBR : (0 : ℝ) < B := by exact_mod_cast hB
  rw [le_div_iff₀' hBR, habs, Nat.cast_mul]

theorem typeIII_full_supported_frequency_fiber_kl3
    (b d b₁ b₂ b₃ : ℕ) [NeZero b] [NeZero d]
    (hbd : Squarefree (b * d))
    (hb₁ : 0 < b₁) (hb₂ : 0 < b₂) (hb₃ : 0 < b₃)
    (hb : b = (radical (b₁ * b₂ * b₃) : ℕ))
    (S : Finset (ℤ × ℤ × ℤ)) (c : ℤ × ℤ × ℤ → ℂ)
    (a : (ZMod (b * d))ˣ) :
    let W : ℤ → ℕ := fun h =>
      ∏ p ∈ (b * d).primeFactors, p ^ (h.natAbs.factorization p)
    let F : Finset (ℤ × ℤ × ℤ) := S.filter (fun h =>
      h.1 * h.2.1 * h.2.2 ≠ 0 ∧ W h.1 = b₁ ∧ W h.2.1 = b₂ ∧ W h.2.2 = b₃)
    let L : Finset (ℤ × ℤ × ℤ) := F.image (fun h =>
      (h.1 / (b₁ : ℤ), h.2.1 / (b₂ : ℤ), h.2.2 / (b₃ : ℤ)))
    let rebuild : ℤ × ℤ × ℤ → ℤ × ℤ × ℤ := fun ℓ =>
      ((b₁ : ℤ) * ℓ.1, (b₂ : ℤ) * ℓ.2.1, (b₃ : ℤ) * ℓ.2.2)
    let a_d : (ZMod d)ˣ :=
      Units.map ((ZMod.castHom (Nat.dvd_mul_left d b) (ZMod d)).toMonoidHom) a
    let good : ℤ × ℤ × ℤ → ZMod d := fun ℓ =>
      (a_d : ZMod d) * ((b₁ * b₂ * b₃ : ℕ) : ZMod d) *
        ((ℓ.1 * ℓ.2.1 * ℓ.2.2 : ℤ) : ZMod d) * ((b : ZMod d)⁻¹) ^ 3
    let bad : ℂ := typeIIICompleteFiberSum b
      (b₁ : ZMod b) (b₂ : ZMod b) (b₃ : ZMod b) 1
    (∀ ℓ : ℤ × ℤ × ℤ, ℓ ∈ L ↔
      rebuild ℓ ∈ S ∧ ℓ.1 * ℓ.2.1 * ℓ.2.2 ≠ 0 ∧
        Int.gcd (ℓ.1 * ℓ.2.1 * ℓ.2.2) ((b * d : ℕ) : ℤ) = 1) ∧
      (∑ h ∈ F, c h * typeIIICompleteFiberSum (b * d)
        (h.1 : ZMod (b * d)) (h.2.1 : ZMod (b * d)) (h.2.2 : ZMod (b * d)) a) =
        bad * (∑ ℓ ∈ L, c (rebuild ℓ) * normalizedKloosterman3Mod d (good ℓ)) ∧
      (∀ ℓ ∈ L, IsUnit (good ℓ)) ∧
      ‖bad‖ ≤ (((radical b₁ : ℕ) : ℝ) * ((radical b₂ : ℕ) : ℝ) *
        ((radical b₃ : ℕ) : ℝ)) / (b : ℝ) ^ 2 := by
  intro W F L rebuild a_d good bad
  let P : ℕ := b₁ * b₂ * b₃
  have hP : 0 < P := by positivity
  have hb₁d : b₁ ∣ P := dvd_mul_of_dvd_left (dvd_mul_right b₁ b₂) b₃
  have hb₂d : b₂ ∣ P := dvd_mul_of_dvd_left (dvd_mul_left b₂ b₁) b₃
  have hb₃d : b₃ ∣ P := dvd_mul_left b₃ (b₁ * b₂)
  have hB₁ : (b₁ : ℤ) ≠ 0 := by positivity
  have hB₂ : (b₂ : ℤ) ≠ 0 := by positivity
  have hB₃ : (b₃ : ℤ) ≠ 0 := by positivity
  have hsupport (n : ℕ) (hn : n ∣ P) :
      n.primeFactors ⊆ (b * d).primeFactors := by
    have hpb : P.primeFactors = b.primeFactors := by
      rw [hb, Nat.primeFactors_radical]
    apply (Nat.primeFactors_mono hn hP.ne').trans
    rw [hpb]
    exact Nat.primeFactors_mono (Nat.dvd_mul_right b d) hbd.ne_zero
  have hbase (n : ℕ) (hn : 0 < n) (hnd : n ∣ P) : W (n : ℤ) = n := by
    simp only [W, Int.natAbs_natCast]
    calc
      _ = ∏ p ∈ n.primeFactors, p ^ n.factorization p := by
        symm
        apply Finset.prod_subset (hsupport n hnd)
        intro p _ hpn
        have hp0 : n.factorization p = 0 := Finsupp.notMem_support_iff.mp
          (by simpa only [Nat.support_factorization] using hpn)
        simp only [hp0, pow_zero]
      _ = n := (Nat.prod_primeFactors_pow_factorization hn.ne').symm
  have hquot (x : ℤ) (hx : x ≠ 0) (n : ℕ) (hn : W x = n) :
      (n : ℤ) * (x / (n : ℤ)) = x ∧ x / (n : ℤ) ≠ 0 ∧
        Int.gcd (x / (n : ℤ)) ((b * d : ℕ) : ℤ) = 1 ∧
        (radical n : ℕ) = Int.gcd x ((b * d : ℕ) : ℤ) := by
    subst n
    obtain ⟨_, hr, hz, _, hg, _, hrad, _, _⟩ :=
      typeIII_signed_supported_prime_part (b * d) hbd x hx
    exact ⟨hr, hz, hg, hrad⟩
  have hcop_iff (v : ℤ × ℤ × ℤ) :
      Int.gcd (v.1 * v.2.1 * v.2.2) ((b * d : ℕ) : ℤ) = 1 ↔
        Int.gcd v.1 ((b * d : ℕ) : ℤ) = 1 ∧
          Int.gcd v.2.1 ((b * d : ℕ) : ℤ) = 1 ∧
            Int.gcd v.2.2 ((b * d : ℕ) : ℤ) = 1 := by
    simp only [← Int.isCoprime_iff_gcd_eq_one, IsCoprime.mul_left_iff, and_assoc]
  have hWmul (n : ℕ) (hn : 0 < n) (hnd : n ∣ P) (z : ℤ) (hz : z ≠ 0)
      (hzg : Int.gcd z ((b * d : ℕ) : ℤ) = 1) : W ((n : ℤ) * z) = n := by
    have hzc : Nat.Coprime z.natAbs (b * d) := by
      simpa only [Int.gcd_def, Int.natAbs_natCast] using hzg
    obtain ⟨_, _, _, _, hinv⟩ :=
      primeFactors_prod_pow_factorization_dvd_and_coprime_div (b * d) n
        hbd.ne_zero hn.ne'
    simpa only [W, Int.natAbs_mul, Int.natAbs_natCast, mul_comm] using
      (hinv z.natAbs (Int.natAbs_ne_zero.mpr hz) hzc).trans (hbase n hn hnd)
  let Q : ℤ × ℤ × ℤ → ℤ × ℤ × ℤ := fun h =>
    (h.1 / (b₁ : ℤ), h.2.1 / (b₂ : ℤ), h.2.2 / (b₃ : ℤ))
  have hQrebuild (v : ℤ × ℤ × ℤ) : Q (rebuild v) = v :=
    Prod.ext (Int.mul_ediv_cancel_left v.1 hB₁)
      (Prod.ext (Int.mul_ediv_cancel_left v.2.1 hB₂)
        (Int.mul_ediv_cancel_left v.2.2 hB₃))
  have hFdata (h : ℤ × ℤ × ℤ) (hh : h ∈ F) :
      rebuild (Q h) = h ∧ (Q h).1 * (Q h).2.1 * (Q h).2.2 ≠ 0 ∧
        Int.gcd ((Q h).1 * (Q h).2.1 * (Q h).2.2) ((b * d : ℕ) : ℤ) = 1 := by
    obtain ⟨_, hprod, hw₁, hw₂, hw₃⟩ := Finset.mem_filter.mp hh
    have hz : h.1 ≠ 0 ∧ h.2.1 ≠ 0 ∧ h.2.2 ≠ 0 := by
      simpa only [mul_ne_zero_iff, and_assoc] using hprod
    obtain ⟨hr₁, hz₁, hg₁, _⟩ := hquot h.1 hz.1 b₁ hw₁
    obtain ⟨hr₂, hz₂, hg₂, _⟩ := hquot h.2.1 hz.2.1 b₂ hw₂
    obtain ⟨hr₃, hz₃, hg₃, _⟩ := hquot h.2.2 hz.2.2 b₃ hw₃
    exact ⟨Prod.ext hr₁ (Prod.ext hr₂ hr₃), mul_ne_zero (mul_ne_zero hz₁ hz₂) hz₃,
      (hcop_iff (Q h)).2 ⟨hg₁, hg₂, hg₃⟩⟩
  have hL (v : ℤ × ℤ × ℤ) : v ∈ L ↔
      rebuild v ∈ S ∧ v.1 * v.2.1 * v.2.2 ≠ 0 ∧
        Int.gcd (v.1 * v.2.1 * v.2.2) ((b * d : ℕ) : ℤ) = 1 := by
    constructor
    · intro hv
      change v ∈ F.image Q at hv
      obtain ⟨h, hh, rfl⟩ := Finset.mem_image.mp hv
      obtain ⟨hr, hz, hg⟩ := hFdata h hh
      refine ⟨?_, hz, hg⟩
      simpa only [hr] using (Finset.mem_filter.mp hh).1
    · rintro ⟨hvS, hprod, hg⟩
      have hz : v.1 ≠ 0 ∧ v.2.1 ≠ 0 ∧ v.2.2 ≠ 0 := by
        simpa only [mul_ne_zero_iff, and_assoc] using hprod
      obtain ⟨hg₁, hg₂, hg₃⟩ := (hcop_iff v).mp hg
      have hvF : rebuild v ∈ F := by
        refine Finset.mem_filter.mpr ⟨hvS, ?_,
          hWmul b₁ hb₁ hb₁d v.1 hz.1 hg₁,
          hWmul b₂ hb₂ hb₂d v.2.1 hz.2.1 hg₂,
          hWmul b₃ hb₃ hb₃d v.2.2 hz.2.2 hg₃⟩
        exact mul_ne_zero
          (mul_ne_zero (mul_ne_zero hB₁ hz.1) (mul_ne_zero hB₂ hz.2.1))
          (mul_ne_zero hB₃ hz.2.2)
      exact Finset.mem_image.mpr ⟨rebuild v, hvF, hQrebuild v⟩
  have hrad (n : ℕ) (hn : 0 < n) (hnd : n ∣ P) :
      (radical n : ℕ) = Int.gcd (n : ℤ) ((b * d : ℕ) : ℤ) :=
    (hquot (n : ℤ) (Int.natCast_ne_zero.mpr hn.ne') n (hbase n hn hnd)).2.2.2
  have hbnat : b = Int.gcd (P : ℤ) ((b * d : ℕ) : ℤ) :=
    hb.trans (hrad P hP dvd_rfl)
  have hbcanon : b = Int.gcd ((b₁ : ℤ) * (b₂ : ℤ) * (b₃ : ℤ))
      ((b * d : ℕ) : ℤ) := by
    simpa only [P, Nat.cast_mul] using hbnat
  have hbDivP : b ∣ P := by
    rw [hb]
    exact radical_dvd_self
  have hbdiv : (b : ℤ) ∣ (b₁ : ℤ) * (b₂ : ℤ) * (b₃ : ℤ) := by
    exact_mod_cast (show b ∣ b₁ * b₂ * b₃ from hbDivP)
  have hbq : (b : ℤ) ∣ ((b * d : ℕ) : ℤ) :=
    Int.natCast_dvd_natCast.mpr (Nat.dvd_mul_right b d)
  have hbad := typeIIICompleteFiberSum_squarefree_degenerate_bounds b hbd.of_mul_left
    (b₁ : ℤ) (b₂ : ℤ) (b₃ : ℤ) hbdiv 1
  have hbad_bound : ‖bad‖ ≤
      (((radical b₁ : ℕ) : ℝ) * ((radical b₂ : ℕ) : ℝ) *
        ((radical b₃ : ℕ) : ℝ)) / (b : ℝ) ^ 2 := by
    have hn := (typeIIICompleteFiberSum_good_bad_factorization b d hbd
      (b₁ : ℤ) (b₂ : ℤ) (b₃ : ℤ) hbcanon 1).2.2
    simpa only [bad, Int.cast_natCast, ← hrad b₁ hb₁ hb₁d,
      ← hrad b₂ hb₂ hb₂d, ← hrad b₃ hb₃ hb₃d] using hn
  have hterm (v : ℤ × ℤ × ℤ) (hv : v ∈ L) :
      typeIIICompleteFiberSum (b * d)
        ((rebuild v).1 : ZMod (b * d)) ((rebuild v).2.1 : ZMod (b * d))
        ((rebuild v).2.2 : ZMod (b * d)) a =
          bad * normalizedKloosterman3Mod d (good v) ∧ IsUnit (good v) := by
    have hg := ((hL v).mp hv).2.2
    have hp : (rebuild v).1 * (rebuild v).2.1 * (rebuild v).2.2 =
        (P : ℤ) * (v.1 * v.2.1 * v.2.2) := by
      dsimp only [rebuild, P]
      push_cast
      ring
    have hcanon : b = Int.gcd ((rebuild v).1 * (rebuild v).2.1 * (rebuild v).2.2)
        ((b * d : ℕ) : ℤ) := by
      rw [hp, Int.gcd_mul_left_left_of_gcd_eq_one hg]
      exact hbnat
    obtain ⟨hf, hu, _⟩ := typeIIICompleteFiberSum_good_bad_factorization b d hbd
      (rebuild v).1 (rebuild v).2.1 (rebuild v).2.2 hcanon a
    obtain ⟨hg₁, hg₂, hg₃⟩ := (hcop_iff v).mp hg
    have hunit (z : ℤ) (hz : Int.gcd z ((b * d : ℕ) : ℤ) = 1) :
        IsCoprime z (b : ℤ) :=
      (Int.isCoprime_iff_gcd_eq_one.mpr hz).of_isCoprime_of_dvd_right hbq
    let u₁ : (ZMod b)ˣ := ZMod.unitOfIsCoprime v.1 (hunit v.1 hg₁)
    let u₂ : (ZMod b)ˣ := ZMod.unitOfIsCoprime v.2.1 (hunit v.2.1 hg₂)
    let u₃ : (ZMod b)ˣ := ZMod.unitOfIsCoprime v.2.2 (hunit v.2.2 hg₃)
    have hbeq : typeIIICompleteFiberSum b ((rebuild v).1 : ZMod b)
        ((rebuild v).2.1 : ZMod b) ((rebuild v).2.2 : ZMod b) 1 = bad := by
      simpa only [bad, rebuild, u₁, u₂, u₃, ZMod.coe_unitOfIsCoprime,
        Int.cast_mul, Int.cast_natCast, mul_comm] using hbad.2 1 u₁ u₂ u₃
    have harg : (a_d : ZMod d) * ((rebuild v).1 : ZMod d) *
        ((rebuild v).2.1 : ZMod d) * ((rebuild v).2.2 : ZMod d) *
          ((b : ZMod d)⁻¹) ^ 3 = good v := by
      dsimp only [good, rebuild]
      push_cast
      ring
    rw [hbeq, harg] at hf
    rw [harg] at hu
    exact ⟨hf, hu⟩
  have hinj : Set.InjOn Q F := by
    intro x hx y hy hxy
    exact (hFdata x hx).1.symm.trans
      ((congrArg rebuild hxy).trans (hFdata y hy).1)
  refine ⟨hL, ?_, fun v hv => (hterm v hv).2, hbad_bound⟩
  calc
    _ = ∑ v ∈ L, c (rebuild v) * typeIIICompleteFiberSum (b * d)
        ((rebuild v).1 : ZMod (b * d)) ((rebuild v).2.1 : ZMod (b * d))
        ((rebuild v).2.2 : ZMod (b * d)) a := by
      rw [Finset.sum_image hinj]
      apply Finset.sum_congr rfl
      intro h hh
      rw [(hFdata h hh).1]
    _ = bad * (∑ v ∈ L, c (rebuild v) * normalizedKloosterman3Mod d (good v)) := by
      rw [Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro v hv
      rw [(hterm v hv).1]
      ring

theorem typeIII_signed_product_regrouped_kl3_bound
    (b : ℕ+) (b₁ b₂ b₃ : ℕ) (D : Finset ℕ+) (M : Finset ℤ)
    (η : ℕ → ℂ) (α : ℤ → ℂ)
    (a : ∀ d : ℕ+, (ZMod ((b : ℕ) * (d : ℕ)))ˣ)
    (S : Finset (ℤ × ℤ × ℤ)) (c : ℤ × ℤ × ℤ → ℂ)
    (hS : ∀ ℓ ∈ S, ℓ.1 * ℓ.2.1 * ℓ.2.2 ≠ 0) :
    let P : ℤ × ℤ × ℤ → ℤ := fun ℓ => ℓ.1 * ℓ.2.1 * ℓ.2.2
    let A : ∀ d : ℕ+, (ZMod (d : ℕ))ˣ := fun d =>
      Units.map ((ZMod.castHom (Nat.dvd_mul_left (d : ℕ) (b : ℕ))
        (ZMod (d : ℕ))).toMonoidHom) (a d)
    let K : ℤ → ℂ := fun ℓ =>
      ∑ d ∈ D, if Int.gcd (((b : ℕ) : ℤ) * ℓ) ((d : ℕ) : ℤ) = 1 then
        η ((b : ℕ) * (d : ℕ)) *
          ∑ m ∈ M, if Int.gcd m (((b : ℕ) * (d : ℕ) : ℕ) : ℤ) = 1 then
            α m * normalizedKloosterman3Mod (d : ℕ)
              ((A d : ZMod (d : ℕ)) * ((b₁ * b₂ * b₃ : ℕ) : ZMod (d : ℕ)) *
                (ℓ : ZMod (d : ℕ)) * (m : ZMod (d : ℕ))⁻¹ *
                (((b : ℕ) : ZMod (d : ℕ))⁻¹) ^ 3)
          else 0
      else 0
    let κ : ℤ → ℂ := fun ℓ => ∑ v ∈ S.filter (fun v => P v = ℓ), c v
    let W : ℝ := ((S.sup (fun v => ‖c v‖₊) : ℝ≥0) : ℝ)
    let τ₃ : ℤ → ℕ := fun ℓ =>
      ((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 3) ℓ.natAbs
    (∑ v ∈ S, c v * K (P v)) = (∑ ℓ ∈ S.image P, κ ℓ * K ℓ) ∧
      (∀ ℓ : ℤ, ‖κ ℓ‖ ≤ 4 * W * (τ₃ ℓ : ℝ)) ∧
      ‖∑ v ∈ S, c v * K (P v)‖ ≤
        4 * W * (∑ ℓ ∈ S.image P, (τ₃ ℓ : ℝ) * ‖K ℓ‖) := by
  intro P A K κ W τ₃
  have hfold (z : ℤ) (f : ℕ → ℕ) :
      (∑ p ∈ z.divisorsAntidiag, f p.2.natAbs) =
        2 * ∑ p ∈ z.natAbs.divisorsAntidiagonal, f p.2 := by
    obtain ⟨n, rfl | rfl⟩ := Int.eq_nat_or_neg z
    · rw [Int.divisorsAntidiag_natCast, Finset.sum_disjUnion]
      simp [two_mul]
    · rw [Int.divisorsAntidiag_neg_natCast, Finset.sum_disjUnion]
      simp [two_mul]
  have hcard (z : ℤ) :
      z.divisorsAntidiag.card = 2 * z.natAbs.divisorsAntidiagonal.card := by
    simpa using hfold z (fun _ => 1)
  have hnat (n : ℕ) :
      n.divisorsAntidiagonal.card = (ArithmeticFunction.zeta ^ 2) n := by
    rw [← Nat.map_div_left_divisors, Finset.card_map,
      ← ArithmeticFunction.sigma_zero_apply, ← ArithmeticFunction.zeta_mul_pow_eq_sigma,
      ArithmeticFunction.pow_zero_eq_zeta, pow_two]
  have hcount (ℓ : ℤ) :
      (S.filter (fun v => P v = ℓ)).card ≤ 4 * τ₃ ℓ := by
    calc
      _ ≤ (ℓ.divisorsAntidiag.sigma (fun p => p.2.divisorsAntidiag)).card := by
        apply Finset.card_le_card_of_injOn
          (fun v : ℤ × ℤ × ℤ =>
            (⟨(v.1, v.2.1 * v.2.2), v.2⟩ : Σ _ : ℤ × ℤ, ℤ × ℤ))
        · intro v hv
          obtain ⟨hv, hvℓ⟩ := Finset.mem_filter.mp hv
          have hp : v.1 * (v.2.1 * v.2.2) = ℓ := by
            simpa only [P, mul_assoc] using hvℓ
          have hn : v.1 * (v.2.1 * v.2.2) ≠ 0 := by
            simpa only [mul_assoc] using hS v hv
          exact Finset.mem_sigma.mpr
            ⟨Int.mem_divisorsAntidiag.mpr ⟨hp, hp ▸ hn⟩,
              Int.mem_divisorsAntidiag.mpr ⟨rfl, right_ne_zero_of_mul hn⟩⟩
        · intro v _ w _ h
          exact Prod.ext
            (congrArg (fun x : Σ _ : ℤ × ℤ, ℤ × ℤ => x.1.1) h)
            (congrArg (fun x : Σ _ : ℤ × ℤ, ℤ × ℤ => x.2) h)
      _ = _ := by
        rw [Finset.card_sigma]
        simp_rw [hcard]
        rw [← Finset.mul_sum, hfold ℓ (fun n : ℕ => n.divisorsAntidiagonal.card)]
        simp_rw [hnat]
        rw [← Nat.map_div_left_divisors, Finset.sum_map]
        change 2 * (2 * (∑ d ∈ ℓ.natAbs.divisors,
          (ArithmeticFunction.zeta ^ 2) d)) =
            4 * (ArithmeticFunction.zeta ^ 3) ℓ.natAbs
        rw [pow_succ' (ArithmeticFunction.zeta : ArithmeticFunction ℕ) 2,
          ArithmeticFunction.zeta_mul_apply]
        omega
  have hregroup : (∑ v ∈ S, c v * K (P v)) =
      ∑ ℓ ∈ S.image P, κ ℓ * K ℓ := by
    symm
    apply Finset.sum_image' (fun v => c v * K (P v))
    intro v _
    dsimp only [κ]
    rw [Finset.sum_mul]
    refine Finset.sum_congr rfl ?_
    intro w hw
    rw [(Finset.mem_filter.mp hw).2]
  have hW : 0 ≤ W := NNReal.coe_nonneg _
  have hc (v : ℤ × ℤ × ℤ) (hv : v ∈ S) : ‖c v‖ ≤ W :=
    NNReal.coe_le_coe.mpr (Finset.le_sup (f := fun v => ‖c v‖₊) hv)
  have hκ (ℓ : ℤ) : ‖κ ℓ‖ ≤ 4 * W * (τ₃ ℓ : ℝ) := by
    calc
      ‖κ ℓ‖ ≤ ∑ v ∈ S.filter (fun v => P v = ℓ), W :=
        norm_sum_le_of_le _ fun v hv => hc v (Finset.mem_filter.mp hv).1
      _ = ((S.filter (fun v => P v = ℓ)).card : ℝ) * W := by simp
      _ ≤ ((4 * τ₃ ℓ : ℕ) : ℝ) * W :=
        mul_le_mul_of_nonneg_right (by exact_mod_cast hcount ℓ) hW
      _ = 4 * W * (τ₃ ℓ : ℝ) := by push_cast; ring
  refine ⟨hregroup, hκ, ?_⟩
  rw [hregroup]
  calc
    ‖∑ ℓ ∈ S.image P, κ ℓ * K ℓ‖ ≤
        ∑ ℓ ∈ S.image P, (4 * W * (τ₃ ℓ : ℝ)) * ‖K ℓ‖ := by
      refine norm_sum_le_of_le _ fun ℓ _ => ?_
      rw [norm_mul]
      exact mul_le_mul_of_nonneg_right (hκ ℓ) (norm_nonneg _)
    _ = 4 * W * (∑ ℓ ∈ S.image P, (τ₃ ℓ : ℝ) * ‖K ℓ‖) := by
      simp only [Finset.mul_sum, mul_assoc]

end

section
open scoped ContDiff
open Classical in
theorem sourceTerminalSigma5_retreated_bound_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    («ω» δ ε cD CD cN CN c₀ : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε)
    (hcD : 0 < cD) (hCD : cD ≤ CD) (hcN : 0 < cN) (hCN : cN ≤ CN)
    (hc₀ : 0 < c₀)
    (CX CR CQ CΔlo CΔhi Cm CΛ Cw Cκ cₘ : ℝ)
    (hCX : 1 ≤ CX) (hCR : 1 ≤ CR) (hCQ : 1 ≤ CQ)
    (hCΔlo : 1 ≤ CΔlo) (hCΔhi : 1 ≤ CΔhi) (hCm : 1 ≤ Cm)
    (hCΛ : 1 ≤ CΛ) (hCw : 1 ≤ Cw) (hCκ : 1 ≤ Cκ) (hcₘ : 0 < cₘ)
    (Cφ Eφ Cψ Eψ : ℕ → ℝ)
    (hCφ : ∀ r : ℕ, 0 ≤ Cφ r) (hCψ : ∀ r : ℕ, 0 ≤ Cψ r) :
    ∃ Csum X₀ : ℝ, 0 < Csum ∧ Real.exp 1 ≤ X₀ ∧
      ∀ (x : ℝ), X₀ ≤ x →
      ∀ (m q₀ c₁ c₂ w₁ w₂ z₁ gV : ℕ) (hm : Squarefree m),
      q₀ ∣ m → c₁ ∣ m → c₂ ∣ m → 0 < gV →
      0 < w₁ → Squarefree w₁ → 0 < z₁ → w₁ ∣ z₁ → Nat.Coprime z₁ m →
      ∀ (M N R₀ Q Hscale Δ₁ Λ κ γ : ℝ),
      0 < M → 0 < R₀ → 0 < Q → 1 ≤ Hscale → 0 < Δ₁ → Λ ≠ 0 → 1 ≤ κ →
      N = x ^ γ →
      max ((1 / 4 : ℝ) + 12 * «ω» + 4 * δ + 100 * ε)
        (32 * «ω» + 10 * δ + 400 * ε) ≤ γ →
      γ ≤ (1 / 2 : ℝ) - 4 * «ω» - 2 * δ - 50 * ε →
      x / CX ≤ M * N → M * N ≤ CX * x →
      N ≤ CR * x ^ (δ + 4 * ε) * R₀ →
      R₀ * Q ≤ CQ * x ^ ((1 / 2 : ℝ) + 2 * «ω» + ε) →
      Hscale = x ^ ε * R₀ * Q ^ 2 / ((q₀ : ℝ) * M) →
      κ ≤ Cκ * (q₀ : ℝ) →
      N ≤ CΔlo * x ^ (δ + 55 * ε) * Hscale ^ 2 * Δ₁ →
      Δ₁ ≤ CΔhi * N / (x ^ (55 * ε) * Hscale ^ 2) →
      cₘ * (R₀ * Q ^ 2 * Hscale) /
        ((q₀ : ℝ) * (gV : ℝ) * κ * Δ₁) ≤ (m : ℝ) →
      (m : ℝ) ≤ Cm * x ^ δ * R₀ * Q ^ 2 * Hscale /
        ((q₀ : ℝ) * (gV : ℝ) * Δ₁) →
      (w₁ : ℝ) ≤ Cw * x ^ (5 * ε) * Δ₁ →
      |Λ| ≤ CΛ * x ^ (δ + 5 * ε) * Hscale ^ 2 / ((w₁ : ℝ) * (gV : ℝ)) →
      ∀ (lam lamTilde l ℓ aPhase Bshift d₀ : ℤ),
      c₀ * x ^ (5 * ε) * Δ₁ ≤ (d₀ : ℝ) →
      (1 ≤ (lam : ℝ) / Λ ∧ (lam : ℝ) / Λ < 2) →
      (1 ≤ (lamTilde : ℝ) / Λ ∧ (lamTilde : ℝ) / Λ < 2) →
      w₂ = ∏ p ∈ m.primeFactors, p ^ (lam.natAbs.factorization p) →
      w₂ = ∏ p ∈ m.primeFactors, p ^ (lamTilde.natAbs.factorization p) →
      Int.gcd (((z₁ / w₁ : ℕ) : ℤ)) ((m : ℤ) * lam * lamTilde) = 1 →
      IsUnit (aPhase : ZMod m) →
      ∀ (E : ZMod q₀ → Finset (ZMod q₀)),
      (∀ r, (E r).card ≤ Int.gcd (q₀ : ℤ) ℓ) →
      ∀ (φ ψ : ℝ → ℂ), ContDiff ℝ ∞ φ → ContDiff ℝ ∞ ψ →
      Function.support φ ⊆ Set.Icc cD CD →
      Function.support ψ ⊆ Set.Icc cN CN →
      (∀ (r : ℕ) (t : ℝ), ‖iteratedDeriv r φ t‖ ≤ Cφ r * (Real.log x) ^ Eφ r) →
      (∀ (r : ℕ) (t : ℝ), ‖iteratedDeriv r ψ t‖ ≤ Cψ r * (Real.log x) ^ Eψ r) →
      letI : NeZero m := ⟨hm.ne_zero⟩
      let s : ℕ := z₁ / w₁
      let s₂ : ℕ := Nat.gcd w₂ m
      let g₀ : ℕ := Int.gcd (q₀ : ℤ) ℓ
      let T : ℝ := max ((s₂ : ℝ)⁻¹) Hscale⁻¹ *
        (x ^ (δ + 100 * ε) * Hscale ^ 2 * N / ((gV : ℝ) * Δ₁))
      let τ : ℕ → ℝ := fun d => ((z₁ : ℝ) * (d : ℝ) - (d₀ : ℝ)) / Δ₁
      let D : Finset ℕ :=
        (Finset.Icc 1 ⌊((d₀ : ℝ) + CD * Δ₁) / (z₁ : ℝ)⌋₊).filter
          fun d : ℕ => φ (τ d) ≠ 0
      let I : Finset ℤ := (Finset.Icc ⌈cN * N⌉ ⌊CN * N⌋).filter
        fun n : ℤ => ψ ((n : ℝ) / N) ≠ 0
      let C : ℕ → ℤ → ℂ := fun d n =>
        if (n : ZMod q₀) ∈ E (d : ZMod q₀) then 1 else 0
      let Jn : ℕ → ℤ → ℤ → ℤ := fun d n nt =>
        (lam * (nt + Bshift * (d : ℤ)) -
          lamTilde * (n + Bshift * (d : ℤ))) / (d : ℤ)
      let U₅ : ℕ → ℤ → ℤ → ℂ := fun d n nt =>
        if Int.gcd (d : ℤ) ((m : ℤ) * lam * lamTilde) = 1 ∧
            Int.gcd (n * nt) ((w₁ * c₁ : ℕ) : ℤ) = 1 ∧
            Int.gcd ((n + l * (d : ℤ)) * (nt + l * (d : ℤ))) (c₂ : ℤ) = 1 ∧
            (Int.gcd (Jn d n nt) (m : ℤ) : ℝ) ≤ T then
          C d n * C d nt *
            reciprocalUnitPhase m ((aPhase : ZMod m) * (Jn d n nt : ZMod m))
              (((n + Bshift * (d : ℤ) : ℤ) : ZMod m) *
                ((nt + Bshift * (d : ℤ) : ℤ) : ZMod m))
        else 0
      let term₅ : ℕ → ℤ → ℤ → ℂ := fun d n nt =>
        if Int.ModEq ((s * d : ℕ) : ℤ) (lam * nt) (lamTilde * n) then
          U₅ d n nt * φ (τ d) * ψ ((n : ℝ) / N) * ψ ((nt : ℝ) / N)
        else 0
      let S₅ : ℂ := ∑ d ∈ D, ∑ n ∈ I, ∑ nt ∈ I, term₅ d n nt
      let Rtarget : ℝ := max (x ^ (δ + 10 * ε) * Hscale ^ 3) (Hscale ^ 4)
      S₅ = (∑' d : ℕ, ∑' n : ℤ, ∑' nt : ℤ, term₅ d n nt) ∧
        ‖S₅‖ ≤ Csum *
          ((s₂ : ℝ) * (q₀ : ℝ) ^ 2 * (g₀ : ℝ) ^ 2 * N ^ 2 /
            (κ ^ 2 * x ^ (27 * ε) * Rtarget)) := by
  let CH : ℝ := CX * CR * CQ ^ 2
  let cDelta : ℝ := 1 / CΔlo
  let cStar : ℝ := min (1 / CΔlo) (1 / CΛ)
  let lowerM : ℝ := cₘ / CΔhi
  let B0 : ℝ := 16 * «ω» + 5 * δ + 65 * ε
  have hCH : 0 < CH := by dsimp [CH]; positivity
  have hcDelta : 0 < cDelta := by dsimp [cDelta]; positivity
  have hcStar : 0 < cStar := by dsimp [cStar]; positivity
  have hlowerM : 0 < lowerM := by dsimp [lowerM]; positivity
  have hB0 : 0 < B0 := by dsimp [B0]; positivity
  let CA : ℝ := CX * Cκ ^ 3 * max CH (CH ^ 2) / lowerM
  let CB : ℝ := Cκ ^ 2 * max (CH ^ 7) (CH ^ 8) / cStar
  let CC : ℝ := CX * Cm * Cκ ^ 2 * max (CH ^ 11) (CH ^ 12) /
    (cDelta * cStar)
  obtain ⟨hCA, hCB, hCC, hresources⟩ :=
    source_terminal_three_ratios_of_resources «ω» δ ε Cκ CH CX cDelta cStar lowerM Cm
      hω hδ hε (by positivity) (by positivity) (by positivity)
      hcDelta hcStar hlowerM (by positivity)
  change 0 < CA at hCA
  change 0 < CB at hCB
  change 0 < CC at hCC
  obtain ⟨C5, X5, hC5, hX5, hfive⟩ :=
    sourceTerminalSigma5_uniform_bound_of_deligne hDeligne «ω» δ ε B0 cD CD cN CN c₀
      hω hδ hε hB0 hcD hCD hcN hCN hc₀ CX CR CQ CΔlo CΔhi Cm CΛ Cw
      hCX hCR hCQ hCΔlo hCΔhi hCm hCΛ hCw Cφ Eφ Cψ Eψ hCφ hCψ
  obtain ⟨_, Xgcd, _, _, hgcd⟩ :=
    sourceTerminal_gcd_weight_application «ω» δ ε 1 CΛ CX CR CQ CΔlo Cm
      hω hδ hε le_rfl hCΛ hCX hCR hCQ hCΔlo hCm
  let Csum : ℝ := C5 * (CA + 2 * CB + CC) + Cκ ^ 2 * CH ^ 4
  let X₀ : ℝ := max X5 (max Xgcd (CΔhi ^ ((55 * ε)⁻¹)))
  refine ⟨Csum, X₀, by dsimp [Csum]; positivity,
    hX5.trans (le_max_left _ _), ?_⟩
  intro x hx m q₀ c₁ c₂ w₁ w₂ z₁ gV hm hq₀ hc₁ hc₂ hgV
    hw₁ hw₁sq hz₁ hwz hzm M N R₀ Q Hscale Δ₁ Λ κ γ
    hM hR₀ hQ hHscale hΔ₁ hΛ hκ hNγ hγlo hγhi hMNlo hMNhi hNR hRQ
    hHdef hκbound hΔlower hΔupper hmlower hmupper hwupper hΛupper
    lam lamTilde l ℓ aPhase Bshift d₀ hd₀ hlam hlamTilde hw₂ hw₂Tilde
    hprimitive hA E hE φ ψ hφ hψ hsφ hsψ hbφ hbψ
    s s₂ g₀ T τ D I C Jn U₅ term₅ S₅ Rtarget
  have hx5 : X5 ≤ x := (le_max_left _ _).trans hx
  have hxgcd : Xgcd ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans hx)
  have hxcap : CΔhi ^ ((55 * ε)⁻¹) ≤ x :=
    (le_max_right _ _).trans ((le_max_right _ _).trans hx)
  have hx1 : 1 ≤ x :=
    (Real.one_lt_exp_iff.mpr zero_lt_one).le.trans (hX5.trans hx5)
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hpow (a : ℝ) : 0 < x ^ a := Real.rpow_pos_of_pos hx0 a
  have hγfirst : (1 / 4 : ℝ) + 12 * «ω» + 4 * δ + 100 * ε ≤ γ :=
    (le_max_left _ _).trans hγlo
  have hγpos : 0 < γ := by linarith only [hγfirst, hω, hδ, hε]
  have hγone : γ ≤ 1 := by linarith only [hγhi, hω, hδ, hε]
  have hN : 0 < N := hNγ.symm ▸ hpow γ
  have hNone : 1 ≤ N := hNγ.symm ▸ Real.one_le_rpow hx1 hγpos.le
  have hmpos : 0 < m := Nat.pos_of_ne_zero hm.ne_zero
  have hmreal : 0 < (m : ℝ) := by exact_mod_cast hmpos
  have hqpos : 0 < q₀ := Nat.pos_of_dvd_of_pos hq₀ hmpos
  have hqone : (1 : ℝ) ≤ (q₀ : ℝ) := by exact_mod_cast hqpos
  have hqreal : 0 < (q₀ : ℝ) := by positivity
  have hgone : (1 : ℝ) ≤ (gV : ℝ) := by exact_mod_cast hgV
  have hgreal : 0 < (gV : ℝ) := by positivity
  have hwone : (1 : ℝ) ≤ (w₁ : ℝ) := by exact_mod_cast hw₁
  have hw₂pos : 0 < w₂ := by
    rw [hw₂]
    exact Finset.prod_pos fun p hp =>
      pow_pos (Nat.prime_of_mem_primeFactors hp).pos _
  have hs₂pos : 0 < s₂ := Nat.gcd_pos_of_pos_right w₂ hmpos
  have hs₂one : (1 : ℝ) ≤ (s₂ : ℝ) := by exact_mod_cast hs₂pos
  have hs₂real : 0 < (s₂ : ℝ) := by positivity
  have hg₀pos : 0 < g₀ :=
    Int.gcd_pos_of_ne_zero_left ℓ (by exact_mod_cast hqpos.ne')
  have hg₀one : (1 : ℝ) ≤ (g₀ : ℝ) := by exact_mod_cast hg₀pos
  have hg₀real : 0 < (g₀ : ℝ) := by positivity
  have hHpos : 0 < Hscale := zero_lt_one.trans_le hHscale
  have hκpos : 0 < κ := zero_lt_one.trans_le hκ
  have hΛpos : 0 < |Λ| := abs_pos.mpr hΛ
  let Δstar : ℝ := min (N / (|Λ| * x ^ (5 * ε))) Δ₁
  have hΔstar : 0 < Δstar := by dsimp [Δstar]; positivity
  have hHbound : Hscale ≤ CH * x ^ (4 * «ω» + δ + 7 * ε) / (q₀ : ℝ) :=
    (hgcd x hxgcd m q₀ gV w₁ w₂ z₁
      hm hq₀ hgV hw₁sq hw₂pos hz₁ hwz hzm M N R₀ Q Hscale Δ₁ Λ γ
      hM hR₀ hQ hHscale hΔ₁ hΛ hNγ hγfirst hMNlo hMNhi hNR hRQ
      hHdef hΔlower hmupper hΛupper lam lamTilde Bshift).2.1
  have hTnonneg : 0 ≤ T := by dsimp [T]; positivity
  have hTupper : T ≤ x ^ (δ + 100 * ε) * Hscale ^ 2 * N /
      ((gV : ℝ) * Δ₁) := by
    change max ((s₂ : ℝ)⁻¹) Hscale⁻¹ * _ ≤ _
    exact mul_le_of_le_one_left (by positivity)
      (max_le (inv_le_one_of_one_le₀ hs₂one) (inv_le_one_of_one_le₀ hHscale))
  have hCΔcap : CΔhi ≤ x ^ (55 * ε) :=
    (Real.rpow_inv_le_iff_of_pos (by positivity) hx0.le (by positivity)).mp hxcap
  have hdenCap : CΔhi ≤ x ^ (55 * ε) * Hscale ^ 2 :=
    hCΔcap.trans (le_mul_of_one_le_right (hpow _).le (one_le_pow₀ hHscale))
  have hΔN : Δ₁ ≤ N := hΔupper.trans <|
    (div_le_iff₀ (by positivity)).mpr (by
      simpa only [mul_comm] using mul_le_mul_of_nonneg_right hdenCap hN.le)
  have hΔstarN : Δstar ≤ N := (min_le_right _ _).trans hΔN
  let P : ℝ := x ^ (δ + 55 * ε) * Hscale ^ 2
  have hP : 0 < P := by dsimp [P]; positivity
  have hDeltaLower : cDelta * N / P ≤ Δ₁ := by
    calc
      cDelta * N / P = N / (CΔlo * P) := by dsimp [cDelta]; ring
      _ ≤ Δ₁ := (div_le_iff₀ (by positivity)).mpr (by
        simpa only [P, mul_assoc, mul_comm, mul_left_comm] using hΔlower)
  have hΛsimple : |Λ| ≤ CΛ * x ^ (δ + 5 * ε) * Hscale ^ 2 :=
    hΛupper.trans (div_le_self (by positivity)
      (one_le_mul_of_one_le_of_one_le hwone hgone))
  have hΛscale : |Λ| * x ^ (5 * ε) ≤ CΛ * P := by
    calc
      |Λ| * x ^ (5 * ε) ≤
          (CΛ * x ^ (δ + 5 * ε) * Hscale ^ 2) * x ^ (5 * ε) := by gcongr
      _ = CΛ * (x ^ (δ + 10 * ε) * Hscale ^ 2) := by
        rw [show δ + 10 * ε = (δ + 5 * ε) + 5 * ε by ring,
          Real.rpow_add hx0 (δ + 5 * ε) (5 * ε)]
        ring
      _ ≤ CΛ * P := by
        dsimp [P]
        exact mul_le_mul_of_nonneg_left
          (mul_le_mul_of_nonneg_right
            (Real.rpow_le_rpow_of_exponent_le hx1 (by linarith)) (sq_nonneg Hscale))
          (by positivity)
  have hStarLower : cStar * N / P ≤ Δstar := by
    apply le_min
    · calc
        cStar * N / P ≤ (1 / CΛ) * N / P := by
          gcongr
          exact min_le_right _ _
        _ = N / (CΛ * P) := by ring
        _ ≤ N / (|Λ| * x ^ (5 * ε)) :=
          div_le_div_of_nonneg_left hN.le (by positivity) hΛscale
    · calc
        cStar * N / P ≤ cDelta * N / P := by
          gcongr
          exact min_le_left _ _
        _ ≤ Δ₁ := hDeltaLower
  obtain ⟨_, hmresourceLower, hmresourceUpper⟩ :=
    source_terminal_modulus_resource_transport δ ε cₘ Cm CΔhi
      hδ hε hcₘ (by positivity) (by positivity)
      x M N R₀ Q Hscale κ (q₀ : ℝ) (gV : ℝ) Δ₁ (m : ℝ)
      hx1 hM hN hR₀ hQ hHscale hκ hqone hgone hΔ₁ hmreal
      hHdef hΔupper hmlower hmupper
  let W : ℝ := max (x ^ (δ + 10 * ε) * Hscale ^ 5) (Hscale ^ 6)
  let ratioA : ℝ := κ ^ 2 * x ^ (δ + 131 * ε) * W /
    ((gV : ℝ) * (q₀ : ℝ) ^ 2 * (g₀ : ℝ) * (m : ℝ))
  let ratioB : ℝ := κ ^ 2 * x ^ (δ + 131 * ε) * W /
    ((gV : ℝ) * (q₀ : ℝ) ^ 2 * (g₀ : ℝ) * Δstar)
  let ratioC : ℝ := κ ^ 2 * x ^ (δ + 131 * ε) * (m : ℝ) * W /
    ((gV : ℝ) * (q₀ : ℝ) ^ 2 * (g₀ : ℝ) * N * Δstar)
  obtain ⟨_, hratioA, hratioB, hratioC⟩ :=
    hresources x γ M N Hscale κ (q₀ : ℝ) (gV : ℝ) (g₀ : ℝ) Δ₁ Δstar (m : ℝ)
      hx1 hM hN hHscale hκ hqone hgone hg₀one hΔ₁ hΔstar hmreal hNγ
      hMNlo hMNhi hκbound hHbound hDeltaLower hStarLower hmresourceLower hmresourceUpper
  obtain ⟨hpowerA, hpowerB, hpowerC⟩ :=
    source_terminal_three_power_bounds x «ω» δ ε γ hx1 hω hδ hε hγlo hγhi
  have hnegative : x ^ (-δ) ≤ 1 :=
    Real.rpow_le_one_of_one_le_of_nonpos hx1 (neg_nonpos.mpr hδ.le)
  have hratioA' : ratioA ≤ CA :=
    hratioA.trans (mul_le_of_le_one_right hCA.le (hpowerA.trans hnegative))
  have hratioB' : ratioB ≤ CB :=
    hratioB.trans (mul_le_of_le_one_right hCB.le hpowerB)
  have hratioC' : ratioC ≤ CC :=
    hratioC.trans (mul_le_of_le_one_right hCC.le hpowerC)
  let target : ℝ := (s₂ : ℝ) * (q₀ : ℝ) ^ 2 * (g₀ : ℝ) ^ 2 * N ^ 2 /
    (κ ^ 2 * x ^ (27 * ε) * Rtarget)
  have hRtarget : 0 < Rtarget := lt_max_of_lt_right (by positivity)
  have htarget : 0 < target := by dsimp [target]; positivity
  let R : ℝ := (x ^ (4 * ε) * (s₂ : ℝ) * T / (q₀ : ℝ)) * (Δ₁ / Δstar) *
    (N / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ)) *
    (Δstar / Real.sqrt (m : ℝ) + Real.sqrt (m : ℝ))
  have hgeometry := source_terminal_sigma5_ratio_comparison
    x δ ε N Hscale κ (q₀ : ℝ) (gV : ℝ) (g₀ : ℝ) (s₂ : ℝ) Δ₁ Δstar (m : ℝ) T
    hx0 hN hHpos hκpos hqreal hgreal hg₀real hs₂real hΔ₁ hΔstar hmreal
    hTnonneg hΔstarN hTupper
  change ((q₀ : ℝ) * (g₀ : ℝ)) * R ≤ target * (ratioA + 2 * ratioB + ratioC)
    at hgeometry
  have hmainGeometry : ((q₀ : ℝ) * (g₀ : ℝ)) * R ≤ target * (CA + 2 * CB + CC) :=
    hgeometry.trans (mul_le_mul_of_nonneg_left
      (by linarith only [hratioA', hratioB', hratioC']) htarget.le)
  have hHsimple : Hscale ≤ CH * x ^ (4 * «ω» + δ + 7 * ε) :=
    hHbound.trans (div_le_self (by positivity) hqone)
  have hRsimple : Rtarget ≤ x ^ (δ + 10 * ε) * Hscale ^ 4 := by
    apply max_le
    · exact mul_le_mul_of_nonneg_left
        (pow_le_pow_right₀ hHscale (by norm_num : 3 ≤ 4)) (hpow _).le
    · exact le_mul_of_one_le_left (by positivity)
        (Real.one_le_rpow hx1 (by positivity))
  have hRcap : Rtarget ≤ CH ^ 4 * x ^ (B0 - 27 * ε) := by
    calc
      Rtarget ≤ x ^ (δ + 10 * ε) * Hscale ^ 4 := hRsimple
      _ ≤ x ^ (δ + 10 * ε) * (CH * x ^ (4 * «ω» + δ + 7 * ε)) ^ 4 := by gcongr
      _ = CH ^ 4 * x ^ (B0 - 27 * ε) := by
        rw [mul_pow, ← Real.rpow_mul_natCast hx0.le]
        rw [show B0 - 27 * ε = (δ + 10 * ε) + (4 * «ω» + δ + 7 * ε) * 4 by
          dsimp [B0]; ring,
          Real.rpow_add hx0 (δ + 10 * ε) ((4 * «ω» + δ + 7 * ε) * 4)]
        ring_nf
  have hκ2 : κ ^ 2 ≤ Cκ ^ 2 * (q₀ : ℝ) ^ 2 := by
    simpa only [mul_pow] using pow_le_pow_left₀ hκpos.le hκbound 2
  have herror : x ^ (-B0) ≤ Cκ ^ 2 * CH ^ 4 * target := by
    dsimp only [target]
    rw [← mul_div_assoc]
    apply (le_div_iff₀ (by positivity)).mpr
    calc
      x ^ (-B0) * (κ ^ 2 * x ^ (27 * ε) * Rtarget) ≤
          x ^ (-B0) * ((Cκ ^ 2 * (q₀ : ℝ) ^ 2) * x ^ (27 * ε) *
            (CH ^ 4 * x ^ (B0 - 27 * ε))) := by gcongr
      _ = Cκ ^ 2 * CH ^ 4 * (q₀ : ℝ) ^ 2 := by
        rw [Real.rpow_sub hx0, Real.rpow_neg hx0.le]
        field_simp (disch := positivity)
      _ = Cκ ^ 2 * CH ^ 4 * (1 * (q₀ : ℝ) ^ 2 * 1 * 1) := by ring
      _ ≤ Cκ ^ 2 * CH ^ 4 * ((s₂ : ℝ) * (q₀ : ℝ) ^ 2 * (g₀ : ℝ) ^ 2 * N ^ 2) := by
        gcongr
        · exact one_le_pow₀ hg₀one
        · exact one_le_pow₀ hNone
  have hfiveResult := hfive x hx5 m q₀ c₁ c₂ w₁ w₂ z₁ gV hm hq₀ hc₁ hc₂ hgV
    hw₁ hw₁sq hz₁ hwz hzm M N R₀ Q Hscale Δ₁ Λ γ
    hM hR₀ hQ hHscale hΔ₁ hΛ hNγ hγfirst hγone hMNlo hMNhi hNR hRQ
    hHdef hΔlower hΔupper hmupper hwupper hΛupper
    lam lamTilde l ℓ aPhase Bshift d₀ hd₀ hlam hlamTilde hw₂ hw₂Tilde
    hprimitive hA E hE φ ψ hφ hψ hsφ hsψ hbφ hbψ
  change S₅ = (∑' d : ℕ, ∑' n : ℤ, ∑' nt : ℤ, term₅ d n nt) ∧
    ‖S₅‖ ≤ C5 * ((q₀ * g₀ : ℕ) : ℝ) * R + x ^ (-B0) at hfiveResult
  refine ⟨hfiveResult.1, ?_⟩
  change ‖S₅‖ ≤ Csum * target
  calc
    ‖S₅‖ ≤ C5 * (((q₀ : ℝ) * (g₀ : ℝ)) * R) + x ^ (-B0) := by
      simpa only [Nat.cast_mul, mul_assoc] using hfiveResult.2
    _ ≤ C5 * (target * (CA + 2 * CB + CC)) + Cκ ^ 2 * CH ^ 4 * target :=
      add_le_add (mul_le_mul_of_nonneg_left hmainGeometry hC5.le) herror
    _ = Csum * target := by dsimp [Csum]; ring

open Classical in
theorem sourceSecondary_crt_and_compatibility_family
    (r₁ q₀ u₁ v₁ v₂ q₂ a b₁ b₂ : ℕ)
    (hpos : 0 < r₁ ∧ 0 < q₀ ∧ 0 < u₁ ∧ 0 < v₁ ∧ 0 < v₂ ∧ 0 < q₂)
    (hsq : Squarefree (r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂))
    (hprim : Nat.Coprime (r₁ * q₀ * u₁ * v₁ * v₂ * q₂) (a * b₁ * b₂))
    (ℓ : ℤ) :
    let m : ℕ := r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂
    letI : NeZero q₀ := ⟨ne_of_gt hpos.2.1⟩
    let E : ZMod q₀ → Finset (ZMod q₀) := fun r =>
      if IsUnit r then Finset.univ.filter (fun n =>
        IsUnit (n * (n + (ℓ : ZMod q₀) * r * (r₁ : ZMod q₀))) ∧
        (b₁ : ZMod q₀) * n⁻¹ =
          (b₂ : ZMod q₀) * (n + (ℓ : ZMod q₀) * r * (r₁ : ZMod q₀))⁻¹)
      else ∅
    ∃ A B : Fin m,
      (A.val : ZMod r₁) = (a : ZMod r₁) ∧
      (A.val : ZMod (q₀ * u₁ * Nat.lcm v₁ v₂)) =
        (b₁ : ZMod (q₀ * u₁ * Nat.lcm v₁ v₂)) ∧
      (A.val : ZMod q₂) = (b₂ : ZMod q₂) ∧
      (B.val : ZMod r₁) = 0 ∧
      (B.val : ZMod (q₀ * u₁ * Nat.lcm v₁ v₂)) = 0 ∧
      (B.val : ZMod q₂) = ((ℓ * (r₁ : ℤ)) : ZMod q₂) ∧
      Nat.Coprime A.val m ∧
      (∀ r : ZMod q₀, (E r).card ≤ Int.gcd (q₀ : ℤ) ℓ) ∧
      (∀ r : ZMod q₀, ¬IsUnit r → E r = ∅) ∧
      ∀ d : ℕ, Nat.Coprime d q₀ → ∀ n : ℤ,
        sourceCompatibility (d * r₁) q₀ b₁ b₂ ℓ n =
          if (n : ZMod q₀) ∈ E (d : ZMod q₀) then 1 else 0 := by
  intro m E
  let : NeZero r₁ := ⟨hpos.1.ne'⟩
  let : NeZero q₀ := ⟨hpos.2.1.ne'⟩
  let : NeZero u₁ := ⟨hpos.2.2.1.ne'⟩
  let : NeZero v₁ := ⟨hpos.2.2.2.1.ne'⟩
  let : NeZero v₂ := ⟨hpos.2.2.2.2.1.ne'⟩
  let : NeZero q₂ := ⟨hpos.2.2.2.2.2.ne'⟩
  obtain ⟨AB, hAB, _⟩ := sourceSecondaryCRT_classes_exists_unique
    r₁ q₀ u₁ v₁ v₂ q₂ hsq (a : ℤ) (b₁ : ℤ) (b₂ : ℤ) ℓ
    (by simpa only [Nat.cast_mul] using hprim.isCoprime)
  obtain ⟨hAr, hAW, hAq, hBr, hBW, hBq, hAcop⟩ := hAB
  have hrq : Nat.Coprime r₁ q₀ := Nat.coprime_of_squarefree_mul
    (hsq.squarefree_of_dvd (show r₁ * q₀ ∣ r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂ from
      ⟨u₁ * Nat.lcm v₁ v₂ * q₂, by ring⟩))
  have hqb : Nat.Coprime q₀ (a * b₁ * b₂) :=
    hprim.of_dvd_left ⟨r₁ * u₁ * v₁ * v₂ * q₂, by ring⟩
  have hb₁q : Nat.Coprime b₁ q₀ := hqb.symm.of_dvd_left ⟨a * b₂, by ring⟩
  have hb₂q : Nat.Coprime b₂ q₀ := hqb.symm.of_dvd_left ⟨a * b₁, by ring⟩
  have hE := sourceCompatibility_residueFamily_exact q₀ r₁ b₁ b₂ ℓ
    ((hrq.mul_left hb₁q).mul_left hb₂q)
  refine ⟨AB.1, AB.2, ?_, ?_, ?_, hBr, hBW, hBq, hAcop,
    hE.1, hE.2.1, hE.2.2⟩
  · simpa only [Int.cast_natCast] using hAr
  · simpa only [Int.cast_natCast] using hAW
  · simpa only [Int.cast_natCast] using hAq

open Classical in
theorem sourceSigmaTwo_uniform_secondary_reduction
    («ω» δ ε C Bsave cM TM cN TN cD TD : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε)
    (hworking : 72 * «ω» + 24 * δ < 1) (hsmall : ε < δ / 10 ^ 100)
    (hC : 1 ≤ C) (hBsave : 0 < Bsave)
    (hcM : 0 < cM) (hMT : cM ≤ TM)
    (hcN : 0 < cN) (hNT : cN ≤ TN)
    (hcD : 0 < cD) (hDT : cD ≤ TD)
    (CM EM CN EN CD ED : ℕ → ℝ)
    (henvelopes : ∀ j : ℕ, 0 ≤ CM j ∧ 0 ≤ CN j ∧ 0 ≤ CD j) :
    ∃ J₀ : ℕ, ∃ CDpoly EDpoly : ℕ → ℕ → ℝ,
      (∀ j k : ℕ, 0 ≤ CDpoly j k) ∧
      ∃ K X₀ : ℝ, 0 < K ∧ Real.exp 1 ≤ X₀ ∧
      ∀ (x : ℝ), X₀ ≤ x →
      ∀ (r₁ q₀ u₁ v₁ v₂ q₂ a b₁ b₂ : ℕ)
        (hpos : 0 < r₁ ∧ 0 < q₀ ∧ 0 < u₁ ∧ 0 < v₁ ∧ 0 < v₂ ∧ 0 < q₂)
        (_ : Squarefree (r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂))
        (_ : Nat.Coprime (r₁ * q₀ * u₁ * v₁ * v₂ * q₂) (a * b₁ * b₂))
        (ℓ : ℤ),
      let m : ℕ := r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂
      letI : NeZero q₀ := ⟨ne_of_gt hpos.2.1⟩
      let E : ZMod q₀ → Finset (ZMod q₀) := fun r =>
        if IsUnit r then Finset.univ.filter (fun n =>
          IsUnit (n * (n + (ℓ : ZMod q₀) * r * (r₁ : ZMod q₀))) ∧
          (b₁ : ZMod q₀) * n⁻¹ =
            (b₂ : ZMod q₀) * (n + (ℓ : ZMod q₀) * r * (r₁ : ZMod q₀))⁻¹)
        else ∅
      ∃ A B : Fin m,
        (A.val : ZMod r₁) = (a : ZMod r₁) ∧
        (A.val : ZMod (q₀ * u₁ * Nat.lcm v₁ v₂)) =
          (b₁ : ZMod (q₀ * u₁ * Nat.lcm v₁ v₂)) ∧
        (A.val : ZMod q₂) = (b₂ : ZMod q₂) ∧
        (B.val : ZMod r₁) = 0 ∧
        (B.val : ZMod (q₀ * u₁ * Nat.lcm v₁ v₂)) = 0 ∧
        (B.val : ZMod q₂) = ((ℓ * (r₁ : ℤ)) : ZMod q₂) ∧
        Nat.Coprime A.val m ∧
        (∀ r : ZMod q₀, (E r).card ≤ Int.gcd (q₀ : ℤ) ℓ) ∧
        (∀ r : ZMod q₀, ¬IsUnit r → E r = ∅) ∧
        (∀ d : ℕ, Nat.Coprime d q₀ → ∀ n : ℤ,
          sourceCompatibility (d * r₁) q₀ b₁ b₂ ℓ n =
            if (n : ZMod q₀) ∈ E (d : ZMod q₀) then 1 else 0) ∧
        ∀ M N R₀ Q U V H Hstar Δ d₀ γ : ℝ,
        0 < M → 0 < N → 0 < R₀ → 0 < Q → 0 < U → 0 < V → 0 < Δ →
        x / C ≤ M * N → M * N ≤ C * x → N = x ^ γ →
        max (1 / 4 + 12 * «ω» + 4 * δ + 100 * ε)
            (32 * «ω» + 10 * δ + 400 * ε) ≤ γ →
        γ ≤ 1 / 2 - 4 * «ω» - 2 * δ - 50 * ε →
        N ≤ C * x ^ (δ + 4 * ε) * R₀ →
        R₀ ≤ C * x ^ (-2 * ε) * N →
        x ^ (1 / 2 - ε) ≤ C * R₀ * Q →
        R₀ * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) →
        H = x ^ ε * R₀ * Q ^ 2 / ((q₀ : ℝ) * M) → 1 ≤ H →
        x ^ (-δ - 5 * ε) * Q / ((q₀ : ℝ) * H) ≤ C * U →
        U ≤ C * x ^ (-5 * ε) * Q / H →
        x ^ (5 * ε) * H / (q₀ : ℝ) ≤ C * V →
        V ≤ C * x ^ (δ + 5 * ε) * H →
        Q / (q₀ : ℝ) ≤ C * U * V → U * V ≤ C * Q / (q₀ : ℝ) →
        R₀ / C ≤ (r₁ : ℝ) * Δ → (r₁ : ℝ) * Δ ≤ C * R₀ →
        U / C ≤ (u₁ : ℝ) → (u₁ : ℝ) ≤ C * U →
        V / C ≤ (v₁ : ℝ) → (v₁ : ℝ) ≤ C * V →
        V / C ≤ (v₂ : ℝ) → (v₂ : ℝ) ≤ C * V →
        Q / (C * (q₀ : ℝ)) ≤ (q₂ : ℝ) → (q₂ : ℝ) ≤ C * Q / (q₀ : ℝ) →
        (q₀ : ℝ) ≤ C * Q →
        (∀ p ∈ q₀.primeFactors, Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (p : ℝ)) →
        N ≤ C * x ^ (δ + 50 * ε) * H ^ 2 * Δ →
        Δ ≤ C * N / (x ^ (50 * ε) * H ^ 2) →
        Δ / C ≤ d₀ → d₀ ≤ C * Δ →
        ℓ ≠ 0 → |(ℓ : ℝ)| ≤ C * N / R₀ →
        Hstar ≠ 0 → 1 ≤ C * |Hstar| → |Hstar| ≤ C * H →
        ∀ ψM ψN ψD : ℝ → ℝ,
        ContDiff ℝ ∞ ψM → ContDiff ℝ ∞ ψN → ContDiff ℝ ∞ ψD →
        Function.support ψM ⊆ Set.Icc cM TM →
        Function.support ψN ⊆ Set.Icc cN TN →
        Function.support ψD ⊆ Set.Icc cD TD →
        (∀ t : ℝ, 0 ≤ ψM t ∧ 0 ≤ ψN t ∧ 0 ≤ ψD t) →
        (∀ (j : ℕ) (t : ℝ),
          |iteratedDeriv j ψM t| ≤ CM j * (Real.log x) ^ EM j ∧
          |iteratedDeriv j ψN t| ≤ CN j * (Real.log x) ^ EN j ∧
          |iteratedDeriv j ψD t| ≤ CD j * (Real.log x) ^ ED j) →
        let Δ₁ : ℝ := x ^ (-5 * ε) * Δ
        let g : ℕ := Nat.gcd v₁ v₂
        let κ : ℝ := max 1 (x ^ (5 * ε) * H / V)
        let Hbound : ℕ := ⌊2 * |Hstar|⌋₊
        let J : Finset ℤ :=
          (Finset.Icc (-(Hbound : ℤ)) (Hbound : ℤ)).filter
            (fun h => 1 ≤ (h : ℝ) / Hstar ∧ (h : ℝ) / Hstar < 2)
        let φ : ℤ × ℤ → ℤ := fun h =>
          h.1 * ((v₂ / g : ℕ) : ℤ) - h.2 * ((v₁ / g : ℕ) : ℤ)
        let Freq : Finset (ℤ × ℤ) := (J ×ˢ J).filter
          (fun h => h.1 * (v₂ : ℤ) ≠ h.2 * (v₁ : ℤ))
        let L : Finset ℤ := ((J ×ˢ J).image φ).erase 0
        let Dmax : ℕ := ⌊d₀ + TD * Δ₁⌋₊
        let D : Finset ℕ := Finset.Icc 1 Dmax
        let I : Finset ℤ := Finset.Icc ⌈cN * N⌉ ⌊TN * N⌋
        let supported : ℤ → ℕ := fun y =>
          ∏ p ∈ m.primeFactors, p ^ y.natAbs.factorization p
        let W : Finset ℕ := D.filter (fun w => Squarefree w ∧ Nat.Coprime w m)
        let W₂ : Finset ℕ := L.image supported
        let Ys : Finset ℤ := L.image (fun y =>
          Int.sign y * ((2 ^ Nat.log 2 y.natAbs : ℕ) : ℤ))
        let WW : Finset (ℕ × ℕ) := W.biUnion (fun w₁ =>
          (w₁.divisors.filter (fun w₀ => w₀ * w₁ ≤ Dmax)).image (fun w₀ => (w₀, w₁)))
        let Blocks : Finset (ℕ × ℕ × ℤ) := W ×ˢ W₂ ×ˢ Ys
        let P₃ : Finset ((ℕ × ℕ) × ℕ × ℤ × ℕ) :=
          WW ×ˢ W₂ ×ˢ Ys ×ˢ Finset.range (J₀ + 1)
        let Ypairs : ℕ → ℕ → ℤ → Finset (ℤ × ℤ) := fun w₁ w₂ Y =>
          (L ×ˢ L).filter (fun p =>
            1 ≤ (p.1 : ℝ) / (Y : ℝ) ∧ (p.1 : ℝ) / (Y : ℝ) < 2 ∧
            1 ≤ (p.2 : ℝ) / (Y : ℝ) ∧ (p.2 : ℝ) / (Y : ℝ) < 2 ∧
            (w₁ : ℤ) ∣ p.1 ∧ (w₁ : ℤ) ∣ p.2 ∧
            supported p.1 = w₂ ∧ supported p.2 = w₂)
        let Fblock : ℕ → ℕ → ℤ → Finset (ℤ × ℤ) := fun w₁ w₂ Y =>
          Freq.filter (fun h =>
            (w₁ : ℤ) ∣ φ h ∧ supported (φ h) = w₂ ∧
            1 ≤ (φ h : ℝ) / (Y : ℝ) ∧ (φ h : ℝ) / (Y : ℝ) < 2)
        let R₁ : ℕ := r₁ * q₀ * u₁ * v₁ * q₂
        let R₂ : ℕ := r₁ * q₀ * u₁ * v₂ * q₂
        let Four : (ℤ × ℤ) → (ℤ × ℤ) → ℝ → ℂ := fun h h' d =>
          sourcePhiRealFactor ψM M R₁ h.1 d *
            star (sourcePhiRealFactor ψM M R₂ h.2 d) *
            star (sourcePhiRealFactor ψM M R₁ h'.1 d) *
            sourcePhiRealFactor ψM M R₂ h'.2 d
        let coeff : (ℤ × ℤ) → (ℤ × ℤ) → ℕ → ℂ := fun h h' j =>
          (Δ₁ ^ j / (j.factorial : ℝ)) • iteratedDeriv j (Four h h') d₀
        let Γ : ℕ → ℤ → ℤ → ℂ := fun j y y' =>
          ∑ h ∈ Freq.filter (fun h => φ h = y),
            ∑ h' ∈ Freq.filter (fun h' => φ h' = y'), coeff h h' j
        let kernel : ℕ → ℕ → ℤ → ℤ → ℂ := fun w₁ d y y' =>
          ∑ n ∈ I, ∑ n' ∈ I,
            sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
              (A.val : ℤ) (B.val : ℤ) ℓ E ψN N y y' ⊤ d n n'
        let energyTerm : ℕ → ℕ → ℤ → ℕ → ℂ := fun w₁ w₂ Y d =>
          if w₁ ∣ d ∧ Nat.Coprime (d / w₁) w₁ then
            (ψD (((d : ℝ) - d₀) / Δ₁) : ℂ) *
              ∑ h ∈ Fblock w₁ w₂ Y, ∑ h' ∈ Fblock w₁ w₂ Y,
                if Int.gcd ((d / w₁ : ℕ) : ℤ)
                    (((m : ℤ) * φ h * φ h') / (w₁ : ℤ) ^ 2) = 1 then
                  kernel w₁ d (φ h) (φ h') * Four h h' (d : ℝ)
                else 0
          else 0
        let energy : ℕ → ℕ → ℤ → ℂ := fun w₁ w₂ Y =>
          ∑ d ∈ D, energyTerm w₁ w₂ Y d
        let remainder : ℕ → ℕ → ℤ → ℕ → ℂ := fun w₁ w₂ Y d =>
          if w₁ ∣ d ∧ Nat.Coprime (d / w₁) w₁ then
            (ψD (((d : ℝ) - d₀) / Δ₁) : ℂ) *
              ∑ h ∈ Fblock w₁ w₂ Y, ∑ h' ∈ Fblock w₁ w₂ Y,
                if Int.gcd ((d / w₁ : ℕ) : ℤ)
                    (((m : ℤ) * φ h * φ h') / (w₁ : ℤ) ^ 2) = 1 then
                  kernel w₁ d (φ h) (φ h') *
                    (Four h h' (d : ℝ) -
                      ∑ j ∈ Finset.range (J₀ + 1),
                        ((((d : ℝ) - d₀) / Δ₁) ^ j : ℝ) • coeff h h' j)
                else 0
          else 0
        let expansion : ℕ → ℕ → ℤ → ℂ := fun w₁ w₂ Y =>
          ∑ j ∈ Finset.range (J₀ + 1), ∑ w₀ ∈ w₁.divisors,
            (ArithmeticFunction.moebius w₀ : ℂ) *
              ∑ p ∈ Ypairs w₁ w₂ Y, Γ j p.1 p.2 *
                ∑ d ∈ D,
                  sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
                    (A.val : ℤ) (B.val : ℤ) ℓ E ψN ψD N Δ₁ d₀ j p.1 p.2 ⊤ d
        let maxEnergy : ℝ :=
          ((Blocks.sup (fun b => Real.toNNReal (energy b.1 b.2.1 b.2.2).re) : NNReal) : ℝ)
        let maxSigmaThree : ℝ :=
          ((P₃.sup (fun p => Real.toNNReal
            (sourceSigmaThree m r₁ q₀ u₁ v₁ v₂ q₂ p.1.1 p.1.2 p.2.1
              (A.val : ℤ) (B.val : ℤ) ℓ E L ψN ψD
              N Δ₁ d₀ (p.2.2.1 : ℝ) p.2.2.2)) : NNReal) : ℝ)
        let sigmaTwoTerm : ℕ → ℝ := fun d =>
          if Squarefree d ∧ Nat.Coprime d m then
            ψD (((d : ℝ) - d₀) / Δ₁) *
              ‖sourceDispersionFrequencyBlock Freq ψM (fun t => ψN (t / N)) M
                (d * r₁) q₀ u₁ v₁ v₂ q₂ a b₁ b₂ ℓ‖
          else 0
        (∀ j ≤ J₀,
          ContDiff ℝ ∞ (fun t : ℝ => ψD t * t ^ j) ∧
          Function.support (fun t : ℝ => ψD t * t ^ j) ⊆ Set.Icc cD TD ∧
          (∀ t : ℝ, 0 ≤ ψD t * t ^ j) ∧
          ∀ (k : ℕ) (t : ℝ),
            |iteratedDeriv k (fun u : ℝ => ψD u * u ^ j) t| ≤
              CDpoly j k * (Real.log x) ^ EDpoly j k) ∧
        (∀ (w₁ : ℕ) (y y' : ℤ) (T : WithTop ℝ) (d : ℕ),
          (∀ n n' : ℤ, n ∉ I ∨ n' ∉ I →
            sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
              (A.val : ℤ) (B.val : ℤ) ℓ E ψN N y y' T d n n' = 0) ∧
          (∀ n : ℤ, HasSum
            (fun n' : ℤ => sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
              (A.val : ℤ) (B.val : ℤ) ℓ E ψN N y y' T d n n')
            (∑ n' ∈ I, sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
              (A.val : ℤ) (B.val : ℤ) ℓ E ψN N y y' T d n n')) ∧
          HasSum
            (fun n : ℤ => ∑' n' : ℤ,
              sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
                (A.val : ℤ) (B.val : ℤ) ℓ E ψN N y y' T d n n')
            (∑ n ∈ I, ∑ n' ∈ I,
              sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
                (A.val : ℤ) (B.val : ℤ) ℓ E ψN N y y' T d n n')) ∧
        (∀ (w₀ w₁ : ℕ) (j : ℕ) (y y' : ℤ) (T : WithTop ℝ),
          (∀ d ∉ D, sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
            (A.val : ℤ) (B.val : ℤ) ℓ E ψN ψD N Δ₁ d₀ j y y' T d = 0) ∧
          HasSum
            (sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
              (A.val : ℤ) (B.val : ℤ) ℓ E ψN ψD N Δ₁ d₀ j y y' T)
            (∑ d ∈ D, sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
              (A.val : ℤ) (B.val : ℤ) ℓ E ψN ψD N Δ₁ d₀ j y y' T d)) ∧
        HasSum sigmaTwoTerm (∑ d ∈ D, sigmaTwoTerm d) ∧
        sourceSigmaTwo J ψM (fun t => ψN (t / N)) ψD M Δ₁ d₀
          r₁ q₀ u₁ v₁ v₂ q₂ a b₁ b₂ ℓ = ∑ d ∈ D, sigmaTwoTerm d ∧
        (∀ b ∈ Blocks, (energy b.1 b.2.1 b.2.2).im = 0 ∧
          0 ≤ (energy b.1 b.2.1 b.2.2).re) ∧
        sourceSigmaTwo J ψM (fun t => ψN (t / N)) ψD M Δ₁ d₀
          r₁ q₀ u₁ v₁ v₂ q₂ a b₁ b₂ ℓ ≤
            K * x ^ (5 * ε / 2) * Δ * Real.sqrt maxEnergy ∧
        (∀ h ∈ Freq, ∀ h' ∈ Freq, ∀ j ≤ J₀,
          ‖coeff h h' j‖ ≤ K * (Real.log x) ^ (4 * max 0 (EM 0)) *
            x ^ (-4 * (j : ℝ) * ε)) ∧
        (∀ j ≤ J₀, ∀ y ∈ L, ∀ y' ∈ L,
          ‖Γ j y y'‖ ≤ K * x ^ ε * ((g : ℝ) * κ) ^ 2) ∧
        (∀ b ∈ Blocks,
          energy b.1 b.2.1 b.2.2 - expansion b.1 b.2.1 b.2.2 =
              ∑ d ∈ D, remainder b.1 b.2.1 b.2.2 d ∧
          (∑ d ∈ D, ‖remainder b.1 b.2.1 b.2.2 d‖) ≤
            K * x ^ (-2 * Bsave - 100)) ∧
        (∀ p ∈ P₃,
          sourceSigmaThree m r₁ q₀ u₁ v₁ v₂ q₂ p.1.1 p.1.2 p.2.1
            (A.val : ℤ) (B.val : ℤ) ℓ E L ψN ψD
            N Δ₁ d₀ (p.2.2.1 : ℝ) p.2.2.2 =
          ∑ yy ∈ Ypairs p.1.2 p.2.1 p.2.2.1,
            ‖∑ d ∈ D,
              sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ p.1.1 p.1.2
                (A.val : ℤ) (B.val : ℤ) ℓ E ψN ψD
                N Δ₁ d₀ p.2.2.2 yy.1 yy.2 ⊤ d‖) ∧
        sourceSigmaTwo J ψM (fun t => ψN (t / N)) ψD M Δ₁ d₀
          r₁ q₀ u₁ v₁ v₂ q₂ a b₁ b₂ ℓ ≤
            K * x ^ (7 * ε / 2) * (g : ℝ) * κ * Δ * Real.sqrt maxSigmaThree +
              K * x ^ (-Bsave)
:= by
  have hFourScale (x Δ d₀ M H R₁ R₂ : ℝ)
      (hx : 1 ≤ x) (hΔ : 0 < Δ) (hd₀ : 0 < d₀)
      (hM : 0 ≤ M) (hH : 0 ≤ H) (hR₁ : 0 < R₁) (hR₂ : 0 < R₂)
      (hcenter : Δ / C ≤ d₀)
      (h₁ : M * H / (d₀ * R₁) ≤ C ^ 6 * x ^ ε)
      (h₂ : M * H / (d₀ * R₂) ≤ C ^ 6 * x ^ ε) :
      (x ^ (-5 * ε) * Δ) / d₀ *
          (1 + TM * M * (2 * C * H) / d₀ * (R₁⁻¹ + R₂⁻¹)) ≤
        (C + 4 * TM * C ^ 8) * x ^ (-4 * ε) := by
    clear * - hC hcM hMT hε hx hΔ hd₀ hM hH hR₁ hR₂ hcenter h₁ h₂
    have hCpos : 0 < C := zero_lt_one.trans_le hC
    have hTM : 0 < TM := hcM.trans_le hMT
    have hxpos : 0 < x := zero_lt_one.trans_le hx
    have hpower : 1 ≤ x ^ ε := Real.one_le_rpow hx hε.le
    have hratio : Δ / d₀ ≤ C :=
      (div_le_iff₀ hd₀).mpr (by
        have ht := (div_le_iff₀ hCpos).mp hcenter
        nlinarith)
    have hsum :
        TM * M * (2 * C * H) / d₀ * (R₁⁻¹ + R₂⁻¹) ≤
          4 * TM * C ^ 7 * x ^ ε := by
      calc
        _ = 2 * C * TM * (M * H / (d₀ * R₁) + M * H / (d₀ * R₂)) := by
          simp only [div_eq_mul_inv, mul_inv_rev]
          ring
        _ ≤ 2 * C * TM * (C ^ 6 * x ^ ε + C ^ 6 * x ^ ε) :=
          mul_le_mul_of_nonneg_left (add_le_add h₁ h₂) (by positivity)
        _ = _ := by ring
    have hG : 1 + TM * M * (2 * C * H) / d₀ * (R₁⁻¹ + R₂⁻¹) ≤
        (1 + 4 * TM * C ^ 7) * x ^ ε := by
      nlinarith
    have hSratio : (x ^ (-5 * ε) * Δ) / d₀ ≤ C * x ^ (-5 * ε) := by
      rw [mul_div_assoc]
      simpa only [mul_comm] using
        mul_le_mul_of_nonneg_left hratio (Real.rpow_nonneg hxpos.le _)
    calc
      _ ≤ (C * x ^ (-5 * ε)) * ((1 + 4 * TM * C ^ 7) * x ^ ε) := by
        exact mul_le_mul hSratio hG (by positivity) (by positivity)
      _ = (C + 4 * TM * C ^ 8) * (x ^ (-5 * ε) * x ^ ε) := by ring
      _ = _ := by rw [← Real.rpow_add hxpos]; congr 2; ring
  have hεbound : ε < 1 / 1000 := by
    have hδone : δ < 1 := by linarith
    exact hsmall.trans ((div_lt_div_of_pos_right hδone
      (by positivity : (0 : ℝ) < 10 ^ 100)).trans_le
      (by norm_num : (1 : ℝ) / 10 ^ 100 ≤ 1 / 1000))
  obtain ⟨CDpoly, EDpoly, hCDpoly, hpolyBound⟩ :=
    sourceSecondary_polynomial_profile_envelopes
      cD TD hcD CD ED (fun j => (henvelopes j).2.2)
  obtain ⟨J₀, hJ₀⟩ := exists_nat_gt ((2 * Bsave + 1000) / ε)
  obtain ⟨CF, hCF, hTaylor⟩ := sourcePhi_fourfold_common_cutoff_taylor.{0} J₀
  let KS : ℝ := C + 4 * TM * C ^ 8
  let KF : ℝ := CF * (TM * CM 0) ^ 4 * KS ^ J₀
  let K : ℝ := 1 + KF * (1 + 4 * C ^ 2) ^ 2
  let KR : ℝ := CF * TM ^ 4 * (TD * KS) ^ (J₀ + 1)
  have hTMpos : 0 < TM := hcM.trans_le hMT
  have hTDpos : 0 < TD := hcD.trans_le hDT
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hKS : 1 ≤ KS := by
    exact hC.trans (le_add_of_nonneg_right (by positivity))
  have hKone : 1 ≤ K := by
    exact le_add_of_nonneg_right (by dsimp only [KF]; positivity)
  have hK : 0 < K := zero_lt_one.trans_le hKone
  have hJlarge : 2 * Bsave + 1000 < ε * (J₀ : ℝ) := by
    simpa only [mul_comm] using (div_lt_iff₀ hε).mp hJ₀
  obtain ⟨X, hX⟩ := Filter.eventually_atTop.mp
    (sourceSecondary_uniform_loss_packet
      ε (CM 0) (EM 0) (CN 0) (EN 0) (CD 0) (ED 0) K KR C TD J₀ hε)
  let X₀ : ℝ := max (max (Real.exp 1) X) (max 3 (max C (max TN TD)))
  have hX₀ : Real.exp 1 ≤ X₀ := (le_max_left _ _).trans (le_max_left _ _)
  refine ⟨J₀, CDpoly, EDpoly, hCDpoly, K, X₀, hK, hX₀, ?_⟩
  intro x hx r₁ q₀ u₁ v₁ v₂ q₂ a b₁ b₂ hpos hsq hprim ℓ m E
  have hxX : X ≤ x := ((le_max_right _ _).trans (le_max_left _ _)).trans hx
  have hxe : Real.exp 1 ≤ x := hX₀.trans hx
  obtain ⟨hx3, hCx, hTNx, hTDx⟩ := by
    simpa only [max_le_iff] using ((le_max_right _ _).trans hx)
  have hx1 : 1 ≤ x := (by norm_num : (1 : ℝ) ≤ 3).trans hx3
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hlogx : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hxe
  obtain ⟨_, hW₂x, hTaux, hlogFx, hCMx, hCNx, hCDx, hCDsmall,
    hDSmall, hKRSmall, hFinalSmall, hKSmall, hDyadicX, hHarmonicX⟩ := hX x hxX
  obtain ⟨A, B, hAr, hAW, hAq, hBr, hBW, hBq, hAcop, hEcard, hEempty, hCompat⟩ :=
    sourceSecondary_crt_and_compatibility_family
      r₁ q₀ u₁ v₁ v₂ q₂ a b₁ b₂ hpos hsq hprim ℓ
  refine ⟨A, B, hAr, hAW, hAq, hBr, hBW, hBq, hAcop, hEcard, hEempty, hCompat, ?_⟩
  intro M N R₀ Q U V H Hstar Δ d₀ γ hM hN hR hQ hU hV hΔ hMNlo hMNhi
    hNpow hγlo hγhi hRlo hRhi hRQlo hRQhi hHdef hHone hUlo hUhi hVlo hVhi
    hUVlo hUVhi hrΔlo hrΔhi hulo huhi hv₁lo hv₁hi hv₂lo hv₂hi hq₂lo hq₂hi
    hq₀hi hq₀rough hΔlo hΔhi hd₀lo hd₀hi hℓne hℓhi hHsne hHslo hHshi
    ψM ψN ψD hψM hψN hψD hsM hsN hsD hnprofiles hbprofiles
    Δ₁ g κ Hbound J φ Freq L Dmax D I supported W W₂ Ys WW Blocks P₃
    Ypairs Fblock R₁ R₂ Four coeff Γ kernel energyTerm energy remainder expansion
    maxEnergy maxSigmaThree sigmaTwoTerm
  have hmpos : 0 < m := Nat.pos_of_ne_zero hsq.ne_zero
  have hqpos : 0 < (q₀ : ℝ) := Nat.cast_pos.mpr hpos.2.1
  have hqone : (1 : ℝ) ≤ q₀ := by exact_mod_cast hpos.2.1
  have hHpos : 0 < H := zero_lt_one.trans_le hHone
  have hγzero : 0 ≤ γ := by
    have hg := (le_max_left _ _).trans hγlo
    linarith only [hg, hω, hδ, hε]
  have hγone : γ ≤ 1 := by linarith only [hγhi, hω, hδ, hε]
  have hNlower : 1 ≤ N := by rw [hNpow]; exact Real.one_le_rpow hx1 hγzero
  have hNupper : N ≤ x := by
    rw [hNpow]
    exact Real.rpow_le_self_of_one_le hx1 hγone
  have hMNlower : x ≤ C * M * N := by
    simpa only [mul_assoc, mul_left_comm, mul_comm] using
      (div_le_iff₀ hCpos).mp hMNlo
  have hRweak : R₀ ≤ C * N := by
    calc
      R₀ ≤ C * x ^ (-2 * ε) * N := hRhi
      _ ≤ C * 1 * N := by
        gcongr
        exact Real.rpow_le_one_of_one_le_of_nonpos hx1 (by linarith)
      _ = C * N := by ring
  have hHtimes : H * (q₀ : ℝ) * M = x ^ ε * R₀ * Q ^ 2 := by
    rw [hHdef]
    field_simp [hqpos.ne', hM.ne']
  have hUweak : U * H ≤ C * Q := by
    calc
      U * H ≤ C * x ^ (-5 * ε) * Q := (le_div_iff₀ hHpos).mp hUhi
      _ ≤ C * 1 * Q := by
        gcongr
        exact Real.rpow_le_one_of_one_le_of_nonpos hx1 (by linarith)
      _ = _ := by ring
  have hΔweak : Δ ≤ C * N := by
    have hp : 1 ≤ x ^ (50 * ε) := Real.one_le_rpow hx1 (by positivity)
    have hden : 1 ≤ x ^ (50 * ε) * H ^ 2 :=
      one_le_mul_of_one_le_of_one_le hp (one_le_pow₀ hHone)
    exact (le_mul_of_one_le_right hΔ.le hden).trans
      ((le_div_iff₀ (zero_lt_one.trans_le hden)).mp hΔhi)
  obtain ⟨_, _, _, _, _, hHupper, _, _, hΔupper, _, hrupper, hqupper, huupper,
    hvupper, hv'upper, hq'upper⟩ := sourceSecondary_coarse_parameter_bounds
      «ω» δ ε C hω hδ hε hworking hC hεbound
      x M N R₀ Q U V H Δ r₁ q₀ u₁ v₁ v₂ q₂
      hx3 hCx hM hNlower hNupper hR hQ hU hV hHone hΔ
      (Nat.cast_nonneg _) hqone (Nat.cast_nonneg _) hMNlower hMNhi hRlo hRweak
      hRQhi hHtimes hUweak hVhi hΔlo hΔweak hrΔhi hq₀hi huhi hv₁hi hv₂hi
      ((le_div_iff₀ hqpos).mp hq₂hi)
  have hΔ₁pos : 0 < Δ₁ := mul_pos (Real.rpow_pos_of_pos hx0 _) hΔ
  have hΔ₁le : Δ₁ ≤ Δ := by
    calc
      Δ₁ = x ^ (-5 * ε) * Δ := rfl
      _ ≤ 1 * Δ := mul_le_mul_of_nonneg_right
        (Real.rpow_le_one_of_one_le_of_nonpos hx1 (by linarith)) hΔ.le
      _ = Δ := one_mul _
  have hd₀pos : 0 < d₀ := (div_pos hΔ hCpos).trans_le hd₀lo
  obtain ⟨hDmax, hDsize, hDhundred, hmBound, hφmem, hHbound,
    hJdata, hFreqcard, hLdata⟩ := sourceSecondary_literal_support_census
      x C H Hstar Δ Δ₁ d₀ TD r₁ q₀ u₁ v₁ v₂ q₂
      hx3 hC hCx hTDx hΔ hΔ₁pos hd₀pos hTDpos hΔ₁le hd₀hi hΔupper
      hHpos.le hHupper hHshi hpos.2.2.2.1 hpos.2.2.2.2.1
      hrupper hqupper huupper hvupper hv'upper hq'upper
  have hfin := sourceSecondary_literal_finite_support m r₁ q₀ u₁ v₁ v₂ q₂ a b₁ b₂
    (A.val : ℤ) (B.val : ℤ) ℓ E J L ψM ψN ψD M N Δ₁ d₀ cN TN cD TD
    hN hΔ₁pos hd₀pos.le hcN hNT hcD hDT hsN hsD
  have hexpansion := sourceSecondary_signed_mobius_expansion
    J₀ Dmax m r₁ q₀ u₁ v₁ v₂ q₂ A B ℓ E ψN ψD N Δ₁ d₀
    Freq L φ I Four coeff hφmem
      (fun w₁ y y' T d => (hfin.1 w₁ y y' T d).2.2.tsum_eq)
  have hWsubset : W ⊆ Finset.Icc 1 Dmax := Finset.filter_subset _ _
  have hPeriodScale (v : ℕ) (hv : 0 < v) (hvlo : V / C ≤ (v : ℝ)) :
      M * H / (d₀ * ((r₁ * q₀ * u₁ * v * q₂ : ℕ) : ℝ)) ≤ C ^ 6 * x ^ ε := by
    clear * - hrΔlo hulo hvlo hq₂lo hUVlo hd₀lo hCpos hqpos hHtimes hd₀pos
      hpos hv hR hQ hU hV hΔ hM hHpos hx0
    have hrΔ : R₀ ≤ C * (r₁ : ℝ) * Δ := by
      simpa only [mul_assoc, mul_comm, mul_left_comm] using (div_le_iff₀ hCpos).mp hrΔlo
    have hU' : U ≤ C * (u₁ : ℝ) := by
      simpa only [mul_comm] using (div_le_iff₀ hCpos).mp hulo
    have hV' : V ≤ C * (v : ℝ) := by
      simpa only [mul_comm] using (div_le_iff₀ hCpos).mp hvlo
    have hq' : Q ≤ C * (q₀ : ℝ) * (q₂ : ℝ) := by
      simpa only [mul_assoc, mul_comm, mul_left_comm] using
        (div_le_iff₀ (mul_pos hCpos hqpos)).mp hq₂lo
    have hUV' : Q ≤ C * (q₀ : ℝ) * U * V := by
      simpa only [mul_assoc, mul_comm, mul_left_comm] using (div_le_iff₀ hqpos).mp hUVlo
    have hd' : Δ ≤ C * d₀ := by
      simpa only [mul_comm] using (div_le_iff₀ hCpos).mp hd₀lo
    have hperiodpos : 0 < ((r₁ * q₀ * u₁ * v * q₂ : ℕ) : ℝ) :=
      Nat.cast_pos.mpr (Nat.mul_pos (Nat.mul_pos (Nat.mul_pos (Nat.mul_pos
        hpos.1 hpos.2.1) hpos.2.2.1) hv) hpos.2.2.2.2.2)
    have hlower : R₀ * Q ^ 2 ≤
        C ^ 6 * (q₀ : ℝ) * d₀ * ((r₁ * q₀ * u₁ * v * q₂ : ℕ) : ℝ) := by
      calc
        R₀ * Q ^ 2 = R₀ * Q * Q := by ring
        _ ≤ (C * (r₁ : ℝ) * Δ) * (C * (q₀ : ℝ) * U * V) *
            (C * (q₀ : ℝ) * (q₂ : ℝ)) := by gcongr
        _ ≤ (C * (r₁ : ℝ) * (C * d₀)) *
            (C * (q₀ : ℝ) * (C * (u₁ : ℝ)) * (C * (v : ℝ))) *
            (C * (q₀ : ℝ) * (q₂ : ℝ)) := by gcongr
        _ = _ := by simp only [Nat.cast_mul]; ring
    apply (div_le_iff₀ (mul_pos hd₀pos hperiodpos)).mpr
    apply (mul_le_mul_iff_left₀ hqpos).mp
    calc
      M * H * (q₀ : ℝ) = H * (q₀ : ℝ) * M := by ring
      _ = x ^ ε * R₀ * Q ^ 2 := hHtimes
      _ ≤ x ^ ε * (C ^ 6 * (q₀ : ℝ) * d₀ *
          ((r₁ * q₀ * u₁ * v * q₂ : ℕ) : ℝ)) := by
        simpa only [mul_assoc] using
          mul_le_mul_of_nonneg_left hlower (Real.rpow_nonneg hx0.le ε)
      _ = (C ^ 6 * x ^ ε * (d₀ * ((r₁ * q₀ * u₁ * v * q₂ : ℕ) : ℝ))) *
          (q₀ : ℝ) := by ring
  let ST : ℝ := Δ₁ / d₀ *
    (1 + TM * M * (2 * C * H) / d₀ * ((R₁ : ℝ)⁻¹ + (R₂ : ℝ)⁻¹))
  have hR₁pos : 0 < R₁ :=
    Nat.mul_pos (Nat.mul_pos (Nat.mul_pos (Nat.mul_pos hpos.1 hpos.2.1)
      hpos.2.2.1) hpos.2.2.2.1) hpos.2.2.2.2.2
  have hR₂pos : 0 < R₂ :=
    Nat.mul_pos (Nat.mul_pos (Nat.mul_pos (Nat.mul_pos hpos.1 hpos.2.1)
      hpos.2.2.1) hpos.2.2.2.2.1) hpos.2.2.2.2.2
  have hST : ST ≤ KS * x ^ (-4 * ε) := hFourScale x Δ d₀ M H R₁ R₂
    hx1 hΔ hd₀pos hM.le hHpos.le (Nat.cast_pos.mpr hR₁pos) (Nat.cast_pos.mpr hR₂pos)
    hd₀lo (hPeriodScale v₁ hpos.2.2.2.1 hv₁lo) (hPeriodScale v₂ hpos.2.2.2.2.1 hv₂lo)
  have hMzero (t : ℝ) : |ψM t| ≤ CM 0 * (Real.log x) ^ EM 0 := by
    simpa only [iteratedDeriv_zero] using (hbprofiles 0 t).1
  have hNzero (t : ℝ) : |ψN t| ≤ CN 0 * (Real.log x) ^ EN 0 := by
    simpa only [iteratedDeriv_zero] using (hbprofiles 0 t).2.1
  have hDzero (t : ℝ) : |ψD t| ≤ CD 0 * (Real.log x) ^ ED 0 := by
    simpa only [iteratedDeriv_zero] using (hbprofiles 0 t).2.2
  obtain ⟨hCoeff, hGammaBound, hRemainder⟩ :=
    sourceSecondary_fourfold_taylor_certificate
      J₀ Dmax Hbound m r₁ q₀ u₁ v₁ v₂ q₂ A B ℓ E
      CF KS x C ε Bsave cM TM cN TN cD TD M N H V Δ₁ d₀ (CM 0) (EM 0)
      hCF hKS hxe hC hε hBsave hM hN hHpos.le hV hΔ₁pos hd₀pos
      hcM hMT hcN hNT hcD hDT (henvelopes 0).1 hmpos hpos hTNx hNupper
      ψM ψN ψD hsM hsD hMzero hCMx
      (fun t => (hNzero t).trans hCNx) (fun t => (hDzero t).trans hCDx)
      J (fun h hh => ⟨(Finset.mem_filter.mp hh).1, (hJdata h hh).2⟩)
      hHbound hv₁lo hlogFx hJlarge hTaylor hFreqcard hST hDsize hKRSmall
  let sigma3 (w₀ w₁ w₂ : ℕ) (Y : ℤ) (j : ℕ) : ℝ :=
    sourceSigmaThree m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁ w₂
      (A.val : ℤ) (B.val : ℤ) ℓ E L ψN ψD N Δ₁ d₀ (Y : ℝ) j
  have hSigma3Finite (w₀ w₁ w₂ : ℕ) (Y : ℤ) (j : ℕ) :
      sigma3 w₀ w₁ w₂ Y j = ∑ yy ∈ Ypairs w₁ w₂ Y,
        ‖∑ d ∈ D, sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
          (A.val : ℤ) (B.val : ℤ) ℓ E ψN ψD N Δ₁ d₀ j yy.1 yy.2 ⊤ d‖ :=
    hfin.2.2.2.2 w₀ w₁ w₂ (Y : ℝ) j
  have hMaxSigma3 : 0 ≤ maxSigmaThree := NNReal.coe_nonneg _
  have hSigma3Le (w₀ w₁ w₂ : ℕ) (Y : ℤ) (j : ℕ)
      (hp : ((w₀, w₁), w₂, Y, j) ∈ P₃) : sigma3 w₀ w₁ w₂ Y j ≤ maxSigmaThree := by
    have hs := Finset.le_sup (f := fun p => Real.toNNReal
      (sigma3 p.1.1 p.1.2 p.2.1 p.2.2.1 p.2.2.2)) hp
    have hr := Real.toNNReal_le_iff_le_coe.mp hs
    exact hr
  have hDtermOut (w₀ w₁ : ℕ) (j : ℕ) (y y' : ℤ) (d : ℕ) (hd : d ∈ D)
      (hlarge : Dmax < w₀ * w₁) :
      sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
        (A.val : ℤ) (B.val : ℤ) ℓ E ψN ψD N Δ₁ d₀ j y y' ⊤ d = 0 := by
    have hnot : ¬w₀ * w₁ ∣ d := by
      intro hdiv
      have he := Nat.le_of_dvd (Finset.mem_Icc.mp hd).1 hdiv
      exact (not_le_of_gt hlarge) (he.trans (Finset.mem_Icc.mp hd).2)
    simp only [sourceSecondaryDTerm, hnot, false_and, and_false, ite_false]
  have hSigma3Out (w₀ w₁ w₂ : ℕ) (Y : ℤ) (j : ℕ) (hlarge : Dmax < w₀ * w₁) :
      sigma3 w₀ w₁ w₂ Y j = 0 := by
    rw [hSigma3Finite]
    apply Finset.sum_eq_zero
    intro p _
    rw [show (∑ d ∈ D, sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
      (A.val : ℤ) (B.val : ℤ) ℓ E ψN ψD N Δ₁ d₀ j p.1 p.2 ⊤ d) = 0 from
      Finset.sum_eq_zero (fun d hd => hDtermOut w₀ w₁ j p.1 p.2 d hd hlarge), norm_zero]
  have hSigma3Block (b : ℕ × ℕ × ℤ) (hb : b ∈ Blocks) (w₀ : ℕ)
      (hw₀ : w₀ ∈ b.1.divisors) (j : ℕ) (hj : j ≤ J₀) :
      sigma3 w₀ b.1 b.2.1 b.2.2 j ≤ maxSigmaThree := by
    by_cases hsmall : w₀ * b.1 ≤ Dmax
    · apply hSigma3Le
      obtain ⟨hw₁, hw₂Y⟩ := Finset.mem_product.mp hb
      obtain ⟨hw₂, hY⟩ := Finset.mem_product.mp hw₂Y
      have hww : (w₀, b.1) ∈ WW := Finset.mem_biUnion.mpr
        ⟨b.1, hw₁, Finset.mem_image_of_mem _ (Finset.mem_filter.mpr ⟨hw₀, hsmall⟩)⟩
      exact Finset.mem_product.mpr ⟨hww, Finset.mem_product.mpr
        ⟨hw₂, Finset.mem_product.mpr ⟨hY, Finset.mem_range.mpr (Nat.lt_succ_iff.mpr hj)⟩⟩⟩
    · rw [hSigma3Out _ _ _ _ _ (lt_of_not_ge hsmall)]
      exact hMaxSigma3
  have hExpansionBound (b : ℕ × ℕ × ℤ) (hb : b ∈ Blocks) :
      ‖expansion b.1 b.2.1 b.2.2‖ ≤
        K * (J₀ + 1) * x ^ (3 * ε / 2) * ((g : ℝ) * κ) ^ 2 * maxSigmaThree := by
    clear * - hGammaBound hSigma3Finite hSigma3Block hTaux hWsubset hDhundred
      hx0 hK hMaxSigma3 hε hb
    have hw : b.1 ∈ W := (Finset.mem_product.mp hb).1
    have hwsq : Squarefree b.1 := (Finset.mem_filter.mp hw).2.1
    have hwb : (b.1 : ℝ) ≤ x ^ (100 : ℝ) :=
      (show (b.1 : ℝ) ≤ (Dmax : ℝ) from
        by exact_mod_cast (Finset.mem_Icc.mp (hWsubset hw)).2).trans hDhundred
    have hdiv := hTaux b.1 hwsq hwb
    have hmu (w₀ : ℕ) : ‖(ArithmeticFunction.moebius w₀ : ℂ)‖ ≤ 1 := by
      simpa only [Complex.norm_intCast, Int.cast_abs, Int.cast_one] using
        (show (|ArithmeticFunction.moebius w₀| : ℝ) ≤ 1 from
          by exact_mod_cast ArithmeticFunction.abs_moebius_le_one (n := w₀))
    have hrow (w₀ j : ℕ) (hw₀ : w₀ ∈ b.1.divisors) (hj : j ≤ J₀) :
        ‖(ArithmeticFunction.moebius w₀ : ℂ) *
          ∑ p ∈ Ypairs b.1 b.2.1 b.2.2, Γ j p.1 p.2 *
            ∑ d ∈ D, sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ b.1
              (A.val : ℤ) (B.val : ℤ) ℓ E ψN ψD N Δ₁ d₀ j p.1 p.2 ⊤ d‖ ≤
          K * x ^ ε * ((g : ℝ) * κ) ^ 2 * maxSigmaThree := by
      calc
        _ ≤ 1 * ∑ p ∈ Ypairs b.1 b.2.1 b.2.2,
            (K * x ^ ε * ((g : ℝ) * κ) ^ 2) *
              ‖∑ d ∈ D, sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ b.1
                (A.val : ℤ) (B.val : ℤ) ℓ E ψN ψD N Δ₁ d₀ j p.1 p.2 ⊤ d‖ := by
          apply norm_mul_le_of_le (hmu w₀)
          apply norm_sum_le_of_le
          intro p hp
          obtain ⟨hp₁, hp₂⟩ := Finset.mem_product.mp (Finset.mem_filter.mp hp).1
          exact norm_mul_le_of_le (hGammaBound j hj p.1 hp₁ p.2 hp₂) le_rfl
        _ = K * x ^ ε * ((g : ℝ) * κ) ^ 2 * sigma3 w₀ b.1 b.2.1 b.2.2 j := by
          rw [one_mul, ← Finset.mul_sum, hSigma3Finite]
        _ ≤ _ := mul_le_mul_of_nonneg_left (hSigma3Block b hb w₀ hw₀ j hj) (by positivity)
    calc
      ‖expansion b.1 b.2.1 b.2.2‖ ≤
          ∑ j ∈ Finset.range (J₀ + 1), ∑ w₀ ∈ b.1.divisors,
            K * x ^ ε * ((g : ℝ) * κ) ^ 2 * maxSigmaThree := by
        apply norm_sum_le_of_le
        intro j hj
        exact norm_sum_le_of_le b.1.divisors (fun w₀ hw₀ =>
          hrow w₀ j hw₀ (Nat.le_of_lt_succ (Finset.mem_range.mp hj)))
      _ = (J₀ + 1 : ℕ) * (b.1.divisors.card : ℝ) *
          (K * x ^ ε * ((g : ℝ) * κ) ^ 2 * maxSigmaThree) := by
        simp [mul_assoc]
      _ ≤ (J₀ + 1 : ℕ) * x ^ (ε / 2) *
          (K * x ^ ε * ((g : ℝ) * κ) ^ 2 * maxSigmaThree) := by gcongr
      _ = K * (J₀ + 1) * (x ^ (ε / 2) * x ^ ε) *
          ((g : ℝ) * κ) ^ 2 * maxSigmaThree := by
        push_cast
        ring
      _ = _ := by rw [← Real.rpow_add hx0]; congr 3; ring_nf
  have hEnergyUpper (b : ℕ × ℕ × ℤ) (hb : b ∈ Blocks) :
      (energy b.1 b.2.1 b.2.2).re ≤
        K * (J₀ + 1) * x ^ (3 * ε / 2) * ((g : ℝ) * κ) ^ 2 * maxSigmaThree +
          K * x ^ (-2 * Bsave - 100) := by
    have he : energy b.1 b.2.1 b.2.2 = expansion b.1 b.2.1 b.2.2 +
        ∑ d ∈ D, remainder b.1 b.2.1 b.2.2 d :=
      sub_eq_iff_eq_add'.mp (hexpansion b hb)
    rw [he]
    exact (Complex.re_le_norm _).trans (norm_add_le_of_le
      (hExpansionBound b hb) ((norm_sum_le _ _).trans (hRemainder b hb)))
  have hMaxEnergyUpper : maxEnergy ≤
      K * (J₀ + 1) * x ^ (3 * ε / 2) * ((g : ℝ) * κ) ^ 2 * maxSigmaThree +
        K * x ^ (-2 * Bsave - 100) := by
    have hr : 0 ≤ K * (J₀ + 1) * x ^ (3 * ε / 2) * ((g : ℝ) * κ) ^ 2 * maxSigmaThree +
        K * x ^ (-2 * Bsave - 100) := by positivity
    have hs := Finset.sup_le (fun b hb => Real.toNNReal_le_toNNReal (hEnergyUpper b hb))
    have hbound := (Real.le_toNNReal_iff_coe_le hr).mp hs
    exact hbound
  have hFinalSqrt : K * x ^ (5 * ε / 2) * Δ * Real.sqrt maxEnergy ≤
      K * x ^ (7 * ε / 2) * (g : ℝ) * κ * Δ * Real.sqrt maxSigmaThree +
        K * x ^ (-Bsave) := by
    simpa only [mul_assoc] using
      sourceSecondary_sqrt_error_absorption
        x ε Bsave K Δ maxEnergy maxSigmaThree ((g : ℝ) * κ) J₀
        hx1 hε hεbound hKone hΔ hΔupper hMaxSigma3
        (mul_nonneg (Nat.cast_nonneg g : (0 : ℝ) ≤ (g : ℝ))
          (zero_le_one.trans (show (1 : ℝ) ≤ κ from le_max_left _ _)))
        hMaxEnergyUpper hFinalSmall hKSmall
  obtain ⟨hEnergyPositive, hInitialBound⟩ := sourceSecondary_positive_block_cauchy
    x ε K C Δ hx1 hε hKone hC hΔ
    r₁ q₀ u₁ v₁ v₂ q₂ a b₁ b₂ hpos hsq ℓ A B E
    hAr hAW hAq hBr hBW hBq hCompat
    M N Δ₁ d₀ cM TM cN TN cD TD (CM 0 * (Real.log x) ^ EM 0)
    hM hN hΔ₁pos hd₀pos hcM hMT hcN hNT hcD hDT
    (mul_nonneg (henvelopes 0).1 (Real.rpow_nonneg (zero_le_one.trans hlogx) _))
    ψM ψN ψD hsM hsN hsD (fun t => (hnprofiles t).2.2) hMzero
    (fun t => (le_abs_self _).trans ((hDzero t).trans hCDsmall))
    J hφmem (hW₂x m hmpos hmBound L hLdata) (hDyadicX L hLdata) hDmax hDSmall
      (hHarmonicX Dmax W hWsubset hDhundred)
  refine ⟨?_, hfin.1, hfin.2.1, hfin.2.2.1, hfin.2.2.2.1,
    hEnergyPositive, hInitialBound, hCoeff, hGammaBound, ?_, ?_, hInitialBound.trans hFinalSqrt⟩
  · intro j _
    exact hpolyBound x hxe ψD hψD hsD (fun t => (hnprofiles t).2.2)
      (fun k t => (hbprofiles k t).2.2) j
  · intro b hb
    exact ⟨hexpansion b hb, hRemainder b hb⟩
  · intro p _
    exact hSigma3Finite p.1.1 p.1.2 p.2.1 p.2.2.1 p.2.2.2

end

section
open UniqueFactorizationMonoid

theorem typeIII_dense_factor_selection
    (b : ℕ+) (Y : Set.Ici (1 : ℝ)) (D : Finset ℕ+)
    (Qlo Qhi S : ℝ) (hQlo : 0 < Qlo) (hQhi : Qlo ≤ Qhi)
    (hS : 1 ≤ S) (hSrange : S ≤ (Y : ℝ) * Qlo)
    (hD : ∀ d ∈ D,
      Squarefree ((b : ℕ) * (d : ℕ)) ∧
      Nonempty (DenseDivisibilityWitness
        Y 1 ((b : ℕ) * (d : ℕ))) ∧
      Qlo ≤ (b : ℝ) * (d : ℝ) ∧ (b : ℝ) * (d : ℝ) ≤ Qhi) :
    ∃ ρ σ : ℕ+ → ℕ+, ∀ d ∈ D,
      d = ρ d * σ d ∧
      Squarefree (ρ d : ℕ) ∧ Squarefree (σ d : ℕ) ∧
      Nat.Coprime (ρ d : ℕ) (σ d : ℕ) ∧
      Nat.Coprime (b : ℕ) ((ρ d : ℕ) * (σ d : ℕ)) ∧
      S / ((b : ℝ) * (Y : ℝ)) ≤ (σ d : ℝ) ∧ (σ d : ℝ) ≤ S ∧
      Qlo / ((b : ℝ) * S) ≤ (ρ d : ℝ) ∧
      (ρ d : ℝ) ≤ (Y : ℝ) * Qhi / S := by
  classical
  have hbpos : (0 : ℝ) < b := by exact_mod_cast b.pos
  have hbone : (1 : ℝ) ≤ b := by exact_mod_cast (show 1 ≤ (b : ℕ) from b.pos)
  have hYpos : 0 < (Y : ℝ) := zero_lt_one.trans_le Y.property
  have hSpos : 0 < S := zero_lt_one.trans_le hS
  let Z : Set.Ici (1 : ℝ) :=
    ⟨(b : ℝ) * (Y : ℝ), one_le_mul_of_one_le_of_one_le hbone Y.property⟩
  have hlocal : ∀ d ∈ D, ∃ u v : ℕ+,
      d = u * v ∧ Squarefree (u : ℕ) ∧ Squarefree (v : ℕ) ∧
        Nat.Coprime (u : ℕ) (v : ℕ) ∧
        Nat.Coprime (b : ℕ) ((u : ℕ) * (v : ℕ)) ∧
        S / ((b : ℝ) * (Y : ℝ)) ≤ (v : ℝ) ∧ (v : ℝ) ≤ S ∧
        Qlo / ((b : ℝ) * S) ≤ (u : ℝ) ∧
        (u : ℝ) ≤ (Y : ℝ) * Qhi / S := by
    intro d hd
    obtain ⟨hsq, hdense, hlo, hhi⟩ := hD d hd
    have hquot := single_dense_div (Z := Z) hdense b.pos
      (Nat.dvd_mul_right (b : ℕ) (d : ℕ)) (le_refl ((b : ℝ) * (Y : ℝ)))
    have hdense' : Nonempty
        (DenseDivisibilityWitness Z 1 (d : ℕ)) := by
      simpa only [Nat.mul_div_right (d : ℕ) b.pos] using hquot
    have htarget : S ≤ (Z : ℝ) * (d : ℝ) := by
      calc
        S ≤ (Y : ℝ) * Qlo := hSrange
        _ ≤ (Y : ℝ) * ((b : ℝ) * (d : ℝ)) :=
          mul_le_mul_of_nonneg_left hlo hYpos.le
        _ = (Z : ℝ) * (d : ℝ) := by dsimp only [Z]; ring
    obtain ⟨u, v, hprod, hu, hv, hvl, hvh⟩ :=
      (denseDivisibility_succ_iff.mp hdense').2
        0 0 rfl S hS htarget
    have hupos : 0 < u := denseDivisibility_pos hu
    have hvpos : 0 < v := denseDivisibility_pos hv
    have hvR : (0 : ℝ) < v := by exact_mod_cast hvpos
    have hprodR : (d : ℝ) = (u : ℝ) * (v : ℝ) := by exact_mod_cast hprod
    have hur : (u : ℝ) = (d : ℝ) / (v : ℝ) :=
      (eq_div_iff hvR.ne').mpr hprodR.symm
    have hsqUV : Squarefree (u * v) := by
      simpa only [hprod] using hsq.of_mul_right
    refine ⟨⟨u, hupos⟩, ⟨v, hvpos⟩, PNat.eq hprod,
      hsqUV.of_mul_left, hsqUV.of_mul_right,
      Nat.coprime_of_squarefree_mul hsqUV, ?_, hvl, hvh, ?_, ?_⟩
    · change Nat.Coprime (b : ℕ) (u * v)
      rw [← hprod]
      exact Nat.coprime_of_squarefree_mul hsq
    · change Qlo / ((b : ℝ) * S) ≤ (u : ℝ)
      rw [hur]
      have hlow : Qlo / (b : ℝ) ≤ (d : ℝ) :=
        (div_le_iff₀' hbpos).mpr hlo
      calc
        Qlo / ((b : ℝ) * S) = (Qlo / (b : ℝ)) / S := by rw [div_div]
        _ ≤ (d : ℝ) / (v : ℝ) :=
          div_le_div₀ (by positivity) hlow hvR hvh
    · change (u : ℝ) ≤ (Y : ℝ) * Qhi / S
      rw [hur]
      have hhigh : (d : ℝ) ≤ Qhi / (b : ℝ) :=
        (le_div_iff₀' hbpos).mpr hhi
      calc
        (d : ℝ) / (v : ℝ) ≤
            (Qhi / (b : ℝ)) / (S / ((b : ℝ) * (Y : ℝ))) :=
          div_le_div₀ (div_nonneg (hQlo.le.trans hQhi) hbpos.le) hhigh
            (div_pos hSpos (mul_pos hbpos hYpos)) hvl
        _ = (Y : ℝ) * Qhi / S := by
          field_simp [hbpos.ne', hYpos.ne', hSpos.ne']
  choose! ρ σ hρσ using hlocal
  exact ⟨ρ, σ, hρσ⟩

open Classical in
theorem typeIII_coherent_good_modulus_coefficient
    (b : ℕ+) (b₁ b₂ b₃ : ℕ)
    (hb₁ : 0 < b₁) (hb₂ : 0 < b₂) (hb₃ : 0 < b₃)
    (hb : (b : ℕ) = (radical (b₁ * b₂ * b₃) : ℕ))
    (D : Finset ℕ+)
    (hD : ∀ d ∈ D, Squarefree ((b : ℕ) * (d : ℕ)))
    (a₀ : ℤ) (a : ∀ d : ℕ+, (ZMod ((b : ℕ) * (d : ℕ)))ˣ)
    (ha : ∀ d ∈ D,
      (a d : ZMod ((b : ℕ) * (d : ℕ))) = (a₀ : ZMod ((b : ℕ) * (d : ℕ)))) :
    let P : ℕ := ∏ d ∈ D, (d : ℕ)
    let c : ZMod P := (a₀ : ZMod P) * ((b₁ * b₂ * b₃ : ℕ) : ZMod P) *
      (((b : ℕ) : ZMod P)⁻¹) ^ 3
    let A : ℤ := (c.val : ℤ)
    0 < P ∧ (D = ∅ → P = 1) ∧ Nat.Coprime (b : ℕ) P ∧ IsUnit c ∧
      (∀ q : ℕ, q ∣ P → IsUnit (A : ZMod q)) ∧
      ∀ d ∈ D, (d : ℕ) ∣ P ∧
        (A : ZMod (d : ℕ)) =
          ((Units.map ((ZMod.castHom (Nat.dvd_mul_left (d : ℕ) (b : ℕ))
            (ZMod (d : ℕ))).toMonoidHom) (a d) : (ZMod (d : ℕ))ˣ) : ZMod (d : ℕ)) *
            ((b₁ * b₂ * b₃ : ℕ) : ZMod (d : ℕ)) *
            (((b : ℕ) : ZMod (d : ℕ))⁻¹) ^ 3 := by
  intro P c A
  have hP : 0 < P := Finset.prod_pos fun d _ => d.pos
  let : NeZero P := ⟨hP.ne'⟩
  have hdP (d : ℕ+) (hd : d ∈ D) : (d : ℕ) ∣ P :=
    Finset.dvd_prod_of_mem (fun e : ℕ+ => (e : ℕ)) hd
  have hbP : Nat.Coprime (b : ℕ) P :=
    Nat.coprime_prod_right_iff.mpr fun d hd =>
      Nat.coprime_of_squarefree_mul (hD d hd)
  have hnP : Nat.Coprime (b₁ * b₂ * b₃) P := by
    apply (hbP.pow_left (b₁ * b₂ * b₃)).coprime_dvd_left
    rw [hb]
    exact Nat.dvd_radical_pow_self
      (mul_ne_zero (mul_ne_zero hb₁.ne' hb₂.ne') hb₃.ne')
  have hbunit : IsUnit (((b : ℕ) : ZMod P)) :=
    (ZMod.isUnit_iff_coprime _ _).mpr hbP
  have hnunit : IsUnit ((b₁ * b₂ * b₃ : ℕ) : ZMod P) :=
    (ZMod.isUnit_iff_coprime _ _).mpr hnP
  have haP : IsUnit (a₀ : ZMod P) := by
    apply (ZMod.coe_int_isUnit_iff_isCoprime a₀ P).mpr
    dsimp only [P]
    rw [Nat.cast_prod]
    apply IsCoprime.prod_left
    intro d hd
    apply (ZMod.coe_int_isUnit_iff_isCoprime a₀ (d : ℕ)).mp
    have had : IsUnit (a₀ : ZMod ((b : ℕ) * (d : ℕ))) := by
      rw [← ha d hd]
      exact (a d).isUnit
    simpa only [map_intCast] using had.map
      (ZMod.castHom (Nat.dvd_mul_left (d : ℕ) (b : ℕ)) (ZMod (d : ℕ)))
  have hbinv : IsUnit ((((b : ℕ) : ZMod P))⁻¹) :=
    isUnit_of_dvd_one ⟨_, (ZMod.inv_mul_of_unit _ hbunit).symm⟩
  have hc : IsUnit c := (haP.mul hnunit).mul (hbinv.pow 3)
  have hAP : (A : ZMod P) = c := by
    simpa only [A, Int.cast_natCast] using ZMod.natCast_zmod_val c
  have hAunit : IsUnit (A : ZMod P) := hAP.symm ▸ hc
  refine ⟨hP, ?_, hbP, hc, ?_, ?_⟩
  · intro h
    simp [P, h]
  · intro q hq
    simpa only [map_intCast] using hAunit.map (ZMod.castHom hq (ZMod q))
  · intro d hd
    let f : ZMod P →+* ZMod (d : ℕ) :=
      ZMod.castHom (hdP d hd) (ZMod (d : ℕ))
    have hinv : f ((((b : ℕ) : ZMod P))⁻¹) =
        (((b : ℕ) : ZMod (d : ℕ))⁻¹) := by
      apply Eq.symm
      apply ZMod.inv_eq_of_mul_eq_one
      simpa only [map_mul, map_natCast, map_one] using
        congrArg f (ZMod.mul_inv_of_unit ((b : ℕ) : ZMod P) hbunit)
    refine ⟨hdP d hd, ?_⟩
    change (A : ZMod (d : ℕ)) =
      (ZMod.castHom (Nat.dvd_mul_left (d : ℕ) (b : ℕ)) (ZMod (d : ℕ))) (a d) *
        ((b₁ * b₂ * b₃ : ℕ) : ZMod (d : ℕ)) *
        (((b : ℕ) : ZMod (d : ℕ))⁻¹) ^ 3
    rw [ha d hd, map_intCast]
    simpa only [c, map_mul, map_pow, map_intCast, map_natCast, hinv] using
      congrArg f hAP

open Classical in
theorem typeIII_selected_factor_cauchy_correlation
    (b : ℕ+) (b₁ b₂ b₃ : ℕ)
    (hb₁ : 0 < b₁) (hb₂ : 0 < b₂) (hb₃ : 0 < b₃)
    (hb : (b : ℕ) = (radical (b₁ * b₂ * b₃) : ℕ))
    (D : Finset ℕ+) (hD : ∀ d ∈ D, Squarefree ((b : ℕ) * (d : ℕ)))
    (ρ σ : ℕ+ → ℕ+) (hfactor : ∀ d ∈ D, d = ρ d * σ d)
    (a₀ : ℤ) (a : ∀ d : ℕ+, (ZMod ((b : ℕ) * (d : ℕ)))ˣ)
    (ha : ∀ d ∈ D,
      (a d : ZMod ((b : ℕ) * (d : ℕ))) = (a₀ : ZMod ((b : ℕ) * (d : ℕ))))
    (M : Finset ℤ) (η : ℕ → ℂ) (α : ℤ → ℂ)
    (x H ε Tψ : ℝ) (hx : 0 < x) (hH : 0 < H) (hTψ : 1 ≤ Tψ)
    (ψ : ℝ → ℝ) (hψnonneg : ∀ t : ℝ, 0 ≤ ψ t)
    (hψone : ∀ t ∈ Set.Icc (-1 : ℝ) 1, ψ t = 1)
    (hψsupport : Function.support ψ ⊆ Set.Icc (-Tψ) Tψ) :
    let Hb : ℝ := x ^ (3 * ε / 2) * H / ((b₁ * b₂ * b₃ : ℕ) : ℝ)
    let L : Finset ℤ :=
      (Finset.Icc (Int.ceil (-Hb)) (Int.floor Hb)).filter (fun ℓ => ℓ ≠ 0)
    let E : Finset ℤ := Finset.Icc (Int.ceil (-Tψ * Hb)) (Int.floor (Tψ * Hb))
    let 𝒮 : Finset ℕ+ := D.image σ
    let ℛ : ℕ+ → Finset ℕ+ := fun s => (D.filter (fun d => σ d = s)).image ρ
    let τ₃ : ℤ → ℝ := fun ℓ =>
      (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 3) ℓ.natAbs : ℝ)
    let P : ℕ := ∏ d ∈ D, (d : ℕ)
    let c : ZMod P := (a₀ : ZMod P) * ((b₁ * b₂ * b₃ : ℕ) : ZMod P) *
      (((b : ℕ) : ZMod P)⁻¹) ^ 3
    let A : ℤ := (c.val : ℤ)
    let A_d : ∀ d : ℕ+, (ZMod (d : ℕ))ˣ := fun d =>
      Units.map ((ZMod.castHom (Nat.dvd_mul_left (d : ℕ) (b : ℕ))
        (ZMod (d : ℕ))).toMonoidHom) (a d)
    let K : ℤ → ℂ := fun ℓ =>
      ∑ d ∈ D, if Int.gcd (((b : ℕ) : ℤ) * ℓ) ((d : ℕ) : ℤ) = 1 then
        η ((b : ℕ) * (d : ℕ)) *
          ∑ m ∈ M, if Int.gcd m (((b : ℕ) * (d : ℕ) : ℕ) : ℤ) = 1 then
            α m * normalizedKloosterman3Mod (d : ℕ)
              ((A_d d : ZMod (d : ℕ)) * ((b₁ * b₂ * b₃ : ℕ) : ZMod (d : ℕ)) *
                (ℓ : ZMod (d : ℕ)) * (m : ZMod (d : ℕ))⁻¹ *
                (((b : ℕ) : ZMod (d : ℕ))⁻¹) ^ 3)
          else 0
      else 0
    let F : ℕ+ → ℤ → ℂ := fun s ℓ =>
      ∑ r ∈ ℛ s,
        if Int.gcd (((b : ℕ) : ℤ) * ℓ) (((r : ℕ) * (s : ℕ) : ℕ) : ℤ) = 1 then
          η ((b : ℕ) * (r : ℕ) * (s : ℕ)) *
            ∑ m ∈ M,
              if Int.gcd m (((b : ℕ) * (r : ℕ) * (s : ℕ) : ℕ) : ℤ) = 1 then
                α m * normalizedKloosterman3Mod ((r : ℕ) * (s : ℕ))
                  (((A : ZMod ((r : ℕ) * (s : ℕ))) *
                    (m : ZMod ((r : ℕ) * (s : ℕ)))⁻¹) *
                    (ℓ : ZMod ((r : ℕ) * (s : ℕ))))
              else 0
        else 0
    let U : ℕ+ → ℕ+ → ℕ+ → ℤ → ℤ → ℂ := fun r₁ r₂ s m₁ m₂ =>
      ∑ ℓ ∈ E,
        if IsUnit (ℓ : ZMod ((s : ℕ) * Nat.lcm (r₁ : ℕ) (r₂ : ℕ))) then
          (ψ ((ℓ : ℝ) / Hb) : ℂ) *
            normalizedKloosterman3Mod ((r₁ : ℕ) * (s : ℕ))
              (((A : ZMod ((r₁ : ℕ) * (s : ℕ))) *
                (m₁ : ZMod ((r₁ : ℕ) * (s : ℕ)))⁻¹) *
                (ℓ : ZMod ((r₁ : ℕ) * (s : ℕ)))) *
            star (normalizedKloosterman3Mod ((r₂ : ℕ) * (s : ℕ))
              (((A : ZMod ((r₂ : ℕ) * (s : ℕ))) *
                (m₂ : ZMod ((r₂ : ℕ) * (s : ℕ)))⁻¹) *
                (ℓ : ZMod ((r₂ : ℕ) * (s : ℕ)))))
        else 0
    let T₁ : ℝ := ∑ s ∈ 𝒮, (1 / (s : ℝ)) * ∑ ℓ ∈ L, τ₃ ℓ ^ 2
    let T₂ : ℝ := ∑ s ∈ 𝒮, ∑ ℓ ∈ E, (s : ℝ) * ψ ((ℓ : ℝ) / Hb) * ‖F s ℓ‖ ^ 2
    let G₂ : ℂ := ∑ s ∈ 𝒮, ∑ r₁ ∈ ℛ s, ∑ r₂ ∈ ℛ s, ∑ m₁ ∈ M, ∑ m₂ ∈ M,
      if Int.gcd m₁ (((b : ℕ) * (r₁ : ℕ) * (s : ℕ) : ℕ) : ℤ) = 1 ∧
          Int.gcd m₂ (((b : ℕ) * (r₂ : ℕ) * (s : ℕ) : ℕ) : ℤ) = 1 then
        (s : ℂ) *
          (η ((b : ℕ) * (r₁ : ℕ) * (s : ℕ)) *
            star (η ((b : ℕ) * (r₂ : ℕ) * (s : ℕ)))) *
          (α m₁ * star (α m₂)) * U r₁ r₂ s m₁ m₂
      else 0
    let B₂ : ℝ := ∑ s ∈ 𝒮, ∑ r₁ ∈ ℛ s, ∑ r₂ ∈ ℛ s, ∑ m₁ ∈ M, ∑ m₂ ∈ M,
      if Int.gcd m₁ (((b : ℕ) * (r₁ : ℕ) * (s : ℕ) : ℕ) : ℤ) = 1 ∧
          Int.gcd m₂ (((b : ℕ) * (r₂ : ℕ) * (s : ℕ) : ℕ) : ℤ) = 1 then
        (s : ℝ) * ‖η ((b : ℕ) * (r₁ : ℕ) * (s : ℕ))‖ *
          ‖η ((b : ℕ) * (r₂ : ℕ) * (s : ℕ))‖ *
          ‖α m₁‖ * ‖α m₂‖ * ‖U r₁ r₂ s m₁ m₂‖
      else 0
    0 < Hb ∧
      (∀ ℓ : ℤ, ℓ ∈ L ↔ ℓ ≠ 0 ∧ |(ℓ : ℝ)| ≤ Hb) ∧
      L ⊆ E ∧ (∀ ℓ ∈ L, ψ ((ℓ : ℝ) / Hb) = 1) ∧
      (∀ ℓ : ℤ, ℓ ∉ E → ψ ((ℓ : ℝ) / Hb) = 0) ∧
      (∀ ℓ : ℤ, K ℓ = ∑ s ∈ 𝒮, F s ℓ) ∧
      0 ≤ T₁ ∧ 0 ≤ T₂ ∧
      (∑ ℓ ∈ L, τ₃ ℓ * ‖K ℓ‖) ^ 2 ≤ T₁ * T₂ ∧
      (T₂ : ℂ) = G₂ ∧ T₂ ≤ B₂ ∧
      (∑ ℓ ∈ L, τ₃ ℓ * ‖K ℓ‖) ^ 2 ≤ T₁ * B₂ ∧
      ∀ s ∈ 𝒮, ∀ r₁ ∈ ℛ s, ∀ r₂ ∈ ℛ s,
        r₁ * s ∈ D ∧ r₂ * s ∈ D ∧
        Squarefree (s : ℕ) ∧ Squarefree (r₁ : ℕ) ∧ Squarefree (r₂ : ℕ) ∧
        Nat.Coprime (s : ℕ) ((r₁ : ℕ) * (r₂ : ℕ)) ∧
        IsUnit (A : ZMod ((s : ℕ) * Nat.lcm (r₁ : ℕ) (r₂ : ℕ))) := by
  have hkernelTransport (A₀ m ℓ : ℤ) (u v : ℕ+) (huv : u = v) :
      normalizedKloosterman3Mod (u : ℕ)
        (((A₀ : ZMod (u : ℕ)) * (m : ZMod (u : ℕ))⁻¹) *
          (ℓ : ZMod (u : ℕ))) =
        normalizedKloosterman3Mod (v : ℕ)
          (((A₀ : ZMod (v : ℕ)) * (m : ZMod (v : ℕ))⁻¹) *
            (ℓ : ZMod (v : ℕ))) := by
    cases huv
    rfl
  have hfiniteCS (S : Finset ℕ+) (L E : Finset ℤ)
      (τ : ℤ → ℝ) (f : ℕ+ → ℤ → ℂ) (w : ℤ → ℝ)
      (hτ : ∀ ℓ ∈ L, 0 ≤ τ ℓ) (hw : ∀ ℓ ∈ E, 0 ≤ w ℓ)
      (hLE : L ⊆ E) (hwone : ∀ ℓ ∈ L, w ℓ = 1) :
      (∑ ℓ ∈ L, τ ℓ * ‖∑ s ∈ S, f s ℓ‖) ^ 2 ≤
        (∑ s ∈ S, (1 / (s : ℝ)) * ∑ ℓ ∈ L, τ ℓ ^ 2) *
          (∑ s ∈ S, ∑ ℓ ∈ E, (s : ℝ) * w ℓ * ‖f s ℓ‖ ^ 2) := by
    calc
      _ ≤ (∑ t ∈ S ×ˢ L, τ t.2 * ‖f t.1 t.2‖) ^ 2 := by
        apply pow_le_pow_left₀
          (Finset.sum_nonneg fun ℓ hℓ => mul_nonneg (hτ ℓ hℓ) (norm_nonneg _))
        calc
          _ ≤ ∑ ℓ ∈ L, τ ℓ * ∑ s ∈ S, ‖f s ℓ‖ :=
            Finset.sum_le_sum fun ℓ hℓ =>
              mul_le_mul_of_nonneg_left (norm_sum_le S _) (hτ ℓ hℓ)
          _ = _ := by
            simp only [Finset.mul_sum, Finset.sum_product]
            exact Finset.sum_comm
      _ ≤ (∑ s ∈ S, (1 / (s : ℝ)) * ∑ ℓ ∈ L, τ ℓ ^ 2) *
          (∑ s ∈ S, ∑ ℓ ∈ L, (s : ℝ) * ‖f s ℓ‖ ^ 2) := by
        simpa only [Finset.sum_product, Finset.mul_sum] using
          Finset.sum_sq_le_sum_mul_sum_of_sq_le_mul (S ×ˢ L)
            (r := fun t => τ t.2 * ‖f t.1 t.2‖)
            (f := fun t => (1 / (t.1 : ℝ)) * τ t.2 ^ 2)
            (g := fun t => (t.1 : ℝ) * ‖f t.1 t.2‖ ^ 2)
            (fun _ _ => by positivity)
            (fun _ _ => by positivity)
            (fun t _ => by
              have hs : (t.1 : ℝ) ≠ 0 := ne_of_gt (by exact_mod_cast t.1.pos)
              apply le_of_eq
              field_simp [hs])
      _ ≤ _ := by
        refine mul_le_mul_of_nonneg_left ?_ (by positivity)
        apply Finset.sum_le_sum
        intro s _
        calc
          _ = ∑ ℓ ∈ L, (s : ℝ) * w ℓ * ‖f s ℓ‖ ^ 2 := by
            apply Finset.sum_congr rfl
            intro ℓ hℓ
            rw [hwone ℓ hℓ, mul_one]
          _ ≤ _ := Finset.sum_le_sum_of_subset_of_nonneg hLE
            (fun ℓ hℓ _ => mul_nonneg
              (mul_nonneg (by positivity) (hw ℓ hℓ)) (sq_nonneg _))
  have hfiniteGram (R : Finset ℕ+) (N J : Finset ℤ)
      (e : ℕ+ → ℂ) (a : ℤ → ℂ) (k : ℕ+ → ℤ → ℤ → ℂ)
      (p q : ℕ+ → ℤ → Prop) (w : ℤ → ℝ) (v : ℝ) :
      ((∑ ℓ ∈ J, v * w ℓ *
        ‖∑ r ∈ R, if p r ℓ then
          e r * ∑ m ∈ N, if q r m then a m * k r m ℓ else 0
        else 0‖ ^ 2 : ℝ) : ℂ) =
        ∑ r₁ ∈ R, ∑ r₂ ∈ R, ∑ m₁ ∈ N, ∑ m₂ ∈ N,
          if q r₁ m₁ ∧ q r₂ m₂ then
            (v : ℂ) * (e r₁ * star (e r₂)) * (a m₁ * star (a m₂)) *
              ∑ ℓ ∈ J, if p r₁ ℓ ∧ p r₂ ℓ then
                (w ℓ : ℂ) * k r₁ m₁ ℓ * star (k r₂ m₂ ℓ)
              else 0
          else 0 := by
    have hlinear (ℓ : ℤ) :
        (∑ r ∈ R, if p r ℓ then
          e r * ∑ m ∈ N, if q r m then a m * k r m ℓ else 0
        else 0) =
          ∑ r ∈ R, ∑ m ∈ N,
            if p r ℓ ∧ q r m then e r * a m * k r m ℓ else 0 := by
      simp only [Finset.mul_sum, mul_ite_zero, Finset.ite_sum_zero, ← ite_and, mul_assoc]
    calc
      _ = ∑ ℓ ∈ J, (v : ℂ) * (w ℓ : ℂ) *
          ((∑ r ∈ R, if p r ℓ then
            e r * ∑ m ∈ N, if q r m then a m * k r m ℓ else 0
          else 0) *
          star (∑ r ∈ R, if p r ℓ then
            e r * ∑ m ∈ N, if q r m then a m * k r m ℓ else 0
          else 0)) := by
        simp only [Complex.ofReal_sum, Complex.ofReal_mul, Complex.ofReal_pow,
          Complex.star_def, Complex.mul_conj']
      _ = ∑ ℓ ∈ J, ∑ r₁ ∈ R, ∑ r₂ ∈ R, ∑ m₁ ∈ N, ∑ m₂ ∈ N,
          if q r₁ m₁ ∧ q r₂ m₂ then
            (v : ℂ) * (e r₁ * star (e r₂)) * (a m₁ * star (a m₂)) *
              (if p r₁ ℓ ∧ p r₂ ℓ then
                (w ℓ : ℂ) * k r₁ m₁ ℓ * star (k r₂ m₂ ℓ)
              else 0)
          else 0 := by
        simp_rw [hlinear]
        simp only [star_sum]
        simp_rw [Finset.sum_mul_sum]
        simp only [Finset.mul_sum]
        simp only [apply_ite star, star_zero, star_mul, ite_zero_mul, mul_ite_zero,
          ← ite_and]
        simp only [and_left_comm, and_comm, mul_assoc, mul_left_comm, mul_comm]
      _ = ∑ r₁ ∈ R, ∑ r₂ ∈ R, ∑ m₁ ∈ N, ∑ m₂ ∈ N, ∑ ℓ ∈ J,
          if q r₁ m₁ ∧ q r₂ m₂ then
            (v : ℂ) * (e r₁ * star (e r₂)) * (a m₁ * star (a m₂)) *
              (if p r₁ ℓ ∧ p r₂ ℓ then
                (w ℓ : ℂ) * k r₁ m₁ ℓ * star (k r₂ m₂ ℓ)
              else 0)
          else 0 := by
        rw [← Finset.sum_comm_cycle]
        apply Finset.sum_congr rfl
        intro r₁ _
        apply Finset.sum_congr rfl
        intro r₂ _
        exact Finset.sum_comm_cycle.symm
      _ = _ := by
        simp only [Finset.ite_sum_zero, Finset.mul_sum]
  intro Hb L E 𝒮 ℛ τ₃ P c A A_d K F U T₁ T₂ G₂ B₂
  obtain ⟨_, _, _, _, hAunit, hcoefficient⟩ :=
    typeIII_coherent_good_modulus_coefficient
      b b₁ b₂ b₃ hb₁ hb₂ hb₃ hb D hD a₀ a ha
  change ∀ q : ℕ, q ∣ P → IsUnit (A : ZMod q) at hAunit
  change ∀ d ∈ D, (d : ℕ) ∣ P ∧
    (A : ZMod (d : ℕ)) =
      (A_d d : ZMod (d : ℕ)) * ((b₁ * b₂ * b₃ : ℕ) : ZMod (d : ℕ)) *
        (((b : ℕ) : ZMod (d : ℕ))⁻¹) ^ 3 at hcoefficient
  clear_value A
  have hHb : 0 < Hb := by
    change 0 < x ^ (3 * ε / 2) * H / ((b₁ * b₂ * b₃ : ℕ) : ℝ)
    exact div_pos (mul_pos (Real.rpow_pos_of_pos hx _) hH)
      (by exact_mod_cast mul_pos (mul_pos hb₁ hb₂) hb₃)
  have hL (ℓ : ℤ) : ℓ ∈ L ↔ ℓ ≠ 0 ∧ |(ℓ : ℝ)| ≤ Hb := by
    simp only [L, Finset.mem_filter, Finset.mem_Icc, Int.ceil_le, Int.le_floor, abs_le]
    tauto
  have hE (ℓ : ℤ) : ℓ ∈ E ↔ |(ℓ : ℝ)| ≤ Tψ * Hb := by
    simp only [E, Finset.mem_Icc, Int.ceil_le, Int.le_floor, abs_le, neg_mul]
  have hLE : L ⊆ E := by
    intro ℓ hℓ
    exact (hE ℓ).mpr (((hL ℓ).mp hℓ).2.trans
      (le_mul_of_one_le_left hHb.le hTψ))
  have hψL (ℓ : ℤ) (hℓ : ℓ ∈ L) : ψ ((ℓ : ℝ) / Hb) = 1 := by
    apply hψone
    have hl := abs_le.mp ((hL ℓ).mp hℓ).2
    constructor
    · exact (le_div_iff₀ hHb).mpr (by simpa using hl.1)
    · exact (div_le_iff₀ hHb).mpr (by simpa using hl.2)
  have hψE (ℓ : ℤ) (hℓ : ℓ ∉ E) : ψ ((ℓ : ℝ) / Hb) = 0 := by
    by_contra hn
    have hs := hψsupport hn
    apply hℓ
    apply (hE ℓ).mpr
    apply abs_le.mpr
    constructor
    · have ht := (le_div_iff₀ hHb).mp hs.1
      simpa only [neg_mul] using ht
    · exact (div_le_iff₀ hHb).mp hs.2
  have hmember (s r : ℕ+) (hr : r ∈ ℛ s) : r * s ∈ D := by
    obtain ⟨d, hd, rfl⟩ := Finset.mem_image.mp hr
    obtain ⟨hdD, hσ⟩ := Finset.mem_filter.mp hd
    rw [← hσ, ← hfactor d hdD]
    exact hdD
  have hgood (s r : ℕ+) (hr : r ∈ ℛ s) :
      Squarefree ((r : ℕ) * (s : ℕ)) ∧
        Nat.Coprime (b : ℕ) ((r : ℕ) * (s : ℕ)) := by
    have hd := hD (r * s) (hmember s r hr)
    change Squarefree ((b : ℕ) * ((r : ℕ) * (s : ℕ))) at hd
    exact ⟨hd.of_mul_right, Nat.coprime_of_squarefree_mul hd⟩
  have hinj (s : ℕ+) : Set.InjOn ρ (D.filter (fun d => σ d = s)) := by
    intro d₁ hd₁ d₂ hd₂ heq
    have h₁ := Finset.mem_filter.mp hd₁
    have h₂ := Finset.mem_filter.mp hd₂
    calc
      d₁ = ρ d₁ * s := by rw [← h₁.2]; exact hfactor d₁ h₁.1
      _ = ρ d₂ * s := congrArg (fun r : ℕ+ => r * s) heq
      _ = d₂ := by rw [← h₂.2]; exact (hfactor d₂ h₂.1).symm
  have hunit (ℓ : ℤ) (n : ℕ) :
      IsUnit (ℓ : ZMod n) ↔ Nat.Coprime ℓ.natAbs n := by
    simpa only [Int.isCoprime_iff_gcd_eq_one, Int.gcd, Int.natAbs_natCast,
      Nat.gcd_comm, Nat.Coprime] using ZMod.coe_int_isUnit_iff_isCoprime ℓ n
  have hfreq (s r : ℕ+) (hr : r ∈ ℛ s) (ℓ : ℤ) :
      Int.gcd (((b : ℕ) : ℤ) * ℓ) (((r : ℕ) * (s : ℕ) : ℕ) : ℤ) = 1 ↔
        Nat.Coprime ℓ.natAbs ((r : ℕ) * (s : ℕ)) := by
    simp only [Int.gcd, Int.natAbs_mul, Int.natAbs_natCast]
    rw [(hgood s r hr).2.gcd_mul_left_cancel ℓ.natAbs]
  have hlcm (s r₁ r₂ : ℕ+) :
      Nat.lcm ((r₁ : ℕ) * (s : ℕ)) ((r₂ : ℕ) * (s : ℕ)) =
        (s : ℕ) * Nat.lcm (r₁ : ℕ) (r₂ : ℕ) := by
    rw [Nat.lcm_mul_right, Nat.mul_comm]
  have hpairmask (s r₁ r₂ : ℕ+) (hr₁ : r₁ ∈ ℛ s) (hr₂ : r₂ ∈ ℛ s)
      (ℓ : ℤ) :
      (Int.gcd (((b : ℕ) : ℤ) * ℓ) (((r₁ : ℕ) * (s : ℕ) : ℕ) : ℤ) = 1 ∧
        Int.gcd (((b : ℕ) : ℤ) * ℓ) (((r₂ : ℕ) * (s : ℕ) : ℕ) : ℤ) = 1) ↔
        IsUnit (ℓ : ZMod ((s : ℕ) * Nat.lcm (r₁ : ℕ) (r₂ : ℕ))) := by
    rw [hfreq s r₁ hr₁ ℓ, hfreq s r₂ hr₂ ℓ, hunit, ← hlcm]
    constructor
    · rintro ⟨h₁, h₂⟩
      exact (h₁.mul_right h₂).coprime_dvd_right (Nat.lcm_dvd_mul _ _)
    · intro h
      exact ⟨h.coprime_dvd_right (Nat.dvd_lcm_left _ _),
        h.coprime_dvd_right (Nat.dvd_lcm_right _ _)⟩
  have hK (ℓ : ℤ) : K ℓ = ∑ s ∈ 𝒮, F s ℓ := by
    calc
      K ℓ = ∑ d ∈ D,
        if Int.gcd (((b : ℕ) : ℤ) * ℓ) ((d : ℕ) : ℤ) = 1 then
          η ((b : ℕ) * (d : ℕ)) *
            ∑ m ∈ M, if Int.gcd m (((b : ℕ) * (d : ℕ) : ℕ) : ℤ) = 1 then
              α m * normalizedKloosterman3Mod (d : ℕ)
                (((A : ZMod (d : ℕ)) * (m : ZMod (d : ℕ))⁻¹) *
                  (ℓ : ZMod (d : ℕ)))
            else 0
        else 0 := by
        dsimp only [K]
        apply Finset.sum_congr rfl
        intro d hd
        refine if_congr Iff.rfl ?_ rfl
        apply congrArg (fun z : ℂ => η ((b : ℕ) * (d : ℕ)) * z)
        apply Finset.sum_congr rfl
        intro m _
        refine if_congr Iff.rfl ?_ rfl
        apply congrArg (fun z : ℂ => α m * z)
        apply congrArg (normalizedKloosterman3Mod (d : ℕ))
        have hcd : (A : ZMod (d : ℕ)) =
            (A_d d : ZMod (d : ℕ)) * ((b₁ * b₂ * b₃ : ℕ) : ZMod (d : ℕ)) *
              (((b : ℕ) : ZMod (d : ℕ))⁻¹) ^ 3 :=
          (hcoefficient d hd).2
        rw [hcd]
        ring
      _ = ∑ s ∈ 𝒮, ∑ d ∈ D.filter (fun d => σ d = s),
          if Int.gcd (((b : ℕ) : ℤ) * ℓ) ((d : ℕ) : ℤ) = 1 then
            η ((b : ℕ) * (d : ℕ)) *
              ∑ m ∈ M, if Int.gcd m (((b : ℕ) * (d : ℕ) : ℕ) : ℤ) = 1 then
                α m * normalizedKloosterman3Mod (d : ℕ)
                  (((A : ZMod (d : ℕ)) * (m : ZMod (d : ℕ))⁻¹) *
                    (ℓ : ZMod (d : ℕ)))
              else 0
          else 0 :=
        (Finset.sum_fiberwise_of_maps_to (s := D) (t := 𝒮) (g := σ)
          (fun d hd => Finset.mem_image_of_mem σ hd) _).symm
      _ = _ := by
        apply Finset.sum_congr rfl
        intro s _
        dsimp only [F, ℛ]
        rw [Finset.sum_image (hinj s)]
        apply Finset.sum_congr rfl
        intro d hd
        obtain ⟨hdD, hσ⟩ := Finset.mem_filter.mp hd
        have hds : d = ρ d * s := by
          simpa only [hσ] using hfactor d hdD
        have hnat : (ρ d : ℕ) * (s : ℕ) = (d : ℕ) :=
          congrArg (fun n : ℕ+ => (n : ℕ)) hds.symm
        simp only [Nat.mul_assoc, hnat]
        refine if_congr Iff.rfl ?_ rfl
        apply congrArg (fun z : ℂ => η ((b : ℕ) * (d : ℕ)) * z)
        apply Finset.sum_congr rfl
        intro m _
        refine if_congr Iff.rfl ?_ rfl
        apply congrArg (fun z : ℂ => α m * z)
        exact hkernelTransport A m ℓ d (ρ d * s) hds
  have hT₁ : 0 ≤ T₁ := by
    dsimp only [T₁]
    positivity
  have hT₂ : 0 ≤ T₂ := by
    dsimp only [T₂]
    apply Finset.sum_nonneg
    intro s _
    apply Finset.sum_nonneg
    intro ℓ _
    exact mul_nonneg (mul_nonneg (by positivity) (hψnonneg _)) (sq_nonneg _)
  have hCS : (∑ ℓ ∈ L, τ₃ ℓ * ‖K ℓ‖) ^ 2 ≤ T₁ * T₂ := by
    simp_rw [hK]
    exact hfiniteCS 𝒮 L E τ₃ F (fun ℓ => ψ ((ℓ : ℝ) / Hb))
      (fun _ _ => by dsimp only [τ₃]; positivity)
      (fun _ _ => hψnonneg _) hLE hψL
  let e : ℕ+ → ℕ+ → ℂ := fun s r =>
    η ((b : ℕ) * (r : ℕ) * (s : ℕ))
  let mark : ℕ+ → ℕ+ → ℤ → Prop := fun s r m =>
    Int.gcd m (((b : ℕ) * (r : ℕ) * (s : ℕ) : ℕ) : ℤ) = 1
  let freq : ℕ+ → ℕ+ → ℤ → Prop := fun s r ℓ =>
    Int.gcd (((b : ℕ) : ℤ) * ℓ) (((r : ℕ) * (s : ℕ) : ℕ) : ℤ) = 1
  let κ : ℕ+ → ℕ+ → ℤ → ℤ → ℂ := fun s r m ℓ =>
    normalizedKloosterman3Mod ((r : ℕ) * (s : ℕ))
      (((A : ZMod ((r : ℕ) * (s : ℕ))) *
        (m : ZMod ((r : ℕ) * (s : ℕ)))⁻¹) *
        (ℓ : ZMod ((r : ℕ) * (s : ℕ))))
  have hGram : (T₂ : ℂ) = G₂ := by
    simp only [T₂, Complex.ofReal_sum, G₂]
    apply Finset.sum_congr rfl
    intro s _
    rw [← Complex.ofReal_sum]
    have hraw :
        ((∑ ℓ ∈ E, (s : ℝ) * ψ ((ℓ : ℝ) / Hb) * ‖F s ℓ‖ ^ 2 : ℝ) : ℂ) =
          ∑ r₁ ∈ ℛ s, ∑ r₂ ∈ ℛ s, ∑ m₁ ∈ M, ∑ m₂ ∈ M,
            if mark s r₁ m₁ ∧ mark s r₂ m₂ then
              (s : ℂ) * (e s r₁ * star (e s r₂)) * (α m₁ * star (α m₂)) *
                ∑ ℓ ∈ E, if freq s r₁ ℓ ∧ freq s r₂ ℓ then
                  (ψ ((ℓ : ℝ) / Hb) : ℂ) * κ s r₁ m₁ ℓ * star (κ s r₂ m₂ ℓ)
                else 0
            else 0 := by
      simpa only [F, e, κ, freq, mark, Complex.ofReal_natCast] using
        hfiniteGram (ℛ s) M E (e s) α (κ s) (freq s) (mark s)
          (fun ℓ => ψ ((ℓ : ℝ) / Hb)) (s : ℝ)
    rw [hraw]
    apply Finset.sum_congr rfl
    intro r₁ hr₁
    apply Finset.sum_congr rfl
    intro r₂ hr₂
    simp only [mark, U, freq, κ, e, hpairmask s r₁ r₂ hr₁ hr₂]
  have hTB : T₂ ≤ B₂ := by
    rw [← Complex.norm_of_nonneg hT₂, hGram]
    dsimp only [G₂, B₂]
    refine norm_sum_le_of_le _ (fun s _ => ?_)
    refine norm_sum_le_of_le _ (fun r₁ _ => ?_)
    refine norm_sum_le_of_le _ (fun r₂ _ => ?_)
    refine norm_sum_le_of_le _ (fun m₁ _ => ?_)
    refine norm_sum_le_of_le _ (fun m₂ _ => ?_)
    split_ifs <;>
      simp only [norm_mul, norm_star, Complex.norm_natCast, mul_assoc, norm_zero, le_refl]
  refine ⟨hHb, hL, hLE, hψL, hψE, hK, hT₁, hT₂, hCS, hGram, hTB,
    hCS.trans (mul_le_mul_of_nonneg_left hTB hT₁), ?_⟩
  intro s _ r₁ hr₁ r₂ hr₂
  have h₁ := (hgood s r₁ hr₁).1
  have h₂ := (hgood s r₂ hr₂).1
  have hc₁ := (Nat.coprime_of_squarefree_mul h₁).symm
  have hc₂ := (Nat.coprime_of_squarefree_mul h₂).symm
  refine ⟨hmember s r₁ hr₁, hmember s r₂ hr₂,
    h₁.of_mul_right, h₁.of_mul_left, h₂.of_mul_left, hc₁.mul_right hc₂, ?_⟩
  apply hAunit
  rw [← hlcm]
  exact Nat.lcm_dvd
    (hcoefficient (r₁ * s) (hmember s r₁ hr₁)).1
    (hcoefficient (r₂ * s) (hmember s r₂ hr₂)).1

end

section
open scoped ContDiff
open Classical in
theorem heathBrown_geometric_profiles_uniform :
    ∃ C : ℕ → ℝ, (∀ r : ℕ, 0 < C r) ∧
      ∀ Θ : ℝ, 1 < Θ → Θ ≤ 2 →
        let η : ℝ → ℝ := fun u =>
          if 0 < u then
            Real.smoothTransition (Real.log u / Real.log Θ + 1) -
              Real.smoothTransition (Real.log u / Real.log Θ)
          else 0
        ContDiff ℝ ∞ η ∧
          Function.support η = Set.Ioo Θ⁻¹ Θ ∧
          (∀ u : ℝ, 0 ≤ η u ∧ η u ≤ 1) ∧
          (∀ (N t : ℝ) (logWeight : Bool), 1 ≤ N → 0 ≤ t → t ≤ 10 →
            let φ : ℝ → ℝ := fun u =>
              η u * Real.rpow (N * u) (-t) *
                (if logWeight then Real.log (N * u) else 1)
            ContDiff ℝ ∞ φ ∧
              Function.support φ ⊆ Set.Icc (1 / 2 : ℝ) 2 ∧
              ∀ (r : ℕ) (u : ℝ),
                ‖iteratedDeriv r φ u‖ ≤
                  C r * (1 + Real.log N) / (Θ - 1) ^ r) ∧
          ∀ R : ℝ, 1 ≤ R →
            let M : ℕ := ⌈Real.log R / Real.log Θ⌉₊
            ((M + 1 : ℕ) : ℝ) ≤ 2 * Real.log R / (Θ - 1) + 2 ∧
              (∀ y : ℝ, 1 ≤ y →
                0 ≤ (∑ m ∈ Finset.range (M + 1), η (y / Θ ^ m)) ∧
                  (∑ m ∈ Finset.range (M + 1), η (y / Θ ^ m)) ≤ 1) ∧
              ∀ y : ℝ, 1 ≤ y → y ≤ R →
                ∑ m ∈ Finset.range (M + 1), η (y / Θ ^ m) = 1 := by
  let χ : ℝ → ℝ := fun z => Real.smoothTransition (z + 1) - Real.smoothTransition z
  obtain ⟨hχ, hχsupport, hχrange, hχpartition, _⟩ :=
    sourceShortSmoothPartition_kernel
  change ContDiff ℝ ∞ χ at hχ
  change Function.support χ = Set.Ioo (-1) 1 at hχsupport
  change ∀ z : ℝ, 0 ≤ χ z ∧ χ z ≤ 1 at hχrange
  let P := (ℝ × ℝ) × (ℝ × ℝ)
  let O : Set P := {p | 0 < p.2.2}
  let K : Set P := (Set.Icc (0 : ℝ) 10 ×ˢ Set.Icc (0 : ℝ) 1) ×ˢ
    (Set.Icc (-1 : ℝ) 1 ×ˢ Set.Icc (1 / 2 : ℝ) 2)
  let J : ℝ → ℝ × ℝ := fun u => (Real.log u, u)
  let F : Bool → P → ℝ := fun b p =>
    χ p.2.1 * p.2.2 ^ (-p.1.1) *
      (if b then p.1.2 + (1 - p.1.2) * Real.log p.2.2 else 1 - p.1.2)
  have hO : IsOpen O := isOpen_lt continuous_const continuous_snd.snd
  have hOu : UniqueDiffOn ℝ O := hO.uniqueDiffOn
  have hK : IsCompact K := (isCompact_Icc.prod isCompact_Icc).prod
    (isCompact_Icc.prod isCompact_Icc)
  have hKO : K ⊆ O := fun _ hp => one_half_pos.trans_le hp.2.2.1
  have hF (b : Bool) : ContDiffOn ℝ ∞ (F b) O := by
    have hid : ContDiffOn ℝ ∞ (fun p : P => p) O := contDiffOn_id
    have hz : ContDiffOn ℝ ∞ (fun p : P => p.2.1) O := hid.snd.fst
    have hu : ContDiffOn ℝ ∞ (fun p : P => p.2.2) O := hid.snd.snd
    have ht : ContDiffOn ℝ ∞ (fun p : P => p.1.1) O := hid.fst.fst
    have ha : ContDiffOn ℝ ∞ (fun p : P => p.1.2) O := hid.fst.snd
    have hu0 : ∀ p ∈ O, p.2.2 ≠ 0 := fun p hp => ne_of_gt hp
    have hpow := hu.rpow ht.neg hu0
    have hlog := hu.log hu0
    cases b
    · exact ((hχ.comp_contDiffOn hz).mul hpow).mul (contDiffOn_const.sub ha)
    · exact ((hχ.comp_contDiffOn hz).mul hpow).mul
        (ha.add ((contDiffOn_const.sub ha).mul hlog))
  have hJ : ContDiffOn ℝ ∞ J (Set.Ioi 0) :=
    (contDiffOn_id.log (fun u hu => ne_of_gt hu)).prodMk contDiffOn_id
  have hIu : UniqueDiffOn ℝ (Set.Ioi (0 : ℝ)) := isOpen_Ioi.uniqueDiffOn
  have hAexists (b : Bool) (r : ℕ) : ∃ a : ℝ, 0 < a ∧
      ∀ p ∈ K, ‖iteratedFDerivWithin ℝ r (F b) O p‖ ≤ a := by
    have hc := ((hF b).continuousOn_iteratedFDerivWithin (m := r) (by simp) hOu).mono hKO
    obtain ⟨a, ha, hbound⟩ := (hK.image_of_continuousOn hc).isBounded.exists_pos_norm_le
    exact ⟨a, ha, fun p hp => hbound _ (Set.mem_image_of_mem _ hp)⟩
  have hBexists (r : ℕ) : ∃ b : ℝ, 0 < b ∧
      ∀ u ∈ Set.Icc (1 / 2 : ℝ) 2,
        ‖iteratedFDerivWithin ℝ r J (Set.Ioi 0) u‖ ≤ b := by
    have hsub : Set.Icc (1 / 2 : ℝ) 2 ⊆ Set.Ioi 0 :=
      fun _ hu => one_half_pos.trans_le hu.1
    have hc := (hJ.continuousOn_iteratedFDerivWithin (m := r) (by simp) hIu).mono hsub
    obtain ⟨b, hb, hbound⟩ := (isCompact_Icc.image_of_continuousOn hc).isBounded.exists_pos_norm_le
    exact ⟨b, hb, fun u hu => hbound _ (Set.mem_image_of_mem _ hu)⟩
  choose A hApos hAbound using hAexists
  choose B hBpos hBbound using hBexists
  let A₀ : ℕ → ℝ := fun r => 1 + ∑ i ∈ Finset.range (r + 1), (A false i + A true i)
  let B₀ : ℕ → ℝ := fun r => 1 + ∑ i ∈ Finset.range (r + 1), B i
  have hA₀ (r : ℕ) : 1 ≤ A₀ r :=
    le_add_of_nonneg_right (Finset.sum_nonneg
      (fun i _ => add_nonneg (hApos false i).le (hApos true i).le))
  have hB₀ (r : ℕ) : 1 ≤ B₀ r :=
    le_add_of_nonneg_right (Finset.sum_nonneg (fun i _ => (hBpos i).le))
  have hAprefix (b : Bool) (i r : ℕ) (hir : i ≤ r) : A b i ≤ A₀ r := by
    have hs : A false i + A true i ≤
        ∑ j ∈ Finset.range (r + 1), (A false j + A true j) :=
      Finset.single_le_sum (fun j _ => add_nonneg (hApos false j).le (hApos true j).le)
        (Finset.mem_range_succ_iff.mpr hir)
    have hi : A b i ≤ A false i + A true i := by
      cases b
      · exact le_add_of_nonneg_right (hApos true i).le
      · exact le_add_of_nonneg_left (hApos false i).le
    exact hi.trans (hs.trans (le_add_of_nonneg_left zero_le_one))
  have hBprefix (i r : ℕ) (hir : i ≤ r) : B i ≤ B₀ r := by
    have hs := Finset.single_le_sum (fun j (_ : j ∈ Finset.range (r + 1)) => (hBpos j).le)
      (Finset.mem_range_succ_iff.mpr hir)
    exact hs.trans (le_add_of_nonneg_left zero_le_one)
  let C : ℕ → ℝ := fun r => (r.factorial : ℝ) * A₀ r * (2 * B₀ r) ^ r
  have hC (r : ℕ) : 0 < C r := by
    have ha : 0 < A₀ r := zero_lt_one.trans_le (hA₀ r)
    have hb : 0 < B₀ r := zero_lt_one.trans_le (hB₀ r)
    dsimp only [C]
    positivity
  refine ⟨C, hC, ?_⟩
  intro Θ hΘ hΘ₂ η
  have hΘpos : 0 < Θ := zero_lt_one.trans hΘ
  have hlogΘ : 0 < Real.log Θ := Real.log_pos hΘ
  have hδ : 0 < Θ - 1 := sub_pos.mpr hΘ
  have hinvΘ : 0 < Θ⁻¹ := inv_pos.mpr hΘpos
  have hinvhalf : (1 / 2 : ℝ) ≤ Θ⁻¹ := by
    simpa only [one_div] using one_div_le_one_div_of_le hΘpos hΘ₂
  have hloglower : (Θ - 1) / 2 ≤ Real.log Θ := by
    nlinarith [Real.self_sub_one_le_mul_log hΘpos.le,
      mul_nonneg (sub_nonneg.mpr hΘ₂) hlogΘ.le]
  have hloginv : (Real.log Θ)⁻¹ ≤ 2 / (Θ - 1) :=
    inv_le_of_inv_le₀ (by positivity) (by simpa only [inv_div] using hloglower)
  have hηpositive (u : ℝ) (hu : 0 < u) : η u = χ (Real.log u / Real.log Θ) :=
    ite_eq_left hu
  have hηsupport : Function.support η = Set.Ioo Θ⁻¹ Θ := by
    ext u
    by_cases hu : 0 < u
    · change η u ≠ 0 ↔ Θ⁻¹ < u ∧ u < Θ
      rw [hηpositive u hu]
      change Real.log u / Real.log Θ ∈ Function.support χ ↔ _
      rw [hχsupport]
      change (-1 < Real.logb Θ u ∧ Real.logb Θ u < 1) ↔ _
      rw [Real.lt_logb_iff_rpow_lt hΘ hu, Real.logb_lt_iff_lt_rpow hΘ hu,
        Real.rpow_neg_one, Real.rpow_one]
    · have hlo : ¬Θ⁻¹ < u := by linarith
      simp only [Function.mem_support, η, ite_eq_right hu, ne_eq, not_true_eq_false,
        Set.mem_Ioo, hlo, false_and]
  have hηrange (u : ℝ) : 0 ≤ η u ∧ η u ≤ 1 := by
    by_cases hu : 0 < u
    · rw [hηpositive u hu]
      exact hχrange _
    · simp only [η, ite_eq_right hu, le_refl, zero_le_one, and_self]
  have hηclosed : Function.support η ⊆ Set.Icc Θ⁻¹ Θ :=
    hηsupport.subset.trans Set.Ioo_subset_Icc_self
  have hclosedbox : Set.Icc Θ⁻¹ Θ ⊆ Set.Icc (1 / 2 : ℝ) 2 :=
    Set.Icc_subset_Icc hinvhalf hΘ₂
  have hzeroLocal (f : ℝ → ℝ) (hf : Function.support f ⊆ Set.Icc Θ⁻¹ Θ)
      (u : ℝ) (hu : u ∉ Set.Icc Θ⁻¹ Θ) : f =ᶠ[nhds u] fun _ => 0 := by
    filter_upwards [isClosed_Icc.isOpen_compl.mem_nhds hu] with v hv
    exact Function.notMem_support.mp (fun hvf => hv (hf hvf))
  have hηsmooth : ContDiff ℝ ∞ η := by
    apply contDiff_iff_contDiffAt.mpr
    intro u
    by_cases hu : 0 < u
    · have heq : η =ᶠ[nhds u] fun v => χ (Real.log v / Real.log Θ) := by
        filter_upwards [isOpen_Ioi.mem_nhds hu] with v hv
        exact hηpositive v hv
      exact (hχ.contDiffAt.comp u
        ((contDiffAt_id.log hu.ne').div_const (Real.log Θ))).congr_of_eventuallyEq heq
    · have ho : u ∉ Set.Icc Θ⁻¹ Θ := fun h => hu (hinvΘ.trans_le h.1)
      exact contDiffAt_const.congr_of_eventuallyEq (hzeroLocal η hηclosed u ho)
  refine ⟨hηsmooth, hηsupport, hηrange, ?_, ?_⟩
  · intro N t b hN ht ht₁₀ φ
    have hNp : 0 < N := zero_lt_one.trans_le hN
    have hlogN : 0 ≤ Real.log N := Real.log_nonneg hN
    have hlog1 : 0 < 1 + Real.log N := by linarith
    let a : ℝ := Real.log N / (1 + Real.log N)
    have ha0 : 0 ≤ a := div_nonneg hlogN hlog1.le
    have ha1 : a ≤ 1 := (div_le_iff₀ hlog1).mpr (by linarith)
    let k : ℝ := N ^ (-t) * (1 + Real.log N)
    have hk0 : 0 ≤ k := mul_nonneg (Real.rpow_nonneg hNp.le _) hlog1.le
    have hk : k ≤ 1 + Real.log N :=
      mul_le_of_le_one_left hlog1.le
        (Real.rpow_le_one_of_one_le_of_nonpos hN (neg_nonpos.mpr ht))
    let inner : ℝ → P := fun u => ((t, a), (Real.log u / Real.log Θ, u))
    have hinner : ContDiffOn ℝ ∞ inner (Set.Ioi 0) :=
      contDiffOn_const.prodMk
        (((contDiffOn_id.log (fun u hu => ne_of_gt hu)).div_const (Real.log Θ)).prodMk
          contDiffOn_id)
    have hinnerO : Set.MapsTo inner (Set.Ioi 0) O := fun _ hu => hu
    have hφclosed : Function.support φ ⊆ Set.Icc Θ⁻¹ Θ :=
      (Function.support_mul_subset_left _ _).trans
        ((Function.support_mul_subset_left _ _).trans hηclosed)
    have hφsmooth : ContDiff ℝ ∞ φ := by
      apply contDiff_iff_contDiffAt.mpr
      intro u
      by_cases hu : 0 < u
      · have hNu : N * u ≠ 0 := (mul_pos hNp hu).ne'
        have hmul : ContDiffAt ℝ ∞ (fun v : ℝ => N * v) u :=
          contDiffAt_const.mul contDiffAt_id
        have hf := hηsmooth.contDiffAt.mul (hmul.rpow_const_of_ne (p := -t) hNu)
        cases b
        · exact hf.mul contDiffAt_const
        · exact hf.mul (hmul.log hNu)
      · have ho : u ∉ Set.Icc Θ⁻¹ Θ := fun h => hu (hinvΘ.trans_le h.1)
        exact contDiffAt_const.congr_of_eventuallyEq (hzeroLocal φ hφclosed u ho)
    have hformula : Set.EqOn φ (fun u => k * F b (inner u)) (Set.Ioi 0) := by
      intro u hu
      dsimp only [φ]
      rw [hηpositive u hu, Real.rpow_eq_pow, Real.mul_rpow hNp.le hu.le]
      dsimp only [k, F, inner, a]
      cases b
      · simp only [Bool.false_eq_true, ite_false]
        field_simp [hlog1.ne']
        ring
      · simp only [ite_true]
        rw [Real.log_mul hNp.ne' hu.ne']
        field_simp [hlog1.ne']
        ring
    refine ⟨hφsmooth, hφclosed.trans hclosedbox, ?_⟩
    intro r u
    by_cases huK : u ∈ Set.Icc Θ⁻¹ Θ
    · have hu : 0 < u := hinvΘ.trans_le huK.1
      have hubox := hclosedbox huK
      have hinnerK : inner u ∈ K := by
        refine ⟨⟨⟨ht, ht₁₀⟩, ⟨ha0, ha1⟩⟩, ⟨?_, hubox⟩⟩
        change -1 ≤ Real.logb Θ u ∧ Real.logb Θ u ≤ 1
        rw [Real.le_logb_iff_rpow_le hΘ hu, Real.logb_le_iff_le_rpow hΘ hu,
          Real.rpow_neg_one, Real.rpow_one]
        exact huK
      let L : (ℝ × ℝ) →L[ℝ] P :=
        (0 : (ℝ × ℝ) →L[ℝ] (ℝ × ℝ)).prod
          (((Real.log Θ)⁻¹ • ContinuousLinearMap.fst ℝ ℝ ℝ).prod
            (ContinuousLinearMap.snd ℝ ℝ ℝ))
      have hLnorm : ‖L‖ ≤ 2 / (Θ - 1) := by
        dsimp only [L, P]
        simp only [ContinuousLinearMap.opNorm_prod, Prod.norm_def, norm_zero,
          norm_smul, ContinuousLinearMap.norm_fst, ContinuousLinearMap.norm_snd,
          norm_inv, Real.norm_eq_abs, abs_of_pos hlogΘ, mul_one, max_le_iff]
        exact ⟨by positivity, hloginv, (le_div_iff₀ hδ).mpr (by linarith)⟩
      have hinnerEq : inner = fun v => ((t, a), (0, 0)) + L (J v) := by
        funext v
        change ((t, a), (Real.log v / Real.log Θ, v)) =
          ((t + 0, a + 0), (0 + (Real.log Θ)⁻¹ * Real.log v, 0 + v))
        simp only [add_zero, zero_add]
        exact congrArg (fun z : ℝ => ((t, a), (z, v))) (div_eq_inv_mul _ _)
      let D : ℝ := 2 * B₀ r / (Θ - 1)
      have hD : 1 ≤ D := by
        apply (le_div_iff₀ hδ).mpr
        linarith [hB₀ r]
      have hInnerDerivative (i : ℕ) (hi : 1 ≤ i) (hir : i ≤ r) :
          ‖iteratedFDerivWithin ℝ i inner (Set.Ioi 0) u‖ ≤ D ^ i := by
        have hLin := L.norm_iteratedFDerivWithin_comp_left
          (hJ u hu) hIu hu (show (i : ℕ∞ω) ≤ (∞ : ℕ∞ω) by simp)
        have hBbound' : ‖iteratedFDerivWithin ℝ i J (Set.Ioi 0) u‖ ≤ B₀ r :=
          (hBbound i u hubox).trans (hBprefix i r hir)
        calc
          _ ≤ ‖L‖ * ‖iteratedFDerivWithin ℝ i J (Set.Ioi 0) u‖ := by
            simpa only [norm_iteratedFDerivWithin_eq_norm_iteratedDerivWithin,
              hinnerEq, iteratedDerivWithin_const_add hi,
              Function.comp_def]
              using hLin
          _ ≤ (2 / (Θ - 1)) * B₀ r :=
            mul_le_mul hLnorm hBbound' (norm_nonneg _) (by positivity)
          _ = D := by dsimp only [D]; ring
          _ ≤ D ^ i := Bound.le_self_pow_of_pos hD hi
      have hcomp := norm_iteratedFDerivWithin_comp_le (hF b) hinner
        (show (r : ℕ∞ω) ≤ (∞ : ℕ∞ω) by simp) hOu hIu hinnerO hu
        (fun i hir => (hAbound b i (inner u) hinnerK).trans (hAprefix b i r hir))
        hInnerDerivative
      have hderiv : iteratedDeriv r φ u =
          k * iteratedDerivWithin r (F b ∘ inner) (Set.Ioi 0) u := by
        rw [← iteratedDerivWithin_eq_iteratedDeriv hIu
          (hφsmooth.of_le (show (r : ℕ∞ω) ≤ (∞ : ℕ∞ω) by simp)).contDiffAt hu]
        rw [iteratedDerivWithin_congr hformula hu, iteratedDerivWithin_const_mul_field]
        rfl
      rw [hderiv, norm_mul, Real.norm_eq_abs, abs_of_nonneg hk0]
      calc
        _ ≤ (1 + Real.log N) * ((r.factorial : ℝ) * A₀ r * D ^ r) := by
          apply mul_le_mul hk _ (norm_nonneg _) hlog1.le
          simpa only [norm_iteratedFDerivWithin_eq_norm_iteratedDerivWithin] using hcomp
        _ = C r * (1 + Real.log N) / (Θ - 1) ^ r := by
          dsimp only [C, D]
          rw [div_pow]
          ring
    · rw [(hzeroLocal φ hφclosed u huK).iteratedDeriv_eq r]
      rw [iteratedDeriv_fun_const_zero, norm_zero]
      exact div_nonneg (mul_nonneg (hC r).le hlog1.le) (pow_nonneg hδ.le _)
  · intro R hR M
    have hlogR : 0 ≤ Real.log R := Real.log_nonneg hR
    have hratioR : 0 ≤ Real.log R / Real.log Θ := Real.logb_nonneg hΘ hR
    have hMceil : (M : ℝ) < Real.log R / Real.log Θ + 1 :=
      Nat.ceil_lt_add_one hratioR
    have hcount : ((M + 1 : ℕ) : ℝ) ≤ 2 * Real.log R / (Θ - 1) + 2 := by
      have hratio : Real.log R / Real.log Θ ≤ 2 * Real.log R / (Θ - 1) := by
        calc
          _ = Real.log R * (Real.log Θ)⁻¹ := div_eq_mul_inv _ _
          _ ≤ Real.log R * (2 / (Θ - 1)) := mul_le_mul_of_nonneg_left hloginv hlogR
          _ = _ := by ring
      push_cast
      linarith
    have hgrid (y : ℝ) (hy : 0 < y) (m : ℕ) :
        η (y / Θ ^ m) = χ (Real.log y / Real.log Θ - (m : ℝ)) := by
      rw [hηpositive _ (div_pos hy (pow_pos hΘpos _)),
        Real.log_div hy.ne' (pow_pos hΘpos _).ne', Real.log_pow]
      congr 1
      field_simp [hlogΘ.ne']
    have hsum (y : ℝ) (hy : 1 ≤ y) :
        (∑ m ∈ Finset.range (M + 1), η (y / Θ ^ m)) =
          ∑ m ∈ Finset.range (M + 1), χ (Real.log y / Real.log Θ - (m : ℝ)) :=
      Finset.sum_congr rfl (fun m _ => hgrid y (zero_lt_one.trans_le hy) m)
    refine ⟨hcount, ?_, ?_⟩
    · intro y hy
      refine ⟨Finset.sum_nonneg (fun m _ => (hηrange _).1), ?_⟩
      let s : ℝ := Real.log y / Real.log Θ
      have hs : 0 ≤ s := Real.logb_nonneg hΘ hy
      let J : ℕ := max M ⌈s⌉₊
      have hJs : s ≤ (J : ℝ) := (Nat.le_ceil s).trans (by exact_mod_cast le_max_right M ⌈s⌉₊)
      rw [hsum y hy]
      calc
        _ ≤ ∑ m ∈ Finset.range (J + 1), χ (s - (m : ℝ)) :=
          Finset.sum_le_sum_of_subset_of_nonneg
            (Finset.range_mono (Nat.succ_le_succ (le_max_left M ⌈s⌉₊)))
            (fun m _ _ => (hχrange _).1)
        _ = 1 := hχpartition J s hs hJs
    · intro y hy hyR
      have hy0 : 0 < y := zero_lt_one.trans_le hy
      have hs : 0 ≤ Real.log y / Real.log Θ :=
        Real.logb_nonneg hΘ hy
      have hupper : Real.log y / Real.log Θ ≤ (M : ℝ) := by
        calc
          _ ≤ Real.log R / Real.log Θ :=
            Real.logb_le_logb_of_le hΘ hy0 hyR
          _ ≤ (M : ℝ) := Nat.le_ceil _
      rw [hsum y hy]
      exact hχpartition M (Real.log y / Real.log Θ) hs hupper

open Classical in
theorem heathBrown_finite_smooth_box_boundary
    (j : ℕ) (hj : 0 < j)
    (A B U Θ t : ℝ)
    (hA : 1 ≤ A) (hAB : A ≤ B)
    (hΘ : 1 < Θ) (hΘtwo : Θ ≤ 2)
    (ht : 0 ≤ t) (_ : t ≤ 10) :
    let η : ℝ → ℝ := fun u =>
      if 0 < u then
        Real.smoothTransition (Real.log u / Real.log Θ + 1) -
          Real.smoothTransition (Real.log u / Real.log Θ)
      else 0
    let M : ℕ := ⌈Real.log B / Real.log Θ⌉₊
    let J : Finset (Fin (2 * j) → ℕ) :=
      Fintype.piFinset (fun _ : Fin (2 * j) => Finset.range (M + 1))
    let scale : (Fin (2 * j) → ℕ) → Fin (2 * j) → ℝ :=
      fun ν i => Θ ^ (ν i)
    let E : Finset (Fin (2 * j) → ℕ) := J.filter (fun ν =>
      A / Θ ^ (2 * j) ≤ (∏ i : Fin (2 * j), scale ν i) ∧
        (∏ i : Fin (2 * j), scale ν i) ≤ B * Θ ^ (2 * j))
    let μU : ArithmeticFunction ℝ :=
      arithmeticFunctionLowCutoff U
        (ArithmeticFunction.moebius : ArithmeticFunction ℝ)
    let H : ArithmeticFunction ℝ :=
      μU ^ j * (ArithmeticFunction.zeta : ArithmeticFunction ℝ) ^ (j - 1) *
        ArithmeticFunction.log
    let f : Fin (2 * j) → ArithmeticFunction ℝ := fun i =>
      if i.val < j then μU
      else if i.val + 1 = 2 * j then ArithmeticFunction.log
      else (ArithmeticFunction.zeta : ArithmeticFunction ℝ)
    let β : (Fin (2 * j) → ℕ) → Fin (2 * j) → MonoidAlgebra ℂ ℕ :=
      fun ν i => ∑ n ∈ Finset.Icc 1 ⌊Θ * scale ν i⌋₊,
        MonoidAlgebra.single n
          ((η ((n : ℝ) / scale ν i) * Real.rpow (n : ℝ) (-t) * f i n : ℝ) : ℂ)
    let g : ℕ →₀ ℂ := ∑ ν ∈ E, (∏ i : Fin (2 * j), β ν i).coeff
    let target : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc ⌈A⌉₊ ⌊B⌋₊,
      Finsupp.single n ((Real.rpow (n : ℝ) (-t) * H n : ℝ) : ℂ)
    let error : ℕ →₀ ℂ := g - target
    E.card ≤ (M + 1) ^ (2 * j) ∧
      target = g.filter (fun n : ℕ => A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B) ∧
      (∀ ν ∈ E, ∀ i : Fin (2 * j), ∀ n ∈ (β ν i).coeff.support,
        scale ν i / Θ ≤ (n : ℝ) ∧ (n : ℝ) ≤ Θ * scale ν i ∧
          ‖(β ν i).coeff n‖ ≤ 1 + Real.log (n : ℝ)) ∧
      (∀ n ∈ error.support,
        (A / Θ ^ (4 * j) ≤ (n : ℝ) ∧ (n : ℝ) < A) ∨
          (B < (n : ℝ) ∧ (n : ℝ) ≤ B * Θ ^ (4 * j))) ∧
      ∀ n : ℕ, ‖error n‖ ≤
        (n.divisors.card : ℝ) ^ (2 * j - 1) * Real.log (n : ℝ) := by
  intro η M J scale E μU H f β g target error
  have hB : 1 ≤ B := hA.trans hAB
  have hΘpos : 0 < Θ := zero_lt_one.trans hΘ
  have hpow (m : ℕ) : 0 < Θ ^ m := pow_pos hΘpos m
  obtain ⟨_, _, hprofiles⟩ := heathBrown_geometric_profiles_uniform
  rcases hprofiles Θ hΘ hΘtwo with ⟨_, hηsupport, hηbounds, _, hgrid⟩
  change Function.support η = Set.Ioo Θ⁻¹ Θ at hηsupport
  change ∀ u : ℝ, 0 ≤ η u ∧ η u ≤ 1 at hηbounds
  rcases hgrid B hB with ⟨_, hmass, hpartition⟩
  change ∀ y : ℝ, 1 ≤ y →
    0 ≤ (∑ m ∈ Finset.range (M + 1), η (y / Θ ^ m)) ∧
      (∑ m ∈ Finset.range (M + 1), η (y / Θ ^ m)) ≤ 1 at hmass
  change ∀ y : ℝ, 1 ≤ y → y ≤ B →
    ∑ m ∈ Finset.range (M + 1), η (y / Θ ^ m) = 1 at hpartition
  have hηmem {u : ℝ} (hu : η u ≠ 0) : Θ⁻¹ < u ∧ u < Θ := by
    have hu' : u ∈ Function.support η := hu
    rwa [hηsupport] at hu'
  let a : ℕ → Fin (2 * j) → ArithmeticFunction ℝ := fun m i =>
    ⟨fun n => η ((n : ℝ) / Θ ^ m) * Real.rpow (n : ℝ) (-t) * f i n,
      by simp⟩
  let aabs : ℕ → Fin (2 * j) → ArithmeticFunction ℝ := fun m i =>
    ⟨fun n => η ((n : ℝ) / Θ ^ m) * Real.rpow (n : ℝ) (-t) * |f i n|,
      by simp⟩
  let z : Fin (2 * j) → ArithmeticFunction ℝ := fun i =>
    if i.val < j then (ArithmeticFunction.zeta : ArithmeticFunction ℝ)
    else if i.val + 1 = 2 * j then ArithmeticFunction.log
    else (ArithmeticFunction.zeta : ArithmeticFunction ℝ)
  let ev (n : ℕ) : ArithmeticFunction ℝ →+ ℝ :=
    { toFun := fun F => F n
      map_zero' := rfl
      map_add' := fun _ _ => rfl }
  have hasupport (m : ℕ) (i : Fin (2 * j)) (n : ℕ)
      (han : a m i n ≠ 0) :
      0 < n ∧ Θ ^ m / Θ ≤ (n : ℝ) ∧ (n : ℝ) ≤ Θ * Θ ^ m := by
    have hηne : η ((n : ℝ) / Θ ^ m) ≠ 0 :=
      left_ne_zero_of_mul (left_ne_zero_of_mul han)
    rcases hηmem hηne with ⟨hl, hu⟩
    have hlo : Θ⁻¹ * Θ ^ m < (n : ℝ) := (lt_div_iff₀ (hpow m)).mp hl
    have hup : (n : ℝ) < Θ * Θ ^ m := (div_lt_iff₀ (hpow m)).mp hu
    refine ⟨?_, ?_, hup.le⟩
    · exact_mod_cast (mul_pos (inv_pos.mpr hΘpos) (hpow m)).trans hlo
    · simpa only [div_eq_mul_inv, mul_comm] using hlo.le
  have hβ (ν : Fin (2 * j) → ℕ) (i : Fin (2 * j)) (n : ℕ) :
      (β ν i).coeff n = (a (ν i) i n : ℂ) := by
    have hcut : (β ν i).coeff n =
        if n ∈ Finset.Icc 1 ⌊Θ * scale ν i⌋₊ then (a (ν i) i n : ℂ) else 0 := by
      simp only [β, a, scale, MonoidAlgebra.coeff_sum, MonoidAlgebra.coeff_single,
        Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_ite_eq',
        ArithmeticFunction.coe_mk]
    rw [hcut]
    by_cases hn : n ∈ Finset.Icc 1 ⌊Θ * scale ν i⌋₊
    · exact ite_eq_left hn
    · rw [ite_eq_right hn]
      have ha : a (ν i) i n = 0 := by
        by_contra ha
        rcases hasupport (ν i) i n ha with ⟨hnpos, _, hnup⟩
        exact hn (Finset.mem_Icc.mpr ⟨hnpos, Nat.le_floor (by simpa only [scale] using hnup)⟩)
      rw [ha, Complex.ofReal_zero]
  have hcoeffMul (P Q : MonoidAlgebra ℂ ℕ) (p q : ArithmeticFunction ℝ)
      (hP : ∀ n, P.coeff n = (p n : ℂ)) (hQ : ∀ n, Q.coeff n = (q n : ℂ)) :
      ∀ n : ℕ, (P * Q).coeff n = ((p * q) n : ℂ) := by
    intro n
    by_cases hn : n = 0
    · subst n
      simp only [ArithmeticFunction.map_zero, Complex.ofReal_zero,
        MonoidAlgebra.coeff_mul, Finsupp.sum]
      apply Finset.sum_eq_zero
      intro x _
      apply Finset.sum_eq_zero
      intro y _
      split_ifs with hxy
      · rcases Nat.mul_eq_zero.mp hxy with hx0 | hy0
        · subst x
          rw [hP]
          simp
        · subst y
          rw [hQ]
          simp
      · rfl
    · rw [MonoidAlgebra.coeff_mul_antidiag P Q n n.divisorsAntidiagonal
        (by intro d; exact Nat.prodMk_mem_divisorsAntidiag hn)]
      simp only [ArithmeticFunction.mul_apply, Complex.ofReal_sum, Complex.ofReal_mul, hP, hQ]
  have hβprod (ν : Fin (2 * j) → ℕ) (s : Finset (Fin (2 * j))) :
      ∀ n : ℕ, (∏ i ∈ s, β ν i).coeff n = ((∏ i ∈ s, a (ν i) i) n : ℂ) := by
    induction s using Finset.induction_on with
    | empty =>
        intro n
        simp only [Finset.prod_empty, ArithmeticFunction.one_apply, MonoidAlgebra.one_def,
          MonoidAlgebra.coeff_single, Finsupp.single_apply, eq_comm]
        split_ifs <;> norm_num
    | @insert i s hi ih =>
        intro n
        simp only [Finset.prod_insert hi]
        exact hcoeffMul (β ν i) (∏ k ∈ s, β ν k)
          (a (ν i) i) (∏ k ∈ s, a (ν k) k) (hβ ν i) ih n
  have hg (n : ℕ) :
      g n = ∑ ν ∈ E, ((∏ i : Fin (2 * j), a (ν i) i) n : ℂ) := by
    simp only [g, Finsupp.finsetSum_apply, hβprod]
  have hslots (X Y Z : ArithmeticFunction ℝ) :
      (∏ i : Fin (2 * j),
        if i.val < j then X else if i.val + 1 = 2 * j then Z else Y) =
        X ^ j * Y ^ (j - 1) * Z := by
    let q : Fin (2 * j) := ⟨2 * j - 1, by omega⟩
    have hfirst : (Finset.univ.filter (fun i : Fin (2 * j) => i.val < j)).card = j := by
      simpa only [Nat.min_eq_right (by omega : j ≤ 2 * j)] using
        (Fin.card_filter_val_lt (n := 2 * j) (m := j))
    have hlast :
        ((Finset.univ.filter (fun i : Fin (2 * j) => ¬i.val < j)).filter
          (fun i => i.val + 1 = 2 * j)) = {q} := by
      ext i
      simp only [Finset.mem_filter, Finset.mem_univ, true_and, Finset.mem_singleton,
        Fin.ext_iff]
      dsimp only [q]
      omega
    have hc := Finset.card_filter_add_card_filter_not
      (s := Finset.univ) (fun i : Fin (2 * j) => i.val < j)
    rw [hfirst, Finset.card_univ, Fintype.card_fin] at hc
    have hm := Finset.card_filter_add_card_filter_not
      (s := Finset.univ.filter (fun i : Fin (2 * j) => ¬i.val < j))
      (fun i => i.val + 1 = 2 * j)
    rw [hlast, Finset.card_singleton] at hm
    have hmiddle :
        ((Finset.univ.filter (fun i : Fin (2 * j) => ¬i.val < j)).filter
          (fun i => ¬i.val + 1 = 2 * j)).card = j - 1 := by omega
    rw [Finset.prod_ite, Finset.prod_const, hfirst, Finset.prod_ite,
      Finset.prod_const, hlast, Finset.card_singleton, pow_one,
      Finset.prod_const, hmiddle]
    ac_rfl
  have hfprod : (∏ i : Fin (2 * j), f i) = H :=
    hslots μU (ArithmeticFunction.zeta : ArithmeticFunction ℝ) ArithmeticFunction.log
  have hzprod : (∏ i : Fin (2 * j), z i) =
      (ArithmeticFunction.zeta : ArithmeticFunction ℝ) ^ (2 * j - 1) *
        ArithmeticFunction.log := by
    dsimp only [z]
    rw [hslots, ← pow_add, show j + (j - 1) = 2 * j - 1 by omega]
  have hμ (n : ℕ) : |μU n| ≤ (ArithmeticFunction.zeta : ArithmeticFunction ℝ) n := by
    by_cases hn : n = 0
    · simp [hn]
    · change |if (n : ℝ) ≤ U then (ArithmeticFunction.moebius n : ℝ) else 0| ≤
        (ArithmeticFunction.zeta n : ℝ)
      rw [ArithmeticFunction.zeta_apply_ne hn, Nat.cast_one]
      split_ifs
      · exact_mod_cast (ArithmeticFunction.abs_moebius_le_one (n := n))
      · simp
  have hfz (i : Fin (2 * j)) (n : ℕ) : |f i n| ≤ z i n := by
    dsimp only [f, z]
    split_ifs
    · exact hμ n
    · exact (abs_of_nonneg (Real.log_natCast_nonneg n)).le
    · change |(ArithmeticFunction.zeta n : ℝ)| ≤ (ArithmeticFunction.zeta n : ℝ)
      exact (abs_of_nonneg (Nat.cast_nonneg _)).le
  have hzsmall (i : Fin (2 * j)) (n : ℕ) : z i n ≤ 1 + Real.log (n : ℝ) := by
    have hlog := Real.log_natCast_nonneg n
    have hζ : (ArithmeticFunction.zeta : ArithmeticFunction ℝ) n ≤ 1 := by
      by_cases hn : n = 0
      · simp [hn]
      · simp only [ArithmeticFunction.natCoe_apply, ArithmeticFunction.zeta_apply_ne hn,
          Nat.cast_one, le_refl]
    dsimp only [z]
    split_ifs
    · exact hζ.trans (le_add_of_nonneg_right hlog)
    · change Real.log (n : ℝ) ≤ 1 + Real.log (n : ℝ)
      exact le_add_of_nonneg_left zero_le_one
    · exact hζ.trans (le_add_of_nonneg_right hlog)
  have haabs (m : ℕ) (i : Fin (2 * j)) (n : ℕ) :
      |a m i n| = aabs m i n := by
    simp only [a, aabs, ArithmeticFunction.coe_mk, Real.rpow_eq_pow]
    rw [abs_mul, abs_mul, abs_of_nonneg (hηbounds _).1,
      abs_of_nonneg (Real.rpow_nonneg (Nat.cast_nonneg n) (-t))]
  have haabs_nonneg (m : ℕ) (i : Fin (2 * j)) (n : ℕ) : 0 ≤ aabs m i n := by
    rw [← haabs]
    exact abs_nonneg _
  have ha_le_absf (m : ℕ) (i : Fin (2 * j)) (n : ℕ) :
      aabs m i n ≤ |f i n| := by
    by_cases hn : n = 0
    · simp [hn]
    · have hn1 : 1 ≤ (n : ℝ) := by exact_mod_cast Nat.one_le_iff_ne_zero.mpr hn
      exact mul_le_of_le_one_left (abs_nonneg _)
        ((mul_le_of_le_one_left (Real.rpow_nonneg (Nat.cast_nonneg n) (-t))
          (hηbounds _).2).trans
          (Real.rpow_le_one_of_one_le_of_nonpos hn1 (neg_nonpos.mpr ht)))
  have hprod_bound (F G : Fin (2 * j) → ArithmeticFunction ℝ)
      (hFG : ∀ i n, |F i n| ≤ G i n) (s : Finset (Fin (2 * j))) :
      ∀ n : ℕ, |(∏ i ∈ s, F i) n| ≤ (∏ i ∈ s, G i) n := by
    induction s using Finset.induction_on with
    | empty =>
        intro n
        simp only [Finset.prod_empty, ArithmeticFunction.one_apply]
        split_ifs <;> norm_num
    | @insert i s hi ih =>
        intro n
        simp only [Finset.prod_insert hi, ArithmeticFunction.mul_apply]
        refine (Finset.abs_sum_le_sum_abs _ _).trans ?_
        apply Finset.sum_le_sum
        intro d _
        rw [abs_mul]
        exact mul_le_mul (hFG i d.1) (ih d.2) (abs_nonneg _)
          ((abs_nonneg _).trans (hFG i d.1))
  have hprod_nonneg (F : Fin (2 * j) → ArithmeticFunction ℝ)
      (hF : ∀ i n, 0 ≤ F i n) (s : Finset (Fin (2 * j))) :
      ∀ n : ℕ, 0 ≤ (∏ i ∈ s, F i) n := by
    intro n
    exact (abs_nonneg _).trans
      (hprod_bound F F (fun i k => (abs_of_nonneg (hF i k)).le) s n)
  have hsumJ (F : ℕ → Fin (2 * j) → ArithmeticFunction ℝ) (n : ℕ) :
      (∑ ν ∈ J, (∏ i : Fin (2 * j), F (ν i) i) n) =
        (∏ i : Fin (2 * j), ∑ m ∈ Finset.range (M + 1), F m i) n := by
    change (∑ ν ∈ J, ev n (∏ i : Fin (2 * j), F (ν i) i)) =
      ev n (∏ i : Fin (2 * j), ∑ m ∈ Finset.range (M + 1), F m i)
    rw [← map_sum]
    congr 1
    exact Finset.sum_prod_piFinset (Finset.range (M + 1)) (fun i m => F m i)
  let b : Fin (2 * j) → ArithmeticFunction ℝ := fun i =>
    ∑ m ∈ Finset.range (M + 1), aabs m i
  have hbnonneg (i : Fin (2 * j)) (n : ℕ) : 0 ≤ b i n := by
    change 0 ≤ ev n (∑ m ∈ Finset.range (M + 1), aabs m i)
    rw [map_sum]
    exact Finset.sum_nonneg fun m _ => haabs_nonneg m i n
  have hbbound (i : Fin (2 * j)) (n : ℕ) : |b i n| ≤ z i n := by
    rw [abs_of_nonneg (hbnonneg i n)]
    by_cases hn : n = 0
    · simp [hn]
    · have hn1 : 1 ≤ (n : ℝ) := by exact_mod_cast Nat.one_le_iff_ne_zero.mpr hn
      calc
        b i n = (∑ m ∈ Finset.range (M + 1), η ((n : ℝ) / Θ ^ m)) *
            Real.rpow (n : ℝ) (-t) * |f i n| := by
          change ev n (∑ m ∈ Finset.range (M + 1), aabs m i) = _
          rw [map_sum]
          change (∑ m ∈ Finset.range (M + 1),
            η ((n : ℝ) / Θ ^ m) * Real.rpow (n : ℝ) (-t) * |f i n|) = _
          rw [Finset.sum_mul, Finset.sum_mul]
        _ ≤ |f i n| := mul_le_of_le_one_left (abs_nonneg _)
          ((mul_le_of_le_one_left (Real.rpow_nonneg (Nat.cast_nonneg n) (-t))
            (hmass (n : ℝ) hn1).2).trans
            (Real.rpow_le_one_of_one_le_of_nonpos hn1 (neg_nonpos.mpr ht)))
        _ ≤ z i n := hfz i n
  have hgnorm (n : ℕ) :
      ‖g n‖ ≤ (n.divisors.card : ℝ) ^ (2 * j - 1) * Real.log (n : ℝ) := by
    rw [hg]
    calc
      _ ≤ ∑ ν ∈ E, ‖((∏ i : Fin (2 * j), a (ν i) i) n : ℂ)‖ :=
        norm_sum_le _ _
      _ = ∑ ν ∈ E, |(∏ i : Fin (2 * j), a (ν i) i) n| := by
        simp only [Complex.norm_real, Real.norm_eq_abs]
      _ ≤ ∑ ν ∈ E, (∏ i : Fin (2 * j), aabs (ν i) i) n := by
        apply Finset.sum_le_sum
        intro ν _
        exact hprod_bound (fun i => a (ν i) i) (fun i => aabs (ν i) i)
          (fun i k => (haabs (ν i) i k).le) Finset.univ n
      _ ≤ ∑ ν ∈ J, (∏ i : Fin (2 * j), aabs (ν i) i) n :=
        Finset.sum_le_sum_of_subset_of_nonneg (Finset.filter_subset _ _)
          (fun ν _ _ => hprod_nonneg (fun i => aabs (ν i) i)
            (fun i k => haabs_nonneg (ν i) i k) Finset.univ n)
      _ = (∏ i : Fin (2 * j), b i) n := hsumJ aabs n
      _ ≤ (∏ i : Fin (2 * j), z i) n := by
        simpa only [abs_of_nonneg (hprod_nonneg b hbnonneg Finset.univ n)] using
          hprod_bound b z hbbound Finset.univ n
      _ = (((ArithmeticFunction.zeta : ArithmeticFunction ℝ) ^ (2 * j - 1)) *
          ArithmeticFunction.log) n := by rw [hzprod]
      _ ≤ _ := zeta_pow_log_le_card_divisors_pow (2 * j - 1) n
  have hgeom (ν : Fin (2 * j) → ℕ) (s : Finset (Fin (2 * j))) :
      ∀ n : ℕ, (∏ i ∈ s, a (ν i) i) n ≠ 0 →
        (∏ i ∈ s, scale ν i) / Θ ^ s.card ≤ (n : ℝ) ∧
          (n : ℝ) ≤ (∏ i ∈ s, scale ν i) * Θ ^ s.card := by
    induction s using Finset.induction_on with
    | empty =>
        intro n hn
        have hn1 : n = 1 := by
          by_contra h
          exact hn (by simp [h])
        simp [hn1]
    | @insert i s hi ih =>
        intro n hn
        rw [Finset.prod_insert hi, ArithmeticFunction.mul_apply] at hn
        obtain ⟨d, hd, hdn⟩ := Finset.exists_ne_zero_of_sum_ne_zero hn
        rcases mul_ne_zero_iff.mp hdn with ⟨hd1, hd2⟩
        rcases hasupport (ν i) i d.1 hd1 with ⟨_, hlo, hup⟩
        rcases ih d.2 hd2 with ⟨hlo', hup'⟩
        have hP : 0 < ∏ k ∈ s, scale ν k :=
          Finset.prod_pos fun k _ => hpow (ν k)
        have hdprod : (d.1 : ℝ) * (d.2 : ℝ) = (n : ℝ) := by
          exact_mod_cast (Nat.mem_divisorsAntidiagonal.mp hd).1
        simp only [Finset.prod_insert hi, Finset.card_insert_of_notMem hi]
        constructor
        · calc
            (scale ν i * ∏ k ∈ s, scale ν k) / Θ ^ (s.card + 1) =
                (Θ ^ (ν i) / Θ) * ((∏ k ∈ s, scale ν k) / Θ ^ s.card) := by
              simp only [scale, pow_succ, div_eq_mul_inv, mul_inv_rev]
              ring
            _ ≤ (d.1 : ℝ) * (d.2 : ℝ) :=
              mul_le_mul hlo hlo' (div_nonneg hP.le (hpow s.card).le) (Nat.cast_nonneg _)
            _ = (n : ℝ) := hdprod
        · calc
            (n : ℝ) = (d.1 : ℝ) * (d.2 : ℝ) := hdprod.symm
            _ ≤ (Θ * Θ ^ (ν i)) * ((∏ k ∈ s, scale ν k) * Θ ^ s.card) :=
              mul_le_mul hup hup' (Nat.cast_nonneg _) (mul_pos hΘpos (hpow (ν i))).le
            _ = (scale ν i * ∏ k ∈ s, scale ν k) * Θ ^ (s.card + 1) := by
              simp only [scale, pow_succ]
              ring
  have hgeomFull (ν : Fin (2 * j) → ℕ) (n : ℕ)
      (hn : (∏ i : Fin (2 * j), a (ν i) i) n ≠ 0) :
      (∏ i : Fin (2 * j), scale ν i) / Θ ^ (2 * j) ≤ (n : ℝ) ∧
        (n : ℝ) ≤ (∏ i : Fin (2 * j), scale ν i) * Θ ^ (2 * j) := by
    simpa only [Finset.card_univ, Fintype.card_fin] using hgeom ν Finset.univ n hn
  have hlocal (F G : Fin (2 * j) → ArithmeticFunction ℝ)
      (s : Finset (Fin (2 * j))) :
      ∀ n : ℕ, (∀ i d, d ∣ n → F i d = G i d) →
        (∏ i ∈ s, F i) n = (∏ i ∈ s, G i) n := by
    induction s using Finset.induction_on with
    | empty => intro n _; rfl
    | @insert i s hi ih =>
        intro n h
        simp only [Finset.prod_insert hi, ArithmeticFunction.mul_apply]
        apply Finset.sum_congr rfl
        intro d hd
        have hd1 := Nat.dvd_of_mem_divisors (Nat.fst_mem_divisors_of_mem_antidiagonal hd)
        have hd2 := Nat.dvd_of_mem_divisors (Nat.snd_mem_divisors_of_mem_antidiagonal hd)
        rw [h i d.1 hd1, ih d.2 (fun k e he => h k e (he.trans hd2))]
  let twist : ArithmeticFunction ℝ →+* ArithmeticFunction ℝ :=
    { toFun := fun F => ⟨fun n => Real.rpow (n : ℝ) (-t) * F n, by simp⟩
      map_zero' := by
        ext n
        exact mul_zero _
      map_one' := by
        ext n
        change Real.rpow (n : ℝ) (-t) * (if n = 1 then 1 else 0) =
          (if n = 1 then 1 else 0)
        by_cases hn : n = 1 <;> simp [hn]
      map_add' := by
        intro F G
        ext n
        exact mul_add _ _ _
      map_mul' := by
        intro F G
        ext n
        change Real.rpow (n : ℝ) (-t) *
            (∑ d ∈ n.divisorsAntidiagonal, F d.1 * G d.2) =
          ∑ d ∈ n.divisorsAntidiagonal,
            (Real.rpow (d.1 : ℝ) (-t) * F d.1) *
              (Real.rpow (d.2 : ℝ) (-t) * G d.2)
        simp only [Real.rpow_eq_pow]
        rw [Finset.mul_sum]
        apply Finset.sum_congr rfl
        intro d hd
        rw [← (Nat.mem_divisorsAntidiagonal.mp hd).1, Nat.cast_mul,
          Real.mul_rpow (Nat.cast_nonneg d.1) (Nat.cast_nonneg d.2)]
        ring }
  have hinside (n : ℕ) (hn : A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B) :
      g n = ((Real.rpow (n : ℝ) (-t) * H n : ℝ) : ℂ) := by
    have hn0 : n ≠ 0 := by
      intro hz
      have := hA.trans hn.1
      norm_num [hz] at this
    have hEJ : (∑ ν ∈ E, (∏ i : Fin (2 * j), a (ν i) i) n) =
        ∑ ν ∈ J, (∏ i : Fin (2 * j), a (ν i) i) n := by
      apply Finset.sum_subset (Finset.filter_subset _ _)
      intro ν hν hnot
      by_contra hne
      rcases hgeomFull ν n hne with ⟨hl, hu⟩
      apply hnot
      exact Finset.mem_filter.mpr ⟨hν,
        (div_le_iff₀ (hpow (2 * j))).mpr (hn.1.trans hu),
        (div_le_iff₀ (hpow (2 * j))).mp (hl.trans hn.2)⟩
    rw [hg, ← Complex.ofReal_sum, hEJ, hsumJ]
    congr 1
    calc
      (∏ i : Fin (2 * j), ∑ m ∈ Finset.range (M + 1), a m i) n =
          (∏ i : Fin (2 * j), twist (f i)) n := by
        apply hlocal _ _ Finset.univ n
        intro i d hd
        have hdmem : d ∈ n.divisors := Nat.mem_divisors.mpr ⟨hd, hn0⟩
        have hd1 : 1 ≤ (d : ℝ) := by exact_mod_cast Nat.pos_of_mem_divisors hdmem
        have hdB : (d : ℝ) ≤ B :=
          (show (d : ℝ) ≤ (n : ℝ) by exact_mod_cast Nat.divisor_le hdmem).trans hn.2
        change ev d (∑ m ∈ Finset.range (M + 1), a m i) =
          Real.rpow (d : ℝ) (-t) * f i d
        rw [map_sum]
        change (∑ m ∈ Finset.range (M + 1),
          η ((d : ℝ) / Θ ^ m) * Real.rpow (d : ℝ) (-t) * f i d) = _
        rw [← Finset.sum_mul, ← Finset.sum_mul, hpartition (d : ℝ) hd1 hdB, one_mul]
      _ = Real.rpow (n : ℝ) (-t) * H n := by
        rw [← map_prod, hfprod]
        rfl
  have htarget (n : ℕ) :
      target n = if A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B
        then ((Real.rpow (n : ℝ) (-t) * H n : ℝ) : ℂ) else 0 := by
    have hmem : n ∈ Finset.Icc ⌈A⌉₊ ⌊B⌋₊ ↔ A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B := by
      rw [Finset.mem_Icc, Nat.ceil_le, Nat.le_floor_iff (zero_le_one.trans hB)]
    simp only [target, Finsupp.finsetSum_apply, Finsupp.single_apply,
      Finset.sum_ite_eq', hmem]
  have herror (n : ℕ) :
      error n = if A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B then 0 else g n := by
    by_cases hn : A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B
    · simp only [error, Finsupp.sub_apply, htarget, ite_eq_left hn, hinside n hn, sub_self]
    · simp only [error, Finsupp.sub_apply, htarget, ite_eq_right hn, sub_zero]
  refine ⟨?_, ?_, ?_, ?_, ?_⟩
  · calc
      E.card ≤ J.card := Finset.card_le_card (Finset.filter_subset _ _)
      _ = (M + 1) ^ (2 * j) := by simp [J, Fintype.card_piFinset]
  · ext n
    by_cases hn : A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B
    · simp only [htarget, Finsupp.filter_apply, ite_eq_left hn, hinside n hn]
    · simp only [htarget, Finsupp.filter_apply, ite_eq_right hn]
  · intro ν _ i n hn
    have han : a (ν i) i n ≠ 0 :=
      Complex.ofReal_ne_zero.mp (by simpa only [hβ] using Finsupp.mem_support_iff.mp hn)
    rcases hasupport (ν i) i n han with ⟨_, hl, hu⟩
    refine ⟨hl, hu, ?_⟩
    rw [hβ, Complex.norm_real, Real.norm_eq_abs, haabs]
    exact (ha_le_absf (ν i) i n).trans ((hfz i n).trans (hzsmall i n))
  · intro n hn
    have hne := Finsupp.mem_support_iff.mp hn
    have hout : ¬(A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B) := by
      intro hin
      exact hne (by rw [herror, ite_eq_left hin])
    have hgn : g n ≠ 0 := by simpa only [herror, ite_eq_right hout] using hne
    rw [hg] at hgn
    obtain ⟨ν, hν, hνn⟩ := Finset.exists_ne_zero_of_sum_ne_zero hgn
    have hpn : (∏ i : Fin (2 * j), a (ν i) i) n ≠ 0 :=
      Complex.ofReal_ne_zero.mp hνn
    rcases hgeomFull ν n hpn with ⟨hl, hu⟩
    have hbox := (Finset.mem_filter.mp hν).2
    have hlow : A / Θ ^ (4 * j) ≤ (n : ℝ) := by
      calc
        A / Θ ^ (4 * j) = (A / Θ ^ (2 * j)) / Θ ^ (2 * j) := by
          rw [div_div, ← pow_add, show 2 * j + 2 * j = 4 * j by omega]
        _ ≤ (∏ i : Fin (2 * j), scale ν i) / Θ ^ (2 * j) :=
          div_le_div_of_nonneg_right hbox.1 (hpow (2 * j)).le
        _ ≤ (n : ℝ) := hl
    have hupp : (n : ℝ) ≤ B * Θ ^ (4 * j) := by
      calc
        (n : ℝ) ≤ (∏ i : Fin (2 * j), scale ν i) * Θ ^ (2 * j) := hu
        _ ≤ (B * Θ ^ (2 * j)) * Θ ^ (2 * j) :=
          mul_le_mul_of_nonneg_right hbox.2 (hpow (2 * j)).le
        _ = B * Θ ^ (4 * j) := by
          rw [mul_assoc, ← pow_add, show 2 * j + 2 * j = 4 * j by omega]
    by_cases hleft : (n : ℝ) < A
    · exact Or.inl ⟨hlow, hleft⟩
    · exact Or.inr ⟨lt_of_not_ge (fun hright => hout ⟨le_of_not_gt hleft, hright⟩), hupp⟩
  · intro n
    rw [herror]
    split_ifs
    · simp only [norm_zero]
      exact mul_nonneg (pow_nonneg (Nat.cast_nonneg _) _) (Real.log_natCast_nonneg n)
    · exact hgnorm n

theorem squarefree_or_integer_interval_discrepancy_le
    (H N V : ℝ) (hH : 0 < H) (hN : 0 < N) (hV : 0 ≤ V)
    (L R : ℕ) (hR : (R : ℝ) ≤ H * N)
    (ψ : ℝ → ℂ) (hψ : ContDiff ℝ 1 ψ)
    (hψbound : ∀ u ∈ Set.Icc (0 : ℝ) H,
      ‖ψ u‖ ≤ V ∧ ‖deriv ψ u‖ ≤ V)
    (squarefree : Bool)
    (q r a : ℕ) (hq : 0 < q) (hr : 0 < r) (ha : Nat.Coprime a q) :
    let f : ℕ →₀ ℂ :=
      ∑ n ∈ Finset.Icc (max 1 L) R,
        Finsupp.single n
          (((if squarefree then |(ArithmeticFunction.moebius n : ℝ)| else 1 : ℝ) : ℂ) *
            ψ ((n : ℝ) / N))
    ‖fullDiscrepancy
        (f.filter (fun n => Nat.Coprime n r)) q a‖ ≤
      4 * (1 + H) * V * (r.divisors.card : ℝ) *
        (if squarefree then Real.sqrt (R : ℝ) else 1)
:= by
  classical
  let hq0 : NeZero q := ⟨hq.ne'⟩
  let c : ℕ → ℂ := fun n =>
    ((if squarefree then |(ArithmeticFunction.moebius n : ℝ)| else 1 : ℝ) : ℂ)
  let S : Finset ℕ := if squarefree then Finset.Icc 1 R.sqrt else {1}
  let w : ℕ → ℂ := fun d => if squarefree then (ArithmeticFunction.moebius d : ℂ) else 1
  have hmuNorm (d : ℕ) : ‖(ArithmeticFunction.moebius d : ℂ)‖ ≤ 1 :=
    mod_cast ArithmeticFunction.abs_moebius_le_one
  have hwNorm (d : ℕ) : ‖w d‖ ≤ 1 := by
    clear * - squarefree w hmuNorm d
    cases squarefree <;> simp_all [w]
  have hSpos (d : ℕ) (hd : d ∈ S) : 0 < d := by
    clear * - squarefree S d hd
    cases squarefree <;> simp_all [S, Nat.lt_iff_add_one_le]
  have hScard : (S.card : ℝ) ≤
      (if squarefree then Real.sqrt (R : ℝ) else 1) := by
    cases squarefree with
    | false => simp [S]
    | true => simpa [S] using Real.nat_sqrt_le_real_sqrt (a := R)
  have hmuSum (m : ℕ) :
      (∑ d ∈ m.divisors, (ArithmeticFunction.moebius d : ℂ)) =
        if m = 1 then 1 else 0 := by
    rw [← ArithmeticFunction.one_apply, ← ArithmeticFunction.coe_moebius_mul_coe_zeta]
    simp only [ArithmeticFunction.coe_mul_zeta_apply, ArithmeticFunction.intCoe_apply]
  have hbase (n : ℕ) (hn : 0 < n) (hnR : n ≤ R) :
      c n = ∑ d ∈ S, if d ^ 2 ∣ n then w d else 0 := by
    clear * - squarefree c S w R n hn hnR hmuSum
    cases squarefree with
    | false =>
        simp only [c, S, w, Bool.false_eq_true, ite_false, Finset.sum_singleton]
        norm_num
    | true =>
        have hroot : Nat.floorRoot 2 n = 1 ↔ Squarefree n := by
          rw [← Nat.isUnit_iff]
          constructor
          · intro h d hd
            exact isUnit_of_dvd_unit
              (Nat.pow_dvd_iff_dvd_floorRoot.mp (by simpa [pow_two] using hd)) h
          · intro hs
            exact hs _ (by
              simpa [pow_two] using Nat.floorRoot_pow_dvd (n := 2) (a := n))
        have hset : (Finset.Icc 1 R.sqrt).filter (fun d => d ^ 2 ∣ n) =
            (Nat.floorRoot 2 n).divisors := by
          ext d
          simp only [Finset.mem_filter, Finset.mem_Icc, Nat.mem_divisors]
          constructor
          · intro hd
            exact ⟨Nat.pow_dvd_iff_dvd_floorRoot.mp hd.2,
              Nat.floorRoot_ne_zero.mpr ⟨two_ne_zero, hn.ne'⟩⟩
          · intro hd
            have hdn := Nat.pow_dvd_iff_dvd_floorRoot.mpr hd.1
            exact ⟨⟨Nat.pos_of_dvd_of_pos hd.1 (Nat.pos_of_ne_zero hd.2),
              Nat.le_sqrt'.mpr ((Nat.le_of_dvd hn hdn).trans hnR)⟩, hdn⟩
        have habs : |(ArithmeticFunction.moebius n : ℝ)| =
            if Squarefree n then 1 else 0 := mod_cast ArithmeticFunction.abs_moebius
        simp only [c, S, w, ↓reduceIte, ← Finset.sum_filter, hset, hmuSum, hroot,
          habs]
        split_ifs <;> simp
  have hmask (n : ℕ) :
      (∑ e ∈ r.divisors, if e ∣ n then (ArithmeticFunction.moebius e : ℂ) else 0) =
        if Nat.Coprime n r then 1 else 0 := by
    clear * - r hr n hmuSum
    have hset : r.divisors.filter (fun e => e ∣ n) = (Nat.gcd n r).divisors := by
      rw [← Nat.divisors_filter_dvd_of_dvd hr.ne' (Nat.gcd_dvd_right n r)]
      exact Finset.filter_congr fun e he => by
        rw [Nat.dvd_gcd_iff, and_iff_left (Nat.dvd_of_mem_divisors he)]
    rw [← Finset.sum_filter, hset, hmuSum]
  let C₀ : ℕ → ℕ → ℂ := fun T b =>
    ∑ n ∈ Finset.range T, if n % q = b % q then 1 else 0
  let C₁ : ℕ → ℕ → ℂ := fun T b =>
    ∑ n ∈ Finset.Icc 1 T, if n % q = b % q then 1 else 0
  have hcount (T b : ℕ) :
      C₀ T b = ((T / q : ℕ) : ℂ) + (if b % q < T % q then 1 else 0) := by
    clear * - q hq C₀ T b
    have hc := Nat.count_modEq_card T hq b
    rw [Nat.count_eq_card_filter_range] at hc
    dsimp only [C₀]
    rw [Finset.sum_boole]
    calc
      _ = ((T / q + (if b % q < T % q then 1 else 0) : ℕ) : ℂ) :=
        Nat.cast_inj.mpr ((congrArg Finset.card
          (@Finset.filter_congr_decidable ℕ (Finset.range T)
            (fun n => n % q = b % q) _ _)).trans hc)
      _ = _ := by simp
  have hcountPair (T b b' : ℕ) : ‖C₀ T b - C₀ T b'‖ ≤ 1 := by
    clear * - C₀ hcount q T b b'
    rw [hcount, hcount, add_sub_add_left_eq_sub]
    split_ifs <;> norm_num
  have hpositive (T b : ℕ) :
      C₁ T b = C₀ (T + 1) b - (if 0 % q = b % q then 1 else 0) := by
    clear * - C₀ C₁ q T b
    dsimp only [C₁, C₀]
    rw [Finset.sum_range_eq_add_Ico (n := T + 1) _ (Nat.succ_pos T),
      Finset.Ico_add_one_right_eq_Icc, add_sub_cancel_left]
  have hpositivePair (T b b' : ℕ) : ‖C₁ T b - C₁ T b'‖ ≤ 2 := by
    clear * - C₀ C₁ q T b b' hpositive hcountPair
    rw [hpositive, hpositive, sub_sub_sub_comm]
    refine (norm_sub_le_of_le (hcountPair _ _ _) ?_).trans_eq one_add_one_eq_two
    split_ifs <;> norm_num
  let D : ℕ → ℕ → ℕ → ℂ := fun T m b =>
    ∑ n ∈ Finset.Icc 1 T, if m ∣ n ∧ n % q = b % q then 1 else 0
  have hmultiple (T m : ℕ) (hm : 0 < m) (f : ℕ → ℂ) :
      (∑ n ∈ (Finset.Icc 1 T).filter (fun n => m ∣ n), f n) =
        ∑ j ∈ Finset.Icc 1 (T / m), f (m * j) := by
    clear * - T m hm f
    refine Finset.sum_nbij' (· / m) (m * ·) ?_ ?_ ?_ ?_ ?_
    · intro n hn
      simp only [Finset.mem_filter, Finset.mem_Icc] at hn
      exact Finset.mem_Icc.mpr
        ⟨Nat.div_pos (Nat.le_of_dvd hn.1.1 hn.2) hm,
          Nat.div_le_div_right hn.1.2⟩
    · intro j hj
      simp only [Finset.mem_Icc] at hj
      exact Finset.mem_filter.mpr
        ⟨Finset.mem_Icc.mpr ⟨Nat.mul_pos hm hj.1,
          by simpa [Nat.mul_comm] using (Nat.le_div_iff_mul_le hm).mp hj.2⟩,
          Nat.dvd_mul_right m j⟩
    · intro n hn
      exact Nat.mul_div_cancel' (Finset.mem_filter.mp hn).2
    · intro j hj
      exact Nat.mul_div_cancel_left j hm
    · intro n hn
      rw [Nat.mul_div_cancel' (Finset.mem_filter.mp hn).2]
  have hDpair (T m b b' : ℕ) (hm : 0 < m)
      (hb : Nat.Coprime b q) (hb' : Nat.Coprime b' q) :
      ‖D T m b - D T m b'‖ ≤ 2 := by
    clear * - D C₁ q hq hq0 T m b b' hm hb hb' hmultiple hpositivePair
    by_cases hmq : Nat.Coprime m q
    · have htransport (v : ℕ) :
          D T m v = C₁ (T / m) (((m : ZMod q)⁻¹ * (v : ZMod q)).val) := by
        have hres (j : ℕ) : (m * j) % q = v % q ↔
            j % q = (((m : ZMod q)⁻¹ * (v : ZMod q)).val) % q := by
          rw [← ZMod.natCast_eq_natCast_iff', ← ZMod.natCast_eq_natCast_iff',
            ZMod.natCast_zmod_val, Nat.cast_mul]
          simpa only [← ZMod.inv_coe_unit, ZMod.coe_unitOfCoprime] using
            (Units.eq_inv_mul_iff_mul_eq (ZMod.unitOfCoprime m hmq)
              (a := (j : ZMod q)) (c := (v : ZMod q))).symm
        calc
          _ = ∑ n ∈ (Finset.Icc 1 T).filter (fun n => m ∣ n),
              if n % q = v % q then (1 : ℂ) else 0 := by
            simp only [D, Finset.sum_filter, ite_and]
          _ = ∑ j ∈ Finset.Icc 1 (T / m),
              if (m * j) % q = v % q then (1 : ℂ) else 0 := hmultiple _ _ hm _
          _ = _ := by simp [C₁, hres]
      rw [htransport, htransport]
      exact hpositivePair _ _ _
    · have hzero (v : ℕ) (hv : Nat.Coprime v q) : D T m v = 0 :=
        Finset.sum_eq_zero fun n _ => ite_eq_right fun h => hmq (Nat.Coprime.of_dvd_left h.1
          ((show Nat.ModEq q n v from h.2).gcd_eq.trans hv))
      norm_num [hzero b hb, hzero b' hb']
  let v : ℕ → ℂ := fun n => if Nat.Coprime n r then c n else 0
  let P : ℕ → ℕ → ℂ := fun T b =>
    ∑ n ∈ Finset.Icc 1 T, if n % q = b % q then v n else 0
  have hPexpand (T b : ℕ) (hTR : T ≤ R) :
      P T b = ∑ d ∈ S, ∑ e ∈ r.divisors,
        (w d * (ArithmeticFunction.moebius e : ℂ)) * D T (Nat.lcm (d ^ 2) e) b := by
    clear * - T b hTR P v c S w r q hbase hmask D
    calc
      _ = ∑ n ∈ Finset.Icc 1 T, ∑ d ∈ S, ∑ e ∈ r.divisors,
          if d ^ 2 ∣ n ∧ e ∣ n ∧ n % q = b % q then
            w d * (ArithmeticFunction.moebius e : ℂ) else 0 := by
        refine Finset.sum_congr rfl fun n hn => ?_
        have hn' := Finset.mem_Icc.mp hn
        have hfactor : (if n % q = b % q then v n else 0) =
            (∑ d ∈ S, if d ^ 2 ∣ n then w d else 0) *
              (∑ e ∈ r.divisors, if e ∣ n then (ArithmeticFunction.moebius e : ℂ) else 0) *
                (if n % q = b % q then 1 else 0) := by
          rw [← hbase n hn'.1 (hn'.2.trans hTR), hmask]
          simp only [v, mul_boole]
        rw [hfactor, Finset.sum_mul_sum]
        simp_rw [Finset.sum_mul, ite_zero_mul_ite_zero, mul_one, and_assoc]
      _ = _ := by
        rw [← Finset.sum_comm_cycle]
        simp_rw [D, Finset.mul_sum, Nat.lcm_dvd_iff, and_assoc, mul_boole]
  have hPpair (T b b' : ℕ) (hTR : T ≤ R)
      (hb : Nat.Coprime b q) (hb' : Nat.Coprime b' q) :
      ‖P T b - P T b'‖ ≤ 2 * (S.card : ℝ) * (r.divisors.card : ℝ) := by
    clear * - T b b' hTR hb hb' P S r q hPexpand w hDpair hSpos hwNorm hmuNorm
    rw [hPexpand T b hTR, hPexpand T b' hTR]
    simp only [← Finset.sum_sub_distrib, ← mul_sub]
    calc
      _ ≤ ∑ _d ∈ S, ∑ _e ∈ r.divisors, (2 : ℝ) := by
        apply norm_sum_le_of_le
        intro d hd
        apply norm_sum_le_of_le
        intro e he
        simpa using norm_mul_le_of_le
          (norm_mul_le_of_le (hwNorm d) (hmuNorm e))
          (hDpair T _ b b'
            (Nat.lcm_pos (pow_pos (hSpos d hd) 2) (Nat.pos_of_mem_divisors he)) hb hb')
      _ = _ := by simp; ring
  clear hmuNorm hwNorm hSpos hmuSum hbase hmask hcount hcountPair hpositive
    hpositivePair hmultiple hDpair hPexpand C₀ C₁ D w
  let Q : Finset ℕ := (Finset.range q).filter (fun b => Nat.Coprime b q)
  have hQcard : Q.card = q.totient := by
    simpa [Q, Nat.coprime_comm] using (Nat.totient_eq_card_coprime q).symm
  have hQnonempty : Q.Nonempty := by
    rwa [← Finset.card_pos, hQcard, Nat.totient_pos]
  have haverage (n : ℕ) (z : ℂ) :
      (∑ b ∈ Q, if n % q = b % q then z else 0) =
        if Nat.Coprime n q then z else 0 := by
    clear * - Q q hq n z
    calc
      _ = ∑ b ∈ Q, if n % q = b then z else 0 := by
        refine Finset.sum_congr rfl fun b hb => ?_
        rw [Nat.mod_eq_of_lt (Finset.mem_range.mp (Finset.mem_filter.mp hb).1)]
      _ = if n % q ∈ Q then z else 0 := Finset.sum_ite_eq _ _ (fun _ => z)
      _ = _ := by simp [Q, Nat.mod_lt n hq]
  have hreduced (T : ℕ) :
      (∑ b ∈ Q, P T b) =
        ∑ n ∈ Finset.Icc 1 T, if Nat.Coprime n q then v n else 0 := by
    clear * - P Q q v T haverage
    dsimp only [P]
    rw [Finset.sum_comm]
    simp [haverage]
  let B : ℝ := 2 * (r.divisors.card : ℝ) *
    (if squarefree then Real.sqrt (R : ℝ) else 1)
  have hB : 0 ≤ B := by
    clear * - B r R squarefree
    positivity
  have hcenter (T : ℕ) (hTR : T ≤ R) :
      ‖P T a -
          (∑ n ∈ Finset.Icc 1 T, if Nat.Coprime n q then v n else 0) /
            (q.totient : ℂ)‖ ≤ B := by
    clear * - P Q q r R S squarefree B T hTR ha hQnonempty hQcard hreduced hPpair hScard
    rw [← hreduced T, ← hQcard, ← Finset.expect_eq_sum_div_card Q (P T),
      ← Finset.expect_const hQnonempty (P T a), ← Finset.expect_sub_distrib]
    refine (RCLike.norm_expect_le (K := ℂ)).trans ?_
    refine (Finset.expect_le hQnonempty (fun b hb =>
      hPpair T a b hTR ha (Finset.mem_filter.mp hb).2)).trans ?_
    dsimp only [B]
    rw [mul_right_comm]
    gcongr
  clear hPpair hScard hQcard hQnonempty haverage hreduced Q S
  let z : ℕ → ℂ := fun n => if 0 < n then
    (if n % q = a % q then v n else 0) -
      (if Nat.Coprime n q then v n else 0) / (q.totient : ℂ) else 0
  have hprefix (T : ℕ) (hTR : T ≤ R) :
      ‖∑ n ∈ Finset.range (T + 1), z n‖ ≤ B := by
    clear * - T hTR z P q v hcenter B
    refine le_of_eq_of_le ?_ (hcenter T hTR)
    congr 1
    rw [Finset.sum_range_eq_add_Ico (n := T + 1) z (Nat.succ_pos T),
      Finset.Ico_add_one_right_eq_Icc, show z 0 = 0 by simp [z], zero_add]
    dsimp only [P]
    rw [Finset.sum_div, ← Finset.sum_sub_distrib]
    exact Finset.sum_congr rfl fun n hn => ite_eq_left (Finset.mem_Icc.mp hn).1
  clear hcenter P
  have hsample (i : ℕ) (hi : i ≤ R) : (i : ℝ) / N ∈ Set.Icc (0 : ℝ) H :=
    ⟨by positivity, (div_le_iff₀ hN).2 ((Nat.mono_cast hi).trans hR)⟩
  have hweighted (K : ℕ) (hK : K ≤ R + 1) :
      ‖∑ n ∈ Finset.range K, ψ ((n : ℝ) / N) * z n‖ ≤ B * ((1 + H) * V) := by
    clear * - K hK R N H V ψ z B hB hH hN hV hψ hψbound hsample hprefix
    cases K with
    | zero =>
        simp only [Finset.range_zero, Finset.sum_empty, norm_zero]
        positivity
    | succ K =>
        have hKR : K ≤ R := by omega
        have hraw (j : ℕ) (hj : j ≤ K + 1) : ‖∑ n ∈ Finset.range j, z n‖ ≤ B := by
          cases j with
          | zero => simpa using hB
          | succ j => exact hprefix j (by omega)
        have hstep (i : ℕ) (hi : i ∈ Finset.range K) :
            ‖ψ (((i + 1 : ℕ) : ℝ) / N) - ψ ((i : ℝ) / N)‖ ≤ V / N := by
          have hiK := Finset.mem_range.mp hi
          refine (Convex.norm_image_sub_le_of_norm_deriv_le
            (fun t _ => hψ.differentiable_one t)
            (fun t ht => (hψbound t ht).2) (convex_Icc 0 H)
            (hsample i (by omega)) (hsample (i + 1) (by omega))).trans_eq ?_
          simp [div_eq_mul_inv, add_mul, abs_of_pos hN]
        have hvariation :
            (∑ i ∈ Finset.range K,
              ‖ψ (((i + 1 : ℕ) : ℝ) / N) - ψ ((i : ℝ) / N)‖) ≤ H * V := by
          calc
            _ ≤ ∑ _i ∈ Finset.range K, V / N := Finset.sum_le_sum hstep
            _ = V * ((K : ℝ) / N) := by simp; ring
            _ ≤ H * V := by
              simpa [mul_comm] using mul_le_mul_of_nonneg_left (hsample K hKR).2 hV
        calc
          _ ≤ B * (‖ψ ((K : ℝ) / N)‖ +
              ∑ i ∈ Finset.range K,
                ‖ψ (((i + 1 : ℕ) : ℝ) / N) - ψ ((i : ℝ) / N)‖) := by
            simpa using
              norm_sum_range_smul_le_of_partial_sum_bound
                (fun n : ℕ => ψ ((n : ℝ) / N)) z (K + 1) B hraw
          _ ≤ B * ((1 + H) * V) := by
            simpa [one_add_mul] using mul_le_mul_of_nonneg_left
              (add_le_add (hψbound _ (hsample K hKR)).1 hvariation) hB
  clear hprefix hsample
  have hinterval :
      ‖∑ n ∈ Finset.Icc (max 1 L) R, ψ ((n : ℝ) / N) * z n‖ ≤
        2 * B * ((1 + H) * V) := by
    clear * - L R N H V ψ z B hB hH hV hweighted
    by_cases hLR : max 1 L ≤ R
    · calc
        _ = ‖(∑ n ∈ Finset.range (R + 1), ψ ((n : ℝ) / N) * z n) -
            ∑ n ∈ Finset.range (max 1 L), ψ ((n : ℝ) / N) * z n‖ := by
          congr 1
          rw [← Finset.Ico_add_one_right_eq_Icc]
          exact Finset.sum_Ico_eq_sub _ (hLR.trans (Nat.le_succ R))
        _ ≤ 2 * B * ((1 + H) * V) := by
          simpa [two_mul, add_mul] using norm_sub_le_of_le
            (hweighted (R + 1) le_rfl) (hweighted (max 1 L) (hLR.trans (Nat.le_succ R)))
    · rw [Finset.Icc_eq_empty_of_lt (lt_of_not_ge hLR), Finset.sum_empty, norm_zero]
      positivity
  clear hweighted
  let f : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc (max 1 L) R,
    Finsupp.single n (c n * ψ ((n : ℝ) / N))
  have hMass (pred : ℕ → Prop) [DecidablePred pred] :
      (f.filter (fun n => Nat.Coprime n r)).sum (fun n t => if pred n then t else 0) =
        ∑ n ∈ Finset.Icc (max 1 L) R,
          ψ ((n : ℝ) / N) * (if pred n then v n else 0) := by
    rw [Finsupp.sum_filter_index, Finsupp.support_filter, Finset.sum_filter]
    change f.sum (fun n t => if Nat.Coprime n r then if pred n then t else 0 else 0) = _
    dsimp only [f]
    rw [← Finsupp.indicator_eq_sum_single,
      Finsupp.sum_indicator_index _ (by simp)]
    simp only [v, mul_ite_zero, ← ite_and]
    simp only [and_comm, mul_comm]
  change ‖fullDiscrepancy
    (f.filter (fun n => Nat.Coprime n r)) q a‖ ≤ _
  calc
    _ = ‖∑ n ∈ Finset.Icc (max 1 L) R, ψ ((n : ℝ) / N) * z n‖ := by
      congr 1
      change
        (f.filter (fun n => Nat.Coprime n r)).sum
            (fun n t => if n % q = a % q then t else 0) -
          (f.filter (fun n => Nat.Coprime n r)).sum
              (fun n t => if Nat.Coprime n q then t else 0) / (q.totient : ℂ) = _
      rw [hMass, hMass, Finset.sum_div, ← Finset.sum_sub_distrib]
      refine Finset.sum_congr rfl fun n hn => ?_
      simp only [z, ite_eq_left
        (Nat.lt_of_succ_le ((le_max_left 1 L).trans (Finset.mem_Icc.mp hn).1))]
      ring
    _ ≤ _ := hinterval.trans_eq (by dsimp only [B]; ring)

theorem heathBrown_localized_products_fixedPower_siegelWalfisz
    (K : ℕ) (hK : 0 < K) (δ H : ℝ) (hδ : 0 < δ) (hH : 0 < H) :
    ∀ D : ℝ, 0 < D → ∀ A : ℝ, 0 < A →
      ∃ C X₀ : ℝ, 0 < C ∧ Real.exp 1 ≤ X₀ ∧
        ∀ x : ℝ, X₀ ≤ x →
          let Θ : ℝ := 1 + (Real.log x) ^ (-D)
          let η : ℝ → ℝ := fun u =>
            if 0 < u then
              Real.smoothTransition (Real.log u / Real.log Θ + 1) -
                Real.smoothTransition (Real.log u / Real.log Θ)
            else 0
          ∀ k : ℕ, 0 < k → k ≤ K →
            ∀ N U t : Fin k → ℝ,
              (∀ i : Fin k, 1 ≤ N i) →
              x ^ δ ≤ (∏ i : Fin k, N i) →
              (∏ i : Fin k, N i) ≤ x ^ H →
              (∀ i : Fin k, 0 ≤ t i ∧ t i ≤ 10) →
              ∀ role : Fin k → Fin 4,
                ∀ L R : Fin k → ℕ,
                  (∀ i : Fin k, (R i : ℝ) ≤ 2 * N i) →
                  ∀ L₀ R₀ : ℕ,
                    let P : ℝ := ∏ i : Fin k, N i
                    let μU : Fin k → ArithmeticFunction ℝ := fun i =>
                      arithmeticFunctionLowCutoff (U i)
                        (ArithmeticFunction.moebius : ArithmeticFunction ℝ)
                    let f : Fin k → ℕ → ℝ := fun i n =>
                      if role i = 0 then μU i n
                      else if role i = 1 then |μU i n|
                      else if role i = 2 then
                        (ArithmeticFunction.zeta : ArithmeticFunction ℝ) n
                      else ArithmeticFunction.log n
                    let β : Fin k → MonoidAlgebra ℂ ℕ := fun i =>
                      ∑ n ∈ Finset.Icc (max 1 (L i)) (R i),
                        MonoidAlgebra.single n
                          ((η ((n : ℝ) / N i) * Real.rpow (n : ℝ) (-(t i)) *
                            f i n : ℝ) : ℂ)
                    let F : ℕ →₀ ℂ :=
                      (∏ i : Fin k, β i).coeff.filter
                        (fun n : ℕ => L₀ ≤ n ∧ n ≤ R₀)
                    (∀ n ∈ F.support,
                      P / (2 : ℝ) ^ K ≤ (n : ℝ) ∧
                        (n : ℝ) ≤ (2 : ℝ) ^ K * P) ∧
                      (∀ n : ℕ, ‖F n‖ ≤
                        (1 + H) ^ K * (n.divisors.card : ℝ) ^ (K - 1) *
                          (Real.log x) ^ K) ∧
                      ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
                        ‖fullDiscrepancy
                            (F.filter (fun n => Nat.Coprime n r)) q a‖ ≤
                          C * ((q * r).divisors.card : ℝ) ^ 2 * P /
                            (Real.log x) ^ A
    := by
  classical
  intro D hD A hA
  obtain ⟨Cder, hCder, hgeometric⟩ := heathBrown_geometric_profiles_uniform
  let d : ℝ := δ / (K : ℝ)
  let E : ℝ := D + 1
  let S : ℝ := A + (K : ℝ)
  let Cψ : ℝ := max (Cder 0) (Cder 1) * (1 + H)
  have hd : 0 < d := by positivity
  have hCψ : 0 < Cψ :=
    mul_pos (lt_max_of_lt_left (hCder 0)) (add_pos zero_lt_one hH)
  obtain ⟨Cμ, Xμ, hCμ, hXμ, hsw⟩ :=
    truncated_moebius_interval_coefficient_siegelWalfisz
      d 2 Cψ E hd zero_lt_two hCψ (add_nonneg hD.le zero_le_one) S
        (add_pos_of_pos_of_nonneg hA (Nat.cast_nonneg K))
  obtain ⟨X, hX⟩ := Filter.eventually_atTop.mp
    (isLittleO_log_rpow_rpow_atTop (2 * (E + S)) hd).eventuallyLE
  let Cslot : ℝ := max Cμ (24 * Cψ)
  have hCslot : 0 < Cslot := lt_max_of_lt_left hCμ
  refine ⟨Cslot * (2 * (1 + H)) ^ K, max Xμ X, by positivity,
    hXμ.trans (le_max_left _ _), ?_⟩
  intro x hx Θ η k hk hkK N U t hN hPlower hPupper ht role L R hR L₀ R₀
    P μU f β F
  have hxμ : Xμ ≤ x := (le_max_left _ _).trans hx
  have hxexp : Real.exp 1 ≤ x := hXμ.trans hxμ
  have hxone : 1 < x := (Real.one_lt_exp_iff.mpr zero_lt_one).trans_le hxexp
  have hxpos : 0 < x := zero_lt_one.trans hxone
  let ℓ : ℝ := Real.log x
  let B : ℝ := (1 + H) * ℓ
  have hℓ : 1 ≤ ℓ := (Real.le_log_iff_exp_le hxpos).mpr hxexp
  have hℓpos : 0 < ℓ := zero_lt_one.trans_le hℓ
  have hBone : 1 ≤ B :=
    one_le_mul_of_one_le_of_one_le (le_add_of_nonneg_right hH.le) hℓ
  have hB : 0 ≤ B := zero_le_one.trans hBone
  have hlogAbsorb : ℓ ^ (2 * (E + S)) ≤ x ^ d :=
    (Real.le_norm_self _).trans ((hX x ((le_max_right _ _).trans hx)).trans_eq
      (Real.norm_of_nonneg (Real.rpow_nonneg hxpos.le d)))
  have hΘ : 1 < Θ :=
    lt_add_of_pos_right 1 (Real.rpow_pos_of_pos hℓpos (-D))
  have hΘtwo : Θ ≤ 2 :=
    (add_le_add_right (Real.rpow_le_one_of_one_le_of_nonpos hℓ
      (neg_nonpos.mpr hD.le)) 1).trans_eq one_add_one_eq_two
  obtain ⟨-, hηsupport, hηbound, hprofiles, -⟩ :=
    hgeometric Θ hΘ hΘtwo
  change Function.support η = Set.Ioo Θ⁻¹ Θ at hηsupport
  change ∀ u : ℝ, 0 ≤ η u ∧ η u ≤ 1 at hηbound
  clear hgeometric
  have hNi : ∀ i : Fin k, 0 < N i := fun i => zero_lt_one.trans_le (hN i)
  have hNupper (i : Fin k) : N i ≤ x ^ H :=
    (Multiset.mem_le_prod_of_one_le (s := Finset.univ.val) hN
      (Finset.mem_univ i)).trans hPupper
  have hPpos : 0 < P := Finset.prod_pos fun i _ => hNi i
  have hlogN (i : Fin k) : 1 + Real.log (N i) ≤ (1 + H) * ℓ := by
    clear * - hNi hNupper hxpos hℓ
    simpa [one_add_mul, Real.log_rpow hxpos] using
      add_le_add hℓ (Real.log_le_log (hNi i) (hNupper i))
  have hℓE : ℓ ≤ ℓ ^ E :=
    Real.self_le_rpow_of_one_le hℓ (le_add_of_nonneg_left hD.le)
  let ψ : Fin k → Bool → ℝ → ℂ := fun i b u =>
    ((η u * Real.rpow (N i * u) (-(t i)) *
      (if b then Real.log (N i * u) else 1) : ℝ) : ℂ)
  have hprofile (i : Fin k) (b : Bool) :
      ContDiff ℝ 1 (ψ i b) ∧
        ∀ u ∈ Set.Icc (0 : ℝ) 2,
          ‖ψ i b u‖ ≤ Cψ * ℓ ^ E ∧ ‖deriv (ψ i b) u‖ ≤ Cψ * ℓ ^ E := by
    let φ : ℝ → ℝ := fun u => η u * Real.rpow (N i * u) (-(t i)) *
      (if b then Real.log (N i * u) else 1)
    obtain ⟨hφ, -, hφbound⟩ :=
      hprofiles (N i) (t i) b (hN i) (ht i).1 (ht i).2
    change ContDiff ℝ ∞ φ at hφ
    change ∀ r u, ‖iteratedDeriv r φ u‖ ≤
      Cder r * (1 + Real.log (N i)) / (Θ - 1) ^ r at hφbound
    have hφone : ContDiff ℝ 1 φ := contDiff_infty.mp hφ 1
    clear * - hφone hφbound hlogN hCder hB hℓpos hℓE hCψ
    refine ⟨Complex.ofRealCLM.contDiff.comp hφone, ?_⟩
    intro u _
    have hvalue : ‖φ u‖ ≤ Cψ * ℓ ^ E := by
      calc
        _ ≤ Cder 0 * (1 + Real.log (N i)) := by
          simpa using hφbound 0 u
        _ ≤ Cψ * ℓ := by
          rw [mul_assoc]
          exact mul_le_mul_of_nonneg (le_max_left _ _) (hlogN i) (hCder 0).le hB
        _ ≤ Cψ * ℓ ^ E := by gcongr
    have hderiv : ‖deriv φ u‖ ≤ Cψ * ℓ ^ E := by
      calc
        _ ≤ Cder 1 * (1 + Real.log (N i)) / (Θ - 1) := by
          simpa using hφbound 1 u
        _ = Cder 1 * (1 + Real.log (N i)) * ℓ ^ D := by
          change Cder 1 * (1 + Real.log (N i)) / ((1 + ℓ ^ (-D)) - 1) = _
          rw [add_sub_cancel_left, Real.rpow_neg hℓpos.le, div_inv_eq_mul]
        _ ≤ Cψ * ℓ ^ E := by
          simpa only [Cψ, E, Real.rpow_add_one hℓpos.ne' D,
            mul_assoc, mul_comm ℓ (ℓ ^ D)] using
            mul_le_mul_of_nonneg_right
              (mul_le_mul_of_nonneg (le_max_right (Cder 0) (Cder 1))
                (hlogN i) (hCder 1).le hB)
              (Real.rpow_nonneg hℓpos.le D)
    change ‖Complex.ofReal (φ u)‖ ≤ Cψ * ℓ ^ E ∧
      ‖deriv (fun y : ℝ => Complex.ofReal (φ y)) u‖ ≤ Cψ * ℓ ^ E
    simpa [(hφone.differentiable_one u).hasDerivAt.ofReal_comp.deriv] using
      And.intro hvalue hderiv
  clear hprofiles hCder
  have hsample (i : Fin k) (b : Bool) (n : ℕ) :
      ψ i b ((n : ℝ) / N i) =
        ((η ((n : ℝ) / N i) * Real.rpow (n : ℝ) (-(t i)) *
          (if b then Real.log (n : ℝ) else 1) : ℝ) : ℂ) := by
    simp only [ψ, mul_div_cancel₀ (n : ℝ) (hNi i).ne']
  let c : Fin k → ℕ → ℂ := fun i n =>
    ((η ((n : ℝ) / N i) * Real.rpow (n : ℝ) (-(t i)) * f i n : ℝ) : ℂ)
  let γ : Fin k → ℕ → ℕ → ℕ →₀ ℂ := fun i l u =>
    ∑ n ∈ Finset.Icc (max 1 l) u, Finsupp.single n (c i n)
  have hγapply (i : Fin k) (l u n : ℕ) :
      γ i l u n = if n ∈ Finset.Icc (max 1 l) u then c i n else 0 := by
    clear * - γ c i l u n
    simp only [γ, ← Finsupp.indicator_eq_sum_single, Finsupp.indicator_apply,
      dite_eq_ite]
  have hβeq (i : Fin k) : (β i).coeff = γ i (L i) (R i) :=
    MonoidAlgebra.coeff_sum _ _
  have hγfilter (i : Fin k) (l u l' u' : ℕ) :
      (γ i l u).filter (fun n => l' ≤ n ∧ n ≤ u') =
        γ i (max l l') (min u u') := by
    clear * - hγapply
    ext n
    rw [Finsupp.filter_apply, hγapply, hγapply]
    simp only [Finset.mem_Icc, max_le_iff, le_min_iff, ← ite_and,
      and_assoc, and_comm, and_left_comm]
  have hμbound (i : Fin k) (n : ℕ) : |μU i n| ≤ 1 := by
    change |if (n : ℝ) ≤ U i then
      (ArithmeticFunction.moebius n : ℝ) else 0| ≤ 1
    rw [abs_ite, abs_zero]
    exact ite_le_one (mod_cast ArithmeticFunction.abs_moebius_le_one) zero_le_one
  have hroleBound (i : Fin k) (n : ℕ) (hn : 1 ≤ n)
      (hnR : (n : ℝ) ≤ 2 * N i) : |f i n| ≤ B := by
    clear * - hNi hlogN hμbound hBone hn hnR
    dsimp only [f]
    split_ifs
    · exact (hμbound i n).trans hBone
    · simpa using (hμbound i n).trans hBone
    · simpa [ArithmeticFunction.zeta_apply, Nat.ne_zero_of_lt hn] using hBone
    · have hnRone : (1 : ℝ) ≤ n := mod_cast hn
      have hh := Real.log_le_log (zero_lt_one.trans_le hnRone) hnR
      rw [Real.log_mul two_ne_zero (hNi i).ne'] at hh
      refine (abs_of_nonneg (Real.log_nonneg hnRone)).le.trans
        (le_trans ?_ (hlogN i))
      linarith only [hh, Real.log_le_sub_one_of_pos zero_lt_two]
  clear hlogN hNupper hℓE
  have hβinterval (i : Fin k) (n : ℕ) (hn : n ∈ (β i).coeff.support) :
      n ∈ Finset.Icc (max 1 (L i)) (R i) := by
    simp only [hβeq, γ, ← Finsupp.indicator_eq_sum_single] at hn
    exact Finsupp.support_indicator_subset _ _ hn
  have hβbound (i : Fin k) (n : ℕ) : ‖(β i).coeff n‖ ≤ B := by
    clear * - hβeq hB hR ht hηbound hroleBound
    rw [hβeq]
    simp only [γ, ← Finsupp.indicator_eq_sum_single]
    rw [Finsupp.indicator_eq_set_indicator, norm_indicator_eq_indicator_norm]
    refine Set.indicator_apply_le' (fun hn => ?_) (fun _ => hB)
    have hnm := Finset.mem_Icc.mp hn
    have hn1 : 1 ≤ n := (le_max_left _ _).trans hnm.1
    change ‖((η ((n : ℝ) / N i) *
      (n : ℝ) ^ (-(t i)) * f i n : ℝ) : ℂ)‖ ≤ B
    rw [Complex.norm_real, Real.norm_eq_abs, abs_mul, abs_mul,
      abs_of_nonneg (hηbound _).1,
      abs_of_nonneg (Real.rpow_nonneg (Nat.cast_nonneg n) _)]
    grw [(hηbound ((n : ℝ) / N i)).2,
      Real.rpow_le_one_of_one_le_of_nonpos (Nat.one_le_cast.mpr hn1)
        (neg_nonpos.mpr (ht i).1)]
    simpa using hroleBound i n hn1 ((Nat.mono_cast hnm.2).trans (hR i))
  have hβsupport (i : Fin k) (n : ℕ) (hn : n ∈ (β i).coeff.support) :
      N i / 2 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * N i := by
    clear * - hβinterval hβeq hγapply hηsupport hΘ hΘtwo hNi hn
    have hηwindow : Θ⁻¹ < (n : ℝ) / N i ∧ (n : ℝ) / N i < Θ := by
      have hc := Finsupp.mem_support_iff.mp hn
      rw [hβeq, hγapply, ite_eq_left (hβinterval i n hn)] at hc
      exact hηsupport.subset
        (left_ne_zero_of_mul (left_ne_zero_of_mul (Complex.ofReal_ne_zero.mp hc)))
    constructor
    · simpa [div_eq_mul_inv] using
        (le_div_iff₀' (hNi i)).mp
          ((inv_anti₀ (zero_lt_one.trans hΘ) hΘtwo).trans hηwindow.1.le)
    · exact (div_le_iff₀ (hNi i)).mp (hηwindow.2.le.trans hΘtwo)
  have hβmass (i : Fin k) :
      (∑ n ∈ (β i).coeff.support, ‖(β i).coeff n‖) ≤ 2 * N i * B := by
    clear * - hβinterval hβbound hR hB
    have hcard : (β i).coeff.support.card ≤ R i := by
      apply (Finset.card_le_card (hβinterval i)).trans
      rw [Nat.card_Icc]
      omega
    calc
      _ ≤ ((β i).coeff.support.card : ℝ) * B := by
        simpa using Finset.sum_le_card_nsmul _ _ B (fun n _ => hβbound i n)
      _ ≤ 2 * N i * B :=
        mul_le_mul_of_nonneg_right ((Nat.mono_cast hcard).trans (hR i)) hB
  have hsqrtSaving (i : Fin k) (hlong : x ^ d ≤ N i) :
      ℓ ^ E * Real.sqrt (N i) ≤ N i / ℓ ^ S := by
    clear * - hlogAbsorb hℓpos hNi hlong
    have hsq : (ℓ ^ (E + S)) ^ 2 ≤ N i := by
      rw [← Real.rpow_mul_natCast hℓpos.le, mul_comm]
      exact hlogAbsorb.trans hlong
    apply (le_div_iff₀ (Real.rpow_pos_of_pos hℓpos S)).mpr
    rw [mul_right_comm, ← Real.rpow_add hℓpos E S]
    exact (mul_le_mul_of_nonneg_right (Real.le_sqrt_of_sq_le hsq)
      (Real.sqrt_nonneg _)).trans_eq (Real.mul_self_sqrt (hNi i).le)
  have hpositive (i : Fin k) (hlong : x ^ d ≤ N i)
      (b squarefree : Bool) (l u : ℕ) (hu : (u : ℝ) ≤ 2 * N i)
      (q r a : ℕ) (hq : 0 < q) (hr : 0 < r) (ha : Nat.Coprime a q) :
      ‖fullDiscrepancy
          ((∑ n ∈ Finset.Icc (max 1 l) u,
            Finsupp.single n
              (((if squarefree then |(ArithmeticFunction.moebius n : ℝ)|
                  else 1 : ℝ) : ℂ) * ψ i b ((n : ℝ) / N i))).filter
            (fun n => Nat.Coprime n r)) q a‖ ≤
        Cslot * ((q * r).divisors.card : ℝ) ^ 2 * N i / ℓ ^ S := by
    clear * - hNi hN hCψ hℓpos hprofile hsqrtSaving hlong hu hq hr ha
    have htaur : (r.divisors.card : ℝ) ≤ ((q * r).divisors.card : ℝ) ^ 2 :=
      mod_cast (Finset.card_le_card
        (Nat.divisors_subset_of_dvd (Nat.mul_ne_zero hq.ne' hr.ne')
          (Nat.dvd_mul_left r q))).trans (Nat.le_pow zero_lt_two)
    have hs : (if squarefree then Real.sqrt (u : ℝ) else 1) ≤
        2 * Real.sqrt (N i) := by
      cases squarefree with
      | false => exact one_le_mul_of_one_le_of_one_le one_le_two (Real.one_le_sqrt.mpr (hN i))
      | true =>
        change Real.sqrt (u : ℝ) ≤ 2 * Real.sqrt (N i)
        refine Real.sqrt_le_iff.mpr ⟨by positivity, ?_⟩
        nlinarith only [hu, (hNi i).le, Real.sq_sqrt (hNi i).le]
    refine (squarefree_or_integer_interval_discrepancy_le
      2 (N i) (Cψ * ℓ ^ E) zero_lt_two (hNi i) (by positivity)
      l u hu (ψ i b) (hprofile i b).1 (hprofile i b).2
      squarefree q r a hq hr ha).trans ?_
    calc
      _ = 12 * Cψ * (r.divisors.card : ℝ) * ℓ ^ E *
          (if squarefree then Real.sqrt (u : ℝ) else 1) := by ring
      _ ≤ 12 * Cψ * ((q * r).divisors.card : ℝ) ^ 2 * ℓ ^ E *
          (2 * Real.sqrt (N i)) := by gcongr
      _ = 24 * Cψ * ((q * r).divisors.card : ℝ) ^ 2 *
          (ℓ ^ E * Real.sqrt (N i)) := by ring
      _ ≤ 24 * Cψ * ((q * r).divisors.card : ℝ) ^ 2 * N i / ℓ ^ S := by
        rw [mul_div_assoc]
        gcongr
        exact hsqrtSaving i hlong
      _ ≤ Cslot * ((q * r).divisors.card : ℝ) ^ 2 * N i / ℓ ^ S := by
        have := hNi i
        gcongr
        exact le_max_right _ _
  have hsingle (i : Fin k) (hlong : x ^ d ≤ N i)
      (l u : ℕ) (hu : (u : ℝ) ≤ 2 * N i)
      (q r a : ℕ) (hq : 0 < q) (hr : 0 < r) (ha : Nat.Coprime a q) :
      ‖fullDiscrepancy
          ((γ i l u).filter (fun n => Nat.Coprime n r)) q a‖ ≤
        Cslot * ((q * r).divisors.card : ℝ) ^ 2 * N i / ℓ ^ S := by
    clear * - hsw hxμ hpositive hprofile hsample hγapply hNi
      hℓpos hlong hu hq hr ha
    by_cases h0 : role i = 0
    · have heq : γ i l u =
          ∑ n ∈ Finset.Icc (max 1 l) u,
            Finsupp.single n (if (n : ℝ) ≤ U i then
              (ArithmeticFunction.moebius n : ℂ) * ψ i false ((n : ℝ) / N i)
              else 0) := by
        apply Finset.sum_congr rfl
        intro n _
        congr 1
        simp [hsample, c, f, μU, arithmeticFunctionLowCutoff,
          h0, apply_ite Complex.ofReal, mul_comm, mul_left_comm, mul_assoc]
      rw [heq]
      refine (hsw x hxμ (N i) (U i) hlong (max 1 l) u hu
        (ψ i false) (hprofile i false).1 (hprofile i false).2 q r a hq hr ha).trans ?_
      have := hNi i
      gcongr
      exact le_max_left _ _
    · by_cases h1 : role i = 1
      · let u' : ℕ := min u ⌊U i⌋₊
        have heq : γ i l u =
            ∑ n ∈ Finset.Icc (max 1 l) u',
              Finsupp.single n
                (Complex.ofReal |(ArithmeticFunction.moebius n : ℝ)| *
                  ψ i false ((n : ℝ) / N i)) := by
          ext n
          have hm :
              n ∈ Finset.Icc (max 1 l) u' ↔
                n ∈ Finset.Icc (max 1 l) u ∧ (n : ℝ) ≤ U i := by
            by_cases hn : n = 0
            · simp [hn, Finset.mem_Icc]
            · simp only [u', Finset.mem_Icc, le_min_iff,
                Nat.le_floor_iff' hn, and_assoc]
          rw [hγapply, ← Finsupp.indicator_eq_sum_single,
            Finsupp.indicator_apply, dite_eq_ite, hsample]
          dsimp only [c, f]
          rw [ite_eq_right h0, ite_eq_left h1]
          simp only [μU, arithmeticFunctionLowCutoff,
            ArithmeticFunction.coe_mk, ArithmeticFunction.intCoe_apply,
            Bool.false_eq_true, ite_false]
          rw [abs_ite, abs_zero, mul_ite_zero,
            apply_ite Complex.ofReal, Complex.ofReal_zero, mul_one, ← ite_and]
          simp only [hm]
          rw [← Complex.ofReal_mul, mul_comm]
        rw [heq]
        exact hpositive i hlong false true l u'
          ((Nat.mono_cast (min_le_left u ⌊U i⌋₊)).trans hu) q r a hq hr ha
      · by_cases h2 : role i = 2
        · have heq : γ i l u =
              ∑ n ∈ Finset.Icc (max 1 l) u,
                Finsupp.single n (ψ i false ((n : ℝ) / N i)) := by
            apply Finset.sum_congr rfl
            intro n hn
            congr 1
            have hn1 : 1 ≤ n := (le_max_left _ _).trans (Finset.mem_Icc.mp hn).1
            simp [hsample, c, f, h2, ArithmeticFunction.zeta_apply,
              Nat.ne_zero_of_lt hn1]
          simpa only [heq, Bool.false_eq_true, ite_false, Complex.ofReal_one, one_mul] using
            hpositive i hlong false false l u hu q r a hq hr ha
        · have heq : γ i l u =
              ∑ n ∈ Finset.Icc (max 1 l) u,
                Finsupp.single n (ψ i true ((n : ℝ) / N i)) := by
            apply Finset.sum_congr rfl
            intro n _
            congr 1
            simp only [hsample, c, f, h0, h1, h2, ite_false, ite_true,
              ArithmeticFunction.log_apply]
          simpa only [heq, Bool.false_eq_true, ite_false, Complex.ofReal_one, one_mul] using
            hpositive i hlong true false l u hu q r a hq hr ha
  clear hsw hpositive hprofile hsample hsqrtSaving
  let mass (v : MonoidAlgebra ℂ ℕ) : ℝ :=
    ∑ n ∈ v.coeff.support, ‖v.coeff n‖
  have hmassNonneg (v : MonoidAlgebra ℂ ℕ) : 0 ≤ mass v := by
    clear * - mass v
    positivity
  have hmassMul (v w : MonoidAlgebra ℂ ℕ) :
      mass (v * w) ≤ mass v * mass w := by
    clear * - mass v w
    calc
      _ ≤ ∑ n ∈ (v * w).coeff.support,
          ∑ a ∈ v.coeff.support, ∑ b ∈ w.coeff.support,
            if a * b = n then ‖v.coeff a‖ * ‖w.coeff b‖ else 0 := by
        simp only [mass, MonoidAlgebra.coeff_mul, Finsupp.sum]
        grw [norm_sum_le, norm_sum_le]
        simp [apply_ite (fun z : ℂ => ‖z‖)]
      _ = ∑ a ∈ v.coeff.support, ∑ b ∈ w.coeff.support,
          ∑ n ∈ (v * w).coeff.support,
            if a * b = n then ‖v.coeff a‖ * ‖w.coeff b‖ else 0 :=
        Finset.sum_comm_cycle.symm
      _ ≤ mass v * mass w := by
        rw [Finset.sum_mul_sum]
        gcongr with a _ b _
        rw [Finset.sum_ite_eq]
        split_ifs
        · exact le_rfl
        · positivity
  have hmassProdScale (s : Finset (Fin k)) :
      mass (∏ i ∈ s, β i) ≤
        (2 : ℝ) ^ s.card * (∏ i ∈ s, N i) * B ^ s.card := by
    clear * - β N B mass hmassNonneg hmassMul hβmass s
    refine (Finset.le_prod_of_submultiplicative_of_nonneg mass hmassNonneg
      (by simp [mass, MonoidAlgebra.one_def]) hmassMul s β).trans ?_
    dsimp only [mass]
    grw [hβmass]
    simp [Finset.prod_mul_distrib]
  have hsupportProd : ∀ s : Finset (Fin k),
      ∀ n ∈ (∏ i ∈ s, β i).coeff.support,
        (∏ i ∈ s, N i) / (2 : ℝ) ^ s.card ≤ (n : ℝ) ∧
          (n : ℝ) ≤ (2 : ℝ) ^ s.card * (∏ i ∈ s, N i) := by
    clear * - β N hNi hβsupport
    suffices h : ∀ s : Finset (Fin k),
        ∀ n ∈ (∏ i ∈ s, β i).coeff.support,
          (∏ i ∈ s, N i / 2) ≤ (n : ℝ) ∧
            (n : ℝ) ≤ ∏ i ∈ s, 2 * N i by
      simpa [Finset.prod_mul_distrib] using h
    intro s
    induction s using Finset.induction_on with
    | empty => simp_all
    | @insert i s his ih =>
        intro n hn
        rw [Finset.prod_insert his] at hn
        obtain ⟨a, ha, b, hb, rfl⟩ :=
          Finset.mem_mul.mp
            (MonoidAlgebra.support_coeff_mul_subset (β i) (∏ j ∈ s, β j) hn)
        obtain ⟨haLower, haUpper⟩ := hβsupport i a ha
        obtain ⟨hbLower, hbUpper⟩ := ih b hb
        simp only [Finset.prod_insert his, Nat.cast_mul]
        exact ⟨mul_le_mul_of_nonneg haLower hbLower
            (div_nonneg (hNi i).le zero_le_two) (Nat.cast_nonneg b),
          mul_le_mul haUpper hbUpper (Nat.cast_nonneg b)
            (mul_nonneg zero_le_two (hNi i).le)⟩
  have hprodZero (s : Finset (Fin k)) : (∏ i ∈ s, β i).coeff 0 = 0 := by
    clear * - β N hNi hsupportProd s
    exact Finsupp.notMem_support_iff.mp fun hn =>
      (div_pos (Finset.prod_pos (s := s) fun i _ => hNi i)
        (pow_pos zero_lt_two s.card)).not_ge (by simpa using (hsupportProd s 0 hn).1)
  let T (v : MonoidAlgebra ℂ ℕ) : ArithmeticFunction ℂ :=
    toArithmeticFunction v.coeff
  have hTmul (v w : MonoidAlgebra ℂ ℕ) : T (v * w) = T v * T w := by
    clear * - T v w
    rw [← ArithmeticFunction.toArithmeticFunction_eq_self (T v * T w)]
    apply toArithmeticFunction_congr
    intro n hn
    change (v * w).coeff n = LSeries.convolution v.coeff w.coeff n
    rw [LSeries.convolution_def]
    exact MonoidAlgebra.coeff_mul_antidiag v w n n.divisorsAntidiagonal
      (by simp [Nat.mem_divisorsAntidiagonal, hn])
  have hTβbound (i : Fin k) (n : ℕ) : ‖T (β i) n‖ ≤ B := by
    clear * - β T B hB hβbound i n
    by_cases hn : n = 0
    · simpa [hn] using hB
    · simpa [T, toArithmeticFunction, hn] using hβbound i n
  have hgrowth : ∀ s : Finset (Fin k), s.Nonempty → ∀ n : ℕ,
      ‖(∏ i ∈ s, T (β i)) n‖ ≤ B ^ s.card * (n.divisors.card : ℝ) ^ (s.card - 1) := by
    clear * - β T B hB hTβbound
    intro s hs
    induction hs using Finset.Nonempty.cons_induction with
    | singleton i =>
        simpa using hTβbound i
    | cons i s his hsne ih =>
        have hexp :
            0 + (s.card - 1) + 1 = (Finset.cons i s his).card - 1 := by
          simpa [his] using Nat.sub_add_cancel (Finset.one_le_card.mpr hsne)
        simpa only [Finset.prod_cons, hexp, Finset.card_cons,
          one_pow, mul_one, pow_succ'] using
            convolution_growth_bound (T (β i)) (∏ j ∈ s, T (β j))
              (C := B) (D := B ^ s.card) (L := 1)
              hB (pow_nonneg hB _) zero_le_one 0 (s.card - 1) 0 0
              (by simpa using hTβbound i)
              (by simpa using ih)
  have hcoeffGrowth (s : Finset (Fin k)) (hs : s.Nonempty) (n : ℕ) :
      ‖(∏ i ∈ s, β i).coeff n‖ ≤ B ^ s.card * (n.divisors.card : ℝ) ^ (s.card - 1) := by
    clear * - β T B hprodZero hgrowth hTmul s hs n
    have hmap : T (∏ i ∈ s, β i) = ∏ i ∈ s, T (β i) := by
      simpa using
        map_multiset_ne_zero_prod
          ({ toFun := T, map_mul' := hTmul } :
            MonoidAlgebra ℂ ℕ →ₙ* ArithmeticFunction ℂ)
          (s := s.val.map β) (by simpa using hs.ne_empty)
    replace hmap := (ArithmeticFunction.toArithmeticFunction_eq_self
      (⟨(∏ i ∈ s, β i).coeff, hprodZero s⟩ : ArithmeticFunction ℂ)).symm.trans hmap
    simpa [← hmap] using hgrowth s hs n
  have htransportBound
      (α ζ : ℕ →₀ ℂ) (q r a l₀ u₀ : ℕ)
      (hα : ∀ m ∈ α.support, 0 < m) (hq : 0 < q) (ha : Nat.Coprime a q)
      (V : ℝ) (hV : 0 ≤ V)
      (hζ : ∀ l u b : ℕ, Nat.Coprime b q →
        ‖fullDiscrepancy
            ((ζ.filter (fun n => l ≤ n ∧ n ≤ u)).filter
              (fun n => Nat.Coprime n r)) q b‖ ≤ V) :
      ‖fullDiscrepancy
          (((finiteConvolution α ζ).filter
            (fun n => l₀ ≤ n ∧ n ≤ u₀)).filter
              (fun n => Nat.Coprime n r)) q a‖ ≤
        V * ∑ m ∈ α.support, ‖α m‖ := by
    clear * - α ζ q r a l₀ u₀ hα hq ha V hV hζ
    let : NeZero q := ⟨hq.ne'⟩
    let b : ℕ → ℕ := fun m => ((m : ZMod q)⁻¹ * (a : ZMod q)).val
    let ζm : ℕ → ℕ →₀ ℂ := fun m =>
      ζ.filter (fun n => l₀ ⌈/⌉ m ≤ n ∧ n ≤ u₀ / m)
    let κ : ℕ → ℕ → ℂ := fun a n =>
      (if n % q = a % q then 1 else 0) -
        (if Nat.Coprime n q then (q.totient : ℂ)⁻¹ else 0)
    have hdiscrepancy (g : ℕ →₀ ℂ) (a : ℕ) :
        fullDiscrepancy g q a =
          ∑ n ∈ g.support, g n * κ a n := by
      simp [fullDiscrepancy,
        progressionMass, reducedMass, κ,
        mul_sub, div_eq_mul_inv, Finset.sum_mul]
    have hfilterPair (g : ℕ →₀ ℂ) (p : ℕ → Prop)
        [DecidablePred p] (J : ℕ → ℂ) :
        (∑ n ∈ (g.filter p).support, (g.filter p) n * J n) =
          ∑ n ∈ g.support, g n * (if p n then J n else 0) := by
      simp [Finsupp.filter_apply, Finset.sum_filter, ← ite_and]
    have hinterval (m n : ℕ) (hm : 0 < m) :
        (l₀ ≤ m * n ∧ m * n ≤ u₀) ↔ (l₀ ⌈/⌉ m ≤ n ∧ n ≤ u₀ / m) := by
      rw [ceilDiv_le_iff_le_mul hm, Nat.le_div_iff_mul_le hm, Nat.mul_comm n m]
    have hprimitive (m : ℕ) (hmq : Nat.Coprime m q) : Nat.Coprime (b m) q := by
      simpa only [b, Units.val_mul, ← ZMod.inv_coe_unit, ZMod.coe_unitOfCoprime] using
        ZMod.val_coe_unit_coprime
          ((ZMod.unitOfCoprime m hmq)⁻¹ * ZMod.unitOfCoprime a ha)
    have hresidue (m n : ℕ) (hmq : Nat.Coprime m q) :
        (m * n) % q = a % q ↔ n % q = b m % q := by
      rw [← ZMod.natCast_eq_natCast_iff' (m * n) a q,
        ← ZMod.natCast_eq_natCast_iff' n (b m) q, Nat.cast_mul]
      simpa only [b, ZMod.natCast_zmod_val,
        ← ZMod.inv_coe_unit, ZMod.coe_unitOfCoprime] using
        (Units.eq_inv_mul_iff_mul_eq (ZMod.unitOfCoprime m hmq)
          (a := (n : ZMod q)) (c := (a : ZMod q))).symm
    have hkernel (m n : ℕ) (hm : 0 < m) :
        (if l₀ ≤ m * n ∧ m * n ≤ u₀ then
          if Nat.Coprime (m * n) r then κ a (m * n) else 0 else 0) =
          if Nat.Coprime m (q * r) then
            if l₀ ⌈/⌉ m ≤ n ∧ n ≤ u₀ / m then
              if Nat.Coprime n r then κ (b m) n else 0 else 0 else 0 := by
      by_cases hmq : Nat.Coprime m q
      · by_cases hmr : Nat.Coprime m r
        · simp only [κ, Nat.coprime_mul_iff_left, Nat.coprime_mul_iff_right,
            eq_true hmq, eq_true hmr, true_and, ite_true, hinterval m n hm, hresidue m n hmq]
        · simp only [Nat.coprime_mul_iff_left, Nat.coprime_mul_iff_right,
            hmr, false_and, and_false, ite_false, ite_self]
      · have hmod : ¬(m * n) % q = a % q := fun h =>
          hmq (Nat.Coprime.coprime_mul_right
            ((show Nat.ModEq q (m * n) a from h).gcd_eq.trans ha))
        simp only [Nat.coprime_mul_iff_right, hmq, false_and, ite_false, κ,
          Nat.coprime_mul_iff_left, hmod, sub_self, ite_self]
    have htransport :
        fullDiscrepancy
            (((finiteConvolution α ζ).filter
              (fun n => l₀ ≤ n ∧ n ≤ u₀)).filter
                (fun n => Nat.Coprime n r)) q a =
          ∑ m ∈ α.support with Nat.Coprime m (q * r),
            α m * fullDiscrepancy
              ((ζm m).filter (fun n => Nat.Coprime n r)) q (b m) := by
      calc
        _ = ∑ m ∈ α.support, ∑ n ∈ ζ.support, α m * ζ n *
            (if l₀ ≤ m * n ∧ m * n ≤ u₀ then
              if Nat.Coprime (m * n) r then κ a (m * n) else 0 else 0) := by
          rw [hdiscrepancy, hfilterPair, hfilterPair,
            finiteConvolution_pairing]
        _ = _ := by
          rw [Finset.sum_filter]
          apply Finset.sum_congr rfl
          intro m hm
          simp_rw [hkernel m _ (hα m hm)]
          rw [hdiscrepancy, hfilterPair, hfilterPair, Finset.mul_sum]
          simp [mul_assoc]
    rw [htransport]
    calc
      _ ≤ ∑ m ∈ α.support with Nat.Coprime m (q * r), ‖α m‖ * V := by
        apply norm_sum_le_of_le
        intro m hm
        exact norm_mul_le_of_le le_rfl
          (hζ (l₀ ⌈/⌉ m) (u₀ / m) (b m)
            (hprimitive m (Finset.mem_filter.mp hm).2.coprime_mul_right_right))
      _ ≤ V * ∑ m ∈ α.support, ‖α m‖ := by
        rw [mul_comm V, Finset.sum_mul]
        exact Finset.sum_mono_set_of_nonneg
          (fun m => mul_nonneg (norm_nonneg _) hV) (Finset.filter_subset _ _)
  have huniv : (Finset.univ : Finset (Fin k)).Nonempty :=
    ⟨⟨0, hk⟩, Finset.mem_univ _⟩
  refine ⟨?_, ?_, ?_⟩
  · intro n hn
    obtain ⟨hlo, hup⟩ := hsupportProd Finset.univ n (Finset.mem_of_mem_filter n hn)
    simp only [Finset.card_fin] at hlo hup
    have hpow : (2 : ℝ) ^ k ≤ (2 : ℝ) ^ K :=
      pow_le_pow_right₀ one_le_two hkK
    clear * - hlo hup hPpos hpow
    refine ⟨le_trans ?_ hlo, hup.trans ?_⟩ <;> gcongr
  · intro n
    clear * - β F B ℓ K k H hH hℓpos hB hBone hkK hprodZero hcoeffGrowth huniv n
    by_cases hn : n = 0
    · subst n
      rw [Finsupp.filter_apply, hprodZero Finset.univ, ite_self, norm_zero]
      positivity
    · have htau : (1 : ℝ) ≤ n.divisors.card :=
        mod_cast Finset.one_le_card.mpr (Nat.nonempty_divisors.mpr hn)
      calc
        _ ≤ B ^ k * (n.divisors.card : ℝ) ^ (k - 1) := by
          grw [Finsupp.filter_eq_indicator, norm_indicator_le_norm_self]
          simpa using hcoeffGrowth Finset.univ huniv n
        _ ≤ (1 + H) ^ K * (n.divisors.card : ℝ) ^ (K - 1) * (Real.log x) ^ K := by
          rw [mul_right_comm, ← mul_pow]
          gcongr
  · intro q r a hq hr ha
    obtain ⟨j, hj⟩ : ∃ j : Fin k, x ^ d ≤ N j := by
      clear * - k K x N d δ hNi huniv hkK hxone hxpos hd hPlower hK
      by_contra hnot
      push Not at hnot
      have hlt : (∏ i : Fin k, N i) < (x ^ d) ^ k := by
        simpa using
          Finset.prod_lt_prod_of_nonempty (fun i _ => hNi i)
            (fun i _ => hnot i) huniv
      have hpower : (x ^ d) ^ K = x ^ δ := by
        rw [← Real.rpow_mul_natCast hxpos.le d K]
        congr 1
        exact div_mul_cancel₀ δ (mod_cast hK.ne')
      exact hPlower.not_gt (hlt.trans_le
        ((pow_le_pow_right₀ (Real.one_le_rpow hxone.le hd.le) hkK).trans_eq hpower))
    let J : Finset (Fin k) := Finset.univ.erase j
    let Q : ℝ := ∏ i ∈ J, N i
    let α : ℕ →₀ ℂ := (∏ i ∈ J, β i).coeff
    have hQpos : 0 < Q := Finset.prod_pos fun i _ => hNi i
    have hJP : Q * N j = P := Finset.prod_erase_mul _ _ (Finset.mem_univ j)
    have hJcard : J.card ≤ K := (card_finset_fin_le J).trans hkK
    have hαpositive : ∀ m ∈ α.support, 0 < m := by
      clear * - α J hprodZero
      intro m hm
      exact Nat.pos_of_ne_zero
        (ne_of_mem_of_not_mem hm (Finsupp.notMem_support_iff.mpr (hprodZero J)))
    have hfactor : finiteConvolution α (β j).coeff =
        (∏ i : Fin k, β i).coeff := by
      clear * - α β j
      exact congrArg (fun v : MonoidAlgebra ℂ ℕ => v.coeff)
        (Finset.prod_erase_mul Finset.univ β (Finset.mem_univ j))
    have hslotNonneg :
        0 ≤ Cslot * ((q * r).divisors.card : ℝ) ^ 2 * N j / ℓ ^ S := by
      have := hNi j
      clear * - this hCslot hℓpos
      positivity
    have hconv := htransportBound α (β j).coeff q r a L₀ R₀ hαpositive hq ha
      (Cslot * ((q * r).divisors.card : ℝ) ^ 2 * N j / ℓ ^ S)
      hslotNonneg (fun l u b hb => by
        clear * - β hβeq hγfilter hsingle j hj L R hR q r l u b hq hr hb
        rw [hβeq, hγfilter]
        apply hsingle j hj (max (L j) l) (min (R j) u) _ q r b hq hr hb
        exact (Nat.mono_cast (min_le_left (R j) u)).trans (hR j))
    rw [hfactor] at hconv
    have hmass : (∑ m ∈ α.support, ‖α m‖) ≤
        (2 * (1 + H)) ^ K * ℓ ^ K * Q := by
      clear * - α J Q B H ℓ K hmassProdScale hJcard hQpos hBone
      refine (hmassProdScale J).trans ?_
      rw [mul_right_comm, ← mul_pow, ← mul_pow, mul_assoc (2 : ℝ) (1 + H) ℓ]
      gcongr
      exact one_le_mul_of_one_le_of_one_le one_le_two hBone
    refine (hconv.trans (mul_le_mul_of_nonneg_left hmass hslotNonneg)).trans_eq ?_
    clear * - ℓ S A K Cslot H q r N j P Q hℓpos hJP
    rw [Real.rpow_add_natCast hℓpos.ne' A K]
    change (Cslot * ((q * r).divisors.card : ℝ) ^ 2 * N j /
      (ℓ ^ A * ℓ ^ K)) * ((2 * (1 + H)) ^ K * ℓ ^ K * Q) =
      (Cslot * (2 * (1 + H)) ^ K) * ((q * r).divisors.card : ℝ) ^ 2 * P / ℓ ^ A
    rw [← hJP]
    field_simp

open Classical in
theorem weighted_shortInterval_fullDiscrepancy_bound
    (Y K k X Q J r : ℕ) (hY : 2 ≤ Y) (hX : X ≤ Y ^ K) (hQ : 1 ≤ Q)
    (L : ℝ) (hL : 0 ≤ L)
    (S : Finset ℕ) (hS : S ⊆ Finset.Icc 1 Q)
    (a : ℕ → ℕ) (ha : ∀ q ∈ S, Nat.Coprime (a q) q)
    (lo hi : Fin r → ℕ)
    (hinterval : ∀ i, 1 ≤ lo i ∧ lo i ≤ hi i ∧ hi i ≤ X + 1)
    (u : ℕ →₀ ℂ)
    (hsupport : ∀ n ∈ u.support, ∃ i, lo i ≤ n ∧ n < hi i)
    (henvelope : ∀ n ∈ u.support,
      ‖u n‖ ≤ L * (n.divisors.card : ℝ) ^ k) :
    (∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
      ‖fullDiscrepancy u q (a q)‖) ≤
      (2 : ℝ) ^ (K * k + 1) * L *
        ((∑ i : Fin r, ((hi i - lo i : ℕ) : ℝ)) +
          (r : ℝ) * (Y ^ 2 : ℕ) * (Q + 1 : ℕ)) *
        (1 + Real.log (Y ^ 2 : ℕ)) ^ (2 ^ (K * k)) *
        (1 + Real.log (Q : ℝ)) ^ (2 ^ (J + 1)) := by
  have hmoment (e Z : ℕ) (hZ : 1 ≤ Z) :
      (∑ d ∈ Finset.Icc 1 Z, (d.divisors.card : ℝ) ^ e) ≤
        (Z : ℝ) * (1 + Real.log (Z : ℝ)) ^ (2 ^ e) := by
    refine (sum_card_divisors_pow_le_mul_log_pow e Z).trans ?_
    apply mul_le_mul_of_nonneg_left _ (Nat.cast_nonneg Z)
    apply pow_le_pow_right₀
    · exact le_add_of_nonneg_right (Real.log_nonneg (by exact_mod_cast hZ))
    · exact Nat.sub_le _ _
  let Z := Y ^ 2
  let R := (2 : ℝ) ^ (K * k) * (1 + Real.log (Z : ℝ)) ^ (2 ^ (K * k))
  let H : ℝ := ∑ i : Fin r, ((hi i - lo i : ℕ) : ℝ)
  let W := (1 + Real.log (Q : ℝ)) ^ (2 ^ (J + 1))
  have hZ : 1 ≤ Z := one_le_pow₀ (by omega : 1 ≤ Y)
  have hZlog : 1 ≤ 1 + Real.log (Z : ℝ) :=
    le_add_of_nonneg_right (Real.log_nonneg (by exact_mod_cast hZ))
  have hR : 0 ≤ R := by dsimp [R]; positivity
  have hH : 0 ≤ H := Finset.sum_nonneg fun _ _ => Nat.cast_nonneg _
  have hQlog : 1 ≤ 1 + Real.log (Q : ℝ) :=
    le_add_of_nonneg_right (Real.log_nonneg (by exact_mod_cast hQ))
  have hW : 0 ≤ W := pow_nonneg (zero_le_one.trans hQlog) _
  have hcover (w : ℕ → ℝ) (hw : ∀ n, 0 ≤ w n) :
      (∑ n ∈ u.support, w n) ≤ ∑ i : Fin r, ∑ n ∈ Finset.Ico (lo i) (hi i), w n := by
    calc
      _ ≤ ∑ n ∈ u.support, ∑ i : Fin r,
          if n ∈ Finset.Ico (lo i) (hi i) then w n else 0 := by
        apply Finset.sum_le_sum
        intro n hn
        obtain ⟨i, hni⟩ := hsupport n hn
        calc
          w n = (if n ∈ Finset.Ico (lo i) (hi i) then w n else 0) := by
            rw [ite_eq_left (Finset.mem_Ico.mpr hni)]
          _ ≤ _ := Finset.single_le_sum
            (f := fun j : Fin r => if n ∈ Finset.Ico (lo j) (hi j) then w n else 0)
            (fun j _ => by split_ifs <;> first | exact hw n | exact le_rfl)
            (Finset.mem_univ i)
      _ = ∑ i : Fin r, ∑ n ∈ u.support.filter (fun n => n ∈ Finset.Ico (lo i) (hi i)),
          w n := by rw [Finset.sum_comm]; simp only [Finset.sum_filter]
      _ ≤ _ := by
        apply Finset.sum_le_sum
        intro i _
        exact Finset.sum_le_sum_of_subset_of_nonneg
          (fun n hn => (Finset.mem_filter.mp hn).2) (fun n _ _ => hw n)
  have hprogress (q v : ℕ) (hq : 0 < q) (hv : Nat.Coprime v q) :
      (∑ n ∈ u.support, if n % q = v % q then (n.divisors.card : ℝ) ^ k else 0) ≤
        R * (H / q + (r : ℝ) * Z) := by
    calc
      _ ≤ ∑ i : Fin r, ∑ n ∈ Finset.Ico (lo i) (hi i),
          if n % q = v % q then (n.divisors.card : ℝ) ^ k else 0 :=
        hcover _ (fun n => by split_ifs <;> positivity)
      _ = ∑ i : Fin r, ∑ n ∈ (Finset.Ico (lo i) (hi i)).filter
          (fun n => n % q = v % q), (n.divisors.card : ℝ) ^ k := by
        simp only [Finset.sum_filter]
      _ ≤ ∑ i : Fin r, R * (((hi i - lo i : ℕ) : ℝ) / q + Z) := by
        apply Finset.sum_le_sum
        intro i _
        exact sum_Ico_card_divisors_pow_modEq_le Y K k X hY hX
          (lo i) (hi i) q v (hinterval i).1 (hinterval i).2.1
          (hinterval i).2.2 hq hv
      _ = _ := by
        rw [← Finset.mul_sum, Finset.sum_add_distrib, Finset.sum_div]
        simp only [Finset.sum_const, Finset.card_univ, Fintype.card_fin, nsmul_eq_mul]
  have hall : (∑ n ∈ u.support, (n.divisors.card : ℝ) ^ k) ≤
      R * (H + (r : ℝ) * Z) := by
    simpa only [Nat.mod_one, ite_true, Nat.cast_one, div_one] using
      hprogress 1 0 (by decide) (by decide)
  have hnormmask (p : ℕ → Prop) [DecidablePred p] :
      ‖∑ n ∈ u.support, if p n then u n else 0‖ ≤
        L * ∑ n ∈ u.support, if p n then (n.divisors.card : ℝ) ^ k else 0 := by
    rw [Finset.mul_sum]
    apply norm_sum_le_of_le
    intro n hn
    by_cases hp : p n
    · simpa only [ite_eq_left hp] using henvelope n hn
    · simp only [ite_eq_right hp, norm_zero, mul_zero, le_refl]
  have hpoint (q : ℕ) (hqS : q ∈ S) :
      ‖fullDiscrepancy u q (a q)‖ ≤
        L * R * (H / q + (r : ℝ) * Z + (H + (r : ℝ) * Z) / q.totient) := by
    have hq : 0 < q := (Finset.mem_Icc.mp (hS hqS)).1
    have hfirst : ‖progressionMass u q (a q)‖ ≤
        L * R * (H / q + (r : ℝ) * Z) :=
      (hnormmask (fun n => n % q = a q % q)).trans
        (by simpa only [mul_assoc] using
          mul_le_mul_of_nonneg_left (hprogress q (a q) hq (ha q hqS)) hL)
    have hsecond : ‖reducedMass u q‖ ≤
        L * R * (H + (r : ℝ) * Z) := by
      refine (hnormmask (fun n => Nat.Coprime n q)).trans ?_
      calc
        _ ≤ L * ∑ n ∈ u.support, (n.divisors.card : ℝ) ^ k := by
          apply mul_le_mul_of_nonneg_left _ hL
          apply Finset.sum_le_sum
          intro n _
          split_ifs <;> first | exact le_rfl | positivity
        _ ≤ _ := by simpa only [mul_assoc] using mul_le_mul_of_nonneg_left hall hL
    rw [fullDiscrepancy]
    calc
      _ ≤ L * R * (H / q + (r : ℝ) * Z) +
          (L * R * (H + (r : ℝ) * Z)) / q.totient := norm_sub_le_of_le hfirst (by
        rw [norm_div, Complex.norm_natCast]
        exact div_le_div_of_nonneg_right hsecond (Nat.cast_nonneg _))
      _ = _ := by ring
  have hJlog : (1 + Real.log (Q : ℝ)) ^ (2 ^ J) ≤ W :=
    pow_le_pow_right₀ hQlog (pow_le_pow_right₀ (by decide : 1 ≤ (2 : ℕ)) (Nat.le_succ J))
  have hSrec (e : ℕ) :
      (∑ q ∈ S, (q.divisors.card : ℝ) ^ e / q) ≤
        (1 + Real.log (Q : ℝ)) ^ (2 ^ e) := by
    refine (Finset.sum_le_sum_of_subset_of_nonneg hS (fun q _ _ => by positivity)).trans
      (sum_card_divisors_pow_div_le_log_pow e Q)
  have hrecJ : (∑ q ∈ S, (q.divisors.card : ℝ) ^ J / q) ≤ W :=
    (hSrec J).trans hJlog
  have hsumJ : (∑ q ∈ S, (q.divisors.card : ℝ) ^ J) ≤ (Q : ℝ) * W := by
    refine (Finset.sum_le_sum_of_subset_of_nonneg hS (fun q _ _ => by positivity)).trans ?_
    exact (hmoment J Q hQ).trans (mul_le_mul_of_nonneg_left hJlog (Nat.cast_nonneg Q))
  have htotJ : (∑ q ∈ S, (q.divisors.card : ℝ) ^ J / q.totient) ≤ W := by
    calc
      _ ≤ ∑ q ∈ S, (q.divisors.card : ℝ) ^ (J + 1) / q := by
        apply Finset.sum_le_sum
        intro q hqS
        have hq : (0 : ℝ) < q := by exact_mod_cast (Finset.mem_Icc.mp (hS hqS)).1
        calc
          _ = ((q.divisors.card : ℝ) ^ J / q) * ((q : ℝ) / q.totient) :=
            (div_mul_div_cancel₀ hq.ne').symm
          _ ≤ ((q.divisors.card : ℝ) ^ J / q) * (q.divisors.card : ℝ) :=
            mul_le_mul_of_nonneg_left (div_totient_le_card_divisors q) (by positivity)
          _ = _ := by rw [pow_succ]; ring
      _ ≤ W := hSrec (J + 1)
  calc
    _ ≤ ∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
        (L * R * (H / q + (r : ℝ) * Z + (H + (r : ℝ) * Z) / q.totient)) := by
      apply Finset.sum_le_sum
      intro q hq
      exact mul_le_mul_of_nonneg_left (hpoint q hq) (by positivity)
    _ = L * R * ∑ q ∈ S,
        (H * ((q.divisors.card : ℝ) ^ J / q) +
          (r : ℝ) * Z * (q.divisors.card : ℝ) ^ J +
          (H + (r : ℝ) * Z) * ((q.divisors.card : ℝ) ^ J / q.totient)) := by
      rw [Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro q _
      ring
    _ = L * R *
        (H * (∑ q ∈ S, (q.divisors.card : ℝ) ^ J / q) +
          (r : ℝ) * Z * (∑ q ∈ S, (q.divisors.card : ℝ) ^ J) +
          (H + (r : ℝ) * Z) * (∑ q ∈ S, (q.divisors.card : ℝ) ^ J / q.totient)) := by
      rw [Finset.sum_add_distrib, Finset.sum_add_distrib,
        ← Finset.mul_sum, ← Finset.mul_sum, ← Finset.mul_sum]
    _ ≤ L * R * (H * W + (r : ℝ) * Z * ((Q : ℝ) * W) +
        (H + (r : ℝ) * Z) * W) := by
      apply mul_le_mul_of_nonneg_left _ (mul_nonneg hL hR)
      exact add_le_add
        (add_le_add (mul_le_mul_of_nonneg_left hrecJ hH)
          (mul_le_mul_of_nonneg_left hsumJ (by positivity)))
        (mul_le_mul_of_nonneg_left htotJ (by positivity))
    _ = L * R * (2 * H + (r : ℝ) * Z * ((Q : ℝ) + 1)) * W := by ring
    _ ≤ L * R * (2 * (H + (r : ℝ) * Z * ((Q : ℝ) + 1))) * W := by
      apply mul_le_mul_of_nonneg_right _ hW
      apply mul_le_mul_of_nonneg_left _ (mul_nonneg hL hR)
      have hz : 0 ≤ (r : ℝ) * Z * ((Q : ℝ) + 1) := by positivity
      linarith
    _ = _ := by
      rw [pow_succ (2 : ℝ) (K * k)]
      dsimp only [R, H, W, Z]
      push_cast
      ring

open Classical in
theorem weighted_boundary_fullDiscrepancy_log_saving
    (θ : ℝ) (hθ0 : 0 < θ) (hθ1 : θ < 1)
    (k E J r : ℕ) (Cscale Cwidth : ℝ)
    (hCscale : 1 ≤ Cscale) (hCwidth : 0 ≤ Cwidth)
    (A : ℝ) (hA : 0 < A) :
    ∃ D : ℕ, 1 ≤ D ∧ ∃ K X₀ : ℝ, 0 < K ∧ Real.exp 1 ≤ X₀ ∧
      ∀ x : ℝ, X₀ ≤ x →
      ∀ L : ℝ, 0 ≤ L →
      ∀ S : Finset ℕ, S ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
      ∀ lo hi : Fin r → ℕ,
        (∀ i, 1 ≤ lo i ∧ lo i ≤ hi i ∧ hi i ≤ ⌈Cscale * x⌉₊ + 1) →
        (∑ i : Fin r, ((hi i - lo i : ℕ) : ℝ)) ≤
          Cwidth * x / (Real.log x) ^ D →
      ∀ u : ℕ →₀ ℂ,
        (∀ n ∈ u.support, ∃ i, lo i ≤ n ∧ n < hi i) →
        (∀ n ∈ u.support,
          ‖u n‖ ≤ L * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ E) →
        (∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy u q (a q)‖) ≤
            K * L * x / (Real.log x) ^ A := by
  obtain ⟨κ, hκ⟩ := exists_nat_gt (max (3 : ℝ) (2 / (1 - θ)))
  have hκpos : (0 : ℝ) < κ := lt_of_lt_of_le (by positivity) hκ.le
  let α : ℝ := 2 / (κ : ℝ)
  let γ : ℝ := θ + α
  have hαpos : 0 < α := div_pos (by norm_num) hκpos
  have hαgap : α < 1 - θ :=
    (div_lt_comm₀ hκpos (sub_pos.mpr hθ1)).mpr ((le_max_right _ _).trans_lt hκ)
  have hα1 : α ≤ 1 := hαgap.le.trans (sub_le_self 1 hθ0.le)
  have hγ1 : γ < 1 := lt_sub_iff_add_lt'.mp hαgap
  let P : ℕ := 2 ^ (κ * k)
  let R : ℕ := 2 ^ (J + 1)
  let T : ℕ := E + P + R
  let D : ℕ := ⌈A + (T : ℝ) + 1⌉₊
  have hD1 : 1 ≤ D := Nat.one_le_ceil_iff.mpr (by positivity)
  have hD : (T : ℝ) + A ≤ D := by
    have h := Nat.le_ceil (A + (T : ℝ) + 1)
    change A + (T : ℝ) + 1 ≤ (D : ℝ) at h
    linarith only [h]
  have hCscale0 : 0 < Cscale := zero_lt_one.trans_le hCscale
  let cY : ℝ := 32 * Cscale
  have hcY1 : 1 ≤ cY := by dsimp only [cY]; linarith only [hCscale]
  have hcYpos : 0 < cY := zero_lt_one.trans_le hcY1
  have hlogcY : 0 ≤ Real.log cY := Real.log_nonneg hcY1
  let dY : ℝ := 2 + Real.log cY
  have hdYpos : 0 < dY := add_pos_of_pos_of_nonneg (by norm_num) hlogcY
  let F : ℝ := 2 ^ (κ * k + 1) * dY ^ P * 2 ^ R
  have hF : 0 < F := by dsimp only [F]; positivity
  let b : ℝ := 64 * (r : ℝ) * Cscale
  have hb : 0 ≤ b := by dsimp only [b]; positivity
  have hevent : ∀ᶠ x : ℝ in Filter.atTop, Real.exp 1 ≤ x ∧
      (Real.log x) ^ ((T : ℝ) + A) ≤ x ^ (1 - γ) := by
    filter_upwards [Filter.eventually_ge_atTop (Real.exp 1),
      (isLittleO_log_rpow_rpow_atTop ((T : ℝ) + A)
        (sub_pos.mpr hγ1)).eventuallyLE] with x hx hlog
    have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
    have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxpos).mpr hx
    refine ⟨hx, ?_⟩
    simpa only [Real.norm_of_nonneg
      (Real.rpow_nonneg (zero_le_one.trans hlog1) _),
      Real.norm_of_nonneg (Real.rpow_nonneg hxpos.le _)] using hlog
  obtain ⟨X₀, hX₀⟩ := Filter.eventually_atTop.mp hevent
  refine ⟨D, hD1, F * (Cwidth + b + 1), X₀,
    mul_pos hF (by linarith only [hCwidth, hb]), (hX₀ X₀ le_rfl).1, ?_⟩
  intro x hx L hL S hS a ha lo hi hinterval hwidth u hsupport henvelope
  obtain ⟨hxexp, hlogsmall⟩ := hX₀ x hx
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hx1 : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hxexp
  have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxpos).mpr hxexp
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlog1
  have hLA : 0 < (Real.log x) ^ A := Real.rpow_pos_of_pos hlogpos A
  let X : ℕ := ⌈Cscale * x⌉₊
  let t : ℝ := (X : ℝ) ^ (1 / (κ : ℝ))
  let Y : ℕ := 2 + ⌈t⌉₊
  let Q : ℕ := ⌊x ^ θ⌋₊
  let H : ℝ := ∑ i : Fin r, ((hi i - lo i : ℕ) : ℝ)
  have hH : 0 ≤ H := Finset.sum_nonneg fun _ _ => Nat.cast_nonneg _
  change H ≤ Cwidth * x / (Real.log x) ^ D at hwidth
  have hCx1 : 1 ≤ Cscale * x := one_le_mul_of_one_le_of_one_le hCscale hx1
  have hX1r : (1 : ℝ) ≤ X := hCx1.trans (Nat.le_ceil _)
  have hX0 : (0 : ℝ) ≤ X := Nat.cast_nonneg X
  have hXupper : (X : ℝ) ≤ 2 * Cscale * x := by
    have h := (Nat.ceil_lt_add_one (zero_le_one.trans hCx1)).le
    change (X : ℝ) ≤ Cscale * x + 1 at h
    nlinarith only [h, hCx1]
  have ht1 : 1 ≤ t := Real.one_le_rpow hX1r (by positivity)
  have ht0 : 0 ≤ t := zero_le_one.trans ht1
  have hY : 2 ≤ Y := by dsimp only [Y]; omega
  have htY : t ≤ (Y : ℝ) := by
    simpa only [Y, Nat.cast_add, Nat.cast_ofNat] using
      (Nat.le_ceil t).trans (le_add_of_nonneg_left zero_le_two)
  have hYupper : (Y : ℝ) ≤ 4 * t := by
    have h := (Nat.ceil_lt_add_one ht0).le
    change ((2 + ⌈t⌉₊ : ℕ) : ℝ) ≤ 4 * t
    push_cast
    linarith only [h, ht1]
  have ht2 : t ^ 2 = (X : ℝ) ^ α := by
    dsimp only [t, α]
    rw [← Real.rpow_mul_natCast hX0]
    congr 1
    ring
  have hXscale : X ≤ Y ^ κ := by
    have h := (Real.rpow_inv_le_iff_of_pos hX0 (Nat.cast_nonneg Y) hκpos).mp
      (by simpa only [t, one_div] using htY)
    rw [Real.rpow_natCast] at h
    exact_mod_cast h
  have hCpow : (2 * Cscale) ^ α ≤ 2 * Cscale := Real.rpow_le_self_of_one_le
    (show (1 : ℝ) ≤ 2 * Cscale by linarith only [hCscale]) hα1
  have hY2 : ((Y ^ 2 : ℕ) : ℝ) ≤ 32 * Cscale * x ^ α := by
    calc
      _ = (Y : ℝ) ^ 2 := by simp only [Nat.cast_pow]
      _ ≤ (4 * t) ^ 2 := pow_le_pow_left₀ (Nat.cast_nonneg _) hYupper 2
      _ = 16 * (X : ℝ) ^ α := by rw [show (4 * t) ^ 2 = 16 * t ^ 2 by ring, ht2]
      _ ≤ 16 * (2 * Cscale * x) ^ α :=
        mul_le_mul_of_nonneg_left (Real.rpow_le_rpow hX0 hXupper hαpos.le)
          (by norm_num)
      _ = 16 * (2 * Cscale) ^ α * x ^ α := by
        rw [Real.mul_rpow (by positivity) hxpos.le]
        ring
      _ ≤ 16 * (2 * Cscale) * x ^ α :=
        mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left hCpow (by norm_num))
          (Real.rpow_nonneg hxpos.le _)
      _ = _ := by ring
  have hYsq1 : (1 : ℝ) ≤ (Y ^ 2 : ℕ) := by
    exact_mod_cast (one_le_pow₀ (show 1 ≤ Y by omega) : 1 ≤ Y ^ 2)
  have hYsqpos : (0 : ℝ) < (Y ^ 2 : ℕ) := zero_lt_one.trans_le hYsq1
  have hxθ1 : 1 ≤ x ^ θ := Real.one_le_rpow hx1 hθ0.le
  have hQ : 1 ≤ Q := (Nat.one_le_floor_iff _).mpr hxθ1
  have hQ1r : (1 : ℝ) ≤ Q := by exact_mod_cast hQ
  have hQpos : (0 : ℝ) < Q := zero_lt_one.trans_le hQ1r
  have hQupper : (Q : ℝ) ≤ x ^ θ := Nat.floor_le (Real.rpow_nonneg hxpos.le _)
  have hQadd : ((Q + 1 : ℕ) : ℝ) ≤ 2 * x ^ θ := by
    simp only [Nat.cast_add, Nat.cast_one]
    linarith only [hQupper, hxθ1]
  have hYQ : ((Y ^ 2 : ℕ) : ℝ) * (Q + 1 : ℕ) ≤
      64 * Cscale * x ^ γ := by
    calc
      _ ≤ (32 * Cscale * x ^ α) * (2 * x ^ θ) :=
        mul_le_mul hY2 hQadd (Nat.cast_nonneg _) (by positivity)
      _ = _ := by dsimp only [γ]; rw [Real.rpow_add hxpos]; ring
  have hxα : x ^ α ≤ x := Real.rpow_le_self_of_one_le hx1 hα1
  have hxθ : x ^ θ ≤ x := Real.rpow_le_self_of_one_le hx1 hθ1.le
  have hYsmall : ((Y ^ 2 : ℕ) : ℝ) ≤ cY * x :=
    hY2.trans (mul_le_mul_of_nonneg_left hxα hcYpos.le)
  have hlogY0 : 0 ≤ 1 + Real.log (Y ^ 2 : ℕ) :=
    add_nonneg zero_le_one (Real.log_nonneg hYsq1)
  have hlogQ0 : 0 ≤ 1 + Real.log (Q : ℝ) :=
    add_nonneg zero_le_one (Real.log_nonneg hQ1r)
  have hlogY : 1 + Real.log (Y ^ 2 : ℕ) ≤ dY * Real.log x := by
    have h := Real.log_le_log hYsqpos hYsmall
    rw [Real.log_mul hcYpos.ne' hxpos.ne'] at h
    dsimp only [dY]
    nlinarith only [h, hlog1, hlogcY,
      mul_nonneg hlogcY (sub_nonneg.mpr hlog1)]
  have hlogQ : 1 + Real.log (Q : ℝ) ≤ 2 * Real.log x := by
    have h := Real.log_le_log hQpos (hQupper.trans hxθ)
    linarith only [h, hlog1]
  have hlogs :
      (1 + Real.log (Y ^ 2 : ℕ)) ^ P * (1 + Real.log (Q : ℝ)) ^ R ≤
        (dY * Real.log x) ^ P * (2 * Real.log x) ^ R :=
    mul_le_mul (pow_le_pow_left₀ hlogY0 hlogY P)
      (pow_le_pow_left₀ hlogQ0 hlogQ R) (pow_nonneg hlogQ0 R)
      (pow_nonneg (mul_nonneg hdYpos.le hlogpos.le) P)
  have hsize : H + (r : ℝ) * (Y ^ 2 : ℕ) * (Q + 1 : ℕ) ≤ H + b * x ^ γ := by
    calc
      _ = H + (r : ℝ) * (((Y ^ 2 : ℕ) : ℝ) * (Q + 1 : ℕ)) := by ring
      _ ≤ H + (r : ℝ) * (64 * Cscale * x ^ γ) :=
        add_le_add_right (mul_le_mul_of_nonneg_left hYQ (Nat.cast_nonneg _)) H
      _ = _ := by dsimp only [b]; ring
  have hsizepos : 0 ≤ H + b * x ^ γ :=
    add_nonneg hH (mul_nonneg hb (Real.rpow_nonneg hxpos.le _))
  have hproduct :
      (H + (r : ℝ) * (Y ^ 2 : ℕ) * (Q + 1 : ℕ)) *
        ((1 + Real.log (Y ^ 2 : ℕ)) ^ P * (1 + Real.log (Q : ℝ)) ^ R) ≤
      (H + b * x ^ γ) * ((dY * Real.log x) ^ P * (2 * Real.log x) ^ R) :=
    mul_le_mul hsize hlogs
      (mul_nonneg (pow_nonneg hlogY0 P) (pow_nonneg hlogQ0 R)) hsizepos
  have hraw := weighted_shortInterval_fullDiscrepancy_bound Y κ k X Q J r
    hY hXscale hQ (L * (Real.log x) ^ E) (mul_nonneg hL (pow_nonneg hlogpos.le E))
    S hS a ha lo hi hinterval u hsupport (fun n hn => by
      simpa only [mul_assoc, mul_left_comm, mul_comm] using henvelope n hn)
  have hscaled : (∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
      ‖fullDiscrepancy u q (a q)‖) ≤
        F * L * (H + b * x ^ γ) * (Real.log x) ^ T := by
    calc
      _ ≤ (2 : ℝ) ^ (κ * k + 1) * (L * (Real.log x) ^ E) *
          (H + (r : ℝ) * (Y ^ 2 : ℕ) * (Q + 1 : ℕ)) *
          (1 + Real.log (Y ^ 2 : ℕ)) ^ P * (1 + Real.log (Q : ℝ)) ^ R := hraw
      _ = (2 : ℝ) ^ (κ * k + 1) * (L * (Real.log x) ^ E) *
          ((H + (r : ℝ) * (Y ^ 2 : ℕ) * (Q + 1 : ℕ)) *
            ((1 + Real.log (Y ^ 2 : ℕ)) ^ P * (1 + Real.log (Q : ℝ)) ^ R)) := by ring
      _ ≤ (2 : ℝ) ^ (κ * k + 1) * (L * (Real.log x) ^ E) *
          ((H + b * x ^ γ) * ((dY * Real.log x) ^ P * (2 * Real.log x) ^ R)) :=
        mul_le_mul_of_nonneg_left hproduct
          (mul_nonneg (pow_nonneg (by norm_num) _) (mul_nonneg hL (pow_nonneg hlogpos.le E)))
      _ = _ := by
        dsimp only [F]
        rw [show (Real.log x) ^ T =
          (Real.log x) ^ E * (Real.log x) ^ P * (Real.log x) ^ R by
            dsimp only [T]
            rw [pow_add, pow_add]]
        rw [mul_pow, mul_pow]
        ring
  have hratio : (Real.log x) ^ T / (Real.log x) ^ D ≤ 1 / (Real.log x) ^ A := by
    apply (div_le_div_iff₀ (pow_pos hlogpos D) hLA).mpr
    have hpow := Real.rpow_le_rpow_of_exponent_le hlog1 hD
    simpa only [Real.rpow_add hlogpos, Real.rpow_natCast, one_mul] using hpow
  have hwidthterm : H * (Real.log x) ^ T ≤ Cwidth * x / (Real.log x) ^ A := by
    calc
      _ ≤ (Cwidth * x / (Real.log x) ^ D) * (Real.log x) ^ T :=
        mul_le_mul_of_nonneg_right hwidth (pow_nonneg hlogpos.le T)
      _ = (Cwidth * x) * ((Real.log x) ^ T / (Real.log x) ^ D) := by ring
      _ ≤ (Cwidth * x) * (1 / (Real.log x) ^ A) :=
        mul_le_mul_of_nonneg_left hratio (mul_nonneg hCwidth hxpos.le)
      _ = _ := by ring
  have hpower : x ^ γ * (Real.log x) ^ T ≤ x / (Real.log x) ^ A := by
    apply (le_div_iff₀ hLA).mpr
    calc
      _ = x ^ γ * (Real.log x) ^ ((T : ℝ) + A) := by
        rw [Real.rpow_add hlogpos, Real.rpow_natCast]
        ring
      _ ≤ x ^ γ * x ^ (1 - γ) :=
        mul_le_mul_of_nonneg_left hlogsmall (Real.rpow_nonneg hxpos.le _)
      _ = x := by
        rw [← Real.rpow_add hxpos, show γ + (1 - γ) = 1 by ring, Real.rpow_one]
  have hcombined : (H + b * x ^ γ) * (Real.log x) ^ T ≤
      (Cwidth + b) * x / (Real.log x) ^ A := by
    calc
      _ = H * (Real.log x) ^ T + b * (x ^ γ * (Real.log x) ^ T) := by ring
      _ ≤ Cwidth * x / (Real.log x) ^ A + b * (x / (Real.log x) ^ A) :=
        add_le_add hwidthterm (mul_le_mul_of_nonneg_left hpower hb)
      _ = _ := by ring
  calc
    _ ≤ F * L * (H + b * x ^ γ) * (Real.log x) ^ T := hscaled
    _ = F * L * ((H + b * x ^ γ) * (Real.log x) ^ T) := by ring
    _ ≤ F * L * ((Cwidth + b) * x / (Real.log x) ^ A) :=
      mul_le_mul_of_nonneg_left hcombined (mul_nonneg hF.le hL)
    _ = F * (Cwidth + b) * L * x / (Real.log x) ^ A := by ring
    _ ≤ F * (Cwidth + b + 1) * L * x / (Real.log x) ^ A :=
      div_le_div_of_nonneg_right
        (mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_right
            (mul_le_mul_of_nonneg_left (le_add_of_nonneg_right zero_le_one) hF.le)
            hL) hxpos.le) hLA.le

theorem exceptional_smallPrimePart_fullDiscrepancy_log_saving
    (θ : ℝ) (hθ0 : 0 < θ) (hθ1 : θ < 1)
    (k J : ℕ) (E Cscale : ℝ) (hCscale : 1 ≤ Cscale)
    (A : ℝ) (hA : 0 < A) :
    ∃ K X₀ : ℝ, 0 < K ∧ Real.exp 1 ≤ X₀ ∧
      ∀ x : ℝ, X₀ ≤ x →
      ∀ L : ℝ, 0 ≤ L →
      ∀ S : Finset ℕ, S ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
      ∀ u : ℕ →₀ ℂ,
        (∀ n ∈ u.support, 0 < n ∧ (n : ℝ) ≤ Cscale * x) →
        (∀ n ∈ u.support,
          ‖u n‖ ≤ L * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ E) →
        (∑ q ∈ S.filter (fun q : ℕ =>
            Real.exp ((Real.log x) ^ (2 / 3 : ℝ)) <
              (smallPrimePart
                ⌊Real.exp ((Real.log x) ^ (1 / 3 : ℝ))⌋₊ q : ℝ)),
          (q.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy u q (a q)‖) ≤
              K * L * x / (Real.log x) ^ A := by
  classical
  obtain ⟨P, Kraw, hKraw, hprogression⟩ :=
    long_progression_card_divisors_pow_bound θ hθ0 hθ1 k Cscale hCscale
  let R : ℕ := 2 ^ (J + 2)
  let T : ℝ := E + (P : ℝ) + (R : ℝ)
  let K : ℝ := (2 : ℝ) ^ (R + 1) * Kraw
  have hK : 0 < K := by dsimp only [K]; positivity
  have hdecay : ∀ᶠ x : ℝ in Filter.atTop, Real.exp 1 ≤ x ∧
      (Real.log x) ^ (T + A) *
        Real.exp (-(Real.log 2 * (Real.log x) ^ (1 / 3 : ℝ))) ≤ 1 := by
    have hroot : Filter.Tendsto (fun x : ℝ => (Real.log x) ^ (1 / 3 : ℝ))
        Filter.atTop Filter.atTop :=
      (tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 3)).comp
        Real.tendsto_log_atTop
    have hlim :=
      (tendsto_rpow_mul_exp_neg_mul_atTop_nhds_zero (3 * (T + A))
        (Real.log 2) (Real.log_pos (by norm_num : (1 : ℝ) < 2))).comp hroot
    filter_upwards [Filter.eventually_ge_atTop (Real.exp 1),
      hlim.eventually (eventually_le_nhds (by norm_num : (0 : ℝ) < 1))]
      with x hx hsmall
    have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
    have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxpos).mpr hx
    have hrootpow : ((Real.log x) ^ (1 / 3 : ℝ)) ^ (3 * (T + A)) =
        (Real.log x) ^ (T + A) := by
      rw [← Real.rpow_mul (zero_le_one.trans hlog1)]
      congr 1
      ring
    refine ⟨hx, ?_⟩
    simpa only [Function.comp_apply, hrootpow, neg_mul] using hsmall
  obtain ⟨X₀, hX₀⟩ := Filter.eventually_atTop.mp hdecay
  refine ⟨K, X₀, hK, (hX₀ X₀ le_rfl).1, ?_⟩
  intro x hx L hL S hS a ha u hsupport henvelope
  obtain ⟨hxexp, hsmall⟩ := hX₀ x hx
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hx1 : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hxexp
  have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxpos).mpr hxexp
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlog1
  have hLA : 0 < (Real.log x) ^ A :=
    zero_lt_one.trans_le (Real.one_le_rpow hlog1 hA.le)
  let Q : ℕ := ⌊x ^ θ⌋₊
  let B : ℝ := L * (Real.log x) ^ E
  let F : ℝ := B * Kraw * x * (Real.log x) ^ P
  let V : Finset ℕ := S.filter (fun q : ℕ =>
    Real.exp ((Real.log x) ^ (2 / 3 : ℝ)) <
      (smallPrimePart
        ⌊Real.exp ((Real.log x) ^ (1 / 3 : ℝ))⌋₊ q : ℝ))
  have hB : 0 ≤ B := mul_nonneg hL (Real.rpow_nonneg hlogpos.le E)
  have hF : 0 ≤ F := by dsimp only [F]; positivity
  have hqone : (1 : ℝ) ≤ x ^ θ := Real.one_le_rpow hx1 hθ0.le
  have hQ1 : 1 ≤ Q := (Nat.one_le_floor_iff _).mpr hqone
  have hQpos : (0 : ℝ) < Q := Nat.cast_pos.mpr (zero_lt_one.trans_le hQ1)
  have hQbound : (Q : ℝ) ≤ x ^ θ := Nat.floor_le (Real.rpow_nonneg hxpos.le θ)
  have hQx : (Q : ℝ) ≤ x := hQbound.trans (by
    simpa only [Real.rpow_one] using
      Real.rpow_le_rpow_of_exponent_le hx1 hθ1.le)
  have hlogQ0 : 0 ≤ 1 + Real.log (Q : ℝ) :=
    add_nonneg zero_le_one (Real.log_nonneg (by exact_mod_cast hQ1))
  have hlogQ : 1 + Real.log (Q : ℝ) ≤ 2 * Real.log x := by
    have h := Real.log_le_log hQpos hQx
    linarith only [h, hlog1]
  have hsupportIcc : u.support ⊆ Finset.Icc 1 ⌈Cscale * x⌉₊ := by
    intro n hn
    obtain ⟨hnpos, hnupper⟩ := hsupport n hn
    refine Finset.mem_Icc.mpr ⟨hnpos, ?_⟩
    exact_mod_cast hnupper.trans (Nat.le_ceil (Cscale * x))
  have hprogress (q v : ℕ) (hq : 0 < q) (hqx : (q : ℝ) ≤ x ^ θ)
      (hv : Nat.Coprime v q) :
      (∑ n ∈ u.support, if n % q = v % q then (n.divisors.card : ℝ) ^ k else 0) ≤
        Kraw * x / q * (Real.log x) ^ P := by
    calc
      _ = ∑ n ∈ u.support.filter (fun n => n % q = v % q),
          (n.divisors.card : ℝ) ^ k := by rw [Finset.sum_filter]
      _ ≤ ∑ n ∈ (Finset.Icc 1 ⌈Cscale * x⌉₊).filter
          (fun n => n % q = v % q), (n.divisors.card : ℝ) ^ k := by
        apply Finset.sum_le_sum_of_subset_of_nonneg
        · intro n hn
          exact Finset.mem_filter.mpr
            ⟨hsupportIcc (Finset.mem_filter.mp hn).1, (Finset.mem_filter.mp hn).2⟩
        · intro n _ _
          positivity
      _ ≤ _ := hprogression x hxexp q v hq hqx hv
  have hall : (∑ n ∈ u.support, (n.divisors.card : ℝ) ^ k) ≤
      Kraw * x * (Real.log x) ^ P := by
    simpa only [Nat.mod_one, ite_true, Nat.cast_one, div_one] using
      hprogress 1 0 (by decide) (by simpa only [Nat.cast_one] using hqone) (by decide)
  have hnormmask (p : ℕ → Prop) [DecidablePred p] :
      ‖∑ n ∈ u.support, if p n then u n else 0‖ ≤
        B * ∑ n ∈ u.support, if p n then (n.divisors.card : ℝ) ^ k else 0 := by
    rw [Finset.mul_sum]
    apply norm_sum_le_of_le
    intro n hn
    by_cases hp : p n
    · simpa only [ite_eq_left hp, B, mul_assoc, mul_left_comm, mul_comm] using
        henvelope n hn
    · simp only [ite_eq_right hp, norm_zero, mul_zero, le_refl]
  have hpoint (q : ℕ) (hqS : q ∈ S) :
      ‖fullDiscrepancy u q (a q)‖ ≤
        2 * F * (q.divisors.card : ℝ) / q := by
    have hq : 0 < q := (Finset.mem_Icc.mp (hS hqS)).1
    have hqr : (0 : ℝ) < q := Nat.cast_pos.mpr hq
    have hqx : (q : ℝ) ≤ x ^ θ :=
      (Nat.cast_le.mpr (Finset.mem_Icc.mp (hS hqS)).2).trans hQbound
    have hφ : (0 : ℝ) < q.totient := Nat.cast_pos.mpr (Nat.totient_pos.mpr hq)
    have hφq : (q.totient : ℝ) ≤ q := Nat.cast_le.mpr (Nat.totient_le q)
    have hfirst : ‖progressionMass u q (a q)‖ ≤ F / q := by
      calc
        _ ≤ B * ∑ n ∈ u.support,
            if n % q = a q % q then (n.divisors.card : ℝ) ^ k else 0 :=
          hnormmask (fun n => n % q = a q % q)
        _ ≤ B * (Kraw * x / q * (Real.log x) ^ P) :=
          mul_le_mul_of_nonneg_left (hprogress q (a q) hq hqx (ha q hqS)) hB
        _ = F / q := by dsimp only [F]; ring
    have hsecond : ‖reducedMass u q‖ ≤ F := by
      calc
        _ ≤ B * ∑ n ∈ u.support,
            if Nat.Coprime n q then (n.divisors.card : ℝ) ^ k else 0 :=
          hnormmask (fun n => Nat.Coprime n q)
        _ ≤ B * ∑ n ∈ u.support, (n.divisors.card : ℝ) ^ k := by
          apply mul_le_mul_of_nonneg_left _ hB
          apply Finset.sum_le_sum
          intro n _
          split_ifs <;> first | exact le_rfl | positivity
        _ ≤ B * (Kraw * x * (Real.log x) ^ P) :=
          mul_le_mul_of_nonneg_left hall hB
        _ = F := by dsimp only [F]; ring
    rw [fullDiscrepancy]
    calc
      _ ≤ F / q + F / q.totient := norm_sub_le_of_le hfirst (by
        rw [norm_div, Complex.norm_natCast]
        exact div_le_div_of_nonneg_right hsecond hφ.le)
      _ ≤ F / q.totient + F / q.totient :=
        add_le_add (div_le_div_of_nonneg_left hF hφ hφq) le_rfl
      _ = (2 * F / q) * ((q : ℝ) / q.totient) := by
        rw [div_mul_div_cancel₀ hqr.ne']
        ring
      _ ≤ (2 * F / q) * (q.divisors.card : ℝ) :=
        mul_le_mul_of_nonneg_left (div_totient_le_card_divisors q) (by positivity)
      _ = _ := by ring
  have hVsubset : V ⊆ (Finset.Icc 1 Q).filter (fun q : ℕ =>
      Real.exp ((Real.log x) ^ (2 / 3 : ℝ)) <
        (smallPrimePart
          ⌊Real.exp ((Real.log x) ^ (1 / 3 : ℝ))⌋₊ q : ℝ)) := by
    intro q hq
    exact Finset.mem_filter.mpr
      ⟨hS (Finset.mem_filter.mp hq).1, (Finset.mem_filter.mp hq).2⟩
  have htail : (∑ q ∈ V, (q.divisors.card : ℝ) ^ (J + 1) / q) ≤
      Real.exp (-(Real.log 2 * (Real.log x) ^ (1 / 3 : ℝ))) *
        (1 + Real.log (Q : ℝ)) ^ R := by
    refine (Finset.sum_le_sum_of_subset_of_nonneg hVsubset
      (fun q _ _ => by positivity)).trans ?_
    simpa only [R, Nat.add_assoc] using
      exceptional_smallPrimePart_reciprocal_moment_bound x hxexp (J + 1) Q
  have hlogpower : (Real.log x) ^ T =
      (Real.log x) ^ E * (Real.log x) ^ P * (Real.log x) ^ R := by
    dsimp only [T]
    rw [Real.rpow_add hlogpos, Real.rpow_add hlogpos,
      Real.rpow_natCast, Real.rpow_natCast]
  have hscaled : (∑ q ∈ V, (q.divisors.card : ℝ) ^ J *
      ‖fullDiscrepancy u q (a q)‖) ≤
        K * L * x * (Real.log x) ^ T *
          Real.exp (-(Real.log 2 * (Real.log x) ^ (1 / 3 : ℝ))) := by
    calc
      _ ≤ ∑ q ∈ V, (q.divisors.card : ℝ) ^ J *
          (2 * F * (q.divisors.card : ℝ) / q) := by
        apply Finset.sum_le_sum
        intro q hq
        exact mul_le_mul_of_nonneg_left
          (hpoint q (Finset.mem_filter.mp hq).1) (by positivity)
      _ = 2 * F * ∑ q ∈ V, (q.divisors.card : ℝ) ^ (J + 1) / q := by
        rw [Finset.mul_sum]
        apply Finset.sum_congr rfl
        intro q _
        rw [pow_succ]
        ring
      _ ≤ 2 * F *
          (Real.exp (-(Real.log 2 * (Real.log x) ^ (1 / 3 : ℝ))) *
            (1 + Real.log (Q : ℝ)) ^ R) :=
        mul_le_mul_of_nonneg_left htail (by positivity)
      _ ≤ 2 * F *
          (Real.exp (-(Real.log 2 * (Real.log x) ^ (1 / 3 : ℝ))) *
            (2 * Real.log x) ^ R) := by
        apply mul_le_mul_of_nonneg_left _ (by positivity)
        exact mul_le_mul_of_nonneg_left
          (pow_le_pow_left₀ hlogQ0 hlogQ R) (Real.exp_pos _).le
      _ = _ := by
        rw [hlogpower, mul_pow]
        dsimp only [F, B, K]
        rw [pow_succ (2 : ℝ) R]
        ring
  have habsorb : (Real.log x) ^ T *
      Real.exp (-(Real.log 2 * (Real.log x) ^ (1 / 3 : ℝ))) ≤
        1 / (Real.log x) ^ A := by
    apply (le_div_iff₀ hLA).mpr
    calc
      _ = (Real.log x) ^ (T + A) *
          Real.exp (-(Real.log 2 * (Real.log x) ^ (1 / 3 : ℝ))) := by
        rw [Real.rpow_add hlogpos T A]
        ring
      _ ≤ 1 := hsmall
  calc
    _ ≤ K * L * x * (Real.log x) ^ T *
        Real.exp (-(Real.log 2 * (Real.log x) ^ (1 / 3 : ℝ))) := hscaled
    _ = K * L * x * ((Real.log x) ^ T *
        Real.exp (-(Real.log 2 * (Real.log x) ^ (1 / 3 : ℝ)))) := by ring
    _ ≤ K * L * x * (1 / (Real.log x) ^ A) :=
      mul_le_mul_of_nonneg_left habsorb (by positivity)
    _ = K * L * x / (Real.log x) ^ A := by ring

end

section
open scoped ContDiff FourierTransform SchwartzMap RealInnerProductSpace
open Classical in
theorem typeIII_sampled_transform_derivative_decay
    (j k : ℕ) (T : ℝ) (hT : 0 ≤ T) :
    ∃ Cdec : ℝ, 0 < Cdec ∧
      ∀ (L N : ℝ), 0 ≤ L → 1 ≤ N →
      ∀ ψ : ℝ → ℂ, ContDiff ℝ ∞ ψ →
        Function.support ψ ⊆ Set.Icc (-T) T →
        (∀ r : ℕ, r ≤ k + 2 → ∀ t : ℝ, ‖iteratedDeriv r ψ t‖ ≤ L) →
        let I : Finset ℤ := Finset.Icc (Int.ceil (-T * N)) (Int.floor (T * N))
        let Ψ : ℝ → ℂ := fun y =>
          ∑ n ∈ I, ψ ((n : ℝ) / N) *
            Complex.exp (((-2 * Real.pi * (n : ℝ) * y : ℝ) : ℂ) * Complex.I)
        ∀ y : ℝ, |y| ≤ 1 / 2 →
          ‖iteratedDeriv j Ψ y‖ ≤
            Cdec * L * N ^ (j + 1) / (1 + N * |y|) ^ k := by
  let a : ℂ := ((-2 * Real.pi : ℝ) : ℂ) * Complex.I
  let p : ℝ → ℂ := fun t => a ^ j * (t : ℂ) ^ j
  have hp : ContDiff ℝ ∞ p :=
    contDiff_const.mul (Complex.ofRealCLM.contDiff.pow j)
  let jet : ℝ → Fin (k + 3) → ℂ := fun t r => iteratedDeriv r.val p t
  have hjet : Continuous jet :=
    continuous_pi fun r => hp.continuous_iteratedDeriv r.val (by simp)
  obtain ⟨D₀, hD₀⟩ := IsCompact.exists_bound_of_continuousOn
    (show IsCompact (Set.Icc (-T) T) from isCompact_Icc) hjet.continuousOn
  let D : ℝ := (|D₀| + 1) * (2 : ℝ) ^ (k + 2)
  have hD : 0 < D := by dsimp only [D]; positivity
  have hpbound (r : ℕ) (hr : r ≤ k + 2) (t : ℝ) (ht : t ∈ Set.Icc (-T) T) :
      ‖iteratedDeriv r p t‖ ≤ |D₀| + 1 := by
    calc
      _ ≤ ‖jet t‖ := norm_le_pi_norm (jet t) ⟨r, by omega⟩
      _ ≤ D₀ := hD₀ t ht
      _ ≤ |D₀| + 1 := by linarith [le_abs_self D₀]
  have hsmallD : |D₀| + 1 ≤ D :=
    le_mul_of_one_le_right (by positivity) (one_le_pow₀ (by norm_num))
  refine ⟨1 + 5 * (2 : ℝ) ^ (k + 3) * T * D, by positivity, ?_⟩
  intro L N hL hN ψ hψ hsupport hbound I Ψ y hy
  have hNpos : 0 < N := zero_lt_one.trans_le hN
  let φ : ℝ → ℂ := fun t => p t * ψ t
  have hφ : ContDiff ℝ ∞ φ := hp.mul hψ
  have hsφ : Function.support φ ⊆ Set.Icc (-T) T :=
    (Function.support_mul_subset_right p ψ).trans hsupport
  have htsφ : tsupport φ ⊆ Set.Icc (-T) T := closure_minimal hsφ isClosed_Icc
  have hsDφ : Function.support (iteratedDeriv (k + 2) φ) ⊆ Set.Icc (-T) T := by
    rw [iteratedDeriv_eq_equiv_comp]
    exact (Function.support_comp_subset (map_zero _) _).trans
      ((support_iteratedFDeriv_subset (𝕜 := ℝ) (f := φ) (k + 2)).trans htsφ)
  have hφbound (t : ℝ) : ‖φ t‖ ≤ D * L ∧ ‖iteratedDeriv (k + 2) φ t‖ ≤ D * L := by
    by_cases ht : t ∈ Set.Icc (-T) T
    · constructor
      · have hp₀ : ‖p t‖ ≤ D := by
          simpa only [iteratedDeriv_zero] using (hpbound 0 (by omega) t ht).trans hsmallD
        have hψ₀ : ‖ψ t‖ ≤ L := by simpa only [iteratedDeriv_zero] using hbound 0 (by omega) t
        exact (norm_mul_le _ _).trans (mul_le_mul hp₀ hψ₀ (norm_nonneg _) hD.le)
      · have hsum : (∑ r ∈ Finset.range (k + 3), ((k + 2).choose r : ℝ)) =
            (2 : ℝ) ^ (k + 2) := by
          exact_mod_cast Nat.sum_range_choose (k + 2)
        rw [show φ = (fun t => p t * ψ t) from rfl,
          iteratedDeriv_fun_mul (hp.of_le (by simp)).contDiffAt
            (hψ.of_le (by simp)).contDiffAt]
        calc
          _ ≤ ∑ r ∈ Finset.range (k + 3), ((k + 2).choose r : ℝ) * (|D₀| + 1) * L := by
            refine norm_sum_le_of_le _ ?_
            intro r hr
            have hr' : r ≤ k + 2 := by have := Finset.mem_range.mp hr; omega
            simp only [norm_mul, Complex.norm_natCast]
            exact mul_le_mul
              (mul_le_mul_of_nonneg_left (hpbound r hr' t ht) (Nat.cast_nonneg _))
              (hbound (k + 2 - r) (Nat.sub_le _ _) t) (norm_nonneg _) (by positivity)
          _ = D * L := by
            rw [← Finset.sum_mul, ← Finset.sum_mul, hsum]
            dsimp only [D]
            ring
    · rw [Function.support_subset_iff'.mp hsφ t ht, norm_zero,
        Function.support_subset_iff'.mp hsDφ t ht, norm_zero]
      exact ⟨mul_nonneg hD.le hL, mul_nonneg hD.le hL⟩
  let w : ℝ → ℂ := fun t => φ (t / N)
  have hws : Function.support w ⊆ Set.Icc (-T * N) (T * N) := by
    intro t ht
    have hh := hsφ ht
    exact ⟨(le_div_iff₀ hNpos).mp hh.1, (div_le_iff₀ hNpos).mp hh.2⟩
  have hwc : HasCompactSupport w :=
    HasCompactSupport.of_support_subset_isCompact isCompact_Icc hws
  have hw : ContDiff ℝ ∞ w := hφ.comp (contDiff_id.div_const N)
  have hsample (n : ℤ) (hn : n ∉ I) : w (n : ℝ) = 0 := by
    by_contra he
    have hh := hws he
    exact hn (Finset.mem_Icc.mpr ⟨Int.ceil_le.mpr hh.1, Int.le_floor.mpr hh.2⟩)
  have halias (θ : ℝ) :
      HasSum (fun r : ℤ => 𝓕 w ((r : ℝ) + θ))
        (∑ n ∈ I, φ ((n : ℝ) / N) *
          Complex.exp (((-2 * Real.pi * (n : ℝ) * θ : ℝ) : ℂ) * Complex.I)) := by
    let g : ℝ → ℂ := fun t =>
      w t * Complex.exp (((-2 * Real.pi * t * θ : ℝ) : ℂ) * Complex.I)
    have hgc : HasCompactSupport g := hwc.mul_right
    have hg : ContDiff ℝ ∞ g := by
      apply hw.mul
      apply ContDiff.cexp
      exact (Complex.ofRealCLM.contDiff.comp
        (show ContDiff ℝ ∞ (fun t : ℝ => -2 * Real.pi * t * θ) by fun_prop)).mul contDiff_const
    let gs : 𝓢(ℝ, ℂ) := hgc.toSchwartzMap hg
    have hfourier (v : ℝ) : 𝓕 g v = 𝓕 w (v + θ) := by
      rw [Real.fourier_real_eq_integral_exp_smul, Real.fourier_real_eq_integral_exp_smul]
      congr 1 with t
      simp only [g, smul_eq_mul]
      calc
        _ = Complex.exp (((-2 * Real.pi * t * v : ℝ) : ℂ) * Complex.I +
            ((-2 * Real.pi * t * θ : ℝ) : ℂ) * Complex.I) * w t := by
          rw [Complex.exp_add]
          ring
        _ = _ := by congr 2; push_cast; ring
    have hgsum : Summable (fun r : ℤ => (𝓕 gs) (r : ℝ)) := by
      apply summable_of_isBigO (Real.summable_abs_int_rpow one_lt_two)
      simpa only [Function.comp_def, Real.norm_eq_abs] using
        ((𝓕 gs).isBigO_cocompact_rpow (-2)).comp_tendsto Int.tendsto_coe_cofinite
    have hnorm : Summable (fun r : ℤ => ‖𝓕 w ((r : ℝ) + θ)‖) := by
      have hh := hgsum.norm
      change Summable (fun r : ℤ => ‖𝓕 g (r : ℝ)‖) at hh
      simpa only [hfourier] using hh
    have hfinite : HasSum (fun n : ℤ => g (n : ℝ)) (∑ n ∈ I, g (n : ℝ)) := by
      apply hasSum_sum_of_ne_finset_zero
      intro n hn
      simp only [g, hsample n hn, zero_mul]
    have hp := SchwartzMap.tsum_eq_tsum_fourier gs 0
    change (∑' n : ℤ, g (0 + (n : ℝ))) =
      ∑' r : ℤ, 𝓕 g (r : ℝ) * fourier r ((0 : ℝ) : UnitAddCircle) at hp
    simp only [zero_add, AddCircle.coe_zero, fourier_eval_zero, mul_one, hfourier] at hp
    apply hnorm.of_norm.hasSum_iff.mpr
    simpa only [g, w] using hp.symm.trans hfinite.tsum_eq
  let u : ℝ := 1 + N * |y|
  let Cw : ℝ := (2 : ℝ) ^ (k + 3) * T * D * L * N
  have hu : 0 < u := by dsimp only [u]; positivity
  have hCw : 0 ≤ Cw := by dsimp only [Cw]; positivity
  have hdec (v : ℝ) : ‖𝓕 w v‖ ≤ Cw / (1 + N * |v|) ^ (k + 2) := by
    simpa only [w, Cw, sub_zero, mul_assoc] using
      compactProfile_fourier_decay_bound_order (k + 2) T (D * L) N 0 hT
        (mul_nonneg hD.le hL) hNpos φ (hφ.of_le (by simp)) hsφ hφbound v
  have hgeom (r : ℤ) : |y| ≤ |(r : ℝ) + y| ∧ |(r : ℝ)| / 2 ≤ |(r : ℝ) + y| := by
    by_cases hr : r = 0
    · subst r
      simp
    · have hr₁ : (1 : ℝ) ≤ |(r : ℝ)| := by exact_mod_cast Int.one_le_abs hr
      have hh : |(r : ℝ)| ≤ |(r : ℝ) + y| + |y| := by
        simpa only [add_neg_cancel_right, abs_neg] using abs_add_le ((r : ℝ) + y) (-y)
      constructor <;> linarith
  have hmajor (r : ℤ) : ‖𝓕 w ((r : ℝ) + y)‖ ≤
      (Cw / u ^ k) * (1 + (N / 2) * |(r : ℝ)|)⁻¹ ^ 2 := by
    let v : ℝ := 1 + (N / 2) * |(r : ℝ)|
    let z : ℝ := 1 + N * |(r : ℝ) + y|
    have hv : 0 < v := by dsimp only [v]; positivity
    have hz : 0 < z := by dsimp only [z]; positivity
    have huz : u ≤ z := by
      dsimp only [u, z]
      exact add_le_add le_rfl (mul_le_mul_of_nonneg_left (hgeom r).1 hNpos.le)
    have hvz : v ≤ z := by
      dsimp only [v, z]
      nlinarith [(mul_le_mul_of_nonneg_left (hgeom r).2 hNpos.le)]
    have hprod : u ^ k * v ^ 2 ≤ z ^ (k + 2) := by
      calc
        _ ≤ z ^ k * z ^ 2 := mul_le_mul (pow_le_pow_left₀ hu.le huz k)
          (pow_le_pow_left₀ hv.le hvz 2) (pow_nonneg hv.le 2) (pow_nonneg hz.le k)
        _ = _ := (pow_add z k 2).symm
    calc
      _ ≤ Cw / z ^ (k + 2) := hdec _
      _ ≤ Cw / (u ^ k * v ^ 2) :=
        div_le_div_of_nonneg_left hCw (by positivity) hprod
      _ = (Cw / u ^ k) * v⁻¹ ^ 2 := by
        simp only [div_eq_mul_inv, mul_inv_rev, inv_pow]
        ring
  obtain ⟨hlattice, hlatticeMass, _⟩ :=
    reciprocalSquare_integer_lattice_bounds (N / 2) (by positivity)
  have hlatticeFive : (∑' r : ℤ, (1 + (N / 2) * |(r : ℝ)|)⁻¹ ^ 2) ≤ 5 := by
    apply hlatticeMass.trans
    have hh : 2 / (N / 2) ≤ 4 := (div_le_iff₀ (by positivity)).2 (by nlinarith)
    linarith
  let S : ℂ := ∑ n ∈ I, φ ((n : ℝ) / N) *
    Complex.exp (((-2 * Real.pi * (n : ℝ) * y : ℝ) : ℂ) * Complex.I)
  have hS : ‖S‖ ≤ (Cw / u ^ k) * 5 := by
    have hh := (halias y).norm_le_of_bounded
      (hlattice.hasSum.mul_left (Cw / u ^ k)) hmajor
    exact hh.trans
      (mul_le_mul_of_nonneg_left hlatticeFive (div_nonneg hCw (pow_nonneg hu.le k)))
  have hexp (c : ℂ) (r : ℕ) :
      iteratedDeriv r (fun t : ℝ => Complex.exp (c * (t : ℂ))) =
        fun t : ℝ => c ^ r * Complex.exp (c * (t : ℂ)) := by
    induction r with
    | zero => simp only [iteratedDeriv_zero, pow_zero, one_mul]
    | succ r ih =>
      rw [iteratedDeriv_succ, ih]
      funext t
      have hd := (((hasDerivAt_id (t : ℂ)).const_mul c).cexp.comp_ofReal).const_mul (c ^ r)
      simp only [id_eq, mul_one] at hd
      rw [pow_succ]
      exact hd.deriv.trans (by ring)
  have hphase (n : ℤ) (t : ℝ) :
      Complex.exp (((-2 * Real.pi * (n : ℝ) * t : ℝ) : ℂ) * Complex.I) =
        Complex.exp ((a * (n : ℂ)) * (t : ℂ)) := by
    congr 1
    dsimp only [a]
    push_cast
    ring
  have hΨ : iteratedDeriv j Ψ y = (N : ℂ) ^ j * S := by
    change iteratedDeriv j (fun t => ∑ n ∈ I, ψ ((n : ℝ) / N) *
      Complex.exp (((-2 * Real.pi * (n : ℝ) * t : ℝ) : ℂ) * Complex.I)) y = _
    rw [iteratedDeriv_fun_sum (fun n _ => by
      apply ContDiff.contDiffAt
      apply contDiff_const.mul
      apply ContDiff.cexp
      exact (Complex.ofRealCLM.contDiff.comp
        (show ContDiff ℝ (j : ℕ) (fun t : ℝ => -2 * Real.pi * (n : ℝ) * t) by
          fun_prop)).mul contDiff_const)]
    dsimp only [S]
    rw [Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro n hn
    simp only [hphase, iteratedDeriv_const_mul_field, hexp]
    dsimp only [φ, p]
    push_cast
    rw [div_pow, mul_pow]
    field_simp [hNpos.ne']
  rw [hΨ, norm_mul, norm_pow, Complex.norm_real, Real.norm_eq_abs, abs_of_pos hNpos]
  calc
    _ ≤ N ^ j * ((Cw / u ^ k) * 5) := mul_le_mul_of_nonneg_left hS (pow_nonneg hNpos.le j)
    _ = (5 * (2 : ℝ) ^ (k + 3) * T * D) * L * N ^ (j + 1) / u ^ k := by
      dsimp only [Cw]
      rw [pow_succ]
      ring
    _ ≤ (1 + 5 * (2 : ℝ) ^ (k + 3) * T * D) * L * N ^ (j + 1) / u ^ k := by
      apply div_le_div_of_nonneg_right _ (pow_nonneg hu.le k)
      exact mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_right (by linarith) hL) (pow_nonneg hNpos.le (j + 1))

open Classical in
theorem typeIII_sampled_transform_fineBand_taylor
    (B ε C T E : ℝ) (hB : 0 ≤ B) (hε : 0 < ε)
    (hC : 1 ≤ C) (hT : 0 ≤ T) :
    let J : ℕ := Nat.ceil (2 * (B + 1) / ε)
    ∃ Ccoef Cerr X : ℝ, 0 < Ccoef ∧ 0 < Cerr ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ L : ℝ, 0 ≤ L →
      ∀ N Qcenter : ℝ, 0 < Qcenter → 8 * x ^ (ε / 2) ≤ N →
      ∀ ψ : ℝ → ℂ, ContDiff ℝ ∞ ψ →
        Function.support ψ ⊆ Set.Icc (-T) T →
        (∀ r : ℕ, r ≤ J + 2 → ∀ t : ℝ,
          ‖iteratedDeriv r ψ t‖ ≤ L * (Real.log x) ^ E) →
        let A : ℤ := Int.ceil (-T * N)
        let K : ℕ := (Int.floor (T * N) + 1 - A).toNat
        let I : Finset ℤ := Finset.Icc A (Int.floor (T * N))
        let Ψ : ℝ → ℂ := fun y =>
          ∑ n ∈ I, ψ ((n : ℝ) / N) *
            Complex.exp (((-2 * Real.pi * (n : ℝ) * y : ℝ) : ℂ) * Complex.I)
        let H : ℝ := x ^ (ε / 2) * Qcenter / N
        let S : Finset ℤ := Finset.Icc (Int.ceil (-H)) (Int.floor H)
        let c : ℕ → ℤ → ℂ := fun j h =>
          ((((h : ℝ) / Qcenter) ^ j / (Nat.factorial j : ℝ) / N : ℝ) : ℂ) *
            iteratedDeriv j Ψ ((h : ℝ) / Qcenter)
        (∀ j : ℕ, j ≤ J → ∀ h ∈ S,
          ‖c j h‖ ≤ Ccoef * L * (Real.log x) ^ E) ∧
        ∀ q : ℕ+,
          Qcenter * (1 - C * x ^ (-ε)) ≤ (q : ℝ) →
          (q : ℝ) ≤ Qcenter * (1 + C * x ^ (-ε)) →
          let W : ZMod (q : ℕ) → ℂ := integerIntervalResidueWeight (q : ℕ) A K
            (fun n => ψ (((A : ℝ) + (n : ℝ)) / N))
          let η : ℕ → ℝ := fun j =>
            Qcenter / (q : ℝ) * ((Qcenter - (q : ℝ)) / (q : ℝ)) ^ j
          let P : ZMod (q : ℕ) → ℂ := fun ξ =>
            if |(ξ.valMinAbs : ℝ)| ≤ H then
              ((N / Qcenter : ℝ) : ℂ) *
                ∑ j ∈ Finset.range (J + 1), c j ξ.valMinAbs * (η j : ℂ)
            else 0
          (∀ ξ : ZMod (q : ℕ),
            ZMod.dft W ξ = Ψ ((ξ.valMinAbs : ℝ) / (q : ℝ))) ∧
          (∀ j : ℕ, |η j| ≤ 2) ∧
          (((Finset.univ : Finset (ZMod (q : ℕ))).filter
              (fun ξ => |(ξ.valMinAbs : ℝ)| ≤ H)).image ZMod.valMinAbs = S) ∧
          (∀ ξ : ZMod (q : ℕ),
            ‖(q : ℂ)⁻¹ * ZMod.dft W ξ - P ξ‖ ≤
              Cerr * L * (N / Qcenter) * x ^ (-B)) ∧
          (∑ ξ : ZMod (q : ℕ), ‖(q : ℂ)⁻¹ * ZMod.dft W ξ - P ξ‖ ≤
            2 * Cerr * L * N * x ^ (-B)) ∧
          (∑ ξ ∈ (Finset.univ : Finset (ZMod (q : ℕ))).filter
              (fun ξ => H < |(ξ.valMinAbs : ℝ)|), ‖(q : ℂ)⁻¹ * ZMod.dft W ξ‖ ≤
            2 * Cerr * L * N * x ^ (-B)) ∧
          (∀ z : ZMod (q : ℕ),
            ‖W z - ((N / Qcenter : ℝ) : ℂ) *
                ∑ j ∈ Finset.range (J + 1), (η j : ℂ) *
                  ∑ h ∈ S, c j h * ZMod.stdAddChar ((h : ZMod (q : ℕ)) * z)‖ ≤
              2 * Cerr * L * N * x ^ (-B)) := by
  let J : ℕ := Nat.ceil (2 * (B + 1) / ε)
  change ∃ Ccoef Cerr X : ℝ, _
  choose D hDpos hD using fun j k =>
    typeIII_sampled_transform_derivative_decay j k T hT
  let Ccoef : ℝ := 1 + ∑ j ∈ Finset.range (J + 1), D j j
  let CT : ℝ := 2 * D (J + 1) 0 * (2 * C) ^ (J + 1)
  let CF : ℝ := 2 ^ (J + 1) * D 0 J
  let Cerr : ℝ := CT + CF
  have hDT : 0 < D (J + 1) 0 := hDpos (J + 1) 0
  have hDF : 0 < D 0 J := hDpos 0 J
  have hCT : 0 < CT := by dsimp [CT]; positivity
  have hCF : 0 < CF := by dsimp [CF]; positivity
  have hCerr : 0 < Cerr := add_pos hCT hCF
  have hCcoef : 0 < Ccoef := by
    dsimp [Ccoef]
    exact add_pos_of_pos_of_nonneg zero_lt_one
      (Finset.sum_nonneg fun j _ => (hDpos j j).le)
  have hDcoef (j : ℕ) (hj : j ≤ J) : D j j ≤ Ccoef :=
    (Finset.single_le_sum (fun i (_ : i ∈ Finset.range (J + 1)) => (hDpos i i).le)
      (Finset.mem_range.mpr (Nat.lt_succ_of_le hj))).trans
      (le_add_of_nonneg_left zero_le_one)
  have hCTerr : CT ≤ Cerr := le_add_of_nonneg_right hCF.le
  have hCFerr : CF ≤ Cerr := le_add_of_nonneg_left hCT.le
  have hJ : B + 1 ≤ ε * (J : ℝ) / 2 := by
    have hc := (div_le_iff₀ hε).mp (Nat.le_ceil (2 * (B + 1) / ε))
    dsimp only [J]
    nlinarith only [hc]
  have hfine : ∀ᶠ x : ℝ in Filter.atTop, C * x ^ (-ε) ≤ 1 / 3 := by
    have ht := (tendsto_rpow_neg_atTop hε).const_mul C
    exact ht.eventually_le_const (by norm_num : C * 0 < (1 : ℝ) / 3)
  have hlog : ∀ᶠ x : ℝ in Filter.atTop, (Real.log x) ^ E ≤ x := by
    have he := (isLittleO_log_rpow_rpow_atTop E (by norm_num : (0 : ℝ) < 1)).bound
      (by norm_num : (0 : ℝ) < 1)
    filter_upwards [he, Filter.eventually_ge_atTop (1 : ℝ)] with x hx hx1
    simpa only [Real.rpow_one, one_mul, Real.norm_eq_abs,
      abs_of_nonneg (Real.rpow_nonneg (Real.log_nonneg hx1) E),
      abs_of_nonneg (zero_le_one.trans hx1)] using hx
  obtain ⟨X₀, hX₀⟩ := Filter.eventually_atTop.mp (hfine.and hlog)
  refine ⟨Ccoef, Cerr, max (Real.exp 1) (X₀ + B), hCcoef, hCerr, le_max_left _ _, ?_⟩
  intro x hx L hL N Qcenter hQ hN ψ hψ hsψ hbψ
  have hxexp : Real.exp 1 ≤ x := (le_max_left _ _).trans hx
  have hx1 : 1 ≤ x := (Real.one_le_exp (by norm_num : (0 : ℝ) ≤ 1)).trans hxexp
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hxlog1 : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hxexp
  have hlogpow : 0 < (Real.log x) ^ E := by positivity
  obtain ⟨hsmall, hlogx⟩ := hX₀ x
    ((le_add_of_nonneg_right hB).trans ((le_max_right _ _).trans hx))
  have hrpow : 0 < x ^ (ε / 2) := Real.rpow_pos_of_pos hx0 _
  have hrpow1 : 1 ≤ x ^ (ε / 2) :=
    Real.one_le_rpow hx1 (by linarith)
  have hNpos : 0 < N := (mul_pos (by norm_num) hrpow).trans_le hN
  have hN1 : 1 ≤ N := by linarith only [hN, hrpow1]
  have hLN : 0 ≤ L * (Real.log x) ^ E := mul_nonneg hL hlogpow.le
  let A : ℤ := Int.ceil (-T * N)
  let K : ℕ := (Int.floor (T * N) + 1 - A).toNat
  let I : Finset ℤ := Finset.Icc A (Int.floor (T * N))
  let Ψ : ℝ → ℂ := fun y =>
    ∑ n ∈ I, ψ ((n : ℝ) / N) *
      Complex.exp (((-2 * Real.pi * (n : ℝ) * y : ℝ) : ℂ) * Complex.I)
  let H : ℝ := x ^ (ε / 2) * Qcenter / N
  let S : Finset ℤ := Finset.Icc (Int.ceil (-H)) (Int.floor H)
  let c : ℕ → ℤ → ℂ := fun j h =>
    ((((h : ℝ) / Qcenter) ^ j / (Nat.factorial j : ℝ) / N : ℝ) : ℂ) *
      iteratedDeriv j Ψ ((h : ℝ) / Qcenter)
  change (∀ j : ℕ, j ≤ J → ∀ h ∈ S,
    ‖c j h‖ ≤ Ccoef * L * (Real.log x) ^ E) ∧ _
  have hH : H ≤ Qcenter / 8 := by
    dsimp [H]
    apply (div_le_iff₀ hNpos).mpr
    nlinarith only [mul_le_mul_of_nonneg_left hN hQ.le]
  have hSmem (h : ℤ) : h ∈ S ↔ |(h : ℝ)| ≤ H := by
    simp only [S, Finset.mem_Icc, Int.ceil_le, Int.le_floor, abs_le]
  have hΨ : ContDiff ℝ ∞ Ψ := by
    apply ContDiff.sum
    intro n hn
    apply contDiff_const.mul
    apply ContDiff.cexp
    exact (Complex.ofRealCLM.contDiff.comp
      (contDiff_const.mul contDiff_id)).mul contDiff_const
  have hdec (j k : ℕ) (hk : k ≤ J) (y : ℝ) (hy : |y| ≤ 1 / 2) :
      ‖iteratedDeriv j Ψ y‖ ≤
        D j k * (L * (Real.log x) ^ E) * N ^ (j + 1) / (1 + N * |y|) ^ k := by
    exact hD j k (L * (Real.log x) ^ E) N hLN hN1 ψ hψ hsψ
      (fun r hr t => hbψ r (by omega) t) y hy
  have habscenter (h : ℤ) (hh : |(h : ℝ)| ≤ H) :
      |(h : ℝ) / Qcenter| ≤ 1 / 8 := by
    rw [abs_div, abs_of_pos hQ]
    exact (div_le_iff₀ hQ).mpr (hh.trans (hH.trans_eq (by ring)))
  have habscenter' (h : ℤ) (hh : |(h : ℝ)| ≤ H) :
      |(h : ℝ) / Qcenter| ≤ x ^ (ε / 2) / N := by
    rw [abs_div, abs_of_pos hQ]
    apply (div_le_iff₀ hQ).mpr
    exact hh.trans_eq (by dsimp [H]; ring)
  have habsorb (r : ℕ) (hr : J ≤ r) :
      (Real.log x) ^ E * x ^ ((-ε / 2) * (r : ℝ)) ≤ x ^ (-B) := by
    have hr' : (J : ℝ) ≤ r := by exact_mod_cast hr
    have hexp : 1 + (-ε / 2) * (r : ℝ) ≤ -B := by
      nlinarith only [hJ, mul_nonneg hε.le (sub_nonneg.mpr hr')]
    calc
      (Real.log x) ^ E * x ^ ((-ε / 2) * (r : ℝ)) ≤
          x * x ^ ((-ε / 2) * (r : ℝ)) :=
        mul_le_mul_of_nonneg_right hlogx (Real.rpow_nonneg hx0.le _)
      _ = x ^ (1 + (-ε / 2) * (r : ℝ)) := by
        rw [Real.rpow_add hx0, Real.rpow_one]
      _ ≤ x ^ (-B) := Real.rpow_le_rpow_of_exponent_le hx1 hexp
  constructor
  · intro j hj h hh
    have hDj : 0 < D j j := hDpos j j
    have hy := habscenter h ((hSmem h).mp hh)
    have hdecj := hdec j j hj ((h : ℝ) / Qcenter) (by linarith only [hy])
    have hfact : (1 : ℝ) ≤ Nat.factorial j := by
      exact_mod_cast Nat.factorial_pos j
    have hfactpos : (0 : ℝ) < Nat.factorial j := zero_lt_one.trans_le hfact
    have hratio : (N * |(h : ℝ) / Qcenter|) ^ j /
        (1 + N * |(h : ℝ) / Qcenter|) ^ j ≤ 1 := by
      apply (div_le_one (by positivity)).mpr
      exact pow_le_pow_left₀ (mul_nonneg hNpos.le (abs_nonneg _))
        (by linarith) j
    calc
      ‖c j h‖ =
          (|(h : ℝ) / Qcenter| ^ j / (Nat.factorial j : ℝ) / N) *
            ‖iteratedDeriv j Ψ ((h : ℝ) / Qcenter)‖ := by
        simp only [c, norm_mul, Complex.norm_real, Real.norm_eq_abs,
          abs_div, abs_pow, abs_of_pos hfactpos, abs_of_pos hNpos]
      _ ≤ (|(h : ℝ) / Qcenter| ^ j / (Nat.factorial j : ℝ) / N) *
          (D j j * (L * (Real.log x) ^ E) * N ^ (j + 1) /
            (1 + N * |(h : ℝ) / Qcenter|) ^ j) := by
        gcongr
      _ = (D j j * (L * (Real.log x) ^ E)) *
          ((N * |(h : ℝ) / Qcenter|) ^ j /
            (1 + N * |(h : ℝ) / Qcenter|) ^ j) / (Nat.factorial j : ℝ) := by
        rw [mul_pow, pow_succ]
        field_simp
      _ ≤ D j j * (L * (Real.log x) ^ E) := by
        exact (div_le_self (by positivity) hfact).trans
          (mul_le_of_le_one_right (by positivity) hratio)
      _ ≤ Ccoef * L * (Real.log x) ^ E := by
        simpa only [mul_assoc] using mul_le_mul_of_nonneg_right (hDcoef j hj) hLN
  · intro q hqlo hqhi
    let W : ZMod (q : ℕ) → ℂ := integerIntervalResidueWeight (q : ℕ) A K
      (fun n => ψ (((A : ℝ) + (n : ℝ)) / N))
    let η : ℕ → ℝ := fun j =>
      Qcenter / (q : ℝ) * ((Qcenter - (q : ℝ)) / (q : ℝ)) ^ j
    let P : ZMod (q : ℕ) → ℂ := fun ξ =>
      if |(ξ.valMinAbs : ℝ)| ≤ H then
        ((N / Qcenter : ℝ) : ℂ) *
          ∑ j ∈ Finset.range (J + 1), c j ξ.valMinAbs * (η j : ℂ)
      else 0
    change
      (∀ ξ : ZMod (q : ℕ),
        ZMod.dft W ξ = Ψ ((ξ.valMinAbs : ℝ) / (q : ℝ))) ∧
      (∀ j : ℕ, |η j| ≤ 2) ∧
      (((Finset.univ : Finset (ZMod (q : ℕ))).filter
          (fun ξ => |(ξ.valMinAbs : ℝ)| ≤ H)).image ZMod.valMinAbs = S) ∧
      (∀ ξ : ZMod (q : ℕ),
        ‖(q : ℂ)⁻¹ * ZMod.dft W ξ - P ξ‖ ≤
          Cerr * L * (N / Qcenter) * x ^ (-B)) ∧
      (∑ ξ : ZMod (q : ℕ), ‖(q : ℂ)⁻¹ * ZMod.dft W ξ - P ξ‖ ≤
        2 * Cerr * L * N * x ^ (-B)) ∧
      (∑ ξ ∈ (Finset.univ : Finset (ZMod (q : ℕ))).filter
          (fun ξ => H < |(ξ.valMinAbs : ℝ)|), ‖(q : ℂ)⁻¹ * ZMod.dft W ξ‖ ≤
        2 * Cerr * L * N * x ^ (-B)) ∧
      (∀ z : ZMod (q : ℕ),
        ‖W z - ((N / Qcenter : ℝ) : ℂ) *
            ∑ j ∈ Finset.range (J + 1), (η j : ℂ) *
              ∑ h ∈ S, c j h * ZMod.stdAddChar ((h : ZMod (q : ℕ)) * z)‖ ≤
          2 * Cerr * L * N * x ^ (-B))
    have hq : 0 < (q : ℝ) := by exact_mod_cast q.pos
    have hqC : (q : ℂ) ≠ 0 := by exact_mod_cast q.ne_zero
    have hQq : Qcenter / 2 ≤ (q : ℝ) := by
      nlinarith only [hqlo, hQ, mul_le_mul_of_nonneg_left hsmall hQ.le]
    have hqQ : (q : ℝ) ≤ 2 * Qcenter := by
      nlinarith only [hqhi, hQ, mul_le_mul_of_nonneg_left hsmall hQ.le]
    have hQdivq : Qcenter / (q : ℝ) ≤ 2 := by
      exact (div_le_iff₀ hq).mpr (by linarith only [hQq])
    have hqdivQ : (q : ℝ) / Qcenter ≤ 2 := (div_le_iff₀ hQ).mpr hqQ
    have hdiff : |Qcenter - (q : ℝ)| ≤ Qcenter * (C * x ^ (-ε)) := by
      rw [abs_le]
      constructor <;> nlinarith only [hqlo, hqhi]
    have hratio : |(Qcenter - (q : ℝ)) / (q : ℝ)| ≤ 1 / 2 := by
      rw [abs_div, abs_of_pos hq]
      apply (div_le_iff₀ hq).mpr
      nlinarith only [hdiff, hqlo, mul_le_mul_of_nonneg_left hsmall hQ.le]
    have hratio' : |(Qcenter - (q : ℝ)) / (q : ℝ)| ≤
        2 * C * x ^ (-ε) := by
      rw [abs_div, abs_of_pos hq]
      calc
        |Qcenter - (q : ℝ)| / (q : ℝ) ≤
            Qcenter * (C * x ^ (-ε)) / (q : ℝ) := div_le_div_of_nonneg_right hdiff hq.le
        _ = (Qcenter / (q : ℝ)) * (C * x ^ (-ε)) := by ring
        _ ≤ 2 * (C * x ^ (-ε)) := by
          gcongr
        _ = 2 * C * x ^ (-ε) := by ring
    have hHhalf : H < (q : ℝ) / 2 := by linarith only [hH, hQq, hQ]
    have hhalf (ξ : ZMod (q : ℕ)) :
        |(ξ.valMinAbs : ℝ) / (q : ℝ)| ≤ 1 / 2 := by
      have hm := ξ.valMinAbs_mem_Ioc
      have hml : -(q : ℝ) < (ξ.valMinAbs : ℝ) * 2 := by exact_mod_cast hm.1
      have hmu : (ξ.valMinAbs : ℝ) * 2 ≤ (q : ℝ) := by exact_mod_cast hm.2
      rw [abs_div, abs_of_pos hq, div_le_iff₀ hq, abs_le]
      constructor <;> linarith only [hml, hmu]
    have hDFT (ξ : ZMod (q : ℕ)) :
        ZMod.dft W ξ = Ψ ((ξ.valMinAbs : ℝ) / (q : ℝ)) := by
      rw [(integerIntervalResidueWeight_spec (q : ℕ) A K
        (fun n => ψ (((A : ℝ) + (n : ℝ)) / N))).2.1 ξ]
      dsimp only [Ψ, I]
      rw [Int.Icc_eq_finset_map, Finset.sum_map]
      apply Finset.sum_congr rfl
      intro n hn
      simp only [Function.Embedding.trans_apply, Nat.castEmbedding_apply,
        addLeftEmbedding_apply, Int.cast_add, Int.cast_natCast]
      congr 1
      have hz : -(((A : ZMod (q : ℕ)) + (n : ZMod (q : ℕ))) * ξ) =
          ((-((A + (n : ℤ)) * ξ.valMinAbs) : ℤ) : ZMod (q : ℕ)) := by
        simp only [Int.cast_neg, Int.cast_mul, Int.cast_add, Int.cast_natCast,
          ZMod.coe_valMinAbs]
      rw [hz, ZMod.stdAddChar_coe]
      congr 1
      push_cast
      ring
    clear_value Ψ W
    have hη (j : ℕ) : |η j| ≤ 2 := by
      dsimp [η]
      rw [abs_mul, abs_div, abs_of_pos hQ, abs_of_pos hq, abs_pow]
      exact (mul_le_of_le_one_right (div_nonneg hQ.le hq.le)
        (pow_le_one₀ (abs_nonneg _) (hratio.trans (by norm_num)))).trans hQdivq
    let R : Finset (ZMod (q : ℕ)) := Finset.univ.filter
      (fun ξ => |(ξ.valMinAbs : ℝ)| ≤ H)
    have himage : R.image ZMod.valMinAbs = S := by
      ext h
      constructor
      · intro hh
        obtain ⟨ξ, hξ, rfl⟩ := Finset.mem_image.mp hh
        exact (hSmem _).mpr (Finset.mem_filter.mp hξ).2
      · intro hh
        have hh' := (hSmem h).mp hh
        have hc : (h : ZMod (q : ℕ)).valMinAbs = h := by
          apply (ZMod.valMinAbs_spec _ _).mpr
          refine ⟨rfl, ?_⟩
          have hl : -(q : ℝ) < (h : ℝ) * 2 := by
            have hhl := (abs_le.mp hh').1
            linarith only [hhl, hHhalf]
          have hu : (h : ℝ) * 2 ≤ (q : ℝ) := by
            have hhu := (abs_le.mp hh').2
            linarith only [hhu, hHhalf]
          exact ⟨by exact_mod_cast hl, by exact_mod_cast hu⟩
        refine Finset.mem_image.mpr ⟨(h : ZMod (q : ℕ)), ?_, hc⟩
        simp only [R, Finset.mem_filter, Finset.mem_univ, true_and, hc]
        exact hh'
    have hnormq : ‖(q : ℂ)⁻¹‖ = (q : ℝ)⁻¹ := by
      simp only [norm_inv, Complex.norm_natCast]
    have hqinv : (q : ℝ)⁻¹ ≤ 2 / Qcenter := by
      rw [inv_eq_one_div, div_le_div_iff₀ hq hQ]
      linarith only [hQq]
    have hpoint (ξ : ZMod (q : ℕ)) :
        ‖(q : ℂ)⁻¹ * ZMod.dft W ξ - P ξ‖ ≤
          Cerr * L * (N / Qcenter) * x ^ (-B) := by
      by_cases hret : |(ξ.valMinAbs : ℝ)| ≤ H
      · let y : ℝ := (ξ.valMinAbs : ℝ) / Qcenter
        let d : ℝ := (ξ.valMinAbs : ℝ) / (q : ℝ) - y
        have hyd : y + d = (ξ.valMinAbs : ℝ) / (q : ℝ) := by dsimp [d]; ring
        have hd : d = y * ((Qcenter - (q : ℝ)) / (q : ℝ)) := by
          dsimp [d, y]
          field_simp
        have hy : |y| ≤ 1 / 8 := habscenter _ hret
        have hy' : |y| ≤ x ^ (ε / 2) / N := habscenter' _ hret
        have hdabs : |d| ≤ 2 * C * x ^ (-ε / 2) / N := by
          rw [hd, abs_mul]
          calc
            |y| * |(Qcenter - (q : ℝ)) / (q : ℝ)| ≤
                (x ^ (ε / 2) / N) * (2 * C * x ^ (-ε)) := by
              gcongr
            _ = 2 * C * x ^ (-ε / 2) / N := by
              have hp : x ^ (ε / 2) * x ^ (-ε) = x ^ (-ε / 2) := by
                rw [← Real.rpow_add hx0]
                congr 1
                ring
              calc
                _ = 2 * C * (x ^ (ε / 2) * x ^ (-ε)) / N := by ring
                _ = _ := by rw [hp]
        have hseg (t : ℝ) (ht : t ∈ Set.Icc 0 1) : |y + t * d| ≤ 1 / 2 := by
          have hyhalf : |y| ≤ 1 / 2 := hy.trans (by norm_num)
          have hyend : y + d ∈ Set.Icc (-(1 / 2 : ℝ)) (1 / 2) := by
            rw [hyd]
            exact abs_le.mp (hhalf ξ)
          apply abs_le.mpr
          simpa only [smul_eq_mul, Set.mem_Icc] using
            (convex_Icc (𝕜 := ℝ) (-(1 / 2 : ℝ)) (1 / 2)).add_smul_mem
              (abs_le.mp hyhalf) hyend ht
        let Q : ℂ := ∑ j ∈ Finset.range (J + 1),
          (Nat.factorial j : ℝ)⁻¹ • (d ^ j • iteratedDeriv j Ψ y)
        have hTaylor : Ψ (y + d) = Q + (Nat.factorial J : ℝ)⁻¹ •
            ∫ t in (0 : ℝ)..1, (1 - t) ^ J •
              (d ^ (J + 1) • iteratedDeriv (J + 1) Ψ (y + t * d)) := by
          have ht := map_add_eq_sum_add_integral_iteratedFDeriv
            (f := Ψ) (x := y) (y := d) (n := J)
            (fun t _ => hΨ.contDiffAt.of_le (by simp))
          simpa only [Q, iteratedFDeriv_apply_eq_iteratedDeriv_mul_prod,
            Finset.prod_const, Finset.card_univ, Fintype.card_fin, smul_eq_mul] using ht
        have hrem : ‖Ψ (y + d) - Q‖ ≤
            D (J + 1) 0 * (L * (Real.log x) ^ E) * N ^ (J + 2) * |d| ^ (J + 1) := by
          have hi : ‖∫ t in (0 : ℝ)..1, (1 - t) ^ J •
              (d ^ (J + 1) • iteratedDeriv (J + 1) Ψ (y + t * d))‖ ≤
              D (J + 1) 0 * (L * (Real.log x) ^ E) * N ^ (J + 2) * |d| ^ (J + 1) := by
            apply (intervalIntegral.norm_integral_le_of_norm_le_const
              (C := D (J + 1) 0 * (L * (Real.log x) ^ E) *
                N ^ (J + 2) * |d| ^ (J + 1)) ?_).trans_eq (by norm_num)
            intro t ht
            have ht' : t ∈ Set.Icc (0 : ℝ) 1 := Set.Ioc_subset_Icc_self (by
              simpa only [Set.uIoc_of_le zero_le_one] using ht)
            have hb := hdec (J + 1) 0 (Nat.zero_le _) (y + t * d) (hseg t ht')
            simp only [pow_zero, div_one] at hb
            have hweight : |1 - t| ^ J ≤ 1 :=
              pow_le_one₀ (abs_nonneg _) (by
                rw [abs_le]
                constructor <;> linarith only [ht'.1, ht'.2])
            rw [norm_smul, norm_smul, Real.norm_eq_abs, Real.norm_eq_abs, abs_pow, abs_pow]
            calc
              |1 - t| ^ J * (|d| ^ (J + 1) * ‖iteratedDeriv (J + 1) Ψ (y + t * d)‖) ≤
                  1 * (|d| ^ (J + 1) *
                    (D (J + 1) 0 * (L * (Real.log x) ^ E) * N ^ (J + 2))) := by
                gcongr
              _ = _ := by ring
          rw [hTaylor, add_sub_cancel_left, norm_smul, Real.norm_eq_abs,
            abs_of_nonneg (by positivity : 0 ≤ (Nat.factorial J : ℝ)⁻¹)]
          have hf : (Nat.factorial J : ℝ)⁻¹ ≤ 1 :=
            inv_le_one_of_one_le₀ (by exact_mod_cast Nat.factorial_pos J)
          exact (mul_le_mul_of_nonneg_left hi (by positivity)).trans
            (mul_le_of_le_one_left (by positivity) hf)
        have hP : P ξ = (q : ℂ)⁻¹ * Q := by
          simp only [P, ite_eq_left hret, Q, Finset.mul_sum]
          apply Finset.sum_congr rfl
          intro j hj
          dsimp only [c, η]
          rw [hd]
          dsimp only [y]
          simp only [Complex.real_smul]
          push_cast
          simp only [mul_pow, div_pow]
          field_simp [Complex.ofReal_ne_zero.mpr hNpos.ne',
            Complex.ofReal_ne_zero.mpr hQ.ne', hqC]
        rw [hDFT, hP, ← mul_sub, ← hyd, norm_mul, hnormq]
        calc
          (q : ℝ)⁻¹ * ‖Ψ (y + d) - Q‖ ≤
              (2 / Qcenter) *
                (D (J + 1) 0 * (L * (Real.log x) ^ E) * N ^ (J + 2) *
                  (2 * C * x ^ (-ε / 2) / N) ^ (J + 1)) := by
            refine mul_le_mul hqinv (hrem.trans ?_) (norm_nonneg _) (by positivity)
            gcongr
          _ = CT * L * (N / Qcenter) *
              ((Real.log x) ^ E * x ^ ((-ε / 2) * ((J + 1 : ℕ) : ℝ))) := by
            rw [Real.rpow_mul_natCast hx0.le]
            dsimp [CT]
            rw [div_pow, mul_pow, mul_pow, pow_succ N (J + 1)]
            field_simp
          _ ≤ CT * L * (N / Qcenter) * x ^ (-B) := by
            gcongr
            exact habsorb (J + 1) (Nat.le_succ _)
          _ ≤ Cerr * L * (N / Qcenter) * x ^ (-B) := by
            gcongr
      · have htail : H < |(ξ.valMinAbs : ℝ)| := lt_of_not_ge hret
        have hlower : x ^ (ε / 2) / 2 ≤
            1 + N * |(ξ.valMinAbs : ℝ) / (q : ℝ)| := by
          rw [abs_div, abs_of_pos hq]
          have ht : x ^ (ε / 2) * Qcenter < |(ξ.valMinAbs : ℝ)| * N :=
            (div_lt_iff₀ hNpos).mp htail
          have hl : x ^ (ε / 2) / 2 ≤ N * |(ξ.valMinAbs : ℝ)| / (q : ℝ) := by
            apply (le_div_iff₀ hq).mpr
            nlinarith only [ht, mul_le_mul_of_nonneg_left hqQ hrpow.le]
          simpa only [mul_div_assoc] using
            hl.trans (le_add_of_nonneg_left (show (0 : ℝ) ≤ 1 by norm_num))
        have hd0 := hdec 0 J (le_refl J) ((ξ.valMinAbs : ℝ) / (q : ℝ)) (hhalf ξ)
        simp only [iteratedDeriv_zero, zero_add, pow_one] at hd0
        simp only [P, ite_eq_right hret, sub_zero, hDFT, norm_mul, hnormq]
        calc
          (q : ℝ)⁻¹ * ‖Ψ ((ξ.valMinAbs : ℝ) / (q : ℝ))‖ ≤
              (2 / Qcenter) * (D 0 J * (L * (Real.log x) ^ E) * N /
                (x ^ (ε / 2) / 2) ^ J) := by
            refine mul_le_mul hqinv (hd0.trans ?_) (norm_nonneg _) (by positivity)
            gcongr
          _ = CF * L * (N / Qcenter) *
              ((Real.log x) ^ E * x ^ ((-ε / 2) * (J : ℝ))) := by
            have hp : x ^ ((-ε / 2) * (J : ℝ)) = ((x ^ (ε / 2)) ^ J)⁻¹ := by
              rw [show (-ε / 2) * (J : ℝ) = -((ε / 2) * (J : ℝ)) by ring,
                Real.rpow_neg hx0.le, Real.rpow_mul_natCast hx0.le]
            rw [hp]
            dsimp [CF]
            rw [div_pow, pow_succ]
            field_simp
          _ ≤ CF * L * (N / Qcenter) * x ^ (-B) := by
            gcongr
            exact habsorb J (le_refl J)
          _ ≤ Cerr * L * (N / Qcenter) * x ^ (-B) := by
            gcongr
    have hsum : (∑ ξ : ZMod (q : ℕ),
        ‖(q : ℂ)⁻¹ * ZMod.dft W ξ - P ξ‖) ≤ 2 * Cerr * L * N * x ^ (-B) := by
      calc
        (∑ ξ : ZMod (q : ℕ), ‖(q : ℂ)⁻¹ * ZMod.dft W ξ - P ξ‖) ≤
            ∑ _ξ : ZMod (q : ℕ), Cerr * L * (N / Qcenter) * x ^ (-B) :=
          Finset.sum_le_sum fun ξ _ => hpoint ξ
        _ = ((q : ℝ) / Qcenter) * (Cerr * L * N * x ^ (-B)) := by
          simp only [Finset.sum_const, Finset.card_univ, ZMod.card, nsmul_eq_mul]
          ring
        _ ≤ 2 * (Cerr * L * N * x ^ (-B)) := by
          gcongr
        _ = _ := by ring
    refine ⟨hDFT, hη, himage, hpoint, hsum, ?_, ?_⟩
    · calc
        (∑ ξ ∈ (Finset.univ : Finset (ZMod (q : ℕ))).filter
            (fun ξ => H < |(ξ.valMinAbs : ℝ)|), ‖(q : ℂ)⁻¹ * ZMod.dft W ξ‖) =
            ∑ ξ ∈ (Finset.univ : Finset (ZMod (q : ℕ))).filter
              (fun ξ => H < |(ξ.valMinAbs : ℝ)|),
                ‖(q : ℂ)⁻¹ * ZMod.dft W ξ - P ξ‖ := by
          apply Finset.sum_congr rfl
          intro ξ hξ
          have ht := (Finset.mem_filter.mp hξ).2
          simp only [P, ite_eq_right (not_le.mpr ht), sub_zero]
        _ ≤ ∑ ξ : ZMod (q : ℕ), ‖(q : ℂ)⁻¹ * ZMod.dft W ξ - P ξ‖ :=
          Finset.sum_le_sum_of_subset_of_nonneg (Finset.filter_subset _ _)
            (fun ξ _ _ => norm_nonneg _)
        _ ≤ _ := hsum
    · intro z
      have hinv : W z = ∑ ξ : ZMod (q : ℕ),
          ((q : ℂ)⁻¹ * ZMod.dft W ξ) * ZMod.stdAddChar (ξ * z) := by
        have hi := congrFun (ZMod.dft.symm_apply_apply W) z
        rw [ZMod.invDFT_apply] at hi
        simpa only [smul_eq_mul, Finset.mul_sum, mul_comm, mul_left_comm, mul_assoc]
          using hi.symm
      have hpoly : (∑ ξ : ZMod (q : ℕ), P ξ * ZMod.stdAddChar (ξ * z)) =
          ((N / Qcenter : ℝ) : ℂ) *
            ∑ j ∈ Finset.range (J + 1), (η j : ℂ) *
              ∑ h ∈ S, c j h * ZMod.stdAddChar ((h : ZMod (q : ℕ)) * z) := by
        calc
          (∑ ξ : ZMod (q : ℕ), P ξ * ZMod.stdAddChar (ξ * z)) =
              ∑ ξ ∈ R, (((N / Qcenter : ℝ) : ℂ) *
                ∑ j ∈ Finset.range (J + 1), c j ξ.valMinAbs * (η j : ℂ)) *
                  ZMod.stdAddChar (ξ * z) := by
            simp only [P, R, Finset.sum_filter, ite_mul, zero_mul]
          _ = ((N / Qcenter : ℝ) : ℂ) *
              ∑ j ∈ Finset.range (J + 1), (η j : ℂ) *
                ∑ ξ ∈ R, c j ξ.valMinAbs * ZMod.stdAddChar (ξ * z) := by
            simp only [Finset.mul_sum, Finset.sum_mul]
            rw [Finset.sum_comm]
            apply Finset.sum_congr rfl
            intro j hj
            apply Finset.sum_congr rfl
            intro ξ hξ
            ring
          _ = _ := by
            congr 1
            apply Finset.sum_congr rfl
            intro j hj
            congr 1
            rw [← himage, Finset.sum_image]
            · simp only [ZMod.coe_valMinAbs]
            · exact fun ξ _ ζ _ he => ZMod.injective_valMinAbs he
      rw [← hpoly, hinv, ← Finset.sum_sub_distrib]
      exact (norm_sum_le _ _).trans (by
        simpa only [← sub_mul, norm_mul, ZMod.stdAddChar_apply, Circle.norm_coe,
          mul_one] using hsum)

end

open Classical in
theorem sourceSigmaThree_uniform_large_gcd_truncation
    (δ ε C P cN TN cD TD CN EN CD ED : ℝ) (J₀ : ℕ)
    (hδ : 0 < δ) (hε : 0 < ε) (hC : 1 ≤ C) (hP : 0 < P)
    (hcN : 0 < cN) (hNT : cN ≤ TN)
    (hcD : 0 < cD) (hDT : cD ≤ TD)
    (hCN : 0 ≤ CN) (hCD : 0 ≤ CD) :
    ∃ K X₀ : ℝ, 0 < K ∧ Real.exp 1 ≤ X₀ ∧
      ∀ (x : ℝ), X₀ ≤ x →
      ∀ (r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁ w₂ : ℕ),
      0 < r₁ → 0 < q₀ → 0 < u₁ → 0 < v₁ → 0 < v₂ → 0 < q₂ →
      let m : ℕ := r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂
      ∀ (A B : Fin m) (ℓ : ℤ) (E : ZMod q₀ → Finset (ZMod q₀)),
      ∀ (N Δ d₀ H V : ℝ),
      1 ≤ N → 1 ≤ Δ → 1 ≤ H → 0 < V →
      N ≤ x ^ P → H ≤ x ^ P → (m : ℝ) ≤ x ^ P →
      Δ ≤ C * N / (x ^ (50 * ε) * H ^ 2) →
      Δ / C ≤ d₀ → d₀ ≤ C * Δ →
      (v₁ : ℝ) ≤ C * V → (v₂ : ℝ) ≤ C * V →
      V ≤ C * x ^ (δ + 5 * ε) * H →
      ∀ (J : Finset ℤ), (∀ h ∈ J, |(h : ℝ)| ≤ C * H) →
      ∀ (ψN ψD : ℝ → ℝ),
      Function.support ψN ⊆ Set.Icc cN TN →
      Function.support ψD ⊆ Set.Icc cD TD →
      (∀ t : ℝ, |ψN t| ≤ CN * (Real.log x) ^ EN) →
      (∀ t : ℝ, |ψD t| ≤ CD * (Real.log x) ^ ED) →
      ∀ (Y : ℝ) (j : ℕ), j ≤ J₀ →
      let Δ₁ : ℝ := x ^ (-5 * ε) * Δ
      let g : ℕ := Nat.gcd v₁ v₂
      let s₂ : ℕ := Nat.gcd w₂ m
      let φ : ℤ × ℤ → ℤ := fun h =>
        h.1 * ((v₂ / g : ℕ) : ℤ) - h.2 * ((v₁ / g : ℕ) : ℤ)
      let L : Finset ℤ := ((J ×ˢ J).image φ).erase 0
      let Ypairs : Finset (ℤ × ℤ) := (L ×ˢ L).filter (fun p =>
        1 ≤ (p.1 : ℝ) / Y ∧ (p.1 : ℝ) / Y < 2 ∧
        1 ≤ (p.2 : ℝ) / Y ∧ (p.2 : ℝ) / Y < 2 ∧
        (w₁ : ℤ) ∣ p.1 ∧ (w₁ : ℤ) ∣ p.2 ∧
        (∏ q ∈ m.primeFactors, q ^ p.1.natAbs.factorization q) = w₂ ∧
        (∏ q ∈ m.primeFactors, q ^ p.2.natAbs.factorization q) = w₂)
      let R : ℝ := max (x ^ (δ + 10 * ε) * H ^ 3) (H ^ 4)
      let T : ℝ := max ((s₂ : ℝ)⁻¹) H⁻¹ *
        (x ^ (δ + 100 * ε) * H ^ 2 * N / ((g : ℝ) * Δ₁))
      let maxSigmaFour : ℝ :=
        ((Ypairs.sup (fun p => Real.toNNReal
          ‖∑' d : ℕ,
            sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
              (A.val : ℤ) (B.val : ℤ) ℓ E ψN ψD N Δ₁ d₀ j p.1 p.2
                (T : WithTop ℝ) d‖) : NNReal) : ℝ)
      sourceSigmaThree m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁ w₂
        (A.val : ℤ) (B.val : ℤ) ℓ E L ψN ψD N Δ₁ d₀ Y j ≤
          K * R / (s₂ : ℝ) * maxSigmaFour + K * x ^ (-47 * ε) * N ^ 2 := by
  have hdiagonalCount (F : Finset ((ℤ × ℤ) × ℕ × ℤ × ℤ))
      (Ls : Finset ℤ) (D : Finset ℕ) (I : Finset ℤ)
      (hF : ∀ t ∈ F, t.1.1 ∈ Ls ∧ t.2.1 ∈ D ∧ t.2.2.1 ∈ I ∧
        t.1.1 = t.1.2 ∧ t.2.2.1 = t.2.2.2) :
      (F.card : ℝ) ≤ (Ls.card : ℝ) * (D.card : ℝ) * (I.card : ℝ) := by
    let key : ((ℤ × ℤ) × ℕ × ℤ × ℤ) → ℤ × ℕ × ℤ := fun t =>
      (t.1.1, t.2.1, t.2.2.1)
    have hmap : ∀ t ∈ F, key t ∈ Ls ×ˢ (D ×ˢ I) := by
      intro t ht
      obtain ⟨hy, hd, hn, _, _⟩ := hF t ht
      exact Finset.mem_product.mpr ⟨hy, Finset.mem_product.mpr ⟨hd, hn⟩⟩
    have hinj : (F : Set ((ℤ × ℤ) × ℕ × ℤ × ℤ)).InjOn key := by
      intro t ht u hu hkey
      obtain ⟨_, _, _, hty, htn⟩ := hF t ht
      obtain ⟨_, _, _, huy, hun⟩ := hF u hu
      obtain ⟨hy, hrest⟩ := Prod.mk.inj hkey
      obtain ⟨hd, hn⟩ := Prod.mk.inj hrest
      exact Prod.ext (Prod.ext hy (hty.symm.trans (hy.trans huy)))
        (Prod.ext hd (Prod.ext hn (htn.symm.trans (hn.trans hun))))
    have h := Finset.card_le_card_of_injOn key hmap hinj
    calc
      (F.card : ℝ) ≤ ((Ls ×ˢ (D ×ˢ I)).card : ℝ) := by exact_mod_cast h
      _ = _ := by simp only [Finset.card_product, Nat.cast_mul]; ring
  have hsameYTailCount
      (F : Finset ((ℤ × ℤ) × ℕ × ℤ × ℤ))
      (Ls : Finset ℤ) (D : Finset ℕ) (I : Finset ℤ) (q : ℕ)
      (Δ C₀ TN₀ Yabs N₀ : ℝ) (hq : 0 < q)
      (hΔ : 0 < Δ) (hC₀ : 1 ≤ C₀) (hTN₀ : 0 < TN₀)
      (hYabs : 0 ≤ Yabs) (hN₀ : 0 < N₀)
      (hF : ∀ t ∈ F,
        t.1.1 ∈ Ls ∧ t.2.1 ∈ D ∧ t.2.2.1 ∈ I ∧
        t.1.1 = t.1.2 ∧ t.1.1 ≠ 0 ∧ t.2.2.2 ≠ t.2.2.1 ∧
        Δ / C₀ ≤ (t.2.1 : ℝ) ∧ |(t.1.1 : ℝ)| ≤ 2 * Yabs ∧
        |(t.2.2.1 : ℝ)| ≤ TN₀ * N₀ ∧ |(t.2.2.2 : ℝ)| ≤ TN₀ * N₀ ∧
        (t.2.1 : ℤ) * (q : ℤ) ∣ t.1.1 * (t.2.2.2 - t.2.2.1)) :
      (F.card : ℝ) ≤ (Ls.card : ℝ) * (D.card : ℝ) * (I.card : ℝ) *
        (8 * C₀ * TN₀ * Yabs * N₀ / (Δ * (q : ℝ))) := by
    let W : ℝ := 4 * C₀ * TN₀ * Yabs * N₀ / (Δ * (q : ℝ))
    have hW : 0 ≤ W := by dsimp only [W]; positivity
    let key : ((ℤ × ℤ) × ℕ × ℤ × ℤ) → ℤ × ℕ × ℤ := fun t =>
      (t.1.1, t.2.1, t.2.2.1)
    let κ : ((ℤ × ℤ) × ℕ × ℤ × ℤ) → ℤ := fun t =>
      t.1.1 * (t.2.2.2 - t.2.2.1) / ((t.2.1 : ℤ) * (q : ℤ))
    have hquotient (t : (ℤ × ℤ) × ℕ × ℤ × ℤ) (ht : t ∈ F) :
        κ t * ((t.2.1 : ℤ) * (q : ℤ)) = t.1.1 * (t.2.2.2 - t.2.2.1) :=
      Int.ediv_mul_cancel (hF t ht).2.2.2.2.2.2.2.2.2.2
    have hkbound (t : (ℤ × ℤ) × ℕ × ℤ × ℤ) (ht : t ∈ F) :
        |(κ t : ℝ)| ≤ W ∧ κ t ≠ 0 := by
      obtain ⟨_, _, _, _, hy0, hnn', hd, hy, hn, hn', hdiv⟩ := hF t ht
      have hdiv₀ : (t.2.1 : ℤ) * (q : ℤ) ∣
          t.1.1 * (t.2.2.2 + (0 : ℤ) * (t.2.1 : ℤ)) -
            t.1.1 * (t.2.2.1 + (0 : ℤ) * (t.2.1 : ℤ)) := by
        simpa only [zero_mul, add_zero, mul_sub] using hdiv
      have hr := int_bilinear_quotient_radius t.2.1 q 0 t.1.1 t.1.1 t.2.2.1 t.2.2.2
        Δ C₀ TN₀ Yabs N₀ hq hΔ hC₀ hTN₀ hYabs hN₀ hd hy hy hn hn' hdiv₀
      have hnonzeroκ : κ t ≠ 0 := left_ne_zero_of_mul
        ((hquotient t ht).trans_ne (mul_ne_zero hy0 (sub_ne_zero.mpr hnn')))
      refine ⟨?_, hnonzeroκ⟩
      simpa [κ, W, mul_sub] using hr.2
    have hmap : ∀ t ∈ F, key t ∈ Ls ×ˢ (D ×ˢ I) := by
      intro t ht
      obtain ⟨hy, hd, hn, _⟩ := hF t ht
      exact Finset.mem_product.mpr ⟨hy, Finset.mem_product.mpr ⟨hd, hn⟩⟩
    have hfiber (a : ℤ × ℕ × ℤ) (_ha : a ∈ Ls ×ˢ (D ×ˢ I)) :
        ((F.filter (fun t => key t = a)).card : ℝ) ≤ 2 * W := by
      let S := F.filter (fun t => key t = a)
      have hinj : (S : Set ((ℤ × ℤ) × ℕ × ℤ × ℤ)).InjOn κ := by
        intro t ht u hu hκ
        obtain ⟨htF, htkey⟩ := Finset.mem_filter.mp ht
        obtain ⟨huF, hukey⟩ := Finset.mem_filter.mp hu
        have hkey : key t = key u := htkey.trans hukey.symm
        obtain ⟨hy, hrest⟩ := Prod.mk.inj hkey
        obtain ⟨hd, hn⟩ := Prod.mk.inj hrest
        have hdiff : t.2.2.2 - t.2.2.1 = u.2.2.2 - u.2.2.1 := by
          apply mul_left_cancel₀ (hF t htF).2.2.2.2.1
          calc
            t.1.1 * (t.2.2.2 - t.2.2.1) = κ t * ((t.2.1 : ℤ) * (q : ℤ)) :=
              (hquotient t htF).symm
            _ = κ u * ((u.2.1 : ℤ) * (q : ℤ)) := by rw [hκ, hd]
            _ = u.1.1 * (u.2.2.2 - u.2.2.1) := hquotient u huF
            _ = t.1.1 * (u.2.2.2 - u.2.2.1) := by rw [hy]
        have hty : t.1.1 = t.1.2 := (hF t htF).2.2.2.1
        have huy : u.1.1 = u.1.2 := (hF u huF).2.2.2.1
        exact Prod.ext (Prod.ext hy (hty.symm.trans (hy.trans huy)))
          (Prod.ext hd (Prod.ext hn (by omega)))
      have himage : ((S.image κ).card : ℝ) ≤ 2 * W := by
        have h := int_nonzero_dvd_card_le (S.image κ) W hW 1 (by norm_num) (by
          intro k hk
          obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hk
          have h := hkbound t (Finset.mem_filter.mp ht).1
          exact ⟨h.1, h.2, one_dvd _⟩)
        simpa only [Int.cast_one, div_one] using h
      calc
        (S.card : ℝ) = ((S.image κ).card : ℝ) := by
          exact_mod_cast (Finset.card_image_of_injOn hinj).symm
        _ ≤ 2 * W := himage
    calc
      (F.card : ℝ) = ∑ a ∈ Ls ×ˢ (D ×ˢ I),
          ((F.filter (fun t => key t = a)).card : ℝ) := by
        exact_mod_cast Finset.card_eq_sum_card_fiberwise hmap
      _ ≤ ((Ls ×ˢ (D ×ˢ I)).card : ℝ) * (2 * W) := by
        simpa only [nsmul_eq_mul] using Finset.sum_le_card_nsmul _ _ _ hfiber
      _ = _ := by simp only [Finset.card_product, Nat.cast_mul, W]; ring
  have hmincensus (s H : ℝ) (hs : 1 ≤ s) (hH : 1 ≤ H) :
      (H ^ 2 / s + H) * min s H ≤ 2 * H ^ 2 := by
    have hs0 : 0 < s := zero_lt_one.trans_le hs
    have hH0 : 0 ≤ H := zero_le_one.trans hH
    have hu : min s H / s ≤ 1 := (div_le_one hs0).mpr (min_le_left _ _)
    calc
      (H ^ 2 / s + H) * min s H = H ^ 2 * (min s H / s) + H * min s H := by ring
      _ ≤ H ^ 2 * 1 + H * H :=
        add_le_add (mul_le_mul_of_nonneg_left hu (sq_nonneg H))
          (mul_le_mul_of_nonneg_left (min_le_right _ _) hH0)
      _ = 2 * H ^ 2 := by ring
  have hpairScalar (A C H s Z b : ℝ) (hA : 0 ≤ A) (hC : 0 ≤ C)
      (hH : 1 ≤ H) (hs : 1 ≤ s) (hZ : 0 ≤ Z) (hb : 0 ≤ b)
      (hfirst : b ≤ A * (H ^ 2 / s + H))
      (hsecond : b ≤ 4 * C ^ 3 * Z * H ^ 2 / s) :
      b ^ 2 ≤ (4 * A ^ 2 + 8 * A * C ^ 3) * max (Z * H ^ 3) (H ^ 4) / s := by
    have hs0 : 0 < s := zero_lt_one.trans_le hs
    have hH0 : 0 ≤ H := zero_le_one.trans hH
    have hHsq : H ≤ H ^ 2 := by nlinarith only [hH]
    have hmax0 : 0 ≤ max (Z * H ^ 3) (H ^ 4) := (pow_nonneg hH0 4).trans (le_max_right _ _)
    by_cases hsmall : s ≤ H ^ 2
    · have ha : H ^ 2 / s ≤ H ^ 2 := div_le_self (sq_nonneg H) hs
      have hsum : H ^ 2 / s + 2 * H + s ≤ 4 * H ^ 2 := by
        linarith only [ha, hsmall, hHsq]
      have hsquare : (H ^ 2 / s + H) ^ 2 ≤ 4 * H ^ 4 / s := by
        apply (le_div_iff₀ hs0).mpr
        calc
          (H ^ 2 / s + H) ^ 2 * s = H ^ 2 * (H ^ 2 / s + 2 * H + s) := by
            field_simp
            ring
          _ ≤ H ^ 2 * (4 * H ^ 2) := mul_le_mul_of_nonneg_left hsum (sq_nonneg H)
          _ = 4 * H ^ 4 := by ring
      calc
        b ^ 2 ≤ (A * (H ^ 2 / s + H)) ^ 2 := pow_le_pow_left₀ hb hfirst 2
        _ = A ^ 2 * (H ^ 2 / s + H) ^ 2 := mul_pow _ _ _
        _ ≤ A ^ 2 * (4 * H ^ 4 / s) := mul_le_mul_of_nonneg_left hsquare (sq_nonneg A)
        _ ≤ A ^ 2 * (4 * max (Z * H ^ 3) (H ^ 4) / s) := by
          gcongr
          exact le_max_right _ _
        _ ≤ (4 * A ^ 2 + 8 * A * C ^ 3) * max (Z * H ^ 3) (H ^ 4) / s := by
          calc
            A ^ 2 * (4 * max (Z * H ^ 3) (H ^ 4) / s) =
                (4 * A ^ 2) * max (Z * H ^ 3) (H ^ 4) / s := by ring
            _ ≤ _ := div_le_div_of_nonneg_right
              (mul_le_mul_of_nonneg_right
                (le_add_of_nonneg_right (by positivity)) hmax0) hs0.le
    · have ha : H ^ 2 / s ≤ 1 := (div_le_one hs0).mpr (le_of_not_ge hsmall)
      have hfirst' : b ≤ 2 * A * H := by
        calc
          b ≤ A * (H ^ 2 / s + H) := hfirst
          _ ≤ A * (1 + H) := mul_le_mul_of_nonneg_left (add_le_add ha le_rfl) hA
          _ ≤ 2 * A * H := by nlinarith only [mul_nonneg hA (sub_nonneg.mpr hH)]
      calc
        b ^ 2 = b * b := pow_two b
        _ ≤ (2 * A * H) * (4 * C ^ 3 * Z * H ^ 2 / s) :=
          mul_le_mul hfirst' hsecond hb (by positivity)
        _ = 8 * A * C ^ 3 * (Z * H ^ 3) / s := by ring
        _ ≤ 8 * A * C ^ 3 * max (Z * H ^ 3) (H ^ 4) / s := by
          gcongr
          exact le_max_left _ _
        _ ≤ (4 * A ^ 2 + 8 * A * C ^ 3) * max (Z * H ^ 3) (H ^ 4) / s := by
          exact div_le_div_of_nonneg_right
            (mul_le_mul_of_nonneg_right
              (le_add_of_nonneg_left (by positivity)) hmax0) hs0.le
  have htailScales (x N Δ H g s Y q : ℝ)
      (hx : 1 ≤ x) (hN : 1 ≤ N) (hΔ : 0 < Δ) (hH : 1 ≤ H)
      (hg : 0 < g) (hs : 1 ≤ s) (hq : 0 < q)
      (hpower : 16 * C ^ 4 ≤ x ^ (100 * ε))
      (hΔupper : Δ ≤ C * N / (x ^ (50 * ε) * H ^ 2))
      (hY : |Y| ≤ 2 * C ^ 3 * x ^ (δ + 5 * ε) * H ^ 2 / g)
      (hcut : max s⁻¹ H⁻¹ *
        (x ^ (δ + 100 * ε) * H ^ 2 * N / (g * (x ^ (-5 * ε) * Δ))) < q) :
      |Y| / q ≤ 2 * C ^ 4 * min s H * x ^ (-150 * ε) / H ^ 2 ∧
      |Y| * N / (Δ * q) ≤ 2 * C ^ 3 * min s H * x ^ (-100 * ε) ∧
      4 * |Y| < q := by
    have hx0 : 0 < x := zero_lt_one.trans_le hx
    have hC0 : 0 < C := zero_lt_one.trans_le hC
    have hN0 : 0 < N := zero_lt_one.trans_le hN
    have hH0 : 0 < H := zero_lt_one.trans_le hH
    have hs0 : 0 < s := zero_lt_one.trans_le hs
    let u : ℝ := min s H
    have hu : 0 < u := lt_min hs0 hH0
    have huH : u ≤ H := min_le_right _ _
    have hinv : max s⁻¹ H⁻¹ = u⁻¹ :=
      (antitoneOn_inv_pos.map_min hs0 hH0).symm
    let A : ℝ := x ^ (δ + 100 * ε)
    let F : ℝ := x ^ (-5 * ε)
    have hA : 0 < A := Real.rpow_pos_of_pos hx0 _
    have hF : 0 < F := Real.rpow_pos_of_pos hx0 _
    have hTpos : 0 < u⁻¹ * (A * H ^ 2 * N / (g * (F * Δ))) := by positivity
    have hcut' : u⁻¹ * (A * H ^ 2 * N / (g * (F * Δ))) < q := by
      simpa only [hinv] using hcut
    have hqinv : q⁻¹ ≤ u * g * F * Δ / (A * H ^ 2 * N) := by
      calc
        q⁻¹ ≤ (u⁻¹ * (A * H ^ 2 * N / (g * (F * Δ))))⁻¹ :=
          (inv_le_inv₀ hq hTpos).mpr hcut'.le
        _ = u * g * F * Δ / (A * H ^ 2 * N) := by field_simp
    have hrpow : x ^ (δ + 5 * ε) * F / A = x ^ (-100 * ε) := by
      dsimp only [F, A]
      rw [← Real.rpow_add hx0, ← Real.rpow_sub hx0]
      congr 1
      ring
    have hsecond : |Y| * N / (Δ * q) ≤ 2 * C ^ 3 * u * x ^ (-100 * ε) := by
      calc
        |Y| * N / (Δ * q) = (|Y| * (N / Δ)) * q⁻¹ := by ring
        _ ≤ ((2 * C ^ 3 * x ^ (δ + 5 * ε) * H ^ 2 / g) * (N / Δ)) *
            (u * g * F * Δ / (A * H ^ 2 * N)) :=
          mul_le_mul (mul_le_mul_of_nonneg_right hY (div_nonneg hN0.le hΔ.le))
            hqinv (inv_nonneg.mpr hq.le) (by positivity)
        _ = (2 * C ^ 3 * u) * (x ^ (δ + 5 * ε) * F / A) := by field_simp
        _ = 2 * C ^ 3 * u * x ^ (-100 * ε) := by rw [hrpow]
    have hΔN : Δ / N ≤ C / (x ^ (50 * ε) * H ^ 2) := by
      apply (div_le_iff₀ hN0).mpr
      calc
        Δ ≤ C * N / (x ^ (50 * ε) * H ^ 2) := hΔupper
        _ = C / (x ^ (50 * ε) * H ^ 2) * N := by ring
    have hfirst : |Y| / q ≤ 2 * C ^ 4 * u * x ^ (-150 * ε) / H ^ 2 := by
      calc
        |Y| / q = (|Y| * N / (Δ * q)) * (Δ / N) := by
          field_simp
        _ ≤ (2 * C ^ 3 * u * x ^ (-100 * ε)) *
            (C / (x ^ (50 * ε) * H ^ 2)) :=
          mul_le_mul hsecond hΔN (div_nonneg hΔ.le hN0.le) (by positivity)
        _ = (2 * C ^ 4 * u / H ^ 2) * (x ^ (-100 * ε) / x ^ (50 * ε)) := by ring
        _ = 2 * C ^ 4 * u * x ^ (-150 * ε) / H ^ 2 := by
          rw [← Real.rpow_sub hx0]
          rw [show -100 * ε - 50 * ε = -150 * ε by ring]
          ring
    have hx150 : 16 * C ^ 4 ≤ x ^ (150 * ε) :=
      hpower.trans (Real.rpow_le_rpow_of_exponent_le hx (by linarith only [hε]))
    have hdecay : 2 * C ^ 4 * x ^ (-150 * ε) ≤ 1 / 8 := by
      rw [show -150 * ε = -(150 * ε) by ring, Real.rpow_neg hx0.le,
        ← div_eq_mul_inv]
      apply (div_le_iff₀ (Real.rpow_pos_of_pos hx0 _)).mpr
      linarith only [hx150]
    have huHsq : u ≤ H ^ 2 := huH.trans (by nlinarith only [hH])
    have hsmall : |Y| / q ≤ 1 / 8 := by
      calc
        |Y| / q ≤ 2 * C ^ 4 * u * x ^ (-150 * ε) / H ^ 2 := hfirst
        _ = (2 * C ^ 4 * x ^ (-150 * ε)) * (u / H ^ 2) := by ring
        _ ≤ (2 * C ^ 4 * x ^ (-150 * ε)) * 1 :=
          mul_le_mul_of_nonneg_left ((div_le_one (sq_pos_of_pos hH0)).mpr huHsq)
            (by positivity)
        _ ≤ 1 / 8 := by simpa only [mul_one] using hdecay
    refine ⟨hfirst, hsecond, ?_⟩
    have hb := (div_le_iff₀ hq).mp hsmall
    linarith only [hb, hq]
  let Pstar : ℝ := δ + 5 * ε + 3 * P + 2
  have hPstar : 0 < Pstar := by dsimp only [Pstar]; positivity
  have hPPstar : P ≤ Pstar := by
    dsimp only [Pstar]
    linarith only [hδ, hε, hP]
  let Aprofile : ℝ := CN ^ 2 * CD * (max 1 TD) ^ J₀
  obtain ⟨Cτ, hCτ, hτraw⟩ :=
    exists_card_divisors_bound (show 0 < ε / (2 * Pstar) by positivity)
  have hsmall : ∀ᶠ x : ℝ in Filter.atTop,
      ‖Aprofile * (Real.log x) ^ (2 * EN + ED)‖ ≤ ‖x ^ ε‖ := by
    simpa only [one_mul] using
      ((isLittleO_log_rpow_rpow_atTop (2 * EN + ED) hε).const_mul_left
        Aprofile).bound zero_lt_one
  have hthreshold : ∀ᶠ x : ℝ in Filter.atTop,
      Real.exp 1 ≤ x ∧ 8 * (TN + 1) * C ^ 3 ≤ x ∧
      16 * C ^ 4 ≤ x ^ (100 * ε) ∧ Cτ ≤ x ^ (ε / 2) ∧
      Aprofile * (Real.log x) ^ (2 * EN + ED) ≤ x ^ ε := by
    filter_upwards [Filter.eventually_ge_atTop (Real.exp 1),
      Filter.eventually_ge_atTop (8 * (TN + 1) * C ^ 3),
      (tendsto_rpow_atTop (show 0 < 100 * ε by positivity)).eventually_ge_atTop
        (16 * C ^ 4),
      (tendsto_rpow_atTop (half_pos hε)).eventually_ge_atTop Cτ,
      hsmall] with x hx hheight hpower htau hprofile
    have hx0 : 0 < x := (Real.exp_pos 1).trans_le hx
    refine ⟨hx, hheight, hpower, htau, ?_⟩
    exact (Real.le_norm_self _).trans
      (hprofile.trans_eq (Real.norm_of_nonneg (Real.rpow_nonneg hx0.le _)))
  obtain ⟨X, hX⟩ := Filter.eventually_atTop.mp hthreshold
  let Cfreq : ℝ := 4 * C ^ 2 + 4 * C + 1
  let Cdiff : ℝ := 4 * (2 * C) ^ 2 + 4 * (2 * C) + 1
  let Cdiag : ℝ := 2 * (C + TD) * (TN + 1) * Cfreq
  let Cmixed : ℝ := 4 * (C + TD) * (TN + 1) * Cdiff * (1 + 16 * C ^ 4 * TN)
  let Csame : ℝ := 32 * C ^ 5 * TN * (C + TD) * (TN + 1) * Cfreq
  let Ctail : ℝ := C * (Cdiag + Cmixed) + Csame
  let Cpair : ℝ := 4 * Cfreq ^ 2 + 8 * Cfreq * C ^ 3
  let K : ℝ := 1 + Ctail + Cpair
  have hC0 : 0 < C := zero_lt_one.trans_le hC
  have hTN : 0 < TN := hcN.trans_le hNT
  have hTD : 0 < TD := hcD.trans_le hDT
  have hCfreq : 0 < Cfreq := by dsimp only [Cfreq]; positivity
  have hCdiff : 0 < Cdiff := by dsimp only [Cdiff]; positivity
  have hCdiag : 0 < Cdiag := by dsimp only [Cdiag]; positivity
  have hCmixed : 0 < Cmixed := by dsimp only [Cmixed]; positivity
  have hCsame : 0 < Csame := by dsimp only [Csame]; positivity
  have hCtail : 0 < Ctail := by dsimp only [Ctail]; positivity
  have hCpair : 0 < Cpair := by dsimp only [Cpair]; positivity
  refine ⟨K, max (Real.exp 1) X, by dsimp only [K]; positivity, le_max_left _ _, ?_⟩
  intro x hx r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁ w₂ hr₁ hq₀ hu₁ hv₁ hv₂ hq₂
    m A B ℓ E N Δ d₀ H V hN hΔ hH hV hNx hHx hmx hΔupper hd₀lo hd₀hi
    hv₁V hv₂V hVupper J hJ ψN ψD hψNsupport hψDsupport hψNbound hψDbound
    Y j hj Δ₁ g s₂ φ L Ypairs R T maxSigmaFour
  obtain ⟨hxexp, hxheight, hxpower, hxτ, hxprofile⟩ :=
    hX x ((le_max_right _ _).trans hx)
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hx1 : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hxexp
  have hlog : 0 < Real.log x :=
    Real.log_pos ((Real.one_lt_exp_iff.mpr zero_lt_one).trans_le hxexp)
  have hN0 : 0 < N := zero_lt_one.trans_le hN
  have hΔ0 : 0 < Δ := zero_lt_one.trans_le hΔ
  have hH0 : 0 < H := zero_lt_one.trans_le hH
  have hm : 0 < m := by
    dsimp only [m]
    exact mul_pos (mul_pos (mul_pos (mul_pos hr₁ hq₀) hu₁)
      (Nat.lcm_pos hv₁ hv₂)) hq₂
  let : NeZero m := ⟨hm.ne'⟩
  have hg : 0 < g := Nat.gcd_pos_of_pos_left v₂ hv₁
  have hgs : (0 : ℝ) < g := by exact_mod_cast hg
  have hg1 : (1 : ℝ) ≤ g := by exact_mod_cast hg
  have hs₂ : 0 < s₂ := Nat.gcd_pos_of_pos_right w₂ hm
  have hs₂R : (0 : ℝ) < s₂ := by exact_mod_cast hs₂
  have hs₂one : (1 : ℝ) ≤ s₂ := by exact_mod_cast hs₂
  have hΔ₁ : 0 < Δ₁ := mul_pos (Real.rpow_pos_of_pos hx0 _) hΔ0
  have hΔ₁le : Δ₁ ≤ Δ := by
    apply mul_le_of_le_one_left hΔ0.le
    exact Real.rpow_le_one_of_one_le_of_nonpos hx1 (by linarith only [hε])
  have hxε : 1 ≤ x ^ ε := Real.one_le_rpow hx1 hε.le
  have htau (a : ℕ) (ha : 0 < a) (hax : (a : ℝ) ≤ x ^ Pstar) :
      (a.divisors.card : ℝ) ≤ x ^ ε := by
    have hρ : 0 < ε / (2 * Pstar) := by positivity
    have hrpow : (a : ℝ) ^ (ε / (2 * Pstar)) ≤ x ^ (ε / 2) := by
      calc
        (a : ℝ) ^ (ε / (2 * Pstar)) ≤
            (x ^ Pstar) ^ (ε / (2 * Pstar)) :=
          Real.rpow_le_rpow (Nat.cast_nonneg a) hax hρ.le
        _ = x ^ (ε / 2) := by
          rw [← Real.rpow_mul hx0.le]
          congr 1
          field_simp [hPstar.ne']
    calc
      (a.divisors.card : ℝ) ≤ Cτ * (a : ℝ) ^ (ε / (2 * Pstar)) :=
        hτraw a ha.ne'
      _ ≤ x ^ (ε / 2) * x ^ (ε / 2) :=
        mul_le_mul hxτ hrpow (Real.rpow_nonneg (Nat.cast_nonneg a) _) (by positivity)
      _ = x ^ ε := by rw [← Real.rpow_add hx0]; congr 1; ring
  have htaum : (m.divisors.card : ℝ) ≤ x ^ ε :=
    htau m hm (hmx.trans (Real.rpow_le_rpow_of_exponent_le hx1 hPPstar))
  let I : Finset ℤ := Finset.Icc (Int.ceil (cN * N)) (Int.floor (TN * N))
  let D : Finset ℕ := Finset.Icc 1 (Nat.floor ((C + TD) * Δ))
  let tD : ℕ → ℝ := fun d => ((d : ℝ) - d₀) / Δ₁
  let amp : ℕ → ℂ := fun d => ((ψD (tD d) * tD d ^ j : ℝ) : ℂ)
  have hIbound (n : ℤ) (hn : n ∈ I) :
      0 < (n : ℝ) ∧ |(n : ℝ)| ≤ TN * N := by
    obtain ⟨hlo, hhi⟩ := Finset.mem_Icc.mp hn
    have hn0 : 0 < (n : ℝ) := (mul_pos hcN hN0).trans_le (Int.ceil_le.mp hlo)
    exact ⟨hn0, by rw [abs_of_pos hn0]; exact Int.le_floor.mp hhi⟩
  have hIzero (n : ℤ) (hn : n ∉ I) : ψN ((n : ℝ) / N) = 0 := by
    by_contra hz
    have ht := hψNsupport hz
    exact hn (Finset.mem_Icc.mpr
      ⟨Int.ceil_le.mpr ((le_div_iff₀ hN0).mp ht.1),
        Int.le_floor.mpr ((div_le_iff₀ hN0).mp ht.2)⟩)
  have hIcard : (I.card : ℝ) ≤ (TN + 1) * N := by
    have hi := int_finset_card_le_of_mem_real_Icc I 0 (TN * N) (by positivity)
      (fun n hn => ⟨(hIbound n hn).1.le, (le_abs_self _).trans (hIbound n hn).2⟩)
    linarith only [hi, hN]
  have hDcard : (D.card : ℝ) ≤ (C + TD) * Δ := by
    simpa only [D, Nat.card_Icc, Nat.add_sub_cancel] using
      (Nat.floor_le (show 0 ≤ (C + TD) * Δ by positivity))
  have hDsupport (d : ℕ) (hd : ψD (tD d) ≠ 0) :
      Δ / C ≤ (d : ℝ) ∧ d ∈ D := by
    have hsupport := hψDsupport hd
    have htlo := (le_div_iff₀ hΔ₁).mp hsupport.1
    have hthi := (div_le_iff₀ hΔ₁).mp hsupport.2
    have hdlo : Δ / C ≤ (d : ℝ) := by
      linarith only [htlo, hd₀lo, mul_pos hcD hΔ₁]
    have hdhi : (d : ℝ) ≤ (C + TD) * Δ := by
      linarith only [hthi, hd₀hi, mul_le_mul_of_nonneg_left hΔ₁le hTD.le]
    have hd0 : 0 < d := by exact_mod_cast (div_pos hΔ0 hC0).trans_le hdlo
    exact ⟨hdlo, Finset.mem_Icc.mpr
      ⟨hd0, (Nat.le_floor_iff' hd0.ne').mpr hdhi⟩⟩
  have hampzero (d : ℕ) (hd : d ∉ D) : amp d = 0 := by
    have hψ : ψD (tD d) = 0 := by
      by_contra hn
      exact hd (hDsupport d hn).2
    simp only [amp, hψ, zero_mul, Complex.ofReal_zero]
  have hamplower (d : ℕ) (hd : amp d ≠ 0) : Δ / C ≤ (d : ℝ) := by
    apply (hDsupport d ?_).1
    intro hz
    apply hd
    simp only [amp, hz, zero_mul, Complex.ofReal_zero]
  have hampbound (d : ℕ) :
      ‖amp d‖ ≤ CD * (Real.log x) ^ ED * (max 1 TD) ^ J₀ := by
    by_cases hz : ψD (tD d) = 0
    · simp only [amp, hz, zero_mul, Complex.ofReal_zero, norm_zero]
      positivity
    · have ht := hψDsupport hz
      have ht0 : 0 ≤ tD d := hcD.le.trans ht.1
      have htp : |tD d| ^ j ≤ (max 1 TD) ^ J₀ := by
        calc
          |tD d| ^ j = tD d ^ j := by rw [abs_of_nonneg ht0]
          _ ≤ (max 1 TD) ^ j :=
            pow_le_pow_left₀ ht0 (ht.2.trans (le_max_right _ _)) j
          _ ≤ (max 1 TD) ^ J₀ := pow_le_pow_right₀ (le_max_left _ _) hj
      calc
        ‖amp d‖ = |ψD (tD d)| * |tD d| ^ j := by
          simp only [amp, Complex.norm_real, Real.norm_eq_abs, abs_mul, abs_pow]
        _ ≤ (CD * (Real.log x) ^ ED) * (max 1 TD) ^ J₀ :=
          mul_le_mul (hψDbound _) htp (pow_nonneg (abs_nonneg _) _) (by positivity)
  have hphasebound (c z : ZMod m) :
      ‖reciprocalUnitPhase m c z‖ ≤ 1 := by
    have hp := (reciprocalUnitPhase_and_product_norm m
      (fun _ => ∅) (fun _ _ => 0)).1 c z
    rw [hp]
    split_ifs <;> norm_num
  have hpairzero (p : ℤ × ℤ) (d : ℕ) (cut : WithTop ℝ) (n n' : ℤ)
      (hz : n ∉ I ∨ n' ∉ I) :
      sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
        (A.val : ℤ) (B.val : ℤ) ℓ E ψN N p.1 p.2 cut d n n' = 0 := by
    rcases hz with hz | hz <;>
      simp [sourceSecondaryPairTerm, hIzero _ hz]
  have hpairbound (p : ℤ × ℤ) (d : ℕ) (cut : WithTop ℝ) (n n' : ℤ) :
      ‖sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
        (A.val : ℤ) (B.val : ℤ) ℓ E ψN N p.1 p.2 cut d n n'‖ ≤
          CN ^ 2 * (Real.log x) ^ (2 * EN) := by
    simp only [sourceSecondaryPairTerm, dite_eq_right hm.ne']
    split_ifs <;> try { simp only [mul_zero, zero_mul, norm_zero]; positivity }
    simp only [one_mul, norm_mul, Complex.norm_real, Real.norm_eq_abs]
    calc
      |ψN ((n : ℝ) / N)| * |ψN ((n' : ℝ) / N)| *
          ‖reciprocalUnitPhase m _ _‖ ≤
            (CN * (Real.log x) ^ EN) * (CN * (Real.log x) ^ EN) * 1 :=
        mul_le_mul (mul_le_mul (hψNbound _) (hψNbound _)
          (abs_nonneg _) (by positivity)) (hphasebound _ _) (norm_nonneg _) (by positivity)
      _ = CN ^ 2 * (Real.log x) ^ (2 * EN) := by
        rw [show 2 * EN = EN + EN by ring, Real.rpow_add hlog]
        ring
  have hweightedbound (p : ℤ × ℤ) (d : ℕ) (cut : WithTop ℝ) (n n' : ℤ) :
      ‖amp d * sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
        (A.val : ℤ) (B.val : ℤ) ℓ E ψN N p.1 p.2 cut d n n'‖ ≤ x ^ ε := by
    rw [norm_mul]
    calc
      _ ≤ (CD * (Real.log x) ^ ED * (max 1 TD) ^ J₀) *
          (CN ^ 2 * (Real.log x) ^ (2 * EN)) :=
        mul_le_mul (hampbound d) (hpairbound p d cut n n') (norm_nonneg _) (by positivity)
      _ = Aprofile * (Real.log x) ^ (2 * EN + ED) := by
        rw [Real.rpow_add hlog]
        dsimp only [Aprofile]
        ring
      _ ≤ x ^ ε := hxprofile
  let Jval : (ℤ × ℤ) → ℕ → ℤ → ℤ → ℤ := fun p d n n' =>
    (p.1 * (n' + (B.val : ℤ) * (d : ℤ)) -
      p.2 * (n + (B.val : ℤ) * (d : ℤ))) / (d : ℤ)
  let dGate : (ℤ × ℤ) → ℕ → Prop := fun p d =>
    0 < d ∧ w₀ * w₁ ∣ d ∧
      Int.gcd ((d / w₁ : ℕ) : ℤ)
        (((m : ℤ) * p.1 * p.2) / (w₁ : ℤ) ^ 2) = 1
  let term : WithTop ℝ → ((ℤ × ℤ) × ℕ × ℤ × ℤ) → ℂ := fun cut t =>
    if dGate t.1 t.2.1 then
      amp t.2.1 * sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
        (A.val : ℤ) (B.val : ℤ) ℓ E ψN N t.1.1 t.1.2 cut t.2.1 t.2.2.1 t.2.2.2
    else 0
  let Full : Finset ((ℤ × ℤ) × ℕ × ℤ × ℤ) := Ypairs ×ˢ (D ×ˢ (I ×ˢ I))
  let Tail : Finset ((ℤ × ℤ) × ℕ × ℤ × ℤ) := Full.filter (fun t =>
    term ⊤ t ≠ 0 ∧ (T : WithTop ℝ) <
      ((Int.gcd (Jval t.1 t.2.1 t.2.2.1 t.2.2.2) (m : ℤ) : ℝ) : WithTop ℝ))
  have htermnorm (cut : WithTop ℝ) (t : (ℤ × ℤ) × ℕ × ℤ × ℤ) :
      ‖term cut t‖ ≤ x ^ ε := by
    dsimp only [term]
    split_ifs
    · exact hweightedbound t.1 t.2.1 cut t.2.2.1 t.2.2.2
    · simpa only [norm_zero] using (Real.rpow_nonneg hx0.le ε)
  have hpairfinite (p : ℤ × ℤ) (cut : WithTop ℝ) (d : ℕ) :
      (∑' n : ℤ, ∑' n' : ℤ,
        sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
          (A.val : ℤ) (B.val : ℤ) ℓ E ψN N p.1 p.2 cut d n n') =
        ∑ n ∈ I, ∑ n' ∈ I,
          sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
            (A.val : ℤ) (B.val : ℤ) ℓ E ψN N p.1 p.2 cut d n n' := by
    rw [tsum_eq_sum (s := I) (fun n hn => by
      simpa only [tsum_zero] using
        tsum_congr (fun n' => hpairzero p d cut n n' (Or.inl hn)))]
    apply Finset.sum_congr rfl
    intro n _hn
    exact tsum_eq_sum (s := I) (fun n' hn' => hpairzero p d cut n n' (Or.inr hn'))
  have hDfinite (p : ℤ × ℤ) (cut : WithTop ℝ) (d : ℕ) :
      sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
        (A.val : ℤ) (B.val : ℤ) ℓ E ψN ψD N Δ₁ d₀ j p.1 p.2 cut d =
        ∑ n ∈ I, ∑ n' ∈ I, term cut (p, d, n, n') := by
    change (if dGate p d then amp d *
      (∑' n : ℤ, ∑' n' : ℤ,
        sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
          (A.val : ℤ) (B.val : ℤ) ℓ E ψN N p.1 p.2 cut d n n') else 0) = _
    rw [hpairfinite]
    by_cases hd : dGate p d
    · simp only [term, ite_eq_left hd, Finset.mul_sum]
    · simp only [term, ite_eq_right hd, Finset.sum_const_zero]
  have hDtsum (p : ℤ × ℤ) (cut : WithTop ℝ) :
      (∑' d : ℕ,
        sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
          (A.val : ℤ) (B.val : ℤ) ℓ E ψN ψD N Δ₁ d₀ j p.1 p.2 cut d) =
        ∑ u ∈ D ×ˢ (I ×ˢ I), term cut (p, u) := by
    rw [tsum_eq_sum (s := D) (fun d hd => by
      rw [hDfinite]
      simp only [term, hampzero d hd, zero_mul, ite_self, Finset.sum_const_zero])]
    simp only [hDfinite, Finset.sum_product]
  have htermdata (t : (ℤ × ℤ) × ℕ × ℤ × ℤ) (ht : term ⊤ t ≠ 0) :
      0 < t.2.1 ∧ Δ / C ≤ (t.2.1 : ℝ) ∧
      Int.ModEq (t.2.1 : ℤ) (t.1.1 * t.2.2.2) (t.1.2 * t.2.2.1) ∧
      (t.2.1 : ℤ) * Jval t.1 t.2.1 t.2.2.1 t.2.2.2 =
        t.1.1 * (t.2.2.2 + (B.val : ℤ) * (t.2.1 : ℤ)) -
          t.1.2 * (t.2.2.1 + (B.val : ℤ) * (t.2.1 : ℤ)) ∧
      Int.gcd (t.2.2.1 + (B.val : ℤ) * (t.2.1 : ℤ)) (m : ℤ) = 1 ∧
      Int.gcd (t.2.2.2 + (B.val : ℤ) * (t.2.1 : ℤ)) (m : ℤ) = 1 := by
    have hd : dGate t.1 t.2.1 := by
      by_contra hbad
      exact ht (by simp only [term, ite_eq_right hbad])
    have hprod : amp t.2.1 *
        sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
          (A.val : ℤ) (B.val : ℤ) ℓ E ψN N t.1.1 t.1.2 ⊤ t.2.1 t.2.2.1 t.2.2.2 ≠ 0 := by
      simpa only [term, ite_eq_left hd] using ht
    have hamp := (mul_ne_zero_iff.mp hprod).1
    have hp := (mul_ne_zero_iff.mp hprod).2
    have hcond :
        Int.ModEq (t.2.1 : ℤ) (t.1.1 * t.2.2.2) (t.1.2 * t.2.2.1) ∧
        Int.gcd (t.2.2.1 * t.2.2.2) ((w₁ * r₁ * q₀ * u₁ * v₁ * v₂ : ℕ) : ℤ) = 1 ∧
        Int.gcd ((t.2.2.1 + ℓ * (t.2.1 : ℤ) * (r₁ : ℤ)) *
          (t.2.2.2 + ℓ * (t.2.1 : ℤ) * (r₁ : ℤ))) ((q₀ * q₂ : ℕ) : ℤ) = 1 := by
      by_contra hbad
      apply hp
      simp only [sourceSecondaryPairTerm, dite_eq_right hm.ne', le_top, and_true,
        ite_eq_right hbad]
    have hphase : reciprocalUnitPhase m
        (((A.val : ℤ) : ZMod m) * (Jval t.1 t.2.1 t.2.2.1 t.2.2.2 : ZMod m))
        (((t.2.2.1 + (B.val : ℤ) * (t.2.1 : ℤ) : ℤ) : ZMod m) *
          ((t.2.2.2 + (B.val : ℤ) * (t.2.1 : ℤ) : ℤ) : ZMod m)) ≠ 0 := by
      simp only [sourceSecondaryPairTerm, dite_eq_right hm.ne', le_top, and_true,
        ite_eq_left hcond] at hp
      exact (mul_ne_zero_iff.mp hp).2
    have hunit : IsUnit
        (((t.2.2.1 + (B.val : ℤ) * (t.2.1 : ℤ) : ℤ) : ZMod m) *
          ((t.2.2.2 + (B.val : ℤ) * (t.2.1 : ℤ) : ℤ) : ZMod m)) := by
      by_contra hbad
      apply hphase
      simp only [reciprocalUnitPhase, ite_eq_right hbad]
    have hunitgcd (z : ℤ) (hz : IsUnit (z : ZMod m)) : Int.gcd z (m : ℤ) = 1 :=
      (Int.gcd_comm z (m : ℤ)).trans
        (Int.isCoprime_iff_gcd_eq_one.mp ((ZMod.coe_int_isUnit_iff_isCoprime z m).mp hz))
    have hcross : (t.2.1 : ℤ) ∣
        t.1.1 * (t.2.2.2 + (B.val : ℤ) * (t.2.1 : ℤ)) -
          t.1.2 * (t.2.2.1 + (B.val : ℤ) * (t.2.1 : ℤ)) := by
      have hb := hcond.1.symm.dvd
      have he : (t.2.1 : ℤ) ∣ (t.2.1 : ℤ) * ((B.val : ℤ) * (t.1.1 - t.1.2)) :=
        dvd_mul_right _ _
      have heq :
          t.1.1 * (t.2.2.2 + (B.val : ℤ) * (t.2.1 : ℤ)) -
            t.1.2 * (t.2.2.1 + (B.val : ℤ) * (t.2.1 : ℤ)) =
          (t.1.1 * t.2.2.2 - t.1.2 * t.2.2.1) +
            (t.2.1 : ℤ) * ((B.val : ℤ) * (t.1.1 - t.1.2)) := by ring
      rw [heq]
      exact dvd_add hb he
    refine ⟨hd.1, hamplower t.2.1 hamp, hcond.1, ?_,
      hunitgcd _ (isUnit_of_mul_isUnit_left hunit),
      hunitgcd _ (isUnit_of_mul_isUnit_right hunit)⟩
    exact Int.mul_ediv_cancel' hcross
  have hpaircut (p : ℤ × ℤ) (cut : WithTop ℝ) (d : ℕ) (n n' : ℤ) :
      sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
        (A.val : ℤ) (B.val : ℤ) ℓ E ψN N p.1 p.2 cut d n n' =
        if ((Int.gcd (Jval p d n n') (m : ℤ) : ℝ) : WithTop ℝ) ≤ cut then
          sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁
            (A.val : ℤ) (B.val : ℤ) ℓ E ψN N p.1 p.2 ⊤ d n n'
        else 0 := by
    by_cases hc : ((Int.gcd (Jval p d n n') (m : ℤ) : ℝ) : WithTop ℝ) ≤ cut
    · dsimp only [Jval] at hc
      simp only [Jval, sourceSecondaryPairTerm, dite_eq_right hm.ne', hc, le_top,
        and_true, ite_true]
    · dsimp only [Jval] at hc
      simp only [Jval, sourceSecondaryPairTerm, dite_eq_right hm.ne', hc,
        and_false, ite_false]
  have htermcut (cut : WithTop ℝ) (t : (ℤ × ℤ) × ℕ × ℤ × ℤ) :
      term cut t =
        if ((Int.gcd (Jval t.1 t.2.1 t.2.2.1 t.2.2.2) (m : ℤ) : ℝ) : WithTop ℝ) ≤ cut
        then term ⊤ t else 0 := by
    dsimp only [term]
    by_cases hd : dGate t.1 t.2.1
    · rw [ite_eq_left hd, hpaircut t.1 cut t.2.1 t.2.2.1 t.2.2.2]
      simp only [ite_eq_left hd, mul_ite, mul_zero]
    · simp only [ite_eq_right hd, ite_self]
  have htermsplit (cut : WithTop ℝ) (t : (ℤ × ℤ) × ℕ × ℤ × ℤ) :
      term ⊤ t - term cut t =
        if cut < ((Int.gcd (Jval t.1 t.2.1 t.2.2.1 t.2.2.2) (m : ℤ) : ℝ) : WithTop ℝ)
        then term ⊤ t else 0 := by
    rw [htermcut cut t, sub_ite, sub_self, sub_zero, ← ite_not]
    simp only [not_le]
  have hdiffnorm (t : (ℤ × ℤ) × ℕ × ℤ × ℤ) :
      ‖term ⊤ t - term (T : WithTop ℝ) t‖ ≤
        if term ⊤ t ≠ 0 ∧ (T : WithTop ℝ) <
            ((Int.gcd (Jval t.1 t.2.1 t.2.2.1 t.2.2.2) (m : ℤ) : ℝ) : WithTop ℝ)
        then x ^ ε else 0 := by
    rw [htermsplit]
    by_cases hz : term ⊤ t = 0
    · simp only [hz, ite_self, norm_zero, ne_eq, not_true_eq_false, false_and, ite_false, le_refl]
    · by_cases hc : (T : WithTop ℝ) <
          ((Int.gcd (Jval t.1 t.2.1 t.2.2.1 t.2.2.2) (m : ℤ) : ℝ) : WithTop ℝ)
      · rw [ite_eq_left hc, ite_eq_left ⟨hz, hc⟩]
        exact htermnorm ⊤ t
      · simp only [hc, and_false, ite_false, norm_zero, le_refl]
  have hmaxpair (p : ℤ × ℤ) (hp : p ∈ Ypairs) :
      ‖∑ u ∈ D ×ˢ (I ×ˢ I), term (T : WithTop ℝ) (p, u)‖ ≤ maxSigmaFour := by
    rw [← hDtsum]
    have hNN := Finset.le_sup (s := Ypairs)
      (f := fun p => Real.toNNReal ‖∑' d : ℕ,
        sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
          (A.val : ℤ) (B.val : ℤ) ℓ E ψN ψD N Δ₁ d₀ j p.1 p.2
            (T : WithTop ℝ) d‖) hp
    simpa only [Real.coe_toNNReal _ (norm_nonneg _)] using NNReal.coe_le_coe.mpr hNN
  have htailweight :
      (∑ p ∈ Ypairs, ∑ u ∈ D ×ˢ (I ×ˢ I),
        if term ⊤ (p, u) ≠ 0 ∧ (T : WithTop ℝ) <
            ((Int.gcd (Jval p u.1 u.2.1 u.2.2) (m : ℤ) : ℝ) : WithTop ℝ)
        then x ^ ε else 0) = x ^ ε * (Tail.card : ℝ) := by
    rw [← Finset.sum_product']
    change (∑ t ∈ Full, if term ⊤ t ≠ 0 ∧ (T : WithTop ℝ) <
      ((Int.gcd (Jval t.1 t.2.1 t.2.2.1 t.2.2.2) (m : ℤ) : ℝ) : WithTop ℝ)
      then x ^ ε else 0) = _
    rw [← Finset.sum_filter]
    change (∑ _t ∈ Tail, x ^ ε) = _
    simp only [Finset.sum_const, nsmul_eq_mul, mul_comm]
  have hSigmaBound :
      sourceSigmaThree m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁ w₂
        (A.val : ℤ) (B.val : ℤ) ℓ E L ψN ψD N Δ₁ d₀ Y j ≤
          (Ypairs.card : ℝ) * maxSigmaFour + x ^ ε * (Tail.card : ℝ) := by
    have hpoint (p : ℤ × ℤ) (hp : p ∈ Ypairs) :
        ‖∑ u ∈ D ×ˢ (I ×ˢ I), term ⊤ (p, u)‖ ≤ maxSigmaFour +
          ∑ u ∈ D ×ˢ (I ×ˢ I),
            if term ⊤ (p, u) ≠ 0 ∧ (T : WithTop ℝ) <
                ((Int.gcd (Jval p u.1 u.2.1 u.2.2) (m : ℤ) : ℝ) : WithTop ℝ)
            then x ^ ε else 0 := by
      have h := norm_le_norm_add_norm_sub'
        (∑ u ∈ D ×ˢ (I ×ˢ I), term ⊤ (p, u))
        (∑ u ∈ D ×ˢ (I ×ˢ I), term (T : WithTop ℝ) (p, u))
      rw [← Finset.sum_sub_distrib] at h
      exact h.trans (add_le_add (hmaxpair p hp)
        (norm_sum_le_of_le _ (fun u _ => hdiffnorm (p, u))))
    change (∑ p ∈ Ypairs, ‖∑' d : ℕ,
      sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
        (A.val : ℤ) (B.val : ℤ) ℓ E ψN ψD N Δ₁ d₀ j p.1 p.2 ⊤ d‖) ≤ _
    simp_rw [hDtsum]
    simpa only [Finset.sum_add_distrib, Finset.sum_const, nsmul_eq_mul, htailweight] using
      Finset.sum_le_sum hpoint
  clear hpairfinite hDfinite hDtsum hpaircut htermcut htermsplit hdiffnorm
    hmaxpair htailweight htermnorm hweightedbound hpairbound hphasebound hpairzero
    hampbound hamplower hampzero hDsupport hIzero
  clear_value term Jval
  clear amp tD dGate
  let a : ℕ := v₂ / g
  let b : ℕ := v₁ / g
  have hab : a.Coprime b := by
    change Nat.Coprime (v₂ / Nat.gcd v₁ v₂) (v₁ / Nat.gcd v₁ v₂)
    exact (Nat.coprime_div_gcd_div_gcd (Nat.gcd_pos_of_pos_left v₂ hv₁)).symm
  have hag : (a : ℝ) * (g : ℝ) = (v₂ : ℝ) := by
    exact_mod_cast (Nat.div_mul_cancel (Nat.gcd_dvd_right v₁ v₂))
  have hbg : (b : ℝ) * (g : ℝ) = (v₁ : ℝ) := by
    exact_mod_cast (Nat.div_mul_cancel (Nat.gcd_dvd_left v₁ v₂))
  let height : ℝ := 2 * C ^ 3 * x ^ (δ + 5 * ε) * H ^ 2 / (g : ℝ)
  have hheight0 : 0 ≤ height := by dsimp only [height]; positivity
  have hLzero (y : ℤ) (hy : y ∈ L) : y ≠ 0 := (Finset.mem_erase.mp hy).1
  have hLheight (y : ℤ) (hy : y ∈ L) : |(y : ℝ)| ≤ height := by
    obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp (Finset.mem_erase.mp hy).2
    obtain ⟨hp₁, hp₂⟩ := Finset.mem_product.mp hp
    have habg : (a : ℝ) + (b : ℝ) ≤ 2 * C * V / (g : ℝ) := by
      apply (le_div_iff₀ hgs).mpr
      calc
        ((a : ℝ) + (b : ℝ)) * (g : ℝ) = (v₂ : ℝ) + (v₁ : ℝ) := by
          rw [add_mul, hag, hbg]
        _ ≤ 2 * C * V := by linarith only [hv₁V, hv₂V]
    calc
      |((φ p : ℤ) : ℝ)| = |(p.1 : ℝ) * (a : ℝ) - (p.2 : ℝ) * (b : ℝ)| := by
        simp only [φ, a, b, Int.cast_sub, Int.cast_mul, Int.cast_natCast]
      _ ≤ |(p.1 : ℝ)| * (a : ℝ) + |(p.2 : ℝ)| * (b : ℝ) := by
        simpa only [abs_mul, abs_of_nonneg (Nat.cast_nonneg a : (0 : ℝ) ≤ a),
          abs_of_nonneg (Nat.cast_nonneg b : (0 : ℝ) ≤ b)] using
          abs_sub ((p.1 : ℝ) * (a : ℝ)) ((p.2 : ℝ) * (b : ℝ))
      _ ≤ (C * H) * (a : ℝ) + (C * H) * (b : ℝ) :=
        add_le_add (mul_le_mul_of_nonneg_right (hJ p.1 hp₁) (Nat.cast_nonneg a))
          (mul_le_mul_of_nonneg_right (hJ p.2 hp₂) (Nat.cast_nonneg b))
      _ = C * H * ((a : ℝ) + (b : ℝ)) := by ring
      _ ≤ C * H * (2 * C * V / (g : ℝ)) :=
        mul_le_mul_of_nonneg_left habg (mul_nonneg hC0.le hH0.le)
      _ ≤ C * H * (2 * C * (C * x ^ (δ + 5 * ε) * H) / (g : ℝ)) :=
        mul_le_mul_of_nonneg_left
          (div_le_div_of_nonneg_right
            (mul_le_mul_of_nonneg_left hVupper (mul_nonneg zero_le_two hC0.le)) hgs.le)
          (mul_nonneg hC0.le hH0.le)
      _ = height := by dsimp only [height]; ring
  let Ls : Finset ℤ := L.filter (fun y => (s₂ : ℤ) ∣ y)
  have hLsfirst : (Ls.card : ℝ) ≤ Cfreq * (H ^ 2 / (s₂ : ℝ) + H) := by
    have hf := int_linear_image_dvd_card_le C H hC hH a b s₂ hab hs₂ J hJ
    have heq : (J ×ˢ J).image (fun p : ℤ × ℤ => (a : ℤ) * p.1 - (b : ℤ) * p.2) =
        (J ×ˢ J).image φ := by
      congr 1
      funext p
      dsimp only [φ, a, b]
      ring
    rw [heq] at hf
    calc
      (Ls.card : ℝ) ≤
          ((((J ×ˢ J).image φ).filter (fun y => (s₂ : ℤ) ∣ y)).card : ℝ) := by
        apply Nat.cast_le.mpr
        apply Finset.card_le_card
        intro y hy
        obtain ⟨hy, hd⟩ := Finset.mem_filter.mp hy
        exact Finset.mem_filter.mpr ⟨(Finset.mem_erase.mp hy).2, hd⟩
      _ ≤ Cfreq * (H ^ 2 / (s₂ : ℝ) + H) := hf
  have hLssecond : (Ls.card : ℝ) ≤
      4 * C ^ 3 * x ^ (δ + 10 * ε) * H ^ 2 / (s₂ : ℝ) := by
    have hf := int_nonzero_dvd_card_le Ls height hheight0 (s₂ : ℤ)
      (by exact_mod_cast hs₂) (by
        intro y hy
        obtain ⟨hy, hd⟩ := Finset.mem_filter.mp hy
        exact ⟨hLheight y hy, hLzero y hy, hd⟩)
    calc
      (Ls.card : ℝ) ≤ 2 * height / ((s₂ : ℤ) : ℝ) := hf
      _ = (4 * C ^ 3 * x ^ (δ + 5 * ε) * H ^ 2 / (s₂ : ℝ)) / (g : ℝ) := by
        dsimp only [height]
        push_cast
        ring
      _ ≤ 4 * C ^ 3 * x ^ (δ + 5 * ε) * H ^ 2 / (s₂ : ℝ) :=
        div_le_self (by positivity) hg1
      _ ≤ 4 * C ^ 3 * x ^ (δ + 10 * ε) * H ^ 2 / (s₂ : ℝ) :=
        div_le_div_of_nonneg_right
          (mul_le_mul_of_nonneg_right
            (mul_le_mul_of_nonneg_left
              (Real.rpow_le_rpow_of_exponent_le hx1 (by linarith only [hε]))
              (by positivity)) (sq_nonneg H)) hs₂R.le
  have hband (y : ℤ) (hlo : 1 ≤ (y : ℝ) / Y) (hhi : (y : ℝ) / Y < 2) :
      |Y| ≤ |(y : ℝ)| ∧ |(y : ℝ)| ≤ 2 * |Y| := by
    have hY : Y ≠ 0 := by
      intro hz
      simp only [hz, div_zero] at hlo
      norm_num at hlo
    have hYabs : 0 < |Y| := abs_pos.mpr hY
    have hratio : |(y : ℝ)| / |Y| = (y : ℝ) / Y :=
      (abs_div (y : ℝ) Y).symm.trans (abs_of_nonneg (zero_le_one.trans hlo))
    constructor
    · have h := (le_div_iff₀ hYabs).mp (hlo.trans_eq hratio.symm)
      simpa only [one_mul] using h
    · exact ((div_lt_iff₀ hYabs).mp (hratio.trans_lt hhi)).le
  have hpartdvd (y : ℤ) (hy : y ∈ L)
      (hpart : (∏ q ∈ m.primeFactors, q ^ y.natAbs.factorization q) = w₂) :
      (s₂ : ℤ) ∣ y := by
    have hp := primeFactors_prod_pow_factorization_dvd_and_coprime_div m y.natAbs hm.ne'
      (Int.natAbs_ne_zero.mpr (hLzero y hy))
    rw [hpart] at hp
    exact Int.natCast_dvd.mpr ((Nat.gcd_dvd_left w₂ m).trans hp.2.1)
  have hpairGeometry (p : ℤ × ℤ) (hp : p ∈ Ypairs) :
      p.1 ∈ Ls ∧ p.2 ∈ Ls ∧
      |Y| ≤ |(p.1 : ℝ)| ∧ |(p.1 : ℝ)| ≤ 2 * |Y| ∧
      |Y| ≤ |(p.2 : ℝ)| ∧ |(p.2 : ℝ)| ≤ 2 * |Y| := by
    obtain ⟨hLp, hplo, hphi, hp'lo, hp'hi, _hw, _hw', hpart, hpart'⟩ :=
      Finset.mem_filter.mp hp
    obtain ⟨hy, hy'⟩ := Finset.mem_product.mp hLp
    exact ⟨Finset.mem_filter.mpr ⟨hy, hpartdvd p.1 hy hpart⟩,
      Finset.mem_filter.mpr ⟨hy', hpartdvd p.2 hy' hpart'⟩,
      (hband p.1 hplo hphi).1, (hband p.1 hplo hphi).2,
      (hband p.2 hp'lo hp'hi).1, (hband p.2 hp'lo hp'hi).2⟩
  have hpaircard : (Ypairs.card : ℝ) ≤ Cpair * R / (s₂ : ℝ) := by
    have hsub : Ypairs ⊆ Ls ×ˢ Ls := by
      intro p hp
      exact Finset.mem_product.mpr ⟨(hpairGeometry p hp).1, (hpairGeometry p hp).2.1⟩
    calc
      (Ypairs.card : ℝ) ≤ ((Ls ×ˢ Ls).card : ℝ) := Nat.cast_le.mpr (Finset.card_le_card hsub)
      _ = (Ls.card : ℝ) ^ 2 := by rw [Finset.card_product, Nat.cast_mul, pow_two]
      _ ≤ Cpair * R / (s₂ : ℝ) :=
        hpairScalar Cfreq C H (s₂ : ℝ) (x ^ (δ + 10 * ε)) (Ls.card : ℝ)
          hCfreq.le hC0.le hH hs₂one (Real.rpow_nonneg hx0.le _) (Nat.cast_nonneg _)
          hLsfirst hLssecond
  let Jdiff : Finset ℤ := (J ×ˢ J).image (fun p => p.1 - p.2)
  let Z : Finset ℤ := ((L ×ˢ L).image (fun p => p.1 - p.2)).filter
    (fun z => z ≠ 0 ∧ (s₂ : ℤ) ∣ z)
  have hJdiff (h : ℤ) (hh : h ∈ Jdiff) : |(h : ℝ)| ≤ (2 * C) * H := by
    obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hh
    obtain ⟨hp₁, hp₂⟩ := Finset.mem_product.mp hp
    calc
      |((p.1 - p.2 : ℤ) : ℝ)| ≤ |(p.1 : ℝ)| + |(p.2 : ℝ)| := by
        rw [Int.cast_sub]
        exact abs_sub _ _
      _ ≤ C * H + C * H := add_le_add (hJ p.1 hp₁) (hJ p.2 hp₂)
      _ = (2 * C) * H := by ring
  have hZcard : (Z.card : ℝ) ≤ Cdiff * (H ^ 2 / (s₂ : ℝ) + H) := by
    have hf := int_linear_image_dvd_card_le (2 * C) H (by linarith only [hC])
      hH a b s₂ hab hs₂ Jdiff hJdiff
    calc
      (Z.card : ℝ) ≤
          ((((Jdiff ×ˢ Jdiff).image (fun p : ℤ × ℤ => (a : ℤ) * p.1 - (b : ℤ) * p.2)).filter
            (fun z => (s₂ : ℤ) ∣ z)).card : ℝ) := by
        apply Nat.cast_le.mpr
        apply Finset.card_le_card
        intro z hz
        obtain ⟨hz, _hne, hd⟩ := Finset.mem_filter.mp hz
        obtain ⟨⟨y, y'⟩, hyy', rfl⟩ := Finset.mem_image.mp hz
        obtain ⟨hy, hy'⟩ := Finset.mem_product.mp hyy'
        obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp (Finset.mem_erase.mp hy).2
        obtain ⟨p', hp', rfl⟩ := Finset.mem_image.mp (Finset.mem_erase.mp hy').2
        obtain ⟨hp₁, hp₂⟩ := Finset.mem_product.mp hp
        obtain ⟨hp'₁, hp'₂⟩ := Finset.mem_product.mp hp'
        refine Finset.mem_filter.mpr ⟨?_, hd⟩
        refine Finset.mem_image.mpr ⟨(p.1 - p'.1, p.2 - p'.2), ?_, ?_⟩
        · exact Finset.mem_product.mpr
            ⟨Finset.mem_image.mpr ⟨(p.1, p'.1), Finset.mem_product.mpr ⟨hp₁, hp'₁⟩, rfl⟩,
              Finset.mem_image.mpr ⟨(p.2, p'.2), Finset.mem_product.mpr ⟨hp₂, hp'₂⟩, rfl⟩⟩
        · dsimp only [φ, a, b]
          ring
      _ ≤ Cdiff * (H ^ 2 / (s₂ : ℝ) + H) := hf
  have hYheight (hpairs : Ypairs.Nonempty) : |Y| ≤ height := by
    obtain ⟨p, hp⟩ := hpairs
    have hpgeo := hpairGeometry p hp
    exact hpgeo.2.2.1.trans (hLheight p.1 (Finset.mem_filter.mp hpgeo.1).1)
  have hproductheight (p : ℤ × ℤ) (hp : p ∈ Ypairs) (n n' : ℤ)
      (hn : n ∈ I) (hn' : n' ∈ I) :
      (((p.2 * (n' - n)).natAbs : ℕ) : ℝ) ≤ x ^ Pstar := by
    have hpgeo := hpairGeometry p hp
    have hdiff : |((n' - n : ℤ) : ℝ)| ≤ 2 * TN * N := by
      rw [Int.cast_sub]
      exact (abs_sub (n' : ℝ) (n : ℝ)).trans (by
        have h := add_le_add (hIbound n' hn').2 (hIbound n hn).2
        linarith only [h])
    have hheight : |(p.2 : ℝ)| ≤ height := hLheight p.2 (Finset.mem_filter.mp hpgeo.2.1).1
    have hconst : 4 * TN * C ^ 3 ≤ x ^ 2 := by
      have hx2 : x ≤ x ^ 2 := by nlinarith only [hx1]
      have hCT : 4 * TN * C ^ 3 ≤ 8 * (TN + 1) * C ^ 3 := by
        nlinarith only [mul_nonneg (show 0 ≤ 4 * TN + 8 by positivity) (pow_nonneg hC0.le 3)]
      exact hCT.trans (hxheight.trans hx2)
    calc
      (((p.2 * (n' - n)).natAbs : ℕ) : ℝ) = |(p.2 : ℝ)| * |((n' - n : ℤ) : ℝ)| := by
        rw [Nat.cast_natAbs, Int.cast_abs, Int.cast_mul, abs_mul]
      _ ≤ height * (2 * TN * N) :=
        mul_le_mul hheight hdiff (abs_nonneg _) hheight0
      _ = (4 * TN * C ^ 3) * (x ^ (δ + 5 * ε) * H ^ 2 * N) / (g : ℝ) := by
        dsimp only [height]
        ring
      _ ≤ (4 * TN * C ^ 3) * (x ^ (δ + 5 * ε) * H ^ 2 * N) :=
        div_le_self (by positivity) hg1
      _ ≤ x ^ 2 * (x ^ (δ + 5 * ε) * (x ^ P) ^ 2 * x ^ P) :=
        mul_le_mul hconst
          (mul_le_mul
            (mul_le_mul_of_nonneg_left (pow_le_pow_left₀ hH0.le hHx 2)
              (Real.rpow_nonneg hx0.le _))
            hNx hN0.le (by positivity))
          (by positivity) (sq_nonneg x)
      _ = x ^ Pstar := by
        rw [← Real.rpow_mul_natCast hx0.le, ← Real.rpow_natCast, ← Real.rpow_add hx0,
          ← Real.rpow_add hx0, ← Real.rpow_add hx0]
        dsimp only [Pstar]
        congr 1
        ring
  clear hpairScalar hab hag hbg hheight0 hLheight hLssecond hband
    hpartdvd hJdiff hJ hNx hHx hv₁V hv₂V hVupper hxheight
  clear_value I D Ypairs L
  let Qtail : Finset ℕ := m.divisors.filter (fun q => T < (q : ℝ))
  let Fq : ℕ → Finset ((ℤ × ℤ) × ℕ × ℤ × ℤ) := fun q => Full.filter
    (fun t => term ⊤ t ≠ 0 ∧ (q : ℤ) ∣ Jval t.1 t.2.1 t.2.2.1 t.2.2.2)
  have hFull (t : (ℤ × ℤ) × ℕ × ℤ × ℤ) (ht : t ∈ Full) :
      t.1 ∈ Ypairs ∧ t.2.1 ∈ D ∧ t.2.2.1 ∈ I ∧ t.2.2.2 ∈ I := by
    simpa only [Full, Finset.mem_product] using ht
  have hFsource (q : ℕ) (t : (ℤ × ℤ) × ℕ × ℤ × ℤ) (ht : t ∈ Fq q) :
      t.1 ∈ Ypairs ∧ t.2.1 ∈ D ∧ t.2.2.1 ∈ I ∧ t.2.2.2 ∈ I ∧
      term ⊤ t ≠ 0 ∧ (q : ℤ) ∣ Jval t.1 t.2.1 t.2.2.1 t.2.2.2 := by
    obtain ⟨htFull, hne, hq⟩ := Finset.mem_filter.mp ht
    obtain ⟨hp, hd, hn, hn'⟩ := hFull t htFull
    exact ⟨hp, hd, hn, hn', hne, hq⟩
  have hFcross (q : ℕ) (t : (ℤ × ℤ) × ℕ × ℤ × ℤ) (ht : t ∈ Fq q) :
      (t.2.1 : ℤ) * (q : ℤ) ∣
        t.1.1 * (t.2.2.2 + (B.val : ℤ) * (t.2.1 : ℤ)) -
          t.1.2 * (t.2.2.1 + (B.val : ℤ) * (t.2.1 : ℤ)) := by
    have hs := hFsource q t ht
    have htd := htermdata t hs.2.2.2.2.1
    rw [← htd.2.2.2.1]
    exact mul_dvd_mul (dvd_refl _) hs.2.2.2.2.2
  have hQdata (q : ℕ) (hq : q ∈ Qtail) : 0 < q ∧ q ∣ m ∧ T < (q : ℝ) := by
    obtain ⟨hqm, hTq⟩ := Finset.mem_filter.mp hq
    have hdiv := (Nat.mem_divisors.mp hqm).1
    exact ⟨Nat.pos_of_dvd_of_pos hdiv hm, hdiv, hTq⟩
  have hQcard : (Qtail.card : ℝ) ≤ x ^ ε :=
    (Nat.cast_le.mpr (Finset.card_filter_le _ _)).trans htaum
  have htailcover : Tail ⊆ Qtail.biUnion Fq := by
    intro t ht
    obtain ⟨htFull, hne, hlarge⟩ := Finset.mem_filter.mp ht
    let q : ℕ := Int.gcd (Jval t.1 t.2.1 t.2.2.1 t.2.2.2) (m : ℤ)
    have hqm : q ∣ m := by
      exact_mod_cast Int.gcd_dvd_right (Jval t.1 t.2.1 t.2.2.1 t.2.2.2) (m : ℤ)
    have hTq : T < (q : ℝ) := by exact_mod_cast hlarge
    apply Finset.mem_biUnion.mpr
    refine ⟨q, Finset.mem_filter.mpr ⟨Nat.mem_divisors.mpr ⟨hqm, hm.ne'⟩, hTq⟩, ?_⟩
    exact Finset.mem_filter.mpr ⟨htFull, hne,
      Int.gcd_dvd_left (Jval t.1 t.2.1 t.2.2.1 t.2.2.2) (m : ℤ)⟩
  let u : ℝ := min (s₂ : ℝ) H
  have huone : 1 ≤ u := le_min hs₂one hH
  have hu0 : 0 ≤ u := zero_le_one.trans huone
  have hmincount : (H ^ 2 / (s₂ : ℝ) + H) * u ≤ 2 * H ^ 2 :=
    hmincensus (s₂ : ℝ) H hs₂one hH
  have hcoarsecount : H ^ 2 / (s₂ : ℝ) + H ≤ 2 * H ^ 2 := by
    have hs := div_le_self (sq_nonneg H) hs₂one
    have hHsq : H ≤ H ^ 2 := by nlinarith only [hH]
    linarith only [hs, hHsq]
  have hcardProductBound :
      (Ls.card : ℝ) * (D.card : ℝ) * (I.card : ℝ) ≤
        (Cfreq * (H ^ 2 / (s₂ : ℝ) + H)) * ((C + TD) * Δ) * ((TN + 1) * N) :=
    mul_le_mul
      (mul_le_mul hLsfirst hDcard (Nat.cast_nonneg _) (by positivity))
      hIcard (Nat.cast_nonneg _) (by positivity)
  have hΔscaled : x ^ ε * Δ * N * H ^ 2 ≤ C * x ^ (-49 * ε) * N ^ 2 := by
    calc
      x ^ ε * Δ * N * H ^ 2 ≤
          x ^ ε * (C * N / (x ^ (50 * ε) * H ^ 2)) * N * H ^ 2 :=
        mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_right
            (mul_le_mul_of_nonneg_left hΔupper (Real.rpow_nonneg hx0.le _)) hN0.le)
          (sq_nonneg H)
      _ = C * (x ^ ε / x ^ (50 * ε)) * N ^ 2 := by field_simp [hH0.ne']
      _ = C * x ^ (-49 * ε) * N ^ 2 := by
        rw [← Real.rpow_sub hx0, show ε - 50 * ε = -49 * ε by ring]
  have hFqbound (q : ℕ) (hq : q ∈ Qtail) :
      ((Fq q).card : ℝ) ≤ Ctail * x ^ (-49 * ε) * N ^ 2 := by
    rcases (Fq q).eq_empty_or_nonempty with hFempty | hFnonempty
    · rw [hFempty, Finset.card_empty, Nat.cast_zero]
      positivity
    obtain ⟨t₀, ht₀⟩ := hFnonempty
    have hpairs : Ypairs.Nonempty := ⟨t₀.1, (hFsource q t₀ ht₀).1⟩
    obtain ⟨hqpos, hqm, hqcut⟩ := hQdata q hq
    have hqR : (0 : ℝ) < q := by exact_mod_cast hqpos
    have hscales := htailScales x N Δ H (g : ℝ) (s₂ : ℝ) Y (q : ℝ)
      hx1 hN hΔ0 hH hgs hs₂one hqR hxpower hΔupper (hYheight hpairs) hqcut
    have hscale₁ : |Y| / (q : ℝ) ≤ 2 * C ^ 4 * u * x ^ (-150 * ε) / H ^ 2 := hscales.1
    have hscale₂ : |Y| * N / (Δ * (q : ℝ)) ≤ 2 * C ^ 3 * u * x ^ (-100 * ε) := hscales.2.1
    have hseparate : 4 * |Y| < (q : ℝ) := hscales.2.2
    have hnomiddle (t : (ℤ × ℤ) × ℕ × ℤ × ℤ) (ht : t ∈ Fq q)
        (hy : t.1.1 ≠ t.1.2) (hn : t.2.2.1 = t.2.2.2) : False := by
      have hs := hFsource q t ht
      have hp := hpairGeometry t.1 hs.1
      have htd := htermdata t hs.2.2.2.2.1
      have hcross : (q : ℤ) ∣
          (t.1.1 - t.1.2) * (t.2.2.1 + (B.val : ℤ) * (t.2.1 : ℤ)) := by
        have hc := (dvd_mul_of_dvd_right (dvd_refl (q : ℤ)) (t.2.1 : ℤ)).trans (hFcross q t ht)
        rw [← hn, ← sub_mul] at hc
        exact hc
      have hcopm : IsCoprime (m : ℤ) (t.2.2.1 + (B.val : ℤ) * (t.2.1 : ℤ)) :=
        (Int.isCoprime_iff_gcd_eq_one.mpr htd.2.2.2.2.1).symm
      have hqd : (q : ℤ) ∣ t.1.1 - t.1.2 :=
        (hcopm.of_isCoprime_of_dvd_left (by exact_mod_cast hqm)).dvd_of_dvd_mul_right hcross
      have hqle : (q : ℝ) ≤ |((t.1.1 - t.1.2 : ℤ) : ℝ)| := by
        have hqn := Nat.le_of_dvd (Int.natAbs_pos.mpr (sub_ne_zero.mpr hy))
          (Int.natCast_dvd.mp hqd)
        have hqr : (q : ℝ) ≤ ((t.1.1 - t.1.2).natAbs : ℝ) := by exact_mod_cast hqn
        simpa only [Nat.cast_natAbs, Int.cast_abs] using hqr
      have hdiff : |((t.1.1 - t.1.2 : ℤ) : ℝ)| ≤ 4 * |Y| := by
        rw [Int.cast_sub]
        exact (abs_sub (t.1.1 : ℝ) (t.1.2 : ℝ)).trans (by
          have h := add_le_add hp.2.2.2.1 hp.2.2.2.2.2
          linarith only [h])
      exact (not_lt_of_ge (hqle.trans hdiff)) hseparate
    let Fdiag := (Fq q).filter (fun t => t.1.1 = t.1.2 ∧ t.2.2.1 = t.2.2.2)
    let Fsame := (Fq q).filter (fun t => t.1.1 = t.1.2 ∧ t.2.2.1 ≠ t.2.2.2)
    let Fmixed := (Fq q).filter (fun t => t.1.1 ≠ t.1.2 ∧ t.2.2.1 ≠ t.2.2.2)
    have hthree : Fq q ⊆ (Fdiag ∪ Fsame) ∪ Fmixed := by
      intro t ht
      by_cases hy : t.1.1 = t.1.2
      · by_cases hn : t.2.2.1 = t.2.2.2
        · exact Finset.mem_union_left _
            (Finset.mem_union_left _ (Finset.mem_filter.mpr ⟨ht, hy, hn⟩))
        · exact Finset.mem_union_left _
            (Finset.mem_union_right _ (Finset.mem_filter.mpr ⟨ht, hy, hn⟩))
      · by_cases hn : t.2.2.1 = t.2.2.2
        · exact (hnomiddle t ht hy hn).elim
        · exact Finset.mem_union_right _ (Finset.mem_filter.mpr ⟨ht, hy, hn⟩)
    have hthreecard : ((Fq q).card : ℝ) ≤
        (Fdiag.card : ℝ) + (Fsame.card : ℝ) + (Fmixed.card : ℝ) := by
      have h : (Fq q).card ≤ Fdiag.card + Fsame.card + Fmixed.card :=
        (Finset.card_le_card hthree).trans
          ((Finset.card_union_le (s := Fdiag ∪ Fsame) (t := Fmixed)).trans
            (Nat.add_le_add_right (Finset.card_union_le (s := Fdiag) (t := Fsame)) _))
      exact_mod_cast h
    have hdiag : (Fdiag.card : ℝ) ≤ Cdiag * x ^ ε * Δ * N * H ^ 2 := by
      have hc := hdiagonalCount Fdiag Ls D I (by
        intro t ht
        obtain ⟨ht, hy, hn⟩ := Finset.mem_filter.mp ht
        have hs := hFsource q t ht
        exact ⟨(hpairGeometry t.1 hs.1).1, hs.2.1, hs.2.2.1, hy, hn⟩)
      calc
        (Fdiag.card : ℝ) ≤ (Ls.card : ℝ) * (D.card : ℝ) * (I.card : ℝ) := hc
        _ ≤ (Cfreq * (H ^ 2 / (s₂ : ℝ) + H)) * ((C + TD) * Δ) * ((TN + 1) * N) :=
          hcardProductBound
        _ = (Cfreq * (C + TD) * (TN + 1) * Δ * N) * (H ^ 2 / (s₂ : ℝ) + H) := by ring
        _ ≤ (Cfreq * (C + TD) * (TN + 1) * Δ * N) * (2 * H ^ 2) :=
          mul_le_mul_of_nonneg_left hcoarsecount (by positivity)
        _ = Cdiag * Δ * N * H ^ 2 := by dsimp only [Cdiag]; ring
        _ ≤ Cdiag * x ^ ε * Δ * N * H ^ 2 := by
          simpa only [mul_one] using
            mul_le_mul_of_nonneg_right
              (mul_le_mul_of_nonneg_right
                (mul_le_mul_of_nonneg_right
                  (mul_le_mul_of_nonneg_left hxε hCdiag.le) hΔ0.le) hN0.le)
              (sq_nonneg H)
    have hsame : (Fsame.card : ℝ) ≤ Csame * x ^ (-150 * ε) * N ^ 2 := by
      have hc := hsameYTailCount Fsame Ls D I q Δ C TN |Y| N
        hqpos hΔ0 hC hTN (abs_nonneg Y) hN0 (by
          intro t ht
          obtain ⟨ht, hy, hn⟩ := Finset.mem_filter.mp ht
          have hs := hFsource q t ht
          have hp := hpairGeometry t.1 hs.1
          have htd := htermdata t hs.2.2.2.2.1
          refine ⟨hp.1, hs.2.1, hs.2.2.1, hy,
            hLzero t.1.1 (Finset.mem_filter.mp hp.1).1, Ne.symm hn,
            htd.2.1, hp.2.2.2.1, (hIbound _ hs.2.2.1).2, (hIbound _ hs.2.2.2.1).2, ?_⟩
          convert hFcross q t ht using 1
          rw [← hy]
          ring)
      calc
        (Fsame.card : ℝ) ≤ (Ls.card : ℝ) * (D.card : ℝ) * (I.card : ℝ) *
            (8 * C * TN * |Y| * N / (Δ * (q : ℝ))) := hc
        _ ≤ (Cfreq * (H ^ 2 / (s₂ : ℝ) + H)) * ((C + TD) * Δ) *
            ((TN + 1) * N) * (8 * C * TN * |Y| * N / (Δ * (q : ℝ))) :=
          mul_le_mul_of_nonneg_right hcardProductBound (by positivity)
        _ = (8 * C * TN * (C + TD) * (TN + 1) * Cfreq * N ^ 2) *
            ((H ^ 2 / (s₂ : ℝ) + H) * (|Y| / (q : ℝ))) := by
          field_simp [hΔ0.ne']
        _ ≤ (8 * C * TN * (C + TD) * (TN + 1) * Cfreq * N ^ 2) *
            ((H ^ 2 / (s₂ : ℝ) + H) *
              (2 * C ^ 4 * u * x ^ (-150 * ε) / H ^ 2)) :=
          mul_le_mul_of_nonneg_left
            (mul_le_mul_of_nonneg_left hscale₁ (by positivity)) (by positivity)
        _ = (16 * C ^ 5 * TN * (C + TD) * (TN + 1) * Cfreq * x ^ (-150 * ε) * N ^ 2) *
            (((H ^ 2 / (s₂ : ℝ) + H) * u) / H ^ 2) := by ring
        _ ≤ (16 * C ^ 5 * TN * (C + TD) * (TN + 1) * Cfreq * x ^ (-150 * ε) * N ^ 2) * 2 := by
          apply mul_le_mul_of_nonneg_left _ (by positivity)
          exact (div_le_iff₀ (sq_pos_of_pos hH0)).mpr hmincount
        _ = Csame * x ^ (-150 * ε) * N ^ 2 := by dsimp only [Csame]; ring
    have hmixed : (Fmixed.card : ℝ) ≤ Cmixed * x ^ ε * Δ * N * H ^ 2 := by
      have hc := int_bilinear_congruence_card_le Fmixed D I Z q (B.val : ℤ) Δ C TN |Y| N
        (x ^ ε) hqpos hΔ0 hC hTN (abs_nonneg Y) hN0 (Real.rpow_nonneg hx0.le _)
        (by
          intro t ht
          obtain ⟨ht, hy, hn⟩ := Finset.mem_filter.mp ht
          have hs := hFsource q t ht
          have hp := hpairGeometry t.1 hs.1
          have htd := htermdata t hs.2.2.2.2.1
          have hZ : t.1.1 - t.1.2 ∈ Z := by
            apply Finset.mem_filter.mpr
            refine ⟨?_, sub_ne_zero.mpr hy, ?_⟩
            · exact Finset.mem_image.mpr ⟨t.1, Finset.mem_product.mpr
                ⟨(Finset.mem_filter.mp hp.1).1, (Finset.mem_filter.mp hp.2.1).1⟩, rfl⟩
            · exact dvd_sub (Finset.mem_filter.mp hp.1).2 (Finset.mem_filter.mp hp.2.1).2
          exact ⟨hs.2.1, htd.2.1, hs.2.2.2.1, hZ,
            hLzero t.1.2 (Finset.mem_filter.mp hp.2.1).1,
            sub_ne_zero.mpr (Ne.symm hn), hp.2.2.2.1, hp.2.2.2.2.2,
            (hIbound _ hs.2.2.1).2, (hIbound _ hs.2.2.2.1).2, hFcross q t ht⟩)
        (by
          intro t ht
          obtain ⟨ht, _hy, hn⟩ := Finset.mem_filter.mp ht
          have hs := hFsource q t ht
          have hp := hpairGeometry t.1 hs.1
          apply htau
          · exact Int.natAbs_pos.mpr (mul_ne_zero
              (hLzero t.1.2 (Finset.mem_filter.mp hp.2.1).1)
              (sub_ne_zero.mpr (Ne.symm hn)))
          · exact hproductheight t.1 hs.1 _ _ hs.2.2.1 hs.2.2.2.1)
      have hdecay : x ^ (-100 * ε) ≤ 1 :=
        Real.rpow_le_one_of_one_le_of_nonpos hx1 (by linarith only [hε])
      have hfactor : 1 + 8 * C * TN * |Y| * N / (Δ * (q : ℝ)) ≤
          (1 + 16 * C ^ 4 * TN) * u := by
        calc
          1 + 8 * C * TN * |Y| * N / (Δ * (q : ℝ)) =
              1 + (8 * C * TN) * (|Y| * N / (Δ * (q : ℝ))) := by ring
          _ ≤ 1 + (8 * C * TN) * (2 * C ^ 3 * u * x ^ (-100 * ε)) :=
            add_le_add le_rfl (mul_le_mul_of_nonneg_left hscale₂ (by positivity))
          _ ≤ 1 + (8 * C * TN) * (2 * C ^ 3 * u * 1) :=
            add_le_add le_rfl
              (mul_le_mul_of_nonneg_left
                (mul_le_mul_of_nonneg_left hdecay (by positivity)) (by positivity))
          _ = 1 + (16 * C ^ 4 * TN) * u := by ring
          _ ≤ u + (16 * C ^ 4 * TN) * u := add_le_add huone le_rfl
          _ = (1 + 16 * C ^ 4 * TN) * u := by ring
      calc
        (Fmixed.card : ℝ) ≤ (D.card : ℝ) * (I.card : ℝ) * (Z.card : ℝ) *
            (1 + 8 * C * TN * |Y| * N / (Δ * (q : ℝ))) * (2 * x ^ ε) := hc
        _ ≤ ((C + TD) * Δ) * ((TN + 1) * N) *
            (Cdiff * (H ^ 2 / (s₂ : ℝ) + H)) * ((1 + 16 * C ^ 4 * TN) * u) *
              (2 * x ^ ε) :=
          mul_le_mul_of_nonneg_right
            (mul_le_mul
              (mul_le_mul
                (mul_le_mul hDcard hIcard (Nat.cast_nonneg _) (by positivity))
                hZcard (Nat.cast_nonneg _) (by positivity))
              hfactor (by positivity) (by positivity))
            (mul_nonneg zero_le_two (Real.rpow_nonneg hx0.le _))
        _ = (2 * (C + TD) * (TN + 1) * Cdiff * (1 + 16 * C ^ 4 * TN) *
              x ^ ε * Δ * N) * ((H ^ 2 / (s₂ : ℝ) + H) * u) := by ring
        _ ≤ (2 * (C + TD) * (TN + 1) * Cdiff * (1 + 16 * C ^ 4 * TN) *
              x ^ ε * Δ * N) * (2 * H ^ 2) :=
          mul_le_mul_of_nonneg_left hmincount (by positivity)
        _ = Cmixed * x ^ ε * Δ * N * H ^ 2 := by dsimp only [Cmixed]; ring
    calc
      ((Fq q).card : ℝ) ≤ (Fdiag.card : ℝ) + (Fsame.card : ℝ) + (Fmixed.card : ℝ) := hthreecard
      _ ≤ Cdiag * x ^ ε * Δ * N * H ^ 2 + Csame * x ^ (-150 * ε) * N ^ 2 +
          Cmixed * x ^ ε * Δ * N * H ^ 2 := add_le_add (add_le_add hdiag hsame) hmixed
      _ = (Cdiag + Cmixed) * (x ^ ε * Δ * N * H ^ 2) +
          Csame * x ^ (-150 * ε) * N ^ 2 := by ring
      _ ≤ (Cdiag + Cmixed) * (C * x ^ (-49 * ε) * N ^ 2) +
          Csame * x ^ (-49 * ε) * N ^ 2 := by
        apply add_le_add
        · exact mul_le_mul_of_nonneg_left hΔscaled (add_nonneg hCdiag.le hCmixed.le)
        · exact mul_le_mul_of_nonneg_right
            (mul_le_mul_of_nonneg_left
              (Real.rpow_le_rpow_of_exponent_le hx1 (by linarith only [hε])) hCsame.le)
            (sq_nonneg N)
      _ = Ctail * x ^ (-49 * ε) * N ^ 2 := by dsimp only [Ctail]; ring
  have htailcard : (Tail.card : ℝ) ≤
      (Qtail.card : ℝ) * (Ctail * x ^ (-49 * ε) * N ^ 2) := by
    have hc : Tail.card ≤ ∑ q ∈ Qtail, (Fq q).card :=
      (Finset.card_le_card htailcover).trans Finset.card_biUnion_le
    calc
      (Tail.card : ℝ) ≤ ∑ q ∈ Qtail, ((Fq q).card : ℝ) := by exact_mod_cast hc
      _ ≤ (Qtail.card : ℝ) * (Ctail * x ^ (-49 * ε) * N ^ 2) := by
        simpa only [nsmul_eq_mul] using Finset.sum_le_card_nsmul _ _ _ hFqbound
  have htailfinal : x ^ ε * (Tail.card : ℝ) ≤ Ctail * x ^ (-47 * ε) * N ^ 2 := by
    calc
      x ^ ε * (Tail.card : ℝ) ≤
          x ^ ε * ((Qtail.card : ℝ) * (Ctail * x ^ (-49 * ε) * N ^ 2)) :=
        mul_le_mul_of_nonneg_left htailcard (Real.rpow_nonneg hx0.le _)
      _ ≤ x ^ ε * (x ^ ε * (Ctail * x ^ (-49 * ε) * N ^ 2)) :=
        mul_le_mul_of_nonneg_left
          (mul_le_mul_of_nonneg_right hQcard (by positivity))
          (Real.rpow_nonneg hx0.le _)
      _ = Ctail * ((x ^ ε * x ^ ε) * x ^ (-49 * ε)) * N ^ 2 := by ring
      _ = Ctail * x ^ (-47 * ε) * N ^ 2 := by
        rw [← Real.rpow_add hx0, ← Real.rpow_add hx0,
          show ε + ε + -49 * ε = -47 * ε by ring]
  have hKpair : Cpair ≤ K := by dsimp only [K]; linarith only [hCtail]
  have hKtail : Ctail ≤ K := by dsimp only [K]; linarith only [hCpair]
  have hR : 0 ≤ R := (pow_nonneg hH0.le 4).trans (le_max_right _ _)
  have hmaxSigmaFour : 0 ≤ maxSigmaFour := by positivity
  calc
    sourceSigmaThree m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁ w₂
        (A.val : ℤ) (B.val : ℤ) ℓ E L ψN ψD N Δ₁ d₀ Y j ≤
        (Ypairs.card : ℝ) * maxSigmaFour + x ^ ε * (Tail.card : ℝ) := hSigmaBound
    _ ≤ (Cpair * R / (s₂ : ℝ)) * maxSigmaFour + Ctail * x ^ (-47 * ε) * N ^ 2 :=
      add_le_add (mul_le_mul_of_nonneg_right hpaircard hmaxSigmaFour) htailfinal
    _ ≤ K * R / (s₂ : ℝ) * maxSigmaFour + K * x ^ (-47 * ε) * N ^ 2 :=
      add_le_add
        (mul_le_mul_of_nonneg_right
          (div_le_div_of_nonneg_right
            (mul_le_mul_of_nonneg_right hKpair hR) hs₂R.le) hmaxSigmaFour)
        (mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_right hKtail (Real.rpow_nonneg hx0.le _))
          (sq_nonneg N))

section
open UniqueFactorizationMonoid
open Classical in
theorem typeIII_comparable_lcm_kernel_sourceRange_bound
    (R : Finset ℕ) (Rlo Rhi : ℝ) (hRlo : 0 < Rlo) (hRhi : 0 ≤ Rhi)
    (hR : ∀ r ∈ R, Rlo ≤ (r : ℝ) ∧ (r : ℝ) ≤ Rhi)
    (M H Q b : ℝ) (hM : 0 ≤ M) (hH : 0 ≤ H)
    (hQ : 0 < Q) (hb : 0 < b) :
    let J := R.image (fun r : ℕ => Nat.log 2 r)
    let τR := J.sup (fun j : ℕ =>
      (Finset.Ico ((2 : ℕ) ^ j) (4 * (2 : ℕ) ^ j)).sup
        (fun r : ℕ => r.divisors.card))
    (∑ r₁ ∈ R, ∑ r₂ ∈ R,
      if r₁ ≤ 2 * r₂ ∧ r₂ ≤ 2 * r₁ then
        ((M ^ 2 + M * Real.sqrt (Nat.gcd r₁ r₂ : ℝ)) / (r₁ : ℝ) ^ 2) *
          (H * Real.sqrt (b * (r₁ : ℝ)) /
              Real.sqrt (Q * (Nat.lcm r₁ r₂ : ℝ)) +
            Real.sqrt (Q * (Nat.lcm r₁ r₂ : ℝ)) /
              Real.sqrt (b * (r₁ : ℝ)))
      else 0) ≤
      (M ^ 2 + M) *
        (96 * (τR : ℝ) * H * Real.sqrt b /
            (Real.sqrt Q * Real.sqrt Rlo) +
          72 * Real.sqrt Q * Real.sqrt Rhi / Real.sqrt b) := by
  intro J τR
  rcases R.eq_empty_or_nonempty with rfl | hRne
  · simp only [Finset.sum_empty]
    positivity
  have hpos (r : ℕ) (hr : r ∈ R) : 0 < r := by
    exact_mod_cast lt_of_lt_of_le hRlo (hR r hr).1
  have hJ : J.Nonempty := hRne.image (fun r : ℕ => Nat.log 2 r)
  let m := J.min' hJ
  let n := J.max' hJ
  let s : ℝ := Real.sqrt 2
  have hspos : 0 < s := Real.sqrt_pos_of_pos (by norm_num)
  have hslo : (4 : ℝ) / 3 ≤ s := by
    exact Real.le_sqrt_of_sq_le (by norm_num)
  have hsone : 1 < s := Real.one_lt_sqrt_two
  have hroot (j : ℕ) : Real.sqrt ((2 : ℝ) ^ j) = s ^ j := by
    simpa [s, NNReal.sqrtHom] using
      congrArg NNReal.toReal (map_pow NNReal.sqrtHom (2 : NNReal) j)
  have hinvnonneg : 0 ≤ s⁻¹ := inv_nonneg.mpr hspos.le
  have hinvle : s⁻¹ ≤ (3 : ℝ) / 4 := by
    rw [inv_eq_one_div, div_le_iff₀ hspos]
    nlinarith [hslo]
  have hinvlt : s⁻¹ < 1 := inv_lt_one_of_one_lt₀ hsone
  have hJinterval : J ⊆ Finset.Ico m (n + 1) := by
    intro j hj
    exact Finset.mem_Ico.mpr
      ⟨J.min'_le j hj, Nat.lt_succ_of_le (J.le_max' j hj)⟩
  have hJrange : J ⊆ Finset.range (n + 1) := by
    simpa only [Nat.Iio_eq_range] using hJinterval.trans Finset.Ico_subset_Iio_self
  have htail : (∑ j ∈ J, s⁻¹ ^ j) ≤ 4 * s⁻¹ ^ m := by
    calc
      _ ≤ ∑ j ∈ Finset.Ico m (n + 1), s⁻¹ ^ j :=
        Finset.sum_le_sum_of_subset_of_nonneg hJinterval
          (fun j _ _ => pow_nonneg hinvnonneg j)
      _ ≤ s⁻¹ ^ m / (1 - s⁻¹) :=
        geom_sum_Ico_le_of_lt_one hinvnonneg hinvlt
      _ ≤ 4 * s⁻¹ ^ m := by
        apply (div_le_iff₀ (sub_pos.mpr hinvlt)).2
        nlinarith [mul_nonneg (pow_nonneg hinvnonneg m)
          (show 0 ≤ 3 - 4 * s⁻¹ by linarith)]
  have hhead : (∑ j ∈ J, s ^ j) ≤ 4 * s ^ n := by
    calc
      _ ≤ ∑ j ∈ Finset.range (n + 1), s ^ j :=
        Finset.sum_le_sum_of_subset_of_nonneg hJrange
          (fun j _ _ => pow_nonneg hspos.le j)
      _ = (s ^ (n + 1) - 1) / (s - 1) :=
        geom_sum_eq (ne_of_gt hsone) _
      _ ≤ 4 * s ^ n := by
        apply (div_le_iff₀ (sub_pos.mpr hsone)).2
        rw [pow_succ]
        nlinarith [mul_nonneg (pow_nonneg hspos.le n)
          (show 0 ≤ 3 * s - 4 by linarith)]
  obtain ⟨r₀, hr₀, hlog₀⟩ := Finset.mem_image.mp
    (show m ∈ R.image (fun r : ℕ => Nat.log 2 r) from J.min'_mem hJ)
  obtain ⟨r₁, hr₁, hlog₁⟩ := Finset.mem_image.mp
    (show n ∈ R.image (fun r : ℕ => Nat.log 2 r) from J.max'_mem hJ)
  have hlo : Rlo ≤ 2 * (2 : ℝ) ^ m := by
    have h := Nat.lt_pow_succ_log_self (by decide : 1 < 2) r₀
    rw [hlog₀, pow_succ] at h
    have hcast : (r₀ : ℝ) < (2 : ℝ) ^ m * 2 := by exact_mod_cast h
    linarith [(hR r₀ hr₀).1]
  have hhi : (2 : ℝ) ^ n ≤ Rhi := by
    have h := Nat.pow_log_le_self 2 (hpos r₁ hr₁).ne'
    rw [hlog₁] at h
    exact le_trans (by exact_mod_cast h) (hR r₁ hr₁).2
  have hloRoot : Real.sqrt Rlo ≤ 2 * s ^ m := by
    apply Real.sqrt_le_iff.mpr ⟨by positivity, ?_⟩
    have hpow : (s ^ m) ^ 2 = (2 : ℝ) ^ m := by
      rw [← hroot m, Real.sq_sqrt (by positivity)]
    nlinarith [pow_nonneg (show (0 : ℝ) ≤ 2 by norm_num) m]
  have hsumInv :
      (∑ j ∈ J, 1 / Real.sqrt (((2 : ℕ) ^ j : ℕ) : ℝ)) ≤
        8 / Real.sqrt Rlo := by
    have h : (∑ j ∈ J, 1 / Real.sqrt ((2 : ℝ) ^ j)) ≤ 4 / s ^ m := by
      simpa only [hroot, one_div, inv_pow, div_eq_mul_inv, one_mul] using htail
    have hbound : 4 / s ^ m ≤ 8 / Real.sqrt Rlo := by
      apply (div_le_div_iff₀ (pow_pos hspos m) (Real.sqrt_pos.mpr hRlo)).2
      linarith
    simpa only [Nat.cast_pow, Nat.cast_ofNat] using h.trans hbound
  have hsumRoot :
      (∑ j ∈ J, Real.sqrt (((2 : ℕ) ^ j : ℕ) : ℝ)) ≤
        4 * Real.sqrt Rhi := by
    have h : (∑ j ∈ J, Real.sqrt ((2 : ℝ) ^ j)) ≤ 4 * s ^ n := by
      simpa only [hroot] using hhead
    have hbound : 4 * s ^ n ≤ 4 * Real.sqrt Rhi := by
      simpa only [hroot] using mul_le_mul_of_nonneg_left
        ((Real.sqrt_le_sqrt_iff hRhi).2 hhi) (by norm_num : (0 : ℝ) ≤ 4)
    simpa only [Nat.cast_pow, Nat.cast_ofNat] using h.trans hbound
  let block (j : ℕ) := Finset.Ico ((2 : ℕ) ^ j) (4 * (2 : ℕ) ^ j)
  let K (r₁ r₂ : ℕ) : ℝ :=
    ((M ^ 2 + M * Real.sqrt (Nat.gcd r₁ r₂ : ℝ)) / (r₁ : ℝ) ^ 2) *
      (H * Real.sqrt (b * (r₁ : ℝ)) /
          Real.sqrt (Q * (Nat.lcm r₁ r₂ : ℝ)) +
        Real.sqrt (Q * (Nat.lcm r₁ r₂ : ℝ)) / Real.sqrt (b * (r₁ : ℝ)))
  have hK (r₁ r₂ : ℕ) : 0 ≤ K r₁ r₂ := by
    dsimp only [K]
    positivity
  let P := (R ×ˢ R).filter (fun p => p.1 ≤ 2 * p.2 ∧ p.2 ≤ 2 * p.1)
  let e : ℕ × ℕ → Σ _ : ℕ, ℕ × ℕ := fun p => ⟨Nat.log 2 (min p.1 p.2), p⟩
  have hinj : Set.InjOn e (↑P : Set (ℕ × ℕ)) := by
    intro p _ q _ hpq
    exact congrArg (fun z : Σ _ : ℕ, ℕ × ℕ => z.2) hpq
  have hcover : P.image e ⊆ J.sigma (fun j => block j ×ˢ block j) := by
    intro z hz
    obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hz
    obtain ⟨hpR, hcomp₁, hcomp₂⟩ := Finset.mem_filter.mp hp
    obtain ⟨hp₁, hp₂⟩ := Finset.mem_product.mp hpR
    have hminR : min p.1 p.2 ∈ R := min_rec' (· ∈ R) hp₁ hp₂
    have hlow := Nat.pow_log_le_self 2 (hpos _ hminR).ne'
    have hupp : min p.1 p.2 < 2 * (2 : ℕ) ^ Nat.log 2 (min p.1 p.2) := by
      simpa only [pow_succ, Nat.mul_comm] using
        Nat.lt_pow_succ_log_self (by decide : 1 < 2) (min p.1 p.2)
    have hup₁ : p.1 < 4 * (2 : ℕ) ^ Nat.log 2 (min p.1 p.2) := by omega
    have hup₂ : p.2 < 4 * (2 : ℕ) ^ Nat.log 2 (min p.1 p.2) := by omega
    apply Finset.mem_sigma.mpr
    refine ⟨Finset.mem_image.mpr ⟨min p.1 p.2, hminR, rfl⟩, ?_⟩
    apply Finset.mem_product.mpr
    exact ⟨Finset.mem_Ico.mpr ⟨hlow.trans (min_le_left _ _), hup₁⟩,
      Finset.mem_Ico.mpr ⟨hlow.trans (min_le_right _ _), hup₂⟩⟩
  have hsumCover :
      (∑ p ∈ P, K p.1 p.2) ≤
        ∑ j ∈ J, ∑ r₁ ∈ block j, ∑ r₂ ∈ block j, K r₁ r₂ := by
    have h := Finset.sum_le_sum_of_injOn
      (f := fun p : ℕ × ℕ => K p.1 p.2)
      (g := fun z : Σ _ : ℕ, ℕ × ℕ => K z.2.1 z.2.2)
      e hinj hcover (fun _ _ => le_rfl) (fun _ _ _ => hK _ _)
    simpa only [Finset.sum_sigma, Finset.sum_product] using h
  let c₁ : ℝ := 12 * (τR : ℝ) * H * Real.sqrt b / Real.sqrt Q
  let c₂ : ℝ := 18 * Real.sqrt Q / Real.sqrt b
  have hc₁ : 0 ≤ c₁ := by
    dsimp only [c₁]
    positivity
  have hc₂ : 0 ≤ c₂ := by
    dsimp only [c₂]
    positivity
  have hMsum : 0 ≤ M ^ 2 + M := add_nonneg (sq_nonneg M) hM
  have hblock (j : ℕ) (hj : j ∈ J) :
      (∑ r₁ ∈ block j, ∑ r₂ ∈ block j, K r₁ r₂) ≤
        (M ^ 2 + M) *
          (c₁ * (1 / Real.sqrt (((2 : ℕ) ^ j : ℕ) : ℝ)) +
            c₂ * Real.sqrt (((2 : ℕ) ^ j : ℕ) : ℝ)) := by
    have h := typeIII_comparable_lcm_kernel_bound ((2 : ℕ) ^ j)
      (pow_pos (by decide : 0 < 2) j) M H Q b hM hH hQ hb
    have hτ :
        (((block j).sup (fun r : ℕ => r.divisors.card) : ℕ) : ℝ) ≤ (τR : ℝ) := by
      exact_mod_cast Finset.le_sup
        (f := fun j : ℕ => (block j).sup (fun r : ℕ => r.divisors.card)) hj
    calc
      _ ≤ (M ^ 2 + M) *
          (12 * (((block j).sup (fun r : ℕ => r.divisors.card) : ℕ) : ℝ) *
              H * Real.sqrt b /
                (Real.sqrt Q * Real.sqrt (((2 : ℕ) ^ j : ℕ) : ℝ)) +
            18 * Real.sqrt Q * Real.sqrt (((2 : ℕ) ^ j : ℕ) : ℝ) /
              Real.sqrt b) := h
      _ ≤ (M ^ 2 + M) *
          (12 * (τR : ℝ) * H * Real.sqrt b /
                (Real.sqrt Q * Real.sqrt (((2 : ℕ) ^ j : ℕ) : ℝ)) +
            18 * Real.sqrt Q * Real.sqrt (((2 : ℕ) ^ j : ℕ) : ℝ) /
              Real.sqrt b) := by
        gcongr
      _ = _ := by
        dsimp only [c₁, c₂]
        simp only [div_eq_mul_inv, mul_inv_rev, one_mul]
        ring
  change (∑ r₁ ∈ R, ∑ r₂ ∈ R,
    if r₁ ≤ 2 * r₂ ∧ r₂ ≤ 2 * r₁ then K r₁ r₂ else 0) ≤ _
  calc
    _ = ∑ p ∈ P, K p.1 p.2 := by
      simp only [P, Finset.sum_filter, Finset.sum_product]
    _ ≤ ∑ j ∈ J, ∑ r₁ ∈ block j, ∑ r₂ ∈ block j, K r₁ r₂ := hsumCover
    _ ≤ ∑ j ∈ J, (M ^ 2 + M) *
        (c₁ * (1 / Real.sqrt (((2 : ℕ) ^ j : ℕ) : ℝ)) +
          c₂ * Real.sqrt (((2 : ℕ) ^ j : ℕ) : ℝ)) :=
      Finset.sum_le_sum hblock
    _ = (M ^ 2 + M) *
        (c₁ * (∑ j ∈ J, 1 / Real.sqrt (((2 : ℕ) ^ j : ℕ) : ℝ)) +
          c₂ * (∑ j ∈ J, Real.sqrt (((2 : ℕ) ^ j : ℕ) : ℝ))) := by
      simp only [mul_add, Finset.sum_add_distrib, Finset.mul_sum]
    _ ≤ (M ^ 2 + M) *
        (c₁ * (8 / Real.sqrt Rlo) + c₂ * (4 * Real.sqrt Rhi)) := by
      apply mul_le_mul_of_nonneg_left _ hMsum
      exact add_le_add (mul_le_mul_of_nonneg_left hsumInv hc₁)
        (mul_le_mul_of_nonneg_left hsumRoot hc₂)
    _ = _ := by
      dsimp only [c₁, c₂]
      simp only [div_eq_mul_inv, mul_inv_rev]
      ring

open Classical in
theorem typeIII_selected_factor_second_moment_bound_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (b : ℕ+) (b₁ b₂ b₃ : ℕ)
    (hb₁ : 0 < b₁) (hb₂ : 0 < b₂) (hb₃ : 0 < b₃)
    (hb : (b : ℕ) = (radical (b₁ * b₂ * b₃) : ℕ))
    (D : Finset ℕ+) (hD : ∀ d ∈ D, Squarefree ((b : ℕ) * (d : ℕ)))
    (Q : ℝ) (hQ : 0 < Q)
    (hQrange : ∀ d ∈ D, Q ≤ (b : ℝ) * (d : ℝ) ∧
      (b : ℝ) * (d : ℝ) ≤ 2 * Q)
    (Y : Set.Ici (1 : ℝ)) (S : ℝ) (hS : 1 ≤ S)
    (ρ σ : ℕ+ → ℕ+) (hfactor : ∀ d ∈ D, d = ρ d * σ d)
    (hσ : ∀ d ∈ D,
      S / ((b : ℝ) * (Y : ℝ)) ≤ (σ d : ℝ) ∧ (σ d : ℝ) ≤ S)
    (a₀ : ℤ) (a : ∀ d : ℕ+, (ZMod ((b : ℕ) * (d : ℕ)))ˣ)
    (ha : ∀ d ∈ D,
      (a d : ZMod ((b : ℕ) * (d : ℕ))) = (a₀ : ZMod ((b : ℕ) * (d : ℕ))))
    (M₀ M₁ : ℤ) (hM₀ : 0 < M₀) (M : ℝ) (hM : 0 ≤ M)
    (hMwidth : (M₁ : ℝ) - (M₀ : ℝ) ≤ M)
    (η : ℕ → ℂ) (α : ℤ → ℂ)
    (Wη Wα : ℝ) (hWη : 0 ≤ Wη) (hWα : 0 ≤ Wα)
    (hη : ∀ d ∈ D, ‖η ((b : ℕ) * (d : ℕ))‖ ≤ Wη)
    (hα : ∀ m ∈ Finset.Icc M₀ M₁, ‖α m‖ ≤ Wα)
    (x H ε Tψ Lw : ℝ) (hx : 0 < x) (hH : 0 < H)
    (hTψ : 1 ≤ Tψ) (hLw : 0 ≤ Lw)
    (ψ : ℝ → ℝ) (hψ : ContDiff ℝ 2 ψ)
    (hψnonneg : ∀ t : ℝ, 0 ≤ ψ t)
    (hψone : ∀ t ∈ Set.Icc (-1 : ℝ) 1, ψ t = 1)
    (hψsupport : Function.support ψ ⊆ Set.Icc (-Tψ) Tψ)
    (hψbound : ∀ t : ℝ,
      ‖ψ t‖ ≤ Lw ∧ ‖deriv ψ t‖ ≤ Lw ∧ ‖deriv (deriv ψ) t‖ ≤ Lw) :
    let I : Finset ℤ := Finset.Icc M₀ M₁
    let Dmax : ℕ := D.sup (fun d : ℕ+ => (d : ℕ))
    let Mmax : ℕ := I.sup (fun m : ℤ => m.natAbs)
    let Nτ : ℕ := max (4 * Dmax) (2 * Dmax ^ 3 * Mmax)
    let τ : ℕ := max 1 ((Finset.Icc 1 Nτ).sup (fun n : ℕ => n.divisors.card))
    let Ω : ℕ := D.sup (fun d : ℕ+ => (d : ℕ).primeFactors.card)
    let Hb : ℝ := x ^ (3 * ε / 2) * H / ((b₁ * b₂ * b₃ : ℕ) : ℝ)
    let E : Finset ℤ := Finset.Icc (Int.ceil (-Tψ * Hb)) (Int.floor (Tψ * Hb))
    let 𝒮 : Finset ℕ+ := D.image σ
    let ℛ : ℕ+ → Finset ℕ+ := fun s => (D.filter (fun d => σ d = s)).image ρ
    let P : ℕ := ∏ d ∈ D, (d : ℕ)
    let c : ZMod P := (a₀ : ZMod P) * ((b₁ * b₂ * b₃ : ℕ) : ZMod P) *
      (((b : ℕ) : ZMod P)⁻¹) ^ 3
    let A : ℤ := (c.val : ℤ)
    let F : ℕ+ → ℤ → ℂ := fun s ℓ =>
      ∑ r ∈ ℛ s,
        if Int.gcd (((b : ℕ) : ℤ) * ℓ) (((r : ℕ) * (s : ℕ) : ℕ) : ℤ) = 1 then
          η ((b : ℕ) * (r : ℕ) * (s : ℕ)) *
            ∑ m ∈ I,
              if Int.gcd m (((b : ℕ) * (r : ℕ) * (s : ℕ) : ℕ) : ℤ) = 1 then
                α m * normalizedKloosterman3Mod ((r : ℕ) * (s : ℕ))
                  (((A : ZMod ((r : ℕ) * (s : ℕ))) *
                    (m : ZMod ((r : ℕ) * (s : ℕ)))⁻¹) *
                    (ℓ : ZMod ((r : ℕ) * (s : ℕ))))
              else 0
        else 0
    let U : ℕ+ → ℕ+ → ℕ+ → ℤ → ℤ → ℂ := fun r₁ r₂ s m₁ m₂ =>
      ∑ ℓ ∈ E,
        if IsUnit (ℓ : ZMod ((s : ℕ) * Nat.lcm (r₁ : ℕ) (r₂ : ℕ))) then
          (ψ ((ℓ : ℝ) / Hb) : ℂ) *
            normalizedKloosterman3Mod ((r₁ : ℕ) * (s : ℕ))
              (((A : ZMod ((r₁ : ℕ) * (s : ℕ))) *
                (m₁ : ZMod ((r₁ : ℕ) * (s : ℕ)))⁻¹) *
                (ℓ : ZMod ((r₁ : ℕ) * (s : ℕ)))) *
            star (normalizedKloosterman3Mod ((r₂ : ℕ) * (s : ℕ))
              (((A : ZMod ((r₂ : ℕ) * (s : ℕ))) *
                (m₂ : ZMod ((r₂ : ℕ) * (s : ℕ)))⁻¹) *
                (ℓ : ZMod ((r₂ : ℕ) * (s : ℕ)))))
        else 0
    let V : ℕ+ → ℕ+ → ℕ+ → ℤ → ℤ → ℝ := fun r₁ r₂ s m₁ m₂ =>
      if Int.gcd m₁ (((b : ℕ) * (r₁ : ℕ) * (s : ℕ) : ℕ) : ℤ) = 1 ∧
          Int.gcd m₂ (((b : ℕ) * (r₂ : ℕ) * (s : ℕ) : ℕ) : ℤ) = 1 then
        (s : ℝ) * ‖η ((b : ℕ) * (r₁ : ℕ) * (s : ℕ))‖ *
          ‖η ((b : ℕ) * (r₂ : ℕ) * (s : ℕ))‖ *
          ‖α m₁‖ * ‖α m₂‖ * ‖U r₁ r₂ s m₁ m₂‖
      else 0
    let T₂ : ℝ := ∑ s ∈ 𝒮, ∑ ℓ ∈ E, (s : ℝ) * ψ ((ℓ : ℝ) / Hb) * ‖F s ℓ‖ ^ 2
    let B₂ : ℝ := ∑ s ∈ 𝒮, ∑ r₁ ∈ ℛ s, ∑ r₂ ∈ ℛ s, ∑ m₁ ∈ I, ∑ m₂ ∈ I,
      V r₁ r₂ s m₁ m₂
    let B₀ : ℝ := ∑ s ∈ 𝒮, ∑ r₁ ∈ ℛ s, ∑ r₂ ∈ ℛ s, ∑ m₁ ∈ I, ∑ m₂ ∈ I,
      if (r₁ : ℤ) ^ 3 * m₁ - (r₂ : ℤ) ^ 3 * m₂ = 0 then V r₁ r₂ s m₁ m₂ else 0
    let B₁ : ℝ := ∑ s ∈ 𝒮, ∑ r₁ ∈ ℛ s, ∑ r₂ ∈ ℛ s, ∑ m₁ ∈ I, ∑ m₂ ∈ I,
      if (r₁ : ℤ) ^ 3 * m₁ - (r₂ : ℤ) ^ 3 * m₂ ≠ 0 then V r₁ r₂ s m₁ m₂ else 0
    let Dscale : ℝ :=
      2 * Wη ^ 2 * Wα ^ 2 * Lw * (2 * Tψ * Hb + 1) *
        (9 : ℝ) ^ Ω * (τ : ℝ) * (M + 1) * Q * S / (b : ℝ)
    let Oscale : ℝ :=
      (6 * (2 * Tψ + 3)) * Lw * Wη ^ 2 * Wα ^ 2 *
        (9 : ℝ) ^ (2 * Ω) * (τ : ℝ) ^ 2 * ((M + 1) ^ 2 + (M + 1)) *
          (768 * (τ : ℝ) * Hb * Q * Real.sqrt S / (b : ℝ) +
            576 * Real.sqrt (2 * (b : ℝ) * (Y : ℝ)) * Q ^ 3 /
              ((b : ℝ) ^ 3 * Real.sqrt S))
    0 < Hb ∧
      (I.card : ℝ) ≤ M + 1 ∧
      (E.card : ℝ) ≤ 2 * Tψ * Hb + 1 ∧
      (∀ s ∈ 𝒮, ∀ r ∈ ℛ s,
        Q / ((b : ℝ) * (s : ℝ)) ≤ (r : ℝ) ∧
          (r : ℝ) ≤ 2 * Q / ((b : ℝ) * (s : ℝ))) ∧
      0 ≤ T₂ ∧ T₂ ≤ B₂ ∧ B₂ = B₀ + B₁ ∧
      B₀ ≤ Dscale ∧ B₁ ≤ Oscale ∧
      B₂ ≤ Dscale + Oscale ∧ T₂ ≤ Dscale + Oscale := by
  have hdiag
      (R : Finset ℕ+) (I : Finset ℤ) (S : ℕ+ → Finset ℕ+)
      (hR : ∀ r ∈ R, Squarefree (r : ℕ))
      (hI : ∀ m ∈ I, 0 < m)
      (hS : ∀ r ∈ R, ∀ s ∈ S r, Squarefree (s : ℕ))
      (hcop : ∀ r ∈ R, ∀ s ∈ S r, Nat.Coprime (r : ℕ) (s : ℕ))
      (A : ℤ)
      (hA : ∀ r₁ ∈ R, ∀ r₂ ∈ R, ∀ s ∈ S r₁, s ∈ S r₂ →
        IsUnit (A : ZMod ((s : ℕ) * Nat.lcm (r₁ : ℕ) (r₂ : ℕ))))
      (α : ℤ → ℂ) (η : ℕ+ → ℕ+ → ℂ)
      (Wα Wη : ℝ) (hWα : 0 ≤ Wα) (hWη : 0 ≤ Wη)
      (hα : ∀ m ∈ I, ‖α m‖ ≤ Wα)
      (hη : ∀ r ∈ R, ∀ s ∈ S r, ‖η r s‖ ≤ Wη)
      (T Lw H : ℝ) (hT : 0 ≤ T) (hLw : 0 ≤ Lw) (hH : 0 < H)
      (ψ : ℝ → ℂ)
      (hsupport : Function.support ψ ⊆ Set.Icc (-T) T)
      (hbound : ∀ t : ℝ, ‖ψ t‖ ≤ Lw) :
      let L := Finset.Icc (Int.ceil (-T * H)) (Int.floor (T * H))
      let τ := (R ×ˢ I).sup (fun rm : ℕ+ × ℤ =>
        ((rm.1 : ℕ) ^ 3 * rm.2.natAbs).divisors.card)
      let Ω := R.sup (fun r => (S r).sup (fun s =>
        ((r : ℕ) * (s : ℕ)).primeFactors.card))
      let U : ℕ+ → ℕ+ → ℕ+ → ℤ → ℤ → ℂ := fun r₁ r₂ s m₁ m₂ =>
        ∑ ℓ ∈ L,
          if IsUnit (ℓ : ZMod ((s : ℕ) * Nat.lcm (r₁ : ℕ) (r₂ : ℕ))) then
            ψ ((ℓ : ℝ) / H) *
              normalizedKloosterman3Mod ((r₁ : ℕ) * (s : ℕ))
                (((A : ZMod ((r₁ : ℕ) * (s : ℕ))) *
                  (m₁ : ZMod ((r₁ : ℕ) * (s : ℕ)))⁻¹) *
                  (ℓ : ZMod ((r₁ : ℕ) * (s : ℕ)))) *
              star (normalizedKloosterman3Mod ((r₂ : ℕ) * (s : ℕ))
                (((A : ZMod ((r₂ : ℕ) * (s : ℕ))) *
                  (m₂ : ZMod ((r₂ : ℕ) * (s : ℕ)))⁻¹) *
                  (ℓ : ZMod ((r₂ : ℕ) * (s : ℕ)))))
          else 0
      (∑ r₁ ∈ R, ∑ m₁ ∈ I, ∑ s ∈ S r₁, ∑ r₂ ∈ R, ∑ m₂ ∈ I,
        if s ∈ S r₂ ∧
            IsUnit (m₁ : ZMod ((r₁ : ℕ) * (s : ℕ))) ∧
            IsUnit (m₂ : ZMod ((r₂ : ℕ) * (s : ℕ))) ∧
            (r₁ : ℤ) ^ 3 * m₁ - (r₂ : ℤ) ^ 3 * m₂ = 0
        then (s : ℝ) * ‖η r₁ s‖ * ‖η r₂ s‖ * ‖α m₁‖ * ‖α m₂‖ *
          ‖U r₁ r₂ s m₁ m₂‖ else 0) ≤
        Wη ^ 2 * Wα ^ 2 * Lw * (L.card : ℝ) * (9 : ℝ) ^ Ω *
          (τ : ℝ) * (I.card : ℝ) *
            ∑ r ∈ R, ((S r).card : ℝ) * (((S r).sup PNat.val : ℕ) : ℝ) := by
    clear * - hDeligne hR hI hS hcop hA hWα hWη hα hη hT hLw hH hsupport hbound
    intro L τ Ω U
    let RN : Finset ℕ := R.image PNat.val
    let IN : Finset ℕ := I.image Int.toNat
    let SN : ℕ → Finset ℕ := fun r => (S r.toPNat').image PNat.val
    let τN : ℕ := (RN ×ˢ IN).sup
      (fun rm : ℕ × ℕ => (rm.1 ^ 3 * rm.2).divisors.card)
    let ΩN : ℕ := RN.sup (fun r => (SN r).sup (fun s => (r * s).primeFactors.card))
    let V : ℕ+ → ℕ+ → ℕ+ → ℤ → ℤ → ℝ := fun r₁ r₂ s m₁ m₂ =>
      if s ∈ S r₂ ∧
          IsUnit (m₁ : ZMod ((r₁ : ℕ) * (s : ℕ))) ∧
          IsUnit (m₂ : ZMod ((r₂ : ℕ) * (s : ℕ))) ∧
          (r₁ : ℤ) ^ 3 * m₁ - (r₂ : ℤ) ^ 3 * m₂ = 0
      then (s : ℝ) * ‖η r₁ s‖ * ‖η r₂ s‖ * ‖α m₁‖ * ‖α m₂‖ *
        ‖U r₁ r₂ s m₁ m₂‖ else 0
    have hUnitInt (q q' : ℕ) (hq : q = q') (z : ℤ) :
        IsUnit (z : ZMod q) ↔ IsUnit (z : ZMod q') := by
      subst q'
      rfl
    have hUnitNat (q q' : ℕ) (hq : q = q') (m : ℕ) :
        IsUnit (m : ZMod q) ↔ IsUnit (m : ZMod q') := by
      subst q'
      rfl
    have hKlCast (q q' : ℕ) [NeZero q] [NeZero q']
        (hq : q = q') (m : ℕ) (ℓ : ℤ) :
        normalizedKloosterman3Mod q
            (((A : ZMod q) * (m : ZMod q)⁻¹) * (ℓ : ZMod q)) =
          normalizedKloosterman3Mod q'
            (((A : ZMod q') * (m : ZMod q')⁻¹) * (ℓ : ZMod q')) := by
      subst q'
      rfl
    have hRNpos (r : ℕ) (hr : r ∈ RN) : 0 < r := by
      rcases Finset.mem_image.mp hr with ⟨rP, _, rfl⟩
      exact rP.pos
    have hRNmem (r : ℕ) (hr : r ∈ RN) : r.toPNat' ∈ R := by
      rcases Finset.mem_image.mp hr with ⟨rP, hrP, rfl⟩
      simpa only [PNat.coe_toPNat'] using hrP
    have hSNpos (r s : ℕ) (hs : s ∈ SN r) : 0 < s := by
      rcases Finset.mem_image.mp hs with ⟨sP, _, rfl⟩
      exact sP.pos
    have hmemSN (r s : ℕ) (hspos : 0 < s) :
        s ∈ SN r ↔ s.toPNat' ∈ S r.toPNat' := by
      constructor
      · intro hm
        rcases Finset.mem_image.mp hm with ⟨sP, hsP, rfl⟩
        simpa only [PNat.coe_toPNat'] using hsP
      · intro hm
        exact Finset.mem_image.mpr ⟨s.toPNat', hm, PNat.toPNat'_coe hspos⟩
    have hmcast (m : ℤ) (hm : m ∈ I) : (m.toNat : ℤ) = m :=
      Int.toNat_of_nonneg (hI m hm).le
    have hinj : Set.InjOn Int.toNat I := by
      intro m hm n hn hmn
      calc
        m = (m.toNat : ℤ) := (hmcast m hm).symm
        _ = (n.toNat : ℤ) := congrArg (fun k : ℕ => (k : ℤ)) hmn
        _ = n := hmcast n hn
    have hRN : ∀ r ∈ RN, Squarefree r := by
      intro r hr
      simpa only [PNat.toPNat'_coe (hRNpos r hr)] using hR r.toPNat' (hRNmem r hr)
    have hIN : ∀ m ∈ IN, 0 < m := by
      intro m hm
      rcases Finset.mem_image.mp hm with ⟨mZ, hmZ, rfl⟩
      exact Int.pos_iff_toNat_pos.mp (hI mZ hmZ)
    have hSN : ∀ r ∈ RN, ∀ s ∈ SN r, Squarefree s := by
      intro r hr s hs
      simpa only [PNat.toPNat'_coe (hSNpos r s hs)] using
        hS r.toPNat' (hRNmem r hr) s.toPNat' ((hmemSN r s (hSNpos r s hs)).mp hs)
    have hcopN : ∀ r ∈ RN, ∀ s ∈ SN r, Nat.Coprime r s := by
      intro r hr s hs
      simpa only [PNat.toPNat'_coe (hRNpos r hr), PNat.toPNat'_coe (hSNpos r s hs)] using
        hcop r.toPNat' (hRNmem r hr) s.toPNat' ((hmemSN r s (hSNpos r s hs)).mp hs)
    have hAN : ∀ r₁ ∈ RN, ∀ r₂ ∈ RN, ∀ s ∈ SN r₁, s ∈ SN r₂ →
        IsUnit (A : ZMod (s * Nat.lcm r₁ r₂)) := by
      intro r₁ hr₁ r₂ hr₂ s hs₁ hs₂
      have hmod :
          (s.toPNat' : ℕ) *
              Nat.lcm (r₁.toPNat' : ℕ) (r₂.toPNat' : ℕ) =
            s * Nat.lcm r₁ r₂ := by
        rw [PNat.toPNat'_coe (hRNpos r₁ hr₁),
          PNat.toPNat'_coe (hRNpos r₂ hr₂),
          PNat.toPNat'_coe (hSNpos r₁ s hs₁)]
      exact (hUnitInt _ _ hmod A).mp
        (hA r₁.toPNat' (hRNmem r₁ hr₁)
          r₂.toPNat' (hRNmem r₂ hr₂) s.toPNat'
          ((hmemSN r₁ s (hSNpos r₁ s hs₁)).mp hs₁)
          ((hmemSN r₂ s (hSNpos r₁ s hs₁)).mp hs₂))
    have hαN : ∀ m ∈ IN, ‖α (m : ℤ)‖ ≤ Wα := by
      intro m hm
      rcases Finset.mem_image.mp hm with ⟨mZ, hmZ, rfl⟩
      simpa only [hmcast mZ hmZ] using hα mZ hmZ
    have hηN : ∀ r ∈ RN, ∀ s ∈ SN r, ‖η r.toPNat' s.toPNat'‖ ≤ Wη := by
      intro r hr s hs
      exact hη r.toPNat' (hRNmem r hr) s.toPNat' ((hmemSN r s (hSNpos r s hs)).mp hs)
    have hED := typeIII_exactDiagonal_weighted_compactProfile_sum_le_of_deligne
      hDeligne RN IN SN hRN hIN hSN hcopN A hAN
      (fun m : ℕ => α (m : ℤ)) (fun r s : ℕ => η r.toPNat' s.toPNat')
      Wα Wη hWα hWη hαN hηN T Lw H hT hLw hH ψ hsupport hbound
    dsimp only at hED
    have hEDpull :
        (∑ r₁ : RN, ∑ m₁ ∈ IN, ∑ s : SN r₁.val, ∑ r₂ : RN, ∑ m₂ ∈ IN,
          V r₁.val.toPNat' r₂.val.toPNat' s.val.toPNat' (m₁ : ℤ) (m₂ : ℤ)) ≤
        Wη ^ 2 * Wα ^ 2 * Lw * (L.card : ℝ) * (9 : ℝ) ^ ΩN * (τN : ℝ) *
          (IN.card : ℝ) *
            ∑ r ∈ RN, ((SN r).card : ℝ) * (((SN r).sup id : ℕ) : ℝ) := by
      convert hED using 1
      apply Finset.sum_congr rfl
      intro r₁ _
      apply Finset.sum_congr rfl
      intro m₁ _
      apply Finset.sum_congr rfl
      intro s _
      apply Finset.sum_congr rfl
      intro r₂ _
      apply Finset.sum_congr rfl
      intro m₂ _
      have hr₁val : (r₁.val.toPNat' : ℕ) = r₁.val :=
        PNat.toPNat'_coe (hRNpos r₁.val r₁.property)
      have hr₂val : (r₂.val.toPNat' : ℕ) = r₂.val :=
        PNat.toPNat'_coe (hRNpos r₂.val r₂.property)
      have hsval : (s.val.toPNat' : ℕ) = s.val :=
        PNat.toPNat'_coe (hSNpos r₁.val s.val s.property)
      have hsmem : s.val ∈ SN r₂.val ↔ s.val.toPNat' ∈ S r₂.val.toPNat' :=
        hmemSN r₂.val s.val (hSNpos r₁.val s.val s.property)
      let : NeZero (r₁.val * s.val) :=
        ⟨mul_ne_zero (hRN r₁.val r₁.property).ne_zero
          (hSN r₁.val r₁.property s.val s.property).ne_zero⟩
      let : NeZero (r₂.val * s.val) :=
        ⟨mul_ne_zero (hRN r₂.val r₂.property).ne_zero
          (hSN r₁.val r₁.property s.val s.property).ne_zero⟩
      have hq₁ :
          (r₁.val.toPNat' : ℕ) * (s.val.toPNat' : ℕ) =
            r₁.val * s.val := by rw [hr₁val, hsval]
      have hq₂ :
          (r₂.val.toPNat' : ℕ) * (s.val.toPNat' : ℕ) =
            r₂.val * s.val := by rw [hr₂val, hsval]
      have hq :
          (s.val.toPNat' : ℕ) *
              Nat.lcm (r₁.val.toPNat' : ℕ) (r₂.val.toPNat' : ℕ) =
            s.val * Nat.lcm r₁.val r₂.val := by
        rw [hr₁val, hr₂val, hsval]
      have hum₁ := hUnitNat _ _ hq₁ m₁
      have hum₂ := hUnitNat _ _ hq₂ m₂
      have hufreq (t : ℤ) := hUnitInt _ _ hq t
      have hk₁ (t : ℤ) := hKlCast _ _ hq₁ m₁ t
      have hk₂ (t : ℤ) := hKlCast _ _ hq₂ m₂ t
      simp only [V, U, L, Int.cast_natCast, hum₁, hum₂,
        hufreq, hk₁, hk₂, hr₁val, hr₂val, hsval, hsmem]
    clear hED
    clear * - hEDpull hmcast hinj hI hWα hWη hLw
    clear_value U
    have hsumRN (f : ℕ+ → ℝ) :
        (∑ r : RN, f r.val.toPNat') = ∑ r ∈ R, f r := by
      rw [Finset.sum_coe_sort (s := RN)
        (f := fun r : ℕ => f r.toPNat')]
      change (∑ r ∈ R.image PNat.val, f r.toPNat') = _
      rw [Finset.sum_image PNat.coe_injective.injOn]
      simp only [PNat.coe_toPNat']
    have hsumSN (r : ℕ) (f : ℕ+ → ℝ) :
        (∑ s : SN r, f s.val.toPNat') = ∑ s ∈ S r.toPNat', f s := by
      rw [Finset.sum_coe_sort (s := SN r)
        (f := fun s : ℕ => f s.toPNat')]
      change (∑ s ∈ (S r.toPNat').image PNat.val, f s.toPNat') = _
      rw [Finset.sum_image PNat.coe_injective.injOn]
      simp only [PNat.coe_toPNat']
    have hsumIN (f : ℤ → ℝ) :
        (∑ m ∈ IN, f (m : ℤ)) = ∑ m ∈ I, f m := by
      change (∑ m ∈ I.image Int.toNat, f (m : ℤ)) = _
      rw [Finset.sum_image hinj]
      exact Finset.sum_congr rfl (fun m hm => congrArg f (hmcast m hm))
    have hcardIN : IN.card = I.card := Finset.card_image_iff.mpr hinj
    have hΩN : ΩN = Ω := by
      dsimp only [ΩN, RN, SN, Ω]
      simp only [Finset.sup_image, Function.comp_def, PNat.coe_toPNat']
    have hτN : τN ≤ τ := by
      apply Finset.sup_le
      rintro ⟨rN, mN⟩ hrm
      rcases Finset.mem_product.mp hrm with ⟨hrN, hmN⟩
      rcases Finset.mem_image.mp hrN with ⟨rP, hrP, rfl⟩
      rcases Finset.mem_image.mp hmN with ⟨mZ, hmZ, rfl⟩
      have hmabs : mZ.toNat = mZ.natAbs := by
        have h₁ := hmcast mZ hmZ
        have h₂ := Int.natAbs_of_nonneg (hI mZ hmZ).le
        exact_mod_cast h₁.trans h₂.symm
      simpa only [hmabs] using
        (Finset.le_sup (s := R ×ˢ I) (b := (rP, mZ))
          (f := fun rm : ℕ+ × ℤ => ((rm.1 : ℕ) ^ 3 * rm.2.natAbs).divisors.card)
          (Finset.mem_product.mpr ⟨hrP, hmZ⟩))
    have hmass :
        (∑ r ∈ RN, ((SN r).card : ℝ) * (((SN r).sup id : ℕ) : ℝ)) =
          ∑ r ∈ R, ((S r).card : ℝ) * (((S r).sup PNat.val : ℕ) : ℝ) := by
      change (∑ r ∈ R.image PNat.val, ((SN r).card : ℝ) *
        (((SN r).sup id : ℕ) : ℝ)) = _
      rw [Finset.sum_image PNat.coe_injective.injOn]
      apply Finset.sum_congr rfl
      intro r _
      simp only [SN, PNat.coe_toPNat']
      rw [Finset.card_image_of_injective _ PNat.coe_injective, Finset.sup_image]
      rfl
    have hsum :
        (∑ r₁ : RN, ∑ m₁ ∈ IN, ∑ s : SN r₁.val, ∑ r₂ : RN, ∑ m₂ ∈ IN,
          V r₁.val.toPNat' r₂.val.toPNat' s.val.toPNat' (m₁ : ℤ) (m₂ : ℤ)) =
          ∑ r₁ ∈ R, ∑ m₁ ∈ I, ∑ s ∈ S r₁, ∑ r₂ ∈ R, ∑ m₂ ∈ I,
            V r₁ r₂ s m₁ m₂ := by
      calc
        _ = ∑ r₁ : RN, ∑ m₁ ∈ IN, ∑ s ∈ S r₁.val.toPNat',
            ∑ r₂ : RN, ∑ m₂ ∈ IN,
              V r₁.val.toPNat' r₂.val.toPNat' s (m₁ : ℤ) (m₂ : ℤ) := by
          apply Finset.sum_congr rfl
          intro r₁ _
          apply Finset.sum_congr rfl
          intro m₁ _
          exact hsumSN r₁.val (fun s : ℕ+ =>
            ∑ r₂ : RN, ∑ m₂ ∈ IN,
              V r₁.val.toPNat' r₂.val.toPNat' s (m₁ : ℤ) (m₂ : ℤ))
        _ = ∑ r₁ : RN, ∑ m₁ ∈ IN, ∑ s ∈ S r₁.val.toPNat',
            ∑ r₂ ∈ R, ∑ m₂ ∈ I,
              V r₁.val.toPNat' r₂ s (m₁ : ℤ) m₂ := by
          apply Finset.sum_congr rfl
          intro r₁ _
          apply Finset.sum_congr rfl
          intro m₁ _
          apply Finset.sum_congr rfl
          intro s _
          calc
            _ = ∑ r₂ : RN, ∑ m₂ ∈ I,
                V r₁.val.toPNat' r₂.val.toPNat' s (m₁ : ℤ) m₂ := by
              apply Finset.sum_congr rfl
              intro r₂ _
              exact hsumIN (fun m₂ : ℤ =>
                V r₁.val.toPNat' r₂.val.toPNat' s (m₁ : ℤ) m₂)
            _ = _ := hsumRN (fun r₂ : ℕ+ =>
              ∑ m₂ ∈ I, V r₁.val.toPNat' r₂ s (m₁ : ℤ) m₂)
        _ = ∑ r₁ : RN, ∑ m₁ ∈ I, ∑ s ∈ S r₁.val.toPNat',
            ∑ r₂ ∈ R, ∑ m₂ ∈ I,
              V r₁.val.toPNat' r₂ s m₁ m₂ := by
          apply Finset.sum_congr rfl
          intro r₁ _
          exact hsumIN (fun m₁ : ℤ =>
            ∑ s ∈ S r₁.val.toPNat', ∑ r₂ ∈ R, ∑ m₂ ∈ I,
              V r₁.val.toPNat' r₂ s m₁ m₂)
        _ = _ := hsumRN (fun r₁ : ℕ+ =>
          ∑ m₁ ∈ I, ∑ s ∈ S r₁, ∑ r₂ ∈ R, ∑ m₂ ∈ I,
            V r₁ r₂ s m₁ m₂)
    rw [hsum, hΩN, hcardIN, hmass] at hEDpull
    calc
      _ ≤ Wη ^ 2 * Wα ^ 2 * Lw * (L.card : ℝ) * (9 : ℝ) ^ Ω *
          (τN : ℝ) * (I.card : ℝ) *
            ∑ r ∈ R, ((S r).card : ℝ) * (((S r).sup PNat.val : ℕ) : ℝ) := by
        simpa only [V] using hEDpull
      _ ≤ _ := by
        exact mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_right
            (mul_le_mul_of_nonneg_left (Nat.cast_le.mpr hτN) (by positivity))
            (Nat.cast_nonneg _))
          (Finset.sum_nonneg (fun _ _ => mul_nonneg (Nat.cast_nonneg _) (Nat.cast_nonneg _)))
  have hcompletionScalar (a L H s : ℝ)
      (ha : 0 < a) (hL : 0 < L) (hH : 0 ≤ H)
      (has : a ≤ s) (hsa : s ≤ 2 * a) :
      s * (1 + H / (s * L)) * Real.sqrt (s * L) ≤
        4 * a * (H / Real.sqrt (a * L) + Real.sqrt (a * L)) := by
    clear * - ha hL hH has hsa
    have hsqrtlo : Real.sqrt (a * L) ≤ Real.sqrt (s * L) :=
      Real.sqrt_le_sqrt (mul_le_mul_of_nonneg_right has hL.le)
    have hsqrthi : Real.sqrt (s * L) ≤ 2 * Real.sqrt (a * L) := by
      apply Real.sqrt_le_iff.mpr
      refine ⟨by positivity, ?_⟩
      nlinarith only [Real.sq_sqrt (mul_nonneg ha.le hL.le),
        mul_le_mul_of_nonneg_right hsa hL.le, mul_nonneg ha.le hL.le]
    have hdiv : H / Real.sqrt (s * L) ≤ H / Real.sqrt (a * L) :=
      div_le_div_of_nonneg_left hH (Real.sqrt_pos_of_pos (mul_pos ha hL)) hsqrtlo
    have hdivnonneg : 0 ≤ H / Real.sqrt (a * L) :=
      div_nonneg hH (Real.sqrt_nonneg _)
    calc
      _ = s * (Real.sqrt (s * L) + H * (Real.sqrt (s * L) / (s * L))) := by ring
      _ = s * (H / Real.sqrt (s * L) + Real.sqrt (s * L)) := by
        rw [Real.sqrt_div_self]
        ring
      _ ≤ (2 * a) * (H / Real.sqrt (s * L) + Real.sqrt (s * L)) :=
        mul_le_mul_of_nonneg_right hsa (by positivity)
      _ ≤ (2 * a) * (H / Real.sqrt (a * L) + 2 * Real.sqrt (a * L)) :=
        mul_le_mul_of_nonneg_left (add_le_add hdiv hsqrthi) (by positivity)
      _ ≤ (2 * a) * (2 * (H / Real.sqrt (a * L) + Real.sqrt (a * L))) := by
        apply mul_le_mul_of_nonneg_left _ (by positivity)
        linarith only [hdivnonneg]
      _ = _ := by ring
  have hcompletionKernelRewrite (Q b r L H : ℝ) (hQL : 0 ≤ Q * L) :
      H / Real.sqrt ((Q / (b * r)) * L) + Real.sqrt ((Q / (b * r)) * L) =
        H * Real.sqrt (b * r) / Real.sqrt (Q * L) +
          Real.sqrt (Q * L) / Real.sqrt (b * r) := by
    clear * - hQL
    simp only [div_mul_eq_mul_div, Real.sqrt_div hQL, div_div_eq_mul_div]
  have hkernelConstants (Q b S Y τ H : ℝ)
      (hQ : 0 < Q) (hb : 0 < b) (hS : 0 < S) (hY : 0 < Y) :
      8 * (Q / b) ^ 2 *
          (96 * τ * H * Real.sqrt b / (Real.sqrt Q * Real.sqrt (Q / (b * S))) +
            72 * Real.sqrt Q * Real.sqrt (2 * Y * Q / S) / Real.sqrt b) =
        768 * τ * H * Q * Real.sqrt S / b +
          576 * Real.sqrt (2 * b * Y) * Q ^ 3 / (b ^ 3 * Real.sqrt S) := by
    clear * - hQ hb hS hY
    have hsb : Real.sqrt b ≠ 0 := (Real.sqrt_pos_of_pos hb).ne'
    have hss : Real.sqrt S ≠ 0 := (Real.sqrt_pos_of_pos hS).ne'
    have hsmall : Real.sqrt (Q / (b * S)) =
        Real.sqrt Q / (Real.sqrt b * Real.sqrt S) := by
      rw [Real.sqrt_div hQ.le (b * S), Real.sqrt_mul hb.le S]
    have hbig : Real.sqrt (2 * Y * Q / S) =
        Real.sqrt (2 * Y) * Real.sqrt Q / Real.sqrt S := by
      rw [Real.sqrt_div (show 0 ≤ 2 * Y * Q by positivity) S,
        Real.sqrt_mul (show 0 ≤ 2 * Y by positivity) Q]
    have hcross : Real.sqrt (2 * b * Y) = Real.sqrt b * Real.sqrt (2 * Y) := by
      calc
        _ = Real.sqrt (b * (2 * Y)) := congrArg Real.sqrt (by ring)
        _ = _ := Real.sqrt_mul hb.le _
    have hden : Real.sqrt Q * Real.sqrt (Q / (b * S)) =
        Q / (Real.sqrt b * Real.sqrt S) := by
      rw [hsmall, ← mul_div_assoc, Real.mul_self_sqrt hQ.le]
    have hratio₁ : Real.sqrt b / (Real.sqrt Q * Real.sqrt (Q / (b * S))) =
        b * Real.sqrt S / Q := by
      rw [hden, div_div_eq_mul_div, ← mul_assoc, Real.mul_self_sqrt hb.le]
    have hratio₂ : Real.sqrt Q * Real.sqrt (2 * Y * Q / S) / Real.sqrt b =
        Q * Real.sqrt (2 * b * Y) / (b * Real.sqrt S) := by
      rw [hbig]
      calc
        _ = (Real.sqrt Q * Real.sqrt Q) * Real.sqrt (2 * Y) /
            (Real.sqrt b * Real.sqrt S) := by field_simp [hsb, hss]
        _ = Q * Real.sqrt (2 * Y) / (Real.sqrt b * Real.sqrt S) := by
          rw [Real.mul_self_sqrt hQ.le]
        _ = Q * (Real.sqrt b * Real.sqrt (2 * Y)) /
            ((Real.sqrt b * Real.sqrt b) * Real.sqrt S) := by
          field_simp [hsb, hss]
        _ = Q * Real.sqrt (2 * b * Y) / (b * Real.sqrt S) := by
          rw [Real.mul_self_sqrt hb.le, hcross]
    calc
      _ = 8 * (Q / b) ^ 2 *
          (96 * τ * H * (b * Real.sqrt S / Q) +
            72 * (Q * Real.sqrt (2 * b * Y) / (b * Real.sqrt S))) := by
        rw [← hratio₁, ← hratio₂]
        ring
      _ = _ := by field_simp [hQ.ne', hb.ne', hss]; ring
  intro I Dmax Mmax Nτ τ Ω Hb E 𝒮 ℛ P c A F U V T₂ B₂ B₀ B₁ Dscale Oscale
  have hbpos : (0 : ℝ) < b := by exact_mod_cast b.pos
  have hSpos : 0 < S := zero_lt_one.trans_le hS
  have hYpos : 0 < (Y : ℝ) := zero_lt_one.trans_le Y.property
  have hTnonneg : 0 ≤ Tψ := zero_le_one.trans hTψ
  have hcs := typeIII_selected_factor_cauchy_correlation
    b b₁ b₂ b₃ hb₁ hb₂ hb₃ hb D hD ρ σ hfactor a₀ a ha I η α
    x H ε Tψ hx hH hTψ ψ hψnonneg hψone hψsupport
  have hHb : 0 < Hb := hcs.1
  have hT₂ : 0 ≤ T₂ := hcs.2.2.2.2.2.2.2.1
  have hTB : T₂ ≤ B₂ := by
    simpa only [B₂, V] using hcs.2.2.2.2.2.2.2.2.2.2.1
  have hparameters : ∀ s ∈ 𝒮, ∀ r₁ ∈ ℛ s, ∀ r₂ ∈ ℛ s,
      r₁ * s ∈ D ∧ r₂ * s ∈ D ∧
      Squarefree (s : ℕ) ∧ Squarefree (r₁ : ℕ) ∧ Squarefree (r₂ : ℕ) ∧
      Nat.Coprime (s : ℕ) ((r₁ : ℕ) * (r₂ : ℕ)) ∧
      IsUnit (A : ZMod ((s : ℕ) * Nat.lcm (r₁ : ℕ) (r₂ : ℕ))) :=
    hcs.2.2.2.2.2.2.2.2.2.2.2.2
  clear hcs
  clear_value A F
  have hIpos (m : ℤ) (hm : m ∈ I) : 0 < m :=
    hM₀.trans_le (Finset.mem_Icc.mp hm).1
  have hIcard : (I.card : ℝ) ≤ M + 1 := by
    by_cases horder : M₀ ≤ M₁
    · have hcard : (I.card : ℤ) = M₁ + 1 - M₀ :=
        Int.card_Icc_of_le M₀ M₁ (by omega)
      have hcardR : (I.card : ℝ) = (M₁ : ℝ) + 1 - (M₀ : ℝ) := by
        exact_mod_cast hcard
      rw [hcardR]
      linarith only [hMwidth]
    · have he : I = ∅ := Finset.Icc_eq_empty_of_lt (lt_of_not_ge horder)
      rw [he]
      simp only [Finset.card_empty, Nat.cast_zero]
      linarith only [hM]
  have hEcard : (E.card : ℝ) ≤ 2 * Tψ * Hb + 1 := by
    have hscale : 0 ≤ Tψ * Hb := mul_nonneg hTnonneg hHb.le
    have hlo : Int.ceil (-Tψ * Hb) ≤ (0 : ℤ) :=
      Int.ceil_le.mpr (by simpa only [Int.cast_zero, neg_mul] using neg_nonpos.mpr hscale)
    have hhi : (0 : ℤ) ≤ Int.floor (Tψ * Hb) :=
      Int.le_floor.mpr (by simpa only [Int.cast_zero] using hscale)
    have hcard : (E.card : ℤ) =
        Int.floor (Tψ * Hb) + 1 - Int.ceil (-Tψ * Hb) :=
      Int.card_Icc_of_le (Int.ceil (-Tψ * Hb)) (Int.floor (Tψ * Hb)) (by omega)
    have hcardR : (E.card : ℝ) =
        (Int.floor (Tψ * Hb) : ℝ) + 1 - (Int.ceil (-Tψ * Hb) : ℝ) := by
      exact_mod_cast hcard
    rw [hcardR]
    have hl := Int.le_ceil (-Tψ * Hb)
    have hu := Int.floor_le (Tψ * Hb)
    linarith only [hl, hu]
  let R : Finset ℕ+ := D.image ρ
  let Srow : ℕ+ → Finset ℕ+ := fun r => 𝒮.filter (fun s => r ∈ ℛ s)
  have hmember (r s : ℕ+) (hr : r ∈ ℛ s) :
      r * s ∈ D ∧ σ (r * s) = s ∧ ρ (r * s) = r := by
    obtain ⟨d, hd, hρ⟩ := Finset.mem_image.mp hr
    obtain ⟨hd, hσd⟩ := Finset.mem_filter.mp hd
    have heq : d = r * s := by
      rw [hfactor d hd, hρ, hσd]
    subst d
    exact ⟨hd, hσd, hρ⟩
  have hrow_sub (s : ℕ+) : ℛ s ⊆ R :=
    Finset.image_subset_image (Finset.filter_subset _ _)
  have hRdata (r : ℕ+) (hr : r ∈ R) :
      Squarefree (r : ℕ) ∧ (r : ℕ) ≤ Dmax := by
    obtain ⟨d, hd, rfl⟩ := Finset.mem_image.mp hr
    have hdvd : (ρ d : ℕ) ∣ (d : ℕ) := by
      refine ⟨(σ d : ℕ), ?_⟩
      exact congrArg (fun n : ℕ+ => (n : ℕ)) (hfactor d hd)
    exact ⟨(hD d hd).of_mul_right.squarefree_of_dvd hdvd,
      (Nat.le_of_dvd d.pos hdvd).trans (Finset.le_sup (f := fun d : ℕ+ => (d : ℕ)) hd)⟩
  have hrow_range (s : ℕ+) (_hs : s ∈ 𝒮) (r : ℕ+) (hr : r ∈ ℛ s) :
      Q / ((b : ℝ) * (s : ℝ)) ≤ (r : ℝ) ∧
        (r : ℝ) ≤ 2 * Q / ((b : ℝ) * (s : ℝ)) := by
    have hq := hQrange (r * s) (hmember r s hr).1
    have hspos : (0 : ℝ) < s := by exact_mod_cast s.pos
    have hmul : ((r * s : ℕ+) : ℝ) = (r : ℝ) * (s : ℝ) := by
      exact_mod_cast PNat.mul_coe r s
    rw [hmul] at hq
    constructor
    · apply (div_le_iff₀ (mul_pos hbpos hspos)).mpr
      nlinarith only [hq.1]
    · apply (le_div_iff₀ (mul_pos hbpos hspos)).mpr
      nlinarith only [hq.2]
  have hsrow (r s : ℕ+) (hs : s ∈ Srow r) :
      s ∈ 𝒮 ∧ r ∈ ℛ s := Finset.mem_filter.mp hs
  have hsupper (s : ℕ+) (hs : s ∈ 𝒮) : (s : ℝ) ≤ S := by
    obtain ⟨d, hd, rfl⟩ := Finset.mem_image.mp hs
    exact (hσ d hd).2
  have hRrange (r : ℕ+) (hr : r ∈ R) :
      Q / ((b : ℝ) * S) ≤ (r : ℝ) ∧
        (r : ℝ) ≤ 2 * (Y : ℝ) * Q / S := by
    obtain ⟨d, hd, rfl⟩ := Finset.mem_image.mp hr
    have hprod : (d : ℝ) = (ρ d : ℝ) * (σ d : ℝ) := by
      exact_mod_cast hfactor d hd
    have hrpos : (0 : ℝ) < ρ d := by exact_mod_cast (ρ d).pos
    have hq := hQrange d hd
    rw [hprod] at hq
    have hv := hσ d hd
    constructor
    · apply (div_le_iff₀ (mul_pos hbpos hSpos)).mpr
      nlinarith only [hq.1, mul_le_mul_of_nonneg_left hv.2 (mul_nonneg hbpos.le hrpos.le)]
    · apply (le_div_iff₀ hSpos).mpr
      have hl : S ≤ (σ d : ℝ) * ((b : ℝ) * (Y : ℝ)) :=
        (div_le_iff₀ (mul_pos hbpos hYpos)).mp hv.1
      nlinarith only [mul_le_mul_of_nonneg_left hl hrpos.le,
        mul_le_mul_of_nonneg_left hq.2 hYpos.le]
  have hcompare (s : ℕ+) (hs : s ∈ 𝒮) (r₁ r₂ : ℕ+)
      (h₁ : r₁ ∈ ℛ s) (h₂ : r₂ ∈ ℛ s) :
      (r₁ : ℕ) ≤ 2 * (r₂ : ℕ) ∧ (r₂ : ℕ) ≤ 2 * (r₁ : ℕ) := by
    have h₁r := hrow_range s hs r₁ h₁
    have h₂r := hrow_range s hs r₂ h₂
    have heq : 2 * Q / ((b : ℝ) * (s : ℝ)) =
        2 * (Q / ((b : ℝ) * (s : ℝ))) := by ring
    rw [heq] at h₁r h₂r
    constructor
    · exact_mod_cast (by linarith only [h₁r.2, h₂r.1] : (r₁ : ℝ) ≤ 2 * (r₂ : ℝ))
    · exact_mod_cast (by linarith only [h₂r.2, h₁r.1] : (r₂ : ℝ) ≤ 2 * (r₁ : ℝ))
  have hηrow (r s : ℕ+) (hr : r ∈ ℛ s) :
      ‖η ((b : ℕ) * (r : ℕ) * (s : ℕ))‖ ≤ Wη := by
    simpa only [PNat.mul_coe, Nat.mul_assoc] using hη (r * s) (hmember r s hr).1
  have hDcard : (D.card : ℝ) ≤ 2 * Q / (b : ℝ) := by
    have hsub : D.image (fun d : ℕ+ => (d : ℕ)) ⊆
        Finset.Icc 1 (Nat.floor (2 * Q / (b : ℝ))) := by
      intro n hn
      obtain ⟨d, hd, rfl⟩ := Finset.mem_image.mp hn
      refine Finset.mem_Icc.mpr ⟨d.pos, Nat.le_floor ?_⟩
      apply (le_div_iff₀ hbpos).mpr
      simpa only [mul_comm] using (hQrange d hd).2
    have hc : D.card ≤ Nat.floor (2 * Q / (b : ℝ)) := by
      calc
        D.card = (D.image (fun d : ℕ+ => (d : ℕ))).card :=
          (Finset.card_image_of_injective D PNat.coe_injective).symm
        _ ≤ (Finset.Icc 1 (Nat.floor (2 * Q / (b : ℝ)))).card :=
          Finset.card_le_card hsub
        _ = _ := by simp
    exact (Nat.cast_le.mpr hc).trans (Nat.floor_le (by positivity))
  have hτbound (n : ℕ) (hn : n ≤ Nτ) : n.divisors.card ≤ τ := by
    by_cases hz : n = 0
    · subst n
      simp only [Nat.divisors_zero, Finset.card_empty]
      exact Nat.zero_le _
    · exact (Finset.le_sup (f := fun n : ℕ => n.divisors.card)
        (Finset.mem_Icc.mpr ⟨Nat.pos_of_ne_zero hz, hn⟩)).trans (le_max_right _ _)
  have hImax (m : ℤ) (hm : m ∈ I) : m.natAbs ≤ Mmax :=
    Finset.le_sup (f := fun m : ℤ => m.natAbs) hm
  have hcube (r : ℕ+) (hr : r ∈ R) (m : ℤ) (hm : m ∈ I) :
      (r : ℕ) ^ 3 * m.natAbs ≤ Dmax ^ 3 * Mmax :=
    Nat.mul_le_mul (Nat.pow_le_pow_left (hRdata r hr).2 3) (hImax m hm)
  have hΔbound (r₁ r₂ : ℕ+) (h₁ : r₁ ∈ R) (h₂ : r₂ ∈ R)
      (m₁ m₂ : ℤ) (hm₁ : m₁ ∈ I) (hm₂ : m₂ ∈ I) :
      ((r₁ : ℤ) ^ 3 * m₁ - (r₂ : ℤ) ^ 3 * m₂).natAbs ≤ Nτ := by
    calc
      _ ≤ ((r₁ : ℤ) ^ 3 * m₁).natAbs + ((r₂ : ℤ) ^ 3 * m₂).natAbs :=
        Int.natAbs_sub_le _ _
      _ = (r₁ : ℕ) ^ 3 * m₁.natAbs + (r₂ : ℕ) ^ 3 * m₂.natAbs := by
        simp only [Int.natAbs_mul, Int.natAbs_pow, Int.natAbs_natCast]
      _ ≤ 2 * Dmax ^ 3 * Mmax := by
        nlinarith only [hcube r₁ h₁ m₁ hm₁, hcube r₂ h₂ m₂ hm₂]
      _ ≤ Nτ := le_max_right _ _
  have hΩrow (r s : ℕ+) (hr : r ∈ ℛ s) :
      ((r : ℕ) * (s : ℕ)).primeFactors.card ≤ Ω := by
    simpa only [PNat.mul_coe] using
      (Finset.le_sup (f := fun d : ℕ+ => (d : ℕ).primeFactors.card) (hmember r s hr).1)
  have hΩpair (s r₁ r₂ : ℕ+) (h₁ : r₁ ∈ ℛ s) (h₂ : r₂ ∈ ℛ s) :
      ((s : ℕ) * Nat.lcm (r₁ : ℕ) (r₂ : ℕ)).primeFactors.card ≤ 2 * Ω := by
    have hq : (s : ℕ) * Nat.lcm (r₁ : ℕ) (r₂ : ℕ) =
        Nat.lcm ((r₁ : ℕ) * (s : ℕ)) ((r₂ : ℕ) * (s : ℕ)) := by
      rw [Nat.lcm_mul_right, Nat.mul_comm]
    have hdvd : (s : ℕ) * Nat.lcm (r₁ : ℕ) (r₂ : ℕ) ∣
        ((r₁ : ℕ) * (s : ℕ)) * ((r₂ : ℕ) * (s : ℕ)) := by
      rw [hq]
      exact Nat.lcm_dvd_mul _ _
    have hp := Finset.card_le_card (Nat.primeFactors_mono hdvd
      (mul_ne_zero (mul_ne_zero r₁.pos.ne' s.pos.ne') (mul_ne_zero r₂.pos.ne' s.pos.ne')))
    rw [Nat.primeFactors_mul
      (mul_ne_zero r₁.pos.ne' s.pos.ne') (mul_ne_zero r₂.pos.ne' s.pos.ne')] at hp
    exact hp.trans ((Finset.card_union_le _ _).trans
      (by simpa only [two_mul] using Nat.add_le_add (hΩrow r₁ s h₁) (hΩrow r₂ s h₂)))
  let ψc : ℝ → ℂ := fun t => (ψ t : ℂ)
  have hψc : ContDiff ℝ 2 ψc := by
    simpa only [ψc, Complex.ofRealCLM_apply] using
      hψ.continuousLinearMap_comp Complex.ofRealCLM
  have hψcsupport : Function.support ψc ⊆ Set.Icc (-Tψ) Tψ := by
    intro t ht
    exact hψsupport (by simpa [Function.mem_support, ψc] using ht)
  have hψdiff : Differentiable ℝ ψ := hψ.differentiable (by norm_num)
  have hψddiff : Differentiable ℝ (deriv ψ) := hψ.differentiable_deriv_two
  have hderiv₁ : deriv ψc = fun t => ((deriv ψ t : ℝ) : ℂ) := by
    funext t
    exact ((hψdiff t).hasDerivAt.ofReal_comp).deriv
  have hderiv₂ (t : ℝ) : deriv (deriv ψc) t = ((deriv (deriv ψ) t : ℝ) : ℂ) := by
    rw [hderiv₁]
    exact ((hψddiff t).hasDerivAt.ofReal_comp).deriv
  have hψcbound (t : ℝ) :
      ‖ψc t‖ ≤ Lw ∧ ‖deriv ψc t‖ ≤ Lw ∧ ‖deriv (deriv ψc) t‖ ≤ Lw := by
    rw [hderiv₂, hderiv₁]
    simpa only [ψc, Complex.norm_real] using hψbound t
  have hrow_sum (s : ℕ+) (f : ℕ+ → ℝ) :
      (∑ r ∈ ℛ s, f r) = ∑ r ∈ R, if r ∈ ℛ s then f r else 0 := by
    rw [← Finset.sum_filter, Finset.filter_mem_eq_of_subset (hrow_sub s)]
  have hrows (f : ℕ+ → ℕ+ → ℝ) :
      (∑ s ∈ 𝒮, ∑ r ∈ ℛ s, f r s) =
        ∑ r ∈ R, ∑ s ∈ Srow r, f r s := by
    calc
      _ = ∑ s ∈ 𝒮, ∑ r ∈ R, if r ∈ ℛ s then f r s else 0 :=
        Finset.sum_congr rfl (fun s _ => hrow_sum s (fun r => f r s))
      _ = ∑ r ∈ R, ∑ s ∈ 𝒮, if r ∈ ℛ s then f r s else 0 :=
        Finset.sum_comm
      _ = _ := by simp only [Srow, Finset.sum_filter]
  have hrectangle (f : ℕ+ → ℕ+ → ℕ+ → ℤ → ℤ → ℝ) :
      (∑ s ∈ 𝒮, ∑ r₁ ∈ ℛ s, ∑ r₂ ∈ ℛ s, ∑ m₁ ∈ I, ∑ m₂ ∈ I,
        f r₁ r₂ s m₁ m₂) =
        ∑ r₁ ∈ R, ∑ r₂ ∈ R, ∑ m₁ ∈ I, ∑ m₂ ∈ I, ∑ s ∈ Srow r₁,
          if r₂ ∈ ℛ s then f r₁ r₂ s m₁ m₂ else 0 := by
    rw [hrows]
    apply Finset.sum_congr rfl
    intro r₁ _
    calc
      _ = ∑ s ∈ Srow r₁, ∑ r₂ ∈ R,
          if r₂ ∈ ℛ s then ∑ m₁ ∈ I, ∑ m₂ ∈ I, f r₁ r₂ s m₁ m₂ else 0 :=
        Finset.sum_congr rfl (fun s _ => hrow_sum s _)
      _ = ∑ r₂ ∈ R, ∑ s ∈ Srow r₁,
          if r₂ ∈ ℛ s then ∑ m₁ ∈ I, ∑ m₂ ∈ I, f r₁ r₂ s m₁ m₂ else 0 :=
        Finset.sum_comm
      _ = _ := by
        apply Finset.sum_congr rfl
        intro r₂ _
        calc
          _ = ∑ s ∈ Srow r₁, ∑ m₁ ∈ I, ∑ m₂ ∈ I,
              if r₂ ∈ ℛ s then f r₁ r₂ s m₁ m₂ else 0 := by
            simp only [Finset.sum_ite_irrel, Finset.sum_const_zero]
          _ = ∑ m₁ ∈ I, ∑ s ∈ Srow r₁, ∑ m₂ ∈ I,
              if r₂ ∈ ℛ s then f r₁ r₂ s m₁ m₂ else 0 := Finset.sum_comm
          _ = _ := Finset.sum_congr rfl (fun _ _ => Finset.sum_comm)
  have hunit (m : ℤ) (n : ℕ) :
      IsUnit (m : ZMod n) ↔ Nat.Coprime m.natAbs n := by
    simpa only [Int.isCoprime_iff_gcd_eq_one, Int.gcd, Int.natAbs_natCast,
      Nat.gcd_comm, Nat.Coprime] using ZMod.coe_int_isUnit_iff_isCoprime m n
  have hmaskUnit (m : ℤ) (r s : ℕ+)
      (hm : Int.gcd m (((b : ℕ) * (r : ℕ) * (s : ℕ) : ℕ) : ℤ) = 1) :
      IsUnit (m : ZMod ((r : ℕ) * (s : ℕ))) := by
    apply (hunit _ _).mpr
    have hc : Nat.Coprime m.natAbs ((b : ℕ) * (r : ℕ) * (s : ℕ)) := by
      simpa only [Int.gcd, Int.natAbs_natCast, Nat.Coprime] using hm
    apply hc.of_dvd_right
    exact ⟨(b : ℕ), by ring⟩
  let Cψ : ℝ := (6 * (2 * Tψ + 3)) * Lw * (9 : ℝ) ^ (2 * Ω)
  let W : ℝ := Wη ^ 2 * Wα ^ 2
  have hCψ : 0 ≤ Cψ := by dsimp only [Cψ]; positivity
  have hW : 0 ≤ W := mul_nonneg (sq_nonneg _) (sq_nonneg _)
  let Δ : ℕ+ → ℕ+ → ℤ → ℤ → ℤ :=
    fun r₁ r₂ m₁ m₂ => (r₁ : ℤ) ^ 3 * m₁ - (r₂ : ℤ) ^ 3 * m₂
  let G : ℕ+ → ℕ+ → ℤ → ℤ → ℕ → ℝ :=
    fun r₁ r₂ m₁ m₂ s =>
      Real.sqrt (Int.gcd
        (((((r₁ : ℕ) / Nat.gcd (r₁ : ℕ) (r₂ : ℕ) : ℕ) : ℤ) ^ 3 * m₁) -
          ((((r₂ : ℕ) / Nat.gcd (r₁ : ℕ) (r₂ : ℕ) : ℕ) : ℤ) ^ 3 * m₂))
        (Nat.gcd (r₁ : ℕ) (r₂ : ℕ) : ℤ) : ℝ) *
        Real.sqrt (Int.gcd (Δ r₁ r₂ m₁ m₂) (s : ℤ) : ℝ)
  have hG (r₁ r₂ : ℕ+) (m₁ m₂ : ℤ) (s : ℕ) :
      0 ≤ G r₁ r₂ m₁ m₂ s := mul_nonneg (Real.sqrt_nonneg _) (Real.sqrt_nonneg _)
  have hUnorm (s : ℕ+) (hs : s ∈ 𝒮) (r₁ r₂ : ℕ+)
      (h₁ : r₁ ∈ ℛ s) (h₂ : r₂ ∈ ℛ s) (m₁ m₂ : ℤ)
      (hm₁ : IsUnit (m₁ : ZMod ((r₁ : ℕ) * (s : ℕ))))
      (hm₂ : IsUnit (m₂ : ZMod ((r₂ : ℕ) * (s : ℕ)))) :
      ‖U r₁ r₂ s m₁ m₂‖ ≤
        Cψ * (1 + Hb / ((s : ℝ) * (Nat.lcm (r₁ : ℕ) (r₂ : ℕ) : ℝ))) *
          Real.sqrt ((s : ℝ) * (Nat.lcm (r₁ : ℕ) (r₂ : ℕ) : ℝ)) *
            G r₁ r₂ m₁ m₂ s := by
    obtain ⟨_, _, hsf, h₁f, h₂f, hcop, hA⟩ := hparameters s hs r₁ h₁ r₂ h₂
    have ht := typeIII_mixed_reciprocal_compactProfile_norm_le_of_deligne
      hDeligne s r₁ r₂ hsf h₁f h₂f hcop A m₁ m₂ hA hm₁ hm₂
      Tψ Lw Hb hTnonneg hLw hHb ψc hψc hψcsupport hψcbound
    have hp : (9 : ℝ) ^
        ((s : ℕ) * Nat.lcm (r₁ : ℕ) (r₂ : ℕ)).primeFactors.card ≤
          (9 : ℝ) ^ (2 * Ω) :=
      pow_le_pow_right₀ (by norm_num) (hΩpair s r₁ r₂ h₁ h₂)
    calc
      _ ≤ (6 * (2 * Tψ + 3)) * Lw *
          (1 + Hb / ((s : ℝ) * (Nat.lcm (r₁ : ℕ) (r₂ : ℕ) : ℝ))) *
          (9 : ℝ) ^ ((s : ℕ) * Nat.lcm (r₁ : ℕ) (r₂ : ℕ)).primeFactors.card *
          Real.sqrt ((s : ℝ) * (Nat.lcm (r₁ : ℕ) (r₂ : ℕ) : ℝ)) *
          G r₁ r₂ m₁ m₂ s := by
        simpa only [U, E, ψc, G, Δ, Nat.cast_mul, Nat.cast_pow] using ht
      _ ≤ _ := by
        dsimp only [Cψ]
        have hh := mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_right
            (mul_le_mul_of_nonneg_left hp (show 0 ≤
              (6 * (2 * Tψ + 3)) * Lw *
                (1 + Hb / ((s : ℝ) * (Nat.lcm (r₁ : ℕ) (r₂ : ℕ) : ℝ))) by
              positivity))
              (Real.sqrt_nonneg ((s : ℝ) * (Nat.lcm (r₁ : ℕ) (r₂ : ℕ) : ℝ))))
          (hG r₁ r₂ m₁ m₂ s)
        exact hh.trans_eq (by ring)
  have hrowCard (r : ℕ+) :
      (Srow r).card = (D.filter (fun d => ρ d = r)).card := by
    have hrow : Srow r = (D.filter (fun d => ρ d = r)).image σ := by
      ext s
      constructor
      · intro hs
        rcases Finset.mem_filter.mp hs with ⟨_, hr⟩
        rcases Finset.mem_image.mp hr with ⟨d, hd, hρ⟩
        rcases Finset.mem_filter.mp hd with ⟨hd, hσ⟩
        exact Finset.mem_image.mpr ⟨d, Finset.mem_filter.mpr ⟨hd, hρ⟩, hσ⟩
      · intro hs
        rcases Finset.mem_image.mp hs with ⟨d, hd, hσ⟩
        rcases Finset.mem_filter.mp hd with ⟨hd, hρ⟩
        exact Finset.mem_filter.mpr ⟨Finset.mem_image.mpr ⟨d, hd, hσ⟩,
          Finset.mem_image.mpr ⟨d, Finset.mem_filter.mpr ⟨hd, hσ⟩, hρ⟩⟩
    rw [hrow]
    apply Finset.card_image_iff.mpr
    intro d hd e he hσ
    rcases Finset.mem_filter.mp hd with ⟨hd, hρd⟩
    rcases Finset.mem_filter.mp he with ⟨he, hρe⟩
    calc
      d = ρ d * σ d := hfactor d hd
      _ = ρ e * σ e := by rw [hρd, hρe, hσ]
      _ = e := (hfactor e he).symm
  have hmass :
      (∑ r ∈ R, ((Srow r).card : ℝ) * (((Srow r).sup PNat.val : ℕ) : ℝ)) ≤
        2 * Q * S / (b : ℝ) := by
    have hcardnat : (∑ r ∈ R, (Srow r).card) = D.card := by
      simp_rw [hrowCard]
      exact (Finset.card_eq_sum_card_image ρ D).symm
    have hcardreal : (∑ r ∈ R, ((Srow r).card : ℝ)) = (D.card : ℝ) := by
      exact_mod_cast hcardnat
    have hsup (r : ℕ+) : (((Srow r).sup PNat.val : ℕ) : ℝ) ≤ S := by
      have hn : (Srow r).sup PNat.val ≤ Nat.floor S :=
        Finset.sup_le fun s hs => Nat.le_floor (hsupper s (hsrow r s hs).1)
      exact (Nat.cast_le.mpr hn).trans (Nat.floor_le hSpos.le)
    calc
      _ ≤ ∑ r ∈ R, ((Srow r).card : ℝ) * S :=
        Finset.sum_le_sum (fun r _ => mul_le_mul_of_nonneg_left (hsup r) (Nat.cast_nonneg _))
      _ = (D.card : ℝ) * S := by rw [← Finset.sum_mul, hcardreal]
      _ ≤ (2 * Q / (b : ℝ)) * S := mul_le_mul_of_nonneg_right hDcard hSpos.le
      _ = _ := by ring
  let τD : ℕ := (R ×ˢ I).sup (fun rm : ℕ+ × ℤ =>
    ((rm.1 : ℕ) ^ 3 * rm.2.natAbs).divisors.card)
  let ΩD : ℕ := R.sup (fun r => (Srow r).sup
    (fun s => ((r : ℕ) * (s : ℕ)).primeFactors.card))
  let VD : ℕ+ → ℕ+ → ℕ+ → ℤ → ℤ → ℝ := fun r₁ r₂ s m₁ m₂ =>
    if s ∈ Srow r₂ ∧
        IsUnit (m₁ : ZMod ((r₁ : ℕ) * (s : ℕ))) ∧
        IsUnit (m₂ : ZMod ((r₂ : ℕ) * (s : ℕ))) ∧ Δ r₁ r₂ m₁ m₂ = 0
    then (s : ℝ) * ‖η ((b : ℕ) * (r₁ : ℕ) * (s : ℕ))‖ *
      ‖η ((b : ℕ) * (r₂ : ℕ) * (s : ℕ))‖ *
      ‖α m₁‖ * ‖α m₂‖ * ‖U r₁ r₂ s m₁ m₂‖ else 0
  have hVD (r₁ r₂ s : ℕ+) (m₁ m₂ : ℤ) : 0 ≤ VD r₁ r₂ s m₁ m₂ := by
    dsimp only [VD]
    positivity
  have hED :
      (∑ r₁ ∈ R, ∑ m₁ ∈ I, ∑ s ∈ Srow r₁, ∑ r₂ ∈ R, ∑ m₂ ∈ I,
        VD r₁ r₂ s m₁ m₂) ≤
        Wη ^ 2 * Wα ^ 2 * Lw * (E.card : ℝ) * (9 : ℝ) ^ ΩD *
          (τD : ℝ) * (I.card : ℝ) *
            ∑ r ∈ R, ((Srow r).card : ℝ) * (((Srow r).sup PNat.val : ℕ) : ℝ) := by
    have ht := hdiag R I Srow (fun r hr => (hRdata r hr).1) hIpos
      (by
        intro r _ s hs
        exact (hparameters s (hsrow r s hs).1 r (hsrow r s hs).2
          r (hsrow r s hs).2).2.2.1)
      (by
        intro r _ s hs
        have hd := (hD (r * s) (hmember r s (hsrow r s hs).2).1).of_mul_right
        exact Nat.coprime_of_squarefree_mul (by simpa only [PNat.mul_coe] using hd))
      A (by
        intro r₁ _ r₂ _ s hs₁ hs₂
        exact (hparameters s (hsrow r₁ s hs₁).1 r₁ (hsrow r₁ s hs₁).2
          r₂ (hsrow r₂ s hs₂).2).2.2.2.2.2.2)
      α (fun r s => η ((b : ℕ) * (r : ℕ) * (s : ℕ)))
      Wα Wη hWα hWη hα (by
        intro r _ s hs
        exact hηrow r s (hsrow r s hs).2)
      Tψ Lw Hb hTnonneg hLw hHb ψc hψcsupport (fun t => (hψcbound t).1)
    simpa only [VD, τD, ΩD, Δ, U, E, ψc] using ht
  clear_value U
  have hτD : τD ≤ τ := by
    apply Finset.sup_le
    rintro ⟨r, m⟩ hrm
    apply hτbound
    calc
      _ ≤ Dmax ^ 3 * Mmax := hcube r (Finset.mem_product.mp hrm).1
        m (Finset.mem_product.mp hrm).2
      _ ≤ 2 * Dmax ^ 3 * Mmax := by
        nlinarith only [Nat.zero_le (Dmax ^ 3 * Mmax)]
      _ ≤ Nτ := le_max_right _ _
  have hΩD : ΩD ≤ Ω := by
    apply Finset.sup_le
    intro r _
    apply Finset.sup_le
    intro s hs
    exact hΩrow r s (hsrow r s hs).2
  have hB₀ED :
      B₀ ≤ ∑ r₁ ∈ R, ∑ m₁ ∈ I, ∑ s ∈ Srow r₁, ∑ r₂ ∈ R, ∑ m₂ ∈ I,
        VD r₁ r₂ s m₁ m₂ := by
    dsimp only [B₀]
    rw [hrows]
    apply Finset.sum_le_sum
    intro r₁ _
    calc
      _ = ∑ s ∈ Srow r₁, ∑ m₁ ∈ I, ∑ r₂ ∈ ℛ s, ∑ m₂ ∈ I,
          if Δ r₁ r₂ m₁ m₂ = 0 then V r₁ r₂ s m₁ m₂ else 0 :=
        Finset.sum_congr rfl (fun _ _ => Finset.sum_comm)
      _ = ∑ m₁ ∈ I, ∑ s ∈ Srow r₁, ∑ r₂ ∈ ℛ s, ∑ m₂ ∈ I,
          if Δ r₁ r₂ m₁ m₂ = 0 then V r₁ r₂ s m₁ m₂ else 0 := Finset.sum_comm
      _ ≤ _ := by
        apply Finset.sum_le_sum
        intro m₁ _
        apply Finset.sum_le_sum
        intro s hs
        calc
          _ ≤ ∑ r₂ ∈ ℛ s, ∑ m₂ ∈ I, VD r₁ r₂ s m₁ m₂ := by
            apply Finset.sum_le_sum
            intro r₂ hr₂
            apply Finset.sum_le_sum
            intro m₂ _
            by_cases hd : Δ r₁ r₂ m₁ m₂ = 0
            · rw [ite_eq_left hd]
              dsimp only [V]
              split_ifs with hm
              · dsimp only [VD]
                rw [ite_eq_left ⟨Finset.mem_filter.mpr ⟨(hsrow r₁ s hs).1, hr₂⟩,
                  hmaskUnit m₁ r₁ s hm.1, hmaskUnit m₂ r₂ s hm.2, hd⟩]
              · exact hVD _ _ _ _ _
            · rw [ite_eq_right hd]
              exact hVD _ _ _ _ _
          _ ≤ _ := Finset.sum_le_sum_of_subset_of_nonneg (hrow_sub s) (by
            intro r₂ _ _
            exact Finset.sum_nonneg (fun m₂ _ => hVD _ _ _ _ _))
  have hB₀ : B₀ ≤ Dscale := by
    clear * - hB₀ED hED hΩD hτD hEcard hIcard hmass hLw hM hTnonneg hHb hQ hbpos hSpos
    have hpow : (9 : ℝ) ^ ΩD ≤ (9 : ℝ) ^ Ω :=
      pow_le_pow_right₀ (by norm_num) hΩD
    have hτDr : (τD : ℝ) ≤ (τ : ℝ) := Nat.cast_le.mpr hτD
    calc
      B₀ ≤ Wη ^ 2 * Wα ^ 2 * Lw * (E.card : ℝ) * (9 : ℝ) ^ ΩD *
          (τD : ℝ) * (I.card : ℝ) *
            ∑ r ∈ R, ((Srow r).card : ℝ) * (((Srow r).sup PNat.val : ℕ) : ℝ) :=
        hB₀ED.trans hED
      _ ≤ Wη ^ 2 * Wα ^ 2 * Lw * (2 * Tψ * Hb + 1) * (9 : ℝ) ^ Ω *
          (τ : ℝ) * (M + 1) * (2 * Q * S / (b : ℝ)) := by
        exact mul_le_mul
          (mul_le_mul
            (mul_le_mul
              (mul_le_mul
                (mul_le_mul_of_nonneg_left hEcard (by positivity))
                hpow (by positivity) (by positivity))
              hτDr (by positivity) (by positivity))
            hIcard (by positivity) (by positivity))
          hmass (Finset.sum_nonneg (fun _ _ => by positivity)) (by positivity)
      _ = Dscale := by dsimp only [Dscale]; ring
  let K : ℕ+ → ℕ := fun r => Nat.floor (2 * Q / ((b : ℝ) * (r : ℝ)))
  let k : ℕ+ → ℕ+ → ℝ := fun r₁ r₂ =>
    Hb * Real.sqrt ((b : ℝ) * (r₁ : ℝ)) /
        Real.sqrt (Q * (Nat.lcm (r₁ : ℕ) (r₂ : ℕ) : ℝ)) +
      Real.sqrt (Q * (Nat.lcm (r₁ : ℕ) (r₂ : ℕ) : ℝ)) /
        Real.sqrt ((b : ℝ) * (r₁ : ℝ))
  have hk (r₁ r₂ : ℕ+) : 0 ≤ k r₁ r₂ := by dsimp only [k]; positivity
  have hsrange (r s : ℕ+) (hr : r ∈ ℛ s) :
      Q / ((b : ℝ) * (r : ℝ)) ≤ (s : ℝ) ∧
        (s : ℝ) ≤ 2 * Q / ((b : ℝ) * (r : ℝ)) := by
    have hq := hQrange (r * s) (hmember r s hr).1
    have hrpos : (0 : ℝ) < r := by exact_mod_cast r.pos
    have hm : ((r * s : ℕ+) : ℝ) = (r : ℝ) * (s : ℝ) := by
      exact_mod_cast PNat.mul_coe r s
    rw [hm] at hq
    exact ⟨(div_le_iff₀ (mul_pos hbpos hrpos)).mpr (by nlinarith only [hq.1]),
      (le_div_iff₀ (mul_pos hbpos hrpos)).mpr (by nlinarith only [hq.2])⟩
  have hsK (r s : ℕ+) (hr : r ∈ ℛ s) :
      (s : ℕ) ∈ Finset.Icc 1 (K r) :=
    Finset.mem_Icc.mpr ⟨s.pos, Nat.le_floor (hsrange r s hr).2⟩
  have hVbound (s : ℕ+) (hs : s ∈ 𝒮) (r₁ r₂ : ℕ+)
      (h₁ : r₁ ∈ ℛ s) (h₂ : r₂ ∈ ℛ s) (m₁ m₂ : ℤ)
      (hm₁ : m₁ ∈ I) (hm₂ : m₂ ∈ I) :
      V r₁ r₂ s m₁ m₂ ≤
        Cψ * W * (4 * (Q / ((b : ℝ) * (r₁ : ℝ)))) *
          k r₁ r₂ * G r₁ r₂ m₁ m₂ s := by
    have hrpos : (0 : ℝ) < r₁ := by exact_mod_cast r₁.pos
    have hlpos : (0 : ℝ) < Nat.lcm (r₁ : ℕ) (r₂ : ℕ) := by
      exact_mod_cast Nat.lcm_pos r₁.pos r₂.pos
    have ha : 0 < Q / ((b : ℝ) * (r₁ : ℝ)) := div_pos hQ (mul_pos hbpos hrpos)
    have hscalar := hcompletionScalar (Q / ((b : ℝ) * (r₁ : ℝ)))
      (Nat.lcm (r₁ : ℕ) (r₂ : ℕ)) Hb s ha hlpos hHb.le
      (hsrange r₁ s h₁).1 (by convert (hsrange r₁ s h₁).2 using 1; ring)
    rw [hcompletionKernelRewrite Q b r₁
      (Nat.lcm (r₁ : ℕ) (r₂ : ℕ)) Hb (mul_nonneg hQ.le hlpos.le)] at hscalar
    dsimp only [V]
    split_ifs with hm
    · have hcoeff :
          ‖η ((b : ℕ) * (r₁ : ℕ) * (s : ℕ))‖ *
            ‖η ((b : ℕ) * (r₂ : ℕ) * (s : ℕ))‖ *
            ‖α m₁‖ * ‖α m₂‖ ≤ W := by
        calc
          _ ≤ Wη * Wη * Wα * Wα := by
            exact mul_le_mul (mul_le_mul
              (mul_le_mul (hηrow r₁ s h₁) (hηrow r₂ s h₂)
                (norm_nonneg _) hWη)
              (hα m₁ hm₁) (norm_nonneg _) (mul_nonneg hWη hWη))
              (hα m₂ hm₂) (norm_nonneg _) (by positivity)
          _ = W := by dsimp only [W]; ring
      have hu := hUnorm s hs r₁ r₂ h₁ h₂ m₁ m₂
          (hmaskUnit m₁ r₁ s hm.1) (hmaskUnit m₂ r₂ s hm.2)
      calc
        _ = (‖η ((b : ℕ) * (r₁ : ℕ) * (s : ℕ))‖ *
            ‖η ((b : ℕ) * (r₂ : ℕ) * (s : ℕ))‖ *
            ‖α m₁‖ * ‖α m₂‖) * (s : ℝ) * ‖U r₁ r₂ s m₁ m₂‖ := by ring
        _ ≤ W * (s : ℝ) *
            (Cψ * (1 + Hb / ((s : ℝ) * (Nat.lcm (r₁ : ℕ) (r₂ : ℕ) : ℝ))) *
              Real.sqrt ((s : ℝ) * (Nat.lcm (r₁ : ℕ) (r₂ : ℕ) : ℝ)) *
                G r₁ r₂ m₁ m₂ s) := by
          exact mul_le_mul
            (mul_le_mul_of_nonneg_right hcoeff (by positivity)) hu
            (norm_nonneg _) (mul_nonneg hW (by positivity))
        _ = Cψ * W *
            ((s : ℝ) * (1 + Hb / ((s : ℝ) * (Nat.lcm (r₁ : ℕ) (r₂ : ℕ) : ℝ))) *
              Real.sqrt ((s : ℝ) * (Nat.lcm (r₁ : ℕ) (r₂ : ℕ) : ℝ))) *
                G r₁ r₂ m₁ m₂ s := by ring
        _ ≤ _ := by
          simpa only [k, mul_assoc] using
            (mul_le_mul_of_nonneg_right
              (mul_le_mul_of_nonneg_left hscalar (mul_nonneg hCψ hW))
              (hG r₁ r₂ m₁ m₂ s))
    · exact mul_nonneg (mul_nonneg (mul_nonneg (mul_nonneg hCψ hW)
        (by positivity)) (hk _ _)) (hG _ _ _ _ _)
  let kernel : ℕ+ → ℕ+ → ℝ := fun r₁ r₂ =>
    (((I.card : ℝ) ^ 2 + (I.card : ℝ) *
      Real.sqrt (Nat.gcd (r₁ : ℕ) (r₂ : ℕ) : ℝ)) / (r₁ : ℝ) ^ 2) * k r₁ r₂
  have hpair (r₁ r₂ : ℕ+) (hr₁ : r₁ ∈ R) (hr₂ : r₂ ∈ R) :
      (∑ m₁ ∈ I, ∑ m₂ ∈ I, ∑ s ∈ Srow r₁,
        if r₂ ∈ ℛ s then
          if Δ r₁ r₂ m₁ m₂ ≠ 0 then V r₁ r₂ s m₁ m₂ else 0
        else 0) ≤
      if (r₁ : ℕ) ≤ 2 * (r₂ : ℕ) ∧ (r₂ : ℕ) ≤ 2 * (r₁ : ℕ) then
        (Cψ * W * 8 * (Q / (b : ℝ)) ^ 2 * (τ : ℝ) ^ 2) * kernel r₁ r₂
      else 0 := by
    clear * - hr₁ hr₂ hRdata hτbound hΔbound hsrow hsK hVbound hG hcompare hQ hbpos hCψ hW hk K
    by_cases hcomp : (r₁ : ℕ) ≤ 2 * (r₂ : ℕ) ∧
        (r₂ : ℕ) ≤ 2 * (r₁ : ℕ)
    · rw [ite_eq_left hcomp]
      let aR : ℝ := Q / ((b : ℝ) * (r₁ : ℝ))
      have hrpos : (0 : ℝ) < r₁ := by exact_mod_cast r₁.pos
      have haR : 0 < aR := div_pos hQ (mul_pos hbpos hrpos)
      let Cp : ℝ := Cψ * W * (4 * aR) * k r₁ r₂
      have hCp : 0 ≤ Cp := mul_nonneg
        (mul_nonneg (mul_nonneg hCψ hW) (by positivity)) (hk _ _)
      let τΔ : ℕ := (I ×ˢ I).sup (fun mn : ℤ × ℤ =>
        (Δ r₁ r₂ mn.1 mn.2).natAbs.divisors.card)
      have hτΔ : τΔ ≤ τ := by
        apply Finset.sup_le
        rintro ⟨m₁, m₂⟩ hm
        exact hτbound _ (hΔbound r₁ r₂ hr₁ hr₂ m₁ m₂
          (Finset.mem_product.mp hm).1 (Finset.mem_product.mp hm).2)
      have hτd : (Nat.gcd (r₁ : ℕ) (r₂ : ℕ)).divisors.card ≤ τ := by
        apply hτbound
        calc
          _ ≤ (r₁ : ℕ) := Nat.le_of_dvd r₁.pos (Nat.gcd_dvd_left _ _)
          _ ≤ Dmax := (hRdata r₁ hr₁).2
          _ ≤ 4 * Dmax := by omega
          _ ≤ Nτ := le_max_left _ _
      have hK : (K r₁ : ℝ) ≤ 2 * aR := by
        have ht := Nat.floor_le (show 0 ≤ 2 * Q / ((b : ℝ) * (r₁ : ℝ)) by positivity)
        simpa only [K, aR, mul_div_assoc] using ht
      have hsG (m₁ m₂ : ℤ) :
          (∑ s ∈ Srow r₁, G r₁ r₂ m₁ m₂ (s : ℕ)) ≤
            ∑ s ∈ Finset.Icc 1 (K r₁), G r₁ r₂ m₁ m₂ s := by
        rw [← Finset.sum_image PNat.coe_injective.injOn]
        apply Finset.sum_le_sum_of_subset_of_nonneg
        · intro s hs
          obtain ⟨sP, hsP, rfl⟩ := Finset.mem_image.mp hs
          exact hsK r₁ sP (hsrow r₁ sP hsP).2
        · intro s _ _
          exact hG _ _ _ _ _
      have hsV (m₁ : ℤ) (hm₁ : m₁ ∈ I) (m₂ : ℤ) (hm₂ : m₂ ∈ I) :
          (∑ s ∈ Srow r₁,
            if r₂ ∈ ℛ s then
              if Δ r₁ r₂ m₁ m₂ ≠ 0 then V r₁ r₂ s m₁ m₂ else 0
            else 0) ≤
          Cp * (if Δ r₁ r₂ m₁ m₂ ≠ 0 then
            ∑ s ∈ Finset.Icc 1 (K r₁), G r₁ r₂ m₁ m₂ s else 0) := by
        by_cases hd : Δ r₁ r₂ m₁ m₂ ≠ 0
        · simp only [ite_eq_left hd]
          calc
            _ ≤ ∑ s ∈ Srow r₁, Cp * G r₁ r₂ m₁ m₂ (s : ℕ) := by
              apply Finset.sum_le_sum
              intro s hs
              by_cases hr : r₂ ∈ ℛ s
              · rw [ite_eq_left hr]
                exact hVbound s (hsrow r₁ s hs).1 r₁ r₂
                  (hsrow r₁ s hs).2 hr m₁ m₂ hm₁ hm₂
              · rw [ite_eq_right hr]
                exact mul_nonneg hCp (hG _ _ _ _ _)
            _ = Cp * ∑ s ∈ Srow r₁, G r₁ r₂ m₁ m₂ (s : ℕ) := by
              rw [Finset.mul_sum]
            _ ≤ _ := mul_le_mul_of_nonneg_left (hsG m₁ m₂) hCp
        · simp only [ite_eq_right hd, ite_self, Finset.sum_const_zero, mul_zero]
          exact le_rfl
      have havg :
          (∑ m₁ ∈ I, ∑ m₂ ∈ I,
            if Δ r₁ r₂ m₁ m₂ ≠ 0 then
              ∑ s ∈ Finset.Icc 1 (K r₁), G r₁ r₂ m₁ m₂ s
            else 0) ≤
          (K r₁ : ℝ) * (τΔ : ℝ) *
            ((Nat.gcd (r₁ : ℕ) (r₂ : ℕ)).divisors.card : ℝ) *
              ((I.card : ℝ) ^ 2 + (I.card : ℝ) *
                Real.sqrt (Nat.gcd (r₁ : ℕ) (r₂ : ℕ) : ℝ)) := by
        have ht := typeIII_offDiagonal_cubic_gcd_average
          r₁ r₂ (K r₁) (hRdata r₁ hr₁).1 (hRdata r₂ hr₂).1
          M₀ M₁ M₀ M₁ (fun _ _ _ => (1 : ℂ)) 1 (by norm_num)
          (by intros; simp)
        simpa only [I, Δ, G, τΔ, norm_one, one_mul, pow_two] using ht
      clear * - hsV havg hCp hK hτΔ hτd haR
      clear_value V Δ G
      calc
        _ ≤ ∑ m₁ ∈ I, ∑ m₂ ∈ I,
            Cp * (if Δ r₁ r₂ m₁ m₂ ≠ 0 then
              ∑ s ∈ Finset.Icc 1 (K r₁), G r₁ r₂ m₁ m₂ s else 0) :=
          Finset.sum_le_sum (fun m₁ hm₁ => Finset.sum_le_sum
            (fun m₂ hm₂ => hsV m₁ hm₁ m₂ hm₂))
        _ = Cp * (∑ m₁ ∈ I, ∑ m₂ ∈ I,
            if Δ r₁ r₂ m₁ m₂ ≠ 0 then
              ∑ s ∈ Finset.Icc 1 (K r₁), G r₁ r₂ m₁ m₂ s else 0) := by
          simp only [Finset.mul_sum]
        _ ≤ Cp * ((K r₁ : ℝ) * (τΔ : ℝ) *
            ((Nat.gcd (r₁ : ℕ) (r₂ : ℕ)).divisors.card : ℝ) *
              ((I.card : ℝ) ^ 2 + (I.card : ℝ) *
                Real.sqrt (Nat.gcd (r₁ : ℕ) (r₂ : ℕ) : ℝ))) :=
          mul_le_mul_of_nonneg_left havg hCp
        _ ≤ Cp * ((2 * aR) * (τ : ℝ) * (τ : ℝ) *
              ((I.card : ℝ) ^ 2 + (I.card : ℝ) *
                Real.sqrt (Nat.gcd (r₁ : ℕ) (r₂ : ℕ) : ℝ))) := by
          apply mul_le_mul_of_nonneg_left _ hCp
          apply mul_le_mul_of_nonneg_right _
            (add_nonneg (sq_nonneg _)
              (mul_nonneg (Nat.cast_nonneg _) (Real.sqrt_nonneg _)))
          exact mul_le_mul
            (mul_le_mul hK (Nat.cast_le.mpr hτΔ) (Nat.cast_nonneg _)
              (mul_nonneg (by norm_num) haR.le))
            (Nat.cast_le.mpr hτd) (Nat.cast_nonneg _)
            (mul_nonneg (mul_nonneg (by norm_num) haR.le) (Nat.cast_nonneg _))
        _ = _ := by
          dsimp only [Cp, aR, kernel]
          simp only [div_eq_mul_inv, mul_inv_rev, ← inv_pow]
          ring
    · rw [ite_eq_right hcomp]
      apply le_of_eq
      apply Finset.sum_eq_zero
      intro m₁ _
      apply Finset.sum_eq_zero
      intro m₂ _
      apply Finset.sum_eq_zero
      intro s hs
      have hr : r₂ ∉ ℛ s := by
        intro hr
        exact hcomp (hcompare s (hsrow r₁ s hs).1 r₁ r₂ (hsrow r₁ s hs).2 hr)
      rw [ite_eq_right hr]
  have hB₁kernel :
      B₁ ≤ (Cψ * W * 8 * (Q / (b : ℝ)) ^ 2 * (τ : ℝ) ^ 2) *
        ∑ r₁ ∈ R, ∑ r₂ ∈ R,
          if (r₁ : ℕ) ≤ 2 * (r₂ : ℕ) ∧ (r₂ : ℕ) ≤ 2 * (r₁ : ℕ)
          then kernel r₁ r₂ else 0 := by
    clear * - hrectangle hpair
    dsimp only [B₁]
    rw [hrectangle]
    calc
      _ ≤ ∑ r₁ ∈ R, ∑ r₂ ∈ R,
          if (r₁ : ℕ) ≤ 2 * (r₂ : ℕ) ∧ (r₂ : ℕ) ≤ 2 * (r₁ : ℕ) then
            (Cψ * W * 8 * (Q / (b : ℝ)) ^ 2 * (τ : ℝ) ^ 2) * kernel r₁ r₂
          else 0 := Finset.sum_le_sum (fun r₁ hr₁ =>
            Finset.sum_le_sum (fun r₂ hr₂ => hpair r₁ r₂ hr₁ hr₂))
      _ = _ := by simp only [Finset.mul_sum, mul_ite, mul_zero]
  let RN : Finset ℕ := R.image PNat.val
  let JR : Finset ℕ := RN.image (fun r => Nat.log 2 r)
  let τR : ℕ := JR.sup (fun j : ℕ =>
    (Finset.Ico ((2 : ℕ) ^ j) (4 * (2 : ℕ) ^ j)).sup
      (fun r : ℕ => r.divisors.card))
  have hτR : τR ≤ τ := by
    apply Finset.sup_le
    intro j hj
    obtain ⟨rN, hrN, rfl⟩ := Finset.mem_image.mp hj
    obtain ⟨rP, hrP, rfl⟩ := Finset.mem_image.mp hrN
    apply Finset.sup_le
    intro n hn
    apply hτbound
    calc
      n ≤ 4 * 2 ^ Nat.log 2 (rP : ℕ) := (Finset.mem_Ico.mp hn).2.le
      _ ≤ 4 * (rP : ℕ) := Nat.mul_le_mul_left 4 (Nat.pow_log_le_self 2 rP.pos.ne')
      _ ≤ 4 * Dmax := Nat.mul_le_mul_left 4 (hRdata rP hrP).2
      _ ≤ Nτ := le_max_left _ _
  have hRlo : 0 < Q / ((b : ℝ) * S) := div_pos hQ (mul_pos hbpos hSpos)
  have hRhi : 0 ≤ 2 * (Y : ℝ) * Q / S := by positivity
  have hkernelSource :
      (∑ r₁ ∈ R, ∑ r₂ ∈ R,
        if (r₁ : ℕ) ≤ 2 * (r₂ : ℕ) ∧ (r₂ : ℕ) ≤ 2 * (r₁ : ℕ)
        then kernel r₁ r₂ else 0) ≤
      ((I.card : ℝ) ^ 2 + (I.card : ℝ)) *
        (96 * (τ : ℝ) * Hb * Real.sqrt (b : ℝ) /
          (Real.sqrt Q * Real.sqrt (Q / ((b : ℝ) * S))) +
          72 * Real.sqrt Q * Real.sqrt (2 * (Y : ℝ) * Q / S) /
            Real.sqrt (b : ℝ)) := by
    clear * - hRlo hRhi hRrange hτR hHb hQ hbpos
    have ht := typeIII_comparable_lcm_kernel_sourceRange_bound
      RN (Q / ((b : ℝ) * S)) (2 * (Y : ℝ) * Q / S) hRlo hRhi
      (by
        intro r hr
        obtain ⟨rP, hrP, rfl⟩ := Finset.mem_image.mp hr
        exact hRrange rP hrP)
      (I.card : ℝ) Hb Q (b : ℝ) (Nat.cast_nonneg _) hHb.le hQ hbpos
    dsimp only at ht
    simp only [RN, Finset.sum_image PNat.coe_injective.injOn] at ht
    change (∑ r₁ ∈ R, ∑ r₂ ∈ R,
      if (r₁ : ℕ) ≤ 2 * (r₂ : ℕ) ∧ (r₂ : ℕ) ≤ 2 * (r₁ : ℕ)
      then kernel r₁ r₂ else 0) ≤ _ at ht
    clear * - ht hτR hHb
    clear_value kernel
    apply ht.trans
    apply mul_le_mul_of_nonneg_left _
      (add_nonneg (sq_nonneg _) (Nat.cast_nonneg _))
    refine add_le_add ?_ le_rfl
    apply div_le_div_of_nonneg_right _
      (mul_nonneg (Real.sqrt_nonneg _) (Real.sqrt_nonneg _))
    exact mul_le_mul_of_nonneg_right
      (mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_left (Nat.cast_le.mpr hτR) (by norm_num)) hHb.le)
      (Real.sqrt_nonneg _)
  have hB₁ : B₁ ≤ Oscale := by
    clear * - hB₁kernel hkernelSource hkernelConstants hQ hbpos hSpos hYpos hHb hCψ hW hIcard hM
    clear_value B₁ kernel
    let Bsource : ℝ := 768 * (τ : ℝ) * Hb * Q * Real.sqrt S / (b : ℝ) +
      576 * Real.sqrt (2 * (b : ℝ) * (Y : ℝ)) * Q ^ 3 /
        ((b : ℝ) ^ 3 * Real.sqrt S)
    have hBsource : 0 ≤ Bsource := by dsimp only [Bsource]; positivity
    have hpoly : (I.card : ℝ) ^ 2 + (I.card : ℝ) ≤ (M + 1) ^ 2 + (M + 1) :=
      add_le_add (pow_le_pow_left₀ (Nat.cast_nonneg I.card) hIcard 2) hIcard
    calc
      B₁ ≤ (Cψ * W * 8 * (Q / (b : ℝ)) ^ 2 * (τ : ℝ) ^ 2) *
          ∑ r₁ ∈ R, ∑ r₂ ∈ R,
            if (r₁ : ℕ) ≤ 2 * (r₂ : ℕ) ∧ (r₂ : ℕ) ≤ 2 * (r₁ : ℕ)
            then kernel r₁ r₂ else 0 := hB₁kernel
      _ ≤ (Cψ * W * 8 * (Q / (b : ℝ)) ^ 2 * (τ : ℝ) ^ 2) *
          (((I.card : ℝ) ^ 2 + (I.card : ℝ)) *
            (96 * (τ : ℝ) * Hb * Real.sqrt (b : ℝ) /
              (Real.sqrt Q * Real.sqrt (Q / ((b : ℝ) * S))) +
              72 * Real.sqrt Q * Real.sqrt (2 * (Y : ℝ) * Q / S) /
                Real.sqrt (b : ℝ))) :=
        mul_le_mul_of_nonneg_left hkernelSource (by positivity)
      _ = Cψ * W * (τ : ℝ) ^ 2 *
          ((I.card : ℝ) ^ 2 + (I.card : ℝ)) * Bsource := by
        have heq := hkernelConstants Q b S Y τ Hb hQ hbpos hSpos hYpos
        dsimp only [Bsource]
        calc
          _ = Cψ * W * (τ : ℝ) ^ 2 * ((I.card : ℝ) ^ 2 + (I.card : ℝ)) *
              (8 * (Q / (b : ℝ)) ^ 2 *
                (96 * (τ : ℝ) * Hb * Real.sqrt (b : ℝ) /
                  (Real.sqrt Q * Real.sqrt (Q / ((b : ℝ) * S))) +
                  72 * Real.sqrt Q * Real.sqrt (2 * (Y : ℝ) * Q / S) /
                    Real.sqrt (b : ℝ))) := by ring
          _ = _ := by rw [heq]
      _ ≤ Cψ * W * (τ : ℝ) ^ 2 * ((M + 1) ^ 2 + (M + 1)) * Bsource :=
        mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left hpoly (by positivity)) hBsource
      _ = Oscale := by dsimp only [Oscale, Cψ, W, Bsource]; ring
  have hsplit : B₂ = B₀ + B₁ := by
    simp only [B₂, B₀, B₁, ← Finset.sum_add_distrib, ite_not,
      ite_add_ite, add_zero, zero_add, ite_self]
  have hB₂ : B₂ ≤ Dscale + Oscale := by rw [hsplit]; exact add_le_add hB₀ hB₁
  exact ⟨hHb, hIcard, hEcard, hrow_range, hT₂, hTB, hsplit, hB₀, hB₁, hB₂, hTB.trans hB₂⟩

open Classical in
theorem typeIII_fineBand_weighted_kl3_bound_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (qExp δ ε C θ : ℝ)
    (hδ : 0 < δ) (hε : 0 < ε) (hC : 1 ≤ C) (hθ : 0 < θ)
    (hgap : 3 * qExp + 3 * ε < 2 + δ) :
    ∃ X : ℝ, 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ M N Qcenter : ℝ, 1 ≤ M → 1 ≤ N → 0 < Qcenter →
        x / C ≤ M * N → M * N ≤ C * x → Qcenter ≤ C * x ^ qExp →
      ∀ Y : Set.Ici (1 : ℝ), (Y : ℝ) = x ^ δ →
      ∀ (b : ℕ+) (b₁ b₂ b₃ : ℕ),
        0 < b₁ → 0 < b₂ → 0 < b₃ →
        (b : ℕ) = (radical (b₁ * b₂ * b₃) : ℕ) →
      ∀ D : Finset ℕ+,
        (∀ d ∈ D,
          Squarefree ((b : ℕ) * (d : ℕ)) ∧
          Nonempty (DenseDivisibilityWitness
            Y 1 ((b : ℕ) * (d : ℕ))) ∧
          Qcenter * (1 - C * x ^ (-ε)) ≤ (b : ℝ) * (d : ℝ) ∧
          (b : ℝ) * (d : ℝ) ≤ Qcenter * (1 + C * x ^ (-ε))) →
      ∀ (a₀ : ℤ) (a : ∀ d : ℕ+, (ZMod ((b : ℕ) * (d : ℕ)))ˣ),
        (∀ d ∈ D,
          (a d : ZMod ((b : ℕ) * (d : ℕ))) =
            (a₀ : ZMod ((b : ℕ) * (d : ℕ)))) →
      ∀ M₀ M₁ : ℤ, 0 < M₀ → (M₁ : ℝ) - (M₀ : ℝ) ≤ M →
        (∀ m ∈ Finset.Icc M₀ M₁, |(m : ℝ)| ≤ C * M) →
      ∀ (η : ℕ → ℂ) (α : ℤ → ℂ) (Wη Wα : ℝ), 0 ≤ Wη → 0 ≤ Wα →
        (∀ d ∈ D, ‖η ((b : ℕ) * (d : ℕ))‖ ≤ Wη) →
        (∀ m ∈ Finset.Icc M₀ M₁, ‖α m‖ ≤ Wα) →
      ∀ (Tψ Lw : ℝ) (ψ : ℝ → ℝ), 1 ≤ Tψ → 0 ≤ Lw →
        ContDiff ℝ 2 ψ →
        (∀ t : ℝ, 0 ≤ ψ t) →
        (∀ t ∈ Set.Icc (-1 : ℝ) 1, ψ t = 1) →
        Function.support ψ ⊆ Set.Icc (-Tψ) Tψ →
        (∀ t : ℝ,
          ‖ψ t‖ ≤ Lw ∧ ‖deriv ψ t‖ ≤ Lw ∧ ‖deriv (deriv ψ) t‖ ≤ Lw) →
          let I : Finset ℤ := Finset.Icc M₀ M₁
          let B : ℝ := ((b₁ * b₂ * b₃ : ℕ) : ℝ)
          let H : ℝ := Qcenter ^ 3 / N
          let Hb : ℝ := x ^ (3 * ε / 2) * H / B
          let L : Finset ℤ :=
            (Finset.Icc (Int.ceil (-Hb)) (Int.floor Hb)).filter (fun ℓ => ℓ ≠ 0)
          let τ₃ : ℤ → ℝ := fun ℓ =>
            (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 3) ℓ.natAbs : ℝ)
          let A_d : ∀ d : ℕ+, (ZMod (d : ℕ))ˣ := fun d =>
            Units.map ((ZMod.castHom (Nat.dvd_mul_left (d : ℕ) (b : ℕ))
              (ZMod (d : ℕ))).toMonoidHom) (a d)
          let K : ℤ → ℂ := fun ℓ =>
            ∑ d ∈ D, if Int.gcd (((b : ℕ) : ℤ) * ℓ) ((d : ℕ) : ℤ) = 1 then
              η ((b : ℕ) * (d : ℕ)) *
                ∑ m ∈ I, if Int.gcd m (((b : ℕ) * (d : ℕ) : ℕ) : ℤ) = 1 then
                  α m * normalizedKloosterman3Mod (d : ℕ)
                    ((A_d d : ZMod (d : ℕ)) * ((b₁ * b₂ * b₃ : ℕ) : ZMod (d : ℕ)) *
                      (ℓ : ZMod (d : ℕ)) * (m : ZMod (d : ℕ))⁻¹ *
                      (((b : ℕ) : ZMod (d : ℕ))⁻¹) ^ 3)
                else 0
            else 0
          let J : ℝ := ∑ ℓ ∈ L, τ₃ ℓ * ‖K ℓ‖
          let Eenv : ℝ := (2 * Tψ + 3) * Lw * Wη ^ 2 * Wα ^ 2
          let Z : ℝ :=
            ((b : ℝ) * (Y : ℝ)) ^ ((1 : ℝ) / 3) * Hb ^ ((1 : ℝ) / 3) *
                M ^ ((5 : ℝ) / 3) * (Qcenter / (b : ℝ)) ^ ((7 : ℝ) / 3) +
              ((b : ℝ) * (Y : ℝ)) ^ ((1 : ℝ) / 6) * Hb ^ ((2 : ℝ) / 3) *
                M ^ ((7 : ℝ) / 3) * (Qcenter / (b : ℝ)) ^ ((5 : ℝ) / 3) +
              M ^ 2 * (Qcenter / (b : ℝ)) ^ ((5 : ℝ) / 2)
          J ^ 2 ≤ 82944 * Eenv * x ^ (2 * θ) * Hb * Z ∧
            J ≤ 288 * Wη * Wα * Real.sqrt ((2 * Tψ + 3) * Lw) *
              x ^ (θ + 5 * ε / 4) / ((b : ℝ) * Real.sqrt B) *
                (x ^ (δ / 6) * H ^ ((2 : ℝ) / 3) *
                    M ^ ((5 : ℝ) / 6) * Qcenter ^ ((7 : ℝ) / 6) +
                  x ^ (δ / 12) * H ^ ((5 : ℝ) / 6) *
                    M ^ ((7 : ℝ) / 6) * Qcenter ^ ((5 : ℝ) / 6) +
                  H ^ ((1 : ℝ) / 2) * M * Qcenter ^ ((5 : ℝ) / 4)) := by
  have hnormalize
      (x δ ε θ M H Hb Y b B Qcenter Tψ Lw Wη Wα J : ℝ)
      (hx : 1 ≤ x) (hε : 0 < ε)
      (hM : 0 < M) (hH : 0 < H) (hQcenter : 0 < Qcenter)
      (hb : 1 ≤ b) (hbB : b ≤ B)
      (hY : Y = x ^ δ) (hHb : Hb = x ^ (3 * ε / 2) * H / B)
      (hTψ : 1 ≤ Tψ) (hLw : 0 ≤ Lw) (hWη : 0 ≤ Wη) (hWα : 0 ≤ Wα)
      (hquad : J ^ 2 ≤
        82944 * ((2 * Tψ + 3) * Lw * Wη ^ 2 * Wα ^ 2) * x ^ (2 * θ) * Hb *
          ((b * Y) ^ ((1 : ℝ) / 3) * Hb ^ ((1 : ℝ) / 3) *
              M ^ ((5 : ℝ) / 3) * (Qcenter / b) ^ ((7 : ℝ) / 3) +
            (b * Y) ^ ((1 : ℝ) / 6) * Hb ^ ((2 : ℝ) / 3) *
              M ^ ((7 : ℝ) / 3) * (Qcenter / b) ^ ((5 : ℝ) / 3) +
            M ^ 2 * (Qcenter / b) ^ ((5 : ℝ) / 2))) :
      J ≤ 288 * Wη * Wα * Real.sqrt ((2 * Tψ + 3) * Lw) *
        x ^ (θ + 5 * ε / 4) / (b * Real.sqrt B) *
          (x ^ (δ / 6) * H ^ ((2 : ℝ) / 3) *
              M ^ ((5 : ℝ) / 6) * Qcenter ^ ((7 : ℝ) / 6) +
            x ^ (δ / 12) * H ^ ((5 : ℝ) / 6) *
              M ^ ((7 : ℝ) / 6) * Qcenter ^ ((5 : ℝ) / 6) +
            H ^ ((1 : ℝ) / 2) * M * Qcenter ^ ((5 : ℝ) / 4)) := by
    have hx0 : 0 < x := zero_lt_one.trans_le hx
    have hb0 : 0 < b := zero_lt_one.trans_le hb
    have hB0 : 0 < B := hb0.trans_le hbB
    have hY0 : 0 < Y := by rw [hY]; positivity
    have hHb0 : 0 < Hb := by rw [hHb]; positivity
    have hlogb : 0 ≤ Real.log b := Real.log_nonneg hb
    have hlogB : 0 ≤ Real.log B := Real.log_nonneg (hb.trans hbB)
    have hlogbB : Real.log b ≤ Real.log B := Real.log_le_log hb0 hbB
    have hεlogx : 0 ≤ ε * Real.log x := mul_nonneg hε.le (Real.log_nonneg hx)
    let k : ℝ := x ^ (5 * ε / 4) / (b * Real.sqrt B)
    let u : ℝ := x ^ (δ / 6) * H ^ ((2 : ℝ) / 3) *
      M ^ ((5 : ℝ) / 6) * Qcenter ^ ((7 : ℝ) / 6)
    let v : ℝ := x ^ (δ / 12) * H ^ ((5 : ℝ) / 6) *
      M ^ ((7 : ℝ) / 6) * Qcenter ^ ((5 : ℝ) / 6)
    let w : ℝ := H ^ ((1 : ℝ) / 2) * M * Qcenter ^ ((5 : ℝ) / 4)
    let z₁ : ℝ := (b * Y) ^ ((1 : ℝ) / 3) * Hb ^ ((1 : ℝ) / 3) *
      M ^ ((5 : ℝ) / 3) * (Qcenter / b) ^ ((7 : ℝ) / 3)
    let z₂ : ℝ := (b * Y) ^ ((1 : ℝ) / 6) * Hb ^ ((2 : ℝ) / 3) *
      M ^ ((7 : ℝ) / 3) * (Qcenter / b) ^ ((5 : ℝ) / 3)
    let z₃ : ℝ := M ^ 2 * (Qcenter / b) ^ ((5 : ℝ) / 2)
    have hk : 0 < k := by dsimp [k]; positivity
    have hu : 0 < u := by dsimp [u]; positivity
    have hv : 0 < v := by dsimp [v]; positivity
    have hw : 0 < w := by dsimp [w]; positivity
    have h₁ : Hb * z₁ ≤ (k * u) ^ 2 := by
      apply (Real.log_le_log_iff (by dsimp [z₁]; positivity)
        (by positivity)).mp
      dsimp [k, u, z₁]
      rw [hHb, hY]
      simp (disch := positivity) only [Real.log_mul, Real.log_div, Real.log_rpow,
        Real.log_pow, Real.log_sqrt, Nat.cast_ofNat]
      nlinarith only [hεlogx, hlogB]
    have h₂ : Hb * z₂ ≤ (k * v) ^ 2 := by
      apply (Real.log_le_log_iff (by dsimp [z₂]; positivity)
        (by positivity)).mp
      dsimp [k, v, z₂]
      rw [hHb, hY]
      simp (disch := positivity) only [Real.log_mul, Real.log_div, Real.log_rpow,
        Real.log_pow, Real.log_sqrt, Nat.cast_ofNat]
      nlinarith only [hlogb, hlogbB]
    have h₃ : Hb * z₃ ≤ (k * w) ^ 2 := by
      apply (Real.log_le_log_iff (by dsimp [z₃]; positivity)
        (by positivity)).mp
      dsimp [k, w, z₃]
      rw [hHb]
      simp (disch := positivity) only [Real.log_mul, Real.log_div, Real.log_rpow,
        Real.log_pow, Real.log_sqrt, Nat.cast_ofNat]
      nlinarith only [hεlogx, hlogb]
    have hmass : Hb * (z₁ + z₂ + z₃) ≤ (k * (u + v + w)) ^ 2 := by
      calc
        Hb * (z₁ + z₂ + z₃) = Hb * z₁ + Hb * z₂ + Hb * z₃ := by ring
        _ ≤ (k * u) ^ 2 + (k * v) ^ 2 + (k * w) ^ 2 :=
          add_le_add (add_le_add h₁ h₂) h₃
        _ ≤ (k * (u + v + w)) ^ 2 := by
          simpa [Fin.sum_univ_three, mul_add] using
            (Finset.sum_sq_le_sq_sum_of_nonneg
              (s := Finset.univ) (f := ![k * u, k * v, k * w])
              (by intro i _; fin_cases i <;> dsimp <;> positivity))
    have hprofile : 0 ≤ (2 * Tψ + 3) * Lw :=
      mul_nonneg (by linarith only [hTψ]) hLw
    let P : ℝ := 288 * Wη * Wα * Real.sqrt ((2 * Tψ + 3) * Lw) * x ^ θ
    have hP : 0 ≤ P := by dsimp [P]; positivity
    have hpow : (x ^ θ) ^ 2 = x ^ (2 * θ) := by
      simpa only [Nat.cast_ofNat, mul_comm] using (Real.rpow_mul_natCast hx0.le θ 2).symm
    have hP2 : P ^ 2 =
        82944 * ((2 * Tψ + 3) * Lw * Wη ^ 2 * Wα ^ 2) * x ^ (2 * θ) := by
      simp only [P, mul_pow, Real.sq_sqrt hprofile, hpow]
      ring
    have hJ2 : J ^ 2 ≤ P ^ 2 * (Hb * (z₁ + z₂ + z₃)) := by
      rw [hP2]
      simpa only [z₁, z₂, z₃, mul_assoc] using hquad
    have hsquare : J ^ 2 ≤ (P * k * (u + v + w)) ^ 2 := by
      calc
        J ^ 2 ≤ P ^ 2 * (Hb * (z₁ + z₂ + z₃)) := hJ2
        _ ≤ P ^ 2 * (k * (u + v + w)) ^ 2 :=
          mul_le_mul_of_nonneg_left hmass (sq_nonneg P)
        _ = (P * k * (u + v + w)) ^ 2 := by ring
    have hJ : J ≤ P * k * (u + v + w) :=
      le_of_sq_le_sq hsquare (by positivity)
    convert hJ using 1
    dsimp [P, k, u, v, w]
    rw [Real.rpow_add hx0 θ (5 * ε / 4)]
    ring
  let Kheight : ℝ := 2 + 4 * |qExp| + δ + 2 * ε
  have hKtwo : 2 ≤ Kheight := by
    dsimp only [Kheight]
    linarith only [abs_nonneg qExp, hδ, hε]
  have hKheight : 0 < Kheight := zero_lt_two.trans_le hKtwo
  have hKq : qExp + 1 ≤ Kheight := by
    dsimp only [Kheight]
    linarith only [le_abs_self qExp, abs_nonneg qExp, hδ, hε]
  have hKYq : δ + qExp + 1 ≤ Kheight := by
    dsimp only [Kheight]
    linarith only [le_abs_self qExp, abs_nonneg qExp, hε]
  have hKHb : 3 * qExp + 3 * ε / 2 + 1 ≤ Kheight := by
    dsimp only [Kheight]
    linarith only [le_abs_self qExp, abs_nonneg qExp, hδ, hε]
  obtain ⟨Xsrc, _, hsource⟩ :=
    typeIII_balancing_source_ranges_eventually qExp δ ε C hδ hε hC hgap
  obtain ⟨Xfirst, _, hfirstBound⟩ :=
    typeIII_first_moment_le_rpow Kheight θ hKheight hθ
  obtain ⟨Xloss, _, hlossBound⟩ :=
    typeIII_finite_divisor_primeFactor_loss_le_rpow Kheight θ hKheight hθ
  refine ⟨max 1 (max (4 * C ^ 3) (max Xsrc (max Xfirst Xloss))),
    le_max_left _ _, ?_⟩
  intro x hx M N Qcenter hM hN hQcenter hMNlo hMNhi hQmax
    Y hY b b₁ b₂ b₃ hb₁ hb₂ hb₃ hb D hD a₀ a ha
    M₀ M₁ hM₀ hMwidth hMheight η α Wη Wα hWη hWα hη hα
    Tψ Lw ψ hTψ hLw hψ hψnonneg hψone hψsupport hψbound
    I B H Hb L τ₃ A_d K J Eenv Z
  simp only [max_le_iff] at hx
  obtain ⟨hxone, hxC, hxsrc, hxfirst, hxloss⟩ := hx
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hMpos : 0 < M := zero_lt_one.trans_le hM
  have hNpos : 0 < N := zero_lt_one.trans_le hN
  have hYpos : 0 < (Y : ℝ) := zero_lt_one.trans_le Y.property
  have hbone : 1 ≤ (b : ℝ) := Nat.one_le_cast.mpr b.pos
  have hbpos : 0 < (b : ℝ) := zero_lt_one.trans_le hbone
  have hbB : (b : ℝ) ≤ B := by
    change ((b : ℕ) : ℝ) ≤ ((b₁ * b₂ * b₃ : ℕ) : ℝ)
    rw [Nat.cast_le, hb, Nat.radical_le_self_iff]
    positivity
  have hBone : 1 ≤ B := hbone.trans hbB
  have hBpos : 0 < B := zero_lt_one.trans_le hBone
  have hHpos : 0 < H := by dsimp only [H]; positivity
  have hHbpos : 0 < Hb := by dsimp only [Hb]; positivity
  have hEenv : 0 ≤ Eenv := by
    have : 0 ≤ Tψ := zero_le_one.trans hTψ
    dsimp only [Eenv]
    positivity
  have hZ : 0 ≤ Z := by
    dsimp only [Z]
    positivity
  have hRHS : 0 ≤ 82944 * Eenv * x ^ (2 * θ) * Hb * Z := by
    positivity
  have hquadratic : J ^ 2 ≤ 82944 * Eenv * x ^ (2 * θ) * Hb * Z := by
    rcases D.eq_empty_or_nonempty with hDempty | hDnonempty
    · have hJ : J = 0 := by simp [J, K, hDempty]
      simpa only [hJ, zero_pow two_ne_zero] using hRHS
    by_cases hHbone : 1 ≤ Hb
    · have hsmall : C * x ^ (-ε) ≤ (1 : ℝ) / 3 := (hsource x hxsrc).1
      have hupper (d : ℕ+) (hd : d ∈ D) :
          (b : ℝ) * (d : ℝ) ≤ 2 * Qcenter := by
        have hscaled := mul_le_mul_of_nonneg_left hsmall hQcenter.le
        exact ((hD d hd).2.2.2).trans (by
          nlinarith only [hscaled, hQcenter.le])
      obtain ⟨d₀, hd₀⟩ := hDnonempty
      have hd₀one : 1 ≤ (d₀ : ℝ) := Nat.one_le_cast.mpr d₀.pos
      have hbQ : (b : ℝ) ≤ 2 * Qcenter :=
        (le_mul_of_one_le_right hbpos.le hd₀one).trans (hupper d₀ hd₀)
      let Qlo : ℝ := Qcenter * (1 - C * x ^ (-ε))
      obtain ⟨hQlo, hQhalf, hQlole, hband, _, _, hcap, hbalance⟩ :=
        (hsource x hxsrc).2 M N Qcenter (b : ℝ) B
          hMpos hNpos hQcenter hbone hbB hbQ hMNlo hQmax
      have hQrange : ∀ d ∈ D,
          Qlo ≤ (b : ℝ) * (d : ℝ) ∧ (b : ℝ) * (d : ℝ) ≤ 2 * Qlo :=
        fun d hd => hband ((b : ℝ) * (d : ℝ)) (hD d hd).2.2.1 (hD d hd).2.2.2
      have hcapY : 2 ≤ (Y : ℝ) * Qcenter := by
        simpa only [hY] using hcap
      have hbalanceY :
          Hb ^ 2 ≤ (Qcenter / (b : ℝ)) ^ 4 * ((b : ℝ) * (Y : ℝ)) * M ^ 2 := by
        simpa only [hY] using hbalance
      have hCcube : C ≤ C ^ 3 := le_self_pow₀ hC three_ne_zero
      have hCcubeX : C ^ 3 ≤ x := by linarith only [hCcube, hC, hxC]
      have htwoCX : 2 * C ≤ x := by linarith only [hCcube, hC, hxC]
      have hhalfCX : C / 2 ≤ x := by linarith only [htwoCX, hC]
      have hCsquareX : C ^ 2 ≤ x :=
        (pow_le_pow_right₀ hC (by decide : (2 : ℕ) ≤ 3)).trans hCcubeX
      have hcoefficient (a p : ℝ) (ha : a ≤ x) (hp : p + 1 ≤ Kheight) :
          a * x ^ p ≤ x ^ Kheight := by
        calc
          a * x ^ p ≤ x * x ^ p :=
            mul_le_mul_of_nonneg_right ha (by positivity)
          _ = x ^ (p + 1) := by rw [Real.rpow_add_one hxpos.ne', mul_comm]
          _ ≤ x ^ Kheight := Real.rpow_le_rpow_of_exponent_le hxone hp
      have hDheight : ∀ d ∈ D, (d : ℝ) ≤ x ^ Kheight := by
        intro d hd
        calc
          (d : ℝ) ≤ (b : ℝ) * (d : ℝ) :=
            le_mul_of_one_le_left (by positivity) hbone
          _ ≤ 2 * Qcenter := hupper d hd
          _ ≤ 2 * (C * x ^ qExp) :=
            mul_le_mul_of_nonneg_left hQmax zero_le_two
          _ = (2 * C) * x ^ qExp := by ring
          _ ≤ x ^ Kheight := hcoefficient (2 * C) qExp htwoCX hKq
      have hMscale : M ≤ C * x :=
        (le_mul_of_one_le_right hMpos.le hN).trans hMNhi
      have hmarkScale : C * M ≤ x ^ Kheight := by
        calc
          C * M ≤ C * (C * x) := mul_le_mul_of_nonneg_left hMscale hCpos.le
          _ = C ^ 2 * x ^ (1 : ℝ) := by rw [Real.rpow_one]; ring
          _ ≤ x ^ Kheight :=
            hcoefficient (C ^ 2) 1 hCsquareX (by linarith only [hKtwo])
      have hmarkHeight : ∀ m ∈ Finset.Icc M₀ M₁, |(m : ℝ)| ≤ x ^ Kheight :=
        fun m hm => (hMheight m hm).trans hmarkScale
      have hHle : H ≤ Qcenter ^ 3 := div_le_self (pow_nonneg hQcenter.le 3) hN
      have hHbraw : Hb ≤ C ^ 3 * x ^ (3 * qExp + 3 * ε / 2) := by
        have hqpower : (x ^ qExp) ^ 3 = x ^ (3 * qExp) := by
          simpa only [Nat.cast_ofNat, mul_comm] using (Real.rpow_mul_natCast hxpos.le qExp 3).symm
        calc
          Hb ≤ x ^ (3 * ε / 2) * H :=
            div_le_self (by positivity) hBone
          _ ≤ x ^ (3 * ε / 2) * Qcenter ^ 3 :=
            mul_le_mul_of_nonneg_left hHle (by positivity)
          _ ≤ x ^ (3 * ε / 2) * (C * x ^ qExp) ^ 3 :=
            mul_le_mul_of_nonneg_left (pow_le_pow_left₀ hQcenter.le hQmax 3)
              (by positivity)
          _ = C ^ 3 * x ^ (3 * qExp + 3 * ε / 2) := by
            rw [mul_pow, hqpower, Real.rpow_add hxpos]
            ring
      have hHbHeight : Hb ≤ x ^ Kheight :=
        hHbraw.trans (hcoefficient (C ^ 3) (3 * qExp + 3 * ε / 2) hCcubeX hKHb)
      let Dmax : ℕ := D.sup (fun d : ℕ+ => (d : ℕ))
      let Mmax : ℕ := I.sup (fun m : ℤ => m.natAbs)
      let Nτ : ℕ := max (4 * Dmax) (2 * Dmax ^ 3 * Mmax)
      let τ : ℕ := max 1 ((Finset.Icc 1 Nτ).sup (fun n : ℕ => n.divisors.card))
      let Ω : ℕ := D.sup (fun d : ℕ+ => (d : ℕ).primeFactors.card)
      have hτ : 1 ≤ τ := le_max_left _ _
      have hloss : (9 : ℝ) ^ (2 * Ω) * (τ : ℝ) ^ 3 ≤ x ^ θ :=
        hlossBound x hxloss D M₀ M₁ hDheight hmarkHeight
      let S : ℝ :=
        min ((Qcenter / (b : ℝ)) ^ ((4 : ℝ) / 3) *
          ((b : ℝ) * (Y : ℝ)) ^ ((1 : ℝ) / 3) * M ^ ((2 : ℝ) / 3) /
            Hb ^ ((2 : ℝ) / 3)) (((b : ℝ) * (Y : ℝ)) * Qcenter / (2 * (b : ℝ)))
      have hbalanced := typeIII_second_moment_scales_balanced
        (b : ℝ) Qlo Qcenter (Y : ℝ) M Hb Tψ Lw Wη Wα τ Ω
        hbpos hQlo hQlole hQhalf Y.property hM hHbone
        hTψ hLw hWη hWα hτ hcapY hbalanceY
      have hS : 1 ≤ S := hbalanced.1
      have hScap : S ≤ (Y : ℝ) * Qcenter / 2 := hbalanced.2.1
      have hSrange : S ≤ (Y : ℝ) * Qlo := hbalanced.2.2.1
      have hSheight : S ≤ x ^ Kheight := by
        calc
          S ≤ (Y : ℝ) * Qcenter / 2 := hScap
          _ ≤ (Y : ℝ) * (C * x ^ qExp) / 2 :=
            div_le_div_of_nonneg_right
              (mul_le_mul_of_nonneg_left hQmax hYpos.le) zero_le_two
          _ = (C / 2) * x ^ (δ + qExp) := by
            rw [hY, Real.rpow_add hxpos]
            ring
          _ ≤ x ^ Kheight := hcoefficient (C / 2) (δ + qExp) hhalfCX hKYq
      have hDdense : ∀ d ∈ D,
          Squarefree ((b : ℕ) * (d : ℕ)) ∧
          Nonempty (DenseDivisibilityWitness
            Y 1 ((b : ℕ) * (d : ℕ))) ∧
          Qlo ≤ (b : ℝ) * (d : ℝ) ∧ (b : ℝ) * (d : ℝ) ≤ 2 * Qlo :=
        fun d hd => ⟨(hD d hd).1, (hD d hd).2.1, hQrange d hd⟩
      obtain ⟨ρ, σ, hselected⟩ := typeIII_dense_factor_selection
        b Y D Qlo (2 * Qlo) S hQlo
        (le_mul_of_one_le_left hQlo.le one_le_two)
        hS hSrange hDdense
      have hfactor : ∀ d ∈ D, d = ρ d * σ d := fun d hd => (hselected d hd).1
      have hσ : ∀ d ∈ D,
          S / ((b : ℝ) * (Y : ℝ)) ≤ (σ d : ℝ) ∧ (σ d : ℝ) ≤ S := by
        intro d hd
        obtain ⟨_, _, _, _, _, hlo, hhi, _, _⟩ := hselected d hd
        exact ⟨hlo, hhi⟩
      have himage : ∀ s ∈ D.image σ, (s : ℝ) ≤ S :=
        Finset.forall_mem_image.mpr (fun d hd => (hσ d hd).2)
      have hfirst := hfirstBound x hxfirst Hb S hHbpos hHbHeight hS hSheight
        (D.image σ) himage
      have hDsq : ∀ d ∈ D, Squarefree ((b : ℕ) * (d : ℕ)) :=
        fun d hd => (hD d hd).1
      have hcauchy := typeIII_selected_factor_cauchy_correlation
        b b₁ b₂ b₃ hb₁ hb₂ hb₃ hb D hDsq ρ σ hfactor a₀ a ha I η α
        x H ε Tψ hxpos hHpos hTψ ψ hψnonneg hψone hψsupport
      have hsecond := typeIII_selected_factor_second_moment_bound_of_deligne
        hDeligne b b₁ b₂ b₃ hb₁ hb₂ hb₃ hb D hDsq Qlo hQlo hQrange
        Y S hS ρ σ hfactor hσ a₀ a ha M₀ M₁ hM₀ M hMpos.le hMwidth
        η α Wη Wα hWη hWα hη hα x H ε Tψ Lw hxpos hHpos hTψ hLw
        ψ hψ hψnonneg hψone hψsupport hψbound
      have hcostLoss :
          82944 * (Eenv * (9 : ℝ) ^ (2 * Ω) * (τ : ℝ) ^ 3) * Z ≤
            82944 * Eenv * x ^ θ * Z := by
        calc
          _ = (82944 * Eenv * Z) * ((9 : ℝ) ^ (2 * Ω) * (τ : ℝ) ^ 3) := by ring
          _ ≤ (82944 * Eenv * Z) * x ^ θ :=
            mul_le_mul_of_nonneg_left hloss (by positivity)
          _ = _ := by ring
      have hcost := hbalanced.2.2.2.trans hcostLoss
      have hsecondBound := hsecond.2.2.2.2.2.2.2.2.2.2.trans hcost
      have hproduct := mul_le_mul hfirst hsecondBound hsecond.2.2.2.2.1
        (by positivity)
      have htheta : x ^ θ * x ^ θ = x ^ (2 * θ) := by
        simpa only [two_mul] using (Real.rpow_add hxpos θ θ).symm
      calc
        J ^ 2 ≤ _ := hcauchy.2.2.2.2.2.2.2.2.1
        _ ≤ (x ^ θ * Hb) * (82944 * Eenv * x ^ θ * Z) := hproduct
        _ = 82944 * Eenv * (x ^ θ * x ^ θ) * Hb * Z := by ring
        _ = 82944 * Eenv * x ^ (2 * θ) * Hb * Z := by rw [htheta]
    · have hLempty : L = ∅ := by
        apply Finset.eq_empty_of_forall_notMem
        intro ℓ hℓ
        have hmember : (-Hb ≤ (ℓ : ℝ) ∧ (ℓ : ℝ) ≤ Hb) ∧ ℓ ≠ 0 := by
          simpa only [L, Finset.mem_filter, Finset.mem_Icc, Int.ceil_le, Int.le_floor] using hℓ
        have hℓone : (1 : ℝ) ≤ |(ℓ : ℝ)| := by
          exact_mod_cast Int.one_le_abs hmember.2
        exact hHbone (hℓone.trans (abs_le.mpr hmember.1))
      have hJ : J = 0 := by simp only [J, hLempty, Finset.sum_empty]
      simpa only [hJ, zero_pow two_ne_zero] using hRHS
  exact ⟨hquadratic,
    hnormalize x δ ε θ M H Hb (Y : ℝ) (b : ℝ) B Qcenter Tψ Lw Wη Wα J
      hxone hε hMpos hHpos hQcenter hbone hbB hY rfl hTψ hLw hWη hWα hquadratic⟩

end

section
open UniqueFactorizationMonoid
open Classical in
theorem typeIII_fineBand_nonzero_fourier_power_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (omegaExp δ σ C : ℝ)
    (hω : 0 < omegaExp) (hωupper : omegaExp < 1 / 12)
    (hδ : 0 < δ) (hC : 1 ≤ C)
    (hσ : 1 / 18 + 28 / 9 * omegaExp + 2 / 9 * δ < σ) :
    let μ : ℝ := 3 * σ / 4 - 7 * omegaExp / 3 - δ / 6 - 1 / 24
    let γ : ℝ := 1 / 2 + δ - 6 * omegaExp
    let εcap : ℝ := min (1 / 100) (min (μ / 8) (γ / 12))
    0 < εcap ∧
      ∀ ε : ℝ, 0 < ε → ε ≤ εcap →
      ∃ K X : ℝ, 0 < K ∧ 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ M N₁ N₂ N₃ Qcenter : ℝ,
        1 ≤ M → 1 ≤ N₁ → 1 ≤ N₂ → 1 ≤ N₃ → 0 < Qcenter →
        let N : ℝ := N₁ * N₂ * N₃
        x / C ≤ M * N → M * N ≤ C * x →
        x ^ (3 / 4 + 3 * σ / 2 - ε) / C ≤ N →
        Qcenter ≤ C * x ^ (1 / 2 + 2 * omegaExp + ε) →
      ∀ Y : Set.Ici (1 : ℝ), (Y : ℝ) = x ^ δ →
      ∀ Qset : Finset ℕ+,
        (∀ q ∈ Qset,
          Squarefree (q : ℕ) ∧
          Nonempty (DenseDivisibilityWitness Y 1 (q : ℕ)) ∧
          Qcenter * (1 - C * x ^ (-ε)) ≤ (q : ℝ) ∧
          (q : ℝ) ≤ Qcenter * (1 + C * x ^ (-ε))) →
      ∀ (a₀ : ℤ) (a : ∀ q : ℕ+, (ZMod (q : ℕ))ˣ),
        (∀ q ∈ Qset, (a q : ZMod (q : ℕ)) = (a₀ : ZMod (q : ℕ))) →
      ∀ M₀ M₁ : ℤ, 0 < M₀ → (M₁ : ℝ) - (M₀ : ℝ) ≤ M →
        (∀ m ∈ Finset.Icc M₀ M₁, |(m : ℝ)| ≤ C * M) →
        let I : Finset ℤ := Finset.Icc M₀ M₁
        let T₁ : ℝ := x ^ (ε / 2) * Qcenter / N₁
        let T₂ : ℝ := x ^ (ε / 2) * Qcenter / N₂
        let T₃ : ℝ := x ^ (ε / 2) * Qcenter / N₃
        let S : Finset (ℤ × ℤ × ℤ) :=
          ((Finset.Icc (Int.ceil (-T₁)) (Int.floor T₁)) ×ˢ
            ((Finset.Icc (Int.ceil (-T₂)) (Int.floor T₂)) ×ˢ
              (Finset.Icc (Int.ceil (-T₃)) (Int.floor T₃)))).filter
                (fun h => h.1 * h.2.1 * h.2.2 ≠ 0)
      ∀ (η : ℕ → ℂ) (α : ℤ → ℂ) (c : ℤ × ℤ × ℤ → ℂ)
        (Wη Wα Wc : ℝ), 0 ≤ Wη → 0 ≤ Wα → 0 ≤ Wc →
        (∀ q ∈ Qset, ‖η (q : ℕ)‖ ≤ Wη) →
        (∀ m ∈ I, ‖α m‖ ≤ Wα) →
        (∀ h ∈ S, ‖c h‖ ≤ Wc) →
      ∀ (Tψ Lw : ℝ) (ψ : ℝ → ℝ), 1 ≤ Tψ → 0 ≤ Lw →
        ContDiff ℝ 2 ψ →
        (∀ t : ℝ, 0 ≤ ψ t) →
        (∀ t ∈ Set.Icc (-1 : ℝ) 1, ψ t = 1) →
        Function.support ψ ⊆ Set.Icc (-Tψ) Tψ →
        (∀ t : ℝ,
          ‖ψ t‖ ≤ Lw ∧ ‖deriv ψ t‖ ≤ Lw ∧ ‖deriv (deriv ψ) t‖ ≤ Lw) →
        let V : ℂ := ((N / Qcenter ^ 3 : ℝ) : ℂ) *
          ∑ q ∈ Qset, (q : ℂ) * η (q : ℕ) *
            ∑ m ∈ I, if hm : IsUnit (m : ZMod (q : ℕ)) then
              α m * ∑ h ∈ S, c h *
                typeIIICompleteFiberSum (q : ℕ)
                  (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
                  (h.2.2 : ZMod (q : ℕ)) (a q * hm.unit⁻¹)
            else 0
        ‖V‖ ≤ K * Wc * Wη * Wα * Real.sqrt ((2 * Tψ + 3) * Lw) *
          (M * N) * x ^ (-3 * ε) := by
  have hweight_algebra (r b wc we wa s t z root : ℝ) :
      (r / b ^ 2) * (4 * wc * (288 * (2 * we) * wa * s * t / (b * root) * z)) =
        (2304 * wc * we * wa * s * t * z) * (r / (root * b ^ 3)) := by
    simp only [div_eq_mul_inv, mul_inv_rev, ← inv_pow]
    ring
  have hfrequency_bound (T₁ T₂ T₃ : ℝ) (b₁ b₂ b₃ : ℕ)
      (hb₁ : 0 < b₁) (hb₂ : 0 < b₂) (hb₃ : 0 < b₃) (ℓ : ℤ × ℤ × ℤ)
      (h₁ : (b₁ : ℤ) * ℓ.1 ∈ Finset.Icc (Int.ceil (-T₁)) (Int.floor T₁))
      (h₂ : (b₂ : ℤ) * ℓ.2.1 ∈ Finset.Icc (Int.ceil (-T₂)) (Int.floor T₂))
      (h₃ : (b₃ : ℤ) * ℓ.2.2 ∈ Finset.Icc (Int.ceil (-T₃)) (Int.floor T₃)) :
      |((ℓ.1 * ℓ.2.1 * ℓ.2.2 : ℤ) : ℝ)| ≤
        T₁ * T₂ * T₃ / ((b₁ * b₂ * b₃ : ℕ) : ℝ) := by
    have hcoordinate (T : ℝ) (b : ℕ) (hb : 0 < b) (z : ℤ)
        (hz : (b : ℤ) * z ∈ Finset.Icc (Int.ceil (-T)) (Int.floor T)) :
        |(z : ℝ)| ≤ T / (b : ℝ) := by
      obtain ⟨hlo, hhi⟩ := Finset.mem_Icc.mp hz
      have habs : |(((b : ℤ) * z : ℤ) : ℝ)| ≤ T :=
        abs_le.mpr ⟨Int.ceil_le.mp hlo, Int.le_floor.mp hhi⟩
      rw [Int.cast_mul, Int.cast_natCast, abs_mul,
        abs_of_nonneg (Nat.cast_nonneg b)] at habs
      apply (le_div_iff₀ (by exact_mod_cast hb : 0 < (b : ℝ))).2
      simpa only [mul_comm] using habs
    have hu := hcoordinate T₁ b₁ hb₁ ℓ.1 h₁
    have hv := hcoordinate T₂ b₂ hb₂ ℓ.2.1 h₂
    have hw := hcoordinate T₃ b₃ hb₃ ℓ.2.2 h₃
    have hTu : 0 ≤ T₁ / (b₁ : ℝ) := (abs_nonneg _).trans hu
    have hTv : 0 ≤ T₂ / (b₂ : ℝ) := (abs_nonneg _).trans hv
    calc
      |((ℓ.1 * ℓ.2.1 * ℓ.2.2 : ℤ) : ℝ)| =
          |(ℓ.1 : ℝ)| * |(ℓ.2.1 : ℝ)| * |(ℓ.2.2 : ℝ)| := by
        simp only [Int.cast_mul, abs_mul]
      _ ≤ (T₁ / (b₁ : ℝ)) * (T₂ / (b₂ : ℝ)) * (T₃ / (b₃ : ℝ)) :=
        mul_le_mul (mul_le_mul hu hv (abs_nonneg _) hTu) hw
          (abs_nonneg _) (mul_nonneg hTu hTv)
      _ = T₁ * T₂ * T₃ / ((b₁ * b₂ * b₃ : ℕ) : ℝ) := by
        simp only [Nat.cast_mul, div_mul_div_comm]
  have hproject (b d : ℕ) (a : (ZMod (b * d))ˣ) (m : ℤ)
      (hm : IsUnit (m : ZMod (b * d))) :
      ((Units.map ((ZMod.castHom (Nat.dvd_mul_left d b) (ZMod d)).toMonoidHom)
          (a * hm.unit⁻¹) : (ZMod d)ˣ) : ZMod d) =
        ((Units.map ((ZMod.castHom (Nat.dvd_mul_left d b) (ZMod d)).toMonoidHom)
          a : (ZMod d)ˣ) : ZMod d) * (m : ZMod d)⁻¹ := by
    rw [map_mul, map_inv, Units.val_mul, ← ZMod.inv_coe_unit]
    congr 2
    change (ZMod.castHom (Nat.dvd_mul_left d b) (ZMod d))
      (hm.unit : ZMod (b * d)) = (m : ZMod d)
    rw [hm.unit_spec, map_intCast]
  have hunit_iff (q : ℕ) (m : ℤ) :
      Int.gcd m (q : ℤ) = 1 ↔ IsUnit (m : ZMod q) := by
    rw [ZMod.coe_int_isUnit_iff_isCoprime, Int.isCoprime_iff_gcd_eq_one, Int.gcd_comm]
  intro μ γ εcap
  have hμ : 0 < μ := by
    dsimp only [μ]
    linarith only [hσ]
  have hγ : 0 < γ := by
    dsimp only [γ]
    linarith only [hωupper, hδ]
  have hεcap_pos : 0 < εcap := by
    dsimp only [εcap]
    positivity
  refine ⟨hεcap_pos, ?_⟩
  intro ε hε hεcap
  have hεμ : ε ≤ μ / 8 := (le_min_iff.mp (le_min_iff.mp hεcap).2).1
  have hεγ : ε ≤ γ / 12 := (le_min_iff.mp (le_min_iff.mp hεcap).2).2
  have hεmargin : 8 * ε ≤ 3 * σ / 4 - 7 * omegaExp / 3 - δ / 6 - 1 / 24 := by
    dsimp only [μ] at hεμ
    linarith only [hεμ]
  have hgap : 3 * (1 / 2 + 2 * omegaExp + ε) + 3 * ε < 2 + δ := by
    dsimp only [γ] at hγ hεγ
    linarith only [hγ, hεγ]
  have hnormalize (x M N Q : ℝ) (hx : 1 ≤ x) (hM0 : 0 < M) (hN0 : 0 < N)
      (hQ : 0 < Q) (hMNlo : x / C ≤ M * N) (hMNhi : M * N ≤ C * x)
      (hNlow : x ^ (3 / 4 + 3 * σ / 2 - ε) / C ≤ N)
      (hQup : Q ≤ C * x ^ (1 / 2 + 2 * omegaExp + ε)) :
      (N / Q ^ 2) * x ^ (ε + 5 * ε / 4) *
          (x ^ (δ / 6) * (Q ^ 3 / N) ^ ((2 : ℝ) / 3) *
              M ^ ((5 : ℝ) / 6) * Q ^ ((7 : ℝ) / 6) +
            x ^ (δ / 12) * (Q ^ 3 / N) ^ ((5 : ℝ) / 6) *
              M ^ ((7 : ℝ) / 6) * Q ^ ((5 : ℝ) / 6) +
            (Q ^ 3 / N) ^ ((1 : ℝ) / 2) * M * Q ^ ((5 : ℝ) / 4)) ≤
        3 * C ^ ((5 : ℝ) / 2) * (M * N) * x ^ (-3 * ε) := by
    have hlogx : 0 ≤ Real.log x := Real.log_nonneg hx
    have hlogC : 0 ≤ Real.log C := Real.log_nonneg hC
    have hεlogx : 0 ≤ ε * Real.log x := mul_nonneg hε.le hlogx
    have hωlogx : 0 ≤ omegaExp * Real.log x := mul_nonneg hω.le hlogx
    have hδlogx : 0 ≤ δ * Real.log x := mul_nonneg hδ.le hlogx
    have hmarginlog := mul_le_mul_of_nonneg_right hεmargin hlogx
    have hlogMNlo := Real.log_le_log (by positivity : 0 < x / C) hMNlo
    have hlogMNhi := Real.log_le_log (mul_pos hM0 hN0) hMNhi
    have hlogN := Real.log_le_log
      (by positivity : 0 < x ^ (3 / 4 + 3 * σ / 2 - ε) / C) hNlow
    have hlogQ := Real.log_le_log hQ hQup
    simp (disch := positivity) only [Real.log_mul, Real.log_div, Real.log_rpow]
      at hlogMNlo hlogMNhi hlogN hlogQ
    let k : ℝ := (N / Q ^ 2) * x ^ (ε + 5 * ε / 4)
    let u : ℝ := x ^ (δ / 6) * (Q ^ 3 / N) ^ ((2 : ℝ) / 3) *
      M ^ ((5 : ℝ) / 6) * Q ^ ((7 : ℝ) / 6)
    let v : ℝ := x ^ (δ / 12) * (Q ^ 3 / N) ^ ((5 : ℝ) / 6) *
      M ^ ((7 : ℝ) / 6) * Q ^ ((5 : ℝ) / 6)
    let w : ℝ := (Q ^ 3 / N) ^ ((1 : ℝ) / 2) * M * Q ^ ((5 : ℝ) / 4)
    let R : ℝ := C ^ ((5 : ℝ) / 2) * (M * N) * x ^ (-3 * ε)
    have hk : 0 < k := by dsimp [k]; positivity
    have hu : 0 < u := by dsimp [u]; positivity
    have hv : 0 < v := by dsimp [v]; positivity
    have hw : 0 < w := by dsimp [w]; positivity
    have hR : 0 < R := by dsimp [R]; positivity
    have h₁ : k * u ≤ R := by
      apply (Real.log_le_log_iff (mul_pos hk hu) hR).mp
      dsimp [k, u, R]
      simp (disch := positivity) only [Real.log_mul, Real.log_div, Real.log_rpow,
        Real.log_pow, Nat.cast_ofNat]
      linear_combination hlogMNlo / 6 + hlogN / 2 + 7 * hlogQ / 6 +
        hmarginlog + 13 * hεlogx / 12 + 2 * hlogC / 3
    have h₂ : k * v ≤ R := by
      apply (Real.log_le_log_iff (mul_pos hk hv) hR).mp
      dsimp [k, v, R]
      simp (disch := positivity) only [Real.log_mul, Real.log_div, Real.log_rpow,
        Real.log_pow, Nat.cast_ofNat]
      linear_combination hlogMNhi / 6 + hlogN + 4 * hlogQ / 3 +
        2 * hmarginlog + 101 * hεlogx / 12 + 2 * hωlogx + hδlogx / 4
    have h₃ : k * w ≤ R := by
      apply (Real.log_le_log_iff (mul_pos hk hw) hR).mp
      dsimp [k, w, R]
      simp (disch := positivity) only [Real.log_mul, Real.log_div, Real.log_rpow,
        Real.log_pow, Nat.cast_ofNat]
      linear_combination hlogN / 2 + 3 * hlogQ / 4 + hmarginlog +
        3 * hεlogx / 2 + 5 * hωlogx / 6 + hδlogx / 6 + hlogx / 24 + 5 * hlogC / 4
    calc
      k * (u + v + w) = k * u + k * v + k * w := by ring
      _ ≤ R + R + R := add_le_add (add_le_add h₁ h₂) h₃
      _ = 3 * C ^ ((5 : ℝ) / 2) * (M * N) * x ^ (-3 * ε) := by
        dsimp [R]
        ring
  obtain ⟨Cbad, hCbad, hbadtotal⟩ :=
    exists_typeIII_bad_weight_sum_bound
  obtain ⟨Xc, _, hComp⟩ := typeIII_fineBand_weighted_kl3_bound_of_deligne hDeligne
    (1 / 2 + 2 * omegaExp + ε) δ ε C ε hδ hε hC hε hgap
  let X : ℝ := max Xc (max 1 ((3 * C) ^ (1 / ε)))
  have hX : 1 ≤ X := (le_max_left _ _).trans (le_max_right _ _)
  refine ⟨6912 * Cbad * C ^ ((5 : ℝ) / 2), X, by positivity, hX, ?_⟩
  intro x hx
  have hx1 : 1 ≤ x := hX.trans hx
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hxC : Xc ≤ x := (le_max_left _ _).trans hx
  have hxpow : (3 * C) ^ (1 / ε) ≤ x :=
    (le_max_right _ _).trans ((le_max_right _ _).trans hx)
  have hCpow : 3 * C ≤ x ^ ε :=
    (Real.rpow_inv_le_iff_of_pos (by positivity) hx0.le hε).mp
      (by simpa only [one_div] using hxpow)
  have hband : C * x ^ (-ε) ≤ 1 / 3 := by
    rw [Real.rpow_neg hx0.le, ← div_eq_mul_inv]
    apply (div_le_iff₀ (Real.rpow_pos_of_pos hx0 ε)).2
    linarith only [hCpow]
  intro M N₁ N₂ N₃ Qcenter hM hN₁ hN₂ hN₃ hQ N hMNlo hMNhi hNlow hQup
  have hN : 1 ≤ N := one_le_mul_of_one_le_of_one_le
    (one_le_mul_of_one_le_of_one_le hN₁ hN₂) hN₃
  have hM0 : 0 < M := zero_lt_one.trans_le hM
  have hN0 : 0 < N := zero_lt_one.trans_le hN
  intro Y hY Qset hQset a₀ a ha M₀ M₁ hM₀ hwidth hheight I T₁ T₂ T₃ S
    η α c Wη Wα Wc hWη hWα hWc hη hα hc Tψ Lw ψ hTψ hLw hψ hψnonneg hψone
    hψsupport hψbounds V
  let η' : ℕ → ℂ := fun n => (((n : ℝ) / Qcenter : ℝ) : ℂ) * η n
  have hη' (q : ℕ+) (hq : q ∈ Qset) : ‖η' (q : ℕ)‖ ≤ 2 * Wη := by
    have hqratio : (q : ℝ) / Qcenter ≤ 2 := by
      apply (div_le_iff₀ hQ).2
      have hqu := (hQset q hq).2.2.2
      have hbandQ := mul_le_mul_of_nonneg_left hband hQ.le
      nlinarith only [hqu, hbandQ, hQ]
    have hratio0 : 0 ≤ (q : ℝ) / Qcenter := by positivity
    calc
      ‖η' (q : ℕ)‖ = ((q : ℝ) / Qcenter) * ‖η (q : ℕ)‖ := by
        simp only [η', norm_mul, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg hratio0]
      _ ≤ 2 * Wη := mul_le_mul hqratio (hη q hq) (norm_nonneg _) (by norm_num)
  let P : ℤ × ℤ × ℤ → ℤ := fun h => h.1 * h.2.1 * h.2.2
  have hS (h : ℤ × ℤ × ℤ) (hh : h ∈ S) : P h ≠ 0 :=
    (Finset.mem_filter.mp hh).2
  let part : ℕ+ → ℤ → ℕ := fun q z =>
    ∏ p ∈ (q : ℕ).primeFactors, p ^ z.natAbs.factorization p
  let parts : ℕ+ → ℤ × ℤ × ℤ → ℕ × ℕ × ℕ := fun q h =>
    (part q h.1, part q h.2.1, part q h.2.2)
  have hpart (q : ℕ+) (hq : q ∈ Qset) (z : ℤ) (hz : z ≠ 0) :
      0 < part q z ∧ part q z ∈ Nat.factoredNumbers (q : ℕ).primeFactors := by
    obtain ⟨hp, _, _, _, _, hs, _, _, _⟩ :=
      typeIII_signed_supported_prime_part (q : ℕ) (hQset q hq).1 z hz
    exact ⟨hp, hs⟩
  let R : Finset (ℕ × ℕ × ℕ) := (Qset ×ˢ S).image (fun z => parts z.1 z.2)
  let F : (ℕ × ℕ × ℕ) → ℕ+ → Finset (ℤ × ℤ × ℤ) := fun v q =>
    S.filter (fun h => P h ≠ 0 ∧ part q h.1 = v.1 ∧
      part q h.2.1 = v.2.1 ∧ part q h.2.2 = v.2.2)
  have hF (q : ℕ+) (v : ℕ × ℕ × ℕ) :
      S.filter (fun h => parts q h = v) = F v q := by
    apply Finset.filter_congr
    intro h hh
    simp only [parts, Prod.ext_iff]
    exact ⟨fun heq => ⟨hS h hh, heq⟩, And.right⟩
  have hsplit (q : ℕ+) (hq : q ∈ Qset) (f : ℤ × ℤ × ℤ → ℂ) :
      (∑ h ∈ S, f h) = ∑ v ∈ R, ∑ h ∈ F v q, f h := by
    have hm : ∀ h ∈ S, parts q h ∈ R := fun h hh =>
      Finset.mem_image.mpr ⟨(q, h), Finset.mem_product.mpr ⟨hq, hh⟩, rfl⟩
    simpa only [hF] using
      (Finset.sum_fiberwise_of_maps_to (s := S) (t := R) (g := parts q) hm f).symm
  have hRpos (v : ℕ × ℕ × ℕ) (hv : v ∈ R) :
      0 < v.1 ∧ 0 < v.2.1 ∧ 0 < v.2.2 := by
    obtain ⟨⟨q, h⟩, hqh, rfl⟩ := Finset.mem_image.mp hv
    obtain ⟨hq, hh⟩ := Finset.mem_product.mp hqh
    have hz : h.1 ≠ 0 ∧ h.2.1 ≠ 0 ∧ h.2.2 ≠ 0 := by
      simpa only [P, mul_ne_zero_iff, and_assoc] using hS h hh
    exact ⟨(hpart q hq h.1 hz.1).1, (hpart q hq h.2.1 hz.2.1).1,
      (hpart q hq h.2.2 hz.2.2).1⟩
  have hrad_dvd (v : ℕ × ℕ × ℕ) (q : ℕ+) (hq : q ∈ Qset)
      (h : ℤ × ℤ × ℤ) (hh : h ∈ F v q) :
      (radical (v.1 * v.2.1 * v.2.2) : ℕ) ∣ (q : ℕ) := by
    obtain ⟨_, hz, h₁, h₂, h₃⟩ := Finset.mem_filter.mp hh
    have hz' : h.1 ≠ 0 ∧ h.2.1 ≠ 0 ∧ h.2.2 ≠ 0 := by
      simpa only [P, mul_ne_zero_iff, and_assoc] using hz
    apply (Nat.radical_dvd_iff (PNat.ne_zero q)).2
    apply Nat.primeFactors_subset_of_mem_factoredNumbers
    rw [← h₁, ← h₂, ← h₃]
    exact Nat.mul_mem_factoredNumbers
      (Nat.mul_mem_factoredNumbers (hpart q hq h.1 hz'.1).2
        (hpart q hq h.2.1 hz'.2.1).2) (hpart q hq h.2.2 hz'.2.2).2
  let G : (ℕ × ℕ × ℕ) → ℂ := fun v =>
    ∑ q ∈ Qset, η' (q : ℕ) *
      ∑ m ∈ I, if hm : IsUnit (m : ZMod (q : ℕ)) then
        α m * ∑ h ∈ F v q, c h * typeIIICompleteFiberSum (q : ℕ)
          (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ)) (h.2.2 : ZMod (q : ℕ))
          (a q * hm.unit⁻¹)
      else 0
  have hpartition :
      (∑ q ∈ Qset, η' (q : ℕ) *
        ∑ m ∈ I, if hm : IsUnit (m : ZMod (q : ℕ)) then
          α m * ∑ h ∈ S, c h * typeIIICompleteFiberSum (q : ℕ)
            (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ)) (h.2.2 : ZMod (q : ℕ))
            (a q * hm.unit⁻¹)
        else 0) = ∑ v ∈ R, G v := by
    symm
    dsimp only [G]
    rw [Finset.sum_comm]
    apply Finset.sum_congr rfl
    intro q hq
    rw [← Finset.mul_sum]
    congr 1
    rw [Finset.sum_comm]
    apply Finset.sum_congr rfl
    intro m hm
    by_cases hu : IsUnit (m : ZMod (q : ℕ))
    · simp only [dite_eq_left hu]
      rw [hsplit q hq, Finset.mul_sum]
    · simp only [dite_eq_right hu, Finset.sum_const_zero]
  have hV : V = (((N / Qcenter ^ 2 : ℝ) : ℂ)) * ∑ v ∈ R, G v := by
    rw [← hpartition]
    dsimp only [V, η']
    rw [Finset.mul_sum, Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro q hq
    have hQz : (Qcenter : ℂ) ≠ 0 := by exact_mod_cast hQ.ne'
    push_cast
    field_simp [hQz]
  let H : ℝ := Qcenter ^ 3 / N
  let Zsum : ℝ :=
    x ^ (δ / 6) * H ^ ((2 : ℝ) / 3) * M ^ ((5 : ℝ) / 6) * Qcenter ^ ((7 : ℝ) / 6) +
      x ^ (δ / 12) * H ^ ((5 : ℝ) / 6) * M ^ ((7 : ℝ) / 6) * Qcenter ^ ((5 : ℝ) / 6) +
      H ^ ((1 : ℝ) / 2) * M * Qcenter ^ ((5 : ℝ) / 4)
  let E : ℝ := 2304 * Wc * Wη * Wα * Real.sqrt ((2 * Tψ + 3) * Lw) *
    x ^ (ε + 5 * ε / 4) * Zsum
  let weight : ℕ × ℕ × ℕ → ℝ := fun v =>
    (((radical v.1 : ℕ) : ℝ) * ((radical v.2.1 : ℕ) : ℝ) * ((radical v.2.2 : ℕ) : ℝ)) /
      (Real.sqrt ((v.1 * v.2.1 * v.2.2 : ℕ) : ℝ) *
        ((radical (v.1 * v.2.1 * v.2.2) : ℕ) : ℝ) ^ 3)
  have hE : 0 ≤ E := by dsimp only [E, Zsum, H]; positivity
  have hGbound (v : ℕ × ℕ × ℕ) (hv : v ∈ R) : ‖G v‖ ≤ E * weight v := by
    obtain ⟨hv₁, hv₂, hv₃⟩ := hRpos v hv
    let B : ℕ := v.1 * v.2.1 * v.2.2
    let b : ℕ+ := ⟨radical B, Nat.radical_pos B⟩
    let D : Finset ℕ+ := Qset.preimage (fun d : ℕ+ => b * d)
      (fun _ _ _ _ h => mul_left_cancel h)
    have hDmem (d : ℕ+) : d ∈ D ↔ b * d ∈ Qset := Finset.mem_preimage
    have hD (d : ℕ+) (hd : d ∈ D) :
        Squarefree ((b : ℕ) * (d : ℕ)) ∧
        Nonempty (DenseDivisibilityWitness Y 1 ((b : ℕ) * (d : ℕ))) ∧
        Qcenter * (1 - C * x ^ (-ε)) ≤ (b : ℝ) * (d : ℝ) ∧
        (b : ℝ) * (d : ℝ) ≤ Qcenter * (1 + C * x ^ (-ε)) := by
      simpa only [PNat.mul_coe, Nat.cast_mul] using hQset (b * d) ((hDmem d).mp hd)
    have hFempty (q : ℕ+) (hq : q ∈ Qset) (hbq : ¬ b ∣ q) : F v q = ∅ := by
      apply Finset.eq_empty_iff_forall_notMem.mpr
      intro h hh
      exact hbq (PNat.dvd_iff.mpr (hrad_dvd v q hq h hh))
    let ad : ∀ d : ℕ+, (ZMod ((b : ℕ) * (d : ℕ)))ˣ := fun d => a (b * d)
    let A_d : ∀ d : ℕ+, (ZMod (d : ℕ))ˣ := fun d =>
      Units.map ((ZMod.castHom (Nat.dvd_mul_left (d : ℕ) (b : ℕ))
        (ZMod (d : ℕ))).toMonoidHom) (ad d)
    let rebuild : ℤ × ℤ × ℤ → ℤ × ℤ × ℤ := fun ℓ =>
      ((v.1 : ℤ) * ℓ.1, (v.2.1 : ℤ) * ℓ.2.1, (v.2.2 : ℤ) * ℓ.2.2)
    have hreb_inj : Function.Injective rebuild :=
      (mul_right_injective₀ (by exact_mod_cast hv₁.ne')).prodMap
        ((mul_right_injective₀ (by exact_mod_cast hv₂.ne')).prodMap
          (mul_right_injective₀ (by exact_mod_cast hv₃.ne')))
    let U : Finset (ℤ × ℤ × ℤ) :=
      (S.preimage rebuild (fun _ _ _ _ h => hreb_inj h)).filter
        (fun ℓ => Int.gcd (P ℓ) ((b : ℕ) : ℤ) = 1)
    have hUmem (ℓ : ℤ × ℤ × ℤ) : ℓ ∈ U ↔
        rebuild ℓ ∈ S ∧ Int.gcd (P ℓ) ((b : ℕ) : ℤ) = 1 :=
      Finset.mem_filter.trans (and_congr Finset.mem_preimage Iff.rfl)
    have hreb_nonzero (ℓ : ℤ × ℤ × ℤ) (hℓ : rebuild ℓ ∈ S) : P ℓ ≠ 0 := by
      simpa [P, rebuild, mul_ne_zero_iff, hv₁.ne', hv₂.ne', hv₃.ne', and_assoc]
        using hS (rebuild ℓ) hℓ
    have hUprod (ℓ : ℤ × ℤ × ℤ) (hℓ : ℓ ∈ U) : P ℓ ≠ 0 :=
      hreb_nonzero ℓ ((hUmem ℓ).mp hℓ).1
    let Ld : ℕ+ → Finset (ℤ × ℤ × ℤ) := fun d => (F v (b * d)).image (fun h =>
      (h.1 / (v.1 : ℤ), h.2.1 / (v.2.1 : ℤ), h.2.2 / (v.2.2 : ℤ)))
    have hLd (d : ℕ+) (hd : d ∈ D) : Ld d =
        U.filter (fun ℓ => Int.gcd (((b : ℕ) : ℤ) * P ℓ) ((d : ℕ) : ℤ) = 1) := by
      obtain ⟨hL, _, _, _⟩ := typeIII_full_supported_frequency_fiber_kl3
        (b : ℕ) (d : ℕ) v.1 v.2.1 v.2.2 (hD d hd).1 hv₁ hv₂ hv₃ rfl S c 1
      have hbd : IsCoprime ((b : ℕ) : ℤ) ((d : ℕ) : ℤ) :=
        (Nat.coprime_of_squarefree_mul (hD d hd).1).isCoprime
      ext ℓ
      have hm : ℓ ∈ Ld d ↔ rebuild ℓ ∈ S ∧ P ℓ ≠ 0 ∧
          Int.gcd (P ℓ) (((b : ℕ) * (d : ℕ) : ℕ) : ℤ) = 1 := hL ℓ
      rw [hm]
      conv_rhs => rw [Finset.mem_filter, hUmem, and_assoc]
      simp only [← Int.isCoprime_iff_gcd_eq_one, Nat.cast_mul,
        IsCoprime.mul_right_iff, IsCoprime.mul_left_iff, hbd, true_and]
      exact and_congr_right fun hs => by simp [hreb_nonzero ℓ hs]
    let bad : ℂ := typeIIICompleteFiberSum (b : ℕ)
      (v.1 : ZMod (b : ℕ)) (v.2.1 : ZMod (b : ℕ)) (v.2.2 : ZMod (b : ℕ)) 1
    let phase : ℕ+ → ℤ → ℤ → ℂ := fun d m z => normalizedKloosterman3Mod (d : ℕ)
      ((A_d d : ZMod (d : ℕ)) * (B : ZMod (d : ℕ)) * (z : ZMod (d : ℕ)) *
        (m : ZMod (d : ℕ))⁻¹ * (((b : ℕ) : ZMod (d : ℕ))⁻¹) ^ 3)
    have hFRsum (d : ℕ+) (hd : d ∈ D) (m : ℤ)
        (hm : IsUnit (m : ZMod ((b : ℕ) * (d : ℕ)))) :
        (∑ h ∈ F v (b * d), c h * typeIIICompleteFiberSum ((b : ℕ) * (d : ℕ))
          (h.1 : ZMod ((b : ℕ) * (d : ℕ))) (h.2.1 : ZMod ((b : ℕ) * (d : ℕ)))
          (h.2.2 : ZMod ((b : ℕ) * (d : ℕ))) (ad d * hm.unit⁻¹)) =
        bad * ∑ ℓ ∈ U, if Int.gcd (((b : ℕ) : ℤ) * P ℓ) ((d : ℕ) : ℤ) = 1 then
          c (rebuild ℓ) * phase d m (P ℓ) else 0 := by
      have hf := (typeIII_full_supported_frequency_fiber_kl3 (b : ℕ) (d : ℕ)
        v.1 v.2.1 v.2.2 (hD d hd).1 hv₁ hv₂ hv₃ rfl S c (ad d * hm.unit⁻¹)).2.1
      change (∑ h ∈ F v (b * d), _) = bad * ∑ ℓ ∈ Ld d, _ at hf
      rw [hf, hLd d hd, Finset.sum_filter]
      congr 1
      apply Finset.sum_congr rfl
      intro ℓ hℓ
      dsimp only [phase]
      congr 3
      rw [hproject]
      dsimp only [A_d]
      ring
    let dterm : ℕ+ → ℤ → ℂ := fun d z =>
      if Int.gcd (((b : ℕ) : ℤ) * z) ((d : ℕ) : ℤ) = 1 then
        η' ((b : ℕ) * (d : ℕ)) * ∑ m ∈ I,
          if Int.gcd m (((b : ℕ) * (d : ℕ) : ℕ) : ℤ) = 1 then
            α m * phase d m z else 0
      else 0
    let K : ℤ → ℂ := fun z => ∑ d ∈ D, dterm d z
    have hbyd (d : ℕ+) (hd : d ∈ D) :
        η' ((b : ℕ) * (d : ℕ)) *
          (∑ m ∈ I, if hm : IsUnit (m : ZMod ((b : ℕ) * (d : ℕ))) then
            α m * ∑ h ∈ F v (b * d), c h * typeIIICompleteFiberSum ((b : ℕ) * (d : ℕ))
              (h.1 : ZMod ((b : ℕ) * (d : ℕ))) (h.2.1 : ZMod ((b : ℕ) * (d : ℕ)))
              (h.2.2 : ZMod ((b : ℕ) * (d : ℕ))) (ad d * hm.unit⁻¹)
          else 0) = bad * ∑ ℓ ∈ U, c (rebuild ℓ) * dterm d (P ℓ) := by
      calc
        _ = ∑ m ∈ I, ∑ ℓ ∈ U, bad * c (rebuild ℓ) *
            (if Int.gcd (((b : ℕ) : ℤ) * P ℓ) ((d : ℕ) : ℤ) = 1 then
              η' ((b : ℕ) * (d : ℕ)) *
                (if Int.gcd m (((b : ℕ) * (d : ℕ) : ℕ) : ℤ) = 1 then
                  α m * phase d m (P ℓ) else 0)
            else 0) := by
          rw [Finset.mul_sum]
          apply Finset.sum_congr rfl
          intro m hmI
          by_cases hm : IsUnit (m : ZMod ((b : ℕ) * (d : ℕ)))
          · have hmg := (hunit_iff ((b : ℕ) * (d : ℕ)) m).mpr hm
            simp only [dite_eq_left hm, ite_eq_left hmg]
            rw [hFRsum d hd m hm]
            simp only [Finset.mul_sum]
            apply Finset.sum_congr rfl
            intro ℓ hℓ
            split_ifs <;> ring
          · have hmg : Int.gcd m (((b : ℕ) * (d : ℕ) : ℕ) : ℤ) ≠ 1 :=
              fun hg => hm ((hunit_iff ((b : ℕ) * (d : ℕ)) m).mp hg)
            simp only [dite_eq_right hm, ite_eq_right hmg, mul_zero, ite_self,
              Finset.sum_const_zero]
        _ = _ := by
          rw [Finset.sum_comm]
          simp only [dterm, Finset.mul_sum, mul_ite, mul_zero,
            Finset.sum_ite_irrel, Finset.sum_const_zero, mul_assoc]
    have hGexact : G v = bad * ∑ ℓ ∈ U, c (rebuild ℓ) * K (P ℓ) := by
      dsimp only [G]
      rw [← Finset.sum_preimage (fun d : ℕ+ => b * d) Qset
        (fun _ _ _ _ h => mul_left_cancel h) _
        (fun q hq hnot => by
          simp [hFempty q hq (fun hbq => hnot (Exists.imp (fun _ hd => hd.symm) hbq))])]
      trans ∑ d ∈ D, bad * ∑ ℓ ∈ U, c (rebuild ℓ) * dterm d (P ℓ)
      · exact Finset.sum_congr rfl hbyd
      rw [← Finset.mul_sum, Finset.sum_comm]
      simp only [K, Finset.mul_sum]
    let Hb : ℝ := x ^ (3 * ε / 2) * H / (B : ℝ)
    let L : Finset ℤ := (Finset.Icc (Int.ceil (-Hb)) (Int.floor Hb)).filter (fun z => z ≠ 0)
    let τ₃ : ℤ → ℝ := fun z => (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 3) z.natAbs : ℝ)
    let J : ℝ := ∑ z ∈ L, τ₃ z * ‖K z‖
    have hUL : U.image P ⊆ L := by
      intro z hz
      obtain ⟨ℓ, hℓ, rfl⟩ := Finset.mem_image.mp hz
      have hs := (hUmem ℓ).mp hℓ
      obtain ⟨hbox, _⟩ := Finset.mem_filter.mp hs.1
      obtain ⟨h₁, h₂₃⟩ := Finset.mem_product.mp hbox
      obtain ⟨h₂, h₃⟩ := Finset.mem_product.mp h₂₃
      have habs := hfrequency_bound T₁ T₂ T₃ v.1 v.2.1 v.2.2 hv₁ hv₂ hv₃ ℓ h₁ h₂ h₃
      have hvolume : T₁ * T₂ * T₃ / (B : ℝ) = Hb := by
        dsimp only [T₁, T₂, T₃, Hb, H, N]
        rw [show 3 * ε / 2 = ε / 2 * (3 : ℝ) by ring, Real.rpow_mul hx0.le,
          Real.rpow_ofNat]
        simp only [div_mul_div_comm]
        ring
      have hbound : |((P ℓ : ℤ) : ℝ)| ≤ Hb := habs.trans_eq hvolume
      exact Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr
        ⟨Int.ceil_le.mpr (abs_le.mp hbound).1, Int.le_floor.mpr (abs_le.mp hbound).2⟩,
        hUprod ℓ hℓ⟩
    have hτ (z : ℤ) : 0 ≤ τ₃ z := Nat.cast_nonneg _
    have hJsub : (∑ z ∈ U.image P, τ₃ z * ‖K z‖) ≤ J :=
      Finset.sum_le_sum_of_subset_of_nonneg hUL (fun z _ _ => mul_nonneg (hτ z) (norm_nonneg _))
    let W : ℝ := ((U.sup (fun ℓ => ‖c (rebuild ℓ)‖₊) : ℝ≥0) : ℝ)
    have hW : W ≤ Wc :=
      NNReal.coe_le_coe.mpr
        (show U.sup (fun ℓ => ‖c (rebuild ℓ)‖₊) ≤ (⟨Wc, hWc⟩ : ℝ≥0) from
          Finset.sup_le fun ℓ hℓ =>
            NNReal.coe_le_coe.mp (hc (rebuild ℓ) ((hUmem ℓ).mp hℓ).1))
    have hreg : ‖∑ ℓ ∈ U, c (rebuild ℓ) * K (P ℓ)‖ ≤ 4 * Wc * J := by
      have ht := (typeIII_signed_product_regrouped_kl3_bound b v.1 v.2.1 v.2.2 D I η' α ad
        U (fun ℓ => c (rebuild ℓ)) hUprod).2.2
      exact ht.trans (mul_le_mul (mul_le_mul_of_nonneg_left hW (by norm_num)) hJsub
        (Finset.sum_nonneg (fun z _ => mul_nonneg (hτ z) (norm_nonneg _))) (by positivity))
    have hJ : J ≤ 288 * (2 * Wη) * Wα * Real.sqrt ((2 * Tψ + 3) * Lw) *
        x ^ (ε + 5 * ε / 4) / ((b : ℝ) * Real.sqrt (B : ℝ)) * Zsum :=
      (hComp x hxC M N Qcenter hM hN hQ hMNlo hMNhi hQup Y hY
        b v.1 v.2.1 v.2.2 hv₁ hv₂ hv₃ rfl D hD a₀ ad
        (fun d hd => ha (b * d) ((hDmem d).mp hd)) M₀ M₁ hM₀ hwidth hheight
        η' α (2 * Wη) Wα (by positivity) hWα
        (fun d hd => hη' (b * d) ((hDmem d).mp hd)) hα Tψ Lw ψ hTψ hLw
        hψ hψnonneg hψone hψsupport hψbounds).2
    have hbad : ‖bad‖ ≤
        (((radical v.1 : ℕ) : ℝ) * ((radical v.2.1 : ℕ) : ℝ) * ((radical v.2.2 : ℕ) : ℝ)) /
          (b : ℝ) ^ 2 :=
      (typeIII_full_supported_frequency_fiber_kl3 (b : ℕ) 1 v.1 v.2.1 v.2.2
        (by simpa only [mul_one, b, PNat.mk_coe] using
          (UniqueFactorizationMonoid.squarefree_radical (a := B))) hv₁ hv₂ hv₃ rfl S c 1).2.2.2
    calc
      ‖G v‖ = ‖bad‖ * ‖∑ ℓ ∈ U, c (rebuild ℓ) * K (P ℓ)‖ := by rw [hGexact, norm_mul]
      _ ≤ ((((radical v.1 : ℕ) : ℝ) * ((radical v.2.1 : ℕ) : ℝ) *
          ((radical v.2.2 : ℕ) : ℝ)) / (b : ℝ) ^ 2) * (4 * Wc * J) :=
        mul_le_mul hbad hreg (norm_nonneg _) (by positivity)
      _ ≤ ((((radical v.1 : ℕ) : ℝ) * ((radical v.2.1 : ℕ) : ℝ) *
          ((radical v.2.2 : ℕ) : ℝ)) / (b : ℝ) ^ 2) *
          (4 * Wc * (288 * (2 * Wη) * Wα * Real.sqrt ((2 * Tψ + 3) * Lw) *
            x ^ (ε + 5 * ε / 4) / ((b : ℝ) * Real.sqrt (B : ℝ)) * Zsum)) :=
        mul_le_mul_of_nonneg_left (mul_le_mul_of_nonneg_left hJ (by positivity)) (by positivity)
      _ = E * weight v :=
        hweight_algebra
          ((((radical v.1 : ℕ) : ℝ) * ((radical v.2.1 : ℕ) : ℝ)) *
            ((radical v.2.2 : ℕ) : ℝ))
          (b : ℝ) Wc Wη Wα (Real.sqrt ((2 * Tψ + 3) * Lw))
          (x ^ (ε + 5 * ε / 4)) Zsum (Real.sqrt (B : ℝ))
  have hweights : (∑ v ∈ R, weight v) ≤ Cbad := hbadtotal R hRpos
  have hraw : ‖∑ v ∈ R, G v‖ ≤ E * Cbad := by
    calc
      ‖∑ v ∈ R, G v‖ ≤ ∑ v ∈ R, E * weight v := norm_sum_le_of_le _ hGbound
      _ = E * ∑ v ∈ R, weight v := (Finset.mul_sum _ _ _).symm
      _ ≤ E * Cbad := mul_le_mul_of_nonneg_left hweights hE
  have hnormalized : (N / Qcenter ^ 2) * x ^ (ε + 5 * ε / 4) * Zsum ≤
      3 * C ^ ((5 : ℝ) / 2) * (M * N) * x ^ (-3 * ε) :=
    hnormalize x M N Qcenter hx1 hM0 hN0 hQ hMNlo hMNhi hNlow hQup
  have hEeq : E = 2304 * Wc * Wη * Wα * Real.sqrt ((2 * Tψ + 3) * Lw) *
      x ^ (ε + 5 * ε / 4) * Zsum := rfl
  clear_value V G R E Zsum H N weight η' part parts F S I T₁ T₂ T₃
  clear hComp hnormalize hGbound hweights hbadtotal hRpos hrad_dvd hpart hF hsplit hpartition
    hS hη' hDeligne
  have hNQ : 0 ≤ N / Qcenter ^ 2 := by positivity
  calc
    ‖V‖ = (N / Qcenter ^ 2) * ‖∑ v ∈ R, G v‖ := by
      rw [hV, norm_mul, Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg hNQ]
    _ ≤ (N / Qcenter ^ 2) * (E * Cbad) := mul_le_mul_of_nonneg_left hraw hNQ
    _ = (2304 * Cbad * Wc * Wη * Wα * Real.sqrt ((2 * Tψ + 3) * Lw)) *
        ((N / Qcenter ^ 2) * x ^ (ε + 5 * ε / 4) * Zsum) := by rw [hEeq]; ring
    _ ≤ (2304 * Cbad * Wc * Wη * Wα * Real.sqrt ((2 * Tψ + 3) * Lw)) *
        (3 * C ^ ((5 : ℝ) / 2) * (M * N) * x ^ (-3 * ε)) :=
      mul_le_mul_of_nonneg_left
        hnormalized
        (mul_nonneg
          (mul_nonneg (mul_nonneg (mul_nonneg
            (mul_nonneg (by norm_num : (0 : ℝ) ≤ 2304) hCbad.le) hWc) hWη) hWα)
          (Real.sqrt_nonneg _))
    _ = (6912 * Cbad * C ^ ((5 : ℝ) / 2)) * Wc * Wη * Wα *
        Real.sqrt ((2 * Tψ + 3) * Lw) * (M * N) * x ^ (-3 * ε) := by ring

end

section

local notation3 "∞" => ((⊤ : ℕ∞) : WithTop ℕ∞)
open Classical in
theorem sourceSigmaFour_terminal_dictionary
    (ω δ ε C cN TN cD TD : ℝ)
    (hω : 0 < ω) (hδ : 0 < δ) (hε : 0 < ε) (hC : 1 ≤ C)
    (_ : 0 < cN) (_ : cN ≤ TN) (hcD : 0 < cD) (_ : cD ≤ TD) :
    ∃ X₀ : ℝ, Real.exp 1 ≤ X₀ ∧
      ∀ (x : ℝ), X₀ ≤ x →
      ∀ (m r₁ q₀ u₁ v₁ v₂ q₂ : ℕ) [NeZero m] [NeZero q₀],
      m = r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂ →
      ∀ (M N R₀ Q H Δ d₀ γ : ℝ),
      0 < M → 0 < N → 0 < R₀ → 0 < Q → 0 < Δ →
      x / C ≤ M * N → N = x ^ γ →
      1 / 4 + 12 * ω + 4 * δ + 100 * ε ≤ γ →
      N ≤ C * x ^ (δ + 4 * ε) * R₀ →
      R₀ * Q ≤ C * x ^ (1 / 2 + 2 * ω + ε) →
      H = x ^ ε * R₀ * Q ^ 2 / ((q₀ : ℝ) * M) →
      N ≤ C * x ^ (δ + 50 * ε) * H ^ 2 * Δ →
      Δ / C ≤ d₀ →
      let Δ₁ : ℝ := x ^ (-5 * ε) * Δ
      let dInt : ℤ := ⌊d₀⌋
      let shift : ℝ := ((dInt : ℝ) - d₀) / Δ₁
      1 ≤ Δ₁ ∧
        (1 / (2 * C)) * x ^ (5 * ε) * Δ₁ ≤ (dInt : ℝ) ∧
        -1 ≤ shift ∧ shift ≤ 0 ∧
        ∀ (w₀ w₁ w₂ : ℕ), 0 < w₁ → w₀ ∣ w₁ → Nat.Coprime w₁ m →
        ∀ (y y' : ℤ) (Y : ℝ),
        (w₁ : ℤ) ∣ y → (w₁ : ℤ) ∣ y' →
        (1 ≤ (y : ℝ) / Y ∧ (y : ℝ) / Y < 2) →
        (1 ≤ (y' : ℝ) / Y ∧ (y' : ℝ) / Y < 2) →
        w₂ = (∏ p ∈ m.primeFactors, p ^ (y.natAbs.factorization p)) →
        w₂ = (∏ p ∈ m.primeFactors, p ^ (y'.natAbs.factorization p)) →
        ∀ (Ao Bo ℓ : ℤ) (Tcut : ℝ),
        ∀ (E : ZMod q₀ → Finset (ZMod q₀)),
        (∀ r, (E r).card ≤ Int.gcd (q₀ : ℤ) ℓ) →
        ∀ (ψN ψD : ℝ → ℝ), ContDiff ℝ ∞ ψN → ContDiff ℝ ∞ ψD →
        Function.support ψN ⊆ Set.Icc cN TN →
        Function.support ψD ⊆ Set.Icc cD TD →
        ∀ j : ℕ,
        let z₁ : ℕ := w₀ * w₁
        let s : ℕ := z₁ / w₁
        let lam : ℤ := y / (w₁ : ℤ)
        let lamTilde : ℤ := y' / (w₁ : ℤ)
        let Λ : ℝ := Y / (w₁ : ℝ)
        let c₁ : ℕ := r₁ * q₀ * u₁ * Nat.lcm v₁ v₂
        let c₂ : ℕ := q₀ * q₂
        let l : ℤ := ℓ * (z₁ : ℤ) * (r₁ : ℤ)
        let An : ℤ := (((Ao : ZMod m) * (w₁ : ZMod m) * (z₁ : ZMod m)⁻¹).val : ℤ)
        let Bn : ℤ := (((Bo : ZMod m) * (z₁ : ZMod m)).val : ℤ)
        let En : ZMod q₀ → Finset (ZMod q₀) := fun r => E ((z₁ : ZMod q₀) * r)
        let χ : ℝ → ℝ := fun u => ψD u * u ^ j
        let φ : ℝ → ℂ := fun u => (χ (u + shift) : ℂ)
        let ψ : ℝ → ℂ := fun u => (ψN u : ℂ)
        let τ : ℕ → ℝ := fun d => ((z₁ : ℝ) * (d : ℝ) - (dInt : ℝ)) / Δ₁
        let Dold : Finset ℕ := (Finset.Icc 1 ⌊d₀ + TD * Δ₁⌋₊).filter
          fun d => χ (((d : ℝ) - d₀) / Δ₁) ≠ 0
        let D : Finset ℕ :=
          (Finset.Icc 1 ⌊((dInt : ℝ) + (TD + 1) * Δ₁) / (z₁ : ℝ)⌋₊).filter
            fun d => φ (τ d) ≠ 0
        let I : Finset ℤ := (Finset.Icc ⌈cN * N⌉ ⌊TN * N⌋).filter
          fun n => ψ ((n : ℝ) / N) ≠ 0
        let Cn : ℕ → ℤ → ℂ := fun d n =>
          if (n : ZMod q₀) ∈ En (d : ZMod q₀) then 1 else 0
        let Jn : ℕ → ℤ → ℤ → ℤ := fun d n nt =>
          (lam * (nt + Bn * (d : ℤ)) - lamTilde * (n + Bn * (d : ℤ))) / (d : ℤ)
        let U₅ : ℕ → ℤ → ℤ → ℂ := fun d n nt =>
          if Int.gcd (d : ℤ) ((m : ℤ) * lam * lamTilde) = 1 ∧
              Int.gcd (n * nt) ((w₁ * c₁ : ℕ) : ℤ) = 1 ∧
              Int.gcd ((n + l * (d : ℤ)) * (nt + l * (d : ℤ))) (c₂ : ℤ) = 1 ∧
              (Int.gcd (Jn d n nt) (m : ℤ) : ℝ) ≤ Tcut then
            Cn d n * Cn d nt *
              reciprocalUnitPhase m ((An : ZMod m) * (Jn d n nt : ZMod m))
                (((n + Bn * (d : ℤ) : ℤ) : ZMod m) *
                  ((nt + Bn * (d : ℤ) : ℤ) : ZMod m))
          else 0
        let term₅ : ℕ → ℤ → ℤ → ℂ := fun d n nt =>
          if Int.ModEq ((s * d : ℕ) : ℤ) (lam * nt) (lamTilde * n) then
            U₅ d n nt * φ (τ d) * ψ ((n : ℝ) / N) * ψ ((nt : ℝ) / N)
          else 0
        let S₅ : ℂ := ∑ d ∈ D, ∑ n ∈ I, ∑ nt ∈ I, term₅ d n nt
        let F₄ : ℕ → ℂ := sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
          Ao Bo ℓ E ψN ψD N Δ₁ d₀ j y y' (Tcut : WithTop ℝ)
        0 < z₁ ∧ w₁ ∣ z₁ ∧ s = w₀ ∧ Nat.Coprime z₁ m ∧
          q₀ ∣ m ∧ c₁ ∣ m ∧ c₂ ∣ m ∧
          y = (w₁ : ℤ) * lam ∧ y' = (w₁ : ℤ) * lamTilde ∧
          lam ≠ 0 ∧ lamTilde ≠ 0 ∧ Λ ≠ 0 ∧
          (1 ≤ (lam : ℝ) / Λ ∧ (lam : ℝ) / Λ < 2) ∧
          (1 ≤ (lamTilde : ℝ) / Λ ∧ (lamTilde : ℝ) / Λ < 2) ∧
          w₂ = (∏ p ∈ m.primeFactors, p ^ (lam.natAbs.factorization p)) ∧
          w₂ = (∏ p ∈ m.primeFactors, p ^ (lamTilde.natAbs.factorization p)) ∧
          0 ≤ An ∧ An < (m : ℤ) ∧ 0 ≤ Bn ∧ Bn < (m : ℤ) ∧
          (An : ZMod m) = (Ao : ZMod m) * (w₁ : ZMod m) * (z₁ : ZMod m)⁻¹ ∧
          (IsUnit (An : ZMod m) ↔ IsUnit (Ao : ZMod m)) ∧
          Int.ModEq (m : ℤ) Bn (Bo * (z₁ : ℤ)) ∧
          (∀ r, (En r).card ≤ Int.gcd (q₀ : ℤ) ℓ) ∧
          (∀ (d : ℕ) (n : ℤ), Cn d n =
            if (n : ZMod q₀) ∈ E ((z₁ * d : ℕ) : ZMod q₀) then 1 else 0) ∧
          ContDiff ℝ ∞ φ ∧ ContDiff ℝ ∞ ψ ∧
          Function.support φ ⊆ Set.Icc cD (TD + 1) ∧
          Function.support ψ ⊆ Set.Icc cN TN ∧
          (∀ (r : ℕ) (u : ℝ),
            iteratedDeriv r φ u = ((iteratedDeriv r χ (u + shift) : ℝ) : ℂ) ∧
            iteratedDeriv r ψ u = ((iteratedDeriv r ψN u : ℝ) : ℂ)) ∧
          (∀ d : ℕ, φ (τ d) = (χ ((((z₁ * d : ℕ) : ℝ) - d₀) / Δ₁) : ℂ)) ∧
          D = (Dold.filter fun d => z₁ ∣ d).image (fun d => d / z₁) ∧
          (∀ d : ℕ, d ∈ D ↔ φ (τ d) ≠ 0) ∧
          (∀ n : ℤ, n ∈ I ↔ ψ ((n : ℝ) / N) ≠ 0) ∧
          HasSum (fun p : ℕ × (ℤ × ℤ) => term₅ p.1 p.2.1 p.2.2) S₅ ∧
          S₅ = (∑' d : ℕ, ∑' n : ℤ, ∑' nt : ℤ, term₅ d n nt) ∧
          (∀ d ∉ Dold, F₄ d = 0) ∧
          HasSum F₄ (if Int.gcd (s : ℤ) ((m : ℤ) * lam * lamTilde) = 1 then S₅ else 0) ∧
          (∑' d : ℕ, F₄ d) =
            (if Int.gcd (s : ℤ) ((m : ℤ) * lam * lamTilde) = 1 then S₅ else 0) ∧
          ((∑' d : ℕ, F₄ d) ≠ 0 →
            (z₁ : ℝ) ≤ d₀ + TD * Δ₁ ∧
            |(l : ℝ)| ≤ |(ℓ : ℝ)| * (r₁ : ℝ) * (d₀ + TD * Δ₁)) ∧
          ‖∑' d : ℕ, F₄ d‖ =
            (if Int.gcd (s : ℤ) ((m : ℤ) * lam * lamTilde) = 1 then ‖S₅‖ else 0) := by
  let X₀ : ℝ := max (Real.exp 1) (max (C ^ 36) ((2 * C) ^ ((5 * ε)⁻¹)))
  refine ⟨X₀, le_max_left _ _, ?_⟩
  intro x hx m r₁ q₀ u₁ v₁ v₂ q₂ _ _ hm M N R₀ Q H Δ d₀ γ
    hM hN hR₀ hQ hΔ hMNlo hNdef hγ hNR hRQ hHdef hΔscale hd₀
  let Δ₁ : ℝ := x ^ (-5 * ε) * Δ
  let dInt : ℤ := ⌊d₀⌋
  let shift : ℝ := ((dInt : ℝ) - d₀) / Δ₁
  change 1 ≤ Δ₁ ∧
    (1 / (2 * C)) * x ^ (5 * ε) * Δ₁ ≤ (dInt : ℝ) ∧
    -1 ≤ shift ∧ shift ≤ 0 ∧ _
  have hxexp : Real.exp 1 ≤ x := (le_max_left _ _).trans hx
  have hx1 : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hxexp
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hpow (a : ℝ) : 0 < x ^ a := Real.rpow_pos_of_pos hx0 a
  have hqnat : 0 < q₀ := Nat.pos_of_ne_zero (NeZero.ne q₀)
  have hqpos : 0 < (q₀ : ℝ) := by exact_mod_cast hqnat
  have hqone : (1 : ℝ) ≤ q₀ := by exact_mod_cast hqnat
  have hHpos : 0 < H := by rw [hHdef]; positivity
  have hΔ₁pos : 0 < Δ₁ := mul_pos (hpow _) hΔ
  have hC36 : C ^ 36 ≤ x :=
    (le_max_left _ _).trans ((le_max_right _ _).trans hx)
  have hlarge : 2 * C ≤ x ^ (5 * ε) := by
    apply (Real.rpow_inv_le_iff_of_pos (by positivity) hx0.le (by positivity)).mp
    exact (le_max_right _ _).trans ((le_max_right _ _).trans hx)
  have hC9 : C ^ 9 ≤ x ^ (1 / 4 : ℝ) := by
    have hfour : (C ^ 9) ^ (4 : ℝ) ≤ x := by
      simpa only [Real.rpow_ofNat, ← pow_mul] using hC36
    have h := (Real.le_rpow_inv_iff_of_pos (pow_nonneg hCpos.le 9)
      hx0.le (by norm_num : (0 : ℝ) < 4)).mpr hfour
    simpa only [one_div] using h
  let E : ℝ := 4 * ω + δ + 7 * ε
  let Dexp : ℝ := 8 * ω + 3 * δ + 69 * ε
  have hHproduct : H * ((q₀ : ℝ) * M) = x ^ ε * R₀ * Q ^ 2 :=
    (eq_div_iff (mul_ne_zero hqpos.ne' hM.ne')).mp hHdef
  have hRQsq : (R₀ * Q) ^ 2 ≤
      (C * x ^ ((1 / 2 : ℝ) + 2 * ω + ε)) ^ 2 :=
    pow_le_pow_left₀ (mul_nonneg hR₀.le hQ.le) hRQ 2
  have hHX : H * (q₀ : ℝ) * x ≤ C ^ 4 * x ^ E * x := by
    calc
      H * (q₀ : ℝ) * x ≤ H * (q₀ : ℝ) * (C * (M * N)) :=
        mul_le_mul_of_nonneg_left ((div_le_iff₀' hCpos).mp hMNlo) (by positivity)
      _ = C * x ^ ε * (R₀ * Q ^ 2) * N := by
        calc
          _ = C * (H * ((q₀ : ℝ) * M)) * N := by ring
          _ = _ := by rw [hHproduct]; ring
      _ ≤ C * x ^ ε * (R₀ * Q ^ 2) *
          (C * x ^ (δ + 4 * ε) * R₀) :=
        mul_le_mul_of_nonneg_left hNR (by positivity)
      _ = C ^ 2 * x ^ ε * x ^ (δ + 4 * ε) * (R₀ * Q) ^ 2 := by ring
      _ ≤ C ^ 2 * x ^ ε * x ^ (δ + 4 * ε) *
          (C * x ^ ((1 / 2 : ℝ) + 2 * ω + ε)) ^ 2 :=
        mul_le_mul_of_nonneg_left hRQsq (by positivity)
      _ = C ^ 4 * (x ^ ε * x ^ (δ + 4 * ε) *
          x ^ (((1 / 2 : ℝ) + 2 * ω + ε) * 2)) := by
        rw [mul_pow, ← Real.rpow_mul_natCast hx0.le]
        ring_nf
      _ = C ^ 4 * x ^ (ε + (δ + 4 * ε) +
          ((1 / 2 : ℝ) + 2 * ω + ε) * 2) := by
        rw [← Real.rpow_add hx0 ε (δ + 4 * ε),
          ← Real.rpow_add hx0 (ε + (δ + 4 * ε))
            (((1 / 2 : ℝ) + 2 * ω + ε) * 2)]
      _ = C ^ 4 * x ^ (E + 1) := by
        congr 2
        dsimp only [E]
        ring
      _ = C ^ 4 * x ^ E * x := by
        rw [Real.rpow_add_one hx0.ne' E, mul_assoc]
  have hHbound : H ≤ C ^ 4 * x ^ E / (q₀ : ℝ) := by
    apply (le_div_iff₀ hqpos).mpr
    exact (mul_le_mul_iff_left₀ hx0).mp hHX
  have hHsimple : H ≤ C ^ 4 * x ^ E :=
    hHbound.trans (div_le_self (by positivity) hqone)
  have hΔeq : Δ = x ^ (5 * ε) * Δ₁ := by
    dsimp only [Δ₁]
    rw [← mul_assoc, ← Real.rpow_add hx0,
      show 5 * ε + -5 * ε = 0 by ring, Real.rpow_zero, one_mul]
  have hHsq : H ^ 2 ≤ (C ^ 4 * x ^ E) ^ 2 :=
    pow_le_pow_left₀ hHpos.le hHsimple 2
  have hNupper : N ≤ C ^ 9 * x ^ Dexp * Δ₁ := by
    calc
      N ≤ C * x ^ (δ + 50 * ε) * H ^ 2 * Δ := hΔscale
      _ ≤ C * x ^ (δ + 50 * ε) * (C ^ 4 * x ^ E) ^ 2 * Δ :=
        mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left hHsq (by positivity)) hΔ.le
      _ = C ^ 9 * (x ^ (δ + 50 * ε) * x ^ (E * 2) * x ^ (5 * ε)) * Δ₁ := by
        rw [hΔeq, mul_pow, ← Real.rpow_mul_natCast hx0.le]
        ring_nf
      _ = C ^ 9 * x ^ Dexp * Δ₁ := by
        rw [← Real.rpow_add hx0 (δ + 50 * ε) (E * 2),
          ← Real.rpow_add hx0 (δ + 50 * ε + E * 2) (5 * ε),
          show δ + 50 * ε + E * 2 + 5 * ε = Dexp by
            dsimp only [E, Dexp]
            ring]
  have hscaleN : C ^ 9 * x ^ Dexp ≤ N := by
    calc
      C ^ 9 * x ^ Dexp ≤ x ^ (1 / 4 : ℝ) * x ^ Dexp :=
        mul_le_mul_of_nonneg_right hC9 (hpow _).le
      _ = x ^ ((1 / 4 : ℝ) + Dexp) := (Real.rpow_add hx0 _ _).symm
      _ ≤ x ^ γ := Real.rpow_le_rpow_of_exponent_le hx1 (by
        dsimp only [Dexp]
        linarith only [hγ, hω, hδ, hε])
      _ = N := hNdef.symm
  have hΔ₁one : 1 ≤ Δ₁ := by
    apply (mul_le_mul_iff_right₀ (show 0 < C ^ 9 * x ^ Dexp by positivity)).mp
    simpa only [mul_one] using hscaleN.trans hNupper
  have hΔlarge : 2 * C ≤ Δ := by
    calc
      2 * C ≤ x ^ (5 * ε) := hlarge
      _ ≤ x ^ (5 * ε) * Δ₁ :=
        le_mul_of_one_le_right (hpow _).le hΔ₁one
      _ = Δ := hΔeq.symm
  have hd₀two : 2 ≤ d₀ := by
    have h := hΔlarge.trans ((div_le_iff₀ hCpos).mp hd₀)
    exact (mul_le_mul_iff_left₀ hCpos).mp h
  have hfloorlow : d₀ - 1 < (dInt : ℝ) := Int.sub_one_lt_floor d₀
  have hfloorhigh : (dInt : ℝ) ≤ d₀ := Int.floor_le d₀
  have hfloorhalf : d₀ / 2 ≤ (dInt : ℝ) := by
    linarith only [hfloorlow, hd₀two]
  have hdIntlower :
      (1 / (2 * C)) * x ^ (5 * ε) * Δ₁ ≤ (dInt : ℝ) := by
    calc
      (1 / (2 * C)) * x ^ (5 * ε) * Δ₁ =
          (x ^ (5 * ε) * Δ₁) / C / 2 := by ring
      _ = (Δ / C) / 2 := by rw [← hΔeq]
      _ ≤ d₀ / 2 := div_le_div_of_nonneg_right hd₀ (by norm_num)
      _ ≤ (dInt : ℝ) := hfloorhalf
  have hshiftlo : -1 ≤ shift := by
    apply (le_div_iff₀ hΔ₁pos).mpr
    linarith only [hfloorlow, hΔ₁one]
  have hshifthi : shift ≤ 0 :=
    div_nonpos_of_nonpos_of_nonneg (sub_nonpos.mpr hfloorhigh) hΔ₁pos.le
  refine ⟨hΔ₁one, hdIntlower, hshiftlo, hshifthi, ?_⟩
  intro w₀ w₁ w₂ hw₁ hw₀ hw₁m y y' Y hydiv hy'div hyband hy'band hw₂ hw₂'
    Ao Bo ℓ Tcut E hE ψN ψD hψN hψD hsuppN hsuppD j
    z₁ s lam lamTilde Λ c₁ c₂ l An Bn En χ φ ψ τ Dold D I Cn Jn U₅ term₅ S₅ F₄
  have hw₀pos : 0 < w₀ := Nat.pos_of_dvd_of_pos hw₀ hw₁
  have hzpos : 0 < z₁ := Nat.mul_pos hw₀pos hw₁
  have hwz : w₁ ∣ z₁ := Nat.dvd_mul_left w₁ w₀
  have hs : s = w₀ := by dsimp only [s, z₁]; exact Nat.mul_div_cancel _ hw₁
  have hzm : Nat.Coprime z₁ m :=
    Nat.coprime_mul_iff_left.mpr ⟨hw₁m.of_dvd_left hw₀, hw₁m⟩
  let : NeZero w₁ := ⟨hw₁.ne'⟩
  let : NeZero z₁ := ⟨hzpos.ne'⟩
  have hwR : (w₁ : ℝ) ≠ 0 := by exact_mod_cast hw₁.ne'
  have hzR : 0 < (z₁ : ℝ) := by exact_mod_cast hzpos
  have hqdiv : q₀ ∣ m := by
    refine ⟨r₁ * u₁ * Nat.lcm v₁ v₂ * q₂, ?_⟩
    rw [hm]
    ring
  have hc₁div : c₁ ∣ m := by
    refine ⟨q₂, ?_⟩
    exact hm
  have hc₂div : c₂ ∣ m := by
    refine ⟨r₁ * u₁ * Nat.lcm v₁ v₂, ?_⟩
    dsimp only [c₂]
    rw [hm]
    ring
  have hy : y = (w₁ : ℤ) * lam := (Int.mul_ediv_cancel' hydiv).symm
  have hy' : y' = (w₁ : ℤ) * lamTilde := (Int.mul_ediv_cancel' hy'div).symm
  obtain ⟨hyReal, hY⟩ := div_ne_zero_iff.mp (zero_lt_one.trans_le hyband.1).ne'
  have hyne : y ≠ 0 := by exact_mod_cast hyReal
  have hy'ne : y' ≠ 0 := by
    exact_mod_cast (div_ne_zero_iff.mp (zero_lt_one.trans_le hy'band.1).ne').1
  have hlam : lam ≠ 0 := by intro h; exact hyne (by simpa only [h, mul_zero] using hy)
  have hlamTilde : lamTilde ≠ 0 := by
    intro h
    exact hy'ne (by simpa only [h, mul_zero] using hy')
  have hΛ : Λ ≠ 0 := div_ne_zero hY hwR
  have hlamRatio : (lam : ℝ) / Λ = (y : ℝ) / Y := by
    rw [hy]
    dsimp only [Λ]
    push_cast
    field_simp [hY, hwR]
  have hlamTildeRatio : (lamTilde : ℝ) / Λ = (y' : ℝ) / Y := by
    rw [hy']
    dsimp only [Λ]
    push_cast
    field_simp [hY, hwR]
  have hlamBand : 1 ≤ (lam : ℝ) / Λ ∧ (lam : ℝ) / Λ < 2 :=
    hlamRatio.symm ▸ hyband
  have hlamTildeBand : 1 ≤ (lamTilde : ℝ) / Λ ∧ (lamTilde : ℝ) / Λ < 2 :=
    hlamTildeRatio.symm ▸ hy'band
  have hw₂lam : w₂ = ∏ p ∈ m.primeFactors, p ^ (lam.natAbs.factorization p) := by
    rw [hw₂, hy, Int.natAbs_mul, Int.natAbs_natCast]
    exact (primeFactors_prod_pow_factorization_dvd_and_coprime_div m lam.natAbs (NeZero.ne m)
      (Int.natAbs_ne_zero.mpr hlam)).2.2.2.2 w₁ hw₁.ne' hw₁m
  have hw₂lamTilde :
      w₂ = ∏ p ∈ m.primeFactors, p ^ (lamTilde.natAbs.factorization p) := by
    rw [hw₂', hy', Int.natAbs_mul, Int.natAbs_natCast]
    exact (primeFactors_prod_pow_factorization_dvd_and_coprime_div m lamTilde.natAbs (NeZero.ne m)
      (Int.natAbs_ne_zero.mpr hlamTilde)).2.2.2.2 w₁ hw₁.ne' hw₁m
  have hAnonneg : 0 ≤ An := Int.natCast_nonneg _
  have hAnlt : An < (m : ℤ) := by
    dsimp only [An]
    exact_mod_cast (ZMod.val_lt ((Ao : ZMod m) * (w₁ : ZMod m) * (z₁ : ZMod m)⁻¹))
  have hBnnonneg : 0 ≤ Bn := Int.natCast_nonneg _
  have hBnlt : Bn < (m : ℤ) := by
    dsimp only [Bn]
    exact_mod_cast (ZMod.val_lt ((Bo : ZMod m) * (z₁ : ZMod m)))
  have hA : (An : ZMod m) =
      (Ao : ZMod m) * (w₁ : ZMod m) * (z₁ : ZMod m)⁻¹ := by
    dsimp only [An]
    rw [Int.cast_natCast, ZMod.natCast_zmod_val]
  have hBcast : (Bn : ZMod m) = (Bo : ZMod m) * (z₁ : ZMod m) := by
    dsimp only [Bn]
    rw [Int.cast_natCast, ZMod.natCast_zmod_val]
  have hB : Int.ModEq (m : ℤ) Bn (Bo * (z₁ : ℤ)) :=
    (ZMod.intCast_eq_intCast_iff _ _ m).mp (by
      simpa only [Int.cast_mul, Int.cast_natCast] using hBcast)
  have hwunit : IsUnit (w₁ : ZMod m) := (ZMod.isUnit_iff_coprime _ _).mpr hw₁m
  have hzunit : IsUnit (z₁ : ZMod m) := (ZMod.isUnit_iff_coprime _ _).mpr hzm
  have hzinv : IsUnit (z₁ : ZMod m)⁻¹ := by
    simpa only [Int.cast_natCast] using
      ZMod.isUnit_inv (n := (z₁ : ℤ)) (by simpa only [Int.cast_natCast] using hzunit)
  have hAunit : IsUnit (An : ZMod m) ↔ IsUnit (Ao : ZMod m) := by
    rw [hA, hzinv.mul_right_iff, hwunit.mul_right_iff]
  have hEn (r : ZMod q₀) : (En r).card ≤ Int.gcd (q₀ : ℤ) ℓ := hE _
  have hCn (d : ℕ) (n : ℤ) : Cn d n =
      if (n : ZMod q₀) ∈ E ((z₁ * d : ℕ) : ZMod q₀) then 1 else 0 := by
    simp only [Cn, En, Nat.cast_mul]
  have hχ : ContDiff ℝ ∞ χ := hψD.mul (contDiff_id.pow j)
  have hφ : ContDiff ℝ ∞ φ := by
    change ContDiff ℝ ∞ (fun u : ℝ => (χ (u + shift) : ℂ))
    exact Complex.ofRealCLM.contDiff.comp (hχ.comp
      (show ContDiff ℝ ∞ (fun u : ℝ => u + shift) from contDiff_id.add contDiff_const))
  have hψ : ContDiff ℝ ∞ ψ := Complex.ofRealCLM.contDiff.comp hψN
  have hχsupport : Function.support χ ⊆ Set.Icc cD TD :=
    (Function.support_mul_subset_left ψD (fun u => u ^ j)).trans hsuppD
  have hφsupport : Function.support φ ⊆ Set.Icc cD (TD + 1) := by
    intro u hu
    obtain ⟨hlo, hhi⟩ := hχsupport (Complex.ofReal_ne_zero.mp hu)
    constructor <;> linarith only [hlo, hhi, hshiftlo, hshifthi]
  have hψsupport : Function.support ψ ⊆ Set.Icc cN TN :=
    (Function.support_comp_subset Complex.ofReal_zero ψN).trans hsuppN
  have hcastDeriv (f : ℝ → ℝ) (hf : ContDiff ℝ ∞ f) (r : ℕ) (u : ℝ) :
      iteratedDeriv r (fun v => (f v : ℂ)) u = ((iteratedDeriv r f u : ℝ) : ℂ) := by
    simpa only [Complex.real_smul, mul_one] using
      iteratedDeriv_smul_const ((contDiff_infty.mp hf r).contDiffAt) (1 : ℂ)
  have hderiv (r : ℕ) (u : ℝ) :
      iteratedDeriv r φ u = ((iteratedDeriv r χ (u + shift) : ℝ) : ℂ) ∧
      iteratedDeriv r ψ u = ((iteratedDeriv r ψN u : ℝ) : ℂ) := by
    constructor
    · change iteratedDeriv r (fun v : ℝ => (χ (v + shift) : ℂ)) u = _
      rw [iteratedDeriv_comp_add_const r (fun v : ℝ => (χ v : ℂ)) shift]
      exact hcastDeriv χ hχ r (u + shift)
    · exact hcastDeriv ψN hψN r u
  have hφeval (d : ℕ) :
      φ (τ d) = (χ ((((z₁ * d : ℕ) : ℝ) - d₀) / Δ₁) : ℂ) := by
    change (χ (((z₁ : ℝ) * (d : ℝ) - (dInt : ℝ)) / Δ₁ + shift) : ℂ) = _
    congr 2
    change ((z₁ : ℝ) * (d : ℝ) - (dInt : ℝ)) / Δ₁ +
      ((dInt : ℝ) - d₀) / Δ₁ = (((z₁ * d : ℕ) : ℝ) - d₀) / Δ₁
    push_cast
    ring
  have hd₀pos : 0 < d₀ := (div_pos hΔ hCpos).trans_le hd₀
  have hdIntpos : 0 < (dInt : ℝ) := by
    exact (show 0 < (1 / (2 * C)) * x ^ (5 * ε) * Δ₁ by positivity).trans_le hdIntlower
  have hDold (d : ℕ) : d ∈ Dold ↔ χ (((d : ℝ) - d₀) / Δ₁) ≠ 0 := by
    constructor
    · exact fun hd => (Finset.mem_filter.mp hd).2
    · intro hd
      obtain ⟨hlo, hhi⟩ := hχsupport hd
      have hlow : d₀ + cD * Δ₁ ≤ (d : ℝ) := by
        have := (le_div_iff₀ hΔ₁pos).mp hlo
        linarith only [this]
      have hupp : (d : ℝ) ≤ d₀ + TD * Δ₁ := by
        have := (div_le_iff₀ hΔ₁pos).mp hhi
        linarith only [this]
      have hpos : 0 < d := by
        exact_mod_cast (add_pos hd₀pos (mul_pos hcD hΔ₁pos)).trans_le hlow
      exact Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr
        ⟨hpos, Nat.le_floor hupp⟩, hd⟩
  have hD (d : ℕ) : d ∈ D ↔ φ (τ d) ≠ 0 := by
    constructor
    · exact fun hd => (Finset.mem_filter.mp hd).2
    · intro hd
      obtain ⟨hlo, hhi⟩ := hφsupport hd
      have hlow : (dInt : ℝ) + cD * Δ₁ ≤ (z₁ : ℝ) * (d : ℝ) := by
        have := (le_div_iff₀ hΔ₁pos).mp hlo
        linarith only [this]
      have hupp : (d : ℝ) ≤ ((dInt : ℝ) + (TD + 1) * Δ₁) / (z₁ : ℝ) := by
        apply (le_div_iff₀ hzR).mpr
        have := (div_le_iff₀ hΔ₁pos).mp hhi
        nlinarith only [this]
      have hpos : 0 < d := by
        have hprod : 0 < (z₁ : ℝ) * (d : ℝ) :=
          (add_pos hdIntpos (mul_pos hcD hΔ₁pos)).trans_le hlow
        exact_mod_cast (mul_pos_iff_of_pos_left hzR).mp hprod
      exact Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr ⟨hpos, Nat.le_floor hupp⟩, hd⟩
  have hI (n : ℤ) : n ∈ I ↔ ψ ((n : ℝ) / N) ≠ 0 := by
    constructor
    · exact fun hn => (Finset.mem_filter.mp hn).2
    · intro hn
      obtain ⟨hlo, hhi⟩ := hψsupport hn
      exact Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr
        ⟨Int.ceil_le.mpr ((le_div_iff₀ hN).mp hlo),
          Int.le_floor.mpr ((div_le_iff₀ hN).mp hhi)⟩, hn⟩
  have hDimage : D = (Dold.filter fun d => z₁ ∣ d).image (fun d => d / z₁) := by
    ext d
    constructor
    · intro hd
      have hn : χ ((((z₁ * d : ℕ) : ℝ) - d₀) / Δ₁) ≠ 0 := by
        intro hz
        exact (hD d).mp hd (by rw [hφeval, hz, Complex.ofReal_zero])
      refine Finset.mem_image.mpr ⟨z₁ * d,
        Finset.mem_filter.mpr ⟨(hDold _).mpr hn, dvd_mul_right _ _⟩, ?_⟩
      exact Nat.mul_div_cancel_left d hzpos
    · intro hd
      obtain ⟨dOld, hdo, rfl⟩ := Finset.mem_image.mp hd
      obtain ⟨hdo, hzdiv⟩ := Finset.mem_filter.mp hdo
      apply (hD _).mpr
      rw [hφeval, Nat.mul_div_cancel' hzdiv]
      exact_mod_cast (hDold _).mp hdo
  have hDn : ((Dold.filter fun d => 0 < d ∧ z₁ ∣ d).image fun d => d / z₁) = D := by
    rw [hDimage]
    congr 1
    apply Finset.filter_congr
    intro d hd
    have hp : 0 < d := (Finset.mem_Icc.mp (Finset.mem_filter.mp hd).1).1
    simp only [hp, true_and]
  have hψzero (n : ℤ) (hn : n ∉ I) : ψN ((n : ℝ) / N) = 0 :=
    Complex.ofReal_eq_zero.mp (not_ne_iff.mp (fun h => hn ((hI n).mpr h)))
  have htermD (d : ℕ) (hd : d ∉ D) (n nt : ℤ) : term₅ d n nt = 0 := by
    have hzero : φ (τ d) = 0 := not_ne_iff.mp (fun h => hd ((hD d).mpr h))
    simp only [term₅, hzero, mul_zero, zero_mul, ite_self]
  have htermI (d : ℕ) (n nt : ℤ) (hn : n ∉ I ∨ nt ∉ I) : term₅ d n nt = 0 := by
    rcases hn with hn | hnt
    · simp only [term₅, ψ, hψzero n hn, Complex.ofReal_zero, mul_zero, zero_mul, ite_self]
    · simp only [term₅, ψ, hψzero nt hnt, Complex.ofReal_zero, mul_zero, ite_self]
  have hSsum : HasSum (fun p : ℕ × (ℤ × ℤ) => term₅ p.1 p.2.1 p.2.2) S₅ := by
    have hfinite : HasSum (fun p : ℕ × (ℤ × ℤ) => term₅ p.1 p.2.1 p.2.2)
        (∑ p ∈ D ×ˢ (I ×ˢ I), term₅ p.1 p.2.1 p.2.2) :=
      hasSum_sum_of_ne_finset_zero (by
        intro p hp
        by_cases hd : p.1 ∈ D
        · apply htermI
          simpa only [Finset.mem_product, hd, true_and, not_and_or] using hp
        · exact htermD _ hd _ _)
    simpa only [Finset.sum_product, S₅] using hfinite
  have hSiter : S₅ = ∑' d : ℕ, ∑' n : ℤ, ∑' nt : ℤ, term₅ d n nt := by
    rw [← hSsum.tsum_eq, hSsum.summable.tsum_prod]
    exact tsum_congr (fun d => (hSsum.summable.prod_factor d).tsum_prod)
  have hFzero (d : ℕ) (hd : d ∉ Dold) : F₄ d = 0 := by
    have hzero : χ (((d : ℝ) - d₀) / Δ₁) = 0 :=
      not_ne_iff.mp (fun h => hd ((hDold d).mpr h))
    change sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
      Ao Bo ℓ E ψN ψD N Δ₁ d₀ j y y' (Tcut : WithTop ℝ) d = 0
    unfold sourceSecondaryDTerm
    change (if _ then (χ (((d : ℝ) - d₀) / Δ₁) : ℂ) * _ else 0) = 0
    simp only [hzero, Complex.ofReal_zero, zero_mul, ite_self]
  let P : Finset (ℤ × ℤ) := I ×ˢ I
  let WD : ℤ → ℂ := fun k => (χ (((k : ℝ) - d₀) / Δ₁) : ℂ)
  let Co : ℤ → ℕ → ℂ := fun n d =>
    if (n : ZMod q₀) ∈ E (d : ZMod q₀) then 1 else 0
  let Jo : ℕ → ℤ × ℤ → ℤ := fun d p =>
    (((w₁ : ℤ) * lam) * (p.2 + Bo * (d : ℤ)) -
      ((w₁ : ℤ) * lamTilde) * (p.1 + Bo * (d : ℤ))) / (d : ℤ)
  let goodO : ℕ → Prop := fun d => 0 < d ∧ z₁ ∣ d ∧
    Int.gcd ((d / w₁ : ℕ) : ℤ)
      (((m : ℤ) * ((w₁ : ℤ) * lam) * ((w₁ : ℤ) * lamTilde)) / (w₁ : ℤ) ^ 2) = 1
  let Po : ℕ → ℤ × ℤ → Prop := fun d p =>
    Int.ModEq (d : ℤ) (((w₁ : ℤ) * lam) * p.2) (((w₁ : ℤ) * lamTilde) * p.1) ∧
      Int.gcd (p.1 * p.2) ((w₁ * r₁ * q₀ * u₁ * v₁ * v₂ : ℕ) : ℤ) = 1 ∧
      Int.gcd ((p.1 + ℓ * (d : ℤ) * (r₁ : ℤ)) *
        (p.2 + ℓ * (d : ℤ) * (r₁ : ℤ))) ((q₀ * q₂ : ℕ) : ℤ) = 1 ∧
      (Int.gcd (Jo d p) (m : ℤ) : ℝ) ≤ Tcut
  let Wo : ℕ → ℤ × ℤ → ℂ := fun d p =>
    Co p.1 d * Co p.2 d * ψ ((p.1 : ℝ) / N) * ψ ((p.2 : ℝ) / N) *
      reciprocalUnitPhase m ((Ao : ZMod m) * (Jo d p : ZMod m))
        (((p.1 + Bo * (d : ℤ) : ℤ) : ZMod m) *
          ((p.2 + Bo * (d : ℤ) : ℤ) : ZMod m))
  let Pn : ℕ → ℤ × ℤ → Prop := fun d p =>
    Int.ModEq ((s * d : ℕ) : ℤ) (lam * p.2) (lamTilde * p.1) ∧
      Int.gcd (p.1 * p.2) ((w₁ * c₁ : ℕ) : ℤ) = 1 ∧
      Int.gcd ((p.1 + l * (d : ℤ)) * (p.2 + l * (d : ℤ))) (c₂ : ℤ) = 1 ∧
      (Int.gcd (Jn d p.1 p.2) (m : ℤ) : ℝ) ≤ Tcut
  let Wn : ℕ → ℤ × ℤ → ℂ := fun d p =>
    Co p.1 (z₁ * d) * Co p.2 (z₁ * d) * ψ ((p.1 : ℝ) / N) * ψ ((p.2 : ℝ) / N) *
      reciprocalUnitPhase m ((An : ZMod m) * (Jn d p.1 p.2 : ZMod m))
        (((p.1 + Bn * (d : ℤ) : ℤ) : ZMod m) *
          ((p.2 + Bn * (d : ℤ) : ℤ) : ZMod m))
  let K4 : ℂ := ∑ d ∈ Dold.filter goodO, WD (d : ℤ) * ∑ p ∈ P.filter (Po d), Wo d p
  let K5 : ℂ :=
    ∑ d ∈ D.filter (fun d : ℕ => Int.gcd (d : ℤ) ((m : ℤ) * lam * lamTilde) = 1),
      WD ((z₁ * d : ℕ) : ℤ) * ∑ p ∈ P.filter (Pn d), Wn d p
  have hkernel :
      K4 = if Int.gcd (s : ℤ) ((m : ℤ) * lam * lamTilde) = 1 then K5 else 0 := by
    have h := (sourceTerminalDictionary_finite_kernel w₁ z₁ m hwz hzm
      r₁ q₀ u₁ v₁ v₂ q₂ ℓ Ao Bo An Bn lam lamTilde 0 hA hB
      Dold P Tcut WD (fun n => ψ ((n : ℝ) / N)) Co).1
    dsimp only at h
    simp only [sub_zero] at h
    rw [hDn] at h
    exact h
  have hpairZero (d : ℕ) (n nt : ℤ) (hn : n ∉ I ∨ nt ∉ I) :
      sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁ Ao Bo ℓ E ψN N
        y y' (Tcut : WithTop ℝ) d n nt = 0 := by
    rcases hn with hn | hnt
    · simp [sourceSecondaryPairTerm, hψzero n hn]
    · simp [sourceSecondaryPairTerm, hψzero nt hnt]
  have hpairFinite (d : ℕ) :
      (∑' n : ℤ, ∑' nt : ℤ,
        sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁ Ao Bo ℓ E ψN N
          y y' (Tcut : WithTop ℝ) d n nt) =
      ∑ n ∈ I, ∑ nt ∈ I,
        sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁ Ao Bo ℓ E ψN N
          y y' (Tcut : WithTop ℝ) d n nt := by
    rw [tsum_eq_sum (s := I) (by
      intro n hn
      simp only [hpairZero d n _ (Or.inl hn), tsum_zero])]
    apply Finset.sum_congr rfl
    intro n hn
    exact tsum_eq_sum (fun nt hnt => hpairZero d n nt (Or.inr hnt))
  have hFpoint (d : ℕ) :
      F₄ d = if goodO d then WD (d : ℤ) * ∑ p ∈ P.filter (Po d), Wo d p else 0 := by
    dsimp only [F₄, sourceSecondaryDTerm]
    rw [hpairFinite d, hy, hy']
    change (if goodO d then WD (d : ℤ) *
      (∑ n ∈ I, ∑ nt ∈ I,
        sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁ Ao Bo ℓ E ψN N
          ((w₁ : ℤ) * lam) ((w₁ : ℤ) * lamTilde) (Tcut : WithTop ℝ) d n nt)
      else 0) = _
    by_cases hg : goodO d
    · simp only [ite_eq_left hg]
      congr 1
      rw [← Finset.sum_product I I (fun p : ℤ × ℤ =>
        sourceSecondaryPairTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₁ Ao Bo ℓ E ψN N
          ((w₁ : ℤ) * lam) ((w₁ : ℤ) * lamTilde) (Tcut : WithTop ℝ) d p.1 p.2)]
      change (∑ p ∈ P, _) = _
      rw [Finset.sum_filter (s := P) (Po d) (Wo d)]
      apply Finset.sum_congr rfl
      intro p hp
      simp only [sourceSecondaryPairTerm, dite_eq_right (NeZero.ne m),
        WithTop.coe_le_coe, Po, Wo, Jo, Co, ψ]
    · simp only [ite_eq_right hg]
  have hFK4 : (∑' d : ℕ, F₄ d) = K4 := by
    rw [tsum_eq_sum hFzero]
    dsimp only [K4]
    rw [Finset.sum_filter (s := Dold) goodO
      (fun d : ℕ => WD (d : ℤ) * ∑ p ∈ P.filter (Po d), Wo d p)]
    exact Finset.sum_congr rfl (fun d _ => hFpoint d)
  have hWD (d : ℕ) : WD ((z₁ * d : ℕ) : ℤ) = φ (τ d) := by
    simpa only [WD, Int.cast_natCast] using (hφeval d).symm
  have hCo (d : ℕ) (n : ℤ) : Co n (z₁ * d) = Cn d n := (hCn d n).symm
  have hK5 : K5 = S₅ := by
    dsimp only [K5, S₅]
    rw [Finset.sum_filter (s := D)
      (fun d : ℕ => Int.gcd (d : ℤ) ((m : ℤ) * lam * lamTilde) = 1)
      (fun d : ℕ => WD ((z₁ * d : ℕ) : ℤ) * ∑ p ∈ P.filter (Pn d), Wn d p)]
    apply Finset.sum_congr rfl
    intro d hd
    by_cases hdg : Int.gcd (d : ℤ) ((m : ℤ) * lam * lamTilde) = 1
    · rw [ite_eq_left hdg, hWD, Finset.sum_filter (s := P) (Pn d) (Wn d)]
      dsimp only [P]
      rw [Finset.sum_product, Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro n hn
      rw [Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro nt hnt
      simp only [Pn, Wn, term₅, U₅, hCo, hdg, ite_true, ite_and,
        mul_ite, ite_mul, mul_zero, zero_mul]
      congr 1
      congr 1
      congr 1
      congr 1
      ring
    · simp only [term₅, U₅, hdg, false_and, ite_false,
        zero_mul, ite_self, Finset.sum_const_zero]
  have hFsum : (∑' d : ℕ, F₄ d) =
      if Int.gcd (s : ℤ) ((m : ℤ) * lam * lamTilde) = 1 then S₅ else 0 := by
    rw [hFK4, hkernel, hK5]
  have hFhas : HasSum F₄
      (if Int.gcd (s : ℤ) ((m : ℤ) * lam * lamTilde) = 1 then S₅ else 0) := by
    rw [← hFsum]
    exact (summable_of_ne_finset_zero hFzero).hasSum
  have hnonzero : (∑' d : ℕ, F₄ d) ≠ 0 →
      (z₁ : ℝ) ≤ d₀ + TD * Δ₁ ∧
      |(l : ℝ)| ≤ |(ℓ : ℝ)| * (r₁ : ℝ) * (d₀ + TD * Δ₁) := by
    intro hne
    have hfinite : (∑ d ∈ Dold, F₄ d) ≠ 0 :=
      fun hz => hne ((tsum_eq_sum hFzero).trans hz)
    obtain ⟨d, hd, hFd⟩ := Finset.exists_ne_zero_of_sum_ne_zero hfinite
    have hgood : goodO d := by
      by_contra h
      exact hFd (by rw [hFpoint, ite_eq_right h])
    have hzleNat : z₁ ≤ d := Nat.le_of_dvd hgood.1 hgood.2.1
    have hzle : (z₁ : ℝ) ≤ (d : ℝ) := by exact_mod_cast hzleNat
    have hupp : (d : ℝ) ≤ d₀ + TD * Δ₁ := by
      have h := (hχsupport ((hDold d).mp hd)).2
      have := (div_le_iff₀ hΔ₁pos).mp h
      linarith only [this]
    refine ⟨hzle.trans hupp, ?_⟩
    calc
      |(l : ℝ)| = |(ℓ : ℝ)| * (r₁ : ℝ) * (z₁ : ℝ) := by
        dsimp only [l]
        push_cast
        rw [abs_mul, abs_mul]
        simp only [abs_of_nonneg (show (0 : ℝ) ≤ (z₁ : ℝ) from Nat.cast_nonneg _),
          abs_of_nonneg (show (0 : ℝ) ≤ (r₁ : ℝ) from Nat.cast_nonneg _)]
        ring
      _ ≤ |(ℓ : ℝ)| * (r₁ : ℝ) * (d₀ + TD * Δ₁) :=
        mul_le_mul_of_nonneg_left (hzle.trans hupp) (by positivity)
  have hnorm : ‖∑' d : ℕ, F₄ d‖ =
      if Int.gcd (s : ℤ) ((m : ℤ) * lam * lamTilde) = 1 then ‖S₅‖ else 0 := by
    rw [hFsum]
    split_ifs <;> simp only [norm_zero]
  exact ⟨hzpos, hwz, hs, hzm, hqdiv, hc₁div, hc₂div, hy, hy', hlam, hlamTilde,
    hΛ, hlamBand, hlamTildeBand, hw₂lam, hw₂lamTilde, hAnonneg, hAnlt,
    hBnnonneg, hBnlt, hA, hAunit, hB, hEn, hCn, hφ, hψ, hφsupport,
    hψsupport, hderiv, hφeval, hDimage, hD, hI, hSsum, hSiter, hFzero,
    hFhas, hFsum, hnonzero, hnorm⟩

end

section
open scoped ContDiff
open Classical in
theorem heathBrown_finite_smooth_box_closedCutoff_discrepancy
    (j : ℕ) (hj : 0 < j) (Jmod : ℕ)
    (θ C : ℝ) (hθ0 : 0 < θ) (hθ1 : θ < 1) (hC : 1 ≤ C)
    (Asave : ℝ) (hAsave : 0 < Asave) :
    ∃ D : ℕ, 1 ≤ D ∧ ∃ K X₀ : ℝ, 0 < K ∧ max (Real.exp 1) C ≤ X₀ ∧
      ∀ x : ℝ, X₀ ≤ x →
      let Θ : ℝ := 1 + (Real.log x) ^ (-(D : ℝ))
      ∀ A B U t : ℝ, x / C ≤ A → A ≤ B → B ≤ C * x →
        0 ≤ t → t ≤ 10 →
      let η : ℝ → ℝ := fun u =>
        if 0 < u then
          Real.smoothTransition (Real.log u / Real.log Θ + 1) -
            Real.smoothTransition (Real.log u / Real.log Θ)
        else 0
      let M : ℕ := ⌈Real.log B / Real.log Θ⌉₊
      let grid : Finset (Fin (2 * j) → ℕ) :=
        Fintype.piFinset (fun _ : Fin (2 * j) => Finset.range (M + 1))
      let scale : (Fin (2 * j) → ℕ) → Fin (2 * j) → ℝ :=
        fun ν i => Θ ^ (ν i)
      let E : Finset (Fin (2 * j) → ℕ) := grid.filter (fun ν =>
        A / Θ ^ (2 * j) ≤ (∏ i : Fin (2 * j), scale ν i) ∧
          (∏ i : Fin (2 * j), scale ν i) ≤ B * Θ ^ (2 * j))
      let μU : ArithmeticFunction ℝ :=
        arithmeticFunctionLowCutoff U
          (ArithmeticFunction.moebius : ArithmeticFunction ℝ)
      let H : ArithmeticFunction ℝ :=
        μU ^ j * (ArithmeticFunction.zeta : ArithmeticFunction ℝ) ^ (j - 1) *
          ArithmeticFunction.log
      let f : Fin (2 * j) → ArithmeticFunction ℝ := fun i =>
        if i.val < j then μU
        else if i.val + 1 = 2 * j then ArithmeticFunction.log
        else (ArithmeticFunction.zeta : ArithmeticFunction ℝ)
      let β : (Fin (2 * j) → ℕ) → Fin (2 * j) → MonoidAlgebra ℂ ℕ :=
        fun ν i => ∑ n ∈ Finset.Icc 1 ⌊Θ * scale ν i⌋₊,
          MonoidAlgebra.single n
            ((η ((n : ℝ) / scale ν i) * Real.rpow (n : ℝ) (-t) * f i n : ℝ) : ℂ)
      let target : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc ⌈A⌉₊ ⌊B⌋₊,
        Finsupp.single n ((Real.rpow (n : ℝ) (-t) * H n : ℝ) : ℂ)
      ∀ S : Finset ℕ, S ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
        (∑ q ∈ S, (q.divisors.card : ℝ) ^ Jmod *
          ‖fullDiscrepancy target q (a q) -
            ∑ ν ∈ E, fullDiscrepancy
              (∏ i : Fin (2 * j), β ν i).coeff q (a q)‖) ≤
          K * x / (Real.log x) ^ Asave := by
  let m : ℕ := 4 * j
  let Cscale : ℝ := C * (2 : ℝ) ^ m
  let Cwidth : ℝ := 4 + 2 * (m : ℝ) * C * (2 : ℝ) ^ m
  let Lamp : ℝ := 1 + Real.log Cscale
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hm : 1 ≤ m := by dsimp only [m]; omega
  have hCscale : 1 ≤ Cscale :=
    one_le_mul_of_one_le_of_one_le hC (one_le_pow₀ one_le_two)
  have hCwidth : 0 ≤ Cwidth := by dsimp only [Cwidth]; positivity
  have hlogC : 0 ≤ Real.log Cscale := Real.log_nonneg hCscale
  have hLamp : 0 < Lamp := add_pos_of_pos_of_nonneg zero_lt_one hlogC
  obtain ⟨D, hD, Kb, Xb, hKb, _, hboundary⟩ :=
    weighted_boundary_fullDiscrepancy_log_saving
      θ hθ0 hθ1 (2 * j - 1) 1 Jmod 2 Cscale Cwidth hCscale hCwidth Asave hAsave
  have hevent : ∀ᶠ x : ℝ in Filter.atTop,
      (Real.log x) ^ D ≤ x := by
    filter_upwards [Filter.eventually_ge_atTop (0 : ℝ),
      (isLittleO_log_rpow_rpow_atTop (D : ℝ) zero_lt_one).eventuallyLE] with x hx hsmall
    refine (Real.le_norm_self _).trans ?_
    simpa only [Real.rpow_natCast, Real.rpow_one, Real.norm_of_nonneg hx] using hsmall
  obtain ⟨Xr, hXr⟩ := Filter.eventually_atTop.mp hevent
  let X₀ : ℝ := max (max (Real.exp 1) C) (max Xb Xr)
  refine ⟨D, hD, Kb * Lamp, X₀, mul_pos hKb hLamp, le_max_left _ _, ?_⟩
  intro x hx Θ A B U t hAx hAB hBC ht ht10 η M grid scale E μU H f β target S hS a ha
  obtain ⟨hxbase, hxrest⟩ := max_le_iff.mp hx
  obtain ⟨hxexp, hxC⟩ := max_le_iff.mp hxbase
  obtain ⟨hxxb, hxxr⟩ := max_le_iff.mp hxrest
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
  let ell : ℝ := Real.log x
  let δ : ℝ := ell ^ (-(D : ℝ))
  have hell : 1 ≤ ell := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hxexp
  have hellpos : 0 < ell := zero_lt_one.trans_le hell
  have hellDpos : 0 < ell ^ D := pow_pos hellpos D
  have hδinv : δ = 1 / ell ^ D := by
    simpa only [Real.rpow_natCast, one_div] using Real.rpow_neg hellpos.le (D : ℝ)
  have hδone : δ ≤ 1 := by
    rw [hδinv]
    exact div_le_self zero_le_one (one_le_pow₀ hell)
  have hΘeq : Θ = 1 + δ := rfl
  have hΘ : 1 < Θ := lt_add_of_pos_right 1 (Real.rpow_pos_of_pos hellpos _)
  have hΘtwo : Θ ≤ 2 := by rw [hΘeq]; linarith only [hδone]
  have hΘpos : 0 < Θ := zero_lt_one.trans hΘ
  have hA : 1 ≤ A := ((one_le_div hCpos).mpr hxC).trans hAx
  have hApos : 0 < A := zero_lt_one.trans_le hA
  have hBpos : 0 < B := hApos.trans_le hAB
  let R : ℝ := Θ ^ m
  have hRone : 1 ≤ R := one_le_pow₀ hΘ.le
  have hRpos : 0 < R := zero_lt_one.trans_le hRone
  have hRsub : 0 ≤ R - 1 := sub_nonneg.mpr hRone
  have hΘsub : 0 ≤ Θ - 1 := sub_nonneg.mpr hΘ.le
  have hgap : R - 1 ≤ δ * (m : ℝ) * (2 : ℝ) ^ (m - 1) := by
    calc
      _ ≤ (Θ - 1) * (m : ℝ) * Θ ^ (m - 1) := by
        have h := abs_pow_sub_pow_le (a := Θ) (b := (1 : ℝ)) (n := m)
        rw [one_pow] at h
        change |R - 1| ≤ |Θ - 1| * (m : ℝ) * max |Θ| |(1 : ℝ)| ^ (m - 1) at h
        simpa only [abs_of_nonneg hRsub, abs_of_nonneg hΘsub,
          abs_of_pos hΘpos, abs_one, max_eq_left hΘ.le] using h
      _ ≤ (Θ - 1) * (m : ℝ) * (2 : ℝ) ^ (m - 1) :=
        mul_le_mul_of_nonneg_left (pow_le_pow_left₀ hΘpos.le hΘtwo (m - 1))
          (mul_nonneg hΘsub (Nat.cast_nonneg m))
      _ = _ := by rw [hΘeq]; ring
  have htwo_succ : (2 : ℝ) ^ m = (2 : ℝ) ^ (m - 1) * 2 := by
    simpa only [Nat.sub_add_cancel hm] using (pow_succ (2 : ℝ) (m - 1))
  have hAdivpos : 0 < A / R := div_pos hApos hRpos
  have hBle : B ≤ B * R := le_mul_of_one_le_right hBpos.le hRone
  have hBupper : B * R ≤ Cscale * x := by
    calc
      _ ≤ (C * x) * (2 : ℝ) ^ m :=
        mul_le_mul hBC (pow_le_pow_left₀ hΘpos.le hΘtwo m) hRpos.le
          (mul_nonneg hCpos.le hxpos.le)
      _ = _ := by dsimp only [Cscale]; ring
  have hAupper : A ≤ Cscale * x := hAB.trans (hBle.trans hBupper)
  let b : (Fin (2 * j) → ℕ) → ℕ →₀ ℂ := fun ν =>
    (∏ i : Fin (2 * j), β ν i).coeff
  let error : ℕ →₀ ℂ := (∑ ν ∈ E, b ν) - target
  obtain ⟨_, _, _, hshell, herror⟩ :=
    heathBrown_finite_smooth_box_boundary j hj A B U Θ t hA hAB hΘ hΘtwo ht ht10
  change (∀ n ∈ error.support,
    (A / R ≤ (n : ℝ) ∧ (n : ℝ) < A) ∨
      (B < (n : ℝ) ∧ (n : ℝ) ≤ B * R)) at hshell
  change ∀ n : ℕ, ‖error n‖ ≤
    (n.divisors.card : ℝ) ^ (2 * j - 1) * Real.log (n : ℝ) at herror
  have hsizes (n : ℕ) (hn : n ∈ error.support) :
      1 ≤ n ∧ (n : ℝ) ≤ Cscale * x := by
    rcases hshell n hn with hl | hr
    · refine ⟨?_, hl.2.le.trans hAupper⟩
      exact_mod_cast hAdivpos.trans_le hl.1
    · refine ⟨?_, hr.2.trans hBupper⟩
      exact_mod_cast hBpos.trans hr.1
  let lo : Fin 2 → ℕ := fun i =>
    if i = 0 then ⌈A / R⌉₊ else ⌊B⌋₊ + 1
  let hi : Fin 2 → ℕ := fun i =>
    if i = 0 then ⌈A⌉₊ else ⌊B * R⌋₊ + 1
  have hceilAr : 1 ≤ ⌈A / R⌉₊ := Nat.one_le_ceil_iff.mpr hAdivpos
  have horder0 : ⌈A / R⌉₊ ≤ ⌈A⌉₊ :=
    Nat.ceil_mono (div_le_self hApos.le hRone)
  have horder1 : ⌊B⌋₊ + 1 ≤ ⌊B * R⌋₊ + 1 :=
    Nat.add_le_add_right (Nat.floor_mono hBle) 1
  have hinterval (i : Fin 2) :
      1 ≤ lo i ∧ lo i ≤ hi i ∧ hi i ≤ ⌈Cscale * x⌉₊ + 1 := by
    by_cases hi0 : i = 0
    · simp only [lo, hi, ite_eq_left hi0]
      exact ⟨hceilAr, horder0, (Nat.ceil_mono hAupper).trans (Nat.le_succ _)⟩
    · simp only [lo, hi, ite_eq_right hi0]
      exact ⟨by omega, horder1, Nat.add_le_add_right
        ((Nat.floor_mono hBupper).trans (Nat.floor_le_ceil (Cscale * x))) 1⟩
  have hcover (n : ℕ) (hn : n ∈ error.support) :
      ∃ i : Fin 2, lo i ≤ n ∧ n < hi i := by
    rcases hshell n hn with hl | hr
    · refine ⟨0, ?_⟩
      simpa [lo, hi] using
        And.intro (Nat.ceil_le.mpr hl.1) (Nat.lt_ceil.mpr hl.2)
    · refine ⟨1, ?_⟩
      simpa [lo, hi] using
        And.intro ((Nat.floor_lt hBpos.le).mpr hr.1) (Nat.lt_succ_of_le (Nat.le_floor hr.2))
  have hleftwidth :
      ((⌈A⌉₊ - ⌈A / R⌉₊ : ℕ) : ℝ) ≤ A - A / R + 1 := by
    rw [Nat.cast_sub horder0]
    linarith only [(Nat.ceil_lt_add_one hApos.le).le, Nat.le_ceil (A / R)]
  have hrightwidth :
      ((⌊B * R⌋₊ + 1 - (⌊B⌋₊ + 1) : ℕ) : ℝ) ≤ B * R - B + 1 := by
    rw [Nat.cast_sub horder1]
    simp only [Nat.cast_add, Nat.cast_one]
    linarith only [Nat.floor_le (mul_nonneg hBpos.le hRpos.le), Nat.lt_floor_add_one B]
  have hlength :
      (∑ i : Fin 2, ((hi i - lo i : ℕ) : ℝ)) ≤
        A - A / R + 1 + (B * R - B + 1) := by
    simpa [Fin.sum_univ_two, lo, hi] using add_le_add hleftwidth hrightwidth
  have hfirstreal : A - A / R ≤ A * (R - 1) := by
    calc
      A - A / R = A * ((R - 1) / R) := by field_simp [hRpos.ne']
      _ ≤ A * (R - 1) :=
        mul_le_mul_of_nonneg_left (div_le_self hRsub hRone) hApos.le
  have hrealwidth :
      A - A / R + (B * R - B) ≤ (A + B) * (R - 1) := by
    nlinarith only [hfirstreal]
  have hABupper : A + B ≤ 2 * C * x := by linarith only [hAB, hBC]
  have hunit : 1 ≤ x / ell ^ D := (one_le_div hellDpos).mpr (hXr x hxxr)
  have hcoef : (m : ℝ) * C * (2 : ℝ) ^ m + 2 ≤ Cwidth := by
    have hnonneg : 0 ≤ (m : ℝ) * C * (2 : ℝ) ^ m := by positivity
    dsimp only [Cwidth]
    linarith only [hnonneg]
  have hwidth :
      (∑ i : Fin 2, ((hi i - lo i : ℕ) : ℝ)) ≤
        Cwidth * x / (Real.log x) ^ D := by
    calc
      _ ≤ A - A / R + 1 + (B * R - B + 1) := hlength
      _ = (A - A / R + (B * R - B)) + 2 := by ring
      _ ≤ (A + B) * (R - 1) + 2 := add_le_add_left hrealwidth 2
      _ ≤ (2 * C * x) * (R - 1) + 2 :=
        add_le_add_left (mul_le_mul_of_nonneg_right hABupper hRsub) 2
      _ ≤ (2 * C * x) * (δ * (m : ℝ) * (2 : ℝ) ^ (m - 1)) + 2 :=
        add_le_add_left
          (mul_le_mul_of_nonneg_left hgap (show 0 ≤ 2 * C * x by positivity)) 2
      _ = (m : ℝ) * C * (2 : ℝ) ^ m * x / ell ^ D + 2 := by
        rw [hδinv, htwo_succ]
        ring
      _ ≤ (m : ℝ) * C * (2 : ℝ) ^ m * x / ell ^ D +
          2 * (x / ell ^ D) :=
        add_le_add_right (le_mul_of_one_le_right zero_le_two hunit) _
      _ = ((m : ℝ) * C * (2 : ℝ) ^ m + 2) * x / ell ^ D := by ring
      _ ≤ Cwidth * x / ell ^ D :=
        div_le_div_of_nonneg_right
          (mul_le_mul_of_nonneg_right hcoef hxpos.le) hellDpos.le
  have henvelope (n : ℕ) (hn : n ∈ error.support) :
      ‖error n‖ ≤ Lamp * (n.divisors.card : ℝ) ^ (2 * j - 1) *
        (Real.log x) ^ (1 : ℕ) := by
    have hnpos : (0 : ℝ) < n := by exact_mod_cast (hsizes n hn).1
    have hlog : Real.log (n : ℝ) ≤ Lamp * ell := by
      calc
        _ ≤ Real.log (Cscale * x) := Real.log_le_log hnpos (hsizes n hn).2
        _ = Real.log Cscale + ell := by
          rw [Real.log_mul (zero_lt_one.trans_le hCscale).ne' hxpos.ne']
        _ ≤ Real.log Cscale * ell + ell :=
          add_le_add_left (le_mul_of_one_le_right hlogC hell) ell
        _ = (1 + Real.log Cscale) * ell := by ring
    calc
      ‖error n‖ ≤ (n.divisors.card : ℝ) ^ (2 * j - 1) * Real.log (n : ℝ) := herror n
      _ ≤ (n.divisors.card : ℝ) ^ (2 * j - 1) * (Lamp * ell) :=
        mul_le_mul_of_nonneg_left hlog (pow_nonneg (Nat.cast_nonneg _) _)
      _ = _ := by dsimp only [ell]; ring
  have hmask_error (P : ℕ → Prop) [DecidablePred P] :
      error.sum (fun n z => if P n then z else (0 : ℂ)) =
        (∑ ν ∈ E, (b ν).sum (fun n z => if P n then z else (0 : ℂ))) -
          target.sum (fun n z => if P n then z else (0 : ℂ)) := by
    change ((∑ ν ∈ E, b ν) - target).sum
      (fun n z => if P n then z else (0 : ℂ)) = _
    rw [Finsupp.sum_sub_index
      (h := fun n z => if P n then z else (0 : ℂ)) (by
        intro n z w
        by_cases h : P n <;> simp [h]),
      Finsupp.sum_finsetSum b E (fun n z => if P n then z else (0 : ℂ))
        (fun _ => by simp) (by
          intro n z w
          by_cases h : P n <;> simp [h])]
  have hdelta_error (q a : ℕ) :
      fullDiscrepancy error q a =
        (∑ ν ∈ E, fullDiscrepancy (b ν) q a) -
          fullDiscrepancy target q a := by
    have hp := hmask_error (fun n => n % q = a % q)
    have hr := hmask_error (fun n => Nat.Coprime n q)
    simp only [Finsupp.sum] at hp hr
    simp only [fullDiscrepancy,
      progressionMass, reducedMass,
      hp, hr, Finset.sum_sub_distrib, sub_div, Finset.sum_div]
    ring
  calc
    _ = ∑ q ∈ S, (q.divisors.card : ℝ) ^ Jmod *
        ‖fullDiscrepancy error q (a q)‖ := by
      simp only [b, hdelta_error, norm_sub_rev]
    _ ≤ Kb * Lamp * x / (Real.log x) ^ Asave :=
      hboundary x hxxb Lamp hLamp.le S hS a ha lo hi hinterval hwidth error hcover henvelope

end

open Classical in
theorem weighted_fullDiscrepancy_positiveSupport_log_growth
    (θ : ℝ) (hθ0 : 0 < θ) (hθ1 : θ < 1)
    (k J : ℕ) (E Cscale : ℝ) (hCscale : 1 ≤ Cscale) :
    ∃ P : ℕ, ∃ K : ℝ, 0 < K ∧
      ∀ x : ℝ, Real.exp 1 ≤ x →
      ∀ L : ℝ, 0 ≤ L →
      ∀ S : Finset ℕ, S ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
      ∀ u : ℕ →₀ ℂ,
        (∀ n ∈ u.support, 0 < n ∧ (n : ℝ) ≤ Cscale * x) →
        (∀ n ∈ u.support,
          ‖u n‖ ≤ L * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ E) →
        (∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy u q (a q)‖) ≤
            K * L * x * (Real.log x) ^ P := by
  obtain ⟨κ, hκ⟩ := exists_nat_gt (max (3 : ℝ) (2 / (1 - θ)))
  have hκpos : (0 : ℝ) < κ := lt_of_lt_of_le (by positivity) hκ.le
  let α : ℝ := 2 / (κ : ℝ)
  let γ : ℝ := θ + α
  have hαpos : 0 < α := div_pos (by norm_num) hκpos
  have hαgap : α < 1 - θ :=
    (div_lt_comm₀ hκpos (sub_pos.mpr hθ1)).mpr ((le_max_right _ _).trans_lt hκ)
  have hα1 : α ≤ 1 := hαgap.le.trans (sub_le_self 1 hθ0.le)
  have hγ1 : γ < 1 := lt_sub_iff_add_lt'.mp hαgap
  let e : ℕ := ⌈E⌉₊
  let R : ℕ := 2 ^ (κ * k)
  let T : ℕ := 2 ^ (J + 1)
  let P : ℕ := e + R + T
  let cY : ℝ := 32 * Cscale
  have hcY1 : 1 ≤ cY := by dsimp only [cY]; linarith only [hCscale]
  have hcYpos : 0 < cY := zero_lt_one.trans_le hcY1
  have hlogcY : 0 ≤ Real.log cY := Real.log_nonneg hcY1
  let dY : ℝ := 2 + Real.log cY
  have hdYpos : 0 < dY := add_pos_of_pos_of_nonneg (by norm_num) hlogcY
  let F : ℝ := 2 ^ (κ * k + 1) * dY ^ R * 2 ^ T
  refine ⟨P, 66 * Cscale * F, by dsimp only [F]; positivity, ?_⟩
  intro x hx L hL S hS a ha u hsupport henvelope
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
  have hx1 : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hx
  have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxpos).mpr hx
  have hlogE : (Real.log x) ^ E ≤ (Real.log x) ^ e := by
    simpa only [Real.rpow_natCast] using
      Real.rpow_le_rpow_of_exponent_le hlog1 (Nat.le_ceil E)
  let X : ℕ := ⌈Cscale * x⌉₊
  let t : ℝ := (X : ℝ) ^ (1 / (κ : ℝ))
  let Y : ℕ := 2 + ⌈t⌉₊
  let Q : ℕ := ⌊x ^ θ⌋₊
  have hCx1 : 1 ≤ Cscale * x := one_le_mul_of_one_le_of_one_le hCscale hx1
  have hX1r : (1 : ℝ) ≤ X := hCx1.trans (Nat.le_ceil _)
  have hX0 : (0 : ℝ) ≤ X := Nat.cast_nonneg X
  have hXupper : (X : ℝ) ≤ 2 * Cscale * x := by
    simpa only [X, mul_assoc] using
      (Nat.ceil_le_two_mul (a := Cscale * x) (by linarith only [hCx1]))
  have ht1 : 1 ≤ t := Real.one_le_rpow hX1r (by positivity)
  have hY : 2 ≤ Y := by dsimp only [Y]; omega
  have htY : t ≤ (Y : ℝ) := by
    simpa only [Y, Nat.cast_add, Nat.cast_ofNat] using
      (Nat.le_ceil t).trans (le_add_of_nonneg_left zero_le_two)
  have hYupper : (Y : ℝ) ≤ 4 * t := by
    have h := Nat.ceil_le_two_mul (a := t) (by linarith only [ht1])
    simp only [Y, Nat.cast_add, Nat.cast_ofNat]
    linarith only [h, ht1]
  have ht2 : t ^ 2 = (X : ℝ) ^ α := by
    simpa only [t, α, Nat.cast_ofNat, one_div_mul_eq_div] using
      (Real.rpow_mul_natCast hX0 (1 / (κ : ℝ)) 2).symm
  have hXscale : X ≤ Y ^ κ := by
    simpa only [Real.rpow_natCast, ← Nat.cast_pow, Nat.cast_le] using
      (Real.rpow_inv_le_iff_of_pos hX0 (Nat.cast_nonneg Y) hκpos).mp
        (by simpa only [t, one_div] using htY)
  have hCpow : (2 * Cscale) ^ α ≤ 2 * Cscale := Real.rpow_le_self_of_one_le
    (show (1 : ℝ) ≤ 2 * Cscale by linarith only [hCscale]) hα1
  have hY2 : ((Y ^ 2 : ℕ) : ℝ) ≤ 32 * Cscale * x ^ α := by
    calc
      _ = (Y : ℝ) ^ 2 := by simp only [Nat.cast_pow]
      _ ≤ (4 * t) ^ 2 := by gcongr
      _ = 16 * (X : ℝ) ^ α := by norm_num [mul_pow, ht2]
      _ ≤ 16 * (2 * Cscale * x) ^ α := by gcongr
      _ = 16 * (2 * Cscale) ^ α * x ^ α := by
        rw [Real.mul_rpow (by positivity) hxpos.le, mul_assoc]
      _ ≤ 16 * (2 * Cscale) * x ^ α := by gcongr
      _ = _ := by ring
  have hxθ1 : 1 ≤ x ^ θ := Real.one_le_rpow hx1 hθ0.le
  have hQ : 1 ≤ Q := (Nat.one_le_floor_iff _).mpr hxθ1
  have hQupper : (Q : ℝ) ≤ x ^ θ := Nat.floor_le (Real.rpow_nonneg hxpos.le _)
  have hQadd : ((Q + 1 : ℕ) : ℝ) ≤ 2 * x ^ θ := by
    simp only [Nat.cast_add, Nat.cast_one]
    linarith only [hQupper, hxθ1]
  have hxγ : x ^ γ ≤ x := Real.rpow_le_self_of_one_le hx1 hγ1.le
  have hsize : (X : ℝ) + ((Y ^ 2 : ℕ) : ℝ) * (Q + 1 : ℕ) ≤
      66 * Cscale * x := by
    calc
      _ ≤ 2 * Cscale * x + (32 * Cscale * x ^ α) * (2 * x ^ θ) := by gcongr
      _ = 2 * Cscale * x + 64 * Cscale * x ^ γ := by
        dsimp only [γ]; rw [Real.rpow_add hxpos]; ring
      _ ≤ 2 * Cscale * x + 64 * Cscale * x := by gcongr
      _ = _ := by ring
  have hxα : x ^ α ≤ x := Real.rpow_le_self_of_one_le hx1 hα1
  have hxθ : x ^ θ ≤ x := Real.rpow_le_self_of_one_le hx1 hθ1.le
  have hYsmall : ((Y ^ 2 : ℕ) : ℝ) ≤ cY * x :=
    hY2.trans (mul_le_mul_of_nonneg_left hxα hcYpos.le)
  have hlogY : 1 + Real.log (Y ^ 2 : ℕ) ≤ dY * Real.log x := by
    have h := Real.log_le_log (by positivity) hYsmall
    rw [Real.log_mul hcYpos.ne' hxpos.ne'] at h
    dsimp only [dY]
    nlinarith only [h, hlog1, hlogcY,
      mul_nonneg hlogcY (sub_nonneg.mpr hlog1)]
  have hlogQ : 1 + Real.log (Q : ℝ) ≤ 2 * Real.log x := by
    have h := Real.log_le_log (by positivity) (hQupper.trans hxθ)
    linarith only [h, hlog1]
  let lo : Fin 1 → ℕ := fun _ => 1
  let hi : Fin 1 → ℕ := fun _ => X + 1
  have hinterval (i : Fin 1) : 1 ≤ lo i ∧ lo i ≤ hi i ∧ hi i ≤ X + 1 :=
    ⟨le_rfl, Nat.le_add_left 1 X, le_rfl⟩
  have hcover : ∀ n ∈ u.support, ∃ i : Fin 1, lo i ≤ n ∧ n < hi i := by
    intro n hn
    exact ⟨0, (hsupport n hn).1, Nat.lt_succ_of_le
      (Nat.cast_le.mp ((hsupport n hn).2.trans (Nat.le_ceil (Cscale * x))))⟩
  have henv : ∀ n ∈ u.support,
      ‖u n‖ ≤ (L * (Real.log x) ^ e) * (n.divisors.card : ℝ) ^ k := by
    intro n hn
    calc
      _ ≤ L * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ e :=
        (henvelope n hn).trans (by gcongr)
      _ = _ := by ring
  have hraw := weighted_shortInterval_fullDiscrepancy_bound Y κ k X Q J 1
    hY hXscale hQ (L * (Real.log x) ^ e) (by positivity)
    S hS a ha lo hi hinterval u hcover henv
  calc
    _ ≤ (2 : ℝ) ^ (κ * k + 1) * (L * (Real.log x) ^ e) *
        (((X : ℝ) + ((Y ^ 2 : ℕ) : ℝ) * (Q + 1 : ℕ)) *
          ((1 + Real.log (Y ^ 2 : ℕ)) ^ R * (1 + Real.log (Q : ℝ)) ^ T)) := by
      simpa [lo, hi, R, T, mul_assoc] using hraw
    _ ≤ (2 : ℝ) ^ (κ * k + 1) * (L * (Real.log x) ^ e) *
        ((66 * Cscale * x) * ((dY * Real.log x) ^ R * (2 * Real.log x) ^ T)) := by
      gcongr
    _ = (66 * Cscale * F) * L * x * (Real.log x) ^ P := by
      simp only [F, P, pow_add, mul_pow]
      ring

section
open scoped ContDiff
open Classical in
theorem typeIII_physical_periodization (q : ℕ+) (I : Finset ℤ)
    (A₁ B₁ A₂ B₂ A₃ B₃ : ℤ) (α s₁ s₂ s₃ : ℤ → ℂ)
    (a : ZMod (q : ℕ)) :
    (∑ m ∈ I, ∑ n₁ ∈ Finset.Icc A₁ B₁, ∑ n₂ ∈ Finset.Icc A₂ B₂,
      ∑ n₃ ∈ Finset.Icc A₃ B₃,
        if ((m * n₁ * n₂ * n₃ : ℤ) : ZMod (q : ℕ)) = a then
          α m * s₁ n₁ * s₂ n₂ * s₃ n₃ else 0) =
      ∑ m ∈ I, α m *
        ∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
          if (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = a then
            integerIntervalResidueWeight (q : ℕ) A₁ (B₁ + 1 - A₁).toNat
                (fun k => s₁ (A₁ + k)) z₁ *
              integerIntervalResidueWeight (q : ℕ) A₂ (B₂ + 1 - A₂).toNat
                (fun k => s₂ (A₂ + k)) z₂ *
              integerIntervalResidueWeight (q : ℕ) A₃ (B₃ + 1 - A₃).toNat
                (fun k => s₃ (A₃ + k)) z₃
          else 0 := by
  have hintervalPeriodization (q : ℕ+) (A B : ℤ) (s : ℤ → ℂ)
      (F : ZMod (q : ℕ) → ℂ) :
      (∑ n ∈ Finset.Icc A B, s n * F (n : ZMod (q : ℕ))) =
        ∑ z : ZMod (q : ℕ),
          integerIntervalResidueWeight (q : ℕ) A (B + 1 - A).toNat
            (fun k => s (A + k)) z * F z := by
    rw [(integerIntervalResidueWeight_spec (q : ℕ) A (B + 1 - A).toNat
      (fun k => s (A + k))).1 F]
    rw [Int.Icc_eq_finset_map, Finset.sum_map]
    rfl
  have htriplePeriodization (q : ℕ+) (A₁ B₁ A₂ B₂ A₃ B₃ : ℤ)
      (s₁ s₂ s₃ : ℤ → ℂ)
      (F : ZMod (q : ℕ) → ZMod (q : ℕ) → ZMod (q : ℕ) → ℂ) :
      (∑ n₁ ∈ Finset.Icc A₁ B₁, ∑ n₂ ∈ Finset.Icc A₂ B₂,
        ∑ n₃ ∈ Finset.Icc A₃ B₃,
          s₁ n₁ * s₂ n₂ * s₃ n₃ * F (n₁ : ZMod (q : ℕ))
            (n₂ : ZMod (q : ℕ)) (n₃ : ZMod (q : ℕ))) =
        ∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
          integerIntervalResidueWeight (q : ℕ) A₁ (B₁ + 1 - A₁).toNat
              (fun k => s₁ (A₁ + k)) z₁ *
            integerIntervalResidueWeight (q : ℕ) A₂ (B₂ + 1 - A₂).toNat
              (fun k => s₂ (A₂ + k)) z₂ *
            integerIntervalResidueWeight (q : ℕ) A₃ (B₃ + 1 - A₃).toNat
              (fun k => s₃ (A₃ + k)) z₃ * F z₁ z₂ z₃ := by
    simp only [mul_assoc, ← Finset.mul_sum]
    rw [hintervalPeriodization q A₁ B₁ s₁ (fun z₁ =>
      ∑ n₂ ∈ Finset.Icc A₂ B₂, s₂ n₂ *
        ∑ n₃ ∈ Finset.Icc A₃ B₃, s₃ n₃ *
          F z₁ (n₂ : ZMod (q : ℕ)) (n₃ : ZMod (q : ℕ)))]
    apply Finset.sum_congr rfl
    intro z₁ _
    congr 1
    rw [hintervalPeriodization q A₂ B₂ s₂ (fun z₂ =>
      ∑ n₃ ∈ Finset.Icc A₃ B₃, s₃ n₃ * F z₁ z₂ (n₃ : ZMod (q : ℕ)))]
    apply Finset.sum_congr rfl
    intro z₂ _
    congr 1
    exact hintervalPeriodization q A₃ B₃ s₃ (F z₁ z₂)
  apply Finset.sum_congr rfl
  intro m _
  simpa only [Finset.mul_sum, mul_ite, mul_one, mul_zero,
    Int.cast_mul, mul_assoc] using
    congrArg (fun z : ℂ => α m * z)
      (htriplePeriodization q A₁ B₁ A₂ B₂ A₃ B₃ s₁ s₂ s₃
        (fun z₁ z₂ z₃ =>
          if (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = a then 1 else 0))

open Classical in
theorem typeIII_sampled_residue_l1 (q : ℕ+) (T N L A : ℝ)
    (hT : 0 ≤ T) (hN : 1 ≤ N) (hL : 0 ≤ L) (hA : 0 ≤ A)
    (ψ : ℝ → ℂ) (hψ : ∀ t : ℝ, ‖ψ t‖ ≤ L * A) :
    (∑ z : ZMod (q : ℕ),
      ‖integerIntervalResidueWeight (q : ℕ) (Int.ceil (-T * N))
        (Int.floor (T * N) + 1 - Int.ceil (-T * N)).toNat
        (fun k => ψ (((Int.ceil (-T * N) : ℝ) + (k : ℝ)) / N)) z‖) ≤
      (2 * T + 3) * L * N * A := by
  have hperiodizationL1 (q : ℕ+) (A B : ℤ) (s : ℤ → ℂ) :
      (∑ z : ZMod (q : ℕ),
        ‖integerIntervalResidueWeight (q : ℕ) A (B + 1 - A).toNat
          (fun k => s (A + k)) z‖) ≤ ∑ n ∈ Finset.Icc A B, ‖s n‖ := by
    calc
      _ ≤ ∑ z : ZMod (q : ℕ), ∑ k ∈ Finset.range (B + 1 - A).toNat,
          ‖if ((A + k : ℤ) : ZMod (q : ℕ)) = z then s (A + k) else 0‖ := by
        apply Finset.sum_le_sum
        intro z _
        exact norm_sum_le _ _
      _ = ∑ k ∈ Finset.range (B + 1 - A).toNat, ‖s (A + k)‖ := by
        rw [Finset.sum_comm]
        simp only [apply_ite, norm_zero, Fintype.sum_ite_eq]
      _ = _ := by
        rw [Int.Icc_eq_finset_map, Finset.sum_map]
        rfl
  have hsampleCard (T N : ℝ) (hT : 0 ≤ T) (hN : 1 ≤ N) :
      ((Finset.Icc (Int.ceil (-T * N)) (Int.floor (T * N))).card : ℝ) ≤
        (2 * T + 3) * N := by
    have hTN : 0 ≤ T * N := mul_nonneg hT (by linarith)
    have hcast := congrArg (fun n : ℤ => (n : ℝ))
      (Int.card_Icc_of_le (Int.ceil (-T * N)) (Int.floor (T * N))
        ((Int.ceil_mono (show -T * N ≤ T * N by nlinarith only [hTN])).trans
          (Int.ceil_le_floor_add_one (T * N))))
    push_cast at hcast
    nlinarith only [hN, hcast, Int.floor_le (T * N), Int.le_ceil (-T * N)]
  calc
    _ ≤ ∑ n ∈ Finset.Icc (Int.ceil (-T * N)) (Int.floor (T * N)),
        ‖ψ ((n : ℝ) / N)‖ := by
      simpa only [Int.cast_add, Int.cast_natCast] using
        hperiodizationL1 q (Int.ceil (-T * N)) (Int.floor (T * N))
          (fun n => ψ ((n : ℝ) / N))
    _ ≤ ((Finset.Icc (Int.ceil (-T * N)) (Int.floor (T * N))).card : ℝ) *
        (L * A) := by
      simpa only [nsmul_eq_mul] using
        Finset.sum_le_card_nsmul
          (Finset.Icc (Int.ceil (-T * N)) (Int.floor (T * N)))
          (fun n => ‖ψ ((n : ℝ) / N)‖) (L * A) (fun n _ => hψ _)
    _ ≤ ((2 * T + 3) * N) * (L * A) :=
      mul_le_mul_of_nonneg_right (hsampleCard T N hT hN) (mul_nonneg hL hA)
    _ = _ := by ring

open Classical in
theorem typeIII_weighted_physical_error (S : Finset ℕ+) (Q : ℝ) (hQ : 0 < Q)
    (hq : ∀ q ∈ S, (q : ℝ) ≤ 2 * Q) (I : Finset ℤ) (M Wα : ℝ)
    (hM : 0 ≤ M) (hWα : 0 ≤ Wα) (hcard : (I.card : ℝ) ≤ 2 * M)
    (α : ℤ → ℂ) (hα : ∀ m ∈ I, ‖α m‖ ≤ Wα)
    (D e A t B₁ B₂ B₃ : ℝ) (hD : 0 ≤ D) (he : 0 ≤ e)
    (hA : 1 ≤ A) (ht : 0 ≤ t)
    (hB₁ : 0 ≤ B₁) (hB₂ : 0 ≤ B₂) (hB₃ : 0 ≤ B₃)
    (hqt : ∀ q ∈ S, (q : ℝ) * t ≤ 1)
    (U₁ U₂ U₃ V₁ V₂ V₃ : (q : ℕ+) → ZMod (q : ℕ) → ℂ)
    (hU₁ : ∀ q ∈ S, (∑ z : ZMod (q : ℕ), ‖U₁ q z‖) ≤ D * B₁ * A)
    (hU₂ : ∀ q ∈ S, (∑ z : ZMod (q : ℕ), ‖U₂ q z‖) ≤ D * B₂ * A)
    (hU₃ : ∀ q ∈ S, (∑ z : ZMod (q : ℕ), ‖U₃ q z‖) ≤ D * B₃ * A)
    (hE₁ : ∀ q ∈ S, ∀ z, ‖U₁ q z - V₁ q z‖ ≤ e * B₁ * t)
    (hE₂ : ∀ q ∈ S, ∀ z, ‖U₂ q z - V₂ q z‖ ≤ e * B₂ * t)
    (hE₃ : ∀ q ∈ S, ∀ z, ‖U₃ q z - V₃ q z‖ ≤ e * B₃ * t)
    (η : ℕ → ℂ) (hη : ∀ q ∈ S, ‖η (q : ℕ)‖ ≤ 1)
    (a : (q : ℕ+) → ZMod (q : ℕ)) :
    ‖(∑ q ∈ S, η (q : ℕ) *
        (∑ m ∈ I, α m * ∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ),
          ∑ z₃ : ZMod (q : ℕ),
            if (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = a q then
              U₁ q z₁ * U₂ q z₂ * U₃ q z₃ else 0)) -
      (∑ q ∈ S, η (q : ℕ) *
        (∑ m ∈ I, α m * ∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ),
          ∑ z₃ : ZMod (q : ℕ),
            if (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = a q then
              V₁ q z₁ * V₂ q z₂ * V₃ q z₃ else 0))‖ ≤
      8 * (e * (D ^ 2 + (D + e) * D + (D + e) ^ 2)) *
        Wα * M * (B₁ * B₂ * B₃) * Q ^ 2 * A ^ 2 * t := by
  have htripleProductL1 (q : ℕ+) (U₁ U₂ U₃ V₁ V₂ V₃ : ZMod (q : ℕ) → ℂ) :
      (∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
        ‖U₁ z₁ * U₂ z₂ * U₃ z₃ - V₁ z₁ * V₂ z₂ * V₃ z₃‖) ≤
        (∑ z : ZMod (q : ℕ), ‖U₁ z - V₁ z‖) *
            (∑ z : ZMod (q : ℕ), ‖U₂ z‖) * (∑ z : ZMod (q : ℕ), ‖U₃ z‖) +
          (∑ z : ZMod (q : ℕ), ‖V₁ z‖) *
            (∑ z : ZMod (q : ℕ), ‖U₂ z - V₂ z‖) *
            (∑ z : ZMod (q : ℕ), ‖U₃ z‖) +
          (∑ z : ZMod (q : ℕ), ‖V₁ z‖) * (∑ z : ZMod (q : ℕ), ‖V₂ z‖) *
            (∑ z : ZMod (q : ℕ), ‖U₃ z - V₃ z‖) := by
    have hp (z₁ z₂ z₃ : ZMod (q : ℕ)) :
        ‖U₁ z₁ * U₂ z₂ * U₃ z₃ - V₁ z₁ * V₂ z₂ * V₃ z₃‖ ≤
          ‖U₁ z₁ - V₁ z₁‖ * ‖U₂ z₂‖ * ‖U₃ z₃‖ +
            ‖V₁ z₁‖ * ‖U₂ z₂ - V₂ z₂‖ * ‖U₃ z₃‖ +
            ‖V₁ z₁‖ * ‖V₂ z₂‖ * ‖U₃ z₃ - V₃ z₃‖ := by
      calc
        _ = ‖(U₁ z₁ - V₁ z₁) * U₂ z₂ * U₃ z₃ +
            V₁ z₁ * (U₂ z₂ - V₂ z₂) * U₃ z₃ +
            V₁ z₁ * V₂ z₂ * (U₃ z₃ - V₃ z₃)‖ := by
          congr 1
          ring
        _ ≤ ‖(U₁ z₁ - V₁ z₁) * U₂ z₂ * U₃ z₃‖ +
            ‖V₁ z₁ * (U₂ z₂ - V₂ z₂) * U₃ z₃‖ +
            ‖V₁ z₁ * V₂ z₂ * (U₃ z₃ - V₃ z₃)‖ :=
          norm_add₃_le
        _ = _ := by simp only [norm_mul]
    calc
      _ ≤ ∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
          (‖U₁ z₁ - V₁ z₁‖ * ‖U₂ z₂‖ * ‖U₃ z₃‖ +
            ‖V₁ z₁‖ * ‖U₂ z₂ - V₂ z₂‖ * ‖U₃ z₃‖ +
            ‖V₁ z₁‖ * ‖V₂ z₂‖ * ‖U₃ z₃ - V₃ z₃‖) :=
        Finset.sum_le_sum fun z₁ _ => Finset.sum_le_sum fun z₂ _ =>
          Finset.sum_le_sum fun z₃ _ => hp z₁ z₂ z₃
      _ = _ := by
        simp only [Finset.sum_add_distrib, ← Finset.mul_sum, ← Finset.sum_mul]
  have hphysicalMaskError (q : ℕ+) (I : Finset ℤ) (α : ℤ → ℂ)
      (a : ZMod (q : ℕ)) (U₁ U₂ U₃ V₁ V₂ V₃ : ZMod (q : ℕ) → ℂ) :
      ‖(∑ m ∈ I, α m * ∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ),
          ∑ z₃ : ZMod (q : ℕ),
            if (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = a then
              U₁ z₁ * U₂ z₂ * U₃ z₃ else 0) -
        (∑ m ∈ I, α m * ∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ),
          ∑ z₃ : ZMod (q : ℕ),
            if (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = a then
              V₁ z₁ * V₂ z₂ * V₃ z₃ else 0)‖ ≤
        (∑ m ∈ I, ‖α m‖) *
          ∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
            ‖U₁ z₁ * U₂ z₂ * U₃ z₃ - V₁ z₁ * V₂ z₂ * V₃ z₃‖ := by
    let Δ : ℝ := ∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ),
      ∑ z₃ : ZMod (q : ℕ),
        ‖U₁ z₁ * U₂ z₂ * U₃ z₃ - V₁ z₁ * V₂ z₂ * V₃ z₃‖
    have hm (m : ℤ) :
        ‖(∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
            if (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = a then
              U₁ z₁ * U₂ z₂ * U₃ z₃ else 0) -
          (∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
            if (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = a then
              V₁ z₁ * V₂ z₂ * V₃ z₃ else 0)‖ ≤ Δ := by
      dsimp only [Δ]
      simp only [← Finset.sum_sub_distrib]
      refine norm_sum_le_of_le _ fun z₁ _ => ?_
      refine norm_sum_le_of_le _ fun z₂ _ => ?_
      refine norm_sum_le_of_le _ fun z₃ _ => ?_
      by_cases h : (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = a
      · simp only [ite_eq_left h]
        exact le_rfl
      · simp only [ite_eq_right h, sub_self, norm_zero, norm_nonneg]
    rw [← Finset.sum_sub_distrib]
    calc
      _ ≤ ∑ m ∈ I, ‖α m‖ * Δ := by
        refine norm_sum_le_of_le _ fun m _ => ?_
        rw [← mul_sub]
        exact norm_mul_le_of_le le_rfl (hm m)
      _ = _ := by rw [← Finset.sum_mul]
  have hphysicalCubeBound (q : ℕ+) (D e A t B₁ B₂ B₃ : ℝ)
      (hD : 0 ≤ D) (he : 0 ≤ e) (hA : 1 ≤ A) (ht : 0 ≤ t)
      (hB₁ : 0 ≤ B₁) (hB₂ : 0 ≤ B₂) (hB₃ : 0 ≤ B₃)
      (hqt : (q : ℝ) * t ≤ 1)
      (U₁ U₂ U₃ V₁ V₂ V₃ : ZMod (q : ℕ) → ℂ)
      (hU₁ : (∑ z : ZMod (q : ℕ), ‖U₁ z‖) ≤ D * B₁ * A)
      (hU₂ : (∑ z : ZMod (q : ℕ), ‖U₂ z‖) ≤ D * B₂ * A)
      (hU₃ : (∑ z : ZMod (q : ℕ), ‖U₃ z‖) ≤ D * B₃ * A)
      (hE₁ : ∀ z, ‖U₁ z - V₁ z‖ ≤ e * B₁ * t)
      (hE₂ : ∀ z, ‖U₂ z - V₂ z‖ ≤ e * B₂ * t)
      (hE₃ : ∀ z, ‖U₃ z - V₃ z‖ ≤ e * B₃ * t) :
      (∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
        ‖U₁ z₁ * U₂ z₂ * U₃ z₃ - V₁ z₁ * V₂ z₂ * V₃ z₃‖) ≤
        e * (D ^ 2 + (D + e) * D + (D + e) ^ 2) * (q : ℝ) *
          (B₁ * B₂ * B₃) * A ^ 2 * t := by
    have hA0 : 0 ≤ A := by linarith
    have hq0 : 0 ≤ (q : ℝ) := by positivity
    have hres (B : ℝ) (U V : ZMod (q : ℕ) → ℂ)
        (hE : ∀ z, ‖U z - V z‖ ≤ e * B * t) :
        (∑ z : ZMod (q : ℕ), ‖U z - V z‖) ≤ (q : ℝ) * (e * B * t) := by
      simpa only [Finset.card_univ, ZMod.card, nsmul_eq_mul] using
        Finset.sum_le_card_nsmul Finset.univ (fun z => ‖U z - V z‖)
          (e * B * t) (fun z _ => hE z)
    have happrox (B : ℝ) (hB : 0 ≤ B) (U V : ZMod (q : ℕ) → ℂ)
        (hU : (∑ z : ZMod (q : ℕ), ‖U z‖) ≤ D * B * A)
        (hE : ∀ z, ‖U z - V z‖ ≤ e * B * t) :
        (∑ z : ZMod (q : ℕ), ‖V z‖) ≤ (D + e) * B * A := by
      calc
        _ ≤ ∑ z : ZMod (q : ℕ), (‖U z‖ + ‖U z - V z‖) :=
          Finset.sum_le_sum fun z _ => norm_le_norm_add_norm_sub (U z) (V z)
        _ = (∑ z : ZMod (q : ℕ), ‖U z‖) +
            (∑ z : ZMod (q : ℕ), ‖U z - V z‖) := by rw [Finset.sum_add_distrib]
        _ ≤ D * B * A + (q : ℝ) * (e * B * t) := add_le_add hU (hres B U V hE)
        _ ≤ D * B * A + e * B * A := by
          refine add_le_add (le_refl (D * B * A)) ?_
          calc
            (q : ℝ) * (e * B * t) = (e * B) * ((q : ℝ) * t) := by ring
            _ ≤ e * B := mul_le_of_le_one_right (mul_nonneg he hB) hqt
            _ ≤ e * B * A := le_mul_of_one_le_right (mul_nonneg he hB) hA
        _ = _ := by ring
    have hR₁ := hres B₁ U₁ V₁ hE₁
    have hR₂ := hres B₂ U₂ V₂ hE₂
    have hR₃ := hres B₃ U₃ V₃ hE₃
    have hV₁ := happrox B₁ hB₁ U₁ V₁ hU₁ hE₁
    have hV₂ := happrox B₂ hB₂ U₂ V₂ hU₂ hE₂
    calc
      _ ≤ (∑ z : ZMod (q : ℕ), ‖U₁ z - V₁ z‖) *
            (∑ z : ZMod (q : ℕ), ‖U₂ z‖) * (∑ z : ZMod (q : ℕ), ‖U₃ z‖) +
          (∑ z : ZMod (q : ℕ), ‖V₁ z‖) *
            (∑ z : ZMod (q : ℕ), ‖U₂ z - V₂ z‖) *
            (∑ z : ZMod (q : ℕ), ‖U₃ z‖) +
          (∑ z : ZMod (q : ℕ), ‖V₁ z‖) * (∑ z : ZMod (q : ℕ), ‖V₂ z‖) *
            (∑ z : ZMod (q : ℕ), ‖U₃ z - V₃ z‖) :=
        htripleProductL1 q U₁ U₂ U₃ V₁ V₂ V₃
      _ ≤ ((q : ℝ) * (e * B₁ * t)) * (D * B₂ * A) * (D * B₃ * A) +
          ((D + e) * B₁ * A) * ((q : ℝ) * (e * B₂ * t)) * (D * B₃ * A) +
          ((D + e) * B₁ * A) * ((D + e) * B₂ * A) *
            ((q : ℝ) * (e * B₃ * t)) := by
        gcongr
      _ = _ := by ring
  have hmarkL1 (I : Finset ℤ) (M W : ℝ) (hW : 0 ≤ W)
      (hcard : (I.card : ℝ) ≤ 2 * M) (α : ℤ → ℂ)
      (hα : ∀ m ∈ I, ‖α m‖ ≤ W) :
      (∑ m ∈ I, ‖α m‖) ≤ 2 * M * W := by
    calc
      _ ≤ ∑ _m ∈ I, W := Finset.sum_le_sum fun m hm => hα m hm
      _ = (I.card : ℝ) * W := by simp only [Finset.sum_const, nsmul_eq_mul]
      _ ≤ _ := mul_le_mul_of_nonneg_right hcard hW
  have hsumModuli (S : Finset ℕ+) (Q : ℝ) (hQ : 0 < Q)
      (hq : ∀ q ∈ S, (q : ℝ) ≤ 2 * Q) :
      (∑ q ∈ S, (q : ℝ)) ≤ 4 * Q ^ 2 := by
    have hcard : S.card ≤ Nat.floor (2 * Q) := by
      calc
        S.card ≤ (Finset.Icc 1 (Nat.floor (2 * Q))).card := by
          refine Finset.card_le_card_of_injOn (fun q : ℕ+ => (q : ℕ)) ?_ ?_
          · intro q hqS
            exact Finset.mem_Icc.mpr ⟨q.pos, Nat.le_floor (hq q hqS)⟩
          · intro q _ r _ hqr
            exact PNat.coe_injective hqr
        _ = _ := by simp
    have hcardR : (S.card : ℝ) ≤ 2 * Q := by
      calc
        _ ≤ (Nat.floor (2 * Q) : ℝ) := by exact_mod_cast hcard
        _ ≤ _ := Nat.floor_le (by linarith)
    calc
      _ ≤ ∑ _q ∈ S, (2 * Q) := Finset.sum_le_sum fun q hqS => hq q hqS
      _ = (S.card : ℝ) * (2 * Q) := by simp only [Finset.sum_const, nsmul_eq_mul]
      _ ≤ (2 * Q) * (2 * Q) := mul_le_mul_of_nonneg_right hcardR (by linarith)
      _ = _ := by ring
  have hweightedSumError (S : Finset ℕ+) (Q B : ℝ) (hQ : 0 < Q) (hB : 0 ≤ B)
      (hq : ∀ q ∈ S, (q : ℝ) ≤ 2 * Q) (η : ℕ → ℂ)
      (hη : ∀ q ∈ S, ‖η (q : ℕ)‖ ≤ 1) (R Rtilde : ℕ+ → ℂ)
      (herr : ∀ q ∈ S, ‖R q - Rtilde q‖ ≤ B * (q : ℝ)) :
      ‖(∑ q ∈ S, η (q : ℕ) * R q) -
        (∑ q ∈ S, η (q : ℕ) * Rtilde q)‖ ≤ 4 * B * Q ^ 2 := by
    rw [← Finset.sum_sub_distrib]
    calc
      _ ≤ ∑ q ∈ S, B * (q : ℝ) := by
        refine norm_sum_le_of_le _ fun q hqS => ?_
        rw [← mul_sub]
        simpa only [one_mul] using norm_mul_le_of_le (hη q hqS) (herr q hqS)
      _ = B * ∑ q ∈ S, (q : ℝ) := by rw [Finset.mul_sum]
      _ ≤ B * (4 * Q ^ 2) := mul_le_mul_of_nonneg_left (hsumModuli S Q hQ hq) hB
      _ = _ := by ring
  let Dtel : ℝ := e * (D ^ 2 + (D + e) * D + (D + e) ^ 2)
  let Bglobal : ℝ := 2 * M * Wα * Dtel * (B₁ * B₂ * B₃) * A ^ 2 * t
  have hDtel : 0 ≤ Dtel := by dsimp only [Dtel]; positivity
  have hBglobal : 0 ≤ Bglobal := by dsimp only [Bglobal]; positivity
  calc
    _ ≤ 4 * Bglobal * Q ^ 2 := by
      apply hweightedSumError S Q Bglobal hQ hBglobal hq η hη
      intro q hqS
      have hcube := hphysicalCubeBound q D e A t B₁ B₂ B₃
        hD he hA ht hB₁ hB₂ hB₃ (hqt q hqS)
        (U₁ q) (U₂ q) (U₃ q) (V₁ q) (V₂ q) (V₃ q)
        (hU₁ q hqS) (hU₂ q hqS) (hU₃ q hqS)
        (hE₁ q hqS) (hE₂ q hqS) (hE₃ q hqS)
      calc
        _ ≤ (∑ m ∈ I, ‖α m‖) *
            (∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
              ‖U₁ q z₁ * U₂ q z₂ * U₃ q z₃ -
                V₁ q z₁ * V₂ q z₂ * V₃ q z₃‖) :=
          hphysicalMaskError q I α (a q) (U₁ q) (U₂ q) (U₃ q)
            (V₁ q) (V₂ q) (V₃ q)
        _ ≤ (2 * M * Wα) *
            (Dtel * (q : ℝ) * (B₁ * B₂ * B₃) * A ^ 2 * t) :=
          mul_le_mul (hmarkL1 I M Wα hWα hcard α hα) hcube
            (by positivity) (by positivity)
        _ = Bglobal * (q : ℝ) := by dsimp only [Bglobal]; ring
    _ = _ := by dsimp only [Bglobal, Dtel]; ring

open Classical in
theorem typeIII_finite_taylor_character_expansion
    (q : ℕ+) (m : ℤ) (a : (ZMod (q : ℕ))ˣ)
    (J : Finset ℕ) (S₁ S₂ S₃ : Finset ℤ)
    (c₁ c₂ c₃ : ℕ → ℤ → ℂ) (e : ℕ → ℂ) (κ₁ κ₂ κ₃ : ℂ) :
    let W₁ : ZMod (q : ℕ) → ℂ := fun z =>
      κ₁ * ∑ j ∈ J, e j * ∑ h ∈ S₁, c₁ j h *
        ZMod.stdAddChar ((h : ZMod (q : ℕ)) * z)
    let W₂ : ZMod (q : ℕ) → ℂ := fun z =>
      κ₂ * ∑ j ∈ J, e j * ∑ h ∈ S₂, c₂ j h *
        ZMod.stdAddChar ((h : ZMod (q : ℕ)) * z)
    let W₃ : ZMod (q : ℕ) → ℂ := fun z =>
      κ₃ * ∑ j ∈ J, e j * ∑ h ∈ S₃, c₃ j h *
        ZMod.stdAddChar ((h : ZMod (q : ℕ)) * z)
    (∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
      if (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = (a : ZMod (q : ℕ)) then
        W₁ z₁ * W₂ z₂ * W₃ z₃ else 0) =
      (κ₁ * κ₂ * κ₃) * (q : ℂ) *
        ∑ j₁ ∈ J, ∑ j₂ ∈ J, ∑ j₃ ∈ J,
          (e j₁ * e j₂ * e j₃) *
            (if hm : IsUnit (m : ZMod (q : ℕ)) then
              ∑ h ∈ S₁ ×ˢ (S₂ ×ˢ S₃),
                (c₁ j₁ h.1 * c₂ j₂ h.2.1 * c₃ j₃ h.2.2) *
                  typeIIICompleteFiberSum (q : ℕ)
                    (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
                    (h.2.2 : ZMod (q : ℕ)) (a * hm.unit⁻¹)
            else 0) := by
  have hfinite {ι₁ ι₂ ι₃ : Type}
      (T₁ : Finset ι₁) (T₂ : Finset ι₂) (T₃ : Finset ι₃)
      (b₁ : ι₁ → ZMod (q : ℕ) → ℂ)
      (b₂ : ι₂ → ZMod (q : ℕ) → ℂ)
      (b₃ : ι₃ → ZMod (q : ℕ) → ℂ)
      (P : ZMod (q : ℕ) → ZMod (q : ℕ) → ZMod (q : ℕ) → Prop)
      [decP : ∀ z₁ z₂ z₃, Decidable (P z₁ z₂ z₃)]
      (k₁ k₂ k₃ : ℂ) :
      (∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
        if P z₁ z₂ z₃ then
          (k₁ * ∑ i ∈ T₁, b₁ i z₁) * (k₂ * ∑ j ∈ T₂, b₂ j z₂) *
            (k₃ * ∑ k ∈ T₃, b₃ k z₃)
        else 0) =
        (k₁ * k₂ * k₃) *
          ∑ i ∈ T₁, ∑ j ∈ T₂, ∑ k ∈ T₃,
            ∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
              if P z₁ z₂ z₃ then b₁ i z₁ * b₂ j z₂ * b₃ k z₃ else 0 := by
    have hpoint (z₁ z₂ z₃ : ZMod (q : ℕ)) :
        (if P z₁ z₂ z₃ then
          (k₁ * ∑ i ∈ T₁, b₁ i z₁) * (k₂ * ∑ j ∈ T₂, b₂ j z₂) *
            (k₃ * ∑ k ∈ T₃, b₃ k z₃)
        else 0) =
          (k₁ * k₂ * k₃) *
            ∑ i ∈ T₁, ∑ j ∈ T₂, ∑ k ∈ T₃,
              if P z₁ z₂ z₃ then b₁ i z₁ * b₂ j z₂ * b₃ k z₃ else 0 := by
      by_cases hz : P z₁ z₂ z₃
      · simp only [ite_eq_left hz]
        calc
          _ = (k₁ * k₂ * k₃) *
              ((∑ i ∈ T₁, b₁ i z₁) * (∑ j ∈ T₂, b₂ j z₂) *
                (∑ k ∈ T₃, b₃ k z₃)) := by ring
          _ = _ := by
            apply congrArg (fun z : ℂ => (k₁ * k₂ * k₃) * z)
            rw [Finset.sum_mul_sum T₁ T₂ (fun i => b₁ i z₁) (fun j => b₂ j z₂),
              Finset.sum_mul]
            simp_rw [Finset.sum_mul, Finset.mul_sum]
      · simp only [ite_eq_right hz, Finset.sum_const_zero, mul_zero]
    calc
      _ = (k₁ * k₂ * k₃) *
          ∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
            ∑ i ∈ T₁, ∑ j ∈ T₂, ∑ k ∈ T₃,
              if P z₁ z₂ z₃ then b₁ i z₁ * b₂ j z₂ * b₃ k z₃ else 0 := by
        simp_rw [hpoint, Finset.mul_sum]
      _ = _ := by
        apply congrArg (fun z : ℂ => (k₁ * k₂ * k₃) * z)
        simpa only [Finset.sum_product, Fintype.sum_prod_type] using
          (Finset.sum_comm
            (s := (Finset.univ : Finset
              (ZMod (q : ℕ) × ZMod (q : ℕ) × ZMod (q : ℕ))))
            (t := T₁ ×ˢ (T₂ ×ˢ T₃))
            (f := fun z t =>
              if P z.1 z.2.1 z.2.2 then
                b₁ t.1 z.1 * b₂ t.2.1 z.2.1 * b₃ t.2.2 z.2.2
              else 0))
  have hreindex (f : (ℕ × ℤ) → (ℕ × ℤ) → (ℕ × ℤ) → ℂ) :
      (∑ k₁ ∈ J ×ˢ S₁, ∑ k₂ ∈ J ×ˢ S₂, ∑ k₃ ∈ J ×ˢ S₃, f k₁ k₂ k₃) =
        ∑ j₁ ∈ J, ∑ j₂ ∈ J, ∑ j₃ ∈ J,
          ∑ h₁ ∈ S₁, ∑ h₂ ∈ S₂, ∑ h₃ ∈ S₃,
            f (j₁, h₁) (j₂, h₂) (j₃, h₃) := by
    simp only [Finset.sum_product]
    apply Finset.sum_congr rfl
    intro j₁ _
    rw [Finset.sum_comm]
    apply Finset.sum_congr rfl
    intro j₂ _
    rw [Finset.sum_comm_cycle]
  have hpull (E : ℕ → ℕ → ℕ → ℂ)
      (V : ℕ → ℕ → ℕ → ℤ → ℤ → ℤ → ℂ) (k : ℂ) :
      (∑ j₁ ∈ J, ∑ j₂ ∈ J, ∑ j₃ ∈ J,
        ∑ h₁ ∈ S₁, ∑ h₂ ∈ S₂, ∑ h₃ ∈ S₃,
          k * E j₁ j₂ j₃ * V j₁ j₂ j₃ h₁ h₂ h₃) =
        k * ∑ j₁ ∈ J, ∑ j₂ ∈ J, ∑ j₃ ∈ J,
          E j₁ j₂ j₃ * ∑ h ∈ S₁ ×ˢ (S₂ ×ˢ S₃),
            V j₁ j₂ j₃ h.1 h.2.1 h.2.2 := by
    simp only [Finset.sum_product, Finset.mul_sum, mul_assoc]
  dsimp only
  by_cases hm : IsUnit (m : ZMod (q : ℕ))
  · simp only [dite_eq_left hm]
    have hcharacter (h₁ h₂ h₃ : ZMod (q : ℕ)) :
        (∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
          if (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = (a : ZMod (q : ℕ)) then
            ZMod.stdAddChar (h₁ * z₁ + h₂ * z₂ + h₃ * z₃) else 0) =
          (q : ℂ) * typeIIICompleteFiberSum (q : ℕ) h₁ h₂ h₃ (a * hm.unit⁻¹) := by
      have hmask (z₁ z₂ z₃ : ZMod (q : ℕ)) :
          (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = (a : ZMod (q : ℕ)) ↔
            z₁ * z₂ * z₃ = ((a * hm.unit⁻¹ : (ZMod (q : ℕ))ˣ) : ZMod (q : ℕ)) := by
        simpa only [Units.val_mul, IsUnit.unit_spec, mul_assoc, mul_comm,
          mul_left_comm] using
          (Units.eq_mul_inv_iff_mul_eq hm.unit
            (a := z₁ * z₂ * z₃) (b := (a : ZMod (q : ℕ)))).symm
      simp_rw [hmask]
      dsimp only [typeIIICompleteFiberSum]
      rw [← mul_assoc,
        mul_inv_cancel₀ (by exact_mod_cast q.ne_zero : (q : ℂ) ≠ 0), one_mul]
    let P : ZMod (q : ℕ) → ZMod (q : ℕ) → ZMod (q : ℕ) → Prop := fun z₁ z₂ z₃ =>
      (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = (a : ZMod (q : ℕ))
    let b₁ : (ℕ × ℤ) → ZMod (q : ℕ) → ℂ := fun k z =>
      e k.1 * (c₁ k.1 k.2 * ZMod.stdAddChar ((k.2 : ZMod (q : ℕ)) * z))
    let b₂ : (ℕ × ℤ) → ZMod (q : ℕ) → ℂ := fun k z =>
      e k.1 * (c₂ k.1 k.2 * ZMod.stdAddChar ((k.2 : ZMod (q : ℕ)) * z))
    let b₃ : (ℕ × ℤ) → ZMod (q : ℕ) → ℂ := fun k z =>
      e k.1 * (c₃ k.1 k.2 * ZMod.stdAddChar ((k.2 : ZMod (q : ℕ)) * z))
    have hw₁ (z : ZMod (q : ℕ)) :
        (κ₁ * ∑ j ∈ J, e j * ∑ h ∈ S₁,
          c₁ j h * ZMod.stdAddChar ((h : ZMod (q : ℕ)) * z)) =
            κ₁ * ∑ k ∈ J ×ˢ S₁, b₁ k z := by
      simp only [b₁, Finset.sum_product, Finset.mul_sum]
    have hw₂ (z : ZMod (q : ℕ)) :
        (κ₂ * ∑ j ∈ J, e j * ∑ h ∈ S₂,
          c₂ j h * ZMod.stdAddChar ((h : ZMod (q : ℕ)) * z)) =
            κ₂ * ∑ k ∈ J ×ˢ S₂, b₂ k z := by
      simp only [b₂, Finset.sum_product, Finset.mul_sum]
    have hw₃ (z : ZMod (q : ℕ)) :
        (κ₃ * ∑ j ∈ J, e j * ∑ h ∈ S₃,
          c₃ j h * ZMod.stdAddChar ((h : ZMod (q : ℕ)) * z)) =
            κ₃ * ∑ k ∈ J ×ˢ S₃, b₃ k z := by
      simp only [b₃, Finset.sum_product, Finset.mul_sum]
    let F : (ℕ × ℤ) → (ℕ × ℤ) → (ℕ × ℤ) → ℂ := fun k₁ k₂ k₃ =>
      ∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
        if P z₁ z₂ z₃ then
          b₁ k₁ z₁ * b₂ k₂ z₂ * b₃ k₃ z₃ else 0
    have hinner (j₁ j₂ j₃ : ℕ) (h₁ h₂ h₃ : ℤ) :
        F (j₁, h₁) (j₂, h₂) (j₃, h₃) =
          (q : ℂ) * (e j₁ * e j₂ * e j₃) *
            ((c₁ j₁ h₁ * c₂ j₂ h₂ * c₃ j₃ h₃) *
              typeIIICompleteFiberSum (q : ℕ)
                (h₁ : ZMod (q : ℕ)) (h₂ : ZMod (q : ℕ))
                (h₃ : ZMod (q : ℕ)) (a * hm.unit⁻¹)) := by
      dsimp only [F, P, b₁, b₂, b₃]
      calc
        _ = ((e j₁ * e j₂ * e j₃) * (c₁ j₁ h₁ * c₂ j₂ h₂ * c₃ j₃ h₃)) *
            (∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
              if (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = (a : ZMod (q : ℕ)) then
                ZMod.stdAddChar ((h₁ : ZMod (q : ℕ)) * z₁ +
                  (h₂ : ZMod (q : ℕ)) * z₂ + (h₃ : ZMod (q : ℕ)) * z₃)
              else 0) := by
          simp only [Finset.mul_sum, AddChar.map_add_eq_mul, mul_ite,
            mul_zero, mul_assoc, mul_left_comm, mul_comm]
        _ = ((e j₁ * e j₂ * e j₃) * (c₁ j₁ h₁ * c₂ j₂ h₂ * c₃ j₃ h₃)) *
            ((q : ℂ) * typeIIICompleteFiberSum (q : ℕ)
              (h₁ : ZMod (q : ℕ)) (h₂ : ZMod (q : ℕ))
              (h₃ : ZMod (q : ℕ)) (a * hm.unit⁻¹)) :=
          congrArg
            (fun z : ℂ => ((e j₁ * e j₂ * e j₃) *
              (c₁ j₁ h₁ * c₂ j₂ h₂ * c₃ j₃ h₃)) * z)
            (hcharacter (h₁ : ZMod (q : ℕ)) (h₂ : ZMod (q : ℕ)) (h₃ : ZMod (q : ℕ)))
        _ = _ := by ring
    have hF (k₁ k₂ k₃ : ℕ × ℤ) :
        F k₁ k₂ k₃ =
          ∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
            if P z₁ z₂ z₃ then b₁ k₁ z₁ * b₂ k₂ z₂ * b₃ k₃ z₃ else 0 := rfl
    have hphysicalPacked :
        (∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
          if (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = (a : ZMod (q : ℕ)) then
            (κ₁ * ∑ j ∈ J, e j * ∑ h ∈ S₁,
              c₁ j h * ZMod.stdAddChar ((h : ZMod (q : ℕ)) * z₁)) *
              (κ₂ * ∑ j ∈ J, e j * ∑ h ∈ S₂,
                c₂ j h * ZMod.stdAddChar ((h : ZMod (q : ℕ)) * z₂)) *
              (κ₃ * ∑ j ∈ J, e j * ∑ h ∈ S₃,
                c₃ j h * ZMod.stdAddChar ((h : ZMod (q : ℕ)) * z₃))
          else 0) =
            ∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
              if P z₁ z₂ z₃ then
                (κ₁ * ∑ k ∈ J ×ˢ S₁, b₁ k z₁) *
                  (κ₂ * ∑ k ∈ J ×ˢ S₂, b₂ k z₂) *
                  (κ₃ * ∑ k ∈ J ×ˢ S₃, b₃ k z₃)
              else 0 := by
      simp only [P, hw₁, hw₂, hw₃]
    clear_value F b₁ b₂ b₃
    calc
      _ = ∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
            if P z₁ z₂ z₃ then
              (κ₁ * ∑ k ∈ J ×ˢ S₁, b₁ k z₁) *
                (κ₂ * ∑ k ∈ J ×ˢ S₂, b₂ k z₂) *
                (κ₃ * ∑ k ∈ J ×ˢ S₃, b₃ k z₃)
            else 0 := hphysicalPacked
      _ = (κ₁ * κ₂ * κ₃) *
          ∑ k₁ ∈ J ×ˢ S₁, ∑ k₂ ∈ J ×ˢ S₂, ∑ k₃ ∈ J ×ˢ S₃,
            ∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
              if P z₁ z₂ z₃ then b₁ k₁ z₁ * b₂ k₂ z₂ * b₃ k₃ z₃ else 0 :=
        hfinite (J ×ˢ S₁) (J ×ˢ S₂) (J ×ˢ S₃) b₁ b₂ b₃ P
          (decP := fun z₁ z₂ z₃ =>
            ZMod.decidableEq (q : ℕ)
              ((m : ZMod (q : ℕ)) * z₁ * z₂ * z₃) (a : ZMod (q : ℕ)))
          κ₁ κ₂ κ₃
      _ = (κ₁ * κ₂ * κ₃) *
          ∑ k₁ ∈ J ×ˢ S₁, ∑ k₂ ∈ J ×ˢ S₂, ∑ k₃ ∈ J ×ˢ S₃, F k₁ k₂ k₃ := by
        simp_rw [← hF]
      _ = (κ₁ * κ₂ * κ₃) *
          ∑ j₁ ∈ J, ∑ j₂ ∈ J, ∑ j₃ ∈ J,
            ∑ h₁ ∈ S₁, ∑ h₂ ∈ S₂, ∑ h₃ ∈ S₃,
              F (j₁, h₁) (j₂, h₂) (j₃, h₃) :=
        congrArg (fun z : ℂ => (κ₁ * κ₂ * κ₃) * z) (hreindex F)
      _ = (κ₁ * κ₂ * κ₃) *
          ∑ j₁ ∈ J, ∑ j₂ ∈ J, ∑ j₃ ∈ J,
            ∑ h₁ ∈ S₁, ∑ h₂ ∈ S₂, ∑ h₃ ∈ S₃,
              (q : ℂ) * (e j₁ * e j₂ * e j₃) *
                ((c₁ j₁ h₁ * c₂ j₂ h₂ * c₃ j₃ h₃) *
                  typeIIICompleteFiberSum (q : ℕ)
                    (h₁ : ZMod (q : ℕ)) (h₂ : ZMod (q : ℕ))
                    (h₃ : ZMod (q : ℕ)) (a * hm.unit⁻¹)) := by
        simp_rw [hinner]
      _ = (κ₁ * κ₂ * κ₃) * ((q : ℂ) *
          ∑ j₁ ∈ J, ∑ j₂ ∈ J, ∑ j₃ ∈ J,
            (e j₁ * e j₂ * e j₃) *
              ∑ h ∈ S₁ ×ˢ (S₂ ×ˢ S₃),
                (c₁ j₁ h.1 * c₂ j₂ h.2.1 * c₃ j₃ h.2.2) *
                  typeIIICompleteFiberSum (q : ℕ)
                    (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
                    (h.2.2 : ZMod (q : ℕ)) (a * hm.unit⁻¹)) :=
        congrArg (fun z : ℂ => (κ₁ * κ₂ * κ₃) * z)
          (hpull (fun j₁ j₂ j₃ => e j₁ * e j₂ * e j₃)
            (fun j₁ j₂ j₃ h₁ h₂ h₃ =>
              (c₁ j₁ h₁ * c₂ j₂ h₂ * c₃ j₃ h₃) *
                typeIIICompleteFiberSum (q : ℕ)
                  (h₁ : ZMod (q : ℕ)) (h₂ : ZMod (q : ℕ))
                  (h₃ : ZMod (q : ℕ)) (a * hm.unit⁻¹))
            (q : ℂ))
      _ = _ := (mul_assoc (κ₁ * κ₂ * κ₃) (q : ℂ) _).symm
  · simp only [dite_eq_right hm, mul_zero, Finset.sum_const_zero]
    apply Finset.sum_eq_zero
    intro z₁ _
    apply Finset.sum_eq_zero
    intro z₂ _
    apply Finset.sum_eq_zero
    intro z₃ _
    apply ite_eq_right
    intro hz
    have hu : IsUnit ((m : ZMod (q : ℕ)) * z₁ * z₂ * z₃) := hz.symm ▸ a.isUnit
    exact hm (isUnit_of_mul_isUnit_left
      (isUnit_of_mul_isUnit_left (isUnit_of_mul_isUnit_left hu)))

open Classical in
theorem typeIII_global_taylor_zero_nonzero_decomposition
    (Qset : Finset ℕ+) (I : Finset ℤ) (J : Finset ℕ)
    (S₁ S₂ S₃ : Finset ℤ) (α : ℤ → ℂ) (dualη : ℕ → ℂ)
    (e : ℕ → ℕ → ℂ) (c₁ c₂ c₃ : ℕ → ℤ → ℂ) (κ₁ κ₂ κ₃ : ℂ) :
    let S : Finset (ℤ × ℤ × ℤ) := S₁ ×ˢ (S₂ ×ˢ S₃)
    let Szero := S.filter (fun h => h.1 * h.2.1 * h.2.2 = 0)
    let Snz := S.filter (fun h => h.1 * h.2.1 * h.2.2 ≠ 0)
    let c : ℕ → ℕ → ℕ → ℤ × ℤ × ℤ → ℂ := fun j₁ j₂ j₃ h =>
      c₁ j₁ h.1 * c₂ j₂ h.2.1 * c₃ j₃ h.2.2
    let D : ℕ+ → ℕ → ℕ → ℕ → ℂ := fun q j₁ j₂ j₃ =>
      dualη (q : ℕ) * e (q : ℕ) j₁ * e (q : ℕ) j₂ * e (q : ℕ) j₃
    let W₁ : (q : ℕ+) → ZMod (q : ℕ) → ℂ := fun q z =>
      κ₁ * ∑ j ∈ J, e (q : ℕ) j * ∑ h ∈ S₁,
        c₁ j h * ZMod.stdAddChar ((h : ZMod (q : ℕ)) * z)
    let W₂ : (q : ℕ+) → ZMod (q : ℕ) → ℂ := fun q z =>
      κ₂ * ∑ j ∈ J, e (q : ℕ) j * ∑ h ∈ S₂,
        c₂ j h * ZMod.stdAddChar ((h : ZMod (q : ℕ)) * z)
    let W₃ : (q : ℕ+) → ZMod (q : ℕ) → ℂ := fun q z =>
      κ₃ * ∑ j ∈ J, e (q : ℕ) j * ∑ h ∈ S₃,
        c₃ j h * ZMod.stdAddChar ((h : ZMod (q : ℕ)) * z)
    let Rt : (q : ℕ+) → ZMod (q : ℕ) → ℂ := fun q a =>
      ∑ m ∈ I, α m *
        ∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
          if (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = a then
            W₁ q z₁ * W₂ q z₂ * W₃ q z₃ else 0
    let Z : ℂ := (κ₁ * κ₂ * κ₃) *
      ∑ j₁ ∈ J, ∑ j₂ ∈ J, ∑ j₃ ∈ J,
        ∑ q ∈ Qset, (q : ℂ) * D q j₁ j₂ j₃ *
          ∑ m ∈ I, if IsUnit (m : ZMod (q : ℕ)) then
            α m * ∑ h ∈ Szero, c j₁ j₂ j₃ h *
              typeIIICompleteFiberSum (q : ℕ)
                (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
                (h.2.2 : ZMod (q : ℕ)) 1
          else 0
    ∀ a : ∀ q : ℕ+, (ZMod (q : ℕ))ˣ,
      (∑ q ∈ Qset, dualη (q : ℕ) * Rt q (a q : ZMod (q : ℕ))) - Z =
        ∑ j₁ ∈ J, ∑ j₂ ∈ J, ∑ j₃ ∈ J,
          (κ₁ * κ₂ * κ₃) *
            ∑ q ∈ Qset, (q : ℂ) * D q j₁ j₂ j₃ *
              ∑ m ∈ I, if hm : IsUnit (m : ZMod (q : ℕ)) then
                α m * ∑ h ∈ Snz, c j₁ j₂ j₃ h *
                  typeIIICompleteFiberSum (q : ℕ)
                    (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
                    (h.2.2 : ZMod (q : ℕ)) (a q * hm.unit⁻¹)
              else 0 := by
  dsimp only
  intro a
  let κ : ℂ := κ₁ * κ₂ * κ₃
  let S : Finset (ℤ × ℤ × ℤ) := S₁ ×ˢ (S₂ ×ˢ S₃)
  let Szero := S.filter (fun h => h.1 * h.2.1 * h.2.2 = 0)
  let Snz := S.filter (fun h => h.1 * h.2.1 * h.2.2 ≠ 0)
  let c : ℕ → ℕ → ℕ → ℤ × ℤ × ℤ → ℂ := fun j₁ j₂ j₃ h =>
    c₁ j₁ h.1 * c₂ j₂ h.2.1 * c₃ j₃ h.2.2
  let D : ℕ+ → ℕ → ℕ → ℕ → ℂ := fun q j₁ j₂ j₃ =>
    dualη (q : ℕ) * e (q : ℕ) j₁ * e (q : ℕ) j₂ * e (q : ℕ) j₃
  let W₁ : (q : ℕ+) → ZMod (q : ℕ) → ℂ := fun q z =>
    κ₁ * ∑ j ∈ J, e (q : ℕ) j * ∑ h ∈ S₁,
      c₁ j h * ZMod.stdAddChar ((h : ZMod (q : ℕ)) * z)
  let W₂ : (q : ℕ+) → ZMod (q : ℕ) → ℂ := fun q z =>
    κ₂ * ∑ j ∈ J, e (q : ℕ) j * ∑ h ∈ S₂,
      c₂ j h * ZMod.stdAddChar ((h : ZMod (q : ℕ)) * z)
  let W₃ : (q : ℕ+) → ZMod (q : ℕ) → ℂ := fun q z =>
    κ₃ * ∑ j ∈ J, e (q : ℕ) j * ∑ h ∈ S₃,
      c₃ j h * ZMod.stdAddChar ((h : ZMod (q : ℕ)) * z)
  let Rt : (q : ℕ+) → ZMod (q : ℕ) → ℂ := fun q a =>
    ∑ m ∈ I, α m *
      ∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
        if (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = a then
          W₁ q z₁ * W₂ q z₂ * W₃ q z₃ else 0
  let Z : ℂ := κ * ∑ j₁ ∈ J, ∑ j₂ ∈ J, ∑ j₃ ∈ J,
    ∑ q ∈ Qset, (q : ℂ) * D q j₁ j₂ j₃ *
      ∑ m ∈ I, if IsUnit (m : ZMod (q : ℕ)) then
        α m * ∑ h ∈ Szero, c j₁ j₂ j₃ h *
          typeIIICompleteFiberSum (q : ℕ)
            (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
            (h.2.2 : ZMod (q : ℕ)) 1
      else 0
  change (∑ q ∈ Qset, dualη (q : ℕ) * Rt q (a q : ZMod (q : ℕ))) - Z =
    ∑ j₁ ∈ J, ∑ j₂ ∈ J, ∑ j₃ ∈ J, κ *
      ∑ q ∈ Qset, (q : ℂ) * D q j₁ j₂ j₃ *
        ∑ m ∈ I, if hm : IsUnit (m : ZMod (q : ℕ)) then
          α m * ∑ h ∈ Snz, c j₁ j₂ j₃ h *
            typeIIICompleteFiberSum (q : ℕ)
              (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
              (h.2.2 : ZMod (q : ℕ)) (a q * hm.unit⁻¹)
        else 0
  have hswap (f : ℕ+ → ℤ → ℕ → ℕ → ℕ → ℂ) :
      (∑ q ∈ Qset, ∑ m ∈ I, ∑ j₁ ∈ J, ∑ j₂ ∈ J, ∑ j₃ ∈ J,
        f q m j₁ j₂ j₃) =
        ∑ j₁ ∈ J, ∑ j₂ ∈ J, ∑ j₃ ∈ J, ∑ q ∈ Qset, ∑ m ∈ I,
          f q m j₁ j₂ j₃ := by
    simpa only [Finset.sum_product] using
      (Finset.sum_comm (s := Qset ×ˢ I) (t := J ×ˢ (J ×ˢ J))
        (f := fun qm j => f qm.1 qm.2 j.1 j.2.1 j.2.2))
  have hpoint (q : ℕ+) (m : ℤ) :
      dualη (q : ℕ) * (α m *
        ∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
          if (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = (a q : ZMod (q : ℕ)) then
            W₁ q z₁ * W₂ q z₂ * W₃ q z₃ else 0) =
        κ * ∑ j₁ ∈ J, ∑ j₂ ∈ J, ∑ j₃ ∈ J,
          (q : ℂ) * D q j₁ j₂ j₃ *
            (if hm : IsUnit (m : ZMod (q : ℕ)) then
              α m * ∑ h ∈ S, c j₁ j₂ j₃ h *
                typeIIICompleteFiberSum (q : ℕ)
                  (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
                  (h.2.2 : ZMod (q : ℕ)) (a q * hm.unit⁻¹)
            else 0) := by
    have hcube :
        (∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
          if (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = (a q : ZMod (q : ℕ)) then
            W₁ q z₁ * W₂ q z₂ * W₃ q z₃ else 0) =
          κ * (q : ℂ) * ∑ j₁ ∈ J, ∑ j₂ ∈ J, ∑ j₃ ∈ J,
            (e (q : ℕ) j₁ * e (q : ℕ) j₂ * e (q : ℕ) j₃) *
              (if hm : IsUnit (m : ZMod (q : ℕ)) then
                ∑ h ∈ S, c j₁ j₂ j₃ h *
                  typeIIICompleteFiberSum (q : ℕ)
                    (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
                    (h.2.2 : ZMod (q : ℕ)) (a q * hm.unit⁻¹)
              else 0) := by
      simpa only [κ, W₁, W₂, W₃, S, c] using
        typeIII_finite_taylor_character_expansion q m (a q) J S₁ S₂ S₃ c₁ c₂ c₃
          (e (q : ℕ)) κ₁ κ₂ κ₃
    rw [hcube]
    simp only [Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro j₁ _
    apply Finset.sum_congr rfl
    intro j₂ _
    apply Finset.sum_congr rfl
    intro j₃ _
    by_cases hm : IsUnit (m : ZMod (q : ℕ))
    · simp only [dite_eq_left hm, D, Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro h _
      ring
    · simp only [dite_eq_right hm, mul_zero]
  have hphysical :
      (∑ q ∈ Qset, dualη (q : ℕ) * Rt q (a q : ZMod (q : ℕ))) =
        κ * ∑ j₁ ∈ J, ∑ j₂ ∈ J, ∑ j₃ ∈ J,
          ∑ q ∈ Qset, (q : ℂ) * D q j₁ j₂ j₃ *
            ∑ m ∈ I, if hm : IsUnit (m : ZMod (q : ℕ)) then
              α m * ∑ h ∈ S, c j₁ j₂ j₃ h *
                typeIIICompleteFiberSum (q : ℕ)
                  (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
                  (h.2.2 : ZMod (q : ℕ)) (a q * hm.unit⁻¹)
            else 0 := by
    calc
      _ = ∑ q ∈ Qset, ∑ m ∈ I, dualη (q : ℕ) * (α m *
          ∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
            if (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = (a q : ZMod (q : ℕ)) then
              W₁ q z₁ * W₂ q z₂ * W₃ q z₃ else 0) := by
        simp only [Rt, Finset.mul_sum]
      _ = κ * ∑ q ∈ Qset, ∑ m ∈ I, ∑ j₁ ∈ J, ∑ j₂ ∈ J, ∑ j₃ ∈ J,
          (q : ℂ) * D q j₁ j₂ j₃ *
            (if hm : IsUnit (m : ZMod (q : ℕ)) then
              α m * ∑ h ∈ S, c j₁ j₂ j₃ h *
                typeIIICompleteFiberSum (q : ℕ)
                  (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
                  (h.2.2 : ZMod (q : ℕ)) (a q * hm.unit⁻¹)
            else 0) := by
        simp_rw [hpoint, Finset.mul_sum]
      _ = κ * ∑ j₁ ∈ J, ∑ j₂ ∈ J, ∑ j₃ ∈ J, ∑ q ∈ Qset, ∑ m ∈ I,
          (q : ℂ) * D q j₁ j₂ j₃ *
            (if hm : IsUnit (m : ZMod (q : ℕ)) then
              α m * ∑ h ∈ S, c j₁ j₂ j₃ h *
                typeIIICompleteFiberSum (q : ℕ)
                  (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
                  (h.2.2 : ZMod (q : ℕ)) (a q * hm.unit⁻¹)
            else 0) := by
        rw [hswap]
      _ = _ := by simp only [Finset.mul_sum]
  have hfrequencySplit (q : ℕ+) (m : ℤ) (j₁ j₂ j₃ : ℕ) :
      (if hm : IsUnit (m : ZMod (q : ℕ)) then
        α m * ∑ h ∈ S, c j₁ j₂ j₃ h *
          typeIIICompleteFiberSum (q : ℕ)
            (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
            (h.2.2 : ZMod (q : ℕ)) (a q * hm.unit⁻¹)
      else 0) =
        (if IsUnit (m : ZMod (q : ℕ)) then
          α m * ∑ h ∈ Szero, c j₁ j₂ j₃ h *
            typeIIICompleteFiberSum (q : ℕ)
              (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
              (h.2.2 : ZMod (q : ℕ)) 1
        else 0) +
        (if hm : IsUnit (m : ZMod (q : ℕ)) then
          α m * ∑ h ∈ Snz, c j₁ j₂ j₃ h *
            typeIIICompleteFiberSum (q : ℕ)
              (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
              (h.2.2 : ZMod (q : ℕ)) (a q * hm.unit⁻¹)
        else 0) := by
    by_cases hm : IsUnit (m : ZMod (q : ℕ))
    · simp only [dite_eq_left hm, ite_eq_left hm]
      rw [← mul_add]
      congr 1
      have hzero :
          (∑ h ∈ Szero, c j₁ j₂ j₃ h *
            typeIIICompleteFiberSum (q : ℕ)
              (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
              (h.2.2 : ZMod (q : ℕ)) (a q * hm.unit⁻¹)) =
            ∑ h ∈ Szero, c j₁ j₂ j₃ h *
              typeIIICompleteFiberSum (q : ℕ)
                (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
                (h.2.2 : ZMod (q : ℕ)) 1 := by
        apply Finset.sum_congr rfl
        intro h hh
        have hz : h.1 = 0 ∨ h.2.1 = 0 ∨ h.2.2 = 0 := by
          simpa only [mul_eq_zero, or_assoc] using (Finset.mem_filter.mp hh).2
        have hzq : (h.1 : ZMod (q : ℕ)) = 0 ∨
            (h.2.1 : ZMod (q : ℕ)) = 0 ∨ (h.2.2 : ZMod (q : ℕ)) = 0 := by
          rcases hz with h₁ | h₂ | h₃
          · exact Or.inl (by simp only [h₁, Int.cast_zero])
          · exact Or.inr (Or.inl (by simp only [h₂, Int.cast_zero]))
          · exact Or.inr (Or.inr (by simp only [h₃, Int.cast_zero]))
        rw [typeIIICompleteFiberSum_eq_of_zero_coordinate (q : ℕ)
          (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ)) (h.2.2 : ZMod (q : ℕ))
          (a q * hm.unit⁻¹) 1 hzq]
      calc
        _ = (∑ h ∈ Szero, c j₁ j₂ j₃ h *
            typeIIICompleteFiberSum (q : ℕ)
              (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
              (h.2.2 : ZMod (q : ℕ)) (a q * hm.unit⁻¹)) +
            ∑ h ∈ Snz, c j₁ j₂ j₃ h *
              typeIIICompleteFiberSum (q : ℕ)
                (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
                (h.2.2 : ZMod (q : ℕ)) (a q * hm.unit⁻¹) := by
          simpa only [Szero, Snz] using
            (Finset.sum_filter_add_sum_filter_not S
              (fun h => h.1 * h.2.1 * h.2.2 = 0)
              (fun h => c j₁ j₂ j₃ h * typeIIICompleteFiberSum (q : ℕ)
                (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
                (h.2.2 : ZMod (q : ℕ)) (a q * hm.unit⁻¹))).symm
        _ = _ := by rw [hzero]
    · simp only [dite_eq_right hm, ite_eq_right hm, zero_add]
  have hphysical_sum :
      (∑ q ∈ Qset, dualη (q : ℕ) * Rt q (a q : ZMod (q : ℕ))) =
        Z + ∑ j₁ ∈ J, ∑ j₂ ∈ J, ∑ j₃ ∈ J, κ *
          ∑ q ∈ Qset, (q : ℂ) * D q j₁ j₂ j₃ *
            ∑ m ∈ I, if hm : IsUnit (m : ZMod (q : ℕ)) then
              α m * ∑ h ∈ Snz, c j₁ j₂ j₃ h *
                typeIIICompleteFiberSum (q : ℕ)
                  (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
                  (h.2.2 : ZMod (q : ℕ)) (a q * hm.unit⁻¹)
            else 0 := by
    rw [hphysical]
    simp_rw [hfrequencySplit, Finset.sum_add_distrib, mul_add]
    simp only [Z, Finset.mul_sum, Finset.sum_add_distrib, mul_add]
  rw [hphysical_sum, add_sub_cancel_left]

open Classical in
theorem typeIII_physical_coherent_center_to_norm
    (Qset : Finset ℕ+) (I P₁ P₂ P₃ : Finset ℤ)
    (w : ℤ → ℤ → ℤ → ℤ → ℂ) (B : ℝ) :
    let R : (q : ℕ+) → ZMod (q : ℕ) → ℂ := fun q a =>
      ∑ m ∈ I, ∑ n₁ ∈ P₁, ∑ n₂ ∈ P₂, ∑ n₃ ∈ P₃,
        if ((m * n₁ * n₂ * n₃ : ℤ) : ZMod (q : ℕ)) = a then
          w m n₁ n₂ n₃ else 0
    let U : ℕ+ → ℂ := fun q =>
      ∑ m ∈ I, ∑ n₁ ∈ P₁, ∑ n₂ ∈ P₂, ∑ n₃ ∈ P₃,
        if IsUnit ((m * n₁ * n₂ * n₃ : ℤ) : ZMod (q : ℕ)) then
          w m n₁ n₂ n₃ else 0
    (∀ η : ℕ → ℂ, (∀ q ∈ Qset, ‖η (q : ℕ)‖ ≤ 1) →
      ∃ Z : ℂ,
      ∀ (a₀ : ℤ) (a : ∀ q : ℕ+, (ZMod (q : ℕ))ˣ),
        (∀ q ∈ Qset, (a q : ZMod (q : ℕ)) = (a₀ : ZMod (q : ℕ))) →
        ‖(∑ q ∈ Qset, η (q : ℕ) * R q (a q : ZMod (q : ℕ))) - Z‖ ≤ B) →
    ∀ (a₀ : ℤ) (a : ∀ q : ℕ+, (ZMod (q : ℕ))ˣ),
      (∀ q ∈ Qset, (a q : ZMod (q : ℕ)) = (a₀ : ZMod (q : ℕ))) →
      ∑ q ∈ Qset,
        ‖R q (a q : ZMod (q : ℕ)) - U q / ((q : ℕ).totient : ℂ)‖ ≤ 2 * B := by
  dsimp only
  let R : (q : ℕ+) → ZMod (q : ℕ) → ℂ := fun q a =>
    ∑ m ∈ I, ∑ n₁ ∈ P₁, ∑ n₂ ∈ P₂, ∑ n₃ ∈ P₃,
      if ((m * n₁ * n₂ * n₃ : ℤ) : ZMod (q : ℕ)) = a then
        w m n₁ n₂ n₃ else 0
  let U : ℕ+ → ℂ := fun q =>
    ∑ m ∈ I, ∑ n₁ ∈ P₁, ∑ n₂ ∈ P₂, ∑ n₃ ∈ P₃,
      if IsUnit ((m * n₁ * n₂ * n₃ : ℤ) : ZMod (q : ℕ)) then
        w m n₁ n₂ n₃ else 0
  change
    (∀ η : ℕ → ℂ, (∀ q ∈ Qset, ‖η (q : ℕ)‖ ≤ 1) →
      ∃ Z : ℂ,
      ∀ (a₀ : ℤ) (a : ∀ q : ℕ+, (ZMod (q : ℕ))ˣ),
        (∀ q ∈ Qset, (a q : ZMod (q : ℕ)) = (a₀ : ZMod (q : ℕ))) →
        ‖(∑ q ∈ Qset, η (q : ℕ) * R q (a q : ZMod (q : ℕ))) - Z‖ ≤ B) →
      ∀ (a₀ : ℤ) (a : ∀ q : ℕ+, (ZMod (q : ℕ))ˣ),
        (∀ q ∈ Qset, (a q : ZMod (q : ℕ)) = (a₀ : ZMod (q : ℕ))) →
        ∑ q ∈ Qset,
          ‖R q (a q : ZMod (q : ℕ)) - U q / ((q : ℕ).totient : ℂ)‖ ≤ 2 * B
  intro hcenter
  have hprimitive_indicator (q : ℕ+) (r : ZMod (q : ℕ)) (v : ℂ) :
      (∑ b ∈ primitiveResidues (q : ℕ),
        if r = (b : ZMod (q : ℕ)) then v else 0) =
          if IsUnit r then v else 0 := by
    have hmem :
        r.val ∈ primitiveResidues (q : ℕ) ↔ IsUnit r := by
      simp only [primitiveResidues, Finset.mem_filter,
        Finset.mem_range, ZMod.val_lt, true_and]
      simpa only [ZMod.natCast_zmod_val] using
        (ZMod.isUnit_iff_coprime r.val (q : ℕ)).symm
    calc
      _ = ∑ b ∈ primitiveResidues (q : ℕ),
          if r.val = b then v else 0 := by
        apply Finset.sum_congr rfl
        intro b hb
        have hbq : b < (q : ℕ) :=
          Finset.mem_range.mp (Finset.mem_filter.mp hb).1
        have heq : r = (b : ZMod (q : ℕ)) ↔ r.val = b := by
          rw [← (ZMod.val_injective (q : ℕ)).eq_iff, ZMod.val_natCast_of_lt hbq]
        exact if_congr heq rfl rfl
      _ = if r.val ∈ primitiveResidues (q : ℕ)
          then v else 0 := Finset.sum_ite_eq _ _ (fun _ => v)
      _ = _ := if_congr hmem rfl rfl
  have hphysical_primitive_mean (G : ℕ) (hG : 0 < G)
      (q : ℕ+) (hqG : (q : ℕ) ∣ G) :
      (∑ b ∈ primitiveResidues G,
        R q (b : ZMod (q : ℕ))) / (G.totient : ℂ) =
          U q / ((q : ℕ).totient : ℂ) := by
    have hlocal :
        (∑ b ∈ primitiveResidues (q : ℕ),
          R q (b : ZMod (q : ℕ))) = U q := by
      dsimp only [R, U]
      rw [Finset.sum_comm]
      apply Finset.sum_congr rfl
      intro m _
      rw [Finset.sum_comm]
      apply Finset.sum_congr rfl
      intro n₁ _
      rw [Finset.sum_comm]
      apply Finset.sum_congr rfl
      intro n₂ _
      rw [Finset.sum_comm]
      apply Finset.sum_congr rfl
      intro n₃ _
      exact hprimitive_indicator q
        (((m * n₁ * n₂ * n₃ : ℤ) : ZMod (q : ℕ))) (w m n₁ n₂ n₃)
    calc
      _ = (∑ b ∈ primitiveResidues (q : ℕ),
          R q (b : ZMod (q : ℕ))) / ((q : ℕ).totient : ℂ) := by
        simpa only [ZMod.natCast_mod] using
          average_primitiveResidues_mod hG hqG
            (fun b => R q (b : ZMod (q : ℕ)))
      _ = _ := by rw [hlocal]
  intro a₀ a ha
  let G : ℕ := Qset.lcm (fun q => (q : ℕ))
  have hG : 0 < G := by
    apply Nat.pos_of_ne_zero
    exact Finset.lcm_ne_zero_iff.mpr (fun q _ => q.pos.ne')
  have hqG (q : ℕ+) (hq : q ∈ Qset) : (q : ℕ) ∣ G :=
    Finset.dvd_lcm hq
  let P : Finset ℕ := primitiveResidues G
  have hPcard : P.card = G.totient := by
    simpa only [P, primitiveResidues, Nat.coprime_comm] using
      (Nat.totient_eq_card_coprime G).symm
  have hPne : P.Nonempty := Finset.card_pos.mp (by
    rw [hPcard]
    exact Nat.totient_pos.mpr hG)
  choose ζ hζ using fun q : ℕ+ => Complex.exists_norm_eq_mul_self
    (R q (a q : ZMod (q : ℕ)) - U q / ((q : ℕ).totient : ℂ))
  let η : ℕ → ℂ := fun n => if hn : 0 < n then ζ ⟨n, hn⟩ else 0
  have hηq (q : ℕ+) : η (q : ℕ) = ζ q := by
    simp only [η, dite_eq_left q.pos]
    exact congrArg ζ (PNat.coe_injective rfl)
  obtain ⟨Z, hZ⟩ := hcenter η (by
    intro q _
    rw [hηq]
    exact (hζ q).1.le)
  let S : ℕ → ℂ := fun b =>
    ∑ q ∈ Qset, η (q : ℕ) * R q (b : ZMod (q : ℕ))
  have hmean : (∑ b ∈ P, S b) / (G.totient : ℂ) =
      ∑ q ∈ Qset, η (q : ℕ) * (U q / ((q : ℕ).totient : ℂ)) := by
    dsimp only [S]
    rw [Finset.sum_comm, Finset.sum_div]
    apply Finset.sum_congr rfl
    intro q hq
    rw [← Finset.mul_sum, mul_div_assoc,
      hphysical_primitive_mean G hG q (hqG q hq)]
  have hZb (b : ℕ) (hb : b ∈ P) : ‖S b - Z‖ ≤ B := by
    have hbG : Nat.Coprime b G := (Finset.mem_filter.mp hb).2
    let ab : ∀ q : ℕ+, (ZMod (q : ℕ))ˣ := fun q =>
      if hq : q ∈ Qset then ZMod.unitOfCoprime b (hbG.of_dvd_right (hqG q hq))
      else 1
    have hab (q : ℕ+) (hq : q ∈ Qset) :
        (ab q : ZMod (q : ℕ)) = ((b : ℤ) : ZMod (q : ℕ)) := by
      simp only [ab, dite_eq_left hq, ZMod.coe_unitOfCoprime, Int.cast_natCast]
    have hS : (∑ q ∈ Qset, η (q : ℕ) * R q (ab q : ZMod (q : ℕ))) = S b := by
      dsimp only [S]
      apply Finset.sum_congr rfl
      intro q hq
      rw [hab q hq, Int.cast_natCast]
    simpa only [hS] using hZ (b : ℤ) ab hab
  have hmeanZ : ‖(∑ b ∈ P, S b) / (G.totient : ℂ) - Z‖ ≤ B := by
    have hbound : ‖Finset.expect P (fun b => S b - Z)‖ ≤ B :=
      (RCLike.norm_expect_le (K := ℂ) (s := P) (f := fun b => S b - Z)).trans
        (Finset.expect_le hPne hZb)
    simp only [Finset.expect_sub_distrib, Finset.expect_const hPne] at hbound
    simpa only [Finset.expect_eq_sum_div_card, hPcard] using hbound
  have hlinear :
      ((∑ q ∈ Qset,
        ‖R q (a q : ZMod (q : ℕ)) - U q / ((q : ℕ).totient : ℂ)‖ : ℝ) : ℂ) =
        (∑ q ∈ Qset, η (q : ℕ) * R q (a q : ZMod (q : ℕ))) -
          (∑ b ∈ P, S b) / (G.totient : ℂ) := by
    calc
      _ = ∑ q ∈ Qset, η (q : ℕ) *
          (R q (a q : ZMod (q : ℕ)) - U q / ((q : ℕ).totient : ℂ)) := by
        rw [Complex.ofReal_sum]
        apply Finset.sum_congr rfl
        intro q _
        rw [hηq]
        exact (hζ q).2
      _ = (∑ q ∈ Qset, η (q : ℕ) * R q (a q : ZMod (q : ℕ))) -
          ∑ q ∈ Qset, η (q : ℕ) * (U q / ((q : ℕ).totient : ℂ)) := by
        simp only [mul_sub, Finset.sum_sub_distrib]
      _ = _ := by rw [hmean]
  have hnonneg : 0 ≤ ∑ q ∈ Qset,
      ‖R q (a q : ZMod (q : ℕ)) - U q / ((q : ℕ).totient : ℂ)‖ :=
    Finset.sum_nonneg (fun _ _ => norm_nonneg _)
  calc
    (∑ q ∈ Qset,
      ‖R q (a q : ZMod (q : ℕ)) - U q / ((q : ℕ).totient : ℂ)‖) =
        ‖((∑ q ∈ Qset,
          ‖R q (a q : ZMod (q : ℕ)) - U q / ((q : ℕ).totient : ℂ)‖ : ℝ) : ℂ)‖ :=
      (Complex.norm_of_nonneg hnonneg).symm
    _ = ‖((∑ q ∈ Qset, η (q : ℕ) * R q (a q : ZMod (q : ℕ))) - Z) -
        ((∑ b ∈ P, S b) / (G.totient : ℂ) - Z)‖ := by
      rw [hlinear, sub_sub_sub_cancel_right]
    _ ≤ B + B := norm_sub_le_of_le (hZ a₀ a ha) hmeanZ
    _ = 2 * B := (two_mul B).symm

theorem typeIII_fixed_majorant : ∃ (L : ℝ) (ψ : ℝ → ℝ),
    1 ≤ L ∧ ContDiff ℝ 2 ψ ∧
    (∀ t : ℝ, 0 ≤ ψ t) ∧
    (∀ t ∈ Set.Icc (-1 : ℝ) 1, ψ t = 1) ∧
    Function.support ψ ⊆ Set.Icc (-2 : ℝ) 2 ∧
    (∀ t : ℝ, ‖ψ t‖ ≤ L ∧ ‖deriv ψ t‖ ≤ L ∧
      ‖deriv (deriv ψ) t‖ ≤ L) := by
  let f : ContDiffBump (0 : ℝ) := ⟨1, 2, by norm_num, by norm_num⟩
  have hf : ContDiff ℝ ∞ (fun t : ℝ => f t) := f.contDiff
  have hf₁ : ContDiff ℝ ∞ (deriv (fun t : ℝ => f t)) :=
    (contDiff_infty_iff_deriv.mp hf).2
  obtain ⟨B₁, hB₁⟩ := f.hasCompactSupport.deriv.exists_bound_of_continuous
    hf₁.continuous
  obtain ⟨B₂, hB₂⟩ := f.hasCompactSupport.deriv.deriv.exists_bound_of_continuous
    (hf₁.continuous_deriv (by simp))
  refine ⟨max 1 (max B₁ B₂), (fun t : ℝ => f t), le_max_left _ _,
    hf.of_le (by simp), (fun t => f.nonneg), ?_, ?_, ?_⟩
  · intro t ht
    apply f.one_of_mem_closedBall
    simpa only [Real.closedBall_zero_eq_Icc] using ht
  · change Function.support f ⊆ Set.Icc (-2 : ℝ) 2
    rw [f.support_eq, Real.ball_zero_eq_Ioo]
    exact Set.Ioo_subset_Icc_self
  · intro t
    refine ⟨?_, (hB₁ t).trans ((le_max_left _ _).trans (le_max_right _ _)),
      (hB₂ t).trans ((le_max_right _ _).trans (le_max_right _ _))⟩
    rw [Real.norm_of_nonneg f.nonneg]
    exact f.le_one.trans (le_max_left _ _)

theorem typeIII_log_cube_threshold (ε E : ℝ) (hε : 0 < ε) :
    ∃ X : ℝ, Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      (max 1 ((Real.log x) ^ E)) ^ 3 ≤ x ^ ε := by
  have hlog : ∀ᶠ x : ℝ in Filter.atTop,
      (Real.log x) ^ E ≤ x ^ (ε / 3) := by
    have hsmall := (isLittleO_log_rpow_rpow_atTop E
      (by positivity : 0 < ε / 3)).bound (by norm_num : (0 : ℝ) < 1)
    filter_upwards [hsmall, Filter.eventually_ge_atTop (1 : ℝ)] with x hx hx1
    simpa only [one_mul, Real.norm_eq_abs,
      abs_of_nonneg (Real.rpow_nonneg (Real.log_nonneg hx1) E),
      abs_of_nonneg (Real.rpow_nonneg (zero_le_one.trans hx1) (ε / 3))] using hx
  obtain ⟨X₀, hX₀⟩ := Filter.eventually_atTop.mp hlog
  refine ⟨max (Real.exp 1) X₀, le_max_left _ _, ?_⟩
  intro x hx
  have hxexp : Real.exp 1 ≤ x := (le_max_left _ _).trans hx
  have hx1 : 1 ≤ x := (Real.one_le_exp (by norm_num : (0 : ℝ) ≤ 1)).trans hxexp
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hmax : max 1 ((Real.log x) ^ E) ≤ x ^ (ε / 3) :=
    max_le (Real.one_le_rpow hx1 (by positivity))
      (hX₀ x ((le_max_right _ _).trans hx))
  calc
    _ ≤ (x ^ (ε / 3)) ^ 3 := by gcongr
    _ = x ^ ε := by
      rw [← Real.rpow_mul_natCast hx0.le]
      congr 1
      ring

theorem typeIII_fineband_scale_bounds
    (omegaExp C E : ℝ) (hωupper : omegaExp < 1 / 12) (hC : 1 ≤ C)
    (ε x Q : ℝ) (hε : 0 < ε) (hεsmall : ε ≤ 1 / 100)
    (hx1 : 1 ≤ x) (hxC : 2 * C ≤ x) (hQ : 0 < Q)
    (hQupper : Q ≤ C * x ^ (1 / 2 + 2 * omegaExp + ε))
    (hA : (max 1 ((Real.log x) ^ E)) ^ 3 ≤ x ^ ε) :
    (∀ q : ℕ+, (q : ℝ) ≤ 2 * Q → (q : ℝ) * x ^ (-10 : ℝ) ≤ 1) ∧
    Q ^ 2 * (max 1 ((Real.log x) ^ E)) ^ 2 * x ^ (-10 : ℝ) ≤
      C ^ 2 * x ^ (-2 * ε) := by
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hC0 : 0 ≤ C := zero_le_one.trans hC
  have hexp : 1 / 2 + 2 * omegaExp + ε ≤ (1 : ℝ) := by linarith
  have hQx : Q ≤ C * x := calc
    _ ≤ C * x ^ (1 / 2 + 2 * omegaExp + ε) := hQupper
    _ ≤ C * x ^ (1 : ℝ) :=
      mul_le_mul_of_nonneg_left
        (Real.rpow_le_rpow_of_exponent_le hx1 hexp) hC0
    _ = C * x := by rw [Real.rpow_one]
  have hpow2 : (max 1 ((Real.log x) ^ E)) ^ 2 ≤ x := by
    calc
      _ ≤ (max 1 ((Real.log x) ^ E)) ^ 3 :=
        pow_le_pow_right₀ (le_max_left _ _) (by norm_num)
      _ ≤ x ^ ε := hA
      _ ≤ x ^ (1 : ℝ) :=
        Real.rpow_le_rpow_of_exponent_le hx1 (by linarith)
      _ = x := Real.rpow_one x
  constructor
  · intro q hq
    have hq2 : (q : ℝ) ≤ x ^ 2 := by
      have hmid : (q : ℝ) ≤ 2 * (C * x) := hq.trans
        (mul_le_mul_of_nonneg_left hQx (by norm_num))
      nlinarith [mul_le_mul_of_nonneg_right hxC hx0.le]
    calc
      _ ≤ x ^ 2 * x ^ (-10 : ℝ) := by gcongr
      _ = x ^ (-8 : ℝ) := by
        rw [show x ^ (2 : ℕ) = x ^ (2 : ℝ) by norm_num, ← Real.rpow_add hx0]
        norm_num
      _ ≤ 1 := Real.rpow_le_one_of_one_le_of_nonpos hx1 (by norm_num)
  · calc
      _ ≤ (C * x) ^ 2 * x * x ^ (-10 : ℝ) := by gcongr
      _ = C ^ 2 * x ^ (-7 : ℝ) := by
        rw [mul_pow]
        calc
          C ^ 2 * x ^ 2 * x * x ^ (-10 : ℝ) =
              C ^ 2 * (x ^ (3 : ℝ) * x ^ (-10 : ℝ)) := by
            norm_num
            ring
          _ = _ := by rw [← Real.rpow_add hx0]; norm_num
      _ ≤ C ^ 2 * x ^ (-2 * ε) :=
        mul_le_mul_of_nonneg_left
          (Real.rpow_le_rpow_of_exponent_le hx1 (by linarith)) (sq_nonneg C)

open Classical in
theorem typeIII_sampled_convolution_fineBand_discrepancy_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (omegaExp δ σ C T E : ℝ)
    (hω : 0 < omegaExp) (hωupper : omegaExp < 1 / 12)
    (hδ : 0 < δ) (hC : 1 ≤ C) (hT : 0 ≤ T)
    (hσ : 1 / 18 + 28 / 9 * omegaExp + 2 / 9 * δ < σ) :
    let μ : ℝ := 3 * σ / 4 - 7 * omegaExp / 3 - δ / 6 - 1 / 24
    let γ : ℝ := 1 / 2 + δ - 6 * omegaExp
    let εcap : ℝ := min (1 / 100) (min (μ / 8) (γ / 12))
    0 < εcap ∧
      ∀ ε : ℝ, 0 < ε → ε ≤ εcap →
      let J : ℕ := Nat.ceil (22 / ε)
      ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ M N₁ N₂ N₃ Qcenter : ℝ,
        1 ≤ M → 0 < Qcenter →
        8 * x ^ (ε / 2) ≤ N₁ →
        8 * x ^ (ε / 2) ≤ N₂ →
        8 * x ^ (ε / 2) ≤ N₃ →
        let N : ℝ := N₁ * N₂ * N₃
        x / C ≤ M * N → M * N ≤ C * x →
        x ^ (3 / 4 + 3 * σ / 2 - ε) / C ≤ N →
        Qcenter ≤ C * x ^ (1 / 2 + 2 * omegaExp + ε) →
      ∀ Y : Set.Ici (1 : ℝ), (Y : ℝ) = x ^ δ →
      ∀ Qset : Finset ℕ+,
        (∀ q ∈ Qset,
          Squarefree (q : ℕ) ∧
          Nonempty (DenseDivisibilityWitness Y 1 (q : ℕ)) ∧
          Qcenter * (1 - C * x ^ (-ε)) ≤ (q : ℝ) ∧
          (q : ℝ) ≤ Qcenter * (1 + C * x ^ (-ε))) →
      ∀ M₀ M₁ : ℤ, 0 < M₀ → (M₁ : ℝ) - (M₀ : ℝ) ≤ M →
        (∀ m ∈ Finset.Icc M₀ M₁, |(m : ℝ)| ≤ C * M) →
      ∀ (L₁ L₂ L₃ Wα : ℝ), 0 ≤ L₁ → 0 ≤ L₂ → 0 ≤ L₃ → 0 ≤ Wα →
      ∀ (α : ℤ → ℂ) (ψ₁ ψ₂ ψ₃ : ℝ → ℂ),
        (∀ m ∈ Finset.Icc M₀ M₁, ‖α m‖ ≤ Wα) →
        ContDiff ℝ ∞ ψ₁ → ContDiff ℝ ∞ ψ₂ → ContDiff ℝ ∞ ψ₃ →
        Function.support ψ₁ ⊆ Set.Icc (-T) T →
        Function.support ψ₂ ⊆ Set.Icc (-T) T →
        Function.support ψ₃ ⊆ Set.Icc (-T) T →
        (∀ r : ℕ, r ≤ J + 2 → ∀ t : ℝ,
          ‖iteratedDeriv r ψ₁ t‖ ≤ L₁ * (Real.log x) ^ E) →
        (∀ r : ℕ, r ≤ J + 2 → ∀ t : ℝ,
          ‖iteratedDeriv r ψ₂ t‖ ≤ L₂ * (Real.log x) ^ E) →
        (∀ r : ℕ, r ≤ J + 2 → ∀ t : ℝ,
          ‖iteratedDeriv r ψ₃ t‖ ≤ L₃ * (Real.log x) ^ E) →
        let I : Finset ℤ := Finset.Icc M₀ M₁
        let P₁ : Finset ℤ := Finset.Icc (Int.ceil (-T * N₁)) (Int.floor (T * N₁))
        let P₂ : Finset ℤ := Finset.Icc (Int.ceil (-T * N₂)) (Int.floor (T * N₂))
        let P₃ : Finset ℤ := Finset.Icc (Int.ceil (-T * N₃)) (Int.floor (T * N₃))
        let w : ℤ → ℤ → ℤ → ℤ → ℂ := fun m n₁ n₂ n₃ =>
          α m * ψ₁ ((n₁ : ℝ) / N₁) * ψ₂ ((n₂ : ℝ) / N₂) *
            ψ₃ ((n₃ : ℝ) / N₃)
        let R : (q : ℕ+) → ZMod (q : ℕ) → ℂ := fun q a =>
          ∑ m ∈ I, ∑ n₁ ∈ P₁, ∑ n₂ ∈ P₂, ∑ n₃ ∈ P₃,
            if ((m * n₁ * n₂ * n₃ : ℤ) : ZMod (q : ℕ)) = a then
              w m n₁ n₂ n₃ else 0
        let U : ℕ+ → ℂ := fun q =>
          ∑ m ∈ I, ∑ n₁ ∈ P₁, ∑ n₂ ∈ P₂, ∑ n₃ ∈ P₃,
            if IsUnit ((m * n₁ * n₂ * n₃ : ℤ) : ZMod (q : ℕ)) then
              w m n₁ n₂ n₃ else 0
        (∀ η : ℕ → ℂ, (∀ q ∈ Qset, ‖η (q : ℕ)‖ ≤ 1) →
          ∃ Z : ℂ,
          ∀ (a₀ : ℤ) (a : ∀ q : ℕ+, (ZMod (q : ℕ))ˣ),
            (∀ q ∈ Qset, (a q : ZMod (q : ℕ)) = (a₀ : ZMod (q : ℕ))) →
            ‖(∑ q ∈ Qset, η (q : ℕ) * R q (a q : ZMod (q : ℕ))) - Z‖ ≤
              K * (L₁ * L₂ * L₃) * Wα * (M * N) * x ^ (-2 * ε)) ∧
        (∀ (a₀ : ℤ) (a : ∀ q : ℕ+, (ZMod (q : ℕ))ˣ),
          (∀ q ∈ Qset, (a q : ZMod (q : ℕ)) = (a₀ : ZMod (q : ℕ))) →
          ∑ q ∈ Qset,
            ‖R q (a q : ZMod (q : ℕ)) - U q / ((q : ℕ).totient : ℂ)‖ ≤
            2 * K * (L₁ * L₂ * L₃) * Wα * (M * N) * x ^ (-2 * ε)) := by
  have hmarkCard (M : ℝ) (hM : 1 ≤ M) (M₀ M₁ : ℤ)
      (hwidth : (M₁ : ℝ) - (M₀ : ℝ) ≤ M) :
      ((Finset.Icc M₀ M₁).card : ℝ) ≤ 2 * M := by
    rcases (Finset.Icc M₀ M₁).eq_empty_or_nonempty with hI | hI
    · rw [hI, Finset.card_empty, Nat.cast_zero]
      linarith only [hM]
    · obtain ⟨m, hm⟩ := hI
      have hm' := Finset.mem_Icc.mp hm
      have hcast : ((Finset.Icc M₀ M₁).card : ℝ) =
          (M₁ : ℝ) + 1 - (M₀ : ℝ) := by
        exact_mod_cast Int.card_Icc_of_le M₀ M₁ (show M₀ ≤ M₁ + 1 by omega)
      rw [hcast]
      linarith only [hM, hwidth]
  have hterm := typeIII_fineBand_nonzero_fourier_power_saving_of_deligne
    hDeligne omegaExp δ σ C hω hωupper hδ hC hσ
  dsimp only at hterm ⊢
  refine ⟨hterm.1, ?_⟩
  intro ε hε hεcap
  let J : ℕ := Nat.ceil (22 / ε)
  have hεsmall : ε ≤ 1 / 100 := hεcap.trans (min_le_left _ _)
  obtain ⟨Kt, Xt, hKt, _, htermBound⟩ := hterm.2 ε hε hεcap
  have hft := typeIII_sampled_transform_fineBand_taylor (10 : ℝ) ε C T E
    (by norm_num) hε hC hT
  have horder : 2 * ((10 : ℝ) + 1) / ε = 22 / ε := by ring
  simp only [horder] at hft
  obtain ⟨Cf, Cerr, Xf, hCf, hCerr, _, hftBound⟩ := hft
  obtain ⟨Lstar, φ, hLstar, hφcont, hφnonneg, hφone, hφsupport, hφbounds⟩ :=
    typeIII_fixed_majorant
  have hLstar0 : 0 ≤ Lstar := zero_le_one.trans hLstar
  obtain ⟨Xlog, _, hlogBound⟩ := typeIII_log_cube_threshold ε E hε
  have hfine : ∀ᶠ x : ℝ in Filter.atTop, C * x ^ (-ε) ≤ 1 / 3 := by
    have ht := (tendsto_rpow_neg_atTop hε).const_mul C
    exact ht.eventually_le_const (by norm_num : C * 0 < (1 : ℝ) / 3)
  obtain ⟨Xfine, hXfine⟩ := Filter.eventually_atTop.mp hfine
  let D : ℝ := 2 * T + 3
  let e : ℝ := 2 * Cerr
  let Dtel : ℝ := e * (D ^ 2 + (D + e) * D + (D + e) ^ 2)
  let Sstar : ℝ := Real.sqrt ((2 * (2 : ℝ) + 3) * Lstar)
  let Ct : ℝ := 8 * Kt * ((J + 1 : ℕ) : ℝ) ^ 3 * Cf ^ 3 * Sstar
  let Ce : ℝ := 8 * Dtel * C ^ 2
  let K : ℝ := 1 + Ct + Ce
  let X : ℝ := max (Real.exp 1) (max Xt (max Xf (max Xlog (max Xfine (2 * C)))))
  have hD : 0 ≤ D :=
    add_nonneg (mul_nonneg (by norm_num : (0 : ℝ) ≤ 2) hT) (by norm_num)
  have he : 0 ≤ e := mul_nonneg (by norm_num : (0 : ℝ) ≤ 2) hCerr.le
  have hDtel : 0 ≤ Dtel :=
    mul_nonneg he (add_nonneg
      (add_nonneg (sq_nonneg D) (mul_nonneg (add_nonneg hD he) hD))
      (sq_nonneg (D + e)))
  have hCt : 0 ≤ Ct :=
    mul_nonneg
      (mul_nonneg
        (mul_nonneg
          (mul_nonneg (by norm_num : (0 : ℝ) ≤ 8) hKt.le)
          (pow_nonneg (Nat.cast_nonneg (J + 1)) 3))
        (pow_nonneg hCf.le 3))
      (Real.sqrt_nonneg _)
  have hCe : 0 ≤ Ce :=
    mul_nonneg (mul_nonneg (by norm_num : (0 : ℝ) ≤ 8) hDtel) (sq_nonneg C)
  refine ⟨K, X, add_pos_of_pos_of_nonneg
    (add_pos_of_pos_of_nonneg zero_lt_one hCt) hCe, le_max_left _ _, ?_⟩
  intro x hx
  obtain ⟨hxexp, hxXt, hxXf, hxXlog, hxXfine, hxC⟩ :
      Real.exp 1 ≤ x ∧ Xt ≤ x ∧ Xf ≤ x ∧ Xlog ≤ x ∧ Xfine ≤ x ∧ 2 * C ≤ x := by
    simpa only [X, max_le_iff] using hx
  have hx1 : 1 ≤ x := (Real.one_le_exp (by norm_num : (0 : ℝ) ≤ 1)).trans hxexp
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hxlog : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hxexp
  let ell : ℝ := (Real.log x) ^ E
  let A0 : ℝ := max 1 ell
  let t : ℝ := x ^ (-10 : ℝ)
  have hell : 0 < ell := Real.rpow_pos_of_pos (zero_lt_one.trans_le hxlog) E
  have hA0 : 1 ≤ A0 := le_max_left _ _
  have hA00 : 0 ≤ A0 := zero_le_one.trans hA0
  have hellA : ell ≤ A0 := le_max_right _ _
  have ht : 0 ≤ t := Real.rpow_nonneg hx0.le (-10)
  have hA03 : A0 ^ 3 ≤ x ^ ε := hlogBound x hxXlog
  have hell3 : ell ^ 3 ≤ x ^ ε := (pow_le_pow_left₀ hell.le hellA 3).trans hA03
  have hsmall : C * x ^ (-ε) ≤ 1 / 3 := hXfine x hxXfine
  have hr1 : 1 ≤ x ^ (ε / 2) :=
    Real.one_le_rpow hx1 (div_nonneg hε.le (by norm_num : (0 : ℝ) ≤ 2))
  intro M N₁ N₂ N₃ Qcenter hM hQ hN₁ hN₂ hN₃
  let N : ℝ := N₁ * N₂ * N₃
  have hN₁1 : 1 ≤ N₁ := by linarith only [hN₁, hr1]
  have hN₂1 : 1 ≤ N₂ := by linarith only [hN₂, hr1]
  have hN₃1 : 1 ≤ N₃ := by linarith only [hN₃, hr1]
  have hN₁0 : 0 < N₁ := zero_lt_one.trans_le hN₁1
  have hN₂0 : 0 < N₂ := zero_lt_one.trans_le hN₂1
  have hN₃0 : 0 < N₃ := zero_lt_one.trans_le hN₃1
  have hN0 : 0 < N := mul_pos (mul_pos hN₁0 hN₂0) hN₃0
  have hM0 : 0 ≤ M := zero_le_one.trans hM
  intro hMNlower hMNupper hNlower hQupper Y hY Qset hQset
  obtain ⟨hqtAll, hscaleError⟩ :=
    typeIII_fineband_scale_bounds omegaExp C E hωupper hC ε x Qcenter
      hε hεsmall hx1 hxC hQ hQupper hA03
  have hqUpper : ∀ q ∈ Qset, (q : ℝ) ≤ 2 * Qcenter := by
    intro q hq
    have hband := (hQset q hq).2.2.2
    nlinarith only [hband, hQ.le, mul_nonneg hQ.le (sub_nonneg.mpr hsmall)]
  have hqt : ∀ q ∈ Qset, (q : ℝ) * t ≤ 1 :=
    fun q hq => hqtAll q (hqUpper q hq)
  intro M₀ M₁ hM₀ hwidth hheight L₁ L₂ L₃ Wα hL₁ hL₂ hL₃ hWα
    α ψ₁ ψ₂ ψ₃ hα hψ₁ hψ₂ hψ₃ hsψ₁ hsψ₂ hsψ₃ hbψ₁ hbψ₂ hbψ₃
  let I : Finset ℤ := Finset.Icc M₀ M₁
  let P₁ : Finset ℤ := Finset.Icc (Int.ceil (-T * N₁)) (Int.floor (T * N₁))
  let P₂ : Finset ℤ := Finset.Icc (Int.ceil (-T * N₂)) (Int.floor (T * N₂))
  let P₃ : Finset ℤ := Finset.Icc (Int.ceil (-T * N₃)) (Int.floor (T * N₃))
  let w : ℤ → ℤ → ℤ → ℤ → ℂ := fun m n₁ n₂ n₃ =>
    α m * ψ₁ ((n₁ : ℝ) / N₁) * ψ₂ ((n₂ : ℝ) / N₂) * ψ₃ ((n₃ : ℝ) / N₃)
  let R : (q : ℕ+) → ZMod (q : ℕ) → ℂ := fun q a =>
    ∑ m ∈ I, ∑ n₁ ∈ P₁, ∑ n₂ ∈ P₂, ∑ n₃ ∈ P₃,
      if ((m * n₁ * n₂ * n₃ : ℤ) : ZMod (q : ℕ)) = a then w m n₁ n₂ n₃ else 0
  let U : ℕ+ → ℂ := fun q =>
    ∑ m ∈ I, ∑ n₁ ∈ P₁, ∑ n₂ ∈ P₂, ∑ n₃ ∈ P₃,
      if IsUnit ((m * n₁ * n₂ * n₃ : ℤ) : ZMod (q : ℕ)) then w m n₁ n₂ n₃ else 0
  let sampleTransform (NN : ℝ) (ψ : ℝ → ℂ) : ℝ → ℂ := fun y =>
    ∑ n ∈ Finset.Icc (Int.ceil (-T * NN)) (Int.floor (T * NN)),
      ψ ((n : ℝ) / NN) *
        Complex.exp (((-2 * Real.pi * (n : ℝ) * y : ℝ) : ℂ) * Complex.I)
  let coeff (NN : ℝ) (ψ : ℝ → ℂ) : ℕ → ℤ → ℂ := fun j h =>
    ((((h : ℝ) / Qcenter) ^ j / (Nat.factorial j : ℝ) / NN : ℝ) : ℂ) *
      iteratedDeriv j (sampleTransform NN ψ) ((h : ℝ) / Qcenter)
  let H (NN : ℝ) : ℝ := x ^ (ε / 2) * Qcenter / NN
  let S (NN : ℝ) : Finset ℤ := Finset.Icc (Int.ceil (-H NN)) (Int.floor (H NN))
  let theta : ℕ → ℕ → ℂ := fun q j =>
    ((Qcenter / (q : ℝ) * ((Qcenter - (q : ℝ)) / (q : ℝ)) ^ j : ℝ) : ℂ)
  let weight (NN : ℝ) (ψ : ℝ → ℂ) (q : ℕ+) : ZMod (q : ℕ) → ℂ :=
    integerIntervalResidueWeight (q : ℕ) (Int.ceil (-T * NN))
      (Int.floor (T * NN) + 1 - Int.ceil (-T * NN)).toNat
      (fun k => ψ (((Int.ceil (-T * NN) : ℝ) + (k : ℝ)) / NN))
  let approx (NN : ℝ) (ψ : ℝ → ℂ) (q : ℕ+) : ZMod (q : ℕ) → ℂ := fun z =>
    ((NN / Qcenter : ℝ) : ℂ) *
      ∑ j ∈ Finset.range (J + 1), theta (q : ℕ) j *
        ∑ h ∈ S NN, coeff NN ψ j h * ZMod.stdAddChar ((h : ZMod (q : ℕ)) * z)
  let Rt : (q : ℕ+) → ZMod (q : ℕ) → ℂ := fun q a =>
    ∑ m ∈ I, α m * ∑ z₁ : ZMod (q : ℕ), ∑ z₂ : ZMod (q : ℕ),
      ∑ z₃ : ZMod (q : ℕ),
        if (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = a then
          approx N₁ ψ₁ q z₁ * approx N₂ ψ₂ q z₂ * approx N₃ ψ₃ q z₃ else 0
  let Bprod : ℝ := L₁ * L₂ * L₃
  have hBprod : 0 ≤ Bprod := mul_nonneg (mul_nonneg hL₁ hL₂) hL₃
  have hphysical (q : ℕ+) (a : ZMod (q : ℕ)) :
      R q a = ∑ m ∈ I, α m * ∑ z₁ : ZMod (q : ℕ),
        ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
          if (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = a then
            weight N₁ ψ₁ q z₁ * weight N₂ ψ₂ q z₂ * weight N₃ ψ₃ q z₃ else 0 := by
    have hcastSample (NN : ℝ) (ψ : ℝ → ℂ) :
        (fun k : ℕ => ψ (((Int.ceil (-T * NN) + k : ℤ) : ℝ) / NN)) =
          (fun k : ℕ => ψ (((Int.ceil (-T * NN) : ℝ) + (k : ℝ)) / NN)) := by
      funext k
      rw [Int.cast_add, Int.cast_natCast]
    have hperiod :
        R q a = ∑ m ∈ I, α m * ∑ z₁ : ZMod (q : ℕ),
          ∑ z₂ : ZMod (q : ℕ), ∑ z₃ : ZMod (q : ℕ),
            if (m : ZMod (q : ℕ)) * z₁ * z₂ * z₃ = a then
              integerIntervalResidueWeight (q : ℕ) (Int.ceil (-T * N₁))
                  (Int.floor (T * N₁) + 1 - Int.ceil (-T * N₁)).toNat
                  (fun k => ψ₁ (((Int.ceil (-T * N₁) + k : ℤ) : ℝ) / N₁)) z₁ *
                integerIntervalResidueWeight (q : ℕ) (Int.ceil (-T * N₂))
                  (Int.floor (T * N₂) + 1 - Int.ceil (-T * N₂)).toNat
                  (fun k => ψ₂ (((Int.ceil (-T * N₂) + k : ℤ) : ℝ) / N₂)) z₂ *
                integerIntervalResidueWeight (q : ℕ) (Int.ceil (-T * N₃))
                  (Int.floor (T * N₃) + 1 - Int.ceil (-T * N₃)).toNat
                  (fun k => ψ₃ (((Int.ceil (-T * N₃) + k : ℤ) : ℝ) / N₃)) z₃
            else 0 :=
      typeIII_physical_periodization q I
        (Int.ceil (-T * N₁)) (Int.floor (T * N₁))
        (Int.ceil (-T * N₂)) (Int.floor (T * N₂))
        (Int.ceil (-T * N₃)) (Int.floor (T * N₃)) α
        (fun n => ψ₁ ((n : ℝ) / N₁)) (fun n => ψ₂ ((n : ℝ) / N₂))
        (fun n => ψ₃ ((n : ℝ) / N₃)) a
    rw [hcastSample N₁ ψ₁, hcastSample N₂ ψ₂, hcastSample N₃ ψ₃] at hperiod
    exact hperiod
  obtain ⟨hc₁, hrest₁⟩ := hftBound x hxXf L₁ hL₁ N₁ Qcenter hQ hN₁
    ψ₁ hψ₁ hsψ₁ hbψ₁
  obtain ⟨hc₂, hrest₂⟩ := hftBound x hxXf L₂ hL₂ N₂ Qcenter hQ hN₂
    ψ₂ hψ₂ hsψ₂ hbψ₂
  obtain ⟨hc₃, hrest₃⟩ := hftBound x hxXf L₃ hL₃ N₃ Qcenter hQ hN₃
    ψ₃ hψ₃ hsψ₃ hbψ₃
  have hcoef₁ : ∀ j : ℕ, j ≤ J → ∀ h ∈ S N₁,
      ‖coeff N₁ ψ₁ j h‖ ≤ Cf * L₁ * ell := hc₁
  have hcoef₂ : ∀ j : ℕ, j ≤ J → ∀ h ∈ S N₂,
      ‖coeff N₂ ψ₂ j h‖ ≤ Cf * L₂ * ell := hc₂
  have hcoef₃ : ∀ j : ℕ, j ≤ J → ∀ h ∈ S N₃,
      ‖coeff N₃ ψ₃ j h‖ ≤ Cf * L₃ * ell := hc₃
  have htheta : ∀ q ∈ Qset, ∀ j : ℕ, ‖theta (q : ℕ) j‖ ≤ 2 := by
    intro q hq j
    have hh := (hrest₁ q (hQset q hq).2.2.1 (hQset q hq).2.2.2).2.1 j
    simpa only [theta, Complex.norm_real, Real.norm_eq_abs] using hh
  have herr₁ : ∀ q ∈ Qset, ∀ z : ZMod (q : ℕ),
      ‖weight N₁ ψ₁ q z - approx N₁ ψ₁ q z‖ ≤ e * (L₁ * N₁) * t := by
    intro q hq z
    have hh := (hrest₁ q (hQset q hq).2.2.1 (hQset q hq).2.2.2).2.2.2.2.2.2 z
    convert hh using 1; try rfl
    dsimp only [e, t]
    ring
  have herr₂ : ∀ q ∈ Qset, ∀ z : ZMod (q : ℕ),
      ‖weight N₂ ψ₂ q z - approx N₂ ψ₂ q z‖ ≤ e * (L₂ * N₂) * t := by
    intro q hq z
    have hh := (hrest₂ q (hQset q hq).2.2.1 (hQset q hq).2.2.2).2.2.2.2.2.2 z
    convert hh using 1; try rfl
    dsimp only [e, t]
    ring
  have herr₃ : ∀ q ∈ Qset, ∀ z : ZMod (q : ℕ),
      ‖weight N₃ ψ₃ q z - approx N₃ ψ₃ q z‖ ≤ e * (L₃ * N₃) * t := by
    intro q hq z
    have hh := (hrest₃ q (hQset q hq).2.2.1 (hQset q hq).2.2.2).2.2.2.2.2.2 z
    convert hh using 1; try rfl
    dsimp only [e, t]
    ring
  have hW₁ : ∀ q ∈ Qset, (∑ z : ZMod (q : ℕ), ‖weight N₁ ψ₁ q z‖) ≤
      D * (L₁ * N₁) * A0 := by
    intro q _
    convert typeIII_sampled_residue_l1 q T N₁ L₁ A0 hT hN₁1 hL₁ hA00 ψ₁
      (fun u => by simpa only [iteratedDeriv_zero] using
        (hbψ₁ 0 (Nat.zero_le _) u).trans (mul_le_mul_of_nonneg_left hellA hL₁)) using 1;
      dsimp only [D]; ring
  have hW₂ : ∀ q ∈ Qset, (∑ z : ZMod (q : ℕ), ‖weight N₂ ψ₂ q z‖) ≤
      D * (L₂ * N₂) * A0 := by
    intro q _
    convert typeIII_sampled_residue_l1 q T N₂ L₂ A0 hT hN₂1 hL₂ hA00 ψ₂
      (fun u => by simpa only [iteratedDeriv_zero] using
        (hbψ₂ 0 (Nat.zero_le _) u).trans (mul_le_mul_of_nonneg_left hellA hL₂)) using 1;
      dsimp only [D]; ring
  have hW₃ : ∀ q ∈ Qset, (∑ z : ZMod (q : ℕ), ‖weight N₃ ψ₃ q z‖) ≤
      D * (L₃ * N₃) * A0 := by
    intro q _
    convert typeIII_sampled_residue_l1 q T N₃ L₃ A0 hT hN₃1 hL₃ hA00 ψ₃
      (fun u => by simpa only [iteratedDeriv_zero] using
        (hbψ₃ 0 (Nat.zero_le _) u).trans (mul_le_mul_of_nonneg_left hellA hL₃)) using 1;
      dsimp only [D]; ring
  have herror (η : ℕ → ℂ) (hη : ∀ q ∈ Qset, ‖η (q : ℕ)‖ ≤ 1)
      (a : ∀ q : ℕ+, (ZMod (q : ℕ))ˣ) :
      ‖(∑ q ∈ Qset, η (q : ℕ) * R q (a q : ZMod (q : ℕ))) -
        (∑ q ∈ Qset, η (q : ℕ) * Rt q (a q : ZMod (q : ℕ)))‖ ≤
        Ce * Bprod * Wα * (M * N) * x ^ (-2 * ε) := by
    have hraw := typeIII_weighted_physical_error Qset Qcenter hQ hqUpper I M Wα
      hM0 hWα (hmarkCard M hM M₀ M₁ hwidth) α hα
      D e A0 t (L₁ * N₁) (L₂ * N₂) (L₃ * N₃)
      hD he hA0 ht (mul_nonneg hL₁ hN₁0.le)
      (mul_nonneg hL₂ hN₂0.le) (mul_nonneg hL₃ hN₃0.le) hqt
      (weight N₁ ψ₁) (weight N₂ ψ₂) (weight N₃ ψ₃)
      (approx N₁ ψ₁) (approx N₂ ψ₂) (approx N₃ ψ₃)
      hW₁ hW₂ hW₃ herr₁ herr₂ herr₃ η hη
      (fun q => (a q : ZMod (q : ℕ)))
    calc
      _ ≤ 8 * Dtel * Wα * M * ((L₁ * N₁) * (L₂ * N₂) * (L₃ * N₃)) *
          Qcenter ^ 2 * A0 ^ 2 * t := by
        simpa only [← hphysical] using hraw
      _ = (8 * Dtel * Bprod * Wα * (M * N)) *
          (Qcenter ^ 2 * A0 ^ 2 * t) := by dsimp only [Bprod, N]; ring
      _ ≤ (8 * Dtel * Bprod * Wα * (M * N)) * (C ^ 2 * x ^ (-2 * ε)) :=
        mul_le_mul_of_nonneg_left hscaleError
          (mul_nonneg
            (mul_nonneg
              (mul_nonneg (mul_nonneg (by norm_num : (0 : ℝ) ≤ 8) hDtel) hBprod)
              hWα)
            (mul_nonneg hM0 hN0.le))
      _ = _ := by dsimp only [Ce]; ring
  have htripleSumNorm (f : ℕ → ℕ → ℕ → ℂ) (B : ℝ)
      (hb : ∀ j₁ ∈ Finset.range (J + 1), ∀ j₂ ∈ Finset.range (J + 1),
        ∀ j₃ ∈ Finset.range (J + 1), ‖f j₁ j₂ j₃‖ ≤ B) :
      ‖∑ j₁ ∈ Finset.range (J + 1), ∑ j₂ ∈ Finset.range (J + 1),
        ∑ j₃ ∈ Finset.range (J + 1), f j₁ j₂ j₃‖ ≤
        ((J + 1 : ℕ) : ℝ) ^ 3 * B := by
    calc
      _ ≤ ∑ j₁ ∈ Finset.range (J + 1), ∑ j₂ ∈ Finset.range (J + 1),
          ∑ j₃ ∈ Finset.range (J + 1), B :=
        norm_sum_le_of_le _ fun j₁ hj₁ =>
          norm_sum_le_of_le _ fun j₂ hj₂ =>
            norm_sum_le_of_le _ fun j₃ hj₃ => hb j₁ hj₁ j₂ hj₂ j₃ hj₃
      _ = _ := by
        simp only [Finset.sum_const, Finset.card_range, nsmul_eq_mul]
        ring
  have hlogSaving : ell ^ 3 * x ^ (-3 * ε) ≤ x ^ (-2 * ε) := by
    calc
      _ ≤ x ^ ε * x ^ (-3 * ε) :=
        mul_le_mul_of_nonneg_right hell3 (Real.rpow_nonneg hx0.le (-3 * ε))
      _ = _ := by rw [← Real.rpow_add hx0]; congr 1; ring
  let kappa : ℂ := ((N₁ / Qcenter : ℝ) : ℂ) * ((N₂ / Qcenter : ℝ) : ℂ) *
    ((N₃ / Qcenter : ℝ) : ℂ)
  have hkappa : kappa = ((N / Qcenter ^ 3 : ℝ) : ℂ) := by
    dsimp only [kappa, N]
    push_cast
    have hQcomplex : (Qcenter : ℂ) ≠ 0 := by exact_mod_cast hQ.ne'
    field_simp
  let Sbox : Finset (ℤ × ℤ × ℤ) := (S N₁) ×ˢ ((S N₂) ×ˢ (S N₃))
  let Szero : Finset (ℤ × ℤ × ℤ) := Sbox.filter (fun h => h.1 * h.2.1 * h.2.2 = 0)
  let Snz : Finset (ℤ × ℤ × ℤ) := Sbox.filter (fun h => h.1 * h.2.1 * h.2.2 ≠ 0)
  let cTriple (j₁ j₂ j₃ : ℕ) (h : ℤ × ℤ × ℤ) : ℂ :=
    coeff N₁ ψ₁ j₁ h.1 * coeff N₂ ψ₂ j₂ h.2.1 * coeff N₃ ψ₃ j₃ h.2.2
  have hcoeffTriple (j₁ j₂ j₃ : ℕ)
      (hj₁ : j₁ ∈ Finset.range (J + 1)) (hj₂ : j₂ ∈ Finset.range (J + 1))
      (hj₃ : j₃ ∈ Finset.range (J + 1)) :
      ∀ h ∈ Snz, ‖cTriple j₁ j₂ j₃ h‖ ≤ Cf ^ 3 * Bprod * ell ^ 3 := by
    intro h hh
    have hbox := (Finset.mem_filter.mp hh).1
    obtain ⟨hh₁, hh₂₃⟩ := Finset.mem_product.mp hbox
    obtain ⟨hh₂, hh₃⟩ := Finset.mem_product.mp hh₂₃
    have hj₁' : j₁ ≤ J := by simpa only [Finset.mem_range, Nat.lt_succ_iff] using hj₁
    have hj₂' : j₂ ≤ J := by simpa only [Finset.mem_range, Nat.lt_succ_iff] using hj₂
    have hj₃' : j₃ ≤ J := by simpa only [Finset.mem_range, Nat.lt_succ_iff] using hj₃
    calc
      _ ≤ (Cf * L₁ * ell) * (Cf * L₂ * ell) * (Cf * L₃ * ell) :=
        norm_mul_le_of_le
          (norm_mul_le_of_le (hcoef₁ j₁ hj₁' h.1 hh₁) (hcoef₂ j₂ hj₂' h.2.1 hh₂))
          (hcoef₃ j₃ hj₃' h.2.2 hh₃)
      _ = _ := by dsimp only [Bprod]; ring
  have hcenter :
      ∀ η : ℕ → ℂ, (∀ q ∈ Qset, ‖η (q : ℕ)‖ ≤ 1) →
        ∃ Z : ℂ,
        ∀ (a₀ : ℤ) (a : ∀ q : ℕ+, (ZMod (q : ℕ))ˣ),
          (∀ q ∈ Qset, (a q : ZMod (q : ℕ)) = (a₀ : ZMod (q : ℕ))) →
          ‖(∑ q ∈ Qset, η (q : ℕ) * R q (a q : ZMod (q : ℕ))) - Z‖ ≤
            K * Bprod * Wα * (M * N) * x ^ (-2 * ε) := by
    intro η hη
    let etaTriple (j₁ j₂ j₃ : ℕ) (q : ℕ) : ℂ :=
      η q * theta q j₁ * theta q j₂ * theta q j₃
    let V (j₁ j₂ j₃ : ℕ) (a : ∀ q : ℕ+, (ZMod (q : ℕ))ˣ) : ℂ :=
      kappa * ∑ q ∈ Qset, (q : ℂ) * etaTriple j₁ j₂ j₃ (q : ℕ) *
        ∑ m ∈ I, if hm : IsUnit (m : ZMod (q : ℕ)) then
          α m * ∑ h ∈ Snz, cTriple j₁ j₂ j₃ h *
            typeIIICompleteFiberSum (q : ℕ)
              (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
              (h.2.2 : ZMod (q : ℕ)) (a q * hm.unit⁻¹)
        else 0
    let Z : ℂ := kappa *
      ∑ j₁ ∈ Finset.range (J + 1), ∑ j₂ ∈ Finset.range (J + 1),
        ∑ j₃ ∈ Finset.range (J + 1),
          ∑ q ∈ Qset, (q : ℂ) * etaTriple j₁ j₂ j₃ (q : ℕ) *
            ∑ m ∈ I, if IsUnit (m : ZMod (q : ℕ)) then
              α m * ∑ h ∈ Szero, cTriple j₁ j₂ j₃ h *
                typeIIICompleteFiberSum (q : ℕ)
                  (h.1 : ZMod (q : ℕ)) (h.2.1 : ZMod (q : ℕ))
                  (h.2.2 : ZMod (q : ℕ)) 1
            else 0
    refine ⟨Z, ?_⟩
    intro a₀ a ha
    have hdecomposition :
        (∑ q ∈ Qset, η (q : ℕ) * Rt q (a q : ZMod (q : ℕ))) - Z =
          ∑ j₁ ∈ Finset.range (J + 1), ∑ j₂ ∈ Finset.range (J + 1),
            ∑ j₃ ∈ Finset.range (J + 1), V j₁ j₂ j₃ a :=
      typeIII_global_taylor_zero_nonzero_decomposition Qset I
        (Finset.range (J + 1)) (S N₁) (S N₂) (S N₃) α η theta
        (coeff N₁ ψ₁) (coeff N₂ ψ₂) (coeff N₃ ψ₃)
        ((N₁ / Qcenter : ℝ) : ℂ) ((N₂ / Qcenter : ℝ) : ℂ)
        ((N₃ / Qcenter : ℝ) : ℂ) a
    have hetaTriple (j₁ j₂ j₃ : ℕ) :
        ∀ q ∈ Qset, ‖etaTriple j₁ j₂ j₃ (q : ℕ)‖ ≤ 8 := by
      intro q hq
      calc
        _ ≤ 1 * 2 * 2 * (2 : ℝ) :=
          norm_mul_le_of_le
            (norm_mul_le_of_le (norm_mul_le_of_le (hη q hq) (htheta q hq j₁))
              (htheta q hq j₂))
            (htheta q hq j₃)
        _ = 8 := by norm_num
    have hVbound (j₁ j₂ j₃ : ℕ)
        (hj₁ : j₁ ∈ Finset.range (J + 1)) (hj₂ : j₂ ∈ Finset.range (J + 1))
        (hj₃ : j₃ ∈ Finset.range (J + 1)) :
        ‖V j₁ j₂ j₃ a‖ ≤
          Kt * (Cf ^ 3 * Bprod * ell ^ 3) * 8 * Wα * Sstar *
            (M * N) * x ^ (-3 * ε) := by
      dsimp only [V]
      rw [hkappa]
      exact htermBound x hxXt M N₁ N₂ N₃ Qcenter
        hM hN₁1 hN₂1 hN₃1 hQ hMNlower hMNupper hNlower hQupper
        Y hY Qset hQset a₀ a ha M₀ M₁ hM₀ hwidth hheight
        (etaTriple j₁ j₂ j₃) α (cTriple j₁ j₂ j₃)
        8 Wα (Cf ^ 3 * Bprod * ell ^ 3)
        (by norm_num) hWα
        (mul_nonneg (mul_nonneg (pow_nonneg hCf.le 3) hBprod) (pow_nonneg hell.le 3))
        (hetaTriple j₁ j₂ j₃) hα (hcoeffTriple j₁ j₂ j₃ hj₁ hj₂ hj₃)
        2 Lstar φ (by norm_num) hLstar0 hφcont hφnonneg hφone hφsupport hφbounds
    have hVsum :
        ‖∑ j₁ ∈ Finset.range (J + 1), ∑ j₂ ∈ Finset.range (J + 1),
          ∑ j₃ ∈ Finset.range (J + 1), V j₁ j₂ j₃ a‖ ≤
          Ct * Bprod * Wα * (M * N) * x ^ (-2 * ε) := by
      calc
        _ ≤ ((J + 1 : ℕ) : ℝ) ^ 3 *
            (Kt * (Cf ^ 3 * Bprod * ell ^ 3) * 8 * Wα * Sstar *
              (M * N) * x ^ (-3 * ε)) :=
          htripleSumNorm (fun j₁ j₂ j₃ => V j₁ j₂ j₃ a) _
            (fun j₁ hj₁ j₂ hj₂ j₃ hj₃ => hVbound j₁ j₂ j₃ hj₁ hj₂ hj₃)
        _ = (Ct * Bprod * Wα * (M * N)) * (ell ^ 3 * x ^ (-3 * ε)) := by
          dsimp only [Ct]
          ring
        _ ≤ (Ct * Bprod * Wα * (M * N)) * x ^ (-2 * ε) :=
          mul_le_mul_of_nonneg_left hlogSaving
            (mul_nonneg (mul_nonneg (mul_nonneg hCt hBprod) hWα)
              (mul_nonneg hM0 hN0.le))
        _ = _ := by ring
    calc
      _ ≤ ‖(∑ q ∈ Qset, η (q : ℕ) * R q (a q : ZMod (q : ℕ))) -
            (∑ q ∈ Qset, η (q : ℕ) * Rt q (a q : ZMod (q : ℕ)))‖ +
          ‖(∑ q ∈ Qset, η (q : ℕ) * Rt q (a q : ZMod (q : ℕ))) - Z‖ :=
        norm_sub_le_norm_sub_add_norm_sub _ _ _
      _ ≤ Ce * Bprod * Wα * (M * N) * x ^ (-2 * ε) +
          Ct * Bprod * Wα * (M * N) * x ^ (-2 * ε) := by
        apply add_le_add (herror η hη a)
        rw [hdecomposition]
        exact hVsum
      _ = (Ce + Ct) * (Bprod * Wα * (M * N) * x ^ (-2 * ε)) := by ring
      _ ≤ K * (Bprod * Wα * (M * N) * x ^ (-2 * ε)) :=
        mul_le_mul_of_nonneg_right (by dsimp only [K]; linarith only [])
          (mul_nonneg (mul_nonneg (mul_nonneg hBprod hWα) (mul_nonneg hM0 hN0.le))
            (Real.rpow_nonneg hx0.le (-2 * ε)))
      _ = _ := by ring
  refine ⟨hcenter, ?_⟩
  intro a₀ a ha
  have hnorm :
      (∑ q ∈ Qset,
        ‖R q (a q : ZMod (q : ℕ)) - U q / ((q : ℕ).totient : ℂ)‖) ≤
          2 * (K * Bprod * Wα * (M * N) * x ^ (-2 * ε)) :=
    typeIII_physical_coherent_center_to_norm Qset I P₁ P₂ P₃ w
      (K * Bprod * Wα * (M * N) * x ^ (-2 * ε)) hcenter a₀ a ha
  calc
    _ ≤ 2 * (K * Bprod * Wα * (M * N) * x ^ (-2 * ε)) := hnorm
    _ = _ := by dsimp only [Bprod]; ring

open Classical in
theorem typeIII_positive_smooth_convolution_global_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (omegaExp δ σ C E Eα : ℝ) (D : ℕ)
    (hω : 0 < omegaExp) (hωupper : omegaExp < 1 / 12)
    (hδ : 0 < δ) (hC : 1 ≤ C)
    (hσ : 1 / 18 + 28 / 9 * omegaExp + 2 / 9 * δ < σ) :
    let μ : ℝ := 3 * σ / 4 - 7 * omegaExp / 3 - δ / 6 - 1 / 24
    let γ : ℝ := 1 / 2 + δ - 6 * omegaExp
    let εcap : ℝ := min (1 / 100) (min (μ / 8) (γ / 12))
    0 < εcap ∧
      ∀ ε : ℝ, 0 < ε → ε ≤ εcap →
      let κ : ℝ := ε / 4
      let J : ℕ := Nat.ceil (22 / ε)
      ∀ A : ℝ, 0 < A →
      ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ M N₁ N₂ N₃ : ℝ, 1 ≤ M → 1 ≤ N₁ → 1 ≤ N₂ → 1 ≤ N₃ →
        let N : ℝ := N₁ * N₂ * N₃
        x / C ≤ M * N → M * N ≤ C * x →
        x ^ (1 / 2 + σ - κ) / C ≤ N₁ * N₂ →
        x ^ (1 / 2 + σ - κ) / C ≤ N₁ * N₃ →
        x ^ (1 / 2 + σ - κ) / C ≤ N₂ * N₃ →
        N₁ ≤ C * x ^ (1 / 2 - σ + κ) →
        N₂ ≤ C * x ^ (1 / 2 - σ + κ) →
        N₃ ≤ C * x ^ (1 / 2 - σ + κ) →
      ∀ Y : Set.Ici (1 : ℝ), (Y : ℝ) = x ^ δ →
      ∀ Qset : Finset ℕ+,
        (∀ q ∈ Qset,
          Squarefree (q : ℕ) ∧
          Nonempty (DenseDivisibilityWitness Y 1 (q : ℕ)) ∧
          (q : ℝ) ≤ C * x ^ (1 / 2 + 2 * omegaExp + κ)) →
      ∀ Lα L₁ L₂ L₃ : ℝ, 0 ≤ Lα → 0 ≤ L₁ → 0 ≤ L₂ → 0 ≤ L₃ →
      ∀ α : ℕ →₀ ℂ,
        (∀ n ∈ α.support, M / C ≤ (n : ℝ) ∧ (n : ℝ) ≤ C * M) →
        (∀ n ∈ α.support,
          ‖α n‖ ≤ Lα * ((Nat.divisors n).card : ℝ) ^ D * (Real.log x) ^ Eα) →
      ∀ ψ₁ ψ₂ ψ₃ : ℝ → ℂ,
        ContDiff ℝ ∞ ψ₁ → ContDiff ℝ ∞ ψ₂ → ContDiff ℝ ∞ ψ₃ →
        Function.support ψ₁ ⊆ Set.Icc (1 / C) C →
        Function.support ψ₂ ⊆ Set.Icc (1 / C) C →
        Function.support ψ₃ ⊆ Set.Icc (1 / C) C →
        (∀ r : ℕ, r ≤ J + 2 → ∀ t : ℝ,
          ‖iteratedDeriv r ψ₁ t‖ ≤ L₁ * (Real.log x) ^ E) →
        (∀ r : ℕ, r ≤ J + 2 → ∀ t : ℝ,
          ‖iteratedDeriv r ψ₂ t‖ ≤ L₂ * (Real.log x) ^ E) →
        (∀ r : ℕ, r ≤ J + 2 → ∀ t : ℝ,
          ‖iteratedDeriv r ψ₃ t‖ ≤ L₃ * (Real.log x) ^ E) →
        let β₁ : ℕ →₀ ℂ :=
          positiveCompactProfileSequence ψ₁ C N₁ 0
        let β₂ : ℕ →₀ ℂ :=
          positiveCompactProfileSequence ψ₂ C N₂ 0
        let β₃ : ℕ →₀ ℂ :=
          positiveCompactProfileSequence ψ₃ C N₃ 0
        let f : ℕ →₀ ℂ := finiteConvolution α
          (finiteConvolution β₁
            (finiteConvolution β₂ β₃))
        ∀ a₀ : ℤ,
          (∀ q ∈ Qset, IsUnit (a₀ : ZMod (q : ℕ))) →
          ∑ q ∈ Qset,
            ‖(∑ n ∈ f.support,
                if (n : ZMod (q : ℕ)) = (a₀ : ZMod (q : ℕ)) then f n else 0) -
              ((q : ℕ).totient : ℂ)⁻¹ *
                (∑ n ∈ f.support, if Nat.Coprime n (q : ℕ) then f n else 0)‖ ≤
            K * (Lα * L₁ * L₂ * L₃) * x / (Real.log x) ^ A := by
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hCtwo : 1 ≤ C ^ 2 := one_le_pow₀ hC
  have hphys := typeIII_sampled_convolution_fineBand_discrepancy_of_deligne
    hDeligne omegaExp δ σ (C ^ 2) C E hω hωupper hδ hCtwo hCpos.le hσ
  dsimp only at hphys ⊢
  refine ⟨hphys.1, ?_⟩
  intro ε hε hεcap A hA
  have hεsmall : ε ≤ 1 / 100 := hεcap.trans (min_le_left _ _)
  have hσsmall : 1 / 18 < σ := by linarith only [hσ, hω, hδ]
  have hscaleExp : 0 < 2 * σ - ε := by linarith only [hσsmall, hεsmall]
  let κ : ℝ := ε / 4
  let aExp : ℝ := 1 / 2 + 2 * omegaExp + κ
  have haExp : 0 < aExp := by dsimp [aExp, κ]; positivity
  obtain ⟨Kp, Xp, hKp, _, hp⟩ := hphys.2 ε hε hεcap
  clear hphys
  obtain ⟨Cd, hCd, hdivisor⟩ :=
    exists_divisorPower_bound D (by positivity : 0 < ε / 8)
  let Kα : ℝ := Cd * C ^ (ε / 4)
  have hKα : 0 < Kα := mul_pos hCd (Real.rpow_pos_of_pos hCpos _)
  let Acov : ℝ := 1 + 2 * Real.log C + 2 * aExp
  have hlogC : 0 ≤ Real.log C := Real.log_nonneg hC
  have hAcov : 0 < Acov := by dsimp [Acov]; positivity
  have hexp1 : 1 ≤ Real.exp 1 := Real.one_le_exp (by norm_num)
  have hlogPower (b e : ℝ) (he : 0 < e) :
      ∀ᶠ x : ℝ in Filter.atTop, (Real.log x) ^ b ≤ x ^ e := by
    clear * - hexp1 he
    filter_upwards [Filter.eventually_ge_atTop (Real.exp 1),
      (isLittleO_log_rpow_rpow_atTop b he).bound (by norm_num : (0 : ℝ) < 1)]
      with x hx hb
    have hx1 : 1 ≤ x := hexp1.trans hx
    simpa only [Real.norm_of_nonneg (Real.rpow_nonneg (Real.log_nonneg hx1) b),
      Real.norm_of_nonneg (Real.rpow_nonneg (zero_le_one.trans hx1) e), one_mul] using hb
  have hevent : ∀ᶠ x : ℝ in Filter.atTop,
      Real.exp 1 ≤ x ∧ Xp ≤ x ∧
      8 * C ^ 2 ≤ x ^ (2 * σ - ε) ∧
      C ^ 2 * x ^ (-ε) ≤ 1 / 3 ∧
      (Real.log x) ^ Eα ≤ x ^ (ε / 8) ∧
      Real.log x ≤ x ^ (ε / 4) ∧
      (Real.log x) ^ A ≤ x ^ (ε / 2) := by
    filter_upwards [Filter.eventually_ge_atTop (Real.exp 1),
      Filter.eventually_ge_atTop Xp,
      (tendsto_rpow_atTop hscaleExp).eventually_ge_atTop (8 * C ^ 2),
      ((tendsto_rpow_neg_atTop hε).const_mul (C ^ 2)).eventually_le_const
        (by norm_num : C ^ 2 * 0 < (1 : ℝ) / 3),
      hlogPower Eα (ε / 8) (by positivity),
      hlogPower 1 (ε / 4) (by positivity),
      hlogPower A (ε / 2) (by positivity)] with x hx hp hxscale hρ hαlog hlog hlogA
    exact ⟨hx, hp, hxscale, hρ, hαlog, by simpa only [Real.rpow_one] using hlog, hlogA⟩
  obtain ⟨X, hX⟩ := Filter.eventually_atTop.mp hevent
  let K : ℝ := 1 + 2 * Kp * Acov * Kα * C ^ 2
  refine ⟨K, max X (Real.exp 1), by dsimp [K]; positivity, le_max_right _ _, ?_⟩
  intro x hx M N₁ N₂ N₃ hM hN₁ hN₂ hN₃
    hMNlo hMNhi h₁₂ h₁₃ h₂₃ hN₁hi hN₂hi hN₃hi
    Y hY Qset hQset Lα L₁ L₂ L₃ hLα hL₁ hL₂ hL₃ α hαsupport hαbound
    ψ₁ ψ₂ ψ₃ hψ₁ hψ₂ hψ₃ hs₁ hs₂ hs₃ hd₁ hd₂ hd₃ a₀ ha₀
  obtain ⟨hxexp, hxXp, hxscale, hρupper, hαlog, hlogsmall, hlogA⟩ :=
    hX x ((le_max_left _ _).trans hx)
  have hx1 : 1 ≤ x := hexp1.trans hxexp
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hxlog : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hxexp
  have hlog0 : 0 < Real.log x := zero_lt_one.trans_le hxlog
  have hM0 : 0 < M := zero_lt_one.trans_le hM
  have hN₁0 : 0 < N₁ := zero_lt_one.trans_le hN₁
  have hN₂0 : 0 < N₂ := zero_lt_one.trans_le hN₂
  have hN₃0 : 0 < N₃ := zero_lt_one.trans_le hN₃
  let N : ℝ := N₁ * N₂ * N₃
  have hN : 1 ≤ N :=
    one_le_mul_of_one_le_of_one_le
      (one_le_mul_of_one_le_of_one_le hN₁ hN₂) hN₃
  have hN0 : 0 < N := zero_lt_one.trans_le hN
  have hMhi : M ≤ C * x :=
    (le_mul_of_one_le_right hM0.le hN).trans hMNhi
  have hscale (U V : ℝ) (hU : 0 ≤ U)
      (huv : x ^ (1 / 2 + σ - κ) / C ≤ U * V)
      (hv : V ≤ C * x ^ (1 / 2 - σ + κ)) :
      8 * x ^ (ε / 2) ≤ U := by
    clear * - hU huv hv hCpos hx0 hxscale κ
    have hpow : x ^ (1 / 2 + σ - κ) =
        x ^ (1 / 2 - σ + κ) * x ^ (2 * σ - 2 * κ) := by
      rw [← Real.rpow_add hx0]
      congr 1
      ring
    have hl : x ^ (1 / 2 - σ + κ) * x ^ (2 * σ - 2 * κ) ≤
        x ^ (1 / 2 - σ + κ) * (C ^ 2 * U) := by
      calc
        _ = x ^ (1 / 2 + σ - κ) := hpow.symm
        _ ≤ U * V * C := (div_le_iff₀ hCpos).mp huv
        _ ≤ U * (C * x ^ (1 / 2 - σ + κ)) * C := by gcongr
        _ = _ := by ring
    have hslot : x ^ (2 * σ - 2 * κ) ≤ C ^ 2 * U :=
      (mul_le_mul_iff_right₀ (Real.rpow_pos_of_pos hx0 _)).mp hl
    have hlarge : (8 * x ^ (ε / 2)) * C ^ 2 ≤ x ^ (2 * σ - 2 * κ) := by
      calc
        _ = (8 * C ^ 2) * x ^ (ε / 2) := by ring
        _ ≤ x ^ (2 * σ - ε) * x ^ (ε / 2) := by gcongr
        _ = _ := by rw [← Real.rpow_add hx0]; congr 1; dsimp [κ]; ring
    exact (mul_le_mul_iff_left₀ (sq_pos_of_pos hCpos)).mp (by
      simpa only [mul_comm (C ^ 2) U] using hlarge.trans hslot)
  have hlarge₁ : 8 * x ^ (ε / 2) ≤ N₁ :=
    hscale N₁ N₂ hN₁0.le h₁₂ hN₂hi
  have hlarge₂ : 8 * x ^ (ε / 2) ≤ N₂ :=
    hscale N₂ N₁ hN₂0.le (by simpa only [mul_comm] using h₁₂) hN₁hi
  have hlarge₃ : 8 * x ^ (ε / 2) ≤ N₃ :=
    hscale N₃ N₁ hN₃0.le (by simpa only [mul_comm] using h₁₃) hN₁hi
  have hNlower : x ^ (3 / 4 + 3 * σ / 2 - ε) / C ^ 2 ≤ N := by
    clear * - κ h₁₂ h₁₃ h₂₃ hN₁0 hN₂0 hN₃0 hx0 hx1 hC hCpos hε hN0
    let u : ℝ := x ^ (1 / 2 + σ - κ) / C
    have hu : 0 ≤ u := by dsimp [u]; positivity
    have hpairs : u ^ 3 ≤ N ^ 2 := by
      have ht := mul_le_mul
        (mul_le_mul h₁₂ h₁₃ hu (by positivity)) h₂₃ hu (by positivity)
      calc
        u ^ 3 = u * u * u := by ring
        _ ≤ (N₁ * N₂) * (N₁ * N₃) * (N₂ * N₃) := ht
        _ = N ^ 2 := by dsimp only [N]; ring
    apply (sq_le_sq₀ (by positivity) hN0.le).mp
    calc
      (x ^ (3 / 4 + 3 * σ / 2 - ε) / C ^ 2) ^ 2 =
          x ^ ((3 / 4 + 3 * σ / 2 - ε) * (2 : ℝ)) / C ^ 4 := by
        rw [div_pow, ← Real.rpow_mul_natCast hx0.le]
        norm_num
        ring
      _ ≤ x ^ ((1 / 2 + σ - κ) * (3 : ℝ)) / C ^ 3 := by
        apply div_le_div₀ (Real.rpow_nonneg hx0.le _)
          (Real.rpow_le_rpow_of_exponent_le hx1 ?_) (by positivity) ?_
        · dsimp [κ]
          linarith
        · exact pow_le_pow_right₀ hC (by norm_num)
      _ = u ^ 3 := by
        dsimp only [u]
        rw [div_pow, ← Real.rpow_mul_natCast hx0.le]
        norm_num
      _ ≤ N ^ 2 := hpairs
  have hMphys : 1 ≤ C * M := one_le_mul_of_one_le_of_one_le hC hM
  have hMNphyslo : x / C ^ 2 ≤ (C * M) * N := by
    calc
      _ ≤ x / C := div_le_div_of_nonneg_left hx0.le hCpos (le_self_pow₀ hC two_ne_zero)
      _ ≤ M * N := hMNlo
      _ ≤ (C * M) * N := by gcongr; exact le_mul_of_one_le_left hM0.le hC
  have hMNphyshi : (C * M) * N ≤ C ^ 2 * x := by
    calc
      _ = C * (M * N) := by ring
      _ ≤ C * (C * x) := by gcongr
      _ = _ := by ring
  let M₀ : ℤ := Int.ceil (M / C)
  let M₁ : ℤ := Int.floor (C * M)
  let I : Finset ℤ := Finset.Icc M₀ M₁
  have hM₀ : 0 < M₀ := Int.ceil_pos.mpr (div_pos hM0 hCpos)
  have hwidth : (M₁ : ℝ) - (M₀ : ℝ) ≤ C * M :=
    (sub_le_self (M₁ : ℝ) (show 0 ≤ (M₀ : ℝ) by exact_mod_cast hM₀.le)).trans
      (Int.floor_le _)
  have hmark (m : ℤ) (hm : m ∈ I) :
      0 < m ∧ (m : ℝ) ≤ C * M := by
    have hi : (m : ℝ) ∈ Set.Icc (M / C) (C * M) :=
      Int.cast_mem_Icc_iff.mpr hm
    exact ⟨Int.cast_pos.mp ((div_pos hM0 hCpos).trans_le hi.1), hi.2⟩
  have hheight : ∀ m ∈ I, |(m : ℝ)| ≤ C ^ 2 * (C * M) := by
    intro m hm
    have hz : 0 ≤ (m : ℝ) := by exact_mod_cast (hmark m hm).1.le
    rw [abs_of_nonneg hz]
    exact (hmark m hm).2.trans
      (le_mul_of_one_le_left (mul_nonneg hCpos.le hM0.le) hCtwo)
  let Wα : ℝ := Kα * Lα * x ^ (ε / 4)
  have hWα : 0 ≤ Wα := by dsimp [Wα]; positivity
  have hαint : ∀ m ∈ I, ‖α m.toNat‖ ≤ Wα := by
    clear * - hαbound hmark hWα hdivisor hMhi hCpos hx0 hαlog hLα hCd hε hlog0 Kα Wα
    intro m hm
    by_cases ha : α m.toNat = 0
    · simpa only [ha, norm_zero] using hWα
    have hn : m.toNat ≠ 0 := (Int.pos_iff_toNat_pos.mp (hmark m hm).1).ne'
    have hnreal : (m.toNat : ℝ) ≤ C ^ 2 * x := by
      have hcast : (m.toNat : ℝ) = (m : ℝ) := by
        exact_mod_cast Int.toNat_of_nonneg (hmark m hm).1.le
      rw [hcast]
      calc
        _ ≤ C * M := (hmark m hm).2
        _ ≤ C * (C * x) := by gcongr
        _ = _ := by ring
    have hτ : ((Nat.divisors m.toNat).card : ℝ) ^ D ≤
        Kα * x ^ (ε / 8) := by
      calc
        _ ≤ Cd * (m.toNat : ℝ) ^ (ε / 8) := hdivisor _ hn
        _ ≤ Cd * (C ^ 2 * x) ^ (ε / 8) := by gcongr
        _ = Kα * x ^ (ε / 8) := by
          rw [Real.mul_rpow (sq_nonneg C) hx0.le, ← Real.rpow_natCast_mul hCpos.le]
          dsimp only [Kα]
          norm_num only [Nat.cast_ofNat]
          rw [show (2 : ℝ) * (ε / 8) = ε / 4 by ring]
          ring
    calc
      _ ≤ Lα * ((Nat.divisors m.toNat).card : ℝ) ^ D * (Real.log x) ^ Eα :=
        hαbound _ (Finsupp.mem_support_iff.mpr ha)
      _ ≤ Lα * (Kα * x ^ (ε / 8)) * x ^ (ε / 8) := by gcongr
      _ = Wα := by
        dsimp only [Wα]
        rw [mul_assoc Lα, mul_assoc Kα, ← Real.rpow_add hx0]
        rw [show ε / 8 + ε / 8 = ε / 4 by ring]
        ring
  let ρ : ℝ := C ^ 2 * x ^ (-ε)
  let r : ℝ := 1 + ρ
  let Qmax : ℝ := C * x ^ aExp
  let label : ℕ+ → ℕ := fun q => Nat.floor (Real.logb r (q : ℝ))
  let bins : ℕ := Nat.floor (Real.logb r Qmax) + 1
  have hρ : 0 < ρ := by dsimp only [ρ]; positivity
  have hr : 1 < r := by dsimp only [r]; linarith
  have hr0 : 0 < r := zero_lt_one.trans hr
  have hQmax : 1 ≤ Qmax :=
    one_le_mul_of_one_le_of_one_le hC (Real.one_le_rpow hx1 haExp.le)
  have hQmax0 : 0 < Qmax := zero_lt_one.trans_le hQmax
  have hlabels : ∀ q ∈ Qset, label q ∈ Finset.range bins := by
    clear * - hQset hr label bins Qmax
    intro q hq
    apply Finset.mem_range.mpr
    have hq0 : 0 < (q : ℝ) := by exact_mod_cast q.pos
    have hqmax : (q : ℝ) ≤ Qmax := (hQset q hq).2.2
    have hl := Nat.floor_mono (Real.logb_le_logb_of_le hr hq0 hqmax)
    exact lt_of_le_of_lt hl (Nat.lt_succ_self _)
  have hcenter (j : ℕ) (hj : j ∈ Finset.range bins) :
      0 < r ^ j ∧ r ^ j ≤ C ^ 2 * x ^ (1 / 2 + 2 * omegaExp + ε) := by
    clear * - hj hC hx1 hr hr0 hQmax hQmax0 hε κ aExp bins Qmax
    have hj' : j ≤ Nat.floor (Real.logb r Qmax) :=
      Nat.le_of_lt_succ (Finset.mem_range.mp hj)
    have hjreal : (j : ℝ) ≤ Real.logb r Qmax :=
      (Nat.cast_le.mpr hj').trans (Nat.floor_le (Real.logb_nonneg hr hQmax))
    have hpow : r ^ j ≤ Qmax := by
      simpa only [Real.rpow_natCast] using
        (Real.le_logb_iff_rpow_le hr hQmax0).mp hjreal
    refine ⟨pow_pos hr0 _, hpow.trans ?_⟩
    dsimp only [Qmax]
    apply mul_le_mul (le_self_pow₀ hC two_ne_zero)
      (Real.rpow_le_rpow_of_exponent_le hx1 ?_) (by positivity) (sq_nonneg C)
    dsimp only [aExp, κ]
    linarith
  have hband (j : ℕ) : ∀ q ∈ Qset.filter (fun q => label q = j),
      Squarefree (q : ℕ) ∧
      Nonempty (DenseDivisibilityWitness Y 1 (q : ℕ)) ∧
      r ^ j * (1 - C ^ 2 * x ^ (-ε)) ≤ (q : ℝ) ∧
      (q : ℝ) ≤ r ^ j * (1 + C ^ 2 * x ^ (-ε)) := by
    clear * - hQset hr hr0 hρ label r ρ
    intro q hq
    obtain ⟨hqset, hlabel⟩ := Finset.mem_filter.mp hq
    have hq0 : 0 < (q : ℝ) := by exact_mod_cast q.pos
    have hq1 : 1 ≤ (q : ℝ) := by
      exact_mod_cast (show (1 : ℕ) ≤ (q : ℕ) from q.pos)
    have hlow : r ^ label q ≤ (q : ℝ) := by
      simpa only [Real.rpow_natCast] using
        (Real.le_logb_iff_rpow_le hr hq0).mp
          (Nat.floor_le (Real.logb_nonneg hr hq1))
    have hupp : (q : ℝ) < r ^ (label q + 1) := by
      rw [← Real.rpow_natCast]
      apply (Real.logb_lt_iff_lt_rpow hr hq0).mp
      simpa only [Nat.cast_add, Nat.cast_one, label] using
        Nat.lt_floor_add_one (Real.logb r (q : ℝ))
    rw [hlabel] at hlow hupp
    refine ⟨(hQset q hqset).1, (hQset q hqset).2.1, ?_, ?_⟩
    · exact (mul_le_of_le_one_right (pow_pos hr0 j).le
        (by dsimp only [ρ] at hρ; linarith)).trans hlow
    · simpa only [pow_succ, r, ρ] using hupp.le
  have hlogr : ρ / 2 ≤ Real.log r := by
    clear * - hρ hρupper r ρ
    have hρtwo : ρ ≤ 2 := by dsimp only [ρ]; linarith only [hρupper]
    calc
      ρ / 2 = 2 * ρ / 4 := by ring
      _ ≤ 2 * ρ / (ρ + 2) :=
        div_le_div_of_nonneg_left (by positivity) (by positivity) (by linarith only [hρtwo])
      _ ≤ Real.log r := Real.le_log_one_add_of_nonneg hρ.le
  have hrhoinverse : ρ⁻¹ ≤ x ^ ε := by
    clear * - hCtwo hx0 ρ
    dsimp only [ρ]
    rw [mul_inv_rev, ← Real.rpow_neg hx0.le (-ε), neg_neg]
    exact mul_le_of_le_one_right (Real.rpow_nonneg hx0.le _)
      (inv_le_one_of_one_le₀ hCtwo)
  have hbins : (bins : ℝ) ≤ Acov * x ^ ε * Real.log x := by
    clear * - hCpos hx0 hlogC haExp hxlog hx1 hε hlogr hρ hrhoinverse hr hQmax
      Qmax aExp bins Acov r ρ
    have hlogQ : Real.log Qmax = Real.log C + aExp * Real.log x := by
      dsimp only [Qmax]
      rw [Real.log_mul hCpos.ne' (Real.rpow_pos_of_pos hx0 _).ne',
        Real.log_rpow hx0]
    have hlogQupper : Real.log Qmax ≤ (Real.log C + aExp) * Real.log x := by
      rw [hlogQ, add_mul (Real.log C) aExp (Real.log x)]
      exact add_le_add (le_mul_of_one_le_right hlogC hxlog) le_rfl
    have hf : (Nat.floor (Real.logb r Qmax) : ℝ) ≤ Real.logb r Qmax :=
      Nat.floor_le (Real.logb_nonneg hr hQmax)
    have hxε : 1 ≤ x ^ ε := Real.one_le_rpow hx1 hε.le
    have hbase : 1 ≤ x ^ ε * Real.log x :=
      one_le_mul_of_one_le_of_one_le hxε hxlog
    calc
      (bins : ℝ) ≤ Real.log Qmax / Real.log r + 1 := by
        dsimp only [bins]
        push_cast
        simpa only [Real.logb] using add_le_add hf (le_refl (1 : ℝ))
      _ ≤ Real.log Qmax / (ρ / 2) + 1 := by
        gcongr
        exact Real.log_nonneg hQmax
      _ = 2 * Real.log Qmax * ρ⁻¹ + 1 := by ring
      _ ≤ 2 * ((Real.log C + aExp) * Real.log x) * x ^ ε + 1 := by
        gcongr
      _ ≤ 2 * ((Real.log C + aExp) * Real.log x) * x ^ ε +
          x ^ ε * Real.log x := add_le_add le_rfl hbase
      _ = Acov * x ^ ε * Real.log x := by
        dsimp only [Acov]
        ring
  have hαpair (F : ℤ → ℂ) :
      (∑ n ∈ α.support, α n * F (n : ℤ)) =
        ∑ m ∈ I, α m.toNat * F m := by
    clear * - hαsupport hmark I
    refine Finset.sum_bij_ne_zero (fun n _ _ => (n : ℤ)) ?_ ?_ ?_ ?_
    · intro n hn _
      apply Int.cast_mem_Icc_iff.mp
      simpa only [Set.mem_Icc, Int.cast_natCast] using hαsupport n hn
    · intro n₁ _ _ n₂ _ _ he
      exact Int.ofNat.inj he
    · intro m hm hmne
      have ha : α m.toNat ≠ 0 := left_ne_zero_of_mul hmne
      have hcast : (m.toNat : ℤ) = m := Int.toNat_of_nonneg (hmark m hm).1.le
      refine ⟨m.toNat, Finsupp.mem_support_iff.mpr ha, ?_, hcast⟩
      simpa only [hcast] using hmne
    · intro n _ _
      simp only [Int.toNat_natCast]
  have hβpair (N' : ℝ) (hN' : 0 < N') (ψ : ℝ → ℂ)
      (hs : Function.support ψ ⊆ Set.Icc (1 / C) C) (F : ℤ → ℂ) :
      let β := positiveCompactProfileSequence ψ C N' 0
      (∑ n ∈ β.support, β n * F (n : ℤ)) =
        ∑ z ∈ Finset.Icc (Int.ceil (-C * N')) (Int.floor (C * N')),
          ψ ((z : ℝ) / N') * F z := by
    clear * - hCpos hN' hs
    let s : Finset ℕ := Finset.Icc 1 (Nat.floor (C * N'))
    have hwindow (t : ℝ) (ht : ψ (t / N') ≠ 0) :
        0 < t ∧ -C * N' ≤ t ∧ t ≤ C * N' := by
      have hh := hs ht
      have hlo : (1 / C) * N' ≤ t := (le_div_iff₀ hN').mp hh.1
      have hhi : t ≤ C * N' := (div_le_iff₀ hN').mp hh.2
      have htpos : 0 < t := (mul_pos (one_div_pos.mpr hCpos) hN').trans_le hlo
      refine ⟨htpos, ?_, hhi⟩
      simpa only [neg_mul] using
        (neg_nonpos.mpr (mul_nonneg hCpos.le hN'.le)).trans htpos.le
    have hmemS (n : ℕ) (hn : ψ ((n : ℝ) / N') ≠ 0) : n ∈ s := by
      have hh := hwindow (n : ℝ) hn
      exact Finset.mem_Icc.mpr ⟨Nat.cast_pos.mp hh.1, Nat.le_floor hh.2.2⟩
    have hmemI (z : ℤ) (hz : ψ ((z : ℝ) / N') ≠ 0) :
        z ∈ Finset.Icc (Int.ceil (-C * N')) (Int.floor (C * N')) :=
      Int.cast_mem_Icc_iff.mp (hwindow (z : ℝ) hz).2
    have hnat :
        (∑ n ∈ (positiveCompactProfileSequence
          ψ C N' 0).support,
          positiveCompactProfileSequence ψ C N' 0 n *
            F (n : ℤ)) = ∑ n ∈ s, ψ ((n : ℝ) / N') * F (n : ℤ) := by
      simp only [positiveCompactProfileSequence,
        zero_add, sub_zero]
      change (∑ n ∈ s, Finsupp.single n (ψ ((n : ℝ) / N'))).sum
        (fun n z => z * F (n : ℤ)) = _
      rw [← Finsupp.indicator_eq_sum_single]
      exact Finsupp.sum_indicator_index _ (fun _ _ => zero_mul _)
    refine hnat.trans ?_
    refine Finset.sum_bij_ne_zero (fun n _ _ => (n : ℤ)) ?_ ?_ ?_ ?_
    · intro n _ hn
      apply hmemI
      simpa only [Int.cast_natCast] using
        (left_ne_zero_of_mul hn : ψ ((n : ℝ) / N') ≠ 0)
    · intro n₁ _ _ n₂ _ _ he
      exact Int.ofNat.inj he
    · intro z _ hz
      have hw : ψ ((z : ℝ) / N') ≠ 0 := left_ne_zero_of_mul hz
      have hzpos : 0 < z := by exact_mod_cast (hwindow (z : ℝ) hw).1
      lift z to ℕ using hzpos.le with n
      simp only [Int.cast_natCast] at hw hz ⊢
      exact ⟨n, hmemS _ hw, hz, rfl⟩
    · intro n _ _
      simp only [Int.cast_natCast]
  let β₁ := positiveCompactProfileSequence ψ₁ C N₁ 0
  let β₂ := positiveCompactProfileSequence ψ₂ C N₂ 0
  let β₃ := positiveCompactProfileSequence ψ₃ C N₃ 0
  let f := finiteConvolution α
    (finiteConvolution β₁
      (finiteConvolution β₂ β₃))
  let P₁ := Finset.Icc (Int.ceil (-C * N₁)) (Int.floor (C * N₁))
  let P₂ := Finset.Icc (Int.ceil (-C * N₂)) (Int.floor (C * N₂))
  let P₃ := Finset.Icc (Int.ceil (-C * N₃)) (Int.floor (C * N₃))
  let w : ℤ → ℤ → ℤ → ℤ → ℂ := fun m n₁ n₂ n₃ =>
    α m.toNat * ψ₁ ((n₁ : ℝ) / N₁) * ψ₂ ((n₂ : ℝ) / N₂) *
      ψ₃ ((n₃ : ℝ) / N₃)
  have hconv (a b : ℕ →₀ ℂ) (F : ℤ → ℂ) :
      (∑ n ∈ (finiteConvolution a b).support,
        finiteConvolution a b n * F (n : ℤ)) =
      ∑ m ∈ a.support, a m * ∑ n ∈ b.support, b n * F ((m : ℤ) * n) := by
    clear * -
    rw [finiteConvolution_pairing]
    simp only [Finset.mul_sum, mul_assoc, Nat.cast_mul]
  have hfnat (F : ℤ → ℂ) :
      (∑ n ∈ f.support, f n * F (n : ℤ)) =
      ∑ m ∈ α.support, α m *
        ∑ n₁ ∈ β₁.support, β₁ n₁ *
          ∑ n₂ ∈ β₂.support, β₂ n₂ *
            ∑ n₃ ∈ β₃.support, β₃ n₃ *
              F ((m : ℤ) * n₁ * n₂ * n₃) := by
    clear * - hconv f β₁ β₂ β₃
    dsimp only [f]
    rw [hconv α _ F]
    apply Finset.sum_congr rfl
    intro m _
    apply congrArg (fun z : ℂ => α m * z)
    rw [hconv β₁ _ (fun z => F ((m : ℤ) * z))]
    apply Finset.sum_congr rfl
    intro n₁ _
    apply congrArg (fun z : ℂ => β₁ n₁ * z)
    rw [hconv β₂ β₃ (fun z => F ((m : ℤ) * ((n₁ : ℤ) * z)))]
    simp only [mul_assoc]
  have hpair (F : ℤ → ℂ) :
      (∑ n ∈ f.support, f n * F (n : ℤ)) =
      ∑ m ∈ I, ∑ n₁ ∈ P₁, ∑ n₂ ∈ P₂, ∑ n₃ ∈ P₃,
        w m n₁ n₂ n₃ * F (m * n₁ * n₂ * n₃) := by
    clear * - hfnat hαpair hβpair hN₁0 hN₂0 hN₃0 hs₁ hs₂ hs₃ β₁ β₂ β₃ P₁ P₂ P₃ w
    rw [hfnat]
    calc
      _ = ∑ m ∈ I, α m.toNat *
          ∑ n₁ ∈ β₁.support, β₁ n₁ *
            ∑ n₂ ∈ β₂.support, β₂ n₂ *
              ∑ n₃ ∈ β₃.support, β₃ n₃ *
                F (m * (n₁ : ℤ) * n₂ * n₃) :=
        hαpair (fun m => ∑ n₁ ∈ β₁.support, β₁ n₁ *
          ∑ n₂ ∈ β₂.support, β₂ n₂ *
            ∑ n₃ ∈ β₃.support, β₃ n₃ * F (m * (n₁ : ℤ) * n₂ * n₃))
      _ = ∑ m ∈ I, α m.toNat *
          ∑ n₁ ∈ P₁, ψ₁ ((n₁ : ℝ) / N₁) *
            ∑ n₂ ∈ P₂, ψ₂ ((n₂ : ℝ) / N₂) *
              ∑ n₃ ∈ P₃, ψ₃ ((n₃ : ℝ) / N₃) *
                F (m * n₁ * n₂ * n₃) := by
        apply Finset.sum_congr rfl
        intro m _
        apply congrArg (fun z : ℂ => α m.toNat * z)
        calc
          _ = ∑ n₁ ∈ P₁, ψ₁ ((n₁ : ℝ) / N₁) *
              ∑ n₂ ∈ β₂.support, β₂ n₂ *
                ∑ n₃ ∈ β₃.support, β₃ n₃ * F (m * n₁ * (n₂ : ℤ) * n₃) :=
            hβpair N₁ hN₁0 ψ₁ hs₁ (fun n₁ => ∑ n₂ ∈ β₂.support, β₂ n₂ *
              ∑ n₃ ∈ β₃.support, β₃ n₃ * F (m * n₁ * (n₂ : ℤ) * n₃))
          _ = _ := by
            apply Finset.sum_congr rfl
            intro n₁ _
            apply congrArg (fun z : ℂ => ψ₁ ((n₁ : ℝ) / N₁) * z)
            calc
              _ = ∑ n₂ ∈ P₂, ψ₂ ((n₂ : ℝ) / N₂) *
                  ∑ n₃ ∈ β₃.support, β₃ n₃ * F (m * n₁ * n₂ * (n₃ : ℤ)) :=
                hβpair N₂ hN₂0 ψ₂ hs₂ (fun n₂ =>
                  ∑ n₃ ∈ β₃.support, β₃ n₃ * F (m * n₁ * n₂ * (n₃ : ℤ)))
              _ = _ := by
                apply Finset.sum_congr rfl
                intro n₂ _
                exact congrArg (fun z : ℂ => ψ₂ ((n₂ : ℝ) / N₂) * z)
                  (hβpair N₃ hN₃0 ψ₃ hs₃ (fun n₃ => F (m * n₁ * n₂ * n₃)))
      _ = _ := by
        simp only [w, Finset.mul_sum, mul_assoc]
  let R : (q : ℕ+) → ZMod (q : ℕ) → ℂ := fun q a =>
    ∑ m ∈ I, ∑ n₁ ∈ P₁, ∑ n₂ ∈ P₂, ∑ n₃ ∈ P₃,
      if ((m * n₁ * n₂ * n₃ : ℤ) : ZMod (q : ℕ)) = a then
        w m n₁ n₂ n₃ else 0
  let U : ℕ+ → ℂ := fun q =>
    ∑ m ∈ I, ∑ n₁ ∈ P₁, ∑ n₂ ∈ P₂, ∑ n₃ ∈ P₃,
      if IsUnit ((m * n₁ * n₂ * n₃ : ℤ) : ZMod (q : ℕ)) then
        w m n₁ n₂ n₃ else 0
  have hR (q : ℕ+) (a : ZMod (q : ℕ)) :
      (∑ n ∈ f.support, if (n : ZMod (q : ℕ)) = a then f n else 0) =
        R q a := by
    clear * - hpair
    simpa only [R, Int.cast_natCast, mul_ite, mul_one, mul_zero] using
      hpair (fun z => if (z : ZMod (q : ℕ)) = a then 1 else 0)
  have hU (q : ℕ+) :
      (∑ n ∈ f.support, if Nat.Coprime n (q : ℕ) then f n else 0) = U q := by
    clear * - hpair
    simpa only [U, Int.cast_natCast, ZMod.isUnit_iff_coprime,
      mul_ite, mul_one, mul_zero] using
      hpair (fun z => if IsUnit (z : ZMod (q : ℕ)) then 1 else 0)
  let a : ∀ q : ℕ+, (ZMod (q : ℕ))ˣ := fun q =>
    if hq : q ∈ Qset then (ha₀ q hq).unit else 1
  have ha : ∀ q ∈ Qset, (a q : ZMod (q : ℕ)) = (a₀ : ZMod (q : ℕ)) := by
    intro q hq
    simp only [a, dite_eq_left hq, IsUnit.unit_spec]
  have hsym (ψ : ℝ → ℂ) (hs : Function.support ψ ⊆ Set.Icc (1 / C) C) :
      Function.support ψ ⊆ Set.Icc (-C) C :=
    hs.trans (Set.Icc_subset_Icc_left
      ((neg_nonpos.mpr hCpos.le).trans (one_div_pos.mpr hCpos).le))
  have hper (j : ℕ) (hj : j ∈ Finset.range bins) :
      ∑ q ∈ Qset.filter (fun q => label q = j),
        ‖R q (a q : ZMod (q : ℕ)) - U q / ((q : ℕ).totient : ℂ)‖ ≤
      2 * Kp * (L₁ * L₂ * L₃) * Wα * ((C * M) * N) * x ^ (-2 * ε) := by
    have hh := hp x hxXp (C * M) N₁ N₂ N₃ (r ^ j)
      hMphys (hcenter j hj).1 hlarge₁ hlarge₂ hlarge₃
      hMNphyslo hMNphyshi hNlower (hcenter j hj).2 Y hY
      (Qset.filter (fun q => label q = j)) (hband j)
      M₀ M₁ hM₀ hwidth hheight L₁ L₂ L₃ Wα hL₁ hL₂ hL₃ hWα
      (fun m => α m.toNat) ψ₁ ψ₂ ψ₃ hαint hψ₁ hψ₂ hψ₃
      (hsym ψ₁ hs₁) (hsym ψ₂ hs₂) (hsym ψ₃ hs₃) hd₁ hd₂ hd₃
    exact hh.2 a₀ a (fun q hq => ha q (Finset.mem_filter.mp hq).1)
  clear * - hper hlabels hbins hR hU ha hMNphyshi hCpos hKp hAcov hKα
    hLα hL₁ hL₂ hL₃ hWα hM0 hN0 hx0 hlog0 hlogsmall hlogA
  let B : ℝ := 2 * Kp * Acov * Kα * C ^ 2 * (Lα * L₁ * L₂ * L₃)
  have hB : 0 ≤ B := by dsimp only [B]; positivity
  have hbulk : 0 ≤ 2 * Kp * (L₁ * L₂ * L₃) * Wα := by positivity
  have hcover : 0 ≤ Acov * x ^ ε * Real.log x := by positivity
  have hpower : x ^ ε * x ^ (ε / 4) * x * x ^ (-2 * ε) =
      x ^ (1 - 3 * ε / 4) := by
    clear * - hx0
    rw [← Real.rpow_add hx0, ← Real.rpow_add_one hx0.ne', ← Real.rpow_add hx0]
    congr 1
    ring
  change
    ∑ q ∈ Qset,
      ‖(∑ n ∈ f.support,
        if (n : ZMod (q : ℕ)) = (a₀ : ZMod (q : ℕ)) then f n else 0) -
        ((q : ℕ).totient : ℂ)⁻¹ *
          (∑ n ∈ f.support, if Nat.Coprime n (q : ℕ) then f n else 0)‖ ≤
      K * (Lα * L₁ * L₂ * L₃) * x / (Real.log x) ^ A
  calc
    _ = ∑ q ∈ Qset,
        ‖R q (a q : ZMod (q : ℕ)) - U q / ((q : ℕ).totient : ℂ)‖ := by
      apply Finset.sum_congr rfl
      intro q hq
      rw [hR, hU, ha q hq, div_eq_mul_inv, mul_comm (U q)]
    _ = ∑ j ∈ Finset.range bins, ∑ q ∈ Qset.filter (fun q => label q = j),
        ‖R q (a q : ZMod (q : ℕ)) - U q / ((q : ℕ).totient : ℂ)‖ :=
      (Finset.sum_fiberwise_of_maps_to hlabels _).symm
    _ ≤ (bins : ℝ) *
        (2 * Kp * (L₁ * L₂ * L₃) * Wα * ((C * M) * N) * x ^ (-2 * ε)) := by
      simpa only [Finset.sum_const, Finset.card_range, nsmul_eq_mul] using
        Finset.sum_le_sum hper
    _ ≤ (Acov * x ^ ε * Real.log x) *
        (2 * Kp * (L₁ * L₂ * L₃) * Wα * ((C * M) * N) * x ^ (-2 * ε)) :=
      mul_le_mul_of_nonneg_right hbins (by positivity)
    _ ≤ (Acov * x ^ ε * Real.log x) *
        (2 * Kp * (L₁ * L₂ * L₃) * Wα * (C ^ 2 * x) * x ^ (-2 * ε)) :=
      mul_le_mul_of_nonneg_left
        (mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left hMNphyshi hbulk)
          (Real.rpow_nonneg hx0.le _)) hcover
    _ = B * (x ^ ε * x ^ (ε / 4) * x * x ^ (-2 * ε)) * Real.log x := by
      dsimp only [B, Wα]
      ring
    _ = B * x ^ (1 - 3 * ε / 4) * Real.log x := by rw [hpower]
    _ ≤ B * x ^ (1 - 3 * ε / 4) * x ^ (ε / 4) :=
      mul_le_mul_of_nonneg_left hlogsmall (by positivity)
    _ = B * x ^ (1 - ε / 2) := by
      rw [mul_assoc, ← Real.rpow_add hx0]
      congr 1
      ring_nf
    _ ≤ B * x / (Real.log x) ^ A := by
      apply (le_div_iff₀ (Real.rpow_pos_of_pos hlog0 A)).mpr
      calc
        _ ≤ B * x ^ (1 - ε / 2) * x ^ (ε / 2) :=
          mul_le_mul_of_nonneg_left hlogA (by positivity)
        _ = B * x := by
          rw [mul_assoc, ← Real.rpow_add hx0]
          simp
    _ ≤ K * (Lα * L₁ * L₂ * L₃) * x / (Real.log x) ^ A := by
      apply div_le_div_of_nonneg_right _ (Real.rpow_nonneg hlog0.le _)
      apply mul_le_mul_of_nonneg_right _ hx0.le
      exact mul_le_mul_of_nonneg_right (le_add_of_nonneg_left zero_le_one) (by positivity)

end

open scoped Classical in
theorem nonprincipal_character_sum_eq_primitive_conductors
    (q : ℕ) [NeZero q] {M : Type*} [AddCommMonoid M]
    (F : DirichletCharacter ℂ q → M) :
    (∑ χ ∈ (Finset.univ : Finset (DirichletCharacter ℂ q)).erase 1, F χ) =
      ∑ f ∈ q.divisors.attach.filter (fun f => 1 < f.1),
        ∑ ψ ∈ (Finset.univ : Finset (DirichletCharacter ℂ f.1)).filter
            (fun ψ => ψ.IsPrimitive),
          F (DirichletCharacter.changeLevel (Nat.dvd_of_mem_divisors f.2) ψ)
:= by
  classical
  have hfiber (d : ℕ) (hd : d ∣ q) :
      (∑ χ ∈ (Finset.univ : Finset (DirichletCharacter ℂ q)).filter
          (fun χ => χ.conductor = d), F χ) =
        ∑ ψ ∈ (Finset.univ : Finset (DirichletCharacter ℂ d)).filter
            (fun ψ => ψ.IsPrimitive),
          F (DirichletCharacter.changeLevel hd ψ) := by
    symm
    refine Finset.sum_bij (fun ψ _ => DirichletCharacter.changeLevel hd ψ)
      ?_ ?_ ?_ ?_
    · intro ψ hψ
      refine Finset.mem_filter.mpr ⟨Finset.mem_univ _, ?_⟩
      rw [DirichletCharacter.conductor_changeLevel]
      exact (DirichletCharacter.isPrimitive_def ψ).mp (Finset.mem_filter.mp hψ).2
    · intro ψ _ ξ _ h
      exact DirichletCharacter.changeLevel_injective hd h
    · intro χ hχ
      have hc : χ.conductor = d := (Finset.mem_filter.mp hχ).2
      subst d
      refine ⟨χ.primitiveCharacter, ?_, ?_⟩
      · exact Finset.mem_filter.mpr
          ⟨Finset.mem_univ _, χ.primitiveCharacter_isPrimitive⟩
      · exact χ.changeLevel_primitiveCharacter
    · intro ψ _
      rfl
  let D : DirichletCharacter ℂ q → {d : ℕ // d ∈ q.divisors} :=
    fun χ => ⟨χ.conductor,
      Nat.mem_divisors.mpr ⟨χ.conductor_dvd_level, NeZero.ne q⟩⟩
  have hD : ∀ χ ∈ (Finset.univ : Finset (DirichletCharacter ℂ q)).erase 1,
      D χ ∈ q.divisors.attach.filter (fun d => 1 < d.1) := by
    intro χ hχ
    refine Finset.mem_filter.mpr ⟨Finset.mem_attach _ _, ?_⟩
    change 1 < χ.conductor
    have hc0 := χ.conductor_ne_zero
    have hc1 : χ.conductor ≠ 1 := by
      intro hc
      exact (Finset.mem_erase.mp hχ).1
        (DirichletCharacter.eq_one_iff_conductor_eq_one.mpr hc)
    omega
  calc
    (∑ χ ∈ (Finset.univ : Finset (DirichletCharacter ℂ q)).erase 1, F χ) =
        ∑ d ∈ q.divisors.attach.filter (fun d => 1 < d.1),
          ∑ χ ∈ ((Finset.univ : Finset (DirichletCharacter ℂ q)).erase 1).filter
              (fun χ => D χ = d), F χ :=
      (Finset.sum_fiberwise_of_maps_to hD F).symm
    _ = ∑ d ∈ q.divisors.attach.filter (fun d => 1 < d.1),
          ∑ ψ ∈ (Finset.univ : Finset (DirichletCharacter ℂ d.1)).filter
              (fun ψ => ψ.IsPrimitive),
            F (DirichletCharacter.changeLevel (Nat.dvd_of_mem_divisors d.2) ψ) := by
      apply Finset.sum_congr rfl
      intro d hd
      have hd1 : 1 < d.1 := (Finset.mem_filter.mp hd).2
      have hfilter :
          ((Finset.univ : Finset (DirichletCharacter ℂ q)).erase 1).filter
              (fun χ => D χ = d) =
            (Finset.univ : Finset (DirichletCharacter ℂ q)).filter
              (fun χ => χ.conductor = d.1) := by
        ext χ
        simp only [Finset.mem_filter, Finset.mem_erase, Finset.mem_univ,
          and_true, true_and]
        constructor
        · rintro ⟨_, hχ⟩
          exact congrArg Subtype.val hχ
        · intro hc
          refine ⟨?_, Subtype.ext hc⟩
          intro hχ
          subst χ
          have : 1 = d.1 := by
            simpa only [DirichletCharacter.conductor_one] using hc
          omega
      rw [hfilter]
      exact hfiber d.1 (Nat.dvd_of_mem_divisors d.2)

open scoped Classical in
theorem masked_finiteConvolution_changeLevel_pairing
    (α β : ℕ →₀ ℂ) (e f h : ℕ) (ψ : DirichletCharacter ℂ f) :
    (∑ n ∈ (finiteConvolution α β).support,
      if Nat.Coprime n h then
        finiteConvolution α β n *
          DirichletCharacter.changeLevel (Nat.dvd_mul_left f e) ψ (n : ZMod (e * f))
      else 0) =
      (∑ m ∈ α.support,
        if Nat.Coprime m (e * h) then α m * ψ (m : ZMod f) else 0) *
      (∑ n ∈ β.support,
        if Nat.Coprime n (e * h) then β n * ψ (n : ZMod f) else 0)
:= by
  classical
  have hlift (k : ℕ) :
      DirichletCharacter.changeLevel (Nat.dvd_mul_left f e) ψ
          (k : ZMod (e * f)) =
        if Nat.Coprime k e then ψ (k : ZMod f) else 0 := by
    by_cases hu : IsUnit (k : ZMod (e * f))
    · have he : Nat.Coprime k e :=
        (Nat.coprime_mul_iff_right.mp
          ((ZMod.isUnit_iff_coprime k (e * f)).mp hu)).1
      rw [ite_eq_left he]
      obtain ⟨u, hu⟩ := hu
      have hv := DirichletCharacter.changeLevel_eq_cast_of_dvd ψ
        (Nat.dvd_mul_left f e) u
      rw [hu, ZMod.cast_natCast (Nat.dvd_mul_left f e)] at hv
      exact hv
    · rw [MulChar.map_nonunit _ hu]
      by_cases he : Nat.Coprime k e
      · have hf : ¬ Nat.Coprime k f := by
          intro hf
          exact hu ((ZMod.isUnit_iff_coprime k (e * f)).mpr
            (Nat.coprime_mul_iff_right.mpr ⟨he, hf⟩))
        rw [ite_eq_left he, MulChar.map_nonunit ψ
          ((ZMod.isUnit_iff_coprime k f).not.mpr hf)]
      · rw [ite_eq_right he]
  let K : ℕ → ℂ := fun k =>
    if Nat.Coprime k h then
      DirichletCharacter.changeLevel (Nat.dvd_mul_left f e) ψ
        (k : ZMod (e * f))
    else 0
  have hkernel (m n : ℕ) :
      α m * β n * K (m * n) =
        (if Nat.Coprime m (e * h) then α m * ψ (m : ZMod f) else 0) *
          (if Nat.Coprime n (e * h) then β n * ψ (n : ZMod f) else 0) := by
    simp only [K, hlift, Nat.cast_mul, map_mul,
      Nat.coprime_mul_iff_left, Nat.coprime_mul_iff_right, mul_ite, ite_mul,
      zero_mul, mul_zero, ← ite_and, and_assoc, and_left_comm, and_comm,
      mul_mul_mul_comm]
  calc
    (∑ n ∈ (finiteConvolution α β).support,
        if Nat.Coprime n h then
          finiteConvolution α β n *
            DirichletCharacter.changeLevel (Nat.dvd_mul_left f e) ψ
              (n : ZMod (e * f))
        else 0) =
        ∑ n ∈ (finiteConvolution α β).support, finiteConvolution α β n * K n := by
      simp only [K, mul_ite, mul_zero]
    _ = ∑ m ∈ α.support, ∑ n ∈ β.support, α m * β n * K (m * n) :=
      finiteConvolution_pairing α β K
    _ = (∑ m ∈ α.support,
          if Nat.Coprime m (e * h) then α m * ψ (m : ZMod f) else 0) *
        (∑ n ∈ β.support,
          if Nat.Coprime n (e * h) then β n * ψ (n : ZMod f) else 0) := by
      simp_rw [hkernel, ← Finset.mul_sum, ← Finset.sum_mul]

open scoped Classical in
theorem sum_max_masked_finiteConvolution_discrepancy_le_conductor_sum
    (α β : ℕ →₀ ℂ) (Q h : ℕ) :
    (∑ q ∈ Finset.Ioc 0 Q,
      ⨆ a : (ZMod q)ˣ,
        ‖fullDiscrepancy
          ((finiteConvolution α β).filter (fun n : ℕ => Nat.Coprime n h))
          q (a : ZMod q).val‖) ≤
      ∑ e ∈ Finset.Ioc 0 Q, (e.totient : ℝ)⁻¹ *
        ∑ f ∈ Finset.Ioc 1 (Q / e), (f.totient : ℝ)⁻¹ *
          ∑ ψ ∈ (Finset.univ : Finset (DirichletCharacter ℂ f)).filter
              (fun ψ => ψ.IsPrimitive),
            ‖(∑ m ∈ α.support,
                if Nat.Coprime m (e * h) then α m * ψ (m : ZMod f) else 0) *
              (∑ n ∈ β.support,
                if Nat.Coprime n (e * h) then β n * ψ (n : ZMod f) else 0)‖
:= by
  classical
  let g : ℕ →₀ ℂ :=
    (finiteConvolution α β).filter (fun n : ℕ => Nat.Coprime n h)
  let Z (q : ℕ) (χ : DirichletCharacter ℂ q) : ℂ :=
    ∑ n ∈ (finiteConvolution α β).support,
      if Nat.Coprime n h then finiteConvolution α β n * χ (n : ZMod q) else 0
  let T (e f : ℕ) : ℝ :=
    ∑ ψ ∈ (Finset.univ : Finset (DirichletCharacter ℂ f)).filter
        (fun ψ => ψ.IsPrimitive),
      ‖(∑ m ∈ α.support,
          if Nat.Coprime m (e * h) then α m * ψ (m : ZMod f) else 0) *
        (∑ n ∈ β.support,
          if Nat.Coprime n (e * h) then β n * ψ (n : ZMod f) else 0)‖
  let W (e f : ℕ) : ℝ := (e.totient : ℝ)⁻¹ * ((f.totient : ℝ)⁻¹ * T e f)
  have hT (e f : ℕ) : 0 ≤ T e f :=
    Finset.sum_nonneg fun _ _ => norm_nonneg _
  have htwist (q : ℕ) (χ : DirichletCharacter ℂ q) :
      (∑ n ∈ g.support, g n * χ (n : ZMod q)) = Z q χ := by
    change (∑ n ∈ (finiteConvolution α β).support.filter
        (fun n : ℕ => Nat.Coprime n h),
      ((finiteConvolution α β).filter (fun n : ℕ => Nat.Coprime n h)) n *
        χ (n : ZMod q)) = _
    simp only [Finset.sum_filter, Finsupp.filter_apply, Z, ite_mul, zero_mul,
      ← ite_and, and_self]
  have herase (q : ℕ) [NeZero q] :
      @Finset.erase (DirichletCharacter ℂ q)
          (fun x y => Classical.propDecidable (x = y)) Finset.univ 1 =
        (Finset.univ : Finset (DirichletCharacter ℂ q)).erase 1 :=
    congrArg
      (fun inst : DecidableEq (DirichletCharacter ℂ q) =>
        @Finset.erase (DirichletCharacter ℂ q) inst Finset.univ 1)
      (Subsingleton.elim _ _)
  have hchar (q : ℕ) (hq : 0 < q) (a : (ZMod q)ˣ) :
      fullDiscrepancy g q (a : ZMod q).val =
        (q.totient : ℂ)⁻¹ *
          ∑ χ ∈ (Finset.univ : Finset (DirichletCharacter ℂ q)).erase 1,
            χ ((a : ZMod q)⁻¹) * Z q χ := by
    let : NeZero q := ⟨Nat.ne_of_gt hq⟩
    rw [herase q]
    have hp :
        (∑ n ∈ g.support,
          if (n : ZMod q) = (a : ZMod q) then g n else 0) =
          progressionMass g q (a : ZMod q).val := by
      change (∑ n ∈ g.support,
          if (n : ZMod q) = (a : ZMod q) then g n else 0) =
        ∑ n ∈ g.support,
          if n % q = (a : ZMod q).val % q then g n else 0
      apply Finset.sum_congr rfl
      intro n _
      have hc := ZMod.natCast_eq_natCast_iff' n (a : ZMod q).val q
      rw [ZMod.natCast_zmod_val] at hc
      simp only [hc]
    have hc :
        (∑ n ∈ g.support,
          if (n : ZMod q) = (a : ZMod q) then g n else 0) -
          (q.totient : ℂ)⁻¹ *
            (∑ n ∈ g.support, if Nat.Coprime n q then g n else 0) =
          (q.totient : ℂ)⁻¹ *
            ∑ χ ∈ (Finset.univ : Finset (DirichletCharacter ℂ q)).erase 1,
              χ ((a : ZMod q)⁻¹) * ∑ n ∈ g.support, g n * χ (n : ZMod q) := by
      simpa only [Nat.coprime_one_right_eq_true, true_and, ite_true] using
        masked_discrepancy_eq_nonprincipal_character_sum
          q 1 (by decide) a g
    rw [hp] at hc
    simp_rw [htwist] at hc
    calc
      fullDiscrepancy g q (a : ZMod q).val =
          progressionMass g q (a : ZMod q).val -
            (q.totient : ℂ)⁻¹ * reducedMass g q := by
        rw [fullDiscrepancy, div_eq_mul_inv,
          mul_comm (reducedMass g q) ((q.totient : ℂ)⁻¹)]
      _ = (q.totient : ℂ)⁻¹ *
          ∑ χ ∈ (Finset.univ : Finset (DirichletCharacter ℂ q)).erase 1,
            χ ((a : ZMod q)⁻¹) * Z q χ := hc
  have hqbound (q : ℕ) (hq : 0 < q) (a : (ZMod q)ˣ) :
      ‖fullDiscrepancy g q (a : ZMod q).val‖ ≤
        ∑ d ∈ q.divisors.attach.filter (fun d => 1 < d.1), W (q / d.1) d.1 := by
    let : NeZero q := ⟨Nat.ne_of_gt hq⟩
    have hnorm :
        ‖fullDiscrepancy g q (a : ZMod q).val‖ ≤
          (q.totient : ℝ)⁻¹ *
            ∑ χ ∈ (Finset.univ : Finset (DirichletCharacter ℂ q)).erase 1,
              ‖Z q χ‖ := by
      rw [hchar q hq a, herase q, norm_mul, norm_inv, Complex.norm_natCast]
      apply mul_le_mul_of_nonneg_left _ (inv_nonneg.mpr (Nat.cast_nonneg _))
      exact norm_sum_le_of_le _ (fun χ _ => by
        rw [norm_mul, ZMod.inv_coe_unit,
          DirichletCharacter.unit_norm_eq_one, one_mul])
    rw [nonprincipal_character_sum_eq_primitive_conductors
      q (fun χ => ‖Z q χ‖)] at hnorm
    calc
      ‖fullDiscrepancy g q (a : ZMod q).val‖ ≤
          (q.totient : ℝ)⁻¹ *
            ∑ d ∈ q.divisors.attach.filter (fun d => 1 < d.1),
              ∑ ψ ∈ (Finset.univ : Finset (DirichletCharacter ℂ d.1)).filter
                  (fun ψ => ψ.IsPrimitive),
                ‖Z q (DirichletCharacter.changeLevel
                  (Nat.dvd_of_mem_divisors d.2) ψ)‖ := hnorm
      _ = ∑ d ∈ q.divisors.attach.filter (fun d => 1 < d.1),
            (q.totient : ℝ)⁻¹ * T (q / d.1) d.1 := by
        rw [Finset.mul_sum]
        apply Finset.sum_congr rfl
        intro d _
        apply congrArg (fun x : ℝ => (q.totient : ℝ)⁻¹ * x)
        dsimp only [T]
        apply Finset.sum_congr rfl
        intro ψ _
        have hp := masked_finiteConvolution_changeLevel_pairing α β
          (q / d.1) d.1 h ψ
        have htransport (q' : ℕ) (he : q / d.1 * d.1 = q') (hd' : d.1 ∣ q') :
            Z q' (DirichletCharacter.changeLevel hd' ψ) =
              Z (q / d.1 * d.1)
                (DirichletCharacter.changeLevel (Nat.dvd_mul_left d.1 (q / d.1)) ψ) := by
          subst q'
          rfl
        rw [htransport q (Nat.div_mul_cancel (Nat.dvd_of_mem_divisors d.2))
          (Nat.dvd_of_mem_divisors d.2)]
        exact congrArg norm hp
      _ ≤ ∑ d ∈ q.divisors.attach.filter (fun d => 1 < d.1),
            W (q / d.1) d.1 := by
        apply Finset.sum_le_sum
        intro d _
        have hd : d.1 ∣ q := Nat.dvd_of_mem_divisors d.2
        have hdpos : 0 < d.1 := Nat.pos_of_mem_divisors d.2
        have hepos : 0 < q / d.1 :=
          Nat.div_pos (Nat.le_of_dvd hq hd) hdpos
        have hφe : 0 < ((q / d.1).totient : ℝ) := by
          exact_mod_cast Nat.totient_pos.mpr hepos
        have hφd : 0 < (d.1.totient : ℝ) := by
          exact_mod_cast Nat.totient_pos.mpr hdpos
        have hφ :
            ((q / d.1).totient : ℝ) * (d.1.totient : ℝ) ≤ (q.totient : ℝ) := by
          have hn := Nat.totient_super_multiplicative (q / d.1) d.1
          rw [Nat.div_mul_cancel hd] at hn
          exact_mod_cast hn
        have hi :
            (q.totient : ℝ)⁻¹ ≤
              ((q / d.1).totient : ℝ)⁻¹ * (d.1.totient : ℝ)⁻¹ := by
          have hn := one_div_le_one_div_of_le (mul_pos hφe hφd) hφ
          simpa only [one_div, mul_inv_rev, mul_comm] using hn
        simpa only [W, mul_assoc] using
          mul_le_mul_of_nonneg_right hi (hT (q / d.1) d.1)
  have hreindex :
      (∑ q ∈ Finset.Ioc 0 Q,
        ∑ d ∈ q.divisors.attach.filter (fun d => 1 < d.1), W (q / d.1) d.1) =
        ∑ e ∈ Finset.Ioc 0 Q, ∑ f ∈ Finset.Ioc 1 (Q / e), W e f := by
    let S : Finset (ℕ × ℕ) := Finset.Ioc 0 Q ×ˢ Finset.Ioc 0 Q
    let F : ℕ × ℕ → ℝ := fun p => if 1 < p.2 then W p.1 p.2 else 0
    let P : Finset (ℕ × ℕ) :=
      (S.filter (fun p => p.1 * p.2 ∈ Finset.Ioc 0 Q)).filter (fun p => 1 < p.2)
    have hP (p : ℕ × ℕ) :
        p ∈ P ↔ p.1 ∈ Finset.Ioc 0 Q ∧ p.2 ∈ Finset.Ioc 1 (Q / p.1) := by
      dsimp only [P, S]
      simp only [Finset.mem_filter, Finset.mem_product, Finset.mem_Ioc]
      constructor
      · rintro ⟨⟨⟨he, _⟩, hp⟩, hf⟩
        refine ⟨he, hf, ?_⟩
        apply (Nat.le_div_iff_mul_le he.1).mpr
        simpa only [Nat.mul_comm] using hp.2
      · rintro ⟨he, hf⟩
        have hfpos : 0 < p.2 := lt_trans Nat.zero_lt_one hf.1
        have hp : p.1 * p.2 ≤ Q := by
          have hm := (Nat.le_div_iff_mul_le he.1).mp hf.2
          simpa only [Nat.mul_comm] using hm
        exact ⟨⟨⟨he, ⟨hfpos, le_trans hf.2 (Nat.div_le_self _ _)⟩⟩,
          ⟨Nat.mul_pos he.1 hfpos, hp⟩⟩, hf.1⟩
    calc
      (∑ q ∈ Finset.Ioc 0 Q,
          ∑ d ∈ q.divisors.attach.filter (fun d => 1 < d.1),
            W (q / d.1) d.1) =
          ∑ q ∈ Finset.Ioc 0 Q,
            ∑ d ∈ q.divisors, if 1 < d then W (q / d) d else 0 := by
        apply Finset.sum_congr rfl
        intro q _
        rw [Finset.sum_filter]
        exact Finset.sum_attach q.divisors (fun d => if 1 < d then W (q / d) d else 0)
      _ = ∑ q ∈ Finset.Ioc 0 Q, ∑ p ∈ q.divisorsAntidiagonal, F p := by
        apply Finset.sum_congr rfl
        intro q _
        exact (Nat.sum_divisorsAntidiagonal'
          (fun e f => if 1 < f then W e f else 0)).symm
      _ = ∑ q ∈ Finset.Ioc 0 Q,
          ∑ p ∈ S.filter (fun p => p.1 * p.2 = q), F p := by
        apply Finset.sum_congr rfl
        intro q hq
        rw [Nat.divisorsAntidiagonal_eq_prod_filter_of_le
          (Nat.ne_of_gt (Finset.mem_Ioc.mp hq).1) (Finset.mem_Ioc.mp hq).2]
      _ = ∑ p ∈ S.filter (fun p => p.1 * p.2 ∈ Finset.Ioc 0 Q), F p :=
        Finset.sum_fiberwise_eq_sum_filter S (Finset.Ioc 0 Q)
          (fun p => p.1 * p.2) F
      _ = ∑ p ∈ P, W p.1 p.2 :=
        (Finset.sum_filter
          (s := S.filter (fun p => p.1 * p.2 ∈ Finset.Ioc 0 Q))
          (fun p : ℕ × ℕ => 1 < p.2) (fun p => W p.1 p.2)).symm
      _ = ∑ e ∈ Finset.Ioc 0 Q, ∑ f ∈ Finset.Ioc 1 (Q / e), W e f :=
        Finset.sum_finset_product' P (Finset.Ioc 0 Q)
          (fun e => Finset.Ioc 1 (Q / e)) hP
  calc
    (∑ q ∈ Finset.Ioc 0 Q,
        ⨆ a : (ZMod q)ˣ, ‖fullDiscrepancy g q (a : ZMod q).val‖) ≤
        ∑ q ∈ Finset.Ioc 0 Q,
          ∑ d ∈ q.divisors.attach.filter (fun d => 1 < d.1),
            W (q / d.1) d.1 := by
      apply Finset.sum_le_sum
      intro q hq
      apply ciSup_le
      intro a
      exact hqbound q (Finset.mem_Ioc.mp hq).1 a
    _ = ∑ e ∈ Finset.Ioc 0 Q, ∑ f ∈ Finset.Ioc 1 (Q / e), W e f := hreindex
    _ = ∑ e ∈ Finset.Ioc 0 Q, (e.totient : ℝ)⁻¹ *
        ∑ f ∈ Finset.Ioc 1 (Q / e), (f.totient : ℝ)⁻¹ *
          ∑ ψ ∈ (Finset.univ : Finset (DirichletCharacter ℂ f)).filter
              (fun ψ => ψ.IsPrimitive),
            ‖(∑ m ∈ α.support,
                if Nat.Coprime m (e * h) then α m * ψ (m : ZMod f) else 0) *
              (∑ n ∈ β.support,
                if Nat.Coprime n (e * h) then β n * ψ (n : ZMod f) else 0)‖ := by
      simp only [W, T, Finset.mul_sum]

section
open scoped ContDiff

theorem sourceSigmaOne_sigmaFour_bound
  (hDeligne :
    (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
      c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
    (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
      A ≠ 0 → B ≠ 0 →
        ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
          unnormalizedKloosterman2 p (A / t) *
            unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
          8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    :
    ∀ («ω» δ ε C cN TN cD TD : ℝ),
    0 < «ω» → 0 < δ → 0 < ε → 1 ≤ C →
    0 < cN → cN ≤ TN → 0 < cD → cD ≤ TD →
    ∀ (Cφ Eφ CN EN : ℕ → ℝ),
    (∀ r, 0 ≤ Cφ r) → (∀ r, 0 ≤ CN r) →
    ∃ K X₀ : ℝ, 0 < K ∧ Real.exp 1 ≤ X₀ ∧
      ∀ (x : ℝ), X₀ ≤ x →
      ∀ (m r₁ q₀ u₁ v₁ v₂ q₂ g : ℕ),
      Squarefree m → m = r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂ →
      0 < q₀ → 0 < g →
      ∀ (M N R₀ Q H Δ d₀ κ γ : ℝ),
      0 < M → 0 < N → 0 < R₀ → 0 < Q → 0 < Δ → 1 ≤ H → 1 ≤ κ →
      N = x ^ γ →
      max (1 / 4 + 12 * «ω» + 4 * δ + 100 * ε)
        (32 * «ω» + 10 * δ + 400 * ε) ≤ γ →
      γ ≤ 1 / 2 - 4 * «ω» - 2 * δ - 50 * ε →
      x / C ≤ M * N → M * N ≤ C * x →
      N ≤ C * x ^ (δ + 4 * ε) * R₀ →
      R₀ * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) →
      H = x ^ ε * R₀ * Q ^ 2 / ((q₀ : ℝ) * M) →
      N ≤ C * x ^ (δ + 50 * ε) * H ^ 2 * Δ →
      Δ ≤ C * N / (x ^ (50 * ε) * H ^ 2) → Δ / C ≤ d₀ →
      let Δ₁ : ℝ := x ^ (-5 * ε) * Δ
      κ ≤ C * (q₀ : ℝ) →
      (1 / C ^ 6) * (R₀ * Q ^ 2 * H) /
        ((q₀ : ℝ) * (g : ℝ) * κ * Δ₁) ≤ (m : ℝ) →
      (m : ℝ) ≤ C ^ 7 * x ^ δ * R₀ * Q ^ 2 * H /
        ((q₀ : ℝ) * (g : ℝ) * Δ₁) →
      ∀ (w₀ w₁ w₂ : ℕ),
      0 < w₁ → w₀ ∣ w₁ → Squarefree w₁ → Nat.Coprime w₁ m →
      (w₁ : ℝ) ≤ (C + TD) * x ^ (5 * ε) * Δ₁ →
      ∀ (y y' : ℤ) (Y : ℝ),
      (w₁ : ℤ) ∣ y → (w₁ : ℤ) ∣ y' →
      (1 ≤ (y : ℝ) / Y ∧ (y : ℝ) / Y < 2) →
      (1 ≤ (y' : ℝ) / Y ∧ (y' : ℝ) / Y < 2) →
      w₂ = (∏ p ∈ m.primeFactors, p ^ (y.natAbs.factorization p)) →
      w₂ = (∏ p ∈ m.primeFactors, p ^ (y'.natAbs.factorization p)) →
      |Y / (w₁ : ℝ)| ≤ 4 * C ^ 3 * x ^ (δ + 5 * ε) * H ^ 2 /
        ((w₁ : ℝ) * (g : ℝ)) →
      ∀ (Ao Bo ℓ : ℤ) (E : ZMod q₀ → Finset (ZMod q₀)),
      (∀ r, (E r).card ≤ Int.gcd (q₀ : ℤ) ℓ) → IsUnit (Ao : ZMod m) →
      ∀ (ψN ψD : ℝ → ℝ), ContDiff ℝ ∞ ψN → ContDiff ℝ ∞ ψD →
      Function.support ψN ⊆ Set.Icc cN TN →
      Function.support ψD ⊆ Set.Icc cD TD →
      ∀ j : ℕ,
      let χ : ℝ → ℝ := fun u => ψD u * u ^ j
      (∀ (r : ℕ) (u : ℝ), |iteratedDeriv r χ u| ≤ Cφ r * (Real.log x) ^ Eφ r) →
      (∀ (r : ℕ) (u : ℝ), |iteratedDeriv r ψN u| ≤ CN r * (Real.log x) ^ EN r) →
      let s₂ : ℕ := Nat.gcd w₂ m
      let g₀ : ℕ := Int.gcd (q₀ : ℤ) ℓ
      let Tcut : ℝ := max ((s₂ : ℝ)⁻¹) H⁻¹ *
        (x ^ (δ + 100 * ε) * H ^ 2 * N / ((g : ℝ) * Δ₁))
      let Rtarget : ℝ := max (x ^ (δ + 10 * ε) * H ^ 3) (H ^ 4)
      ‖∑' d : ℕ, sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
        Ao Bo ℓ E ψN ψD N Δ₁ d₀ j y y' (Tcut : WithTop ℝ) d‖ ≤
        K * (s₂ : ℝ) * (q₀ : ℝ) ^ 2 * (g₀ : ℝ) ^ 2 * N ^ 2 /
          (κ ^ 2 * x ^ (27 * ε) * Rtarget) := by
  intro «ω» δ ε C cN TN cD TD hω hδ hε hC hcN hNT hcD hDT
    Cφ Eφ CN EN hCφ hCN
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hTD : 0 < TD := hcD.trans_le hDT
  have hDT' : cD ≤ TD + 1 := hDT.trans (le_add_of_nonneg_right zero_le_one)
  have hC₇ : 1 ≤ C ^ 7 := one_le_pow₀ hC
  have hCΛ : 1 ≤ 4 * C ^ 3 := by
    have hC₃ : 1 ≤ C ^ 3 := one_le_pow₀ hC
    linarith only [hC₃]
  have hCw : 1 ≤ C + TD := by linarith only [hC, hTD]
  obtain ⟨Xdict, hXdict, hDictionary⟩ :=
    sourceSigmaFour_terminal_dictionary «ω» δ ε C cN TN cD TD
      hω hδ hε hC hcN hNT hcD hDT
  obtain ⟨K, Xterm, hK, _, hTerminal⟩ :=
    sourceTerminalSigma5_retreated_bound_of_deligne hDeligne
      «ω» δ ε cD (TD + 1) cN TN (1 / (2 * C))
      hω hδ hε hcD hDT' hcN hNT (by positivity)
      C C C C C (C ^ 7) (4 * C ^ 3) (C + TD) C (1 / C ^ 6)
      hC hC hC hC hC hC₇ hCΛ hCw hC (by positivity)
      Cφ Eφ CN EN hCφ hCN
  refine ⟨K, max Xdict Xterm, hK, hXdict.trans (le_max_left _ _), ?_⟩
  intro x hx m r₁ q₀ u₁ v₁ v₂ q₂ g hm hmeq hq₀Nat hg
    M N R₀ Q H Δ d₀ κ γ hM hN hR₀ hQ hΔ hH hκ
    hNγ hγlo hγhi hMNlo hMNhi hNR hRQ hHdef hΔlo hΔhi hd₀
    Δ₁ hκupper hmlower hmupper w₀ w₁ w₂ hw₁ hw₀ hw₁sq hw₁cop hwupper
    y y' Y hydiv hy'div hyband hy'band hw₂y hw₂y' hΛupper
    Ao Bo ℓ E hE hAo ψN ψD hψN hψD hsN hsD j χ hχ hψNderiv
    s₂ g₀ Tcut Rtarget
  let : NeZero m := ⟨hm.ne_zero⟩
  let : NeZero q₀ := ⟨hq₀Nat.ne'⟩
  have hxDict : Xdict ≤ x := (le_max_left _ _).trans hx
  have hxTerm : Xterm ≤ x := (le_max_right _ _).trans hx
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le (hXdict.trans hxDict)
  have hHpos : 0 < H := zero_lt_one.trans_le hH
  have hpow (a : ℝ) : 0 < x ^ a := Real.rpow_pos_of_pos hxpos a
  let dInt : ℤ := ⌊d₀⌋
  let shift : ℝ := ((dInt : ℝ) - d₀) / Δ₁
  let z₁ : ℕ := w₀ * w₁
  let s : ℕ := z₁ / w₁
  let lam : ℤ := y / (w₁ : ℤ)
  let lamTilde : ℤ := y' / (w₁ : ℤ)
  let Λ : ℝ := Y / (w₁ : ℝ)
  let c₁ : ℕ := r₁ * q₀ * u₁ * Nat.lcm v₁ v₂
  let c₂ : ℕ := q₀ * q₂
  let l : ℤ := ℓ * (z₁ : ℤ) * (r₁ : ℤ)
  let An : ℤ := (((Ao : ZMod m) * (w₁ : ZMod m) * (z₁ : ZMod m)⁻¹).val : ℤ)
  let Bn : ℤ := (((Bo : ZMod m) * (z₁ : ZMod m)).val : ℤ)
  let En : ZMod q₀ → Finset (ZMod q₀) := fun r => E ((z₁ : ZMod q₀) * r)
  let φ : ℝ → ℂ := fun u => (χ (u + shift) : ℂ)
  let ψ : ℝ → ℂ := fun u => (ψN u : ℂ)
  obtain ⟨hΔ₁one, hdInt, _, _, hDictionaryAt⟩ :=
    hDictionary x hxDict m r₁ q₀ u₁ v₁ v₂ q₂ hmeq
      M N R₀ Q H Δ d₀ γ hM hN hR₀ hQ hΔ hMNlo hNγ
      ((le_max_left _ _).trans hγlo) hNR hRQ hHdef hΔlo hd₀
  obtain ⟨hz₁, hwz, _, hzm, hqm, hc₁m, hc₂m, _, _,
      _, _, hΛ, hlam, hlamTilde, hw₂lam, hw₂lamTilde,
      _, _, _, _, _, hAnunit, _, hEn, _, hφ, hψ,
      hsφ, hsψ, hderiv, _, _, _, _, _, _, _, hsum, _, _, _⟩ :=
    hDictionaryAt w₀ w₁ w₂ hw₁ hw₀ hw₁cop y y' Y hydiv hy'div
      hyband hy'band hw₂y hw₂y' Ao Bo ℓ Tcut E hE
      ψN ψD hψN hψD hsN hsD j
  have hΔ₁ : 0 < Δ₁ := zero_lt_one.trans_le hΔ₁one
  have hscale : x ^ (5 * ε) * Δ₁ = Δ := by
    dsimp only [Δ₁]
    rw [← mul_assoc, ← Real.rpow_add hxpos,
      show 5 * ε + -5 * ε = 0 by ring, Real.rpow_zero, one_mul]
  have hΔlower : N ≤ C * x ^ (δ + 55 * ε) * H ^ 2 * Δ₁ := by
    calc
      N ≤ C * x ^ (δ + 50 * ε) * H ^ 2 * Δ := hΔlo
      _ = C * x ^ (δ + 55 * ε) * H ^ 2 * Δ₁ := by
        rw [← hscale,
          show δ + 55 * ε = (δ + 50 * ε) + 5 * ε by ring,
          Real.rpow_add hxpos (δ + 50 * ε) (5 * ε)]
        ring
  have hΔupper : Δ₁ ≤ C * N / (x ^ (55 * ε) * H ^ 2) := by
    apply (le_div_iff₀ (mul_pos (hpow (55 * ε)) (pow_pos hHpos 2))).2
    calc
      Δ₁ * (x ^ (55 * ε) * H ^ 2) = Δ * (x ^ (50 * ε) * H ^ 2) := by
        rw [← hscale, show 55 * ε = 5 * ε + 50 * ε by ring,
          Real.rpow_add hxpos (5 * ε) (50 * ε)]
        ring
      _ ≤ C * N :=
        (le_div_iff₀ (mul_pos (hpow (50 * ε)) (pow_pos hHpos 2))).1 hΔhi
  have hbφ (r : ℕ) (t : ℝ) :
      ‖iteratedDeriv r φ t‖ ≤ Cφ r * (Real.log x) ^ Eφ r := by
    rw [(hderiv r t).1, Complex.norm_real, Real.norm_eq_abs]
    exact hχ r (t + shift)
  have hbψ (r : ℕ) (t : ℝ) :
      ‖iteratedDeriv r ψ t‖ ≤ CN r * (Real.log x) ^ EN r := by
    rw [(hderiv r t).2, Complex.norm_real, Real.norm_eq_abs]
    exact hψNderiv r t
  by_cases hprimitive : Int.gcd (s : ℤ) ((m : ℤ) * lam * lamTilde) = 1
  · have hmain :=
      hTerminal x hxTerm m q₀ c₁ c₂ w₁ w₂ z₁ g hm hqm hc₁m hc₂m hg
        hw₁ hw₁sq hz₁ hwz hzm M N R₀ Q H Δ₁ Λ κ γ
        hM hR₀ hQ hH hΔ₁ hΛ hκ hNγ hγlo hγhi hMNlo hMNhi hNR hRQ
        hHdef hκupper hΔlower hΔupper hmlower hmupper hwupper hΛupper
        lam lamTilde l ℓ An Bn dInt hdInt hlam hlamTilde hw₂lam hw₂lamTilde
        hprimitive (hAnunit.2 hAo) En hEn φ ψ hφ hψ hsφ hsψ hbφ hbψ
    rw [hsum.tsum_eq, ite_eq_left hprimitive]
    exact hmain.2.trans_eq (by
      change
        K * ((s₂ : ℝ) * (q₀ : ℝ) ^ 2 * (g₀ : ℝ) ^ 2 * N ^ 2 /
          (κ ^ 2 * x ^ (27 * ε) * Rtarget)) =
        K * (s₂ : ℝ) * (q₀ : ℝ) ^ 2 * (g₀ : ℝ) ^ 2 * N ^ 2 /
          (κ ^ 2 * x ^ (27 * ε) * Rtarget)
      ring)
  · rw [hsum.tsum_eq, ite_eq_right hprimitive, norm_zero]
    dsimp only [s₂, g₀, Rtarget]
    positivity

theorem sourceSigmaOne_uniform_secondary_bound
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    («ω» δ ε C₁ cM TM cN TN : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε)
    (hworking : 72 * «ω» + 24 * δ < 1) (hsmall : ε < δ / 10 ^ 100)
    (hεsmall : ε < 1 / 1000) (hC₁ : 1 ≤ C₁)
    (hcM : 0 < cM) (hMT : cM ≤ TM) (hcN : 0 < cN) (hNT : cN ≤ TN)
    (CM EM CN EN CD : ℕ → ℝ)
    (henvelopes : ∀ j : ℕ, 0 ≤ CM j ∧ 0 ≤ CN j ∧ 0 ≤ CD j) :
    ∃ K₂ Xtwo : ℝ, 0 < K₂ ∧ Real.exp 1 ≤ Xtwo ∧
      ∀ (x : ℝ), Xtwo ≤ x →
      ∀ (r₁ q₀ u₁ v₁ v₂ q₂ aN b₁N b₂N : ℕ) (ℓ : ℤ),
      0 < r₁ → 0 < q₀ → 0 < u₁ → 0 < v₁ → 0 < v₂ → 0 < q₂ →
      Squarefree (r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂) →
      Nat.Coprime (r₁ * q₀ * u₁ * v₁ * v₂ * q₂) (aN * b₁N * b₂N) →
      ∀ (M N R₀ Q U V H Hstar Δ d₀ γ : ℝ),
      0 < M → 0 < N → 0 < R₀ → 0 < Q → 0 < U → 0 < V → 1 ≤ Δ →
      x / C₁ ≤ M * N → M * N ≤ C₁ * x → N = x ^ γ →
      max (1 / 4 + 12 * «ω» + 4 * δ + 100 * ε)
        (32 * «ω» + 10 * δ + 400 * ε) ≤ γ →
      γ ≤ 1 / 2 - 4 * «ω» - 2 * δ - 50 * ε →
      N ≤ C₁ * x ^ (δ + 4 * ε) * R₀ →
      R₀ ≤ C₁ * x ^ (-2 * ε) * N →
      x ^ (1 / 2 - ε) ≤ C₁ * R₀ * Q →
      R₀ * Q ≤ C₁ * x ^ (1 / 2 + 2 * «ω» + ε) →
      H = x ^ ε * R₀ * Q ^ 2 / ((q₀ : ℝ) * M) → 1 ≤ H →
      x ^ (-δ - 5 * ε) * Q / ((q₀ : ℝ) * H) ≤ C₁ * U →
      U ≤ C₁ * x ^ (-5 * ε) * Q / H →
      x ^ (5 * ε) * H / (q₀ : ℝ) ≤ C₁ * V →
      V ≤ C₁ * x ^ (δ + 5 * ε) * H →
      Q / (q₀ : ℝ) ≤ C₁ * U * V → U * V ≤ C₁ * Q / (q₀ : ℝ) →
      R₀ / C₁ ≤ (r₁ : ℝ) * Δ → (r₁ : ℝ) * Δ ≤ C₁ * R₀ →
      U / C₁ ≤ (u₁ : ℝ) → (u₁ : ℝ) ≤ C₁ * U →
      V / C₁ ≤ (v₁ : ℝ) → (v₁ : ℝ) ≤ C₁ * V →
      V / C₁ ≤ (v₂ : ℝ) → (v₂ : ℝ) ≤ C₁ * V →
      Q / (C₁ * (q₀ : ℝ)) ≤ (q₂ : ℝ) → (q₂ : ℝ) ≤ C₁ * Q / (q₀ : ℝ) →
      (q₀ : ℝ) ≤ C₁ * Q →
      (∀ p ∈ q₀.primeFactors,
        Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (p : ℝ)) →
      N ≤ C₁ * x ^ (δ + 50 * ε) * H ^ 2 * Δ →
      Δ ≤ C₁ * N / (x ^ (50 * ε) * H ^ 2) → Δ / C₁ ≤ d₀ → d₀ ≤ C₁ * Δ →
      ℓ ≠ 0 → |(ℓ : ℝ)| ≤ C₁ * N / R₀ →
      Hstar ≠ 0 → 1 ≤ C₁ * |Hstar| → |Hstar| ≤ C₁ * H →
      1 ≤ N → N ≤ x → R₀ ≤ x ^ (2 : ℕ) → Q ≤ x ^ (4 : ℕ) →
      H ≤ x ^ (12 : ℕ) → U ≤ x ^ (5 : ℕ) → C₁ * V ≤ x ^ (15 : ℕ) →
      ∀ (ψM ψN ψD : ℝ → ℝ),
      ContDiff ℝ ∞ ψM → ContDiff ℝ ∞ ψN → ContDiff ℝ ∞ ψD →
      Function.support ψM ⊆ Set.Icc cM TM →
      Function.support ψN ⊆ Set.Icc cN TN →
      Function.support ψD ⊆ Set.Icc (1 / 2) (5 / 2) →
      (∀ t : ℝ, 0 ≤ ψM t ∧ 0 ≤ ψN t) →
      (∀ t : ℝ, 0 ≤ ψD t ∧ ψD t ≤ 1) →
      (∀ (j : ℕ) (t : ℝ),
        |iteratedDeriv j ψM t| ≤ CM j * (Real.log x) ^ EM j ∧
        |iteratedDeriv j ψN t| ≤ CN j * (Real.log x) ^ EN j) →
      (∀ (j : ℕ) (t : ℝ),
        |iteratedDeriv j ψD t| ≤ CD j * (Real.log x) ^ (0 : ℝ)) →
      let Hbound : ℕ := ⌊2 * |Hstar|⌋₊
      let J : Finset ℤ :=
        (Finset.Icc (-(Hbound : ℤ)) (Hbound : ℤ)).filter
          (fun h => 1 ≤ (h : ℝ) / Hstar ∧ (h : ℝ) / Hstar < 2)
      (∀ h ∈ J, h ≠ 0 ∧ |(h : ℝ)| ≤ 2 * C₁ * H) →
      sourceSigmaTwo J ψM (fun z => ψN (z / N)) ψD M (x ^ (-5 * ε) * Δ) d₀
        r₁ q₀ u₁ v₁ v₂ q₂ aN b₁N b₂N ℓ ≤
          K₂ * (q₀ : ℝ) * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * Δ * N *
            (Nat.gcd v₁ v₂ : ℝ) * x ^ (-10 * ε) := by
  classical
  have hFiniteEnvelope (J₀ : ℕ) (A E : ℕ → ℕ → ℝ)
      (hA : ∀ j k : ℕ, 0 ≤ A j k) :
      ∃ Abar Ebar : ℕ → ℝ, (∀ k, 0 ≤ Abar k) ∧
        ∀ j ≤ J₀, ∀ (k : ℕ) (L : ℝ), 1 ≤ L →
          A j k * L ^ E j k ≤ Abar k * L ^ Ebar k := by
    clear * - hA
    let S : Finset ℕ := Finset.range (J₀ + 1)
    have hS : S.Nonempty := by simp [S]
    let Abar : ℕ → ℝ := fun k => ∑ j ∈ S, A j k
    let Ebar : ℕ → ℝ := fun k => S.sup' hS (fun j => max 0 (E j k))
    have hAbar : ∀ k, 0 ≤ Abar k := fun k => Finset.sum_nonneg fun j _ => hA j k
    refine ⟨Abar, Ebar, hAbar, ?_⟩
    intro j hj k L hL
    have hjS : j ∈ S := Finset.mem_range.mpr (Nat.lt_succ_of_le hj)
    have hAj : A j k ≤ Abar k := Finset.single_le_sum (fun i _ => hA i k) hjS
    have hEj : E j k ≤ Ebar k :=
      (le_max_right (0 : ℝ) (E j k)).trans
        (Finset.le_sup' (fun j => max 0 (E j k)) hjS)
    exact mul_le_mul hAj (Real.rpow_le_rpow_of_exponent_le hL hEj)
      (Real.rpow_nonneg (zero_le_one.trans hL) _) (hAbar k)
  have hThreeFinish (x ε C K₃ K₅ R s₂ qg N κ A S : ℝ)
      (hx : 1 ≤ x) (hε : 0 < ε)
      (hK₃ : 0 ≤ K₃) (hR : 0 < R) (hs₂ : 0 < s₂)
      (hκ : 0 < κ) (hκupper : κ ≤ C * qg)
      (hA : A ≤ K₅ * s₂ * qg ^ 2 * N ^ 2 / (κ ^ 2 * x ^ (27 * ε) * R))
      (hS : S ≤ K₃ * R / s₂ * A + K₃ * x ^ (-47 * ε) * N ^ 2) :
      S ≤ K₃ * (K₅ + C ^ 2) * qg ^ 2 * N ^ 2 / (κ ^ 2 * x ^ (27 * ε)) := by
    clear * - hx hε hK₃ hR hs₂ hκ hκupper hA hS
    have hx0 : 0 < x := zero_lt_one.trans_le hx
    have hpow (a : ℝ) : 0 < x ^ a := Real.rpow_pos_of_pos hx0 a
    have hκsq : κ ^ 2 ≤ C ^ 2 * qg ^ 2 := by
      simpa only [mul_pow] using pow_le_pow_left₀ hκ.le hκupper 2
    have hfactor : 1 ≤ C ^ 2 * qg ^ 2 / κ ^ 2 :=
      (one_le_div (sq_pos_of_pos hκ)).mpr hκsq
    have herr : x ^ (-47 * ε) * N ^ 2 ≤
        C ^ 2 * qg ^ 2 * N ^ 2 / (κ ^ 2 * x ^ (27 * ε)) := by
      calc
        _ ≤ x ^ (-27 * ε) * N ^ 2 := mul_le_mul_of_nonneg_right
          (Real.rpow_le_rpow_of_exponent_le hx (by linarith)) (sq_nonneg N)
        _ ≤ (C ^ 2 * qg ^ 2 / κ ^ 2) * (x ^ (-27 * ε) * N ^ 2) :=
          le_mul_of_one_le_left (by positivity) hfactor
        _ = _ := by
          rw [show -27 * ε = -(27 * ε) by ring, Real.rpow_neg hx0.le]
          ring
    have hmain : K₃ * R / s₂ * A ≤
        K₃ * K₅ * qg ^ 2 * N ^ 2 / (κ ^ 2 * x ^ (27 * ε)) := by
      calc
        _ ≤ K₃ * R / s₂ *
            (K₅ * s₂ * qg ^ 2 * N ^ 2 / (κ ^ 2 * x ^ (27 * ε) * R)) :=
          mul_le_mul_of_nonneg_left hA (by positivity)
        _ = _ := by
          field_simp [hs₂.ne', hR.ne', hκ.ne', (hpow (27 * ε)).ne']
    calc
      S ≤ K₃ * R / s₂ * A + K₃ * x ^ (-47 * ε) * N ^ 2 := hS
      _ ≤ K₃ * K₅ * qg ^ 2 * N ^ 2 / (κ ^ 2 * x ^ (27 * ε)) +
          K₃ * (C ^ 2 * qg ^ 2 * N ^ 2 / (κ ^ 2 * x ^ (27 * ε))) :=
        add_le_add hmain (by simpa only [mul_assoc] using mul_le_mul_of_nonneg_left herr hK₃)
      _ = _ := by ring
  have hTwoFinish (x ε K A qg κ Δ N g S Z : ℝ)
      (hx : 1 ≤ x) (hεsmall : ε < 1 / 1000)
      (hK : 0 ≤ K) (hA : 0 ≤ A) (hqg : 1 ≤ qg) (hκ : 0 < κ)
      (hΔ : 1 ≤ Δ) (hN : 1 ≤ N) (hg : 1 ≤ g)
      (hS : S ≤ A * qg ^ 2 * N ^ 2 / (κ ^ 2 * x ^ (27 * ε)))
      (hZ : Z ≤ K * x ^ (7 * ε / 2) * g * κ * Δ * Real.sqrt S + K * x ^ (-100 : ℝ)) :
      Z ≤ K * (Real.sqrt A + 1) * qg * Δ * N * g * x ^ (-10 * ε) := by
    clear * - hx hεsmall hK hA hqg hκ hΔ hN hg hS hZ
    have hx0 : 0 < x := zero_lt_one.trans_le hx
    have hpow (a : ℝ) : 0 < x ^ a := Real.rpow_pos_of_pos hx0 a
    let W : ℝ := Real.sqrt A * qg * N / κ * x ^ (-27 * ε / 2)
    have hW : 0 ≤ W := by dsimp only [W]; positivity
    have hWsq : W ^ 2 = A * qg ^ 2 * N ^ 2 / (κ ^ 2 * x ^ (27 * ε)) := by
      dsimp only [W]
      rw [mul_pow, div_pow, mul_pow, mul_pow, Real.sq_sqrt hA,
        ← Real.rpow_mul_natCast hx0.le]
      simp only [Nat.cast_ofNat]
      rw [show (-27 * ε / 2) * (2 : ℝ) = -(27 * ε) by ring,
        Real.rpow_neg hx0.le]
      ring
    have hsqrt : Real.sqrt S ≤ W := Real.sqrt_le_iff.mpr ⟨hW, hS.trans_eq hWsq.symm⟩
    have hp : x ^ (7 * ε / 2) * x ^ (-27 * ε / 2) = x ^ (-10 * ε) := by
      rw [← Real.rpow_add hx0]
      congr 1
      ring
    have hmain : K * x ^ (7 * ε / 2) * g * κ * Δ * W =
        K * Real.sqrt A * qg * Δ * N * g * x ^ (-10 * ε) := by
      dsimp only [W]
      rw [← hp]
      field_simp [hκ.ne']
    have hscale : 1 ≤ qg * Δ * N * g :=
      one_le_mul_of_one_le_of_one_le
        (one_le_mul_of_one_le_of_one_le (one_le_mul_of_one_le_of_one_le hqg hΔ) hN) hg
    have herr : x ^ (-100 : ℝ) ≤ qg * Δ * N * g * x ^ (-10 * ε) := by
      exact (Real.rpow_le_rpow_of_exponent_le hx (by linarith)).trans
        (le_mul_of_one_le_left (hpow _).le hscale)
    calc
      Z ≤ K * x ^ (7 * ε / 2) * g * κ * Δ * Real.sqrt S + K * x ^ (-100 : ℝ) := hZ
      _ ≤ K * x ^ (7 * ε / 2) * g * κ * Δ * W +
          K * (qg * Δ * N * g * x ^ (-10 * ε)) :=
        add_le_add (mul_le_mul_of_nonneg_left hsqrt (by positivity))
          (mul_le_mul_of_nonneg_left herr hK)
      _ = _ := by rw [hmain]; ring
  have hNormalizedFrequencyBand (C H V : ℝ) (hC : 1 ≤ C) (hH : 0 < H) (_ : 0 < V)
      (v₁ v₂ : ℕ) (hv₁ : 0 < v₁) (_ : 0 < v₂)
      (hv₁bound : (v₁ : ℝ) ≤ C * V) (hv₂bound : (v₂ : ℝ) ≤ C * V)
      (J : Finset ℤ) (hJ : ∀ h ∈ J, |(h : ℝ)| ≤ 2 * C * H) :
      let g := Nat.gcd v₁ v₂
      let φ : ℤ × ℤ → ℤ := fun h =>
        h.1 * ((v₂ / g : ℕ) : ℤ) - h.2 * ((v₁ / g : ℕ) : ℤ)
      let L := ((J ×ˢ J).image φ).erase 0
      (∀ y ∈ L, y ≠ 0 ∧ |(y : ℝ)| ≤ 4 * C ^ 2 * H * V / (g : ℝ)) ∧
      (∀ y ∈ L, ∀ Y : ℝ, 1 ≤ (y : ℝ) / Y → (y : ℝ) / Y < 2 →
        ∀ w₁ : ℕ, 0 < w₁ → ∀ x δ ε : ℝ, 1 ≤ x →
          V ≤ C * x ^ (δ + 5 * ε) * H →
          Y ≠ 0 ∧ |Y / (w₁ : ℝ)| ≤
            4 * C ^ 3 * x ^ (δ + 5 * ε) * H ^ 2 / ((w₁ : ℝ) * (g : ℝ))) := by
    clear * - hC hH hv₁ hv₁bound hv₂bound hJ
    classical
    intro g φ L
    have hCpos : 0 < C := zero_lt_one.trans_le hC
    have hg : 0 < (g : ℝ) := by
      exact_mod_cast Nat.gcd_pos_of_pos_left v₂ hv₁
    have hc₁ : ((v₁ / g : ℕ) : ℝ) ≤ C * V / (g : ℝ) :=
      Nat.cast_div_le.trans (div_le_div_of_nonneg_right hv₁bound hg.le)
    have hc₂ : ((v₂ / g : ℕ) : ℝ) ≤ C * V / (g : ℝ) :=
      Nat.cast_div_le.trans (div_le_div_of_nonneg_right hv₂bound hg.le)
    have hpoint (y : ℤ) (hy : y ∈ L) :
        y ≠ 0 ∧ |(y : ℝ)| ≤ 4 * C ^ 2 * H * V / (g : ℝ) := by
      obtain ⟨hyzero, hyimage⟩ := Finset.mem_erase.mp hy
      obtain ⟨h, hh, hφ⟩ := Finset.mem_image.mp hyimage
      obtain ⟨hh₁, hh₂⟩ := Finset.mem_product.mp hh
      refine ⟨hyzero, ?_⟩
      rw [← hφ]
      change |((h.1 * ((v₂ / g : ℕ) : ℤ) -
        h.2 * ((v₁ / g : ℕ) : ℤ) : ℤ) : ℝ)| ≤ _
      rw [Int.cast_sub, Int.cast_mul, Int.cast_mul, Int.cast_natCast, Int.cast_natCast]
      calc
        |(h.1 : ℝ) * ((v₂ / g : ℕ) : ℝ) -
            (h.2 : ℝ) * ((v₁ / g : ℕ) : ℝ)| ≤
            |(h.1 : ℝ) * ((v₂ / g : ℕ) : ℝ)| +
              |(h.2 : ℝ) * ((v₁ / g : ℕ) : ℝ)| := abs_sub _ _
        _ = |(h.1 : ℝ)| * ((v₂ / g : ℕ) : ℝ) +
            |(h.2 : ℝ)| * ((v₁ / g : ℕ) : ℝ) := by
          rw [abs_mul, abs_mul,
            abs_of_nonneg (Nat.cast_nonneg (v₂ / g) : (0 : ℝ) ≤ ((v₂ / g : ℕ) : ℝ)),
            abs_of_nonneg (Nat.cast_nonneg (v₁ / g) : (0 : ℝ) ≤ ((v₁ / g : ℕ) : ℝ))]
        _ ≤ (2 * C * H) * (C * V / (g : ℝ)) +
            (2 * C * H) * (C * V / (g : ℝ)) :=
          add_le_add
            (mul_le_mul (hJ h.1 hh₁) hc₂ (Nat.cast_nonneg _) (by positivity))
            (mul_le_mul (hJ h.2 hh₂) hc₁ (Nat.cast_nonneg _) (by positivity))
        _ = 4 * C ^ 2 * H * V / (g : ℝ) := by ring
    refine ⟨hpoint, ?_⟩
    intro y hy Y hlower _ w₁ hw₁ x δ ε _ hVupper
    have hY : Y ≠ 0 := by
      intro hzero
      simp only [hzero, div_zero] at hlower
      norm_num at hlower
    have hw : 0 < (w₁ : ℝ) := by exact_mod_cast hw₁
    have habsY : |Y| ≤ |(y : ℝ)| := by
      have hratio : 1 ≤ |(y : ℝ) / Y| := hlower.trans (le_abs_self _)
      rw [abs_div] at hratio
      exact (one_le_div (abs_pos.mpr hY)).1 hratio
    refine ⟨hY, ?_⟩
    calc
      |Y / (w₁ : ℝ)| = |Y| / (w₁ : ℝ) := by rw [abs_div, abs_of_pos hw]
      _ ≤ |(y : ℝ)| / (w₁ : ℝ) := div_le_div_of_nonneg_right habsY hw.le
      _ ≤ (4 * C ^ 2 * H * V / (g : ℝ)) / (w₁ : ℝ) :=
        div_le_div_of_nonneg_right (hpoint y hy).2 hw.le
      _ ≤ (4 * C ^ 2 * H * (C * x ^ (δ + 5 * ε) * H) / (g : ℝ)) /
          (w₁ : ℝ) :=
        div_le_div_of_nonneg_right
          (div_le_div_of_nonneg_right
            (mul_le_mul_of_nonneg_left hVupper (by positivity)) hg.le) hw.le
      _ = 4 * C ^ 3 * x ^ (δ + 5 * ε) * H ^ 2 /
          ((w₁ : ℝ) * (g : ℝ)) := by
        field_simp [ne_of_gt hw, ne_of_gt hg]
  have hC₁pos : 0 < C₁ := zero_lt_one.trans_le hC₁
  obtain ⟨J₀, CDpoly, EDpoly, hCDpoly, Kss, Xss, hKss, hXss, hSecondary⟩ :=
    sourceSigmaTwo_uniform_secondary_reduction «ω» δ ε C₁ 100 cM TM cN TN (1 / 2) (5 / 2)
      hω hδ hε hworking hsmall hC₁ (by norm_num) hcM hMT hcN hNT
      (by norm_num) (by norm_num) CM EM CN EN CD (fun _ => 0)
      (fun j => ⟨(henvelopes j).1, (henvelopes j).2.1, (henvelopes j).2.2⟩)
  obtain ⟨Cφ, Eφ, hCφ, hφEnvelope⟩ := hFiniteEnvelope J₀ CDpoly EDpoly hCDpoly
  obtain ⟨Kfour, Xfour, hKfour, hXfour, hFourAt⟩ :=
    sourceSigmaOne_sigmaFour_bound hDeligne «ω» δ ε C₁ cN TN (1 / 2) (5 / 2)
      hω hδ hε hC₁ hcN hNT (by norm_num) (by norm_num)
      Cφ Eφ CN EN hCφ (fun j => (henvelopes j).2.1)
  obtain ⟨Kthree, Xthree, hKthree, hXthree, hThreeAt⟩ :=
    sourceSigmaThree_uniform_large_gcd_truncation δ ε (2 * C₁) 100
      cN TN (1 / 2) (5 / 2) (CN 0) (EN 0) (CD 0) 0 J₀
      hδ hε (by linarith) (by norm_num) hcN hNT (by norm_num) (by norm_num)
      (henvelopes 0).2.1 (henvelopes 0).2.2
  let K₃ : ℝ := Kthree * (Kfour + C₁ ^ 2)
  let K₂ : ℝ := Kss * (Real.sqrt K₃ + 1)
  have hK₃ : 0 < K₃ := by dsimp only [K₃]; positivity
  have hK₂ : 0 < K₂ := by dsimp only [K₂]; positivity
  let thresholds : Finset ℝ := {Real.exp 1, 3, C₁, Xss, Xfour, Xthree}
  have hthresholds : thresholds.Nonempty := ⟨Real.exp 1, by simp [thresholds]⟩
  let Xtwo : ℝ := thresholds.sup' hthresholds id
  have hthreshold (z : ℝ) (hz : z ∈ thresholds) : z ≤ Xtwo := Finset.le_sup' id hz
  refine ⟨K₂, Xtwo, hK₂, hthreshold _ (by simp [thresholds]), ?_⟩
  intro x hx r₁ q₀ u₁ v₁ v₂ q₂ aN b₁N b₂N ℓ
    hr₁ hq₀ hu₁ hv₁ hv₂ hq₂ hsq hcop M N R₀ Q U V H Hstar Δ d₀ γ
    hM hN hR₀ hQ hU hV hΔone hMNlo₁ hMNhi₁ hNγ hγlo hγhi
    hNR₁ hRhi₁ hRQlo₁ hRQhi₁ hHdef hH hUlo₁ hUhi₁ hVlo₁ hVhi₁ hUVlo₁ hUVhi₁
    hrlo hrhi hulo huhi hv₁lo hv₁hi hv₂lo hv₂hi hq₂lo hq₂hi hq₀Q₁ hrough
    hΔlo hΔhi hd₀lo hd₀hi hℓne hℓbound₁ hHstarne hHstarlo₁ hHstarhi₁
    hNone hNx hRx hQx hHx hUx hCVx ψM ψN ψD hψM hψN hψD hsM hsN hsD
    hvalues hDvalues hderivatives hDderiv Hbound J hJdata
  have hxt (z : ℝ) (hz : z ∈ thresholds) : z ≤ x := (hthreshold z hz).trans hx
  have hxe : Real.exp 1 ≤ x := hxt _ (by simp [thresholds])
  have hx3 : 3 ≤ x := hxt _ (by simp [thresholds])
  have hxC : C₁ ≤ x := hxt _ (by simp [thresholds])
  have hxss : Xss ≤ x := hxt _ (by simp [thresholds])
  have hxfour : Xfour ≤ x := hxt _ (by simp [thresholds])
  have hxthree : Xthree ≤ x := hxt _ (by simp [thresholds])
  have hx1 : 1 ≤ x := by linarith
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hpow (z : ℝ) : 0 < x ^ z := Real.rpow_pos_of_pos hx0 z
  have hlogx : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hxe
  have hq₀one : (1 : ℝ) ≤ (q₀ : ℝ) := by exact_mod_cast hq₀
  have hq₀real : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀
  have hHpos : 0 < H := zero_lt_one.trans_le hH
  let g₀ : ℕ := Int.gcd (q₀ : ℤ) ℓ
  have hg₀nat : 0 < g₀ := Int.gcd_pos_of_ne_zero_left ℓ (by exact_mod_cast hq₀.ne')
  have hg₀one : (1 : ℝ) ≤ (g₀ : ℝ) := by exact_mod_cast hg₀nat
  let : NeZero q₀ := ⟨hq₀.ne'⟩
  clear * - hδ hε hThreeFinish hTwoFinish hNormalizedFrequencyBand hC₁ hC₁pos hεsmall hψD
    hsD hDvalues hKss hSecondary hφEnvelope hFourAt hKthree hKfour hThreeAt hK₃
    hq₀ hM hN hR₀ hQ hU hV hNγ hγlo hγhi
    hHdef hH hrough hℓne hHstarne hψM hψN hsM hsN hvalues
    hderivatives hxC hxss hxfour hxthree hx1 hx0 hpow hlogx hq₀one
    hq₀real hHpos hg₀one hMNlo₁ hMNhi₁ hNR₁ hRhi₁ hRQlo₁ hRQhi₁ hUlo₁
    hUhi₁ hVlo₁ hVhi₁ hUVlo₁ hUVhi₁ hq₀Q₁ hℓbound₁ hHstarlo₁ hHstarhi₁ hNone
    hNx hJdata hDderiv hRx hQx hHx hUx hCVx hr₁
    hu₁ hv₁ hv₂ hq₂ hsq hcop hΔone hrlo hrhi hulo
    huhi hv₁lo hv₁hi hv₂lo hv₂hi hq₂lo hq₂hi hΔlo hΔhi hd₀lo
    hd₀hi
  let m : ℕ := r₁ * q₀ * u₁ * Nat.lcm v₁ v₂ * q₂
  let g : ℕ := Nat.gcd v₁ v₂
  let κ : ℝ := max 1 (x ^ (5 * ε) * H / V)
  let Δ₁ : ℝ := x ^ (-5 * ε) * Δ
  let E : ZMod q₀ → Finset (ZMod q₀) := fun r =>
    if IsUnit r then Finset.univ.filter (fun n =>
      IsUnit (n * (n + (ℓ : ZMod q₀) * r * (r₁ : ZMod q₀))) ∧
      (b₁N : ZMod q₀) * n⁻¹ =
        (b₂N : ZMod q₀) * (n + (ℓ : ZMod q₀) * r * (r₁ : ZMod q₀))⁻¹)
    else ∅
  obtain ⟨A, B, -, -, -, -, -, -, hAcoprime, hEcard, -, -, hSecondaryAt⟩ :=
    hSecondary x hxss r₁ q₀ u₁ v₁ v₂ q₂ aN b₁N b₂N
      ⟨hr₁, hq₀, hu₁, hv₁, hv₂, hq₂⟩ hsq hcop ℓ
  obtain ⟨hpoly, -, -, -, -, -, -, -, -, -, -, hFinal⟩ :=
    hSecondaryAt M N R₀ Q U V H Hstar Δ d₀ γ
      hM hN hR₀ hQ hU hV (zero_lt_one.trans_le hΔone)
      hMNlo₁ hMNhi₁ hNγ hγlo hγhi hNR₁ hRhi₁ hRQlo₁ hRQhi₁ hHdef hH
      hUlo₁ hUhi₁ hVlo₁ hVhi₁ hUVlo₁ hUVhi₁ hrlo hrhi hulo huhi
      hv₁lo hv₁hi hv₂lo hv₂hi hq₂lo hq₂hi hq₀Q₁ hrough hΔlo hΔhi hd₀lo hd₀hi
      hℓne hℓbound₁ hHstarne hHstarlo₁ hHstarhi₁
      ψM ψN ψD hψM hψN hψD hsM hsN hsD
      (fun t => ⟨(hvalues t).1, (hvalues t).2, (hDvalues t).1⟩)
      (fun j t => ⟨(hderivatives j t).1, (hderivatives j t).2, hDderiv j t⟩)
  clear hSecondary hSecondaryAt
  obtain ⟨hgNat, hκone, hκupper, hΔ₁pos, hmlower, hmupper⟩ :=
    sourceSigmaOne_modulus_resources x δ ε C₁ R₀ Q U V H Δ hx1 hC₁ hδ.le hε.le
      hR₀ hQ hU hV hHpos (zero_lt_one.trans_le hΔone)
      r₁ q₀ u₁ v₁ v₂ q₂ hr₁ hq₀ hu₁ hv₁ hv₂ hq₂
      hrlo hrhi hulo huhi hv₁lo hv₁hi hv₂lo hv₂hi hq₂lo hq₂hi
      hUVlo₁ hUVhi₁ hVlo₁ hVhi₁
  have hgReal : 0 < (g : ℝ) := by exact_mod_cast hgNat
  have hgOne : (1 : ℝ) ≤ (g : ℝ) := by exact_mod_cast hgNat
  have hmNat : 0 < m := Nat.pos_of_ne_zero hsq.ne_zero
  have hκpos : 0 < κ := zero_lt_one.trans_le hκone
  let : NeZero m := ⟨hsq.ne_zero⟩
  have hΔpos : 0 < Δ := zero_lt_one.trans_le hΔone
  have hΔscale : x ^ (5 * ε) * Δ₁ = Δ := by
    clear * - hx0
    dsimp only [Δ₁]
    rw [← mul_assoc, ← Real.rpow_add hx0,
      show 5 * ε + -5 * ε = 0 by ring, Real.rpow_zero, one_mul]
  have hΔshort : Δ₁ ≤ Δ := by
    clear * - hΔpos hx1 hε
    dsimp only [Δ₁]
    exact mul_le_of_le_one_left hΔpos.le
      (Real.rpow_le_one_of_one_le_of_nonpos hx1 (by linarith))
  have hpow100 (n : ℕ) (hn : n ≤ 100) : x ^ n ≤ x ^ (100 : ℝ) := by
    clear * - hx1 hn
    rw [← Real.rpow_natCast]
    exact Real.rpow_le_rpow_of_exponent_le hx1 (by exact_mod_cast hn)
  have hN100 : N ≤ x ^ (100 : ℝ) := hNx.trans (by simpa using hpow100 1 (by decide))
  have hH100 : H ≤ x ^ (100 : ℝ) := hHx.trans (hpow100 12 (by decide))
  have hCQx : C₁ * Q ≤ x ^ (5 : ℕ) := by
    clear * - hxC hQx hQ hx0
    calc
      C₁ * Q ≤ x * x ^ (4 : ℕ) := mul_le_mul hxC hQx hQ.le hx0.le
      _ = _ := by ring
  have hr₁x : (r₁ : ℝ) ≤ x ^ (3 : ℕ) := by
    clear * - hΔone hrhi hxC hRx hR₀ hx0
    calc
      (r₁ : ℝ) ≤ (r₁ : ℝ) * Δ := le_mul_of_one_le_right (Nat.cast_nonneg _) hΔone
      _ ≤ C₁ * R₀ := hrhi
      _ ≤ x * x ^ (2 : ℕ) := mul_le_mul hxC hRx hR₀.le hx0.le
      _ = _ := by ring
  have hq₀x : (q₀ : ℝ) ≤ x ^ (5 : ℕ) := hq₀Q₁.trans hCQx
  have hu₁x : (u₁ : ℝ) ≤ x ^ (6 : ℕ) := by
    clear * - huhi hxC hUx hU hx0
    calc
      (u₁ : ℝ) ≤ C₁ * U := huhi
      _ ≤ x * x ^ (5 : ℕ) := mul_le_mul hxC hUx hU.le hx0.le
      _ = _ := by ring
  have hv₁x : (v₁ : ℝ) ≤ x ^ (15 : ℕ) := hv₁hi.trans hCVx
  have hv₂x : (v₂ : ℝ) ≤ x ^ (15 : ℕ) := hv₂hi.trans hCVx
  have hq₂x : (q₂ : ℝ) ≤ x ^ (5 : ℕ) :=
    hq₂hi.trans ((div_le_self (mul_pos hC₁pos hQ).le hq₀one).trans hCQx)
  have hm100 : (m : ℝ) ≤ x ^ (100 : ℝ) := by
    clear * - hv₁ hv₂ hpow100 hr₁x hq₀x hu₁x hv₁x hv₂x hq₂x hx0
    have hlcm : (Nat.lcm v₁ v₂ : ℝ) ≤ (v₁ : ℝ) * (v₂ : ℝ) := by
      exact_mod_cast Nat.le_of_dvd (mul_pos hv₁ hv₂) (Nat.lcm_dvd_mul v₁ v₂)
    calc
      (m : ℝ) ≤ (r₁ : ℝ) * (q₀ : ℝ) * (u₁ : ℝ) * (v₁ : ℝ) * (v₂ : ℝ) * (q₂ : ℝ) := by
        have hh := mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left hlcm
            (by positivity : 0 ≤ (r₁ : ℝ) * (q₀ : ℝ) * (u₁ : ℝ)))
          (Nat.cast_nonneg q₂)
        simpa only [m, Nat.cast_mul, mul_assoc] using hh
      _ ≤ x ^ (3 : ℕ) * x ^ (5 : ℕ) * x ^ (6 : ℕ) *
          x ^ (15 : ℕ) * x ^ (15 : ℕ) * x ^ (5 : ℕ) := by
        exact mul_le_mul
          (mul_le_mul
            (mul_le_mul
              (mul_le_mul
                (mul_le_mul hr₁x hq₀x (Nat.cast_nonneg _) (pow_nonneg hx0.le _))
                hu₁x (Nat.cast_nonneg _) (by positivity))
              hv₁x (Nat.cast_nonneg _) (by positivity))
            hv₂x (Nat.cast_nonneg _) (by positivity))
          hq₂x (Nat.cast_nonneg _) (by positivity)
      _ = x ^ (49 : ℕ) := by simp only [← pow_add]
      _ ≤ _ := hpow100 49 (by decide)
  let φ : ℤ × ℤ → ℤ := fun h =>
    h.1 * ((v₂ / g : ℕ) : ℤ) - h.2 * ((v₁ / g : ℕ) : ℤ)
  let L : Finset ℤ := ((J ×ˢ J).image φ).erase 0
  let Dmax : ℕ := ⌊d₀ + (5 / 2 : ℝ) * Δ₁⌋₊
  let W : Finset ℕ := (Finset.Icc 1 Dmax).filter (fun w => Squarefree w ∧ Nat.Coprime w m)
  let supported : ℤ → ℕ := fun y => ∏ p ∈ m.primeFactors, p ^ y.natAbs.factorization p
  let W₂ : Finset ℕ := L.image supported
  let Ys : Finset ℤ := L.image (fun y =>
    Int.sign y * ((2 ^ Nat.log 2 y.natAbs : ℕ) : ℤ))
  let WW : Finset (ℕ × ℕ) := W.biUnion (fun w₁ =>
    (w₁.divisors.filter (fun w₀ => w₀ * w₁ ≤ Dmax)).image (fun w₀ => (w₀, w₁)))
  let P₃ : Finset ((ℕ × ℕ) × ℕ × ℤ × ℕ) := WW ×ˢ W₂ ×ˢ Ys ×ˢ Finset.range (J₀ + 1)
  let S₃ : (ℕ × ℕ) × ℕ × ℤ × ℕ → ℝ := fun p =>
    sourceSigmaThree m r₁ q₀ u₁ v₁ v₂ q₂ p.1.1 p.1.2 p.2.1
      (A.val : ℤ) (B.val : ℤ) ℓ E L ψN ψD N Δ₁ d₀ (p.2.2.1 : ℝ) p.2.2.2
  let qg : ℝ := (q₀ : ℝ) * (g₀ : ℝ)
  let B₃ : ℝ := K₃ * qg ^ 2 * N ^ 2 / (κ ^ 2 * x ^ (27 * ε))
  have hqg : 1 ≤ qg := one_le_mul_of_one_le_of_one_le hq₀one hg₀one
  have hκqg : κ ≤ C₁ * qg := hκupper.trans (by
    dsimp only [qg]
    nlinarith only [mul_le_mul_of_nonneg_left hg₀one
      (mul_pos hC₁pos hq₀real).le])
  have hB₃ : 0 ≤ B₃ := by dsimp only [B₃]; positivity
  have hBand := hNormalizedFrequencyBand C₁ H V hC₁ hHpos hV
    v₁ v₂ hv₁ hv₂ hv₁hi hv₂hi J (fun h hh => (hJdata h hh).2)
  have hAunit : IsUnit ((A.val : ℤ) : ZMod m) := by
    clear * - hAcoprime
    simpa only [Int.cast_natCast] using (ZMod.isUnit_iff_coprime A.val m).mpr hAcoprime
  have hS₃bound : ∀ p ∈ P₃, S₃ p ≤ B₃ := by
    clear hFinal
    rintro ⟨⟨w₀, w₁⟩, w₂, Y, j⟩ hp
    obtain ⟨hww, hw₂Yj⟩ := Finset.mem_product.mp hp
    obtain ⟨hw₂, hYj⟩ := Finset.mem_product.mp hw₂Yj
    obtain ⟨hY, hj⟩ := Finset.mem_product.mp hYj
    have hj₀ : j ≤ J₀ := Nat.le_of_lt_succ (Finset.mem_range.mp hj)
    obtain ⟨w, hw, hpw⟩ := Finset.mem_biUnion.mp hww
    obtain ⟨w', hw', heq⟩ := Finset.mem_image.mp hpw
    obtain ⟨heq₀, heq₁⟩ := Prod.mk.inj heq
    subst w'
    subst w
    obtain ⟨hwD, hw₁sq, hw₁cop⟩ := Finset.mem_filter.mp hw
    have hw₁pos : 0 < w₁ := (Finset.mem_Icc.mp hwD).1
    have hw₀dvd : w₀ ∣ w₁ := Nat.dvd_of_mem_divisors (Finset.mem_filter.mp hw').1
    have hw₁upper : (w₁ : ℝ) ≤ (C₁ + 5 / 2) * x ^ (5 * ε) * Δ₁ := by
      have hwle : (w₁ : ℝ) ≤ (Dmax : ℝ) := by exact_mod_cast (Finset.mem_Icc.mp hwD).2
      have hdpos : 0 < d₀ := (div_pos hΔpos hC₁pos).trans_le hd₀lo
      calc
        (w₁ : ℝ) ≤ (Dmax : ℝ) := hwle
        _ ≤ d₀ + (5 / 2 : ℝ) * Δ₁ := Nat.floor_le (by positivity)
        _ ≤ C₁ * Δ + (5 / 2 : ℝ) * Δ := add_le_add hd₀hi (by gcongr)
        _ = (C₁ + 5 / 2) * x ^ (5 * ε) * Δ₁ := by
          rw [mul_assoc (C₁ + 5 / 2), hΔscale]
          ring
    let s₂ : ℕ := Nat.gcd w₂ m
    let R : ℝ := max (x ^ (δ + 10 * ε) * H ^ 3) (H ^ 4)
    let Tcut : ℝ := max ((s₂ : ℝ)⁻¹) H⁻¹ *
      (x ^ (δ + 100 * ε) * H ^ 2 * N / ((g : ℝ) * Δ₁))
    let pairs : Finset (ℤ × ℤ) := (L ×ˢ L).filter (fun p =>
      1 ≤ (p.1 : ℝ) / (Y : ℝ) ∧ (p.1 : ℝ) / (Y : ℝ) < 2 ∧
      1 ≤ (p.2 : ℝ) / (Y : ℝ) ∧ (p.2 : ℝ) / (Y : ℝ) < 2 ∧
      (w₁ : ℤ) ∣ p.1 ∧ (w₁ : ℤ) ∣ p.2 ∧
      supported p.1 = w₂ ∧ supported p.2 = w₂)
    let f₄ : ℤ × ℤ → ℝ := fun p =>
      ‖∑' d : ℕ, sourceSecondaryDTerm m r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁
        (A.val : ℤ) (B.val : ℤ) ℓ E ψN ψD N Δ₁ d₀ j p.1 p.2 (Tcut : WithTop ℝ) d‖
    let B₄ : ℝ := Kfour * (s₂ : ℝ) * qg ^ 2 * N ^ 2 /
      (κ ^ 2 * x ^ (27 * ε) * R)
    have hs₂pos : 0 < (s₂ : ℝ) := by exact_mod_cast Nat.gcd_pos_of_pos_right w₂ hmNat
    have hRpos : 0 < R := (mul_pos (hpow _) (pow_pos hHpos 3)).trans_le (le_max_left _ _)
    have hB₄ : 0 ≤ B₄ := by dsimp only [B₄]; positivity
    have hf₄ : ∀ p ∈ pairs, f₄ p ≤ B₄ := by
      clear hThreeAt hThreeFinish hTwoFinish
      rintro ⟨y, y'⟩ hyy
      obtain ⟨hLL, hyband, hyband', hy'band, hy'band', hydiv, hy'div, hysup, hy'sup⟩ :=
        Finset.mem_filter.mp hyy
      obtain ⟨hyL, hy'L⟩ := Finset.mem_product.mp hLL
      have hΛ := (hBand.2 y hyL (Y : ℝ) hyband hyband'
        w₁ hw₁pos x δ ε hx1 hVhi₁).2
      have hχ (r : ℕ) (u : ℝ) :
          |iteratedDeriv r (fun z : ℝ => ψD z * z ^ j) u| ≤
            Cφ r * (Real.log x) ^ Eφ r :=
        ((hpoly j hj₀).2.2.2 r u).trans (hφEnvelope j hj₀ r (Real.log x) hlogx)
      have hh := hFourAt x hxfour m r₁ q₀ u₁ v₁ v₂ q₂ g hsq rfl hq₀ hgNat
        M N R₀ Q H Δ d₀ κ γ hM hN hR₀ hQ hΔpos hH hκone hNγ hγlo hγhi
        hMNlo₁ hMNhi₁ hNR₁ hRQhi₁ hHdef hΔlo hΔhi hd₀lo
        hκupper hmlower hmupper w₀ w₁ w₂ hw₁pos hw₀dvd hw₁sq hw₁cop hw₁upper
        y y' (Y : ℝ) hydiv hy'div ⟨hyband, hyband'⟩ ⟨hy'band, hy'band'⟩
        hysup.symm hy'sup.symm hΛ (A.val : ℤ) (B.val : ℤ) ℓ E hEcard hAunit
        ψN ψD hψN hψD hsN hsD j hχ (fun r u => (hderivatives r u).2)
      calc
        f₄ (y, y') ≤ Kfour * (s₂ : ℝ) * (q₀ : ℝ) ^ 2 * (g₀ : ℝ) ^ 2 * N ^ 2 /
            (κ ^ 2 * x ^ (27 * ε) * R) := hh
        _ = B₄ := by
          dsimp only [B₄, qg]
          ring
    clear hFourAt hpoly hφEnvelope hBand hAunit
    have hmaxFour : ((pairs.sup (fun p => Real.toNNReal (f₄ p)) : NNReal) : ℝ) ≤ B₄ := by
      clear_value pairs f₄ B₄
      clear * - hB₄ hf₄
      exact (Real.le_toNNReal_iff_coe_le hB₄).mp
        (Finset.sup_le fun p hp => Real.toNNReal_mono (hf₄ p hp))
    have hCdouble : C₁ ≤ 2 * C₁ :=
      le_mul_of_one_le_left hC₁pos.le (by norm_num)
    have hThree := hThreeAt x hxthree r₁ q₀ u₁ v₁ v₂ q₂ w₀ w₁ w₂
      hr₁ hq₀ hu₁ hv₁ hv₂ hq₂ A B ℓ E N Δ d₀ H V hNone hΔone hH hV
      hN100 hH100 hm100
      (hΔhi.trans (div_le_div_of_nonneg_right
        (mul_le_mul_of_nonneg_right hCdouble hN.le)
        (mul_nonneg (hpow (50 * ε)).le (sq_nonneg H))))
      ((div_le_div_of_nonneg_left hΔpos.le hC₁pos hCdouble).trans hd₀lo)
      (hd₀hi.trans (mul_le_mul_of_nonneg_right hCdouble hΔpos.le))
      (hv₁hi.trans (mul_le_mul_of_nonneg_right hCdouble hV.le))
      (hv₂hi.trans (mul_le_mul_of_nonneg_right hCdouble hV.le))
      (hVhi₁.trans (mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_right hCdouble (hpow (δ + 5 * ε)).le) hHpos.le))
      J (fun h hh => (hJdata h hh).2)
      ψN ψD hsN hsD
      (fun t => by simpa only [iteratedDeriv_zero] using (hderivatives 0 t).2)
      (fun t => by simpa only [iteratedDeriv_zero] using hDderiv 0 t)
      (Y : ℝ) j hj₀
    exact hThreeFinish x ε C₁ Kthree Kfour R (s₂ : ℝ) qg N κ
      _ (S₃ ((w₀, w₁), w₂, Y, j)) hx1 hε hKthree.le hRpos hs₂pos hκpos hκqg
      hmaxFour hThree
  clear hFourAt hThreeAt hpoly hφEnvelope hBand
  have hmaxThree : ((P₃.sup (fun p => Real.toNNReal (S₃ p)) : NNReal) : ℝ) ≤ B₃ := by
    clear_value P₃ S₃ B₃
    clear * - hB₃ hS₃bound
    exact (Real.le_toNNReal_iff_coe_le hB₃).mp
      (Finset.sup_le fun p hp => Real.toNNReal_mono (hS₃bound p hp))
  have hh := hTwoFinish x ε Kss K₃ qg κ Δ N (g : ℝ)
    _ (sourceSigmaTwo J ψM (fun z => ψN (z / N)) ψD M Δ₁ d₀
      r₁ q₀ u₁ v₁ v₂ q₂ aN b₁N b₂N ℓ)
    hx1 hεsmall hKss.le hK₃.le hqg hκpos hΔone hNone hgOne hmaxThree hFinal
  simpa only [K₂, qg, g₀, mul_assoc] using hh

theorem sourceSigmaOne_selected_family_bound_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    («ω» δ ε C cM TM cN TN : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε)
    (hworking : 72 * «ω» + 24 * δ < 1) (hsmall : ε < δ / 10 ^ 100)
    (hC : 1 ≤ C) (hcM : 0 < cM) (hMT : cM ≤ TM)
    (hcN : 0 < cN) (hNT : cN ≤ TN)
    (CM EM CN EN : ℕ → ℝ)
    (henvelopes : ∀ j : ℕ, 0 ≤ CM j ∧ 0 ≤ CN j) :
    ∃ K X₀ : ℝ, 0 < K ∧ Real.exp 1 ≤ X₀ ∧
      ∀ (x : ℝ), X₀ ≤ x →
      ∀ (q₀ : ℕ), 0 < q₀ → Squarefree q₀ →
      ∀ (a b₁ b₂ ℓ : ℤ),
      Int.gcd (a * b₁ * b₂) (q₀ : ℤ) = 1 →
      ∀ (M N R₀ Q U V H Hstar γ : ℝ),
      0 < M → 0 < N → 0 < R₀ → 0 < Q → 0 < U → 0 < V →
      x / C ≤ M * N → M * N ≤ C * x → N = x ^ γ →
      max (1 / 4 + 12 * «ω» + 4 * δ + 100 * ε)
        (32 * «ω» + 10 * δ + 400 * ε) ≤ γ →
      γ ≤ 1 / 2 - 4 * «ω» - 2 * δ - 50 * ε →
      N ≤ C * x ^ (δ + 4 * ε) * R₀ →
      R₀ ≤ C * x ^ (-2 * ε) * N →
      x ^ (1 / 2 - ε) ≤ C * R₀ * Q →
      R₀ * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) →
      H = x ^ ε * R₀ * Q ^ 2 / ((q₀ : ℝ) * M) → 1 ≤ H →
      x ^ (-δ - 5 * ε) * Q / ((q₀ : ℝ) * H) ≤ C * U →
      U ≤ C * x ^ (-5 * ε) * Q / H →
      x ^ (5 * ε) * H / (q₀ : ℝ) ≤ C * V →
      V ≤ C * x ^ (δ + 5 * ε) * H →
      Q / (q₀ : ℝ) ≤ C * U * V → U * V ≤ C * Q / (q₀ : ℝ) →
      (q₀ : ℝ) ≤ C * Q →
      (∀ p ∈ q₀.primeFactors,
        Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (p : ℝ)) →
      ℓ ≠ 0 → |(ℓ : ℝ)| ≤ C * N / R₀ →
      Hstar ≠ 0 → 1 ≤ C * |Hstar| → |Hstar| ≤ C * H →
      ∀ (ψM ψN : ℝ → ℝ), ContDiff ℝ ∞ ψM → ContDiff ℝ ∞ ψN →
      Function.support ψM ⊆ Set.Icc cM TM →
      Function.support ψN ⊆ Set.Icc cN TN →
      (∀ t : ℝ, 0 ≤ ψM t ∧ 0 ≤ ψN t) →
      (∀ (j : ℕ) (t : ℝ),
        |iteratedDeriv j ψM t| ≤ CM j * (Real.log x) ^ EM j ∧
        |iteratedDeriv j ψN t| ≤ CN j * (Real.log x) ^ EN j) →
      ∀ (𝒯 : Finset (ℕ × ℕ × ℕ × ℕ × ℕ)),
      (∀ t ∈ 𝒯,
        0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2.1 ∧
        0 < t.2.2.2.1 ∧ 0 < t.2.2.2.2 ∧
        R₀ / C ≤ (t.1 : ℝ) ∧ (t.1 : ℝ) ≤ C * R₀ ∧
        U / C ≤ (t.2.1 : ℝ) ∧ (t.2.1 : ℝ) ≤ C * U ∧
        V / C ≤ (t.2.2.1 : ℝ) ∧ (t.2.2.1 : ℝ) ≤ C * V ∧
        V / C ≤ (t.2.2.2.1 : ℝ) ∧ (t.2.2.2.1 : ℝ) ≤ C * V ∧
        Q / (C * (q₀ : ℝ)) ≤ (t.2.2.2.2 : ℝ) ∧
        (t.2.2.2.2 : ℝ) ≤ C * Q / (q₀ : ℝ) ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ 1 t.1) ∧
        Squarefree (t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2.2) ∧
        Squarefree (t.1 * q₀ * t.2.1 * t.2.2.2.1 * t.2.2.2.2) ∧
        Int.gcd (a * b₁ * b₂)
          ((t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2.1 * t.2.2.2.2 : ℕ) : ℤ) = 1) →
      let Hbound : ℕ := ⌊2 * |Hstar|⌋₊
      let J : Finset ℤ :=
        (Finset.Icc (-(Hbound : ℤ)) (Hbound : ℤ)).filter
          (fun h => 1 ≤ (h : ℝ) / Hstar ∧ (h : ℝ) / Hstar < 2)
      (∑ t ∈ 𝒯,
        ‖sourceSignedDispersionFrequencyBlock (J ×ˢ J)
          ψM (fun z => ψN (z / N)) M
          t.1 q₀ t.2.1 t.2.2.1 t.2.2.2.1 t.2.2.2.2 a b₁ b₂ ℓ‖) ≤
        K * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * R₀ * Q * N * U * V ^ 2 *
          x ^ (-4 * ε)
:= by
  classical
  have hLogAbsorb (A B η : ℝ) (hη : 0 < η) :
      ∀ᶠ x : ℝ in Filter.atTop, A * (Real.log x) ^ B ≤ x ^ η := by
    clear * - hη
    filter_upwards [((isLittleO_log_rpow_rpow_atTop B hη).const_mul_left A).eventuallyLE,
      Filter.eventually_ge_atTop (0 : ℝ)] with x hx hx0
    exact (le_abs_self (A * (Real.log x) ^ B)).trans (by
      simpa only [Real.norm_eq_abs, abs_of_nonneg (Real.rpow_nonneg hx0 η)] using hx)
  have hPrimeWindowMass (ψ : ℝ → ℝ) (c T N A E x : ℝ)
      (hc : 0 < c) (hcT : c ≤ T) (hN : 1 ≤ N) (hA : 0 ≤ A)
      (hx : Real.exp 1 ≤ x) (hs : Function.support ψ ⊆ Set.Icc c T)
      (hb : ∀ t : ℝ, |ψ t| ≤ A * (Real.log x) ^ E) :
      let I : Finset ℤ := Finset.Icc ⌈c * N⌉ ⌊T * N⌋
      (∀ n ∉ I, ψ ((n : ℝ) / N) = 0) ∧
        (∑ n ∈ I, |ψ ((n : ℝ) / N)|) ≤
          (T + 1) * A * N * (Real.log x) ^ E := by
    clear * - hc hcT hN hA hx hs hb
    intro I
    have hNpos : 0 < N := zero_lt_one.trans_le hN
    have hTpos : 0 < T := hc.trans_le hcT
    have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
    have hlog : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxpos).mpr hx
    have hweight : 0 ≤ A * (Real.log x) ^ E := by positivity
    have hcard : (I.card : ℝ) ≤ (T + 1) * N := by
      have hcount := int_finset_card_le_of_mem_real_Icc I 0 (T * N)
        (mul_nonneg hTpos.le hNpos.le) (by
          intro n hn
          obtain ⟨hlo, hhi⟩ := Finset.mem_Icc.mp hn
          exact ⟨(mul_nonneg hc.le hNpos.le).trans (Int.ceil_le.mp hlo),
            Int.le_floor.mp hhi⟩)
      nlinarith
    constructor
    · intro n hn
      by_contra hn0
      have hsupport := hs hn0
      exact hn (Finset.mem_Icc.mpr
        ⟨Int.ceil_le.mpr ((le_div_iff₀ hNpos).mp hsupport.1),
          Int.le_floor.mpr ((div_le_iff₀ hNpos).mp hsupport.2)⟩)
    · calc
        (∑ n ∈ I, |ψ ((n : ℝ) / N)|) ≤
            ∑ _n ∈ I, A * (Real.log x) ^ E := Finset.sum_le_sum fun n _ => hb _
        _ = (I.card : ℝ) * (A * (Real.log x) ^ E) := by
          simp only [Finset.sum_const, nsmul_eq_mul]
        _ ≤ ((T + 1) * N) * (A * (Real.log x) ^ E) :=
          mul_le_mul_of_nonneg_right hcard hweight
        _ = _ := by ring
  have hChooseDivisor (R : Finset ℕ) (Y D : ℝ) (hY : 1 ≤ Y) (hD : 1 ≤ D)
      (hupper : ∀ r ∈ R, D ≤ Y * (r : ℝ))
      (hdense : ∀ r ∈ R, Nonempty
        (DenseDivisibilityWitness ⟨Y, hY⟩ 1 r)) :
      ∃ d : ℕ → ℕ, ∀ r ∈ R,
        0 < d r ∧ d r ∣ r ∧ D / Y ≤ (d r : ℝ) ∧ (d r : ℝ) ≤ D := by
    clear * - hY hD hupper hdense
    classical
    have hex (r : ℕ) : ∃ e : ℕ, r ∈ R →
        0 < e ∧ e ∣ r ∧ D / Y ≤ (e : ℝ) ∧ (e : ℝ) ≤ D := by
      by_cases hr : r ∈ R
      · obtain ⟨u, v, hproduct, _, hv, hlower, hbound⟩ :=
          (denseDivisibility_succ_iff.mp (hdense r hr)).2
            0 0 rfl D hD (hupper r hr)
        exact ⟨v, fun _ => ⟨denseDivisibility_pos hv,
          ⟨u, by simpa only [mul_comm] using hproduct⟩, hlower, hbound⟩⟩
      · exact ⟨1, fun h => False.elim (hr h)⟩
    choose d hd using hex
    exact ⟨d, hd⟩
  have hLiteralJWindow (C H Hstar : ℝ) (hstar : |Hstar| ≤ C * H) :
      let Hbound : ℕ := ⌊2 * |Hstar|⌋₊
      let J : Finset ℤ := (Finset.Icc (-(Hbound : ℤ)) (Hbound : ℤ)).filter
        (fun h => 1 ≤ (h : ℝ) / Hstar ∧ (h : ℝ) / Hstar < 2)
      (∀ h ∈ J, h ≠ 0 ∧ |(h : ℝ)| ≤ 2 * C * H) ∧
        J ⊆ (Finset.Icc (-(Hbound : ℤ)) (Hbound : ℤ)).filter (fun h => h ≠ 0) := by
    clear * - hstar
    intro Hbound J
    have hpoint (h : ℤ) (hh : h ∈ J) : h ≠ 0 ∧ |(h : ℝ)| ≤ 2 * C * H := by
      obtain ⟨hinterval, hratio⟩ := Finset.mem_filter.mp hh
      obtain ⟨hlower, hupper⟩ := Finset.mem_Icc.mp hinterval
      refine ⟨?_, ?_⟩
      · intro hzero
        simp only [hzero, Int.cast_zero, zero_div] at hratio
        norm_num at hratio
      · have habs : |(h : ℝ)| ≤ (Hbound : ℝ) := by
          apply abs_le.mpr
          exact ⟨by exact_mod_cast hlower, by exact_mod_cast hupper⟩
        calc
          |(h : ℝ)| ≤ (Hbound : ℝ) := habs
          _ ≤ 2 * |Hstar| := Nat.floor_le (by positivity)
          _ ≤ 2 * (C * H) := mul_le_mul_of_nonneg_left hstar (by norm_num)
          _ = 2 * C * H := by ring
    refine ⟨hpoint, ?_⟩
    intro h hh
    exact Finset.mem_filter.mpr ⟨(Finset.mem_filter.mp hh).1, (hpoint h hh).1⟩
  let C₁ : ℝ := 2 * C
  have hC₁two : 2 ≤ C₁ := by dsimp only [C₁]; linarith
  have hC₁ : 1 ≤ C₁ := by linarith
  have hC₁pos : 0 < C₁ := zero_lt_one.trans_le hC₁
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hCC₁ : C ≤ C₁ := by dsimp only [C₁]; linarith
  have hεsmall : ε < 1 / 1000 := by
    clear * - hsmall hworking hω
    have hεmul := (lt_div_iff₀ (by norm_num : (0 : ℝ) < 10 ^ 100)).mp hsmall
    have hδone : δ < 1 := by linarith only [hworking, hω]
    nlinarith [show (1000 : ℝ) ≤ 10 ^ 100 by norm_num]
  obtain ⟨ψD, CD, hψD, hsD, hDvalues, hDone, hCDpos, hDbound, hcoverUniform⟩ :=
    exists_source_scale_positive_short_cover
  obtain ⟨Xcover, hXcover, hcoverAt⟩ := hcoverUniform ε hε
  obtain ⟨K₂, Xtwo, hK₂, hXtwo, hTwoAt⟩ :=
    sourceSigmaOne_uniform_secondary_bound hDeligne «ω» δ ε C₁ cM TM cN TN
      hω hδ hε hworking hsmall hεsmall hC₁ hcM hMT hcN hNT
      CM EM CN EN CD
      (fun j => ⟨(henvelopes j).1, (henvelopes j).2, (hCDpos j).le⟩)
  obtain ⟨Xtarget, hXtarget, hTargetAt⟩ :=
    sourceSigmaOne_divisor_target_resources C₁ «ω» δ ε hC₁ hω hδ hε hworking hsmall
  let AM : ℝ := CM 0
  let AN : ℝ := (TN + 1) * CN 0
  let EM₀ : ℝ := max 0 (EM 0)
  let EN₀ : ℝ := max 0 (EN 0)
  let Efinal : ℝ := 2 * EM₀ + EN₀ + 1
  let Kfiber : ℝ := 128 * C₁ ^ 5 * (TM * AM) ^ 2 * AN + 48 * K₂ * C₁ ^ 2
  let Ktotal : ℝ := C₁ ^ 3 * Kfiber * (1 + 1 / Real.log 2)
  have hAM : 0 ≤ AM := (henvelopes 0).1
  have hAN : 0 ≤ AN := by
    clear * - hcN hNT henvelopes
    have hTN : 0 < TN := hcN.trans_le hNT
    dsimp only [AN]
    exact mul_nonneg (by positivity) (henvelopes 0).2
  have hEM₀ : 0 ≤ EM₀ := le_max_left _ _
  have hEN₀ : 0 ≤ EN₀ := le_max_left _ _
  have hEfinal : 0 ≤ Efinal := by dsimp only [Efinal]; positivity
  have hKfiber : 0 ≤ Kfiber := by dsimp only [Kfiber]; positivity
  obtain ⟨Xlog, hLogAt⟩ := (hLogAbsorb Ktotal (Efinal + 1) ε hε).exists_forall_of_atTop
  let thresholds : Finset ℝ :=
    {Real.exp 1, 3, C₁, Xcover, Xtwo, Xtarget, Xlog}
  have hthresholds : thresholds.Nonempty := ⟨Real.exp 1, by simp [thresholds]⟩
  let X₀ : ℝ := thresholds.sup' hthresholds id
  have hthreshold (z : ℝ) (hz : z ∈ thresholds) : z ≤ X₀ := Finset.le_sup' id hz
  refine ⟨1, X₀, zero_lt_one, hthreshold _ (by simp [thresholds]), ?_⟩
  intro x hx q₀ hq₀ hq₀sq a b₁ b₂ ℓ hprimitive₀ M N R₀ Q U V H Hstar γ
    hM hN hR₀ hQ hU hV hMNlo hMNhi hNγ hγlo hγhi hNR hRhi hRQlo hRQhi
    hHdef hH hUlo hUhi hVlo hVhi hUVlo hUVhi hq₀Q hrough hℓne hℓbound
    hHstarne hHstarlo hHstarhi ψM ψN hψM hψN hsM hsN hvalues hderivatives
    𝒯 h𝒯 Hbound J
  have hxt (z : ℝ) (hz : z ∈ thresholds) : z ≤ x := (hthreshold z hz).trans hx
  have hxe : Real.exp 1 ≤ x := hxt _ (by simp [thresholds])
  have hx3 : 3 ≤ x := hxt _ (by simp [thresholds])
  have hxC : C₁ ≤ x := hxt _ (by simp [thresholds])
  have hxtwo : Xtwo ≤ x := hxt _ (by simp [thresholds])
  have hxcover : Xcover ≤ x := hxt _ (by simp [thresholds])
  have hxtarget : Xtarget ≤ x := hxt _ (by simp [thresholds])
  have hxlog : Xlog ≤ x := hxt _ (by simp [thresholds])
  have hx1 : 1 ≤ x := by linarith
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hpow (z : ℝ) : 0 < x ^ z := Real.rpow_pos_of_pos hx0 z
  have hlogx : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hxe
  have hq₀one : (1 : ℝ) ≤ (q₀ : ℝ) := by exact_mod_cast hq₀
  have hq₀real : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀
  have hHpos : 0 < H := zero_lt_one.trans_le hH
  let g₀ : ℕ := Int.gcd (q₀ : ℤ) ℓ
  have hg₀nat : 0 < g₀ := Int.gcd_pos_of_ne_zero_left ℓ (by exact_mod_cast hq₀.ne')
  have hg₀one : (1 : ℝ) ≤ (g₀ : ℝ) := by exact_mod_cast hg₀nat
  have hg₀real : 0 < (g₀ : ℝ) := by exact_mod_cast hg₀nat
  let : NeZero q₀ := ⟨hq₀.ne'⟩
  have hMNlo₁ : x / C₁ ≤ M * N :=
    (div_le_div_of_nonneg_left hx0.le hCpos hCC₁).trans hMNlo
  have hMNhi₁ : M * N ≤ C₁ * x := hMNhi.trans (by gcongr)
  have hNR₁ : N ≤ C₁ * x ^ (δ + 4 * ε) * R₀ := hNR.trans (by gcongr)
  have hRhi₁ : R₀ ≤ C₁ * x ^ (-2 * ε) * N := hRhi.trans (by gcongr)
  have hRQlo₁ : x ^ (1 / 2 - ε) ≤ C₁ * R₀ * Q := hRQlo.trans (by gcongr)
  have hRQhi₁ : R₀ * Q ≤ C₁ * x ^ (1 / 2 + 2 * «ω» + ε) := hRQhi.trans (by gcongr)
  have hUlo₁ : x ^ (-δ - 5 * ε) * Q / ((q₀ : ℝ) * H) ≤ C₁ * U :=
    hUlo.trans (by gcongr)
  have hUhi₁ : U ≤ C₁ * x ^ (-5 * ε) * Q / H := hUhi.trans (by gcongr)
  have hVlo₁ : x ^ (5 * ε) * H / (q₀ : ℝ) ≤ C₁ * V := hVlo.trans (by gcongr)
  have hVhi₁ : V ≤ C₁ * x ^ (δ + 5 * ε) * H := hVhi.trans (by gcongr)
  have hUVlo₁ : Q / (q₀ : ℝ) ≤ C₁ * U * V := hUVlo.trans (by gcongr)
  have hUVhi₁ : U * V ≤ C₁ * Q / (q₀ : ℝ) := hUVhi.trans (by gcongr)
  have hq₀Q₁ : (q₀ : ℝ) ≤ C₁ * Q := hq₀Q.trans (by gcongr)
  have hℓbound₁ : |(ℓ : ℝ)| ≤ C₁ * N / R₀ := hℓbound.trans (by gcongr)
  have hHstarlo₁ : 1 ≤ C₁ * |Hstar| := hHstarlo.trans (by gcongr)
  have hHstarhi₁ : |Hstar| ≤ C₁ * H := hHstarhi.trans (by gcongr)
  let Dtarget : ℝ := N / (x ^ (50 * ε) * H ^ 2)
  obtain ⟨hHrough, hNone, hNx, hDtargetpos, hDtargetone, hDtargetN, hxδ, hDtargetUpper⟩ :=
    hTargetAt x hxtarget q₀ hq₀ M N R₀ Q H γ hM hN hR₀ hQ hH hNγ
      ((le_max_left _ _).trans hγlo) hγhi hMNlo₁ hNR₁ hRQhi₁ hHdef
  obtain ⟨hJdata, hJwindow⟩ := hLiteralJWindow C₁ H Hstar hHstarhi₁
  have hDderiv (j : ℕ) (t : ℝ) :
      |iteratedDeriv j ψD t| ≤ CD j * (Real.log x) ^ (0 : ℝ) := by
    simpa only [Real.rpow_zero, mul_one, Real.norm_eq_abs] using hDbound j t
  have hMamp (t : ℝ) : |ψM t| ≤ AM * (Real.log x) ^ EM₀ := by
    clear * - hderivatives hlogx hAM
    have hh := (hderivatives 0 t).1
    simp only [iteratedDeriv_zero] at hh
    exact hh.trans (mul_le_mul_of_nonneg_left
      (Real.rpow_le_rpow_of_exponent_le hlogx (le_max_right 0 (EM 0))) hAM)
  have hNamp (t : ℝ) : |ψN t| ≤ CN 0 * (Real.log x) ^ EN₀ := by
    clear * - hderivatives hlogx henvelopes
    have hh := (hderivatives 0 t).2
    simp only [iteratedDeriv_zero] at hh
    exact hh.trans (mul_le_mul_of_nonneg_left
      (Real.rpow_le_rpow_of_exponent_le hlogx (le_max_right 0 (EN 0))) (henvelopes 0).2)
  let Isupport : Finset ℤ := Finset.Icc ⌈cN * N⌉ ⌊TN * N⌋
  obtain ⟨hNzero, hNmass⟩ :=
    hPrimeWindowMass ψN cN TN N (CN 0) EN₀ x hcN hNT hNone (henvelopes 0).2 hxe hsN hNamp
  have hxneg (e : ℝ) (he : 0 ≤ e) : x ^ (-e) ≤ 1 := by
    clear * - hx1 he
    simpa only [Real.rpow_zero] using
      Real.rpow_le_rpow_of_exponent_le hx1 (show -e ≤ 0 by linarith)
  have hRsimple : R₀ ≤ C₁ * N := by
    clear * - hRhi₁ hxneg hε hN hC₁pos
    calc
      R₀ ≤ C₁ * x ^ (-2 * ε) * N := hRhi₁
      _ ≤ C₁ * 1 * N := by
        gcongr
        simpa only [neg_mul] using hxneg (2 * ε) (by positivity)
      _ = _ := by ring
  have hUsimple : U * H ≤ C₁ * Q := by
    clear * - hUhi₁ hHpos hxneg hε hQ hC₁pos
    have hu := (le_div_iff₀ hHpos).mp hUhi₁
    calc
      U * H ≤ C₁ * x ^ (-5 * ε) * Q := hu
      _ ≤ C₁ * 1 * Q := by
        gcongr
        simpa only [neg_mul] using hxneg (5 * ε) (by positivity)
      _ = _ := by ring
  have hHmul : H * (q₀ : ℝ) * M = x ^ ε * R₀ * Q ^ 2 := by
    clear * - hHdef hq₀real hM
    have hh := (eq_div_iff (mul_ne_zero hq₀real.ne' hM.ne')).mp hHdef
    simpa only [mul_assoc] using hh
  have hTargetScale : N ≤ C₁ * x ^ (δ + 50 * ε) * H ^ 2 * Dtarget := by
    clear * - hHpos hpow hx0 hN hC₁ hxδ
    have heq : C₁ * x ^ (δ + 50 * ε) * H ^ 2 * Dtarget = C₁ * x ^ δ * N := by
      dsimp only [Dtarget]
      rw [Real.rpow_add hx0]
      field_simp [hHpos.ne', (hpow (50 * ε)).ne']
    rw [heq]
    exact le_mul_of_one_le_left hN.le (one_le_mul_of_one_le_of_one_le hC₁ hxδ)
  obtain ⟨hMx, hMlower, hRx, hRlower, hQx, hHx, hUx, hVx, _, _, _, _, _, _, _, _⟩ :=
    sourceSecondary_coarse_parameter_bounds «ω» δ ε C₁ hω hδ hε hworking hC₁ hεsmall
      x M N R₀ Q U V H Dtarget 0 (q₀ : ℝ) 0 0 0 0
      hx3 hxC hM hNone hNx hR₀ hQ hU hV hH hDtargetpos (by norm_num) hq₀one
      (by norm_num)
      (by simpa only [mul_assoc] using (div_le_iff₀' hC₁pos).mp hMNlo₁)
      hMNhi₁ hNR₁ hRsimple hRQhi₁ hHmul hUsimple hVhi₁ hTargetScale
      (hDtargetN.trans (le_mul_of_one_le_left hN.le hC₁))
      (by simpa only [zero_mul] using (mul_pos hC₁pos hR₀).le) hq₀Q₁
      (by positivity) (by positivity) (by positivity)
      (by simpa only [zero_mul] using (mul_pos hC₁pos hQ).le)
  have hCVx : C₁ * V ≤ x ^ (15 : ℕ) := by
    clear * - hxC hVx hV hx0
    calc
      C₁ * V ≤ x * x ^ (14 : ℕ) := mul_le_mul hxC hVx hV.le hx0.le
      _ = _ := by ring
  let Kv : ℕ := ⌊C₁ * V⌋₊
  have hKvbound : (Kv : ℝ) ≤ C₁ * V := Nat.floor_le (mul_pos hC₁pos hV).le
  have hlogKv : 1 + Real.log (Kv : ℝ) ≤ 16 * Real.log x := by
    clear * - hlogx hKvbound hCVx
    by_cases hz : Kv = 0
    · simp only [hz, Nat.cast_zero, Real.log_zero]
      linarith
    · have hp : 0 < (Kv : ℝ) := Nat.cast_pos.mpr (Nat.pos_of_ne_zero hz)
      have hlog := Real.log_le_log hp (hKvbound.trans hCVx)
      rw [Real.log_pow] at hlog
      norm_num at hlog
      linarith
  have hHV : H / V ≤ C₁ * (q₀ : ℝ) * x ^ (-5 * ε) := by
    clear * - hVlo₁ hV hq₀real hx0 hpow hC₁pos
    have hmul := (div_le_iff₀ hq₀real).mp hVlo₁
    apply (div_le_iff₀ hV).mpr
    calc
      H = (x ^ (5 * ε) * H) * x ^ (-5 * ε) := by
        have hp : x ^ (5 * ε) * x ^ (-5 * ε) = 1 := by
          rw [← Real.rpow_add hx0, show 5 * ε + -5 * ε = 0 by ring, Real.rpow_zero]
        rw [mul_right_comm, hp, one_mul]
      _ ≤ (C₁ * V * (q₀ : ℝ)) * x ^ (-5 * ε) :=
        mul_le_mul_of_nonneg_right hmul (hpow _).le
      _ = _ := by ring
  have hHbound : (Hbound : ℝ) ≤ 2 * C₁ * H :=
    (Nat.floor_le (by positivity : 0 ≤ 2 * |Hstar|)).trans (by
      calc
        2 * |Hstar| ≤ 2 * (C₁ * H) :=
          mul_le_mul_of_nonneg_left hHstarhi₁ (by norm_num)
        _ = 2 * C₁ * H := by ring)
  clear hTargetAt
  let Rs : Finset ℕ := 𝒯.image Prod.fst
  obtain ⟨d, hd⟩ := hChooseDivisor Rs (x ^ δ) Dtarget hxδ hDtargetone
    (by
      intro r hr
      obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hr
      obtain ⟨_, _, _, _, _, hrlo, _⟩ := h𝒯 t ht
      exact hDtargetUpper t.1
        ((div_le_div_of_nonneg_left hR₀.le hCpos hCC₁).trans hrlo))
    (by
      intro r hr
      obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hr
      obtain ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hden, _⟩ := h𝒯 t ht
      simpa only [max_eq_right hxδ] using hden)
  have hd𝒯 (t : ℕ × ℕ × ℕ × ℕ × ℕ) (ht : t ∈ 𝒯) :
      0 < d t.1 ∧ d t.1 ∣ t.1 ∧ Dtarget / x ^ δ ≤ (d t.1 : ℝ) ∧
        (d t.1 : ℝ) ≤ Dtarget := hd t.1 (Finset.mem_image_of_mem Prod.fst ht)
  let key : (ℕ × ℕ × ℕ × ℕ × ℕ) → ℕ := fun t => Nat.log2 (d t.1)
  let aKey : (ℕ × ℕ × ℕ × ℕ × ℕ) → ℕ × ℕ × ℕ :=
    fun t => (t.1 / d t.1, t.2.1, t.2.2.2.2)
  let value : (ℕ × ℕ × ℕ × ℕ × ℕ) → ℕ × ℕ × ℕ :=
    fun t => (d t.1, t.2.2.1, t.2.2.2.1)
  let reconstruct : (ℕ × ℕ × ℕ) → (ℕ × ℕ × ℕ) → ℕ × ℕ × ℕ × ℕ × ℕ :=
    fun z p => (p.1 * z.1, z.2.1, p.2.1, p.2.2, z.2.2)
  let Ks : Finset ℕ := 𝒯.image key
  let As : ℕ → Finset (ℕ × ℕ × ℕ) :=
    fun k => (𝒯.filter fun t => key t = k).image aKey
  let Fs : ℕ → (ℕ × ℕ × ℕ) → Finset (ℕ × ℕ × ℕ) :=
    fun k z => (𝒯.filter fun t => key t = k ∧ aKey t = z).image value
  let Δs : ℕ → ℝ := fun k => (2 ^ k : ℕ)
  let Δshorts : ℕ → ℝ := fun k => x ^ (-5 * ε) * Δs k
  let Ds : ℕ → Finset ℕ := fun k => Finset.Icc (2 ^ k) (2 * 2 ^ k)
  let grids : ℕ → Finset ℕ := fun k => Finset.range (⌈Δs k / Δshorts k⌉₊ + 1)
  let centers : ℕ → ℕ → ℝ := fun k i => Δs k - Δshorts k + (i : ℝ) * Δshorts k
  let Dcut : ℕ → Finset ℕ := fun k => (grids k).biUnion (fun i =>
    Finset.Icc 1 ⌊centers k i + (5 / 2 : ℝ) * Δshorts k⌋₊)
  have hΔsone (k : ℕ) : 1 ≤ Δs k := by
    dsimp only [Δs]
    exact_mod_cast Nat.one_le_pow k 2 (by decide)
  have hΔspos (k : ℕ) : 0 < Δs k := zero_lt_one.trans_le (hΔsone k)
  have hcoverData (k : ℕ) := hcoverAt x hxcover (Δs k) (hΔspos k)
  have hcenterData (k i : ℕ) (hi : i ∈ grids k) :
      Δs k / 2 ≤ centers k i ∧ centers k i ≤ 2 * Δs k :=
    (hcoverData k).2.2.2.2.2.2.1 i hi
  have hgridCard (k : ℕ) : ((grids k).card : ℝ) ≤ 3 * x ^ (5 * ε) :=
    (hcoverData k).2.2.2.2.2.1
  have hcenterNonneg (k i : ℕ) (hi : i ∈ grids k) : 0 ≤ centers k i :=
    (div_nonneg (hΔspos k).le (by norm_num)).trans (hcenterData k i hi).1
  have hcoverD (k : ℕ) (d' : ℕ) (hd' : d' ∈ Ds k) :
      ∃ i ∈ grids k, Δshorts k ≤ (d' : ℝ) - centers k i ∧
        (d' : ℝ) - centers k i ≤ 2 * Δshorts k := by
    obtain ⟨hlo, hhi⟩ := Finset.mem_Icc.mp hd'
    apply (hcoverData k).2.2.2.2.2.2.2.1
    exact ⟨by
      change ((2 ^ k : ℕ) : ℝ) ≤ (d' : ℝ)
      exact_mod_cast hlo, by
      change (d' : ℝ) ≤ 2 * ((2 ^ k : ℕ) : ℝ)
      exact_mod_cast hhi⟩
  have hDcutpos (k : ℕ) (d' : ℕ) (hd' : d' ∈ Dcut k) : 0 < d' := by
    obtain ⟨i, _, hi⟩ := Finset.mem_biUnion.mp hd'
    exact (Finset.mem_Icc.mp hi).1
  have hAspos (k : ℕ) (z : ℕ × ℕ × ℕ) (hz : z ∈ As k) :
      0 < z.1 ∧ 0 < z.2.1 ∧ 0 < z.2.2 := by
    obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hz
    have ht' := (Finset.mem_filter.mp ht).1
    obtain ⟨hr, hu, _, _, hq₂, _⟩ := h𝒯 t ht'
    obtain ⟨hdpos, hdvd, _, _⟩ := hd𝒯 t ht'
    exact ⟨Nat.div_pos (Nat.le_of_dvd hr hdvd) hdpos, hu, hq₂⟩
  have hFsource (k : ℕ) (z p : ℕ × ℕ × ℕ) (hp : p ∈ Fs k z) :
      reconstruct z p ∈ 𝒯 ∧ d (reconstruct z p).1 = p.1 ∧
        Nat.log2 p.1 = k := by
    obtain ⟨t, ht, heq⟩ := Finset.mem_image.mp hp
    obtain ⟨ht𝒯, hkey, haKey⟩ := Finset.mem_filter.mp ht
    have hrecon : reconstruct (aKey t) (value t) = t := by
      rcases t with ⟨r, u, v₁, v₂, q₂⟩
      change (d r * (r / d r), u, v₁, v₂, q₂) = (r, u, v₁, v₂, q₂)
      rw [Nat.mul_div_cancel' (hd𝒯 (r, u, v₁, v₂, q₂) ht𝒯).2.1]
    have hrecon' : reconstruct z p = t := by
      simpa only [haKey, heq] using hrecon
    refine ⟨hrecon'.symm ▸ ht𝒯, ?_, ?_⟩
    · rw [hrecon']
      exact congrArg Prod.fst heq
    · have he := congrArg (fun p : ℕ × ℕ × ℕ => Nat.log2 p.1) heq
      exact he.symm.trans hkey
  have hFspos (k : ℕ) (z p : ℕ × ℕ × ℕ) (hp : p ∈ Fs k z) :
      0 < p.1 ∧ 0 < p.2.1 ∧ 0 < p.2.2 := by
    obtain ⟨ht, hd', _⟩ := hFsource k z p hp
    obtain ⟨_, _, hv₁, hv₂, _⟩ := h𝒯 _ ht
    exact ⟨hd' ▸ (hd𝒯 _ ht).1, hv₁, hv₂⟩
  have hFiberGeometry (k : ℕ) (z p : ℕ × ℕ × ℕ) (hp : p ∈ Fs k z) :
      p.1 ∈ Ds k ∧ R₀ / C₁ ≤ (z.1 : ℝ) * Δs k ∧
      (z.1 : ℝ) * Δs k ≤ C₁ * R₀ ∧
      N ≤ C₁ * x ^ (δ + 50 * ε) * H ^ 2 * Δs k ∧
      Δs k ≤ C₁ * N / (x ^ (50 * ε) * H ^ 2) ∧
      ((Ds k).card : ℝ) ≤ 2 * Δs k := by
    obtain ⟨ht, hd', hkey⟩ := hFsource k z p hp
    obtain ⟨hr, _, _, _, _, hrlo, hrhi, _⟩ := h𝒯 _ ht
    obtain ⟨hdpos, _, hdlo, hdhi⟩ := hd𝒯 _ ht
    rw [hd'] at hdpos hdlo hdhi
    have hzpos : 0 < z.1 :=
      Nat.pos_of_mul_pos_left hr
    have hh := sourceSigmaOne_dyadic_source_geometry C x δ ε N H R₀ hC hx1 hδ hε hN hHpos hR₀
      (p.1 * z.1) p.1 z.1 hr hdpos hzpos rfl hrlo hrhi hdlo hdhi
    obtain ⟨_, hlo, hhi, hrlo', hrhi', hΔlo, hΔhi, hcard⟩ := hh
    rw [hkey] at hlo hhi hrlo' hrhi' hΔlo hΔhi hcard
    exact ⟨Finset.mem_Icc.mpr ⟨hlo, hhi⟩, hrlo', hrhi', hΔlo, hΔhi, hcard⟩
  have hFnonempty (k : ℕ) (z : ℕ × ℕ × ℕ) (hz : z ∈ As k) :
      (Fs k z).Nonempty := by
    obtain ⟨t, ht, heq⟩ := Finset.mem_image.mp hz
    obtain ⟨ht𝒯, hkey⟩ := Finset.mem_filter.mp ht
    exact ⟨value t, Finset.mem_image.mpr
      ⟨t, Finset.mem_filter.mpr ⟨ht𝒯, hkey, heq⟩, rfl⟩⟩
  obtain ⟨P, hP, _, hcommon⟩ := sourceSigmaOne_global_cutoff_residues Ks As Fs Dcut q₀ hq₀
    (fun k _ z hz => hAspos k z hz)
    (fun k _ z _ p hp => hFspos k z p hp)
    (fun k _ d' hd' => hDcutpos k d' hd')
  let : NeZero P := ⟨hP.ne'⟩
  let aN : ℕ := (a : ZMod P).val
  let b₁N : ℕ := (b₁ : ZMod P).val
  let b₂N : ℕ := (b₂ : ZMod P).val
  have hcommon' := hcommon a b₁ b₂
  let f : (ℕ × ℕ × ℕ × ℕ × ℕ) → ℝ := fun t =>
    ‖sourceSignedDispersionFrequencyBlock (J ×ˢ J) ψM (fun z => ψN (z / N)) M
      t.1 q₀ t.2.1 t.2.2.1 t.2.2.2.1 t.2.2.2.2 a b₁ b₂ ℓ‖
  have hFibers (k : ℕ) (hk : k ∈ Ks) (z : ℕ × ℕ × ℕ) (hz : z ∈ As k) :
      (∑ p ∈ Fs k z, f (reconstruct z p)) ≤
        Kfiber * (q₀ : ℝ) * (g₀ : ℝ) * Δs k * N * V ^ 2 *
          x ^ (-5 * ε) * (Real.log x) ^ Efinal := by
    obtain ⟨hr₁, hu₁, hq₂⟩ := hAspos k z hz
    obtain ⟨p₀, hp₀⟩ := hFnonempty k z hz
    obtain ⟨_, hrlo, hrhi, hΔlo, hΔhi, hDcard⟩ := hFiberGeometry k z p₀ hp₀
    have hΔ₁pos : 0 < Δshorts k := (hcoverData k).1
    have hDmajor (t : ℝ) (ht : t ∈ Set.Icc (1 : ℝ) 2) : 1 ≤ ψD t :=
      (hDone t ht).ge
    have hF (p : ℕ × ℕ × ℕ) (hp : p ∈ Fs k z) :
        p.1 ∈ Ds k ∧ p.2.1 ∈ Finset.Icc 1 Kv ∧ p.2.2 ∈ Finset.Icc 1 Kv ∧
        V / C₁ ≤ ((max p.2.1 p.2.2 : ℕ) : ℝ) ∧
        Squarefree ((p.1 * z.1) * q₀ * z.2.1 * p.2.1 * z.2.2) ∧
        Squarefree ((p.1 * z.1) * q₀ * z.2.1 * p.2.2 * z.2.2) ∧
        Nat.Coprime ((p.1 * z.1) * q₀ * z.2.1 * p.2.1 * p.2.2 * z.2.2)
          (aN * b₁N * b₂N) := by
      obtain ⟨ht, _, _⟩ := hFsource k z p hp
      obtain ⟨_, _, hv₁, hv₂, _, _, _, _, _, hv₁lo, hv₁hi,
        _, hv₂hi, _, _, _, hs₁, hs₂, hprim⟩ := h𝒯 _ ht
      have hv₁upper : (p.2.1 : ℝ) ≤ C₁ * V := hv₁hi.trans (by gcongr)
      have hv₂upper : (p.2.2 : ℝ) ≤ C₁ * V := hv₂hi.trans (by gcongr)
      refine ⟨(hFiberGeometry k z p hp).1,
        Finset.mem_Icc.mpr ⟨hv₁, Nat.le_floor hv₁upper⟩,
        Finset.mem_Icc.mpr ⟨hv₂, Nat.le_floor hv₂upper⟩, ?_, hs₁, hs₂, ?_⟩
      · exact ((div_le_div_of_nonneg_left hV.le hCpos hCC₁).trans hv₁lo).trans
          (by exact_mod_cast le_max_left p.2.1 p.2.2)
      · exact (hcommon' k hk z hz p (Finset.mem_union_left _ hp)).2.1.mpr hprim
    have hbase := (sourceSelectedBlock_le_diagonal_add_sigmaTwo (Fs k z) (Ds k)
      (grids k) (centers k) J Isupport Hbound Kv (V / C₁) cM TM M
      (AM * (Real.log x) ^ EM₀) (Δshorts k) (1 / 2) (5 / 2)
      ψM (fun t => ψN (t / N)) ψD z.1 q₀ z.2.1 z.2.2 aN b₁N b₂N ℓ
      hr₁ hq₀ hu₁ hq₂ (div_pos hV hC₁pos) hcM hMT hM (by positivity)
      hsM hMamp hNzero hJwindow hΔ₁pos (by norm_num) (by norm_num)
      hsD (fun t => (hDvalues t).1) hDmajor (hcenterNonneg k) (hcoverD k) hF).1
    have htwo (v : ℕ × ℕ) (hv : v ∈ (Fs k z).image Prod.snd)
        (i : ℕ) (hi : i ∈ grids k) :
        sourceSigmaTwo J ψM (fun t => ψN (t / N)) ψD M (Δshorts k) (centers k i)
          z.1 q₀ z.2.1 v.1 v.2 z.2.2 aN b₁N b₂N ℓ ≤
            K₂ * (q₀ : ℝ) * (g₀ : ℝ) * Δs k * N * (Nat.gcd v.1 v.2 : ℝ) *
              x ^ (-10 * ε) := by
      obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hv
      obtain ⟨ht, _, _⟩ := hFsource k z p hp
      obtain ⟨_, _, hv₁, hv₂, _, _, _, hulo, huhi, hv₁lo, hv₁hi,
        hv₂lo, hv₂hi, hq₂lo, hq₂hi, _⟩ := h𝒯 _ ht
      have hbasecop : Nat.Coprime (z.1 * q₀ * z.2.1 * p.2.1 * p.2.2 * z.2.2)
          (aN * b₁N * b₂N) := by
        apply Nat.Coprime.of_dvd_left (b := aN * b₁N * b₂N) ?_ (hF p hp).2.2.2.2.2.2
        exact ⟨p.1, by ring⟩
      have hcenterlo : Δs k / C₁ ≤ centers k i :=
        (div_le_div_of_nonneg_left (hΔspos k).le (by norm_num) hC₁two).trans
          (hcenterData k i hi).1
      have hcenterhi : centers k i ≤ C₁ * Δs k :=
        (hcenterData k i hi).2.trans (mul_le_mul_of_nonneg_right hC₁two (hΔspos k).le)
      exact hTwoAt x hxtwo z.1 q₀ z.2.1 p.2.1 p.2.2 z.2.2 aN b₁N b₂N ℓ
        hr₁ hq₀ hu₁ hv₁ hv₂ hq₂
        (hbase p.2 (Finset.mem_image_of_mem Prod.snd hp)).1 hbasecop
        M N R₀ Q U V H Hstar (Δs k) (centers k i) γ
        hM hN hR₀ hQ hU hV (hΔsone k)
        hMNlo₁ hMNhi₁ hNγ hγlo hγhi hNR₁ hRhi₁ hRQlo₁ hRQhi₁ hHdef hH
        hUlo₁ hUhi₁ hVlo₁ hVhi₁ hUVlo₁ hUVhi₁ hrlo hrhi
        ((div_le_div_of_nonneg_left hU.le hCpos hCC₁).trans hulo)
        (huhi.trans (by gcongr))
        ((div_le_div_of_nonneg_left hV.le hCpos hCC₁).trans hv₁lo)
        (hv₁hi.trans (by gcongr))
        ((div_le_div_of_nonneg_left hV.le hCpos hCC₁).trans hv₂lo)
        (hv₂hi.trans (by gcongr))
        ((div_le_div_of_nonneg_left hQ.le (mul_pos hCpos hq₀real)
          (mul_le_mul_of_nonneg_right hCC₁ hq₀real.le)).trans hq₂lo)
        (hq₂hi.trans (by gcongr)) hq₀Q₁ hrough hΔlo hΔhi hcenterlo hcenterhi
        hℓne hℓbound₁ hHstarne hHstarlo₁ hHstarhi₁
        hNone hNx hRx hQx hHx hUx hCVx
        ψM ψN ψD hψM hψN hψD hsM hsN hsD hvalues hDvalues hderivatives hDderiv hJdata
    have hphysical := sourceSigmaOne_fixed_fiber_bound
      (Fs k z) (Ds k) (grids k) (centers k) J Isupport
      Hbound Kv x ε C₁ (Δs k) (Δshorts k) N V H cM TM M AM EM₀ AN EN₀ K₂ (g₀ : ℝ)
      ψM (fun t => ψN (t / N)) ψD z.1 q₀ z.2.1 z.2.2 aN b₁N b₂N ℓ
      hxe hε hC₁ (hΔspos k) hN hV hHpos rfl hr₁ hq₀ hu₁ hq₂
      hcM hMT hM hAM hAN hEM₀ hEN₀ hK₂ hg₀one hsM hMamp hNzero hNmass hJwindow
      hsD (fun t => (hDvalues t).1) hDmajor (hcenterNonneg k) (hcoverD k) hF
      hDcard (hgridCard k) hHbound hKvbound hlogKv hHV htwo
    have heq : (∑ p ∈ Fs k z, f (reconstruct z p)) =
        ∑ p ∈ Fs k z, ‖sourceDispersionFrequencyBlock (J ×ˢ J) ψM
          (fun t => ψN (t / N)) M (p.1 * z.1) q₀ z.2.1 p.2.1 p.2.2 z.2.2
            aN b₁N b₂N ℓ‖ := by
      apply Finset.sum_congr rfl
      intro p hp
      exact congrArg norm ((hcommon' k hk z hz p
        (Finset.mem_union_left _ hp)).2.2 (J ×ˢ J) ψM (fun t => ψN (t / N)) M ℓ).symm
    rw [heq]
    exact hphysical
  have htotal := sourceSigmaOne_total_fiber_bound 𝒯 d C₁ R₀ Q N U V (g₀ : ℝ) x ε Efinal Kfiber q₀
    hC₁ hR₀ hQ hN hU hV hg₀one hq₀ hxe hε hEfinal hKfiber
    (by
      intro t ht
      obtain ⟨hr, hu, _, _, hq₂, _, hrhi, _, huhi, _, _, _, _, _, hq₂hi, _⟩ := h𝒯 t ht
      obtain ⟨hdpos, hdvd, _, hdhi⟩ := hd𝒯 t ht
      exact ⟨hr, hu, hq₂, hdpos, hdvd, hrhi.trans (by gcongr),
        huhi.trans (by gcongr), hq₂hi.trans (by gcongr), hdhi.trans (hDtargetN.trans hNx)⟩)
    f hFibers
  have hlogAbsorb : Ktotal * (Real.log x) ^ (Efinal + 1) ≤ x ^ ε := hLogAt x hxlog
  have hpowers : x ^ (-5 * ε) * x ^ ε = x ^ (-4 * ε) := by
    rw [← Real.rpow_add hx0]
    congr 1
    ring
  calc
    (∑ t ∈ 𝒯, f t) ≤ Ktotal * (g₀ : ℝ) * R₀ * Q * N * U * V ^ 2 *
        x ^ (-5 * ε) * (Real.log x) ^ (Efinal + 1) := htotal
    _ = ((g₀ : ℝ) * R₀ * Q * N * U * V ^ 2 * x ^ (-5 * ε)) *
        (Ktotal * (Real.log x) ^ (Efinal + 1)) := by ring
    _ ≤ ((g₀ : ℝ) * R₀ * Q * N * U * V ^ 2 * x ^ (-5 * ε)) * x ^ ε :=
      mul_le_mul_of_nonneg_left hlogAbsorb (by positivity)
    _ = 1 * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * R₀ * Q * N * U * V ^ 2 * x ^ (-4 * ε) := by
      rw [mul_assoc, hpowers]
      simp only [g₀, one_mul]

open Classical in
theorem opening_uniform_band
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    («ω» δ ε C cM TM cN TN : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε)
    (hworking : 72 * «ω» + 24 * δ < 1) (hsmall : ε < δ / 10 ^ 100)
    (hC : 1 ≤ C) (hcM : 0 < cM) (hMT : cM ≤ TM)
    (hcN : 0 < cN) (hNT : cN ≤ TN)
    (dβ : ℕ) (Eβ : ℝ) (CM CN : ℕ → ℝ)
    (henvelopes : ∀ j : ℕ, 0 ≤ CM j ∧ 0 ≤ CN j)
    (ψM ψN : ℝ → ℝ) (hψM : ContDiff ℝ ∞ ψM) (hψN : ContDiff ℝ ∞ ψN)
    (hsupportM : Function.support ψM ⊆ Set.Icc cM TM)
    (hsupportN : Function.support ψN ⊆ Set.Icc cN TN)
    (hnonneg : ∀ t : ℝ, 0 ≤ ψM t ∧ 0 ≤ ψN t)
    (hderivatives : ∀ (j : ℕ) (t : ℝ),
      |iteratedDeriv j ψM t| ≤ CM j ∧ |iteratedDeriv j ψN t| ≤ CN j) :
    ∃ K X₀ : ℝ, 0 < K ∧ Real.exp 1 ≤ X₀ ∧
      ∀ x : ℝ, X₀ ≤ x →
      ∀ q₀ : ℕ, 0 < q₀ → Squarefree q₀ →
      ∀ a b₁ b₂ : ℕ, Nat.Coprime (a * b₁ * b₂) q₀ →
      ∀ (ℓ : ℤ) (M N R Q U V H Hstar γ : ℝ),
      0 < M → 0 < N → 0 < R → 0 < Q → 0 < U → 0 < V →
      x / C ≤ M * N → M * N ≤ C * x → N = x ^ γ →
      max (1 / 4 + 12 * «ω» + 4 * δ + 100 * ε)
        (32 * «ω» + 10 * δ + 400 * ε) ≤ γ →
      γ ≤ 1 / 2 - 4 * «ω» - 2 * δ - 50 * ε →
      N ≤ C * x ^ (δ + 4 * ε) * R →
      R ≤ C * x ^ (-2 * ε) * N →
      x ^ (1 / 2 - ε) ≤ C * R * Q →
      R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) → N ≤ x →
      H = x ^ ε * R * Q ^ 2 / ((q₀ : ℝ) * M) → 1 ≤ H →
      x ^ (-δ - 5 * ε) * Q / ((q₀ : ℝ) * H) ≤ C * U →
      U ≤ C * x ^ (-5 * ε) * Q / H →
      x ^ (5 * ε) * H / (q₀ : ℝ) ≤ C * V →
      V ≤ C * x ^ (δ + 5 * ε) * H →
      Q / (q₀ : ℝ) ≤ C * U * V → U * V ≤ C * Q / (q₀ : ℝ) →
      (q₀ : ℝ) ≤ C * Q →
      (∀ p ∈ q₀.primeFactors,
        Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (p : ℝ)) →
      ℓ ≠ 0 → |(ℓ : ℝ)| ≤ C * N / R →
      Hstar ≠ 0 → 1 ≤ C * |Hstar| → |Hstar| ≤ C * H →
      ∀ β : ℕ →₀ ℂ,
      (∀ n ∈ β.support, 0 < n ∧ (n : ℝ) ≤ TN * N ∧
        ‖β n‖ ≤ C * (n.divisors.card : ℝ) ^ dβ * (Real.log x) ^ Eβ ∧
        1 ≤ ψN ((n : ℝ) / N)) →
      ∀ (c : ℕ × ℕ → ℂ) (𝒜 : Finset (ℕ × ℕ × ℕ × ℕ)),
      (∀ t ∈ 𝒜,
        0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
        R ≤ (t.1 : ℝ) ∧ (t.1 : ℝ) ≤ 2 * R ∧
        U / C ≤ (t.2.1 : ℝ) ∧ (t.2.1 : ℝ) ≤ C * U ∧
        V / C ≤ (t.2.2.1 : ℝ) ∧ (t.2.2.1 : ℝ) ≤ C * V ∧
        Q / (C * (q₀ : ℝ)) ≤ (t.2.2.2 : ℝ) ∧
        (t.2.2.2 : ℝ) ≤ C * Q / (q₀ : ℝ) ∧
        Q ≤ ((q₀ * t.2.1 * t.2.2.1 : ℕ) : ℝ) ∧
        Q ≤ ((q₀ * t.2.2.2 : ℕ) : ℝ) ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ 1 t.1) ∧
        Squarefree (t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2) ∧
        Nat.Coprime (a * b₁ * b₂) (t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2)) →
      (∀ t ∈ 𝒜,
        ‖c (q₀ * t.2.1 * t.2.2.1, t.1)‖ ≤ 1 ∧
        ‖c (q₀ * t.2.2.2, t.1)‖ ≤ 1) →
      let Hbound : ℕ := ⌊2 * |Hstar|⌋₊
      let J : Finset ℤ :=
        (Finset.Icc (-(Hbound : ℤ)) (Hbound : ℤ)).filter
          (fun h => 1 ≤ (h : ℝ) / Hstar ∧ (h : ℝ) / Hstar < 2)
      let γβ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
      let P : (ℕ × ℕ × ℕ × ℕ) → ℕ := fun t =>
        t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2
      (∑ t ∈ 𝒜,
        ‖c (q₀ * t.2.1 * t.2.2.1, t.1) *
          star (c (q₀ * t.2.2.2, t.1)) * ((M : ℂ) / (P t : ℂ)) *
            ∑ n ∈ γβ.support.filter (fun n =>
              Int.gcd n ((t.1 * q₀ * t.2.1 * t.2.2.1 : ℕ) : ℤ) = 1 ∧
              Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2.2 : ℕ) : ℤ) = 1),
              γβ n * star (γβ (n + ℓ * (t.1 : ℤ))) *
                (sourceCompatibility t.1 q₀ b₁ b₂ ℓ n : ℂ) *
                  ∑ h ∈ J, sourcePhi ψM M (P t) h *
                    sourceTheta t.1 q₀ t.2.1 t.2.2.1 t.2.2.2
                      a b₁ b₂ ℓ n h‖) ≤
        K * M * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) / (q₀ : ℝ) *
          x ^ (-3 * ε / 2) := by
  let CSigma : ℝ := max 2 C
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hCCSigma : C ≤ CSigma := le_max_right _ _
  have htwoCSigma : 2 ≤ CSigma := le_max_left _ _
  have hCSigmaone : 1 ≤ CSigma := hC.trans hCCSigma
  have hCSigmapos : 0 < CSigma := hCpos.trans_le hCCSigma
  have hTNpos : 0 < TN := hcN.trans_le hNT
  obtain ⟨KSigma, XSigma, hKSigma, hXSigma, hSigma⟩ :=
    sourceSigmaOne_selected_family_bound_of_deligne hDeligne «ω» δ ε CSigma cM TM cN TN
      hω hδ hε hworking hsmall hCSigmaone hcM hMT hcN hNT
      CM (fun _ => 0) CN (fun _ => 0) henvelopes
  obtain ⟨XΓ, hGamma⟩ := Filter.eventually_atTop.mp
    (sourceGamma_uniform_subpower_bound dβ Eβ 1 ε C TN CSigma C C (1 / C) (1 / C)
      C «ω» δ ε (by norm_num) hε hCpos.le hTNpos hCSigmapos hCpos hCpos
      (div_pos zero_lt_one hCpos) (div_pos zero_lt_one hCpos) hCpos hω hδ hε)
  refine ⟨C * Real.sqrt KSigma + 1, max XSigma XΓ, ?_, hXSigma.trans (le_max_left _ _), ?_⟩
  · exact add_pos_of_nonneg_of_pos (mul_nonneg hCpos.le (Real.sqrt_nonneg KSigma)) zero_lt_one
  intro x hx q₀ hq₀ hq₀sf a b₁ b₂ hprimitive ℓ M N R Q U V H Hstar γ
    hM hN hR hQ hU hV hMNlo hMNhi hNγ hγlo hγhi hNR hRN hRQlo hRQhi hNx
    hHdef hHone hUlo hUhi hVlo hVhi hUVlo hUVhi hq₀Q hrough hℓ hℓbound
    hHstar hHstarlo hHstarhi β hβ c 𝒜 h𝒜 hc Hbound J γβ P
  have hxSigma : XSigma ≤ x := (le_max_left _ _).trans hx
  have hxΓ : XΓ ≤ x := (le_max_right _ _).trans hx
  have hxe : Real.exp 1 ≤ x := hXSigma.trans hxSigma
  have hxone : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hxe
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  have hqreal : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀
  have hHpos : 0 < H := zero_lt_one.trans_le hHone
  have hp (a : ℝ) : 0 < x ^ a := Real.rpow_pos_of_pos hxpos a
  have hb₁ : Nat.Coprime b₁ q₀ :=
    (Nat.coprime_mul_iff_left.mp (Nat.coprime_mul_iff_left.mp hprimitive).1).2
  have hIntPrimitive : Int.gcd ((a : ℤ) * b₁ * b₂) (q₀ : ℤ) = 1 := by
    have hh : Int.gcd ((a * b₁ * b₂ : ℕ) : ℤ) (q₀ : ℤ) = 1 := by
      rw [Int.gcd_natCast_natCast]
      exact hprimitive
    simpa only [Nat.cast_mul] using hh
  have hNlower : x ^ (1 / 4 + 12 * «ω» + 4 * δ + 100 * ε) ≤ N := by
    rw [hNγ]
    exact Real.rpow_le_rpow_of_exponent_le hxone ((le_max_left _ _).trans hγlo)
  have hRlower : (1 / C) * x ^ (-δ - 4 * ε) * N ≤ R := by
    calc
      (1 / C) * x ^ (-δ - 4 * ε) * N ≤
          ((1 / C) * x ^ (-δ - 4 * ε)) * (C * x ^ (δ + 4 * ε) * R) :=
        mul_le_mul_of_nonneg_left hNR (by positivity)
      _ = R := by
        rw [show -δ - 4 * ε = -(δ + 4 * ε) by ring, Real.rpow_neg hxpos.le]
        field_simp [hCpos.ne', (hp (δ + 4 * ε)).ne']
  have hGammaFamily : ∀ t ∈ 𝒜,
      0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2.2 ∧ Nat.Coprime t.1 q₀ ∧
      (t.1 : ℝ) ≤ CSigma * R ∧ (t.2.1 : ℝ) ≤ C * U ∧
      ((q₀ * t.2.2.2 : ℕ) : ℝ) ≤ C * Q := by
    intro t ht
    obtain ⟨hr, hu, _, hq₂, _, hrhi, _, huhi, _, _, _, hq₂hi,
      _, _, _, hsf, _⟩ := h𝒜 t ht
    have hrq₀ : Nat.Coprime t.1 q₀ :=
      Nat.coprime_of_squarefree_mul hsf.of_mul_left.of_mul_left.of_mul_left
    refine ⟨hr, hu, hq₂, hrq₀,
      hrhi.trans (mul_le_mul_of_nonneg_right htwoCSigma hR.le), huhi, ?_⟩
    have hh := (le_div_iff₀ hqreal).1 hq₂hi
    simpa only [Nat.cast_mul, mul_comm] using hh
  have hΓ := (hGamma x hxΓ 𝒜 β q₀ b₁ b₂ ℓ M N R Q U hq₀ hb₁
    hM hN hR hQ hU (by simpa only [Real.rpow_one] using hNx) hNlower
    (by simpa only [one_div, div_eq_mul_inv, mul_comm, mul_one] using hMNlo)
    hRlower hRQhi (by simpa only [← hHdef] using hHone)
    (fun n hn => ⟨(hβ n hn).1, (hβ n hn).2.1⟩)
    (fun n hn => (hβ n hn).2.2.1) hGammaFamily).2
  let Ω := (𝒜 ×ˢ 𝒜).filter (fun p =>
    p.2.1 = p.1.1 ∧ p.2.2.1 = p.1.2.1 ∧ p.2.2.2.2 = p.1.2.2.2)
  let 𝒯 : Finset (ℕ × ℕ × ℕ × ℕ × ℕ) := Ω.image (fun p =>
    (p.1.1, p.1.2.1, p.1.2.2.1, p.2.2.2.1, p.1.2.2.2))
  have hTFamily : ∀ t ∈ 𝒯,
      0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2.1 ∧ 0 < t.2.2.2.2 ∧
      R / CSigma ≤ (t.1 : ℝ) ∧ (t.1 : ℝ) ≤ CSigma * R ∧
      U / CSigma ≤ (t.2.1 : ℝ) ∧ (t.2.1 : ℝ) ≤ CSigma * U ∧
      V / CSigma ≤ (t.2.2.1 : ℝ) ∧ (t.2.2.1 : ℝ) ≤ CSigma * V ∧
      V / CSigma ≤ (t.2.2.2.1 : ℝ) ∧ (t.2.2.2.1 : ℝ) ≤ CSigma * V ∧
      Q / (CSigma * (q₀ : ℝ)) ≤ (t.2.2.2.2 : ℝ) ∧
      (t.2.2.2.2 : ℝ) ≤ CSigma * Q / (q₀ : ℝ) ∧
      Nonempty (DenseDivisibilityWitness
        ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ 1 t.1) ∧
      Squarefree (t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2.2) ∧
      Squarefree (t.1 * q₀ * t.2.1 * t.2.2.2.1 * t.2.2.2.2) ∧
      Int.gcd ((a : ℤ) * b₁ * b₂)
        ((t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2.1 * t.2.2.2.2 : ℕ) : ℤ) = 1 := by
    clear * - h𝒜 hCpos hCSigmaone htwoCSigma hCCSigma hR hU hV hQ hqreal
    intro t ht
    obtain ⟨p, hpΩ, rfl⟩ := Finset.mem_image.mp ht
    obtain ⟨hpA, hpEq⟩ := Finset.mem_filter.mp hpΩ
    obtain ⟨hp₁, hp₂⟩ := Finset.mem_product.mp hpA
    rcases p with ⟨⟨r, u, v₁, q₂⟩, ⟨s, w, v₂, z⟩⟩
    change s = r ∧ w = u ∧ z = q₂ at hpEq
    rcases hpEq with ⟨hs, hw, hz⟩
    subst s
    subst w
    subst z
    obtain ⟨hr, hu, hv₁, hq₂, hrlo, hrhi, hulo, huhi, hv₁lo, hv₁hi,
      hq₂lo, hq₂hi, _, _, hdense, hsf₁, hprimitive₁⟩ := h𝒜 _ hp₁
    obtain ⟨_, _, hv₂, _, _, _, _, _, hv₂lo, hv₂hi, _, _, _, _, _,
      hsf₂, hprimitive₂⟩ := h𝒜 _ hp₂
    have hprimitiveV₂ : Nat.Coprime (a * b₁ * b₂) v₂ :=
      hprimitive₂.of_dvd_right (dvd_mul_of_dvd_left (dvd_mul_left v₂ (r * q₀ * u)) q₂)
    have hfull : Nat.Coprime (a * b₁ * b₂) (r * q₀ * u * v₁ * v₂ * q₂) := by
      simpa only [mul_assoc, mul_comm, mul_left_comm] using
        hprimitive₁.mul_right hprimitiveV₂
    have hfullInt : Int.gcd ((a : ℤ) * b₁ * b₂)
        ((r * q₀ * u * v₁ * v₂ * q₂ : ℕ) : ℤ) = 1 := by
      have hh : Int.gcd ((a * b₁ * b₂ : ℕ) : ℤ)
          ((r * q₀ * u * v₁ * v₂ * q₂ : ℕ) : ℤ) = 1 := by
        rw [Int.gcd_natCast_natCast]
        exact hfull
      simpa only [Nat.cast_mul] using hh
    refine ⟨hr, hu, hv₁, hv₂, hq₂, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_,
      hdense, hsf₁, hsf₂, hfullInt⟩
    · exact (div_le_self hR.le hCSigmaone).trans hrlo
    · exact hrhi.trans (mul_le_mul_of_nonneg_right htwoCSigma hR.le)
    · exact (div_le_div_of_nonneg_left hU.le hCpos hCCSigma).trans hulo
    · exact huhi.trans (mul_le_mul_of_nonneg_right hCCSigma hU.le)
    · exact (div_le_div_of_nonneg_left hV.le hCpos hCCSigma).trans hv₁lo
    · exact hv₁hi.trans (mul_le_mul_of_nonneg_right hCCSigma hV.le)
    · exact (div_le_div_of_nonneg_left hV.le hCpos hCCSigma).trans hv₂lo
    · exact hv₂hi.trans (mul_le_mul_of_nonneg_right hCCSigma hV.le)
    · exact (div_le_div_of_nonneg_left hQ.le (mul_pos hCpos hqreal)
        (mul_le_mul_of_nonneg_right hCCSigma hqreal.le)).trans hq₂lo
    · exact hq₂hi.trans (div_le_div_of_nonneg_right
        (mul_le_mul_of_nonneg_right hCCSigma hQ.le) hqreal.le)
  have hMNloSigma : x / CSigma ≤ M * N :=
    (div_le_div_of_nonneg_left hxpos.le hCpos hCCSigma).trans hMNlo
  have hMNhiSigma : M * N ≤ CSigma * x :=
    hMNhi.trans (mul_le_mul_of_nonneg_right hCCSigma hxpos.le)
  have hNRSigma : N ≤ CSigma * x ^ (δ + 4 * ε) * R :=
    hNR.trans (mul_le_mul_of_nonneg_right
      (mul_le_mul_of_nonneg_right hCCSigma (hp (δ + 4 * ε)).le) hR.le)
  have hRNSigma : R ≤ CSigma * x ^ (-2 * ε) * N :=
    hRN.trans (mul_le_mul_of_nonneg_right
      (mul_le_mul_of_nonneg_right hCCSigma (hp (-2 * ε)).le) hN.le)
  have hRQloSigma : x ^ (1 / 2 - ε) ≤ CSigma * R * Q :=
    hRQlo.trans (mul_le_mul_of_nonneg_right
      (mul_le_mul_of_nonneg_right hCCSigma hR.le) hQ.le)
  have hRQhiSigma : R * Q ≤ CSigma * x ^ (1 / 2 + 2 * «ω» + ε) :=
    hRQhi.trans (mul_le_mul_of_nonneg_right hCCSigma (hp (1 / 2 + 2 * «ω» + ε)).le)
  have hUloSigma : x ^ (-δ - 5 * ε) * Q / ((q₀ : ℝ) * H) ≤ CSigma * U :=
    hUlo.trans (mul_le_mul_of_nonneg_right hCCSigma hU.le)
  have hUhiSigma : U ≤ CSigma * x ^ (-5 * ε) * Q / H :=
    hUhi.trans (div_le_div_of_nonneg_right
      (mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_right hCCSigma (hp (-5 * ε)).le) hQ.le) hHpos.le)
  have hVloSigma : x ^ (5 * ε) * H / (q₀ : ℝ) ≤ CSigma * V :=
    hVlo.trans (mul_le_mul_of_nonneg_right hCCSigma hV.le)
  have hVhiSigma : V ≤ CSigma * x ^ (δ + 5 * ε) * H :=
    hVhi.trans (mul_le_mul_of_nonneg_right
      (mul_le_mul_of_nonneg_right hCCSigma (hp (δ + 5 * ε)).le) hHpos.le)
  have hUVloSigma : Q / (q₀ : ℝ) ≤ CSigma * U * V :=
    hUVlo.trans (mul_le_mul_of_nonneg_right
      (mul_le_mul_of_nonneg_right hCCSigma hU.le) hV.le)
  have hUVhiSigma : U * V ≤ CSigma * Q / (q₀ : ℝ) :=
    hUVhi.trans (div_le_div_of_nonneg_right
      (mul_le_mul_of_nonneg_right hCCSigma hQ.le) hqreal.le)
  have hq₀QSigma : (q₀ : ℝ) ≤ CSigma * Q :=
    hq₀Q.trans (mul_le_mul_of_nonneg_right hCCSigma hQ.le)
  have hℓboundSigma : |(ℓ : ℝ)| ≤ CSigma * N / R :=
    hℓbound.trans (div_le_div_of_nonneg_right
      (mul_le_mul_of_nonneg_right hCCSigma hN.le) hR.le)
  have hHstarloSigma : 1 ≤ CSigma * |Hstar| :=
    hHstarlo.trans (mul_le_mul_of_nonneg_right hCCSigma (abs_nonneg Hstar))
  have hHstarhiSigma : |Hstar| ≤ CSigma * H :=
    hHstarhi.trans (mul_le_mul_of_nonneg_right hCCSigma hHpos.le)
  have hSigma := hSigma x hxSigma q₀ hq₀ hq₀sf (a : ℤ) (b₁ : ℤ) (b₂ : ℤ) ℓ
    hIntPrimitive M N R Q U V H Hstar γ hM hN hR hQ hU hV
    hMNloSigma hMNhiSigma hNγ hγlo hγhi hNRSigma hRNSigma hRQloSigma hRQhiSigma hHdef hHone
    hUloSigma hUhiSigma hVloSigma hVhiSigma hUVloSigma hUVhiSigma hq₀QSigma hrough hℓ hℓboundSigma
    hHstar hHstarloSigma hHstarhiSigma ψM ψN hψM hψN hsupportM hsupportN hnonneg
    (by intro j t; simpa only [Real.rpow_zero, mul_one] using hderivatives j t)
    𝒯 hTFamily
  have hBasicFamily : ∀ t ∈ 𝒜,
      0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
      R ≤ (t.1 : ℝ) ∧ Q ≤ ((q₀ * t.2.1 * t.2.2.1 : ℕ) : ℝ) ∧
      Q ≤ ((q₀ * t.2.2.2 : ℕ) : ℝ) := by
    intro t ht
    obtain ⟨hr, hu, hv, hq₂, hrlo, _, _, _, _, _, _, _, hq₁, hq₂orig,
      _, _, _⟩ := h𝒜 t ht
    exact ⟨hr, hu, hv, hq₂, hrlo, hq₁, hq₂orig⟩
  have hBound := opening_band_cauchy 𝒜 β c q₀ a b₁ b₂ ℓ J ψM ψN
    C KSigma x ε cN TN M N R Q U V hq₀ hCpos.le hKSigma.le hxpos hcN hNT
    hM hN hR hQ hU.le hV.le hUVhi hsupportN (fun t => (hnonneg t).2)
    (fun n hn => (hβ n hn).2.2.2) hBasicFamily hc hΓ hSigma
  apply hBound.trans
  exact mul_le_mul_of_nonneg_right
    (div_le_div_of_nonneg_right
      (mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_right (le_add_of_nonneg_right zero_le_one) hM.le)
          hN.le) (Nat.cast_nonneg _)) hqreal.le)
    (Real.rpow_nonneg hxpos.le _)

theorem sourceDeltaZero_rough_dyadic_uniform_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    («ω» δ ε C cM TM cN TN : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε)
    (hworking : 72 * «ω» + 24 * δ < 1) (hsmall : ε < δ / 10 ^ 100)
    (hC : 1 ≤ C) (hcM : 0 < cM) (hMT : cM ≤ TM)
    (hcN : 0 < cN) (hNT : cN ≤ TN)
    (dα dβ : ℕ) (Eα Eβ A η : ℝ) (hA : 0 < A) (hη : 0 < η) :
    ∃ X₀ : ℝ, Real.exp 1 ≤ X₀ ∧
      ∀ (x : ℝ), X₀ ≤ x →
      ∀ (M N R Q γ : ℝ),
      0 < M → 0 < N → 0 < R → 0 < Q →
      x / C ≤ M * N → M * N ≤ C * x → N = x ^ γ →
      max (1 / 4 + 12 * «ω» + 4 * δ + 100 * ε)
        (32 * «ω» + 10 * δ + 400 * ε) ≤ γ →
      γ ≤ 1 / 2 - 4 * «ω» - 2 * δ - 50 * ε →
      N ≤ C * x ^ (δ + 4 * ε) * R →
      R ≤ C * x ^ (-2 * ε) * N →
      x ^ (1 / 2 - ε) ≤ C * R * Q →
      R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) →
      ∀ (α β : ℕ →₀ ℂ),
      (∀ n ∈ α.support,
        cM * M ≤ (n : ℝ) ∧ (n : ℝ) ≤ TM * M ∧
        ‖α n‖ ≤ C * (n.divisors.card : ℝ) ^ dα * (Real.log x) ^ Eα) →
      (∀ n ∈ β.support,
        cN * N ≤ (n : ℝ) ∧ (n : ℝ) ≤ TN * N ∧
        ‖β n‖ ≤ C * (n.divisors.card : ℝ) ^ dβ * (Real.log x) ^ Eβ) →
      ∀ (S : Finset (ℕ × ℕ)),
      (∀ p ∈ S,
        0 < p.1 ∧ 0 < p.2 ∧ Squarefree (p.1 * p.2) ∧
        Q ≤ (p.1 : ℝ) ∧ (p.1 : ℝ) ≤ 2 * Q ∧
        R ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ 2 * R ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ 1 p.1) ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ 1 p.2) ∧
        (∀ t ∈ p.1.primeFactors,
          Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (t : ℝ))) →
      ∀ (a b₁ b₂ : ℕ),
      (∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2)) →
      (∑ p ∈ S,
        ‖deltaZero (finiteConvolution α β) p.1 p.2 a b₁ b₂‖) ≤
          η * (M * N) * (Real.log x) ^ (-A)
:= by
  classical
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hTMpos : 0 < TM := hcM.trans_le hMT
  have hTNpos : 0 < TN := hcN.trans_le hNT
  have hεone : ε ≤ 1 := by
    have hεδ : ε < δ := hsmall.trans_le (div_le_self hδ.le (by norm_num))
    linarith only [hεδ, hworking, hω]
  obtain ⟨ψM, hψM, hsM, hMnonneg, hMmajor, hMderivatives⟩ := opening_majorant cM TM hcM hMT
  obtain ⟨ψN, hψN, hsN, hNnonneg, hNmajor, hNderivatives⟩ := opening_majorant cN TN hcN hNT
  choose CM hCM hCMbound using hMderivatives
  choose CN hCN hCNbound using hNderivatives
  let C₀ : ℝ := 4 * (C + TM + TN + 1)
  have hC₀four : 4 ≤ C₀ := by dsimp only [C₀]; nlinarith
  have hC₀ : 1 ≤ C₀ := by linarith
  have hC₀pos : 0 < C₀ := zero_lt_one.trans_le hC₀
  have hCC₀ : C ≤ C₀ := by dsimp only [C₀]; nlinarith
  have hTN₀ : 2 * TN ≤ C₀ := by dsimp only [C₀]; nlinarith
  have hMinterval : cM / 2 ≤ 2 * TM := by linarith
  have hNinterval : cN / 2 ≤ 2 * TN := by linarith
  obtain ⟨Kband, Xband, hKband, hXband, hBandAt⟩ :=
    opening_uniform_band hDeligne «ω» δ ε C₀ (cM / 2) (2 * TM) (cN / 2) (2 * TN)
      hω hδ hε hworking hsmall hC₀ (by positivity) hMinterval (by positivity) hNinterval
      dβ Eβ CM CN (fun j => ⟨hCM j, hCN j⟩) ψM ψN hψM hψN hsM hsN
      (fun t => ⟨hMnonneg t, hNnonneg t⟩)
      (fun j t => ⟨by simpa only [Real.norm_eq_abs] using hCMbound j t,
        by simpa only [Real.norm_eq_abs] using hCNbound j t⟩)
  obtain ⟨Kα, Fα, hKα, hMomentAt⟩ := opening_moment dα Eα C TM hCpos.le hTMpos
  let D : ℝ := 2 * A + |Fα| + 2
  have hD : 0 < D := by dsimp only [D]; positivity
  let k : ℕ := Nat.ceil ((1 + ((2 * dβ + 5 : ℕ) : ℝ) * 2 + 2) / ε)
  let Ltail : ℝ := max (CM 0) (CM (k + 2))
  have hLtail : 0 ≤ Ltail := (hCM 0).trans (le_max_left _ _)
  have hTailAt := (opening_padded_truncation dβ Eβ 2 C ε 1
    (by norm_num) hCpos.le hε (by norm_num)).2
      (cM / 2) (2 * TM) Ltail 0 (by positivity) hMinterval hLtail
  let Lzero : ℝ := max (CM 0) (max (CM 1) (CM 2))
  have hLzero : 0 ≤ Lzero := (hCM 0).trans (le_max_left _ _)
  have hZeroAt := opening_zero_mode dβ Eβ C TN (2 * TM) Lzero ε D
    hCpos hTNpos (by positivity) hLzero hε ψM (hψM.of_le (by simp))
    (hsM.trans (Set.Icc_subset_Icc_left (by linarith))) (by
      intro t
      refine ⟨(by simpa only [iteratedDeriv_zero, Real.norm_eq_abs] using
        (hCMbound 0 t).trans (le_max_left _ _)), ?_, ?_⟩
      · simpa only [iteratedDeriv_one, Real.norm_eq_abs] using
          (hCMbound 1 t).trans ((le_max_left _ _).trans (le_max_right _ _))
      · simpa only [iteratedDeriv_succ, iteratedDeriv_one, iteratedDeriv_zero,
          Real.norm_eq_abs] using
          (hCMbound 2 t).trans ((le_max_right _ _).trans (le_max_right _ _)))
  have hDiagonalAt := mixedCorrelation_diagonal_paper_scale_uniform dβ «ω» δ ε C₀
    (2 * TM) C (CM 0) Eβ 0 D hω hδ hε hC₀ (by positivity) hCpos.le (hCM 0) hD.le
  let Bcount : ℝ := 2 + 4 / Real.log 2
  have hBcount : 0 < Bcount := by
    dsimp only [Bcount]
    have : 0 < Real.log 2 := Real.log_pos (by norm_num)
    positivity
  let Koff : ℝ := 36 * Kband * Bcount ^ 2 * (2 * TN)
  have hKoff : 0 < Koff := by dsimp only [Koff]; positivity
  have hLogAbsorb (K E ρ : ℝ) (hρ : 0 < ρ) :
      ∀ᶠ x : ℝ in Filter.atTop, K * (Real.log x) ^ E ≤ x ^ ρ := by
    clear * - hρ
    filter_upwards [((isLittleO_log_rpow_rpow_atTop E hρ).const_mul_left K).eventuallyLE,
      Filter.eventually_ge_atTop (0 : ℝ)] with x hx hx0
    exact (le_abs_self _).trans (by
      simpa only [Real.norm_eq_abs, abs_of_nonneg (Real.rpow_nonneg hx0 ρ)] using hx)
  have hmain : ∀ᶠ x : ℝ in Filter.atTop,
      ∀ (M N R Q γ : ℝ), 0 < M → 0 < N → 0 < R → 0 < Q →
      x / C ≤ M * N → M * N ≤ C * x → N = x ^ γ →
      max (1 / 4 + 12 * «ω» + 4 * δ + 100 * ε)
        (32 * «ω» + 10 * δ + 400 * ε) ≤ γ →
      γ ≤ 1 / 2 - 4 * «ω» - 2 * δ - 50 * ε →
      N ≤ C * x ^ (δ + 4 * ε) * R → R ≤ C * x ^ (-2 * ε) * N →
      x ^ (1 / 2 - ε) ≤ C * R * Q → R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) →
      ∀ (α β : ℕ →₀ ℂ),
      (∀ n ∈ α.support, cM * M ≤ (n : ℝ) ∧ (n : ℝ) ≤ TM * M ∧
        ‖α n‖ ≤ C * (n.divisors.card : ℝ) ^ dα * (Real.log x) ^ Eα) →
      (∀ n ∈ β.support, cN * N ≤ (n : ℝ) ∧ (n : ℝ) ≤ TN * N ∧
        ‖β n‖ ≤ C * (n.divisors.card : ℝ) ^ dβ * (Real.log x) ^ Eβ) →
      ∀ (S : Finset (ℕ × ℕ)),
      (∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Squarefree (p.1 * p.2) ∧
        Q ≤ (p.1 : ℝ) ∧ (p.1 : ℝ) ≤ 2 * Q ∧
        R ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ 2 * R ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ 1 p.1) ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ 1 p.2) ∧
        (∀ t ∈ p.1.primeFactors,
          Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (t : ℝ))) →
      ∀ (a b₁ b₂ : ℕ), (∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2)) →
      (∑ p ∈ S, ‖deltaZero (finiteConvolution α β) p.1 p.2 a b₁ b₂‖) ≤
        η * (M * N) * (Real.log x) ^ (-A) := by
    filter_upwards [opening_scale_resources C₀ «ω» δ ε hC₀ hω hδ hε hworking hsmall,
      hMomentAt, hZeroAt, hDiagonalAt, hTailAt,
      hLogAbsorb Koff (4 + D) (3 * ε / 2) (by positivity),
      hLogAbsorb 1 D 1 zero_lt_one,
      Filter.eventually_ge_atTop Xband,
      Filter.eventually_ge_atTop (max (C₀ ^ 2) (max (2 * TN)
        (Real.exp (max 1 (26 * Kα / η ^ 2)))))]
      with x hscales hmomentAt hzeroAt hdiagonalAt htailAt hoffAbsorb htailAbsorb hxband hxlarge
    obtain ⟨hxexp, hxtwo, htarget, hscaleAt⟩ := hscales
    have hx1 : 1 ≤ x := (by norm_num : (1 : ℝ) ≤ 2).trans hxtwo
    have hx0 : 0 < x := zero_lt_one.trans_le hx1
    have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hxexp
    have hlog0 : 0 < Real.log x := zero_lt_one.trans_le hlog1
    have hC₀square : C₀ ^ 2 ≤ x := (le_max_left _ _).trans hxlarge
    have hTNx : 2 * TN ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans hxlarge)
    intro M N R Q γ hM hN hR hQ hMNlo hMNhi hNγ hγlo hγhi hNR hRhi hRQlo hRQhi
      α β hα hβ S hS a b₁ b₂ hprim
    have hMNlo₀ : x / C₀ ≤ M * N :=
      (div_le_div_of_nonneg_left hx0.le hCpos hCC₀).trans hMNlo
    have hMNhi₀ : M * N ≤ C₀ * x := hMNhi.trans
      (mul_le_mul_of_nonneg_right hCC₀ hx0.le)
    have hNR₀ : N ≤ C₀ * x ^ (δ + 4 * ε) * R := hNR.trans
      (mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_right hCC₀ (Real.rpow_nonneg hx0.le _)) hR.le)
    have hRhi₀ : R ≤ C₀ * x ^ (-2 * ε) * N := hRhi.trans
      (mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_right hCC₀ (Real.rpow_nonneg hx0.le _)) hN.le)
    have hRQlo₀ : x ^ (1 / 2 - ε) ≤ C₀ * R * Q := hRQlo.trans
      (mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_right hCC₀ hR.le) hQ.le)
    have hRQhi₀ : R * Q ≤ C₀ * x ^ (1 / 2 + 2 * «ω» + ε) := hRQhi.trans
      (mul_le_mul_of_nonneg_right hCC₀ (Real.rpow_nonneg hx0.le _))
    obtain ⟨hNone, hNx, hMone, hMx, hRx, hQx, hMshort⟩ :=
      hscaleAt M N R Q γ hM hN hR hQ hMNlo₀ hMNhi₀ hNγ hγlo hγhi hNR₀ hRhi₀ hRQhi₀
    have hSsimple : ∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Squarefree (p.1 * p.2) := by
      intro p hp
      exact ⟨(hS p hp).1, (hS p hp).2.1, (hS p hp).2.2.1⟩
    have hScoprime : ∀ p ∈ S, Nat.Coprime p.1 p.2 :=
      fun p hp => Nat.coprime_of_squarefree_mul (hSsimple p hp).2.2
    have hβpos (n : ℕ) (hn : n ∈ β.support) : 0 < n := by
      exact_mod_cast (mul_pos hcN hN).trans_le (hβ n hn).1
    have hαpos (n : ℕ) (hn : n ∈ α.support) : 0 < n := by
      exact_mod_cast (mul_pos hcM hM).trans_le (hα n hn).1
    let NI : ℕ := ⌊TN * N⌋₊
    have hβsupport : β.support ⊆ Finset.Icc 1 NI := fun n hn =>
      Finset.mem_Icc.mpr ⟨hβpos n hn, Nat.le_floor (hβ n hn).2.1⟩
    have hNI : (NI : ℝ) ≤ TN * N := Nat.floor_le (by positivity)
    have hNIx : (NI : ℝ) ≤ x ^ (2 : ℝ) := by
      rw [Real.rpow_two]
      calc
        (NI : ℝ) ≤ TN * N := hNI
        _ ≤ x * x := mul_le_mul (by linarith only [hTNx, hTNpos]) hNx hN.le hx0.le
        _ = x ^ 2 := (pow_two x).symm
    have hNIscale : (NI : ℝ) ≤ C₀ * N := hNI.trans
      (mul_le_mul_of_nonneg_right (by linarith only [hTN₀, hTNpos]) hN.le)
    let sm : Finset ℕ := Finset.Icc 1 ⌊(2 * TM) * M⌋₊
    let w : ℕ → ℝ := fun n => ψM ((n : ℝ) / M)
    have hsm : α.support ⊆ sm := by
      intro n hn
      refine Finset.mem_Icc.mpr ⟨hαpos n hn, Nat.le_floor ?_⟩
      exact (hα n hn).2.1.trans (by nlinarith only [hTMpos, hM])
    have hw0 : ∀ n ∈ sm, 0 ≤ w n := fun n _ => hMnonneg _
    have hw1 : ∀ n ∈ α.support, 1 ≤ w n := by
      intro n hn
      exact hMmajor _ ⟨(le_div_iff₀ hM).mpr (hα n hn).1,
        (div_le_iff₀ hM).mpr (hα n hn).2.1⟩
    have hψNmajor : ∀ n ∈ β.support, 1 ≤ ψN ((n : ℝ) / N) := by
      intro n hn
      exact hNmajor _ ⟨(le_div_iff₀ hN).mpr (hβ n hn).1,
        (div_le_iff₀ hN).mpr (hβ n hn).2.1⟩
    have hαmoment := hmomentAt M hM hMx α (fun n hn =>
      ⟨hαpos n hn, (hα n hn).2.1, (hα n hn).2.2⟩)
    let H : ℕ → ℝ := fun g => x ^ ε * R * Q ^ 2 / ((g : ℝ) * M)
    let X : ℕ → ℝ := fun g => x ^ (-5 * ε) * Q / H g
    let Y : Set.Ici (1 : ℝ) :=
      ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩
    obtain ⟨u₀, hu₀⟩ := opening_coherent_dense_selector Y Q hQ X
    let u : ℕ → ℕ → ℕ := fun g q => if 1 ≤ H g then u₀ g (g * q) else 1
    let shells : ℕ → ℕ := fun g => if H g < 1 then 0 else Nat.log 2 ⌊H g⌋₊ + 1
    let J : ℕ → Finset ℤ := fun g =>
      (Finset.Ioo (-((2 : ℤ) ^ shells g)) ((2 : ℤ) ^ shells g)).erase 0
    have hXwindow (g : ℕ) (hg : 0 < g) (hH : 1 ≤ H g) : 1 ≤ X g ∧ X g ≤ Q :=
      opening_selector_target_window C₀ x ε Q (H g) (2 * «ω» + 2 * δ + 43 * ε)
        g hC₀ hx1 hε.le hQ hH hg htarget
        (opening_selector_target_lower C₀ x «ω» δ ε M N R Q (H g) γ g hC₀ hx1
          hM hN hR hQ hg hMNlo₀ hNγ hγhi hRQhi₀ rfl)
    have hu : ∀ p₁ ∈ S, ∀ p₂ ∈ S, p₁.2 = p₂.2 →
        let g := Nat.gcd p₁.1 p₂.1
        0 < u g (p₁.1 / g) ∧ u g (p₁.1 / g) ∣ p₁.1 / g := by
      intro p₁ hp₁ p₂ hp₂ _ g
      have hg : 0 < g := Nat.gcd_pos_of_pos_left _ (hSsimple p₁ hp₁).1
      have hgq : g ∣ p₁.1 := Nat.gcd_dvd_left _ _
      by_cases hH : 1 ≤ H g
      · have hrec : g * (p₁.1 / g) = p₁.1 := Nat.mul_div_cancel' hgq
        have hw := hXwindow g hg hH
        obtain ⟨_, _, _, hlo, hhi, _, _, hdense, _, _⟩ := hS p₁ hp₁
        have hs := hu₀ g p₁.1 hg hgq hlo hhi hdense hw.1 hw.2
        simpa only [u, ite_eq_left hH, hrec] using ⟨hs.1, hs.2.2.1⟩
      · simp only [u, ite_eq_right hH, zero_lt_one, one_dvd, and_self]
    let Ω : Finset ((ℕ × ℕ) × (ℕ × ℕ)) :=
      (S ×ˢ S).filter (fun p => p.1.2 = p.2.2)
    let G : Finset ℕ := Ω.image (fun p => Nat.gcd p.1.1 p.2.1)
    let 𝒜 : ℕ → Finset (ℕ × ℕ × ℕ × ℕ) := fun g =>
      (Ω.filter (fun p => Nat.gcd p.1.1 p.2.1 = g)).image (fun p =>
        (p.1.2, u g (p.1.1 / g), (p.1.1 / g) / u g (p.1.1 / g), p.2.1 / g))
    let γβ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
    let L : ℕ → Finset ℤ := fun r =>
      ((γβ.support ×ˢ γβ.support).filter
        (fun p => p.1 ≠ p.2 ∧ Int.ModEq (r : ℤ) p.1 p.2)).image
          (fun p => (p.2 - p.1) / (r : ℤ))
    let LI : ℕ := ⌊(2 * TN) * N / R⌋₊
    let Lall : Finset ℤ := (Finset.Icc (-(LI : ℤ)) (LI : ℤ)).erase 0
    let bins : ℕ → Finset ℕ := fun g => (𝒜 g).image (fun t => Nat.log 2 t.2.1)
    let block : ℕ → ℤ → ℕ → Finset (ℕ × ℕ × ℕ × ℕ) := fun g ℓ i =>
      (𝒜 g).filter (fun t => ℓ ∈ L t.1 ∧ Nat.log 2 t.2.1 = i)
    have hfactor := mixedFourier_offDiagonal_gcd_shift_factorization
      sm w S β (fun _ => 0) a b₁ b₂ J u hSsimple hprim hu
    have hGdata (g : ℕ) (hg : g ∈ G) :
        0 < g ∧ Squarefree g ∧ (g : ℝ) ≤ 2 * Q ∧
        Nat.Coprime (a * b₁ * b₂) g ∧
        ∀ p ∈ g.primeFactors,
          Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (p : ℝ) := by
      obtain ⟨p, hpΩ, hpg⟩ := Finset.mem_image.mp hg
      obtain ⟨hp₁, _⟩ := Finset.mem_product.mp (Finset.mem_filter.mp hpΩ).1
      obtain ⟨hq, _, hsf, _, hqhi, _, _, _, _, hrough⟩ := hS p.1 hp₁
      have hgdvd : g ∣ p.1.1 := by
        rw [← hpg]
        exact Nat.gcd_dvd_left _ _
      have hgpos : 0 < g := by
        rw [← hpg]
        exact Nat.gcd_pos_of_pos_left _ hq
      have hgle : (g : ℝ) ≤ (p.1.1 : ℝ) := by
        exact_mod_cast Nat.le_of_dvd hq hgdvd
      refine ⟨hgpos, hsf.of_mul_left.squarefree_of_dvd hgdvd, hgle.trans hqhi,
        (hprim p.1 hp₁).of_dvd_right (dvd_mul_of_dvd_left hgdvd p.1.2), ?_⟩
      intro t ht
      exact hrough t (Nat.primeFactors_mono hgdvd hq.ne' ht)
    have hLall : ∀ r ∈ S.image Prod.snd, L r ⊆ Lall := by
      intro r hr ℓ hℓ
      have hℓne : ℓ ≠ 0 := (hfactor.2.1 r hr ℓ hℓ).1
      have hsupport0 : β.support ⊆ Finset.Icc 0 (0 + NI) := by
        intro n hn
        exact Finset.mem_Icc.mpr
          ⟨Nat.zero_le n, by simpa only [zero_add] using (Finset.mem_Icc.mp (hβsupport hn)).2⟩
      have hnat : ℓ.natAbs * r ≤ NI := hfactor.2.2.1 0 NI hsupport0 r hr ℓ hℓ
      have hRr : R ≤ (r : ℝ) := by
        obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hr
        obtain ⟨_, _, _, _, _, hrlow, _, _, _, _⟩ := hS p hp
        exact hrlow
      have hreal : (ℓ.natAbs : ℝ) * (r : ℝ) ≤ (NI : ℝ) := by exact_mod_cast hnat
      have hratio : (ℓ.natAbs : ℝ) ≤ (2 * TN) * N / R := by
        apply (le_div_iff₀ hR).2
        calc
          (ℓ.natAbs : ℝ) * R ≤ (ℓ.natAbs : ℝ) * (r : ℝ) :=
            mul_le_mul_of_nonneg_left hRr (Nat.cast_nonneg _)
          _ ≤ (NI : ℝ) := hreal
          _ ≤ TN * N := hNI
          _ ≤ (2 * TN) * N :=
            mul_le_mul_of_nonneg_right (by linarith only [hTNpos]) hN.le
      have hℓLI : ℓ.natAbs ≤ LI := Nat.le_floor hratio
      have hℓabs : |ℓ| ≤ (LI : ℤ) := by
        have hh : (ℓ.natAbs : ℤ) ≤ (LI : ℤ) := by exact_mod_cast hℓLI
        simpa only [Int.natCast_natAbs] using hh
      exact Finset.mem_erase.mpr ⟨hℓne, Finset.mem_Icc.mpr (abs_le.mp hℓabs)⟩
    have hSelected (g : ℕ) (hg : g ∈ G) (hH : 1 ≤ H g)
        (t : ℕ × ℕ × ℕ × ℕ) (ht : t ∈ 𝒜 g) :
        X g / ((g : ℝ) * x ^ δ) ≤ (t.2.1 : ℝ) ∧ (t.2.1 : ℝ) ≤ X g := by
      obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp ht
      have hpg := (Finset.mem_filter.mp hp).2
      have hpΩ := Finset.mem_filter.mp (Finset.mem_filter.mp hp).1
      obtain ⟨hp₁, _⟩ := Finset.mem_product.mp hpΩ.1
      have hgpos := (hGdata g hg).1
      have hgq : g ∣ p.1.1 := by rw [← hpg]; exact Nat.gcd_dvd_left _ _
      have hrec : g * (p.1.1 / g) = p.1.1 := Nat.mul_div_cancel' hgq
      obtain ⟨_, _, _, hqlo, hqhi, _, _, hdense, _, _⟩ := hS p.1 hp₁
      have hwindow := hXwindow g hgpos hH
      have hchoice := hu₀ g p.1.1 hgpos hgq hqlo hqhi hdense hwindow.1 hwindow.2
      have hY : (Y : ℝ) = x ^ δ := max_eq_right (Real.one_le_rpow hx1 hδ.le)
      simpa only [u, ite_eq_left hH, hrec, hY] using
        And.intro hchoice.2.2.2.2.1 hchoice.2.2.2.2.2.1
    have hBins (g : ℕ) (hg : g ∈ G) :
        ((bins g).card : ℝ) ≤ Bcount * Real.log x := by
      have hgpos := (hGdata g hg).1
      have hQsquare : 2 * Q ≤ x ^ 2 :=
        (opening_frequency_cutoff_power_bounds x ε M R Q g hxtwo hεone hMone
          hR.le hQ.le hRx hQx hgpos).2
      have hsubset : bins g ⊆ Finset.range (⌊2 * Real.log x / Real.log 2⌋₊ + 1) := by
        intro i hi
        obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hi
        obtain ⟨_, huPos, _, _, htS, _, _, _, _, _⟩ := (hfactor.1 g hg).2 t ht
        have hqPos : 0 < g * t.2.1 * t.2.2.1 := (hSsimple _ htS).1
        have huDvd : t.2.1 ∣ g * t.2.1 * t.2.2.1 :=
          dvd_mul_of_dvd_left (dvd_mul_left t.2.1 g) t.2.2.1
        have huUpper : (t.2.1 : ℝ) ≤ x ^ 2 := by
          calc
            (t.2.1 : ℝ) ≤ ((g * t.2.1 * t.2.2.1 : ℕ) : ℝ) := by
              exact_mod_cast Nat.le_of_dvd hqPos huDvd
            _ ≤ 2 * Q := by
              obtain ⟨_, _, _, _, hqhi, _, _, _, _, _⟩ := hS _ htS
              exact hqhi
            _ ≤ x ^ 2 := hQsquare
        simpa only [Nat.log2_eq_log_two] using
          (opening_selected_dyadic_log_budget x hx1 t.2.1 huPos huUpper).1
      have hcard : ((bins g).card : ℝ) ≤
          ((Finset.range (⌊2 * Real.log x / Real.log 2⌋₊ + 1)).card : ℝ) := by
        exact_mod_cast Finset.card_le_card hsubset
      have hbudget := (opening_selected_dyadic_log_budget x hx1 1 (by decide)
        (by simpa only [Nat.cast_one] using
          (show (1 : ℝ) ≤ x ^ 2 from by nlinarith only [hxtwo]))).2
      have hlog2 : 0 < Real.log 2 := Real.log_pos (by norm_num)
      have hnonneg : 0 ≤ (2 / Real.log 2) * Real.log x := by positivity
      calc
        ((bins g).card : ℝ) ≤ 2 * Real.log x / Real.log 2 + 1 := hcard.trans hbudget
        _ = (2 / Real.log 2) * Real.log x + 1 := by ring
        _ ≤ (2 / Real.log 2) * Real.log x + Real.log x := add_le_add_right hlog1 _
        _ ≤ 2 * ((2 / Real.log 2) * Real.log x + Real.log x) := by
          linarith only [hnonneg, hlog0.le]
        _ = Bcount * Real.log x := by dsimp only [Bcount]; ring
    have hShells (g : ℕ) (hg : g ∈ G) : (shells g : ℝ) ≤ Bcount * Real.log x := by
      have hupper := (opening_frequency_cutoff_power_bounds x ε M R Q g
        hxtwo hεone hMone hR.le hQ.le
        hRx hQx (hGdata g hg).1).1
      have hupperReal : H g ≤ x ^ (4 : ℝ) := by
        simpa only [H, Real.rpow_ofNat] using hupper
      simpa only [shells, Bcount] using opening_padded_count x (H g) hxexp hupperReal
    let Ebase : ℝ := M * N ^ 2 / R * (Real.log x) ^ (-D)
    have hEbase : 0 ≤ Ebase := by dsimp only [Ebase]; positivity
    have hSwitch (q : ℕ) (hq : Nat.Coprime (a * b₁ * b₂) q)
        (b : ℕ) (hb : b ∈ ({b₁, b₂} : Finset ℕ))
        (b' : ℕ) (hb' : b' ∈ ({b₁, b₂} : Finset ℕ)) :
        Nat.Coprime (a * b * b') q := by
      have ha : Nat.Coprime a q := hq.coprime_mul_right.coprime_mul_right
      have h₁ : Nat.Coprime b₁ q := hq.coprime_mul_right.coprime_mul_left
      have h₂ : Nat.Coprime b₂ q := hq.coprime_mul_left
      have hside (z : ℕ) (hz : z ∈ ({b₁, b₂} : Finset ℕ)) : Nat.Coprime z q := by
        simp only [Finset.mem_insert, Finset.mem_singleton] at hz
        rcases hz with rfl | rfl
        · exact h₁
        · exact h₂
      exact (ha.mul_left (hside b hb)).mul_left (hside b' hb')
    have hOffDiagonalBound (c : ℕ × ℕ → ℂ)
        (hc : ∀ p ∈ S, ‖c p‖ ≤ 1)
        (b : ℕ) (hb : b ∈ ({b₁, b₂} : Finset ℕ))
        (b' : ℕ) (hb' : b' ∈ ({b₁, b₂} : Finset ℕ)) :
        ‖∑ r ∈ S.image Prod.snd,
          ∑ p₁ ∈ S.filter (fun p => p.2 = r),
            ∑ p₂ ∈ S.filter (fun p => p.2 = r),
              c p₁ * star (c p₂) *
                ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                  if n₁ = n₂ then 0 else
                    β n₁ * star (β n₂) *
                      ∑ h ∈ J (Nat.gcd p₁.1 p₂.1),
                        mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b b' n₁ n₂
                          ((h : ZMod (r * Nat.lcm p₁.1 p₂.1)).val)‖ ≤ Ebase := by
      clear htailAt hzeroAt hdiagonalAt hαmoment
      have hprimSides : ∀ p ∈ S, Nat.Coprime (a * b * b') (p.1 * p.2) :=
        fun p hp => hSwitch _ (hprim p hp) b hb b' hb'
      let F : ℕ → ℤ → Finset (ℕ × ℕ × ℕ × ℕ) → Finset ℤ → ℂ :=
        fun g ℓ B J' =>
          ∑ t ∈ B,
            c (g * t.2.1 * t.2.2.1, t.1) * star (c (g * t.2.2.2, t.1)) *
              ((M : ℂ) / ((t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2 : ℕ) : ℂ)) *
                ∑ n ∈ γβ.support.filter (fun n =>
                  Int.gcd n ((t.1 * g * t.2.1 * t.2.2.1 : ℕ) : ℤ) = 1 ∧
                  Int.gcd (n + ℓ * (t.1 : ℤ)) ((g * t.2.2.2 : ℕ) : ℤ) = 1),
                  γβ n * star (γβ (n + ℓ * (t.1 : ℤ))) *
                    (sourceCompatibility t.1 g b b' ℓ n : ℂ) *
                      ∑ h ∈ J', sourcePhi ψM M
                        (t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2) h *
                          sourceTheta t.1 g t.2.1 t.2.2.1 t.2.2.2 a b b' ℓ n h
      let Jpos : ℕ → Finset ℤ := fun j =>
        Finset.Ico ((2 : ℤ) ^ j) ((2 : ℤ) ^ (j + 1))
      let Jneg : ℕ → Finset ℤ := fun j =>
        Finset.Ioc (-((2 : ℤ) ^ (j + 1))) (-((2 : ℤ) ^ j))
      let Fband : ℕ → ℤ → ℕ → ℕ → Bool → ℂ := fun g ℓ i j side =>
        F g ℓ (block g ℓ i) (if side then Jneg j else Jpos j)
      have hPoint : ∀ g ∈ G, ∀ ℓ ∈ (Finset.Icc (-(LI : ℤ)) (LI : ℤ)).erase 0,
          ∀ i ∈ bins g, ∀ j ∈ Finset.range (shells g), ∀ side : Bool,
            ‖Fband g ℓ i j side‖ ≤
              Kband * M * N * (Int.gcd (g : ℤ) ℓ : ℝ) / (g : ℝ) *
                x ^ (-3 * ε / 2) := by
        intro g hg ℓ hℓ i _hi j hj side
        have hgpos : 0 < g := (hGdata g hg).1
        by_cases hempty : block g ℓ i = ∅
        · simp only [Fband, F, hempty, Finset.sum_empty, norm_zero]
          positivity
        have hHone : 1 ≤ H g := by
          by_contra hbad
          have hsmallH : H g < 1 := lt_of_not_ge hbad
          simp [shells, hsmallH] at hj
        obtain ⟨t₀, ht₀⟩ := Finset.nonempty_iff_ne_empty.mpr hempty
        let U : ℝ := (2 : ℝ) ^ i
        let V : ℝ := Q / ((g : ℝ) * U)
        have hBlockGpos : 0 < (g : ℝ) := by exact_mod_cast (hGdata g hg).1
        have hBlockHpos : 0 < H g := zero_lt_one.trans_le hHone
        have hBlockTwo : (2 : ℝ) ≤ C₀ := (by norm_num : (2 : ℝ) ≤ 4).trans hC₀four
        have hU : 0 < U := by dsimp only [U]; positivity
        have hTupleGeometry (t : ℕ × ℕ × ℕ × ℕ) (ht : t ∈ block g ℓ i) :
            0 < U ∧ 0 < V ∧ U * V = Q / (g : ℝ) ∧
            U ≤ (t.2.1 : ℝ) ∧ (t.2.1 : ℝ) ≤ 2 * U ∧
            V / 2 ≤ (t.2.2.1 : ℝ) ∧ (t.2.2.1 : ℝ) ≤ 2 * V ∧
            x ^ (-δ - 5 * ε) * Q / ((g : ℝ) * H g) ≤ 2 * U ∧
            U ≤ x ^ (-5 * ε) * Q / H g ∧
            x ^ (5 * ε) * H g / (g : ℝ) ≤ V ∧
            V ≤ 2 * x ^ (δ + 5 * ε) * H g := by
          have htA : t ∈ 𝒜 g := (Finset.mem_filter.mp ht).1
          have htbin : Nat.log 2 t.2.1 = i := (Finset.mem_filter.mp ht).2.2
          obtain ⟨_, htu, _, _, htS, _, _, _, _, _⟩ := (hfactor.1 g hg).2 t htA
          have huLo : U ≤ (t.2.1 : ℝ) := by
            have hn : 2 ^ i ≤ t.2.1 := by
              simpa only [htbin] using Nat.pow_log_le_self 2 htu.ne'
            dsimp only [U]
            exact_mod_cast hn
          have huHi : (t.2.1 : ℝ) < 2 * U := by
            have hn : t.2.1 < 2 ^ (i + 1) := by
              simpa only [htbin] using
                Nat.lt_pow_succ_log_self (by norm_num : 1 < (2 : ℕ)) t.2.1
            have hr : (t.2.1 : ℝ) < (2 : ℝ) ^ (i + 1) := by exact_mod_cast hn
            simpa only [U, pow_succ, mul_comm] using hr
          obtain ⟨_, _, _, hqLo, hqHi, _, _, _, _, _⟩ := hS _ htS
          have hselection := hSelected g hg hHone t htA
          exact opening_one_bin_geometry x δ ε Q (H g) U g t.2.1 t.2.2.1
            hx1 hQ hBlockHpos hU (hGdata g hg).1 huLo huHi.le
            (by simpa only [Nat.cast_mul] using hqLo)
            (by simpa only [Nat.cast_mul] using hqHi) hselection.1 hselection.2
        obtain ⟨_, hV, hUV, _, _, _, _, hUloTwo, hUhiOne, hVloOne, hVhiTwo⟩ :=
          hTupleGeometry t₀ ht₀
        have hUlo : x ^ (-δ - 5 * ε) * Q / ((g : ℝ) * H g) ≤ C₀ * U :=
          hUloTwo.trans (mul_le_mul_of_nonneg_right hBlockTwo hU.le)
        have hUhi : U ≤ C₀ * x ^ (-5 * ε) * Q / H g := by
          apply hUhiOne.trans
          have hh := mul_le_mul_of_nonneg_right hC₀
            (show 0 ≤ x ^ (-5 * ε) * Q / H g from by positivity)
          simpa only [one_mul, mul_div_assoc, mul_assoc] using hh
        have hVlo : x ^ (5 * ε) * H g / (g : ℝ) ≤ C₀ * V :=
          hVloOne.trans (le_mul_of_one_le_left hV.le hC₀)
        have hVhi : V ≤ C₀ * x ^ (δ + 5 * ε) * H g :=
          hVhiTwo.trans (mul_le_mul_of_nonneg_right
            (mul_le_mul_of_nonneg_right hBlockTwo (Real.rpow_nonneg hx0.le _))
            hBlockHpos.le)
        have hUVlo : Q / (g : ℝ) ≤ C₀ * U * V := by
          calc
            Q / (g : ℝ) = U * V := hUV.symm
            _ ≤ C₀ * (U * V) := le_mul_of_one_le_left (mul_nonneg hU.le hV.le) hC₀
            _ = C₀ * U * V := by ring
        have hUVhi : U * V ≤ C₀ * Q / (g : ℝ) := by
          rw [hUV]
          exact div_le_div_of_nonneg_right (le_mul_of_one_le_left hQ.le hC₀)
            hBlockGpos.le
        have hFamily : ∀ t ∈ block g ℓ i,
            0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
            R ≤ (t.1 : ℝ) ∧ (t.1 : ℝ) ≤ 2 * R ∧
            U / C₀ ≤ (t.2.1 : ℝ) ∧ (t.2.1 : ℝ) ≤ C₀ * U ∧
            V / C₀ ≤ (t.2.2.1 : ℝ) ∧ (t.2.2.1 : ℝ) ≤ C₀ * V ∧
            Q / (C₀ * (g : ℝ)) ≤ (t.2.2.2 : ℝ) ∧
            (t.2.2.2 : ℝ) ≤ C₀ * Q / (g : ℝ) ∧
            Q ≤ ((g * t.2.1 * t.2.2.1 : ℕ) : ℝ) ∧
            Q ≤ ((g * t.2.2.2 : ℕ) : ℝ) ∧
            Nonempty (DenseDivisibilityWitness
              ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ 1 t.1) ∧
            Squarefree (t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2) ∧
            Nat.Coprime (a * b * b') (t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2) := by
          intro t ht
          have htA : t ∈ 𝒜 g := (Finset.mem_filter.mp ht).1
          obtain ⟨hrt, htu, htv, htq, htS₁, htS₂, _, _, hsf, hprimitive⟩ :=
            (hfactor.1 g hg).2 t htA
          obtain ⟨_, _, _, hq₁lo, _, hrlo, hrhi, _, hdense, _⟩ := hS _ htS₁
          obtain ⟨_, _, _, hq₂lo, hq₂hi, _, _, _, _, _⟩ := hS _ htS₂
          obtain ⟨_, _, _, huLo, huHi, hvLo, hvHi, _, _, _, _⟩ := hTupleGeometry t ht
          have hq₂lower : Q / (g : ℝ) ≤ (t.2.2.2 : ℝ) := by
            apply (div_le_iff₀ hBlockGpos).2
            simpa only [Nat.cast_mul, mul_comm] using hq₂lo
          have hq₂upper : (t.2.2.2 : ℝ) ≤ 2 * Q / (g : ℝ) := by
            apply (le_div_iff₀ hBlockGpos).2
            simpa only [Nat.cast_mul, mul_comm] using hq₂hi
          refine ⟨hrt, htu, htv, htq, hrlo, hrhi,
            (div_le_self hU.le hC₀).trans huLo,
            huHi.trans (mul_le_mul_of_nonneg_right hBlockTwo hU.le),
            (div_le_div_of_nonneg_left hV.le (by norm_num : (0 : ℝ) < 2)
              hBlockTwo).trans hvLo,
            hvHi.trans (mul_le_mul_of_nonneg_right hBlockTwo hV.le), ?_, ?_,
            hq₁lo, hq₂lo, hdense, hsf, hSwitch _ hprimitive.symm b hb b' hb'⟩
          · apply le_trans _ hq₂lower
            exact div_le_div_of_nonneg_left hQ.le hBlockGpos
              (le_mul_of_one_le_left hBlockGpos.le hC₀)
          · exact hq₂upper.trans (div_le_div_of_nonneg_right
              (mul_le_mul_of_nonneg_right hBlockTwo hQ.le) hBlockGpos.le)
        have hPhase : ∀ t ∈ block g ℓ i,
            ‖c (g * t.2.1 * t.2.2.1, t.1)‖ ≤ 1 ∧
            ‖c (g * t.2.2.2, t.1)‖ ≤ 1 := by
          intro t ht
          obtain ⟨_, _, _, _, hp₁, hp₂, _, _, _, _⟩ :=
            (hfactor.1 g hg).2 t (Finset.mem_filter.mp ht).1
          exact ⟨hc _ hp₁, hc _ hp₂⟩
        have hℓne : ℓ ≠ 0 := (Finset.mem_erase.mp hℓ).1
        have hℓLI : |(ℓ : ℝ)| ≤ (LI : ℝ) := by
          apply abs_le.mpr
          exact ⟨by exact_mod_cast (Finset.mem_Icc.mp (Finset.mem_erase.mp hℓ).2).1,
            by exact_mod_cast (Finset.mem_Icc.mp (Finset.mem_erase.mp hℓ).2).2⟩
        have hℓbound : |(ℓ : ℝ)| ≤ C₀ * N / R := by
          calc
            |(ℓ : ℝ)| ≤ (LI : ℝ) := hℓLI
            _ ≤ (2 * TN) * N / R := Nat.floor_le (by positivity)
            _ ≤ C₀ * N / R := div_le_div_of_nonneg_right
              (mul_le_mul_of_nonneg_right hTN₀ hN.le) hR.le
        have hjShell : j ∈ Finset.range (Nat.log 2 ⌊H g⌋₊ + 1) := by
          simpa only [shells, ite_eq_right (not_lt_of_ge hHone)] using hj
        have hShellWindow : 1 ≤ (2 : ℝ) ^ j ∧ (2 : ℝ) ^ j ≤ H g :=
          (padded_dyadic_cutoff_bounds (H g) hHone).2.2.2.2.2.2 j hjShell
        let Hstar : ℝ := if side then -((2 : ℝ) ^ j) else (2 : ℝ) ^ j
        have hstarabs : |Hstar| = (2 : ℝ) ^ j := by
          cases side <;> simp [Hstar, abs_of_pos (pow_pos (by norm_num : (0 : ℝ) < 2) j)]
        have hstarne : Hstar ≠ 0 := by
          have hpositive : 0 < (2 : ℝ) ^ j := by positivity
          intro hz
          rw [hz, abs_zero] at hstarabs
          exact hpositive.ne hstarabs
        have hstarlo : 1 ≤ C₀ * |Hstar| := by
          rw [hstarabs]
          exact hShellWindow.1.trans
            (le_mul_of_one_le_left (zero_le_one.trans hShellWindow.1) hC₀)
        have hstarhi : |Hstar| ≤ C₀ * H g := by
          rw [hstarabs]
          exact hShellWindow.2.trans
            (le_mul_of_one_le_left (zero_le_one.trans hHone) hC₀)
        have hJstar :
            ((Finset.Icc (-((⌊2 * |Hstar|⌋₊ : ℕ) : ℤ))
              ((⌊2 * |Hstar|⌋₊ : ℕ) : ℤ)).filter
                (fun h : ℤ => 1 ≤ (h : ℝ) / Hstar ∧ (h : ℝ) / Hstar < 2)) =
              (if side then Jneg j else Jpos j) := by
          cases side with
          | false => simpa [Hstar, Jpos] using (signed_dyadic_profile_window j).1
          | true => simpa [Hstar, Jneg, abs_neg] using (signed_dyadic_profile_window j).2
        have hβBand : ∀ n ∈ β.support,
            0 < n ∧ (n : ℝ) ≤ (2 * TN) * N ∧
            ‖β n‖ ≤ C₀ * (n.divisors.card : ℝ) ^ dβ * (Real.log x) ^ Eβ ∧
            1 ≤ ψN ((n : ℝ) / N) := by
          intro n hn
          refine ⟨hβpos n hn, (hβ n hn).2.1.trans ?_,
            (hβ n hn).2.2.trans ?_, hψNmajor n hn⟩
          · exact mul_le_mul_of_nonneg_right (by linarith only [hTNpos]) hN.le
          · exact mul_le_mul_of_nonneg_right
              (mul_le_mul_of_nonneg_right hCC₀ (pow_nonneg (Nat.cast_nonneg _) _))
              (Real.rpow_nonneg hlog0.le _)
        have hgQ : (g : ℝ) ≤ C₀ * Q :=
          (hGdata g hg).2.2.1.trans
            (mul_le_mul_of_nonneg_right (by linarith only [hC₀four]) hQ.le)
        have hraw := hBandAt x hxband g hgpos (hGdata g hg).2.1
          a b b' (hSwitch _ (hGdata g hg).2.2.2.1 b hb b' hb')
          ℓ M N R Q U V (H g) Hstar γ hM hN hR hQ hU hV
          hMNlo₀ hMNhi₀ hNγ hγlo hγhi hNR₀ hRhi₀ hRQlo₀ hRQhi₀ hNx
          rfl hHone hUlo hUhi hVlo hVhi hUVlo hUVhi hgQ
          (hGdata g hg).2.2.2.2 hℓne hℓbound hstarne hstarlo hstarhi
          β hβBand c (block g ℓ i) hFamily hPhase
        dsimp only at hraw
        rw [hJstar] at hraw
        dsimp only [Fband, F]
        exact (norm_sum_le _ _).trans hraw
      have htwoQ : 2 * Q ≤ x ^ 2 := by
        calc
          2 * Q ≤ 2 * x := mul_le_mul_of_nonneg_left hQx (by norm_num)
          _ ≤ x * x := mul_le_mul_of_nonneg_right hxtwo hx0.le
          _ = x ^ 2 := (pow_two x).symm
      have hQI : (⌊2 * Q⌋₊ : ℝ) ≤ x ^ 2 :=
        (Nat.floor_le (by positivity : 0 ≤ 2 * Q)).trans htwoQ
      have hGI : ∀ g ∈ G, 0 < g ∧ g ≤ ⌊2 * Q⌋₊ :=
        fun g hg => ⟨(hGdata g hg).1, Nat.le_floor (hGdata g hg).2.2.1⟩
      have hLI : (LI : ℝ) ≤ (2 * TN) * N / R := Nat.floor_le (by positivity)
      have hsum := opening_summed_bands x ε Kband Bcount (2 * TN) M N R
        hxexp hKband.le hBcount.le (by positivity) hM.le hN.le hR
        G ⌊2 * Q⌋₊ LI bins shells Fband hGI hQI hLI hBins hShells hPoint
      have hsplit := opening_off_diagonal_split (cM / 2) (2 * TM) M
        (by positivity) hMinterval hM ψM hsM S β c a b b' shells u
        hSsimple hprimSides hu Lall hLall
      have hLogProduct :
          (Real.log x) ^ (4 + D) * (Real.log x) ^ (-D) = (Real.log x) ^ 4 := by
        rw [← Real.rpow_add hlog0, show (4 + D) + (-D) = (4 : ℝ) by ring]
        norm_num
      have hXProduct : x ^ (3 * ε / 2) * x ^ (-3 * ε / 2) = 1 := by
        rw [← Real.rpow_add hx0, show 3 * ε / 2 + (-3 * ε / 2) = 0 by ring,
          Real.rpow_zero]
      have hOffScalar :
          Koff * (Real.log x) ^ 4 * x ^ (-3 * ε / 2) ≤ (Real.log x) ^ (-D) := by
        calc
          _ = (Koff * (Real.log x) ^ (4 + D)) *
              ((Real.log x) ^ (-D) * x ^ (-3 * ε / 2)) := by
            calc
              _ = Koff * ((Real.log x) ^ (4 + D) * (Real.log x) ^ (-D)) *
                  x ^ (-3 * ε / 2) := by rw [hLogProduct]
              _ = _ := by ring
          _ ≤ x ^ (3 * ε / 2) *
              ((Real.log x) ^ (-D) * x ^ (-3 * ε / 2)) :=
            mul_le_mul_of_nonneg_right hoffAbsorb (by positivity)
          _ = (Real.log x) ^ (-D) := by
            calc
              _ = (Real.log x) ^ (-D) *
                  (x ^ (3 * ε / 2) * x ^ (-3 * ε / 2)) := by ring
              _ = _ := by rw [hXProduct, mul_one]
      calc
        _ ≤ ∑ g ∈ G, ∑ ℓ ∈ Lall, ∑ i ∈ bins g, ∑ j ∈ Finset.range (shells g),
            (‖F g ℓ (block g ℓ i) (Jpos j)‖ +
              ‖F g ℓ (block g ℓ i) (Jneg j)‖) := hsplit
        _ ≤ 36 * Kband * Bcount ^ 2 * (2 * TN) * (M * N ^ 2 / R) *
            (Real.log x) ^ 4 * x ^ (-3 * ε / 2) := by
          simpa only [Fband, Bool.false_eq_true, ↓reduceIte] using hsum
        _ = (M * N ^ 2 / R) *
            (Koff * (Real.log x) ^ 4 * x ^ (-3 * ε / 2)) := by
          dsimp only [Koff]
          ring
        _ ≤ (M * N ^ 2 / R) * (Real.log x) ^ (-D) :=
          mul_le_mul_of_nonneg_left hOffScalar (by positivity)
        _ = Ebase := rfl
    clear hBandAt hfactor hSelected hGdata hLall hBins hShells hu hu₀ hXwindow hψNmajor
    have hbaseOne : 1 ≤ M * N ^ 2 / R := by
      have hRsmall : R ≤ C₀ * N := hRhi₀.trans (by
        have hpow := Real.rpow_le_one_of_one_le_of_nonpos hx1
          (show -2 * ε ≤ 0 by linarith only [hε])
        simpa only [mul_one] using mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left hpow hC₀pos.le) hN.le)
      have hMNbig : C₀ ≤ M * N := by
        calc
          C₀ = C₀ ^ 2 / C₀ := by field_simp
          _ ≤ x / C₀ := div_le_div_of_nonneg_right hC₀square hC₀pos.le
          _ ≤ M * N := hMNlo₀
      apply (le_div_iff₀ hR).mpr
      calc
        1 * R = R := one_mul R
        _ ≤ C₀ * N := hRsmall
        _ ≤ (M * N) * N := mul_le_mul_of_nonneg_right hMNbig hN.le
        _ = M * N ^ 2 := by ring
    have hTailSmall : x ^ (-1 : ℝ) ≤ Ebase := by
      have hlogpower : (Real.log x) ^ D ≤ x := by
        simpa only [one_mul, Real.rpow_one] using htailAbsorb
      have hinv := inv_anti₀ (Real.rpow_pos_of_pos hlog0 D) hlogpower
      calc
        x ^ (-1 : ℝ) ≤ (Real.log x) ^ (-D) := by
          simpa only [Real.rpow_neg_one, Real.rpow_neg hlog0.le] using hinv
        _ ≤ M * N ^ 2 / R * (Real.log x) ^ (-D) :=
          le_mul_of_one_le_left (Real.rpow_nonneg hlog0.le _) hbaseOne
    have hRlower : x ^ (-δ - 4 * ε) * N / C₀ ≤ R := by
      calc
        x ^ (-δ - 4 * ε) * N / C₀ = N / (C₀ * x ^ (δ + 4 * ε)) := by
          rw [show -δ - 4 * ε = -(δ + 4 * ε) by ring, Real.rpow_neg hx0.le]
          ring_nf
        _ ≤ R := (div_le_iff₀ (mul_pos hC₀pos (Real.rpow_pos_of_pos hx0 _))).mpr
          (by simpa only [mul_comm, mul_left_comm, mul_assoc] using hNR₀)
    have hScales : ∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Nat.Coprime p.1 p.2 ∧
        Q ≤ (p.1 : ℝ) ∧ (p.1 : ℝ) ≤ 2 * Q ∧
        R ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ 2 * R ∧
        (p.1 : ℝ) ≤ x ^ (2 : ℝ) ∧ (p.2 : ℝ) ≤ x ^ (2 : ℝ) := by
      intro p hp
      obtain ⟨hq, hr, _, hqlo, hqhi, hrlo, hrhi, _, _, _⟩ := hS p hp
      have hQ2 : 2 * Q ≤ x ^ 2 := by nlinarith only [hQx, hxtwo]
      have hR2 : 2 * R ≤ x ^ 2 := by nlinarith only [hRx, hxtwo]
      exact ⟨hq, hr, hScoprime p hp, hqlo, hqhi, hrlo, hrhi,
        by simpa only [Real.rpow_two] using hqhi.trans hQ2,
        by simpa only [Real.rpow_two] using hrhi.trans hR2⟩
    have hEnergy : ∀ c : ℕ × ℕ → ℂ, (∀ p ∈ S, ‖c p‖ = 1) →
        dispersionEnergy sm w S β c a b₁ b₂ ≤ 13 * Ebase := by
      intro c hc
      have hc' : ∀ p ∈ S, ‖c p‖ ≤ 1 := fun p hp => (hc p hp).le
      let Dcorr : ℕ → ℕ → ℂ := fun b b' =>
        ∑ r ∈ S.image Prod.snd,
          ∑ p₁ ∈ S.filter (fun p => p.2 = r),
            ∑ p₂ ∈ S.filter (fun p => p.2 = r),
              c p₁ * star (c p₂) *
                ∑ n ∈ β.support, β n * star (β n) *
                  (mixedFiberMass sm w p₁.1 p₂.1 r a b b' n n : ℂ)
      let Ocorr : ℕ → ℕ → ℂ := fun b b' =>
        ∑ r ∈ S.image Prod.snd,
          ∑ p₁ ∈ S.filter (fun p => p.2 = r),
            ∑ p₂ ∈ S.filter (fun p => p.2 = r),
              c p₁ * star (c p₂) *
                ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                  if n₁ = n₂ then 0 else β n₁ * star (β n₂) *
                    ∑ h ∈ J (Nat.gcd p₁.1 p₂.1),
                      mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b b' n₁ n₂
                        ((h : ZMod (r * Nat.lcm p₁.1 p₂.1)).val)
      apply opening_four_energy sm w S β c a b₁ b₂ Ebase Dcorr Ocorr
      · intro b hb b' hb'
        have hprimitive : ∀ p ∈ S, Nat.Coprime (a * b * b') (p.1 * p.2) :=
          fun p hp => hSwitch _ (hprim p hp) b hb b' hb'
        have htail := htailAt S β c NI M Q R hM hQ hR hβsupport hNIx
          (fun n hn => (hβ n hn).2.2) hc' hScales a b b' hprimitive ψM hψM hsM
          (by
            intro t
            simp only [Real.rpow_zero, mul_one]
            exact ⟨by simpa only [iteratedDeriv_zero] using
              (hCMbound 0 t).trans (le_max_left _ _),
              (hCMbound (k + 2) t).trans (le_max_right _ _)⟩) hMshort
        let V : ℕ → ℕ → ℕ → ℕ → ℕ → ℂ := fun r q₁ q₂ n₁ n₂ =>
          if n₁ = n₂ then (mixedFiberMass sm w q₁ q₂ r a b b' n₁ n₂ : ℂ)
          else mixedFiberFourierCoefficient sm w q₁ q₂ r a b b' n₁ n₂ 0 +
            ∑ h ∈ J (Nat.gcd q₁ q₂),
              mixedFiberFourierCoefficient sm w q₁ q₂ r a b b' n₁ n₂
                ((h : ZMod (r * Nat.lcm q₁ q₂)).val)
        have htail' :
            ‖mixedCorrelation sm w S β c a b b' -
                (∑ r ∈ S.image Prod.snd,
                  ∑ p₁ ∈ S.filter (fun p => p.2 = r),
                    ∑ p₂ ∈ S.filter (fun p => p.2 = r),
                      c p₁ * star (c p₂) *
                        ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                          β n₁ * star (β n₂) * V r p₁.1 p₂.1 n₁ n₂)‖ ≤ x ^ (-1 : ℝ) := by
          clear * - htail
          simpa only [opening_padded_window, V, J, shells, H, sm, w] using htail
        have hidentity := opening_truncated_identity sm w S β c a b b' J
        change
          (∑ r ∈ S.image Prod.snd,
            ∑ p₁ ∈ S.filter (fun p => p.2 = r),
              ∑ p₂ ∈ S.filter (fun p => p.2 = r),
                c p₁ * star (c p₂) *
                  ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                    β n₁ * star (β n₂) * V r p₁.1 p₂.1 n₁ n₂) =
            Dcorr b b' + offDiagonalZeroMode sm w S β c a b b' + Ocorr b b' at hidentity
        rw [hidentity] at htail'
        refine ⟨htail'.trans hTailSmall, ?_, hOffDiagonalBound c hc' b hb b' hb'⟩
        have hdiag := hdiagonalAt γ M Q R NI hγlo hγhi hM hQ hR
          (by simpa only [← hNγ] using hMNlo₀)
          (by simpa only [← hNγ] using hMNhi₀)
          (by simpa only [← hNγ] using hRlower)
          (by simpa only [← hNγ] using hRhi₀) hRQhi₀
          (by simpa only [← hNγ] using hNIscale) S β c hβsupport
          (fun n hn => (hβ n hn).2.2) hc'
          (fun p hp => by
            obtain ⟨hq, hr, hcp, hqlo, hqhi, hrlo, hrhi, _, _⟩ := hScales p hp
            exact ⟨hq, hr, hcp, hqlo, hqhi, hrlo, hrhi⟩)
          a b b' ψM (by
            intro t
            simpa only [Real.rpow_zero, mul_one, iteratedDeriv_zero, Real.norm_eq_abs]
              using hCMbound 0 t)
        calc
          ‖Dcorr b b'‖ ≤
              ∑ r ∈ S.image Prod.snd,
                ∑ p₁ ∈ S.filter (fun p => p.2 = r),
                  ∑ p₂ ∈ S.filter (fun p => p.2 = r),
                    ‖c p₁ * star (c p₂) *
                      (∑ n ∈ β.support, β n * star (β n) *
                        (mixedFiberMass sm w p₁.1 p₂.1 r a b b' n n : ℂ))‖ := by
            dsimp only [Dcorr]
            apply norm_sum_le_of_le
            intro r _
            apply norm_sum_le_of_le
            intro p₁ _
            exact norm_sum_le _ _
          _ ≤ Ebase := by simpa only [← hNγ, sm, w, Ebase] using hdiag
      · have hz := hzeroAt M N R Q hM hN hR hQ hMone hNx hQx hRhi
          sm S β c a b₁ b₂
          (fun n hn => ⟨hβpos n hn, (hβ n hn).2.1, (hβ n hn).2.2⟩) hc'
          (fun p hp => by
            obtain ⟨hq, hr, hcp, _, hqhi, hrlo, hrhi, _, _⟩ := hScales p hp
            exact ⟨hq, hr, hcp, hrlo, hrhi, hqhi⟩)
          hprim (fun p hp => (hS p hp).2.2.2.2.2.2.2.2.2)
        exact hz
    clear hOffDiagonalBound htailAt hzeroAt hdiagonalAt
    have hCauchy := opening_final_cauchy α β S sm w a b₁ b₂ R (13 * Ebase) hR
      (mul_nonneg (by norm_num) hEbase)
      (fun p hp => by
        obtain ⟨hq, hr, _, _, _, _, hrhi, _, _, _⟩ := hS p hp
        exact ⟨hq, hr, hrhi⟩) hprim hsm hw0 hw1 hEnergy
    refine opening_cauchy_logarithmic_absorption
      hM hN hR hKα hη hlog1
      ((le_max_right _ _).trans ((le_max_right _ _).trans hxlarge))
      (Finset.sum_nonneg fun _ _ => norm_nonneg _) hαmoment ?_
    simpa only [Ebase, D] using hCauchy
  obtain ⟨X₀, hX₀⟩ := hmain.exists_forall_of_atTop
  refine ⟨max (Real.exp 1) X₀, le_max_left _ _, ?_⟩
  intro x hx
  exact hX₀ x ((le_max_right _ _).trans hx)

end

open scoped Classical in
theorem balanced_bv_masked_uniform_log_saving
    {ι : Type*} (M N : ℝ → ι → ℝ)
    (α β : ℝ → ι → ℕ →₀ ℂ)
    (c C W η X₀ : ℝ) (k s : ℕ)
    (hc : 0 < c) (hC : 1 ≤ C) (hW : 0 ≤ W)
    (hη : 0 < η) (hX₀ : Real.exp 1 ≤ X₀)
    (hscale : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι,
      x / C ≤ M x i * N x i ∧
      M x i * N x i ≤ C * x ∧
      x ^ η ≤ M x i ∧ x ^ η ≤ N x i)
    (hsupport : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι,
      (∀ n ∈ (α x i).support,
        c * M x i ≤ (n : ℝ) ∧ (n : ℝ) ≤ C * M x i) ∧
      (∀ n ∈ (β x i).support,
        c * N x i ≤ (n : ℝ) ∧ (n : ℝ) ≤ C * N x i))
    (hcoeff : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι, ∀ n : ℕ,
      ‖α x i n‖ ≤ W * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ k ∧
      ‖β x i n‖ ≤ W * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ k)
    (hSW : ∀ A : ℝ, 0 < A →
      ∃ KSW XSW : ℝ, 0 < KSW ∧ X₀ ≤ XSW ∧
        ∀ x : ℝ, XSW ≤ x → ∀ i : ι,
        ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
          ‖fullDiscrepancy
              ((β x i).filter (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
            KSW * ((q * r).divisors.card : ℝ) ^ s * N x i /
              (Real.log x) ^ A) :
    ∀ A : ℝ, 0 < A →
      ∃ B K X : ℝ, 0 < B ∧ 0 < K ∧ X₀ ≤ X ∧
        ∀ x : ℝ, X ≤ x → ∀ i : ι,
        ∀ h : ℕ, 0 < h →
          (∑ q ∈ Finset.Ioc 0
              (Nat.floor (Real.sqrt x / (Real.log x) ^ B)),
            ⨆ a : (ZMod q)ˣ,
              ‖fullDiscrepancy
                  ((finiteConvolution (α x i) (β x i)).filter
                    (fun n : ℕ => Nat.Coprime n h))
                  q (a : ZMod q).val‖) ≤
            K * (h.divisors.card : ℝ) ^ s * x / (Real.log x) ^ A
:= by
  classical
  have hCpos : 0 < C := lt_of_lt_of_le zero_lt_one hC
  let Rlog : ℝ := 2 + Real.log (2 * C ^ 2)
  have hbase : 1 ≤ 2 * C ^ 2 := by nlinarith [sq_nonneg (C - 1)]
  have hRlog2 : 2 ≤ Rlog := by
    dsimp only [Rlog]
    linarith [Real.log_nonneg hbase]
  have hRlog0 : 0 ≤ Rlog := le_trans (by norm_num) hRlog2
  have hreciprocal_moment (j Q : ℕ) :
      (∑ e ∈ Finset.Ioc 0 Q,
        (e.divisors.card : ℝ) ^ j / (e.totient : ℝ)) ≤
          (harmonic Q : ℝ) ^ (2 ^ (j + 1)) := by
    rw [← Finset.Icc_succ_left_eq_Ioc (0 : ℕ) Q]
    calc
      (∑ e ∈ Finset.Icc 1 Q,
          (e.divisors.card : ℝ) ^ j / (e.totient : ℝ)) ≤
          ∑ e ∈ Finset.Icc 1 Q, (e.divisors.card : ℝ) ^ (j + 1) / (e : ℝ) := by
        apply Finset.sum_le_sum
        intro e he
        have hepos : 0 < e := (Finset.mem_Icc.mp he).1
        have heR : 0 < (e : ℝ) := Nat.cast_pos.mpr hepos
        have hφ : 0 < (e.totient : ℝ) := Nat.cast_pos.mpr (Nat.totient_pos.mpr hepos)
        calc
          (e.divisors.card : ℝ) ^ j / (e.totient : ℝ) =
              ((e.divisors.card : ℝ) ^ j * ((e : ℝ) / e.totient)) / e := by
            field_simp [heR.ne', hφ.ne']
          _ ≤ ((e.divisors.card : ℝ) ^ j * (e.divisors.card : ℝ)) / e :=
            div_le_div_of_nonneg_right
              (mul_le_mul_of_nonneg_left
                (div_totient_le_card_divisors e)
                (pow_nonneg (Nat.cast_nonneg _) _)) heR.le
          _ = (e.divisors.card : ℝ) ^ (j + 1) / e := by rw [pow_succ]
      _ ≤ ∑ e ∈ Finset.Icc 1 Q,
          (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (2 ^ (j + 1))) e : ℝ) /
            (e : ℝ) := by
        apply Finset.sum_le_sum
        intro e he
        apply div_le_div_of_nonneg_right _ (Nat.cast_nonneg e)
        exact_mod_cast card_divisors_pow_le_zeta_pow (j + 1) e
          (Finset.mem_Icc.mp he).1
      _ ≤ (harmonic Q : ℝ) ^ (2 ^ (j + 1)) :=
        sum_zeta_pow_div_le_harmonic_pow (2 ^ (j + 1)) Q
  have hceil_geometry (T : ℝ) (hT : 1 ≤ T) (u : ℕ →₀ ℂ)
      (hsu : ∀ n ∈ u.support, 0 < n ∧ (n : ℝ) ≤ C * T) :
      (0 < ⌈C * T⌉₊ ∧ (⌈C * T⌉₊ : ℝ) ≤ 2 * C * T) ∧
        u.support ⊆ Finset.Ioc 0 ⌈C * T⌉₊ := by
    have hTpos : 0 < T := lt_of_lt_of_le zero_lt_one hT
    have hCT : 1 ≤ C * T :=
      hT.trans (le_mul_of_one_le_left hTpos.le hC)
    refine ⟨⟨Nat.ceil_pos.mpr (mul_pos hCpos hTpos), ?_⟩, ?_⟩
    · have hceil := Nat.ceil_lt_add_one (mul_nonneg hCpos.le hTpos.le)
      linarith
    · intro n hn
      exact Finset.mem_Ioc.mpr ⟨(hsu n hn).1,
        Nat.cast_le.mp ((hsu n hn).2.trans (Nat.le_ceil (C * T)))⟩
  have hcoefficient_moment (j : ℕ) (x T : ℝ)
      (hx : Real.exp 1 ≤ x) (hT : 1 ≤ T) (hTx : T ≤ C * x)
      (u : ℕ →₀ ℂ)
      (hsu : ∀ n ∈ u.support, 0 < n ∧ (n : ℝ) ≤ C * T)
      (hcu : ∀ n ∈ u.support,
        ‖u n‖ ≤ W * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ k) :
      (∑ n ∈ u.support, ‖u n‖ ^ j) ≤
        2 * C * W ^ j * Rlog ^ (2 ^ (k * j) - 1) * T *
          (Real.log x) ^ (k * j + (2 ^ (k * j) - 1)) := by
    let L : ℝ := Real.log x
    let P : ℕ := ⌈C * T⌉₊
    let b : ℕ := 2 ^ (k * j) - 1
    have hxpos : 0 < x := lt_of_lt_of_le (Real.exp_pos 1) hx
    have hL : 1 ≤ L := by
      simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hx
    have hL0 : 0 ≤ L := le_trans zero_le_one hL
    have hTpos : 0 < T := lt_of_lt_of_le zero_lt_one hT
    obtain ⟨⟨hPpos, hP⟩, huP⟩ := hceil_geometry T hT u hsu
    have huP' : u.support ⊆ Finset.Icc 1 P := by
      intro n hn
      exact Finset.mem_Icc.mpr ⟨(Finset.mem_Ioc.mp (huP hn)).1,
        (Finset.mem_Ioc.mp (huP hn)).2⟩
    have hPx : (P : ℝ) ≤ 2 * C ^ 2 * x := by
      calc
        (P : ℝ) ≤ 2 * C * T := hP
        _ ≤ 2 * C * (C * x) := mul_le_mul_of_nonneg_left hTx (by positivity)
        _ = 2 * C ^ 2 * x := by ring
    have hPlog0 : 0 ≤ 1 + Real.log (P : ℝ) := by
      have hP1 : (1 : ℝ) ≤ P := by exact_mod_cast hPpos
      linarith [Real.log_nonneg hP1]
    have hPlog : 1 + Real.log (P : ℝ) ≤ Rlog * L := by
      have hpR : 0 < (P : ℝ) := Nat.cast_pos.mpr hPpos
      have hcc : 0 < 2 * C ^ 2 := by positivity
      have hh := Real.log_le_log hpR hPx
      rw [Real.log_mul hcc.ne' hxpos.ne'] at hh
      have hprod := mul_nonneg (Real.log_nonneg hbase) (sub_nonneg.mpr hL)
      dsimp only [Rlog, L] at *
      nlinarith
    have hpoint (n : ℕ) (hn : n ∈ u.support) :
        ‖u n‖ ^ j ≤ W ^ j * (n.divisors.card : ℝ) ^ (k * j) * L ^ (k * j) := by
      simpa only [mul_pow, ← pow_mul] using
        pow_le_pow_left₀ (norm_nonneg (u n)) (hcu n hn) j
    have hsum :
        (∑ n ∈ u.support, ‖u n‖ ^ j) ≤
          W ^ j * (∑ n ∈ Finset.Icc 1 P, (n.divisors.card : ℝ) ^ (k * j)) *
            L ^ (k * j) := by
      calc
        (∑ n ∈ u.support, ‖u n‖ ^ j) ≤
            ∑ n ∈ u.support, W ^ j * (n.divisors.card : ℝ) ^ (k * j) *
              L ^ (k * j) := Finset.sum_le_sum hpoint
        _ = W ^ j * (∑ n ∈ u.support, (n.divisors.card : ℝ) ^ (k * j)) *
            L ^ (k * j) := by rw [Finset.mul_sum, Finset.sum_mul]
        _ ≤ W ^ j * (∑ n ∈ Finset.Icc 1 P, (n.divisors.card : ℝ) ^ (k * j)) *
            L ^ (k * j) := by
          apply mul_le_mul_of_nonneg_right _ (pow_nonneg hL0 _)
          apply mul_le_mul_of_nonneg_left _ (pow_nonneg hW _)
          exact Finset.sum_le_sum_of_subset_of_nonneg huP'
            (fun n _ _ => pow_nonneg (Nat.cast_nonneg _) _)
    change (∑ n ∈ u.support, ‖u n‖ ^ j) ≤
      2 * C * W ^ j * Rlog ^ b * T * L ^ (k * j + b)
    calc
      (∑ n ∈ u.support, ‖u n‖ ^ j) ≤
          W ^ j * (∑ n ∈ Finset.Icc 1 P, (n.divisors.card : ℝ) ^ (k * j)) *
            L ^ (k * j) := hsum
      _ ≤ W ^ j * ((P : ℝ) * (1 + Real.log (P : ℝ)) ^ b) * L ^ (k * j) := by
        apply mul_le_mul_of_nonneg_right _ (pow_nonneg hL0 _)
        apply mul_le_mul_of_nonneg_left _ (pow_nonneg hW _)
        exact sum_card_divisors_pow_le_mul_log_pow (k * j) P
      _ ≤ W ^ j * ((2 * C * T) * (Rlog * L) ^ b) * L ^ (k * j) := by
        apply mul_le_mul_of_nonneg_right _ (pow_nonneg hL0 _)
        apply mul_le_mul_of_nonneg_left _ (pow_nonneg hW _)
        exact mul_le_mul hP (pow_le_pow_left₀ hPlog0 hPlog b)
          (pow_nonneg hPlog0 _) (by positivity)
      _ = 2 * C * W ^ j * Rlog ^ b * T * L ^ (k * j + b) := by
        rw [mul_pow, pow_add]
        ring
  have hlarge_conductor := balanced_bv_large_conductor
  have hsmall_conductor := balanced_bv_small_conductor s
  have hlarge_geometry := balanced_bv_large_geometry C η hCpos
  have hfinite_bound (u v : ℕ →₀ ℂ) (P R Q F h : ℕ)
      (Lα K N₀ : ℝ) (hQ : 1 ≤ Q) (hF : 1 ≤ F) (hh : 0 < h)
      (huP : u.support ⊆ Finset.Ioc 0 P) (hvR : v.support ⊆ Finset.Ioc 0 R)
      (hLα : 0 ≤ Lα) (hK : 0 ≤ K) (hN₀ : 0 ≤ N₀)
      (hu : (∑ n ∈ u.support, ‖u n‖) ≤ Lα)
      (hv : ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
        ‖fullDiscrepancy (v.filter (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
          K * ((q * r).divisors.card : ℝ) ^ s * N₀) :
      (∑ q ∈ Finset.Ioc 0 Q, ⨆ a : (ZMod q)ˣ,
        ‖fullDiscrepancy ((finiteConvolution u v).filter
          (fun n : ℕ => Nat.Coprime n h)) q (a : ZMod q).val‖) ≤
        Lα * K * N₀ * (h.divisors.card : ℝ) ^ s * (F : ℝ) ^ (s + 2) *
            (harmonic Q : ℝ) ^ (2 ^ (s + 1)) +
          ((Nat.log 2 Q + 1 : ℕ) : ℝ) *
            Real.sqrt (∑ m ∈ u.support, ‖u m‖ ^ 2) *
            Real.sqrt (∑ n ∈ v.support, ‖v n‖ ^ 2) *
            (2 * Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ) / (F : ℝ) +
              2 * (Real.sqrt (P : ℝ) + Real.sqrt (R : ℝ)) + 4 * (Q : ℝ)) *
            (harmonic Q : ℝ) ^ 2 := by
    let Z (e f : ℕ) : ℝ := (f.totient : ℝ)⁻¹ *
      ∑ ψ ∈ (Finset.univ : Finset (DirichletCharacter ℂ f)).filter
          (fun ψ => ψ.IsPrimitive),
        ‖(∑ m ∈ u.support,
            if Nat.Coprime m (e * h) then u m * ψ (m : ZMod f) else 0) *
          (∑ n ∈ v.support,
            if Nat.Coprime n (e * h) then v n * ψ (n : ZMod f) else 0)‖
    let T : ℝ := Lα * K * N₀ * (h.divisors.card : ℝ) ^ s * (F : ℝ) ^ (s + 2)
    let V : ℝ := ((Nat.log 2 Q + 1 : ℕ) : ℝ) *
      Real.sqrt (∑ m ∈ u.support, ‖u m‖ ^ 2) *
      Real.sqrt (∑ n ∈ v.support, ‖v n‖ ^ 2) *
      (2 * Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ) / (F : ℝ) +
        2 * (Real.sqrt (P : ℝ) + Real.sqrt (R : ℝ)) + 4 * (Q : ℝ))
    have hT : 0 ≤ T := by dsimp only [T]; positivity
    have hV : 0 ≤ V := by dsimp only [V]; positivity
    have hsplit (e : ℕ) :
        (∑ f ∈ Finset.Ioc 1 (Q / e), Z e f) =
          (∑ f ∈ (Finset.Ioc 1 (Q / e)).filter (fun f => f ≤ F), Z e f) +
            ∑ f ∈ (Finset.Ioc 1 (Q / e)).filter (fun f => F < f), Z e f := by
      simpa only [not_le] using
        (Finset.sum_filter_add_sum_filter_not (Finset.Ioc 1 (Q / e))
          (fun f => f ≤ F) (Z e)).symm
    have hpoint (e : ℕ) (he : e ∈ Finset.Ioc 0 Q) :
        (e.totient : ℝ)⁻¹ * (∑ f ∈ Finset.Ioc 1 (Q / e), Z e f) ≤
          T * ((e.divisors.card : ℝ) ^ s / (e.totient : ℝ)) +
            V * (e.totient : ℝ)⁻¹ := by
      have hepos : 0 < e := (Finset.mem_Ioc.mp he).1
      have hsmall := hsmall_conductor u v F (Q / e) e h Lα K N₀
        hF hepos hh hLα hK hN₀ hu hv
      have hlarge := hlarge_conductor u v P R Q F (e * h) (Q / e)
        huP hvR hQ hF (Nat.div_le_self Q e)
      change (∑ f ∈ (Finset.Ioc 1 (Q / e)).filter (fun f => f ≤ F), Z e f) ≤
        Lα * K * N₀ * (e.divisors.card : ℝ) ^ s * (h.divisors.card : ℝ) ^ s *
          (F : ℝ) ^ (s + 2) at hsmall
      change (∑ f ∈ (Finset.Ioc 1 (Q / e)).filter (fun f => F < f), Z e f) ≤ V
        at hlarge
      rw [hsplit]
      calc
        (e.totient : ℝ)⁻¹ *
            ((∑ f ∈ (Finset.Ioc 1 (Q / e)).filter (fun f => f ≤ F), Z e f) +
              ∑ f ∈ (Finset.Ioc 1 (Q / e)).filter (fun f => F < f), Z e f) ≤
            (e.totient : ℝ)⁻¹ *
              (Lα * K * N₀ * (e.divisors.card : ℝ) ^ s *
                (h.divisors.card : ℝ) ^ s * (F : ℝ) ^ (s + 2) + V) :=
          mul_le_mul_of_nonneg_left (add_le_add hsmall hlarge)
            (inv_nonneg.mpr (Nat.cast_nonneg _))
        _ = T * ((e.divisors.card : ℝ) ^ s / (e.totient : ℝ)) +
            V * (e.totient : ℝ)⁻¹ := by
          dsimp only [T]
          rw [div_eq_mul_inv]
          ring
    have hrecip : (∑ e ∈ Finset.Ioc 0 Q, (e.totient : ℝ)⁻¹) ≤
        (harmonic Q : ℝ) ^ 2 := by
      simpa only [pow_zero, one_div, Nat.zero_add, pow_one] using hreciprocal_moment 0 Q
    change (∑ q ∈ Finset.Ioc 0 Q, ⨆ a : (ZMod q)ˣ,
      ‖fullDiscrepancy ((finiteConvolution u v).filter
        (fun n : ℕ => Nat.Coprime n h)) q (a : ZMod q).val‖) ≤
      T * (harmonic Q : ℝ) ^ (2 ^ (s + 1)) + V * (harmonic Q : ℝ) ^ 2
    calc
      (∑ q ∈ Finset.Ioc 0 Q, ⨆ a : (ZMod q)ˣ,
          ‖fullDiscrepancy ((finiteConvolution u v).filter
            (fun n : ℕ => Nat.Coprime n h)) q (a : ZMod q).val‖) ≤
          ∑ e ∈ Finset.Ioc 0 Q, (e.totient : ℝ)⁻¹ *
            ∑ f ∈ Finset.Ioc 1 (Q / e), Z e f :=
        sum_max_masked_finiteConvolution_discrepancy_le_conductor_sum u v Q h
      _ ≤ ∑ e ∈ Finset.Ioc 0 Q,
          (T * ((e.divisors.card : ℝ) ^ s / (e.totient : ℝ)) +
            V * (e.totient : ℝ)⁻¹) := Finset.sum_le_sum hpoint
      _ = T * (∑ e ∈ Finset.Ioc 0 Q, (e.divisors.card : ℝ) ^ s / (e.totient : ℝ)) +
          V * (∑ e ∈ Finset.Ioc 0 Q, (e.totient : ℝ)⁻¹) := by
        rw [Finset.sum_add_distrib, ← Finset.mul_sum, ← Finset.mul_sum]
      _ ≤ T * (harmonic Q : ℝ) ^ (2 ^ (s + 1)) + V * (harmonic Q : ℝ) ^ 2 :=
        add_le_add (mul_le_mul_of_nonneg_left (hreciprocal_moment s Q) hT)
          (mul_le_mul_of_nonneg_left hrecip hV)
  have hlog_threshold (D : ℝ) (hD : 0 < D) :
      ∀ᶠ x : ℝ in Filter.atTop,
        Real.exp 1 ≤ x ∧ 2 ≤ (Real.log x) ^ D ∧
          (Real.log x) ^ D ≤ x ^ (η / 2) := by
    have hlarge : ∀ᶠ x : ℝ in Filter.atTop, 2 ≤ (Real.log x) ^ D :=
      ((tendsto_rpow_atTop hD).comp Real.tendsto_log_atTop).eventually_ge_atTop 2
    have hsmall := (isLittleO_log_rpow_rpow_atTop D (half_pos hη)).bound
      (by norm_num : (0 : ℝ) < 1)
    filter_upwards [Filter.eventually_ge_atTop (Real.exp 1), hlarge, hsmall]
      with x hx hlarge hsmall
    refine ⟨hx, hlarge, ?_⟩
    have hx0 : 0 ≤ x := (lt_of_lt_of_le (Real.exp_pos 1) hx).le
    have hpow0 : 0 ≤ (Real.log x) ^ D := le_trans (by norm_num) hlarge
    simpa only [Real.norm_of_nonneg hpow0,
      Real.norm_of_nonneg (Real.rpow_nonneg hx0 (η / 2)), one_mul] using hsmall
  have hlog_sums (x : ℝ) (Q : ℕ) (hx : Real.exp 1 ≤ x)
      (hQ : 1 ≤ Q) (hQx : (Q : ℝ) ≤ x) :
      (harmonic Q : ℝ) ≤ 2 * Real.log x ∧
        ((Nat.log 2 Q + 1 : ℕ) : ℝ) ≤
          (2 + 1 / Real.log 2) * Real.log x := by
    have hlogx : 1 ≤ Real.log x := by
      simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hx
    have hQpos : 0 < (Q : ℝ) :=
      Nat.cast_pos.mpr (lt_of_lt_of_le Nat.zero_lt_one hQ)
    have hlogQ : Real.log (Q : ℝ) ≤ Real.log x :=
      Real.log_le_log hQpos hQx
    have hlog2 : 0 < Real.log 2 := Real.log_pos (by norm_num)
    constructor
    · exact (harmonic_le_one_add_log Q).trans (by linarith)
    · have hnat : (Nat.log 2 Q : ℝ) ≤ Real.log (Q : ℝ) / Real.log 2 := by
        simpa only [Real.logb, Nat.cast_ofNat] using Real.natLog_le_logb Q 2
      have hnatx : (Nat.log 2 Q : ℝ) ≤ Real.log x / Real.log 2 :=
        hnat.trans (div_le_div_of_nonneg_right hlogQ hlog2.le)
      rw [Nat.cast_add, Nat.cast_one]
      calc
        (Nat.log 2 Q : ℝ) + 1 ≤ Real.log x / Real.log 2 + 1 :=
          by linarith only [hnatx]
        _ ≤ (2 + 1 / Real.log 2) * Real.log x := by
          have hdiv : Real.log x / Real.log 2 = (1 / Real.log 2) * Real.log x := by
            ring
          rw [hdiv]
          nlinarith
  have hpower_saving (L a A D : ℝ) (hL : 1 ≤ L) (hD : A + a ≤ D) :
      L ^ a / L ^ D ≤ 1 / L ^ A := by
    have hLpos : 0 < L := lt_of_lt_of_le zero_lt_one hL
    calc
      L ^ a / L ^ D = L ^ (a - D) := (Real.rpow_sub hLpos a D).symm
      _ ≤ L ^ (-A) := Real.rpow_le_rpow_of_exponent_le hL (by linarith)
      _ = 1 / L ^ A := by rw [Real.rpow_neg hLpos.le, one_div]
  intro A hA
  let p₁ : ℕ := k + (2 ^ k - 1)
  let p₂ : ℕ := 2 * k + (2 ^ (2 * k) - 1)
  let ρ : ℕ := 2 ^ (s + 1)
  let Acoef : ℝ := 2 * C * W * Rlog ^ (2 ^ k - 1)
  let Ecoef : ℝ := 2 * C * W ^ 2 * Rlog ^ (2 ^ (2 * k) - 1)
  let J : ℝ := 2 + 1 / Real.log 2
  let G : ℝ := 8 * C ^ 2 + 4 * C * Real.sqrt (2 * C) + 4 * Real.sqrt C
  let D : ℝ := A + p₂ + 4
  let A' : ℝ := A + p₁ + ρ + (s + 2 : ℕ) * D + 1
  have hAcoef : 0 ≤ Acoef := by dsimp only [Acoef]; positivity
  have hEcoef : 0 ≤ Ecoef := by dsimp only [Ecoef]; positivity
  have hJ : 0 ≤ J := by
    dsimp only [J]
    have : 0 < Real.log 2 := Real.log_pos (by norm_num)
    positivity
  have hG : 0 ≤ G := by dsimp only [G]; positivity
  have hD : 0 < D := by dsimp only [D]; positivity
  have hA' : 0 < A' := by dsimp only [A']; positivity
  obtain ⟨KSW, XSW, hKSW, hXSW, hSW'⟩ := hSW A' hA'
  obtain ⟨X₁, hX₁⟩ := Filter.eventually_atTop.mp (hlog_threshold D hD)
  let Ks : ℝ := C * Acoef * KSW * 2 ^ ρ
  let Kl : ℝ := 4 * J * Ecoef * G
  have hKs : 0 ≤ Ks := by dsimp only [Ks]; positivity
  have hKl : 0 ≤ Kl := by dsimp only [Kl]; positivity
  refine ⟨D, 1 + Ks + Kl, max X₀ (max XSW X₁), hD, by positivity,
    le_max_left _ _, ?_⟩
  intro x hx i h hh
  have hx₀ : X₀ ≤ x := (le_max_left _ _).trans hx
  have hxSW : XSW ≤ x := (le_max_left XSW X₁).trans ((le_max_right _ _).trans hx)
  have hx₁ : X₁ ≤ x := (le_max_right XSW X₁).trans ((le_max_right _ _).trans hx)
  obtain ⟨_, hLD2, hLDsmall⟩ := hX₁ x hx₁
  have hxexp : Real.exp 1 ≤ x := hX₀.trans hx₀
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hx1 : 1 ≤ x := by
    exact (Real.one_le_exp_iff.mpr (by norm_num : (0 : ℝ) ≤ 1)).trans hxexp
  let L : ℝ := Real.log x
  let Q : ℕ := ⌊Real.sqrt x / L ^ D⌋₊
  let F : ℕ := ⌊L ^ D⌋₊
  let P : ℕ := ⌈C * M x i⌉₊
  let R : ℕ := ⌈C * N x i⌉₊
  have hL1 : 1 ≤ L := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hxexp
  have hLpos : 0 < L := lt_of_lt_of_le zero_lt_one hL1
  have hLDpos : 0 < L ^ D := Real.rpow_pos_of_pos hLpos D
  have hLApos : 0 < L ^ A := Real.rpow_pos_of_pos hLpos A
  have hLA'pos : 0 < L ^ A' := Real.rpow_pos_of_pos hLpos A'
  have hF : 1 ≤ F := (Nat.one_le_floor_iff (L ^ D)).mpr (by linarith)
  have hFupper : (F : ℝ) ≤ L ^ D := Nat.floor_le hLDpos.le
  have hFlower : L ^ D / 2 ≤ (F : ℝ) := by
    have hf := Nat.lt_floor_add_one (L ^ D)
    change L ^ D < (F : ℝ) + 1 at hf
    change 2 ≤ L ^ D at hLD2
    linarith
  have hQcut : (Q : ℝ) ≤ Real.sqrt x / L ^ D :=
    Nat.floor_le (div_nonneg (Real.sqrt_nonneg _) hLDpos.le)
  have hQx : (Q : ℝ) ≤ x := by
    calc
      (Q : ℝ) ≤ Real.sqrt x / L ^ D := hQcut
      _ ≤ Real.sqrt x := div_le_self (Real.sqrt_nonneg _) (Real.one_le_rpow hL1 hD.le)
      _ ≤ x := Real.sqrt_le_self_iff.mpr (Or.inr hx1)
  have hτh : 1 ≤ (h.divisors.card : ℝ) ^ s := by
    apply one_le_pow₀
    exact_mod_cast Finset.one_le_card.mpr ⟨1, Nat.one_mem_divisors.mpr (Nat.ne_of_gt hh)⟩
  change (∑ q ∈ Finset.Ioc 0 Q, ⨆ a : (ZMod q)ˣ,
    ‖fullDiscrepancy ((finiteConvolution (α x i) (β x i)).filter
      (fun n : ℕ => Nat.Coprime n h)) q (a : ZMod q).val‖) ≤
    (1 + Ks + Kl) * (h.divisors.card : ℝ) ^ s * x / L ^ A
  by_cases hQzero : Q = 0
  · simp only [hQzero, Finset.Ioc_self, Finset.sum_empty]
    positivity
  have hQ : 1 ≤ Q := Nat.pos_of_ne_zero hQzero
  obtain ⟨hH, hcount⟩ := hlog_sums x Q hxexp hQ hQx
  change (harmonic Q : ℝ) ≤ 2 * L at hH
  change ((Nat.log 2 Q + 1 : ℕ) : ℝ) ≤ J * L at hcount
  have hH0 : 0 ≤ (harmonic Q : ℝ) := by
    exact_mod_cast (harmonic_pos hQzero).le
  obtain ⟨_, hMN, hM, hN⟩ := hscale x hx₀ i
  have hM1 : 1 ≤ M x i := (Real.one_le_rpow hx1 hη.le).trans hM
  have hN1 : 1 ≤ N x i := (Real.one_le_rpow hx1 hη.le).trans hN
  have hMpos : 0 < M x i := lt_of_lt_of_le zero_lt_one hM1
  have hNpos : 0 < N x i := lt_of_lt_of_le zero_lt_one hN1
  have hMx : M x i ≤ C * x :=
    (le_mul_of_one_le_right hMpos.le hN1).trans hMN
  have hNx : N x i ≤ C * x := by
    calc
      N x i ≤ M x i * N x i := le_mul_of_one_le_left hNpos.le hM1
      _ ≤ C * x := hMN
  obtain ⟨hαsupport, hβsupport⟩ := hsupport x hx₀ i
  have hαpos : ∀ n ∈ (α x i).support, 0 < n ∧ (n : ℝ) ≤ C * M x i := by
    intro n hn
    exact ⟨Nat.cast_pos.mp ((mul_pos hc hMpos).trans_le (hαsupport n hn).1),
      (hαsupport n hn).2⟩
  have hβpos : ∀ n ∈ (β x i).support, 0 < n ∧ (n : ℝ) ≤ C * N x i := by
    intro n hn
    exact ⟨Nat.cast_pos.mp ((mul_pos hc hNpos).trans_le (hβsupport n hn).1),
      (hβsupport n hn).2⟩
  obtain ⟨⟨_, hPupper⟩, hαP⟩ := hceil_geometry (M x i) hM1 (α x i) hαpos
  obtain ⟨⟨_, hRupper⟩, hβR⟩ := hceil_geometry (N x i) hN1 (β x i) hβpos
  have hαone : (∑ n ∈ (α x i).support, ‖α x i n‖) ≤ Acoef * M x i * L ^ p₁ := by
    simpa only [mul_one, pow_one, Acoef, p₁, L] using
      hcoefficient_moment 1 x (M x i) hxexp hM1 hMx (α x i) hαpos
        (fun n _ => (hcoeff x hx₀ i n).1)
  have hαtwo : (∑ n ∈ (α x i).support, ‖α x i n‖ ^ 2) ≤ Ecoef * M x i * L ^ p₂ := by
    simpa only [Ecoef, p₂, L, Nat.mul_comm] using
      hcoefficient_moment 2 x (M x i) hxexp hM1 hMx (α x i) hαpos
        (fun n _ => (hcoeff x hx₀ i n).1)
  have hβtwo : (∑ n ∈ (β x i).support, ‖β x i n‖ ^ 2) ≤ Ecoef * N x i * L ^ p₂ := by
    simpa only [Ecoef, p₂, L, Nat.mul_comm] using
      hcoefficient_moment 2 x (N x i) hxexp hN1 hNx (β x i) hβpos
        (fun n _ => (hcoeff x hx₀ i n).2)
  have henergy :
      Real.sqrt (∑ n ∈ (α x i).support, ‖α x i n‖ ^ 2) *
          Real.sqrt (∑ n ∈ (β x i).support, ‖β x i n‖ ^ 2) ≤
        Ecoef * Real.sqrt (M x i) * Real.sqrt (N x i) * L ^ p₂ := by
    calc
      Real.sqrt (∑ n ∈ (α x i).support, ‖α x i n‖ ^ 2) *
          Real.sqrt (∑ n ∈ (β x i).support, ‖β x i n‖ ^ 2) ≤
          Real.sqrt (Ecoef * M x i * L ^ p₂) * Real.sqrt (Ecoef * N x i * L ^ p₂) :=
        mul_le_mul (Real.sqrt_le_sqrt hαtwo) (Real.sqrt_le_sqrt hβtwo)
          (Real.sqrt_nonneg _) (Real.sqrt_nonneg _)
      _ = (Real.sqrt Ecoef) ^ 2 * (Real.sqrt (L ^ p₂)) ^ 2 *
          Real.sqrt (M x i) * Real.sqrt (N x i) := by
        rw [Real.sqrt_mul (mul_nonneg hEcoef hMpos.le),
          Real.sqrt_mul (mul_nonneg hEcoef hNpos.le),
          Real.sqrt_mul hEcoef, Real.sqrt_mul hEcoef]
        ring
      _ = Ecoef * Real.sqrt (M x i) * Real.sqrt (N x i) * L ^ p₂ := by
        rw [Real.sq_sqrt hEcoef, Real.sq_sqrt (pow_nonneg hLpos.le _)]
        ring
  have hβSW : ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
      ‖fullDiscrepancy ((β x i).filter (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
        (KSW / L ^ A') * ((q * r).divisors.card : ℝ) ^ s * N x i := by
    intro q r a hq hr ha
    convert hSW' x hxSW i q r a hq hr ha using 1
    ring
  have hfinite := hfinite_bound (α x i) (β x i) P R Q F h
    (Acoef * M x i * L ^ p₁) (KSW / L ^ A') (N x i)
    hQ hF hh hαP hβR (by positivity) (div_nonneg hKSW.le hLA'pos.le)
    hNpos.le hαone hβSW
  have hpre : 0 ≤ Acoef * M x i * L ^ p₁ * (KSW / L ^ A') * N x i *
      (h.divisors.card : ℝ) ^ s :=
    mul_nonneg
      (mul_nonneg
        (mul_nonneg (mul_nonneg (mul_nonneg hAcoef hMpos.le) (pow_nonneg hLpos.le _))
          (div_nonneg hKSW.le hLA'pos.le)) hNpos.le)
      (pow_nonneg (Nat.cast_nonneg _) _)
  have hsmall :
      Acoef * M x i * L ^ p₁ * (KSW / L ^ A') * N x i *
          (h.divisors.card : ℝ) ^ s * (F : ℝ) ^ (s + 2) * (harmonic Q : ℝ) ^ ρ ≤
        Ks * (h.divisors.card : ℝ) ^ s * x / L ^ A := by
    have hpowers : L ^ p₁ * (L ^ D) ^ (s + 2) * L ^ ρ =
        L ^ ((p₁ : ℝ) + (s + 2 : ℕ) * D + (ρ : ℝ)) := by
      have hpowD : (L ^ D) ^ (s + 2) = L ^ ((s + 2 : ℕ) * D) := by
        rw [← Real.rpow_natCast (L ^ D) (s + 2),
          ← Real.rpow_mul hLpos.le D ((s + 2 : ℕ) : ℝ)]
        congr 1
        ring
      rw [Real.rpow_add hLpos ((p₁ : ℝ) + (s + 2 : ℕ) * D) (ρ : ℝ),
        Real.rpow_add hLpos (p₁ : ℝ) ((s + 2 : ℕ) * D),
        Real.rpow_natCast L p₁, Real.rpow_natCast L ρ, hpowD]
    calc
      Acoef * M x i * L ^ p₁ * (KSW / L ^ A') * N x i *
          (h.divisors.card : ℝ) ^ s * (F : ℝ) ^ (s + 2) * (harmonic Q : ℝ) ^ ρ ≤
          Acoef * M x i * L ^ p₁ * (KSW / L ^ A') * N x i *
            (h.divisors.card : ℝ) ^ s * (L ^ D) ^ (s + 2) * (2 * L) ^ ρ :=
        mul_le_mul
          (mul_le_mul_of_nonneg_left
            (pow_le_pow_left₀ (Nat.cast_nonneg F) hFupper _) hpre)
          (pow_le_pow_left₀ hH0 hH _) (pow_nonneg hH0 _)
          (mul_nonneg hpre (pow_nonneg hLDpos.le _))
      _ = Acoef * KSW * (M x i * N x i) * (h.divisors.card : ℝ) ^ s * 2 ^ ρ *
          (L ^ p₁ * (L ^ D) ^ (s + 2) * L ^ ρ / L ^ A') := by
        rw [mul_pow]
        ring
      _ ≤ Acoef * KSW * (C * x) * (h.divisors.card : ℝ) ^ s * 2 ^ ρ *
          (L ^ p₁ * (L ^ D) ^ (s + 2) * L ^ ρ / L ^ A') := by
        apply mul_le_mul_of_nonneg_right _
          (div_nonneg (mul_nonneg (mul_nonneg (pow_nonneg hLpos.le _)
            (pow_nonneg hLDpos.le _)) (pow_nonneg hLpos.le _)) hLA'pos.le)
        apply mul_le_mul_of_nonneg_right _ (pow_nonneg (by norm_num) _)
        apply mul_le_mul_of_nonneg_right _ (pow_nonneg (Nat.cast_nonneg _) _)
        exact mul_le_mul_of_nonneg_left hMN (mul_nonneg hAcoef hKSW.le)
      _ = Ks * (h.divisors.card : ℝ) ^ s * x *
          (L ^ ((p₁ : ℝ) + (s + 2 : ℕ) * D + (ρ : ℝ)) / L ^ A') := by
        rw [hpowers]
        dsimp only [Ks]
        ring
      _ ≤ Ks * (h.divisors.card : ℝ) ^ s * x * (1 / L ^ A) := by
        apply mul_le_mul_of_nonneg_left _ (by positivity)
        exact hpower_saving L _ A A' hL1 (by dsimp only [A']; linarith)
      _ = Ks * (h.divisors.card : ℝ) ^ s * x / L ^ A := by ring
  let V : ℝ := 2 * Real.sqrt (P : ℝ) * Real.sqrt (R : ℝ) / (F : ℝ) +
    2 * (Real.sqrt (P : ℝ) + Real.sqrt (R : ℝ)) + 4 * (Q : ℝ)
  have hV : 0 ≤ V := by dsimp only [V]; positivity
  have hgeometry : Real.sqrt (M x i) * Real.sqrt (N x i) * V ≤ G * x / L ^ D :=
    hlarge_geometry x (M x i) (N x i) P R Q F D hxexp hD.le hMN hM hN
      hPupper hRupper hFlower hQcut hLDsmall
  have hlarge : ((Nat.log 2 Q + 1 : ℕ) : ℝ) *
      Real.sqrt (∑ n ∈ (α x i).support, ‖α x i n‖ ^ 2) *
      Real.sqrt (∑ n ∈ (β x i).support, ‖β x i n‖ ^ 2) * V *
        (harmonic Q : ℝ) ^ 2 ≤ Kl * (h.divisors.card : ℝ) ^ s * x / L ^ A := by
    calc
      ((Nat.log 2 Q + 1 : ℕ) : ℝ) *
          Real.sqrt (∑ n ∈ (α x i).support, ‖α x i n‖ ^ 2) *
          Real.sqrt (∑ n ∈ (β x i).support, ‖β x i n‖ ^ 2) * V *
            (harmonic Q : ℝ) ^ 2 =
          ((Nat.log 2 Q + 1 : ℕ) : ℝ) *
            (Real.sqrt (∑ n ∈ (α x i).support, ‖α x i n‖ ^ 2) *
              Real.sqrt (∑ n ∈ (β x i).support, ‖β x i n‖ ^ 2)) * V *
            (harmonic Q : ℝ) ^ 2 := by ring
      _ ≤ (J * L) * (Ecoef * Real.sqrt (M x i) * Real.sqrt (N x i) * L ^ p₂) * V *
          (2 * L) ^ 2 := by
        exact mul_le_mul
          (mul_le_mul_of_nonneg_right
            (mul_le_mul hcount henergy (by positivity) (mul_nonneg hJ hLpos.le)) hV)
          (pow_le_pow_left₀ hH0 hH _) (pow_nonneg hH0 _) (by positivity)
      _ = 4 * J * Ecoef * L ^ (p₂ + 3) *
          (Real.sqrt (M x i) * Real.sqrt (N x i) * V) := by
        rw [pow_add]
        ring
      _ ≤ 4 * J * Ecoef * L ^ (p₂ + 3) * (G * x / L ^ D) :=
        mul_le_mul_of_nonneg_left hgeometry (by positivity)
      _ = Kl * x * (L ^ ((p₂ + 3 : ℕ) : ℝ) / L ^ D) := by
        rw [Real.rpow_natCast]
        dsimp only [Kl]
        ring
      _ ≤ Kl * x * (1 / L ^ A) := by
        apply mul_le_mul_of_nonneg_left _ (mul_nonneg hKl hxpos.le)
        apply hpower_saving L _ A D hL1
        dsimp only [D]
        push_cast
        linarith
      _ = Kl * x / L ^ A := by ring
      _ ≤ Kl * (h.divisors.card : ℝ) ^ s * x / L ^ A :=
        div_le_div_of_nonneg_right
          (mul_le_mul_of_nonneg_right (le_mul_of_one_le_right hKl hτh) hxpos.le) hLApos.le
  calc
    (∑ q ∈ Finset.Ioc 0 Q, ⨆ a : (ZMod q)ˣ,
        ‖fullDiscrepancy ((finiteConvolution (α x i) (β x i)).filter
          (fun n : ℕ => Nat.Coprime n h)) q (a : ZMod q).val‖) ≤
        Acoef * M x i * L ^ p₁ * (KSW / L ^ A') * N x i *
            (h.divisors.card : ℝ) ^ s * (F : ℝ) ^ (s + 2) * (harmonic Q : ℝ) ^ ρ +
          ((Nat.log 2 Q + 1 : ℕ) : ℝ) *
            Real.sqrt (∑ n ∈ (α x i).support, ‖α x i n‖ ^ 2) *
            Real.sqrt (∑ n ∈ (β x i).support, ‖β x i n‖ ^ 2) * V *
              (harmonic Q : ℝ) ^ 2 := hfinite
    _ ≤ Ks * (h.divisors.card : ℝ) ^ s * x / L ^ A +
        Kl * (h.divisors.card : ℝ) ^ s * x / L ^ A := add_le_add hsmall hlarge
    _ = (Ks + Kl) * (h.divisors.card : ℝ) ^ s * x / L ^ A := by
      rw [← add_div, ← add_mul, ← add_mul]
    _ ≤ (1 + Ks + Kl) * (h.divisors.card : ℝ) ^ s * x / L ^ A := by
      have hsum : Ks + Kl ≤ 1 + Ks + Kl :=
        (le_add_of_nonneg_left zero_le_one :
          Ks + Kl ≤ 1 + (Ks + Kl)).trans_eq
            (add_assoc (1 : ℝ) Ks Kl).symm
      exact div_le_div_of_nonneg_right
        (mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_right hsum (zero_le_one.trans hτh))
          hxpos.le) hLApos.le

open scoped Classical in
theorem balanced_bv_meanTerm_uniform_log_saving
    {ι : Type*} (M N : ℝ → ι → ℝ)
    (α β : ℝ → ι → ℕ →₀ ℂ)
    (c C W η X₀ : ℝ) (k s : ℕ)
    (hc : 0 < c) (hC : 1 ≤ C) (hW : 0 ≤ W)
    (hη : 0 < η) (hX₀ : Real.exp 1 ≤ X₀)
    (hscale : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι,
      x / C ≤ M x i * N x i ∧
      M x i * N x i ≤ C * x ∧
      x ^ η ≤ M x i ∧ x ^ η ≤ N x i)
    (hsupport : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι,
      (∀ n ∈ (α x i).support,
        c * M x i ≤ (n : ℝ) ∧ (n : ℝ) ≤ C * M x i) ∧
      (∀ n ∈ (β x i).support,
        c * N x i ≤ (n : ℝ) ∧ (n : ℝ) ≤ C * N x i))
    (hcoeff : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι, ∀ n : ℕ,
      ‖α x i n‖ ≤ W * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ k ∧
      ‖β x i n‖ ≤ W * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ k)
    (hSW : ∀ A : ℝ, 0 < A →
      ∃ KSW XSW : ℝ, 0 < KSW ∧ X₀ ≤ XSW ∧
        ∀ x : ℝ, XSW ≤ x → ∀ i : ι,
        ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
          ‖fullDiscrepancy
              ((β x i).filter (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
            KSW * ((q * r).divisors.card : ℝ) ^ s * N x i /
              (Real.log x) ^ A)
    (T θ : ℝ) (hT : 0 ≤ T) (hθ : θ < 1 / 2) :
    ∀ A : ℝ, 0 < A →
      ∃ K X : ℝ, 0 < K ∧ X₀ ≤ X ∧
        ∀ x : ℝ, X ≤ x → ∀ i : ι,
        ∀ S : Finset (ℕ × ℕ),
        (∀ p ∈ S, 0 < p.1 ∧ p.1 ≤ ⌊x ^ T⌋₊ ∧
          0 < p.2 ∧ p.2 ≤ ⌊x ^ θ⌋₊ ∧ Nat.Coprime p.1 p.2) →
        ∀ a : ℕ, (∀ p ∈ S, Nat.Coprime a (p.1 * p.2)) →
          (∑ p ∈ S, ‖meanTerm (finiteConvolution (α x i) (β x i)) p.1 p.2 a‖) ≤
            K * x / (Real.log x) ^ A := by
  classical
  intro A hA
  let ρ : ℕ := 2 ^ (s + 1)
  let A' : ℝ := A + ρ
  have hA' : 0 < A' := by dsimp only [A']; positivity
  obtain ⟨B, K, XB, hB, hK, hXB, hBV⟩ :=
    balanced_bv_masked_uniform_log_saving M N α β c C W η X₀ k s
      hc hC hW hη hX₀ hscale hsupport hcoeff hSW A' hA'
  have hgap : 0 < (1 / 2 : ℝ) - θ := sub_pos.mpr hθ
  have hsmall : ∀ᶠ x : ℝ in Filter.atTop,
      ‖(Real.log x) ^ B‖ ≤ ‖x ^ ((1 / 2 : ℝ) - θ)‖ := by
    simpa only [one_mul] using
      (isLittleO_log_rpow_rpow_atTop B hgap).bound (by norm_num : (0 : ℝ) < 1)
  obtain ⟨XP, hXP⟩ := Filter.eventually_atTop.mp hsmall
  let J : ℝ := (1 + T) ^ ρ
  have hJ : 0 < J := pow_pos (by linarith) _
  refine ⟨K * J, max XB XP, mul_pos hK hJ, hXB.trans (le_max_left _ _), ?_⟩
  intro x hx i S hS a ha
  have hxB : XB ≤ x := (le_max_left _ _).trans hx
  have hxP : XP ≤ x := (le_max_right _ _).trans hx
  have hx₀ : X₀ ≤ x := hXB.trans hxB
  have hxexp : Real.exp 1 ≤ x := hX₀.trans hx₀
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hx1 : 1 ≤ x :=
    (Real.one_le_exp_iff.mpr (by norm_num : (0 : ℝ) ≤ 1)).trans hxexp
  let L : ℝ := Real.log x
  let U : ℕ := ⌊x ^ T⌋₊
  let V : ℕ := ⌊x ^ θ⌋₊
  let Q : ℕ := ⌊Real.sqrt x / L ^ B⌋₊
  have hL1 : 1 ≤ L := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hxexp
  have hLpos : 0 < L := zero_lt_one.trans_le hL1
  have hLB : 0 < L ^ B := Real.rpow_pos_of_pos hLpos B
  have hLA : 0 < L ^ A := Real.rpow_pos_of_pos hLpos A
  have hLA' : 0 < L ^ A' := Real.rpow_pos_of_pos hLpos A'
  have hcut : x ^ θ ≤ Real.sqrt x / L ^ B := by
    have hp : L ^ B ≤ x ^ ((1 / 2 : ℝ) - θ) := by
      simpa only [Real.norm_of_nonneg hLB.le,
        Real.norm_of_nonneg (Real.rpow_nonneg hxpos.le _), L] using hXP x hxP
    apply (le_div_iff₀ hLB).mpr
    calc
      x ^ θ * L ^ B ≤ x ^ θ * x ^ ((1 / 2 : ℝ) - θ) :=
        mul_le_mul_of_nonneg_left hp (Real.rpow_nonneg hxpos.le _)
      _ = x ^ (1 / 2 : ℝ) := by
        rw [← Real.rpow_add hxpos θ ((1 / 2 : ℝ) - θ)]
        congr 1
        ring
      _ = Real.sqrt x := (Real.sqrt_eq_rpow x).symm
  have hVQ : V ≤ Q := Nat.floor_mono hcut
  have hprefix (q : ℕ) (hq : 0 < q) (_hqU : q ≤ U) :
      (∑ r ∈ Finset.Ioc 0 V, ⨆ b : (ZMod r)ˣ,
        ‖fullDiscrepancy
          ((finiteConvolution (α x i) (β x i)).filter
            (fun n : ℕ => Nat.Coprime n q)) r (b : ZMod r).val‖) ≤
        (K * x / L ^ A') * (q.divisors.card : ℝ) ^ s := by
    let Z (r : ℕ) : ℝ := ⨆ b : (ZMod r)ˣ,
      ‖fullDiscrepancy
        ((finiteConvolution (α x i) (β x i)).filter
          (fun n : ℕ => Nat.Coprime n q)) r (b : ZMod r).val‖
    have hnonneg (r : ℕ) (hr : 0 < r) : 0 ≤ Z r := by
      let : NeZero r := ⟨Nat.ne_of_gt hr⟩
      have hb : BddAbove (Set.range (fun b : (ZMod r)ˣ =>
          ‖fullDiscrepancy
            ((finiteConvolution (α x i) (β x i)).filter
              (fun n : ℕ => Nat.Coprime n q)) r (b : ZMod r).val‖)) :=
        (Set.finite_range _).bddAbove
      exact (norm_nonneg _).trans (le_ciSup hb (1 : (ZMod r)ˣ))
    change (∑ r ∈ Finset.Ioc 0 V, Z r) ≤ _
    calc
      (∑ r ∈ Finset.Ioc 0 V, Z r) ≤ ∑ r ∈ Finset.Ioc 0 Q, Z r := by
        apply Finset.sum_le_sum_of_subset_of_nonneg
        · intro r hr
          exact Finset.mem_Ioc.mpr
            ⟨(Finset.mem_Ioc.mp hr).1, (Finset.mem_Ioc.mp hr).2.trans hVQ⟩
        · intro r hr _
          exact hnonneg r (Finset.mem_Ioc.mp hr).1
      _ ≤ K * (q.divisors.card : ℝ) ^ s * x / L ^ A' := hBV x hxB i q hq
      _ = (K * x / L ^ A') * (q.divisors.card : ℝ) ^ s := by ring
  have hfinite := sum_norm_meanTerm_le_harmonic_of_masked_bv
    (finiteConvolution (α x i) (β x i)) U V s (K * x / L ^ A')
    (div_nonneg (mul_nonneg hK.le hxpos.le) hLA'.le) S a
    (fun p hp => ⟨(hS p hp).1, (hS p hp).2.1, (hS p hp).2.2.1,
      (hS p hp).2.2.2.1, (hS p hp).2.2.2.2, ha p hp⟩) hprefix
  have hU1 : 1 ≤ U := (Nat.one_le_floor_iff (x ^ T)).mpr (Real.one_le_rpow hx1 hT)
  have hUpos : (0 : ℝ) < U := Nat.cast_pos.mpr hU1
  have hUupper : (U : ℝ) ≤ x ^ T := Nat.floor_le (Real.rpow_nonneg hxpos.le _)
  have hlogU : Real.log (U : ℝ) ≤ T * L := by
    have hp := Real.log_le_log hUpos hUupper
    rwa [Real.log_rpow hxpos] at hp
  have hH : (harmonic U : ℝ) ≤ (1 + T) * L := by
    apply (harmonic_le_one_add_log U).trans
    nlinarith only [hlogU, hL1]
  have hH0 : 0 ≤ (harmonic U : ℝ) := by
    exact_mod_cast (harmonic_pos (Nat.ne_of_gt hU1)).le
  have hpowers : L ^ A' = L ^ A * L ^ ρ := by
    dsimp only [A']
    rw [Real.rpow_add hLpos A (ρ : ℝ), Real.rpow_natCast]
  calc
    (∑ p ∈ S, ‖meanTerm (finiteConvolution (α x i) (β x i)) p.1 p.2 a‖) ≤
        (K * x / L ^ A') * (harmonic U : ℝ) ^ ρ := hfinite
    _ ≤ (K * x / L ^ A') * ((1 + T) * L) ^ ρ :=
      mul_le_mul_of_nonneg_left (pow_le_pow_left₀ hH0 hH _)
        (div_nonneg (mul_nonneg hK.le hxpos.le) hLA'.le)
    _ = K * J * x / L ^ A := by
      rw [mul_pow, hpowers]
      dsimp only [J]
      field_simp [hLA.ne', (pow_pos hLpos ρ).ne']

theorem squarefree_residue_square_roots_card_le
    (q : ℕ) [NeZero q] (hq : Squarefree q) (a : ZMod q) :
    (Finset.univ.filter (fun z : ZMod q => z ^ 2 = a)).card ≤ q.divisors.card := by
  classical
  have (p : q.primeFactors) : Fact p.val.Prime :=
    ⟨Nat.prime_of_mem_primeFactors p.property⟩
  have hprod : (∏ p : q.primeFactors, p.val) = q := by
    calc
      _ = ∏ p ∈ q.primeFactors, p := by
        rw [Finset.prod_coe_sort_eq_attach]
        exact Finset.prod_attach q.primeFactors id
      _ = q := Nat.prod_primeFactors_of_squarefree hq
  have hcop : Pairwise (fun p r : q.primeFactors => Nat.Coprime p.val r.val) := by
    intro p r hpr
    apply (Nat.coprime_primes
      (Nat.prime_of_mem_primeFactors p.property)
      (Nat.prime_of_mem_primeFactors r.property)).mpr
    exact fun h => hpr (Subtype.ext h)
  let e : ZMod q ≃+* (∀ p : q.primeFactors, ZMod p.val) :=
    (ZMod.ringEquivCongr hprod.symm).trans
      (ZMod.prodEquivPi (fun p : q.primeFactors => p.val) hcop)
  let S : Finset (ZMod q) := Finset.univ.filter (fun z => z ^ 2 = a)
  let R (p : q.primeFactors) : Finset (ZMod p.val) :=
    Polynomial.nthRootsFinset 2 (e a p)
  have hR (p : q.primeFactors) : (R p).card ≤ 2 := by
    simpa only [R, Polynomial.nthRootsFinset_def] using
      (Multiset.toFinset_card_le (Polynomial.nthRoots 2 (e a p))).trans
        (Polynomial.card_nthRoots 2 (e a p))
  let f : S → ∀ p : q.primeFactors, R p := fun z p =>
    ⟨e z.val p, (Polynomial.mem_nthRootsFinset (by norm_num : 0 < 2) (e a p)).mpr
      (by
        have hz := congrArg e (Finset.mem_filter.mp z.property).2
        simpa only [map_pow, Pi.pow_apply] using congrFun hz p)⟩
  have hf : Function.Injective f := by
    intro z w hzw
    apply Subtype.ext
    apply e.injective
    funext p
    exact congrArg Subtype.val (congrFun hzw p)
  have hdiv : q.divisors.card = 2 ^ q.primeFactors.card := by
    rw [Nat.card_divisors hq.ne_zero]
    calc
      q.primeFactors.prod (fun p => q.factorization p + 1) =
          ∏ _p ∈ q.primeFactors, 2 := by
        apply Finset.prod_congr rfl
        intro p hp
        rw [Nat.factorization_eq_one_of_squarefree hq
          (Nat.prime_of_mem_primeFactors hp) (Nat.dvd_of_mem_primeFactors hp)]
      _ = 2 ^ q.primeFactors.card := by simp
  calc
    S.card = Fintype.card S := (Fintype.card_coe S).symm
    _ ≤ Fintype.card (∀ p : q.primeFactors, R p) := Fintype.card_le_of_injective f hf
    _ = ∏ p : q.primeFactors, (R p).card := by simp only [Fintype.card_pi, Fintype.card_coe]
    _ ≤ ∏ _p : q.primeFactors, 2 := Finset.prod_le_prod' (fun p _ => hR p)
    _ = 2 ^ q.primeFactors.card := by simp
    _ = q.divisors.card := hdiv.symm

/--
The part of the von Mangoldt function supported on nonprime prime powers: it is zero at primes
and equals the von Mangoldt function elsewhere.
-/
noncomputable def primePowerError (n : ℕ) : ℝ :=
  if n.Prime then 0 else ArithmeticFunction.vonMangoldt n

theorem primePowerError_eq (n : ℕ) :
    primePowerError n = ArithmeticFunction.vonMangoldt n -
      (if n.Prime then Real.log (n : ℝ) else 0) := by
  by_cases hn : n.Prime
  · simp [primePowerError, hn, ArithmeticFunction.vonMangoldt_apply_prime hn]
  · simp [primePowerError, hn]

theorem primePowerError_nonneg (n : ℕ) : 0 ≤ primePowerError n := by
  unfold primePowerError
  positivity

theorem primePowerError_prime_pow (p k : ℕ) (hp : p.Prime) (hk : 0 < k) :
    primePowerError (p ^ k) = if k = 1 then 0 else Real.log (p : ℝ) := by
  by_cases hk1 : k = 1
  · simp [hk1, primePowerError, hp]
  · simp [primePowerError, hk1, Nat.Prime.not_prime_pow' hk1,
      ArithmeticFunction.vonMangoldt_apply_pow hk.ne',
      ArithmeticFunction.vonMangoldt_apply_prime hp]

theorem square_residue_interval_card_le (M q a : ℕ) [NeZero q]
    (hsq : Squarefree q) :
    ((Finset.Ioc 0 M).filter (fun n => Nat.ModEq q (n ^ 2) a)).card ≤
      (M / q + 1) * q.divisors.card := by
  classical
  let R : Finset (ZMod q) := Finset.univ.filter (fun z => z ^ 2 = (a : ZMod q))
  calc
    _ ≤ ((Finset.Icc 0 (M / q)) ×ˢ R).card := by
      apply Finset.card_le_card_of_injOn (fun n : ℕ => (n / q, (n : ZMod q)))
      · intro n hn
        obtain ⟨hnI, hnmod⟩ := Finset.mem_filter.mp hn
        apply Finset.mem_product.mpr
        refine ⟨Finset.mem_Icc.mpr ⟨Nat.zero_le _,
          Nat.div_le_div_right (Finset.mem_Ioc.mp hnI).2⟩, ?_⟩
        apply Finset.mem_filter.mpr
        refine ⟨Finset.mem_univ _, ?_⟩
        simpa only [Nat.cast_pow] using
          (ZMod.natCast_eq_natCast_iff (n ^ 2) a q).mpr hnmod
      · intro n _ m _ hnm
        exact Nat.ext_div_modEq (congrArg Prod.fst hnm)
          ((ZMod.natCast_eq_natCast_iff n m q).mp (congrArg Prod.snd hnm))
    _ = (M / q + 1) * R.card := by simp
    _ ≤ (M / q + 1) * q.divisors.card :=
      Nat.mul_le_mul_left _ (squarefree_residue_square_roots_card_le q hsq (a : ZMod q))

theorem square_residue_interval_card_cast_le (M q a : ℕ) [NeZero q]
    (hsq : Squarefree q) :
    (((Finset.Ioc 0 M).filter (fun n => Nat.ModEq q (n ^ 2) a)).card : ℝ) ≤
      (q.divisors.card : ℝ) * ((M : ℝ) / (q : ℝ) + 1) := by
  calc
    _ ≤ ((M / q + 1 : ℕ) : ℝ) * (q.divisors.card : ℝ) := by
      exact_mod_cast square_residue_interval_card_le M q a hsq
    _ ≤ ((M : ℝ) / (q : ℝ) + 1) * (q.divisors.card : ℝ) := by
      push_cast
      gcongr
      exact Nat.cast_div_le
    _ = _ := mul_comm _ _

theorem square_prime_log_progression_le (X : ℝ) (hX : 1 ≤ X)
    (q a : ℕ) [NeZero q] (hsq : Squarefree q) :
    (∑ p ∈ (Finset.Ioc 0 ⌊Real.sqrt X⌋₊).filter Nat.Prime,
      if Nat.ModEq q (p ^ 2) a then Real.log (p : ℝ) else 0) ≤
      (q.divisors.card : ℝ) * (Real.sqrt X / (q : ℝ) + 1) * Real.log X := by
  classical
  have hlog : 0 ≤ Real.log X := Real.log_nonneg hX
  have hsqrt : Real.sqrt X ≤ X := by
    rw [Real.sqrt_eq_rpow]
    exact Real.rpow_le_self_of_one_le hX (by norm_num)
  have hq : (0 : ℝ) < q := by exact_mod_cast Nat.pos_of_ne_zero (NeZero.ne q)
  calc
    _ ≤ ∑ p ∈ Finset.Ioc 0 ⌊Real.sqrt X⌋₊,
        if Nat.ModEq q (p ^ 2) a then Real.log X else 0 := by
      rw [Finset.sum_filter]
      apply Finset.sum_le_sum
      intro p hpI
      have hpX : (p : ℝ) ≤ X :=
        ((Nat.cast_le.mpr (Finset.mem_Ioc.mp hpI).2).trans
          (Nat.floor_le (Real.sqrt_nonneg X))).trans hsqrt
      by_cases hp : p.Prime
      · by_cases hm : Nat.ModEq q (p ^ 2) a
        · simp only [hp, hm, ite_true]
          exact Real.log_le_log (Nat.cast_pos.mpr hp.pos) hpX
        · simp [hp, hm]
      · simp only [hp, ite_false]
        positivity
    _ = (((Finset.Ioc 0 ⌊Real.sqrt X⌋₊).filter
        (fun p => Nat.ModEq q (p ^ 2) a)).card : ℝ) * Real.log X := by
      rw [← Finset.sum_filter]
      simp
    _ ≤ (q.divisors.card : ℝ) * (Real.sqrt X / (q : ℝ) + 1) * Real.log X := by
      apply mul_le_mul_of_nonneg_right _ hlog
      refine (square_residue_interval_card_cast_le ⌊Real.sqrt X⌋₊ q a hsq).trans ?_
      gcongr
      exact Nat.floor_le (Real.sqrt_nonneg X)

theorem primePowerError_progression_le (X : ℝ) (hX : 1 ≤ X)
    (q a : ℕ) [NeZero q] (hsq : Squarefree q) :
    (∑ n ∈ (Finset.Ioc 0 ⌊X⌋₊).filter (fun n => Nat.ModEq q n a),
      primePowerError n) ≤
      (q.divisors.card : ℝ) * (Real.sqrt X / (q : ℝ) + 1) * Real.log X +
        2 * X ^ (1 / 3 : ℝ) * Real.log X := by
  classical
  let N : ℕ := ⌊Real.log X / Real.log 2⌋₊
  let g : ℕ → ℝ := fun n => if Nat.ModEq q n a then primePowerError n else 0
  let B : ℝ := (q.divisors.card : ℝ) *
    (Real.sqrt X / (q : ℝ) + 1) * Real.log X
  let C : ℝ := Real.log 4 * X ^ (1 / 3 : ℝ)
  have hX0 : 0 < X := zero_lt_one.trans_le hX
  have hlog : 0 ≤ Real.log X := Real.log_nonneg hX
  have hlog2 : 0 < Real.log 2 := Real.log_pos (by norm_num)
  have hB : 0 ≤ B := by positivity
  have hC : 0 ≤ C := by positivity
  have hrestrict : (∑ n ∈ Finset.Ioc 0 ⌊X⌋₊, g n) =
      ∑ n ∈ (Finset.Ioc 0 ⌊X⌋₊).filter IsPrimePow, g n := by
    rw [Finset.sum_filter]
    apply Finset.sum_congr rfl
    intro n _
    by_cases hn : IsPrimePow n
    · simp [hn]
    · have hz := ArithmeticFunction.vonMangoldt_eq_zero_iff.mpr hn
      simp [g, primePowerError, hz, hn]
  have hterm (k : ℕ) (hk : k ∈ Finset.Icc 1 N) :
      (∑ p ∈ (Finset.Ioc 0 ⌊X ^ ((1 : ℝ) / k)⌋₊).filter Nat.Prime,
        g (p ^ k)) ≤ (if k = 2 then B else 0) + C := by
    have hkpos : 0 < k := (Finset.mem_Icc.mp hk).1
    by_cases hk1 : k = 1
    · subst k
      have hz : (∑ p ∈ (Finset.Ioc 0 ⌊X ^ ((1 : ℝ) / 1)⌋₊).filter Nat.Prime,
          g (p ^ 1)) = 0 := by
        apply Finset.sum_eq_zero
        intro p hp
        simp [g, primePowerError, (Finset.mem_filter.mp hp).2]
      simp only [Nat.cast_one]
      rw [hz]
      simpa using hC
    by_cases hk2 : k = 2
    · subst k
      have heq : (∑ p ∈ (Finset.Ioc 0 ⌊X ^ ((1 : ℝ) / (2 : ℕ))⌋₊).filter Nat.Prime,
          g (p ^ 2)) =
          ∑ p ∈ (Finset.Ioc 0 ⌊Real.sqrt X⌋₊).filter Nat.Prime,
            if Nat.ModEq q (p ^ 2) a then Real.log (p : ℝ) else 0 := by
        simp only [Nat.cast_ofNat, ← Real.sqrt_eq_rpow]
        apply Finset.sum_congr rfl
        intro p hp
        simp [g, primePowerError_prime_pow p 2 (Finset.mem_filter.mp hp).2 (by omega)]
      rw [heq]
      simp only [ite_true]
      exact (square_prime_log_progression_le X hX q a hsq).trans
        (le_add_of_nonneg_right hC)
    · have hk3 : 3 ≤ k := by omega
      have hinner : (∑ p ∈ (Finset.Ioc 0 ⌊X ^ ((1 : ℝ) / k)⌋₊).filter Nat.Prime,
          g (p ^ k)) ≤ Chebyshev.theta (X ^ ((1 : ℝ) / k)) := by
        apply Finset.sum_le_sum
        intro p hp
        have hpprime := (Finset.mem_filter.mp hp).2
        simp only [g, primePowerError_prime_pow p k hpprime hkpos, hk1, ite_false]
        split_ifs
        · exact le_rfl
        · exact Real.log_nonneg (Nat.one_le_cast.mpr hpprime.one_le)
      simp only [hk2, ite_false, zero_add]
      refine hinner.trans ((Chebyshev.theta_le_log4_mul_x
        (Real.rpow_nonneg hX0.le _)).trans ?_)
      apply mul_le_mul_of_nonneg_left _ (Real.log_nonneg (by norm_num))
      apply Real.rpow_le_rpow_of_exponent_le hX
      exact one_div_le_one_div_of_le (by norm_num) (by exact_mod_cast hk3)
  rw [Finset.sum_filter]
  change (∑ n ∈ Finset.Ioc 0 ⌊X⌋₊, g n) ≤ _
  rw [hrestrict, Chebyshev.sum_PrimePow_eq_sum_sum' g hX0.le (N := N) le_rfl]
  calc
    _ ≤ ∑ k ∈ Finset.Icc 1 N, ((if k = 2 then B else 0) + C) :=
      Finset.sum_le_sum hterm
    _ = (if 2 ∈ Finset.Icc 1 N then B else 0) + (N : ℝ) * C := by
      rw [Finset.sum_add_distrib]
      simp
    _ ≤ B + (N : ℝ) * C := by
      gcongr
      split_ifs <;> simp [hB]
    _ ≤ B + 2 * X ^ (1 / 3 : ℝ) * Real.log X := by
      apply add_le_add_right
      have hN : (N : ℝ) ≤ Real.log X / Real.log 2 :=
        Nat.floor_le (div_nonneg hlog hlog2.le)
      calc
        _ ≤ (Real.log X / Real.log 2) * C :=
          mul_le_mul_of_nonneg_right hN hC
        _ = _ := by
          dsimp only [C]
          rw [show Real.log 4 = 2 * Real.log 2 by
            rw [show (4 : ℝ) = 2 ^ (2 : ℕ) by norm_num, Real.log_pow]
            norm_num]
          field_simp

theorem sum_primePowerError_le (S : Finset ℕ) (X : ℝ) (hX : 1 ≤ X)
    (hS : S ⊆ Finset.Ioc 0 ⌊X⌋₊) :
    (∑ n ∈ S, primePowerError n) ≤ 2 * Real.sqrt X * Real.log X := by
  classical
  calc
    _ ≤ ∑ n ∈ Finset.Ioc 0 ⌊X⌋₊, primePowerError n :=
      Finset.sum_le_sum_of_subset_of_nonneg hS (fun n _ _ => primePowerError_nonneg n)
    _ = Chebyshev.psi X - Chebyshev.theta X := by
      rw [Chebyshev.psi_sub_theta_eq_sum_not_prime, Finset.sum_filter]
      apply Finset.sum_congr rfl
      intro n _
      by_cases hn : n.Prime <;> simp [primePowerError, hn]
    _ ≤ _ := Chebyshev.psi_sub_theta_le hX

/--
The discrepancy of the nonprime prime-power contribution in the residue class `a` modulo `q`
within `S`, relative to its coprime mass divided by `φ(q)`.
-/
noncomputable def primePowerDiscrepancy (S : Finset ℕ) (q a : ℕ) : ℝ :=
  (∑ n ∈ S.filter (fun n => Nat.ModEq q n a), primePowerError n) -
    (∑ n ∈ S.filter (fun n => Nat.Coprime n q), primePowerError n) / (q.totient : ℝ)

theorem primePowerDiscrepancy_le (S : Finset ℕ) (X : ℝ) (hX : 1 ≤ X)
    (hS : S ⊆ Finset.Ioc 0 ⌊X⌋₊) (q a : ℕ) [NeZero q] (hsq : Squarefree q) :
    |primePowerDiscrepancy S q a| ≤
      (q.divisors.card : ℝ) * (3 * Real.sqrt X / (q : ℝ) + 1) * Real.log X +
        2 * X ^ (1 / 3 : ℝ) * Real.log X := by
  classical
  have hq : (0 : ℝ) < q := by exact_mod_cast Nat.pos_of_ne_zero (NeZero.ne q)
  have hφ : 0 < (q.totient : ℝ) :=
    Nat.cast_pos.mpr (Nat.totient_pos.mpr (Nat.pos_of_ne_zero (NeZero.ne q)))
  have hlog : 0 ≤ Real.log X := Real.log_nonneg hX
  have hAP := primePowerError_progression_le X hX q a hsq
  have hAP' : (∑ n ∈ S.filter (fun n => Nat.ModEq q n a), primePowerError n) ≤
      (q.divisors.card : ℝ) * (Real.sqrt X / (q : ℝ) + 1) * Real.log X +
        2 * X ^ (1 / 3 : ℝ) * Real.log X := by
    refine (Finset.sum_le_sum_of_subset_of_nonneg
      (Finset.filter_subset_filter _ hS) (fun n _ _ => primePowerError_nonneg n)).trans hAP
  have hred := sum_primePowerError_le (S.filter (fun n => Nat.Coprime n q)) X hX
    ((Finset.filter_subset _ _).trans hS)
  have hrecip : (q.totient : ℝ)⁻¹ ≤ (q.divisors.card : ℝ) / (q : ℝ) := by
    apply (le_div_iff₀ hq).mpr
    simpa only [div_eq_mul_inv, mul_comm] using
      div_totient_le_card_divisors q
  calc
    _ ≤ (∑ n ∈ S.filter (fun n => Nat.ModEq q n a), primePowerError n) +
        (∑ n ∈ S.filter (fun n => Nat.Coprime n q), primePowerError n) /
          (q.totient : ℝ) := by
      unfold primePowerDiscrepancy
      refine (abs_sub _ _).trans_eq ?_
      rw [abs_of_nonneg (Finset.sum_nonneg fun n _ => primePowerError_nonneg n),
        abs_of_nonneg (div_nonneg
          (Finset.sum_nonneg fun n _ => primePowerError_nonneg n) hφ.le)]
    _ ≤ ((q.divisors.card : ℝ) * (Real.sqrt X / (q : ℝ) + 1) * Real.log X +
        2 * X ^ (1 / 3 : ℝ) * Real.log X) +
          (2 * Real.sqrt X * Real.log X) * ((q.divisors.card : ℝ) / (q : ℝ)) := by
      apply add_le_add hAP'
      rw [div_eq_mul_inv]
      exact mul_le_mul hred hrecip (inv_nonneg.mpr hφ.le) (by positivity)
    _ = _ := by ring

theorem sum_squarefree_primePowerDiscrepancy_le
    (J Q : ℕ) (hQ : 0 < Q) (S : Finset ℕ) (X : ℝ) (hX : 1 ≤ X)
    (hS : S ⊆ Finset.Ioc 0 ⌊X⌋₊) (a : ℕ → ℕ) :
    (∑ q ∈ (Finset.Icc 1 Q).filter Squarefree,
      (q.divisors.card : ℝ) ^ J * |primePowerDiscrepancy S q (a q)|) ≤
      (3 * Real.sqrt X + (Q : ℝ) + 2 * (Q : ℝ) * X ^ (1 / 3 : ℝ)) *
        Real.log X * (1 + Real.log (Q : ℝ)) ^ (2 ^ (J + 1)) := by
  classical
  let L : ℝ := 1 + Real.log (Q : ℝ)
  let B : ℕ := 2 ^ (J + 1)
  have hL : 1 ≤ L :=
    le_add_of_nonneg_right (Real.log_nonneg (Nat.one_le_cast.mpr hQ))
  have hlog : 0 ≤ Real.log X := Real.log_nonneg hX
  have hweights (j : ℕ) (hj : j ≤ J + 1) :
      (∑ q ∈ Finset.Icc 1 Q, (q.divisors.card : ℝ) ^ j) ≤ (Q : ℝ) * L ^ B := by
    refine (sum_card_divisors_pow_le_mul_log_pow j Q).trans ?_
    apply mul_le_mul_of_nonneg_left _ (Nat.cast_nonneg Q)
    apply pow_le_pow_right₀ hL
    exact (Nat.sub_le _ _).trans (Nat.pow_le_pow_right (by omega) hj)
  have hrecip := sum_card_divisors_pow_div_le_log_pow (J + 1) Q
  calc
    _ ≤ ∑ q ∈ (Finset.Icc 1 Q).filter Squarefree,
        (3 * Real.sqrt X * Real.log X * ((q.divisors.card : ℝ) ^ (J + 1) / q) +
          Real.log X * (q.divisors.card : ℝ) ^ (J + 1) +
          (2 * X ^ (1 / 3 : ℝ) * Real.log X) * (q.divisors.card : ℝ) ^ J) := by
      apply Finset.sum_le_sum
      intro q hq
      have hqpos : 0 < q := (Finset.mem_Icc.mp (Finset.mem_filter.mp hq).1).1
      let : NeZero q := ⟨hqpos.ne'⟩
      refine (mul_le_mul_of_nonneg_left
        (primePowerDiscrepancy_le S X hX hS q (a q) (Finset.mem_filter.mp hq).2)
        (pow_nonneg (Nat.cast_nonneg _) J)).trans_eq ?_
      rw [pow_succ]
      ring
    _ ≤ ∑ q ∈ Finset.Icc 1 Q,
        (3 * Real.sqrt X * Real.log X * ((q.divisors.card : ℝ) ^ (J + 1) / q) +
          Real.log X * (q.divisors.card : ℝ) ^ (J + 1) +
          (2 * X ^ (1 / 3 : ℝ) * Real.log X) * (q.divisors.card : ℝ) ^ J) :=
      Finset.sum_le_sum_of_subset_of_nonneg (Finset.filter_subset _ _)
        (fun q _ _ => by positivity)
    _ = (3 * Real.sqrt X * Real.log X) *
          (∑ q ∈ Finset.Icc 1 Q, (q.divisors.card : ℝ) ^ (J + 1) / q) +
        Real.log X * (∑ q ∈ Finset.Icc 1 Q, (q.divisors.card : ℝ) ^ (J + 1)) +
        (2 * X ^ (1 / 3 : ℝ) * Real.log X) *
          (∑ q ∈ Finset.Icc 1 Q, (q.divisors.card : ℝ) ^ J) := by
      simp only [Finset.sum_add_distrib, Finset.mul_sum]
    _ ≤ (3 * Real.sqrt X * Real.log X) * L ^ B +
        Real.log X * ((Q : ℝ) * L ^ B) +
        (2 * X ^ (1 / 3 : ℝ) * Real.log X) * ((Q : ℝ) * L ^ B) := by
      gcongr
      · exact hweights (J + 1) le_rfl
      · exact hweights J (Nat.le_succ J)
    _ = _ := by ring

theorem squarefree_primePower_correction_uniform_log_saving
    (θ : ℝ) (hθ : θ < 2 / 3) (J : ℕ) (A : ℝ) :
    ∀ ε : ℝ, 0 < ε → ∀ᶠ x : ℝ in Filter.atTop,
      ∀ (Q : ℕ) (S : Finset ℕ) (a : ℕ → ℕ),
        (Q : ℝ) ≤ x ^ θ → S ⊆ Finset.Ioc 0 ⌊2 * x⌋₊ →
        (Real.log x) ^ A / x *
          (∑ q ∈ (Finset.Icc 1 Q).filter Squarefree,
            (q.divisors.card : ℝ) ^ J * |primePowerDiscrepancy S q (a q)|) ≤ ε := by
  intro ε hε
  let B : ℕ := 2 ^ (J + 1)
  let b : ℝ := max (1 / 2) (θ + 1 / 3)
  let c : ℝ := 22 * (2 : ℝ) ^ B
  have hb : b < 1 := max_lt (by norm_num) (by linarith)
  have hc : 0 < c := by positivity
  have hsmall := (isLittleO_log_rpow_rpow_atTop
    (A + (B : ℝ) + 1) (sub_pos.mpr hb)).def (div_pos hε hc)
  filter_upwards [hsmall, Filter.eventually_ge_atTop (Real.exp 1)] with x hxsmall hx
  intro Q S a hQ hS
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
  have hxone : 1 ≤ x := (Real.one_le_exp_iff.mpr zero_le_one).trans hx
  have hℓ : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxpos).mpr hx
  have hℓpos : 0 < Real.log x := zero_lt_one.trans_le hℓ
  by_cases hQzero : Q = 0
  · simp [hQzero, hε.le]
  have hQpos : 0 < Q := Nat.pos_of_ne_zero hQzero
  have hQx : (Q : ℝ) ≤ x := hQ.trans
    (Real.rpow_le_self_of_one_le hxone (by linarith))
  have hLQ : 1 + Real.log (Q : ℝ) ≤ 2 * Real.log x := by
    have hlogQ := Real.log_le_log (Nat.cast_pos.mpr hQpos) hQx
    linarith
  have hlog2x : Real.log (2 * x) ≤ 2 * Real.log x := by
    rw [Real.log_mul two_ne_zero hxpos.ne']
    have hlog2 := Real.log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2)
    linarith
  have hlog2x0 : 0 ≤ Real.log (2 * x) := Real.log_nonneg (by linarith)
  have hhalf : x ^ (1 / 2 : ℝ) ≤ x ^ b :=
    Real.rpow_le_rpow_of_exponent_le hxone (le_max_left _ _)
  have hthird : x ^ (θ + 1 / 3) ≤ x ^ b :=
    Real.rpow_le_rpow_of_exponent_le hxone (le_max_right _ _)
  have hQb : (Q : ℝ) ≤ x ^ b := hQ.trans
    (Real.rpow_le_rpow_of_exponent_le hxone (by dsimp [b]; exact le_max_of_le_right (by linarith)))
  have hsqrt : Real.sqrt (2 * x) ≤ 2 * x ^ b := by
    rw [Real.sqrt_eq_rpow, Real.mul_rpow (by norm_num) hxpos.le]
    exact mul_le_mul (Real.rpow_le_self_of_one_le (by norm_num) (by norm_num))
      hhalf (Real.rpow_nonneg hxpos.le _) (by norm_num)
  have hcube : (Q : ℝ) * (2 * x) ^ (1 / 3 : ℝ) ≤ 2 * x ^ b := by
    calc
      _ ≤ x ^ θ * ((2 : ℝ) ^ (1 / 3 : ℝ) * x ^ (1 / 3 : ℝ)) := by
        rw [← Real.mul_rpow (by norm_num) hxpos.le]
        exact mul_le_mul_of_nonneg_right hQ (Real.rpow_nonneg (by positivity) _)
      _ ≤ x ^ θ * (2 * x ^ (1 / 3 : ℝ)) := by
        gcongr
        exact Real.rpow_le_self_of_one_le (by norm_num) (by norm_num)
      _ = 2 * x ^ (θ + 1 / 3) := by rw [Real.rpow_add hxpos]; ring
      _ ≤ 2 * x ^ b := mul_le_mul_of_nonneg_left hthird zero_le_two
  have hpoly : 3 * Real.sqrt (2 * x) + (Q : ℝ) +
      2 * (Q : ℝ) * (2 * x) ^ (1 / 3 : ℝ) ≤ 11 * x ^ b := by
    nlinarith only [hsqrt, hQb, hcube]
  have hbound := sum_squarefree_primePowerDiscrepancy_le J Q hQpos S (2 * x)
    (by linarith) hS a
  have hbound' : (∑ q ∈ (Finset.Icc 1 Q).filter Squarefree,
      (q.divisors.card : ℝ) ^ J * |primePowerDiscrepancy S q (a q)|) ≤
      c * x ^ b * (Real.log x) ^ (B + 1) := by
    refine hbound.trans ?_
    calc
      _ ≤ (11 * x ^ b) * (2 * Real.log x) * (2 * Real.log x) ^ B := by
        gcongr
      _ = _ := by dsimp only [c]; rw [mul_pow, pow_succ]; ring
  have hs : (Real.log x) ^ (A + (B : ℝ) + 1) ≤
      (ε / c) * x ^ (1 - b) := by
    simpa only [Real.norm_of_nonneg (Real.rpow_nonneg hℓpos.le _),
      Real.norm_of_nonneg (Real.rpow_nonneg hxpos.le _)] using hxsmall
  have hscale : (Real.log x) ^ A / x *
      (c * x ^ b * (Real.log x) ^ (B + 1)) =
      c * (Real.log x) ^ (A + (B : ℝ) + 1) / x ^ (1 - b) := by
    rw [show A + (B : ℝ) + 1 = A + ((B + 1 : ℕ) : ℝ) by push_cast; ring,
      Real.rpow_add_natCast hℓpos.ne', Real.rpow_sub hxpos, Real.rpow_one]
    field_simp
  refine (mul_le_mul_of_nonneg_left hbound' (by positivity)).trans ?_
  rw [hscale]
  apply (div_le_iff₀ (Real.rpow_pos_of_pos hxpos (1 - b))).mpr
  calc
    _ ≤ c * ((ε / c) * x ^ (1 - b)) := mul_le_mul_of_nonneg_left hs hc.le
    _ = _ := by field_simp

theorem fullDiscrepancy_primePowerError_eq (S : Finset ℕ) (q a : ℕ) :
    fullDiscrepancy
      (∑ n ∈ S, Finsupp.single n (primePowerError n : ℂ)) q a =
        (primePowerDiscrepancy S q a : ℂ) := by
  classical
  have hsum (P : ℕ → Prop) [DecidablePred P] :
      (∑ n ∈ (∑ m ∈ S, Finsupp.single m (primePowerError m : ℂ)).support,
        if P n then (∑ m ∈ S, Finsupp.single m (primePowerError m : ℂ)) n else 0) =
      ∑ n ∈ S, if P n then (primePowerError n : ℂ) else 0 := by
    change (∑ m ∈ S, Finsupp.single m (primePowerError m : ℂ)).sum
      (fun n z => if P n then z else 0) = _
    rw [← Finsupp.indicator_eq_sum_single]
    exact Finsupp.sum_indicator_index _ (fun n _ => by simp)
  simp only [fullDiscrepancy,
    progressionMass, reducedMass, hsum]
  simp only [primePowerDiscrepancy, Finset.sum_filter, Complex.ofReal_sub,
    Complex.ofReal_div, Complex.ofReal_sum, Complex.ofReal_natCast,
    apply_ite Complex.ofReal, Complex.ofReal_zero, Nat.ModEq]
  congr 1
  exact (Finset.sum_filter (fun n : ℕ => n % q = a % q)
    (fun n => (primePowerError n : ℂ))).symm

theorem squarefree_vonMangoldt_sub_prime_log_uniform_log_saving
    (θ : ℝ) (hθ : θ < 2 / 3) (J : ℕ) (A : ℝ) :
    ∀ ε : ℝ, 0 < ε → ∀ᶠ x : ℝ in Filter.atTop,
      ∀ (Q : ℕ) (S : Finset ℕ) (a : ℕ → ℕ),
        (Q : ℝ) ≤ x ^ θ → S ⊆ Finset.Ioc 0 ⌊2 * x⌋₊ →
        (Real.log x) ^ A / x *
          (∑ q ∈ (Finset.Icc 1 Q).filter Squarefree,
            (q.divisors.card : ℝ) ^ J *
              ‖fullDiscrepancy
                (∑ n ∈ S, Finsupp.single n
                  ((ArithmeticFunction.vonMangoldt n -
                    (if n.Prime then Real.log (n : ℝ) else 0) : ℝ) : ℂ)) q (a q)‖) ≤ ε := by
  intro ε hε
  filter_upwards [squarefree_primePower_correction_uniform_log_saving θ hθ J A ε hε]
    with x hx
  intro Q S a hQ hS
  simpa only [← primePowerError_eq, fullDiscrepancy_primePowerError_eq,
    Complex.norm_real, Real.norm_eq_abs] using hx Q S a hQ hS

theorem sum_norm_prime_interval_le_of_joint_log_prefix_bound
    {ι : Type*} [Fintype ι] (c : ι → ℕ → ℂ)
    (L N : ℕ) (hL : 2 ≤ L) (B : ℝ)
    (hprefix : ∀ k : ℕ, k ≤ N →
      (∑ q : ι, ‖∑ n ∈ Finset.range k,
        if (L + n).Prime then (Real.log (L + n : ℕ) : ℂ) * c q (L + n)
        else 0‖) ≤ B) :
    (∑ q : ι, ‖∑ n ∈ Finset.range N,
      if (L + n).Prime then c q (L + n) else 0‖) ≤ B / Real.log (L : ℝ) := by
  classical
  let E := PiLp 1 (fun _ : ι => ℂ)
  let Z : ℕ → E := fun n => WithLp.toLp 1 (fun q : ι =>
    if (L + n).Prime then (Real.log (L + n : ℕ) : ℂ) * c q (L + n) else 0)
  let w : ℕ → ℝ := fun n => (Real.log (L + n : ℕ))⁻¹
  have hlog (n : ℕ) : 0 < Real.log (L + n : ℕ) :=
    Real.log_pos (by exact_mod_cast (show 1 < L + n by omega))
  have hw (n : ℕ) : 0 ≤ w n := inv_nonneg.mpr (hlog n).le
  have hmono (n : ℕ) : w (n + 1) ≤ w n := by
    apply inv_anti₀ (hlog n)
    apply Real.log_le_log
    · exact_mod_cast (show 0 < L + n by omega)
    · exact_mod_cast (show L + n ≤ L + (n + 1) by omega)
  have hsum (k : ℕ) (q : ι) :
      (∑ n ∈ Finset.range k, Z n) q =
        ∑ n ∈ Finset.range k,
          if (L + n).Prime then (Real.log (L + n : ℕ) : ℂ) * c q (L + n)
          else 0 :=
    map_sum (PiLp.projₗ (p := 1) (𝕜 := ℝ) (β := fun _ : ι => ℂ) q)
      Z (Finset.range k)
  have hbound (k : ℕ) (hk : k ≤ N) : ‖∑ n ∈ Finset.range k, Z n‖ ≤ B := by
    rw [PiLp.norm_eq_of_L1]
    simp_rw [hsum]
    exact hprefix k hk
  have hB : 0 ≤ B := by simpa using hprefix 0 (Nat.zero_le N)
  by_cases hN : N = 0
  · subst N
    simpa using div_nonneg hB (by simpa using (hlog 0).le)
  have hdiff (n : ℕ) : ‖w (n + 1) - w n‖ = w n - w (n + 1) := by
    rw [Real.norm_eq_abs, abs_of_nonpos (sub_nonpos.mpr (hmono n))]
    ring
  have hvariation :
      ‖w (N - 1)‖ + ∑ n ∈ Finset.range (N - 1), ‖w (n + 1) - w n‖ = w 0 := by
    rw [Real.norm_eq_abs, abs_of_nonneg (hw (N - 1))]
    simp_rw [hdiff]
    rw [Finset.sum_range_sub']
    ring
  let P : E := WithLp.toLp 1 (fun q : ι =>
    ∑ n ∈ Finset.range N, if (L + n).Prime then c q (L + n) else 0)
  have hweighted : (∑ n ∈ Finset.range N, w n • Z n) = P := by
    apply PiLp.ext
    intro q
    calc
      (∑ n ∈ Finset.range N, w n • Z n) q =
          ∑ n ∈ Finset.range N, (w n • Z n) q :=
        map_sum (PiLp.projₗ (p := 1) (𝕜 := ℝ) (β := fun _ : ι => ℂ) q)
          (fun n => w n • Z n) (Finset.range N)
      _ = P q := by
        apply Finset.sum_congr rfl
        intro n hn
        change w n • (if (L + n).Prime then
          (Real.log (L + n : ℕ) : ℂ) * c q (L + n) else 0) =
            if (L + n).Prime then c q (L + n) else 0
        split_ifs
        · change (Real.log (L + n : ℕ))⁻¹ •
            ((Real.log (L + n : ℕ) : ℂ) * c q (L + n)) = c q (L + n)
          rw [Complex.real_smul, Complex.ofReal_inv,
            inv_mul_cancel_left₀ (Complex.ofReal_ne_zero.mpr (hlog n).ne')]
        · exact smul_zero _
  have hparts := norm_sum_range_smul_le_of_partial_sum_bound
    w Z N B hbound
  rw [hweighted, hvariation, PiLp.norm_eq_of_L1] at hparts
  simpa only [P, PiLp.toLp_apply, w, Nat.add_zero, div_eq_mul_inv] using hparts

theorem denseDivisibility_mono_scale
    {r N : ℕ} {Y Z : Set.Ici (1 : ℝ)}
    (hYZ : (Y : ℝ) ≤ (Z : ℝ))
    (hN : Nonempty (DenseDivisibilityWitness Y r N)) :
    Nonempty (DenseDivisibilityWitness Z r N) := by
  induction r using Nat.strong_induction_on generalizing N Y Z with
  | h r ih =>
    cases r with
    | zero => exact ⟨.zero (denseDivisibility_pos hN)⟩
    | succ r =>
      have hYpos : 0 < (Y : ℝ) := zero_lt_one.trans_le Y.property
      have hNpos : 0 < N := denseDivisibility_pos hN
      apply denseDivisibility_succ_of_small_targets hNpos
      · intro s hsr
        exact ih s (by omega) hYZ (denseDivisibility_mono_order hN (by omega))
      · intro j k hjk X hX hXN
        have hXY : X ≤ (Y : ℝ) * N :=
          hXN.trans (le_mul_of_one_le_left (Nat.cast_nonneg N) Y.property)
        obtain ⟨u, v, huv, hu, hv, hlo, hhi⟩ :=
          (denseDivisibility_succ_iff.mp hN).2 j k hjk X hX hXY
        refine ⟨u, v, huv, ih j (by omega) hYZ hu, ih k (by omega) hYZ hv, ?_, hhi⟩
        exact (div_le_div_of_nonneg_left (zero_le_one.trans hX) hYpos hYZ).trans hlo

theorem denseDivisibility_presieve_lcm {r D E W : ℕ} {Y : Set.Ici (1 : ℝ)}
    (h : Nonempty (DenseDivisibilityWitness Y r (D.lcm E)))
    (hW : 0 < W) (hWY : (W : ℝ) ≤ Y)
    (hDW : D.Coprime W) (hEW : E.Coprime W) :
    Nonempty (DenseDivisibilityWitness Y r (W.lcm (D.lcm E))) := by
  have hcop : W.Coprime (D.lcm E) :=
    (hDW.symm.mul_right hEW.symm).coprime_dvd_right (Nat.lcm_dvd_mul D E)
  rw [hcop.lcm_eq_mul, Nat.mul_comm]
  exact denseDivisibility_mul_insert h hW (Or.inl hWY)

theorem fullDiscrepancy_eq_finsupp_sum (f : ℕ →₀ ℂ) (q a : ℕ) :
    fullDiscrepancy f q a =
      f.sum (fun n z =>
        (if n % q = a % q then z else 0) -
          (if Nat.Coprime n q then z else 0) / (q.totient : ℂ)) := by
  unfold fullDiscrepancy progressionMass reducedMass Finsupp.sum
  rw [Finset.sum_sub_distrib, Finset.sum_div]

open Classical in
theorem fullDiscrepancy_sample (S : Finset ℕ) (f : ℕ → ℂ) (q a : ℕ) :
    fullDiscrepancy (∑ n ∈ S, Finsupp.single n (f n)) q a =
      ∑ n ∈ S,
        ((if n % q = a % q then f n else 0) -
          (if Nat.Coprime n q then f n else 0) / (q.totient : ℂ)) := by
  rw [fullDiscrepancy_eq_finsupp_sum, ← Finsupp.indicator_eq_sum_single]
  exact Finsupp.sum_indicator_index _ (fun n _ => by simp)

open Classical in
theorem sum_weighted_prime_interval_discrepancy_le_of_log_prefix
    (Q : Finset ℕ) (J : ℕ) (a : ℕ → ℕ) (L N : ℕ) (hL : 2 ≤ L) (B : ℝ)
    (hprefix : ∀ k : ℕ, k ≤ N →
      (∑ q ∈ Q, (q.divisors.card : ℝ) ^ J *
        ‖fullDiscrepancy
          (∑ n ∈ Finset.Ico L (L + k),
            Finsupp.single n
              (if n.Prime then (Real.log (n : ℝ) : ℂ) else 0)) q (a q)‖) ≤ B) :
    (∑ q ∈ Q, (q.divisors.card : ℝ) ^ J *
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Ico L (L + N),
          Finsupp.single n (if n.Prime then (1 : ℂ) else 0)) q (a q)‖) ≤
      B / Real.log (L : ℝ) := by
  let d (q n : ℕ) : ℂ :=
    (if n % q = a q % q then 1 else 0) -
      (if Nat.Coprime n q then 1 else 0) / (q.totient : ℂ)
  let c (q : Q) (n : ℕ) : ℂ := (q.val.divisors.card : ℂ) ^ J * d q.val n
  have hsample (q k : ℕ) (v : ℕ → ℂ) :
      (∑ n ∈ Finset.range k, d q (L + n) * v (L + n)) =
        fullDiscrepancy
          (∑ n ∈ Finset.Ico L (L + k), Finsupp.single n (v n)) q (a q) := by
    rw [fullDiscrepancy_sample, Finset.sum_Ico_eq_sum_range]
    simp only [Nat.add_sub_cancel_left, d, sub_mul, div_mul_eq_mul_div,
      ite_mul, one_mul, zero_mul]
  have hnorm (k : ℕ) (v : ℕ → ℂ) :
      (∑ q : Q, ‖∑ n ∈ Finset.range k, c q (L + n) * v (L + n)‖) =
        ∑ q ∈ Q, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy
            (∑ n ∈ Finset.Ico L (L + k), Finsupp.single n (v n)) q (a q)‖ := by
    have hq (q : Q) :
        ‖∑ n ∈ Finset.range k, c q (L + n) * v (L + n)‖ =
          (q.val.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy
              (∑ n ∈ Finset.Ico L (L + k), Finsupp.single n (v n)) q.val (a q.val)‖ := by
      simp only [c, mul_assoc, ← Finset.mul_sum]
      rw [hsample, norm_mul, norm_pow, Complex.norm_natCast]
    simp_rw [hq]
    rw [Finset.sum_coe_sort_eq_attach]
    exact Finset.sum_attach Q (fun q : ℕ => (q.divisors.card : ℝ) ^ J *
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Ico L (L + k), Finsupp.single n (v n)) q (a q)‖)
  have hlog (k : ℕ) :
      (∑ q : Q, ‖∑ n ∈ Finset.range k,
        if (L + n).Prime then (Real.log (L + n : ℕ) : ℂ) * c q (L + n)
        else 0‖) =
        ∑ q ∈ Q, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy
            (∑ n ∈ Finset.Ico L (L + k),
              Finsupp.single n (if n.Prime then (Real.log (n : ℝ) : ℂ) else 0))
            q (a q)‖ := by
    rw [← hnorm k (fun n => if n.Prime then (Real.log (n : ℝ) : ℂ) else 0)]
    simp only [mul_ite, mul_comm, zero_mul]
  have hprime :
      (∑ q : Q, ‖∑ n ∈ Finset.range N, if (L + n).Prime then c q (L + n) else 0‖) =
        ∑ q ∈ Q, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy
            (∑ n ∈ Finset.Ico L (L + N),
              Finsupp.single n (if n.Prime then (1 : ℂ) else 0)) q (a q)‖ := by
    rw [← hnorm N (fun n => if n.Prime then (1 : ℂ) else 0)]
    simp only [mul_ite, mul_one, mul_zero]
  rw [← hprime]
  apply sum_norm_prime_interval_le_of_joint_log_prefix_bound c L N hL B
  intro k hk
  rw [hlog]
  exact hprefix k hk

theorem finiteConvolution_support_and_divisor_bound
    (α β : ℕ →₀ ℂ) (x M N c C W : ℝ) (k : ℕ)
    (hx : 1 ≤ x) (hM : 0 < M) (hN : 0 < N) (hc : 0 < c)
    (hC : 1 ≤ C) (hW : 0 ≤ W) (hMN : M * N ≤ C * x)
    (hαsupport : ∀ m ∈ α.support, c * M ≤ (m : ℝ) ∧ (m : ℝ) ≤ C * M)
    (hβsupport : ∀ n ∈ β.support, c * N ≤ (n : ℝ) ∧ (n : ℝ) ≤ C * N)
    (hαbound : ∀ n ∈ α.support,
      ‖α n‖ ≤ W * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ k)
    (hβbound : ∀ n ∈ β.support,
      ‖β n‖ ≤ W * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ k) :
    (∀ n ∈ (finiteConvolution α β).support, 0 < n ∧ (n : ℝ) ≤ C ^ 3 * x) ∧
      ∀ n : ℕ, ‖finiteConvolution α β n‖ ≤
        W ^ 2 * (n.divisors.card : ℝ) ^ (2 * k + 1) * (Real.log x) ^ (2 * k) := by
  classical
  have hC0 : 0 ≤ C := zero_le_one.trans hC
  have hlog : 0 ≤ Real.log x := Real.log_nonneg hx
  have hαpos (m : ℕ) (hm : m ∈ α.support) : 0 < m := by
    exact_mod_cast (mul_pos hc hM).trans_le (hαsupport m hm).1
  have hβpos (n : ℕ) (hn : n ∈ β.support) : 0 < n := by
    exact_mod_cast (mul_pos hc hN).trans_le (hβsupport n hn).1
  have hsupport : ∀ n ∈ (finiteConvolution α β).support,
      0 < n ∧ (n : ℝ) ≤ C ^ 3 * x := by
    intro n hn
    have hprod := MonoidAlgebra.support_coeff_mul_subset
      (MonoidAlgebra.ofCoeff α : MonoidAlgebra ℂ ℕ)
      (MonoidAlgebra.ofCoeff β : MonoidAlgebra ℂ ℕ) hn
    obtain ⟨m, hm, l, hl, rfl⟩ := Finset.mem_mul.mp hprod
    refine ⟨Nat.mul_pos (hαpos m hm) (hβpos l hl), ?_⟩
    calc
      ((m * l : ℕ) : ℝ) = (m : ℝ) * (l : ℝ) := by rw [Nat.cast_mul]
      _ ≤ (C * M) * (C * N) :=
        mul_le_mul (hαsupport m hm).2 (hβsupport l hl).2
          (Nat.cast_nonneg l) (mul_nonneg hC0 hM.le)
      _ = C ^ 2 * (M * N) := by ring
      _ ≤ C ^ 2 * (C * x) := mul_le_mul_of_nonneg_left hMN (sq_nonneg C)
      _ = C ^ 3 * x := by ring
  have hαzero : α 0 = 0 := Finsupp.notMem_support_iff.mp (by
    intro h
    exact (Nat.lt_irrefl 0) (hαpos 0 h))
  have hβzero : β 0 = 0 := Finsupp.notMem_support_iff.mp (by
    intro h
    exact (Nat.lt_irrefl 0) (hβpos 0 h))
  let f : ArithmeticFunction ℂ := ⟨α, hαzero⟩
  let g : ArithmeticFunction ℂ := ⟨β, hβzero⟩
  have heq (n : ℕ) : finiteConvolution α β n = (f * g) n := by
    by_cases hn : n = 0
    · subst n
      have hzero : finiteConvolution α β 0 = 0 := Finsupp.notMem_support_iff.mp (by
        intro h
        exact (Nat.lt_irrefl 0) (hsupport 0 h).1)
      simpa only [ArithmeticFunction.map_zero] using hzero
    · have h := MonoidAlgebra.coeff_mul_antidiag
        (MonoidAlgebra.ofCoeff α : MonoidAlgebra ℂ ℕ)
        (MonoidAlgebra.ofCoeff β : MonoidAlgebra ℂ ℕ)
        n n.divisorsAntidiagonal (fun {p} => by
          rw [Nat.mem_divisorsAntidiagonal]
          exact and_iff_left hn)
      rw [ArithmeticFunction.mul_apply]
      exact h
  have hf (n : ℕ) : ‖f n‖ ≤
      W * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ k := by
    change ‖α n‖ ≤ _
    by_cases hn : n ∈ α.support
    · exact hαbound n hn
    · rw [Finsupp.notMem_support_iff.mp hn, norm_zero]
      positivity
  have hg (n : ℕ) : ‖g n‖ ≤
      W * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ k := by
    change ‖β n‖ ≤ _
    by_cases hn : n ∈ β.support
    · exact hβbound n hn
    · rw [Finsupp.notMem_support_iff.mp hn, norm_zero]
      positivity
  refine ⟨hsupport, fun n => ?_⟩
  rw [heq]
  simpa only [pow_two, two_mul] using
    convolution_growth_bound f g hW hW hlog k k k k hf hg n

section
open scoped ContDiff

theorem exists_rough_lower_order_factorization
    (j : ℕ) (hj : j = 1 ∨ j = 2) (Y Z : Set.Ici (1 : ℝ))
    (B n : ℕ) (T : ℝ) (hT : 1 ≤ T) (hTn : T ≤ (n : ℝ))
    (hn : Squarefree n) (hdense : Nonempty (DenseDivisibilityWitness Y j n))
    (hsmall : (smallPrimePart B n : ℝ) ≤ (Z : ℝ)) :
    ∃ q r : ℕ, n = q * r ∧ 0 < q ∧ 0 < r ∧ Nat.Coprime q r ∧
      T / (Y : ℝ) ≤ (r : ℝ) ∧ (r : ℝ) ≤ T * (Z : ℝ) ∧
      (∀ p ∈ q.primeFactors, B < p) ∧
      Nonempty (DenseDivisibilityWitness (inflatedScale Y Z) (j - 1) q) ∧
      Nonempty (DenseDivisibilityWitness Y 1 (q * r)) := by
  classical
  have hjpos : 0 < j := by rcases hj with rfl | rfl <;> norm_num
  have hYpos : 0 < (Y : ℝ) := zero_lt_one.trans_le Y.property
  have hTpos : 0 < T := zero_lt_one.trans_le hT
  have hTlarge : T ≤ (Y : ℝ) * (n : ℝ) :=
    hTn.trans (by
      simpa only [one_mul] using
        mul_le_mul_of_nonneg_right (show (1 : ℝ) ≤ (Y : ℝ) from Y.property)
          (Nat.cast_nonneg n))
  have hsucc : Nonempty (DenseDivisibilityWitness Y ((j - 1) + 1) n) := by
    simpa only [Nat.sub_add_cancel hjpos] using hdense
  obtain ⟨q₀, r₀, hprod₀, hqdense₀, hrdense₀, hrlo, hrhi⟩ :=
    (denseDivisibility_succ_iff.mp hsucc).2 (j - 1) 0 (by omega) T hT hTlarge
  have hq₀pos : 0 < q₀ := denseDivisibility_pos hqdense₀
  have hr₀pos : 0 < r₀ := denseDivisibility_pos hrdense₀
  have hq₀dvd : q₀ ∣ n := ⟨r₀, hprod₀⟩
  have hq₀sf : Squarefree q₀ := hn.squarefree_of_dvd hq₀dvd
  let s := smallPrimePart B n
  let g := q₀.gcd s
  let q := q₀ / g
  let r := r₀ * g
  have hspos : 0 < s :=
    Finset.prod_pos fun p hp =>
      Nat.pos_of_mem_primeFactors (Finset.mem_filter.mp hp).1
  have hgpos : 0 < g := Nat.gcd_pos_of_pos_left s hq₀pos
  have hqpos : 0 < q := Nat.div_gcd_pos_of_pos_left s hq₀pos
  have hrpos : 0 < r := Nat.mul_pos hr₀pos hgpos
  have hqg : q * g = q₀ := Nat.div_mul_cancel (Nat.gcd_dvd_left q₀ s)
  have hprod : n = q * r := by
    calc
      n = q₀ * r₀ := hprod₀
      _ = (q * g) * r₀ := by rw [hqg]
      _ = q * r := by dsimp only [r]; ac_rfl
  have hsFactors : s.primeFactors = n.primeFactors.filter (fun p => p ≤ B) :=
    Nat.primeFactors_prod fun p hp =>
      Nat.prime_of_mem_primeFactors (Finset.mem_filter.mp hp).1
  have hqFactors : q.primeFactors = q₀.primeFactors \ s.primeFactors :=
    Nat.primeFactors_div_gcd hq₀sf hspos.ne'
  have hrough : ∀ p ∈ q.primeFactors, B < p := by
    intro p hp
    rw [hqFactors] at hp
    obtain ⟨hpq₀, hpnotS⟩ := Finset.mem_sdiff.mp hp
    have hpn : p ∈ n.primeFactors :=
      Nat.primeFactors_mono hq₀dvd hn.ne_zero hpq₀
    by_contra hnot
    exact hpnotS (by
      rw [hsFactors]
      exact Finset.mem_filter.mpr ⟨hpn, Nat.le_of_not_gt hnot⟩)
  have hgOne : (1 : ℝ) ≤ (g : ℝ) := by exact_mod_cast hgpos
  have hgSmall : (g : ℝ) ≤ (Z : ℝ) := by
    exact (show (g : ℝ) ≤ (s : ℝ) by exact_mod_cast Nat.gcd_le_right q₀ hspos).trans
      hsmall
  have hscale : (g : ℝ) * (Y : ℝ) ≤ (inflatedScale Y Z : ℝ) := by
    change (g : ℝ) * (Y : ℝ) ≤ (Y : ℝ) * (Z : ℝ)
    simpa only [mul_comm] using mul_le_mul_of_nonneg_right hgSmall hYpos.le
  have hqdense : Nonempty (DenseDivisibilityWitness (inflatedScale Y Z) (j - 1) q) := by
    rcases hj with rfl | rfl
    · exact ⟨.zero hqpos⟩
    · exact single_dense_div hqdense₀ hgpos (Nat.gcd_dvd_left q₀ s) hscale
  have hrLower : T / (Y : ℝ) ≤ (r : ℝ) := by
    calc
      T / (Y : ℝ) ≤ (r₀ : ℝ) := hrlo
      _ ≤ (r₀ : ℝ) * (g : ℝ) := by
        simpa only [mul_one] using
          mul_le_mul_of_nonneg_left hgOne (Nat.cast_nonneg r₀)
      _ = (r : ℝ) := by simp only [r, Nat.cast_mul]
  have hrUpper : (r : ℝ) ≤ T * (Z : ℝ) := by
    calc
      (r : ℝ) = (r₀ : ℝ) * (g : ℝ) := by simp only [r, Nat.cast_mul]
      _ ≤ T * (g : ℝ) := mul_le_mul_of_nonneg_right hrhi (Nat.cast_nonneg g)
      _ ≤ T * (Z : ℝ) := mul_le_mul_of_nonneg_left hgSmall hTpos.le
  refine ⟨q, r, hprod, hqpos, hrpos,
    Nat.coprime_of_squarefree_mul (hprod ▸ hn), hrLower, hrUpper, hrough, hqdense, ?_⟩
  rw [← hprod]
  exact denseDivisibility_mono_order hdense hjpos

theorem select_rough_lower_order_factor_family
    (j : ℕ) (hj : j = 1 ∨ j = 2) (Y Z : Set.Ici (1 : ℝ))
    (B : ℕ) (T : ℝ) (hT : 1 ≤ T) (E : Finset ℕ)
    (hE : ∀ n ∈ E, Squarefree n ∧ T ≤ (n : ℝ) ∧
      Nonempty (DenseDivisibilityWitness Y j n) ∧
      (smallPrimePart B n : ℝ) ≤ (Z : ℝ)) :
    ∃ S : Finset (ℕ × ℕ),
      (∀ F : ℕ → ℝ, (∑ n ∈ E, F n) = ∑ p ∈ S, F (p.1 * p.2)) ∧
      Set.InjOn (fun p : ℕ × ℕ => p.1 * p.2) S ∧
      ∀ p ∈ S, p.1 * p.2 ∈ E ∧ 0 < p.1 ∧ 0 < p.2 ∧ Nat.Coprime p.1 p.2 ∧
        T / (Y : ℝ) ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ T * (Z : ℝ) ∧
        (∀ t ∈ p.1.primeFactors, B < t) ∧
        Nonempty (DenseDivisibilityWitness (inflatedScale Y Z) (j - 1) p.1) ∧
        Nonempty (DenseDivisibilityWitness Y 1 (p.1 * p.2)) := by
  classical
  have hex : ∀ n : ℕ, ∃ q r : ℕ, n ∈ E → n = q * r ∧
      0 < q ∧ 0 < r ∧ Nat.Coprime q r ∧
      T / (Y : ℝ) ≤ (r : ℝ) ∧ (r : ℝ) ≤ T * (Z : ℝ) ∧
      (∀ p ∈ q.primeFactors, B < p) ∧
      Nonempty (DenseDivisibilityWitness (inflatedScale Y Z) (j - 1) q) ∧
      Nonempty (DenseDivisibilityWitness Y 1 (q * r)) := by
    intro n
    by_cases hn : n ∈ E
    · obtain ⟨hnSq, hTn, hdn, hsmall⟩ := hE n hn
      obtain ⟨q, r, hqr⟩ :=
        exists_rough_lower_order_factorization j hj Y Z B n T hT hTn hnSq hdn hsmall
      exact ⟨q, r, fun _ => hqr⟩
    · exact ⟨0, 0, fun h => (hn h).elim⟩
  choose q r hqr using hex
  let pick : ℕ → ℕ × ℕ := fun n => (q n, r n)
  have hinj : Set.InjOn pick E := by
    intro n hn m hm hnm
    exact (hqr n hn).1.trans
      ((congrArg (fun p : ℕ × ℕ => p.1 * p.2) hnm).trans (hqr m hm).1.symm)
  refine ⟨E.image pick, ?_, ?_, ?_⟩
  · intro F
    rw [Finset.sum_image hinj]
    apply Finset.sum_congr rfl
    intro n hn
    exact congrArg F (hqr n hn).1
  · intro p hp p' hp' heq
    obtain ⟨n, hn, rfl⟩ := Finset.mem_image.mp hp
    obtain ⟨m, hm, rfl⟩ := Finset.mem_image.mp hp'
    exact congrArg pick ((hqr n hn).1.trans (heq.trans (hqr m hm).1.symm))
  · intro p hp
    obtain ⟨n, hn, rfl⟩ := Finset.mem_image.mp hp
    refine ⟨?_, (hqr n hn).2⟩
    simpa only [pick, ← (hqr n hn).1] using hn

theorem lower_order_parameter_retreat
    (j : ℕ) («ω» δ σ : ℝ) (hω : 0 < «ω») (hδ : 0 < δ)
    (hI : (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1))
    (hII : 68 * «ω» + 14 * δ < 1) :
    ∃ ω' δ' c ρ : ℝ,
      «ω» < ω' ∧ δ < δ' ∧ 0 < c ∧ 0 < ρ ∧
      100 * ρ < c ∧ δ + 100 * ρ < δ' ∧
      ((j = 1 ∧ 54 * ω' + 15 * δ' + 5 * σ + 10000 * ρ < 1) ∨
        (j = 2 ∧ 56 * ω' + 16 * δ' + 4 * σ + 10000 * ρ < 1)) ∧
      68 * ω' + 14 * δ' + 100 * c + 10000 * ρ < 1 ∧
      σ < 1 / 4 ∧
      0 < 1 / 2 - 2 * σ - 2 * ω' - δ' - 100 * ρ ∧
      0 < 1 - 2 * σ - 3 * δ' - 100 * ρ ∧
      ((68 * ω' + 14 * δ' - 1) / 4 + 5 * c / 2 + 25 * ρ / 2 < -10 * ρ) ∧
      ((20 * ω' + 6 * δ' - 1) / 2 + c + 11 * ρ < -10 * ρ) ∧
      ((16 * ω' + 6 * δ' + 2 * σ - 1) / 2 + 11 * ρ < -10 * ρ) ∧
      (j = 1 → (54 * ω' + 15 * δ' + 5 * σ - 1) / 6 + 9 * ρ < -10 * ρ) ∧
      (j = 2 → (56 * ω' + 16 * δ' + 4 * σ - 1) / 6 + 19 * ρ / 2 < -10 * ρ) := by
  let μ : ℝ := if j = 1 then 1 - 54 * «ω» - 15 * δ - 5 * σ
    else 1 - 56 * «ω» - 16 * δ - 4 * σ
  have hμ : 0 < μ := by
    rcases hI with ⟨rfl, h⟩ | ⟨rfl, h⟩ <;> norm_num [μ] <;> linarith
  let e : ℝ := min «ω» (min δ (min μ (1 - 68 * «ω» - 14 * δ))) / 1000000
  have he : 0 < e := by
    dsimp only [e]
    exact div_pos (lt_min hω (lt_min hδ (lt_min hμ (by linarith)))) (by norm_num)
  have heμ : 1000000 * e ≤ μ := by
    have h : min «ω» (min δ (min μ (1 - 68 * «ω» - 14 * δ))) ≤ μ :=
      (min_le_right «ω» _).trans
      ((min_le_right δ _).trans (min_le_left μ _))
    dsimp only [e]
    linarith
  have heII : 1000000 * e ≤ 1 - 68 * «ω» - 14 * δ := by
    have h : min «ω» (min δ (min μ (1 - 68 * «ω» - 14 * δ))) ≤
        1 - 68 * «ω» - 14 * δ := (min_le_right «ω» _).trans
      ((min_le_right δ _).trans (min_le_right μ _))
    dsimp only [e]
    linarith
  let ω' := «ω» + e
  let δ' := δ + e
  let c := e
  let ρ := e / 1000
  have hω' : 0 < ω' := add_pos hω he
  have hδ' : 0 < δ' := add_pos hδ he
  have hc : 0 < c := he
  have hρ : 0 < ρ := div_pos he (by norm_num)
  have hI' : (j = 1 ∧ 54 * ω' + 15 * δ' + 5 * σ + 10000 * ρ < 1) ∨
      (j = 2 ∧ 56 * ω' + 16 * δ' + 4 * σ + 10000 * ρ < 1) := by
    rcases hI with ⟨rfl, h⟩ | ⟨rfl, h⟩
    · refine Or.inl ⟨rfl, ?_⟩
      norm_num [μ] at heμ
      dsimp only [ω', δ', ρ]
      linarith
    · refine Or.inr ⟨rfl, ?_⟩
      norm_num [μ] at heμ
      dsimp only [ω', δ', ρ]
      linarith
  have hII' : 68 * ω' + 14 * δ' + 100 * c + 10000 * ρ < 1 := by
    dsimp only [ω', δ', c, ρ]
    linarith
  have hσquarter : σ < 1 / 4 := by
    rcases hI' with ⟨_, h⟩ | ⟨_, h⟩ <;> linarith
  have hlength : 0 < 1 / 2 - 2 * σ - 2 * ω' - δ' - 100 * ρ := by
    rcases hI' with ⟨_, h⟩ | ⟨_, h⟩ <;> linarith
  have hcube : 0 < 1 - 2 * σ - 3 * δ' - 100 * ρ := by
    rcases hI' with ⟨_, h⟩ | ⟨_, h⟩ <;> linarith
  have hsecondary : (16 * ω' + 6 * δ' + 2 * σ - 1) / 2 + 11 * ρ < -10 * ρ := by
    rcases hI' with ⟨_, h⟩ | ⟨_, h⟩ <;> linarith
  refine ⟨ω', δ', c, ρ, by dsimp only [ω']; linarith,
    by dsimp only [δ']; linarith, hc, hρ,
    by dsimp only [ρ, c]; linarith,
    by dsimp only [ρ, δ']; linarith,
    hI', hII', hσquarter, hlength, hcube, by linarith, by linarith, hsecondary, ?_, ?_⟩
  · intro hj
    rcases hI' with ⟨_, h⟩ | ⟨hj', _⟩
    · linarith
    · omega
  · intro hj
    rcases hI' with ⟨hj', _⟩ | ⟨_, h⟩
    · omega
    · linarith

theorem lower_order_cost_exponents
    («ω» δ σ c ρ m γ r q : ℝ) (hρ : 0 ≤ ρ)
    (hMN : 1 - ρ ≤ m + γ) (hN : 1 / 2 - σ ≤ γ) (hNhi : γ ≤ 1 / 2)
    (hRlo : γ - δ - 6 * ρ ≤ r) (hRhi : r ≤ γ - 4 * ρ)
    (hRQ : r + q ≤ 1 / 2 + 2 * «ω» + ρ) :
    let h : ℝ := ρ + r + 2 * q - m
    (2 * h + q / 2 + r / 6 + δ / 6 - γ / 2 ≤
      (54 * «ω» + 15 * δ + 5 * σ - 1) / 6 + 100 * ρ) ∧
    (13 * h / 6 + q / 3 + r / 6 + δ / 3 + ρ / 3 - γ / 2 ≤
      (56 * «ω» + 16 * δ + 4 * σ - 1) / 6 + 100 * ρ) ∧
    (2 * h - r ≤ (16 * «ω» + 6 * δ + 2 * σ - 1) / 2 + 100 * ρ) ∧
    (h - 2 * q ≤ -2 * ρ) ∧
    (γ ≤ 1 / 2 - 2 * «ω» - c → h - q ≤ -c + 3 * ρ) ∧
    (1 / 2 - 2 * «ω» - c ≤ γ →
      (2 * h + 2 * q + r / 2 - γ ≤
        (68 * «ω» + 14 * δ - 1) / 4 + 5 * c / 2 + 100 * ρ) ∧
      (2 * h - r ≤ (20 * «ω» + 6 * δ - 1) / 2 + c + 100 * ρ)) := by
  dsimp only
  refine ⟨by linarith, by linarith, by linarith, by linarith, ?_, ?_⟩
  · intro hγ
    linarith
  · intro hγ
    exact ⟨by linarith, by linarith⟩

theorem lower_order_normalized_cost_bounds
    (x M N R Q H «ω» δ σ c ρ : ℝ)
    (hx : 1 < x) (hM : 0 < M) (hN : 0 < N) (hR : 0 < R) (hQ : 0 < Q)
    (hH : 0 ≤ H) (hρ : 0 ≤ ρ)
    (hMN : x ^ (1 - ρ) ≤ M * N)
    (hNlo : x ^ (1 / 2 - σ) ≤ N) (hNhi : N ≤ x ^ (1 / 2 : ℝ))
    (hRlo : x ^ (-δ - 6 * ρ) * N ≤ R)
    (hRhi : R ≤ x ^ (-4 * ρ) * N)
    (hRQ : R * Q ≤ x ^ (1 / 2 + 2 * «ω» + ρ))
    (hHscale : H ≤ x ^ ρ * R * Q ^ 2 / M) :
    H ^ 2 * Real.sqrt Q * R ^ (1 / 6 : ℝ) * x ^ (δ / 6) / Real.sqrt N ≤
        x ^ ((54 * «ω» + 15 * δ + 5 * σ - 1) / 6 + 100 * ρ) ∧
    H ^ (13 / 6 : ℝ) * Q ^ (1 / 3 : ℝ) * R ^ (1 / 6 : ℝ) *
        x ^ (δ / 3 + ρ / 3) / Real.sqrt N ≤
      x ^ ((56 * «ω» + 16 * δ + 4 * σ - 1) / 6 + 100 * ρ) ∧
    H ^ 2 / R ≤ x ^ ((16 * «ω» + 6 * δ + 2 * σ - 1) / 2 + 100 * ρ) ∧
    H / Q ^ 2 ≤ x ^ (-2 * ρ) ∧
    (N ≤ x ^ (1 / 2 - 2 * «ω» - c) → H / Q ≤ x ^ (-c + 3 * ρ)) ∧
    (x ^ (1 / 2 - 2 * «ω» - c) ≤ N →
      H ^ 2 * Q ^ 2 * Real.sqrt R / N ≤
          x ^ ((68 * «ω» + 14 * δ - 1) / 4 + 5 * c / 2 + 100 * ρ) ∧
        H ^ 2 / R ≤ x ^ ((20 * «ω» + 6 * δ - 1) / 2 + c + 100 * ρ)) := by
  have hx0 : 0 < x := zero_lt_one.trans hx
  let m := Real.logb x M
  let γ := Real.logb x N
  let r := Real.logb x R
  let q := Real.logb x Q
  let h : ℝ := ρ + r + 2 * q - m
  have hMeq : x ^ m = M := Real.rpow_logb hx0 hx.ne' hM
  have hNeq : x ^ γ = N := Real.rpow_logb hx0 hx.ne' hN
  have hReq : x ^ r = R := Real.rpow_logb hx0 hx.ne' hR
  have hQeq : x ^ q = Q := Real.rpow_logb hx0 hx.ne' hQ
  have hMNexp : 1 - ρ ≤ m + γ := by
    apply (Real.rpow_le_rpow_left_iff hx).mp
    simpa only [Real.rpow_add hx0, hMeq, hNeq] using hMN
  have hNexp : 1 / 2 - σ ≤ γ := by
    apply (Real.rpow_le_rpow_left_iff hx).mp
    simpa only [hNeq] using hNlo
  have hNexpHi : γ ≤ 1 / 2 := by
    apply (Real.rpow_le_rpow_left_iff hx).mp
    simpa only [hNeq] using hNhi
  have hRexpLo : γ - δ - 6 * ρ ≤ r := by
    apply (Real.rpow_le_rpow_left_iff hx).mp
    calc
      x ^ (γ - δ - 6 * ρ) = x ^ (-δ - 6 * ρ) * N := by
        rw [← hNeq, ← Real.rpow_add hx0]
        congr 1
        ring
      _ ≤ x ^ r := by simpa only [hReq] using hRlo
  have hRexpHi : r ≤ γ - 4 * ρ := by
    apply (Real.rpow_le_rpow_left_iff hx).mp
    calc
      x ^ r ≤ x ^ (-4 * ρ) * N := by simpa only [hReq] using hRhi
      _ = x ^ (γ - 4 * ρ) := by
        rw [← hNeq, ← Real.rpow_add hx0]
        congr 1
        ring
  have hRQexp : r + q ≤ 1 / 2 + 2 * «ω» + ρ := by
    apply (Real.rpow_le_rpow_left_iff hx).mp
    simpa only [Real.rpow_add hx0, hReq, hQeq] using hRQ
  obtain ⟨heI, heII, hesecond, hecollision, heIcollision, heTypeII⟩ :=
    lower_order_cost_exponents «ω» δ σ c ρ m γ r q hρ
      hMNexp hNexp hNexpHi hRexpLo hRexpHi hRQexp
  have hHpow : H ≤ x ^ h := by
    calc
      H ≤ x ^ ρ * R * Q ^ 2 / M := hHscale
      _ = x ^ h := by
        rw [← hMeq, ← hReq, ← hQeq, ← Real.rpow_mul_natCast hx0.le,
          ← Real.rpow_add hx0, ← Real.rpow_add hx0, ← Real.rpow_sub hx0]
        congr 1
        dsimp only [h]
        norm_num
        ring
  have hsquare : H ^ 2 ≤ (x ^ h) ^ 2 := pow_le_pow_left₀ hH hHpow 2
  have hmainI :
      H ^ 2 * Real.sqrt Q * R ^ (1 / 6 : ℝ) * x ^ (δ / 6) / Real.sqrt N ≤
        x ^ (2 * h + q / 2 + r / 6 + δ / 6 - γ / 2) := by
    calc
      _ ≤ (x ^ h) ^ 2 * Real.sqrt Q * R ^ (1 / 6 : ℝ) *
          x ^ (δ / 6) / Real.sqrt N := by gcongr
      _ = _ := by
        rw [← hQeq, ← hReq, ← hNeq]
        simp only [Real.sqrt_eq_rpow, ← Real.rpow_mul hx0.le,
          ← Real.rpow_mul_natCast hx0.le, ← Real.rpow_add hx0,
          ← Real.rpow_sub hx0]
        congr 1
        norm_num
        ring
  have hmainII :
      H ^ (13 / 6 : ℝ) * Q ^ (1 / 3 : ℝ) * R ^ (1 / 6 : ℝ) *
          x ^ (δ / 3 + ρ / 3) / Real.sqrt N ≤
        x ^ (13 * h / 6 + q / 3 + r / 6 + δ / 3 + ρ / 3 - γ / 2) := by
    calc
      _ ≤ (x ^ h) ^ (13 / 6 : ℝ) * Q ^ (1 / 3 : ℝ) * R ^ (1 / 6 : ℝ) *
          x ^ (δ / 3 + ρ / 3) / Real.sqrt N := by gcongr
      _ = _ := by
        rw [← hQeq, ← hReq, ← hNeq]
        simp only [Real.sqrt_eq_rpow, ← Real.rpow_mul hx0.le,
          ← Real.rpow_add hx0, ← Real.rpow_sub hx0]
        congr 1
        ring
  have hsecond : H ^ 2 / R ≤ x ^ (2 * h - r) := by
    calc
      H ^ 2 / R ≤ (x ^ h) ^ 2 / R := div_le_div_of_nonneg_right hsquare hR.le
      _ = x ^ (2 * h - r) := by
        rw [← hReq, ← Real.rpow_mul_natCast hx0.le, ← Real.rpow_sub hx0]
        congr 1
        norm_num
        ring
  have hcollision : H / Q ^ 2 ≤ x ^ (h - 2 * q) := by
    calc
      H / Q ^ 2 ≤ x ^ h / Q ^ 2 := div_le_div_of_nonneg_right hHpow (sq_nonneg Q)
      _ = x ^ (h - 2 * q) := by
        rw [← hQeq, ← Real.rpow_mul_natCast hx0.le, ← Real.rpow_sub hx0]
        congr 1
        norm_num
        ring
  refine ⟨hmainI.trans (Real.rpow_le_rpow_of_exponent_le hx.le heI),
    hmainII.trans (Real.rpow_le_rpow_of_exponent_le hx.le heII),
    hsecond.trans (Real.rpow_le_rpow_of_exponent_le hx.le hesecond),
    hcollision.trans (Real.rpow_le_rpow_of_exponent_le hx.le hecollision), ?_, ?_⟩
  · intro hNI
    have hγ : γ ≤ 1 / 2 - 2 * «ω» - c := by
      apply (Real.rpow_le_rpow_left_iff hx).mp
      simpa only [hNeq] using hNI
    calc
      H / Q ≤ x ^ h / Q := div_le_div_of_nonneg_right hHpow hQ.le
      _ = x ^ (h - q) := by
        rw [← hQeq]
        exact (Real.rpow_sub hx0 h q).symm
      _ ≤ x ^ (-c + 3 * ρ) := Real.rpow_le_rpow_of_exponent_le hx.le (heIcollision hγ)
  · intro hNII
    have hγ : 1 / 2 - 2 * «ω» - c ≤ γ := by
      apply (Real.rpow_le_rpow_left_iff hx).mp
      simpa only [hNeq] using hNII
    obtain ⟨hlead, hsecondary⟩ := heTypeII hγ
    refine ⟨?_, hsecond.trans (Real.rpow_le_rpow_of_exponent_le hx.le hsecondary)⟩
    calc
      H ^ 2 * Q ^ 2 * Real.sqrt R / N ≤ (x ^ h) ^ 2 * Q ^ 2 * Real.sqrt R / N := by
        gcongr
      _ = x ^ (2 * h + 2 * q + r / 2 - γ) := by
        rw [← hQeq, ← hReq, ← hNeq]
        simp only [Real.sqrt_eq_rpow, ← Real.rpow_mul hx0.le,
          ← Real.rpow_mul_natCast hx0.le, ← Real.rpow_add hx0,
          ← Real.rpow_sub hx0]
        congr 1
        norm_num
        ring
      _ ≤ _ := Real.rpow_le_rpow_of_exponent_le hx.le hlead

open Classical in
theorem sourceTypeII_coefficient_cauchy
    (𝒜 : Finset (ℕ × ℕ × ℕ)) (β : ℤ →₀ ℂ) (s : Finset ℤ)
    (c : ℕ × ℕ → ℂ) (q₀ a b₁ b₂ : ℕ) [NeZero q₀]
    (ℓ : ℤ) (J : Finset ℤ) (ψM χ : ℝ → ℝ) (M N R Q : ℝ)
    (hM : 0 < M) (hR : 0 < R) (hQ : 0 < Q)
    (hβs : β.support ⊆ s) (hχnonneg : ∀ n ∈ s, 0 ≤ χ ((n : ℝ) / N))
    (hχmajor : ∀ n ∈ β.support, 1 ≤ χ ((n : ℝ) / N))
    (h𝒜 : ∀ t ∈ 𝒜,
      0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2 ∧ R ≤ (t.1 : ℝ) ∧
      Q ≤ ((q₀ * t.2.1 : ℕ) : ℝ) ∧ Q ≤ ((q₀ * t.2.2 : ℕ) : ℝ))
    (hc : ∀ t ∈ 𝒜,
      ‖c (q₀ * t.2.1, t.1)‖ ≤ 1 ∧ ‖c (q₀ * t.2.2, t.1)‖ ≤ 1) :
    let P : (ℕ × ℕ × ℕ) → ℕ := fun t => t.1 * q₀ * t.2.1 * t.2.2
    let F : (ℕ × ℕ × ℕ) → ℤ → ℂ := fun t n =>
      if Int.gcd n (t.2.1 : ℤ) = 1 ∧
      Int.gcd (n + ℓ * (t.1 : ℤ)) (t.2.2 : ℤ) = 1 then
        ∑ h ∈ J, sourcePhi ψM M (P t) h *
          sourceTheta t.1 q₀ 1 t.2.1 t.2.2 a b₁ b₂ ℓ n h
      else 0
    let B : Finset (ℕ) := 𝒜.image (fun t => t.1)
    let Γ : ℝ := ∑ r ∈ B, ∑ n ∈ β.support.filter (fun n =>
      Int.gcd n ((r * q₀ : ℕ) : ℤ) = 1 ∧
      Int.gcd (n + ℓ * (r : ℤ)) (q₀ : ℤ) = 1 ∧
      sourceCompatibility r q₀ b₁ b₂ ℓ n = 1),
        ‖β n * star (β (n + ℓ * (r : ℤ)))‖ ^ 2
    (∑ t ∈ 𝒜,
      ‖c (q₀ * t.2.1, t.1) * star (c (q₀ * t.2.2, t.1)) *
        ((M : ℂ) / (P t : ℂ)) *
          ∑ n ∈ β.support.filter (fun n =>
            Int.gcd n ((t.1 * q₀ * t.2.1 : ℕ) : ℤ) = 1 ∧
            Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2 : ℕ) : ℤ) = 1),
            β n * star (β (n + ℓ * (t.1 : ℤ))) *
              (sourceCompatibility t.1 q₀ b₁ b₂ ℓ n : ℂ) *
                ∑ h ∈ J, sourcePhi ψM M (P t) h *
                  sourceTheta t.1 q₀ 1 t.2.1 t.2.2 a b₁ b₂ ℓ n h‖) ^ 2 ≤
      (M * (q₀ : ℝ) / (R * Q ^ 2)) ^ 2 * Γ *
        (∑ t₁ ∈ 𝒜, ∑ t₂ ∈ 𝒜.filter (fun t₂ => t₂.1 = t₁.1),
          ‖∑ n ∈ s.filter (fun n =>
              Int.gcd n ((t₁.1 * q₀ : ℕ) : ℤ) = 1 ∧
              Int.gcd (n + ℓ * (t₁.1 : ℤ)) (q₀ : ℤ) = 1 ∧
              sourceCompatibility t₁.1 q₀ b₁ b₂ ℓ n = 1),
            (χ ((n : ℝ) / N) : ℂ) * F t₁ n * star (F t₂ n)‖) := by
  intro P F B Γ
  let base : (ℕ × ℕ × ℕ) → ℕ := fun t => t.1
  let p : (ℕ) → ℤ → Prop := fun r n =>
    Int.gcd n ((r * q₀ : ℕ) : ℤ) = 1 ∧
      Int.gcd (n + ℓ * (r : ℤ)) (q₀ : ℤ) = 1 ∧
      sourceCompatibility r q₀ b₁ b₂ ℓ n = 1
  let pair : (ℕ) → ℤ → ℂ := fun r n =>
    β n * star (β (n + ℓ * (r : ℤ)))
  let d : (ℕ × ℕ × ℕ) → ℂ := fun t =>
    c (q₀ * t.2.1, t.1) * star (c (q₀ * t.2.2, t.1)) *
      ((M : ℂ) / (P t : ℂ))
  let K : ℝ := M * (q₀ : ℝ) / (R * Q ^ 2)
  have hcompat (r : ℕ) (n : ℤ) :
      sourceCompatibility r q₀ b₁ b₂ ℓ n = 0 ∨
        sourceCompatibility r q₀ b₁ b₂ ℓ n = 1 :=
    Or.symm (ite_eq_or_eq _ _ _)
  have hguard (t : ℕ × ℕ × ℕ) (n : ℤ) :
      (Int.gcd n ((t.1 * q₀ * t.2.1 : ℕ) : ℤ) = 1 ∧
        Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2 : ℕ) : ℤ) = 1) ↔
      (Int.gcd n ((t.1 * q₀ : ℕ) : ℤ) = 1 ∧
        Int.gcd (n + ℓ * (t.1 : ℤ)) (q₀ : ℤ) = 1) ∧
        (Int.gcd n (t.2.1 : ℤ) = 1 ∧
        Int.gcd (n + ℓ * (t.1 : ℤ)) (t.2.2 : ℤ) = 1) := by
    simp only [← Int.isCoprime_iff_gcd_eq_one, Nat.cast_mul,
      IsCoprime.mul_right_iff]
    tauto
  have hinner (t : ℕ × ℕ × ℕ) :
      (∑ n ∈ β.support.filter (fun n =>
        Int.gcd n ((t.1 * q₀ * t.2.1 : ℕ) : ℤ) = 1 ∧
        Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2 : ℕ) : ℤ) = 1),
        β n * star (β (n + ℓ * (t.1 : ℤ))) *
          (sourceCompatibility t.1 q₀ b₁ b₂ ℓ n : ℂ) *
            ∑ h ∈ J, sourcePhi ψM M (P t) h *
              sourceTheta t.1 q₀ 1 t.2.1 t.2.2 a b₁ b₂ ℓ n h) =
      ∑ n ∈ s.filter (p (base t)), pair (base t) n * F t n := by
    calc
      _ = ∑ n ∈ β.support.filter (p (base t)), pair (base t) n * F t n := by
        simp only [Finset.sum_filter]
        apply Finset.sum_congr rfl
        intro n _
        simp only [hguard]
        rcases hcompat t.1 n with hC | hC
        · simp [p, base, hC]
        · by_cases hr : Int.gcd n (t.2.1 : ℤ) = 1 ∧
        Int.gcd (n + ℓ * (t.1 : ℤ)) (t.2.2 : ℤ) = 1
          · simp [p, pair, F, base, hC, hr]
          · simp [p, F, base, hC, hr]
      _ = _ := by
        simpa only [Finsupp.sum, Finset.sum_filter, pair, base] using
          β.sum_of_support_subset hβs
            (fun n z => if p (base t) n then
              z * star (β (n + ℓ * (t.1 : ℤ))) * F t n else 0)
            (fun n _ => by simp)
  have henergy :
      (∑ r ∈ 𝒜.image base, ∑ n ∈ s.filter (p r), ‖pair r n‖ ^ 2) = Γ := by
    change (∑ r ∈ 𝒜.image base, ∑ n ∈ s.filter (p r), ‖pair r n‖ ^ 2) =
      ∑ r ∈ 𝒜.image base, ∑ n ∈ β.support.filter (p r), ‖pair r n‖ ^ 2
    apply Finset.sum_congr rfl
    intro r _
    symm
    simpa only [Finsupp.sum, Finset.sum_filter, pair] using
      β.sum_of_support_subset hβs
        (fun n z => if p r n then
          ‖z * star (β (n + ℓ * (r : ℤ)))‖ ^ 2 else 0)
        (fun n _ => by simp)
  have hq₀ : 0 < q₀ := NeZero.pos q₀
  have hd (t : ℕ × ℕ × ℕ) (ht : t ∈ 𝒜) : ‖d t‖ ≤ K := by
    rcases h𝒜 t ht with ⟨hr, hq₁, hq₂, hRr, hQ₁, hQ₂⟩
    have hP : 0 < (P t : ℝ) := by positivity
    have hqq : Q ^ 2 ≤ ((q₀ * t.2.1 : ℕ) : ℝ) *
        ((q₀ * t.2.2 : ℕ) : ℝ) := by
      simpa only [pow_two] using
        mul_le_mul hQ₁ hQ₂ hQ.le (hQ.le.trans hQ₁)
    have hden : R * Q ^ 2 ≤ (P t : ℝ) * (q₀ : ℝ) := by
      simpa only [P, Nat.cast_mul, mul_assoc, mul_left_comm, mul_comm] using
        mul_le_mul hRr hqq (sq_nonneg _) (Nat.cast_nonneg _)
    have hscale : M / (P t : ℝ) ≤ K := by
      apply (div_le_div_iff₀ hP (mul_pos hR (pow_pos hQ 2))).mpr
      simpa only [mul_assoc, mul_left_comm, mul_comm] using
        mul_le_mul_of_nonneg_left hden hM.le
    calc
      ‖d t‖ ≤ M / (P t : ℝ) := by
        dsimp only [d]
        simp only [norm_mul, norm_star, norm_div,
          Complex.norm_of_nonneg hM.le, Complex.norm_natCast]
        exact mul_le_of_le_one_left (div_nonneg hM.le hP.le)
          ((mul_le_of_le_one_left (norm_nonneg _) (hc t ht).1).trans (hc t ht).2)
      _ ≤ K := hscale
  have himage :
      @Finset.image _ _ (fun x y => Classical.propDecidable (x = y)) base 𝒜 =
        𝒜.image base := by congr 1; apply Subsingleton.elim
  have hbound := sourceAssembly_grouped_coefficient_cauchy
    𝒜 s base p d pair F (fun n => χ ((n : ℝ) / N)) K
    (by positivity) hd hχnonneg
    (fun _ _ n _ _ hp =>
      hχmajor n (Finsupp.mem_support_iff.mpr (left_ne_zero_of_mul hp)))
  simp_rw [himage,
    fun r => Finset.filter_congr_decidable s (p r) (fun _ => Classical.propDecidable _),
    fun t => Finset.filter_congr_decidable 𝒜 (fun u => base u = base t)
      (fun _ => Classical.propDecidable _)] at hbound
  rw [henergy] at hbound
  simpa only [d, K, ← hinner, base, p] using hbound

open Classical in
theorem sourceTypeIOne_coefficient_cauchy
    (𝒜 : Finset (ℕ × ℕ × ℕ)) (β : ℤ →₀ ℂ) (s : Finset ℤ)
    (c : ℕ × ℕ → ℂ) (q₀ a b₁ b₂ : ℕ) [NeZero q₀]
    (ℓ : ℤ) (J : Finset ℤ) (ψM χ : ℝ → ℝ) (M N R Q : ℝ)
    (hM : 0 < M) (hR : 0 < R) (hQ : 0 < Q)
    (hβs : β.support ⊆ s) (hχnonneg : ∀ n ∈ s, 0 ≤ χ ((n : ℝ) / N))
    (hχmajor : ∀ n ∈ β.support, 1 ≤ χ ((n : ℝ) / N))
    (h𝒜 : ∀ t ∈ 𝒜,
      0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2 ∧ R ≤ (t.1 : ℝ) ∧
      Q ≤ ((q₀ * t.2.1 : ℕ) : ℝ) ∧ Q ≤ ((q₀ * t.2.2 : ℕ) : ℝ))
    (hc : ∀ t ∈ 𝒜,
      ‖c (q₀ * t.2.1, t.1)‖ ≤ 1 ∧ ‖c (q₀ * t.2.2, t.1)‖ ≤ 1) :
    let P : (ℕ × ℕ × ℕ) → ℕ := fun t => t.1 * q₀ * t.2.1 * t.2.2
    let F : (ℕ × ℕ × ℕ) → ℤ → ℂ := fun t n =>
      if Int.gcd (n + ℓ * (t.1 : ℤ)) (t.2.2 : ℤ) = 1 then
        ∑ h ∈ J, sourcePhi ψM M (P t) h *
          sourceTheta t.1 q₀ 1 t.2.1 t.2.2 a b₁ b₂ ℓ n h
      else 0
    let B : Finset (ℕ × ℕ) := 𝒜.image (fun t => (t.1, t.2.1))
    let Γ : ℝ := ∑ r ∈ B, ∑ n ∈ β.support.filter (fun n =>
      Int.gcd n ((r.1 * q₀ * r.2 : ℕ) : ℤ) = 1 ∧
      Int.gcd (n + ℓ * (r.1 : ℤ)) (q₀ : ℤ) = 1 ∧
      sourceCompatibility r.1 q₀ b₁ b₂ ℓ n = 1),
        ‖β n * star (β (n + ℓ * (r.1 : ℤ)))‖ ^ 2
    (∑ t ∈ 𝒜,
      ‖c (q₀ * t.2.1, t.1) * star (c (q₀ * t.2.2, t.1)) *
        ((M : ℂ) / (P t : ℂ)) *
          ∑ n ∈ β.support.filter (fun n =>
            Int.gcd n ((t.1 * q₀ * t.2.1 : ℕ) : ℤ) = 1 ∧
            Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2 : ℕ) : ℤ) = 1),
            β n * star (β (n + ℓ * (t.1 : ℤ))) *
              (sourceCompatibility t.1 q₀ b₁ b₂ ℓ n : ℂ) *
                ∑ h ∈ J, sourcePhi ψM M (P t) h *
                  sourceTheta t.1 q₀ 1 t.2.1 t.2.2 a b₁ b₂ ℓ n h‖) ^ 2 ≤
      (M * (q₀ : ℝ) / (R * Q ^ 2)) ^ 2 * Γ *
        (∑ t₁ ∈ 𝒜, ∑ t₂ ∈ 𝒜.filter (fun t₂ => t₂.1 = t₁.1 ∧ t₂.2.1 = t₁.2.1),
          ‖∑ n ∈ s.filter (fun n =>
              Int.gcd n ((t₁.1 * q₀ * t₁.2.1 : ℕ) : ℤ) = 1 ∧
              Int.gcd (n + ℓ * (t₁.1 : ℤ)) (q₀ : ℤ) = 1 ∧
              sourceCompatibility t₁.1 q₀ b₁ b₂ ℓ n = 1),
            (χ ((n : ℝ) / N) : ℂ) * F t₁ n * star (F t₂ n)‖) := by
  intro P F B Γ
  let base : (ℕ × ℕ × ℕ) → ℕ × ℕ := fun t => (t.1, t.2.1)
  let p : (ℕ × ℕ) → ℤ → Prop := fun r n =>
    Int.gcd n ((r.1 * q₀ * r.2 : ℕ) : ℤ) = 1 ∧
      Int.gcd (n + ℓ * (r.1 : ℤ)) (q₀ : ℤ) = 1 ∧
      sourceCompatibility r.1 q₀ b₁ b₂ ℓ n = 1
  let pair : (ℕ × ℕ) → ℤ → ℂ := fun r n =>
    β n * star (β (n + ℓ * (r.1 : ℤ)))
  let d : (ℕ × ℕ × ℕ) → ℂ := fun t =>
    c (q₀ * t.2.1, t.1) * star (c (q₀ * t.2.2, t.1)) *
      ((M : ℂ) / (P t : ℂ))
  let K : ℝ := M * (q₀ : ℝ) / (R * Q ^ 2)
  have hcompat (r : ℕ) (n : ℤ) :
      sourceCompatibility r q₀ b₁ b₂ ℓ n = 0 ∨
        sourceCompatibility r q₀ b₁ b₂ ℓ n = 1 :=
    Or.symm (ite_eq_or_eq _ _ _)
  have hguard (t : ℕ × ℕ × ℕ) (n : ℤ) :
      (Int.gcd n ((t.1 * q₀ * t.2.1 : ℕ) : ℤ) = 1 ∧
        Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2 : ℕ) : ℤ) = 1) ↔
      (Int.gcd n ((t.1 * q₀ * t.2.1 : ℕ) : ℤ) = 1 ∧
        Int.gcd (n + ℓ * (t.1 : ℤ)) (q₀ : ℤ) = 1) ∧
        (Int.gcd (n + ℓ * (t.1 : ℤ)) (t.2.2 : ℤ) = 1) := by
    simp only [← Int.isCoprime_iff_gcd_eq_one, Nat.cast_mul,
      IsCoprime.mul_right_iff]
    tauto
  have hinner (t : ℕ × ℕ × ℕ) :
      (∑ n ∈ β.support.filter (fun n =>
        Int.gcd n ((t.1 * q₀ * t.2.1 : ℕ) : ℤ) = 1 ∧
        Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2 : ℕ) : ℤ) = 1),
        β n * star (β (n + ℓ * (t.1 : ℤ))) *
          (sourceCompatibility t.1 q₀ b₁ b₂ ℓ n : ℂ) *
            ∑ h ∈ J, sourcePhi ψM M (P t) h *
              sourceTheta t.1 q₀ 1 t.2.1 t.2.2 a b₁ b₂ ℓ n h) =
      ∑ n ∈ s.filter (p (base t)), pair (base t) n * F t n := by
    calc
      _ = ∑ n ∈ β.support.filter (p (base t)), pair (base t) n * F t n := by
        simp only [Finset.sum_filter]
        apply Finset.sum_congr rfl
        intro n _
        simp only [hguard]
        rcases hcompat t.1 n with hC | hC
        · simp [p, base, hC]
        · by_cases hr : Int.gcd (n + ℓ * (t.1 : ℤ)) (t.2.2 : ℤ) = 1
          · simp [p, pair, F, base, hC, hr]
          · simp [p, F, base, hC, hr]
      _ = _ := by
        simpa only [Finsupp.sum, Finset.sum_filter, pair, base] using
          β.sum_of_support_subset hβs
            (fun n z => if p (base t) n then
              z * star (β (n + ℓ * (t.1 : ℤ))) * F t n else 0)
            (fun n _ => by simp)
  have henergy :
      (∑ r ∈ 𝒜.image base, ∑ n ∈ s.filter (p r), ‖pair r n‖ ^ 2) = Γ := by
    change (∑ r ∈ 𝒜.image base, ∑ n ∈ s.filter (p r), ‖pair r n‖ ^ 2) =
      ∑ r ∈ 𝒜.image base, ∑ n ∈ β.support.filter (p r), ‖pair r n‖ ^ 2
    apply Finset.sum_congr rfl
    intro r _
    symm
    simpa only [Finsupp.sum, Finset.sum_filter, pair] using
      β.sum_of_support_subset hβs
        (fun n z => if p r n then
          ‖z * star (β (n + ℓ * (r.1 : ℤ)))‖ ^ 2 else 0)
        (fun n _ => by simp)
  have hq₀ : 0 < q₀ := NeZero.pos q₀
  have hd (t : ℕ × ℕ × ℕ) (ht : t ∈ 𝒜) : ‖d t‖ ≤ K := by
    rcases h𝒜 t ht with ⟨hr, hq₁, hq₂, hRr, hQ₁, hQ₂⟩
    have hP : 0 < (P t : ℝ) := by positivity
    have hqq : Q ^ 2 ≤ ((q₀ * t.2.1 : ℕ) : ℝ) *
        ((q₀ * t.2.2 : ℕ) : ℝ) := by
      simpa only [pow_two] using
        mul_le_mul hQ₁ hQ₂ hQ.le (hQ.le.trans hQ₁)
    have hden : R * Q ^ 2 ≤ (P t : ℝ) * (q₀ : ℝ) := by
      simpa only [P, Nat.cast_mul, mul_assoc, mul_left_comm, mul_comm] using
        mul_le_mul hRr hqq (sq_nonneg _) (Nat.cast_nonneg _)
    have hscale : M / (P t : ℝ) ≤ K := by
      apply (div_le_div_iff₀ hP (mul_pos hR (pow_pos hQ 2))).mpr
      simpa only [mul_assoc, mul_left_comm, mul_comm] using
        mul_le_mul_of_nonneg_left hden hM.le
    calc
      ‖d t‖ ≤ M / (P t : ℝ) := by
        dsimp only [d]
        simp only [norm_mul, norm_star, norm_div,
          Complex.norm_of_nonneg hM.le, Complex.norm_natCast]
        exact mul_le_of_le_one_left (div_nonneg hM.le hP.le)
          ((mul_le_of_le_one_left (norm_nonneg _) (hc t ht).1).trans (hc t ht).2)
      _ ≤ K := hscale
  have himage :
      @Finset.image _ _ (fun x y => Classical.propDecidable (x = y)) base 𝒜 =
        𝒜.image base := by congr 1; apply Subsingleton.elim
  have hbound := sourceAssembly_grouped_coefficient_cauchy
    𝒜 s base p d pair F (fun n => χ ((n : ℝ) / N)) K
    (by positivity) hd hχnonneg
    (fun _ _ n _ _ hp =>
      hχmajor n (Finsupp.mem_support_iff.mpr (left_ne_zero_of_mul hp)))
  simp_rw [himage,
    fun r => Finset.filter_congr_decidable s (p r) (fun _ => Classical.propDecidable _),
    fun t => Finset.filter_congr_decidable 𝒜 (fun u => base u = base t)
      (fun _ => Classical.propDecidable _)] at hbound
  rw [henergy] at hbound
  simpa only [d, K, ← hinner, base, p, Prod.mk.injEq] using hbound

theorem signed_interval_gcd_sum_le (r L : ℕ) (hr : 0 < r) :
    (∑ n ∈ Finset.Icc (-(L : ℤ)) (L : ℤ), (Int.gcd n (r : ℤ) : ℝ)) ≤
      (r : ℝ) + 2 * (L : ℝ) * (r.divisors.card : ℝ) := by
  have heq (L : ℕ) :
      (∑ n ∈ Finset.Icc (-(L : ℤ)) (L : ℤ), (Int.gcd n (r : ℤ) : ℝ)) =
        (r : ℝ) + 2 * ∑ n ∈ Finset.Icc 1 L, (Nat.gcd r n : ℝ) := by
    induction L with
    | zero => simp
    | succ L ih =>
      have hd : Disjoint (Finset.Icc (-(L : ℤ)) (L : ℤ))
          {-(L + 1 : ℤ), (L + 1 : ℤ)} := by
        apply Finset.disjoint_left.2
        intro z hz hz'
        simp only [Finset.mem_Icc, Finset.mem_insert, Finset.mem_singleton] at hz hz'
        omega
      rw [Nat.cast_add, Nat.cast_one, Finset.Icc_succ_succ, Finset.sum_union hd,
        Finset.sum_pair (by omega : -(L + 1 : ℤ) ≠ L + 1), ih,
        Finset.sum_Icc_succ_top (by omega : 1 ≤ L + 1)]
      have hcast : (L : ℤ) + 1 = ((L + 1 : ℕ) : ℤ) := by norm_cast
      simp only [Int.neg_gcd, hcast, Int.gcd_natCast_natCast, Nat.gcd_comm]
      ring
  rw [heq]
  have h := (reciprocal_differencing_gcd_sums r L hr).1
  nlinarith

theorem signed_bounded_fiber_gcd_sum_le {α : Type*}
    (S : Finset α) (f : α → ℤ) (T D r : ℕ) (hr : 0 < r)
    (hT : ∀ a ∈ S, -(T : ℤ) ≤ f a ∧ f a ≤ T)
    (hD : ∀ w : ℤ, (S.filter (fun a => f a = w)).card ≤ D) :
    (∑ a ∈ S, ∑ b ∈ S, (Int.gcd (f a - f b) (r : ℤ) : ℝ)) ≤
      (S.card : ℝ) * D * ((r : ℝ) + 4 * T * (r.divisors.card : ℝ)) := by
  classical
  have hinner (a : α) (ha : a ∈ S) :
      (∑ b ∈ S, (Int.gcd (f a - f b) (r : ℤ) : ℝ)) ≤
        (D : ℝ) * ((r : ℝ) + 4 * T * (r.divisors.card : ℝ)) := by
    have hmap (b : α) (hb : b ∈ S) :
        f a - f b ∈ Finset.Icc (-(2 * T : ℕ) : ℤ) (2 * T : ℕ) := by
      obtain ⟨ha₀, ha₁⟩ := hT a ha
      obtain ⟨hb₀, hb₁⟩ := hT b hb
      simp only [Finset.mem_Icc, Nat.cast_mul, Nat.cast_ofNat]
      omega
    rw [← Finset.sum_fiberwise_of_maps_to' hmap (fun z => (Int.gcd z (r : ℤ) : ℝ))]
    calc
      _ ≤ ∑ z ∈ Finset.Icc (-(2 * T : ℕ) : ℤ) (2 * T : ℕ),
          (D : ℝ) * (Int.gcd z (r : ℤ) : ℝ) := by
        apply Finset.sum_le_sum
        intro z _
        have hfilter : S.filter (fun b => f a - f b = z) =
            S.filter (fun b => f b = f a - z) := by
          ext b
          simp only [Finset.mem_filter]
          constructor <;> rintro ⟨hb, h⟩ <;> exact ⟨hb, by omega⟩
        rw [Finset.sum_const, nsmul_eq_mul, hfilter]
        exact mul_le_mul_of_nonneg_right (by exact_mod_cast hD (f a - z))
          (Nat.cast_nonneg _)
      _ = (D : ℝ) * ∑ z ∈ Finset.Icc (-(2 * T : ℕ) : ℤ) (2 * T : ℕ),
          (Int.gcd z (r : ℤ) : ℝ) := by rw [Finset.mul_sum]
      _ ≤ (D : ℝ) * ((r : ℝ) + 4 * T * (r.divisors.card : ℝ)) := by
        calc
          _ ≤ (D : ℝ) * ((r : ℝ) + 2 * (2 * T : ℕ) * (r.divisors.card : ℝ)) :=
            mul_le_mul_of_nonneg_left (signed_interval_gcd_sum_le r (2 * T) hr)
              (Nat.cast_nonneg D)
          _ = _ := by push_cast; ring
  calc
    _ ≤ ∑ _a ∈ S, (D : ℝ) * ((r : ℝ) + 4 * T * (r.divisors.card : ℝ)) :=
      Finset.sum_le_sum hinner
    _ = _ := by simp [mul_assoc]

theorem signed_frequency_card (K : ℕ) :
    ((Finset.Icc (-(K : ℤ)) (K : ℤ)).filter (fun h => h ≠ 0)).card = 2 * K := by
  rw [Finset.filter_ne', Finset.card_erase_of_mem (by simp), Int.card_Icc]
  omega

theorem signed_product_fiber_card_le (K V : ℕ) (w : ℤ) :
    ((((Finset.Icc (-(K : ℤ)) (K : ℤ)).filter (fun h => h ≠ 0)).product
        (Finset.Icc 1 V)).filter (fun a => a.1 * (a.2 : ℤ) = w)).card ≤
      w.natAbs.divisors.card := by
  classical
  apply Finset.card_le_card_of_injOn Prod.snd
  · intro a ha
    obtain ⟨ha, haw⟩ := Finset.mem_filter.mp ha
    obtain ⟨ha₁, ha₂⟩ := Finset.mem_product.mp ha
    have hn := (Finset.mem_filter.mp ha₁).2
    have hv := (Finset.mem_Icc.mp ha₂).1
    have hw : w ≠ 0 := by
      rw [← haw]
      exact mul_ne_zero hn (by exact_mod_cast (show a.2 ≠ 0 by omega))
    apply Nat.mem_divisors.mpr
    refine ⟨?_, Int.natAbs_ne_zero.mpr hw⟩
    rw [← haw, Int.natAbs_mul, Int.natAbs_natCast]
    exact dvd_mul_left _ _
  · intro a ha b hb hab
    obtain ⟨ha, haw⟩ := Finset.mem_filter.mp ha
    obtain ⟨hb, hbw⟩ := Finset.mem_filter.mp hb
    have hv := (Finset.mem_Icc.mp (Finset.mem_product.mp ha).2).1
    have hav : (a.2 : ℤ) ≠ 0 := by exact_mod_cast (show a.2 ≠ 0 by omega)
    have heq : a.1 * (a.2 : ℤ) = b.1 * (a.2 : ℤ) := by
      simpa only [hab] using haw.trans hbw.symm
    exact Prod.ext (mul_right_cancel₀ hav heq) hab

theorem signed_triple_product_fiber_card_le (K V : ℕ) (w : ℤ) :
    ((((Finset.Icc (-(K : ℤ)) (K : ℤ)).filter (fun h => h ≠ 0)).product
        ((Finset.Icc 1 V).product (Finset.Icc 1 V))).filter
          (fun a => a.1 * (a.2.1 : ℤ) * (a.2.2 : ℤ) = w)).card ≤
      w.natAbs.divisors.card ^ 2 := by
  classical
  rw [pow_two, ← Finset.card_product]
  apply Finset.card_le_card_of_injOn Prod.snd
  · intro a ha
    obtain ⟨ha, haw⟩ := Finset.mem_filter.mp ha
    obtain ⟨ha₁, ha₂⟩ := Finset.mem_product.mp ha
    obtain ⟨hv₁, hv₂⟩ := Finset.mem_product.mp ha₂
    have hh := (Finset.mem_filter.mp ha₁).2
    have hn₁ := (Finset.mem_Icc.mp hv₁).1
    have hn₂ := (Finset.mem_Icc.mp hv₂).1
    have hw : w ≠ 0 := by
      rw [← haw]
      exact mul_ne_zero (mul_ne_zero hh (by exact_mod_cast (show a.2.1 ≠ 0 by omega)))
        (by exact_mod_cast (show a.2.2 ≠ 0 by omega))
    have hwa : w.natAbs ≠ 0 := Int.natAbs_ne_zero.mpr hw
    apply Finset.mem_product.mpr
    constructor
    · apply Nat.mem_divisors.mpr
      refine ⟨?_, hwa⟩
      rw [← haw, Int.natAbs_mul, Int.natAbs_mul, Int.natAbs_natCast,
        Int.natAbs_natCast]
      exact dvd_mul_of_dvd_left (dvd_mul_left _ _) _
    · apply Nat.mem_divisors.mpr
      refine ⟨?_, hwa⟩
      rw [← haw, Int.natAbs_mul, Int.natAbs_mul, Int.natAbs_natCast,
        Int.natAbs_natCast]
      exact dvd_mul_left _ _
  · intro a ha b hb hab
    obtain ⟨ha, haw⟩ := Finset.mem_filter.mp ha
    obtain ⟨hb, hbw⟩ := Finset.mem_filter.mp hb
    obtain ⟨hv₁, hv₂⟩ := Finset.mem_product.mp (Finset.mem_product.mp ha).2
    have hn₁ := (Finset.mem_Icc.mp hv₁).1
    have hn₂ := (Finset.mem_Icc.mp hv₂).1
    have hav : (a.2.1 : ℤ) * (a.2.2 : ℤ) ≠ 0 :=
      mul_ne_zero (by exact_mod_cast (show a.2.1 ≠ 0 by omega))
        (by exact_mod_cast (show a.2.2 ≠ 0 by omega))
    have heq : a.1 * ((a.2.1 : ℤ) * (a.2.2 : ℤ)) =
        b.1 * ((a.2.1 : ℤ) * (a.2.2 : ℤ)) := by
      simpa only [hab, mul_assoc] using haw.trans hbw.symm
    exact Prod.ext (mul_right_cancel₀ hav heq) hab

theorem signed_product_difference_gcd_sum_le (K V r : ℕ) (hr : 0 < r) :
    let H := (Finset.Icc (-(K : ℤ)) (K : ℤ)).filter (fun h => h ≠ 0)
    let S := H.product (Finset.Icc 1 V)
    let D := (Finset.Icc 1 (K * V)).sup (fun n => n.divisors.card)
    (∑ a ∈ S, ∑ b ∈ S,
      (Int.gcd (a.1 * (a.2 : ℤ) - b.1 * (b.2 : ℤ)) (r : ℤ) : ℝ)) ≤
        2 * K * V * D * r + 8 * (K : ℝ) ^ 2 * (V : ℝ) ^ 2 * D *
          (r.divisors.card : ℝ) := by
  classical
  dsimp only
  let H := (Finset.Icc (-(K : ℤ)) (K : ℤ)).filter (fun h => h ≠ 0)
  let S := H.product (Finset.Icc 1 V)
  let D := (Finset.Icc 1 (K * V)).sup (fun n => n.divisors.card)
  have hbounds (a : ℤ × ℕ) (ha : a ∈ S) :
      -(K * V : ℕ) ≤ a.1 * (a.2 : ℤ) ∧ a.1 * (a.2 : ℤ) ≤ (K * V : ℕ) := by
    obtain ⟨hh, hv⟩ := Finset.mem_product.mp ha
    obtain ⟨hlo, hhi⟩ := Finset.mem_Icc.mp (Finset.mem_filter.mp hh).1
    obtain ⟨hv₀, hv₁⟩ := Finset.mem_Icc.mp hv
    have hvpos : (0 : ℤ) ≤ a.2 := Nat.cast_nonneg _
    have hvupper : (a.2 : ℤ) ≤ V := by exact_mod_cast hv₁
    have hK : (0 : ℤ) ≤ K := Nat.cast_nonneg _
    push_cast
    constructor <;> nlinarith
  have hfiber (w : ℤ) : (S.filter (fun a => a.1 * (a.2 : ℤ) = w)).card ≤ D := by
    by_cases he : (S.filter (fun a => a.1 * (a.2 : ℤ) = w)).Nonempty
    · obtain ⟨a, ha⟩ := he
      obtain ⟨ha, haw⟩ := Finset.mem_filter.mp ha
      have hwbound := hbounds a ha
      rw [haw] at hwbound
      have ha₀ := (Finset.mem_filter.mp (Finset.mem_product.mp ha).1).2
      have ha₁ := (Finset.mem_Icc.mp (Finset.mem_product.mp ha).2).1
      have hwne : w ≠ 0 := by
        rw [← haw]
        exact mul_ne_zero ha₀ (by exact_mod_cast (show a.2 ≠ 0 by omega))
      have hwn : w.natAbs ∈ Finset.Icc 1 (K * V) := by
        simp only [Finset.mem_Icc]
        constructor
        · exact Int.natAbs_pos.mpr hwne
        · have hwa : (w.natAbs : ℤ) ≤ (K * V : ℕ) := by
            simpa only [Int.natCast_natAbs] using (abs_le.mpr hwbound)
          exact_mod_cast hwa
      exact (signed_product_fiber_card_le K V w).trans
        (Finset.le_sup (f := fun n => n.divisors.card) hwn)
    · simp only [Finset.not_nonempty_iff_eq_empty.mp he, Finset.card_empty, Nat.zero_le]
  have h := signed_bounded_fiber_gcd_sum_le S (fun a => a.1 * (a.2 : ℤ))
    (K * V) D r hr hbounds hfiber
  have hcard : S.card = 2 * K * V := by
    simp [S, H, Finset.card_product, signed_frequency_card, Nat.card_Icc]
  rw [hcard] at h
  push_cast at h
  convert h using 1
  dsimp [S, H, D]
  ring

theorem signed_triple_product_difference_gcd_sum_le (K V r : ℕ) (hr : 0 < r) :
    let H := (Finset.Icc (-(K : ℤ)) (K : ℤ)).filter (fun h => h ≠ 0)
    let S := H.product ((Finset.Icc 1 V).product (Finset.Icc 1 V))
    let D := (Finset.Icc 1 (K * V ^ 2)).sup (fun n => n.divisors.card)
    (∑ a ∈ S, ∑ b ∈ S,
      (Int.gcd (a.1 * (a.2.1 : ℤ) * (a.2.2 : ℤ) -
        b.1 * (b.2.1 : ℤ) * (b.2.2 : ℤ)) (r : ℤ) : ℝ)) ≤
        2 * K * (V : ℝ) ^ 2 * (D : ℝ) ^ 2 * r +
          8 * (K : ℝ) ^ 2 * (V : ℝ) ^ 4 * (D : ℝ) ^ 2 *
            (r.divisors.card : ℝ) := by
  classical
  dsimp only
  let H := (Finset.Icc (-(K : ℤ)) (K : ℤ)).filter (fun h => h ≠ 0)
  let S := H.product ((Finset.Icc 1 V).product (Finset.Icc 1 V))
  let D := (Finset.Icc 1 (K * V ^ 2)).sup (fun n => n.divisors.card)
  have hbounds (a : ℤ × (ℕ × ℕ)) (ha : a ∈ S) :
      -(K * V ^ 2 : ℕ) ≤ a.1 * (a.2.1 : ℤ) * (a.2.2 : ℤ) ∧
        a.1 * (a.2.1 : ℤ) * (a.2.2 : ℤ) ≤ (K * V ^ 2 : ℕ) := by
    obtain ⟨hh, hv⟩ := Finset.mem_product.mp ha
    obtain ⟨hlo, hhi⟩ := Finset.mem_Icc.mp (Finset.mem_filter.mp hh).1
    obtain ⟨hv₁, hv₂⟩ := Finset.mem_product.mp hv
    have hv₁' := (Finset.mem_Icc.mp hv₁).2
    have hv₂' := (Finset.mem_Icc.mp hv₂).2
    have hp : (0 : ℤ) ≤ (a.2.1 : ℤ) * (a.2.2 : ℤ) := by positivity
    have hp' : (a.2.1 : ℤ) * (a.2.2 : ℤ) ≤ (V : ℤ) ^ 2 := by
      exact_mod_cast (show a.2.1 * a.2.2 ≤ V ^ 2 by
        simpa [pow_two] using Nat.mul_le_mul hv₁' hv₂')
    have hK : (0 : ℤ) ≤ K := Nat.cast_nonneg _
    push_cast
    constructor <;> nlinarith
  have hfiber (w : ℤ) :
      (S.filter (fun a => a.1 * (a.2.1 : ℤ) * (a.2.2 : ℤ) = w)).card ≤ D ^ 2 := by
    by_cases he : (S.filter (fun a => a.1 * (a.2.1 : ℤ) * (a.2.2 : ℤ) = w)).Nonempty
    · obtain ⟨a, ha⟩ := he
      obtain ⟨ha, haw⟩ := Finset.mem_filter.mp ha
      have hwbound := hbounds a ha
      rw [haw] at hwbound
      have ha₀ := (Finset.mem_filter.mp (Finset.mem_product.mp ha).1).2
      obtain ⟨hv₁, hv₂⟩ := Finset.mem_product.mp (Finset.mem_product.mp ha).2
      have hn₁ := (Finset.mem_Icc.mp hv₁).1
      have hn₂ := (Finset.mem_Icc.mp hv₂).1
      have hwne : w ≠ 0 := by
        rw [← haw]
        exact mul_ne_zero (mul_ne_zero ha₀ (by exact_mod_cast (show a.2.1 ≠ 0 by omega)))
          (by exact_mod_cast (show a.2.2 ≠ 0 by omega))
      have hwn : w.natAbs ∈ Finset.Icc 1 (K * V ^ 2) := by
        simp only [Finset.mem_Icc]
        constructor
        · exact Int.natAbs_pos.mpr hwne
        · have hwa : (w.natAbs : ℤ) ≤ (K * V ^ 2 : ℕ) := by
            simpa only [Int.natCast_natAbs] using (abs_le.mpr hwbound)
          exact_mod_cast hwa
      exact (signed_triple_product_fiber_card_le K V w).trans
        (Nat.pow_le_pow_left (Finset.le_sup (f := fun n => n.divisors.card) hwn) 2)
    · simp only [Finset.not_nonempty_iff_eq_empty.mp he, Finset.card_empty, Nat.zero_le]
  have h := signed_bounded_fiber_gcd_sum_le S
    (fun a => a.1 * (a.2.1 : ℤ) * (a.2.2 : ℤ)) (K * V ^ 2) (D ^ 2) r hr hbounds hfiber
  have hcard : S.card = 2 * K * V ^ 2 := by
    simp [S, H, Finset.card_product, signed_frequency_card, Nat.card_Icc, pow_two, mul_assoc]
  rw [hcard] at h
  push_cast at h
  convert h using 1
  dsimp [S, H, D]
  ring

theorem lower_order_correlation_length_gates
    (x N R Q «ω» δ σ ρ : ℝ) (hx : 1 < x)
    (hN : 0 < N) (hR : 0 < R) (hQ : 0 < Q)
    (htwo : 2 ≤ x ^ ρ) (hNlo : x ^ (1 / 2 - σ) ≤ N)
    (hRlo : x ^ (-δ - 6 * ρ) * N ≤ R)
    (hRQ : R * Q ≤ x ^ (1 / 2 + 2 * «ω» + ρ))
    (hlength : 0 ≤ 1 / 2 - 2 * σ - 2 * «ω» - δ - 8 * ρ)
    (hcube : 0 ≤ 1 - 2 * σ - 3 * δ - 18 * ρ) :
    2 * Q ≤ N ∧ N ≤ R ^ 3 := by
  have hx0 : 0 < x := zero_lt_one.trans hx
  let γ := Real.logb x N
  let r := Real.logb x R
  let q := Real.logb x Q
  have hNeq : x ^ γ = N := Real.rpow_logb hx0 hx.ne' hN
  have hReq : x ^ r = R := Real.rpow_logb hx0 hx.ne' hR
  have hQeq : x ^ q = Q := Real.rpow_logb hx0 hx.ne' hQ
  have hγ : 1 / 2 - σ ≤ γ := by
    apply (Real.rpow_le_rpow_left_iff hx).mp
    simpa only [hNeq] using hNlo
  have hr : γ - δ - 6 * ρ ≤ r := by
    apply (Real.rpow_le_rpow_left_iff hx).mp
    calc
      x ^ (γ - δ - 6 * ρ) = x ^ (-δ - 6 * ρ) * N := by
        rw [← hNeq, ← Real.rpow_add hx0]
        congr 1
        ring
      _ ≤ x ^ r := by simpa only [hReq] using hRlo
  have hqr : r + q ≤ 1 / 2 + 2 * «ω» + ρ := by
    apply (Real.rpow_le_rpow_left_iff hx).mp
    simpa only [Real.rpow_add hx0, hReq, hQeq] using hRQ
  constructor
  · calc
      2 * Q ≤ x ^ ρ * Q := mul_le_mul_of_nonneg_right htwo hQ.le
      _ = x ^ (ρ + q) := by rw [← hQeq, Real.rpow_add hx0]
      _ ≤ x ^ γ := Real.rpow_le_rpow_of_exponent_le hx.le (by linarith)
      _ = N := hNeq
  · calc
      N = x ^ γ := hNeq.symm
      _ ≤ x ^ (r * (3 : ℕ)) := Real.rpow_le_rpow_of_exponent_le hx.le (by
        norm_num only [Nat.cast_ofNat]
        linarith)
      _ = R ^ 3 := by rw [Real.rpow_mul_natCast hx0.le, hReq]

theorem source_shared_first_factor_gcd
    (r q₁ q₂ s₂ : ℕ) (hcoprime : Nat.Coprime q₁ r) (h₁ h₂ : ℤ) :
    Int.gcd (r : ℤ)
        (h₁ * (q₁ : ℤ) * (s₂ : ℤ) - h₂ * (q₁ : ℤ) * (q₂ : ℤ)) =
      Int.gcd (r : ℤ) (h₁ * (s₂ : ℤ) - h₂ * (q₂ : ℤ)) := by
  have he : h₁ * (q₁ : ℤ) * (s₂ : ℤ) - h₂ * (q₁ : ℤ) * (q₂ : ℤ) =
      (q₁ : ℤ) * (h₁ * (s₂ : ℤ) - h₂ * (q₂ : ℤ)) := by ring
  rw [he]
  simpa only [Int.gcd_eq_natAbs_gcd_natAbs, Int.natAbs_mul, Int.natAbs_natCast] using
    hcoprime.gcd_mul_left_cancel_right (h₁ * (s₂ : ℤ) - h₂ * (q₂ : ℤ)).natAbs

theorem source_shared_outer_factors_gcd
    (r u v₁ v₂ q₂ : ℕ) (hcoprime : Nat.Coprime (u * q₂) r) (h₁ h₂ : ℤ) :
    Int.gcd (r : ℤ)
        (h₁ * (u * v₂ : ℕ) * (q₂ : ℤ) - h₂ * (u * v₁ : ℕ) * (q₂ : ℤ)) =
      Int.gcd (r : ℤ) (h₁ * (v₂ : ℤ) - h₂ * (v₁ : ℤ)) := by
  have he : h₁ * (u * v₂ : ℕ) * (q₂ : ℤ) - h₂ * (u * v₁ : ℕ) * (q₂ : ℤ) =
      (u * q₂ : ℕ) * (h₁ * (v₂ : ℤ) - h₂ * (v₁ : ℤ)) := by push_cast; ring
  rw [he]
  simpa only [Int.gcd_eq_natAbs_gcd_natAbs, Int.natAbs_mul, Int.natAbs_natCast] using
    hcoprime.gcd_mul_left_cancel_right (h₁ * (v₂ : ℤ) - h₂ * (v₁ : ℤ)).natAbs

theorem source_pair_lcm_upper_bounds
    (r q₀ q₁ q₂ s₁ s₂ u v₁ v₂ : ℕ)
    (hq₁ : 0 < q₁) (hq₂ : 0 < q₂) (hs₁ : 0 < s₁) (hs₂ : 0 < s₂)
    (hv₁ : 0 < v₁) (hv₂ : 0 < v₂) :
    Nat.lcm (r * q₀ * q₁ * q₂) (r * q₀ * s₁ * s₂) ≤
        r * q₀ * q₁ * q₂ * s₁ * s₂ ∧
      Nat.lcm (r * q₀ * q₁ * q₂) (r * q₀ * q₁ * s₂) ≤
        r * q₀ * q₁ * q₂ * s₂ ∧
      Nat.lcm (r * q₀ * (u * v₁) * q₂) (r * q₀ * (u * v₂) * q₂) ≤
        r * q₀ * u * q₂ * v₁ * v₂ := by
  constructor
  · calc
      _ = (r * q₀) * Nat.lcm (q₁ * q₂) (s₁ * s₂) := by
        simp only [Nat.mul_assoc, Nat.lcm_mul_left]
      _ ≤ (r * q₀) * ((q₁ * q₂) * (s₁ * s₂)) :=
        Nat.mul_le_mul_left _ (Nat.lcm_le_mul (Nat.mul_pos hq₁ hq₂) (Nat.mul_pos hs₁ hs₂))
      _ = _ := by ring
  constructor
  · rw [Nat.lcm_mul_left]
    simpa only [Nat.mul_assoc] using Nat.mul_le_mul_left (r * q₀ * q₁)
      (Nat.lcm_le_mul hq₂ hs₂)
  · have h₁ : r * q₀ * (u * v₁) * q₂ = (r * q₀ * u * q₂) * v₁ := by ring
    have h₂ : r * q₀ * (u * v₂) * q₂ = (r * q₀ * u * q₂) * v₂ := by ring
    rw [h₁, h₂, Nat.lcm_mul_left]
    simpa only [Nat.mul_assoc] using Nat.mul_le_mul_left (r * q₀ * u * q₂)
      (Nat.lcm_le_mul hv₁ hv₂)

open Classical in
theorem vonMangoldt_closedSubinterval_log_saving_of_dyadic
    (j : ℕ) (θ₀ θ₁ δ₀ δ₁ : ℝ)
    (hθ₀ : 0 < θ₀) (hθ : θ₀ < θ₁)
    (hδ₀ : 0 < δ₀) (hδ : δ₀ < δ₁) (hθsmall : θ₀ < 2 / 3)
    (hDyadic : ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ y : ℝ, X ≤ y →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊y ^ θ₁⌋₊).filter (fun q =>
          q ∣ ∏ p ∈ I, p ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (y ^ δ₁), le_max_left (1 : ℝ) (y ^ δ₁)⟩ j q)),
          ‖fullDiscrepancy
            (∑ n ∈ Finset.Icc ⌈y⌉₊ ⌊2 * y⌋₊,
              Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q a‖) ≤
            K * y / (Real.log y) ^ A) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      ∀ u v : ℝ, x ≤ u → u ≤ v → v ≤ 2 * x →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊x ^ θ₀⌋₊).filter (fun q =>
          q ∣ ∏ p ∈ I, p ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (x ^ δ₀), le_max_left (1 : ℝ) (x ^ δ₀)⟩ j q)),
          ‖fullDiscrepancy
            (∑ n ∈ Finset.Icc ⌈u⌉₊ ⌊v⌋₊,
              Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q a‖) ≤
            K * x / (Real.log x) ^ A := by
  have hclosed_prefix (w : ℕ → ℂ) (u v : ℝ) (hu : 1 ≤ u) (huv : u ≤ v) :
      let P : ℝ → ℂ := fun t => ∑ n ∈ Finset.Ioc 0 ⌊t⌋₊, w n
      let E : ℝ → ℂ := fun y => ∑ n ∈ Finset.Icc ⌈y⌉₊ ⌊y⌋₊, w n
      (∑ n ∈ Finset.Icc ⌈u⌉₊ ⌊v⌋₊, w n) = P v - P u + E u := by
    classical
    intro P E
    have hfloor : ⌊u⌋₊ ≤ ⌊v⌋₊ := Nat.floor_mono huv
    have hceilfloor : ⌊u⌋₊ ≤ ⌈u⌉₊ := Nat.floor_le_ceil u
    have hceilnext : ⌈u⌉₊ ≤ ⌊u⌋₊ + 1 := Nat.ceil_le_floor_add_one u
    have hzero : 0 ≤ ⌊u⌋₊ := Nat.zero_le _
    have hset : Finset.Icc ⌈u⌉₊ ⌊v⌋₊ =
        Finset.Ioc ⌊u⌋₊ ⌊v⌋₊ ∪ Finset.Icc ⌈u⌉₊ ⌊u⌋₊ := by
      ext n
      simp only [Finset.mem_Icc, Finset.mem_union, Finset.mem_Ioc]
      omega
    have hdisjoint : Disjoint (Finset.Ioc ⌊u⌋₊ ⌊v⌋₊)
        (Finset.Icc ⌈u⌉₊ ⌊u⌋₊) := by
      apply Finset.disjoint_left.mpr
      intro n hn hm
      exact (not_lt_of_ge (Finset.mem_Icc.mp hm).2) (Finset.mem_Ioc.mp hn).1
    have hprefix : P u + (∑ n ∈ Finset.Ioc ⌊u⌋₊ ⌊v⌋₊, w n) = P v :=
      Finset.sum_Ioc_consecutive w hzero hfloor
    rw [hset, Finset.sum_union hdisjoint]
    change (∑ n ∈ Finset.Ioc ⌊u⌋₊ ⌊v⌋₊, w n) + E u = P v - P u + E u
    rw [← hprefix]
    abel
  have hdyadic_prefix (w : ℕ → ℂ) (N : ℕ) (t : ℝ)
      (ht : 1 ≤ t / (2 : ℝ) ^ N) :
      let P : ℝ → ℂ := fun z => ∑ n ∈ Finset.Ioc 0 ⌊z⌋₊, w n
      let D : ℝ → ℂ := fun y => ∑ n ∈ Finset.Icc ⌈y⌉₊ ⌊2 * y⌋₊, w n
      let E : ℝ → ℂ := fun y => ∑ n ∈ Finset.Icc ⌈y⌉₊ ⌊y⌋₊, w n
      P t =
        (∑ k ∈ Finset.range N,
          (D (t / (2 : ℝ) ^ (k + 1)) - E (t / (2 : ℝ) ^ (k + 1)))) +
          P (t / (2 : ℝ) ^ N) := by
    classical
    intro P D E
    have hpow : (2 : ℝ) ^ N ≤ t := by
      simpa only [one_mul] using
        (le_div_iff₀ (pow_pos (by norm_num : (0 : ℝ) < 2) N)).mp ht
    have hterm (k : ℕ) (hk : k ∈ Finset.range N) :
        D (t / (2 : ℝ) ^ (k + 1)) - E (t / (2 : ℝ) ^ (k + 1)) =
          P (t / (2 : ℝ) ^ k) - P (t / (2 : ℝ) ^ (k + 1)) := by
      have hkpow : (2 : ℝ) ^ (k + 1) ≤ (2 : ℝ) ^ N :=
        pow_le_pow_right₀ (by norm_num : (1 : ℝ) ≤ 2)
          (Nat.succ_le_of_lt (Finset.mem_range.mp hk))
      have hy : 1 ≤ t / (2 : ℝ) ^ (k + 1) := by
        apply (le_div_iff₀ (pow_pos (by norm_num : (0 : ℝ) < 2) (k + 1))).mpr
        simpa only [one_mul] using hkpow.trans hpow
      have hdouble : 2 * (t / (2 : ℝ) ^ (k + 1)) = t / (2 : ℝ) ^ k := by
        rw [pow_succ]
        field_simp [pow_ne_zero k (by norm_num : (2 : ℝ) ≠ 0)]
      have hstep := hclosed_prefix w (t / (2 : ℝ) ^ (k + 1))
        (2 * (t / (2 : ℝ) ^ (k + 1))) hy (by linarith only [hy])
      change D (t / (2 : ℝ) ^ (k + 1)) =
        P (2 * (t / (2 : ℝ) ^ (k + 1))) - P (t / (2 : ℝ) ^ (k + 1)) +
          E (t / (2 : ℝ) ^ (k + 1)) at hstep
      rw [hdouble] at hstep
      rw [hstep]
      abel
    have hsum : (∑ k ∈ Finset.range N,
        (D (t / (2 : ℝ) ^ (k + 1)) - E (t / (2 : ℝ) ^ (k + 1)))) =
        P t - P (t / (2 : ℝ) ^ N) := by
      calc
        (∑ k ∈ Finset.range N,
            (D (t / (2 : ℝ) ^ (k + 1)) - E (t / (2 : ℝ) ^ (k + 1)))) =
            ∑ k ∈ Finset.range N,
              (P (t / (2 : ℝ) ^ k) - P (t / (2 : ℝ) ^ (k + 1))) :=
          Finset.sum_congr rfl hterm
        _ = P t - P (t / (2 : ℝ) ^ N) := by
          simpa only [pow_zero, div_one] using
            Finset.sum_range_sub' (fun k : ℕ => P (t / (2 : ℝ) ^ k)) N
    rw [hsum]
    abel
  have hdyadic_geometry (x η : ℝ) (hx : 1 ≤ x) (hη : 0 < η) :
      let N : ℕ := Nat.log 2 ⌊x ^ η⌋₊
      (2 : ℝ) ^ N ≤ x ^ η ∧ x ^ η < 2 * (2 : ℝ) ^ N ∧
        (N : ℝ) ≤ η / Real.log 2 * Real.log x ∧
        ∀ t : ℝ, x ≤ t → t ≤ 2 * x →
          x ^ (1 - η) ≤ t / (2 : ℝ) ^ N ∧
          t / (2 : ℝ) ^ N ≤ 4 * x ^ (1 - η) ∧
          ∀ k : ℕ, k < N →
            x ^ (1 - η) ≤ t / (2 : ℝ) ^ (k + 1) ∧
            t / (2 : ℝ) ^ (k + 1) ≤ 2 * x := by
    intro N
    have hxpos : 0 < x := zero_lt_one.trans_le hx
    have hpowpos : 0 < x ^ η := Real.rpow_pos_of_pos hxpos η
    have hpowone : 1 ≤ x ^ η := Real.one_le_rpow hx hη.le
    have hfloorpos : 0 < ⌊x ^ η⌋₊ := Nat.floor_pos.mpr hpowone
    have htwoNpos : 0 < (2 : ℝ) ^ N := pow_pos (by norm_num) N
    have hlo : (2 : ℝ) ^ N ≤ x ^ η := by
      calc
        (2 : ℝ) ^ N ≤ (⌊x ^ η⌋₊ : ℝ) := by
          exact_mod_cast Nat.pow_log_le_self 2 hfloorpos.ne'
        _ ≤ x ^ η := Nat.floor_le hpowpos.le
    have hnext : ⌊x ^ η⌋₊ + 1 ≤ (2 : ℕ) ^ (N + 1) :=
      Nat.succ_le_of_lt (Nat.lt_pow_succ_log_self (by norm_num : 1 < 2) ⌊x ^ η⌋₊)
    have hhi : x ^ η < 2 * (2 : ℝ) ^ N := by
      calc
        x ^ η < (⌊x ^ η⌋₊ : ℝ) + 1 := Nat.lt_floor_add_one _
        _ ≤ (2 : ℝ) ^ (N + 1) := by exact_mod_cast hnext
        _ = 2 * (2 : ℝ) ^ N := by rw [pow_succ, mul_comm]
    have hlogtwo : 0 < Real.log 2 := Real.log_pos (by norm_num)
    have hlogbound : (N : ℝ) ≤ η / Real.log 2 * Real.log x := by
      have hlog := Real.log_le_log htwoNpos hlo
      rw [Real.log_pow, Real.log_rpow hxpos] at hlog
      calc
        (N : ℝ) ≤ (η * Real.log x) / Real.log 2 := (le_div_iff₀ hlogtwo).mpr hlog
        _ = η / Real.log 2 * Real.log x := by ring
    have hbase : x ^ (1 - η) = x / x ^ η := by
      rw [Real.rpow_sub hxpos, Real.rpow_one]
    refine ⟨hlo, hhi, hlogbound, ?_⟩
    intro t hxt htx
    have ht : 0 ≤ t := hxpos.le.trans hxt
    have hterminal_lo : x ^ (1 - η) ≤ t / (2 : ℝ) ^ N := by
      calc
        x ^ (1 - η) = x / x ^ η := hbase
        _ ≤ x / (2 : ℝ) ^ N := div_le_div_of_nonneg_left hxpos.le htwoNpos hlo
        _ ≤ t / (2 : ℝ) ^ N := div_le_div_of_nonneg_right hxt htwoNpos.le
    have hterminal_hi : t / (2 : ℝ) ^ N ≤ 4 * x ^ (1 - η) := by
      rw [hbase, ← mul_div_assoc]
      apply (div_le_div_iff₀ htwoNpos hpowpos).mpr
      have hprod := mul_le_mul htx hhi.le hpowpos.le
        (mul_nonneg (by norm_num : (0 : ℝ) ≤ 2) hxpos.le)
      nlinarith only [hprod]
    refine ⟨hterminal_lo, hterminal_hi, ?_⟩
    intro k hk
    have hkpow : (2 : ℝ) ^ (k + 1) ≤ (2 : ℝ) ^ N :=
      pow_le_pow_right₀ (by norm_num : (1 : ℝ) ≤ 2) (Nat.succ_le_of_lt hk)
    have hkpos : 0 < (2 : ℝ) ^ (k + 1) := pow_pos (by norm_num) _
    exact ⟨hterminal_lo.trans (div_le_div_of_nonneg_left ht hkpos hkpow),
      (div_le_self ht (one_le_pow₀ (by norm_num : (1 : ℝ) ≤ 2))).trans htx⟩
  have hscale_sum (t : ℝ) (ht : 0 ≤ t) (N : ℕ) :
      (∑ k ∈ Finset.range N, t / (2 : ℝ) ^ (k + 1)) ≤ t := by
    have hterm (k : ℕ) : t / (2 : ℝ) ^ (k + 1) =
        t / (2 : ℝ) ^ k - t / (2 : ℝ) ^ (k + 1) := by
      rw [pow_succ]
      field_simp [pow_ne_zero k (by norm_num : (2 : ℝ) ≠ 0)]
      ring
    calc
      (∑ k ∈ Finset.range N, t / (2 : ℝ) ^ (k + 1)) =
          ∑ k ∈ Finset.range N,
            (t / (2 : ℝ) ^ k - t / (2 : ℝ) ^ (k + 1)) :=
        Finset.sum_congr rfl (fun k _ => hterm k)
      _ = t - t / (2 : ℝ) ^ N := by
        simpa only [pow_zero, div_one] using
          Finset.sum_range_sub' (fun k : ℕ => t / (2 : ℝ) ^ k) N
      _ ≤ t := sub_le_self _ (div_nonneg ht (pow_nonneg (by norm_num) N))
  have hθ₁ : 0 < θ₁ := hθ₀.trans hθ
  have hδ₁ : 0 < δ₁ := hδ₀.trans hδ
  have hθlt : θ₀ < 1 := by linarith only [hθsmall]
  let η : ℝ := min (min ((1 - θ₀) / 2) ((θ₁ - θ₀) / (2 * θ₁)))
    ((δ₁ - δ₀) / (2 * δ₁))
  have hη : 0 < η := lt_min
    (lt_min (div_pos (sub_pos.mpr hθlt) (by norm_num))
      (div_pos (sub_pos.mpr hθ) (mul_pos (by norm_num) hθ₁)))
    (div_pos (sub_pos.mpr hδ) (mul_pos (by norm_num) hδ₁))
  have hηθ : η ≤ (θ₁ - θ₀) / (2 * θ₁) :=
    (min_le_left _ _).trans (min_le_right _ _)
  have hηδ : η ≤ (δ₁ - δ₀) / (2 * δ₁) := min_le_right _ _
  have hηsmall : η < 1 - θ₀ :=
    ((min_le_left _ _).trans (min_le_left _ _)).trans_lt (by linarith only [hθlt])
  have hηlt : η < 1 := by linarith only [hηsmall, hθ₀]
  let ρ : ℝ := 1 - η
  have hρ : 0 < ρ := sub_pos.mpr hηlt
  have hρθ : θ₀ < ρ * θ₁ := by
    have hh := (le_div_iff₀ (mul_pos (by norm_num : (0 : ℝ) < 2) hθ₁)).mp hηθ
    dsimp only [ρ]
    nlinarith only [hh, hθ]
  have hρδ : δ₀ < ρ * δ₁ := by
    have hh := (le_div_iff₀ (mul_pos (by norm_num : (0 : ℝ) < 2) hδ₁)).mp hηδ
    dsimp only [ρ]
    nlinarith only [hh, hδ]
  have hlog2 : 0 < Real.log 2 := Real.log_pos (by norm_num)
  let L : ℝ := 1 + Real.log 2
  have hL : 0 < L := add_pos zero_lt_one hlog2
  let CN : ℝ := 1 + η / Real.log 2
  have hCN : 0 < CN := add_pos zero_lt_one (div_pos hη hlog2)
  intro A hA
  obtain ⟨KD, XD, hKD, hXD, hD⟩ := hDyadic A hA
  obtain ⟨D, _, KB, XB, hKB, hXB, hBoundary⟩ :=
    weighted_boundary_fullDiscrepancy_log_saving
      θ₀ hθ₀ hθlt 0 1 0 1 2 4 (by norm_num) (by norm_num)
      (A + 2) (by linarith only [hA])
  have hscaleEvent : ∀ᶠ x : ℝ in Filter.atTop, XD ≤ x ^ ρ :=
    (tendsto_rpow_atTop hρ).eventually (Filter.eventually_ge_atTop XD)
  have hwidthEvent : ∀ᶠ x : ℝ in Filter.atTop,
      ‖(Real.log x) ^ (D : ℝ)‖ ≤ ‖x ^ η‖ := by
    simpa only [one_mul] using
      (isLittleO_log_rpow_rpow_atTop (D : ℝ) hη).bound
        (by norm_num : (0 : ℝ) < 1)
  obtain ⟨XS, hXS⟩ := Filter.eventually_atTop.mp hscaleEvent
  obtain ⟨XW, hXW⟩ := Filter.eventually_atTop.mp hwidthEvent
  let X : ℝ := max XB (max XS XW)
  let CD : ℝ := KD / ρ ^ A
  have hCD : 0 < CD := div_pos hKD (Real.rpow_pos_of_pos hρ A)
  let K : ℝ := 4 * CD + 3 * CN * KB * L
  have hK : 0 < K := by dsimp only [K]; positivity
  refine ⟨K, X, hK, hXB.trans (le_max_left _ _), ?_⟩
  intro x hx u v hxu huv hvx I hI a ha
  have hxB : XB ≤ x := (le_max_left _ _).trans hx
  have hxS : XS ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans hx)
  have hxW : XW ≤ x := (le_max_right _ _).trans ((le_max_right _ _).trans hx)
  have hxexp : Real.exp 1 ≤ x := hXB.trans hxB
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hx1 : 1 ≤ x :=
    (Real.one_le_exp_iff.mpr (by norm_num : (0 : ℝ) ≤ 1)).trans hxexp
  have hlog1 : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hxexp
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlog1
  have hxρ : XD ≤ x ^ ρ := hXS x hxS
  have hxρ1 : 1 ≤ x ^ ρ :=
    (Real.one_le_exp_iff.mpr (by norm_num : (0 : ℝ) ≤ 1)).trans (hXD.trans hxρ)
  have hwidthPower : (Real.log x) ^ D ≤ x ^ η := by
    simpa only [Real.rpow_natCast, Real.norm_of_nonneg (pow_nonneg hlogpos.le _),
      Real.norm_of_nonneg (Real.rpow_nonneg hxpos.le _)] using hXW x hxW
  have hρWidth : x ^ ρ ≤ x / (Real.log x) ^ D := by
    apply (le_div_iff₀ (pow_pos hlogpos D)).mpr
    calc
      x ^ ρ * (Real.log x) ^ D ≤ x ^ ρ * x ^ η :=
        mul_le_mul_of_nonneg_left hwidthPower (Real.rpow_nonneg hxpos.le _)
      _ = x := by
        rw [← Real.rpow_add hxpos]
        dsimp only [ρ]
        rw [sub_add_cancel, Real.rpow_one]
  let Q : Finset ℕ := (Finset.Icc 1 ⌊x ^ θ₀⌋₊).filter fun q =>
    q ∣ ∏ p ∈ I, p ∧ Nonempty (DenseDivisibilityWitness
      ⟨max 1 (x ^ δ₀), le_max_left (1 : ℝ) (x ^ δ₀)⟩ j q)
  have hQsubset : Q ⊆ Finset.Icc 1 ⌊x ^ θ₀⌋₊ := Finset.filter_subset _ _
  have hQprimitive (q : ℕ) (hq : q ∈ Q) : Nat.Coprime a q :=
    ha.of_dvd_right (Finset.mem_filter.mp hq).2.1
  let Wq (q n : ℕ) : ℂ := ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ) *
    ((if n % q = a % q then 1 else 0) -
      (if Nat.Coprime n q then 1 else 0) / (q.totient : ℂ))
  let P (q : ℕ) (t : ℝ) : ℂ := ∑ n ∈ Finset.Ioc 0 ⌊t⌋₊, Wq q n
  let E (q : ℕ) (t : ℝ) : ℂ := ∑ n ∈ Finset.Icc ⌈t⌉₊ ⌊t⌋₊, Wq q n
  let V (q : ℕ) (t : ℝ) : ℂ := ∑ n ∈ Finset.Icc ⌈t⌉₊ ⌊2 * t⌋₊, Wq q n
  let Remainder : ℝ := KB * L * x / (Real.log x) ^ (A + 2)
  have hRemainder : 0 ≤ Remainder := by dsimp only [Remainder]; positivity
  have hEval (S : Finset ℕ) (q : ℕ) :
      fullDiscrepancy
        (∑ n ∈ S, Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q a =
          ∑ n ∈ S, Wq q n := by
    have hmass (R : ℕ → Prop) [DecidablePred R] :
        (∑ n ∈ (∑ m ∈ S,
          Finsupp.single m ((ArithmeticFunction.vonMangoldt m : ℝ) : ℂ)).support,
          if R n then (∑ m ∈ S,
            Finsupp.single m ((ArithmeticFunction.vonMangoldt m : ℝ) : ℂ)) n else 0) =
        ∑ n ∈ S, if R n then ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ) else 0 := by
      change (∑ m ∈ S,
        Finsupp.single m ((ArithmeticFunction.vonMangoldt m : ℝ) : ℂ)).sum
          (fun n z => if R n then z else 0) = _
      rw [← Finsupp.indicator_eq_sum_single]
      exact Finsupp.sum_indicator_index _ (fun n _ => by simp)
    have hkernel (n : ℕ) : Wq q n =
        (if n % q = a % q then ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ) else 0) -
        (if Nat.Coprime n q then ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ) else 0) /
          (q.totient : ℂ) := by
      dsimp only [Wq]
      split_ifs <;> ring
    simp only [fullDiscrepancy, progressionMass, reducedMass, hmass, hkernel,
      Finset.sum_sub_distrib, Finset.sum_div]
  have hvalue (S : Finset ℕ) (n : ℕ) :
      (∑ m ∈ S, Finsupp.single m ((ArithmeticFunction.vonMangoldt m : ℝ) : ℂ)) n =
        if n ∈ S then ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ) else 0 := by
    simp only [Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_ite_eq']
  have hsupport (S : Finset ℕ) (n : ℕ)
      (hn : n ∈ (∑ m ∈ S,
        Finsupp.single m ((ArithmeticFunction.vonMangoldt m : ℝ) : ℂ)).support) : n ∈ S := by
    by_contra h
    exact (Finsupp.mem_support_iff.mp hn) (by rw [hvalue, ite_eq_right h])
  have hSmall (S : Finset ℕ) (lo hi : ℕ)
      (hlo : 1 ≤ lo) (hlohi : lo ≤ hi) (hhi : hi ≤ ⌈2 * x⌉₊ + 1)
      (hwidth : ((hi - lo : ℕ) : ℝ) ≤ 4 * x / (Real.log x) ^ D)
      (hSinterval : ∀ n ∈ S, lo ≤ n ∧ n < hi)
      (hSrange : ∀ n ∈ S, 0 < n ∧ (n : ℝ) ≤ 2 * x) :
      (∑ q ∈ Q, ‖∑ n ∈ S, Wq q n‖) ≤ Remainder := by
    let fS : ℕ →₀ ℂ :=
      ∑ n ∈ S, Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)
    have hs : ∀ n ∈ fS.support, ∃ i : Fin 1,
        (fun _ : Fin 1 => lo) i ≤ n ∧ n < (fun _ : Fin 1 => hi) i := by
      intro n hn
      exact ⟨0, hSinterval n (hsupport S n hn)⟩
    have hc : ∀ n ∈ fS.support,
        ‖fS n‖ ≤ L * (n.divisors.card : ℝ) ^ 0 * (Real.log x) ^ (1 : ℕ) := by
      intro n hn
      have hnS := hsupport S n hn
      have hnrange := hSrange n hnS
      change ‖(∑ m ∈ S,
        Finsupp.single m ((ArithmeticFunction.vonMangoldt m : ℝ) : ℂ)) n‖ ≤ _
      rw [hvalue, ite_eq_left hnS, pow_zero, mul_one, pow_one]
      rw [Complex.norm_real, Real.norm_eq_abs,
        abs_of_nonneg ArithmeticFunction.vonMangoldt_nonneg]
      calc
        ArithmeticFunction.vonMangoldt n ≤ Real.log (n : ℝ) :=
          ArithmeticFunction.vonMangoldt_le_log
        _ ≤ Real.log (2 * x) := Real.log_le_log (Nat.cast_pos.mpr hnrange.1) hnrange.2
        _ = Real.log 2 + Real.log x := Real.log_mul (by norm_num) hxpos.ne'
        _ ≤ L * Real.log x := by dsimp only [L]; nlinarith only [hlog1, hlog2]
    have hh := hBoundary x hxB L hL.le Q hQsubset (fun _ => a) hQprimitive
      (fun _ : Fin 1 => lo) (fun _ : Fin 1 => hi)
      (fun _ => ⟨hlo, hlohi, hhi⟩)
      (by simpa only [Fin.sum_univ_one] using hwidth) fS hs hc
    simpa only [pow_zero, one_mul, fS, hEval, Remainder] using hh
  have hPsmall (z : ℝ) (hz : 0 ≤ z) (hzx : z ≤ 2 * x)
      (hzwidth : z ≤ 4 * x ^ ρ) :
      (∑ q ∈ Q, ‖P q z‖) ≤ Remainder := by
    apply hSmall (Finset.Ioc 0 ⌊z⌋₊) 1 (⌊z⌋₊ + 1) le_rfl (by omega)
    · exact Nat.add_le_add_right
        ((Nat.floor_mono hzx).trans (Nat.floor_le_ceil (2 * x))) 1
    · simp only [Nat.add_sub_cancel]
      calc
        (⌊z⌋₊ : ℝ) ≤ z := Nat.floor_le hz
        _ ≤ 4 * x ^ ρ := hzwidth
        _ ≤ 4 * x / (Real.log x) ^ D := by
          simpa only [mul_div_assoc] using mul_le_mul_of_nonneg_left hρWidth (by norm_num)
    · intro n hn
      obtain ⟨hn0, hnz⟩ := Finset.mem_Ioc.mp hn
      exact ⟨hn0, Nat.lt_succ_of_le hnz⟩
    · intro n hn
      obtain ⟨hn0, hnz⟩ := Finset.mem_Ioc.mp hn
      exact ⟨hn0, ((Nat.cast_le.mpr hnz).trans (Nat.floor_le hz)).trans hzx⟩
  have hEsmall (y : ℝ) (hy : 1 ≤ y) (hyx : y ≤ 2 * x) :
      (∑ q ∈ Q, ‖E q y‖) ≤ Remainder := by
    apply hSmall (Finset.Icc ⌈y⌉₊ ⌊y⌋₊) ⌈y⌉₊ (⌈y⌉₊ + 1)
      (Nat.one_le_ceil_iff.mpr (zero_lt_one.trans_le hy)) (Nat.le_succ _)
    · exact Nat.add_le_add_right (Nat.ceil_mono hyx) 1
    · simp only [Nat.add_sub_cancel_left, Nat.cast_one]
      have hh : 1 ≤ x / (Real.log x) ^ D := hxρ1.trans hρWidth
      rw [mul_div_assoc]
      linarith only [hh]
    · intro n hn
      obtain ⟨hnlo, hnhi⟩ := Finset.mem_Icc.mp hn
      exact ⟨hnlo, Nat.lt_succ_of_le (hnhi.trans (Nat.floor_le_ceil y))⟩
    · intro n hn
      obtain ⟨hnlo, hnhi⟩ := Finset.mem_Icc.mp hn
      refine ⟨(Nat.one_le_ceil_iff.mpr (zero_lt_one.trans_le hy)).trans hnlo, ?_⟩
      exact ((Nat.cast_le.mpr hnhi).trans (Nat.floor_le (zero_le_one.trans hy))).trans hyx
  have hDyadicBound (y : ℝ) (hy : x ^ ρ ≤ y) :
      (∑ q ∈ Q, ‖V q y‖) ≤ CD * y / (Real.log x) ^ A := by
    have hyD : XD ≤ y := hxρ.trans hy
    have hyexp : Real.exp 1 ≤ y := hXD.trans hyD
    have hypos : 0 < y := (Real.exp_pos 1).trans_le hyexp
    have hlevel : x ^ θ₀ ≤ y ^ θ₁ := by
      calc
        x ^ θ₀ ≤ x ^ (ρ * θ₁) := Real.rpow_le_rpow_of_exponent_le hx1 hρθ.le
        _ = (x ^ ρ) ^ θ₁ := Real.rpow_mul hxpos.le ρ θ₁
        _ ≤ y ^ θ₁ := Real.rpow_le_rpow (Real.rpow_nonneg hxpos.le _) hy hθ₁.le
    have hdensity : max 1 (x ^ δ₀) ≤ max 1 (y ^ δ₁) := by
      apply max_le_max le_rfl
      calc
        x ^ δ₀ ≤ x ^ (ρ * δ₁) := Real.rpow_le_rpow_of_exponent_le hx1 hρδ.le
        _ = (x ^ ρ) ^ δ₁ := Real.rpow_mul hxpos.le ρ δ₁
        _ ≤ y ^ δ₁ := Real.rpow_le_rpow (Real.rpow_nonneg hxpos.le _) hy hδ₁.le
    have hsubset : Q ⊆ (Finset.Icc 1 ⌊y ^ θ₁⌋₊).filter (fun q =>
        q ∣ ∏ p ∈ I, p ∧ Nonempty (DenseDivisibilityWitness
          ⟨max 1 (y ^ δ₁), le_max_left (1 : ℝ) (y ^ δ₁)⟩ j q)) := by
      intro q hq
      obtain ⟨hqI, hqdiv, hqDD⟩ := Finset.mem_filter.mp hq
      exact Finset.mem_filter.mpr
        ⟨Finset.mem_Icc.mpr ⟨(Finset.mem_Icc.mp hqI).1,
          (Finset.mem_Icc.mp hqI).2.trans (Nat.floor_mono hlevel)⟩,
          hqdiv, denseDivisibility_mono_scale hdensity hqDD⟩
    have hsum : (∑ q ∈ Q, ‖V q y‖) ≤ KD * y / (Real.log y) ^ A := by
      apply (Finset.sum_le_sum_of_subset_of_nonneg hsubset
        (fun q _ _ => norm_nonneg (V q y))).trans
      simpa only [hEval, V] using hD y hyD I hI a ha
    have hloglower : ρ * Real.log x ≤ Real.log y := by
      have hh := Real.log_le_log (Real.rpow_pos_of_pos hxpos ρ) hy
      rwa [Real.log_rpow hxpos] at hh
    calc
      (∑ q ∈ Q, ‖V q y‖) ≤ KD * y / (Real.log y) ^ A := hsum
      _ ≤ KD * y / (ρ * Real.log x) ^ A :=
        div_le_div_of_nonneg_left (mul_nonneg hKD.le hypos.le)
          (Real.rpow_pos_of_pos (mul_pos hρ hlogpos) A)
          (Real.rpow_le_rpow (mul_nonneg hρ.le hlogpos.le) hloglower hA.le)
      _ = CD * y / (Real.log x) ^ A := by
        rw [Real.mul_rpow hρ.le hlogpos.le]
        dsimp only [CD]
        field_simp
  let N : ℕ := Nat.log 2 ⌊x ^ η⌋₊
  obtain ⟨_, _, hNlog, hscales⟩ := hdyadic_geometry x η hx1 hη
  have hPrefixBound (t : ℝ) (hxt : x ≤ t) (htx : t ≤ 2 * x) :
      (∑ q ∈ Q, ‖P q t‖) ≤ CD * t / (Real.log x) ^ A +
        ((N : ℝ) + 1) * Remainder := by
    have htpos : 0 < t := hxpos.trans_le hxt
    obtain ⟨hbaseLo, hbaseWidth, hbandScale⟩ := hscales t hxt htx
    have hbasePos : 0 ≤ t / (2 : ℝ) ^ N :=
      div_nonneg htpos.le (pow_nonneg (by norm_num) _)
    have hbaseUpper : t / (2 : ℝ) ^ N ≤ 2 * x :=
      (div_le_self htpos.le (one_le_pow₀ (by norm_num : (1 : ℝ) ≤ 2))).trans htx
    have hbase := hPsmall (t / (2 : ℝ) ^ N) hbasePos hbaseUpper hbaseWidth
    have hpoint (q : ℕ) : ‖P q t‖ ≤
        (∑ k ∈ Finset.range N,
          (‖V q (t / (2 : ℝ) ^ (k + 1))‖ + ‖E q (t / (2 : ℝ) ^ (k + 1))‖)) +
          ‖P q (t / (2 : ℝ) ^ N)‖ := by
      have htelescope := hdyadic_prefix (Wq q) N t (hxρ1.trans hbaseLo)
      change P q t =
        (∑ k ∈ Finset.range N,
          (V q (t / (2 : ℝ) ^ (k + 1)) - E q (t / (2 : ℝ) ^ (k + 1)))) +
          P q (t / (2 : ℝ) ^ N) at htelescope
      rw [htelescope]
      apply (norm_add_le _ _).trans
      refine add_le_add ?_ le_rfl
      exact norm_sum_le_of_le _ (fun _ _ => norm_sub_le _ _)
    have hswap :
        (∑ q ∈ Q, ((∑ k ∈ Finset.range N,
          (‖V q (t / (2 : ℝ) ^ (k + 1))‖ + ‖E q (t / (2 : ℝ) ^ (k + 1))‖)) +
          ‖P q (t / (2 : ℝ) ^ N)‖)) =
        (∑ k ∈ Finset.range N, ∑ q ∈ Q, ‖V q (t / (2 : ℝ) ^ (k + 1))‖) +
        (∑ k ∈ Finset.range N, ∑ q ∈ Q, ‖E q (t / (2 : ℝ) ^ (k + 1))‖) +
          ∑ q ∈ Q, ‖P q (t / (2 : ℝ) ^ N)‖ := by
      rw [Finset.sum_add_distrib]
      congr 1
      rw [Finset.sum_comm]
      simp only [Finset.sum_add_distrib]
    have hdyadicSum :
        (∑ k ∈ Finset.range N, ∑ q ∈ Q, ‖V q (t / (2 : ℝ) ^ (k + 1))‖) ≤
          CD * t / (Real.log x) ^ A := by
      calc
        (∑ k ∈ Finset.range N, ∑ q ∈ Q, ‖V q (t / (2 : ℝ) ^ (k + 1))‖) ≤
            ∑ k ∈ Finset.range N, CD * (t / (2 : ℝ) ^ (k + 1)) /
              (Real.log x) ^ A := by
          apply Finset.sum_le_sum
          intro k hk
          exact hDyadicBound _ (hbandScale k (Finset.mem_range.mp hk)).1
        _ = CD * (∑ k ∈ Finset.range N, t / (2 : ℝ) ^ (k + 1)) /
            (Real.log x) ^ A := by rw [← Finset.sum_div, ← Finset.mul_sum]
        _ ≤ CD * t / (Real.log x) ^ A :=
          div_le_div_of_nonneg_right
            (mul_le_mul_of_nonneg_left (hscale_sum t htpos.le N) hCD.le)
            (Real.rpow_nonneg hlogpos.le _)
    have hendpointSum :
        (∑ k ∈ Finset.range N, ∑ q ∈ Q, ‖E q (t / (2 : ℝ) ^ (k + 1))‖) ≤
          (N : ℝ) * Remainder := by
      calc
        (∑ k ∈ Finset.range N, ∑ q ∈ Q, ‖E q (t / (2 : ℝ) ^ (k + 1))‖) ≤
            ∑ _k ∈ Finset.range N, Remainder := by
          apply Finset.sum_le_sum
          intro k hk
          obtain ⟨hlo, hhi⟩ := hbandScale k (Finset.mem_range.mp hk)
          exact hEsmall _ (hxρ1.trans hlo) hhi
        _ = (N : ℝ) * Remainder := by simp only [Finset.sum_const, Finset.card_range, nsmul_eq_mul]
    calc
      (∑ q ∈ Q, ‖P q t‖) ≤
          ∑ q ∈ Q, ((∑ k ∈ Finset.range N,
            (‖V q (t / (2 : ℝ) ^ (k + 1))‖ + ‖E q (t / (2 : ℝ) ^ (k + 1))‖)) +
            ‖P q (t / (2 : ℝ) ^ N)‖) := Finset.sum_le_sum fun q _ => hpoint q
      _ = (∑ k ∈ Finset.range N, ∑ q ∈ Q, ‖V q (t / (2 : ℝ) ^ (k + 1))‖) +
          (∑ k ∈ Finset.range N, ∑ q ∈ Q, ‖E q (t / (2 : ℝ) ^ (k + 1))‖) +
            ∑ q ∈ Q, ‖P q (t / (2 : ℝ) ^ N)‖ := hswap
      _ ≤ CD * t / (Real.log x) ^ A + (N : ℝ) * Remainder + Remainder :=
        add_le_add (add_le_add hdyadicSum hendpointSum) hbase
      _ = CD * t / (Real.log x) ^ A + ((N : ℝ) + 1) * Remainder := by ring
  have hu1 : 1 ≤ u := hx1.trans hxu
  have hux : u ≤ 2 * x := huv.trans hvx
  have hxv : x ≤ v := hxu.trans huv
  have hPu := hPrefixBound u hxu hux
  have hPv := hPrefixBound v hxv hvx
  have hEu := hEsmall u hu1 hux
  have hNcount : (N : ℝ) + 1 ≤ CN * Real.log x := by
    dsimp only [CN]
    nlinarith only [hNlog, hlog1]
  have hcount : 2 * ((N : ℝ) + 1) + 1 ≤ 3 * CN * (Real.log x) ^ 2 := by
    have hN0 : (0 : ℝ) ≤ N := Nat.cast_nonneg N
    have hlogSquare : Real.log x ≤ (Real.log x) ^ 2 := by nlinarith only [hlog1]
    have hm := mul_le_mul_of_nonneg_left hlogSquare
      (mul_nonneg (by norm_num : (0 : ℝ) ≤ 3) hCN.le)
    nlinarith only [hNcount, hN0, hm]
  have hRtotal : (2 * ((N : ℝ) + 1) + 1) * Remainder ≤
      3 * CN * KB * L * x / (Real.log x) ^ A := by
    calc
      (2 * ((N : ℝ) + 1) + 1) * Remainder ≤
          (3 * CN * (Real.log x) ^ 2) * Remainder :=
        mul_le_mul_of_nonneg_right hcount hRemainder
      _ = 3 * CN * KB * L * x / (Real.log x) ^ A := by
        dsimp only [Remainder]
        rw [Real.rpow_add hlogpos, Real.rpow_two]
        field_simp
  have hMainScale : CD * v / (Real.log x) ^ A + CD * u / (Real.log x) ^ A ≤
      4 * CD * x / (Real.log x) ^ A := by
    have hm := add_le_add
      (mul_le_mul_of_nonneg_left hvx hCD.le)
      (mul_le_mul_of_nonneg_left hux hCD.le)
    have hd := div_le_div_of_nonneg_right hm (Real.rpow_nonneg hlogpos.le A)
    calc
      CD * v / (Real.log x) ^ A + CD * u / (Real.log x) ^ A =
          (CD * v + CD * u) / (Real.log x) ^ A := (add_div _ _ _).symm
      _ ≤ (CD * (2 * x) + CD * (2 * x)) / (Real.log x) ^ A := hd
      _ = 4 * CD * x / (Real.log x) ^ A := by ring
  change (∑ q ∈ Q, ‖fullDiscrepancy
    (∑ n ∈ Finset.Icc ⌈u⌉₊ ⌊v⌋₊,
      Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q a‖) ≤
      K * x / (Real.log x) ^ A
  simp only [hEval]
  calc
    (∑ q ∈ Q, ‖∑ n ∈ Finset.Icc ⌈u⌉₊ ⌊v⌋₊, Wq q n‖) ≤
        ∑ q ∈ Q, (‖P q v‖ + ‖P q u‖ + ‖E q u‖) := by
      apply Finset.sum_le_sum
      intro q _
      have heq := hclosed_prefix (Wq q) u v hu1 huv
      change (∑ n ∈ Finset.Icc ⌈u⌉₊ ⌊v⌋₊, Wq q n) = P q v - P q u + E q u at heq
      rw [heq]
      exact (norm_add_le _ _).trans (add_le_add (norm_sub_le _ _) le_rfl)
    _ = (∑ q ∈ Q, ‖P q v‖) + (∑ q ∈ Q, ‖P q u‖) + ∑ q ∈ Q, ‖E q u‖ := by
      rw [Finset.sum_add_distrib, Finset.sum_add_distrib]
    _ ≤ (CD * v / (Real.log x) ^ A + ((N : ℝ) + 1) * Remainder) +
        (CD * u / (Real.log x) ^ A + ((N : ℝ) + 1) * Remainder) + Remainder :=
      add_le_add (add_le_add hPv hPu) hEu
    _ = (CD * v / (Real.log x) ^ A + CD * u / (Real.log x) ^ A) +
        (2 * ((N : ℝ) + 1) + 1) * Remainder := by ring
    _ ≤ 4 * CD * x / (Real.log x) ^ A + 3 * CN * KB * L * x / (Real.log x) ^ A :=
      add_le_add hMainScale hRtotal
    _ = K * x / (Real.log x) ^ A := by dsimp only [K]; ring

theorem sourceLowerTypeIOne_normalized_envelope
    (δ x H N R Q r q P Y E : ℝ)
    (hx : 1 ≤ x) (hH : 0 < H) (hN : 0 < N) (hR : 0 < R) (hQ : 0 < Q)
    (hr : R ≤ r) (hq : 1 ≤ q) (hP : 0 < P) (hY : 0 < Y)
    (hYx : Y ≤ x ^ δ) (hPupper : P ≤ 16 * R * Q ^ 3 / q ^ 2)
    (h₁ : H ^ 2 * Real.sqrt Q * R ^ (1 / 6 : ℝ) *
      x ^ (δ / 6) / Real.sqrt N ≤ E)
    (h₂ : H ^ 2 / R ≤ E) (h₃ : H / Q ≤ E) :
    (N / q) *
        ((5 * H) ^ 2 * (2 * Q / q) ^ 2 *
            (Real.sqrt (N / q) * (P * Y) ^ (1 / 6 : ℝ)) +
          (N / q / r) * (5 * H) * (2 * Q / q) * (4 * H * Q / q + r)) ≤
      250 * (N * Q / q) ^ 2 * E := by
  have hxpos : 0 < x := zero_lt_one.trans_le hx
  have hrpos : 0 < r := hR.trans_le hr
  have hqpos : 0 < q := zero_lt_one.trans_le hq
  have hlogq : 0 ≤ Real.log q := Real.log_nonneg hq
  have hlog2 : 0 ≤ Real.log 2 := Real.log_nonneg (by norm_num)
  have hlog16 : Real.log 16 = 4 * Real.log 2 := by
    rw [show (16 : ℝ) = 2 ^ 4 by norm_num, Real.log_pow]
    norm_num
  have hlogP := Real.log_le_log hP hPupper
  have hlogY := Real.log_le_log hY hYx
  simp (disch := positivity) only [Real.log_div, Real.log_mul, Real.log_pow,
    Real.log_rpow, Nat.cast_ofNat, hlog16] at hlogP hlogY
  have hdeep : (N / q) * (5 * H) ^ 2 * (2 * Q / q) ^ 2 *
      (Real.sqrt (N / q) * (P * Y) ^ (1 / 6 : ℝ)) ≤
        200 * (N * Q / q) ^ 2 *
          (H ^ 2 * Real.sqrt Q * R ^ (1 / 6 : ℝ) *
            x ^ (δ / 6) / Real.sqrt N) := by
    apply (Real.log_le_log_iff (by positivity) (by positivity)).mp
    have hlog200 : Real.log 200 = 3 * Real.log 2 + 2 * Real.log 5 := by
      rw [show (200 : ℝ) = 2 ^ 3 * 5 ^ 2 by norm_num,
        Real.log_mul (by norm_num) (by norm_num), Real.log_pow, Real.log_pow]
      norm_num
    simp (disch := positivity) only [Real.sqrt_eq_rpow, Real.log_div, Real.log_mul,
      Real.log_pow, Real.log_rpow, Nat.cast_ofNat, hlog200]
    nlinarith only [hlogP, hlogY, hlogq, hlog2]
  have hq₂ : 1 ≤ q ^ 2 := one_le_pow₀ hq
  have hsecond : H ^ 2 / (q ^ 2 * r) ≤ E :=
    (div_le_div_of_nonneg_left (sq_nonneg H) hR
      (hr.trans (le_mul_of_one_le_left hrpos.le hq₂))).trans h₂
  have hthird : H / (q * Q) ≤ E :=
    (div_le_div_of_nonneg_left hH.le hQ
      (le_mul_of_one_le_left hQ.le hq)).trans h₃
  have hmean : (N / q) * (N / q / r) * (5 * H) * (2 * Q / q) *
      (4 * H * Q / q + r) ≤ (N * Q / q) ^ 2 * (40 * E + 10 * E) := by
    calc
      _ = (N * Q / q) ^ 2 *
          (40 * (H ^ 2 / (q ^ 2 * r)) + 10 * (H / (q * Q))) := by
        field_simp [hqpos.ne', hrpos.ne', hQ.ne']
        ring
      _ ≤ _ := by gcongr
  calc
    _ = (N / q) * (5 * H) ^ 2 * (2 * Q / q) ^ 2 *
        (Real.sqrt (N / q) * (P * Y) ^ (1 / 6 : ℝ)) +
          (N / q) * (N / q / r) * (5 * H) * (2 * Q / q) *
            (4 * H * Q / q + r) := by ring
    _ ≤ 200 * (N * Q / q) ^ 2 * E + (N * Q / q) ^ 2 * (40 * E + 10 * E) :=
      add_le_add (hdeep.trans (mul_le_mul_of_nonneg_left h₁ (by positivity))) hmean
    _ = _ := by ring

open Classical in
theorem sourceLowerTypeIOne_geometry
    («ω» δ σ ρ x M N R Q H γ : ℝ) (r q₀ q₁ : ℕ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hσ : 0 ≤ σ) (hρ : 0 < ρ)
    (hmargin : 54 * «ω» + 15 * δ + 5 * σ + 10000 * ρ < 1)
    (hx : 16 ≤ x) (hxρ : 2 ≤ x ^ ρ)
    (hM : 0 < M) (hN : 0 < N) (hR : 0 < R) (hQ : 0 < Q)
    (hq₀ : 0 < q₀) (hq₁ : 0 < q₁)
    (hMN : x ^ (1 - ρ) ≤ M * N) (hNγ : N = x ^ γ)
    (hNR : x ^ (-δ - 6 * ρ) * N ≤ R)
    (hRN : R ≤ x ^ (-4 * ρ) * N)
    (hRQ : R * Q ≤ x ^ (1 / 2 + 2 * «ω» + ρ))
    (hγlo : 1 / 2 - σ ≤ γ) (hγhi : γ ≤ 1 / 2)
    (hRr : R ≤ (r : ℝ)) (hrR : (r : ℝ) ≤ 2 * R)
    (hH : H = x ^ ρ * R * Q ^ 2 / ((q₀ : ℝ) * M)) (hHone : 1 ≤ H)
    (hq₁Q : (q₀ : ℝ) * (q₁ : ℝ) ≤ 2 * Q) :
    let HN : ℕ := ⌊2 * H⌋₊
    let KN : ℕ := ⌊2 * Q / (q₀ : ℝ)⌋₊
    let P₀ : ℝ := (r : ℝ) * (q₀ : ℝ) * (q₁ : ℝ) * (KN : ℝ) ^ 2
    (q₀ : ℝ) ≤ N ∧ N ≤ (r : ℝ) ^ (3 : ℝ) ∧ (r : ℝ) ≤ x ^ (10 : ℝ) ∧
      (HN : ℝ) * (KN : ℝ) ≤ x ^ (10 : ℝ) ∧ P₀ ≤ x ^ (10 : ℝ) ∧
      P₀ ≤ 16 * R * Q ^ 3 / (q₀ : ℝ) ^ 2 ∧
      (HN : ℝ) * (KN : ℝ) ≤ 4 * H * Q / (q₀ : ℝ) := by
  intro HN KN P₀
  have hxgt : 1 < x := by linarith only [hx]
  have hxpos : 0 < x := by linarith only [hx]
  have hqpos : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀
  have hqone : 1 ≤ (q₀ : ℝ) := by exact_mod_cast hq₀
  have hq₁one : 1 ≤ (q₁ : ℝ) := by exact_mod_cast hq₁
  have hrpos : 0 < (r : ℝ) := hR.trans_le hRr
  have hHpos : 0 < H := zero_lt_one.trans_le hHone
  have hNlo : x ^ (1 / 2 - σ) ≤ N := by
    rw [hNγ]
    exact Real.rpow_le_rpow_of_exponent_le hxgt.le hγlo
  obtain ⟨hQN, hNRcube⟩ := lower_order_correlation_length_gates
    x N R Q «ω» δ σ ρ hxgt hN hR hQ hxρ hNlo hNR hRQ
      (by linarith only [hmargin, hω, hδ, hσ, hρ])
      (by linarith only [hmargin, hω, hδ, hσ, hρ])
  have hqQ : (q₀ : ℝ) ≤ 2 * Q :=
    (le_mul_of_one_le_right hqpos.le hq₁one).trans hq₁Q
  have hqN : (q₀ : ℝ) ≤ N := hqQ.trans hQN
  have hNr : N ≤ (r : ℝ) ^ (3 : ℝ) := by
    calc
      N ≤ (r : ℝ) ^ 3 := hNRcube.trans (pow_le_pow_left₀ hR.le hRr 3)
      _ = (r : ℝ) ^ (3 : ℝ) := (Real.rpow_natCast (r : ℝ) 3).symm
  have hNhi : N ≤ x ^ (1 / 2 : ℝ) := by
    rw [hNγ]
    exact Real.rpow_le_rpow_of_exponent_le hxgt.le hγhi
  have hRhi : R ≤ x ^ (1 / 2 : ℝ) := by
    apply hRN.trans
    have hp : x ^ (-4 * ρ) ≤ 1 := Real.rpow_le_one_of_one_le_of_nonpos hxgt.le (by linarith)
    exact (mul_le_of_le_one_left hN.le hp).trans hNhi
  have hlogx : 0 < Real.log x := Real.log_pos hxgt
  have hlogR := Real.log_le_log (mul_pos (Real.rpow_pos_of_pos hxpos _) hN) hNR
  have hlogRQ := Real.log_le_log (mul_pos hR hQ) hRQ
  have hlogNlo := Real.log_le_log (Real.rpow_pos_of_pos hxpos _) hNlo
  simp (disch := positivity) only [Real.log_mul, Real.log_rpow] at hlogR hlogRQ hlogNlo
  have hQx : Q ≤ x := by
    apply (Real.log_le_log_iff hQ hxpos).mp
    have he : σ + 2 * «ω» + δ + 7 * ρ ≤ 1 := by
      linarith only [hmargin, hω, hδ, hσ, hρ]
    nlinarith only [hlogR, hlogRQ, hlogNlo, he, hlogx]
  have hHx : H ≤ x ^ (3 : ℝ) := by
    apply (Real.log_le_log_iff hHpos (Real.rpow_pos_of_pos hxpos _)).mp
    have hlogH := congrArg Real.log hH
    have hlogMN := Real.log_le_log (Real.rpow_pos_of_pos hxpos _) hMN
    have hlogRhi := Real.log_le_log hR hRhi
    have hlogNhi := Real.log_le_log hN hNhi
    have hlogQ := Real.log_le_log hQ hQx
    have hlogq : 0 ≤ Real.log (q₀ : ℝ) := Real.log_nonneg hqone
    simp (disch := positivity) only [Real.log_mul, Real.log_div, Real.log_pow,
      Real.log_rpow, Nat.cast_ofNat] at hlogH hlogMN hlogRhi hlogNhi ⊢
    have he : 2 * ρ + 2 ≤ 3 := by linarith only [hmargin, hω, hδ, hσ, hρ]
    nlinarith only [hlogH, hlogMN, hlogRhi, hlogNhi, hlogQ, hlogq, he, hlogx]
  have hHN : (HN : ℝ) ≤ 2 * H := Nat.floor_le (by positivity)
  have hKN : (KN : ℝ) ≤ 2 * Q / (q₀ : ℝ) := Nat.floor_le (by positivity)
  have hHK : (HN : ℝ) * (KN : ℝ) ≤ 4 * H * Q / (q₀ : ℝ) := by
    calc
      _ ≤ (2 * H) * (2 * Q / (q₀ : ℝ)) :=
        mul_le_mul hHN hKN (Nat.cast_nonneg _) (by positivity)
      _ = _ := by ring
  have hP : P₀ ≤ 16 * R * Q ^ 3 / (q₀ : ℝ) ^ 2 := by
    calc
      P₀ = (r : ℝ) * ((q₀ : ℝ) * (q₁ : ℝ)) * (KN : ℝ) ^ 2 := by
        dsimp only [P₀]
        ring
      _ ≤ (2 * R) * (2 * Q) * (2 * Q / (q₀ : ℝ)) ^ 2 := by gcongr
      _ = _ := by field_simp; ring
  have hrx : (r : ℝ) ≤ x ^ (10 : ℝ) := by
    calc
      _ ≤ 2 * R := hrR
      _ ≤ x * x ^ (1 / 2 : ℝ) := mul_le_mul (by linarith only [hx]) hRhi hR.le hxpos.le
      _ = x ^ (3 / 2 : ℝ) := by
        calc
          x * x ^ (1 / 2 : ℝ) = x ^ (1 : ℝ) * x ^ (1 / 2 : ℝ) := by rw [Real.rpow_one]
          _ = x ^ ((1 : ℝ) + 1 / 2) := (Real.rpow_add hxpos _ _).symm
          _ = _ := by norm_num
      _ ≤ _ := Real.rpow_le_rpow_of_exponent_le hxgt.le (by norm_num)
  have hHKx : (HN : ℝ) * (KN : ℝ) ≤ x ^ (10 : ℝ) := by
    calc
      _ ≤ 4 * H * Q / (q₀ : ℝ) := hHK
      _ ≤ 4 * H * Q := div_le_self (by positivity) hqone
      _ ≤ x * x ^ (3 : ℝ) * x := by gcongr; linarith only [hx]
      _ = x ^ (5 : ℝ) := by
        calc
          x * x ^ (3 : ℝ) * x = x ^ (1 : ℝ) * x ^ (3 : ℝ) * x ^ (1 : ℝ) := by
            rw [Real.rpow_one]
          _ = x ^ ((1 : ℝ) + 3 + 1) := by rw [Real.rpow_add hxpos, Real.rpow_add hxpos]
          _ = _ := by norm_num
      _ ≤ _ := Real.rpow_le_rpow_of_exponent_le hxgt.le (by norm_num)
  have hPx : P₀ ≤ x ^ (10 : ℝ) := by
    calc
      _ ≤ 16 * R * Q ^ 3 / (q₀ : ℝ) ^ 2 := hP
      _ ≤ 16 * R * Q ^ 3 := div_le_self (by positivity) (one_le_pow₀ hqone)
      _ ≤ x * x ^ (1 / 2 : ℝ) * x ^ 3 := by gcongr
      _ = x ^ (9 / 2 : ℝ) := by
        calc
          x * x ^ (1 / 2 : ℝ) * x ^ 3 =
              x ^ (1 : ℝ) * x ^ (1 / 2 : ℝ) * x ^ (3 : ℝ) := by
            rw [Real.rpow_one, show x ^ (3 : ℝ) = x ^ 3 from Real.rpow_natCast x 3]
          _ = x ^ ((1 : ℝ) + 1 / 2 + 3) := by rw [Real.rpow_add hxpos, Real.rpow_add hxpos]
          _ = _ := by norm_num
      _ ≤ _ := Real.rpow_le_rpow_of_exponent_le hxgt.le (by norm_num)
  exact ⟨hqN, hNr, hrx, hHKx, hPx, hP, hHK⟩

theorem sourceLowerTwo_scale_envelopes
    («ω» δ ε C x M N R Q H q γ V : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε)
    (hC : 1 ≤ C) (hx : 1 ≤ x)
    (hM : 0 < M) (hN : 0 < N) (hR : 0 < R) (hQ : 0 < Q)
    (hq : 1 ≤ q) (hV : 0 < V)
    (hMN : x / C ≤ M * N) (hNγ : N = x ^ γ)
    (hNR : N ≤ C * x ^ (δ + 4 * ε) * R)
    (hRQ : R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε))
    (hH : H = x ^ ε * R * Q ^ 2 / (q * M))
    (hγlo : 1 / 4 + 14 * «ω» + 4 * δ + 100 * ε ≤ γ)
    (hVlo : x ^ (5 * ε) * H / q ≤ C * V) :
    H ^ (13 / 6 : ℝ) * Q ^ (1 / 3 : ℝ) * R ^ (1 / 6 : ℝ) *
        x ^ (δ / 3 + 5 * ε / 6) / N ^ (1 / 2 : ℝ) ≤ C ^ 12 * x ^ (-5 * ε) ∧
      H ^ 2 / R ≤ C ^ 12 * x ^ (-5 * ε) ∧
      H / (V * q) ≤ C ^ 12 * x ^ (-5 * ε) := by
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hxpos : 0 < x := zero_lt_one.trans_le hx
  have hqpos : 0 < q := zero_lt_one.trans_le hq
  have hHpos : 0 < H := by rw [hH]; positivity
  have hlogx : 0 ≤ Real.log x := Real.log_nonneg hx
  have hlogC : 0 ≤ Real.log C := Real.log_nonneg hC
  have hlogq : 0 ≤ Real.log q := Real.log_nonneg hq
  have hlogMN : Real.log x - Real.log C ≤ Real.log M + Real.log N := by
    have hh := Real.log_le_log (by positivity : 0 < x / C) hMN
    simpa (disch := positivity) only [Real.log_div, Real.log_mul] using hh
  have hlogN : Real.log N = γ * Real.log x := by rw [hNγ, Real.log_rpow hxpos]
  have hlogNR : Real.log N ≤
      Real.log C + (δ + 4 * ε) * Real.log x + Real.log R := by
    have hh := Real.log_le_log hN hNR
    simpa (disch := positivity) only [Real.log_mul, Real.log_rpow] using hh
  have hlogRQ : Real.log R + Real.log Q ≤
      Real.log C + (1 / 2 + 2 * «ω» + ε) * Real.log x := by
    have hh := Real.log_le_log (mul_pos hR hQ) hRQ
    simpa (disch := positivity) only [Real.log_mul, Real.log_rpow] using hh
  have hlogH : Real.log H = ε * Real.log x + Real.log R +
      2 * Real.log Q - Real.log q - Real.log M := by
    rw [hH]
    simp (disch := positivity) only [Real.log_div, Real.log_mul, Real.log_rpow, Real.log_pow]
    ring
  have hbound {z p : ℝ} (hz : 0 < z)
      (hzlog : Real.log z ≤ 12 * Real.log C + p * Real.log x) :
      z ≤ C ^ 12 * x ^ p := by
    apply (Real.log_le_log_iff hz (by positivity)).mp
    simpa (disch := positivity) only [Real.log_mul, Real.log_pow,
      Real.log_rpow, Nat.cast_ofNat] using hzlog
  have htwo : Real.log (H ^ 2 / R) ≤ 9 * Real.log C +
      (8 * «ω» + 3 * δ + 18 * ε - γ) * Real.log x := by
    simp (disch := positivity) only [Real.log_div, Real.log_pow, Nat.cast_ofNat]
    nlinarith only [hlogMN, hlogNR, hlogRQ, hlogH, hlogN, hlogq]
  have he₁ : 1 / 6 + 28 * «ω» / 3 + 8 * δ / 3 + 17 * ε -
      2 * γ / 3 ≤ -5 * ε := by linarith only [hγlo, hε]
  have he₂ : 8 * «ω» + 3 * δ + 18 * ε - γ ≤ -5 * ε := by
    linarith only [hγlo, hε, hω, hδ]
  have hlogV : 5 * ε * Real.log x + Real.log H - Real.log q ≤
      Real.log C + Real.log V := by
    have hh := Real.log_le_log (by positivity : 0 < x ^ (5 * ε) * H / q) hVlo
    simpa (disch := positivity) only [Real.log_div, Real.log_mul, Real.log_rpow] using hh
  refine ⟨hbound (by positivity) ?_, hbound (by positivity) ?_,
    hbound (by positivity) ?_⟩
  · have hfirst :
        Real.log (H ^ (13 / 6 : ℝ) * Q ^ (1 / 3 : ℝ) * R ^ (1 / 6 : ℝ) *
          x ^ (δ / 3 + 5 * ε / 6) / N ^ (1 / 2 : ℝ)) ≤
        (55 / 6 : ℝ) * Real.log C +
          (1 / 6 + 28 * «ω» / 3 + 8 * δ / 3 + 17 * ε - 2 * γ / 3) * Real.log x := by
      simp (disch := positivity) only [Real.log_div, Real.log_mul, Real.log_rpow]
      nlinarith only [hlogMN, hlogNR, hlogRQ, hlogH, hlogN, hlogq]
    nlinarith only [hfirst, mul_le_mul_of_nonneg_right he₁ hlogx, hlogC]
  · nlinarith only [htwo, mul_le_mul_of_nonneg_right he₂ hlogx, hlogC]
  · simp (disch := positivity) only [Real.log_div, Real.log_mul]
    nlinarith only [hlogV, hlogC]

open Classical in
theorem opening_lower_scale_resources (C «ω» δ ε c : ℝ)
    (hC : 1 ≤ C) (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε)
    (hεhalf : ε < 1 / 2) (hc : 7 * ε < c) :
    ∀ᶠ x : ℝ in Filter.atTop,
      Real.exp 1 ≤ x ∧ 2 ≤ x ∧ C ^ 2 ≤ x ^ (c - 7 * ε) ∧
      ∀ M N R Q γ : ℝ,
        0 < M → 0 < N → 0 < R → 0 < Q →
        x / C ≤ M * N → M * N ≤ C * x → N = x ^ γ →
        1 / 4 + 2 * «ω» + δ + 5 * ε ≤ γ →
        γ ≤ 1 / 2 →
        N ≤ C * x ^ (δ + 4 * ε) * R →
        R ≤ C * x ^ (-2 * ε) * N →
        R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) →
        1 ≤ N ∧ N ≤ x ∧ 1 ≤ M ∧ M ≤ x ^ 2 ∧ R ≤ x ∧ Q ≤ x ∧
          4 * x ^ ε < M := by
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hmargin : 0 < c - 7 * ε := sub_pos.mpr hc
  have hCmargin : ∀ᶠ x : ℝ in Filter.atTop,
      C ^ 2 ≤ x ^ (c - 7 * ε) :=
    (tendsto_rpow_atTop hmargin).eventually_ge_atTop (C ^ 2)
  have hCquarter : ∀ᶠ x : ℝ in Filter.atTop, C ^ 2 ≤ x ^ (1 / 4 : ℝ) :=
    (tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 4)).eventually_ge_atTop
      (C ^ 2)
  have hCutoff := eventually_scale_dominates_cutoff_of_product_lower
    (1 / C) 1 (1 / 2) ε 4 (by positivity) (by norm_num) (by norm_num)
    (by linarith only [hεhalf])
  filter_upwards [Filter.eventually_ge_atTop (Real.exp 1),
    Filter.eventually_ge_atTop (2 : ℝ), hCmargin, hCquarter, hCutoff]
    with x hxe hx2 hCmarginAt hCquarterAt hCutoffAt
  refine ⟨hxe, hx2, hCmarginAt, ?_⟩
  intro M N R Q γ hM hN _hR hQ hMNlo hMNhi hNγ hγlo hγhi hNR hRupper hRQ
  have hxone : 1 ≤ x := (by norm_num : (1 : ℝ) ≤ 2).trans hx2
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  have hγlower : 1 / 4 + 2 * «ω» + δ + 5 * ε ≤ γ := hγlo
  have hγnonneg : 0 ≤ γ := by linarith only [hγlower, hω, hδ, hε]
  have hγhalf : γ ≤ 1 / 2 := by linarith only [hγhi, hω, hδ, hε]
  have hNhalf : N ≤ x ^ (1 / 2 : ℝ) := by
    rw [hNγ]
    exact Real.rpow_le_rpow_of_exponent_le hxone hγhalf
  have hhalf : x ^ (1 / 2 : ℝ) ≤ x := by
    simpa only [Real.rpow_one] using
      Real.rpow_le_rpow_of_exponent_le hxone (by norm_num : (1 / 2 : ℝ) ≤ 1)
  have hNone : 1 ≤ N := by
    rw [hNγ]
    exact Real.one_le_rpow hxone hγnonneg
  have hCpow : C ≤ C ^ 2 := by
    simpa only [mul_one, pow_two] using mul_le_mul_of_nonneg_left hC hCpos.le
  have hCquarterBound : C ≤ x ^ (1 / 4 : ℝ) := hCpow.trans hCquarterAt
  have hChalf : C ≤ x ^ (1 / 2 : ℝ) := hCquarterBound.trans
    (Real.rpow_le_rpow_of_exponent_le hxone (by norm_num : (1 / 4 : ℝ) ≤ 1 / 2))
  have hCx : C ≤ x := hChalf.trans hhalf
  have hMcut : 4 * x ^ ε < M := hCutoffAt M N hN
    (by simpa only [one_mul] using hNhalf)
    (by simpa only [one_div, div_eq_mul_inv, mul_comm, mul_one] using hMNlo)
  have hMone : 1 ≤ M := by
    have hxeone : 1 ≤ x ^ ε := Real.one_le_rpow hxone hε.le
    linarith only [hMcut, hxeone]
  have hMupper : M ≤ x ^ 2 := by
    calc
      M ≤ M * N := le_mul_of_one_le_right hM.le hNone
      _ ≤ C * x := hMNhi
      _ ≤ x * x := mul_le_mul_of_nonneg_right hCx hxpos.le
      _ = x ^ 2 := (pow_two x).symm
  have hRsmall : R ≤ x := by
    have hxnegative : x ^ (-2 * ε) ≤ 1 :=
      Real.rpow_le_one_of_one_le_of_nonpos hxone (by linarith only [hε])
    calc
      R ≤ C * x ^ (-2 * ε) * N := hRupper
      _ ≤ C * 1 * N := mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_left hxnegative hCpos.le) hN.le
      _ = C * N := by ring
      _ ≤ x ^ (1 / 2 : ℝ) * x ^ (1 / 2 : ℝ) :=
        mul_le_mul hChalf hNhalf hN.le (Real.rpow_nonneg hxpos.le _)
      _ = x := by rw [← Real.rpow_add hxpos]; norm_num
  have hQN : Q * N ≤ C ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε) := by
    calc
      Q * N ≤ Q * (C * x ^ (δ + 4 * ε) * R) :=
        mul_le_mul_of_nonneg_left hNR hQ.le
      _ = (C * x ^ (δ + 4 * ε)) * (R * Q) := by ring
      _ ≤ (C * x ^ (δ + 4 * ε)) * (C * x ^ (1 / 2 + 2 * «ω» + ε)) :=
        mul_le_mul_of_nonneg_left hRQ (by positivity)
      _ = C ^ 2 * (x ^ (δ + 4 * ε) * x ^ (1 / 2 + 2 * «ω» + ε)) := by ring
      _ = C ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε) := by
        rw [← Real.rpow_add hxpos,
          show δ + 4 * ε + (1 / 2 + 2 * «ω» + ε) =
            1 / 2 + 2 * «ω» + δ + 5 * ε by ring]
  have hQsmall : Q ≤ x := by
    have hpower : 1 / 2 + 2 * «ω» + δ + 5 * ε - γ ≤ 1 / 4 := by
      linarith only [hγlower, hω, hδ, hε]
    calc
      Q ≤ (C ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε)) / N :=
        (le_div_iff₀ hN).mpr hQN
      _ = C ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε - γ) := by
        rw [hNγ, mul_div_assoc, ← Real.rpow_sub hxpos]
      _ ≤ C ^ 2 * x ^ (1 / 4 : ℝ) := mul_le_mul_of_nonneg_left
        (Real.rpow_le_rpow_of_exponent_le hxone hpower) (sq_nonneg C)
      _ ≤ x ^ (1 / 4 : ℝ) * x ^ (1 / 4 : ℝ) :=
        mul_le_mul_of_nonneg_right hCquarterAt (Real.rpow_nonneg hxpos.le _)
      _ = x ^ (1 / 2 : ℝ) := by rw [← Real.rpow_add hxpos]; norm_num
      _ ≤ x := hhalf
  exact ⟨hNone, hNhalf.trans hhalf, hMone, hMupper, hRsmall, hQsmall, hMcut⟩

open Classical in
theorem opening_lower_diagonal
    (d : ℕ) («ω» δ ε K T Bβ L Eβ Eψ A : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε)
    (hK : 1 ≤ K) (hT : 0 < T) (hBβ : 0 ≤ Bβ) (hL : 0 ≤ L)
    (hA : 0 ≤ A) :
    ∀ᶠ x : ℝ in Filter.atTop,
      ∀ (γ M Q R : ℝ) (N : ℕ),
        4 * «ω» + δ + 6 * ε ≤ γ →
        γ ≤ 1 / 2 →
        0 < M → 0 < Q → 0 < R →
        x / K ≤ M * x ^ γ → M * x ^ γ ≤ K * x →
        x ^ (-δ - 4 * ε) * x ^ γ / K ≤ R →
        R ≤ K * x ^ (-2 * ε) * x ^ γ →
        R * Q ≤ K * x ^ (1 / 2 + 2 * «ω» + ε) →
        (N : ℝ) ≤ K * x ^ γ →
        ∀ (S : Finset (ℕ × ℕ)) (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ),
          β.support ⊆ Finset.Icc 1 N →
          (∀ n ∈ β.support,
            ‖β n‖ ≤ Bβ * (n.divisors.card : ℝ) ^ d * (Real.log x) ^ Eβ) →
          (∀ p ∈ S, ‖c p‖ ≤ 1) →
          (∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Nat.Coprime p.1 p.2 ∧
            Q ≤ (p.1 : ℝ) ∧ (p.1 : ℝ) ≤ 2 * Q ∧
            R ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ 2 * R) →
          ∀ (a b₁ b₂ : ℕ) (ψ : ℝ → ℝ),
            (∀ t : ℝ, |ψ t| ≤ L * (Real.log x) ^ Eψ) →
            let sm : Finset ℕ := Finset.Icc 1 ⌊T * M⌋₊
            let w : ℕ → ℝ := fun n => ψ ((n : ℝ) / M)
            (∑ r ∈ S.image Prod.snd,
              ∑ p₁ ∈ S.filter (fun p => p.2 = r),
                ∑ p₂ ∈ S.filter (fun p => p.2 = r),
                  ‖c p₁ * star (c p₂) *
                    (∑ n ∈ β.support, β n * star (β n) *
                      (mixedFiberMass sm w p₁.1 p₂.1 r a b₁ b₂ n n : ℂ))‖) ≤
              M * (x ^ γ) ^ 2 / R * (Real.log x) ^ (-A) := by
  have hKpos : 0 < K := zero_lt_one.trans_le hK
  obtain ⟨C, hC, hfinite⟩ := mixedFiberMass_diagonal_family_subpower_majorant d ε hε
  let F : ℝ := T * K ^ 2
  let H : ℝ := 24 * F + 8 * K ^ 3
  let D : ℝ := C * Bβ ^ 2 * L * F ^ ε * H
  let E : ℝ := 2 * Eβ + Eψ + 4
  have hF : 0 < F := by dsimp [F]; positivity
  have hsmall : ∀ᶠ x : ℝ in Filter.atTop,
      ‖D * K ^ 2 * (Real.log x) ^ (E + A)‖ ≤ ‖x ^ ε‖ :=
    ((isLittleO_log_rpow_rpow_atTop (E + A) hε).const_mul_left
      (D * K ^ 2)).eventuallyLE
  have hlarge : ∀ᶠ x : ℝ in Filter.atTop, 2 * K ^ 2 ≤ x ^ ((1 : ℝ) / 2) :=
    (tendsto_rpow_atTop one_half_pos).eventually_ge_atTop _
  filter_upwards [hsmall, hlarge, Filter.eventually_ge_atTop (Real.exp 1)]
    with x hxsmall hxlarge hx
  intro γ M Q R N hγlower hγupper hM hQ hR hMNlower hMNupper hRlower hRupper hRQ hN
    S β c hsupport hβ hc hS a b₁ b₂ ψ hψ sm w
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
  have hxone : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hx
  have hlogone : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hx
  have hlog : 0 ≤ Real.log x := zero_le_one.trans hlogone
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlogone
  have hdecay : 0 ≤ (Real.log x) ^ (-A) := by
    rw [Real.rpow_neg hlog]
    exact inv_nonneg.mpr (zero_le_one.trans (Real.one_le_rpow hlogone hA))
  have hγpos : 0 < γ := by linarith only [hγlower, hω, hδ, hε]
  have hxγ : 0 < x ^ γ := zero_lt_one.trans_le (Real.one_le_rpow hxone hγpos.le)
  let U : ℕ := ⌊2 * Q⌋₊
  let V : ℕ := ⌊2 * R⌋₊
  let X : ℕ := ⌊T * M⌋₊ * N
  have hUcap : (U : ℝ) ≤ 2 * Q := Nat.floor_le (by positivity)
  have hVcap : (V : ℝ) ≤ 2 * R := Nat.floor_le (by positivity)
  have hX : (X : ℝ) ≤ F * x := by
    calc
      _ = (⌊T * M⌋₊ : ℝ) * (N : ℝ) := Nat.cast_mul _ _
      _ ≤ (T * M) * (K * x ^ γ) :=
        mul_le_mul (Nat.floor_le (by positivity)) hN
          (Nat.cast_nonneg N) (mul_nonneg hT.le hM.le)
      _ = T * K * (M * x ^ γ) := by ring
      _ ≤ T * K * (K * x) :=
        mul_le_mul_of_nonneg_left hMNupper (mul_nonneg hT.le hKpos.le)
      _ = F * x := by dsimp [F]; ring
  have hQbound : Q ≤ K ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε - γ) := by
    calc
      _ ≤ (K * x ^ (1 / 2 + 2 * «ω» + ε)) /
          (x ^ (-δ - 4 * ε) * x ^ γ / K) := by
        apply (le_div_iff₀ (by positivity)).mpr
        simpa only [mul_comm] using
          (mul_le_mul_of_nonneg_right hRlower hQ.le).trans hRQ
      _ = K ^ 2 *
          (x ^ (1 / 2 + 2 * «ω» + ε) / (x ^ (-δ - 4 * ε) * x ^ γ)) := by
        rw [div_div_eq_mul_div]
        ring
      _ = K ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε - γ) := by
        rw [← Real.rpow_add hxpos, ← Real.rpow_sub hxpos]
        congr 2
        ring
  have hQhalf : Q ≤ K ^ 2 * x ^ ((1 : ℝ) / 2) :=
    hQbound.trans (mul_le_mul_of_nonneg_left
      (Real.rpow_le_rpow_of_exponent_le hxone
        (by linarith only [hγlower, hω, hδ, hε])) (sq_nonneg K))
  have hRhalf : R ≤ K ^ 2 * x ^ ((1 : ℝ) / 2) := by
    calc
      _ ≤ K * x ^ (-2 * ε) * x ^ γ := hRupper
      _ = K * x ^ (γ - 2 * ε) := by
        rw [mul_assoc, ← Real.rpow_add hxpos]
        congr 2
        ring
      _ ≤ K * x ^ ((1 : ℝ) / 2) :=
        mul_le_mul_of_nonneg_left
          (Real.rpow_le_rpow_of_exponent_le hxone (by linarith)) hKpos.le
      _ ≤ K ^ 2 * x ^ ((1 : ℝ) / 2) :=
        mul_le_mul_of_nonneg_right (le_self_pow₀ hK two_ne_zero)
          (Real.rpow_nonneg hxpos.le _)
  have hcap (u : ℝ) (hu : u ≤ K ^ 2 * x ^ ((1 : ℝ) / 2)) : 2 * u ≤ x := by
    calc
      _ ≤ 2 * (K ^ 2 * x ^ ((1 : ℝ) / 2)) :=
        mul_le_mul_of_nonneg_left hu zero_le_two
      _ = (2 * K ^ 2) * x ^ ((1 : ℝ) / 2) := by ring
      _ ≤ x ^ ((1 : ℝ) / 2) * x ^ ((1 : ℝ) / 2) :=
        mul_le_mul_of_nonneg_right hxlarge (Real.rpow_nonneg hxpos.le _)
      _ = x := by rw [← Real.rpow_add hxpos]; norm_num
  have hU : (U : ℝ) ≤ x := hUcap.trans (hcap Q hQhalf)
  have hV : (V : ℝ) ≤ x := hVcap.trans (hcap R hRhalf)
  have hlogcap (n : ℕ) (hn : (n : ℝ) ≤ x) : Real.log (n : ℝ) ≤ Real.log x := by
    by_cases hn0 : n = 0
    · simpa only [hn0, Nat.cast_zero, Real.log_zero] using hlog
    · exact Real.log_le_log (Nat.cast_pos.mpr (Nat.pos_of_ne_zero hn0)) hn
  have hu : 1 + Real.log (U : ℝ) ≤ 2 * Real.log x := by
    linarith [hlogcap U hU]
  have hv : 1 + Real.log (V : ℝ) ≤ 2 * Real.log x := by
    linarith [hlogcap V hV]
  have hu₃ : 2 + Real.log (U : ℝ) ≤ 3 * Real.log x := by
    linarith [hlogcap U hU]
  have hlogs :
      (1 + Real.log (V : ℝ)) * (1 + Real.log (U : ℝ)) ^ 2 *
        (2 + Real.log (U : ℝ)) ≤ 24 * (Real.log x) ^ 4 := by
    calc
      _ ≤ (2 * Real.log x) * (2 * Real.log x) ^ 2 * (3 * Real.log x) :=
        mul_le_mul
          (mul_le_mul hv (pow_le_pow_left₀ (by positivity) hu 2)
            (sq_nonneg _) (by positivity))
          hu₃ (by positivity) (by positivity)
      _ = _ := by ring
  have hendpoint : (V : ℝ) * (U : ℝ) ^ 2 ≤ 8 * K ^ 3 * x := by
    calc
      _ ≤ (2 * R) * (2 * Q) ^ 2 :=
        mul_le_mul hVcap (pow_le_pow_left₀ (Nat.cast_nonneg U) hUcap 2)
          (sq_nonneg _) (by positivity)
      _ = 8 * (R * Q) * Q := by ring
      _ ≤ 8 * (K * x ^ (1 / 2 + 2 * «ω» + ε)) *
          (K ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε - γ)) :=
        mul_le_mul (mul_le_mul_of_nonneg_left hRQ (by norm_num)) hQbound
          hQ.le (by positivity)
      _ = 8 * K ^ 3 *
          (x ^ (1 / 2 + 2 * «ω» + ε) * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε - γ)) := by
        ring
      _ = 8 * K ^ 3 * x ^ (1 + 4 * «ω» + δ + 6 * ε - γ) := by
        rw [← Real.rpow_add hxpos]
        congr 2
        ring
      _ ≤ 8 * K ^ 3 * x := by
        apply mul_le_mul_of_nonneg_left _ (by positivity)
        simpa only [Real.rpow_one] using
          Real.rpow_le_rpow_of_exponent_le hxone
            (show 1 + 4 * «ω» + δ + 6 * ε - γ ≤ 1 by linarith)
  have hcount :
      (X : ℝ) * (1 + Real.log (V : ℝ)) * (1 + Real.log (U : ℝ)) ^ 2 *
        (2 + Real.log (U : ℝ)) + (V : ℝ) * (U : ℝ) ^ 2 ≤
          H * x * (Real.log x) ^ 4 := by
    calc
      _ = (X : ℝ) * ((1 + Real.log (V : ℝ)) * (1 + Real.log (U : ℝ)) ^ 2 *
          (2 + Real.log (U : ℝ))) + (V : ℝ) * (U : ℝ) ^ 2 := by ring
      _ ≤ (F * x) * (24 * (Real.log x) ^ 4) + 8 * K ^ 3 * x :=
        add_le_add (mul_le_mul hX hlogs (by positivity) (by positivity)) hendpoint
      _ ≤ (F * x) * (24 * (Real.log x) ^ 4) +
          (8 * K ^ 3 * x) * (Real.log x) ^ 4 :=
        add_le_add le_rfl (le_mul_of_one_le_right (by positivity : 0 ≤ 8 * K ^ 3 * x)
          (one_le_pow₀ hlogone))
      _ = H * x * (Real.log x) ^ 4 := by dsimp [H]; ring
  have hXp : (X : ℝ) ^ ε ≤ F ^ ε * x ^ ε :=
    (Real.rpow_le_rpow (Nat.cast_nonneg X) hX hε.le).trans_eq
      (Real.mul_rpow hF.le hxpos.le)
  have hscale :
      x ^ (1 + 2 * ε) / K ^ 2 ≤ M * (x ^ γ) ^ 2 / R := by
    calc
      _ = (x / K * x ^ γ) / (K * x ^ (-2 * ε) * x ^ γ) := by
        calc
          _ = (1 / K ^ 2) * (x ^ ((1 : ℝ) - (-2 * ε))) := by
            rw [neg_mul, sub_neg_eq_add]
            ring
          _ = (x / K) / (K * x ^ (-2 * ε)) := by
            rw [Real.rpow_sub hxpos, Real.rpow_one]
            ring
          _ = _ := (mul_div_mul_right _ _ hxγ.ne').symm
      _ ≤ (M * x ^ γ * x ^ γ) / R :=
        div_le_div₀ (by positivity)
          (mul_le_mul_of_nonneg_right hMNlower hxγ.le) hR hRupper
      _ = _ := by ring
  have hfinite' := hfinite S sm w β c ⌊T * M⌋₊ N U V
    (Bβ * (Real.log x) ^ Eβ) (L * (Real.log x) ^ Eψ)
    (by positivity) (by positivity) Finset.Subset.rfl hsupport
    (fun n hn => by simpa only [mul_right_comm] using hβ n hn)
    (fun n _ => hψ ((n : ℝ) / M)) hc
    (fun p hp => by
      rcases hS p hp with ⟨hp₁, hp₂, _, _, hpQ, _, hpR⟩
      exact ⟨hp₁, Nat.le_floor hpQ, hp₂, Nat.le_floor hpR⟩)
    (fun p hp => (hS p hp).2.2.1) a b₁ b₂
  have hlogpower :
      ((Real.log x) ^ Eβ) ^ 2 * (Real.log x) ^ Eψ * (Real.log x) ^ 4 =
        (Real.log x) ^ E := by
    rw [← Real.rpow_mul_natCast hlog, ← Real.rpow_natCast,
      ← Real.rpow_add hlogpos, ← Real.rpow_add hlogpos]
    congr 1
    norm_num [E, mul_comm]
  have henvelope :
      C * (Bβ * (Real.log x) ^ Eβ) ^ 2 * (L * (Real.log x) ^ Eψ) *
        (X : ℝ) ^ ε *
        ((X : ℝ) * (1 + Real.log (V : ℝ)) * (1 + Real.log (U : ℝ)) ^ 2 *
          (2 + Real.log (U : ℝ)) + (V : ℝ) * (U : ℝ) ^ 2) ≤
        D * x ^ (1 + ε) * (Real.log x) ^ E := by
    calc
      _ ≤ C * (Bβ * (Real.log x) ^ Eβ) ^ 2 * (L * (Real.log x) ^ Eψ) *
          (F ^ ε * x ^ ε) * (H * x * (Real.log x) ^ 4) :=
        mul_le_mul (mul_le_mul_of_nonneg_left hXp (by positivity)) hcount
          (by positivity) (by positivity)
      _ = (C * Bβ ^ 2 * L * F ^ ε * H) * (x * x ^ ε) *
          (((Real.log x) ^ Eβ) ^ 2 * (Real.log x) ^ Eψ * (Real.log x) ^ 4) := by
        ring
      _ = D * x ^ (1 + ε) * (Real.log x) ^ E := by
        rw [hlogpower, Real.rpow_add hxpos, Real.rpow_one]
  have hsmall' : D * K ^ 2 * (Real.log x) ^ (E + A) ≤ x ^ ε :=
    (Real.le_norm_self _).trans
      (hxsmall.trans_eq (Real.norm_of_nonneg (Real.rpow_nonneg hxpos.le ε)))
  have hlogcancel : (Real.log x) ^ (E + A) * (Real.log x) ^ (-A) =
      (Real.log x) ^ E := by
    rw [← Real.rpow_add hlogpos, add_neg_cancel_right]
  have hscalar : D * (Real.log x) ^ E ≤
      (x ^ ε / K ^ 2) * (Real.log x) ^ (-A) := by
    calc
      _ = (D * K ^ 2 * (Real.log x) ^ (E + A)) / K ^ 2 *
          (Real.log x) ^ (-A) := by
        rw [mul_right_comm D (K ^ 2), mul_div_cancel_right₀ _ (pow_ne_zero 2 hKpos.ne'),
          mul_assoc D ((Real.log x) ^ (E + A)), hlogcancel]
      _ ≤ _ :=
        mul_le_mul_of_nonneg_right
          (div_le_div_of_nonneg_right hsmall' (sq_nonneg K))
          hdecay
  calc
    _ ≤ C * (Bβ * (Real.log x) ^ Eβ) ^ 2 * (L * (Real.log x) ^ Eψ) *
        (X : ℝ) ^ ε *
        ((X : ℝ) * (1 + Real.log (V : ℝ)) * (1 + Real.log (U : ℝ)) ^ 2 *
          (2 + Real.log (U : ℝ)) + (V : ℝ) * (U : ℝ) ^ 2) := hfinite'
    _ ≤ D * x ^ (1 + ε) * (Real.log x) ^ E := henvelope
    _ = x ^ (1 + ε) * (D * (Real.log x) ^ E) := by ring
    _ ≤ x ^ (1 + ε) * ((x ^ ε / K ^ 2) * (Real.log x) ^ (-A)) :=
      mul_le_mul_of_nonneg_left hscalar (Real.rpow_nonneg hxpos.le _)
    _ = (x ^ (1 + 2 * ε) / K ^ 2) * (Real.log x) ^ (-A) := by
      calc
        _ = (x ^ (1 + ε) * x ^ ε) / K ^ 2 * (Real.log x) ^ (-A) := by ring
        _ = _ := by
          rw [← Real.rpow_add hxpos, two_mul, add_assoc]
    _ ≤ _ := mul_le_mul_of_nonneg_right hscale hdecay

theorem opening_lower_selector_target
    (C x M N R Q g «ω» ε c γ : ℝ)
    (hC : 1 ≤ C) (hx : 1 < x)
    (hM : 0 < M) (hN : 0 < N) (hR : 0 < R) (hQ : 0 < Q) (hg : 0 < g)
    (hε : 0 ≤ ε) (hMN : x / C ≤ M * N) (hNγ : N = x ^ γ)
    (hRQ : R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε))
    (hγ : γ ≤ 1 / 2 - 2 * «ω» - c) :
    let H := x ^ ε * R * Q ^ 2 / (g * M)
    (g / C ^ 2) * x ^ (c - 7 * ε) ≤ x ^ (-5 * ε) * Q / H := by
  intro H
  have hx₀ : 0 < x := zero_lt_one.trans hx
  have hC₀ : 0 < C := zero_lt_one.trans_le hC
  have hxε : 0 < x ^ ε := zero_lt_one.trans_le (Real.one_le_rpow hx.le hε)
  have hMlo : x ^ (1 - γ) / C ≤ M := by
    calc
      _ = (x / C) / N := by rw [hNγ, Real.rpow_sub hx₀, Real.rpow_one]; ring
      _ ≤ M := (div_le_iff₀ hN).mpr hMN
  have hquot :
      (g * (x ^ (1 - γ) / C)) / (C * x ^ (1 / 2 + 2 * «ω» + ε)) ≤
        (g * M) / (R * Q) :=
    div_le_div₀ (mul_nonneg hg.le hM.le)
      (mul_le_mul_of_nonneg_left hMlo hg.le) (mul_pos hR hQ) hRQ
  have hpower : x ^ (-6 * ε) = x ^ (-5 * ε) / x ^ ε := by
    rw [← Real.rpow_sub hx₀]
    congr 1
    ring
  calc
    (g / C ^ 2) * x ^ (c - 7 * ε) ≤
        (g / C ^ 2) * x ^ (1 - γ - (1 / 2 + 2 * «ω» + ε) - 6 * ε) := by
      apply mul_le_mul_of_nonneg_left _ (by positivity)
      exact Real.rpow_le_rpow_of_exponent_le hx.le (by linarith only [hγ])
    _ = ((g * (x ^ (1 - γ) / C)) / (C * x ^ (1 / 2 + 2 * «ω» + ε))) *
        x ^ (-6 * ε) := by
      rw [Real.rpow_sub hx₀, Real.rpow_sub hx₀,
        show -6 * ε = -(6 * ε) by ring, Real.rpow_neg hx₀.le]
      ring
    _ ≤ ((g * M) / (R * Q)) * x ^ (-6 * ε) :=
      mul_le_mul_of_nonneg_right hquot (Real.rpow_nonneg hx₀.le _)
    _ = x ^ (-5 * ε) * Q / H := by
      rw [hpower]
      dsimp only [H]
      field_simp [hR.ne', hQ.ne', hg.ne', hM.ne', hxε.ne']

theorem opening_lower_selector_target_nat
    (C x M N R Q «ω» ε c γ : ℝ) (g : ℕ)
    (hC : 1 ≤ C) (hx : 1 < x)
    (hM : 0 < M) (hN : 0 < N) (hR : 0 < R) (hQ : 0 < Q) (hg : 0 < g)
    (hε : 0 ≤ ε) (hMN : x / C ≤ M * N) (hNγ : N = x ^ γ)
    (hRQ : R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε))
    (hγ : γ ≤ 1 / 2 - 2 * «ω» - c) :
    let H := x ^ ε * R * Q ^ 2 / ((g : ℝ) * M)
    (1 / C ^ 2) * x ^ (c - 7 * ε) ≤ x ^ (-5 * ε) * Q / H := by
  intro H
  have hg₁ : (1 : ℝ) ≤ g := by exact_mod_cast hg
  have hg₀ : (0 : ℝ) < g := zero_lt_one.trans_le hg₁
  calc
    (1 / C ^ 2) * x ^ (c - 7 * ε) ≤
        ((g : ℝ) / C ^ 2) * x ^ (c - 7 * ε) :=
      mul_le_mul_of_nonneg_right (div_le_div_of_nonneg_right hg₁ (sq_nonneg C))
        (Real.rpow_nonneg (zero_lt_one.trans hx).le _)
    _ ≤ _ := opening_lower_selector_target C x M N R Q g «ω» ε c γ
      hC hx hM hN hR hQ hg₀ hε hMN hNγ hRQ hγ

open Classical in
theorem heathBrown_geometric_grid_card_bound
    (n D : ℕ) (x : ℝ) (hx : Real.exp 1 ≤ x) :
    let Θ : ℝ := 1 + (Real.log x) ^ (-(D : ℝ))
    let M : ℕ := ⌈Real.log (2 * x) / Real.log Θ⌉₊
    let grid : Finset (Fin n → ℕ) :=
      Fintype.piFinset (fun _ : Fin n => Finset.range (M + 1))
    (grid.card : ℝ) ≤ (8 : ℝ) ^ n * (Real.log x) ^ (n * (D + 1)) := by
  intro Θ M grid
  let L := Real.log x
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
  have hL : 1 ≤ L := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hx
  have hLpos : 0 < L := zero_lt_one.trans_le hL
  have hxone : 1 ≤ x := (Real.one_le_exp (by norm_num)).trans hx
  have hΘ : 1 < Θ :=
    lt_add_of_pos_right 1 (Real.rpow_pos_of_pos hLpos _)
  have hΘtwo : Θ ≤ 2 := by
    have hsmall : L ^ (-(D : ℝ)) ≤ 1 :=
      Real.rpow_le_one_of_one_le_of_nonpos hL (neg_nonpos.mpr (Nat.cast_nonneg D))
    change 1 + L ^ (-(D : ℝ)) ≤ 2
    linarith
  obtain ⟨Cder, _, hgeometric⟩ :=
    heathBrown_geometric_profiles_uniform
  obtain ⟨_, _, _, _, hmesh⟩ := hgeometric Θ hΘ hΘtwo
  have hR : 1 ≤ 2 * x := by linarith
  have hM : ((M + 1 : ℕ) : ℝ) ≤ 2 * Real.log (2 * x) * L ^ D + 2 := by
    have hh := (hmesh (2 * x) hR).1
    change ((M + 1 : ℕ) : ℝ) ≤ 2 * Real.log (2 * x) / (Θ - 1) + 2 at hh
    change ((M + 1 : ℕ) : ℝ) ≤ _
    simpa only [Θ, L, add_sub_cancel_left, Real.rpow_neg hLpos.le,
      Real.rpow_natCast, div_inv_eq_mul] using hh
  have hlogR : Real.log (2 * x) ≤ 2 * L := by
    rw [Real.log_mul two_ne_zero hxpos.ne']
    have hlog2 := Real.log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2)
    change Real.log 2 + L ≤ 2 * L
    linarith
  have hM' : ((M + 1 : ℕ) : ℝ) ≤ 8 * L ^ (D + 1) := by
    have hh := mul_le_mul_of_nonneg_right hlogR (pow_nonneg hLpos.le D)
    have hone : 1 ≤ L ^ (D + 1) := one_le_pow₀ hL
    rw [pow_succ] at hone ⊢
    nlinarith
  have hcard : grid.card = (M + 1) ^ n := by
    simp only [grid, Fintype.card_piFinset, Finset.card_range, Finset.prod_const,
      Finset.card_univ, Fintype.card_fin]
  calc
    (grid.card : ℝ) = ((M + 1 : ℕ) : ℝ) ^ n := by rw [hcard, Nat.cast_pow]
    _ ≤ (8 * L ^ (D + 1)) ^ n :=
      pow_le_pow_left₀ (Nat.cast_nonneg _) hM' n
    _ = (8 : ℝ) ^ n * (Real.log x) ^ (n * (D + 1)) := by
      simp only [mul_pow, ← pow_mul, Nat.mul_comm, L]

open Classical in
theorem heathBrown_box_product_support_norm_bound
    {ι : Type*} (s : Finset ι) (hs : s.Nonempty)
    (β : ι → MonoidAlgebra ℂ ℕ) (N : ι → ℝ)
    (B : ℝ) (hB : 0 ≤ B)
    (hN : ∀ i ∈ s, 1 ≤ N i)
    (hsupport : ∀ i ∈ s, ∀ n ∈ (β i).coeff.support,
      N i / 2 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * N i)
    (hbound : ∀ i ∈ s, ∀ n : ℕ, ‖(β i).coeff n‖ ≤ B) :
    let P : ℝ := ∏ i ∈ s, N i
    (∀ n ∈ (∏ i ∈ s, β i).coeff.support,
      P / (2 : ℝ) ^ s.card ≤ (n : ℝ) ∧
        (n : ℝ) ≤ (2 : ℝ) ^ s.card * P) ∧
      ∀ n : ℕ, ‖(∏ i ∈ s, β i).coeff n‖ ≤
        B ^ s.card * (n.divisors.card : ℝ) ^ (s.card - 1) := by
  dsimp only
  have hNi (i : ι) (hi : i ∈ s) : 0 < N i :=
    zero_lt_one.trans_le (hN i hi)
  have hsupportProd : ∀ t : Finset ι, t ⊆ s →
      ∀ n ∈ (∏ i ∈ t, β i).coeff.support,
        (∏ i ∈ t, N i) / (2 : ℝ) ^ t.card ≤ (n : ℝ) ∧
          (n : ℝ) ≤ (2 : ℝ) ^ t.card * (∏ i ∈ t, N i) := by
    suffices h : ∀ t : Finset ι, t ⊆ s →
        ∀ n ∈ (∏ i ∈ t, β i).coeff.support,
          (∏ i ∈ t, N i / 2) ≤ (n : ℝ) ∧
            (n : ℝ) ≤ ∏ i ∈ t, 2 * N i by
      simpa [Finset.prod_mul_distrib] using h
    intro t
    induction t using Finset.induction_on with
    | empty => simp_all
    | @insert i t hit ih =>
        intro hts n hn
        have hi : i ∈ s := hts (Finset.mem_insert_self i t)
        have ht : t ⊆ s := (Finset.subset_insert i t).trans hts
        rw [Finset.prod_insert hit] at hn
        obtain ⟨a, ha, b, hb, rfl⟩ :=
          Finset.mem_mul.mp
            (MonoidAlgebra.support_coeff_mul_subset (β i) (∏ j ∈ t, β j) hn)
        obtain ⟨haLower, haUpper⟩ := hsupport i hi a ha
        obtain ⟨hbLower, hbUpper⟩ := ih ht b hb
        simp only [Finset.prod_insert hit, Nat.cast_mul]
        exact ⟨mul_le_mul_of_nonneg haLower hbLower
            (div_nonneg (hNi i hi).le zero_le_two) (Nat.cast_nonneg b),
          mul_le_mul haUpper hbUpper (Nat.cast_nonneg b)
            (mul_nonneg zero_le_two (hNi i hi).le)⟩
  have hprodZero (t : Finset ι) (ht : t ⊆ s) :
      (∏ i ∈ t, β i).coeff 0 = 0 := by
    exact Finsupp.notMem_support_iff.mp fun hn =>
      (div_pos (Finset.prod_pos (s := t) fun i hi => hNi i (ht hi))
        (pow_pos zero_lt_two t.card)).not_ge
          (by simpa using (hsupportProd t ht 0 hn).1)
  let T (v : MonoidAlgebra ℂ ℕ) : ArithmeticFunction ℂ :=
    toArithmeticFunction v.coeff
  have hTmul (v w : MonoidAlgebra ℂ ℕ) : T (v * w) = T v * T w := by
    rw [← ArithmeticFunction.toArithmeticFunction_eq_self (T v * T w)]
    apply toArithmeticFunction_congr
    intro n hn
    change (v * w).coeff n = LSeries.convolution v.coeff w.coeff n
    rw [LSeries.convolution_def]
    exact MonoidAlgebra.coeff_mul_antidiag v w n n.divisorsAntidiagonal
      (by simp [Nat.mem_divisorsAntidiagonal, hn])
  have hTβbound (i : ι) (hi : i ∈ s) (n : ℕ) : ‖T (β i) n‖ ≤ B := by
    by_cases hn : n = 0
    · simpa [hn] using hB
    · simpa [T, toArithmeticFunction, hn] using hbound i hi n
  have hgrowth : ∀ t : Finset ι, t.Nonempty → t ⊆ s → ∀ n : ℕ,
      ‖(∏ i ∈ t, T (β i)) n‖ ≤
        B ^ t.card * (n.divisors.card : ℝ) ^ (t.card - 1) := by
    intro t ht
    induction ht using Finset.Nonempty.cons_induction with
    | singleton i =>
        intro hts
        simpa using hTβbound i (hts (Finset.mem_singleton_self i))
    | cons i t hit htne ih =>
        intro hts
        have hi : i ∈ s := hts (by simp)
        have ht : t ⊆ s := fun j hj => hts (by simp [hj])
        have hexp :
            0 + (t.card - 1) + 1 = (Finset.cons i t hit).card - 1 := by
          simpa [hit] using Nat.sub_add_cancel (Finset.one_le_card.mpr htne)
        simpa only [Finset.prod_cons, hexp, Finset.card_cons,
          one_pow, mul_one, pow_succ'] using
            convolution_growth_bound
              (T (β i)) (∏ j ∈ t, T (β j))
              (C := B) (D := B ^ t.card) (L := 1)
              hB (pow_nonneg hB _) zero_le_one 0 (t.card - 1) 0 0
              (by simpa using hTβbound i hi)
              (by simpa using ih ht)
  refine ⟨hsupportProd s (Finset.Subset.refl s), ?_⟩
  intro n
  have hmap : T (∏ i ∈ s, β i) = ∏ i ∈ s, T (β i) := by
    simpa using
      map_multiset_ne_zero_prod
        ({ toFun := T, map_mul' := hTmul } :
          MonoidAlgebra ℂ ℕ →ₙ* ArithmeticFunction ℂ)
        (s := s.val.map β) (by simpa using hs.ne_empty)
  replace hmap := (ArithmeticFunction.toArithmeticFunction_eq_self
    (⟨(∏ i ∈ s, β i).coeff, hprodZero s (Finset.Subset.refl s)⟩ :
      ArithmeticFunction ℂ)).symm.trans hmap
  simpa [← hmap] using hgrowth s hs (Finset.Subset.refl s) n

open Classical in
theorem heathBrown_smooth_geometric_factor_profiles :
    ∃ Cder : ℕ → ℝ, (∀ r : ℕ, 0 < Cder r) ∧
      ∀ Θ : ℝ, 1 < Θ → Θ ≤ 2 →
      ∀ N : ℝ, 1 ≤ N →
      ∀ C : ℝ, 2 ≤ C →
      ∀ b : Bool,
        let η : ℝ → ℝ := fun u =>
          if 0 < u then
            Real.smoothTransition (Real.log u / Real.log Θ + 1) -
              Real.smoothTransition (Real.log u / Real.log Θ)
          else 0
        let ψ : ℝ → ℂ := fun u =>
          ((η u * (if b then Real.log (N * u) else 1) : ℝ) : ℂ)
        ContDiff ℝ ∞ ψ ∧
          Function.support ψ ⊆ Set.Icc (1 / C) C ∧
          (∑ n ∈ Finset.Icc 1 ⌊Θ * N⌋₊,
            MonoidAlgebra.single n
              (((η ((n : ℝ) / N) *
                (if b then ArithmeticFunction.log n
                  else (ArithmeticFunction.zeta : ArithmeticFunction ℝ) n)) : ℝ) : ℂ)).coeff =
            positiveCompactProfileSequence ψ C N 0 ∧
          ∀ (r : ℕ) (u : ℝ),
            ‖iteratedDeriv r ψ u‖ ≤
              Cder r * (1 + Real.log N) / (Θ - 1) ^ r := by
  obtain ⟨Cder, hCder, hgeometric⟩ :=
    heathBrown_geometric_profiles_uniform
  refine ⟨Cder, hCder, ?_⟩
  intro Θ hΘ hΘtwo N hN C hC b
  let η : ℝ → ℝ := fun u =>
    if 0 < u then
      Real.smoothTransition (Real.log u / Real.log Θ + 1) -
        Real.smoothTransition (Real.log u / Real.log Θ)
    else 0
  let φ : ℝ → ℝ := fun u => η u * (if b then Real.log (N * u) else 1)
  let ψ : ℝ → ℂ := fun u => (φ u : ℂ)
  change ContDiff ℝ ∞ ψ ∧ Function.support ψ ⊆ Set.Icc (1 / C) C ∧
    (∑ n ∈ Finset.Icc 1 ⌊Θ * N⌋₊,
      MonoidAlgebra.single n
        (((η ((n : ℝ) / N) *
          (if b then ArithmeticFunction.log n
            else (ArithmeticFunction.zeta : ArithmeticFunction ℝ) n)) : ℝ) : ℂ)).coeff =
      positiveCompactProfileSequence ψ C N 0 ∧
    ∀ (r : ℕ) (u : ℝ),
      ‖iteratedDeriv r ψ u‖ ≤ Cder r * (1 + Real.log N) / (Θ - 1) ^ r
  obtain ⟨_, hηsupport, _, hprofiles, _⟩ := hgeometric Θ hΘ hΘtwo
  change Function.support η = Set.Ioo Θ⁻¹ Θ at hηsupport
  have hreal : ContDiff ℝ ∞ φ ∧
      Function.support φ ⊆ Set.Icc (1 / 2 : ℝ) 2 ∧
      ∀ (r : ℕ) (u : ℝ),
        ‖iteratedDeriv r φ u‖ ≤ Cder r * (1 + Real.log N) / (Θ - 1) ^ r := by
    simpa only [neg_zero, Real.rpow_eq_pow, Real.rpow_zero, mul_one] using
      hprofiles N 0 b hN (le_refl 0) (by norm_num)
  obtain ⟨hφ, hφsupport, hφbound⟩ := hreal
  have hNpos : 0 < N := lt_of_lt_of_le zero_lt_one hN
  have hNzero : N ≠ 0 := ne_of_gt hNpos
  have hΘpos : 0 < Θ := zero_lt_one.trans hΘ
  refine ⟨Complex.ofRealCLM.contDiff.comp hφ, ?_, ?_, ?_⟩
  · intro u hu
    have hφu : u ∈ Function.support φ :=
      Complex.ofReal_ne_zero.mp (show (φ u : ℂ) ≠ 0 from hu)
    obtain ⟨huLower, huUpper⟩ := hφsupport hφu
    exact ⟨(one_div_le_one_div_of_le (by norm_num : (0 : ℝ) < 2) hC).trans huLower,
      huUpper.trans hC⟩
  · have hsample (n : ℕ) (hn : 1 ≤ n) :
        (((η ((n : ℝ) / N) *
          (if b then ArithmeticFunction.log n
            else (ArithmeticFunction.zeta : ArithmeticFunction ℝ) n)) : ℝ) : ℂ) =
          ψ ((n : ℝ) / N) := by
      have hnzero : n ≠ 0 := by omega
      have hcancel : N * ((n : ℝ) / N) = (n : ℝ) := by field_simp [hNzero]
      simp [ψ, φ, hcancel, ArithmeticFunction.log_apply,
        ArithmeticFunction.natCoe_apply, ArithmeticFunction.zeta_apply, hnzero]
    simp only [MonoidAlgebra.coeff_sum, MonoidAlgebra.coeff_single,
      positiveCompactProfileSequence, zero_add, sub_zero]
    calc
      (∑ n ∈ Finset.Icc 1 ⌊Θ * N⌋₊,
          Finsupp.single n
            (((η ((n : ℝ) / N) *
              (if b then ArithmeticFunction.log n
                else (ArithmeticFunction.zeta : ArithmeticFunction ℝ) n)) : ℝ) : ℂ)) =
          ∑ n ∈ Finset.Icc 1 ⌊Θ * N⌋₊, Finsupp.single n (ψ ((n : ℝ) / N)) := by
        apply Finset.sum_congr rfl
        intro n hn
        rw [hsample n (Finset.mem_Icc.mp hn).1]
      _ = ∑ n ∈ Finset.Icc 1 ⌊C * N⌋₊, Finsupp.single n (ψ ((n : ℝ) / N)) := by
        apply Finset.sum_subset
          (Finset.Icc_subset_Icc le_rfl
            (Nat.floor_mono (mul_le_mul_of_nonneg_right (hΘtwo.trans hC) hNpos.le)))
        intro n hn hnsmall
        have hnleft : 1 ≤ n := (Finset.mem_Icc.mp hn).1
        have hnlarge : ⌊Θ * N⌋₊ < n := by
          by_contra h
          exact hnsmall (Finset.mem_Icc.mpr ⟨hnleft, Nat.le_of_not_gt h⟩)
        have hquot : Θ < (n : ℝ) / N :=
          (lt_div_iff₀ hNpos).2
            ((Nat.floor_lt (mul_nonneg hΘpos.le hNpos.le)).1 hnlarge)
        have hηzero : η ((n : ℝ) / N) = 0 := by
          by_contra hne
          have hmem : (n : ℝ) / N ∈ Function.support η := hne
          rw [hηsupport] at hmem
          exact (not_lt_of_ge hquot.le) hmem.2
        simp [ψ, φ, hηzero]
  · intro r u
    have hnorm : ‖iteratedDeriv r ψ u‖ = ‖iteratedDeriv r φ u‖ := by
      have hψ : ψ = Complex.ofRealLI ∘ φ := rfl
      rw [hψ]
      simpa only [norm_iteratedFDeriv_eq_norm_iteratedDeriv] using
        (Complex.ofRealLI.norm_iteratedFDeriv_comp_left
          (hφ.contDiffAt (x := u)) (i := r) (by simp))
    exact hnorm.le.trans (hφbound r u)

open Classical in
theorem heathBrown_geometric_slots_support_norm
    (j : ℕ) (Θ U x C0 : ℝ) (N : Fin (2 * j) → ℝ)
    (hΘ : 1 < Θ) (hΘtwo : Θ ≤ 2) (hx : Real.exp 1 ≤ x)
    (hC0x : C0 ≤ x) (hN : ∀ i, 1 ≤ N i)
    (hprod : (∏ i, N i) ≤ C0 * x) :
    let η : ℝ → ℝ := fun u =>
      if 0 < u then
        Real.smoothTransition (Real.log u / Real.log Θ + 1) -
          Real.smoothTransition (Real.log u / Real.log Θ)
      else 0
    let μU := arithmeticFunctionLowCutoff U
      (ArithmeticFunction.moebius : ArithmeticFunction ℝ)
    let f : Fin (2 * j) → ArithmeticFunction ℝ := fun i =>
      if i.val < j then μU else if i.val + 1 = 2 * j then
        ArithmeticFunction.log else ArithmeticFunction.zeta
    let β : Fin (2 * j) → MonoidAlgebra ℂ ℕ := fun i =>
      ∑ n ∈ Finset.Icc 1 ⌊Θ * N i⌋₊,
        MonoidAlgebra.single n (((η ((n : ℝ) / N i) * f i n : ℝ) : ℂ))
    (∀ i, ∀ n ∈ (β i).coeff.support,
      N i / 2 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * N i) ∧
      (∀ i n, ‖(β i).coeff n‖ ≤ 3 * Real.log x) ∧
      ∀ i, i.val < j → β i ≠ 0 → N i ≤ 2 * U := by
  intro η μU f β
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
  have hlog : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hx
  have hNi (i : Fin (2 * j)) : 0 < N i := zero_lt_one.trans_le (hN i)
  have hNupper (i : Fin (2 * j)) : N i ≤ x ^ 2 := by
    calc
      N i ≤ ∏ l, N l :=
        Multiset.mem_le_prod_of_one_le (s := Finset.univ.val) hN (Finset.mem_univ i)
      _ ≤ C0 * x := hprod
      _ ≤ x * x := mul_le_mul_of_nonneg_right hC0x hxpos.le
      _ = x ^ 2 := (sq x).symm
  obtain ⟨Cder, _, hgeometric⟩ :=
    heathBrown_geometric_profiles_uniform
  obtain ⟨_, hηsupport, hηrange, _, _⟩ := hgeometric Θ hΘ hΘtwo
  change Function.support η = Set.Ioo Θ⁻¹ Θ at hηsupport
  change ∀ u : ℝ, 0 ≤ η u ∧ η u ≤ 1 at hηrange
  have hcoeff (i : Fin (2 * j)) :
      (β i).coeff = ∑ n ∈ Finset.Icc 1 ⌊Θ * N i⌋₊,
        Finsupp.single n (((η ((n : ℝ) / N i) * f i n : ℝ) : ℂ)) :=
    MonoidAlgebra.coeff_sum _ _
  have happly (i : Fin (2 * j)) (n : ℕ) :
      (β i).coeff n = if n ∈ Finset.Icc 1 ⌊Θ * N i⌋₊ then
        (((η ((n : ℝ) / N i) * f i n : ℝ) : ℂ)) else 0 := by
    rw [hcoeff]
    simp only [← Finsupp.indicator_eq_sum_single, Finsupp.indicator_apply, dite_eq_ite]
  have hmem (i : Fin (2 * j)) (n : ℕ) (hn : n ∈ (β i).coeff.support) :
      n ∈ Finset.Icc 1 ⌊Θ * N i⌋₊ := by
    by_contra hout
    have hn0 := Finsupp.mem_support_iff.mp hn
    rw [happly, ite_eq_right hout] at hn0
    exact hn0 rfl
  have hwindow (i : Fin (2 * j)) (n : ℕ) (hn : n ∈ (β i).coeff.support) :
      Θ⁻¹ < (n : ℝ) / N i ∧ (n : ℝ) / N i < Θ := by
    have hn0 := Finsupp.mem_support_iff.mp hn
    rw [happly, ite_eq_left (hmem i n hn)] at hn0
    exact hηsupport.subset
      (left_ne_zero_of_mul (Complex.ofReal_ne_zero.mp hn0))
  have hsupport (i : Fin (2 * j)) (n : ℕ) (hn : n ∈ (β i).coeff.support) :
      N i / 2 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * N i := by
    obtain ⟨hl, hu⟩ := hwindow i n hn
    constructor
    · have hhalf : (1 / 2 : ℝ) ≤ Θ⁻¹ := by
        simpa only [one_div] using inv_anti₀ (zero_lt_one.trans hΘ) hΘtwo
      have hh : (1 / 2 : ℝ) ≤ (n : ℝ) / N i := hhalf.trans hl.le
      simpa only [div_eq_mul_inv, one_mul, mul_comm] using (le_div_iff₀ (hNi i)).mp hh
    · exact (div_le_iff₀ (hNi i)).mp (hu.le.trans hΘtwo)
  have hμ (n : ℕ) : |μU n| ≤ 1 := by
    change |if (n : ℝ) ≤ U then (ArithmeticFunction.moebius n : ℝ) else 0| ≤ 1
    rw [abs_ite, abs_zero]
    exact ite_le_one (mod_cast ArithmeticFunction.abs_moebius_le_one) zero_le_one
  have hrole (i : Fin (2 * j)) (n : ℕ)
      (hn : n ∈ Finset.Icc 1 ⌊Θ * N i⌋₊) : |f i n| ≤ 3 * Real.log x := by
    have hn1 : (1 : ℝ) ≤ n := Nat.one_le_cast.mpr (Finset.mem_Icc.mp hn).1
    have hnr : (n : ℝ) ≤ 2 * N i :=
      ((Nat.cast_le.mpr (Finset.mem_Icc.mp hn).2).trans
        (Nat.floor_le (mul_nonneg (zero_lt_one.trans hΘ).le (hNi i).le))).trans
          (mul_le_mul_of_nonneg_right hΘtwo (hNi i).le)
    have hlogNi := Real.log_le_log (hNi i) (hNupper i)
    rw [Real.log_pow] at hlogNi
    norm_num only [Nat.cast_ofNat] at hlogNi
    have hlogn := Real.log_le_log (zero_lt_one.trans_le hn1) hnr
    rw [Real.log_mul two_ne_zero (hNi i).ne'] at hlogn
    have hlog2 := Real.log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2)
    dsimp only [f]
    split_ifs
    · exact (hμ n).trans (by linarith)
    · change |Real.log (n : ℝ)| ≤ _
      rw [abs_of_nonneg (Real.log_nonneg hn1)]
      linarith
    · simp only [ArithmeticFunction.natCoe_apply, ArithmeticFunction.zeta_apply,
        Nat.ne_zero_of_lt (Finset.mem_Icc.mp hn).1, ite_false, Nat.cast_one, abs_one]
      linarith
  refine ⟨hsupport, ?_, ?_⟩
  · intro i n
    rw [happly]
    split_ifs with hn
    · rw [Complex.norm_real, Real.norm_eq_abs, abs_mul,
        abs_of_nonneg (hηrange _).1]
      exact (mul_le_mul (hηrange _).2 (hrole i n hn)
        (abs_nonneg _) zero_le_one).trans_eq (one_mul _)
    · rw [norm_zero]
      linarith
  · intro i hi hβ
    have hc : (β i).coeff ≠ 0 := fun hc => hβ (MonoidAlgebra.coeff_eq_zero.mp hc)
    obtain ⟨n, hn⟩ := Finsupp.support_nonempty_iff.mpr hc
    have hn0 := Finsupp.mem_support_iff.mp hn
    rw [happly, ite_eq_left (hmem i n hn)] at hn0
    have hμn : μU n ≠ 0 := by
      have hf := right_ne_zero_of_mul (Complex.ofReal_ne_zero.mp hn0)
      simpa only [f, ite_eq_left hi] using hf
    have hnU : (n : ℝ) ≤ U := by
      by_contra hout
      apply hμn
      change (if (n : ℝ) ≤ U then (ArithmeticFunction.moebius n : ℝ) else 0) = 0
      exact ite_eq_right hout
    linarith [(hsupport i n hn).1]

open Classical in
theorem heathBrown_box_product_mass_bound
    {ι : Type*} (s : Finset ι) (β : ι → MonoidAlgebra ℂ ℕ)
    (N : ι → ℝ) (B : ℝ) (hB : 0 ≤ B) (hN : ∀ i ∈ s, 0 ≤ N i)
    (hsupport : ∀ i ∈ s, ∀ n ∈ (β i).coeff.support,
      0 < n ∧ (n : ℝ) ≤ 2 * N i)
    (hbound : ∀ i ∈ s, ∀ n : ℕ, ‖(β i).coeff n‖ ≤ B) :
    (∑ n ∈ (∏ i ∈ s, β i).coeff.support, ‖(∏ i ∈ s, β i).coeff n‖) ≤
      (2 : ℝ) ^ s.card * (∏ i ∈ s, N i) * B ^ s.card := by
  let mass (v : MonoidAlgebra ℂ ℕ) : ℝ := ∑ n ∈ v.coeff.support, ‖v.coeff n‖
  have hmassNonneg (v : MonoidAlgebra ℂ ℕ) : 0 ≤ mass v :=
    Finset.sum_nonneg fun _ _ => norm_nonneg _
  have hmassMul (v w : MonoidAlgebra ℂ ℕ) :
      mass (v * w) ≤ mass v * mass w := by
    calc
      mass (v * w) ≤ ∑ n ∈ (v * w).coeff.support,
          ∑ a ∈ v.coeff.support, ∑ b ∈ w.coeff.support,
            if a * b = n then ‖v.coeff a‖ * ‖w.coeff b‖ else 0 := by
        simp only [mass, MonoidAlgebra.coeff_mul, Finsupp.sum]
        grw [norm_sum_le, norm_sum_le]
        simp [apply_ite (fun z : ℂ => ‖z‖)]
      _ = ∑ a ∈ v.coeff.support, ∑ b ∈ w.coeff.support,
          ∑ n ∈ (v * w).coeff.support,
            if a * b = n then ‖v.coeff a‖ * ‖w.coeff b‖ else 0 :=
        Finset.sum_comm_cycle.symm
      _ ≤ mass v * mass w := by
        rw [Finset.sum_mul_sum]
        gcongr with a _ b _
        rw [Finset.sum_ite_eq]
        split_ifs
        · exact le_rfl
        · positivity
  have hfactor (i : ι) (hi : i ∈ s) : mass (β i) ≤ 2 * N i * B := by
    have hsub : (β i).coeff.support ⊆ Finset.Icc 1 ⌊2 * N i⌋₊ := by
      intro n hn
      exact Finset.mem_Icc.mpr ⟨(hsupport i hi n hn).1,
        (Nat.le_floor_iff' (hsupport i hi n hn).1.ne').2 (hsupport i hi n hn).2⟩
    have hcard : ((β i).coeff.support.card : ℝ) ≤ 2 * N i := by
      calc
        ((β i).coeff.support.card : ℝ) ≤ ((Finset.Icc 1 ⌊2 * N i⌋₊).card : ℝ) :=
          Nat.cast_le.mpr (Finset.card_le_card hsub)
        _ = (⌊2 * N i⌋₊ : ℝ) := by simp only [Nat.card_Icc, Nat.add_sub_cancel]
        _ ≤ 2 * N i := Nat.floor_le (mul_nonneg zero_le_two (hN i hi))
    calc
      mass (β i) ≤ ((β i).coeff.support.card : ℝ) * B := by
        simpa only [mass, nsmul_eq_mul] using
          Finset.sum_le_card_nsmul (β i).coeff.support
            (fun n => ‖(β i).coeff n‖) B (fun n _ => hbound i hi n)
      _ ≤ 2 * N i * B := mul_le_mul_of_nonneg_right hcard hB
  calc
    (∑ n ∈ (∏ i ∈ s, β i).coeff.support, ‖(∏ i ∈ s, β i).coeff n‖) ≤
        ∏ i ∈ s, mass (β i) :=
      Finset.le_prod_of_submultiplicative_of_nonneg mass hmassNonneg
        (by simp [mass, MonoidAlgebra.one_def]) hmassMul s β
    _ ≤ ∏ i ∈ s, 2 * N i * B :=
      Finset.prod_le_prod (fun i _ => hmassNonneg (β i)) hfactor
    _ = (2 : ℝ) ^ s.card * (∏ i ∈ s, N i) * B ^ s.card := by
      simp only [Finset.prod_mul_distrib, Finset.prod_const]

open Classical in
theorem heathBrown_geometric_derivatives_log_bound
    (Cder : ℕ → ℝ) (hCder : ∀ r, 0 ≤ Cder r) (D J : ℕ)
    (x N : ℝ) (hx : Real.exp 1 ≤ x) (hN : 1 ≤ N) (hNupper : N ≤ x ^ 2)
    (ψ : ℝ → ℂ)
    (hderiv : ∀ r u, ‖iteratedDeriv r ψ u‖ ≤
      Cder r * (1 + Real.log N) /
        ((1 + (Real.log x) ^ (-(D : ℝ))) - 1) ^ r) :
    ∀ r : ℕ, r ≤ J → ∀ u : ℝ,
      ‖iteratedDeriv r ψ u‖ ≤
        (3 * (1 + ∑ v ∈ Finset.range (J + 1), Cder v)) *
          (Real.log x) ^ (D * J + 1) := by
  intro r hr u
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
  have hL : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hx
  have hLpos : 0 < Real.log x := zero_lt_one.trans_le hL
  have hlogN : 1 + Real.log N ≤ 3 * Real.log x := by
    have hh := Real.log_le_log (zero_lt_one.trans_le hN) hNupper
    rw [Real.log_pow] at hh
    norm_num only [Nat.cast_ofNat] at hh
    linarith
  have hCsum : Cder r ≤ 1 + ∑ v ∈ Finset.range (J + 1), Cder v :=
    (Finset.single_le_sum (fun v _ => hCder v)
      (Finset.mem_range.mpr (Nat.lt_succ_of_le hr))).trans
        (le_add_of_nonneg_left zero_le_one)
  have hpower : (Real.log x) ^ (D * r + 1) ≤ (Real.log x) ^ (D * J + 1) :=
    pow_le_pow_right₀ hL (Nat.add_le_add_right (Nat.mul_le_mul_left D hr) 1)
  calc
    ‖iteratedDeriv r ψ u‖ ≤ Cder r * (1 + Real.log N) /
        ((1 + (Real.log x) ^ (-(D : ℝ))) - 1) ^ r := hderiv r u
    _ = Cder r * (1 + Real.log N) * (Real.log x) ^ (D * r) := by
      rw [add_sub_cancel_left, Real.rpow_neg hLpos.le, Real.rpow_natCast,
        inv_pow, div_inv_eq_mul, ← pow_mul]
    _ ≤ Cder r * (3 * Real.log x) * (Real.log x) ^ (D * r) :=
      mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_left hlogN (hCder r))
        (pow_nonneg hLpos.le _)
    _ = (3 * Cder r) * (Real.log x) ^ (D * r + 1) := by rw [pow_succ]; ring
    _ ≤ (3 * (1 + ∑ v ∈ Finset.range (J + 1), Cder v)) *
        (Real.log x) ^ (D * J + 1) :=
      mul_le_mul (mul_le_mul_of_nonneg_left hCsum zero_le_three) hpower
        (pow_nonneg hLpos.le _)
        (mul_nonneg zero_le_three
          (add_nonneg zero_le_one (Finset.sum_nonneg fun v _ => hCder v)))

open Classical in
theorem heathBrown_scale_trichotomy {n : ℕ} (σ C x : ℝ)
    (hσ : (1 / 10 : ℝ) < σ) (hσhalf : σ < 1 / 2)
    (hC : 1 ≤ C) (hx : C < x) (N : Fin n → ℝ)
    (hNi : ∀ i, 1 ≤ N i) (hlo : x / C ≤ ∏ i, N i)
    (hhi : (∏ i, N i) ≤ C * x) :
    (∃ i : Fin n, x ^ (1 / 2 + σ) / C ≤ N i) ∨
    (∃ S T : Finset (Fin n), Disjoint S T ∧ S ∪ T = Finset.univ ∧
      S.Nonempty ∧ T.Nonempty ∧
      x ^ (1 / 2 - σ) / C < (∏ i ∈ S, N i) ∧
      (∏ i ∈ S, N i) ≤ (∏ i ∈ T, N i) ∧
      (∏ i ∈ T, N i) ≤ C * x ^ (1 / 2 + σ)) ∨
    (∃ i j k : Fin n, i ≠ j ∧ i ≠ k ∧ j ≠ k ∧
      x ^ (2 * σ) / C ≤ N i ∧ N i ≤ N j ∧ N j ≤ N k ∧
      N k ≤ C * x ^ (1 / 2 - σ) ∧
      x ^ (1 / 2 + σ) / C ≤ N i * N j ∧
      x ^ (1 / 2 + σ) / C ≤ N i * N k ∧
      x ^ (1 / 2 + σ) / C ≤ N j * N k) := by
  let P : ℝ := ∏ i, N i
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hxpos : 0 < x := hCpos.trans hx
  have hPone : 1 < P := ((one_lt_div hCpos).2 hx).trans_le hlo
  have hPpos : 0 < P := zero_lt_one.trans hPone
  have hNpos (i : Fin n) : 0 < N i := zero_lt_one.trans_le (hNi i)
  have hlogP : 0 < Real.log P := Real.log_pos hPone
  let t : Fin n → ℝ := fun i => Real.log (N i) / Real.log P
  have ht0 (i : Fin n) : 0 ≤ t i :=
    div_nonneg (Real.log_nonneg (hNi i)) hlogP.le
  have hlogprod : Real.log P = ∑ i, Real.log (N i) := by
    dsimp only [P]
    exact Real.log_prod fun i _hi => (hNpos i).ne'
  have htsum : ∑ i, t i = 1 := by
    change (∑ i, Real.log (N i) / Real.log P) = 1
    rw [← Finset.sum_div, ← hlogprod, div_self hlogP.ne']
  have hpow (i : Fin n) : P ^ t i = N i := by
    apply (Real.mul_log_eq_log_iff hPpos (hNpos i)).mp
    exact div_mul_cancel₀ (Real.log (N i)) hlogP.ne'
  have hprod (S : Finset (Fin n)) :
      P ^ (∑ i ∈ S, t i) = ∏ i ∈ S, N i := by
    simpa only [hpow] using Real.rpow_sum_of_pos hPpos t S
  have hmono {i j : Fin n} (hij : t i ≤ t j) : N i ≤ N j := by
    simpa only [hpow] using Real.rpow_le_rpow_of_exponent_le hPone.le hij
  have hpair (i j : Fin n) : P ^ (t i + t j) = N i * N j := by
    simp only [Real.rpow_add hPpos, hpow]
  have htransfer (r : ℝ) (hr0 : 0 ≤ r) (hr1 : r ≤ 1) :
      x ^ r / C ≤ P ^ r ∧ P ^ r ≤ C * x ^ r := by
    have hCr : C ^ r ≤ C := Real.rpow_le_self_of_one_le hC hr1
    constructor
    · apply (div_le_iff₀ hCpos).2
      calc
        x ^ r ≤ (P * C) ^ r :=
          Real.rpow_le_rpow hxpos.le ((div_le_iff₀ hCpos).1 hlo) hr0
        _ = P ^ r * C ^ r := Real.mul_rpow hPpos.le hCpos.le
        _ ≤ P ^ r * C :=
          mul_le_mul_of_nonneg_left hCr (Real.rpow_nonneg hPpos.le r)
    · calc
        P ^ r ≤ (C * x) ^ r := Real.rpow_le_rpow hPpos.le hhi hr0
        _ = C ^ r * x ^ r := Real.mul_rpow hCpos.le hxpos.le
        _ ≤ C * x ^ r :=
          mul_le_mul_of_nonneg_right hCr (Real.rpow_nonneg hxpos.le r)
  have hplus := htransfer (1 / 2 + σ) (by linarith) (by linarith)
  have hminus := htransfer (1 / 2 - σ) (by linarith) (by linarith)
  have htwice := htransfer (2 * σ) (by linarith) (by linarith)
  rcases partition_trichotomy_of_sum_eq_one hσ hσhalf t ht0 htsum with
    hlarge | hbalanced | htriple
  · rcases hlarge with ⟨i, hi⟩
    refine Or.inl ⟨i, ?_⟩
    calc
      x ^ (1 / 2 + σ) / C ≤ P ^ (1 / 2 + σ) := hplus.1
      _ ≤ P ^ t i := Real.rpow_le_rpow_of_exponent_le hPone.le hi
      _ = N i := hpow i
  · rcases hbalanced with ⟨S, T, hdisj, hunion, hSlo, hST, hThi⟩
    have hSne : S.Nonempty := by
      apply Finset.nonempty_iff_ne_empty.mpr
      intro hSempty
      have hneg : 1 / 2 - σ < (0 : ℝ) := by
        simpa only [hSempty, Finset.sum_empty] using hSlo
      linarith
    have hTne : T.Nonempty := by
      apply Finset.nonempty_iff_ne_empty.mpr
      intro hTempty
      have hTzero : (∑ i ∈ T, t i) = 0 := by
        simp only [hTempty, Finset.sum_empty]
      linarith
    refine Or.inr (Or.inl ⟨S, T, hdisj, hunion, hSne, hTne, ?_, ?_, ?_⟩)
    · calc
        x ^ (1 / 2 - σ) / C ≤ P ^ (1 / 2 - σ) := hminus.1
        _ < P ^ (∑ i ∈ S, t i) :=
          Real.rpow_lt_rpow_of_exponent_lt hPone hSlo
        _ = ∏ i ∈ S, N i := hprod S
    · calc
        (∏ i ∈ S, N i) = P ^ (∑ i ∈ S, t i) := (hprod S).symm
        _ ≤ P ^ (∑ i ∈ T, t i) :=
          Real.rpow_le_rpow_of_exponent_le hPone.le hST
        _ = ∏ i ∈ T, N i := hprod T
    · calc
        (∏ i ∈ T, N i) = P ^ (∑ i ∈ T, t i) := (hprod T).symm
        _ ≤ P ^ (1 / 2 + σ) :=
          Real.rpow_le_rpow_of_exponent_le hPone.le hThi.le
        _ ≤ C * x ^ (1 / 2 + σ) := hplus.2
  · rcases htriple with ⟨i, j, k, hij, hik, hjk, hi, hij', hjk', hk, hpairij,
      hpairik, hpairjk⟩
    refine Or.inr (Or.inr ⟨i, j, k, hij, hik, hjk, ?_, hmono hij', hmono hjk',
      ?_, ?_, ?_, ?_⟩)
    · calc
        x ^ (2 * σ) / C ≤ P ^ (2 * σ) := htwice.1
        _ ≤ P ^ t i := Real.rpow_le_rpow_of_exponent_le hPone.le hi
        _ = N i := hpow i
    · calc
        N k = P ^ t k := (hpow k).symm
        _ ≤ P ^ (1 / 2 - σ) := Real.rpow_le_rpow_of_exponent_le hPone.le hk
        _ ≤ C * x ^ (1 / 2 - σ) := hminus.2
    · calc
        x ^ (1 / 2 + σ) / C ≤ P ^ (1 / 2 + σ) := hplus.1
        _ ≤ P ^ (t i + t j) := Real.rpow_le_rpow_of_exponent_le hPone.le hpairij
        _ = N i * N j := hpair i j
    · calc
        x ^ (1 / 2 + σ) / C ≤ P ^ (1 / 2 + σ) := hplus.1
        _ ≤ P ^ (t i + t k) := Real.rpow_le_rpow_of_exponent_le hPone.le hpairik
        _ = N i * N k := hpair i k
    · calc
        x ^ (1 / 2 + σ) / C ≤ P ^ (1 / 2 + σ) := hplus.1
        _ ≤ P ^ (t j + t k) := Real.rpow_le_rpow_of_exponent_le hPone.le hpairjk
        _ = N j * N k := hpair j k

open Classical in
theorem heathBrown_zero_boxes_log_saving
    (density j D : ℕ) (_hj : 1 ≤ j) (hj20 : j ≤ 20)
    («ω» δ σ C0 : ℝ) (hC0 : 1 ≤ C0)
    (hσgap : 2 * «ω» < σ) (hσhalf : σ < 1 / 2) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
        let Θ : ℝ := 1 + (Real.log x) ^ (-(D : ℝ))
        let U : ℝ := (2 * x) ^ (1 / 20 : ℝ)
        let η : ℝ → ℝ := fun u =>
          if 0 < u then
            Real.smoothTransition (Real.log u / Real.log Θ + 1) -
              Real.smoothTransition (Real.log u / Real.log Θ)
          else 0
        let μU := arithmeticFunctionLowCutoff U
          (ArithmeticFunction.moebius : ArithmeticFunction ℝ)
        let f : Fin (2 * j) → ArithmeticFunction ℝ := fun i =>
          if i.val < j then μU else if i.val + 1 = 2 * j then
            ArithmeticFunction.log else ArithmeticFunction.zeta
        ∀ ν : Fin (2 * j) → ℕ,
          let Ni : Fin (2 * j) → ℝ := fun i => Θ ^ ν i
          let β : Fin (2 * j) → MonoidAlgebra ℂ ℕ := fun i =>
            ∑ n ∈ Finset.Icc 1 ⌊Θ * Ni i⌋₊,
              MonoidAlgebra.single n (((η ((n : ℝ) / Ni i) * f i n : ℝ) : ℂ))
          (∏ i, Ni i) ≤ C0 * x →
          ∀ i : Fin (2 * j), j ≤ i.val → x ^ (1 / 2 + σ) / C0 ≤ Ni i →
          ∀ I : Finset ℕ, ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
            (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
                q ∣ (∏ p ∈ I, p) ∧
                  Nonempty (DenseDivisibilityWitness
                    ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩ density q)),
              ‖fullDiscrepancy (∏ i, β i).coeff q a‖) ≤
                K * x / (Real.log x) ^ A := by
  intro A _hA
  let ε : ℝ := (σ - 2 * «ω») / 2
  have hε : 0 < ε := div_pos (sub_pos.mpr hσgap) zero_lt_two
  let k : ℕ := ⌈((3 : ℝ) + 1) / ε⌉₊
  obtain ⟨Cder, hCder, hprofiles⟩ := heathBrown_smooth_geometric_factor_profiles
  let L : ℝ := 3 * (1 + ∑ v ∈ Finset.range ((k + 2) + 1), Cder v)
  let E : ℝ := (D * (k + 2) + 1 : ℕ)
  have hL : 0 < L := by
    dsimp only [L]
    exact mul_pos zero_lt_three
      (add_pos_of_pos_of_nonneg zero_lt_one
        (Finset.sum_nonneg fun v _ => (hCder v).le))
  have hzero := positiveCompactProfile_typeZero_uniform_log_saving A 3 ε
    (by norm_num) hε
  obtain ⟨Xt, hXt, ht⟩ := hzero.2 (1 / 2) 2 L E 40
    (by norm_num) (by norm_num) hL.le
  obtain ⟨Xc, hXc⟩ := Filter.eventually_atTop.mp
    ((tendsto_rpow_atTop hε).eventually_ge_atTop C0)
  let X : ℝ := max (max (Real.exp 1) Xt) (max (max C0 (C0 * 6 ^ (40 : ℕ))) Xc)
  refine ⟨1, X, zero_lt_one, (le_max_left _ _).trans (le_max_left _ _), ?_⟩
  intro x hx Θ U η μU f ν Ni β hprod i hi hlong I a ha
  obtain ⟨hxbase, hxrest⟩ := max_le_iff.mp hx
  obtain ⟨hxexp, hxXt⟩ := max_le_iff.mp hxbase
  obtain ⟨hxconstants, hxXc⟩ := max_le_iff.mp hxrest
  obtain ⟨hC0x, hmassConstant⟩ := max_le_iff.mp hxconstants
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hxone : 1 ≤ x := (Real.one_le_exp (by norm_num)).trans hxexp
  have hlog : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hxexp
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlog
  have hC0pos : 0 < C0 := zero_lt_one.trans_le hC0
  have hCpower : C0 ≤ x ^ ε := hXc x hxXc
  have hΘ : 1 < Θ :=
    lt_add_of_pos_right 1 (Real.rpow_pos_of_pos hlogpos _)
  have hΘtwo : Θ ≤ 2 := by
    have hh := Real.rpow_le_one_of_one_le_of_nonpos hlog
      (neg_nonpos.mpr (Nat.cast_nonneg D))
    change 1 + (Real.log x) ^ (-(D : ℝ)) ≤ 2
    linarith
  have hNi (l : Fin (2 * j)) : 1 ≤ Ni l := one_le_pow₀ hΘ.le
  have hNipos (l : Fin (2 * j)) : 0 < Ni l := zero_lt_one.trans_le (hNi l)
  obtain ⟨hsupport, hbound, _⟩ :=
    heathBrown_geometric_slots_support_norm j Θ U x C0 Ni
      hΘ hΘtwo hxexp hC0x hNi hprod
  let T : Finset (Fin (2 * j)) := Finset.univ.erase i
  let M : ℝ := ∏ l ∈ T, Ni l
  let α : ℕ →₀ ℂ := (∏ l ∈ T, β l).coeff
  have hM0 : 0 ≤ M := Finset.prod_nonneg fun l _ => zero_le_one.trans (hNi l)
  have hMprod : M * Ni i = ∏ l, Ni l := Finset.prod_erase_mul _ _ (Finset.mem_univ i)
  have hMupper : M ≤ C0 * x :=
    ((le_mul_of_one_le_right hM0 (hNi i)).trans_eq hMprod).trans hprod
  have hcard : T.card ≤ 40 := by
    have hh := Finset.card_le_card (Finset.subset_univ T)
    simp only [Finset.card_univ, Fintype.card_fin] at hh
    omega
  have hmass : (∑ n ∈ α.support, ‖α n‖) ≤
      6 ^ (40 : ℕ) * (C0 * x) * (Real.log x) ^ (40 : ℕ) := by
    have hm := heathBrown_box_product_mass_bound T β Ni (3 * Real.log x)
      (by positivity) (fun l _ => zero_le_one.trans (hNi l))
      (fun l _ n hn => ⟨by
        have hh := (hsupport l n hn).1
        have hp : 0 < Ni l / 2 := div_pos (hNipos l) zero_lt_two
        exact Nat.cast_pos.mp (hp.trans_le hh), (hsupport l n hn).2⟩)
      (fun l _ n => hbound l n)
    calc
      (∑ n ∈ α.support, ‖α n‖) ≤
          (2 : ℝ) ^ T.card * M * (3 * Real.log x) ^ T.card := hm
      _ = M * (6 * Real.log x) ^ T.card := by
        rw [mul_comm ((2 : ℝ) ^ T.card) M, mul_assoc, ← mul_pow,
          show (2 : ℝ) * (3 * Real.log x) = 6 * Real.log x by ring]
      _ ≤ M * (6 * Real.log x) ^ (40 : ℕ) :=
        mul_le_mul_of_nonneg_left (pow_le_pow_right₀ (by linarith) hcard) hM0
      _ = 6 ^ (40 : ℕ) * M * (Real.log x) ^ (40 : ℕ) := by rw [mul_pow]; ring
      _ ≤ 6 ^ (40 : ℕ) * (C0 * x) * (Real.log x) ^ (40 : ℕ) :=
        mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left hMupper (by positivity)) (by positivity)
  let ψ : ℝ → ℂ := fun u =>
    ((η u * (if i.val + 1 = 2 * j then Real.log (Ni i * u) else 1) : ℝ) : ℂ)
  have hprofile : ContDiff ℝ ∞ ψ ∧
      Function.support ψ ⊆ Set.Icc (1 / 2 : ℝ) 2 ∧
      (β i).coeff = positiveCompactProfileSequence ψ 2 (Ni i) 0 ∧
      ∀ r u, ‖iteratedDeriv r ψ u‖ ≤
        Cder r * (1 + Real.log (Ni i)) / (Θ - 1) ^ r := by
    by_cases hlast : i.val + 1 = 2 * j
    · simpa only [ψ, β, f, ite_eq_right (not_lt_of_ge hi), ite_eq_left hlast,
        ↓reduceIte] using
        hprofiles Θ hΘ hΘtwo (Ni i) (hNi i) 2 (by norm_num) true
    · simpa only [ψ, β, f, ite_eq_right (not_lt_of_ge hi), ite_eq_right hlast,
        Bool.false_eq_true, ↓reduceIte] using
        hprofiles Θ hΘ hΘtwo (Ni i) (hNi i) 2 (by norm_num) false
  obtain ⟨hψ, hsψ, hβψ, hdψ⟩ := hprofile
  have hNiupper : Ni i ≤ x ^ 2 := by
    calc
      Ni i ≤ ∏ l, Ni l :=
        Multiset.mem_le_prod_of_one_le (s := Finset.univ.val) hNi (Finset.mem_univ i)
      _ ≤ C0 * x := hprod
      _ ≤ x * x := mul_le_mul_of_nonneg_right hC0x hxpos.le
      _ = x ^ 2 := (sq x).symm
  have hder := heathBrown_geometric_derivatives_log_bound Cder
    (fun r => (hCder r).le) D (k + 2) x (Ni i) hxexp (hNi i) hNiupper ψ hdψ
  have hψbound (u : ℝ) : ‖ψ u‖ ≤ L * (Real.log x) ^ E ∧
      ‖iteratedDeriv (k + 2) ψ u‖ ≤ L * (Real.log x) ^ E := by
    constructor
    · simpa only [iteratedDeriv_zero, E, Real.rpow_natCast, L] using
        hder 0 (Nat.zero_le _) u
    · simpa only [E, Real.rpow_natCast, L] using hder (k + 2) le_rfl u
  have hbox : (∏ l, β l).coeff =
      finiteConvolution α (positiveCompactProfileSequence ψ 2 (Ni i) 0) := by
    rw [← hβψ]
    change (∏ l, β l).coeff = ((∏ l ∈ T, β l) * β i).coeff
    exact congrArg MonoidAlgebra.coeff (Finset.prod_erase_mul _ _ (Finset.mem_univ i)).symm
  let S := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
                q ∣ (∏ p ∈ I, p) ∧
                  Nonempty (DenseDivisibilityWitness
                    ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩ density q))
  have hSpos (q : ℕ) (hq : q ∈ S) : 0 < q :=
    (Finset.mem_Icc.mp (Finset.mem_filter.mp hq).1).1
  have hSq (q : ℕ) (hq : q ∈ S) : (q : ℝ) ≤ x ^ (1 / 2 + 2 * «ω») :=
    (Nat.cast_le.mpr (Finset.mem_Icc.mp (Finset.mem_filter.mp hq).1).2).trans
      (Nat.floor_le (Real.rpow_nonneg hxpos.le _))
  have hScard : (S.card : ℝ) ≤ x := by
    calc
      (S.card : ℝ) ≤ ((Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).card : ℝ) :=
        Nat.cast_le.mpr (Finset.card_le_card (Finset.filter_subset _ _))
      _ = (⌊x ^ (1 / 2 + 2 * «ω»)⌋₊ : ℝ) := by
        simp only [Nat.card_Icc, Nat.add_sub_cancel]
      _ ≤ x ^ (1 / 2 + 2 * «ω») := Nat.floor_le (Real.rpow_nonneg hxpos.le _)
      _ ≤ x := by
        simpa only [Real.rpow_one] using
          Real.rpow_le_rpow_of_exponent_le hxone
            (show (1 / 2 : ℝ) + 2 * «ω» ≤ 1 by linarith)
  have hbudget : (∑ q ∈ S, (1 : ℝ) * ∑ m ∈ α.support, ‖α m‖) ≤
      x ^ (3 : ℝ) * (Real.log x) ^ (40 : ℝ) := by
    calc
      (∑ q ∈ S, (1 : ℝ) * ∑ m ∈ α.support, ‖α m‖) =
          (S.card : ℝ) * ∑ m ∈ α.support, ‖α m‖ := by
        simp only [one_mul, Finset.sum_const, nsmul_eq_mul]
      _ ≤ x * (6 ^ (40 : ℕ) * (C0 * x) * (Real.log x) ^ (40 : ℕ)) :=
        mul_le_mul hScard hmass (Finset.sum_nonneg fun _ _ => norm_nonneg _) hxpos.le
      _ = (C0 * 6 ^ (40 : ℕ)) * (x ^ 2 * (Real.log x) ^ (40 : ℕ)) := by ring
      _ ≤ x * (x ^ 2 * (Real.log x) ^ (40 : ℕ)) :=
        mul_le_mul_of_nonneg_right hmassConstant (by positivity)
      _ = x ^ (3 : ℝ) * (Real.log x) ^ (40 : ℝ) := by
        norm_num only [Real.rpow_ofNat]
        ring
  have hlarge (q : ℕ) (hq : q ∈ S) : x ^ ε * (q : ℝ) ≤ Ni i := by
    calc
      x ^ ε * (q : ℝ) ≤ x ^ ε * x ^ (1 / 2 + 2 * «ω») :=
        mul_le_mul_of_nonneg_left (hSq q hq) (Real.rpow_nonneg hxpos.le _)
      _ = x ^ (ε + (1 / 2 + 2 * «ω»)) := (Real.rpow_add hxpos _ _).symm
      _ ≤ x ^ (1 / 2 + σ) / C0 := by
        apply (le_div_iff₀ hC0pos).2
        calc
          x ^ (ε + (1 / 2 + 2 * «ω»)) * C0 ≤
              x ^ (ε + (1 / 2 + 2 * «ω»)) * x ^ ε :=
            mul_le_mul_of_nonneg_left hCpower (Real.rpow_nonneg hxpos.le _)
          _ = x ^ ((ε + (1 / 2 + 2 * «ω»)) + ε) := (Real.rpow_add hxpos _ _).symm
          _ = x ^ (1 / 2 + σ) := by congr 1; dsimp only [ε]; ring
      _ ≤ Ni i := hlong
  have hprimitive (q : ℕ) (hq : q ∈ S) : Nat.Coprime a q :=
    ha.of_dvd_right (Finset.mem_filter.mp hq).2.1
  have hfinal := ht x hxXt S hSpos (fun _ => 1) (fun _ _ => zero_le_one)
    (fun _ => α) hbudget (fun _ => Ni i) (fun _ => 0)
    (fun _ _ => hNipos i) hlarge (fun _ _ => by positivity)
    (fun _ => ψ) (fun _ _ => hψ) (fun _ _ => hsψ)
    (fun _ _ u => hψbound u) (fun _ => a) hprimitive
  rw [← hbox] at hfinal
  simpa only [S, one_mul, Real.rpow_neg hlogpos.le, div_eq_mul_inv] using hfinal

open Classical in
theorem heathBrown_three_boxes_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (density : ℕ) (hdensity : 1 ≤ density)
    (j D : ℕ) (_hj : 1 ≤ j) (hjupper : j ≤ 20) (_hD : 1 ≤ D)
    («ω» δ σ C0 : ℝ) (hω : 0 < «ω») (hωupper : «ω» < 1 / 12)
    (hδ : 0 < δ) (_hσhalf : σ < 1 / 2) (hC0 : 1 ≤ C0)
    (hσ : 1 / 18 + 28 / 9 * «ω» + 2 / 9 * δ < σ) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
        let Θ : ℝ := 1 + (Real.log x) ^ (-(D : ℝ))
        let U : ℝ := (2 * x) ^ (1 / 20 : ℝ)
        let η : ℝ → ℝ := fun u =>
          if 0 < u then
            Real.smoothTransition (Real.log u / Real.log Θ + 1) -
              Real.smoothTransition (Real.log u / Real.log Θ)
          else 0
        let μU := arithmeticFunctionLowCutoff U
          (ArithmeticFunction.moebius : ArithmeticFunction ℝ)
        let f : Fin (2 * j) → ArithmeticFunction ℝ := fun i =>
          if i.val < j then μU else if i.val + 1 = 2 * j then
            ArithmeticFunction.log else ArithmeticFunction.zeta
        ∀ ν : Fin (2 * j) → ℕ,
          let Ni : Fin (2 * j) → ℝ := fun i => Θ ^ ν i
          let β : Fin (2 * j) → MonoidAlgebra ℂ ℕ := fun i =>
            ∑ n ∈ Finset.Icc 1 ⌊Θ * Ni i⌋₊,
              MonoidAlgebra.single n
                (((η ((n : ℝ) / Ni i) * f i n : ℝ) : ℂ))
          x / C0 ≤ (∏ i, Ni i) → (∏ i, Ni i) ≤ C0 * x →
          ∀ i₁ i₂ i₃ : Fin (2 * j),
            i₁ ≠ i₂ → i₁ ≠ i₃ → i₂ ≠ i₃ →
            j ≤ i₁.val → j ≤ i₂.val → j ≤ i₃.val →
            x ^ (1 / 2 + σ) / C0 ≤ Ni i₁ * Ni i₂ →
            x ^ (1 / 2 + σ) / C0 ≤ Ni i₁ * Ni i₃ →
            x ^ (1 / 2 + σ) / C0 ≤ Ni i₂ * Ni i₃ →
            Ni i₁ ≤ C0 * x ^ (1 / 2 - σ) →
            Ni i₂ ≤ C0 * x ^ (1 / 2 - σ) →
            Ni i₃ ≤ C0 * x ^ (1 / 2 - σ) →
          ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
          ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
            (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
                q ∣ (∏ p ∈ I, p) ∧
                  Nonempty (DenseDivisibilityWitness
                    ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩ density q)),
              ‖fullDiscrepancy (∏ i, β i).coeff q a‖) ≤
                K * x / (Real.log x) ^ A := by
  let C : ℝ := (2 : ℝ) ^ 40 * C0
  have hC0pos : 0 < C0 := zero_lt_one.trans_le hC0
  have hC0C : C0 ≤ C := by
    exact le_mul_of_one_le_left hC0pos.le (one_le_pow₀ (by norm_num))
  have hCtwo : 2 ≤ C := by
    have htwo : (2 : ℝ) ≤ (2 : ℝ) ^ 40 := by norm_num
    exact htwo.trans (le_mul_of_one_le_right (by positivity) hC0)
  have hC : 1 ≤ C := one_le_two.trans hCtwo
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  let ε : ℝ := min (1 / 100)
    (min ((3 * σ / 4 - 7 * «ω» / 3 - δ / 6 - 1 / 24) / 8)
      ((1 / 2 + δ - 6 * «ω») / 12))
  have hε : 0 < ε :=
    (typeIII_positive_smooth_convolution_global_log_saving_of_deligne
      hDeligne «ω» δ σ C 0 40 40 hω hωupper hδ hC hσ).1
  let κ : ℝ := ε / 4
  have hκ : 0 ≤ κ := (div_pos hε (by norm_num)).le
  let J : ℕ := Nat.ceil (22 / ε)
  let E : ℝ := ((D * (J + 2) + 1 : ℕ) : ℝ)
  obtain ⟨Cder, hCder, hprofiles⟩ := heathBrown_smooth_geometric_factor_profiles
  let Lder : ℝ := 3 * (1 + ∑ r ∈ Finset.range (J + 2 + 1), Cder r)
  have hLder : 0 < Lder := by
    have hsum : 0 ≤ ∑ r ∈ Finset.range (J + 2 + 1), Cder r :=
      Finset.sum_nonneg fun r _ => (hCder r).le
    dsimp only [Lder]
    positivity
  intro A hA
  obtain ⟨K0, X0, hK0, hX0, hglobal⟩ :=
    (typeIII_positive_smooth_convolution_global_log_saving_of_deligne
      hDeligne «ω» δ σ C E 40 40 hω hωupper hδ hC hσ).2
        ε hε le_rfl A hA
  refine ⟨K0 * ((3 : ℝ) ^ 40 * Lder * Lder * Lder), max X0 C0,
    by positivity, hX0.trans (le_max_left _ _), ?_⟩
  intro x hx Θ U η μU f ν Ni β hlo hhi i₁ i₂ i₃ h12 h13 h23 hi₁ hi₂ hi₃
    hpair12 hpair13 hpair23 hupper₁ hupper₂ hupper₃ I hI a ha
  have hx0 : X0 ≤ x := (le_max_left _ _).trans hx
  have hC0x : C0 ≤ x := (le_max_right _ _).trans hx
  have hxexp : Real.exp 1 ≤ x := hX0.trans hx0
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hxone : 1 ≤ x := (Real.one_le_exp (by norm_num)).trans hxexp
  have hlog : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hxexp
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlog
  have hΘ : 1 < Θ :=
    lt_add_of_pos_right 1 (Real.rpow_pos_of_pos hlogpos _)
  have hΘtwo : Θ ≤ 2 := by
    have hh : (Real.log x) ^ (-(D : ℝ)) ≤ 1 :=
      Real.rpow_le_one_of_one_le_of_nonpos hlog (neg_nonpos.mpr (Nat.cast_nonneg D))
    change 1 + (Real.log x) ^ (-(D : ℝ)) ≤ 2
    linarith
  have hNi (i : Fin (2 * j)) : 1 ≤ Ni i := one_le_pow₀ hΘ.le
  have hNiupper (i : Fin (2 * j)) : Ni i ≤ x ^ 2 := by
    calc
      Ni i ≤ ∏ l, Ni l :=
        Multiset.mem_le_prod_of_one_le (s := Finset.univ.val) hNi (Finset.mem_univ i)
      _ ≤ C0 * x := hhi
      _ ≤ x * x := mul_le_mul_of_nonneg_right hC0x hxpos.le
      _ = x ^ 2 := (sq x).symm
  obtain ⟨hslots, hslotnorm, _⟩ :=
    heathBrown_geometric_slots_support_norm j Θ U x C0 Ni hΘ hΘtwo hxexp hC0x hNi hhi
  change ∀ i, ∀ n ∈ (β i).coeff.support,
    Ni i / 2 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * Ni i at hslots
  change ∀ i n, ‖(β i).coeff n‖ ≤ 3 * Real.log x at hslotnorm
  let T : Finset (Fin (2 * j)) := Finset.univ \ {i₁, i₂, i₃}
  have hselectedCard : ({i₁, i₂, i₃} : Finset (Fin (2 * j))).card = 3 := by
    simp [h12, h13, h23]
  have hTcardEq : T.card + 3 = 2 * j := by
    simpa only [T, hselectedCard, Finset.card_univ, Fintype.card_fin] using
      Finset.card_sdiff_add_card_eq_card
        (Finset.subset_univ ({i₁, i₂, i₃} : Finset (Fin (2 * j))))
  have hTne : T.Nonempty := by
    apply Finset.card_pos.mp
    omega
  have hTcard : T.card ≤ 40 := by omega
  let M : ℝ := ∏ i ∈ T, Ni i
  let α : ℕ →₀ ℂ := (∏ i ∈ T, β i).coeff
  have hM : 1 ≤ M := Finset.one_le_prod fun i _ => hNi i
  have hMpos : 0 < M := zero_lt_one.trans_le hM
  have hsplitN : (∏ i, Ni i) = M * (Ni i₁ * Ni i₂ * Ni i₃) := by
    simpa [M, T, h12, h13, h23, mul_assoc] using
      (Finset.prod_sdiff (f := Ni)
        (Finset.subset_univ ({i₁, i₂, i₃} : Finset (Fin (2 * j))))).symm
  have hsplitβ : (∏ i, β i) = (∏ i ∈ T, β i) * (β i₁ * β i₂ * β i₃) := by
    simpa [T, h12, h13, h23, mul_assoc] using
      (Finset.prod_sdiff (f := β)
        (Finset.subset_univ ({i₁, i₂, i₃} : Finset (Fin (2 * j))))).symm
  have hfactor : (∏ i, β i).coeff =
      finiteConvolution α (finiteConvolution (β i₁).coeff
        (finiteConvolution (β i₂).coeff (β i₃).coeff)) := by
    simpa only [finiteConvolution, α, MonoidAlgebra.ofCoeff_coeff, mul_assoc] using
      congrArg (fun v : MonoidAlgebra ℂ ℕ => v.coeff) hsplitβ
  obtain ⟨hαsupport, hαnorm⟩ :=
    heathBrown_box_product_support_norm_bound T hTne β Ni (3 * Real.log x)
      (by positivity) (fun i _ => hNi i) (fun i _ => hslots i) (fun i _ => hslotnorm i)
  change ∀ n ∈ α.support,
    M / (2 : ℝ) ^ T.card ≤ (n : ℝ) ∧ (n : ℝ) ≤ (2 : ℝ) ^ T.card * M at hαsupport
  change ∀ n, ‖α n‖ ≤ (3 * Real.log x) ^ T.card *
    (n.divisors.card : ℝ) ^ (T.card - 1) at hαnorm
  have htwoCard : (2 : ℝ) ^ T.card ≤ C :=
    (pow_le_pow_right₀ one_le_two hTcard).trans
      (le_mul_of_one_le_right (by positivity) hC0)
  have hαwindow (n : ℕ) (hn : n ∈ α.support) :
      M / C ≤ (n : ℝ) ∧ (n : ℝ) ≤ C * M :=
    ⟨(div_le_div_of_nonneg_left hMpos.le (pow_pos zero_lt_two _) htwoCard).trans
        (hαsupport n hn).1,
      (hαsupport n hn).2.trans (mul_le_mul_of_nonneg_right htwoCard hMpos.le)⟩
  have hαgrowth (n : ℕ) (hn : n ∈ α.support) :
      ‖α n‖ ≤ (3 : ℝ) ^ 40 * (n.divisors.card : ℝ) ^ 40 * (Real.log x) ^ (40 : ℝ) := by
    have hnpos : 0 < n := by
      exact_mod_cast (div_pos hMpos (pow_pos zero_lt_two T.card)).trans_le
        (hαsupport n hn).1
    have hτ : 1 ≤ (n.divisors.card : ℝ) := by
      exact_mod_cast Finset.one_le_card.mpr (Nat.nonempty_divisors.mpr hnpos.ne')
    have h3 : (3 : ℝ) ^ T.card ≤ (3 : ℝ) ^ 40 :=
      pow_le_pow_right₀ (by norm_num) hTcard
    have hL : (Real.log x) ^ T.card ≤ (Real.log x) ^ 40 :=
      pow_le_pow_right₀ hlog hTcard
    have hτpow : (n.divisors.card : ℝ) ^ (T.card - 1) ≤
        (n.divisors.card : ℝ) ^ 40 :=
      pow_le_pow_right₀ hτ ((Nat.sub_le _ _).trans hTcard)
    calc
      ‖α n‖ ≤ (3 * Real.log x) ^ T.card *
          (n.divisors.card : ℝ) ^ (T.card - 1) := hαnorm n
      _ = (3 : ℝ) ^ T.card * (Real.log x) ^ T.card *
          (n.divisors.card : ℝ) ^ (T.card - 1) := by rw [mul_pow]
      _ ≤ (3 : ℝ) ^ 40 * (Real.log x) ^ 40 * (n.divisors.card : ℝ) ^ 40 :=
        mul_le_mul
          (mul_le_mul h3 hL (pow_nonneg hlogpos.le _)
            (pow_nonneg (by norm_num : (0 : ℝ) ≤ 3) _)) hτpow
          (pow_nonneg (Nat.cast_nonneg _) _)
          (mul_nonneg (pow_nonneg (by norm_num : (0 : ℝ) ≤ 3) _)
            (pow_nonneg hlogpos.le _))
      _ = (3 : ℝ) ^ 40 * (n.divisors.card : ℝ) ^ 40 *
          (Real.log x) ^ (40 : ℝ) := by
        simpa only [Real.rpow_ofNat] using
          (mul_right_comm ((3 : ℝ) ^ (40 : ℕ)) ((Real.log x) ^ (40 : ℕ))
            ((n.divisors.card : ℝ) ^ (40 : ℕ)))
  let logRole : Fin (2 * j) → Bool := fun i => decide (i.val + 1 = 2 * j)
  let ψ : Fin (2 * j) → ℝ → ℂ := fun i u =>
    ((η u * (if logRole i then Real.log (Ni i * u) else 1) : ℝ) : ℂ)
  have hsmooth (i : Fin (2 * j)) (hi : j ≤ i.val) :
      ContDiff ℝ ∞ (ψ i) ∧ Function.support (ψ i) ⊆ Set.Icc (1 / C) C ∧
      (β i).coeff = positiveCompactProfileSequence (ψ i) C (Ni i) 0 ∧
      ∀ r u, ‖iteratedDeriv r (ψ i) u‖ ≤
        Cder r * (1 + Real.log (Ni i)) / (Θ - 1) ^ r := by
    by_cases hlast : i.val + 1 = 2 * j
    · simpa only [ψ, β, f, logRole, decide_eq_true_eq,
        ite_eq_right (not_lt.mpr hi), ite_eq_left hlast, ↓reduceIte] using
        hprofiles Θ hΘ hΘtwo (Ni i) (hNi i) C hCtwo true
    · simpa only [ψ, β, f, logRole, decide_eq_true_eq,
        ite_eq_right (not_lt.mpr hi), ite_eq_right hlast,
        Bool.false_eq_true, ↓reduceIte] using
        hprofiles Θ hΘ hΘtwo (Ni i) (hNi i) C hCtwo false
  obtain ⟨hψ₁, hsupp₁, hβ₁, hder₁⟩ := hsmooth i₁ hi₁
  obtain ⟨hψ₂, hsupp₂, hβ₂, hder₂⟩ := hsmooth i₂ hi₂
  obtain ⟨hψ₃, hsupp₃, hβ₃, hder₃⟩ := hsmooth i₃ hi₃
  have hderivative (i : Fin (2 * j))
      (hh : ∀ r u, ‖iteratedDeriv r (ψ i) u‖ ≤
        Cder r * (1 + Real.log (Ni i)) / (Θ - 1) ^ r) :
      ∀ r : ℕ, r ≤ J + 2 → ∀ u : ℝ,
        ‖iteratedDeriv r (ψ i) u‖ ≤ Lder * (Real.log x) ^ E := by
    simpa only [Lder, E, Real.rpow_natCast] using
      heathBrown_geometric_derivatives_log_bound Cder (fun r => (hCder r).le)
        D (J + 2) x (Ni i) hxexp (hNi i) (hNiupper i) (ψ i) hh
  have hpair {u v : ℝ} (h : x ^ (1 / 2 + σ) / C0 ≤ u * v) :
      x ^ (1 / 2 + σ - κ) / C ≤ u * v := by
    calc
      x ^ (1 / 2 + σ - κ) / C ≤ x ^ (1 / 2 + σ) / C :=
        div_le_div_of_nonneg_right
          (Real.rpow_le_rpow_of_exponent_le hxone (by linarith)) hCpos.le
      _ ≤ x ^ (1 / 2 + σ) / C0 :=
        div_le_div_of_nonneg_left (Real.rpow_nonneg hxpos.le _) hC0pos hC0C
      _ ≤ u * v := h
  have hupper {u : ℝ} (h : u ≤ C0 * x ^ (1 / 2 - σ)) :
      u ≤ C * x ^ (1 / 2 - σ + κ) :=
    h.trans (mul_le_mul hC0C
      (Real.rpow_le_rpow_of_exponent_le hxone (by linarith))
      (Real.rpow_nonneg hxpos.le _) hCpos.le)
  have htotalLower : x / C ≤ M * (Ni i₁ * Ni i₂ * Ni i₃) := by
    rw [← hsplitN]
    exact (div_le_div_of_nonneg_left hxpos.le hC0pos hC0C).trans hlo
  have htotalUpper : M * (Ni i₁ * Ni i₂ * Ni i₃) ≤ C * x := by
    rw [← hsplitN]
    exact hhi.trans (mul_le_mul_of_nonneg_right hC0C hxpos.le)
  let Y : Set.Ici (1 : ℝ) := ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩
  have hY : (Y : ℝ) = x ^ δ := max_eq_right (Real.one_le_rpow hxone hδ.le)
  let S : Finset ℕ := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
      q ∣ (∏ p ∈ I, p) ∧
        Nonempty (DenseDivisibilityWitness
          Y density q))
  change (∑ q ∈ S, ‖fullDiscrepancy (∏ i, β i).coeff q a‖) ≤
    (K0 * ((3 : ℝ) ^ 40 * Lder * Lder * Lder)) * x / (Real.log x) ^ A
  have hSdata (q : ℕ) (hq : q ∈ S) :
      1 ≤ q ∧ q ≤ ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊ ∧ q ∣ (∏ p ∈ I, p) ∧
        Nonempty (DenseDivisibilityWitness Y density q) := by
    change q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter
      (fun q => q ∣ (∏ p ∈ I, p) ∧
        Nonempty (DenseDivisibilityWitness Y density q)) at hq
    obtain ⟨hqIcc, hqdvd, hqdd⟩ := Finset.mem_filter.mp hq
    exact ⟨(Finset.mem_Icc.mp hqIcc).1, (Finset.mem_Icc.mp hqIcc).2, hqdvd, hqdd⟩
  let lift : {q // q ∈ S} → ℕ+ := fun q =>
    ⟨q.val, lt_of_lt_of_le Nat.zero_lt_one (hSdata q.val q.property).1⟩
  let Qset : Finset ℕ+ := S.attach.image lift
  have hlift : Function.Injective lift := by
    intro q r h
    apply Subtype.ext
    exact congrArg (fun z : ℕ+ => (z : ℕ)) h
  have hIcf : Squarefree (∏ p ∈ I, p) := by
    refine Finset.squarefree_prod_of_pairwise_isCoprime
      (fun p hp q hq hpq => ?_) (fun p hp => (hI p hp).squarefree)
    exact Nat.coprime_iff_isRelPrime.mp
      ((Nat.coprime_primes (hI p hp) (hI q hq)).2 hpq)
  have hQset (q : ℕ+) (hq : q ∈ Qset) :
      Squarefree (q : ℕ) ∧
      Nonempty (DenseDivisibilityWitness Y 1 (q : ℕ)) ∧
      (q : ℝ) ≤ C * x ^ (1 / 2 + 2 * «ω» + κ) := by
    rcases Finset.mem_image.mp hq with ⟨r, _, rfl⟩
    obtain ⟨_, hrupper, hrdvd, hrdd⟩ := hSdata r.val r.property
    refine ⟨hIcf.squarefree_of_dvd hrdvd,
      denseDivisibility_mono_order hrdd hdensity, ?_⟩
    calc
      ((lift r : ℕ+) : ℝ) = (r.val : ℝ) := rfl
      _ ≤ (⌊x ^ (1 / 2 + 2 * «ω»)⌋₊ : ℝ) := Nat.cast_le.mpr hrupper
      _ ≤ x ^ (1 / 2 + 2 * «ω») := Nat.floor_le (Real.rpow_nonneg hxpos.le _)
      _ ≤ x ^ (1 / 2 + 2 * «ω» + κ) :=
        Real.rpow_le_rpow_of_exponent_le hxone (by linarith)
      _ ≤ C * x ^ (1 / 2 + 2 * «ω» + κ) :=
        le_mul_of_one_le_left (Real.rpow_nonneg hxpos.le _) hC
  have haunit (q : ℕ+) (hq : q ∈ Qset) : IsUnit ((a : ℤ) : ZMod (q : ℕ)) := by
    rcases Finset.mem_image.mp hq with ⟨r, _, rfl⟩
    change IsUnit ((a : ℤ) : ZMod r.val)
    simpa only [Int.cast_natCast] using
      (ZMod.isUnit_iff_coprime a r.val).mpr
        (ha.of_dvd_right (hSdata r.val r.property).2.2.1)
  have hphysical := hglobal x hx0 M (Ni i₁) (Ni i₂) (Ni i₃)
    hM (hNi i₁) (hNi i₂) (hNi i₃) htotalLower htotalUpper
    (hpair hpair12) (hpair hpair13) (hpair hpair23)
    (hupper hupper₁) (hupper hupper₂) (hupper hupper₃)
    Y hY Qset hQset ((3 : ℝ) ^ 40) Lder Lder Lder
    (by positivity) hLder.le hLder.le hLder.le α hαwindow hαgrowth
    (ψ i₁) (ψ i₂) (ψ i₃) hψ₁ hψ₂ hψ₃ hsupp₁ hsupp₂ hsupp₃
    (hderivative i₁ hder₁) (hderivative i₂ hder₂) (hderivative i₃ hder₃)
    (a : ℤ) haunit
  have hf : finiteConvolution α
      (finiteConvolution (positiveCompactProfileSequence (ψ i₁) C (Ni i₁) 0)
        (finiteConvolution (positiveCompactProfileSequence (ψ i₂) C (Ni i₂) 0)
          (positiveCompactProfileSequence (ψ i₃) C (Ni i₃) 0))) =
        (∏ i, β i).coeff := by
    rw [← hβ₁, ← hβ₂, ← hβ₃, ← hfactor]
  rw [hf] at hphysical
  have hdisc (q : ℕ+) :
      ((∑ n ∈ (∏ i, β i).coeff.support,
          if (n : ZMod (q : ℕ)) = ((a : ℤ) : ZMod (q : ℕ)) then
            (∏ i, β i).coeff n else 0) -
        ((q : ℕ).totient : ℂ)⁻¹ *
          (∑ n ∈ (∏ i, β i).coeff.support,
            if Nat.Coprime n (q : ℕ) then (∏ i, β i).coeff n else 0)) =
        fullDiscrepancy (∏ i, β i).coeff (q : ℕ) a := by
    simp only [fullDiscrepancy, progressionMass, reducedMass, Int.cast_natCast,
      ZMod.natCast_eq_natCast_iff', div_eq_mul_inv, mul_comm]
  simp only [hdisc] at hphysical
  have hsum : (∑ q ∈ Qset, ‖fullDiscrepancy (∏ i, β i).coeff (q : ℕ) a‖) =
      ∑ q ∈ S, ‖fullDiscrepancy (∏ i, β i).coeff q a‖ := by
    change (∑ q ∈ S.attach.image lift,
      ‖fullDiscrepancy (∏ i, β i).coeff (q : ℕ) a‖) = _
    rw [Finset.sum_image hlift.injOn]
    exact Finset.sum_attach S (fun q => ‖fullDiscrepancy (∏ i, β i).coeff q a‖)
  rw [hsum] at hphysical
  exact hphysical

open Classical in
theorem sum_norm_closed_heathBrown_discrepancy_le
    (K : ℕ) (hK : 0 < K) (U x : ℝ)
    (hU : 0 ≤ U) (hx : 0 ≤ x) (hcut : 2 * x ≤ U ^ K)
    (S : Finset ℕ) (a : ℕ → ℕ) :
    (∑ q ∈ S, ‖fullDiscrepancy
      (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ))
      q (a q)‖) ≤
      ∑ j ∈ Finset.range K, (K.choose (j + 1) : ℝ) *
        ∑ q ∈ S, ‖fullDiscrepancy
          (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n
              (((arithmeticFunctionLowCutoff U
                  (ArithmeticFunction.moebius : ArithmeticFunction ℝ)) ^ (j + 1) *
                (ArithmeticFunction.zeta : ArithmeticFunction ℝ) ^ j *
                  ArithmeticFunction.log) n : ℂ))
          q (a q)‖ := by
  let I : Finset ℕ := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
  let H : ℕ → ArithmeticFunction ℝ := fun j =>
    (arithmeticFunctionLowCutoff U
        (ArithmeticFunction.moebius : ArithmeticFunction ℝ)) ^ (j + 1) *
      (ArithmeticFunction.zeta : ArithmeticFunction ℝ) ^ j * ArithmeticFunction.log
  let T : ℕ → ℕ →₀ ℂ := fun j =>
    ∑ n ∈ I, Finsupp.single n ((H j n : ℝ) : ℂ)
  let c : ℕ → ℂ := fun j => (-1 : ℂ) ^ j * (K.choose (j + 1) : ℂ)
  let L : ℕ →₀ ℂ :=
    ∑ n ∈ I, Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)
  let D (q b : ℕ) : (ℕ →₀ ℂ) →ₗ[ℂ] ℂ :=
    Finsupp.linearCombination ℂ (fun n : ℕ =>
      (if n % q = b % q then (1 : ℂ) else 0) -
        (if Nat.Coprime n q then (1 : ℂ) else 0) / (q.totient : ℂ))
  have hD (g : ℕ →₀ ℂ) (q b : ℕ) :
      D q b g = fullDiscrepancy g q b := by
    simp only [D, Finsupp.linearCombination_apply,
      fullDiscrepancy_eq_finsupp_sum, smul_eq_mul,
      mul_sub, ← mul_div_assoc, mul_ite, mul_one, mul_zero]
  have hpoint (n : ℕ) (hn : n ∈ I) :
      ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ) =
        ∑ j ∈ Finset.range K, c j * ((H j n : ℝ) : ℂ) := by
    have hncut : (n : ℝ) ≤ U ^ K :=
      ((Nat.cast_le.mpr (Finset.mem_Icc.mp hn).2).trans
        (Nat.floor_le (mul_nonneg (by norm_num) hx))).trans hcut
    have hid := heathBrown_identity hK hU hncut
    let ev : ArithmeticFunction ℝ →+ ℝ :=
      { toFun := fun f => f n
        map_zero' := rfl
        map_add' := fun _ _ => rfl }
    have hsum : heathBrownSum K U n =
        ∑ j ∈ Finset.range K,
          ((-1 : ℝ) ^ j * (K.choose (j + 1) : ℝ)) * H j n :=
      map_sum ev _ _
    have hreal := hid.trans hsum
    dsimp only [c]
    exact_mod_cast hreal
  have hL : L = ∑ j ∈ Finset.range K, c j • T j := by
    calc
      L = ∑ n ∈ I, Finsupp.single n
          (∑ j ∈ Finset.range K, c j * ((H j n : ℝ) : ℂ)) := by
        apply Finset.sum_congr rfl
        intro n hn
        rw [hpoint n hn]
      _ = ∑ n ∈ I, ∑ j ∈ Finset.range K,
          c j • Finsupp.single n ((H j n : ℝ) : ℂ) := by
        simp only [Finsupp.single_finsetSum, Finsupp.smul_single, smul_eq_mul]
      _ = ∑ j ∈ Finset.range K, c j • T j := by
        rw [Finset.sum_comm]
        simp only [T, Finset.smul_sum]
  have hc (j : ℕ) : ‖c j‖ = (K.choose (j + 1) : ℝ) := by
    simp only [c, norm_mul, norm_pow, norm_neg, norm_one, one_pow, one_mul,
      Complex.norm_natCast]
  change (∑ q ∈ S, ‖fullDiscrepancy L q (a q)‖) ≤
    ∑ j ∈ Finset.range K, (K.choose (j + 1) : ℝ) *
      ∑ q ∈ S, ‖fullDiscrepancy (T j) q (a q)‖
  calc
    (∑ q ∈ S, ‖fullDiscrepancy L q (a q)‖) =
        ∑ q ∈ S, ‖∑ j ∈ Finset.range K,
          c j * fullDiscrepancy (T j) q (a q)‖ := by
      apply Finset.sum_congr rfl
      intro q _hq
      rw [← hD L q (a q), hL, map_sum]
      simp_rw [map_smul, smul_eq_mul, hD]
    _ ≤ ∑ q ∈ S, ∑ j ∈ Finset.range K,
        (K.choose (j + 1) : ℝ) * ‖fullDiscrepancy (T j) q (a q)‖ := by
      apply Finset.sum_le_sum
      intro q _hq
      exact norm_sum_le_of_le _ (fun j _ => by rw [norm_mul, hc])
    _ = ∑ j ∈ Finset.range K, (K.choose (j + 1) : ℝ) *
        ∑ q ∈ S, ‖fullDiscrepancy (T j) q (a q)‖ := by
      rw [Finset.sum_comm]
      simp only [Finset.mul_sum]

open Classical in
theorem heathBrown_subpower_log_saving_of_retreat
    (density : ℕ) («ω» δ ω' δ' : ℝ)
    (hωretreat : «ω» < ω') (hδretreat : δ ≤ δ')
    (hcore :
      ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
        ∀ x : ℝ, X ≤ x →
        ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
        ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
          let Λx : ℕ →₀ ℂ :=
            ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
              Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)
          (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * ω')⌋₊).filter (fun q =>
                  q ∣ (∏ p ∈ I, p) ∧
                    Nonempty (DenseDivisibilityWitness
                      ⟨max 1 (x ^ δ'), by exact le_max_left (1 : ℝ) (x ^ δ')⟩ density q)),
            ‖fullDiscrepancy Λx q a‖) ≤ K * x / (Real.log x) ^ A)
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Filter.Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x)
      Filter.atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ),
        (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let Λx : ℕ →₀ ℂ :=
          ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)
        let Q : Finset ℕ :=
          (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter
            (fun q => q ∣ ∏ p ∈ I, p ∧
              Nonempty (DenseDivisibilityWitness Y density q))
        (∑ q ∈ Q, ‖fullDiscrepancy Λx q a‖) ≤
          K * x / (Real.log x) ^ A := by
  have hsubpower : ∀ᶠ x : ℝ in Filter.atTop, L0 x ≤ x ^ (ω' - «ω») := by
    have hsmall := (tendsto_order.mp hL0sub).2 (ω' - «ω») (sub_pos.mpr hωretreat)
    filter_upwards [hsmall, Filter.eventually_gt_atTop (1 : ℝ)] with x hx hx1
    have hxpos : 0 < x := zero_lt_one.trans hx1
    apply (Real.log_le_log_iff (hL0 x)
      (Real.rpow_pos_of_pos hxpos (ω' - «ω»))).mp
    rw [Real.log_rpow hxpos]
    exact ((div_lt_iff₀ (Real.log_pos hx1)).mp hx).le
  obtain ⟨Xsub, hXsub⟩ := Filter.eventually_atTop.mp hsubpower
  intro A hA
  obtain ⟨K, Xcore, hK, _, hcore⟩ :=
    hcore A hA
  refine ⟨K, max (max Xcore Xsub) 2, hK,
    (by norm_num : (1 : ℝ) < 2).trans_le (le_max_right _ _), ?_⟩
  intro x hx Y hY I hI a ha Λx Q
  have hxcore : Xcore ≤ x :=
    (le_max_left _ _).trans ((le_max_left _ _).trans hx)
  have hxsub : Xsub ≤ x :=
    (le_max_right _ _).trans ((le_max_left _ _).trans hx)
  have hxtwo : (2 : ℝ) ≤ x := (le_max_right _ _).trans hx
  have hxone : 1 ≤ x := by linarith
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  have hcutoff : x ^ (1 / 2 + 2 * «ω») * L0 x ≤ x ^ (1 / 2 + 2 * ω') := by
    calc
      x ^ (1 / 2 + 2 * «ω») * L0 x ≤
          x ^ (1 / 2 + 2 * «ω») * x ^ (ω' - «ω») :=
        mul_le_mul_of_nonneg_left (hXsub x hxsub) (Real.rpow_nonneg hxpos.le _)
      _ = x ^ ((1 / 2 + 2 * «ω») + (ω' - «ω»)) := (Real.rpow_add hxpos _ _).symm
      _ ≤ x ^ (1 / 2 + 2 * ω') :=
        Real.rpow_le_rpow_of_exponent_le hxone (by linarith)
  let Y' : Set.Ici (1 : ℝ) := ⟨max 1 (x ^ δ'), by exact le_max_left (1 : ℝ) (x ^ δ')⟩
  have hscale : (Y : ℝ) ≤ (Y' : ℝ) := by
    rw [hY]
    exact (Real.rpow_le_rpow_of_exponent_le hxone hδretreat).trans (le_max_right _ _)
  have hsubset : Q ⊆ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * ω')⌋₊).filter (fun q =>
      q ∣ (∏ p ∈ I, p) ∧
        Nonempty (DenseDivisibilityWitness
          Y' density q)) := by
    intro q hq
    change q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter
      (fun q => q ∣ ∏ p ∈ I, p ∧
        Nonempty (DenseDivisibilityWitness Y density q)) at hq
    obtain ⟨hqIcc, hqdvd, hqdd⟩ := Finset.mem_filter.mp hq
    exact Finset.mem_filter.mpr
      ⟨Finset.mem_Icc.mpr ⟨(Finset.mem_Icc.mp hqIcc).1,
        (Finset.mem_Icc.mp hqIcc).2.trans (Nat.floor_mono hcutoff)⟩,
        hqdvd, denseDivisibility_mono_scale hscale hqdd⟩
  have hbound := hcore x hxcore I hI a ha
  change (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * ω')⌋₊).filter (fun q =>
      q ∣ (∏ p ∈ I, p) ∧
        Nonempty (DenseDivisibilityWitness
          Y' density q)),
    ‖fullDiscrepancy Λx q a‖) ≤ K * x / (Real.log x) ^ A at hbound
  exact (Finset.sum_le_sum_of_subset_of_nonneg hsubset
    (fun q _ _ => norm_nonneg (fullDiscrepancy Λx q a))).trans hbound

open Classical in
theorem lowerOrder_mpz_parameter_retreat
    (density : ℕ) («ω» δ σ : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hωupper : «ω» < 1 / 4)
    (hδupper : δ < 1 / 4 + «ω») (hσhalf : σ < 1 / 2)
    (hσgap : 2 * «ω» < σ)
    (hI : (density = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1) ∨
      (density = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1))
    (hII : 68 * «ω» + 14 * δ < 1)
    (hIII : 1 / 18 + 28 / 9 * «ω» + 2 / 9 * δ < σ) :
    ∃ ω' δ' σdist : ℝ,
      «ω» < ω' ∧ δ < δ' ∧ 0 < ω' ∧ 0 < δ' ∧
      ω' < 1 / 12 ∧ δ' < 1 / 4 + ω' ∧
      σ < σdist ∧ σdist < 1 / 2 ∧ 2 * ω' < σ ∧
      ((density = 1 ∧ 54 * ω' + 15 * δ' + 5 * σdist < 1) ∨
        (density = 2 ∧ 56 * ω' + 16 * δ' + 4 * σdist < 1)) ∧
      68 * ω' + 14 * δ' < 1 ∧
      1 / 18 + 28 / 9 * ω' + 2 / 9 * δ' < σ := by
  let mI : ℝ := if density = 1 then 1 - (54 * «ω» + 15 * δ + 5 * σ)
    else 1 - (56 * «ω» + 16 * δ + 4 * σ)
  have hmI : 0 < mI := by
    rcases hI with ⟨hd, hi⟩ | ⟨hd, hi⟩
    · simpa only [mI, ite_eq_left hd] using sub_pos.mpr hi
    · have hd' : density ≠ 1 := by omega
      simpa only [mI, ite_eq_right hd'] using sub_pos.mpr hi
  let cap : ℝ := min (1 / 4 - «ω») (min (1 / 2 - σ)
    (min (σ - 2 * «ω») (min mI
      (min (1 - 68 * «ω» - 14 * δ) (σ - 1 / 18 - 28 / 9 * «ω» - 2 / 9 * δ)))))
  have hcap : 0 < cap := by
    dsimp only [cap]
    simp only [lt_min_iff]
    exact ⟨sub_pos.mpr hωupper, sub_pos.mpr hσhalf, sub_pos.mpr hσgap,
      hmI, by linarith only [hII], by linarith only [hIII]⟩
  let ε : ℝ := cap / 1000
  have hε : 0 < ε := div_pos hcap (by norm_num)
  have hbound : 1000 * ε ≤ cap := by
    dsimp only [ε]
    linarith
  dsimp only [cap] at hbound
  rcases le_min_iff.mp hbound with ⟨_, hbound⟩
  rcases le_min_iff.mp hbound with ⟨hσcap, hbound⟩
  rcases le_min_iff.mp hbound with ⟨hgapcap, hbound⟩
  rcases le_min_iff.mp hbound with ⟨hIcap, hbound⟩
  rcases le_min_iff.mp hbound with ⟨hIIcap, hIIIcap⟩
  have hII' : 68 * («ω» + ε) + 14 * (δ + ε) < 1 := by
    linarith only [hIIcap, hε]
  refine ⟨«ω» + ε, δ + ε, σ + ε,
    lt_add_of_pos_right _ hε, lt_add_of_pos_right _ hε,
    add_pos hω hε, add_pos hδ hε, ?_, ?_,
    lt_add_of_pos_right _ hε, ?_, ?_, ?_, hII', ?_⟩
  · linarith only [hII', add_pos hδ hε]
  · linarith only [hδupper]
  · linarith only [hσcap, hε]
  · linarith only [hgapcap, hε]
  · rcases hI with ⟨hd, _⟩ | ⟨hd, _⟩
    · left
      refine ⟨hd, ?_⟩
      have hh : 1000 * ε ≤ 1 - (54 * «ω» + 15 * δ + 5 * σ) := by
        simpa only [mI, ite_eq_left hd] using hIcap
      linarith only [hh, hε]
    · right
      refine ⟨hd, ?_⟩
      have hd' : density ≠ 1 := by omega
      have hh : 1000 * ε ≤ 1 - (56 * «ω» + 16 * δ + 4 * σ) := by
        simpa only [mI, ite_eq_right hd'] using hIcap
      linarith only [hh, hε]
  · linarith only [hIIIcap, hε]

open Classical in
theorem vonMangoldt_closedSubinterval_divisor_weight_log_saving_of_dyadic
    (j : ℕ) (θ₀ θ₁ δ₀ δ₁ : ℝ)
    (hθ₀ : 0 < θ₀) (hθ : θ₀ < θ₁)
    (hδ₀ : 0 < δ₀) (hδ : δ₀ < δ₁) (hθsmall : θ₀ < 2 / 3)
    (hDyadic : ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ y : ℝ, X ≤ y →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊y ^ θ₁⌋₊).filter (fun q =>
          q ∣ ∏ p ∈ I, p ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (y ^ δ₁), le_max_left (1 : ℝ) (y ^ δ₁)⟩ j q)),
          ‖fullDiscrepancy
            (∑ n ∈ Finset.Icc ⌈y⌉₊ ⌊2 * y⌋₊,
              Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q a‖) ≤
            K * y / (Real.log y) ^ A) (J : ℕ) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      ∀ u v : ℝ, x ≤ u → u ≤ v → v ≤ 2 * x →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊x ^ θ₀⌋₊).filter (fun q =>
          q ∣ ∏ p ∈ I, p ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (x ^ δ₀), le_max_left (1 : ℝ) (x ^ δ₀)⟩ j q)),
          (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy
            (∑ n ∈ Finset.Icc ⌈u⌉₊ ⌊v⌋₊,
              Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q a‖) ≤
            K * x / (Real.log x) ^ A := by
  intro A hA
  let Lamp : ℝ := 1 + Real.log 2
  have hLamp : 0 < Lamp := by
    dsimp only [Lamp]
    linarith only [Real.log_nonneg (by norm_num : (1 : ℝ) ≤ 2)]
  have hθone : θ₀ < 1 := by linarith only [hθsmall]
  obtain ⟨P, Kg, hKg, hgrowth⟩ :=
    weighted_fullDiscrepancy_positiveSupport_log_growth
      θ₀ hθ₀ hθone 0 (2 * J) 1 2 (by norm_num)
  obtain ⟨Ks, Xs, hKs, hXs, hsmall⟩ :=
    vonMangoldt_closedSubinterval_log_saving_of_dyadic
      j θ₀ θ₁ δ₀ δ₁ hθ₀ hθ hδ₀ hδ hθsmall hDyadic
      (2 * A + (P : ℝ)) (by positivity)
  refine ⟨Ks + Kg * Lamp, Xs, by positivity, hXs, ?_⟩
  intro x hx u v hxu huv hvx I hI a ha
  let Λuv : ℕ →₀ ℂ :=
    ∑ n ∈ Finset.Icc ⌈u⌉₊ ⌊v⌋₊,
      Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)
  let Q : Finset ℕ := (Finset.Icc 1 ⌊x ^ θ₀⌋₊).filter (fun q =>
    q ∣ ∏ p ∈ I, p ∧
    Nonempty (DenseDivisibilityWitness
      ⟨max 1 (x ^ δ₀), le_max_left (1 : ℝ) (x ^ δ₀)⟩ j q))
  change (∑ q ∈ Q, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy Λuv q a‖) ≤ _
  have hxexp : Real.exp 1 ≤ x := hXs.trans hx
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hlogone : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxpos).mpr hxexp
  have hlog : 0 < Real.log x := zero_lt_one.trans_le hlogone
  have hvpos : 0 < v := hxpos.trans_le (hxu.trans huv)
  have hvalue (n : ℕ) :
      Λuv n = if n ∈ Finset.Icc ⌈u⌉₊ ⌊v⌋₊ then
        ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ) else 0 := by
    simp only [Λuv, Finsupp.finsetSum_apply, Finsupp.single_apply,
      Finset.sum_ite_eq']
  have hmem (n : ℕ) (hn : n ∈ Λuv.support) : n ∈ Finset.Icc ⌈u⌉₊ ⌊v⌋₊ := by
    by_contra h
    exact (Finsupp.mem_support_iff.mp hn) (by rw [hvalue, ite_eq_right h])
  have hsupport (n : ℕ) (hn : n ∈ Λuv.support) :
      0 < n ∧ (n : ℝ) ≤ 2 * x := by
    have hi := Finset.mem_Icc.mp (hmem n hn)
    have hlo : x ≤ (n : ℝ) :=
      hxu.trans ((Nat.le_ceil u).trans (Nat.cast_le.mpr hi.1))
    refine ⟨Nat.cast_pos.mp (hxpos.trans_le hlo), ?_⟩
    exact (Nat.cast_le.mpr hi.2).trans ((Nat.floor_le hvpos.le).trans hvx)
  have henvelope (n : ℕ) (hn : n ∈ Λuv.support) :
      ‖Λuv n‖ ≤ Lamp * Real.log x := by
    rw [hvalue, ite_eq_left (hmem n hn)]
    rw [Complex.norm_real, Real.norm_eq_abs,
      abs_of_nonneg ArithmeticFunction.vonMangoldt_nonneg]
    calc
      _ ≤ Real.log (n : ℝ) := ArithmeticFunction.vonMangoldt_le_log
      _ ≤ Real.log (2 * x) :=
        Real.log_le_log (Nat.cast_pos.mpr (hsupport n hn).1) (hsupport n hn).2
      _ = Real.log 2 + Real.log x := Real.log_mul (by norm_num) hxpos.ne'
      _ ≤ Lamp * Real.log x := by
        dsimp only [Lamp]
        nlinarith only [hlogone, Real.log_nonneg (by norm_num : (1 : ℝ) ≤ 2)]
  have hQ : Q ⊆ Finset.Icc 1 ⌊x ^ θ₀⌋₊ := Finset.filter_subset _ _
  have hcoherent : ∀ q ∈ Q, Nat.Coprime a q := by
    intro q hq
    exact ha.of_dvd_right (Finset.mem_filter.mp hq).2.1
  have hcrude :
      (∑ q ∈ Q, (q.divisors.card : ℝ) ^ (2 * J) * ‖fullDiscrepancy Λuv q a‖) ≤
        (Kg * Lamp) * x * (Real.log x) ^ P := by
    have hg := hgrowth x hxexp Lamp hLamp.le Q hQ (fun _ => a)
      hcoherent Λuv hsupport (fun n hn => by
        simpa only [pow_zero, mul_one, Real.rpow_one] using henvelope n hn)
    simpa only [mul_assoc] using hg
  have hraw : (∑ q ∈ Q, ‖fullDiscrepancy Λuv q a‖) ≤
      Ks * x / (Real.log x) ^ (2 * A + (P : ℝ)) :=
    hsmall x hx u v hxu huv hvx I hI a ha
  exact sum_divisor_weighted_log_saving_of_two_bounds
    Q J (fun q => ‖fullDiscrepancy Λuv q a‖) (fun q _ => norm_nonneg _)
    x (Real.log x) A Ks (Kg * Lamp) P hxpos.le hlog hKs (mul_pos hKg hLamp)
    hraw hcrude

open Classical in
theorem primeIndicator_shifted_discrepancy_sub_le
    (L R h q a : ℕ) (hq : 0 < q) :
    ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc (L + h) (R + h),
          Finsupp.single n (if n.Prime then (1 : ℂ) else 0)) q a -
      fullDiscrepancy
        (∑ n ∈ Finset.Icc L R,
          Finsupp.single n (if n.Prime then (1 : ℂ) else 0)) q a‖ ≤ 4 * (h : ℝ) := by
  let w : ℕ → ℂ := fun n =>
    (if n % q = a % q then (if n.Prime then 1 else 0) else 0) -
      (if Nat.Coprime n q then (if n.Prime then 1 else 0) else 0) / (q.totient : ℂ)
  have hφ : (1 : ℝ) ≤ q.totient := Nat.one_le_cast.mpr (Nat.totient_pos.mpr hq)
  have hinv : ‖(q.totient : ℂ)⁻¹‖ ≤ 1 := by
    rw [norm_inv, Complex.norm_natCast]
    exact inv_le_one_of_one_le₀ hφ
  have hw (n : ℕ) : ‖w n‖ ≤ 2 := by
    have hprime : ‖(if n.Prime then (1 : ℂ) else 0)‖ ≤ 1 := by
      split_ifs <;> simp
    have hfirst :
        ‖(if n % q = a % q then (if n.Prime then (1 : ℂ) else 0) else 0)‖ ≤ 1 := by
      rw [apply_ite norm]
      exact ite_le_one hprime (by simp)
    have hsecond :
        ‖(if Nat.Coprime n q then (if n.Prime then (1 : ℂ) else 0) else 0)‖ ≤ 1 := by
      rw [apply_ite norm]
      exact ite_le_one hprime (by simp)
    calc
      ‖w n‖ ≤
          ‖(if n % q = a % q then (if n.Prime then (1 : ℂ) else 0) else 0)‖ +
            ‖(if Nat.Coprime n q then (if n.Prime then (1 : ℂ) else 0) else 0) /
              (q.totient : ℂ)‖ := norm_sub_le _ _
      _ ≤ 1 + 1 := by
        apply add_le_add hfirst
        rw [div_eq_mul_inv, norm_mul]
        exact (mul_le_mul hsecond hinv (norm_nonneg _) zero_le_one).trans_eq (one_mul _)
      _ = 2 := by norm_num
  have hleft : (Finset.Icc L R \ Finset.Icc (L + h) (R + h)).card ≤ h := by
    calc
      _ ≤ (Finset.Ico L (L + h)).card := Finset.card_le_card (by
        intro n hn
        simp only [Finset.mem_sdiff, Finset.mem_Icc, Finset.mem_Ico] at hn ⊢
        omega)
      _ = h := by simp
  have hright : (Finset.Icc (L + h) (R + h) \ Finset.Icc L R).card ≤ h := by
    calc
      _ ≤ (Finset.Ioc R (R + h)).card := Finset.card_le_card (by
        intro n hn
        simp only [Finset.mem_sdiff, Finset.mem_Icc, Finset.mem_Ioc] at hn ⊢
        omega)
      _ = h := by simp
  have hsum (S : Finset ℕ) (hS : S.card ≤ h) : ‖∑ n ∈ S, w n‖ ≤ 2 * (h : ℝ) := by
    calc
      _ ≤ ∑ n ∈ S, (2 : ℝ) := norm_sum_le_of_le _ (fun n _ => hw n)
      _ = (S.card : ℝ) * 2 := by simp
      _ ≤ (h : ℝ) * 2 := mul_le_mul_of_nonneg_right (Nat.mono_cast hS) zero_le_two
      _ = _ := mul_comm _ _
  rw [fullDiscrepancy_sample,
    fullDiscrepancy_sample]
  change ‖∑ n ∈ Finset.Icc (L + h) (R + h), w n -
    ∑ n ∈ Finset.Icc L R, w n‖ ≤ _
  rw [← Finset.sum_sdiff_sub_sum_sdiff]
  exact (norm_sub_le _ _).trans ((add_le_add (hsum _ hright) (hsum _ hleft)).trans_eq
    (by ring))

open Classical in
theorem primeIndicator_shifted_discrepancy_divisor_weight_le
    (J Q L R h : ℕ) (S : Finset ℕ) (hS : S ⊆ Finset.Icc 1 Q) (a : ℕ → ℕ) :
    (∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
      ‖fullDiscrepancy
          (∑ n ∈ Finset.Icc (L + h) (R + h),
            Finsupp.single n (if n.Prime then (1 : ℂ) else 0)) q (a q) -
        fullDiscrepancy
          (∑ n ∈ Finset.Icc L R,
            Finsupp.single n (if n.Prime then (1 : ℂ) else 0)) q (a q)‖) ≤
      4 * (h : ℝ) * Q * (1 + Real.log (Q : ℝ)) ^ (2 ^ J - 1) := by
  have hweights :
      (∑ q ∈ S, (q.divisors.card : ℝ) ^ J) ≤
        (Q : ℝ) * (1 + Real.log (Q : ℝ)) ^ (2 ^ J - 1) :=
    (Finset.sum_le_sum_of_subset_of_nonneg hS (fun q _ _ => by positivity)).trans
      (sum_card_divisors_pow_le_mul_log_pow J Q)
  calc
    _ ≤ ∑ q ∈ S, (q.divisors.card : ℝ) ^ J * (4 * (h : ℝ)) := by
      apply Finset.sum_le_sum
      intro q hq
      exact mul_le_mul_of_nonneg_left
        (primeIndicator_shifted_discrepancy_sub_le L R h q (a q) (Finset.mem_Icc.mp (hS hq)).1)
        (by positivity)
    _ = (4 * (h : ℝ)) * ∑ q ∈ S, (q.divisors.card : ℝ) ^ J := by
      rw [← Finset.sum_mul, mul_comm]
    _ ≤ (4 * (h : ℝ)) * ((Q : ℝ) * (1 + Real.log (Q : ℝ)) ^ (2 ^ J - 1)) :=
      mul_le_mul_of_nonneg_left hweights (by positivity)
    _ = _ := by ring

theorem fixed_shift_divisor_moment_eventually
    (θ : ℝ) (hθ : θ < 1) (J h : ℕ) (A : ℝ) :
    ∀ᶠ x : ℝ in Filter.atTop,
      4 * (h : ℝ) * (⌊x ^ θ⌋₊ : ℝ) *
        (1 + Real.log (⌊x ^ θ⌋₊ : ℝ)) ^ (2 ^ J - 1) ≤
          x / (Real.log x) ^ A := by
  let B : ℕ := 2 ^ J - 1
  let C : ℝ := 4 * (h : ℝ) * 2 ^ B + 1
  have hC : 0 < C := by positivity
  have hsmall := (isLittleO_log_rpow_rpow_atTop
    (A + (B : ℝ)) (sub_pos.mpr hθ)).def (inv_pos.mpr hC)
  filter_upwards [hsmall, Filter.eventually_ge_atTop (Real.exp 1)] with x hxsmall hx
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
  have hxone : 1 ≤ x := (Real.one_le_exp_iff.mpr zero_le_one).trans hx
  have hℓ : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxpos).mpr hx
  have hℓpos : 0 < Real.log x := zero_lt_one.trans_le hℓ
  let Q : ℕ := ⌊x ^ θ⌋₊
  have hQ : (Q : ℝ) ≤ x ^ θ := Nat.floor_le (Real.rpow_nonneg hxpos.le _)
  by_cases hQzero : Q = 0
  · change 4 * (h : ℝ) * (Q : ℝ) * (1 + Real.log (Q : ℝ)) ^ B ≤ _
    simp only [hQzero, Nat.cast_zero, mul_zero, zero_mul]
    positivity
  have hQpos : 0 < Q := Nat.pos_of_ne_zero hQzero
  have hQx : (Q : ℝ) ≤ x := hQ.trans (Real.rpow_le_self_of_one_le hxone hθ.le)
  have hLQ : 1 + Real.log (Q : ℝ) ≤ 2 * Real.log x := by
    have hlogQ := Real.log_le_log (Nat.cast_pos.mpr hQpos) hQx
    linarith
  have hLQnonneg : 0 ≤ 1 + Real.log (Q : ℝ) := by
    have := Real.log_nonneg (Nat.one_le_cast.mpr hQpos)
    linarith
  have hbound :
      4 * (h : ℝ) * (Q : ℝ) * (1 + Real.log (Q : ℝ)) ^ B ≤
        C * x ^ θ * (Real.log x) ^ B := by
    calc
      _ ≤ 4 * (h : ℝ) * x ^ θ * (2 * Real.log x) ^ B := by gcongr
      _ = (4 * (h : ℝ) * 2 ^ B) * x ^ θ * (Real.log x) ^ B := by
        rw [mul_pow]
        ring
      _ ≤ C * x ^ θ * (Real.log x) ^ B := by
        dsimp only [C]
        gcongr
        exact le_add_of_nonneg_right zero_le_one
  have hs : (Real.log x) ^ (A + (B : ℝ)) ≤ C⁻¹ * x ^ (1 - θ) := by
    simpa only [Real.norm_of_nonneg (Real.rpow_nonneg hℓpos.le _),
      Real.norm_of_nonneg (Real.rpow_nonneg hxpos.le _)] using hxsmall
  have hscale : (Real.log x) ^ A / x * (C * x ^ θ * (Real.log x) ^ B) =
      C * (Real.log x) ^ (A + (B : ℝ)) / x ^ (1 - θ) := by
    rw [Real.rpow_add_natCast hℓpos.ne', Real.rpow_sub hxpos, Real.rpow_one]
    field_simp
  have hnorm : (Real.log x) ^ A / x *
      (4 * (h : ℝ) * (Q : ℝ) * (1 + Real.log (Q : ℝ)) ^ B) ≤ 1 := by
    refine (mul_le_mul_of_nonneg_left hbound (by positivity)).trans ?_
    rw [hscale]
    apply (div_le_iff₀ (Real.rpow_pos_of_pos hxpos (1 - θ))).mpr
    calc
      _ ≤ C * (C⁻¹ * x ^ (1 - θ)) := mul_le_mul_of_nonneg_left hs hC.le
      _ = _ := by field_simp
  change 4 * (h : ℝ) * (Q : ℝ) * (1 + Real.log (Q : ℝ)) ^ B ≤ _
  apply (le_div_iff₀ (Real.rpow_pos_of_pos hℓpos A)).mpr
  have hn : (4 * (h : ℝ) * (Q : ℝ) * (1 + Real.log (Q : ℝ)) ^ B) *
      (Real.log x) ^ A / x ≤ 1 := by
    simpa only [div_mul_eq_mul_div, mul_comm] using hnorm
  simpa only [one_mul] using (div_le_iff₀ hxpos).mp hn

open Classical in
theorem vonMangoldt_prefix_discrepancy_le_centeredMaximum
    (N y q a : ℕ) (hy : 2 ≤ y) (hyN : y ≤ N)
    (hq : 0 < q) (ha : Nat.Coprime a q) :
    ‖fullDiscrepancy
      (∑ n ∈ Finset.Icc 1 y,
        Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q a‖ ≤
      2 * maxCenteredProgressionDiscrepancyUpTo N q := by
  let R := coprimeResidues q
  let P := chebyshevProgressionSum y q
  let c : ℝ := Chebyshev.psi (y : ℝ) / (q.totient : ℝ)
  let E := maxCenteredProgressionDiscrepancyUpTo N q
  have hφ : (0 : ℝ) < q.totient := Nat.cast_pos.mpr (Nat.totient_pos.mpr hq)
  have hmod (b : ℕ) : Nat.Coprime (b % q) q ↔ Nat.Coprime b q := by
    change Nat.gcd (b % q) q = 1 ↔ Nat.gcd b q = 1
    rw [← Nat.gcd_rec q b, Nat.gcd_comm q b]
  have hcard : R.card = q.totient := by
    rw [Nat.totient_eq_card_coprime]
    congr 1
    ext b
    simp [R, coprimeResidues, Nat.coprime_comm]
  have hE (b : ℕ) (hb : b ∈ R) : |P b - c| ≤ E := by
    dsimp only [E]
    rw [maxCenteredProgressionDiscrepancyUpTo_eq_sup_endpoint_residues
      (hy.trans hyN) hq]
    exact Finset.le_sup'_of_le _ (Finset.mem_Icc.mpr ⟨hy, hyN⟩)
      (Finset.le_sup' (fun b =>
        |chebyshevProgressionSum y q b -
          Chebyshev.psi (y : ℝ) / (q.totient : ℝ)|)
        (show b ∈ coprimeResidues q from hb))
  have haE : |P a - c| ≤ E := by
    have hamem : a % q ∈ R := Finset.mem_filter.mpr
      ⟨Finset.mem_range.mpr (Nat.mod_lt a hq), (hmod a).mpr ha⟩
    simpa only [P, chebyshevProgressionSum, Nat.mod_mod]
      using hE (a % q) hamem
  have hmass : (∑ b ∈ R, P b) =
      ∑ n ∈ (Finset.Icc 1 y).filter (fun n => Nat.Coprime n q),
        (ArithmeticFunction.vonMangoldt n : ℝ) := by
    calc
      _ = ∑ b ∈ R, ∑ n ∈ (Finset.Icc 1 y).filter (fun n => n % q = b),
          (ArithmeticFunction.vonMangoldt n : ℝ) := by
        apply Finset.sum_congr rfl
        intro b hb
        have hbq : b < q := Finset.mem_range.mp (Finset.mem_filter.mp hb).1
        simp only [P, chebyshevProgressionSum, Nat.mod_eq_of_lt hbq]
      _ = ∑ n ∈ (Finset.Icc 1 y).filter (fun n => n % q ∈ R),
          (ArithmeticFunction.vonMangoldt n : ℝ) :=
        Finset.sum_fiberwise_eq_sum_filter _ _ _ _
      _ = _ := by
        congr 1
        ext n
        simp [R, coprimeResidues, Nat.mod_lt n hq, hmod]
  have hraw : fullDiscrepancy
      (∑ n ∈ Finset.Icc 1 y,
        Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q a =
        ((P a - (∑ b ∈ R, P b) / (q.totient : ℝ) : ℝ) : ℂ) := by
    rw [fullDiscrepancy_sample, hmass]
    simp only [P, chebyshevProgressionSum,
      Finset.sum_filter, Finset.sum_sub_distrib, Finset.sum_div,
      Complex.ofReal_sub, Complex.ofReal_div, Complex.ofReal_sum,
      Complex.ofReal_natCast, apply_ite Complex.ofReal, Complex.ofReal_zero]
  have hcenter : P a - (∑ b ∈ R, P b) / (q.totient : ℝ) =
      (P a - c) - (∑ b ∈ R, (P b - c)) / (q.totient : ℝ) := by
    rw [Finset.sum_sub_distrib, Finset.sum_const, nsmul_eq_mul, hcard]
    field_simp
    ring
  rw [hraw, Complex.norm_real, Real.norm_eq_abs, hcenter]
  calc
    _ ≤ |P a - c| + |(∑ b ∈ R, (P b - c)) / (q.totient : ℝ)| := abs_sub _ _
    _ ≤ E + (R.card : ℝ) * E / (q.totient : ℝ) := by
      apply add_le_add haE
      rw [abs_div, abs_of_pos hφ]
      apply div_le_div_of_nonneg_right _ hφ.le
      exact (Finset.abs_sum_le_sum_abs _ _).trans
        (by simpa only [Finset.sum_const, nsmul_eq_mul] using
          Finset.sum_le_sum (fun b hb => hE b hb))
    _ = 2 * E := by
      rw [hcard]
      field_simp
      ring

open Classical in
theorem vonMangoldt_dyadic_allModuli_bombieriVinogradov
    (θ : ℝ) (hθpos : 0 < θ) (hθ : θ < 1 / 2) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      ∀ S : Finset ℕ, S ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
        (∑ q ∈ S,
          ‖fullDiscrepancy
            (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
              Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q (a q)‖) ≤
            K * x / (Real.log x) ^ A := by
  intro A hA
  obtain ⟨C, c, hC, hc, N₀, hN₀, hBV⟩ :=
    exists_siegelWalfisz_sum_maxCenteredProgressionDiscrepancyUpTo_le_logSaving_allCutoffs
      A hA.le
  let D : ℝ := C + 40 * vaughanProgressionMeanConstant
    (Real.log 4 + 4)
  let K : ℝ := 8 * (|D| + 1)
  have hsmall := (isLittleO_log_rpow_rpow_atTop (A + 5) (sub_pos.mpr hθ)).eventuallyLE
  obtain ⟨T, hT⟩ := Filter.eventually_atTop.mp hsmall
  let X : ℝ := max (Real.exp 1) (max 4 (max (N₀ : ℝ) T))
  refine ⟨K, X, by dsimp only [K]; positivity, le_max_left _ _, ?_⟩
  intro x hx S hS a ha
  have hx4 : (4 : ℝ) ≤ x :=
    (le_max_of_le_right (le_max_left _ _)).trans hx
  have hxN₀ : (N₀ : ℝ) ≤ x :=
    (le_max_of_le_right (le_max_of_le_right (le_max_left _ _))).trans hx
  have hxT : T ≤ x :=
    (le_max_of_le_right (le_max_of_le_right (le_max_right _ _))).trans hx
  have hxexp : Real.exp 1 ≤ x := (le_max_left _ _).trans hx
  have hxpos : 0 < x := by linarith
  have hℓ : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxpos).mpr hxexp
  have hℓpos : 0 < Real.log x := zero_lt_one.trans_le hℓ
  let N : ℕ := ⌊2 * x⌋₊
  let L : ℕ := ⌈x⌉₊
  let Q : ℕ := ⌊x ^ θ⌋₊
  have hNupper : (N : ℝ) ≤ 2 * x := Nat.floor_le (by positivity)
  have hxN : x ≤ (N : ℝ) := by
    have := Nat.lt_floor_add_one (2 * x)
    change 2 * x < (N : ℝ) + 1 at this
    linarith
  have hNfour : 4 ≤ N := Nat.cast_le.mp (hx4.trans hxN)
  have hNpos : 0 < (N : ℝ) := by positivity
  have hNthreshold : N₀ ≤ N := Nat.cast_le.mp (hxN₀.trans hxN)
  have hlogN : Real.log x ≤ Real.log (N : ℝ) := Real.log_le_log hxpos hxN
  have hlogNpos : 0 < Real.log (N : ℝ) := hℓpos.trans_le hlogN
  have hQ : (Q : ℝ) ≤ (N : ℝ) ^ θ :=
    (Nat.floor_le (Real.rpow_nonneg hxpos.le θ)).trans
      (Real.rpow_le_rpow hxpos.le hxN hθpos.le)
  have hgrowth : (Real.log (N : ℝ)) ^ (A + 5) ≤
      (N : ℝ) ^ (1 / 2 - θ) := by
    simpa only [Real.norm_of_nonneg (Real.rpow_nonneg hlogNpos.le _),
      Real.norm_of_nonneg (Real.rpow_nonneg hNpos.le _)]
      using hT (N : ℝ) (hxT.trans hxN)
  have hwindow : (Q : ℝ) ≤ Real.sqrt (N : ℝ) / (Real.log (N : ℝ)) ^ (A + 5) := by
    apply (le_div_iff₀ (Real.rpow_pos_of_pos hlogNpos (A + 5))).mpr
    calc
      _ ≤ (N : ℝ) ^ θ * (N : ℝ) ^ (1 / 2 - θ) := by gcongr
      _ = Real.sqrt (N : ℝ) := by
        rw [← Real.rpow_add hNpos, add_sub_cancel, Real.sqrt_eq_rpow]
  have hsource := hBV N hNthreshold Q hwindow
  have hLthree : 3 ≤ L := by
    exact Nat.cast_le.mp (show (3 : ℝ) ≤ (L : ℝ) from
      (show (3 : ℝ) ≤ x by linarith).trans (Nat.le_ceil x))
  have hLN : L ≤ N := Nat.ceil_le.mpr hxN
  have hpoint (q : ℕ) (hqS : q ∈ S) :
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc L N,
          Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q (a q)‖ ≤
        4 * maxCenteredProgressionDiscrepancyUpTo N q := by
    have hq : 0 < q := (Finset.mem_Icc.mp (hS hqS)).1
    have hdisj : Disjoint (Finset.Icc 1 (L - 1)) (Finset.Icc L N) := by
      apply Finset.disjoint_left.mpr
      intro n hn hm
      simp only [Finset.mem_Icc] at hn hm
      omega
    have hunion : Finset.Icc 1 (L - 1) ∪ Finset.Icc L N = Finset.Icc 1 N := by
      ext n
      simp only [Finset.mem_union, Finset.mem_Icc]
      omega
    have hsub : fullDiscrepancy
        (∑ n ∈ Finset.Icc L N,
          Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q (a q) =
        fullDiscrepancy
          (∑ n ∈ Finset.Icc 1 N,
            Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q (a q) -
        fullDiscrepancy
          (∑ n ∈ Finset.Icc 1 (L - 1),
            Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q (a q) := by
      simp only [fullDiscrepancy_sample]
      rw [← hunion, Finset.sum_union hdisj]
      simp
    rw [hsub]
    exact (norm_sub_le _ _).trans
      ((add_le_add
        (vonMangoldt_prefix_discrepancy_le_centeredMaximum N N q (a q)
          (by omega) le_rfl hq (ha q hqS))
        (vonMangoldt_prefix_discrepancy_le_centeredMaximum N (L - 1) q (a q)
          (by omega) (by omega) hq (ha q hqS))).trans_eq (by ring))
  calc
    _ ≤ ∑ q ∈ S, 4 * maxCenteredProgressionDiscrepancyUpTo N q :=
      Finset.sum_le_sum hpoint
    _ ≤ ∑ q ∈ Finset.Icc 1 Q,
        4 * maxCenteredProgressionDiscrepancyUpTo N q :=
      Finset.sum_le_sum_of_subset_of_nonneg hS
        (fun q _ _ => mul_nonneg (by norm_num)
          (maxCenteredProgressionDiscrepancyUpTo_nonneg N q))
    _ = 4 * ∑ q ∈ Finset.Icc 1 Q,
        maxCenteredProgressionDiscrepancyUpTo N q :=
      (Finset.mul_sum ..).symm
    _ ≤ 4 * (D * (N : ℝ) / (Real.log (N : ℝ)) ^ A) :=
      mul_le_mul_of_nonneg_left hsource (by norm_num)
    _ ≤ 4 * ((|D| + 1) * (N : ℝ) / (Real.log (N : ℝ)) ^ A) := by
      gcongr
      exact (le_abs_self D).trans (le_add_of_nonneg_right zero_le_one)
    _ ≤ 4 * ((|D| + 1) * (2 * x) / (Real.log x) ^ A) := by
      gcongr
    _ = K * x / (Real.log x) ^ A := by dsimp only [K]; ring

open Classical in
theorem vonMangoldt_dyadic_coherent_bombieriVinogradov
    (j : ℕ) (θ δ : ℝ) (hθpos : 0 < θ) (hθ : θ < 1 / 2) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊x ^ θ⌋₊).filter (fun q =>
          q ∣ ∏ p ∈ I, p ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (x ^ δ), le_max_left (1 : ℝ) (x ^ δ)⟩ j q)),
          ‖fullDiscrepancy
            (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
              Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q a‖) ≤
            K * x / (Real.log x) ^ A := by
  intro A hA
  obtain ⟨K, X, hK, hX, hBV⟩ := vonMangoldt_dyadic_allModuli_bombieriVinogradov
    θ hθpos hθ A hA
  refine ⟨K, X, hK, hX, ?_⟩
  intro x hx I _hI a ha
  apply hBV x hx _ (Finset.filter_subset _ _) (fun _ => a)
  intro q hq
  exact Nat.Coprime.of_dvd_right (Finset.mem_filter.mp hq).2.1 ha

open Classical in
theorem primeIndicator_closedSubinterval_log_saving_of_vonMangoldt
    (j : ℕ) (θ δ : ℝ) (J : ℕ) (hθ : θ < 2 / 3)
    (hLambda : ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      ∀ u v : ℝ, x ≤ u → u ≤ v → v ≤ 2 * x →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊x ^ θ⌋₊).filter (fun q =>
          q ∣ ∏ p ∈ I, p ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (x ^ δ), le_max_left (1 : ℝ) (x ^ δ)⟩ j q)),
          (q.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy
              (∑ n ∈ Finset.Icc ⌈u⌉₊ ⌊v⌋₊,
                Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q a‖) ≤
            K * x / (Real.log x) ^ A) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      ∀ u v : ℝ, x ≤ u → u ≤ v → v ≤ 2 * x →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊x ^ θ⌋₊).filter (fun q =>
          q ∣ ∏ p ∈ I, p ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (x ^ δ), le_max_left (1 : ℝ) (x ^ δ)⟩ j q)),
          (q.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy
              (∑ n ∈ Finset.Icc ⌈u⌉₊ ⌊v⌋₊,
                Finsupp.single n (if n.Prime then (1 : ℂ) else 0)) q a‖) ≤
            K * x / (Real.log x) ^ A := by
  intro A hA
  obtain ⟨K, X₀, hK, hX₀, hΛ⟩ := hLambda A hA
  obtain ⟨X₁, hX₁⟩ := Filter.eventually_atTop.mp
    (squarefree_vonMangoldt_sub_prime_log_uniform_log_saving θ hθ J A 1 zero_lt_one)
  let X : ℝ := max X₀ X₁
  refine ⟨K + 1, X, by positivity, hX₀.trans (le_max_left _ _), ?_⟩
  intro x hx u v hxu huv hvx I hI a ha
  let Q : Finset ℕ := (Finset.Icc 1 ⌊x ^ θ⌋₊).filter (fun q =>
    q ∣ ∏ p ∈ I, p ∧
    Nonempty (DenseDivisibilityWitness
      ⟨max 1 (x ^ δ), le_max_left (1 : ℝ) (x ^ δ)⟩ j q))
  let L : ℕ := ⌈u⌉₊
  let U : ℕ := ⌊v⌋₊
  have hx₀ : X₀ ≤ x := (le_max_left _ _).trans hx
  have hx₁ : X₁ ≤ x := (le_max_right _ _).trans hx
  have hxexp : Real.exp 1 ≤ x := hX₀.trans hx₀
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hxone : 1 < x := (Real.one_lt_exp_iff.mpr zero_lt_one).trans_le hxexp
  have hlog : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxpos).mpr hxexp
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlog
  have hden : 0 < (Real.log x) ^ A := Real.rpow_pos_of_pos hlogpos A
  have hu0 : 0 < u := hxpos.trans_le hxu
  have hv0 : 0 ≤ v := hu0.le.trans huv
  have hLx : x ≤ (L : ℝ) := hxu.trans (Nat.le_ceil u)
  have hL : 2 ≤ L := by
    have : (1 : ℝ) < L := hxone.trans_le hLx
    exact_mod_cast this
  have hlogL : 1 ≤ Real.log (L : ℝ) :=
    hlog.trans (Real.log_le_log hxpos hLx)
  have hU : (U : ℝ) ≤ 2 * x := (Nat.floor_le hv0).trans hvx
  have hprod : Squarefree (∏ p ∈ I, p) := by
    refine Finset.squarefree_prod_of_pairwise_isCoprime
      (fun p hp r hr hpr => ?_) (fun p hp => (hI p hp).squarefree)
    exact Nat.coprime_iff_isRelPrime.mp
      ((Nat.coprime_primes (hI p hp) (hI r hr)).mpr hpr)
  have hQ : Q ⊆ (Finset.Icc 1 ⌊x ^ θ⌋₊).filter Squarefree := by
    intro q hq
    obtain ⟨hqrange, hqdvd, _⟩ := Finset.mem_filter.mp hq
    exact Finset.mem_filter.mpr ⟨hqrange, Squarefree.squarefree_of_dvd hqdvd hprod⟩
  have herror (S : Finset ℕ) (hS : S ⊆ Finset.Ioc 0 ⌊2 * x⌋₊) :
      (∑ q ∈ Q, (q.divisors.card : ℝ) ^ J *
        ‖fullDiscrepancy
          (∑ n ∈ S, Finsupp.single n
            ((ArithmeticFunction.vonMangoldt n -
              (if n.Prime then Real.log (n : ℝ) else 0) : ℝ) : ℂ)) q a‖) ≤
        x / (Real.log x) ^ A := by
    have he := hX₁ x hx₁ ⌊x ^ θ⌋₊ S (fun _ => a)
      (Nat.floor_le (Real.rpow_nonneg hxpos.le _)) hS
    have hsub :
        (∑ q ∈ Q, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy
            (∑ n ∈ S, Finsupp.single n
              ((ArithmeticFunction.vonMangoldt n -
                (if n.Prime then Real.log (n : ℝ) else 0) : ℝ) : ℂ)) q a‖) ≤
        ∑ q ∈ (Finset.Icc 1 ⌊x ^ θ⌋₊).filter Squarefree,
          (q.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy
              (∑ n ∈ S, Finsupp.single n
                ((ArithmeticFunction.vonMangoldt n -
                  (if n.Prime then Real.log (n : ℝ) else 0) : ℝ) : ℂ)) q a‖ :=
      Finset.sum_le_sum_of_subset_of_nonneg hQ (fun q _ _ => by positivity)
    have hs := (mul_le_mul_of_nonneg_left hsub (by positivity :
      0 ≤ (Real.log x) ^ A / x)).trans he
    rw [div_mul_eq_mul_div] at hs
    have hmul := (div_le_iff₀ hxpos).mp hs
    apply (le_div_iff₀ hden).mpr
    nlinarith only [hmul]
  have hsplit (S : Finset ℕ) (q : ℕ) :
      fullDiscrepancy
        (∑ n ∈ S, Finsupp.single n
          (if n.Prime then (Real.log (n : ℝ) : ℂ) else 0)) q a =
      fullDiscrepancy
        (∑ n ∈ S, Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q a -
      fullDiscrepancy
        (∑ n ∈ S, Finsupp.single n
          ((ArithmeticFunction.vonMangoldt n -
            (if n.Prime then Real.log (n : ℝ) else 0) : ℝ) : ℂ)) q a := by
    simp only [fullDiscrepancy_sample, ← Finset.sum_sub_distrib]
    apply Finset.sum_congr rfl
    intro n hn
    simp only [Complex.ofReal_sub, apply_ite Complex.ofReal, Complex.ofReal_zero]
    split_ifs <;> ring
  by_cases hLU : L ≤ U
  · let N : ℕ := U + 1 - L
    have hLN : L + N = U + 1 := by dsimp only [N]; omega
    have hinterval : Finset.Ico L (L + N) = Finset.Icc L U := by
      ext n
      simp only [Finset.mem_Ico, Finset.mem_Icc, hLN]
      omega
    have hprefix (k : ℕ) (hk : k ≤ N) :
        (∑ q ∈ Q, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy
            (∑ n ∈ Finset.Ico L (L + k), Finsupp.single n
              (if n.Prime then (Real.log (n : ℝ) : ℂ) else 0)) q a‖) ≤
          (K + 1) * x / (Real.log x) ^ A := by
      by_cases hk0 : k = 0
      · subst k
        simp only [Nat.add_zero, Finset.Ico_self, Finset.sum_empty,
          fullDiscrepancy, progressionMass, reducedMass, Finsupp.support_zero,
          zero_div, sub_self, norm_zero, mul_zero, Finset.sum_const_zero]
        positivity
      let V : ℕ := L + k - 1
      have hLV : L ≤ V := by dsimp only [V]; omega
      have hVU : V ≤ U := by dsimp only [V, N] at *; omega
      have hVx : (V : ℝ) ≤ 2 * x := (Nat.cast_le.mpr hVU).trans hU
      have hclosed : Finset.Ico L (L + k) = Finset.Icc L V := by
        ext n
        simp only [Finset.mem_Ico, Finset.mem_Icc]
        dsimp only [V]
        omega
      have hS : Finset.Ico L (L + k) ⊆ Finset.Ioc 0 ⌊2 * x⌋₊ := by
        intro n hn
        obtain ⟨hnL, hnV⟩ := Finset.mem_Icc.mp (hclosed ▸ hn)
        refine Finset.mem_Ioc.mpr ⟨by omega, ?_⟩
        exact (Nat.le_floor_iff (by positivity)).mpr
          ((Nat.cast_le.mpr hnV).trans hVx)
      have hΛk := hΛ x hx₀ (L : ℝ) (V : ℝ) hLx (Nat.cast_le.mpr hLV)
        hVx I hI a ha
      have hΛbound :
          (∑ q ∈ Q, (q.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy
              (∑ n ∈ Finset.Ico L (L + k),
                Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q a‖) ≤
            K * x / (Real.log x) ^ A := by
        simpa only [Q, hclosed, Nat.ceil_natCast, Nat.floor_natCast] using hΛk
      calc
        _ ≤ (∑ q ∈ Q, (q.divisors.card : ℝ) ^ J *
              ‖fullDiscrepancy
                (∑ n ∈ Finset.Ico L (L + k),
                  Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q a‖) +
            ∑ q ∈ Q, (q.divisors.card : ℝ) ^ J *
              ‖fullDiscrepancy
                (∑ n ∈ Finset.Ico L (L + k), Finsupp.single n
                  ((ArithmeticFunction.vonMangoldt n -
                    (if n.Prime then Real.log (n : ℝ) else 0) : ℝ) : ℂ)) q a‖ := by
          rw [← Finset.sum_add_distrib]
          apply Finset.sum_le_sum
          intro q hq
          rw [hsplit, ← mul_add]
          exact mul_le_mul_of_nonneg_left (norm_sub_le _ _) (by positivity)
        _ ≤ K * x / (Real.log x) ^ A + x / (Real.log x) ^ A :=
          add_le_add hΛbound (herror _ hS)
        _ = (K + 1) * x / (Real.log x) ^ A := by ring
    have hprime := sum_weighted_prime_interval_discrepancy_le_of_log_prefix
      Q J (fun _ => a) L N hL ((K + 1) * x / (Real.log x) ^ A) hprefix
    have hdrop : ((K + 1) * x / (Real.log x) ^ A) / Real.log (L : ℝ) ≤
        (K + 1) * x / (Real.log x) ^ A :=
      div_le_self (by positivity) hlogL
    simpa only [hinterval, Q, L, U] using hprime.trans hdrop
  · have hnil : Finset.Icc L U = ∅ := Finset.Icc_eq_empty_of_lt (lt_of_not_ge hLU)
    change (∑ q ∈ Q, (q.divisors.card : ℝ) ^ J *
      ‖fullDiscrepancy (∑ n ∈ Finset.Icc L U,
        Finsupp.single n (if n.Prime then (1 : ℂ) else 0)) q a‖) ≤ _
    simp only [hnil, Finset.sum_empty, fullDiscrepancy, progressionMass,
      reducedMass, Finsupp.support_zero, zero_div, sub_self, norm_zero, mul_zero,
      Finset.sum_const_zero]
    positivity

open Classical in
theorem primeIndicator_closedSubinterval_divisor_weight_log_saving_of_dyadic
    (j : ℕ) (θ₀ θ₁ δ₀ δ₁ : ℝ)
    (hθ₀ : 0 < θ₀) (hθ : θ₀ < θ₁)
    (hδ₀ : 0 < δ₀) (hδ : δ₀ < δ₁) (hθsmall : θ₀ < 2 / 3)
    (hDyadic : ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ y : ℝ, X ≤ y →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊y ^ θ₁⌋₊).filter (fun q =>
          q ∣ ∏ p ∈ I, p ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (y ^ δ₁), le_max_left (1 : ℝ) (y ^ δ₁)⟩ j q)),
          ‖fullDiscrepancy
            (∑ n ∈ Finset.Icc ⌈y⌉₊ ⌊2 * y⌋₊,
              Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q a‖) ≤
            K * y / (Real.log y) ^ A)
    (J : ℕ) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      ∀ u v : ℝ, x ≤ u → u ≤ v → v ≤ 2 * x →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊x ^ θ₀⌋₊).filter (fun q =>
          q ∣ ∏ p ∈ I, p ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (x ^ δ₀), le_max_left (1 : ℝ) (x ^ δ₀)⟩ j q)),
          (q.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy
              (∑ n ∈ Finset.Icc ⌈u⌉₊ ⌊v⌋₊,
                Finsupp.single n (if n.Prime then (1 : ℂ) else 0)) q a‖) ≤
            K * x / (Real.log x) ^ A := by
  apply primeIndicator_closedSubinterval_log_saving_of_vonMangoldt j θ₀ δ₀ J hθsmall
  exact vonMangoldt_closedSubinterval_divisor_weight_log_saving_of_dyadic
    j θ₀ θ₁ δ₀ δ₁ hθ₀ hθ hδ₀ hδ hθsmall hDyadic J

open Classical in
theorem primeIndicator_shifted_closedSubinterval_divisor_weight_log_saving_of_dyadic
    (j : ℕ) (θ₀ θ₁ δ₀ δ₁ : ℝ)
    (hθ₀ : 0 < θ₀) (hθ : θ₀ < θ₁)
    (hδ₀ : 0 < δ₀) (hδ : δ₀ < δ₁) (hθsmall : θ₀ < 2 / 3)
    (hDyadic : ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ y : ℝ, X ≤ y →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊y ^ θ₁⌋₊).filter (fun q =>
          q ∣ ∏ p ∈ I, p ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (y ^ δ₁), le_max_left (1 : ℝ) (y ^ δ₁)⟩ j q)),
          ‖fullDiscrepancy
            (∑ n ∈ Finset.Icc ⌈y⌉₊ ⌊2 * y⌋₊,
              Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q a‖) ≤
            K * y / (Real.log y) ^ A)
    (J h : ℕ) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      ∀ u v : ℝ, x ≤ u → u ≤ v → v ≤ 2 * x →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊x ^ θ₀⌋₊).filter (fun q =>
          q ∣ ∏ p ∈ I, p ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (x ^ δ₀), le_max_left (1 : ℝ) (x ^ δ₀)⟩ j q)),
          (q.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy
              (∑ n ∈ Finset.Icc ⌈u + (h : ℝ)⌉₊ ⌊v + (h : ℝ)⌋₊,
                Finsupp.single n (if n.Prime then (1 : ℂ) else 0)) q a‖) ≤
            K * x / (Real.log x) ^ A := by
  intro A hA
  obtain ⟨K, X, hK, hX, hbase⟩ :=
    primeIndicator_closedSubinterval_divisor_weight_log_saving_of_dyadic
      j θ₀ θ₁ δ₀ δ₁ hθ₀ hθ hδ₀ hδ hθsmall hDyadic J A hA
  obtain ⟨Y, hY⟩ := Filter.eventually_atTop.mp
    (fixed_shift_divisor_moment_eventually θ₀ (by linarith) J h A)
  refine ⟨K + 1, max X Y, by positivity, hX.trans (le_max_left _ _), ?_⟩
  intro x hx u v hxu huv hvx I hI a ha
  have hxX : X ≤ x := (le_max_left _ _).trans hx
  have hxY : Y ≤ x := (le_max_right _ _).trans hx
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le (hX.trans hxX)
  have hu : 0 ≤ u := hxpos.le.trans hxu
  have hv : 0 ≤ v := hu.trans huv
  let S := (Finset.Icc 1 ⌊x ^ θ₀⌋₊).filter (fun q =>
    q ∣ ∏ p ∈ I, p ∧
    Nonempty (DenseDivisibilityWitness
      ⟨max 1 (x ^ δ₀), le_max_left (1 : ℝ) (x ^ δ₀)⟩ j q))
  let F : Finset ℕ → ℕ → ℂ := fun T q =>
    fullDiscrepancy (∑ n ∈ T,
      Finsupp.single n (if n.Prime then (1 : ℂ) else 0)) q a
  have herror :
      (∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
        ‖F (Finset.Icc (⌈u⌉₊ + h) (⌊v⌋₊ + h)) q -
          F (Finset.Icc ⌈u⌉₊ ⌊v⌋₊) q‖) ≤ x / (Real.log x) ^ A :=
    (primeIndicator_shifted_discrepancy_divisor_weight_le J ⌊x ^ θ₀⌋₊
      ⌈u⌉₊ ⌊v⌋₊ h S (Finset.filter_subset _ _) (fun _ => a)).trans (hY x hxY)
  have hbase' : (∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
      ‖F (Finset.Icc ⌈u⌉₊ ⌊v⌋₊) q‖) ≤ K * x / (Real.log x) ^ A :=
    hbase x hxX u v hxu huv hvx I hI a ha
  rw [Nat.ceil_add_natCast hu, Nat.floor_add_natCast hv]
  change (∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
    ‖F (Finset.Icc (⌈u⌉₊ + h) (⌊v⌋₊ + h)) q‖) ≤ _
  calc
    _ ≤ ∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
        (‖F (Finset.Icc ⌈u⌉₊ ⌊v⌋₊) q‖ +
          ‖F (Finset.Icc (⌈u⌉₊ + h) (⌊v⌋₊ + h)) q -
            F (Finset.Icc ⌈u⌉₊ ⌊v⌋₊) q‖) := by
      apply Finset.sum_le_sum
      intro q hq
      apply mul_le_mul_of_nonneg_left _ (by positivity)
      simpa only [add_sub_cancel] using
        (norm_add_le (F (Finset.Icc ⌈u⌉₊ ⌊v⌋₊) q)
          (F (Finset.Icc (⌈u⌉₊ + h) (⌊v⌋₊ + h)) q -
            F (Finset.Icc ⌈u⌉₊ ⌊v⌋₊) q))
    _ = (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖F (Finset.Icc ⌈u⌉₊ ⌊v⌋₊) q‖) +
        ∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
          ‖F (Finset.Icc (⌈u⌉₊ + h) (⌊v⌋₊ + h)) q -
            F (Finset.Icc ⌈u⌉₊ ⌊v⌋₊) q‖ := by
      simp only [mul_add, Finset.sum_add_distrib]
    _ ≤ K * x / (Real.log x) ^ A + x / (Real.log x) ^ A :=
      add_le_add hbase' herror
    _ = (K + 1) * x / (Real.log x) ^ A := by ring

open Classical in
theorem primeIndicator_subpower_shifted_log_saving_of_dyadic
    (j : ℕ) (θ₀ θ₁ δ₀ δ₁ : ℝ)
    (hθ₀ : 0 < θ₀) (hθ : θ₀ < θ₁)
    (hδ₀ : 0 < δ₀) (hδ : δ₀ < δ₁) (hθsmall : θ₀ < 2 / 3)
    (hDyadic : ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ y : ℝ, X ≤ y →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊y ^ θ₁⌋₊).filter (fun q =>
          q ∣ ∏ p ∈ I, p ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (y ^ δ₁), le_max_left (1 : ℝ) (y ^ δ₁)⟩ j q)),
          ‖fullDiscrepancy
            (∑ n ∈ Finset.Icc ⌈y⌉₊ ⌊2 * y⌋₊,
              Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q a‖) ≤
            K * y / (Real.log y) ^ A)
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Filter.Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x)
      Filter.atTop (nhds 0)) (J h : ℕ) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      ∀ u v : ℝ, x ≤ u → u ≤ v → v ≤ 2 * x →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊x ^ θ₀ * L0 x⌋₊).filter (fun q =>
          q ∣ ∏ p ∈ I, p ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (x ^ δ₀), le_max_left (1 : ℝ) (x ^ δ₀)⟩ j q)),
          (q.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy
              (∑ n ∈ Finset.Icc ⌈u + (h : ℝ)⌉₊ ⌊v + (h : ℝ)⌋₊,
                Finsupp.single n (if n.Prime then (1 : ℂ) else 0)) q a‖) ≤
            K * x / (Real.log x) ^ A := by
  let θm : ℝ := (θ₀ + min θ₁ (2 / 3)) / 2
  have hcap : θ₀ < min θ₁ (2 / 3) := lt_min hθ hθsmall
  have hgap : 0 < θm - θ₀ := by dsimp only [θm]; linarith only [hcap]
  have hθm : 0 < θm := by linarith only [hθ₀, hgap]
  have hmid : θm < θ₁ := by
    have := min_le_left θ₁ (2 / 3 : ℝ)
    dsimp only [θm]
    linarith only [hcap, this]
  have hsmall : θm < 2 / 3 := by
    have := min_le_right θ₁ (2 / 3 : ℝ)
    dsimp only [θm]
    linarith only [hcap, this]
  intro A hA
  obtain ⟨K, Xp, hK, hXp, hp⟩ :=
    primeIndicator_shifted_closedSubinterval_divisor_weight_log_saving_of_dyadic
      j θm θ₁ δ₀ δ₁ hθm hmid hδ₀ hδ hsmall hDyadic J h A hA
  have hsubpower : ∀ᶠ x : ℝ in Filter.atTop, L0 x ≤ x ^ (θm - θ₀) := by
    have hlimit := (tendsto_order.mp hL0sub).2 (θm - θ₀) hgap
    filter_upwards [hlimit, Filter.eventually_gt_atTop (1 : ℝ)] with x hx hxone
    have hxpos : 0 < x := zero_lt_one.trans hxone
    apply (Real.log_le_log_iff (hL0 x)
      (Real.rpow_pos_of_pos hxpos (θm - θ₀))).mp
    rw [Real.log_rpow hxpos]
    exact ((div_lt_iff₀ (Real.log_pos hxone)).mp hx).le
  obtain ⟨Xr, hXr⟩ := Filter.eventually_atTop.mp hsubpower
  refine ⟨K, max Xp Xr, hK, hXp.trans (le_max_left _ _), ?_⟩
  intro x hx u v hxu huv hvx I hI a ha
  have hxp : Xp ≤ x := (le_max_left _ _).trans hx
  have hxr : Xr ≤ x := (le_max_right _ _).trans hx
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le (hXp.trans hxp)
  have hcutoff : x ^ θ₀ * L0 x ≤ x ^ θm := by
    calc
      _ ≤ x ^ θ₀ * x ^ (θm - θ₀) :=
        mul_le_mul_of_nonneg_left (hXr x hxr) (Real.rpow_nonneg hxpos.le _)
      _ = x ^ (θ₀ + (θm - θ₀)) := (Real.rpow_add hxpos _ _).symm
      _ = x ^ θm := by congr 1; ring
  have hfamily :
      (Finset.Icc 1 ⌊x ^ θ₀ * L0 x⌋₊).filter (fun q =>
        q ∣ ∏ p ∈ I, p ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ₀), le_max_left (1 : ℝ) (x ^ δ₀)⟩ j q)) ⊆
      (Finset.Icc 1 ⌊x ^ θm⌋₊).filter (fun q =>
        q ∣ ∏ p ∈ I, p ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ₀), le_max_left (1 : ℝ) (x ^ δ₀)⟩ j q)) := by
    intro q hq
    obtain ⟨hqr, hqd⟩ := Finset.mem_filter.mp hq
    obtain ⟨hlo, hhi⟩ := Finset.mem_Icc.mp hqr
    exact Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr
      ⟨hlo, hhi.trans (Nat.floor_mono hcutoff)⟩, hqd⟩
  exact (Finset.sum_le_sum_of_subset_of_nonneg hfamily
    (fun q _ _ => by positivity)).trans (hp x hxp u v hxu huv hvx I hI a ha)

open Classical in
theorem primeIndicator_shifted_closedSubinterval_divisor_weight_bombieriVinogradov
    (j : ℕ) (θ δ : ℝ) (hθpos : 0 < θ) (hθ : θ < 1 / 2)
    (hδ : 0 < δ) (J h : ℕ) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      ∀ u v : ℝ, x ≤ u → u ≤ v → v ≤ 2 * x →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊x ^ θ⌋₊).filter (fun q =>
          q ∣ ∏ p ∈ I, p ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (x ^ δ), le_max_left (1 : ℝ) (x ^ δ)⟩ j q)),
          (q.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy
              (∑ n ∈ Finset.Icc ⌈u + (h : ℝ)⌉₊ ⌊v + (h : ℝ)⌋₊,
                Finsupp.single n (if n.Prime then (1 : ℂ) else 0)) q a‖) ≤
            K * x / (Real.log x) ^ A := by
  apply primeIndicator_shifted_closedSubinterval_divisor_weight_log_saving_of_dyadic
    j θ ((θ + 1 / 2) / 2) δ (δ + 1) hθpos (by linarith) hδ (by linarith)
      (by linarith) _ J h
  exact vonMangoldt_dyadic_coherent_bombieriVinogradov
    j ((θ + 1 / 2) / 2) (δ + 1) (by linarith) (by linarith)

theorem fullDiscrepancy_masked_prime_sample_eq_count
    (S : Finset ℕ) (r0 q a : ℕ) :
    fullDiscrepancy
      (∑ n ∈ S, Finsupp.single n
        (if Nat.Prime n ∧ Nat.Coprime n r0 then (1 : ℂ) else 0)) q a =
      ((S.filter (fun n => Nat.Prime n ∧ Nat.Coprime n r0 ∧
        n % q = a % q)).card : ℂ) -
      ((S.filter (fun n => Nat.Prime n ∧ Nat.Coprime n r0 ∧
        Nat.Coprime n q)).card : ℂ) / (q.totient : ℂ) := by
  classical
  rw [fullDiscrepancy_sample, Finset.sum_sub_distrib, ← Finset.sum_div]
  simp only [← ite_and, and_comm, and_left_comm, and_assoc, Finset.sum_boole]

theorem exists_masked_prime_closed_interval_discrepancy_bound
    (D : ℝ) (hD : 0 < D) :
    ∃ C c : ℝ, 0 < C ∧ 0 < c ∧
      ∃ X0 : ℕ, 4 ≤ X0 ∧
        ∀ X : ℕ, X0 ≤ X →
          ∀ (q : ℕ) [NeZero q],
            (q : ℝ) ≤ Real.log (X : ℝ) ^ D →
              ∀ r0 : ℕ, 0 < r0 →
                ∀ a : ℕ, Nat.Coprime a q →
                  ∀ L U : ℕ, U ≤ X →
                    ‖fullDiscrepancy
                      (∑ n ∈ Finset.Icc L U, Finsupp.single n
                        (if Nat.Prime n ∧ Nat.Coprime n r0 then (1 : ℂ) else 0))
                      q a‖ ≤
                      2 * C * (r0.divisors.card : ℝ) *
                        ((X : ℝ) * Real.exp
                          (-c * Real.sqrt (Real.log (X : ℝ)))) := by
  classical
  obtain ⟨C, c, hC, hc, X0, hX0, hprefix⟩ :=
    exists_masked_prime_prefix_discrepancy_bound D hD
  refine ⟨C, c, hC, hc, X0, hX0, ?_⟩
  intro X hX q _ hq r0 hr0 a ha L U hUX
  let B : ℝ := C * (r0.divisors.card : ℝ) *
    ((X : ℝ) * Real.exp (-c * Real.sqrt (Real.log (X : ℝ))))
  have hB : 0 ≤ B := by dsimp [B]; positivity
  have hnatPrefix (y : ℕ) (hy : y ≤ X) :
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc 1 y, Finsupp.single n
          (if Nat.Prime n ∧ Nat.Coprime n r0 then (1 : ℂ) else 0))
        q a‖ ≤ B := by
    have h := hprefix X hX q hq r0 hr0 (ZMod.unitOfCoprime a ha) y hy
    rw [fullDiscrepancy_masked_prime_sample_eq_count]
    simpa only [B, ZMod.coe_unitOfCoprime, ZMod.natCast_eq_natCast_iff',
      div_eq_mul_inv, mul_comm] using h
  by_cases hLU : L ≤ U
  · have hinterval (f : ℕ → ℂ) (hf0 : f 0 = 0) :
        (∑ n ∈ Finset.Icc L U, f n) =
          (∑ n ∈ Finset.Icc 1 U, f n) -
            ∑ n ∈ Finset.Icc 1 (L - 1), f n := by
      have hpref (y : ℕ) :
          (∑ n ∈ Finset.Icc 1 y, f n) = ∑ n ∈ Finset.range (y + 1), f n := by
        rw [← Finset.Ico_add_one_right_eq_Icc,
          Finset.sum_Ico_eq_sub f (by omega), Finset.sum_range_one, hf0, sub_zero]
      have hwhole :
          (∑ n ∈ Finset.Icc L U, f n) =
            (∑ n ∈ Finset.range (U + 1), f n) - ∑ n ∈ Finset.range L, f n := by
        rw [← Finset.Ico_add_one_right_eq_Icc, Finset.sum_Ico_eq_sub f (by omega)]
      rw [hwhole, hpref U, hpref (L - 1)]
      by_cases hL : L = 0
      · subst L
        simp [hf0]
      · rw [Nat.sub_add_cancel (by omega : 1 ≤ L)]
    let F : ℕ → ℂ := fun n =>
      (if n % q = a % q then
        (if Nat.Prime n ∧ Nat.Coprime n r0 then 1 else 0) else 0) -
      (if Nat.Coprime n q then
        (if Nat.Prime n ∧ Nat.Coprime n r0 then 1 else 0) else 0) /
        (q.totient : ℂ)
    have hF0 : F 0 = 0 := by simp [F, Nat.not_prime_zero]
    have hdecomp :
        fullDiscrepancy
          (∑ n ∈ Finset.Icc L U, Finsupp.single n
            (if Nat.Prime n ∧ Nat.Coprime n r0 then (1 : ℂ) else 0)) q a =
        fullDiscrepancy
          (∑ n ∈ Finset.Icc 1 U, Finsupp.single n
            (if Nat.Prime n ∧ Nat.Coprime n r0 then (1 : ℂ) else 0)) q a -
        fullDiscrepancy
          (∑ n ∈ Finset.Icc 1 (L - 1), Finsupp.single n
            (if Nat.Prime n ∧ Nat.Coprime n r0 then (1 : ℂ) else 0)) q a := by
      simp only [fullDiscrepancy_sample]
      exact hinterval F hF0
    rw [hdecomp]
    calc
      _ ≤ ‖fullDiscrepancy
          (∑ n ∈ Finset.Icc 1 U, Finsupp.single n
            (if Nat.Prime n ∧ Nat.Coprime n r0 then (1 : ℂ) else 0)) q a‖ +
        ‖fullDiscrepancy
          (∑ n ∈ Finset.Icc 1 (L - 1), Finsupp.single n
            (if Nat.Prime n ∧ Nat.Coprime n r0 then (1 : ℂ) else 0)) q a‖ :=
        norm_sub_le _ _
      _ ≤ B + B := add_le_add (hnatPrefix U hUX)
        (hnatPrefix (L - 1) ((Nat.sub_le L 1).trans (hLU.trans hUX)))
      _ = _ := by dsimp [B]; ring
  · have hUL : U < L := lt_of_not_ge hLU
    rw [fullDiscrepancy_sample,
      Finset.Icc_eq_empty_of_lt hUL, Finset.sum_empty, norm_zero]
    calc
      0 ≤ 2 * B := mul_nonneg (by norm_num) hB
      _ = _ := by dsimp [B]; ring

theorem exists_masked_prime_real_closed_interval_discrepancy_bound
    (D : ℝ) (hD : 0 < D) :
    ∃ C c : ℝ, 0 < C ∧ 0 < c ∧
      ∃ X0 : ℕ, 4 ≤ X0 ∧
        ∀ X : ℕ, X0 ≤ X →
          ∀ (q : ℕ) [NeZero q],
            (q : ℝ) ≤ Real.log (X : ℝ) ^ D →
              ∀ r0 : ℕ, 0 < r0 →
                ∀ a : ℕ, Nat.Coprime a q →
                  ∀ L U : ℝ, U ≤ (X : ℝ) →
                    ‖fullDiscrepancy
                      (∑ n ∈ Finset.Icc (Nat.ceil L) (Nat.floor U), Finsupp.single n
                        (if Nat.Prime n ∧ Nat.Coprime n r0 then (1 : ℂ) else 0))
                      q a‖ ≤
                      2 * C * (r0.divisors.card : ℝ) *
                        ((X : ℝ) * Real.exp
                          (-c * Real.sqrt (Real.log (X : ℝ)))) := by
  classical
  obtain ⟨C, c, hC, hc, X0, hX0, hinterval⟩ :=
    exists_masked_prime_closed_interval_discrepancy_bound D hD
  refine ⟨C, c, hC, hc, X0, hX0, ?_⟩
  intro X hX q _ hq r0 hr0 a ha L U hUX
  apply hinterval X hX q hq r0 hr0 a ha (Nat.ceil L) (Nat.floor U)
  simpa only [Nat.floor_natCast] using Nat.floor_mono hUX

open Classical in
theorem norm_fullDiscrepancy_weighted_prime_windows_le
    {ι : Type*} (I : Finset ι) (m : ι → ℕ) (w : ι → ℂ)
    (L U : ι → ℕ) (q r0 a : ℕ) (hq : 0 < q)
    (ha : Nat.Coprime a q) (V : ι → ℝ)
    (hV : ∀ i ∈ I, 0 ≤ V i)
    (hprime : ∀ i ∈ I, ∀ b : ℕ, Nat.Coprime b q →
      ‖fullDiscrepancy
        (∑ p ∈ Finset.Icc (L i) (U i), Finsupp.single p
          (if Nat.Prime p ∧ Nat.Coprime p r0 then (1 : ℂ) else 0))
        q b‖ ≤ V i) :
    ‖fullDiscrepancy
      (∑ i ∈ I, ∑ p ∈ Finset.Icc (L i) (U i),
        Finsupp.single (m i * p)
          (if Nat.Prime p ∧ Nat.Coprime (m i * p) r0 then w i else 0))
      q a‖ ≤ ∑ i ∈ I, ‖w i‖ * V i := by
  let : NeZero q := ⟨hq.ne'⟩
  let κ : ℕ → ℕ → ℂ := fun b n =>
    (if n % q = b % q then 1 else 0) -
      (if Nat.Coprime n q then 1 else 0) / (q.totient : ℂ)
  let D (b : ℕ) : (ℕ →₀ ℂ) →ₗ[ℂ] ℂ := Finsupp.linearCombination ℂ (κ b)
  have hD (g : ℕ →₀ ℂ) (b : ℕ) : D b g = fullDiscrepancy g q b := by
    simp only [D, Finsupp.linearCombination_apply, fullDiscrepancy_eq_finsupp_sum,
      κ, smul_eq_mul, mul_sub, ← mul_div_assoc, mul_ite, mul_one, mul_zero]
  have hsingle (b n : ℕ) (z : ℂ) : D b (Finsupp.single n z) = z * κ b n := by
    simp only [D, Finsupp.linearCombination_single, smul_eq_mul]
  let b : ι → ℕ := fun i => ((m i : ZMod q)⁻¹ * (a : ZMod q)).val
  have hprimitive (i : ι) (hmq : Nat.Coprime (m i) q) : Nat.Coprime (b i) q := by
    simpa only [b, Units.val_mul, ← ZMod.inv_coe_unit, ZMod.coe_unitOfCoprime] using
      ZMod.val_coe_unit_coprime
        ((ZMod.unitOfCoprime (m i) hmq)⁻¹ * ZMod.unitOfCoprime a ha)
  have hresidue (i : ι) (p : ℕ) (hmq : Nat.Coprime (m i) q) :
      (m i * p) % q = a % q ↔ p % q = b i % q := by
    rw [← ZMod.natCast_eq_natCast_iff' (m i * p) a q,
      ← ZMod.natCast_eq_natCast_iff' p (b i) q, Nat.cast_mul]
    simpa only [b, ZMod.natCast_zmod_val,
      ← ZMod.inv_coe_unit, ZMod.coe_unitOfCoprime] using
      (Units.eq_inv_mul_iff_mul_eq (ZMod.unitOfCoprime (m i) hmq)
        (a := (p : ZMod q)) (c := (a : ZMod q))).symm
  have hkernel (i : ι) (p : ℕ) :
      (if Nat.Prime p ∧ Nat.Coprime (m i * p) r0 then w i else 0) *
          κ a (m i * p) =
        if Nat.Coprime (m i) (q * r0) then
          w i * ((if Nat.Prime p ∧ Nat.Coprime p r0 then (1 : ℂ) else 0) *
            κ (b i) p) else 0 := by
    by_cases hmq : Nat.Coprime (m i) q
    · by_cases hmr : Nat.Coprime (m i) r0
      · simp only [κ, Nat.coprime_mul_iff_left, Nat.coprime_mul_iff_right,
          eq_true hmq, eq_true hmr, true_and, ite_true, hresidue i p hmq]
        split_ifs <;> ring
      · simp only [Nat.coprime_mul_iff_left, Nat.coprime_mul_iff_right,
          hmr, false_and, and_false, ite_false, zero_mul]
    · have hmod : ¬(m i * p) % q = a % q := fun h =>
        hmq (Nat.Coprime.coprime_mul_right
          ((show Nat.ModEq q (m i * p) a from h).gcd_eq.trans ha))
      simp only [κ, Nat.coprime_mul_iff_left, Nat.coprime_mul_iff_right,
        hmq, false_and, ite_false, hmod, zero_div, sub_self, mul_zero]
  have htransport :
      fullDiscrepancy
        (∑ i ∈ I, ∑ p ∈ Finset.Icc (L i) (U i),
          Finsupp.single (m i * p)
            (if Nat.Prime p ∧ Nat.Coprime (m i * p) r0 then w i else 0)) q a =
        ∑ i ∈ I, if Nat.Coprime (m i) (q * r0) then
          w i * fullDiscrepancy
            (∑ p ∈ Finset.Icc (L i) (U i), Finsupp.single p
              (if Nat.Prime p ∧ Nat.Coprime p r0 then (1 : ℂ) else 0))
            q (b i) else 0 := by
    rw [← hD, map_sum]
    apply Finset.sum_congr rfl
    intro i _hi
    rw [map_sum]
    simp only [hsingle, hkernel]
    by_cases hm : Nat.Coprime (m i) (q * r0)
    · simp only [eq_true hm, ite_true, ← Finset.mul_sum]
      rw [← hD, map_sum]
      simp only [hsingle]
    · simp [hm]
  rw [htransport]
  apply norm_sum_le_of_le
  intro i hi
  split_ifs with hm
  · rw [norm_mul]
    exact mul_le_mul_of_nonneg_left
      (hprime i hi (b i) (hprimitive i hm.coprime_mul_right_right)) (norm_nonneg _)
  · exact (norm_zero.trans_le (mul_nonneg (norm_nonneg _) (hV i hi)))

open Classical in
theorem exists_weighted_prime_windows_discrepancy_bound
    (D : ℝ) (hD : 0 < D) :
    ∃ C c : ℝ, 0 < C ∧ 0 < c ∧ ∃ X0 : ℕ, 4 ≤ X0 ∧
      ∀ {ι : Type*} (I : Finset ι) (m : ι → ℕ) (w : ι → ℂ)
        (L U X : ι → ℕ),
        (∀ i ∈ I, X0 ≤ X i) →
        (∀ i ∈ I, U i ≤ X i) →
        ∀ (q : ℕ) [NeZero q],
          (∀ i ∈ I, (q : ℝ) ≤ Real.log (X i : ℝ) ^ D) →
        ∀ r0 : ℕ, 0 < r0 → ∀ a : ℕ, Nat.Coprime a q →
          ‖fullDiscrepancy
            (∑ i ∈ I, ∑ p ∈ Finset.Icc (L i) (U i),
              Finsupp.single (m i * p)
                (if Nat.Prime p ∧ Nat.Coprime (m i * p) r0 then w i else 0))
            q a‖ ≤
            2 * C * (r0.divisors.card : ℝ) *
              ∑ i ∈ I, ‖w i‖ * ((X i : ℝ) *
                Real.exp (-c * Real.sqrt (Real.log (X i : ℝ)))) := by
  obtain ⟨C, c, hC, hc, X0, hX0, hinterval⟩ :=
    exists_masked_prime_closed_interval_discrepancy_bound D hD
  refine ⟨C, c, hC, hc, X0, hX0, ?_⟩
  intro ι I m w L U X hX hLU q _ hq r0 hr0 a ha
  let V : ι → ℝ := fun i => 2 * C * (r0.divisors.card : ℝ) *
    ((X i : ℝ) * Real.exp (-c * Real.sqrt (Real.log (X i : ℝ))))
  calc
    _ ≤ ∑ i ∈ I, ‖w i‖ * V i := by
      apply norm_fullDiscrepancy_weighted_prime_windows_le
        I m w L U q r0 a (Nat.pos_of_ne_zero (NeZero.ne q)) ha V
      · intro i _hi
        dsimp only [V]
        positivity
      · intro i hi b hb
        exact hinterval (X i) (hX i hi) q (hq i hi) r0 hr0 b hb
          (L i) (U i) (hLU i hi)
    _ = _ := by
      simp only [V, Finset.mul_sum, mul_assoc, mul_left_comm]

open Classical in
theorem largest_prime_windows_fixedPower_siegelWalfisz
    (D B H T A : ℝ) (hD : 0 < D) (hH : 0 ≤ H) (hT : 0 ≤ T) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, 0 ≤ N →
      ∀ {ι : Type*} (I : Finset ι) (m : ι → ℕ) (w : ι → ℂ)
        (L U X : ι → ℕ),
        (∀ i ∈ I, 0 < m i) →
        (∀ i ∈ I, Real.exp (Real.sqrt (Real.log x)) ≤ (X i : ℝ)) →
        (∀ i ∈ I, (X i : ℝ) ≤ T * N / (m i : ℝ)) →
        (∀ i ∈ I, U i ≤ X i) →
        (∑ i ∈ I, ‖w i‖ / (m i : ℝ)) ≤ H * (Real.log x) ^ B →
        ∀ (q : ℕ) [NeZero q], (q : ℝ) ≤ (Real.log x) ^ D →
        ∀ r0 : ℕ, 0 < r0 → ∀ a : ℕ, Nat.Coprime a q →
          ‖fullDiscrepancy
            (∑ i ∈ I, ∑ p ∈ Finset.Icc (L i) (U i),
              Finsupp.single (m i * p)
                (if Nat.Prime p ∧ Nat.Coprime (m i * p) r0 then w i else 0))
            q a‖ ≤ K * (r0.divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨C, c, hC, hc, Xp, _hXp, hprime⟩ :=
    exists_weighted_prime_windows_discrepancy_bound (2 * D) (by positivity)
  have hscale : Filter.Tendsto (fun x : ℝ => Real.exp (Real.sqrt (Real.log x)))
      Filter.atTop Filter.atTop :=
    Real.tendsto_exp_atTop.comp (Real.tendsto_sqrt_atTop.comp Real.tendsto_log_atTop)
  have hlarge : ∀ᶠ x : ℝ in Filter.atTop,
      Real.exp 1 ≤ x ∧ (Xp : ℝ) ≤ Real.exp (Real.sqrt (Real.log x)) ∧
        Real.exp (-c * Real.sqrt (Real.sqrt (Real.log x))) * (Real.log x) ^ B ≤
          (Real.log x) ^ (-A) := by
    filter_upwards [Filter.eventually_ge_atTop (Real.exp 1),
      hscale.eventually (Filter.eventually_ge_atTop (Xp : ℝ)),
      eventually_exp_neg_sqrt_sqrt_log_mul_rpow_le_rpow A B c hc]
      with x hx hscaleX hdecay
    exact ⟨hx, hscaleX, hdecay⟩
  obtain ⟨X0, hX0⟩ := Filter.eventually_atTop.mp hlarge
  let K : ℝ := 2 * C * T * H + 1
  refine ⟨K, max X0 (Real.exp 1), ?_, le_max_right _ _, ?_⟩
  · dsimp only [K]
    positivity
  intro x hx N hN ι I m w L U X hm hXL hXU hLU hw q _ hq r0 hr0 a ha
  obtain ⟨hxexp, hXp, hdecay⟩ := hX0 x ((le_max_left _ _).trans hx)
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hlog : 0 < Real.log x := by
    have := (Real.le_log_iff_exp_le hx0).mpr hxexp
    linarith
  have hcomparison (i : ι) (hi : i ∈ I) :=
    largest_prime_scale_logarithmic_comparison
      x hxexp (X i) (hXL i hi) D c hD hc
  have hbound := hprime I m w L U X
    (fun i hi => Nat.cast_le.mp (hXp.trans (hXL i hi))) hLU q
    (fun i hi => hq.trans (hcomparison i hi).1) r0 hr0 a ha
  let E : ℝ := Real.exp (-c * Real.sqrt (Real.sqrt (Real.log x)))
  have hsum :
      (∑ i ∈ I, ‖w i‖ * ((X i : ℝ) *
        Real.exp (-c * Real.sqrt (Real.log (X i : ℝ)))) ) ≤
        T * H * N * (Real.log x) ^ (-A) := by
    calc
      _ ≤ ∑ i ∈ I, ‖w i‖ * ((T * N / (m i : ℝ)) * E) := by
        apply Finset.sum_le_sum
        intro i hi
        apply mul_le_mul_of_nonneg_left _ (norm_nonneg _)
        exact mul_le_mul (hXU i hi) (hcomparison i hi).2
          (Real.exp_pos _).le
          (div_nonneg (mul_nonneg hT hN) (Nat.cast_pos.mpr (hm i hi)).le)
      _ = T * N * E * ∑ i ∈ I, ‖w i‖ / (m i : ℝ) := by
        simp only [Finset.mul_sum, div_eq_mul_inv, mul_assoc, mul_left_comm, mul_comm]
      _ ≤ T * N * E * (H * (Real.log x) ^ B) :=
        mul_le_mul_of_nonneg_left hw (by dsimp only [E]; positivity)
      _ = T * H * N * (E * (Real.log x) ^ B) := by ring
      _ ≤ T * H * N * (Real.log x) ^ (-A) :=
        mul_le_mul_of_nonneg_left hdecay (by positivity)
  calc
    _ ≤ 2 * C * (r0.divisors.card : ℝ) *
        (T * H * N * (Real.log x) ^ (-A)) :=
      hbound.trans (mul_le_mul_of_nonneg_left hsum (by positivity))
    _ = (2 * C * T * H) * (r0.divisors.card : ℝ) * N / (Real.log x) ^ A := by
      rw [Real.rpow_neg hlog.le]
      ring
    _ ≤ K * (r0.divisors.card : ℝ) * N / (Real.log x) ^ A := by
      apply div_le_div_of_nonneg_right _ (Real.rpow_nonneg hlog.le A)
      apply mul_le_mul_of_nonneg_right _ hN
      apply mul_le_mul_of_nonneg_right _ (Nat.cast_nonneg _)
      dsimp only [K]
      linarith

open Classical in
theorem largest_prime_windows_all_moduli_siegelWalfisz
    (C₀ D₀ ε c T C B H A : ℝ)
    (hε : 0 < ε) (hc : 0 < c) (hT : 0 < T) (hH : 0 ≤ H) (hA : 0 < A) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ {ι : Type*} (I : Finset ι) (m : ι → ℕ) (w : ι → ℂ)
        (L U X : ι → ℕ),
        (∀ i ∈ I, 0 < m i) →
        (∀ i ∈ I, Real.exp (Real.sqrt (Real.log x)) ≤ (X i : ℝ)) →
        (∀ i ∈ I, (X i : ℝ) ≤ T * N / (m i : ℝ)) →
        (∀ i ∈ I, U i ≤ X i) →
        (∑ i ∈ I, ‖w i‖ / (m i : ℝ)) ≤ H * (Real.log x) ^ B →
        let F0 : ℕ →₀ ℂ :=
          ∑ i ∈ I, ∑ p ∈ Finset.Icc (L i) (U i),
            Finsupp.single (m i * p) (if Nat.Prime p then w i else 0)
        (∀ n ∈ F0.support, c * N ≤ (n : ℝ) ∧ (n : ℝ) ≤ T * N) →
        (∀ n ∈ F0.support,
          ‖F0 n‖ ≤ D₀ * (n.divisors.card : ℝ) ^ C₀ * (Real.log x) ^ C₀) →
        ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 →
        ∀ a : ℕ, Nat.Coprime a q →
          ‖fullDiscrepancy
            (∑ i ∈ I, ∑ p ∈ Finset.Icc (L i) (U i),
              Finsupp.single (m i * p)
                (if Nat.Prime p ∧ Nat.Coprime (m i * p) r0 then w i else 0))
            q a‖ ≤ K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨D, hD, hlarge⟩ :=
    eventually_large_modulus_finsupp_discrepancy_le
      C₀ D₀ ε c T C hε hc hT A hA
  obtain ⟨Ks, Xs, hKs, hXs, hsmall⟩ :=
    largest_prime_windows_fixedPower_siegelWalfisz D B H T A hD hH hT.le
  obtain ⟨Xl, hXl⟩ := Filter.eventually_atTop.mp hlarge
  refine ⟨max Ks 1, max Xs Xl,
    hKs.trans_le (le_max_left _ _), hXs.trans (le_max_left _ _), ?_⟩
  intro x hx N hNL hNU ι I m w L U X hm hXL hXU hLU hw F0 hs hf q hq r0 hr0 a ha
  have hxexp : Real.exp 1 ≤ x := hXs.trans ((le_max_left _ _).trans hx)
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hlog : 0 ≤ Real.log x := by
    have := (Real.le_log_iff_exp_le hx0).mpr hxexp
    linarith
  have hN : 0 ≤ N := (Real.rpow_pos_of_pos hx0 ε).le.trans hNL
  have hden : 0 ≤ (Real.log x) ^ A := Real.rpow_nonneg hlog A
  have hqr0 : q * r0 ≠ 0 := Nat.mul_ne_zero hq.ne' hr0.ne'
  have hτq : (q.divisors.card : ℝ) ≤ ((q * r0).divisors.card : ℝ) := by
    exact_mod_cast Finset.card_le_card
      (Nat.divisors_subset_of_dvd hqr0 (show q ∣ q * r0 from ⟨r0, rfl⟩))
  have hτr : (r0.divisors.card : ℝ) ≤ ((q * r0).divisors.card : ℝ) := by
    exact_mod_cast Finset.card_le_card
      (Nat.divisors_subset_of_dvd hqr0
        (show r0 ∣ q * r0 from ⟨q, Nat.mul_comm q r0⟩))
  by_cases hqsmall : (q : ℝ) ≤ (Real.log x) ^ D
  · let : NeZero q := ⟨hq.ne'⟩
    have hbound := hsmall x ((le_max_left _ _).trans hx) N hN
      I m w L U X hm hXL hXU hLU hw q hqsmall r0 hr0 a ha
    calc
      _ ≤ Ks * (r0.divisors.card : ℝ) * N / (Real.log x) ^ A := hbound
      _ ≤ max Ks 1 * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
        apply div_le_div_of_nonneg_right _ hden
        apply mul_le_mul_of_nonneg_right _ hN
        exact (mul_le_mul_of_nonneg_left hτr hKs.le).trans
          (mul_le_mul_of_nonneg_right (le_max_left Ks 1) (Nat.cast_nonneg _))
  · have hfilter : F0.filter (fun n : ℕ => Nat.Coprime n r0) =
        ∑ i ∈ I, ∑ p ∈ Finset.Icc (L i) (U i),
          Finsupp.single (m i * p)
            (if Nat.Prime p ∧ Nat.Coprime (m i * p) r0 then w i else 0) := by
      dsimp only [F0]
      rw [Finsupp.filter_sum]
      apply Finset.sum_congr rfl
      intro i _hi
      rw [Finsupp.filter_sum]
      apply Finset.sum_congr rfl
      intro p _hp
      by_cases hcop : Nat.Coprime (m i * p) r0
      · rw [Finsupp.filter_single_of_pos (fun n => Nat.Coprime n r0) hcop]
        simp only [eq_true hcop, and_true]
      · rw [Finsupp.filter_single_of_neg (fun n => Nat.Coprime n r0) hcop]
        simp [hcop]
    have hdiscrepancy (f : ℕ →₀ ℂ) :
        fullDiscrepancy (f.filter (fun n : ℕ => Nat.Coprime n r0)) q a =
          (∑ n ∈ f.support with Nat.ModEq q n a ∧ Nat.Coprime n r0, f n) -
            (q.totient : ℂ)⁻¹ *
              (∑ n ∈ f.support with Nat.Coprime n q ∧ Nat.Coprime n r0, f n) := by
      have hprogression :
          (∑ n ∈ f.support.filter (fun n : ℕ => Nat.Coprime n r0),
            if n % q = a % q then f n else 0) =
          ∑ n ∈ f.support with Nat.ModEq q n a ∧ Nat.Coprime n r0, f n := by
        simp only [Finset.sum_filter]
        apply Finset.sum_congr rfl
        intro n _hn
        by_cases hnr : Nat.Coprime n r0 <;> by_cases hna : n % q = a % q <;>
          simp [hnr, hna, Nat.ModEq]
      have hreduced :
          (∑ n ∈ f.support.filter (fun n : ℕ => Nat.Coprime n r0),
            if Nat.Coprime n q then f n else 0) =
          ∑ n ∈ f.support with Nat.Coprime n q ∧ Nat.Coprime n r0, f n := by
        simp only [Finset.sum_filter, ← ite_and, and_comm]
      rw [Finsupp.filter_eq_sum, fullDiscrepancy_sample,
        Finset.sum_sub_distrib, ← Finset.sum_div, hprogression, hreduced]
      ring
    have hbound := hXl x ((le_max_right _ _).trans hx) N hNL hNU
      q hq (lt_of_not_ge hqsmall) a ha r0 hr0 F0 hs hf
    rw [← hdiscrepancy F0, hfilter] at hbound
    have hτK : (q.divisors.card : ℝ) ≤
        max Ks 1 * ((q * r0).divisors.card : ℝ) := by
      calc
        _ ≤ ((q * r0).divisors.card : ℝ) := hτq
        _ = 1 * ((q * r0).divisors.card : ℝ) := (one_mul _).symm
        _ ≤ max Ks 1 * ((q * r0).divisors.card : ℝ) :=
          mul_le_mul_of_nonneg_right (le_max_right Ks 1) (Nat.cast_nonneg _)
    calc
      _ ≤ (q.divisors.card : ℝ) * N * (Real.log x) ^ (-A) := hbound
      _ = (q.divisors.card : ℝ) * N / (Real.log x) ^ A := by
        rw [Real.rpow_neg hlog]
        ring
      _ ≤ max Ks 1 * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A :=
        div_le_div_of_nonneg_right (mul_le_mul_of_nonneg_right hτK hN) hden

open Classical in
theorem vonMangoldt_dyadic_bombieriVinogradov_retreat
    (η : ℝ) (hη : 0 < η) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      ∀ S : Finset ℕ, S ⊆ Finset.Icc 1 ⌊x ^ (1 / 2 - η)⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
        (∑ q ∈ S,
          ‖fullDiscrepancy
            (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
              Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q (a q)‖) ≤
            K * x / (Real.log x) ^ A := by
  let θ : ℝ := max (1 / 4) (1 / 2 - η)
  have hθpos : 0 < θ := lt_of_lt_of_le (by norm_num) (le_max_left _ _)
  have hθ : θ < 1 / 2 := max_lt (by norm_num) (by linarith)
  intro A hA
  obtain ⟨K, X, hK, hX, hBV⟩ :=
    vonMangoldt_dyadic_allModuli_bombieriVinogradov θ hθpos hθ A hA
  refine ⟨K, X, hK, hX, ?_⟩
  intro x hx S hS a ha
  have hxone : 1 ≤ x := (Real.one_le_exp_iff.mpr zero_le_one).trans (hX.trans hx)
  apply hBV x hx S _ a ha
  exact hS.trans (Finset.Icc_subset_Icc le_rfl (Nat.floor_mono
    (Real.rpow_le_rpow_of_exponent_le hxone (le_max_right _ _))))

end

open Classical in
theorem primeIndicator_interval_le_centeredMaximum
    (L N : ℕ) (hL : 3 ≤ L) (hLN : L ≤ N) (S : Finset ℕ) (a : ℕ → ℕ)
    (hq : ∀ q ∈ S, 0 < q) (ha : ∀ q ∈ S, Nat.Coprime (a q) q) :
    (∑ q ∈ S, ‖fullDiscrepancy
      (∑ n ∈ Finset.Icc L N,
        Finsupp.single n (if n.Prime then (1 : ℂ) else 0)) q (a q)‖) ≤
      (4 * (∑ q ∈ S, maxCenteredProgressionDiscrepancyUpTo N q) +
        4 * (S.card : ℝ) * Real.sqrt (N : ℝ) * Real.log (N : ℝ)) /
          Real.log (L : ℝ) := by
  let E (q : ℕ) := maxCenteredProgressionDiscrepancyUpTo N q
  let B : ℝ := 4 * (∑ q ∈ S, E q) +
    4 * (S.card : ℝ) * Real.sqrt (N : ℝ) * Real.log (N : ℝ)
  let K : ℕ := N + 1 - L
  have hN1 : (1 : ℝ) ≤ N := by exact_mod_cast (show 1 ≤ N by omega)
  have hB : 0 ≤ B := by
    have hsum : 0 ≤ ∑ q ∈ S, E q := Finset.sum_nonneg fun q _ =>
      maxCenteredProgressionDiscrepancyUpTo_nonneg N q
    have hlog := Real.log_nonneg hN1
    dsimp only [B]
    positivity
  have herror (T : Finset ℕ) (hT : T ⊆ Finset.Ioc 0 N) (q : ℕ) (hq0 : 0 < q) :
      ‖fullDiscrepancy
        (∑ n ∈ T, Finsupp.single n (primePowerError n : ℂ)) q (a q)‖ ≤
        4 * Real.sqrt (N : ℝ) * Real.log (N : ℝ) := by
    have hφ : (1 : ℝ) ≤ q.totient := by exact_mod_cast Nat.totient_pos.mpr hq0
    have hterm (n : ℕ) :
        ‖(if n % q = a q % q then (primePowerError n : ℂ) else 0) -
          (if Nat.Coprime n q then (primePowerError n : ℂ) else 0) /
            (q.totient : ℂ)‖ ≤ 2 * primePowerError n := by
      have hnorm : ‖(primePowerError n : ℂ)‖ = primePowerError n :=
        Complex.norm_of_nonneg (primePowerError_nonneg n)
      have hfirst : ‖if n % q = a q % q then (primePowerError n : ℂ) else 0‖ ≤
          primePowerError n := by
        split_ifs
        · exact hnorm.le
        · simpa only [norm_zero] using primePowerError_nonneg n
      have hsecond : ‖if Nat.Coprime n q then (primePowerError n : ℂ) else 0‖ ≤
          primePowerError n := by
        split_ifs
        · exact hnorm.le
        · simpa only [norm_zero] using primePowerError_nonneg n
      calc
        _ ≤ primePowerError n + primePowerError n / (q.totient : ℝ) := by
          apply (norm_sub_le _ _).trans
          rw [norm_div, Complex.norm_natCast]
          exact add_le_add hfirst
            (div_le_div_of_nonneg_right hsecond (Nat.cast_nonneg _))
        _ ≤ 2 * primePowerError n := by
          linarith only [div_le_self (primePowerError_nonneg n) hφ]
    rw [fullDiscrepancy_sample]
    calc
      _ ≤ ∑ n ∈ T, 2 * primePowerError n :=
        norm_sum_le_of_le _ (fun n _ => hterm n)
      _ = 2 * ∑ n ∈ T, primePowerError n := (Finset.mul_sum ..).symm
      _ ≤ 2 * (2 * Real.sqrt (N : ℝ) * Real.log (N : ℝ)) := by
        apply mul_le_mul_of_nonneg_left _ (by norm_num)
        exact sum_primePowerError_le T (N : ℝ) hN1 (by simpa only [Nat.floor_natCast] using hT)
      _ = _ := by ring
  have hsplit (T : Finset ℕ) (q : ℕ) :
      fullDiscrepancy
        (∑ n ∈ T, Finsupp.single n
          (if n.Prime then (Real.log (n : ℝ) : ℂ) else 0)) q (a q) =
      fullDiscrepancy
        (∑ n ∈ T, Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ))
          q (a q) -
      fullDiscrepancy
        (∑ n ∈ T, Finsupp.single n (primePowerError n : ℂ)) q (a q) := by
    simp only [fullDiscrepancy_sample, ← Finset.sum_sub_distrib]
    apply Finset.sum_congr rfl
    intro n _hn
    rw [primePowerError_eq]
    simp only [Complex.ofReal_sub, apply_ite Complex.ofReal, Complex.ofReal_zero]
    split_ifs <;> ring
  have hprefix (k : ℕ) (hk : k ≤ K) :
      (∑ q ∈ S, ‖fullDiscrepancy
        (∑ n ∈ Finset.Ico L (L + k), Finsupp.single n
          (if n.Prime then (Real.log (n : ℝ) : ℂ) else 0)) q (a q)‖) ≤ B := by
    by_cases hk0 : k = 0
    · subst k
      simpa only [Nat.add_zero, Finset.Ico_self, Finset.sum_empty,
        fullDiscrepancy, progressionMass, reducedMass, Finsupp.support_zero,
        zero_div, sub_self, norm_zero, Finset.sum_const_zero] using hB
    let V : ℕ := L + k - 1
    have hLV : L ≤ V := by dsimp [V]; omega
    have hVN : V ≤ N := by dsimp [V, K] at *; omega
    have hclosed : Finset.Ico L (L + k) = Finset.Icc L V := by
      ext n
      simp only [Finset.mem_Ico, Finset.mem_Icc]
      dsimp only [V]
      omega
    have hT : Finset.Ico L (L + k) ⊆ Finset.Ioc 0 N := by
      intro n hn
      obtain ⟨hnL, hnV⟩ := Finset.mem_Icc.mp (hclosed ▸ hn)
      exact Finset.mem_Ioc.mpr ⟨by omega, hnV.trans hVN⟩
    have hpoint (q : ℕ) (hqS : q ∈ S) :
        ‖fullDiscrepancy
          (∑ n ∈ Finset.Ico L (L + k), Finsupp.single n
            (if n.Prime then (Real.log (n : ℝ) : ℂ) else 0)) q (a q)‖ ≤
          4 * E q + 4 * Real.sqrt (N : ℝ) * Real.log (N : ℝ) := by
      have hdisj : Disjoint (Finset.Icc 1 (L - 1)) (Finset.Icc L V) := by
        apply Finset.disjoint_left.mpr
        intro n hn hm
        simp only [Finset.mem_Icc] at hn hm
        omega
      have hunion : Finset.Icc 1 (L - 1) ∪ Finset.Icc L V = Finset.Icc 1 V := by
        ext n
        simp only [Finset.mem_union, Finset.mem_Icc]
        omega
      have hsub : fullDiscrepancy
          (∑ n ∈ Finset.Ico L (L + k),
            Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q (a q) =
          fullDiscrepancy
            (∑ n ∈ Finset.Icc 1 V,
              Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q (a q) -
          fullDiscrepancy
            (∑ n ∈ Finset.Icc 1 (L - 1),
              Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q (a q) := by
        simp only [hclosed, fullDiscrepancy_sample]
        rw [← hunion, Finset.sum_union hdisj]
        simp
      have hLambda : ‖fullDiscrepancy
          (∑ n ∈ Finset.Ico L (L + k),
            Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q (a q)‖ ≤
          4 * E q := by
        rw [hsub]
        exact (norm_sub_le _ _).trans
          ((add_le_add
            (vonMangoldt_prefix_discrepancy_le_centeredMaximum N V q (a q)
              (by omega) hVN (hq q hqS) (ha q hqS))
            (vonMangoldt_prefix_discrepancy_le_centeredMaximum N (L - 1) q (a q)
              (by omega) (by omega) (hq q hqS) (ha q hqS))).trans_eq (by dsimp [E]; ring))
      rw [hsplit]
      exact (norm_sub_le _ _).trans (add_le_add hLambda (herror _ hT q (hq q hqS)))
    calc
      _ ≤ ∑ q ∈ S, (4 * E q + 4 * Real.sqrt (N : ℝ) * Real.log (N : ℝ)) :=
        Finset.sum_le_sum hpoint
      _ = B := by
        rw [Finset.sum_add_distrib, ← Finset.mul_sum]
        simp only [Finset.sum_const, nsmul_eq_mul, B]
        ring
  have hinterval : Finset.Ico L (L + K) = Finset.Icc L N := by
    ext n
    simp only [Finset.mem_Ico, Finset.mem_Icc]
    dsimp [K]
    omega
  have hparts := sum_weighted_prime_interval_discrepancy_le_of_log_prefix
    S 0 a L K (by omega) B (fun k hk => by
      simpa only [pow_zero, one_mul] using hprefix k hk)
  simpa only [pow_zero, one_mul, hinterval, B, E] using hparts

open Classical in
theorem primeIndicator_dyadic_allModuli_bombieriVinogradov
    (θ : ℝ) (hθpos : 0 < θ) (hθ : θ < 1 / 2) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      ∀ S : Finset ℕ, S ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
        (∑ q ∈ S,
          ‖fullDiscrepancy
            (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
              Finsupp.single n (if n.Prime then (1 : ℂ) else 0)) q (a q)‖) ≤
            K * x / (Real.log x) ^ A := by
  intro A hA
  obtain ⟨C, c, hC, hc, N₀, hN₀, hBV⟩ :=
    exists_siegelWalfisz_sum_maxCenteredProgressionDiscrepancyUpTo_le_logSaving_allCutoffs
      A hA.le
  let D : ℝ := C + 40 * vaughanProgressionMeanConstant
    (Real.log 4 + 4)
  let K : ℝ := 8 * (|D| + 1) + 16
  obtain ⟨T, hT⟩ := Filter.eventually_atTop.mp
    (isLittleO_log_rpow_rpow_atTop (A + 5) (sub_pos.mpr hθ)).eventuallyLE
  let X : ℝ := max (Real.exp 1) (max 4 (max (N₀ : ℝ) T))
  refine ⟨K, X, by dsimp only [K]; positivity, le_max_left _ _, ?_⟩
  intro x hx S hS a ha
  have hx4 : (4 : ℝ) ≤ x := (le_max_of_le_right (le_max_left _ _)).trans hx
  have hxN₀ : (N₀ : ℝ) ≤ x :=
    (le_max_of_le_right (le_max_of_le_right (le_max_left _ _))).trans hx
  have hxT : T ≤ x :=
    (le_max_of_le_right (le_max_of_le_right (le_max_right _ _))).trans hx
  have hxexp : Real.exp 1 ≤ x := (le_max_left _ _).trans hx
  have hxpos : 0 < x := by linarith
  have hℓ : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxpos).mpr hxexp
  have hℓpos : 0 < Real.log x := zero_lt_one.trans_le hℓ
  let N : ℕ := ⌊2 * x⌋₊
  let L : ℕ := ⌈x⌉₊
  let Q : ℕ := ⌊x ^ θ⌋₊
  have hNupper : (N : ℝ) ≤ 2 * x := Nat.floor_le (by positivity)
  have hxN : x ≤ (N : ℝ) := by
    have := Nat.lt_floor_add_one (2 * x)
    change 2 * x < (N : ℝ) + 1 at this
    linarith
  have hNpos : 0 < (N : ℝ) := hxpos.trans_le hxN
  have hNthreshold : N₀ ≤ N := Nat.cast_le.mp (hxN₀.trans hxN)
  have hlogN : Real.log x ≤ Real.log (N : ℝ) := Real.log_le_log hxpos hxN
  have hlogNpos : 0 < Real.log (N : ℝ) := hℓpos.trans_le hlogN
  have hQ : (Q : ℝ) ≤ (N : ℝ) ^ θ :=
    (Nat.floor_le (Real.rpow_nonneg hxpos.le θ)).trans
      (Real.rpow_le_rpow hxpos.le hxN hθpos.le)
  have hgrowth : (Real.log (N : ℝ)) ^ (A + 5) ≤ (N : ℝ) ^ (1 / 2 - θ) := by
    simpa only [Real.norm_of_nonneg (Real.rpow_nonneg hlogNpos.le _),
      Real.norm_of_nonneg (Real.rpow_nonneg hNpos.le _)]
      using hT (N : ℝ) (hxT.trans hxN)
  have hwindow : (Q : ℝ) ≤ Real.sqrt (N : ℝ) / (Real.log (N : ℝ)) ^ (A + 5) := by
    apply (le_div_iff₀ (Real.rpow_pos_of_pos hlogNpos (A + 5))).mpr
    calc
      _ ≤ (N : ℝ) ^ θ * (N : ℝ) ^ (1 / 2 - θ) := by gcongr
      _ = Real.sqrt (N : ℝ) := by
        rw [← Real.rpow_add hNpos, add_sub_cancel, Real.sqrt_eq_rpow]
  have hsource := hBV N hNthreshold Q hwindow
  have hLthree : 3 ≤ L := Nat.cast_le.mp
    ((show (3 : ℝ) ≤ x by linarith).trans (Nat.le_ceil x))
  have hLN : L ≤ N := Nat.ceil_le.mpr hxN
  have hlogL : 1 ≤ Real.log (L : ℝ) :=
    hℓ.trans (Real.log_le_log hxpos (Nat.le_ceil x))
  have hmax : 4 * (∑ q ∈ S, maxCenteredProgressionDiscrepancyUpTo N q) ≤
      8 * (|D| + 1) * x / (Real.log x) ^ A := by
    calc
      _ ≤ 4 * ∑ q ∈ Finset.Icc 1 Q, maxCenteredProgressionDiscrepancyUpTo N q :=
        mul_le_mul_of_nonneg_left (Finset.sum_le_sum_of_subset_of_nonneg hS
          (fun q _ _ => maxCenteredProgressionDiscrepancyUpTo_nonneg N q)) (by norm_num)
      _ ≤ 4 * (D * (N : ℝ) / (Real.log (N : ℝ)) ^ A) :=
        mul_le_mul_of_nonneg_left hsource (by norm_num)
      _ ≤ 4 * ((|D| + 1) * (N : ℝ) / (Real.log (N : ℝ)) ^ A) := by
        gcongr
        exact (le_abs_self D).trans (le_add_of_nonneg_right zero_le_one)
      _ ≤ 4 * ((|D| + 1) * (2 * x) / (Real.log x) ^ A) := by gcongr
      _ = _ := by ring
  have hScard : (S.card : ℝ) ≤ x ^ θ := by
    have hs : S.card ≤ Q := by
      simpa only [Nat.card_Icc, Nat.add_sub_cancel] using (Finset.card_le_card hS)
    exact (Nat.cast_le.mpr hs).trans (Nat.floor_le (Real.rpow_nonneg hxpos.le θ))
  have hsqrt : Real.sqrt (N : ℝ) ≤ 2 * Real.sqrt x := by
    calc
      _ ≤ Real.sqrt (4 * x) := Real.sqrt_le_sqrt (by linarith only [hNupper, hxpos])
      _ = _ := by rw [Real.sqrt_mul (by norm_num : (0 : ℝ) ≤ 4)]; norm_num
  have hlogupper : Real.log (N : ℝ) ≤ 2 * Real.log x := by
    calc
      _ ≤ Real.log (2 * x) := Real.log_le_log hNpos hNupper
      _ = Real.log 2 + Real.log x := Real.log_mul (by norm_num) hxpos.ne'
      _ ≤ _ := by
        have hlogtwo := Real.log_le_log (by norm_num : (0 : ℝ) < 2)
          (show (2 : ℝ) ≤ x by linarith)
        linarith only [hlogtwo]
  have hgrowthx : (Real.log x) ^ (A + 1) ≤ x ^ (1 / 2 - θ) := by
    refine (Real.rpow_le_rpow_of_exponent_le hℓ (by linarith : A + 1 ≤ A + 5)).trans ?_
    simpa only [Real.norm_of_nonneg (Real.rpow_nonneg hℓpos.le _),
      Real.norm_of_nonneg (Real.rpow_nonneg hxpos.le _)] using hT x hxT
  have herr : 4 * (S.card : ℝ) * Real.sqrt (N : ℝ) * Real.log (N : ℝ) ≤
      16 * x / (Real.log x) ^ A := by
    calc
      _ ≤ 16 * (x ^ θ * Real.sqrt x) * Real.log x := by
        calc
          _ ≤ 4 * (x ^ θ) * (2 * Real.sqrt x) * (2 * Real.log x) := by gcongr
          _ = _ := by ring
      _ = 16 * x ^ (θ + 1 / 2) * Real.log x := by
        rw [Real.sqrt_eq_rpow, ← Real.rpow_add hxpos]
      _ ≤ _ := by
        apply (le_div_iff₀ (Real.rpow_pos_of_pos hℓpos A)).mpr
        calc
          _ = 16 * x ^ (θ + 1 / 2) * (Real.log x) ^ (A + 1) := by
            rw [Real.rpow_add hℓpos, Real.rpow_one]
            ring
          _ ≤ 16 * x ^ (θ + 1 / 2) * x ^ (1 / 2 - θ) :=
            mul_le_mul_of_nonneg_left hgrowthx (by positivity)
          _ = 16 * x := by
            rw [mul_assoc, ← Real.rpow_add hxpos,
              show θ + 1 / 2 + (1 / 2 - θ) = (1 : ℝ) by ring, Real.rpow_one]
  have hparts := primeIndicator_interval_le_centeredMaximum L N hLthree hLN S a
    (fun q hq => (Finset.mem_Icc.mp (hS hq)).1) ha
  have hB0 : 0 ≤ 4 * (∑ q ∈ S, maxCenteredProgressionDiscrepancyUpTo N q) +
      4 * (S.card : ℝ) * Real.sqrt (N : ℝ) * Real.log (N : ℝ) := by
    have hsum : 0 ≤ ∑ q ∈ S, maxCenteredProgressionDiscrepancyUpTo N q :=
      Finset.sum_nonneg fun q _ => maxCenteredProgressionDiscrepancyUpTo_nonneg N q
    positivity
  refine hparts.trans ((div_le_self hB0 hlogL).trans ?_)
  calc
    _ ≤ 8 * (|D| + 1) * x / (Real.log x) ^ A + 16 * x / (Real.log x) ^ A :=
      add_le_add hmax herr
    _ = K * x / (Real.log x) ^ A := by dsimp [K]; ring

section

open scoped ContDiff
open Classical in
theorem positiveCompactProfileSequence_apply
    (c T N : ℝ) (hc : 0 < c) (hN : 0 < N)
    (ψ : ℝ → ℂ) (hsupport : Function.support ψ ⊆ Set.Icc c T) (n : ℕ) :
    positiveCompactProfileSequence ψ T N 0 n = ψ ((n : ℝ) / N) := by
  have hmem (hn : ψ ((n : ℝ) / N) ≠ 0) :
      n ∈ Finset.Icc 1 ⌊T * N⌋₊ := by
    have h := hsupport hn
    have hnpos : 0 < (n : ℝ) :=
      (mul_pos hc hN).trans_le ((le_div_iff₀ hN).mp h.1)
    exact Finset.mem_Icc.mpr ⟨Nat.cast_pos.mp hnpos,
      Nat.le_floor ((div_le_iff₀ hN).mp h.2)⟩
  simp only [positiveCompactProfileSequence, zero_add, sub_zero,
    Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_ite_eq']
  by_cases hn : n ∈ Finset.Icc 1 ⌊T * N⌋₊
  · simp [hn]
  · have hz : ψ ((n : ℝ) / N) = 0 := by
      by_contra h
      exact hn (hmem h)
    simp [hn, hz]

open Classical in
theorem positiveCompactProfileSequence_intCast_eq
    (c T N : ℝ) (hc : 0 < c) (hN : 0 < N)
    (ψ : ℝ → ℂ) (hsupport : Function.support ψ ⊆ Set.Icc c T) (z : ℤ) :
    Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ)
      (positiveCompactProfileSequence ψ T N 0) z = ψ ((z : ℝ) / N) := by
  by_cases hz : 0 ≤ z
  · lift z to ℕ using hz with n
    change Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ)
      (positiveCompactProfileSequence ψ T N 0) ((Nat.castEmbedding : ℕ ↪ ℤ) n) =
        ψ ((n : ℝ) / N)
    rw [Finsupp.embDomain_apply_self]
    exact positiveCompactProfileSequence_apply c T N hc hN ψ hsupport n
  · rw [Finsupp.embDomain_of_notMem_range]
    · symm
      by_contra hψ
      have hl := (hsupport hψ).1
      have hzR : (z : ℝ) < 0 := by exact_mod_cast lt_of_not_ge hz
      have hneg : (z : ℝ) / N < 0 := div_neg_of_neg_of_pos hzR hN
      linarith
    · rintro ⟨n, hn⟩
      exact hz (hn ▸ Int.natCast_nonneg n)

open Classical in
theorem profileSW_dilation
    (c T N : ℝ) (hc : 0 < c) (hN : 0 < N)
    (ψ : ℝ → ℂ) (hsupport : Function.support ψ ⊆ Set.Icc c T)
    (d : ℕ) (hd : 0 < d) :
    finiteConvolution (Finsupp.single d 1)
        (positiveCompactProfileSequence ψ T (N / (d : ℝ)) 0) =
      (positiveCompactProfileSequence ψ T N 0).filter (fun n => d ∣ n) := by
  have hdR : 0 < (d : ℝ) := by exact_mod_cast hd
  ext n
  rw [Finsupp.filter_apply, positiveCompactProfileSequence_apply c T N hc hN ψ hsupport]
  by_cases hdn : d ∣ n
  · obtain ⟨m, rfl⟩ := hdn
    rw [ite_eq_left (dvd_mul_right d m)]
    change (MonoidAlgebra.single d (1 : ℂ) *
      MonoidAlgebra.ofCoeff (positiveCompactProfileSequence ψ T (N / (d : ℝ)) 0)).coeff
      (d * m) = _
    rw [MonoidAlgebra.coeff_single_mul_eq_mul_coeff m
      (fun k _ => ⟨Nat.mul_left_cancel hd, congrArg (d * ·)⟩), one_mul]
    rw [positiveCompactProfileSequence_apply c T (N / (d : ℝ)) hc
      (div_pos hN hdR) ψ hsupport]
    congr 1
    push_cast
    field_simp
  · rw [ite_eq_right hdn]
    change (MonoidAlgebra.single d (1 : ℂ) *
      MonoidAlgebra.ofCoeff (positiveCompactProfileSequence ψ T (N / (d : ℝ)) 0)).coeff n = 0
    exact MonoidAlgebra.coeff_single_mul_of_forall_mul_ne _ _
      (fun m hm => hdn ⟨m, hm.symm⟩)

open Classical in
theorem profileSW_moebius_filter (f : ℕ →₀ ℂ) (r : ℕ) (hr : 0 < r) :
    f.filter (fun n => Nat.Coprime n r) =
      ∑ d ∈ r.divisors, (ArithmeticFunction.moebius d : ℂ) • f.filter (fun n => d ∣ n) := by
  ext n
  have hgcd : (n.gcd r).divisors = r.divisors.filter (fun d => d ∣ n) := by
    ext d
    simp [Nat.mem_divisors, Nat.dvd_gcd_iff, hr.ne',
      (Nat.gcd_pos_of_pos_right n hr).ne', and_comm]
  have hsum : (∑ d ∈ r.divisors, if d ∣ n then (ArithmeticFunction.moebius d : ℂ) else 0) =
      if Nat.Coprime n r then (1 : ℂ) else 0 := by
    rw [← Finset.sum_filter, ← hgcd]
    simpa only [ArithmeticFunction.coe_mul_zeta_apply, ArithmeticFunction.intCoe_apply,
      ArithmeticFunction.one_apply, Nat.coprime_iff_gcd_eq_one] using
      DFunLike.congr_fun (ArithmeticFunction.coe_moebius_mul_coe_zeta (R := ℂ)) (n.gcd r)
  simpa only [Finsupp.filter_apply, Finsupp.finsetSum_apply, Finsupp.smul_apply,
    smul_eq_mul, Finset.sum_mul, ite_mul, zero_mul, one_mul, mul_ite, mul_zero] using
      congrArg (fun z : ℂ => z * f n) hsum.symm

open Classical in
theorem profileSW_discrepancy_linear
    {ι : Type*} (S : Finset ι) (c : ι → ℂ) (f : ι → ℕ →₀ ℂ) (q a : ℕ) :
    fullDiscrepancy (∑ i ∈ S, c i • f i) q a =
      ∑ i ∈ S, c i * fullDiscrepancy (f i) q a := by
  let K : ℕ → ℂ := fun n =>
    (if n % q = a % q then 1 else 0) -
      (if Nat.Coprime n q then 1 else 0) / (q.totient : ℂ)
  have hδ (g : ℕ →₀ ℂ) :
      fullDiscrepancy g q a = Finsupp.linearCombination ℂ K g := by
    simp [Finsupp.linearCombination_apply, smul_eq_mul, fullDiscrepancy,
      progressionMass, reducedMass, Finsupp.sum, K, div_eq_mul_inv, mul_sub,
      Finset.sum_sub_distrib, Finset.sum_mul]
  simp only [hδ, map_sum, map_smul, smul_eq_mul]

open Classical in
theorem positiveCompactProfile_fixedMask_discrepancy_le
    (q r : ℕ) (hq : 0 < q) (hr : 0 < r)
    (c T L N : ℝ) (hc : 0 < c) (hcT : c ≤ T) (hL : 0 ≤ L) (hN : 0 < N)
    (ψ : ℝ → ℂ) (hψ : ContDiff ℝ ∞ ψ)
    (hsupport : Function.support ψ ⊆ Set.Icc c T)
    (hbound : ∀ t : ℝ, ‖ψ t‖ ≤ L ∧ ‖iteratedDeriv 2 ψ t‖ ≤ L)
    (a : ℕ) (ha : Nat.Coprime a q) :
    ‖fullDiscrepancy
      ((positiveCompactProfileSequence ψ T N 0).filter (fun n => Nat.Coprime n r)) q a‖ ≤
        32 * T * L * ((q * r).divisors.card : ℝ) := by
  let : NeZero q := ⟨hq.ne'⟩
  have hT : 0 ≤ T := hc.le.trans hcT
  have hC : 0 ≤ 32 * T * L := by positivity
  have hdivisor (d : ℕ) (hd : d ∈ r.divisors) :
      ‖fullDiscrepancy
        ((positiveCompactProfileSequence ψ T N 0).filter (fun n => d ∣ n)) q a‖ ≤
          32 * T * L := by
    have hdpos : 0 < d := Nat.pos_of_mem_divisors hd
    have hdR : 0 < (d : ℝ) := by exact_mod_cast hdpos
    have hN' : 0 < N / (d : ℝ) := div_pos hN hdR
    rw [← profileSW_dilation c T N hc hN ψ hsupport d hdpos]
    have hb := positiveCompactProfile_convolution_discrepancy_le 0 q c T L
      (N / (d : ℝ)) 0 hc hcT hL hN' (by simpa using mul_pos hc hN')
      ψ hψ hsupport hbound (Finsupp.single d 1) a ha
    have hsum : (∑ m ∈ (Finsupp.single d (1 : ℂ)).support with Nat.Coprime m q,
        ‖Finsupp.single d (1 : ℂ) m‖) ≤ 1 := by
      calc
        _ ≤ ∑ m ∈ (Finsupp.single d (1 : ℂ)).support,
            ‖Finsupp.single d (1 : ℂ) m‖ :=
          Finset.sum_le_sum_of_subset_of_nonneg (Finset.filter_subset _ _)
            (fun _ _ _ => norm_nonneg _)
        _ = 1 := by simp
    norm_num only [zero_add, pow_zero, div_one, pow_succ, pow_zero, mul_one] at hb
    exact hb.trans ((mul_le_mul_of_nonneg_left hsum hC).trans_eq (mul_one _))
  rw [profileSW_moebius_filter _ r hr, profileSW_discrepancy_linear]
  calc
    _ ≤ ∑ d ∈ r.divisors, (32 * T * L) := by
      apply norm_sum_le_of_le
      intro d hd
      have hμ : ‖(ArithmeticFunction.moebius d : ℂ)‖ ≤ 1 := by
        rw [Complex.norm_intCast]
        exact_mod_cast ArithmeticFunction.abs_moebius_le_one (n := d)
      calc
        _ ≤ 1 * (32 * T * L) := norm_mul_le_of_le hμ (hdivisor d hd)
        _ = _ := one_mul _
    _ = 32 * T * L * (r.divisors.card : ℝ) := by simp [mul_comm]
    _ ≤ _ := mul_le_mul_of_nonneg_left (by
      exact_mod_cast Finset.card_le_card
        (Nat.divisors_subset_of_dvd (Nat.mul_pos hq hr).ne' (dvd_mul_left r q))) hC

open Classical in
theorem positiveCompactProfile_fixedMask_uniform_log_saving
    (A γ₀ c T L E : ℝ) (_hA : 0 < A) (hγ₀ : 0 < γ₀)
    (hc : 0 < c) (hcT : c ≤ T) (hL : 0 ≤ L) :
    ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ N : ℝ, x ^ γ₀ ≤ N →
      ∀ ψ : ℝ → ℂ, ContDiff ℝ ∞ ψ →
      Function.support ψ ⊆ Set.Icc c T →
      (∀ t : ℝ, ‖ψ t‖ ≤ L * (Real.log x) ^ E ∧
        ‖iteratedDeriv 2 ψ t‖ ≤ L * (Real.log x) ^ E) →
      ∀ q : ℕ, 0 < q → ∀ r : ℕ, 0 < r → ∀ a : ℕ, Nat.Coprime a q →
        ‖fullDiscrepancy
          ((positiveCompactProfileSequence ψ T N 0).filter
            (fun n => Nat.Coprime n r)) q a‖ ≤
          K * ((q * r).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  have hsmall := (isLittleO_log_rpow_rpow_atTop (E + A) hγ₀).bound
    (by norm_num : (0 : ℝ) < 1)
  obtain ⟨X0, hX0⟩ := Filter.eventually_atTop.mp hsmall
  let K : ℝ := 32 * T * L + 1
  have hT : 0 ≤ T := hc.le.trans hcT
  have hK : 0 < K := by dsimp [K]; positivity
  refine ⟨K, max (Real.exp 1) X0, hK, le_max_left _ _, ?_⟩
  intro x hx N hNL ψ hψ hsupp hb q hq r hr a ha
  have hxexp : Real.exp 1 ≤ x := (le_max_left _ _).trans hx
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hlog : 0 < Real.log x :=
    zero_lt_one.trans_le ((Real.le_log_iff_exp_le hx0).mpr hxexp)
  have hN : 0 < N := (Real.rpow_pos_of_pos hx0 γ₀).trans_le hNL
  have hlogpow : (Real.log x) ^ (E + A) ≤ x ^ γ₀ := by
    simpa only [Real.norm_of_nonneg (Real.rpow_nonneg hlog.le _),
      Real.norm_of_nonneg (Real.rpow_nonneg hx0.le _), one_mul] using
      hX0 x ((le_max_right _ _).trans hx)
  have hlogN : (Real.log x) ^ E ≤ N / (Real.log x) ^ A := by
    apply (le_div_iff₀ (Real.rpow_pos_of_pos hlog A)).mpr
    rw [← Real.rpow_add hlog]
    exact hlogpow.trans hNL
  have hbase := positiveCompactProfile_fixedMask_discrepancy_le q r hq hr c T
    (L * (Real.log x) ^ E) N hc hcT (by positivity) hN ψ hψ hsupp hb a ha
  have hC : 0 ≤ 32 * T * L := by positivity
  calc
    _ ≤ 32 * T * (L * (Real.log x) ^ E) * ((q * r).divisors.card : ℝ) := hbase
    _ = (32 * T * L * ((q * r).divisors.card : ℝ)) * (Real.log x) ^ E := by ring
    _ ≤ (32 * T * L * ((q * r).divisors.card : ℝ)) * (N / (Real.log x) ^ A) :=
      mul_le_mul_of_nonneg_left hlogN (mul_nonneg hC (Nat.cast_nonneg _))
    _ ≤ (K * ((q * r).divisors.card : ℝ)) * (N / (Real.log x) ^ A) := by
      apply mul_le_mul_of_nonneg_right
      · exact mul_le_mul_of_nonneg_right (by dsimp [K]; linarith) (Nat.cast_nonneg _)
      · positivity
    _ = _ := by ring

theorem sourceTheta_single_compat_decompose (q₀ r b₁ b₂ : ℕ) [NeZero q₀] (ℓ : ℤ)
    (I : Finset ℤ) (f : ℤ → ℂ) :
    (∑ n ∈ I, (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) * f n) =
      ∑ a ∈ (Finset.Icc 1 q₀).filter (fun a : ℕ =>
        sourceCompatibility r q₀ b₁ b₂ ℓ (a : ℤ) = 1),
        ∑ n ∈ I, if Int.ModEq (q₀ : ℤ) n (a : ℤ) then f n else 0 := by
  classical
  have hcompat_period (u v : ℤ) (huv : Int.ModEq (q₀ : ℤ) u v) :
      sourceCompatibility r q₀ b₁ b₂ ℓ u =
        sourceCompatibility r q₀ b₁ b₂ ℓ v := by
    have hprod : Int.ModEq (q₀ : ℤ)
        (u * (u + ℓ * (r : ℤ))) (v * (v + ℓ * (r : ℤ))) :=
      huv.mul (huv.add_right (ℓ * (r : ℤ)))
    have hgcd : Int.gcd (u * (u + ℓ * (r : ℤ))) (q₀ : ℤ) =
        Int.gcd (v * (v + ℓ * (r : ℤ))) (q₀ : ℤ) := by
      calc
        _ = Int.gcd ((u * (u + ℓ * (r : ℤ))) % (q₀ : ℤ)) (q₀ : ℤ) :=
          (Int.gcd_emod _ _).symm
        _ = Int.gcd ((v * (v + ℓ * (r : ℤ))) % (q₀ : ℤ)) (q₀ : ℤ) :=
          congrArg (fun z : ℤ => Int.gcd z (q₀ : ℤ)) hprod.eq
        _ = _ := Int.gcd_emod _ _
    have hcast : (u : ZMod q₀) = (v : ZMod q₀) :=
      (ZMod.intCast_eq_intCast_iff u v q₀).2 huv
    have hshift : ((u + ℓ * (r : ℤ) : ℤ) : ZMod q₀) =
        ((v + ℓ * (r : ℤ) : ℤ) : ZMod q₀) :=
      (ZMod.intCast_eq_intCast_iff _ _ q₀).2 (huv.add_right (ℓ * (r : ℤ)))
    simp only [sourceCompatibility, hgcd, hcast, hshift]
  have hqpos : (0 : ℤ) < (q₀ : ℤ) := by
    exact_mod_cast (Nat.pos_of_ne_zero (NeZero.ne q₀))
  have hrep (n : ℤ) : ∃ a : ℕ, a ∈ Finset.Icc 1 q₀ ∧
      Int.ModEq (q₀ : ℤ) n (a : ℤ) := by
    obtain ⟨z, hzq, hzn⟩ := Int.existsUnique_equiv_nat (n - 1) hqpos
    have hzlt : z < q₀ := by exact_mod_cast hzq
    refine ⟨z + 1, Finset.mem_Icc.mpr ⟨by omega, by omega⟩, ?_⟩
    simpa only [Nat.cast_add, Nat.cast_one, sub_add_cancel] using
      (hzn.add_right 1).symm
  have huniq (a b : ℕ) (ha : a ∈ Finset.Icc 1 q₀)
      (hb : b ∈ Finset.Icc 1 q₀)
      (hab : Int.ModEq (q₀ : ℤ) (a : ℤ) (b : ℤ)) : a = b := by
    obtain ⟨ha1, haq⟩ := Finset.mem_Icc.mp ha
    obtain ⟨hb1, hbq⟩ := Finset.mem_Icc.mp hb
    have haeq : ((a : ℤ) - 1) % (q₀ : ℤ) = (a : ℤ) - 1 :=
      Int.emod_eq_of_lt (by omega) (by omega)
    have hbeq : ((b : ℤ) - 1) % (q₀ : ℤ) = (b : ℤ) - 1 :=
      Int.emod_eq_of_lt (by omega) (by omega)
    have hmod := (hab.sub_right 1).eq
    rw [haeq, hbeq] at hmod
    omega
  rw [Finset.sum_comm]
  apply Finset.sum_congr rfl
  intro n _
  by_cases hc : sourceCompatibility r q₀ b₁ b₂ ℓ n = 1
  · obtain ⟨a, ha, hna⟩ := hrep n
    have haS : a ∈ (Finset.Icc 1 q₀).filter (fun a : ℕ =>
        sourceCompatibility r q₀ b₁ b₂ ℓ (a : ℤ) = 1) :=
      Finset.mem_filter.mpr ⟨ha, (hcompat_period n a hna).symm.trans hc⟩
    have hsingle :
        (∑ b ∈ (Finset.Icc 1 q₀).filter (fun b : ℕ =>
          sourceCompatibility r q₀ b₁ b₂ ℓ (b : ℤ) = 1),
          if Int.ModEq (q₀ : ℤ) n (b : ℤ) then f n else 0) = f n := by
      calc
        _ = if Int.ModEq (q₀ : ℤ) n (a : ℤ) then f n else 0 := by
          apply Finset.sum_eq_single_of_mem a haS
          intro b hb hba
          have hnb : ¬ Int.ModEq (q₀ : ℤ) n (b : ℤ) := by
            intro hnb
            exact hba (huniq b a (Finset.mem_filter.mp hb).1 ha (hnb.symm.trans hna))
          exact ite_eq_right hnb
        _ = f n := ite_eq_left hna
    rw [hc]
    simpa only [Complex.ofReal_one, one_mul] using hsingle.symm
  · have hc0 : sourceCompatibility r q₀ b₁ b₂ ℓ n = 0 := by
      unfold sourceCompatibility at hc ⊢
      split_ifs at hc ⊢ with h
      · exact (hc rfl).elim
      · rfl
    rw [hc0, Complex.ofReal_zero, zero_mul]
    symm
    apply Finset.sum_eq_zero
    intro a ha
    have hna : ¬ Int.ModEq (q₀ : ℤ) n (a : ℤ) := by
      intro hna
      exact hc ((hcompat_period n a hna).trans (Finset.mem_filter.mp ha).2)
    exact ite_eq_right hna

theorem sourceTheta_single_dense_lcm (Y : Set.Ici (1 : ℝ)) (m n : ℕ)
    (hm : Nonempty (DenseDivisibilityWitness Y 1 m))
    (hn : Nonempty (DenseDivisibilityWitness Y 1 n)) :
    Nonempty (DenseDivisibilityWitness Y 1 (Nat.lcm m n)) := by
  have hordered (u v : ℕ) (hu : 0 < u) (huv : u ≤ v)
      (hv : Nonempty (DenseDivisibilityWitness Y 1 v)) :
      Nonempty (DenseDivisibilityWitness Y 1 (Nat.lcm u v)) := by
    obtain ⟨hvpos, hvdense⟩ := single_dense_iff.mp hv
    have hlcmpos : 0 < Nat.lcm u v := Nat.lcm_pos hu hvpos
    let k : ℕ := Nat.lcm u v / v
    have hkv : k * v = Nat.lcm u v := Nat.div_mul_cancel (Nat.dvd_lcm_right u v)
    have hkpos : 0 < k :=
      Nat.div_pos (Nat.le_of_dvd hlcmpos (Nat.dvd_lcm_right u v)) hvpos
    have hlcmdvd : Nat.lcm u v ∣ u * v :=
      Nat.lcm_dvd ⟨v, rfl⟩ ⟨u, Nat.mul_comm u v⟩
    have hku : k ≤ u := by
      apply Nat.le_of_mul_le_mul_right ?_ hvpos
      rw [hkv]
      exact Nat.le_of_dvd (Nat.mul_pos hu hvpos) hlcmdvd
    have hkR : 0 < (k : ℝ) := by exact_mod_cast hkpos
    have hkvR : (k : ℝ) * (v : ℝ) = (Nat.lcm u v : ℝ) := by
      exact_mod_cast hkv
    have hY : 0 < (Y : ℝ) := lt_of_lt_of_le zero_lt_one Y.property
    refine single_dense_iff.mpr ⟨hlcmpos, ?_⟩
    intro X hX hXlcm
    by_cases hXv : X ≤ (v : ℝ)
    · obtain ⟨d, hd, hlow, hupp⟩ := hvdense X hX hXv
      exact ⟨d, hd.trans (Nat.dvd_lcm_right u v), hlow, hupp⟩
    · have hkX : (k : ℝ) ≤ X :=
        (show (k : ℝ) ≤ (v : ℝ) by exact_mod_cast hku.trans huv).trans
          (le_of_not_ge hXv)
      have htarget : X / (k : ℝ) ≤ (v : ℝ) := by
        apply (div_le_iff₀ hkR).2
        calc
          X ≤ (Nat.lcm u v : ℝ) := hXlcm
          _ = (v : ℝ) * (k : ℝ) := by rw [← hkvR, mul_comm]
      obtain ⟨d, hd, hlow, hupp⟩ :=
        hvdense (X / (k : ℝ)) ((one_le_div hkR).2 hkX) htarget
      refine ⟨k * d, ?_, (div_le_iff₀ hY).2 ?_, ?_⟩
      · rw [← hkv]
        exact mul_dvd_mul_left k hd
      · calc
          X ≤ ((d : ℝ) * (Y : ℝ)) * (k : ℝ) :=
            (div_le_iff₀ hkR).1 ((div_le_iff₀ hY).1 hlow)
          _ = ((k * d : ℕ) : ℝ) * (Y : ℝ) := by
            simp only [Nat.cast_mul]
            ring
      · simpa only [Nat.cast_mul, mul_comm] using (le_div_iff₀ hkR).1 hupp
  rcases le_total m n with hmn | hnm
  · exact hordered m n (single_dense_iff.mp hm).1 hmn hn
  · simpa only [Nat.lcm_comm] using
      hordered n m (single_dense_iff.mp hn).1 hnm hm

theorem sourceTheta_single_reciprocal_data
    (r q₀ q₁ q₂ a b₁ b₂ : ℕ)
    [NeZero r] [NeZero (q₀ * q₁)] [NeZero q₂]
    [NeZero (Nat.lcm r (q₀ * q₁))]
    (hsq : Squarefree (r * q₀ * q₁ * q₂))
    (ha : Nat.Coprime a r) (hb₁ : Nat.Coprime b₁ (q₀ * q₁))
    (hb₂ : Nat.Coprime b₂ q₂) (ℓ h : ℤ) :
    ∃ c₀ : ZMod (Nat.lcm r (q₀ * q₁)), ∃ c₁ : ZMod q₂,
      (∀ n : ℤ, sourceTheta r q₀ 1 q₁ q₂ a b₁ b₂ ℓ n h =
        reciprocalUnitPhase (Nat.lcm r (q₀ * q₁)) c₀
          (n : ZMod (Nat.lcm r (q₀ * q₁))) *
        reciprocalUnitPhase q₂ c₁
          ((n + ℓ * (r : ℤ) : ℤ) : ZMod q₂)) ∧
      Nat.gcd c₀.val (Nat.lcm r (q₀ * q₁)) =
        Nat.gcd h.natAbs (Nat.lcm r (q₀ * q₁)) ∧
      Nat.gcd c₁.val q₂ = Nat.gcd h.natAbs q₂ := by
  have hunit_cast (d m : ℕ) (hd : d ∣ m) (n : ℤ)
      (hn : IsUnit (n : ZMod m)) : IsUnit (n : ZMod d) := by
    simpa only [map_intCast] using hn.map (ZMod.castHom hd (ZMod d))
  have hunit_lcm (d e : ℕ) (n : ℤ) :
      IsUnit (n : ZMod (Nat.lcm d e)) ↔
        IsUnit (n : ZMod d) ∧ IsUnit (n : ZMod e) := by
    constructor
    · intro hn
      exact ⟨hunit_cast d _ (Nat.dvd_lcm_left d e) n hn,
        hunit_cast e _ (Nat.dvd_lcm_right d e) n hn⟩
    · rintro ⟨hd, he⟩
      apply (ZMod.coe_int_isUnit_iff_isCoprime _ _).mpr
      have hp := ((ZMod.coe_int_isUnit_iff_isCoprime _ _).mp hd).mul_left
        ((ZMod.coe_int_isUnit_iff_isCoprime _ _).mp he)
      apply hp.of_isCoprime_of_dvd_left
      exact_mod_cast Nat.lcm_dvd_mul d e
  have hchar_inflate (d m : ℕ) [NeZero d] [NeZero m]
      (hd : d ∣ m) (z : ZMod m) :
      ZMod.stdAddChar (ZMod.castHom hd (ZMod d) z) =
        ZMod.stdAddChar (((m / d : ℕ) : ZMod m) * z) := by
    obtain ⟨j, rfl⟩ := ZMod.intCast_surjective z
    rw [map_intCast, ← Int.cast_natCast (m / d), ← Int.cast_mul,
      ZMod.stdAddChar_coe, ZMod.stdAddChar_coe]
    congr 1
    simp only [Int.cast_mul, Int.cast_natCast, Nat.cast_div_charZero hd]
    field_simp [NeZero.ne (d : ℂ), NeZero.ne (m : ℂ)]
  have hphase_inflate (d m : ℕ) [NeZero d] [NeZero m]
      (hd : d ∣ m) (c : ZMod d) (n : ℤ) (hn : IsUnit (n : ZMod m)) :
      reciprocalUnitPhase d c (n : ZMod d) =
        ZMod.stdAddChar (((m / d : ℕ) : ZMod m) *
          (c.val : ZMod m) * (n : ZMod m)⁻¹) := by
    have hnd := hunit_cast d m hd n hn
    let π := ZMod.castHom hd (ZMod d)
    have hinv : π ((n : ZMod m)⁻¹) = (n : ZMod d)⁻¹ := by
      symm
      apply ZMod.inv_eq_of_mul_eq_one
      rw [← map_intCast π n, ← map_mul, ZMod.mul_inv_of_unit _ hn, map_one]
    have hc : π (c.val : ZMod m) = c := by
      simp only [map_natCast, ZMod.natCast_zmod_val]
    rw [reciprocalUnitPhase, ite_eq_left hnd]
    calc
      _ = ZMod.stdAddChar (π ((c.val : ZMod m) * (n : ZMod m)⁻¹)) := by
        rw [map_mul π, hc, hinv]
      _ = _ := by rw [hchar_inflate d m hd]; congr 1; ring
  have hphase_scale (q : ℕ) [NeZero q] (c x y : ZMod q) (hy : IsUnit y) :
      reciprocalUnitPhase q c (x * y) =
        reciprocalUnitPhase q (c * y⁻¹) x := by
    by_cases hx : IsUnit x
    · have hi : (x * y)⁻¹ = y⁻¹ * x⁻¹ := by
        apply ZMod.inv_eq_of_mul_eq_one
        calc
          x * y * (y⁻¹ * x⁻¹) = (x * x⁻¹) * (y * y⁻¹) := by ring
          _ = 1 := by rw [ZMod.mul_inv_of_unit _ hx, ZMod.mul_inv_of_unit _ hy, one_mul]
      simp only [reciprocalUnitPhase, ite_eq_left hx,
        ite_eq_left (hx.mul hy), hi, mul_assoc]
    · have hxy : ¬ IsUnit (x * y) := fun h => hx (IsUnit.mul_iff.mp h).1
      simp only [reciprocalUnitPhase, ite_eq_right hx, ite_eq_right hxy]
  have hphase_modulus (d e : ℕ) [NeZero d] [NeZero e] (hde : d = e)
      (b : ℕ) (h n : ℤ) (k : ℕ) :
      reciprocalUnitPhase d ((b : ZMod d) * (h : ZMod d))
        ((n : ZMod d) * (k : ZMod d)) =
      reciprocalUnitPhase e ((b : ZMod e) * (h : ZMod e))
        ((n : ZMod e) * (k : ZMod e)) := by
    subst e
    rfl
  have hgcd_unit (r : ℕ) [NeZero r] (c d : ℤ) (u : ZMod r)
      (hu : IsUnit u) (h : (c : ZMod r) = u * (d : ZMod r)) :
      Int.gcd c (r : ℤ) = Int.gcd d (r : ℤ) := by
    have huc : Nat.Coprime u.val r :=
      (ZMod.isUnit_iff_coprime u.val r).mp (by
        simpa only [ZMod.natCast_zmod_val] using hu)
    have huG : Int.gcd (u.val : ℤ) (r : ℤ) = 1 := by
      simpa only [Int.gcd_natCast_natCast] using huc.gcd_eq_one
    have hmod : Int.ModEq (r : ℤ) c ((u.val : ℤ) * d) :=
      (ZMod.intCast_eq_intCast_iff c ((u.val : ℤ) * d) r).mp (by
        simpa only [Int.cast_mul, Int.cast_natCast, ZMod.natCast_zmod_val] using h)
    simpa only [Int.gcd_emod, Int.gcd_mul_right_left_of_gcd_eq_one huG] using
      congrArg (fun a : ℤ => Int.gcd a (r : ℤ)) hmod.eq
  have hphase_merge (d e : ℕ) [NeZero d] [NeZero e] [NeZero (Nat.lcm d e)]
      (c : ZMod d) (f : ZMod e) (n : ℤ) :
      reciprocalUnitPhase d c (n : ZMod d) *
          reciprocalUnitPhase e f (n : ZMod e) =
        reciprocalUnitPhase (Nat.lcm d e)
          (((Nat.lcm d e / d : ℕ) : ZMod (Nat.lcm d e)) *
              (c.val : ZMod (Nat.lcm d e)) +
            ((Nat.lcm d e / e : ℕ) : ZMod (Nat.lcm d e)) *
              (f.val : ZMod (Nat.lcm d e))) (n : ZMod (Nat.lcm d e)) := by
    by_cases hn : IsUnit (n : ZMod (Nat.lcm d e))
    · rw [hphase_inflate d (Nat.lcm d e) (Nat.dvd_lcm_left d e) c n hn,
        hphase_inflate e (Nat.lcm d e) (Nat.dvd_lcm_right d e) f n hn]
      simp only [reciprocalUnitPhase, ite_eq_left hn,
        add_mul, AddChar.map_add_eq_mul]
    · by_cases hnd : IsUnit (n : ZMod d)
      · have hne : ¬ IsUnit (n : ZMod e) :=
          fun hne => hn ((hunit_lcm d e n).2 ⟨hnd, hne⟩)
        simp only [reciprocalUnitPhase, ite_eq_right hne,
          ite_eq_right hn, mul_zero]
      · simp only [reciprocalUnitPhase, ite_eq_right hnd,
          ite_eq_right hn, zero_mul]
  let u := q₀ * q₁
  let m₀ := Nat.lcm r u
  have hsq' : Squarefree (r * (u * q₂)) := by
    simpa only [u, Nat.mul_assoc] using hsq
  have hruq : Nat.Coprime r (u * q₂) := Nat.coprime_of_squarefree_mul hsq'
  have hru : Nat.Coprime r u := hruq.coprime_mul_right_right
  have hrq : Nat.Coprime r q₂ := hruq.coprime_mul_left_right
  have huq : Nat.Coprime u q₂ := Nat.coprime_of_squarefree_mul hsq'.of_mul_right
  have hrm : r ∣ m₀ := Nat.dvd_lcm_left _ _
  have hum : u ∣ m₀ := Nat.dvd_lcm_right _ _
  have hmdivr : m₀ / r = u := by
    dsimp only [m₀]
    rw [hru.lcm_eq_mul, Nat.mul_div_cancel_left _ (NeZero.pos r)]
  have hmdivu : m₀ / u = r := by
    dsimp only [m₀]
    rw [hru.lcm_eq_mul, Nat.mul_div_cancel _ (NeZero.pos u)]
  let ar : ZMod r := (a : ZMod r) * (h : ZMod r) * ((u * q₂ : ℕ) : ZMod r)⁻¹
  let cu : ZMod u := (b₁ : ZMod u) * (h : ZMod u) * ((r * q₂ : ℕ) : ZMod u)⁻¹
  let cv : ZMod q₂ := (b₂ : ZMod q₂) * (h : ZMod q₂) * ((r * u : ℕ) : ZMod q₂)⁻¹
  let c₀ : ZMod m₀ := ((m₀ / r : ℕ) : ZMod m₀) * ar.val +
    ((m₀ / u : ℕ) : ZMod m₀) * cu.val
  have hΘ (n : ℤ) : sourceTheta r q₀ 1 q₁ q₂ a b₁ b₂ ℓ n h =
      reciprocalUnitPhase r ar (n : ZMod r) *
        reciprocalUnitPhase u cu (n : ZMod u) *
        reciprocalUnitPhase q₂ cv
          ((n + ℓ * (r : ℤ) : ℤ) : ZMod q₂) := by
    have hp : r ≠ 0 ∧ q₀ * 1 * q₁ ≠ 0 ∧ q₂ ≠ 0 :=
      ⟨NeZero.ne _, by simpa only [Nat.mul_one] using NeZero.ne u, NeZero.ne _⟩
    let : NeZero (q₀ * 1 * q₁) := ⟨hp.2.1⟩
    rw [sourceTheta, dite_eq_left hp]
    dsimp only
    rw [hphase_modulus (q₀ * 1 * q₁) u
      (by simp only [u, Nat.mul_one]) b₁ h n (r * q₂)]
    simp only [Nat.mul_one]
    rw [show r * q₀ * q₁ = r * u by simp only [u, Nat.mul_assoc]]
    rw [hphase_scale r _ _ _ ((ZMod.isUnit_iff_coprime _ _).2 hruq.symm),
      hphase_scale u _ _ _ ((ZMod.isUnit_iff_coprime _ _).2 (hru.mul_left huq.symm)),
      hphase_scale q₂ _ _ _ ((ZMod.isUnit_iff_coprime _ _).2 (hrq.mul_left huq))]
  have hprojr : (c₀.val : ZMod r) = (u : ZMod r) * ar := by
    calc
      _ = ZMod.castHom hrm (ZMod r) c₀ := by
        simp only [ZMod.castHom_apply, ZMod.natCast_val]
      _ = _ := by
        dsimp only [c₀]
        simp only [map_add, map_mul, map_natCast, hmdivr, hmdivu,
          ZMod.natCast_self, zero_mul, add_zero, ZMod.natCast_zmod_val]
  have hproju : (c₀.val : ZMod u) = (r : ZMod u) * cu := by
    calc
      _ = ZMod.castHom hum (ZMod u) c₀ := by
        simp only [ZMod.castHom_apply, ZMod.natCast_val]
      _ = _ := by
        dsimp only [c₀]
        simp only [map_add, map_mul, map_natCast, hmdivr, hmdivu,
          ZMod.natCast_self, zero_mul, zero_add, ZMod.natCast_zmod_val]
  have hinvunit {m : ℕ} [NeZero m] {z : ZMod m} (hz : IsUnit z) : IsUnit z⁻¹ := by
    obtain ⟨w, hw⟩ := hz
    rw [← hw, ZMod.inv_coe_unit]
    exact (w⁻¹).isUnit
  have hgcdr : Nat.gcd c₀.val r = Nat.gcd h.natAbs r := by
    have hh := hgcd_unit r (c₀.val : ℤ) h
      ((u : ZMod r) * (a : ZMod r) * ((u * q₂ : ℕ) : ZMod r)⁻¹)
      ((((ZMod.isUnit_iff_coprime _ _).2 hru.symm).mul
        ((ZMod.isUnit_iff_coprime _ _).2 ha)).mul
        (hinvunit ((ZMod.isUnit_iff_coprime _ _).2 hruq.symm))) (by
          rw [Int.cast_natCast, hprojr]
          dsimp only [ar]
          ring)
    simpa only [Int.gcd_def, Int.natAbs_natCast] using hh
  have hgcdu : Nat.gcd c₀.val u = Nat.gcd h.natAbs u := by
    have hh := hgcd_unit u (c₀.val : ℤ) h
      ((r : ZMod u) * (b₁ : ZMod u) * ((r * q₂ : ℕ) : ZMod u)⁻¹)
      ((((ZMod.isUnit_iff_coprime _ _).2 hru).mul
        ((ZMod.isUnit_iff_coprime _ _).2 hb₁)).mul
        (hinvunit ((ZMod.isUnit_iff_coprime _ _).2 (hru.mul_left huq.symm)))) (by
          rw [Int.cast_natCast, hproju]
          dsimp only [cu]
          ring)
    simpa only [Int.gcd_def, Int.natAbs_natCast] using hh
  refine ⟨c₀, cv, ?_, ?_, ?_⟩
  · intro n
    rw [hΘ, hphase_merge]
  · calc
      Nat.gcd c₀.val (Nat.lcm r u) = Nat.gcd c₀.val (r * u) :=
        congrArg (Nat.gcd c₀.val) hru.lcm_eq_mul
      _ = Nat.gcd h.natAbs (r * u) := by
        rw [Nat.Coprime.gcd_mul _ hru, hgcdr, hgcdu,
          ← Nat.Coprime.gcd_mul _ hru]
      _ = Nat.gcd h.natAbs (Nat.lcm r u) :=
        congrArg (Nat.gcd h.natAbs) hru.lcm_eq_mul.symm
  · have hh := hgcd_unit q₂ (cv.val : ℤ) h
      ((b₂ : ZMod q₂) * ((r * u : ℕ) : ZMod q₂)⁻¹)
      (((ZMod.isUnit_iff_coprime _ _).2 hb₂).mul
        (hinvunit ((ZMod.isUnit_iff_coprime _ _).2 (hrq.mul_left huq)))) (by
          simp only [Int.cast_natCast, ZMod.natCast_zmod_val]
          dsimp only [cv]
          ring)
    simpa only [Int.gcd_def, Int.natAbs_natCast] using hh

open Classical in
theorem sourceTheta_single_smooth_bounds
    (T A₀ A₁ η : ℝ)
    (hT : 1 ≤ T) (hA₀ : 0 ≤ A₀) (hA₁ : 0 ≤ A₁) (hη : 0 < η) :
    ∃ C : ℝ, 0 < C ∧
      ∀ (r q₀ q₁ q₂ a b₁ b₂ : ℕ),
        Squarefree (r * q₀ * q₁ * q₂) →
        Nat.Coprime a r → Nat.Coprime b₁ (q₀ * q₁) →
        Nat.Coprime b₂ (q₀ * q₂) →
        ∀ (ℓ h : ℤ),
        let P : ℕ := r * q₀ * q₁ * q₂
        ∀ (N t₀ : ℝ), (q₀ : ℝ) ≤ N → N ≤ (P : ℝ) ^ (3 : ℝ) →
        ∀ (ψ : ℝ → ℂ), ContDiff ℝ 1 ψ →
        Function.support ψ ⊆ Set.Icc (-T) T →
        (∀ t : ℝ, ‖ψ t‖ ≤ A₀ ∧ ‖deriv ψ t‖ ≤ A₁) →
        let g : ℕ := Int.gcd (q₀ : ℤ) ℓ
        let D : ℕ := Int.gcd h ((r * q₁ * q₂ : ℕ) : ℤ)
        let F : ℤ → ℂ := fun n =>
          ψ (((n : ℝ) - t₀) / N) * (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
            sourceTheta r q₀ 1 q₁ q₂ a b₁ b₂ ℓ n h
        let S : ℂ :=
          ∑ n ∈ Finset.Icc (⌈t₀ - T * N⌉ : ℤ) (⌊t₀ + T * N⌋ : ℤ), F n
        (∑' n : ℤ, F n) = S ∧
          ‖S‖ ≤ C * (P : ℝ) ^ η * (g : ℝ) *
            (Real.sqrt ((P / q₀ : ℕ) : ℝ) +
              (N / (q₀ : ℝ)) * ((D : ℝ) / (r * q₁ * q₂ : ℕ))) ∧
          ∀ (Y : Set.Ici (1 : ℝ)),
            Nonempty (DenseDivisibilityWitness
              Y 1 (r * q₀ * q₁)) →
            Nonempty (DenseDivisibilityWitness
              Y 1 (r * q₀ * q₂)) →
            ‖S‖ ≤ C * (P : ℝ) ^ η * (g : ℝ) *
              (Real.sqrt (N / (q₀ : ℝ)) * ((P : ℝ) * (Y : ℝ)) ^ (1 / 6 : ℝ) +
                (N / (q₀ : ℝ)) * ((D : ℝ) / (r * q₁ * q₂ : ℕ))) := by
  obtain ⟨K, hK, hbound⟩ := reciprocalUnitPhase_pair_smooth_class_bounds
    T A₀ A₁ 0 0 3 η hT hA₀ hA₁ hη
  refine ⟨2 * K, mul_pos (by norm_num) hK, ?_⟩
  intro r q₀ q₁ q₂ a b₁ b₂ hsq ha hb₁ hb₂ ℓ h P N t₀ hNd hN ψ hψ hψs hψb g D F S
  let u := q₀ * q₁
  let m₀ := Nat.lcm r u
  have hsq' : Squarefree (r * (u * q₂)) := by
    simpa only [u, Nat.mul_assoc] using hsq
  have hr : Squarefree r := hsq'.of_mul_left
  have hu : Squarefree u := hsq'.of_mul_right.of_mul_left
  have hq₂ : Squarefree q₂ := hsq'.of_mul_right.of_mul_right
  have hq₀ : Squarefree q₀ := hu.of_mul_left
  have hruq : Nat.Coprime r (u * q₂) := Nat.coprime_of_squarefree_mul hsq'
  have hru : Nat.Coprime r u := hruq.coprime_mul_right_right
  have hrq₂ : Nat.Coprime r q₂ := hruq.coprime_mul_left_right
  have huq₂ : Nat.Coprime u q₂ := Nat.coprime_of_squarefree_mul hsq'.of_mul_right
  have hm₀eq : m₀ = r * u := hru.lcm_eq_mul
  have hm₀sf : Squarefree m₀ := by
    rw [hm₀eq]
    simpa only [u, Nat.mul_assoc] using hsq.of_mul_left
  let : NeZero r := ⟨hr.ne_zero⟩
  let : NeZero u := ⟨hu.ne_zero⟩
  let : NeZero q₂ := ⟨hq₂.ne_zero⟩
  let : NeZero q₀ := ⟨hq₀.ne_zero⟩
  let : NeZero m₀ := ⟨hm₀sf.ne_zero⟩
  have hm₀q₂ : Nat.Coprime m₀ q₂ := by rw [hm₀eq]; exact hrq₂.mul_left huq₂
  have hq₀u : q₀ ∣ u := ⟨q₁, rfl⟩
  have hq₀m₀ : q₀ ∣ m₀ := hq₀u.trans (Nat.dvd_lcm_right r u)
  have hq₀q₂ : Nat.Coprime q₀ q₂ := huq₂.of_dvd_left hq₀u
  have hrq₀ : Nat.Coprime r q₀ := hru.of_dvd_right hq₀u
  have hmP : Nat.lcm m₀ q₂ = P := by
    rw [hm₀q₂.lcm_eq_mul, hm₀eq]
    simp only [P, u, Nat.mul_assoc]
  have hPpos : 0 < P := Nat.pos_of_ne_zero hsq.ne_zero
  have hq₀P : q₀ ∣ P := by
    rw [← hmP]
    exact hq₀m₀.trans (Nat.dvd_lcm_left _ _)
  have hNpos : 0 < N := lt_of_lt_of_le (by exact_mod_cast NeZero.pos q₀) hNd
  have hb₂q₂ : Nat.Coprime b₂ q₂ := hb₂.coprime_mul_left_right
  obtain ⟨c₀, c₁, hphase, hc₀, hc₁⟩ := sourceTheta_single_reciprocal_data
    r q₀ q₁ q₂ a b₁ b₂ hsq ha hb₁ hb₂q₂ ℓ h
  have hquot : m₀ / q₀ = r * q₁ := by
    rw [show m₀ = q₀ * (r * q₁) by rw [hm₀eq]; dsimp only [u]; ring,
      Nat.mul_div_cancel_left _ (NeZero.pos q₀)]
  have he₀dvd : r * q₁ ∣ m₀ := by
    rw [← hquot]
    exact Nat.div_dvd_of_dvd hq₀m₀
  have hcoeff : Nat.gcd c₀.val (r * q₁) = Nat.gcd h.natAbs (r * q₁) := by
    calc
      _ = Nat.gcd (Nat.gcd c₀.val m₀) (r * q₁) := by
        rw [Nat.gcd_assoc, Nat.gcd_eq_right he₀dvd]
      _ = Nat.gcd (Nat.gcd h.natAbs m₀) (r * q₁) := congrArg (fun k => Nat.gcd k (r * q₁)) hc₀
      _ = _ := by rw [Nat.gcd_assoc, Nat.gcd_eq_right he₀dvd]
  have hecop : Nat.Coprime (r * q₁) q₂ := hm₀q₂.of_dvd_left he₀dvd
  let m : Fin 2 → ℕ := ![m₀, q₂]
  let c : Fin 2 → ℤ := ![(c₀.val : ℤ), (c₁.val : ℤ)]
  let shifts : Fin 2 → ℤ := ![0, ℓ * (r : ℤ)]
  have hm : ∀ i, Squarefree (m i) := by intro i; fin_cases i <;> assumption
  let mean : ℝ := ∏ i : Fin 2,
    (Nat.gcd (c i).natAbs (m i / Nat.gcd (m 0) (m 1) /
      Nat.gcd q₀ (m i / Nat.gcd (m 0) (m 1))) : ℝ) /
      (m i / Nat.gcd (m 0) (m 1) / Nat.gcd q₀ (m i / Nat.gcd (m 0) (m 1)) : ℕ)
  have hmean : mean = (D : ℝ) / (r * q₁ * q₂ : ℕ) := by
    dsimp only [mean]
    rw [Fin.prod_univ_two]
    change ((Nat.gcd c₀.val (m₀ / Nat.gcd m₀ q₂ /
      Nat.gcd q₀ (m₀ / Nat.gcd m₀ q₂)) : ℝ) /
        (m₀ / Nat.gcd m₀ q₂ / Nat.gcd q₀ (m₀ / Nat.gcd m₀ q₂) : ℕ)) *
      ((Nat.gcd c₁.val (q₂ / Nat.gcd m₀ q₂ /
      Nat.gcd q₀ (q₂ / Nat.gcd m₀ q₂)) : ℝ) /
        (q₂ / Nat.gcd m₀ q₂ / Nat.gcd q₀ (q₂ / Nat.gcd m₀ q₂) : ℕ)) = _
    simp only [hm₀q₂.gcd_eq_one, Nat.div_one, Nat.gcd_eq_left hq₀m₀,
      hquot, hq₀q₂.gcd_eq_one, hcoeff, hc₁]
    calc
      _ = (Nat.gcd h.natAbs (r * q₁ * q₂) : ℝ) / (r * q₁ * q₂ : ℕ) := by
        rw [Nat.Coprime.gcd_mul _ hecop]
        simp only [Nat.cast_mul]
        exact div_mul_div_comm _ _ _ _
      _ = _ := by simp only [D, Int.gcd_def, Int.natAbs_natCast]
  let I := Finset.Icc (⌈t₀ - T * N⌉ : ℤ) (⌊t₀ + T * N⌋ : ℤ)
  let f : ℤ → ℂ := fun n => ψ (((n : ℝ) - t₀) / N) *
    (reciprocalUnitPhase m₀ c₀ (n : ZMod m₀) *
      reciprocalUnitPhase q₂ c₁ ((n + ℓ * (r : ℤ) : ℤ) : ZMod q₂))
  let R := (Finset.Icc 1 q₀).filter
    (fun z : ℕ => sourceCompatibility r q₀ b₁ b₂ ℓ (z : ℤ) = 1)
  let W : ℕ → ℂ := fun z => ∑ n ∈ I, if Int.ModEq (q₀ : ℤ) n (z : ℤ) then f n else 0
  have hF (n : ℤ) : F n = (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) * f n := by
    dsimp only [F, f]
    rw [hphase]
    ring
  have hS : S = ∑ z ∈ R, W z := by
    change (∑ n ∈ I, F n) = _
    simp_rw [hF]
    exact sourceTheta_single_compat_decompose q₀ r b₁ b₂ ℓ I f
  have hcard : (R.card : ℝ) ≤ 2 * (g : ℝ) := by
    have hh := sourceCompatibility_fixed_shift_count_le q₀ r b₁ b₂ q₀ ℓ
      hb₁.coprime_mul_right_right hrq₀
    simpa only [R, g, div_self (show (q₀ : ℝ) ≠ 0 by exact_mod_cast NeZero.ne q₀),
      one_add_one_eq_two, mul_comm] using hh
  have hsum (B₀ : ℝ) (hB₀ : 0 ≤ B₀)
      (hw : ∀ z ∈ R, ‖W z‖ ≤ K * (P : ℝ) ^ η * B₀) :
      ‖S‖ ≤ (2 * K) * (P : ℝ) ^ η * (g : ℝ) * B₀ := by
    rw [hS]
    calc
      ‖∑ z ∈ R, W z‖ ≤ ∑ _z ∈ R, K * (P : ℝ) ^ η * B₀ := norm_sum_le_of_le _ hw
      _ = (R.card : ℝ) * (K * (P : ℝ) ^ η * B₀) := by simp
      _ ≤ (2 * (g : ℝ)) * (K * (P : ℝ) ^ η * B₀) :=
        mul_le_mul_of_nonneg_right hcard
          (mul_nonneg (mul_nonneg hK.le (Real.rpow_nonneg (Nat.cast_nonneg _) _)) hB₀)
      _ = _ := by ring
  have hlocal (y : ℝ) (hy : 1 ≤ y)
      (hdense : ∀ X : ℝ, 1 ≤ X → X ≤ y * (P : ℝ) →
        ∃ d : ℕ, d ∣ P ∧ X / y ≤ (d : ℝ) ∧ (d : ℝ) ≤ X) (z : ℕ) :
      ‖W z‖ ≤ K * (P : ℝ) ^ η *
        (Real.sqrt (N / (q₀ : ℝ)) * ((P : ℝ) * y) ^ (1 / 6 : ℝ) +
          (N / (q₀ : ℝ)) * ((D : ℝ) / (r * q₁ * q₂ : ℕ))) ∧
      ‖W z‖ ≤ K * (P : ℝ) ^ η *
        (Real.sqrt ((P / q₀ : ℕ) : ℝ) +
          (N / (q₀ : ℝ)) * ((D : ℝ) / (r * q₁ * q₂ : ℕ))) := by
    have hmp : Nat.lcm (m 0) (m 1) = P := hmP
    have hh := hbound m hm y hy (by simpa only [hmp] using hdense)
      q₀ (by simpa only [hmp] using hq₀P) c shifts (z : ℤ) N t₀ hNd
      (by simpa only [hmp] using hN) ψ hψ hψs (by
        intro t
        simpa only [Real.rpow_zero, mul_one] using hψb t)
    have hphase' (n : ℤ) :
        (∏ i : Fin 2, letI : NeZero (m i) := ⟨(hm i).ne_zero⟩
          reciprocalUnitPhase (m i) (c i : ZMod (m i))
            ((n + shifts i : ℤ) : ZMod (m i))) =
          reciprocalUnitPhase m₀ c₀ (n : ZMod m₀) *
            reciprocalUnitPhase q₂ c₁
              ((n + ℓ * (r : ℤ) : ℤ) : ZMod q₂) := by
      rw [Fin.prod_univ_two]
      change reciprocalUnitPhase m₀ ((c₀.val : ℤ) : ZMod m₀)
        ((n + 0 : ℤ) : ZMod m₀) *
        reciprocalUnitPhase q₂ ((c₁.val : ℤ) : ZMod q₂)
          ((n + ℓ * (r : ℤ) : ℤ) : ZMod q₂) = _
      simp only [Int.cast_natCast, ZMod.natCast_zmod_val, add_zero]
    dsimp only at hh
    simp_rw [hphase'] at hh
    change (∑' n : ℤ, if Int.ModEq (q₀ : ℤ) n (z : ℤ) then f n else 0) = W z ∧
      ‖W z‖ ≤ K * (Nat.lcm (m 0) (m 1) : ℝ) ^ η *
        (Real.sqrt (N / (q₀ : ℝ)) *
            ((Nat.lcm (m 0) (m 1) : ℝ) * y) ^ (1 / 6 : ℝ) +
          (N / (q₀ : ℝ)) * mean) ∧
      ‖W z‖ ≤ K * (Nat.lcm (m 0) (m 1) : ℝ) ^ η *
        (Real.sqrt ((Nat.lcm (m 0) (m 1) / q₀ : ℕ) : ℝ) +
          (N / (q₀ : ℝ)) * mean) at hh
    rw [hmp, hmean] at hh
    exact ⟨hh.2.1, hh.2.2⟩
  refine ⟨?_, ?_, ?_⟩
  · change (∑' n : ℤ, F n) = ∑ n ∈ I, F n
    apply tsum_eq_sum
    intro n hn
    have hz : ψ (((n : ℝ) - t₀) / N) = 0 := by
      by_contra hz
      have hsupport := hψs (show ((n : ℝ) - t₀) / N ∈ Function.support ψ from hz)
      have hlow := (le_div_iff₀ hNpos).1 hsupport.1
      have hupp := (div_le_iff₀ hNpos).1 hsupport.2
      apply hn
      exact Finset.mem_Icc.mpr ⟨Int.ceil_le.mpr (by linarith only [hlow]),
        Int.le_floor.mpr (by linarith only [hupp])⟩
    simp only [F, hz, zero_mul]
  · apply hsum _ (by positivity)
    intro z _
    apply (hlocal (P : ℝ) (by exact_mod_cast hPpos) ?_ z).2
    intro X hX hXsq
    have hPR : 0 < (P : ℝ) := by exact_mod_cast hPpos
    by_cases hXP : X ≤ (P : ℝ)
    · refine ⟨1, one_dvd P, (div_le_iff₀ hPR).2 ?_, ?_⟩
      · simpa only [Nat.cast_one, one_mul] using hXP
      · simpa only [Nat.cast_one] using hX
    · exact ⟨P, dvd_rfl, (div_le_iff₀ hPR).2 hXsq, le_of_not_ge hXP⟩
  · intro Y hY₁ hY₂
    have hq₁q₂ : Nat.Coprime q₁ q₂ :=
      huq₂.of_dvd_left (show q₁ ∣ u from dvd_mul_left _ _)
    have hPY : Nat.lcm (r * q₀ * q₁) (r * q₀ * q₂) = P := by
      rw [Nat.lcm_mul_left, hq₁q₂.lcm_eq_mul]
      simp only [P, Nat.mul_assoc]
    have hY : Nonempty (DenseDivisibilityWitness Y 1 P) := by
      rw [← hPY]
      exact sourceTheta_single_dense_lcm Y _ _ hY₁ hY₂
    have hdense : ∀ X : ℝ, 1 ≤ X → X ≤ (Y : ℝ) * (P : ℝ) →
        ∃ d : ℕ, d ∣ P ∧ X / (Y : ℝ) ≤ (d : ℝ) ∧ (d : ℝ) ≤ X := by
      intro X hX hXY
      obtain ⟨u, v, huv, _, _, hlow, hupp⟩ :=
        (denseDivisibility_succ_iff.mp hY).2 0 0 rfl X hX hXY
      exact ⟨v, ⟨u, by simpa only [Nat.mul_comm] using huv⟩, hlow, hupp⟩
    apply hsum _ (add_nonneg
      (mul_nonneg (Real.sqrt_nonneg _)
        (Real.rpow_nonneg
          (mul_nonneg (Nat.cast_nonneg _) (zero_le_one.trans Y.property)) _))
      (mul_nonneg (div_nonneg hNpos.le (Nat.cast_nonneg _))
        (div_nonneg (Nat.cast_nonneg _) (Nat.cast_nonneg _))))
    intro z _
    exact (hlocal (Y : ℝ) Y.property hdense z).1

theorem sourceSmoothFactor_signed_gcd_sum_le
    (D K : ℕ) (hD : 0 < D) (J : Finset ℤ)
    (hJ : ∀ h ∈ J, h ≠ 0 ∧ -(K : ℤ) ≤ h ∧ h ≤ (K : ℤ)) :
    (∑ h ∈ J, (Int.gcd h (D : ℤ) : ℝ)) ≤
      2 * (K : ℝ) * (D.divisors.card : ℝ) := by
  classical
  let S := Finset.Icc (-(K : ℤ)) (K : ℤ)
  have hzero : (0 : ℤ) ∈ S := by simp [S]
  have hsplit := Finset.sum_erase_add S (fun h => (Int.gcd h (D : ℤ) : ℝ)) hzero
  have hbound := signed_interval_gcd_sum_le D K hD
  have herase : (∑ h ∈ S.erase 0, (Int.gcd h (D : ℤ) : ℝ)) ≤
      2 * (K : ℝ) * (D.divisors.card : ℝ) := by
    change (∑ h ∈ S, (Int.gcd h (D : ℤ) : ℝ)) ≤ _ at hbound
    simp only [Int.gcd_zero_left, Int.natAbs_natCast] at hsplit
    linarith
  apply le_trans ?_ herase
  apply Finset.sum_le_sum_of_subset_of_nonneg
  · intro h hh
    exact Finset.mem_erase.mpr ⟨(hJ h hh).1,
      Finset.mem_Icc.mpr (hJ h hh).2⟩
  · intro h _ _
    exact Nat.cast_nonneg _

theorem sourceSmoothFactor_terminal_geometry
    («ω» δ ε C x M N R Q H q γ : ℝ)
    (hC : 1 ≤ C) (hx : 1 ≤ x) (hε : 0 < ε) (hεsmall : ε ≤ 1 / 1000)
    (hM : 0 < M) (hN : 0 < N) (hR : 0 < R) (hQ : 0 < Q) (hq : 1 ≤ q)
    (hH : H = x ^ ε * R * Q ^ 2 / (q * M))
    (hMN : x / C ≤ M * N) (hNγ : N = x ^ γ)
    (hNR : N ≤ C * x ^ (δ + 6 * ε) * R)
    (hRQ : R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε))
    (hγlo : 1 / 4 + 7 * «ω» + 2 * δ + 100 * ε ≤ γ)
    (hγhi : γ ≤ 1 / 2 + ε) :
    H * Real.sqrt (N / q) *
        (2 * C ^ 2 * R * Q ^ 2 / q * x ^ δ) ^ (1 / 6 : ℝ) / N ≤
      2 * C ^ 5 * x ^ (-50 * ε) ∧
    H * q / (R * Q ^ 2) ≤ C * x ^ (-40 * ε) := by
  have hxpos : 0 < x := zero_lt_one.trans_le hx
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hqpos : 0 < q := zero_lt_one.trans_le hq
  have hHpos : 0 < H := by rw [hH]; positivity
  have hlogx : 0 ≤ Real.log x := Real.log_nonneg hx
  have hlogC : 0 ≤ Real.log C := Real.log_nonneg hC
  have hlogq : 0 ≤ Real.log q := Real.log_nonneg hq
  have hlogtwo : 0 ≤ Real.log 2 := Real.log_nonneg (by norm_num)
  have hlogMN := Real.log_le_log (div_pos hxpos hCpos) hMN
  have hlogNR := Real.log_le_log hN hNR
  have hlogRQ := Real.log_le_log (mul_pos hR hQ) hRQ
  have hlogN : Real.log N = γ * Real.log x := by
    rw [hNγ, Real.log_rpow hxpos]
  have hlogH : Real.log H = ε * Real.log x + Real.log R + 2 * Real.log Q -
      Real.log q - Real.log M := by
    rw [hH]
    simp (disch := positivity) only [Real.log_div, Real.log_mul, Real.log_pow,
      Real.log_rpow, Nat.cast_ofNat]
    ring
  simp (disch := positivity) only [Real.log_div, Real.log_mul, Real.log_rpow]
    at hlogMN hlogNR hlogRQ
  have hγlower := mul_le_mul_of_nonneg_right hγlo hlogx
  have hγupper := mul_le_mul_of_nonneg_right hγhi hlogx
  have hepslog : 0 ≤ ε * Real.log x := mul_nonneg hε.le hlogx
  have hsmalllog := mul_le_mul_of_nonneg_right hεsmall hlogx
  constructor
  · apply (Real.log_le_log_iff (by positivity) (by positivity)).mp
    simp (disch := positivity) only [Real.sqrt_eq_rpow, Real.log_div, Real.log_mul,
      Real.log_pow, Real.log_rpow, Nat.cast_ofNat]
    rw [hlogH]
    nlinarith only [hlogMN, hlogNR, hlogRQ, hlogN, hγlower,
      hlogC, hlogq, hlogtwo, hepslog]
  · apply (Real.log_le_log_iff (by positivity) (by positivity)).mp
    simp (disch := positivity) only [Real.log_div, Real.log_mul, Real.log_pow,
      Real.log_rpow, Nat.cast_ofNat]
    rw [hlogH]
    nlinarith only [hlogMN, hlogN, hγupper, hsmalllog, hlogx]

theorem sourceSmoothFactor_modulus_geometry
    («ω» δ ε C x N R Q γ : ℝ) (r q₀ q₁ q₂ : ℕ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε) (hεsmall : ε ≤ 1 / 1000)
    (hC : 1 ≤ C) (hx : 1 ≤ x) (hlarge : 100 * C ^ 10 ≤ x ^ ε)
    (hN : 0 < N) (hR : 0 < R) (hQ : 0 < Q)
    (hNγ : N = x ^ γ) (hNR : N ≤ C * x ^ (δ + 6 * ε) * R)
    (hRQlo : x ^ (1 / 2 - ε) ≤ C * R * Q)
    (hRQhi : R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε))
    (hγlo : 1 / 4 + 7 * «ω» + 2 * δ + 100 * ε ≤ γ)
    (hγhi : γ ≤ 1 / 2 + ε)
    (hr : 0 < r) (hq₀ : 0 < q₀) (hq₁ : 0 < q₁) (hq₂ : 0 < q₂)
    (hRr : R ≤ (r : ℝ)) (hrR : (r : ℝ) ≤ 2 * R)
    (hq₁lo : Q ≤ (q₀ * q₁ : ℕ)) (hq₁hi : (q₀ * q₁ : ℕ) ≤ 2 * Q)
    (_hq₂lo : Q ≤ (q₀ * q₂ : ℕ)) (hq₂hi : (q₀ * q₂ : ℕ) ≤ 2 * Q) :
    let P : ℕ := r * q₀ * q₁ * q₂
    (q₀ : ℝ) ≤ N ∧ (P : ℝ) ≤ x ^ (10 : ℝ) ∧
      N ≤ (P : ℝ) ^ (3 : ℝ) ∧
      (P : ℝ) ≤ 8 * R * Q ^ 2 / (q₀ : ℝ) ∧
      R * Q ≤ (P : ℝ) := by
  intro P
  have hxpos : 0 < x := zero_lt_one.trans_le hx
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hqpos : (0 : ℝ) < q₀ := by exact_mod_cast hq₀
  have hqone : (1 : ℝ) ≤ q₀ := by exact_mod_cast hq₀
  have hPpos : (0 : ℝ) < P := by dsimp only [P]; positivity
  have hlogx : 0 ≤ Real.log x := Real.log_nonneg hx
  have hlogC : 0 ≤ Real.log C := Real.log_nonneg hC
  have hlog2 : 0 ≤ Real.log 2 := Real.log_nonneg (by norm_num)
  have hlog8 : Real.log 8 = 3 * Real.log 2 := by
    rw [show (8 : ℝ) = 2 ^ 3 by norm_num, Real.log_pow]
    norm_num
  have hlog2_100 : Real.log 2 ≤ Real.log 100 :=
    Real.log_le_log (by norm_num) (by norm_num)
  have hlog8_100 : Real.log 8 ≤ Real.log 100 :=
    Real.log_le_log (by norm_num) (by norm_num)
  have hloglarge := Real.log_le_log (by positivity : 0 < 100 * C ^ 10) hlarge
  simp (disch := positivity) only [Real.log_mul, Real.log_pow, Real.log_rpow,
    Nat.cast_ofNat] at hloglarge
  have hlogNR := Real.log_le_log hN hNR
  have hlogRQhi := Real.log_le_log (mul_pos hR hQ) hRQhi
  have hlogRQlo := Real.log_le_log (Real.rpow_pos_of_pos hxpos _) hRQlo
  simp (disch := positivity) only [Real.log_mul, Real.log_rpow]
    at hlogNR hlogRQhi hlogRQlo
  have hlogN : Real.log N = γ * Real.log x := by rw [hNγ, Real.log_rpow hxpos]
  have hγlower := mul_le_mul_of_nonneg_right hγlo hlogx
  have hγupper := mul_le_mul_of_nonneg_right hγhi hlogx
  have hωlog : 0 ≤ «ω» * Real.log x := mul_nonneg hω.le hlogx
  have hδlog : 0 ≤ δ * Real.log x := mul_nonneg hδ.le hlogx
  have hεlog : 0 ≤ ε * Real.log x := mul_nonneg hε.le hlogx
  have hsmalllog := mul_le_mul_of_nonneg_right hεsmall hlogx
  have hPupper : (P : ℝ) ≤ 8 * R * Q ^ 2 / (q₀ : ℝ) := by
    apply (le_div_iff₀ hqpos).mpr
    calc
      (P : ℝ) * (q₀ : ℝ) =
          (r : ℝ) * ((q₀ * q₁ : ℕ) : ℝ) * ((q₀ * q₂ : ℕ) : ℝ) := by
        dsimp only [P]
        push_cast
        ring
      _ ≤ (2 * R) * (2 * Q) * (2 * Q) := by gcongr
      _ = _ := by ring
  have hPlower : R * Q ≤ (P : ℝ) := by
    have hq₂one : (1 : ℝ) ≤ q₂ := by exact_mod_cast hq₂
    calc
      R * Q ≤ (r : ℝ) * ((q₀ * q₁ : ℕ) : ℝ) :=
        mul_le_mul hRr hq₁lo hQ.le (Nat.cast_nonneg _)
      _ ≤ (r : ℝ) * ((q₀ * q₁ : ℕ) : ℝ) * (q₂ : ℝ) :=
        le_mul_of_one_le_right (by positivity) hq₂one
      _ = _ := by dsimp only [P]; push_cast; ring
  have hqN : (q₀ : ℝ) ≤ N := by
    have hqQ : (q₀ : ℝ) ≤ 2 * Q := by
      have hqmul : (q₀ : ℝ) ≤ ((q₀ * q₁ : ℕ) : ℝ) := by
        exact_mod_cast Nat.le_mul_of_pos_right q₀ hq₁
      exact hqmul.trans hq₁hi
    apply hqQ.trans
    apply (Real.log_le_log_iff (by positivity) hN).mp
    rw [Real.log_mul (by norm_num) hQ.ne']
    nlinarith only [hlogNR, hlogRQhi, hloglarge, hlog2_100, hlogN,
      hγlower, hωlog, hδlog, hεlog, hlogC]
  have hPx : (P : ℝ) ≤ x ^ (10 : ℝ) := by
    have hP' : (P : ℝ) ≤ 8 * R * Q ^ 2 :=
      hPupper.trans (div_le_self (by positivity) hqone)
    have hlogP := Real.log_le_log hPpos hP'
    simp (disch := positivity) only [Real.log_mul, Real.log_pow, Nat.cast_ofNat]
      at hlogP
    apply (Real.log_le_log_iff hPpos (Real.rpow_pos_of_pos hxpos _)).mp
    rw [Real.log_rpow hxpos]
    nlinarith only [hlogP, hlogNR, hlogRQhi, hloglarge, hlog8_100, hlogN,
      hγlower, hωlog, hδlog, hεlog, hlogC, hlogx]
  have hNP : N ≤ (P : ℝ) ^ (3 : ℝ) := by
    have hlogP := Real.log_le_log (mul_pos hR hQ) hPlower
    rw [Real.log_mul hR.ne' hQ.ne'] at hlogP
    apply (Real.log_le_log_iff hN (Real.rpow_pos_of_pos hPpos _)).mp
    rw [Real.log_rpow hPpos]
    nlinarith only [hlogP, hlogRQlo, hloglarge, hlogN, hγupper,
      hsmalllog, hlogC, hlogx, hlog2, hlog2_100]
  exact ⟨hqN, hPx, hNP, hPupper, hPlower⟩

theorem sourceSmoothFactor_normalized_pair
    (cN TN W s : ℝ) (hcN : 0 < cN) (hW : 0 < W)
    (ψ : ℝ → ℂ) (hψ : ContDiff ℝ 1 ψ)
    (hsupport : Function.support ψ ⊆ Set.Icc cN TN)
    (hbound : ∀ t : ℝ, ‖ψ t‖ ≤ W ∧ ‖deriv ψ t‖ ≤ W) :
    ∃ φ : ℝ → ℂ, ContDiff ℝ 1 φ ∧
      Function.support φ ⊆ Set.Icc (-(max 1 TN)) (max 1 TN) ∧
      (∀ t : ℝ, ‖φ t‖ ≤ 1 ∧ ‖deriv φ t‖ ≤ 2) ∧
      ∀ t : ℝ, ψ t * star (ψ (t + s)) = ((W ^ 2 : ℝ) : ℂ) * φ t := by
  let f : ℝ → ℂ := fun t => ψ t * star (ψ (t + s))
  have hshift : ContDiff ℝ 1 (fun t : ℝ => ψ (t + s)) :=
    hψ.comp (contDiff_id.add contDiff_const)
  have hstar : ContDiff ℝ 1 (fun t : ℝ => star (ψ (t + s))) := by
    simpa only [Function.comp_def, Complex.conjCLE_apply, Complex.star_def] using
      Complex.conjCLE.contDiff.comp hshift
  have hf : ContDiff ℝ 1 f := hψ.mul hstar
  let φ : ℝ → ℂ := (W ^ 2)⁻¹ • f
  have hWsq : 0 < W ^ 2 := sq_pos_of_pos hW
  have hφ : ContDiff ℝ 1 φ := ContDiff.const_smul (W ^ 2)⁻¹ hf
  have hφeq (t : ℝ) : f t = ((W ^ 2 : ℝ) : ℂ) * φ t := by
    simp only [φ, Pi.smul_apply, Complex.real_smul, Complex.ofReal_inv]
    rw [← mul_assoc, mul_inv_cancel₀ (by exact_mod_cast hWsq.ne'), one_mul]
  refine ⟨φ, hφ, ?_, ?_, hφeq⟩
  · intro t ht
    have hψt : ψ t ≠ 0 := by
      intro hz
      have hfzero : f t = 0 := by simp only [f, hz, zero_mul]
      exact ht (by simp only [φ, Pi.smul_apply, hfzero, smul_zero])
    have hh := hsupport hψt
    exact ⟨by linarith [hh.1, le_max_left (1 : ℝ) TN], hh.2.trans (le_max_right _ _)⟩
  · intro t
    have hfnorm : ‖f t‖ ≤ W ^ 2 := by
      dsimp only [f]
      rw [norm_mul, norm_star]
      simpa only [pow_two] using
        mul_le_mul (hbound t).1 (hbound (t + s)).1 (norm_nonneg _) hW.le
    have hderiv : ‖deriv f t‖ ≤ 2 * W ^ 2 := by
      dsimp only [f]
      rw [deriv_fun_mul (hψ.differentiable_one t) (hstar.differentiable_one t),
        deriv.star, deriv_comp_add_const]
      calc
        _ ≤ ‖deriv ψ t * star (ψ (t + s))‖ +
          ‖ψ t * star (deriv ψ (t + s))‖ := norm_add_le _ _
        _ ≤ W * W + W * W := by
          simp only [norm_mul, norm_star]
          exact add_le_add
            (mul_le_mul (hbound t).2 (hbound (t + s)).1 (norm_nonneg _) hW.le)
            (mul_le_mul (hbound t).1 (hbound (t + s)).2 (norm_nonneg _) hW.le)
        _ = _ := by ring
    constructor
    · calc
        ‖φ t‖ = (W ^ 2)⁻¹ * ‖f t‖ := by
          simp only [φ, Pi.smul_apply, norm_smul, Real.norm_of_nonneg (inv_nonneg.mpr hWsq.le)]
        _ ≤ (W ^ 2)⁻¹ * W ^ 2 := mul_le_mul_of_nonneg_left hfnorm (inv_nonneg.mpr hWsq.le)
        _ = 1 := inv_mul_cancel₀ hWsq.ne'
    · calc
        ‖deriv φ t‖ = (W ^ 2)⁻¹ * ‖deriv f t‖ := by
          rw [show φ = (W ^ 2)⁻¹ • f from rfl, deriv_const_smul _ (hf.differentiable_one t),
            norm_smul, Real.norm_of_nonneg (inv_nonneg.mpr hWsq.le)]
        _ ≤ (W ^ 2)⁻¹ * (2 * W ^ 2) :=
          mul_le_mul_of_nonneg_left hderiv (inv_nonneg.mpr hWsq.le)
        _ = 2 := by field_simp

open Classical in
theorem sourceSmoothFactor_fiber_uniform_power_saving
    («ω» δ ε C cN TN L : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε) (hεsmall : ε ≤ 1 / 1000)
    (hC : 1 ≤ C) (hcN : 0 < cN) (_hNT : cN ≤ TN) (hL : 0 ≤ L) :
    ∃ K X : ℝ, 0 < K ∧ 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ M N R Q H γ : ℝ,
        0 < M → 0 < N → 0 < R → 0 < Q →
        x / C ≤ M * N → N = x ^ γ →
        N ≤ C * x ^ (δ + 6 * ε) * R →
        R ≤ C * x ^ (-2 * ε) * N →
        x ^ (1 / 2 - ε) ≤ C * R * Q →
        R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) →
        1 / 4 + 7 * «ω» + 2 * δ + 100 * ε ≤ γ →
        γ ≤ 1 / 2 + ε →
      ∀ r q₀ a b₁ b₂ : ℕ, 0 < r → 0 < q₀ →
        R ≤ (r : ℝ) → (r : ℝ) ≤ 2 * R →
        H = x ^ ε * R * Q ^ 2 / ((q₀ : ℝ) * M) → 1 ≤ H →
      ∀ (Y : Set.Ici (1 : ℝ)), (Y : ℝ) ≤ x ^ δ →
      ∀ (F : Finset (ℕ × ℕ)) (J : Finset ℤ),
        (∀ q ∈ F,
          0 < q.1 ∧ 0 < q.2 ∧ Squarefree (r * q₀ * q.1 * q.2) ∧
          Q ≤ (q₀ * q.1 : ℕ) ∧ (q₀ * q.1 : ℕ) ≤ 2 * Q ∧
          Q ≤ (q₀ * q.2 : ℕ) ∧ (q₀ * q.2 : ℕ) ≤ 2 * Q) →
        (∀ q ∈ F,
          Nonempty (DenseDivisibilityWitness
            Y 1 (r * q₀ * q.1)) ∧
          Nonempty (DenseDivisibilityWitness
            Y 1 (r * q₀ * q.2))) →
        (∀ h ∈ J, h ≠ 0 ∧ |(h : ℝ)| ≤ 2 * H) →
        Nat.Coprime a r →
        (∀ q ∈ F, Nat.Coprime b₁ (q₀ * q.1) ∧ Nat.Coprime b₂ (q₀ * q.2)) →
      ∀ (ℓ : ℤ) (ψN : ℝ → ℂ),
        ContDiff ℝ 1 ψN → Function.support ψN ⊆ Set.Icc cN TN →
        (∀ t : ℝ, ‖ψN t‖ ≤ x ^ (ε / 100) ∧ ‖deriv ψN t‖ ≤ x ^ (ε / 100)) →
      ∀ (c : (ℕ × ℕ) → ℤ → ℂ), (∀ q ∈ F, ∀ h ∈ J, ‖c q h‖ ≤ L) →
      let β : ℕ →₀ ℂ := positiveCompactProfileSequence ψN TN N 0
      let βℤ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
      (∑ q ∈ F, ‖∑ n ∈ βℤ.support,
        βℤ n * star (βℤ (n + ℓ * (r : ℤ))) *
          (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
          ∑ h ∈ J, c q h * sourceTheta r q₀ 1 q.1 q.2 a b₁ b₂ ℓ n h‖) ≤
        K * Q ^ 2 * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) /
          (q₀ : ℝ) ^ 2 * x ^ (-ε / 4) := by
  obtain ⟨K₀, hK₀, hsingle⟩ := sourceTheta_single_smooth_bounds
    (max 1 TN) 1 2 (ε / 1000) (le_max_left _ _) (by norm_num) (by norm_num) (by positivity)
  obtain ⟨Cτ, hCτ, hτraw⟩ := exists_card_divisors_bound (by positivity : 0 < ε / 2000)
  obtain ⟨X₁, hX₁⟩ := Filter.eventually_atTop.mp
    ((tendsto_rpow_atTop (by positivity : 0 < ε / 200)).eventually_ge_atTop Cτ)
  obtain ⟨X₂, hX₂⟩ := Filter.eventually_atTop.mp
    ((tendsto_rpow_atTop hε).eventually_ge_atTop (100 * C ^ 10))
  let K : ℝ := 4 * K₀ * (L + 1) * (320 * C ^ 5 + 8 * C)
  have hK : 0 < K := by dsimp only [K]; positivity
  refine ⟨K, max 1 (max X₁ X₂), hK, le_max_left _ _, ?_⟩
  intro x hx M N R Q H γ hM hN hR hQ hMN hNγ hNR hRN hRQlo hRQhi hγlo hγhi
    r q₀ a b₁ b₂ hr hq₀ hRr hrR hH hHone Y hY F J hF hdense hJ ha hb ℓ ψN
    hψ hψs hψb c hc β βℤ
  have hxone : 1 ≤ x := (le_max_left _ _).trans hx
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  have hlarge : 100 * C ^ 10 ≤ x ^ ε :=
    hX₂ x ((le_max_right _ _).trans ((le_max_right _ _).trans hx))
  have hτconstant : Cτ ≤ x ^ (ε / 200) :=
    hX₁ x ((le_max_left _ _).trans ((le_max_right _ _).trans hx))
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hqpos : (0 : ℝ) < q₀ := by exact_mod_cast hq₀
  have hqone : (1 : ℝ) ≤ q₀ := by exact_mod_cast hq₀
  have hHpos : 0 < H := zero_lt_one.trans_le hHone
  have hYnonneg : 0 ≤ (Y : ℝ) := zero_le_one.trans Y.property
  let D : ℝ := x ^ (ε / 100)
  have hDpos : 0 < D := Real.rpow_pos_of_pos hxpos _
  have hDone : 1 ≤ D := Real.one_le_rpow hxone (by positivity)
  have hτ (n : ℕ) (hn : 0 < n) (hnx : (n : ℝ) ≤ x ^ (10 : ℝ)) :
      (n.divisors.card : ℝ) ≤ D := by
    calc
      _ ≤ Cτ * (n : ℝ) ^ (ε / 2000) := hτraw n hn.ne'
      _ ≤ x ^ (ε / 200) * (x ^ (10 : ℝ)) ^ (ε / 2000) :=
        mul_le_mul hτconstant
          (Real.rpow_le_rpow (Nat.cast_nonneg _) hnx (by positivity))
          (Real.rpow_nonneg (Nat.cast_nonneg _) _) (Real.rpow_nonneg hxpos.le _)
      _ = D := by
        rw [← Real.rpow_mul hxpos.le, ← Real.rpow_add hxpos]
        congr 1
        ring
  let P : (ℕ × ℕ) → ℕ := fun q => r * q₀ * q.1 * q.2
  have hmod (q : ℕ × ℕ) (hq : q ∈ F) :
      (q₀ : ℝ) ≤ N ∧ (P q : ℝ) ≤ x ^ (10 : ℝ) ∧
        N ≤ (P q : ℝ) ^ (3 : ℝ) ∧
        (P q : ℝ) ≤ 8 * R * Q ^ 2 / (q₀ : ℝ) ∧ R * Q ≤ (P q : ℝ) := by
    rcases hF q hq with ⟨hq₁, hq₂, _, hq₁lo, hq₁hi, hq₂lo, hq₂hi⟩
    exact sourceSmoothFactor_modulus_geometry «ω» δ ε C x N R Q γ r q₀ q.1 q.2
      hω hδ hε hεsmall hC hxone hlarge hN hR hQ hNγ hNR hRQlo hRQhi hγlo hγhi
      hr hq₀ hq₁ hq₂ hRr hrR hq₁lo hq₁hi hq₂lo hq₂hi
  have hPlower (q : ℕ × ℕ) (hq : q ∈ F) :
      R * Q ^ 2 / (q₀ : ℝ) ≤ (P q : ℝ) := by
    rcases hF q hq with ⟨_, _, _, hq₁lo, _, hq₂lo, _⟩
    apply (div_le_iff₀ hqpos).mpr
    calc
      R * Q ^ 2 = R * Q * Q := by ring
      _ ≤ (r : ℝ) * ((q₀ * q.1 : ℕ) : ℝ) * ((q₀ * q.2 : ℕ) : ℝ) :=
        mul_le_mul (mul_le_mul hRr hq₁lo hQ.le (Nat.cast_nonneg _))
          hq₂lo hQ.le (by positivity)
      _ = _ := by dsimp only [P]; push_cast; ring
  have hPη (q : ℕ × ℕ) (hq : q ∈ F) : (P q : ℝ) ^ (ε / 1000) ≤ D := by
    calc
      _ ≤ (x ^ (10 : ℝ)) ^ (ε / 1000) :=
        Real.rpow_le_rpow (Nat.cast_nonneg _) (hmod q hq).2.1 (by positivity)
      _ = D := by rw [← Real.rpow_mul hxpos.le]; congr 1; ring
  let HN : ℕ := ⌊2 * H⌋₊
  have hHN : (HN : ℝ) ≤ 2 * H := Nat.floor_le (by positivity)
  have hJnat (h : ℤ) (hh : h ∈ J) : h ≠ 0 ∧ -(HN : ℤ) ≤ h ∧ h ≤ (HN : ℤ) := by
    have hcast : (h.natAbs : ℝ) = |(h : ℝ)| := by
      rw [Nat.cast_natAbs, Int.cast_abs]
    have hreal : (h.natAbs : ℝ) ≤ 2 * H := by rw [hcast]; exact (hJ h hh).2
    have habs : h.natAbs ≤ HN :=
      (Nat.le_floor_iff (by positivity : (0 : ℝ) ≤ 2 * H)).mpr hreal
    exact ⟨(hJ h hh).1, by omega, by omega⟩
  have hJcard : (J.card : ℝ) ≤ 5 * H := by
    have hsub : J ⊆ Finset.Icc (-(HN : ℤ)) (HN : ℤ) :=
      fun h hh => Finset.mem_Icc.mpr (hJnat h hh).2
    have hcard : ((Finset.Icc (-(HN : ℤ)) (HN : ℤ)).card : ℝ) = 2 * (HN : ℝ) + 1 := by
      have hh := Int.card_Icc_of_le (a := -(HN : ℤ)) (b := (HN : ℤ)) (by omega)
      have hh' : ((Finset.Icc (-(HN : ℤ)) (HN : ℤ)).card : ℝ) =
          (HN : ℝ) + 1 - (-(HN : ℝ)) := by exact_mod_cast hh
      linarith only [hh']
    calc
      (J.card : ℝ) ≤ ((Finset.Icc (-(HN : ℤ)) (HN : ℤ)).card : ℝ) := by
        exact_mod_cast Finset.card_le_card hsub
      _ = 2 * (HN : ℝ) + 1 := hcard
      _ ≤ 5 * H := by linarith only [hHN, hHone]
  have hcoordinate (q : ℕ × ℕ) (hq : q ∈ F) :
      (q.1 : ℝ) ≤ 2 * Q / (q₀ : ℝ) ∧ (q.2 : ℝ) ≤ 2 * Q / (q₀ : ℝ) := by
    rcases hF q hq with ⟨_, _, _, _, hq₁hi, _, hq₂hi⟩
    constructor <;> apply (le_div_iff₀ hqpos).mpr
    · simpa only [Nat.cast_mul, mul_comm] using hq₁hi
    · simpa only [Nat.cast_mul, mul_comm] using hq₂hi
  have hFcard : (F.card : ℝ) ≤ 4 * Q ^ 2 / (q₀ : ℝ) ^ 2 := by
    let QN : ℕ := ⌊2 * Q / (q₀ : ℝ)⌋₊
    have hsub : F ⊆ (Finset.Icc 1 QN) ×ˢ (Finset.Icc 1 QN) := by
      intro q hq
      apply Finset.mem_product.mpr
      constructor
      · exact Finset.mem_Icc.mpr ⟨(hF q hq).1,
          (Nat.le_floor_iff (by positivity)).mpr (hcoordinate q hq).1⟩
      · exact Finset.mem_Icc.mpr ⟨(hF q hq).2.1,
          (Nat.le_floor_iff (by positivity)).mpr (hcoordinate q hq).2⟩
    have hcard : F.card ≤ QN ^ 2 := by
      simpa only [Finset.card_product, Nat.card_Icc, Nat.add_sub_cancel, pow_two] using
        Finset.card_le_card hsub
    calc
      (F.card : ℝ) ≤ (QN : ℝ) ^ 2 := by exact_mod_cast hcard
      _ ≤ (2 * Q / (q₀ : ℝ)) ^ 2 :=
        pow_le_pow_left₀ (Nat.cast_nonneg _) (Nat.floor_le (by positivity)) 2
      _ = _ := by ring
  let B : ℝ := Real.sqrt (N / (q₀ : ℝ)) *
    (8 * C ^ 2 * R * Q ^ 2 / (q₀ : ℝ) * x ^ δ) ^ (1 / 6 : ℝ)
  have hB0 : 0 ≤ B := by dsimp only [B]; positivity
  have hscale := sourceSmoothFactor_terminal_geometry «ω» δ ε (2 * C) x M N R Q H
    (q₀ : ℝ) γ (by linarith) hxone hε hεsmall hM hN hR hQ hqone hH
    (by
      calc
        x / (2 * C) ≤ x / C :=
          div_le_div_of_nonneg_left hxpos.le hCpos (by linarith)
        _ ≤ M * N := hMN)
    hNγ
    (hNR.trans (mul_le_mul_of_nonneg_right
      (mul_le_mul_of_nonneg_right (show C ≤ 2 * C by linarith)
        (Real.rpow_nonneg hxpos.le _)) hR.le))
    (hRQhi.trans (mul_le_mul_of_nonneg_right (show C ≤ 2 * C by linarith)
      (Real.rpow_nonneg hxpos.le _)))
    hγlo hγhi
  have hdeep : H * B ≤ 64 * C ^ 5 * N * x ^ (-50 * ε) := by
    have hh := (div_le_iff₀ hN).mp hscale.1
    have hbase : 2 * (2 * C) ^ 2 * R * Q ^ 2 / (q₀ : ℝ) * x ^ δ =
      8 * C ^ 2 * R * Q ^ 2 / (q₀ : ℝ) * x ^ δ := by ring
    rw [hbase] at hh
    dsimp only [B]
    nlinarith only [hh]
  have hmeanScale : H * N * (q₀ : ℝ) / (R * Q ^ 2) ≤
      2 * C * N * x ^ (-40 * ε) := by
    calc
      _ = N * (H * (q₀ : ℝ) / (R * Q ^ 2)) := by ring
      _ ≤ N * (2 * C * x ^ (-40 * ε)) :=
        mul_le_mul_of_nonneg_left hscale.2 hN.le
      _ = _ := by ring
  let g : ℝ := (Int.gcd (q₀ : ℤ) ℓ : ℝ)
  have hg0 : 0 ≤ g := Nat.cast_nonneg _
  obtain ⟨φ, hφ, hφs, hφb, hφeq⟩ := sourceSmoothFactor_normalized_pair
    cN TN D (((ℓ * (r : ℤ) : ℤ) : ℝ) / N) hcN hDpos ψN hψ hψs hψb
  have hβ (n : ℤ) : βℤ n = ψN ((n : ℝ) / N) :=
    positiveCompactProfileSequence_intCast_eq cN TN N hcN hN ψN hψs n
  have hproduct (n : ℤ) :
      βℤ n * star (βℤ (n + ℓ * (r : ℤ))) = ((D ^ 2 : ℝ) : ℂ) * φ ((n : ℝ) / N) := by
    rw [hβ, hβ]
    rw [show (((n + ℓ * (r : ℤ) : ℤ) : ℝ) / N) =
      (n : ℝ) / N + ((ℓ * (r : ℤ) : ℤ) : ℝ) / N by push_cast; ring]
    exact hφeq _
  have hφzero (n : ℤ) (hn : n ∉ βℤ.support) : φ ((n : ℝ) / N) = 0 := by
    have hh := hproduct n
    rw [Finsupp.notMem_support_iff.mp hn, zero_mul] at hh
    exact (mul_eq_zero.mp hh.symm).resolve_left (by exact_mod_cast (sq_pos_of_pos hDpos).ne')
  let I := Finset.Icc (⌈-((max 1 TN) * N)⌉ : ℤ) (⌊(max 1 TN) * N⌋ : ℤ)
  let S : (ℕ × ℕ) → ℤ → ℂ := fun q h =>
    ∑ n ∈ I, φ ((n : ℝ) / N) * (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
      sourceTheta r q₀ 1 q.1 q.2 a b₁ b₂ ℓ n h
  have hlocal (q : ℕ × ℕ) (hq : q ∈ F) (h : ℤ) :
      (∑ n ∈ βℤ.support, φ ((n : ℝ) / N) *
        (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
          sourceTheta r q₀ 1 q.1 q.2 a b₁ b₂ ℓ n h) = S q h ∧
      ‖S q h‖ ≤ K₀ * D * g *
        (B + (N * (q₀ : ℝ) / (R * Q ^ 2)) *
          (Int.gcd h ((r * q.1 * q.2 : ℕ) : ℤ) : ℝ)) := by
    rcases hF q hq with ⟨hq₁, hq₂, hsq, _, _, _, _⟩
    have hh := hsingle r q₀ q.1 q.2 a b₁ b₂ hsq ha (hb q hq).1 (hb q hq).2
      ℓ h N 0 (hmod q hq).1 (hmod q hq).2.2.1 φ hφ hφs hφb
    dsimp only at hh
    simp only [sub_zero, zero_sub, zero_add] at hh
    change (∑' n : ℤ, φ ((n : ℝ) / N) *
        (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
          sourceTheta r q₀ 1 q.1 q.2 a b₁ b₂ ℓ n h) = S q h ∧ _ at hh
    constructor
    · rw [← hh.1]
      symm
      apply tsum_eq_sum
      intro n hn
      simp only [hφzero n hn, zero_mul]
    · have hd := hh.2.2 Y (hdense q hq).1 (hdense q hq).2
      have hroot : Real.sqrt (N / (q₀ : ℝ)) *
          ((P q : ℝ) * (Y : ℝ)) ^ (1 / 6 : ℝ) ≤ B := by
        apply mul_le_mul_of_nonneg_left ?_ (Real.sqrt_nonneg _)
        apply Real.rpow_le_rpow
          (mul_nonneg (Nat.cast_nonneg _) (zero_le_one.trans Y.property)) ?_ (by norm_num)
        calc
          (P q : ℝ) * (Y : ℝ) ≤
              (8 * R * Q ^ 2 / (q₀ : ℝ)) * x ^ δ :=
            mul_le_mul (hmod q hq).2.2.2.1 hY (zero_le_one.trans Y.property) (by positivity)
          _ ≤ 8 * C ^ 2 * R * Q ^ 2 / (q₀ : ℝ) * x ^ δ := by
            have hC2 : 1 ≤ C ^ 2 := one_le_pow₀ hC
            gcongr
            nlinarith only [hC2]
      have hmean : (N / (q₀ : ℝ)) *
          ((Int.gcd h ((r * q.1 * q.2 : ℕ) : ℤ) : ℝ) / (r * q.1 * q.2 : ℕ)) ≤
          (N * (q₀ : ℝ) / (R * Q ^ 2)) *
            (Int.gcd h ((r * q.1 * q.2 : ℕ) : ℤ) : ℝ) := by
        have hPpos : (0 : ℝ) < P q := by dsimp only [P]; positivity
        have hinv : N / (P q : ℝ) ≤ N * (q₀ : ℝ) / (R * Q ^ 2) := by
          calc
            N / (P q : ℝ) ≤ N / (R * Q ^ 2 / (q₀ : ℝ)) :=
              div_le_div_of_nonneg_left hN.le (by positivity) (hPlower q hq)
            _ = _ := by field_simp
        calc
          _ = (N / (P q : ℝ)) * (Int.gcd h ((r * q.1 * q.2 : ℕ) : ℤ) : ℝ) := by
            dsimp only [P]
            push_cast
            ring
          _ ≤ _ := mul_le_mul_of_nonneg_right hinv (Nat.cast_nonneg _)
      exact hd.trans (mul_le_mul
        (mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left (hPη q hq) hK₀.le) hg0)
        (add_le_add hroot hmean) (by positivity) (by positivity))
  have hgcd (q : ℕ × ℕ) (hq : q ∈ F) :
      (∑ h ∈ J, (Int.gcd h ((r * q.1 * q.2 : ℕ) : ℤ) : ℝ)) ≤ 4 * H * D := by
    have hq₁ := (hF q hq).1
    have hq₂ := (hF q hq).2.1
    have hdpos : 0 < r * q.1 * q.2 := by positivity
    have hdP : r * q.1 * q.2 ≤ P q := by
      simpa only [P, Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm] using
        Nat.le_mul_of_pos_right (r * q.1 * q.2) hq₀
    have hdτ := hτ (r * q.1 * q.2) hdpos
      ((Nat.cast_le.mpr hdP).trans (hmod q hq).2.1)
    calc
      _ ≤ 2 * (HN : ℝ) * ((r * q.1 * q.2).divisors.card : ℝ) :=
        sourceSmoothFactor_signed_gcd_sum_le _ HN hdpos J hJnat
      _ ≤ 2 * (2 * H) * D := by gcongr
      _ = _ := by ring
  have hrow (q : ℕ × ℕ) (hq : q ∈ F) :
      ‖∑ n ∈ βℤ.support, βℤ n * star (βℤ (n + ℓ * (r : ℤ))) *
        (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
        ∑ h ∈ J, c q h * sourceTheta r q₀ 1 q.1 q.2 a b₁ b₂ ℓ n h‖ ≤
      K₀ * L * g * D ^ 3 *
        (5 * H * B + 4 * H * N * (q₀ : ℝ) / (R * Q ^ 2) * D) := by
    have heq :
        (∑ n ∈ βℤ.support, βℤ n * star (βℤ (n + ℓ * (r : ℤ))) *
          (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
          ∑ h ∈ J, c q h * sourceTheta r q₀ 1 q.1 q.2 a b₁ b₂ ℓ n h) =
        ((D ^ 2 : ℝ) : ℂ) * ∑ h ∈ J, c q h * S q h := by
      simp_rw [hproduct, Finset.mul_sum]
      rw [Finset.sum_comm]
      apply Finset.sum_congr rfl
      intro h _
      rw [← (hlocal q hq h).1]
      simp only [Finset.mul_sum, mul_assoc, mul_left_comm, mul_comm]
    rw [heq, norm_mul, Complex.norm_real, Real.norm_of_nonneg (sq_nonneg D)]
    calc
      D ^ 2 * ‖∑ h ∈ J, c q h * S q h‖ ≤ D ^ 2 * ∑ h ∈ J,
          L * (K₀ * D * g * (B + (N * (q₀ : ℝ) / (R * Q ^ 2)) *
            (Int.gcd h ((r * q.1 * q.2 : ℕ) : ℤ) : ℝ))) := by
        apply mul_le_mul_of_nonneg_left ?_ (sq_nonneg D)
        apply norm_sum_le_of_le
        intro h hh
        rw [norm_mul]
        exact mul_le_mul (hc q hq h hh) (hlocal q hq h).2 (norm_nonneg _) hL
      _ = K₀ * L * g * D ^ 3 *
          ((J.card : ℝ) * B + (N * (q₀ : ℝ) / (R * Q ^ 2)) *
            ∑ h ∈ J, (Int.gcd h ((r * q.1 * q.2 : ℕ) : ℤ) : ℝ)) := by
        simp only [Finset.sum_add_distrib, ← Finset.mul_sum, Finset.sum_const,
          nsmul_eq_mul]
        ring
      _ ≤ K₀ * L * g * D ^ 3 *
          ((5 * H) * B + (N * (q₀ : ℝ) / (R * Q ^ 2)) * (4 * H * D)) := by
        apply mul_le_mul_of_nonneg_left ?_ (by positivity)
        exact add_le_add (mul_le_mul_of_nonneg_right hJcard hB0)
          (mul_le_mul_of_nonneg_left (hgcd q hq) (by positivity))
      _ = _ := by ring
  have hbracket :
      5 * H * B + 4 * H * N * (q₀ : ℝ) / (R * Q ^ 2) * D ≤
        (320 * C ^ 5 + 8 * C) * N * D * x ^ (-40 * ε) := by
    have hpow : x ^ (-50 * ε) ≤ x ^ (-40 * ε) :=
      Real.rpow_le_rpow_of_exponent_le hxone (by linarith)
    have hfirst : 5 * H * B ≤ 320 * C ^ 5 * N * D * x ^ (-40 * ε) := by
      calc
        5 * H * B ≤ 320 * C ^ 5 * N * x ^ (-50 * ε) := by nlinarith only [hdeep]
        _ ≤ 320 * C ^ 5 * N * x ^ (-40 * ε) :=
          mul_le_mul_of_nonneg_left hpow (by positivity)
        _ ≤ _ := by
          have hh := mul_le_mul_of_nonneg_left hDone
            (show 0 ≤ 320 * C ^ 5 * N * x ^ (-40 * ε) by positivity)
          nlinarith only [hh]
    have hsecond : 4 * H * N * (q₀ : ℝ) / (R * Q ^ 2) * D ≤
        8 * C * N * D * x ^ (-40 * ε) := by
      calc
        _ = (H * N * (q₀ : ℝ) / (R * Q ^ 2)) * (4 * D) := by ring
        _ ≤ (2 * C * N * x ^ (-40 * ε)) * (4 * D) :=
          mul_le_mul_of_nonneg_right hmeanScale (by positivity)
        _ = _ := by ring
    nlinarith only [hfirst, hsecond]
  have hpower : D ^ 4 * x ^ (-40 * ε) ≤ x ^ (-ε / 4) := by
    calc
      D ^ 4 * x ^ (-40 * ε) = x ^ ((ε / 100) * 4 + (-40 * ε)) := by
        dsimp only [D]
        rw [← Real.rpow_mul_natCast hxpos.le, ← Real.rpow_add hxpos]
        simp only [Nat.cast_ofNat]
      _ ≤ _ := Real.rpow_le_rpow_of_exponent_le hxone (by linarith)
  have hrowfinal (q : ℕ × ℕ) (hq : q ∈ F) :
      ‖∑ n ∈ βℤ.support, βℤ n * star (βℤ (n + ℓ * (r : ℤ))) *
        (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
        ∑ h ∈ J, c q h * sourceTheta r q₀ 1 q.1 q.2 a b₁ b₂ ℓ n h‖ ≤
        K₀ * (L + 1) * (320 * C ^ 5 + 8 * C) * g * N * x ^ (-ε / 4) := by
    apply (hrow q hq).trans
    calc
      _ ≤ K₀ * L * g * D ^ 3 *
          ((320 * C ^ 5 + 8 * C) * N * D * x ^ (-40 * ε)) :=
        mul_le_mul_of_nonneg_left hbracket (by positivity)
      _ = (K₀ * L * (320 * C ^ 5 + 8 * C) * g * N) *
          (D ^ 4 * x ^ (-40 * ε)) := by ring
      _ ≤ (K₀ * L * (320 * C ^ 5 + 8 * C) * g * N) * x ^ (-ε / 4) :=
        mul_le_mul_of_nonneg_left hpower (by positivity)
      _ ≤ _ := by gcongr; linarith
  calc
    _ ≤ ∑ _q ∈ F, K₀ * (L + 1) * (320 * C ^ 5 + 8 * C) * g * N * x ^ (-ε / 4) :=
      Finset.sum_le_sum hrowfinal
    _ = (F.card : ℝ) *
        (K₀ * (L + 1) * (320 * C ^ 5 + 8 * C) * g * N * x ^ (-ε / 4)) := by simp
    _ ≤ (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) *
        (K₀ * (L + 1) * (320 * C ^ 5 + 8 * C) * g * N * x ^ (-ε / 4)) :=
      mul_le_mul_of_nonneg_right hFcard (by positivity)
    _ = _ := by dsimp only [K, g]; ring

open Classical in
theorem sourceSmoothFactor_uniform_band
    («ω» δ ε C cM TM cN TN LM : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε) (hεsmall : ε ≤ 1 / 1000)
    (hC : 1 ≤ C) (hcM : 0 < cM) (hMT : cM ≤ TM)
    (hcN : 0 < cN) (hNT : cN ≤ TN) (hLM : 0 ≤ LM) :
    ∃ K X : ℝ, 0 < K ∧ 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ M N R Q H γ : ℝ,
        0 < M → 0 < N → 0 < R → 0 < Q →
        x / C ≤ M * N → N = x ^ γ →
        N ≤ C * x ^ (δ + 6 * ε) * R →
        R ≤ C * x ^ (-2 * ε) * N →
        x ^ (1 / 2 - ε) ≤ C * R * Q →
        R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) →
        1 / 4 + 7 * «ω» + 2 * δ + 100 * ε ≤ γ →
        γ ≤ 1 / 2 + ε →
      ∀ q₀ a b₁ b₂ : ℕ,
        H = x ^ ε * R * Q ^ 2 / ((q₀ : ℝ) * M) → 1 ≤ H →
      ∀ (Y : Set.Ici (1 : ℝ)), (Y : ℝ) ≤ x ^ δ →
      ∀ (𝒜 : Finset (ℕ × ℕ × ℕ × ℕ)) (J : Finset ℤ),
        (∀ t ∈ 𝒜,
          t.2.1 = 1 ∧ 0 < t.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
          Squarefree (t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2) ∧
          R ≤ (t.1 : ℝ) ∧ (t.1 : ℝ) ≤ 2 * R ∧
          Q ≤ (q₀ * t.2.2.1 : ℕ) ∧ (q₀ * t.2.2.1 : ℕ) ≤ 2 * Q ∧
          Q ≤ (q₀ * t.2.2.2 : ℕ) ∧ (q₀ * t.2.2.2 : ℕ) ≤ 2 * Q) →
        (∀ t ∈ 𝒜,
          Nonempty (DenseDivisibilityWitness
            Y 1 (t.1 * q₀ * t.2.2.1)) ∧
          Nonempty (DenseDivisibilityWitness
            Y 1 (t.1 * q₀ * t.2.2.2))) →
        (∀ h ∈ J, h ≠ 0 ∧ |(h : ℝ)| ≤ 2 * H) →
        (∀ t ∈ 𝒜, Nat.Coprime a t.1 ∧
          Nat.Coprime b₁ (q₀ * t.2.2.1) ∧ Nat.Coprime b₂ (q₀ * t.2.2.2)) →
      ∀ (ν : ℕ × ℕ → ℂ),
        (∀ t ∈ 𝒜,
          ‖ν (q₀ * t.2.1 * t.2.2.1, t.1)‖ ≤ 1 ∧
          ‖ν (q₀ * t.2.2.2, t.1)‖ ≤ 1) →
      ∀ (ℓ : ℤ) (ψM : ℝ → ℝ) (ψN : ℝ → ℂ),
        Function.support ψM ⊆ Set.Icc cM TM → (∀ t : ℝ, |ψM t| ≤ LM) →
        ContDiff ℝ 1 ψN → Function.support ψN ⊆ Set.Icc cN TN →
        (∀ t : ℝ, ‖ψN t‖ ≤ x ^ (ε / 100) ∧ ‖deriv ψN t‖ ≤ x ^ (ε / 100)) →
      let β : ℕ →₀ ℂ := positiveCompactProfileSequence ψN TN N 0
      let βℤ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
      let P : (ℕ × ℕ × ℕ × ℕ) → ℕ := fun t =>
        t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2
      (∑ t ∈ 𝒜,
        ‖ν (q₀ * t.2.1 * t.2.2.1, t.1) * star (ν (q₀ * t.2.2.2, t.1)) *
          ((M : ℂ) / (P t : ℂ)) *
            ∑ n ∈ βℤ.support.filter (fun n =>
              Int.gcd n ((t.1 * q₀ * t.2.1 * t.2.2.1 : ℕ) : ℤ) = 1 ∧
              Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2.2 : ℕ) : ℤ) = 1),
              βℤ n * star (βℤ (n + ℓ * (t.1 : ℤ))) *
                (sourceCompatibility t.1 q₀ b₁ b₂ ℓ n : ℂ) *
                  ∑ h ∈ J, sourcePhi ψM M (P t) h *
                    sourceTheta t.1 q₀ t.2.1 t.2.2.1 t.2.2.2 a b₁ b₂ ℓ n h‖) ≤
        K * M * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) / (q₀ : ℝ) * x ^ (-ε / 4) := by
  have hTM : 0 < TM := hcM.trans_le hMT
  have hPhiBound : 0 ≤ TM * LM := mul_nonneg hTM.le hLM
  obtain ⟨K, X, hK, hX, hfiber⟩ := sourceSmoothFactor_fiber_uniform_power_saving
    «ω» δ ε C cN TN (TM * LM) hω hδ hε hεsmall hC hcN hNT hPhiBound
  refine ⟨2 * K, X, mul_pos (by norm_num) hK, hX, ?_⟩
  intro x hx M N R Q H γ hM hN hR hQ hMN hNγ hNR hRN hRQlo hRQ hγlo hγhi
    q₀ a b₁ b₂ hH hHone Y hYx 𝒜 J h𝒜 h𝒜Y hJ hprimitive ν hν ℓ ψM ψN hψMs hψMb
    hψN hψNs hψNb β βℤ P
  have hxone : 1 ≤ x := hX.trans hx
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  by_cases h𝒜empty : 𝒜 = ∅
  · simp only [h𝒜empty, Finset.sum_empty]
    positivity
  obtain ⟨t₀', ht₀'⟩ := Finset.nonempty_iff_ne_empty.mpr h𝒜empty
  have hsf := (h𝒜 t₀' ht₀').2.2.2.2.1
  have hq₀ : 0 < q₀ :=
    Nat.pos_of_ne_zero hsf.of_mul_left.of_mul_left.of_mul_left.of_mul_right.ne_zero
  have hqpos : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀
  have hPhi (d : ℕ) (h : ℤ) : ‖sourcePhi ψM M d h‖ ≤ TM * LM := by
    have hb := sourcePhiRealFactor_sampling_and_norm cM TM M LM hcM hMT hM hLM
      ψM hψMs hψMb d h
    have heq := hb.2.1 1
    simp only [Nat.cast_one, Nat.one_mul] at heq
    simpa only [heq] using hb.2.2 (1 : ℝ)
  let Rs : Finset ℕ := 𝒜.image Prod.fst
  let F : ℕ → Finset (ℕ × ℕ) := fun r =>
    (𝒜.filter (fun t => t.1 = r)).image (fun t => t.2.2)
  let w : ℕ → (ℕ × ℕ) → ℝ := fun r q =>
    ‖∑ n ∈ βℤ.support, βℤ n * star (βℤ (n + ℓ * (r : ℤ))) *
      (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
        ∑ h ∈ J, sourcePhi ψM M (r * q₀ * q.1 * q.2) h *
          sourceTheta r q₀ 1 q.1 q.2 a b₁ b₂ ℓ n h‖
  have hw (r : ℕ) (q : ℕ × ℕ) : 0 ≤ w r q := norm_nonneg _
  have hF (r : ℕ) (q : ℕ × ℕ) (hq : q ∈ F r) :
      0 < q.1 ∧ 0 < q.2 ∧ Squarefree (r * q₀ * q.1 * q.2) ∧
        Q ≤ (q₀ * q.1 : ℕ) ∧ (q₀ * q.1 : ℕ) ≤ 2 * Q ∧
        Q ≤ (q₀ * q.2 : ℕ) ∧ (q₀ * q.2 : ℕ) ≤ 2 * Q := by
    obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hq
    obtain ⟨htA, htr⟩ := Finset.mem_filter.mp ht
    obtain ⟨hu, _, hq₁, hq₂, hsf, _, _, hq₁lo, hq₁hi, hq₂lo, hq₂hi⟩ := h𝒜 t htA
    refine ⟨hq₁, hq₂, ?_, hq₁lo, hq₁hi, hq₂lo, hq₂hi⟩
    simpa only [hu, Nat.mul_one, htr] using hsf
  have hFY (r : ℕ) (q : ℕ × ℕ) (hq : q ∈ F r) :
      Nonempty (DenseDivisibilityWitness Y 1 (r * q₀ * q.1)) ∧
      Nonempty (DenseDivisibilityWitness Y 1 (r * q₀ * q.2)) := by
    obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hq
    obtain ⟨htA, htr⟩ := Finset.mem_filter.mp ht
    simpa only [htr] using h𝒜Y t htA
  have hFprimitive (r : ℕ) (q : ℕ × ℕ) (hq : q ∈ F r) :
      Nat.Coprime b₁ (q₀ * q.1) ∧ Nat.Coprime b₂ (q₀ * q.2) := by
    obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hq
    exact (hprimitive t (Finset.mem_filter.mp ht).1).2
  have hrow (t : ℕ × ℕ × ℕ × ℕ) (ht : t ∈ 𝒜) := by
    obtain ⟨hu, hr, hv, hq₂, _, hRr, _, hQ₁, _, hQ₂, _⟩ := h𝒜 t ht
    have hraw := sourceHighGamma_weighted_row_norm t.1 q₀ t.2.1 t.2.2.1 t.2.2.2
      a b₁ b₂ ℓ M R Q hM hR hQ hr hq₀ (by omega) hv hq₂ hRr
      (by simpa only [hu, Nat.mul_one] using hQ₁) hQ₂
      (ν (q₀ * t.2.1 * t.2.2.1, t.1)) (ν (q₀ * t.2.2.2, t.1))
      (hν t ht).1 (hν t ht).2 βℤ.support J βℤ (fun h => sourcePhi ψM M (P t) h)
    dsimp only at hraw
    conv_rhs at hraw => simp only [P, hu, Nat.mul_one]
    exact hraw
  have hlocal (r : ℕ) (hr : r ∈ Rs) :
      (∑ q ∈ F r, w r q) ≤
        K * Q ^ 2 * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) / (q₀ : ℝ) ^ 2 * x ^ (-ε / 4) := by
    obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hr
    obtain ⟨_, hr, _, _, _, hRr, hrR, _, _, _, _⟩ := h𝒜 t ht
    exact hfiber x hx M N R Q H γ hM hN hR hQ hMN hNγ hNR hRN hRQlo hRQ hγlo hγhi
      t.1 q₀ a b₁ b₂ hr hq₀ hRr hrR hH hHone Y hYx (F t.1) J (hF t.1) (hFY t.1)
      hJ (hprimitive t ht).1 (hFprimitive t.1) ℓ ψN hψN hψNs hψNb
      (fun q h => sourcePhi ψM M (t.1 * q₀ * q.1 * q.2) h)
      (fun _ _ h _ => hPhi _ h)
  have hsumr (r : ℕ) :
      (∑ t ∈ 𝒜.filter (fun t => t.1 = r), w t.1 t.2.2) = ∑ q ∈ F r, w r q := by
    have hinj : Set.InjOn (fun t : ℕ × ℕ × ℕ × ℕ => t.2.2)
        (𝒜.filter (fun t => t.1 = r) : Set _) := by
      intro t ht s hs heq
      obtain ⟨htA, htr⟩ := Finset.mem_filter.mp ht
      obtain ⟨hsA, hsr⟩ := Finset.mem_filter.mp hs
      exact Prod.ext (htr.trans hsr.symm)
        (Prod.ext ((h𝒜 t htA).1.trans (h𝒜 s hsA).1.symm) heq)
    calc
      _ = ∑ t ∈ 𝒜.filter (fun t => t.1 = r), w r t.2.2 := by
        apply Finset.sum_congr rfl
        intro t ht
        rw [(Finset.mem_filter.mp ht).2]
      _ = _ := (Finset.sum_image hinj).symm
  have hRcard : (Rs.card : ℝ) ≤ 2 * R := by
    have hsub : Rs ⊆ Finset.Icc 1 ⌊2 * R⌋₊ := by
      intro r hr
      obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hr
      obtain ⟨_, hr, _, _, _, _, hrR, _, _, _, _⟩ := h𝒜 t ht
      exact Finset.mem_Icc.mpr ⟨hr, (Nat.le_floor_iff (by positivity)).mpr hrR⟩
    have hh : Rs.card ≤ ⌊2 * R⌋₊ := by
      simpa only [Nat.card_Icc, Nat.add_sub_cancel] using Finset.card_le_card hsub
    exact (Nat.cast_le.mpr hh).trans (Nat.floor_le (by positivity))
  have hfamily : (∑ t ∈ 𝒜, w t.1 t.2.2) ≤
      (2 * R) * (K * Q ^ 2 * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) /
        (q₀ : ℝ) ^ 2 * x ^ (-ε / 4)) := by
    calc
      _ = ∑ r ∈ Rs, ∑ t ∈ 𝒜.filter (fun t => t.1 = r), w t.1 t.2.2 :=
        (Finset.sum_fiberwise_of_maps_to (s := 𝒜) (t := Rs) (g := Prod.fst)
          (fun t ht => Finset.mem_image_of_mem Prod.fst ht) _).symm
      _ = ∑ r ∈ Rs, ∑ q ∈ F r, w r q := Finset.sum_congr rfl (fun r _ => hsumr r)
      _ ≤ ∑ _r ∈ Rs,
          K * Q ^ 2 * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) / (q₀ : ℝ) ^ 2 * x ^ (-ε / 4) :=
        Finset.sum_le_sum hlocal
      _ = (Rs.card : ℝ) *
          (K * Q ^ 2 * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) / (q₀ : ℝ) ^ 2 * x ^ (-ε / 4)) := by
        rw [Finset.sum_const, nsmul_eq_mul]
      _ ≤ _ := mul_le_mul_of_nonneg_right hRcard (by positivity)
  calc
    _ ≤ ∑ t ∈ 𝒜, (M * (q₀ : ℝ) / (R * Q ^ 2)) * w t.1 t.2.2 := Finset.sum_le_sum hrow
    _ = (M * (q₀ : ℝ) / (R * Q ^ 2)) * ∑ t ∈ 𝒜, w t.1 t.2.2 := (Finset.mul_sum ..).symm
    _ ≤ (M * (q₀ : ℝ) / (R * Q ^ 2)) *
        ((2 * R) * (K * Q ^ 2 * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) /
          (q₀ : ℝ) ^ 2 * x ^ (-ε / 4))) :=
      mul_le_mul_of_nonneg_left hfamily (by positivity)
    _ = _ := by field_simp [hR.ne', hQ.ne', hqpos.ne']

open Classical in
theorem opening_smooth_o1_scale_resources (C «ω» δ ε : ℝ)
    (hC : 1 ≤ C) (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε)
    (hεsmall : ε ≤ 1 / 1000) (hsmall : ε < δ / 10 ^ 100) :
    ∀ᶠ x : ℝ in Filter.atTop,
      Real.exp 1 ≤ x ∧ 2 ≤ x ∧ C ^ 2 ≤ x ^ (δ / 2 - 7 * ε) ∧
      ∀ M N R Q γ : ℝ,
        0 < M → 0 < N → 0 < R → 0 < Q →
        x / C ≤ M * N → M * N ≤ C * x → N = x ^ γ →
        1 / 4 + 7 * «ω» + 2 * δ + 100 * ε ≤ γ →
        γ ≤ 1 / 2 + ε →
        N ≤ C * x ^ (δ + 4 * ε) * R →
        R ≤ C * x ^ (-2 * ε) * N →
        R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) →
        1 ≤ N ∧ N ≤ x ∧ 1 ≤ M ∧ M ≤ x ^ 2 ∧ R ≤ x ∧ Q ≤ x ∧
          4 * x ^ ε < M := by
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hεquarter : ε < 1 / 4 := hεsmall.trans_lt (by norm_num)
  have hmargin : 0 < δ / 2 - 7 * ε := by
    have hs := (lt_div_iff₀ (by positivity : (0 : ℝ) < 10 ^ 100)).mp hsmall
    have hn : (100 : ℝ) ≤ 10 ^ 100 := by norm_num
    nlinarith only [hs, hn, hε]
  have hCmargin : ∀ᶠ x : ℝ in Filter.atTop,
      C ^ 2 ≤ x ^ (δ / 2 - 7 * ε) :=
    (tendsto_rpow_atTop hmargin).eventually_ge_atTop (C ^ 2)
  have hCquarter : ∀ᶠ x : ℝ in Filter.atTop, C ^ 2 ≤ x ^ (1 / 4 : ℝ) :=
    (tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 4)).eventually_ge_atTop
      (C ^ 2)
  have hCutoff := eventually_scale_dominates_cutoff_of_product_lower
    (1 / C) 1 (1 / 2 + ε) ε 4 (by positivity) (by norm_num) (by norm_num)
    (by linarith only [hεquarter])
  filter_upwards [Filter.eventually_ge_atTop (Real.exp 1),
    Filter.eventually_ge_atTop (2 : ℝ), hCmargin, hCquarter, hCutoff]
    with x hxe hx2 hCmarginAt hCquarterAt hCutoffAt
  refine ⟨hxe, hx2, hCmarginAt, ?_⟩
  intro M N R Q γ hM hN _hR hQ hMNlo hMNhi hNγ hγlo hγhi hNR hRupper hRQ
  have hxone : 1 ≤ x := (by norm_num : (1 : ℝ) ≤ 2).trans hx2
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  have hγlower : 1 / 4 + 7 * «ω» + 2 * δ + 100 * ε ≤ γ := hγlo
  have hγnonneg : 0 ≤ γ := by linarith only [hγlower, hω, hδ, hε]
  have hNupper : N ≤ x ^ (1 / 2 + ε) := by
    rw [hNγ]
    exact Real.rpow_le_rpow_of_exponent_le hxone hγhi
  have hNx : N ≤ x := hNupper.trans (by
    simpa only [Real.rpow_one] using Real.rpow_le_rpow_of_exponent_le hxone
      (show 1 / 2 + ε ≤ 1 by linarith only [hεquarter]))
  have hhalf : x ^ (1 / 2 : ℝ) ≤ x := by
    simpa only [Real.rpow_one] using
      Real.rpow_le_rpow_of_exponent_le hxone (by norm_num : (1 / 2 : ℝ) ≤ 1)
  have hNone : 1 ≤ N := by
    rw [hNγ]
    exact Real.one_le_rpow hxone hγnonneg
  have hCpow : C ≤ C ^ 2 := by
    simpa only [mul_one, pow_two] using mul_le_mul_of_nonneg_left hC hCpos.le
  have hCquarterBound : C ≤ x ^ (1 / 4 : ℝ) := hCpow.trans hCquarterAt
  have hChalf : C ≤ x ^ (1 / 2 : ℝ) := hCquarterBound.trans
    (Real.rpow_le_rpow_of_exponent_le hxone (by norm_num : (1 / 4 : ℝ) ≤ 1 / 2))
  have hCx : C ≤ x := hChalf.trans hhalf
  have hMcut : 4 * x ^ ε < M := hCutoffAt M N hN
    (by simpa only [one_mul] using hNupper)
    (by simpa only [one_div, div_eq_mul_inv, mul_comm, mul_one] using hMNlo)
  have hMone : 1 ≤ M := by
    have hxeone : 1 ≤ x ^ ε := Real.one_le_rpow hxone hε.le
    linarith only [hMcut, hxeone]
  have hMupper : M ≤ x ^ 2 := by
    calc
      M ≤ M * N := le_mul_of_one_le_right hM.le hNone
      _ ≤ C * x := hMNhi
      _ ≤ x * x := mul_le_mul_of_nonneg_right hCx hxpos.le
      _ = x ^ 2 := (pow_two x).symm
  have hRsmall : R ≤ x := by
    calc
      R ≤ C * x ^ (-2 * ε) * N := hRupper
      _ ≤ C * x ^ (-2 * ε) * x ^ (1 / 2 + ε) :=
        mul_le_mul_of_nonneg_left hNupper
          (mul_nonneg hCpos.le (Real.rpow_nonneg hxpos.le _))
      _ = C * x ^ (1 / 2 - ε) := by
        rw [mul_assoc, ← Real.rpow_add hxpos]
        congr 2
        ring
      _ ≤ x ^ (1 / 2 : ℝ) * x ^ (1 / 2 : ℝ) :=
        mul_le_mul hChalf
          (Real.rpow_le_rpow_of_exponent_le hxone (by linarith only [hε]))
          (Real.rpow_nonneg hxpos.le _) (Real.rpow_nonneg hxpos.le _)
      _ = x := by rw [← Real.rpow_add hxpos]; norm_num
  have hQN : Q * N ≤ C ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε) := by
    calc
      Q * N ≤ Q * (C * x ^ (δ + 4 * ε) * R) :=
        mul_le_mul_of_nonneg_left hNR hQ.le
      _ = (C * x ^ (δ + 4 * ε)) * (R * Q) := by ring
      _ ≤ (C * x ^ (δ + 4 * ε)) * (C * x ^ (1 / 2 + 2 * «ω» + ε)) :=
        mul_le_mul_of_nonneg_left hRQ (by positivity)
      _ = C ^ 2 * (x ^ (δ + 4 * ε) * x ^ (1 / 2 + 2 * «ω» + ε)) := by ring
      _ = C ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε) := by
        rw [← Real.rpow_add hxpos,
          show δ + 4 * ε + (1 / 2 + 2 * «ω» + ε) =
            1 / 2 + 2 * «ω» + δ + 5 * ε by ring]
  have hQsmall : Q ≤ x := by
    have hpower : 1 / 2 + 2 * «ω» + δ + 5 * ε - γ ≤ 1 / 4 := by
      linarith only [hγlower, hω, hδ, hε]
    calc
      Q ≤ (C ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε)) / N :=
        (le_div_iff₀ hN).mpr hQN
      _ = C ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε - γ) := by
        rw [hNγ, mul_div_assoc, ← Real.rpow_sub hxpos]
      _ ≤ C ^ 2 * x ^ (1 / 4 : ℝ) := mul_le_mul_of_nonneg_left
        (Real.rpow_le_rpow_of_exponent_le hxone hpower) (sq_nonneg C)
      _ ≤ x ^ (1 / 4 : ℝ) * x ^ (1 / 4 : ℝ) :=
        mul_le_mul_of_nonneg_right hCquarterAt (Real.rpow_nonneg hxpos.le _)
      _ = x ^ (1 / 2 : ℝ) := by rw [← Real.rpow_add hxpos]; norm_num
      _ ≤ x := hhalf
  exact ⟨hNone, hNx, hMone, hMupper, hRsmall, hQsmall, hMcut⟩

open Classical in
theorem opening_smooth_o1_diagonal
    (d : ℕ) («ω» δ ε K T Bβ L Eβ Eψ A : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε)
    (hK : 1 ≤ K) (hT : 0 < T) (hBβ : 0 ≤ Bβ) (hL : 0 ≤ L)
    (hA : 0 ≤ A) :
    ∀ᶠ x : ℝ in Filter.atTop,
      ∀ (γ M Q R : ℝ) (N : ℕ),
        1 / 4 + 7 * «ω» + 2 * δ + 100 * ε ≤ γ →
        γ ≤ 1 / 2 + ε →
        0 < M → 0 < Q → 0 < R →
        x / K ≤ M * x ^ γ → M * x ^ γ ≤ K * x →
        x ^ (-δ - 4 * ε) * x ^ γ / K ≤ R →
        R ≤ K * x ^ (-2 * ε) * x ^ γ →
        R * Q ≤ K * x ^ (1 / 2 + 2 * «ω» + ε) →
        (N : ℝ) ≤ K * x ^ γ →
        ∀ (S : Finset (ℕ × ℕ)) (β : ℕ →₀ ℂ) (c : ℕ × ℕ → ℂ),
          β.support ⊆ Finset.Icc 1 N →
          (∀ n ∈ β.support,
            ‖β n‖ ≤ Bβ * (n.divisors.card : ℝ) ^ d * (Real.log x) ^ Eβ) →
          (∀ p ∈ S, ‖c p‖ ≤ 1) →
          (∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Nat.Coprime p.1 p.2 ∧
            Q ≤ (p.1 : ℝ) ∧ (p.1 : ℝ) ≤ 2 * Q ∧
            R ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ 2 * R) →
          ∀ (a b₁ b₂ : ℕ) (ψ : ℝ → ℝ),
            (∀ t : ℝ, |ψ t| ≤ L * (Real.log x) ^ Eψ) →
            let sm : Finset ℕ := Finset.Icc 1 ⌊T * M⌋₊
            let w : ℕ → ℝ := fun n => ψ ((n : ℝ) / M)
            (∑ r ∈ S.image Prod.snd,
              ∑ p₁ ∈ S.filter (fun p => p.2 = r),
                ∑ p₂ ∈ S.filter (fun p => p.2 = r),
                  ‖c p₁ * star (c p₂) *
                    (∑ n ∈ β.support, β n * star (β n) *
                      (mixedFiberMass sm w p₁.1 p₂.1 r a b₁ b₂ n n : ℂ))‖) ≤
              M * (x ^ γ) ^ 2 / R * (Real.log x) ^ (-A) := by
  have hKpos : 0 < K := zero_lt_one.trans_le hK
  obtain ⟨C, hC, hfinite⟩ := mixedFiberMass_diagonal_family_subpower_majorant d ε hε
  let F : ℝ := T * K ^ 2
  let H : ℝ := 24 * F + 8 * K ^ 3
  let D : ℝ := C * Bβ ^ 2 * L * F ^ ε * H
  let E : ℝ := 2 * Eβ + Eψ + 4
  have hF : 0 < F := by dsimp [F]; positivity
  have hsmall : ∀ᶠ x : ℝ in Filter.atTop,
      ‖D * K ^ 2 * (Real.log x) ^ (E + A)‖ ≤ ‖x ^ ε‖ :=
    ((isLittleO_log_rpow_rpow_atTop (E + A) hε).const_mul_left
      (D * K ^ 2)).eventuallyLE
  have hlarge : ∀ᶠ x : ℝ in Filter.atTop, 2 * K ^ 2 ≤ x ^ ((1 : ℝ) / 2) :=
    (tendsto_rpow_atTop one_half_pos).eventually_ge_atTop _
  filter_upwards [hsmall, hlarge, Filter.eventually_ge_atTop (Real.exp 1)]
    with x hxsmall hxlarge hx
  intro γ M Q R N hγlower hγupper hM hQ hR hMNlower hMNupper hRlower hRupper hRQ hN
    S β c hsupport hβ hc hS a b₁ b₂ ψ hψ sm w
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
  have hxone : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hx
  have hlogone : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hx
  have hlog : 0 ≤ Real.log x := zero_le_one.trans hlogone
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlogone
  have hdecay : 0 ≤ (Real.log x) ^ (-A) := by
    rw [Real.rpow_neg hlog]
    exact inv_nonneg.mpr (zero_le_one.trans (Real.one_le_rpow hlogone hA))
  have hxγ : 0 < x ^ γ := Real.rpow_pos_of_pos hxpos γ
  let U : ℕ := ⌊2 * Q⌋₊
  let V : ℕ := ⌊2 * R⌋₊
  let X : ℕ := ⌊T * M⌋₊ * N
  have hUcap : (U : ℝ) ≤ 2 * Q := Nat.floor_le (by positivity)
  have hVcap : (V : ℝ) ≤ 2 * R := Nat.floor_le (by positivity)
  have hX : (X : ℝ) ≤ F * x := by
    calc
      _ = (⌊T * M⌋₊ : ℝ) * (N : ℝ) := Nat.cast_mul _ _
      _ ≤ (T * M) * (K * x ^ γ) :=
        mul_le_mul (Nat.floor_le (by positivity)) hN
          (Nat.cast_nonneg N) (mul_nonneg hT.le hM.le)
      _ = T * K * (M * x ^ γ) := by ring
      _ ≤ T * K * (K * x) :=
        mul_le_mul_of_nonneg_left hMNupper (mul_nonneg hT.le hKpos.le)
      _ = F * x := by dsimp [F]; ring
  have hQbound : Q ≤ K ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε - γ) := by
    calc
      _ ≤ (K * x ^ (1 / 2 + 2 * «ω» + ε)) /
          (x ^ (-δ - 4 * ε) * x ^ γ / K) := by
        apply (le_div_iff₀ (by positivity)).mpr
        simpa only [mul_comm] using
          (mul_le_mul_of_nonneg_right hRlower hQ.le).trans hRQ
      _ = K ^ 2 *
          (x ^ (1 / 2 + 2 * «ω» + ε) / (x ^ (-δ - 4 * ε) * x ^ γ)) := by
        rw [div_div_eq_mul_div]
        ring
      _ = K ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε - γ) := by
        rw [← Real.rpow_add hxpos, ← Real.rpow_sub hxpos]
        congr 2
        ring
  have hQhalf : Q ≤ K ^ 2 * x ^ ((1 : ℝ) / 2) :=
    hQbound.trans (mul_le_mul_of_nonneg_left
      (Real.rpow_le_rpow_of_exponent_le hxone
        (by linarith only [hγlower, hω, hδ, hε])) (sq_nonneg K))
  have hRhalf : R ≤ K ^ 2 * x ^ ((1 : ℝ) / 2) := by
    calc
      _ ≤ K * x ^ (-2 * ε) * x ^ γ := hRupper
      _ = K * x ^ (γ - 2 * ε) := by
        rw [mul_assoc, ← Real.rpow_add hxpos]
        congr 2
        ring
      _ ≤ K * x ^ ((1 : ℝ) / 2) :=
        mul_le_mul_of_nonneg_left
          (Real.rpow_le_rpow_of_exponent_le hxone
            (by linarith only [hγupper, hε])) hKpos.le
      _ ≤ K ^ 2 * x ^ ((1 : ℝ) / 2) :=
        mul_le_mul_of_nonneg_right (le_self_pow₀ hK two_ne_zero)
          (Real.rpow_nonneg hxpos.le _)
  have hcap (u : ℝ) (hu : u ≤ K ^ 2 * x ^ ((1 : ℝ) / 2)) : 2 * u ≤ x := by
    calc
      _ ≤ 2 * (K ^ 2 * x ^ ((1 : ℝ) / 2)) :=
        mul_le_mul_of_nonneg_left hu zero_le_two
      _ = (2 * K ^ 2) * x ^ ((1 : ℝ) / 2) := by ring
      _ ≤ x ^ ((1 : ℝ) / 2) * x ^ ((1 : ℝ) / 2) :=
        mul_le_mul_of_nonneg_right hxlarge (Real.rpow_nonneg hxpos.le _)
      _ = x := by rw [← Real.rpow_add hxpos]; norm_num
  have hU : (U : ℝ) ≤ x := hUcap.trans (hcap Q hQhalf)
  have hV : (V : ℝ) ≤ x := hVcap.trans (hcap R hRhalf)
  have hlogcap (n : ℕ) (hn : (n : ℝ) ≤ x) : Real.log (n : ℝ) ≤ Real.log x := by
    by_cases hn0 : n = 0
    · simpa only [hn0, Nat.cast_zero, Real.log_zero] using hlog
    · exact Real.log_le_log (Nat.cast_pos.mpr (Nat.pos_of_ne_zero hn0)) hn
  have hu : 1 + Real.log (U : ℝ) ≤ 2 * Real.log x := by
    linarith [hlogcap U hU]
  have hv : 1 + Real.log (V : ℝ) ≤ 2 * Real.log x := by
    linarith [hlogcap V hV]
  have hu₃ : 2 + Real.log (U : ℝ) ≤ 3 * Real.log x := by
    linarith [hlogcap U hU]
  have hlogs :
      (1 + Real.log (V : ℝ)) * (1 + Real.log (U : ℝ)) ^ 2 *
        (2 + Real.log (U : ℝ)) ≤ 24 * (Real.log x) ^ 4 := by
    calc
      _ ≤ (2 * Real.log x) * (2 * Real.log x) ^ 2 * (3 * Real.log x) :=
        mul_le_mul
          (mul_le_mul hv (pow_le_pow_left₀ (by positivity) hu 2)
            (sq_nonneg _) (by positivity))
          hu₃ (by positivity) (by positivity)
      _ = _ := by ring
  have hendpoint : (V : ℝ) * (U : ℝ) ^ 2 ≤ 8 * K ^ 3 * x := by
    calc
      _ ≤ (2 * R) * (2 * Q) ^ 2 :=
        mul_le_mul hVcap (pow_le_pow_left₀ (Nat.cast_nonneg U) hUcap 2)
          (sq_nonneg _) (by positivity)
      _ = 8 * (R * Q) * Q := by ring
      _ ≤ 8 * (K * x ^ (1 / 2 + 2 * «ω» + ε)) *
          (K ^ 2 * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε - γ)) :=
        mul_le_mul (mul_le_mul_of_nonneg_left hRQ (by norm_num)) hQbound
          hQ.le (by positivity)
      _ = 8 * K ^ 3 *
          (x ^ (1 / 2 + 2 * «ω» + ε) * x ^ (1 / 2 + 2 * «ω» + δ + 5 * ε - γ)) := by
        ring
      _ = 8 * K ^ 3 * x ^ (1 + 4 * «ω» + δ + 6 * ε - γ) := by
        rw [← Real.rpow_add hxpos]
        congr 2
        ring
      _ ≤ 8 * K ^ 3 * x := by
        apply mul_le_mul_of_nonneg_left _ (by positivity)
        simpa only [Real.rpow_one] using
          Real.rpow_le_rpow_of_exponent_le hxone
            (show 1 + 4 * «ω» + δ + 6 * ε - γ ≤ 1 by
              linarith only [hγlower, hω, hδ, hε])
  have hcount :
      (X : ℝ) * (1 + Real.log (V : ℝ)) * (1 + Real.log (U : ℝ)) ^ 2 *
        (2 + Real.log (U : ℝ)) + (V : ℝ) * (U : ℝ) ^ 2 ≤
          H * x * (Real.log x) ^ 4 := by
    calc
      _ = (X : ℝ) * ((1 + Real.log (V : ℝ)) * (1 + Real.log (U : ℝ)) ^ 2 *
          (2 + Real.log (U : ℝ))) + (V : ℝ) * (U : ℝ) ^ 2 := by ring
      _ ≤ (F * x) * (24 * (Real.log x) ^ 4) + 8 * K ^ 3 * x :=
        add_le_add (mul_le_mul hX hlogs (by positivity) (by positivity)) hendpoint
      _ ≤ (F * x) * (24 * (Real.log x) ^ 4) +
          (8 * K ^ 3 * x) * (Real.log x) ^ 4 :=
        add_le_add le_rfl (le_mul_of_one_le_right (by positivity : 0 ≤ 8 * K ^ 3 * x)
          (one_le_pow₀ hlogone))
      _ = H * x * (Real.log x) ^ 4 := by dsimp [H]; ring
  have hXp : (X : ℝ) ^ ε ≤ F ^ ε * x ^ ε :=
    (Real.rpow_le_rpow (Nat.cast_nonneg X) hX hε.le).trans_eq
      (Real.mul_rpow hF.le hxpos.le)
  have hscale :
      x ^ (1 + 2 * ε) / K ^ 2 ≤ M * (x ^ γ) ^ 2 / R := by
    calc
      _ = (x / K * x ^ γ) / (K * x ^ (-2 * ε) * x ^ γ) := by
        calc
          _ = (1 / K ^ 2) * (x ^ ((1 : ℝ) - (-2 * ε))) := by
            rw [neg_mul, sub_neg_eq_add]
            ring
          _ = (x / K) / (K * x ^ (-2 * ε)) := by
            rw [Real.rpow_sub hxpos, Real.rpow_one]
            ring
          _ = _ := (mul_div_mul_right _ _ hxγ.ne').symm
      _ ≤ (M * x ^ γ * x ^ γ) / R :=
        div_le_div₀ (by positivity)
          (mul_le_mul_of_nonneg_right hMNlower hxγ.le) hR hRupper
      _ = _ := by ring
  have hfinite' := hfinite S sm w β c ⌊T * M⌋₊ N U V
    (Bβ * (Real.log x) ^ Eβ) (L * (Real.log x) ^ Eψ)
    (by positivity) (by positivity) Finset.Subset.rfl hsupport
    (fun n hn => by simpa only [mul_right_comm] using hβ n hn)
    (fun n _ => hψ ((n : ℝ) / M)) hc
    (fun p hp => by
      rcases hS p hp with ⟨hp₁, hp₂, _, _, hpQ, _, hpR⟩
      exact ⟨hp₁, Nat.le_floor hpQ, hp₂, Nat.le_floor hpR⟩)
    (fun p hp => (hS p hp).2.2.1) a b₁ b₂
  have hlogpower :
      ((Real.log x) ^ Eβ) ^ 2 * (Real.log x) ^ Eψ * (Real.log x) ^ 4 =
        (Real.log x) ^ E := by
    rw [← Real.rpow_mul_natCast hlog, ← Real.rpow_natCast,
      ← Real.rpow_add hlogpos, ← Real.rpow_add hlogpos]
    congr 1
    norm_num [E, mul_comm]
  have henvelope :
      C * (Bβ * (Real.log x) ^ Eβ) ^ 2 * (L * (Real.log x) ^ Eψ) *
        (X : ℝ) ^ ε *
        ((X : ℝ) * (1 + Real.log (V : ℝ)) * (1 + Real.log (U : ℝ)) ^ 2 *
          (2 + Real.log (U : ℝ)) + (V : ℝ) * (U : ℝ) ^ 2) ≤
        D * x ^ (1 + ε) * (Real.log x) ^ E := by
    calc
      _ ≤ C * (Bβ * (Real.log x) ^ Eβ) ^ 2 * (L * (Real.log x) ^ Eψ) *
          (F ^ ε * x ^ ε) * (H * x * (Real.log x) ^ 4) :=
        mul_le_mul (mul_le_mul_of_nonneg_left hXp (by positivity)) hcount
          (by positivity) (by positivity)
      _ = (C * Bβ ^ 2 * L * F ^ ε * H) * (x * x ^ ε) *
          (((Real.log x) ^ Eβ) ^ 2 * (Real.log x) ^ Eψ * (Real.log x) ^ 4) := by
        ring
      _ = D * x ^ (1 + ε) * (Real.log x) ^ E := by
        rw [hlogpower, Real.rpow_add hxpos, Real.rpow_one]
  have hsmall' : D * K ^ 2 * (Real.log x) ^ (E + A) ≤ x ^ ε :=
    (Real.le_norm_self _).trans
      (hxsmall.trans_eq (Real.norm_of_nonneg (Real.rpow_nonneg hxpos.le ε)))
  have hlogcancel : (Real.log x) ^ (E + A) * (Real.log x) ^ (-A) =
      (Real.log x) ^ E := by
    rw [← Real.rpow_add hlogpos, add_neg_cancel_right]
  have hscalar : D * (Real.log x) ^ E ≤
      (x ^ ε / K ^ 2) * (Real.log x) ^ (-A) := by
    calc
      _ = (D * K ^ 2 * (Real.log x) ^ (E + A)) / K ^ 2 *
          (Real.log x) ^ (-A) := by
        rw [mul_right_comm D (K ^ 2), mul_div_cancel_right₀ _ (pow_ne_zero 2 hKpos.ne'),
          mul_assoc D ((Real.log x) ^ (E + A)), hlogcancel]
      _ ≤ _ :=
        mul_le_mul_of_nonneg_right
          (div_le_div_of_nonneg_right hsmall' (sq_nonneg K))
          hdecay
  calc
    _ ≤ C * (Bβ * (Real.log x) ^ Eβ) ^ 2 * (L * (Real.log x) ^ Eψ) *
        (X : ℝ) ^ ε *
        ((X : ℝ) * (1 + Real.log (V : ℝ)) * (1 + Real.log (U : ℝ)) ^ 2 *
          (2 + Real.log (U : ℝ)) + (V : ℝ) * (U : ℝ) ^ 2) := hfinite'
    _ ≤ D * x ^ (1 + ε) * (Real.log x) ^ E := henvelope
    _ = x ^ (1 + ε) * (D * (Real.log x) ^ E) := by ring
    _ ≤ x ^ (1 + ε) * ((x ^ ε / K ^ 2) * (Real.log x) ^ (-A)) :=
      mul_le_mul_of_nonneg_left hscalar (Real.rpow_nonneg hxpos.le _)
    _ = (x ^ (1 + 2 * ε) / K ^ 2) * (Real.log x) ^ (-A) := by
      calc
        _ = (x ^ (1 + ε) * x ^ ε) / K ^ 2 * (Real.log x) ^ (-A) := by ring
        _ = _ := by
          rw [← Real.rpow_add hxpos, two_mul, add_assoc]
    _ ≤ _ := mul_le_mul_of_nonneg_right hscale hdecay

theorem sourceDeltaZero_rough_dyadic_smoothFactor_uniform_log_saving
    («ω» δ ε C cM TM cN TN : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε)
    (hεsmall : ε ≤ 1 / 1000) (hsmall : ε < δ / 10 ^ 100)
    (hC : 1 ≤ C) (hcM : 0 < cM) (hMT : cM ≤ TM)
    (hcN : 0 < cN) (hNT : cN ≤ TN)
    (dα : ℕ) (Eα Eβ A η : ℝ) (hA : 0 < A) (hη : 0 < η) :
    ∃ X₀ : ℝ, Real.exp 1 ≤ X₀ ∧
      ∀ (x : ℝ), X₀ ≤ x →
      ∀ (M N R Q γ : ℝ),
      0 < M → 0 < N → 0 < R → 0 < Q →
      x / C ≤ M * N → M * N ≤ C * x → N = x ^ γ →
      1 / 4 + 7 * «ω» + 2 * δ + 100 * ε ≤ γ →
      γ ≤ 1 / 2 + ε →
      N ≤ C * x ^ (δ + 4 * ε) * R →
      R ≤ C * x ^ (-2 * ε) * N →
      x ^ (1 / 2 - ε) ≤ C * R * Q →
      R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) →
      ∀ (α : ℕ →₀ ℂ),
      (∀ n ∈ α.support,
        cM * M ≤ (n : ℝ) ∧ (n : ℝ) ≤ TM * M ∧
        ‖α n‖ ≤ C * (n.divisors.card : ℝ) ^ dα * (Real.log x) ^ Eα) →
      ∀ (ψN : ℝ → ℂ), ContDiff ℝ 1 ψN →
      Function.support ψN ⊆ Set.Icc cN TN →
      (∀ t : ℝ, ‖ψN t‖ ≤ C * (Real.log x) ^ Eβ ∧
        ‖deriv ψN t‖ ≤ C * (Real.log x) ^ Eβ) →
      let β : ℕ →₀ ℂ := positiveCompactProfileSequence ψN TN N 0
      ∀ (S : Finset (ℕ × ℕ)),
      (∀ p ∈ S,
        0 < p.1 ∧ 0 < p.2 ∧ Squarefree (p.1 * p.2) ∧
        Q ≤ (p.1 : ℝ) ∧ (p.1 : ℝ) ≤ 2 * Q ∧
        R ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ 2 * R ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩
            1 (p.1 * p.2)) ∧
        (∀ t ∈ p.1.primeFactors,
          Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (t : ℝ))) →
      ∀ (a b₁ b₂ : ℕ),
      (∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2)) →
      (∑ p ∈ S,
        ‖deltaZero (finiteConvolution α β) p.1 p.2 a b₁ b₂‖) ≤
          η * (M * N) * (Real.log x) ^ (-A)
:= by
  classical
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hTMpos : 0 < TM := hcM.trans_le hMT
  have hTNpos : 0 < TN := hcN.trans_le hNT
  have hεone : ε ≤ 1 := hεsmall.trans (by norm_num)
  obtain ⟨ψM, hψM, hsM, hMnonneg, hMmajor, hMderivatives⟩ := opening_majorant cM TM hcM hMT
  choose CM hCM hCMbound using hMderivatives
  let C₀ : ℝ := 4 * (C + TM + TN + 1)
  have hC₀four : 4 ≤ C₀ := by dsimp only [C₀]; nlinarith
  have hC₀ : 1 ≤ C₀ := by linarith
  have hC₀pos : 0 < C₀ := zero_lt_one.trans_le hC₀
  have hCC₀ : C ≤ C₀ := by dsimp only [C₀]; nlinarith
  have hTN₀ : 2 * TN ≤ C₀ := by dsimp only [C₀]; nlinarith
  have hMinterval : cM / 2 ≤ 2 * TM := by linarith
  obtain ⟨Kband, Xband, hKband, _, hBandAt⟩ :=
    sourceSmoothFactor_uniform_band «ω» δ ε C₀ (cM / 2) (2 * TM) cN TN (CM 0)
      hω hδ hε hεsmall hC₀ (by positivity) hMinterval hcN hNT (hCM 0)
  have hMbound : ∀ t : ℝ, |ψM t| ≤ CM 0 := by
    intro t
    simpa only [iteratedDeriv_zero, Real.norm_eq_abs] using hCMbound 0 t
  have hBetaAt : ∀ᶠ x : ℝ in Filter.atTop,
      C * (Real.log x) ^ Eβ ≤ x ^ (ε / 100) := by
    filter_upwards [((isLittleO_log_rpow_rpow_atTop Eβ
      (div_pos hε (by norm_num : (0 : ℝ) < 100))).const_mul_left C).eventuallyLE,
      Filter.eventually_ge_atTop (0 : ℝ)] with x hx hx0
    exact (le_abs_self _).trans (by
      simpa only [Real.norm_eq_abs, abs_of_nonneg (Real.rpow_nonneg hx0 _)] using hx)
  obtain ⟨Kα, Fα, hKα, hMomentAt⟩ := opening_moment dα Eα C TM hCpos.le hTMpos
  let D : ℝ := 2 * A + |Fα| + 2
  have hD : 0 < D := by dsimp only [D]; positivity
  let k : ℕ := Nat.ceil ((1 + ((2 * 0 + 5 : ℕ) : ℝ) * 2 + 2) / ε)
  let Ltail : ℝ := max (CM 0) (CM (k + 2))
  have hLtail : 0 ≤ Ltail := (hCM 0).trans (le_max_left _ _)
  have hTailAt := (opening_padded_truncation 0 Eβ 2 C ε 1
    (by norm_num) hCpos.le hε (by norm_num)).2
      (cM / 2) (2 * TM) Ltail 0 (by positivity) hMinterval hLtail
  let Lzero : ℝ := max (CM 0) (max (CM 1) (CM 2))
  have hLzero : 0 ≤ Lzero := (hCM 0).trans (le_max_left _ _)
  have hZeroAt := opening_zero_mode 0 Eβ C TN (2 * TM) Lzero ε D
    hCpos hTNpos (by positivity) hLzero hε ψM (hψM.of_le (by simp))
    (hsM.trans (Set.Icc_subset_Icc_left (by linarith))) (by
      intro t
      refine ⟨(by simpa only [iteratedDeriv_zero, Real.norm_eq_abs] using
        (hCMbound 0 t).trans (le_max_left _ _)), ?_, ?_⟩
      · simpa only [iteratedDeriv_one, Real.norm_eq_abs] using
          (hCMbound 1 t).trans ((le_max_left _ _).trans (le_max_right _ _))
      · simpa only [iteratedDeriv_succ, iteratedDeriv_one, iteratedDeriv_zero,
          Real.norm_eq_abs] using
          (hCMbound 2 t).trans ((le_max_right _ _).trans (le_max_right _ _)))
  have hDiagonalAt := opening_smooth_o1_diagonal 0 «ω» δ ε C₀
    (2 * TM) C (CM 0) Eβ 0 D hω hδ hε hC₀ (by positivity) hCpos.le (hCM 0) hD.le
  let Bcount : ℝ := 2 + 4 / Real.log 2
  have hBcount : 0 < Bcount := by
    dsimp only [Bcount]
    have : 0 < Real.log 2 := Real.log_pos (by norm_num)
    positivity
  let Koff : ℝ := 36 * Kband * Bcount ^ 2 * (2 * TN)
  have hKoff : 0 < Koff := by dsimp only [Koff]; positivity
  have hLogAbsorb (K E ρ : ℝ) (hρ : 0 < ρ) :
      ∀ᶠ x : ℝ in Filter.atTop, K * (Real.log x) ^ E ≤ x ^ ρ := by
    clear * - hρ
    filter_upwards [((isLittleO_log_rpow_rpow_atTop E hρ).const_mul_left K).eventuallyLE,
      Filter.eventually_ge_atTop (0 : ℝ)] with x hx hx0
    exact (le_abs_self _).trans (by
      simpa only [Real.norm_eq_abs, abs_of_nonneg (Real.rpow_nonneg hx0 ρ)] using hx)
  have hmain : ∀ᶠ x : ℝ in Filter.atTop,
      ∀ (M N R Q γ : ℝ), 0 < M → 0 < N → 0 < R → 0 < Q →
      x / C ≤ M * N → M * N ≤ C * x → N = x ^ γ →
      1 / 4 + 7 * «ω» + 2 * δ + 100 * ε ≤ γ →
      γ ≤ 1 / 2 + ε →
      N ≤ C * x ^ (δ + 4 * ε) * R → R ≤ C * x ^ (-2 * ε) * N →
      x ^ (1 / 2 - ε) ≤ C * R * Q → R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) →
      ∀ (α : ℕ →₀ ℂ),
      (∀ n ∈ α.support, cM * M ≤ (n : ℝ) ∧ (n : ℝ) ≤ TM * M ∧
        ‖α n‖ ≤ C * (n.divisors.card : ℝ) ^ dα * (Real.log x) ^ Eα) →
      ∀ (ψN : ℝ → ℂ), ContDiff ℝ 1 ψN →
      Function.support ψN ⊆ Set.Icc cN TN →
      (∀ t : ℝ, ‖ψN t‖ ≤ C * (Real.log x) ^ Eβ ∧
        ‖deriv ψN t‖ ≤ C * (Real.log x) ^ Eβ) →
      let β : ℕ →₀ ℂ := positiveCompactProfileSequence ψN TN N 0
      ∀ (S : Finset (ℕ × ℕ)),
      (∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Squarefree (p.1 * p.2) ∧
        Q ≤ (p.1 : ℝ) ∧ (p.1 : ℝ) ≤ 2 * Q ∧
        R ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ 2 * R ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩
            1 (p.1 * p.2)) ∧
        (∀ t ∈ p.1.primeFactors,
          Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (t : ℝ))) →
      ∀ (a b₁ b₂ : ℕ), (∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2)) →
      (∑ p ∈ S, ‖deltaZero (finiteConvolution α β) p.1 p.2 a b₁ b₂‖) ≤
        η * (M * N) * (Real.log x) ^ (-A) := by
    filter_upwards [opening_smooth_o1_scale_resources C₀ «ω» δ ε
      hC₀ hω hδ hε hεsmall hsmall,
      hMomentAt, hBetaAt, hZeroAt, hDiagonalAt, hTailAt,
      hLogAbsorb Koff (4 + D) (ε / 4) (by positivity),
      hLogAbsorb 1 D 1 zero_lt_one,
      Filter.eventually_ge_atTop Xband,
      Filter.eventually_ge_atTop (max (C₀ ^ 2) (max (2 * TN)
        (Real.exp (max 1 (26 * Kα / η ^ 2)))))]
      with x hscales hmomentAt hbetaAt hzeroAt hdiagonalAt htailAt hoffAbsorb
        htailAbsorb hxband hxlarge
    obtain ⟨hxexp, hxtwo, _, hscaleAt⟩ := hscales
    have hx1 : 1 ≤ x := (by norm_num : (1 : ℝ) ≤ 2).trans hxtwo
    have hx0 : 0 < x := zero_lt_one.trans_le hx1
    have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hxexp
    have hlog0 : 0 < Real.log x := zero_lt_one.trans_le hlog1
    have hC₀square : C₀ ^ 2 ≤ x := (le_max_left _ _).trans hxlarge
    have hTNx : 2 * TN ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans hxlarge)
    intro M N R Q γ hM hN hR hQ hMNlo hMNhi hNγ hγlo hγhi hNR hRhi hRQlo hRQhi
      α hα ψN hψN hsN hψNbounds β S hS a b₁ b₂ hprim
    have hβsample (n : ℕ) : β n = ψN ((n : ℝ) / N) :=
      positiveCompactProfileSequence_apply cN TN N hcN hN ψN hsN n
    have hβ : ∀ n ∈ β.support,
        cN * N ≤ (n : ℝ) ∧ (n : ℝ) ≤ TN * N ∧
        ‖β n‖ ≤ C * (n.divisors.card : ℝ) ^ (0 : ℕ) * (Real.log x) ^ Eβ := by
      intro n hn
      have hne : β n ≠ 0 := Finsupp.mem_support_iff.mp hn
      have hne' : ψN ((n : ℝ) / N) ≠ 0 := by
        rw [← hβsample n]
        exact hne
      have hmem := hsN hne'
      refine ⟨(le_div_iff₀ hN).mp hmem.1, (div_le_iff₀ hN).mp hmem.2, ?_⟩
      simpa only [hβsample n, pow_zero, mul_one] using (hψNbounds ((n : ℝ) / N)).1
    have hMNlo₀ : x / C₀ ≤ M * N :=
      (div_le_div_of_nonneg_left hx0.le hCpos hCC₀).trans hMNlo
    have hMNhi₀ : M * N ≤ C₀ * x := hMNhi.trans
      (mul_le_mul_of_nonneg_right hCC₀ hx0.le)
    have hNR₀ : N ≤ C₀ * x ^ (δ + 4 * ε) * R := hNR.trans
      (mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_right hCC₀ (Real.rpow_nonneg hx0.le _)) hR.le)
    have hRhi₀ : R ≤ C₀ * x ^ (-2 * ε) * N := hRhi.trans
      (mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_right hCC₀ (Real.rpow_nonneg hx0.le _)) hN.le)
    have hRQlo₀ : x ^ (1 / 2 - ε) ≤ C₀ * R * Q := hRQlo.trans
      (mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_right hCC₀ hR.le) hQ.le)
    have hRQhi₀ : R * Q ≤ C₀ * x ^ (1 / 2 + 2 * «ω» + ε) := hRQhi.trans
      (mul_le_mul_of_nonneg_right hCC₀ (Real.rpow_nonneg hx0.le _))
    obtain ⟨hNone, hNx, hMone, hMx, hRx, hQx, hMshort⟩ :=
      hscaleAt M N R Q γ hM hN hR hQ hMNlo₀ hMNhi₀ hNγ hγlo hγhi hNR₀ hRhi₀ hRQhi₀
    have hSsimple : ∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Squarefree (p.1 * p.2) := by
      intro p hp
      exact ⟨(hS p hp).1, (hS p hp).2.1, (hS p hp).2.2.1⟩
    have hScoprime : ∀ p ∈ S, Nat.Coprime p.1 p.2 :=
      fun p hp => Nat.coprime_of_squarefree_mul (hSsimple p hp).2.2
    have hβpos (n : ℕ) (hn : n ∈ β.support) : 0 < n := by
      exact_mod_cast (mul_pos hcN hN).trans_le (hβ n hn).1
    have hαpos (n : ℕ) (hn : n ∈ α.support) : 0 < n := by
      exact_mod_cast (mul_pos hcM hM).trans_le (hα n hn).1
    let NI : ℕ := ⌊TN * N⌋₊
    have hβsupport : β.support ⊆ Finset.Icc 1 NI := fun n hn =>
      Finset.mem_Icc.mpr ⟨hβpos n hn, Nat.le_floor (hβ n hn).2.1⟩
    have hNI : (NI : ℝ) ≤ TN * N := Nat.floor_le (by positivity)
    have hNIx : (NI : ℝ) ≤ x ^ (2 : ℝ) := by
      rw [Real.rpow_two]
      calc
        (NI : ℝ) ≤ TN * N := hNI
        _ ≤ x * x := mul_le_mul (by linarith only [hTNx, hTNpos]) hNx hN.le hx0.le
        _ = x ^ 2 := (pow_two x).symm
    have hNIscale : (NI : ℝ) ≤ C₀ * N := hNI.trans
      (mul_le_mul_of_nonneg_right (by linarith only [hTN₀, hTNpos]) hN.le)
    let sm : Finset ℕ := Finset.Icc 1 ⌊(2 * TM) * M⌋₊
    let w : ℕ → ℝ := fun n => ψM ((n : ℝ) / M)
    have hsm : α.support ⊆ sm := by
      intro n hn
      refine Finset.mem_Icc.mpr ⟨hαpos n hn, Nat.le_floor ?_⟩
      exact (hα n hn).2.1.trans (by nlinarith only [hTMpos, hM])
    have hw0 : ∀ n ∈ sm, 0 ≤ w n := fun n _ => hMnonneg _
    have hw1 : ∀ n ∈ α.support, 1 ≤ w n := by
      intro n hn
      exact hMmajor _ ⟨(le_div_iff₀ hM).mpr (hα n hn).1,
        (div_le_iff₀ hM).mpr (hα n hn).2.1⟩
    have hαmoment := hmomentAt M hM hMx α (fun n hn =>
      ⟨hαpos n hn, (hα n hn).2.1, (hα n hn).2.2⟩)
    let H : ℕ → ℝ := fun g => x ^ ε * R * Q ^ 2 / ((g : ℝ) * M)
    let Y : Set.Ici (1 : ℝ) :=
      ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩
    let u : ℕ → ℕ → ℕ := fun _ _ => 1
    let shells : ℕ → ℕ := fun g => if H g < 1 then 0 else Nat.log 2 ⌊H g⌋₊ + 1
    let J : ℕ → Finset ℤ := fun g =>
      (Finset.Ioo (-((2 : ℤ) ^ shells g)) ((2 : ℤ) ^ shells g)).erase 0
    have hu : ∀ p₁ ∈ S, ∀ p₂ ∈ S, p₁.2 = p₂.2 →
        let g := Nat.gcd p₁.1 p₂.1
        0 < u g (p₁.1 / g) ∧ u g (p₁.1 / g) ∣ p₁.1 / g := by
      intro p₁ _ p₂ _ _ g
      exact ⟨Nat.zero_lt_one, one_dvd _⟩
    let Ω : Finset ((ℕ × ℕ) × (ℕ × ℕ)) :=
      (S ×ˢ S).filter (fun p => p.1.2 = p.2.2)
    let G : Finset ℕ := Ω.image (fun p => Nat.gcd p.1.1 p.2.1)
    let 𝒜 : ℕ → Finset (ℕ × ℕ × ℕ × ℕ) := fun g =>
      (Ω.filter (fun p => Nat.gcd p.1.1 p.2.1 = g)).image (fun p =>
        (p.1.2, u g (p.1.1 / g), (p.1.1 / g) / u g (p.1.1 / g), p.2.1 / g))
    let γβ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
    let L : ℕ → Finset ℤ := fun r =>
      ((γβ.support ×ˢ γβ.support).filter
        (fun p => p.1 ≠ p.2 ∧ Int.ModEq (r : ℤ) p.1 p.2)).image
          (fun p => (p.2 - p.1) / (r : ℤ))
    let LI : ℕ := ⌊(2 * TN) * N / R⌋₊
    let Lall : Finset ℤ := (Finset.Icc (-(LI : ℤ)) (LI : ℤ)).erase 0
    let bins : ℕ → Finset ℕ := fun g => (𝒜 g).image (fun t => Nat.log 2 t.2.1)
    let block : ℕ → ℤ → ℕ → Finset (ℕ × ℕ × ℕ × ℕ) := fun g ℓ i =>
      (𝒜 g).filter (fun t => ℓ ∈ L t.1 ∧ Nat.log 2 t.2.1 = i)
    have hfactor := mixedFourier_offDiagonal_gcd_shift_factorization
      sm w S β (fun _ => 0) a b₁ b₂ J u hSsimple hprim hu
    have hGdata (g : ℕ) (hg : g ∈ G) :
        0 < g ∧ Squarefree g ∧ (g : ℝ) ≤ 2 * Q ∧
        Nat.Coprime (a * b₁ * b₂) g ∧
        ∀ p ∈ g.primeFactors,
          Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (p : ℝ) := by
      obtain ⟨p, hpΩ, hpg⟩ := Finset.mem_image.mp hg
      obtain ⟨hp₁, _⟩ := Finset.mem_product.mp (Finset.mem_filter.mp hpΩ).1
      obtain ⟨hq, _, hsf, _, hqhi, _, _, _, hrough⟩ := hS p.1 hp₁
      have hgdvd : g ∣ p.1.1 := by
        rw [← hpg]
        exact Nat.gcd_dvd_left _ _
      have hgpos : 0 < g := by
        rw [← hpg]
        exact Nat.gcd_pos_of_pos_left _ hq
      have hgle : (g : ℝ) ≤ (p.1.1 : ℝ) := by
        exact_mod_cast Nat.le_of_dvd hq hgdvd
      refine ⟨hgpos, hsf.of_mul_left.squarefree_of_dvd hgdvd, hgle.trans hqhi,
        (hprim p.1 hp₁).of_dvd_right (dvd_mul_of_dvd_left hgdvd p.1.2), ?_⟩
      intro t ht
      exact hrough t (Nat.primeFactors_mono hgdvd hq.ne' ht)
    have hLall : ∀ r ∈ S.image Prod.snd, L r ⊆ Lall := by
      intro r hr ℓ hℓ
      have hℓne : ℓ ≠ 0 := (hfactor.2.1 r hr ℓ hℓ).1
      have hsupport0 : β.support ⊆ Finset.Icc 0 (0 + NI) := by
        intro n hn
        exact Finset.mem_Icc.mpr
          ⟨Nat.zero_le n, by simpa only [zero_add] using (Finset.mem_Icc.mp (hβsupport hn)).2⟩
      have hnat : ℓ.natAbs * r ≤ NI := hfactor.2.2.1 0 NI hsupport0 r hr ℓ hℓ
      have hRr : R ≤ (r : ℝ) := by
        obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hr
        obtain ⟨_, _, _, _, _, hrlow, _, _, _⟩ := hS p hp
        exact hrlow
      have hreal : (ℓ.natAbs : ℝ) * (r : ℝ) ≤ (NI : ℝ) := by exact_mod_cast hnat
      have hratio : (ℓ.natAbs : ℝ) ≤ (2 * TN) * N / R := by
        apply (le_div_iff₀ hR).2
        calc
          (ℓ.natAbs : ℝ) * R ≤ (ℓ.natAbs : ℝ) * (r : ℝ) :=
            mul_le_mul_of_nonneg_left hRr (Nat.cast_nonneg _)
          _ ≤ (NI : ℝ) := hreal
          _ ≤ TN * N := hNI
          _ ≤ (2 * TN) * N :=
            mul_le_mul_of_nonneg_right (by linarith only [hTNpos]) hN.le
      have hℓLI : ℓ.natAbs ≤ LI := Nat.le_floor hratio
      have hℓabs : |ℓ| ≤ (LI : ℤ) := by
        have hh : (ℓ.natAbs : ℤ) ≤ (LI : ℤ) := by exact_mod_cast hℓLI
        simpa only [Int.natCast_natAbs] using hh
      exact Finset.mem_erase.mpr ⟨hℓne, Finset.mem_Icc.mpr (abs_le.mp hℓabs)⟩
    have hBins (g : ℕ) (hg : g ∈ G) :
        ((bins g).card : ℝ) ≤ Bcount * Real.log x := by
      have hgpos := (hGdata g hg).1
      have hQsquare : 2 * Q ≤ x ^ 2 :=
        (opening_frequency_cutoff_power_bounds x ε M R Q g hxtwo hεone hMone
          hR.le hQ.le hRx hQx hgpos).2
      have hsubset : bins g ⊆ Finset.range (⌊2 * Real.log x / Real.log 2⌋₊ + 1) := by
        intro i hi
        obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hi
        obtain ⟨_, huPos, _, _, htS, _, _, _, _, _⟩ := (hfactor.1 g hg).2 t ht
        have hqPos : 0 < g * t.2.1 * t.2.2.1 := (hSsimple _ htS).1
        have huDvd : t.2.1 ∣ g * t.2.1 * t.2.2.1 :=
          dvd_mul_of_dvd_left (dvd_mul_left t.2.1 g) t.2.2.1
        have huUpper : (t.2.1 : ℝ) ≤ x ^ 2 := by
          calc
            (t.2.1 : ℝ) ≤ ((g * t.2.1 * t.2.2.1 : ℕ) : ℝ) := by
              exact_mod_cast Nat.le_of_dvd hqPos huDvd
            _ ≤ 2 * Q := by
              obtain ⟨_, _, _, _, hqhi, _, _, _, _⟩ := hS _ htS
              exact hqhi
            _ ≤ x ^ 2 := hQsquare
        simpa only [Nat.log2_eq_log_two] using
          (opening_selected_dyadic_log_budget x hx1 t.2.1 huPos huUpper).1
      have hcard : ((bins g).card : ℝ) ≤
          ((Finset.range (⌊2 * Real.log x / Real.log 2⌋₊ + 1)).card : ℝ) := by
        exact_mod_cast Finset.card_le_card hsubset
      have hbudget := (opening_selected_dyadic_log_budget x hx1 1 (by decide)
        (by simpa only [Nat.cast_one] using
          (show (1 : ℝ) ≤ x ^ 2 from by nlinarith only [hxtwo]))).2
      have hlog2 : 0 < Real.log 2 := Real.log_pos (by norm_num)
      have hnonneg : 0 ≤ (2 / Real.log 2) * Real.log x := by positivity
      calc
        ((bins g).card : ℝ) ≤ 2 * Real.log x / Real.log 2 + 1 := hcard.trans hbudget
        _ = (2 / Real.log 2) * Real.log x + 1 := by ring
        _ ≤ (2 / Real.log 2) * Real.log x + Real.log x := add_le_add_right hlog1 _
        _ ≤ 2 * ((2 / Real.log 2) * Real.log x + Real.log x) := by
          linarith only [hnonneg, hlog0.le]
        _ = Bcount * Real.log x := by dsimp only [Bcount]; ring
    have hShells (g : ℕ) (hg : g ∈ G) : (shells g : ℝ) ≤ Bcount * Real.log x := by
      have hupper := (opening_frequency_cutoff_power_bounds x ε M R Q g
        hxtwo hεone hMone hR.le hQ.le
        hRx hQx (hGdata g hg).1).1
      have hupperReal : H g ≤ x ^ (4 : ℝ) := by
        simpa only [H, Real.rpow_ofNat] using hupper
      simpa only [shells, Bcount] using opening_padded_count x (H g) hxexp hupperReal
    let Ebase : ℝ := M * N ^ 2 / R * (Real.log x) ^ (-D)
    have hEbase : 0 ≤ Ebase := by dsimp only [Ebase]; positivity
    have hSwitch (q : ℕ) (hq : Nat.Coprime (a * b₁ * b₂) q)
        (b : ℕ) (hb : b ∈ ({b₁, b₂} : Finset ℕ))
        (b' : ℕ) (hb' : b' ∈ ({b₁, b₂} : Finset ℕ)) :
        Nat.Coprime (a * b * b') q := by
      have ha : Nat.Coprime a q := hq.coprime_mul_right.coprime_mul_right
      have h₁ : Nat.Coprime b₁ q := hq.coprime_mul_right.coprime_mul_left
      have h₂ : Nat.Coprime b₂ q := hq.coprime_mul_left
      have hside (z : ℕ) (hz : z ∈ ({b₁, b₂} : Finset ℕ)) : Nat.Coprime z q := by
        simp only [Finset.mem_insert, Finset.mem_singleton] at hz
        rcases hz with rfl | rfl
        · exact h₁
        · exact h₂
      exact (ha.mul_left (hside b hb)).mul_left (hside b' hb')
    have hOffDiagonalBound (c : ℕ × ℕ → ℂ)
        (hc : ∀ p ∈ S, ‖c p‖ ≤ 1)
        (b : ℕ) (hb : b ∈ ({b₁, b₂} : Finset ℕ))
        (b' : ℕ) (hb' : b' ∈ ({b₁, b₂} : Finset ℕ)) :
        ‖∑ r ∈ S.image Prod.snd,
          ∑ p₁ ∈ S.filter (fun p => p.2 = r),
            ∑ p₂ ∈ S.filter (fun p => p.2 = r),
              c p₁ * star (c p₂) *
                ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                  if n₁ = n₂ then 0 else
                    β n₁ * star (β n₂) *
                      ∑ h ∈ J (Nat.gcd p₁.1 p₂.1),
                        mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b b' n₁ n₂
                          ((h : ZMod (r * Nat.lcm p₁.1 p₂.1)).val)‖ ≤ Ebase := by
      clear htailAt hzeroAt hdiagonalAt hαmoment
      have hprimSides : ∀ p ∈ S, Nat.Coprime (a * b * b') (p.1 * p.2) :=
        fun p hp => hSwitch _ (hprim p hp) b hb b' hb'
      let F : ℕ → ℤ → Finset (ℕ × ℕ × ℕ × ℕ) → Finset ℤ → ℂ :=
        fun g ℓ B J' =>
          ∑ t ∈ B,
            c (g * t.2.1 * t.2.2.1, t.1) * star (c (g * t.2.2.2, t.1)) *
              ((M : ℂ) / ((t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2 : ℕ) : ℂ)) *
                ∑ n ∈ γβ.support.filter (fun n =>
                  Int.gcd n ((t.1 * g * t.2.1 * t.2.2.1 : ℕ) : ℤ) = 1 ∧
                  Int.gcd (n + ℓ * (t.1 : ℤ)) ((g * t.2.2.2 : ℕ) : ℤ) = 1),
                  γβ n * star (γβ (n + ℓ * (t.1 : ℤ))) *
                    (sourceCompatibility t.1 g b b' ℓ n : ℂ) *
                      ∑ h ∈ J', sourcePhi ψM M
                        (t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2) h *
                          sourceTheta t.1 g t.2.1 t.2.2.1 t.2.2.2 a b b' ℓ n h
      let Jpos : ℕ → Finset ℤ := fun j =>
        Finset.Ico ((2 : ℤ) ^ j) ((2 : ℤ) ^ (j + 1))
      let Jneg : ℕ → Finset ℤ := fun j =>
        Finset.Ioc (-((2 : ℤ) ^ (j + 1))) (-((2 : ℤ) ^ j))
      let Fband : ℕ → ℤ → ℕ → ℕ → Bool → ℂ := fun g ℓ i j side =>
        F g ℓ (block g ℓ i) (if side then Jneg j else Jpos j)
      have hPoint : ∀ g ∈ G, ∀ ℓ ∈ (Finset.Icc (-(LI : ℤ)) (LI : ℤ)).erase 0,
          ∀ i ∈ bins g, ∀ j ∈ Finset.range (shells g), ∀ side : Bool,
            ‖Fband g ℓ i j side‖ ≤
              Kband * M * N * (Int.gcd (g : ℤ) ℓ : ℝ) / (g : ℝ) *
                x ^ (-ε / 4) := by
        intro g hg ℓ _hℓ i _hi j hj side
        by_cases hempty : block g ℓ i = ∅
        · simp only [Fband, F, hempty, Finset.sum_empty, norm_zero]
          positivity
        have hHone : 1 ≤ H g := by
          by_contra hbad
          have hsmallH : H g < 1 := lt_of_not_ge hbad
          simp [shells, hsmallH] at hj
        have hPhase : ∀ t ∈ block g ℓ i,
            ‖c (g * t.2.1 * t.2.2.1, t.1)‖ ≤ 1 ∧
            ‖c (g * t.2.2.2, t.1)‖ ≤ 1 := by
          intro t ht
          obtain ⟨_, _, _, _, hp₁, hp₂, _, _, _, _⟩ :=
            (hfactor.1 g hg).2 t (Finset.mem_filter.mp ht).1
          exact ⟨hc _ hp₁, hc _ hp₂⟩
        have hunit (t : ℕ × ℕ × ℕ × ℕ) (ht : t ∈ block g ℓ i) : t.2.1 = 1 := by
          have htA : t ∈ 𝒜 g := (Finset.mem_filter.mp ht).1
          obtain ⟨p, _, rfl⟩ := Finset.mem_image.mp htA
          rfl
        have hPrimitive : ∀ t ∈ block g ℓ i,
            Nat.Coprime a t.1 ∧ Nat.Coprime b (g * t.2.2.1) ∧
              Nat.Coprime b' (g * t.2.2.2) := by
          intro t ht
          obtain ⟨_, _, _, _, hp₁, hp₂, _, _, _, _⟩ :=
            (hfactor.1 g hg).2 t (Finset.mem_filter.mp ht).1
          have h₁ := hprimSides _ hp₁
          have h₂ := hprimSides _ hp₂
          refine ⟨h₁.coprime_mul_right.coprime_mul_right.of_dvd_right
            (dvd_mul_left _ _), ?_, ?_⟩
          · simpa only [hunit t ht, Nat.mul_one] using
              h₁.coprime_mul_right.coprime_mul_left.of_dvd_right (dvd_mul_right _ _)
          · exact h₂.coprime_mul_left.of_dvd_right (dvd_mul_right _ _)
        have hψNsmall : ∀ t : ℝ,
            ‖ψN t‖ ≤ x ^ (ε / 100) ∧ ‖deriv ψN t‖ ≤ x ^ (ε / 100) :=
          fun t => ⟨(hψNbounds t).1.trans hbetaAt, (hψNbounds t).2.trans hbetaAt⟩
        have hjShell : j ∈ Finset.range (Nat.log 2 ⌊H g⌋₊ + 1) := by
          simpa only [shells, ite_eq_right (not_lt_of_ge hHone)] using hj
        have hShellWindow : 1 ≤ (2 : ℝ) ^ j ∧ (2 : ℝ) ^ j ≤ H g :=
          (padded_dyadic_cutoff_bounds (H g) hHone).2.2.2.2.2.2 j hjShell
        have hShellUpper : (2 : ℝ) ^ (j + 1) ≤ 2 * H g := by
          calc
            (2 : ℝ) ^ (j + 1) = 2 * (2 : ℝ) ^ j := by rw [pow_succ, mul_comm]
            _ ≤ 2 * H g := mul_le_mul_of_nonneg_left hShellWindow.2 zero_le_two
        have hJband : ∀ h ∈ (if side then Jneg j else Jpos j),
            h ≠ 0 ∧ |(h : ℝ)| ≤ 2 * H g := by
          intro h hh
          cases side with
          | false =>
            change h ∈ Finset.Ico ((2 : ℤ) ^ j) ((2 : ℤ) ^ (j + 1)) at hh
            have hmem := Finset.mem_Ico.mp hh
            have hpos : 0 < h := (pow_pos (by norm_num : (0 : ℤ) < 2) j).trans_le hmem.1
            refine ⟨ne_of_gt hpos, ?_⟩
            have hreal : (h : ℝ) < (2 : ℝ) ^ (j + 1) := by exact_mod_cast hmem.2
            have hrealpos : 0 ≤ (h : ℝ) := by exact_mod_cast hpos.le
            rw [abs_of_nonneg hrealpos]
            exact hreal.le.trans hShellUpper
          | true =>
            change h ∈ Finset.Ioc (-((2 : ℤ) ^ (j + 1))) (-((2 : ℤ) ^ j)) at hh
            have hmem := Finset.mem_Ioc.mp hh
            have hneg : h < 0 := hmem.2.trans_lt
              (neg_lt_zero.mpr (pow_pos (by norm_num : (0 : ℤ) < 2) j))
            refine ⟨ne_of_lt hneg, ?_⟩
            have hreal : -((2 : ℝ) ^ (j + 1)) < (h : ℝ) := by exact_mod_cast hmem.1
            have hrealneg : (h : ℝ) ≤ 0 := by exact_mod_cast hneg.le
            rw [abs_of_nonpos hrealneg]
            exact (show -(h : ℝ) ≤ (2 : ℝ) ^ (j + 1) by linarith only [hreal]).trans
              hShellUpper
        have hFamily : ∀ t ∈ block g ℓ i,
            t.2.1 = 1 ∧ 0 < t.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
            Squarefree (t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2) ∧
            R ≤ (t.1 : ℝ) ∧ (t.1 : ℝ) ≤ 2 * R ∧
            Q ≤ ((g * t.2.2.1 : ℕ) : ℝ) ∧
            ((g * t.2.2.1 : ℕ) : ℝ) ≤ 2 * Q ∧
            Q ≤ ((g * t.2.2.2 : ℕ) : ℝ) ∧
            ((g * t.2.2.2 : ℕ) : ℝ) ≤ 2 * Q := by
          intro t ht
          have htA : t ∈ 𝒜 g := (Finset.mem_filter.mp ht).1
          obtain ⟨hrt, _, htv, htq, htS₁, htS₂, _, _, hsf, _⟩ :=
            (hfactor.1 g hg).2 t htA
          obtain ⟨_, _, _, hq₁lo, hq₁hi, hrlo, hrhi, _, _⟩ := hS _ htS₁
          obtain ⟨_, _, _, hq₂lo, hq₂hi, _, _, _, _⟩ := hS _ htS₂
          refine ⟨hunit t ht, hrt, htv, htq, hsf, hrlo, hrhi, ?_, ?_, hq₂lo, hq₂hi⟩
          · simpa only [hunit t ht, Nat.mul_one] using hq₁lo
          · simpa only [hunit t ht, Nat.mul_one] using hq₁hi
        have hDense : ∀ t ∈ block g ℓ i,
            Nonempty (DenseDivisibilityWitness
              Y 1 (t.1 * g * t.2.2.1)) ∧
            Nonempty (DenseDivisibilityWitness
              Y 1 (t.1 * g * t.2.2.2)) := by
          intro t ht
          obtain ⟨_, _, _, _, htS₁, htS₂, _, _, _, _⟩ :=
            (hfactor.1 g hg).2 t (Finset.mem_filter.mp ht).1
          obtain ⟨_, _, _, _, _, _, _, hd₁, _⟩ := hS _ htS₁
          obtain ⟨_, _, _, _, _, _, _, hd₂, _⟩ := hS _ htS₂
          constructor
          · simpa only [hunit t ht, Nat.mul_one, Nat.mul_assoc,
              Nat.mul_left_comm, Nat.mul_comm] using hd₁
          · simpa only [Nat.mul_assoc, Nat.mul_left_comm, Nat.mul_comm] using hd₂
        have hYbound : (Y : ℝ) ≤ x ^ δ :=
          max_le (Real.one_le_rpow hx1 hδ.le) le_rfl
        have hNRsix : N ≤ C₀ * x ^ (δ + 6 * ε) * R := hNR₀.trans
          (mul_le_mul_of_nonneg_right
            (mul_le_mul_of_nonneg_left
              (Real.rpow_le_rpow_of_exponent_le hx1 (by linarith only [hε]))
              hC₀pos.le) hR.le)
        have hraw := hBandAt x hxband M N R Q (H g) γ hM hN hR hQ
          hMNlo₀ hNγ hNRsix hRhi₀ hRQlo₀ hRQhi₀ hγlo hγhi
          g a b b' rfl hHone Y hYbound
          (block g ℓ i) (if side then Jneg j else Jpos j)
          hFamily hDense hJband hPrimitive c hPhase ℓ ψM ψN
          hsM hMbound hψN hsN hψNsmall
        dsimp only at hraw
        dsimp only [Fband, F]
        exact (norm_sum_le _ _).trans hraw
      have htwoQ : 2 * Q ≤ x ^ 2 := by
        calc
          2 * Q ≤ 2 * x := mul_le_mul_of_nonneg_left hQx (by norm_num)
          _ ≤ x * x := mul_le_mul_of_nonneg_right hxtwo hx0.le
          _ = x ^ 2 := (pow_two x).symm
      have hQI : (⌊2 * Q⌋₊ : ℝ) ≤ x ^ 2 :=
        (Nat.floor_le (by positivity : 0 ≤ 2 * Q)).trans htwoQ
      have hGI : ∀ g ∈ G, 0 < g ∧ g ≤ ⌊2 * Q⌋₊ :=
        fun g hg => ⟨(hGdata g hg).1, Nat.le_floor (hGdata g hg).2.2.1⟩
      have hLI : (LI : ℝ) ≤ (2 * TN) * N / R := Nat.floor_le (by positivity)
      have hsum := opening_summed_bands x (ε / 6) Kband Bcount (2 * TN) M N R
        hxexp hKband.le hBcount.le (by positivity) hM.le hN.le hR
        G ⌊2 * Q⌋₊ LI bins shells Fband hGI hQI hLI hBins hShells (by
          simpa only [show -3 * (ε / 6) / 2 = -ε / 4 by ring] using hPoint)
      have hsplit := opening_off_diagonal_split (cM / 2) (2 * TM) M
        (by positivity) hMinterval hM ψM hsM S β c a b b' shells u
        hSsimple hprimSides hu Lall hLall
      have hLogProduct :
          (Real.log x) ^ (4 + D) * (Real.log x) ^ (-D) = (Real.log x) ^ 4 := by
        rw [← Real.rpow_add hlog0, show (4 + D) + (-D) = (4 : ℝ) by ring]
        norm_num
      have hXProduct : x ^ (ε / 4) * x ^ (-ε / 4) = 1 := by
        rw [← Real.rpow_add hx0, show ε / 4 + (-ε / 4) = 0 by ring,
          Real.rpow_zero]
      have hOffScalar :
          Koff * (Real.log x) ^ 4 * x ^ (-ε / 4) ≤ (Real.log x) ^ (-D) := by
        calc
          _ = (Koff * (Real.log x) ^ (4 + D)) *
              ((Real.log x) ^ (-D) * x ^ (-ε / 4)) := by
            calc
              _ = Koff * ((Real.log x) ^ (4 + D) * (Real.log x) ^ (-D)) *
                  x ^ (-ε / 4) := by rw [hLogProduct]
              _ = _ := by ring
          _ ≤ x ^ (ε / 4) *
              ((Real.log x) ^ (-D) * x ^ (-ε / 4)) :=
            mul_le_mul_of_nonneg_right hoffAbsorb (by positivity)
          _ = (Real.log x) ^ (-D) := by
            calc
              _ = (Real.log x) ^ (-D) *
                  (x ^ (ε / 4) * x ^ (-ε / 4)) := by ring
              _ = _ := by rw [hXProduct, mul_one]
      calc
        _ ≤ ∑ g ∈ G, ∑ ℓ ∈ Lall, ∑ i ∈ bins g, ∑ j ∈ Finset.range (shells g),
            (‖F g ℓ (block g ℓ i) (Jpos j)‖ +
              ‖F g ℓ (block g ℓ i) (Jneg j)‖) := hsplit
        _ ≤ 36 * Kband * Bcount ^ 2 * (2 * TN) * (M * N ^ 2 / R) *
            (Real.log x) ^ 4 * x ^ (-ε / 4) := by
          simpa only [Fband, Bool.false_eq_true, ↓reduceIte,
            show -3 * (ε / 6) / 2 = -ε / 4 by ring] using hsum
        _ = (M * N ^ 2 / R) *
            (Koff * (Real.log x) ^ 4 * x ^ (-ε / 4)) := by
          dsimp only [Koff]
          ring
        _ ≤ (M * N ^ 2 / R) * (Real.log x) ^ (-D) :=
          mul_le_mul_of_nonneg_left hOffScalar (by positivity)
        _ = Ebase := rfl
    clear hBandAt hfactor hGdata hLall hBins hShells hu
    have hbaseOne : 1 ≤ M * N ^ 2 / R := by
      have hRsmall : R ≤ C₀ * N := hRhi₀.trans (by
        have hpow := Real.rpow_le_one_of_one_le_of_nonpos hx1
          (show -2 * ε ≤ 0 by linarith only [hε])
        simpa only [mul_one] using mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left hpow hC₀pos.le) hN.le)
      have hMNbig : C₀ ≤ M * N := by
        calc
          C₀ = C₀ ^ 2 / C₀ := by field_simp
          _ ≤ x / C₀ := div_le_div_of_nonneg_right hC₀square hC₀pos.le
          _ ≤ M * N := hMNlo₀
      apply (le_div_iff₀ hR).mpr
      calc
        1 * R = R := one_mul R
        _ ≤ C₀ * N := hRsmall
        _ ≤ (M * N) * N := mul_le_mul_of_nonneg_right hMNbig hN.le
        _ = M * N ^ 2 := by ring
    have hTailSmall : x ^ (-1 : ℝ) ≤ Ebase := by
      have hlogpower : (Real.log x) ^ D ≤ x := by
        simpa only [one_mul, Real.rpow_one] using htailAbsorb
      have hinv := inv_anti₀ (Real.rpow_pos_of_pos hlog0 D) hlogpower
      calc
        x ^ (-1 : ℝ) ≤ (Real.log x) ^ (-D) := by
          simpa only [Real.rpow_neg_one, Real.rpow_neg hlog0.le] using hinv
        _ ≤ M * N ^ 2 / R * (Real.log x) ^ (-D) :=
          le_mul_of_one_le_left (Real.rpow_nonneg hlog0.le _) hbaseOne
    have hRlower : x ^ (-δ - 4 * ε) * N / C₀ ≤ R := by
      calc
        x ^ (-δ - 4 * ε) * N / C₀ = N / (C₀ * x ^ (δ + 4 * ε)) := by
          rw [show -δ - 4 * ε = -(δ + 4 * ε) by ring, Real.rpow_neg hx0.le]
          ring_nf
        _ ≤ R := (div_le_iff₀ (mul_pos hC₀pos (Real.rpow_pos_of_pos hx0 _))).mpr
          (by simpa only [mul_comm, mul_left_comm, mul_assoc] using hNR₀)
    have hScales : ∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Nat.Coprime p.1 p.2 ∧
        Q ≤ (p.1 : ℝ) ∧ (p.1 : ℝ) ≤ 2 * Q ∧
        R ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ 2 * R ∧
        (p.1 : ℝ) ≤ x ^ (2 : ℝ) ∧ (p.2 : ℝ) ≤ x ^ (2 : ℝ) := by
      intro p hp
      obtain ⟨hq, hr, _, hqlo, hqhi, hrlo, hrhi, _, _⟩ := hS p hp
      have hQ2 : 2 * Q ≤ x ^ 2 := by nlinarith only [hQx, hxtwo]
      have hR2 : 2 * R ≤ x ^ 2 := by nlinarith only [hRx, hxtwo]
      exact ⟨hq, hr, hScoprime p hp, hqlo, hqhi, hrlo, hrhi,
        by simpa only [Real.rpow_two] using hqhi.trans hQ2,
        by simpa only [Real.rpow_two] using hrhi.trans hR2⟩
    have hEnergy : ∀ c : ℕ × ℕ → ℂ, (∀ p ∈ S, ‖c p‖ = 1) →
        dispersionEnergy sm w S β c a b₁ b₂ ≤ 13 * Ebase := by
      intro c hc
      have hc' : ∀ p ∈ S, ‖c p‖ ≤ 1 := fun p hp => (hc p hp).le
      let Dcorr : ℕ → ℕ → ℂ := fun b b' =>
        ∑ r ∈ S.image Prod.snd,
          ∑ p₁ ∈ S.filter (fun p => p.2 = r),
            ∑ p₂ ∈ S.filter (fun p => p.2 = r),
              c p₁ * star (c p₂) *
                ∑ n ∈ β.support, β n * star (β n) *
                  (mixedFiberMass sm w p₁.1 p₂.1 r a b b' n n : ℂ)
      let Ocorr : ℕ → ℕ → ℂ := fun b b' =>
        ∑ r ∈ S.image Prod.snd,
          ∑ p₁ ∈ S.filter (fun p => p.2 = r),
            ∑ p₂ ∈ S.filter (fun p => p.2 = r),
              c p₁ * star (c p₂) *
                ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                  if n₁ = n₂ then 0 else β n₁ * star (β n₂) *
                    ∑ h ∈ J (Nat.gcd p₁.1 p₂.1),
                      mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b b' n₁ n₂
                        ((h : ZMod (r * Nat.lcm p₁.1 p₂.1)).val)
      apply opening_four_energy sm w S β c a b₁ b₂ Ebase Dcorr Ocorr
      · intro b hb b' hb'
        have hprimitive : ∀ p ∈ S, Nat.Coprime (a * b * b') (p.1 * p.2) :=
          fun p hp => hSwitch _ (hprim p hp) b hb b' hb'
        have htail := htailAt S β c NI M Q R hM hQ hR hβsupport hNIx
          (fun n hn => (hβ n hn).2.2) hc' hScales a b b' hprimitive ψM hψM hsM
          (by
            intro t
            simp only [Real.rpow_zero, mul_one]
            exact ⟨by simpa only [iteratedDeriv_zero] using
              (hCMbound 0 t).trans (le_max_left _ _),
              (hCMbound (k + 2) t).trans (le_max_right _ _)⟩) hMshort
        let V : ℕ → ℕ → ℕ → ℕ → ℕ → ℂ := fun r q₁ q₂ n₁ n₂ =>
          if n₁ = n₂ then (mixedFiberMass sm w q₁ q₂ r a b b' n₁ n₂ : ℂ)
          else mixedFiberFourierCoefficient sm w q₁ q₂ r a b b' n₁ n₂ 0 +
            ∑ h ∈ J (Nat.gcd q₁ q₂),
              mixedFiberFourierCoefficient sm w q₁ q₂ r a b b' n₁ n₂
                ((h : ZMod (r * Nat.lcm q₁ q₂)).val)
        have htail' :
            ‖mixedCorrelation sm w S β c a b b' -
                (∑ r ∈ S.image Prod.snd,
                  ∑ p₁ ∈ S.filter (fun p => p.2 = r),
                    ∑ p₂ ∈ S.filter (fun p => p.2 = r),
                      c p₁ * star (c p₂) *
                        ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                          β n₁ * star (β n₂) * V r p₁.1 p₂.1 n₁ n₂)‖ ≤ x ^ (-1 : ℝ) := by
          clear * - htail
          simpa only [opening_padded_window, V, J, shells, H, sm, w] using htail
        have hidentity := opening_truncated_identity sm w S β c a b b' J
        change
          (∑ r ∈ S.image Prod.snd,
            ∑ p₁ ∈ S.filter (fun p => p.2 = r),
              ∑ p₂ ∈ S.filter (fun p => p.2 = r),
                c p₁ * star (c p₂) *
                  ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                    β n₁ * star (β n₂) * V r p₁.1 p₂.1 n₁ n₂) =
            Dcorr b b' + offDiagonalZeroMode sm w S β c a b b' + Ocorr b b' at hidentity
        rw [hidentity] at htail'
        refine ⟨htail'.trans hTailSmall, ?_, hOffDiagonalBound c hc' b hb b' hb'⟩
        have hdiag := hdiagonalAt γ M Q R NI hγlo hγhi hM hQ hR
          (by simpa only [← hNγ] using hMNlo₀)
          (by simpa only [← hNγ] using hMNhi₀)
          (by simpa only [← hNγ] using hRlower)
          (by simpa only [← hNγ] using hRhi₀) hRQhi₀
          (by simpa only [← hNγ] using hNIscale) S β c hβsupport
          (fun n hn => (hβ n hn).2.2) hc'
          (fun p hp => by
            obtain ⟨hq, hr, hcp, hqlo, hqhi, hrlo, hrhi, _, _⟩ := hScales p hp
            exact ⟨hq, hr, hcp, hqlo, hqhi, hrlo, hrhi⟩)
          a b b' ψM (by
            intro t
            simpa only [Real.rpow_zero, mul_one, iteratedDeriv_zero, Real.norm_eq_abs]
              using hCMbound 0 t)
        calc
          ‖Dcorr b b'‖ ≤
              ∑ r ∈ S.image Prod.snd,
                ∑ p₁ ∈ S.filter (fun p => p.2 = r),
                  ∑ p₂ ∈ S.filter (fun p => p.2 = r),
                    ‖c p₁ * star (c p₂) *
                      (∑ n ∈ β.support, β n * star (β n) *
                        (mixedFiberMass sm w p₁.1 p₂.1 r a b b' n n : ℂ))‖ := by
            dsimp only [Dcorr]
            apply norm_sum_le_of_le
            intro r _
            apply norm_sum_le_of_le
            intro p₁ _
            exact norm_sum_le _ _
          _ ≤ Ebase := by simpa only [← hNγ, sm, w, Ebase] using hdiag
      · have hz := hzeroAt M N R Q hM hN hR hQ hMone hNx hQx hRhi
          sm S β c a b₁ b₂
          (fun n hn => ⟨hβpos n hn, (hβ n hn).2.1, (hβ n hn).2.2⟩) hc'
          (fun p hp => by
            obtain ⟨hq, hr, hcp, _, hqhi, hrlo, hrhi, _, _⟩ := hScales p hp
            exact ⟨hq, hr, hcp, hrlo, hrhi, hqhi⟩)
          hprim (fun p hp => (hS p hp).2.2.2.2.2.2.2.2)
        exact hz
    clear hOffDiagonalBound htailAt hzeroAt hdiagonalAt
    have hCauchy := opening_final_cauchy α β S sm w a b₁ b₂ R (13 * Ebase) hR
      (mul_nonneg (by norm_num) hEbase)
      (fun p hp => by
        obtain ⟨hq, hr, _, _, _, _, hrhi, _, _⟩ := hS p hp
        exact ⟨hq, hr, hrhi⟩) hprim hsm hw0 hw1 hEnergy
    refine opening_cauchy_logarithmic_absorption
      hM hN hR hKα hη hlog1
      ((le_max_right _ _).trans ((le_max_right _ _).trans hxlarge))
      (Finset.sum_nonneg fun _ _ => norm_nonneg _) hαmoment ?_
    simpa only [Ebase, D] using hCauchy
  obtain ⟨X₀, hX₀⟩ := hmain.exists_forall_of_atTop
  refine ⟨max (Real.exp 1) X₀, le_max_left _ _, ?_⟩
  intro x hx
  exact hX₀ x ((le_max_right _ _).trans hx)

theorem smooth_factor_parameter_retreat («ω» δ γ₀ : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ)
    (hgap : 1 / 4 + 7 * «ω» + 2 * δ < γ₀) (hγ₀hi : γ₀ ≤ 1 / 2) :
    ∃ ω' δ' ε : ℝ,
      «ω» < ω' ∧ δ < δ' ∧ 0 < ε ∧ ε ≤ 1 / 1000 ∧
      ε < δ' / 10 ^ 100 ∧ «ω» + 100 * ε < ω' ∧ δ + 100 * ε < δ' ∧
      1 / 4 + 7 * ω' + 2 * δ' + 100 * ε ≤ γ₀ := by
  let ρ : ℝ := (γ₀ - (1 / 4 + 7 * «ω» + 2 * δ)) / 100
  let ω' : ℝ := «ω» + ρ
  let δ' : ℝ := δ + ρ
  let ε : ℝ := min (ρ / 1000) (δ' / 10 ^ 101)
  have hρ : 0 < ρ := div_pos (sub_pos.mpr hgap) (by norm_num)
  have hρsmall : ρ < 1 / 400 := by
    dsimp only [ρ]
    linarith only [hγ₀hi, hω, hδ]
  have hδ' : 0 < δ' := by dsimp only [δ']; positivity
  have hε : 0 < ε := lt_min (by positivity) (by positivity)
  have hερ : ε ≤ ρ / 1000 := min_le_left _ _
  have hεδ : ε ≤ δ' / 10 ^ 101 := min_le_right _ _
  have hsmall : ε < δ' / 10 ^ 100 := hεδ.trans_lt
    (div_lt_div_of_pos_left hδ' (by norm_num) (by norm_num))
  refine ⟨ω', δ', ε, ?_, ?_, hε, ?_, hsmall, ?_, ?_, ?_⟩
  · dsimp only [ω']
    linarith only [hρ]
  · dsimp only [δ']
    linarith only [hρ]
  · linarith only [hερ, hρsmall]
  · dsimp only [ω']
    linarith only [hερ, hρ]
  · dsimp only [δ']
    linarith only [hερ, hρ]
  · dsimp only [ω', δ']
    have hρeq : 100 * ρ = γ₀ - (1 / 4 + 7 * «ω» + 2 * δ) := by
      dsimp only [ρ]
      ring
    linarith only [hρeq, hερ, hρ]

end

open Classical in
theorem sourceTheta_pair_smooth_correlation_bounds
    (T A₀ A₁ E₀ E₁ Csrc ε : ℝ)
    (hT : 1 ≤ T) (hA₀ : 0 ≤ A₀) (hA₁ : 0 ≤ A₁) (hε : 0 < ε) :
    ∃ C : ℝ, 0 < C ∧
      ∀ (r q₀ q₁ q₂ s₁ s₂ a b₁ b₂ : ℕ),
        Squarefree (r * q₀ * q₁ * q₂) →
        Squarefree (r * q₀ * s₁ * s₂) →
        Nat.Coprime a r → Nat.Coprime b₁ q₀ →
        ∀ (ℓ h₁ h₂ : ℤ),
        let P : ℕ := Nat.lcm (r * q₀ * q₁ * q₂) (r * q₀ * s₁ * s₂)
        ∀ (N t₀ : ℝ), (q₀ : ℝ) ≤ N → N ≤ (P : ℝ) ^ Csrc →
        ∀ (ψ : ℝ → ℂ), ContDiff ℝ 1 ψ →
        Function.support ψ ⊆ Set.Icc (-T) T →
        (∀ t : ℝ,
          ‖ψ t‖ ≤ A₀ * (Real.log (2 * (P : ℝ) * N)) ^ E₀ ∧
          ‖deriv ψ t‖ ≤ A₁ * (Real.log (2 * (P : ℝ) * N)) ^ E₁) →
        let Δ : ℤ := h₁ * (s₁ : ℤ) * (s₂ : ℤ) - h₂ * (q₁ : ℤ) * (q₂ : ℤ)
        let g : ℕ := Int.gcd (q₀ : ℤ) ℓ
        let D : ℕ := Int.gcd (r : ℤ) Δ
        let F : ℤ → ℂ := fun n =>
          ψ (((n : ℝ) - t₀) / N) * (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
            (sourceTheta r q₀ 1 q₁ q₂ a b₁ b₂ ℓ n h₁ *
              star (sourceTheta r q₀ 1 s₁ s₂ a b₁ b₂ ℓ n h₂))
        let S : ℂ :=
          ∑ n ∈ Finset.Icc (⌈t₀ - T * N⌉ : ℤ) (⌊t₀ + T * N⌋ : ℤ), F n
        (∑' n : ℤ, F n) = S ∧
          ‖S‖ ≤ C * (P : ℝ) ^ ε * (g : ℝ) *
            (Real.sqrt ((P / q₀ : ℕ) : ℝ) +
              (N / (q₀ : ℝ)) * ((D : ℝ) / (r : ℝ))) ∧
          ∀ (Y : Set.Ici (1 : ℝ)),
            Nonempty (DenseDivisibilityWitness
              Y 1 (r * q₀ * q₁)) →
            Nonempty (DenseDivisibilityWitness
              Y 1 (r * q₀ * q₂)) →
            Nonempty (DenseDivisibilityWitness
              Y 1 (r * q₀ * s₁)) →
            Nonempty (DenseDivisibilityWitness
              Y 1 (r * q₀ * s₂)) →
            ‖S‖ ≤ C * (P : ℝ) ^ ε * (g : ℝ) *
              (Real.sqrt (N / (q₀ : ℝ)) * ((P : ℝ) * (Y : ℝ)) ^ (1 / 6 : ℝ) +
                (N / (q₀ : ℝ)) * ((D : ℝ) / (r : ℝ))) := by
  have hsquarefree_lcm {u v : ℕ} (hu : Squarefree u) (hv : Squarefree v) :
      Squarefree (Nat.lcm u v) := by
    apply Nat.squarefree_of_factorization_le_one (Nat.lcm_ne_zero hu.ne_zero hv.ne_zero)
    intro p
    rw [Nat.factorization_lcm hu.ne_zero hv.ne_zero, Finsupp.sup_apply]
    exact max_le (hu.natFactorization_le_one p) (hv.natFactorization_le_one p)
  have hunit_cast (d m : ℕ) (hd : d ∣ m) (n : ℤ)
      (hn : IsUnit (n : ZMod m)) : IsUnit (n : ZMod d) := by
    simpa only [map_intCast] using hn.map (ZMod.castHom hd (ZMod d))
  have hunit_lcm (d e : ℕ) (n : ℤ) :
      IsUnit (n : ZMod (Nat.lcm d e)) ↔
        IsUnit (n : ZMod d) ∧ IsUnit (n : ZMod e) := by
    constructor
    · intro hn
      exact ⟨hunit_cast d _ (Nat.dvd_lcm_left d e) n hn,
        hunit_cast e _ (Nat.dvd_lcm_right d e) n hn⟩
    · rintro ⟨hd, he⟩
      apply (ZMod.coe_int_isUnit_iff_isCoprime _ _).mpr
      have hp := ((ZMod.coe_int_isUnit_iff_isCoprime _ _).mp hd).mul_left
        ((ZMod.coe_int_isUnit_iff_isCoprime _ _).mp he)
      apply hp.of_isCoprime_of_dvd_left
      exact_mod_cast Nat.lcm_dvd_mul d e
  have hchar_inflate (d m : ℕ) [NeZero d] [NeZero m]
      (hd : d ∣ m) (z : ZMod m) :
      ZMod.stdAddChar (ZMod.castHom hd (ZMod d) z) =
        ZMod.stdAddChar (((m / d : ℕ) : ZMod m) * z) := by
    obtain ⟨j, rfl⟩ := ZMod.intCast_surjective z
    rw [map_intCast, ← Int.cast_natCast (m / d), ← Int.cast_mul,
      ZMod.stdAddChar_coe, ZMod.stdAddChar_coe]
    congr 1
    simp only [Int.cast_mul, Int.cast_natCast, Nat.cast_div_charZero hd]
    field_simp [NeZero.ne (d : ℂ), NeZero.ne (m : ℂ)]
  have hphase_inflate (d m : ℕ) [NeZero d] [NeZero m]
      (hd : d ∣ m) (c : ZMod d) (n : ℤ) (hn : IsUnit (n : ZMod m)) :
      reciprocalUnitPhase d c (n : ZMod d) =
        ZMod.stdAddChar (((m / d : ℕ) : ZMod m) *
          (c.val : ZMod m) * (n : ZMod m)⁻¹) := by
    have hnd := hunit_cast d m hd n hn
    let π := ZMod.castHom hd (ZMod d)
    have hinv : π ((n : ZMod m)⁻¹) = (n : ZMod d)⁻¹ := by
      symm
      apply ZMod.inv_eq_of_mul_eq_one
      rw [← map_intCast π n, ← map_mul, ZMod.mul_inv_of_unit _ hn, map_one]
    have hc : π (c.val : ZMod m) = c := by
      simp only [map_natCast, ZMod.natCast_zmod_val]
    rw [reciprocalUnitPhase, ite_eq_left hnd]
    calc
      _ = ZMod.stdAddChar (π ((c.val : ZMod m) * (n : ZMod m)⁻¹)) := by
        rw [map_mul π, hc, hinv]
      _ = _ := by rw [hchar_inflate d m hd]; congr 1; ring
  have hphase_scale (q : ℕ) [NeZero q] (c x y : ZMod q) (hy : IsUnit y) :
      reciprocalUnitPhase q c (x * y) =
        reciprocalUnitPhase q (c * y⁻¹) x := by
    by_cases hx : IsUnit x
    · have hi : (x * y)⁻¹ = y⁻¹ * x⁻¹ := by
        apply ZMod.inv_eq_of_mul_eq_one
        calc
          x * y * (y⁻¹ * x⁻¹) = (x * x⁻¹) * (y * y⁻¹) := by ring
          _ = 1 := by rw [ZMod.mul_inv_of_unit _ hx, ZMod.mul_inv_of_unit _ hy, one_mul]
      simp only [reciprocalUnitPhase, ite_eq_left hx,
        ite_eq_left (hx.mul hy), hi, mul_assoc]
    · have hxy : ¬ IsUnit (x * y) := fun h => hx (IsUnit.mul_iff.mp h).1
      simp only [reciprocalUnitPhase, ite_eq_right hx, ite_eq_right hxy]
  have hphase_modulus (d e : ℕ) [NeZero d] [NeZero e] (hde : d = e)
      (b : ℕ) (h n : ℤ) (k : ℕ) :
      reciprocalUnitPhase d ((b : ZMod d) * (h : ZMod d))
        ((n : ZMod d) * (k : ZMod d)) =
      reciprocalUnitPhase e ((b : ZMod e) * (h : ZMod e))
        ((n : ZMod e) * (k : ZMod e)) := by
    subst e
    rfl
  have hchar_star (q : ℕ) [NeZero q] (c : ZMod q) :
      star (ZMod.stdAddChar c) = ZMod.stdAddChar (-c) := by
    simpa only [Complex.star_def] using (AddChar.map_neg_eq_conj ZMod.stdAddChar c).symm
  have hphase_star (q : ℕ) [NeZero q] (c x : ZMod q) :
      star (reciprocalUnitPhase q c x) =
        reciprocalUnitPhase q (-c) x := by
    by_cases hx : IsUnit x
    · simp only [reciprocalUnitPhase, ite_eq_left hx, hchar_star, neg_mul]
    · simp only [reciprocalUnitPhase, ite_eq_right hx, star_zero]
  have hphase_add (q : ℕ) [NeZero q] (c d x : ZMod q) :
      reciprocalUnitPhase q c x *
        reciprocalUnitPhase q d x =
          reciprocalUnitPhase q (c + d) x := by
    by_cases hx : IsUnit x
    · simp only [reciprocalUnitPhase, ite_eq_left hx,
        add_mul, AddChar.map_add_eq_mul]
    · simp only [reciprocalUnitPhase, ite_eq_right hx, zero_mul]
  have hdense_lcm (Y : Set.Ici (1 : ℝ)) (m n : ℕ)
      (hm : Nonempty (DenseDivisibilityWitness Y 1 m))
      (hn : Nonempty (DenseDivisibilityWitness Y 1 n)) :
      Nonempty (DenseDivisibilityWitness Y 1 (Nat.lcm m n)) :=
    sourceTheta_single_dense_lcm Y m n hm hn
  have hdense_any (q : ℕ) (hq : 0 < q) :
      ∀ X : ℝ, 1 ≤ X → X ≤ (q : ℝ) * (q : ℝ) →
        ∃ d : ℕ, d ∣ q ∧ X / (q : ℝ) ≤ (d : ℝ) ∧ (d : ℝ) ≤ X := by
    have hqR : 0 < (q : ℝ) := by exact_mod_cast hq
    intro X hX hXsq
    by_cases hXq : X ≤ (q : ℝ)
    · refine ⟨1, one_dvd q, (div_le_iff₀ hqR).2 ?_, ?_⟩
      · simpa only [Nat.cast_one, one_mul] using hXq
      · simpa only [Nat.cast_one] using hX
    · exact ⟨q, dvd_rfl, (div_le_iff₀ hqR).2 hXsq, le_of_not_ge hXq⟩
  have hgcd_unit (r : ℕ) [NeZero r] (c d : ℤ) (u : ZMod r)
      (hu : IsUnit u) (h : (c : ZMod r) = u * (d : ZMod r)) :
      Int.gcd c (r : ℤ) = Int.gcd d (r : ℤ) := by
    have huc : Nat.Coprime u.val r :=
      (ZMod.isUnit_iff_coprime u.val r).mp (by
        simpa only [ZMod.natCast_zmod_val] using hu)
    have huG : Int.gcd (u.val : ℤ) (r : ℤ) = 1 := by
      simpa only [Int.gcd_natCast_natCast] using huc.gcd_eq_one
    have hmod : Int.ModEq (r : ℤ) c ((u.val : ℤ) * d) :=
      (ZMod.intCast_eq_intCast_iff c ((u.val : ℤ) * d) r).mp (by
        simpa only [Int.cast_mul, Int.cast_natCast, ZMod.natCast_zmod_val] using h)
    simpa only [Int.gcd_emod, Int.gcd_mul_right_left_of_gcd_eq_one huG] using
      congrArg (fun a : ℤ => Int.gcd a (r : ℤ)) hmod.eq
  have hgcd_ratio (c : ℤ) (r d : ℕ) (hr : 0 < r) (hd : 0 < d) (hrd : r ∣ d) :
      (Nat.gcd c.natAbs d : ℝ) / (d : ℝ) ≤
        (Nat.gcd c.natAbs r : ℝ) / (r : ℝ) := by
    obtain ⟨k, rfl⟩ := hrd
    have hk : 0 < k := Nat.pos_of_mul_pos_left hd
    have hdiv : Nat.gcd c.natAbs (r * k) ∣ Nat.gcd c.natAbs r * k :=
      (Nat.gcd_mul_right_dvd_mul_gcd c.natAbs r k).trans
        (Nat.mul_dvd_mul (dvd_refl _) (Nat.gcd_dvd_right c.natAbs k))
    have hle : Nat.gcd c.natAbs (r * k) ≤ Nat.gcd c.natAbs r * k :=
      Nat.le_of_dvd (Nat.mul_pos (Nat.gcd_pos_of_pos_right c.natAbs hr) hk) hdiv
    have hcross : Nat.gcd c.natAbs (r * k) * r ≤
        Nat.gcd c.natAbs r * (r * k) := by
      calc
        Nat.gcd c.natAbs (r * k) * r ≤ (Nat.gcd c.natAbs r * k) * r :=
          Nat.mul_le_mul_right r hle
        _ = Nat.gcd c.natAbs r * (r * k) := by ring
    apply (div_le_div_iff₀ (by exact_mod_cast hd) (by exact_mod_cast hr)).2
    exact_mod_cast hcross
  have hdiv_remove (r m n : ℕ) (hrm : r ∣ m) (hcop : Nat.Coprime r n) :
      r ∣ m / Nat.gcd m n := by
    have hc : Nat.Coprime r (Nat.gcd m n) :=
      hcop.of_dvd_right (Nat.gcd_dvd_right m n)
    apply hc.dvd_of_dvd_mul_left
    simpa only [Nat.mul_div_cancel' (Nat.gcd_dvd_left m n)] using hrm
  have hcompat_decompose (q₀ r b₁ b₂ : ℕ) [NeZero q₀] (ℓ : ℤ)
      (I : Finset ℤ) (f : ℤ → ℂ) :
      (∑ n ∈ I, (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) * f n) =
        ∑ a ∈ (Finset.Icc 1 q₀).filter (fun a : ℕ =>
          sourceCompatibility r q₀ b₁ b₂ ℓ (a : ℤ) = 1),
          ∑ n ∈ I, if Int.ModEq (q₀ : ℤ) n (a : ℤ) then f n else 0 :=
    sourceTheta_single_compat_decompose q₀ r b₁ b₂ ℓ I f
  have hphase_merge (d e : ℕ) [NeZero d] [NeZero e] [NeZero (Nat.lcm d e)]
      (c : ZMod d) (f : ZMod e) (n : ℤ) :
      reciprocalUnitPhase d c (n : ZMod d) *
          reciprocalUnitPhase e f (n : ZMod e) =
        reciprocalUnitPhase (Nat.lcm d e)
          (((Nat.lcm d e / d : ℕ) : ZMod (Nat.lcm d e)) *
              (c.val : ZMod (Nat.lcm d e)) +
            ((Nat.lcm d e / e : ℕ) : ZMod (Nat.lcm d e)) *
              (f.val : ZMod (Nat.lcm d e))) (n : ZMod (Nat.lcm d e)) := by
    by_cases hn : IsUnit (n : ZMod (Nat.lcm d e))
    · rw [hphase_inflate d (Nat.lcm d e) (Nat.dvd_lcm_left d e) c n hn,
        hphase_inflate e (Nat.lcm d e) (Nat.dvd_lcm_right d e) f n hn]
      simp only [reciprocalUnitPhase, ite_eq_left hn,
        add_mul, AddChar.map_add_eq_mul]
    · by_cases hnd : IsUnit (n : ZMod d)
      · have hne : ¬ IsUnit (n : ZMod e) :=
          fun hne => hn ((hunit_lcm d e n).2 ⟨hnd, hne⟩)
        simp only [reciprocalUnitPhase, ite_eq_right hne,
          ite_eq_right hn, mul_zero]
      · simp only [reciprocalUnitPhase, ite_eq_right hnd,
          ite_eq_right hn, zero_mul]
  have hphase_merge_three (d e f : ℕ) [NeZero d] [NeZero e] [NeZero f]
      [NeZero (Nat.lcm d (Nat.lcm e f))]
      (cd : ZMod d) (ce : ZMod e) (cf : ZMod f) (n : ℤ) :
      reciprocalUnitPhase d cd (n : ZMod d) *
          reciprocalUnitPhase e ce (n : ZMod e) *
          reciprocalUnitPhase f cf (n : ZMod f) =
        reciprocalUnitPhase (Nat.lcm d (Nat.lcm e f))
          (((Nat.lcm d (Nat.lcm e f) / d : ℕ) : ZMod (Nat.lcm d (Nat.lcm e f))) *
              (cd.val : ZMod (Nat.lcm d (Nat.lcm e f))) +
            ((Nat.lcm d (Nat.lcm e f) / e : ℕ) : ZMod (Nat.lcm d (Nat.lcm e f))) *
              (ce.val : ZMod (Nat.lcm d (Nat.lcm e f))) +
            ((Nat.lcm d (Nat.lcm e f) / f : ℕ) : ZMod (Nat.lcm d (Nat.lcm e f))) *
              (cf.val : ZMod (Nat.lcm d (Nat.lcm e f))))
          (n : ZMod (Nat.lcm d (Nat.lcm e f))) := by
    have hedvd : e ∣ Nat.lcm d (Nat.lcm e f) :=
      (Nat.dvd_lcm_left e f).trans (Nat.dvd_lcm_right d (Nat.lcm e f))
    have hfdvd : f ∣ Nat.lcm d (Nat.lcm e f) :=
      (Nat.dvd_lcm_right e f).trans (Nat.dvd_lcm_right d (Nat.lcm e f))
    by_cases hn : IsUnit (n : ZMod (Nat.lcm d (Nat.lcm e f)))
    · rw [hphase_inflate d (Nat.lcm d (Nat.lcm e f))
          (Nat.dvd_lcm_left d (Nat.lcm e f)) cd n hn,
        hphase_inflate e (Nat.lcm d (Nat.lcm e f)) hedvd ce n hn,
        hphase_inflate f (Nat.lcm d (Nat.lcm e f)) hfdvd cf n hn]
      simp only [reciprocalUnitPhase, ite_eq_left hn,
        add_mul, AddChar.map_add_eq_mul]
    · by_cases hnd : IsUnit (n : ZMod d)
      · have hnef : ¬ IsUnit (n : ZMod (Nat.lcm e f)) :=
          fun hef => hn ((hunit_lcm d (Nat.lcm e f) n).2 ⟨hnd, hef⟩)
        by_cases hne : IsUnit (n : ZMod e)
        · have hnf : ¬ IsUnit (n : ZMod f) :=
            fun hnf => hnef ((hunit_lcm e f n).2 ⟨hne, hnf⟩)
          simp only [reciprocalUnitPhase, ite_eq_right hnf,
            ite_eq_right hn, mul_zero]
        · simp only [reciprocalUnitPhase, ite_eq_right hne,
            ite_eq_right hn, mul_zero, zero_mul]
      · simp only [reciprocalUnitPhase, ite_eq_right hnd,
          ite_eq_right hn, zero_mul]
  have hgcd_inflated (r u v m : ℕ) [NeZero r] [NeZero u] [NeZero v] [NeZero m]
      (hr : r ∣ m) (hu : u ∣ m) (hv : v ∣ m)
      (hru : Nat.Coprime r u) (hrv : Nat.Coprime r v)
      (hmr : Nat.Coprime (m / r) r)
      (cr : ZMod r) (cu : ZMod u) (cv : ZMod v)
      (Δ : ℤ) (w : ZMod r) (hw : IsUnit w) (hcr : cr = w * (Δ : ZMod r)) :
      let c : ZMod m :=
        ((m / r : ℕ) : ZMod m) * (cr.val : ZMod m) +
          ((m / u : ℕ) : ZMod m) * (cu.val : ZMod m) +
          ((m / v : ℕ) : ZMod m) * (cv.val : ZMod m)
      Int.gcd (c.val : ℤ) (r : ℤ) = Int.gcd Δ (r : ℤ) := by
    intro c
    have hdivu : r ∣ m / u := by
      apply hru.dvd_of_dvd_mul_left
      simpa only [Nat.mul_div_cancel' hu] using hr
    have hdivv : r ∣ m / v := by
      apply hrv.dvd_of_dvd_mul_left
      simpa only [Nat.mul_div_cancel' hv] using hr
    have hmu : ((m / u : ℕ) : ZMod r) = 0 :=
      (ZMod.natCast_eq_zero_iff (m / u) r).mpr hdivu
    have hmv : ((m / v : ℕ) : ZMod r) = 0 :=
      (ZMod.natCast_eq_zero_iff (m / v) r).mpr hdivv
    have hproj : (c.val : ZMod r) = ((m / r : ℕ) : ZMod r) * cr := by
      calc
        (c.val : ZMod r) = ZMod.castHom hr (ZMod r) c := by
          simp only [ZMod.castHom_apply, ZMod.natCast_val]
        _ = ((m / r : ℕ) : ZMod r) * cr := by
          dsimp only [c]
          simp only [map_add, map_mul, map_natCast, hmu, hmv, zero_mul, add_zero,
            ZMod.natCast_zmod_val]
    apply hgcd_unit r (c.val : ℤ) Δ (((m / r : ℕ) : ZMod r) * w)
      (((ZMod.isUnit_iff_coprime (m / r) r).mpr hmr).mul hw)
    rw [Int.cast_natCast, hproj, hcr, mul_assoc]
  obtain ⟨K, hK, hbound⟩ := reciprocalUnitPhase_pair_smooth_class_bounds
    T A₀ A₁ E₀ E₁ Csrc ε hT hA₀ hA₁ hε
  refine ⟨2 * K, mul_pos (by norm_num) hK, ?_⟩
  intro r q₀ q₁ q₂ s₁ s₂ a b₁ b₂ hsq₁ hsq₂ ha hb₁ ℓ h₁ h₂ P
    N t₀ hNd hN ψ hψ hψs hψb Δ g D F S
  let u₁ := q₀ * q₁
  let u₂ := q₀ * s₁
  have hs₁ : Squarefree (r * (u₁ * q₂)) := by
    simpa only [u₁, Nat.mul_assoc] using hsq₁
  have hs₂ : Squarefree (r * (u₂ * s₂)) := by
    simpa only [u₂, Nat.mul_assoc] using hsq₂
  have hr : Squarefree r := hs₁.of_mul_left
  have hu₁ : Squarefree u₁ := hs₁.of_mul_right.of_mul_left
  have hu₂ : Squarefree u₂ := hs₂.of_mul_right.of_mul_left
  have hq₂ : Squarefree q₂ := hs₁.of_mul_right.of_mul_right
  have hs₂sf : Squarefree s₂ := hs₂.of_mul_right.of_mul_right
  have hq₀ : Squarefree q₀ := hu₁.of_mul_left
  let : NeZero r := ⟨hr.ne_zero⟩
  let : NeZero u₁ := ⟨hu₁.ne_zero⟩
  let : NeZero u₂ := ⟨hu₂.ne_zero⟩
  let : NeZero q₂ := ⟨hq₂.ne_zero⟩
  let : NeZero s₂ := ⟨hs₂sf.ne_zero⟩
  let : NeZero q₀ := ⟨hq₀.ne_zero⟩
  have hr₁ : Nat.Coprime r (u₁ * q₂) := Nat.coprime_of_squarefree_mul hs₁
  have hr₂ : Nat.Coprime r (u₂ * s₂) := Nat.coprime_of_squarefree_mul hs₂
  have huq : Nat.Coprime u₁ q₂ := Nat.coprime_of_squarefree_mul hs₁.of_mul_right
  have hus : Nat.Coprime u₂ s₂ := Nat.coprime_of_squarefree_mul hs₂.of_mul_right
  have hru₁ : Nat.Coprime r u₁ := hr₁.coprime_mul_right_right
  have hru₂ : Nat.Coprime r u₂ := hr₂.coprime_mul_right_right
  have hrq₂ : Nat.Coprime r q₂ := hr₁.coprime_mul_left_right
  have hrs₂ : Nat.Coprime r s₂ := hr₂.coprime_mul_left_right
  have hq₀u₁ : q₀ ∣ u₁ := ⟨q₁, rfl⟩
  have hrq₀ : Nat.Coprime r q₀ := hru₁.of_dvd_right hq₀u₁
  let m₀ := Nat.lcm r (Nat.lcm u₁ u₂)
  let m₁ := Nat.lcm q₂ s₂
  have hm₀sf : Squarefree m₀ := hsquarefree_lcm hr (hsquarefree_lcm hu₁ hu₂)
  have hm₁sf : Squarefree m₁ := hsquarefree_lcm hq₂ hs₂sf
  let : NeZero m₀ := ⟨hm₀sf.ne_zero⟩
  let : NeZero m₁ := ⟨hm₁sf.ne_zero⟩
  have hrm₀ : r ∣ m₀ := Nat.dvd_lcm_left _ _
  have hu₁m₀ : u₁ ∣ m₀ := (Nat.dvd_lcm_left u₁ u₂).trans (Nat.dvd_lcm_right _ _)
  have hu₂m₀ : u₂ ∣ m₀ := (Nat.dvd_lcm_right u₁ u₂).trans (Nat.dvd_lcm_right _ _)
  have hq₂m₁ : q₂ ∣ m₁ := Nat.dvd_lcm_left _ _
  have hs₂m₁ : s₂ ∣ m₁ := Nat.dvd_lcm_right _ _
  have hrm₁ : Nat.Coprime r m₁ :=
    (hrq₂.mul_right hrs₂).of_dvd_right (Nat.lcm_dvd_mul q₂ s₂)
  have hP₁ : Nat.lcm (Nat.lcm r u₁) q₂ = r * q₀ * q₁ * q₂ := by
    rw [hru₁.lcm_eq_mul, (hrq₂.mul_left huq).lcm_eq_mul]
    simp only [u₁, Nat.mul_assoc]
  have hP₂ : Nat.lcm (Nat.lcm r u₂) s₂ = r * q₀ * s₁ * s₂ := by
    rw [hru₂.lcm_eq_mul, (hrs₂.mul_left hus).lcm_eq_mul]
    simp only [u₂, Nat.mul_assoc]
  have hmP : Nat.lcm m₀ m₁ = P := by
    have hleft : Nat.lcm (Nat.lcm r u₁) q₂ ∣ P := by
      rw [hP₁]
      exact Nat.dvd_lcm_left _ _
    have hright : Nat.lcm (Nat.lcm r u₂) s₂ ∣ P := by
      rw [hP₂]
      exact Nat.dvd_lcm_right _ _
    apply Nat.dvd_antisymm
    · apply Nat.lcm_dvd
      · exact Nat.lcm_dvd
          ((Nat.dvd_lcm_left r u₁).trans ((Nat.dvd_lcm_left _ _).trans hleft))
          (Nat.lcm_dvd
            ((Nat.dvd_lcm_right r u₁).trans ((Nat.dvd_lcm_left _ _).trans hleft))
            ((Nat.dvd_lcm_right r u₂).trans ((Nat.dvd_lcm_left _ _).trans hright)))
      · exact Nat.lcm_dvd ((Nat.dvd_lcm_right _ _).trans hleft)
          ((Nat.dvd_lcm_right _ _).trans hright)
    · apply Nat.lcm_dvd
      · rw [← hP₁]
        exact Nat.lcm_dvd
          (Nat.lcm_dvd (hrm₀.trans (Nat.dvd_lcm_left _ _))
            (hu₁m₀.trans (Nat.dvd_lcm_left _ _)))
          (hq₂m₁.trans (Nat.dvd_lcm_right _ _))
      · rw [← hP₂]
        exact Nat.lcm_dvd
          (Nat.lcm_dvd (hrm₀.trans (Nat.dvd_lcm_left _ _))
            (hu₂m₀.trans (Nat.dvd_lcm_left _ _)))
          (hs₂m₁.trans (Nat.dvd_lcm_right _ _))
  have hPpos : 0 < P := by rw [← hmP]; exact Nat.lcm_pos (NeZero.pos _) (NeZero.pos _)
  have hq₀P : q₀ ∣ P := by
    rw [← hmP]
    exact hq₀u₁.trans (hu₁m₀.trans (Nat.dvd_lcm_left _ _))
  have hNpos : 0 < N := lt_of_lt_of_le (by exact_mod_cast NeZero.pos q₀) hNd
  let ar₁ : ZMod r := (a : ZMod r) * (h₁ : ZMod r) * ((u₁ * q₂ : ℕ) : ZMod r)⁻¹
  let ar₂ : ZMod r := (a : ZMod r) * (h₂ : ZMod r) * ((u₂ * s₂ : ℕ) : ZMod r)⁻¹
  let cu₁ : ZMod u₁ := (b₁ : ZMod u₁) * (h₁ : ZMod u₁) * ((r * q₂ : ℕ) : ZMod u₁)⁻¹
  let cu₂ : ZMod u₂ := (b₁ : ZMod u₂) * (h₂ : ZMod u₂) * ((r * s₂ : ℕ) : ZMod u₂)⁻¹
  let cv₁ : ZMod q₂ := (b₂ : ZMod q₂) * (h₁ : ZMod q₂) * ((r * u₁ : ℕ) : ZMod q₂)⁻¹
  let cv₂ : ZMod s₂ := (b₂ : ZMod s₂) * (h₂ : ZMod s₂) * ((r * u₂ : ℕ) : ZMod s₂)⁻¹
  let cr : ZMod r := ar₁ - ar₂
  let c₀ : ZMod m₀ := ((m₀ / r : ℕ) : ZMod m₀) * cr.val +
    ((m₀ / u₁ : ℕ) : ZMod m₀) * cu₁.val +
    ((m₀ / u₂ : ℕ) : ZMod m₀) * (-cu₂).val
  let c₁ : ZMod m₁ := ((m₁ / q₂ : ℕ) : ZMod m₁) * cv₁.val +
    ((m₁ / s₂ : ℕ) : ZMod m₁) * (-cv₂).val
  have hΘ₁ (n : ℤ) : sourceTheta r q₀ 1 q₁ q₂ a b₁ b₂ ℓ n h₁ =
      reciprocalUnitPhase r ar₁ (n : ZMod r) *
        reciprocalUnitPhase u₁ cu₁ (n : ZMod u₁) *
        reciprocalUnitPhase q₂ cv₁ ((n + ℓ * (r : ℤ) : ℤ) : ZMod q₂) := by
    have hp : r ≠ 0 ∧ q₀ * 1 * q₁ ≠ 0 ∧ q₂ ≠ 0 :=
      ⟨hr.ne_zero, by simpa only [Nat.mul_one] using hu₁.ne_zero, hq₂.ne_zero⟩
    let : NeZero (q₀ * 1 * q₁) := ⟨hp.2.1⟩
    rw [sourceTheta, dite_eq_left hp]
    dsimp only
    rw [hphase_modulus (q₀ * 1 * q₁) u₁ (by simp only [u₁, Nat.mul_one]) b₁ h₁ n (r * q₂)]
    simp only [Nat.mul_one]
    rw [show r * q₀ * q₁ = r * u₁ by simp only [u₁, Nat.mul_assoc]]
    rw [hphase_scale r _ _ _ ((ZMod.isUnit_iff_coprime _ _).2 hr₁.symm),
      hphase_scale u₁ _ _ _ ((ZMod.isUnit_iff_coprime _ _).2 (hru₁.mul_left huq.symm)),
      hphase_scale q₂ _ _ _ ((ZMod.isUnit_iff_coprime _ _).2 (hrq₂.mul_left huq))]
  have hΘ₂ (n : ℤ) : sourceTheta r q₀ 1 s₁ s₂ a b₁ b₂ ℓ n h₂ =
      reciprocalUnitPhase r ar₂ (n : ZMod r) *
        reciprocalUnitPhase u₂ cu₂ (n : ZMod u₂) *
        reciprocalUnitPhase s₂ cv₂ ((n + ℓ * (r : ℤ) : ℤ) : ZMod s₂) := by
    have hp : r ≠ 0 ∧ q₀ * 1 * s₁ ≠ 0 ∧ s₂ ≠ 0 :=
      ⟨hr.ne_zero, by simpa only [Nat.mul_one] using hu₂.ne_zero, hs₂sf.ne_zero⟩
    let : NeZero (q₀ * 1 * s₁) := ⟨hp.2.1⟩
    rw [sourceTheta, dite_eq_left hp]
    dsimp only
    rw [hphase_modulus (q₀ * 1 * s₁) u₂ (by simp only [u₂, Nat.mul_one]) b₁ h₂ n (r * s₂)]
    simp only [Nat.mul_one]
    rw [show r * q₀ * s₁ = r * u₂ by simp only [u₂, Nat.mul_assoc]]
    rw [hphase_scale r _ _ _ ((ZMod.isUnit_iff_coprime _ _).2 hr₂.symm),
      hphase_scale u₂ _ _ _ ((ZMod.isUnit_iff_coprime _ _).2 (hru₂.mul_left hus.symm)),
      hphase_scale s₂ _ _ _ ((ZMod.isUnit_iff_coprime _ _).2 (hrs₂.mul_left hus))]
  have hphase (n : ℤ) :
      sourceTheta r q₀ 1 q₁ q₂ a b₁ b₂ ℓ n h₁ *
        star (sourceTheta r q₀ 1 s₁ s₂ a b₁ b₂ ℓ n h₂) =
      reciprocalUnitPhase m₀ c₀ (n : ZMod m₀) *
        reciprocalUnitPhase m₁ c₁ ((n + ℓ * (r : ℤ) : ℤ) : ZMod m₁) := by
    rw [hΘ₁, hΘ₂, star_mul, star_mul, hphase_star, hphase_star, hphase_star]
    calc
      _ = ((reciprocalUnitPhase r ar₁ (n : ZMod r) *
          reciprocalUnitPhase r (-ar₂) (n : ZMod r)) *
          reciprocalUnitPhase u₁ cu₁ (n : ZMod u₁) *
          reciprocalUnitPhase u₂ (-cu₂) (n : ZMod u₂)) *
          (reciprocalUnitPhase q₂ cv₁ ((n + ℓ * (r : ℤ) : ℤ) : ZMod q₂) *
          reciprocalUnitPhase s₂ (-cv₂) ((n + ℓ * (r : ℤ) : ℤ) : ZMod s₂)) := by ring
      _ = _ := by
        rw [hphase_add, hphase_merge_three, hphase_merge]
        simp only [c₀, c₁, cr, m₀, m₁, sub_eq_add_neg]
  let t : ZMod r := ((q₀ * q₁ * q₂ * s₁ * s₂ : ℕ) : ZMod r)
  have ht : IsUnit t := by
    apply (ZMod.isUnit_iff_coprime _ _).2
    simpa only [u₁, u₂, Nat.mul_assoc] using
      (hr₁.mul_right (hr₂.coprime_mul_right_right.coprime_mul_left_right.mul_right hrs₂)).symm
  have hi₁ : ((u₁ * q₂ : ℕ) : ZMod r)⁻¹ = ((s₁ * s₂ : ℕ) : ZMod r) * t⁻¹ := by
    apply ZMod.inv_eq_of_mul_eq_one
    calc
      _ = t * t⁻¹ := by dsimp [t, u₁]; push_cast; ring
      _ = 1 := ZMod.mul_inv_of_unit _ ht
  have hi₂ : ((u₂ * s₂ : ℕ) : ZMod r)⁻¹ = ((q₁ * q₂ : ℕ) : ZMod r) * t⁻¹ := by
    apply ZMod.inv_eq_of_mul_eq_one
    calc
      _ = t * t⁻¹ := by dsimp [t, u₂]; push_cast; ring
      _ = 1 := ZMod.mul_inv_of_unit _ ht
  have htinv : IsUnit t⁻¹ := by
    obtain ⟨v, hv⟩ := ht
    rw [← hv, ZMod.inv_coe_unit]
    exact (v⁻¹).isUnit
  have hcr : cr = ((a : ZMod r) * t⁻¹) * (Δ : ZMod r) := by
    dsimp only [cr, ar₁, ar₂]
    rw [hi₁, hi₂]
    dsimp only [Δ]
    push_cast
    ring
  have hmr : Nat.Coprime (m₀ / r) r := by
    apply Nat.coprime_of_squarefree_mul
    simpa only [Nat.div_mul_cancel hrm₀] using hm₀sf
  have hc₀gcd : Nat.gcd c₀.val r = D := by
    have hc := hgcd_inflated r u₁ u₂ m₀ hrm₀ hu₁m₀ hu₂m₀ hru₁ hru₂ hmr
      cr cu₁ (-cu₂) Δ ((a : ZMod r) * t⁻¹)
      (((ZMod.isUnit_iff_coprime _ _).2 ha).mul htinv) hcr
    change Nat.gcd c₀.val r = Int.gcd Δ (r : ℤ) at hc
    exact hc.trans (Int.gcd_comm Δ (r : ℤ))
  let d₀ := m₀ / Nat.gcd m₀ m₁
  let d₁ := m₁ / Nat.gcd m₀ m₁
  let e₀ := d₀ / Nat.gcd q₀ d₀
  let e₁ := d₁ / Nat.gcd q₀ d₁
  have hd₀ : 0 < d₀ := Nat.div_gcd_pos_of_pos_left _ (NeZero.pos _)
  have hd₁ : 0 < d₁ := Nat.div_gcd_pos_of_pos_right _ (NeZero.pos _)
  have he₀ : 0 < e₀ := Nat.div_gcd_pos_of_pos_right _ hd₀
  have he₁ : 0 < e₁ := Nat.div_gcd_pos_of_pos_right _ hd₁
  have hre₀ : r ∣ e₀ := by
    have hrd₀ := hdiv_remove r m₀ m₁ hrm₀ hrm₁
    simpa only [e₀, Nat.gcd_comm] using hdiv_remove r d₀ q₀ hrd₀ hrq₀
  have hratio₀ : (Nat.gcd c₀.val e₀ : ℝ) / (e₀ : ℝ) ≤ (D : ℝ) / (r : ℝ) := by
    simpa only [Int.natAbs_natCast, hc₀gcd] using
      hgcd_ratio (c₀.val : ℤ) r e₀ (NeZero.pos _) he₀ hre₀
  have hratio₁ : (Nat.gcd c₁.val e₁ : ℝ) / (e₁ : ℝ) ≤ 1 := by
    apply (div_le_one (by exact_mod_cast he₁)).2
    exact_mod_cast Nat.gcd_le_right c₁.val he₁
  let m : Fin 2 → ℕ := ![m₀, m₁]
  let c : Fin 2 → ℤ := ![(c₀.val : ℤ), (c₁.val : ℤ)]
  let shifts : Fin 2 → ℤ := ![0, ℓ * (r : ℤ)]
  have hm : ∀ i, Squarefree (m i) := by intro i; fin_cases i <;> assumption
  let mean : ℝ := ∏ i : Fin 2,
    (Nat.gcd (c i).natAbs (m i / Nat.gcd (m 0) (m 1) /
      Nat.gcd q₀ (m i / Nat.gcd (m 0) (m 1))) : ℝ) /
      (m i / Nat.gcd (m 0) (m 1) / Nat.gcd q₀ (m i / Nat.gcd (m 0) (m 1)) : ℕ)
  have hmean : mean ≤ (D : ℝ) / (r : ℝ) := by
    dsimp only [mean]
    rw [Fin.prod_univ_two]
    change ((Nat.gcd c₀.val e₀ : ℝ) / (e₀ : ℝ)) *
      ((Nat.gcd c₁.val e₁ : ℝ) / (e₁ : ℝ)) ≤ _
    exact (mul_le_of_le_one_right (by positivity) hratio₁).trans hratio₀
  let I := Finset.Icc (⌈t₀ - T * N⌉ : ℤ) (⌊t₀ + T * N⌋ : ℤ)
  let f : ℤ → ℂ := fun n => ψ (((n : ℝ) - t₀) / N) *
    (reciprocalUnitPhase m₀ c₀ (n : ZMod m₀) *
      reciprocalUnitPhase m₁ c₁ ((n + ℓ * (r : ℤ) : ℤ) : ZMod m₁))
  let R := (Finset.Icc 1 q₀).filter (fun z : ℕ => sourceCompatibility r q₀ b₁ b₂ ℓ (z : ℤ) = 1)
  let W : ℕ → ℂ := fun z => ∑ n ∈ I, if Int.ModEq (q₀ : ℤ) n (z : ℤ) then f n else 0
  have hF (n : ℤ) : F n = (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) * f n := by
    dsimp only [F, f]
    rw [hphase]
    ring
  have hS : S = ∑ z ∈ R, W z := by
    change (∑ n ∈ I, F n) = _
    simp_rw [hF]
    exact hcompat_decompose q₀ r b₁ b₂ ℓ I f
  have hcard : (R.card : ℝ) ≤ 2 * (g : ℝ) := by
    have hh := sourceCompatibility_fixed_shift_count_le q₀ r b₁ b₂ q₀ ℓ hb₁ hrq₀
    simpa only [R, g, div_self (show (q₀ : ℝ) ≠ 0 by exact_mod_cast NeZero.ne q₀),
      one_add_one_eq_two, mul_comm] using hh
  have hsum (B₀ : ℝ) (hB₀ : 0 ≤ B₀) (hw : ∀ z ∈ R, ‖W z‖ ≤ K * (P : ℝ) ^ ε * B₀) :
      ‖S‖ ≤ (2 * K) * (P : ℝ) ^ ε * (g : ℝ) * B₀ := by
    rw [hS]
    calc
      ‖∑ z ∈ R, W z‖ ≤ ∑ _z ∈ R, K * (P : ℝ) ^ ε * B₀ := norm_sum_le_of_le _ hw
      _ = (R.card : ℝ) * (K * (P : ℝ) ^ ε * B₀) := by simp
      _ ≤ (2 * (g : ℝ)) * (K * (P : ℝ) ^ ε * B₀) :=
        mul_le_mul_of_nonneg_right hcard
          (mul_nonneg (mul_nonneg hK.le (Real.rpow_nonneg (Nat.cast_nonneg _) _)) hB₀)
      _ = _ := by ring
  have hlocal (y : ℝ) (hy : 1 ≤ y)
      (hdense : ∀ X : ℝ, 1 ≤ X → X ≤ y * (P : ℝ) →
        ∃ d : ℕ, d ∣ P ∧ X / y ≤ (d : ℝ) ∧ (d : ℝ) ≤ X) (z : ℕ) :
      ‖W z‖ ≤ K * (P : ℝ) ^ ε *
        (Real.sqrt (N / (q₀ : ℝ)) * ((P : ℝ) * y) ^ (1 / 6 : ℝ) +
          (N / (q₀ : ℝ)) * ((D : ℝ) / (r : ℝ))) ∧
      ‖W z‖ ≤ K * (P : ℝ) ^ ε *
        (Real.sqrt ((P / q₀ : ℕ) : ℝ) + (N / (q₀ : ℝ)) * ((D : ℝ) / (r : ℝ))) := by
    have hmp : Nat.lcm (m 0) (m 1) = P := hmP
    have hh := hbound m hm y hy (by simpa only [hmp] using hdense)
      q₀ (by simpa only [hmp] using hq₀P) c shifts (z : ℤ) N t₀ hNd
      (by simpa only [hmp] using hN) ψ hψ hψs (by simpa only [hmp] using hψb)
    have hphase' (n : ℤ) :
        (∏ i : Fin 2, letI : NeZero (m i) := ⟨(hm i).ne_zero⟩
          reciprocalUnitPhase (m i) (c i : ZMod (m i))
            ((n + shifts i : ℤ) : ZMod (m i))) =
          reciprocalUnitPhase m₀ c₀ (n : ZMod m₀) *
            reciprocalUnitPhase m₁ c₁ ((n + ℓ * (r : ℤ) : ℤ) : ZMod m₁) := by
      rw [Fin.prod_univ_two]
      change reciprocalUnitPhase m₀ ((c₀.val : ℤ) : ZMod m₀)
        ((n + 0 : ℤ) : ZMod m₀) *
        reciprocalUnitPhase m₁ ((c₁.val : ℤ) : ZMod m₁)
          ((n + ℓ * (r : ℤ) : ℤ) : ZMod m₁) = _
      simp only [Int.cast_natCast, ZMod.natCast_zmod_val, add_zero]
    dsimp only at hh
    simp_rw [hphase'] at hh
    change (∑' n : ℤ, if Int.ModEq (q₀ : ℤ) n (z : ℤ) then f n else 0) = W z ∧
      ‖W z‖ ≤ K * (Nat.lcm (m 0) (m 1) : ℝ) ^ ε *
        (Real.sqrt (N / (q₀ : ℝ)) * ((Nat.lcm (m 0) (m 1) : ℝ) * y) ^ (1 / 6 : ℝ) +
          (N / (q₀ : ℝ)) * mean) ∧
      ‖W z‖ ≤ K * (Nat.lcm (m 0) (m 1) : ℝ) ^ ε *
        (Real.sqrt ((Nat.lcm (m 0) (m 1) / q₀ : ℕ) : ℝ) + (N / (q₀ : ℝ)) * mean) at hh
    rw [hmp] at hh
    have hb : (N / (q₀ : ℝ)) * mean ≤ (N / (q₀ : ℝ)) * ((D : ℝ) / (r : ℝ)) :=
      mul_le_mul_of_nonneg_left hmean (div_nonneg hNpos.le (Nat.cast_nonneg _))
    have hk : 0 ≤ K * (P : ℝ) ^ ε := mul_nonneg hK.le (Real.rpow_nonneg (Nat.cast_nonneg _) _)
    exact ⟨hh.2.1.trans (mul_le_mul_of_nonneg_left (add_le_add le_rfl hb) hk),
      hh.2.2.trans (mul_le_mul_of_nonneg_left (add_le_add le_rfl hb) hk)⟩
  refine ⟨?_, ?_, ?_⟩
  · change (∑' n : ℤ, F n) = ∑ n ∈ I, F n
    apply tsum_eq_sum
    intro n hn
    have hz : ψ (((n : ℝ) - t₀) / N) = 0 := by
      by_contra hz
      have hsupport := hψs (show ((n : ℝ) - t₀) / N ∈ Function.support ψ from hz)
      have hlow := (le_div_iff₀ hNpos).1 hsupport.1
      have hupp := (div_le_iff₀ hNpos).1 hsupport.2
      apply hn
      exact Finset.mem_Icc.mpr ⟨Int.ceil_le.mpr (by linarith only [hlow]),
        Int.le_floor.mpr (by linarith only [hupp])⟩
    simp only [F, hz, zero_mul]
  · apply hsum _ (by positivity)
    intro z _
    exact (hlocal (P : ℝ) (by exact_mod_cast hPpos) (hdense_any P hPpos) z).2
  · intro Y hY₁ hY₂ hY₃ hY₄
    have hq₁q₂ : Nat.Coprime q₁ q₂ := huq.of_dvd_left (by dsimp [u₁]; exact dvd_mul_left _ _)
    have hs₁s₂ : Nat.Coprime s₁ s₂ := hus.of_dvd_left (by dsimp [u₂]; exact dvd_mul_left _ _)
    have hPY : Nat.lcm (Nat.lcm (r * q₀ * q₁) (r * q₀ * q₂))
        (Nat.lcm (r * q₀ * s₁) (r * q₀ * s₂)) = P := by
      rw [Nat.lcm_mul_left, Nat.lcm_mul_left, hq₁q₂.lcm_eq_mul, hs₁s₂.lcm_eq_mul]
      simp only [P, Nat.mul_assoc]
    have hY : Nonempty (DenseDivisibilityWitness Y 1 P) := by
      rw [← hPY]
      exact hdense_lcm Y _ _ (hdense_lcm Y _ _ hY₁ hY₂) (hdense_lcm Y _ _ hY₃ hY₄)
    have hdense : ∀ X : ℝ, 1 ≤ X → X ≤ (Y : ℝ) * (P : ℝ) →
        ∃ d : ℕ, d ∣ P ∧ X / (Y : ℝ) ≤ (d : ℝ) ∧ (d : ℝ) ≤ X := by
      intro X hX hXY
      obtain ⟨u, v, huv, _, _, hlow, hupp⟩ :=
        (denseDivisibility_succ_iff.mp hY).2 0 0 rfl X hX hXY
      exact ⟨v, ⟨u, by simpa only [Nat.mul_comm] using huv⟩, hlow, hupp⟩
    apply hsum _ (add_nonneg
      (mul_nonneg (Real.sqrt_nonneg _)
        (Real.rpow_nonneg (mul_nonneg (Nat.cast_nonneg _) (zero_le_one.trans Y.property)) _))
      (mul_nonneg (div_nonneg hNpos.le (Nat.cast_nonneg _))
        (div_nonneg (Nat.cast_nonneg _) (Nat.cast_nonneg _))))
    intro z _
    exact (hlocal (Y : ℝ) Y.property hdense z).1

section
open scoped ContDiff
open Classical in
theorem sourceTheta_pair_finite_cauchy_bounds
    (T A₀ A₁ Csrc ε : ℝ)
    (hT : 1 ≤ T) (hA₀ : 0 ≤ A₀) (hA₁ : 0 ≤ A₁) (hε : 0 < ε) :
    ∃ C : ℝ, 0 < C ∧
      ∀ (r q₀ a b₁ b₂ N₀ : ℕ),
      ∀ (F : Finset (ℕ × ℕ)) (J : Finset ℤ),
        (∀ q ∈ F, Squarefree (r * q₀ * q.1 * q.2)) →
        Nat.Coprime a r → Nat.Coprime b₁ q₀ →
        ∀ (ℓ : ℤ) (N t₀ W L : ℝ),
          (q₀ : ℝ) ≤ N → 0 ≤ W → 0 ≤ L →
          (∀ q ∈ F, ∀ s ∈ F,
            N ≤ (Nat.lcm (r * q₀ * q.1 * q.2)
              (r * q₀ * s.1 * s.2) : ℝ) ^ Csrc) →
        ∀ (ψ : ℝ → ℝ), ContDiff ℝ 1 ψ →
          Function.support ψ ⊆ Set.Icc (-T) T →
          (∀ t : ℝ, 0 ≤ ψ t) →
          (∀ t : ℝ, |ψ t| ≤ A₀ ∧ |deriv ψ t| ≤ A₁) →
        ∀ (β : ℕ →₀ ℂ), β.support ⊆ Finset.Icc 1 N₀ →
          (∀ n ∈ β.support, ‖β n‖ ≤ W) →
          (∀ n ∈ β.support, 1 ≤ ψ (((n : ℝ) - t₀) / N)) →
        ∀ (c : (ℕ × ℕ) → ℤ → ℂ),
          (∀ q ∈ F, ∀ h ∈ J, ‖c q h‖ ≤ L) →
        let γ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
        let g : ℕ := Int.gcd (q₀ : ℤ) ℓ
        let P : (ℕ × ℕ) → (ℕ × ℕ) → ℕ := fun q s =>
          Nat.lcm (r * q₀ * q.1 * q.2) (r * q₀ * s.1 * s.2)
        let V : ℝ := (∑ q ∈ F, ‖∑ n ∈ γ.support,
          γ n * star (γ (n + ℓ * (r : ℤ))) *
            (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
            ∑ h ∈ J, c q h * sourceTheta r q₀ 1 q.1 q.2 a b₁ b₂ ℓ n h‖) ^ 2
        V ≤
          C * W ^ 4 * (g : ℝ) ^ 2 * (1 + (N₀ : ℝ) / (q₀ : ℝ)) * L ^ 2 *
            ∑ q ∈ F, ∑ s ∈ F, ∑ h ∈ J, ∑ k ∈ J,
              (P q s : ℝ) ^ ε *
                (Real.sqrt ((P q s / q₀ : ℕ) : ℝ) +
                  (N / (q₀ : ℝ)) *
                    ((Int.gcd (r : ℤ)
                      (h * (s.1 : ℤ) * (s.2 : ℤ) -
                        k * (q.1 : ℤ) * (q.2 : ℤ)) : ℝ) / (r : ℝ))) ∧
        ∀ (Y : Set.Ici (1 : ℝ)),
          (∀ q ∈ F,
            Nonempty (DenseDivisibilityWitness
              Y 1 (r * q₀ * q.1)) ∧
            Nonempty (DenseDivisibilityWitness
              Y 1 (r * q₀ * q.2))) →
          V ≤
            C * W ^ 4 * (g : ℝ) ^ 2 * (1 + (N₀ : ℝ) / (q₀ : ℝ)) * L ^ 2 *
              ∑ q ∈ F, ∑ s ∈ F, ∑ h ∈ J, ∑ k ∈ J,
                (P q s : ℝ) ^ ε *
                  (Real.sqrt (N / (q₀ : ℝ)) *
                    ((P q s : ℝ) * (Y : ℝ)) ^ (1 / 6 : ℝ) +
                    (N / (q₀ : ℝ)) *
                      ((Int.gcd (r : ℤ)
                        (h * (s.1 : ℤ) * (s.2 : ℤ) -
                          k * (q.1 : ℤ) * (q.2 : ℤ)) : ℝ) / (r : ℝ))) := by
  obtain ⟨C, hC, hcorr⟩ := sourceTheta_pair_smooth_correlation_bounds
    T A₀ A₁ 0 0 Csrc ε hT hA₀ hA₁ hε
  refine ⟨C, hC, ?_⟩
  intro r q₀ a b₁ b₂ N₀ F J hF ha hb₁ ℓ N t₀ W L hN hW hL
    hNP ψ hψ hψsupport hψnonneg hψbound β hβsupport hβ hψmajor c hc γ g P V
  by_cases hFempty : F = ∅
  · simp [V, hFempty]
  obtain ⟨q, hqF⟩ := Finset.nonempty_iff_ne_empty.mpr hFempty
  have hrq : Squarefree (r * q₀) := (hF q hqF).of_mul_left.of_mul_left
  have hq₀ : 0 < q₀ := Nat.pos_of_ne_zero hrq.of_mul_right.ne_zero
  have hq₀R : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀
  have hNpos : 0 < N := hq₀R.trans_le hN
  let : NeZero q₀ := ⟨hq₀.ne'⟩
  have hγ (n : ℤ) : ‖γ n‖ ≤ W := by
    by_cases hn : n ∈ γ.support
    · change n ∈ β.support.map (Nat.castEmbedding : ℕ ↪ ℤ) at hn
      obtain ⟨m, hm, rfl⟩ := Finset.mem_map.mp hn
      simpa only [γ, Finsupp.embDomain_apply_self] using hβ m hm
    · rw [Finsupp.notMem_support_iff.mp hn, norm_zero]
      exact hW
  let b : ℤ → ℂ := fun n => γ n * star (γ (n + ℓ * (r : ℤ)))
  let χ : ℤ → ℝ := fun n => ψ (((n : ℝ) - t₀) / N)
  let I := Finset.Icc (⌈t₀ - T * N⌉ : ℤ) (⌊t₀ + T * N⌋ : ℤ)
  let K := γ.support ∪ I
  let S := K.filter (fun n => sourceCompatibility r q₀ b₁ b₂ ℓ n = 1)
  let f : (ℕ × ℕ) → ℤ → ℂ := fun q n =>
    ∑ h ∈ J, c q h * sourceTheta r q₀ 1 q.1 q.2 a b₁ b₂ ℓ n h
  have hcompat (n : ℤ) : sourceCompatibility r q₀ b₁ b₂ ℓ n = 1 ∨
      sourceCompatibility r q₀ b₁ b₂ ℓ n = 0 := ite_eq_or_eq _ _ _
  have hχzero (n : ℤ) (hn : n ∉ I) : χ n = 0 := by
    by_contra hne
    have ht := hψsupport hne
    have hlow : t₀ - T * N ≤ (n : ℝ) := by
      have := (le_div_iff₀ hNpos).mp ht.1
      linarith
    have hupp : (n : ℝ) ≤ t₀ + T * N := by
      have := (div_le_iff₀ hNpos).mp ht.2
      linarith
    exact hn (Finset.mem_Icc.mpr ⟨Int.ceil_le.mpr hlow, Int.le_floor.mpr hupp⟩)
  have hbzero (n : ℤ) (hn : n ∉ γ.support) : b n = 0 := by
    simp [b, Finsupp.notMem_support_iff.mp hn]
  have hmajor (n : ℤ) (_hn : n ∈ S) (hb : b n ≠ 0) : 1 ≤ χ n := by
    have hn : n ∈ γ.support := by
      by_contra hn
      exact hb (hbzero n hn)
    change n ∈ β.support.map (Nat.castEmbedding : ℕ ↪ ℤ) at hn
    obtain ⟨m, hm, rfl⟩ := Finset.mem_map.mp hn
    simpa only [χ, Nat.castEmbedding_apply, Int.cast_natCast] using hψmajor m hm
  have hleft (q : ℕ × ℕ) :
      (∑ n ∈ γ.support, b n * (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) * f q n) =
        ∑ n ∈ S, b n * f q n := by
    calc
      _ = ∑ n ∈ K, b n * (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) * f q n := by
        apply Finset.sum_subset Finset.subset_union_left
        intro n _ hn
        simp only [hbzero n hn, zero_mul]
      _ = _ := by
        dsimp only [S]
        rw [Finset.sum_filter]
        apply Finset.sum_congr rfl
        intro n _
        rcases hcompat n with hn | hn <;> simp [hn]
  have hmoment : (∑ n ∈ S, ‖b n‖ ^ 2) ≤
      (g : ℝ) * (1 + (N₀ : ℝ) / (q₀ : ℝ)) * W ^ 4 := by
    have hb (n : ℤ) : ‖b n‖ ^ 2 ≤ W ^ 4 := by
      calc
        ‖b n‖ ^ 2 = (‖γ n‖ * ‖γ (n + ℓ * (r : ℤ))‖) ^ 2 := by
          simp only [b, norm_mul, norm_star]
        _ ≤ (W * W) ^ 2 := pow_le_pow_left₀ (by positivity)
          (mul_le_mul (hγ n) (hγ _) (norm_nonneg _) hW) 2
        _ = _ := by ring
    calc
      (∑ n ∈ S, ‖b n‖ ^ 2) =
          ∑ n ∈ γ.support,
            if sourceCompatibility r q₀ b₁ b₂ ℓ n = 1 then ‖b n‖ ^ 2 else 0 := by
        dsimp only [S]
        rw [Finset.sum_filter]
        symm
        apply Finset.sum_subset Finset.subset_union_left
        intro n _ hn
        simp only [hbzero n hn, norm_zero, zero_pow (by decide : 2 ≠ 0), ite_self]
      _ ≤ ∑ n ∈ γ.support,
          if sourceCompatibility r q₀ b₁ b₂ ℓ n = 1 then W ^ 4 else 0 := by
        apply Finset.sum_le_sum
        intro n _
        split_ifs
        · exact hb n
        · exact le_refl _
      _ = ∑ n ∈ β.support,
          if sourceCompatibility r q₀ b₁ b₂ ℓ (n : ℤ) = 1 then W ^ 4 else 0 := by
        simp [γ]
      _ ≤ ∑ n ∈ Finset.Icc 1 N₀,
          if sourceCompatibility r q₀ b₁ b₂ ℓ (n : ℤ) = 1 then W ^ 4 else 0 :=
        Finset.sum_le_sum_of_subset_of_nonneg hβsupport
          (fun _ _ _ => ite_nonneg (pow_nonneg hW 4) le_rfl)
      _ = (((Finset.Icc 1 N₀).filter (fun n : ℕ =>
          sourceCompatibility r q₀ b₁ b₂ ℓ (n : ℤ) = 1)).card : ℝ) * W ^ 4 := by
        rw [← Finset.sum_filter, Finset.sum_const, nsmul_eq_mul]
      _ ≤ _ := mul_le_mul_of_nonneg_right
        (sourceCompatibility_fixed_shift_count_le q₀ r b₁ b₂ N₀ ℓ hb₁
          (Nat.coprime_of_squarefree_mul hrq)) (pow_nonneg hW 4)
  let Ψ : ℝ → ℂ := fun t => (ψ t : ℂ)
  have hΨ : ContDiff ℝ 1 Ψ := Complex.ofRealCLM.contDiff.comp hψ
  have hΨsupport : Function.support Ψ ⊆ Set.Icc (-T) T :=
    (Function.support_comp_subset Complex.ofReal_zero ψ).trans hψsupport
  have hderiv : deriv Ψ = fun t => ((deriv ψ t : ℝ) : ℂ) := by
    funext t
    exact ((hψ.differentiable (by norm_num) t).hasDerivAt.ofReal_comp).deriv
  have hgram (q s : ℕ × ℕ) :
      (∑ n ∈ S, (χ n : ℂ) * f q n * star (f s n)) =
        ∑ h ∈ J, ∑ k ∈ J, c q h * star (c s k) *
          ∑ n ∈ I, (χ n : ℂ) * (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
            (sourceTheta r q₀ 1 q.1 q.2 a b₁ b₂ ℓ n h *
              star (sourceTheta r q₀ 1 s.1 s.2 a b₁ b₂ ℓ n k)) := by
    calc
      _ = ∑ n ∈ K, (χ n : ℂ) * (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
          f q n * star (f s n) := by
        dsimp only [S]
        rw [Finset.sum_filter]
        apply Finset.sum_congr rfl
        intro n _
        rcases hcompat n with hn | hn <;> simp [hn]
      _ = ∑ n ∈ I, (χ n : ℂ) * (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
          f q n * star (f s n) := by
        symm
        apply Finset.sum_subset Finset.subset_union_right
        intro n _ hn
        simp only [hχzero n hn, Complex.ofReal_zero, zero_mul]
      _ = ∑ n ∈ I, ∑ h ∈ J, ∑ k ∈ J,
          c q h * star (c s k) *
            ((χ n : ℂ) * (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
              (sourceTheta r q₀ 1 q.1 q.2 a b₁ b₂ ℓ n h *
                star (sourceTheta r q₀ 1 s.1 s.2 a b₁ b₂ ℓ n k))) := by
        simp only [f, star_sum, star_mul, Finset.mul_sum,
          mul_assoc, mul_left_comm, mul_comm]
        apply Finset.sum_congr rfl
        intro n _
        exact Finset.sum_comm
      _ = _ := by
        rw [← Finset.sum_comm_cycle]
        simp only [Finset.mul_sum]
  have hconsume (E : (ℕ × ℕ) → (ℕ × ℕ) → ℤ → ℤ → ℝ)
      (hpair : ∀ q ∈ F, ∀ s ∈ F, ∀ h k : ℤ,
        ‖∑ n ∈ I, (χ n : ℂ) * (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
          (sourceTheta r q₀ 1 q.1 q.2 a b₁ b₂ ℓ n h *
            star (sourceTheta r q₀ 1 s.1 s.2 a b₁ b₂ ℓ n k))‖ ≤
              C * (g : ℝ) * E q s h k) :
      V ≤ C * W ^ 4 * (g : ℝ) ^ 2 * (1 + (N₀ : ℝ) / (q₀ : ℝ)) * L ^ 2 *
        ∑ q ∈ F, ∑ s ∈ F, ∑ h ∈ J, ∑ k ∈ J, E q s h k := by
    have hgrambound (q : ℕ × ℕ) (hq : q ∈ F) (s : ℕ × ℕ) (hs : s ∈ F) :
        ‖∑ n ∈ S, (χ n : ℂ) * f q n * star (f s n)‖ ≤
          L ^ 2 * C * (g : ℝ) * ∑ h ∈ J, ∑ k ∈ J, E q s h k := by
      rw [hgram]
      conv_rhs => simp only [Finset.mul_sum]
      refine norm_sum_le_of_le _ (fun h hh => ?_)
      refine norm_sum_le_of_le _ (fun k hk => ?_)
      have hcoeff : ‖c q h * star (c s k)‖ ≤ L ^ 2 := by
        simpa only [norm_mul, norm_star, pow_two] using
          mul_le_mul (hc q hq h hh) (hc s hs k hk) (norm_nonneg _) hL
      calc
        _ = ‖c q h * star (c s k)‖ * ‖∑ n ∈ I,
            (χ n : ℂ) * (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
              (sourceTheta r q₀ 1 q.1 q.2 a b₁ b₂ ℓ n h *
                star (sourceTheta r q₀ 1 s.1 s.2 a b₁ b₂ ℓ n k))‖ := norm_mul _ _
        _ ≤ L ^ 2 * (C * (g : ℝ) * E q s h k) :=
          mul_le_mul hcoeff (hpair q hq s hs h k) (norm_nonneg _) (sq_nonneg _)
        _ = _ := by ring
    have henergy : (∑ q ∈ F, ∑ s ∈ F,
        ‖∑ n ∈ S, (χ n : ℂ) * f q n * star (f s n)‖) ≤
          L ^ 2 * C * (g : ℝ) * ∑ q ∈ F, ∑ s ∈ F, ∑ h ∈ J, ∑ k ∈ J, E q s h k := by
      calc
        _ ≤ ∑ q ∈ F, ∑ s ∈ F,
            L ^ 2 * C * (g : ℝ) * ∑ h ∈ J, ∑ k ∈ J, E q s h k :=
          Finset.sum_le_sum fun q hq => Finset.sum_le_sum fun s hs => hgrambound q hq s hs
        _ = _ := by simp only [Finset.mul_sum]
    have hcs := sourceTheta_finite_weighted_cauchy F S b f χ
      (fun n _ => hψnonneg _) hmajor
    change (∑ q ∈ F, ‖∑ n ∈ γ.support,
      b n * (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) * f q n‖) ^ 2 ≤ _
    simp_rw [hleft]
    calc
      _ ≤ (∑ n ∈ S, ‖b n‖ ^ 2) * ∑ q ∈ F, ∑ s ∈ F,
          ‖∑ n ∈ S, (χ n : ℂ) * f q n * star (f s n)‖ := hcs
      _ ≤ ((g : ℝ) * (1 + (N₀ : ℝ) / (q₀ : ℝ)) * W ^ 4) *
          (L ^ 2 * C * (g : ℝ) * ∑ q ∈ F, ∑ s ∈ F, ∑ h ∈ J, ∑ k ∈ J, E q s h k) :=
        mul_le_mul hmoment henergy (by positivity) (by positivity)
      _ = _ := by ring
  have hΨbound (q s : ℕ × ℕ) : ∀ t : ℝ,
      ‖Ψ t‖ ≤ A₀ * (Real.log (2 * (P q s : ℝ) * N)) ^ (0 : ℝ) ∧
      ‖deriv Ψ t‖ ≤ A₁ * (Real.log (2 * (P q s : ℝ) * N)) ^ (0 : ℝ) := by
    intro t
    simpa only [Ψ, hderiv, Complex.norm_real, Real.norm_eq_abs,
      Real.rpow_zero, mul_one] using hψbound t
  constructor
  · apply hconsume
    intro q hq s hs h k
    have hh := (hcorr r q₀ q.1 q.2 s.1 s.2 a b₁ b₂
      (hF q hq) (hF s hs) ha hb₁ ℓ h k N t₀ hN (hNP q hq s hs)
      Ψ hΨ hΨsupport (hΨbound q s)).2.1
    change _ ≤ C * (P q s : ℝ) ^ ε * (g : ℝ) * _ at hh
    calc
      _ ≤ C * (P q s : ℝ) ^ ε * (g : ℝ) * _ := hh
      _ = _ := by ring
  · intro Y hY
    apply hconsume
    intro q hq s hs h k
    have hh := (hcorr r q₀ q.1 q.2 s.1 s.2 a b₁ b₂
      (hF q hq) (hF s hs) ha hb₁ ℓ h k N t₀ hN (hNP q hq s hs)
      Ψ hΨ hΨsupport (hΨbound q s)).2.2 Y
        (hY q hq).1 (hY q hq).2 (hY s hs).1 (hY s hs).2
    change _ ≤ C * (P q s : ℝ) ^ ε * (g : ℝ) * _ at hh
    calc
      _ ≤ C * (P q s : ℝ) ^ ε * (g : ℝ) * _ := hh
      _ = _ := by ring

open Classical in
theorem sourceTheta_near_typeII_uniform_power_saving
    («ω» δ ε C T TN A₀ A₁ L : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε)
    (hworking : 72 * «ω» + 24 * δ < 1)
    (hsmall : ε < δ / 10 ^ 100)
    (hC : 1 ≤ C) (hT : 1 ≤ T) (hTN : 1 ≤ TN)
    (hA₀ : 0 ≤ A₀) (hA₁ : 0 ≤ A₁) (hL : 0 ≤ L) :
    ∃ K X : ℝ, 0 < K ∧ 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ M N R Q H γ : ℝ,
        0 < M → 0 < N → 0 < R → 0 < Q →
        x / C ≤ M * N → N = x ^ γ →
        N ≤ C * x ^ (δ + 4 * ε) * R →
        R ≤ C * x ^ (-2 * ε) * N →
        R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) →
        1 / 2 - 2 * «ω» - δ / 2 ≤ γ → γ ≤ 1 / 2 →
      ∀ r q₀ a b₁ b₂ : ℕ,
        R ≤ (r : ℝ) → (r : ℝ) ≤ 2 * R →
        H = x ^ ε * R * Q ^ 2 / ((q₀ : ℝ) * M) → 1 ≤ H →
      ∀ (F : Finset (ℕ × ℕ)) (J : Finset ℤ),
        (∀ q ∈ F,
          Squarefree (r * q₀ * q.1 * q.2) ∧
          Q ≤ (q₀ * q.1 : ℕ) ∧ (q₀ * q.1 : ℕ) ≤ 2 * Q ∧
          Q ≤ (q₀ * q.2 : ℕ) ∧ (q₀ * q.2 : ℕ) ≤ 2 * Q) →
        (∀ h ∈ J, h ≠ 0 ∧ |(h : ℝ)| ≤ 2 * H) →
        Nat.Coprime a r → Nat.Coprime b₁ q₀ →
      ∀ (ℓ : ℤ) (t₀ : ℝ) (ψ : ℝ → ℝ),
        ContDiff ℝ 1 ψ → Function.support ψ ⊆ Set.Icc (-T) T →
        (∀ t : ℝ, 0 ≤ ψ t) →
        (∀ t : ℝ, |ψ t| ≤ A₀ ∧ |deriv ψ t| ≤ A₁) →
      ∀ (β : ℕ →₀ ℂ), β.support ⊆ Finset.Icc 1 ⌊TN * N⌋₊ →
        (∀ n ∈ β.support, ‖β n‖ ≤ x ^ (ε / 100)) →
        (∀ n ∈ β.support, 1 ≤ ψ (((n : ℝ) - t₀) / N)) →
      ∀ (c : (ℕ × ℕ) → ℤ → ℂ),
        (∀ q ∈ F, ∀ h ∈ J, ‖c q h‖ ≤ L) →
      let βℤ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
      (∑ q ∈ F, ‖∑ n ∈ βℤ.support,
        βℤ n * star (βℤ (n + ℓ * (r : ℤ))) *
          (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
          ∑ h ∈ J, c q h * sourceTheta r q₀ 1 q.1 q.2 a b₁ b₂ ℓ n h‖) ≤
        K * Q ^ 2 * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) / (q₀ : ℝ) ^ 2 *
          x ^ (-ε / 4) := by
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hTNpos : 0 < TN := zero_lt_one.trans_le hTN
  have hεsmall : ε ≤ 1 / 100 := by
    have hp : (1000 : ℝ) ≤ 10 ^ 100 := by norm_num
    have hs := (lt_div_iff₀ (by positivity : (0 : ℝ) < 10 ^ 100)).mp hsmall
    nlinarith only [hp, hs, hworking, hω, hε, hδ]
  have hδsmall : δ + 4 * ε ≤ 1 / 12 := by
    have hp : (1000 : ℝ) ≤ 10 ^ 100 := by norm_num
    have hs := (lt_div_iff₀ (by positivity : (0 : ℝ) < 10 ^ 100)).mp hsmall
    nlinarith only [hp, hs, hworking, hω, hε, hδ]
  have hRQexponent : 1 / 2 + 2 * «ω» + ε ≤ 7 / 12 := by
    linarith only [hworking, hδ, hεsmall]
  obtain ⟨C₀, hC₀, hphase⟩ := sourceTheta_pair_finite_cauchy_bounds
    T A₀ A₁ 3 (ε / 1000) hT hA₀ hA₁ (by positivity)
  obtain ⟨Xg, hXg, hgcd⟩ := sourceSignedProduct_pair_gcd_sum_uniform
    10 (ε / 100) (by norm_num) (by positivity)
  obtain ⟨Xc, hXc⟩ := Filter.eventually_atTop.mp
    ((tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 100)).eventually_ge_atTop (100 * C))
  let K := Real.sqrt (2600 * C₀ * (1 + TN) * L ^ 2 * C ^ 12 + 1)
  have hK : 0 < K := by dsimp only [K]; positivity
  refine ⟨K, max 1 (max Xg Xc), hK, le_max_left _ _, ?_⟩
  intro x hx M N R Q H γ hM hN hR hQ hMN hNγ hNR hRN hRQ hγlo hγhi
    r q₀ a b₁ b₂ hRr hrR hH hHone F J hF hJ ha hb₁ ℓ t₀ ψ hψ hψs hψ0 hψb
    β hβs hβ hψmajor c hc βℤ
  have hxone : 1 ≤ x := (le_max_left _ _).trans hx
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  have hxg : Xg ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans hx)
  have hxc : Xc ≤ x := (le_max_right _ _).trans ((le_max_right _ _).trans hx)
  have hxlarge : 100 * C ≤ x ^ (1 / 100 : ℝ) := hXc x hxc
  by_cases hFempty : F = ∅
  · simp only [hFempty, Finset.sum_empty]
    positivity
  have hγlower : 5 / 12 ≤ γ := by linarith only [hγlo, hworking, hω, hδ]
  let P : (ℕ × ℕ) → (ℕ × ℕ) → ℕ := fun t s =>
    Nat.lcm (r * q₀ * t.1 * t.2) (r * q₀ * s.1 * s.2)
  let HN : ℕ := ⌊2 * H⌋₊
  let KN : ℕ := ⌊4 * Q ^ 2 / (q₀ : ℝ) ^ 2⌋₊
  obtain ⟨hq₀, hq₀N, hrx, hPbounds, hJcard, hFcard, hHK, hHKx, hJnat, hFnat⟩ :=
    sourceHighGamma_near_geometry «ω» δ ε C x M N R Q H γ r q₀ F J
      hC hxone hxlarge hε hεsmall hδsmall hRQexponent hM hN hR hQ
      hMN hNγ hNR hRN hRQ hγlower hγhi hRr hrR hH hHone
      (Finset.nonempty_iff_ne_empty.mpr hFempty) hF hJ
  have hq₀R : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀
  have hq₀one : 1 ≤ (q₀ : ℝ) := by exact_mod_cast hq₀
  have hrpos : 0 < (r : ℝ) := hR.trans_le hRr
  have hrnat : 0 < r := by exact_mod_cast hrpos
  have hHpos : 0 < H := zero_lt_one.trans_le hHone
  have hPscale (t : ℕ × ℕ) (ht : t ∈ F) (s : ℕ × ℕ) (hs : s ∈ F) :
      N ≤ (P t s : ℝ) ^ (3 : ℝ) ∧ (P t s : ℝ) ≤ x ^ (10 : ℝ) :=
    ⟨(hPbounds t ht s hs).1, (hPbounds t ht s hs).2.1⟩
  have hPsqrt (t : ℕ × ℕ) (ht : t ∈ F) (s : ℕ × ℕ) (hs : s ∈ F) :
      Real.sqrt ((P t s / q₀ : ℕ) : ℝ) ≤ 6 * Real.sqrt R * Q ^ 2 / (q₀ : ℝ) ^ 2 :=
    (hPbounds t ht s hs).2.2
  let D : ℝ := x ^ (ε / 100)
  have hDpos : 0 < D := Real.rpow_pos_of_pos hxpos _
  have hDone : 1 ≤ D := Real.one_le_rpow hxone (by positivity)
  have hPε (t : ℕ × ℕ) (ht : t ∈ F) (s : ℕ × ℕ) (hs : s ∈ F) :
      (P t s : ℝ) ^ (ε / 1000) ≤ D := by
    calc
      _ ≤ (x ^ (10 : ℝ)) ^ (ε / 1000) :=
        Real.rpow_le_rpow (Nat.cast_nonneg _) (hPscale t ht s hs).2 (by positivity)
      _ = D := by rw [← Real.rpow_mul hxpos.le]; congr 1; ring
  let G : ℝ := ∑ t ∈ F, ∑ s ∈ F, ∑ h ∈ J, ∑ k ∈ J,
    (Int.gcd (r : ℤ) (h * (s.1 : ℤ) * (s.2 : ℤ) -
      k * (t.1 : ℤ) * (t.2 : ℤ)) : ℝ)
  have hG : G ≤ D * (5 * H) * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) *
      (8 * H * Q ^ 2 / (q₀ : ℝ) ^ 2 + 2 * R) := by
    have hraw := hgcd x hxg r HN KN hrnat hrx hHKx J F hJnat hFnat
    have heq : G = ∑ h ∈ J, ∑ s ∈ F, ∑ k ∈ J, ∑ t ∈ F,
        (Int.gcd (h * (s.1 : ℤ) * (s.2 : ℤ) -
          k * (t.1 : ℤ) * (t.2 : ℤ)) (r : ℤ) : ℝ) := by
      calc
        G = ∑ s ∈ F, ∑ t ∈ F, ∑ h ∈ J, ∑ k ∈ J,
            (Int.gcd (r : ℤ) (h * (s.1 : ℤ) * (s.2 : ℤ) -
              k * (t.1 : ℤ) * (t.2 : ℤ)) : ℝ) := Finset.sum_comm
        _ = ∑ s ∈ F, ∑ h ∈ J, ∑ k ∈ J, ∑ t ∈ F,
            (Int.gcd (r : ℤ) (h * (s.1 : ℤ) * (s.2 : ℤ) -
              k * (t.1 : ℤ) * (t.2 : ℤ)) : ℝ) := by
          apply Finset.sum_congr rfl
          intro s _
          exact Finset.sum_comm_cycle.symm
        _ = ∑ h ∈ J, ∑ s ∈ F, ∑ k ∈ J, ∑ t ∈ F,
            (Int.gcd (r : ℤ) (h * (s.1 : ℤ) * (s.2 : ℤ) -
              k * (t.1 : ℤ) * (t.2 : ℤ)) : ℝ) := Finset.sum_comm
        _ = _ := by simp only [Int.gcd_comm]
    rw [heq]
    apply hraw.trans
    change D * (J.card : ℝ) * (F.card : ℝ) * ((HN : ℝ) * (KN : ℝ) + (r : ℝ)) ≤ _
    gcongr
  let B : ℝ := 6 * Real.sqrt R * Q ^ 2 / (q₀ : ℝ) ^ 2
  let A : ℝ := (N / (q₀ : ℝ) / (r : ℝ))
  let E : ℝ := ∑ t ∈ F, ∑ s ∈ F, ∑ h ∈ J, ∑ k ∈ J,
    (P t s : ℝ) ^ (ε / 1000) *
      (Real.sqrt ((P t s / q₀ : ℕ) : ℝ) +
        (N / (q₀ : ℝ)) *
          ((Int.gcd (r : ℤ) (h * (s.1 : ℤ) * (s.2 : ℤ) -
            k * (t.1 : ℤ) * (t.2 : ℤ)) : ℝ) / (r : ℝ)))
  have hEsum : E ≤ D *
      ((J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * B + A * G) := by
    calc
      E ≤ ∑ t ∈ F, ∑ s ∈ F, ∑ h ∈ J, ∑ k ∈ J,
          D * (B + A * (Int.gcd (r : ℤ)
            (h * (s.1 : ℤ) * (s.2 : ℤ) -
              k * (t.1 : ℤ) * (t.2 : ℤ)) : ℝ)) := by
        apply Finset.sum_le_sum
        intro t ht
        apply Finset.sum_le_sum
        intro s hs
        apply Finset.sum_le_sum
        intro h _
        apply Finset.sum_le_sum
        intro k _
        apply mul_le_mul (hPε t ht s hs) ?_ (by positivity) hDpos.le
        have hh := hPsqrt t ht s hs
        simpa only [A, B, div_eq_mul_inv, mul_assoc, mul_left_comm, mul_comm, add_comm] using
          add_le_add_right hh ((N / (q₀ : ℝ)) *
            ((Int.gcd (r : ℤ) (h * (s.1 : ℤ) * (s.2 : ℤ) -
              k * (t.1 : ℤ) * (t.2 : ℤ)) : ℝ) / (r : ℝ)))
      _ = _ := sourceHighGamma_four_sum_affine F J D B A
        (fun t s h k => (Int.gcd (r : ℤ)
          (h * (s.1 : ℤ) * (s.2 : ℤ) - k * (t.1 : ℤ) * (t.2 : ℤ)) : ℝ))
  have hEbound : E ≤ D ^ 2 *
      ((5 * H) ^ 2 * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) ^ 2 * B +
        A * (5 * H) * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) *
          (8 * H * Q ^ 2 / (q₀ : ℝ) ^ 2 + 2 * R)) := by
    apply hEsum.trans
    have hB0 : 0 ≤ B := by dsimp only [B]; positivity
    have hA0 : 0 ≤ A := by dsimp only [A]; positivity
    have hcards : (J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * B ≤
        (5 * H) ^ 2 * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) ^ 2 * B :=
      mul_le_mul_of_nonneg_right
        (mul_le_mul (pow_le_pow_left₀ (Nat.cast_nonneg _) hJcard 2)
          (pow_le_pow_left₀ (Nat.cast_nonneg _) hFcard 2) (sq_nonneg _) (sq_nonneg _)) hB0
    calc
      D * ((J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * B + A * G) ≤
          D * ((5 * H) ^ 2 * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) ^ 2 * B +
            A * (D * (5 * H) * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) *
              (8 * H * Q ^ 2 / (q₀ : ℝ) ^ 2 + 2 * R))) :=
        mul_le_mul_of_nonneg_left
          (add_le_add hcards (mul_le_mul_of_nonneg_left hG hA0)) hDpos.le
      _ ≤ D * (D *
          ((5 * H) ^ 2 * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) ^ 2 * B +
            A * (5 * H) * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) *
              (8 * H * Q ^ 2 / (q₀ : ℝ) ^ 2 + 2 * R))) := by
        have hh : (5 * H) ^ 2 * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) ^ 2 * B ≤
            D * ((5 * H) ^ 2 * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) ^ 2 * B) :=
          le_mul_of_one_le_left (by positivity) hDone
        nlinarith only [mul_le_mul_of_nonneg_left hh hDpos.le]
      _ = _ := by ring
  let U : ℝ := ∑ t ∈ F, ‖∑ n ∈ βℤ.support,
    βℤ n * star (βℤ (n + ℓ * (r : ℤ))) *
      (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
      ∑ h ∈ J, c t h * sourceTheta r q₀ 1 t.1 t.2 a b₁ b₂ ℓ n h‖
  let g : ℝ := (Int.gcd (q₀ : ℤ) ℓ : ℝ)
  let Z : ℝ := Q ^ 2 * N * g / (q₀ : ℝ) ^ 2
  have hU : 0 ≤ U := by dsimp only [U]; positivity
  have hg : 0 ≤ g := Nat.cast_nonneg _
  have hZ : 0 ≤ Z := by dsimp only [Z]; positivity
  have hraw := (hphase r q₀ a b₁ b₂ ⌊TN * N⌋₊ F J
    (fun t ht => (hF t ht).1) ha hb₁ ℓ N t₀ D L hq₀N hDpos.le hL
    (fun t ht s hs => (hPscale t ht s hs).1) ψ hψ hψs hψ0 hψb
    β hβs hβ hψmajor c hc).1
  change U ^ 2 ≤ C₀ * D ^ 4 * g ^ 2 *
    (1 + (⌊TN * N⌋₊ : ℝ) / (q₀ : ℝ)) * L ^ 2 * E at hraw
  have hmass : 1 + (⌊TN * N⌋₊ : ℝ) / (q₀ : ℝ) ≤ (1 + TN) * N / (q₀ : ℝ) := by
    have hf := Nat.floor_le (show 0 ≤ TN * N by positivity)
    calc
      _ ≤ N / (q₀ : ℝ) + (TN * N) / (q₀ : ℝ) :=
        add_le_add ((one_le_div hq₀R).mpr hq₀N)
          (div_le_div_of_nonneg_right hf hq₀R.le)
      _ = _ := by ring
  have hscale := (sourceHighGamma_scale_envelopes «ω» δ ε C x M N R Q H
    (q₀ : ℝ) γ hω hδ hε hworking hsmall hC hxone hM hN hR hQ hq₀one
    hMN hNγ hNR hRN hRQ hH hγhi).1 hγlo
  rw [← Real.sqrt_eq_rpow] at hscale
  have hnormalized := sourceHighGamma_normalized_completion_envelope
    H N R Q (r : ℝ) (q₀ : ℝ) (C ^ 12 * x ^ (-ε)) hHpos.le hN hR hQ hRr hq₀one
      hscale.1 hscale.2.1 hscale.2.2
  have hE0 : 0 ≤ E := by dsimp only [E]; positivity
  have hUfinal : U ^ 2 ≤
      (2600 * C₀ * (1 + TN) * L ^ 2 * C ^ 12) * Z ^ 2 * D ^ 6 * x ^ (-ε) := by
    apply hraw.trans
    calc
      C₀ * D ^ 4 * g ^ 2 * (1 + (⌊TN * N⌋₊ : ℝ) / (q₀ : ℝ)) * L ^ 2 * E ≤
          C₀ * D ^ 4 * g ^ 2 * ((1 + TN) * N / (q₀ : ℝ)) * L ^ 2 *
            (D ^ 2 * ((5 * H) ^ 2 * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) ^ 2 * B +
              A * (5 * H) * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) *
                (8 * H * Q ^ 2 / (q₀ : ℝ) ^ 2 + 2 * R))) := by
        gcongr
      _ = (C₀ * (1 + TN) * L ^ 2 * g ^ 2 * D ^ 6) *
          ((N / (q₀ : ℝ)) *
            ((5 * H) ^ 2 * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) ^ 2 * B +
              A * (5 * H) * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) *
                (8 * H * Q ^ 2 / (q₀ : ℝ) ^ 2 + 2 * R))) := by ring
      _ ≤ (C₀ * (1 + TN) * L ^ 2 * g ^ 2 * D ^ 6) *
          (2600 * (Q ^ 2 * N / (q₀ : ℝ) ^ 2) ^ 2 * (C ^ 12 * x ^ (-ε))) :=
        mul_le_mul_of_nonneg_left hnormalized (by positivity)
      _ = _ := by dsimp only [Z]; ring
  have hpower : D ^ 6 * x ^ (-ε) ≤ x ^ (-ε / 2) := by
    calc
      D ^ 6 * x ^ (-ε) = x ^ (6 * (ε / 100) - ε) := by
        dsimp only [D]
        rw [← Real.rpow_mul_natCast hxpos.le, ← Real.rpow_add hxpos]
        congr 1
        ring
      _ ≤ x ^ (-ε / 2) := Real.rpow_le_rpow_of_exponent_le hxone (by linarith only [hε])
  have hKsq : K ^ 2 = 2600 * C₀ * (1 + TN) * L ^ 2 * C ^ 12 + 1 := by
    exact Real.sq_sqrt (by positivity)
  have hsq : U ^ 2 ≤ (K * Z * x ^ (-ε / 4)) ^ 2 := by
    calc
      U ^ 2 ≤ (2600 * C₀ * (1 + TN) * L ^ 2 * C ^ 12) * Z ^ 2 *
          (D ^ 6 * x ^ (-ε)) := by simpa only [mul_assoc] using hUfinal
      _ ≤ K ^ 2 * Z ^ 2 * x ^ (-ε / 2) := by
        gcongr
        · rw [hKsq]
          linarith
      _ = _ := by
        rw [mul_pow, mul_pow, ← Real.rpow_mul_natCast hxpos.le]
        congr 1
        ring_nf
  have hfinal : U ≤ K * Z * x ^ (-ε / 4) :=
    (sq_le_sq₀ hU (by positivity)).mp hsq
  change U ≤ _
  convert hfinal using 1
  dsimp only [Z, g]
  ring

open Classical in
theorem sourceTheta_split_fiber_dense_cauchy_bound
    (T A₀ A₁ κ η : ℝ)
    (hT : 1 ≤ T) (hA₀ : 0 ≤ A₀) (hA₁ : 0 ≤ A₁)
    (hκ : 0 < κ) (hη : 0 < η) :
    ∃ C X : ℝ, 0 < C ∧ 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ r q₀ u q₂ a b₁ b₂ N₀ H K : ℕ,
        0 < r → 0 < q₀ → 0 < u → 0 < q₂ →
        (r : ℝ) ≤ x ^ κ → (H : ℝ) * (K : ℝ) ≤ x ^ κ →
        (r : ℝ) * (q₀ : ℝ) * (u : ℝ) * (K : ℝ) ^ 2 * (q₂ : ℝ) ≤ x ^ κ →
      ∀ (F : Finset ℕ) (J : Finset ℤ),
        (∀ v ∈ F, 0 < v ∧ v ≤ K ∧ Squarefree (r * q₀ * (u * v) * q₂)) →
        (∀ h ∈ J, h ≠ 0 ∧ -(H : ℤ) ≤ h ∧ h ≤ (H : ℤ)) →
        Nat.Coprime a r → Nat.Coprime b₁ q₀ →
      ∀ (ℓ : ℤ) (N t₀ W L : ℝ),
        (q₀ : ℝ) ≤ N → N ≤ (r : ℝ) ^ (3 : ℝ) → 0 ≤ W → 0 ≤ L →
      ∀ (Y : Set.Ici (1 : ℝ)),
        (∀ v ∈ F,
          Nonempty (DenseDivisibilityWitness
            Y 1 (r * q₀ * (u * v))) ∧
          Nonempty (DenseDivisibilityWitness
            Y 1 (r * q₀ * q₂))) →
      ∀ (ψ : ℝ → ℝ), ContDiff ℝ 1 ψ →
        Function.support ψ ⊆ Set.Icc (-T) T →
        (∀ t : ℝ, 0 ≤ ψ t) →
        (∀ t : ℝ, |ψ t| ≤ A₀ ∧ |deriv ψ t| ≤ A₁) →
      ∀ (β : ℕ →₀ ℂ), β.support ⊆ Finset.Icc 1 N₀ →
        (∀ n ∈ β.support, ‖β n‖ ≤ W) →
        (∀ n ∈ β.support, 1 ≤ ψ (((n : ℝ) - t₀) / N)) →
      ∀ (c : ℕ → ℤ → ℂ), (∀ v ∈ F, ∀ h ∈ J, ‖c v h‖ ≤ L) →
      let βℤ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
      let P₀ : ℝ := (r : ℝ) * (q₀ : ℝ) * (u : ℝ) * (K : ℝ) ^ 2 * (q₂ : ℝ)
      (∑ v ∈ F, ‖∑ n ∈ βℤ.support,
        βℤ n * star (βℤ (n + ℓ * (r : ℤ))) *
          (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
          ∑ h ∈ J, c v h * sourceTheta r q₀ 1 (u * v) q₂ a b₁ b₂ ℓ n h‖) ^ 2 ≤
        C * W ^ 4 * (Int.gcd (q₀ : ℤ) ℓ : ℝ) ^ 2 *
          (1 + (N₀ : ℝ) / (q₀ : ℝ)) * L ^ 2 * x ^ η *
          ((J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 *
              (Real.sqrt (N / (q₀ : ℝ)) * (P₀ * (Y : ℝ)) ^ (1 / 6 : ℝ)) +
            (N / (q₀ : ℝ) / (r : ℝ)) *
              (x ^ η * (J.card : ℝ) * (F.card : ℝ) *
                ((H : ℝ) * (K : ℝ) + (r : ℝ)))) := by
  obtain ⟨C, hC, hphase⟩ := sourceTheta_pair_finite_cauchy_bounds
    T A₀ A₁ 3 (η / κ) hT hA₀ hA₁ (div_pos hη hκ)
  obtain ⟨X, hX, hgcd⟩ := sourceSignedProduct_pair_gcd_sum_uniform κ η hκ hη
  refine ⟨C, X, hC, hX, ?_⟩
  intro x hx r q₀ u q₂ a b₁ b₂ N₀ H K hr hq₀ hu hq₂ hrx hHKx hP₀x
    F J hF hJ ha hb₁ ℓ N t₀ W L hN hNr hW hL Y hY ψ hψ hψs hψ0 hψb
    β hβs hβ hψmajor c hc βℤ P₀
  have hxone : 1 ≤ x := hX.trans hx
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  have hrpos : 0 < (r : ℝ) := by exact_mod_cast hr
  have hq₀pos : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀
  have hNpos : 0 < N := hq₀pos.trans_le hN
  have hYpos : 0 < (Y : ℝ) := zero_lt_one.trans_le Y.property
  by_cases hFempty : F = ∅
  · simp only [hFempty, Finset.sum_empty, zero_pow (by decide : 2 ≠ 0),
      Finset.card_empty, Nat.cast_zero, zero_mul, mul_zero, add_zero, le_refl]
  obtain ⟨v₀, hv₀⟩ := Finset.nonempty_iff_ne_empty.mpr hFempty
  have hK : 0 < K := (hF v₀ hv₀).1.trans_le (hF v₀ hv₀).2.1
  have hP₀pos : 0 < P₀ := by dsimp only [P₀]; positivity
  let f : ℕ → ℕ × ℕ := fun v => (u * v, q₂)
  let Fq : Finset (ℕ × ℕ) := F.image f
  have hfinj : Function.Injective f := by
    intro v w hvw
    exact Nat.eq_of_mul_eq_mul_left hu (congrArg Prod.fst hvw)
  have hsum (g : (ℕ × ℕ) → ℝ) :
      (∑ q ∈ Fq, g q) = ∑ v ∈ F, g (f v) :=
    Finset.sum_image (fun _ _ _ _ hvw => hfinj hvw)
  have hFq (q : ℕ × ℕ) (hq : q ∈ Fq) : Squarefree (r * q₀ * q.1 * q.2) := by
    obtain ⟨v, hv, rfl⟩ := Finset.mem_image.mp hq
    exact (hF v hv).2.2
  have hYq (q : ℕ × ℕ) (hq : q ∈ Fq) :
      Nonempty (DenseDivisibilityWitness Y 1 (r * q₀ * q.1)) ∧
      Nonempty (DenseDivisibilityWitness Y 1 (r * q₀ * q.2)) := by
    obtain ⟨v, hv, rfl⟩ := Finset.mem_image.mp hq
    exact hY v hv
  let P : ℕ → ℕ → ℕ := fun v w =>
    Nat.lcm (r * q₀ * (u * v) * q₂) (r * q₀ * (u * w) * q₂)
  have hP (v : ℕ) (hv : v ∈ F) (w : ℕ) (hw : w ∈ F) :
      0 < P v w ∧ (r : ℝ) ≤ (P v w : ℝ) ∧ (P v w : ℝ) ≤ P₀ := by
    have hvpos : 0 < v := (hF v hv).1
    have hwpos : 0 < w := (hF w hw).1
    have hp : 0 < P v w := Nat.pos_of_ne_zero
      (Nat.lcm_ne_zero (hF v hv).2.2.ne_zero (hF w hw).2.2.ne_zero)
    have hdr : r ∣ P v w :=
      (show r ∣ r * q₀ * (u * v) * q₂ from ⟨q₀ * (u * v) * q₂, by ring⟩).trans
        (Nat.dvd_lcm_left _ _)
    have hdP : P v w ∣ r * q₀ * u * v * w * q₂ := by
      apply Nat.lcm_dvd
      · exact ⟨w, by ring⟩
      · exact ⟨v, by ring⟩
    refine ⟨hp, by exact_mod_cast Nat.le_of_dvd hp hdr, ?_⟩
    calc
      (P v w : ℝ) ≤ ((r * q₀ * u * v * w * q₂ : ℕ) : ℝ) := by
        exact_mod_cast Nat.le_of_dvd (by positivity) hdP
      _ = (r : ℝ) * (q₀ : ℝ) * (u : ℝ) * ((v : ℝ) * (w : ℝ)) * (q₂ : ℝ) := by
        push_cast
        ring
      _ ≤ P₀ := by
        dsimp only [P₀]
        rw [pow_two]
        exact mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left
            (mul_le_mul (Nat.cast_le.mpr (hF v hv).2.1)
              (Nat.cast_le.mpr (hF w hw).2.1) (Nat.cast_nonneg _) (Nat.cast_nonneg _))
            (by positivity)) (Nat.cast_nonneg q₂)
  have hNP (q : ℕ × ℕ) (hq : q ∈ Fq) (s : ℕ × ℕ) (hs : s ∈ Fq) :
      N ≤ (Nat.lcm (r * q₀ * q.1 * q.2) (r * q₀ * s.1 * s.2) : ℝ) ^ (3 : ℝ) := by
    obtain ⟨v, hv, rfl⟩ := Finset.mem_image.mp hq
    obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hs
    exact hNr.trans (Real.rpow_le_rpow hrpos.le (hP v hv w hw).2.1 (by norm_num))
  have hPη (v : ℕ) (hv : v ∈ F) (w : ℕ) (hw : w ∈ F) :
      (P v w : ℝ) ^ (η / κ) ≤ x ^ η := by
    calc
      _ ≤ (x ^ κ) ^ (η / κ) := Real.rpow_le_rpow (Nat.cast_nonneg _)
        ((hP v hv w hw).2.2.trans hP₀x) (div_nonneg hη.le hκ.le)
      _ = x ^ η := by rw [← Real.rpow_mul hxpos.le]; congr 1; field_simp
  have hcop : Int.gcd ((u * q₂ : ℕ) : ℤ) (r : ℤ) = 1 := by
    have hsf : Squarefree (r * (u * q₂)) := by
      have hh : Squarefree ((r * (u * q₂)) * (q₀ * v₀)) := by
        convert (hF v₀ hv₀).2.2 using 1
        ring
      exact hh.of_mul_left
    have hh := (Nat.coprime_of_squarefree_mul hsf).symm.gcd_eq_one
    simpa only [Int.gcd_natCast_natCast] using hh
  have hdet (v w : ℕ) (h k : ℤ) :
      Int.gcd (r : ℤ) (h * ((u * w : ℕ) : ℤ) * (q₂ : ℤ) -
        k * ((u * v : ℕ) : ℤ) * (q₂ : ℤ)) =
      Int.gcd (h * (w : ℤ) - k * (v : ℤ)) (r : ℤ) := by
    rw [Int.gcd_comm]
    have heq : h * ((u * w : ℕ) : ℤ) * (q₂ : ℤ) -
        k * ((u * v : ℕ) : ℤ) * (q₂ : ℤ) =
        ((u * q₂ : ℕ) : ℤ) * (h * (w : ℤ) - k * (v : ℤ)) := by push_cast; ring
    rw [heq, Int.gcd_mul_right_left_of_gcd_eq_one hcop]
  let F₁ : Finset (ℕ × ℕ) := F.image (fun v => (v, 1))
  have hsum₁ (g : (ℕ × ℕ) → ℝ) :
      (∑ q ∈ F₁, g q) = ∑ v ∈ F, g (v, 1) :=
    Finset.sum_image (fun _ _ _ _ hvw => congrArg Prod.fst hvw)
  have hcard₁ : F₁.card = F.card :=
    Finset.card_image_of_injective F (fun _ _ hvw => congrArg Prod.fst hvw)
  have hG₁ := hgcd x hx r H K hr hrx hHKx J F₁ hJ (by
    intro t ht
    obtain ⟨v, hv, rfl⟩ := Finset.mem_image.mp ht
    exact ⟨(hF v hv).1, by norm_num, by simpa using (hF v hv).2.1⟩)
  simp_rw [hsum₁] at hG₁
  simp only [Nat.cast_one, mul_one, hcard₁] at hG₁
  let G : ℝ := ∑ v ∈ F, ∑ w ∈ F, ∑ h ∈ J, ∑ k ∈ J,
    (Int.gcd (h * (w : ℤ) - k * (v : ℤ)) (r : ℤ) : ℝ)
  have hG : G ≤ x ^ η * (J.card : ℝ) * (F.card : ℝ) *
      ((H : ℝ) * (K : ℝ) + (r : ℝ)) := by
    have heq : G = ∑ h ∈ J, ∑ w ∈ F, ∑ k ∈ J, ∑ v ∈ F,
        (Int.gcd (h * (w : ℤ) - k * (v : ℤ)) (r : ℤ) : ℝ) := by
      calc
        G = ∑ w ∈ F, ∑ v ∈ F, ∑ h ∈ J, ∑ k ∈ J,
            (Int.gcd (h * (w : ℤ) - k * (v : ℤ)) (r : ℤ) : ℝ) := Finset.sum_comm
        _ = ∑ w ∈ F, ∑ h ∈ J, ∑ k ∈ J, ∑ v ∈ F,
            (Int.gcd (h * (w : ℤ) - k * (v : ℤ)) (r : ℤ) : ℝ) := by
          apply Finset.sum_congr rfl
          intro w _
          exact Finset.sum_comm_cycle.symm
        _ = _ := Finset.sum_comm
    rw [heq]
    exact hG₁
  let c' : (ℕ × ℕ) → ℤ → ℂ := fun q h => c (q.1 / u) h
  have hc' (q : ℕ × ℕ) (hq : q ∈ Fq) (h : ℤ) (hh : h ∈ J) : ‖c' q h‖ ≤ L := by
    obtain ⟨v, hv, rfl⟩ := Finset.mem_image.mp hq
    simpa only [c', f, Nat.mul_div_cancel_left _ hu] using hc v hv h hh
  have hraw := (hphase r q₀ a b₁ b₂ N₀ Fq J hFq ha hb₁ ℓ N t₀ W L
    hN hW hL hNP ψ hψ hψs hψ0 hψb β hβs hβ hψmajor c' hc').2 Y hYq
  simp_rw [hsum] at hraw
  simp only [f, c', Nat.mul_div_cancel_left _ hu] at hraw
  change _ ≤ C * W ^ 4 * (Int.gcd (q₀ : ℤ) ℓ : ℝ) ^ 2 *
    (1 + (N₀ : ℝ) / (q₀ : ℝ)) * L ^ 2 *
      ∑ v ∈ F, ∑ w ∈ F, ∑ h ∈ J, ∑ k ∈ J,
        (P v w : ℝ) ^ (η / κ) *
          (Real.sqrt (N / (q₀ : ℝ)) * ((P v w : ℝ) * (Y : ℝ)) ^ (1 / 6 : ℝ) +
            (N / (q₀ : ℝ)) * ((Int.gcd (r : ℤ)
              (h * ((u * w : ℕ) : ℤ) * (q₂ : ℤ) -
                k * ((u * v : ℕ) : ℤ) * (q₂ : ℤ)) : ℝ) / (r : ℝ))) at hraw
  simp_rw [hdet] at hraw
  let B : ℝ := Real.sqrt (N / (q₀ : ℝ)) * (P₀ * (Y : ℝ)) ^ (1 / 6 : ℝ)
  let A : ℝ := N / (q₀ : ℝ) / (r : ℝ)
  have hA : 0 ≤ A := by dsimp only [A]; positivity
  have hB : 0 ≤ B := by dsimp only [B]; positivity
  have hmain : (∑ v ∈ F, ‖∑ n ∈ βℤ.support,
      βℤ n * star (βℤ (n + ℓ * (r : ℤ))) *
        (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
        ∑ h ∈ J, c v h * sourceTheta r q₀ 1 (u * v) q₂ a b₁ b₂ ℓ n h‖) ^ 2 ≤
      C * W ^ 4 * (Int.gcd (q₀ : ℤ) ℓ : ℝ) ^ 2 *
      (1 + (N₀ : ℝ) / (q₀ : ℝ)) * L ^ 2 *
      ∑ v ∈ F, ∑ w ∈ F, ∑ h ∈ J, ∑ k ∈ J,
        x ^ η * (B + A * (Int.gcd (h * (w : ℤ) - k * (v : ℤ)) (r : ℤ) : ℝ)) := by
    apply hraw.trans
    apply mul_le_mul_of_nonneg_left _ (by positivity)
    apply Finset.sum_le_sum
    intro v hv
    apply Finset.sum_le_sum
    intro w hw
    apply Finset.sum_le_sum
    intro h _
    apply Finset.sum_le_sum
    intro k _
    apply mul_le_mul (hPη v hv w hw) ?_ (by positivity) (Real.rpow_nonneg hxpos.le _)
    have hroot : Real.sqrt (N / (q₀ : ℝ)) *
        ((P v w : ℝ) * (Y : ℝ)) ^ (1 / 6 : ℝ) ≤ B := by
      apply mul_le_mul_of_nonneg_left _ (Real.sqrt_nonneg _)
      exact Real.rpow_le_rpow (by positivity)
        (mul_le_mul_of_nonneg_right (hP v hv w hw).2.2 (zero_le_one.trans Y.property))
        (by norm_num)
    have hmean : (N / (q₀ : ℝ)) *
        ((Int.gcd (h * (w : ℤ) - k * (v : ℤ)) (r : ℤ) : ℝ) / (r : ℝ)) =
        A * (Int.gcd (h * (w : ℤ) - k * (v : ℤ)) (r : ℤ) : ℝ) := by
      dsimp only [A]
      ring
    rw [hmean]
    exact add_le_add hroot le_rfl
  have hsumAffine : (∑ v ∈ F, ∑ w ∈ F, ∑ h ∈ J, ∑ k ∈ J,
        x ^ η * (B + A * (Int.gcd (h * (w : ℤ) - k * (v : ℤ)) (r : ℤ) : ℝ))) =
      x ^ η * ((J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * B + A * G) :=
    sourceHighGamma_four_sum_affine F J (x ^ η) B A
      (fun v w h k => (Int.gcd (h * (w : ℤ) - k * (v : ℤ)) (r : ℤ) : ℝ))
  rw [hsumAffine] at hmain
  apply hmain.trans
  rw [← mul_assoc]
  apply mul_le_mul_of_nonneg_left _ (by positivity)
  exact add_le_add le_rfl (mul_le_mul_of_nonneg_left hG hA)

open Classical in
theorem sourceTheta_split_typeI_uniform_power_saving
    («ω» δ ε C T TN A₀ A₁ L : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε)
    (hworking : 72 * «ω» + 24 * δ < 1) (hsmall : ε < δ / 10 ^ 100)
    (hC : 1 ≤ C) (hT : 1 ≤ T) (hTN : 1 ≤ TN)
    (hA₀ : 0 ≤ A₀) (hA₁ : 0 ≤ A₁) (hL : 0 ≤ L) :
    ∃ K X : ℝ, 0 < K ∧ 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ M N R Q H V γ : ℝ,
        0 < M → 0 < N → 0 < R → 0 < Q → 0 < V →
        x / C ≤ M * N → N = x ^ γ →
        N ≤ C * x ^ (δ + 4 * ε) * R →
        R ≤ C * x ^ (-2 * ε) * N →
        R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) →
        1 / 4 + 14 * «ω» + 4 * δ + 100 * ε ≤ γ →
        γ ≤ 1 / 2 - 2 * «ω» - δ / 2 →
      ∀ r q₀ u q₂ a b₁ b₂ : ℕ,
        R ≤ (r : ℝ) → (r : ℝ) ≤ 2 * R →
        H = x ^ ε * R * Q ^ 2 / ((q₀ : ℝ) * M) → 1 ≤ H →
        (u : ℝ) * V ≤ C * Q / (q₀ : ℝ) →
        (q₀ : ℝ) * (q₂ : ℝ) ≤ C * Q →
        x ^ (5 * ε) * H / (q₀ : ℝ) ≤ C * V →
        V ≤ C * x ^ (δ + 5 * ε) * H →
      ∀ (F : Finset ℕ) (J : Finset ℤ),
        (∀ v ∈ F, 0 < v ∧ (v : ℝ) ≤ C * V ∧ Squarefree (r * q₀ * (u * v) * q₂)) →
        (∀ h ∈ J, h ≠ 0 ∧ |(h : ℝ)| ≤ 2 * H) →
        Nat.Coprime a r → Nat.Coprime b₁ q₀ →
      ∀ (ℓ : ℤ) (t₀ : ℝ) (Y : Set.Ici (1 : ℝ)), (Y : ℝ) ≤ x ^ δ →
        (∀ v ∈ F,
          Nonempty (DenseDivisibilityWitness
            Y 1 (r * q₀ * (u * v))) ∧
          Nonempty (DenseDivisibilityWitness
            Y 1 (r * q₀ * q₂))) →
      ∀ (ψ : ℝ → ℝ), ContDiff ℝ 1 ψ → Function.support ψ ⊆ Set.Icc (-T) T →
        (∀ t : ℝ, 0 ≤ ψ t) →
        (∀ t : ℝ, |ψ t| ≤ A₀ ∧ |deriv ψ t| ≤ A₁) →
      ∀ (β : ℕ →₀ ℂ), β.support ⊆ Finset.Icc 1 ⌊TN * N⌋₊ →
        (∀ n ∈ β.support, ‖β n‖ ≤ x ^ (ε / 100)) →
        (∀ n ∈ β.support, 1 ≤ ψ (((n : ℝ) - t₀) / N)) →
      ∀ (c : ℕ → ℤ → ℂ), (∀ v ∈ F, ∀ h ∈ J, ‖c v h‖ ≤ L) →
      let βℤ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
      (∑ v ∈ F, ‖∑ n ∈ βℤ.support,
        βℤ n * star (βℤ (n + ℓ * (r : ℤ))) *
          (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
          ∑ h ∈ J, c v h * sourceTheta r q₀ 1 (u * v) q₂ a b₁ b₂ ℓ n h‖) ≤
        K * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * N * V * x ^ (-2 * ε) := by
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hTNpos : 0 < TN := zero_lt_one.trans_le hTN
  have hεδ : 1000 * ε ≤ δ := by
    have hp : (1000 : ℝ) ≤ 10 ^ 100 := by norm_num
    have hs := (lt_div_iff₀ (by positivity : (0 : ℝ) < 10 ^ 100)).mp hsmall
    nlinarith only [hp, hs, hε]
  have hεsmall : ε ≤ 1 / 100 := by linarith only [hεδ, hworking, hω, hδ]
  have hδsmall : δ + 4 * ε ≤ 1 / 12 := by linarith only [hεδ, hworking, hω, hδ]
  have hδ₅ : δ + 5 * ε ≤ 1 / 10 := by linarith only [hεδ, hworking, hω, hδ]
  have hRQexponent : 1 / 2 + 2 * «ω» + ε ≤ 7 / 12 := by
    linarith only [hworking, hδ, hεsmall]
  obtain ⟨C₀, X₀, hC₀, hX₀, hraw⟩ := sourceTheta_split_fiber_dense_cauchy_bound
    T A₀ A₁ 10 (ε / 100) hT hA₀ hA₁ (by norm_num) (by positivity)
  obtain ⟨Xc, hXc⟩ := Filter.eventually_atTop.mp
    ((tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 100)).eventually_ge_atTop (100 * C))
  let K := Real.sqrt (65 * C₀ * (1 + TN) * L ^ 2 * C ^ 15 + 1)
  have hK : 0 < K := by dsimp only [K]; positivity
  refine ⟨K, max 1 (max X₀ Xc), hK, le_max_left _ _, ?_⟩
  intro x hx M N R Q H V γ hM hN hR hQ hV hMN hNγ hNR hRN hRQ hγlo hγcut
    r q₀ u q₂ a b₁ b₂ hRr hrR hH hHone huV hq₂Q hVlower hVupper F J hF hJ
    ha hb₁ ℓ t₀ Y hYx hY ψ hψ hψs hψ0 hψb β hβs hβ hψmajor c hc βℤ
  have hxone : 1 ≤ x := (le_max_left _ _).trans hx
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  have hx₀ : X₀ ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans hx)
  have hxc : Xc ≤ x := (le_max_right _ _).trans ((le_max_right _ _).trans hx)
  have hxlarge : 100 * C ≤ x ^ (1 / 100 : ℝ) := hXc x hxc
  by_cases hFempty : F = ∅
  · simp only [hFempty, Finset.sum_empty]
    positivity
  obtain ⟨v₀, hv₀⟩ := Finset.nonempty_iff_ne_empty.mpr hFempty
  have hsf := (hF v₀ hv₀).2.2
  have hq₀ : 0 < q₀ := Nat.pos_of_ne_zero hsf.of_mul_left.of_mul_left.of_mul_right.ne_zero
  have hu : 0 < u := Nat.pos_of_ne_zero hsf.of_mul_left.of_mul_right.of_mul_left.ne_zero
  have hq₂ : 0 < q₂ := Nat.pos_of_ne_zero hsf.of_mul_right.ne_zero
  have hqpos : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀
  have hqone : 1 ≤ (q₀ : ℝ) := by exact_mod_cast hq₀
  have hrpos : 0 < (r : ℝ) := hR.trans_le hRr
  have hrnat : 0 < r := by exact_mod_cast hrpos
  have hHpos : 0 < H := zero_lt_one.trans_le hHone
  have hγlower : 1 / 4 ≤ γ := by linarith only [hγlo, hω, hδ, hε]
  have hγhi : γ ≤ 1 / 2 := by linarith only [hγcut, hω, hδ]
  let HN : ℕ := ⌊2 * H⌋₊
  let KN : ℕ := ⌊C * V⌋₊
  let P₀ : ℝ := (r : ℝ) * (q₀ : ℝ) * (u : ℝ) * (KN : ℝ) ^ 2 * (q₂ : ℝ)
  obtain ⟨hqN, hNr, hrx, hHKx, hPx, hPupper, hHK⟩ :=
    sourceHighGamma_split_geometry «ω» δ ε C x M N R Q H V γ r q₀ u q₂ hω.le hδ.le
      hC hxone hxlarge hε hεsmall hδsmall hδ₅ hRQexponent hM hN hR hQ hV hq₀ hu hq₂
      hMN hNγ hNR hRN hRQ hγlo hγlower hγhi hRr hrR hH hHone huV hq₂Q hVupper
  have hHN : (HN : ℝ) ≤ 2 * H := Nat.floor_le (by positivity)
  have hKN : (KN : ℝ) ≤ C * V := Nat.floor_le (by positivity)
  have hFnat (v : ℕ) (hv : v ∈ F) : 0 < v ∧ v ≤ KN ∧ Squarefree (r * q₀ * (u * v) * q₂) :=
    ⟨(hF v hv).1, (Nat.le_floor_iff (by positivity)).mpr (hF v hv).2.1, (hF v hv).2.2⟩
  have hKNpos : 0 < KN := (hFnat v₀ hv₀).1.trans_le (hFnat v₀ hv₀).2.1
  have hPpos : 0 < P₀ := by dsimp only [P₀]; positivity
  have hJnat (h : ℤ) (hh : h ∈ J) : h ≠ 0 ∧ -(HN : ℤ) ≤ h ∧ h ≤ (HN : ℤ) := by
    have hreal : (h.natAbs : ℝ) ≤ 2 * H := by
      rw [Nat.cast_natAbs, Int.cast_abs]
      exact (hJ h hh).2
    have habs : h.natAbs ≤ HN := (Nat.le_floor_iff (by positivity)).mpr hreal
    exact ⟨(hJ h hh).1, by omega, by omega⟩
  have hFcard : (F.card : ℝ) ≤ C * V := by
    have hsub : F ⊆ Finset.Icc 1 KN := fun v hv =>
      Finset.mem_Icc.mpr ⟨(hFnat v hv).1, (hFnat v hv).2.1⟩
    have hh : F.card ≤ KN := by
      simpa only [Nat.card_Icc, Nat.add_sub_cancel] using Finset.card_le_card hsub
    exact (Nat.cast_le.mpr hh).trans hKN
  have hJcard : (J.card : ℝ) ≤ 5 * H := by
    have hsub : J ⊆ Finset.Icc (-(HN : ℤ)) (HN : ℤ) :=
      fun h hh => Finset.mem_Icc.mpr (hJnat h hh).2
    have hcard := Int.card_Icc_of_le (a := -(HN : ℤ)) (b := (HN : ℤ)) (by omega)
    have hcardR : ((Finset.Icc (-(HN : ℤ)) (HN : ℤ)).card : ℝ) =
        (HN : ℝ) + 1 - (-(HN : ℝ)) := by exact_mod_cast hcard
    have hh : (J.card : ℝ) ≤ ((Finset.Icc (-(HN : ℤ)) (HN : ℤ)).card : ℝ) := by
      exact_mod_cast Finset.card_le_card hsub
    linarith only [hh, hcardR, hHN, hHone]
  let D : ℝ := x ^ (ε / 100)
  have hDpos : 0 < D := Real.rpow_pos_of_pos hxpos _
  have hDone : 1 ≤ D := Real.one_le_rpow hxone (by positivity)
  let A : ℝ := Real.sqrt (N / (q₀ : ℝ)) * (P₀ * (Y : ℝ)) ^ (1 / 6 : ℝ)
  let B : ℝ := N / (q₀ : ℝ) / (r : ℝ)
  have hYpos : 0 < (Y : ℝ) := zero_lt_one.trans_le Y.property
  have hA0 : 0 ≤ A := by dsimp only [A]; positivity
  have hB0 : 0 ≤ B := by dsimp only [B]; positivity
  have hS0 : 0 ≤ (J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * A +
      B * (D * (J.card : ℝ) * (F.card : ℝ) * ((HN : ℝ) * (KN : ℝ) + (r : ℝ))) :=
    add_nonneg (mul_nonneg (mul_nonneg (sq_nonneg _) (sq_nonneg _)) hA0)
      (mul_nonneg hB0 (mul_nonneg
        (mul_nonneg (mul_nonneg hDpos.le (Nat.cast_nonneg _)) (Nat.cast_nonneg _))
        (add_nonneg (mul_nonneg (Nat.cast_nonneg _) (Nat.cast_nonneg _)) (Nat.cast_nonneg _))))
  let U : ℝ := ∑ v ∈ F, ‖∑ n ∈ βℤ.support,
    βℤ n * star (βℤ (n + ℓ * (r : ℤ))) *
      (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
      ∑ h ∈ J, c v h * sourceTheta r q₀ 1 (u * v) q₂ a b₁ b₂ ℓ n h‖
  let g : ℝ := (Int.gcd (q₀ : ℤ) ℓ : ℝ)
  have hU : 0 ≤ U := by dsimp only [U]; positivity
  have hg : 0 ≤ g := Nat.cast_nonneg _
  have hbound := hraw x hx₀ r q₀ u q₂ a b₁ b₂ ⌊TN * N⌋₊ HN KN
    hrnat hq₀ hu hq₂ hrx hHKx hPx F J hFnat hJnat ha hb₁
    ℓ N t₀ D L hqN hNr hDpos.le hL Y hY ψ hψ hψs hψ0 hψb β hβs hβ hψmajor c hc
  clear hraw
  change U ^ 2 ≤ C₀ * D ^ 4 * g ^ 2 * (1 + (⌊TN * N⌋₊ : ℝ) / (q₀ : ℝ)) * L ^ 2 * D *
    ((J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * A +
      B * (D * (J.card : ℝ) * (F.card : ℝ) * ((HN : ℝ) * (KN : ℝ) + (r : ℝ)))) at hbound
  have hmass : 1 + (⌊TN * N⌋₊ : ℝ) / (q₀ : ℝ) ≤ (1 + TN) * N / (q₀ : ℝ) := by
    have hf := Nat.floor_le (show 0 ≤ TN * N by positivity)
    calc
      _ ≤ N / (q₀ : ℝ) + (TN * N) / (q₀ : ℝ) :=
        add_le_add ((one_le_div hqpos).mpr hqN) (div_le_div_of_nonneg_right hf hqpos.le)
      _ = _ := by ring
  have hparts : (J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * A ≤ (5 * H) ^ 2 * (C * V) ^ 2 * A :=
    mul_le_mul_of_nonneg_right
      (mul_le_mul (pow_le_pow_left₀ (Nat.cast_nonneg _) hJcard 2)
        (pow_le_pow_left₀ (Nat.cast_nonneg _) hFcard 2) (sq_nonneg _) (sq_nonneg _)) hA0
  have hmean : (J.card : ℝ) * (F.card : ℝ) * ((HN : ℝ) * (KN : ℝ) + (r : ℝ)) ≤
      (5 * H) * (C * V) * (2 * C * H * V + (r : ℝ)) := by gcongr
  have hbracket : (J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * A +
      B * (D * (J.card : ℝ) * (F.card : ℝ) * ((HN : ℝ) * (KN : ℝ) + (r : ℝ))) ≤
      D * ((5 * H) ^ 2 * (C * V) ^ 2 * A + B * (5 * H) * (C * V) *
        (2 * C * H * V + (r : ℝ))) := by
    have hfirst : (J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * A ≤
        D * ((5 * H) ^ 2 * (C * V) ^ 2 * A) :=
      hparts.trans (le_mul_of_one_le_left (by positivity) hDone)
    have hsecond := mul_le_mul_of_nonneg_left
      (mul_le_mul_of_nonneg_left hmean hDpos.le) hB0
    nlinarith only [hfirst, hsecond]
  have hscale := ((sourceHighGamma_scale_envelopes «ω» δ ε C x M N R Q H
    (q₀ : ℝ) γ hω hδ hε hworking hsmall hC hxone hM hN hR hQ hqone
      hMN hNγ hNR hRN hRQ hH hγhi).2 hγlo hγcut).2 V hV hVlower
  have hnormalized := sourceHighGamma_split_normalized_envelope
    δ ε C x H N R Q V (r : ℝ) (q₀ : ℝ) P₀ (Y : ℝ) (C ^ 12 * x ^ (-5 * ε))
      hC hxone hHpos hN hR hQ hV hRr hqone hPpos
      (zero_lt_one.trans_le Y.property) hYx hPupper hVupper hscale.1 hscale.2.1 hscale.2.2
  change U ≤ K * g * N * V * x ^ (-2 * ε)
  exact sourceHighGamma_split_energy_finish C₀ C TN L x ε N V (q₀ : ℝ) U g
    (1 + (⌊TN * N⌋₊ : ℝ) / (q₀ : ℝ))
    ((J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * A +
      B * (D * (J.card : ℝ) * (F.card : ℝ) * ((HN : ℝ) * (KN : ℝ) + (r : ℝ))))
    ((5 * H) ^ 2 * (C * V) ^ 2 * A + B * (5 * H) * (C * V) *
      (2 * C * H * V + (r : ℝ)))
    hC₀ hC hTN hxone hε hN hV hqpos hU hg hS0
    hbound hmass hbracket hnormalized

open Classical in
theorem sourceHighGamma_near_uniform_band
    («ω» δ ε C cM TM TN T A₀ A₁ LM : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε)
    (hworking : 72 * «ω» + 24 * δ < 1) (hsmall : ε < δ / 10 ^ 100)
    (hC : 1 ≤ C) (hcM : 0 < cM) (hMT : cM ≤ TM)
    (hTN : 1 ≤ TN) (hT : 1 ≤ T) (hA₀ : 0 ≤ A₀) (hA₁ : 0 ≤ A₁) (hLM : 0 ≤ LM) :
    ∃ K X : ℝ, 0 < K ∧ 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ M N R Q H γ : ℝ,
        0 < M → 0 < N → 0 < R → 0 < Q →
        x / C ≤ M * N → N = x ^ γ →
        N ≤ C * x ^ (δ + 4 * ε) * R →
        R ≤ C * x ^ (-2 * ε) * N →
        R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) →
        1 / 2 - 2 * «ω» - δ / 2 ≤ γ → γ ≤ 1 / 2 →
      ∀ q₀ a b₁ b₂ : ℕ,
        H = x ^ ε * R * Q ^ 2 / ((q₀ : ℝ) * M) → 1 ≤ H →
      ∀ (𝒜 : Finset (ℕ × ℕ × ℕ × ℕ)) (J : Finset ℤ),
        (∀ t ∈ 𝒜,
          t.2.1 = 1 ∧ 0 < t.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
          Squarefree (t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2) ∧
          R ≤ (t.1 : ℝ) ∧ (t.1 : ℝ) ≤ 2 * R ∧
          Q ≤ (q₀ * t.2.2.1 : ℕ) ∧ (q₀ * t.2.2.1 : ℕ) ≤ 2 * Q ∧
          Q ≤ (q₀ * t.2.2.2 : ℕ) ∧ (q₀ * t.2.2.2 : ℕ) ≤ 2 * Q) →
        (∀ h ∈ J, h ≠ 0 ∧ |(h : ℝ)| ≤ 2 * H) →
        (∀ t ∈ 𝒜, Nat.Coprime a t.1) → Nat.Coprime b₁ q₀ →
      ∀ (ν : ℕ × ℕ → ℂ),
        (∀ t ∈ 𝒜,
          ‖ν (q₀ * t.2.1 * t.2.2.1, t.1)‖ ≤ 1 ∧
          ‖ν (q₀ * t.2.2.2, t.1)‖ ≤ 1) →
      ∀ (ℓ : ℤ) (t₀ : ℝ) (ψM ψN : ℝ → ℝ),
        Function.support ψM ⊆ Set.Icc cM TM → (∀ t : ℝ, |ψM t| ≤ LM) →
        ContDiff ℝ 1 ψN → Function.support ψN ⊆ Set.Icc (-T) T →
        (∀ t : ℝ, 0 ≤ ψN t) →
        (∀ t : ℝ, |ψN t| ≤ A₀ ∧ |deriv ψN t| ≤ A₁) →
      ∀ (β : ℕ →₀ ℂ), β.support ⊆ Finset.Icc 1 ⌊TN * N⌋₊ →
        (∀ n ∈ β.support, ‖β n‖ ≤ x ^ (ε / 100)) →
        (∀ n ∈ β.support, 1 ≤ ψN (((n : ℝ) - t₀) / N)) →
      let βℤ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
      let P : (ℕ × ℕ × ℕ × ℕ) → ℕ := fun t =>
        t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2
      (∑ t ∈ 𝒜,
        ‖ν (q₀ * t.2.1 * t.2.2.1, t.1) * star (ν (q₀ * t.2.2.2, t.1)) *
          ((M : ℂ) / (P t : ℂ)) *
            ∑ n ∈ βℤ.support.filter (fun n =>
              Int.gcd n ((t.1 * q₀ * t.2.1 * t.2.2.1 : ℕ) : ℤ) = 1 ∧
              Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2.2 : ℕ) : ℤ) = 1),
              βℤ n * star (βℤ (n + ℓ * (t.1 : ℤ))) *
                (sourceCompatibility t.1 q₀ b₁ b₂ ℓ n : ℂ) *
                  ∑ h ∈ J, sourcePhi ψM M (P t) h *
                    sourceTheta t.1 q₀ t.2.1 t.2.2.1 t.2.2.2 a b₁ b₂ ℓ n h‖) ≤
        K * M * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) / (q₀ : ℝ) * x ^ (-ε / 4) := by
  have hTM : 0 < TM := hcM.trans_le hMT
  have hPhiBound : 0 ≤ TM * LM := mul_nonneg hTM.le hLM
  obtain ⟨K, X, hK, hX, hnear⟩ := sourceTheta_near_typeII_uniform_power_saving
    «ω» δ ε C T TN A₀ A₁ (TM * LM) hω hδ hε hworking hsmall hC hT hTN hA₀ hA₁ hPhiBound
  refine ⟨2 * K, X, mul_pos (by norm_num) hK, hX, ?_⟩
  intro x hx M N R Q H γ hM hN hR hQ hMN hNγ hNR hRN hRQ hγlo hγhi
    q₀ a b₁ b₂ hH hHone 𝒜 J h𝒜 hJ ha hb₁ ν hν ℓ t₀ ψM ψN hψMs hψMb
    hψN hψNs hψN0 hψNb β hβs hβ hψmajor βℤ P
  have hxone : 1 ≤ x := hX.trans hx
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  by_cases h𝒜empty : 𝒜 = ∅
  · simp only [h𝒜empty, Finset.sum_empty]
    positivity
  obtain ⟨t₀', ht₀'⟩ := Finset.nonempty_iff_ne_empty.mpr h𝒜empty
  have hsf := (h𝒜 t₀' ht₀').2.2.2.2.1
  have hq₀ : 0 < q₀ :=
    Nat.pos_of_ne_zero hsf.of_mul_left.of_mul_left.of_mul_left.of_mul_right.ne_zero
  have hqpos : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀
  have hPhi (d : ℕ) (h : ℤ) : ‖sourcePhi ψM M d h‖ ≤ TM * LM := by
    have hb := sourcePhiRealFactor_sampling_and_norm cM TM M LM hcM hMT hM hLM
      ψM hψMs hψMb d h
    have heq := hb.2.1 1
    simp only [Nat.cast_one, Nat.one_mul] at heq
    simpa only [heq] using hb.2.2 (1 : ℝ)
  let Rs : Finset ℕ := 𝒜.image Prod.fst
  let F : ℕ → Finset (ℕ × ℕ) := fun r =>
    (𝒜.filter (fun t => t.1 = r)).image (fun t => t.2.2)
  let w : ℕ → (ℕ × ℕ) → ℝ := fun r q =>
    ‖∑ n ∈ βℤ.support, βℤ n * star (βℤ (n + ℓ * (r : ℤ))) *
      (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
        ∑ h ∈ J, sourcePhi ψM M (r * q₀ * q.1 * q.2) h *
          sourceTheta r q₀ 1 q.1 q.2 a b₁ b₂ ℓ n h‖
  have hw (r : ℕ) (q : ℕ × ℕ) : 0 ≤ w r q := norm_nonneg _
  have hF (r : ℕ) (q : ℕ × ℕ) (hq : q ∈ F r) :
      Squarefree (r * q₀ * q.1 * q.2) ∧
        Q ≤ (q₀ * q.1 : ℕ) ∧ (q₀ * q.1 : ℕ) ≤ 2 * Q ∧
        Q ≤ (q₀ * q.2 : ℕ) ∧ (q₀ * q.2 : ℕ) ≤ 2 * Q := by
    obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hq
    obtain ⟨htA, htr⟩ := Finset.mem_filter.mp ht
    obtain ⟨hu, _, _, _, hsf, _, _, hq₁lo, hq₁hi, hq₂lo, hq₂hi⟩ := h𝒜 t htA
    refine ⟨?_, hq₁lo, hq₁hi, hq₂lo, hq₂hi⟩
    simpa only [hu, Nat.mul_one, htr] using hsf
  have hrow (t : ℕ × ℕ × ℕ × ℕ) (ht : t ∈ 𝒜) := by
    obtain ⟨hu, hr, hv, hq₂, _, hRr, _, hQ₁, _, hQ₂, _⟩ := h𝒜 t ht
    have hraw := sourceHighGamma_weighted_row_norm t.1 q₀ t.2.1 t.2.2.1 t.2.2.2
      a b₁ b₂ ℓ M R Q hM hR hQ hr hq₀ (by omega) hv hq₂ hRr
      (by simpa only [hu, Nat.mul_one] using hQ₁) hQ₂
      (ν (q₀ * t.2.1 * t.2.2.1, t.1)) (ν (q₀ * t.2.2.2, t.1))
      (hν t ht).1 (hν t ht).2 βℤ.support J βℤ (fun h => sourcePhi ψM M (P t) h)
    dsimp only at hraw
    conv_rhs at hraw => simp only [P, hu, Nat.mul_one]
    exact hraw
  have hlocal (r : ℕ) (hr : r ∈ Rs) :
      (∑ q ∈ F r, w r q) ≤
        K * Q ^ 2 * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) / (q₀ : ℝ) ^ 2 * x ^ (-ε / 4) := by
    obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hr
    obtain ⟨_, _, _, _, _, hRr, hrR, _, _, _, _⟩ := h𝒜 t ht
    exact hnear x hx M N R Q H γ hM hN hR hQ hMN hNγ hNR hRN hRQ hγlo hγhi
      t.1 q₀ a b₁ b₂ hRr hrR hH hHone (F t.1) J (hF t.1) hJ (ha t ht) hb₁
      ℓ t₀ ψN hψN hψNs hψN0 hψNb β hβs hβ hψmajor
      (fun q h => sourcePhi ψM M (t.1 * q₀ * q.1 * q.2) h)
      (fun _ _ h _ => hPhi _ h)
  have hsumr (r : ℕ) :
      (∑ t ∈ 𝒜.filter (fun t => t.1 = r), w t.1 t.2.2) = ∑ q ∈ F r, w r q := by
    have hinj : Set.InjOn (fun t : ℕ × ℕ × ℕ × ℕ => t.2.2)
        (𝒜.filter (fun t => t.1 = r) : Set _) := by
      intro t ht s hs heq
      obtain ⟨htA, htr⟩ := Finset.mem_filter.mp ht
      obtain ⟨hsA, hsr⟩ := Finset.mem_filter.mp hs
      exact Prod.ext (htr.trans hsr.symm)
        (Prod.ext ((h𝒜 t htA).1.trans (h𝒜 s hsA).1.symm) heq)
    calc
      _ = ∑ t ∈ 𝒜.filter (fun t => t.1 = r), w r t.2.2 := by
        apply Finset.sum_congr rfl
        intro t ht
        rw [(Finset.mem_filter.mp ht).2]
      _ = _ := (Finset.sum_image hinj).symm
  have hRcard : (Rs.card : ℝ) ≤ 2 * R := by
    have hsub : Rs ⊆ Finset.Icc 1 ⌊2 * R⌋₊ := by
      intro r hr
      obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hr
      obtain ⟨_, hr, _, _, _, _, hrR, _, _, _, _⟩ := h𝒜 t ht
      exact Finset.mem_Icc.mpr ⟨hr, (Nat.le_floor_iff (by positivity)).mpr hrR⟩
    have hh : Rs.card ≤ ⌊2 * R⌋₊ := by
      simpa only [Nat.card_Icc, Nat.add_sub_cancel] using Finset.card_le_card hsub
    exact (Nat.cast_le.mpr hh).trans (Nat.floor_le (by positivity))
  have hfamily : (∑ t ∈ 𝒜, w t.1 t.2.2) ≤
      (2 * R) * (K * Q ^ 2 * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) /
        (q₀ : ℝ) ^ 2 * x ^ (-ε / 4)) := by
    calc
      _ = ∑ r ∈ Rs, ∑ t ∈ 𝒜.filter (fun t => t.1 = r), w t.1 t.2.2 :=
        (Finset.sum_fiberwise_of_maps_to (s := 𝒜) (t := Rs) (g := Prod.fst)
          (fun t ht => Finset.mem_image_of_mem Prod.fst ht) _).symm
      _ = ∑ r ∈ Rs, ∑ q ∈ F r, w r q := Finset.sum_congr rfl (fun r _ => hsumr r)
      _ ≤ ∑ _r ∈ Rs,
          K * Q ^ 2 * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) / (q₀ : ℝ) ^ 2 * x ^ (-ε / 4) :=
        Finset.sum_le_sum hlocal
      _ = (Rs.card : ℝ) *
          (K * Q ^ 2 * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) / (q₀ : ℝ) ^ 2 * x ^ (-ε / 4)) := by
        rw [Finset.sum_const, nsmul_eq_mul]
      _ ≤ _ := mul_le_mul_of_nonneg_right hRcard (by positivity)
  calc
    _ ≤ ∑ t ∈ 𝒜, (M * (q₀ : ℝ) / (R * Q ^ 2)) * w t.1 t.2.2 := Finset.sum_le_sum hrow
    _ = (M * (q₀ : ℝ) / (R * Q ^ 2)) * ∑ t ∈ 𝒜, w t.1 t.2.2 := (Finset.mul_sum ..).symm
    _ ≤ (M * (q₀ : ℝ) / (R * Q ^ 2)) *
        ((2 * R) * (K * Q ^ 2 * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) /
          (q₀ : ℝ) ^ 2 * x ^ (-ε / 4))) :=
      mul_le_mul_of_nonneg_left hfamily (by positivity)
    _ = _ := by field_simp [hR.ne', hQ.ne', hqpos.ne']

open Classical in
theorem sourceHighGamma_split_uniform_band
    («ω» δ ε C cM TM TN T A₀ A₁ LM : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε)
    (hworking : 72 * «ω» + 24 * δ < 1) (hsmall : ε < δ / 10 ^ 100)
    (hC : 1 ≤ C) (hcM : 0 < cM) (hMT : cM ≤ TM)
    (hTN : 1 ≤ TN) (hT : 1 ≤ T) (hA₀ : 0 ≤ A₀) (hA₁ : 0 ≤ A₁) (hLM : 0 ≤ LM) :
    ∃ K X : ℝ, 0 < K ∧ 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ M N R Q H U V γ : ℝ,
        0 < M → 0 < N → 0 < R → 0 < Q → 0 < U → 0 < V →
        x / C ≤ M * N → N = x ^ γ →
        N ≤ C * x ^ (δ + 4 * ε) * R →
        R ≤ C * x ^ (-2 * ε) * N →
        R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) →
        1 / 4 + 14 * «ω» + 4 * δ + 100 * ε ≤ γ →
        γ ≤ 1 / 2 - 2 * «ω» - δ / 2 →
      ∀ q₀ a b₁ b₂ : ℕ, 0 < q₀ →
        H = x ^ ε * R * Q ^ 2 / ((q₀ : ℝ) * M) → 1 ≤ H →
        U * V ≤ C * Q / (q₀ : ℝ) →
        x ^ (5 * ε) * H / (q₀ : ℝ) ≤ C * V →
        V ≤ C * x ^ (δ + 5 * ε) * H →
      ∀ (Y : Set.Ici (1 : ℝ)), (Y : ℝ) ≤ x ^ δ →
      ∀ (𝒜 : Finset (ℕ × ℕ × ℕ × ℕ)) (J : Finset ℤ),
        (∀ t ∈ 𝒜,
          0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
          Squarefree (t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2) ∧
          R ≤ (t.1 : ℝ) ∧ (t.1 : ℝ) ≤ 2 * R ∧
          (t.2.1 : ℝ) ≤ C * U ∧ (t.2.2.1 : ℝ) ≤ C * V ∧
          Q ≤ (q₀ * t.2.1 * t.2.2.1 : ℕ) ∧
          Q ≤ (q₀ * t.2.2.2 : ℕ) ∧ (q₀ * t.2.2.2 : ℕ) ≤ C * Q) →
        (∀ t ∈ 𝒜,
          Nonempty (DenseDivisibilityWitness
            Y 1 (t.1 * q₀ * t.2.1 * t.2.2.1)) ∧
          Nonempty (DenseDivisibilityWitness
            Y 1 (t.1 * q₀ * t.2.2.2))) →
        (∀ h ∈ J, h ≠ 0 ∧ |(h : ℝ)| ≤ 2 * H) →
        (∀ t ∈ 𝒜, Nat.Coprime a t.1) → Nat.Coprime b₁ q₀ →
      ∀ (ν : ℕ × ℕ → ℂ),
        (∀ t ∈ 𝒜,
          ‖ν (q₀ * t.2.1 * t.2.2.1, t.1)‖ ≤ 1 ∧
          ‖ν (q₀ * t.2.2.2, t.1)‖ ≤ 1) →
      ∀ (ℓ : ℤ) (t₀ : ℝ) (ψM ψN : ℝ → ℝ),
        Function.support ψM ⊆ Set.Icc cM TM → (∀ t : ℝ, |ψM t| ≤ LM) →
        ContDiff ℝ 1 ψN → Function.support ψN ⊆ Set.Icc (-T) T →
        (∀ t : ℝ, 0 ≤ ψN t) →
        (∀ t : ℝ, |ψN t| ≤ A₀ ∧ |deriv ψN t| ≤ A₁) →
      ∀ (β : ℕ →₀ ℂ), β.support ⊆ Finset.Icc 1 ⌊TN * N⌋₊ →
        (∀ n ∈ β.support, ‖β n‖ ≤ x ^ (ε / 100)) →
        (∀ n ∈ β.support, 1 ≤ ψN (((n : ℝ) - t₀) / N)) →
      let βℤ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
      let P : (ℕ × ℕ × ℕ × ℕ) → ℕ := fun t =>
        t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2
      (∑ t ∈ 𝒜,
        ‖ν (q₀ * t.2.1 * t.2.2.1, t.1) * star (ν (q₀ * t.2.2.2, t.1)) *
          ((M : ℂ) / (P t : ℂ)) *
            ∑ n ∈ βℤ.support.filter (fun n =>
              Int.gcd n ((t.1 * q₀ * t.2.1 * t.2.2.1 : ℕ) : ℤ) = 1 ∧
              Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2.2 : ℕ) : ℤ) = 1),
              βℤ n * star (βℤ (n + ℓ * (t.1 : ℤ))) *
                (sourceCompatibility t.1 q₀ b₁ b₂ ℓ n : ℂ) *
                  ∑ h ∈ J, sourcePhi ψM M (P t) h *
                    sourceTheta t.1 q₀ t.2.1 t.2.2.1 t.2.2.2 a b₁ b₂ ℓ n h‖) ≤
        K * M * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) / (q₀ : ℝ) * x ^ (-ε / 4) := by
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hTM : 0 < TM := hcM.trans_le hMT
  let D : ℝ := 4 * C ^ 2
  have hCD : C ≤ D := by dsimp only [D]; nlinarith only [hC, sq_nonneg (C - 1)]
  have hC₂D : C ^ 2 ≤ D := by dsimp only [D]; nlinarith only [sq_nonneg C]
  have hD : 1 ≤ D := hC.trans hCD
  have hDpos : 0 < D := zero_lt_one.trans_le hD
  obtain ⟨K, X, hK, hX, hsplit⟩ := sourceTheta_split_typeI_uniform_power_saving
    «ω» δ ε D T TN A₀ A₁ (TM * LM) hω hδ hε hworking hsmall hD hT hTN
      hA₀ hA₁ (mul_nonneg hTM.le hLM)
  refine ⟨2 * C ^ 3 * K, X, by positivity, hX, ?_⟩
  intro x hx M N R Q H U V γ hM hN hR hQ hU hV hMN hNγ hNR hRN hRQ hγlo hγcut
    q₀ a b₁ b₂ hq₀ hH hHone hUV hVlo hVhi Y hYx 𝒜 J h𝒜 h𝒜Y hJ ha hb₁
    ν hν ℓ t₀ ψM ψN hψMs hψMb hψN hψNs hψN0 hψNb β hβs hβ hψmajor βℤ P
  have hxone : 1 ≤ x := hX.trans hx
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  have hqpos : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀
  have hMN' : x / D ≤ M * N :=
    (div_le_div_of_nonneg_left hxpos.le hCpos hCD).trans hMN
  have hNR' : N ≤ D * x ^ (δ + 4 * ε) * R := hNR.trans
    (mul_le_mul_of_nonneg_right
      (mul_le_mul_of_nonneg_right hCD (Real.rpow_nonneg hxpos.le _)) hR.le)
  have hRN' : R ≤ D * x ^ (-2 * ε) * N := hRN.trans
    (mul_le_mul_of_nonneg_right
      (mul_le_mul_of_nonneg_right hCD (Real.rpow_nonneg hxpos.le _)) hN.le)
  have hRQ' : R * Q ≤ D * x ^ (1 / 2 + 2 * «ω» + ε) := hRQ.trans
    (mul_le_mul_of_nonneg_right hCD (Real.rpow_nonneg hxpos.le _))
  have hVlo' : x ^ (5 * ε) * H / (q₀ : ℝ) ≤ D * V :=
    hVlo.trans (mul_le_mul_of_nonneg_right hCD hV.le)
  have hVhi' : V ≤ D * x ^ (δ + 5 * ε) * H := hVhi.trans
    (mul_le_mul_of_nonneg_right
      (mul_le_mul_of_nonneg_right hCD (Real.rpow_nonneg hxpos.le _))
      (zero_le_one.trans hHone))
  have hPhi (d : ℕ) (h : ℤ) : ‖sourcePhi ψM M d h‖ ≤ TM * LM := by
    have hh := sourcePhiRealFactor_sampling_and_norm cM TM M LM hcM hMT hM hLM
      ψM hψMs hψMb d h
    have heq := hh.2.1 1
    simp only [Nat.cast_one, Nat.one_mul] at heq
    simpa only [heq] using hh.2.2 (1 : ℝ)
  let π : (ℕ × ℕ × ℕ × ℕ) → ℕ × ℕ × ℕ := fun t => (t.1, t.2.1, t.2.2.2)
  let I : Finset (ℕ × ℕ × ℕ) := 𝒜.image π
  let F : (ℕ × ℕ × ℕ) → Finset ℕ := fun i =>
    (𝒜.filter (fun t => π t = i)).image (fun t => t.2.2.1)
  let w : (ℕ × ℕ × ℕ) → ℕ → ℝ := fun i v =>
    ‖∑ n ∈ βℤ.support, βℤ n * star (βℤ (n + ℓ * (i.1 : ℤ))) *
      (sourceCompatibility i.1 q₀ b₁ b₂ ℓ n : ℂ) *
        ∑ h ∈ J, sourcePhi ψM M (i.1 * q₀ * (i.2.1 * v) * i.2.2) h *
          sourceTheta i.1 q₀ 1 (i.2.1 * v) i.2.2 a b₁ b₂ ℓ n h‖
  have hFmem (i : ℕ × ℕ × ℕ) (v : ℕ) (hv : v ∈ F i) :
      (i.1, i.2.1, v, i.2.2) ∈ 𝒜 := by
    obtain ⟨t, ht, htv⟩ := Finset.mem_image.mp hv
    obtain ⟨htA, hti⟩ := Finset.mem_filter.mp ht
    have hfirst : t.1 = i.1 := congrArg (fun p : ℕ × ℕ × ℕ => p.1) hti
    have hsecond : t.2.1 = i.2.1 := congrArg (fun p : ℕ × ℕ × ℕ => p.2.1) hti
    have hfourth : t.2.2.2 = i.2.2 := by
      simpa only [π] using congrArg (fun p : ℕ × ℕ × ℕ => p.2.2) hti
    have heq : t = (i.1, i.2.1, v, i.2.2) :=
      Prod.ext hfirst (Prod.ext hsecond (Prod.ext htv hfourth))
    exact heq ▸ htA
  have hTheta (r u v q₂ : ℕ) (n h : ℤ) :
      sourceTheta r q₀ u v q₂ a b₁ b₂ ℓ n h =
        sourceTheta r q₀ 1 (u * v) q₂ a b₁ b₂ ℓ n h := by
    let θ : ℕ → ℂ := fun z =>
      if hp : r ≠ 0 ∧ z ≠ 0 ∧ q₂ ≠ 0 then
        let _ : NeZero r := ⟨hp.1⟩
        let _ : NeZero z := ⟨hp.2.1⟩
        let _ : NeZero q₂ := ⟨hp.2.2⟩
        reciprocalUnitPhase r ((a : ZMod r) * (h : ZMod r))
          ((n : ZMod r) * ((z * q₂ : ℕ) : ZMod r)) *
        reciprocalUnitPhase z ((b₁ : ZMod z) * (h : ZMod z))
          ((n : ZMod z) * ((r * q₂ : ℕ) : ZMod z)) *
        reciprocalUnitPhase q₂ ((b₂ : ZMod q₂) * (h : ZMod q₂))
          (((n + ℓ * (r : ℤ) : ℤ) : ZMod q₂) * ((r * z : ℕ) : ZMod q₂))
      else 0
    have hf (u v : ℕ) : sourceTheta r q₀ u v q₂ a b₁ b₂ ℓ n h = θ (q₀ * u * v) := by
      unfold sourceTheta
      dsimp only [θ]
      split_ifs
      · congr 3
        push_cast
        ring
      · rfl
    rw [hf u v, hf 1 (u * v)]
    congr 1
    ring
  have hrow (t : ℕ × ℕ × ℕ × ℕ) (ht : t ∈ 𝒜) :
      ‖ν (q₀ * t.2.1 * t.2.2.1, t.1) * star (ν (q₀ * t.2.2.2, t.1)) *
        ((M : ℂ) / (P t : ℂ)) *
          ∑ n ∈ βℤ.support.filter (fun n =>
            Int.gcd n ((t.1 * q₀ * t.2.1 * t.2.2.1 : ℕ) : ℤ) = 1 ∧
            Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2.2 : ℕ) : ℤ) = 1),
            βℤ n * star (βℤ (n + ℓ * (t.1 : ℤ))) *
              (sourceCompatibility t.1 q₀ b₁ b₂ ℓ n : ℂ) *
                ∑ h ∈ J, sourcePhi ψM M (P t) h *
                  sourceTheta t.1 q₀ t.2.1 t.2.2.1 t.2.2.2 a b₁ b₂ ℓ n h‖ ≤
        (M * (q₀ : ℝ) / (R * Q ^ 2)) * w (π t) t.2.2.1 := by
    obtain ⟨hr, hu, hv, hq₂, _, hRr, _, _, _, hQ₁, hQ₂, _⟩ := h𝒜 t ht
    have hh := sourceHighGamma_weighted_row_norm t.1 q₀ t.2.1 t.2.2.1 t.2.2.2
      a b₁ b₂ ℓ M R Q hM hR hQ hr hq₀ hu hv hq₂ hRr hQ₁ hQ₂
      (ν (q₀ * t.2.1 * t.2.2.1, t.1)) (ν (q₀ * t.2.2.2, t.1))
      (hν t ht).1 (hν t ht).2 βℤ.support J βℤ (fun h => sourcePhi ψM M (P t) h)
    dsimp only at hh
    have hTh : sourceTheta t.1 q₀ t.2.1 t.2.2.1 t.2.2.2 a b₁ b₂ ℓ =
        sourceTheta t.1 q₀ 1 (t.2.1 * t.2.2.1) t.2.2.2 a b₁ b₂ ℓ :=
      funext fun n => funext fun h => hTheta _ _ _ _ n h
    conv_rhs at hh => rw [hTh]
    simpa only [P, w, π, Nat.mul_assoc] using hh
  have hlocal (i : ℕ × ℕ × ℕ) (hi : i ∈ I) :
      (∑ v ∈ F i, w i v) ≤
        K * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * N * V * x ^ (-2 * ε) := by
    obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hi
    obtain ⟨_, _, _, _, _, hRr, hrR, huU, _, _, _, hq₂Q⟩ := h𝒜 t ht
    have huV : (t.2.1 : ℝ) * V ≤ D * Q / (q₀ : ℝ) := by
      calc
        _ ≤ (C * U) * V := mul_le_mul_of_nonneg_right huU hV.le
        _ = C * (U * V) := by ring
        _ ≤ C * (C * Q / (q₀ : ℝ)) := mul_le_mul_of_nonneg_left hUV hCpos.le
        _ = C ^ 2 * Q / (q₀ : ℝ) := by ring
        _ ≤ _ := div_le_div_of_nonneg_right
          (mul_le_mul_of_nonneg_right hC₂D hQ.le) hqpos.le
    have hq₂Q' : (q₀ : ℝ) * (t.2.2.2 : ℝ) ≤ D * Q := by
      have hh : (q₀ : ℝ) * (t.2.2.2 : ℝ) ≤ C * Q := by
        simpa only [Nat.cast_mul] using hq₂Q
      exact hh.trans (mul_le_mul_of_nonneg_right hCD hQ.le)
    have hFdata (v : ℕ) (hv : v ∈ F (π t)) :
        0 < v ∧ (v : ℝ) ≤ D * V ∧ Squarefree (t.1 * q₀ * (t.2.1 * v) * t.2.2.2) := by
      obtain ⟨_, _, hvpos, _, hsf, _, _, _, hvV, _, _, _⟩ :=
        h𝒜 _ (hFmem (π t) v hv)
      refine ⟨hvpos, hvV.trans (mul_le_mul_of_nonneg_right hCD hV.le), ?_⟩
      simpa only [π, Nat.mul_assoc] using hsf
    have hFdense (v : ℕ) (hv : v ∈ F (π t)) :
        Nonempty (DenseDivisibilityWitness
          Y 1 (t.1 * q₀ * (t.2.1 * v))) ∧
        Nonempty (DenseDivisibilityWitness
          Y 1 (t.1 * q₀ * t.2.2.2)) := by
      simpa only [π, Nat.mul_assoc] using h𝒜Y _ (hFmem (π t) v hv)
    exact hsplit x hx M N R Q H V γ hM hN hR hQ hV hMN' hNγ hNR' hRN' hRQ'
      hγlo hγcut t.1 q₀ t.2.1 t.2.2.2 a b₁ b₂ hRr hrR hH hHone huV hq₂Q'
      hVlo' hVhi' (F (π t)) J hFdata hJ (ha t ht) hb₁ ℓ t₀ Y hYx hFdense
      ψN hψN hψNs hψN0 hψNb β hβs hβ hψmajor
      (fun v h => sourcePhi ψM M (t.1 * q₀ * (t.2.1 * v) * t.2.2.2) h)
      (fun _ _ h _ => hPhi _ h)
  have hsumfiber (i : ℕ × ℕ × ℕ) :
      (∑ t ∈ 𝒜.filter (fun t => π t = i), w (π t) t.2.2.1) =
        ∑ v ∈ F i, w i v := by
    have hinj : Set.InjOn (fun t : ℕ × ℕ × ℕ × ℕ => t.2.2.1)
        (𝒜.filter (fun t => π t = i) : Set _) := by
      intro t ht s hs hv
      have heq : π t = π s := (Finset.mem_filter.mp ht).2.trans
        (Finset.mem_filter.mp hs).2.symm
      have hfirst : t.1 = s.1 := congrArg (fun p : ℕ × ℕ × ℕ => p.1) heq
      have hsecond : t.2.1 = s.2.1 := congrArg (fun p : ℕ × ℕ × ℕ => p.2.1) heq
      have hfourth : t.2.2.2 = s.2.2.2 := by
        simpa only [π] using congrArg (fun p : ℕ × ℕ × ℕ => p.2.2) heq
      exact Prod.ext hfirst (Prod.ext hsecond (Prod.ext hv hfourth))
    calc
      _ = ∑ t ∈ 𝒜.filter (fun t => π t = i), w i t.2.2.1 := by
        apply Finset.sum_congr rfl
        intro t ht
        rw [(Finset.mem_filter.mp ht).2]
      _ = _ := (Finset.sum_image hinj).symm
  have hIcard : (I.card : ℝ) ≤ 2 * C ^ 2 * R * U * Q / (q₀ : ℝ) := by
    let IR := Finset.Icc 1 ⌊2 * R⌋₊
    let IU := Finset.Icc 1 ⌊C * U⌋₊
    let IQ := Finset.Icc 1 ⌊C * Q / (q₀ : ℝ)⌋₊
    have hsub : I ⊆ IR ×ˢ (IU ×ˢ IQ) := by
      intro i hi
      obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hi
      obtain ⟨hr, hu, _, hq₂, _, _, hrR, huU, _, _, _, hq₂Q⟩ := h𝒜 t ht
      have hq₂bound : (t.2.2.2 : ℝ) ≤ C * Q / (q₀ : ℝ) := by
        apply (le_div_iff₀ hqpos).mpr
        simpa only [Nat.cast_mul, mul_comm] using hq₂Q
      exact Finset.mem_product.mpr
        ⟨Finset.mem_Icc.mpr ⟨hr, Nat.le_floor hrR⟩,
          Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨hu, Nat.le_floor huU⟩,
            Finset.mem_Icc.mpr ⟨hq₂, Nat.le_floor hq₂bound⟩⟩⟩
    have hc : I.card ≤ ⌊2 * R⌋₊ * (⌊C * U⌋₊ * ⌊C * Q / (q₀ : ℝ)⌋₊) := by
      simpa only [Finset.card_product, IR, IU, IQ, Nat.card_Icc, Nat.add_sub_cancel] using
        Finset.card_le_card hsub
    calc
      (I.card : ℝ) ≤ (⌊2 * R⌋₊ : ℝ) *
          ((⌊C * U⌋₊ : ℝ) * (⌊C * Q / (q₀ : ℝ)⌋₊ : ℝ)) := by exact_mod_cast hc
      _ ≤ (2 * R) * ((C * U) * (C * Q / (q₀ : ℝ))) := by
        gcongr <;> exact Nat.floor_le (by positivity)
      _ = _ := by ring
  have hfamily : (∑ t ∈ 𝒜, w (π t) t.2.2.1) ≤
      (2 * C ^ 2 * R * U * Q / (q₀ : ℝ)) *
        (K * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * N * V * x ^ (-2 * ε)) := by
    calc
      _ = ∑ i ∈ I, ∑ t ∈ 𝒜.filter (fun t => π t = i), w (π t) t.2.2.1 :=
        (Finset.sum_fiberwise_of_maps_to (s := 𝒜) (t := I) (g := π)
          (fun t ht => Finset.mem_image_of_mem π ht) _).symm
      _ = ∑ i ∈ I, ∑ v ∈ F i, w i v :=
        Finset.sum_congr rfl (fun i _ => hsumfiber i)
      _ ≤ ∑ _i ∈ I, K * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * N * V * x ^ (-2 * ε) :=
        Finset.sum_le_sum hlocal
      _ = (I.card : ℝ) *
          (K * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * N * V * x ^ (-2 * ε)) := by
        rw [Finset.sum_const, nsmul_eq_mul]
      _ ≤ _ := mul_le_mul_of_nonneg_right hIcard (by positivity)
  have hpow : x ^ (-2 * ε) ≤ x ^ (-ε / 4) :=
    Real.rpow_le_rpow_of_exponent_le hxone (by linarith only [hε])
  calc
    _ ≤ ∑ t ∈ 𝒜, (M * (q₀ : ℝ) / (R * Q ^ 2)) * w (π t) t.2.2.1 :=
      Finset.sum_le_sum hrow
    _ = (M * (q₀ : ℝ) / (R * Q ^ 2)) * ∑ t ∈ 𝒜, w (π t) t.2.2.1 :=
      (Finset.mul_sum ..).symm
    _ ≤ (M * (q₀ : ℝ) / (R * Q ^ 2)) *
        ((2 * C ^ 2 * R * U * Q / (q₀ : ℝ)) *
          (K * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * N * V * x ^ (-2 * ε))) :=
      mul_le_mul_of_nonneg_left hfamily (by positivity)
    _ = (2 * C ^ 2 * K * M * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ)) *
        ((U * V) / Q) * x ^ (-2 * ε) := by
      field_simp [hR.ne', hQ.ne', hqpos.ne']
    _ ≤ (2 * C ^ 2 * K * M * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ)) *
        (C / (q₀ : ℝ)) * x ^ (-ε / 4) := by
      apply mul_le_mul _ hpow (Real.rpow_nonneg hxpos.le _) (by positivity)
      apply mul_le_mul_of_nonneg_left _ (by positivity)
      calc
        (U * V) / Q ≤ (C * Q / (q₀ : ℝ)) / Q :=
          div_le_div_of_nonneg_right hUV hQ.le
        _ = C / (q₀ : ℝ) := by field_simp [hQ.ne', hqpos.ne']
    _ = _ := by ring

theorem sourceDeltaZero_rough_dyadic_largeGamma_uniform_log_saving_of_deligne
    (_hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    («ω» δ ε C cM TM cN TN : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hε : 0 < ε)
    (hworking : 72 * «ω» + 24 * δ < 1) (hsmall : ε < δ / 10 ^ 100)
    (hC : 1 ≤ C) (hcM : 0 < cM) (hMT : cM ≤ TM)
    (hcN : 0 < cN) (hNT : cN ≤ TN)
    (dα dβ : ℕ) (Eα Eβ A η : ℝ) (hA : 0 < A) (hη : 0 < η) :
    ∃ X₀ : ℝ, Real.exp 1 ≤ X₀ ∧
      ∀ (x : ℝ), X₀ ≤ x →
      ∀ (M N R Q γ : ℝ),
      0 < M → 0 < N → 0 < R → 0 < Q →
      x / C ≤ M * N → M * N ≤ C * x → N = x ^ γ →
      1 / 4 + 14 * «ω» + 4 * δ + 100 * ε ≤ γ →
      γ ≤ 1 / 2 →
      N ≤ C * x ^ (δ + 4 * ε) * R →
      R ≤ C * x ^ (-2 * ε) * N →
      x ^ (1 / 2 - ε) ≤ C * R * Q →
      R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) →
      ∀ (α β : ℕ →₀ ℂ),
      (∀ n ∈ α.support,
        cM * M ≤ (n : ℝ) ∧ (n : ℝ) ≤ TM * M ∧
        ‖α n‖ ≤ C * (n.divisors.card : ℝ) ^ dα * (Real.log x) ^ Eα) →
      (∀ n ∈ β.support,
        cN * N ≤ (n : ℝ) ∧ (n : ℝ) ≤ TN * N ∧
        ‖β n‖ ≤ C * (n.divisors.card : ℝ) ^ dβ * (Real.log x) ^ Eβ) →
      ∀ (S : Finset (ℕ × ℕ)),
      (∀ p ∈ S,
        0 < p.1 ∧ 0 < p.2 ∧ Squarefree (p.1 * p.2) ∧
        Q ≤ (p.1 : ℝ) ∧ (p.1 : ℝ) ≤ 2 * Q ∧
        R ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ 2 * R ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ 1 p.1) ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ 1 p.2) ∧
        (∀ t ∈ p.1.primeFactors,
          Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (t : ℝ))) →
      ∀ (a b₁ b₂ : ℕ),
      (∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2)) →
      (∑ p ∈ S,
        ‖deltaZero (finiteConvolution α β) p.1 p.2 a b₁ b₂‖) ≤
          η * (M * N) * (Real.log x) ^ (-A)
:= by
  classical
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hTMpos : 0 < TM := hcM.trans_le hMT
  have hTNpos : 0 < TN := hcN.trans_le hNT
  have hεone : ε ≤ 1 := by
    have hεδ : ε < δ := hsmall.trans_le (div_le_self hδ.le (by norm_num))
    linarith only [hεδ, hworking, hω]
  obtain ⟨ψM, hψM, hsM, hMnonneg, hMmajor, hMderivatives⟩ := opening_majorant cM TM hcM hMT
  obtain ⟨ψN, hψN, hsN, hNnonneg, hNmajor, hNderivatives⟩ := opening_majorant cN TN hcN hNT
  choose CM hCM hCMbound using hMderivatives
  choose CN hCN hCNbound using hNderivatives
  let C₀ : ℝ := 4 * (C + TM + TN + 1)
  have hC₀four : 4 ≤ C₀ := by dsimp only [C₀]; nlinarith
  have hC₀ : 1 ≤ C₀ := by linarith
  have hC₀pos : 0 < C₀ := zero_lt_one.trans_le hC₀
  have hCC₀ : C ≤ C₀ := by dsimp only [C₀]; nlinarith
  have hTN₀ : 2 * TN ≤ C₀ := by dsimp only [C₀]; nlinarith
  have hMinterval : cM / 2 ≤ 2 * TM := by linarith
  have hNinterval : cN / 2 ≤ 2 * TN := by linarith
  obtain ⟨Knear, Xnear, hKnear, hXnear, hNearAt⟩ :=
    sourceHighGamma_near_uniform_band «ω» δ ε C₀ (cM / 2) (2 * TM)
      C₀ C₀ (CN 0) (CN 1) (CM 0)
      hω hδ hε hworking hsmall hC₀ (by positivity) hMinterval
      hC₀ hC₀ (hCN 0) (hCN 1) (hCM 0)
  obtain ⟨Ksplit, Xsplit, hKsplit, hXsplit, hSplitAt⟩ :=
    sourceHighGamma_split_uniform_band «ω» δ ε C₀ (cM / 2) (2 * TM)
      C₀ C₀ (CN 0) (CN 1) (CM 0)
      hω hδ hε hworking hsmall hC₀ (by positivity) hMinterval
      hC₀ hC₀ (hCN 0) (hCN 1) (hCM 0)
  let Kband : ℝ := max Knear Ksplit
  let Xband : ℝ := max Xnear Xsplit
  have hKband : 0 < Kband := hKnear.trans_le (le_max_left _ _)
  have hNearK : Knear ≤ Kband := le_max_left _ _
  have hSplitK : Ksplit ≤ Kband := le_max_right _ _
  have hψN1 : ContDiff ℝ 1 ψN := hψN.of_le (by simp)
  have hsNsym : Function.support ψN ⊆ Set.Icc (-C₀) C₀ :=
    hsN.trans (Set.Icc_subset_Icc (by linarith only [hcN, hC₀pos]) hTN₀)
  have hMbound : ∀ t : ℝ, |ψM t| ≤ CM 0 := by
    intro t
    simpa only [iteratedDeriv_zero, Real.norm_eq_abs] using hCMbound 0 t
  have hNbound : ∀ t : ℝ, |ψN t| ≤ CN 0 ∧ |deriv ψN t| ≤ CN 1 := by
    intro t
    exact ⟨by simpa only [iteratedDeriv_zero, Real.norm_eq_abs] using hCNbound 0 t,
      by simpa only [iteratedDeriv_one, Real.norm_eq_abs] using hCNbound 1 t⟩
  have hBetaAt := opening_high_beta_subpower dβ Eβ C TN ε hCpos.le hTNpos hε
  obtain ⟨Kα, Fα, hKα, hMomentAt⟩ := opening_moment dα Eα C TM hCpos.le hTMpos
  let D : ℝ := 2 * A + |Fα| + 2
  have hD : 0 < D := by dsimp only [D]; positivity
  let k : ℕ := Nat.ceil ((1 + ((2 * dβ + 5 : ℕ) : ℝ) * 2 + 2) / ε)
  let Ltail : ℝ := max (CM 0) (CM (k + 2))
  have hLtail : 0 ≤ Ltail := (hCM 0).trans (le_max_left _ _)
  have hTailAt := (opening_padded_truncation dβ Eβ 2 C ε 1
    (by norm_num) hCpos.le hε (by norm_num)).2
      (cM / 2) (2 * TM) Ltail 0 (by positivity) hMinterval hLtail
  let Lzero : ℝ := max (CM 0) (max (CM 1) (CM 2))
  have hLzero : 0 ≤ Lzero := (hCM 0).trans (le_max_left _ _)
  have hZeroAt := opening_zero_mode dβ Eβ C TN (2 * TM) Lzero ε D
    hCpos hTNpos (by positivity) hLzero hε ψM (hψM.of_le (by simp))
    (hsM.trans (Set.Icc_subset_Icc_left (by linarith))) (by
      intro t
      refine ⟨(by simpa only [iteratedDeriv_zero, Real.norm_eq_abs] using
        (hCMbound 0 t).trans (le_max_left _ _)), ?_, ?_⟩
      · simpa only [iteratedDeriv_one, Real.norm_eq_abs] using
          (hCMbound 1 t).trans ((le_max_left _ _).trans (le_max_right _ _))
      · simpa only [iteratedDeriv_succ, iteratedDeriv_one, iteratedDeriv_zero,
          Real.norm_eq_abs] using
          (hCMbound 2 t).trans ((le_max_right _ _).trans (le_max_right _ _)))
  have hDiagonalAt := opening_high_diagonal dβ «ω» δ ε C₀
    (2 * TM) C (CM 0) Eβ 0 D hω hδ hε hC₀ (by positivity) hCpos.le (hCM 0) hD.le
  let Bcount : ℝ := 2 + 4 / Real.log 2
  have hBcount : 0 < Bcount := by
    dsimp only [Bcount]
    have : 0 < Real.log 2 := Real.log_pos (by norm_num)
    positivity
  let Koff : ℝ := 36 * Kband * Bcount ^ 2 * (2 * TN)
  have hKoff : 0 < Koff := by dsimp only [Koff]; positivity
  have hLogAbsorb (K E ρ : ℝ) (hρ : 0 < ρ) :
      ∀ᶠ x : ℝ in Filter.atTop, K * (Real.log x) ^ E ≤ x ^ ρ := by
    clear * - hρ
    filter_upwards [((isLittleO_log_rpow_rpow_atTop E hρ).const_mul_left K).eventuallyLE,
      Filter.eventually_ge_atTop (0 : ℝ)] with x hx hx0
    exact (le_abs_self _).trans (by
      simpa only [Real.norm_eq_abs, abs_of_nonneg (Real.rpow_nonneg hx0 ρ)] using hx)
  have hmain : ∀ᶠ x : ℝ in Filter.atTop,
      ∀ (M N R Q γ : ℝ), 0 < M → 0 < N → 0 < R → 0 < Q →
      x / C ≤ M * N → M * N ≤ C * x → N = x ^ γ →
      1 / 4 + 14 * «ω» + 4 * δ + 100 * ε ≤ γ →
      γ ≤ 1 / 2 →
      N ≤ C * x ^ (δ + 4 * ε) * R → R ≤ C * x ^ (-2 * ε) * N →
      x ^ (1 / 2 - ε) ≤ C * R * Q → R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) →
      ∀ (α β : ℕ →₀ ℂ),
      (∀ n ∈ α.support, cM * M ≤ (n : ℝ) ∧ (n : ℝ) ≤ TM * M ∧
        ‖α n‖ ≤ C * (n.divisors.card : ℝ) ^ dα * (Real.log x) ^ Eα) →
      (∀ n ∈ β.support, cN * N ≤ (n : ℝ) ∧ (n : ℝ) ≤ TN * N ∧
        ‖β n‖ ≤ C * (n.divisors.card : ℝ) ^ dβ * (Real.log x) ^ Eβ) →
      ∀ (S : Finset (ℕ × ℕ)),
      (∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Squarefree (p.1 * p.2) ∧
        Q ≤ (p.1 : ℝ) ∧ (p.1 : ℝ) ≤ 2 * Q ∧
        R ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ 2 * R ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ 1 p.1) ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ 1 p.2) ∧
        (∀ t ∈ p.1.primeFactors,
          Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (t : ℝ))) →
      ∀ (a b₁ b₂ : ℕ), (∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2)) →
      (∑ p ∈ S, ‖deltaZero (finiteConvolution α β) p.1 p.2 a b₁ b₂‖) ≤
        η * (M * N) * (Real.log x) ^ (-A) := by
    filter_upwards [opening_high_scale_resources C₀ «ω» δ ε hC₀ hω hδ hε hworking hsmall,
      hMomentAt, hBetaAt, hZeroAt, hDiagonalAt, hTailAt,
      hLogAbsorb Koff (4 + D) (ε / 4) (by positivity),
      hLogAbsorb 1 D 1 zero_lt_one,
      Filter.eventually_ge_atTop Xband,
      Filter.eventually_ge_atTop (max (C₀ ^ 2) (max (2 * TN)
        (Real.exp (max 1 (26 * Kα / η ^ 2)))))]
      with x hscales hmomentAt hbetaAt hzeroAt hdiagonalAt htailAt hoffAbsorb
        htailAbsorb hxband hxlarge
    obtain ⟨hxexp, hxtwo, htarget, hscaleAt⟩ := hscales
    have hx1 : 1 ≤ x := (by norm_num : (1 : ℝ) ≤ 2).trans hxtwo
    have hx0 : 0 < x := zero_lt_one.trans_le hx1
    have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hxexp
    have hlog0 : 0 < Real.log x := zero_lt_one.trans_le hlog1
    have hC₀square : C₀ ^ 2 ≤ x := (le_max_left _ _).trans hxlarge
    have hTNx : 2 * TN ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans hxlarge)
    intro M N R Q γ hM hN hR hQ hMNlo hMNhi hNγ hγlo hγhi hNR hRhi hRQlo hRQhi
      α β hα hβ S hS a b₁ b₂ hprim
    have hMNlo₀ : x / C₀ ≤ M * N :=
      (div_le_div_of_nonneg_left hx0.le hCpos hCC₀).trans hMNlo
    have hMNhi₀ : M * N ≤ C₀ * x := hMNhi.trans
      (mul_le_mul_of_nonneg_right hCC₀ hx0.le)
    have hNR₀ : N ≤ C₀ * x ^ (δ + 4 * ε) * R := hNR.trans
      (mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_right hCC₀ (Real.rpow_nonneg hx0.le _)) hR.le)
    have hRhi₀ : R ≤ C₀ * x ^ (-2 * ε) * N := hRhi.trans
      (mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_right hCC₀ (Real.rpow_nonneg hx0.le _)) hN.le)
    have hRQlo₀ : x ^ (1 / 2 - ε) ≤ C₀ * R * Q := hRQlo.trans
      (mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_right hCC₀ hR.le) hQ.le)
    have hRQhi₀ : R * Q ≤ C₀ * x ^ (1 / 2 + 2 * «ω» + ε) := hRQhi.trans
      (mul_le_mul_of_nonneg_right hCC₀ (Real.rpow_nonneg hx0.le _))
    obtain ⟨hNone, hNx, hMone, hMx, hRx, hQx, hMshort⟩ :=
      hscaleAt M N R Q γ hM hN hR hQ hMNlo₀ hMNhi₀ hNγ hγlo hγhi hNR₀ hRhi₀ hRQhi₀
    have hSsimple : ∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Squarefree (p.1 * p.2) := by
      intro p hp
      exact ⟨(hS p hp).1, (hS p hp).2.1, (hS p hp).2.2.1⟩
    have hScoprime : ∀ p ∈ S, Nat.Coprime p.1 p.2 :=
      fun p hp => Nat.coprime_of_squarefree_mul (hSsimple p hp).2.2
    have hβpos (n : ℕ) (hn : n ∈ β.support) : 0 < n := by
      exact_mod_cast (mul_pos hcN hN).trans_le (hβ n hn).1
    have hαpos (n : ℕ) (hn : n ∈ α.support) : 0 < n := by
      exact_mod_cast (mul_pos hcM hM).trans_le (hα n hn).1
    let NI : ℕ := ⌊TN * N⌋₊
    have hβsupport : β.support ⊆ Finset.Icc 1 NI := fun n hn =>
      Finset.mem_Icc.mpr ⟨hβpos n hn, Nat.le_floor (hβ n hn).2.1⟩
    have hNI : (NI : ℝ) ≤ TN * N := Nat.floor_le (by positivity)
    have hNIx : (NI : ℝ) ≤ x ^ (2 : ℝ) := by
      rw [Real.rpow_two]
      calc
        (NI : ℝ) ≤ TN * N := hNI
        _ ≤ x * x := mul_le_mul (by linarith only [hTNx, hTNpos]) hNx hN.le hx0.le
        _ = x ^ 2 := (pow_two x).symm
    have hNIscale : (NI : ℝ) ≤ C₀ * N := hNI.trans
      (mul_le_mul_of_nonneg_right (by linarith only [hTN₀, hTNpos]) hN.le)
    let sm : Finset ℕ := Finset.Icc 1 ⌊(2 * TM) * M⌋₊
    let w : ℕ → ℝ := fun n => ψM ((n : ℝ) / M)
    have hsm : α.support ⊆ sm := by
      intro n hn
      refine Finset.mem_Icc.mpr ⟨hαpos n hn, Nat.le_floor ?_⟩
      exact (hα n hn).2.1.trans (by nlinarith only [hTMpos, hM])
    have hw0 : ∀ n ∈ sm, 0 ≤ w n := fun n _ => hMnonneg _
    have hw1 : ∀ n ∈ α.support, 1 ≤ w n := by
      intro n hn
      exact hMmajor _ ⟨(le_div_iff₀ hM).mpr (hα n hn).1,
        (div_le_iff₀ hM).mpr (hα n hn).2.1⟩
    have hψNmajor : ∀ n ∈ β.support, 1 ≤ ψN ((n : ℝ) / N) := by
      intro n hn
      exact hNmajor _ ⟨(le_div_iff₀ hN).mpr (hβ n hn).1,
        (div_le_iff₀ hN).mpr (hβ n hn).2.1⟩
    have hαmoment := hmomentAt M hM hMx α (fun n hn =>
      ⟨hαpos n hn, (hα n hn).2.1, (hα n hn).2.2⟩)
    let H : ℕ → ℝ := fun g => x ^ ε * R * Q ^ 2 / ((g : ℝ) * M)
    let X : ℕ → ℝ := fun g => x ^ (-5 * ε) * Q / H g
    let Y : Set.Ici (1 : ℝ) :=
      ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩
    obtain ⟨u₀, hu₀⟩ := opening_coherent_dense_selector Y Q hQ X
    let u : ℕ → ℕ → ℕ := fun g q =>
      if γ ≤ 1 / 2 - 2 * «ω» - δ / 2 ∧ 1 ≤ H g then u₀ g (g * q) else 1
    let shells : ℕ → ℕ := fun g => if H g < 1 then 0 else Nat.log 2 ⌊H g⌋₊ + 1
    let J : ℕ → Finset ℤ := fun g =>
      (Finset.Ioo (-((2 : ℤ) ^ shells g)) ((2 : ℤ) ^ shells g)).erase 0
    have hXwindow (g : ℕ) (hg : 0 < g)
        (hcut : γ ≤ 1 / 2 - 2 * «ω» - δ / 2) (hH : 1 ≤ H g) :
        1 ≤ X g ∧ X g ≤ Q := by
      have hg1 : (1 : ℝ) ≤ g := by exact_mod_cast hg
      have hlower := ((sourceHighGamma_scale_envelopes «ω» δ ε C₀ x M N R Q
        (H g) (g : ℝ) γ hω hδ hε hworking hsmall hC₀ hx1 hM hN hR hQ hg1
        hMNlo₀ hNγ hNR₀ hRhi₀ hRQhi₀ rfl hγhi).2 hγlo hcut).1
      exact opening_selector_target_window C₀ x ε Q (H g) (δ / 2 - 7 * ε) 1
        hC₀ hx1 hε.le hQ hH (by norm_num) htarget (by
          simpa only [Nat.cast_one, Real.rpow_neg hC₀pos.le, Real.rpow_two,
            one_div] using hlower)
    have hu : ∀ p₁ ∈ S, ∀ p₂ ∈ S, p₁.2 = p₂.2 →
        let g := Nat.gcd p₁.1 p₂.1
        0 < u g (p₁.1 / g) ∧ u g (p₁.1 / g) ∣ p₁.1 / g := by
      intro p₁ hp₁ p₂ hp₂ _ g
      have hg : 0 < g := Nat.gcd_pos_of_pos_left _ (hSsimple p₁ hp₁).1
      have hgq : g ∣ p₁.1 := Nat.gcd_dvd_left _ _
      by_cases huse : γ ≤ 1 / 2 - 2 * «ω» - δ / 2 ∧ 1 ≤ H g
      · have hrec : g * (p₁.1 / g) = p₁.1 := Nat.mul_div_cancel' hgq
        have hw := hXwindow g hg huse.1 huse.2
        obtain ⟨_, _, _, hlo, hhi, _, _, hdense, _, _⟩ := hS p₁ hp₁
        have hs := hu₀ g p₁.1 hg hgq hlo hhi hdense hw.1 hw.2
        simpa only [u, ite_eq_left huse, hrec] using ⟨hs.1, hs.2.2.1⟩
      · simp only [u, ite_eq_right huse, zero_lt_one, one_dvd, and_self]
    let Ω : Finset ((ℕ × ℕ) × (ℕ × ℕ)) :=
      (S ×ˢ S).filter (fun p => p.1.2 = p.2.2)
    let G : Finset ℕ := Ω.image (fun p => Nat.gcd p.1.1 p.2.1)
    let 𝒜 : ℕ → Finset (ℕ × ℕ × ℕ × ℕ) := fun g =>
      (Ω.filter (fun p => Nat.gcd p.1.1 p.2.1 = g)).image (fun p =>
        (p.1.2, u g (p.1.1 / g), (p.1.1 / g) / u g (p.1.1 / g), p.2.1 / g))
    let γβ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
    let L : ℕ → Finset ℤ := fun r =>
      ((γβ.support ×ˢ γβ.support).filter
        (fun p => p.1 ≠ p.2 ∧ Int.ModEq (r : ℤ) p.1 p.2)).image
          (fun p => (p.2 - p.1) / (r : ℤ))
    let LI : ℕ := ⌊(2 * TN) * N / R⌋₊
    let Lall : Finset ℤ := (Finset.Icc (-(LI : ℤ)) (LI : ℤ)).erase 0
    let bins : ℕ → Finset ℕ := fun g => (𝒜 g).image (fun t => Nat.log 2 t.2.1)
    let block : ℕ → ℤ → ℕ → Finset (ℕ × ℕ × ℕ × ℕ) := fun g ℓ i =>
      (𝒜 g).filter (fun t => ℓ ∈ L t.1 ∧ Nat.log 2 t.2.1 = i)
    have hfactor := mixedFourier_offDiagonal_gcd_shift_factorization
      sm w S β (fun _ => 0) a b₁ b₂ J u hSsimple hprim hu
    have hGdata (g : ℕ) (hg : g ∈ G) :
        0 < g ∧ Squarefree g ∧ (g : ℝ) ≤ 2 * Q ∧
        Nat.Coprime (a * b₁ * b₂) g ∧
        ∀ p ∈ g.primeFactors,
          Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (p : ℝ) := by
      obtain ⟨p, hpΩ, hpg⟩ := Finset.mem_image.mp hg
      obtain ⟨hp₁, _⟩ := Finset.mem_product.mp (Finset.mem_filter.mp hpΩ).1
      obtain ⟨hq, _, hsf, _, hqhi, _, _, _, _, hrough⟩ := hS p.1 hp₁
      have hgdvd : g ∣ p.1.1 := by
        rw [← hpg]
        exact Nat.gcd_dvd_left _ _
      have hgpos : 0 < g := by
        rw [← hpg]
        exact Nat.gcd_pos_of_pos_left _ hq
      have hgle : (g : ℝ) ≤ (p.1.1 : ℝ) := by
        exact_mod_cast Nat.le_of_dvd hq hgdvd
      refine ⟨hgpos, hsf.of_mul_left.squarefree_of_dvd hgdvd, hgle.trans hqhi,
        (hprim p.1 hp₁).of_dvd_right (dvd_mul_of_dvd_left hgdvd p.1.2), ?_⟩
      intro t ht
      exact hrough t (Nat.primeFactors_mono hgdvd hq.ne' ht)
    have hLall : ∀ r ∈ S.image Prod.snd, L r ⊆ Lall := by
      intro r hr ℓ hℓ
      have hℓne : ℓ ≠ 0 := (hfactor.2.1 r hr ℓ hℓ).1
      have hsupport0 : β.support ⊆ Finset.Icc 0 (0 + NI) := by
        intro n hn
        exact Finset.mem_Icc.mpr
          ⟨Nat.zero_le n, by simpa only [zero_add] using (Finset.mem_Icc.mp (hβsupport hn)).2⟩
      have hnat : ℓ.natAbs * r ≤ NI := hfactor.2.2.1 0 NI hsupport0 r hr ℓ hℓ
      have hRr : R ≤ (r : ℝ) := by
        obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hr
        obtain ⟨_, _, _, _, _, hrlow, _, _, _, _⟩ := hS p hp
        exact hrlow
      have hreal : (ℓ.natAbs : ℝ) * (r : ℝ) ≤ (NI : ℝ) := by exact_mod_cast hnat
      have hratio : (ℓ.natAbs : ℝ) ≤ (2 * TN) * N / R := by
        apply (le_div_iff₀ hR).2
        calc
          (ℓ.natAbs : ℝ) * R ≤ (ℓ.natAbs : ℝ) * (r : ℝ) :=
            mul_le_mul_of_nonneg_left hRr (Nat.cast_nonneg _)
          _ ≤ (NI : ℝ) := hreal
          _ ≤ TN * N := hNI
          _ ≤ (2 * TN) * N :=
            mul_le_mul_of_nonneg_right (by linarith only [hTNpos]) hN.le
      have hℓLI : ℓ.natAbs ≤ LI := Nat.le_floor hratio
      have hℓabs : |ℓ| ≤ (LI : ℤ) := by
        have hh : (ℓ.natAbs : ℤ) ≤ (LI : ℤ) := by exact_mod_cast hℓLI
        simpa only [Int.natCast_natAbs] using hh
      exact Finset.mem_erase.mpr ⟨hℓne, Finset.mem_Icc.mpr (abs_le.mp hℓabs)⟩
    have hSelected (g : ℕ) (hg : g ∈ G)
        (hcut : γ ≤ 1 / 2 - 2 * «ω» - δ / 2) (hH : 1 ≤ H g)
        (t : ℕ × ℕ × ℕ × ℕ) (ht : t ∈ 𝒜 g) :
        X g / ((g : ℝ) * x ^ δ) ≤ (t.2.1 : ℝ) ∧ (t.2.1 : ℝ) ≤ X g := by
      obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp ht
      have hpg := (Finset.mem_filter.mp hp).2
      have hpΩ := Finset.mem_filter.mp (Finset.mem_filter.mp hp).1
      obtain ⟨hp₁, _⟩ := Finset.mem_product.mp hpΩ.1
      have hgpos := (hGdata g hg).1
      have hgq : g ∣ p.1.1 := by rw [← hpg]; exact Nat.gcd_dvd_left _ _
      have hrec' : g * (p.1.1 / g) = p.1.1 := Nat.mul_div_cancel' hgq
      obtain ⟨_, _, _, hqlo, hqhi, _, _, hdense, _, _⟩ := hS p.1 hp₁
      have hwindow := hXwindow g hgpos hcut hH
      have hchoice := hu₀ g p.1.1 hgpos hgq hqlo hqhi hdense hwindow.1 hwindow.2
      have hY : (Y : ℝ) = x ^ δ := max_eq_right (Real.one_le_rpow hx1 hδ.le)
      simpa only [u, ite_eq_left (And.intro hcut hH), hrec', hY] using
        And.intro hchoice.2.2.2.2.1 hchoice.2.2.2.2.2.1
    have hBins (g : ℕ) (hg : g ∈ G) :
        ((bins g).card : ℝ) ≤ Bcount * Real.log x := by
      have hgpos := (hGdata g hg).1
      have hQsquare : 2 * Q ≤ x ^ 2 :=
        (opening_frequency_cutoff_power_bounds x ε M R Q g hxtwo hεone hMone
          hR.le hQ.le hRx hQx hgpos).2
      have hsubset : bins g ⊆ Finset.range (⌊2 * Real.log x / Real.log 2⌋₊ + 1) := by
        intro i hi
        obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hi
        obtain ⟨_, huPos, _, _, htS, _, _, _, _, _⟩ := (hfactor.1 g hg).2 t ht
        have hqPos : 0 < g * t.2.1 * t.2.2.1 := (hSsimple _ htS).1
        have huDvd : t.2.1 ∣ g * t.2.1 * t.2.2.1 :=
          dvd_mul_of_dvd_left (dvd_mul_left t.2.1 g) t.2.2.1
        have huUpper : (t.2.1 : ℝ) ≤ x ^ 2 := by
          calc
            (t.2.1 : ℝ) ≤ ((g * t.2.1 * t.2.2.1 : ℕ) : ℝ) := by
              exact_mod_cast Nat.le_of_dvd hqPos huDvd
            _ ≤ 2 * Q := by
              obtain ⟨_, _, _, _, hqhi, _, _, _, _, _⟩ := hS _ htS
              exact hqhi
            _ ≤ x ^ 2 := hQsquare
        simpa only [Nat.log2_eq_log_two] using
          (opening_selected_dyadic_log_budget x hx1 t.2.1 huPos huUpper).1
      have hcard : ((bins g).card : ℝ) ≤
          ((Finset.range (⌊2 * Real.log x / Real.log 2⌋₊ + 1)).card : ℝ) := by
        exact_mod_cast Finset.card_le_card hsubset
      have hbudget := (opening_selected_dyadic_log_budget x hx1 1 (by decide)
        (by simpa only [Nat.cast_one] using
          (show (1 : ℝ) ≤ x ^ 2 from by nlinarith only [hxtwo]))).2
      have hlog2 : 0 < Real.log 2 := Real.log_pos (by norm_num)
      have hnonneg : 0 ≤ (2 / Real.log 2) * Real.log x := by positivity
      calc
        ((bins g).card : ℝ) ≤ 2 * Real.log x / Real.log 2 + 1 := hcard.trans hbudget
        _ = (2 / Real.log 2) * Real.log x + 1 := by ring
        _ ≤ (2 / Real.log 2) * Real.log x + Real.log x := add_le_add_right hlog1 _
        _ ≤ 2 * ((2 / Real.log 2) * Real.log x + Real.log x) := by
          linarith only [hnonneg, hlog0.le]
        _ = Bcount * Real.log x := by dsimp only [Bcount]; ring
    have hShells (g : ℕ) (hg : g ∈ G) : (shells g : ℝ) ≤ Bcount * Real.log x := by
      have hupper := (opening_frequency_cutoff_power_bounds x ε M R Q g
        hxtwo hεone hMone hR.le hQ.le
        hRx hQx (hGdata g hg).1).1
      have hupperReal : H g ≤ x ^ (4 : ℝ) := by
        simpa only [H, Real.rpow_ofNat] using hupper
      simpa only [shells, Bcount] using opening_padded_count x (H g) hxexp hupperReal
    let Ebase : ℝ := M * N ^ 2 / R * (Real.log x) ^ (-D)
    have hEbase : 0 ≤ Ebase := by dsimp only [Ebase]; positivity
    have hSwitch (q : ℕ) (hq : Nat.Coprime (a * b₁ * b₂) q)
        (b : ℕ) (hb : b ∈ ({b₁, b₂} : Finset ℕ))
        (b' : ℕ) (hb' : b' ∈ ({b₁, b₂} : Finset ℕ)) :
        Nat.Coprime (a * b * b') q := by
      have ha : Nat.Coprime a q := hq.coprime_mul_right.coprime_mul_right
      have h₁ : Nat.Coprime b₁ q := hq.coprime_mul_right.coprime_mul_left
      have h₂ : Nat.Coprime b₂ q := hq.coprime_mul_left
      have hside (z : ℕ) (hz : z ∈ ({b₁, b₂} : Finset ℕ)) : Nat.Coprime z q := by
        simp only [Finset.mem_insert, Finset.mem_singleton] at hz
        rcases hz with rfl | rfl
        · exact h₁
        · exact h₂
      exact (ha.mul_left (hside b hb)).mul_left (hside b' hb')
    have hOffDiagonalBound (c : ℕ × ℕ → ℂ)
        (hc : ∀ p ∈ S, ‖c p‖ ≤ 1)
        (b : ℕ) (hb : b ∈ ({b₁, b₂} : Finset ℕ))
        (b' : ℕ) (hb' : b' ∈ ({b₁, b₂} : Finset ℕ)) :
        ‖∑ r ∈ S.image Prod.snd,
          ∑ p₁ ∈ S.filter (fun p => p.2 = r),
            ∑ p₂ ∈ S.filter (fun p => p.2 = r),
              c p₁ * star (c p₂) *
                ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                  if n₁ = n₂ then 0 else
                    β n₁ * star (β n₂) *
                      ∑ h ∈ J (Nat.gcd p₁.1 p₂.1),
                        mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b b' n₁ n₂
                          ((h : ZMod (r * Nat.lcm p₁.1 p₂.1)).val)‖ ≤ Ebase := by
      clear htailAt hzeroAt hdiagonalAt hαmoment
      have hprimSides : ∀ p ∈ S, Nat.Coprime (a * b * b') (p.1 * p.2) :=
        fun p hp => hSwitch _ (hprim p hp) b hb b' hb'
      let F : ℕ → ℤ → Finset (ℕ × ℕ × ℕ × ℕ) → Finset ℤ → ℂ :=
        fun g ℓ B J' =>
          ∑ t ∈ B,
            c (g * t.2.1 * t.2.2.1, t.1) * star (c (g * t.2.2.2, t.1)) *
              ((M : ℂ) / ((t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2 : ℕ) : ℂ)) *
                ∑ n ∈ γβ.support.filter (fun n =>
                  Int.gcd n ((t.1 * g * t.2.1 * t.2.2.1 : ℕ) : ℤ) = 1 ∧
                  Int.gcd (n + ℓ * (t.1 : ℤ)) ((g * t.2.2.2 : ℕ) : ℤ) = 1),
                  γβ n * star (γβ (n + ℓ * (t.1 : ℤ))) *
                    (sourceCompatibility t.1 g b b' ℓ n : ℂ) *
                      ∑ h ∈ J', sourcePhi ψM M
                        (t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2) h *
                          sourceTheta t.1 g t.2.1 t.2.2.1 t.2.2.2 a b b' ℓ n h
      let Jpos : ℕ → Finset ℤ := fun j =>
        Finset.Ico ((2 : ℤ) ^ j) ((2 : ℤ) ^ (j + 1))
      let Jneg : ℕ → Finset ℤ := fun j =>
        Finset.Ioc (-((2 : ℤ) ^ (j + 1))) (-((2 : ℤ) ^ j))
      let Fband : ℕ → ℤ → ℕ → ℕ → Bool → ℂ := fun g ℓ i j side =>
        F g ℓ (block g ℓ i) (if side then Jneg j else Jpos j)
      have hPoint : ∀ g ∈ G, ∀ ℓ ∈ (Finset.Icc (-(LI : ℤ)) (LI : ℤ)).erase 0,
          ∀ i ∈ bins g, ∀ j ∈ Finset.range (shells g), ∀ side : Bool,
            ‖Fband g ℓ i j side‖ ≤
              Kband * M * N * (Int.gcd (g : ℤ) ℓ : ℝ) / (g : ℝ) *
                x ^ (-ε / 4) := by
        intro g hg ℓ _hℓ i _hi j hj side
        have hgpos : 0 < g := (hGdata g hg).1
        by_cases hempty : block g ℓ i = ∅
        · simp only [Fband, F, hempty, Finset.sum_empty, norm_zero]
          positivity
        have hHone : 1 ≤ H g := by
          by_contra hbad
          have hsmallH : H g < 1 := lt_of_not_ge hbad
          simp [shells, hsmallH] at hj
        have hBlockGpos : 0 < (g : ℝ) := by exact_mod_cast hgpos
        have hBlockHpos : 0 < H g := zero_lt_one.trans_le hHone
        have hBlockTwo : (2 : ℝ) ≤ C₀ := (by norm_num : (2 : ℝ) ≤ 4).trans hC₀four
        have hPhase : ∀ t ∈ block g ℓ i,
            ‖c (g * t.2.1 * t.2.2.1, t.1)‖ ≤ 1 ∧
            ‖c (g * t.2.2.2, t.1)‖ ≤ 1 := by
          intro t ht
          obtain ⟨_, _, _, _, hp₁, hp₂, _, _, _, _⟩ :=
            (hfactor.1 g hg).2 t (Finset.mem_filter.mp ht).1
          exact ⟨hc _ hp₁, hc _ hp₂⟩
        have hPrimitive : ∀ t ∈ block g ℓ i, Nat.Coprime a t.1 := by
          intro t ht
          obtain ⟨_, _, _, _, hp₁, _, _, _, _, _⟩ :=
            (hfactor.1 g hg).2 t (Finset.mem_filter.mp ht).1
          have hp := hprimSides _ hp₁
          exact hp.coprime_mul_right.coprime_mul_right.of_dvd_right (dvd_mul_left _ _)
        have hbg : Nat.Coprime b g :=
          (hSwitch _ (hGdata g hg).2.2.2.1 b hb b' hb').coprime_mul_right.coprime_mul_left
        have hβCarrier : β.support ⊆ Finset.Icc 1 ⌊C₀ * N⌋₊ := by
          intro n hn
          refine Finset.mem_Icc.mpr ⟨hβpos n hn, Nat.le_floor ?_⟩
          exact (hβ n hn).2.1.trans (mul_le_mul_of_nonneg_right
            (by linarith only [hTN₀, hTNpos]) hN.le)
        have hβBound : ∀ n ∈ β.support, ‖β n‖ ≤ x ^ (ε / 100) := by
          intro n hn
          exact (hβ n hn).2.2.trans (hbetaAt n (hβpos n hn)
            ((hβ n hn).2.1.trans (mul_le_mul_of_nonneg_left hNx hTNpos.le)))
        have hβMajor : ∀ n ∈ β.support, 1 ≤ ψN (((n : ℝ) - 0) / N) := by
          intro n hn
          simpa only [sub_zero] using hψNmajor n hn
        have hjShell : j ∈ Finset.range (Nat.log 2 ⌊H g⌋₊ + 1) := by
          simpa only [shells, ite_eq_right (not_lt_of_ge hHone)] using hj
        have hShellWindow : 1 ≤ (2 : ℝ) ^ j ∧ (2 : ℝ) ^ j ≤ H g :=
          (padded_dyadic_cutoff_bounds (H g) hHone).2.2.2.2.2.2 j hjShell
        have hShellUpper : (2 : ℝ) ^ (j + 1) ≤ 2 * H g := by
          calc
            (2 : ℝ) ^ (j + 1) = 2 * (2 : ℝ) ^ j := by rw [pow_succ, mul_comm]
            _ ≤ 2 * H g := mul_le_mul_of_nonneg_left hShellWindow.2 zero_le_two
        have hJband : ∀ h ∈ (if side then Jneg j else Jpos j),
            h ≠ 0 ∧ |(h : ℝ)| ≤ 2 * H g := by
          intro h hh
          cases side with
          | false =>
            change h ∈ Finset.Ico ((2 : ℤ) ^ j) ((2 : ℤ) ^ (j + 1)) at hh
            have hmem := Finset.mem_Ico.mp hh
            have hpos : 0 < h := (pow_pos (by norm_num : (0 : ℤ) < 2) j).trans_le hmem.1
            refine ⟨ne_of_gt hpos, ?_⟩
            have hreal : (h : ℝ) < (2 : ℝ) ^ (j + 1) := by exact_mod_cast hmem.2
            have hrealpos : 0 ≤ (h : ℝ) := by exact_mod_cast hpos.le
            rw [abs_of_nonneg hrealpos]
            exact hreal.le.trans hShellUpper
          | true =>
            change h ∈ Finset.Ioc (-((2 : ℤ) ^ (j + 1))) (-((2 : ℤ) ^ j)) at hh
            have hmem := Finset.mem_Ioc.mp hh
            have hneg : h < 0 := hmem.2.trans_lt
              (neg_lt_zero.mpr (pow_pos (by norm_num : (0 : ℤ) < 2) j))
            refine ⟨ne_of_lt hneg, ?_⟩
            have hreal : -((2 : ℝ) ^ (j + 1)) < (h : ℝ) := by exact_mod_cast hmem.1
            have hrealneg : (h : ℝ) ≤ 0 := by exact_mod_cast hneg.le
            rw [abs_of_nonpos hrealneg]
            exact (show -(h : ℝ) ≤ (2 : ℝ) ^ (j + 1) by linarith only [hreal]).trans
              hShellUpper
        have hKbound (K : ℝ) (hK : K ≤ Kband) :
            K * M * N * (Int.gcd (g : ℤ) ℓ : ℝ) / (g : ℝ) * x ^ (-ε / 4) ≤
              Kband * M * N * (Int.gcd (g : ℤ) ℓ : ℝ) / (g : ℝ) * x ^ (-ε / 4) :=
          mul_le_mul_of_nonneg_right
            (div_le_div_of_nonneg_right
              (mul_le_mul_of_nonneg_right
                (mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_right hK hM.le) hN.le)
                (Nat.cast_nonneg _)) hBlockGpos.le)
            (Real.rpow_nonneg hx0.le _)
        by_cases hcut : γ ≤ 1 / 2 - 2 * «ω» - δ / 2
        · obtain ⟨t₀, ht₀⟩ := Finset.nonempty_iff_ne_empty.mpr hempty
          let U : ℝ := (2 : ℝ) ^ i
          let V : ℝ := Q / ((g : ℝ) * U)
          have hU : 0 < U := by dsimp only [U]; positivity
          have hTupleGeometry (t : ℕ × ℕ × ℕ × ℕ) (ht : t ∈ block g ℓ i) :
              0 < U ∧ 0 < V ∧ U * V = Q / (g : ℝ) ∧
              U ≤ (t.2.1 : ℝ) ∧ (t.2.1 : ℝ) ≤ 2 * U ∧
              V / 2 ≤ (t.2.2.1 : ℝ) ∧ (t.2.2.1 : ℝ) ≤ 2 * V ∧
              x ^ (-δ - 5 * ε) * Q / ((g : ℝ) * H g) ≤ 2 * U ∧
              U ≤ x ^ (-5 * ε) * Q / H g ∧
              x ^ (5 * ε) * H g / (g : ℝ) ≤ V ∧
              V ≤ 2 * x ^ (δ + 5 * ε) * H g := by
            have htA : t ∈ 𝒜 g := (Finset.mem_filter.mp ht).1
            have htbin : Nat.log 2 t.2.1 = i := (Finset.mem_filter.mp ht).2.2
            obtain ⟨_, htu, _, _, htS, _, _, _, _, _⟩ := (hfactor.1 g hg).2 t htA
            have huLo : U ≤ (t.2.1 : ℝ) := by
              have hn : 2 ^ i ≤ t.2.1 := by
                simpa only [htbin] using Nat.pow_log_le_self 2 htu.ne'
              dsimp only [U]
              exact_mod_cast hn
            have huHi : (t.2.1 : ℝ) < 2 * U := by
              have hn : t.2.1 < 2 ^ (i + 1) := by
                simpa only [htbin] using
                  Nat.lt_pow_succ_log_self (by norm_num : 1 < (2 : ℕ)) t.2.1
              have hr : (t.2.1 : ℝ) < (2 : ℝ) ^ (i + 1) := by exact_mod_cast hn
              simpa only [U, pow_succ, mul_comm] using hr
            obtain ⟨_, _, _, hqLo, hqHi, _, _, _, _, _⟩ := hS _ htS
            have hselection := hSelected g hg hcut hHone t htA
            exact opening_one_bin_geometry x δ ε Q (H g) U g t.2.1 t.2.2.1
              hx1 hQ hBlockHpos hU hgpos huLo huHi.le
              (by simpa only [Nat.cast_mul] using hqLo)
              (by simpa only [Nat.cast_mul] using hqHi) hselection.1 hselection.2
          obtain ⟨_, hV, hUV, _, _, _, _, _, _, hVloOne, hVhiTwo⟩ :=
            hTupleGeometry t₀ ht₀
          have hVlo : x ^ (5 * ε) * H g / (g : ℝ) ≤ C₀ * V :=
            hVloOne.trans (le_mul_of_one_le_left hV.le hC₀)
          have hVhi : V ≤ C₀ * x ^ (δ + 5 * ε) * H g :=
            hVhiTwo.trans (mul_le_mul_of_nonneg_right
              (mul_le_mul_of_nonneg_right hBlockTwo (Real.rpow_nonneg hx0.le _))
              hBlockHpos.le)
          have hUVhi : U * V ≤ C₀ * Q / (g : ℝ) := by
            rw [hUV]
            exact div_le_div_of_nonneg_right (le_mul_of_one_le_left hQ.le hC₀)
              hBlockGpos.le
          have hFamily : ∀ t ∈ block g ℓ i,
              0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
              Squarefree (t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2) ∧
              R ≤ (t.1 : ℝ) ∧ (t.1 : ℝ) ≤ 2 * R ∧
              (t.2.1 : ℝ) ≤ C₀ * U ∧ (t.2.2.1 : ℝ) ≤ C₀ * V ∧
              Q ≤ ((g * t.2.1 * t.2.2.1 : ℕ) : ℝ) ∧
              Q ≤ ((g * t.2.2.2 : ℕ) : ℝ) ∧
              ((g * t.2.2.2 : ℕ) : ℝ) ≤ C₀ * Q := by
            intro t ht
            have htA : t ∈ 𝒜 g := (Finset.mem_filter.mp ht).1
            obtain ⟨hrt, htu, htv, htq, htS₁, htS₂, _, _, hsf, _⟩ :=
              (hfactor.1 g hg).2 t htA
            obtain ⟨_, _, _, hq₁lo, _, hrlo, hrhi, _, _, _⟩ := hS _ htS₁
            obtain ⟨_, _, _, hq₂lo, hq₂hi, _, _, _, _, _⟩ := hS _ htS₂
            obtain ⟨_, _, _, _, huHi, _, hvHi, _, _, _, _⟩ := hTupleGeometry t ht
            exact ⟨hrt, htu, htv, htq, hsf, hrlo, hrhi,
              huHi.trans (mul_le_mul_of_nonneg_right hBlockTwo hU.le),
              hvHi.trans (mul_le_mul_of_nonneg_right hBlockTwo hV.le),
              hq₁lo, hq₂lo, hq₂hi.trans (mul_le_mul_of_nonneg_right hBlockTwo hQ.le)⟩
          have hDense : ∀ t ∈ block g ℓ i,
              Nonempty (DenseDivisibilityWitness
                Y 1 (t.1 * g * t.2.1 * t.2.2.1)) ∧
              Nonempty (DenseDivisibilityWitness
                Y 1 (t.1 * g * t.2.2.2)) := by
            intro t ht
            obtain ⟨_, _, _, _, htS₁, htS₂, _, _, _, _⟩ :=
              (hfactor.1 g hg).2 t (Finset.mem_filter.mp ht).1
            obtain ⟨_, _, _, _, _, _, _, hdq₁, hdr, _⟩ := hS _ htS₁
            obtain ⟨_, _, _, _, _, _, _, hdq₂, _, _⟩ := hS _ htS₂
            have hd₁ := source_single_dense_mul_same Y t.1 (g * t.2.1 * t.2.2.1) hdr hdq₁
            have hd₂ := source_single_dense_mul_same Y t.1 (g * t.2.2.2) hdr hdq₂
            simpa only [Nat.mul_assoc] using And.intro hd₁ hd₂
          have hYbound : (Y : ℝ) ≤ x ^ δ :=
            max_le (Real.one_le_rpow hx1 hδ.le) le_rfl
          have hraw := hSplitAt x ((le_max_right Xnear Xsplit).trans hxband)
            M N R Q (H g) U V γ hM hN hR hQ hU hV
            hMNlo₀ hNγ hNR₀ hRhi₀ hRQhi₀ hγlo hcut
            g a b b' hgpos rfl hHone hUVhi hVlo hVhi Y hYbound
            (block g ℓ i) (if side then Jneg j else Jpos j)
            hFamily hDense hJband hPrimitive hbg c hPhase ℓ 0 ψM ψN
            hsM hMbound hψN1 hsNsym hNnonneg hNbound β hβCarrier hβBound hβMajor
          dsimp only at hraw
          dsimp only [Fband, F]
          exact (norm_sum_le _ _).trans (hraw.trans (hKbound Ksplit hSplitK))
        · have hunit (t : ℕ × ℕ × ℕ × ℕ) (ht : t ∈ block g ℓ i) : t.2.1 = 1 := by
            have htA : t ∈ 𝒜 g := (Finset.mem_filter.mp ht).1
            obtain ⟨p, _, rfl⟩ := Finset.mem_image.mp htA
            have huse : ¬ (γ ≤ 1 / 2 - 2 * «ω» - δ / 2 ∧ 1 ≤ H g) :=
              fun h => hcut h.1
            simp only [u, ite_eq_right huse]
          have hFamily : ∀ t ∈ block g ℓ i,
              t.2.1 = 1 ∧ 0 < t.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
              Squarefree (t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2) ∧
              R ≤ (t.1 : ℝ) ∧ (t.1 : ℝ) ≤ 2 * R ∧
              Q ≤ ((g * t.2.2.1 : ℕ) : ℝ) ∧
              ((g * t.2.2.1 : ℕ) : ℝ) ≤ 2 * Q ∧
              Q ≤ ((g * t.2.2.2 : ℕ) : ℝ) ∧
              ((g * t.2.2.2 : ℕ) : ℝ) ≤ 2 * Q := by
            intro t ht
            have htA : t ∈ 𝒜 g := (Finset.mem_filter.mp ht).1
            obtain ⟨hrt, _, htv, htq, htS₁, htS₂, _, _, hsf, _⟩ :=
              (hfactor.1 g hg).2 t htA
            obtain ⟨_, _, _, hq₁lo, hq₁hi, hrlo, hrhi, _, _, _⟩ := hS _ htS₁
            obtain ⟨_, _, _, hq₂lo, hq₂hi, _, _, _, _, _⟩ := hS _ htS₂
            refine ⟨hunit t ht, hrt, htv, htq, hsf, hrlo, hrhi, ?_, ?_, hq₂lo, hq₂hi⟩
            · simpa only [hunit t ht, Nat.mul_one] using hq₁lo
            · simpa only [hunit t ht, Nat.mul_one] using hq₁hi
          have hraw := hNearAt x ((le_max_left Xnear Xsplit).trans hxband)
            M N R Q (H g) γ hM hN hR hQ hMNlo₀ hNγ hNR₀ hRhi₀ hRQhi₀
            (le_of_not_ge hcut) hγhi g a b b' rfl hHone
            (block g ℓ i) (if side then Jneg j else Jpos j)
            hFamily hJband hPrimitive hbg c hPhase ℓ 0 ψM ψN
            hsM hMbound hψN1 hsNsym hNnonneg hNbound β hβCarrier hβBound hβMajor
          dsimp only at hraw
          dsimp only [Fband, F]
          exact (norm_sum_le _ _).trans (hraw.trans (hKbound Knear hNearK))
      have htwoQ : 2 * Q ≤ x ^ 2 := by
        calc
          2 * Q ≤ 2 * x := mul_le_mul_of_nonneg_left hQx (by norm_num)
          _ ≤ x * x := mul_le_mul_of_nonneg_right hxtwo hx0.le
          _ = x ^ 2 := (pow_two x).symm
      have hQI : (⌊2 * Q⌋₊ : ℝ) ≤ x ^ 2 :=
        (Nat.floor_le (by positivity : 0 ≤ 2 * Q)).trans htwoQ
      have hGI : ∀ g ∈ G, 0 < g ∧ g ≤ ⌊2 * Q⌋₊ :=
        fun g hg => ⟨(hGdata g hg).1, Nat.le_floor (hGdata g hg).2.2.1⟩
      have hLI : (LI : ℝ) ≤ (2 * TN) * N / R := Nat.floor_le (by positivity)
      have hsum := opening_summed_bands x (ε / 6) Kband Bcount (2 * TN) M N R
        hxexp hKband.le hBcount.le (by positivity) hM.le hN.le hR
        G ⌊2 * Q⌋₊ LI bins shells Fband hGI hQI hLI hBins hShells (by
          simpa only [show -3 * (ε / 6) / 2 = -ε / 4 by ring] using hPoint)
      have hsplit := opening_off_diagonal_split (cM / 2) (2 * TM) M
        (by positivity) hMinterval hM ψM hsM S β c a b b' shells u
        hSsimple hprimSides hu Lall hLall
      have hLogProduct :
          (Real.log x) ^ (4 + D) * (Real.log x) ^ (-D) = (Real.log x) ^ 4 := by
        rw [← Real.rpow_add hlog0, show (4 + D) + (-D) = (4 : ℝ) by ring]
        norm_num
      have hXProduct : x ^ (ε / 4) * x ^ (-ε / 4) = 1 := by
        rw [← Real.rpow_add hx0, show ε / 4 + (-ε / 4) = 0 by ring,
          Real.rpow_zero]
      have hOffScalar :
          Koff * (Real.log x) ^ 4 * x ^ (-ε / 4) ≤ (Real.log x) ^ (-D) := by
        calc
          _ = (Koff * (Real.log x) ^ (4 + D)) *
              ((Real.log x) ^ (-D) * x ^ (-ε / 4)) := by
            calc
              _ = Koff * ((Real.log x) ^ (4 + D) * (Real.log x) ^ (-D)) *
                  x ^ (-ε / 4) := by rw [hLogProduct]
              _ = _ := by ring
          _ ≤ x ^ (ε / 4) *
              ((Real.log x) ^ (-D) * x ^ (-ε / 4)) :=
            mul_le_mul_of_nonneg_right hoffAbsorb (by positivity)
          _ = (Real.log x) ^ (-D) := by
            calc
              _ = (Real.log x) ^ (-D) *
                  (x ^ (ε / 4) * x ^ (-ε / 4)) := by ring
              _ = _ := by rw [hXProduct, mul_one]
      calc
        _ ≤ ∑ g ∈ G, ∑ ℓ ∈ Lall, ∑ i ∈ bins g, ∑ j ∈ Finset.range (shells g),
            (‖F g ℓ (block g ℓ i) (Jpos j)‖ +
              ‖F g ℓ (block g ℓ i) (Jneg j)‖) := hsplit
        _ ≤ 36 * Kband * Bcount ^ 2 * (2 * TN) * (M * N ^ 2 / R) *
            (Real.log x) ^ 4 * x ^ (-ε / 4) := by
          simpa only [Fband, Bool.false_eq_true, ↓reduceIte,
            show -3 * (ε / 6) / 2 = -ε / 4 by ring] using hsum
        _ = (M * N ^ 2 / R) *
            (Koff * (Real.log x) ^ 4 * x ^ (-ε / 4)) := by
          dsimp only [Koff]
          ring
        _ ≤ (M * N ^ 2 / R) * (Real.log x) ^ (-D) :=
          mul_le_mul_of_nonneg_left hOffScalar (by positivity)
        _ = Ebase := rfl
    clear hNearAt hSplitAt hfactor hSelected hGdata hLall hBins hShells hu hu₀ hXwindow hψNmajor
    have hbaseOne : 1 ≤ M * N ^ 2 / R := by
      have hRsmall : R ≤ C₀ * N := hRhi₀.trans (by
        have hpow := Real.rpow_le_one_of_one_le_of_nonpos hx1
          (show -2 * ε ≤ 0 by linarith only [hε])
        simpa only [mul_one] using mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left hpow hC₀pos.le) hN.le)
      have hMNbig : C₀ ≤ M * N := by
        calc
          C₀ = C₀ ^ 2 / C₀ := by field_simp
          _ ≤ x / C₀ := div_le_div_of_nonneg_right hC₀square hC₀pos.le
          _ ≤ M * N := hMNlo₀
      apply (le_div_iff₀ hR).mpr
      calc
        1 * R = R := one_mul R
        _ ≤ C₀ * N := hRsmall
        _ ≤ (M * N) * N := mul_le_mul_of_nonneg_right hMNbig hN.le
        _ = M * N ^ 2 := by ring
    have hTailSmall : x ^ (-1 : ℝ) ≤ Ebase := by
      have hlogpower : (Real.log x) ^ D ≤ x := by
        simpa only [one_mul, Real.rpow_one] using htailAbsorb
      have hinv := inv_anti₀ (Real.rpow_pos_of_pos hlog0 D) hlogpower
      calc
        x ^ (-1 : ℝ) ≤ (Real.log x) ^ (-D) := by
          simpa only [Real.rpow_neg_one, Real.rpow_neg hlog0.le] using hinv
        _ ≤ M * N ^ 2 / R * (Real.log x) ^ (-D) :=
          le_mul_of_one_le_left (Real.rpow_nonneg hlog0.le _) hbaseOne
    have hRlower : x ^ (-δ - 4 * ε) * N / C₀ ≤ R := by
      calc
        x ^ (-δ - 4 * ε) * N / C₀ = N / (C₀ * x ^ (δ + 4 * ε)) := by
          rw [show -δ - 4 * ε = -(δ + 4 * ε) by ring, Real.rpow_neg hx0.le]
          ring_nf
        _ ≤ R := (div_le_iff₀ (mul_pos hC₀pos (Real.rpow_pos_of_pos hx0 _))).mpr
          (by simpa only [mul_comm, mul_left_comm, mul_assoc] using hNR₀)
    have hScales : ∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Nat.Coprime p.1 p.2 ∧
        Q ≤ (p.1 : ℝ) ∧ (p.1 : ℝ) ≤ 2 * Q ∧
        R ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ 2 * R ∧
        (p.1 : ℝ) ≤ x ^ (2 : ℝ) ∧ (p.2 : ℝ) ≤ x ^ (2 : ℝ) := by
      intro p hp
      obtain ⟨hq, hr, _, hqlo, hqhi, hrlo, hrhi, _, _, _⟩ := hS p hp
      have hQ2 : 2 * Q ≤ x ^ 2 := by nlinarith only [hQx, hxtwo]
      have hR2 : 2 * R ≤ x ^ 2 := by nlinarith only [hRx, hxtwo]
      exact ⟨hq, hr, hScoprime p hp, hqlo, hqhi, hrlo, hrhi,
        by simpa only [Real.rpow_two] using hqhi.trans hQ2,
        by simpa only [Real.rpow_two] using hrhi.trans hR2⟩
    have hEnergy : ∀ c : ℕ × ℕ → ℂ, (∀ p ∈ S, ‖c p‖ = 1) →
        dispersionEnergy sm w S β c a b₁ b₂ ≤ 13 * Ebase := by
      intro c hc
      have hc' : ∀ p ∈ S, ‖c p‖ ≤ 1 := fun p hp => (hc p hp).le
      let Dcorr : ℕ → ℕ → ℂ := fun b b' =>
        ∑ r ∈ S.image Prod.snd,
          ∑ p₁ ∈ S.filter (fun p => p.2 = r),
            ∑ p₂ ∈ S.filter (fun p => p.2 = r),
              c p₁ * star (c p₂) *
                ∑ n ∈ β.support, β n * star (β n) *
                  (mixedFiberMass sm w p₁.1 p₂.1 r a b b' n n : ℂ)
      let Ocorr : ℕ → ℕ → ℂ := fun b b' =>
        ∑ r ∈ S.image Prod.snd,
          ∑ p₁ ∈ S.filter (fun p => p.2 = r),
            ∑ p₂ ∈ S.filter (fun p => p.2 = r),
              c p₁ * star (c p₂) *
                ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                  if n₁ = n₂ then 0 else β n₁ * star (β n₂) *
                    ∑ h ∈ J (Nat.gcd p₁.1 p₂.1),
                      mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b b' n₁ n₂
                        ((h : ZMod (r * Nat.lcm p₁.1 p₂.1)).val)
      apply opening_four_energy sm w S β c a b₁ b₂ Ebase Dcorr Ocorr
      · intro b hb b' hb'
        have hprimitive : ∀ p ∈ S, Nat.Coprime (a * b * b') (p.1 * p.2) :=
          fun p hp => hSwitch _ (hprim p hp) b hb b' hb'
        have htail := htailAt S β c NI M Q R hM hQ hR hβsupport hNIx
          (fun n hn => (hβ n hn).2.2) hc' hScales a b b' hprimitive ψM hψM hsM
          (by
            intro t
            simp only [Real.rpow_zero, mul_one]
            exact ⟨by simpa only [iteratedDeriv_zero] using
              (hCMbound 0 t).trans (le_max_left _ _),
              (hCMbound (k + 2) t).trans (le_max_right _ _)⟩) hMshort
        let V : ℕ → ℕ → ℕ → ℕ → ℕ → ℂ := fun r q₁ q₂ n₁ n₂ =>
          if n₁ = n₂ then (mixedFiberMass sm w q₁ q₂ r a b b' n₁ n₂ : ℂ)
          else mixedFiberFourierCoefficient sm w q₁ q₂ r a b b' n₁ n₂ 0 +
            ∑ h ∈ J (Nat.gcd q₁ q₂),
              mixedFiberFourierCoefficient sm w q₁ q₂ r a b b' n₁ n₂
                ((h : ZMod (r * Nat.lcm q₁ q₂)).val)
        have htail' :
            ‖mixedCorrelation sm w S β c a b b' -
                (∑ r ∈ S.image Prod.snd,
                  ∑ p₁ ∈ S.filter (fun p => p.2 = r),
                    ∑ p₂ ∈ S.filter (fun p => p.2 = r),
                      c p₁ * star (c p₂) *
                        ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                          β n₁ * star (β n₂) * V r p₁.1 p₂.1 n₁ n₂)‖ ≤ x ^ (-1 : ℝ) := by
          clear * - htail
          simpa only [opening_padded_window, V, J, shells, H, sm, w] using htail
        have hidentity := opening_truncated_identity sm w S β c a b b' J
        change
          (∑ r ∈ S.image Prod.snd,
            ∑ p₁ ∈ S.filter (fun p => p.2 = r),
              ∑ p₂ ∈ S.filter (fun p => p.2 = r),
                c p₁ * star (c p₂) *
                  ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                    β n₁ * star (β n₂) * V r p₁.1 p₂.1 n₁ n₂) =
            Dcorr b b' + offDiagonalZeroMode sm w S β c a b b' + Ocorr b b' at hidentity
        rw [hidentity] at htail'
        refine ⟨htail'.trans hTailSmall, ?_, hOffDiagonalBound c hc' b hb b' hb'⟩
        have hdiag := hdiagonalAt γ M Q R NI hγlo hγhi hM hQ hR
          (by simpa only [← hNγ] using hMNlo₀)
          (by simpa only [← hNγ] using hMNhi₀)
          (by simpa only [← hNγ] using hRlower)
          (by simpa only [← hNγ] using hRhi₀) hRQhi₀
          (by simpa only [← hNγ] using hNIscale) S β c hβsupport
          (fun n hn => (hβ n hn).2.2) hc'
          (fun p hp => by
            obtain ⟨hq, hr, hcp, hqlo, hqhi, hrlo, hrhi, _, _⟩ := hScales p hp
            exact ⟨hq, hr, hcp, hqlo, hqhi, hrlo, hrhi⟩)
          a b b' ψM (by
            intro t
            simpa only [Real.rpow_zero, mul_one, iteratedDeriv_zero, Real.norm_eq_abs]
              using hCMbound 0 t)
        calc
          ‖Dcorr b b'‖ ≤
              ∑ r ∈ S.image Prod.snd,
                ∑ p₁ ∈ S.filter (fun p => p.2 = r),
                  ∑ p₂ ∈ S.filter (fun p => p.2 = r),
                    ‖c p₁ * star (c p₂) *
                      (∑ n ∈ β.support, β n * star (β n) *
                        (mixedFiberMass sm w p₁.1 p₂.1 r a b b' n n : ℂ))‖ := by
            dsimp only [Dcorr]
            apply norm_sum_le_of_le
            intro r _
            apply norm_sum_le_of_le
            intro p₁ _
            exact norm_sum_le _ _
          _ ≤ Ebase := by simpa only [← hNγ, sm, w, Ebase] using hdiag
      · have hz := hzeroAt M N R Q hM hN hR hQ hMone hNx hQx hRhi
          sm S β c a b₁ b₂
          (fun n hn => ⟨hβpos n hn, (hβ n hn).2.1, (hβ n hn).2.2⟩) hc'
          (fun p hp => by
            obtain ⟨hq, hr, hcp, _, hqhi, hrlo, hrhi, _, _⟩ := hScales p hp
            exact ⟨hq, hr, hcp, hrlo, hrhi, hqhi⟩)
          hprim (fun p hp => (hS p hp).2.2.2.2.2.2.2.2.2)
        exact hz
    clear hOffDiagonalBound htailAt hzeroAt hdiagonalAt
    have hCauchy := opening_final_cauchy α β S sm w a b₁ b₂ R (13 * Ebase) hR
      (mul_nonneg (by norm_num) hEbase)
      (fun p hp => by
        obtain ⟨hq, hr, _, _, _, _, hrhi, _, _, _⟩ := hS p hp
        exact ⟨hq, hr, hrhi⟩) hprim hsm hw0 hw1 hEnergy
    refine opening_cauchy_logarithmic_absorption
      hM hN hR hKα hη hlog1
      ((le_max_right _ _).trans ((le_max_right _ _).trans hxlarge))
      (Finset.sum_nonneg fun _ _ => norm_nonneg _) hαmoment ?_
    simpa only [Ebase, D] using hCauchy
  obtain ⟨X₀, hX₀⟩ := hmain.exists_forall_of_atTop
  refine ⟨max (Real.exp 1) X₀, le_max_left _ _, ?_⟩
  intro x hx
  exact hX₀ x ((le_max_right _ _).trans hx)

end

open scoped Classical in
theorem sourceTypeI_II_triply_dense_uniform_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    («ω» δ σ : ℝ) (hω : 0 < «ω») (hδ : 0 < δ) (hσ : 0 < σ)
    (hA : 72 * «ω» + 24 * δ < 1)
    (hB : 48 * «ω» + 16 * δ + 4 * σ < 1)
    (hC : 64 * «ω» + 20 * δ + 2 * σ < 1)
    {ι : Type*} (M N : ℝ → ι → ℝ) (α β : ℝ → ι → ℕ →₀ ℂ)
    (c C W X₀ : ℝ) (k s : ℕ)
    (hc : 0 < c) (hCscale : 1 ≤ C) (hW : 0 ≤ W) (hX₀ : Real.exp 1 ≤ X₀)
    (hscale : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι,
      x / C ≤ M x i * N x i ∧ M x i * N x i ≤ C * x ∧
      x ^ (1 / 2 - σ) ≤ N x i ∧ N x i ≤ x ^ (1 / 2 : ℝ))
    (hsupport : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι,
      (∀ n ∈ (α x i).support,
        c * M x i ≤ (n : ℝ) ∧ (n : ℝ) ≤ C * M x i) ∧
      (∀ n ∈ (β x i).support,
        c * N x i ≤ (n : ℝ) ∧ (n : ℝ) ≤ C * N x i))
    (hcoeff : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι, ∀ n : ℕ,
      ‖α x i n‖ ≤ W * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ k ∧
      ‖β x i n‖ ≤ W * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ k)
    (hSW : ∀ A : ℝ, 0 < A →
      ∃ KSW XSW : ℝ, 0 < KSW ∧ X₀ ≤ XSW ∧
        ∀ x : ℝ, XSW ≤ x → ∀ i : ι,
        ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
          ‖fullDiscrepancy
              ((β x i).filter (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
            KSW * ((q * r).divisors.card : ℝ) ^ s * N x i /
              (Real.log x) ^ A) :
    ∀ A : ℝ, 0 < A →
      ∃ K X : ℝ, 0 < K ∧ X₀ ≤ X ∧
        ∀ x : ℝ, X ≤ x → ∀ i : ι,
        ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
        ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
          (∑ q ∈ tripleSourceModuli
              ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩
              ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊ I,
            ‖fullDiscrepancy (finiteConvolution (α x i) (β x i)) q a‖) ≤
              K * x / (Real.log x) ^ A := by
  classical
  have hdyadic_bin_count (x θ : ℝ) (Q : ℕ) (hx : Real.exp 1 ≤ x)
      (hθ : 0 ≤ θ) (hQ : Q ≤ ⌊x ^ θ⌋₊) :
      ((Nat.log 2 Q + 1 : ℕ) : ℝ) ≤
        (1 + θ / Real.log 2) * Real.log x := by
    have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
    have hlogx : 1 ≤ Real.log x := by
      simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hx
    have hlogtwo : 0 < Real.log 2 := Real.log_pos (by norm_num)
    have hQreal : (Q : ℝ) ≤ x ^ θ :=
      (show (Q : ℝ) ≤ (⌊x ^ θ⌋₊ : ℝ) by exact_mod_cast hQ).trans
        (Nat.floor_le (Real.rpow_nonneg hxpos.le θ))
    have hlogbound : (Nat.log 2 Q : ℝ) * Real.log 2 ≤ θ * Real.log x := by
      by_cases hQzero : Q = 0
      · simpa only [hQzero, Nat.log_zero_right, Nat.cast_zero, zero_mul] using
          mul_nonneg hθ (zero_le_one.trans hlogx)
      · have hpow : (2 : ℝ) ^ Nat.log 2 Q ≤ x ^ θ :=
          (show (2 : ℝ) ^ Nat.log 2 Q ≤ (Q : ℝ) by
            exact_mod_cast Nat.pow_log_le_self 2 hQzero).trans hQreal
        have h := Real.log_le_log (pow_pos (by norm_num : (0 : ℝ) < 2) _) hpow
        simpa only [Real.log_pow, Real.log_rpow hxpos] using h
    have hquot : (Nat.log 2 Q : ℝ) ≤ θ * Real.log x / Real.log 2 :=
      (le_div_iff₀ hlogtwo).2 hlogbound
    calc
      ((Nat.log 2 Q + 1 : ℕ) : ℝ) = (Nat.log 2 Q : ℝ) + 1 := by norm_num
      _ ≤ θ * Real.log x / Real.log 2 + Real.log x := add_le_add hquot hlogx
      _ = (1 + θ / Real.log 2) * Real.log x := by ring
  have hpair_dyadic_cover (S : Finset (ℕ × ℕ)) (w : ℕ × ℕ → ℝ) (U V : ℕ)
      (hS : ∀ p ∈ S, 0 < p.1 ∧ p.1 ≤ U ∧ 0 < p.2 ∧ p.2 ≤ V)
      (hw : ∀ p ∈ S, 0 ≤ w p) :
      (∑ p ∈ S, w p) ≤
        ∑ j ∈ Finset.Icc 0 (Nat.log 2 U),
          ∑ k ∈ Finset.Icc 0 (Nat.log 2 V),
            ∑ p ∈ S.filter (fun p =>
              2 ^ j ≤ p.1 ∧ p.1 ≤ 2 * 2 ^ j ∧
              2 ^ k ≤ p.2 ∧ p.2 ≤ 2 * 2 ^ k), w p := by
    have hmap : ∀ p ∈ S, (Nat.log 2 p.1, Nat.log 2 p.2) ∈
        (Finset.Icc 0 (Nat.log 2 U)) ×ˢ (Finset.Icc 0 (Nat.log 2 V)) := by
      intro p hp
      exact Finset.mem_product.mpr
        ⟨Finset.mem_Icc.mpr ⟨Nat.zero_le _, Nat.log_mono_right (b := 2) (hS p hp).2.1⟩,
          Finset.mem_Icc.mpr ⟨Nat.zero_le _, Nat.log_mono_right (b := 2) (hS p hp).2.2.2⟩⟩
    calc
      (∑ p ∈ S, w p) = ∑ j ∈ Finset.Icc 0 (Nat.log 2 U),
          ∑ k ∈ Finset.Icc 0 (Nat.log 2 V),
            ∑ p ∈ S.filter (fun p => Nat.log 2 p.1 = j ∧ Nat.log 2 p.2 = k), w p := by
        simpa only [Finset.sum_product, Prod.mk.injEq] using
          (Finset.sum_fiberwise_of_maps_to hmap w).symm
      _ ≤ _ := by
        apply Finset.sum_le_sum
        intro j _
        apply Finset.sum_le_sum
        intro k _
        apply Finset.sum_le_sum_of_subset_of_nonneg
        · intro p hp
          obtain ⟨hpS, hj, hk⟩ := Finset.mem_filter.mp hp
          refine Finset.mem_filter.mpr ⟨hpS, ?_, ?_, ?_, ?_⟩
          · simpa only [hj] using Nat.pow_log_le_self 2 (hS p hpS).1.ne'
          · simpa only [hj, pow_succ, Nat.mul_comm] using
              (Nat.lt_pow_succ_log_self (by norm_num : 1 < 2) p.1).le
          · simpa only [hk] using Nat.pow_log_le_self 2 (hS p hpS).2.2.1.ne'
          · simpa only [hk, pow_succ, Nat.mul_comm] using
              (Nat.lt_pow_succ_log_self (by norm_num : 1 < 2) p.2).le
        · intro p hp _
          exact hw p (Finset.mem_filter.mp hp).1
  have hprime_product_pos (P : Finset ℕ) (hP : ∀ t ∈ P, Nat.Prime t) :
      0 < ∏ t ∈ P, t :=
    Finset.prod_pos (fun t ht => (hP t ht).pos)
  have hrough_data (Y Z : Set.Ici (1 : ℝ)) (B cutoff D U V : ℕ)
      (T : ℝ) (P : Finset ℕ) (hP : ∀ t ∈ P, Nat.Prime t)
      (p : ℕ × ℕ) (hp : p ∈ roughTripleFactorPairs Y Z B cutoff D U V T P) :
      0 < p.1 ∧ 0 < p.2 ∧ Squarefree (p.1 * p.2) ∧
        p.1 * p.2 ∣ (∏ t ∈ P, t) ∧ D ≤ p.1 * p.2 ∧ p.1 * p.2 ≤ 2 * D ∧
        (smallPrimePart B (p.1 * p.2) : ℝ) ≤ (Z : ℝ) ∧
        T / (Y : ℝ) ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ T * (Z : ℝ) ∧
        Nonempty (DenseDivisibilityWitness
          (inflatedScale Y Z) 1 p.1) ∧
        Nonempty (DenseDivisibilityWitness
          (inflatedScale Y Z) 1 p.2) ∧
        (∀ t ∈ p.1.primeFactors, B < t) := by
    classical
    obtain ⟨hrect, hsource, hsmall, hrough, hlo, hhi, hdense₁, hdense₂⟩ :=
      Finset.mem_filter.mp hp
    obtain ⟨htriple, hDlo, hDhi⟩ := Finset.mem_filter.mp hsource
    obtain ⟨_, hprodDiv, _⟩ := Finset.mem_filter.mp htriple
    have hsfP : Squarefree (∏ t ∈ P, t) := by
      apply Finset.squarefree_prod_of_pairwise_isCoprime
      · intro s hs t ht hst
        exact Nat.coprime_iff_isRelPrime.mp
          ((Nat.coprime_primes (hP s hs) (hP t ht)).mpr hst)
      · intro t ht
        exact (hP t ht).squarefree
    refine ⟨(Finset.mem_Ioc.mp (Finset.mem_product.mp hrect).1).1,
      (Finset.mem_Ioc.mp (Finset.mem_product.mp hrect).2).1,
      hsfP.squarefree_of_dvd hprodDiv, hprodDiv, hDlo, hDhi, hsmall,
      hlo, hhi, hdense₁, hdense₂, ?_⟩
    intro t ht
    have hPrough : ∀ s ∈ P.filter (fun s => B < s), Nat.Prime s :=
      fun s hs => hP s (Finset.mem_filter.mp hs).1
    have ht' : t ∈ P.filter (fun s => B < s) := by
      rw [← Nat.primeFactors_prod hPrough]
      exact Nat.primeFactors_mono hrough
        (hprime_product_pos (P.filter (fun s => B < s)) hPrough).ne' ht
    exact (Finset.mem_filter.mp ht').2
  have hprimitive_average_le (G : ℕ) (hG : 0 < G) (F : ℕ → ℝ) (E : ℝ)
      (hF : ∀ b ∈ primitiveResidues G, F b ≤ E) :
      (∑ b ∈ primitiveResidues G, F b) / (G.totient : ℝ) ≤ E := by
    have hcard : (primitiveResidues G).card = G.totient := by
      unfold primitiveResidues
      rw [Nat.totient_eq_card_coprime]
      congr 1
      ext b
      simp only [Finset.mem_filter, Nat.coprime_comm]
    have hphi : (G.totient : ℝ) ≠ 0 := by
      exact_mod_cast (Nat.totient_pos.mpr hG).ne'
    calc
      (∑ b ∈ primitiveResidues G, F b) / (G.totient : ℝ) ≤
          (∑ b ∈ primitiveResidues G, E) / (G.totient : ℝ) :=
        div_le_div_of_nonneg_right (Finset.sum_le_sum hF) (Nat.cast_nonneg _)
      _ = E := by
        rw [Finset.sum_const, nsmul_eq_mul, hcard]
        exact mul_div_cancel_left₀ E hphi
  have hselect_pairs (Y Z : Set.Ici (1 : ℝ)) (B cutoff : ℕ)
      (T : ℝ) (P : Finset ℕ) (hP : ∀ t ∈ P, Nat.Prime t) (hT : 1 ≤ T)
      (E : Finset ℕ)
      (hE : ∀ n ∈ E, n ∈ tripleSourceModuli Y cutoff P ∧ T ≤ (n : ℝ) ∧
        (smallPrimePart B n : ℝ) ≤ (Z : ℝ)) :
      ∃ S : Finset (ℕ × ℕ),
        (∀ F : ℕ → ℝ, (∑ n ∈ E, F n) = ∑ p ∈ S, F (p.1 * p.2)) ∧
        ∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Squarefree (p.1 * p.2) ∧
          p.1 * p.2 ∈ E ∧ p.1 * p.2 ∣ (∏ t ∈ P, t) ∧
          T / (Y : ℝ) ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ T * (Z : ℝ) ∧
          Nonempty (DenseDivisibilityWitness
            (inflatedScale Y Z) 1 p.1) ∧
          Nonempty (DenseDivisibilityWitness
            (inflatedScale Y Z) 1 p.2) ∧
          (∀ t ∈ p.1.primeFactors, B < t) := by
    classical
    let U : ℕ := ⌈2 * (cutoff : ℝ) * (Y : ℝ) / T⌉₊
    let V : ℕ := ⌈T * (Z : ℝ)⌉₊
    have hTpos : 0 < T := zero_lt_one.trans_le hT
    have hYpos : 0 < (Y : ℝ) := zero_lt_one.trans_le Y.property
    have hV : T * (Z : ℝ) ≤ (V : ℝ) := Nat.le_ceil _
    have hex : ∀ n : ℕ, ∃ p : ℕ × ℕ, n ∈ E →
        p ∈ roughTripleFactorPairs Y Z B cutoff n U V T P ∧ p.1 * p.2 = n := by
      intro n
      by_cases hn : n ∈ E
      · obtain ⟨hsource, hTn, hsmall⟩ := hE n hn
        have hncut : n ≤ cutoff :=
          (Finset.mem_Icc.mp (Finset.mem_filter.mp hsource).1).2
        have hncutR : (n : ℝ) ≤ (cutoff : ℝ) := by exact_mod_cast hncut
        have hU : 2 * (n : ℝ) * (Y : ℝ) / T ≤ (U : ℝ) := by
          calc
            2 * (n : ℝ) * (Y : ℝ) / T ≤
                2 * (cutoff : ℝ) * (Y : ℝ) / T :=
              div_le_div_of_nonneg_right
                (mul_le_mul_of_nonneg_right
                  (mul_le_mul_of_nonneg_left hncutR (by norm_num)) hYpos.le) hTpos.le
            _ ≤ (U : ℝ) := Nat.le_ceil _
        have hdyadic : n ∈ dyadicTripleSourceModuli Y cutoff n P :=
          Finset.mem_filter.mpr ⟨hsource, le_rfl, by omega⟩
        obtain ⟨p, hp, hprod⟩ :=
          exists_roughTripleFactorPair Y Z B cutoff n U V T P hP hT hTn hU hV
            hdyadic hsmall
        exact ⟨p, fun _ => ⟨hp, hprod⟩⟩
      · exact ⟨(0, 0), fun h => (hn h).elim⟩
    choose pick hpick using hex
    have hinj : Set.InjOn pick E := by
      intro n hn m hm hnm
      exact (hpick n hn).2.symm.trans
        ((congrArg (fun p : ℕ × ℕ => p.1 * p.2) hnm).trans (hpick m hm).2)
    refine ⟨E.image pick, ?_, ?_⟩
    · intro F
      rw [Finset.sum_image hinj]
      apply Finset.sum_congr rfl
      intro n hn
      rw [(hpick n hn).2]
    · intro p hp
      obtain ⟨n, hn, rfl⟩ := Finset.mem_image.mp hp
      obtain ⟨hp, hprod⟩ := hpick n hn
      obtain ⟨hpos₁, hpos₂, hsf, hdiv, _, _, _, hlo, hhi, hdense₁, hdense₂,
        hrough⟩ := hrough_data Y Z B cutoff n U V T P hP (pick n) hp
      refine ⟨hpos₁, hpos₂, hsf, ?_, hdiv, hlo, hhi, hdense₁, hdense₂, hrough⟩
      simpa only [hprod] using hn
  obtain ⟨ω', δ', ε, hωw, hδw, hε, hεsmall, _, hεδ, hwork, _, _,
    hγlower, hγoverlap, hσlt, _, _, hωsmall, hδsmall⟩ :=
    source_typeI_II_parameter_retreat «ω» δ σ hω hδ hA hB hC
  have hω' : 0 < ω' := hω.trans hωw
  have hδ' : 0 < δ' := hδ.trans hδw
  have hεltδ : ε < δ' := hεsmall.trans_le
    (div_le_self hδ'.le (by norm_num : (1 : ℝ) ≤ 10 ^ 100))
  have hεbound : ε < 1 / 24 := hεltδ.trans hδsmall
  have hσgap : 0 < 1 / 2 - σ := by linarith only [hσ, hσlt]
  let θ : ℝ := 1 / 2 + 2 * «ω»
  have hθpos : 0 < θ := by dsimp only [θ]; linarith only [hω]
  have hθlt : θ < 1 := by dsimp only [θ]; linarith only [hωw, hωsmall]
  have hCpos : 0 < C := zero_lt_one.trans_le hCscale
  let C' : ℝ := max 4 (max C W)
  let c' : ℝ := min c 1
  have hC'4 : 4 ≤ C' := le_max_left _ _
  have hC'C : C ≤ C' := (le_max_left C W).trans (le_max_right _ _)
  have hC'W : W ≤ C' := (le_max_right C W).trans (le_max_right _ _)
  have hC' : 1 ≤ C' := by linarith only [hC'4]
  have hc' : 0 < c' := lt_min hc zero_lt_one
  have hc'c : c' ≤ c := min_le_left _ _
  have hc'C' : c' ≤ C' := (min_le_right _ _).trans hC'
  have hCevent : ∀ᶠ x : ℝ in Filter.atTop, C ≤ x ^ (1 / 4 : ℝ) :=
    (tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 4)).eventually
      (Filter.eventually_ge_atTop C)
  obtain ⟨XC, hXC⟩ := Filter.eventually_atTop.mp hCevent
  let Xbase : ℝ := max X₀ XC
  have hXbase₀ : X₀ ≤ Xbase := le_max_left _ _
  have hXbase : Real.exp 1 ≤ Xbase := hX₀.trans hXbase₀
  have hbalanced : ∀ x : ℝ, Xbase ≤ x → ∀ i : ι,
      x / C ≤ M x i * N x i ∧ M x i * N x i ≤ C * x ∧
      x ^ (1 / 8 : ℝ) ≤ M x i ∧ x ^ (1 / 8 : ℝ) ≤ N x i := by
    intro x hx i
    have hx₀ : X₀ ≤ x := hXbase₀.trans hx
    have hxexp : Real.exp 1 ≤ x := hX₀.trans hx₀
    have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
    have hx1 : 1 ≤ x :=
      (Real.one_le_exp_iff.mpr (by norm_num : (0 : ℝ) ≤ 1)).trans hxexp
    obtain ⟨hMNlo, hMNhi, hNlo, hNhi⟩ := hscale x hx₀ i
    have hNpos : 0 < N x i := (Real.rpow_pos_of_pos hxpos _).trans_le hNlo
    have hMpos : 0 < M x i :=
      pos_of_mul_pos_left ((div_pos hxpos hCpos).trans_le hMNlo) hNpos.le
    have hCp : C ≤ x ^ (1 / 4 : ℝ) := hXC x ((le_max_right _ _).trans hx)
    have hMquarter : x ^ (1 / 4 : ℝ) ≤ M x i := by
      refine le_of_mul_le_mul_right ?_ (mul_pos hCpos hNpos)
      calc
        x ^ (1 / 4 : ℝ) * (C * N x i) ≤
            x ^ (1 / 4 : ℝ) * (x ^ (1 / 4 : ℝ) * x ^ (1 / 2 : ℝ)) :=
          mul_le_mul_of_nonneg_left
            (mul_le_mul hCp hNhi hNpos.le (Real.rpow_nonneg hxpos.le _))
            (Real.rpow_nonneg hxpos.le _)
        _ = x := by
          rw [← Real.rpow_add hxpos, ← Real.rpow_add hxpos]
          norm_num
        _ ≤ M x i * (C * N x i) := by
          have hm := (div_le_iff₀ hCpos).mp hMNlo
          nlinarith only [hm]
    refine ⟨hMNlo, hMNhi, ?_, ?_⟩
    · exact (Real.rpow_le_rpow_of_exponent_le hx1 (by norm_num)).trans hMquarter
    · exact (Real.rpow_le_rpow_of_exponent_le hx1
        (by linarith only [hσlt] : (1 / 8 : ℝ) ≤ 1 / 2 - σ)).trans hNlo
  have hsupportBase := fun x (hx : Xbase ≤ x) => hsupport x (hXbase₀.trans hx)
  have hcoeffBase := fun x (hx : Xbase ≤ x) => hcoeff x (hXbase₀.trans hx)
  have hSWbase : ∀ A : ℝ, 0 < A →
      ∃ KSW XSW : ℝ, 0 < KSW ∧ Xbase ≤ XSW ∧
        ∀ x : ℝ, XSW ≤ x → ∀ i : ι,
        ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
          ‖fullDiscrepancy ((β x i).filter (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
            KSW * ((q * r).divisors.card : ℝ) ^ s * N x i / (Real.log x) ^ A := by
    intro A hA
    obtain ⟨KSW, XSW, hKSW, _, hSW'⟩ := hSW A hA
    exact ⟨KSW, max Xbase XSW, hKSW, le_max_left _ _,
      fun x hx => hSW' x ((le_max_right _ _).trans hx)⟩
  intro A hA
  obtain ⟨B, KBV, XBV, hBpos, hKBV, hXBV, hBV⟩ :=
    balanced_bv_masked_uniform_log_saving M N α β c C W (1 / 8) Xbase k s
      hc hCscale hW (by norm_num) hXbase hbalanced hsupportBase hcoeffBase hSWbase A hA
  obtain ⟨KM, XM, hKM, hXM, hMean⟩ :=
    balanced_bv_meanTerm_uniform_log_saving M N α β c C W (1 / 8) Xbase k s
      hc hCscale hW (by norm_num) hXbase hbalanced hsupportBase hcoeffBase hSWbase
      θ (1 / 2 - 2 * ε) hθpos.le (by linarith only [hε]) A hA
  obtain ⟨KE, XE, hKE, hXE, hExceptional⟩ :=
    exceptional_smallPrimePart_fullDiscrepancy_log_saving
      θ hθpos hθlt (2 * k + 1) 0 (2 * k : ℕ) (C ^ 3)
      (one_le_pow₀ hCscale) A hA
  obtain ⟨XL, hXL, hLow⟩ :=
    sourceDeltaZero_rough_dyadic_uniform_log_saving_of_deligne
      hDeligne ω' δ' ε C' c' C' c' C' hω' hδ' hε hwork hεsmall
      hC' hc' hc'C' hc' hc'C' k k k k (A + 2) 1 (by linarith only [hA]) zero_lt_one
  suffices hHighSource :
      ∃ XH : ℝ, Real.exp 1 ≤ XH ∧
        ∀ x : ℝ, XH ≤ x → ∀ M N R Q γ : ℝ,
        0 < M → 0 < N → 0 < R → 0 < Q →
        x / C' ≤ M * N → M * N ≤ C' * x → N = x ^ γ →
        1 / 4 + 14 * ω' + 4 * δ' + 100 * ε ≤ γ → γ ≤ 1 / 2 →
        N ≤ C' * x ^ (δ' + 4 * ε) * R →
        R ≤ C' * x ^ (-2 * ε) * N →
        x ^ (1 / 2 - ε) ≤ C' * R * Q →
        R * Q ≤ C' * x ^ (1 / 2 + 2 * ω' + ε) →
        ∀ α' β' : ℕ →₀ ℂ,
        (∀ n ∈ α'.support,
          c' * M ≤ (n : ℝ) ∧ (n : ℝ) ≤ C' * M ∧
          ‖α' n‖ ≤ C' * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ (k : ℝ)) →
        (∀ n ∈ β'.support,
          c' * N ≤ (n : ℝ) ∧ (n : ℝ) ≤ C' * N ∧
          ‖β' n‖ ≤ C' * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ (k : ℝ)) →
        ∀ S : Finset (ℕ × ℕ),
        (∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Squarefree (p.1 * p.2) ∧
          Q ≤ (p.1 : ℝ) ∧ (p.1 : ℝ) ≤ 2 * Q ∧
          R ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ 2 * R ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (x ^ δ'), le_max_left (1 : ℝ) (x ^ δ')⟩ 1 p.1) ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (x ^ δ'), le_max_left (1 : ℝ) (x ^ δ')⟩ 1 p.2) ∧
          (∀ t ∈ p.1.primeFactors,
            Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (t : ℝ))) →
        ∀ a b₁ b₂ : ℕ,
        (∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2)) →
        (∑ p ∈ S, ‖deltaZero (finiteConvolution α' β') p.1 p.2 a b₁ b₂‖) ≤
          1 * (M * N) * (Real.log x) ^ (-(A + 2)) by
    obtain ⟨XH, hXH, hHigh⟩ := hHighSource
    have hZevent : ∀ᶠ x : ℝ in Filter.atTop,
        Real.exp ((Real.log x) ^ (2 / 3 : ℝ)) ≤ x ^ ε := by
      simpa only [Real.rpow_zero, one_mul] using
        small_prime_density_scale_absorption 0 ε hε
    have hLogevent : ∀ᶠ x : ℝ in Filter.atTop,
        ‖(Real.log x) ^ B‖ ≤ ‖x ^ ε‖ := by
      simpa only [one_mul] using
        (isLittleO_log_rpow_rpow_atTop B hε).bound (by norm_num : (0 : ℝ) < 1)
    obtain ⟨XZ, hXZ⟩ := Filter.eventually_atTop.mp hZevent
    obtain ⟨XP, hXP⟩ := Filter.eventually_atTop.mp hLogevent
    let X : ℝ := max XBV (max XM (max XE (max XL (max XH (max XZ XP)))))
    let Dθ : ℝ := 1 + θ / Real.log 2
    have hDθ : 0 < Dθ := by
      dsimp only [Dθ]
      exact add_pos zero_lt_one (div_pos hθpos (Real.log_pos (by norm_num)))
    let K : ℝ := KBV + KE * W ^ 2 + KM + C * Dθ ^ 2
    have hK : 0 < K := by
      dsimp only [K]
      positivity
    refine ⟨K, X, hK, hXbase₀.trans (hXBV.trans (le_max_left _ _)), ?_⟩
    intro x hx i I hI a ha
    have hxBV : XBV ≤ x := (le_max_left _ _).trans hx
    have hxM : XM ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans hx)
    have hxE : XE ≤ x := (le_max_left _ _).trans
      ((le_max_right _ _).trans ((le_max_right _ _).trans hx))
    have hxL : XL ≤ x := (le_max_left _ _).trans
      ((le_max_right _ _).trans ((le_max_right _ _).trans ((le_max_right _ _).trans hx)))
    have hxH : XH ≤ x := (le_max_left _ _).trans
      ((le_max_right _ _).trans ((le_max_right _ _).trans
        ((le_max_right _ _).trans ((le_max_right _ _).trans hx))))
    have hxZ : XZ ≤ x := (le_max_left _ _).trans
      ((le_max_right _ _).trans ((le_max_right _ _).trans ((le_max_right _ _).trans
        ((le_max_right _ _).trans ((le_max_right _ _).trans hx)))))
    have hxP : XP ≤ x := (le_max_right _ _).trans
      ((le_max_right _ _).trans ((le_max_right _ _).trans ((le_max_right _ _).trans
        ((le_max_right _ _).trans ((le_max_right _ _).trans hx)))))
    have hxbase : Xbase ≤ x := hXBV.trans hxBV
    have hx₀ : X₀ ≤ x := hXbase₀.trans hxbase
    have hxexp : Real.exp 1 ≤ x := hX₀.trans hx₀
    have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
    have hx1 : 1 ≤ x :=
      (Real.one_le_exp_iff.mpr (by norm_num : (0 : ℝ) ≤ 1)).trans hxexp
    have hlog1 : 1 ≤ Real.log x := by
      simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hxexp
    have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlog1
    obtain ⟨hMNlo, hMNhi, hNlo, hNhi⟩ := hscale x hx₀ i
    have hNpos : 0 < N x i := (Real.rpow_pos_of_pos hxpos _).trans_le hNlo
    have hMpos : 0 < M x i :=
      pos_of_mul_pos_left ((div_pos hxpos hCpos).trans_le hMNlo) hNpos.le
    have hMNpos : 0 < M x i * N x i := mul_pos hMpos hNpos
    let f : ℕ →₀ ℂ := finiteConvolution (α x i) (β x i)
    let Y : Set.Ici (1 : ℝ) :=
      ⟨max 1 (x ^ δ), le_max_left (1 : ℝ) (x ^ δ)⟩
    let Z : Set.Ici (1 : ℝ) :=
      ⟨Real.exp ((Real.log x) ^ (2 / 3 : ℝ)),
        Real.one_le_exp_iff.mpr (Real.rpow_nonneg hlogpos.le _)⟩
    let cutoff : ℕ := ⌊x ^ θ⌋₊
    let cutoffSmall : ℕ := ⌊x ^ (1 / 2 - ε)⌋₊
    let Brough : ℕ := ⌊Real.exp ((Real.log x) ^ (1 / 3 : ℝ))⌋₊
    let S₀ : Finset ℕ := tripleSourceModuli Y cutoff I
    let E : Finset ℕ := S₀.filter fun q =>
      cutoffSmall < q ∧ (smallPrimePart Brough q : ℝ) ≤ (Z : ℝ)
    let T : ℝ := x ^ (-3 * ε) * N x i
    have hY : (Y : ℝ) = x ^ δ := max_eq_right
      (Real.one_le_rpow hx1 hδ.le)
    have hZ : (Z : ℝ) ≤ x ^ ε := hXZ x hxZ
    have hYworking : (inflatedScale Y Z : ℝ) ≤ max 1 (x ^ δ') := by
      change (Y : ℝ) * (Z : ℝ) ≤ max 1 (x ^ δ')
      calc
        (Y : ℝ) * (Z : ℝ) ≤ x ^ δ * x ^ ε := by
          rw [hY]
          exact mul_le_mul_of_nonneg_left hZ (Real.rpow_nonneg hxpos.le _)
        _ = x ^ (δ + ε) := (Real.rpow_add hxpos _ _).symm
        _ ≤ x ^ δ' := Real.rpow_le_rpow_of_exponent_le hx1 (by linarith only [hεδ, hε])
        _ ≤ max 1 (x ^ δ') := le_max_right _ _
    have hT : 1 ≤ T := by
      calc
        1 ≤ x ^ (-3 * ε + (1 / 2 - σ)) :=
          Real.one_le_rpow hx1 (by linarith only [hεbound, hσlt])
        _ = x ^ (-3 * ε) * x ^ (1 / 2 - σ) := Real.rpow_add hxpos _ _
        _ ≤ T := mul_le_mul_of_nonneg_left hNlo (Real.rpow_nonneg hxpos.le _)
    have hTsmall : T ≤ x ^ (1 / 2 - ε) := by
      calc
        T ≤ x ^ (-3 * ε) * x ^ (1 / 2 : ℝ) :=
          mul_le_mul_of_nonneg_left hNhi (Real.rpow_nonneg hxpos.le _)
        _ = x ^ (-3 * ε + 1 / 2) := (Real.rpow_add hxpos _ _).symm
        _ ≤ x ^ (1 / 2 - ε) := Real.rpow_le_rpow_of_exponent_le hx1
          (by linarith only [hε])
    have hTZ : T * (Z : ℝ) ≤ x ^ (-2 * ε) * N x i := by
      calc
        T * (Z : ℝ) ≤ (x ^ (-3 * ε) * N x i) * x ^ ε :=
          mul_le_mul_of_nonneg_left hZ (zero_le_one.trans hT)
        _ = x ^ (-2 * ε) * N x i := by
          rw [mul_right_comm, ← Real.rpow_add hxpos,
            show -3 * ε + ε = -2 * ε by ring]
    have hS₀data (q : ℕ) (hq : q ∈ S₀) :
        0 < q ∧ q ≤ cutoff ∧ q ∣ ∏ p ∈ I, p := by
      obtain ⟨hinterval, hdiv, _⟩ := Finset.mem_filter.mp hq
      exact ⟨(Finset.mem_Icc.mp hinterval).1,
        (Finset.mem_Icc.mp hinterval).2, hdiv⟩
    have hS₀subset : S₀ ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ := by
      intro q hq
      exact Finset.mem_Icc.mpr ⟨(hS₀data q hq).1, (hS₀data q hq).2.1⟩
    have hS₀primitive (q : ℕ) (hq : q ∈ S₀) : Nat.Coprime a q :=
      ha.of_dvd_right (hS₀data q hq).2.2
    have hlogB : (Real.log x) ^ B ≤ x ^ ε := by
      simpa only [Real.norm_of_nonneg (Real.rpow_nonneg hlogpos.le _),
        Real.norm_of_nonneg (Real.rpow_nonneg hxpos.le _)] using hXP x hxP
    have hsmallcut : x ^ (1 / 2 - ε) ≤ Real.sqrt x / (Real.log x) ^ B := by
      apply (le_div_iff₀ (Real.rpow_pos_of_pos hlogpos B)).mpr
      calc
        x ^ (1 / 2 - ε) * (Real.log x) ^ B ≤ x ^ (1 / 2 - ε) * x ^ ε :=
          mul_le_mul_of_nonneg_left hlogB (Real.rpow_nonneg hxpos.le _)
        _ = x ^ (1 / 2 : ℝ) := by
          rw [← Real.rpow_add hxpos]
          congr 1
          ring
        _ = Real.sqrt x := (Real.sqrt_eq_rpow x).symm
    let U : ℕ := ⌊Real.sqrt x / (Real.log x) ^ B⌋₊
    have hsmallU : cutoffSmall ≤ U := Nat.floor_mono hsmallcut
    let F (q : ℕ) : ℝ := ⨆ b : (ZMod q)ˣ, ‖fullDiscrepancy f q (b : ZMod q).val‖
    have hFnonneg (q : ℕ) (hq : 0 < q) : 0 ≤ F q := by
      let : NeZero q := ⟨hq.ne'⟩
      have hb : BddAbove (Set.range fun b : (ZMod q)ˣ =>
          ‖fullDiscrepancy f q (b : ZMod q).val‖) := (Set.finite_range _).bddAbove
      exact (norm_nonneg _).trans (le_ciSup hb (1 : (ZMod q)ˣ))
    have hFbound (q : ℕ) (hq : q ∈ S₀) : ‖fullDiscrepancy f q a‖ ≤ F q := by
      let : NeZero q := ⟨(hS₀data q hq).1.ne'⟩
      have hb : BddAbove (Set.range fun b : (ZMod q)ˣ =>
          ‖fullDiscrepancy f q (b : ZMod q).val‖) := (Set.finite_range _).bddAbove
      have heq : ‖fullDiscrepancy f q
          (ZMod.unitOfCoprime a (hS₀primitive q hq) : ZMod q).val‖ =
            ‖fullDiscrepancy f q a‖ := by
        simp only [ZMod.coe_unitOfCoprime, ZMod.val_natCast, fullDiscrepancy,
          progressionMass, Nat.mod_mod]
      exact heq.symm.trans_le (le_ciSup hb (ZMod.unitOfCoprime a (hS₀primitive q hq)))
    have hfilterOne : f.filter (fun n : ℕ => Nat.Coprime n 1) = f := by
      ext n
      simp only [Finsupp.filter_apply]
      exact ite_eq_left (Nat.coprime_one_right n)
    have hBVone : (∑ q ∈ Finset.Ioc 0 U, F q) ≤ KBV * x / (Real.log x) ^ A := by
      have hb := hBV x hxBV i 1 zero_lt_one
      change (∑ q ∈ Finset.Ioc 0 U,
        ⨆ b : (ZMod q)ˣ, ‖fullDiscrepancy
          (f.filter (fun n : ℕ => Nat.Coprime n 1)) q (b : ZMod q).val‖) ≤ _ at hb
      rw [hfilterOne] at hb
      simpa only [Nat.divisors_one, Finset.card_singleton, Nat.cast_one,
        one_pow, mul_one, F] using hb
    have hsmallBound :
        (∑ q ∈ S₀.filter (fun q => q ≤ cutoffSmall), ‖fullDiscrepancy f q a‖) ≤
          KBV * x / (Real.log x) ^ A := by
      calc
        (∑ q ∈ S₀.filter (fun q => q ≤ cutoffSmall), ‖fullDiscrepancy f q a‖) ≤
            ∑ q ∈ S₀.filter (fun q => q ≤ cutoffSmall), F q :=
          Finset.sum_le_sum fun q hq => hFbound q (Finset.mem_filter.mp hq).1
        _ ≤ ∑ q ∈ Finset.Ioc 0 U, F q := by
          apply Finset.sum_le_sum_of_subset_of_nonneg
          · intro q hq
            obtain ⟨hqS, hqcut⟩ := Finset.mem_filter.mp hq
            exact Finset.mem_Ioc.mpr ⟨(hS₀data q hqS).1, hqcut.trans hsmallU⟩
          · intro q hq _
            exact hFnonneg q (Finset.mem_Ioc.mp hq).1
        _ ≤ KBV * x / (Real.log x) ^ A := hBVone
    obtain ⟨hfSupport, hfCoeff⟩ := finiteConvolution_support_and_divisor_bound
      (α x i) (β x i) x (M x i) (N x i) c C W k
        hx1 hMpos hNpos hc hCscale hW hMNhi
        (hsupport x hx₀ i).1 (hsupport x hx₀ i).2
        (fun n _ => (hcoeff x hx₀ i n).1) (fun n _ => (hcoeff x hx₀ i n).2)
    have hExceptionalBound :
        (∑ q ∈ S₀.filter (fun q => (Z : ℝ) < (smallPrimePart Brough q : ℝ)),
          ‖fullDiscrepancy f q a‖) ≤ KE * W ^ 2 * x / (Real.log x) ^ A := by
      have hcoefE : ∀ n ∈ f.support,
          ‖f n‖ ≤ W ^ 2 * (n.divisors.card : ℝ) ^ (2 * k + 1) *
            (Real.log x) ^ ((2 * k : ℕ) : ℝ) := by
        intro n _
        simpa only [Real.rpow_natCast, f] using hfCoeff n
      have he := hExceptional x hxE (W ^ 2) (sq_nonneg W) S₀ hS₀subset
        (fun _ => a) hS₀primitive f hfSupport hcoefE
      simpa only [pow_zero, one_mul, Brough, Z] using he
    have hEdata (n : ℕ) (hn : n ∈ E) :
        n ∈ tripleSourceModuli Y cutoff I ∧ T ≤ (n : ℝ) ∧
          (smallPrimePart Brough n : ℝ) ≤ (Z : ℝ) := by
      obtain ⟨hnS, hnlarge, hnsmall⟩ := Finset.mem_filter.mp hn
      exact ⟨hnS, hTsmall.trans (Nat.lt_of_floor_lt hnlarge).le, hnsmall⟩
    obtain ⟨S, hSsum, hS⟩ := hselect_pairs Y Z Brough cutoff T I hI hT E hEdata
    have hSpair (p : ℕ × ℕ) (hp : p ∈ S) :
        0 < p.1 ∧ 0 < p.2 ∧ p.1 ≤ cutoff ∧ p.2 ≤ cutoff ∧
          Nat.Coprime p.1 p.2 ∧ Nat.Coprime a (p.1 * p.2) := by
      obtain ⟨hq, hr, hsf, hpE, _, _, _, _, _, _⟩ := hS p hp
      have hpS : p.1 * p.2 ∈ S₀ := (Finset.mem_filter.mp hpE).1
      have hcut := (hS₀data _ hpS).2.1
      exact ⟨hq, hr, (Nat.le_mul_of_pos_right _ hr).trans hcut,
        (Nat.le_mul_of_pos_left _ hq).trans hcut,
        Nat.coprime_of_squarefree_mul hsf, hS₀primitive _ hpS⟩
    have hSmean (p : ℕ × ℕ) (hp : p ∈ S) :
        0 < p.1 ∧ p.1 ≤ ⌊x ^ θ⌋₊ ∧
          0 < p.2 ∧ p.2 ≤ ⌊x ^ (1 / 2 - 2 * ε)⌋₊ ∧ Nat.Coprime p.1 p.2 := by
      obtain ⟨hq, hr, hqcut, _, hcop, _⟩ := hSpair p hp
      refine ⟨hq, hqcut, hr, ?_, hcop⟩
      apply (Nat.le_floor_iff (Real.rpow_nonneg hxpos.le _)).mpr
      calc
        (p.2 : ℝ) ≤ T * (Z : ℝ) := (hS p hp).2.2.2.2.2.2.1
        _ ≤ x ^ (-2 * ε) * N x i := hTZ
        _ ≤ x ^ (-2 * ε) * x ^ (1 / 2 : ℝ) :=
          mul_le_mul_of_nonneg_left hNhi (Real.rpow_nonneg hxpos.le _)
        _ = x ^ (1 / 2 - 2 * ε) := by
          rw [← Real.rpow_add hxpos]
          congr 1
          ring
    have hMeanBound : (∑ p ∈ S, ‖meanTerm f p.1 p.2 a‖) ≤
        KM * x / (Real.log x) ^ A :=
      hMean x hxM i S hSmean a (fun p hp => (hSpair p hp).2.2.2.2.2)
    let γ : ℝ := Real.log (N x i) / Real.log x
    have hNγ : N x i = x ^ γ := by
      apply Real.log_injOn_pos (Set.mem_Ioi.mpr hNpos)
        (Set.mem_Ioi.mpr (Real.rpow_pos_of_pos hxpos γ))
      rw [Real.log_rpow hxpos]
      dsimp only [γ]
      field_simp
    have hγlo : 1 / 2 - σ ≤ γ := by
      apply (le_div_iff₀ hlogpos).mpr
      have hn := Real.log_le_log (Real.rpow_pos_of_pos hxpos _) hNlo
      rwa [Real.log_rpow hxpos] at hn
    have hγhi : γ ≤ 1 / 2 := by
      apply (div_le_iff₀ hlogpos).mpr
      have hn := Real.log_le_log hNpos hNhi
      rwa [Real.log_rpow hxpos] at hn
    have hMNlo' : x / C' ≤ M x i * N x i :=
      (div_le_div_of_nonneg_left hxpos.le hCpos hC'C).trans hMNlo
    have hMNhi' : M x i * N x i ≤ C' * x :=
      hMNhi.trans (mul_le_mul_of_nonneg_right hC'C hxpos.le)
    have hαOpen : ∀ n ∈ (α x i).support,
        c' * M x i ≤ (n : ℝ) ∧ (n : ℝ) ≤ C' * M x i ∧
        ‖α x i n‖ ≤ C' * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ (k : ℝ) := by
      intro n hn
      obtain ⟨hnlo, hnhi⟩ := (hsupport x hx₀ i).1 n hn
      refine ⟨(mul_le_mul_of_nonneg_right hc'c hMpos.le).trans hnlo,
        hnhi.trans (mul_le_mul_of_nonneg_right hC'C hMpos.le), ?_⟩
      rw [Real.rpow_natCast]
      exact (hcoeff x hx₀ i n).1.trans
        (mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_right hC'W (pow_nonneg (Nat.cast_nonneg _) _))
          (pow_nonneg hlogpos.le _))
    have hβOpen : ∀ n ∈ (β x i).support,
        c' * N x i ≤ (n : ℝ) ∧ (n : ℝ) ≤ C' * N x i ∧
        ‖β x i n‖ ≤ C' * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ (k : ℝ) := by
      intro n hn
      obtain ⟨hnlo, hnhi⟩ := (hsupport x hx₀ i).2 n hn
      refine ⟨(mul_le_mul_of_nonneg_right hc'c hNpos.le).trans hnlo,
        hnhi.trans (mul_le_mul_of_nonneg_right hC'C hNpos.le), ?_⟩
      rw [Real.rpow_natCast]
      exact (hcoeff x hx₀ i n).2.trans
        (mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_right hC'W (pow_nonneg (Nat.cast_nonneg _) _))
          (pow_nonneg hlogpos.le _))
    let G : ℕ := ∏ p ∈ I, p
    have hG : 0 < G := hprime_product_pos I hI
    have hDeltaBound (b : ℕ) (hb : b ∈ primitiveResidues G) :
        (∑ p ∈ S, ‖deltaZero f p.1 p.2 a a b‖) ≤
          C * Dθ ^ 2 * x / (Real.log x) ^ A := by
      have hbG : Nat.Coprime b G := (Finset.mem_filter.mp hb).2
      have habG : Nat.Coprime (a * a * b) G := (ha.mul_left ha).mul_left hbG
      let J : Finset ℕ := Finset.Icc 0 (Nat.log 2 cutoff)
      let E₀ : ℝ := (M x i * N x i) * (Real.log x) ^ (-(A + 2))
      have hE₀ : 0 ≤ E₀ := mul_nonneg hMNpos.le (Real.rpow_nonneg hlogpos.le _)
      have hBand (j k' : ℕ) :
          (∑ p ∈ S.filter (fun p =>
              2 ^ j ≤ p.1 ∧ p.1 ≤ 2 * 2 ^ j ∧
              2 ^ k' ≤ p.2 ∧ p.2 ≤ 2 * 2 ^ k'),
            ‖deltaZero f p.1 p.2 a a b‖) ≤ E₀ := by
        let Q : ℝ := (2 ^ j : ℕ)
        let R : ℝ := (2 ^ k' : ℕ)
        let S' : Finset (ℕ × ℕ) := S.filter fun p =>
          2 ^ j ≤ p.1 ∧ p.1 ≤ 2 * 2 ^ j ∧
          2 ^ k' ≤ p.2 ∧ p.2 ≤ 2 * 2 ^ k'
        have hQ : 0 < Q := Nat.cast_pos.mpr (pow_pos (by norm_num) _)
        have hR : 0 < R := Nat.cast_pos.mpr (pow_pos (by norm_num) _)
        by_cases hS' : S' = ∅
        · change (∑ p ∈ S', ‖deltaZero f p.1 p.2 a a b‖) ≤ E₀
          simpa only [hS', Finset.sum_empty] using hE₀
        obtain ⟨p, hp⟩ := Finset.nonempty_iff_ne_empty.mpr hS'
        obtain ⟨hpS, hqloN, hqhiN, hrloN, hrhiN⟩ := Finset.mem_filter.mp hp
        obtain ⟨hqpos, hrpos, hsf, hpE, hpdiv, hrloT, hrhiT, hdq, hdr, hrough⟩ :=
          hS p hpS
        have hqlo : Q ≤ (p.1 : ℝ) := by dsimp only [Q]; exact_mod_cast hqloN
        have hqhi : (p.1 : ℝ) ≤ 2 * Q := by dsimp only [Q]; exact_mod_cast hqhiN
        have hrlo : R ≤ (p.2 : ℝ) := by dsimp only [R]; exact_mod_cast hrloN
        have hrhi : (p.2 : ℝ) ≤ 2 * R := by dsimp only [R]; exact_mod_cast hrhiN
        have hqp : (0 : ℝ) ≤ p.1 := Nat.cast_nonneg _
        have hrp : (0 : ℝ) ≤ p.2 := Nat.cast_nonneg _
        have hprodlo : R * Q ≤ (p.1 : ℝ) * p.2 := by
          simpa only [mul_comm] using mul_le_mul hqlo hrlo hR.le hqp
        have hprodhi : (p.1 : ℝ) * p.2 ≤ 4 * (R * Q) := by
          have hm := mul_le_mul hqhi hrhi hrp (by positivity : 0 ≤ 2 * Q)
          nlinarith only [hm]
        obtain ⟨hpSource, hpLarge, _⟩ := Finset.mem_filter.mp hpE
        have hlarge : x ^ (1 / 2 - ε) < (p.1 : ℝ) * p.2 := by
          exact_mod_cast Nat.lt_of_floor_lt hpLarge
        have hupper : (p.1 : ℝ) * p.2 ≤ x ^ θ := by
          have hh : ((p.1 * p.2 : ℕ) : ℝ) ≤ (cutoff : ℝ) :=
            Nat.cast_le.mpr (hS₀data _ hpSource).2.1
          have hpcast : (p.1 : ℝ) * p.2 ≤ (cutoff : ℝ) := by
            simpa only [Nat.cast_mul] using hh
          exact hpcast.trans (Nat.floor_le (Real.rpow_nonneg hxpos.le _))
        have hRQlo : x ^ (1 / 2 - ε) ≤ C' * R * Q := by
          have hc := mul_le_mul_of_nonneg_right hC'4 (mul_nonneg hR.le hQ.le)
          nlinarith only [hlarge, hprodhi, hc]
        have hRQhi : R * Q ≤ C' * x ^ (1 / 2 + 2 * ω' + ε) := by
          calc
            R * Q ≤ x ^ θ := hprodlo.trans hupper
            _ ≤ x ^ (1 / 2 + 2 * ω' + ε) :=
              Real.rpow_le_rpow_of_exponent_le hx1
                (by dsimp only [θ]; linarith only [hωw, hε])
            _ ≤ C' * x ^ (1 / 2 + 2 * ω' + ε) :=
              le_mul_of_one_le_left (Real.rpow_nonneg hxpos.le _) hC'
        have hRhi : R ≤ C' * x ^ (-2 * ε) * N x i := by
          calc
            R ≤ (p.2 : ℝ) := hrlo
            _ ≤ T * (Z : ℝ) := hrhiT
            _ ≤ x ^ (-2 * ε) * N x i := hTZ
            _ ≤ C' * x ^ (-2 * ε) * N x i :=
              mul_le_mul_of_nonneg_right
                (le_mul_of_one_le_left (Real.rpow_nonneg hxpos.le (-2 * ε)) hC')
                hNpos.le
        have hNfromR : N x i ≤ C' * x ^ (δ' + 4 * ε) * R := by
          have hYpos : 0 < (Y : ℝ) := zero_lt_one.trans_le Y.property
          have ht := (div_le_iff₀ hYpos).mp hrloT
          have hNr : N x i ≤ x ^ (δ + 3 * ε) * (p.2 : ℝ) := by
            calc
              N x i = x ^ (3 * ε) * T := by
                dsimp only [T]
                rw [← mul_assoc, ← Real.rpow_add hxpos]
                rw [show 3 * ε + -3 * ε = 0 by ring, Real.rpow_zero, one_mul]
              _ ≤ x ^ (3 * ε) * ((p.2 : ℝ) * (Y : ℝ)) :=
                mul_le_mul_of_nonneg_left ht (Real.rpow_nonneg hxpos.le _)
              _ = x ^ (δ + 3 * ε) * (p.2 : ℝ) := by
                rw [hY]
                calc
                  x ^ (3 * ε) * ((p.2 : ℝ) * x ^ δ) =
                      (x ^ (3 * ε) * x ^ δ) * (p.2 : ℝ) := by ring
                  _ = x ^ (δ + 3 * ε) * (p.2 : ℝ) := by
                    rw [← Real.rpow_add hxpos,
                      show 3 * ε + δ = δ + 3 * ε by ring]
          calc
            N x i ≤ x ^ (δ + 3 * ε) * (p.2 : ℝ) := hNr
            _ ≤ x ^ (δ + 3 * ε) * (2 * R) :=
              mul_le_mul_of_nonneg_left hrhi (Real.rpow_nonneg hxpos.le _)
            _ ≤ x ^ (δ' + 4 * ε) * (2 * R) :=
              mul_le_mul_of_nonneg_right
                (Real.rpow_le_rpow_of_exponent_le hx1 (by linarith only [hδw, hε]))
                (by positivity)
            _ ≤ C' * x ^ (δ' + 4 * ε) * R := by
              calc
                x ^ (δ' + 4 * ε) * (2 * R) = (2 * x ^ (δ' + 4 * ε)) * R := by ring
                _ ≤ (C' * x ^ (δ' + 4 * ε)) * R :=
                  mul_le_mul_of_nonneg_right
                    (mul_le_mul_of_nonneg_right
                      (by linarith only [hC'4] : (2 : ℝ) ≤ C')
                      (Real.rpow_nonneg hxpos.le (δ' + 4 * ε))) hR.le
        have hSource : ∀ t ∈ S',
            0 < t.1 ∧ 0 < t.2 ∧ Squarefree (t.1 * t.2) ∧
            Q ≤ (t.1 : ℝ) ∧ (t.1 : ℝ) ≤ 2 * Q ∧
            R ≤ (t.2 : ℝ) ∧ (t.2 : ℝ) ≤ 2 * R ∧
            Nonempty (DenseDivisibilityWitness
              ⟨max 1 (x ^ δ'), le_max_left (1 : ℝ) (x ^ δ')⟩ 1 t.1) ∧
            Nonempty (DenseDivisibilityWitness
              ⟨max 1 (x ^ δ'), le_max_left (1 : ℝ) (x ^ δ')⟩ 1 t.2) ∧
            (∀ u ∈ t.1.primeFactors,
              Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (u : ℝ)) := by
          intro t ht
          obtain ⟨htS, htqlo, htqhi, htrlo, htrhi⟩ := Finset.mem_filter.mp ht
          obtain ⟨htq, htr, htsf, _, _, _, _, htdq, htdr, htrough⟩ := hS t htS
          refine ⟨htq, htr, htsf, ?_, ?_, ?_, ?_,
            denseDivisibility_mono_scale hYworking htdq,
            denseDivisibility_mono_scale hYworking htdr, ?_⟩
          · dsimp only [Q]
            exact_mod_cast htqlo
          · dsimp only [Q]
            exact_mod_cast htqhi
          · dsimp only [R]
            exact_mod_cast htrlo
          · dsimp only [R]
            exact_mod_cast htrhi
          · intro u hu
            exact Nat.lt_of_floor_lt (htrough u hu)
        have hPrimitive : ∀ t ∈ S', Nat.Coprime (a * a * b) (t.1 * t.2) := by
          intro t ht
          exact habG.of_dvd_right (hS t (Finset.mem_filter.mp ht).1).2.2.2.2.1
        by_cases hγcap : γ ≤ 1 / 2 - 4 * ω' - 2 * δ' - 50 * ε
        · simpa only [one_mul, f, S', E₀] using
            hLow x hxL (M x i) (N x i) R Q γ hMpos hNpos hR hQ
              hMNlo' hMNhi' hNγ (hγlower.le.trans hγlo) hγcap
              hNfromR hRhi hRQlo hRQhi (α x i) (β x i) hαOpen hβOpen S' hSource
              a a b hPrimitive
        · have hγhigh : 1 / 4 + 14 * ω' + 4 * δ' + 100 * ε ≤ γ :=
            hγoverlap.le.trans (le_of_lt (lt_of_not_ge hγcap))
          simpa only [one_mul, f, S', E₀] using
            hHigh x hxH (M x i) (N x i) R Q γ hMpos hNpos hR hQ
              hMNlo' hMNhi' hNγ hγhigh hγhi
              hNfromR hRhi hRQlo hRQhi (α x i) (β x i) hαOpen hβOpen S' hSource
              a a b hPrimitive
      have hcover := hpair_dyadic_cover S
        (fun p => ‖deltaZero f p.1 p.2 a a b‖) cutoff cutoff
        (fun p hp => ⟨(hSpair p hp).1, (hSpair p hp).2.2.1,
          (hSpair p hp).2.1, (hSpair p hp).2.2.2.1⟩)
        (fun _ _ => norm_nonneg _)
      have hcard : (J.card : ℝ) ≤ Dθ * Real.log x :=
        by simpa only [J, Nat.card_Icc, Nat.sub_zero, Dθ] using
          hdyadic_bin_count x θ cutoff hxexp hθpos.le le_rfl
      calc
        (∑ p ∈ S, ‖deltaZero f p.1 p.2 a a b‖) ≤
            ∑ j ∈ J, ∑ k' ∈ J,
              ∑ p ∈ S.filter (fun p =>
                2 ^ j ≤ p.1 ∧ p.1 ≤ 2 * 2 ^ j ∧
                2 ^ k' ≤ p.2 ∧ p.2 ≤ 2 * 2 ^ k'),
                ‖deltaZero f p.1 p.2 a a b‖ := hcover
        _ ≤ ∑ _j ∈ J, ∑ _k ∈ J, E₀ :=
          Finset.sum_le_sum fun j _ => Finset.sum_le_sum fun k' _ => hBand j k'
        _ = (J.card : ℝ) ^ 2 * E₀ := by
          simp only [Finset.sum_const, nsmul_eq_mul]
          ring
        _ ≤ (Dθ * Real.log x) ^ 2 * E₀ :=
          mul_le_mul_of_nonneg_right (pow_le_pow_left₀ (Nat.cast_nonneg _) hcard 2) hE₀
        _ ≤ (Dθ * Real.log x) ^ 2 * ((C * x) * (Real.log x) ^ (-(A + 2))) :=
          mul_le_mul_of_nonneg_left
            (mul_le_mul_of_nonneg_right hMNhi (Real.rpow_nonneg hlogpos.le _))
            (sq_nonneg _)
        _ = C * Dθ ^ 2 * x / (Real.log x) ^ A := by
          rw [Real.rpow_neg hlogpos.le, Real.rpow_add hlogpos, Real.rpow_two]
          field_simp
    have hDispersionBound : (∑ p ∈ S, ‖dispersionTerm f p.1 p.2 a‖) ≤
        C * Dθ ^ 2 * x / (Real.log x) ^ A := by
      apply (sum_norm_dispersion_le_global_average f hG S ?_ a).trans
        (hprimitive_average_le G hG
          (fun b => ∑ p ∈ S, ‖deltaZero f p.1 p.2 a a b‖)
          (C * Dθ ^ 2 * x / (Real.log x) ^ A) hDeltaBound)
      intro p hp
      exact ⟨(hSpair p hp).2.2.2.2.1,
        (dvd_mul_right p.1 p.2).trans (hS p hp).2.2.2.2.1⟩
    have hGoodBound : (∑ q ∈ E, ‖fullDiscrepancy f q a‖) ≤
        (C * Dθ ^ 2 + KM) * x / (Real.log x) ^ A := by
      rw [hSsum]
      calc
        (∑ p ∈ S, ‖fullDiscrepancy f (p.1 * p.2) a‖) ≤
            ∑ p ∈ S, (‖dispersionTerm f p.1 p.2 a‖ + ‖meanTerm f p.1 p.2 a‖) := by
          apply Finset.sum_le_sum
          intro p _
          rw [fullDiscrepancy_eq_dispersion_add_mean]
          exact norm_add_le _ _
        _ = (∑ p ∈ S, ‖dispersionTerm f p.1 p.2 a‖) +
            ∑ p ∈ S, ‖meanTerm f p.1 p.2 a‖ := Finset.sum_add_distrib
        _ ≤ C * Dθ ^ 2 * x / (Real.log x) ^ A + KM * x / (Real.log x) ^ A :=
          add_le_add hDispersionBound hMeanBound
        _ = (C * Dθ ^ 2 + KM) * x / (Real.log x) ^ A := by ring
    have hSplit : (∑ q ∈ S₀, ‖fullDiscrepancy f q a‖) ≤
        (∑ q ∈ S₀.filter (fun q => q ≤ cutoffSmall), ‖fullDiscrepancy f q a‖) +
        (∑ q ∈ S₀.filter (fun q => (Z : ℝ) < (smallPrimePart Brough q : ℝ)),
          ‖fullDiscrepancy f q a‖) +
        ∑ q ∈ E, ‖fullDiscrepancy f q a‖ := by
      dsimp only [E]
      simp only [Finset.sum_filter]
      rw [← Finset.sum_add_distrib, ← Finset.sum_add_distrib]
      apply Finset.sum_le_sum
      intro q _
      by_cases hsmall : q ≤ cutoffSmall
      · by_cases hbad : (Z : ℝ) < (smallPrimePart Brough q : ℝ)
        · simp only [hsmall, hbad, not_lt_of_ge hsmall, false_and,
            ite_true, ite_false, add_zero]
          exact le_add_of_nonneg_right (norm_nonneg _)
        · simp only [hsmall, hbad, not_lt_of_ge hsmall, false_and,
            ite_true, ite_false, add_zero, le_refl]
      · have hlarge : cutoffSmall < q := lt_of_not_ge hsmall
        by_cases hbad : (Z : ℝ) < (smallPrimePart Brough q : ℝ)
        · simp only [hsmall, hbad, hlarge, not_le_of_gt hbad, and_false,
            ite_true, ite_false, zero_add, add_zero, le_refl]
        · have hgood : (smallPrimePart Brough q : ℝ) ≤ (Z : ℝ) := le_of_not_gt hbad
          simp only [hsmall, hbad, hlarge, hgood, and_self,
            ite_true, ite_false, zero_add, le_refl]
    change (∑ q ∈ S₀, ‖fullDiscrepancy f q a‖) ≤ K * x / (Real.log x) ^ A
    calc
      (∑ q ∈ S₀, ‖fullDiscrepancy f q a‖) ≤
          (∑ q ∈ S₀.filter (fun q => q ≤ cutoffSmall), ‖fullDiscrepancy f q a‖) +
          (∑ q ∈ S₀.filter (fun q => (Z : ℝ) < (smallPrimePart Brough q : ℝ)),
            ‖fullDiscrepancy f q a‖) +
          ∑ q ∈ E, ‖fullDiscrepancy f q a‖ := hSplit
      _ ≤ KBV * x / (Real.log x) ^ A + KE * W ^ 2 * x / (Real.log x) ^ A +
          (C * Dθ ^ 2 + KM) * x / (Real.log x) ^ A :=
        add_le_add (add_le_add hsmallBound hExceptionalBound) hGoodBound
      _ = K * x / (Real.log x) ^ A := by dsimp only [K]; ring
  exact sourceDeltaZero_rough_dyadic_largeGamma_uniform_log_saving_of_deligne
      hDeligne ω' δ' ε C' c' C' c' C' hω' hδ' hε hwork hεsmall
      hC' hc' hc'C' hc' hc'C' k k k k (A + 2) 1 (by linarith only [hA]) zero_lt_one

section
open scoped ContDiff

open Classical in
theorem sourceTheta_fixed_first_fiber_dense_cauchy_bound
    (T A₀ A₁ κ η : ℝ)
    (hT : 1 ≤ T) (hA₀ : 0 ≤ A₀) (hA₁ : 0 ≤ A₁)
    (hκ : 0 < κ) (hη : 0 < η) :
    ∃ C X : ℝ, 0 < C ∧ 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ r q₀ q₁ a b₁ b₂ N₀ H K : ℕ,
        0 < r → 0 < q₀ → 0 < q₁ →
        (r : ℝ) ≤ x ^ κ → (H : ℝ) * (K : ℝ) ≤ x ^ κ →
        (r : ℝ) * (q₀ : ℝ) * (q₁ : ℝ) * (K : ℝ) ^ 2 ≤ x ^ κ →
      ∀ (F : Finset ℕ) (J : Finset ℤ),
        (∀ v ∈ F, 0 < v ∧ v ≤ K ∧ Squarefree (r * q₀ * q₁ * v)) →
        (∀ h ∈ J, h ≠ 0 ∧ -(H : ℤ) ≤ h ∧ h ≤ (H : ℤ)) →
        Nat.Coprime a r → Nat.Coprime b₁ q₀ →
      ∀ (ℓ : ℤ) (N t₀ W L : ℝ),
        (q₀ : ℝ) ≤ N → N ≤ (r : ℝ) ^ (3 : ℝ) → 0 ≤ W → 0 ≤ L →
      ∀ (Y : Set.Ici (1 : ℝ)),
        (∀ v ∈ F,
          Nonempty (DenseDivisibilityWitness
            Y 1 (r * q₀ * q₁)) ∧
          Nonempty (DenseDivisibilityWitness
            Y 1 (r * q₀ * v))) →
      ∀ (ψ : ℝ → ℝ), ContDiff ℝ 1 ψ →
        Function.support ψ ⊆ Set.Icc (-T) T →
        (∀ t : ℝ, 0 ≤ ψ t) →
        (∀ t : ℝ, |ψ t| ≤ A₀ ∧ |deriv ψ t| ≤ A₁) →
      ∀ (β : ℕ →₀ ℂ), β.support ⊆ Finset.Icc 1 N₀ →
        (∀ n ∈ β.support, ‖β n‖ ≤ W) →
        (∀ n ∈ β.support, 1 ≤ ψ (((n : ℝ) - t₀) / N)) →
      ∀ (c : ℕ → ℤ → ℂ), (∀ v ∈ F, ∀ h ∈ J, ‖c v h‖ ≤ L) →
      let βℤ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
      let P₀ : ℝ := (r : ℝ) * (q₀ : ℝ) * (q₁ : ℝ) * (K : ℝ) ^ 2
      (∑ v ∈ F, ‖∑ n ∈ βℤ.support,
        βℤ n * star (βℤ (n + ℓ * (r : ℤ))) *
          (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
          ∑ h ∈ J, c v h * sourceTheta r q₀ 1 q₁ v a b₁ b₂ ℓ n h‖) ^ 2 ≤
        C * W ^ 4 * (Int.gcd (q₀ : ℤ) ℓ : ℝ) ^ 2 *
          (1 + (N₀ : ℝ) / (q₀ : ℝ)) * L ^ 2 * x ^ η *
          ((J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 *
              (Real.sqrt (N / (q₀ : ℝ)) * (P₀ * (Y : ℝ)) ^ (1 / 6 : ℝ)) +
            (N / (q₀ : ℝ) / (r : ℝ)) *
              (x ^ η * (J.card : ℝ) * (F.card : ℝ) *
                ((H : ℝ) * (K : ℝ) + (r : ℝ)))) := by
  obtain ⟨C, hC, hphase⟩ := sourceTheta_pair_finite_cauchy_bounds
    T A₀ A₁ 3 (η / κ) hT hA₀ hA₁ (div_pos hη hκ)
  obtain ⟨X, hX, hgcd⟩ := sourceSignedProduct_pair_gcd_sum_uniform κ η hκ hη
  refine ⟨C, X, hC, hX, ?_⟩
  intro x hx r q₀ q₁ a b₁ b₂ N₀ H K hr hq₀ hq₁ hrx hHKx hP₀x
    F J hF hJ ha hb₁ ℓ N t₀ W L hN hNr hW hL Y hY ψ hψ hψs hψ0 hψb
    β hβs hβ hψmajor c hc βℤ P₀
  have hxone : 1 ≤ x := hX.trans hx
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  have hrpos : 0 < (r : ℝ) := by exact_mod_cast hr
  have hq₀pos : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀
  have hNpos : 0 < N := hq₀pos.trans_le hN
  have hYpos : 0 < (Y : ℝ) := zero_lt_one.trans_le Y.property
  by_cases hFempty : F = ∅
  · simp only [hFempty, Finset.sum_empty, zero_pow (by decide : 2 ≠ 0),
      Finset.card_empty, Nat.cast_zero, zero_mul, mul_zero, add_zero, le_refl]
  obtain ⟨v₀, hv₀⟩ := Finset.nonempty_iff_ne_empty.mpr hFempty
  have hK : 0 < K := (hF v₀ hv₀).1.trans_le (hF v₀ hv₀).2.1
  have hP₀pos : 0 < P₀ := by dsimp only [P₀]; positivity
  let f : ℕ → ℕ × ℕ := fun v => (q₁, v)
  let Fq : Finset (ℕ × ℕ) := F.image f
  have hfinj : Function.Injective f := by
    intro v w hvw
    exact congrArg Prod.snd hvw
  have hsum (g : (ℕ × ℕ) → ℝ) :
      (∑ q ∈ Fq, g q) = ∑ v ∈ F, g (f v) :=
    Finset.sum_image (fun _ _ _ _ hvw => hfinj hvw)
  have hFq (q : ℕ × ℕ) (hq : q ∈ Fq) : Squarefree (r * q₀ * q.1 * q.2) := by
    obtain ⟨v, hv, rfl⟩ := Finset.mem_image.mp hq
    exact (hF v hv).2.2
  have hYq (q : ℕ × ℕ) (hq : q ∈ Fq) :
      Nonempty (DenseDivisibilityWitness Y 1 (r * q₀ * q.1)) ∧
      Nonempty (DenseDivisibilityWitness Y 1 (r * q₀ * q.2)) := by
    obtain ⟨v, hv, rfl⟩ := Finset.mem_image.mp hq
    exact hY v hv
  let P : ℕ → ℕ → ℕ := fun v w =>
    Nat.lcm (r * q₀ * q₁ * v) (r * q₀ * q₁ * w)
  have hP (v : ℕ) (hv : v ∈ F) (w : ℕ) (hw : w ∈ F) :
      0 < P v w ∧ (r : ℝ) ≤ (P v w : ℝ) ∧ (P v w : ℝ) ≤ P₀ := by
    have hvpos : 0 < v := (hF v hv).1
    have hwpos : 0 < w := (hF w hw).1
    have hp : 0 < P v w := Nat.pos_of_ne_zero
      (Nat.lcm_ne_zero (hF v hv).2.2.ne_zero (hF w hw).2.2.ne_zero)
    have hdr : r ∣ P v w :=
      (show r ∣ r * q₀ * q₁ * v from ⟨q₀ * q₁ * v, by ring⟩).trans
        (Nat.dvd_lcm_left _ _)
    have hdP : P v w ∣ r * q₀ * q₁ * v * w := by
      apply Nat.lcm_dvd
      · exact ⟨w, by ring⟩
      · exact ⟨v, by ring⟩
    refine ⟨hp, by exact_mod_cast Nat.le_of_dvd hp hdr, ?_⟩
    calc
      (P v w : ℝ) ≤ ((r * q₀ * q₁ * v * w : ℕ) : ℝ) := by
        exact_mod_cast Nat.le_of_dvd (by positivity) hdP
      _ = (r : ℝ) * (q₀ : ℝ) * (q₁ : ℝ) * ((v : ℝ) * (w : ℝ)) := by
        push_cast
        ring
      _ ≤ P₀ := by
        dsimp only [P₀]
        rw [pow_two]
        exact mul_le_mul_of_nonneg_left
          (mul_le_mul (Nat.cast_le.mpr (hF v hv).2.1)
            (Nat.cast_le.mpr (hF w hw).2.1) (Nat.cast_nonneg _) (Nat.cast_nonneg _))
          (by positivity)
  have hNP (q : ℕ × ℕ) (hq : q ∈ Fq) (s : ℕ × ℕ) (hs : s ∈ Fq) :
      N ≤ (Nat.lcm (r * q₀ * q.1 * q.2) (r * q₀ * s.1 * s.2) : ℝ) ^ (3 : ℝ) := by
    obtain ⟨v, hv, rfl⟩ := Finset.mem_image.mp hq
    obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hs
    exact hNr.trans (Real.rpow_le_rpow hrpos.le (hP v hv w hw).2.1 (by norm_num))
  have hPη (v : ℕ) (hv : v ∈ F) (w : ℕ) (hw : w ∈ F) :
      (P v w : ℝ) ^ (η / κ) ≤ x ^ η := by
    calc
      _ ≤ (x ^ κ) ^ (η / κ) := Real.rpow_le_rpow (Nat.cast_nonneg _)
        ((hP v hv w hw).2.2.trans hP₀x) (div_nonneg hη.le hκ.le)
      _ = x ^ η := by rw [← Real.rpow_mul hxpos.le]; congr 1; field_simp
  have hcop : Int.gcd (q₁ : ℤ) (r : ℤ) = 1 := by
    have hsf : Squarefree (r * q₁) := by
      have hh : Squarefree ((r * q₁) * (q₀ * v₀)) := by
        convert (hF v₀ hv₀).2.2 using 1
        ring
      exact hh.of_mul_left
    have hh := (Nat.coprime_of_squarefree_mul hsf).symm.gcd_eq_one
    simpa only [Int.gcd_natCast_natCast] using hh
  have hdet (v w : ℕ) (h k : ℤ) :
      Int.gcd (r : ℤ) (h * (q₁ : ℤ) * (w : ℤ) -
        k * (q₁ : ℤ) * (v : ℤ)) =
      Int.gcd (h * (w : ℤ) - k * (v : ℤ)) (r : ℤ) := by
    rw [Int.gcd_comm]
    have heq : h * (q₁ : ℤ) * (w : ℤ) -
        k * (q₁ : ℤ) * (v : ℤ) =
        (q₁ : ℤ) * (h * (w : ℤ) - k * (v : ℤ)) := by ring
    rw [heq, Int.gcd_mul_right_left_of_gcd_eq_one hcop]
  let F₁ : Finset (ℕ × ℕ) := F.image (fun v => (v, 1))
  have hsum₁ (g : (ℕ × ℕ) → ℝ) :
      (∑ q ∈ F₁, g q) = ∑ v ∈ F, g (v, 1) :=
    Finset.sum_image (fun _ _ _ _ hvw => congrArg Prod.fst hvw)
  have hcard₁ : F₁.card = F.card :=
    Finset.card_image_of_injective F (fun _ _ hvw => congrArg Prod.fst hvw)
  have hG₁ := hgcd x hx r H K hr hrx hHKx J F₁ hJ (by
    intro t ht
    obtain ⟨v, hv, rfl⟩ := Finset.mem_image.mp ht
    exact ⟨(hF v hv).1, by norm_num, by simpa using (hF v hv).2.1⟩)
  simp_rw [hsum₁] at hG₁
  simp only [Nat.cast_one, mul_one, hcard₁] at hG₁
  let G : ℝ := ∑ v ∈ F, ∑ w ∈ F, ∑ h ∈ J, ∑ k ∈ J,
    (Int.gcd (h * (w : ℤ) - k * (v : ℤ)) (r : ℤ) : ℝ)
  have hG : G ≤ x ^ η * (J.card : ℝ) * (F.card : ℝ) *
      ((H : ℝ) * (K : ℝ) + (r : ℝ)) := by
    have heq : G = ∑ h ∈ J, ∑ w ∈ F, ∑ k ∈ J, ∑ v ∈ F,
        (Int.gcd (h * (w : ℤ) - k * (v : ℤ)) (r : ℤ) : ℝ) := by
      calc
        G = ∑ w ∈ F, ∑ v ∈ F, ∑ h ∈ J, ∑ k ∈ J,
            (Int.gcd (h * (w : ℤ) - k * (v : ℤ)) (r : ℤ) : ℝ) := Finset.sum_comm
        _ = ∑ w ∈ F, ∑ h ∈ J, ∑ k ∈ J, ∑ v ∈ F,
            (Int.gcd (h * (w : ℤ) - k * (v : ℤ)) (r : ℤ) : ℝ) := by
          apply Finset.sum_congr rfl
          intro w _
          exact Finset.sum_comm_cycle.symm
        _ = _ := Finset.sum_comm
    rw [heq]
    exact hG₁
  let c' : (ℕ × ℕ) → ℤ → ℂ := fun q h => c q.2 h
  have hc' (q : ℕ × ℕ) (hq : q ∈ Fq) (h : ℤ) (hh : h ∈ J) : ‖c' q h‖ ≤ L := by
    obtain ⟨v, hv, rfl⟩ := Finset.mem_image.mp hq
    simpa only [c', f] using hc v hv h hh
  have hraw := (hphase r q₀ a b₁ b₂ N₀ Fq J hFq ha hb₁ ℓ N t₀ W L
    hN hW hL hNP ψ hψ hψs hψ0 hψb β hβs hβ hψmajor c' hc').2 Y hYq
  simp_rw [hsum] at hraw
  simp only [f, c'] at hraw
  change _ ≤ C * W ^ 4 * (Int.gcd (q₀ : ℤ) ℓ : ℝ) ^ 2 *
    (1 + (N₀ : ℝ) / (q₀ : ℝ)) * L ^ 2 *
      ∑ v ∈ F, ∑ w ∈ F, ∑ h ∈ J, ∑ k ∈ J,
        (P v w : ℝ) ^ (η / κ) *
          (Real.sqrt (N / (q₀ : ℝ)) * ((P v w : ℝ) * (Y : ℝ)) ^ (1 / 6 : ℝ) +
            (N / (q₀ : ℝ)) * ((Int.gcd (r : ℤ)
              (h * (q₁ : ℤ) * (w : ℤ) -
                k * (q₁ : ℤ) * (v : ℤ)) : ℝ) / (r : ℝ))) at hraw
  simp_rw [hdet] at hraw
  let B : ℝ := Real.sqrt (N / (q₀ : ℝ)) * (P₀ * (Y : ℝ)) ^ (1 / 6 : ℝ)
  let A : ℝ := N / (q₀ : ℝ) / (r : ℝ)
  have hA : 0 ≤ A := by dsimp only [A]; positivity
  have hB : 0 ≤ B := by dsimp only [B]; positivity
  have hmain : (∑ v ∈ F, ‖∑ n ∈ βℤ.support,
      βℤ n * star (βℤ (n + ℓ * (r : ℤ))) *
        (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
        ∑ h ∈ J, c v h * sourceTheta r q₀ 1 q₁ v a b₁ b₂ ℓ n h‖) ^ 2 ≤
      C * W ^ 4 * (Int.gcd (q₀ : ℤ) ℓ : ℝ) ^ 2 *
      (1 + (N₀ : ℝ) / (q₀ : ℝ)) * L ^ 2 *
      ∑ v ∈ F, ∑ w ∈ F, ∑ h ∈ J, ∑ k ∈ J,
        x ^ η * (B + A * (Int.gcd (h * (w : ℤ) - k * (v : ℤ)) (r : ℤ) : ℝ)) := by
    apply hraw.trans
    apply mul_le_mul_of_nonneg_left _ (by positivity)
    apply Finset.sum_le_sum
    intro v hv
    apply Finset.sum_le_sum
    intro w hw
    apply Finset.sum_le_sum
    intro h _
    apply Finset.sum_le_sum
    intro k _
    apply mul_le_mul (hPη v hv w hw) ?_ (by positivity) (Real.rpow_nonneg hxpos.le _)
    have hroot : Real.sqrt (N / (q₀ : ℝ)) *
        ((P v w : ℝ) * (Y : ℝ)) ^ (1 / 6 : ℝ) ≤ B := by
      apply mul_le_mul_of_nonneg_left _ (Real.sqrt_nonneg _)
      exact Real.rpow_le_rpow (by positivity)
        (mul_le_mul_of_nonneg_right (hP v hv w hw).2.2 (zero_le_one.trans Y.property))
        (by norm_num)
    have hmean : (N / (q₀ : ℝ)) *
        ((Int.gcd (h * (w : ℤ) - k * (v : ℤ)) (r : ℤ) : ℝ) / (r : ℝ)) =
        A * (Int.gcd (h * (w : ℤ) - k * (v : ℤ)) (r : ℤ) : ℝ) := by
      dsimp only [A]
      ring
    rw [hmean]
    exact add_le_add hroot le_rfl
  have hsumAffine : (∑ v ∈ F, ∑ w ∈ F, ∑ h ∈ J, ∑ k ∈ J,
        x ^ η * (B + A * (Int.gcd (h * (w : ℤ) - k * (v : ℤ)) (r : ℤ) : ℝ))) =
      x ^ η * ((J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * B + A * G) := by
    simp only [G, mul_add, Finset.sum_add_distrib, Finset.sum_const, nsmul_eq_mul,
      ← Finset.mul_sum]
    ring
  rw [hsumAffine] at hmain
  apply hmain.trans
  rw [← mul_assoc]
  apply mul_le_mul_of_nonneg_left _ (by positivity)
  exact add_le_add le_rfl (mul_le_mul_of_nonneg_left hG hA)

open Classical in
theorem sourceTheta_lower_typeIOne_uniform_power_saving
    («ω» δ σ c₀ ρ C T TN A₀ A₁ L : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hσ : 0 ≤ σ) (hρ : 0 < ρ)
    (hmargin : 54 * «ω» + 15 * δ + 5 * σ + 10000 * ρ < 1)
    (hc₀ : 100 * ρ < c₀)
    (hC : 1 ≤ C) (hT : 1 ≤ T) (hTN : 1 ≤ TN)
    (hA₀ : 0 ≤ A₀) (hA₁ : 0 ≤ A₁) (hL : 0 ≤ L) :
    ∃ K X : ℝ, 0 < K ∧ 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ M N R Q H γ : ℝ,
        0 < M → 0 < N → 0 < R → 0 < Q →
        x / C ≤ M * N → N = x ^ γ →
        x ^ (-δ - 6 * ρ) * N ≤ R →
        R ≤ x ^ (-4 * ρ) * N →
        R * Q ≤ x ^ (1 / 2 + 2 * «ω» + ρ) →
        1 / 2 - σ ≤ γ → γ ≤ 1 / 2 - 2 * «ω» - c₀ →
      ∀ r q₀ q₁ a b₁ b₂ : ℕ,
        R ≤ (r : ℝ) → (r : ℝ) ≤ 2 * R →
        (q₀ : ℝ) * (q₁ : ℝ) ≤ 2 * Q →
        H = x ^ ρ * R * Q ^ 2 / ((q₀ : ℝ) * M) → 1 ≤ H →
      ∀ (F : Finset ℕ) (J : Finset ℤ),
        (∀ v ∈ F, 0 < v ∧ (v : ℝ) ≤ 2 * Q / (q₀ : ℝ) ∧
          Squarefree (r * q₀ * q₁ * v)) →
        (∀ h ∈ J, h ≠ 0 ∧ |(h : ℝ)| ≤ 2 * H) →
        Nat.Coprime a r → Nat.Coprime b₁ q₀ →
      ∀ (ℓ : ℤ) (t₀ : ℝ) (Y : Set.Ici (1 : ℝ)), (Y : ℝ) ≤ x ^ δ →
        (∀ v ∈ F,
          Nonempty (DenseDivisibilityWitness
            Y 1 (r * q₀ * q₁)) ∧
          Nonempty (DenseDivisibilityWitness
            Y 1 (r * q₀ * v))) →
      ∀ (ψ : ℝ → ℝ), ContDiff ℝ 1 ψ →
        Function.support ψ ⊆ Set.Icc (-T) T →
        (∀ t : ℝ, 0 ≤ ψ t) →
        (∀ t : ℝ, |ψ t| ≤ A₀ ∧ |deriv ψ t| ≤ A₁) →
      ∀ (β : ℕ →₀ ℂ), β.support ⊆ Finset.Icc 1 ⌊TN * N⌋₊ →
        (∀ n ∈ β.support, ‖β n‖ ≤ x ^ (ρ / 100)) →
        (∀ n ∈ β.support, 1 ≤ ψ (((n : ℝ) - t₀) / N)) →
      ∀ (c : ℕ → ℤ → ℂ), (∀ v ∈ F, ∀ h ∈ J, ‖c v h‖ ≤ L) →
      let βℤ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
      (∑ v ∈ F, ‖∑ n ∈ βℤ.support,
        βℤ n * star (βℤ (n + ℓ * (r : ℤ))) *
          (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
          ∑ h ∈ J, c v h * sourceTheta r q₀ 1 q₁ v a b₁ b₂ ℓ n h‖) ≤
        K * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * N * Q / (q₀ : ℝ) * x ^ (-ρ / 2) := by
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hTNpos : 0 < TN := zero_lt_one.trans_le hTN
  have hc₀pos : 0 < c₀ := by linarith only [hc₀, hρ]
  obtain ⟨C₀, X₀, hC₀, hX₀, hraw⟩ := sourceTheta_fixed_first_fiber_dense_cauchy_bound
    T A₀ A₁ 10 (ρ / 100) hT hA₀ hA₁ (by norm_num) (by positivity)
  obtain ⟨Xρ, hXρ⟩ := Filter.eventually_atTop.mp
    ((tendsto_rpow_atTop hρ).eventually_ge_atTop (max C 2))
  let K := Real.sqrt (250 * C₀ * (1 + TN) * L ^ 2 + 1)
  have hK : 0 < K := by dsimp only [K]; positivity
  refine ⟨K, max 16 (max X₀ Xρ), hK,
    le_trans (by norm_num : (1 : ℝ) ≤ 16) (le_max_left _ _), ?_⟩
  intro x hx M N R Q H γ hM hN hR hQ hMN hNγ hNR hRN hRQ hγlo hγcut
    r q₀ q₁ a b₁ b₂ hRr hrR hq₁Q hH hHone F J hF hJ ha hb₁
    ℓ t₀ Y hYx hY ψ hψ hψs hψ0 hψb β hβs hβ hψmajor c hc βℤ
  have hx16 : 16 ≤ x := (le_max_left _ _).trans hx
  have hxgt : 1 < x := by linarith only [hx16]
  have hxone : 1 ≤ x := hxgt.le
  have hxpos : 0 < x := zero_lt_one.trans hxgt
  have hx₀ : X₀ ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans hx)
  have hxρ : Xρ ≤ x := (le_max_right _ _).trans ((le_max_right _ _).trans hx)
  have hCpower : C ≤ x ^ ρ := (le_max_left _ _).trans (hXρ x hxρ)
  have htwopower : 2 ≤ x ^ ρ := (le_max_right _ _).trans (hXρ x hxρ)
  have hMNcost : x ^ (1 - ρ) ≤ M * N := by
    calc
      x ^ (1 - ρ) = x / x ^ ρ := by rw [Real.rpow_sub hxpos, Real.rpow_one]
      _ ≤ x / C := div_le_div_of_nonneg_left hxpos.le hCpos hCpower
      _ ≤ M * N := hMN
  by_cases hFempty : F = ∅
  · simp only [hFempty, Finset.sum_empty]
    positivity
  obtain ⟨v₀, hv₀⟩ := Finset.nonempty_iff_ne_empty.mpr hFempty
  have hsf := (hF v₀ hv₀).2.2
  have hq₀ : 0 < q₀ := Nat.pos_of_ne_zero hsf.of_mul_left.of_mul_left.of_mul_right.ne_zero
  have hq₁ : 0 < q₁ := Nat.pos_of_ne_zero hsf.of_mul_left.of_mul_right.ne_zero
  have hqpos : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀
  have hqone : 1 ≤ (q₀ : ℝ) := by exact_mod_cast hq₀
  have hrpos : 0 < (r : ℝ) := hR.trans_le hRr
  have hrnat : 0 < r := by exact_mod_cast hrpos
  have hHpos : 0 < H := zero_lt_one.trans_le hHone
  have hγhi : γ ≤ 1 / 2 := by linarith only [hγcut, hω, hc₀pos]
  let HN : ℕ := ⌊2 * H⌋₊
  let KN : ℕ := ⌊2 * Q / (q₀ : ℝ)⌋₊
  let P₀ : ℝ := (r : ℝ) * (q₀ : ℝ) * (q₁ : ℝ) * (KN : ℝ) ^ 2
  obtain ⟨hqN, hNr, hrx, hHKx, hPx, hPupper, hHK⟩ :=
    sourceLowerTypeIOne_geometry «ω» δ σ ρ x M N R Q H γ r q₀ q₁
      hω hδ hσ hρ hmargin hx16 htwopower hM hN hR hQ hq₀ hq₁
      hMNcost hNγ hNR hRN hRQ hγlo hγhi hRr hrR hH hHone hq₁Q
  have hHN : (HN : ℝ) ≤ 2 * H := Nat.floor_le (by positivity)
  have hKN : (KN : ℝ) ≤ 2 * Q / (q₀ : ℝ) := Nat.floor_le (by positivity)
  have hFnat (v : ℕ) (hv : v ∈ F) : 0 < v ∧ v ≤ KN ∧ Squarefree (r * q₀ * q₁ * v) :=
    ⟨(hF v hv).1, (Nat.le_floor_iff (by positivity)).mpr (hF v hv).2.1, (hF v hv).2.2⟩
  have hKNpos : 0 < KN := (hFnat v₀ hv₀).1.trans_le (hFnat v₀ hv₀).2.1
  have hPpos : 0 < P₀ := by dsimp only [P₀]; positivity
  have hJnat (h : ℤ) (hh : h ∈ J) : h ≠ 0 ∧ -(HN : ℤ) ≤ h ∧ h ≤ (HN : ℤ) := by
    have hreal : (h.natAbs : ℝ) ≤ 2 * H := by
      rw [Nat.cast_natAbs, Int.cast_abs]
      exact (hJ h hh).2
    have habs : h.natAbs ≤ HN := (Nat.le_floor_iff (by positivity)).mpr hreal
    exact ⟨(hJ h hh).1, by omega, by omega⟩
  have hFcard : (F.card : ℝ) ≤ 2 * Q / (q₀ : ℝ) := by
    have hsub : F ⊆ Finset.Icc 1 KN := fun v hv =>
      Finset.mem_Icc.mpr ⟨(hFnat v hv).1, (hFnat v hv).2.1⟩
    have hh : F.card ≤ KN := by
      simpa only [Nat.card_Icc, Nat.add_sub_cancel] using Finset.card_le_card hsub
    exact (Nat.cast_le.mpr hh).trans hKN
  have hJcard : (J.card : ℝ) ≤ 5 * H := by
    have hsub : J ⊆ Finset.Icc (-(HN : ℤ)) (HN : ℤ) :=
      fun h hh => Finset.mem_Icc.mpr (hJnat h hh).2
    have hcard := Int.card_Icc_of_le (a := -(HN : ℤ)) (b := (HN : ℤ)) (by omega)
    have hcardR : ((Finset.Icc (-(HN : ℤ)) (HN : ℤ)).card : ℝ) =
        (HN : ℝ) + 1 - (-(HN : ℝ)) := by exact_mod_cast hcard
    have hh : (J.card : ℝ) ≤ ((Finset.Icc (-(HN : ℤ)) (HN : ℤ)).card : ℝ) := by
      exact_mod_cast Finset.card_le_card hsub
    linarith only [hh, hcardR, hHN, hHone]
  let D : ℝ := x ^ (ρ / 100)
  have hDpos : 0 < D := Real.rpow_pos_of_pos hxpos _
  have hDone : 1 ≤ D := Real.one_le_rpow hxone (by positivity)
  let A : ℝ := Real.sqrt (N / (q₀ : ℝ)) * (P₀ * (Y : ℝ)) ^ (1 / 6 : ℝ)
  let B : ℝ := N / (q₀ : ℝ) / (r : ℝ)
  have hYpos : 0 < (Y : ℝ) := zero_lt_one.trans_le Y.property
  have hA0 : 0 ≤ A := by dsimp only [A]; positivity
  have hB0 : 0 ≤ B := by dsimp only [B]; positivity
  let S : ℝ := (J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * A +
    B * (D * (J.card : ℝ) * (F.card : ℝ) * ((HN : ℝ) * (KN : ℝ) + (r : ℝ)))
  have hS0 : 0 ≤ S :=
    add_nonneg (mul_nonneg (mul_nonneg (sq_nonneg _) (sq_nonneg _)) hA0)
      (mul_nonneg hB0 (mul_nonneg
        (mul_nonneg (mul_nonneg hDpos.le (Nat.cast_nonneg _)) (Nat.cast_nonneg _))
        (add_nonneg (mul_nonneg (Nat.cast_nonneg _) (Nat.cast_nonneg _)) (Nat.cast_nonneg _))))
  let U : ℝ := ∑ v ∈ F, ‖∑ n ∈ βℤ.support,
    βℤ n * star (βℤ (n + ℓ * (r : ℤ))) *
      (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
      ∑ h ∈ J, c v h * sourceTheta r q₀ 1 q₁ v a b₁ b₂ ℓ n h‖
  let g : ℝ := (Int.gcd (q₀ : ℤ) ℓ : ℝ)
  let Z : ℝ := g * N * Q / (q₀ : ℝ)
  have hU : 0 ≤ U := Finset.sum_nonneg (fun _ _ => norm_nonneg _)
  have hg : 0 ≤ g := Nat.cast_nonneg _
  have hZ : 0 ≤ Z := by dsimp only [Z]; positivity
  have hbound := hraw x hx₀ r q₀ q₁ a b₁ b₂ ⌊TN * N⌋₊ HN KN
    hrnat hq₀ hq₁ hrx hHKx hPx F J hFnat hJnat ha hb₁
    ℓ N t₀ D L hqN hNr hDpos.le hL Y hY ψ hψ hψs hψ0 hψb β hβs hβ hψmajor c hc
  clear hraw
  change U ^ 2 ≤ C₀ * D ^ 4 * g ^ 2 *
    (1 + (⌊TN * N⌋₊ : ℝ) / (q₀ : ℝ)) * L ^ 2 * D * S at hbound
  have hmass : 1 + (⌊TN * N⌋₊ : ℝ) / (q₀ : ℝ) ≤ (1 + TN) * N / (q₀ : ℝ) := by
    have hf := Nat.floor_le (show 0 ≤ TN * N by positivity)
    calc
      _ ≤ N / (q₀ : ℝ) + (TN * N) / (q₀ : ℝ) :=
        add_le_add ((one_le_div hqpos).mpr hqN) (div_le_div_of_nonneg_right hf hqpos.le)
      _ = _ := by ring
  let E : ℝ := (5 * H) ^ 2 * (2 * Q / (q₀ : ℝ)) ^ 2 * A +
    B * (5 * H) * (2 * Q / (q₀ : ℝ)) * (4 * H * Q / (q₀ : ℝ) + (r : ℝ))
  have hbracket : S ≤ D * E := by
    have hparts : (J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * A ≤
        (5 * H) ^ 2 * (2 * Q / (q₀ : ℝ)) ^ 2 * A :=
      mul_le_mul_of_nonneg_right
        (mul_le_mul (pow_le_pow_left₀ (Nat.cast_nonneg _) hJcard 2)
          (pow_le_pow_left₀ (Nat.cast_nonneg _) hFcard 2) (sq_nonneg _) (sq_nonneg _)) hA0
    have hmean : (J.card : ℝ) * (F.card : ℝ) * ((HN : ℝ) * (KN : ℝ) + (r : ℝ)) ≤
        (5 * H) * (2 * Q / (q₀ : ℝ)) * (4 * H * Q / (q₀ : ℝ) + (r : ℝ)) := by gcongr
    have hfirst := hparts.trans (le_mul_of_one_le_left (by positivity) hDone)
    have hsecond := mul_le_mul_of_nonneg_left
      (mul_le_mul_of_nonneg_left hmean hDpos.le) hB0
    dsimp only [S, E]
    nlinarith only [hfirst, hsecond]
  have hNloCost : x ^ (1 / 2 - σ) ≤ N := by
    rw [hNγ]
    exact Real.rpow_le_rpow_of_exponent_le hxone hγlo
  have hNhiCost : N ≤ x ^ (1 / 2 : ℝ) := by
    rw [hNγ]
    exact Real.rpow_le_rpow_of_exponent_le hxone hγhi
  have hNcutCost : N ≤ x ^ (1 / 2 - 2 * «ω» - c₀) := by
    rw [hNγ]
    exact Real.rpow_le_rpow_of_exponent_le hxone hγcut
  have hHcost : H ≤ x ^ ρ * R * Q ^ 2 / M := by
    rw [hH]
    exact div_le_div_of_nonneg_left (by positivity) hM
      (le_mul_of_one_le_left hM.le hqone)
  obtain ⟨hleadCost, _, hsecondaryCost, _, hcollisionCost, _⟩ :=
    lower_order_normalized_cost_bounds x M N R Q H «ω» δ σ c₀ ρ
      hxgt hM hN hR hQ hHpos.le hρ.le hMNcost hNloCost hNhiCost hNR hRN hRQ hHcost
  have hlead : H ^ 2 * Real.sqrt Q * R ^ (1 / 6 : ℝ) *
      x ^ (δ / 6) / Real.sqrt N ≤ x ^ (-2 * ρ) :=
    hleadCost.trans (Real.rpow_le_rpow_of_exponent_le hxone
      (by linarith only [hmargin, hρ]))
  have hsecondary : H ^ 2 / R ≤ x ^ (-2 * ρ) :=
    hsecondaryCost.trans (Real.rpow_le_rpow_of_exponent_le hxone
      (by linarith only [hmargin, hω, hδ, hσ, hρ]))
  have hcollision : H / Q ≤ x ^ (-2 * ρ) :=
    (hcollisionCost hNcutCost).trans (Real.rpow_le_rpow_of_exponent_le hxone
      (by linarith only [hc₀, hρ]))
  have hnormalized : (N / (q₀ : ℝ)) * E ≤
      250 * (N * Q / (q₀ : ℝ)) ^ 2 * x ^ (-2 * ρ) :=
    sourceLowerTypeIOne_normalized_envelope δ x H N R Q (r : ℝ) (q₀ : ℝ) P₀ (Y : ℝ)
      (x ^ (-2 * ρ)) hxone hHpos hN hR hQ hRr hqone hPpos hYpos hYx hPupper
      hlead hsecondary hcollision
  have hfinalsq : U ^ 2 ≤
      (250 * C₀ * (1 + TN) * L ^ 2) * Z ^ 2 * D ^ 6 * x ^ (-2 * ρ) := by
    apply hbound.trans
    calc
      _ ≤ C₀ * D ^ 4 * g ^ 2 * ((1 + TN) * N / (q₀ : ℝ)) * L ^ 2 * D * (D * E) := by
        exact mul_le_mul
          (mul_le_mul_of_nonneg_right
            (mul_le_mul_of_nonneg_right
              (mul_le_mul_of_nonneg_left hmass (by positivity)) (sq_nonneg L)) hDpos.le)
          hbracket hS0 (by positivity)
      _ = (C₀ * (1 + TN) * L ^ 2 * g ^ 2 * D ^ 6) * ((N / (q₀ : ℝ)) * E) := by ring
      _ ≤ (C₀ * (1 + TN) * L ^ 2 * g ^ 2 * D ^ 6) *
          (250 * (N * Q / (q₀ : ℝ)) ^ 2 * x ^ (-2 * ρ)) :=
        mul_le_mul_of_nonneg_left hnormalized (by positivity)
      _ = _ := by dsimp only [Z]; ring
  have hpower : D ^ 6 * x ^ (-2 * ρ) ≤ x ^ (-ρ) := by
    calc
      D ^ 6 * x ^ (-2 * ρ) = x ^ (6 * (ρ / 100) - 2 * ρ) := by
        dsimp only [D]
        rw [← Real.rpow_mul_natCast hxpos.le, ← Real.rpow_add hxpos]
        congr 1
        ring
      _ ≤ x ^ (-ρ) := Real.rpow_le_rpow_of_exponent_le hxone (by linarith only [hρ])
  have hKsq : K ^ 2 = 250 * C₀ * (1 + TN) * L ^ 2 + 1 := Real.sq_sqrt (by positivity)
  have hsq : U ^ 2 ≤ (K * Z * x ^ (-ρ / 2)) ^ 2 := by
    calc
      U ^ 2 ≤ (250 * C₀ * (1 + TN) * L ^ 2) * Z ^ 2 *
          (D ^ 6 * x ^ (-2 * ρ)) := by simpa only [mul_assoc] using hfinalsq
      _ ≤ K ^ 2 * Z ^ 2 * x ^ (-ρ) := by
        gcongr
        rw [hKsq]
        linarith
      _ = _ := by
        rw [mul_pow, mul_pow, ← Real.rpow_mul_natCast hxpos.le]
        congr 1
        ring_nf
  have hfinal : U ≤ K * Z * x ^ (-ρ / 2) := (sq_le_sq₀ hU (by positivity)).mp hsq
  change U ≤ _
  convert hfinal using 1
  dsimp only [Z, g]
  ring

open Classical in
theorem sourceLowerOne_uniform_band
    («ω» δ σ c₀ ρ C cM TM TN T A₀ A₁ LM : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hσ : 0 ≤ σ) (hρ : 0 < ρ)
    (hmargin : 54 * «ω» + 15 * δ + 5 * σ + 10000 * ρ < 1)
    (hc₀ : 100 * ρ < c₀)
    (hC : 1 ≤ C) (hcM : 0 < cM) (hMT : cM ≤ TM)
    (hTN : 1 ≤ TN) (hT : 1 ≤ T) (hA₀ : 0 ≤ A₀) (hA₁ : 0 ≤ A₁) (hLM : 0 ≤ LM) :
    ∃ K X : ℝ, 0 < K ∧ 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ M N R Q H γ : ℝ,
        0 < M → 0 < N → 0 < R → 0 < Q →
        x / C ≤ M * N → N = x ^ γ →
        x ^ (-δ - 6 * ρ) * N ≤ R →
        R ≤ x ^ (-4 * ρ) * N →
        R * Q ≤ x ^ (1 / 2 + 2 * «ω» + ρ) →
        1 / 2 - σ ≤ γ → γ ≤ 1 / 2 - 2 * «ω» - c₀ →
      ∀ q₀ a b₁ b₂ : ℕ,
        H = x ^ ρ * R * Q ^ 2 / ((q₀ : ℝ) * M) → 1 ≤ H →
      ∀ (𝒜 : Finset (ℕ × ℕ × ℕ × ℕ)) (J : Finset ℤ),
        (∀ t ∈ 𝒜,
          t.2.1 = 1 ∧ 0 < t.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
          Squarefree (t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2) ∧
          R ≤ (t.1 : ℝ) ∧ (t.1 : ℝ) ≤ 2 * R ∧
          Q ≤ (q₀ * t.2.2.1 : ℕ) ∧ (q₀ * t.2.2.1 : ℕ) ≤ 2 * Q ∧
          Q ≤ (q₀ * t.2.2.2 : ℕ) ∧ (q₀ * t.2.2.2 : ℕ) ≤ 2 * Q) →
        (∀ h ∈ J, h ≠ 0 ∧ |(h : ℝ)| ≤ 2 * H) →
        (∀ t ∈ 𝒜, Nat.Coprime a t.1) → Nat.Coprime b₁ q₀ →
      ∀ (ν : ℕ × ℕ → ℂ),
        (∀ t ∈ 𝒜,
          ‖ν (q₀ * t.2.1 * t.2.2.1, t.1)‖ ≤ 1 ∧
          ‖ν (q₀ * t.2.2.2, t.1)‖ ≤ 1) →
      ∀ (ℓ : ℤ) (t₀ : ℝ) (Y : Set.Ici (1 : ℝ)), (Y : ℝ) ≤ x ^ δ →
        (∀ t ∈ 𝒜,
          Nonempty (DenseDivisibilityWitness
            Y 1 (t.1 * q₀ * t.2.2.1)) ∧
          Nonempty (DenseDivisibilityWitness
            Y 1 (t.1 * q₀ * t.2.2.2))) →
      ∀ (ψM ψN : ℝ → ℝ),
        Function.support ψM ⊆ Set.Icc cM TM → (∀ t : ℝ, |ψM t| ≤ LM) →
        ContDiff ℝ 1 ψN → Function.support ψN ⊆ Set.Icc (-T) T →
        (∀ t : ℝ, 0 ≤ ψN t) →
        (∀ t : ℝ, |ψN t| ≤ A₀ ∧ |deriv ψN t| ≤ A₁) →
      ∀ (β : ℕ →₀ ℂ), β.support ⊆ Finset.Icc 1 ⌊TN * N⌋₊ →
        (∀ n ∈ β.support, ‖β n‖ ≤ x ^ (ρ / 100)) →
        (∀ n ∈ β.support, 1 ≤ ψN (((n : ℝ) - t₀) / N)) →
      let βℤ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
      let P : (ℕ × ℕ × ℕ × ℕ) → ℕ := fun t =>
        t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2
      (∑ t ∈ 𝒜,
        ‖ν (q₀ * t.2.1 * t.2.2.1, t.1) * star (ν (q₀ * t.2.2.2, t.1)) *
          ((M : ℂ) / (P t : ℂ)) *
            ∑ n ∈ βℤ.support.filter (fun n =>
              Int.gcd n ((t.1 * q₀ * t.2.1 * t.2.2.1 : ℕ) : ℤ) = 1 ∧
              Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2.2 : ℕ) : ℤ) = 1),
              βℤ n * star (βℤ (n + ℓ * (t.1 : ℤ))) *
                (sourceCompatibility t.1 q₀ b₁ b₂ ℓ n : ℂ) *
                  ∑ h ∈ J, sourcePhi ψM M (P t) h *
                    sourceTheta t.1 q₀ t.2.1 t.2.2.1 t.2.2.2 a b₁ b₂ ℓ n h‖) ≤
        K * M * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) / (q₀ : ℝ) * x ^ (-ρ / 2) := by
  have hTM : 0 < TM := hcM.trans_le hMT
  have hPhiBound : 0 ≤ TM * LM := mul_nonneg hTM.le hLM
  obtain ⟨K, X, hK, hX, hnear⟩ := sourceTheta_lower_typeIOne_uniform_power_saving
    «ω» δ σ c₀ ρ C T TN A₀ A₁ (TM * LM) hω hδ hσ hρ hmargin hc₀
      hC hT hTN hA₀ hA₁ hPhiBound
  refine ⟨4 * K, X, mul_pos (by norm_num) hK, hX, ?_⟩
  intro x hx M N R Q H γ hM hN hR hQ hMN hNγ hNR hRN hRQ hγlo hγhi
    q₀ a b₁ b₂ hH hHone 𝒜 J h𝒜 hJ ha hb₁ ν hν ℓ t₀ Y hYx hY ψM ψN hψMs hψMb
    hψN hψNs hψN0 hψNb β hβs hβ hψmajor βℤ P
  have hxone : 1 ≤ x := hX.trans hx
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  by_cases h𝒜empty : 𝒜 = ∅
  · simp only [h𝒜empty, Finset.sum_empty]
    positivity
  obtain ⟨t₀', ht₀'⟩ := Finset.nonempty_iff_ne_empty.mpr h𝒜empty
  have hsf := (h𝒜 t₀' ht₀').2.2.2.2.1
  have hq₀ : 0 < q₀ :=
    Nat.pos_of_ne_zero hsf.of_mul_left.of_mul_left.of_mul_left.of_mul_right.ne_zero
  have hqpos : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀
  have hPhi (d : ℕ) (h : ℤ) : ‖sourcePhi ψM M d h‖ ≤ TM * LM := by
    have hb := sourcePhiRealFactor_sampling_and_norm cM TM M LM hcM hMT hM hLM
      ψM hψMs hψMb d h
    have heq := hb.2.1 1
    simp only [Nat.cast_one, Nat.one_mul] at heq
    simpa only [heq] using hb.2.2 (1 : ℝ)
  let key : (ℕ × ℕ × ℕ × ℕ) → ℕ × ℕ := fun t => (t.1, t.2.2.1)
  let Bs : Finset (ℕ × ℕ) := 𝒜.image key
  let F : (ℕ × ℕ) → Finset ℕ := fun b =>
    (𝒜.filter (fun t => key t = b)).image (fun t => t.2.2.2)
  let w : (ℕ × ℕ) → ℕ → ℝ := fun b v =>
    ‖∑ n ∈ βℤ.support, βℤ n * star (βℤ (n + ℓ * (b.1 : ℤ))) *
      (sourceCompatibility b.1 q₀ b₁ b₂ ℓ n : ℂ) *
        ∑ h ∈ J, sourcePhi ψM M (b.1 * q₀ * b.2 * v) h *
          sourceTheta b.1 q₀ 1 b.2 v a b₁ b₂ ℓ n h‖
  have hw (b : ℕ × ℕ) (v : ℕ) : 0 ≤ w b v := norm_nonneg _
  have hF (b : ℕ × ℕ) (v : ℕ) (hv : v ∈ F b) :
      0 < v ∧ (v : ℝ) ≤ 2 * Q / (q₀ : ℝ) ∧ Squarefree (b.1 * q₀ * b.2 * v) := by
    obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hv
    obtain ⟨htA, htb⟩ := Finset.mem_filter.mp ht
    have htr : t.1 = b.1 := congrArg Prod.fst htb
    have htq : t.2.2.1 = b.2 := congrArg Prod.snd htb
    obtain ⟨hu, _, _, hv, hsf, _, _, _, _, _, hq₂hi⟩ := h𝒜 t htA
    refine ⟨hv, ?_, ?_⟩
    · apply (le_div_iff₀ hqpos).mpr
      simpa only [Nat.cast_mul, mul_comm] using hq₂hi
    · simpa only [hu, Nat.mul_one, htr, htq] using hsf
  have hYF (b : ℕ × ℕ) (v : ℕ) (hv : v ∈ F b) :
      Nonempty (DenseDivisibilityWitness Y 1 (b.1 * q₀ * b.2)) ∧
      Nonempty (DenseDivisibilityWitness Y 1 (b.1 * q₀ * v)) := by
    obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hv
    obtain ⟨htA, htb⟩ := Finset.mem_filter.mp ht
    have htr : t.1 = b.1 := congrArg Prod.fst htb
    have htq : t.2.2.1 = b.2 := congrArg Prod.snd htb
    simpa only [htr, htq] using hY t htA
  have hrow (t : ℕ × ℕ × ℕ × ℕ) (ht : t ∈ 𝒜) := by
    obtain ⟨hu, hr, hv, hq₂, _, hRr, _, hQ₁, _, hQ₂, _⟩ := h𝒜 t ht
    have hraw := sourceHighGamma_weighted_row_norm t.1 q₀ t.2.1 t.2.2.1 t.2.2.2
      a b₁ b₂ ℓ M R Q hM hR hQ hr hq₀ (by omega) hv hq₂ hRr
      (by simpa only [hu, Nat.mul_one] using hQ₁) hQ₂
      (ν (q₀ * t.2.1 * t.2.2.1, t.1)) (ν (q₀ * t.2.2.2, t.1))
      (hν t ht).1 (hν t ht).2 βℤ.support J βℤ (fun h => sourcePhi ψM M (P t) h)
    dsimp only at hraw
    conv_rhs at hraw => simp only [P, hu, Nat.mul_one]
    exact hraw
  have hlocal (b : ℕ × ℕ) (hb : b ∈ Bs) :
      (∑ v ∈ F b, w b v) ≤
        K * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * N * Q / (q₀ : ℝ) * x ^ (-ρ / 2) := by
    obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hb
    obtain ⟨_, _, _, _, _, hRr, hrR, _, hq₁hi, _, _⟩ := h𝒜 t ht
    exact hnear x hx M N R Q H γ hM hN hR hQ hMN hNγ hNR hRN hRQ hγlo hγhi
      t.1 q₀ t.2.2.1 a b₁ b₂ hRr hrR (by simpa only [Nat.cast_mul] using hq₁hi)
      hH hHone (F (key t)) J (hF (key t)) hJ (ha t ht) hb₁
      ℓ t₀ Y hYx (hYF (key t)) ψN hψN hψNs hψN0 hψNb β hβs hβ hψmajor
      (fun v h => sourcePhi ψM M (t.1 * q₀ * t.2.2.1 * v) h)
      (fun _ _ h _ => hPhi _ h)
  have hsumr (b : ℕ × ℕ) :
      (∑ t ∈ 𝒜.filter (fun t => key t = b), w (key t) t.2.2.2) =
        ∑ v ∈ F b, w b v := by
    have hinj : Set.InjOn (fun t : ℕ × ℕ × ℕ × ℕ => t.2.2.2)
        (𝒜.filter (fun t => key t = b) : Set _) := by
      intro t ht s hs heq
      obtain ⟨htA, htb⟩ := Finset.mem_filter.mp ht
      obtain ⟨hsA, hsb⟩ := Finset.mem_filter.mp hs
      have hkeys : key t = key s := htb.trans hsb.symm
      have htr : t.1 = s.1 := congrArg (fun b : ℕ × ℕ => b.1) hkeys
      have htq : t.2.2.1 = s.2.2.1 := congrArg (fun b : ℕ × ℕ => b.2) hkeys
      exact Prod.ext htr
        (Prod.ext ((h𝒜 t htA).1.trans (h𝒜 s hsA).1.symm)
          (Prod.ext htq heq))
    calc
      _ = ∑ t ∈ 𝒜.filter (fun t => key t = b), w b t.2.2.2 := by
        apply Finset.sum_congr rfl
        intro t ht
        rw [(Finset.mem_filter.mp ht).2]
      _ = _ := (Finset.sum_image hinj).symm
  have hBcard : (Bs.card : ℝ) ≤ 4 * R * Q / (q₀ : ℝ) := by
    have hsub : Bs ⊆ (Finset.Icc 1 ⌊2 * R⌋₊) ×ˢ
        (Finset.Icc 1 ⌊2 * Q / (q₀ : ℝ)⌋₊) := by
      intro b hb
      obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hb
      obtain ⟨_, hr, hq₁, _, _, _, hrR, _, hq₁hi, _, _⟩ := h𝒜 t ht
      refine Finset.mem_product.mpr ⟨?_, ?_⟩
      · exact Finset.mem_Icc.mpr ⟨hr, (Nat.le_floor_iff (by positivity)).mpr hrR⟩
      · refine Finset.mem_Icc.mpr ⟨hq₁, (Nat.le_floor_iff (by positivity)).mpr ?_⟩
        apply (le_div_iff₀ hqpos).mpr
        simpa only [Nat.cast_mul, mul_comm] using hq₁hi
    have hh : Bs.card ≤ ⌊2 * R⌋₊ * ⌊2 * Q / (q₀ : ℝ)⌋₊ := by
      simpa only [Finset.card_product, Nat.card_Icc, Nat.add_sub_cancel] using
        Finset.card_le_card hsub
    calc
      _ ≤ (⌊2 * R⌋₊ : ℝ) * (⌊2 * Q / (q₀ : ℝ)⌋₊ : ℝ) := by exact_mod_cast hh
      _ ≤ (2 * R) * (2 * Q / (q₀ : ℝ)) :=
        mul_le_mul (Nat.floor_le (by positivity)) (Nat.floor_le (by positivity))
          (Nat.cast_nonneg _) (by positivity)
      _ = _ := by ring
  have hfamily : (∑ t ∈ 𝒜, w (key t) t.2.2.2) ≤
      (4 * R * Q / (q₀ : ℝ)) *
        (K * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * N * Q / (q₀ : ℝ) * x ^ (-ρ / 2)) := by
    calc
      _ = ∑ b ∈ Bs, ∑ t ∈ 𝒜.filter (fun t => key t = b), w (key t) t.2.2.2 :=
        (Finset.sum_fiberwise_of_maps_to (s := 𝒜) (t := Bs) (g := key)
          (fun t ht => Finset.mem_image_of_mem key ht) _).symm
      _ = ∑ b ∈ Bs, ∑ v ∈ F b, w b v := Finset.sum_congr rfl (fun b _ => hsumr b)
      _ ≤ ∑ _b ∈ Bs, K * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * N * Q / (q₀ : ℝ) * x ^ (-ρ / 2) :=
        Finset.sum_le_sum hlocal
      _ = (Bs.card : ℝ) *
          (K * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * N * Q / (q₀ : ℝ) * x ^ (-ρ / 2)) := by
        rw [Finset.sum_const, nsmul_eq_mul]
      _ ≤ _ := mul_le_mul_of_nonneg_right hBcard (by positivity)
  calc
    _ ≤ ∑ t ∈ 𝒜, (M * (q₀ : ℝ) / (R * Q ^ 2)) * w (key t) t.2.2.2 :=
      Finset.sum_le_sum hrow
    _ = (M * (q₀ : ℝ) / (R * Q ^ 2)) * ∑ t ∈ 𝒜, w (key t) t.2.2.2 :=
      (Finset.mul_sum ..).symm
    _ ≤ (M * (q₀ : ℝ) / (R * Q ^ 2)) *
        ((4 * R * Q / (q₀ : ℝ)) *
          (K * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * N * Q / (q₀ : ℝ) * x ^ (-ρ / 2))) :=
      mul_le_mul_of_nonneg_left hfamily (by positivity)
    _ = _ := by field_simp [hR.ne', hQ.ne', hqpos.ne']

open Classical in
theorem sourceTheta_lower_typeII_uniform_power_saving
    («ω» δ c₀ ρ C T TN A₀ A₁ L : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hc₀ : 0 < c₀) (hρ : 0 < ρ)
    (hmargin : 68 * «ω» + 14 * δ + 100 * c₀ + 10000 * ρ < 1)
    (hC : 1 ≤ C) (hT : 1 ≤ T) (hTN : 1 ≤ TN)
    (hA₀ : 0 ≤ A₀) (hA₁ : 0 ≤ A₁) (hL : 0 ≤ L) :
    ∃ K X : ℝ, 0 < K ∧ 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ M N R Q H γ : ℝ,
        0 < M → 0 < N → 0 < R → 0 < Q →
        x / C ≤ M * N → N = x ^ γ →
        x ^ (-δ - 6 * ρ) * N ≤ R →
        R ≤ x ^ (-4 * ρ) * N →
        R * Q ≤ x ^ (1 / 2 + 2 * «ω» + ρ) →
        1 / 2 - 2 * «ω» - c₀ ≤ γ → γ ≤ 1 / 2 →
      ∀ r q₀ a b₁ b₂ : ℕ,
        R ≤ (r : ℝ) → (r : ℝ) ≤ 2 * R →
        H = x ^ ρ * R * Q ^ 2 / ((q₀ : ℝ) * M) → 1 ≤ H →
      ∀ (F : Finset (ℕ × ℕ)) (J : Finset ℤ),
        (∀ q ∈ F,
          Squarefree (r * q₀ * q.1 * q.2) ∧
          Q ≤ (q₀ * q.1 : ℕ) ∧ (q₀ * q.1 : ℕ) ≤ 2 * Q ∧
          Q ≤ (q₀ * q.2 : ℕ) ∧ (q₀ * q.2 : ℕ) ≤ 2 * Q) →
        (∀ h ∈ J, h ≠ 0 ∧ |(h : ℝ)| ≤ 2 * H) →
        Nat.Coprime a r → Nat.Coprime b₁ q₀ →
      ∀ (ℓ : ℤ) (t₀ : ℝ) (ψ : ℝ → ℝ),
        ContDiff ℝ 1 ψ → Function.support ψ ⊆ Set.Icc (-T) T →
        (∀ t : ℝ, 0 ≤ ψ t) →
        (∀ t : ℝ, |ψ t| ≤ A₀ ∧ |deriv ψ t| ≤ A₁) →
      ∀ (β : ℕ →₀ ℂ), β.support ⊆ Finset.Icc 1 ⌊TN * N⌋₊ →
        (∀ n ∈ β.support, ‖β n‖ ≤ x ^ (ρ / 100)) →
        (∀ n ∈ β.support, 1 ≤ ψ (((n : ℝ) - t₀) / N)) →
      ∀ (c : (ℕ × ℕ) → ℤ → ℂ),
        (∀ q ∈ F, ∀ h ∈ J, ‖c q h‖ ≤ L) →
      let βℤ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
      (∑ q ∈ F, ‖∑ n ∈ βℤ.support,
        βℤ n * star (βℤ (n + ℓ * (r : ℤ))) *
          (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
          ∑ h ∈ J, c q h * sourceTheta r q₀ 1 q.1 q.2 a b₁ b₂ ℓ n h‖) ≤
        K * Q ^ 2 * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) / (q₀ : ℝ) ^ 2 *
          x ^ (-ρ / 2) := by
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hTNpos : 0 < TN := zero_lt_one.trans_le hTN
  have hρsmall : ρ ≤ 1 / 100 := by
    linarith
  have hδsmall : (δ + 2 * ρ) + 4 * ρ ≤ 1 / 12 := by
    linarith
  have hRQexponent : 1 / 2 + 2 * «ω» + ρ ≤ 7 / 12 := by
    linarith
  obtain ⟨C₀, hC₀, hphase⟩ := sourceTheta_pair_finite_cauchy_bounds
    T A₀ A₁ 3 (ρ / 1000) hT hA₀ hA₁ (by positivity)
  obtain ⟨Xg, hXg, hgcd⟩ := sourceSignedProduct_pair_gcd_sum_uniform
    10 (ρ / 100) (by norm_num) (by positivity)
  obtain ⟨Xc, hXc⟩ := Filter.eventually_atTop.mp
    ((tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 100)).eventually_ge_atTop (100 * C))
  obtain ⟨Xρ, hXρ⟩ := Filter.eventually_atTop.mp
    ((tendsto_rpow_atTop hρ).eventually_ge_atTop C)
  let K := Real.sqrt (2600 * C₀ * (1 + TN) * L ^ 2 + 1)
  have hK : 0 < K := by dsimp only [K]; positivity
  refine ⟨K, max 2 (max Xg (max Xc Xρ)), hK,
    le_trans (by norm_num : (1 : ℝ) ≤ 2) (le_max_left _ _), ?_⟩
  intro x hx M N R Q H γ hM hN hR hQ hMN hNγ hNR hRN hRQ hγlo hγhi
    r q₀ a b₁ b₂ hRr hrR hH hHone F J hF hJ ha hb₁ ℓ t₀ ψ hψ hψs hψ0 hψb
    β hβs hβ hψmajor c hc βℤ
  have hxtwo : 2 ≤ x := (le_max_left _ _).trans hx
  have hxone : 1 ≤ x := by linarith
  have hxgt : 1 < x := by linarith
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  have hxg : Xg ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans hx)
  have hxc : Xc ≤ x := (le_max_left _ _).trans
    ((le_max_right _ _).trans ((le_max_right _ _).trans hx))
  have hxρ : Xρ ≤ x := (le_max_right _ _).trans
    ((le_max_right _ _).trans ((le_max_right _ _).trans hx))
  have hCpower : C ≤ x ^ ρ := hXρ x hxρ
  have hxlarge : 100 * C ≤ x ^ (1 / 100 : ℝ) := hXc x hxc
  by_cases hFempty : F = ∅
  · simp only [hFempty, Finset.sum_empty]
    positivity
  have hγlower : 5 / 12 ≤ γ := by linarith
  have hNRgeo : N ≤ C * x ^ ((δ + 2 * ρ) + 4 * ρ) * R := by
    calc
      N = x ^ (δ + 6 * ρ) * (x ^ (-δ - 6 * ρ) * N) := by
        rw [← mul_assoc, ← Real.rpow_add hxpos]
        simp only [show δ + 6 * ρ + (-δ - 6 * ρ) = 0 by ring, Real.rpow_zero, one_mul]
      _ ≤ x ^ (δ + 6 * ρ) * R := mul_le_mul_of_nonneg_left hNR (by positivity)
      _ ≤ C * x ^ (δ + 6 * ρ) * R := by
        exact mul_le_mul_of_nonneg_right
          (le_mul_of_one_le_left (by positivity) hC) hR.le
      _ = _ := by
        rw [show δ + 6 * ρ = (δ + 2 * ρ) + 4 * ρ by ring]
  have hRNgeo : R ≤ C * x ^ (-2 * ρ) * N := by
    calc
      R ≤ x ^ (-4 * ρ) * N := hRN
      _ ≤ x ^ (-2 * ρ) * N := by gcongr; linarith
      _ ≤ C * x ^ (-2 * ρ) * N :=
        mul_le_mul_of_nonneg_right (le_mul_of_one_le_left (by positivity) hC) hN.le
  have hRQgeo : R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ρ) :=
    hRQ.trans (le_mul_of_one_le_left (by positivity) hC)
  let P : (ℕ × ℕ) → (ℕ × ℕ) → ℕ := fun t s =>
    Nat.lcm (r * q₀ * t.1 * t.2) (r * q₀ * s.1 * s.2)
  let HN : ℕ := ⌊2 * H⌋₊
  let KN : ℕ := ⌊4 * Q ^ 2 / (q₀ : ℝ) ^ 2⌋₊
  obtain ⟨hq₀, hq₀N, hrx, hPbounds, hJcard, hFcard, hHK, hHKx, hJnat, hFnat⟩ :=
    sourceHighGamma_near_geometry «ω» (δ + 2 * ρ) ρ C x M N R Q H γ r q₀ F J
      hC hxone hxlarge hρ hρsmall hδsmall hRQexponent hM hN hR hQ
      hMN hNγ hNRgeo hRNgeo hRQgeo hγlower hγhi hRr hrR hH hHone
      (Finset.nonempty_iff_ne_empty.mpr hFempty) hF hJ
  have hq₀R : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀
  have hq₀one : 1 ≤ (q₀ : ℝ) := by exact_mod_cast hq₀
  have hrpos : 0 < (r : ℝ) := hR.trans_le hRr
  have hrnat : 0 < r := by exact_mod_cast hrpos
  have hHpos : 0 < H := zero_lt_one.trans_le hHone
  have hPscale (t : ℕ × ℕ) (ht : t ∈ F) (s : ℕ × ℕ) (hs : s ∈ F) :
      N ≤ (P t s : ℝ) ^ (3 : ℝ) ∧ (P t s : ℝ) ≤ x ^ (10 : ℝ) :=
    ⟨(hPbounds t ht s hs).1, (hPbounds t ht s hs).2.1⟩
  have hPsqrt (t : ℕ × ℕ) (ht : t ∈ F) (s : ℕ × ℕ) (hs : s ∈ F) :
      Real.sqrt ((P t s / q₀ : ℕ) : ℝ) ≤ 6 * Real.sqrt R * Q ^ 2 / (q₀ : ℝ) ^ 2 :=
    (hPbounds t ht s hs).2.2
  let D : ℝ := x ^ (ρ / 100)
  have hDpos : 0 < D := Real.rpow_pos_of_pos hxpos _
  have hDone : 1 ≤ D := Real.one_le_rpow hxone (by positivity)
  have hPρ (t : ℕ × ℕ) (ht : t ∈ F) (s : ℕ × ℕ) (hs : s ∈ F) :
      (P t s : ℝ) ^ (ρ / 1000) ≤ D := by
    calc
      _ ≤ (x ^ (10 : ℝ)) ^ (ρ / 1000) :=
        Real.rpow_le_rpow (Nat.cast_nonneg _) (hPscale t ht s hs).2 (by positivity)
      _ = D := by rw [← Real.rpow_mul hxpos.le]; congr 1; ring
  let G : ℝ := ∑ t ∈ F, ∑ s ∈ F, ∑ h ∈ J, ∑ k ∈ J,
    (Int.gcd (r : ℤ) (h * (s.1 : ℤ) * (s.2 : ℤ) -
      k * (t.1 : ℤ) * (t.2 : ℤ)) : ℝ)
  have hG : G ≤ D * (5 * H) * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) *
      (8 * H * Q ^ 2 / (q₀ : ℝ) ^ 2 + 2 * R) := by
    have hraw := hgcd x hxg r HN KN hrnat hrx hHKx J F hJnat hFnat
    have heq : G = ∑ h ∈ J, ∑ s ∈ F, ∑ k ∈ J, ∑ t ∈ F,
        (Int.gcd (h * (s.1 : ℤ) * (s.2 : ℤ) -
          k * (t.1 : ℤ) * (t.2 : ℤ)) (r : ℤ) : ℝ) := by
      calc
        G = ∑ s ∈ F, ∑ t ∈ F, ∑ h ∈ J, ∑ k ∈ J,
            (Int.gcd (r : ℤ) (h * (s.1 : ℤ) * (s.2 : ℤ) -
              k * (t.1 : ℤ) * (t.2 : ℤ)) : ℝ) := Finset.sum_comm
        _ = ∑ s ∈ F, ∑ h ∈ J, ∑ k ∈ J, ∑ t ∈ F,
            (Int.gcd (r : ℤ) (h * (s.1 : ℤ) * (s.2 : ℤ) -
              k * (t.1 : ℤ) * (t.2 : ℤ)) : ℝ) := by
          apply Finset.sum_congr rfl
          intro s _
          exact Finset.sum_comm_cycle.symm
        _ = ∑ h ∈ J, ∑ s ∈ F, ∑ k ∈ J, ∑ t ∈ F,
            (Int.gcd (r : ℤ) (h * (s.1 : ℤ) * (s.2 : ℤ) -
              k * (t.1 : ℤ) * (t.2 : ℤ)) : ℝ) := Finset.sum_comm
        _ = _ := by simp only [Int.gcd_comm]
    rw [heq]
    apply hraw.trans
    change D * (J.card : ℝ) * (F.card : ℝ) * ((HN : ℝ) * (KN : ℝ) + (r : ℝ)) ≤ _
    gcongr
  let B : ℝ := 6 * Real.sqrt R * Q ^ 2 / (q₀ : ℝ) ^ 2
  let A : ℝ := (N / (q₀ : ℝ) / (r : ℝ))
  let E : ℝ := ∑ t ∈ F, ∑ s ∈ F, ∑ h ∈ J, ∑ k ∈ J,
    (P t s : ℝ) ^ (ρ / 1000) *
      (Real.sqrt ((P t s / q₀ : ℕ) : ℝ) +
        (N / (q₀ : ℝ)) *
          ((Int.gcd (r : ℤ) (h * (s.1 : ℤ) * (s.2 : ℤ) -
            k * (t.1 : ℤ) * (t.2 : ℤ)) : ℝ) / (r : ℝ)))
  have hEsum : E ≤ D *
      ((J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * B + A * G) := by
    calc
      E ≤ ∑ t ∈ F, ∑ s ∈ F, ∑ h ∈ J, ∑ k ∈ J,
          D * (B + A * (Int.gcd (r : ℤ)
            (h * (s.1 : ℤ) * (s.2 : ℤ) -
              k * (t.1 : ℤ) * (t.2 : ℤ)) : ℝ)) := by
        apply Finset.sum_le_sum
        intro t ht
        apply Finset.sum_le_sum
        intro s hs
        apply Finset.sum_le_sum
        intro h _
        apply Finset.sum_le_sum
        intro k _
        apply mul_le_mul (hPρ t ht s hs) ?_ (by positivity) hDpos.le
        have hh := hPsqrt t ht s hs
        simpa only [A, B, div_eq_mul_inv, mul_assoc, mul_left_comm, mul_comm, add_comm] using
          add_le_add_right hh ((N / (q₀ : ℝ)) *
            ((Int.gcd (r : ℤ) (h * (s.1 : ℤ) * (s.2 : ℤ) -
              k * (t.1 : ℤ) * (t.2 : ℤ)) : ℝ) / (r : ℝ)))
      _ = _ := sourceHighGamma_four_sum_affine F J D B A
        (fun t s h k => (Int.gcd (r : ℤ)
          (h * (s.1 : ℤ) * (s.2 : ℤ) - k * (t.1 : ℤ) * (t.2 : ℤ)) : ℝ))
  have hEbound : E ≤ D ^ 2 *
      ((5 * H) ^ 2 * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) ^ 2 * B +
        A * (5 * H) * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) *
          (8 * H * Q ^ 2 / (q₀ : ℝ) ^ 2 + 2 * R)) := by
    apply hEsum.trans
    have hB0 : 0 ≤ B := by dsimp only [B]; positivity
    have hA0 : 0 ≤ A := by dsimp only [A]; positivity
    have hcards : (J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * B ≤
        (5 * H) ^ 2 * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) ^ 2 * B :=
      mul_le_mul_of_nonneg_right
        (mul_le_mul (pow_le_pow_left₀ (Nat.cast_nonneg _) hJcard 2)
          (pow_le_pow_left₀ (Nat.cast_nonneg _) hFcard 2) (sq_nonneg _) (sq_nonneg _)) hB0
    calc
      D * ((J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * B + A * G) ≤
          D * ((5 * H) ^ 2 * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) ^ 2 * B +
            A * (D * (5 * H) * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) *
              (8 * H * Q ^ 2 / (q₀ : ℝ) ^ 2 + 2 * R))) :=
        mul_le_mul_of_nonneg_left
          (add_le_add hcards (mul_le_mul_of_nonneg_left hG hA0)) hDpos.le
      _ ≤ D * (D *
          ((5 * H) ^ 2 * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) ^ 2 * B +
            A * (5 * H) * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) *
              (8 * H * Q ^ 2 / (q₀ : ℝ) ^ 2 + 2 * R))) := by
        have hh : (5 * H) ^ 2 * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) ^ 2 * B ≤
            D * ((5 * H) ^ 2 * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) ^ 2 * B) :=
          le_mul_of_one_le_left (by positivity) hDone
        nlinarith only [mul_le_mul_of_nonneg_left hh hDpos.le]
      _ = _ := by ring
  let U : ℝ := ∑ t ∈ F, ‖∑ n ∈ βℤ.support,
    βℤ n * star (βℤ (n + ℓ * (r : ℤ))) *
      (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
      ∑ h ∈ J, c t h * sourceTheta r q₀ 1 t.1 t.2 a b₁ b₂ ℓ n h‖
  let g : ℝ := (Int.gcd (q₀ : ℤ) ℓ : ℝ)
  let Z : ℝ := Q ^ 2 * N * g / (q₀ : ℝ) ^ 2
  have hU : 0 ≤ U := by dsimp only [U]; positivity
  have hg : 0 ≤ g := Nat.cast_nonneg _
  have hZ : 0 ≤ Z := by dsimp only [Z]; positivity
  have hraw := (hphase r q₀ a b₁ b₂ ⌊TN * N⌋₊ F J
    (fun t ht => (hF t ht).1) ha hb₁ ℓ N t₀ D L hq₀N hDpos.le hL
    (fun t ht s hs => (hPscale t ht s hs).1) ψ hψ hψs hψ0 hψb
    β hβs hβ hψmajor c hc).1
  change U ^ 2 ≤ C₀ * D ^ 4 * g ^ 2 *
    (1 + (⌊TN * N⌋₊ : ℝ) / (q₀ : ℝ)) * L ^ 2 * E at hraw
  have hmass : 1 + (⌊TN * N⌋₊ : ℝ) / (q₀ : ℝ) ≤ (1 + TN) * N / (q₀ : ℝ) := by
    have hf := Nat.floor_le (show 0 ≤ TN * N by positivity)
    calc
      _ ≤ N / (q₀ : ℝ) + (TN * N) / (q₀ : ℝ) :=
        add_le_add ((one_le_div hq₀R).mpr hq₀N)
          (div_le_div_of_nonneg_right hf hq₀R.le)
      _ = _ := by ring
  have hMNcost : x ^ (1 - ρ) ≤ M * N := by
    calc
      x ^ (1 - ρ) = x / x ^ ρ := by rw [Real.rpow_sub hxpos, Real.rpow_one]
      _ ≤ x / C := div_le_div_of_nonneg_left hxpos.le hCpos hCpower
      _ ≤ M * N := hMN
  have hNloCost : x ^ (1 / 2 - (2 * «ω» + c₀)) ≤ N := by
    rw [hNγ]
    apply Real.rpow_le_rpow_of_exponent_le hxone
    linarith
  have hNhiCost : N ≤ x ^ (1 / 2 : ℝ) := by
    rw [hNγ]
    exact Real.rpow_le_rpow_of_exponent_le hxone hγhi
  have hHcost : H ≤ x ^ ρ * R * Q ^ 2 / M := by
    rw [hH]
    apply div_le_div_of_nonneg_left (by positivity) hM
    exact le_mul_of_one_le_left hM.le hq₀one
  obtain ⟨_, _, _, hcollision, _, hIIcost⟩ := lower_order_normalized_cost_bounds
    x M N R Q H «ω» δ (2 * «ω» + c₀) c₀ ρ hxgt hM hN hR hQ hHpos.le hρ.le
    hMNcost hNloCost hNhiCost hNR hRN hRQ hHcost
  obtain ⟨hleadCost, hsecondaryCost⟩ := hIIcost (by
    simpa only [sub_add_eq_sub_sub] using hNloCost)
  have hlead : H ^ 2 * Q ^ 2 * Real.sqrt R / N ≤ x ^ (-2 * ρ) :=
    hleadCost.trans (Real.rpow_le_rpow_of_exponent_le hxone (by linarith))
  have hsecondary : H ^ 2 / R ≤ x ^ (-2 * ρ) :=
    hsecondaryCost.trans (Real.rpow_le_rpow_of_exponent_le hxone (by linarith))
  have hnormalized := sourceHighGamma_normalized_completion_envelope
    H N R Q (r : ℝ) (q₀ : ℝ) (x ^ (-2 * ρ)) hHpos.le hN hR hQ hRr hq₀one
      hlead hsecondary hcollision
  have hE0 : 0 ≤ E := by dsimp only [E]; positivity
  have hUfinal : U ^ 2 ≤
      (2600 * C₀ * (1 + TN) * L ^ 2) * Z ^ 2 * D ^ 6 * x ^ (-2 * ρ) := by
    clear_value U E
    apply hraw.trans
    calc
      C₀ * D ^ 4 * g ^ 2 * (1 + (⌊TN * N⌋₊ : ℝ) / (q₀ : ℝ)) * L ^ 2 * E ≤
          C₀ * D ^ 4 * g ^ 2 * ((1 + TN) * N / (q₀ : ℝ)) * L ^ 2 *
            (D ^ 2 * ((5 * H) ^ 2 * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) ^ 2 * B +
              A * (5 * H) * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) *
                (8 * H * Q ^ 2 / (q₀ : ℝ) ^ 2 + 2 * R))) := by
        gcongr
      _ = (C₀ * (1 + TN) * L ^ 2 * g ^ 2 * D ^ 6) *
          ((N / (q₀ : ℝ)) *
            ((5 * H) ^ 2 * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) ^ 2 * B +
              A * (5 * H) * (4 * Q ^ 2 / (q₀ : ℝ) ^ 2) *
                (8 * H * Q ^ 2 / (q₀ : ℝ) ^ 2 + 2 * R))) := by ring
      _ ≤ (C₀ * (1 + TN) * L ^ 2 * g ^ 2 * D ^ 6) *
          (2600 * (Q ^ 2 * N / (q₀ : ℝ) ^ 2) ^ 2 * (x ^ (-2 * ρ))) :=
        mul_le_mul_of_nonneg_left hnormalized (by positivity)
      _ = _ := by dsimp only [Z]; ring
  have hpower : D ^ 6 * x ^ (-2 * ρ) ≤ x ^ (-ρ) := by
    calc
      D ^ 6 * x ^ (-2 * ρ) = x ^ (6 * (ρ / 100) - 2 * ρ) := by
        dsimp only [D]
        rw [← Real.rpow_mul_natCast hxpos.le, ← Real.rpow_add hxpos]
        congr 1
        ring
      _ ≤ x ^ (-ρ) := Real.rpow_le_rpow_of_exponent_le hxone (by linarith only [hρ])
  have hKsq : K ^ 2 = 2600 * C₀ * (1 + TN) * L ^ 2 + 1 := by
    exact Real.sq_sqrt (by positivity)
  have hsq : U ^ 2 ≤ (K * Z * x ^ (-ρ / 2)) ^ 2 := by
    clear_value U
    calc
      U ^ 2 ≤ (2600 * C₀ * (1 + TN) * L ^ 2) * Z ^ 2 *
          (D ^ 6 * x ^ (-2 * ρ)) := by simpa only [mul_assoc] using hUfinal
      _ ≤ K ^ 2 * Z ^ 2 * x ^ (-ρ) := by
        gcongr
        · rw [hKsq]
          linarith
      _ = _ := by
        rw [mul_pow, mul_pow, ← Real.rpow_mul_natCast hxpos.le,
          show (-ρ / 2) * ((2 : ℕ) : ℝ) = -ρ by
            simpa only [Nat.cast_ofNat] using
              (div_mul_cancel₀ (-ρ) (by norm_num : (2 : ℝ) ≠ 0))]
  have hfinal : U ≤ K * Z * x ^ (-ρ / 2) :=
    (sq_le_sq₀ hU (by positivity)).mp hsq
  change U ≤ _
  apply hfinal.trans_eq
  dsimp only [Z, g]
  ring

open Classical in
theorem sourceLowerTypeII_uniform_band
    («ω» δ c₀ ρ C cM TM TN T A₀ A₁ LM : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hc₀ : 0 < c₀) (hρ : 0 < ρ)
    (hmargin : 68 * «ω» + 14 * δ + 100 * c₀ + 10000 * ρ < 1)
    (hC : 1 ≤ C) (hcM : 0 < cM) (hMT : cM ≤ TM)
    (hTN : 1 ≤ TN) (hT : 1 ≤ T) (hA₀ : 0 ≤ A₀) (hA₁ : 0 ≤ A₁) (hLM : 0 ≤ LM) :
    ∃ K X : ℝ, 0 < K ∧ 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ M N R Q H γ : ℝ,
        0 < M → 0 < N → 0 < R → 0 < Q →
        x / C ≤ M * N → N = x ^ γ →
        x ^ (-δ - 6 * ρ) * N ≤ R →
        R ≤ x ^ (-4 * ρ) * N →
        R * Q ≤ x ^ (1 / 2 + 2 * «ω» + ρ) →
        1 / 2 - 2 * «ω» - c₀ ≤ γ → γ ≤ 1 / 2 →
      ∀ q₀ a b₁ b₂ : ℕ,
        H = x ^ ρ * R * Q ^ 2 / ((q₀ : ℝ) * M) → 1 ≤ H →
      ∀ (𝒜 : Finset (ℕ × ℕ × ℕ × ℕ)) (J : Finset ℤ),
        (∀ t ∈ 𝒜,
          t.2.1 = 1 ∧ 0 < t.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
          Squarefree (t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2) ∧
          R ≤ (t.1 : ℝ) ∧ (t.1 : ℝ) ≤ 2 * R ∧
          Q ≤ (q₀ * t.2.2.1 : ℕ) ∧ (q₀ * t.2.2.1 : ℕ) ≤ 2 * Q ∧
          Q ≤ (q₀ * t.2.2.2 : ℕ) ∧ (q₀ * t.2.2.2 : ℕ) ≤ 2 * Q) →
        (∀ h ∈ J, h ≠ 0 ∧ |(h : ℝ)| ≤ 2 * H) →
        (∀ t ∈ 𝒜, Nat.Coprime a t.1) → Nat.Coprime b₁ q₀ →
      ∀ (ν : ℕ × ℕ → ℂ),
        (∀ t ∈ 𝒜,
          ‖ν (q₀ * t.2.1 * t.2.2.1, t.1)‖ ≤ 1 ∧
          ‖ν (q₀ * t.2.2.2, t.1)‖ ≤ 1) →
      ∀ (ℓ : ℤ) (t₀ : ℝ) (ψM ψN : ℝ → ℝ),
        Function.support ψM ⊆ Set.Icc cM TM → (∀ t : ℝ, |ψM t| ≤ LM) →
        ContDiff ℝ 1 ψN → Function.support ψN ⊆ Set.Icc (-T) T →
        (∀ t : ℝ, 0 ≤ ψN t) →
        (∀ t : ℝ, |ψN t| ≤ A₀ ∧ |deriv ψN t| ≤ A₁) →
      ∀ (β : ℕ →₀ ℂ), β.support ⊆ Finset.Icc 1 ⌊TN * N⌋₊ →
        (∀ n ∈ β.support, ‖β n‖ ≤ x ^ (ρ / 100)) →
        (∀ n ∈ β.support, 1 ≤ ψN (((n : ℝ) - t₀) / N)) →
      let βℤ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
      let P : (ℕ × ℕ × ℕ × ℕ) → ℕ := fun t =>
        t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2
      (∑ t ∈ 𝒜,
        ‖ν (q₀ * t.2.1 * t.2.2.1, t.1) * star (ν (q₀ * t.2.2.2, t.1)) *
          ((M : ℂ) / (P t : ℂ)) *
            ∑ n ∈ βℤ.support.filter (fun n =>
              Int.gcd n ((t.1 * q₀ * t.2.1 * t.2.2.1 : ℕ) : ℤ) = 1 ∧
              Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2.2 : ℕ) : ℤ) = 1),
              βℤ n * star (βℤ (n + ℓ * (t.1 : ℤ))) *
                (sourceCompatibility t.1 q₀ b₁ b₂ ℓ n : ℂ) *
                  ∑ h ∈ J, sourcePhi ψM M (P t) h *
                    sourceTheta t.1 q₀ t.2.1 t.2.2.1 t.2.2.2 a b₁ b₂ ℓ n h‖) ≤
        K * M * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) / (q₀ : ℝ) * x ^ (-ρ / 2) := by
  have hTM : 0 < TM := hcM.trans_le hMT
  have hPhiBound : 0 ≤ TM * LM := mul_nonneg hTM.le hLM
  obtain ⟨K, X, hK, hX, hnear⟩ := sourceTheta_lower_typeII_uniform_power_saving
    «ω» δ c₀ ρ C T TN A₀ A₁ (TM * LM) hω hδ hc₀ hρ hmargin hC hT hTN hA₀ hA₁ hPhiBound
  refine ⟨2 * K, X, mul_pos (by norm_num) hK, hX, ?_⟩
  intro x hx M N R Q H γ hM hN hR hQ hMN hNγ hNR hRN hRQ hγlo hγhi
    q₀ a b₁ b₂ hH hHone 𝒜 J h𝒜 hJ ha hb₁ ν hν ℓ t₀ ψM ψN hψMs hψMb
    hψN hψNs hψN0 hψNb β hβs hβ hψmajor βℤ P
  have hxone : 1 ≤ x := hX.trans hx
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  by_cases h𝒜empty : 𝒜 = ∅
  · simp only [h𝒜empty, Finset.sum_empty]
    positivity
  obtain ⟨t₀', ht₀'⟩ := Finset.nonempty_iff_ne_empty.mpr h𝒜empty
  have hsf := (h𝒜 t₀' ht₀').2.2.2.2.1
  have hq₀ : 0 < q₀ :=
    Nat.pos_of_ne_zero hsf.of_mul_left.of_mul_left.of_mul_left.of_mul_right.ne_zero
  have hqpos : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀
  have hPhi (d : ℕ) (h : ℤ) : ‖sourcePhi ψM M d h‖ ≤ TM * LM := by
    have hb := sourcePhiRealFactor_sampling_and_norm cM TM M LM hcM hMT hM hLM
      ψM hψMs hψMb d h
    have heq := hb.2.1 1
    simp only [Nat.cast_one, Nat.one_mul] at heq
    simpa only [heq] using hb.2.2 (1 : ℝ)
  let Rs : Finset ℕ := 𝒜.image Prod.fst
  let F : ℕ → Finset (ℕ × ℕ) := fun r =>
    (𝒜.filter (fun t => t.1 = r)).image (fun t => t.2.2)
  let w : ℕ → (ℕ × ℕ) → ℝ := fun r q =>
    ‖∑ n ∈ βℤ.support, βℤ n * star (βℤ (n + ℓ * (r : ℤ))) *
      (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
        ∑ h ∈ J, sourcePhi ψM M (r * q₀ * q.1 * q.2) h *
          sourceTheta r q₀ 1 q.1 q.2 a b₁ b₂ ℓ n h‖
  have hw (r : ℕ) (q : ℕ × ℕ) : 0 ≤ w r q := norm_nonneg _
  have hF (r : ℕ) (q : ℕ × ℕ) (hq : q ∈ F r) :
      Squarefree (r * q₀ * q.1 * q.2) ∧
        Q ≤ (q₀ * q.1 : ℕ) ∧ (q₀ * q.1 : ℕ) ≤ 2 * Q ∧
        Q ≤ (q₀ * q.2 : ℕ) ∧ (q₀ * q.2 : ℕ) ≤ 2 * Q := by
    obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hq
    obtain ⟨htA, htr⟩ := Finset.mem_filter.mp ht
    obtain ⟨hu, _, _, _, hsf, _, _, hq₁lo, hq₁hi, hq₂lo, hq₂hi⟩ := h𝒜 t htA
    refine ⟨?_, hq₁lo, hq₁hi, hq₂lo, hq₂hi⟩
    simpa only [hu, Nat.mul_one, htr] using hsf
  have hrow (t : ℕ × ℕ × ℕ × ℕ) (ht : t ∈ 𝒜) := by
    obtain ⟨hu, hr, hv, hq₂, _, hRr, _, hQ₁, _, hQ₂, _⟩ := h𝒜 t ht
    have hraw := sourceHighGamma_weighted_row_norm t.1 q₀ t.2.1 t.2.2.1 t.2.2.2
      a b₁ b₂ ℓ M R Q hM hR hQ hr hq₀ (by omega) hv hq₂ hRr
      (by simpa only [hu, Nat.mul_one] using hQ₁) hQ₂
      (ν (q₀ * t.2.1 * t.2.2.1, t.1)) (ν (q₀ * t.2.2.2, t.1))
      (hν t ht).1 (hν t ht).2 βℤ.support J βℤ (fun h => sourcePhi ψM M (P t) h)
    dsimp only at hraw
    conv_rhs at hraw => simp only [P, hu, Nat.mul_one]
    exact hraw
  have hlocal (r : ℕ) (hr : r ∈ Rs) :
      (∑ q ∈ F r, w r q) ≤
        K * Q ^ 2 * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) / (q₀ : ℝ) ^ 2 * x ^ (-ρ / 2) := by
    obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hr
    obtain ⟨_, _, _, _, _, hRr, hrR, _, _, _, _⟩ := h𝒜 t ht
    exact hnear x hx M N R Q H γ hM hN hR hQ hMN hNγ hNR hRN hRQ hγlo hγhi
      t.1 q₀ a b₁ b₂ hRr hrR hH hHone (F t.1) J (hF t.1) hJ (ha t ht) hb₁
      ℓ t₀ ψN hψN hψNs hψN0 hψNb β hβs hβ hψmajor
      (fun q h => sourcePhi ψM M (t.1 * q₀ * q.1 * q.2) h)
      (fun _ _ h _ => hPhi _ h)
  have hsumr (r : ℕ) :
      (∑ t ∈ 𝒜.filter (fun t => t.1 = r), w t.1 t.2.2) = ∑ q ∈ F r, w r q := by
    have hinj : Set.InjOn (fun t : ℕ × ℕ × ℕ × ℕ => t.2.2)
        (𝒜.filter (fun t => t.1 = r) : Set _) := by
      intro t ht s hs heq
      obtain ⟨htA, htr⟩ := Finset.mem_filter.mp ht
      obtain ⟨hsA, hsr⟩ := Finset.mem_filter.mp hs
      exact Prod.ext (htr.trans hsr.symm)
        (Prod.ext ((h𝒜 t htA).1.trans (h𝒜 s hsA).1.symm) heq)
    calc
      _ = ∑ t ∈ 𝒜.filter (fun t => t.1 = r), w r t.2.2 := by
        apply Finset.sum_congr rfl
        intro t ht
        rw [(Finset.mem_filter.mp ht).2]
      _ = _ := (Finset.sum_image hinj).symm
  have hRcard : (Rs.card : ℝ) ≤ 2 * R := by
    have hsub : Rs ⊆ Finset.Icc 1 ⌊2 * R⌋₊ := by
      intro r hr
      obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hr
      obtain ⟨_, hr, _, _, _, _, hrR, _, _, _, _⟩ := h𝒜 t ht
      exact Finset.mem_Icc.mpr ⟨hr, (Nat.le_floor_iff (by positivity)).mpr hrR⟩
    have hh : Rs.card ≤ ⌊2 * R⌋₊ := by
      simpa only [Nat.card_Icc, Nat.add_sub_cancel] using Finset.card_le_card hsub
    exact (Nat.cast_le.mpr hh).trans (Nat.floor_le (by positivity))
  have hfamily : (∑ t ∈ 𝒜, w t.1 t.2.2) ≤
      (2 * R) * (K * Q ^ 2 * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) /
        (q₀ : ℝ) ^ 2 * x ^ (-ρ / 2)) := by
    calc
      _ = ∑ r ∈ Rs, ∑ t ∈ 𝒜.filter (fun t => t.1 = r), w t.1 t.2.2 :=
        (Finset.sum_fiberwise_of_maps_to (s := 𝒜) (t := Rs) (g := Prod.fst)
          (fun t ht => Finset.mem_image_of_mem Prod.fst ht) _).symm
      _ = ∑ r ∈ Rs, ∑ q ∈ F r, w r q := Finset.sum_congr rfl (fun r _ => hsumr r)
      _ ≤ ∑ _r ∈ Rs,
          K * Q ^ 2 * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) / (q₀ : ℝ) ^ 2 * x ^ (-ρ / 2) :=
        Finset.sum_le_sum hlocal
      _ = (Rs.card : ℝ) *
          (K * Q ^ 2 * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) / (q₀ : ℝ) ^ 2 * x ^ (-ρ / 2)) := by
        rw [Finset.sum_const, nsmul_eq_mul]
      _ ≤ _ := mul_le_mul_of_nonneg_right hRcard (by positivity)
  calc
    _ ≤ ∑ t ∈ 𝒜, (M * (q₀ : ℝ) / (R * Q ^ 2)) * w t.1 t.2.2 := Finset.sum_le_sum hrow
    _ = (M * (q₀ : ℝ) / (R * Q ^ 2)) * ∑ t ∈ 𝒜, w t.1 t.2.2 := (Finset.mul_sum ..).symm
    _ ≤ (M * (q₀ : ℝ) / (R * Q ^ 2)) *
        ((2 * R) * (K * Q ^ 2 * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) /
          (q₀ : ℝ) ^ 2 * x ^ (-ρ / 2))) :=
      mul_le_mul_of_nonneg_left hfamily (by positivity)
    _ = _ := by field_simp [hR.ne', hQ.ne', hqpos.ne']

open Classical in
theorem sourceTheta_lowerTwo_uniform_power_saving
    («ω» δ σ ε C T TN A₀ A₁ L : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hσ : 0 < σ) (hε : 0 < ε)
    (hworking : 56 * «ω» + 16 * δ + 4 * σ + 10000 * ε < 1)
    (hC : 1 ≤ C) (hT : 1 ≤ T) (hTN : 1 ≤ TN)
    (hA₀ : 0 ≤ A₀) (hA₁ : 0 ≤ A₁) (hL : 0 ≤ L) :
    ∃ K X : ℝ, 0 < K ∧ 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ M N R Q H V γ : ℝ,
        0 < M → 0 < N → 0 < R → 0 < Q → 0 < V →
        x / C ≤ M * N → N = x ^ γ →
        N ≤ C * x ^ (δ + 4 * ε) * R →
        R ≤ C * x ^ (-2 * ε) * N →
        R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) →
        1 / 2 - σ ≤ γ → γ ≤ 1 / 2 →
      ∀ r q₀ u q₂ a b₁ b₂ : ℕ,
        R ≤ (r : ℝ) → (r : ℝ) ≤ 2 * R →
        H = x ^ ε * R * Q ^ 2 / ((q₀ : ℝ) * M) → 1 ≤ H →
        (u : ℝ) * V ≤ C * Q / (q₀ : ℝ) →
        (q₀ : ℝ) * (q₂ : ℝ) ≤ C * Q →
        x ^ (5 * ε) * H / (q₀ : ℝ) ≤ C * V →
        V ≤ C * x ^ (δ + 5 * ε) * H →
      ∀ (F : Finset ℕ) (J : Finset ℤ),
        (∀ v ∈ F, 0 < v ∧ (v : ℝ) ≤ C * V ∧ Squarefree (r * q₀ * (u * v) * q₂)) →
        (∀ h ∈ J, h ≠ 0 ∧ |(h : ℝ)| ≤ 2 * H) →
        Nat.Coprime a r → Nat.Coprime b₁ q₀ →
      ∀ (ℓ : ℤ) (t₀ : ℝ) (Y : Set.Ici (1 : ℝ)), (Y : ℝ) ≤ x ^ δ →
        (∀ v ∈ F,
          Nonempty (DenseDivisibilityWitness
            Y 1 (r * q₀ * (u * v))) ∧
          Nonempty (DenseDivisibilityWitness
            Y 1 (r * q₀ * q₂))) →
      ∀ (ψ : ℝ → ℝ), ContDiff ℝ 1 ψ → Function.support ψ ⊆ Set.Icc (-T) T →
        (∀ t : ℝ, 0 ≤ ψ t) →
        (∀ t : ℝ, |ψ t| ≤ A₀ ∧ |deriv ψ t| ≤ A₁) →
      ∀ (β : ℕ →₀ ℂ), β.support ⊆ Finset.Icc 1 ⌊TN * N⌋₊ →
        (∀ n ∈ β.support, ‖β n‖ ≤ x ^ (ε / 100)) →
        (∀ n ∈ β.support, 1 ≤ ψ (((n : ℝ) - t₀) / N)) →
      ∀ (c : ℕ → ℤ → ℂ), (∀ v ∈ F, ∀ h ∈ J, ‖c v h‖ ≤ L) →
      let βℤ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
      (∑ v ∈ F, ‖∑ n ∈ βℤ.support,
        βℤ n * star (βℤ (n + ℓ * (r : ℤ))) *
          (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
          ∑ h ∈ J, c v h * sourceTheta r q₀ 1 (u * v) q₂ a b₁ b₂ ℓ n h‖) ≤
        K * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * N * V * x ^ (-2 * ε) := by
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hTNpos : 0 < TN := zero_lt_one.trans_le hTN
  have hεsmall : ε ≤ 1 / 100 := by
    linarith only [hworking, hω, hδ, hσ]
  have hδsmall : δ + 4 * ε ≤ 1 / 12 := by
    linarith only [hworking, hω, hσ, hε]
  have hδ₅ : δ + 5 * ε ≤ 1 / 10 := by
    linarith only [hworking, hω, hσ, hε]
  have hRQexponent : 1 / 2 + 2 * «ω» + ε ≤ 7 / 12 := by
    linarith only [hworking, hδ, hσ, hε]
  obtain ⟨C₀, X₀, hC₀, hX₀, hraw⟩ := sourceTheta_split_fiber_dense_cauchy_bound
    T A₀ A₁ 10 (ε / 100) hT hA₀ hA₁ (by norm_num) (by positivity)
  obtain ⟨Xc, hXc⟩ := Filter.eventually_atTop.mp
    ((tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 100)).eventually_ge_atTop (100 * C))
  let K := Real.sqrt (65 * C₀ * (1 + TN) * L ^ 2 * C ^ 15 + 1)
  have hK : 0 < K := by dsimp only [K]; positivity
  refine ⟨K, max 1 (max X₀ Xc), hK, le_max_left _ _, ?_⟩
  intro x hx M N R Q H V γ hM hN hR hQ hV hMN hNγ hNR hRN hRQ hγlo hγhi
    r q₀ u q₂ a b₁ b₂ hRr hrR hH hHone huV hq₂Q hVlower hVupper F J hF hJ
    ha hb₁ ℓ t₀ Y hYx hY ψ hψ hψs hψ0 hψb β hβs hβ hψmajor c hc βℤ
  have hxone : 1 ≤ x := (le_max_left _ _).trans hx
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  have hx₀ : X₀ ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans hx)
  have hxc : Xc ≤ x := (le_max_right _ _).trans ((le_max_right _ _).trans hx)
  have hxlarge : 100 * C ≤ x ^ (1 / 100 : ℝ) := hXc x hxc
  by_cases hFempty : F = ∅
  · simp only [hFempty, Finset.sum_empty]
    positivity
  obtain ⟨v₀, hv₀⟩ := Finset.nonempty_iff_ne_empty.mpr hFempty
  have hsf := (hF v₀ hv₀).2.2
  have hq₀ : 0 < q₀ := Nat.pos_of_ne_zero hsf.of_mul_left.of_mul_left.of_mul_right.ne_zero
  have hu : 0 < u := Nat.pos_of_ne_zero hsf.of_mul_left.of_mul_right.of_mul_left.ne_zero
  have hq₂ : 0 < q₂ := Nat.pos_of_ne_zero hsf.of_mul_right.ne_zero
  have hqpos : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀
  have hqone : 1 ≤ (q₀ : ℝ) := by exact_mod_cast hq₀
  have hrpos : 0 < (r : ℝ) := hR.trans_le hRr
  have hrnat : 0 < r := by exact_mod_cast hrpos
  have hHpos : 0 < H := zero_lt_one.trans_le hHone
  have hγcritical : 1 / 4 + 14 * «ω» + 4 * δ + 100 * ε ≤ γ := by
    linarith only [hworking, hγlo, hε]
  have hγlower : 1 / 4 ≤ γ := by linarith only [hγcritical, hω, hδ, hε]
  let HN : ℕ := ⌊2 * H⌋₊
  let KN : ℕ := ⌊C * V⌋₊
  let P₀ : ℝ := (r : ℝ) * (q₀ : ℝ) * (u : ℝ) * (KN : ℝ) ^ 2 * (q₂ : ℝ)
  obtain ⟨hqN, hNr, hrx, hHKx, hPx, hPupper, hHK⟩ :=
    sourceHighGamma_split_geometry «ω» δ ε C x M N R Q H V γ r q₀ u q₂ hω.le hδ.le
      hC hxone hxlarge hε hεsmall hδsmall hδ₅ hRQexponent hM hN hR hQ hV hq₀ hu hq₂
      hMN hNγ hNR hRN hRQ hγcritical hγlower hγhi hRr hrR hH hHone huV hq₂Q hVupper
  have hHN : (HN : ℝ) ≤ 2 * H := Nat.floor_le (by positivity)
  have hKN : (KN : ℝ) ≤ C * V := Nat.floor_le (by positivity)
  have hFnat (v : ℕ) (hv : v ∈ F) : 0 < v ∧ v ≤ KN ∧ Squarefree (r * q₀ * (u * v) * q₂) :=
    ⟨(hF v hv).1, (Nat.le_floor_iff (by positivity)).mpr (hF v hv).2.1, (hF v hv).2.2⟩
  have hKNpos : 0 < KN := (hFnat v₀ hv₀).1.trans_le (hFnat v₀ hv₀).2.1
  have hPpos : 0 < P₀ := by dsimp only [P₀]; positivity
  have hJnat (h : ℤ) (hh : h ∈ J) : h ≠ 0 ∧ -(HN : ℤ) ≤ h ∧ h ≤ (HN : ℤ) := by
    have hreal : (h.natAbs : ℝ) ≤ 2 * H := by
      rw [Nat.cast_natAbs, Int.cast_abs]
      exact (hJ h hh).2
    have habs : h.natAbs ≤ HN := (Nat.le_floor_iff (by positivity)).mpr hreal
    exact ⟨(hJ h hh).1, by omega, by omega⟩
  have hFcard : (F.card : ℝ) ≤ C * V := by
    have hsub : F ⊆ Finset.Icc 1 KN := fun v hv =>
      Finset.mem_Icc.mpr ⟨(hFnat v hv).1, (hFnat v hv).2.1⟩
    have hh : F.card ≤ KN := by
      simpa only [Nat.card_Icc, Nat.add_sub_cancel] using Finset.card_le_card hsub
    exact (Nat.cast_le.mpr hh).trans hKN
  have hJcard : (J.card : ℝ) ≤ 5 * H := by
    have hsub : J ⊆ Finset.Icc (-(HN : ℤ)) (HN : ℤ) :=
      fun h hh => Finset.mem_Icc.mpr (hJnat h hh).2
    have hcard := Int.card_Icc_of_le (a := -(HN : ℤ)) (b := (HN : ℤ)) (by omega)
    have hcardR : ((Finset.Icc (-(HN : ℤ)) (HN : ℤ)).card : ℝ) =
        (HN : ℝ) + 1 - (-(HN : ℝ)) := by exact_mod_cast hcard
    have hh : (J.card : ℝ) ≤ ((Finset.Icc (-(HN : ℤ)) (HN : ℤ)).card : ℝ) := by
      exact_mod_cast Finset.card_le_card hsub
    linarith only [hh, hcardR, hHN, hHone]
  let D : ℝ := x ^ (ε / 100)
  have hDpos : 0 < D := Real.rpow_pos_of_pos hxpos _
  have hDone : 1 ≤ D := Real.one_le_rpow hxone (by positivity)
  let A : ℝ := Real.sqrt (N / (q₀ : ℝ)) * (P₀ * (Y : ℝ)) ^ (1 / 6 : ℝ)
  let B : ℝ := N / (q₀ : ℝ) / (r : ℝ)
  have hYpos : 0 < (Y : ℝ) := zero_lt_one.trans_le Y.property
  have hA0 : 0 ≤ A := by dsimp only [A]; positivity
  have hB0 : 0 ≤ B := by dsimp only [B]; positivity
  have hS0 : 0 ≤ (J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * A +
      B * (D * (J.card : ℝ) * (F.card : ℝ) * ((HN : ℝ) * (KN : ℝ) + (r : ℝ))) :=
    add_nonneg (mul_nonneg (mul_nonneg (sq_nonneg _) (sq_nonneg _)) hA0)
      (mul_nonneg hB0 (mul_nonneg
        (mul_nonneg (mul_nonneg hDpos.le (Nat.cast_nonneg _)) (Nat.cast_nonneg _))
        (add_nonneg (mul_nonneg (Nat.cast_nonneg _) (Nat.cast_nonneg _)) (Nat.cast_nonneg _))))
  let U : ℝ := ∑ v ∈ F, ‖∑ n ∈ βℤ.support,
    βℤ n * star (βℤ (n + ℓ * (r : ℤ))) *
      (sourceCompatibility r q₀ b₁ b₂ ℓ n : ℂ) *
      ∑ h ∈ J, c v h * sourceTheta r q₀ 1 (u * v) q₂ a b₁ b₂ ℓ n h‖
  let g : ℝ := (Int.gcd (q₀ : ℤ) ℓ : ℝ)
  have hU : 0 ≤ U := by dsimp only [U]; positivity
  have hg : 0 ≤ g := Nat.cast_nonneg _
  have hbound := hraw x hx₀ r q₀ u q₂ a b₁ b₂ ⌊TN * N⌋₊ HN KN
    hrnat hq₀ hu hq₂ hrx hHKx hPx F J hFnat hJnat ha hb₁
    ℓ N t₀ D L hqN hNr hDpos.le hL Y hY ψ hψ hψs hψ0 hψb β hβs hβ hψmajor c hc
  clear hraw
  change U ^ 2 ≤ C₀ * D ^ 4 * g ^ 2 * (1 + (⌊TN * N⌋₊ : ℝ) / (q₀ : ℝ)) * L ^ 2 * D *
    ((J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * A +
      B * (D * (J.card : ℝ) * (F.card : ℝ) * ((HN : ℝ) * (KN : ℝ) + (r : ℝ)))) at hbound
  have hmass : 1 + (⌊TN * N⌋₊ : ℝ) / (q₀ : ℝ) ≤ (1 + TN) * N / (q₀ : ℝ) := by
    have hf := Nat.floor_le (show 0 ≤ TN * N by positivity)
    calc
      _ ≤ N / (q₀ : ℝ) + (TN * N) / (q₀ : ℝ) :=
        add_le_add ((one_le_div hqpos).mpr hqN) (div_le_div_of_nonneg_right hf hqpos.le)
      _ = _ := by ring
  have hparts : (J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * A ≤ (5 * H) ^ 2 * (C * V) ^ 2 * A :=
    mul_le_mul_of_nonneg_right
      (mul_le_mul (pow_le_pow_left₀ (Nat.cast_nonneg _) hJcard 2)
        (pow_le_pow_left₀ (Nat.cast_nonneg _) hFcard 2) (sq_nonneg _) (sq_nonneg _)) hA0
  have hmean : (J.card : ℝ) * (F.card : ℝ) * ((HN : ℝ) * (KN : ℝ) + (r : ℝ)) ≤
      (5 * H) * (C * V) * (2 * C * H * V + (r : ℝ)) := by gcongr
  have hbracket : (J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * A +
      B * (D * (J.card : ℝ) * (F.card : ℝ) * ((HN : ℝ) * (KN : ℝ) + (r : ℝ))) ≤
      D * ((5 * H) ^ 2 * (C * V) ^ 2 * A + B * (5 * H) * (C * V) *
        (2 * C * H * V + (r : ℝ))) := by
    have hfirst : (J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * A ≤
        D * ((5 * H) ^ 2 * (C * V) ^ 2 * A) :=
      hparts.trans (le_mul_of_one_le_left (by positivity) hDone)
    have hsecond := mul_le_mul_of_nonneg_left
      (mul_le_mul_of_nonneg_left hmean hDpos.le) hB0
    nlinarith only [hfirst, hsecond]
  have hscale := sourceLowerTwo_scale_envelopes «ω» δ ε C x M N R Q H
    (q₀ : ℝ) γ V hω hδ hε hC hxone hM hN hR hQ hqone hV
      hMN hNγ hNR hRQ hH hγcritical hVlower
  have hnormalized := sourceHighGamma_split_normalized_envelope
    δ ε C x H N R Q V (r : ℝ) (q₀ : ℝ) P₀ (Y : ℝ) (C ^ 12 * x ^ (-5 * ε))
      hC hxone hHpos hN hR hQ hV hRr hqone hPpos
      (zero_lt_one.trans_le Y.property) hYx hPupper hVupper hscale.1 hscale.2.1 hscale.2.2
  change U ≤ K * g * N * V * x ^ (-2 * ε)
  exact sourceHighGamma_split_energy_finish C₀ C TN L x ε N V (q₀ : ℝ) U g
    (1 + (⌊TN * N⌋₊ : ℝ) / (q₀ : ℝ))
    ((J.card : ℝ) ^ 2 * (F.card : ℝ) ^ 2 * A +
      B * (D * (J.card : ℝ) * (F.card : ℝ) * ((HN : ℝ) * (KN : ℝ) + (r : ℝ))))
    ((5 * H) ^ 2 * (C * V) ^ 2 * A + B * (5 * H) * (C * V) *
      (2 * C * H * V + (r : ℝ)))
    hC₀ hC hTN hxone hε hN hV hqpos hU hg hS0
    hbound hmass hbracket hnormalized

open Classical in
theorem sourceLowerTwo_uniform_band
    («ω» δ σ ε C cM TM TN T A₀ A₁ LM : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hσ : 0 < σ) (hε : 0 < ε)
    (hworking : 56 * «ω» + 16 * δ + 4 * σ + 10000 * ε < 1)
    (hC : 1 ≤ C) (hcM : 0 < cM) (hMT : cM ≤ TM)
    (hTN : 1 ≤ TN) (hT : 1 ≤ T) (hA₀ : 0 ≤ A₀) (hA₁ : 0 ≤ A₁) (hLM : 0 ≤ LM) :
    ∃ K X : ℝ, 0 < K ∧ 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ M N R Q H U V γ : ℝ,
        0 < M → 0 < N → 0 < R → 0 < Q → 0 < U → 0 < V →
        x / C ≤ M * N → N = x ^ γ →
        N ≤ C * x ^ (δ + 4 * ε) * R →
        R ≤ C * x ^ (-2 * ε) * N →
        R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) →
        1 / 2 - σ ≤ γ → γ ≤ 1 / 2 →
      ∀ q₀ a b₁ b₂ : ℕ, 0 < q₀ →
        H = x ^ ε * R * Q ^ 2 / ((q₀ : ℝ) * M) → 1 ≤ H →
        U * V ≤ C * Q / (q₀ : ℝ) →
        x ^ (5 * ε) * H / (q₀ : ℝ) ≤ C * V →
        V ≤ C * x ^ (δ + 5 * ε) * H →
      ∀ (Y : Set.Ici (1 : ℝ)), (Y : ℝ) ≤ x ^ δ →
      ∀ (𝒜 : Finset (ℕ × ℕ × ℕ × ℕ)) (J : Finset ℤ),
        (∀ t ∈ 𝒜,
          0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
          Squarefree (t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2) ∧
          R ≤ (t.1 : ℝ) ∧ (t.1 : ℝ) ≤ 2 * R ∧
          (t.2.1 : ℝ) ≤ C * U ∧ (t.2.2.1 : ℝ) ≤ C * V ∧
          Q ≤ (q₀ * t.2.1 * t.2.2.1 : ℕ) ∧
          Q ≤ (q₀ * t.2.2.2 : ℕ) ∧ (q₀ * t.2.2.2 : ℕ) ≤ C * Q) →
        (∀ t ∈ 𝒜,
          Nonempty (DenseDivisibilityWitness
            Y 1 (t.1 * q₀ * t.2.1 * t.2.2.1)) ∧
          Nonempty (DenseDivisibilityWitness
            Y 1 (t.1 * q₀ * t.2.2.2))) →
        (∀ h ∈ J, h ≠ 0 ∧ |(h : ℝ)| ≤ 2 * H) →
        (∀ t ∈ 𝒜, Nat.Coprime a t.1) → Nat.Coprime b₁ q₀ →
      ∀ (ν : ℕ × ℕ → ℂ),
        (∀ t ∈ 𝒜,
          ‖ν (q₀ * t.2.1 * t.2.2.1, t.1)‖ ≤ 1 ∧
          ‖ν (q₀ * t.2.2.2, t.1)‖ ≤ 1) →
      ∀ (ℓ : ℤ) (t₀ : ℝ) (ψM ψN : ℝ → ℝ),
        Function.support ψM ⊆ Set.Icc cM TM → (∀ t : ℝ, |ψM t| ≤ LM) →
        ContDiff ℝ 1 ψN → Function.support ψN ⊆ Set.Icc (-T) T →
        (∀ t : ℝ, 0 ≤ ψN t) →
        (∀ t : ℝ, |ψN t| ≤ A₀ ∧ |deriv ψN t| ≤ A₁) →
      ∀ (β : ℕ →₀ ℂ), β.support ⊆ Finset.Icc 1 ⌊TN * N⌋₊ →
        (∀ n ∈ β.support, ‖β n‖ ≤ x ^ (ε / 100)) →
        (∀ n ∈ β.support, 1 ≤ ψN (((n : ℝ) - t₀) / N)) →
      let βℤ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
      let P : (ℕ × ℕ × ℕ × ℕ) → ℕ := fun t =>
        t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2
      (∑ t ∈ 𝒜,
        ‖ν (q₀ * t.2.1 * t.2.2.1, t.1) * star (ν (q₀ * t.2.2.2, t.1)) *
          ((M : ℂ) / (P t : ℂ)) *
            ∑ n ∈ βℤ.support.filter (fun n =>
              Int.gcd n ((t.1 * q₀ * t.2.1 * t.2.2.1 : ℕ) : ℤ) = 1 ∧
              Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2.2 : ℕ) : ℤ) = 1),
              βℤ n * star (βℤ (n + ℓ * (t.1 : ℤ))) *
                (sourceCompatibility t.1 q₀ b₁ b₂ ℓ n : ℂ) *
                  ∑ h ∈ J, sourcePhi ψM M (P t) h *
                    sourceTheta t.1 q₀ t.2.1 t.2.2.1 t.2.2.2 a b₁ b₂ ℓ n h‖) ≤
        K * M * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) / (q₀ : ℝ) * x ^ (-ε / 4) := by
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hTM : 0 < TM := hcM.trans_le hMT
  let D : ℝ := 4 * C ^ 2
  have hCD : C ≤ D := by dsimp only [D]; nlinarith only [hC, sq_nonneg (C - 1)]
  have hC₂D : C ^ 2 ≤ D := by dsimp only [D]; nlinarith only [sq_nonneg C]
  have hD : 1 ≤ D := hC.trans hCD
  have hDpos : 0 < D := zero_lt_one.trans_le hD
  obtain ⟨K, X, hK, hX, hsplit⟩ := sourceTheta_lowerTwo_uniform_power_saving
    «ω» δ σ ε D T TN A₀ A₁ (TM * LM) hω hδ hσ hε hworking hD hT hTN
      hA₀ hA₁ (mul_nonneg hTM.le hLM)
  refine ⟨2 * C ^ 3 * K, X, by positivity, hX, ?_⟩
  intro x hx M N R Q H U V γ hM hN hR hQ hU hV hMN hNγ hNR hRN hRQ hγlo hγhi
    q₀ a b₁ b₂ hq₀ hH hHone hUV hVlo hVhi Y hYx 𝒜 J h𝒜 h𝒜Y hJ ha hb₁
    ν hν ℓ t₀ ψM ψN hψMs hψMb hψN hψNs hψN0 hψNb β hβs hβ hψmajor βℤ P
  have hxone : 1 ≤ x := hX.trans hx
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  have hqpos : 0 < (q₀ : ℝ) := by exact_mod_cast hq₀
  have hMN' : x / D ≤ M * N :=
    (div_le_div_of_nonneg_left hxpos.le hCpos hCD).trans hMN
  have hNR' : N ≤ D * x ^ (δ + 4 * ε) * R := hNR.trans
    (mul_le_mul_of_nonneg_right
      (mul_le_mul_of_nonneg_right hCD (Real.rpow_nonneg hxpos.le _)) hR.le)
  have hRN' : R ≤ D * x ^ (-2 * ε) * N := hRN.trans
    (mul_le_mul_of_nonneg_right
      (mul_le_mul_of_nonneg_right hCD (Real.rpow_nonneg hxpos.le _)) hN.le)
  have hRQ' : R * Q ≤ D * x ^ (1 / 2 + 2 * «ω» + ε) := hRQ.trans
    (mul_le_mul_of_nonneg_right hCD (Real.rpow_nonneg hxpos.le _))
  have hVlo' : x ^ (5 * ε) * H / (q₀ : ℝ) ≤ D * V :=
    hVlo.trans (mul_le_mul_of_nonneg_right hCD hV.le)
  have hVhi' : V ≤ D * x ^ (δ + 5 * ε) * H := hVhi.trans
    (mul_le_mul_of_nonneg_right
      (mul_le_mul_of_nonneg_right hCD (Real.rpow_nonneg hxpos.le _))
      (zero_le_one.trans hHone))
  have hPhi (d : ℕ) (h : ℤ) : ‖sourcePhi ψM M d h‖ ≤ TM * LM := by
    have hh := sourcePhiRealFactor_sampling_and_norm cM TM M LM hcM hMT hM hLM
      ψM hψMs hψMb d h
    have heq := hh.2.1 1
    simp only [Nat.cast_one, Nat.one_mul] at heq
    simpa only [heq] using hh.2.2 (1 : ℝ)
  let π : (ℕ × ℕ × ℕ × ℕ) → ℕ × ℕ × ℕ := fun t => (t.1, t.2.1, t.2.2.2)
  let I : Finset (ℕ × ℕ × ℕ) := 𝒜.image π
  let F : (ℕ × ℕ × ℕ) → Finset ℕ := fun i =>
    (𝒜.filter (fun t => π t = i)).image (fun t => t.2.2.1)
  let w : (ℕ × ℕ × ℕ) → ℕ → ℝ := fun i v =>
    ‖∑ n ∈ βℤ.support, βℤ n * star (βℤ (n + ℓ * (i.1 : ℤ))) *
      (sourceCompatibility i.1 q₀ b₁ b₂ ℓ n : ℂ) *
        ∑ h ∈ J, sourcePhi ψM M (i.1 * q₀ * (i.2.1 * v) * i.2.2) h *
          sourceTheta i.1 q₀ 1 (i.2.1 * v) i.2.2 a b₁ b₂ ℓ n h‖
  have hFmem (i : ℕ × ℕ × ℕ) (v : ℕ) (hv : v ∈ F i) :
      (i.1, i.2.1, v, i.2.2) ∈ 𝒜 := by
    obtain ⟨t, ht, htv⟩ := Finset.mem_image.mp hv
    obtain ⟨htA, hti⟩ := Finset.mem_filter.mp ht
    have hfirst : t.1 = i.1 := congrArg (fun p : ℕ × ℕ × ℕ => p.1) hti
    have hsecond : t.2.1 = i.2.1 := congrArg (fun p : ℕ × ℕ × ℕ => p.2.1) hti
    have hfourth : t.2.2.2 = i.2.2 := by
      simpa only [π] using congrArg (fun p : ℕ × ℕ × ℕ => p.2.2) hti
    have heq : t = (i.1, i.2.1, v, i.2.2) :=
      Prod.ext hfirst (Prod.ext hsecond (Prod.ext htv hfourth))
    exact heq ▸ htA
  have hTheta (r u v q₂ : ℕ) (n h : ℤ) :
      sourceTheta r q₀ u v q₂ a b₁ b₂ ℓ n h =
        sourceTheta r q₀ 1 (u * v) q₂ a b₁ b₂ ℓ n h := by
    let θ : ℕ → ℂ := fun z =>
      if hp : r ≠ 0 ∧ z ≠ 0 ∧ q₂ ≠ 0 then
        let _ : NeZero r := ⟨hp.1⟩
        let _ : NeZero z := ⟨hp.2.1⟩
        let _ : NeZero q₂ := ⟨hp.2.2⟩
        reciprocalUnitPhase r ((a : ZMod r) * (h : ZMod r))
          ((n : ZMod r) * ((z * q₂ : ℕ) : ZMod r)) *
        reciprocalUnitPhase z ((b₁ : ZMod z) * (h : ZMod z))
          ((n : ZMod z) * ((r * q₂ : ℕ) : ZMod z)) *
        reciprocalUnitPhase q₂ ((b₂ : ZMod q₂) * (h : ZMod q₂))
          (((n + ℓ * (r : ℤ) : ℤ) : ZMod q₂) * ((r * z : ℕ) : ZMod q₂))
      else 0
    have hf (u v : ℕ) : sourceTheta r q₀ u v q₂ a b₁ b₂ ℓ n h = θ (q₀ * u * v) := by
      unfold sourceTheta
      dsimp only [θ]
      split_ifs
      · congr 3
        push_cast
        ring
      · rfl
    rw [hf u v, hf 1 (u * v)]
    congr 1
    ring
  have hrow (t : ℕ × ℕ × ℕ × ℕ) (ht : t ∈ 𝒜) :
      ‖ν (q₀ * t.2.1 * t.2.2.1, t.1) * star (ν (q₀ * t.2.2.2, t.1)) *
        ((M : ℂ) / (P t : ℂ)) *
          ∑ n ∈ βℤ.support.filter (fun n =>
            Int.gcd n ((t.1 * q₀ * t.2.1 * t.2.2.1 : ℕ) : ℤ) = 1 ∧
            Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2.2 : ℕ) : ℤ) = 1),
            βℤ n * star (βℤ (n + ℓ * (t.1 : ℤ))) *
              (sourceCompatibility t.1 q₀ b₁ b₂ ℓ n : ℂ) *
                ∑ h ∈ J, sourcePhi ψM M (P t) h *
                  sourceTheta t.1 q₀ t.2.1 t.2.2.1 t.2.2.2 a b₁ b₂ ℓ n h‖ ≤
        (M * (q₀ : ℝ) / (R * Q ^ 2)) * w (π t) t.2.2.1 := by
    obtain ⟨hr, hu, hv, hq₂, _, hRr, _, _, _, hQ₁, hQ₂, _⟩ := h𝒜 t ht
    have hh := sourceHighGamma_weighted_row_norm t.1 q₀ t.2.1 t.2.2.1 t.2.2.2
      a b₁ b₂ ℓ M R Q hM hR hQ hr hq₀ hu hv hq₂ hRr hQ₁ hQ₂
      (ν (q₀ * t.2.1 * t.2.2.1, t.1)) (ν (q₀ * t.2.2.2, t.1))
      (hν t ht).1 (hν t ht).2 βℤ.support J βℤ (fun h => sourcePhi ψM M (P t) h)
    dsimp only at hh
    have hTh : sourceTheta t.1 q₀ t.2.1 t.2.2.1 t.2.2.2 a b₁ b₂ ℓ =
        sourceTheta t.1 q₀ 1 (t.2.1 * t.2.2.1) t.2.2.2 a b₁ b₂ ℓ :=
      funext fun n => funext fun h => hTheta _ _ _ _ n h
    conv_rhs at hh => rw [hTh]
    simpa only [P, w, π, Nat.mul_assoc] using hh
  have hlocal (i : ℕ × ℕ × ℕ) (hi : i ∈ I) :
      (∑ v ∈ F i, w i v) ≤
        K * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * N * V * x ^ (-2 * ε) := by
    obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hi
    obtain ⟨_, _, _, _, _, hRr, hrR, huU, _, _, _, hq₂Q⟩ := h𝒜 t ht
    have huV : (t.2.1 : ℝ) * V ≤ D * Q / (q₀ : ℝ) := by
      calc
        _ ≤ (C * U) * V := mul_le_mul_of_nonneg_right huU hV.le
        _ = C * (U * V) := by ring
        _ ≤ C * (C * Q / (q₀ : ℝ)) := mul_le_mul_of_nonneg_left hUV hCpos.le
        _ = C ^ 2 * Q / (q₀ : ℝ) := by ring
        _ ≤ _ := div_le_div_of_nonneg_right
          (mul_le_mul_of_nonneg_right hC₂D hQ.le) hqpos.le
    have hq₂Q' : (q₀ : ℝ) * (t.2.2.2 : ℝ) ≤ D * Q := by
      have hh : (q₀ : ℝ) * (t.2.2.2 : ℝ) ≤ C * Q := by
        simpa only [Nat.cast_mul] using hq₂Q
      exact hh.trans (mul_le_mul_of_nonneg_right hCD hQ.le)
    have hFdata (v : ℕ) (hv : v ∈ F (π t)) :
        0 < v ∧ (v : ℝ) ≤ D * V ∧ Squarefree (t.1 * q₀ * (t.2.1 * v) * t.2.2.2) := by
      obtain ⟨_, _, hvpos, _, hsf, _, _, _, hvV, _, _, _⟩ :=
        h𝒜 _ (hFmem (π t) v hv)
      refine ⟨hvpos, hvV.trans (mul_le_mul_of_nonneg_right hCD hV.le), ?_⟩
      simpa only [π, Nat.mul_assoc] using hsf
    have hFdense (v : ℕ) (hv : v ∈ F (π t)) :
        Nonempty (DenseDivisibilityWitness
          Y 1 (t.1 * q₀ * (t.2.1 * v))) ∧
        Nonempty (DenseDivisibilityWitness
          Y 1 (t.1 * q₀ * t.2.2.2)) := by
      simpa only [π, Nat.mul_assoc] using h𝒜Y _ (hFmem (π t) v hv)
    exact hsplit x hx M N R Q H V γ hM hN hR hQ hV hMN' hNγ hNR' hRN' hRQ'
      hγlo hγhi t.1 q₀ t.2.1 t.2.2.2 a b₁ b₂ hRr hrR hH hHone huV hq₂Q'
      hVlo' hVhi' (F (π t)) J hFdata hJ (ha t ht) hb₁ ℓ t₀ Y hYx hFdense
      ψN hψN hψNs hψN0 hψNb β hβs hβ hψmajor
      (fun v h => sourcePhi ψM M (t.1 * q₀ * (t.2.1 * v) * t.2.2.2) h)
      (fun _ _ h _ => hPhi _ h)
  have hsumfiber (i : ℕ × ℕ × ℕ) :
      (∑ t ∈ 𝒜.filter (fun t => π t = i), w (π t) t.2.2.1) =
        ∑ v ∈ F i, w i v := by
    have hinj : Set.InjOn (fun t : ℕ × ℕ × ℕ × ℕ => t.2.2.1)
        (𝒜.filter (fun t => π t = i) : Set _) := by
      intro t ht s hs hv
      have heq : π t = π s := (Finset.mem_filter.mp ht).2.trans
        (Finset.mem_filter.mp hs).2.symm
      have hfirst : t.1 = s.1 := congrArg (fun p : ℕ × ℕ × ℕ => p.1) heq
      have hsecond : t.2.1 = s.2.1 := congrArg (fun p : ℕ × ℕ × ℕ => p.2.1) heq
      have hfourth : t.2.2.2 = s.2.2.2 := by
        simpa only [π] using congrArg (fun p : ℕ × ℕ × ℕ => p.2.2) heq
      exact Prod.ext hfirst (Prod.ext hsecond (Prod.ext hv hfourth))
    calc
      _ = ∑ t ∈ 𝒜.filter (fun t => π t = i), w i t.2.2.1 := by
        apply Finset.sum_congr rfl
        intro t ht
        rw [(Finset.mem_filter.mp ht).2]
      _ = _ := (Finset.sum_image hinj).symm
  have hIcard : (I.card : ℝ) ≤ 2 * C ^ 2 * R * U * Q / (q₀ : ℝ) := by
    let IR := Finset.Icc 1 ⌊2 * R⌋₊
    let IU := Finset.Icc 1 ⌊C * U⌋₊
    let IQ := Finset.Icc 1 ⌊C * Q / (q₀ : ℝ)⌋₊
    have hsub : I ⊆ IR ×ˢ (IU ×ˢ IQ) := by
      intro i hi
      obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hi
      obtain ⟨hr, hu, _, hq₂, _, _, hrR, huU, _, _, _, hq₂Q⟩ := h𝒜 t ht
      have hq₂bound : (t.2.2.2 : ℝ) ≤ C * Q / (q₀ : ℝ) := by
        apply (le_div_iff₀ hqpos).mpr
        simpa only [Nat.cast_mul, mul_comm] using hq₂Q
      exact Finset.mem_product.mpr
        ⟨Finset.mem_Icc.mpr ⟨hr, Nat.le_floor hrR⟩,
          Finset.mem_product.mpr ⟨Finset.mem_Icc.mpr ⟨hu, Nat.le_floor huU⟩,
            Finset.mem_Icc.mpr ⟨hq₂, Nat.le_floor hq₂bound⟩⟩⟩
    have hc : I.card ≤ ⌊2 * R⌋₊ * (⌊C * U⌋₊ * ⌊C * Q / (q₀ : ℝ)⌋₊) := by
      simpa only [Finset.card_product, IR, IU, IQ, Nat.card_Icc, Nat.add_sub_cancel] using
        Finset.card_le_card hsub
    calc
      (I.card : ℝ) ≤ (⌊2 * R⌋₊ : ℝ) *
          ((⌊C * U⌋₊ : ℝ) * (⌊C * Q / (q₀ : ℝ)⌋₊ : ℝ)) := by exact_mod_cast hc
      _ ≤ (2 * R) * ((C * U) * (C * Q / (q₀ : ℝ))) := by
        gcongr <;> exact Nat.floor_le (by positivity)
      _ = _ := by ring
  have hfamily : (∑ t ∈ 𝒜, w (π t) t.2.2.1) ≤
      (2 * C ^ 2 * R * U * Q / (q₀ : ℝ)) *
        (K * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * N * V * x ^ (-2 * ε)) := by
    calc
      _ = ∑ i ∈ I, ∑ t ∈ 𝒜.filter (fun t => π t = i), w (π t) t.2.2.1 :=
        (Finset.sum_fiberwise_of_maps_to (s := 𝒜) (t := I) (g := π)
          (fun t ht => Finset.mem_image_of_mem π ht) _).symm
      _ = ∑ i ∈ I, ∑ v ∈ F i, w i v :=
        Finset.sum_congr rfl (fun i _ => hsumfiber i)
      _ ≤ ∑ _i ∈ I, K * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * N * V * x ^ (-2 * ε) :=
        Finset.sum_le_sum hlocal
      _ = (I.card : ℝ) *
          (K * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * N * V * x ^ (-2 * ε)) := by
        rw [Finset.sum_const, nsmul_eq_mul]
      _ ≤ _ := mul_le_mul_of_nonneg_right hIcard (by positivity)
  have hpow : x ^ (-2 * ε) ≤ x ^ (-ε / 4) :=
    Real.rpow_le_rpow_of_exponent_le hxone (by linarith only [hε])
  calc
    _ ≤ ∑ t ∈ 𝒜, (M * (q₀ : ℝ) / (R * Q ^ 2)) * w (π t) t.2.2.1 :=
      Finset.sum_le_sum hrow
    _ = (M * (q₀ : ℝ) / (R * Q ^ 2)) * ∑ t ∈ 𝒜, w (π t) t.2.2.1 :=
      (Finset.mul_sum ..).symm
    _ ≤ (M * (q₀ : ℝ) / (R * Q ^ 2)) *
        ((2 * C ^ 2 * R * U * Q / (q₀ : ℝ)) *
          (K * (Int.gcd (q₀ : ℤ) ℓ : ℝ) * N * V * x ^ (-2 * ε))) :=
      mul_le_mul_of_nonneg_left hfamily (by positivity)
    _ = (2 * C ^ 2 * K * M * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ)) *
        ((U * V) / Q) * x ^ (-2 * ε) := by
      field_simp [hR.ne', hQ.ne', hqpos.ne']
    _ ≤ (2 * C ^ 2 * K * M * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ)) *
        (C / (q₀ : ℝ)) * x ^ (-ε / 4) := by
      apply mul_le_mul _ hpow (Real.rpow_nonneg hxpos.le _) (by positivity)
      apply mul_le_mul_of_nonneg_left _ (by positivity)
      calc
        (U * V) / Q ≤ (C * Q / (q₀ : ℝ)) / Q :=
          div_le_div_of_nonneg_right hUV hQ.le
        _ = C / (q₀ : ℝ) := by field_simp [hQ.ne', hqpos.ne']
    _ = _ := by ring

open Classical in
theorem sourceLowerLow_uniform_band
    (j : ℕ) («ω» δ σ c₀ ε C cM TM TN T A₀ A₁ LM : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hσ : 0 < σ) (hε : 0 < ε)
    (hI : (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ + 20000 * ε < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ + 20000 * ε < 1))
    (hc₀ : 100 * ε < c₀)
    (hC : 2 ≤ C) (hcM : 0 < cM) (hMT : cM ≤ TM)
    (hTN : 1 ≤ TN) (hT : 1 ≤ T) (hA₀ : 0 ≤ A₀) (hA₁ : 0 ≤ A₁) (hLM : 0 ≤ LM) :
    ∃ K X : ℝ, 0 < K ∧ 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ M N R Q H U V γ : ℝ,
        0 < M → 0 < N → 0 < R → 0 < Q → 0 < U → 0 < V →
        x / C ≤ M * N → N = x ^ γ →
        x ^ (-δ - 6 * ε) * N ≤ R → R ≤ x ^ (-4 * ε) * N →
        R * Q ≤ x ^ (1 / 2 + 2 * «ω» + ε) →
        1 / 2 - σ ≤ γ → γ ≤ 1 / 2 - 2 * «ω» - c₀ →
      ∀ q₀ a b₁ b₂ : ℕ, 0 < q₀ →
        H = x ^ ε * R * Q ^ 2 / ((q₀ : ℝ) * M) → 1 ≤ H →
      ∀ (Y : Set.Ici (1 : ℝ)), (Y : ℝ) ≤ x ^ δ →
      ∀ (𝒜 : Finset (ℕ × ℕ × ℕ × ℕ)) (J : Finset ℤ),
        (∀ t ∈ 𝒜,
          0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
          Squarefree (t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2) ∧
          R ≤ (t.1 : ℝ) ∧ (t.1 : ℝ) ≤ 2 * R ∧
          Q ≤ (q₀ * t.2.1 * t.2.2.1 : ℕ) ∧
          (q₀ * t.2.1 * t.2.2.1 : ℕ) ≤ 2 * Q ∧
          Q ≤ (q₀ * t.2.2.2 : ℕ) ∧ (q₀ * t.2.2.2 : ℕ) ≤ 2 * Q) →
        (j = 1 → ∀ t ∈ 𝒜, t.2.1 = 1) →
        (j = 2 →
          U * V ≤ C * Q / (q₀ : ℝ) ∧
          x ^ (5 * ε) * H / (q₀ : ℝ) ≤ C * V ∧
          V ≤ C * x ^ (δ + 5 * ε) * H ∧
          ∀ t ∈ 𝒜, (t.2.1 : ℝ) ≤ C * U ∧ (t.2.2.1 : ℝ) ≤ C * V) →
        (∀ t ∈ 𝒜,
          Nonempty (DenseDivisibilityWitness
            Y 1 (t.1 * q₀ * t.2.1 * t.2.2.1)) ∧
          Nonempty (DenseDivisibilityWitness
            Y 1 (t.1 * q₀ * t.2.2.2))) →
        (∀ h ∈ J, h ≠ 0 ∧ |(h : ℝ)| ≤ 2 * H) →
        (∀ t ∈ 𝒜, Nat.Coprime a t.1) → Nat.Coprime b₁ q₀ →
      ∀ (ν : ℕ × ℕ → ℂ),
        (∀ t ∈ 𝒜,
          ‖ν (q₀ * t.2.1 * t.2.2.1, t.1)‖ ≤ 1 ∧
          ‖ν (q₀ * t.2.2.2, t.1)‖ ≤ 1) →
      ∀ (ℓ : ℤ) (t₀ : ℝ) (ψM ψN : ℝ → ℝ),
        Function.support ψM ⊆ Set.Icc cM TM → (∀ t : ℝ, |ψM t| ≤ LM) →
        ContDiff ℝ 1 ψN → Function.support ψN ⊆ Set.Icc (-T) T →
        (∀ t : ℝ, 0 ≤ ψN t) →
        (∀ t : ℝ, |ψN t| ≤ A₀ ∧ |deriv ψN t| ≤ A₁) →
      ∀ (β : ℕ →₀ ℂ), β.support ⊆ Finset.Icc 1 ⌊TN * N⌋₊ →
        (∀ n ∈ β.support, ‖β n‖ ≤ x ^ (ε / 100)) →
        (∀ n ∈ β.support, 1 ≤ ψN (((n : ℝ) - t₀) / N)) →
      let βℤ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
      let P : (ℕ × ℕ × ℕ × ℕ) → ℕ := fun t =>
        t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2
      (∑ t ∈ 𝒜,
        ‖ν (q₀ * t.2.1 * t.2.2.1, t.1) * star (ν (q₀ * t.2.2.2, t.1)) *
          ((M : ℂ) / (P t : ℂ)) *
            ∑ n ∈ βℤ.support.filter (fun n =>
              Int.gcd n ((t.1 * q₀ * t.2.1 * t.2.2.1 : ℕ) : ℤ) = 1 ∧
              Int.gcd (n + ℓ * (t.1 : ℤ)) ((q₀ * t.2.2.2 : ℕ) : ℤ) = 1),
              βℤ n * star (βℤ (n + ℓ * (t.1 : ℤ))) *
                (sourceCompatibility t.1 q₀ b₁ b₂ ℓ n : ℂ) *
                  ∑ h ∈ J, sourcePhi ψM M (P t) h *
                    sourceTheta t.1 q₀ t.2.1 t.2.2.1 t.2.2.2 a b₁ b₂ ℓ n h‖) ≤
        K * M * N * (Int.gcd (q₀ : ℤ) ℓ : ℝ) / (q₀ : ℝ) * x ^ (-ε / 4) := by
  have hC1 : 1 ≤ C := (by norm_num : (1 : ℝ) ≤ 2).trans hC
  rcases hI with ⟨rfl, hI⟩ | ⟨rfl, hI⟩
  · obtain ⟨K, X, hK, hX, hAt⟩ := sourceLowerOne_uniform_band
      «ω» δ σ c₀ ε C cM TM TN T A₀ A₁ LM
      hω hδ hσ.le hε (by linarith only [hI, hε]) hc₀
      hC1 hcM hMT hTN hT hA₀ hA₁ hLM
    refine ⟨K, X, hK, hX, ?_⟩
    intro x hx M N R Q H U V γ hM hN hR hQ _hU _hV hMN hNγ hNR hRN hRQ hγlo hγhi
      q₀ a b₁ b₂ hq₀ hH hHone Y hY 𝒜 J h𝒜 hUnit _hGeometry hDense hJ ha hb
      ν hν ℓ t₀ ψM ψN hψMs hψMb hψN hψNs hψN0 hψNb β hβs hβ hMajor βℤ P
    have hFamily : ∀ t ∈ 𝒜,
        t.2.1 = 1 ∧ 0 < t.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
        Squarefree (t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2) ∧
        R ≤ (t.1 : ℝ) ∧ (t.1 : ℝ) ≤ 2 * R ∧
        Q ≤ (q₀ * t.2.2.1 : ℕ) ∧ (q₀ * t.2.2.1 : ℕ) ≤ 2 * Q ∧
        Q ≤ (q₀ * t.2.2.2 : ℕ) ∧ (q₀ * t.2.2.2 : ℕ) ≤ 2 * Q := by
      intro t ht
      obtain ⟨hr, _, hv, hq, hsf, hrlo, hrhi, hq₁lo, hq₁hi, hq₂lo, hq₂hi⟩ := h𝒜 t ht
      exact ⟨hUnit rfl t ht, hr, hv, hq, hsf, hrlo, hrhi,
        by simpa only [hUnit rfl t ht, Nat.mul_one] using hq₁lo,
        by simpa only [hUnit rfl t ht, Nat.mul_one] using hq₁hi, hq₂lo, hq₂hi⟩
    have hDense' : ∀ t ∈ 𝒜,
        Nonempty (DenseDivisibilityWitness
          Y 1 (t.1 * q₀ * t.2.2.1)) ∧
        Nonempty (DenseDivisibilityWitness
          Y 1 (t.1 * q₀ * t.2.2.2)) := by
      intro t ht
      simpa only [hUnit rfl t ht, Nat.mul_one] using hDense t ht
    have hraw := hAt x hx M N R Q H γ hM hN hR hQ hMN hNγ hNR hRN hRQ hγlo hγhi
      q₀ a b₁ b₂ hH hHone 𝒜 J hFamily hJ ha hb ν hν ℓ t₀ Y hY hDense'
      ψM ψN hψMs hψMb hψN hψNs hψN0 hψNb β hβs hβ hMajor
    refine hraw.trans ?_
    exact mul_le_mul_of_nonneg_left
      (Real.rpow_le_rpow_of_exponent_le (hX.trans hx) (by linarith only [hε]))
      (by positivity)
  · have hδ' : 0 < δ + 2 * ε := by positivity
    obtain ⟨K, X, hK, hX, hAt⟩ := sourceLowerTwo_uniform_band
      «ω» (δ + 2 * ε) σ ε C cM TM TN T A₀ A₁ LM
      hω hδ' hσ hε (by linarith only [hI, hε])
      hC1 hcM hMT hTN hT hA₀ hA₁ hLM
    refine ⟨K, X, hK, hX, ?_⟩
    intro x hx M N R Q H U V γ hM hN hR hQ hU hV hMN hNγ hNR hRN hRQ hγlo hγhi
      q₀ a b₁ b₂ hq₀ hH hHone Y hY 𝒜 J h𝒜 _hUnit hGeometry hDense hJ ha hb
      ν hν ℓ t₀ ψM ψN hψMs hψMb hψN hψNs hψN0 hψNb β hβs hβ hMajor βℤ P
    have hxone : 1 ≤ x := hX.trans hx
    have hxpos : 0 < x := zero_lt_one.trans_le hxone
    have hCpos : 0 < C := zero_lt_one.trans_le hC1
    have hNR' : N ≤ C * x ^ ((δ + 2 * ε) + 4 * ε) * R := by
      have hmul := mul_le_mul_of_nonneg_left hNR
        (Real.rpow_nonneg hxpos.le (δ + 6 * ε))
      have hcancel : x ^ (δ + 6 * ε) * (x ^ (-δ - 6 * ε) * N) = N := by
        rw [← mul_assoc, ← Real.rpow_add hxpos]
        simp only [show δ + 6 * ε + (-δ - 6 * ε) = 0 by ring, Real.rpow_zero, one_mul]
      rw [hcancel] at hmul
      calc
        N ≤ x ^ (δ + 6 * ε) * R := hmul
        _ ≤ C * (x ^ (δ + 6 * ε) * R) := le_mul_of_one_le_left (by positivity) hC1
        _ = C * x ^ ((δ + 2 * ε) + 4 * ε) * R := by
          rw [show (δ + 2 * ε) + 4 * ε = δ + 6 * ε by ring]
          ring
    have hRN' : R ≤ C * x ^ (-2 * ε) * N := hRN.trans (by
      calc
        x ^ (-4 * ε) * N ≤ x ^ (-2 * ε) * N := mul_le_mul_of_nonneg_right
          (Real.rpow_le_rpow_of_exponent_le hxone (by linarith only [hε])) hN.le
        _ ≤ C * (x ^ (-2 * ε) * N) := le_mul_of_one_le_left (by positivity) hC1
        _ = _ := by ring)
    have hRQ' : R * Q ≤ C * x ^ (1 / 2 + 2 * «ω» + ε) := hRQ.trans
      (le_mul_of_one_le_left (Real.rpow_nonneg hxpos.le _) hC1)
    obtain ⟨hUV, hVlo, hVhi, hsize⟩ := hGeometry rfl
    have hVhi' : V ≤ C * x ^ ((δ + 2 * ε) + 5 * ε) * H := hVhi.trans
      (mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_left
        (Real.rpow_le_rpow_of_exponent_le hxone (by linarith only [hε])) hCpos.le)
        (zero_lt_one.trans_le hHone).le)
    have hY' : (Y : ℝ) ≤ x ^ (δ + 2 * ε) := hY.trans
      (Real.rpow_le_rpow_of_exponent_le hxone (by linarith only [hε]))
    have hFamily : ∀ t ∈ 𝒜,
        0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
        Squarefree (t.1 * q₀ * t.2.1 * t.2.2.1 * t.2.2.2) ∧
        R ≤ (t.1 : ℝ) ∧ (t.1 : ℝ) ≤ 2 * R ∧
        (t.2.1 : ℝ) ≤ C * U ∧ (t.2.2.1 : ℝ) ≤ C * V ∧
        Q ≤ (q₀ * t.2.1 * t.2.2.1 : ℕ) ∧
        Q ≤ (q₀ * t.2.2.2 : ℕ) ∧ (q₀ * t.2.2.2 : ℕ) ≤ C * Q := by
      intro t ht
      obtain ⟨hr, hu, hv, hq, hsf, hrlo, hrhi, hq₁lo, _, hq₂lo, hq₂hi⟩ := h𝒜 t ht
      have hq₂C : (q₀ * t.2.2.2 : ℕ) ≤ C * Q :=
        hq₂hi.trans (mul_le_mul_of_nonneg_right hC hQ.le)
      exact ⟨hr, hu, hv, hq, hsf, hrlo, hrhi, (hsize t ht).1,
        (hsize t ht).2, hq₁lo, hq₂lo, hq₂C⟩
    exact hAt x hx M N R Q H U V γ hM hN hR hQ hU hV hMN hNγ hNR' hRN' hRQ'
      hγlo (by linarith only [hγhi, hω, hc₀, hε]) q₀ a b₁ b₂ hq₀ hH hHone
      hUV hVlo hVhi' Y hY' 𝒜 J hFamily hDense hJ ha hb ν hν ℓ t₀
      ψM ψN hψMs hψMb hψN hψNs hψN0 hψNb β hβs hβ hMajor

theorem sourceDeltaZero_rough_dyadic_lowerOrder_uniform_log_saving
    (j₀ : ℕ) («ω» δ σ ε c₀ C cM TM cN TN : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hσ : 0 < σ) (hε : 0 < ε)
    (hc₀ : 0 < c₀) (hcutmargin : 100 * ε < c₀)
    (hI : (j₀ = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ + 20000 * ε < 1) ∨
      (j₀ = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ + 20000 * ε < 1))
    (hII : 68 * «ω» + 14 * δ + 100 * c₀ + 20000 * ε < 1)
    (hC : 1 ≤ C) (hcM : 0 < cM) (hMT : cM ≤ TM)
    (hcN : 0 < cN) (hNT : cN ≤ TN)
    (dα dβ : ℕ) (Eα Eβ A η : ℝ) (hA : 0 < A) (hη : 0 < η) :
    ∃ X₀ : ℝ, Real.exp 1 ≤ X₀ ∧
      ∀ (x : ℝ), X₀ ≤ x →
      ∀ (M N R Q γ : ℝ),
      0 < M → 0 < N → 0 < R → 0 < Q →
      x / C ≤ M * N → M * N ≤ C * x → N = x ^ γ →
      1 / 2 - σ ≤ γ →
      γ ≤ 1 / 2 →
      x ^ (-δ - 6 * ε) * N ≤ R →
      R ≤ x ^ (-4 * ε) * N →
      x ^ (1 / 2 - ε) ≤ C * R * Q →
      R * Q ≤ x ^ (1 / 2 + 2 * «ω» + ε) →
      ∀ (α β : ℕ →₀ ℂ),
      (∀ n ∈ α.support,
        cM * M ≤ (n : ℝ) ∧ (n : ℝ) ≤ TM * M ∧
        ‖α n‖ ≤ C * (n.divisors.card : ℝ) ^ dα * (Real.log x) ^ Eα) →
      (∀ n ∈ β.support,
        cN * N ≤ (n : ℝ) ∧ (n : ℝ) ≤ TN * N ∧
        ‖β n‖ ≤ C * (n.divisors.card : ℝ) ^ dβ * (Real.log x) ^ Eβ) →
      ∀ (S : Finset (ℕ × ℕ)),
      (∀ p ∈ S,
        0 < p.1 ∧ 0 < p.2 ∧ Squarefree (p.1 * p.2) ∧
        Q ≤ (p.1 : ℝ) ∧ (p.1 : ℝ) ≤ 2 * Q ∧
        R ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ 2 * R ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ (j₀ - 1) p.1) ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ 1 (p.1 * p.2)) ∧
        (∀ t ∈ p.1.primeFactors,
          Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (t : ℝ))) →
      ∀ (a b₁ b₂ : ℕ),
      (∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2)) →
      (∑ p ∈ S,
        ‖deltaZero (finiteConvolution α β) p.1 p.2 a b₁ b₂‖) ≤
          η * (M * N) * (Real.log x) ^ (-A)
:= by
  classical
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hTMpos : 0 < TM := hcM.trans_le hMT
  have hTNpos : 0 < TN := hcN.trans_le hNT
  have hεhalf : ε < 1 / 2 := by
    linarith only [hII, hω, hδ, hc₀, hε]
  have hεone : ε ≤ 1 := by linarith only [hεhalf]
  let δ₀ : ℝ := δ + 2 * ε
  have hδ₀ : 0 < δ₀ := by dsimp only [δ₀]; positivity
  obtain ⟨ψM, hψM, hsM, hMnonneg, hMmajor, hMderivatives⟩ := opening_majorant cM TM hcM hMT
  obtain ⟨ψN, hψN, hsN, hNnonneg, hNmajor, hNderivatives⟩ := opening_majorant cN TN hcN hNT
  choose CM hCM hCMbound using hMderivatives
  choose CN hCN hCNbound using hNderivatives
  let C₀ : ℝ := 4 * (C + TM + TN + 1)
  have hC₀four : 4 ≤ C₀ := by dsimp only [C₀]; nlinarith
  have hC₀ : 1 ≤ C₀ := by linarith
  have hC₀pos : 0 < C₀ := zero_lt_one.trans_le hC₀
  have hCC₀ : C ≤ C₀ := by dsimp only [C₀]; nlinarith
  have hTN₀ : 2 * TN ≤ C₀ := by dsimp only [C₀]; nlinarith
  have hMinterval : cM / 2 ≤ 2 * TM := by linarith
  have hNinterval : cN / 2 ≤ 2 * TN := by linarith
  have hC₀two : 2 ≤ C₀ := (by norm_num : (2 : ℝ) ≤ 4).trans hC₀four
  obtain ⟨Knear, Xnear, hKnear, hXnear, hNearAt⟩ :=
    sourceLowerTypeII_uniform_band «ω» δ c₀ ε C₀ (cM / 2) (2 * TM)
      C₀ C₀ (CN 0) (CN 1) (CM 0)
      hω hδ hc₀ hε (by linarith only [hII, hε]) hC₀ (by positivity) hMinterval
      hC₀ hC₀ (hCN 0) (hCN 1) (hCM 0)
  obtain ⟨Ksplit, Xsplit, hKsplit, hXsplit, hSplitAt⟩ :=
    sourceLowerLow_uniform_band j₀ «ω» δ σ c₀ ε C₀ (cM / 2) (2 * TM)
      C₀ C₀ (CN 0) (CN 1) (CM 0)
      hω hδ hσ hε hI hcutmargin hC₀two (by positivity) hMinterval
      hC₀ hC₀ (hCN 0) (hCN 1) (hCM 0)
  let Kband : ℝ := max Knear Ksplit
  let Xband : ℝ := max Xnear Xsplit
  have hKband : 0 < Kband := hKnear.trans_le (le_max_left _ _)
  have hNearK : Knear ≤ Kband := le_max_left _ _
  have hSplitK : Ksplit ≤ Kband := le_max_right _ _
  have hψN1 : ContDiff ℝ 1 ψN := hψN.of_le (by simp)
  have hsNsym : Function.support ψN ⊆ Set.Icc (-C₀) C₀ :=
    hsN.trans (Set.Icc_subset_Icc (by linarith only [hcN, hC₀pos]) hTN₀)
  have hMbound : ∀ t : ℝ, |ψM t| ≤ CM 0 := by
    intro t
    simpa only [iteratedDeriv_zero, Real.norm_eq_abs] using hCMbound 0 t
  have hNbound : ∀ t : ℝ, |ψN t| ≤ CN 0 ∧ |deriv ψN t| ≤ CN 1 := by
    intro t
    exact ⟨by simpa only [iteratedDeriv_zero, Real.norm_eq_abs] using hCNbound 0 t,
      by simpa only [iteratedDeriv_one, Real.norm_eq_abs] using hCNbound 1 t⟩
  have hBetaAt := opening_high_beta_subpower dβ Eβ C TN ε hCpos.le hTNpos hε
  obtain ⟨Kα, Fα, hKα, hMomentAt⟩ := opening_moment dα Eα C TM hCpos.le hTMpos
  let D : ℝ := 2 * A + |Fα| + 2
  have hD : 0 < D := by dsimp only [D]; positivity
  let k : ℕ := Nat.ceil ((1 + ((2 * dβ + 5 : ℕ) : ℝ) * 2 + 2) / ε)
  let Ltail : ℝ := max (CM 0) (CM (k + 2))
  have hLtail : 0 ≤ Ltail := (hCM 0).trans (le_max_left _ _)
  have hTailAt := (opening_padded_truncation dβ Eβ 2 C ε 1
    (by norm_num) hCpos.le hε (by norm_num)).2
      (cM / 2) (2 * TM) Ltail 0 (by positivity) hMinterval hLtail
  let Lzero : ℝ := max (CM 0) (max (CM 1) (CM 2))
  have hLzero : 0 ≤ Lzero := (hCM 0).trans (le_max_left _ _)
  have hZeroAt := opening_zero_mode dβ Eβ C TN (2 * TM) Lzero ε D
    hCpos hTNpos (by positivity) hLzero hε ψM (hψM.of_le (by simp))
    (hsM.trans (Set.Icc_subset_Icc_left (by linarith))) (by
      intro t
      refine ⟨(by simpa only [iteratedDeriv_zero, Real.norm_eq_abs] using
        (hCMbound 0 t).trans (le_max_left _ _)), ?_, ?_⟩
      · simpa only [iteratedDeriv_one, Real.norm_eq_abs] using
          (hCMbound 1 t).trans ((le_max_left _ _).trans (le_max_right _ _))
      · simpa only [iteratedDeriv_succ, iteratedDeriv_one, iteratedDeriv_zero,
          Real.norm_eq_abs] using
          (hCMbound 2 t).trans ((le_max_right _ _).trans (le_max_right _ _)))
  have hDiagonalAt := opening_lower_diagonal dβ «ω» δ₀ ε C₀
    (2 * TM) C (CM 0) Eβ 0 D hω hδ₀ hε hC₀ (by positivity) hCpos.le (hCM 0) hD.le
  let Bcount : ℝ := 2 + 4 / Real.log 2
  have hBcount : 0 < Bcount := by
    dsimp only [Bcount]
    have : 0 < Real.log 2 := Real.log_pos (by norm_num)
    positivity
  let Koff : ℝ := 36 * Kband * Bcount ^ 2 * (2 * TN)
  have hKoff : 0 < Koff := by dsimp only [Koff]; positivity
  have hLogAbsorb (K E ρ : ℝ) (hρ : 0 < ρ) :
      ∀ᶠ x : ℝ in Filter.atTop, K * (Real.log x) ^ E ≤ x ^ ρ := by
    clear * - hρ
    filter_upwards [((isLittleO_log_rpow_rpow_atTop E hρ).const_mul_left K).eventuallyLE,
      Filter.eventually_ge_atTop (0 : ℝ)] with x hx hx0
    exact (le_abs_self _).trans (by
      simpa only [Real.norm_eq_abs, abs_of_nonneg (Real.rpow_nonneg hx0 ρ)] using hx)
  have hmain : ∀ᶠ x : ℝ in Filter.atTop,
      ∀ (M N R Q γ : ℝ), 0 < M → 0 < N → 0 < R → 0 < Q →
      x / C ≤ M * N → M * N ≤ C * x → N = x ^ γ →
      1 / 2 - σ ≤ γ →
      γ ≤ 1 / 2 →
      x ^ (-δ - 6 * ε) * N ≤ R → R ≤ x ^ (-4 * ε) * N →
      x ^ (1 / 2 - ε) ≤ C * R * Q → R * Q ≤ x ^ (1 / 2 + 2 * «ω» + ε) →
      ∀ (α β : ℕ →₀ ℂ),
      (∀ n ∈ α.support, cM * M ≤ (n : ℝ) ∧ (n : ℝ) ≤ TM * M ∧
        ‖α n‖ ≤ C * (n.divisors.card : ℝ) ^ dα * (Real.log x) ^ Eα) →
      (∀ n ∈ β.support, cN * N ≤ (n : ℝ) ∧ (n : ℝ) ≤ TN * N ∧
        ‖β n‖ ≤ C * (n.divisors.card : ℝ) ^ dβ * (Real.log x) ^ Eβ) →
      ∀ (S : Finset (ℕ × ℕ)),
      (∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Squarefree (p.1 * p.2) ∧
        Q ≤ (p.1 : ℝ) ∧ (p.1 : ℝ) ≤ 2 * Q ∧
        R ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ 2 * R ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ (j₀ - 1) p.1) ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ 1 (p.1 * p.2)) ∧
        (∀ t ∈ p.1.primeFactors,
          Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (t : ℝ))) →
      ∀ (a b₁ b₂ : ℕ), (∀ p ∈ S, Nat.Coprime (a * b₁ * b₂) (p.1 * p.2)) →
      (∑ p ∈ S, ‖deltaZero (finiteConvolution α β) p.1 p.2 a b₁ b₂‖) ≤
        η * (M * N) * (Real.log x) ^ (-A) := by
    filter_upwards [opening_lower_scale_resources C₀ «ω» δ₀ ε c₀ hC₀ hω hδ₀ hε hεhalf
      (by linarith only [hcutmargin, hε]),
      hMomentAt, hBetaAt, hZeroAt, hDiagonalAt, hTailAt,
      hLogAbsorb Koff (4 + D) (ε / 4) (by positivity),
      hLogAbsorb 1 D 1 zero_lt_one,
      Filter.eventually_ge_atTop Xband,
      Filter.eventually_ge_atTop (max (C₀ ^ 2) (max (2 * TN)
        (Real.exp (max 1 (26 * Kα / η ^ 2)))))]
      with x hscales hmomentAt hbetaAt hzeroAt hdiagonalAt htailAt hoffAbsorb
        htailAbsorb hxband hxlarge
    obtain ⟨hxexp, hxtwo, htarget, hscaleAt⟩ := hscales
    have hx1 : 1 ≤ x := (by norm_num : (1 : ℝ) ≤ 2).trans hxtwo
    have hx0 : 0 < x := zero_lt_one.trans_le hx1
    have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hxexp
    have hlog0 : 0 < Real.log x := zero_lt_one.trans_le hlog1
    have hC₀square : C₀ ^ 2 ≤ x := (le_max_left _ _).trans hxlarge
    have hTNx : 2 * TN ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans hxlarge)
    intro M N R Q γ hM hN hR hQ hMNlo hMNhi hNγ hγlo hγhi hNR hRhi hRQlo hRQhi
      α β hα hβ S hS a b₁ b₂ hprim
    have hMNlo₀ : x / C₀ ≤ M * N :=
      (div_le_div_of_nonneg_left hx0.le hCpos hCC₀).trans hMNlo
    have hMNhi₀ : M * N ≤ C₀ * x := hMNhi.trans
      (mul_le_mul_of_nonneg_right hCC₀ hx0.le)
    have hNR₀ : N ≤ C₀ * x ^ (δ₀ + 4 * ε) * R := by
      have hmul := mul_le_mul_of_nonneg_left hNR
        (Real.rpow_nonneg hx0.le (δ + 6 * ε))
      have hcancel : x ^ (δ + 6 * ε) * (x ^ (-δ - 6 * ε) * N) = N := by
        rw [← mul_assoc, ← Real.rpow_add hx0]
        simp only [show δ + 6 * ε + (-δ - 6 * ε) = 0 by ring, Real.rpow_zero, one_mul]
      rw [hcancel] at hmul
      calc
        N ≤ x ^ (δ + 6 * ε) * R := hmul
        _ ≤ C₀ * (x ^ (δ + 6 * ε) * R) :=
          le_mul_of_one_le_left (by positivity) hC₀
        _ = C₀ * x ^ (δ₀ + 4 * ε) * R := by
          dsimp only [δ₀]
          rw [show δ + 2 * ε + 4 * ε = δ + 6 * ε by ring]
          ring
    have hRhi₀ : R ≤ C₀ * x ^ (-2 * ε) * N := hRhi.trans (by
      calc
        x ^ (-4 * ε) * N ≤ x ^ (-2 * ε) * N := mul_le_mul_of_nonneg_right
          (Real.rpow_le_rpow_of_exponent_le hx1 (by linarith only [hε])) hN.le
        _ ≤ C₀ * (x ^ (-2 * ε) * N) := le_mul_of_one_le_left (by positivity) hC₀
        _ = _ := by ring)
    have hRQlo₀ : x ^ (1 / 2 - ε) ≤ C₀ * R * Q := hRQlo.trans
      (mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_right hCC₀ hR.le) hQ.le)
    have hRQhi₀ : R * Q ≤ C₀ * x ^ (1 / 2 + 2 * «ω» + ε) := hRQhi.trans
      (le_mul_of_one_le_left (Real.rpow_nonneg hx0.le _) hC₀)
    have hγresource : 1 / 4 + 2 * «ω» + δ₀ + 5 * ε ≤ γ := by
      dsimp only [δ₀]
      rcases hI with ⟨_, hI'⟩ | ⟨_, hI'⟩ <;>
        linarith only [hI', hγlo, hω, hδ, hε]
    have hγdiagonal : 4 * «ω» + δ₀ + 6 * ε ≤ γ := by
      dsimp only [δ₀]
      rcases hI with ⟨_, hI'⟩ | ⟨_, hI'⟩ <;>
        linarith only [hI', hγlo, hω, hδ, hε]
    obtain ⟨hNone, hNx, hMone, hMx, hRx, hQx, hMshort⟩ :=
      hscaleAt M N R Q γ hM hN hR hQ hMNlo₀ hMNhi₀ hNγ
        hγresource hγhi hNR₀ hRhi₀ hRQhi₀
    have hSsimple : ∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Squarefree (p.1 * p.2) := by
      intro p hp
      exact ⟨(hS p hp).1, (hS p hp).2.1, (hS p hp).2.2.1⟩
    have hScoprime : ∀ p ∈ S, Nat.Coprime p.1 p.2 :=
      fun p hp => Nat.coprime_of_squarefree_mul (hSsimple p hp).2.2
    have hβpos (n : ℕ) (hn : n ∈ β.support) : 0 < n := by
      exact_mod_cast (mul_pos hcN hN).trans_le (hβ n hn).1
    have hαpos (n : ℕ) (hn : n ∈ α.support) : 0 < n := by
      exact_mod_cast (mul_pos hcM hM).trans_le (hα n hn).1
    let NI : ℕ := ⌊TN * N⌋₊
    have hβsupport : β.support ⊆ Finset.Icc 1 NI := fun n hn =>
      Finset.mem_Icc.mpr ⟨hβpos n hn, Nat.le_floor (hβ n hn).2.1⟩
    have hNI : (NI : ℝ) ≤ TN * N := Nat.floor_le (by positivity)
    have hNIx : (NI : ℝ) ≤ x ^ (2 : ℝ) := by
      rw [Real.rpow_two]
      calc
        (NI : ℝ) ≤ TN * N := hNI
        _ ≤ x * x := mul_le_mul (by linarith only [hTNx, hTNpos]) hNx hN.le hx0.le
        _ = x ^ 2 := (pow_two x).symm
    have hNIscale : (NI : ℝ) ≤ C₀ * N := hNI.trans
      (mul_le_mul_of_nonneg_right (by linarith only [hTN₀, hTNpos]) hN.le)
    let sm : Finset ℕ := Finset.Icc 1 ⌊(2 * TM) * M⌋₊
    let w : ℕ → ℝ := fun n => ψM ((n : ℝ) / M)
    have hsm : α.support ⊆ sm := by
      intro n hn
      refine Finset.mem_Icc.mpr ⟨hαpos n hn, Nat.le_floor ?_⟩
      exact (hα n hn).2.1.trans (by nlinarith only [hTMpos, hM])
    have hw0 : ∀ n ∈ sm, 0 ≤ w n := fun n _ => hMnonneg _
    have hw1 : ∀ n ∈ α.support, 1 ≤ w n := by
      intro n hn
      exact hMmajor _ ⟨(le_div_iff₀ hM).mpr (hα n hn).1,
        (div_le_iff₀ hM).mpr (hα n hn).2.1⟩
    have hψNmajor : ∀ n ∈ β.support, 1 ≤ ψN ((n : ℝ) / N) := by
      intro n hn
      exact hNmajor _ ⟨(le_div_iff₀ hN).mpr (hβ n hn).1,
        (div_le_iff₀ hN).mpr (hβ n hn).2.1⟩
    have hαmoment := hmomentAt M hM hMx α (fun n hn =>
      ⟨hαpos n hn, (hα n hn).2.1, (hα n hn).2.2⟩)
    let H : ℕ → ℝ := fun g => x ^ ε * R * Q ^ 2 / ((g : ℝ) * M)
    let X : ℕ → ℝ := fun g => x ^ (-5 * ε) * Q / H g
    let Y : Set.Ici (1 : ℝ) :=
      ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩
    obtain ⟨u₀, hu₀⟩ := opening_coherent_dense_selector Y Q hQ X
    let u : ℕ → ℕ → ℕ := fun g q =>
      if j₀ = 2 ∧ γ ≤ 1 / 2 - 2 * «ω» - c₀ ∧ 1 ≤ H g then u₀ g (g * q) else 1
    let shells : ℕ → ℕ := fun g => if H g < 1 then 0 else Nat.log 2 ⌊H g⌋₊ + 1
    let J : ℕ → Finset ℤ := fun g =>
      (Finset.Ioo (-((2 : ℤ) ^ shells g)) ((2 : ℤ) ^ shells g)).erase 0
    have hXwindow (g : ℕ) (hg : 0 < g)
        (hcut : γ ≤ 1 / 2 - 2 * «ω» - c₀) (hH : 1 ≤ H g) :
        1 ≤ X g ∧ X g ≤ Q := by
      have hlower := opening_lower_selector_target_nat C₀ x M N R Q «ω» ε c₀ γ g
        hC₀ (lt_of_lt_of_le (by norm_num : (1 : ℝ) < 2) hxtwo)
        hM hN hR hQ hg hε.le hMNlo₀ hNγ hRQhi₀ hcut
      exact opening_selector_target_window C₀ x ε Q (H g) (c₀ - 7 * ε) 1
        hC₀ hx1 hε.le hQ hH (by norm_num) htarget (by
          simpa only [Nat.cast_one, H, one_mul] using hlower)
    have hu : ∀ p₁ ∈ S, ∀ p₂ ∈ S, p₁.2 = p₂.2 →
        let g := Nat.gcd p₁.1 p₂.1
        0 < u g (p₁.1 / g) ∧ u g (p₁.1 / g) ∣ p₁.1 / g := by
      intro p₁ hp₁ p₂ hp₂ _ g
      have hg : 0 < g := Nat.gcd_pos_of_pos_left _ (hSsimple p₁ hp₁).1
      have hgq : g ∣ p₁.1 := Nat.gcd_dvd_left _ _
      by_cases huse : j₀ = 2 ∧ γ ≤ 1 / 2 - 2 * «ω» - c₀ ∧ 1 ≤ H g
      · have hrec : g * (p₁.1 / g) = p₁.1 := Nat.mul_div_cancel' hgq
        have hw := hXwindow g hg huse.2.1 huse.2.2
        obtain ⟨_, _, _, hlo, hhi, _, _, hdense, _, _⟩ := hS p₁ hp₁
        have hdense' : Nonempty (DenseDivisibilityWitness Y 1 p₁.1) := by
          simpa only [huse.1, Nat.reduceSub] using hdense
        have hs := hu₀ g p₁.1 hg hgq hlo hhi hdense' hw.1 hw.2
        simpa only [u, ite_eq_left huse, hrec] using ⟨hs.1, hs.2.2.1⟩
      · simp only [u, ite_eq_right huse, zero_lt_one, one_dvd, and_self]
    let Ω : Finset ((ℕ × ℕ) × (ℕ × ℕ)) :=
      (S ×ˢ S).filter (fun p => p.1.2 = p.2.2)
    let G : Finset ℕ := Ω.image (fun p => Nat.gcd p.1.1 p.2.1)
    let 𝒜 : ℕ → Finset (ℕ × ℕ × ℕ × ℕ) := fun g =>
      (Ω.filter (fun p => Nat.gcd p.1.1 p.2.1 = g)).image (fun p =>
        (p.1.2, u g (p.1.1 / g), (p.1.1 / g) / u g (p.1.1 / g), p.2.1 / g))
    let γβ : ℤ →₀ ℂ := Finsupp.embDomain (Nat.castEmbedding : ℕ ↪ ℤ) β
    let L : ℕ → Finset ℤ := fun r =>
      ((γβ.support ×ˢ γβ.support).filter
        (fun p => p.1 ≠ p.2 ∧ Int.ModEq (r : ℤ) p.1 p.2)).image
          (fun p => (p.2 - p.1) / (r : ℤ))
    let LI : ℕ := ⌊(2 * TN) * N / R⌋₊
    let Lall : Finset ℤ := (Finset.Icc (-(LI : ℤ)) (LI : ℤ)).erase 0
    let bins : ℕ → Finset ℕ := fun g => (𝒜 g).image (fun t => Nat.log 2 t.2.1)
    let block : ℕ → ℤ → ℕ → Finset (ℕ × ℕ × ℕ × ℕ) := fun g ℓ i =>
      (𝒜 g).filter (fun t => ℓ ∈ L t.1 ∧ Nat.log 2 t.2.1 = i)
    have hfactor := mixedFourier_offDiagonal_gcd_shift_factorization
      sm w S β (fun _ => 0) a b₁ b₂ J u hSsimple hprim hu
    have hGdata (g : ℕ) (hg : g ∈ G) :
        0 < g ∧ Squarefree g ∧ (g : ℝ) ≤ 2 * Q ∧
        Nat.Coprime (a * b₁ * b₂) g ∧
        ∀ p ∈ g.primeFactors,
          Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (p : ℝ) := by
      obtain ⟨p, hpΩ, hpg⟩ := Finset.mem_image.mp hg
      obtain ⟨hp₁, _⟩ := Finset.mem_product.mp (Finset.mem_filter.mp hpΩ).1
      obtain ⟨hq, _, hsf, _, hqhi, _, _, _, _, hrough⟩ := hS p.1 hp₁
      have hgdvd : g ∣ p.1.1 := by
        rw [← hpg]
        exact Nat.gcd_dvd_left _ _
      have hgpos : 0 < g := by
        rw [← hpg]
        exact Nat.gcd_pos_of_pos_left _ hq
      have hgle : (g : ℝ) ≤ (p.1.1 : ℝ) := by
        exact_mod_cast Nat.le_of_dvd hq hgdvd
      refine ⟨hgpos, hsf.of_mul_left.squarefree_of_dvd hgdvd, hgle.trans hqhi,
        (hprim p.1 hp₁).of_dvd_right (dvd_mul_of_dvd_left hgdvd p.1.2), ?_⟩
      intro t ht
      exact hrough t (Nat.primeFactors_mono hgdvd hq.ne' ht)
    have hLall : ∀ r ∈ S.image Prod.snd, L r ⊆ Lall := by
      intro r hr ℓ hℓ
      have hℓne : ℓ ≠ 0 := (hfactor.2.1 r hr ℓ hℓ).1
      have hsupport0 : β.support ⊆ Finset.Icc 0 (0 + NI) := by
        intro n hn
        exact Finset.mem_Icc.mpr
          ⟨Nat.zero_le n, by simpa only [zero_add] using (Finset.mem_Icc.mp (hβsupport hn)).2⟩
      have hnat : ℓ.natAbs * r ≤ NI := hfactor.2.2.1 0 NI hsupport0 r hr ℓ hℓ
      have hRr : R ≤ (r : ℝ) := by
        obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hr
        obtain ⟨_, _, _, _, _, hrlow, _, _, _, _⟩ := hS p hp
        exact hrlow
      have hreal : (ℓ.natAbs : ℝ) * (r : ℝ) ≤ (NI : ℝ) := by exact_mod_cast hnat
      have hratio : (ℓ.natAbs : ℝ) ≤ (2 * TN) * N / R := by
        apply (le_div_iff₀ hR).2
        calc
          (ℓ.natAbs : ℝ) * R ≤ (ℓ.natAbs : ℝ) * (r : ℝ) :=
            mul_le_mul_of_nonneg_left hRr (Nat.cast_nonneg _)
          _ ≤ (NI : ℝ) := hreal
          _ ≤ TN * N := hNI
          _ ≤ (2 * TN) * N :=
            mul_le_mul_of_nonneg_right (by linarith only [hTNpos]) hN.le
      have hℓLI : ℓ.natAbs ≤ LI := Nat.le_floor hratio
      have hℓabs : |ℓ| ≤ (LI : ℤ) := by
        have hh : (ℓ.natAbs : ℤ) ≤ (LI : ℤ) := by exact_mod_cast hℓLI
        simpa only [Int.natCast_natAbs] using hh
      exact Finset.mem_erase.mpr ⟨hℓne, Finset.mem_Icc.mpr (abs_le.mp hℓabs)⟩
    have hSelected (g : ℕ) (hg : g ∈ G) (hj₂ : j₀ = 2)
        (hcut : γ ≤ 1 / 2 - 2 * «ω» - c₀) (hH : 1 ≤ H g)
        (t : ℕ × ℕ × ℕ × ℕ) (ht : t ∈ 𝒜 g) :
        X g / ((g : ℝ) * x ^ δ) ≤ (t.2.1 : ℝ) ∧ (t.2.1 : ℝ) ≤ X g := by
      obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp ht
      have hpg := (Finset.mem_filter.mp hp).2
      have hpΩ := Finset.mem_filter.mp (Finset.mem_filter.mp hp).1
      obtain ⟨hp₁, _⟩ := Finset.mem_product.mp hpΩ.1
      have hgpos := (hGdata g hg).1
      have hgq : g ∣ p.1.1 := by rw [← hpg]; exact Nat.gcd_dvd_left _ _
      have hrec' : g * (p.1.1 / g) = p.1.1 := Nat.mul_div_cancel' hgq
      obtain ⟨_, _, _, hqlo, hqhi, _, _, hdense, _, _⟩ := hS p.1 hp₁
      have hwindow := hXwindow g hgpos hcut hH
      have hdense' : Nonempty (DenseDivisibilityWitness Y 1 p.1.1) := by
        simpa only [hj₂, Nat.reduceSub] using hdense
      have hchoice := hu₀ g p.1.1 hgpos hgq hqlo hqhi hdense' hwindow.1 hwindow.2
      have hY : (Y : ℝ) = x ^ δ := max_eq_right (Real.one_le_rpow hx1 hδ.le)
      simpa only [u, ite_eq_left (And.intro hj₂ (And.intro hcut hH)), hrec', hY] using
        And.intro hchoice.2.2.2.2.1 hchoice.2.2.2.2.2.1
    have hBins (g : ℕ) (hg : g ∈ G) :
        ((bins g).card : ℝ) ≤ Bcount * Real.log x := by
      have hgpos := (hGdata g hg).1
      have hQsquare : 2 * Q ≤ x ^ 2 :=
        (opening_frequency_cutoff_power_bounds x ε M R Q g hxtwo hεone hMone
          hR.le hQ.le hRx hQx hgpos).2
      have hsubset : bins g ⊆ Finset.range (⌊2 * Real.log x / Real.log 2⌋₊ + 1) := by
        intro i hi
        obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hi
        obtain ⟨_, huPos, _, _, htS, _, _, _, _, _⟩ := (hfactor.1 g hg).2 t ht
        have hqPos : 0 < g * t.2.1 * t.2.2.1 := (hSsimple _ htS).1
        have huDvd : t.2.1 ∣ g * t.2.1 * t.2.2.1 :=
          dvd_mul_of_dvd_left (dvd_mul_left t.2.1 g) t.2.2.1
        have huUpper : (t.2.1 : ℝ) ≤ x ^ 2 := by
          calc
            (t.2.1 : ℝ) ≤ ((g * t.2.1 * t.2.2.1 : ℕ) : ℝ) := by
              exact_mod_cast Nat.le_of_dvd hqPos huDvd
            _ ≤ 2 * Q := by
              obtain ⟨_, _, _, _, hqhi, _, _, _, _, _⟩ := hS _ htS
              exact hqhi
            _ ≤ x ^ 2 := hQsquare
        simpa only [Nat.log2_eq_log_two] using
          (opening_selected_dyadic_log_budget x hx1 t.2.1 huPos huUpper).1
      have hcard : ((bins g).card : ℝ) ≤
          ((Finset.range (⌊2 * Real.log x / Real.log 2⌋₊ + 1)).card : ℝ) := by
        exact_mod_cast Finset.card_le_card hsubset
      have hbudget := (opening_selected_dyadic_log_budget x hx1 1 (by decide)
        (by simpa only [Nat.cast_one] using
          (show (1 : ℝ) ≤ x ^ 2 from by nlinarith only [hxtwo]))).2
      have hlog2 : 0 < Real.log 2 := Real.log_pos (by norm_num)
      have hnonneg : 0 ≤ (2 / Real.log 2) * Real.log x := by positivity
      calc
        ((bins g).card : ℝ) ≤ 2 * Real.log x / Real.log 2 + 1 := hcard.trans hbudget
        _ = (2 / Real.log 2) * Real.log x + 1 := by ring
        _ ≤ (2 / Real.log 2) * Real.log x + Real.log x := add_le_add_right hlog1 _
        _ ≤ 2 * ((2 / Real.log 2) * Real.log x + Real.log x) := by
          linarith only [hnonneg, hlog0.le]
        _ = Bcount * Real.log x := by dsimp only [Bcount]; ring
    have hShells (g : ℕ) (hg : g ∈ G) : (shells g : ℝ) ≤ Bcount * Real.log x := by
      have hupper := (opening_frequency_cutoff_power_bounds x ε M R Q g
        hxtwo hεone hMone hR.le hQ.le
        hRx hQx (hGdata g hg).1).1
      have hupperReal : H g ≤ x ^ (4 : ℝ) := by
        simpa only [H, Real.rpow_ofNat] using hupper
      simpa only [shells, Bcount] using opening_padded_count x (H g) hxexp hupperReal
    let Ebase : ℝ := M * N ^ 2 / R * (Real.log x) ^ (-D)
    have hEbase : 0 ≤ Ebase := by dsimp only [Ebase]; positivity
    have hSwitch (q : ℕ) (hq : Nat.Coprime (a * b₁ * b₂) q)
        (b : ℕ) (hb : b ∈ ({b₁, b₂} : Finset ℕ))
        (b' : ℕ) (hb' : b' ∈ ({b₁, b₂} : Finset ℕ)) :
        Nat.Coprime (a * b * b') q := by
      have ha : Nat.Coprime a q := hq.coprime_mul_right.coprime_mul_right
      have h₁ : Nat.Coprime b₁ q := hq.coprime_mul_right.coprime_mul_left
      have h₂ : Nat.Coprime b₂ q := hq.coprime_mul_left
      have hside (z : ℕ) (hz : z ∈ ({b₁, b₂} : Finset ℕ)) : Nat.Coprime z q := by
        simp only [Finset.mem_insert, Finset.mem_singleton] at hz
        rcases hz with rfl | rfl
        · exact h₁
        · exact h₂
      exact (ha.mul_left (hside b hb)).mul_left (hside b' hb')
    have hOffDiagonalBound (c : ℕ × ℕ → ℂ)
        (hc : ∀ p ∈ S, ‖c p‖ ≤ 1)
        (b : ℕ) (hb : b ∈ ({b₁, b₂} : Finset ℕ))
        (b' : ℕ) (hb' : b' ∈ ({b₁, b₂} : Finset ℕ)) :
        ‖∑ r ∈ S.image Prod.snd,
          ∑ p₁ ∈ S.filter (fun p => p.2 = r),
            ∑ p₂ ∈ S.filter (fun p => p.2 = r),
              c p₁ * star (c p₂) *
                ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                  if n₁ = n₂ then 0 else
                    β n₁ * star (β n₂) *
                      ∑ h ∈ J (Nat.gcd p₁.1 p₂.1),
                        mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b b' n₁ n₂
                          ((h : ZMod (r * Nat.lcm p₁.1 p₂.1)).val)‖ ≤ Ebase := by
      clear htailAt hzeroAt hdiagonalAt hαmoment
      have hprimSides : ∀ p ∈ S, Nat.Coprime (a * b * b') (p.1 * p.2) :=
        fun p hp => hSwitch _ (hprim p hp) b hb b' hb'
      let F : ℕ → ℤ → Finset (ℕ × ℕ × ℕ × ℕ) → Finset ℤ → ℂ :=
        fun g ℓ B J' =>
          ∑ t ∈ B,
            c (g * t.2.1 * t.2.2.1, t.1) * star (c (g * t.2.2.2, t.1)) *
              ((M : ℂ) / ((t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2 : ℕ) : ℂ)) *
                ∑ n ∈ γβ.support.filter (fun n =>
                  Int.gcd n ((t.1 * g * t.2.1 * t.2.2.1 : ℕ) : ℤ) = 1 ∧
                  Int.gcd (n + ℓ * (t.1 : ℤ)) ((g * t.2.2.2 : ℕ) : ℤ) = 1),
                  γβ n * star (γβ (n + ℓ * (t.1 : ℤ))) *
                    (sourceCompatibility t.1 g b b' ℓ n : ℂ) *
                      ∑ h ∈ J', sourcePhi ψM M
                        (t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2) h *
                          sourceTheta t.1 g t.2.1 t.2.2.1 t.2.2.2 a b b' ℓ n h
      let Jpos : ℕ → Finset ℤ := fun j =>
        Finset.Ico ((2 : ℤ) ^ j) ((2 : ℤ) ^ (j + 1))
      let Jneg : ℕ → Finset ℤ := fun j =>
        Finset.Ioc (-((2 : ℤ) ^ (j + 1))) (-((2 : ℤ) ^ j))
      let Fband : ℕ → ℤ → ℕ → ℕ → Bool → ℂ := fun g ℓ i j side =>
        F g ℓ (block g ℓ i) (if side then Jneg j else Jpos j)
      have hPoint : ∀ g ∈ G, ∀ ℓ ∈ (Finset.Icc (-(LI : ℤ)) (LI : ℤ)).erase 0,
          ∀ i ∈ bins g, ∀ j ∈ Finset.range (shells g), ∀ side : Bool,
            ‖Fband g ℓ i j side‖ ≤
              Kband * M * N * (Int.gcd (g : ℤ) ℓ : ℝ) / (g : ℝ) *
                x ^ (-ε / 4) := by
        intro g hg ℓ _hℓ i _hi j hj side
        have hgpos : 0 < g := (hGdata g hg).1
        by_cases hempty : block g ℓ i = ∅
        · simp only [Fband, F, hempty, Finset.sum_empty, norm_zero]
          positivity
        have hHone : 1 ≤ H g := by
          by_contra hbad
          have hsmallH : H g < 1 := lt_of_not_ge hbad
          simp [shells, hsmallH] at hj
        have hBlockGpos : 0 < (g : ℝ) := by exact_mod_cast hgpos
        have hBlockHpos : 0 < H g := zero_lt_one.trans_le hHone
        have hBlockTwo : (2 : ℝ) ≤ C₀ := (by norm_num : (2 : ℝ) ≤ 4).trans hC₀four
        have hPhase : ∀ t ∈ block g ℓ i,
            ‖c (g * t.2.1 * t.2.2.1, t.1)‖ ≤ 1 ∧
            ‖c (g * t.2.2.2, t.1)‖ ≤ 1 := by
          intro t ht
          obtain ⟨_, _, _, _, hp₁, hp₂, _, _, _, _⟩ :=
            (hfactor.1 g hg).2 t (Finset.mem_filter.mp ht).1
          exact ⟨hc _ hp₁, hc _ hp₂⟩
        have hPrimitive : ∀ t ∈ block g ℓ i, Nat.Coprime a t.1 := by
          intro t ht
          obtain ⟨_, _, _, _, hp₁, _, _, _, _, _⟩ :=
            (hfactor.1 g hg).2 t (Finset.mem_filter.mp ht).1
          have hp := hprimSides _ hp₁
          exact hp.coprime_mul_right.coprime_mul_right.of_dvd_right (dvd_mul_left _ _)
        have hbg : Nat.Coprime b g :=
          (hSwitch _ (hGdata g hg).2.2.2.1 b hb b' hb').coprime_mul_right.coprime_mul_left
        have hβCarrier : β.support ⊆ Finset.Icc 1 ⌊C₀ * N⌋₊ := by
          intro n hn
          refine Finset.mem_Icc.mpr ⟨hβpos n hn, Nat.le_floor ?_⟩
          exact (hβ n hn).2.1.trans (mul_le_mul_of_nonneg_right
            (by linarith only [hTN₀, hTNpos]) hN.le)
        have hβBound : ∀ n ∈ β.support, ‖β n‖ ≤ x ^ (ε / 100) := by
          intro n hn
          exact (hβ n hn).2.2.trans (hbetaAt n (hβpos n hn)
            ((hβ n hn).2.1.trans (mul_le_mul_of_nonneg_left hNx hTNpos.le)))
        have hβMajor : ∀ n ∈ β.support, 1 ≤ ψN (((n : ℝ) - 0) / N) := by
          intro n hn
          simpa only [sub_zero] using hψNmajor n hn
        have hjShell : j ∈ Finset.range (Nat.log 2 ⌊H g⌋₊ + 1) := by
          simpa only [shells, ite_eq_right (not_lt_of_ge hHone)] using hj
        have hShellWindow : 1 ≤ (2 : ℝ) ^ j ∧ (2 : ℝ) ^ j ≤ H g :=
          (padded_dyadic_cutoff_bounds (H g) hHone).2.2.2.2.2.2 j hjShell
        have hShellUpper : (2 : ℝ) ^ (j + 1) ≤ 2 * H g := by
          calc
            (2 : ℝ) ^ (j + 1) = 2 * (2 : ℝ) ^ j := by rw [pow_succ, mul_comm]
            _ ≤ 2 * H g := mul_le_mul_of_nonneg_left hShellWindow.2 zero_le_two
        have hJband : ∀ h ∈ (if side then Jneg j else Jpos j),
            h ≠ 0 ∧ |(h : ℝ)| ≤ 2 * H g := by
          intro h hh
          cases side with
          | false =>
            change h ∈ Finset.Ico ((2 : ℤ) ^ j) ((2 : ℤ) ^ (j + 1)) at hh
            have hmem := Finset.mem_Ico.mp hh
            have hpos : 0 < h := (pow_pos (by norm_num : (0 : ℤ) < 2) j).trans_le hmem.1
            refine ⟨ne_of_gt hpos, ?_⟩
            have hreal : (h : ℝ) < (2 : ℝ) ^ (j + 1) := by exact_mod_cast hmem.2
            have hrealpos : 0 ≤ (h : ℝ) := by exact_mod_cast hpos.le
            rw [abs_of_nonneg hrealpos]
            exact hreal.le.trans hShellUpper
          | true =>
            change h ∈ Finset.Ioc (-((2 : ℤ) ^ (j + 1))) (-((2 : ℤ) ^ j)) at hh
            have hmem := Finset.mem_Ioc.mp hh
            have hneg : h < 0 := hmem.2.trans_lt
              (neg_lt_zero.mpr (pow_pos (by norm_num : (0 : ℤ) < 2) j))
            refine ⟨ne_of_lt hneg, ?_⟩
            have hreal : -((2 : ℝ) ^ (j + 1)) < (h : ℝ) := by exact_mod_cast hmem.1
            have hrealneg : (h : ℝ) ≤ 0 := by exact_mod_cast hneg.le
            rw [abs_of_nonpos hrealneg]
            exact (show -(h : ℝ) ≤ (2 : ℝ) ^ (j + 1) by linarith only [hreal]).trans
              hShellUpper
        have hKbound (K : ℝ) (hK : K ≤ Kband) :
            K * M * N * (Int.gcd (g : ℤ) ℓ : ℝ) / (g : ℝ) * x ^ (-ε / 4) ≤
              Kband * M * N * (Int.gcd (g : ℤ) ℓ : ℝ) / (g : ℝ) * x ^ (-ε / 4) :=
          mul_le_mul_of_nonneg_right
            (div_le_div_of_nonneg_right
              (mul_le_mul_of_nonneg_right
                (mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_right hK hM.le) hN.le)
                (Nat.cast_nonneg _)) hBlockGpos.le)
            (Real.rpow_nonneg hx0.le _)
        by_cases hcut : γ ≤ 1 / 2 - 2 * «ω» - c₀
        · let U : ℝ := (2 : ℝ) ^ i
          let V : ℝ := Q / ((g : ℝ) * U)
          have hU : 0 < U := by dsimp only [U]; positivity
          have hV : 0 < V := by dsimp only [V]; positivity
          have hFamily : ∀ t ∈ block g ℓ i,
              0 < t.1 ∧ 0 < t.2.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
              Squarefree (t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2) ∧
              R ≤ (t.1 : ℝ) ∧ (t.1 : ℝ) ≤ 2 * R ∧
              Q ≤ ((g * t.2.1 * t.2.2.1 : ℕ) : ℝ) ∧
              ((g * t.2.1 * t.2.2.1 : ℕ) : ℝ) ≤ 2 * Q ∧
              Q ≤ ((g * t.2.2.2 : ℕ) : ℝ) ∧
              ((g * t.2.2.2 : ℕ) : ℝ) ≤ 2 * Q := by
            intro t ht
            have htA : t ∈ 𝒜 g := (Finset.mem_filter.mp ht).1
            obtain ⟨hrt, htu, htv, htq, htS₁, htS₂, _, _, hsf, _⟩ :=
              (hfactor.1 g hg).2 t htA
            obtain ⟨_, _, _, hq₁lo, hq₁hi, hrlo, hrhi, _, _, _⟩ := hS _ htS₁
            obtain ⟨_, _, _, hq₂lo, hq₂hi, _, _, _, _, _⟩ := hS _ htS₂
            exact ⟨hrt, htu, htv, htq, hsf, hrlo, hrhi, hq₁lo, hq₁hi, hq₂lo, hq₂hi⟩
          have hUnit (hj₁ : j₀ = 1) (t : ℕ × ℕ × ℕ × ℕ) (ht : t ∈ block g ℓ i) :
              t.2.1 = 1 := by
            have htA : t ∈ 𝒜 g := (Finset.mem_filter.mp ht).1
            obtain ⟨p, _, rfl⟩ := Finset.mem_image.mp htA
            have huse : ¬ (j₀ = 2 ∧ γ ≤ 1 / 2 - 2 * «ω» - c₀ ∧ 1 ≤ H g) := by
              intro h
              omega
            simp only [u, ite_eq_right huse]
          have hGeometry (hj₂ : j₀ = 2) :
              U * V ≤ C₀ * Q / (g : ℝ) ∧
              x ^ (5 * ε) * H g / (g : ℝ) ≤ C₀ * V ∧
              V ≤ C₀ * x ^ (δ + 5 * ε) * H g ∧
              ∀ t ∈ block g ℓ i, (t.2.1 : ℝ) ≤ C₀ * U ∧
                (t.2.2.1 : ℝ) ≤ C₀ * V := by
            have hTupleGeometry (t : ℕ × ℕ × ℕ × ℕ) (ht : t ∈ block g ℓ i) :
                0 < U ∧ 0 < V ∧ U * V = Q / (g : ℝ) ∧
                U ≤ (t.2.1 : ℝ) ∧ (t.2.1 : ℝ) ≤ 2 * U ∧
                V / 2 ≤ (t.2.2.1 : ℝ) ∧ (t.2.2.1 : ℝ) ≤ 2 * V ∧
                x ^ (-δ - 5 * ε) * Q / ((g : ℝ) * H g) ≤ 2 * U ∧
                U ≤ x ^ (-5 * ε) * Q / H g ∧
                x ^ (5 * ε) * H g / (g : ℝ) ≤ V ∧
                V ≤ 2 * x ^ (δ + 5 * ε) * H g := by
              have htA : t ∈ 𝒜 g := (Finset.mem_filter.mp ht).1
              have htbin : Nat.log 2 t.2.1 = i := (Finset.mem_filter.mp ht).2.2
              obtain ⟨_, htu, _, _, htS, _, _, _, _, _⟩ := (hfactor.1 g hg).2 t htA
              have huLo : U ≤ (t.2.1 : ℝ) := by
                have hn : 2 ^ i ≤ t.2.1 := by
                  simpa only [htbin] using Nat.pow_log_le_self 2 htu.ne'
                dsimp only [U]
                exact_mod_cast hn
              have huHi : (t.2.1 : ℝ) < 2 * U := by
                have hn : t.2.1 < 2 ^ (i + 1) := by
                  simpa only [htbin] using
                    Nat.lt_pow_succ_log_self (by norm_num : 1 < (2 : ℕ)) t.2.1
                have hr : (t.2.1 : ℝ) < (2 : ℝ) ^ (i + 1) := by exact_mod_cast hn
                simpa only [U, pow_succ, mul_comm] using hr
              obtain ⟨_, _, _, hqLo, hqHi, _, _, _, _, _⟩ := hS _ htS
              have hselection := hSelected g hg hj₂ hcut hHone t htA
              exact opening_one_bin_geometry x δ ε Q (H g) U g t.2.1 t.2.2.1
                hx1 hQ hBlockHpos hU hgpos huLo huHi.le
                (by simpa only [Nat.cast_mul] using hqLo)
                (by simpa only [Nat.cast_mul] using hqHi) hselection.1 hselection.2
            obtain ⟨t₀, ht₀⟩ := Finset.nonempty_iff_ne_empty.mpr hempty
            obtain ⟨_, _, hUV, _, _, _, _, _, _, hVloOne, hVhiTwo⟩ :=
              hTupleGeometry t₀ ht₀
            refine ⟨?_, hVloOne.trans (le_mul_of_one_le_left hV.le hC₀), ?_, ?_⟩
            · rw [hUV]
              exact div_le_div_of_nonneg_right (le_mul_of_one_le_left hQ.le hC₀)
                hBlockGpos.le
            · exact hVhiTwo.trans (mul_le_mul_of_nonneg_right
                (mul_le_mul_of_nonneg_right hBlockTwo (Real.rpow_nonneg hx0.le _))
                hBlockHpos.le)
            · intro t ht
              obtain ⟨_, _, _, _, huHi, _, hvHi, _, _, _, _⟩ := hTupleGeometry t ht
              exact ⟨huHi.trans (mul_le_mul_of_nonneg_right hBlockTwo hU.le),
                hvHi.trans (mul_le_mul_of_nonneg_right hBlockTwo hV.le)⟩
          have hDense : ∀ t ∈ block g ℓ i,
              Nonempty (DenseDivisibilityWitness
                Y 1 (t.1 * g * t.2.1 * t.2.2.1)) ∧
              Nonempty (DenseDivisibilityWitness
                Y 1 (t.1 * g * t.2.2.2)) := by
            intro t ht
            obtain ⟨_, _, _, _, htS₁, htS₂, _, _, _, _⟩ :=
              (hfactor.1 g hg).2 t (Finset.mem_filter.mp ht).1
            obtain ⟨_, _, _, _, _, _, _, _, hd₁, _⟩ := hS _ htS₁
            obtain ⟨_, _, _, _, _, _, _, _, hd₂, _⟩ := hS _ htS₂
            have hprod₁ : (g * t.2.1 * t.2.2.1) * t.1 = t.1 * g * t.2.1 * t.2.2.1 := by ring
            have hprod₂ : (g * t.2.2.2) * t.1 = t.1 * g * t.2.2.2 := by ring
            exact ⟨by simpa only [hprod₁] using hd₁, by simpa only [hprod₂] using hd₂⟩
          have hYbound : (Y : ℝ) ≤ x ^ δ :=
            max_le (Real.one_le_rpow hx1 hδ.le) le_rfl
          have hraw := hSplitAt x ((le_max_right Xnear Xsplit).trans hxband)
            M N R Q (H g) U V γ hM hN hR hQ hU hV
            hMNlo₀ hNγ hNR hRhi hRQhi hγlo hcut
            g a b b' hgpos rfl hHone Y hYbound
            (block g ℓ i) (if side then Jneg j else Jpos j)
            hFamily hUnit hGeometry hDense hJband hPrimitive hbg c hPhase ℓ 0 ψM ψN
            hsM hMbound hψN1 hsNsym hNnonneg hNbound β hβCarrier hβBound hβMajor
          dsimp only at hraw
          dsimp only [Fband, F]
          exact (norm_sum_le _ _).trans (hraw.trans (hKbound Ksplit hSplitK))
        · have hunit (t : ℕ × ℕ × ℕ × ℕ) (ht : t ∈ block g ℓ i) : t.2.1 = 1 := by
            have htA : t ∈ 𝒜 g := (Finset.mem_filter.mp ht).1
            obtain ⟨p, _, rfl⟩ := Finset.mem_image.mp htA
            have huse : ¬ (j₀ = 2 ∧ γ ≤ 1 / 2 - 2 * «ω» - c₀ ∧ 1 ≤ H g) :=
              fun h => hcut h.2.1
            simp only [u, ite_eq_right huse]
          have hFamily : ∀ t ∈ block g ℓ i,
              t.2.1 = 1 ∧ 0 < t.1 ∧ 0 < t.2.2.1 ∧ 0 < t.2.2.2 ∧
              Squarefree (t.1 * g * t.2.1 * t.2.2.1 * t.2.2.2) ∧
              R ≤ (t.1 : ℝ) ∧ (t.1 : ℝ) ≤ 2 * R ∧
              Q ≤ ((g * t.2.2.1 : ℕ) : ℝ) ∧
              ((g * t.2.2.1 : ℕ) : ℝ) ≤ 2 * Q ∧
              Q ≤ ((g * t.2.2.2 : ℕ) : ℝ) ∧
              ((g * t.2.2.2 : ℕ) : ℝ) ≤ 2 * Q := by
            intro t ht
            have htA : t ∈ 𝒜 g := (Finset.mem_filter.mp ht).1
            obtain ⟨hrt, _, htv, htq, htS₁, htS₂, _, _, hsf, _⟩ :=
              (hfactor.1 g hg).2 t htA
            obtain ⟨_, _, _, hq₁lo, hq₁hi, hrlo, hrhi, _, _, _⟩ := hS _ htS₁
            obtain ⟨_, _, _, hq₂lo, hq₂hi, _, _, _, _, _⟩ := hS _ htS₂
            refine ⟨hunit t ht, hrt, htv, htq, hsf, hrlo, hrhi, ?_, ?_, hq₂lo, hq₂hi⟩
            · simpa only [hunit t ht, Nat.mul_one] using hq₁lo
            · simpa only [hunit t ht, Nat.mul_one] using hq₁hi
          have hraw := hNearAt x ((le_max_left Xnear Xsplit).trans hxband)
            M N R Q (H g) γ hM hN hR hQ hMNlo₀ hNγ hNR hRhi hRQhi
            (le_of_not_ge hcut) hγhi g a b b' rfl hHone
            (block g ℓ i) (if side then Jneg j else Jpos j)
            hFamily hJband hPrimitive hbg c hPhase ℓ 0 ψM ψN
            hsM hMbound hψN1 hsNsym hNnonneg hNbound β hβCarrier hβBound hβMajor
          dsimp only at hraw
          dsimp only [Fband, F]
          have hweaken :
              Knear * M * N * (Int.gcd (g : ℤ) ℓ : ℝ) / (g : ℝ) * x ^ (-ε / 2) ≤
                Knear * M * N * (Int.gcd (g : ℤ) ℓ : ℝ) / (g : ℝ) * x ^ (-ε / 4) :=
            mul_le_mul_of_nonneg_left
              (Real.rpow_le_rpow_of_exponent_le hx1 (by linarith only [hε]))
              (by positivity)
          exact (norm_sum_le _ _).trans (hraw.trans (hweaken.trans (hKbound Knear hNearK)))
      have htwoQ : 2 * Q ≤ x ^ 2 := by
        calc
          2 * Q ≤ 2 * x := mul_le_mul_of_nonneg_left hQx (by norm_num)
          _ ≤ x * x := mul_le_mul_of_nonneg_right hxtwo hx0.le
          _ = x ^ 2 := (pow_two x).symm
      have hQI : (⌊2 * Q⌋₊ : ℝ) ≤ x ^ 2 :=
        (Nat.floor_le (by positivity : 0 ≤ 2 * Q)).trans htwoQ
      have hGI : ∀ g ∈ G, 0 < g ∧ g ≤ ⌊2 * Q⌋₊ :=
        fun g hg => ⟨(hGdata g hg).1, Nat.le_floor (hGdata g hg).2.2.1⟩
      have hLI : (LI : ℝ) ≤ (2 * TN) * N / R := Nat.floor_le (by positivity)
      have hsum := opening_summed_bands x (ε / 6) Kband Bcount (2 * TN) M N R
        hxexp hKband.le hBcount.le (by positivity) hM.le hN.le hR
        G ⌊2 * Q⌋₊ LI bins shells Fband hGI hQI hLI hBins hShells (by
          simpa only [show -3 * (ε / 6) / 2 = -ε / 4 by ring] using hPoint)
      have hsplit := opening_off_diagonal_split (cM / 2) (2 * TM) M
        (by positivity) hMinterval hM ψM hsM S β c a b b' shells u
        hSsimple hprimSides hu Lall hLall
      have hLogProduct :
          (Real.log x) ^ (4 + D) * (Real.log x) ^ (-D) = (Real.log x) ^ 4 := by
        rw [← Real.rpow_add hlog0, show (4 + D) + (-D) = (4 : ℝ) by ring]
        norm_num
      have hXProduct : x ^ (ε / 4) * x ^ (-ε / 4) = 1 := by
        rw [← Real.rpow_add hx0, show ε / 4 + (-ε / 4) = 0 by ring,
          Real.rpow_zero]
      have hOffScalar :
          Koff * (Real.log x) ^ 4 * x ^ (-ε / 4) ≤ (Real.log x) ^ (-D) := by
        calc
          _ = (Koff * (Real.log x) ^ (4 + D)) *
              ((Real.log x) ^ (-D) * x ^ (-ε / 4)) := by
            calc
              _ = Koff * ((Real.log x) ^ (4 + D) * (Real.log x) ^ (-D)) *
                  x ^ (-ε / 4) := by rw [hLogProduct]
              _ = _ := by ring
          _ ≤ x ^ (ε / 4) *
              ((Real.log x) ^ (-D) * x ^ (-ε / 4)) :=
            mul_le_mul_of_nonneg_right hoffAbsorb (by positivity)
          _ = (Real.log x) ^ (-D) := by
            calc
              _ = (Real.log x) ^ (-D) *
                  (x ^ (ε / 4) * x ^ (-ε / 4)) := by ring
              _ = _ := by rw [hXProduct, mul_one]
      calc
        _ ≤ ∑ g ∈ G, ∑ ℓ ∈ Lall, ∑ i ∈ bins g, ∑ j ∈ Finset.range (shells g),
            (‖F g ℓ (block g ℓ i) (Jpos j)‖ +
              ‖F g ℓ (block g ℓ i) (Jneg j)‖) := hsplit
        _ ≤ 36 * Kband * Bcount ^ 2 * (2 * TN) * (M * N ^ 2 / R) *
            (Real.log x) ^ 4 * x ^ (-ε / 4) := by
          simpa only [Fband, Bool.false_eq_true, ↓reduceIte,
            show -3 * (ε / 6) / 2 = -ε / 4 by ring] using hsum
        _ = (M * N ^ 2 / R) *
            (Koff * (Real.log x) ^ 4 * x ^ (-ε / 4)) := by
          dsimp only [Koff]
          ring
        _ ≤ (M * N ^ 2 / R) * (Real.log x) ^ (-D) :=
          mul_le_mul_of_nonneg_left hOffScalar (by positivity)
        _ = Ebase := rfl
    clear hNearAt hSplitAt hfactor hSelected hGdata hLall hBins hShells hu hu₀ hXwindow hψNmajor
    have hbaseOne : 1 ≤ M * N ^ 2 / R := by
      have hRsmall : R ≤ C₀ * N := hRhi₀.trans (by
        have hpow := Real.rpow_le_one_of_one_le_of_nonpos hx1
          (show -2 * ε ≤ 0 by linarith only [hε])
        simpa only [mul_one] using mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left hpow hC₀pos.le) hN.le)
      have hMNbig : C₀ ≤ M * N := by
        calc
          C₀ = C₀ ^ 2 / C₀ := by field_simp
          _ ≤ x / C₀ := div_le_div_of_nonneg_right hC₀square hC₀pos.le
          _ ≤ M * N := hMNlo₀
      apply (le_div_iff₀ hR).mpr
      calc
        1 * R = R := one_mul R
        _ ≤ C₀ * N := hRsmall
        _ ≤ (M * N) * N := mul_le_mul_of_nonneg_right hMNbig hN.le
        _ = M * N ^ 2 := by ring
    have hTailSmall : x ^ (-1 : ℝ) ≤ Ebase := by
      have hlogpower : (Real.log x) ^ D ≤ x := by
        simpa only [one_mul, Real.rpow_one] using htailAbsorb
      have hinv := inv_anti₀ (Real.rpow_pos_of_pos hlog0 D) hlogpower
      calc
        x ^ (-1 : ℝ) ≤ (Real.log x) ^ (-D) := by
          simpa only [Real.rpow_neg_one, Real.rpow_neg hlog0.le] using hinv
        _ ≤ M * N ^ 2 / R * (Real.log x) ^ (-D) :=
          le_mul_of_one_le_left (Real.rpow_nonneg hlog0.le _) hbaseOne
    have hRlower : x ^ (-δ₀ - 4 * ε) * N / C₀ ≤ R := by
      calc
        x ^ (-δ₀ - 4 * ε) * N / C₀ = N / (C₀ * x ^ (δ₀ + 4 * ε)) := by
          rw [show -δ₀ - 4 * ε = -(δ₀ + 4 * ε) by ring, Real.rpow_neg hx0.le]
          ring_nf
        _ ≤ R := (div_le_iff₀ (mul_pos hC₀pos (Real.rpow_pos_of_pos hx0 _))).mpr
          (by simpa only [mul_comm, mul_left_comm, mul_assoc] using hNR₀)
    have hScales : ∀ p ∈ S, 0 < p.1 ∧ 0 < p.2 ∧ Nat.Coprime p.1 p.2 ∧
        Q ≤ (p.1 : ℝ) ∧ (p.1 : ℝ) ≤ 2 * Q ∧
        R ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ 2 * R ∧
        (p.1 : ℝ) ≤ x ^ (2 : ℝ) ∧ (p.2 : ℝ) ≤ x ^ (2 : ℝ) := by
      intro p hp
      obtain ⟨hq, hr, _, hqlo, hqhi, hrlo, hrhi, _, _, _⟩ := hS p hp
      have hQ2 : 2 * Q ≤ x ^ 2 := by nlinarith only [hQx, hxtwo]
      have hR2 : 2 * R ≤ x ^ 2 := by nlinarith only [hRx, hxtwo]
      exact ⟨hq, hr, hScoprime p hp, hqlo, hqhi, hrlo, hrhi,
        by simpa only [Real.rpow_two] using hqhi.trans hQ2,
        by simpa only [Real.rpow_two] using hrhi.trans hR2⟩
    have hEnergy : ∀ c : ℕ × ℕ → ℂ, (∀ p ∈ S, ‖c p‖ = 1) →
        dispersionEnergy sm w S β c a b₁ b₂ ≤ 13 * Ebase := by
      intro c hc
      have hc' : ∀ p ∈ S, ‖c p‖ ≤ 1 := fun p hp => (hc p hp).le
      let Dcorr : ℕ → ℕ → ℂ := fun b b' =>
        ∑ r ∈ S.image Prod.snd,
          ∑ p₁ ∈ S.filter (fun p => p.2 = r),
            ∑ p₂ ∈ S.filter (fun p => p.2 = r),
              c p₁ * star (c p₂) *
                ∑ n ∈ β.support, β n * star (β n) *
                  (mixedFiberMass sm w p₁.1 p₂.1 r a b b' n n : ℂ)
      let Ocorr : ℕ → ℕ → ℂ := fun b b' =>
        ∑ r ∈ S.image Prod.snd,
          ∑ p₁ ∈ S.filter (fun p => p.2 = r),
            ∑ p₂ ∈ S.filter (fun p => p.2 = r),
              c p₁ * star (c p₂) *
                ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                  if n₁ = n₂ then 0 else β n₁ * star (β n₂) *
                    ∑ h ∈ J (Nat.gcd p₁.1 p₂.1),
                      mixedFiberFourierCoefficient sm w p₁.1 p₂.1 r a b b' n₁ n₂
                        ((h : ZMod (r * Nat.lcm p₁.1 p₂.1)).val)
      apply opening_four_energy sm w S β c a b₁ b₂ Ebase Dcorr Ocorr
      · intro b hb b' hb'
        have hprimitive : ∀ p ∈ S, Nat.Coprime (a * b * b') (p.1 * p.2) :=
          fun p hp => hSwitch _ (hprim p hp) b hb b' hb'
        have htail := htailAt S β c NI M Q R hM hQ hR hβsupport hNIx
          (fun n hn => (hβ n hn).2.2) hc' hScales a b b' hprimitive ψM hψM hsM
          (by
            intro t
            simp only [Real.rpow_zero, mul_one]
            exact ⟨by simpa only [iteratedDeriv_zero] using
              (hCMbound 0 t).trans (le_max_left _ _),
              (hCMbound (k + 2) t).trans (le_max_right _ _)⟩) hMshort
        let V : ℕ → ℕ → ℕ → ℕ → ℕ → ℂ := fun r q₁ q₂ n₁ n₂ =>
          if n₁ = n₂ then (mixedFiberMass sm w q₁ q₂ r a b b' n₁ n₂ : ℂ)
          else mixedFiberFourierCoefficient sm w q₁ q₂ r a b b' n₁ n₂ 0 +
            ∑ h ∈ J (Nat.gcd q₁ q₂),
              mixedFiberFourierCoefficient sm w q₁ q₂ r a b b' n₁ n₂
                ((h : ZMod (r * Nat.lcm q₁ q₂)).val)
        have htail' :
            ‖mixedCorrelation sm w S β c a b b' -
                (∑ r ∈ S.image Prod.snd,
                  ∑ p₁ ∈ S.filter (fun p => p.2 = r),
                    ∑ p₂ ∈ S.filter (fun p => p.2 = r),
                      c p₁ * star (c p₂) *
                        ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                          β n₁ * star (β n₂) * V r p₁.1 p₂.1 n₁ n₂)‖ ≤ x ^ (-1 : ℝ) := by
          clear * - htail
          simpa only [opening_padded_window, V, J, shells, H, sm, w] using htail
        have hidentity := opening_truncated_identity sm w S β c a b b' J
        change
          (∑ r ∈ S.image Prod.snd,
            ∑ p₁ ∈ S.filter (fun p => p.2 = r),
              ∑ p₂ ∈ S.filter (fun p => p.2 = r),
                c p₁ * star (c p₂) *
                  ∑ n₁ ∈ β.support, ∑ n₂ ∈ β.support,
                    β n₁ * star (β n₂) * V r p₁.1 p₂.1 n₁ n₂) =
            Dcorr b b' + offDiagonalZeroMode sm w S β c a b b' + Ocorr b b' at hidentity
        rw [hidentity] at htail'
        refine ⟨htail'.trans hTailSmall, ?_, hOffDiagonalBound c hc' b hb b' hb'⟩
        have hdiag := hdiagonalAt γ M Q R NI hγdiagonal hγhi hM hQ hR
          (by simpa only [← hNγ] using hMNlo₀)
          (by simpa only [← hNγ] using hMNhi₀)
          (by simpa only [← hNγ] using hRlower)
          (by simpa only [← hNγ] using hRhi₀) hRQhi₀
          (by simpa only [← hNγ] using hNIscale) S β c hβsupport
          (fun n hn => (hβ n hn).2.2) hc'
          (fun p hp => by
            obtain ⟨hq, hr, hcp, hqlo, hqhi, hrlo, hrhi, _, _⟩ := hScales p hp
            exact ⟨hq, hr, hcp, hqlo, hqhi, hrlo, hrhi⟩)
          a b b' ψM (by
            intro t
            simpa only [Real.rpow_zero, mul_one, iteratedDeriv_zero, Real.norm_eq_abs]
              using hCMbound 0 t)
        calc
          ‖Dcorr b b'‖ ≤
              ∑ r ∈ S.image Prod.snd,
                ∑ p₁ ∈ S.filter (fun p => p.2 = r),
                  ∑ p₂ ∈ S.filter (fun p => p.2 = r),
                    ‖c p₁ * star (c p₂) *
                      (∑ n ∈ β.support, β n * star (β n) *
                        (mixedFiberMass sm w p₁.1 p₂.1 r a b b' n n : ℂ))‖ := by
            dsimp only [Dcorr]
            apply norm_sum_le_of_le
            intro r _
            apply norm_sum_le_of_le
            intro p₁ _
            exact norm_sum_le _ _
          _ ≤ Ebase := by simpa only [← hNγ, sm, w, Ebase] using hdiag
      · have hRhiC : R ≤ C * x ^ (-2 * ε) * N := hRhi.trans (by
          calc
            x ^ (-4 * ε) * N ≤ x ^ (-2 * ε) * N := mul_le_mul_of_nonneg_right
              (Real.rpow_le_rpow_of_exponent_le hx1 (by linarith only [hε])) hN.le
            _ ≤ C * (x ^ (-2 * ε) * N) := le_mul_of_one_le_left (by positivity) hC
            _ = _ := by ring)
        have hz := hzeroAt M N R Q hM hN hR hQ hMone hNx hQx hRhiC
          sm S β c a b₁ b₂
          (fun n hn => ⟨hβpos n hn, (hβ n hn).2.1, (hβ n hn).2.2⟩) hc'
          (fun p hp => by
            obtain ⟨hq, hr, hcp, _, hqhi, hrlo, hrhi, _, _⟩ := hScales p hp
            exact ⟨hq, hr, hcp, hrlo, hrhi, hqhi⟩)
          hprim (fun p hp => (hS p hp).2.2.2.2.2.2.2.2.2)
        exact hz
    clear hOffDiagonalBound htailAt hzeroAt hdiagonalAt
    have hCauchy := opening_final_cauchy α β S sm w a b₁ b₂ R (13 * Ebase) hR
      (mul_nonneg (by norm_num) hEbase)
      (fun p hp => by
        obtain ⟨hq, hr, _, _, _, _, hrhi, _, _, _⟩ := hS p hp
        exact ⟨hq, hr, hrhi⟩) hprim hsm hw0 hw1 hEnergy
    refine opening_cauchy_logarithmic_absorption
      hM hN hR hKα hη hlog1
      ((le_max_right _ _).trans ((le_max_right _ _).trans hxlarge))
      (Finset.sum_nonneg fun _ _ => norm_nonneg _) hαmoment ?_
    simpa only [Ebase, D] using hCauchy
  obtain ⟨X₀, hX₀⟩ := hmain.exists_forall_of_atTop
  refine ⟨max (Real.exp 1) X₀, le_max_left _ _, ?_⟩
  intro x hx
  exact hX₀ x ((le_max_right _ _).trans hx)

end

section
open scoped ContDiff

open scoped Classical in
theorem sourceTypeI_II_lowerOrder_dense_uniform_log_saving
    (j : ℕ) («ω» δ σ : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hσ : 0 < σ)
    (hI : (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1))
    (hII : 68 * «ω» + 14 * δ < 1)
    {ι : Type*} (M N : ℝ → ι → ℝ) (α β : ℝ → ι → ℕ →₀ ℂ)
    (c C W X₀ : ℝ) (k s : ℕ)
    (hc : 0 < c) (hCscale : 1 ≤ C) (hW : 0 ≤ W) (hX₀ : Real.exp 1 ≤ X₀)
    (hscale : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι,
      x / C ≤ M x i * N x i ∧ M x i * N x i ≤ C * x ∧
      x ^ (1 / 2 - σ) ≤ N x i ∧ N x i ≤ x ^ (1 / 2 : ℝ))
    (hsupport : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι,
      (∀ n ∈ (α x i).support,
        c * M x i ≤ (n : ℝ) ∧ (n : ℝ) ≤ C * M x i) ∧
      (∀ n ∈ (β x i).support,
        c * N x i ≤ (n : ℝ) ∧ (n : ℝ) ≤ C * N x i))
    (hcoeff : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι, ∀ n : ℕ,
      ‖α x i n‖ ≤ W * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ k ∧
      ‖β x i n‖ ≤ W * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ k)
    (hSW : ∀ A : ℝ, 0 < A →
      ∃ KSW XSW : ℝ, 0 < KSW ∧ X₀ ≤ XSW ∧
        ∀ x : ℝ, XSW ≤ x → ∀ i : ι,
        ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
          ‖fullDiscrepancy
              ((β x i).filter (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
            KSW * ((q * r).divisors.card : ℝ) ^ s * N x i /
              (Real.log x) ^ A) :
    ∀ A : ℝ, 0 < A →
      ∃ K X : ℝ, 0 < K ∧ X₀ ≤ X ∧
        ∀ x : ℝ, X ≤ x → ∀ i : ι,
        ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
        ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
          (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
              q ∣ (∏ p ∈ I, p) ∧
                Nonempty (DenseDivisibilityWitness
                  ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩
                  j q)),
            ‖fullDiscrepancy (finiteConvolution (α x i) (β x i)) q a‖) ≤
              K * x / (Real.log x) ^ A := by
  classical
  have hdyadic_bin_count (x θ : ℝ) (Q : ℕ) (hx : Real.exp 1 ≤ x)
      (hθ : 0 ≤ θ) (hQ : Q ≤ ⌊x ^ θ⌋₊) :
      ((Nat.log 2 Q + 1 : ℕ) : ℝ) ≤
        (1 + θ / Real.log 2) * Real.log x := by
    have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
    have hlogx : 1 ≤ Real.log x := by
      simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hx
    have hlogtwo : 0 < Real.log 2 := Real.log_pos (by norm_num)
    have hQreal : (Q : ℝ) ≤ x ^ θ :=
      (show (Q : ℝ) ≤ (⌊x ^ θ⌋₊ : ℝ) by exact_mod_cast hQ).trans
        (Nat.floor_le (Real.rpow_nonneg hxpos.le θ))
    have hlogbound : (Nat.log 2 Q : ℝ) * Real.log 2 ≤ θ * Real.log x := by
      by_cases hQzero : Q = 0
      · simpa only [hQzero, Nat.log_zero_right, Nat.cast_zero, zero_mul] using
          mul_nonneg hθ (zero_le_one.trans hlogx)
      · have hpow : (2 : ℝ) ^ Nat.log 2 Q ≤ x ^ θ :=
          (show (2 : ℝ) ^ Nat.log 2 Q ≤ (Q : ℝ) by
            exact_mod_cast Nat.pow_log_le_self 2 hQzero).trans hQreal
        have h := Real.log_le_log (pow_pos (by norm_num : (0 : ℝ) < 2) _) hpow
        simpa only [Real.log_pow, Real.log_rpow hxpos] using h
    have hquot : (Nat.log 2 Q : ℝ) ≤ θ * Real.log x / Real.log 2 :=
      (le_div_iff₀ hlogtwo).2 hlogbound
    calc
      ((Nat.log 2 Q + 1 : ℕ) : ℝ) = (Nat.log 2 Q : ℝ) + 1 := by norm_num
      _ ≤ θ * Real.log x / Real.log 2 + Real.log x := add_le_add hquot hlogx
      _ = (1 + θ / Real.log 2) * Real.log x := by ring
  have hpair_dyadic_cover (S : Finset (ℕ × ℕ)) (w : ℕ × ℕ → ℝ) (U V : ℕ)
      (hS : ∀ p ∈ S, 0 < p.1 ∧ p.1 ≤ U ∧ 0 < p.2 ∧ p.2 ≤ V)
      (hw : ∀ p ∈ S, 0 ≤ w p) :
      (∑ p ∈ S, w p) ≤
        ∑ j ∈ Finset.Icc 0 (Nat.log 2 U),
          ∑ k ∈ Finset.Icc 0 (Nat.log 2 V),
            ∑ p ∈ S.filter (fun p =>
              2 ^ j ≤ p.1 ∧ p.1 ≤ 2 * 2 ^ j ∧
              2 ^ k ≤ p.2 ∧ p.2 ≤ 2 * 2 ^ k), w p := by
    have hmap : ∀ p ∈ S, (Nat.log 2 p.1, Nat.log 2 p.2) ∈
        (Finset.Icc 0 (Nat.log 2 U)) ×ˢ (Finset.Icc 0 (Nat.log 2 V)) := by
      intro p hp
      exact Finset.mem_product.mpr
        ⟨Finset.mem_Icc.mpr ⟨Nat.zero_le _, Nat.log_mono_right (b := 2) (hS p hp).2.1⟩,
          Finset.mem_Icc.mpr ⟨Nat.zero_le _, Nat.log_mono_right (b := 2) (hS p hp).2.2.2⟩⟩
    calc
      (∑ p ∈ S, w p) = ∑ j ∈ Finset.Icc 0 (Nat.log 2 U),
          ∑ k ∈ Finset.Icc 0 (Nat.log 2 V),
            ∑ p ∈ S.filter (fun p => Nat.log 2 p.1 = j ∧ Nat.log 2 p.2 = k), w p := by
        simpa only [Finset.sum_product, Prod.mk.injEq] using
          (Finset.sum_fiberwise_of_maps_to hmap w).symm
      _ ≤ _ := by
        apply Finset.sum_le_sum
        intro j _
        apply Finset.sum_le_sum
        intro k _
        apply Finset.sum_le_sum_of_subset_of_nonneg
        · intro p hp
          obtain ⟨hpS, hj, hk⟩ := Finset.mem_filter.mp hp
          refine Finset.mem_filter.mpr ⟨hpS, ?_, ?_, ?_, ?_⟩
          · simpa only [hj] using Nat.pow_log_le_self 2 (hS p hpS).1.ne'
          · simpa only [hj, pow_succ, Nat.mul_comm] using
              (Nat.lt_pow_succ_log_self (by norm_num : 1 < 2) p.1).le
          · simpa only [hk] using Nat.pow_log_le_self 2 (hS p hpS).2.2.1.ne'
          · simpa only [hk, pow_succ, Nat.mul_comm] using
              (Nat.lt_pow_succ_log_self (by norm_num : 1 < 2) p.2).le
        · intro p hp _
          exact hw p (Finset.mem_filter.mp hp).1
  have hprime_product_pos (P : Finset ℕ) (hP : ∀ t ∈ P, Nat.Prime t) :
      0 < ∏ t ∈ P, t :=
    Finset.prod_pos (fun t ht => (hP t ht).pos)
  have hprimitive_average_le (G : ℕ) (hG : 0 < G) (F : ℕ → ℝ) (E : ℝ)
      (hF : ∀ b ∈ primitiveResidues G, F b ≤ E) :
      (∑ b ∈ primitiveResidues G, F b) / (G.totient : ℝ) ≤ E := by
    have hcard : (primitiveResidues G).card = G.totient := by
      unfold primitiveResidues
      rw [Nat.totient_eq_card_coprime]
      congr 1
      ext b
      simp only [Finset.mem_filter, Nat.coprime_comm]
    have hphi : (G.totient : ℝ) ≠ 0 := by
      exact_mod_cast (Nat.totient_pos.mpr hG).ne'
    calc
      (∑ b ∈ primitiveResidues G, F b) / (G.totient : ℝ) ≤
          (∑ b ∈ primitiveResidues G, E) / (G.totient : ℝ) :=
        div_le_div_of_nonneg_right (Finset.sum_le_sum hF) (Nat.cast_nonneg _)
      _ = E := by
        rw [Finset.sum_const, nsmul_eq_mul, hcard]
        exact mul_div_cancel_left₀ E hphi
  have hj : j = 1 ∨ j = 2 := hI.imp And.left And.left
  obtain ⟨ω', δ', c₀, ρ, hωw, hδw, hc₀, hρ, hcutρ, hεδρ,
    hIρ, hIIρ, hσlt, _⟩ :=
    lower_order_parameter_retreat j «ω» δ σ hω hδ hI hII
  have hω' : 0 < ω' := hω.trans hωw
  have hδ' : 0 < δ' := hδ.trans hδw
  let ε : ℝ := ρ / 2
  have hε : 0 < ε := div_pos hρ (by norm_num)
  have hcut : 100 * ε < c₀ := by dsimp only [ε]; linarith only [hcutρ, hρ]
  have hεδ : δ + 100 * ε < δ' := by dsimp only [ε]; linarith only [hεδρ, hρ]
  have hIwork :
      (j = 1 ∧ 54 * ω' + 15 * δ' + 5 * σ + 20000 * ε < 1) ∨
      (j = 2 ∧ 56 * ω' + 16 * δ' + 4 * σ + 20000 * ε < 1) := by
    rcases hIρ with ⟨hd, hi⟩ | ⟨hd, hi⟩
    · exact Or.inl ⟨hd, by dsimp only [ε]; linarith only [hi]⟩
    · exact Or.inr ⟨hd, by dsimp only [ε]; linarith only [hi]⟩
  have hIIwork : 68 * ω' + 14 * δ' + 100 * c₀ + 20000 * ε < 1 := by
    dsimp only [ε]
    linarith only [hIIρ]
  have hεbound : ε < 1 / 24 := by
    linarith only [hIIwork, hω', hδ', hc₀]
  have hωsmall : ω' < 1 / 12 := by
    linarith only [hIIwork, hδ', hc₀, hε]
  have hσgap : 0 < 1 / 2 - σ := by linarith only [hσ, hσlt]
  let θ : ℝ := 1 / 2 + 2 * «ω»
  have hθpos : 0 < θ := by dsimp only [θ]; linarith only [hω]
  have hθlt : θ < 1 := by dsimp only [θ]; linarith only [hωw, hωsmall]
  have hCpos : 0 < C := zero_lt_one.trans_le hCscale
  let C' : ℝ := max 4 (max C W)
  let c' : ℝ := min c 1
  have hC'4 : 4 ≤ C' := le_max_left _ _
  have hC'C : C ≤ C' := (le_max_left C W).trans (le_max_right _ _)
  have hC'W : W ≤ C' := (le_max_right C W).trans (le_max_right _ _)
  have hC' : 1 ≤ C' := by linarith only [hC'4]
  have hc' : 0 < c' := lt_min hc zero_lt_one
  have hc'c : c' ≤ c := min_le_left _ _
  have hc'C' : c' ≤ C' := (min_le_right _ _).trans hC'
  have hCevent : ∀ᶠ x : ℝ in Filter.atTop, C ≤ x ^ (1 / 4 : ℝ) :=
    (tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 4)).eventually
      (Filter.eventually_ge_atTop C)
  obtain ⟨XC, hXC⟩ := Filter.eventually_atTop.mp hCevent
  let Xbase : ℝ := max X₀ XC
  have hXbase₀ : X₀ ≤ Xbase := le_max_left _ _
  have hXbase : Real.exp 1 ≤ Xbase := hX₀.trans hXbase₀
  have hbalanced : ∀ x : ℝ, Xbase ≤ x → ∀ i : ι,
      x / C ≤ M x i * N x i ∧ M x i * N x i ≤ C * x ∧
      x ^ (1 / 8 : ℝ) ≤ M x i ∧ x ^ (1 / 8 : ℝ) ≤ N x i := by
    intro x hx i
    have hx₀ : X₀ ≤ x := hXbase₀.trans hx
    have hxexp : Real.exp 1 ≤ x := hX₀.trans hx₀
    have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
    have hx1 : 1 ≤ x :=
      (Real.one_le_exp_iff.mpr (by norm_num : (0 : ℝ) ≤ 1)).trans hxexp
    obtain ⟨hMNlo, hMNhi, hNlo, hNhi⟩ := hscale x hx₀ i
    have hNpos : 0 < N x i := (Real.rpow_pos_of_pos hxpos _).trans_le hNlo
    have hMpos : 0 < M x i :=
      pos_of_mul_pos_left ((div_pos hxpos hCpos).trans_le hMNlo) hNpos.le
    have hCp : C ≤ x ^ (1 / 4 : ℝ) := hXC x ((le_max_right _ _).trans hx)
    have hMquarter : x ^ (1 / 4 : ℝ) ≤ M x i := by
      apply (mul_le_mul_iff_left₀ (mul_pos hCpos hNpos)).mp
      calc
        x ^ (1 / 4 : ℝ) * (C * N x i) ≤
            x ^ (1 / 4 : ℝ) * (x ^ (1 / 4 : ℝ) * x ^ (1 / 2 : ℝ)) :=
          mul_le_mul_of_nonneg_left
            (mul_le_mul hCp hNhi hNpos.le (Real.rpow_nonneg hxpos.le _))
            (Real.rpow_nonneg hxpos.le _)
        _ = x := by
          rw [← Real.rpow_add hxpos, ← Real.rpow_add hxpos]
          norm_num
        _ ≤ M x i * (C * N x i) := by
          have hm := (div_le_iff₀ hCpos).mp hMNlo
          nlinarith only [hm]
    refine ⟨hMNlo, hMNhi, ?_, ?_⟩
    · exact (Real.rpow_le_rpow_of_exponent_le hx1 (by norm_num)).trans hMquarter
    · exact (Real.rpow_le_rpow_of_exponent_le hx1
        (by linarith only [hσlt] : (1 / 8 : ℝ) ≤ 1 / 2 - σ)).trans hNlo
  have hsupportBase := fun x (hx : Xbase ≤ x) => hsupport x (hXbase₀.trans hx)
  have hcoeffBase := fun x (hx : Xbase ≤ x) => hcoeff x (hXbase₀.trans hx)
  have hSWbase : ∀ A : ℝ, 0 < A →
      ∃ KSW XSW : ℝ, 0 < KSW ∧ Xbase ≤ XSW ∧
        ∀ x : ℝ, XSW ≤ x → ∀ i : ι,
        ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
          ‖fullDiscrepancy ((β x i).filter (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
            KSW * ((q * r).divisors.card : ℝ) ^ s * N x i / (Real.log x) ^ A := by
    intro A hA
    obtain ⟨KSW, XSW, hKSW, _, hSW'⟩ := hSW A hA
    exact ⟨KSW, max Xbase XSW, hKSW, le_max_left _ _,
      fun x hx => hSW' x ((le_max_right _ _).trans hx)⟩
  intro A hA
  obtain ⟨B, KBV, XBV, hBpos, hKBV, hXBV, hBV⟩ :=
    balanced_bv_masked_uniform_log_saving M N α β c C W (1 / 8) Xbase k s
      hc hCscale hW (by norm_num) hXbase hbalanced hsupportBase hcoeffBase hSWbase A hA
  obtain ⟨KM, XM, hKM, hXM, hMean⟩ :=
    balanced_bv_meanTerm_uniform_log_saving M N α β c C W (1 / 8) Xbase k s
      hc hCscale hW (by norm_num) hXbase hbalanced hsupportBase hcoeffBase hSWbase
      θ (1 / 2 - 4 * ε) hθpos.le (by linarith only [hε]) A hA
  obtain ⟨KE, XE, hKE, hXE, hExceptional⟩ :=
    exceptional_smallPrimePart_fullDiscrepancy_log_saving
      θ hθpos hθlt (2 * k + 1) 0 (2 * k : ℕ) (C ^ 3)
      (one_le_pow₀ hCscale) A hA
  obtain ⟨XD, hXD, hDelta⟩ :=
    sourceDeltaZero_rough_dyadic_lowerOrder_uniform_log_saving
      j ω' δ' σ ε c₀ C' c' C' c' C' hω' hδ' hσ hε hc₀ hcut hIwork hIIwork
      hC' hc' hc'C' hc' hc'C' k k k k (A + 2) 1 (by linarith only [hA]) zero_lt_one
  have hZevent : ∀ᶠ x : ℝ in Filter.atTop,
      Real.exp ((Real.log x) ^ (2 / 3 : ℝ)) ≤ x ^ ε := by
    simpa only [Real.rpow_zero, one_mul] using
      small_prime_density_scale_absorption 0 ε hε
  have hLogevent : ∀ᶠ x : ℝ in Filter.atTop,
      ‖(Real.log x) ^ B‖ ≤ ‖x ^ ε‖ := by
    simpa only [one_mul] using
      (isLittleO_log_rpow_rpow_atTop B hε).bound (by norm_num : (0 : ℝ) < 1)
  obtain ⟨XZ, hXZ⟩ := Filter.eventually_atTop.mp hZevent
  obtain ⟨XP, hXP⟩ := Filter.eventually_atTop.mp hLogevent
  let X : ℝ := max XBV (max XM (max XE (max XD (max XZ XP))))
  let Dθ : ℝ := 1 + θ / Real.log 2
  have hDθ : 0 < Dθ := by
    dsimp only [Dθ]
    exact add_pos zero_lt_one (div_pos hθpos (Real.log_pos (by norm_num)))
  let K : ℝ := KBV + KE * W ^ 2 + KM + C * Dθ ^ 2
  have hK : 0 < K := by
    dsimp only [K]
    positivity
  refine ⟨K, X, hK, hXbase₀.trans (hXBV.trans (le_max_left _ _)), ?_⟩
  intro x hx i I hI a ha
  have hxBV : XBV ≤ x := (le_max_left _ _).trans hx
  have hxM : XM ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans hx)
  have hxE : XE ≤ x := (le_max_left _ _).trans
    ((le_max_right _ _).trans ((le_max_right _ _).trans hx))
  have hxD : XD ≤ x := (le_max_left _ _).trans
    ((le_max_right _ _).trans ((le_max_right _ _).trans ((le_max_right _ _).trans hx)))
  have hxZ : XZ ≤ x := (le_max_left _ _).trans
    ((le_max_right _ _).trans ((le_max_right _ _).trans
      ((le_max_right _ _).trans ((le_max_right _ _).trans hx))))
  have hxP : XP ≤ x := (le_max_right _ _).trans
    ((le_max_right _ _).trans ((le_max_right _ _).trans
      ((le_max_right _ _).trans ((le_max_right _ _).trans hx))))
  have hxbase : Xbase ≤ x := hXBV.trans hxBV
  have hx₀ : X₀ ≤ x := hXbase₀.trans hxbase
  have hxexp : Real.exp 1 ≤ x := hX₀.trans hx₀
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hx1 : 1 ≤ x :=
    (Real.one_le_exp_iff.mpr (by norm_num : (0 : ℝ) ≤ 1)).trans hxexp
  have hlog1 : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hxexp
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlog1
  obtain ⟨hMNlo, hMNhi, hNlo, hNhi⟩ := hscale x hx₀ i
  have hNpos : 0 < N x i := (Real.rpow_pos_of_pos hxpos _).trans_le hNlo
  have hMpos : 0 < M x i :=
    pos_of_mul_pos_left ((div_pos hxpos hCpos).trans_le hMNlo) hNpos.le
  have hMNpos : 0 < M x i * N x i := mul_pos hMpos hNpos
  let f : ℕ →₀ ℂ := finiteConvolution (α x i) (β x i)
  let Y : Set.Ici (1 : ℝ) := ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩
  let Z : Set.Ici (1 : ℝ) :=
    ⟨Real.exp ((Real.log x) ^ (2 / 3 : ℝ)),
      Real.one_le_exp_iff.mpr (Real.rpow_nonneg hlogpos.le _)⟩
  let cutoff : ℕ := ⌊x ^ θ⌋₊
  let cutoffSmall : ℕ := ⌊x ^ (1 / 2 - ε)⌋₊
  let Brough : ℕ := ⌊Real.exp ((Real.log x) ^ (1 / 3 : ℝ))⌋₊
  let S₀ : Finset ℕ := (Finset.Icc 1 cutoff).filter (fun q =>
    q ∣ ∏ p ∈ I, p ∧
      Nonempty (DenseDivisibilityWitness Y j q))
  let E : Finset ℕ := S₀.filter fun q =>
    cutoffSmall < q ∧ (smallPrimePart Brough q : ℝ) ≤ (Z : ℝ)
  let T : ℝ := x ^ (-5 * ε) * N x i
  have hY : (Y : ℝ) = x ^ δ := max_eq_right
    (Real.one_le_rpow hx1 hδ.le)
  have hZ : (Z : ℝ) ≤ x ^ ε := hXZ x hxZ
  have htwoPower : 2 ≤ x ^ ε := by
    calc
      (2 : ℝ) ≤ Real.exp 1 := by linarith only [Real.add_one_le_exp (1 : ℝ)]
      _ ≤ (Z : ℝ) := Real.exp_le_exp.mpr
        (Real.one_le_rpow hlog1 (by norm_num : (0 : ℝ) ≤ 2 / 3))
      _ ≤ x ^ ε := hZ
  have hYworking : (inflatedScale Y Z : ℝ) ≤ max 1 (x ^ δ') := by
    change (Y : ℝ) * (Z : ℝ) ≤ max 1 (x ^ δ')
    calc
      (Y : ℝ) * (Z : ℝ) ≤ x ^ δ * x ^ ε := by
        rw [hY]
        exact mul_le_mul_of_nonneg_left hZ (Real.rpow_nonneg hxpos.le _)
      _ = x ^ (δ + ε) := (Real.rpow_add hxpos _ _).symm
      _ ≤ x ^ δ' := Real.rpow_le_rpow_of_exponent_le hx1 (by linarith only [hεδ, hε])
      _ ≤ max 1 (x ^ δ') := le_max_right _ _
  have hYoriginalWorking : (Y : ℝ) ≤ max 1 (x ^ δ') := by
    rw [hY]
    exact (Real.rpow_le_rpow_of_exponent_le hx1 hδw.le).trans (le_max_right _ _)
  have hT : 1 ≤ T := by
    calc
      1 ≤ x ^ (-5 * ε + (1 / 2 - σ)) :=
        Real.one_le_rpow hx1 (by linarith only [hεbound, hσlt])
      _ = x ^ (-5 * ε) * x ^ (1 / 2 - σ) := Real.rpow_add hxpos _ _
      _ ≤ T := mul_le_mul_of_nonneg_left hNlo (Real.rpow_nonneg hxpos.le _)
  have hTsmall : T ≤ x ^ (1 / 2 - ε) := by
    calc
      T ≤ x ^ (-5 * ε) * x ^ (1 / 2 : ℝ) :=
        mul_le_mul_of_nonneg_left hNhi (Real.rpow_nonneg hxpos.le _)
      _ = x ^ (-5 * ε + 1 / 2) := (Real.rpow_add hxpos _ _).symm
      _ ≤ x ^ (1 / 2 - ε) := Real.rpow_le_rpow_of_exponent_le hx1
        (by linarith only [hε])
  have hTZ : T * (Z : ℝ) ≤ x ^ (-4 * ε) * N x i := by
    calc
      T * (Z : ℝ) ≤ (x ^ (-5 * ε) * N x i) * x ^ ε :=
        mul_le_mul_of_nonneg_left hZ (zero_le_one.trans hT)
      _ = x ^ (-4 * ε) * N x i := by
        rw [mul_right_comm, ← Real.rpow_add hxpos,
          show -5 * ε + ε = -4 * ε by ring]
  have hS₀data (q : ℕ) (hq : q ∈ S₀) :
      0 < q ∧ q ≤ cutoff ∧ q ∣ ∏ p ∈ I, p := by
    obtain ⟨hinterval, hdiv, _⟩ := Finset.mem_filter.mp hq
    exact ⟨(Finset.mem_Icc.mp hinterval).1,
      (Finset.mem_Icc.mp hinterval).2, hdiv⟩
  have hproductSquarefree : Squarefree (∏ p ∈ I, p) := by
    apply Finset.squarefree_prod_of_pairwise_isCoprime
    · intro p hp q hq hpq
      exact Nat.coprime_iff_isRelPrime.mp
        ((Nat.coprime_primes (hI p hp) (hI q hq)).mpr hpq)
    · intro p hp
      exact (hI p hp).squarefree
  have hS₀subset : S₀ ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ := by
    intro q hq
    exact Finset.mem_Icc.mpr ⟨(hS₀data q hq).1, (hS₀data q hq).2.1⟩
  have hS₀primitive (q : ℕ) (hq : q ∈ S₀) : Nat.Coprime a q :=
    ha.of_dvd_right (hS₀data q hq).2.2
  have hlogB : (Real.log x) ^ B ≤ x ^ ε := by
    simpa only [Real.norm_of_nonneg (Real.rpow_nonneg hlogpos.le _),
      Real.norm_of_nonneg (Real.rpow_nonneg hxpos.le _)] using hXP x hxP
  have hsmallcut : x ^ (1 / 2 - ε) ≤ Real.sqrt x / (Real.log x) ^ B := by
    apply (le_div_iff₀ (Real.rpow_pos_of_pos hlogpos B)).mpr
    calc
      x ^ (1 / 2 - ε) * (Real.log x) ^ B ≤ x ^ (1 / 2 - ε) * x ^ ε :=
        mul_le_mul_of_nonneg_left hlogB (Real.rpow_nonneg hxpos.le _)
      _ = x ^ (1 / 2 : ℝ) := by
        rw [← Real.rpow_add hxpos]
        congr 1
        ring
      _ = Real.sqrt x := (Real.sqrt_eq_rpow x).symm
  let U : ℕ := ⌊Real.sqrt x / (Real.log x) ^ B⌋₊
  have hsmallU : cutoffSmall ≤ U := Nat.floor_mono hsmallcut
  let F (q : ℕ) : ℝ := ⨆ b : (ZMod q)ˣ, ‖fullDiscrepancy f q (b : ZMod q).val‖
  have hFnonneg (q : ℕ) (hq : 0 < q) : 0 ≤ F q := by
    let : NeZero q := ⟨hq.ne'⟩
    have hb : BddAbove (Set.range fun b : (ZMod q)ˣ =>
        ‖fullDiscrepancy f q (b : ZMod q).val‖) := (Set.finite_range _).bddAbove
    exact (norm_nonneg _).trans (le_ciSup hb (1 : (ZMod q)ˣ))
  have hFbound (q : ℕ) (hq : q ∈ S₀) : ‖fullDiscrepancy f q a‖ ≤ F q := by
    let : NeZero q := ⟨(hS₀data q hq).1.ne'⟩
    have hb : BddAbove (Set.range fun b : (ZMod q)ˣ =>
        ‖fullDiscrepancy f q (b : ZMod q).val‖) := (Set.finite_range _).bddAbove
    have heq : ‖fullDiscrepancy f q
        (ZMod.unitOfCoprime a (hS₀primitive q hq) : ZMod q).val‖ =
          ‖fullDiscrepancy f q a‖ := by
      simp only [ZMod.coe_unitOfCoprime, ZMod.val_natCast, fullDiscrepancy,
        progressionMass, Nat.mod_mod]
    exact heq.symm.trans_le (le_ciSup hb (ZMod.unitOfCoprime a (hS₀primitive q hq)))
  have hfilterOne : f.filter (fun n : ℕ => Nat.Coprime n 1) = f := by
    ext n
    simp only [Finsupp.filter_apply]
    exact ite_eq_left (Nat.coprime_one_right n)
  have hBVone : (∑ q ∈ Finset.Ioc 0 U, F q) ≤ KBV * x / (Real.log x) ^ A := by
    have hb := hBV x hxBV i 1 zero_lt_one
    change (∑ q ∈ Finset.Ioc 0 U,
      ⨆ b : (ZMod q)ˣ, ‖fullDiscrepancy
        (f.filter (fun n : ℕ => Nat.Coprime n 1)) q (b : ZMod q).val‖) ≤ _ at hb
    rw [hfilterOne] at hb
    simpa only [Nat.divisors_one, Finset.card_singleton, Nat.cast_one,
      one_pow, mul_one, F] using hb
  have hsmallBound :
      (∑ q ∈ S₀.filter (fun q => q ≤ cutoffSmall), ‖fullDiscrepancy f q a‖) ≤
        KBV * x / (Real.log x) ^ A := by
    calc
      (∑ q ∈ S₀.filter (fun q => q ≤ cutoffSmall), ‖fullDiscrepancy f q a‖) ≤
          ∑ q ∈ S₀.filter (fun q => q ≤ cutoffSmall), F q :=
        Finset.sum_le_sum fun q hq => hFbound q (Finset.mem_filter.mp hq).1
      _ ≤ ∑ q ∈ Finset.Ioc 0 U, F q := by
        apply Finset.sum_le_sum_of_subset_of_nonneg
        · intro q hq
          obtain ⟨hqS, hqcut⟩ := Finset.mem_filter.mp hq
          exact Finset.mem_Ioc.mpr ⟨(hS₀data q hqS).1, hqcut.trans hsmallU⟩
        · intro q hq _
          exact hFnonneg q (Finset.mem_Ioc.mp hq).1
      _ ≤ KBV * x / (Real.log x) ^ A := hBVone
  obtain ⟨hfSupport, hfCoeff⟩ := finiteConvolution_support_and_divisor_bound
    (α x i) (β x i) x (M x i) (N x i) c C W k
      hx1 hMpos hNpos hc hCscale hW hMNhi
      (hsupport x hx₀ i).1 (hsupport x hx₀ i).2
      (fun n _ => (hcoeff x hx₀ i n).1) (fun n _ => (hcoeff x hx₀ i n).2)
  have hExceptionalBound :
      (∑ q ∈ S₀.filter (fun q => (Z : ℝ) < (smallPrimePart Brough q : ℝ)),
        ‖fullDiscrepancy f q a‖) ≤ KE * W ^ 2 * x / (Real.log x) ^ A := by
    have hcoefE : ∀ n ∈ f.support,
        ‖f n‖ ≤ W ^ 2 * (n.divisors.card : ℝ) ^ (2 * k + 1) *
          (Real.log x) ^ ((2 * k : ℕ) : ℝ) := by
      intro n _
      simpa only [Real.rpow_natCast, f] using hfCoeff n
    have he := hExceptional x hxE (W ^ 2) (sq_nonneg W) S₀ hS₀subset
      (fun _ => a) hS₀primitive f hfSupport hcoefE
    simpa only [pow_zero, one_mul, Brough, Z] using he
  have hEdata (n : ℕ) (hn : n ∈ E) :
      Squarefree n ∧ T ≤ (n : ℝ) ∧
        Nonempty (DenseDivisibilityWitness Y j n) ∧
        (smallPrimePart Brough n : ℝ) ≤ (Z : ℝ) := by
    obtain ⟨hnS, hnlarge, hnsmall⟩ := Finset.mem_filter.mp hn
    exact ⟨hproductSquarefree.squarefree_of_dvd (hS₀data n hnS).2.2,
      hTsmall.trans (Nat.lt_of_floor_lt hnlarge).le,
      (Finset.mem_filter.mp hnS).2.2, hnsmall⟩
  obtain ⟨S, hSsum, _hSinj, hSraw⟩ :=
    select_rough_lower_order_factor_family j hj Y Z Brough T hT E hEdata
  have hS (p : ℕ × ℕ) (hp : p ∈ S) :
      0 < p.1 ∧ 0 < p.2 ∧ Squarefree (p.1 * p.2) ∧
        p.1 * p.2 ∈ E ∧ p.1 * p.2 ∣ (∏ t ∈ I, t) ∧
        T / (Y : ℝ) ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ T * (Z : ℝ) ∧
        Nonempty (DenseDivisibilityWitness
          (inflatedScale Y Z) (j - 1) p.1) ∧
        Nonempty (DenseDivisibilityWitness Y 1 (p.1 * p.2)) ∧
        (∀ t ∈ p.1.primeFactors, Brough < t) := by
    obtain ⟨hpE, hq, hr, _hcop, hlo, hhi, hrough, hdq, hdfull⟩ := hSraw p hp
    have hpSource : p.1 * p.2 ∈ S₀ := (Finset.mem_filter.mp hpE).1
    have hdiv := (hS₀data _ hpSource).2.2
    exact ⟨hq, hr, hproductSquarefree.squarefree_of_dvd hdiv, hpE, hdiv,
      hlo, hhi, hdq, hdfull, hrough⟩
  have hSpair (p : ℕ × ℕ) (hp : p ∈ S) :
      0 < p.1 ∧ 0 < p.2 ∧ p.1 ≤ cutoff ∧ p.2 ≤ cutoff ∧
        Nat.Coprime p.1 p.2 ∧ Nat.Coprime a (p.1 * p.2) := by
    obtain ⟨hq, hr, hsf, hpE, _, _, _, _, _, _⟩ := hS p hp
    have hpS : p.1 * p.2 ∈ S₀ := (Finset.mem_filter.mp hpE).1
    have hcut := (hS₀data _ hpS).2.1
    exact ⟨hq, hr, (Nat.le_mul_of_pos_right _ hr).trans hcut,
      (Nat.le_mul_of_pos_left _ hq).trans hcut,
      Nat.coprime_of_squarefree_mul hsf, hS₀primitive _ hpS⟩
  have hSmean (p : ℕ × ℕ) (hp : p ∈ S) :
      0 < p.1 ∧ p.1 ≤ ⌊x ^ θ⌋₊ ∧
        0 < p.2 ∧ p.2 ≤ ⌊x ^ (1 / 2 - 4 * ε)⌋₊ ∧ Nat.Coprime p.1 p.2 := by
    obtain ⟨hq, hr, hqcut, _, hcop, _⟩ := hSpair p hp
    refine ⟨hq, hqcut, hr, ?_, hcop⟩
    apply (Nat.le_floor_iff (Real.rpow_nonneg hxpos.le _)).mpr
    calc
      (p.2 : ℝ) ≤ T * (Z : ℝ) := (hS p hp).2.2.2.2.2.2.1
      _ ≤ x ^ (-4 * ε) * N x i := hTZ
      _ ≤ x ^ (-4 * ε) * x ^ (1 / 2 : ℝ) :=
        mul_le_mul_of_nonneg_left hNhi (Real.rpow_nonneg hxpos.le _)
      _ = x ^ (1 / 2 - 4 * ε) := by
        rw [← Real.rpow_add hxpos]
        congr 1
        ring
  have hMeanBound : (∑ p ∈ S, ‖meanTerm f p.1 p.2 a‖) ≤
      KM * x / (Real.log x) ^ A :=
    hMean x hxM i S hSmean a (fun p hp => (hSpair p hp).2.2.2.2.2)
  let γ : ℝ := Real.log (N x i) / Real.log x
  have hNγ : N x i = x ^ γ := by
    apply Real.log_injOn_pos (Set.mem_Ioi.mpr hNpos)
      (Set.mem_Ioi.mpr (Real.rpow_pos_of_pos hxpos γ))
    rw [Real.log_rpow hxpos]
    dsimp only [γ]
    field_simp
  have hγlo : 1 / 2 - σ ≤ γ := by
    apply (le_div_iff₀ hlogpos).mpr
    have hn := Real.log_le_log (Real.rpow_pos_of_pos hxpos _) hNlo
    rwa [Real.log_rpow hxpos] at hn
  have hγhi : γ ≤ 1 / 2 := by
    apply (div_le_iff₀ hlogpos).mpr
    have hn := Real.log_le_log hNpos hNhi
    rwa [Real.log_rpow hxpos] at hn
  have hMNlo' : x / C' ≤ M x i * N x i :=
    (div_le_div_of_nonneg_left hxpos.le hCpos hC'C).trans hMNlo
  have hMNhi' : M x i * N x i ≤ C' * x :=
    hMNhi.trans (mul_le_mul_of_nonneg_right hC'C hxpos.le)
  have hαOpen : ∀ n ∈ (α x i).support,
      c' * M x i ≤ (n : ℝ) ∧ (n : ℝ) ≤ C' * M x i ∧
      ‖α x i n‖ ≤ C' * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ (k : ℝ) := by
    intro n hn
    obtain ⟨hnlo, hnhi⟩ := (hsupport x hx₀ i).1 n hn
    refine ⟨(mul_le_mul_of_nonneg_right hc'c hMpos.le).trans hnlo,
      hnhi.trans (mul_le_mul_of_nonneg_right hC'C hMpos.le), ?_⟩
    rw [Real.rpow_natCast]
    exact (hcoeff x hx₀ i n).1.trans
      (mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_right hC'W (pow_nonneg (Nat.cast_nonneg _) _))
        (pow_nonneg hlogpos.le _))
  have hβOpen : ∀ n ∈ (β x i).support,
      c' * N x i ≤ (n : ℝ) ∧ (n : ℝ) ≤ C' * N x i ∧
      ‖β x i n‖ ≤ C' * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ (k : ℝ) := by
    intro n hn
    obtain ⟨hnlo, hnhi⟩ := (hsupport x hx₀ i).2 n hn
    refine ⟨(mul_le_mul_of_nonneg_right hc'c hNpos.le).trans hnlo,
      hnhi.trans (mul_le_mul_of_nonneg_right hC'C hNpos.le), ?_⟩
    rw [Real.rpow_natCast]
    exact (hcoeff x hx₀ i n).2.trans
      (mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_right hC'W (pow_nonneg (Nat.cast_nonneg _) _))
        (pow_nonneg hlogpos.le _))
  let G : ℕ := ∏ p ∈ I, p
  have hG : 0 < G := hprime_product_pos I hI
  have hDeltaBound (b : ℕ) (hb : b ∈ primitiveResidues G) :
      (∑ p ∈ S, ‖deltaZero f p.1 p.2 a a b‖) ≤
        C * Dθ ^ 2 * x / (Real.log x) ^ A := by
    have hbG : Nat.Coprime b G := (Finset.mem_filter.mp hb).2
    have habG : Nat.Coprime (a * a * b) G := (ha.mul_left ha).mul_left hbG
    let J : Finset ℕ := Finset.Icc 0 (Nat.log 2 cutoff)
    let E₀ : ℝ := (M x i * N x i) * (Real.log x) ^ (-(A + 2))
    have hE₀ : 0 ≤ E₀ := mul_nonneg hMNpos.le (Real.rpow_nonneg hlogpos.le _)
    have hBand (jq k' : ℕ) :
        (∑ p ∈ S.filter (fun p =>
            2 ^ jq ≤ p.1 ∧ p.1 ≤ 2 * 2 ^ jq ∧
            2 ^ k' ≤ p.2 ∧ p.2 ≤ 2 * 2 ^ k'),
          ‖deltaZero f p.1 p.2 a a b‖) ≤ E₀ := by
      let Q : ℝ := (2 ^ jq : ℕ)
      let R : ℝ := (2 ^ k' : ℕ)
      let S' : Finset (ℕ × ℕ) := S.filter fun p =>
        2 ^ jq ≤ p.1 ∧ p.1 ≤ 2 * 2 ^ jq ∧
        2 ^ k' ≤ p.2 ∧ p.2 ≤ 2 * 2 ^ k'
      have hQ : 0 < Q := Nat.cast_pos.mpr (pow_pos (by norm_num) _)
      have hR : 0 < R := Nat.cast_pos.mpr (pow_pos (by norm_num) _)
      by_cases hS' : S' = ∅
      · change (∑ p ∈ S', ‖deltaZero f p.1 p.2 a a b‖) ≤ E₀
        simpa only [hS', Finset.sum_empty] using hE₀
      obtain ⟨p, hp⟩ := Finset.nonempty_iff_ne_empty.mpr hS'
      obtain ⟨hpS, hqloN, hqhiN, hrloN, hrhiN⟩ := Finset.mem_filter.mp hp
      obtain ⟨hqpos, hrpos, hsf, hpE, hpdiv, hrloT, hrhiT, hdq, hdr, hrough⟩ :=
        hS p hpS
      have hqlo : Q ≤ (p.1 : ℝ) := by dsimp only [Q]; exact_mod_cast hqloN
      have hqhi : (p.1 : ℝ) ≤ 2 * Q := by dsimp only [Q]; exact_mod_cast hqhiN
      have hrlo : R ≤ (p.2 : ℝ) := by dsimp only [R]; exact_mod_cast hrloN
      have hrhi : (p.2 : ℝ) ≤ 2 * R := by dsimp only [R]; exact_mod_cast hrhiN
      have hqp : (0 : ℝ) ≤ p.1 := Nat.cast_nonneg _
      have hrp : (0 : ℝ) ≤ p.2 := Nat.cast_nonneg _
      have hprodlo : R * Q ≤ (p.1 : ℝ) * p.2 := by
        simpa only [mul_comm] using mul_le_mul hqlo hrlo hR.le hqp
      have hprodhi : (p.1 : ℝ) * p.2 ≤ 4 * (R * Q) := by
        have hm := mul_le_mul hqhi hrhi hrp (by positivity : 0 ≤ 2 * Q)
        nlinarith only [hm]
      obtain ⟨hpSource, hpLarge, _⟩ := Finset.mem_filter.mp hpE
      have hlarge : x ^ (1 / 2 - ε) < (p.1 : ℝ) * p.2 := by
        exact_mod_cast Nat.lt_of_floor_lt hpLarge
      have hupper : (p.1 : ℝ) * p.2 ≤ x ^ θ := by
        have hh : ((p.1 * p.2 : ℕ) : ℝ) ≤ (cutoff : ℝ) :=
          Nat.cast_le.mpr (hS₀data _ hpSource).2.1
        have hpcast : (p.1 : ℝ) * p.2 ≤ (cutoff : ℝ) := by
          simpa only [Nat.cast_mul] using hh
        exact hpcast.trans (Nat.floor_le (Real.rpow_nonneg hxpos.le _))
      have hRQlo : x ^ (1 / 2 - ε) ≤ C' * R * Q := by
        have hc := mul_le_mul_of_nonneg_right hC'4 (mul_nonneg hR.le hQ.le)
        nlinarith only [hlarge, hprodhi, hc]
      have hRQhi : R * Q ≤ x ^ (1 / 2 + 2 * ω' + ε) := by
        exact (hprodlo.trans hupper).trans
          (Real.rpow_le_rpow_of_exponent_le hx1
            (by dsimp only [θ]; linarith only [hωw, hε]))
      have hRhi : R ≤ x ^ (-4 * ε) * N x i :=
        (hrlo.trans hrhiT).trans hTZ
      have hNfromR : N x i ≤ x ^ (δ' + 6 * ε) * R := by
        have hYpos : 0 < (Y : ℝ) := zero_lt_one.trans_le Y.property
        have ht := (div_le_iff₀ hYpos).mp hrloT
        have hNr : N x i ≤ x ^ (δ + 5 * ε) * (p.2 : ℝ) := by
          calc
            N x i = x ^ (5 * ε) * T := by
              dsimp only [T]
              rw [← mul_assoc, ← Real.rpow_add hxpos]
              rw [show 5 * ε + -5 * ε = 0 by ring, Real.rpow_zero, one_mul]
            _ ≤ x ^ (5 * ε) * ((p.2 : ℝ) * (Y : ℝ)) :=
              mul_le_mul_of_nonneg_left ht (Real.rpow_nonneg hxpos.le _)
            _ = x ^ (δ + 5 * ε) * (p.2 : ℝ) := by
              rw [hY]
              calc
                x ^ (5 * ε) * ((p.2 : ℝ) * x ^ δ) =
                    (x ^ (5 * ε) * x ^ δ) * (p.2 : ℝ) := by ring
                _ = x ^ (δ + 5 * ε) * (p.2 : ℝ) := by
                  rw [← Real.rpow_add hxpos,
                    show 5 * ε + δ = δ + 5 * ε by ring]
        calc
          N x i ≤ x ^ (δ + 5 * ε) * (p.2 : ℝ) := hNr
          _ ≤ x ^ (δ + 5 * ε) * (2 * R) :=
            mul_le_mul_of_nonneg_left hrhi (Real.rpow_nonneg hxpos.le _)
          _ = (2 * x ^ (δ + 5 * ε)) * R := by ring
          _ ≤ (x ^ ε * x ^ (δ + 5 * ε)) * R :=
            mul_le_mul_of_nonneg_right
              (mul_le_mul_of_nonneg_right htwoPower (Real.rpow_nonneg hxpos.le _)) hR.le
          _ = x ^ (δ + 6 * ε) * R := by
            rw [← Real.rpow_add hxpos]
            congr 1
            ring_nf
          _ ≤ x ^ (δ' + 6 * ε) * R :=
            mul_le_mul_of_nonneg_right
              (Real.rpow_le_rpow_of_exponent_le hx1 (by linarith only [hδw])) hR.le
      have hRlo : x ^ (-δ' - 6 * ε) * N x i ≤ R := by
        calc
          _ ≤ x ^ (-δ' - 6 * ε) * (x ^ (δ' + 6 * ε) * R) :=
            mul_le_mul_of_nonneg_left hNfromR (Real.rpow_nonneg hxpos.le _)
          _ = R := by
            rw [← mul_assoc, ← Real.rpow_add hxpos,
              show -δ' - 6 * ε + (δ' + 6 * ε) = 0 by ring, Real.rpow_zero, one_mul]
      have hSource : ∀ t ∈ S',
          0 < t.1 ∧ 0 < t.2 ∧ Squarefree (t.1 * t.2) ∧
          Q ≤ (t.1 : ℝ) ∧ (t.1 : ℝ) ≤ 2 * Q ∧
          R ≤ (t.2 : ℝ) ∧ (t.2 : ℝ) ≤ 2 * R ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (x ^ δ'), by exact le_max_left (1 : ℝ) (x ^ δ')⟩ (j - 1) t.1) ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (x ^ δ'), by exact le_max_left (1 : ℝ) (x ^ δ')⟩ 1 (t.1 * t.2)) ∧
          (∀ u ∈ t.1.primeFactors,
            Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (u : ℝ)) := by
        intro t ht
        obtain ⟨htS, htqlo, htqhi, htrlo, htrhi⟩ := Finset.mem_filter.mp ht
        obtain ⟨htq, htr, htsf, _, _, _, _, htdq, htdfull, htrough⟩ := hS t htS
        refine ⟨htq, htr, htsf, ?_, ?_, ?_, ?_,
          denseDivisibility_mono_scale hYworking htdq,
          denseDivisibility_mono_scale
            hYoriginalWorking htdfull, ?_⟩
        · dsimp only [Q]
          exact_mod_cast htqlo
        · dsimp only [Q]
          exact_mod_cast htqhi
        · dsimp only [R]
          exact_mod_cast htrlo
        · dsimp only [R]
          exact_mod_cast htrhi
        · intro u hu
          exact Nat.lt_of_floor_lt (htrough u hu)
      have hPrimitive : ∀ t ∈ S', Nat.Coprime (a * a * b) (t.1 * t.2) := by
        intro t ht
        exact habG.of_dvd_right (hS t (Finset.mem_filter.mp ht).1).2.2.2.2.1
      simpa only [one_mul, f, S', E₀] using
        hDelta x hxD (M x i) (N x i) R Q γ hMpos hNpos hR hQ
          hMNlo' hMNhi' hNγ hγlo hγhi hRlo hRhi hRQlo hRQhi
          (α x i) (β x i) hαOpen hβOpen S' hSource a a b hPrimitive
    have hcover := hpair_dyadic_cover S
      (fun p => ‖deltaZero f p.1 p.2 a a b‖) cutoff cutoff
      (fun p hp => ⟨(hSpair p hp).1, (hSpair p hp).2.2.1,
        (hSpair p hp).2.1, (hSpair p hp).2.2.2.1⟩)
      (fun _ _ => norm_nonneg _)
    have hcard : (J.card : ℝ) ≤ Dθ * Real.log x :=
      by simpa only [J, Nat.card_Icc, Nat.sub_zero, Dθ] using
        hdyadic_bin_count x θ cutoff hxexp hθpos.le le_rfl
    calc
      (∑ p ∈ S, ‖deltaZero f p.1 p.2 a a b‖) ≤
          ∑ j ∈ J, ∑ k' ∈ J,
            ∑ p ∈ S.filter (fun p =>
              2 ^ j ≤ p.1 ∧ p.1 ≤ 2 * 2 ^ j ∧
              2 ^ k' ≤ p.2 ∧ p.2 ≤ 2 * 2 ^ k'),
              ‖deltaZero f p.1 p.2 a a b‖ := hcover
      _ ≤ ∑ _j ∈ J, ∑ _k ∈ J, E₀ :=
        Finset.sum_le_sum fun j _ => Finset.sum_le_sum fun k' _ => hBand j k'
      _ = (J.card : ℝ) ^ 2 * E₀ := by
        simp only [Finset.sum_const, nsmul_eq_mul]
        ring
      _ ≤ (Dθ * Real.log x) ^ 2 * E₀ :=
        mul_le_mul_of_nonneg_right (pow_le_pow_left₀ (Nat.cast_nonneg _) hcard 2) hE₀
      _ ≤ (Dθ * Real.log x) ^ 2 * ((C * x) * (Real.log x) ^ (-(A + 2))) :=
        mul_le_mul_of_nonneg_left
          (mul_le_mul_of_nonneg_right hMNhi (Real.rpow_nonneg hlogpos.le _))
          (sq_nonneg _)
      _ = C * Dθ ^ 2 * x / (Real.log x) ^ A := by
        rw [Real.rpow_neg hlogpos.le, Real.rpow_add hlogpos, Real.rpow_two]
        field_simp
  have hDispersionBound : (∑ p ∈ S, ‖dispersionTerm f p.1 p.2 a‖) ≤
      C * Dθ ^ 2 * x / (Real.log x) ^ A := by
    apply (sum_norm_dispersion_le_global_average f hG S ?_ a).trans
      (hprimitive_average_le G hG
        (fun b => ∑ p ∈ S, ‖deltaZero f p.1 p.2 a a b‖)
        (C * Dθ ^ 2 * x / (Real.log x) ^ A) hDeltaBound)
    intro p hp
    exact ⟨(hSpair p hp).2.2.2.2.1,
      (dvd_mul_right p.1 p.2).trans (hS p hp).2.2.2.2.1⟩
  have hGoodBound : (∑ q ∈ E, ‖fullDiscrepancy f q a‖) ≤
      (C * Dθ ^ 2 + KM) * x / (Real.log x) ^ A := by
    rw [hSsum]
    calc
      (∑ p ∈ S, ‖fullDiscrepancy f (p.1 * p.2) a‖) ≤
          ∑ p ∈ S, (‖dispersionTerm f p.1 p.2 a‖ + ‖meanTerm f p.1 p.2 a‖) := by
        apply Finset.sum_le_sum
        intro p _
        rw [fullDiscrepancy_eq_dispersion_add_mean]
        exact norm_add_le _ _
      _ = (∑ p ∈ S, ‖dispersionTerm f p.1 p.2 a‖) +
          ∑ p ∈ S, ‖meanTerm f p.1 p.2 a‖ := Finset.sum_add_distrib
      _ ≤ C * Dθ ^ 2 * x / (Real.log x) ^ A + KM * x / (Real.log x) ^ A :=
        add_le_add hDispersionBound hMeanBound
      _ = (C * Dθ ^ 2 + KM) * x / (Real.log x) ^ A := by ring
  have hSplit : (∑ q ∈ S₀, ‖fullDiscrepancy f q a‖) ≤
      (∑ q ∈ S₀.filter (fun q => q ≤ cutoffSmall), ‖fullDiscrepancy f q a‖) +
      (∑ q ∈ S₀.filter (fun q => (Z : ℝ) < (smallPrimePart Brough q : ℝ)),
        ‖fullDiscrepancy f q a‖) +
      ∑ q ∈ E, ‖fullDiscrepancy f q a‖ := by
    dsimp only [E]
    simp only [Finset.sum_filter]
    rw [← Finset.sum_add_distrib, ← Finset.sum_add_distrib]
    apply Finset.sum_le_sum
    intro q _
    by_cases hsmall : q ≤ cutoffSmall
    · by_cases hbad : (Z : ℝ) < (smallPrimePart Brough q : ℝ)
      · simp only [hsmall, hbad, not_lt_of_ge hsmall, false_and,
          ite_true, ite_false, add_zero]
        exact le_add_of_nonneg_right (norm_nonneg _)
      · simp only [hsmall, hbad, not_lt_of_ge hsmall, false_and,
          ite_true, ite_false, add_zero, le_refl]
    · have hlarge : cutoffSmall < q := lt_of_not_ge hsmall
      by_cases hbad : (Z : ℝ) < (smallPrimePart Brough q : ℝ)
      · simp only [hsmall, hbad, hlarge, not_le_of_gt hbad, and_false,
          ite_true, ite_false, zero_add, add_zero, le_refl]
      · have hgood : (smallPrimePart Brough q : ℝ) ≤ (Z : ℝ) := le_of_not_gt hbad
        simp only [hsmall, hbad, hlarge, hgood, and_self,
          ite_true, ite_false, zero_add, le_refl]
  change (∑ q ∈ S₀, ‖fullDiscrepancy f q a‖) ≤ K * x / (Real.log x) ^ A
  calc
    (∑ q ∈ S₀, ‖fullDiscrepancy f q a‖) ≤
        (∑ q ∈ S₀.filter (fun q => q ≤ cutoffSmall), ‖fullDiscrepancy f q a‖) +
        (∑ q ∈ S₀.filter (fun q => (Z : ℝ) < (smallPrimePart Brough q : ℝ)),
          ‖fullDiscrepancy f q a‖) +
        ∑ q ∈ E, ‖fullDiscrepancy f q a‖ := hSplit
    _ ≤ KBV * x / (Real.log x) ^ A + KE * W ^ 2 * x / (Real.log x) ^ A +
        (C * Dθ ^ 2 + KM) * x / (Real.log x) ^ A :=
      add_le_add (add_le_add hsmallBound hExceptionalBound) hGoodBound
    _ = K * x / (Real.log x) ^ A := by dsimp only [K]; ring

end

section
open scoped ContDiff

open Classical in
theorem heathBrown_split_boxes_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (density j D : ℕ) (hj : 1 ≤ j) (hj20 : j ≤ 20) (hD : 1 ≤ D)
    («ω» δ σclass σdist C0 : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hσclass : 0 < σclass)
    (hσclassHalf : σclass < 1 / 2) (hσσ : σclass < σdist)
    (hσdistHalf : σdist < 1 / 2) (hC0 : 1 ≤ C0)
    (hdist :
      (density = 1 ∧ 54 * «ω» + 15 * δ + 5 * σdist < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (density = 2 ∧ 56 * «ω» + 16 * δ + 4 * σdist < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (density = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σdist < 1 ∧ 64 * «ω» + 20 * δ + 2 * σdist < 1)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
        let Θ : ℝ := 1 + (Real.log x) ^ (-(D : ℝ))
        let U : ℝ := (2 * x) ^ (1 / 20 : ℝ)
        let η : ℝ → ℝ := fun u =>
          if 0 < u then
            Real.smoothTransition (Real.log u / Real.log Θ + 1) -
              Real.smoothTransition (Real.log u / Real.log Θ)
          else 0
        let μU := arithmeticFunctionLowCutoff U
          (ArithmeticFunction.moebius : ArithmeticFunction ℝ)
        let f : Fin (2 * j) → ArithmeticFunction ℝ := fun i =>
          if i.val < j then μU else if i.val + 1 = 2 * j then
            ArithmeticFunction.log else ArithmeticFunction.zeta
        ∀ ν : Fin (2 * j) → ℕ,
          let Ni : Fin (2 * j) → ℝ := fun i => Θ ^ ν i
          let β : Fin (2 * j) → MonoidAlgebra ℂ ℕ := fun i =>
            ∑ n ∈ Finset.Icc 1 ⌊Θ * Ni i⌋₊,
              MonoidAlgebra.single n
                (((η ((n : ℝ) / Ni i) * f i n : ℝ) : ℂ))
          x / C0 ≤ (∏ i, Ni i) → (∏ i, Ni i) ≤ C0 * x →
          ∀ S T : Finset (Fin (2 * j)),
            Disjoint S T → S ∪ T = Finset.univ → S.Nonempty → T.Nonempty →
            x ^ (1 / 2 - σclass) / C0 < (∏ i ∈ S, Ni i) →
            (∏ i ∈ S, Ni i) ≤ (∏ i ∈ T, Ni i) →
          ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
          ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
            (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
                q ∣ (∏ p ∈ I, p) ∧
                  Nonempty (DenseDivisibilityWitness
                    ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩ density q)),
              ‖fullDiscrepancy (∏ i, β i).coeff q a‖) ≤
                K * x / (Real.log x) ^ A := by
  have hjrange : 1 ≤ j ∧ j ≤ 20 := ⟨hj, hj20⟩
  have hσdist : 0 < σdist ∧ σdist < 1 / 2 :=
    ⟨hσclass.trans hσσ, hσdistHalf⟩
  have hC0pos : 0 < C0 := zero_lt_one.trans_le hC0
  let d : ℝ := (1 / 2 - σclass) / 2
  have hd : 0 < d := by dsimp only [d]; linarith only [hσclassHalf]
  have hgap : 0 < σdist - σclass := sub_pos.mpr hσσ
  have hlarge : ∀ᶠ x : ℝ in Filter.atTop,
      C0 ≤ x ^ (σdist - σclass) ∧ C0 ≤ x ^ d :=
    ((tendsto_rpow_atTop hgap).eventually_ge_atTop C0).and
      ((tendsto_rpow_atTop hd).eventually_ge_atTop C0)
  obtain ⟨Xbase, hXbase⟩ := Filter.eventually_atTop.1 hlarge
  let X0 : ℝ := max (Real.exp 1) (max C0 Xbase)
  have hX0 : Real.exp 1 ≤ X0 := le_max_left _ _
  have hC0X0 : C0 ≤ X0 := (le_max_left _ _).trans (le_max_right _ _)
  have hbaseX0 : Xbase ≤ X0 := (le_max_right _ _).trans (le_max_right _ _)
  have hxpos (x : ℝ) (hx : X0 ≤ x) : 0 < x :=
    (Real.exp_pos 1).trans_le (hX0.trans hx)
  have hxone (x : ℝ) (hx : X0 ≤ x) : 1 ≤ x :=
    (Real.one_le_exp zero_le_one).trans (hX0.trans hx)
  have hlog (x : ℝ) (hx : X0 ≤ x) : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using
      Real.log_le_log (Real.exp_pos 1) (hX0.trans hx)
  have hlargeX (x : ℝ) (hx : X0 ≤ x) :
      C0 ≤ x ^ (σdist - σclass) ∧ C0 ≤ x ^ d :=
    hXbase x (hbaseX0.trans hx)
  let Θ : ℝ → ℝ := fun x => 1 + (Real.log x) ^ (-(D : ℝ))
  let U : ℝ → ℝ := fun x => (2 * x) ^ (1 / 20 : ℝ)
  let η : ℝ → ℝ → ℝ := fun x u =>
    if 0 < u then
      Real.smoothTransition (Real.log u / Real.log (Θ x) + 1) -
        Real.smoothTransition (Real.log u / Real.log (Θ x))
    else 0
  let μU : ℝ → ArithmeticFunction ℝ := fun x =>
    arithmeticFunctionLowCutoff (U x)
      (ArithmeticFunction.moebius : ArithmeticFunction ℝ)
  let f : ℝ → Fin (2 * j) → ArithmeticFunction ℝ := fun x i =>
    if i.val < j then μU x else if i.val + 1 = 2 * j then
      ArithmeticFunction.log else ArithmeticFunction.zeta
  let scale : ℝ → (Fin (2 * j) → ℕ) → Fin (2 * j) → ℝ :=
    fun x ν i => Θ x ^ ν i
  let slot : ℝ → (Fin (2 * j) → ℕ) → Fin (2 * j) → MonoidAlgebra ℂ ℕ :=
    fun x ν i => ∑ n ∈ Finset.Icc 1 ⌊Θ x * scale x ν i⌋₊,
      MonoidAlgebra.single n
        (((η x ((n : ℝ) / scale x ν i) * f x i n : ℝ) : ℂ))
  let P : ℝ → (Fin (2 * j) → ℕ) → ℝ := fun x ν => ∏ i, scale x ν i
  let Q : ℝ → (Fin (2 * j) → ℕ) → Finset (Fin (2 * j)) → ℝ :=
    fun x ν G => ∏ i ∈ G, scale x ν i
  let coeff : ℝ → (Fin (2 * j) → ℕ) → Finset (Fin (2 * j)) → ℕ →₀ ℂ :=
    fun x ν G => (∏ i ∈ G, slot x ν i).coeff
  have hΘ (x : ℝ) (hx : X0 ≤ x) : 1 < Θ x ∧ Θ x ≤ 2 := by
    have hℓpos : 0 < Real.log x := zero_lt_one.trans_le (hlog x hx)
    have hsmall : (Real.log x) ^ (-(D : ℝ)) ≤ 1 :=
      Real.rpow_le_one_of_one_le_of_nonpos (hlog x hx) (neg_nonpos.mpr (Nat.cast_nonneg D))
    dsimp only [Θ]
    exact ⟨lt_add_of_pos_right 1 (Real.rpow_pos_of_pos hℓpos _), by linarith⟩
  have hscaleone (x : ℝ) (hx : X0 ≤ x) (ν : Fin (2 * j) → ℕ)
      (i : Fin (2 * j)) : 1 ≤ scale x ν i :=
    one_le_pow₀ (hΘ x hx).1.le
  have hQone (x : ℝ) (hx : X0 ≤ x) (ν : Fin (2 * j) → ℕ)
      (G : Finset (Fin (2 * j))) : 1 ≤ Q x ν G :=
    Finset.one_le_prod fun i _hi => hscaleone x hx ν i
  have hcard40 (G : Finset (Fin (2 * j))) : G.card ≤ 40 := by
    have hG := card_finset_fin_le G
    have hj' := hjrange.2
    omega
  let B2 : ℝ := (2 : ℝ) ^ 40
  let c : ℝ := 1 / B2
  let Cf : ℝ := B2 * C0 ^ 2
  let W : ℝ := (3 : ℝ) ^ 40
  have hB2pos : 0 < B2 := by positivity
  have hB2one : 1 ≤ B2 := one_le_pow₀ (by norm_num : (1 : ℝ) ≤ 2)
  have hc : 0 < c := div_pos zero_lt_one hB2pos
  have hC0sq : C0 ≤ C0 ^ 2 := le_self_pow₀ hC0 (by decide)
  have hC0Cf : C0 ≤ Cf :=
    hC0sq.trans (le_mul_of_one_le_left (sq_nonneg C0) hB2one)
  have hCf : 1 ≤ Cf := hC0.trans hC0Cf
  have hW : 0 ≤ W := by positivity
  have hgeometry (x P' PS PT : ℝ) (hx : X0 ≤ x)
      (hPSone : 1 ≤ PS) (hPTone : 1 ≤ PT) (hprod : PS * PT = P')
      (hPlower : x / C0 ≤ P') (hPupper : P' ≤ C0 * x)
      (hPSlower : x ^ (1 / 2 - σclass) / C0 < PS) (hST : PS ≤ PT) :
      (x / Cf ≤ PT * min PS (Real.sqrt x) ∧
        PT * min PS (Real.sqrt x) ≤ Cf * x ∧
        x ^ (1 / 2 - σdist) ≤ min PS (Real.sqrt x) ∧
        min PS (Real.sqrt x) ≤ x ^ (1 / 2 : ℝ)) ∧
      PS ≤ C0 * min PS (Real.sqrt x) ∧ x ^ d ≤ PS ∧ PS ≤ x ^ (2 : ℝ) := by
    have hPSpos : 0 < PS := zero_lt_one.trans_le hPSone
    have hPTpos : 0 < PT := zero_lt_one.trans_le hPTone
    have hPSsq : PS ^ 2 ≤ C0 * x := by
      calc
        PS ^ 2 = PS * PS := pow_two PS
        _ ≤ PS * PT := mul_le_mul_of_nonneg_left hST hPSpos.le
        _ = P' := hprod
        _ ≤ C0 * x := hPupper
    have hPSroot : PS ≤ C0 * Real.sqrt x := by
      calc
        PS ≤ Real.sqrt (C0 * x) := Real.le_sqrt_of_sq_le hPSsq
        _ = Real.sqrt C0 * Real.sqrt x := Real.sqrt_mul hC0pos.le x
        _ ≤ C0 * Real.sqrt x :=
          mul_le_mul_of_nonneg_right
            (Real.sqrt_le_self_iff.mpr (Or.inr hC0)) (Real.sqrt_nonneg x)
    have hPSN : PS ≤ C0 * min PS (Real.sqrt x) := by
      rw [mul_min_of_nonneg _ _ hC0pos.le]
      exact le_min (le_mul_of_one_le_left hPSpos.le hC0) hPSroot
    have hpolyLower : x ^ d ≤ PS := by
      have hh : x ^ d * C0 ≤ x ^ (1 / 2 - σclass) := by
        calc
          x ^ d * C0 ≤ x ^ d * x ^ d :=
            mul_le_mul_of_nonneg_left (hlargeX x hx).2
              (Real.rpow_nonneg (hxpos x hx).le d)
          _ = x ^ (1 / 2 - σclass) := by
            rw [← Real.rpow_add (hxpos x hx)]
            congr 1
            dsimp only [d]
            ring
      exact ((le_div_iff₀ hC0pos).2 hh).trans hPSlower.le
    have hpolyUpper : PS ≤ x ^ (2 : ℝ) := by
      rw [Real.rpow_two]
      calc
        PS ≤ PS * PT := le_mul_of_one_le_right hPSpos.le hPTone
        _ = P' := hprod
        _ ≤ C0 * x := hPupper
        _ ≤ x * x := mul_le_mul_of_nonneg_right (hC0X0.trans hx) (hxpos x hx).le
        _ = x ^ 2 := (pow_two x).symm
    have hNlower : x ^ (1 / 2 - σdist) ≤ min PS (Real.sqrt x) := by
      apply le_min
      · have hh : x ^ (1 / 2 - σdist) * C0 ≤ x ^ (1 / 2 - σclass) := by
          calc
            x ^ (1 / 2 - σdist) * C0 ≤
                x ^ (1 / 2 - σdist) * x ^ (σdist - σclass) :=
              mul_le_mul_of_nonneg_left (hlargeX x hx).1
                (Real.rpow_nonneg (hxpos x hx).le _)
            _ = x ^ (1 / 2 - σclass) := by
              rw [← Real.rpow_add (hxpos x hx)]
              congr 1
              ring
        exact ((le_div_iff₀ hC0pos).2 hh).trans hPSlower.le
      · rw [Real.sqrt_eq_rpow]
        exact Real.rpow_le_rpow_of_exponent_le (hxone x hx)
          (sub_le_self _ hσdist.1.le)
    have hMNlower : x / C0 ≤ PT * min PS (Real.sqrt x) := by
      by_cases hh : PS ≤ Real.sqrt x
      · calc
          x / C0 ≤ P' := hPlower
          _ = PT * min PS (Real.sqrt x) := by
            rw [min_eq_left hh, mul_comm, hprod]
      · have hh' : Real.sqrt x ≤ PS := (lt_of_not_ge hh).le
        calc
          x / C0 ≤ x := div_le_self (hxpos x hx).le hC0
          _ = Real.sqrt x * Real.sqrt x := (Real.mul_self_sqrt (hxpos x hx).le).symm
          _ ≤ PT * Real.sqrt x :=
            mul_le_mul_of_nonneg_right (hh'.trans hST) (Real.sqrt_nonneg x)
          _ = PT * min PS (Real.sqrt x) := by rw [min_eq_right hh']
    have hMNupper : PT * min PS (Real.sqrt x) ≤ C0 * x := by
      calc
        PT * min PS (Real.sqrt x) ≤ PT * PS :=
          mul_le_mul_of_nonneg_left (min_le_left _ _) hPTpos.le
        _ = P' := (mul_comm PT PS).trans hprod
        _ ≤ C0 * x := hPupper
    refine ⟨⟨?_, ?_, hNlower, ?_⟩, hPSN, hpolyLower, hpolyUpper⟩
    · exact (div_le_div_of_nonneg_left (hxpos x hx).le hC0pos hC0Cf).trans hMNlower
    · exact hMNupper.trans (mul_le_mul_of_nonneg_right hC0Cf (hxpos x hx).le)
    · simpa only [Real.sqrt_eq_rpow] using min_le_right PS (Real.sqrt x)
  have hbox (x : ℝ) (hx : X0 ≤ x) (ν : Fin (2 * j) → ℕ)
      (hPupper : P x ν ≤ C0 * x) (G : Finset (Fin (2 * j))) (hG : G.Nonempty) :
      (∀ n ∈ (coeff x ν G).support,
        Q x ν G / (2 : ℝ) ^ G.card ≤ (n : ℝ) ∧
          (n : ℝ) ≤ (2 : ℝ) ^ G.card * Q x ν G) ∧
      ∀ n : ℕ, ‖coeff x ν G n‖ ≤
        W * (n.divisors.card : ℝ) ^ 40 * (Real.log x) ^ 40 := by
    have hslots := heathBrown_geometric_slots_support_norm
      j (Θ x) (U x) x C0 (scale x ν) (hΘ x hx).1 (hΘ x hx).2
        (hX0.trans hx) (hC0X0.trans hx) (hscaleone x hx ν) hPupper
    have hℓ : 1 ≤ Real.log x := hlog x hx
    have hbase : 1 ≤ 3 * Real.log x := by linarith
    have hraw := heathBrown_box_product_support_norm_bound G hG
      (slot x ν) (scale x ν) (3 * Real.log x) (zero_le_one.trans hbase)
      (fun i _hi => hscaleone x hx ν i)
      (fun i _hi => hslots.1 i) (fun i _hi => hslots.2.1 i)
    change (∀ n ∈ (coeff x ν G).support,
      Q x ν G / (2 : ℝ) ^ G.card ≤ (n : ℝ) ∧
        (n : ℝ) ≤ (2 : ℝ) ^ G.card * Q x ν G) ∧
      (∀ n : ℕ, ‖coeff x ν G n‖ ≤
        (3 * Real.log x) ^ G.card * (n.divisors.card : ℝ) ^ (G.card - 1)) at hraw
    have hzero : coeff x ν G 0 = 0 := by
      apply Finsupp.notMem_support_iff.mp
      intro hn
      have hh := (hraw.1 0 hn).1
      have hpos : 0 < Q x ν G / (2 : ℝ) ^ G.card :=
        div_pos (zero_lt_one.trans_le (hQone x hx ν G)) (pow_pos zero_lt_two _)
      exact hpos.not_ge (by simpa only [Nat.cast_zero] using hh)
    refine ⟨hraw.1, ?_⟩
    intro n
    by_cases hn : n = 0
    · subst n
      simp [hzero]
    · have hdv : 1 ≤ (n.divisors.card : ℝ) := by
        exact_mod_cast Finset.one_le_card.mpr (Nat.nonempty_divisors.mpr hn)
      calc
        ‖coeff x ν G n‖ ≤ (3 * Real.log x) ^ G.card *
            (n.divisors.card : ℝ) ^ (G.card - 1) := hraw.2 n
        _ ≤ (3 * Real.log x) ^ 40 * (n.divisors.card : ℝ) ^ 40 :=
          mul_le_mul (pow_le_pow_right₀ hbase (hcard40 G))
            (pow_le_pow_right₀ hdv ((Nat.sub_le _ _).trans (hcard40 G)))
            (pow_nonneg (Nat.cast_nonneg _) _) (pow_nonneg (zero_le_one.trans hbase) _)
        _ = W * (n.divisors.card : ℝ) ^ 40 * (Real.log x) ^ 40 := by
          dsimp only [W]
          rw [mul_pow]
          ring
  have hsupportTransfer (x : ℝ) (hx : X0 ≤ x) (ν : Fin (2 * j) → ℕ)
      (G : Finset (Fin (2 * j))) (L : ℝ) (hL : 0 ≤ L)
      (hLQ : L ≤ Q x ν G) (hQL : Q x ν G ≤ C0 * L)
      (hs : ∀ n ∈ (coeff x ν G).support,
        Q x ν G / (2 : ℝ) ^ G.card ≤ (n : ℝ) ∧
          (n : ℝ) ≤ (2 : ℝ) ^ G.card * Q x ν G) :
      ∀ n ∈ (coeff x ν G).support, c * L ≤ (n : ℝ) ∧ (n : ℝ) ≤ Cf * L := by
    have hQ : 0 ≤ Q x ν G := zero_le_one.trans (hQone x hx ν G)
    have hpow : (2 : ℝ) ^ G.card ≤ B2 :=
      pow_le_pow_right₀ (by norm_num) (hcard40 G)
    intro n hn
    constructor
    · calc
        c * L = L / B2 := by dsimp only [c]; ring
        _ ≤ Q x ν G / B2 := div_le_div_of_nonneg_right hLQ hB2pos.le
        _ ≤ Q x ν G / (2 : ℝ) ^ G.card :=
          div_le_div_of_nonneg_left hQ (pow_pos zero_lt_two _) hpow
        _ ≤ (n : ℝ) := (hs n hn).1
    · calc
        (n : ℝ) ≤ (2 : ℝ) ^ G.card * Q x ν G := (hs n hn).2
        _ ≤ B2 * Q x ν G := mul_le_mul_of_nonneg_right hpow hQ
        _ ≤ B2 * (C0 * L) := mul_le_mul_of_nonneg_left hQL hB2pos.le
        _ ≤ B2 * (C0 ^ 2 * L) :=
          mul_le_mul_of_nonneg_left
            (mul_le_mul_of_nonneg_right hC0sq hL) hB2pos.le
        _ = Cf * L := by dsimp only [Cf]; ring
  let Index : Type := (Fin (2 * j) → ℕ) ×
    (Finset (Fin (2 * j)) × Finset (Fin (2 * j)))
  let Active : ℝ → Index → Prop := fun x z =>
    x / C0 ≤ P x z.1 ∧ P x z.1 ≤ C0 * x ∧
      Disjoint z.2.1 z.2.2 ∧ z.2.1 ∪ z.2.2 = Finset.univ ∧
      z.2.1.Nonempty ∧ z.2.2.Nonempty ∧
      x ^ (1 / 2 - σclass) / C0 < Q x z.1 z.2.1 ∧
      Q x z.1 z.2.1 ≤ Q x z.1 z.2.2
  let MFamily : ℝ → Index → ℝ := fun x z =>
    if Active x z then Q x z.1 z.2.2 else Real.sqrt x
  let NFamily : ℝ → Index → ℝ := fun x z =>
    if Active x z then min (Q x z.1 z.2.1) (Real.sqrt x) else Real.sqrt x
  let αFamily : ℝ → Index → ℕ →₀ ℂ := fun x z =>
    if Active x z then coeff x z.1 z.2.2 else 0
  let βFamily : ℝ → Index → ℕ →₀ ℂ := fun x z =>
    if Active x z then coeff x z.1 z.2.1 else 0
  have hgeom (x : ℝ) (hx : X0 ≤ x) (z : Index) (hz : Active x z) :
      (x / Cf ≤ MFamily x z * NFamily x z ∧
        MFamily x z * NFamily x z ≤ Cf * x ∧
        x ^ (1 / 2 - σdist) ≤ NFamily x z ∧
        NFamily x z ≤ x ^ (1 / 2 : ℝ)) ∧
      Q x z.1 z.2.1 ≤ C0 * NFamily x z ∧
        x ^ d ≤ Q x z.1 z.2.1 ∧ Q x z.1 z.2.1 ≤ x ^ (2 : ℝ) := by
    have hact := hz
    rcases hact with ⟨hPlower, hPupper, hdisj, hunion, _, _, hPSlower, hST⟩
    have hprod : Q x z.1 z.2.1 * Q x z.1 z.2.2 = P x z.1 := by
      dsimp only [Q, P]
      rw [← Finset.prod_union hdisj, hunion]
    simpa only [MFamily, NFamily, ite_eq_left hz] using
      hgeometry x (P x z.1) (Q x z.1 z.2.1) (Q x z.1 z.2.2) hx
        (hQone x hx z.1 z.2.1) (hQone x hx z.1 z.2.2)
        hprod hPlower hPupper hPSlower hST
  have hscaleFamily : ∀ x : ℝ, X0 ≤ x → ∀ z : Index,
      x / Cf ≤ MFamily x z * NFamily x z ∧
        MFamily x z * NFamily x z ≤ Cf * x ∧
        x ^ (1 / 2 - σdist) ≤ NFamily x z ∧
        NFamily x z ≤ x ^ (1 / 2 : ℝ) := by
    intro x hx z
    by_cases hz : Active x z
    · exact (hgeom x hx z hz).1
    · simp only [MFamily, NFamily, ite_eq_right hz]
      simp only [Real.mul_self_sqrt (hxpos x hx).le]
      refine ⟨div_le_self (hxpos x hx).le hCf,
        le_mul_of_one_le_left (hxpos x hx).le hCf, ?_, ?_⟩
      · rw [Real.sqrt_eq_rpow]
        exact Real.rpow_le_rpow_of_exponent_le (hxone x hx)
          (sub_le_self _ hσdist.1.le)
      · exact (Real.sqrt_eq_rpow x).le
  have hsupportFamily : ∀ x : ℝ, X0 ≤ x → ∀ z : Index,
      (∀ n ∈ (αFamily x z).support,
        c * MFamily x z ≤ (n : ℝ) ∧ (n : ℝ) ≤ Cf * MFamily x z) ∧
      (∀ n ∈ (βFamily x z).support,
        c * NFamily x z ≤ (n : ℝ) ∧ (n : ℝ) ≤ Cf * NFamily x z) := by
    intro x hx z
    by_cases hz : Active x z
    · have hact := hz
      rcases hact with ⟨_, hPupper, _, _, hSne, hTne, _, _⟩
      have hs := (hbox x hx z.1 hPupper z.2.1 hSne).1
      have ht := (hbox x hx z.1 hPupper z.2.2 hTne).1
      have hgg := hgeom x hx z hz
      have hTnonneg : 0 ≤ Q x z.1 z.2.2 := zero_le_one.trans (hQone x hx z.1 z.2.2)
      have hNnonneg : 0 ≤ NFamily x z :=
        (Real.rpow_nonneg (hxpos x hx).le _).trans hgg.1.2.2.1
      constructor
      · simpa only [αFamily, MFamily, ite_eq_left hz] using
          hsupportTransfer x hx z.1 z.2.2 (Q x z.1 z.2.2) hTnonneg le_rfl
            (le_mul_of_one_le_left hTnonneg hC0) ht
      · have hNQ : NFamily x z ≤ Q x z.1 z.2.1 := by
          simp only [NFamily, ite_eq_left hz]
          exact min_le_left _ _
        simpa only [βFamily, ite_eq_left hz] using
          hsupportTransfer x hx z.1 z.2.1 (NFamily x z) hNnonneg hNQ hgg.2.1 hs
    · have hαzero : αFamily x z = 0 := ite_eq_right hz
      have hβzero : βFamily x z = 0 := ite_eq_right hz
      rw [hαzero, hβzero, Finsupp.support_zero]
      exact ⟨fun n hn => (Finset.notMem_empty n hn).elim,
        fun n hn => (Finset.notMem_empty n hn).elim⟩
  have hcoeffFamily : ∀ x : ℝ, X0 ≤ x → ∀ z : Index, ∀ n : ℕ,
      ‖αFamily x z n‖ ≤ W * (n.divisors.card : ℝ) ^ 40 * (Real.log x) ^ 40 ∧
      ‖βFamily x z n‖ ≤ W * (n.divisors.card : ℝ) ^ 40 * (Real.log x) ^ 40 := by
    intro x hx z n
    by_cases hz : Active x z
    · have hact := hz
      rcases hact with ⟨_, hPupper, _, _, hSne, hTne, _, _⟩
      simpa only [αFamily, βFamily, ite_eq_left hz] using
        And.intro ((hbox x hx z.1 hPupper z.2.2 hTne).2 n)
          ((hbox x hx z.1 hPupper z.2.1 hSne).2 n)
    · have hℓ : 0 ≤ Real.log x := zero_le_one.trans (hlog x hx)
      have hαzero : αFamily x z = 0 := ite_eq_right hz
      have hβzero : βFamily x z = 0 := ite_eq_right hz
      rw [hαzero, hβzero, Finsupp.zero_apply, norm_zero]
      have hbound : 0 ≤ W * (n.divisors.card : ℝ) ^ 40 * (Real.log x) ^ 40 :=
        mul_nonneg (mul_nonneg hW (pow_nonneg (Nat.cast_nonneg _) _))
          (pow_nonneg hℓ _)
      exact ⟨hbound, hbound⟩
  have hSWFamily : ∀ Asw : ℝ, 0 < Asw →
      ∃ KSW XSW : ℝ, 0 < KSW ∧ X0 ≤ XSW ∧
        ∀ x : ℝ, XSW ≤ x → ∀ z : Index,
        ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
          ‖fullDiscrepancy
              ((βFamily x z).filter (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
            KSW * ((q * r).divisors.card : ℝ) ^ 2 * NFamily x z /
              (Real.log x) ^ Asw := by
    intro Asw hAsw
    have hDpos : (0 : ℝ) < (D : ℝ) := by
      exact_mod_cast (show 0 < D by omega)
    obtain ⟨Csw, Xsw, hCsw, _, hsw⟩ :=
      heathBrown_localized_products_fixedPower_siegelWalfisz
        40 (by norm_num) d 2 hd (by norm_num) (D : ℝ) hDpos Asw hAsw
    refine ⟨Csw * C0, max X0 Xsw, mul_pos hCsw hC0pos, le_max_left _ _, ?_⟩
    intro x hx z q r a hq hr ha
    have hx0 : X0 ≤ x := (le_max_left _ _).trans hx
    have hxsw : Xsw ≤ x := (le_max_right _ _).trans hx
    have hℓpos : 0 < Real.log x := zero_lt_one.trans_le (hlog x hx0)
    by_cases hz : Active x z
    · have hact := hz
      rcases hact with ⟨_, _, _, _, hSne, _, _, _⟩
      let S : Finset (Fin (2 * j)) := z.2.1
      let ν : Fin (2 * j) → ℕ := z.1
      let G : ℕ →₀ ℂ := coeff x ν S
      let e : Fin S.card ≃ S := S.equivFin.symm
      have hNprod :
          (∏ b : Fin S.card, scale x ν (e b)) = Q x ν S :=
        (e.prod_comp (fun i : S => scale x ν i)).trans
          (Finset.prod_coe_sort S (scale x ν))
      let role : Fin S.card → Fin 4 := fun b =>
        if (e b).1.val < j then 0
        else if (e b).1.val + 1 = 2 * j then 3 else 2
      let fsw : Fin S.card → ℕ → ℝ := fun b n =>
        if role b = 0 then μU x n else if role b = 1 then |μU x n|
        else if role b = 2 then (ArithmeticFunction.zeta : ArithmeticFunction ℝ) n
        else ArithmeticFunction.log n
      have hfsw (b : Fin S.card) (n : ℕ) : fsw b n = f x (e b) n := by
        by_cases hμ : (e b).1.val < j
        · simp [fsw, role, f, hμ]
        · by_cases hln : (e b).1.val + 1 = 2 * j
          · simp [fsw, role, f, hμ, hln]
          · simp [fsw, role, f, hμ, hln]
      let βsw : Fin S.card → MonoidAlgebra ℂ ℕ := fun b =>
        ∑ n ∈ Finset.Icc (max 1 (1 : ℕ)) ⌊Θ x * scale x ν (e b)⌋₊,
          MonoidAlgebra.single n
            (((η x ((n : ℝ) / scale x ν (e b)) *
              Real.rpow (n : ℝ) (-(0 : ℝ)) * fsw b n : ℝ) : ℂ))
      have hβsw (b : Fin S.card) : βsw b = slot x ν (e b) := by
        simp only [βsw, slot, max_self, neg_zero, Real.rpow_eq_pow, Real.rpow_zero, mul_one, hfsw]
      have hβprod : (∏ b : Fin S.card, βsw b) = ∏ i ∈ S, slot x ν i := by
        calc
          _ = ∏ b : Fin S.card, slot x ν (e b) :=
            Finset.prod_congr rfl fun b _hb => hβsw b
          _ = _ := (e.prod_comp (fun i : S => slot x ν i)).trans
            (Finset.prod_coe_sort S (slot x ν))
      have hR (b : Fin S.card) :
          (⌊Θ x * scale x ν (e b)⌋₊ : ℝ) ≤ 2 * scale x ν (e b) :=
        (Nat.floor_le
          (mul_nonneg (zero_lt_one.trans (hΘ x hx0).1).le
            (zero_le_one.trans (hscaleone x hx0 ν (e b))))).trans
          (mul_le_mul_of_nonneg_right (hΘ x hx0).2
            (zero_le_one.trans (hscaleone x hx0 ν (e b))))
      have hfilter :
          G.filter (fun n : ℕ => 0 ≤ n ∧ n ≤ G.support.sup id) = G := by
        apply (Finsupp.filter_eq_self_iff _ _).2
        intro n hn
        exact ⟨Nat.zero_le n,
          Finset.le_sup (f := id) (Finsupp.mem_support_iff.mpr hn)⟩
      have hgg := hgeom x hx0 z hz
      have hraw := hsw x hxsw S.card hSne.card_pos (hcard40 S)
        (fun b => scale x ν (e b)) (fun _ => U x) (fun _ => 0)
        (fun b => hscaleone x hx0 ν (e b))
        (by simpa only [hNprod] using hgg.2.2.1)
        (by simpa only [hNprod] using hgg.2.2.2)
        (fun _ => by norm_num) role (fun _ => 1)
        (fun b => ⌊Θ x * scale x ν (e b)⌋₊) hR 0 (G.support.sup id)
      have hh := hraw.2.2 q r a hq hr ha
      change
        ‖fullDiscrepancy
          (((∏ b : Fin S.card, βsw b).coeff.filter
            (fun n : ℕ => 0 ≤ n ∧ n ≤ G.support.sup id)).filter
              (fun n => Nat.Coprime n r)) q a‖ ≤
          Csw * ((q * r).divisors.card : ℝ) ^ 2 *
            (∏ b : Fin S.card, scale x ν (e b)) / (Real.log x) ^ Asw at hh
      rw [hNprod, hβprod] at hh
      change ‖fullDiscrepancy
          ((G.filter (fun n : ℕ => 0 ≤ n ∧ n ≤ G.support.sup id)).filter
            (fun n => Nat.Coprime n r)) q a‖ ≤
          Csw * ((q * r).divisors.card : ℝ) ^ 2 * Q x ν S /
            (Real.log x) ^ Asw at hh
      rw [hfilter] at hh
      have hmain : ‖fullDiscrepancy (G.filter (fun n => Nat.Coprime n r)) q a‖ ≤
          (Csw * C0) * ((q * r).divisors.card : ℝ) ^ 2 * NFamily x z /
            (Real.log x) ^ Asw := by
        calc
          _ ≤ Csw * ((q * r).divisors.card : ℝ) ^ 2 * Q x ν S /
              (Real.log x) ^ Asw := hh
          _ ≤ Csw * ((q * r).divisors.card : ℝ) ^ 2 * (C0 * NFamily x z) /
              (Real.log x) ^ Asw :=
            div_le_div_of_nonneg_right
              (mul_le_mul_of_nonneg_left hgg.2.1
                (mul_nonneg hCsw.le (sq_nonneg _)))
              (Real.rpow_pos_of_pos hℓpos Asw).le
          _ = (Csw * C0) * ((q * r).divisors.card : ℝ) ^ 2 * NFamily x z /
              (Real.log x) ^ Asw := by ring
      simpa only [βFamily, ite_eq_left hz] using hmain
    · have hNinactive : NFamily x z = Real.sqrt x := ite_eq_right hz
      have hNnonneg : 0 ≤ NFamily x z := hNinactive.symm ▸ Real.sqrt_nonneg x
      have hβzero : βFamily x z = 0 := ite_eq_right hz
      have hzero : fullDiscrepancy
          ((βFamily x z).filter (fun n : ℕ => Nat.Coprime n r)) q a = 0 := by
        rw [hβzero, Finsupp.filter_zero]
        simp only [fullDiscrepancy, progressionMass, reducedMass,
          Finsupp.support_zero, Finset.sum_empty, zero_div, sub_self]
      rw [hzero, norm_zero]
      exact div_nonneg
        (mul_nonneg
          (mul_nonneg (mul_nonneg hCsw.le hC0pos.le)
            (sq_nonneg (((q * r).divisors.card : ℝ)))) hNnonneg)
        (Real.rpow_pos_of_pos hℓpos Asw).le
  intro A hAsave
  have hinput : ∃ K X : ℝ, 0 < K ∧ X0 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ z : Index,
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
            q ∣ (∏ p ∈ I, p) ∧
              Nonempty (DenseDivisibilityWitness
                ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩ density q)),
          ‖fullDiscrepancy (finiteConvolution (αFamily x z) (βFamily x z)) q a‖) ≤
            K * x / (Real.log x) ^ A := by
    rcases hdist with ⟨rfl, hI, hII⟩ | ⟨rfl, hI, hII⟩ | ⟨rfl, hI, hII, hIII⟩
    · exact sourceTypeI_II_lowerOrder_dense_uniform_log_saving
        1 «ω» δ σdist hω hδ hσdist.1 (Or.inl ⟨rfl, hI⟩) hII
        MFamily NFamily αFamily βFamily c Cf W X0 40 2
        hc hCf hW hX0 hscaleFamily hsupportFamily hcoeffFamily hSWFamily A hAsave
    · exact sourceTypeI_II_lowerOrder_dense_uniform_log_saving
        2 «ω» δ σdist hω hδ hσdist.1 (Or.inr ⟨rfl, hI⟩) hII
        MFamily NFamily αFamily βFamily c Cf W X0 40 2
        hc hCf hW hX0 hscaleFamily hsupportFamily hcoeffFamily hSWFamily A hAsave
    · exact sourceTypeI_II_triply_dense_uniform_log_saving_of_deligne hDeligne
        «ω» δ σdist hω hδ hσdist.1 hI hII hIII
        MFamily NFamily αFamily βFamily c Cf W X0 40 2
        hc hCf hW hX0 hscaleFamily hsupportFamily hcoeffFamily hSWFamily A hAsave
  obtain ⟨K, X, hK, hXX0, hbound⟩ := hinput
  refine ⟨K, X, hK, hX0.trans hXX0, ?_⟩
  intro x hx Θ' U' η' μU' f' ν Ni' β' hPlower hPupper
    S T hdisj hunion hSne hTne hPSlower hST I hI a ha
  let z : Index := (ν, S, T)
  have hz : Active x z := ⟨hPlower, hPupper, hdisj, hunion, hSne, hTne, hPSlower, hST⟩
  have hfactor : finiteConvolution (αFamily x z) (βFamily x z) =
      (∏ i, slot x ν i).coeff := by
    simp only [αFamily, βFamily, ite_eq_left hz]
    change ((∏ i ∈ T, slot x ν i) * (∏ i ∈ S, slot x ν i)).coeff =
      (∏ i, slot x ν i).coeff
    apply congrArg (fun v : MonoidAlgebra ℂ ℕ => v.coeff)
    rw [← Finset.prod_union hdisj.symm, Finset.union_comm, hunion]
  simpa only [hfactor] using hbound x hx z I hI a ha

open Classical in
theorem heathBrown_term_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (density : ℕ) (hdensity : 1 ≤ density)
    («ω» δ σ σdist : ℝ) (hω : 0 < «ω») (hωupper : «ω» < 1 / 12) (hδ : 0 < δ)
    (hσ0 : 1 / 10 < σ) (hσhalf : σ < 1 / 2) (hσgap : 2 * «ω» < σ)
    (hσσ : σ < σdist) (hσdistHalf : σdist < 1 / 2)
    (hphysical : 1 / 18 + 28 / 9 * «ω» + 2 / 9 * δ < σ)
    (hdist :
      (density = 1 ∧ 54 * «ω» + 15 * δ + 5 * σdist < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (density = 2 ∧ 56 * «ω» + 16 * δ + 4 * σdist < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (density = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σdist < 1 ∧ 64 * «ω» + 20 * δ + 2 * σdist < 1))
    (j : ℕ) (hj : 1 ≤ j) (hj20 : j ≤ 20) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
        let U : ℝ := (2 * x) ^ (1 / 20 : ℝ)
        let μU := arithmeticFunctionLowCutoff U
          (ArithmeticFunction.moebius : ArithmeticFunction ℝ)
        let H : ArithmeticFunction ℝ :=
          μU ^ j * (ArithmeticFunction.zeta : ArithmeticFunction ℝ) ^ (j - 1) *
            ArithmeticFunction.log
        let target : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
          Finsupp.single n ((H n : ℝ) : ℂ)
        ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
        ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
          (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
                q ∣ (∏ p ∈ I, p) ∧
                  Nonempty (DenseDivisibilityWitness
                    ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩ density q)),
            ‖fullDiscrepancy target q a‖) ≤
              K * x / (Real.log x) ^ A := by
  have hθ0 : 0 < (1 / 2 : ℝ) + 2 * «ω» := by linarith
  have hθ1 : (1 / 2 : ℝ) + 2 * «ω» < 1 := by linarith
  let C0 : ℝ := (2 : ℝ) ^ (41 : ℕ)
  have hC0 : 1 ≤ C0 := one_le_pow₀ one_le_two
  have hC0pos : 0 < C0 := zero_lt_one.trans_le hC0
  intro A hA
  obtain ⟨D, hD, Kb, Xb, hKb, hXb, hboundary⟩ :=
    heathBrown_finite_smooth_box_closedCutoff_discrepancy
      j hj 0 (1 / 2 + 2 * «ω») 2 hθ0 hθ1 (by norm_num) A hA
  let loss : ℕ := 2 * j * (D + 1)
  let Abox : ℝ := A + (loss : ℝ)
  have hAbox : 0 < Abox := add_pos_of_pos_of_nonneg hA (Nat.cast_nonneg loss)
  obtain ⟨K0, X0, hK0, hX0, hzero⟩ :=
    heathBrown_zero_boxes_log_saving density j D hj hj20 «ω» δ σ C0 hC0 hσgap hσhalf
      Abox hAbox
  obtain ⟨Ks, Xs, hKs, hXs, hsplit⟩ :=
    heathBrown_split_boxes_log_saving_of_deligne hDeligne density j D hj hj20 hD
      «ω» δ σ σdist C0 hω hδ (by linarith) hσhalf hσσ hσdistHalf hC0
      hdist Abox hAbox
  obtain ⟨K3, X3, hK3, hX3, hthree⟩ :=
    heathBrown_three_boxes_log_saving_of_deligne hDeligne density hdensity j D hj hj20 hD
      «ω» δ σ C0 hω hωupper hδ hσhalf hC0 hphysical Abox hAbox
  let Kbox : ℝ := K0 + Ks + K3
  have hKbox : 0 < Kbox := add_pos (add_pos hK0 hKs) hK3
  have hgap : 0 < 2 * σ - 1 / 20 := by linarith
  obtain ⟨Xcut, hXcut⟩ := Filter.eventually_atTop.mp
    ((tendsto_rpow_atTop hgap).eventually_gt_atTop
      (2 * (2 : ℝ) ^ (1 / 20 : ℝ) * C0))
  let X : ℝ := max (max (max Xb X0) (max Xs X3)) (max (C0 + 1) Xcut)
  have hXbX : Xb ≤ X :=
    (le_max_left _ _).trans ((le_max_left _ _).trans (le_max_left _ _))
  have hX0X : X0 ≤ X :=
    (le_max_right _ _).trans ((le_max_left _ _).trans (le_max_left _ _))
  have hXsX : Xs ≤ X :=
    (le_max_left _ _).trans ((le_max_right _ _).trans (le_max_left _ _))
  have hX3X : X3 ≤ X :=
    (le_max_right _ _).trans ((le_max_right _ _).trans (le_max_left _ _))
  have hCX : C0 + 1 ≤ X := (le_max_left _ _).trans (le_max_right _ _)
  have hcutX : Xcut ≤ X := (le_max_right _ _).trans (le_max_right _ _)
  refine ⟨Kb + (8 : ℝ) ^ (2 * j) * Kbox, X, by positivity,
    ((le_max_left _ _).trans hXb).trans hXbX, ?_⟩
  intro x hx U μU H target I hIprime a ha
  have hxexp : Real.exp 1 ≤ x := ((le_max_left _ _).trans hXb).trans (hXbX.trans hx)
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hxone : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hxexp
  have hlog : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hxexp
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlog
  have hC0x : C0 < x := by linarith [hCX.trans hx]
  let Θ : ℝ := 1 + (Real.log x) ^ (-(D : ℝ))
  let η : ℝ → ℝ := fun z =>
    if 0 < z then
      Real.smoothTransition (Real.log z / Real.log Θ + 1) -
        Real.smoothTransition (Real.log z / Real.log Θ)
    else 0
  let M : ℕ := ⌈Real.log (2 * x) / Real.log Θ⌉₊
  let grid : Finset (Fin (2 * j) → ℕ) :=
    Fintype.piFinset (fun _ : Fin (2 * j) => Finset.range (M + 1))
  let scale : (Fin (2 * j) → ℕ) → Fin (2 * j) → ℝ := fun ν i => Θ ^ ν i
  let boxes : Finset (Fin (2 * j) → ℕ) := grid.filter (fun ν =>
    x / Θ ^ (2 * j) ≤ (∏ i, scale ν i) ∧
      (∏ i, scale ν i) ≤ (2 * x) * Θ ^ (2 * j))
  let f : Fin (2 * j) → ArithmeticFunction ℝ := fun i =>
    if i.val < j then μU else if i.val + 1 = 2 * j then
      ArithmeticFunction.log else ArithmeticFunction.zeta
  let β : (Fin (2 * j) → ℕ) → Fin (2 * j) → MonoidAlgebra ℂ ℕ := fun ν i =>
    ∑ n ∈ Finset.Icc 1 ⌊Θ * scale ν i⌋₊,
      MonoidAlgebra.single n (((η ((n : ℝ) / scale ν i) * f i n : ℝ) : ℂ))
  let S := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
                q ∣ (∏ p ∈ I, p) ∧
                  Nonempty (DenseDivisibilityWitness
                    ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩ density q))
  have hS : S ⊆ Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊ := Finset.filter_subset _ _
  have hprimitive (q : ℕ) (hq : q ∈ S) : Nat.Coprime a q :=
    ha.of_dvd_right (Finset.mem_filter.mp hq).2.1
  have hboundary' : (∑ q ∈ S,
      ‖fullDiscrepancy target q a -
        ∑ ν ∈ boxes, fullDiscrepancy (∏ i, β ν i).coeff q a‖) ≤
        Kb * x / (Real.log x) ^ A := by
    have hh := hboundary x (hXbX.trans hx) x (2 * x) U 0
      (by linarith) (by linarith) le_rfl (by norm_num) (by norm_num)
      S hS (fun _ => a) hprimitive
    simpa only [neg_zero, Real.rpow_eq_pow, Real.rpow_zero, mul_one, one_mul, pow_zero] using hh
  have hΘ : 1 < Θ := lt_add_of_pos_right 1 (Real.rpow_pos_of_pos hlogpos _)
  have hΘtwo : Θ ≤ 2 := by
    have hh := Real.rpow_le_one_of_one_le_of_nonpos hlog
      (neg_nonpos.mpr (Nat.cast_nonneg D))
    change 1 + (Real.log x) ^ (-(D : ℝ)) ≤ 2
    linarith
  have hΘpow : Θ ^ (2 * j) ≤ (2 : ℝ) ^ (40 : ℕ) :=
    (pow_le_pow_left₀ (zero_lt_one.trans hΘ).le hΘtwo (2 * j)).trans
      (pow_le_pow_right₀ one_le_two (by omega))
  have hΘpowC : Θ ^ (2 * j) ≤ C0 := hΘpow.trans (by norm_num [C0])
  have hscale (ν : Fin (2 * j) → ℕ) (i : Fin (2 * j)) : 1 ≤ scale ν i :=
    one_le_pow₀ hΘ.le
  have hcutlarge : 2 * U < x ^ (2 * σ) / C0 := by
    apply (lt_div_iff₀ hC0pos).2
    calc
      2 * U * C0 = (2 * (2 : ℝ) ^ (1 / 20 : ℝ) * C0) * x ^ (1 / 20 : ℝ) := by
        dsimp only [U]
        rw [Real.mul_rpow (by norm_num : (0 : ℝ) ≤ 2) hxpos.le]
        ring
      _ < x ^ (2 * σ - 1 / 20) * x ^ (1 / 20 : ℝ) :=
        mul_lt_mul_of_pos_right (hXcut x (hcutX.trans hx))
          (Real.rpow_pos_of_pos hxpos _)
      _ = x ^ (2 * σ) := by rw [← Real.rpow_add hxpos]; congr 1; ring
  have hboxes (ν : Fin (2 * j) → ℕ) (hν : ν ∈ boxes) :
      (∑ q ∈ S, ‖fullDiscrepancy (∏ i, β ν i).coeff q a‖) ≤
        Kbox * x / (Real.log x) ^ Abox := by
    obtain ⟨_, hlo, hhi⟩ := Finset.mem_filter.mp hν
    have hboxlo : x / C0 ≤ ∏ i, scale ν i :=
      (div_le_div_of_nonneg_left hxpos.le (pow_pos (zero_lt_one.trans hΘ) _)
        hΘpowC).trans hlo
    have hboxhi : (∏ i, scale ν i) ≤ C0 * x := by
      calc
        (∏ i, scale ν i) ≤ (2 * x) * Θ ^ (2 * j) := hhi
        _ ≤ (2 * x) * (2 : ℝ) ^ (40 : ℕ) :=
          mul_le_mul_of_nonneg_left hΘpow (by positivity)
        _ = C0 * x := by norm_num [C0]; ring
    by_cases hprod : (∏ i, β ν i) = 0
    · simp only [hprod, MonoidAlgebra.coeff_zero, fullDiscrepancy,
        progressionMass, reducedMass, Finsupp.support_zero, Finset.sum_empty,
        zero_div, sub_zero, norm_zero, Finset.sum_const_zero]
      positivity
    have hβ (i : Fin (2 * j)) : β ν i ≠ 0 := fun hi =>
      hprod (Finset.prod_eq_zero (Finset.mem_univ i) hi)
    obtain ⟨_, _, hμ⟩ := heathBrown_geometric_slots_support_norm j Θ U x C0
      (scale ν) hΘ hΘtwo hxexp hC0x.le (hscale ν) hboxhi
    have hsmooth (i : Fin (2 * j))
        (hi : x ^ (2 * σ) / C0 ≤ scale ν i) : j ≤ i.val := by
      by_contra hn
      exact (not_le_of_gt hcutlarge) (hi.trans (hμ i (lt_of_not_ge hn) (hβ i)))
    have hconstant {K : ℝ} (hK : K ≤ Kbox) :
        K * x / (Real.log x) ^ Abox ≤ Kbox * x / (Real.log x) ^ Abox :=
      div_le_div_of_nonneg_right (mul_le_mul_of_nonneg_right hK hxpos.le)
        (Real.rpow_nonneg hlogpos.le _)
    rcases heathBrown_scale_trichotomy σ C0 x hσ0 hσhalf hC0 hC0x
        (scale ν) (hscale ν) hboxlo hboxhi with hlarge | hsplitCase | hthreeCase
    · obtain ⟨i, hi⟩ := hlarge
      have hismooth : j ≤ i.val := hsmooth i
        ((div_le_div_of_nonneg_right
          (Real.rpow_le_rpow_of_exponent_le hxone (by linarith : 2 * σ ≤ 1 / 2 + σ))
          hC0pos.le).trans hi)
      exact (hzero x (hX0X.trans hx) ν hboxhi i hismooth hi I a ha).trans
        (hconstant (by dsimp only [Kbox]; linarith))
    · obtain ⟨G, T, hGT, hcover, hG, hT, hGlo, hGTscale, _⟩ := hsplitCase
      exact (hsplit x (hXsX.trans hx) ν hboxlo hboxhi G T hGT hcover hG hT
        hGlo hGTscale I hIprime a ha).trans
          (hconstant (by dsimp only [Kbox]; linarith))
    · obtain ⟨i₁, i₂, i₃, h12, h13, h23, hlower, hscale12, hscale23,
        hupper, hpair12, hpair13, hpair23⟩ := hthreeCase
      exact (hthree x (hX3X.trans hx) ν hboxlo hboxhi i₁ i₂ i₃ h12 h13 h23
        (hsmooth i₁ hlower) (hsmooth i₂ (hlower.trans hscale12))
        (hsmooth i₃ (hlower.trans (hscale12.trans hscale23)))
        hpair12 hpair13 hpair23 (hscale12.trans (hscale23.trans hupper))
        (hscale23.trans hupper) hupper I hIprime a ha).trans
          (hconstant (by dsimp only [Kbox]; linarith))
  have hcard : (boxes.card : ℝ) ≤
      (8 : ℝ) ^ (2 * j) * (Real.log x) ^ loss :=
    (Nat.cast_le.mpr (Finset.card_le_card (Finset.filter_subset _ _))).trans
      (heathBrown_geometric_grid_card_bound (2 * j) D x hxexp)
  have hlogcancel : (Real.log x) ^ loss / (Real.log x) ^ Abox =
      1 / (Real.log x) ^ A := by
    dsimp only [Abox]
    rw [Real.rpow_add hlogpos, Real.rpow_natCast]
    simpa only [one_mul] using mul_div_mul_right (1 : ℝ)
      ((Real.log x) ^ A) (pow_ne_zero loss hlogpos.ne')
  have hsumBoxes : (∑ ν ∈ boxes, ∑ q ∈ S,
      ‖fullDiscrepancy (∏ i, β ν i).coeff q a‖) ≤
        (8 : ℝ) ^ (2 * j) * Kbox * x / (Real.log x) ^ A := by
    calc
      (∑ ν ∈ boxes, ∑ q ∈ S, ‖fullDiscrepancy (∏ i, β ν i).coeff q a‖) ≤
          (boxes.card : ℝ) * (Kbox * x / (Real.log x) ^ Abox) := by
        simpa only [nsmul_eq_mul] using
          Finset.sum_le_card_nsmul boxes
            (fun ν => ∑ q ∈ S, ‖fullDiscrepancy (∏ i, β ν i).coeff q a‖)
            (Kbox * x / (Real.log x) ^ Abox) hboxes
      _ ≤ ((8 : ℝ) ^ (2 * j) * (Real.log x) ^ loss) *
          (Kbox * x / (Real.log x) ^ Abox) :=
        mul_le_mul_of_nonneg_right hcard (by positivity)
      _ = ((8 : ℝ) ^ (2 * j) * Kbox * x) *
          ((Real.log x) ^ loss / (Real.log x) ^ Abox) := by ring
      _ = (8 : ℝ) ^ (2 * j) * Kbox * x / (Real.log x) ^ A := by
        rw [hlogcancel]
        ring
  calc
    (∑ q ∈ S, ‖fullDiscrepancy target q a‖) ≤
        ∑ q ∈ S, (‖fullDiscrepancy target q a -
          ∑ ν ∈ boxes, fullDiscrepancy (∏ i, β ν i).coeff q a‖ +
          ∑ ν ∈ boxes, ‖fullDiscrepancy (∏ i, β ν i).coeff q a‖) := by
      apply Finset.sum_le_sum
      intro q _
      calc
        ‖fullDiscrepancy target q a‖ =
            ‖(fullDiscrepancy target q a -
              ∑ ν ∈ boxes, fullDiscrepancy (∏ i, β ν i).coeff q a) +
              ∑ ν ∈ boxes, fullDiscrepancy (∏ i, β ν i).coeff q a‖ := by
          rw [sub_add_cancel]
        _ ≤ ‖fullDiscrepancy target q a -
              ∑ ν ∈ boxes, fullDiscrepancy (∏ i, β ν i).coeff q a‖ +
              ‖∑ ν ∈ boxes, fullDiscrepancy (∏ i, β ν i).coeff q a‖ := norm_add_le _ _
        _ ≤ _ := by gcongr; exact norm_sum_le _ _
    _ = (∑ q ∈ S, ‖fullDiscrepancy target q a -
          ∑ ν ∈ boxes, fullDiscrepancy (∏ i, β ν i).coeff q a‖) +
          ∑ ν ∈ boxes, ∑ q ∈ S, ‖fullDiscrepancy (∏ i, β ν i).coeff q a‖ := by
      rw [Finset.sum_add_distrib, Finset.sum_comm]
    _ ≤ Kb * x / (Real.log x) ^ A +
        (8 : ℝ) ^ (2 * j) * Kbox * x / (Real.log x) ^ A :=
      add_le_add hboundary' hsumBoxes
    _ = (Kb + (8 : ℝ) ^ (2 * j) * Kbox) * x / (Real.log x) ^ A := by ring

open Classical in
theorem heathBrown_pure_power_dense_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (density : ℕ) (hdensity : 1 ≤ density)
    («ω» δ σ σdist : ℝ) (hω : 0 < «ω») (hωupper : «ω» < 1 / 12) (hδ : 0 < δ)
    (hσ0 : 1 / 10 < σ) (hσhalf : σ < 1 / 2) (hσgap : 2 * «ω» < σ)
    (hσσ : σ < σdist) (hσdistHalf : σdist < 1 / 2)
    (hphysical : 1 / 18 + 28 / 9 * «ω» + 2 / 9 * δ < σ)
    (hdist :
      (density = 1 ∧ 54 * «ω» + 15 * δ + 5 * σdist < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (density = 2 ∧ 56 * «ω» + 16 * δ + 4 * σdist < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (density = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σdist < 1 ∧ 64 * «ω» + 20 * δ + 2 * σdist < 1)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let Λx : ℕ →₀ ℂ :=
          ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)
        (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
                q ∣ (∏ p ∈ I, p) ∧
                  Nonempty (DenseDivisibilityWitness
                    ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩ density q)),
          ‖fullDiscrepancy Λx q a‖) ≤ K * x / (Real.log x) ^ A := by
  intro A hAsave
  have hterms (i : Fin 20) :=
    heathBrown_term_log_saving_of_deligne hDeligne density hdensity
      «ω» δ σ σdist hω hωupper hδ hσ0 hσhalf hσgap hσσ hσdistHalf hphysical hdist
      (i.val + 1) (Nat.succ_pos i.val) (Nat.succ_le_of_lt i.isLt) A hAsave
  choose K X hK hX hterm using hterms
  let C : ℝ := ∑ i : Fin 20, (Nat.choose 20 (i.val + 1) : ℝ) * K i
  let Xmax : ℝ := (Finset.univ : Finset (Fin 20)).sup' Finset.univ_nonempty X
  have hC : 0 < C := by
    dsimp only [C]
    apply Finset.sum_pos
    · intro i _hi
      exact mul_pos
        (Nat.cast_pos.mpr (Nat.choose_pos (Nat.succ_le_of_lt i.isLt))) (hK i)
    · exact Finset.univ_nonempty
  have hXi (i : Fin 20) : X i ≤ Xmax :=
    Finset.le_sup' X (Finset.mem_univ i)
  have hXmax : Real.exp 1 ≤ Xmax := (hX (0 : Fin 20)).trans (hXi 0)
  refine ⟨C, Xmax, hC, hXmax, ?_⟩
  intro x hx I hI a ha Λx
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le (hXmax.trans hx)
  have htwo : 0 ≤ 2 * x := mul_nonneg zero_le_two hxpos.le
  let U : ℝ := (2 * x) ^ (1 / 20 : ℝ)
  let μU := arithmeticFunctionLowCutoff U
    (ArithmeticFunction.moebius : ArithmeticFunction ℝ)
  let H : ℕ → ArithmeticFunction ℝ := fun j =>
    μU ^ (j + 1) * (ArithmeticFunction.zeta : ArithmeticFunction ℝ) ^ j *
      ArithmeticFunction.log
  let T : ℕ → ℕ →₀ ℂ := fun j =>
    ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, Finsupp.single n ((H j n : ℝ) : ℂ)
  let Q : Finset ℕ := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
                q ∣ (∏ p ∈ I, p) ∧
                  Nonempty (DenseDivisibilityWitness
                    ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩ density q))
  have hU : 0 ≤ U := Real.rpow_nonneg htwo _
  have hUpow : U ^ 20 = 2 * x := by
    dsimp only [U]
    rw [← Real.rpow_mul_natCast htwo (1 / 20 : ℝ) 20]
    norm_num
  have hHB := sum_norm_closed_heathBrown_discrepancy_le
    20 (by norm_num) U x hU hxpos.le hUpow.symm.le Q (fun _ => a)
  change (∑ q ∈ Q, ‖fullDiscrepancy Λx q a‖) ≤
    ∑ j ∈ Finset.range 20, (Nat.choose 20 (j + 1) : ℝ) *
      ∑ q ∈ Q, ‖fullDiscrepancy (T j) q a‖ at hHB
  rw [← Fin.sum_univ_eq_sum_range] at hHB
  have hT (i : Fin 20) :
      (∑ q ∈ Q, ‖fullDiscrepancy (T i.val) q a‖) ≤
        K i * x / (Real.log x) ^ A := by
    simpa only [Q, T, H, μU, U, Nat.add_sub_cancel] using
      hterm i x ((hXi i).trans hx) I hI a ha
  change (∑ q ∈ Q, ‖fullDiscrepancy Λx q a‖) ≤ C * x / (Real.log x) ^ A
  calc
    (∑ q ∈ Q, ‖fullDiscrepancy Λx q a‖) ≤
        ∑ i : Fin 20, (Nat.choose 20 (i.val + 1) : ℝ) *
          ∑ q ∈ Q, ‖fullDiscrepancy (T i.val) q a‖ := hHB
    _ ≤ ∑ i : Fin 20, (Nat.choose 20 (i.val + 1) : ℝ) *
        (K i * x / (Real.log x) ^ A) := by
      apply Finset.sum_le_sum
      intro i _hi
      exact mul_le_mul_of_nonneg_left (hT i) (Nat.cast_nonneg _)
    _ = C * x / (Real.log x) ^ A := by
      simp only [C, Finset.sum_mul, Finset.sum_div, mul_div_assoc, mul_assoc]

open Classical in
theorem heathBrown_pure_power_mpz3_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    («ω» δ : ℝ) (hω : 0 < «ω») (hδ : 0 < δ)
    (hrange : 240 * «ω» + 80 * δ < 3) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let Λx : ℕ →₀ ℂ :=
          ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)
        (∑ q ∈ tripleSourceModuli
            ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩
            ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊ I,
          ‖fullDiscrepancy Λx q a‖) ≤ K * x / (Real.log x) ^ A := by
  let u : ℝ := 3 - 240 * «ω» - 80 * δ
  let σ : ℝ := 1 / 10 + u / 40
  obtain ⟨hu0, hu3, hmarginI, hmarginII, hmarginIII,
    hI, hII, hIII, hσidentity, hσlower, hσgap, hσ0, hσhalf,
    hω80, hω12, hδ80, hδlevel, hσdifference, hσ2ω, _⟩ :=
    source_mpz3_parameter_choice «ω» δ hω hδ hrange
  change 0 < u at hu0
  change u < 3 at hu3
  change 1 - 48 * «ω» - 16 * δ - 4 * σ = u / 10 at hmarginII
  change 1 - 64 * «ω» - 20 * δ - 2 * σ = 13 * u / 60 + 4 * δ / 3 at hmarginIII
  change (1 / 10 : ℝ) < σ at hσ0
  change σ < 1 / 2 at hσhalf
  change 2 * «ω» < σ at hσ2ω
  let σdist : ℝ := σ + u / 100
  have hσσ : σ < σdist := lt_add_of_pos_right _ (div_pos hu0 (by norm_num))
  have hσdistHalf : σdist < 1 / 2 := by
    dsimp only [σdist, σ]
    linarith
  have hII' : 48 * «ω» + 16 * δ + 4 * σdist < 1 := by
    dsimp only [σdist]
    linarith
  have hIII' : 64 * «ω» + 20 * δ + 2 * σdist < 1 := by
    dsimp only [σdist]
    linarith
  have hphysical : 1 / 18 + 28 / 9 * «ω» + 2 / 9 * δ < σ := by linarith
  exact heathBrown_pure_power_dense_log_saving_of_deligne hDeligne 3 (by norm_num)
    «ω» δ σ σdist hω hω12 hδ hσ0 hσhalf hσ2ω hσσ hσdistHalf hphysical
    (Or.inr (Or.inr ⟨rfl, hI, hII', hIII'⟩))

open Classical in
theorem source_mpz3_coherent_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    («ω» δ : ℝ) (hω : 0 < «ω») (hδ : 0 < δ)
    (hrange : 240 * «ω» + 80 * δ < 3)
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Filter.Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x)
      Filter.atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ),
        (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let Λx : ℕ →₀ ℂ :=
          ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)
        let Q : Finset ℕ :=
          (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter
            (fun q => q ∣ ∏ p ∈ I, p ∧
              Nonempty (DenseDivisibilityWitness Y 3 q))
        (∑ q ∈ Q, ‖fullDiscrepancy Λx q a‖) ≤
          K * x / (Real.log x) ^ A := by
  have hparameters := source_mpz3_parameter_choice «ω» δ hω hδ hrange
  dsimp only at hparameters
  obtain ⟨_, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _,
    ω', δ', hωretreat, hδretreat, hretreat⟩ := hparameters
  have hω' : 0 < ω' := hω.trans hωretreat
  have hδ' : 0 < δ' := hδ.trans hδretreat
  exact heathBrown_subpower_log_saving_of_retreat
    3 «ω» δ ω' δ' hωretreat hδretreat.le
    (heathBrown_pure_power_mpz3_log_saving_of_deligne
      hDeligne ω' δ' hω' hδ' hretreat) L0 hL0 hL0sub

open Classical in
theorem source_mpz_lowerOrder_coherent_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (density : ℕ)
    («ω» δ σ : ℝ) (hω : 0 < «ω») (hωupper : «ω» < 1 / 4)
    (hδ : 0 < δ) (hδupper : δ < 1 / 4 + «ω»)
    (hσ0 : 1 / 10 < σ) (hσhalf : σ < 1 / 2) (hσgap : 2 * «ω» < σ)
    (hI : (density = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1) ∨
      (density = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1))
    (hII : 68 * «ω» + 14 * δ < 1)
    (hIII : 1 / 18 + 28 / 9 * «ω» + 2 / 9 * δ < σ)
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Filter.Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x)
      Filter.atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ),
        (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let Λx : ℕ →₀ ℂ :=
          ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)
        let Q : Finset ℕ :=
          (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter
            (fun q => q ∣ ∏ p ∈ I, p ∧
              Nonempty (DenseDivisibilityWitness Y density q))
        (∑ q ∈ Q, ‖fullDiscrepancy Λx q a‖) ≤
          K * x / (Real.log x) ^ A := by
  have hdensity : 1 ≤ density := by
    rcases hI with ⟨rfl, _⟩ | ⟨rfl, _⟩ <;> norm_num
  obtain ⟨ω', δ', σdist, hωretreat, hδretreat, hω', hδ', hωupper', _hδupper',
    hσσ, hσdistHalf, hσgap', hI', hII', hIII'⟩ :=
      lowerOrder_mpz_parameter_retreat density «ω» δ σ hω hδ hωupper hδupper
        hσhalf hσgap hI hII hIII
  have hdist :
      (density = 1 ∧ 54 * ω' + 15 * δ' + 5 * σdist < 1 ∧ 68 * ω' + 14 * δ' < 1) ∨
      (density = 2 ∧ 56 * ω' + 16 * δ' + 4 * σdist < 1 ∧ 68 * ω' + 14 * δ' < 1) ∨
      (density = 3 ∧ 72 * ω' + 24 * δ' < 1 ∧
        48 * ω' + 16 * δ' + 4 * σdist < 1 ∧ 64 * ω' + 20 * δ' + 2 * σdist < 1) := by
    rcases hI' with ⟨hd, hi⟩ | ⟨hd, hi⟩
    · exact Or.inl ⟨hd, hi, hII'⟩
    · exact Or.inr (Or.inl ⟨hd, hi, hII'⟩)
  exact heathBrown_subpower_log_saving_of_retreat
    density «ω» δ ω' δ' hωretreat hδretreat.le
    (heathBrown_pure_power_dense_log_saving_of_deligne hDeligne density hdensity
      ω' δ' σ σdist hω' hωupper' hδ' hσ0 hσhalf hσgap' hσσ hσdistHalf hIII' hdist)
    L0 hL0 hL0sub

open Classical in
theorem source_mpz1_coherent_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    («ω» δ σ : ℝ) (hω : 0 < «ω») (hωupper : «ω» < 1 / 4)
    (hδ : 0 < δ) (hδupper : δ < 1 / 4 + «ω»)
    (hσ0 : 1 / 10 < σ) (hσhalf : σ < 1 / 2) (hσgap : 2 * «ω» < σ)
    (hI : 54 * «ω» + 15 * δ + 5 * σ < 1)
    (hII : 68 * «ω» + 14 * δ < 1)
    (hIII : 1 / 18 + 28 / 9 * «ω» + 2 / 9 * δ < σ)
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Filter.Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x)
      Filter.atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ),
        (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let Λx : ℕ →₀ ℂ :=
          ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)
        let Q : Finset ℕ :=
          (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter
            (fun q => q ∣ ∏ p ∈ I, p ∧
              Nonempty (DenseDivisibilityWitness Y 1 q))
        (∑ q ∈ Q, ‖fullDiscrepancy Λx q a‖) ≤
          K * x / (Real.log x) ^ A :=
  source_mpz_lowerOrder_coherent_log_saving_of_deligne hDeligne 1
    «ω» δ σ hω hωupper hδ hδupper hσ0 hσhalf hσgap
    (Or.inl ⟨rfl, hI⟩) hII hIII L0 hL0 hL0sub

open Classical in
theorem source_mpz2_coherent_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    («ω» δ σ : ℝ) (hω : 0 < «ω») (hωupper : «ω» < 1 / 4)
    (hδ : 0 < δ) (hδupper : δ < 1 / 4 + «ω»)
    (hσ0 : 1 / 10 < σ) (hσhalf : σ < 1 / 2) (hσgap : 2 * «ω» < σ)
    (hI : 56 * «ω» + 16 * δ + 4 * σ < 1)
    (hII : 68 * «ω» + 14 * δ < 1)
    (hIII : 1 / 18 + 28 / 9 * «ω» + 2 / 9 * δ < σ)
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Filter.Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x)
      Filter.atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ),
        (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let Λx : ℕ →₀ ℂ :=
          ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)
        let Q : Finset ℕ :=
          (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter
            (fun q => q ∣ ∏ p ∈ I, p ∧
              Nonempty (DenseDivisibilityWitness Y 2 q))
        (∑ q ∈ Q, ‖fullDiscrepancy Λx q a‖) ≤
          K * x / (Real.log x) ^ A :=
  source_mpz_lowerOrder_coherent_log_saving_of_deligne hDeligne 2
    «ω» δ σ hω hωupper hδ hδupper hσ0 hσhalf hσgap
    (Or.inr ⟨rfl, hI⟩) hII hIII L0 hL0 hL0sub

open Classical in
theorem source_mpz3_coherent_divisor_weight_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    («ω» δ : ℝ) (hω : 0 < «ω») (hδ : 0 < δ)
    (hrange : 240 * «ω» + 80 * δ < 3)
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Filter.Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x)
      Filter.atTop (nhds 0)) (J : ℕ) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ),
        (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let Λx : ℕ →₀ ℂ :=
          ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)
        let Q : Finset ℕ :=
          (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter
            (fun q => q ∣ ∏ p ∈ I, p ∧
              Nonempty (DenseDivisibilityWitness Y 3 q))
        (∑ q ∈ Q, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy Λx q a‖) ≤
          K * x / (Real.log x) ^ A := by
  intro A hA
  let θ : ℝ := 3 / 4 + «ω»
  let γ : ℝ := θ - (1 / 2 + 2 * «ω»)
  let Lamp : ℝ := 1 + Real.log 2
  have hωbound : «ω» < (1 / 80 : ℝ) := by linarith only [hrange, hδ]
  have hθ0 : 0 < θ := by dsimp only [θ]; linarith
  have hθ1 : θ < 1 := by dsimp only [θ]; linarith
  have hγ : 0 < γ := by dsimp only [γ, θ]; linarith
  have hLamp : 0 < Lamp := by
    dsimp only [Lamp]
    linarith only [Real.log_nonneg (by norm_num : (1 : ℝ) ≤ 2)]
  obtain ⟨P, Kg, hKg, hgrowth⟩ :=
    weighted_fullDiscrepancy_positiveSupport_log_growth
      θ hθ0 hθ1 0 (2 * J) 1 2 (by norm_num)
  have hrequested : 0 < 2 * A + (P : ℝ) := by positivity
  obtain ⟨Ks, Xs, hKs, hXs, hsmall⟩ :=
    source_mpz3_coherent_log_saving_of_deligne hDeligne «ω» δ hω hδ hrange
      L0 hL0 hL0sub (2 * A + (P : ℝ)) hrequested
  have hsubpower : ∀ᶠ x : ℝ in Filter.atTop, L0 x ≤ x ^ γ := by
    have hsmallL := (tendsto_order.mp hL0sub).2 γ hγ
    filter_upwards [hsmallL, Filter.eventually_gt_atTop (1 : ℝ)] with x hx hx1
    have hx0 : 0 < x := zero_lt_one.trans hx1
    apply (Real.log_le_log_iff (hL0 x) (Real.rpow_pos_of_pos hx0 γ)).mp
    rw [Real.log_rpow hx0]
    exact ((div_lt_iff₀ (Real.log_pos hx1)).mp hx).le
  obtain ⟨Xr, hXr⟩ := Filter.eventually_atTop.mp hsubpower
  let X : ℝ := max Xs (max (Real.exp 1) Xr)
  refine ⟨Ks + Kg * Lamp, X, by positivity,
    hXs.trans_le (le_max_left _ _), ?_⟩
  intro x hx Y hY I hI a ha Λx Q
  have hxxs : Xs ≤ x := (le_max_left _ _).trans hx
  have hxexp : Real.exp 1 ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans hx)
  have hxxr : Xr ≤ x := (le_max_right _ _).trans ((le_max_right _ _).trans hx)
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hlog : 0 < Real.log x :=
    zero_lt_one.trans_le ((Real.le_log_iff_exp_le hxpos).mpr hxexp)
  have hcutoff : x ^ (1 / 2 + 2 * «ω») * L0 x ≤ x ^ θ := by
    calc
      _ ≤ x ^ (1 / 2 + 2 * «ω») * x ^ γ :=
        mul_le_mul_of_nonneg_left (hXr x hxxr) (Real.rpow_nonneg hxpos.le _)
      _ = x ^ ((1 / 2 + 2 * «ω») + γ) := (Real.rpow_add hxpos _ _).symm
      _ = x ^ θ := by congr 1; dsimp only [γ]; ring
  have hQ : Q ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ := by
    intro q hq
    have hmem := Finset.mem_Icc.mp (Finset.mem_filter.mp hq).1
    exact Finset.mem_Icc.mpr ⟨hmem.1, hmem.2.trans (Nat.floor_mono hcutoff)⟩
  have hcoherent : ∀ q ∈ Q, Nat.Coprime a q := by
    intro q hq
    exact ha.of_dvd_right (Finset.mem_filter.mp hq).2.1
  have hΛ := vonMangoldt_closedInterval_support_and_envelope x hxexp
  change (∀ n ∈ Λx.support, 0 < n ∧ (n : ℝ) ≤ 2 * x) ∧
      (∀ n ∈ Λx.support, ‖Λx n‖ ≤ Lamp * Real.log x) at hΛ
  have hcrude :
      (∑ q ∈ Q, (q.divisors.card : ℝ) ^ (2 * J) * ‖fullDiscrepancy Λx q a‖) ≤
        (Kg * Lamp) * x * (Real.log x) ^ P := by
    have hg := hgrowth x hxexp Lamp hLamp.le Q hQ (fun _ => a)
      hcoherent Λx hΛ.1 (fun n hn => by
        simpa only [pow_zero, mul_one, Real.rpow_one] using hΛ.2 n hn)
    simpa only [mul_assoc] using hg
  have hraw :
      (∑ q ∈ Q, ‖fullDiscrepancy Λx q a‖) ≤
        Ks * x / (Real.log x) ^ (2 * A + (P : ℝ)) :=
    hsmall x hxxs Y hY I hI a ha
  exact sum_divisor_weighted_log_saving_of_two_bounds
    Q J (fun q => ‖fullDiscrepancy Λx q a‖) (fun q _ => norm_nonneg _)
    x (Real.log x) A Ks (Kg * Lamp) P hxpos.le hlog hKs (mul_pos hKg hLamp)
    hraw hcrude

open Classical in
theorem source_mpz3_primeIndicator_coherent_divisor_weight_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    («ω» δ : ℝ) (hω : 0 < «ω») (hδ : 0 < δ)
    (hrange : 240 * «ω» + 80 * δ < 3)
    (θ₀ δ₀ : ℝ) (hθ₀ : 0 < θ₀) (hθ : θ₀ < 1 / 2 + 2 * «ω»)
    (hδ₀ : 0 < δ₀) (hδgap : δ₀ < δ)
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Filter.Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x)
      Filter.atTop (nhds 0)) (J : ℕ) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      ∀ u v : ℝ, x ≤ u → u ≤ v → v ≤ 2 * x →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊x ^ θ₀ * L0 x⌋₊).filter (fun q =>
          q ∣ ∏ p ∈ I, p ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (x ^ δ₀), le_max_left (1 : ℝ) (x ^ δ₀)⟩ 3 q)),
          (q.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy
              (∑ n ∈ Finset.Icc ⌈u⌉₊ ⌊v⌋₊,
                Finsupp.single n (if n.Prime then (1 : ℂ) else 0)) q a‖) ≤
            K * x / (Real.log x) ^ A := by
  let θ₁ : ℝ := 1 / 2 + 2 * «ω»
  have hωsmall : «ω» < (1 / 80 : ℝ) := by linarith only [hrange, hδ]
  have hθsmall : θ₀ < 2 / 3 := by linarith only [hθ, hωsmall]
  have hDyadic : ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ y : ℝ, X ≤ y →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊y ^ θ₁⌋₊).filter (fun q =>
          q ∣ ∏ p ∈ I, p ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (y ^ δ), le_max_left (1 : ℝ) (y ^ δ)⟩ 3 q)),
          ‖fullDiscrepancy
            (∑ n ∈ Finset.Icc ⌈y⌉₊ ⌊2 * y⌋₊,
              Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q a‖) ≤
            K * y / (Real.log y) ^ A := by
    intro A hA
    obtain ⟨K, X, hK, hX, hs⟩ := source_mpz3_coherent_log_saving_of_deligne
      hDeligne «ω» δ hω hδ hrange (fun _ => 1) (fun _ => zero_lt_one)
      (by simpa only [Real.log_one, zero_div] using
        (tendsto_const_nhds : Filter.Tendsto (fun _ : ℝ => (0 : ℝ))
          Filter.atTop (nhds 0))) A hA
    refine ⟨K, max X (Real.exp 1), hK, le_max_right _ _, ?_⟩
    intro y hy I hI a ha
    have hys : X ≤ y := (le_max_left _ _).trans hy
    have hyexp : Real.exp 1 ≤ y := (le_max_right _ _).trans hy
    have hyone : 1 ≤ y :=
      (Real.one_le_exp_iff.mpr zero_le_one).trans hyexp
    have hyδ : 1 ≤ y ^ δ := Real.one_le_rpow hyone hδ.le
    let Y : Set.Ici (1 : ℝ) :=
      ⟨max 1 (y ^ δ), le_max_left (1 : ℝ) (y ^ δ)⟩
    have hY : (Y : ℝ) = y ^ δ := max_eq_right hyδ
    have h := hs y hys Y hY I hI a ha
    simpa only [Y, θ₁, mul_one] using h
  have h := primeIndicator_subpower_shifted_log_saving_of_dyadic
    3 θ₀ θ₁ δ₀ δ hθ₀ hθ hδ₀ hδgap hθsmall hDyadic L0 hL0 hL0sub J 0
  simpa only [Nat.cast_zero, add_zero] using h

open Classical in
theorem source_mpz_lowerOrder_primeIndicator_coherent_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (density : ℕ)
    («ω» δ σ : ℝ) (hω : 0 < «ω») (hωupper : «ω» < 1 / 4)
    (hδ : 0 < δ) (hδupper : δ < 1 / 4 + «ω»)
    (hσ0 : 1 / 10 < σ) (hσhalf : σ < 1 / 2) (hσgap : 2 * «ω» < σ)
    (hI : (density = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1) ∨
      (density = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1))
    (hII : 68 * «ω» + 14 * δ < 1)
    (hIII : 1 / 18 + 28 / 9 * «ω» + 2 / 9 * δ < σ)
    (θ₀ δ₀ : ℝ) (hθ₀ : 0 < θ₀) (hθ : θ₀ < 1 / 2 + 2 * «ω»)
    (hδ₀ : 0 < δ₀) (hδgap : δ₀ < δ)
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Filter.Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x)
      Filter.atTop (nhds 0)) (J h : ℕ) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      ∀ u v : ℝ, x ≤ u → u ≤ v → v ≤ 2 * x →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊x ^ θ₀ * L0 x⌋₊).filter (fun q =>
          q ∣ ∏ p ∈ I, p ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (x ^ δ₀), le_max_left (1 : ℝ) (x ^ δ₀)⟩ density q)),
          (q.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy
              (∑ n ∈ Finset.Icc ⌈u + (h : ℝ)⌉₊ ⌊v + (h : ℝ)⌋₊,
                Finsupp.single n (if n.Prime then (1 : ℂ) else 0)) q a‖) ≤
            K * x / (Real.log x) ^ A := by
  let θ₁ : ℝ := 1 / 2 + 2 * «ω»
  have hωsmall : «ω» < (1 / 12 : ℝ) := by linarith only [hII, hδ]
  have hθsmall : θ₀ < 2 / 3 := by linarith only [hθ, hωsmall]
  have hDyadic : ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ y : ℝ, X ≤ y →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊y ^ θ₁⌋₊).filter (fun q =>
          q ∣ ∏ p ∈ I, p ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (y ^ δ), le_max_left (1 : ℝ) (y ^ δ)⟩ density q)),
          ‖fullDiscrepancy
            (∑ n ∈ Finset.Icc ⌈y⌉₊ ⌊2 * y⌋₊,
              Finsupp.single n ((ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)) q a‖) ≤
            K * y / (Real.log y) ^ A := by
    intro A hA
    obtain ⟨K, X, hK, _hX, hs⟩ :=
      source_mpz_lowerOrder_coherent_log_saving_of_deligne
        hDeligne density «ω» δ σ hω hωupper hδ hδupper hσ0 hσhalf hσgap hI hII hIII
        (fun _ => 1) (fun _ => zero_lt_one)
        (by simpa only [Real.log_one, zero_div] using
          (tendsto_const_nhds : Filter.Tendsto (fun _ : ℝ => (0 : ℝ))
            Filter.atTop (nhds 0))) A hA
    refine ⟨K, max X (Real.exp 1), hK, le_max_right _ _, ?_⟩
    intro y hy I hI a ha
    have hys : X ≤ y := (le_max_left _ _).trans hy
    have hyexp : Real.exp 1 ≤ y := (le_max_right _ _).trans hy
    have hyone : 1 ≤ y :=
      (Real.one_le_exp_iff.mpr zero_le_one).trans hyexp
    have hyδ : 1 ≤ y ^ δ := Real.one_le_rpow hyone hδ.le
    let Y : Set.Ici (1 : ℝ) :=
      ⟨max 1 (y ^ δ), le_max_left (1 : ℝ) (y ^ δ)⟩
    have hY : (Y : ℝ) = y ^ δ := max_eq_right hyδ
    have hb := hs y hys Y hY I hI a ha
    simpa only [Y, θ₁, mul_one] using hb
  exact primeIndicator_subpower_shifted_log_saving_of_dyadic
    density θ₀ θ₁ δ₀ δ hθ₀ hθ hδ₀ hδgap hθsmall hDyadic L0 hL0 hL0sub J h

open Classical in
theorem source_mpz1_primeIndicator_coherent_divisor_weight_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    («ω» δ σ : ℝ) (hω : 0 < «ω») (hωupper : «ω» < 1 / 4)
    (hδ : 0 < δ) (hδupper : δ < 1 / 4 + «ω»)
    (hσ0 : 1 / 10 < σ) (hσhalf : σ < 1 / 2) (hσgap : 2 * «ω» < σ)
    (hI : 54 * «ω» + 15 * δ + 5 * σ < 1)
    (hII : 68 * «ω» + 14 * δ < 1)
    (hIII : 1 / 18 + 28 / 9 * «ω» + 2 / 9 * δ < σ)
    (θ₀ δ₀ : ℝ) (hθ₀ : 0 < θ₀) (hθ : θ₀ < 1 / 2 + 2 * «ω»)
    (hδ₀ : 0 < δ₀) (hδgap : δ₀ < δ)
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Filter.Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x)
      Filter.atTop (nhds 0)) (J h : ℕ) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      ∀ u v : ℝ, x ≤ u → u ≤ v → v ≤ 2 * x →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊x ^ θ₀ * L0 x⌋₊).filter (fun q =>
          q ∣ ∏ p ∈ I, p ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (x ^ δ₀), le_max_left (1 : ℝ) (x ^ δ₀)⟩ 1 q)),
          (q.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy
              (∑ n ∈ Finset.Icc ⌈u + (h : ℝ)⌉₊ ⌊v + (h : ℝ)⌋₊,
                Finsupp.single n (if n.Prime then (1 : ℂ) else 0)) q a‖) ≤
            K * x / (Real.log x) ^ A :=
  source_mpz_lowerOrder_primeIndicator_coherent_log_saving_of_deligne hDeligne 1
    «ω» δ σ hω hωupper hδ hδupper hσ0 hσhalf hσgap
    (Or.inl ⟨rfl, hI⟩) hII hIII θ₀ δ₀ hθ₀ hθ hδ₀ hδgap L0 hL0 hL0sub J h

open Classical in
theorem source_mpz2_primeIndicator_coherent_divisor_weight_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    («ω» δ σ : ℝ) (hω : 0 < «ω») (hωupper : «ω» < 1 / 4)
    (hδ : 0 < δ) (hδupper : δ < 1 / 4 + «ω»)
    (hσ0 : 1 / 10 < σ) (hσhalf : σ < 1 / 2) (hσgap : 2 * «ω» < σ)
    (hI : 56 * «ω» + 16 * δ + 4 * σ < 1)
    (hII : 68 * «ω» + 14 * δ < 1)
    (hIII : 1 / 18 + 28 / 9 * «ω» + 2 / 9 * δ < σ)
    (θ₀ δ₀ : ℝ) (hθ₀ : 0 < θ₀) (hθ : θ₀ < 1 / 2 + 2 * «ω»)
    (hδ₀ : 0 < δ₀) (hδgap : δ₀ < δ)
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Filter.Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x)
      Filter.atTop (nhds 0)) (J h : ℕ) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      ∀ u v : ℝ, x ≤ u → u ≤ v → v ≤ 2 * x →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊x ^ θ₀ * L0 x⌋₊).filter (fun q =>
          q ∣ ∏ p ∈ I, p ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (x ^ δ₀), le_max_left (1 : ℝ) (x ^ δ₀)⟩ 2 q)),
          (q.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy
              (∑ n ∈ Finset.Icc ⌈u + (h : ℝ)⌉₊ ⌊v + (h : ℝ)⌋₊,
                Finsupp.single n (if n.Prime then (1 : ℂ) else 0)) q a‖) ≤
            K * x / (Real.log x) ^ A :=
  source_mpz_lowerOrder_primeIndicator_coherent_log_saving_of_deligne hDeligne 2
    «ω» δ σ hω hωupper hδ hδupper hσ0 hσhalf hσgap
    (Or.inr ⟨rfl, hI⟩) hII hIII θ₀ δ₀ hθ₀ hθ hδ₀ hδgap L0 hL0 hL0sub J h

end

section

open scoped ContDiff
open Classical in
theorem sourceSmoothFactor_dense_uniform_log_saving
    («ω» δ γ₀ : ℝ) (hω : 0 < «ω») (hδ : 0 < δ) (hγ₀ : 0 < γ₀)
    (hgap : 1 / 4 + 7 * «ω» + 2 * δ < γ₀) (hγ₀hi : γ₀ ≤ 1 / 2)
    {ι : Type*} (M N : ℝ → ι → ℝ) (α : ℝ → ι → ℕ →₀ ℂ)
    (ψ : ℝ → ι → ℝ → ℂ) (L₀ LN : ℝ → ℝ)
    (c C Wα X₀ : ℝ) (dα : ℕ)
    (hc : 0 < c) (hcC : c ≤ C) (hCscale : 1 ≤ C)
    (hWα : 0 ≤ Wα) (hX₀ : Real.exp 1 ≤ X₀)
    (hLpos : ∀ x : ℝ, X₀ ≤ x → 0 < L₀ x ∧ 0 < LN x)
    (hLsubpower : ∀ η : ℝ, 0 < η →
      ∀ᶠ x : ℝ in Filter.atTop, L₀ x ≤ x ^ η ∧ LN x ≤ x ^ η)
    (hscaleSource : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι,
      x / C ≤ M x i * N x i ∧ M x i * N x i ≤ C * x ∧
      x ^ γ₀ ≤ N x i ∧ N x i ≤ Real.sqrt x * LN x)
    (hαsupport : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι,
      ∀ n ∈ (α x i).support,
        c * M x i ≤ (n : ℝ) ∧ (n : ℝ) ≤ C * M x i)
    (hαcoeff : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι, ∀ n : ℕ,
      ‖α x i n‖ ≤ Wα * (n.divisors.card : ℝ) ^ dα * (Real.log x) ^ dα)
    (hψ : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι, ContDiff ℝ ∞ (ψ x i))
    (hψsupport : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι,
      Function.support (ψ x i) ⊆ Set.Icc c C)
    (hψbounds : ∀ J : ℕ, ∃ L E : ℝ, 0 ≤ L ∧
      ∀ x : ℝ, X₀ ≤ x → ∀ i : ι, ∀ j : ℕ, j ≤ J → ∀ t : ℝ,
        ‖iteratedDeriv j (ψ x i) t‖ ≤ L * (Real.log x) ^ E) :
    let β : ℝ → ι → ℕ →₀ ℂ := fun x i => positiveCompactProfileSequence (ψ x i) C (N x i) 0
    ∀ A : ℝ, 0 < A →
      ∃ K X : ℝ, 0 < K ∧ X₀ ≤ X ∧
        ∀ x : ℝ, X ≤ x → ∀ i : ι,
        ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
        ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
          (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L₀ x⌋₊).filter (fun q =>
              q ∣ (∏ p ∈ I, p) ∧
                Nonempty (DenseDivisibilityWitness
                  ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩
                  1 q)),
            ‖fullDiscrepancy (finiteConvolution (α x i) (β x i)) q a‖) ≤
              K * x / (Real.log x) ^ A := by
  intro β
  obtain ⟨ω', δ', ε, hωw, hδw, hε, hεsmall, hsmall, hωε, hεδ, hγworking⟩ :=
    smooth_factor_parameter_retreat «ω» δ γ₀ hω hδ hgap hγ₀hi
  have hω' : 0 < ω' := hω.trans hωw
  have hδ' : 0 < δ' := hδ.trans hδw
  have hεbound : ε < 1 / 24 := hεsmall.trans_lt (by norm_num)
  have hωsmall : ω' < 1 / 28 := by
    linarith only [hγworking, hγ₀hi, hδ', hε]
  let θ : ℝ := 1 / 2 + «ω» + ω'
  have hθpos : 0 < θ := by dsimp only [θ]; positivity
  have hθlt : θ < 1 := by dsimp only [θ]; linarith only [hωw, hωsmall]
  have hCpos : 0 < C := zero_lt_one.trans_le hCscale
  obtain ⟨L, Eψ, hL, hψuniform⟩ := hψbounds 2
  let W : ℝ := max 1 (max Wα L)
  let k : ℕ := dα + Nat.ceil Eψ
  have hW : 0 ≤ W := hWα.trans ((le_max_left Wα L).trans (le_max_right _ _))
  have hWαW : Wα ≤ W := (le_max_left _ _).trans (le_max_right _ _)
  have hLW : L ≤ W := (le_max_right _ _).trans (le_max_right _ _)
  have hdk : dα ≤ k := Nat.le_add_right _ _
  have hEk : Eψ ≤ (k : ℝ) := by
    have he := Nat.le_ceil Eψ
    dsimp only [k]
    push_cast
    linarith only [he, show (0 : ℝ) ≤ (dα : ℝ) from Nat.cast_nonneg dα]
  have hprofileBound : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι, ∀ j : ℕ, j ≤ 2 → ∀ t : ℝ,
      ‖iteratedDeriv j (ψ x i) t‖ ≤ W * (Real.log x) ^ (k : ℝ) := by
    intro x hx i j hj t
    have hx0 : 0 < x := (Real.exp_pos 1).trans_le (hX₀.trans hx)
    have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr (hX₀.trans hx)
    exact (hψuniform x hx i j hj t).trans
      (mul_le_mul hLW (Real.rpow_le_rpow_of_exponent_le hlog1 hEk)
        (Real.rpow_nonneg (zero_le_one.trans hlog1) _) hW)
  have hsupport : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι,
      (∀ n ∈ (α x i).support,
        c * M x i ≤ (n : ℝ) ∧ (n : ℝ) ≤ C * M x i) ∧
      (∀ n ∈ (β x i).support,
        c * N x i ≤ (n : ℝ) ∧ (n : ℝ) ≤ C * N x i) := by
    intro x hx i
    have hx0 : 0 < x := (Real.exp_pos 1).trans_le (hX₀.trans hx)
    have hN : 0 < N x i := (Real.rpow_pos_of_pos hx0 γ₀).trans_le
      (hscaleSource x hx i).2.2.1
    refine ⟨hαsupport x hx i, ?_⟩
    intro n hn
    have hnψ : ψ x i ((n : ℝ) / N x i) ≠ 0 := by
      simpa only [β, positiveCompactProfileSequence_apply c C (N x i) hc hN
        (ψ x i) (hψsupport x hx i)] using Finsupp.mem_support_iff.mp hn
    obtain ⟨hnlo, hnhi⟩ := hψsupport x hx i hnψ
    exact ⟨(le_div_iff₀ hN).mp hnlo, (div_le_iff₀ hN).mp hnhi⟩
  have hcoeff : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι, ∀ n : ℕ,
      ‖α x i n‖ ≤ W * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ k ∧
      ‖β x i n‖ ≤ W * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ k := by
    intro x hx i n
    have hx0 : 0 < x := (Real.exp_pos 1).trans_le (hX₀.trans hx)
    have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr (hX₀.trans hx)
    have hlog0 : 0 ≤ Real.log x := zero_le_one.trans hlog1
    have hN : 0 < N x i := (Real.rpow_pos_of_pos hx0 γ₀).trans_le
      (hscaleSource x hx i).2.2.1
    have hM : 0 < M x i := pos_of_mul_pos_left
      ((div_pos hx0 hCpos).trans_le (hscaleSource x hx i).1) hN.le
    constructor
    · by_cases hn : α x i n = 0
      · rw [hn, norm_zero]
        positivity
      have hnpos : 0 < n := by
        exact_mod_cast (mul_pos hc hM).trans_le
          ((hsupport x hx i).1 n (Finsupp.mem_support_iff.mpr hn)).1
      have hτ : (1 : ℝ) ≤ n.divisors.card := by
        exact_mod_cast Finset.one_le_card.mpr ⟨1, Nat.one_mem_divisors.mpr hnpos.ne'⟩
      calc
        ‖α x i n‖ ≤ Wα * (n.divisors.card : ℝ) ^ dα * (Real.log x) ^ dα :=
          hαcoeff x hx i n
        _ ≤ W * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ k :=
          mul_le_mul (mul_le_mul hWαW (pow_le_pow_right₀ hτ hdk)
            (pow_nonneg (Nat.cast_nonneg _) _) hW)
            (pow_le_pow_right₀ hlog1 hdk) (pow_nonneg hlog0 _) (by positivity)
    · by_cases hn : β x i n = 0
      · rw [hn, norm_zero]
        positivity
      have hnpos : 0 < n := by
        exact_mod_cast (mul_pos hc hN).trans_le
          ((hsupport x hx i).2 n (Finsupp.mem_support_iff.mpr hn)).1
      have hτ : (1 : ℝ) ≤ n.divisors.card := by
        exact_mod_cast Finset.one_le_card.mpr ⟨1, Nat.one_mem_divisors.mpr hnpos.ne'⟩
      have hb : ‖β x i n‖ ≤ W * (Real.log x) ^ k := by
        simpa only [β, positiveCompactProfileSequence_apply c C (N x i) hc hN
          (ψ x i) (hψsupport x hx i), iteratedDeriv_zero, Real.rpow_natCast] using
          hprofileBound x hx i 0 (by norm_num) ((n : ℝ) / N x i)
      exact hb.trans (mul_le_mul_of_nonneg_right
        (le_mul_of_one_le_right hW (one_le_pow₀ hτ)) (pow_nonneg hlog0 _))
  let C' : ℝ := max 4 (max C W)
  let c' : ℝ := min c 1
  have hC'4 : 4 ≤ C' := le_max_left _ _
  have hC'C : C ≤ C' := (le_max_left C W).trans (le_max_right _ _)
  have hC'W : W ≤ C' := (le_max_right C W).trans (le_max_right _ _)
  have hC' : 1 ≤ C' := by linarith only [hC'4]
  have hc' : 0 < c' := lt_min hc zero_lt_one
  have hc'c : c' ≤ c := min_le_left _ _
  have hc'C' : c' ≤ C' := (min_le_right _ _).trans hC'
  have hCevent : ∀ᶠ x : ℝ in Filter.atTop, C ≤ x ^ (1 / 4 - ε) :=
    (tendsto_rpow_atTop (by linarith only [hεbound] : (0 : ℝ) < 1 / 4 - ε)).eventually
      (Filter.eventually_ge_atTop C)
  obtain ⟨XC, hXC⟩ := Filter.eventually_atTop.mp hCevent
  obtain ⟨XL, hXL⟩ := Filter.eventually_atTop.mp (hLsubpower ε hε)
  let Xbase : ℝ := max X₀ (max XC XL)
  have hXbase₀ : X₀ ≤ Xbase := le_max_left _ _
  have hXbase : Real.exp 1 ≤ Xbase := hX₀.trans hXbase₀
  have hscale : ∀ x : ℝ, Xbase ≤ x → ∀ i : ι,
      x / C ≤ M x i * N x i ∧ M x i * N x i ≤ C * x ∧
      x ^ γ₀ ≤ N x i ∧ N x i ≤ x ^ (1 / 2 + ε) := by
    intro x hx i
    have hx₀ : X₀ ≤ x := hXbase₀.trans hx
    have hx0 : 0 < x := (Real.exp_pos 1).trans_le (hX₀.trans hx₀)
    obtain ⟨hmnlo, hmnhi, hnlo, hnhi⟩ := hscaleSource x hx₀ i
    refine ⟨hmnlo, hmnhi, hnlo, hnhi.trans ?_⟩
    calc
      Real.sqrt x * LN x ≤ x ^ (1 / 2 : ℝ) * x ^ ε := by
        rw [Real.sqrt_eq_rpow]
        exact mul_le_mul le_rfl
          (hXL x ((le_max_right _ _).trans ((le_max_right _ _).trans hx))).2
          (hLpos x hx₀).2.le (Real.rpow_nonneg hx0.le _)
      _ = _ := (Real.rpow_add hx0 _ _).symm
  have hSWbase : ∀ A : ℝ, 0 < A →
      ∃ KSW XSW : ℝ, 0 < KSW ∧ Xbase ≤ XSW ∧
        ∀ x : ℝ, XSW ≤ x → ∀ i : ι,
        ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
          ‖fullDiscrepancy ((β x i).filter (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
            KSW * ((q * r).divisors.card : ℝ) ^ 1 * N x i / (Real.log x) ^ A := by
    intro A hA
    obtain ⟨KSW, XSW, hKSW, _, hSW⟩ :=
      positiveCompactProfile_fixedMask_uniform_log_saving A γ₀ c C L Eψ hA hγ₀ hc hcC hL
    refine ⟨KSW, max Xbase XSW, hKSW, le_max_left _ _, ?_⟩
    intro x hx i q r a hq hr ha
    have hx₀ : X₀ ≤ x := hXbase₀.trans ((le_max_left _ _).trans hx)
    have hbound : ∀ t : ℝ, ‖ψ x i t‖ ≤ L * (Real.log x) ^ Eψ ∧
        ‖iteratedDeriv 2 (ψ x i) t‖ ≤ L * (Real.log x) ^ Eψ := by
      intro t
      exact ⟨by simpa only [iteratedDeriv_zero] using
        hψuniform x hx₀ i 0 (by norm_num) t, hψuniform x hx₀ i 2 le_rfl t⟩
    simpa only [pow_one, β] using hSW x ((le_max_right _ _).trans hx)
      (N x i) (hscaleSource x hx₀ i).2.2.1 (ψ x i) (hψ x hx₀ i)
      (hψsupport x hx₀ i) hbound q hq r hr a ha
  have hdyadic_bin_count (x θ : ℝ) (Q : ℕ) (hx : Real.exp 1 ≤ x)
      (hθ : 0 ≤ θ) (hQ : Q ≤ ⌊x ^ θ⌋₊) :
      ((Nat.log 2 Q + 1 : ℕ) : ℝ) ≤
        (1 + θ / Real.log 2) * Real.log x := by
    have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
    have hlogx : 1 ≤ Real.log x := by
      simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hx
    have hlogtwo : 0 < Real.log 2 := Real.log_pos (by norm_num)
    have hQreal : (Q : ℝ) ≤ x ^ θ :=
      (show (Q : ℝ) ≤ (⌊x ^ θ⌋₊ : ℝ) by exact_mod_cast hQ).trans
        (Nat.floor_le (Real.rpow_nonneg hxpos.le θ))
    have hlogbound : (Nat.log 2 Q : ℝ) * Real.log 2 ≤ θ * Real.log x := by
      by_cases hQzero : Q = 0
      · simpa only [hQzero, Nat.log_zero_right, Nat.cast_zero, zero_mul] using
          mul_nonneg hθ (zero_le_one.trans hlogx)
      · have hpow : (2 : ℝ) ^ Nat.log 2 Q ≤ x ^ θ :=
          (show (2 : ℝ) ^ Nat.log 2 Q ≤ (Q : ℝ) by
            exact_mod_cast Nat.pow_log_le_self 2 hQzero).trans hQreal
        have h := Real.log_le_log (pow_pos (by norm_num : (0 : ℝ) < 2) _) hpow
        simpa only [Real.log_pow, Real.log_rpow hxpos] using h
    have hquot : (Nat.log 2 Q : ℝ) ≤ θ * Real.log x / Real.log 2 :=
      (le_div_iff₀ hlogtwo).2 hlogbound
    calc
      ((Nat.log 2 Q + 1 : ℕ) : ℝ) = (Nat.log 2 Q : ℝ) + 1 := by norm_num
      _ ≤ θ * Real.log x / Real.log 2 + Real.log x := add_le_add hquot hlogx
      _ = (1 + θ / Real.log 2) * Real.log x := by ring
  have hpair_dyadic_cover (S : Finset (ℕ × ℕ)) (w : ℕ × ℕ → ℝ) (U V : ℕ)
      (hS : ∀ p ∈ S, 0 < p.1 ∧ p.1 ≤ U ∧ 0 < p.2 ∧ p.2 ≤ V)
      (hw : ∀ p ∈ S, 0 ≤ w p) :
      (∑ p ∈ S, w p) ≤
        ∑ j ∈ Finset.Icc 0 (Nat.log 2 U),
          ∑ k ∈ Finset.Icc 0 (Nat.log 2 V),
            ∑ p ∈ S.filter (fun p =>
              2 ^ j ≤ p.1 ∧ p.1 ≤ 2 * 2 ^ j ∧
              2 ^ k ≤ p.2 ∧ p.2 ≤ 2 * 2 ^ k), w p := by
    have hmap : ∀ p ∈ S, (Nat.log 2 p.1, Nat.log 2 p.2) ∈
        (Finset.Icc 0 (Nat.log 2 U)) ×ˢ (Finset.Icc 0 (Nat.log 2 V)) := by
      intro p hp
      exact Finset.mem_product.mpr
        ⟨Finset.mem_Icc.mpr ⟨Nat.zero_le _, Nat.log_mono_right (b := 2) (hS p hp).2.1⟩,
          Finset.mem_Icc.mpr ⟨Nat.zero_le _, Nat.log_mono_right (b := 2) (hS p hp).2.2.2⟩⟩
    calc
      (∑ p ∈ S, w p) = ∑ j ∈ Finset.Icc 0 (Nat.log 2 U),
          ∑ k ∈ Finset.Icc 0 (Nat.log 2 V),
            ∑ p ∈ S.filter (fun p => Nat.log 2 p.1 = j ∧ Nat.log 2 p.2 = k), w p := by
        simpa only [Finset.sum_product, Prod.mk.injEq] using
          (Finset.sum_fiberwise_of_maps_to hmap w).symm
      _ ≤ _ := by
        apply Finset.sum_le_sum
        intro j _
        apply Finset.sum_le_sum
        intro k _
        apply Finset.sum_le_sum_of_subset_of_nonneg
        · intro p hp
          obtain ⟨hpS, hj, hk⟩ := Finset.mem_filter.mp hp
          refine Finset.mem_filter.mpr ⟨hpS, ?_, ?_, ?_, ?_⟩
          · simpa only [hj] using Nat.pow_log_le_self 2 (hS p hpS).1.ne'
          · simpa only [hj, pow_succ, Nat.mul_comm] using
              (Nat.lt_pow_succ_log_self (by norm_num : 1 < 2) p.1).le
          · simpa only [hk] using Nat.pow_log_le_self 2 (hS p hpS).2.2.1.ne'
          · simpa only [hk, pow_succ, Nat.mul_comm] using
              (Nat.lt_pow_succ_log_self (by norm_num : 1 < 2) p.2).le
        · intro p hp _
          exact hw p (Finset.mem_filter.mp hp).1
  have hprime_product_pos (P : Finset ℕ) (hP : ∀ t ∈ P, Nat.Prime t) :
      0 < ∏ t ∈ P, t :=
    Finset.prod_pos (fun t ht => (hP t ht).pos)
  have hprimitive_average_le (G : ℕ) (hG : 0 < G) (F : ℕ → ℝ) (E : ℝ)
      (hF : ∀ b ∈ primitiveResidues G, F b ≤ E) :
      (∑ b ∈ primitiveResidues G, F b) / (G.totient : ℝ) ≤ E := by
    have hcard : (primitiveResidues G).card = G.totient := by
      unfold primitiveResidues
      rw [Nat.totient_eq_card_coprime]
      congr 1
      ext b
      simp only [Finset.mem_filter, Nat.coprime_comm]
    have hphi : (G.totient : ℝ) ≠ 0 := by
      exact_mod_cast (Nat.totient_pos.mpr hG).ne'
    calc
      (∑ b ∈ primitiveResidues G, F b) / (G.totient : ℝ) ≤
          (∑ b ∈ primitiveResidues G, E) / (G.totient : ℝ) :=
        div_le_div_of_nonneg_right (Finset.sum_le_sum hF) (Nat.cast_nonneg _)
      _ = E := by
        rw [Finset.sum_const, nsmul_eq_mul, hcard]
        exact mul_div_cancel_left₀ E hphi
  have hbalanced : ∀ x : ℝ, Xbase ≤ x → ∀ i : ι,
      x / C ≤ M x i * N x i ∧ M x i * N x i ≤ C * x ∧
      x ^ (1 / 8 : ℝ) ≤ M x i ∧ x ^ (1 / 8 : ℝ) ≤ N x i := by
    intro x hx i
    have hx₀ : X₀ ≤ x := hXbase₀.trans hx
    have hxexp : Real.exp 1 ≤ x := hX₀.trans hx₀
    have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
    have hx1 : 1 ≤ x :=
      (Real.one_le_exp_iff.mpr (by norm_num : (0 : ℝ) ≤ 1)).trans hxexp
    obtain ⟨hMNlo, hMNhi, hNlo, hNhi⟩ := hscale x hx i
    have hNpos : 0 < N x i := (Real.rpow_pos_of_pos hxpos _).trans_le hNlo
    have hMpos : 0 < M x i :=
      pos_of_mul_pos_left ((div_pos hxpos hCpos).trans_le hMNlo) hNpos.le
    have hCp : C ≤ x ^ (1 / 4 - ε) :=
      hXC x ((le_max_left _ _).trans ((le_max_right _ _).trans hx))
    have hMquarter : x ^ (1 / 4 : ℝ) ≤ M x i := by
      apply (mul_le_mul_iff_left₀ (mul_pos hCpos hNpos)).mp
      calc
        x ^ (1 / 4 : ℝ) * (C * N x i) ≤
            x ^ (1 / 4 : ℝ) * (x ^ (1 / 4 - ε) * x ^ (1 / 2 + ε)) :=
          mul_le_mul_of_nonneg_left
            (mul_le_mul hCp hNhi hNpos.le (Real.rpow_nonneg hxpos.le _))
            (Real.rpow_nonneg hxpos.le _)
        _ = x := by
          rw [← Real.rpow_add hxpos, ← Real.rpow_add hxpos,
            show (1 / 4 : ℝ) + (1 / 4 - ε + (1 / 2 + ε)) = 1 by ring,
            Real.rpow_one]
        _ ≤ M x i * (C * N x i) := by
          have hm := (div_le_iff₀ hCpos).mp hMNlo
          nlinarith only [hm]
    refine ⟨hMNlo, hMNhi, ?_, ?_⟩
    · exact (Real.rpow_le_rpow_of_exponent_le hx1 (by norm_num)).trans hMquarter
    · exact (Real.rpow_le_rpow_of_exponent_le hx1
        (by linarith only [hgap, hω, hδ] : (1 / 8 : ℝ) ≤ γ₀)).trans hNlo
  have hsupportBase := fun x (hx : Xbase ≤ x) => hsupport x (hXbase₀.trans hx)
  have hcoeffBase := fun x (hx : Xbase ≤ x) => hcoeff x (hXbase₀.trans hx)
  intro A hA
  obtain ⟨B, KBV, XBV, hBpos, hKBV, hXBV, hBV⟩ :=
    balanced_bv_masked_uniform_log_saving M N α β c C W (1 / 8) Xbase k 1
      hc hCscale hW (by norm_num) hXbase hbalanced hsupportBase hcoeffBase hSWbase A hA
  obtain ⟨KM, XM, hKM, hXM, hMean⟩ :=
    balanced_bv_meanTerm_uniform_log_saving M N α β c C W (1 / 8) Xbase k 1
      hc hCscale hW (by norm_num) hXbase hbalanced hsupportBase hcoeffBase hSWbase
      θ (1 / 2 - 3 * ε) hθpos.le (by linarith only [hε]) A hA
  obtain ⟨KE, XE, hKE, hXE, hExceptional⟩ :=
    exceptional_smallPrimePart_fullDiscrepancy_log_saving
      θ hθpos hθlt (2 * k + 1) 0 (2 * k : ℕ) (C ^ 3)
      (one_le_pow₀ hCscale) A hA
  obtain ⟨XD, hXD, hDelta⟩ :=
    sourceDeltaZero_rough_dyadic_smoothFactor_uniform_log_saving
      ω' δ' ε C' c' C' c C hω' hδ' hε hεsmall hsmall
      hC' hc' hc'C' hc hcC k k k (A + 2) 1 (by linarith only [hA]) zero_lt_one
  have hZevent : ∀ᶠ x : ℝ in Filter.atTop,
      Real.exp ((Real.log x) ^ (2 / 3 : ℝ)) ≤ x ^ ε := by
    simpa only [Real.rpow_zero, one_mul] using
      small_prime_density_scale_absorption 0 ε hε
  have hLogevent : ∀ᶠ x : ℝ in Filter.atTop,
      ‖(Real.log x) ^ B‖ ≤ ‖x ^ ε‖ := by
    simpa only [one_mul] using
      (isLittleO_log_rpow_rpow_atTop B hε).bound (by norm_num : (0 : ℝ) < 1)
  obtain ⟨XZ, hXZ⟩ := Filter.eventually_atTop.mp hZevent
  obtain ⟨XP, hXP⟩ := Filter.eventually_atTop.mp hLogevent
  let X : ℝ := max XBV (max XM (max XE (max XD (max XZ XP))))
  let Dθ : ℝ := 1 + θ / Real.log 2
  have hDθ : 0 < Dθ := by
    dsimp only [Dθ]
    exact add_pos zero_lt_one (div_pos hθpos (Real.log_pos (by norm_num)))
  let K : ℝ := KBV + KE * W ^ 2 + KM + C * Dθ ^ 2
  have hK : 0 < K := by
    dsimp only [K]
    positivity
  refine ⟨K, X, hK, hXbase₀.trans (hXBV.trans (le_max_left _ _)), ?_⟩
  intro x hx i I hI a ha
  have hxBV : XBV ≤ x := (le_max_left _ _).trans hx
  have hxM : XM ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans hx)
  have hxE : XE ≤ x := (le_max_left _ _).trans
    ((le_max_right _ _).trans ((le_max_right _ _).trans hx))
  have hxD : XD ≤ x := (le_max_left _ _).trans
    ((le_max_right _ _).trans ((le_max_right _ _).trans ((le_max_right _ _).trans hx)))
  have hxZ : XZ ≤ x := (le_max_left _ _).trans
    ((le_max_right _ _).trans ((le_max_right _ _).trans
      ((le_max_right _ _).trans ((le_max_right _ _).trans hx))))
  have hxP : XP ≤ x := (le_max_right _ _).trans
    ((le_max_right _ _).trans ((le_max_right _ _).trans
      ((le_max_right _ _).trans ((le_max_right _ _).trans hx))))
  have hxbase : Xbase ≤ x := hXBV.trans hxBV
  have hx₀ : X₀ ≤ x := hXbase₀.trans hxbase
  have hxexp : Real.exp 1 ≤ x := hX₀.trans hx₀
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hx1 : 1 ≤ x :=
    (Real.one_le_exp_iff.mpr (by norm_num : (0 : ℝ) ≤ 1)).trans hxexp
  have hlog1 : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hxexp
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlog1
  obtain ⟨hMNlo, hMNhi, hNlo, hNhi⟩ := hscale x hxbase i
  have hNpos : 0 < N x i := (Real.rpow_pos_of_pos hxpos _).trans_le hNlo
  have hMpos : 0 < M x i :=
    pos_of_mul_pos_left ((div_pos hxpos hCpos).trans_le hMNlo) hNpos.le
  have hMNpos : 0 < M x i * N x i := mul_pos hMpos hNpos
  let f : ℕ →₀ ℂ := finiteConvolution (α x i) (β x i)
  let Y : Set.Ici (1 : ℝ) := ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩
  let Z : Set.Ici (1 : ℝ) :=
    ⟨Real.exp ((Real.log x) ^ (2 / 3 : ℝ)),
      Real.one_le_exp_iff.mpr (Real.rpow_nonneg hlogpos.le _)⟩
  let cutoff : ℕ := ⌊x ^ θ⌋₊
  let cutoffSmall : ℕ := ⌊x ^ (1 / 2 - ε)⌋₊
  let Brough : ℕ := ⌊Real.exp ((Real.log x) ^ (1 / 3 : ℝ))⌋₊
  let S₀ : Finset ℕ := (Finset.Icc 1 cutoff).filter (fun q =>
    q ∣ ∏ p ∈ I, p ∧
      Nonempty (DenseDivisibilityWitness Y 1 q))
  let E : Finset ℕ := S₀.filter fun q =>
    cutoffSmall < q ∧ (smallPrimePart Brough q : ℝ) ≤ (Z : ℝ)
  let T : ℝ := x ^ (-5 * ε) * N x i
  have hY : (Y : ℝ) = x ^ δ := max_eq_right
    (Real.one_le_rpow hx1 hδ.le)
  have hZ : (Z : ℝ) ≤ x ^ ε := hXZ x hxZ
  have htwoPower : 2 ≤ x ^ ε := by
    calc
      (2 : ℝ) ≤ Real.exp 1 := by linarith only [Real.add_one_le_exp (1 : ℝ)]
      _ ≤ (Z : ℝ) := Real.exp_le_exp.mpr
        (Real.one_le_rpow hlog1 (by norm_num : (0 : ℝ) ≤ 2 / 3))
      _ ≤ x ^ ε := hZ
  have hYoriginalWorking : (Y : ℝ) ≤ max 1 (x ^ δ') := by
    rw [hY]
    exact (Real.rpow_le_rpow_of_exponent_le hx1 hδw.le).trans (le_max_right _ _)
  have hT : 1 ≤ T := by
    calc
      1 ≤ x ^ (-5 * ε + γ₀) :=
        Real.one_le_rpow hx1 (by linarith only [hεbound, hgap, hω, hδ])
      _ = x ^ (-5 * ε) * x ^ γ₀ := Real.rpow_add hxpos _ _
      _ ≤ T := mul_le_mul_of_nonneg_left hNlo (Real.rpow_nonneg hxpos.le _)
  have hTsmall : T ≤ x ^ (1 / 2 - ε) := by
    calc
      T ≤ x ^ (-5 * ε) * x ^ (1 / 2 + ε) :=
        mul_le_mul_of_nonneg_left hNhi (Real.rpow_nonneg hxpos.le _)
      _ = x ^ (-5 * ε + (1 / 2 + ε)) := (Real.rpow_add hxpos _ _).symm
      _ ≤ x ^ (1 / 2 - ε) := Real.rpow_le_rpow_of_exponent_le hx1
        (by linarith only [hε])
  have hTZ : T * (Z : ℝ) ≤ x ^ (-4 * ε) * N x i := by
    calc
      T * (Z : ℝ) ≤ (x ^ (-5 * ε) * N x i) * x ^ ε :=
        mul_le_mul_of_nonneg_left hZ (zero_le_one.trans hT)
      _ = x ^ (-4 * ε) * N x i := by
        rw [mul_right_comm, ← Real.rpow_add hxpos,
          show -5 * ε + ε = -4 * ε by ring]
  have hS₀data (q : ℕ) (hq : q ∈ S₀) :
      0 < q ∧ q ≤ cutoff ∧ q ∣ ∏ p ∈ I, p := by
    obtain ⟨hinterval, hdiv, _⟩ := Finset.mem_filter.mp hq
    exact ⟨(Finset.mem_Icc.mp hinterval).1,
      (Finset.mem_Icc.mp hinterval).2, hdiv⟩
  have hproductSquarefree : Squarefree (∏ p ∈ I, p) := by
    apply Finset.squarefree_prod_of_pairwise_isCoprime
    · intro p hp q hq hpq
      exact Nat.coprime_iff_isRelPrime.mp
        ((Nat.coprime_primes (hI p hp) (hI q hq)).mpr hpq)
    · intro p hp
      exact (hI p hp).squarefree
  have hS₀subset : S₀ ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ := by
    intro q hq
    exact Finset.mem_Icc.mpr ⟨(hS₀data q hq).1, (hS₀data q hq).2.1⟩
  have hS₀primitive (q : ℕ) (hq : q ∈ S₀) : Nat.Coprime a q :=
    ha.of_dvd_right (hS₀data q hq).2.2
  have hlogB : (Real.log x) ^ B ≤ x ^ ε := by
    simpa only [Real.norm_of_nonneg (Real.rpow_nonneg hlogpos.le _),
      Real.norm_of_nonneg (Real.rpow_nonneg hxpos.le _)] using hXP x hxP
  have hsmallcut : x ^ (1 / 2 - ε) ≤ Real.sqrt x / (Real.log x) ^ B := by
    apply (le_div_iff₀ (Real.rpow_pos_of_pos hlogpos B)).mpr
    calc
      x ^ (1 / 2 - ε) * (Real.log x) ^ B ≤ x ^ (1 / 2 - ε) * x ^ ε :=
        mul_le_mul_of_nonneg_left hlogB (Real.rpow_nonneg hxpos.le _)
      _ = x ^ (1 / 2 : ℝ) := by
        rw [← Real.rpow_add hxpos]
        congr 1
        ring
      _ = Real.sqrt x := (Real.sqrt_eq_rpow x).symm
  let U : ℕ := ⌊Real.sqrt x / (Real.log x) ^ B⌋₊
  have hsmallU : cutoffSmall ≤ U := Nat.floor_mono hsmallcut
  let F (q : ℕ) : ℝ := ⨆ b : (ZMod q)ˣ, ‖fullDiscrepancy f q (b : ZMod q).val‖
  have hFnonneg (q : ℕ) (hq : 0 < q) : 0 ≤ F q := by
    let : NeZero q := ⟨hq.ne'⟩
    have hb : BddAbove (Set.range fun b : (ZMod q)ˣ =>
        ‖fullDiscrepancy f q (b : ZMod q).val‖) := (Set.finite_range _).bddAbove
    exact (norm_nonneg _).trans (le_ciSup hb (1 : (ZMod q)ˣ))
  have hFbound (q : ℕ) (hq : q ∈ S₀) : ‖fullDiscrepancy f q a‖ ≤ F q := by
    let : NeZero q := ⟨(hS₀data q hq).1.ne'⟩
    have hb : BddAbove (Set.range fun b : (ZMod q)ˣ =>
        ‖fullDiscrepancy f q (b : ZMod q).val‖) := (Set.finite_range _).bddAbove
    have heq : ‖fullDiscrepancy f q
        (ZMod.unitOfCoprime a (hS₀primitive q hq) : ZMod q).val‖ =
          ‖fullDiscrepancy f q a‖ := by
      simp only [ZMod.coe_unitOfCoprime, ZMod.val_natCast, fullDiscrepancy,
        progressionMass, Nat.mod_mod]
    exact heq.symm.trans_le (le_ciSup hb (ZMod.unitOfCoprime a (hS₀primitive q hq)))
  have hfilterOne : f.filter (fun n : ℕ => Nat.Coprime n 1) = f := by
    ext n
    simp only [Finsupp.filter_apply]
    exact ite_eq_left (Nat.coprime_one_right n)
  have hBVone : (∑ q ∈ Finset.Ioc 0 U, F q) ≤ KBV * x / (Real.log x) ^ A := by
    have hb := hBV x hxBV i 1 zero_lt_one
    change (∑ q ∈ Finset.Ioc 0 U,
      ⨆ b : (ZMod q)ˣ, ‖fullDiscrepancy
        (f.filter (fun n : ℕ => Nat.Coprime n 1)) q (b : ZMod q).val‖) ≤ _ at hb
    rw [hfilterOne] at hb
    simpa only [Nat.divisors_one, Finset.card_singleton, Nat.cast_one,
      one_pow, mul_one, F] using hb
  have hsmallBound :
      (∑ q ∈ S₀.filter (fun q => q ≤ cutoffSmall), ‖fullDiscrepancy f q a‖) ≤
        KBV * x / (Real.log x) ^ A := by
    calc
      (∑ q ∈ S₀.filter (fun q => q ≤ cutoffSmall), ‖fullDiscrepancy f q a‖) ≤
          ∑ q ∈ S₀.filter (fun q => q ≤ cutoffSmall), F q :=
        Finset.sum_le_sum fun q hq => hFbound q (Finset.mem_filter.mp hq).1
      _ ≤ ∑ q ∈ Finset.Ioc 0 U, F q := by
        apply Finset.sum_le_sum_of_subset_of_nonneg
        · intro q hq
          obtain ⟨hqS, hqcut⟩ := Finset.mem_filter.mp hq
          exact Finset.mem_Ioc.mpr ⟨(hS₀data q hqS).1, hqcut.trans hsmallU⟩
        · intro q hq _
          exact hFnonneg q (Finset.mem_Ioc.mp hq).1
      _ ≤ KBV * x / (Real.log x) ^ A := hBVone
  obtain ⟨hfSupport, hfCoeff⟩ := finiteConvolution_support_and_divisor_bound
    (α x i) (β x i) x (M x i) (N x i) c C W k
      hx1 hMpos hNpos hc hCscale hW hMNhi
      (hsupport x hx₀ i).1 (hsupport x hx₀ i).2
      (fun n _ => (hcoeff x hx₀ i n).1) (fun n _ => (hcoeff x hx₀ i n).2)
  have hExceptionalBound :
      (∑ q ∈ S₀.filter (fun q => (Z : ℝ) < (smallPrimePart Brough q : ℝ)),
        ‖fullDiscrepancy f q a‖) ≤ KE * W ^ 2 * x / (Real.log x) ^ A := by
    have hcoefE : ∀ n ∈ f.support,
        ‖f n‖ ≤ W ^ 2 * (n.divisors.card : ℝ) ^ (2 * k + 1) *
          (Real.log x) ^ ((2 * k : ℕ) : ℝ) := by
      intro n _
      simpa only [Real.rpow_natCast, f] using hfCoeff n
    have he := hExceptional x hxE (W ^ 2) (sq_nonneg W) S₀ hS₀subset
      (fun _ => a) hS₀primitive f hfSupport hcoefE
    simpa only [pow_zero, one_mul, Brough, Z] using he
  have hEdata (n : ℕ) (hn : n ∈ E) :
      Squarefree n ∧ T ≤ (n : ℝ) ∧
        Nonempty (DenseDivisibilityWitness Y 1 n) ∧
        (smallPrimePart Brough n : ℝ) ≤ (Z : ℝ) := by
    obtain ⟨hnS, hnlarge, hnsmall⟩ := Finset.mem_filter.mp hn
    exact ⟨hproductSquarefree.squarefree_of_dvd (hS₀data n hnS).2.2,
      hTsmall.trans (Nat.lt_of_floor_lt hnlarge).le,
      (Finset.mem_filter.mp hnS).2.2, hnsmall⟩
  obtain ⟨S, hSsum, _hSinj, hSraw⟩ :=
    select_rough_lower_order_factor_family 1 (Or.inl rfl) Y Z Brough T hT E hEdata
  have hS (p : ℕ × ℕ) (hp : p ∈ S) :
      0 < p.1 ∧ 0 < p.2 ∧ Squarefree (p.1 * p.2) ∧
        p.1 * p.2 ∈ E ∧ p.1 * p.2 ∣ (∏ t ∈ I, t) ∧
        T / (Y : ℝ) ≤ (p.2 : ℝ) ∧ (p.2 : ℝ) ≤ T * (Z : ℝ) ∧
        Nonempty (DenseDivisibilityWitness
          (inflatedScale Y Z) (1 - 1) p.1) ∧
        Nonempty (DenseDivisibilityWitness Y 1 (p.1 * p.2)) ∧
        (∀ t ∈ p.1.primeFactors, Brough < t) := by
    obtain ⟨hpE, hq, hr, _hcop, hlo, hhi, hrough, hdq, hdfull⟩ := hSraw p hp
    have hpSource : p.1 * p.2 ∈ S₀ := (Finset.mem_filter.mp hpE).1
    have hdiv := (hS₀data _ hpSource).2.2
    exact ⟨hq, hr, hproductSquarefree.squarefree_of_dvd hdiv, hpE, hdiv,
      hlo, hhi, hdq, hdfull, hrough⟩
  have hSpair (p : ℕ × ℕ) (hp : p ∈ S) :
      0 < p.1 ∧ 0 < p.2 ∧ p.1 ≤ cutoff ∧ p.2 ≤ cutoff ∧
        Nat.Coprime p.1 p.2 ∧ Nat.Coprime a (p.1 * p.2) := by
    obtain ⟨hq, hr, hsf, hpE, _, _, _, _, _, _⟩ := hS p hp
    have hpS : p.1 * p.2 ∈ S₀ := (Finset.mem_filter.mp hpE).1
    have hcut := (hS₀data _ hpS).2.1
    exact ⟨hq, hr, (Nat.le_mul_of_pos_right _ hr).trans hcut,
      (Nat.le_mul_of_pos_left _ hq).trans hcut,
      Nat.coprime_of_squarefree_mul hsf, hS₀primitive _ hpS⟩
  have hSmean (p : ℕ × ℕ) (hp : p ∈ S) :
      0 < p.1 ∧ p.1 ≤ ⌊x ^ θ⌋₊ ∧
        0 < p.2 ∧ p.2 ≤ ⌊x ^ (1 / 2 - 3 * ε)⌋₊ ∧ Nat.Coprime p.1 p.2 := by
    obtain ⟨hq, hr, hqcut, _, hcop, _⟩ := hSpair p hp
    refine ⟨hq, hqcut, hr, ?_, hcop⟩
    apply (Nat.le_floor_iff (Real.rpow_nonneg hxpos.le _)).mpr
    calc
      (p.2 : ℝ) ≤ T * (Z : ℝ) := (hS p hp).2.2.2.2.2.2.1
      _ ≤ x ^ (-4 * ε) * N x i := hTZ
      _ ≤ x ^ (-4 * ε) * x ^ (1 / 2 + ε) :=
        mul_le_mul_of_nonneg_left hNhi (Real.rpow_nonneg hxpos.le _)
      _ = x ^ (1 / 2 - 3 * ε) := by
        rw [← Real.rpow_add hxpos]
        congr 1
        ring
  have hMeanBound : (∑ p ∈ S, ‖meanTerm f p.1 p.2 a‖) ≤
      KM * x / (Real.log x) ^ A :=
    hMean x hxM i S hSmean a (fun p hp => (hSpair p hp).2.2.2.2.2)
  let γ : ℝ := Real.log (N x i) / Real.log x
  have hNγ : N x i = x ^ γ := by
    apply Real.log_injOn_pos (Set.mem_Ioi.mpr hNpos)
      (Set.mem_Ioi.mpr (Real.rpow_pos_of_pos hxpos γ))
    rw [Real.log_rpow hxpos]
    dsimp only [γ]
    field_simp
  have hγlo : γ₀ ≤ γ := by
    apply (le_div_iff₀ hlogpos).mpr
    have hn := Real.log_le_log (Real.rpow_pos_of_pos hxpos _) hNlo
    rwa [Real.log_rpow hxpos] at hn
  have hγhi : γ ≤ 1 / 2 + ε := by
    apply (div_le_iff₀ hlogpos).mpr
    have hn := Real.log_le_log hNpos hNhi
    rwa [Real.log_rpow hxpos] at hn
  have hMNlo' : x / C' ≤ M x i * N x i :=
    (div_le_div_of_nonneg_left hxpos.le hCpos hC'C).trans hMNlo
  have hMNhi' : M x i * N x i ≤ C' * x :=
    hMNhi.trans (mul_le_mul_of_nonneg_right hC'C hxpos.le)
  have hαOpen : ∀ n ∈ (α x i).support,
      c' * M x i ≤ (n : ℝ) ∧ (n : ℝ) ≤ C' * M x i ∧
      ‖α x i n‖ ≤ C' * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ (k : ℝ) := by
    intro n hn
    obtain ⟨hnlo, hnhi⟩ := (hsupport x hx₀ i).1 n hn
    refine ⟨(mul_le_mul_of_nonneg_right hc'c hMpos.le).trans hnlo,
      hnhi.trans (mul_le_mul_of_nonneg_right hC'C hMpos.le), ?_⟩
    rw [Real.rpow_natCast]
    exact (hcoeff x hx₀ i n).1.trans
      (mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_right hC'W (pow_nonneg (Nat.cast_nonneg _) _))
        (pow_nonneg hlogpos.le _))
  have hψOpen : ∀ t : ℝ,
      ‖ψ x i t‖ ≤ C' * (Real.log x) ^ (k : ℝ) ∧
      ‖deriv (ψ x i) t‖ ≤ C' * (Real.log x) ^ (k : ℝ) := by
    intro t
    have hnorm := hprofileBound x hx₀ i 0 (by norm_num) t
    have hderiv := hprofileBound x hx₀ i 1 (by norm_num) t
    have hweight : W * (Real.log x) ^ (k : ℝ) ≤ C' * (Real.log x) ^ (k : ℝ) :=
      mul_le_mul_of_nonneg_right hC'W (Real.rpow_nonneg hlogpos.le _)
    exact ⟨by simpa only [iteratedDeriv_zero] using hnorm.trans hweight,
      by simpa only [iteratedDeriv_one] using hderiv.trans hweight⟩
  let G : ℕ := ∏ p ∈ I, p
  have hG : 0 < G := hprime_product_pos I hI
  have hDeltaBound (b : ℕ) (hb : b ∈ primitiveResidues G) :
      (∑ p ∈ S, ‖deltaZero f p.1 p.2 a a b‖) ≤
        C * Dθ ^ 2 * x / (Real.log x) ^ A := by
    have hbG : Nat.Coprime b G := (Finset.mem_filter.mp hb).2
    have habG : Nat.Coprime (a * a * b) G := (ha.mul_left ha).mul_left hbG
    let J : Finset ℕ := Finset.Icc 0 (Nat.log 2 cutoff)
    let E₀ : ℝ := (M x i * N x i) * (Real.log x) ^ (-(A + 2))
    have hE₀ : 0 ≤ E₀ := mul_nonneg hMNpos.le (Real.rpow_nonneg hlogpos.le _)
    have hBand (jq k' : ℕ) :
        (∑ p ∈ S.filter (fun p =>
            2 ^ jq ≤ p.1 ∧ p.1 ≤ 2 * 2 ^ jq ∧
            2 ^ k' ≤ p.2 ∧ p.2 ≤ 2 * 2 ^ k'),
          ‖deltaZero f p.1 p.2 a a b‖) ≤ E₀ := by
      let Q : ℝ := (2 ^ jq : ℕ)
      let R : ℝ := (2 ^ k' : ℕ)
      let S' : Finset (ℕ × ℕ) := S.filter fun p =>
        2 ^ jq ≤ p.1 ∧ p.1 ≤ 2 * 2 ^ jq ∧
        2 ^ k' ≤ p.2 ∧ p.2 ≤ 2 * 2 ^ k'
      have hQ : 0 < Q := Nat.cast_pos.mpr (pow_pos (by norm_num) _)
      have hR : 0 < R := Nat.cast_pos.mpr (pow_pos (by norm_num) _)
      by_cases hS' : S' = ∅
      · change (∑ p ∈ S', ‖deltaZero f p.1 p.2 a a b‖) ≤ E₀
        simpa only [hS', Finset.sum_empty] using hE₀
      obtain ⟨p, hp⟩ := Finset.nonempty_iff_ne_empty.mpr hS'
      obtain ⟨hpS, hqloN, hqhiN, hrloN, hrhiN⟩ := Finset.mem_filter.mp hp
      obtain ⟨hqpos, hrpos, hsf, hpE, hpdiv, hrloT, hrhiT, hdq, hdr, hrough⟩ :=
        hS p hpS
      have hqlo : Q ≤ (p.1 : ℝ) := by dsimp only [Q]; exact_mod_cast hqloN
      have hqhi : (p.1 : ℝ) ≤ 2 * Q := by dsimp only [Q]; exact_mod_cast hqhiN
      have hrlo : R ≤ (p.2 : ℝ) := by dsimp only [R]; exact_mod_cast hrloN
      have hrhi : (p.2 : ℝ) ≤ 2 * R := by dsimp only [R]; exact_mod_cast hrhiN
      have hqp : (0 : ℝ) ≤ p.1 := Nat.cast_nonneg _
      have hrp : (0 : ℝ) ≤ p.2 := Nat.cast_nonneg _
      have hprodlo : R * Q ≤ (p.1 : ℝ) * p.2 := by
        simpa only [mul_comm] using mul_le_mul hqlo hrlo hR.le hqp
      have hprodhi : (p.1 : ℝ) * p.2 ≤ 4 * (R * Q) := by
        have hm := mul_le_mul hqhi hrhi hrp (by positivity : 0 ≤ 2 * Q)
        nlinarith only [hm]
      obtain ⟨hpSource, hpLarge, _⟩ := Finset.mem_filter.mp hpE
      have hlarge : x ^ (1 / 2 - ε) < (p.1 : ℝ) * p.2 := by
        exact_mod_cast Nat.lt_of_floor_lt hpLarge
      have hupper : (p.1 : ℝ) * p.2 ≤ x ^ θ := by
        have hh : ((p.1 * p.2 : ℕ) : ℝ) ≤ (cutoff : ℝ) :=
          Nat.cast_le.mpr (hS₀data _ hpSource).2.1
        have hpcast : (p.1 : ℝ) * p.2 ≤ (cutoff : ℝ) := by
          simpa only [Nat.cast_mul] using hh
        exact hpcast.trans (Nat.floor_le (Real.rpow_nonneg hxpos.le _))
      have hRQlo : x ^ (1 / 2 - ε) ≤ C' * R * Q := by
        have hc := mul_le_mul_of_nonneg_right hC'4 (mul_nonneg hR.le hQ.le)
        nlinarith only [hlarge, hprodhi, hc]
      have hRQhi : R * Q ≤ x ^ (1 / 2 + 2 * ω' + ε) := by
        exact (hprodlo.trans hupper).trans
          (Real.rpow_le_rpow_of_exponent_le hx1
            (by dsimp only [θ]; linarith only [hωw, hε]))
      have hRhi : R ≤ x ^ (-4 * ε) * N x i :=
        (hrlo.trans hrhiT).trans hTZ
      have hNfromR : N x i ≤ x ^ (δ' + 4 * ε) * R := by
        have hYpos : 0 < (Y : ℝ) := zero_lt_one.trans_le Y.property
        have ht := (div_le_iff₀ hYpos).mp hrloT
        have hNr : N x i ≤ x ^ (δ + 5 * ε) * (p.2 : ℝ) := by
          calc
            N x i = x ^ (5 * ε) * T := by
              dsimp only [T]
              rw [← mul_assoc, ← Real.rpow_add hxpos]
              rw [show 5 * ε + -5 * ε = 0 by ring, Real.rpow_zero, one_mul]
            _ ≤ x ^ (5 * ε) * ((p.2 : ℝ) * (Y : ℝ)) :=
              mul_le_mul_of_nonneg_left ht (Real.rpow_nonneg hxpos.le _)
            _ = x ^ (δ + 5 * ε) * (p.2 : ℝ) := by
              rw [hY]
              calc
                x ^ (5 * ε) * ((p.2 : ℝ) * x ^ δ) =
                    (x ^ (5 * ε) * x ^ δ) * (p.2 : ℝ) := by ring
                _ = x ^ (δ + 5 * ε) * (p.2 : ℝ) := by
                  rw [← Real.rpow_add hxpos,
                    show 5 * ε + δ = δ + 5 * ε by ring]
        calc
          N x i ≤ x ^ (δ + 5 * ε) * (p.2 : ℝ) := hNr
          _ ≤ x ^ (δ + 5 * ε) * (2 * R) :=
            mul_le_mul_of_nonneg_left hrhi (Real.rpow_nonneg hxpos.le _)
          _ = (2 * x ^ (δ + 5 * ε)) * R := by ring
          _ ≤ (x ^ ε * x ^ (δ + 5 * ε)) * R :=
            mul_le_mul_of_nonneg_right
              (mul_le_mul_of_nonneg_right htwoPower (Real.rpow_nonneg hxpos.le _)) hR.le
          _ = x ^ (δ + 6 * ε) * R := by
            rw [← Real.rpow_add hxpos]
            congr 1
            ring_nf
          _ ≤ x ^ (δ' + 4 * ε) * R :=
            mul_le_mul_of_nonneg_right
              (Real.rpow_le_rpow_of_exponent_le hx1 (by linarith only [hεδ, hε])) hR.le
      have hNR : N x i ≤ C' * x ^ (δ' + 4 * ε) * R := by
        calc
          N x i ≤ x ^ (δ' + 4 * ε) * R := hNfromR
          _ ≤ C' * (x ^ (δ' + 4 * ε) * R) :=
            le_mul_of_one_le_left (by positivity) hC'
          _ = _ := by ring
      have hRhi' : R ≤ C' * x ^ (-2 * ε) * N x i := by
        calc
          R ≤ x ^ (-4 * ε) * N x i := hRhi
          _ ≤ x ^ (-2 * ε) * N x i := mul_le_mul_of_nonneg_right
            (Real.rpow_le_rpow_of_exponent_le hx1 (by linarith only [hε])) hNpos.le
          _ ≤ C' * (x ^ (-2 * ε) * N x i) :=
            le_mul_of_one_le_left (by positivity) hC'
          _ = _ := by ring
      have hRQhi' : R * Q ≤ C' * x ^ (1 / 2 + 2 * ω' + ε) :=
        hRQhi.trans (le_mul_of_one_le_left (by positivity) hC')
      have hSource : ∀ t ∈ S',
          0 < t.1 ∧ 0 < t.2 ∧ Squarefree (t.1 * t.2) ∧
          Q ≤ (t.1 : ℝ) ∧ (t.1 : ℝ) ≤ 2 * Q ∧
          R ≤ (t.2 : ℝ) ∧ (t.2 : ℝ) ≤ 2 * R ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (x ^ δ'), by exact le_max_left (1 : ℝ) (x ^ δ')⟩ 1 (t.1 * t.2)) ∧
          (∀ u ∈ t.1.primeFactors,
            Real.exp ((Real.log x) ^ (1 / 3 : ℝ)) < (u : ℝ)) := by
        intro t ht
        obtain ⟨htS, htqlo, htqhi, htrlo, htrhi⟩ := Finset.mem_filter.mp ht
        obtain ⟨htq, htr, htsf, _, _, _, _, _, htdfull, htrough⟩ := hS t htS
        refine ⟨htq, htr, htsf, ?_, ?_, ?_, ?_,
          denseDivisibility_mono_scale
            hYoriginalWorking htdfull, ?_⟩
        · dsimp only [Q]
          exact_mod_cast htqlo
        · dsimp only [Q]
          exact_mod_cast htqhi
        · dsimp only [R]
          exact_mod_cast htrlo
        · dsimp only [R]
          exact_mod_cast htrhi
        · intro u hu
          exact Nat.lt_of_floor_lt (htrough u hu)
      have hPrimitive : ∀ t ∈ S', Nat.Coprime (a * a * b) (t.1 * t.2) := by
        intro t ht
        exact habG.of_dvd_right (hS t (Finset.mem_filter.mp ht).1).2.2.2.2.1
      simpa only [one_mul, f, S', E₀, β] using
        hDelta x hxD (M x i) (N x i) R Q γ hMpos hNpos hR hQ
          hMNlo' hMNhi' hNγ (hγworking.trans hγlo) hγhi hNR hRhi' hRQlo hRQhi'
          (α x i) hαOpen (ψ x i) ((hψ x hx₀ i).of_le (by simp))
          (hψsupport x hx₀ i) hψOpen S' hSource a a b hPrimitive
    have hcover := hpair_dyadic_cover S
      (fun p => ‖deltaZero f p.1 p.2 a a b‖) cutoff cutoff
      (fun p hp => ⟨(hSpair p hp).1, (hSpair p hp).2.2.1,
        (hSpair p hp).2.1, (hSpair p hp).2.2.2.1⟩)
      (fun _ _ => norm_nonneg _)
    have hcard : (J.card : ℝ) ≤ Dθ * Real.log x :=
      by simpa only [J, Nat.card_Icc, Nat.sub_zero, Dθ] using
        hdyadic_bin_count x θ cutoff hxexp hθpos.le le_rfl
    calc
      (∑ p ∈ S, ‖deltaZero f p.1 p.2 a a b‖) ≤
          ∑ j ∈ J, ∑ k' ∈ J,
            ∑ p ∈ S.filter (fun p =>
              2 ^ j ≤ p.1 ∧ p.1 ≤ 2 * 2 ^ j ∧
              2 ^ k' ≤ p.2 ∧ p.2 ≤ 2 * 2 ^ k'),
              ‖deltaZero f p.1 p.2 a a b‖ := hcover
      _ ≤ ∑ _j ∈ J, ∑ _k ∈ J, E₀ :=
        Finset.sum_le_sum fun j _ => Finset.sum_le_sum fun k' _ => hBand j k'
      _ = (J.card : ℝ) ^ 2 * E₀ := by
        simp only [Finset.sum_const, nsmul_eq_mul]
        ring
      _ ≤ (Dθ * Real.log x) ^ 2 * E₀ :=
        mul_le_mul_of_nonneg_right (pow_le_pow_left₀ (Nat.cast_nonneg _) hcard 2) hE₀
      _ ≤ (Dθ * Real.log x) ^ 2 * ((C * x) * (Real.log x) ^ (-(A + 2))) :=
        mul_le_mul_of_nonneg_left
          (mul_le_mul_of_nonneg_right hMNhi (Real.rpow_nonneg hlogpos.le _))
          (sq_nonneg _)
      _ = C * Dθ ^ 2 * x / (Real.log x) ^ A := by
        rw [Real.rpow_neg hlogpos.le, Real.rpow_add hlogpos, Real.rpow_two]
        field_simp
  have hDispersionBound : (∑ p ∈ S, ‖dispersionTerm f p.1 p.2 a‖) ≤
      C * Dθ ^ 2 * x / (Real.log x) ^ A := by
    apply (sum_norm_dispersion_le_global_average f hG S ?_ a).trans
      (hprimitive_average_le G hG
        (fun b => ∑ p ∈ S, ‖deltaZero f p.1 p.2 a a b‖)
        (C * Dθ ^ 2 * x / (Real.log x) ^ A) hDeltaBound)
    intro p hp
    exact ⟨(hSpair p hp).2.2.2.2.1,
      (dvd_mul_right p.1 p.2).trans (hS p hp).2.2.2.2.1⟩
  have hGoodBound : (∑ q ∈ E, ‖fullDiscrepancy f q a‖) ≤
      (C * Dθ ^ 2 + KM) * x / (Real.log x) ^ A := by
    rw [hSsum]
    calc
      (∑ p ∈ S, ‖fullDiscrepancy f (p.1 * p.2) a‖) ≤
          ∑ p ∈ S, (‖dispersionTerm f p.1 p.2 a‖ + ‖meanTerm f p.1 p.2 a‖) := by
        apply Finset.sum_le_sum
        intro p _
        rw [fullDiscrepancy_eq_dispersion_add_mean]
        exact norm_add_le _ _
      _ = (∑ p ∈ S, ‖dispersionTerm f p.1 p.2 a‖) +
          ∑ p ∈ S, ‖meanTerm f p.1 p.2 a‖ := Finset.sum_add_distrib
      _ ≤ C * Dθ ^ 2 * x / (Real.log x) ^ A + KM * x / (Real.log x) ^ A :=
        add_le_add hDispersionBound hMeanBound
      _ = (C * Dθ ^ 2 + KM) * x / (Real.log x) ^ A := by ring
  have hSplit : (∑ q ∈ S₀, ‖fullDiscrepancy f q a‖) ≤
      (∑ q ∈ S₀.filter (fun q => q ≤ cutoffSmall), ‖fullDiscrepancy f q a‖) +
      (∑ q ∈ S₀.filter (fun q => (Z : ℝ) < (smallPrimePart Brough q : ℝ)),
        ‖fullDiscrepancy f q a‖) +
      ∑ q ∈ E, ‖fullDiscrepancy f q a‖ := by
    dsimp only [E]
    simp only [Finset.sum_filter]
    rw [← Finset.sum_add_distrib, ← Finset.sum_add_distrib]
    apply Finset.sum_le_sum
    intro q _
    by_cases hsmall : q ≤ cutoffSmall
    · by_cases hbad : (Z : ℝ) < (smallPrimePart Brough q : ℝ)
      · simp only [hsmall, hbad, not_lt_of_ge hsmall, false_and,
          ite_true, ite_false, add_zero]
        exact le_add_of_nonneg_right (norm_nonneg _)
      · simp only [hsmall, hbad, not_lt_of_ge hsmall, false_and,
          ite_true, ite_false, add_zero, le_refl]
    · have hlarge : cutoffSmall < q := lt_of_not_ge hsmall
      by_cases hbad : (Z : ℝ) < (smallPrimePart Brough q : ℝ)
      · simp only [hsmall, hbad, hlarge, not_le_of_gt hbad, and_false,
          ite_true, ite_false, zero_add, add_zero, le_refl]
      · have hgood : (smallPrimePart Brough q : ℝ) ≤ (Z : ℝ) := le_of_not_gt hbad
        simp only [hsmall, hbad, hlarge, hgood, and_self,
          ite_true, ite_false, zero_add, le_refl]
  have hcutOriginal : ⌊x ^ (1 / 2 + 2 * «ω») * L₀ x⌋₊ ≤ cutoff := by
    apply Nat.floor_mono
    calc
      x ^ (1 / 2 + 2 * «ω») * L₀ x ≤
          x ^ (1 / 2 + 2 * «ω») * x ^ ε :=
        mul_le_mul le_rfl
          (hXL x ((le_max_right _ _).trans ((le_max_right _ _).trans hxbase))).1
          (hLpos x hx₀).1.le (Real.rpow_nonneg hxpos.le _)
      _ = x ^ (1 / 2 + 2 * «ω» + ε) := (Real.rpow_add hxpos _ _).symm
      _ ≤ x ^ θ := Real.rpow_le_rpow_of_exponent_le hx1
        (by dsimp only [θ]; linarith only [hωε, hε])
  let Ssource : Finset ℕ :=
    (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L₀ x⌋₊).filter (fun q =>
      q ∣ (∏ p ∈ I, p) ∧
        Nonempty (DenseDivisibilityWitness Y 1 q))
  have hsourceSubset : Ssource ⊆ S₀ := by
    intro q hq
    obtain ⟨hqI, hqD, hqDense⟩ := Finset.mem_filter.mp hq
    obtain ⟨hq1, hqCut⟩ := Finset.mem_Icc.mp hqI
    exact Finset.mem_filter.mpr
      ⟨Finset.mem_Icc.mpr ⟨hq1, hqCut.trans hcutOriginal⟩, hqD, hqDense⟩
  change (∑ q ∈ Ssource, ‖fullDiscrepancy f q a‖) ≤ K * x / (Real.log x) ^ A
  apply (Finset.sum_le_sum_of_subset_of_nonneg hsourceSubset
    (fun q _ _ => norm_nonneg (fullDiscrepancy f q a))).trans
  calc
    (∑ q ∈ S₀, ‖fullDiscrepancy f q a‖) ≤
        (∑ q ∈ S₀.filter (fun q => q ≤ cutoffSmall), ‖fullDiscrepancy f q a‖) +
        (∑ q ∈ S₀.filter (fun q => (Z : ℝ) < (smallPrimePart Brough q : ℝ)),
          ‖fullDiscrepancy f q a‖) +
        ∑ q ∈ E, ‖fullDiscrepancy f q a‖ := hSplit
    _ ≤ KBV * x / (Real.log x) ^ A + KE * W ^ 2 * x / (Real.log x) ^ A +
        (C * Dθ ^ 2 + KM) * x / (Real.log x) ^ A :=
      add_le_add (add_le_add hsmallBound hExceptionalBound) hGoodBound
    _ = K * x / (Real.log x) ^ A := by dsimp only [K]; ring

end

/--
The difference of two smooth transitions one unit apart in the logarithmic coordinate `log u /
log Θ`. It is defined as zero for `u ≤ 0` and supplies the multiplicative localization profile
for the Heath–Brown factors.
-/
noncomputable def minorantHBProfile (Θ u : ℝ) : ℝ :=
  if 0 < u then
    Real.smoothTransition (Real.log u / Real.log Θ + 1) -
      Real.smoothTransition (Real.log u / Real.log Θ)
  else 0

/--
The arithmetic function assigned to one of the `2 * j` convolution slots: the first `j` are
Möbius functions cut off at `U`, the last is logarithm, and the remaining slots are zeta
functions.
-/
noncomputable def minorantHBSlot (j : ℕ) (U : ℝ) (i : Fin (2 * j)) : ArithmeticFunction ℝ :=
  if i.val < j then
    arithmeticFunctionLowCutoff U
      (ArithmeticFunction.moebius : ArithmeticFunction ℝ)
  else if i.val + 1 = 2 * j then ArithmeticFunction.log
  else (ArithmeticFunction.zeta : ArithmeticFunction ℝ)

open Classical in
/--
Exponent boxes for the `2 * j` multiplicatively localized Heath–Brown factors. Each exponent is
at most `⌈log B / log Θ⌉₊`, and the product of the box scales lies between `A / Θ^(2 * j)` and
`B * Θ^(2 * j)`.
-/
noncomputable def minorantHBBoxes (j : ℕ) (A B Θ : ℝ) : Finset (Fin (2 * j) → ℕ) :=
  (Fintype.piFinset (fun _ : Fin (2 * j) =>
    Finset.range (⌈Real.log B / Real.log Θ⌉₊ + 1))).filter (fun ν =>
      A / Θ ^ (2 * j) ≤ (∏ i, Θ ^ (ν i)) ∧
        (∏ i, Θ ^ (ν i)) ≤ B * Θ ^ (2 * j))

open Classical in
/--
The finitely supported multiplicative-algebra element for one Heath–Brown slot, localized near
`Θ^(ν i)`. Its coefficient at `n` is the slot value times the smooth profile and the Mellin
factor `n^(-t)`, sampled from `1` through `⌊Θ * Θ^(ν i)⌋₊`.
-/
noncomputable def minorantHBLocalizedSlot (j : ℕ) (U Θ t : ℝ)
    (ν : Fin (2 * j) → ℕ) (i : Fin (2 * j)) : MonoidAlgebra ℂ ℕ :=
  ∑ n ∈ Finset.Icc 1 ⌊Θ * Θ ^ (ν i)⌋₊,
    MonoidAlgebra.single n
      ((minorantHBProfile Θ ((n : ℝ) / Θ ^ (ν i)) *
        Real.rpow (n : ℝ) (-t) * minorantHBSlot j U i n : ℝ) : ℂ)

open Classical in
theorem minorantHBLocalizedSlot_coefficient
    (j : ℕ) (U Θ t : ℝ) (ν : Fin (2 * j) → ℕ) (i : Fin (2 * j)) (n : ℕ) :
    (minorantHBLocalizedSlot j U Θ t ν i).coeff n =
      if n ∈ Finset.Icc 1 ⌊Θ * Θ ^ (ν i)⌋₊ then
        ((minorantHBProfile Θ ((n : ℝ) / Θ ^ (ν i)) *
          Real.rpow (n : ℝ) (-t) * minorantHBSlot j U i n : ℝ) : ℂ)
      else 0 := by
  simp only [minorantHBLocalizedSlot, MonoidAlgebra.coeff_sum,
    MonoidAlgebra.coeff_single, Finsupp.finsetSum_apply, Finsupp.single_apply,
    Finset.sum_ite_eq']

open Classical in
theorem minorantHBLocalizedSlot_moebius_support
    (j : ℕ) (U Θ t : ℝ) (ν : Fin (2 * j) → ℕ) (i : Fin (2 * j))
    (hi : i.val < j) (n : ℕ)
    (hn : n ∈ (minorantHBLocalizedSlot j U Θ t ν i).coeff.support) :
    0 < n ∧ (n : ℝ) ≤ U := by
  have hnz := Finsupp.mem_support_iff.mp hn
  rw [minorantHBLocalizedSlot_coefficient] at hnz
  split_ifs at hnz with hmem
  · refine ⟨(Finset.mem_Icc.mp hmem).1, ?_⟩
    by_contra hU
    have hslot : minorantHBSlot j U i n = 0 := by
      simp [minorantHBSlot, hi,
        arithmeticFunctionLowCutoff, hU]
    simp only [hslot, mul_zero, Complex.ofReal_zero, ne_eq, not_true_eq_false] at hnz
  · exact False.elim (hnz rfl)

open Classical in
theorem minorantHB_box_localization
    (j : ℕ) (hj : 0 < j) (A B U Θ t : ℝ)
    (hA : 1 ≤ A) (hAB : A ≤ B) (hΘ : 1 < Θ) (hΘtwo : Θ ≤ 2)
    (ht : 0 ≤ t) (htten : t ≤ 10) :
    (minorantHBBoxes j A B Θ).card ≤
        (⌈Real.log B / Real.log Θ⌉₊ + 1) ^ (2 * j) ∧
    (∀ n : ℕ,
      (if A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B then
        ((Real.rpow (n : ℝ) (-t) *
          ((arithmeticFunctionLowCutoff U
            (ArithmeticFunction.moebius : ArithmeticFunction ℝ)) ^ j *
            (ArithmeticFunction.zeta : ArithmeticFunction ℝ) ^ (j - 1) *
              ArithmeticFunction.log) n : ℝ) : ℂ)
      else 0) =
      if A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B then
        ∑ ν ∈ minorantHBBoxes j A B Θ,
          (∏ i, minorantHBLocalizedSlot j U Θ t ν i).coeff n
      else 0) ∧
    (∀ ν ∈ minorantHBBoxes j A B Θ, ∀ i : Fin (2 * j),
      ∀ n ∈ (minorantHBLocalizedSlot j U Θ t ν i).coeff.support,
        Θ ^ (ν i) / Θ ≤ (n : ℝ) ∧ (n : ℝ) ≤ Θ * Θ ^ (ν i) ∧
          ‖(minorantHBLocalizedSlot j U Θ t ν i).coeff n‖ ≤ 1 + Real.log (n : ℝ)) := by
  have h := heathBrown_finite_smooth_box_boundary
    j hj A B U Θ t hA hAB hΘ hΘtwo ht htten
  dsimp only at h
  refine ⟨h.1, ?_, h.2.2.1⟩
  intro n
  have he := congrArg (fun f : ℕ →₀ ℂ => f n) h.2.1
  have hB : 0 ≤ B := zero_le_one.trans (hA.trans hAB)
  have hmem : n ∈ Finset.Icc ⌈A⌉₊ ⌊B⌋₊ ↔ A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B := by
    rw [Finset.mem_Icc, Nat.ceil_le, Nat.le_floor_iff hB]
  simpa only [Finsupp.finsetSum_apply, Finsupp.single_apply,
    Finset.sum_ite_eq', hmem, Finsupp.filter_apply, minorantHBBoxes,
    minorantHBLocalizedSlot, minorantHBProfile, minorantHBSlot] using he

open Classical in
theorem minorantHB_product_coefficient {ι : Type*} [Fintype ι] [DecidableEq ι]
    (β : ι → MonoidAlgebra ℂ ℕ) (n : ℕ) :
    (∏ i, β i).coeff n =
      ∑ d ∈ Fintype.piFinset (fun i => (β i).coeff.support),
        if (∏ i, d i) = n then ∏ i, (β i).coeff (d i) else 0 := by
  rw [← Finset.prod_congr rfl (fun i _ => MonoidAlgebra.sum_coeff_single (β i))]
  simp only [Finsupp.sum, Finset.prod_univ_sum, MonoidAlgebra.prod_single,
    MonoidAlgebra.coeff_sum, MonoidAlgebra.coeff_single,
    Finsupp.finsetSum_apply, Finsupp.single_apply]

theorem exists_subset_sum_between_of_le_sum {ι : Type*}
    (s : Finset ι) (w : ι → ℝ) (D y : ℝ) (hy : 0 < y)
    (hs : y ≤ ∑ i ∈ s, w i) (hw : ∀ i ∈ s, w i ≤ D) :
    ∃ t ⊆ s, y ≤ ∑ i ∈ t, w i ∧ ∑ i ∈ t, w i ≤ y + D := by
  classical
  induction s using Finset.induction_on generalizing y with
  | empty =>
      simp only [Finset.sum_empty] at hs
      linarith
  | @insert i s hi ih =>
      by_cases hiy : y ≤ w i
      · refine ⟨{i}, by simp, ?_, ?_⟩
        · simpa only [Finset.sum_singleton] using hiy
        · simpa only [Finset.sum_singleton] using (hw i (by simp)).trans (by linarith)
      · have hy' : 0 < y - w i := by linarith
        have hs' : y - w i ≤ ∑ j ∈ s, w j := by
          rw [Finset.sum_insert hi] at hs
          linarith
        obtain ⟨t, hts, htlo, hthi⟩ := ih (y - w i) hy' hs'
          (fun j hj => hw j (Finset.mem_insert_of_mem hj))
        have hit : i ∉ t := fun hit => hi (hts hit)
        refine ⟨insert i t, Finset.insert_subset_insert i hts, ?_, ?_⟩
        · rw [Finset.sum_insert hit]
          linarith
        · rw [Finset.sum_insert hit]
          linarith

theorem sum_add_sum_lt_of_no_subset_sum_in_Icc {ι : Type*}
    (w : ι → ℝ) (A B : ℝ)
    (havoid : ∀ s : Finset ι, ¬ (A ≤ ∑ i ∈ s, w i ∧ ∑ i ∈ s, w i ≤ B))
    (s t : Finset ι) (hst : Disjoint s t) (hs : ∑ i ∈ s, w i < A)
    (ht : ∀ i ∈ t, w i ≤ B - A) :
    (∑ i ∈ s, w i) + ∑ i ∈ t, w i < A := by
  classical
  by_contra hcross
  have hy : 0 < A - ∑ i ∈ s, w i := by linarith
  obtain ⟨u, hut, hulo, huhi⟩ := exists_subset_sum_between_of_le_sum t w (B - A)
    (A - ∑ i ∈ s, w i) hy (by linarith) ht
  have hsu : Disjoint s u := hst.mono_right hut
  apply havoid (s ∪ u)
  rw [Finset.sum_union hsu]
  constructor <;> linarith

theorem sum_lt_of_card_le_two {ι : Type*}
    (w : ι → ℝ) (A : ℝ) (hA : 0 < A) (hw : ∀ i, w i < A)
    (hpair : ∀ i j, i ≠ j → w i + w j < A)
    (s : Finset ι) (hs : s.card ≤ 2) : ∑ i ∈ s, w i < A := by
  classical
  by_cases he : s = ∅
  · simpa only [he, Finset.sum_empty] using hA
  have hpos : 0 < s.card := Finset.card_pos.mpr (Finset.nonempty_iff_ne_empty.mpr he)
  by_cases hone : s.card = 1
  · obtain ⟨i, rfl⟩ := Finset.card_eq_one.mp hone
    simpa only [Finset.sum_singleton] using hw i
  · have htwo : s.card = 2 := by omega
    obtain ⟨i, j, hij, rfl⟩ := Finset.card_eq_two.mp htwo
    simpa [Finset.sum_insert, hij] using hpair i j hij

open Classical in
theorem three_color_five_singletons {ι : Type*}
    (s : Finset ι) (color : ι → Fin 3) (hs : s.card = 5) :
    ∃ c : Fin 3, 4 ≤ (s.filter (fun i => color i ≠ c)).card := by
  obtain ⟨c, _, hc⟩ := Finset.exists_card_fiber_lt_of_card_lt_mul
    (s := s) (t := (Finset.univ : Finset (Fin 3))) (f := color) (n := 2) (by simp [hs])
  refine ⟨c, ?_⟩
  have he := Finset.card_filter_add_card_filter_not (s := s) (fun i => color i = c)
  simp only [← ne_eq] at he
  omega

open Classical in
theorem minorant_three_prime_heathBrown_trichotomy
    (τ : ℝ) (hτ : 0 < τ) (hτsmall : τ ≤ 1 / 10 ^ 10)
    {n : ℕ} (α : Fin n → ℝ) (color : Fin n → Fin 3)
    (hα : ∀ i, 0 ≤ α i)
    (htotal : |(∑ i, α i) - 1| ≤ τ / 1000)
    (hcolor : ∀ c : Fin 3,
      1 - 1058 / 3125 - 40481 / 100000 - τ / 5 ≤
        ∑ i ∈ (Finset.univ.filter (fun i => color i = c)), α i) :
    (∃ i, 1058 / 3125 - τ ≤ α i) ∨
    (∃ s : Finset (Fin n),
      40481 / 100000 - τ ≤ ∑ i ∈ s, α i ∧
        ∑ i ∈ s, α i ≤ 59519 / 100000 + τ) ∨
    (∃ i j k : Fin n,
      i ≠ j ∧ i ≠ k ∧ j ≠ k ∧
      (19 / 100 - τ ≤ α i ∧ α i ≤ 81 / 200 + τ) ∧
      (19 / 100 - τ ≤ α j ∧ α j ≤ 81 / 200 + τ) ∧
      (19 / 100 - τ ≤ α k ∧ α k ≤ 81 / 200 + τ) ∧
      119 / 200 - τ ≤ α i + α j ∧
      119 / 200 - τ ≤ α i + α k ∧
      119 / 200 - τ ≤ α j + α k) := by
  let A : ℝ := 40481 / 100000 - τ
  let B : ℝ := 59519 / 100000 + τ
  let C : ℝ := 1058 / 3125 - τ
  let D : ℝ := B - A
  let T : ℝ := ∑ i, α i
  change |T - 1| ≤ τ / 1000 at htotal
  obtain ⟨htotalLo, htotalHi⟩ := abs_le.mp htotal
  have hTlo : 1 - τ / 1000 ≤ T := by linarith
  have hThi : T ≤ 1 + τ / 1000 := by linarith
  have hA : 0 < A := by dsimp [A]; linarith only [hτsmall]
  have hD : 0 < D := by dsimp [D, B, A]; linarith only [hτ]
  have hCA : C < A := by dsimp [C, A]; linarith only []
  have hAC : A + C < 1 - τ / 1000 := by dsimp [A, C]; linarith only [hτ]
  have htwoA : 2 * A < 1 - τ / 1000 := by dsimp [A]; linarith only [hτ]
  have hcross : A < B - C + D := by dsimp [A, B, C, D]; linarith only [hτ]
  have hBClo : 19 / 100 - τ < B - C := by dsimp [B, C]; linarith only [hτ]
  have hDlo : 19 / 100 - τ < D := by dsimp [D, B, A]; linarith only [hτ]
  have hCup : C < 81 / 200 + τ := by dsimp [C]; linarith only [hτ]
  have hBlo : 119 / 200 - τ < B := by dsimp [B]; linarith only [hτ]
  have hsix : 1 + τ / 1000 < 6 * D := by dsimp [D, B, A]; linarith only [hτ]
  have hcolorGap : 1 + τ / 1000 - 4 * D <
      1 - 1058 / 3125 - 40481 / 100000 - τ / 5 := by dsimp [D, B, A]; linarith only [hτ]
  by_cases hI : ∃ i, C ≤ α i
  · exact Or.inl hI
  right
  by_cases hII : ∃ s : Finset (Fin n), A ≤ ∑ i ∈ s, α i ∧ ∑ i ∈ s, α i ≤ B
  · exact Or.inl hII
  right
  by_contra hIII
  have hupper (i : Fin n) : α i < C := lt_of_not_ge (fun hi => hI ⟨i, hi⟩)
  have hsmall (i : Fin n) : α i < A := (hupper i).trans hCA
  have havoid (s : Finset (Fin n)) :
      ¬ (A ≤ ∑ i ∈ s, α i ∧ ∑ i ∈ s, α i ≤ B) := fun hs => hII ⟨s, hs⟩
  have habove (s : Finset (Fin n)) (hs : A ≤ ∑ i ∈ s, α i) :
      B < ∑ i ∈ s, α i := lt_of_not_ge (fun ht => havoid s ⟨hs, ht⟩)
  have hpair (i j : Fin n) (hij : i ≠ j) : α i + α j < A := by
    by_contra hijLow
    have hijHigh : B < α i + α j := by
      have hh := habove {i, j} (by simpa [Finset.sum_insert, hij] using le_of_not_gt hijLow)
      simpa [Finset.sum_insert, hij] using hh
    let V : Finset (Fin n) := ({i, j} : Finset (Fin n))ᶜ
    have hTsplit : α i + α j + (∑ k ∈ V, α k) = T := by
      simpa [V, T, Finset.sum_insert, hij] using
        Finset.sum_add_sum_compl ({i, j} : Finset (Fin n)) α
    have hk : ∃ k ∈ V, D < α k := by
      by_contra hk
      push Not at hk
      have hdisjoint : Disjoint ({i} : Finset (Fin n)) V := by
        apply Finset.disjoint_left.mpr
        intro k hki hkV
        have hki' : k = i := Finset.mem_singleton.mp hki
        subst k
        simp [V] at hkV
      have hh := sum_add_sum_lt_of_no_subset_sum_in_Icc α A B havoid {i} V hdisjoint
        (by simpa only [Finset.sum_singleton] using hsmall i) hk
      simp only [Finset.sum_singleton] at hh
      have hTu : T < A + C := by
        calc
          T = (α i + ∑ k ∈ V, α k) + α j := by rw [← hTsplit]; ring
          _ < A + C := add_lt_add hh (hupper j)
      exact (not_lt_of_ge hTlo) (hTu.trans hAC)
    obtain ⟨k, hkV, hkD⟩ := hk
    have hki : k ≠ i ∧ k ≠ j := by simpa [V] using hkV
    have hik : i ≠ k := hki.1.symm
    have hjk : j ≠ k := hki.2.symm
    have hiBC : B - C < α i := by
      simpa only [add_sub_cancel_right] using sub_lt_sub hijHigh (hupper j)
    have hjBC : B - C < α j := by
      have hh := sub_lt_sub hijHigh (hupper i)
      simpa only [add_sub_cancel_left] using hh
    have hikHigh : B < α i + α k := by
      have hh := habove {i, k} (by
        have hbase : A ≤ α i + α k := by
          linarith only [hijHigh, hupper j, hkD, hcross]
        simpa [Finset.sum_insert, hik] using hbase)
      simpa [Finset.sum_insert, hik] using hh
    have hjkHigh : B < α j + α k := by
      have hh := habove {j, k} (by
        have hbase : A ≤ α j + α k := by
          linarith only [hijHigh, hupper i, hkD, hcross]
        simpa [Finset.sum_insert, hjk] using hbase)
      simpa [Finset.sum_insert, hjk] using hh
    apply hIII
    refine ⟨i, j, k, hij, hik, hjk, ⟨?_, ?_⟩, ⟨?_, ?_⟩, ⟨?_, ?_⟩, ?_, ?_, ?_⟩
    · exact hBClo.le.trans hiBC.le
    · exact (hupper i).le.trans hCup.le
    · exact hBClo.le.trans hjBC.le
    · exact (hupper j).le.trans hCup.le
    · exact hDlo.le.trans hkD.le
    · exact (hupper k).le.trans hCup.le
    · exact hBlo.le.trans hijHigh.le
    · exact hBlo.le.trans hikHigh.le
    · exact hBlo.le.trans hjkHigh.le
  let H : Finset (Fin n) := Finset.univ.filter (fun i => D < α i)
  let S : Finset (Fin n) := Hᶜ
  have hSupper (i : Fin n) (hi : i ∈ S) : α i ≤ D := by
    have hiH : i ∉ H := Finset.mem_compl.mp hi
    by_contra hnot
    exact hiH (Finset.mem_filter.mpr ⟨Finset.mem_univ _, lt_of_not_ge hnot⟩)
  have hHfive : 5 ≤ H.card := by
    by_contra hnot
    have hHfour : H.card ≤ 4 := by omega
    obtain ⟨U, hUH, hUcard⟩ := Finset.exists_subset_card_eq (s := H) (n := min 2 H.card)
      (min_le_right _ _)
    have hUtwo : U.card ≤ 2 := hUcard.trans_le (min_le_left _ _)
    have hVtwo : (H \ U).card ≤ 2 := by
      rw [Finset.card_sdiff_of_subset hUH]
      omega
    have hUsmall := sum_lt_of_card_le_two α A hA hsmall hpair U hUtwo
    have hVsmall := sum_lt_of_card_le_two α A hA hsmall hpair (H \ U) hVtwo
    have hUS : Disjoint U S := by
      apply Finset.disjoint_left.mpr
      intro i hiU hiS
      exact (Finset.mem_compl.mp hiS) (hUH hiU)
    have hUScross := sum_add_sum_lt_of_no_subset_sum_in_Icc α A B havoid U S hUS hUsmall hSupper
    have hsplitH : (∑ i ∈ H \ U, α i) + ∑ i ∈ U, α i = ∑ i ∈ H, α i :=
      Finset.sum_sdiff hUH
    have hsplitAll : (∑ i ∈ H, α i) + ∑ i ∈ S, α i = T :=
      Finset.sum_add_sum_compl H α
    have hTu : T < 2 * A := by
      calc
        T = ((∑ i ∈ U, α i) + ∑ i ∈ S, α i) + ∑ i ∈ H \ U, α i := by
          rw [← hsplitAll, ← hsplitH]
          ring
        _ < A + A := add_lt_add hUScross hVsmall
        _ = 2 * A := by ring
    exact (not_lt_of_ge hTlo) (hTu.trans htwoA)
  have hHlefive : H.card ≤ 5 := by
    by_contra hnot
    have hHsix : 6 ≤ H.card := by omega
    have hcast : (6 : ℝ) ≤ (H.card : ℝ) := by exact_mod_cast hHsix
    have hHlo : 6 * D ≤ ∑ i ∈ H, α i := by
      calc
        6 * D ≤ (H.card : ℝ) * D := mul_le_mul_of_nonneg_right hcast hD.le
        _ = ∑ _i ∈ H, D := by rw [Finset.sum_const, nsmul_eq_mul]
        _ ≤ _ := Finset.sum_le_sum (fun i hi => (Finset.mem_filter.mp hi).2.le)
    have hHup : (∑ i ∈ H, α i) ≤ T :=
      Finset.sum_le_sum_of_subset_of_nonneg (Finset.subset_univ _)
        (fun i _ _ => hα i)
    exact (not_lt_of_ge (hHlo.trans hHup)) (hThi.trans_lt hsix)
  have hHcard : H.card = 5 := le_antisymm hHlefive hHfive
  obtain ⟨c, hc⟩ := three_color_five_singletons H color hHcard
  let K : Finset (Fin n) := H.filter (fun i => color i ≠ c)
  let I : Finset (Fin n) := Finset.univ.filter (fun i => color i = c)
  have hKcast : (4 : ℝ) ≤ (K.card : ℝ) := by exact_mod_cast hc
  have hKlo : 4 * D ≤ ∑ i ∈ K, α i := by
    calc
      4 * D ≤ (K.card : ℝ) * D := mul_le_mul_of_nonneg_right hKcast hD.le
      _ = ∑ _i ∈ K, D := by rw [Finset.sum_const, nsmul_eq_mul]
      _ ≤ _ := Finset.sum_le_sum (fun i hi =>
        (Finset.mem_filter.mp (Finset.mem_filter.mp hi).1).2.le)
  have hIK : Disjoint I K := by
    apply Finset.disjoint_left.mpr
    intro i hiI hiK
    exact (Finset.mem_filter.mp hiK).2 (Finset.mem_filter.mp hiI).2
  have hIKsum : (∑ i ∈ I, α i) + ∑ i ∈ K, α i ≤ T := by
    rw [← Finset.sum_union hIK]
    exact Finset.sum_le_sum_of_subset_of_nonneg (Finset.subset_univ _)
      (fun i _ _ => hα i)
  have hcolorc := hcolor c
  change 1 - 1058 / 3125 - 40481 / 100000 - τ / 5 ≤ ∑ i ∈ I, α i at hcolorc
  have hcolorUp : (∑ i ∈ I, α i) ≤ 1 + τ / 1000 - 4 * D := by
    apply (le_sub_iff_add_le).mpr
    exact (add_le_add (le_refl (∑ i ∈ I, α i)) hKlo).trans (hIKsum.trans hThi)
  exact (not_lt_of_ge hcolorc) (hcolorUp.trans_lt hcolorGap)

theorem minorant_three_prime_colored_slot_trichotomy
    (τ : ℝ) (hτ : 0 < τ) (hτsmall : τ ≤ 1 / 10 ^ 10)
    (r : Fin 3 → Fin 5)
    (α : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℝ)
    (hα : ∀ c i, 0 ≤ α c i)
    (hcolor : ∀ c : Fin 3,
      1 - 1058 / 3125 - 40481 / 100000 - τ / 5 ≤ ∑ i, α c i)
    (htotal : |(∑ c, ∑ i, α c i) - 1| ≤ τ / 1000)
    (hmu : ∀ (c : Fin 3) (i : Fin (2 * ((r c).val + 1))),
      i.val < (r c).val + 1 → α c i ≤ 1 / 10) :
    let I := Σ c : Fin 3, Fin (2 * ((r c).val + 1))
    (∃ s : I,
      (r s.1).val + 1 ≤ s.2.val ∧ 1058 / 3125 - τ ≤ α s.1 s.2) ∨
    (∃ S : Finset I,
      40481 / 100000 - τ ≤ ∑ s ∈ S, α s.1 s.2 ∧
        (∑ s ∈ S, α s.1 s.2) ≤ 59519 / 100000 + τ) ∨
    (∃ s t u : I,
      s ≠ t ∧ s ≠ u ∧ t ≠ u ∧
      (r s.1).val + 1 ≤ s.2.val ∧ (r t.1).val + 1 ≤ t.2.val ∧
      (r u.1).val + 1 ≤ u.2.val ∧
      (19 / 100 - τ ≤ α s.1 s.2 ∧
        α s.1 s.2 ≤ 81 / 200 + τ) ∧
      (19 / 100 - τ ≤ α t.1 t.2 ∧
        α t.1 t.2 ≤ 81 / 200 + τ) ∧
      (19 / 100 - τ ≤ α u.1 u.2 ∧
        α u.1 u.2 ≤ 81 / 200 + τ) ∧
      119 / 200 - τ ≤ α s.1 s.2 + α t.1 t.2 ∧
      119 / 200 - τ ≤ α s.1 s.2 + α u.1 u.2 ∧
      119 / 200 - τ ≤ α t.1 t.2 + α u.1 u.2) := by
  classical
  intro I
  let e : I ≃ Fin (Fintype.card I) := Fintype.equivFin I
  have htotalEq :
      (∑ i : Fin (Fintype.card I), α (e.symm i).1 (e.symm i).2) =
        ∑ c, ∑ i, α c i :=
    (e.symm.sum_comp (fun s : I => α s.1 s.2)).trans (Fintype.sum_sigma _)
  have hcolorEq (c : Fin 3) :
      (∑ i ∈ (Finset.univ.filter (fun i : Fin (Fintype.card I) => (e.symm i).1 = c)),
        α (e.symm i).1 (e.symm i).2) = ∑ j, α c j := by
    calc
      _ = ∑ i : Fin (Fintype.card I),
          if (e.symm i).1 = c then α (e.symm i).1 (e.symm i).2 else 0 := by
        rw [Finset.sum_filter]
      _ = ∑ s : I, if s.1 = c then α s.1 s.2 else 0 :=
        e.symm.sum_comp (fun s : I => if s.1 = c then α s.1 s.2 else 0)
      _ = ∑ j, α c j := by rw [Fintype.sum_sigma]; simp
  have hcases := minorant_three_prime_heathBrown_trichotomy τ hτ hτsmall
    (fun i : Fin (Fintype.card I) => α (e.symm i).1 (e.symm i).2)
    (fun i => (e.symm i).1)
    (fun i => hα (e.symm i).1 (e.symm i).2)
    (by simpa only [htotalEq] using htotal)
    (fun c => by simpa only [hcolorEq c] using hcolor c)
  have hNonMu (s : I) (hs : 19 / 100 - τ ≤ α s.1 s.2) :
      (r s.1).val + 1 ≤ s.2.val := by
    by_contra hbad
    have hsmall := hmu s.1 s.2 (by omega)
    have hlt : (1 / 10 : ℝ) < α s.1 s.2 :=
      (by linarith only [hτsmall] : (1 / 10 : ℝ) < 19 / 100 - τ).trans_le hs
    exact (not_lt_of_ge hsmall) hlt
  rcases hcases with ⟨i, hi⟩ | ⟨S, hSlo, hShi⟩ |
    ⟨i, j, k, hij, hik, hjk, hi, hj, hk, hijLo, hikLo, hjkLo⟩
  · refine Or.inl ⟨e.symm i, hNonMu _ ?_, hi⟩
    exact (by linarith only [] :
      19 / 100 - τ ≤ 1058 / 3125 - τ).trans hi
  · have hsum :
        (∑ s ∈ S.image e.symm, α s.1 s.2) =
          ∑ i ∈ S, α (e.symm i).1 (e.symm i).2 :=
      Finset.sum_image (fun i _ j _ h => e.symm.injective h)
    exact Or.inr (Or.inl ⟨S.image e.symm,
      by simpa only [hsum] using hSlo, by simpa only [hsum] using hShi⟩)
  · refine Or.inr (Or.inr ⟨e.symm i, e.symm j, e.symm k,
      ?_, ?_, ?_, hNonMu _ hi.1, hNonMu _ hj.1, hNonMu _ hk.1,
      hi, hj, hk, hijLo, hikLo, hjkLo⟩)
    · exact fun h => hij (e.symm.injective h)
    · exact fun h => hik (e.symm.injective h)
    · exact fun h => hjk (e.symm.injective h)

open Classical in
theorem minorantHB_three_box_radial_support
    (A B t : Fin 3 → ℝ) (U Θ : ℝ)
    (hA : ∀ c, 1 ≤ A c) (hAB : ∀ c, A c ≤ B c)
    (hΘ : 1 < Θ) (hΘtwo : Θ ≤ 2)
    (ht : ∀ c, 0 ≤ t c) (htten : ∀ c, t c ≤ 10)
    (r : Fin 3 → Fin 5)
    (ν : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ)
    (hν : ν ∈ Fintype.piFinset (fun c : Fin 3 =>
      minorantHBBoxes ((r c).val + 1) (A c) (B c) Θ)) :
    let I := Σ c : Fin 3, Fin (2 * ((r c).val + 1))
    let β : I → MonoidAlgebra ℂ ℕ := fun s =>
      minorantHBLocalizedSlot ((r s.1).val + 1) U Θ (t s.1) (ν s.1) s.2
    let P : ℝ := ∏ s : I, Θ ^ (ν s.1 s.2)
    ∀ n ∈ (∏ s : I, β s).coeff.support,
      P / Θ ^ 30 ≤ (n : ℝ) ∧ (n : ℝ) ≤ P * Θ ^ 30 := by
  intro I β P n hn
  have hΘpos : 0 < Θ := zero_lt_one.trans hΘ
  have hcard : Fintype.card I ≤ 30 := by
    change Fintype.card (Σ c : Fin 3, Fin (2 * ((r c).val + 1))) ≤ 30
    rw [Fintype.card_sigma]
    calc
      (∑ c : Fin 3, Fintype.card (Fin (2 * ((r c).val + 1)))) ≤
          ∑ _c : Fin 3, (10 : ℕ) := by
        apply Finset.sum_le_sum
        intro c _hc
        simp only [Fintype.card_fin]
        have hc := (r c).isLt
        omega
      _ = 30 := by norm_num
  have hnz := Finsupp.mem_support_iff.mp hn
  rw [minorantHB_product_coefficient β n] at hnz
  obtain ⟨d, hd, hdz⟩ := Finset.exists_ne_zero_of_sum_ne_zero hnz
  have hprod : (∏ s : I, d s) = n := (ite_ne_right_iff.mp hdz).1
  have hslot (s : I) :
      Θ ^ (ν s.1 s.2) / Θ ≤ (d s : ℝ) ∧
        (d s : ℝ) ≤ Θ * Θ ^ (ν s.1 s.2) := by
    have h := (minorantHB_box_localization ((r s.1).val + 1)
      (Nat.succ_pos _) (A s.1) (B s.1) U Θ (t s.1)
      (hA s.1) (hAB s.1) hΘ hΘtwo (ht s.1) (htten s.1)).2.2
        (ν s.1) (Fintype.mem_piFinset.mp hν s.1) s.2 (d s)
        (Fintype.mem_piFinset.mp hd s)
    exact ⟨h.1, h.2.1⟩
  have hP : 0 ≤ P := Finset.prod_nonneg fun s _ => pow_nonneg hΘpos.le _
  have hpowers : Θ ^ Fintype.card I ≤ Θ ^ 30 := pow_le_pow_right₀ hΘ.le hcard
  have hcast : (∏ s : I, (d s : ℝ)) = (n : ℝ) := by exact_mod_cast hprod
  constructor
  · calc
      P / Θ ^ 30 ≤ P / Θ ^ Fintype.card I :=
        div_le_div_of_nonneg_left hP (pow_pos hΘpos _) hpowers
      _ = ∏ s : I, Θ ^ (ν s.1 s.2) / Θ := by
        simp only [Finset.prod_div_distrib, Finset.prod_const, Finset.card_univ, P]
      _ ≤ ∏ s : I, (d s : ℝ) :=
        Finset.prod_le_prod
          (fun s _ => div_nonneg (pow_nonneg hΘpos.le _) hΘpos.le)
          (fun s _ => (hslot s).1)
      _ = (n : ℝ) := hcast
  · calc
      (n : ℝ) = ∏ s : I, (d s : ℝ) := hcast.symm
      _ ≤ ∏ s : I, Θ * Θ ^ (ν s.1 s.2) :=
        Finset.prod_le_prod (fun s _ => Nat.cast_nonneg (d s))
          (fun s _ => (hslot s).2)
      _ = Θ ^ Fintype.card I * P := by
        simp only [Finset.prod_mul_distrib, Finset.prod_const, Finset.card_univ, P]
      _ ≤ Θ ^ 30 * P := mul_le_mul_of_nonneg_right hpowers hP
      _ = P * Θ ^ 30 := mul_comm _ _

open Classical in
theorem minorantHB_three_radial_selected_support
    (A B t : Fin 3 → ℝ) (U Θ x : ℝ)
    (hA : ∀ c, 1 ≤ A c) (hAB : ∀ c, A c ≤ B c)
    (hΘ : 1 < Θ) (hΘtwo : Θ ≤ 2)
    (ht : ∀ c, 0 ≤ t c) (htten : ∀ c, t c ≤ 10)
    (r : Fin 3 → Fin 5)
    (ν : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ)
    (hν : ν ∈ Fintype.piFinset (fun c : Fin 3 =>
      minorantHBBoxes ((r c).val + 1) (A c) (B c) Θ)) :
    let I := Σ c : Fin 3, Fin (2 * ((r c).val + 1))
    let β : I → MonoidAlgebra ℂ ℕ := fun s =>
      minorantHBLocalizedSlot ((r s.1).val + 1) U Θ (t s.1) (ν s.1) s.2
    let P : ℝ := ∏ s : I, Θ ^ (ν s.1 s.2)
    x * Θ ^ 30 ≤ P → P * Θ ^ 30 ≤ 2 * x →
      ∀ n ∈ (∏ s : I, β s).coeff.support, x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x := by
  intro I β P hlo hhi n hn
  have hpow : 0 < Θ ^ 30 := pow_pos (zero_lt_one.trans hΘ) _
  have hrad := minorantHB_three_box_radial_support A B t U Θ
    hA hAB hΘ hΘtwo ht htten r ν hν n hn
  exact ⟨((le_div_iff₀ hpow).mpr hlo).trans hrad.1, hrad.2.trans hhi⟩

section

open scoped ContDiff
open Classical in
theorem minorantHBLocalizedSlot_smooth_profiles :
    ∃ C : ℕ → ℝ, (∀ k : ℕ, 0 < C k) ∧
      ∀ Θ : ℝ, 1 < Θ → Θ ≤ 2 →
      ∀ (j : ℕ) (U t : ℝ) (ν : Fin (2 * j) → ℕ) (i : Fin (2 * j)),
        j ≤ i.val → 0 ≤ t → t ≤ 10 →
        let N : ℝ := Θ ^ ν i
        let φ : ℝ → ℝ := fun u =>
          minorantHBProfile Θ u * Real.rpow (N * u) (-t) *
            (if i.val + 1 = 2 * j then Real.log (N * u) else 1)
        1 ≤ N ∧ ContDiff ℝ ∞ φ ∧
          Function.support φ ⊆ Set.Icc (1 / 2 : ℝ) 2 ∧
          (∀ k u, ‖iteratedDeriv k φ u‖ ≤ C k * (1 + Real.log N) / (Θ - 1) ^ k) ∧
          ∀ n : ℕ,
            (minorantHBLocalizedSlot j U Θ t ν i).coeff n = (φ ((n : ℝ) / N) : ℂ) := by
  obtain ⟨C, hC, hprofiles⟩ :=
    heathBrown_geometric_profiles_uniform
  refine ⟨C, hC, ?_⟩
  intro Θ hΘ hΘtwo j U t ν i hi ht htten N φ
  have hΘpos : 0 < Θ := zero_lt_one.trans hΘ
  have hN : 1 ≤ N := one_le_pow₀ hΘ.le
  have hNpos : 0 < N := zero_lt_one.trans_le hN
  have hη := (hprofiles Θ hΘ hΘtwo).2.1
  change Function.support (minorantHBProfile Θ) = Set.Ioo Θ⁻¹ Θ at hη
  have hp := (hprofiles Θ hΘ hΘtwo).2.2.2.1
    N t (decide (i.val + 1 = 2 * j)) hN ht htten
  have hp' : ContDiff ℝ ∞ φ ∧ Function.support φ ⊆ Set.Icc (1 / 2 : ℝ) 2 ∧
      ∀ k u, ‖iteratedDeriv k φ u‖ ≤ C k * (1 + Real.log N) / (Θ - 1) ^ k := by
    simpa [φ, minorantHBProfile] using hp
  refine ⟨hN, hp'.1, hp'.2.1, hp'.2.2, ?_⟩
  intro n
  have hcancel : N * ((n : ℝ) / N) = (n : ℝ) := mul_div_cancel₀ _ hNpos.ne'
  by_cases hn : n = 0
  · subst n
    simp [minorantHBLocalizedSlot_coefficient, φ, minorantHBProfile]
  have hnpos : 0 < n := Nat.pos_of_ne_zero hn
  have hslot : minorantHBSlot j U i n =
      if i.val + 1 = 2 * j then Real.log (n : ℝ) else 1 := by
    rw [minorantHBSlot, ite_eq_right (not_lt.mpr hi)]
    split_ifs <;> simp [hn]
  rw [minorantHBLocalizedSlot_coefficient]
  by_cases hmem : n ∈ Finset.Icc 1 ⌊Θ * Θ ^ ν i⌋₊
  · rw [ite_eq_left hmem]
    change ((minorantHBProfile Θ ((n : ℝ) / N) *
      Real.rpow (n : ℝ) (-t) * minorantHBSlot j U i n : ℝ) : ℂ) = _
    simp only [φ, hcancel, hslot]
  · have hηzero : minorantHBProfile Θ ((n : ℝ) / N) = 0 := by
      by_contra hz
      have hzmem : (n : ℝ) / N ∈ Function.support (minorantHBProfile Θ) := hz
      rw [hη] at hzmem
      have hnupper : (n : ℝ) ≤ Θ * Θ ^ ν i :=
        ((div_lt_iff₀ hNpos).mp hzmem.2).le
      apply hmem
      exact Finset.mem_Icc.mpr ⟨hnpos,
        (Nat.le_floor_iff (mul_nonneg hΘpos.le (pow_nonneg hΘpos.le _))).mpr hnupper⟩
    rw [ite_eq_right hmem]
    simp only [φ, hηzero, zero_mul, Complex.ofReal_zero]

open Classical in
theorem minorantHB_three_unmasked_term_geometry
    (τ : ℝ) (hτ : 0 < τ) (hτsmall : τ ≤ 1 / 10 ^ 10) :
    let a : ℝ := 40481 / 100000
    let ζ : ℝ := 1 - 1058 / 3125 - a
    ∃ X : ℝ, 2 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ Θ : ℝ, 1 < Θ → Θ ≤ 2 →
      ∀ (r : Fin 3 → Fin 5) (t : Fin 3 → ℝ),
        (∀ c, 0 ≤ t c) → (∀ c, t c ≤ 10) →
      ∀ ν d : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ,
        ν ∈ Fintype.piFinset (fun c : Fin 3 =>
          minorantHBBoxes ((r c).val + 1) (x ^ (ζ - τ / 10)) (x ^ (a + τ / 10)) Θ) →
        (x ≤ ((∏ c, ∏ i, d c i : ℕ) : ℝ) ∧
          ((∏ c, ∏ i, d c i : ℕ) : ℝ) ≤ 3 * x) →
        (∏ c : Fin 3, ∏ i,
          (minorantHBLocalizedSlot ((r c).val + 1) (x ^ (9 / 100 : ℝ))
            Θ (t c) (ν c) i).coeff (d c i)) ≠ 0 →
        let α : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℝ :=
          fun c i => Real.logb x (Θ ^ ν c i)
        Fintype.card (Σ c : Fin 3, Fin (2 * ((r c).val + 1))) ≤ 30 ∧
          (∀ c i, 0 ≤ α c i) ∧
          (∀ c : Fin 3, ζ - τ / 5 ≤ ∑ i, α c i) ∧
          |(∑ c, ∑ i, α c i) - 1| ≤ τ / 1000 ∧
          ∀ (c : Fin 3) (i : Fin (2 * ((r c).val + 1))),
            i.val < (r c).val + 1 → α c i ≤ 1 / 10 := by
  intro a ζ
  have hlog2 : 0 ≤ Real.log 2 := Real.log_nonneg (by norm_num)
  have hlog3 : 0 ≤ Real.log 3 := Real.log_nonneg (by norm_num)
  let X : ℝ := max 2 (Real.exp (100000 * (Real.log 2 + Real.log 3) / τ))
  refine ⟨X, le_max_left _ _, ?_⟩
  intro x hx Θ hΘ hΘtwo r t ht htten ν d hν htotal hterm α
  have hxTwo : 2 ≤ x := (le_max_left _ _).trans hx
  have hxOne : 1 < x := lt_of_lt_of_le (by norm_num : (1 : ℝ) < 2) hxTwo
  have hxPos : 0 < x := zero_lt_one.trans hxOne
  have hlogx : 0 < Real.log x := Real.log_pos hxOne
  have hΘpos : 0 < Θ := zero_lt_one.trans hΘ
  have hlarge : 100000 * (Real.log 2 + Real.log 3) / τ ≤ Real.log x :=
    (Real.le_log_iff_exp_le hxPos).mpr ((le_max_right _ _).trans hx)
  have hsmall : (Real.log 2 + Real.log 3) / Real.log x ≤ τ / 100000 := by
    apply (div_le_iff₀ hlogx).mpr
    have hh := (div_le_iff₀ hτ).mp hlarge
    calc
      Real.log 2 + Real.log 3 ≤ (Real.log x * τ) / 100000 :=
        (le_div_iff₀ (by norm_num : (0 : ℝ) < 100000)).mpr
          (by simpa only [mul_comm] using hh)
      _ = τ / 100000 * Real.log x := by ring
  let e : ℝ := Real.logb x Θ
  have he : 0 ≤ e := Real.logb_nonneg hxOne hΘ.le
  have heSmall : e ≤ τ / 100000 :=
    (div_le_div_of_nonneg_right
      ((Real.log_le_log hΘpos hΘtwo).trans (le_add_of_nonneg_right hlog3)) hlogx.le).trans
      hsmall
  have hthreeSmall : Real.logb x 3 ≤ τ / 100000 :=
    (div_le_div_of_nonneg_right (le_add_of_nonneg_left hlog2) hlogx.le).trans hsmall
  have hA : 1 ≤ x ^ (ζ - τ / 10) :=
    Real.one_le_rpow hxOne.le (by dsimp [ζ, a]; linarith only [hτsmall])
  have hAB : x ^ (ζ - τ / 10) ≤ x ^ (a + τ / 10) :=
    Real.rpow_le_rpow_of_exponent_le hxOne.le (by dsimp [ζ, a]; linarith only [hτ])
  have hs (c : Fin 3) (i : Fin (2 * ((r c).val + 1))) :
      d c i ∈ (minorantHBLocalizedSlot ((r c).val + 1) (x ^ (9 / 100 : ℝ))
        Θ (t c) (ν c) i).coeff.support := by
    apply Finsupp.mem_support_iff.mpr
    exact (Finset.prod_ne_zero_iff.mp
      ((Finset.prod_ne_zero_iff.mp hterm) c (Finset.mem_univ c))) i (Finset.mem_univ i)
  have hslot (c : Fin 3) (i : Fin (2 * ((r c).val + 1))) :
      Θ ^ ν c i / Θ ≤ (d c i : ℝ) ∧ (d c i : ℝ) ≤ Θ * Θ ^ ν c i := by
    have hw := (minorantHB_box_localization ((r c).val + 1) (by omega)
      (x ^ (ζ - τ / 10)) (x ^ (a + τ / 10)) (x ^ (9 / 100 : ℝ))
      Θ (t c) hA hAB hΘ hΘtwo (ht c) (htten c)).2.2
        (ν c) (Fintype.mem_piFinset.mp hν c) i (d c i) (hs c i)
    exact ⟨hw.1, hw.2.1⟩
  have hslots (c : Fin 3) : 2 * ((r c).val + 1) ≤ 10 := by
    have hr := (r c).isLt
    omega
  have hdPos (c : Fin 3) (i : Fin (2 * ((r c).val + 1))) : 0 < (d c i : ℝ) :=
    (div_pos (pow_pos hΘpos _) hΘpos).trans_le (hslot c i).1
  have hlogSlot (c : Fin 3) (i : Fin (2 * ((r c).val + 1))) :
      α c i - e ≤ Real.logb x (d c i : ℝ) ∧
        Real.logb x (d c i : ℝ) ≤ α c i + e := by
    have hlo := Real.logb_le_logb_of_le hxOne
      (div_pos (pow_pos hΘpos _) hΘpos) (hslot c i).1
    rw [Real.logb_div (pow_ne_zero _ hΘpos.ne') hΘpos.ne'] at hlo
    have hhi := Real.logb_le_logb_of_le hxOne (hdPos c i) (hslot c i).2
    rw [Real.logb_mul hΘpos.ne' (pow_ne_zero _ hΘpos.ne')] at hhi
    exact ⟨hlo, by simpa only [add_comm] using hhi⟩
  have hlogProd : Real.logb x ((∏ c, ∏ i, d c i : ℕ) : ℝ) =
      ∑ c, ∑ i, Real.logb x (d c i : ℝ) := by
    rw [Nat.cast_prod, Real.logb_prod Finset.univ _ (fun c _ => by
      rw [Nat.cast_prod]
      exact (Finset.prod_pos (fun i _ => hdPos c i)).ne')]
    refine Finset.sum_congr rfl (fun c _ => ?_)
    rw [Nat.cast_prod]
    exact Real.logb_prod Finset.univ _ (fun i _ => (hdPos c i).ne')
  have htotalBounds :
      1 ≤ ∑ c, ∑ i, Real.logb x (d c i : ℝ) ∧
        (∑ c, ∑ i, Real.logb x (d c i : ℝ)) ≤ 1 + Real.logb x 3 := by
    have hlo := Real.logb_le_logb_of_le hxOne hxPos htotal.1
    have hhi := Real.logb_le_logb_of_le hxOne (hxPos.trans_le htotal.1) htotal.2
    rw [Real.logb_self_eq_one hxOne, hlogProd] at hlo
    rw [hlogProd, Real.logb_mul (by norm_num : (3 : ℝ) ≠ 0) hxPos.ne',
      Real.logb_self_eq_one hxOne] at hhi
    exact ⟨hlo, by simpa only [add_comm] using hhi⟩
  have herror (c : Fin 3) :
      (∑ i, α c i) - 10 * e ≤ ∑ i, Real.logb x (d c i : ℝ) ∧
        (∑ i, Real.logb x (d c i : ℝ)) ≤ (∑ i, α c i) + 10 * e := by
    have hlo := Finset.sum_le_sum (fun i (_ : i ∈ Finset.univ) => (hlogSlot c i).1)
    have hhi := Finset.sum_le_sum (fun i (_ : i ∈ Finset.univ) => (hlogSlot c i).2)
    simp only [Finset.sum_sub_distrib, Finset.sum_add_distrib, Finset.sum_const,
      Finset.card_univ, Fintype.card_fin, nsmul_eq_mul] at hlo hhi
    have hc : ((2 * ((r c).val + 1) : ℕ) : ℝ) ≤ 10 := by exact_mod_cast hslots c
    have herr := mul_le_mul_of_nonneg_right hc he
    constructor <;> linarith only [hlo, hhi, herr]
  have hall :
      (∑ c, ∑ i, α c i) - 30 * e ≤ ∑ c, ∑ i, Real.logb x (d c i : ℝ) ∧
        (∑ c, ∑ i, Real.logb x (d c i : ℝ)) ≤ (∑ c, ∑ i, α c i) + 30 * e := by
    have hlo := Finset.sum_le_sum (fun c (_ : c ∈ Finset.univ) => (herror c).1)
    have hhi := Finset.sum_le_sum (fun c (_ : c ∈ Finset.univ) => (herror c).2)
    simp only [Finset.sum_sub_distrib, Finset.sum_add_distrib, Finset.sum_const,
      Finset.card_univ, Fintype.card_fin, nsmul_eq_mul, Nat.cast_ofNat] at hlo hhi
    constructor <;> linarith only [hlo, hhi]
  refine ⟨?_, ?_, ?_, ?_, ?_⟩
  · rw [Fintype.card_sigma]
    calc
      (∑ c : Fin 3, Fintype.card (Fin (2 * ((r c).val + 1)))) ≤
          ∑ _c : Fin 3, (10 : ℕ) := by
        exact Finset.sum_le_sum (fun c _ => by
          simpa only [Fintype.card_fin] using hslots c)
      _ = 30 := by norm_num
  · exact fun c i => Real.logb_nonneg hxOne (one_le_pow₀ hΘ.le)
  · intro c
    have hνc := Fintype.mem_piFinset.mp hν c
    dsimp only [minorantHBBoxes] at hνc
    have hlo := (Finset.mem_filter.mp hνc).2.1
    have hl := Real.logb_le_logb_of_le hxOne
      (div_pos (Real.rpow_pos_of_pos hxPos _) (pow_pos hΘpos _)) hlo
    rw [Real.logb_div (Real.rpow_pos_of_pos hxPos _).ne' (pow_pos hΘpos _).ne',
      Real.logb_rpow hxPos hxOne.ne', Real.logb_pow,
      Real.logb_prod Finset.univ _ (fun i _ => pow_ne_zero _ hΘpos.ne')] at hl
    change ζ - τ / 10 - ((2 * ((r c).val + 1) : ℕ) : ℝ) * e ≤ ∑ i, α c i at hl
    have hc : ((2 * ((r c).val + 1) : ℕ) : ℝ) ≤ 10 := by exact_mod_cast hslots c
    have herr := mul_le_mul_of_nonneg_right hc he
    linarith only [hl, herr, heSmall, hτ]
  · apply abs_le.mpr
    constructor <;> linarith only [hall.1, hall.2, htotalBounds.1,
      htotalBounds.2, heSmall, hthreeSmall, hτ]
  · intro c i hi
    have hm := (minorantHBLocalizedSlot_moebius_support ((r c).val + 1)
      (x ^ (9 / 100 : ℝ)) Θ (t c) (ν c) i hi (d c i) (hs c i)).2
    have hdHi : Real.logb x (d c i : ℝ) ≤ 9 / 100 :=
      (Real.logb_le_iff_le_rpow hxOne (hdPos c i)).mpr hm
    have hsl := (hlogSlot c i).1
    linarith only [hdHi, hsl, heSmall, hτsmall]

open Classical in
theorem minorantHB_three_unmasked_term_cases
    (τ : ℝ) (hτ : 0 < τ) (hτsmall : τ ≤ 1 / 10 ^ 10) :
    let a : ℝ := 40481 / 100000
    let ζ : ℝ := 1 - 1058 / 3125 - a
    ∃ X : ℝ, 2 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ Θ : ℝ, 1 < Θ → Θ ≤ 2 →
      ∀ (r : Fin 3 → Fin 5) (t : Fin 3 → ℝ),
        (∀ c, 0 ≤ t c) → (∀ c, t c ≤ 10) →
      ∀ ν d : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ,
        ν ∈ Fintype.piFinset (fun c : Fin 3 =>
          minorantHBBoxes ((r c).val + 1) (x ^ (ζ - τ / 10)) (x ^ (a + τ / 10)) Θ) →
        (x ≤ ((∏ c, ∏ i, d c i : ℕ) : ℝ) ∧ ((∏ c, ∏ i, d c i : ℕ) : ℝ) ≤ 3 * x) →
        (∏ c : Fin 3, ∏ i,
          (minorantHBLocalizedSlot ((r c).val + 1) (x ^ (9 / 100 : ℝ))
            Θ (t c) (ν c) i).coeff (d c i)) ≠ 0 →
        let α : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℝ :=
          fun c i => Real.logb x (Θ ^ ν c i)
        let I := Σ c : Fin 3, Fin (2 * ((r c).val + 1))
        Fintype.card I ≤ 30 ∧
          ((∃ s : I,
            (r s.1).val + 1 ≤ s.2.val ∧ 1058 / 3125 - τ ≤ α s.1 s.2) ∨
          (∃ S : Finset I,
            a - τ ≤ ∑ s ∈ S, α s.1 s.2 ∧
              (∑ s ∈ S, α s.1 s.2) ≤ 59519 / 100000 + τ) ∨
          (∃ s t u : I,
            s ≠ t ∧ s ≠ u ∧ t ≠ u ∧
            (r s.1).val + 1 ≤ s.2.val ∧ (r t.1).val + 1 ≤ t.2.val ∧
            (r u.1).val + 1 ≤ u.2.val ∧
            (19 / 100 - τ ≤ α s.1 s.2 ∧ α s.1 s.2 ≤ 81 / 200 + τ) ∧
            (19 / 100 - τ ≤ α t.1 t.2 ∧ α t.1 t.2 ≤ 81 / 200 + τ) ∧
            (19 / 100 - τ ≤ α u.1 u.2 ∧ α u.1 u.2 ≤ 81 / 200 + τ) ∧
            119 / 200 - τ ≤ α s.1 s.2 + α t.1 t.2 ∧
            119 / 200 - τ ≤ α s.1 s.2 + α u.1 u.2 ∧
            119 / 200 - τ ≤ α t.1 t.2 + α u.1 u.2)) := by
  intro a ζ
  obtain ⟨X, hX, hgeometry⟩ := minorantHB_three_unmasked_term_geometry τ hτ hτsmall
  refine ⟨X, hX, ?_⟩
  intro x hx Θ hΘ hΘtwo r t ht htten ν d hν htotal hterm α I
  have hg := hgeometry x hx Θ hΘ hΘtwo r t ht htten ν d hν htotal hterm
  refine ⟨hg.1, ?_⟩
  exact minorant_three_prime_colored_slot_trichotomy τ hτ hτsmall r α hg.2.1 hg.2.2.1
    hg.2.2.2.1 hg.2.2.2.2

open Classical in
theorem minorantHB_three_box_count (A B Θ : ℝ) :
    (∑ r : Fin 3 → Fin 5,
      (Fintype.piFinset (fun c : Fin 3 =>
        minorantHBBoxes ((r c).val + 1) A B Θ)).card) ≤
      125 * (⌈Real.log B / Real.log Θ⌉₊ + 1) ^ 30 := by
  let M : ℕ := ⌈Real.log B / Real.log Θ⌉₊ + 1
  have hM : 1 ≤ M := by dsimp [M]; omega
  have hj (j : ℕ) : (minorantHBBoxes j A B Θ).card ≤ M ^ (2 * j) := by
    calc
      _ ≤ (Fintype.piFinset (fun _ : Fin (2 * j) => Finset.range M)).card :=
        Finset.card_filter_le _ _
      _ = M ^ (2 * j) := by simp only [Fintype.card_piFinset, Finset.card_range,
        Finset.prod_const, Finset.card_univ, Fintype.card_fin]
  have hr (r : Fin 3 → Fin 5) :
      (Fintype.piFinset (fun c : Fin 3 => minorantHBBoxes ((r c).val + 1) A B Θ)).card ≤
        M ^ 30 := by
    rw [Fintype.card_piFinset]
    calc
      _ ≤ ∏ _c : Fin 3, M ^ 10 := by
        apply Finset.prod_le_prod'
        intro c _
        exact (hj ((r c).val + 1)).trans
          (pow_le_pow_right₀ hM (by have := (r c).isLt; omega))
      _ = M ^ 30 := by simp only [Finset.prod_const, Finset.card_univ,
        Fintype.card_fin, ← pow_mul]
  calc
    _ ≤ ∑ _r : Fin 3 → Fin 5, M ^ 30 := Finset.sum_le_sum (fun r _ => hr r)
    _ = 125 * M ^ 30 := by simp only [Finset.sum_const, Finset.card_univ,
      Fintype.card_fun, Fintype.card_fin, nsmul_eq_mul]; norm_num

open Classical in
theorem minorantHB_three_unmasked_coefficient_cases
    (τ : ℝ) (hτ : 0 < τ) (hτsmall : τ ≤ 1 / 10 ^ 10) :
    let a : ℝ := 40481 / 100000
    let ζ : ℝ := 1 - 1058 / 3125 - a
    ∃ X : ℝ, 2 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ Θ : ℝ, 1 < Θ → Θ ≤ 2 →
      ∀ (r : Fin 3 → Fin 5) (t : Fin 3 → ℝ),
        (∀ c, 0 ≤ t c) → (∀ c, t c ≤ 10) →
      ∀ ν : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ,
        ν ∈ Fintype.piFinset (fun c : Fin 3 =>
          minorantHBBoxes ((r c).val + 1) (x ^ (ζ - τ / 10)) (x ^ (a + τ / 10)) Θ) →
      ∀ n : ℕ, x ≤ (n : ℝ) → (n : ℝ) ≤ 3 * x →
        (∏ s : Σ c : Fin 3, Fin (2 * ((r c).val + 1)),
          minorantHBLocalizedSlot ((r s.1).val + 1) (x ^ (9 / 100 : ℝ))
            Θ (t s.1) (ν s.1) s.2).coeff n ≠ 0 →
        let α : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℝ :=
          fun c i => Real.logb x (Θ ^ ν c i)
        let I := Σ c : Fin 3, Fin (2 * ((r c).val + 1))
        Fintype.card I ≤ 30 ∧
          ((∃ s : I,
            (r s.1).val + 1 ≤ s.2.val ∧ 1058 / 3125 - τ ≤ α s.1 s.2) ∨
          (∃ S : Finset I,
            a - τ ≤ ∑ s ∈ S, α s.1 s.2 ∧
              (∑ s ∈ S, α s.1 s.2) ≤ 59519 / 100000 + τ) ∨
          (∃ s t u : I,
            s ≠ t ∧ s ≠ u ∧ t ≠ u ∧
            (r s.1).val + 1 ≤ s.2.val ∧ (r t.1).val + 1 ≤ t.2.val ∧
            (r u.1).val + 1 ≤ u.2.val ∧
            (19 / 100 - τ ≤ α s.1 s.2 ∧ α s.1 s.2 ≤ 81 / 200 + τ) ∧
            (19 / 100 - τ ≤ α t.1 t.2 ∧ α t.1 t.2 ≤ 81 / 200 + τ) ∧
            (19 / 100 - τ ≤ α u.1 u.2 ∧ α u.1 u.2 ≤ 81 / 200 + τ) ∧
            119 / 200 - τ ≤ α s.1 s.2 + α t.1 t.2 ∧
            119 / 200 - τ ≤ α s.1 s.2 + α u.1 u.2 ∧
            119 / 200 - τ ≤ α t.1 t.2 + α u.1 u.2)) := by
  intro a ζ
  obtain ⟨X, hX, hcases⟩ := minorantHB_three_unmasked_term_cases τ hτ hτsmall
  refine ⟨X, hX, ?_⟩
  intro x hx Θ hΘ hΘtwo r t ht htten ν hν n hnlo hnhi hcoef α I
  let β : I → MonoidAlgebra ℂ ℕ := fun s =>
    minorantHBLocalizedSlot ((r s.1).val + 1) (x ^ (9 / 100 : ℝ))
      Θ (t s.1) (ν s.1) s.2
  change (∏ s : I, β s).coeff n ≠ 0 at hcoef
  rw [minorantHB_product_coefficient] at hcoef
  obtain ⟨d, _, hterm⟩ := Finset.exists_ne_zero_of_sum_ne_zero hcoef
  have hprod : (∏ s : I, d s) = n := by
    by_contra hbad
    exact hterm (ite_eq_right hbad)
  have hnonzero : (∏ s : I, (β s).coeff (d s)) ≠ 0 := by
    simpa only [ite_eq_left hprod] using hterm
  have hprod' : (∏ c : Fin 3, ∏ i, d ⟨c, i⟩) = n :=
    (Fintype.prod_sigma d).symm.trans hprod
  have hnonzero' : (∏ c : Fin 3, ∏ i,
      (minorantHBLocalizedSlot ((r c).val + 1) (x ^ (9 / 100 : ℝ))
        Θ (t c) (ν c) i).coeff (d ⟨c, i⟩)) ≠ 0 :=
    (congrArg (fun z : ℂ => z ≠ 0)
      (Fintype.prod_sigma (fun s : I => (β s).coeff (d s)))).mp hnonzero
  exact hcases x hx Θ hΘ hΘtwo r t ht htten ν (fun c i => d ⟨c, i⟩) hν
    (by simpa only [hprod'] using And.intro hnlo hnhi) hnonzero'

open Classical in
theorem sourceT3_localized_slot_support_norm
    (j : ℕ) (U Θ t : ℝ) (ν : Fin (2 * j) → ℕ) (i : Fin (2 * j))
    (hΘ : 1 < Θ) (hΘtwo : Θ ≤ 2) (ht : 0 ≤ t) :
    let N : ℝ := Θ ^ ν i
    (∀ n ∈ (minorantHBLocalizedSlot j U Θ t ν i).coeff.support,
      N / 2 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * N) ∧
      ∀ n : ℕ, ‖(minorantHBLocalizedSlot j U Θ t ν i).coeff n‖ ≤
        1 + Real.log (n : ℝ) := by
  intro N
  have hΘpos : 0 < Θ := zero_lt_one.trans hΘ
  have hNpos : 0 < N := pow_pos hΘpos _
  obtain ⟨_, _, hprofiles⟩ :=
    heathBrown_geometric_profiles_uniform
  have hηsupport := (hprofiles Θ hΘ hΘtwo).2.1
  have hηrange := (hprofiles Θ hΘ hΘtwo).2.2.1
  change Function.support (minorantHBProfile Θ) = Set.Ioo Θ⁻¹ Θ at hηsupport
  change ∀ u : ℝ, 0 ≤ minorantHBProfile Θ u ∧ minorantHBProfile Θ u ≤ 1 at hηrange
  have hmem (n : ℕ)
      (hn : n ∈ (minorantHBLocalizedSlot j U Θ t ν i).coeff.support) :
      n ∈ Finset.Icc 1 ⌊Θ * N⌋₊ := by
    have hnz := Finsupp.mem_support_iff.mp hn
    rw [minorantHBLocalizedSlot_coefficient] at hnz
    by_contra hout
    exact hnz (ite_eq_right hout)
  have hslot (n : ℕ) (hn : n ∈ Finset.Icc 1 ⌊Θ * N⌋₊) :
      |minorantHBSlot j U i n| ≤ 1 + Real.log (n : ℝ) := by
    have hn0 : n ≠ 0 := Nat.ne_zero_of_lt (Finset.mem_Icc.mp hn).1
    have hlog := Real.log_natCast_nonneg n
    dsimp only [minorantHBSlot]
    split_ifs
    · have hμ :
          |arithmeticFunctionLowCutoff U
            (ArithmeticFunction.moebius : ArithmeticFunction ℝ) n| ≤ 1 := by
        change |if (n : ℝ) ≤ U then (ArithmeticFunction.moebius n : ℝ) else 0| ≤ 1
        rw [abs_ite, abs_zero]
        exact ite_le_one (mod_cast ArithmeticFunction.abs_moebius_le_one) zero_le_one
      exact hμ.trans (le_add_of_nonneg_right hlog)
    · change |Real.log (n : ℝ)| ≤ 1 + Real.log (n : ℝ)
      rw [abs_of_nonneg hlog]
      linarith
    · simpa only [ArithmeticFunction.natCoe_apply, ArithmeticFunction.zeta_apply_ne hn0,
        Nat.cast_one, abs_one] using le_add_of_nonneg_right hlog
  refine ⟨?_, ?_⟩
  · intro n hn
    have hnz := Finsupp.mem_support_iff.mp hn
    rw [minorantHBLocalizedSlot_coefficient, ite_eq_left (hmem n hn)] at hnz
    have hηne : minorantHBProfile Θ ((n : ℝ) / N) ≠ 0 :=
      left_ne_zero_of_mul (left_ne_zero_of_mul (Complex.ofReal_ne_zero.mp hnz))
    have hu := hηsupport.subset hηne
    have hhalf : (1 / 2 : ℝ) ≤ Θ⁻¹ := by
      simpa only [one_div] using inv_anti₀ hΘpos hΘtwo
    refine ⟨?_, ?_⟩
    · have hh := (le_div_iff₀ hNpos).mp (hhalf.trans hu.1.le)
      simpa only [div_eq_mul_inv, one_mul, mul_comm] using hh
    · exact (div_le_iff₀ hNpos).mp (hu.2.le.trans hΘtwo)
  · intro n
    rw [minorantHBLocalizedSlot_coefficient]
    by_cases hn : n ∈ Finset.Icc 1 ⌊Θ * N⌋₊
    · rw [ite_eq_left hn, Complex.norm_real, Real.norm_eq_abs, abs_mul, abs_mul,
        abs_of_nonneg (hηrange _).1]
      have htwistNonneg : 0 ≤ Real.rpow (n : ℝ) (-t) :=
        Real.rpow_nonneg (Nat.cast_nonneg n) (-t)
      rw [abs_of_nonneg htwistNonneg]
      have hn1 : (1 : ℝ) ≤ n := Nat.one_le_cast.mpr (Finset.mem_Icc.mp hn).1
      have htwist : (n : ℝ) ^ (-t) ≤ 1 :=
        Real.rpow_le_one_of_one_le_of_nonpos hn1 (neg_nonpos.mpr ht)
      have hweight : minorantHBProfile Θ ((n : ℝ) / N) * (n : ℝ) ^ (-t) ≤ 1 := by
        calc
          _ ≤ 1 * 1 := mul_le_mul (hηrange _).2 htwist
            (Real.rpow_nonneg (Nat.cast_nonneg n) _) zero_le_one
          _ = 1 := one_mul 1
      exact (mul_le_mul_of_nonneg_right hweight (abs_nonneg _)).trans
        (by simpa only [one_mul] using hslot n hn)
    · rw [ite_eq_right hn, norm_zero]
      exact add_nonneg zero_le_one (Real.log_natCast_nonneg n)

open Classical in
theorem sourceT3_smooth_slot_profiles :
    ∃ Cder : ℕ → ℝ, (∀ k, 0 < Cder k) ∧
      ∀ Θ : ℝ, 1 < Θ → Θ ≤ 2 →
      ∀ (j : ℕ) (U t : ℝ) (ν : Fin (2 * j) → ℕ) (i : Fin (2 * j)),
        j ≤ i.val → 0 ≤ t → t ≤ 10 →
      ∀ C : ℝ, 2 ≤ C →
        let N : ℝ := Θ ^ ν i
        ∃ ψ : ℝ → ℂ,
          ContDiff ℝ ∞ ψ ∧
          Function.support ψ ⊆ Set.Icc (1 / C) C ∧
          (minorantHBLocalizedSlot j U Θ t ν i).coeff =
            positiveCompactProfileSequence ψ C N 0 ∧
          ∀ k u, ‖iteratedDeriv k ψ u‖ ≤
            Cder k * (1 + Real.log N) / (Θ - 1) ^ k := by
  obtain ⟨Cder, hCder, hprofiles⟩ := minorantHBLocalizedSlot_smooth_profiles
  refine ⟨Cder, hCder, ?_⟩
  intro Θ hΘ hΘtwo j U t ν i hi ht htten C hC N
  let φ : ℝ → ℝ := fun u =>
    minorantHBProfile Θ u * Real.rpow (N * u) (-t) *
      (if i.val + 1 = 2 * j then Real.log (N * u) else 1)
  have hp := hprofiles Θ hΘ hΘtwo j U t ν i hi ht htten
  change 1 ≤ N ∧ ContDiff ℝ ∞ φ ∧
    Function.support φ ⊆ Set.Icc (1 / 2 : ℝ) 2 ∧
    (∀ k u, ‖iteratedDeriv k φ u‖ ≤
      Cder k * (1 + Real.log N) / (Θ - 1) ^ k) ∧
    ∀ n : ℕ, (minorantHBLocalizedSlot j U Θ t ν i).coeff n =
      (φ ((n : ℝ) / N) : ℂ) at hp
  obtain ⟨hN, hφ, hφsupport, hφbound, hcoeff⟩ := hp
  have hNpos : 0 < N := zero_lt_one.trans_le hN
  have hCpos : 0 < C := zero_lt_two.trans_le hC
  let ψ : ℝ → ℂ := fun u => (φ u : ℂ)
  have hsupport : Function.support ψ ⊆ Set.Icc (1 / C) C := by
    intro u hu
    have hφu : u ∈ Function.support φ := Complex.ofReal_ne_zero.mp hu
    obtain ⟨hul, huur⟩ := hφsupport hφu
    exact ⟨(one_div_le_one_div_of_le zero_lt_two hC).trans hul, huur.trans hC⟩
  refine ⟨ψ, Complex.ofRealCLM.contDiff.comp hφ, hsupport, ?_, ?_⟩
  · ext n
    rw [hcoeff]
    change ψ ((n : ℝ) / N) = _
    simp only [positiveCompactProfileSequence, zero_add, sub_zero,
      Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_ite_eq']
    by_cases hn : n ∈ Finset.Icc 1 ⌊C * N⌋₊
    · exact (ite_eq_left hn).symm
    · rw [ite_eq_right hn]
      by_contra hψ
      have hs := hsupport hψ
      have hnr : 0 < (n : ℝ) :=
        (mul_pos (one_div_pos.mpr hCpos) hNpos).trans_le
          ((le_div_iff₀ hNpos).mp hs.1)
      have hnupper : (n : ℝ) ≤ C * N := (div_le_iff₀ hNpos).mp hs.2
      exact hn (Finset.mem_Icc.mpr ⟨Nat.cast_pos.mp hnr, Nat.le_floor hnupper⟩)
  · intro k u
    have hnorm : ‖iteratedDeriv k ψ u‖ = ‖iteratedDeriv k φ u‖ := by
      have hψ : ψ = Complex.ofRealLI ∘ φ := rfl
      rw [hψ]
      simpa only [norm_iteratedFDeriv_eq_norm_iteratedDeriv] using
        (Complex.ofRealLI.norm_iteratedFDeriv_comp_left
          (hφ.contDiffAt (x := u)) (i := k) (by simp))
    exact hnorm.le.trans (hφbound k u)

open Classical in
theorem sourceT3_one_smooth_slot_log_saving
    (density : ℕ) (hdensity : 1 ≤ density)
    (orders : Fin 3 → Fin 5) (D : ℕ) (hD : 1 ≤ D)
    («ω» δ γ₀ C0 : ℝ) (hω : 0 < «ω») (hδ : 0 < δ)
    (hγ₀ : 0 < γ₀) (hγ₀hi : γ₀ ≤ 1 / 2) (hC0 : 1 ≤ C0)
    (hgap : 1 / 4 + 7 * «ω» + 2 * δ < γ₀) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
        let Θ : ℝ := 1 + (Real.log x) ^ (-(D : ℝ))
        ∀ t : Fin 3 → ℝ, (∀ c, 0 ≤ t c) → (∀ c, t c ≤ 10) →
        ∀ ν : (c : Fin 3) → Fin (2 * ((orders c).val + 1)) → ℕ,
          let ιr := Σ c : Fin 3, Fin (2 * ((orders c).val + 1))
          let Ni : ιr → ℝ := fun s => Θ ^ ν s.1 s.2
          let β : ιr → MonoidAlgebra ℂ ℕ := fun s =>
            minorantHBLocalizedSlot ((orders s.1).val + 1) (x ^ (9 / 100 : ℝ))
              Θ (t s.1) (ν s.1) s.2
          x / C0 ≤ (∏ s, Ni s) → (∏ s, Ni s) ≤ C0 * x →
          ∀ s : ιr, (orders s.1).val + 1 ≤ s.2.val →
            x ^ γ₀ ≤ Ni s → Ni s ≤ C0 * Real.sqrt x →
          ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
          ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
            (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
                q ∣ (∏ p ∈ I, p) ∧
                  Nonempty (DenseDivisibilityWitness
                    ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩ density q)),
              ‖fullDiscrepancy (∏ s, β s).coeff q a‖) ≤
                K * x / (Real.log x) ^ A := by
  let ιr := Σ c : Fin 3, Fin (2 * ((orders c).val + 1))
  let Params : Type := (Fin 3 → ℝ) × ((c : Fin 3) → Fin (2 * ((orders c).val + 1)) → ℕ)
  let tclip : Params → Fin 3 → ℝ := fun v c => max 0 (min (v.1 c) 10)
  have htclip (v : Params) (c : Fin 3) : 0 ≤ tclip v c ∧ tclip v c ≤ 10 :=
    ⟨le_max_left _ _, max_le (by norm_num) (min_le_right _ _)⟩
  have hcard30 : Fintype.card ιr ≤ 30 := by
    rw [Fintype.card_sigma]
    calc
      (∑ c : Fin 3, Fintype.card (Fin (2 * ((orders c).val + 1)))) ≤
          ∑ _c : Fin 3, (10 : ℕ) :=
        Finset.sum_le_sum fun c _ => by
          simp only [Fintype.card_fin]
          have hc := (orders c).isLt
          omega
      _ = 30 := by norm_num
  have hcard6 : 6 ≤ Fintype.card ιr := by
    rw [Fintype.card_sigma]
    calc
      6 = ∑ _c : Fin 3, (2 : ℕ) := by norm_num
      _ ≤ ∑ c : Fin 3, Fintype.card (Fin (2 * ((orders c).val + 1))) :=
        Finset.sum_le_sum fun c _ => by simp only [Fintype.card_fin]; omega
  have hC0pos : 0 < C0 := zero_lt_one.trans_le hC0
  let X0 : ℝ := max (Real.exp 1) C0
  have hX0 : Real.exp 1 ≤ X0 := le_max_left _ _
  have hC0X0 : C0 ≤ X0 := le_max_right _ _
  have hxpos (x : ℝ) (hx : X0 ≤ x) : 0 < x :=
    (Real.exp_pos 1).trans_le (hX0.trans hx)
  have hxone (x : ℝ) (hx : X0 ≤ x) : 1 ≤ x :=
    (Real.one_le_exp zero_le_one).trans (hX0.trans hx)
  have hlog (x : ℝ) (hx : X0 ≤ x) : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using
      Real.log_le_log (Real.exp_pos 1) (hX0.trans hx)
  let Θ : ℝ → ℝ := fun x => 1 + (Real.log x) ^ (-(D : ℝ))
  let U : ℝ → ℝ := fun x => x ^ (9 / 100 : ℝ)
  let scale : ℝ → Params → ιr → ℝ := fun x v s => Θ x ^ v.2 s.1 s.2
  let slot : ℝ → Params → ιr → MonoidAlgebra ℂ ℕ := fun x v s =>
    minorantHBLocalizedSlot ((orders s.1).val + 1) (U x)
      (Θ x) (tclip v s.1) (v.2 s.1) s.2
  let P : ℝ → Params → ℝ := fun x v => ∏ s, scale x v s
  let Q : ℝ → Params → Finset ιr → ℝ := fun x v G => ∏ s ∈ G, scale x v s
  let coeff : ℝ → Params → Finset ιr → ℕ →₀ ℂ :=
    fun x v G => (∏ s ∈ G, slot x v s).coeff
  have hΘ (x : ℝ) (hx : X0 ≤ x) : 1 < Θ x ∧ Θ x ≤ 2 := by
    have hℓpos : 0 < Real.log x := zero_lt_one.trans_le (hlog x hx)
    have hD0 : 0 ≤ (D : ℝ) := by exact_mod_cast (Nat.zero_le 1).trans hD
    have hsmall : (Real.log x) ^ (-(D : ℝ)) ≤ 1 :=
      Real.rpow_le_one_of_one_le_of_nonpos (hlog x hx) (neg_nonpos.mpr hD0)
    dsimp only [Θ]
    exact ⟨lt_add_of_pos_right 1 (Real.rpow_pos_of_pos hℓpos _), by linarith⟩
  have hscaleone (x : ℝ) (hx : X0 ≤ x) (v : Params) (s : ιr) :
      1 ≤ scale x v s := one_le_pow₀ (hΘ x hx).1.le
  have hQone (x : ℝ) (hx : X0 ≤ x) (v : Params) (G : Finset ιr) :
      1 ≤ Q x v G := Finset.one_le_prod fun s _ => hscaleone x hx v s
  have hcard40 (G : Finset ιr) : G.card ≤ 40 :=
    (Finset.card_le_univ G).trans (hcard30.trans (by norm_num))
  let B2 : ℝ := (2 : ℝ) ^ 40
  let Cf : ℝ := B2 * C0 ^ 2
  let c : ℝ := 1 / Cf
  let W : ℝ := (4 : ℝ) ^ 40
  have hB2pos : 0 < B2 := by positivity
  have hB2one : 1 ≤ B2 := one_le_pow₀ (by norm_num : (1 : ℝ) ≤ 2)
  have hC0sq : C0 ≤ C0 ^ 2 := le_self_pow₀ hC0 (by decide)
  have hB2Cf : B2 ≤ Cf :=
    le_mul_of_one_le_right hB2pos.le (hC0.trans hC0sq)
  have hC0Cf : C0 ≤ Cf :=
    hC0sq.trans (le_mul_of_one_le_left (sq_nonneg C0) hB2one)
  have hCf : 1 ≤ Cf := hC0.trans hC0Cf
  have hCftwo : 2 ≤ Cf := (by norm_num : (2 : ℝ) ≤ 2 ^ 40).trans hB2Cf
  have hCfpos : 0 < Cf := zero_lt_one.trans_le hCf
  have hc : 0 < c := div_pos zero_lt_one hCfpos
  have hcCf : c ≤ Cf := ((div_le_one hCfpos).2 hCf).trans hCf
  have hW : 0 ≤ W := by positivity
  have hbox (x : ℝ) (hx : X0 ≤ x) (ν : Params)
      (hPupper : P x ν ≤ C0 * x) (G : Finset (ιr)) (hG : G.Nonempty) :
      (∀ n ∈ (coeff x ν G).support,
        Q x ν G / (2 : ℝ) ^ G.card ≤ (n : ℝ) ∧
          (n : ℝ) ≤ (2 : ℝ) ^ G.card * Q x ν G) ∧
      ∀ n : ℕ, ‖coeff x ν G n‖ ≤
        W * (n.divisors.card : ℝ) ^ 40 * (Real.log x) ^ 40 := by
    have hslotData (s : ιr) :
        (∀ n ∈ (slot x ν s).coeff.support,
          scale x ν s / 2 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * scale x ν s) ∧
        ∀ n : ℕ, ‖(slot x ν s).coeff n‖ ≤ 1 + Real.log (n : ℝ) :=
      sourceT3_localized_slot_support_norm ((orders s.1).val + 1) (U x)
        (Θ x) (tclip ν s.1) (ν.2 s.1) s.2 (hΘ x hx).1 (hΘ x hx).2 (htclip ν s.1).1
    have hslotNorm (s : ιr) (n : ℕ) : ‖(slot x ν s).coeff n‖ ≤ 4 * Real.log x := by
      by_cases hn : n ∈ (slot x ν s).coeff.support
      · have hNi : scale x ν s ≤ x ^ (2 : ℕ) := by
          calc
            scale x ν s ≤ ∏ u, scale x ν u :=
              Multiset.mem_le_prod_of_one_le (s := Finset.univ.val)
                (hscaleone x hx ν) (Finset.mem_univ s)
            _ ≤ C0 * x := hPupper
            _ ≤ x * x := mul_le_mul_of_nonneg_right (hC0X0.trans hx) (hxpos x hx).le
            _ = x ^ 2 := (pow_two x).symm
        have hns := (hslotData s).1 n hn
        have hnpos : 0 < (n : ℝ) :=
          (div_pos (zero_lt_one.trans_le (hscaleone x hx ν s)) zero_lt_two).trans_le hns.1
        have hnup : (n : ℝ) ≤ 2 * x ^ (2 : ℕ) :=
          hns.2.trans (mul_le_mul_of_nonneg_left hNi zero_le_two)
        have hln := Real.log_le_log hnpos hnup
        rw [Real.log_mul two_ne_zero (pow_ne_zero 2 (hxpos x hx).ne'), Real.log_pow] at hln
        norm_num only [Nat.cast_ofNat] at hln
        have hlog2 := Real.log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2)
        exact ((hslotData s).2 n).trans (by linarith [hlog x hx])
      · rw [Finsupp.notMem_support_iff.mp hn, norm_zero]
        exact mul_nonneg (by norm_num : (0 : ℝ) ≤ 4) (zero_le_one.trans (hlog x hx))
    have hℓ : 1 ≤ Real.log x := hlog x hx
    have hbase : 1 ≤ 4 * Real.log x := by linarith
    have hraw := heathBrown_box_product_support_norm_bound G hG
      (slot x ν) (scale x ν) (4 * Real.log x) (zero_le_one.trans hbase)
      (fun i _hi => hscaleone x hx ν i)
      (fun i _hi => (hslotData i).1) (fun i _hi => hslotNorm i)
    change (∀ n ∈ (coeff x ν G).support,
      Q x ν G / (2 : ℝ) ^ G.card ≤ (n : ℝ) ∧
        (n : ℝ) ≤ (2 : ℝ) ^ G.card * Q x ν G) ∧
      (∀ n : ℕ, ‖coeff x ν G n‖ ≤
        (4 * Real.log x) ^ G.card * (n.divisors.card : ℝ) ^ (G.card - 1)) at hraw
    have hzero : coeff x ν G 0 = 0 := by
      apply Finsupp.notMem_support_iff.mp
      intro hn
      have hh := (hraw.1 0 hn).1
      have hpos : 0 < Q x ν G / (2 : ℝ) ^ G.card :=
        div_pos (zero_lt_one.trans_le (hQone x hx ν G)) (pow_pos zero_lt_two _)
      exact hpos.not_ge (by simpa only [Nat.cast_zero] using hh)
    refine ⟨hraw.1, ?_⟩
    intro n
    by_cases hn : n = 0
    · subst n
      simp [hzero]
    · have hdv : 1 ≤ (n.divisors.card : ℝ) := by
        exact_mod_cast Finset.one_le_card.mpr (Nat.nonempty_divisors.mpr hn)
      calc
        ‖coeff x ν G n‖ ≤ (4 * Real.log x) ^ G.card *
            (n.divisors.card : ℝ) ^ (G.card - 1) := hraw.2 n
        _ ≤ (4 * Real.log x) ^ 40 * (n.divisors.card : ℝ) ^ 40 :=
          mul_le_mul (pow_le_pow_right₀ hbase (hcard40 G))
            (pow_le_pow_right₀ hdv ((Nat.sub_le _ _).trans (hcard40 G)))
            (pow_nonneg (Nat.cast_nonneg _) _) (pow_nonneg (zero_le_one.trans hbase) _)
        _ = W * (n.divisors.card : ℝ) ^ 40 * (Real.log x) ^ 40 := by
          dsimp only [W]
          rw [mul_pow]
          ring
  let Index : Type := Params × ιr
  let G : ιr → Finset ιr := fun s => Finset.univ.erase s
  have hG (s : ιr) : (G s).Nonempty := by
    apply Finset.card_pos.mp
    dsimp only [G]
    rw [Finset.card_erase_of_mem (Finset.mem_univ s), Finset.card_univ]
    omega
  let Active : ℝ → Index → Prop := fun x z =>
    X0 ≤ x ∧ x / C0 ≤ P x z.1 ∧ P x z.1 ≤ C0 * x ∧
      (orders z.2.1).val + 1 ≤ z.2.2.val ∧
      x ^ γ₀ ≤ scale x z.1 z.2 ∧ scale x z.1 z.2 ≤ C0 * Real.sqrt x
  let MFamily : ℝ → Index → ℝ := fun x z =>
    if Active x z then Q x z.1 (G z.2) else Real.sqrt x
  let NFamily : ℝ → Index → ℝ := fun x z =>
    if Active x z then scale x z.1 z.2 else Real.sqrt x
  let αFamily : ℝ → Index → ℕ →₀ ℂ := fun x z =>
    if Active x z then coeff x z.1 (G z.2) else 0
  obtain ⟨Cder, hCder, hprofiles⟩ := sourceT3_smooth_slot_profiles
  have hprofile (x : ℝ) (z : Index) (hz : Active x z) :
      ∃ ψ : ℝ → ℂ, ContDiff ℝ ∞ ψ ∧
        Function.support ψ ⊆ Set.Icc c Cf ∧
        (slot x z.1 z.2).coeff =
          positiveCompactProfileSequence ψ Cf (scale x z.1 z.2) 0 ∧
        ∀ k u, ‖iteratedDeriv k ψ u‖ ≤
          Cder k * (1 + Real.log (scale x z.1 z.2)) / (Θ x - 1) ^ k :=
    hprofiles (Θ x) (hΘ x hz.1).1 (hΘ x hz.1).2
      ((orders z.2.1).val + 1) (U x) (tclip z.1 z.2.1) (z.1.2 z.2.1) z.2.2
      hz.2.2.2.1 (htclip z.1 z.2.1).1 (htclip z.1 z.2.1).2 Cf hCftwo
  let ψFamily : ℝ → Index → ℝ → ℂ := fun x z =>
    if hz : Active x z then Classical.choose (hprofile x z hz) else 0
  have hψdata (x : ℝ) (z : Index) (hz : Active x z) :
      ContDiff ℝ ∞ (ψFamily x z) ∧
        Function.support (ψFamily x z) ⊆ Set.Icc c Cf ∧
        (slot x z.1 z.2).coeff =
          positiveCompactProfileSequence (ψFamily x z) Cf (scale x z.1 z.2) 0 ∧
        ∀ k u, ‖iteratedDeriv k (ψFamily x z) u‖ ≤
          Cder k * (1 + Real.log (scale x z.1 z.2)) / (Θ x - 1) ^ k := by
    simpa only [ψFamily, dite_eq_left hz] using Classical.choose_spec (hprofile x z hz)
  have hscaleFamily (x : ℝ) (hx : X0 ≤ x) (z : Index) :
      x / Cf ≤ MFamily x z * NFamily x z ∧
      MFamily x z * NFamily x z ≤ Cf * x ∧
      x ^ γ₀ ≤ NFamily x z ∧ NFamily x z ≤ Real.sqrt x * C0 := by
    by_cases hz : Active x z
    · have hprod : Q x z.1 (G z.2) * scale x z.1 z.2 = P x z.1 :=
        Finset.prod_erase_mul Finset.univ (scale x z.1) (Finset.mem_univ z.2)
      simp only [MFamily, NFamily, ite_eq_left hz, hprod]
      exact ⟨(div_le_div_of_nonneg_left (hxpos x hx).le hC0pos hC0Cf).trans hz.2.1,
        hz.2.2.1.trans (mul_le_mul_of_nonneg_right hC0Cf (hxpos x hx).le),
        hz.2.2.2.2.1, by simpa only [mul_comm] using hz.2.2.2.2.2⟩
    · simp only [MFamily, NFamily, ite_eq_right hz, Real.mul_self_sqrt (hxpos x hx).le]
      refine ⟨div_le_self (hxpos x hx).le hCf,
        le_mul_of_one_le_left (hxpos x hx).le hCf, ?_,
        le_mul_of_one_le_right (Real.sqrt_nonneg x) hC0⟩
      rw [Real.sqrt_eq_rpow]
      exact Real.rpow_le_rpow_of_exponent_le (hxone x hx) hγ₀hi
  have hαsupport (x : ℝ) (hx : X0 ≤ x) (z : Index) :
      ∀ n ∈ (αFamily x z).support,
        c * MFamily x z ≤ (n : ℝ) ∧ (n : ℝ) ≤ Cf * MFamily x z := by
    by_cases hz : Active x z
    · simp only [αFamily, MFamily, ite_eq_left hz]
      have hb := (hbox x hx z.1 hz.2.2.1 (G z.2) (hG z.2)).1
      have hpow : (2 : ℝ) ^ (G z.2).card ≤ Cf :=
        (pow_le_pow_right₀ (by norm_num) (hcard40 (G z.2))).trans hB2Cf
      have hQnonneg : 0 ≤ Q x z.1 (G z.2) := zero_le_one.trans (hQone x hx z.1 _)
      intro n hn
      constructor
      · calc
          c * Q x z.1 (G z.2) = Q x z.1 (G z.2) / Cf := by dsimp only [c]; ring
          _ ≤ Q x z.1 (G z.2) / (2 : ℝ) ^ (G z.2).card :=
            div_le_div_of_nonneg_left hQnonneg (pow_pos zero_lt_two _) hpow
          _ ≤ (n : ℝ) := (hb n hn).1
      · exact (hb n hn).2.trans (mul_le_mul_of_nonneg_right hpow hQnonneg)
    · simp only [αFamily, ite_eq_right hz, Finsupp.support_zero, Finset.notMem_empty,
        false_implies, forall_const]
  have hαcoeff (x : ℝ) (hx : X0 ≤ x) (z : Index) (n : ℕ) :
      ‖αFamily x z n‖ ≤ W * (n.divisors.card : ℝ) ^ 40 * (Real.log x) ^ 40 := by
    by_cases hz : Active x z
    · simpa only [αFamily, ite_eq_left hz] using
        (hbox x hx z.1 hz.2.2.1 (G z.2) (hG z.2)).2 n
    · simp only [αFamily, ite_eq_right hz, Finsupp.zero_apply, norm_zero]
      exact mul_nonneg (mul_nonneg hW (pow_nonneg (Nat.cast_nonneg _) _))
        (pow_nonneg (zero_le_one.trans (hlog x hx)) _)
  have hψ (x : ℝ) (_hx : X0 ≤ x) (z : Index) : ContDiff ℝ ∞ (ψFamily x z) := by
    by_cases hz : Active x z
    · exact (hψdata x z hz).1
    · simpa only [ψFamily, dite_eq_right hz, Pi.zero_def] using
        (contDiff_const : ContDiff ℝ ∞ (fun _ : ℝ => (0 : ℂ)))
  have hψsupport (x : ℝ) (_hx : X0 ≤ x) (z : Index) :
      Function.support (ψFamily x z) ⊆ Set.Icc c Cf := by
    by_cases hz : Active x z
    · exact (hψdata x z hz).2.1
    · simp only [ψFamily, dite_eq_right hz, Function.support_zero, Set.empty_subset]
  have hψbounds : ∀ J : ℕ, ∃ L E : ℝ, 0 ≤ L ∧
      ∀ x : ℝ, X0 ≤ x → ∀ z : Index, ∀ j : ℕ, j ≤ J → ∀ u : ℝ,
        ‖iteratedDeriv j (ψFamily x z) u‖ ≤ L * (Real.log x) ^ E := by
    intro J
    let L : ℝ := 3 * (1 + ∑ k ∈ Finset.range (J + 1), Cder k)
    have hL : 0 ≤ L :=
      mul_nonneg zero_le_three
        (add_nonneg zero_le_one (Finset.sum_nonneg fun k _ => (hCder k).le))
    refine ⟨L, ((D * J + 1 : ℕ) : ℝ), hL, ?_⟩
    intro x hx z j hj u
    by_cases hz : Active x z
    · have hNupper : scale x z.1 z.2 ≤ x ^ 2 := by
        calc
          scale x z.1 z.2 ≤ ∏ s, scale x z.1 s :=
            Multiset.mem_le_prod_of_one_le (s := Finset.univ.val)
              (hscaleone x hx z.1) (Finset.mem_univ z.2)
          _ ≤ C0 * x := hz.2.2.1
          _ ≤ x * x := mul_le_mul_of_nonneg_right (hC0X0.trans hx) (hxpos x hx).le
          _ = x ^ 2 := (pow_two x).symm
      have hd := heathBrown_geometric_derivatives_log_bound Cder
        (fun k => (hCder k).le) D J x (scale x z.1 z.2) (hX0.trans hx)
        (hscaleone x hx z.1 z.2) hNupper (ψFamily x z)
        (hψdata x z hz).2.2.2 j hj u
      simpa only [L, Real.rpow_natCast] using hd
    · simp only [ψFamily, dite_eq_right hz, iteratedDeriv_const_zero, norm_zero]
      exact mul_nonneg hL (Real.rpow_nonneg (zero_le_one.trans (hlog x hx)) _)
  have hLsubpower : ∀ η : ℝ, 0 < η →
      ∀ᶠ x : ℝ in Filter.atTop, (1 : ℝ) ≤ x ^ η ∧ C0 ≤ x ^ η := by
    intro η hη
    filter_upwards [(tendsto_rpow_atTop hη).eventually_ge_atTop C0] with x hx
    exact ⟨hC0.trans hx, hx⟩
  intro A hA
  obtain ⟨K, X, hK, hXX0, hbound⟩ :=
    sourceSmoothFactor_dense_uniform_log_saving «ω» δ γ₀ hω hδ hγ₀ hgap hγ₀hi
      MFamily NFamily αFamily ψFamily (fun _ => 1) (fun _ => C0)
      c Cf W X0 40 hc hcCf hCf hW hX0
      (fun _ _ => ⟨zero_lt_one, hC0pos⟩) hLsubpower
      hscaleFamily hαsupport hαcoeff hψ hψsupport hψbounds A hA
  refine ⟨K, X, hK, hX0.trans hXX0, ?_⟩
  intro x hx Θ' t ht htten ν ι' Ni' β' hPlower hPupper s hs hNlower hNupper I hI a ha
  let v : Params := (t, ν)
  let z : Index := (v, s)
  have hz : Active x z := ⟨hXX0.trans hx, hPlower, hPupper, hs, hNlower, hNupper⟩
  have hslotEq (u : ιr) : slot x v u = β' u := by
    dsimp only [slot, tclip, v, β']
    rw [min_eq_left (htten u.1), max_eq_right (ht u.1)]
  have hsample : positiveCompactProfileSequence (ψFamily x z) Cf (NFamily x z) 0 =
      (slot x v s).coeff := by
    simpa only [NFamily, ite_eq_left hz] using (hψdata x z hz).2.2.1.symm
  have hfactor : finiteConvolution (αFamily x z)
      (positiveCompactProfileSequence (ψFamily x z) Cf (NFamily x z) 0) =
        (∏ u, slot x v u).coeff := by
    rw [hsample]
    simp only [αFamily, ite_eq_left hz, finiteConvolution, coeff,
      MonoidAlgebra.ofCoeff_coeff]
    exact congrArg (fun w : MonoidAlgebra ℂ ℕ => w.coeff)
      (Finset.prod_erase_mul Finset.univ (slot x v) (Finset.mem_univ s))
  have hb := hbound x hx z I hI a ha
  simp only [mul_one, hfactor, hslotEq] at hb
  refine le_trans (Finset.sum_le_sum_of_subset_of_nonneg ?_ (fun _ _ _ => norm_nonneg _)) hb
  intro q hq
  obtain ⟨hqrange, hqdvd, hqdd⟩ := Finset.mem_filter.mp hq
  exact Finset.mem_filter.mpr ⟨hqrange, hqdvd,
    denseDivisibility_mono_order hqdd hdensity⟩

open Classical in
theorem sourceT3_middle_slots_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (density : ℕ) (orders : Fin 3 → Fin 5) (D : ℕ) (hD : 1 ≤ D)
    («ω» δ σclass σdist C0 : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hσclass : 0 < σclass)
    (hσclassHalf : σclass < 1 / 2) (hσσ : σclass < σdist)
    (hσdistHalf : σdist < 1 / 2) (hC0 : 1 ≤ C0)
    (hdist :
      (density = 1 ∧ 54 * «ω» + 15 * δ + 5 * σdist < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (density = 2 ∧ 56 * «ω» + 16 * δ + 4 * σdist < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (density = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σdist < 1 ∧ 64 * «ω» + 20 * δ + 2 * σdist < 1)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
        let Θ : ℝ := 1 + (Real.log x) ^ (-(D : ℝ))
        ∀ t : Fin 3 → ℝ, (∀ c, 0 ≤ t c) → (∀ c, t c ≤ 10) →
        ∀ ν : (c : Fin 3) → Fin (2 * ((orders c).val + 1)) → ℕ,
          let ιr := Σ c : Fin 3, Fin (2 * ((orders c).val + 1))
          let Ni : ιr → ℝ := fun s => Θ ^ ν s.1 s.2
          let β : ιr → MonoidAlgebra ℂ ℕ := fun s =>
            minorantHBLocalizedSlot ((orders s.1).val + 1) (x ^ (9 / 100 : ℝ))
              Θ (t s.1) (ν s.1) s.2
          x / C0 ≤ (∏ s, Ni s) → (∏ s, Ni s) ≤ C0 * x →
          ∀ S T : Finset ιr,
            Disjoint S T → S ∪ T = Finset.univ → S.Nonempty → T.Nonempty →
            x ^ (1 / 2 - σclass) / C0 < (∏ s ∈ S, Ni s) →
            (∏ s ∈ S, Ni s) ≤ (∏ s ∈ T, Ni s) →
          ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
          ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
            (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
                q ∣ (∏ p ∈ I, p) ∧
                  Nonempty (DenseDivisibilityWitness
                    ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩ density q)),
              ‖fullDiscrepancy (∏ s, β s).coeff q a‖) ≤
                K * x / (Real.log x) ^ A := by
  let ιr := Σ c : Fin 3, Fin (2 * ((orders c).val + 1))
  let Params : Type := (Fin 3 → ℝ) × ((c : Fin 3) → Fin (2 * ((orders c).val + 1)) → ℕ)
  let tclip : Params → Fin 3 → ℝ := fun v c => max 0 (min (v.1 c) 10)
  have htclip (v : Params) (c : Fin 3) : 0 ≤ tclip v c ∧ tclip v c ≤ 10 :=
    ⟨le_max_left _ _, max_le (by norm_num) (min_le_right _ _)⟩
  have hcard30 : Fintype.card ιr ≤ 30 := by
    rw [Fintype.card_sigma]
    calc
      (∑ c : Fin 3, Fintype.card (Fin (2 * ((orders c).val + 1)))) ≤
          ∑ _c : Fin 3, (10 : ℕ) :=
        Finset.sum_le_sum fun c _ => by
          simp only [Fintype.card_fin]
          have hc := (orders c).isLt
          omega
      _ = 30 := by norm_num
  have hσdist : 0 < σdist ∧ σdist < 1 / 2 :=
    ⟨hσclass.trans hσσ, hσdistHalf⟩
  have hC0pos : 0 < C0 := zero_lt_one.trans_le hC0
  let d : ℝ := (1 / 2 - σclass) / 2
  have hd : 0 < d := by dsimp only [d]; linarith only [hσclassHalf]
  have hgap : 0 < σdist - σclass := sub_pos.mpr hσσ
  have hlarge : ∀ᶠ x : ℝ in Filter.atTop,
      C0 ≤ x ^ (σdist - σclass) ∧ C0 ≤ x ^ d :=
    ((tendsto_rpow_atTop hgap).eventually_ge_atTop C0).and
      ((tendsto_rpow_atTop hd).eventually_ge_atTop C0)
  obtain ⟨Xbase, hXbase⟩ := Filter.eventually_atTop.1 hlarge
  let X0 : ℝ := max (Real.exp 1) (max C0 Xbase)
  have hX0 : Real.exp 1 ≤ X0 := le_max_left _ _
  have hC0X0 : C0 ≤ X0 := (le_max_left _ _).trans (le_max_right _ _)
  have hbaseX0 : Xbase ≤ X0 := (le_max_right _ _).trans (le_max_right _ _)
  have hxpos (x : ℝ) (hx : X0 ≤ x) : 0 < x :=
    (Real.exp_pos 1).trans_le (hX0.trans hx)
  have hxone (x : ℝ) (hx : X0 ≤ x) : 1 ≤ x :=
    (Real.one_le_exp zero_le_one).trans (hX0.trans hx)
  have hlog (x : ℝ) (hx : X0 ≤ x) : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using
      Real.log_le_log (Real.exp_pos 1) (hX0.trans hx)
  have hlargeX (x : ℝ) (hx : X0 ≤ x) :
      C0 ≤ x ^ (σdist - σclass) ∧ C0 ≤ x ^ d :=
    hXbase x (hbaseX0.trans hx)
  let Θ : ℝ → ℝ := fun x => 1 + (Real.log x) ^ (-(D : ℝ))
  let U : ℝ → ℝ := fun x => x ^ (9 / 100 : ℝ)
  let η : ℝ → ℝ → ℝ := fun x => minorantHBProfile (Θ x)
  let μU : ℝ → ArithmeticFunction ℝ := fun x =>
    arithmeticFunctionLowCutoff (U x)
      (ArithmeticFunction.moebius : ArithmeticFunction ℝ)
  let f : ℝ → ιr → ArithmeticFunction ℝ := fun x s =>
    minorantHBSlot ((orders s.1).val + 1) (U x) s.2
  let scale : ℝ → Params → ιr → ℝ := fun x v s => Θ x ^ v.2 s.1 s.2
  let slot : ℝ → Params → ιr → MonoidAlgebra ℂ ℕ := fun x v s =>
    minorantHBLocalizedSlot ((orders s.1).val + 1) (U x)
      (Θ x) (tclip v s.1) (v.2 s.1) s.2
  let P : ℝ → Params → ℝ := fun x ν => ∏ i, scale x ν i
  let Q : ℝ → Params → Finset (ιr) → ℝ :=
    fun x ν G => ∏ i ∈ G, scale x ν i
  let coeff : ℝ → Params → Finset (ιr) → ℕ →₀ ℂ :=
    fun x ν G => (∏ i ∈ G, slot x ν i).coeff
  have hΘ (x : ℝ) (hx : X0 ≤ x) : 1 < Θ x ∧ Θ x ≤ 2 := by
    have hℓpos : 0 < Real.log x := zero_lt_one.trans_le (hlog x hx)
    have hsmall : (Real.log x) ^ (-(D : ℝ)) ≤ 1 :=
      Real.rpow_le_one_of_one_le_of_nonpos (hlog x hx)
        (neg_nonpos.mpr (by exact_mod_cast (Nat.zero_le 1).trans hD))
    dsimp only [Θ]
    exact ⟨lt_add_of_pos_right 1 (Real.rpow_pos_of_pos hℓpos _), by linarith⟩
  have hscaleone (x : ℝ) (hx : X0 ≤ x) (ν : Params)
      (i : ιr) : 1 ≤ scale x ν i :=
    one_le_pow₀ (hΘ x hx).1.le
  have hQone (x : ℝ) (hx : X0 ≤ x) (ν : Params)
      (G : Finset (ιr)) : 1 ≤ Q x ν G :=
    Finset.one_le_prod fun i _hi => hscaleone x hx ν i
  have hcard40 (G : Finset ιr) : G.card ≤ 40 :=
    (Finset.card_le_univ G).trans (hcard30.trans (by norm_num))
  let B2 : ℝ := (2 : ℝ) ^ 40
  let c : ℝ := 1 / B2
  let Cf : ℝ := B2 * C0 ^ 2
  let W : ℝ := (4 : ℝ) ^ 40
  have hB2pos : 0 < B2 := by positivity
  have hB2one : 1 ≤ B2 := one_le_pow₀ (by norm_num : (1 : ℝ) ≤ 2)
  have hc : 0 < c := div_pos zero_lt_one hB2pos
  have hC0sq : C0 ≤ C0 ^ 2 := le_self_pow₀ hC0 (by decide)
  have hC0Cf : C0 ≤ Cf :=
    hC0sq.trans (le_mul_of_one_le_left (sq_nonneg C0) hB2one)
  have hCf : 1 ≤ Cf := hC0.trans hC0Cf
  have hW : 0 ≤ W := by positivity
  have hgeometry (x P' PS PT : ℝ) (hx : X0 ≤ x)
      (hPSone : 1 ≤ PS) (hPTone : 1 ≤ PT) (hprod : PS * PT = P')
      (hPlower : x / C0 ≤ P') (hPupper : P' ≤ C0 * x)
      (hPSlower : x ^ (1 / 2 - σclass) / C0 < PS) (hST : PS ≤ PT) :
      (x / Cf ≤ PT * min PS (Real.sqrt x) ∧
        PT * min PS (Real.sqrt x) ≤ Cf * x ∧
        x ^ (1 / 2 - σdist) ≤ min PS (Real.sqrt x) ∧
        min PS (Real.sqrt x) ≤ x ^ (1 / 2 : ℝ)) ∧
      PS ≤ C0 * min PS (Real.sqrt x) ∧ x ^ d ≤ PS ∧ PS ≤ x ^ (2 : ℝ) := by
    have hPSpos : 0 < PS := zero_lt_one.trans_le hPSone
    have hPTpos : 0 < PT := zero_lt_one.trans_le hPTone
    have hPSsq : PS ^ 2 ≤ C0 * x := by
      calc
        PS ^ 2 = PS * PS := pow_two PS
        _ ≤ PS * PT := mul_le_mul_of_nonneg_left hST hPSpos.le
        _ = P' := hprod
        _ ≤ C0 * x := hPupper
    have hPSroot : PS ≤ C0 * Real.sqrt x := by
      calc
        PS ≤ Real.sqrt (C0 * x) := Real.le_sqrt_of_sq_le hPSsq
        _ = Real.sqrt C0 * Real.sqrt x := Real.sqrt_mul hC0pos.le x
        _ ≤ C0 * Real.sqrt x :=
          mul_le_mul_of_nonneg_right
            (Real.sqrt_le_self_iff.mpr (Or.inr hC0)) (Real.sqrt_nonneg x)
    have hPSN : PS ≤ C0 * min PS (Real.sqrt x) := by
      rw [mul_min_of_nonneg _ _ hC0pos.le]
      exact le_min (le_mul_of_one_le_left hPSpos.le hC0) hPSroot
    have hpolyLower : x ^ d ≤ PS := by
      have hh : x ^ d * C0 ≤ x ^ (1 / 2 - σclass) := by
        calc
          x ^ d * C0 ≤ x ^ d * x ^ d :=
            mul_le_mul_of_nonneg_left (hlargeX x hx).2
              (Real.rpow_nonneg (hxpos x hx).le d)
          _ = x ^ (1 / 2 - σclass) := by
            rw [← Real.rpow_add (hxpos x hx)]
            congr 1
            dsimp only [d]
            ring
      exact ((le_div_iff₀ hC0pos).2 hh).trans hPSlower.le
    have hpolyUpper : PS ≤ x ^ (2 : ℝ) := by
      rw [Real.rpow_two]
      calc
        PS ≤ PS * PT := le_mul_of_one_le_right hPSpos.le hPTone
        _ = P' := hprod
        _ ≤ C0 * x := hPupper
        _ ≤ x * x := mul_le_mul_of_nonneg_right (hC0X0.trans hx) (hxpos x hx).le
        _ = x ^ 2 := (pow_two x).symm
    have hNlower : x ^ (1 / 2 - σdist) ≤ min PS (Real.sqrt x) := by
      apply le_min
      · have hh : x ^ (1 / 2 - σdist) * C0 ≤ x ^ (1 / 2 - σclass) := by
          calc
            x ^ (1 / 2 - σdist) * C0 ≤
                x ^ (1 / 2 - σdist) * x ^ (σdist - σclass) :=
              mul_le_mul_of_nonneg_left (hlargeX x hx).1
                (Real.rpow_nonneg (hxpos x hx).le _)
            _ = x ^ (1 / 2 - σclass) := by
              rw [← Real.rpow_add (hxpos x hx)]
              congr 1
              ring
        exact ((le_div_iff₀ hC0pos).2 hh).trans hPSlower.le
      · rw [Real.sqrt_eq_rpow]
        exact Real.rpow_le_rpow_of_exponent_le (hxone x hx)
          (sub_le_self _ hσdist.1.le)
    have hMNlower : x / C0 ≤ PT * min PS (Real.sqrt x) := by
      by_cases hh : PS ≤ Real.sqrt x
      · calc
          x / C0 ≤ P' := hPlower
          _ = PT * min PS (Real.sqrt x) := by
            rw [min_eq_left hh, mul_comm, hprod]
      · have hh' : Real.sqrt x ≤ PS := (lt_of_not_ge hh).le
        calc
          x / C0 ≤ x := div_le_self (hxpos x hx).le hC0
          _ = Real.sqrt x * Real.sqrt x := (Real.mul_self_sqrt (hxpos x hx).le).symm
          _ ≤ PT * Real.sqrt x :=
            mul_le_mul_of_nonneg_right (hh'.trans hST) (Real.sqrt_nonneg x)
          _ = PT * min PS (Real.sqrt x) := by rw [min_eq_right hh']
    have hMNupper : PT * min PS (Real.sqrt x) ≤ C0 * x := by
      calc
        PT * min PS (Real.sqrt x) ≤ PT * PS :=
          mul_le_mul_of_nonneg_left (min_le_left _ _) hPTpos.le
        _ = P' := (mul_comm PT PS).trans hprod
        _ ≤ C0 * x := hPupper
    refine ⟨⟨?_, ?_, hNlower, ?_⟩, hPSN, hpolyLower, hpolyUpper⟩
    · exact (div_le_div_of_nonneg_left (hxpos x hx).le hC0pos hC0Cf).trans hMNlower
    · exact hMNupper.trans (mul_le_mul_of_nonneg_right hC0Cf (hxpos x hx).le)
    · simpa only [Real.sqrt_eq_rpow] using min_le_right PS (Real.sqrt x)
  have hbox (x : ℝ) (hx : X0 ≤ x) (ν : Params)
      (hPupper : P x ν ≤ C0 * x) (G : Finset (ιr)) (hG : G.Nonempty) :
      (∀ n ∈ (coeff x ν G).support,
        Q x ν G / (2 : ℝ) ^ G.card ≤ (n : ℝ) ∧
          (n : ℝ) ≤ (2 : ℝ) ^ G.card * Q x ν G) ∧
      ∀ n : ℕ, ‖coeff x ν G n‖ ≤
        W * (n.divisors.card : ℝ) ^ 40 * (Real.log x) ^ 40 := by
    have hslotData (s : ιr) :
        (∀ n ∈ (slot x ν s).coeff.support,
          scale x ν s / 2 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * scale x ν s) ∧
        ∀ n : ℕ, ‖(slot x ν s).coeff n‖ ≤ 1 + Real.log (n : ℝ) :=
      sourceT3_localized_slot_support_norm ((orders s.1).val + 1) (U x)
        (Θ x) (tclip ν s.1) (ν.2 s.1) s.2 (hΘ x hx).1 (hΘ x hx).2 (htclip ν s.1).1
    have hslotNorm (s : ιr) (n : ℕ) : ‖(slot x ν s).coeff n‖ ≤ 4 * Real.log x := by
      by_cases hn : n ∈ (slot x ν s).coeff.support
      · have hNi : scale x ν s ≤ x ^ (2 : ℕ) := by
          calc
            scale x ν s ≤ ∏ u, scale x ν u :=
              Multiset.mem_le_prod_of_one_le (s := Finset.univ.val)
                (hscaleone x hx ν) (Finset.mem_univ s)
            _ ≤ C0 * x := hPupper
            _ ≤ x * x := mul_le_mul_of_nonneg_right (hC0X0.trans hx) (hxpos x hx).le
            _ = x ^ 2 := (pow_two x).symm
        have hns := (hslotData s).1 n hn
        have hnpos : 0 < (n : ℝ) :=
          (div_pos (zero_lt_one.trans_le (hscaleone x hx ν s)) zero_lt_two).trans_le hns.1
        have hnup : (n : ℝ) ≤ 2 * x ^ (2 : ℕ) :=
          hns.2.trans (mul_le_mul_of_nonneg_left hNi zero_le_two)
        have hln := Real.log_le_log hnpos hnup
        rw [Real.log_mul two_ne_zero (pow_ne_zero 2 (hxpos x hx).ne'), Real.log_pow] at hln
        norm_num only [Nat.cast_ofNat] at hln
        have hlog2 := Real.log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2)
        exact ((hslotData s).2 n).trans (by linarith [hlog x hx])
      · rw [Finsupp.notMem_support_iff.mp hn, norm_zero]
        exact mul_nonneg (by norm_num : (0 : ℝ) ≤ 4) (zero_le_one.trans (hlog x hx))
    have hℓ : 1 ≤ Real.log x := hlog x hx
    have hbase : 1 ≤ 4 * Real.log x := by linarith
    have hraw := heathBrown_box_product_support_norm_bound G hG
      (slot x ν) (scale x ν) (4 * Real.log x) (zero_le_one.trans hbase)
      (fun i _hi => hscaleone x hx ν i)
      (fun i _hi => (hslotData i).1) (fun i _hi => hslotNorm i)
    change (∀ n ∈ (coeff x ν G).support,
      Q x ν G / (2 : ℝ) ^ G.card ≤ (n : ℝ) ∧
        (n : ℝ) ≤ (2 : ℝ) ^ G.card * Q x ν G) ∧
      (∀ n : ℕ, ‖coeff x ν G n‖ ≤
        (4 * Real.log x) ^ G.card * (n.divisors.card : ℝ) ^ (G.card - 1)) at hraw
    have hzero : coeff x ν G 0 = 0 := by
      apply Finsupp.notMem_support_iff.mp
      intro hn
      have hh := (hraw.1 0 hn).1
      have hpos : 0 < Q x ν G / (2 : ℝ) ^ G.card :=
        div_pos (zero_lt_one.trans_le (hQone x hx ν G)) (pow_pos zero_lt_two _)
      exact hpos.not_ge (by simpa only [Nat.cast_zero] using hh)
    refine ⟨hraw.1, ?_⟩
    intro n
    by_cases hn : n = 0
    · subst n
      simp [hzero]
    · have hdv : 1 ≤ (n.divisors.card : ℝ) := by
        exact_mod_cast Finset.one_le_card.mpr (Nat.nonempty_divisors.mpr hn)
      calc
        ‖coeff x ν G n‖ ≤ (4 * Real.log x) ^ G.card *
            (n.divisors.card : ℝ) ^ (G.card - 1) := hraw.2 n
        _ ≤ (4 * Real.log x) ^ 40 * (n.divisors.card : ℝ) ^ 40 :=
          mul_le_mul (pow_le_pow_right₀ hbase (hcard40 G))
            (pow_le_pow_right₀ hdv ((Nat.sub_le _ _).trans (hcard40 G)))
            (pow_nonneg (Nat.cast_nonneg _) _) (pow_nonneg (zero_le_one.trans hbase) _)
        _ = W * (n.divisors.card : ℝ) ^ 40 * (Real.log x) ^ 40 := by
          dsimp only [W]
          rw [mul_pow]
          ring
  have hsupportTransfer (x : ℝ) (hx : X0 ≤ x) (ν : Params)
      (G : Finset (ιr)) (L : ℝ) (hL : 0 ≤ L)
      (hLQ : L ≤ Q x ν G) (hQL : Q x ν G ≤ C0 * L)
      (hs : ∀ n ∈ (coeff x ν G).support,
        Q x ν G / (2 : ℝ) ^ G.card ≤ (n : ℝ) ∧
          (n : ℝ) ≤ (2 : ℝ) ^ G.card * Q x ν G) :
      ∀ n ∈ (coeff x ν G).support, c * L ≤ (n : ℝ) ∧ (n : ℝ) ≤ Cf * L := by
    have hQ : 0 ≤ Q x ν G := zero_le_one.trans (hQone x hx ν G)
    have hpow : (2 : ℝ) ^ G.card ≤ B2 :=
      pow_le_pow_right₀ (by norm_num) (hcard40 G)
    intro n hn
    constructor
    · calc
        c * L = L / B2 := by dsimp only [c]; ring
        _ ≤ Q x ν G / B2 := div_le_div_of_nonneg_right hLQ hB2pos.le
        _ ≤ Q x ν G / (2 : ℝ) ^ G.card :=
          div_le_div_of_nonneg_left hQ (pow_pos zero_lt_two _) hpow
        _ ≤ (n : ℝ) := (hs n hn).1
    · calc
        (n : ℝ) ≤ (2 : ℝ) ^ G.card * Q x ν G := (hs n hn).2
        _ ≤ B2 * Q x ν G := mul_le_mul_of_nonneg_right hpow hQ
        _ ≤ B2 * (C0 * L) := mul_le_mul_of_nonneg_left hQL hB2pos.le
        _ ≤ B2 * (C0 ^ 2 * L) :=
          mul_le_mul_of_nonneg_left
            (mul_le_mul_of_nonneg_right hC0sq hL) hB2pos.le
        _ = Cf * L := by dsimp only [Cf]; ring
  let Index : Type := Params ×
    (Finset (ιr) × Finset (ιr))
  let Active : ℝ → Index → Prop := fun x z =>
    x / C0 ≤ P x z.1 ∧ P x z.1 ≤ C0 * x ∧
      Disjoint z.2.1 z.2.2 ∧ z.2.1 ∪ z.2.2 = Finset.univ ∧
      z.2.1.Nonempty ∧ z.2.2.Nonempty ∧
      x ^ (1 / 2 - σclass) / C0 < Q x z.1 z.2.1 ∧
      Q x z.1 z.2.1 ≤ Q x z.1 z.2.2
  let MFamily : ℝ → Index → ℝ := fun x z =>
    if Active x z then Q x z.1 z.2.2 else Real.sqrt x
  let NFamily : ℝ → Index → ℝ := fun x z =>
    if Active x z then min (Q x z.1 z.2.1) (Real.sqrt x) else Real.sqrt x
  let αFamily : ℝ → Index → ℕ →₀ ℂ := fun x z =>
    if Active x z then coeff x z.1 z.2.2 else 0
  let βFamily : ℝ → Index → ℕ →₀ ℂ := fun x z =>
    if Active x z then coeff x z.1 z.2.1 else 0
  have hgeom (x : ℝ) (hx : X0 ≤ x) (z : Index) (hz : Active x z) :
      (x / Cf ≤ MFamily x z * NFamily x z ∧
        MFamily x z * NFamily x z ≤ Cf * x ∧
        x ^ (1 / 2 - σdist) ≤ NFamily x z ∧
        NFamily x z ≤ x ^ (1 / 2 : ℝ)) ∧
      Q x z.1 z.2.1 ≤ C0 * NFamily x z ∧
        x ^ d ≤ Q x z.1 z.2.1 ∧ Q x z.1 z.2.1 ≤ x ^ (2 : ℝ) := by
    have hact := hz
    rcases hact with ⟨hPlower, hPupper, hdisj, hunion, _, _, hPSlower, hST⟩
    have hprod : Q x z.1 z.2.1 * Q x z.1 z.2.2 = P x z.1 := by
      dsimp only [Q, P]
      rw [← Finset.prod_union hdisj, hunion]
    simpa only [MFamily, NFamily, ite_eq_left hz] using
      hgeometry x (P x z.1) (Q x z.1 z.2.1) (Q x z.1 z.2.2) hx
        (hQone x hx z.1 z.2.1) (hQone x hx z.1 z.2.2)
        hprod hPlower hPupper hPSlower hST
  have hscaleFamily : ∀ x : ℝ, X0 ≤ x → ∀ z : Index,
      x / Cf ≤ MFamily x z * NFamily x z ∧
        MFamily x z * NFamily x z ≤ Cf * x ∧
        x ^ (1 / 2 - σdist) ≤ NFamily x z ∧
        NFamily x z ≤ x ^ (1 / 2 : ℝ) := by
    intro x hx z
    by_cases hz : Active x z
    · exact (hgeom x hx z hz).1
    · simp only [MFamily, NFamily, ite_eq_right hz]
      simp only [Real.mul_self_sqrt (hxpos x hx).le]
      refine ⟨div_le_self (hxpos x hx).le hCf,
        le_mul_of_one_le_left (hxpos x hx).le hCf, ?_, ?_⟩
      · rw [Real.sqrt_eq_rpow]
        exact Real.rpow_le_rpow_of_exponent_le (hxone x hx)
          (sub_le_self _ hσdist.1.le)
      · exact (Real.sqrt_eq_rpow x).le
  have hsupportFamily : ∀ x : ℝ, X0 ≤ x → ∀ z : Index,
      (∀ n ∈ (αFamily x z).support,
        c * MFamily x z ≤ (n : ℝ) ∧ (n : ℝ) ≤ Cf * MFamily x z) ∧
      (∀ n ∈ (βFamily x z).support,
        c * NFamily x z ≤ (n : ℝ) ∧ (n : ℝ) ≤ Cf * NFamily x z) := by
    intro x hx z
    by_cases hz : Active x z
    · have hact := hz
      rcases hact with ⟨_, hPupper, _, _, hSne, hTne, _, _⟩
      have hs := (hbox x hx z.1 hPupper z.2.1 hSne).1
      have ht := (hbox x hx z.1 hPupper z.2.2 hTne).1
      have hgg := hgeom x hx z hz
      have hTnonneg : 0 ≤ Q x z.1 z.2.2 := zero_le_one.trans (hQone x hx z.1 z.2.2)
      have hNnonneg : 0 ≤ NFamily x z :=
        (Real.rpow_nonneg (hxpos x hx).le _).trans hgg.1.2.2.1
      constructor
      · simpa only [αFamily, MFamily, ite_eq_left hz] using
          hsupportTransfer x hx z.1 z.2.2 (Q x z.1 z.2.2) hTnonneg le_rfl
            (le_mul_of_one_le_left hTnonneg hC0) ht
      · have hNQ : NFamily x z ≤ Q x z.1 z.2.1 := by
          simp only [NFamily, ite_eq_left hz]
          exact min_le_left _ _
        simpa only [βFamily, ite_eq_left hz] using
          hsupportTransfer x hx z.1 z.2.1 (NFamily x z) hNnonneg hNQ hgg.2.1 hs
    · have hαzero : αFamily x z = 0 := ite_eq_right hz
      have hβzero : βFamily x z = 0 := ite_eq_right hz
      rw [hαzero, hβzero, Finsupp.support_zero]
      exact ⟨fun n hn => (Finset.notMem_empty n hn).elim,
        fun n hn => (Finset.notMem_empty n hn).elim⟩
  have hcoeffFamily : ∀ x : ℝ, X0 ≤ x → ∀ z : Index, ∀ n : ℕ,
      ‖αFamily x z n‖ ≤ W * (n.divisors.card : ℝ) ^ 40 * (Real.log x) ^ 40 ∧
      ‖βFamily x z n‖ ≤ W * (n.divisors.card : ℝ) ^ 40 * (Real.log x) ^ 40 := by
    intro x hx z n
    by_cases hz : Active x z
    · have hact := hz
      rcases hact with ⟨_, hPupper, _, _, hSne, hTne, _, _⟩
      simpa only [αFamily, βFamily, ite_eq_left hz] using
        And.intro ((hbox x hx z.1 hPupper z.2.2 hTne).2 n)
          ((hbox x hx z.1 hPupper z.2.1 hSne).2 n)
    · have hℓ : 0 ≤ Real.log x := zero_le_one.trans (hlog x hx)
      have hαzero : αFamily x z = 0 := ite_eq_right hz
      have hβzero : βFamily x z = 0 := ite_eq_right hz
      rw [hαzero, hβzero, Finsupp.zero_apply, norm_zero]
      have hbound : 0 ≤ W * (n.divisors.card : ℝ) ^ 40 * (Real.log x) ^ 40 :=
        mul_nonneg (mul_nonneg hW (pow_nonneg (Nat.cast_nonneg _) _))
          (pow_nonneg hℓ _)
      exact ⟨hbound, hbound⟩
  have hSWFamily : ∀ Asw : ℝ, 0 < Asw →
      ∃ KSW XSW : ℝ, 0 < KSW ∧ X0 ≤ XSW ∧
        ∀ x : ℝ, XSW ≤ x → ∀ z : Index,
        ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
          ‖fullDiscrepancy
              ((βFamily x z).filter (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
            KSW * ((q * r).divisors.card : ℝ) ^ 2 * NFamily x z /
              (Real.log x) ^ Asw := by
    intro Asw hAsw
    have hDpos : (0 : ℝ) < (D : ℝ) := by
      exact_mod_cast (show 0 < D by omega)
    obtain ⟨Csw, Xsw, hCsw, _, hsw⟩ :=
      heathBrown_localized_products_fixedPower_siegelWalfisz
        40 (by norm_num) d 2 hd (by norm_num) (D : ℝ) hDpos Asw hAsw
    refine ⟨Csw * C0, max X0 Xsw, mul_pos hCsw hC0pos, le_max_left _ _, ?_⟩
    intro x hx z q r a hq hr ha
    have hx0 : X0 ≤ x := (le_max_left _ _).trans hx
    have hxsw : Xsw ≤ x := (le_max_right _ _).trans hx
    have hℓpos : 0 < Real.log x := zero_lt_one.trans_le (hlog x hx0)
    by_cases hz : Active x z
    · have hact := hz
      rcases hact with ⟨_, _, _, _, hSne, _, _, _⟩
      let S : Finset (ιr) := z.2.1
      let ν : Params := z.1
      let G : ℕ →₀ ℂ := coeff x ν S
      let e : Fin S.card ≃ S := S.equivFin.symm
      have hNprod :
          (∏ b : Fin S.card, scale x ν (e b)) = Q x ν S :=
        (e.prod_comp (fun i : S => scale x ν i)).trans
          (Finset.prod_coe_sort S (scale x ν))
      let role : Fin S.card → Fin 4 := fun b =>
        if (e b).1.2.val < (orders (e b).1.1).val + 1 then 0
        else if (e b).1.2.val + 1 = 2 * ((orders (e b).1.1).val + 1) then 3 else 2
      let fsw : Fin S.card → ℕ → ℝ := fun b n =>
        if role b = 0 then μU x n else if role b = 1 then |μU x n|
        else if role b = 2 then (ArithmeticFunction.zeta : ArithmeticFunction ℝ) n
        else ArithmeticFunction.log n
      have hfsw (b : Fin S.card) (n : ℕ) : fsw b n = f x (e b) n := by
        by_cases hμ : (e b).1.2.val < (orders (e b).1.1).val + 1
        · simp only [fsw, role, hμ, ↓reduceIte, f, minorantHBSlot, μU]
        · by_cases hln : (e b).1.2.val + 1 = 2 * ((orders (e b).1.1).val + 1)
          · simp only [fsw, role, hμ, hln, ↓reduceIte, f, minorantHBSlot]
            norm_num [Fin.ext_iff]
          · simp only [fsw, role, hμ, hln, ↓reduceIte, f, minorantHBSlot]
            norm_num [Fin.ext_iff]
      let βsw : Fin S.card → MonoidAlgebra ℂ ℕ := fun b =>
        ∑ n ∈ Finset.Icc (max 1 (1 : ℕ)) ⌊Θ x * scale x ν (e b)⌋₊,
          MonoidAlgebra.single n
            (((η x ((n : ℝ) / scale x ν (e b)) *
              Real.rpow (n : ℝ) (-(tclip ν (e b).1.1)) * fsw b n : ℝ) : ℂ))
      have hβsw (b : Fin S.card) : βsw b = slot x ν (e b) := by
        simp only [βsw, slot, minorantHBLocalizedSlot, max_self, hfsw, η, scale, f]
      have hβprod : (∏ b : Fin S.card, βsw b) = ∏ i ∈ S, slot x ν i := by
        calc
          _ = ∏ b : Fin S.card, slot x ν (e b) :=
            Finset.prod_congr rfl fun b _hb => hβsw b
          _ = _ := (e.prod_comp (fun i : S => slot x ν i)).trans
            (Finset.prod_coe_sort S (slot x ν))
      have hR (b : Fin S.card) :
          (⌊Θ x * scale x ν (e b)⌋₊ : ℝ) ≤ 2 * scale x ν (e b) :=
        (Nat.floor_le
          (mul_nonneg (zero_lt_one.trans (hΘ x hx0).1).le
            (zero_le_one.trans (hscaleone x hx0 ν (e b))))).trans
          (mul_le_mul_of_nonneg_right (hΘ x hx0).2
            (zero_le_one.trans (hscaleone x hx0 ν (e b))))
      have hfilter :
          G.filter (fun n : ℕ => 0 ≤ n ∧ n ≤ G.support.sup id) = G := by
        apply (Finsupp.filter_eq_self_iff _ _).2
        intro n hn
        exact ⟨Nat.zero_le n,
          Finset.le_sup (f := id) (Finsupp.mem_support_iff.mpr hn)⟩
      have hgg := hgeom x hx0 z hz
      have hraw := hsw x hxsw S.card hSne.card_pos (hcard40 S)
        (fun b => scale x ν (e b)) (fun _ => U x) (fun b => tclip ν (e b).1.1)
        (fun b => hscaleone x hx0 ν (e b))
        (by simpa only [hNprod] using hgg.2.2.1)
        (by simpa only [hNprod] using hgg.2.2.2)
        (fun b => htclip ν (e b).1.1) role (fun _ => 1)
        (fun b => ⌊Θ x * scale x ν (e b)⌋₊) hR 0 (G.support.sup id)
      have hh := hraw.2.2 q r a hq hr ha
      change
        ‖fullDiscrepancy
          (((∏ b : Fin S.card, βsw b).coeff.filter
            (fun n : ℕ => 0 ≤ n ∧ n ≤ G.support.sup id)).filter
              (fun n => Nat.Coprime n r)) q a‖ ≤
          Csw * ((q * r).divisors.card : ℝ) ^ 2 *
            (∏ b : Fin S.card, scale x ν (e b)) / (Real.log x) ^ Asw at hh
      rw [hNprod, hβprod] at hh
      change ‖fullDiscrepancy
          ((G.filter (fun n : ℕ => 0 ≤ n ∧ n ≤ G.support.sup id)).filter
            (fun n => Nat.Coprime n r)) q a‖ ≤
          Csw * ((q * r).divisors.card : ℝ) ^ 2 * Q x ν S /
            (Real.log x) ^ Asw at hh
      rw [hfilter] at hh
      have hmain : ‖fullDiscrepancy (G.filter (fun n => Nat.Coprime n r)) q a‖ ≤
          (Csw * C0) * ((q * r).divisors.card : ℝ) ^ 2 * NFamily x z /
            (Real.log x) ^ Asw := by
        calc
          _ ≤ Csw * ((q * r).divisors.card : ℝ) ^ 2 * Q x ν S /
              (Real.log x) ^ Asw := hh
          _ ≤ Csw * ((q * r).divisors.card : ℝ) ^ 2 * (C0 * NFamily x z) /
              (Real.log x) ^ Asw :=
            div_le_div_of_nonneg_right
              (mul_le_mul_of_nonneg_left hgg.2.1
                (mul_nonneg hCsw.le (sq_nonneg _)))
              (Real.rpow_pos_of_pos hℓpos Asw).le
          _ = (Csw * C0) * ((q * r).divisors.card : ℝ) ^ 2 * NFamily x z /
              (Real.log x) ^ Asw := by ring
      simpa only [βFamily, ite_eq_left hz] using hmain
    · have hNinactive : NFamily x z = Real.sqrt x := ite_eq_right hz
      have hNnonneg : 0 ≤ NFamily x z := hNinactive.symm ▸ Real.sqrt_nonneg x
      have hβzero : βFamily x z = 0 := ite_eq_right hz
      have hzero : fullDiscrepancy
          ((βFamily x z).filter (fun n : ℕ => Nat.Coprime n r)) q a = 0 := by
        rw [hβzero, Finsupp.filter_zero]
        simp only [fullDiscrepancy, progressionMass, reducedMass,
          Finsupp.support_zero, Finset.sum_empty, zero_div, sub_self]
      rw [hzero, norm_zero]
      exact div_nonneg
        (mul_nonneg
          (mul_nonneg (mul_nonneg hCsw.le hC0pos.le)
            (sq_nonneg (((q * r).divisors.card : ℝ)))) hNnonneg)
        (Real.rpow_pos_of_pos hℓpos Asw).le
  intro A hAsave
  have hinput : ∃ K X : ℝ, 0 < K ∧ X0 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ z : Index,
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
            q ∣ (∏ p ∈ I, p) ∧
              Nonempty (DenseDivisibilityWitness
                ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩ density q)),
          ‖fullDiscrepancy (finiteConvolution (αFamily x z) (βFamily x z)) q a‖) ≤
            K * x / (Real.log x) ^ A := by
    rcases hdist with ⟨rfl, hI, hII⟩ | ⟨rfl, hI, hII⟩ | ⟨rfl, hI, hII, hIII⟩
    · exact sourceTypeI_II_lowerOrder_dense_uniform_log_saving
        1 «ω» δ σdist hω hδ hσdist.1 (Or.inl ⟨rfl, hI⟩) hII
        MFamily NFamily αFamily βFamily c Cf W X0 40 2
        hc hCf hW hX0 hscaleFamily hsupportFamily hcoeffFamily hSWFamily A hAsave
    · exact sourceTypeI_II_lowerOrder_dense_uniform_log_saving
        2 «ω» δ σdist hω hδ hσdist.1 (Or.inr ⟨rfl, hI⟩) hII
        MFamily NFamily αFamily βFamily c Cf W X0 40 2
        hc hCf hW hX0 hscaleFamily hsupportFamily hcoeffFamily hSWFamily A hAsave
    · exact sourceTypeI_II_triply_dense_uniform_log_saving_of_deligne hDeligne
        «ω» δ σdist hω hδ hσdist.1 hI hII hIII
        MFamily NFamily αFamily βFamily c Cf W X0 40 2
        hc hCf hW hX0 hscaleFamily hsupportFamily hcoeffFamily hSWFamily A hAsave
  obtain ⟨K, X, hK, hXX0, hbound⟩ := hinput
  refine ⟨K, X, hK, hX0.trans hXX0, ?_⟩
  intro x hx Θ' t ht htten ν ι' Ni' β' hPlower hPupper
    S T hdisj hunion hSne hTne hPSlower hST I hI a ha
  let v : Params := (t, ν)
  have hslotEq (s : ιr) : slot x v s = β' s := by
    dsimp only [slot, tclip, v, β']
    rw [min_eq_left (htten s.1), max_eq_right (ht s.1)]
  let z : Index := (v, S, T)
  have hz : Active x z := ⟨hPlower, hPupper, hdisj, hunion, hSne, hTne, hPSlower, hST⟩
  have hfactor : finiteConvolution (αFamily x z) (βFamily x z) =
      (∏ i, slot x v i).coeff := by
    simp only [αFamily, βFamily, ite_eq_left hz]
    change ((∏ i ∈ T, slot x v i) * (∏ i ∈ S, slot x v i)).coeff =
      (∏ i, slot x v i).coeff
    apply congrArg (fun w : MonoidAlgebra ℂ ℕ => w.coeff)
    rw [← Finset.prod_union hdisj.symm, Finset.union_comm, hunion]
  simpa only [hfactor, hslotEq] using hbound x hx z I hI a ha

open Classical in
theorem sourceT3_three_smooth_slots_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (density : ℕ) (hdensity : 1 ≤ density) (D : ℕ) (hD : 1 ≤ D)
    («ω» δ σ C0 : ℝ) (hω : 0 < «ω») (hωupper : «ω» < 1 / 12)
    (hδ : 0 < δ) (hσhalf : σ < 1 / 2) (hC0 : 1 ≤ C0)
    (hσ : 1 / 18 + 28 / 9 * «ω» + 2 / 9 * δ < σ) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
        let Θ : ℝ := 1 + (Real.log x) ^ (-(D : ℝ))
        ∀ r : Fin 3 → Fin 5, ∀ t : Fin 3 → ℝ,
          (∀ c, 0 ≤ t c) → (∀ c, t c ≤ 10) →
        ∀ ν : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ,
          let ιr := Σ c : Fin 3, Fin (2 * ((r c).val + 1))
          let Ni : ιr → ℝ := fun s => Θ ^ ν s.1 s.2
          let β : ιr → MonoidAlgebra ℂ ℕ := fun s =>
            minorantHBLocalizedSlot ((r s.1).val + 1) (x ^ (9 / 100 : ℝ))
              Θ (t s.1) (ν s.1) s.2
          x / C0 ≤ (∏ s, Ni s) → (∏ s, Ni s) ≤ C0 * x →
          ∀ s₁ s₂ s₃ : ιr,
            s₁ ≠ s₂ → s₁ ≠ s₃ → s₂ ≠ s₃ →
            (r s₁.1).val + 1 ≤ s₁.2.val →
            (r s₂.1).val + 1 ≤ s₂.2.val →
            (r s₃.1).val + 1 ≤ s₃.2.val →
            x ^ (1 / 2 + σ) / C0 ≤ Ni s₁ * Ni s₂ →
            x ^ (1 / 2 + σ) / C0 ≤ Ni s₁ * Ni s₃ →
            x ^ (1 / 2 + σ) / C0 ≤ Ni s₂ * Ni s₃ →
            Ni s₁ ≤ C0 * x ^ (1 / 2 - σ) →
            Ni s₂ ≤ C0 * x ^ (1 / 2 - σ) →
            Ni s₃ ≤ C0 * x ^ (1 / 2 - σ) →
          ∀ P : Finset ℕ, (∀ p ∈ P, Nat.Prime p) →
          ∀ a : ℕ, Nat.Coprime a (∏ p ∈ P, p) →
            (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
                q ∣ (∏ p ∈ P, p) ∧
                  Nonempty (DenseDivisibilityWitness
                    ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩ density q)),
              ‖fullDiscrepancy (∏ s, β s).coeff q a‖) ≤
                K * x / (Real.log x) ^ A := by
  let C : ℝ := (2 : ℝ) ^ 30 * C0
  have hC0pos : 0 < C0 := zero_lt_one.trans_le hC0
  have hC0C : C0 ≤ C := by
    exact le_mul_of_one_le_left hC0pos.le (one_le_pow₀ (by norm_num))
  have hCtwo : 2 ≤ C := by
    have htwo : (2 : ℝ) ≤ (2 : ℝ) ^ 30 := by norm_num
    exact htwo.trans (le_mul_of_one_le_right (by positivity) hC0)
  have hC : 1 ≤ C := one_le_two.trans hCtwo
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  let ε : ℝ := min (1 / 100)
    (min ((3 * σ / 4 - 7 * «ω» / 3 - δ / 6 - 1 / 24) / 8)
      ((1 / 2 + δ - 6 * «ω») / 12))
  have hε : 0 < ε :=
    (typeIII_positive_smooth_convolution_global_log_saving_of_deligne
      hDeligne «ω» δ σ C 0 30 30 hω hωupper hδ hC hσ).1
  let κ : ℝ := ε / 4
  have hκ : 0 ≤ κ := (div_pos hε (by norm_num)).le
  let J : ℕ := Nat.ceil (22 / ε)
  let E : ℝ := ((D * (J + 2) + 1 : ℕ) : ℝ)
  obtain ⟨Cder, hCder, hprofiles⟩ := sourceT3_smooth_slot_profiles
  let Lder : ℝ := 3 * (1 + ∑ r ∈ Finset.range (J + 2 + 1), Cder r)
  have hLder : 0 < Lder := by
    have hsum : 0 ≤ ∑ r ∈ Finset.range (J + 2 + 1), Cder r :=
      Finset.sum_nonneg fun r _ => (hCder r).le
    dsimp only [Lder]
    positivity
  intro A hA
  obtain ⟨K0, X0, hK0, hX0, hglobal⟩ :=
    (typeIII_positive_smooth_convolution_global_log_saving_of_deligne
      hDeligne «ω» δ σ C E 30 30 hω hωupper hδ hC hσ).2
        ε hε le_rfl A hA
  refine ⟨K0 * ((4 : ℝ) ^ 30 * Lder * Lder * Lder), max X0 C0,
    by positivity, hX0.trans (le_max_left _ _), ?_⟩
  intro x hx Θ r t ht htten ν ιr Ni β hlo hhi i₁ i₂ i₃ h12 h13 h23 hi₁ hi₂ hi₃
    hpair12 hpair13 hpair23 hupper₁ hupper₂ hupper₃ I hI a ha
  have hx0 : X0 ≤ x := (le_max_left _ _).trans hx
  have hC0x : C0 ≤ x := (le_max_right _ _).trans hx
  have hxexp : Real.exp 1 ≤ x := hX0.trans hx0
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hxone : 1 ≤ x := (Real.one_le_exp (by norm_num)).trans hxexp
  have hlog : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hxexp
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlog
  have hΘ : 1 < Θ :=
    lt_add_of_pos_right 1 (Real.rpow_pos_of_pos hlogpos _)
  have hΘtwo : Θ ≤ 2 := by
    have hh : (Real.log x) ^ (-(D : ℝ)) ≤ 1 :=
      Real.rpow_le_one_of_one_le_of_nonpos hlog
        (neg_nonpos.mpr (by exact_mod_cast (Nat.zero_le 1).trans hD))
    change 1 + (Real.log x) ^ (-(D : ℝ)) ≤ 2
    linarith
  have hNi (i : ιr) : 1 ≤ Ni i := one_le_pow₀ hΘ.le
  have hNiupper (i : ιr) : Ni i ≤ x ^ 2 := by
    calc
      Ni i ≤ ∏ l, Ni l :=
        Multiset.mem_le_prod_of_one_le (s := Finset.univ.val) hNi (Finset.mem_univ i)
      _ ≤ C0 * x := hhi
      _ ≤ x * x := mul_le_mul_of_nonneg_right hC0x hxpos.le
      _ = x ^ 2 := (sq x).symm
  have hslotdata (s : ιr) :
      (∀ n ∈ (β s).coeff.support,
        Ni s / 2 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * Ni s) ∧
        ∀ n : ℕ, ‖(β s).coeff n‖ ≤ 1 + Real.log (n : ℝ) :=
    sourceT3_localized_slot_support_norm ((r s.1).val + 1)
      (x ^ (9 / 100 : ℝ)) Θ (t s.1) (ν s.1) s.2 hΘ hΘtwo (ht s.1)
  have hslots (s : ιr) : ∀ n ∈ (β s).coeff.support,
      Ni s / 2 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * Ni s := (hslotdata s).1
  have hslotnorm (s : ιr) (n : ℕ) : ‖(β s).coeff n‖ ≤ 4 * Real.log x := by
    by_cases hn : n ∈ (β s).coeff.support
    · have hNpos : 0 < Ni s := zero_lt_one.trans_le (hNi s)
      have hnpos : 0 < (n : ℝ) :=
        (div_pos hNpos zero_lt_two).trans_le (hslots s n hn).1
      have hlogN := Real.log_le_log hNpos (hNiupper s)
      rw [Real.log_pow x 2] at hlogN
      norm_num only [Nat.cast_ofNat] at hlogN
      have hlogn := Real.log_le_log hnpos (hslots s n hn).2
      rw [Real.log_mul two_ne_zero hNpos.ne'] at hlogn
      have hlog2 := Real.log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2)
      exact ((hslotdata s).2 n).trans (by linarith only [hlogn, hlogN, hlog2, hlog])
    · rw [Finsupp.notMem_support_iff.mp hn, norm_zero]
      linarith only [hlog]
  have hcardι : Fintype.card ιr = ∑ c : Fin 3, 2 * ((r c).val + 1) := by
    change Fintype.card (Σ c : Fin 3, Fin (2 * ((r c).val + 1))) = _
    rw [Fintype.card_sigma]
    simp only [Fintype.card_fin]
  have hcardLower : 6 ≤ Fintype.card ιr := by
    rw [hcardι]
    calc
      6 = ∑ _c : Fin 3, (2 : ℕ) := by norm_num
      _ ≤ ∑ c : Fin 3, 2 * ((r c).val + 1) :=
        Finset.sum_le_sum (fun c _ => by omega)
  have hcardUpper : Fintype.card ιr ≤ 30 := by
    rw [hcardι]
    calc
      (∑ c : Fin 3, 2 * ((r c).val + 1)) ≤ ∑ _c : Fin 3, (10 : ℕ) := by
        apply Finset.sum_le_sum
        intro c _
        have hc := (r c).isLt
        omega
      _ = 30 := by norm_num
  let T : Finset ιr := Finset.univ \ {i₁, i₂, i₃}
  have hselectedCard : ({i₁, i₂, i₃} : Finset ιr).card = 3 := by
    simp [h12, h13, h23]
  have hTcardEq : T.card + 3 = Fintype.card ιr := by
    simpa only [T, hselectedCard, Finset.card_univ] using
      Finset.card_sdiff_add_card_eq_card
        (Finset.subset_univ ({i₁, i₂, i₃} : Finset ιr))
  have hTne : T.Nonempty := by
    apply Finset.card_pos.mp
    omega
  have hTcard : T.card ≤ 30 := by omega
  let M : ℝ := ∏ i ∈ T, Ni i
  let α : ℕ →₀ ℂ := (∏ i ∈ T, β i).coeff
  have hM : 1 ≤ M := Finset.one_le_prod fun i _ => hNi i
  have hMpos : 0 < M := zero_lt_one.trans_le hM
  have hsplitN : (∏ i, Ni i) = M * (Ni i₁ * Ni i₂ * Ni i₃) := by
    simpa [M, T, h12, h13, h23, mul_assoc] using
      (Finset.prod_sdiff (f := Ni)
        (Finset.subset_univ ({i₁, i₂, i₃} : Finset (ιr)))).symm
  have hsplitβ : (∏ i, β i) = (∏ i ∈ T, β i) * (β i₁ * β i₂ * β i₃) := by
    simpa [T, h12, h13, h23, mul_assoc] using
      (Finset.prod_sdiff (f := β)
        (Finset.subset_univ ({i₁, i₂, i₃} : Finset (ιr)))).symm
  have hfactor : (∏ i, β i).coeff =
      finiteConvolution α (finiteConvolution (β i₁).coeff
        (finiteConvolution (β i₂).coeff (β i₃).coeff)) := by
    simpa only [finiteConvolution, α, MonoidAlgebra.ofCoeff_coeff, mul_assoc] using
      congrArg (fun v : MonoidAlgebra ℂ ℕ => v.coeff) hsplitβ
  obtain ⟨hαsupport, hαnorm⟩ :=
    heathBrown_box_product_support_norm_bound T hTne β Ni (4 * Real.log x)
      (by positivity) (fun i _ => hNi i) (fun i _ => hslots i) (fun i _ => hslotnorm i)
  change ∀ n ∈ α.support,
    M / (2 : ℝ) ^ T.card ≤ (n : ℝ) ∧ (n : ℝ) ≤ (2 : ℝ) ^ T.card * M at hαsupport
  change ∀ n, ‖α n‖ ≤ (4 * Real.log x) ^ T.card *
    (n.divisors.card : ℝ) ^ (T.card - 1) at hαnorm
  have htwoCard : (2 : ℝ) ^ T.card ≤ C :=
    (pow_le_pow_right₀ one_le_two hTcard).trans
      (le_mul_of_one_le_right (by positivity) hC0)
  have hαwindow (n : ℕ) (hn : n ∈ α.support) :
      M / C ≤ (n : ℝ) ∧ (n : ℝ) ≤ C * M :=
    ⟨(div_le_div_of_nonneg_left hMpos.le (pow_pos zero_lt_two _) htwoCard).trans
        (hαsupport n hn).1,
      (hαsupport n hn).2.trans (mul_le_mul_of_nonneg_right htwoCard hMpos.le)⟩
  have hαgrowth (n : ℕ) (hn : n ∈ α.support) :
      ‖α n‖ ≤ (4 : ℝ) ^ 30 * (n.divisors.card : ℝ) ^ 30 * (Real.log x) ^ (30 : ℝ) := by
    have hnpos : 0 < n := by
      exact_mod_cast (div_pos hMpos (pow_pos zero_lt_two T.card)).trans_le
        (hαsupport n hn).1
    have hτ : 1 ≤ (n.divisors.card : ℝ) := by
      exact_mod_cast Finset.one_le_card.mpr (Nat.nonempty_divisors.mpr hnpos.ne')
    have hFour : (4 : ℝ) ^ T.card ≤ (4 : ℝ) ^ 30 :=
      pow_le_pow_right₀ (by norm_num) hTcard
    have hL : (Real.log x) ^ T.card ≤ (Real.log x) ^ 30 :=
      pow_le_pow_right₀ hlog hTcard
    have hτpow : (n.divisors.card : ℝ) ^ (T.card - 1) ≤
        (n.divisors.card : ℝ) ^ 30 :=
      pow_le_pow_right₀ hτ ((Nat.sub_le _ _).trans hTcard)
    calc
      ‖α n‖ ≤ (4 * Real.log x) ^ T.card *
          (n.divisors.card : ℝ) ^ (T.card - 1) := hαnorm n
      _ = (4 : ℝ) ^ T.card * (Real.log x) ^ T.card *
          (n.divisors.card : ℝ) ^ (T.card - 1) := by rw [mul_pow]
      _ ≤ (4 : ℝ) ^ 30 * (Real.log x) ^ 30 * (n.divisors.card : ℝ) ^ 30 :=
        mul_le_mul
          (mul_le_mul hFour hL (pow_nonneg hlogpos.le _)
            (pow_nonneg (by norm_num : (0 : ℝ) ≤ 4) _)) hτpow
          (pow_nonneg (Nat.cast_nonneg _) _)
          (mul_nonneg (pow_nonneg (by norm_num : (0 : ℝ) ≤ 4) _)
            (pow_nonneg hlogpos.le _))
      _ = (4 : ℝ) ^ 30 * (n.divisors.card : ℝ) ^ 30 *
          (Real.log x) ^ (30 : ℝ) := by
        simpa only [Real.rpow_ofNat] using
          (mul_right_comm ((4 : ℝ) ^ (30 : ℕ)) ((Real.log x) ^ (30 : ℕ))
            ((n.divisors.card : ℝ) ^ (30 : ℕ)))
  obtain ⟨ψ₁, hψ₁, hsupp₁, hβ₁, hder₁⟩ :=
    hprofiles Θ hΘ hΘtwo ((r i₁.1).val + 1) (x ^ (9 / 100 : ℝ))
      (t i₁.1) (ν i₁.1) i₁.2 hi₁ (ht i₁.1) (htten i₁.1) C hCtwo
  obtain ⟨ψ₂, hψ₂, hsupp₂, hβ₂, hder₂⟩ :=
    hprofiles Θ hΘ hΘtwo ((r i₂.1).val + 1) (x ^ (9 / 100 : ℝ))
      (t i₂.1) (ν i₂.1) i₂.2 hi₂ (ht i₂.1) (htten i₂.1) C hCtwo
  obtain ⟨ψ₃, hψ₃, hsupp₃, hβ₃, hder₃⟩ :=
    hprofiles Θ hΘ hΘtwo ((r i₃.1).val + 1) (x ^ (9 / 100 : ℝ))
      (t i₃.1) (ν i₃.1) i₃.2 hi₃ (ht i₃.1) (htten i₃.1) C hCtwo
  change (β i₁).coeff = positiveCompactProfileSequence ψ₁ C (Ni i₁) 0 at hβ₁
  change (β i₂).coeff = positiveCompactProfileSequence ψ₂ C (Ni i₂) 0 at hβ₂
  change (β i₃).coeff = positiveCompactProfileSequence ψ₃ C (Ni i₃) 0 at hβ₃
  have hderivative (s : ιr) (ψ : ℝ → ℂ)
      (hh : ∀ ℓ u, ‖iteratedDeriv ℓ ψ u‖ ≤
        Cder ℓ * (1 + Real.log (Ni s)) / (Θ - 1) ^ ℓ) :
      ∀ ℓ : ℕ, ℓ ≤ J + 2 → ∀ u : ℝ,
        ‖iteratedDeriv ℓ ψ u‖ ≤ Lder * (Real.log x) ^ E := by
    simpa only [Lder, E, Real.rpow_natCast] using
      heathBrown_geometric_derivatives_log_bound Cder (fun ℓ => (hCder ℓ).le)
        D (J + 2) x (Ni s) hxexp (hNi s) (hNiupper s) ψ hh
  have hpair {u v : ℝ} (h : x ^ (1 / 2 + σ) / C0 ≤ u * v) :
      x ^ (1 / 2 + σ - κ) / C ≤ u * v := by
    calc
      x ^ (1 / 2 + σ - κ) / C ≤ x ^ (1 / 2 + σ) / C :=
        div_le_div_of_nonneg_right
          (Real.rpow_le_rpow_of_exponent_le hxone (by linarith)) hCpos.le
      _ ≤ x ^ (1 / 2 + σ) / C0 :=
        div_le_div_of_nonneg_left (Real.rpow_nonneg hxpos.le _) hC0pos hC0C
      _ ≤ u * v := h
  have hupper {u : ℝ} (h : u ≤ C0 * x ^ (1 / 2 - σ)) :
      u ≤ C * x ^ (1 / 2 - σ + κ) :=
    h.trans (mul_le_mul hC0C
      (Real.rpow_le_rpow_of_exponent_le hxone (by linarith))
      (zero_le_one.trans (Real.one_le_rpow hxone (sub_pos.mpr hσhalf).le)) hCpos.le)
  have htotalLower : x / C ≤ M * (Ni i₁ * Ni i₂ * Ni i₃) := by
    rw [← hsplitN]
    exact (div_le_div_of_nonneg_left hxpos.le hC0pos hC0C).trans hlo
  have htotalUpper : M * (Ni i₁ * Ni i₂ * Ni i₃) ≤ C * x := by
    rw [← hsplitN]
    exact hhi.trans (mul_le_mul_of_nonneg_right hC0C hxpos.le)
  let Y : Set.Ici (1 : ℝ) := ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩
  have hY : (Y : ℝ) = x ^ δ := max_eq_right (Real.one_le_rpow hxone hδ.le)
  let S : Finset ℕ := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
      q ∣ (∏ p ∈ I, p) ∧
        Nonempty (DenseDivisibilityWitness
          Y density q))
  change (∑ q ∈ S, ‖fullDiscrepancy (∏ i, β i).coeff q a‖) ≤
    (K0 * ((4 : ℝ) ^ 30 * Lder * Lder * Lder)) * x / (Real.log x) ^ A
  have hSdata (q : ℕ) (hq : q ∈ S) :
      1 ≤ q ∧ q ≤ ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊ ∧ q ∣ (∏ p ∈ I, p) ∧
        Nonempty (DenseDivisibilityWitness Y density q) := by
    change q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter
      (fun q => q ∣ (∏ p ∈ I, p) ∧
        Nonempty (DenseDivisibilityWitness Y density q)) at hq
    obtain ⟨hqIcc, hqdvd, hqdd⟩ := Finset.mem_filter.mp hq
    exact ⟨(Finset.mem_Icc.mp hqIcc).1, (Finset.mem_Icc.mp hqIcc).2, hqdvd, hqdd⟩
  let lift : {q // q ∈ S} → ℕ+ := fun q =>
    ⟨q.val, lt_of_lt_of_le Nat.zero_lt_one (hSdata q.val q.property).1⟩
  let Qset : Finset ℕ+ := S.attach.image lift
  have hlift : Function.Injective lift := by
    intro q r h
    apply Subtype.ext
    exact congrArg (fun z : ℕ+ => (z : ℕ)) h
  have hIcf : Squarefree (∏ p ∈ I, p) := by
    refine Finset.squarefree_prod_of_pairwise_isCoprime
      (fun p hp q hq hpq => ?_) (fun p hp => (hI p hp).squarefree)
    exact Nat.coprime_iff_isRelPrime.mp
      ((Nat.coprime_primes (hI p hp) (hI q hq)).2 hpq)
  have hQset (q : ℕ+) (hq : q ∈ Qset) :
      Squarefree (q : ℕ) ∧
      Nonempty (DenseDivisibilityWitness Y 1 (q : ℕ)) ∧
      (q : ℝ) ≤ C * x ^ (1 / 2 + 2 * «ω» + κ) := by
    rcases Finset.mem_image.mp hq with ⟨r, _, rfl⟩
    obtain ⟨_, hrupper, hrdvd, hrdd⟩ := hSdata r.val r.property
    refine ⟨hIcf.squarefree_of_dvd hrdvd,
      denseDivisibility_mono_order hrdd hdensity, ?_⟩
    calc
      ((lift r : ℕ+) : ℝ) = (r.val : ℝ) := rfl
      _ ≤ (⌊x ^ (1 / 2 + 2 * «ω»)⌋₊ : ℝ) := Nat.cast_le.mpr hrupper
      _ ≤ x ^ (1 / 2 + 2 * «ω») := Nat.floor_le (Real.rpow_nonneg hxpos.le _)
      _ ≤ x ^ (1 / 2 + 2 * «ω» + κ) :=
        Real.rpow_le_rpow_of_exponent_le hxone (by linarith)
      _ ≤ C * x ^ (1 / 2 + 2 * «ω» + κ) :=
        le_mul_of_one_le_left (Real.rpow_nonneg hxpos.le _) hC
  have haunit (q : ℕ+) (hq : q ∈ Qset) : IsUnit ((a : ℤ) : ZMod (q : ℕ)) := by
    rcases Finset.mem_image.mp hq with ⟨r, _, rfl⟩
    change IsUnit ((a : ℤ) : ZMod r.val)
    simpa only [Int.cast_natCast] using
      (ZMod.isUnit_iff_coprime a r.val).mpr
        (ha.of_dvd_right (hSdata r.val r.property).2.2.1)
  have hphysical := hglobal x hx0 M (Ni i₁) (Ni i₂) (Ni i₃)
    hM (hNi i₁) (hNi i₂) (hNi i₃) htotalLower htotalUpper
    (hpair hpair12) (hpair hpair13) (hpair hpair23)
    (hupper hupper₁) (hupper hupper₂) (hupper hupper₃)
    Y hY Qset hQset ((4 : ℝ) ^ 30) Lder Lder Lder
    (by positivity) hLder.le hLder.le hLder.le α hαwindow hαgrowth
    ψ₁ ψ₂ ψ₃ hψ₁ hψ₂ hψ₃ hsupp₁ hsupp₂ hsupp₃
    (hderivative i₁ ψ₁ hder₁) (hderivative i₂ ψ₂ hder₂) (hderivative i₃ ψ₃ hder₃)
    (a : ℤ) haunit
  have hf : finiteConvolution α
      (finiteConvolution (positiveCompactProfileSequence ψ₁ C (Ni i₁) 0)
        (finiteConvolution (positiveCompactProfileSequence ψ₂ C (Ni i₂) 0)
          (positiveCompactProfileSequence ψ₃ C (Ni i₃) 0))) =
        (∏ i, β i).coeff := by
    rw [← hβ₁, ← hβ₂, ← hβ₃, ← hfactor]
  rw [hf] at hphysical
  have hdisc (q : ℕ+) :
      ((∑ n ∈ (∏ i, β i).coeff.support,
          if (n : ZMod (q : ℕ)) = ((a : ℤ) : ZMod (q : ℕ)) then
            (∏ i, β i).coeff n else 0) -
        ((q : ℕ).totient : ℂ)⁻¹ *
          (∑ n ∈ (∏ i, β i).coeff.support,
            if Nat.Coprime n (q : ℕ) then (∏ i, β i).coeff n else 0)) =
        fullDiscrepancy (∏ i, β i).coeff (q : ℕ) a := by
    simp only [fullDiscrepancy, progressionMass, reducedMass, Int.cast_natCast,
      ZMod.natCast_eq_natCast_iff', div_eq_mul_inv, mul_comm]
  simp only [hdisc] at hphysical
  have hsum : (∑ q ∈ Qset, ‖fullDiscrepancy (∏ i, β i).coeff (q : ℕ) a‖) =
      ∑ q ∈ S, ‖fullDiscrepancy (∏ i, β i).coeff q a‖ := by
    change (∑ q ∈ S.attach.image lift,
      ‖fullDiscrepancy (∏ i, β i).coeff (q : ℕ) a‖) = _
    rw [Finset.sum_image hlift.injOn]
    exact Finset.sum_attach S (fun q => ‖fullDiscrepancy (∏ i, β i).coeff q a‖)
  rw [hsum] at hphysical
  exact hphysical

open Classical in
theorem sourceT3_coefficient_case_log_saving_of_deligne
    (τ : ℝ) (hτ : 0 < τ) (hτsmall : τ ≤ (1 / 10 ^ 10 : ℝ))
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (density : ℕ) (hdensity : 1 ≤ density) (orders : Fin 3 → Fin 5)
    (D : ℕ) (hD : 1 ≤ D) («ω» δ : ℝ)
    (hω : 0 < «ω») (hωupper : «ω» < 1 / 12) (hδ : 0 < δ) :
    let a : ℝ := 40481 / 100000
    let ζ : ℝ := 1 - 1058 / 3125 - a
    let σclass : ℝ := 1 / 2 - a + τ
    let γ₀ : ℝ := 1058 / 3125 - τ
    ∀ σdist σIII : ℝ, σclass < σdist → σdist < 1 / 2 →
      1 / 18 + 28 / 9 * «ω» + 2 / 9 * δ < σIII →
      σIII < 19 / 200 - τ →
      1 / 4 + 7 * «ω» + 2 * δ < γ₀ →
      ((density = 1 ∧ 54 * «ω» + 15 * δ + 5 * σdist < 1 ∧
          68 * «ω» + 14 * δ < 1) ∨
        (density = 2 ∧ 56 * «ω» + 16 * δ + 4 * σdist < 1 ∧
          68 * «ω» + 14 * δ < 1) ∨
        (density = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
          48 * «ω» + 16 * δ + 4 * σdist < 1 ∧
          64 * «ω» + 20 * δ + 2 * σdist < 1)) →
      ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
        ∀ x : ℝ, X ≤ x →
          let Θ : ℝ := 1 + (Real.log x) ^ (-(D : ℝ))
          ∀ t : Fin 3 → ℝ, (∀ c, 0 ≤ t c) → (∀ c, t c ≤ 10) →
          ∀ ν : (c : Fin 3) → Fin (2 * ((orders c).val + 1)) → ℕ,
            ν ∈ Fintype.piFinset (fun c : Fin 3 =>
              minorantHBBoxes ((orders c).val + 1)
                (x ^ (ζ - τ / 10)) (x ^ (a + τ / 10)) Θ) →
            let ιr := Σ c : Fin 3, Fin (2 * ((orders c).val + 1))
            let β : ιr → MonoidAlgebra ℂ ℕ := fun s =>
              minorantHBLocalizedSlot ((orders s.1).val + 1) (x ^ (9 / 100 : ℝ))
                Θ (t s.1) (ν s.1) s.2
            (∃ n : ℕ, x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 3 * x ∧
              (∏ s, β s).coeff n ≠ 0) →
            ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
            ∀ a₀ : ℕ, Nat.Coprime a₀ (∏ p ∈ I, p) →
              (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
                  q ∣ (∏ p ∈ I, p) ∧
                    Nonempty (DenseDivisibilityWitness
                      ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩ density q)),
                ‖fullDiscrepancy (∏ s, β s).coeff q a₀‖) ≤
                  K * x / (Real.log x) ^ A := by
  intro a ζ σclass γ₀ σdist σIII hσσ hσdistHalf hσIIIlo hσIIIhi hgap hdist
  have hmiddleGeometry :
      ∀ {ι : Type} [Fintype ι] [DecidableEq ι] (Ni : ι → ℝ) (x Cbase b : ℝ),
        (∀ i, 1 ≤ Ni i) → 1 < x → 1 < Cbase →
        2 * Cbase < x ^ b → x / Cbase ≤ ∏ i, Ni i →
        ∀ S : Finset ι,
          b ≤ ∑ i ∈ S, Real.logb x (Ni i) →
          (∑ i ∈ S, Real.logb x (Ni i)) ≤ 1 - b →
          ∃ S' T' : Finset ι,
            Disjoint S' T' ∧ S' ∪ T' = Finset.univ ∧
            S'.Nonempty ∧ T'.Nonempty ∧
            x ^ b / (2 * Cbase) < ∏ i ∈ S', Ni i ∧
            (∏ i ∈ S', Ni i) ≤ ∏ i ∈ T', Ni i := by
    intro ι _ _ Ni x Cbase b hNi hx hC hlarge hP S hSlo hShi
    classical
    have hxpos : 0 < x := zero_lt_one.trans hx
    have hCpos : 0 < Cbase := zero_lt_one.trans hC
    have hNpos (i : ι) : 0 < Ni i := zero_lt_one.trans_le (hNi i)
    let A : ℝ := ∏ i ∈ S, Ni i
    let B : ℝ := ∏ i ∈ Sᶜ, Ni i
    have hApos : 0 < A := Finset.prod_pos fun i _ => hNpos i
    have hBpos : 0 < B := Finset.prod_pos fun i _ => hNpos i
    have hprod : A * B = ∏ i, Ni i := Finset.prod_mul_prod_compl S Ni
    have hlog : Real.logb x A = ∑ i ∈ S, Real.logb x (Ni i) :=
      Real.logb_prod S Ni fun i _ => (hNpos i).ne'
    have hAlo : x ^ b ≤ A :=
      (Real.le_logb_iff_rpow_le hx hApos).mp (hSlo.trans_eq hlog.symm)
    have hAhi : A ≤ x ^ (1 - b) :=
      (Real.logb_le_iff_le_rpow hx hApos).mp (hlog.trans_le hShi)
    have hBbound : x ^ b / Cbase ≤ B := by
      apply (div_le_iff₀ hCpos).2
      apply (mul_le_mul_iff_left₀ (Real.rpow_pos_of_pos hxpos (1 - b))).1
      calc
        x ^ b * x ^ (1 - b) = x := by
          rw [← Real.rpow_add hxpos, show b + (1 - b) = 1 by ring, Real.rpow_one]
        _ ≤ (A * B) * Cbase := (div_le_iff₀ hCpos).1 (hP.trans_eq hprod.symm)
        _ ≤ (x ^ (1 - b) * B) * Cbase :=
          mul_le_mul_of_nonneg_right
            (mul_le_mul_of_nonneg_right hAhi hBpos.le) hCpos.le
        _ = (B * Cbase) * x ^ (1 - b) := by ring
    have hxbpos : 0 < x ^ b := Real.rpow_pos_of_pos hxpos b
    have hAbound : x ^ b / Cbase ≤ A :=
      (div_le_self hxbpos.le hC.le).trans hAlo
    have hstrict : x ^ b / (2 * Cbase) < x ^ b / Cbase :=
      div_lt_div_of_pos_left hxbpos hCpos (by linarith)
    have hAstrict : x ^ b / (2 * Cbase) < A := hstrict.trans_le hAbound
    have hBstrict : x ^ b / (2 * Cbase) < B := hstrict.trans_le hBbound
    have hthreshold : 1 < x ^ b / (2 * Cbase) :=
      (lt_div_iff₀ (mul_pos zero_lt_two hCpos)).2 (by simpa using hlarge)
    have hnonempty (U : Finset ι)
        (hU : x ^ b / (2 * Cbase) < ∏ i ∈ U, Ni i) : U.Nonempty := by
      apply Finset.nonempty_iff_ne_empty.mpr
      intro hUempty
      exact (lt_irrefl (1 : ℝ)) (by simpa [hUempty] using hthreshold.trans hU)
    rcases le_total A B with hAB | hBA
    · exact ⟨S, Sᶜ, disjoint_compl_right, Finset.union_compl S,
        hnonempty S hAstrict, hnonempty Sᶜ hBstrict, hAstrict, hAB⟩
    · refine ⟨Sᶜ, S, disjoint_compl_left, ?_,
        hnonempty Sᶜ hBstrict, hnonempty S hAstrict, hBstrict, hBA⟩
      simpa only [Finset.union_comm] using Finset.union_compl S
  let Cbase : ℝ := 3 * (2 : ℝ) ^ 30
  let C0 : ℝ := 2 * Cbase
  have hCbase : 1 < Cbase := by norm_num [Cbase]
  have hCbasepos : 0 < Cbase := zero_lt_one.trans hCbase
  have hC0 : 1 ≤ C0 := by norm_num [C0, Cbase]
  have hCbaseC0 : Cbase ≤ C0 := by dsimp only [C0]; linarith
  have hσclass : 0 < σclass := by dsimp only [σclass, a]; linarith only [hτ, hτsmall]
  have hσclassHalf : σclass < 1 / 2 := by dsimp only [σclass, a]; linarith only [hτ, hτsmall]
  have hγ₀ : 0 < γ₀ := by dsimp only [γ₀]; linarith only [hτ, hτsmall]
  have hγ₀hi : γ₀ ≤ 1 / 2 := by dsimp only [γ₀]; linarith only [hτ, hτsmall]
  have hσIIIhalf : σIII < 1 / 2 := by
    linarith only [hσIIIhi, hτ]
  have hb : 0 < a - τ := by dsimp only [a]; linarith only [hτ, hτsmall]
  obtain ⟨Xcase, hXcase, hcases⟩ :=
    minorantHB_three_unmasked_coefficient_cases τ hτ hτsmall
  obtain ⟨Xlarge, hlarge⟩ := Filter.eventually_atTop.1
    ((tendsto_rpow_atTop hb).eventually_gt_atTop C0)
  intro A hA
  obtain ⟨Kone, Xone, hKone, hXone, hone⟩ :=
    sourceT3_one_smooth_slot_log_saving density hdensity orders D hD
      «ω» δ γ₀ C0 hω hδ hγ₀ hγ₀hi hC0 hgap A hA
  obtain ⟨Kmid, Xmid, hKmid, _, hmid⟩ :=
    sourceT3_middle_slots_log_saving_of_deligne hDeligne density orders D hD
      «ω» δ σclass σdist C0 hω hδ hσclass hσclassHalf hσσ
      hσdistHalf hC0 hdist A hA
  obtain ⟨Kthree, Xthree, hKthree, _, hthree⟩ :=
    sourceT3_three_smooth_slots_log_saving_of_deligne hDeligne density hdensity D hD
      «ω» δ σIII C0 hω hωupper hδ hσIIIhalf hC0 hσIIIlo A hA
  refine ⟨Kone + Kmid + Kthree,
    max Xone (max Xmid (max Xthree (max Xcase Xlarge))), by positivity,
    hXone.trans (le_max_left _ _), ?_⟩
  intro x hx Θ t ht htten ν hν ιr β hactive I hI a₀ ha
  let Ni : ιr → ℝ := fun s => Θ ^ ν s.1 s.2
  have hxone : Xone ≤ x := (le_max_left _ _).trans hx
  have hxrest : max Xmid (max Xthree (max Xcase Xlarge)) ≤ x :=
    (le_max_right _ _).trans hx
  have hxmid : Xmid ≤ x := (le_max_left _ _).trans hxrest
  have hxrest' : max Xthree (max Xcase Xlarge) ≤ x :=
    (le_max_right _ _).trans hxrest
  have hxthree : Xthree ≤ x := (le_max_left _ _).trans hxrest'
  have hxlast : max Xcase Xlarge ≤ x := (le_max_right _ _).trans hxrest'
  have hxcase : Xcase ≤ x := (le_max_left _ _).trans hxlast
  have hxlarge : Xlarge ≤ x := (le_max_right _ _).trans hxlast
  have hxTwo : 2 ≤ x := hXcase.trans hxcase
  have hxOne : 1 < x := lt_of_lt_of_le (by norm_num : (1 : ℝ) < 2) hxTwo
  have hxpos : 0 < x := zero_lt_one.trans hxOne
  have hxexp : Real.exp 1 ≤ x := hXone.trans hxone
  have hlog : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hxexp
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlog
  have hΘ : 1 < Θ :=
    lt_add_of_pos_right 1 (Real.rpow_pos_of_pos hlogpos _)
  have hΘtwo : Θ ≤ 2 := by
    have hD0 : 0 ≤ (D : ℝ) := by exact_mod_cast (Nat.zero_le 1).trans hD
    have hh : (Real.log x) ^ (-(D : ℝ)) ≤ 1 :=
      Real.rpow_le_one_of_one_le_of_nonpos hlog (neg_nonpos.mpr hD0)
    change 1 + (Real.log x) ^ (-(D : ℝ)) ≤ 2
    linarith only [hh]
  have hNi (s : ιr) : 1 ≤ Ni s := one_le_pow₀ hΘ.le
  have hNipos (s : ιr) : 0 < Ni s := zero_lt_one.trans_le (hNi s)
  obtain ⟨n, hnlo, hnhi, hn⟩ := hactive
  obtain ⟨hcard30, hclass⟩ :=
    hcases x hxcase Θ hΘ hΘtwo orders t ht htten ν hν n hnlo hnhi hn
  let P : ℝ := ∏ s, Ni s
  have hPpos : 0 < P := Finset.prod_pos fun s _ => hNipos s
  have hslot (s : ιr) : ∀ m ∈ (β s).coeff.support,
      Ni s / 2 ≤ (m : ℝ) ∧ (m : ℝ) ≤ 2 * Ni s :=
    (sourceT3_localized_slot_support_norm ((orders s.1).val + 1)
      (x ^ (9 / 100 : ℝ)) Θ (t s.1) (ν s.1) s.2 hΘ hΘtwo (ht s.1)).1
  let Wslot : ℝ := ∑ s : ιr, ∑ m ∈ (β s).coeff.support, ‖(β s).coeff m‖
  have hWslot : 0 ≤ Wslot :=
    Finset.sum_nonneg fun s _ => Finset.sum_nonneg fun m _ => norm_nonneg _
  have hslotnorm (s : ιr) (m : ℕ) : ‖(β s).coeff m‖ ≤ Wslot := by
    have hlocal : ‖(β s).coeff m‖ ≤
        ∑ l ∈ (β s).coeff.support, ‖(β s).coeff l‖ := by
      simpa only [Finsupp.sum] using
        Finsupp.single_eval_le_sum (β s).coeff norm_zero norm_nonneg m
    exact hlocal.trans
      (Finset.single_le_sum
        (f := fun u : ιr => ∑ l ∈ (β u).coeff.support, ‖(β u).coeff l‖)
        (fun u _ => Finset.sum_nonneg fun l _ => norm_nonneg _) (Finset.mem_univ s))
  have huniv : (Finset.univ : Finset ιr).Nonempty :=
    ⟨⟨0, ⟨0, by omega⟩⟩, Finset.mem_univ _⟩
  have hsupport := (heathBrown_box_product_support_norm_bound
    Finset.univ huniv β Ni Wslot hWslot
      (fun s _ => hNi s) (fun s _ => hslot s) (fun s _ => hslotnorm s)).1
        n (Finsupp.mem_support_iff.mpr hn)
  change P / (2 : ℝ) ^ Fintype.card ιr ≤ (n : ℝ) ∧
    (n : ℝ) ≤ (2 : ℝ) ^ Fintype.card ιr * P at hsupport
  have hpow30 : (2 : ℝ) ^ Fintype.card ιr ≤ (2 : ℝ) ^ 30 :=
    pow_le_pow_right₀ one_le_two hcard30
  have hpowBase : (2 : ℝ) ^ Fintype.card ιr ≤ Cbase :=
    hpow30.trans (le_mul_of_one_le_left (pow_nonneg zero_le_two _)
      (by norm_num : (1 : ℝ) ≤ 3))
  have hPlower : x / Cbase ≤ P := by
    apply (div_le_iff₀ hCbasepos).2
    calc
      x ≤ (n : ℝ) := hnlo
      _ ≤ (2 : ℝ) ^ Fintype.card ιr * P := hsupport.2
      _ ≤ Cbase * P := mul_le_mul_of_nonneg_right hpowBase hPpos.le
      _ = P * Cbase := mul_comm _ _
  have hPupper : P ≤ Cbase * x := by
    calc
      P ≤ (n : ℝ) * (2 : ℝ) ^ Fintype.card ιr :=
        (div_le_iff₀ (pow_pos zero_lt_two _)).1 hsupport.1
      _ ≤ (3 * x) * (2 : ℝ) ^ 30 :=
        mul_le_mul hnhi hpow30 (pow_nonneg zero_le_two _) (by positivity)
      _ = Cbase * x := by dsimp only [Cbase]; ring
  have hPlower0 : x / C0 ≤ P :=
    (div_le_div_of_nonneg_left hxpos.le hCbasepos hCbaseC0).trans hPlower
  have hPupper0 : P ≤ C0 * x :=
    hPupper.trans (mul_le_mul_of_nonneg_right hCbaseC0 hxpos.le)
  have hslotUpper (s : ιr) : Ni s ≤ C0 * Real.sqrt x := by
    have hνc := Fintype.mem_piFinset.mp hν s.1
    dsimp only [minorantHBBoxes] at hνc
    have hboxUpper := (Finset.mem_filter.mp hνc).2.2
    have hslots : 2 * ((orders s.1).val + 1) ≤ 10 := by
      have hh := (orders s.1).isLt
      omega
    have hΘpow : Θ ^ (2 * ((orders s.1).val + 1)) ≤ (2 : ℝ) ^ 10 :=
      (pow_le_pow_left₀ (zero_lt_one.trans hΘ).le hΘtwo _).trans
        (pow_le_pow_right₀ one_le_two hslots)
    have hxpow : x ^ (a + τ / 10) ≤ x ^ (1 / 2 : ℝ) :=
      Real.rpow_le_rpow_of_exponent_le hxOne.le (by dsimp only [a]; linarith only [hτ, hτsmall])
    calc
      Ni s ≤ ∏ i : Fin (2 * ((orders s.1).val + 1)), Θ ^ ν s.1 i :=
        Multiset.mem_le_prod_of_one_le (s := Finset.univ.val)
          (fun i => one_le_pow₀ hΘ.le) (Finset.mem_univ s.2)
      _ ≤ x ^ (a + τ / 10) * Θ ^ (2 * ((orders s.1).val + 1)) := hboxUpper
      _ ≤ x ^ (1 / 2 : ℝ) * (2 : ℝ) ^ 10 :=
        mul_le_mul hxpow hΘpow (pow_nonneg (zero_lt_one.trans hΘ).le _)
          (Real.rpow_nonneg hxpos.le _)
      _ = (2 : ℝ) ^ 10 * Real.sqrt x := by rw [Real.sqrt_eq_rpow]; ring
      _ ≤ C0 * Real.sqrt x :=
        mul_le_mul_of_nonneg_right (by norm_num [C0, Cbase]) (Real.sqrt_nonneg x)
  let Err : ℝ :=
    ∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
        q ∣ (∏ p ∈ I, p) ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩ density q)),
      ‖fullDiscrepancy (∏ s, β s).coeff q a₀‖
  change Err ≤ (Kone + Kmid + Kthree) * x / (Real.log x) ^ A
  have hpromote (K : ℝ) (hK : K ≤ Kone + Kmid + Kthree)
      (h : Err ≤ K * x / (Real.log x) ^ A) :
      Err ≤ (Kone + Kmid + Kthree) * x / (Real.log x) ^ A :=
    h.trans (div_le_div_of_nonneg_right
      (mul_le_mul_of_nonneg_right hK hxpos.le) (Real.rpow_nonneg hlogpos.le A))
  rcases hclass with honeCase | hmidCase | hthreeCase
  · obtain ⟨s, hs, hscale⟩ := honeCase
    have hsLower : x ^ γ₀ ≤ Ni s :=
      (Real.le_logb_iff_rpow_le hxOne (hNipos s)).mp hscale
    exact hpromote Kone (by linarith only [hKmid, hKthree])
      (hone x hxone t ht htten ν hPlower0 hPupper0 s hs hsLower (hslotUpper s) I hI a₀ ha)
  · obtain ⟨S, hSlo, hShi⟩ := hmidCase
    have hShi' : (∑ s ∈ S, Real.logb x (Ni s)) ≤ 1 - (a - τ) := by
      have ha : (59519 / 100000 : ℝ) + τ = 1 - (a - τ) := by
        dsimp only [a]
        ring
      exact hShi.trans_eq ha
    obtain ⟨S', T', hdisj, hunion, hSne, hTne, hSmall, hST⟩ :=
      hmiddleGeometry Ni x Cbase (a - τ) hNi hxOne hCbase
        (hlarge x hxlarge) hPlower S hSlo hShi'
    have hSmall' : x ^ (1 / 2 - σclass) / C0 < ∏ s ∈ S', Ni s := by
      have he : (1 / 2 : ℝ) - σclass = a - τ := by
        dsimp only [σclass]
        ring
      simpa only [he, C0] using hSmall
    exact hpromote Kmid (by linarith only [hKone, hKthree])
      (hmid x hxmid t ht htten ν hPlower0 hPupper0 S' T' hdisj hunion hSne hTne
        hSmall' hST I hI a₀ ha)
  · obtain ⟨s₁, s₂, s₃, h12, h13, h23, hμ₁, hμ₂, hμ₃,
      hsize₁, hsize₂, hsize₃, hpair12, hpair13, hpair23⟩ := hthreeCase
    have hpair (s u : ιr)
        (hh : 119 / 200 - τ ≤ Real.logb x (Ni s) + Real.logb x (Ni u)) :
        x ^ (1 / 2 + σIII) / C0 ≤ Ni s * Ni u := by
      have hraw : x ^ (119 / 200 - τ) ≤ Ni s * Ni u :=
        (Real.le_logb_iff_rpow_le hxOne (mul_pos (hNipos s) (hNipos u))).mp (by
          rw [Real.logb_mul (hNipos s).ne' (hNipos u).ne']
          exact hh)
      calc
        x ^ (1 / 2 + σIII) / C0 ≤ x ^ (1 / 2 + σIII) :=
          div_le_self (Real.rpow_nonneg hxpos.le _) hC0
        _ ≤ x ^ (119 / 200 - τ) :=
          Real.rpow_le_rpow_of_exponent_le hxOne.le (by linarith only [hσIIIhi])
        _ ≤ Ni s * Ni u := hraw
    have hupper (s : ιr) (hh : Real.logb x (Ni s) ≤ 81 / 200 + τ) :
        Ni s ≤ C0 * x ^ (1 / 2 - σIII) := by
      calc
        Ni s ≤ x ^ (81 / 200 + τ) :=
          (Real.logb_le_iff_le_rpow hxOne (hNipos s)).mp hh
        _ ≤ x ^ (1 / 2 - σIII) :=
          Real.rpow_le_rpow_of_exponent_le hxOne.le (by linarith only [hσIIIhi])
        _ ≤ C0 * x ^ (1 / 2 - σIII) :=
          le_mul_of_one_le_left (Real.rpow_nonneg hxpos.le _) hC0
    exact hpromote Kthree (by linarith only [hKone, hKmid])
      (hthree x hxthree orders t ht htten ν hPlower0 hPupper0
        s₁ s₂ s₃ h12 h13 h23 hμ₁ hμ₂ hμ₃
        (hpair s₁ s₂ hpair12) (hpair s₁ s₃ hpair13) (hpair s₂ s₃ hpair23)
        (hupper s₁ hsize₁.2) (hupper s₂ hsize₂.2) (hupper s₃ hsize₃.2) I hI a₀ ha)

open Classical in
theorem sourceT3_selected_boxes_log_saving_of_deligne
    (τ : ℝ) (hτ : 0 < τ) (hτsmall : τ ≤ (1 / 10 ^ 10 : ℝ))
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (density : ℕ) (hdensity : 1 ≤ density)
    (D : ℕ) (hD : 1 ≤ D) («ω» δ : ℝ)
    (hω : 0 < «ω») (hωupper : «ω» < 1 / 12) (hδ : 0 < δ) :
    let a : ℝ := 40481 / 100000
    let ζ : ℝ := 1 - 1058 / 3125 - a
    let σclass : ℝ := 1 / 2 - a + τ
    let γ₀ : ℝ := 1058 / 3125 - τ
    ∀ σdist σIII : ℝ, σclass < σdist → σdist < 1 / 2 →
      1 / 18 + 28 / 9 * «ω» + 2 / 9 * δ < σIII →
      σIII < 19 / 200 - τ →
      1 / 4 + 7 * «ω» + 2 * δ < γ₀ →
      ((density = 1 ∧ 54 * «ω» + 15 * δ + 5 * σdist < 1 ∧
          68 * «ω» + 14 * δ < 1) ∨
        (density = 2 ∧ 56 * «ω» + 16 * δ + 4 * σdist < 1 ∧
          68 * «ω» + 14 * δ < 1) ∨
        (density = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
          48 * «ω» + 16 * δ + 4 * σdist < 1 ∧
          64 * «ω» + 20 * δ + 2 * σdist < 1)) →
      ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
        ∀ x : ℝ, X ≤ x →
          let Θ : ℝ := 1 + (Real.log x) ^ (-(D : ℝ))
          ∀ t : Fin 3 → ℝ, (∀ c, 0 ≤ t c) → (∀ c, t c ≤ 10) →
          ∀ Awin Bwin : Fin 3 → ℝ,
            (∀ c, x ^ (ζ - τ / 10) ≤ Awin c) →
            (∀ c, Awin c ≤ Bwin c) →
            (∀ c, Bwin c ≤ x ^ (a + τ / 10)) →
          let E : (r : Fin 3 → Fin 5) →
              Finset ((c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ) := fun r =>
            (Fintype.piFinset (fun c : Fin 3 =>
              minorantHBBoxes ((r c).val + 1)
                (Awin c) (Bwin c) Θ)).filter (fun ν =>
              x * Θ ^ 30 ≤ (∏ s : Σ c : Fin 3, Fin (2 * ((r c).val + 1)),
                Θ ^ ν s.1 s.2) ∧
              (∏ s : Σ c : Fin 3, Fin (2 * ((r c).val + 1)), Θ ^ ν s.1 s.2) *
                Θ ^ 30 ≤ 2 * x)
          let β : (r : Fin 3 → Fin 5) →
              ((c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ) →
              (Σ c : Fin 3, Fin (2 * ((r c).val + 1))) → MonoidAlgebra ℂ ℕ :=
            fun r ν s => minorantHBLocalizedSlot ((r s.1).val + 1)
              (x ^ (9 / 100 : ℝ)) Θ (t s.1) (ν s.1) s.2
          let selected : ℕ →₀ ℂ :=
            ∑ r : Fin 3 → Fin 5,
              (∏ c : Fin 3,
                (((-1 : ℝ) ^ (r c).val *
                  ((5 : ℕ).choose ((r c).val + 1) : ℝ) : ℝ) : ℂ)) •
                ∑ ν ∈ E r, (∏ s, β r ν s).coeff
          ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
          ∀ a₀ : ℕ, Nat.Coprime a₀ (∏ p ∈ I, p) →
            (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
                q ∣ (∏ p ∈ I, p) ∧
                  Nonempty (DenseDivisibilityWitness
                    ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩ density q)),
              ‖fullDiscrepancy selected q a₀‖) ≤
                K * x / (Real.log x) ^ A := by
  intro a ζ σclass γ₀ σdist σIII hσσ hσdistHalf hσIIIlo hσIIIhi hgap hdist A hA
  let loss : ℕ := 30 * (D + 1)
  let Abox : ℝ := A + loss
  have hAbox : 0 < Abox := add_pos_of_pos_of_nonneg hA (Nat.cast_nonneg loss)
  have hcases (r : Fin 3 → Fin 5) :=
    sourceT3_coefficient_case_log_saving_of_deligne τ hτ hτsmall
      hDeligne density hdensity r D hD «ω» δ hω hωupper hδ
      σdist σIII hσσ hσdistHalf hσIIIlo hσIIIhi hgap hdist Abox hAbox
  choose Kr Xr hKr hXr hcase using hcases
  let ar : (Fin 3 → Fin 5) → ℂ := fun r =>
    ∏ c : Fin 3, (((-1 : ℝ) ^ (r c).val *
      ((5 : ℕ).choose ((r c).val + 1) : ℝ) : ℝ) : ℂ)
  let Ksum : ℝ := 1 + ∑ r : Fin 3 → Fin 5, ‖ar r‖ * Kr r
  have hKsum : 0 < Ksum := by
    have hs : 0 ≤ ∑ r : Fin 3 → Fin 5, ‖ar r‖ * Kr r :=
      Finset.sum_nonneg fun r _ => mul_nonneg (norm_nonneg _) (hKr r).le
    dsimp only [Ksum]
    linarith only [hs]
  let Cgrid : ℝ := 125 * (8 : ℝ) ^ 30
  have hCgrid : 0 < Cgrid := by positivity
  let Xmax : ℝ := (Finset.univ : Finset (Fin 3 → Fin 5)).sup' Finset.univ_nonempty Xr
  have hXrmax (r : Fin 3 → Fin 5) : Xr r ≤ Xmax :=
    Finset.le_sup' Xr (Finset.mem_univ r)
  have hXmax : Real.exp 1 ≤ Xmax :=
    (hXr (fun _ => 0)).trans (hXrmax (fun _ => 0))
  refine ⟨Cgrid * Ksum, Xmax, mul_pos hCgrid hKsum, hXmax, ?_⟩
  intro x hx Θ t ht htten Awin Bwin hAwin hABwin hBwin E β selected I hI a₀ ha
  have hxexp : Real.exp 1 ≤ x := hXmax.trans hx
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hxone : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hxexp
  have hlog : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hxexp
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlog
  have hΘ : 1 < Θ := lt_add_of_pos_right 1 (Real.rpow_pos_of_pos hlogpos _)
  have hΘtwo : Θ ≤ 2 := by
    have hs : (Real.log x) ^ (-(D : ℝ)) ≤ 1 :=
      Real.rpow_le_one_of_one_le_of_nonpos hlog (neg_nonpos.mpr (Nat.cast_nonneg D))
    change 1 + (Real.log x) ^ (-(D : ℝ)) ≤ 2
    linarith only [hs]
  have hleft : 1 ≤ x ^ (ζ - τ / 10) :=
    Real.one_le_rpow hxone (by dsimp only [ζ, a]; linarith only [hτ, hτsmall])
  have hwindowLeft (c : Fin 3) : 1 ≤ Awin c := hleft.trans (hAwin c)
  have hboxesMono (c : Fin 3) (j : ℕ) :
      minorantHBBoxes j (Awin c) (Bwin c) Θ ⊆
        minorantHBBoxes j (x ^ (ζ - τ / 10)) (x ^ (a + τ / 10)) Θ := by
    have hBpos : 0 < Bwin c := (zero_lt_one.trans_le (hwindowLeft c)).trans_le (hABwin c)
    have hceil : ⌈Real.log (Bwin c) / Real.log Θ⌉₊ ≤
        ⌈Real.log (x ^ (a + τ / 10)) / Real.log Θ⌉₊ :=
      Nat.ceil_mono (div_le_div_of_nonneg_right
        (Real.log_le_log hBpos (hBwin c)) (Real.log_pos hΘ).le)
    intro ν hν
    dsimp only [minorantHBBoxes] at hν ⊢
    obtain ⟨hνgrid, hνlower, hνupper⟩ := Finset.mem_filter.mp hν
    refine Finset.mem_filter.mpr ⟨?_, ?_, ?_⟩
    · apply Fintype.mem_piFinset.mpr
      intro i
      exact Finset.mem_range.mpr
        ((Finset.mem_range.mp (Fintype.mem_piFinset.mp hνgrid i)).trans_le
          (Nat.add_le_add_right hceil 1))
    · exact (div_le_div_of_nonneg_right (hAwin c)
        (pow_nonneg (zero_lt_one.trans hΘ).le _)).trans hνlower
    · exact hνupper.trans (mul_le_mul_of_nonneg_right (hBwin c)
        (pow_nonneg (zero_lt_one.trans hΘ).le _))
  have hEwide (r : Fin 3 → Fin 5) : E r ⊆
      Fintype.piFinset (fun c : Fin 3 => minorantHBBoxes ((r c).val + 1)
        (x ^ (ζ - τ / 10)) (x ^ (a + τ / 10)) Θ) := by
    intro ν hν
    have hνbox := (Finset.mem_filter.mp hν).1
    exact Fintype.mem_piFinset.mpr fun c =>
      hboxesMono c ((r c).val + 1) (Fintype.mem_piFinset.mp hνbox c)
  let Q : Finset ℕ := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
    q ∣ (∏ p ∈ I, p) ∧ Nonempty (DenseDivisibilityWitness
      ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩ density q))
  have hbox (r : Fin 3 → Fin 5)
      (ν : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ) (hν : ν ∈ E r) :
      (∑ q ∈ Q, ‖fullDiscrepancy (∏ s, β r ν s).coeff q a₀‖) ≤
        Kr r * x / (Real.log x) ^ Abox := by
    obtain ⟨hνbox, hradial⟩ := Finset.mem_filter.mp hν
    by_cases hzero : (∏ s, β r ν s).coeff = 0
    · simp only [hzero, fullDiscrepancy, progressionMass, reducedMass,
        Finsupp.support_zero, Finset.sum_empty, zero_div, sub_zero,
        norm_zero, Finset.sum_const_zero]
      exact div_nonneg (mul_nonneg (hKr r).le hxpos.le)
        (Real.rpow_nonneg hlogpos.le _)
    · obtain ⟨n, hn⟩ := Finsupp.support_nonempty_iff.mpr hzero
      have hs := minorantHB_three_radial_selected_support
        Awin Bwin t (x ^ (9 / 100 : ℝ)) Θ x hwindowLeft hABwin
        hΘ hΘtwo ht htten r ν hνbox hradial.1 hradial.2 n hn
      exact hcase r x ((hXrmax r).trans hx) t ht htten ν (hEwide r hν)
        ⟨n, hs.1, hs.2.trans (by linarith only [hxpos]),
          Finsupp.mem_support_iff.mp hn⟩ I hI a₀ ha
  let M : ℕ := ⌈Real.log (2 * x) / Real.log Θ⌉₊
  have hMmono :
      ⌈Real.log (x ^ (a + τ / 10)) / Real.log Θ⌉₊ ≤ M := by
    apply Nat.ceil_mono
    apply div_le_div_of_nonneg_right _ (Real.log_pos hΘ).le
    apply Real.log_le_log (Real.rpow_pos_of_pos hxpos _)
    exact (Real.rpow_le_rpow_of_exponent_le hxone
      (by dsimp only [a]; linarith only [hτ, hτsmall] : a + τ / 10 ≤ (1 : ℝ))).trans
        (by rw [Real.rpow_one]; linarith only [hxpos])
  have hgrid : (((M + 1 : ℕ) : ℝ) ^ 30) ≤
      (8 : ℝ) ^ 30 * (Real.log x) ^ loss := by
    have hg := heathBrown_geometric_grid_card_bound 30 D x hxexp
    simpa only [Fintype.card_piFinset, Finset.card_range, Finset.prod_const,
      Finset.card_univ, Fintype.card_fin, Nat.cast_pow, M, loss] using hg
  have hcard (r : Fin 3 → Fin 5) :
      ((E r).card : ℝ) ≤ Cgrid * (Real.log x) ^ loss := by
    have htotal := minorantHB_three_box_count
      (x ^ (ζ - τ / 10)) (x ^ (a + τ / 10)) Θ
    have hsingle :
        (Fintype.piFinset (fun c : Fin 3 =>
          minorantHBBoxes ((r c).val + 1)
            (x ^ (ζ - τ / 10)) (x ^ (a + τ / 10)) Θ)).card ≤
          125 * (⌈Real.log (x ^ (a + τ / 10)) / Real.log Θ⌉₊ + 1) ^ 30 :=
      (Finset.single_le_sum (fun _ _ => Nat.zero_le _) (Finset.mem_univ r)).trans htotal
    have hncard : (E r).card ≤ 125 * (M + 1) ^ 30 :=
      (Finset.card_le_card (hEwide r)).trans (hsingle.trans
        (Nat.mul_le_mul_left 125 (pow_le_pow_left₀ (Nat.zero_le _)
          (Nat.add_le_add_right hMmono 1) 30)))
    have hrcard : ((E r).card : ℝ) ≤ 125 * (((M + 1 : ℕ) : ℝ) ^ 30) := by
      exact_mod_cast hncard
    exact hrcard.trans (by
      calc
        125 * (((M + 1 : ℕ) : ℝ) ^ 30) ≤
            125 * ((8 : ℝ) ^ 30 * (Real.log x) ^ loss) :=
          mul_le_mul_of_nonneg_left hgrid (by norm_num)
        _ = Cgrid * (Real.log x) ^ loss := by dsimp only [Cgrid]; ring)
  have hcancel : (Real.log x) ^ loss / (Real.log x) ^ Abox =
      1 / (Real.log x) ^ A := by
    dsimp only [Abox]
    rw [Real.rpow_add hlogpos, Real.rpow_natCast]
    simpa only [one_mul] using mul_div_mul_right (1 : ℝ)
      ((Real.log x) ^ A) (pow_ne_zero loss hlogpos.ne')
  have hsumBoxes (r : Fin 3 → Fin 5) :
      (∑ ν ∈ E r, ∑ q ∈ Q, ‖fullDiscrepancy (∏ s, β r ν s).coeff q a₀‖) ≤
        Cgrid * Kr r * x / (Real.log x) ^ A := by
    calc
      _ ≤ ((E r).card : ℝ) * (Kr r * x / (Real.log x) ^ Abox) := by
        simpa only [nsmul_eq_mul] using
          Finset.sum_le_card_nsmul (E r)
            (fun ν => ∑ q ∈ Q, ‖fullDiscrepancy (∏ s, β r ν s).coeff q a₀‖)
            (Kr r * x / (Real.log x) ^ Abox) (hbox r)
      _ ≤ (Cgrid * (Real.log x) ^ loss) *
          (Kr r * x / (Real.log x) ^ Abox) :=
        mul_le_mul_of_nonneg_right (hcard r)
          (div_nonneg (mul_nonneg (hKr r).le hxpos.le) (Real.rpow_nonneg hlogpos.le _))
      _ = (Cgrid * Kr r * x) *
          ((Real.log x) ^ loss / (Real.log x) ^ Abox) := by ring
      _ = Cgrid * Kr r * x / (Real.log x) ^ A := by rw [hcancel]; ring
  let Ldisc : ℕ → (ℕ →₀ ℂ) →ₗ[ℂ] ℂ := fun q =>
    Finsupp.linearCombination ℂ (fun n : ℕ =>
      (if n % q = a₀ % q then (1 : ℂ) else 0) -
        (if Nat.Coprime n q then (1 : ℂ) else 0) / (q.totient : ℂ))
  have hLdisc (q : ℕ) (f : ℕ →₀ ℂ) : Ldisc q f = fullDiscrepancy f q a₀ := by
    simp only [Ldisc, Finsupp.linearCombination_apply, Finsupp.sum, smul_eq_mul,
      fullDiscrepancy, progressionMass, reducedMass, mul_sub, mul_div, mul_ite,
      mul_one, mul_zero, Finset.sum_sub_distrib, Finset.sum_div]
  have hselected (q : ℕ) :
      fullDiscrepancy selected q a₀ =
        ∑ r : Fin 3 → Fin 5, ar r *
          ∑ ν ∈ E r, fullDiscrepancy (∏ s, β r ν s).coeff q a₀ := by
    rw [← hLdisc q selected]
    simp only [selected, map_sum, map_smul, smul_eq_mul]
    simp only [hLdisc, ar]
  have hnormsum :
      (∑ q ∈ Q, ‖fullDiscrepancy selected q a₀‖) ≤
        ∑ r : Fin 3 → Fin 5, ‖ar r‖ *
          ∑ ν ∈ E r, ∑ q ∈ Q, ‖fullDiscrepancy (∏ s, β r ν s).coeff q a₀‖ := by
    calc
      _ ≤ ∑ q ∈ Q, ∑ r : Fin 3 → Fin 5, ‖ar r‖ *
          ∑ ν ∈ E r, ‖fullDiscrepancy (∏ s, β r ν s).coeff q a₀‖ := by
        apply Finset.sum_le_sum
        intro q _
        rw [hselected]
        refine norm_sum_le_of_le _ fun r _ => ?_
        rw [norm_mul]
        exact mul_le_mul_of_nonneg_left (norm_sum_le _ _) (norm_nonneg _)
      _ = ∑ r : Fin 3 → Fin 5, ‖ar r‖ *
          ∑ ν ∈ E r, ∑ q ∈ Q, ‖fullDiscrepancy (∏ s, β r ν s).coeff q a₀‖ := by
        rw [Finset.sum_comm]
        apply Finset.sum_congr rfl
        intro r _
        rw [← Finset.mul_sum, Finset.sum_comm]
  change (∑ q ∈ Q, ‖fullDiscrepancy selected q a₀‖) ≤
    (Cgrid * Ksum) * x / (Real.log x) ^ A
  calc
    _ ≤ ∑ r : Fin 3 → Fin 5, ‖ar r‖ *
        (Cgrid * Kr r * x / (Real.log x) ^ A) :=
      hnormsum.trans (Finset.sum_le_sum fun r _ =>
        mul_le_mul_of_nonneg_left (hsumBoxes r) (norm_nonneg _))
    _ = Cgrid * (∑ r : Fin 3 → Fin 5, ‖ar r‖ * Kr r) * x /
        (Real.log x) ^ A := by
      simp only [Finset.mul_sum, Finset.sum_mul, Finset.sum_div,
        mul_div_assoc, mul_left_comm, mul_assoc]
    _ ≤ (Cgrid * Ksum) * x / (Real.log x) ^ A :=
      div_le_div_of_nonneg_right
        (mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left (le_add_of_nonneg_left zero_le_one) hCgrid.le)
          hxpos.le) (Real.rpow_nonneg hlogpos.le _)

end

open Classical in
theorem sourceT3_scalar_retreat
    (τ : ℝ) (hτ : 0 < τ) (hτsmall : τ ≤ (1 / 10 ^ 10 : ℝ))
    (density : ℕ) («ω» δ : ℝ) (hω : 0 < «ω») (hδ : 0 < δ) :
    let a : ℝ := 40481 / 100000
    let σclass : ℝ := 1 / 2 - a + τ
    let γ₀ : ℝ := 1058 / 3125 - τ
    (1 / 2 + 2 * «ω» < 59519 / 100000 - τ) →
    (1 / 4 + 7 * «ω» + 2 * δ < γ₀) →
    (1 / 18 + 28 / 9 * «ω» + 2 / 9 * δ < 19 / 200 - τ) →
    ((density = 1 ∧ 54 * «ω» + 15 * δ + 5 * σclass < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (density = 2 ∧ 56 * «ω» + 16 * δ + 4 * σclass < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (density = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σclass < 1 ∧ 64 * «ω» + 20 * δ + 2 * σclass < 1)) →
    ∀ L0 : ℝ → ℝ, (∀ x, 0 < L0 x) →
      Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x) atTop (nhds 0) →
    ∃ ω' δ' σdist σIII : ℝ,
      «ω» < ω' ∧ δ < δ' ∧ 0 < ω' ∧ ω' < 1 / 12 ∧ 0 < δ' ∧
      σclass < σdist ∧ σdist < 1 / 2 ∧
      1 / 18 + 28 / 9 * ω' + 2 / 9 * δ' < σIII ∧ σIII < 19 / 200 - τ ∧
      1 / 2 + 2 * ω' < 59519 / 100000 - τ ∧
      1 / 4 + 7 * ω' + 2 * δ' < γ₀ ∧
      ((density = 1 ∧ 54 * ω' + 15 * δ' + 5 * σdist < 1 ∧ 68 * ω' + 14 * δ' < 1) ∨
        (density = 2 ∧ 56 * ω' + 16 * δ' + 4 * σdist < 1 ∧ 68 * ω' + 14 * δ' < 1) ∨
        (density = 3 ∧ 72 * ω' + 24 * δ' < 1 ∧
          48 * ω' + 16 * δ' + 4 * σdist < 1 ∧ 64 * ω' + 20 * δ' + 2 * σdist < 1)) ∧
      ∀ᶠ x : ℝ in atTop, Real.exp 1 ≤ x ∧
        x ^ (1 / 2 + 2 * «ω») * L0 x ≤ x ^ (1 / 2 + 2 * ω') ∧
        ∀ Y : Set.Ici (1 : ℝ), (Y : ℝ) = x ^ δ → ∀ I : Finset ℕ,
          (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter (fun q =>
              q ∣ (∏ p ∈ I, p) ∧
                Nonempty (DenseDivisibilityWitness Y density q)) ⊆
            (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * ω')⌋₊).filter (fun q =>
              q ∣ (∏ p ∈ I, p) ∧
                Nonempty (DenseDivisibilityWitness
                  ⟨max 1 (x ^ δ'), by exact le_max_left (1 : ℝ) (x ^ δ')⟩ density q)) := by
  intro a σclass γ₀ hlevel hsmooth hthree hdist L0 hL0 hL0sub
  have hσhalf : σclass < 1 / 2 := by dsimp only [σclass, a]; linarith only [hτ, hτsmall]
  let Good : Set ℝ := {e |
    1 / 2 + 2 * («ω» + e) < 59519 / 100000 - τ ∧
    1 / 4 + 7 * («ω» + e) + 2 * (δ + e) < γ₀ ∧
    1 / 18 + 28 / 9 * («ω» + e) + 2 / 9 * (δ + e) < 19 / 200 - τ ∧
    σclass + e < 1 / 2 ∧
    ((density = 1 ∧ 54 * («ω» + e) + 15 * (δ + e) + 5 * (σclass + e) < 1 ∧
        68 * («ω» + e) + 14 * (δ + e) < 1) ∨
      (density = 2 ∧ 56 * («ω» + e) + 16 * (δ + e) + 4 * (σclass + e) < 1 ∧
        68 * («ω» + e) + 14 * (δ + e) < 1) ∨
      (density = 3 ∧ 72 * («ω» + e) + 24 * (δ + e) < 1 ∧
        48 * («ω» + e) + 16 * (δ + e) + 4 * (σclass + e) < 1 ∧
        64 * («ω» + e) + 20 * (δ + e) + 2 * (σclass + e) < 1))}
  have hI1open : IsOpen {e : ℝ |
      density = 1 ∧ 54 * («ω» + e) + 15 * (δ + e) + 5 * (σclass + e) < 1 ∧
        68 * («ω» + e) + 14 * (δ + e) < 1} :=
    isOpen_const.inter ((isOpen_lt
      (show Continuous (fun e : ℝ => 54 * («ω» + e) + 15 * (δ + e) + 5 * (σclass + e))
        from by fun_prop) continuous_const).inter
      (isOpen_lt (show Continuous (fun e : ℝ => 68 * («ω» + e) + 14 * (δ + e))
        from by fun_prop) continuous_const))
  have hI2open : IsOpen {e : ℝ |
      density = 2 ∧ 56 * («ω» + e) + 16 * (δ + e) + 4 * (σclass + e) < 1 ∧
        68 * («ω» + e) + 14 * (δ + e) < 1} :=
    isOpen_const.inter ((isOpen_lt
      (show Continuous (fun e : ℝ => 56 * («ω» + e) + 16 * (δ + e) + 4 * (σclass + e))
        from by fun_prop) continuous_const).inter
      (isOpen_lt (show Continuous (fun e : ℝ => 68 * («ω» + e) + 14 * (δ + e))
        from by fun_prop) continuous_const))
  have hI3open : IsOpen {e : ℝ |
      density = 3 ∧ 72 * («ω» + e) + 24 * (δ + e) < 1 ∧
        48 * («ω» + e) + 16 * (δ + e) + 4 * (σclass + e) < 1 ∧
        64 * («ω» + e) + 20 * (δ + e) + 2 * (σclass + e) < 1} :=
    isOpen_const.inter ((isOpen_lt
      (show Continuous (fun e : ℝ => 72 * («ω» + e) + 24 * (δ + e))
        from by fun_prop) continuous_const).inter
      ((isOpen_lt
        (show Continuous (fun e : ℝ => 48 * («ω» + e) + 16 * (δ + e) + 4 * (σclass + e))
          from by fun_prop) continuous_const).inter
        (isOpen_lt
          (show Continuous (fun e : ℝ => 64 * («ω» + e) + 20 * (δ + e) + 2 * (σclass + e))
            from by fun_prop) continuous_const)))
  have hopen : IsOpen Good :=
    (isOpen_lt (show Continuous (fun e : ℝ => 1 / 2 + 2 * («ω» + e))
      from by fun_prop) continuous_const).inter
      ((isOpen_lt
        (show Continuous (fun e : ℝ => 1 / 4 + 7 * («ω» + e) + 2 * (δ + e))
          from by fun_prop) continuous_const).inter
        ((isOpen_lt
          (show Continuous (fun e : ℝ => 1 / 18 + 28 / 9 * («ω» + e) + 2 / 9 * (δ + e))
            from by fun_prop) continuous_const).inter
          ((isOpen_lt (show Continuous (fun e : ℝ => σclass + e)
            from by fun_prop) continuous_const).inter
            (hI1open.union (hI2open.union hI3open)))))
  have hzero : (0 : ℝ) ∈ Good := by
    simpa only [Good, add_zero, Set.mem_ofPred_eq] using
      And.intro hlevel (And.intro hsmooth (And.intro hthree (And.intro hσhalf hdist)))
  obtain ⟨ε, hε, hball⟩ := Metric.isOpen_iff.mp hopen 0 hzero
  let e : ℝ := ε / 2
  have he : 0 < e := div_pos hε zero_lt_two
  have heBall : e ∈ Metric.ball (0 : ℝ) ε := by
    rw [Metric.mem_ball, Real.dist_eq, sub_zero, abs_of_pos he]
    dsimp only [e]
    linarith only [hε]
  obtain ⟨hlevel', hsmooth', hthree', hσdistHalf, hdist'⟩ := hball heBall
  let ω' : ℝ := «ω» + e
  let δ' : ℝ := δ + e
  let σdist : ℝ := σclass + e
  let σlo : ℝ := 1 / 18 + 28 / 9 * ω' + 2 / 9 * δ'
  let σIII : ℝ := (σlo + (19 / 200 - τ)) / 2
  have hωretreat : «ω» < ω' := lt_add_of_pos_right _ he
  have hδretreat : δ < δ' := lt_add_of_pos_right _ he
  have hω' : 0 < ω' := hω.trans hωretreat
  have hδ' : 0 < δ' := hδ.trans hδretreat
  have hσretreat : σclass < σdist := lt_add_of_pos_right _ he
  have hωupper : ω' < 1 / 12 := by
    have hγhalf : γ₀ ≤ 1 / 2 := by dsimp only [γ₀]; linarith only [hτ, hτsmall]
    change 1 / 4 + 7 * ω' + 2 * δ' < γ₀ at hsmooth'
    linarith only [hsmooth', hδ', hγhalf]
  have hσIIIlo : σlo < σIII := by
    change σlo < 19 / 200 - τ at hthree'
    dsimp only [σIII]
    linarith only [hthree']
  have hσIIIhi : σIII < 19 / 200 - τ := by
    change σlo < 19 / 200 - τ at hthree'
    dsimp only [σIII]
    linarith only [hthree']
  refine ⟨ω', δ', σdist, σIII, hωretreat, hδretreat, hω', hωupper, hδ',
    hσretreat, hσdistHalf, hσIIIlo, hσIIIhi, hlevel', hsmooth', hdist', ?_⟩
  have hsmall := (tendsto_order.mp hL0sub).2 e he
  filter_upwards [hsmall, Filter.eventually_ge_atTop (Real.exp 1)] with x hxsmall hxexp
  have hxone : 1 < x :=
    (Real.one_lt_exp_iff.mpr zero_lt_one).trans_le hxexp
  have hxpos : 0 < x := zero_lt_one.trans hxone
  have hLbound : L0 x ≤ x ^ e := by
    apply (Real.log_le_log_iff (hL0 x) (Real.rpow_pos_of_pos hxpos e)).mp
    rw [Real.log_rpow hxpos]
    exact ((div_lt_iff₀ (Real.log_pos hxone)).mp hxsmall).le
  have hcutoff : x ^ (1 / 2 + 2 * «ω») * L0 x ≤ x ^ (1 / 2 + 2 * ω') := by
    calc
      x ^ (1 / 2 + 2 * «ω») * L0 x ≤ x ^ (1 / 2 + 2 * «ω») * x ^ e :=
        mul_le_mul_of_nonneg_left hLbound (Real.rpow_nonneg hxpos.le _)
      _ = x ^ ((1 / 2 + 2 * «ω») + e) := (Real.rpow_add hxpos _ _).symm
      _ ≤ x ^ (1 / 2 + 2 * ω') :=
        Real.rpow_le_rpow_of_exponent_le hxone.le (by dsimp only [ω']; linarith only [he])
  refine ⟨hxexp, hcutoff, ?_⟩
  intro Y hY I q hq
  obtain ⟨hqrange, hqdvd, hqdd⟩ := Finset.mem_filter.mp hq
  have hYscale : (Y : ℝ) ≤ max 1 (x ^ δ') := by
    rw [hY]
    exact (Real.rpow_le_rpow_of_exponent_le hxone.le hδretreat.le).trans (le_max_right _ _)
  refine Finset.mem_filter.mpr ⟨?_, hqdvd, ?_⟩
  · exact Finset.mem_Icc.mpr ⟨(Finset.mem_Icc.mp hqrange).1,
      (Finset.mem_Icc.mp hqrange).2.trans (Nat.floor_mono hcutoff)⟩
  · exact denseDivisibility_mono_scale hYscale hqdd

/--
The Möbius function restricted to integers whose largest prime factor, with the empty case
replaced by `1`, is strictly less than `z`.
-/
noncomputable def smallPrimeMobius (z : ℝ) : ArithmeticFunction ℝ := by
  classical
  exact ⟨fun d =>
    if ((max 1 (d.primeFactors.sup id) : ℕ) : ℝ) < z then
      (ArithmeticFunction.moebius d : ℝ) else 0, by simp⟩

/--
The Dirichlet convolution of `u`, `v`, and the small-prime Möbius function, cut off at the real
upper bound `M0`.
-/
noncomputable def harmanA0 (u v : ArithmeticFunction ℝ)
    (z M0 : ℝ) : ArithmeticFunction ℝ := by
  classical
  exact ⟨fun m =>
    if (m : ℝ) ≤ M0 then (u * v * smallPrimeMobius z) m else 0, by simp⟩

theorem roughWeight_eq_smallPrimeMobius_mul_zeta
    (z : ℝ) (hz : 1 < z) :
    roughWeight z = smallPrimeMobius z *
      (ArithmeticFunction.zeta : ArithmeticFunction ℝ) := by
  classical
  have hceil : 0 < Nat.ceil z := Nat.ceil_pos.mpr (lt_trans zero_lt_one hz)
  let P := primorial (Nat.ceil z - 1)
  have hP : P ≠ 0 := primorial_ne_zero _
  have hprime (p : ℕ) (hp : p.Prime) : p ∣ P ↔ (p : ℝ) < z := by
    rw [hp.dvd_primorial_iff, Nat.le_sub_one_iff_lt hceil, Nat.lt_ceil]
  have hcut (d : ℕ) :
      ((max 1 (d.primeFactors.sup id) : ℕ) : ℝ) < z ↔
        ∀ p ∈ d.primeFactors, (p : ℝ) < z := by
    rw [← Nat.lt_ceil, max_lt_iff, Finset.sup_lt_iff hceil]
    simp only [id_eq, Nat.lt_ceil, Nat.cast_one, hz, true_and]
  have hdivP (d : ℕ) (hd : Squarefree d) :
      d ∣ P ↔ ∀ p ∈ d.primeFactors, (p : ℝ) < z := by
    constructor
    · intro h p hp
      exact (hprime p (Nat.prime_of_mem_primeFactors hp)).mp
        ((Nat.dvd_of_mem_primeFactors hp).trans h)
    · intro h
      rw [← Nat.prod_primeFactors_of_squarefree hd]
      apply (Nat.prod_primeFactors_dvd_iff hP).mpr
      intro p hp
      exact Nat.mem_primeFactors.mpr ⟨Nat.prime_of_mem_primeFactors hp,
        (hprime p (Nat.prime_of_mem_primeFactors hp)).mpr (h p hp), hP⟩
  have hpoint (d : ℕ) : smallPrimeMobius z d =
      if d ∣ P then (ArithmeticFunction.moebius d : ℝ) else 0 := by
    change (if ((max 1 (d.primeFactors.sup id) : ℕ) : ℝ) < z then
      (ArithmeticFunction.moebius d : ℝ) else 0) = _
    by_cases hd : Squarefree d
    · simp only [hcut, ← hdivP d hd]
    · simp [ArithmeticFunction.moebius_eq_zero_of_not_squarefree hd]
  apply ArithmeticFunction.ext
  intro n
  by_cases hn : n = 0
  · subst n
    simp
  have hgcd : n.gcd P = 1 ↔ ∀ p ∈ n.primeFactors, z ≤ (p : ℝ) := by
    constructor
    · intro h p hp
      by_contra! hpz
      have hpd : p ∣ n.gcd P := Nat.dvd_gcd (Nat.dvd_of_mem_primeFactors hp)
        ((hprime p (Nat.prime_of_mem_primeFactors hp)).mpr hpz)
      rw [h] at hpd
      exact (Nat.prime_of_mem_primeFactors hp).ne_one (Nat.dvd_one.mp hpd)
    · intro h
      apply Nat.coprime_iff_gcd_eq_one.mp
      apply Nat.coprime_of_dvd
      intro p hp hpn hpP
      exact not_lt_of_ge (h p (hp.mem_primeFactors hpn hn)) ((hprime p hp).mp hpP)
  have hset : n.divisors.filter (fun d => d ∣ P) = (n.gcd P).divisors := by
    ext d
    simp only [Finset.mem_filter, Nat.mem_divisors, Nat.dvd_gcd_iff,
      ne_eq, hn, Nat.gcd_ne_zero_left hn, not_false_eq_true, and_true]
  rw [ArithmeticFunction.coe_mul_zeta_apply]
  calc
    roughWeight z n = if n.gcd P = 1 then 1 else 0 := by
      simp only [roughWeight, ArithmeticFunction.coe_mk, ne_eq, hn, not_false_eq_true,
        true_and, hgcd]
    _ = ∑ d ∈ (n.gcd P).divisors, (ArithmeticFunction.moebius d : ℝ) := by
      symm
      simpa only [ArithmeticFunction.coe_mul_zeta_apply, ArithmeticFunction.one_apply,
        ArithmeticFunction.intCoe_apply] using
        congrArg (fun f : ArithmeticFunction ℝ => f (n.gcd P))
          (ArithmeticFunction.coe_moebius_mul_coe_zeta (R := ℝ))
    _ = ∑ d ∈ n.divisors, smallPrimeMobius z d := by
      simp_rw [hpoint]
      rw [← Finset.sum_filter, hset]

theorem existsUnique_first_crossing
    (r d0 : ℕ) (H z : ℝ)
    (hr : 0 < r) (hrH : (r : ℝ) < H)
    (hd0 : Squarefree d0)
    (hz : ((max 1 (d0.primeFactors.sup id) : ℕ) : ℝ) < z)
    (hcross : H ≤ ((r * d0 : ℕ) : ℝ)) :
    ∃! hd : ℕ × ℕ,
      hd.1 * hd.2 = d0 ∧
      1 < hd.1 ∧ 0 < hd.2 ∧
      ((max 1 (hd.1.primeFactors.sup id) : ℕ) : ℝ) < z ∧
      ((r * hd.1 : ℕ) : ℝ) / (hd.1.minFac : ℝ) < H ∧
      H ≤ ((r * hd.1 : ℕ) : ℝ) ∧
      ((r * hd.1 : ℕ) : ℝ) < H * z ∧
      max 1 (hd.2.primeFactors.sup id) < hd.1.minFac ∧
      Nat.Coprime hd.1 hd.2 ∧
      ArithmeticFunction.moebius d0 =
        ArithmeticFunction.moebius hd.1 * ArithmeticFunction.moebius hd.2 := by
  classical
  have hH : 0 < H := (Nat.cast_pos.mpr hr).trans hrH
  have hd01 : 1 < d0 := by
    by_contra! h
    have heq : d0 = 1 := Nat.le_antisymm h (Nat.one_le_iff_ne_zero.mpr hd0.ne_zero)
    exact not_le_of_gt hrH (by simpa [heq] using hcross)
  have hpfle {m p : ℕ} (hp : p ∈ m.primeFactors) :
      p ≤ max 1 (m.primeFactors.sup id) :=
    (Finset.le_sup (f := id) hp).trans (le_max_right _ _)
  have hratio (a : ℕ) :
      ((r * a : ℕ) : ℝ) / (a.minFac : ℝ) = ((r * (a / a.minFac) : ℕ) : ℝ) := by
    simp only [Nat.cast_mul, Nat.cast_div_charZero (Nat.minFac_dvd a), mul_div_assoc]
  have hquotpos (a : ℕ) (ha : 0 < a) : 0 < a / a.minFac :=
    Nat.div_pos (Nat.le_of_dvd ha (Nat.minFac_dvd a)) (Nat.minFac_pos a)
  have hdiv (a b c : ℕ) (hab : a * b = d0) (hc : c ∣ d0)
      (hgap : max 1 (b.primeFactors.sup id) < a.minFac)
      (hmin : a.minFac ≤ c.minFac) : c ∣ a := by
    have hasf : Squarefree a := hd0.squarefree_of_dvd ⟨b, hab.symm⟩
    have hbsf : Squarefree b := hd0.squarefree_of_dvd ⟨a, by simpa [mul_comm] using hab.symm⟩
    have hcsf : Squarefree c := hd0.squarefree_of_dvd hc
    rw [← Nat.prod_primeFactors_of_squarefree hcsf]
    apply (Nat.prod_primeFactors_dvd_iff hasf.ne_zero).mpr
    intro q hq
    have hqp := Nat.prime_of_mem_primeFactors hq
    have hqd0 : q ∣ d0 := (Nat.dvd_of_mem_primeFactors hq).trans hc
    have hqa : q ∣ a := by
      rcases hqp.dvd_or_dvd (hab ▸ hqd0) with hqa | hqb
      · exact hqa
      · exact (not_lt_of_ge
          (hmin.trans (Nat.minFac_le_of_dvd hqp.two_le (Nat.dvd_of_mem_primeFactors hq)))
          ((hpfle (hqp.mem_primeFactors hqb hbsf.ne_zero)).trans_lt hgap)).elim
    exact hqp.mem_primeFactors hqa hasf.ne_zero
  have hex : ∃ h : ℕ, ∃ d : ℕ, h * d = d0 ∧ 1 < h ∧
      max 1 (d.primeFactors.sup id) < h.minFac ∧ H ≤ ((r * h : ℕ) : ℝ) := by
    refine ⟨d0, 1, by simp, hd01, ?_, hcross⟩
    simpa using (Nat.minFac_prime hd01.ne').one_lt
  let h := Nat.find hex
  obtain ⟨d, hhd, hh, hgap, hcrossh⟩ := Nat.find_spec hex
  change h * d = d0 at hhd
  have hhsf : Squarefree h := hd0.squarefree_of_dvd ⟨d, hhd.symm⟩
  have hdsf : Squarefree d := hd0.squarefree_of_dvd ⟨h, by simpa [mul_comm] using hhd.symm⟩
  have hdpos : 0 < d := Nat.pos_of_ne_zero hdsf.ne_zero
  have hp : h.minFac.Prime := Nat.minFac_prime hh.ne'
  have hprod : h.minFac * (h / h.minFac) = h := Nat.mul_div_cancel' (Nat.minFac_dvd h)
  have hcop : Nat.Coprime h d := Nat.coprime_of_squarefree_mul (hhd ▸ hd0)
  have hcap : ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z := by
    apply lt_of_le_of_lt _ hz
    apply Nat.cast_le.mpr
    apply max_le (le_max_left _ _)
    apply Finset.sup_le
    intro p hpmem
    exact hpfle (Nat.primeFactors_mono ⟨d, hhd.symm⟩ hd0.ne_zero hpmem)
  have hprev : ((r * (h / h.minFac) : ℕ) : ℝ) < H := by
    by_contra! hc
    have ht : 1 < h / h.minFac := by
      have htpos := hquotpos h (lt_trans Nat.zero_lt_one hh)
      by_contra! ht
      have heq : h / h.minFac = 1 := by omega
      exact not_le_of_gt hrH (by simpa [heq] using hc)
    have hpt : h.minFac < (h / h.minFac).minFac := by
      have hq := Nat.minFac_prime ht.ne'
      have hqd : (h / h.minFac).minFac ∣ h :=
        (Nat.minFac_dvd _).trans ⟨h.minFac, by simpa [mul_comm] using hprod.symm⟩
      apply lt_of_le_of_ne (Nat.minFac_le_of_dvd hq.two_le hqd)
      intro heq
      have hpcop : Nat.Coprime h.minFac (h / h.minFac) :=
        Nat.coprime_of_squarefree_mul (by simpa only [hprod] using hhsf)
      apply hp.coprime_iff_not_dvd.mp hpcop
      exact (congrArg (fun p => p ∣ h / h.minFac) heq).mpr (Nat.minFac_dvd _)
    have hgapp : max 1 ((h.minFac * d).primeFactors.sup id) ≤ h.minFac := by
      apply max_le hp.one_le
      apply Finset.sup_le
      intro q hq
      have hqprime := Nat.prime_of_mem_primeFactors hq
      rcases hqprime.dvd_or_dvd (Nat.dvd_of_mem_primeFactors hq) with hqp | hqd
      · exact le_of_eq ((Nat.prime_dvd_prime_iff_eq hqprime hp).mp hqp)
      · exact (hpfle (hqprime.mem_primeFactors hqd hdsf.ne_zero)).trans hgap.le
    apply Nat.find_min hex (Nat.div_lt_self (lt_trans Nat.zero_lt_one hh) hp.one_lt)
    refine ⟨h.minFac * d, ?_, ht, hgapp.trans_lt hpt, hc⟩
    calc
      h / h.minFac * (h.minFac * d) = (h.minFac * (h / h.minFac)) * d := by ac_rfl
      _ = d0 := by rw [hprod, hhd]
  have hprev' : ((r * h : ℕ) : ℝ) / (h.minFac : ℝ) < H := by
    rwa [hratio]
  have hupper : ((r * h : ℕ) : ℝ) < H * z := by
    have hpz : (h.minFac : ℝ) < z :=
      lt_of_le_of_lt (Nat.cast_le.mpr (hpfle
        (hp.mem_primeFactors (Nat.minFac_dvd h) hhsf.ne_zero))) hcap
    exact ((div_lt_iff₀ (Nat.cast_pos.mpr hp.pos)).mp hprev').trans
      (mul_lt_mul_of_pos_left hpz hH)
  refine ⟨(h, d), ⟨hhd, hh, hdpos, hcap, hprev', hcrossh, hupper, hgap, hcop, ?_⟩, ?_⟩
  · rw [← hhd]
    exact ArithmeticFunction.isMultiplicative_moebius.map_mul_of_coprime hcop
  · rintro ⟨a, b⟩ ⟨hab, ha, _, _, haprev, hacross, _, hagap, _, _⟩
    have hmin : h.minFac = a.minFac := by
      rcases lt_trichotomy h.minFac a.minFac with hlt | heq | hgt
      · have hadiv : a ∣ h := hdiv h d a hhd ⟨b, hab.symm⟩ hgap hlt.le
        have hpcop : Nat.Coprime h.minFac a := hp.coprime_iff_not_dvd.mpr fun hpa ↦
          not_lt_of_ge (Nat.minFac_le_of_dvd hp.two_le hpa) hlt
        have hat : a ∣ h / h.minFac :=
          hpcop.symm.dvd_of_dvd_mul_left (by simpa only [hprod] using hadiv)
        have hle := Nat.mul_le_mul_left r (Nat.le_of_dvd
          (hquotpos h (lt_trans Nat.zero_lt_one hh)) hat)
        exact (not_lt_of_ge (hacross.trans (Nat.cast_le.mpr hle)) hprev).elim
      · exact heq
      · have hhdiv : h ∣ a := hdiv a b h hab ⟨d, hhd.symm⟩ hagap hgt.le
        have hpa := Nat.minFac_prime ha.ne'
        have hpcop : Nat.Coprime a.minFac h := hpa.coprime_iff_not_dvd.mpr fun hph ↦
          not_lt_of_ge (Nat.minFac_le_of_dvd hpa.two_le hph) hgt
        have hprodA : a.minFac * (a / a.minFac) = a :=
          Nat.mul_div_cancel' (Nat.minFac_dvd a)
        have hht : h ∣ a / a.minFac :=
          hpcop.symm.dvd_of_dvd_mul_left (by simpa only [hprodA] using hhdiv)
        have hle := Nat.mul_le_mul_left r (Nat.le_of_dvd
          (hquotpos a (lt_trans Nat.zero_lt_one ha)) hht)
        rw [hratio] at haprev
        exact (not_lt_of_ge (hcrossh.trans (Nat.cast_le.mpr hle)) haprev).elim
    have haeq : a = h := Nat.dvd_antisymm
      (hdiv h d a hhd ⟨b, hab.symm⟩ hgap hmin.le)
      (hdiv a b h hab ⟨d, hhd.symm⟩ hagap hmin.ge)
    subst a
    exact Prod.ext rfl (Nat.eq_of_mul_eq_mul_left (lt_trans Nat.zero_lt_one hh)
      (hab.trans hhd.symm))

open Classical in
theorem restricted_harman_decomposition
    (u v : ArithmeticFunction ℝ) (H z M0 : ℝ)
    (hH : 0 < H) (hz : 1 < z)
    (hu : ∀ r, u r ≠ 0 → (r : ℝ) < H)
    (hv : ∀ s, v s ≠ 0 → (s : ℝ) < M0 / H)
    (n : ℕ) :
    (u * v * roughWeight z) n =
      (harmanA0 u v z M0 *
        (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n +
      ∑ a ∈ n.divisorsAntidiagonal,
        ∑ b ∈ a.2.divisorsAntidiagonal,
          ∑ c ∈ b.2.divisorsAntidiagonal,
            ∑ e ∈ c.2.divisorsAntidiagonal,
              let r := a.1
              let s := b.1
              let h := c.1
              let d := e.1
              if 1 < h ∧
                  ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧
                  ((r * h : ℕ) : ℝ) / (h.minFac : ℝ) < H ∧
                  H ≤ ((r * h : ℕ) : ℝ) ∧
                  max 1 (d.primeFactors.sup id) < h.minFac ∧
                  M0 < ((r * s * h * d : ℕ) : ℝ) then
                u r * v s * (ArithmeticFunction.moebius h : ℝ) *
                  (ArithmeticFunction.moebius d : ℝ)
              else 0 := by
  have hrotate (m : ℕ) (f : ℕ → ℕ → ℕ → ℝ) :
      (∑ a ∈ m.divisorsAntidiagonal, ∑ b ∈ a.1.divisorsAntidiagonal, f b.1 b.2 a.2) =
        ∑ a ∈ m.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal, f a.1 b.1 b.2 := by
    clear * - m f
    simp only [Finset.sum_sigma']
    apply Finset.sum_nbij' (fun ⟨⟨_, j⟩, ⟨k, l⟩⟩ ↦ ⟨(k, l * j), (l, j)⟩)
      (fun ⟨⟨i, _⟩, ⟨k, l⟩⟩ ↦ ⟨(i * k, l), (i, k)⟩) <;> aesop (add simp mul_assoc)
  have hpfle {m p : ℕ} (hp : p ∈ m.primeFactors) :
      p ≤ max 1 (m.primeFactors.sup id) :=
    (Finset.le_sup (f := id) hp).trans (le_max_right _ _)
  have haux (r m : ℕ) (a : ℕ × ℕ) (ha : a ∈ m.divisorsAntidiagonal)
      (hc : 1 < a.1 ∧ ((max 1 (a.1.primeFactors.sup id) : ℕ) : ℝ) < z ∧
        ((r * a.1 : ℕ) : ℝ) / (a.1.minFac : ℝ) < H ∧
        H ≤ ((r * a.1 : ℕ) : ℝ) ∧
        max 1 (a.2.primeFactors.sup id) < a.1.minFac) :
      ((max 1 (m.primeFactors.sup id) : ℕ) : ℝ) < z ∧
        Nat.Coprime a.1 a.2 ∧
        ArithmeticFunction.moebius m =
          ArithmeticFunction.moebius a.1 * ArithmeticFunction.moebius a.2 ∧
        ((r * a.1 : ℕ) : ℝ) < H * z := by
    obtain ⟨hab, _⟩ := Nat.mem_divisorsAntidiagonal.mp ha
    obtain ⟨ha0, hb0⟩ := Nat.ne_zero_of_mem_divisorsAntidiagonal ha
    obtain ⟨hh, hcap, hprev, _, hgap⟩ := hc
    have hp := Nat.minFac_prime hh.ne'
    have hpb := hpfle (hp.mem_primeFactors (Nat.minFac_dvd a.1) ha0)
    have hcop : Nat.Coprime a.1 a.2 := by
      apply Nat.coprime_of_dvd
      intro p hprime hpa hpd
      exact not_lt_of_ge (Nat.minFac_le_of_dvd hprime.two_le hpa)
        ((hpfle (hprime.mem_primeFactors hpd hb0)).trans_lt hgap)
    refine ⟨?_, hcop, ?_, ?_⟩
    · apply lt_of_le_of_lt _ hcap
      apply Nat.cast_le.mpr
      apply max_le (le_max_left _ _)
      apply Finset.sup_le
      intro p hpm
      have hprime := Nat.prime_of_mem_primeFactors hpm
      rcases hprime.dvd_or_dvd (hab ▸ Nat.dvd_of_mem_primeFactors hpm) with hpa | hpd
      · exact hpfle (hprime.mem_primeFactors hpa ha0)
      · exact ((hpfle (hprime.mem_primeFactors hpd hb0)).trans hgap.le).trans hpb
    · rw [← hab]
      exact ArithmeticFunction.isMultiplicative_moebius.map_mul_of_coprime hcop
    · exact ((div_lt_iff₀ (Nat.cast_pos.mpr hp.pos)).mp hprev).trans
        (mul_lt_mul_of_pos_left ((Nat.cast_le.mpr hpb).trans_lt hcap) hH)
  have hmu (r m : ℕ) (hr : 0 < r) (hrH : (r : ℝ) < H) (hm : m ≠ 0)
      (hcross : H ≤ ((r * m : ℕ) : ℝ)) :
      smallPrimeMobius z m = ∑ a ∈ m.divisorsAntidiagonal,
        if 1 < a.1 ∧ ((max 1 (a.1.primeFactors.sup id) : ℕ) : ℝ) < z ∧
            ((r * a.1 : ℕ) : ℝ) / (a.1.minFac : ℝ) < H ∧
            H ≤ ((r * a.1 : ℕ) : ℝ) ∧
            max 1 (a.2.primeFactors.sup id) < a.1.minFac then
          (ArithmeticFunction.moebius a.1 : ℝ) * (ArithmeticFunction.moebius a.2 : ℝ)
        else 0 := by
    by_cases hzero : smallPrimeMobius z m = 0
    · rw [hzero]
      symm
      apply Finset.sum_eq_zero
      intro a ha
      split_ifs with hc
      · obtain ⟨hcap, _, hμ, _⟩ := haux r m a ha hc
        have hval : smallPrimeMobius z m = (ArithmeticFunction.moebius m : ℝ) := by
          change (if ((max 1 (m.primeFactors.sup id) : ℕ) : ℝ) < z then
            (ArithmeticFunction.moebius m : ℝ) else 0) = _
          exact ite_eq_left hcap
        rw [← Int.cast_mul, ← hμ, ← hval, hzero]
      · rfl
    have hcap : ((max 1 (m.primeFactors.sup id) : ℕ) : ℝ) < z := by
      by_contra hc
      apply hzero
      change (if ((max 1 (m.primeFactors.sup id) : ℕ) : ℝ) < z then
        (ArithmeticFunction.moebius m : ℝ) else 0) = _
      exact ite_eq_right hc
    have hμ0 : ArithmeticFunction.moebius m ≠ 0 := by
      intro hμ
      exact hzero (by simp only [smallPrimeMobius, ArithmeticFunction.coe_mk,
        hμ, Int.cast_zero, ite_self])
    obtain ⟨⟨h, d⟩, ⟨hhd, hh, hdpos, hcapH, hprev, hcrossH, _, hgap, _, hμ⟩, huniq⟩ :=
      existsUnique_first_crossing r m H z hr hrH
        (ArithmeticFunction.moebius_ne_zero_iff_squarefree.mp hμ0) hcap hcross
    have hmem : (h, d) ∈ m.divisorsAntidiagonal := Nat.mem_divisorsAntidiagonal.mpr ⟨hhd, hm⟩
    have hcond : 1 < h ∧ ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧
        ((r * h : ℕ) : ℝ) / (h.minFac : ℝ) < H ∧ H ≤ ((r * h : ℕ) : ℝ) ∧
        max 1 (d.primeFactors.sup id) < h.minFac :=
      ⟨hh, hcapH, hprev, hcrossH, hgap⟩
    rw [Finset.sum_eq_single (h, d)]
    · change (if ((max 1 (m.primeFactors.sup id) : ℕ) : ℝ) < z then
          (ArithmeticFunction.moebius m : ℝ) else 0) = _
      simp only [ite_eq_left hcap, ite_eq_left hcond, ← Int.cast_mul, ← hμ]
    · intro a ha hne
      split_ifs with hc
      · obtain ⟨_, hcop, hμa, hupper⟩ := haux r m a ha hc
        have heq : a = (h, d) := huniq a
          ⟨(Nat.mem_divisorsAntidiagonal.mp ha).1, hc.1,
            Nat.pos_of_ne_zero (Nat.right_ne_zero_of_mem_divisorsAntidiagonal ha),
            hc.2.1, hc.2.2.1, hc.2.2.2.1, hupper, hc.2.2.2.2, hcop, hμa⟩
        exact (hne heq).elim
      · rfl
    · exact fun hnot ↦ (hnot hmem).elim
  have hweight (r s m : ℕ) (hm : m ≠ 0) :
      (if M0 < ((r * s * m : ℕ) : ℝ) then u r * v s * smallPrimeMobius z m else 0) =
        ∑ a ∈ m.divisorsAntidiagonal,
          if 1 < a.1 ∧ ((max 1 (a.1.primeFactors.sup id) : ℕ) : ℝ) < z ∧
              ((r * a.1 : ℕ) : ℝ) / (a.1.minFac : ℝ) < H ∧
              H ≤ ((r * a.1 : ℕ) : ℝ) ∧
              max 1 (a.2.primeFactors.sup id) < a.1.minFac ∧
              M0 < ((r * s * a.1 * a.2 : ℕ) : ℝ) then
            u r * v s * (ArithmeticFunction.moebius a.1 : ℝ) *
              (ArithmeticFunction.moebius a.2 : ℝ)
          else 0 := by
    by_cases hur : u r = 0
    · simp [hur]
    by_cases hvs : v s = 0
    · simp [hvs]
    by_cases hlong : M0 < ((r * s * m : ℕ) : ℝ)
    · have hr : 0 < r := Nat.pos_of_ne_zero fun hr0 ↦ hur (by simp [hr0])
      have hs : 0 ≤ (s : ℝ) := Nat.cast_nonneg _
      have hsH : (s : ℝ) * H < M0 := (lt_div_iff₀ hH).mp (hv s hvs)
      have hcross : H ≤ ((r * m : ℕ) : ℝ) := by
        by_contra! hc
        have hle := mul_le_mul_of_nonneg_left hc.le hs
        have heq : (s : ℝ) * ((r * m : ℕ) : ℝ) = ((r * s * m : ℕ) : ℝ) := by
          push_cast
          ring
        rw [heq] at hle
        exact not_lt_of_ge (hle.trans hsH.le) hlong
      rw [ite_eq_left hlong, hmu r m hr (hu r hur) hm hcross, Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro a ha
      have heq := (Nat.mem_divisorsAntidiagonal.mp ha).1
      have hlong' : M0 < ((r * s * a.1 * a.2 : ℕ) : ℝ) := by
        simpa only [mul_assoc, heq] using hlong
      simp only [hlong', and_true]
      simp only [mul_ite, mul_zero, mul_assoc]
    · rw [ite_eq_right hlong]
      symm
      apply Finset.sum_eq_zero
      intro a ha
      have heq := (Nat.mem_divisorsAntidiagonal.mp ha).1
      have hlong' : ¬ M0 < ((r * s * a.1 * a.2 : ℕ) : ℝ) := by
        simpa only [mul_assoc, heq] using hlong
      simp only [hlong', and_false, ite_false]
  have htotal : (u * v * roughWeight z) n =
      ∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
        ∑ c ∈ b.2.divisorsAntidiagonal, u a.1 * v b.1 * smallPrimeMobius z c.1 := by
    rw [roughWeight_eq_smallPrimeMobius_mul_zeta z hz]
    simp only [mul_assoc, ArithmeticFunction.mul_apply, Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro a ha
    apply Finset.sum_congr rfl
    intro b hb
    apply Finset.sum_congr rfl
    intro c hc
    rw [ArithmeticFunction.natCoe_apply, ArithmeticFunction.zeta_apply_ne
      (Nat.right_ne_zero_of_mem_divisorsAntidiagonal hc), Nat.cast_one, mul_one]
  have hshort : (harmanA0 u v z M0 * (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n =
      ∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
        ∑ c ∈ b.2.divisorsAntidiagonal,
          if ((a.1 * b.1 * c.1 : ℕ) : ℝ) ≤ M0 then
            u a.1 * v b.1 * smallPrimeMobius z c.1 else 0 := by
    rw [ArithmeticFunction.mul_apply]
    calc
      _ = ∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.1.divisorsAntidiagonal,
          ∑ c ∈ b.2.divisorsAntidiagonal,
            if ((b.1 * c.1 * c.2 : ℕ) : ℝ) ≤ M0 then
              u b.1 * v c.1 * smallPrimeMobius z c.2 else 0 := by
        apply Finset.sum_congr rfl
        intro a ha
        rw [ArithmeticFunction.natCoe_apply, ArithmeticFunction.zeta_apply_ne
          (Nat.right_ne_zero_of_mem_divisorsAntidiagonal ha), Nat.cast_one, mul_one]
        change (if (a.1 : ℝ) ≤ M0 then (u * v * smallPrimeMobius z) a.1 else 0) = _
        rw [mul_assoc, ArithmeticFunction.mul_apply]
        simp_rw [ArithmeticFunction.mul_apply, Finset.mul_sum, Finset.ite_sum_zero]
        apply Finset.sum_congr rfl
        intro b hb
        apply Finset.sum_congr rfl
        intro c hc
        simp only [mul_assoc, (Nat.mem_divisorsAntidiagonal.mp hc).1,
          (Nat.mem_divisorsAntidiagonal.mp hb).1]
      _ = _ := by
        rw [hrotate n (fun r t _ ↦ ∑ c ∈ t.divisorsAntidiagonal,
          if ((r * c.1 * c.2 : ℕ) : ℝ) ≤ M0 then u r * v c.1 * smallPrimeMobius z c.2 else 0)]
        apply Finset.sum_congr rfl
        intro a ha
        exact hrotate a.2 (fun s d _ ↦
          if ((a.1 * s * d : ℕ) : ℝ) ≤ M0 then u a.1 * v s * smallPrimeMobius z d else 0)
  have hlongsum (m r s : ℕ) :
      (∑ c ∈ m.divisorsAntidiagonal, ∑ e ∈ c.2.divisorsAntidiagonal,
        if 1 < c.1 ∧ ((max 1 (c.1.primeFactors.sup id) : ℕ) : ℝ) < z ∧
            ((r * c.1 : ℕ) : ℝ) / (c.1.minFac : ℝ) < H ∧
            H ≤ ((r * c.1 : ℕ) : ℝ) ∧
            max 1 (e.1.primeFactors.sup id) < c.1.minFac ∧
            M0 < ((r * s * c.1 * e.1 : ℕ) : ℝ) then
          u r * v s * (ArithmeticFunction.moebius c.1 : ℝ) *
            (ArithmeticFunction.moebius e.1 : ℝ) else 0) =
        ∑ c ∈ m.divisorsAntidiagonal,
          if M0 < ((r * s * c.1 : ℕ) : ℝ) then u r * v s * smallPrimeMobius z c.1 else 0 := by
    rw [← hrotate m (fun h d _ ↦
      if 1 < h ∧ ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧
          ((r * h : ℕ) : ℝ) / (h.minFac : ℝ) < H ∧ H ≤ ((r * h : ℕ) : ℝ) ∧
          max 1 (d.primeFactors.sup id) < h.minFac ∧ M0 < ((r * s * h * d : ℕ) : ℝ) then
        u r * v s * (ArithmeticFunction.moebius h : ℝ) *
          (ArithmeticFunction.moebius d : ℝ) else 0)]
    apply Finset.sum_congr rfl
    intro c hc
    exact (hweight r s c.1 (Nat.left_ne_zero_of_mem_divisorsAntidiagonal hc)).symm
  dsimp only
  rw [htotal, hshort]
  simp_rw [hlongsum, ← Finset.sum_add_distrib]
  apply Finset.sum_congr rfl
  intro a ha
  apply Finset.sum_congr rfl
  intro b hb
  apply Finset.sum_congr rfl
  intro c hc
  by_cases hle : ((a.1 * b.1 * c.1 : ℕ) : ℝ) ≤ M0
  · simp only [ite_eq_left hle, not_lt_of_ge hle, ite_false, add_zero]
  · simp only [ite_eq_right hle, lt_of_not_ge hle, ite_true, zero_add]

/-!
## Buchstab regions and exceptional prime configurations
-/

/--
The six finite prime-tuple regions used in the Buchstab decomposition, indexed by `j`. They
contain respectively the empty tuple, one-prime tuples, two two-prime regions, and two
three-prime regions, with membership determined by the stated logarithmic size and ordering
inequalities.
-/
noncomputable def siftedPrimeTuples (x : ℝ) (j : Fin 6) :
    Finset (List ℕ) := by
  classical
  let a : ℝ := 40481 / 100000
  let b : ℝ := 59519 / 100000
  let c : ℝ := 1058 / 3125
  let xi : ℝ := 9519 / 50000
  let zeta : ℝ := 1 - c - a
  let alpha (p : ℕ) : ℝ := Real.logb x (p : ℝ)
  let box (k : ℕ) : Finset (Fin k → ℕ) :=
    Fintype.piFinset (fun _ => Nat.primesBelow (Nat.ceil (x ^ a)))
  exact match j.val with
    | 0 => {[]}
    | 1 => ((box 1).filter fun p =>
        xi ≤ alpha (p 0) ∧ alpha (p 0) < a).image List.ofFn
    | 2 => ((box 2).filter fun p =>
        xi ≤ alpha (p 1) ∧ alpha (p 1) < alpha (p 0) ∧
        alpha (p 0) < a ∧ alpha (p 0) + alpha (p 1) < a).image List.ofFn
    | 3 => ((box 2).filter fun p =>
        xi ≤ alpha (p 1) ∧ alpha (p 1) < alpha (p 0) ∧
        alpha (p 0) < a ∧ b < alpha (p 0) + alpha (p 1) ∧
        alpha (p 1) < zeta).image List.ofFn
    | 4 => ((box 3).filter fun p =>
        xi ≤ alpha (p 2) ∧ alpha (p 2) < alpha (p 1) ∧
        alpha (p 1) < alpha (p 0) ∧ alpha (p 0) < a ∧
        alpha (p 0) + alpha (p 1) < a ∧ alpha (p 2) < zeta).image List.ofFn
    | _ => ((box 3).filter fun p =>
        xi ≤ alpha (p 1) ∧ alpha (p 1) < alpha (p 0) ∧
        alpha (p 0) < a ∧ alpha (p 1) ≤ alpha (p 2) ∧
        alpha (p 1) + alpha (p 2) < a ∧ alpha (p 0) < zeta).image List.ofFn

/--
The two factor products assigned to a sifted prime tuple. Region `5` groups the tail against the
first entry; region `4` groups the first two entries against the rest; the other regions split
after the first entry.
-/
def siftedPrimeGroups (j : Fin 6) (p : List ℕ) : ℕ × ℕ :=
  if j.val = 5 then
    ((p.drop 1).prod, (p.take 1).prod)
  else
    let k := if j.val = 4 then 2 else 1
    ((p.take k).prod, (p.drop k).prod)

/--
The weighted count of factorizations of `n` into a tuple from sifted region `j` and a cofactor
rough at level `x^(9519 / 50000)`. Each tuple contributes its weight `w p`.
-/
noncomputable def siftedTheta (x : ℝ) (j : Fin 6)
    (w : List ℕ → ℝ) : ArithmeticFunction ℝ := by
  classical
  exact ⟨fun n =>
    ∑ p ∈ siftedPrimeTuples x j, ∑ d ∈ n.divisorsAntidiagonal,
      if d.1 = p.prod then
        w p * roughWeight (x ^ ((9519 : ℝ) / 50000)) d.2
      else 0, by simp⟩

theorem mem_siftedPrimeTuples_iff
    (x : ℝ) (hx : 1 < x) (j : Fin 6) (p : List ℕ) :
    let a : ℝ := 40481 / 100000
    let b : ℝ := 59519 / 100000
    let c : ℝ := 1058 / 3125
    let xi : ℝ := 9519 / 50000
    let zeta : ℝ := 1 - c - a
    let alpha (q : ℕ) : ℝ := Real.logb x (q : ℝ)
    p ∈ siftedPrimeTuples x j ↔
      match j.val, p with
      | 0, [] => True
      | 1, [p1] =>
          p1.Prime ∧ xi ≤ alpha p1 ∧ alpha p1 < a
      | 2, [p1, p2] =>
          p1.Prime ∧ p2.Prime ∧ xi ≤ alpha p2 ∧ alpha p2 < alpha p1 ∧
          alpha p1 < a ∧ alpha p1 + alpha p2 < a
      | 3, [p1, p2] =>
          p1.Prime ∧ p2.Prime ∧ xi ≤ alpha p2 ∧ alpha p2 < alpha p1 ∧
          alpha p1 < a ∧ b < alpha p1 + alpha p2 ∧ alpha p2 < zeta
      | 4, [p1, p2, p3] =>
          p1.Prime ∧ p2.Prime ∧ p3.Prime ∧
          xi ≤ alpha p3 ∧ alpha p3 < alpha p2 ∧ alpha p2 < alpha p1 ∧
          alpha p1 < a ∧ alpha p1 + alpha p2 < a ∧ alpha p3 < zeta
      | 5, [p2, p3, p4] =>
          p2.Prime ∧ p3.Prime ∧ p4.Prime ∧
          xi ≤ alpha p3 ∧ alpha p3 < alpha p2 ∧ alpha p2 < a ∧
          alpha p3 ≤ alpha p4 ∧ alpha p3 + alpha p4 < a ∧ alpha p2 < zeta
      | _, _ => False := by
  dsimp only
  have hbox (q : ℕ) :
      q ∈ Nat.primesBelow (Nat.ceil (x ^ ((40481 : ℝ) / 100000))) ↔
        q.Prime ∧ Real.logb x (q : ℝ) < (40481 : ℝ) / 100000 := by
    rw [Nat.mem_primesBelow, Nat.lt_ceil, and_comm]
    exact and_congr_right fun hq =>
      (Real.logb_lt_iff_lt_rpow hx (Nat.cast_pos.mpr hq.pos)).symm
  fin_cases j <;>
    rcases p with _ | ⟨p1, _ | ⟨p2, _ | ⟨p3, _ | ⟨p4, ps⟩⟩⟩⟩ <;>
    simp [siftedPrimeTuples, Finset.mem_image, Finset.mem_filter,
      Fintype.mem_piFinset, Fin.exists_fin_succ_pi, Fin.exists_fin_zero_pi,
      Fin.forall_fin_succ, hbox]
  all_goals grind

theorem siftedPrimeTuples_group_bounds
    (x : ℝ) (hx : 1 < x) (j : Fin 6) (p : List ℕ)
    (hp : p ∈ siftedPrimeTuples x j) :
    let g := siftedPrimeGroups j p
    0 < g.1 ∧ 0 < g.2 ∧ g.1 * g.2 = p.prod ∧
      (g.1 : ℝ) < x ^ ((40481 : ℝ) / 100000) ∧
      (g.2 : ℝ) <
        x ^ (1 - (1058 : ℝ) / 3125) / x ^ ((40481 : ℝ) / 100000) ∧
      ∀ q ∈ p, q.Prime ∧ x ^ ((9519 : ℝ) / 50000) ≤ (q : ℝ) := by
  have hlt (q : ℕ) (hq : 0 < q) {s : ℝ}
      (h : Real.logb x (q : ℝ) < s) : (q : ℝ) < x ^ s :=
    (Real.logb_lt_iff_lt_rpow hx (Nat.cast_pos.mpr hq)).mp h
  have hlo (q : ℕ) (hq : 0 < q)
      (h : (9519 : ℝ) / 50000 ≤ Real.logb x (q : ℝ)) :
      x ^ ((9519 : ℝ) / 50000) ≤ (q : ℝ) :=
    (Real.le_logb_iff_rpow_le hx (Nat.cast_pos.mpr hq)).mp h
  have hmul (q r : ℕ) (hq : 0 < q) (hr : 0 < r) {s : ℝ}
      (h : Real.logb x (q : ℝ) + Real.logb x (r : ℝ) < s) :
      (q : ℝ) * (r : ℝ) < x ^ s := by
    apply (Real.logb_lt_iff_lt_rpow hx (by positivity)).mp
    rwa [Real.logb_mul (by positivity) (by positivity)]
  have hmem := (mem_siftedPrimeTuples_iff x hx j p).mp hp
  dsimp only at hmem ⊢
  rw [← Real.rpow_sub (zero_lt_one.trans hx)]
  have ha : (1 : ℝ) < x ^ ((40481 : ℝ) / 100000) :=
    Real.one_lt_rpow hx (by norm_num)
  have hs : (1 : ℝ) < x ^ (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000) :=
    Real.one_lt_rpow hx (by norm_num)
  fin_cases j <;>
    rcases p with _ | ⟨p1, _ | ⟨p2, _ | ⟨p3, _ | ⟨p4, ps⟩⟩⟩⟩ <;>
    simp only at hmem
  · simp [siftedPrimeGroups, ha, hs]
  · rcases hmem with ⟨hp1, hxi, htop⟩
    simp [siftedPrimeGroups, hs, hp1.pos, hp1, hlt p1 hp1.pos htop, hlo p1 hp1.pos hxi]
  · rcases hmem with ⟨hp1, hp2, hxi, h21, htop, hsum⟩
    have hR := hlt p1 hp1.pos htop
    have hS := hlt p2 hp2.pos
      (show Real.logb x (p2 : ℝ) <
        1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000 by linarith)
    have hL1 := hlo p1 hp1.pos (hxi.trans h21.le)
    have hL2 := hlo p2 hp2.pos hxi
    simp [siftedPrimeGroups, hp1.pos, hp2.pos, hp1, hp2, hR, hS, hL1, hL2]
  · rcases hmem with ⟨hp1, hp2, hxi, h21, htop, _, hcap⟩
    simp [siftedPrimeGroups, hp1.pos, hp2.pos, hp1, hp2,
      hlt p1 hp1.pos htop, hlt p2 hp2.pos hcap,
      hlo p1 hp1.pos (hxi.trans h21.le), hlo p2 hp2.pos hxi]
  · rcases hmem with ⟨hp1, hp2, hp3, hxi, h32, h21, _, hsum, hcap⟩
    have hR := hmul p1 p2 hp1.pos hp2.pos hsum
    have hS := hlt p3 hp3.pos hcap
    have hL1 := hlo p1 hp1.pos ((hxi.trans h32.le).trans h21.le)
    have hL2 := hlo p2 hp2.pos (hxi.trans h32.le)
    have hL3 := hlo p3 hp3.pos hxi
    simp [siftedPrimeGroups, hp1.pos, hp2.pos, hp3.pos, hp1, hp2, hp3,
      hR, hS, hL1, hL2, hL3, mul_assoc]
  · rcases hmem with ⟨hp1, hp2, hp3, hxi, h21, _, h23, hsum, hcap⟩
    have hR := hmul p2 p3 hp2.pos hp3.pos hsum
    have hS := hlt p1 hp1.pos hcap
    have hL1 := hlo p1 hp1.pos (hxi.trans h21.le)
    have hL2 := hlo p2 hp2.pos hxi
    have hL3 := hlo p3 hp3.pos (hxi.trans h23)
    simp [siftedPrimeGroups, hp1.pos, hp2.pos, hp3.pos, hp1, hp2, hp3,
      hR, hS, hL1, hL2, hL3, mul_comm]

open Classical in
theorem siftedTheta_restricted_harman_decomposition
    (x : ℝ) (hx : 1 < x) (j : Fin 6)
    (w : List ℕ → ℝ) (n : ℕ) :
    let H := x ^ ((40481 : ℝ) / 100000)
    let z := x ^ ((9519 : ℝ) / 50000)
    let M0 := x ^ (1 - (1058 : ℝ) / 3125)
    let U (p : List ℕ) : ArithmeticFunction ℝ :=
      ⟨fun r => if r = 0 then 0 else
        if r = (siftedPrimeGroups j p).1 then 1 else 0, by simp⟩
    let V (p : List ℕ) : ArithmeticFunction ℝ :=
      ⟨fun s => if s = 0 then 0 else
        if s = (siftedPrimeGroups j p).2 then 1 else 0, by simp⟩
    siftedTheta x j w n =
      ∑ p ∈ siftedPrimeTuples x j, w p *
        ((harmanA0 (U p) (V p) z M0 *
            (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n +
          ∑ a ∈ n.divisorsAntidiagonal,
            ∑ b ∈ a.2.divisorsAntidiagonal,
              ∑ c ∈ b.2.divisorsAntidiagonal,
                ∑ e ∈ c.2.divisorsAntidiagonal,
                  if 1 < c.1 ∧
                      ((max 1 (c.1.primeFactors.sup id) : ℕ) : ℝ) < z ∧
                      ((a.1 * c.1 : ℕ) : ℝ) / (c.1.minFac : ℝ) < H ∧
                      H ≤ ((a.1 * c.1 : ℕ) : ℝ) ∧
                      max 1 (e.1.primeFactors.sup id) < c.1.minFac ∧
                      M0 < ((a.1 * b.1 * c.1 * e.1 : ℕ) : ℝ) then
                    U p a.1 * V p b.1 * (ArithmeticFunction.moebius c.1 : ℝ) *
                      (ArithmeticFunction.moebius e.1 : ℝ)
                  else 0) := by
  intro H z M0 U V
  have hH : 0 < H := Real.rpow_pos_of_pos (zero_lt_one.trans hx) _
  have hz : 1 < z := Real.one_lt_rpow hx (by norm_num)
  have hdelta (d : ℕ) (hd : 0 < d) (m : ℕ) :
      (if m = 0 then (0 : ℝ) else if m = d then 1 else 0) =
        if m = d then 1 else 0 := by
    by_cases hm : m = 0 <;> simp [hm, hd.ne]
  change (∑ p ∈ siftedPrimeTuples x j, ∑ d ∈ n.divisorsAntidiagonal,
    if d.1 = p.prod then w p * roughWeight z d.2 else 0) = _
  apply Finset.sum_congr rfl
  intro p hp
  rcases siftedPrimeTuples_group_bounds x hx j p hp with
    ⟨hrpos, hspos, hprod, hrH, hsH, _⟩
  have hU (r : ℕ) : U p r = if r = (siftedPrimeGroups j p).1 then 1 else 0 :=
    hdelta _ hrpos r
  have hV (s : ℕ) : V p s = if s = (siftedPrimeGroups j p).2 then 1 else 0 :=
    hdelta _ hspos s
  have hprodpos : 0 < p.prod := hprod ▸ Nat.mul_pos hrpos hspos
  have hUV (m : ℕ) : (U p * V p) m = if m = p.prod then 1 else 0 := by
    rw [ArithmeticFunction.mul_apply]
    have hpoint (d : ℕ × ℕ) :
        U p d.1 * V p d.2 = if d = siftedPrimeGroups j p then 1 else 0 := by
      simp only [hU, hV, ite_mul, one_mul, zero_mul, Prod.ext_iff, ite_and]
    simp_rw [hpoint]
    rw [Finset.sum_ite_eq']
    by_cases hm : m = p.prod <;>
      simp [Nat.mem_divisorsAntidiagonal, hprod, hm, hprodpos.ne', eq_comm]
  have hu : ∀ r, U p r ≠ 0 → (r : ℝ) < H := by
    intro r hr
    simp only [hU, ite_ne_right_iff] at hr
    simpa only [hr] using hrH
  have hv : ∀ s, V p s ≠ 0 → (s : ℝ) < M0 / H := by
    intro s hs
    simp only [hV, ite_ne_right_iff] at hs
    simpa only [hs] using hsH
  rw [← restricted_harman_decomposition (U p) (V p) H z M0 hH hz hu hv n,
    ArithmeticFunction.mul_apply, Finset.mul_sum]
  simp only [hUV, ite_mul, one_mul, zero_mul, mul_ite, mul_zero]

theorem family_one_upper_bound_of_weak_cuts
    (α : Fin 5 → ℝ) (δ : ℝ) (hδ : 0 ≤ δ)
    (hlo : ∀ i, (9519 : ℝ) / 50000 ≤ α i)
    (hsum : (∑ i, α i) ≤ 1 + δ)
    (h10 : α 1 ≤ α 0) (h12 : α 1 ≤ α 2)
    (hpair : α 0 + α 2 ≤ (40481 : ℝ) / 100000)
    (htriple : (59519 : ℝ) / 100000 ≤ α 0 + α 1 + α 3)
    (h34 : α 3 ≤ α 4) :
    ∀ i, α i ≤ (40481 : ℝ) / 100000 - (9519 : ℝ) / 50000 + δ := by
  have h0 : α 0 ≤ (40481 : ℝ) / 100000 - (9519 : ℝ) / 50000 + δ := by
    linarith only [hpair, hlo 2, hδ]
  have h2 : α 2 ≤ (40481 : ℝ) / 100000 - (9519 : ℝ) / 50000 + δ := by
    linarith only [hpair, hlo 0, hδ]
  have h1sum : α 1 + α 1 ≤ α 0 + α 2 := add_le_add h10 h12
  have h1 : α 1 ≤ (40481 : ℝ) / 100000 - (9519 : ℝ) / 50000 + δ := by
    linarith only [h1sum, hpair, hδ]
  have h4 : α 4 ≤ (40481 : ℝ) / 100000 - (9519 : ℝ) / 50000 + δ := by
    simp only [Fin.sum_univ_five] at hsum
    linarith only [hsum, htriple, hlo 2]
  have h3 := h34.trans h4
  intro i
  fin_cases i <;> assumption

theorem family_one_upper_cuts_of_small_total
    (α : Fin 5 → ℝ) (δ : ℝ) (hδ : 0 ≤ δ)
    (hδsmall : δ < (481 : ℝ) / 20000)
    (hlo : ∀ i, (9519 : ℝ) / 50000 ≤ α i)
    (hsum : (∑ i, α i) ≤ 1 + δ)
    (h10 : α 1 < α 0) (h12 : α 1 < α 2)
    (hpair : α 0 + α 2 < (40481 : ℝ) / 100000)
    (htriple : (59519 : ℝ) / 100000 < α 0 + α 1 + α 3)
    (h34 : α 3 ≤ α 4) :
    ∀ i, α i < 1 - 4 * ((9519 : ℝ) / 50000) := by
  intro i
  have hi := family_one_upper_bound_of_weak_cuts α δ hδ hlo hsum
    h10.le h12.le hpair.le htriple.le h34 i
  linarith only [hi, hδsmall]

theorem family_one_closed_upper_gap
    (α : Fin 5 → ℝ)
    (hlo : ∀ i, (9519 : ℝ) / 50000 ≤ α i)
    (hsum : (∑ i, α i) = 1)
    (h10 : α 1 ≤ α 0) (h12 : α 1 ≤ α 2)
    (hpair : α 0 + α 2 ≤ (40481 : ℝ) / 100000)
    (htriple : (59519 : ℝ) / 100000 ≤ α 0 + α 1 + α 3)
    (h34 : α 3 ≤ α 4) :
    ∀ i, α i ≤ (1 - 4 * ((9519 : ℝ) / 50000)) - (481 : ℝ) / 20000 := by
  intro i
  have hi := family_one_upper_bound_of_weak_cuts α 0 (le_refl 0) hlo
    (by simpa only [add_zero] using hsum.le) h10 h12 hpair htriple h34 i
  linarith only [hi]

theorem source_final_exponent_mem_compact_band
    (t : Fin 4 → ℝ) (γ δ : ℝ)
    (ht : ∀ i, (9519 : ℝ) / 50000 ≤ t i)
    (hmove0 : 0 ≤ γ - (1 - ∑ i, t i))
    (hmove : γ - (1 - ∑ i, t i) ≤ δ)
    (hδsmall : δ < (19 : ℝ) / 12500)
    (horder : t 3 ≤ 1 - ∑ i, t i) :
    (9519 : ℝ) / 50000 ≤ γ ∧ γ ≤ (6 : ℝ) / 25 := by
  have hbeta : 1 - ∑ i, t i ≤ 1 - 4 * ((9519 : ℝ) / 50000) := by
    rw [Fin.sum_univ_four]
    linarith only [ht 0, ht 1, ht 2, ht 3]
  constructor
  · linarith only [ht 3, horder, hmove0]
  · linarith only [hbeta, hmove, hδsmall]

theorem sum_Icc_inv_sq_le (N r : ℕ) (hr : 2 ≤ r) :
    (∑ m ∈ Finset.Icc r N, (1 : ℝ) / (m : ℝ) ^ 2) ≤
      1 / ((r - 1 : ℕ) : ℝ) := by
  by_cases hrN : r ≤ N
  · simpa only [← Finset.Icc_add_one_left_eq_Ioc,
      Nat.sub_add_cancel (by omega : 1 ≤ r), one_div] using
      (sum_Ioc_inv_sq_le_sub (α := ℝ) (k := r - 1) (n := N)
        (by omega) (by omega)).trans
        (sub_le_self _ (inv_nonneg.mpr (Nat.cast_nonneg N)))
  · rw [Finset.Icc_eq_empty_of_lt (lt_of_not_ge hrN), Finset.sum_empty]
    positivity

theorem large_square_divisor_count_le (N r : ℕ) (hr : 2 ≤ r) :
    (((Finset.Icc 1 N).filter
      (fun n => ∃ m ∈ Finset.Icc r N, m ^ 2 ∣ n)).card : ℝ) ≤
      (N : ℝ) / ((r - 1 : ℕ) : ℝ) := by
  have hI : Finset.Icc 1 N = Finset.Ioc 0 N :=
    Finset.Icc_succ_left_eq_Ioc (0 : ℕ) N
  have hU : (Finset.Icc 1 N).filter
      (fun n => ∃ m ∈ Finset.Icc r N, m ^ 2 ∣ n) =
      (Finset.Icc r N).biUnion
        (fun m => (Finset.Icc 1 N).filter (fun n => m ^ 2 ∣ n)) := by
    ext n
    simp only [Finset.mem_filter, Finset.mem_biUnion, ← exists_and_left, and_left_comm]
  have hcard : ((Finset.Icc 1 N).filter
      (fun n => ∃ m ∈ Finset.Icc r N, m ^ 2 ∣ n)).card ≤
      ∑ m ∈ Finset.Icc r N, N / (m ^ 2) := by
    rw [hU]
    refine Finset.card_biUnion_le.trans (Finset.sum_le_sum fun m _ => ?_)
    exact (show ((Finset.Icc 1 N).filter (fun n => m ^ 2 ∣ n)).card =
        N / (m ^ 2) by rw [hI, Nat.Ioc_filter_dvd_card_eq_div]).le
  have hcast : (((Finset.Icc 1 N).filter
      (fun n => ∃ m ∈ Finset.Icc r N, m ^ 2 ∣ n)).card : ℝ) ≤
      ∑ m ∈ Finset.Icc r N, ((N / (m ^ 2) : ℕ) : ℝ) := by
    exact_mod_cast hcard
  calc
    _ ≤ ∑ m ∈ Finset.Icc r N, ((N / (m ^ 2) : ℕ) : ℝ) := hcast
    _ ≤ ∑ m ∈ Finset.Icc r N, (N : ℝ) / (m : ℝ) ^ 2 := by
      refine Finset.sum_le_sum fun m _ => ?_
      simpa only [Nat.cast_pow] using
        (Nat.cast_div_le (m := N) (n := m ^ 2) :
          ((N / (m ^ 2) : ℕ) : ℝ) ≤ (N : ℝ) / ((m ^ 2 : ℕ) : ℝ))
    _ = (N : ℝ) * (∑ m ∈ Finset.Icc r N, (1 : ℝ) / (m : ℝ) ^ 2) := by
      simp only [div_eq_mul_inv, Finset.mul_sum, one_mul]
    _ ≤ (N : ℝ) * (1 / ((r - 1 : ℕ) : ℝ)) :=
      mul_le_mul_of_nonneg_left (sum_Icc_inv_sq_le N r hr) (Nat.cast_nonneg N)
    _ = (N : ℝ) / ((r - 1 : ℕ) : ℝ) := by rw [mul_one_div]

theorem exceptional_rank_permutation_counts
    (E : Finset (Fin 5 × Fin 5))
    (hE : ∀ t ∈ E, t.1 < t.2) :
    ((Finset.univ : Finset (Equiv.Perm (Fin 5))).filter
      (fun σ => σ 3 < σ 2 ∧ σ 2 < σ 1 ∧ σ 1 < σ 0 ∧
        σ 3 ≤ σ 4 ∧ (σ 1, σ 0) ∈ E)).card =
        (if (3, 4) ∈ E then 2 else 0) +
          (if (2, 4) ∈ E then 1 else 0) +
          (if (2, 3) ∈ E then 1 else 0) ∧
    ((Finset.univ : Finset (Equiv.Perm (Fin 5))).filter
      (fun σ => σ 1 < σ 0 ∧ σ 1 < σ 2 ∧ σ 3 ≤ σ 4 ∧
        (min (σ 0) (σ 2), max (σ 0) (σ 2)) ∈ E)).card =
        2 * ∑ t ∈ E, t.1.val := by
  let P : Finset (Equiv.Perm (Fin 5)) := permsOfFinset (Finset.univ : Finset (Fin 5))
  let A := P.filter
    (fun σ => σ 3 < σ 2 ∧ σ 2 < σ 1 ∧ σ 1 < σ 0 ∧ σ 3 ≤ σ 4)
  let B := P.filter (fun σ => σ 1 < σ 0 ∧ σ 1 < σ 2 ∧ σ 3 ≤ σ 4)
  have hP : P = (Finset.univ : Finset (Equiv.Perm (Fin 5))) := by
    ext σ
    simp [P, mem_perms_of_finset_iff]
  have hfibers : ∀ t : Fin 5 × Fin 5,
      (A.filter (fun σ => (σ 1, σ 0) = t)).card =
        (if t = (3, 4) then 2 else 0) +
          (if t = (2, 4) then 1 else 0) +
          (if t = (2, 3) then 1 else 0) ∧
      (B.filter (fun σ => (min (σ 0) (σ 2), max (σ 0) (σ 2)) = t)).card =
        if t.1 < t.2 then 2 * t.1.val else 0 := by
    decide
  constructor
  · calc
      _ = (A.filter (fun σ => (σ 1, σ 0) ∈ E)).card := by
        simp only [A, Finset.filter_filter, hP, and_assoc]
      _ = ∑ t ∈ E, (A.filter (fun σ => (σ 1, σ 0) = t)).card :=
        (Finset.sum_card_fiberwise_eq_card_filter A E (fun σ => (σ 1, σ 0))).symm
      _ = ∑ t ∈ E, ((if t = (3, 4) then 2 else 0) +
          (if t = (2, 4) then 1 else 0) +
          (if t = (2, 3) then 1 else 0)) :=
        Finset.sum_congr rfl fun t _ => (hfibers t).1
      _ = _ := by simp only [Finset.sum_add_distrib, Finset.sum_ite_eq']
  · calc
      _ = (B.filter
          (fun σ => (min (σ 0) (σ 2), max (σ 0) (σ 2)) ∈ E)).card := by
        simp only [B, Finset.filter_filter, hP, and_assoc]
      _ = ∑ t ∈ E,
          (B.filter (fun σ => (min (σ 0) (σ 2), max (σ 0) (σ 2)) = t)).card :=
        (Finset.sum_card_fiberwise_eq_card_filter B E
          (fun σ => (min (σ 0) (σ 2), max (σ 0) (σ 2)))).symm
      _ = ∑ t ∈ E, 2 * t.1.val := by
        apply Finset.sum_congr rfl
        intro t ht
        rw [(hfibers t).2, ite_eq_left (hE t ht)]
      _ = _ := by rw [Finset.mul_sum]

theorem exceptional_rank_lower_set_bound
    (E : Finset (Fin 5 × Fin 5))
    (hE : ∀ t ∈ E, t.1 < t.2)
    (hlower : ∀ t ∈ E, ∀ r s : Fin 5,
      r < s → r ≤ t.1 → s ≤ t.2 → (r, s) ∈ E) :
    5 * ((if (3, 4) ∈ E then 2 else 0) +
      (if (2, 4) ∈ E then 1 else 0) +
      (if (2, 3) ∈ E then 1 else 0) +
      2 * ∑ t ∈ E, t.1.val) ≤ 12 * E.card := by
  let T : Finset (Fin 5 × Fin 5) := Finset.univ.filter (fun t => t.1 < t.2)
  have hET : E ⊆ T := by
    intro t ht
    exact Finset.mem_filter.mpr ⟨Finset.mem_univ t, hE t ht⟩
  have hsum (S : Finset (Fin 5 × Fin 5)) (hES : E ⊆ S) :
      (∑ t ∈ E, t.1.val) ≤ ∑ t ∈ S, t.1.val :=
    Finset.sum_le_sum_of_subset hES
  have hdown (r s : Fin 5) (hrs : (r, s) ∈ E) :
      (T.filter (fun t => t.1 ≤ r ∧ t.2 ≤ s)).card ≤ E.card := by
    apply Finset.card_le_card
    intro t ht
    obtain ⟨htT, htr, hts⟩ := Finset.mem_filter.mp ht
    exact hlower (r, s) hrs t.1 t.2 (Finset.mem_filter.mp htT).2 htr hts
  by_cases h45 : (3, 4) ∈ E
  · have h35 : (2, 4) ∈ E := hlower (3, 4) h45 2 4 (by decide) (by decide) (by decide)
    have h34 : (2, 3) ∈ E := hlower (3, 4) h45 2 3 (by decide) (by decide) (by decide)
    have hcard : 10 ≤ E.card := by
      have hc := hdown 3 4 h45
      have he : (T.filter (fun t => t.1 ≤ 3 ∧ t.2 ≤ 4)).card = 10 := by decide
      simpa only [he] using hc
    have hsum10 : (∑ t ∈ E, t.1.val) ≤ 10 := by
      have hs := hsum T hET
      have he : (∑ t ∈ T, t.1.val) = 10 := by decide
      simpa only [he] using hs
    simp only [h45, h35, h34, ite_true]
    omega
  · have hET45 : E ⊆ T.erase (3, 4) := Finset.subset_erase.mpr ⟨hET, h45⟩
    by_cases h35 : (2, 4) ∈ E
    · have h34 : (2, 3) ∈ E :=
        hlower (2, 4) h35 2 3 (by decide) (by decide) (by decide)
      have hcard : 9 ≤ E.card := by
        have hc := hdown 2 4 h35
        have he : (T.filter (fun t => t.1 ≤ 2 ∧ t.2 ≤ 4)).card = 9 := by decide
        simpa only [he] using hc
      have hsum7 : (∑ t ∈ E, t.1.val) ≤ 7 := by
        have hs := hsum (T.erase (3, 4)) hET45
        have he : (∑ t ∈ T.erase (3, 4), t.1.val) = 7 := by decide
        simpa only [he] using hs
      simp only [h45, h35, h34, ite_false, ite_true]
      omega
    · have hET35 : E ⊆ (T.erase (3, 4)).erase (2, 4) :=
        Finset.subset_erase.mpr ⟨hET45, h35⟩
      by_cases h34 : (2, 3) ∈ E
      · have hcard : 6 ≤ E.card := by
          have hc := hdown 2 3 h34
          have he : (T.filter (fun t => t.1 ≤ 2 ∧ t.2 ≤ 3)).card = 6 := by decide
          simpa only [he] using hc
        have hsum5 : (∑ t ∈ E, t.1.val) ≤ 5 := by
          have hs := hsum ((T.erase (3, 4)).erase (2, 4)) hET35
          have he : (∑ t ∈ (T.erase (3, 4)).erase (2, 4), t.1.val) = 5 := by decide
          simpa only [he] using hs
        simp only [h45, h35, h34, ite_false, ite_true]
        omega
      · have hsmall : ∀ t : Fin 5 × Fin 5,
            t.1 < t.2 → t ≠ (3, 4) → t ≠ (2, 4) → t ≠ (2, 3) → t.1.val ≤ 1 := by
          decide
        have hsum1 : (∑ t ∈ E, t.1.val) ≤ E.card := by
          simpa using Finset.sum_le_card_nsmul E (fun t => t.1.val) 1
            (fun t ht => hsmall t (hE t ht) (fun h => h45 (h ▸ ht))
              (fun h => h35 (h ▸ ht)) (fun h => h34 (h ▸ ht)))
        simp only [h45, h35, h34, ite_false]
        omega

open Set

theorem integral_positivePart_pow (n : ℕ) (hn : 0 < n) (x : ℝ) :
    (∫ t in (0 : ℝ)..1, (max (x - t) 0) ^ n) =
      ((max x 0) ^ (n + 1) - (max (x - 1) 0) ^ (n + 1)) /
        ((n + 1 : ℕ) : ℝ) := by
  have hc : Continuous (fun y : ℝ => (max y 0) ^ n) :=
    (continuous_id.max continuous_const).pow n
  have hzero (y : ℝ) :
      (∫ t in (0 : ℝ)..y, (max t 0) ^ n) =
        (max y 0) ^ (n + 1) / ((n + 1 : ℕ) : ℝ) := by
    by_cases hy : 0 ≤ y
    · have heq : (∫ t in (0 : ℝ)..y, (max t 0) ^ n) =
          ∫ t in (0 : ℝ)..y, t ^ n := by
        apply intervalIntegral.integral_congr_Ioo_of_le hy
        intro t ht
        exact congrArg (fun z : ℝ => z ^ n) (max_eq_left ht.1.le)
      rw [heq, integral_pow]
      simp [max_eq_left hy]
    · have hy0 : y ≤ 0 := (lt_of_not_ge hy).le
      have heq : (∫ t in y..(0 : ℝ), (max t 0) ^ n) = 0 := by
        calc
          _ = ∫ _ in y..(0 : ℝ), (0 : ℝ) := by
            apply intervalIntegral.integral_congr_Ioo_of_le hy0
            intro t ht
            simp [max_eq_right ht.2.le, zero_pow (Nat.ne_of_gt hn)]
          _ = 0 := by simp
      rw [intervalIntegral.integral_symm y 0, heq]
      simp [max_eq_right hy0]
  have hinter (a b : ℝ) :
      (∫ t in a..b, (max t 0) ^ n) =
        ((max b 0) ^ (n + 1) - (max a 0) ^ (n + 1)) /
          ((n + 1 : ℕ) : ℝ) := by
    have hadd := intervalIntegral.integral_add_adjacent_intervals (μ := volume)
      (hc.intervalIntegrable 0 a) (hc.intervalIntegrable a b)
    rw [hzero a, hzero b] at hadd
    rw [sub_div]
    linarith
  rw [intervalIntegral.integral_comp_sub_left (fun t : ℝ => (max t 0) ^ n) x]
  simpa using hinter (x - 1) x

theorem integral_iterate_fwdDiff (n : ℕ) (f : ℝ → ℝ)
    (hf : Continuous f) (x : ℝ) :
    (∫ t in (0 : ℝ)..1, ((fwdDiff (1 : ℝ))^[n] f) (x - t)) =
      ((fwdDiff (1 : ℝ))^[n] (fun y => ∫ t in (0 : ℝ)..1, f (y - t))) x := by
  simp_rw [fwdDiff_iter_eq_sum_shift, zsmul_eq_mul, nsmul_eq_mul, mul_one]
  rw [intervalIntegral.integral_finsetSum]
  · apply Finset.sum_congr rfl
    intro k _
    rw [intervalIntegral.integral_const_mul]
    congr 1
    apply intervalIntegral.integral_congr
    intro t _
    exact congrArg f (by ring)
  · intro k _
    exact (continuous_const.mul
      (hf.comp ((continuous_const.sub continuous_id).add continuous_const))).intervalIntegrable _ _

theorem unitCubeCDF_succ (m : ℕ) (x : ℝ) :
    (Measure.pi (fun _ : Fin (m + 1) =>
      volume.restrict (Ico (0 : ℝ) 1))).real
        {u : Fin (m + 1) → ℝ | (∑ i, u i) < x} =
      ∫ t in (0 : ℝ)..1,
        (Measure.pi (fun _ : Fin m =>
          volume.restrict (Ico (0 : ℝ) 1))).real
            {u : Fin m → ℝ | (∑ i, u i) < x - t} := by
  classical
  let μ : Measure ℝ := volume.restrict (Ico (0 : ℝ) 1)
  have : IsProbabilityMeasure μ := by
    constructor
    simp [μ, Real.volume_Ico]
  let CDF (n : ℕ) (y : ℝ) :=
    (Measure.pi (fun _ : Fin n => μ)).real {u : Fin n → ℝ | (∑ i, u i) < y}
  have hs (n : ℕ) (y : ℝ) :
      MeasurableSet {u : Fin n → ℝ | (∑ i, u i) < y} :=
    measurableSet_lt
      (Finset.measurable_sum _ (fun i _ => measurable_pi_apply i)) measurable_const
  have hCDF (n : ℕ) (y : ℝ) :
      CDF n y = ∫ u, ({u : Fin n → ℝ | (∑ i, u i) < y}).indicator
        (fun _ => (1 : ℝ)) u ∂Measure.pi (fun _ : Fin n => μ) := by
    simpa only [CDF, smul_eq_mul, mul_one] using
      (integral_indicator_const (μ := Measure.pi (fun _ : Fin n => μ))
        (1 : ℝ) (hs n y)).symm
  let e := MeasurableEquiv.piFinSuccAbove (fun _ : Fin (m + 1) => ℝ) 0
  let s : Set (ℝ × (Fin m → ℝ)) := {v | v.1 + (∑ i, v.2 i) < x}
  let F : ℝ × (Fin m → ℝ) → ℝ := s.indicator (fun _ => 1)
  have hs' : MeasurableSet s :=
    measurableSet_lt (measurable_fst.add
      (Finset.measurable_sum _ (fun i _ =>
        (measurable_pi_apply i).comp measurable_snd))) measurable_const
  have hF : Integrable F (μ.prod (Measure.pi (fun _ : Fin m => μ))) :=
    (integrable_const (μ := μ.prod (Measure.pi (fun _ : Fin m => μ)))
      (1 : ℝ)).indicator hs'
  have hp : MeasurePreserving e (Measure.pi (fun _ : Fin (m + 1) => μ))
      (μ.prod (Measure.pi (fun _ : Fin m => μ))) :=
    measurePreserving_piFinSuccAbove (fun _ : Fin (m + 1) => μ) 0
  have hcomp : (fun u => F (e u)) =
      ({u : Fin (m + 1) → ℝ | (∑ i, u i) < x}).indicator (fun _ => (1 : ℝ)) := by
    funext u
    have hsum : (e u).1 + (∑ i, (e u).2 i) = ∑ i, u i := by
      change u 0 + (∑ i : Fin m, u i.succ) = ∑ i : Fin (m + 1), u i
      exact (Fin.sum_univ_succ u).symm
    change (if (e u).1 + (∑ i, (e u).2 i) < x then (1 : ℝ) else 0) =
      (if (∑ i, u i) < x then 1 else 0)
    rw [hsum]
  change CDF (m + 1) x = ∫ t in (0 : ℝ)..1, CDF m (x - t)
  calc
    CDF (m + 1) x = ∫ u, F (e u) ∂Measure.pi (fun _ : Fin (m + 1) => μ) := by
      rw [hCDF, hcomp]
    _ = ∫ v, F v ∂μ.prod (Measure.pi (fun _ : Fin m => μ)) := hp.integral_comp' F
    _ = ∫ t, ∫ u, F (t, u) ∂Measure.pi (fun _ : Fin m => μ) ∂μ := integral_prod F hF
    _ = ∫ t, CDF m (x - t) ∂μ := by
      apply integral_congr_ae
      apply Filter.Eventually.of_forall
      intro t
      change (∫ u, F (t, u) ∂Measure.pi (fun _ : Fin m => μ)) = CDF m (x - t)
      rw [hCDF]
      apply integral_congr_ae
      apply Filter.Eventually.of_forall
      intro u
      have hlt : t + (∑ i, u i) < x ↔ (∑ i, u i) < x - t :=
        lt_sub_iff_add_lt'.symm
      simp only [F, s, Set.indicator_apply, Set.mem_ofPred_eq, hlt]
    _ = ∫ t in (0 : ℝ)..1, CDF m (x - t) := by
      dsimp only [μ]
      rw [integral_Ico_eq_integral_Ioc,
        ← intervalIntegral.integral_of_le (by norm_num : (0 : ℝ) ≤ 1)]

theorem unitCubeCDF_one (x : ℝ) :
    (Measure.pi (fun _ : Fin 1 =>
      volume.restrict (Ico (0 : ℝ) 1))).real
        {u : Fin 1 → ℝ | (∑ i, u i) < x} =
      max x 0 - max (x - 1) 0 := by
  let μ : Measure ℝ := volume.restrict (Ico (0 : ℝ) 1)
  let e := MeasurableEquiv.piUnique (fun _ : Fin 1 => ℝ)
  have hp : MeasurePreserving e (Measure.pi (fun _ : Fin 1 => μ)) μ :=
    measurePreserving_piUnique (fun _ : Fin 1 => μ)
  have hset : e ⁻¹' Iio x = {u : Fin 1 → ℝ | (∑ i, u i) < x} := by
    ext u
    change u 0 < x ↔ (∑ i : Fin 1, u i) < x
    simp only [Fin.sum_univ_one]
  have hclip :
      (Measure.pi (fun _ : Fin 1 => μ)).real
        {u : Fin 1 → ℝ | (∑ i, u i) < x} = max (min x 1) 0 := by
    calc
      _ = ((Measure.pi (fun _ : Fin 1 => μ)).map e).real (Iio x) := by
        rw [map_measureReal_apply e.measurable measurableSet_Iio, hset]
      _ = μ.real (Iio x) := by rw [hp.map_eq]
      _ = volume.real (Ico (0 : ℝ) (min x 1)) := by
        dsimp only [μ]
        rw [measureReal_restrict_apply measurableSet_Iio]
        congr 1
        ext t
        simp only [mem_inter_iff, mem_Iio, mem_Ico, lt_min_iff]
        tauto
      _ = max (min x 1) 0 := by rw [Real.volume_real_Ico]; simp
  change (Measure.pi (fun _ : Fin 1 => μ)).real
    {u : Fin 1 → ℝ | (∑ i, u i) < x} = _
  rw [hclip, max_min_distrib_right, max_eq_left zero_le_one]
  have h := min_add_max (max x 0) (1 : ℝ)
  rw [max_assoc, max_eq_right zero_le_one] at h
  have ht : max (x - 1) 0 = max x 1 - 1 := by
    simpa using max_sub_sub_right x (1 : ℝ) 1
  rw [ht]
  linarith

theorem unitCubeCDF_forwardDifference (m : ℕ) (hm : 0 < m) (x : ℝ) :
    (Measure.pi (fun _ : Fin m =>
      volume.restrict (Ico (0 : ℝ) 1))).real
        {u : Fin m → ℝ | (∑ i, u i) < x} =
      ((fwdDiff (1 : ℝ))^[m] (fun y : ℝ => (max y 0) ^ m))
        (x - (m : ℝ)) / (m.factorial : ℝ) := by
  have hdiv (k : ℕ) (f : ℝ → ℝ) (a : ℝ) :
      (fwdDiff (1 : ℝ))^[k] (fun y => f y / a) =
        fun y => ((fwdDiff (1 : ℝ))^[k] f) y / a := by
    simpa only [Pi.smul_def, div_eq_mul_inv, smul_eq_mul, mul_comm] using
      fwdDiff_iter_const_smul (1 : ℝ) a⁻¹ f k
  have hback (k : ℕ) (f : ℝ → ℝ) (y : ℝ) :
      ((fwdDiff (1 : ℝ))^[k] (fun z => f z - f (z - 1))) y =
        ((fwdDiff (1 : ℝ))^[k + 1] f) (y - 1) := by
    have hfun : (fun z => f z - f (z - 1)) =
        fun z => fwdDiff (1 : ℝ) f (z + (-1)) := by
      funext z
      simp [fwdDiff, sub_eq_add_neg]
    rw [hfun, fwdDiff_iter_comp_add, ← Function.iterate_succ_apply]
    rfl
  obtain ⟨n, rfl⟩ := Nat.exists_eq_succ_of_ne_zero (Nat.ne_of_gt hm)
  clear hm
  induction n generalizing x with
  | zero => simpa [fwdDiff] using unitCubeCDF_one x
  | succ n ih =>
    rw [unitCubeCDF_succ]
    simp_rw [ih]
    simp_rw [sub_right_comm x _ ((n + 1 : ℕ) : ℝ)]
    rw [intervalIntegral.integral_div,
      integral_iterate_fwdDiff (n + 1) (fun y : ℝ => (max y 0) ^ (n + 1))
        ((continuous_id.max continuous_const).pow (n + 1))]
    simp_rw [integral_positivePart_pow (n + 1) (by omega)]
    rw [hdiv]
    dsimp only
    rw [hback, div_div, Nat.factorial_succ (n + 1), Nat.cast_mul]
    simp only [Nat.succ_eq_add_one, Nat.cast_add, Nat.cast_one, sub_add_eq_sub_sub]

theorem unitCube_carry_eq_forwardDifference (m a : ℕ) (hm : 0 < m) :
    (volume : Measure (Fin m → ℝ))
      (Icc (fun _ : Fin m => (0 : ℝ)) (fun _ => (1 : ℝ)) ∩
        {x | (a : ℝ) ≤ ∑ i : Fin m, x i ∧
          (∑ i : Fin m, x i) < (a : ℝ) + 1}) =
      ENNReal.ofReal
        (((fwdDiff (1 : ℝ))^[m + 1] (fun x : ℝ => (max x 0) ^ m))
          ((a : ℝ) - (m : ℝ)) / (m.factorial : ℝ)) := by
  classical
  let μ : Measure ℝ := volume.restrict (Ico (0 : ℝ) 1)
  have : IsProbabilityMeasure μ := by
    constructor
    simp [μ, Real.volume_Ico]
  let A : Set (Fin m → ℝ) :=
    {u | (a : ℝ) ≤ ∑ i, u i ∧ (∑ i, u i) < (a : ℝ) + 1}
  have hsum : Measurable (fun u : Fin m → ℝ => ∑ i, u i) :=
    Finset.measurable_sum _ (fun i _ => measurable_pi_apply i)
  have hA : MeasurableSet A :=
    (measurableSet_le measurable_const hsum).inter (measurableSet_lt hsum measurable_const)
  have hclosed :
      volume (Icc (fun _ : Fin m => (0 : ℝ)) (fun _ => (1 : ℝ)) ∩ A) =
        (Measure.pi (fun _ : Fin m => μ)) A := by
    have heq :
        (Set.univ.pi (fun _ : Fin m => Ico (0 : ℝ) 1)) =ᵐ[volume]
          Icc (fun _ : Fin m => (0 : ℝ)) (fun _ => (1 : ℝ)) :=
      Measure.univ_pi_Ico_ae_eq_Icc
    calc
      _ = volume ((Set.univ.pi (fun _ : Fin m => Ico (0 : ℝ) 1)) ∩ A) :=
        (measure_congr (heq.inter (ae_eq_refl A))).symm
      _ = (Measure.pi (fun _ : Fin m => μ)) A := by
        rw [← Measure.restrict_pi_pi, ← volume_pi, Measure.restrict_apply hA, Set.inter_comm]
  have hreal :
      (Measure.pi (fun _ : Fin m => μ)).real A =
        ((fwdDiff (1 : ℝ))^[m + 1] (fun x : ℝ => (max x 0) ^ m))
          ((a : ℝ) - (m : ℝ)) / (m.factorial : ℝ) := by
    let S (y : ℝ) : Set (Fin m → ℝ) := {u | (∑ i, u i) < y}
    have hset : A = S ((a : ℝ) + 1) \ S a := by
      ext u
      simp [A, S, and_comm]
    have hsub : S (a : ℝ) ⊆ S ((a : ℝ) + 1) := by
      intro u hu
      change (∑ i, u i) < (a : ℝ) at hu
      exact lt_trans hu (lt_add_of_pos_right _ zero_lt_one)
    rw [hset, measureReal_sdiff hsub (measurableSet_lt hsum measurable_const)]
    change (Measure.pi (fun _ : Fin m => volume.restrict (Ico (0 : ℝ) 1))).real
        {u : Fin m → ℝ | (∑ i, u i) < (a : ℝ) + 1} -
      (Measure.pi (fun _ : Fin m => volume.restrict (Ico (0 : ℝ) 1))).real
        {u : Fin m → ℝ | (∑ i, u i) < (a : ℝ)} = _
    rw [unitCubeCDF_forwardDifference m hm, unitCubeCDF_forwardDifference m hm, ← sub_div]
    congr 1
    rw [Function.iterate_succ_apply']
    simp only [fwdDiff]
    rw [show (a : ℝ) + 1 - (m : ℝ) = (a : ℝ) - (m : ℝ) + 1 by ring]
  change volume (Icc (fun _ : Fin m => (0 : ℝ)) (fun _ => (1 : ℝ)) ∩ A) = _
  rw [hclosed, ← ofReal_measureReal, hreal]

end PrimeGap186

theorem PrimeGap186.theta6_a0_largest_prime_split
    (p m : ℕ) (hp : Nat.Prime p) (hm : 0 < m)
    (hmax : ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p)
    (z H S M0 : ℝ) :
    (if 1 < z ∧ ((p * m : ℕ) : ℝ) ≤ M0 then
      ∑ p2 ∈ (p * m).primeFactors,
        ∑ p3 ∈ (p * m).primeFactors,
          ∑ p4 ∈ (p * m).primeFactors,
            if p2 * p3 * p4 ∣ p * m ∧
                z ≤ (p3 : ℝ) ∧ p3 < p2 ∧ (p2 : ℝ) < H ∧
                p3 ≤ p4 ∧ ((p3 * p4 : ℕ) : ℝ) < H ∧
                (p2 : ℝ) < S ∧
                (p * m) / (p2 * p3 * p4) ∈ Nat.smoothNumbers ⌈z⌉₊
            then ArithmeticFunction.moebius ((p * m) / (p2 * p3 * p4))
            else 0
      else 0) =
    if 1 < z ∧ ((p * m : ℕ) : ℝ) ≤ M0 then
      (∑ u ∈ m.primeFactors, ∑ v ∈ m.primeFactors,
        if u * v ∣ m ∧
            z ≤ (u : ℝ) ∧ u < p ∧ (p : ℝ) < H ∧
            u ≤ v ∧ ((u * v : ℕ) : ℝ) < H ∧ (p : ℝ) < S ∧
            m / (u * v) ∈ Nat.smoothNumbers ⌈z⌉₊
        then ArithmeticFunction.moebius (m / (u * v))
        else 0) +
      (∑ u ∈ m.primeFactors, ∑ v ∈ m.primeFactors,
        if u * v ∣ m ∧
            z ≤ (v : ℝ) ∧ v < u ∧ (u : ℝ) < H ∧
            v ≤ p ∧ ((v * p : ℕ) : ℝ) < H ∧ (u : ℝ) < S ∧
            m / (u * v) ∈ Nat.smoothNumbers ⌈z⌉₊
        then ArithmeticFunction.moebius (m / (u * v))
        else 0)
    else 0 := by
  split_ifs
  · let F (a b c : ℕ) : ℤ :=
      if a * b * c ∣ p * m ∧
          z ≤ (b : ℝ) ∧ b < a ∧ (a : ℝ) < H ∧
          b ≤ c ∧ ((b * c : ℕ) : ℝ) < H ∧ (a : ℝ) < S ∧
          (p * m) / (a * b * c) ∈ Nat.smoothNumbers ⌈z⌉₊
      then ArithmeticFunction.moebius ((p * m) / (a * b * c))
      else 0
    change (∑ a ∈ (p * m).primeFactors, ∑ b ∈ (p * m).primeFactors,
      ∑ c ∈ (p * m).primeFactors, F a b c) = _
    have hnot : ¬p ∣ m := fun h => (lt_irrefl p) (hmax p hp h)
    have hnotmem : p ∉ m.primeFactors := by simp [Nat.mem_primeFactors, hnot]
    have hlt (t : ℕ) (ht : t ∈ m.primeFactors) : t < p :=
      hmax t (Nat.prime_of_mem_primeFactors ht) (Nat.dvd_of_mem_primeFactors ht)
    have hdouble (b : ℕ) : F p b p = 0 := by
      apply ite_eq_right
      rintro ⟨hdiv, _⟩
      simp only [mul_assoc, Nat.mul_dvd_mul_iff_left hp.pos] at hdiv
      exact hnot ((dvd_mul_left p b).trans hdiv)
    have hsmall (a b c : ℕ) (ha : a ∈ m.primeFactors)
        (hb : b ∈ m.primeFactors) (hc : c ∈ m.primeFactors) : F a b c = 0 := by
      apply ite_eq_right
      rintro ⟨hdiv, hz, _, _, _, _, _, hsmooth⟩
      have hndiv : ¬p ∣ a * b * c :=
        hp.not_dvd_mul
          (hp.not_dvd_mul
            (fun h => hnot (h.trans (Nat.dvd_of_mem_primeFactors ha)))
            (fun h => hnot (h.trans (Nat.dvd_of_mem_primeFactors hb))))
          (fun h => hnot (h.trans (Nat.dvd_of_mem_primeFactors hc)))
      have hpd : p ∣ (p * m) / (a * b * c) :=
        (hp.dvd_or_dvd (by
          simpa only [Nat.mul_div_cancel' hdiv] using dvd_mul_right p m)).resolve_left hndiv
      have hpz : (p : ℝ) < z := Nat.lt_ceil.mp
        ((Nat.mem_smoothNumbers'.mp hsmooth) p hp hpd)
      exact not_lt_of_ge hz ((Nat.cast_lt.mpr (hlt b hb)).trans hpz)
    have hrow (a : ℕ) (ha : a ≤ p) :
        (∑ b ∈ insert p m.primeFactors, ∑ c ∈ insert p m.primeFactors, F a b c) =
          ∑ b ∈ m.primeFactors, (F a b p + ∑ c ∈ m.primeFactors, F a b c) := by
      simp [Finset.sum_insert, hnotmem, F, not_lt_of_ge ha]
    simp only [Nat.primeFactors_mul hp.ne_zero hm.ne', hp.primeFactors, Finset.singleton_union]
    rw [Finset.sum_insert hnotmem, hrow p le_rfl]
    simp only [hdouble, zero_add]
    congr 1
    · simp only [F, mul_assoc, Nat.mul_dvd_mul_iff_left hp.pos,
        Nat.mul_div_mul_left _ _ hp.pos]
    · apply Finset.sum_congr rfl
      intro u hu
      rw [hrow u (hlt u hu).le]
      apply Finset.sum_congr rfl
      intro v hv
      rw [Finset.sum_eq_zero (fun c hc => hsmall u v c hu hv hc), add_zero]
      simp only [F, mul_comm (u * v) p, Nat.mul_dvd_mul_iff_left hp.pos,
        Nat.mul_div_mul_left _ _ hp.pos]
  · rfl

namespace PrimeGap186

theorem theta2_prime_tuples_eq (x : ℝ) (hx : 1 < x) :
    siftedPrimeTuples x (1 : Fin 6) =
      ((Nat.primesBelow (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
        (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ))).image
        (fun p => [p]) := by
  classical
  ext ps
  have hm := mem_siftedPrimeTuples_iff x hx (1 : Fin 6) ps
  dsimp only at hm
  rw [hm]
  rcases ps with _ | ⟨p, _ | ⟨q, qs⟩⟩
  · simp
  · simp only [Finset.mem_image, List.cons.injEq, and_true,
      exists_eq_right, Finset.mem_filter, Nat.mem_primesBelow, Nat.lt_ceil]
    constructor
    · rintro ⟨hp, hlo, hhi⟩
      exact ⟨⟨(Real.logb_lt_iff_lt_rpow hx (Nat.cast_pos.mpr hp.pos)).1 hhi, hp⟩,
        (Real.le_logb_iff_rpow_le hx (Nat.cast_pos.mpr hp.pos)).1 hlo⟩
    · rintro ⟨⟨hhi, hp⟩, hlo⟩
      exact ⟨hp, (Real.le_logb_iff_rpow_le hx (Nat.cast_pos.mpr hp.pos)).2 hlo,
        (Real.logb_lt_iff_lt_rpow hx (Nat.cast_pos.mpr hp.pos)).2 hhi⟩
  · simp

theorem siftedTheta_one_eq_prime_sum (x : ℝ) (hx : 1 < x) (n : ℕ) :
    siftedTheta x (1 : Fin 6) (fun _ => 1) n =
      ∑ p ∈ (Nat.primesBelow (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
          (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ)),
        ∑ d ∈ n.divisorsAntidiagonal,
          if d.1 = p then roughWeight (x ^ ((9519 : ℝ) / 50000)) d.2 else 0 := by
  classical
  change (∑ ps ∈ siftedPrimeTuples x (1 : Fin 6),
    ∑ d ∈ n.divisorsAntidiagonal,
      if d.1 = ps.prod then 1 * roughWeight (x ^ ((9519 : ℝ) / 50000)) d.2
      else 0) = _
  rw [theta2_prime_tuples_eq x hx, Finset.sum_image List.singleton_injective.injOn]
  simp

theorem theta2_semiprime_summand (x : ℝ) (hx : 1 < x) (n : ℕ)
    (hn : x ≤ (n : ℝ)) :
    (if ArithmeticFunction.cardFactors n = 2 then
      siftedTheta x (1 : Fin 6) (fun _ => 1) n else 0) =
      ∑ p ∈ (Nat.primesBelow (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
          (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ)),
        ∑ d ∈ n.divisorsAntidiagonal,
          if d.1 = p then if d.2.Prime then (1 : ℝ) else 0 else 0 := by
  classical
  rw [siftedTheta_one_eq_prime_sum x hx]
  simp_rw [Finset.ite_sum_zero]
  apply Finset.sum_congr rfl
  intro p hp
  rcases Finset.mem_filter.mp hp with ⟨hp, _⟩
  rcases Nat.mem_primesBelow.mp hp with ⟨hpceil, hp⟩
  have hpx : (p : ℝ) < x ^ ((40481 : ℝ) / 100000) := Nat.lt_ceil.mp hpceil
  have hp0 : (0 : ℝ) < p := Nat.cast_pos.mpr hp.pos
  apply Finset.sum_congr rfl
  intro d hd
  by_cases hdp : d.1 = p
  · have hdq0 := Nat.right_ne_zero_of_mem_divisorsAntidiagonal hd
    have hprod : p * d.2 = n := by
      simpa only [hdp] using (Nat.mem_divisorsAntidiagonal.mp hd).1
    have hcard : ArithmeticFunction.cardFactors n = 2 ↔ d.2.Prime := by
      rw [← hprod, ArithmeticFunction.cardFactors_mul hp.ne_zero hdq0,
        ArithmeticFunction.cardFactors_apply_prime hp,
        ← ArithmeticFunction.cardFactors_eq_one_iff_prime]
      omega
    have hrough : d.2.Prime →
        roughWeight (x ^ ((9519 : ℝ) / 50000)) d.2 = 1 := by
      intro hq
      have hx0 : 0 < x := zero_lt_one.trans hx
      have hbound : (p : ℝ) * x ^ ((9519 : ℝ) / 50000) < x := by
        calc
          (p : ℝ) * x ^ ((9519 : ℝ) / 50000) <
              x ^ ((40481 : ℝ) / 100000) * x ^ ((9519 : ℝ) / 50000) :=
            mul_lt_mul_of_pos_right hpx (Real.rpow_pos_of_pos hx0 _)
          _ = x ^ (((40481 : ℝ) / 100000) + ((9519 : ℝ) / 50000)) :=
            (Real.rpow_add hx0 _ _).symm
          _ < x := Real.rpow_lt_self_of_one_lt hx (by norm_num)
      have hprodR : (p : ℝ) * (d.2 : ℝ) = n := by exact_mod_cast hprod
      have hcut : x ^ ((9519 : ℝ) / 50000) ≤ (d.2 : ℝ) := by
        nlinarith
      change (if d.2 ≠ 0 ∧ ∀ r ∈ d.2.primeFactors,
        x ^ ((9519 : ℝ) / 50000) ≤ (r : ℝ) then (1 : ℝ) else 0) = 1
      rw [hq.primeFactors]
      simp [hq.ne_zero, hcut]
    by_cases hq : d.2.Prime
    · simp [hdp, hcard, hq, hrough hq]
    · simp [hdp, hcard, hq]
  · simp [hdp]

theorem theta2_semiprime_interval_eq_prime_counts
    (x u v : ℝ) (hx : 1 < x) (hu : 1 ≤ u) (huv : u ≤ v) (_hv : v ≤ 2) :
    (∑ n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)),
      if ArithmeticFunction.cardFactors n = 2 then
        siftedTheta x (1 : Fin 6) (fun _ => 1) n else 0) =
      ∑ p ∈ (Nat.primesBelow (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
          (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ)),
        (((Finset.Icc (Nat.ceil (u * x / (p : ℝ)))
          (Nat.floor (v * x / (p : ℝ)))).filter Nat.Prime).card : ℝ) := by
  classical
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hA : 0 < u * x := mul_pos (zero_lt_one.trans_le hu) hx0
  have hAB : u * x ≤ v * x := mul_le_mul_of_nonneg_right huv hx0.le
  have hs (n : ℕ) (hn : n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x))) :=
    theta2_semiprime_summand x hx n
      ((le_mul_of_one_le_left hx0.le hu).trans
        (Nat.le_of_ceil_le (Finset.mem_Icc.mp hn).1))
  rw [Finset.sum_congr rfl hs, Finset.sum_comm]
  apply Finset.sum_congr rfl
  intro p hp
  have hpPrime := Nat.prime_of_mem_primesBelow (Finset.mem_filter.mp hp).1
  rw [sum_real_Icc_divisorsAntidiagonal_fixed
    (u * x) (v * x) p hA hAB hpPrime.pos (fun q => if q.Prime then 1 else 0)]
  rw [← Finset.sum_filter]
  simp

theorem primeCounting_scaled_endpoint_error
    (C Y0 x p w : ℝ) (hC : 0 < C)
    (hpi : ∀ y : ℝ, Y0 ≤ y →
      |(Nat.primeCounting (Nat.floor y) : ℝ) - y / Real.log y| ≤
        C * y / (Real.log y) ^ 2)
    (hx : 1 < x) (hYx : Y0 ^ 2 ≤ x) (hp : 0 < p)
    (hpx : p ≤ Real.sqrt x) (hw1 : 1 ≤ w) (hw2 : w ≤ 2) :
    |Real.log x / x * (Nat.primeCounting (Nat.floor (w * x / p)) : ℝ) -
        w * (p * (1 - Real.logb x p))⁻¹| ≤
      8 * (C + 1) / (p * Real.log x) := by
  let L := Real.log x
  let D := L - Real.log p
  let t := w * x / p
  have hx0 : 0 < x := by linarith
  have hL : 0 < L := Real.log_pos hx
  have hw0 : 0 < w := by linarith
  have hDhalf : L / 2 ≤ D := by
    have h := Real.log_le_log hp hpx
    rw [Real.log_sqrt hx0.le] at h
    dsimp [D, L]
    linarith
  have hD : 0 < D := by linarith
  have hsqrt : Y0 ≤ Real.sqrt x := Real.le_sqrt_of_sq_le hYx
  have htY : Y0 ≤ t := by
    apply (le_div_iff₀ hp).2
    have hprod : Y0 * p ≤ x := by
      calc
        Y0 * p ≤ Real.sqrt x * Real.sqrt x :=
          mul_le_mul hsqrt hpx hp.le (Real.sqrt_nonneg x)
        _ = x := Real.mul_self_sqrt hx0.le
    exact hprod.trans (by nlinarith)
  have hwlog0 : 0 ≤ Real.log w := Real.log_nonneg hw1
  have hwlog1 : Real.log w ≤ 1 := by
    have h := Real.log_le_sub_one_of_pos hw0
    linarith
  have htlog : Real.log t = D + Real.log w := by
    dsimp [t, D, L]
    rw [Real.log_div (mul_pos hw0 hx0).ne' hp.ne', Real.log_mul hw0.ne' hx0.ne']
    ring
  have htloghalf : L / 2 ≤ Real.log t := by rw [htlog]; linarith
  have htlog0 : 0 < Real.log t := by linarith
  have hsq : L ^ 2 / 4 ≤ (Real.log t) ^ 2 := by
    nlinarith [mul_self_le_mul_self (by positivity : 0 ≤ L / 2) htloghalf]
  have hprod : L ^ 2 / 4 ≤ Real.log t * D := by
    have h := mul_le_mul htloghalf hDhalf (by positivity : 0 ≤ L / 2) htlog0.le
    nlinarith
  have hscale0 : 0 ≤ L / x := by positivity
  have hpi' := mul_le_mul_of_nonneg_left (hpi t htY) hscale0
  have hcount :
      |L / x * (Nat.primeCounting (Nat.floor t) : ℝ) -
          L / x * (t / Real.log t)| ≤ 8 * C / (p * L) := by
    calc
      _ = (L / x) *
          |(Nat.primeCounting (Nat.floor t) : ℝ) - t / Real.log t| := by
        rw [← mul_sub, abs_mul, abs_of_nonneg hscale0]
      _ ≤ (L / x) * (C * t / (Real.log t) ^ 2) := hpi'
      _ = C * w * L / (p * (Real.log t) ^ 2) := by
        dsimp [t]
        field_simp
      _ ≤ C * 2 * L / (p * (L ^ 2 / 4)) := by
        apply div_le_div₀ (by positivity)
        · gcongr
        · positivity
        · exact mul_le_mul_of_nonneg_left hsq hp.le
      _ = 8 * C / (p * L) := by field_simp; ring
  have hd : 1 - Real.logb x p = D / L := by
    change 1 - Real.log p / L = (L - Real.log p) / L
    field_simp
  have hmain : w * (p * (1 - Real.logb x p))⁻¹ = w * L / (p * D) := by
    rw [hd]
    field_simp
  have hshift :
      |L / x * (t / Real.log t) - w * (p * (1 - Real.logb x p))⁻¹| ≤
        8 / (p * L) := by
    have hdiff :
        w * L / (p * D) - L / x * (t / Real.log t) =
          w * L * Real.log w / (p * (Real.log t * D)) := by
      dsimp [t]
      rw [htlog]
      field_simp
      ring
    rw [hmain, abs_sub_comm, hdiff, abs_of_nonneg (by positivity)]
    calc
      _ ≤ 2 * L / (p * (L ^ 2 / 4)) := by
        apply div_le_div₀ (by positivity)
        · calc
            w * L * Real.log w ≤ 2 * L * 1 := by gcongr
            _ = 2 * L := by ring
        · positivity
        · exact mul_le_mul_of_nonneg_left hprod hp.le
      _ = 8 / (p * L) := by field_simp; ring
  calc
    _ ≤ |L / x * (Nat.primeCounting (Nat.floor t) : ℝ) -
        L / x * (t / Real.log t)| +
        |L / x * (t / Real.log t) - w * (p * (1 - Real.logb x p))⁻¹| :=
      abs_sub_le _ _ _
    _ ≤ 8 * C / (p * L) + 8 / (p * L) := add_le_add hcount hshift
    _ = 8 * (C + 1) / (p * L) := by ring

theorem theta2_sum_prime_count_error_le
    (x u v K : ℝ) (hx : 1 < x) (hK : 0 ≤ K)
    (hpoint : ∀ p ∈ (Nat.primesBelow
        (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
          (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ)),
      |Real.log x / x *
          (((Finset.Icc (Nat.ceil (u * x / (p : ℝ)))
            (Nat.floor (v * x / (p : ℝ)))).filter Nat.Prime).card : ℝ) -
        (v - u) * ((p : ℝ) * (1 - Real.logb x (p : ℝ)))⁻¹| ≤
        K / ((p : ℝ) * Real.log x) + Real.log x / x) :
    let P := (Nat.primesBelow
      (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
        (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ))
    |Real.log x / x *
        (∑ p ∈ P,
          (((Finset.Icc (Nat.ceil (u * x / (p : ℝ)))
            (Nat.floor (v * x / (p : ℝ)))).filter Nat.Prime).card : ℝ)) -
      (v - u) * (∑ p ∈ P, ((p : ℝ) * (1 - Real.logb x (p : ℝ)))⁻¹)| ≤
      K / Real.log x *
          (∑ p ∈ P, ((p : ℝ) * (1 - Real.logb x (p : ℝ)))⁻¹) +
        Real.log x / x * (x ^ ((40481 : ℝ) / 100000) + 1) := by
  classical
  dsimp only
  let P := (Nat.primesBelow
    (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
      (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ))
  let W (p : ℕ) : ℝ := ((p : ℝ) * (1 - Real.logb x (p : ℝ)))⁻¹
  let N (p : ℕ) : ℝ :=
    (((Finset.Icc (Nat.ceil (u * x / (p : ℝ)))
      (Nat.floor (v * x / (p : ℝ)))).filter Nat.Prime).card : ℝ)
  change |Real.log x / x * (∑ p ∈ P, N p) - (v - u) * (∑ p ∈ P, W p)| ≤
    K / Real.log x * (∑ p ∈ P, W p) +
      Real.log x / x * (x ^ ((40481 : ℝ) / 100000) + 1)
  have hlog : 0 < Real.log x := Real.log_pos hx
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hmass : (∑ p ∈ P, (p : ℝ)⁻¹) ≤ ∑ p ∈ P, W p := by
    apply Finset.sum_le_sum
    intro p hp
    have hp' := Nat.mem_primesBelow.mp (Finset.mem_filter.mp hp).1
    have hp0 : 0 < (p : ℝ) := by exact_mod_cast hp'.2.pos
    have ht : Real.logb x (p : ℝ) < (40481 : ℝ) / 100000 :=
      (Real.logb_lt_iff_lt_rpow hx hp0).mpr (Nat.lt_ceil.mp hp'.1)
    have ht0 : 0 ≤ Real.logb x (p : ℝ) :=
      Real.logb_nonneg hx (by exact_mod_cast hp'.2.one_le)
    apply inv_anti₀ (mul_pos hp0 (by linarith : 0 < 1 - Real.logb x (p : ℝ)))
    nlinarith
  have hcard : (P.card : ℝ) ≤ x ^ ((40481 : ℝ) / 100000) + 1 := by
    have hn : P.card ≤ Nat.ceil (x ^ ((40481 : ℝ) / 100000)) :=
      (Finset.card_filter_le _ _).trans
        ((Finset.card_filter_le _ _).trans_eq (Finset.card_range _))
    exact (by exact_mod_cast hn : (P.card : ℝ) ≤
      (Nat.ceil (x ^ ((40481 : ℝ) / 100000)) : ℝ)).trans
        (Nat.ceil_lt_add_one (Real.rpow_nonneg hx0.le _)).le
  calc
    _ = |∑ p ∈ P, (Real.log x / x * N p - (v - u) * W p)| := by
      rw [Finset.sum_sub_distrib, ← Finset.mul_sum, ← Finset.mul_sum]
    _ ≤ ∑ p ∈ P, |Real.log x / x * N p - (v - u) * W p| :=
      Finset.abs_sum_le_sum_abs _ _
    _ ≤ ∑ p ∈ P, (K / ((p : ℝ) * Real.log x) + Real.log x / x) :=
      Finset.sum_le_sum hpoint
    _ = K / Real.log x * (∑ p ∈ P, (p : ℝ)⁻¹) +
        Real.log x / x * (P.card : ℝ) := by
      simp [Finset.sum_add_distrib, Finset.mul_sum, div_eq_mul_inv,
        mul_inv_rev, mul_assoc, mul_left_comm, mul_comm]
    _ ≤ _ := add_le_add
      (mul_le_mul_of_nonneg_left hmass (div_nonneg hK hlog.le))
      (mul_le_mul_of_nonneg_left hcard (div_nonneg hlog.le hx0.le))

theorem theta2_endpoint_envelope_tendsto :
    Filter.Tendsto
      (fun x : ℝ => Real.log x / x * (x ^ ((40481 : ℝ) / 100000) + 1))
      Filter.atTop (nhds 0) := by
  have hsmall := (isLittleO_log_rpow_atTop
    (by norm_num : (0 : ℝ) < 1 - (40481 : ℝ) / 100000)).tendsto_div_nhds_zero
  have hlog := Real.isLittleO_log_id_atTop.tendsto_div_nhds_zero
  have hsum : Filter.Tendsto
      (fun x : ℝ => Real.log x / x ^ (1 - (40481 : ℝ) / 100000) + Real.log x / x)
      Filter.atTop (nhds 0) := by simpa using hsmall.add hlog
  apply hsum.congr'
  filter_upwards [Filter.eventually_gt_atTop (0 : ℝ)] with x hx
  rw [Real.rpow_sub hx, Real.rpow_one]
  field_simp

theorem roughWeight_cardFactors_two_eq_sorted_pairs (z : ℝ) (m : ℕ) :
    (if ArithmeticFunction.cardFactors m = 2 then roughWeight z m else 0) =
      (((m.divisorsAntidiagonal.filter fun d : ℕ × ℕ =>
        d.1.Prime ∧ d.2.Prime ∧ d.1 ≤ d.2 ∧ z ≤ (d.1 : ℝ)).card : ℕ) : ℝ) := by
  classical
  by_cases hc : ArithmeticFunction.cardFactors m = 2
  · have hm0 : m ≠ 0 := by
      intro hm
      simp [hm] at hc
    obtain ⟨q, r, hlist⟩ := List.length_eq_two.mp
      (show m.primeFactorsList.length = 2 from hc)
    have hq : q.Prime := Nat.prime_of_mem_primeFactorsList (n := m) (by simp [hlist])
    have hr : r.Prime := Nat.prime_of_mem_primeFactorsList (n := m) (by simp [hlist])
    have hqr : q ≤ r := by
      simpa [hlist] using Nat.isChain_primeFactorsList m
    have hm : q * r = m := by
      simpa [hlist] using Nat.prod_primeFactorsList hm0
    have hmem (d : ℕ × ℕ) :
        d ∈ m.divisorsAntidiagonal.filter (fun d : ℕ × ℕ =>
          d.1.Prime ∧ d.2.Prime ∧ d.1 ≤ d.2 ∧ z ≤ (d.1 : ℝ)) ↔
          d = (q, r) ∧ z ≤ (q : ℝ) := by
      constructor
      · intro hd
        obtain ⟨hdm, hd1, hd2, hle, hz⟩ := Finset.mem_filter.mp hd
        have hp : [d.1, d.2].Perm [q, r] := by
          rw [← hlist]
          exact Nat.primeFactorsList_unique
            (by simpa using (Nat.mem_divisorsAntidiagonal.mp hdm).1)
            (by simpa using And.intro hd1 hd2)
        have hd : d = (q, r) := Prod.ext_iff.mpr (by
          simpa using hp.eq_of_sortedLE
            (by simpa [List.sortedLE_iff_isChain] using hle)
            (by simpa [List.sortedLE_iff_isChain] using hqr))
        exact ⟨hd, by simpa [hd] using hz⟩
      · rintro ⟨rfl, hz⟩
        exact Finset.mem_filter.mpr
          ⟨Nat.mem_divisorsAntidiagonal.mpr ⟨hm, hm0⟩, hq, hr, hqr, hz⟩
    have hs : m.divisorsAntidiagonal.filter (fun d : ℕ × ℕ =>
        d.1.Prime ∧ d.2.Prime ∧ d.1 ≤ d.2 ∧ z ≤ (d.1 : ℝ)) =
        if z ≤ (q : ℝ) then {(q, r)} else ∅ := by
      ext d
      by_cases hz : z ≤ (q : ℝ) <;> simp [hmem, hz]
    rw [ite_eq_left hc, hs, ← hm]
    change (if q * r ≠ 0 ∧ ∀ p ∈ (q * r).primeFactors, z ≤ (p : ℝ)
      then (1 : ℝ) else 0) = _
    rw [Nat.primeFactors_mul hq.ne_zero hr.ne_zero, hq.primeFactors, hr.primeFactors]
    by_cases hz : z ≤ (q : ℝ)
    · have hzr : z ≤ (r : ℝ) := hz.trans (by exact_mod_cast hqr)
      simp [hq.ne_zero, hr.ne_zero, hz, hzr]
    · simp [hz]
  · rw [ite_eq_right hc]
    have hs : m.divisorsAntidiagonal.filter
        (fun d : ℕ × ℕ => d.1.Prime ∧ d.2.Prime ∧ d.1 ≤ d.2 ∧ z ≤ (d.1 : ℝ)) =
        ∅ := by
      apply Finset.filter_eq_empty_iff.mpr
      rintro d hdm ⟨hd1, hd2, _⟩
      apply hc
      simpa only [(Nat.mem_divisorsAntidiagonal.mp hdm).1] using
        (hd1.mul_isAlmostPrime_two hd2).2
    simp [hs]

theorem theta2_three_prime_summand (x : ℝ) (hx : 1 < x) (n : ℕ) :
    (if ArithmeticFunction.cardFactors n = 3 then
      siftedTheta x (1 : Fin 6) (fun _ => 1) n else 0) =
      ∑ p ∈ (Nat.primesBelow (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
          (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ)),
        ∑ d ∈ n.divisorsAntidiagonal,
          if d.1 = p then
            if ArithmeticFunction.cardFactors d.2 = 2 then
              roughWeight (x ^ ((9519 : ℝ) / 50000)) d.2 else 0
          else 0 := by
  classical
  rw [siftedTheta_one_eq_prime_sum x hx]
  simp_rw [Finset.ite_sum_zero]
  apply Finset.sum_congr rfl
  intro p hp
  have hpPrime := Nat.prime_of_mem_primesBelow (Finset.mem_filter.mp hp).1
  apply Finset.sum_congr rfl
  intro d hd
  by_cases hdp : d.1 = p
  · have hdq0 := Nat.right_ne_zero_of_mem_divisorsAntidiagonal hd
    have hprod : p * d.2 = n := by
      simpa only [hdp] using (Nat.mem_divisorsAntidiagonal.mp hd).1
    have hcard : ArithmeticFunction.cardFactors n = 3 ↔
        ArithmeticFunction.cardFactors d.2 = 2 := by
      rw [← hprod, ArithmeticFunction.cardFactors_mul hpPrime.ne_zero hdq0,
        ArithmeticFunction.cardFactors_apply_prime hpPrime]
      omega
    simp [hdp, hcard]
  · simp [hdp]

theorem theta2_three_prime_interval_eq_residual_mass
    (x u v : ℝ) (hx : 1 < x) (hu : 1 ≤ u) (huv : u ≤ v) :
    (∑ n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)),
      if ArithmeticFunction.cardFactors n = 3 then
        siftedTheta x (1 : Fin 6) (fun _ => 1) n else 0) =
      ∑ p ∈ (Nat.primesBelow (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
          (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ)),
        ∑ m ∈ Finset.Icc (Nat.ceil (u * x / (p : ℝ)))
            (Nat.floor (v * x / (p : ℝ))),
          if ArithmeticFunction.cardFactors m = 2 then
            roughWeight (x ^ ((9519 : ℝ) / 50000)) m else 0 := by
  classical
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hA : 0 < u * x := mul_pos (zero_lt_one.trans_le hu) hx0
  have hAB : u * x ≤ v * x := mul_le_mul_of_nonneg_right huv hx0.le
  simp_rw [theta2_three_prime_summand x hx]
  rw [Finset.sum_comm]
  apply Finset.sum_congr rfl
  intro p hp
  have hpPrime := Nat.prime_of_mem_primesBelow (Finset.mem_filter.mp hp).1
  exact sum_real_Icc_divisorsAntidiagonal_fixed
    (u * x) (v * x) p hA hAB hpPrime.pos
    (fun m => if ArithmeticFunction.cardFactors m = 2 then
      roughWeight (x ^ ((9519 : ℝ) / 50000)) m else 0)

theorem sum_sorted_prime_pairs_real_Icc
    (A B z : ℝ) (hA : 0 < A) (hAB : A ≤ B) :
    (∑ m ∈ Finset.Icc (Nat.ceil A) (Nat.floor B),
      (((m.divisorsAntidiagonal.filter fun d : ℕ × ℕ =>
        d.1.Prime ∧ d.2.Prime ∧ d.1 ≤ d.2 ∧ z ≤ (d.1 : ℝ)).card : ℕ) : ℝ)) =
      ∑ q ∈ (Nat.primesLE (Nat.floor (Real.sqrt B))).filter
          (fun q : ℕ => z ≤ (q : ℝ)),
        (((Finset.Icc (max q (Nat.ceil (A / (q : ℝ))))
            (Nat.floor (B / (q : ℝ)))).filter Nat.Prime).card : ℝ) := by
  classical
  let Q := (Nat.primesLE (Nat.floor (Real.sqrt B))).filter
    (fun q : ℕ => z ≤ (q : ℝ))
  have hB : 0 ≤ B := hA.le.trans hAB
  have hsplit (m : ℕ) (hm : m ≤ Nat.floor B) :
      (((m.divisorsAntidiagonal.filter fun d : ℕ × ℕ =>
        d.1.Prime ∧ d.2.Prime ∧ d.1 ≤ d.2 ∧ z ≤ (d.1 : ℝ)).card : ℕ) : ℝ) =
        ∑ q ∈ Q, ∑ d ∈ m.divisorsAntidiagonal,
          if d.1 = q then if q ≤ d.2 ∧ d.2.Prime then (1 : ℝ) else 0 else 0 := by
    have hmap : ((m.divisorsAntidiagonal.filter fun d : ℕ × ℕ =>
        d.1.Prime ∧ d.2.Prime ∧ d.1 ≤ d.2 ∧ z ≤ (d.1 : ℝ)) :
          Set (ℕ × ℕ)).MapsTo Prod.fst Q := by
      intro d hd
      obtain ⟨hd, hdgood⟩ := Finset.mem_filter.mp hd
      have hprod := (Nat.mem_divisorsAntidiagonal.mp hd).1
      have hmB : (m : ℝ) ≤ B := (Nat.le_floor_iff hB).mp hm
      refine Finset.mem_filter.mpr
        ⟨Nat.mem_primesLE.mpr ⟨?_, hdgood.1⟩, hdgood.2.2.2⟩
      apply (Nat.le_floor_iff (Real.sqrt_nonneg B)).mpr
      apply Real.le_sqrt_of_sq_le
      have hle : (d.1 : ℝ) ≤ d.2 := by exact_mod_cast hdgood.2.2.1
      have hprodR : (d.1 : ℝ) * d.2 = m := by exact_mod_cast hprod
      have hd0 : (0 : ℝ) ≤ d.1 := Nat.cast_nonneg _
      nlinarith
    rw [Finset.card_eq_sum_card_fiberwise hmap, Nat.cast_sum]
    apply Finset.sum_congr rfl
    intro q hq
    obtain ⟨hq, hzq⟩ := Finset.mem_filter.mp hq
    have hqp := Nat.prime_of_mem_primesLE hq
    simp only [Finset.filter_filter]
    rw [← Finset.sum_boole]
    apply Finset.sum_congr rfl
    intro d _
    by_cases hdq : d.1 = q
    · simp [hdq, hqp, hzq, and_comm]
    · simp [hdq]
  rw [Finset.sum_congr rfl (fun m hm => hsplit m (Finset.mem_Icc.mp hm).2),
    Finset.sum_comm]
  apply Finset.sum_congr rfl
  intro q hq
  have hqPrime := Nat.prime_of_mem_primesLE (Finset.mem_filter.mp hq).1
  rw [sum_real_Icc_divisorsAntidiagonal_fixed
    A B q hA hAB hqPrime.pos (fun r => if q ≤ r ∧ r.Prime then 1 else 0)]
  rw [← Finset.sum_filter]
  have hsets :
      (Finset.Icc (Nat.ceil (A / (q : ℝ))) (Nat.floor (B / (q : ℝ)))).filter
          (fun r => q ≤ r ∧ r.Prime) =
        (Finset.Icc (max q (Nat.ceil (A / (q : ℝ))))
            (Nat.floor (B / (q : ℝ)))).filter Nat.Prime := by
    ext r
    simp only [Finset.mem_filter, Finset.mem_Icc, max_le_iff]
    tauto
  rw [hsets]
  simp

theorem theta2_three_prime_interval_eq_sorted_prime_counts
    (x u v : ℝ) (hx : 1 < x) (hu : 1 ≤ u) (huv : u ≤ v) :
    (∑ n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)),
      if ArithmeticFunction.cardFactors n = 3 then
        siftedTheta x (1 : Fin 6) (fun _ => 1) n else 0) =
      ∑ p ∈ (Nat.primesBelow (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
          (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ)),
        ∑ q ∈ (Nat.primesLE
            (Nat.floor (Real.sqrt (v * x / (p : ℝ))))).filter
            (fun q : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (q : ℝ)),
          (((Finset.Icc
              (max q (Nat.ceil (u * x / ((p : ℝ) * (q : ℝ)))))
              (Nat.floor (v * x / ((p : ℝ) * (q : ℝ))))).filter
              Nat.Prime).card : ℝ) := by
  classical
  rw [theta2_three_prime_interval_eq_residual_mass x u v hx hu huv]
  apply Finset.sum_congr rfl
  intro p hp
  have hpPrime := Nat.prime_of_mem_primesBelow (Finset.mem_filter.mp hp).1
  have hp0 : (0 : ℝ) < p := Nat.cast_pos.mpr hpPrime.pos
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hA : 0 < u * x / (p : ℝ) :=
    div_pos (mul_pos (zero_lt_one.trans_le hu) hx0) hp0
  have hAB : u * x / (p : ℝ) ≤ v * x / (p : ℝ) :=
    div_le_div_of_nonneg_right (mul_le_mul_of_nonneg_right huv hx0.le) hp0.le
  simp_rw [roughWeight_cardFactors_two_eq_sorted_pairs]
  rw [sum_sorted_prime_pairs_real_Icc _ _ _ hA hAB]
  simp only [div_div]

theorem sorted_prime_count_bulk_strip (X z u v : ℝ) (hX : 0 < X)
    (hu : 1 ≤ u) (huv : u ≤ v) (hv : v ≤ 2) :
    let S : ℝ :=
      ∑ q ∈ (Nat.primesLE (Nat.floor (Real.sqrt (v * X)))).filter (fun q : ℕ => z ≤ (q : ℝ)),
        (((Finset.Icc (max q (Nat.ceil (u * X / q))) (Nat.floor (v * X / q))).filter
          Nat.Prime).card : ℝ)
    let B : ℝ :=
      ∑ q ∈ (Nat.primesLE (Nat.floor (Real.sqrt X))).filter (fun q : ℕ => z ≤ (q : ℝ)),
        (((Finset.Icc (Nat.ceil (u * X / q)) (Nat.floor (v * X / q))).filter
          Nat.Prime).card : ℝ)
    let T : ℝ :=
      ∑ q ∈ (Nat.primesLE (Nat.floor (Real.sqrt (2 * X)))).filter
          (fun q : ℕ => z ≤ (q : ℝ) ∧ Real.sqrt X < (q : ℝ)),
        (Nat.primeCounting (Nat.floor (2 * X / q)) : ℝ)
    0 ≤ S - B ∧ S - B ≤ T := by
  classical
  let S := (Nat.primesLE (Nat.floor (Real.sqrt (v * X)))).filter (fun q : ℕ => z ≤ (q : ℝ))
  let B := (Nat.primesLE (Nat.floor (Real.sqrt X))).filter (fun q : ℕ => z ≤ (q : ℝ))
  let T := (Nat.primesLE (Nat.floor (Real.sqrt (2 * X)))).filter
    (fun q : ℕ => z ≤ (q : ℝ) ∧ Real.sqrt X < (q : ℝ))
  let f := fun q : ℕ =>
    (((Finset.Icc (max q (Nat.ceil (u * X / q))) (Nat.floor (v * X / q))).filter
      Nat.Prime).card : ℝ)
  let g := fun q : ℕ =>
    (((Finset.Icc (Nat.ceil (u * X / q)) (Nat.floor (v * X / q))).filter
      Nat.Prime).card : ℝ)
  let k := fun q : ℕ => (Nat.primeCounting (Nat.floor (2 * X / q)) : ℝ)
  change 0 ≤ (∑ q ∈ S, f q) - ∑ q ∈ B, g q ∧
    (∑ q ∈ S, f q) - ∑ q ∈ B, g q ≤ ∑ q ∈ T, k q
  have hXu : X ≤ u * X := by nlinarith
  have hXv : X ≤ v * X := by nlinarith
  have hsub : B ⊆ S :=
    Finset.filter_subset_filter _
      (Nat.primesLE_mono (Nat.floor_mono (Real.sqrt_le_sqrt hXv)))
  have hagree : ∀ q ∈ B, g q = f q := by
    intro q hq
    have hqp := Nat.prime_of_mem_primesLE (Finset.mem_filter.mp hq).1
    have hqpos : 0 < (q : ℝ) := Nat.cast_pos.mpr hqp.pos
    have hqle : (q : ℝ) ≤ Real.sqrt X :=
      (Nat.le_floor_iff (Real.sqrt_nonneg X)).mp
        (Nat.le_of_mem_primesLE (Finset.mem_filter.mp hq).1)
    have hsq := (Real.le_sqrt' hqpos).mp hqle
    have hqdiv : (q : ℝ) ≤ u * X / q := by
      apply (le_div_iff₀ hqpos).mpr
      nlinarith
    have hceil : q ≤ Nat.ceil (u * X / q) := by
      exact_mod_cast hqdiv.trans (Nat.le_ceil (u * X / q))
    simp only [f, g, max_eq_right hceil]
  have hsum :
      (∑ q ∈ S, f q) - ∑ q ∈ B, g q = ∑ q ∈ S \ B, f q := by
    rw [Finset.sum_congr rfl hagree]
    exact (Finset.sum_sdiff_eq_sub hsub).symm
  rw [hsum]
  constructor
  · exact Finset.sum_nonneg fun q _ => Nat.cast_nonneg _
  · have hstrip : S \ B ⊆ T := by
      intro q hq
      rcases Finset.mem_sdiff.mp hq with ⟨hqs, hqb⟩
      rcases Finset.mem_filter.mp hqs with ⟨hqp, hz⟩
      apply Finset.mem_filter.mpr
      refine ⟨Nat.primesLE_mono
        (Nat.floor_mono (Real.sqrt_le_sqrt
          (mul_le_mul_of_nonneg_right hv hX.le))) hqp, hz, ?_⟩
      by_contra hq
      apply hqb
      exact Finset.mem_filter.mpr ⟨Nat.mem_primesLE.mpr
        ⟨Nat.le_floor (le_of_not_gt hq), Nat.prime_of_mem_primesLE hqp⟩, hz⟩
    calc
      ∑ q ∈ S \ B, f q ≤ ∑ q ∈ S \ B, k q := by
        apply Finset.sum_le_sum
        intro q _
        apply Nat.cast_le.mpr
        rw [← Nat.primesLE_card_eq_primeCounting]
        apply Finset.card_le_card
        intro r hr
        rcases Finset.mem_filter.mp hr with ⟨hr, hrp⟩
        exact Nat.mem_primesLE.mpr ⟨(Finset.mem_Icc.mp hr).2.trans
          (Nat.floor_mono (div_le_div_of_nonneg_right
            (mul_le_mul_of_nonneg_right hv hX.le) (Nat.cast_nonneg q))), hrp⟩
      _ ≤ ∑ q ∈ T, k q :=
        Finset.sum_le_sum_of_subset_of_nonneg hstrip fun q _ _ => Nat.cast_nonneg _

theorem theta2_three_prime_interval_bulk_strip
    (x u v : ℝ) (hx : 1 < x) (hu : 1 ≤ u) (huv : u ≤ v) (hv : v ≤ 2) :
    let P : Finset ℕ :=
      (Nat.primesBelow (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
        (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ))
    let B : ℝ :=
      ∑ p ∈ P, ∑ q ∈ (Nat.primesLE (Nat.floor (Real.sqrt (x / (p : ℝ))))).filter
          (fun q : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (q : ℝ)),
        (((Finset.Icc (Nat.ceil (u * x / ((p : ℝ) * (q : ℝ))))
            (Nat.floor (v * x / ((p : ℝ) * (q : ℝ))))).filter Nat.Prime).card : ℝ)
    let E : ℝ :=
      ∑ p ∈ P, ∑ q ∈ (Nat.primesLE (Nat.floor (Real.sqrt (2 * (x / (p : ℝ)))))).filter
          (fun q : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (q : ℝ) ∧
            Real.sqrt (x / (p : ℝ)) < (q : ℝ)),
        (Nat.primeCounting (Nat.floor (2 * (x / (p : ℝ)) / (q : ℝ))) : ℝ)
    let S : ℝ :=
      ∑ n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)),
        if ArithmeticFunction.cardFactors n = 3 then
          siftedTheta x (1 : Fin 6) (fun _ => 1) n else 0
    0 ≤ S - B ∧ S - B ≤ E := by
  classical
  dsimp only
  simp only [theta2_three_prime_interval_eq_sorted_prime_counts x u v hx hu huv,
    ← Finset.sum_sub_distrib]
  have hx0 : 0 < x := zero_lt_one.trans hx
  have h (p : ℕ) (hp : p.Prime) :=
    sorted_prime_count_bulk_strip (x / (p : ℝ))
      (x ^ ((9519 : ℝ) / 50000)) u v (div_pos hx0 (Nat.cast_pos.mpr hp.pos)) hu huv hv
  constructor
  · apply Finset.sum_nonneg
    intro p hp
    simpa only [mul_div_assoc', div_div] using
      (h p (Nat.prime_of_mem_primesBelow (Finset.mem_filter.mp hp).1)).1
  · apply Finset.sum_le_sum
    intro p hp
    simpa only [mul_div_assoc', div_div] using
      (h p (Nat.prime_of_mem_primesBelow (Finset.mem_filter.mp hp).1)).2

theorem theta2_named_prime_geometry (x : ℝ) (hx : 1 < x)
    (p : ℕ) (hp : p ∈ (Nat.primesBelow
      (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
        (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ))) :
    0 < (p : ℝ) ∧ x ^ ((59519 : ℝ) / 100000) ≤ x / (p : ℝ) ∧
      (59519 : ℝ) / 100000 * Real.log x ≤ Real.log (x / (p : ℝ)) ∧
      Real.sqrt (x / (p : ℝ)) ≤ x ^ ((40481 : ℝ) / 100000) := by
  obtain ⟨hpP, hplo⟩ := Finset.mem_filter.mp hp
  have hpprime := Nat.prime_of_mem_primesBelow hpP
  have hp0 : 0 < (p : ℝ) := by exact_mod_cast hpprime.pos
  have hx0 : 0 < x := by linarith
  have hphi : (p : ℝ) < x ^ ((40481 : ℝ) / 100000) :=
    Nat.lt_ceil.mp (Nat.lt_of_mem_primesBelow hpP)
  have hXlo : x ^ ((59519 : ℝ) / 100000) ≤ x / (p : ℝ) := by
    apply (le_div_iff₀ hp0).2
    calc
      x ^ ((59519 : ℝ) / 100000) * (p : ℝ) ≤
          x ^ ((59519 : ℝ) / 100000) * x ^ ((40481 : ℝ) / 100000) := by gcongr
      _ = x := by rw [← Real.rpow_add hx0]; norm_num
  refine ⟨hp0, hXlo, ?_, ?_⟩
  · have h := Real.log_le_log (Real.rpow_pos_of_pos hx0 _) hXlo
    rwa [Real.log_rpow hx0] at h
  · apply Real.sqrt_le_iff.2 ⟨Real.rpow_nonneg hx0.le _, ?_⟩
    apply (div_le_iff₀ hp0).2
    calc
      x = (x ^ ((40481 : ℝ) / 100000)) ^ 2 * x ^ ((9519 : ℝ) / 50000) := by
        rw [← Real.rpow_mul_natCast hx0.le, ← Real.rpow_add hx0]
        norm_num
      _ ≤ _ := by gcongr

theorem theta3_sum_prime_count_error_le (x u v K H : ℝ)
    (hx : 1 < x) (hK : 0 ≤ K) (hH : 0 ≤ H) :
    let P := (Nat.primesBelow (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
      (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ))
    let Q (p : ℕ) := (Nat.primesLE (Nat.floor (Real.sqrt (x / (p : ℝ))))).filter
      (fun q : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (q : ℝ))
    let R := (Nat.primesLE (Nat.floor (x ^ ((40481 : ℝ) / 100000)))).filter
      (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ))
    (∑ p ∈ R, (p : ℝ)⁻¹) ≤ H →
    (∀ p ∈ P, ∀ q ∈ Q p,
      |Real.log x / x *
          (((Finset.Icc (Nat.ceil (u * x / ((p : ℝ) * q)))
            (Nat.floor (v * x / ((p : ℝ) * q))))).filter Nat.Prime).card -
          (v - u) * ((p : ℝ) * q *
            (1 - Real.logb x (p : ℝ) - Real.logb x (q : ℝ)))⁻¹| ≤
        K / ((p : ℝ) * q * Real.log x) + Real.log x / x) →
    |Real.log x / x *
        (∑ p ∈ P, ∑ q ∈ Q p,
          ((((Finset.Icc (Nat.ceil (u * x / ((p : ℝ) * q)))
            (Nat.floor (v * x / ((p : ℝ) * q))))).filter Nat.Prime).card : ℝ)) -
        (v - u) * (∑ p ∈ P, ∑ q ∈ Q p,
          ((p : ℝ) * q *
            (1 - Real.logb x (p : ℝ) - Real.logb x (q : ℝ)))⁻¹)| ≤
      K / Real.log x * H ^ 2 +
        Real.log x / x * (x ^ ((40481 : ℝ) / 100000) + 1) ^ 2 := by
  classical
  dsimp only
  let P := (Nat.primesBelow (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
    (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ))
  let Q (p : ℕ) := (Nat.primesLE (Nat.floor (Real.sqrt (x / (p : ℝ))))).filter
    (fun q : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (q : ℝ))
  let R := (Nat.primesLE (Nat.floor (x ^ ((40481 : ℝ) / 100000)))).filter
    (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ))
  let T := x ^ ((40481 : ℝ) / 100000) + 1
  let N (p q : ℕ) : ℝ := ((Finset.Icc (Nat.ceil (u * x / ((p : ℝ) * q)))
    (Nat.floor (v * x / ((p : ℝ) * q)))).filter Nat.Prime).card
  let W (p q : ℕ) : ℝ := ((p : ℝ) * q *
    (1 - Real.logb x (p : ℝ) - Real.logb x (q : ℝ)))⁻¹
  intro hmass hpoint
  have hx0 : 0 < x := by linarith
  have hlog : 0 < Real.log x := Real.log_pos hx
  have hT : 0 ≤ T := by dsimp [T]; positivity
  have hPR : P ⊆ R :=
    Finset.filter_subset_filter _ (Nat.primesBelow_mono (Nat.ceil_le_floor_add_one _))
  have hQR (p : ℕ) (hp : p ∈ P) : Q p ⊆ R :=
    Finset.filter_subset_filter _ (Nat.primesLE_mono
      (Nat.floor_mono (theta2_named_prime_geometry x hx p hp).2.2.2))
  have hrecip (S : Finset ℕ) (hS : S ⊆ R) : (∑ p ∈ S, (p : ℝ)⁻¹) ≤ H :=
    (Finset.sum_le_sum_of_subset_of_nonneg hS
      (fun p _ _ => inv_nonneg.mpr (Nat.cast_nonneg p))).trans hmass
  have hRcard : (R.card : ℝ) ≤ T := by
    have hn : R.card ≤ Nat.floor (x ^ ((40481 : ℝ) / 100000)) + 1 :=
      (Finset.card_filter_le _ _).trans
        ((Finset.card_filter_le _ _).trans_eq (Finset.card_range _))
    calc
      (R.card : ℝ) ≤ (Nat.floor (x ^ ((40481 : ℝ) / 100000)) + 1 : ℕ) := by
        exact_mod_cast hn
      _ ≤ T := by
        push_cast
        exact add_le_add (Nat.floor_le (Real.rpow_nonneg hx0.le _)) le_rfl
  have hPcard : (P.card : ℝ) ≤ T :=
    (Nat.cast_le.mpr (Finset.card_le_card hPR)).trans hRcard
  have hQcard (p : ℕ) (hp : p ∈ P) : ((Q p).card : ℝ) ≤ T :=
    (Nat.cast_le.mpr (Finset.card_le_card (hQR p hp))).trans hRcard
  have hdouble : (∑ p ∈ P, ∑ q ∈ Q p, (p : ℝ)⁻¹ * (q : ℝ)⁻¹) ≤ H ^ 2 := by
    calc
      _ = ∑ p ∈ P, (p : ℝ)⁻¹ * (∑ q ∈ Q p, (q : ℝ)⁻¹) := by
        simp_rw [Finset.mul_sum]
      _ ≤ ∑ p ∈ P, (p : ℝ)⁻¹ * H :=
        Finset.sum_le_sum fun p hp => mul_le_mul_of_nonneg_left
          (hrecip _ (hQR p hp)) (inv_nonneg.mpr (Nat.cast_nonneg p))
      _ = (∑ p ∈ P, (p : ℝ)⁻¹) * H := by rw [Finset.sum_mul]
      _ ≤ H * H := mul_le_mul_of_nonneg_right (hrecip _ hPR) hH
      _ = H ^ 2 := by ring
  have hcards : (∑ p ∈ P, ((Q p).card : ℝ)) ≤ T ^ 2 := by
    calc
      _ ≤ ∑ _p ∈ P, T := Finset.sum_le_sum hQcard
      _ = (P.card : ℝ) * T := by simp
      _ ≤ T * T := mul_le_mul_of_nonneg_right hPcard hT
      _ = T ^ 2 := by ring
  change |Real.log x / x * (∑ p ∈ P, ∑ q ∈ Q p, N p q) -
    (v - u) * (∑ p ∈ P, ∑ q ∈ Q p, W p q)| ≤ _
  calc
    _ = |∑ p ∈ P, ∑ q ∈ Q p, (Real.log x / x * N p q - (v - u) * W p q)| := by
      simp_rw [Finset.sum_sub_distrib, ← Finset.mul_sum]
    _ ≤ ∑ p ∈ P, |∑ q ∈ Q p, (Real.log x / x * N p q - (v - u) * W p q)| :=
      Finset.abs_sum_le_sum_abs _ _
    _ ≤ ∑ p ∈ P, ∑ q ∈ Q p, |Real.log x / x * N p q - (v - u) * W p q| :=
      Finset.sum_le_sum fun _ _ => Finset.abs_sum_le_sum_abs _ _
    _ ≤ ∑ p ∈ P, ∑ q ∈ Q p, (K / ((p : ℝ) * q * Real.log x) + Real.log x / x) :=
      Finset.sum_le_sum fun p hp => Finset.sum_le_sum (hpoint p hp)
    _ = K / Real.log x *
        (∑ p ∈ P, ∑ q ∈ Q p, (p : ℝ)⁻¹ * (q : ℝ)⁻¹) +
        Real.log x / x * (∑ p ∈ P, ((Q p).card : ℝ)) := by
      simp [Finset.sum_add_distrib, Finset.mul_sum, div_eq_mul_inv,
        mul_inv_rev, mul_assoc, mul_left_comm, mul_comm]
    _ ≤ _ := add_le_add
      (mul_le_mul_of_nonneg_left hdouble (div_nonneg hK hlog.le))
      (mul_le_mul_of_nonneg_left hcards (div_nonneg hlog.le hx0.le))

theorem theta3_sum_sqrt_strip_le (x C H : ℝ) (hx : 1 < x) (hC : 0 ≤ C) :
    let P := (Nat.primesBelow (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
      (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ))
    let E (p : ℕ) : ℝ :=
      ∑ q ∈ (Nat.primesLE (Nat.floor (Real.sqrt (2 * (x / (p : ℝ)))))).filter
        (fun q : ℕ => Real.sqrt (x / (p : ℝ)) < (q : ℝ)),
        (Nat.primeCounting (Nat.floor (2 * (x / (p : ℝ)) / (q : ℝ))) : ℝ)
    (∑ p ∈ P, (p : ℝ)⁻¹) ≤ H →
    (∀ p ∈ P, Real.log (x / (p : ℝ)) / (x / (p : ℝ)) * E p ≤
      C / Real.log (x / (p : ℝ))) →
    Real.log x / x * (∑ p ∈ P, E p) ≤
      C / (((59519 : ℝ) / 100000) ^ 2 * Real.log x) * H := by
  classical
  dsimp only
  let P := (Nat.primesBelow (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
    (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ))
  let E (p : ℕ) : ℝ :=
    ∑ q ∈ (Nat.primesLE (Nat.floor (Real.sqrt (2 * (x / (p : ℝ)))))).filter
      (fun q : ℕ => Real.sqrt (x / (p : ℝ)) < (q : ℝ)),
      (Nat.primeCounting (Nat.floor (2 * (x / (p : ℝ)) / (q : ℝ))) : ℝ)
  intro hmass hpoint
  have hx0 : 0 < x := by linarith
  have hL : 0 < Real.log x := Real.log_pos hx
  have hpair (p : ℕ) (hp : p ∈ P) :
      Real.log x / x * E p ≤
        C / (((59519 : ℝ) / 100000) ^ 2 * Real.log x) * (p : ℝ)⁻¹ := by
    let X := x / (p : ℝ)
    let L := Real.log x
    let D := Real.log X
    let b : ℝ := 59519 / 100000
    have hb : 0 < b := by norm_num [b]
    have hg := theta2_named_prime_geometry x hx p hp
    have hp0 : 0 < (p : ℝ) := hg.1
    have hX0 : 0 < X := by dsimp [X]; positivity
    have hlog : b * L ≤ D := hg.2.2.1
    have hD : 0 < D := lt_of_lt_of_le (mul_pos hb hL) hlog
    have hs : 0 ≤ L / ((p : ℝ) * D) := by positivity
    have hnorm : L / x * E p = L / ((p : ℝ) * D) * (D / X * E p) := by
      dsimp [X]
      field_simp
    have hsq : (b * L) ^ 2 ≤ D ^ 2 := pow_le_pow_left₀ (by positivity) hlog 2
    calc
      Real.log x / x * E p = L / ((p : ℝ) * D) * (D / X * E p) := hnorm
      _ ≤ L / ((p : ℝ) * D) * (C / D) :=
        mul_le_mul_of_nonneg_left (hpoint p hp) hs
      _ = C * L / ((p : ℝ) * D ^ 2) := by ring
      _ ≤ C * L / ((p : ℝ) * (b * L) ^ 2) := by
        apply div_le_div_of_nonneg_left (by positivity) (by positivity)
        exact mul_le_mul_of_nonneg_left hsq hp0.le
      _ = C / (((59519 : ℝ) / 100000) ^ 2 * Real.log x) * (p : ℝ)⁻¹ := by
        change C * L / ((p : ℝ) * (b * L) ^ 2) = C / (b ^ 2 * L) * (p : ℝ)⁻¹
        field_simp
  calc
    _ = ∑ p ∈ P, Real.log x / x * E p := by rw [Finset.mul_sum]
    _ ≤ ∑ p ∈ P, C / (((59519 : ℝ) / 100000) ^ 2 * Real.log x) * (p : ℝ)⁻¹ :=
      Finset.sum_le_sum hpair
    _ = C / (((59519 : ℝ) / 100000) ^ 2 * Real.log x) *
        (∑ p ∈ P, (p : ℝ)⁻¹) := by rw [Finset.mul_sum]
    _ ≤ _ := mul_le_mul_of_nonneg_left hmass (by positivity)

theorem theta3_endpoint_envelope_tendsto :
    Filter.Tendsto
      (fun x : ℝ => Real.log x / x * (x ^ ((40481 : ℝ) / 100000) + 1) ^ 2)
      Filter.atTop (nhds 0) := by
  have hfirst := (isLittleO_log_rpow_atTop
    (by norm_num : (0 : ℝ) < 1 - 2 * ((40481 : ℝ) / 100000))).tendsto_div_nhds_zero
  have hsecond := (isLittleO_log_rpow_atTop
    (by norm_num : (0 : ℝ) < 1 - ((40481 : ℝ) / 100000))).tendsto_div_nhds_zero
  have hthird := Real.isLittleO_log_id_atTop.tendsto_div_nhds_zero
  have hsum : Filter.Tendsto
      (fun x : ℝ => Real.log x / x ^ (1 - 2 * ((40481 : ℝ) / 100000)) +
        2 * (Real.log x / x ^ (1 - ((40481 : ℝ) / 100000))) + Real.log x / x)
      Filter.atTop (nhds 0) := by
    simpa using (hfirst.add (hsecond.const_mul 2)).add hthird
  apply hsum.congr'
  filter_upwards [Filter.eventually_gt_atTop (0 : ℝ)] with x hx
  rw [Real.rpow_sub hx, Real.rpow_sub hx, Real.rpow_one, two_mul, Real.rpow_add hx]
  field_simp
  ring

/-- The configurations defining the paper's `b₁` and `b₂`, before interval restriction.
The paper makes these sequences zero outside `[x, 2x)`; this arithmetic function
does not include that clipping. The final sieve uses the half-open interval. -/
noncomputable def exceptionalPrimeDefect (x : ℝ) (j : Fin 2) :
    ArithmeticFunction ℝ := by
  classical
  let a : ℝ := 40481 / 100000
  let b : ℝ := 59519 / 100000
  let xi : ℝ := 9519 / 50000
  let uStar : ℝ := 1 - 4 * xi
  let alpha (p : ℕ) : ℝ := Real.logb x (p : ℝ)
  exact ⟨fun n =>
    if j.val = 0 then
      ∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => Nat.primesLE n),
        ∑ r ∈ Finset.Icc 1 n,
          if (∏ i, p i) * r = n ∧ xi ≤ alpha (p 3) ∧
              alpha (p 3) < alpha (p 2) ∧
              alpha (p 2) < alpha (p 1) ∧
              alpha (p 1) < alpha (p 0) ∧ alpha (p 0) < a ∧
              alpha (p 0) + alpha (p 1) < a ∧
              b < alpha (p 1) + alpha (p 2) + alpha (p 3)
          then roughWeight (p 3 : ℝ) r else 0
    else
      ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
        if (∏ i, p i) = n ∧
            (∀ i, xi ≤ alpha (p i) ∧ alpha (p i) ≤ uStar) ∧
            alpha (p 1) < alpha (p 0) ∧
            alpha (p 1) < alpha (p 2) ∧
            alpha (p 0) + alpha (p 2) < a ∧
            b < alpha (p 0) + alpha (p 1) + alpha (p 3) ∧
            alpha (p 3) ≤ alpha (p 4)
        then 1 else 0, by simp⟩

/--
The reciprocal-product integral for one exceptional five-exponent region, using four independent
coordinates and fifth coordinate `1 - ∑ i, t i`. The integrand is zero outside the closed
inequalities defining that region.
-/
noncomputable def exceptionalMassCoefficient (j : Fin 2) : ℝ := by
  classical
  let a : ℝ := 40481 / 100000
  let b : ℝ := 59519 / 100000
  let xi : ℝ := 9519 / 50000
  exact ∫ t : Fin 4 → ℝ,
    let alpha := Fin.snoc t (1 - ∑ i, t i)
    if (∀ i, xi ≤ alpha i) ∧
        (if j.val = 0 then
          alpha 3 ≤ alpha 2 ∧ alpha 2 ≤ alpha 1 ∧ alpha 1 ≤ alpha 0 ∧
          alpha 3 ≤ alpha 4 ∧ alpha 0 + alpha 1 ≤ a ∧
          b ≤ alpha 1 + alpha 2 + alpha 3
        else
          alpha 1 ≤ alpha 0 ∧ alpha 1 ≤ alpha 2 ∧ alpha 3 ≤ alpha 4 ∧
          alpha 0 + alpha 2 ≤ a ∧ b ≤ alpha 0 + alpha 1 + alpha 3)
    then (∏ i, alpha i)⁻¹ else 0

theorem roughWeight_nonneg (z : ℝ) (n : ℕ) : 0 ≤ roughWeight z n := by
  classical
  simp only [roughWeight, ArithmeticFunction.coe_mk]
  positivity

theorem exceptionalPrimeDefect_nonneg (x : ℝ) (j : Fin 2) (n : ℕ) :
    0 ≤ exceptionalPrimeDefect x j n := by
  classical
  simp only [exceptionalPrimeDefect, ArithmeticFunction.coe_mk]
  split_ifs with hj
  · exact Finset.sum_nonneg fun p hp => Finset.sum_nonneg fun r hr =>
      ite_nonneg (roughWeight_nonneg _ _) le_rfl
  · exact Finset.sum_nonneg fun p hp => by positivity

theorem eventually_exceptional_large :
    ∀ᶠ x : ℝ in Filter.atTop,
      1 < x ∧ 2 * x < x ^ (6 * ((9519 : ℝ) / 50000)) := by
  have h := tendsto_rpow_atTop
    (by norm_num : (0 : ℝ) < 6 * ((9519 : ℝ) / 50000) - 1)
  filter_upwards [Filter.eventually_gt_atTop (1 : ℝ), h.eventually_gt_atTop 2] with x hx hh
  have hx0 : 0 < x := by linarith
  have heq : x ^ (6 * ((9519 : ℝ) / 50000)) =
      x * x ^ (6 * ((9519 : ℝ) / 50000) - 1) := by
    conv_lhs => rw [show (6 * ((9519 : ℝ) / 50000)) = 1 + (6 * ((9519 : ℝ) / 50000) - 1) by ring]
    rw [Real.rpow_add hx0, Real.rpow_one]
  exact ⟨hx, by rw [heq]; nlinarith⟩

theorem exceptional_residual_prime {x : ℝ} (hx : 1 < x)
    (hg : 2 * x < x ^ (6 * ((9519 : ℝ) / 50000)))
    {n : ℕ} (hlo : x ≤ (n : ℝ)) (hhi : (n : ℝ) ≤ 2 * x)
    (p : Fin 4 → ℕ) (hp : ∀ i, (p i).Prime) (r : ℕ)
    (heq : (∏ i, p i) * r = n)
    (h0 : ((9519 : ℝ) / 50000) ≤ Real.logb x (p 3 : ℝ))
    (h32 : Real.logb x (p 3 : ℝ) < Real.logb x (p 2 : ℝ))
    (h21 : Real.logb x (p 2 : ℝ) < Real.logb x (p 1 : ℝ))
    (h10 : Real.logb x (p 1 : ℝ) < Real.logb x (p 0 : ℝ))
    (hs : Real.logb x (p 0 : ℝ) + Real.logb x (p 1 : ℝ) < (40481 : ℝ) / 100000)
    (hr : r ≠ 0 ∧ ∀ q ∈ r.primeFactors, (p 3 : ℝ) ≤ (q : ℝ)) :
    r.Prime ∧ (p 3 : ℝ) ≤ (r : ℝ) := by
  classical
  have hx0 : 0 < x := by linarith
  have hpos (i : Fin 4) : 0 < (p i : ℝ) := Nat.cast_pos.mpr (hp i).pos
  have hlow : ∀ i : Fin 4, x ^ ((9519 : ℝ) / 50000) ≤ (p i : ℝ) := by
    intro i
    apply (Real.le_logb_iff_rpow_le hx (hpos i)).mp
    fin_cases i
    · change (9519 : ℝ) / 50000 ≤ Real.logb x (p 0 : ℝ)
      linarith
    · change (9519 : ℝ) / 50000 ≤ Real.logb x (p 1 : ℝ)
      linarith
    · change (9519 : ℝ) / 50000 ≤ Real.logb x (p 2 : ℝ)
      linarith
    · change (9519 : ℝ) / 50000 ≤ Real.logb x (p 3 : ℝ)
      exact h0
  have hn0 : 0 < (n : ℝ) := hx0.trans_le hlo
  have hrone : r ≠ 1 := by
    intro hr1
    have heqp : (∏ i, p i) = n := by simpa [hr1] using heq
    have hl : Real.logb x (n : ℝ) < 2 * ((40481 : ℝ) / 100000) := by
      rw [← heqp, Nat.cast_prod,
        Real.logb_prod Finset.univ (fun i : Fin 4 => (p i : ℝ))
          (fun i _ => (hpos i).ne')]
      simp only [Fin.sum_univ_four]
      linarith
    have hlt : (n : ℝ) < x ^ (2 * ((40481 : ℝ) / 100000)) :=
      (Real.logb_lt_iff_lt_rpow hx hn0).mp hl
    have hlx : x ^ (2 * ((40481 : ℝ) / 100000)) < x := by
      simpa using Real.rpow_lt_rpow_of_exponent_lt hx
        (by norm_num : (2 * ((40481 : ℝ) / 100000)) < 1)
    exact (not_lt_of_ge hlo) (hlt.trans hlx)
  have hrpos : 0 < r := Nat.pos_of_ne_zero hr.1
  have hrp : r.Prime := by
    by_contra hnp
    have hm := Nat.minFac_sq_le_self hrpos hnp
    have hmprime := Nat.minFac_prime hrone
    have hmem : r.minFac ∈ r.primeFactors :=
      (Nat.mem_primeFactors_of_ne_zero hr.1).mpr ⟨hmprime, Nat.minFac_dvd r⟩
    have hmlo := hr.2 (Nat.minFac r) hmem
    have hrlo : (x ^ ((9519 : ℝ) / 50000)) ^ 2 ≤ (r : ℝ) := by
      have hmin : x ^ ((9519 : ℝ) / 50000) ≤ (r.minFac : ℝ) := (hlow 3).trans hmlo
      have hsquare : (r.minFac : ℝ) ^ 2 ≤ (r : ℝ) := by exact_mod_cast hm
      exact (pow_le_pow_left₀ (by positivity) hmin 2).trans hsquare
    have hfour : (x ^ ((9519 : ℝ) / 50000)) ^ 4 ≤ (∏ i, (p i : ℝ)) := by
      simpa using (Finset.prod_le_prod (s := Finset.univ)
        (f := fun _ : Fin 4 => x ^ ((9519 : ℝ) / 50000))
        (g := fun i : Fin 4 => (p i : ℝ)) (by intro i hi; positivity)
        (fun i hi => hlow i))
    have hh : x ^ (6 * ((9519 : ℝ) / 50000)) ≤ (n : ℝ) := by
      have hm' := mul_le_mul hfour hrlo (by positivity) (by positivity)
      rw [← Nat.cast_prod, ← Nat.cast_mul, heq] at hm'
      have hxp : (x ^ ((9519 : ℝ) / 50000)) ^ (6 : ℕ) =
          x ^ (6 * ((9519 : ℝ) / 50000)) := by
        rw [← Real.rpow_mul_natCast hx0.le _ 6]
        norm_num [mul_comm]
      simpa only [← hxp, ← pow_add, show 4 + 2 = 6 from rfl] using hm'
    linarith
  have hrle : (p 3 : ℝ) ≤ (r : ℝ) := by
    simpa only using hr.2 r (hrp.mem_primeFactors_self)
  exact ⟨hrp, hrle⟩

theorem exceptionalPrimeDefect_zero_eq_five {x : ℝ} (hx : 1 < x)
    (hg : 2 * x < x ^ (6 * ((9519 : ℝ) / 50000)))
    {n : ℕ} (hlo : x ≤ (n : ℝ)) (hhi : (n : ℝ) ≤ 2 * x) :
    exceptionalPrimeDefect x 0 n =
      ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
        if (∏ i, p i) = n ∧
            (9519 : ℝ) / 50000 ≤ Real.logb x (p 3 : ℝ) ∧
            Real.logb x (p 3 : ℝ) < Real.logb x (p 2 : ℝ) ∧
            Real.logb x (p 2 : ℝ) < Real.logb x (p 1 : ℝ) ∧
            Real.logb x (p 1 : ℝ) < Real.logb x (p 0 : ℝ) ∧
            Real.logb x (p 0 : ℝ) < (40481 : ℝ) / 100000 ∧
            Real.logb x (p 0 : ℝ) + Real.logb x (p 1 : ℝ) < (40481 : ℝ) / 100000 ∧
            (59519 : ℝ) / 100000 < Real.logb x (p 1 : ℝ) +
              Real.logb x (p 2 : ℝ) + Real.logb x (p 3 : ℝ) ∧
            (p 3 : ℝ) ≤ (p 4 : ℝ)
        then (1 : ℝ) else 0 := by
  classical
  have hs : Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n) =
      (Nat.primesLE n ×ˢ Fintype.piFinset (fun _ : Fin 4 => Nat.primesLE n)).map
        (Fin.snocEquiv (fun _ : Fin 5 => ℕ)).toEmbedding := by
    have he : Fin.init (fun _ : Fin 5 => Nat.primesLE n) =
        (fun _ : Fin 4 => Nat.primesLE n) := rfl
    simpa only [Finset.filter_true, he] using
      Finset.filter_piFinset_eq_map_snocEquiv
        (fun _ : Fin 5 => Nat.primesLE n) (fun _ : Fin 4 → ℕ => True)
  rw [hs, Finset.sum_map, Finset.sum_product, Finset.sum_comm]
  simp only [Equiv.toEmbedding_apply, Fin.snocEquiv_apply, Fin.prod_snoc]
  simp only [exceptionalPrimeDefect, ArithmeticFunction.coe_mk,
    Fin.val_zero]
  apply Finset.sum_congr rfl
  intro p hp
  have hp' : ∀ i, (p i).Prime := fun i => (Nat.mem_primesLE.mp
    (Fintype.mem_piFinset.mp hp i)).2
  rw [Nat.primesLE_eq_filter_Icc_one, Finset.sum_filter]
  apply Finset.sum_congr rfl
  intro r hr
  have h0a : (Fin.snoc p r : Fin 5 → ℕ) 0 = p 0 := rfl
  have h1a : (Fin.snoc p r : Fin 5 → ℕ) 1 = p 1 := rfl
  have h2a : (Fin.snoc p r : Fin 5 → ℕ) 2 = p 2 := rfl
  have h3a : (Fin.snoc p r : Fin 5 → ℕ) 3 = p 3 := rfl
  have h4a : (Fin.snoc p r : Fin 5 → ℕ) 4 = r := rfl
  simp only [h0a, h1a, h2a, h3a, h4a]
  by_cases h : (∏ i, p i) * r = n ∧
      (9519 : ℝ) / 50000 ≤ Real.logb x (p 3 : ℝ) ∧
      Real.logb x (p 3 : ℝ) < Real.logb x (p 2 : ℝ) ∧
      Real.logb x (p 2 : ℝ) < Real.logb x (p 1 : ℝ) ∧
      Real.logb x (p 1 : ℝ) < Real.logb x (p 0 : ℝ) ∧
      Real.logb x (p 0 : ℝ) < (40481 : ℝ) / 100000 ∧
      Real.logb x (p 0 : ℝ) + Real.logb x (p 1 : ℝ) < (40481 : ℝ) / 100000 ∧
      (59519 : ℝ) / 100000 < Real.logb x (p 1 : ℝ) +
        Real.logb x (p 2 : ℝ) + Real.logb x (p 3 : ℝ)
  · have hiff : (r ≠ 0 ∧ ∀ q ∈ r.primeFactors, (p 3 : ℝ) ≤ (q : ℝ)) ↔
        r.Prime ∧ (p 3 : ℝ) ≤ (r : ℝ) := by
      constructor
      · intro hrough
        exact exceptional_residual_prime hx hg hlo hhi p hp' r h.1 h.2.1
          h.2.2.1 h.2.2.2.1 h.2.2.2.2.1 h.2.2.2.2.2.2.1 hrough
      · rintro ⟨hprime, hbound⟩
        refine ⟨hprime.ne_zero, ?_⟩
        intro q hq
        have hqr : q = r := by simpa only [hprime.primeFactors, Finset.mem_singleton] using hq
        simpa only [hqr] using hbound
    rw [ite_eq_left h]
    change (if r ≠ 0 ∧ ∀ q ∈ r.primeFactors, (p 3 : ℝ) ≤ (q : ℝ)
      then (1 : ℝ) else 0) = _
    simp only [hiff]
    simp [h.1, h.2.1, h.2.2.1, h.2.2.2.1,
      h.2.2.2.2.1, h.2.2.2.2.2.1, h.2.2.2.2.2.2.1, h.2.2.2.2.2.2.2, ite_and]
  · simp only [← and_assoc] at h ⊢
    simp [h]

theorem sum_primeTuples_Icc {k : ℕ} (A B : ℕ) (g : (Fin k → ℕ) → ℝ) :
    (∑ n ∈ Finset.Icc A B,
      ∑ p ∈ Fintype.piFinset (fun _ : Fin k => Nat.primesLE n),
        if (∏ i, p i) = n then g p else 0) =
    ∑ p ∈ Fintype.piFinset (fun _ : Fin k => Nat.primesLE B),
      if (∏ i, p i) ∈ Finset.Icc A B then g p else 0 := by
  classical
  have hmem {p : Fin k → ℕ} {n : ℕ}
      (hp : p ∈ Fintype.piFinset (fun _ : Fin k => Nat.primesLE B))
      (hn : (∏ i, p i) = n) :
      p ∈ Fintype.piFinset (fun _ : Fin k => Nat.primesLE n) := by
    have h1 : ∀ i : Fin k, 1 ≤ p i := fun i =>
      (Nat.one_lt_of_mem_primesLE (Fintype.mem_piFinset.mp hp i)).le
    apply Fintype.mem_piFinset.mpr
    intro i
    apply Nat.mem_primesLE.mpr
    refine ⟨?_, (Nat.prime_of_mem_primesLE (Fintype.mem_piFinset.mp hp i))⟩
    simpa [← hn] using
      (Finset.single_le_prod' (s := (Finset.univ : Finset (Fin k)))
        (f := fun i : Fin k => p i) (fun i _ => h1 i) (Finset.mem_univ i))
  have hext (n : ℕ) (hn : n ≤ B) :
      (∑ p ∈ Fintype.piFinset (fun _ : Fin k => Nat.primesLE n),
        if (∏ i, p i) = n then g p else 0) =
      ∑ p ∈ Fintype.piFinset (fun _ : Fin k => Nat.primesLE B),
        if (∏ i, p i) = n then g p else 0 := by
    apply Finset.sum_subset
    · intro p hp
      exact Fintype.mem_piFinset.mpr (fun i => Nat.primesLE_mono hn
        (Fintype.mem_piFinset.mp hp i))
    · intro p hpB hpnot
      exact ite_eq_right (fun h => hpnot (hmem hpB h))
  rw [Finset.sum_congr rfl (fun n hn => hext n (Finset.mem_Icc.mp hn).2),
    Finset.sum_comm]
  exact Finset.sum_congr rfl (fun p _ => Finset.sum_ite_eq _ _ _)

theorem exceptionalPrimeDefect_zero_interval_as_tuple :
    ∀ᶠ x : ℝ in Filter.atTop,
      ∀ u v : ℝ, 1 ≤ u → u ≤ v → v ≤ 2 →
        (∑ n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)),
          exceptionalPrimeDefect x (0 : Fin 2) n) =
        ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE (Nat.floor (v * x))),
          if (∏ i, p i) ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)) ∧
              (9519 : ℝ) / 50000 ≤ Real.logb x (p 3 : ℝ) ∧
              Real.logb x (p 3 : ℝ) < Real.logb x (p 2 : ℝ) ∧
              Real.logb x (p 2 : ℝ) < Real.logb x (p 1 : ℝ) ∧
              Real.logb x (p 1 : ℝ) < Real.logb x (p 0 : ℝ) ∧
              Real.logb x (p 0 : ℝ) < (40481 : ℝ) / 100000 ∧
              Real.logb x (p 0 : ℝ) + Real.logb x (p 1 : ℝ) < (40481 : ℝ) / 100000 ∧
              (59519 : ℝ) / 100000 < Real.logb x (p 1 : ℝ) +
                Real.logb x (p 2 : ℝ) + Real.logb x (p 3 : ℝ) ∧ (p 3 : ℝ) ≤ (p 4 : ℝ)
          then (1 : ℝ) else 0 := by
  classical
  filter_upwards [eventually_exceptional_large] with x hx
  intro u v hu huv hv
  have hux : x ≤ u * x := by nlinarith [hx.1]
  have hvx : 0 ≤ v * x := by nlinarith [hx.1]
  have hsum (n : ℕ) (hn : n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x))) :=
    exceptionalPrimeDefect_zero_eq_five hx.1 hx.2
      (hux.trans (Nat.ceil_le.mp (Finset.mem_Icc.mp hn).1))
      ((Nat.le_floor_iff hvx).mp (Finset.mem_Icc.mp hn).2 |>.trans
        (mul_le_mul_of_nonneg_right hv (le_of_lt (by linarith : 0 < x))))
  rw [Finset.sum_congr rfl hsum]
  simp only [ite_and]
  rw [sum_primeTuples_Icc]

theorem pow_card_mul_add_sum_le_mul_prod {ι : Type*}
    (s : Finset ι) (d : ℝ) (y : ι → ℝ) (hd : 0 ≤ d)
    (hy : ∀ i ∈ s, 0 ≤ y i) :
    d ^ s.card * (d + ∑ i ∈ s, y i) ≤ d * ∏ i ∈ s, (d + y i) := by
  classical
  induction s using Finset.induction_on with
  | empty => simp
  | @insert i s hi ih =>
      have hyi : 0 ≤ y i := hy i (by simp)
      have hys (a : ι) (ha : a ∈ s) : 0 ≤ y a := hy a (by simp [ha])
      have hs : 0 ≤ ∑ j ∈ s, y j := Finset.sum_nonneg hys
      have hpair : d * (d + (y i + ∑ j ∈ s, y j)) ≤
          (d + ∑ j ∈ s, y j) * (d + y i) := by
        nlinarith [mul_nonneg hs hyi]
      simp only [Finset.sum_insert hi, Finset.prod_insert hi,
        Finset.card_insert_of_notMem hi, pow_succ]
      calc
        d ^ s.card * d * (d + (y i + ∑ j ∈ s, y j))
            ≤ d ^ s.card * ((d + ∑ j ∈ s, y j) * (d + y i)) :=
              by simpa only [mul_assoc] using
                (mul_le_mul_of_nonneg_left hpair (pow_nonneg hd s.card))
        _ ≤ (d * ∏ j ∈ s, (d + y j)) * (d + y i) :=
              by
                simpa only [mul_assoc] using
                  (mul_le_mul_of_nonneg_right (ih hys) (add_nonneg hd hyi))
        _ = d * ((d + y i) * ∏ j ∈ s, (d + y j)) := by ring

theorem density_product_lower {f : Fin 5 → ℝ} (h : ∀ i, (9519 : ℝ) / 50000 ≤ f i)
    (hs : ∑ i, f i = 1) :
    ((9519 : ℝ) / 50000) ^ 4 * (1 - 4 * ((9519 : ℝ) / 50000)) ≤ ∏ i, f i := by
  have haux := pow_card_mul_add_sum_le_mul_prod (Finset.univ : Finset (Fin 5))
    ((9519 : ℝ) / 50000) (fun i => f i - 9519 / 50000)
    (by norm_num) (fun i _ => sub_nonneg.mpr (h i))
  simp only [Finset.sum_sub_distrib, Finset.sum_const, Finset.card_univ,
    Fintype.card_fin, nsmul_eq_mul, Nat.cast_ofNat, hs,
    ← add_sub_assoc, add_sub_cancel_left] at haux
  norm_num at haux ⊢
  linarith

theorem coefficient_coord_continuous (i : Fin 5) :
    Continuous (fun t : Fin 4 → ℝ => (Fin.snoc t (1 - ∑ j, t j) : Fin 5 → ℝ) i) := by
  fun_prop

theorem coefficient_sum_one (t : Fin 4 → ℝ) :
    ∑ i, (Fin.snoc t (1 - ∑ k, t k) : Fin 5 → ℝ) i = 1 := by
  rw [Fin.sum_snoc]
  ring

theorem exceptionalCut_measurable (j : Fin 2) :
    MeasurableSet {t : Fin 4 → ℝ |
      let alpha : Fin 5 → ℝ := Fin.snoc t (1 - ∑ k, t k)
      (∀ i, (9519 : ℝ) / 50000 ≤ alpha i) ∧
        (if j.val = 0 then
          alpha 3 ≤ alpha 2 ∧ alpha 2 ≤ alpha 1 ∧ alpha 1 ≤ alpha 0 ∧
          alpha 3 ≤ alpha 4 ∧ alpha 0 + alpha 1 ≤ (40481 : ℝ) / 100000 ∧
          (59519 : ℝ) / 100000 ≤ alpha 1 + alpha 2 + alpha 3
        else
          alpha 1 ≤ alpha 0 ∧ alpha 1 ≤ alpha 2 ∧ alpha 3 ≤ alpha 4 ∧
          alpha 0 + alpha 2 ≤ (40481 : ℝ) / 100000 ∧
          (59519 : ℝ) / 100000 ≤ alpha 0 + alpha 1 + alpha 3)} := by
  classical
  by_cases hj : j.val = 0 <;>
    simp only [hj, ↓reduceIte, Set.ofPred_and, Set.ofPred_forall] <;>
    measurability

theorem exceptional_density_integrable (j : Fin 2) :
    Integrable (fun t : Fin 4 → ℝ =>
      let alpha := (Fin.snoc t (1 - ∑ i, t i) : Fin 5 → ℝ)
      if (∀ i, (9519 : ℝ) / 50000 ≤ alpha i) ∧
          (if j.val = 0 then
            alpha 3 ≤ alpha 2 ∧ alpha 2 ≤ alpha 1 ∧ alpha 1 ≤ alpha 0 ∧
            alpha 3 ≤ alpha 4 ∧ alpha 0 + alpha 1 ≤ (40481 : ℝ) / 100000 ∧
            (59519 : ℝ) / 100000 ≤ alpha 1 + alpha 2 + alpha 3
          else
            alpha 1 ≤ alpha 0 ∧ alpha 1 ≤ alpha 2 ∧ alpha 3 ≤ alpha 4 ∧
            alpha 0 + alpha 2 ≤ (40481 : ℝ) / 100000 ∧
            (59519 : ℝ) / 100000 ≤ alpha 0 + alpha 1 + alpha 3)
      then (∏ i, alpha i)⁻¹ else 0) volume := by
  classical
  let f : (Fin 4 → ℝ) → ℝ := fun t =>
    let alpha := (Fin.snoc t (1 - ∑ i, t i) : Fin 5 → ℝ)
    if (∀ i, (9519 : ℝ) / 50000 ≤ alpha i) ∧
        (if j.val = 0 then
          alpha 3 ≤ alpha 2 ∧ alpha 2 ≤ alpha 1 ∧ alpha 1 ≤ alpha 0 ∧
          alpha 3 ≤ alpha 4 ∧ alpha 0 + alpha 1 ≤ (40481 : ℝ) / 100000 ∧
          (59519 : ℝ) / 100000 ≤ alpha 1 + alpha 2 + alpha 3
        else
          alpha 1 ≤ alpha 0 ∧ alpha 1 ≤ alpha 2 ∧ alpha 3 ≤ alpha 4 ∧
          alpha 0 + alpha 2 ≤ (40481 : ℝ) / 100000 ∧
          (59519 : ℝ) / 100000 ≤ alpha 0 + alpha 1 + alpha 3)
    then (∏ i, alpha i)⁻¹ else 0
  change Integrable f volume
  have hmeas : Measurable f :=
    Measurable.ite (exceptionalCut_measurable j) (by fun_prop) measurable_const
  have hdpos : 0 < ((9519 : ℝ) / 50000) ^ 4 * (1 - 4 * ((9519 : ℝ) / 50000)) := by norm_num
  have hpoint (t : Fin 4 → ℝ) :
      0 ≤ f t ∧ f t ≤ (((9519 : ℝ) / 50000) ^ 4 * (1 - 4 * ((9519 : ℝ) / 50000)))⁻¹ := by
    have hcase (ht : ∀ i : Fin 5,
        (9519 : ℝ) / 50000 ≤ (Fin.snoc t (1 - ∑ k, t k) : Fin 5 → ℝ) i) :
        0 ≤ (∏ i, (Fin.snoc t (1 - ∑ k, t k) : Fin 5 → ℝ) i)⁻¹ ∧
          (∏ i, (Fin.snoc t (1 - ∑ k, t k) : Fin 5 → ℝ) i)⁻¹ ≤
            (((9519 : ℝ) / 50000) ^ 4 * (1 - 4 * ((9519 : ℝ) / 50000)))⁻¹ := by
      have hl := density_product_lower ht (coefficient_sum_one t)
      exact ⟨inv_nonneg.mpr (hdpos.le.trans hl), inv_anti₀ hdpos hl⟩
    dsimp only [f]
    by_cases hj : j.val = 0 <;> simp only [hj, ↓reduceIte]
    all_goals split_ifs with ht
    all_goals first | exact hcase ht.1 | exact ⟨le_rfl, (inv_pos.mpr hdpos).le⟩
  have hbox : Function.support f ⊆ Set.Icc (0 : Fin 4 → ℝ) 1 := by
    intro t ht
    have ht' : f t ≠ 0 := ht
    have hout : (∀ i : Fin 5,
        (9519 : ℝ) / 50000 ≤ (Fin.snoc t (1 - ∑ k, t k) : Fin 5 → ℝ) i) := by
      by_cases hj : j.val = 0 <;> simp only [f, hj, ↓reduceIte] at ht'
      all_goals split_ifs at ht' with hh
      all_goals first | exact hh.1 | exact (ht' rfl).elim
    have hg (i : Fin 5) : 0 ≤ (Fin.snoc t (1 - ∑ k, t k) : Fin 5 → ℝ) i :=
      (by norm_num : (0 : ℝ) ≤ 9519 / 50000) |>.trans (hout i)
    have hle (i : Fin 5) : (Fin.snoc t (1 - ∑ k, t k) : Fin 5 → ℝ) i ≤ 1 := by
      simpa [coefficient_sum_one t] using
        (Finset.single_le_sum (fun k (_ : k ∈ (Finset.univ : Finset (Fin 5))) => hg k)
          (Finset.mem_univ i))
    constructor
    · intro i
      simpa only [Pi.zero_apply, Fin.snoc_castSucc] using hg (Fin.castSucc i)
    · intro i
      simpa only [Pi.one_apply, Fin.snoc_castSucc] using hle (Fin.castSucc i)
  rw [← integrableOn_iff_integrable_of_support_subset hbox]
  refine Measure.integrableOn_of_bounded
    (M := (((9519 : ℝ) / 50000) ^ 4 * (1 - 4 * ((9519 : ℝ) / 50000)))⁻¹) ?_
    (hmeas.aestronglyMeasurable) ?_
  · exact isCompact_Icc.measure_ne_top
  · filter_upwards [] with t
    rw [Real.norm_eq_abs, abs_of_nonneg (hpoint t).1]
    exact (hpoint t).2

theorem exceptionalMassCoefficient_nonneg (j : Fin 2) : 0 ≤ exceptionalMassCoefficient j := by
  classical
  simp only [exceptionalMassCoefficient]
  apply integral_nonneg
  intro t
  simp only [Pi.zero_apply]
  by_cases hj : j.val = 0 <;> simp only [hj, ↓reduceIte]
  all_goals split_ifs with hh
  all_goals first
    | exact inv_nonneg.mpr (Finset.prod_nonneg (fun i _ =>
        (by norm_num : (0 : ℝ) ≤ 9519 / 50000) |>.trans (hh.1 i)))
    | exact le_rfl

theorem affine_hyperplane_null (c : Fin 4 → ℝ) (d : ℝ)
    (hc : ∃ i, c i ≠ 0) : volume {t : Fin 4 → ℝ | (∑ i, c i * t i) = d} = 0 := by
  classical
  let s : AffineSubspace ℝ (Fin 4 → ℝ) :=
    (affineSpan ℝ ({d} : Set ℝ)).comap (dotProductBilin ℝ ℝ c).toAffineMap
  have hneq : s ≠ ⊤ := by
    intro hs
    have he (t : Fin 4 → ℝ) : (∑ i, c i * t i) = d := by
      simpa [s, dotProduct] using
        (hs.symm ▸ AffineSubspace.mem_top ℝ (Fin 4 → ℝ) t : t ∈ s)
    have hd : d = 0 := by
      simpa only [Pi.zero_apply, mul_zero, Finset.sum_const_zero, eq_comm] using
        he (0 : Fin 4 → ℝ)
    obtain ⟨i, hi⟩ := hc
    have hz := he (Pi.single i 1)
    simp only [Pi.single_apply, mul_ite, mul_one, mul_zero, Finset.sum_ite_eq',
      Finset.mem_univ, ↓reduceIte, hd] at hz
    exact hi hz
  simpa [s, Set.preimage, dotProduct] using Measure.addHaar_affineSubspace volume s hneq

theorem snoc_affine_boundary_null (e : Fin 5 → ℝ) (d : ℝ)
    (he : ∃ i j, e i ≠ e j) :
    volume {t : Fin 4 → ℝ | (∑ i, e i * (Fin.snoc t (1 - ∑ k, t k) : Fin 5 → ℝ) i) = d} = 0 := by
  classical
  have he' : ∃ i : Fin 4, e (Fin.castSucc i) ≠ e (Fin.last 4) := by
    by_contra h
    simp only [not_exists, not_not] at h
    obtain ⟨i, j, hij⟩ := he
    have hc (k : Fin 5) : e k = e (Fin.last 4) := by
      refine Fin.lastCases ?_ (fun k' => ?_) k
      · rfl
      · exact h k'
    exact hij ((hc i).trans (hc j).symm)
  apply Eq.trans _ (affine_hyperplane_null (fun i => e (Fin.castSucc i) - e (Fin.last 4))
    (d - e (Fin.last 4)) (by obtain ⟨i, hi⟩ := he'; exact ⟨i, sub_ne_zero.mpr hi⟩))
  congr 1
  ext t
  simp only [Set.mem_ofPred_eq]
  rw [Fin.sum_univ_castSucc (fun i : Fin 5 => e i * (Fin.snoc t (1 - ∑ k, t k) : Fin 5 → ℝ) i)]
  simp only [Fin.snoc_castSucc, Fin.snoc_last]
  have hdist : (∑ i : Fin 4, (e i.castSucc - e (Fin.last 4)) * t i) =
      (∑ i : Fin 4, e i.castSucc * t i) - e (Fin.last 4) * (∑ i : Fin 4, t i) := by
    simp_rw [sub_mul, Finset.sum_sub_distrib, ← Finset.mul_sum]
  rw [hdist]
  constructor <;> intro h <;> linarith

open Classical in
theorem exceptionalPrimeDefect_one_interval_as_tuple (x u v : ℝ) :
    (∑ n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)),
      exceptionalPrimeDefect x (1 : Fin 2) n) =
    ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE (Nat.floor (v * x))),
      if (∏ i, p i) ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)) ∧
          (∀ i, (9519 : ℝ) / 50000 ≤ Real.logb x (p i : ℝ) ∧
            Real.logb x (p i : ℝ) ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
          Real.logb x (p 1 : ℝ) < Real.logb x (p 0 : ℝ) ∧
          Real.logb x (p 1 : ℝ) < Real.logb x (p 2 : ℝ) ∧
          Real.logb x (p 0 : ℝ) + Real.logb x (p 2 : ℝ) < (40481 : ℝ) / 100000 ∧
          (59519 : ℝ) / 100000 < Real.logb x (p 0 : ℝ) +
            Real.logb x (p 1 : ℝ) + Real.logb x (p 3 : ℝ) ∧
          Real.logb x (p 3 : ℝ) ≤ Real.logb x (p 4 : ℝ)
      then (1 : ℝ) else 0 := by
  simp only [exceptionalPrimeDefect, ArithmeticFunction.coe_mk, Fin.val_one,
    Nat.one_ne_zero, ite_false, ite_and]
  rw [sum_primeTuples_Icc]

theorem prime_five_mem_compact_band
    (x : ℝ) (hx : 1 < x)
    (hg : 2 ≤ x ^ ((6 : ℝ) / 25 - (1 - 4 * ((9519 : ℝ) / 50000))))
    (p : Fin 5 → ℕ) (hp : ∀ i, (p i).Prime)
    (hl : ∀ i, (9519 : ℝ) / 50000 ≤ Real.logb x (p i : ℝ))
    (hprod : ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x) :
    ∀ i, p i ∈ (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
      (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime := by
  classical
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hpos (i : Fin 5) : 0 < (p i : ℝ) := Nat.cast_pos.mpr (hp i).pos
  have hPpos : 0 < ∏ i, (p i : ℝ) := Finset.prod_pos (fun i _ => hpos i)
  have hPupper : (∏ i, (p i : ℝ)) ≤ 2 * x := by
    simpa only [Nat.cast_prod] using hprod
  have hlog : Real.logb x (∏ i, (p i : ℝ)) = ∑ i, Real.logb x (p i : ℝ) :=
    Real.logb_prod Finset.univ (fun i : Fin 5 => (p i : ℝ))
      (fun i _ => (hpos i).ne')
  have hsum : (∑ i, Real.logb x (p i : ℝ)) ≤ Real.logb x 2 + 1 := by
    calc
      _ = Real.logb x (∏ i, (p i : ℝ)) := hlog.symm
      _ ≤ Real.logb x (2 * x) := Real.logb_le_logb_of_le hx hPpos hPupper
      _ = _ := by
        rw [Real.logb_mul (by norm_num : (2 : ℝ) ≠ 0) hx0.ne',
          Real.logb_self_eq_one hx]
  have htwo : Real.logb x 2 ≤ (6 : ℝ) / 25 - (1 - 4 * ((9519 : ℝ) / 50000)) :=
    (Real.logb_le_iff_le_rpow hx (by norm_num : (0 : ℝ) < 2)).mpr hg
  have hu (i : Fin 5) : Real.logb x (p i : ℝ) ≤ (6 : ℝ) / 25 := by
    have hi := Finset.single_le_sum
      (s := Finset.univ) (f := fun j : Fin 5 => Real.logb x (p j : ℝ) - 9519 / 50000)
      (fun j _ => sub_nonneg.mpr (hl j)) (Finset.mem_univ i)
    simp only [Finset.sum_sub_distrib, Finset.sum_const, Finset.card_univ,
      Fintype.card_fin, nsmul_eq_mul, Nat.cast_ofNat] at hi
    linarith only [hi, hsum, htwo]
  intro i
  refine Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr ⟨?_, ?_⟩, hp i⟩
  · exact Nat.ceil_le.mpr ((Real.le_logb_iff_rpow_le hx (hpos i)).mp (hl i))
  · exact Nat.le_floor ((Real.logb_le_iff_le_rpow hx (hpos i)).mp (hu i))

open Classical in
theorem exceptionalPrimeDefect_interval_as_compact_tuple :
    ∀ᶠ x : ℝ in Filter.atTop,
      ∀ j : Fin 2, ∀ u v : ℝ, 1 ≤ u → u ≤ v → v ≤ 2 →
        (∑ n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)),
          exceptionalPrimeDefect x j n) =
        let P : Finset ℕ :=
          (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
            (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime
        ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => P),
          let alpha : Fin 5 → ℝ := fun i => Real.logb x (p i : ℝ)
          if (∏ i, p i) ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)) ∧
              (if j.val = 0 then
                (9519 : ℝ) / 50000 ≤ alpha 3 ∧
                alpha 3 < alpha 2 ∧ alpha 2 < alpha 1 ∧ alpha 1 < alpha 0 ∧
                alpha 0 < (40481 : ℝ) / 100000 ∧
                alpha 0 + alpha 1 < (40481 : ℝ) / 100000 ∧
                (59519 : ℝ) / 100000 < alpha 1 + alpha 2 + alpha 3 ∧
                (p 3 : ℝ) ≤ (p 4 : ℝ)
              else
                (∀ i, (9519 : ℝ) / 50000 ≤ alpha i ∧
                  alpha i ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
                alpha 1 < alpha 0 ∧ alpha 1 < alpha 2 ∧
                alpha 0 + alpha 2 < (40481 : ℝ) / 100000 ∧
                (59519 : ℝ) / 100000 < alpha 0 + alpha 1 + alpha 3 ∧
                alpha 3 ≤ alpha 4)
          then (1 : ℝ) else 0 := by
  have hg := tendsto_rpow_atTop (by norm_num :
    (0 : ℝ) < (6 : ℝ) / 25 - (1 - 4 * ((9519 : ℝ) / 50000)))
  filter_upwards [exceptionalPrimeDefect_zero_interval_as_tuple,
    Filter.eventually_gt_atTop (1 : ℝ), hg.eventually_ge_atTop 2] with x hzero hx hgap
  intro j u v hu huv hv
  let P : Finset ℕ :=
    (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
      (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime
  let Q : Finset ℕ := Nat.primesLE (Nat.floor (v * x))
  let C (k : Fin 2) (p : Fin 5 → ℕ) : Prop :=
    let alpha : Fin 5 → ℝ := fun i => Real.logb x (p i : ℝ)
    if k.val = 0 then
      (9519 : ℝ) / 50000 ≤ alpha 3 ∧
      alpha 3 < alpha 2 ∧ alpha 2 < alpha 1 ∧ alpha 1 < alpha 0 ∧
      alpha 0 < (40481 : ℝ) / 100000 ∧
      alpha 0 + alpha 1 < (40481 : ℝ) / 100000 ∧
      (59519 : ℝ) / 100000 < alpha 1 + alpha 2 + alpha 3 ∧
      (p 3 : ℝ) ≤ (p 4 : ℝ)
    else
      (∀ i, (9519 : ℝ) / 50000 ≤ alpha i ∧
        alpha i ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
      alpha 1 < alpha 0 ∧ alpha 1 < alpha 2 ∧
      alpha 0 + alpha 2 < (40481 : ℝ) / 100000 ∧
      (59519 : ℝ) / 100000 < alpha 0 + alpha 1 + alpha 3 ∧ alpha 3 ≤ alpha 4
  let w (p : Fin 5 → ℕ) : ℝ :=
    if (∏ i, p i) ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)) ∧ C j p
    then 1 else 0
  change (∑ n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)),
    exceptionalPrimeDefect x j n) = ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => P), w p
  have hsource : (∑ n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)),
      exceptionalPrimeDefect x j n) =
      ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Q), w p := by
    fin_cases j
    · simpa [w, C, Q] using hzero u v hu huv hv
    · simpa [w, C, Q] using exceptionalPrimeDefect_one_interval_as_tuple x u v
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hv1 : 1 ≤ v := hu.trans huv
  have hvx : 0 ≤ v * x := mul_nonneg (zero_le_one.trans hv1) hx0.le
  have hBx : x ^ ((6 : ℝ) / 25) ≤ x := by
    simpa only [Real.rpow_one] using Real.rpow_le_rpow_of_exponent_le hx.le
      (by norm_num : (6 : ℝ) / 25 ≤ 1)
  have hxvx : x ≤ v * x := by nlinarith
  have hPQ : P ⊆ Q := by
    intro p hp
    rcases Finset.mem_filter.mp hp with ⟨hi, hprime⟩
    apply Nat.mem_primesLE.mpr
    exact ⟨(Finset.mem_Icc.mp hi).2.trans (Nat.floor_mono (hBx.trans hxvx)), hprime⟩
  have hsubset : Fintype.piFinset (fun _ : Fin 5 => P) ⊆
      Fintype.piFinset (fun _ : Fin 5 => Q) :=
    Fintype.piFinset_subset _ _ (fun _ => hPQ)
  calc
    _ = ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Q), w p := hsource
    _ = ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => P), w p := by
      symm
      apply Finset.sum_subset hsubset
      intro p hpQ hpnot
      change (if (∏ i, p i) ∈
        Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)) ∧ C j p then (1 : ℝ) else 0) = 0
      apply ite_eq_right
      intro h
      have hpprime : ∀ i, (p i).Prime := fun i =>
        Nat.prime_of_mem_primesLE (Fintype.mem_piFinset.mp hpQ i)
      have hpos (i : Fin 5) : 0 < (p i : ℝ) := Nat.cast_pos.mpr (hpprime i).pos
      have hl : ∀ i, (9519 : ℝ) / 50000 ≤ Real.logb x (p i : ℝ) := by
        by_cases hj : j.val = 0
        · have hc := h.2
          simp only [C, hj, ite_true] at hc
          rcases hc with ⟨h3, h32, h21, h10, _, _, _, h34⟩
          have hlog34 := Real.logb_le_logb_of_le hx (hpos 3) h34
          intro i
          fin_cases i
          · change (9519 : ℝ) / 50000 ≤ Real.logb x (p 0 : ℝ)
            exact h3.trans (h32.le.trans (h21.le.trans h10.le))
          · change (9519 : ℝ) / 50000 ≤ Real.logb x (p 1 : ℝ)
            exact h3.trans (h32.le.trans h21.le)
          · change (9519 : ℝ) / 50000 ≤ Real.logb x (p 2 : ℝ)
            exact h3.trans h32.le
          · change (9519 : ℝ) / 50000 ≤ Real.logb x (p 3 : ℝ)
            exact h3
          · change (9519 : ℝ) / 50000 ≤ Real.logb x (p 4 : ℝ)
            exact h3.trans hlog34
        · have hc := h.2
          simp only [C, hj, ite_false] at hc
          exact fun i => (hc.1 i).1
      have hupper : ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x :=
        ((Nat.le_floor_iff hvx).mp (Finset.mem_Icc.mp h.1).2).trans
          (mul_le_mul_of_nonneg_right hv hx0.le)
      exact hpnot (Fintype.mem_piFinset.mpr
        (prime_five_mem_compact_band x hx hgap p hpprime hl hupper))

open Classical in
theorem prime_prefix_interval_log_geometry
    (x u v : ℝ) (hx : 1 < x) (hu : 1 ≤ u) (hv : v ≤ 2)
    (p : Fin 4 → ℕ)
    (hp : ∀ i, p i ∈
      (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
        (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime)
    (q : ℕ)
    (hprod : (∏ i, p i) * q ∈
      Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x))) :
    let t : Fin 4 → ℝ := fun i => Real.logb x (p i : ℝ)
    let P : ℝ := ∏ i, (p i : ℝ)
    let beta : ℝ := 1 - ∑ i, t i
    let w : ℝ := (q : ℝ) * P / x
    (∀ i, (9519 : ℝ) / 50000 ≤ t i ∧ t i ≤ (6 : ℝ) / 25) ∧
      0 < P ∧
      x ^ (4 * ((9519 : ℝ) / 50000)) ≤ P ∧ P ≤ x ^ ((24 : ℝ) / 25) ∧
      (1 : ℝ) / 25 ≤ beta ∧ beta ≤ 1 - 4 * ((9519 : ℝ) / 50000) ∧
      Real.logb x P = ∑ i, t i ∧
      u ≤ w ∧ w ≤ v ∧
      Real.logb x (q : ℝ) = beta + Real.log w / Real.log x ∧
      0 ≤ Real.log w / Real.log x ∧
      Real.log w / Real.log x ≤ Real.log 2 / Real.log x := by
  let t : Fin 4 → ℝ := fun i => Real.logb x (p i : ℝ)
  let P : ℝ := ∏ i, (p i : ℝ)
  let beta : ℝ := 1 - ∑ i, t i
  let w : ℝ := (q : ℝ) * P / x
  change (∀ i, (9519 : ℝ) / 50000 ≤ t i ∧ t i ≤ (6 : ℝ) / 25) ∧
    0 < P ∧ x ^ (4 * ((9519 : ℝ) / 50000)) ≤ P ∧ P ≤ x ^ ((24 : ℝ) / 25) ∧
    (1 : ℝ) / 25 ≤ beta ∧ beta ≤ 1 - 4 * ((9519 : ℝ) / 50000) ∧
    Real.logb x P = ∑ i, t i ∧ u ≤ w ∧ w ≤ v ∧
    Real.logb x (q : ℝ) = beta + Real.log w / Real.log x ∧
    0 ≤ Real.log w / Real.log x ∧
    Real.log w / Real.log x ≤ Real.log 2 / Real.log x
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hpos (i : Fin 4) : 0 < (p i : ℝ) :=
    Nat.cast_pos.mpr (Finset.mem_filter.mp (hp i)).2.pos
  have ht : ∀ i, (9519 : ℝ) / 50000 ≤ t i ∧ t i ≤ (6 : ℝ) / 25 := by
    intro i
    have hi := Finset.mem_Icc.mp (Finset.mem_filter.mp (hp i)).1
    constructor
    · exact (Real.le_logb_iff_rpow_le hx (hpos i)).mpr (Nat.ceil_le.mp hi.1)
    · exact (Real.logb_le_iff_le_rpow hx (hpos i)).mpr
        ((Nat.le_floor_iff (Real.rpow_pos_of_pos hx0 _).le).mp hi.2)
  have hPpos : 0 < P := Finset.prod_pos (fun i _ => hpos i)
  have hlog : Real.logb x P = ∑ i, t i :=
    Real.logb_prod Finset.univ (fun i : Fin 4 => (p i : ℝ))
      (fun i _ => (hpos i).ne')
  have hsum : 4 * ((9519 : ℝ) / 50000) ≤ ∑ i, t i ∧
      (∑ i, t i) ≤ (24 : ℝ) / 25 := by
    simp only [Fin.sum_univ_four]
    constructor <;> linarith [(ht 0).1, (ht 1).1, (ht 2).1, (ht 3).1,
      (ht 0).2, (ht 1).2, (ht 2).2, (ht 3).2]
  have hPlo : x ^ (4 * ((9519 : ℝ) / 50000)) ≤ P :=
    (Real.le_logb_iff_rpow_le hx hPpos).mp (by rw [hlog]; exact hsum.1)
  have hPhi : P ≤ x ^ ((24 : ℝ) / 25) :=
    (Real.logb_le_iff_le_rpow hx hPpos).mp (by rw [hlog]; exact hsum.2)
  have hbetalo : (1 : ℝ) / 25 ≤ beta := by dsimp only [beta]; linarith [hsum.2]
  have hbetahi : beta ≤ 1 - 4 * ((9519 : ℝ) / 50000) := by
    dsimp only [beta]
    linarith [hsum.1]
  have huxpos : 0 < u * x := mul_pos (zero_lt_one.trans_le hu) hx0
  have hNpos : 0 < (∏ i, p i) * q :=
    (Nat.ceil_pos.mpr huxpos).trans_le (Finset.mem_Icc.mp hprod).1
  have hq0 : q ≠ 0 := by
    intro hq
    simp only [hq, mul_zero, lt_self_iff_false] at hNpos
  have hqpos : 0 < (q : ℝ) := Nat.cast_pos.mpr (Nat.pos_of_ne_zero hq0)
  have hvx : 0 ≤ v * x :=
    (Nat.pos_of_floor_pos (hNpos.trans_le (Finset.mem_Icc.mp hprod).2)).le
  have hlow : u * x ≤ (q : ℝ) * P := by
    simpa only [Nat.cast_mul, Nat.cast_prod, P, mul_comm] using
      Nat.ceil_le.mp (Finset.mem_Icc.mp hprod).1
  have hhigh : (q : ℝ) * P ≤ v * x := by
    simpa only [Nat.cast_mul, Nat.cast_prod, P, mul_comm] using
      (Nat.le_floor_iff hvx).mp (Finset.mem_Icc.mp hprod).2
  have hwlo : u ≤ w := (le_div_iff₀ hx0).mpr hlow
  have hwhi : w ≤ v := (div_le_iff₀ hx0).mpr hhigh
  have hwone : 1 ≤ w := hu.trans hwlo
  have hwtwo : w ≤ 2 := hwhi.trans hv
  have hwpos : 0 < w := zero_lt_one.trans_le hwone
  have hlogw : Real.logb x w = Real.logb x (q : ℝ) + (∑ i, t i) - 1 := by
    dsimp only [w]
    rw [Real.logb_div (mul_ne_zero hqpos.ne' hPpos.ne') hx0.ne',
      Real.logb_mul hqpos.ne' hPpos.ne', hlog, Real.logb_self_eq_one hx]
  have hlast : Real.logb x (q : ℝ) = beta + Real.log w / Real.log x := by
    change Real.logb x (q : ℝ) = beta + Real.logb x w
    dsimp only [beta]
    linarith [hlogw]
  refine ⟨ht, hPpos, hPlo, hPhi, hbetalo, hbetahi, hlog, hwlo, hwhi, hlast, ?_, ?_⟩
  · exact div_nonneg (Real.log_nonneg hwone) (Real.log_pos hx).le
  · exact div_le_div_of_nonneg_right (Real.log_le_log hwpos hwtwo) (Real.log_pos hx).le

theorem five_prime_product_not_prime (p : Fin 5 → ℕ)
    (hp : ∀ i, Nat.Prime (p i)) :
    ¬Nat.Prime (∏ i, p i) := by
  rw [Fin.prod_univ_succ]
  refine Nat.not_prime_mul (hp 0).ne_one ?_
  intro h
  have hd : p (1 : Fin 5) ∣ ∏ i : Fin 4, p i.succ :=
    Finset.dvd_prod_of_mem (fun i : Fin 4 => p i.succ) (Finset.mem_univ 0)
  rw [h] at hd
  exact (hp 1).not_dvd_one hd

theorem five_prime_product_rough (z : ℝ) (p : Fin 5 → ℕ)
    (hp : ∀ i, Nat.Prime (p i)) (hz : ∀ i, z ≤ (p i : ℝ))
    {n : ℕ} (hn : n = ∏ i, p i) :
    n ≠ 0 ∧ ∀ q ∈ n.primeFactors, z ≤ (q : ℝ) := by
  subst n
  refine ⟨Finset.prod_ne_zero_iff.mpr (fun i _ => (hp i).ne_zero), ?_⟩
  intro q hq
  have hqprime : Nat.Prime q := Nat.prime_of_mem_primeFactors hq
  obtain ⟨i, _, hqi⟩ :=
    (hqprime.prime.dvd_finsetProd_iff p).mp (Nat.dvd_of_mem_primeFactors hq)
  have heq : q = p i := (Nat.prime_dvd_prime_iff_eq hqprime (hp i)).mp hqi
  simpa only [heq] using hz i

theorem sum_five_prime_tuple_indicator_le
    (n : ℕ) (P : (Fin 5 → ℕ) → Prop) [DecidablePred P]
    (hprod : ∀ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
      P p → (∏ i, p i) = n) :
    (∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
      if P p then (1 : ℝ) else 0) ≤ 3125 := by
  classical
  rw [Finset.sum_boole]
  let S := Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n)
  change ((S.filter P).card : ℝ) ≤ 3125
  suffices hcard : (S.filter P).card ≤ 3125 by exact_mod_cast hcard
  by_cases h : (S.filter P).Nonempty
  · obtain ⟨v, hv⟩ := h
    rcases Finset.mem_filter.mp hv with ⟨hvS, hvP⟩
    let R : Finset ℕ := Finset.univ.image v
    have hsubset : S.filter P ⊆ Fintype.piFinset (fun _ : Fin 5 => R) := by
      intro q hq
      rcases Finset.mem_filter.mp hq with ⟨hqS, hqP⟩
      apply Fintype.mem_piFinset.mpr
      intro i
      have hqi : (q i).Prime :=
        Nat.prime_of_mem_primesLE (Fintype.mem_piFinset.mp hqS i)
      have hdiv : q i ∣ ∏ j, v j := by
        rw [hprod v hvS hvP, ← hprod q hqS hqP]
        exact Finset.dvd_prod_of_mem q (Finset.mem_univ i)
      obtain ⟨j, hj, hqj⟩ := hqi.prime.exists_mem_finset_dvd hdiv
      have hvj : (v j).Prime :=
        Nat.prime_of_mem_primesLE (Fintype.mem_piFinset.mp hvS j)
      exact Finset.mem_image.mpr
        ⟨j, hj, ((Nat.prime_dvd_prime_iff_eq hqi hvj).mp hqj).symm⟩
    have hR : R.card ≤ 5 := by
      simpa [R] using
        (Finset.card_image_le (s := (Finset.univ : Finset (Fin 5))) (f := v))
    calc
      (S.filter P).card ≤
          (Fintype.piFinset (fun _ : Fin 5 => R)).card :=
        Finset.card_le_card hsubset
      _ = R.card ^ 5 := Fintype.card_piFinset_const R 5
      _ ≤ 5 ^ 5 := Nat.pow_le_pow_left hR 5
      _ = 3125 := by norm_num
  · rw [Finset.not_nonempty_iff_eq_empty.mp h]
    simp

theorem five_prime_indicator_properties
    (n : ℕ) (z : ℝ) (P : (Fin 5 → ℕ) → Prop) [DecidablePred P]
    (hP : ∀ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
      P p → (∏ i, p i) = n ∧ ∀ i, z ≤ (p i : ℝ)) :
    (n.Prime →
      (∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
        if P p then (1 : ℝ) else 0) = 0) ∧
      ((∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
        if P p then (1 : ℝ) else 0) ≠ 0 →
        n ≠ 0 ∧ ∀ q ∈ n.primeFactors, z ≤ (q : ℝ)) ∧
      (∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
        if P p then (1 : ℝ) else 0) ≤ 3125 := by
  classical
  have hprime (p : Fin 5 → ℕ)
      (hp : p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n)) :
      ∀ i, (p i).Prime :=
    fun i => Nat.prime_of_mem_primesLE (Fintype.mem_piFinset.mp hp i)
  refine ⟨?_, ?_, sum_five_prime_tuple_indicator_le n P
    (fun p hp h => (hP p hp h).1)⟩
  · intro hn
    apply Finset.sum_eq_zero
    intro p hp
    by_cases h : P p
    · exfalso
      exact five_prime_product_not_prime p (hprime p hp)
        (by simpa only [(hP p hp h).1] using hn)
    · exact ite_eq_right h
  · intro hs
    obtain ⟨p, hp, hne⟩ := Finset.exists_ne_zero_of_sum_ne_zero hs
    have h : P p := by
      by_contra h
      exact hne (ite_eq_right h)
    exact five_prime_product_rough z p (hprime p hp)
      (hP p hp h).2 (hP p hp h).1.symm

theorem exceptionalPrimeDefect_pointwise_properties
    {x : ℝ} (hx : 1 < x)
    (hg : 2 * x < x ^ (6 * ((9519 : ℝ) / 50000)))
    {n : ℕ} (hlo : x ≤ (n : ℝ)) (hhi : (n : ℝ) ≤ 2 * x) (j : Fin 2) :
    (n.Prime → exceptionalPrimeDefect x j n = 0) ∧
      (exceptionalPrimeDefect x j n ≠ 0 →
        n ≠ 0 ∧ ∀ p ∈ n.primeFactors,
          x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ)) ∧
      exceptionalPrimeDefect x j n ≤ 3125 := by
  classical
  fin_cases j
  · change (n.Prime → exceptionalPrimeDefect x 0 n = 0) ∧
      (exceptionalPrimeDefect x 0 n ≠ 0 → n ≠ 0 ∧ ∀ p ∈ n.primeFactors,
        x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ)) ∧
      exceptionalPrimeDefect x 0 n ≤ 3125
    rw [exceptionalPrimeDefect_zero_eq_five hx hg hlo hhi]
    apply five_prime_indicator_properties n (x ^ ((9519 : ℝ) / 50000))
    intro p hp h
    rcases h with ⟨hprod, hxi, h32, h21, h10, _, _, _, h34⟩
    have hprime (i : Fin 5) : (p i).Prime :=
      Nat.prime_of_mem_primesLE (Fintype.mem_piFinset.mp hp i)
    have hpos (i : Fin 5) : 0 < (p i : ℝ) := Nat.cast_pos.mpr (hprime i).pos
    have h3 : x ^ ((9519 : ℝ) / 50000) ≤ (p 3 : ℝ) :=
      (Real.le_logb_iff_rpow_le hx (hpos 3)).mp hxi
    refine ⟨hprod, ?_⟩
    intro i
    fin_cases i
    · apply (Real.le_logb_iff_rpow_le hx (hpos 0)).mp
      linarith
    · apply (Real.le_logb_iff_rpow_le hx (hpos 1)).mp
      linarith
    · apply (Real.le_logb_iff_rpow_le hx (hpos 2)).mp
      linarith
    · exact h3
    · exact h3.trans h34
  · let C (p : Fin 5 → ℕ) : Prop :=
      (∏ i, p i) = n ∧
        (∀ i, (9519 : ℝ) / 50000 ≤ Real.logb x (p i : ℝ) ∧
          Real.logb x (p i : ℝ) ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
        Real.logb x (p 1 : ℝ) < Real.logb x (p 0 : ℝ) ∧
        Real.logb x (p 1 : ℝ) < Real.logb x (p 2 : ℝ) ∧
        Real.logb x (p 0 : ℝ) + Real.logb x (p 2 : ℝ) < (40481 : ℝ) / 100000 ∧
        (59519 : ℝ) / 100000 < Real.logb x (p 0 : ℝ) +
          Real.logb x (p 1 : ℝ) + Real.logb x (p 3 : ℝ) ∧
        Real.logb x (p 3 : ℝ) ≤ Real.logb x (p 4 : ℝ)
    let S : ℝ := ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
      if C p then 1 else 0
    change (n.Prime → S = 0) ∧
      (S ≠ 0 → n ≠ 0 ∧ ∀ p ∈ n.primeFactors,
        x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ)) ∧ S ≤ 3125
    apply five_prime_indicator_properties n (x ^ ((9519 : ℝ) / 50000)) C
    intro p hp h
    rcases h with ⟨hprod, hlow, _⟩
    refine ⟨hprod, fun i => ?_⟩
    have hpos : 0 < (p i : ℝ) :=
      Nat.cast_pos.mpr
        (Nat.prime_of_mem_primesLE (Fintype.mem_piFinset.mp hp i)).pos
    exact (Real.le_logb_iff_rpow_le hx hpos).mp (hlow i).1

theorem eventually_literal_minorant_pointwise :
    ∀ᶠ x : ℝ in Filter.atTop, ∀ n : ℕ,
      x ≤ (n : ℝ) → (n : ℝ) ≤ 2 * x →
      let rho : ℝ := (if n.Prime then 1 else 0) -
        exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n
      (n.Prime → rho = 1) ∧
        (¬n.Prime → rho ≤ 0) ∧
        (rho ≠ 0 → n ≠ 0 ∧
          ∀ p ∈ n.primeFactors, x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ)) ∧
        |rho| ≤ 6251 := by
  classical
  filter_upwards [eventually_exceptional_large] with x hx
  intro n hlo hhi
  dsimp only
  have h0 := exceptionalPrimeDefect_pointwise_properties hx.1 hx.2 hlo hhi 0
  have h1 := exceptionalPrimeDefect_pointwise_properties hx.1 hx.2 hlo hhi 1
  have hn0 := exceptionalPrimeDefect_nonneg x 0 n
  have hn1 := exceptionalPrimeDefect_nonneg x 1 n
  refine ⟨?_, ?_, ?_, ?_⟩
  · intro hp
    simp [hp, h0.1 hp, h1.1 hp]
  · intro hp
    simp only [hp, ite_false, zero_sub]
    linarith
  · intro hrho
    by_cases hp : n.Prime
    · refine ⟨hp.ne_zero, ?_⟩
      intro p hpm
      have hpn : p = n := by
        simpa only [hp.primeFactors, Finset.mem_singleton] using hpm
      rw [hpn]
      have hpow : x ^ ((9519 : ℝ) / 50000) ≤ x := by
        simpa only [Real.rpow_one] using
          Real.rpow_le_rpow_of_exponent_le hx.1.le
            (by norm_num : (9519 : ℝ) / 50000 ≤ 1)
      exact hpow.trans hlo
    · by_cases hzero : exceptionalPrimeDefect x 0 n = 0
      · have hone : exceptionalPrimeDefect x 1 n ≠ 0 := by
          intro heq
          exact hrho (by simp [hp, hzero, heq])
        exact h1.2.1 hone
      · exact h0.2.1 hzero
  · have hp0 : 0 ≤ (if n.Prime then (1 : ℝ) else 0) := by positivity
    have hp1 : (if n.Prime then (1 : ℝ) else 0) ≤ 1 := ite_le_one le_rfl zero_le_one
    apply abs_le.mpr
    constructor <;> linarith [h0.2.2, h1.2.2]

theorem real_primes_closed_compare (A B : ℝ) (hA : 0 ≤ A) :
    Nat.primesLE (Nat.floor B) \ Nat.primesLE (Nat.floor A) ⊆
      (Finset.Icc (Nat.ceil A) (Nat.floor B)).filter Nat.Prime ∧
    (Finset.Icc (Nat.ceil A) (Nat.floor B)).filter Nat.Prime ⊆
      insert (Nat.floor A) (Nat.primesLE (Nat.floor B) \ Nat.primesLE (Nat.floor A)) := by
  classical
  let S := Nat.primesLE (Nat.floor B) \ Nat.primesLE (Nat.floor A)
  let T := (Finset.Icc (Nat.ceil A) (Nat.floor B)).filter Nat.Prime
  have hST : S ⊆ T := by
    intro p hp
    obtain ⟨hpB, hpA⟩ := Finset.mem_sdiff.mp hp
    obtain ⟨hpB, hp⟩ := Nat.mem_primesLE.mp hpB
    have hAp : Nat.floor A < p :=
      lt_of_not_ge fun h => hpA (Nat.mem_primesLE.mpr ⟨h, hp⟩)
    exact Finset.mem_filter.mpr
      ⟨Finset.mem_Icc.mpr ⟨Nat.ceil_le.mpr ((Nat.floor_lt hA).mp hAp).le, hpB⟩, hp⟩
  have hTS : T ⊆ insert (Nat.floor A) S := by
    intro p hp
    obtain ⟨hpI, hp⟩ := Finset.mem_filter.mp hp
    obtain ⟨hAp, hpB⟩ := Finset.mem_Icc.mp hpI
    by_cases hpA : p ≤ Nat.floor A
    · exact Finset.mem_insert.mpr
        (Or.inl (le_antisymm hpA ((Nat.floor_le_ceil A).trans hAp)))
    · exact Finset.mem_insert.mpr (Or.inr (Finset.mem_sdiff.mpr
        ⟨Nat.mem_primesLE.mpr ⟨hpB, hp⟩,
          fun h => hpA (Nat.mem_primesLE.mp h).1⟩))
  exact ⟨hST, hTS⟩

theorem abs_closed_prime_count_sub_primeCounting_le_one
    (A B : ℝ) (hA : 0 ≤ A) (hAB : A ≤ B) :
    |(((Finset.Icc (Nat.ceil A) (Nat.floor B)).filter Nat.Prime).card : ℝ) -
      ((Nat.primeCounting (Nat.floor B) : ℝ) -
        (Nat.primeCounting (Nat.floor A) : ℝ))| ≤ 1 := by
  classical
  let S := Nat.primesLE (Nat.floor B) \ Nat.primesLE (Nat.floor A)
  let T := (Finset.Icc (Nat.ceil A) (Nat.floor B)).filter Nat.Prime
  have hsub := Nat.primesLE_mono (Nat.floor_mono hAB)
  have hcard : S.card = Nat.primeCounting (Nat.floor B) -
      Nat.primeCounting (Nat.floor A) := by
    simp [S, Finset.card_sdiff_of_subset hsub]
  obtain ⟨hST, hTS⟩ := real_primes_closed_compare A B hA
  have hlo : (S.card : ℝ) ≤ (T.card : ℝ) := by
    exact_mod_cast Finset.card_le_card hST
  have hhi : (T.card : ℝ) ≤ (S.card : ℝ) + 1 := by
    exact_mod_cast (Finset.card_le_card hTS).trans
      (Finset.card_insert_le (Nat.floor A) S)
  have hmono := Nat.monotone_primeCounting (Nat.floor_mono hAB)
  have hcardR : (S.card : ℝ) = (Nat.primeCounting (Nat.floor B) : ℝ) -
      (Nat.primeCounting (Nat.floor A) : ℝ) := by
    rw [hcard, Nat.cast_sub hmono]
  change |(T.card : ℝ) - _| ≤ 1
  rw [← hcardR, abs_of_nonneg (sub_nonneg.mpr hlo)]
  linarith

theorem last_prime_count_uniform_error_of_primeCounting_bound
    (C Y0 : ℝ) (hC : 0 < C)
    (hpi : ∀ y : ℝ, Y0 ≤ y →
      |(Nat.primeCounting (Nat.floor y) : ℝ) - y / Real.log y| ≤
        C * y / (Real.log y) ^ 2) :
    ∃ K X0 : ℝ, 0 < K ∧ 1 < X0 ∧
      ∀ x : ℝ, X0 ≤ x →
      ∀ p ∈ (Nat.primesBelow (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
        (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ)),
      ∀ u v : ℝ, 1 ≤ u → u ≤ v → v ≤ 2 →
      |Real.log x / x *
          (((Finset.Icc (Nat.ceil (u * x / (p : ℝ)))
            (Nat.floor (v * x / (p : ℝ)))).filter Nat.Prime).card : ℝ) -
          (v - u) * ((p : ℝ) * (1 - Real.logb x (p : ℝ)))⁻¹| ≤
        K / ((p : ℝ) * Real.log x) + Real.log x / x := by
  refine ⟨16 * (C + 1), Y0 ^ 2 + 2, by positivity, by nlinarith [sq_nonneg Y0], ?_⟩
  intro x hx p hpband u v hu huv hv
  have hx1 : 1 < x := by nlinarith [sq_nonneg Y0]
  have hx0 : 0 < x := by linarith
  have hYx : Y0 ^ 2 ≤ x := by linarith
  have hpprime := Nat.prime_of_mem_primesBelow (Finset.mem_filter.mp hpband).1
  have hp0 : 0 < (p : ℝ) := by exact_mod_cast hpprime.pos
  have hpa : (p : ℝ) < x ^ ((40481 : ℝ) / 100000) :=
    Nat.lt_ceil.mp (Nat.lt_of_mem_primesBelow (Finset.mem_filter.mp hpband).1)
  have hpsqrt : (p : ℝ) ≤ Real.sqrt x := by
    apply hpa.le.trans
    rw [Real.sqrt_eq_rpow]
    exact Real.rpow_le_rpow_of_exponent_le hx1.le (by norm_num)
  have hscale : 0 ≤ Real.log x / x := div_nonneg (Real.log_pos hx1).le hx0.le
  have hclosed := abs_closed_prime_count_sub_primeCounting_le_one
    (u * x / (p : ℝ)) (v * x / (p : ℝ))
    (by positivity) (by gcongr)
  have hclosed' := mul_le_mul_of_nonneg_left hclosed hscale
  rw [← abs_of_nonneg hscale, ← abs_mul] at hclosed'
  have huError := primeCounting_scaled_endpoint_error C Y0 x p u hC hpi
    hx1 hYx hp0 hpsqrt hu (huv.trans hv)
  have hvError := primeCounting_scaled_endpoint_error C Y0 x p v hC hpi
    hx1 hYx hp0 hpsqrt (hu.trans huv) hv
  let c := ((p : ℝ) * (1 - Real.logb x (p : ℝ)))⁻¹
  let U : ℝ := Nat.primeCounting (Nat.floor (u * x / (p : ℝ)))
  let V : ℝ := Nat.primeCounting (Nat.floor (v * x / (p : ℝ)))
  let N : ℝ := ((Finset.Icc (Nat.ceil (u * x / (p : ℝ)))
    (Nat.floor (v * x / (p : ℝ)))).filter Nat.Prime).card
  let s := Real.log x / x
  change |s * N - (v - u) * c| ≤ _
  have hdiff : |(s * V - v * c) - (s * U - u * c)| ≤
      16 * (C + 1) / ((p : ℝ) * Real.log x) := by
    calc
      _ ≤ |s * V - v * c| + |s * U - u * c| := by
        simpa only [sub_zero, zero_sub, abs_neg] using
          (abs_sub_le (s * V - v * c) 0 (s * U - u * c))
      _ ≤ 8 * (C + 1) / ((p : ℝ) * Real.log x) +
          8 * (C + 1) / ((p : ℝ) * Real.log x) := add_le_add hvError huError
      _ = 16 * (C + 1) / ((p : ℝ) * Real.log x) := by ring
  calc
    _ = |s * (N - (V - U)) + ((s * V - v * c) - (s * U - u * c))| := by
      congr 1
      ring
    _ ≤ |s * (N - (V - U))| + |(s * V - v * c) - (s * U - u * c)| :=
      abs_add_le _ _
    _ ≤ s + 16 * (C + 1) / ((p : ℝ) * Real.log x) :=
      add_le_add (by simpa only [mul_one, abs_of_nonneg hscale] using hclosed') hdiff
    _ = 16 * (C + 1) / ((p : ℝ) * Real.log x) + Real.log x / x := by ring

theorem siftedTheta_semiprime_interval_mass :
    ∀ epsilon : ℝ, 0 < epsilon →
      ∀ᶠ x : ℝ in Filter.atTop,
        ∀ u v : ℝ, 1 ≤ u → u ≤ v → v ≤ 2 →
          |Real.log x / x *
              (∑ n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)),
                if ArithmeticFunction.cardFactors n = 2 then
                  siftedTheta x (1 : Fin 6) (fun _ => 1) n else 0) -
            (v - u) *
              (∫ t in ((9519 : ℝ) / 50000)..((40481 : ℝ) / 100000),
                (t * (1 - t))⁻¹)| ≤ epsilon := by
  classical
  intro epsilon hepsilon
  let I : ℝ := ∫ t in ((9519 : ℝ) / 50000)..((40481 : ℝ) / 100000),
    (t * (1 - t))⁻¹
  let S : ℝ → ℝ := fun x =>
    ∑ p ∈ (Nat.primesBelow (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
      (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ)),
      ((p : ℝ) * (1 - Real.logb x (p : ℝ)))⁻¹
  have hS : Filter.Tendsto S Filter.atTop (nhds I) :=
    semiprime_weighted_prime_kernel_tendsto
  obtain ⟨C, c, hC, hc, N0, hN0, hExp⟩ :=
    exists_abs_chebyshevPsi_sub_natCast_le_exp_neg_sqrtLog
  obtain ⟨hK, hNat⟩ :=
    abs_psi_nat_sub_self_le_mul_div_log_of_exp_bound
      C c N0 hC hc hN0 hExp
  have hReal := abs_psi_sub_self_le_mul_div_log_of_nat_bound
    (2 * C / c ^ 2) N0 hK hN0 hNat
  obtain ⟨Cpi, Y0, hCpi, _, hpi⟩ :=
    exists_primeCounting_real_logSquare_error_of_psi_bound
      (2 * (2 * C / c ^ 2) + 1) (N0 : ℝ)
      (by positivity) (by exact_mod_cast hN0) hReal
  obtain ⟨K, X0, hKpos, hX0, hpoint⟩ :=
    last_prime_count_uniform_error_of_primeCounting_bound Cpi Y0 hCpi hpi
  have hfirst : Filter.Tendsto (fun x : ℝ => K / Real.log x * S x)
      Filter.atTop (nhds 0) := by
    simpa only [zero_mul] using
      (Real.tendsto_log_atTop.const_div_atTop K).mul hS
  have hdev : Filter.Tendsto (fun x : ℝ => |S x - I|) Filter.atTop (nhds 0) := by
    simpa only [sub_self, abs_zero] using (hS.sub_const I).abs
  have herror : Filter.Tendsto
      (fun x : ℝ => K / Real.log x * S x +
        Real.log x / x * (x ^ ((40481 : ℝ) / 100000) + 1) + |S x - I|)
      Filter.atTop (nhds 0) := by
    simpa only [zero_add] using (hfirst.add theta2_endpoint_envelope_tendsto).add hdev
  filter_upwards [Filter.eventually_ge_atTop X0, herror.eventually_lt_const hepsilon]
    with x hxX0 hxerror
  intro u v hu huv hv
  have hx : 1 < x := hX0.trans_le hxX0
  let A : ℝ := Real.log x / x *
    (∑ n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)),
      if ArithmeticFunction.cardFactors n = 2 then
        siftedTheta x (1 : Fin 6) (fun _ => 1) n else 0)
  change |A - (v - u) * I| ≤ epsilon
  have hmain : |A - (v - u) * S x| ≤ K / Real.log x * S x +
      Real.log x / x * (x ^ ((40481 : ℝ) / 100000) + 1) := by
    dsimp only [A]
    rw [theta2_semiprime_interval_eq_prime_counts x u v hx hu huv hv]
    exact theta2_sum_prime_count_error_le x u v K hx hKpos.le
      (fun p hp => hpoint x hxX0 p hp u v hu huv hv)
  have hprod : |(v - u) * (S x - I)| ≤ |S x - I| := by
    rw [abs_mul, abs_of_nonneg (sub_nonneg.mpr huv)]
    exact mul_le_of_le_one_left (abs_nonneg _) (by linarith : v - u ≤ 1)
  calc
    |A - (v - u) * I| = |(A - (v - u) * S x) + (v - u) * (S x - I)| := by
      congr 1
      ring
    _ ≤ |A - (v - u) * S x| + |(v - u) * (S x - I)| := abs_add_le _ _
    _ ≤ K / Real.log x * S x +
        Real.log x / x * (x ^ ((40481 : ℝ) / 100000) + 1) + |S x - I| :=
      add_le_add hmain hprod
    _ ≤ epsilon := hxerror.le

theorem three_prime_bulk_pair_error
    (C Y0 b x p q u v : ℝ) (hC : 0 < C)
    (hpi : ∀ y : ℝ, Y0 ≤ y →
      |(Nat.primeCounting (Nat.floor y) : ℝ) - y / Real.log y| ≤
        C * y / (Real.log y) ^ 2)
    (hb : 0 < b) (hx : 1 < x) (hp : 0 < p) (hX : 1 < x / p)
    (hYx : Y0 ^ 2 ≤ x / p) (hq : 0 < q) (hqsqrt : q ≤ Real.sqrt (x / p))
    (hlog : b * Real.log x ≤ Real.log (x / p))
    (hu : 1 ≤ u) (huv : u ≤ v) (hv : v ≤ 2) :
    |Real.log x / x *
        (((Finset.Icc (Nat.ceil (u * x / (p * q)))
          (Nat.floor (v * x / (p * q)))).filter Nat.Prime).card : ℝ) -
        (v - u) * (p * q * (1 - Real.logb x p - Real.logb x q))⁻¹| ≤
      16 * (C + 1) / (b ^ 2 * p * q * Real.log x) + Real.log x / x := by
  let X := x / p
  let L := Real.log x
  let D := Real.log X
  let s := L / (p * D)
  let c := (q * (1 - Real.logb X q))⁻¹
  let U : ℝ := Nat.primeCounting (Nat.floor (u * X / q))
  let V : ℝ := Nat.primeCounting (Nat.floor (v * X / q))
  let N : ℝ := ((Finset.Icc (Nat.ceil (u * X / q))
    (Nat.floor (v * X / q))).filter Nat.Prime).card
  have hx0 : 0 < x := by linarith
  have hX0 : 0 < X := by dsimp [X]; positivity
  have hL : 0 < L := Real.log_pos hx
  have hD : 0 < D := Real.log_pos hX
  have hs : 0 ≤ s := by dsimp [s]; positivity
  have hscale : 0 ≤ D / X := by positivity
  have hclosed := abs_closed_prime_count_sub_primeCounting_le_one
    (u * X / q) (v * X / q) (by positivity) (by gcongr)
  have hclosed' : |D / X * (N - (V - U))| ≤ D / X := by
    rw [abs_mul, abs_of_nonneg hscale]
    exact (mul_le_mul_of_nonneg_left hclosed hscale).trans_eq (mul_one _)
  have eu := primeCounting_scaled_endpoint_error C Y0 X q u hC hpi
    hX hYx hq hqsqrt hu (huv.trans hv)
  have ev := primeCounting_scaled_endpoint_error C Y0 X q v hC hpi
    hX hYx hq hqsqrt (hu.trans huv) hv
  have ediff : |(D / X * V - v * c) - (D / X * U - u * c)| ≤
      16 * (C + 1) / (q * D) := by
    calc
      _ ≤ |D / X * V - v * c| + |D / X * U - u * c| := abs_sub _ _
      _ ≤ 8 * (C + 1) / (q * D) + 8 * (C + 1) / (q * D) :=
        add_le_add ev eu
      _ = _ := by ring
  have ebase : |D / X * N - (v - u) * c| ≤
      16 * (C + 1) / (q * D) + D / X := by
    calc
      _ = |D / X * (N - (V - U)) +
          ((D / X * V - v * c) - (D / X * U - u * c))| := by
        congr 1
        ring
      _ ≤ |D / X * (N - (V - U))| +
          |(D / X * V - v * c) - (D / X * U - u * c)| := abs_add_le _ _
      _ ≤ D / X + 16 * (C + 1) / (q * D) := add_le_add hclosed' ediff
      _ = _ := by ring
  have hDX : D = L - Real.log p := Real.log_div hx0.ne' hp.ne'
  have hlogq : Real.log q ≤ D / 2 := by
    have h := Real.log_le_log hq hqsqrt
    rw [Real.log_sqrt hX0.le] at h
    exact h
  have hDq : 0 < D - Real.log q := by linarith
  have hsmall : 1 - Real.logb X q = (D - Real.log q) / D :=
    one_sub_div hD.ne'
  have hlarge : 1 - Real.logb x p - Real.logb x q =
      (D - Real.log q) / L := by
    change 1 - Real.log p / L - Real.log q / L = _
    rw [hDX]
    field_simp
  have hmul : s * (D / X) = L / x := by
    dsimp [s, X]
    field_simp
  have hkernel : s * ((v - u) * c) =
      (v - u) * (p * q * (1 - Real.logb x p - Real.logb x q))⁻¹ := by
    dsimp [s, c]
    rw [hsmall, hlarge]
    field_simp
  have harg (w : ℝ) : w * X / q = w * x / (p * q) := by
    dsimp [X]
    field_simp
  have hsq : (b * L) ^ 2 ≤ D ^ 2 := pow_le_pow_left₀ (by positivity) hlog 2
  have ebound : s * (16 * (C + 1) / (q * D)) ≤
      16 * (C + 1) / (b ^ 2 * p * q * L) := by
    calc
      _ = 16 * (C + 1) * L / (p * q * D ^ 2) := by dsimp [s]; ring
      _ ≤ 16 * (C + 1) * L / (p * q * (b * L) ^ 2) := by
        apply div_le_div_of_nonneg_left (by positivity) (by positivity)
        exact mul_le_mul_of_nonneg_left hsq (by positivity)
      _ = _ := by field_simp
  have escaled : |s * (D / X * N - (v - u) * c)| ≤
      s * (16 * (C + 1) / (q * D) + D / X) := by
    rw [abs_mul, abs_of_nonneg hs]
    exact mul_le_mul_of_nonneg_left ebase hs
  have e : |L / x * N -
      (v - u) * (p * q * (1 - Real.logb x p - Real.logb x q))⁻¹| ≤
      16 * (C + 1) / (b ^ 2 * p * q * L) + L / x := by
    calc
      _ = |s * (D / X * N - (v - u) * c)| := by
        rw [← hkernel, ← hmul]
        congr 1
        ring
      _ ≤ s * (16 * (C + 1) / (q * D) + D / X) := escaled
      _ = s * (16 * (C + 1) / (q * D)) + L / x := by rw [mul_add, hmul]
      _ ≤ _ := add_le_add ebound le_rfl
  simpa only [N, L, harg] using e

theorem exists_count_prefix_error :
    ∃ C Y : ℝ, 0 < C ∧ 2 ≤ Y ∧
      ∀ y : ℝ, Y ≤ y →
        |(Nat.primeCounting (Nat.floor y) : ℝ) - y / Real.log y| ≤
          C * y / (Real.log y) ^ 2 := by
  obtain ⟨C, c, hC, hc, N0, hN0, hExp⟩ :=
    exists_abs_chebyshevPsi_sub_natCast_le_exp_neg_sqrtLog
  obtain ⟨hK, hNat⟩ :=
    abs_psi_nat_sub_self_le_mul_div_log_of_exp_bound
      C c N0 hC hc hN0 hExp
  have hReal := abs_psi_sub_self_le_mul_div_log_of_nat_bound
    (2 * C / c ^ 2) N0 hK hN0 hNat
  exact exists_primeCounting_real_logSquare_error_of_psi_bound
    (2 * (2 * C / c ^ 2) + 1) (N0 : ℝ)
    (by positivity) (by exact_mod_cast hN0) hReal

theorem scaled_prefix_error_margin (C Y x eta p w : ℝ) (hC : 0 < C)
    (hpi : ∀ y : ℝ, Y ≤ y → |(Nat.primeCounting (Nat.floor y) : ℝ) - y / Real.log y|
      ≤ C * y / (Real.log y) ^ 2)
    (heta : 0 < eta) (hx : 1 < x) (hY : Y ≤ x ^ eta)
    (hp : 0 < p) (hpX : p ≤ x ^ (1 - eta)) (hw : 1 ≤ w) (hw' : w ≤ 2) :
    |Real.log x / x * (Nat.primeCounting (Nat.floor (w * x / p)) : ℝ) -
       w * (p * (1 - Real.logb x p))⁻¹| ≤
        2 * (C + 1) / (p * eta ^ 2 * Real.log x) := by
  let L : ℝ := Real.log x
  let D : ℝ := L - Real.log p
  let t : ℝ := w * x / p
  have hx0 : 0 < x := by linarith
  have hw0 : 0 < w := by linarith
  have hL : 0 < L := Real.log_pos hx
  have hDlo : eta * L ≤ D := by
    have h := Real.log_le_log hp hpX
    rw [Real.log_rpow hx0] at h
    dsimp [L, D]
    linarith
  have hD : 0 < D := (mul_pos heta hL).trans_le hDlo
  have htY : Y ≤ t := by
    apply (le_div_iff₀ hp).2
    have heq : x ^ eta * x ^ (1 - eta) = x := by
      rw [← Real.rpow_add hx0]
      simp
    have hprod : Y * p ≤ x := by
      calc
        _ ≤ x ^ eta * x ^ (1 - eta) := mul_le_mul hY hpX hp.le (by positivity)
        _ = x := heq
    exact hprod.trans (by nlinarith)
  have hwlog0 : 0 ≤ Real.log w := Real.log_nonneg hw
  have hwlog1 : Real.log w ≤ 1 := by
    have h := Real.log_le_sub_one_of_pos hw0
    linarith
  have htlogeq : Real.log t = D + Real.log w := by
    dsimp [t, D, L]
    rw [Real.log_div (mul_pos hw0 hx0).ne' hp.ne', Real.log_mul hw0.ne' hx0.ne']
    ring
  have htloglo : eta * L ≤ Real.log t := by rw [htlogeq]; linarith
  have htlog : 0 < Real.log t := lt_of_lt_of_le (mul_pos heta hL) htloglo
  have hsquare : (eta * L) ^ 2 ≤ (Real.log t) ^ 2 := by
    nlinarith [mul_self_le_mul_self (le_of_lt (mul_pos heta hL)) htloglo]
  have hprod : (eta * L) ^ 2 ≤ Real.log t * D := by
    nlinarith [mul_le_mul htloglo hDlo (le_of_lt (mul_pos heta hL)) (le_of_lt htlog)]
  have hscale0 : 0 ≤ L / x := by positivity
  have hpi' := mul_le_mul_of_nonneg_left (hpi t htY) hscale0
  have hcount :
      |L / x * (Nat.primeCounting (Nat.floor t) : ℝ) - L / x * (t / Real.log t)| ≤
        2 * C / (p * eta ^ 2 * L) := by
    calc
      _ = (L / x) * |(Nat.primeCounting (Nat.floor t) : ℝ) - t / Real.log t| := by
        rw [← mul_sub, abs_mul, abs_of_nonneg hscale0]
      _ ≤ (L / x) * (C * t / (Real.log t) ^ 2) := hpi'
      _ = C * w * L / (p * (Real.log t) ^ 2) := by
        dsimp [t]
        field_simp
      _ ≤ C * 2 * L / (p * (eta * L) ^ 2) := by
        apply div_le_div₀ (by positivity)
        · gcongr
        · positivity
        · exact mul_le_mul_of_nonneg_left hsquare hp.le
      _ = 2 * C / (p * eta ^ 2 * L) := by field_simp
  have hd : 1 - Real.logb x p = D / L := by
    change 1 - Real.log p / L = (L - Real.log p) / L
    field_simp
  have hmain : w * (p * (1 - Real.logb x p))⁻¹ = w * L / (p * D) := by
    rw [hd]
    field_simp
  have hshift :
      |L / x * (t / Real.log t) - w * (p * (1 - Real.logb x p))⁻¹| ≤
        2 / (p * eta ^ 2 * L) := by
    have hdiff : w * L / (p * D) - L / x * (t / Real.log t) =
        w * L * Real.log w / (p * (Real.log t * D)) := by
      rw [htlogeq]
      dsimp [t]
      have htlogD : 0 < D + Real.log w := by linarith
      field_simp [hp.ne', hD.ne', htlogD.ne', hx0.ne']
      dsimp only [D]
      ring
    rw [hmain, abs_sub_comm, hdiff, abs_of_nonneg (by positivity)]
    calc
      _ ≤ 2 * L / (p * (eta * L) ^ 2) := by
        apply div_le_div₀ (by positivity)
        · calc
            w * L * Real.log w ≤ 2 * L * 1 := by gcongr
            _ = 2 * L := by ring
        · positivity
        · exact mul_le_mul_of_nonneg_left hprod hp.le
      _ = 2 / (p * eta ^ 2 * L) := by field_simp
  calc
    _ ≤ |L / x * (Nat.primeCounting (Nat.floor t) : ℝ) -
          L / x * (t / Real.log t)| +
        |L / x * (t / Real.log t) - w * (p * (1 - Real.logb x p))⁻¹| := abs_sub_le _ _ _
    _ ≤ 2 * C / (p * eta ^ 2 * L) + 2 / (p * eta ^ 2 * L) := add_le_add hcount hshift
    _ = _ := by ring

theorem exists_closed_final_prime_uniform :
    ∃ K Y : ℝ, 0 < K ∧ 2 ≤ Y ∧
      ∀ eta x p u v : ℝ, 0 < eta → 1 < x → Y ≤ x ^ eta →
        0 < p → p ≤ x ^ (1 - eta) → 1 ≤ u → u ≤ v → v ≤ 2 →
        |Real.log x / x *
            (((Finset.Icc (Nat.ceil (u * x / p)) (Nat.floor (v * x / p))).filter
              Nat.Prime).card : ℝ) -
            (v - u) * (p * (1 - Real.logb x p))⁻¹| ≤
          K / (p * eta ^ 2 * Real.log x) + Real.log x / x := by
  obtain ⟨C, Y, hC, hY, hpi⟩ := exists_count_prefix_error
  refine ⟨4 * (C + 1), Y, by positivity, hY, ?_⟩
  intro eta x p u v heta hx hYx hp hpx hu huv hv
  have hx0 : 0 < x := by linarith
  have hu0 : 0 < u := by linarith
  have huv' : u * x / p ≤ v * x / p := by gcongr
  have hclosed := abs_closed_prime_count_sub_primeCounting_le_one (u * x / p) (v * x / p)
    (by positivity) huv'
  have hlx : 0 < Real.log x := Real.log_pos hx
  have hL : 0 < Real.log x / x := by positivity
  have hd :
      |(Real.log x / x *
          (((Finset.Icc (Nat.ceil (u * x / p)) (Nat.floor (v * x / p))).filter
              Nat.Prime).card : ℝ) -
        Real.log x / x * ((Nat.primeCounting (Nat.floor (v * x / p)) : ℝ) -
          (Nat.primeCounting (Nat.floor (u * x / p)) : ℝ)))| ≤ Real.log x / x := by
    calc
      _ = (Real.log x / x) *
        |((((Finset.Icc (Nat.ceil (u * x / p)) (Nat.floor (v * x / p))).filter
              Nat.Prime).card : ℝ) -
         ((Nat.primeCounting (Nat.floor (v * x / p)) : ℝ) -
            (Nat.primeCounting (Nat.floor (u * x / p)) : ℝ)))| := by
              rw [← mul_sub, abs_mul, abs_of_pos hL]
      _ ≤ (Real.log x / x) * 1 := mul_le_mul_of_nonneg_left hclosed hL.le
      _ = _ := by ring
  have hv' := scaled_prefix_error_margin C Y x eta p v hC hpi heta hx hYx hp hpx
    (by linarith) hv
  have hu' := scaled_prefix_error_margin C Y x eta p u hC hpi heta hx hYx hp hpx
    hu (huv.trans hv)
  have ht :
      |Real.log x / x *
            ((Nat.primeCounting (Nat.floor (v * x / p)) : ℝ) -
              (Nat.primeCounting (Nat.floor (u * x / p)) : ℝ)) -
         (v - u) * (p * (1 - Real.logb x p))⁻¹| ≤
            4 * (C + 1) / (p * eta ^ 2 * Real.log x) := by
    calc
      _ = |(Real.log x / x * (Nat.primeCounting (Nat.floor (v * x / p)) : ℝ) -
           v * (p * (1 - Real.logb x p))⁻¹) -
          (Real.log x / x * (Nat.primeCounting (Nat.floor (u * x / p)) : ℝ) -
           u * (p * (1 - Real.logb x p))⁻¹)| := by congr 1; ring
      _ ≤ _ := by
        calc
          _ ≤ _ := abs_sub _ _
          _ ≤ 2 * (C + 1) / (p * eta ^ 2 * Real.log x) +
            2 * (C + 1) / (p * eta ^ 2 * Real.log x) := add_le_add hv' hu'
          _ = _ := by ring
  calc
    _ = |(Real.log x / x *
          (((Finset.Icc (Nat.ceil (u * x / p)) (Nat.floor (v * x / p))).filter
              Nat.Prime).card : ℝ) -
          Real.log x / x * ((Nat.primeCounting (Nat.floor (v * x / p)) : ℝ) -
            (Nat.primeCounting (Nat.floor (u * x / p)) : ℝ))) +
        (Real.log x / x * ((Nat.primeCounting (Nat.floor (v * x / p)) : ℝ) -
            (Nat.primeCounting (Nat.floor (u * x / p)) : ℝ)) -
            (v - u) * (p * (1 - Real.logb x p))⁻¹)| := by congr 1; ring
    _ ≤ _ := (abs_add_le _ _).trans ((add_le_add hd ht).trans (le_of_eq (add_comm _ _)))

theorem abs_closed_recip_sub_prefix (A B : ℝ) (ha : 0 < A) (hab : A ≤ B) :
    |(∑ p ∈ (Finset.Icc (Nat.ceil A) (Nat.floor B)).filter Nat.Prime, (p : ℝ)⁻¹) -
      ((∑ p ∈ Nat.primesLE (Nat.floor B), (p : ℝ)⁻¹) -
        (∑ p ∈ Nat.primesLE (Nat.floor A), (p : ℝ)⁻¹))| ≤ A⁻¹ := by
  classical
  let S := Nat.primesLE (Nat.floor B) \ Nat.primesLE (Nat.floor A)
  let T := (Finset.Icc (Nat.ceil A) (Nat.floor B)).filter Nat.Prime
  let f : ℕ → ℝ := fun p => (p : ℝ)⁻¹
  have hf (k : ℕ) : 0 ≤ f k := inv_nonneg.mpr (Nat.cast_nonneg _)
  have hmono := Nat.primesLE_mono (Nat.floor_mono hab)
  have hsum : (∑ p ∈ S, f p) = (∑ p ∈ Nat.primesLE (Nat.floor B), (p : ℝ)⁻¹) -
      (∑ p ∈ Nat.primesLE (Nat.floor A), (p : ℝ)⁻¹) := Finset.sum_sdiff_eq_sub hmono
  obtain ⟨hST, hTS⟩ := real_primes_closed_compare A B ha.le
  have hdiffsub : T \ S ⊆ {Nat.floor A} := by
    intro p hp
    obtain ⟨ht, hnot⟩ := Finset.mem_sdiff.mp hp
    cases Finset.mem_insert.mp (hTS ht) with
    | inl h => simpa only [Finset.mem_singleton] using h
    | inr h => exact (hnot h).elim
  have hcard : (T \ S).card ≤ 1 := by
    simpa using Finset.card_le_card hdiffsub
  have hdiff : (∑ p ∈ T \ S, f p) ≤ A⁻¹ := by
    have hpoint (p : ℕ) (hp : p ∈ T \ S) : f p ≤ A⁻¹ := by
      have hA : A ≤ (p : ℝ) := Nat.ceil_le.mp
        (Finset.mem_Icc.mp ((Finset.mem_filter.mp (Finset.mem_sdiff.mp hp).1).1)).1
      exact inv_anti₀ ha hA
    have hb := Finset.sum_le_card_nsmul (T \ S) f (A⁻¹) hpoint
    calc
      _ ≤ (T \ S).card • A⁻¹ := hb
      _ ≤ _ := by simpa only [one_nsmul] using nsmul_le_nsmul_left (inv_nonneg.mpr ha.le) hcard
  change |(∑ p ∈ T, f p) - _| ≤ _
  rw [← hsum, ← Finset.sum_sdiff hST]
  rw [add_sub_cancel_right]
  rw [abs_of_nonneg (Finset.sum_nonneg (fun p _ => hf p))]
  exact hdiff

theorem exists_recip_band_error :
    ∃ D : ℝ, 0 < D ∧
      ∀ x : ℝ, 1 < x → 2 ≤ x ^ ((9519 : ℝ) / 50000) →
        ∀ a b : ℝ, 9519 / 50000 ≤ a → a ≤ b → b ≤ 6 / 25 →
          |(∑ p ∈ (Finset.Icc (Nat.ceil (x ^ a)) (Nat.floor (x ^ b))).filter Nat.Prime,
              (p : ℝ)⁻¹) - Real.log (b / a)| ≤
           2 * D / (((9519 : ℝ) / 50000) * Real.log x) + (x ^ ((9519 : ℝ) / 50000))⁻¹ := by
  obtain ⟨D, M, hD, hbound⟩ := exists_real_reciprocal_prefix
  refine ⟨D, hD, ?_⟩
  intro x hx hax a b ha hab hb
  have hx0 : 0 < x := by linarith
  have hL := Real.log_pos hx
  have hxi : 0 < (9519 : ℝ) / 50000 := by norm_num
  have ha0 : 0 < a := hxi.trans_le ha
  have hb0 : 0 < b := ha0.trans_le hab
  have hA : 2 ≤ x ^ a := hax.trans (Real.rpow_le_rpow_of_exponent_le hx.le ha)
  have hB : 2 ≤ x ^ b := hA.trans (Real.rpow_le_rpow_of_exponent_le hx.le hab)
  have hlogA : Real.log (x ^ a) = a * Real.log x := Real.log_rpow hx0 a
  have hlogB : Real.log (x ^ b) = b * Real.log x := Real.log_rpow hx0 b
  have hmain : Real.log (Real.log (x ^ b)) - Real.log (Real.log (x ^ a)) = Real.log (b / a) := by
    rw [hlogA, hlogB]
    rw [Real.log_mul hb0.ne' hL.ne', Real.log_mul ha0.ne' hL.ne', Real.log_div hb0.ne' ha0.ne']
    ring
  have hpreA := hbound (x ^ a) hA
  have hpreB := hbound (x ^ b) hB
  have hpre :
      |((∑ p ∈ Nat.primesLE (Nat.floor (x ^ b)), (p : ℝ)⁻¹) -
          (∑ p ∈ Nat.primesLE (Nat.floor (x ^ a)), (p : ℝ)⁻¹)) - Real.log (b / a)| ≤
        2 * D / (((9519 : ℝ) / 50000) * Real.log x) := by
    have hle (c : ℝ) (hc : 9519 / 50000 ≤ c) :
        D / Real.log (x ^ c) ≤ D / (((9519 : ℝ) / 50000) * Real.log x) := by
      rw [Real.log_rpow hx0]
      apply div_le_div_of_nonneg_left hD.le (mul_pos hxi hL)
      gcongr
    calc
      _ = |((∑ p ∈ Nat.primesLE (Nat.floor (x ^ b)), (p : ℝ)⁻¹) - Real.log (Real.log (x ^ b)) - M) -
          ((∑ p ∈ Nat.primesLE (Nat.floor (x ^ a)), (p : ℝ)⁻¹) -
            Real.log (Real.log (x ^ a)) - M)| := by
              rw [← hmain]; congr 1; ring
      _ ≤ _ := by
        calc
          _ ≤ _ := abs_sub _ _
          _ ≤ D / Real.log (x ^ b) + D / Real.log (x ^ a) := add_le_add hpreB hpreA
          _ ≤ D / (((9519 : ℝ) / 50000) * Real.log x) + D / (((9519 : ℝ) / 50000) * Real.log x) :=
            add_le_add (hle _ (ha.trans hab)) (hle _ ha)
          _ = _ := by ring
  calc
    _ ≤ |(∑ p ∈ (Finset.Icc (Nat.ceil (x ^ a)) (Nat.floor (x ^ b))).filter Nat.Prime, (p : ℝ)⁻¹) -
      ((∑ p ∈ Nat.primesLE (Nat.floor (x ^ b)), (p : ℝ)⁻¹) -
        (∑ p ∈ Nat.primesLE (Nat.floor (x ^ a)), (p : ℝ)⁻¹))| +
      |((∑ p ∈ Nat.primesLE (Nat.floor (x ^ b)), (p : ℝ)⁻¹) -
        (∑ p ∈ Nat.primesLE (Nat.floor (x ^ a)), (p : ℝ)⁻¹)) - Real.log (b / a)| := abs_sub_le _ _ _
    _ ≤ _ := by
      have hcls := abs_closed_recip_sub_prefix (x ^ a) (x ^ b)
        (Real.rpow_pos_of_pos hx0 _) (Real.rpow_le_rpow_of_exponent_le hx.le hab)
      have hxil := (Real.rpow_le_rpow_of_exponent_le hx.le ha)
      have hins : (x ^ a)⁻¹ ≤ (x ^ ((9519 : ℝ) / 50000))⁻¹ :=
        inv_anti₀ (by positivity) hxil
      linarith

theorem reciprocal_band_tendsto {a b : ℝ}
    (ha : (9519 : ℝ) / 50000 ≤ a) (hab : a ≤ b) (hb : b ≤ 6 / 25) :
    Tendsto (fun x : ℝ =>
      ∑ p ∈ (Finset.Icc (Nat.ceil (x ^ a)) (Nat.floor (x ^ b))).filter Nat.Prime, (p : ℝ)⁻¹)
      atTop (nhds (Real.log (b / a))) := by
  obtain ⟨D, hD, hbnd⟩ := exists_recip_band_error
  have he : Tendsto (fun x : ℝ => (2 * D / ((9519 : ℝ) / 50000) / Real.log x) +
      (x ^ ((9519 : ℝ) / 50000))⁻¹) atTop (nhds 0) := by
    simpa only [zero_add, Pi.inv_apply] using
      (Real.tendsto_log_atTop.const_div_atTop (2 * D / ((9519 : ℝ) / 50000))).add
        ((tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 9519 / 50000)).inv_tendsto_atTop)
  apply tendsto_iff_dist_tendsto_zero.mpr
  refine squeeze_zero' (Filter.Eventually.of_forall fun _ => dist_nonneg) ?_ he
  filter_upwards [Filter.eventually_gt_atTop (1 : ℝ),
    (tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 9519 / 50000)).eventually_ge_atTop 2]
    with x hx hscale
  simpa only [Real.dist_eq, div_div] using hbnd x hx hscale a b ha hab hb

theorem reciprocal_four_box_tendsto (a b : Fin 4 → ℝ)
    (ha : ∀ i, 9519 / 50000 ≤ a i) (hab : ∀ i, a i ≤ b i) (hb : ∀ i, b i ≤ 6 / 25) :
    Tendsto (fun x : ℝ =>
      ∑ p ∈ Fintype.piFinset (fun i : Fin 4 =>
        (Finset.Icc (Nat.ceil (x ^ (a i))) (Nat.floor (x ^ (b i)))).filter Nat.Prime),
            ∏ i, (p i : ℝ)⁻¹) atTop (nhds (∏ i, Real.log (b i / a i))) := by
  have hprod := tendsto_finsetProd (Finset.univ : Finset (Fin 4))
    (fun i _ => reciprocal_band_tendsto (ha i) (hab i) (hb i))
  simpa only [Finset.prod_univ_sum] using hprod

theorem five_prime_error_envelope (K : ℝ) :
    Tendsto (fun x : ℝ =>
      K / (Real.log x) *
        (∑ p ∈ (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
            (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime, (p : ℝ)⁻¹) ^ 4 +
      Real.log x / x * (Nat.floor (x ^ ((6 : ℝ) / 25)) : ℝ) ^ 4)
    atTop (nhds 0) := by
  have hH := reciprocal_band_tendsto (b := (6 : ℝ) / 25) (a := (9519 : ℝ) / 50000)
        (by norm_num) (by norm_num) (by norm_num)
  have hH4 := hH.pow 4
  have hsmall : Tendsto (fun x : ℝ => K / Real.log x) atTop (nhds 0) :=
    Real.tendsto_log_atTop.const_div_atTop K
  have hfirst := hsmall.mul hH4
  have hsecond : Tendsto
      (fun x : ℝ => Real.log x / x * (Nat.floor (x ^ ((6 : ℝ) / 25)) : ℝ) ^ 4)
      atTop (nhds 0) := by
    have hmaj := (isLittleO_log_rpow_atTop
      (by norm_num : (0 : ℝ) < 1-4 * ((6 : ℝ) / 25))).tendsto_div_nhds_zero
    apply squeeze_zero' ?_ ?_ hmaj
    · filter_upwards [Filter.eventually_ge_atTop (1 : ℝ)] with x hx
      exact mul_nonneg (div_nonneg (Real.log_nonneg hx) (le_trans (by norm_num) hx))
        (pow_nonneg (Nat.cast_nonneg _) _)
    · filter_upwards [Filter.eventually_gt_atTop (1 : ℝ)] with x hx
      have hlog := Real.log_pos hx
      have hfl : ((Nat.floor (x ^ ((6 : ℝ) / 25)) : ℕ) : ℝ) ≤ x ^ ((6 : ℝ) / 25) :=
        Nat.floor_le (by positivity)
      have hx0 : 0 < x := by linarith
      have hpows : (x ^ ((6 : ℝ) / 25)) ^ 4 * (x ^ (1-4 * ((6 : ℝ) / 25))) = x := by
        rw [← Real.rpow_mul_natCast hx0.le, ← Real.rpow_add hx0]
        norm_num
      calc
        _ ≤ Real.log x / x * (x ^ ((6 : ℝ) / 25)) ^ 4 := by
          gcongr
        _ = Real.log x / (x ^ (1-4 * ((6 : ℝ) / 25))) := by
          have hne : (x ^ (1-4 * ((6 : ℝ) / 25))) ≠ 0 := (Real.rpow_pos_of_pos hx0 _).ne'
          rw [eq_div_iff hne]
          field_simp [hx0.ne']
          nlinarith [hpows]
  simpa only [zero_mul, zero_add] using hfirst.add hsecond

section
open Real Finset

theorem three_prime_inner_density_integrable {t : ℝ}
    (ht : t ∈ Set.Icc ((9519 : ℝ) / 50000) ((40481 : ℝ) / 100000)) :
    IntervalIntegrable (fun s : ℝ => (t * s * (1 - t - s))⁻¹) volume
      ((9519 : ℝ) / 50000) ((1 - t) / 2) := by
  apply ContinuousOn.intervalIntegrable
  apply ContinuousOn.inv₀ (by fun_prop)
  intro s hs
  rw [Set.uIcc_of_le (by linarith [ht.2] : (9519 : ℝ) / 50000 ≤ (1 - t) / 2)] at hs
  apply mul_ne_zero
  · apply mul_ne_zero <;> linarith [ht.1, hs.1]
  · linarith [ht.2, hs.2]

theorem three_prime_outer_density_integrable :
    IntervalIntegrable
      (fun t : ℝ => ∫ s in ((9519 : ℝ) / 50000)..((1 - t) / 2),
        (t * s * (1 - t - s))⁻¹) volume
      ((9519 : ℝ) / 50000) ((40481 : ℝ) / 100000) := by
  have hcont := HasDerivAt.continuousOn three_prime_coefficient_regular.1
  apply ContinuousOn.intervalIntegrable_of_Icc (by norm_num)
  apply (hcont.div continuousOn_id (fun t ht => by
    change t ≠ 0
    linarith [ht.1])).congr
  intro t ht
  simpa only [Pi.div_apply, id_eq, div_div, mul_comm] using
    three_prime_inner_density_integral ht

end

theorem prime_reciprocal_sqrt_strip_le :
    ∃ C : ℝ, 0 < C ∧ ∀ X : ℝ, 4 ≤ X →
      (∑ q ∈ (Nat.primesLE (Nat.floor (Real.sqrt (2 * X)))).filter
          (fun q : ℕ => Real.sqrt X < (q : ℝ)), (q : ℝ)⁻¹) ≤
        (1 + 4 * C) / Real.log X := by
  classical
  obtain ⟨C, hC, herror⟩ := prime_second_error_bounded
  refine ⟨C, hC, fun X hX => ?_⟩
  have hX0 : 0 < X := by linarith
  have hL : 0 < Real.log X := Real.log_pos (by linarith)
  have hA : 2 ≤ Real.sqrt X := Real.le_sqrt_of_sq_le (by nlinarith)
  have hAB : Real.sqrt X ≤ Real.sqrt (2 * X) := Real.sqrt_le_sqrt (by linarith)
  have hB : 2 ≤ Real.sqrt (2 * X) := hA.trans hAB
  have hLA : 0 < Real.log (Real.sqrt X) := Real.log_pos (by linarith)
  have hLB : 0 < Real.log (Real.sqrt (2 * X)) := Real.log_pos (by linarith)
  have hlogs : Real.log (Real.sqrt X) ≤ Real.log (Real.sqrt (2 * X)) :=
    Real.log_le_log (by linarith) hAB
  have hAbel := prime_band_abel_identity
    (Real.sqrt X) (Real.sqrt (2 * X)) hA hAB (fun _ => 1) (fun _ => 0)
    (fun t _ => hasDerivAt_const t 1) continuousOn_const
  simp only [one_div, mul_inv, ← div_eq_mul_inv, one_mul, zero_mul,
    intervalIntegral.integral_zero, sub_zero, integral_inv_div_log
      (one_lt_two.trans_le hA) (one_lt_two.trans_le hB)] at hAbel
  have hmain :
      Real.log (Real.log (Real.sqrt (2 * X))) -
          Real.log (Real.log (Real.sqrt X)) ≤ 1 / Real.log X := by
    rw [← Real.log_div hLB.ne' hLA.ne']
    calc
      Real.log (Real.log (Real.sqrt (2 * X)) / Real.log (Real.sqrt X)) ≤
          Real.log (Real.sqrt (2 * X)) / Real.log (Real.sqrt X) - 1 :=
        Real.log_le_sub_one_of_pos (div_pos hLB hLA)
      _ = Real.log 2 / Real.log X := by
        rw [Real.log_sqrt (by positivity), Real.log_sqrt hX0.le,
          Real.log_mul (by norm_num) hX0.ne']
        field_simp
        ring
      _ ≤ 1 / Real.log X := by
        apply div_le_div_of_nonneg_right _ hL.le
        have htwo := Real.log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2)
        linarith
  have herrA : |primeSecondError (Real.sqrt X)| ≤ 2 * C / Real.log X := by
    calc
      _ ≤ C / Real.log (Real.sqrt X) := herror _ hA
      _ = 2 * C / Real.log X := by rw [Real.log_sqrt hX0.le]; ring
  have herrB : |primeSecondError (Real.sqrt (2 * X))| ≤ 2 * C / Real.log X := by
    calc
      _ ≤ C / Real.log (Real.sqrt (2 * X)) := herror _ hB
      _ ≤ C / Real.log (Real.sqrt X) := div_le_div_of_nonneg_left hC.le hLA hlogs
      _ = 2 * C / Real.log X := by rw [Real.log_sqrt hX0.le]; ring
  have ha := (abs_le.mp herrA).1
  have hb := (abs_le.mp herrB).2
  have hcombine : 1 / Real.log X + 2 * C / Real.log X + 2 * C / Real.log X =
      (1 + 4 * C) / Real.log X := by ring
  linarith

theorem primeCounting_sqrt_strip_le :
    ∃ C : ℝ, 0 < C ∧ ∀ᶠ X : ℝ in Filter.atTop,
      Real.log X / X *
          (∑ q ∈ (Nat.primesLE (Nat.floor (Real.sqrt (2 * X)))).filter
              (fun q : ℕ => Real.sqrt X < (q : ℝ)),
            (Nat.primeCounting (Nat.floor (2 * X / (q : ℝ))) : ℝ)) ≤
        C / Real.log X := by
  classical
  obtain ⟨CM, hCM, hMertens⟩ := prime_reciprocal_sqrt_strip_le
  obtain ⟨Y, hCheb⟩ := Filter.eventually_atTop.mp
    (Chebyshev.eventually_primeCounting_le (ε := (1 : ℝ)) (by norm_num))
  have hK : 0 < Real.log 4 + 1 :=
    add_pos (Real.log_pos (by norm_num)) zero_lt_one
  refine ⟨4 * (Real.log 4 + 1) * (1 + 4 * CM), by positivity, ?_⟩
  filter_upwards [eventually_ge_atTop (4 : ℝ),
    eventually_ge_atTop (Y ^ 2)] with X hX hY
  have hX0 : 0 < X := by linarith
  have hL : 0 < Real.log X := Real.log_pos (by linarith)
  have hsqrtY : Y ≤ Real.sqrt X := Real.le_sqrt_of_sq_le hY
  have hAB : Real.sqrt X ≤ Real.sqrt (2 * X) := Real.sqrt_le_sqrt (by linarith)
  have hpoint (q : ℕ)
      (hq : q ∈ (Nat.primesLE (Nat.floor (Real.sqrt (2 * X)))).filter
        (fun q : ℕ => Real.sqrt X < (q : ℝ))) :
      (Nat.primeCounting (Nat.floor (2 * X / (q : ℝ))) : ℝ) ≤
        4 * (Real.log 4 + 1) * X / ((q : ℝ) * Real.log X) := by
    have hqa := (Finset.mem_filter.mp hq).2
    have hq0 : 0 < (q : ℝ) := (Real.sqrt_pos.2 hX0).trans hqa
    have hqB : (q : ℝ) ≤ Real.sqrt (2 * X) :=
      (Nat.le_floor_iff (Real.sqrt_nonneg _)).1
        (Nat.le_of_mem_primesLE (Finset.mem_filter.mp hq).1)
    let y := 2 * X / (q : ℝ)
    have hBy : Real.sqrt (2 * X) ≤ y := by
      apply (le_div_iff₀ hq0).2
      calc
        Real.sqrt (2 * X) * (q : ℝ) ≤
            Real.sqrt (2 * X) * Real.sqrt (2 * X) :=
          mul_le_mul_of_nonneg_left hqB (Real.sqrt_nonneg _)
        _ = 2 * X := Real.mul_self_sqrt (by positivity)
    have hy0 : 0 < y := by dsimp [y]; positivity
    have hlogs : Real.log X / 2 ≤ Real.log y := by
      rw [← Real.log_sqrt hX0.le]
      exact Real.log_le_log (Real.sqrt_pos.2 hX0) (hAB.trans hBy)
    have hlogy : 0 < Real.log y := by linarith
    have hrecip : 1 / Real.log y ≤ 2 / Real.log X := by
      apply (div_le_div_iff₀ hlogy hL).2
      linarith
    calc
      (Nat.primeCounting (Nat.floor (2 * X / (q : ℝ))) : ℝ) ≤
          (Real.log 4 + 1) * y / Real.log y :=
        hCheb y (hsqrtY.trans (hAB.trans hBy))
      _ = ((Real.log 4 + 1) * y) * (1 / Real.log y) := by ring
      _ ≤ ((Real.log 4 + 1) * y) * (2 / Real.log X) :=
        mul_le_mul_of_nonneg_left hrecip (mul_nonneg hK.le hy0.le)
      _ = 4 * (Real.log 4 + 1) * X / ((q : ℝ) * Real.log X) := by
        dsimp [y]
        field_simp
        ring
  calc
    Real.log X / X *
        (∑ q ∈ (Nat.primesLE (Nat.floor (Real.sqrt (2 * X)))).filter
            (fun q : ℕ => Real.sqrt X < (q : ℝ)),
          (Nat.primeCounting (Nat.floor (2 * X / (q : ℝ))) : ℝ)) ≤
        Real.log X / X *
          (∑ q ∈ (Nat.primesLE (Nat.floor (Real.sqrt (2 * X)))).filter
              (fun q : ℕ => Real.sqrt X < (q : ℝ)),
            4 * (Real.log 4 + 1) * X / ((q : ℝ) * Real.log X)) :=
      mul_le_mul_of_nonneg_left (Finset.sum_le_sum hpoint) (div_nonneg hL.le hX0.le)
    _ = 4 * (Real.log 4 + 1) *
        (∑ q ∈ (Nat.primesLE (Nat.floor (Real.sqrt (2 * X)))).filter
            (fun q : ℕ => Real.sqrt X < (q : ℝ)), (q : ℝ)⁻¹) := by
      simp [Finset.mul_sum, div_eq_mul_inv, mul_inv_rev, mul_assoc,
        mul_left_comm, mul_comm, hX0.ne', hL.ne']
    _ ≤ 4 * (Real.log 4 + 1) * ((1 + 4 * CM) / Real.log X) :=
      mul_le_mul_of_nonneg_left (hMertens X hX) (by positivity)
    _ = 4 * (Real.log 4 + 1) * (1 + 4 * CM) / Real.log X := by ring

theorem siftedTheta_three_prime_interval_mass :
    ∀ epsilon : ℝ, 0 < epsilon →
      ∀ᶠ x : ℝ in Filter.atTop,
        ∀ u v : ℝ, 1 ≤ u → u ≤ v → v ≤ 2 →
          |Real.log x / x *
              (∑ n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)),
                if ArithmeticFunction.cardFactors n = 3 then
                  siftedTheta x (1 : Fin 6) (fun _ => 1) n else 0) -
            (v - u) *
              (∫ t in ((9519 : ℝ) / 50000)..((40481 : ℝ) / 100000),
                ∫ s in ((9519 : ℝ) / 50000)..((1 - t) / 2),
                  (t * s * (1 - t - s))⁻¹)| ≤ epsilon := by
  classical
  intro epsilon hepsilon
  let I : ℝ :=
    ∫ t in ((9519 : ℝ) / 50000)..((40481 : ℝ) / 100000),
      ∫ s in ((9519 : ℝ) / 50000)..((1 - t) / 2), (t * s * (1 - t - s))⁻¹
  let S : ℝ → ℝ := fun x =>
    ∑ p ∈ (Nat.primesBelow (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
        (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ)),
      ∑ q ∈ (Nat.primesLE (Nat.floor (Real.sqrt (x / (p : ℝ))))).filter
          (fun q : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (q : ℝ)),
        ((p : ℝ) * (q : ℝ) *
          (1 - Real.logb x (p : ℝ) - Real.logb x (q : ℝ)))⁻¹
  have hS : Filter.Tendsto S Filter.atTop (nhds I) :=
    three_prime_weighted_prime_kernel_tendsto
  obtain ⟨C, c, hC, hc, N0, hN0, hExp⟩ :=
    exists_abs_chebyshevPsi_sub_natCast_le_exp_neg_sqrtLog
  obtain ⟨hK, hNat⟩ :=
    abs_psi_nat_sub_self_le_mul_div_log_of_exp_bound
      C c N0 hC hc hN0 hExp
  have hReal := abs_psi_sub_self_le_mul_div_log_of_nat_bound
    (2 * C / c ^ 2) N0 hK hN0 hNat
  obtain ⟨CP, Y0, hCP, _, hpi⟩ :=
    exists_primeCounting_real_logSquare_error_of_psi_bound
      (2 * (2 * C / c ^ 2) + 1) (N0 : ℝ)
      (by positivity) (by exact_mod_cast hN0) hReal
  obtain ⟨H, hH, hband⟩ :=
    eventually_prime_reciprocal_band_bounded
      ((9519 : ℝ) / 50000) ((40481 : ℝ) / 100000) (by norm_num) (by norm_num)
  obtain ⟨CS, hCS, hstrip⟩ := primeCounting_sqrt_strip_le
  obtain ⟨T, hT⟩ := Filter.eventually_atTop.1 hstrip
  let b : ℝ := 59519 / 100000
  let K : ℝ := 16 * (CP + 1) / b ^ 2
  have hb : 0 < b := by norm_num [b]
  have hK0 : 0 < K := by dsimp [K]; positivity
  have hdev : Filter.Tendsto (fun x : ℝ => |S x - I|) Filter.atTop (nhds 0) := by
    simpa only [sub_self, abs_zero] using (hS.sub_const I).abs
  have herror : Filter.Tendsto
      (fun x : ℝ => (K * H ^ 2 + CS / b ^ 2 * H) / Real.log x +
        Real.log x / x * (x ^ ((40481 : ℝ) / 100000) + 1) ^ 2 + |S x - I|)
      Filter.atTop (nhds 0) := by
    simpa only [zero_add] using
      ((Real.tendsto_log_atTop.const_div_atTop (K * H ^ 2 + CS / b ^ 2 * H)).add
        theta3_endpoint_envelope_tendsto).add hdev
  filter_upwards [Filter.eventually_gt_atTop (1 : ℝ), hband,
    (tendsto_rpow_atTop hb).eventually_ge_atTop (max (Y0 ^ 2) T),
    herror.eventually_lt_const hepsilon] with x hx hxband hxlarge hxerror
  intro u v hu huv hv
  let P := (Nat.primesBelow (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
    (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ))
  let Q (p : ℕ) := (Nat.primesLE (Nat.floor (Real.sqrt (x / (p : ℝ))))).filter
    (fun q : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (q : ℝ))
  let M : ℝ := ∑ n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)),
    if ArithmeticFunction.cardFactors n = 3 then
      siftedTheta x (1 : Fin 6) (fun _ => 1) n else 0
  let B : ℝ := ∑ p ∈ P, ∑ q ∈ Q p,
    (((Finset.Icc (Nat.ceil (u * x / ((p : ℝ) * (q : ℝ))))
      (Nat.floor (v * x / ((p : ℝ) * (q : ℝ))))).filter Nat.Prime).card : ℝ)
  let E : ℝ := ∑ p ∈ P,
    ∑ q ∈ (Nat.primesLE (Nat.floor (Real.sqrt (2 * (x / (p : ℝ)))))).filter
        (fun q : ℕ => Real.sqrt (x / (p : ℝ)) < (q : ℝ)),
      (Nat.primeCounting (Nat.floor (2 * (x / (p : ℝ)) / (q : ℝ))) : ℝ)
  have hx0 : 0 < x := by linarith
  have hL : 0 < Real.log x := Real.log_pos hx
  have hscale : 0 ≤ Real.log x / x := by positivity
  have hPx : (∑ p ∈ P, (p : ℝ)⁻¹) ≤ H := by
    apply le_trans _ hxband
    apply Finset.sum_le_sum_of_subset_of_nonneg
    · exact Finset.filter_subset_filter _
        (Nat.primesBelow_mono (Nat.ceil_le_floor_add_one _))
    · intro p _ _
      positivity
  have hpoint (p : ℕ) (hp : p ∈ P) (q : ℕ) (hq : q ∈ Q p) :
      |Real.log x / x *
          (((Finset.Icc (Nat.ceil (u * x / ((p : ℝ) * (q : ℝ))))
            (Nat.floor (v * x / ((p : ℝ) * (q : ℝ))))).filter Nat.Prime).card : ℝ) -
          (v - u) * ((p : ℝ) * (q : ℝ) *
            (1 - Real.logb x (p : ℝ) - Real.logb x (q : ℝ)))⁻¹| ≤
        K / ((p : ℝ) * (q : ℝ) * Real.log x) + Real.log x / x := by
    have hg := theta2_named_prime_geometry x hx p hp
    have hX : 1 < x / (p : ℝ) :=
      (Real.one_lt_rpow hx hb).trans_le hg.2.1
    have hY : Y0 ^ 2 ≤ x / (p : ℝ) :=
      ((le_max_left _ _).trans hxlarge).trans hg.2.1
    obtain ⟨hqP, _⟩ := Finset.mem_filter.mp hq
    obtain ⟨hqhi, hqprime⟩ := Nat.mem_primesLE.mp hqP
    have hq0 : 0 < (q : ℝ) := by exact_mod_cast hqprime.pos
    have hqS : (q : ℝ) ≤ Real.sqrt (x / (p : ℝ)) :=
      (Nat.le_floor_iff (Real.sqrt_nonneg _)).mp hqhi
    have hpq := three_prime_bulk_pair_error CP Y0 b x p q u v hCP hpi
      hb hx hg.1 hX hY hq0 hqS hg.2.2.1 hu huv hv
    calc
      _ ≤ 16 * (CP + 1) / (b ^ 2 * (p : ℝ) * (q : ℝ) * Real.log x) +
          Real.log x / x := hpq
      _ = _ := by
        dsimp [K]
        simp only [div_eq_mul_inv, mul_inv_rev]
        ring
  have hbulk : |Real.log x / x * B - (v - u) * S x| ≤
      K / Real.log x * H ^ 2 +
        Real.log x / x * (x ^ ((40481 : ℝ) / 100000) + 1) ^ 2 :=
    theta3_sum_prime_count_error_le x u v K H hx hK0.le hH.le hxband hpoint
  have hE : Real.log x / x * E ≤ CS / (b ^ 2 * Real.log x) * H := by
    apply theta3_sum_sqrt_strip_le x CS H hx hCS.le hPx
    intro p hp
    have hg := theta2_named_prime_geometry x hx p hp
    exact hT (x / (p : ℝ)) (((le_max_right _ _).trans hxlarge).trans hg.2.1)
  have hfinite := theta2_three_prime_interval_bulk_strip x u v hx hu huv hv
  have hrem0 : 0 ≤ M - B := hfinite.1
  have hrem : M - B ≤ E := by
    apply hfinite.2.trans
    apply Finset.sum_le_sum
    intro p _
    apply Finset.sum_le_sum_of_subset_of_nonneg
    · exact Finset.monotone_filter_right _ (fun _ _ h => h.2)
    · intro q _ _
      positivity
  have hremScale : |Real.log x / x * M - Real.log x / x * B| ≤
      CS / (b ^ 2 * Real.log x) * H := by
    rw [← mul_sub, abs_mul, abs_of_nonneg hscale, abs_of_nonneg hrem0]
    exact (mul_le_mul_of_nonneg_left hrem hscale).trans hE
  have hprod : |(v - u) * (S x - I)| ≤ |S x - I| := by
    rw [abs_mul, abs_of_nonneg (sub_nonneg.mpr huv)]
    exact mul_le_of_le_one_left (abs_nonneg _) (by linarith : v - u ≤ 1)
  change |Real.log x / x * M - (v - u) * I| ≤ epsilon
  calc
    _ ≤ |Real.log x / x * M - Real.log x / x * B| +
        |Real.log x / x * B - (v - u) * S x| +
        |(v - u) * (S x - I)| := by
      simpa only [Real.dist_eq, ← mul_sub] using
        dist_triangle4 (Real.log x / x * M) (Real.log x / x * B)
          ((v - u) * S x) ((v - u) * I)
    _ ≤ CS / (b ^ 2 * Real.log x) * H +
        (K / Real.log x * H ^ 2 +
          Real.log x / x * (x ^ ((40481 : ℝ) / 100000) + 1) ^ 2) + |S x - I| :=
      add_le_add (add_le_add hremScale hbulk) hprod
    _ = (K * H ^ 2 + CS / b ^ 2 * H) / Real.log x +
        Real.log x / x * (x ^ ((40481 : ℝ) / 100000) + 1) ^ 2 + |S x - I| := by ring
    _ ≤ epsilon := hxerror.le

section

local notation "box" =>
  (Set.Icc (fun _ : Fin 4 => exceptionalExponentLower) (fun _ : Fin 4 => exceptionalExponentUpper))
theorem exceptionalExponentLower_pos : 0 < exceptionalExponentLower := by
  norm_num [exceptionalExponentLower]

theorem exceptionalExponentLower_lt_upper :
    exceptionalExponentLower < exceptionalExponentUpper := by
  norm_num [exceptionalExponentLower, exceptionalExponentUpper]

/--
The primes in the closed size interval with endpoints `x^exceptionalExponentLower` and
`x^exceptionalExponentUpper`, represented by natural-number ceiling and
floor endpoints.
-/
noncomputable def exceptionalPrimeBand (x : ℝ) : Finset ℕ :=
  (Finset.Icc (Nat.ceil (x ^ exceptionalExponentLower))
    (Nat.floor (x ^ exceptionalExponentUpper))).filter Nat.Prime

/-- All ordered four-tuples of primes from `exceptionalPrimeBand x`. -/
noncomputable def exceptionalPrimeQuadruples (x : ℝ) : Finset (Fin 4 → ℕ) :=
  Fintype.piFinset (fun _ => exceptionalPrimeBand x)

/-- The reciprocal product of the four coordinates, used as the mass of a prime-tuple atom. -/
noncomputable def reciprocalQuadrupleWeight (p : Fin 4 → ℕ) : ℝ := ∏ i, (p i : ℝ)⁻¹

theorem reciprocalQuadrupleWeight_nonneg (p : Fin 4 → ℕ) : 0 ≤ reciprocalQuadrupleWeight p := by
  dsimp [reciprocalQuadrupleWeight]
  exact Finset.prod_nonneg (by intro i _; exact inv_nonneg.mpr (Nat.cast_nonneg _))

/--
The finite atomic measure placing reciprocal-product mass at the base-`x` exponent vector of
every four-tuple in the prime band.
-/
noncomputable def primeQuadrupleExponentMeasure (x : ℝ) : FiniteMeasure (Fin 4 → ℝ) := by
  let d (p : Fin 4 → ℕ) : FiniteMeasure (Fin 4 → ℝ) :=
    ⟨Measure.dirac (primeQuadrupleExponents x p), by infer_instance⟩
  exact ∑ p ∈ exceptionalPrimeQuadruples x, Real.toNNReal (reciprocalQuadrupleWeight p) • d p

theorem mem_prime_rpow_interval_iff_logb_bounds {x : ℝ} (hx : 1 < x)
    {q : ℕ} (hq : q.Prime) (a b : ℝ) :
    q ∈ (Finset.Icc (Nat.ceil (x ^ a)) (Nat.floor (x ^ b))).filter Nat.Prime ↔
       a ≤ Real.logb x (q : ℝ) ∧ Real.logb x (q : ℝ) ≤ b := by
  have hx0 : 0 < x := by linarith
  have hq0 : 0 < (q : ℝ) := Nat.cast_pos.mpr hq.pos
  rw [Finset.mem_filter, Finset.mem_Icc, and_iff_left hq,
    Nat.ceil_le, Nat.le_floor_iff (Real.rpow_nonneg hx0.le _),
    Real.le_logb_iff_rpow_le hx hq0, Real.logb_le_iff_le_rpow hx hq0]

theorem primeQuadrupleExponents_mem_box {x : ℝ} (hx : 1 < x) {p : Fin 4 → ℕ}
    (hp : p ∈ exceptionalPrimeQuadruples x) : primeQuadrupleExponents x p ∈ box := by
  have common (i : Fin 4) :
      exceptionalExponentLower ≤ primeQuadrupleExponents x p i ∧
        primeQuadrupleExponents x p i ≤ exceptionalExponentUpper := by
    have m := Fintype.mem_piFinset.mp hp i
    exact (mem_prime_rpow_interval_iff_logb_bounds hx (Finset.mem_filter.mp m).2
      exceptionalExponentLower exceptionalExponentUpper).mp m
  exact ⟨fun i => (common i).1, fun i => (common i).2⟩

theorem integral_primeQuadrupleExponentMeasure (x : ℝ) (f : (Fin 4 → ℝ) → ℝ) :
    (∫ t, f t ∂(primeQuadrupleExponentMeasure x : Measure (Fin 4 → ℝ))) =
      ∑ p ∈ exceptionalPrimeQuadruples x,
        f (primeQuadrupleExponents x p) * reciprocalQuadrupleWeight p := by
  rw [primeQuadrupleExponentMeasure, FiniteMeasure.toMeasure_sum, integral_finsetSum_measure]
  · apply Finset.sum_congr rfl
    intro p _
    change (∫ a, f a ∂(Real.toNNReal (reciprocalQuadrupleWeight p) •
      Measure.dirac (primeQuadrupleExponents x p))) = _
    rw [integral_smul_nnreal_measure, integral_dirac, NNReal.smul_def,
      Real.coe_toNNReal _ (reciprocalQuadrupleWeight_nonneg p)]
    exact mul_comm _ _
  · intro p hp
    change Integrable f
      (Real.toNNReal (reciprocalQuadrupleWeight p) • Measure.dirac (primeQuadrupleExponents x p))
    apply Integrable.smul_measure_nnreal
    exact integrable_dirac (by finiteness)

open Classical in
theorem primeQuadrupleExponentMeasure_real (x : ℝ) (s : Set (Fin 4 → ℝ)) (hs : MeasurableSet s) :
    (primeQuadrupleExponentMeasure x : Measure (Fin 4 → ℝ)).real s =
      ∑ p ∈ exceptionalPrimeQuadruples x,
        if primeQuadrupleExponents x p ∈ s then reciprocalQuadrupleWeight p else 0 := by
  rw [← integral_indicator_one hs, integral_primeQuadrupleExponentMeasure]
  simp only [Set.indicator_apply, Pi.one_apply, ite_mul, one_mul, zero_mul]

theorem reciprocal_exponent_density_nonneg {t : Fin 4 → ℝ} (ht : t ∈ box) : 0 ≤ (∏ i, t i)⁻¹ := by
  apply inv_nonneg.mpr
  exact Finset.prod_nonneg (by intro i _; exact exceptionalExponentLower_pos.le.trans (ht.1 i))

theorem continuousOn_reciprocal_exponent_density :
    ContinuousOn (fun t : Fin 4 → ℝ => (∏ i, t i)⁻¹) box := by
  apply (continuousOn_finsetProd (Finset.univ : Finset (Fin 4))
    (by intro i _; exact (continuous_apply i).continuousOn)).inv₀
  intro t ht
  exact Finset.prod_ne_zero_iff.mpr (by
    intro i _
    exact (exceptionalExponentLower_pos.trans_le (ht.1 i)).ne')

/--
The finite measure on the box `[exceptionalExponentLower, exceptionalExponentUpper]^4`,
with density `1 / ∏ i, t i` relative to
four-dimensional Lebesgue measure.
-/
noncomputable def reciprocalExponentMeasure : FiniteMeasure (Fin 4 → ℝ) :=
  ⟨(volume.restrict box).withDensity (fun t : Fin 4 → ℝ => ENNReal.ofReal ((∏ i, t i)⁻¹)), by
    apply isFiniteMeasure_withDensity_ofReal
    exact (continuousOn_reciprocal_exponent_density.integrableOn_compact isCompact_Icc).2⟩

theorem measurable_reciprocal_exponent_density :
    Measurable (fun t : Fin 4 → ℝ => ENNReal.ofReal ((∏ i, t i)⁻¹)) := by
  fun_prop

theorem setIntegral_reciprocalExponentMeasure (g : (Fin 4 → ℝ) → ℝ) (s : Set (Fin 4 → ℝ))
    (hs : MeasurableSet s) :
    (∫ t in s, g t ∂(reciprocalExponentMeasure : Measure (Fin 4 → ℝ))) =
      ∫ t in s ∩ box, g t * (∏ i, t i)⁻¹ := by
  change (∫ t in s, g t ∂(volume.restrict box).withDensity
    (fun t : Fin 4 → ℝ => ENNReal.ofReal ((∏ i, t i)⁻¹))) = _
  rw [setIntegral_withDensity_eq_setIntegral_toReal_smul measurable_reciprocal_exponent_density
    (.of_forall (by intro t; exact ENNReal.ofReal_lt_top)) g hs,
    Measure.restrict_restrict hs]
  apply integral_congr_ae
  filter_upwards [ae_restrict_mem (hs.inter measurableSet_Icc)] with t ht
  simp [ENNReal.toReal_ofReal (reciprocal_exponent_density_nonneg ht.2), smul_eq_mul, mul_comm]

theorem reciprocalExponentMeasure_real (s : Set (Fin 4 → ℝ)) (hs : MeasurableSet s) :
    (reciprocalExponentMeasure : Measure (Fin 4 → ℝ)).real s = ∫ t in s ∩ box, (∏ i, t i)⁻¹ := by
  rw [← setIntegral_one_eq_measureReal, setIntegral_reciprocalExponentMeasure (fun _ => 1) s hs]
  simp

theorem reciprocalExponentMeasure_absolutelyContinuous_volume :
    (reciprocalExponentMeasure : Measure (Fin 4 → ℝ)) ≪ volume :=
  (withDensity_absolutelyContinuous _ _).trans Measure.absolutelyContinuous_restrict

theorem integral_Icc_reciprocal_prod (a b : Fin 4 → ℝ) (hab : a ≤ b)
    (hapos : ∀ i, 0 < a i) :
    (∫ t : Fin 4 → ℝ in Set.Icc a b, (∏ i, t i)⁻¹) = ∏ i, Real.log (b i / a i) := by
  simp_rw [← Finset.prod_inv_distrib]
  rw [← Set.pi_univ_Icc, volume_pi,
    Measure.restrict_pi_pi (fun _ : Fin 4 => (volume : Measure ℝ))]
  rw [integral_fin_nat_prod_eq_prod (fun (_ : Fin 4) (r : ℝ) => r⁻¹)]
  apply Finset.prod_congr rfl
  intro i _
  rw [integral_Icc_eq_integral_Ioc, ← intervalIntegral.integral_of_le (hab i)]
  exact integral_inv_of_pos (hapos i) ((hapos i).trans_le (hab i))

theorem tendsto_primeQuadrupleExponentMeasure_Icc (a b : Fin 4 → ℝ) :
    Filter.Tendsto (fun x : ℝ => (primeQuadrupleExponentMeasure x) (Set.Icc a b)) Filter.atTop
      (nhds (reciprocalExponentMeasure (Set.Icc a b))) := by
  apply NNReal.tendsto_coe.mp
  classical
  have hs : MeasurableSet (Set.Icc a b) := measurableSet_Icc
  let L : Fin 4 → ℝ := a ⊔ (fun _ => exceptionalExponentLower)
  let U : Fin 4 → ℝ := b ⊓ (fun _ => exceptionalExponentUpper)
  have hI : Set.Icc a b ∩ box = Set.Icc L U := by simp [L, U, Set.Icc_inter_Icc]
  by_cases good : L ≤ U
  · have hapos : ∀ i, 0 < L i := fun i =>
      exceptionalExponentLower_pos.trans_le (le_sup_right : exceptionalExponentLower ≤ L i)
    have hbup : ∀ i, U i ≤ exceptionalExponentUpper := fun i => inf_le_right
    have hlim : Filter.Tendsto
        (fun x : ℝ => ∑ p ∈ Fintype.piFinset (fun i : Fin 4 =>
          (Finset.Icc (Nat.ceil (x ^ L i)) (Nat.floor (x ^ U i))).filter Nat.Prime),
            ∏ i, (p i : ℝ)⁻¹) Filter.atTop (nhds (∏ i, Real.log (U i / L i))) :=
      reciprocal_four_box_tendsto _ _ (fun i => le_sup_right) good hbup
    have eqx : ∀ᶠ x : ℝ in Filter.atTop,
        (primeQuadrupleExponentMeasure x : Measure (Fin 4 → ℝ)).real (Set.Icc a b) =
        ∑ p ∈ Fintype.piFinset (fun i : Fin 4 =>
          (Finset.Icc (Nat.ceil (x ^ L i)) (Nat.floor (x ^ U i))).filter Nat.Prime),
            reciprocalQuadrupleWeight p := by
      filter_upwards [Filter.eventually_gt_atTop (1 : ℝ)] with x hx
      have heq : (exceptionalPrimeQuadruples x).filter
          (fun p => primeQuadrupleExponents x p ∈ Set.Icc a b) =
          Fintype.piFinset (fun i : Fin 4 =>
            (Finset.Icc (Nat.ceil (x ^ L i)) (Nat.floor (x ^ U i))).filter Nat.Prime) := by
        ext p
        rw [Finset.mem_filter]
        simp only [exceptionalPrimeQuadruples, Fintype.mem_piFinset]
        by_cases hp : ∀ i, (p i).Prime
        · have hmem (i : Fin 4) (A B : ℝ) := mem_prime_rpow_interval_iff_logb_bounds hx (hp i) A B
          simp only [exceptionalPrimeBand, hmem, Set.mem_Icc, Pi.le_def,
            primeQuadrupleExponents, L, U,
            Pi.sup_apply, Pi.inf_apply, sup_le_iff, le_inf_iff, forall_and]
          tauto
        · simp only [exceptionalPrimeBand, Finset.mem_filter, forall_and, hp, and_false, false_and]
      rw [primeQuadrupleExponentMeasure_real x _ hs, ← heq]
      rw [Finset.sum_filter]
      exact Finset.sum_congr rfl fun _ _ => ite_cond_congr rfl
    have Hν := reciprocalExponentMeasure_real (Set.Icc a b) hs
    rw [hI, integral_Icc_reciprocal_prod L U good hapos] at Hν
    simp only [FiniteMeasure.measureReal_eq_coe_coeFn] at eqx Hν
    rw [← Hν] at hlim
    refine Filter.Tendsto.congr' ?_ hlim
    exact eqx.mono (fun _ e => e.symm)
  · have empty : Set.Icc a b ∩ box = ∅ := by
      rw [hI, Set.Icc_eq_empty_iff]
      exact good
    have eqx : ∀ᶠ x : ℝ in Filter.atTop,
        (primeQuadrupleExponentMeasure x : Measure (Fin 4 → ℝ)).real (Set.Icc a b) = 0 := by
      filter_upwards [Filter.eventually_gt_atTop (1 : ℝ)] with x hx
      rw [primeQuadrupleExponentMeasure_real x _ hs]
      apply Finset.sum_eq_zero
      intro p hp
      rw [ite_eq_right]
      intro ht
      have : primeQuadrupleExponents x p ∈ Set.Icc a b ∩ box :=
        ⟨ht, primeQuadrupleExponents_mem_box hx hp⟩
      rw [empty] at this
      exact this
    have eqn : (reciprocalExponentMeasure : Measure (Fin 4 → ℝ)).real (Set.Icc a b) = 0 := by
      rw [reciprocalExponentMeasure_real (Set.Icc a b) hs, empty]
      simp
    simp only [FiniteMeasure.measureReal_eq_coe_coeFn] at eqx eqn
    simpa only [eqn] using
      (Filter.Tendsto.congr' (eqx.mono (fun _ hh => hh.symm))
        (tendsto_const_nhds (x := (0 : ℝ))))

theorem primeQuadrupleExponentMeasure_box {x : ℝ} (hx : 1 < x) :
    (primeQuadrupleExponentMeasure x) box = (primeQuadrupleExponentMeasure x).mass := by
  apply NNReal.coe_injective
  simp only [← FiniteMeasure.measureReal_eq_coe_coeFn, FiniteMeasure.mass]
  rw [primeQuadrupleExponentMeasure_real x box measurableSet_Icc,
    primeQuadrupleExponentMeasure_real x Set.univ MeasurableSet.univ]
  apply Finset.sum_congr rfl
  intro p hp
  simp [primeQuadrupleExponents_mem_box hx hp]

theorem reciprocalExponentMeasure_box :
    reciprocalExponentMeasure box = reciprocalExponentMeasure.mass := by
  apply NNReal.coe_injective
  simp only [← FiniteMeasure.measureReal_eq_coe_coeFn, FiniteMeasure.mass]
  rw [reciprocalExponentMeasure_real box measurableSet_Icc,
    reciprocalExponentMeasure_real Set.univ MeasurableSet.univ]
  simp

theorem reciprocalExponentMeasure_ne_zero : reciprocalExponentMeasure ≠ 0 := by
  apply (FiniteMeasure.mass_nonzero_iff _).mp
  apply ne_of_gt
  apply (NNReal.coe_pos.mp ?_)
  have W := reciprocalExponentMeasure_real box measurableSet_Icc
  rw [Set.inter_self] at W
  have P := integral_Icc_reciprocal_prod (fun _ : Fin 4 => exceptionalExponentLower)
    (fun _ => exceptionalExponentUpper)
    (by intro i; exact exceptionalExponentLower_lt_upper.le) (fun _ => exceptionalExponentLower_pos)
  have hz : 0 < Real.log (exceptionalExponentUpper / exceptionalExponentLower) :=
    Real.log_pos ((lt_div_iff₀ exceptionalExponentLower_pos).mpr
      (by simpa using exceptionalExponentLower_lt_upper))
  rw [← reciprocalExponentMeasure_box]
  change 0 < (reciprocalExponentMeasure : Measure (Fin 4 → ℝ)).real box
  rw [W, P]
  positivity

theorem tendsto_primeQuadrupleExponentMeasure :
    Filter.Tendsto primeQuadrupleExponentMeasure Filter.atTop (nhds reciprocalExponentMeasure) := by
  have hmass : Filter.Tendsto (fun x : ℝ => (primeQuadrupleExponentMeasure x).mass) Filter.atTop
      (nhds reciprocalExponentMeasure.mass) := by
    have h := tendsto_primeQuadrupleExponentMeasure_Icc (fun _ => exceptionalExponentLower)
      (fun _ => exceptionalExponentUpper)
    change Filter.Tendsto (fun x => (primeQuadrupleExponentMeasure x) box) Filter.atTop
      (nhds (reciprocalExponentMeasure box)) at h
    rw [reciprocalExponentMeasure_box] at h
    refine Filter.Tendsto.congr' ?_ h
    filter_upwards [Filter.eventually_gt_atTop (1 : ℝ)] with x hx
    exact (primeQuadrupleExponentMeasure_box hx)
  have nn := (FiniteMeasure.mass_nonzero_iff reciprocalExponentMeasure).mpr
    reciprocalExponentMeasure_ne_zero
  have ev := (hmass.eventually_ne nn).mono fun x h =>
    (FiniteMeasure.mass_nonzero_iff (primeQuadrupleExponentMeasure x)).mp h
  let S : Set (Set (Fin 4 → ℝ)) :=
    {s | ∃ a b : Fin 4 → ℝ, a ≤ b ∧ Set.Icc a b = s}
  have spi : IsPiSystem S := by
    rintro _ ⟨a, b, hab, rfl⟩ _ ⟨d, e, hde, rfl⟩ hne
    rw [Set.Icc_inter_Icc] at hne ⊢
    exact ⟨_, _, Set.nonempty_Icc.mp hne, rfl⟩
  have normals := spi.tendsto_probabilityMeasure_of_tendsto_of_mem
    (μ := fun x : ℝ => (primeQuadrupleExponentMeasure x).normalize)
    (ν := reciprocalExponentMeasure.normalize)
    (l := Filter.atTop)
    (by rintro _ ⟨a, b, _, rfl⟩; exact measurableSet_Icc)
    (by
      intro u hu x hx
      obtain ⟨r, hr, hru⟩ := Metric.nhds_basis_closedBall.mem_iff.mp (hu.mem_nhds hx)
      refine ⟨Set.Icc (fun i => x i - r) (fun i => x i + r),
        ⟨_, _, by intro i; linarith, rfl⟩, ?_, ?_⟩
      · apply pi_Icc_mem_nhds <;> intro i <;> linarith
      · simpa [closedBall_pi x hr.le, Real.closedBall_eq_Icc, Set.pi_univ_Icc] using hru)
    (by
      rintro _ ⟨a, b, _, rfl⟩
      have key : Filter.Tendsto
          (fun x : ℝ => (primeQuadrupleExponentMeasure x).mass⁻¹ *
            ((primeQuadrupleExponentMeasure x) (Set.Icc a b)))
          Filter.atTop
            (nhds (reciprocalExponentMeasure.mass⁻¹ * reciprocalExponentMeasure (Set.Icc a b))) :=
        (hmass.inv₀ nn).mul (tendsto_primeQuadrupleExponentMeasure_Icc a b)
      rw [← FiniteMeasure.normalize_eq_of_nonzero reciprocalExponentMeasure
        reciprocalExponentMeasure_ne_zero] at key
      refine Filter.Tendsto.congr' ?_ key
      filter_upwards [ev] with x hx
      exact ((primeQuadrupleExponentMeasure x).normalize_eq_of_nonzero hx _).symm)
  exact FiniteMeasure.tendsto_of_tendsto_normalize_testAgainstNN_of_tendsto_mass normals hmass

theorem tendsto_finiteMeasure_apply_of_null_frontier {Ω γ : Type*}
    [MeasurableSpace Ω] [TopologicalSpace Ω]
    [OpensMeasurableSpace Ω] [HasOuterApproxClosed Ω] [Nonempty Ω]
    {l : Filter γ} {μs : γ → FiniteMeasure Ω} {ν : FiniteMeasure Ω}
    (h : Filter.Tendsto μs l (nhds ν)) {A : Set Ω}
    (hnul : (ν : Measure Ω) (frontier A) = 0) :
    Filter.Tendsto (fun i => μs i A) l (nhds (ν A)) := by
  classical
  by_cases hnz : ν = 0
  · subst ν
    apply tendsto_of_tendsto_of_tendsto_of_le_of_le'
        (tendsto_const_nhds (x := (0 : ℝ≥0))) (show Filter.Tendsto
          (fun i => (μs i).mass) l (nhds (0 : ℝ≥0)) by simpa using h.mass)
        (.of_forall (by intro i; exact bot_le))
        (.of_forall (by intro i; exact (μs i).apply_le_mass A))
  · have evp : Filter.Tendsto (fun i => (μs i).normalize) l (nhds ν.normalize) :=
        FiniteMeasure.tendsto_normalize_of_tendsto h hnz
    have he : (ν.normalize : Measure Ω) (frontier A) = 0 := by
      rw [ν.toMeasure_normalize_eq_of_nonzero hnz, Measure.smul_apply, hnul]
      simp
    have evA := ProbabilityMeasure.tendsto_measure_of_null_frontier_of_tendsto evp
      ((ν.normalize.null_iff_toMeasure_null _).mpr he)
    simpa only [← FiniteMeasure.self_eq_mass_mul_normalize] using (h.mass.mul evA)

/--
Coordinatewise clamping to `[exceptionalExponentLower, exceptionalExponentUpper]`, giving a
retraction onto the exponent box.
-/
noncomputable def exceptionalExponentClamp (t : Fin 4 → ℝ) : Fin 4 → ℝ :=
  fun i => max exceptionalExponentLower (min exceptionalExponentUpper (t i))

theorem exceptionalExponentClamp_mem_box (t : Fin 4 → ℝ) : exceptionalExponentClamp t ∈ box :=
  ⟨by intro i; exact le_max_left _ _,
         by intro i; exact max_le exceptionalExponentLower_lt_upper.le (min_le_left _ _)⟩

theorem continuous_exceptionalExponentClamp : Continuous exceptionalExponentClamp := by
  apply continuous_pi
  intro i
  exact continuous_const.max (continuous_const.min (continuous_apply i))

theorem exceptionalExponentClamp_eq_self_of_mem_box {t : Fin 4 → ℝ} (ht : t ∈ box) :
    exceptionalExponentClamp t = t := by
  funext i
  dsimp [exceptionalExponentClamp]
  rw [min_eq_right (ht.2 i), max_eq_right (ht.1 i)]

/--
The bounded continuous extension of a function continuous on the exponent box, obtained by
composing it with coordinatewise clamping.
-/
noncomputable def extendFromExceptionalExponentBox (f : (Fin 4 → ℝ) → ℝ) (hf : ContinuousOn f box) :
    (Fin 4 → ℝ) →ᵇ ℝ where
  toFun t := f (exceptionalExponentClamp t)
  continuous_toFun := hf.comp_continuous continuous_exceptionalExponentClamp
    exceptionalExponentClamp_mem_box
  map_bounded' := by
    apply Metric.isBounded_range_iff.mp
    apply ((isCompact_Icc.image_of_continuousOn hf).isBounded).subset
    rintro z ⟨t, rfl⟩
    exact ⟨exceptionalExponentClamp t, exceptionalExponentClamp_mem_box t, rfl⟩

open Classical in
theorem reciprocal_four_continuous_tendsto
    (f : (Fin 4 → ℝ) → ℝ)
    (hf : ContinuousOn f
      (Set.Icc (fun _ : Fin 4 => (9519 : ℝ) / 50000)
        (fun _ : Fin 4 => (6 : ℝ) / 25))) :
    Filter.Tendsto
      (fun x : ℝ =>
        let P : Finset ℕ :=
          (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
            (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime
        ∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => P),
          f (fun i => Real.logb x (p i : ℝ)) * ∏ i, (p i : ℝ)⁻¹)
      Filter.atTop
      (nhds (∫ t in Set.Icc (fun _ : Fin 4 => (9519 : ℝ) / 50000)
          (fun _ : Fin 4 => (6 : ℝ) / 25), f t * (∏ i, t i)⁻¹)) := by
  change ContinuousOn f box at hf
  let F := extendFromExceptionalExponentBox f hf
  have hlim := FiniteMeasure.tendsto_iff_forall_integral_tendsto.mp
    tendsto_primeQuadrupleExponentMeasure F
  have hv : (∫ t, F t ∂(reciprocalExponentMeasure : Measure (Fin 4 → ℝ))) =
      ∫ t in Set.Icc (fun _ : Fin 4 => (9519 : ℝ) / 50000)
          (fun _ : Fin 4 => (6 : ℝ) / 25), f t * (∏ i, t i)⁻¹ := by
    rw [← setIntegral_univ]
    rw [setIntegral_reciprocalExponentMeasure F Set.univ MeasurableSet.univ, Set.univ_inter]
    apply setIntegral_congr_fun measurableSet_Icc
    intro t ht
    simp [F, extendFromExceptionalExponentBox, exceptionalExponentClamp_eq_self_of_mem_box ht]
  rw [hv] at hlim
  refine Filter.Tendsto.congr' ?_ hlim
  filter_upwards [Filter.eventually_gt_atTop (1 : ℝ)] with x hx
  rw [integral_primeQuadrupleExponentMeasure]
  simp only [exceptionalPrimeQuadruples, exceptionalPrimeBand, exceptionalExponentLower,
    exceptionalExponentUpper, reciprocalQuadrupleWeight]
  apply Finset.sum_congr rfl
  intro p hp
  rw [show F (primeQuadrupleExponents x p) = f (primeQuadrupleExponents x p) from by
    simp [F, extendFromExceptionalExponentBox,
      exceptionalExponentClamp_eq_self_of_mem_box (primeQuadrupleExponents_mem_box hx hp)]]
  rfl

theorem one_sub_sum_ge_of_mem_exceptional_exponent_box {t : Fin 4 → ℝ} (ht : t ∈ box) :
    1 / 25 ≤ 1 - ∑ i, t i := by
  have hbnd : (∑ i, t i) ≤ 4 * exceptionalExponentUpper := by
    calc
      (∑ i : Fin 4, t i) ≤ ∑ _i : Fin 4, exceptionalExponentUpper :=
        Finset.sum_le_sum (by intro i _; exact ht.2 i)
      _ = 4 * exceptionalExponentUpper := by simp
  norm_num [exceptionalExponentUpper] at hbnd ⊢
  linarith

theorem continuousOn_inv_one_sub_sum_exceptional_exponent_box :
    ContinuousOn (fun t : Fin 4 → ℝ => (1 - ∑ i, t i)⁻¹) box := by
  apply (continuousOn_const.sub (continuousOn_finsetSum _
      (by intro i _; exact (continuous_apply i).continuousOn))).inv₀
  intro t ht
  exact (by norm_num : (0 : ℝ) < 1 / 25).trans_le
    (one_sub_sum_ge_of_mem_exceptional_exponent_box ht) |>.ne'

/--
The reciprocal remaining exponent `1 / (1 - ∑ i, t i)` on the exponent box, extended to a
bounded continuous function by clamping.
-/
noncomputable def reciprocalResidualExponent : (Fin 4 → ℝ) →ᵇ ℝ :=
  extendFromExceptionalExponentBox (fun t => (1 - ∑ i, t i)⁻¹)
    continuousOn_inv_one_sub_sum_exceptional_exponent_box

theorem reciprocalResidualExponent_pos (t : Fin 4 → ℝ) : 0 < reciprocalResidualExponent t := by
  change 0 < (1 - ∑ i, exceptionalExponentClamp t i)⁻¹
  exact inv_pos.mpr (((by norm_num : (0 : ℝ) < 1 / 25).trans_le
    (one_sub_sum_ge_of_mem_exceptional_exponent_box (exceptionalExponentClamp_mem_box t))))

theorem reciprocalResidualExponent_eq_inv_one_sub_sum_of_mem_box {t : Fin 4 → ℝ} (ht : t ∈ box) :
    reciprocalResidualExponent t = (1 - ∑ i, t i)⁻¹ := by
  simp [reciprocalResidualExponent, extendFromExceptionalExponentBox,
    exceptionalExponentClamp_eq_self_of_mem_box ht]

/--
The finite measure obtained by weighting `μ` by the positive part of the bounded continuous
function `g`. Negative values are discarded by `ENNReal.ofReal`.
-/
noncomputable def finiteMeasureWithContinuousDensity {Ω : Type*}
    [MeasurableSpace Ω] [TopologicalSpace Ω]
    [OpensMeasurableSpace Ω] (μ : FiniteMeasure Ω) (g : Ω →ᵇ ℝ) : FiniteMeasure Ω :=
  ⟨(μ : Measure Ω).withDensity (fun t => ENNReal.ofReal (g t)),
    isFiniteMeasure_withDensity_ofReal (g.integrable (μ : Measure Ω)).2⟩

theorem tendsto_finiteMeasureWithContinuousDensity {Ω γ : Type*}
    [TopologicalSpace Ω] [MeasurableSpace Ω]
    [OpensMeasurableSpace Ω]
    {l : Filter γ} {ms : γ → FiniteMeasure Ω} {m : FiniteMeasure Ω}
    (g : Ω →ᵇ ℝ) (hg : ∀ t, 0 ≤ g t) (hl : Filter.Tendsto ms l (nhds m)) :
    Filter.Tendsto (fun i => finiteMeasureWithContinuousDensity (ms i) g) l
      (nhds (finiteMeasureWithContinuousDensity m g)) := by
  apply FiniteMeasure.tendsto_iff_forall_integral_tendsto.mpr
  intro f
  have T := FiniteMeasure.tendsto_iff_forall_integral_tendsto.mp hl (g * f)
  have eqi (u : FiniteMeasure Ω) :
      (∫ x, f x ∂(finiteMeasureWithContinuousDensity u g : Measure Ω)) =
        ∫ x, (g * f) x ∂(u : Measure Ω) := by
    change (∫ x, f x ∂(u : Measure Ω).withDensity (fun x => ENNReal.ofReal (g x))) = _
    rw [integral_withDensity_eq_integral_toReal_smul (by fun_prop)
      (.of_forall (by intro t; apply ENNReal.ofReal_lt_top))]
    apply integral_congr_ae
    filter_upwards [] with t
    simp [ENNReal.toReal_ofReal (hg t), BoundedContinuousFunction.coe_mul, smul_eq_mul]
  simpa only [eqi] using T

theorem finiteMeasureWithContinuousDensity_real {Ω : Type*} [MeasurableSpace Ω] [TopologicalSpace Ω]
    [OpensMeasurableSpace Ω] (μ : FiniteMeasure Ω) (g : Ω →ᵇ ℝ) (hg : ∀ t, 0 ≤ g t)
    (s : Set Ω) (hs : MeasurableSet s) :
    (finiteMeasureWithContinuousDensity μ g : Measure Ω).real s =
      ∫ t in s, g t ∂(μ : Measure Ω) := by
  rw [← setIntegral_one_eq_measureReal]
  change (∫ t in s, (1 : ℝ) ∂(μ : Measure Ω).withDensity (fun t => ENNReal.ofReal (g t))) = _
  rw [setIntegral_withDensity_eq_setIntegral_toReal_smul
    (by fun_prop) (.of_forall (by intro t; apply ENNReal.ofReal_lt_top)) (fun _ => (1 : ℝ)) hs]
  apply integral_congr_ae
  filter_upwards [] with t
  simp [ENNReal.toReal_ofReal (hg t), smul_eq_mul]

theorem finiteMeasureWithContinuousDensity_absolutelyContinuous {Ω : Type*}
    [MeasurableSpace Ω] [TopologicalSpace Ω]
    [OpensMeasurableSpace Ω]
    (m : FiniteMeasure Ω) (g : Ω →ᵇ ℝ) :
    (finiteMeasureWithContinuousDensity m g : Measure Ω) ≪ (m : Measure Ω) :=
  withDensity_absolutelyContinuous _ _

open Classical in
theorem weighted_primeQuadrupleExponentMeasure_real (x : ℝ) (hx : 1 < x)
    (s : Set (Fin 4 → ℝ)) (hs : MeasurableSet s) :
    (finiteMeasureWithContinuousDensity (primeQuadrupleExponentMeasure x)
      reciprocalResidualExponent : Measure (Fin 4 → ℝ)).real s =
      ∑ p ∈ exceptionalPrimeQuadruples x,
        if primeQuadrupleExponents x p ∈ s then
          ((∏ i, (p i : ℝ)) * (1 - ∑ i, primeQuadrupleExponents x p i))⁻¹ else 0 := by
  rw [finiteMeasureWithContinuousDensity_real (primeQuadrupleExponentMeasure x)
      reciprocalResidualExponent (fun t => (reciprocalResidualExponent_pos t).le) s hs,
      ← integral_indicator hs, integral_primeQuadrupleExponentMeasure]
  refine Finset.sum_congr rfl fun p hp => ?_
  simp only [Set.indicator_apply, ite_mul, zero_mul,
    reciprocalResidualExponent_eq_inv_one_sub_sum_of_mem_box
      (primeQuadrupleExponents_mem_box hx hp), mul_inv_rev, reciprocalQuadrupleWeight,
    Finset.prod_inv_distrib]

theorem strip_frontier_null (c : Fin 4 → ℝ) (b r : ℝ) (hc : ∃ i, c i ≠ 0) :
    (finiteMeasureWithContinuousDensity reciprocalExponentMeasure
      reciprocalResidualExponent : Measure (Fin 4 → ℝ))
      (frontier {t : Fin 4 → ℝ | |(∑ i, c i * t i) - b| ≤ r}) = 0 := by
  have hf : Continuous (fun t : Fin 4 → ℝ => |(∑ i, c i * t i) - b|) := by fun_prop
  apply ((finiteMeasureWithContinuousDensity_absolutelyContinuous _ _).trans
    reciprocalExponentMeasure_absolutelyContinuous_volume)
  refine measure_mono_null ?_ (measure_union_null
    (affine_hyperplane_null c (b + r) hc) (affine_hyperplane_null c (b - r) hc))
  intro t ht
  have h := eq_or_eq_neg_of_abs_eq (frontier_le_subset_eq hf continuous_const ht)
  simp only [sub_eq_iff_eq_add] at h
  simpa only [Set.mem_union, Set.mem_ofPred_eq, sub_eq_add_neg, add_comm] using h

open Classical in
theorem reciprocal_four_weighted_affine_strip_uniform
    (c : Fin 4 → ℝ) (hc : c ≠ 0) (b : ℝ) :
    ∀ epsilon : ℝ, 0 < epsilon →
      ∃ delta : ℝ, 0 < delta ∧
        ∀ᶠ x : ℝ in Filter.atTop,
          ∀ s : ℝ, 0 ≤ s → s ≤ delta →
            (let P : Finset ℕ :=
              (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
                (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime
             ∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => P),
               let t : Fin 4 → ℝ := fun i => Real.logb x (p i : ℝ)
               if |(∑ i, c i * t i) - b| ≤ s
               then ((∏ i, (p i : ℝ)) * (1 - ∑ i, t i))⁻¹ else 0) ≤ epsilon := by
  intro epsilon he
  have hc' : ∃ i, c i ≠ 0 := Function.ne_iff.mp hc
  let strip (d : ℝ) : Set (Fin 4 → ℝ) := {t | |(∑ i, c i * t i)-b| ≤ d}
  have sm (d : ℝ) : MeasurableSet (strip d) := by
    apply measurableSet_le <;> fun_prop
  let d : ℕ → ℝ := fun n => ((n : ℝ) + 1)⁻¹
  have hd (n) : 0 < d n := by dsimp [d]; positivity
  have hd_antitone : Antitone d := by
    intro n m hnm
    change ((m : ℝ) + 1)⁻¹ ≤ ((n : ℝ) + 1)⁻¹
    exact inv_anti₀ (by positivity) (by exact_mod_cast Nat.add_le_add_right hnm 1)
  have A := fun r => strip_frontier_null c b r hc'
  have hint : (⋂ n, strip (d n)) = {t : Fin 4 → ℝ | (∑ i, c i * t i) = b} := by
    ext t
    constructor
    · intro h
      have hd_lim : Filter.Tendsto d Filter.atTop (nhds 0) := by
        simpa only [d, one_div] using (tendsto_one_div_add_atTop_nhds_zero_nat (𝕜 := ℝ))
      have hle : |(∑ i, c i * t i) - b| ≤ (0 : ℝ) :=
        ge_of_tendsto hd_lim (.of_forall (fun n : ℕ => Set.mem_iInter.mp h n))
      simp only [Set.mem_ofPred_eq]
      exact sub_eq_zero.mp (abs_eq_zero.mp ((le_antisymm hle (abs_nonneg _))))
    · intro h
      simp only [Set.mem_ofPred_eq] at h
      simp only [Set.mem_iInter, strip, Set.mem_ofPred_eq, h, sub_self, abs_zero]
      intro n
      exact (hd n).le
  have hlim : Filter.Tendsto (fun n : ℕ =>
      (finiteMeasureWithContinuousDensity reciprocalExponentMeasure
        reciprocalResidualExponent) (strip (d n)))
      Filter.atTop (nhds (0 : ℝ≥0)) := by
    have HE : Filter.Tendsto
        (fun n : ℕ =>
          (finiteMeasureWithContinuousDensity reciprocalExponentMeasure
            reciprocalResidualExponent : Measure (Fin 4 → ℝ)) (strip (d n)))
        Filter.atTop (nhds (0 : ENNReal)) := by
      rw [← ((finiteMeasureWithContinuousDensity_absolutelyContinuous _ _).trans
        reciprocalExponentMeasure_absolutelyContinuous_volume)
        (affine_hyperplane_null c b hc'), ← hint]
      apply tendsto_measure_iInter_atTop
      · intro n; exact (sm (d n)).nullMeasurableSet
      · intro n m hnm t ht; exact le_trans ht (hd_antitone hnm)
      · exact ⟨0, measure_ne_top _ _⟩
    exact (ENNReal.tendsto_toNNReal (by simp)).comp HE
  have hr : ∃ n : ℕ,
    (finiteMeasureWithContinuousDensity reciprocalExponentMeasure
      reciprocalResidualExponent : Measure (Fin 4 → ℝ)).real
      (strip (d n)) < epsilon := by
    obtain ⟨n, hn⟩ := ((NNReal.tendsto_coe.mpr hlim).eventually_lt_const he).exists
    exact ⟨n, hn⟩
  obtain ⟨n, hn⟩ := hr
  refine ⟨d n, hd n, ?_⟩
  have hw := tendsto_finiteMeasureWithContinuousDensity reciprocalResidualExponent
    (fun t => (reciprocalResidualExponent_pos t).le)
    tendsto_primeQuadrupleExponentMeasure
  have B := tendsto_finiteMeasure_apply_of_null_frontier hw (A (d n))
  filter_upwards [Filter.eventually_gt_atTop (1 : ℝ),
    (NNReal.tendsto_coe.mpr B).eventually_le_const hn] with x hx hxlim
  intro s _ sdn
  calc
    _ = (finiteMeasureWithContinuousDensity (primeQuadrupleExponentMeasure x)
      reciprocalResidualExponent : Measure (Fin 4 → ℝ)).real (strip s) := by
      symm
      simpa [exceptionalPrimeQuadruples, exceptionalPrimeBand, exceptionalExponentLower,
        exceptionalExponentUpper, primeQuadrupleExponents, strip] using
        (weighted_primeQuadrupleExponentMeasure_real x hx (strip s) (sm s))
    _ ≤ (finiteMeasureWithContinuousDensity (primeQuadrupleExponentMeasure x)
      reciprocalResidualExponent : Measure (Fin 4 → ℝ)).real (strip (d n)) := by
      apply measureReal_mono (fun _ ht => le_trans ht sdn)
    _ ≤ epsilon := hxlim

/--
The affine half-space data for exceptional region `j`, after replacing the fifth exponent by `1
- ∑ i, t i`. Each pair records a normal vector and its threshold, including the common lower
bounds on all five exponents.
-/
noncomputable def exceptionalRegionHalfspaces (j : Fin 2) : List ((Fin 4 → ℝ) × ℝ) :=
  [(![1,0,0,0], exceptionalExponentLower), (![0,1,0,0], exceptionalExponentLower),
    (![0,0,1,0], exceptionalExponentLower), (![0,0,0,1], exceptionalExponentLower),
   (![-1,-1,-1,-1], exceptionalExponentLower-1)] ++
  if j.val = 0 then
    [(![0,0,1,-1], 0), (![0,1,-1,0], 0), (![1,-1,0,0], 0),
     (![-1,-1,-1,-2], -1), (![-1,-1,0,0], -(40481 / 100000 : ℝ)),
     (![0,1,1,1], (59519 / 100000 : ℝ))]
  else
    [(![1,-1,0,0], 0), (![0,-1,1,0], 0),
     (![-1,-1,-1,-2], -1), (![-1,0,-1,0], -(40481 / 100000 : ℝ)),
     (![1,1,0,1], (59519 / 100000 : ℝ))]

theorem exceptionalRegionHalfspaces_normals_ne_zero (j : Fin 2) (v : (Fin 4 → ℝ) × ℝ)
    (hv : v ∈ exceptionalRegionHalfspaces j) :
    ∃ i, v.1 i ≠ 0 := by
  have h : ∀ v ∈ exceptionalRegionHalfspaces j, ∃ i : Fin 4, v.1 i ≠ 0 := by
    fin_cases j <;> simp [exceptionalRegionHalfspaces, Fin.exists_fin_succ]
  exact h v hv

theorem volume_frontier_finite_halfspace_intersection (s : List ((Fin 4 → ℝ) × ℝ))
    (nondeg : ∀ v ∈ s, ∃ i, v.1 i ≠ 0) :
    volume (frontier (⋂ v ∈ s.toFinset, {t : Fin 4 → ℝ | v.2 ≤ ∑ i, v.1 i * t i})) = 0 := by
  classical
  induction s with
  | nil => simp
  | cons a s ih =>
    rw [List.toFinset_cons, Finset.set_biInter_insert]
    refine null_frontier_inter ?_ (ih (List.forall_mem_of_forall_mem_cons nondeg))
    refine measure_mono_null ?_ (affine_hyperplane_null a.1 a.2
      (nondeg a List.mem_cons_self))
    intro t ht
    exact (frontier_le_subset_eq continuous_const (by fun_prop) ht).symm

theorem snoc_exponent_lower_bounds_iff (t : Fin 4 → ℝ) :
    (∀ i : Fin 5, exceptionalExponentLower ≤ (Fin.snoc t (1 - ∑ k, t k) : Fin 5 → ℝ) i) ↔
    exceptionalExponentLower ≤ t 0 ∧ exceptionalExponentLower ≤ t 1 ∧
      exceptionalExponentLower ≤ t 2 ∧ exceptionalExponentLower ≤ t 3 ∧
      exceptionalExponentLower ≤ 1 - ∑ k, t k := by
  simp [Fin.forall_fin_succ, Fin.snoc, Fin.castLT]

theorem exceptional_region_eq_halfspace_intersection (j : Fin 2) :
    {t : Fin 4 → ℝ |
      let alpha : Fin 5 → ℝ := Fin.snoc t (1 - ∑ k, t k)
      (∀ i, (9519 : ℝ) / 50000 ≤ alpha i) ∧
        (if j.val = 0 then
          alpha 3 ≤ alpha 2 ∧ alpha 2 ≤ alpha 1 ∧ alpha 1 ≤ alpha 0 ∧
          alpha 3 ≤ alpha 4 ∧ alpha 0 + alpha 1 ≤ (40481 : ℝ) / 100000 ∧
          (59519 : ℝ) / 100000 ≤ alpha 1 + alpha 2 + alpha 3
        else
          alpha 1 ≤ alpha 0 ∧ alpha 1 ≤ alpha 2 ∧ alpha 3 ≤ alpha 4 ∧
          alpha 0 + alpha 2 ≤ (40481 : ℝ) / 100000 ∧
          (59519 : ℝ) / 100000 ≤ alpha 0 + alpha 1 + alpha 3)} =
    ⋂ v ∈ (exceptionalRegionHalfspaces j).toFinset, {t | v.2 ≤ ∑ i, v.1 i * t i} := by
  classical
  ext t
  rw [Set.mem_ofPred_eq]
  change ((∀ i : Fin 5, exceptionalExponentLower ≤
    (Fin.snoc t (1 - ∑ k, t k) : Fin 5 → ℝ) i) ∧ _) ↔ _
  rw [snoc_exponent_lower_bounds_iff t]
  by_cases hj : j.val = 0 <;>
    simp [hj, exceptionalRegionHalfspaces, Fin.sum_univ_four, Fin.snoc, Fin.castPred,
      Fin.castLT] <;>
    grind

theorem mem_exceptional_exponent_box_of_snoc_lower_bounds {t : Fin 4 → ℝ}
    (h : ∀ i : Fin 5, (9519 : ℝ) / 50000 ≤ (Fin.snoc t (1 - ∑ k, t k) : Fin 5 → ℝ) i) :
    t ∈ box := by
  obtain ⟨h0, h1, h2, h3, h4⟩ := (snoc_exponent_lower_bounds_iff t).mp h
  simp only [exceptionalExponentLower, Fin.sum_univ_four] at h0 h1 h2 h3 h4
  constructor
  · intro i
    fin_cases i <;> assumption
  · intro i
    fin_cases i <;> dsimp [exceptionalExponentUpper] <;> linarith

open Classical in
theorem exceptionalMassCoefficient_reciprocal_region_tendsto (j : Fin 2) :
    Filter.Tendsto
      (fun x : ℝ =>
        let a : ℝ := 40481 / 100000
        let b : ℝ := 59519 / 100000
        let xi : ℝ := 9519 / 50000
        let P : Finset ℕ :=
          (Finset.Icc (Nat.ceil (x ^ xi))
            (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime
        ∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => P),
          let t : Fin 4 → ℝ := fun i => Real.logb x (p i : ℝ)
          let alpha : Fin 5 → ℝ := Fin.snoc t (1 - ∑ i, t i)
          if (∀ i, xi ≤ alpha i) ∧
              (if j.val = 0 then
                alpha 3 ≤ alpha 2 ∧ alpha 2 ≤ alpha 1 ∧ alpha 1 ≤ alpha 0 ∧
                alpha 3 ≤ alpha 4 ∧ alpha 0 + alpha 1 ≤ a ∧
                b ≤ alpha 1 + alpha 2 + alpha 3
              else
                alpha 1 ≤ alpha 0 ∧ alpha 1 ≤ alpha 2 ∧ alpha 3 ≤ alpha 4 ∧
                alpha 0 + alpha 2 ≤ a ∧ b ≤ alpha 0 + alpha 1 + alpha 3)
          then ((∏ i, (p i : ℝ)) * (1 - ∑ i, t i))⁻¹ else 0)
      Filter.atTop (nhds (exceptionalMassCoefficient j)) := by
  let R : Set (Fin 4 → ℝ) := {t |
      let alpha : Fin 5 → ℝ := Fin.snoc t (1 - ∑ k, t k)
      (∀ i, (9519 : ℝ) / 50000 ≤ alpha i) ∧
        (if j.val = 0 then
          alpha 3 ≤ alpha 2 ∧ alpha 2 ≤ alpha 1 ∧ alpha 1 ≤ alpha 0 ∧
          alpha 3 ≤ alpha 4 ∧ alpha 0 + alpha 1 ≤ (40481 : ℝ) / 100000 ∧
          (59519 : ℝ) / 100000 ≤ alpha 1 + alpha 2 + alpha 3
        else
          alpha 1 ≤ alpha 0 ∧ alpha 1 ≤ alpha 2 ∧ alpha 3 ≤ alpha 4 ∧
          alpha 0 + alpha 2 ≤ (40481 : ℝ) / 100000 ∧
          (59519 : ℝ) / 100000 ≤ alpha 0 + alpha 1 + alpha 3)}
  have hr : MeasurableSet R := exceptionalCut_measurable j
  let F : (Fin 4 → ℝ) → ℝ := fun t =>
    if t ∈ R then (∏ i : Fin 5, (Fin.snoc t (1-∑ i, t i) : Fin 5 → ℝ) i)⁻¹ else 0
  have Fi : Integrable F volume := exceptional_density_integrable j
  have Fx : ∀ t, t ∉ box → F t = 0 := by
    intro t ht
    by_cases htR : t ∈ R
    · exact (ht (mem_exceptional_exponent_box_of_snoc_lower_bounds htR.1)).elim
    · simp [F, htR]
  have Feq : exceptionalMassCoefficient j =
      (finiteMeasureWithContinuousDensity reciprocalExponentMeasure
        reciprocalResidualExponent : Measure (Fin 4 → ℝ)).real R := by
    have hlim :
        (finiteMeasureWithContinuousDensity reciprocalExponentMeasure
          reciprocalResidualExponent : Measure (Fin 4 → ℝ)).real R =
        ∫ t in R ∩ box, (1-∑ i, t i)⁻¹ * (∏ i, t i)⁻¹ := by
      rw [finiteMeasureWithContinuousDensity_real reciprocalExponentMeasure
          reciprocalResidualExponent (fun t => (reciprocalResidualExponent_pos t).le) R hr,
          setIntegral_reciprocalExponentMeasure reciprocalResidualExponent R hr]
      apply setIntegral_congr_fun (hr.inter measurableSet_Icc)
      intro t ht
      change reciprocalResidualExponent t * (∏ i, t i)⁻¹ = (1-∑ i, t i)⁻¹ * (∏ i, t i)⁻¹
      rw [reciprocalResidualExponent_eq_inv_one_sub_sum_of_mem_box ht.2]
    have hadd := integral_add_compl (s := box) measurableSet_Icc Fi
    have hz : (∫ t in boxᶜ, F t) = 0 :=
      setIntegral_eq_zero_of_forall_eq_zero (fun t ht => Fx t ht)
    rw [hz, add_zero] at hadd
    symm
    rw [hlim]
    change _ = ∫ t, F t
    rw [← hadd, Set.inter_comm R box, ← setIntegral_indicator hr]
    apply setIntegral_congr_fun measurableSet_Icc
    intro t ht
    simp only [F, Set.indicator_apply, Fin.prod_snoc, mul_inv_rev]
  have hn :
      (finiteMeasureWithContinuousDensity reciprocalExponentMeasure
        reciprocalResidualExponent : Measure (Fin 4 → ℝ)) (frontier R) = 0 := by
    apply ((finiteMeasureWithContinuousDensity_absolutelyContinuous _ _).trans
      reciprocalExponentMeasure_absolutelyContinuous_volume)
    change volume (frontier R) = 0
    rw [show R = _ from exceptional_region_eq_halfspace_intersection j]
    exact volume_frontier_finite_halfspace_intersection (exceptionalRegionHalfspaces j)
      (exceptionalRegionHalfspaces_normals_ne_zero j)
  have T := tendsto_finiteMeasure_apply_of_null_frontier
    (tendsto_finiteMeasureWithContinuousDensity reciprocalResidualExponent
      (fun t => (reciprocalResidualExponent_pos t).le)
      tendsto_primeQuadrupleExponentMeasure) hn
  have Tr := NNReal.tendsto_coe.mpr T
  rw [← FiniteMeasure.measureReal_eq_coe_coeFn, ← Feq] at Tr
  refine Filter.Tendsto.congr' ?_ Tr
  filter_upwards [Filter.eventually_gt_atTop (1 : ℝ)] with x hx
  change (finiteMeasureWithContinuousDensity (primeQuadrupleExponentMeasure x)
    reciprocalResidualExponent : Measure (Fin 4 → ℝ)).real R = _
  rw [weighted_primeQuadrupleExponentMeasure_real x hx R hr]
  simp only [exceptionalPrimeQuadruples, exceptionalPrimeBand, exceptionalExponentLower,
    exceptionalExponentUpper]
  exact Finset.sum_congr rfl fun _ _ => ite_cond_congr rfl

end

theorem reciprocal_primeQuadruple_strip_sum_nonneg
    (x : ℝ) (hx : 1 < x) (c : Fin 4 → ℝ) (b s : ℝ) :
    0 ≤ ∑ p ∈ exceptionalPrimeQuadruples x,
      if |(∑ i, c i * primeQuadrupleExponents x p i) - b| ≤ s
      then ((∏ i, (p i : ℝ)) * (1 - ∑ i, primeQuadrupleExponents x p i))⁻¹ else 0 := by
  classical
  refine Finset.sum_nonneg fun p hp => ite_nonneg (inv_nonneg.mpr ?_) le_rfl
  exact mul_nonneg (Finset.prod_nonneg fun _ _ => Nat.cast_nonneg _)
    ((by norm_num : (0 : ℝ) ≤ 1 / 25).trans
      (one_sub_sum_ge_of_mem_exceptional_exponent_box
        (primeQuadrupleExponents_mem_box hx hp)))

open Classical in
theorem reciprocal_four_weighted_affine_moving_strip_tendsto
    (c : Fin 4 → ℝ) (hc : c ≠ 0) (b r : ℝ) (hr : 0 ≤ r) :
    Filter.Tendsto
      (fun x : ℝ =>
        let P : Finset ℕ :=
          (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
            (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime
        ∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => P),
          let t : Fin 4 → ℝ := fun i => Real.logb x (p i : ℝ)
          if |(∑ i, c i * t i) - b| ≤ r * Real.log 2 / Real.log x
          then ((∏ i, (p i : ℝ)) * (1 - ∑ i, t i))⁻¹ else 0)
      Filter.atTop (nhds 0) := by
  change Filter.Tendsto
    (fun x : ℝ => ∑ p ∈ exceptionalPrimeQuadruples x,
      if |(∑ i, c i * primeQuadrupleExponents x p i) - b| ≤ r * Real.log 2 / Real.log x
      then ((∏ i, (p i : ℝ)) * (1 - ∑ i, primeQuadrupleExponents x p i))⁻¹ else 0)
    Filter.atTop (nhds 0)
  refine tendsto_order.2 ⟨?_, ?_⟩
  · intro a ha
    filter_upwards [Filter.eventually_gt_atTop (1 : ℝ)] with x hx
    exact lt_of_lt_of_le ha
      (reciprocal_primeQuadruple_strip_sum_nonneg x hx c b (r * Real.log 2 / Real.log x))
  · intro epsilon he
    obtain ⟨delta, hd, H⟩ :=
      reciprocal_four_weighted_affine_strip_uniform c hc b (epsilon / 2) (half_pos he)
    have hscale : Filter.Tendsto
        (fun x : ℝ => r * Real.log 2 / Real.log x) Filter.atTop (nhds 0) :=
      tendsto_const_nhds.div_atTop Real.tendsto_log_atTop
    filter_upwards [Filter.eventually_gt_atTop (1 : ℝ), H,
      hscale.eventually_le_const hd] with x hx hxstrip hxscale
    have hnonneg : 0 ≤ r * Real.log 2 / Real.log x :=
      div_nonneg (mul_nonneg hr (Real.log_nonneg (by norm_num)))
        (Real.log_nonneg hx.le)
    have hmass : (∑ p ∈ exceptionalPrimeQuadruples x,
        if |(∑ i, c i * primeQuadrupleExponents x p i) - b| ≤ r * Real.log 2 / Real.log x
        then ((∏ i, (p i : ℝ)) * (1 - ∑ i, primeQuadrupleExponents x p i))⁻¹
        else 0) ≤ epsilon / 2 :=
      hxstrip (r * Real.log 2 / Real.log x) hnonneg hxscale
    exact lt_of_le_of_lt hmass (half_lt_self he)

open Classical in
theorem reciprocal_four_weighted_affine_moving_strip_finset_tendsto
    {ι : Type*} (S : Finset ι) (c : ι → Fin 4 → ℝ) (b r : ι → ℝ)
    (hc : ∀ a ∈ S, c a ≠ 0) (hr : ∀ a ∈ S, 0 ≤ r a) :
    Filter.Tendsto
      (fun x : ℝ => ∑ a ∈ S,
        let P : Finset ℕ :=
          (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
            (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime
        ∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => P),
          let t : Fin 4 → ℝ := fun i => Real.logb x (p i : ℝ)
          if |(∑ i, c a i * t i) - b a| ≤ r a * Real.log 2 / Real.log x
          then ((∏ i, (p i : ℝ)) * (1 - ∑ i, t i))⁻¹ else 0)
      Filter.atTop (nhds 0) := by
  simpa only [Finset.sum_const_zero] using
    (tendsto_finsetSum S (fun a ha =>
      reciprocal_four_weighted_affine_moving_strip_tendsto
        (c a) (hc a ha) (b a) (r a) (hr a ha)))

theorem sum_piFinset_snoc {α β : Type*} [AddCommMonoid β]
    (n : ℕ) (s : Finset α) (F : (Fin (n + 1) → α) → β) :
    (∑ p ∈ Fintype.piFinset (fun _ : Fin (n + 1) => s), F p) =
      ∑ p ∈ Fintype.piFinset (fun _ : Fin n => s), ∑ q ∈ s, F (Fin.snoc p q) := by
  classical
  have h := Finset.filter_piFinset_eq_map_snocEquiv
    (fun _ : Fin (n + 1) => s) (fun _ => True)
  simp only [Finset.filter_true] at h
  rw [h, Finset.sum_map, Finset.sum_product, Finset.sum_comm]
  rfl

theorem mul_mem_closed_nat_interval_iff
    (m q : ℕ) (hm : 0 < m) (A B : ℝ) (hB : 0 ≤ B) :
    m * q ∈ Finset.Icc (Nat.ceil A) (Nat.floor B) ↔
      q ∈ Finset.Icc (Nat.ceil (A / (m : ℝ))) (Nat.floor (B / (m : ℝ))) := by
  have hmR : 0 < (m : ℝ) := Nat.cast_pos.mpr hm
  rw [Finset.mem_Icc, Finset.mem_Icc, Nat.ceil_le, Nat.ceil_le,
    Nat.le_floor_iff hB, Nat.le_floor_iff (div_nonneg hB hmR.le),
    Nat.cast_mul, div_le_iff₀ hmR, le_div_iff₀ hmR, mul_comm (m : ℝ) (q : ℝ)]

theorem sum_prime_band_closed_division {β : Type*} [AddCommMonoid β]
    (s : Finset ℕ) (hs : ∀ q ∈ s, q.Prime)
    (m : ℕ) (hm : 0 < m) (A B : ℝ) (hB : 0 ≤ B) (F : ℕ → β) :
    (∑ q ∈ s, if m * q ∈ Finset.Icc (Nat.ceil A) (Nat.floor B) then F q else 0) =
      ∑ q ∈ (Finset.Icc (Nat.ceil (A / (m : ℝ)))
          (Nat.floor (B / (m : ℝ)))).filter Nat.Prime,
        if q ∈ s then F q else 0 := by
  classical
  rw [← Finset.sum_filter, ← Finset.sum_filter]
  apply Finset.sum_congr
  · ext q
    simp only [Finset.mem_filter]
    constructor
    · rintro ⟨hqs, hprod⟩
      exact ⟨⟨(mul_mem_closed_nat_interval_iff m q hm A B hB).mp hprod, hs q hqs⟩, hqs⟩
    · rintro ⟨⟨hq, _⟩, hqs⟩
      exact ⟨hqs, (mul_mem_closed_nat_interval_iff m q hm A B hB).mpr hq⟩
  · intro q _
    rfl

open Classical in
theorem sum_primeTuples_closed_prefix
    (n : ℕ) (s : Finset ℕ) (hs : ∀ q ∈ s, q.Prime)
    (A B : ℝ) (hB : 0 ≤ B) (cut : (Fin (n + 1) → ℕ) → Prop) :
    (∑ p ∈ Fintype.piFinset (fun _ : Fin (n + 1) => s),
      if (∏ i, p i) ∈ Finset.Icc (Nat.ceil A) (Nat.floor B) ∧ cut p
      then (1 : ℝ) else 0) =
      ∑ p ∈ Fintype.piFinset (fun _ : Fin n => s),
        let M : ℕ := ∏ i, p i
        ∑ q ∈ (Finset.Icc (Nat.ceil (A / (M : ℝ)))
            (Nat.floor (B / (M : ℝ)))).filter Nat.Prime,
          if q ∈ s ∧ cut (Fin.snoc p q) then (1 : ℝ) else 0 := by
  rw [sum_piFinset_snoc]
  apply Finset.sum_congr rfl
  intro p hp
  have hm : 0 < ∏ i, p i :=
    Finset.prod_pos (fun i _ => (hs (p i) (Fintype.mem_piFinset.mp hp i)).pos)
  simpa only [Fin.prod_snoc, ite_and] using
    sum_prime_band_closed_division s hs (∏ i, p i) hm A B hB
      (fun q => if cut (Fin.snoc p q) then (1 : ℝ) else 0)

open Classical in
theorem exceptionalPrimeDefect_interval_as_prefix_slice :
    ∀ᶠ x : ℝ in Filter.atTop,
      ∀ j : Fin 2, ∀ u v : ℝ, 1 ≤ u → u ≤ v → v ≤ 2 →
        (∑ n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)),
          exceptionalPrimeDefect x j n) =
        let P : Finset ℕ :=
          (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
            (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime
        ∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => P),
          let M : ℕ := ∏ i, p i
          ∑ q ∈ (Finset.Icc (Nat.ceil (u * x / (M : ℝ)))
              (Nat.floor (v * x / (M : ℝ)))).filter Nat.Prime,
            let p5 : Fin 5 → ℕ := Fin.snoc p q
            let alpha : Fin 5 → ℝ := fun i => Real.logb x (p5 i : ℝ)
            if q ∈ P ∧
                (if j.val = 0 then
                  (9519 : ℝ) / 50000 ≤ alpha 3 ∧
                  alpha 3 < alpha 2 ∧ alpha 2 < alpha 1 ∧ alpha 1 < alpha 0 ∧
                  alpha 0 < (40481 : ℝ) / 100000 ∧
                  alpha 0 + alpha 1 < (40481 : ℝ) / 100000 ∧
                  (59519 : ℝ) / 100000 < alpha 1 + alpha 2 + alpha 3 ∧
                  (p5 3 : ℝ) ≤ (p5 4 : ℝ)
                else
                  (∀ i, (9519 : ℝ) / 50000 ≤ alpha i ∧
                    alpha i ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
                  alpha 1 < alpha 0 ∧ alpha 1 < alpha 2 ∧
                  alpha 0 + alpha 2 < (40481 : ℝ) / 100000 ∧
                  (59519 : ℝ) / 100000 < alpha 0 + alpha 1 + alpha 3 ∧
                  alpha 3 ≤ alpha 4)
            then (1 : ℝ) else 0 := by
  filter_upwards [exceptionalPrimeDefect_interval_as_compact_tuple,
    Filter.eventually_gt_atTop (1 : ℝ)] with x hcompact hx
  intro j u v hu huv hv
  rw [hcompact j u v hu huv hv]
  let P : Finset ℕ :=
    (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
      (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime
  let cut (p5 : Fin 5 → ℕ) : Prop :=
    let alpha : Fin 5 → ℝ := fun i => Real.logb x (p5 i : ℝ)
    if j.val = 0 then
      (9519 : ℝ) / 50000 ≤ alpha 3 ∧
      alpha 3 < alpha 2 ∧ alpha 2 < alpha 1 ∧ alpha 1 < alpha 0 ∧
      alpha 0 < (40481 : ℝ) / 100000 ∧
      alpha 0 + alpha 1 < (40481 : ℝ) / 100000 ∧
      (59519 : ℝ) / 100000 < alpha 1 + alpha 2 + alpha 3 ∧
      (p5 3 : ℝ) ≤ (p5 4 : ℝ)
    else
      (∀ i, (9519 : ℝ) / 50000 ≤ alpha i ∧
        alpha i ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
      alpha 1 < alpha 0 ∧ alpha 1 < alpha 2 ∧
      alpha 0 + alpha 2 < (40481 : ℝ) / 100000 ∧
      (59519 : ℝ) / 100000 < alpha 0 + alpha 1 + alpha 3 ∧ alpha 3 ≤ alpha 4
  have hprime : ∀ q ∈ P, q.Prime := fun _ hq => (Finset.mem_filter.mp hq).2
  have hvx : 0 ≤ v * x := mul_nonneg (by linarith) (by linarith)
  simpa only [P, cut] using
    sum_primeTuples_closed_prefix 4 P hprime (u * x) (v * x) hvx cut

section
variable {n : ℕ} {α ι : Type*}
/-!
## Boundary control in exponent space

Compare moving inequalities with fixed closed regions by isolating small neighborhoods of their
affine boundaries.
-/

theorem snoc_affine_expand (c : Fin (n + 1) → ℝ) (b : ℝ)
    (t : Fin n → ℝ) (z : ℝ) :
    (∑ i, c i * Fin.snoc (α := fun _ => ℝ) t z i) - b =
      (∑ i, c i.castSucc * t i) + c (Fin.last n) * z - b := by
  rw [Fin.sum_univ_castSucc]
  simp only [Fin.snoc_castSucc, Fin.snoc_last]

theorem snoc_affine_sub (c : Fin (n + 1) → ℝ) (b : ℝ)
    (t : Fin n → ℝ) (z z₀ : ℝ) :
    ((∑ i, c i * Fin.snoc (α := fun _ => ℝ) t z i) - b) -
        ((∑ i, c i * Fin.snoc (α := fun _ => ℝ) t z₀ i) - b) =
      c (Fin.last n) * (z - z₀) := by
  rw [snoc_affine_expand, snoc_affine_expand]
  ring

theorem snoc_affine_sub_abs_le (c : Fin (n + 1) → ℝ) (b : ℝ)
    (t : Fin n → ℝ) {z z₀ δ : ℝ} (h : |z - z₀| ≤ δ) :
    |((∑ i, c i * Fin.snoc (α := fun _ => ℝ) t z i) - b) -
        ((∑ i, c i * Fin.snoc (α := fun _ => ℝ) t z₀ i) - b)| ≤
      |c (Fin.last n)| * δ := by
  rw [snoc_affine_sub, abs_mul]
  exact mul_le_mul_of_nonneg_left h (abs_nonneg _)

theorem snoc_affine_limit_eq (c : Fin (n + 1) → ℝ) (b : ℝ)
    (t : Fin n → ℝ) :
    (∑ i, c i * Fin.snoc (α := fun _ => ℝ) t (1 - ∑ k, t k) i) - b =
      (∑ i, (c i.castSucc - c (Fin.last n)) * t i) -
        (b - c (Fin.last n)) := by
  rw [snoc_affine_expand]
  simp_rw [sub_mul, Finset.sum_sub_distrib, ← Finset.mul_sum]
  ring

theorem eliminated_coefficients_ne_zero_iff (c : Fin (n + 1) → ℝ) :
    (fun i : Fin n => c i.castSucc - c (Fin.last n)) ≠ 0 ↔
      ∃ i : Fin n, c i.castSucc ≠ c (Fin.last n) := by
  simp only [Function.ne_iff, Pi.zero_apply, sub_ne_zero]

theorem strict_closed_disagreement_abs_le {a b δ : ℝ}
    (h : |a - b| ≤ δ) (hdis : ¬ ((0 < a) ↔ (0 ≤ b))) :
    |b| ≤ δ := by
  rcases abs_le.mp h with ⟨hlo, hhi⟩
  by_cases ha : 0 < a
  · have hb : ¬ 0 ≤ b := fun hb => hdis ⟨fun _ => hb, fun _ => ha⟩
    rw [abs_of_neg (lt_of_not_ge hb)]
    linarith
  · have hb : 0 ≤ b := by
      by_contra hb
      exact hdis ⟨fun h => (ha h).elim, fun h => (hb h).elim⟩
    rw [abs_of_nonneg hb]
    have ha' : a ≤ 0 := le_of_not_gt ha
    linarith

theorem closed_closed_disagreement_abs_le {a b δ : ℝ}
    (h : |a - b| ≤ δ) (hdis : ¬ ((0 ≤ a) ↔ (0 ≤ b))) :
    |b| ≤ δ := by
  rcases abs_le.mp h with ⟨hlo, hhi⟩
  by_cases ha : 0 ≤ a
  · have hb : ¬ 0 ≤ b := fun hb => hdis ⟨fun _ => hb, fun _ => ha⟩
    rw [abs_of_neg (lt_of_not_ge hb)]
    linarith
  · have hb : 0 ≤ b := by
      by_contra hb
      exact hdis ⟨fun h => (ha h).elim, fun h => (hb h).elim⟩
    rw [abs_of_nonneg hb]
    have ha' : a < 0 := lt_of_not_ge ha
    linarith

open Classical in
theorem mixed_closed_disagreement_abs_le (strict : Bool) {a b δ : ℝ}
    (h : |a - b| ≤ δ)
    (hdis : ¬ ((if strict then 0 < a else 0 ≤ a) ↔ 0 ≤ b)) :
    |b| ≤ δ := by
  cases strict with
  | false => exact closed_closed_disagreement_abs_le h (by simpa using hdis)
  | true => exact strict_closed_disagreement_abs_le h (by simpa using hdis)

open Classical in
theorem mixed_closed_iff_of_outside_strip (strict : Bool) {a b δ : ℝ}
    (h : |a - b| ≤ δ) (hout : δ < |b|) :
    (if strict then 0 < a else 0 ≤ a) ↔ 0 ≤ b := by
  by_contra hdis
  exact (not_le_of_gt hout) (mixed_closed_disagreement_abs_le strict h hdis)

open Classical in
theorem finite_cuts_iff_of_outside_strips
    (faces : Finset ι) (strict : ι → Bool) (a b δ : ι → ℝ)
    (hmove : ∀ k ∈ faces, |a k - b k| ≤ δ k)
    (hout : ∀ k ∈ faces, δ k < |b k|) :
    (∀ k ∈ faces, if strict k then 0 < a k else 0 ≤ a k) ↔
      ∀ k ∈ faces, 0 ≤ b k :=
  forall₂_congr fun k hk =>
    mixed_closed_iff_of_outside_strip (strict k) (hmove k hk) (hout k hk)

open Classical in
theorem finite_cuts_disagreement_exists_strip
    (faces : Finset ι) (strict : ι → Bool) (a b δ : ι → ℝ)
    (hmove : ∀ k ∈ faces, |a k - b k| ≤ δ k)
    (hdis : ¬ ((∀ k ∈ faces, if strict k then 0 < a k else 0 ≤ a k) ↔
      ∀ k ∈ faces, 0 ≤ b k)) :
    ∃ k ∈ faces, |b k| ≤ δ k := by
  by_contra hn
  apply hdis
  apply finite_cuts_iff_of_outside_strips faces strict a b δ hmove
  intro k hk
  exact lt_of_not_ge (fun h => hn ⟨k, hk, h⟩)

open Classical in
theorem strict_closed_indicator_error_at_zero (a w : ℝ) :
    |(if 0 < a then w else 0) - (if 0 ≤ a then w else 0)| =
      if a = 0 then |w| else 0 := by
  rcases lt_trichotomy a 0 with ha | ha | ha
  · simp [not_lt_of_ge ha.le, not_le_of_gt ha, ha.ne]
  · simp [ha]
  · simp [ha, ha.le, ha.ne']

open Classical in
theorem weighted_indicator_error_le_boundary_sum
    (faces : Finset ι) (P Q : Prop) (boundary : ι → Prop)
    (w : ℝ) (hw : 0 ≤ w)
    (hcover : ¬ (P ↔ Q) → ∃ k ∈ faces, boundary k) :
    |(if P then w else 0) - (if Q then w else 0)| ≤
      ∑ k ∈ faces, if boundary k then w else 0 := by
  have hnonneg : ∀ k ∈ faces, 0 ≤ (if boundary k then w else 0) :=
    fun _ _ => ite_nonneg hw le_rfl
  by_cases hpq : P ↔ Q
  · simp only [hpq, sub_self, abs_zero]
    exact Finset.sum_nonneg hnonneg
  · obtain ⟨k, hk, hb⟩ := hcover hpq
    calc
      _ ≤ w := by
        by_cases hp : P <;> by_cases hq : Q <;> simp [hp, hq, abs_of_nonneg hw, hw]
      _ ≤ ∑ k ∈ faces, if boundary k then w else 0 := by
        simpa only [hb, ↓reduceIte] using Finset.single_le_sum hnonneg hk

open Classical in
theorem weighted_indicator_sum_error_le_boundary_mass
    (points : Finset α) (faces : Finset ι)
    (P Q : α → Prop) (boundary : ι → α → Prop) (w : α → ℝ)
    (hw : ∀ p ∈ points, 0 ≤ w p)
    (hcover : ∀ p ∈ points, ¬ (P p ↔ Q p) →
      ∃ k ∈ faces, boundary k p) :
    |(∑ p ∈ points, if P p then w p else 0) -
        (∑ p ∈ points, if Q p then w p else 0)| ≤
      ∑ k ∈ faces, ∑ p ∈ points, if boundary k p then w p else 0 := by
  rw [← Finset.sum_sub_distrib]
  calc
    _ ≤ ∑ p ∈ points,
        |(if P p then w p else 0) - (if Q p then w p else 0)| :=
      Finset.abs_sum_le_sum_abs _ _
    _ ≤ ∑ p ∈ points, ∑ k ∈ faces, if boundary k p then w p else 0 := by
      apply Finset.sum_le_sum
      intro p hp
      exact weighted_indicator_error_le_boundary_sum faces (P p) (Q p)
        (fun k => boundary k p) (w p) (hw p hp) (hcover p hp)
    _ = _ := Finset.sum_comm

open Classical in
theorem weighted_finite_cuts_error_le_strip_mass
    (points : Finset α) (faces : Finset ι) (strict : ι → Bool)
    (a b δ : α → ι → ℝ) (w : α → ℝ)
    (hmove : ∀ p ∈ points, ∀ k ∈ faces, |a p k - b p k| ≤ δ p k)
    (hw : ∀ p ∈ points, 0 ≤ w p) :
    |(∑ p ∈ points,
        if ∀ k ∈ faces, if strict k then 0 < a p k else 0 ≤ a p k
        then w p else 0) -
      (∑ p ∈ points, if ∀ k ∈ faces, 0 ≤ b p k then w p else 0)| ≤
      ∑ k ∈ faces, ∑ p ∈ points, if |b p k| ≤ δ p k then w p else 0 := by
  convert weighted_indicator_sum_error_le_boundary_mass points faces
    (fun p => ∀ k ∈ faces, if strict k then 0 < a p k else 0 ≤ a p k)
    (fun p => ∀ k ∈ faces, 0 ≤ b p k)
    (fun k p => |b p k| ≤ δ p k) w hw
    (fun p hp hdis => finite_cuts_disagreement_exists_strip faces strict
      (a p) (b p) (δ p) (hmove p hp) hdis) using 1
  congr
  all_goals
    funext p
    split_ifs <;> rfl

open Classical in
theorem weighted_snoc_affine_cut_error
    (points : Finset α) (faces : Finset ι) (strict : ι → Bool)
    (c : ι → Fin (n + 1) → ℝ) (b : ι → ℝ)
    (t : α → Fin n → ℝ) (z z₀ δ w : α → ℝ)
    (hmove : ∀ p ∈ points, |z p - z₀ p| ≤ δ p)
    (hw : ∀ p ∈ points, 0 ≤ w p) :
    |(∑ p ∈ points,
        if ∀ k ∈ faces,
            if strict k then 0 < (∑ i, c k i * Fin.snoc (α := fun _ => ℝ) (t p) (z p) i) - b k
            else 0 ≤ (∑ i, c k i * Fin.snoc (α := fun _ => ℝ) (t p) (z p) i) - b k
        then w p else 0) -
      (∑ p ∈ points,
        if ∀ k ∈ faces, 0 ≤ (∑ i, c k i * Fin.snoc (α := fun _ => ℝ) (t p) (z₀ p) i) - b k
        then w p else 0)| ≤
      ∑ k ∈ faces, ∑ p ∈ points,
        if |(∑ i, c k i * Fin.snoc (α := fun _ => ℝ) (t p) (z₀ p) i) - b k| ≤
            |c k (Fin.last n)| * δ p
        then w p else 0 :=
  weighted_finite_cuts_error_le_strip_mass points faces strict
    (fun p k => (∑ i, c k i * Fin.snoc (α := fun _ => ℝ) (t p) (z p) i) - b k)
    (fun p k => (∑ i, c k i * Fin.snoc (α := fun _ => ℝ) (t p) (z₀ p) i) - b k)
    (fun p k => |c k (Fin.last n)| * δ p) w
    (fun p hp k _ => snoc_affine_sub_abs_le (c k) (b k) (t p) (hmove p hp)) hw

open Classical in
theorem weighted_snoc_limit_cut_error
    (points : Finset α) (faces : Finset ι) (strict : ι → Bool)
    (c : ι → Fin (n + 1) → ℝ) (b : ι → ℝ)
    (t : α → Fin n → ℝ) (z w : α → ℝ) (δ : ℝ)
    (hmove : ∀ p ∈ points, |z p - (1 - ∑ i, t p i)| ≤ δ)
    (hw : ∀ p ∈ points, 0 ≤ w p) :
    |(∑ p ∈ points,
        if ∀ k ∈ faces,
            if strict k then 0 < (∑ i, c k i * Fin.snoc (α := fun _ => ℝ) (t p) (z p) i) - b k
            else 0 ≤ (∑ i, c k i * Fin.snoc (α := fun _ => ℝ) (t p) (z p) i) - b k
        then w p else 0) -
      (∑ p ∈ points,
        if ∀ k ∈ faces,
            0 ≤ (∑ i, (c k i.castSucc - c k (Fin.last n)) * t p i) -
              (b k - c k (Fin.last n))
        then w p else 0)| ≤
      ∑ k ∈ faces, ∑ p ∈ points,
        if |(∑ i, (c k i.castSucc - c k (Fin.last n)) * t p i) -
            (b k - c k (Fin.last n))| ≤ |c k (Fin.last n)| * δ
        then w p else 0 := by
  simpa only [snoc_affine_limit_eq] using
    weighted_snoc_affine_cut_error points faces strict c b t z
      (fun p => 1 - ∑ i, t p i) (fun _ => δ) w hmove hw

end

theorem source_strict_order_iff_closed_of_outside_strip
    (a b δ : ℝ) (hδ : 0 ≤ δ) (hout : δ < |b - a|) :
    a < b ↔ a ≤ b := by
  have hzero : |(b - a) - (b - a)| ≤ δ := by simpa using hδ
  simpa [sub_pos, sub_nonneg] using
    mixed_closed_iff_of_outside_strip true hzero hout

theorem source_last_order_iff_closed_of_outside_strip
    (t : Fin 4 → ℝ) (γ δ : ℝ)
    (hmove0 : 0 ≤ γ - (1 - ∑ i, t i))
    (hmove : γ - (1 - ∑ i, t i) ≤ δ)
    (hout : δ < |t 0 + t 1 + t 2 + 2 * t 3 - 1|) :
    t 3 ≤ γ ↔ t 3 ≤ 1 - ∑ i, t i := by
  let β : ℝ := 1 - ∑ i, t i
  have hdiff : |(γ - t 3) - (β - t 3)| ≤ δ := by
    simpa only [sub_sub_sub_cancel_right, β, abs_of_nonneg hmove0] using hmove
  have hface : |β - t 3| = |t 0 + t 1 + t 2 + 2 * t 3 - 1| := by
    rw [← abs_neg (β - t 3)]
    congr 1
    dsimp only [β]
    rw [Fin.sum_univ_four]
    ring
  have hout' : δ < |β - t 3| := by rwa [hface]
  simpa [sub_nonneg, β] using
    mixed_closed_iff_of_outside_strip false hdiff hout'

theorem family_zero_finite_cuts_iff_closed_of_outside_strips
    (t : Fin 4 → ℝ) (γ δ : ℝ)
    (ht : ∀ i, (9519 : ℝ) / 50000 ≤ t i ∧ t i ≤ (6 : ℝ) / 25)
    (hmove0 : 0 ≤ γ - (1 - ∑ i, t i))
    (hmove : γ - (1 - ∑ i, t i) ≤ δ)
    (hδ : 0 ≤ δ)
    (hδsmall : δ < min ((19 : ℝ) / 12500) ((481 : ℝ) / 20000))
    (h01 : δ < |t 0 - t 1|)
    (h12 : δ < |t 1 - t 2|)
    (h23 : δ < |t 2 - t 3|)
    (hpair : δ < |t 0 + t 1 - (40481 : ℝ) / 100000|)
    (htriple : δ < |t 1 + t 2 + t 3 - (59519 : ℝ) / 100000|)
    (hlast : δ < |t 0 + t 1 + t 2 + 2 * t 3 - 1|) :
    (((9519 : ℝ) / 50000 ≤ γ ∧ γ ≤ (6 : ℝ) / 25) ∧
      (9519 : ℝ) / 50000 ≤ t 3 ∧
      t 3 < t 2 ∧ t 2 < t 1 ∧ t 1 < t 0 ∧
      t 0 < (40481 : ℝ) / 100000 ∧
      t 0 + t 1 < (40481 : ℝ) / 100000 ∧
      (59519 : ℝ) / 100000 < t 1 + t 2 + t 3 ∧ t 3 ≤ γ) ↔
    (let α : Fin 5 → ℝ := Fin.snoc (α := fun _ => ℝ) t (1 - ∑ i, t i)
     (∀ i, (9519 : ℝ) / 50000 ≤ α i) ∧
       α 3 ≤ α 2 ∧ α 2 ≤ α 1 ∧ α 1 ≤ α 0 ∧ α 3 ≤ α 4 ∧
       α 0 + α 1 ≤ (40481 : ℝ) / 100000 ∧
       (59519 : ℝ) / 100000 ≤ α 1 + α 2 + α 3) := by
  have hlastIff := source_last_order_iff_closed_of_outside_strip
    t γ δ hmove0 hmove hlast
  have h01Iff := source_strict_order_iff_closed_of_outside_strip
    (t 1) (t 0) δ hδ h01
  have h12Iff := source_strict_order_iff_closed_of_outside_strip
    (t 2) (t 1) δ hδ h12
  have h23Iff := source_strict_order_iff_closed_of_outside_strip
    (t 3) (t 2) δ hδ h23
  have hpairIff := source_strict_order_iff_closed_of_outside_strip
    (t 0 + t 1) ((40481 : ℝ) / 100000) δ hδ
    (by simpa only [abs_sub_comm] using hpair)
  have htripleIff := source_strict_order_iff_closed_of_outside_strip
    ((59519 : ℝ) / 100000) (t 1 + t 2 + t 3) δ hδ htriple
  constructor
  · rintro ⟨_, h3, h32, h21, h10, _, hp, hb, hg⟩
    have hβ := hlastIff.mp hg
    have hlower : ∀ i : Fin 5, (9519 : ℝ) / 50000 ≤
        (Fin.snoc (α := fun _ => ℝ) t (1 - ∑ k, t k)) i := by
      rw [Fin.forall_fin_succ']
      simpa only [Fin.snoc_castSucc, Fin.snoc_last] using
        And.intro (fun i => (ht i).1) (h3.trans hβ)
    exact ⟨hlower, h32.le, h21.le, h10.le, hβ, hp.le, hb.le⟩
  · rintro ⟨_, h32, h21, h10, hβ, hp, hb⟩
    have hband := source_final_exponent_mem_compact_band t γ δ
      (fun i => (ht i).1) hmove0 hmove
      (hδsmall.trans_le (min_le_left _ _)) hβ
    have ha : t 0 < (40481 : ℝ) / 100000 := by
      have hp' : t 0 + t 1 ≤ (40481 : ℝ) / 100000 := hp
      linarith only [hp', (ht 1).1]
    exact ⟨hband, (ht 3).1, h23Iff.mpr h32, h12Iff.mpr h21,
      h01Iff.mpr h10, ha, hpairIff.mpr hp, htripleIff.mpr hb, hlastIff.mpr hβ⟩

theorem family_one_finite_cuts_iff_closed_of_outside_strips
    (t : Fin 4 → ℝ) (γ δ : ℝ)
    (ht : ∀ i, (9519 : ℝ) / 50000 ≤ t i ∧ t i ≤ (6 : ℝ) / 25)
    (hmove0 : 0 ≤ γ - (1 - ∑ i, t i))
    (hmove : γ - (1 - ∑ i, t i) ≤ δ)
    (hδ : 0 ≤ δ)
    (hδsmall : δ < min ((19 : ℝ) / 12500) ((481 : ℝ) / 20000))
    (h01 : δ < |t 0 - t 1|)
    (h21 : δ < |t 2 - t 1|)
    (hpair : δ < |t 0 + t 2 - (40481 : ℝ) / 100000|)
    (htriple : δ < |t 0 + t 1 + t 3 - (59519 : ℝ) / 100000|)
    (hlast : δ < |t 0 + t 1 + t 2 + 2 * t 3 - 1|) :
    (let α : Fin 5 → ℝ := Fin.snoc (α := fun _ => ℝ) t γ
     ((9519 : ℝ) / 50000 ≤ γ ∧ γ ≤ (6 : ℝ) / 25) ∧
       (∀ i, (9519 : ℝ) / 50000 ≤ α i ∧
         α i ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
       α 1 < α 0 ∧ α 1 < α 2 ∧ α 0 + α 2 < (40481 : ℝ) / 100000 ∧
       (59519 : ℝ) / 100000 < α 0 + α 1 + α 3 ∧ α 3 ≤ α 4) ↔
    (let α : Fin 5 → ℝ := Fin.snoc (α := fun _ => ℝ) t (1 - ∑ i, t i)
     (∀ i, (9519 : ℝ) / 50000 ≤ α i) ∧
       α 1 ≤ α 0 ∧ α 1 ≤ α 2 ∧ α 3 ≤ α 4 ∧
       α 0 + α 2 ≤ (40481 : ℝ) / 100000 ∧
       (59519 : ℝ) / 100000 ≤ α 0 + α 1 + α 3) := by
  have hlastIff := source_last_order_iff_closed_of_outside_strip
    t γ δ hmove0 hmove hlast
  have h01Iff := source_strict_order_iff_closed_of_outside_strip
    (t 1) (t 0) δ hδ h01
  have h21Iff := source_strict_order_iff_closed_of_outside_strip
    (t 1) (t 2) δ hδ h21
  have hpairIff := source_strict_order_iff_closed_of_outside_strip
    (t 0 + t 2) ((40481 : ℝ) / 100000) δ hδ
    (by simpa only [abs_sub_comm] using hpair)
  have htripleIff := source_strict_order_iff_closed_of_outside_strip
    ((59519 : ℝ) / 100000) (t 0 + t 1 + t 3) δ hδ htriple
  constructor
  · rintro ⟨_, _, h10, h12, hp, hb, hg⟩
    have hβ := hlastIff.mp hg
    have hlower : ∀ i : Fin 5, (9519 : ℝ) / 50000 ≤
        (Fin.snoc (α := fun _ => ℝ) t (1 - ∑ k, t k)) i := by
      rw [Fin.forall_fin_succ']
      simpa only [Fin.snoc_castSucc, Fin.snoc_last] using
        And.intro (fun i => (ht i).1) ((ht 3).1.trans hβ)
    exact ⟨hlower, h10.le, h12.le, hβ, hp.le, hb.le⟩
  · rintro ⟨_, h10, h12, hβ, hp, hb⟩
    have hband := source_final_exponent_mem_compact_band t γ δ
      (fun i => (ht i).1) hmove0 hmove
      (hδsmall.trans_le (min_le_left _ _)) hβ
    have hg := hlastIff.mpr hβ
    have h10' := h01Iff.mpr h10
    have h12' := h21Iff.mpr h12
    have hp' := hpairIff.mpr hp
    have hb' := htripleIff.mpr hb
    have hlower : ∀ i : Fin 5, (9519 : ℝ) / 50000 ≤
        (Fin.snoc (α := fun _ => ℝ) t γ) i := by
      rw [Fin.forall_fin_succ']
      simpa only [Fin.snoc_castSucc, Fin.snoc_last] using
        And.intro (fun i => (ht i).1) hband.1
    have htotal : (∑ i : Fin 5, (Fin.snoc (α := fun _ => ℝ) t γ) i) ≤ 1 + δ := by
      rw [Fin.sum_snoc]
      linarith only [hmove]
    have hupper := family_one_upper_cuts_of_small_total
      (Fin.snoc (α := fun _ => ℝ) t γ) δ hδ
      (hδsmall.trans_le (min_le_right _ _)) hlower htotal h10' h12' hp' hb' hg
    exact ⟨hband, (fun i => ⟨hlower i, (hupper i).le⟩), h10', h12', hp', hb', hg⟩

section
variable {α β ι : Type*}
open Classical in
theorem finite_slice_cut_error
    (slice : Finset β) (P : β → Prop) (R B : Prop)
    (hstable : ¬ B → ∀ q ∈ slice, P q ↔ R) :
    |(∑ q ∈ slice, if P q then (1 : ℝ) else 0) -
        (if R then (slice.card : ℝ) else 0)| ≤
      if B then (slice.card : ℝ) else 0 := by
  have hnonneg : 0 ≤ ∑ q ∈ slice, if P q then (1 : ℝ) else 0 := by
    apply Finset.sum_nonneg
    intro q _
    split_ifs <;> norm_num
  have hupper : (∑ q ∈ slice, if P q then (1 : ℝ) else 0) ≤ slice.card := by
    calc
      _ ≤ ∑ _q ∈ slice, (1 : ℝ) := by
        apply Finset.sum_le_sum
        intro q _
        split_ifs <;> norm_num
      _ = _ := by simp
  by_cases hb : B
  · rw [ite_eq_left hb]
    by_cases hr : R
    · rw [ite_eq_left hr]
      rw [abs_le]
      constructor <;> linarith
    · rw [ite_eq_right hr, sub_zero, abs_of_nonneg hnonneg]
      exact hupper
  · have heq : (∑ q ∈ slice, if P q then (1 : ℝ) else 0) =
        (if R then (slice.card : ℝ) else 0) := by
      calc
        _ = ∑ _q ∈ slice, if R then (1 : ℝ) else 0 := by
          apply Finset.sum_congr rfl
          intro q hq
          simp only [hstable hb q hq]
        _ = _ := by split_ifs <;> simp
    rw [heq, sub_self, abs_zero, ite_eq_right hb]

open Classical in
theorem count_approximation_with_cut_error
    (A C w E L s : ℝ) (R B : Prop)
    (hL : 0 ≤ L) (hw : 0 ≤ w) (hs : s ≤ 1)
    (hcount : |L * C - s * w| ≤ E)
    (hcut : |A - (if R then C else 0)| ≤ if B then C else 0) :
    |L * A - s * (if R then w else 0)| ≤
      2 * E + (if B then w else 0) := by
  have hE : 0 ≤ E := (abs_nonneg _).trans hcount
  have hupper : L * C ≤ w + E := by
    have hcount_upper := (abs_le.mp hcount).2
    have hsw : s * w ≤ w := by
      simpa only [one_mul] using mul_le_mul_of_nonneg_right hs hw
    linarith
  have hleft : |L * A - L * (if R then C else 0)| ≤
      if B then L * C else 0 := by
    rw [← mul_sub, abs_mul, abs_of_nonneg hL]
    calc
      _ ≤ L * (if B then C else 0) := mul_le_mul_of_nonneg_left hcut hL
      _ = _ := by split_ifs <;> simp
  have hright : |L * (if R then C else 0) - s * (if R then w else 0)| ≤ E := by
    by_cases hr : R
    · simpa only [ite_eq_left hr] using hcount
    · simpa only [ite_eq_right hr, mul_zero, sub_self, abs_zero] using hE
  calc
    _ ≤ |L * A - L * (if R then C else 0)| +
        |L * (if R then C else 0) - s * (if R then w else 0)| :=
      abs_sub_le _ _ _
    _ ≤ (if B then L * C else 0) + E := add_le_add hleft hright
    _ ≤ _ := by split_ifs <;> linarith

open Classical in
theorem finite_count_error_by_boundary_mass
    (points : Finset α) (faces : Finset ι)
    (A C w E : α → ℝ) (R B : α → Prop) (boundary : ι → α → Prop)
    (L s : ℝ) (hL : 0 ≤ L) (hs : s ≤ 1)
    (hw : ∀ p ∈ points, 0 ≤ w p)
    (hcount : ∀ p ∈ points, |L * C p - s * w p| ≤ E p)
    (hcut : ∀ p ∈ points,
      |A p - (if R p then C p else 0)| ≤ if B p then C p else 0)
    (hcover : ∀ p ∈ points, B p → ∃ k ∈ faces, boundary k p) :
    |L * (∑ p ∈ points, A p) - s * (∑ p ∈ points, if R p then w p else 0)| ≤
      2 * (∑ p ∈ points, E p) +
        ∑ k ∈ faces, ∑ p ∈ points, if boundary k p then w p else 0 := by
  have hboundary : ∀ p ∈ points,
      (if B p then w p else 0) ≤ ∑ k ∈ faces, if boundary k p then w p else 0 := by
    intro p hp
    have hnonneg : ∀ k ∈ faces, 0 ≤ (if boundary k p then w p else 0) := by
      intro k _
      split_ifs
      · exact hw p hp
      · exact le_refl 0
    by_cases hb : B p
    · obtain ⟨k, hk, hbnd⟩ := hcover p hp hb
      rw [ite_eq_left hb]
      calc
        w p = (if boundary k p then w p else 0) := (ite_eq_left hbnd).symm
        _ ≤ _ := Finset.single_le_sum hnonneg hk
    · rw [ite_eq_right hb]
      exact Finset.sum_nonneg hnonneg
  calc
    _ = |∑ p ∈ points, (L * A p - s * (if R p then w p else 0))| := by
      rw [Finset.sum_sub_distrib, ← Finset.mul_sum, ← Finset.mul_sum]
    _ ≤ ∑ p ∈ points, |L * A p - s * (if R p then w p else 0)| :=
      Finset.abs_sum_le_sum_abs _ _
    _ ≤ ∑ p ∈ points, (2 * E p + ∑ k ∈ faces, if boundary k p then w p else 0) := by
      apply Finset.sum_le_sum
      intro p hp
      exact (count_approximation_with_cut_error (A p) (C p) (w p) (E p) L s
        (R p) (B p) hL (hw p hp) hs (hcount p hp) (hcut p hp)).trans
          (add_le_add (le_refl (2 * E p)) (hboundary p hp))
    _ = _ := by
      rw [Finset.sum_add_distrib, ← Finset.mul_sum, Finset.sum_comm]

open Classical in
theorem finite_slice_count_error_by_boundary_mass
    (points : Finset α) (slice : α → Finset β) (faces : Finset ι)
    (P : α → β → Prop) (R : α → Prop) (boundary : ι → α → Prop)
    (w E : α → ℝ) (L s : ℝ) (hL : 0 ≤ L) (hs : s ≤ 1)
    (hw : ∀ p ∈ points, 0 ≤ w p)
    (hcount : ∀ p ∈ points, |L * ((slice p).card : ℝ) - s * w p| ≤ E p)
    (hstable : ∀ p ∈ points, (∀ k ∈ faces, ¬ boundary k p) →
      ∀ q ∈ slice p, P p q ↔ R p) :
    |L * (∑ p ∈ points, ∑ q ∈ slice p, if P p q then (1 : ℝ) else 0) -
        s * (∑ p ∈ points, if R p then w p else 0)| ≤
      2 * (∑ p ∈ points, E p) +
        ∑ k ∈ faces, ∑ p ∈ points, if boundary k p then w p else 0 := by
  apply finite_count_error_by_boundary_mass points faces
    (fun p => ∑ q ∈ slice p, if P p q then (1 : ℝ) else 0)
    (fun p => ((slice p).card : ℝ)) w E R
    (fun p => ∃ k ∈ faces, boundary k p) boundary L s hL hs hw hcount
  · intro p hp
    apply finite_slice_cut_error
    intro hbad
    apply hstable p hp
    intro k hk hb
    exact hbad ⟨k, hk, hb⟩
  · intro p _ hb
    exact hb

end

/--
The eight normal vectors for the nontrivial affine boundaries of the two exceptional exponent
regions, paired by index with their offsets.
-/
noncomputable def exceptionalBoundaryNormals : Fin 8 → Fin 4 → ℝ :=
  ![![1, -1, 0, 0], ![0, 1, -1, 0], ![0, 0, 1, -1], ![1, 1, 0, 0],
    ![0, 1, 1, 1], ![1, 1, 1, 2], ![1, 0, 1, 0], ![1, 1, 0, 1]]

/--
The offsets paired with the eight exceptional boundary normals; boundary `i` is the hyperplane
where the normal's dot product equals this value.
-/
noncomputable def exceptionalBoundaryOffsets : Fin 8 → ℝ :=
  ![0, 0, 0, 40481 / 100000, 59519 / 100000, 1, 40481 / 100000, 59519 / 100000]

theorem exceptionalBoundaryNormals_ne_zero (i : Fin 8) :
    exceptionalBoundaryNormals i ≠ 0 := by
  intro h
  have hi : exceptionalBoundaryNormals i
      ((![(0 : Fin 4), 1, 2, 0, 1, 0, 0, 0] : Fin 8 → Fin 4) i) = 1 := by
    fin_cases i <;> rfl
  have hz := congrFun h ((![(0 : Fin 4), 1, 2, 0, 1, 0, 0, 0] : Fin 8 → Fin 4) i)
  rw [hi] at hz
  exact one_ne_zero hz

theorem exceptionalBoundaryValues (t : Fin 4 → ℝ) :
    (fun i : Fin 8 => (∑ k, exceptionalBoundaryNormals i k * t k) -
      exceptionalBoundaryOffsets i) =
    ![t 0 - t 1, t 1 - t 2, t 2 - t 3,
      t 0 + t 1 - 40481 / 100000,
      t 1 + t 2 + t 3 - 59519 / 100000,
      t 0 + t 1 + t 2 + 2 * t 3 - 1,
      t 0 + t 2 - 40481 / 100000,
      t 0 + t 1 + t 3 - 59519 / 100000] := by
  funext i
  fin_cases i <;>
    simp [exceptionalBoundaryNormals, exceptionalBoundaryOffsets, Fin.sum_univ_four,
      sub_eq_add_neg]

open Classical in
theorem prime_slice_finite_cuts_iff_closed_of_outside_strips
    (x u v : ℝ) (hx : 1 < x) (hu : 1 ≤ u) (huv : u ≤ v) (hv : v ≤ 2)
    (hsmall : Real.log 2 / Real.log x <
      min ((19 : ℝ) / 12500) ((481 : ℝ) / 20000))
    (j : Fin 2) (p : Fin 4 → ℕ)
    (hp : ∀ i, p i ∈
      (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
        (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime)
    (hout : ∀ i : Fin 8, Real.log 2 / Real.log x <
      |(∑ k, exceptionalBoundaryNormals i k * Real.logb x (p k : ℝ)) -
        exceptionalBoundaryOffsets i|)
    (q : ℕ)
    (hq : q ∈ (Finset.Icc (Nat.ceil (u * x / ((∏ i, p i : ℕ) : ℝ)))
      (Nat.floor (v * x / ((∏ i, p i : ℕ) : ℝ)))).filter Nat.Prime) :
    (let P : Finset ℕ :=
       (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
         (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime
     let p5 : Fin 5 → ℕ := Fin.snoc p q
     let alpha : Fin 5 → ℝ := fun i => Real.logb x (p5 i : ℝ)
     q ∈ P ∧
       (if j.val = 0 then
         (9519 : ℝ) / 50000 ≤ alpha 3 ∧
         alpha 3 < alpha 2 ∧ alpha 2 < alpha 1 ∧ alpha 1 < alpha 0 ∧
         alpha 0 < (40481 : ℝ) / 100000 ∧
         alpha 0 + alpha 1 < (40481 : ℝ) / 100000 ∧
         (59519 : ℝ) / 100000 < alpha 1 + alpha 2 + alpha 3 ∧
         (p5 3 : ℝ) ≤ (p5 4 : ℝ)
       else
         (∀ i, (9519 : ℝ) / 50000 ≤ alpha i ∧
           alpha i ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
         alpha 1 < alpha 0 ∧ alpha 1 < alpha 2 ∧
         alpha 0 + alpha 2 < (40481 : ℝ) / 100000 ∧
         (59519 : ℝ) / 100000 < alpha 0 + alpha 1 + alpha 3 ∧
         alpha 3 ≤ alpha 4)) ↔
    (let t : Fin 4 → ℝ := fun i => Real.logb x (p i : ℝ)
     let alpha : Fin 5 → ℝ := Fin.snoc t (1 - ∑ i, t i)
     (∀ i, (9519 : ℝ) / 50000 ≤ alpha i) ∧
       (if j.val = 0 then
         alpha 3 ≤ alpha 2 ∧ alpha 2 ≤ alpha 1 ∧ alpha 1 ≤ alpha 0 ∧
         alpha 3 ≤ alpha 4 ∧ alpha 0 + alpha 1 ≤ (40481 : ℝ) / 100000 ∧
         (59519 : ℝ) / 100000 ≤ alpha 1 + alpha 2 + alpha 3
       else
         alpha 1 ≤ alpha 0 ∧ alpha 1 ≤ alpha 2 ∧ alpha 3 ≤ alpha 4 ∧
         alpha 0 + alpha 2 ≤ (40481 : ℝ) / 100000 ∧
         (59519 : ℝ) / 100000 ≤ alpha 0 + alpha 1 + alpha 3)) := by
  let t : Fin 4 → ℝ := fun i => Real.logb x (p i : ℝ)
  let gamma : ℝ := Real.logb x (q : ℝ)
  let delta : ℝ := Real.log 2 / Real.log x
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hpos (i : Fin 4) : 0 < (p i : ℝ) :=
    Nat.cast_pos.mpr (Finset.mem_filter.mp (hp i)).2.pos
  have hqprime : q.Prime := (Finset.mem_filter.mp hq).2
  have hqpos : 0 < (q : ℝ) := Nat.cast_pos.mpr hqprime.pos
  have hm : 0 < ∏ i, p i :=
    Finset.prod_pos (fun i _ => (Finset.mem_filter.mp (hp i)).2.pos)
  have hvx : 0 ≤ v * x := mul_nonneg (by linarith) hx0.le
  have hprod : (∏ i, p i) * q ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)) :=
    (mul_mem_closed_nat_interval_iff (∏ i, p i) q hm (u * x) (v * x) hvx).mpr
      (Finset.mem_filter.mp hq).1
  obtain ⟨ht, _, _, _, _, _, _, _, _, hlast, hlo, hhi⟩ :=
    prime_prefix_interval_log_geometry x u v hx hu hv p hp q hprod
  have hmove0 : 0 ≤ gamma - (1 - ∑ i, t i) := by
    dsimp only [gamma, t]
    linarith only [hlast, hlo]
  have hmove : gamma - (1 - ∑ i, t i) ≤ delta := by
    dsimp only [gamma, t, delta]
    linarith only [hlast, hhi]
  have hdelta : 0 ≤ delta :=
    div_nonneg (Real.log_nonneg (by norm_num)) (Real.log_pos hx).le
  have hfaces : ∀ i : Fin 8, delta <
      |(![t 0 - t 1, t 1 - t 2, t 2 - t 3,
          t 0 + t 1 - 40481 / 100000,
          t 1 + t 2 + t 3 - 59519 / 100000,
          t 0 + t 1 + t 2 + 2 * t 3 - 1,
          t 0 + t 2 - 40481 / 100000,
          t 0 + t 1 + t 3 - 59519 / 100000] : Fin 8 → ℝ) i| := by
    rw [← exceptionalBoundaryValues t]
    exact hout
  have hband : q ∈
      (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
        (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime ↔
      (9519 : ℝ) / 50000 ≤ gamma ∧ gamma ≤ (6 : ℝ) / 25 := by
    rw [Finset.mem_filter, Finset.mem_Icc, and_iff_left hqprime,
      Nat.ceil_le, Nat.le_floor_iff (Real.rpow_nonneg hx0.le _),
      Real.le_logb_iff_rpow_le hx hqpos, Real.logb_le_iff_le_rpow hx hqpos]
  have halpha (i : Fin 5) : Real.logb x
      ((Fin.snoc (α := fun _ => ℕ) p q i : ℕ) : ℝ) =
      (Fin.snoc (α := fun _ => ℝ) t gamma) i :=
    congrFun (Fin.comp_snoc (fun n : ℕ => Real.logb x (n : ℝ)) p q) i
  dsimp only
  simp_rw [halpha]
  rw [hband]
  by_cases hj : j.val = 0
  · simp only [ite_eq_left hj]
    change (((9519 : ℝ) / 50000 ≤ gamma ∧ gamma ≤ (6 : ℝ) / 25) ∧
      (9519 : ℝ) / 50000 ≤ t 3 ∧ t 3 < t 2 ∧ t 2 < t 1 ∧ t 1 < t 0 ∧
      t 0 < (40481 : ℝ) / 100000 ∧ t 0 + t 1 < (40481 : ℝ) / 100000 ∧
      (59519 : ℝ) / 100000 < t 1 + t 2 + t 3 ∧ (p 3 : ℝ) ≤ (q : ℝ)) ↔ _
    rw [← Real.logb_le_logb hx (hpos 3) hqpos]
    exact family_zero_finite_cuts_iff_closed_of_outside_strips t gamma delta
      ht hmove0 hmove hdelta hsmall (hfaces 0) (hfaces 1) (hfaces 2)
      (hfaces 3) (hfaces 4) (hfaces 5)
  · simp only [ite_eq_right hj]
    exact family_one_finite_cuts_iff_closed_of_outside_strips t gamma delta
      ht hmove0 hmove hdelta hsmall (hfaces 0)
      (by
        have h12 : delta < |t 1 - t 2| := hfaces 1
        simpa only [abs_sub_comm] using h12) (hfaces 6) (hfaces 7) (hfaces 5)

section
open Real Topology
open Classical in
theorem prime_prefix_compact_geometry
    (x : ℝ) (hx : 1 < x) (p : Fin 4 → ℕ)
    (hp : ∀ i, p i ∈
      (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
        (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime) :
    let t : Fin 4 → ℝ := fun i => Real.logb x (p i : ℝ)
    let M : ℝ := ∏ i, (p i : ℝ)
    (∀ i, (9519 : ℝ) / 50000 ≤ t i ∧ t i ≤ (6 : ℝ) / 25) ∧
      0 < M ∧ M ≤ x ^ ((24 : ℝ) / 25) ∧
      (1 : ℝ) / 25 ≤ 1 - ∑ i, t i ∧ Real.logb x M = ∑ i, t i := by
  let t : Fin 4 → ℝ := fun i => Real.logb x (p i : ℝ)
  let M : ℝ := ∏ i, (p i : ℝ)
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hpos (i : Fin 4) : 0 < (p i : ℝ) :=
    Nat.cast_pos.mpr (Finset.mem_filter.mp (hp i)).2.pos
  have ht : ∀ i, (9519 : ℝ) / 50000 ≤ t i ∧ t i ≤ (6 : ℝ) / 25 := by
    intro i
    have hi := Finset.mem_Icc.mp (Finset.mem_filter.mp (hp i)).1
    constructor
    · exact (Real.le_logb_iff_rpow_le hx (hpos i)).mpr (Nat.ceil_le.mp hi.1)
    · exact (Real.logb_le_iff_le_rpow hx (hpos i)).mpr
        ((Nat.le_floor_iff (Real.rpow_pos_of_pos hx0 _).le).mp hi.2)
  have hMpos : 0 < M := Finset.prod_pos (fun i _ => hpos i)
  have hlog : Real.logb x M = ∑ i, t i :=
    Real.logb_prod Finset.univ (fun i : Fin 4 => (p i : ℝ))
      (fun i _ => (hpos i).ne')
  have hsum : (∑ i, t i) ≤ (24 : ℝ) / 25 := by
    simp only [Fin.sum_univ_four]
    linarith [(ht 0).2, (ht 1).2, (ht 2).2, (ht 3).2]
  have hMhi : M ≤ x ^ ((24 : ℝ) / 25) :=
    (Real.logb_le_iff_le_rpow hx hMpos).mp (by rw [hlog]; exact hsum)
  have hbeta : (1 : ℝ) / 25 ≤ 1 - ∑ i, t i := by linarith
  exact ⟨ht, hMpos, hMhi, hbeta, hlog⟩

open Classical in
theorem exists_closed_final_prime_prefix_error_control :
    ∃ K : ℝ, 0 < K ∧
      ∀ᶠ x : ℝ in Filter.atTop,
        ∀ u v : ℝ, 1 ≤ u → u ≤ v → v ≤ 2 →
          let P : Finset ℕ :=
            (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
              (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime
          let E : (Fin 4 → ℕ) → ℝ := fun p =>
            let M : ℝ := ∏ i, (p i : ℝ)
            let beta : ℝ := 1 - ∑ i, Real.logb x (p i : ℝ)
            Real.log x / x *
                (((Finset.Icc (Nat.ceil (u * x / M)) (Nat.floor (v * x / M))).filter
                  Nat.Prime).card : ℝ) -
              (v - u) * (M * beta)⁻¹
          (∀ p ∈ Fintype.piFinset (fun _ : Fin 4 => P),
            |E p| ≤ K / ((∏ i, (p i : ℝ)) * ((1 : ℝ) / 25) ^ 2 * Real.log x) +
              Real.log x / x) ∧
          (∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => P), |E p|) ≤
            625 * K / Real.log x * (∑ q ∈ P, (q : ℝ)⁻¹) ^ 4 +
              Real.log x / x * (Nat.floor (x ^ ((6 : ℝ) / 25)) : ℝ) ^ 4 := by
  obtain ⟨K, Y, hK, _, hcount⟩ := exists_closed_final_prime_uniform
  refine ⟨K, hK, ?_⟩
  filter_upwards [Filter.eventually_gt_atTop (1 : ℝ),
    (tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 25)).eventually_ge_atTop Y]
      with x hx hYx
  intro u v hu huv hv
  let P : Finset ℕ :=
    (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
      (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime
  let E : (Fin 4 → ℕ) → ℝ := fun p =>
    let M : ℝ := ∏ i, (p i : ℝ)
    let beta : ℝ := 1 - ∑ i, Real.logb x (p i : ℝ)
    Real.log x / x *
        (((Finset.Icc (Nat.ceil (u * x / M)) (Nat.floor (v * x / M))).filter
          Nat.Prime).card : ℝ) -
      (v - u) * (M * beta)⁻¹
  have hpoint : ∀ p ∈ Fintype.piFinset (fun _ : Fin 4 => P),
      |E p| ≤ K / ((∏ i, (p i : ℝ)) * ((1 : ℝ) / 25) ^ 2 * Real.log x) +
        Real.log x / x := by
    intro p hp
    obtain ⟨_, hMpos, hMhi, _, hlog⟩ :=
      prime_prefix_compact_geometry x hx p (Fintype.mem_piFinset.mp hp)
    have hscale : (∏ i, (p i : ℝ)) ≤ x ^ (1 - (1 : ℝ) / 25) := by
      norm_num
      exact hMhi
    simpa only [E, hlog] using
      hcount ((1 : ℝ) / 25) x (∏ i, (p i : ℝ)) u v (by norm_num) hx hYx
        hMpos hscale hu huv hv
  refine ⟨hpoint, ?_⟩
  have hterm (p : Fin 4 → ℕ) :
      K / ((∏ i, (p i : ℝ)) * ((1 : ℝ) / 25) ^ 2 * Real.log x) =
        (625 * K / Real.log x) * (∏ i, (p i : ℝ))⁻¹ := by
    norm_num [div_eq_mul_inv, mul_inv_rev]
    ring
  have hrecip :
      (∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => P), (∏ i, (p i : ℝ))⁻¹) =
        (∑ q ∈ P, (q : ℝ)⁻¹) ^ 4 := by
    simpa only [Finset.prod_inv_distrib] using
      (Finset.sum_pow' P (fun q : ℕ => (q : ℝ)⁻¹) 4).symm
  have hcard : P.card ≤ Nat.floor (x ^ ((6 : ℝ) / 25)) := by
    calc
      P.card ≤ (Finset.Icc 1 (Nat.floor (x ^ ((6 : ℝ) / 25)))).card := by
        apply Finset.card_le_card
        intro q hq
        exact Finset.mem_Icc.mpr ⟨(Finset.mem_filter.mp hq).2.pos,
          (Finset.mem_Icc.mp (Finset.mem_filter.mp hq).1).2⟩
      _ = Nat.floor (x ^ ((6 : ℝ) / 25)) := by simp
  have hcardR : (P.card : ℝ) ≤ (Nat.floor (x ^ ((6 : ℝ) / 25)) : ℝ) := by
    exact_mod_cast hcard
  have hlogpos : 0 < Real.log x := Real.log_pos hx
  have hxpos : 0 < x := zero_lt_one.trans hx
  calc
    _ ≤ ∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => P),
        ((625 * K / Real.log x) * (∏ i, (p i : ℝ))⁻¹ + Real.log x / x) := by
      change (∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => P), |E p|) ≤ _
      apply Finset.sum_le_sum
      intro p hp
      rw [← hterm p]
      exact hpoint p hp
    _ = 625 * K / Real.log x * (∑ q ∈ P, (q : ℝ)⁻¹) ^ 4 +
        Real.log x / x * (P.card : ℝ) ^ 4 := by
      rw [Finset.sum_add_distrib, ← Finset.mul_sum, hrecip]
      simp [mul_comm]
    _ ≤ _ := add_le_add (le_refl _)
      (mul_le_mul_of_nonneg_left (pow_le_pow_left₀ (Nat.cast_nonneg _) hcardR 4)
        (div_nonneg hlogpos.le hxpos.le))

open Classical in
theorem closed_final_prime_prefix_error_uniform :
    ∀ epsilon : ℝ, 0 < epsilon →
      ∀ᶠ x : ℝ in Filter.atTop,
        ∀ u v : ℝ, 1 ≤ u → u ≤ v → v ≤ 2 →
          let P : Finset ℕ :=
            (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
              (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime
          (∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => P),
            |let M : ℝ := ∏ i, (p i : ℝ)
             let beta : ℝ := 1 - ∑ i, Real.logb x (p i : ℝ)
             Real.log x / x *
                 (((Finset.Icc (Nat.ceil (u * x / M)) (Nat.floor (v * x / M))).filter
                   Nat.Prime).card : ℝ) -
               (v - u) * (M * beta)⁻¹|) ≤ epsilon := by
  intro epsilon hepsilon
  obtain ⟨K, _, hcontrol⟩ := exists_closed_final_prime_prefix_error_control
  have hlimit := five_prime_error_envelope (625 * K)
  filter_upwards [hcontrol, hlimit.eventually_le_const hepsilon] with x hx hsmall
  intro u v hu huv hv
  exact ((hx u v hu huv hv).2).trans hsmall

end

section
open Topology

theorem exceptionalPrimeDefect_interval_mass_coefficient :
    ∀ epsilon : ℝ, 0 < epsilon →
      ∀ᶠ x : ℝ in Filter.atTop,
        ∀ (j : Fin 2) (u v : ℝ),
          1 ≤ u → u ≤ v → v ≤ 2 →
            |Real.log x / x *
                (∑ n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)),
                  exceptionalPrimeDefect x j n) -
              (v - u) * exceptionalMassCoefficient j| ≤ epsilon := by
  classical
  intro epsilon hepsilon
  have he4 : 0 < epsilon / 4 := by positivity
  let P (x : ℝ) : Finset ℕ :=
    (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
      (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime
  let w (x : ℝ) (p : Fin 4 → ℕ) : ℝ :=
    ((∏ i, (p i : ℝ)) * (1 - ∑ i, Real.logb x (p i : ℝ)))⁻¹
  let R (j : Fin 2) (x : ℝ) (p : Fin 4 → ℕ) : Prop :=
    let t : Fin 4 → ℝ := fun i => Real.logb x (p i : ℝ)
    let alpha : Fin 5 → ℝ := Fin.snoc t (1 - ∑ i, t i)
    (∀ i, (9519 : ℝ) / 50000 ≤ alpha i) ∧
      (if j.val = 0 then
        alpha 3 ≤ alpha 2 ∧ alpha 2 ≤ alpha 1 ∧ alpha 1 ≤ alpha 0 ∧
        alpha 3 ≤ alpha 4 ∧ alpha 0 + alpha 1 ≤ (40481 : ℝ) / 100000 ∧
        (59519 : ℝ) / 100000 ≤ alpha 1 + alpha 2 + alpha 3
      else
        alpha 1 ≤ alpha 0 ∧ alpha 1 ≤ alpha 2 ∧ alpha 3 ≤ alpha 4 ∧
        alpha 0 + alpha 2 ≤ (40481 : ℝ) / 100000 ∧
        (59519 : ℝ) / 100000 ≤ alpha 0 + alpha 1 + alpha 3)
  let S (j : Fin 2) (x : ℝ) : ℝ :=
    ∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => P x), if R j x p then w x p else 0
  let B (x : ℝ) (i : Fin 8) (p : Fin 4 → ℕ) : Prop :=
    |(∑ k, exceptionalBoundaryNormals i k * Real.logb x (p k : ℝ)) -
      exceptionalBoundaryOffsets i| ≤ Real.log 2 / Real.log x
  let H (x : ℝ) : ℝ := ∑ i : Fin 8,
    ∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => P x), if B x i p then w x p else 0
  have hSlimit (j : Fin 2) : Tendsto (S j) atTop (nhds (exceptionalMassCoefficient j)) := by
    simpa only [S, R, P, w] using exceptionalMassCoefficient_reciprocal_region_tendsto j
  have hHlimit : Tendsto H atTop (nhds 0) := by
    simpa only [H, B, P, w, one_mul] using
      reciprocal_four_weighted_affine_moving_strip_finset_tendsto
        (Finset.univ : Finset (Fin 8)) exceptionalBoundaryNormals
        exceptionalBoundaryOffsets (fun _ => (1 : ℝ))
        (fun i _ => exceptionalBoundaryNormals_ne_zero i) (by intro i _; norm_num)
  have hSsmall : ∀ᶠ x : ℝ in atTop,
      ∀ j : Fin 2, |S j x - exceptionalMassCoefficient j| ≤ epsilon / 4 := by
    apply Filter.eventually_all.mpr
    intro j
    have hdiff : Tendsto (fun x => |S j x - exceptionalMassCoefficient j|)
        atTop (nhds 0) := by
      simpa only [sub_self, abs_zero] using
        ((hSlimit j).sub_const (exceptionalMassCoefficient j)).abs
    exact hdiff.eventually_le_const he4
  have hdelta : Tendsto (fun x : ℝ => Real.log 2 / Real.log x) atTop (nhds 0) :=
    Real.tendsto_log_atTop.const_div_atTop (Real.log 2)
  have hsmall : ∀ᶠ x : ℝ in atTop, Real.log 2 / Real.log x <
      min ((19 : ℝ) / 12500) ((481 : ℝ) / 20000) := by
    filter_upwards [hdelta.eventually_le_const (by norm_num : (0 : ℝ) < 19 / 25000)]
      with x hx
    exact hx.trans_lt (by norm_num)
  filter_upwards [closed_final_prime_prefix_error_uniform (epsilon / 4) he4,
    hHlimit.eventually_le_const he4, hSsmall, hsmall,
    exceptionalPrimeDefect_interval_as_prefix_slice,
    Filter.eventually_gt_atTop (1 : ℝ)] with x hcount hstrip hregion hsmall hslice hx
  intro j u v hu huv hv
  let slice (p : Fin 4 → ℕ) : Finset ℕ :=
    (Finset.Icc (Nat.ceil (u * x / (∏ i, (p i : ℝ))))
      (Nat.floor (v * x / (∏ i, (p i : ℝ))))).filter Nat.Prime
  let E (p : Fin 4 → ℕ) : ℝ :=
    |Real.log x / x * ((slice p).card : ℝ) - (v - u) * w x p|
  let cut (p : Fin 4 → ℕ) (q : ℕ) : Prop :=
    let p5 : Fin 5 → ℕ := Fin.snoc p q
    let alpha : Fin 5 → ℝ := fun i => Real.logb x (p5 i : ℝ)
    q ∈ P x ∧
      (if j.val = 0 then
        (9519 : ℝ) / 50000 ≤ alpha 3 ∧
        alpha 3 < alpha 2 ∧ alpha 2 < alpha 1 ∧ alpha 1 < alpha 0 ∧
        alpha 0 < (40481 : ℝ) / 100000 ∧
        alpha 0 + alpha 1 < (40481 : ℝ) / 100000 ∧
        (59519 : ℝ) / 100000 < alpha 1 + alpha 2 + alpha 3 ∧
        (p5 3 : ℝ) ≤ (p5 4 : ℝ)
      else
        (∀ i, (9519 : ℝ) / 50000 ≤ alpha i ∧
          alpha i ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
        alpha 1 < alpha 0 ∧ alpha 1 < alpha 2 ∧
        alpha 0 + alpha 2 < (40481 : ℝ) / 100000 ∧
        (59519 : ℝ) / 100000 < alpha 0 + alpha 1 + alpha 3 ∧
        alpha 3 ≤ alpha 4)
  have hE : (∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => P x), E p) ≤ epsilon / 4 := by
    simpa only [E, slice, P, w] using hcount u v hu huv hv
  have hw : ∀ p ∈ Fintype.piFinset (fun _ : Fin 4 => P x), 0 ≤ w x p := by
    intro p hp
    obtain ⟨_, hM, _, hbeta, _⟩ :=
      prime_prefix_compact_geometry x hx p (Fintype.mem_piFinset.mp hp)
    exact inv_nonneg.mpr (mul_nonneg hM.le (by linarith))
  have hstable : ∀ p ∈ Fintype.piFinset (fun _ : Fin 4 => P x),
      (∀ i ∈ (Finset.univ : Finset (Fin 8)), ¬ B x i p) →
      ∀ q ∈ slice p, cut p q ↔ R j x p := by
    intro p hp hout q hq
    have hq' : q ∈ (Finset.Icc (Nat.ceil (u * x / ((∏ i, p i : ℕ) : ℝ)))
        (Nat.floor (v * x / ((∏ i, p i : ℕ) : ℝ)))).filter Nat.Prime := by
      simpa only [slice, Nat.cast_prod] using hq
    simpa only [cut, R, P] using
      prime_slice_finite_cuts_iff_closed_of_outside_strips x u v hx hu huv hv hsmall j p
        (Fintype.mem_piFinset.mp hp)
        (fun i => lt_of_not_ge (hout i (Finset.mem_univ i))) q hq'
  have hidentity :
      (∑ n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)),
        exceptionalPrimeDefect x j n) =
      ∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => P x),
        ∑ q ∈ slice p, if cut p q then (1 : ℝ) else 0 := by
    simpa only [P, slice, cut, Nat.cast_prod] using hslice j u v hu huv hv
  have hL : 0 ≤ Real.log x / x :=
    div_nonneg (Real.log_nonneg hx.le) (zero_lt_one.trans hx).le
  have hbound :
      |Real.log x / x *
          (∑ n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)),
            exceptionalPrimeDefect x j n) - (v - u) * S j x| ≤
        2 * (∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => P x), E p) + H x := by
    rw [hidentity]
    convert! finite_slice_count_error_by_boundary_mass
      (Fintype.piFinset (fun _ : Fin 4 => P x)) slice
      (Finset.univ : Finset (Fin 8)) cut (R j x) (B x) (w x) E
      (Real.log x / x) (v - u) hL (by linarith) hw (fun p _ => le_rfl) hstable
  have hscaled : |(v - u) * S j x - (v - u) * exceptionalMassCoefficient j| ≤
      epsilon / 4 := by
    rw [← mul_sub, abs_mul, abs_of_nonneg (sub_nonneg.mpr huv)]
    calc
      _ ≤ (v - u) * (epsilon / 4) :=
        mul_le_mul_of_nonneg_left (hregion j) (sub_nonneg.mpr huv)
      _ ≤ 1 * (epsilon / 4) := mul_le_mul_of_nonneg_right (by linarith) he4.le
      _ = epsilon / 4 := one_mul _
  calc
    _ ≤ |Real.log x / x *
          (∑ n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)),
            exceptionalPrimeDefect x j n) - (v - u) * S j x| +
        |(v - u) * S j x - (v - u) * exceptionalMassCoefficient j| := abs_sub_le _ _ _
    _ ≤ (2 * (∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => P x), E p) + H x) +
        epsilon / 4 := add_le_add hbound hscaled
    _ ≤ epsilon := by linarith

theorem closed_dyadic_prime_count_tendsto :
    Tendsto (fun x : ℝ => Real.log x / x *
      (((Finset.Icc (Nat.ceil x) (Nat.floor (2 * x))).filter Nat.Prime).card : ℝ))
      atTop (nhds 1) := by
  obtain ⟨K, Y, _, _, hcount⟩ := exists_closed_final_prime_uniform
  have hlog : Tendsto (fun x : ℝ => Real.log x / x) atTop (nhds 0) := by
    simpa only [Real.rpow_one] using
      (isLittleO_log_rpow_atTop (by norm_num : (0 : ℝ) < 1)).tendsto_div_nhds_zero
  have herr : Tendsto (fun x : ℝ => K / Real.log x + Real.log x / x)
      atTop (nhds 0) := by
    simpa only [zero_add] using (Real.tendsto_log_atTop.const_div_atTop K).add hlog
  apply Metric.tendsto_nhds.mpr
  intro epsilon hepsilon
  filter_upwards [Filter.eventually_gt_atTop (1 : ℝ),
    Filter.eventually_ge_atTop Y, herr.eventually_le_const (half_pos hepsilon)]
      with x hx hY herror
  have h := hcount 1 x 1 1 2 (by norm_num) hx
    (by simpa only [Real.rpow_one] using hY) (by norm_num)
    (by simp) (by norm_num) (by norm_num) (by norm_num)
  have hbound : |Real.log x / x *
      (((Finset.Icc (Nat.ceil x) (Nat.floor (2 * x))).filter Nat.Prime).card : ℝ) - 1| ≤
      K / Real.log x + Real.log x / x := by
    norm_num at h ⊢
    exact h
  simpa only [Real.dist_eq] using hbound.trans_lt (herror.trans_lt (half_lt_self hepsilon))

theorem exceptionalPrimeDefect_dyadic_mass_tendsto (j : Fin 2) :
    Tendsto (fun x : ℝ => Real.log x / x *
      (∑ n ∈ Finset.Icc (Nat.ceil x) (Nat.floor (2 * x)), exceptionalPrimeDefect x j n))
      atTop (nhds (exceptionalMassCoefficient j)) := by
  apply Metric.tendsto_nhds.mpr
  intro epsilon hepsilon
  filter_upwards [exceptionalPrimeDefect_interval_mass_coefficient
    (epsilon / 2) (half_pos hepsilon)] with x hx
  have h := hx j 1 2 (by norm_num) (by norm_num) (by norm_num)
  have hbound : |Real.log x / x *
      (∑ n ∈ Finset.Icc (Nat.ceil x) (Nat.floor (2 * x)), exceptionalPrimeDefect x j n) -
        exceptionalMassCoefficient j| ≤ epsilon / 2 := by
    norm_num at h ⊢
    exact h
  simpa only [Real.dist_eq] using hbound.trans_lt (half_lt_self hepsilon)

open Classical in
theorem literal_minorant_signed_mean :
    Tendsto
      (fun x : ℝ => Real.log x / x *
        (∑ n ∈ Finset.Icc (Nat.ceil x) (Nat.floor (2 * x)),
          ((if n.Prime then (1 : ℝ) else 0) -
            exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n)))
      atTop (nhds (1 - (exceptionalMassCoefficient 0 + exceptionalMassCoefficient 1))) := by
  have hprime : Tendsto (fun x : ℝ => Real.log x / x *
      (∑ n ∈ Finset.Icc (Nat.ceil x) (Nat.floor (2 * x)),
        if n.Prime then (1 : ℝ) else 0)) atTop (nhds 1) := by
    simpa only [Finset.sum_boole] using closed_dyadic_prime_count_tendsto
  convert (hprime.sub (exceptionalPrimeDefect_dyadic_mass_tendsto 0)).sub
    (exceptionalPrimeDefect_dyadic_mass_tendsto 1) using 1
  · funext x
    simp only [Finset.sum_sub_distrib, mul_sub]
  · congr 1
    ring

end

section
open Set

theorem standardFourSimplex_volume :
    volume {x : Fin 4 → ℝ | (∀ i, 0 ≤ x i) ∧ ∑ i, x i ≤ 1} =
      ENNReal.ofReal (1 / 24 : ℝ) := by
  have hnull : volume {x : Fin 4 → ℝ | ∑ i, x i = 1} = 0 := by
    simpa only [one_mul] using
      affine_hyperplane_null (fun _ => 1) 1 ⟨0, one_ne_zero⟩
  have hne : ∀ᵐ x : Fin 4 → ℝ ∂volume, ∑ i, x i ≠ 1 := by
    simpa only [ae_iff, not_not] using hnull
  have hset :
      {x : Fin 4 → ℝ | (∀ i, 0 ≤ x i) ∧ ∑ i, x i ≤ 1} =ᵐ[volume]
        (Icc (fun _ : Fin 4 => (0 : ℝ)) (fun _ => (1 : ℝ)) ∩
          {x | (0 : ℝ) ≤ ∑ i, x i ∧ ∑ i, x i < 1} : Set (Fin 4 → ℝ)) := by
    filter_upwards [hne] with x hx
    apply propext
    constructor
    · intro h
      refine ⟨⟨h.1, ?_⟩, Finset.sum_nonneg (fun i _ => h.1 i),
        lt_of_le_of_ne h.2 hx⟩
      intro i
      exact (Finset.single_le_sum (fun j _ => h.1 j) (Finset.mem_univ i)).trans h.2
    · intro h
      exact ⟨h.1.1, h.2.2.le⟩
  rw [measure_congr hset]
  have hcarry := unitCube_carry_eq_forwardDifference 4 0 (by norm_num)
  norm_num [Function.iterate_succ_apply', fwdDiff] at hcarry
  exact hcarry

open scoped Matrix
/--
The seven four-dimensional rational vertices used for the first minorant-region simplex
decomposition.
-/
noncomputable def minorantVertices1 : Fin 7 → (Fin 4 → ℝ) :=
  ![![-1/3, -1/3, -1/3, -1/3],
    ![0, 0, 0, 0],
    ![1/2, 1/2, -3/4, -3/4],
    ![1/2, 1/2, -1/3, -1/3],
    ![1/2, 1/2, 1/2, -2],
    ![1/2, 1/2, 1/2, -3/4],
    ![4/3, -1/3, -1/3, -1/3]]

/--
The seven four-dimensional rational vertices used for the second minorant-region simplex
decomposition.
-/
noncomputable def minorantVertices2 : Fin 7 → (Fin 4 → ℝ) :=
  ![![-2, -2, -2, 3],
    ![-1/3, -1/3, 4/3, -1/3],
    ![1/2, -2, 1/2, 1/2],
    ![1/2, 1/2, 1/2, -2],
    ![1/2, 1/2, 1/2, -3/4],
    ![3, -2, -2, -2],
    ![3, -2, -2, 1/2]]

/--
The five vertex indices of each of the three four-dimensional simplices in the first
decomposition, referring to the first vertex array.
-/
def minorantSimplexIndices1 : Fin 3 → (Fin 5 → Fin 7) :=
  ![![0, 1, 3, 5, 6], ![0, 2, 3, 5, 6], ![0, 2, 4, 5, 6]]

/--
The five vertex indices of each of the three four-dimensional simplices in the second
decomposition, referring to the second vertex array.
-/
def minorantSimplexIndices2 : Fin 3 → (Fin 5 → Fin 7) :=
  ![![0, 1, 2, 5, 6], ![0, 1, 3, 4, 6], ![0, 1, 3, 5, 6]]

theorem convexHull_five_eq_affine_image (v : Fin 5 → (Fin 4 → ℝ)) :
    convexHull ℝ (Set.range v) =
      (fun u : Fin 4 → ℝ =>
        v 0 + (fun r c : Fin 4 => v c.succ r - v 0 r) *ᵥ u) ''
        {u | (∀ i, 0 ≤ u i) ∧ (∑ i, u i) ≤ 1} := by
  classical
  let M : Matrix (Fin 4) (Fin 4) ℝ := fun r c => v c.succ r - v 0 r
  let D : Set (Fin 4 → ℝ) := {u | (∀ i, 0 ≤ u i) ∧ (∑ i, u i) ≤ 1}
  let f : (Fin 4 → ℝ) →ᵃ[ℝ] (Fin 4 → ℝ) :=
    AffineMap.const ℝ (Fin 4 → ℝ) (v 0) + (Matrix.toLin' M).toAffineMap
  have hD : Convex ℝ D := by
    intro x hx y hy a b ha hb hab
    refine ⟨fun i => ?_, ?_⟩
    · change 0 ≤ a * x i + b * y i
      exact add_nonneg (mul_nonneg ha (hx.1 i)) (mul_nonneg hb (hy.1 i))
    · change (∑ i, (a * x i + b * y i)) ≤ 1
      rw [Finset.sum_add_distrib, ← Finset.mul_sum, ← Finset.mul_sum]
      calc
        a * (∑ i, x i) + b * (∑ i, y i) ≤ a * 1 + b * 1 :=
          add_le_add (mul_le_mul_of_nonneg_left hx.2 ha)
            (mul_le_mul_of_nonneg_left hy.2 hb)
        _ = 1 := by simpa using hab
  change convexHull ℝ (Set.range v) = f '' D
  refine Set.Subset.antisymm (convexHull_min ?_ (hD.affine_image f)) ?_
  · rintro _ ⟨i, rfl⟩
    refine Fin.cases ?_ (fun j => ?_) i
    · refine ⟨0, ⟨fun _ => le_rfl, by simp⟩, ?_⟩
      simp [f]
    · refine ⟨Pi.single j 1, ⟨?_, ?_⟩, ?_⟩
      · exact (Pi.single_nonneg (α := fun _ : Fin 4 => ℝ) (i := j)
          (a := (1 : ℝ))).2 (zero_le_one : (0 : ℝ) ≤ 1)
      · simpa only [Fintype.sum_pi_single'] using (le_rfl : (1 : ℝ) ≤ 1)
      · change v 0 + M *ᵥ Pi.single j 1 = v j.succ
        rw [Matrix.mulVec_single_one]
        ext r
        change v 0 r + (v j.succ r - v 0 r) = v j.succ r
        ring
  · rintro _ ⟨u, hu, rfl⟩
    refine mem_convexHull_of_exists_fintype
      (Fin.cons (1 - ∑ i, u i) u) v ?_ ?_ (fun i => Set.mem_range_self i) ?_
    · intro i
      refine Fin.cases ?_ (fun j => ?_) i
      · exact sub_nonneg.mpr hu.2
      · exact hu.1 j
    · simp
    · change
        (∑ i : Fin 5, (Fin.cons (1 - ∑ j, u j) u : Fin 5 → ℝ) i • v i) =
          v 0 + (Matrix.toLin' M) u
      rw [Matrix.toLin'_apply]
      ext r
      simp only [Finset.sum_apply, Pi.smul_apply, smul_eq_mul, Pi.add_apply]
      change
        (∑ i : Fin 5, (Fin.cons (1 - ∑ j, u j) u : Fin 5 → ℝ) i * v i r) =
          v 0 r + ∑ j : Fin 4, (v j.succ r - v 0 r) * u j
      simp [Fin.sum_univ_succ]
      ring

theorem volume_convexHull_five (v : Fin 5 → (Fin 4 → ℝ)) :
    volume (convexHull ℝ (Set.range v)) =
      ENNReal.ofReal |Matrix.det (fun r c : Fin 4 => v c.succ r - v 0 r)| / 24 := by
  let M : Matrix (Fin 4) (Fin 4) ℝ := fun r c => v c.succ r - v 0 r
  let D : Set (Fin 4 → ℝ) := {u | (∀ i, 0 ≤ u i) ∧ (∑ i, u i) ≤ 1}
  rw [convexHull_five_eq_affine_image]
  change volume ((fun u : Fin 4 → ℝ => v 0 + M *ᵥ u) '' D) =
    ENNReal.ofReal |Matrix.det M| / 24
  calc
    volume ((fun u : Fin 4 → ℝ => v 0 + M *ᵥ u) '' D) =
        volume ((fun y : Fin 4 → ℝ => v 0 + y) '' ((Matrix.toLin' M) '' D)) := by
      rw [← Set.image_comp]
      rfl
    _ = volume ((Matrix.toLin' M) '' D) := by
      rw [Set.image_add_left, measure_preimage_add]
    _ = ENNReal.ofReal |Matrix.det M| * volume D := by
      simpa only [LinearMap.det_toLin'] using
        (Measure.addHaar_image_linearMap (volume : Measure (Fin 4 → ℝ))
          (Matrix.toLin' M) D)
    _ = ENNReal.ofReal |Matrix.det M| / 24 := by
      have hD : volume D = (1 : ℝ≥0∞) / 24 := by
        simpa only [ENNReal.ofReal_div_of_pos (by norm_num : 0 < (24 : ℝ)),
          ENNReal.ofReal_one, ENNReal.ofReal_ofNat] using
          standardFourSimplex_volume
      rw [hD]
      simp [div_eq_mul_inv]

theorem minorantSimplex1_edge_det (j : Fin 3) :
    let v : Fin 5 → (Fin 4 → ℝ) := fun k =>
      minorantVertices1 (minorantSimplexIndices1 j k)
    Matrix.det (fun r c : Fin 4 => v c.succ r - v 0 r) =
      (![-125/216, 625/864, -625/288] : Fin 3 → ℝ) j := by
  let M : Matrix (Fin 4) (Fin 4) ℝ := Matrix.of fun r c =>
    minorantVertices1 (minorantSimplexIndices1 j c.succ) r -
      minorantVertices1 (minorantSimplexIndices1 j 0) r
  change Matrix.det M = _
  rw [Matrix.det_succ_column M (3 : Fin 4)]
  simp only [Fin.sum_univ_succ, Matrix.det_fin_three, Matrix.submatrix_apply]
  fin_cases j <;> norm_num [M, minorantVertices1, minorantSimplexIndices1,
    Matrix.of_apply, Fin.succAbove, Fin.lt_def, Fin.succ, Fin.castSucc, Fin.castAdd,
    Fin.castLE] <;> simp only [Matrix.cons_val] <;> norm_num

theorem minorantSimplex2_edge_det (j : Fin 3) :
    let v : Fin 5 → (Fin 4 → ℝ) := fun k =>
      minorantVertices2 (minorantSimplexIndices2 j k)
    Matrix.det (fun r c : Fin 4 => v c.succ r - v 0 r) =
      (![625/12, 625/24, -625/12] : Fin 3 → ℝ) j := by
  let M : Matrix (Fin 4) (Fin 4) ℝ := Matrix.of fun r c =>
    minorantVertices2 (minorantSimplexIndices2 j c.succ) r -
      minorantVertices2 (minorantSimplexIndices2 j 0) r
  change Matrix.det M = _
  rw [Matrix.det_succ_column M (3 : Fin 4)]
  simp only [Fin.sum_univ_succ, Matrix.det_fin_three, Matrix.submatrix_apply]
  fin_cases j <;> norm_num [M, minorantVertices2, minorantSimplexIndices2,
    Matrix.of_apply, Fin.succAbove, Fin.lt_def, Fin.succ, Fin.castSucc, Fin.castAdd,
    Fin.castLE] <;> simp only [Matrix.cons_val] <;> norm_num

theorem minorantSimplex1_volume (j : Fin 3) :
    volume (convexHull ℝ (Set.range fun k : Fin 5 =>
      minorantVertices1 (minorantSimplexIndices1 j k))) =
      (![125/5184, 625/20736, 625/6912] : Fin 3 → ℝ≥0∞) j := by
  rw [volume_convexHull_five]
  have hd := minorantSimplex1_edge_det j
  dsimp only at hd
  rw [hd]
  fin_cases j <;> simp only [Matrix.cons_val, Fin.reduceFinMk]
  all_goals
    apply (ENNReal.toReal_eq_toReal_iff' (by finiteness) (by finiteness)).mp
    norm_num

theorem minorantSimplex2_volume (j : Fin 3) :
    volume (convexHull ℝ (Set.range fun k : Fin 5 =>
      minorantVertices2 (minorantSimplexIndices2 j k))) =
      (![625/288, 625/576, 625/288] : Fin 3 → ℝ≥0∞) j := by
  rw [volume_convexHull_five]
  have hd := minorantSimplex2_edge_det j
  dsimp only at hd
  rw [hd]
  fin_cases j <;> simp only [Matrix.cons_val, Fin.reduceFinMk]
  all_goals
    apply (ENNReal.toReal_eq_toReal_iff' (by finiteness) (by finiteness)).mp
    norm_num

end

section
open Set

theorem volume_affine_rescale_four (b : Fin 4 → ℝ) (c : ℝ) (hc : 0 ≤ c)
    (S : Set (Fin 4 → ℝ)) :
    volume ((fun z => b + c • z) '' S) = ENNReal.ofReal (c ^ 4) * volume S := by
  have himage : (fun z => b + c • z) '' S = (fun y => b + y) '' (c • S) := by
    rw [← Set.image_smul, Set.image_image]
  rw [himage, Set.image_add_left, measure_preimage_add]
  simpa using Measure.addHaar_smul_of_nonneg
    (volume : Measure (Fin 4 → ℝ)) hc S

theorem volume_sourceAlpha_image (S : Set (Fin 4 → ℝ)) :
    volume ((fun z : Fin 4 → ℝ => fun i =>
      (1 / 5 : ℝ) + (481 / 100000 : ℝ) * z i) '' S) =
        ENNReal.ofReal ((481 / 100000 : ℝ) ^ 4) * volume S := by
  have hfun : (fun z : Fin 4 → ℝ =>
      (fun _ => (1 / 5 : ℝ)) + (481 / 100000 : ℝ) • z) =
      (fun z : Fin 4 → ℝ => fun i => (1 / 5 : ℝ) + (481 / 100000 : ℝ) * z i) := by
    funext z i
    rfl
  rw [← hfun]
  exact volume_affine_rescale_four (fun _ => (1 / 5 : ℝ))
    (481 / 100000) (by norm_num) S

theorem volume_real_sourceAlpha_image (S : Set (Fin 4 → ℝ)) :
    volume.real ((fun z : Fin 4 → ℝ => fun i =>
      (1 / 5 : ℝ) + (481 / 100000 : ℝ) * z i) '' S) =
        (481 / 100000 : ℝ) ^ 4 * volume.real S := by
  simp only [measureReal_def, volume_sourceAlpha_image, ENNReal.toReal_mul,
    ENNReal.toReal_ofReal (by positivity : 0 ≤ (481 / 100000 : ℝ) ^ 4)]

theorem convex_minorant_halfspaces1 :
    Convex ℝ {z : Fin 4 → ℝ | (∀ j, -2 ≤ z j) ∧ -2 ≤ -(∑ j, z j) ∧
      z 1 ≤ z 0 ∧ z 2 ≤ z 1 ∧ z 3 ≤ z 2 ∧
      z 3 ≤ -(∑ j, z j) ∧ z 0 + z 1 ≤ 1 ∧
      -1 ≤ z 1 + z 2 + z 3} := by
  intro x hx y hy a b ha hb hab
  simp only [Set.mem_ofPred_eq, Pi.add_apply, Pi.smul_apply,
    smul_eq_mul] at hx hy ⊢
  rcases hx with ⟨hx, hxsum, hx10, hx21, hx32, hx3, hx01, hx123⟩
  rcases hy with ⟨hy, hysum, hy10, hy21, hy32, hy3, hy01, hy123⟩
  have hmix {p q r s : ℝ} (hp : p ≤ q) (hr : r ≤ s) :
      a * p + b * r ≤ a * q + b * s :=
    add_le_add (mul_le_mul_of_nonneg_left hp ha) (mul_le_mul_of_nonneg_left hr hb)
  refine ⟨?_, ?_, hmix hx10 hy10, hmix hx21 hy21, hmix hx32 hy32, ?_, ?_, ?_⟩
  · intro j
    have h := hmix (hx j) (hy j)
    nlinarith only [h, hab]
  · have h := hmix hxsum hysum
    simp [Fin.sum_univ_succ] at h ⊢
    nlinarith only [h, hab]
  · have h := hmix hx3 hy3
    simp [Fin.sum_univ_succ] at h ⊢
    nlinarith only [h, hab]
  · have h := hmix hx01 hy01
    nlinarith only [h, hab]
  · have h := hmix hx123 hy123
    nlinarith only [h, hab]

theorem minorantVertices1_mem_halfspaces (i : Fin 7) :
    minorantVertices1 i ∈ {z : Fin 4 → ℝ | (∀ j, -2 ≤ z j) ∧ -2 ≤ -(∑ j, z j) ∧
      z 1 ≤ z 0 ∧ z 2 ≤ z 1 ∧ z 3 ≤ z 2 ∧
      z 3 ≤ -(∑ j, z j) ∧ z 0 + z 1 ≤ 1 ∧
      -1 ≤ z 1 + z 2 + z 3} := by
  fin_cases i
  all_goals
    norm_num [minorantVertices1, Fin.forall_fin_succ, Fin.sum_univ_succ,
      Matrix.cons_val_two, Matrix.cons_val_three, Matrix.vecHead, Matrix.vecTail]

theorem minorant_simplex1_subset_halfspaces (j : Fin 3) :
    convexHull ℝ (Set.range fun k : Fin 5 =>
      minorantVertices1 (minorantSimplexIndices1 j k)) ⊆
      {z : Fin 4 → ℝ | (∀ j, -2 ≤ z j) ∧ -2 ≤ -(∑ j, z j) ∧
      z 1 ≤ z 0 ∧ z 2 ≤ z 1 ∧ z 3 ≤ z 2 ∧
      z 3 ≤ -(∑ j, z j) ∧ z 0 + z 1 ≤ 1 ∧
      -1 ≤ z 1 + z 2 + z 3} := by
  refine convexHull_min ?_ convex_minorant_halfspaces1
  rintro _ ⟨k, rfl⟩
  exact minorantVertices1_mem_halfspaces _

theorem minorant_halfspaces1_eq_iUnion :
    {z : Fin 4 → ℝ | (∀ j, -2 ≤ z j) ∧ -2 ≤ -(∑ j, z j) ∧
      z 1 ≤ z 0 ∧ z 2 ≤ z 1 ∧ z 3 ≤ z 2 ∧
      z 3 ≤ -(∑ j, z j) ∧ z 0 + z 1 ≤ 1 ∧
      -1 ≤ z 1 + z 2 + z 3} =
      ⋃ j : Fin 3, convexHull ℝ (Set.range fun k : Fin 5 =>
      minorantVertices1 (minorantSimplexIndices1 j k)) := by
  apply Set.Subset.antisymm
  · intro z hz
    simp only [Set.mem_iUnion]
    rcases hz with ⟨_, _, h10, h21, h32, h3, h01, h123⟩
    have hL : 0 ≤ -z 0 - z 1 - z 2 - 2 * z 3 := by
      have h := h3
      simp [Fin.sum_univ_succ] at h
      linarith
    have hR : 0 ≤ 1 - z 0 - z 1 := by linarith
    have hT : 0 ≤ 1 + z 1 + z 2 + z 3 := by linarith
    by_cases hA : 0 ≤ 1 + z 2 + 2 * z 3
    · refine ⟨0, ?_⟩
      apply mem_convexHull_of_exists_fintype
        (![3 * (-z 0 - z 1 - z 2 - 2 * z 3) / 5,
          1 + z 2 + 2 * z 3, 6 * (z 1 - z 2) / 5,
          4 * (z 2 - z 3) / 5, 3 * (z 0 - z 1) / 5] : Fin 5 → ℝ)
        (fun k => minorantVertices1 (minorantSimplexIndices1 0 k))
      · intro k
        fin_cases k <;> norm_num <;> linarith
      · norm_num [Fin.sum_univ_succ]
        ring
      · intro k
        exact Set.mem_range_self k
      · ext r
        fin_cases r
        all_goals
          simp [Fin.sum_univ_succ, minorantVertices1, minorantSimplexIndices1,
            Pi.smul_apply, smul_eq_mul]
          ring
    · have hA' : 1 + z 2 + 2 * z 3 ≤ 0 := le_of_lt (lt_of_not_ge hA)
      by_cases hB : 0 ≤ 1 + z 1 + 2 * z 3
      · refine ⟨1, ?_⟩
        apply mem_convexHull_of_exists_fintype
          (![3 * (1 - z 0 - z 1) / 5, -4 * (1 + z 2 + 2 * z 3) / 5,
            6 * (1 + z 1 + 2 * z 3) / 5, 4 * (z 2 - z 3) / 5,
            3 * (z 0 - z 1) / 5] : Fin 5 → ℝ)
          (fun k => minorantVertices1 (minorantSimplexIndices1 1 k))
        · intro k
          fin_cases k <;> norm_num <;> linarith
        · norm_num [Fin.sum_univ_succ]
          ring
        · intro k
          exact Set.mem_range_self k
        · ext r
          fin_cases r
          all_goals
            simp [Fin.sum_univ_succ, minorantVertices1, minorantSimplexIndices1,
              Pi.smul_apply, smul_eq_mul]
            ring
      · have hB' : 1 + z 1 + 2 * z 3 ≤ 0 := le_of_lt (lt_of_not_ge hB)
        refine ⟨2, ?_⟩
        apply mem_convexHull_of_exists_fintype
          (![3 * (1 - z 0 - z 1) / 5, 4 * (z 1 - z 2) / 5,
            -2 * (1 + z 1 + 2 * z 3) / 5, 4 * (1 + z 1 + z 2 + z 3) / 5,
            3 * (z 0 - z 1) / 5] : Fin 5 → ℝ)
          (fun k => minorantVertices1 (minorantSimplexIndices1 2 k))
        · intro k
          fin_cases k <;> norm_num <;> linarith
        · norm_num [Fin.sum_univ_succ]
          ring
        · intro k
          exact Set.mem_range_self k
        · ext r
          fin_cases r
          all_goals
            simp [Fin.sum_univ_succ, minorantVertices1, minorantSimplexIndices1,
              Pi.smul_apply, smul_eq_mul]
            ring
  · intro z hz
    rcases Set.mem_iUnion.mp hz with ⟨j, hj⟩
    exact minorant_simplex1_subset_halfspaces j hj

theorem convex_minorant_halfspaces2 :
    Convex ℝ {z : Fin 4 → ℝ | (∀ j, -2 ≤ z j) ∧ -2 ≤ -(∑ j, z j) ∧
      z 1 ≤ z 0 ∧ z 1 ≤ z 2 ∧ z 3 ≤ -(∑ j, z j) ∧
      z 0 + z 2 ≤ 1 ∧ -1 ≤ z 0 + z 1 + z 3} := by
  rw [convex_iff_add_mem]
  intro x hx y hy a b ha hb hab
  rcases hx with ⟨hxl, hxe, hx01, hx12, hxd, hx02, hx013⟩
  rcases hy with ⟨hyl, hye, hy01, hy12, hyd, hy02, hy013⟩
  simp only [Set.mem_ofPred_eq, Pi.add_apply, Pi.smul_apply,
    smul_eq_mul, Finset.sum_add_distrib, ← Finset.mul_sum]
  refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_⟩
  · intro j
    nlinarith only [hab, mul_le_mul_of_nonneg_left (hxl j) ha,
      mul_le_mul_of_nonneg_left (hyl j) hb]
  · nlinarith only [hab, mul_le_mul_of_nonneg_left hxe ha,
      mul_le_mul_of_nonneg_left hye hb]
  · nlinarith only [mul_le_mul_of_nonneg_left hx01 ha,
      mul_le_mul_of_nonneg_left hy01 hb]
  · nlinarith only [mul_le_mul_of_nonneg_left hx12 ha,
      mul_le_mul_of_nonneg_left hy12 hb]
  · nlinarith only [mul_le_mul_of_nonneg_left hxd ha,
      mul_le_mul_of_nonneg_left hyd hb]
  · nlinarith only [hab, mul_le_mul_of_nonneg_left hx02 ha,
      mul_le_mul_of_nonneg_left hy02 hb]
  · nlinarith only [hab, mul_le_mul_of_nonneg_left hx013 ha,
      mul_le_mul_of_nonneg_left hy013 hb]

theorem minorantVertices2_mem_halfspaces (i : Fin 7) :
    minorantVertices2 i ∈ {z : Fin 4 → ℝ | (∀ j, -2 ≤ z j) ∧ -2 ≤ -(∑ j, z j) ∧
      z 1 ≤ z 0 ∧ z 1 ≤ z 2 ∧ z 3 ≤ -(∑ j, z j) ∧
      z 0 + z 2 ≤ 1 ∧ -1 ≤ z 0 + z 1 + z 3} := by
  fin_cases i
  all_goals
    norm_num [minorantVertices2, Fin.forall_fin_succ, Fin.sum_univ_succ,
      Matrix.cons_val_two, Matrix.cons_val_three, Matrix.vecHead, Matrix.vecTail]

theorem minorant_simplex2_subset_halfspaces (j : Fin 3) :
    convexHull ℝ (Set.range fun k : Fin 5 =>
      minorantVertices2 (minorantSimplexIndices2 j k)) ⊆
      {z : Fin 4 → ℝ | (∀ j, -2 ≤ z j) ∧ -2 ≤ -(∑ j, z j) ∧
      z 1 ≤ z 0 ∧ z 1 ≤ z 2 ∧ z 3 ≤ -(∑ j, z j) ∧
      z 0 + z 2 ≤ 1 ∧ -1 ≤ z 0 + z 1 + z 3} := by
  refine convexHull_min ?_ convex_minorant_halfspaces2
  rintro _ ⟨k, rfl⟩
  exact minorantVertices2_mem_halfspaces _

theorem minorant_halfspaces2_eq_iUnion :
    {z : Fin 4 → ℝ | (∀ j, -2 ≤ z j) ∧ -2 ≤ -(∑ j, z j) ∧
      z 1 ≤ z 0 ∧ z 1 ≤ z 2 ∧ z 3 ≤ -(∑ j, z j) ∧
      z 0 + z 2 ≤ 1 ∧ -1 ≤ z 0 + z 1 + z 3} =
      ⋃ j : Fin 3, convexHull ℝ (Set.range fun k : Fin 5 =>
      minorantVertices2 (minorantSimplexIndices2 j k)) := by
  classical
  apply Set.Subset.antisymm
  · intro z hz
    rcases hz with ⟨hzl, _, hz01, hz12, hzd, hz02, hz013⟩
    have hL : 0 ≤ -z 0 - z 1 - z 2 - 2 * z 3 := by
      simp [Fin.sum_univ_succ] at hzd
      linarith
    have hR : 0 ≤ 1 - z 0 - z 2 := by linarith
    have hT : 0 ≤ 1 + z 0 + z 1 + z 3 := by linarith
    have hb : 0 ≤ z 1 + 2 := by linarith [hzl 1]
    have hab : 0 ≤ z 0 - z 1 := by linarith
    have hcb : 0 ≤ z 2 - z 1 := by linarith
    by_cases hU : 0 ≤ z 2 - 2 * z 1 - 2
    · apply Set.mem_iUnion.mpr
      refine ⟨0, ?_⟩
      refine mem_convexHull_of_exists_fintype
        (![(1 - z 0 - z 2) / 5, 3 * (z 1 + 2) / 5,
          2 * (z 2 - 2 * z 1 - 2) / 5,
          (-z 0 - z 1 - z 2 - 2 * z 3) / 5,
          2 * (1 + z 0 + z 1 + z 3) / 5] : Fin 5 → ℝ)
        (fun k => minorantVertices2 (minorantSimplexIndices2 0 k)) ?_ ?_ ?_ ?_
      · intro k
        fin_cases k <;> dsimp <;> linarith
      · simp [Fin.sum_univ_succ]
        ring
      · intro k
        exact Set.mem_range_self k
      · ext k
        fin_cases k <;>
          simp [Fin.sum_univ_succ, minorantVertices2, minorantSimplexIndices2,
            Pi.smul_apply, smul_eq_mul] <;> ring
    · by_cases hV : 0 ≤ 2 + z 0 + 3 * z 1 + 2 * z 3
      · apply Set.mem_iUnion.mpr
        refine ⟨1, ?_⟩
        refine mem_convexHull_of_exists_fintype
          (![(1 - z 0 - z 2) / 5, 3 * (z 2 - z 1) / 5,
            2 * (-z 0 - z 1 - z 2 - 2 * z 3) / 5,
            2 * (2 + z 0 + 3 * z 1 + 2 * z 3) / 5,
            (z 0 - z 1) / 5] : Fin 5 → ℝ)
          (fun k => minorantVertices2 (minorantSimplexIndices2 1 k)) ?_ ?_ ?_ ?_
        · intro k
          fin_cases k <;> dsimp <;> linarith
        · simp [Fin.sum_univ_succ]
          ring
        · intro k
          exact Set.mem_range_self k
        · ext k
          fin_cases k <;>
            simp [Fin.sum_univ_succ, minorantVertices2, minorantSimplexIndices2,
              Pi.smul_apply, smul_eq_mul] <;> ring
      · have hUn : z 2 - 2 * z 1 - 2 ≤ 0 := le_of_lt (lt_of_not_ge hU)
        have hVn : 2 + z 0 + 3 * z 1 + 2 * z 3 ≤ 0 := le_of_lt (lt_of_not_ge hV)
        apply Set.mem_iUnion.mpr
        refine ⟨2, ?_⟩
        refine mem_convexHull_of_exists_fintype
          (![(1 - z 0 - z 2) / 5, 3 * (z 2 - z 1) / 5,
            -2 * (z 2 - 2 * z 1 - 2) / 5,
            -(2 + z 0 + 3 * z 1 + 2 * z 3) / 5,
            2 * (1 + z 0 + z 1 + z 3) / 5] : Fin 5 → ℝ)
          (fun k => minorantVertices2 (minorantSimplexIndices2 2 k)) ?_ ?_ ?_ ?_
        · intro k
          fin_cases k <;> dsimp <;> linarith
        · simp [Fin.sum_univ_succ]
          ring
        · intro k
          exact Set.mem_range_self k
        · ext k
          fin_cases k <;>
            simp [Fin.sum_univ_succ, minorantVertices2, minorantSimplexIndices2,
              Pi.smul_apply, smul_eq_mul] <;> ring
  · intro z hz
    rcases Set.mem_iUnion.mp hz with ⟨j, hj⟩
    exact minorant_simplex2_subset_halfspaces j hj

theorem minorant_simplex1_pairwise_aedisjoint :
    Pairwise (fun i j : Fin 3 =>
      AEDisjoint (volume : Measure (Fin 4 → ℝ))
        (convexHull ℝ (Set.range fun k : Fin 5 =>
        minorantVertices1 (minorantSimplexIndices1 i k)))
        (convexHull ℝ (Set.range fun k : Fin 5 =>
        minorantVertices1 (minorantSimplexIndices1 j k)))) := by
  let S : Fin 3 → Set (Fin 4 → ℝ) := fun j =>
    convexHull ℝ (Set.range fun k : Fin 5 =>
        minorantVertices1 (minorantSimplexIndices1 j k))
  change Pairwise (fun i j : Fin 3 => AEDisjoint volume (S i) (S j))
  let A : (Fin 4 → ℝ) →ᵃ[ℝ] ℝ := AffineMap.const ℝ (Fin 4 → ℝ) 1 +
    ((LinearMap.proj 2 : (Fin 4 → ℝ) →ₗ[ℝ] ℝ) +
      (2 : ℝ) • LinearMap.proj 3).toAffineMap
  let B : (Fin 4 → ℝ) →ᵃ[ℝ] ℝ := AffineMap.const ℝ (Fin 4 → ℝ) 1 +
    ((LinearMap.proj 1 : (Fin 4 → ℝ) →ₗ[ℝ] ℝ) +
      (2 : ℝ) • LinearMap.proj 3).toAffineMap
  have hA : volume {z : Fin 4 → ℝ | A z = 0} = 0 := by
    have hset : {z : Fin 4 → ℝ | A z = 0} =
        {z : Fin 4 → ℝ | (∑ i, (![0, 0, 1, 2] : Fin 4 → ℝ) i * z i) = -1} := by
      ext z
      change (1 + (z 2 + 2 * z 3) = 0) ↔ _
      norm_num [Fin.sum_univ_four, Matrix.cons_val_two, Matrix.cons_val_three,
        Matrix.vecHead, Matrix.vecTail]
      constructor <;> intro hz <;> linarith
    rw [hset]
    exact affine_hyperplane_null
      (![0, 0, 1, 2] : Fin 4 → ℝ) (-1)
      ⟨2, by change (1 : ℝ) ≠ 0; norm_num⟩
  have hB : volume {z : Fin 4 → ℝ | B z = 0} = 0 := by
    have hset : {z : Fin 4 → ℝ | B z = 0} =
        {z : Fin 4 → ℝ | (∑ i, (![0, 1, 0, 2] : Fin 4 → ℝ) i * z i) = -1} := by
      ext z
      change (1 + (z 1 + 2 * z 3) = 0) ↔ _
      norm_num [Fin.sum_univ_four, Matrix.cons_val_two, Matrix.cons_val_three,
        Matrix.vecHead, Matrix.vecTail]
      constructor <;> intro hz <;> linarith
    rw [hset]
    exact affine_hyperplane_null
      (![0, 1, 0, 2] : Fin 4 → ℝ) (-1)
      ⟨1, by change (1 : ℝ) ≠ 0; norm_num⟩
  have hA0 : S 0 ⊆ {z | 0 ≤ A z} := by
    refine convexHull_min ?_ ((convex_Ici (0 : ℝ)).affine_preimage A)
    rintro _ ⟨k, rfl⟩
    fin_cases k
    all_goals
      simp only [minorantVertices1, minorantSimplexIndices1,
        Matrix.cons_val, Fin.reduceFinMk]
      norm_num [A, Matrix.cons_val_two, Matrix.cons_val_three,
        Matrix.vecHead, Matrix.vecTail]
  have hA1 : S 1 ⊆ {z | A z ≤ 0} := by
    refine convexHull_min ?_ ((convex_Iic (0 : ℝ)).affine_preimage A)
    rintro _ ⟨k, rfl⟩
    fin_cases k
    all_goals
      simp only [minorantVertices1, minorantSimplexIndices1,
        Matrix.cons_val, Fin.reduceFinMk]
      norm_num [A, Matrix.cons_val_two, Matrix.cons_val_three,
        Matrix.vecHead, Matrix.vecTail]
  have hA2 : S 2 ⊆ {z | A z ≤ 0} := by
    refine convexHull_min ?_ ((convex_Iic (0 : ℝ)).affine_preimage A)
    rintro _ ⟨k, rfl⟩
    fin_cases k
    all_goals
      simp only [minorantVertices1, minorantSimplexIndices1,
        Matrix.cons_val, Fin.reduceFinMk]
      norm_num [A, Matrix.cons_val_two, Matrix.cons_val_three,
        Matrix.vecHead, Matrix.vecTail]
  have hB1 : S 1 ⊆ {z | 0 ≤ B z} := by
    refine convexHull_min ?_ ((convex_Ici (0 : ℝ)).affine_preimage B)
    rintro _ ⟨k, rfl⟩
    fin_cases k
    all_goals
      simp only [minorantVertices1, minorantSimplexIndices1,
        Matrix.cons_val, Fin.reduceFinMk]
      norm_num [B, Matrix.cons_val_two, Matrix.cons_val_three,
        Matrix.vecHead, Matrix.vecTail]
  have hB2 : S 2 ⊆ {z | B z ≤ 0} := by
    refine convexHull_min ?_ ((convex_Iic (0 : ℝ)).affine_preimage B)
    rintro _ ⟨k, rfl⟩
    fin_cases k
    all_goals
      simp only [minorantVertices1, minorantSimplexIndices1,
        Matrix.cons_val, Fin.reduceFinMk]
      norm_num [B, Matrix.cons_val_two, Matrix.cons_val_three,
        Matrix.vecHead, Matrix.vecTail]
  have h01 : AEDisjoint volume (S 0) (S 1) := by
    apply measure_mono_null (t := {z | A z = 0}) ?_ hA
    intro z hz
    exact le_antisymm (hA1 hz.2) (hA0 hz.1)
  have h02 : AEDisjoint volume (S 0) (S 2) := by
    apply measure_mono_null (t := {z | A z = 0}) ?_ hA
    intro z hz
    exact le_antisymm (hA2 hz.2) (hA0 hz.1)
  have h12 : AEDisjoint volume (S 1) (S 2) := by
    apply measure_mono_null (t := {z | B z = 0}) ?_ hB
    intro z hz
    exact le_antisymm (hB2 hz.2) (hB1 hz.1)
  intro i j hij
  fin_cases i <;> fin_cases j
  · exact (hij rfl).elim
  · exact h01
  · exact h02
  · exact h01.symm
  · exact (hij rfl).elim
  · exact h12
  · exact h02.symm
  · exact h12.symm
  · exact (hij rfl).elim

theorem minorant_simplex2_pairwise_aedisjoint :
    Pairwise (fun i j : Fin 3 =>
      AEDisjoint (volume : Measure (Fin 4 → ℝ))
        (convexHull ℝ (Set.range fun k : Fin 5 =>
        minorantVertices2 (minorantSimplexIndices2 i k)))
        (convexHull ℝ (Set.range fun k : Fin 5 =>
        minorantVertices2 (minorantSimplexIndices2 j k)))) := by
  let S : Fin 3 → Set (Fin 4 → ℝ) := fun j =>
    convexHull ℝ (Set.range fun k : Fin 5 =>
        minorantVertices2 (minorantSimplexIndices2 j k))
  change Pairwise (fun i j : Fin 3 => AEDisjoint volume (S i) (S j))
  let A : (Fin 4 → ℝ) →ᵃ[ℝ] ℝ := ((LinearMap.proj 2 : (Fin 4 → ℝ) →ₗ[ℝ] ℝ) -
      (2 : ℝ) • LinearMap.proj 1).toAffineMap -
    AffineMap.const ℝ (Fin 4 → ℝ) 2
  let B : (Fin 4 → ℝ) →ᵃ[ℝ] ℝ := AffineMap.const ℝ (Fin 4 → ℝ) 2 +
    ((LinearMap.proj 0 : (Fin 4 → ℝ) →ₗ[ℝ] ℝ) +
      (3 : ℝ) • LinearMap.proj 1 + (2 : ℝ) • LinearMap.proj 3).toAffineMap
  have hA : volume {z : Fin 4 → ℝ | A z = 0} = 0 := by
    have hset : {z : Fin 4 → ℝ | A z = 0} =
        {z : Fin 4 → ℝ | (∑ i, (![0, -2, 1, 0] : Fin 4 → ℝ) i * z i) = 2} := by
      ext z
      change (z 2 - 2 * z 1 - 2 = 0) ↔ _
      norm_num [Fin.sum_univ_four, Matrix.cons_val_two, Matrix.cons_val_three,
        Matrix.vecHead, Matrix.vecTail]
      constructor <;> intro hz <;> linarith
    rw [hset]
    exact affine_hyperplane_null
      (![0, -2, 1, 0] : Fin 4 → ℝ) (2)
      ⟨2, by change (1 : ℝ) ≠ 0; norm_num⟩
  have hB : volume {z : Fin 4 → ℝ | B z = 0} = 0 := by
    have hset : {z : Fin 4 → ℝ | B z = 0} =
        {z : Fin 4 → ℝ | (∑ i, (![1, 3, 0, 2] : Fin 4 → ℝ) i * z i) = -2} := by
      ext z
      change (2 + (z 0 + 3 * z 1 + 2 * z 3) = 0) ↔ _
      norm_num [Fin.sum_univ_four, Matrix.cons_val_two, Matrix.cons_val_three,
        Matrix.vecHead, Matrix.vecTail]
      constructor <;> intro hz <;> linarith
    rw [hset]
    exact affine_hyperplane_null
      (![1, 3, 0, 2] : Fin 4 → ℝ) (-2)
      ⟨0, by change (1 : ℝ) ≠ 0; norm_num⟩
  have hA0 : S 0 ⊆ {z | 0 ≤ A z} := by
    refine convexHull_min ?_ ((convex_Ici (0 : ℝ)).affine_preimage A)
    rintro _ ⟨k, rfl⟩
    fin_cases k
    all_goals
      simp only [minorantVertices2, minorantSimplexIndices2,
        Matrix.cons_val, Fin.reduceFinMk]
      norm_num [A, Matrix.cons_val_two, Matrix.cons_val_three,
        Matrix.vecHead, Matrix.vecTail]
  have hA1 : S 1 ⊆ {z | A z ≤ 0} := by
    refine convexHull_min ?_ ((convex_Iic (0 : ℝ)).affine_preimage A)
    rintro _ ⟨k, rfl⟩
    fin_cases k
    all_goals
      simp only [minorantVertices2, minorantSimplexIndices2,
        Matrix.cons_val, Fin.reduceFinMk]
      norm_num [A, Matrix.cons_val_two, Matrix.cons_val_three,
        Matrix.vecHead, Matrix.vecTail]
  have hA2 : S 2 ⊆ {z | A z ≤ 0} := by
    refine convexHull_min ?_ ((convex_Iic (0 : ℝ)).affine_preimage A)
    rintro _ ⟨k, rfl⟩
    fin_cases k
    all_goals
      simp only [minorantVertices2, minorantSimplexIndices2,
        Matrix.cons_val, Fin.reduceFinMk]
      norm_num [A, Matrix.cons_val_two, Matrix.cons_val_three,
        Matrix.vecHead, Matrix.vecTail]
  have hB1 : S 1 ⊆ {z | 0 ≤ B z} := by
    refine convexHull_min ?_ ((convex_Ici (0 : ℝ)).affine_preimage B)
    rintro _ ⟨k, rfl⟩
    fin_cases k
    all_goals
      simp only [minorantVertices2, minorantSimplexIndices2,
        Matrix.cons_val, Fin.reduceFinMk]
      norm_num [B, Matrix.cons_val_two, Matrix.cons_val_three,
        Matrix.vecHead, Matrix.vecTail]
  have hB2 : S 2 ⊆ {z | B z ≤ 0} := by
    refine convexHull_min ?_ ((convex_Iic (0 : ℝ)).affine_preimage B)
    rintro _ ⟨k, rfl⟩
    fin_cases k
    all_goals
      simp only [minorantVertices2, minorantSimplexIndices2,
        Matrix.cons_val, Fin.reduceFinMk]
      norm_num [B, Matrix.cons_val_two, Matrix.cons_val_three,
        Matrix.vecHead, Matrix.vecTail]
  have h01 : AEDisjoint volume (S 0) (S 1) := by
    apply measure_mono_null (t := {z | A z = 0}) ?_ hA
    intro z hz
    exact le_antisymm (hA1 hz.2) (hA0 hz.1)
  have h02 : AEDisjoint volume (S 0) (S 2) := by
    apply measure_mono_null (t := {z | A z = 0}) ?_ hA
    intro z hz
    exact le_antisymm (hA2 hz.2) (hA0 hz.1)
  have h12 : AEDisjoint volume (S 1) (S 2) := by
    apply measure_mono_null (t := {z | B z = 0}) ?_ hB
    intro z hz
    exact le_antisymm (hB2 hz.2) (hB1 hz.1)
  intro i j hij
  fin_cases i <;> fin_cases j
  · exact (hij rfl).elim
  · exact h01
  · exact h02
  · exact h01.symm
  · exact (hij rfl).elim
  · exact h12
  · exact h02.symm
  · exact h12.symm
  · exact (hij rfl).elim

theorem minorant_halfspaces1_volume :
    volume {z : Fin 4 → ℝ | (∀ j, -2 ≤ z j) ∧ -2 ≤ -(∑ j, z j) ∧
      z 1 ≤ z 0 ∧ z 2 ≤ z 1 ∧ z 3 ≤ z 2 ∧
      z 3 ≤ -(∑ j, z j) ∧ z 0 + z 1 ≤ 1 ∧
      -1 ≤ z 1 + z 2 + z 3} = (125 : ℝ≥0∞) / 864 := by
  have hm (j : Fin 3) :
      MeasurableSet (convexHull ℝ (Set.range fun k : Fin 5 =>
        minorantVertices1 (minorantSimplexIndices1 j k))) :=
    ((Set.finite_range _).isCompact_convexHull ℝ).isClosed.measurableSet
  rw [minorant_halfspaces1_eq_iUnion,
    measure_iUnion₀ minorant_simplex1_pairwise_aedisjoint
      (fun j => (hm j).nullMeasurableSet), tsum_fintype]
  simp_rw [minorantSimplex1_volume]
  simp only [Fin.sum_univ_three, Matrix.cons_val]
  apply (ENNReal.toReal_eq_toReal_iff' (by finiteness) (by finiteness)).mp
  rw [ENNReal.toReal_add (by finiteness) (by finiteness),
    ENNReal.toReal_add (by finiteness) (by finiteness)]
  norm_num

theorem minorant_halfspaces1_volume_real :
    volume.real {z : Fin 4 → ℝ | (∀ j, -2 ≤ z j) ∧ -2 ≤ -(∑ j, z j) ∧
      z 1 ≤ z 0 ∧ z 2 ≤ z 1 ∧ z 3 ≤ z 2 ∧
      z 3 ≤ -(∑ j, z j) ∧ z 0 + z 1 ≤ 1 ∧
      -1 ≤ z 1 + z 2 + z 3} = (125 : ℝ) / 864 := by
  rw [measureReal_def, minorant_halfspaces1_volume]
  norm_num

theorem minorant_halfspaces2_volume :
    volume {z : Fin 4 → ℝ | (∀ j, -2 ≤ z j) ∧ -2 ≤ -(∑ j, z j) ∧
      z 1 ≤ z 0 ∧ z 1 ≤ z 2 ∧ z 3 ≤ -(∑ j, z j) ∧
      z 0 + z 2 ≤ 1 ∧ -1 ≤ z 0 + z 1 + z 3} = (3125 : ℝ≥0∞) / 576 := by
  have hm (j : Fin 3) :
      MeasurableSet (convexHull ℝ (Set.range fun k : Fin 5 =>
        minorantVertices2 (minorantSimplexIndices2 j k))) :=
    ((Set.finite_range _).isCompact_convexHull ℝ).isClosed.measurableSet
  rw [minorant_halfspaces2_eq_iUnion,
    measure_iUnion₀ minorant_simplex2_pairwise_aedisjoint
      (fun j => (hm j).nullMeasurableSet), tsum_fintype]
  simp_rw [minorantSimplex2_volume]
  simp only [Fin.sum_univ_three, Matrix.cons_val]
  apply (ENNReal.toReal_eq_toReal_iff' (by finiteness) (by finiteness)).mp
  rw [ENNReal.toReal_add (by finiteness) (by finiteness),
    ENNReal.toReal_add (by finiteness) (by finiteness)]
  norm_num

theorem minorant_halfspaces2_volume_real :
    volume.real {z : Fin 4 → ℝ | (∀ j, -2 ≤ z j) ∧ -2 ≤ -(∑ j, z j) ∧
      z 1 ≤ z 0 ∧ z 1 ≤ z 2 ∧ z 3 ≤ -(∑ j, z j) ∧
      z 0 + z 2 ≤ 1 ∧ -1 ≤ z 0 + z 1 + z 3} = (3125 : ℝ) / 576 := by
  rw [measureReal_def, minorant_halfspaces2_volume]
  norm_num

end

section
open Set

section
open Set

theorem coefficient_affine_snoc (z : Fin 4 → ℝ) :
    (Fin.snoc (fun i => (1 : ℝ) / 5 + (481 : ℝ) / 100000 * z i)
      (1 - ∑ i, ((1 : ℝ) / 5 + (481 : ℝ) / 100000 * z i)) : Fin 5 → ℝ) =
    fun i => (1 : ℝ) / 5 + (481 : ℝ) / 100000 *
      (Fin.snoc z (-(∑ k, z k)) : Fin 5 → ℝ) i := by
  funext i
  refine Fin.lastCases ?_ (fun k => ?_) i
  · simp only [Fin.snoc_last, Fin.sum_univ_four]
    ring
  · simp only [Fin.snoc_castSucc]

theorem exceptionalCut_affine_normalized_iff (j : Fin 2) (z : Fin 4 → ℝ) :
    (let t : Fin 4 → ℝ := fun i => (1 : ℝ) / 5 + (481 : ℝ) / 100000 * z i
     let alpha : Fin 5 → ℝ := Fin.snoc t (1 - ∑ i, t i)
     (∀ i, (9519 : ℝ) / 50000 ≤ alpha i) ∧
       (if j.val = 0 then
         alpha 3 ≤ alpha 2 ∧ alpha 2 ≤ alpha 1 ∧ alpha 1 ≤ alpha 0 ∧
         alpha 3 ≤ alpha 4 ∧ alpha 0 + alpha 1 ≤ (40481 : ℝ) / 100000 ∧
         (59519 : ℝ) / 100000 ≤ alpha 1 + alpha 2 + alpha 3
       else
         alpha 1 ≤ alpha 0 ∧ alpha 1 ≤ alpha 2 ∧ alpha 3 ≤ alpha 4 ∧
         alpha 0 + alpha 2 ≤ (40481 : ℝ) / 100000 ∧
         (59519 : ℝ) / 100000 ≤ alpha 0 + alpha 1 + alpha 3)) ↔
    ((∀ i, (-2 : ℝ) ≤ z i) ∧ -2 ≤ -(∑ i, z i) ∧
      (if j.val = 0 then
        z 1 ≤ z 0 ∧ z 2 ≤ z 1 ∧ z 3 ≤ z 2 ∧
        z 3 ≤ -(∑ i, z i) ∧ z 0 + z 1 ≤ 1 ∧ -1 ≤ z 1 + z 2 + z 3
      else
        z 1 ≤ z 0 ∧ z 1 ≤ z 2 ∧ z 3 ≤ -(∑ i, z i) ∧
        z 0 + z 2 ≤ 1 ∧ -1 ≤ z 0 + z 1 + z 3)) := by
  have hlo (r : ℝ) :
      (9519 : ℝ) / 50000 ≤ (1 : ℝ) / 5 + (481 : ℝ) / 100000 * r ↔ -2 ≤ r := by
    constructor <;> intro h <;> linarith
  have hord (r s : ℝ) :
      (1 : ℝ) / 5 + (481 : ℝ) / 100000 * r ≤
        (1 : ℝ) / 5 + (481 : ℝ) / 100000 * s ↔ r ≤ s := by
    constructor <;> intro h <;> linarith
  have hpair (r s : ℝ) :
      ((1 : ℝ) / 5 + (481 : ℝ) / 100000 * r) +
        ((1 : ℝ) / 5 + (481 : ℝ) / 100000 * s) ≤ (40481 : ℝ) / 100000 ↔
      r + s ≤ 1 := by
    constructor <;> intro h <;> linarith
  have htriple (r s t : ℝ) :
      (59519 : ℝ) / 100000 ≤
        ((1 : ℝ) / 5 + (481 : ℝ) / 100000 * r) +
          ((1 : ℝ) / 5 + (481 : ℝ) / 100000 * s) +
          ((1 : ℝ) / 5 + (481 : ℝ) / 100000 * t) ↔ -1 ≤ r + s + t := by
    constructor <;> intro h <;> linarith
  dsimp only
  rw [coefficient_affine_snoc]
  simp only [hlo, hord, hpair, htriple]
  by_cases hj : j.val = 0 <;>
    simp only [hj, ↓reduceIte, Fin.forall_fin_succ', Fin.snoc_castSucc, Fin.snoc_last]
  all_goals tauto

theorem exceptionalCut_eq_affine_normalized_image (j : Fin 2) :
    {t : Fin 4 → ℝ |
      let alpha : Fin 5 → ℝ := Fin.snoc t (1 - ∑ i, t i)
      (∀ i, (9519 : ℝ) / 50000 ≤ alpha i) ∧
        (if j.val = 0 then
          alpha 3 ≤ alpha 2 ∧ alpha 2 ≤ alpha 1 ∧ alpha 1 ≤ alpha 0 ∧
          alpha 3 ≤ alpha 4 ∧ alpha 0 + alpha 1 ≤ (40481 : ℝ) / 100000 ∧
          (59519 : ℝ) / 100000 ≤ alpha 1 + alpha 2 + alpha 3
        else
          alpha 1 ≤ alpha 0 ∧ alpha 1 ≤ alpha 2 ∧ alpha 3 ≤ alpha 4 ∧
          alpha 0 + alpha 2 ≤ (40481 : ℝ) / 100000 ∧
          (59519 : ℝ) / 100000 ≤ alpha 0 + alpha 1 + alpha 3)} =
    (fun z : Fin 4 → ℝ => fun i => (1 : ℝ) / 5 + (481 : ℝ) / 100000 * z i) ''
      {z : Fin 4 → ℝ | (∀ i, (-2 : ℝ) ≤ z i) ∧ -2 ≤ -(∑ i, z i) ∧
        (if j.val = 0 then
          z 1 ≤ z 0 ∧ z 2 ≤ z 1 ∧ z 3 ≤ z 2 ∧
          z 3 ≤ -(∑ i, z i) ∧ z 0 + z 1 ≤ 1 ∧ -1 ≤ z 1 + z 2 + z 3
        else
          z 1 ≤ z 0 ∧ z 1 ≤ z 2 ∧ z 3 ≤ -(∑ i, z i) ∧
          z 0 + z 2 ≤ 1 ∧ -1 ≤ z 0 + z 1 + z 3)} := by
  ext t
  constructor
  · intro ht
    let z : Fin 4 → ℝ := fun i => (t i - (1 : ℝ) / 5) / ((481 : ℝ) / 100000)
    have hz : (fun i => (1 : ℝ) / 5 + (481 : ℝ) / 100000 * z i) = t := by
      funext i
      dsimp only [z]
      ring
    refine ⟨z, ?_, hz⟩
    apply (exceptionalCut_affine_normalized_iff j z).mp
    rw [hz]
    exact ht
  · rintro ⟨z, hz, rfl⟩
    exact (exceptionalCut_affine_normalized_iff j z).mpr hz

theorem exceptionalMassCoefficient_le_density_mul_volume (j : Fin 2) :
    exceptionalMassCoefficient j ≤
      (((9519 : ℝ) / 50000) ^ 4 * (1 - 4 * ((9519 : ℝ) / 50000)))⁻¹ *
        (volume : Measure (Fin 4 → ℝ)).real
          {t : Fin 4 → ℝ |
            let alpha : Fin 5 → ℝ := Fin.snoc t (1 - ∑ i, t i)
            (∀ i, (9519 : ℝ) / 50000 ≤ alpha i) ∧
              (if j.val = 0 then
                alpha 3 ≤ alpha 2 ∧ alpha 2 ≤ alpha 1 ∧ alpha 1 ≤ alpha 0 ∧
                alpha 3 ≤ alpha 4 ∧ alpha 0 + alpha 1 ≤ (40481 : ℝ) / 100000 ∧
                (59519 : ℝ) / 100000 ≤ alpha 1 + alpha 2 + alpha 3
              else
                alpha 1 ≤ alpha 0 ∧ alpha 1 ≤ alpha 2 ∧ alpha 3 ≤ alpha 4 ∧
                alpha 0 + alpha 2 ≤ (40481 : ℝ) / 100000 ∧
                (59519 : ℝ) / 100000 ≤ alpha 0 + alpha 1 + alpha 3)} := by
  classical
  let R : Set (Fin 4 → ℝ) := {t |
    let alpha : Fin 5 → ℝ := Fin.snoc t (1 - ∑ i, t i)
    (∀ i, (9519 : ℝ) / 50000 ≤ alpha i) ∧
      (if j.val = 0 then
        alpha 3 ≤ alpha 2 ∧ alpha 2 ≤ alpha 1 ∧ alpha 1 ≤ alpha 0 ∧
        alpha 3 ≤ alpha 4 ∧ alpha 0 + alpha 1 ≤ (40481 : ℝ) / 100000 ∧
        (59519 : ℝ) / 100000 ≤ alpha 1 + alpha 2 + alpha 3
      else
        alpha 1 ≤ alpha 0 ∧ alpha 1 ≤ alpha 2 ∧ alpha 3 ≤ alpha 4 ∧
        alpha 0 + alpha 2 ≤ (40481 : ℝ) / 100000 ∧
        (59519 : ℝ) / 100000 ≤ alpha 0 + alpha 1 + alpha 3)}
  let f : (Fin 4 → ℝ) → ℝ := fun t =>
    (∏ i, (Fin.snoc t (1 - ∑ k, t k) : Fin 5 → ℝ) i)⁻¹
  let D : ℝ := ((9519 : ℝ) / 50000) ^ 4 * (1 - 4 * ((9519 : ℝ) / 50000))
  change exceptionalMassCoefficient j ≤ D⁻¹ * volume.real R
  have hR : MeasurableSet R := exceptionalCut_measurable j
  have hfinite : volume R < ⊤ :=
    measure_lt_top_of_subset
      (fun t ht => mem_exceptional_exponent_box_of_snoc_lower_bounds ht.1)
      isCompact_Icc.measure_ne_top
  have hd : 0 < D := by norm_num [D]
  have hnorm (t : Fin 4 → ℝ) (ht : t ∈ R) : ‖f t‖ ≤ D⁻¹ := by
    have hl := density_product_lower ht.1 (coefficient_sum_one t)
    have hnonneg : 0 ≤ f t := inv_nonneg.mpr (hd.le.trans hl)
    rw [Real.norm_eq_abs, abs_of_nonneg hnonneg]
    exact inv_anti₀ hd hl
  have hidentity : exceptionalMassCoefficient j = ∫ t in R, f t := by
    rw [← integral_indicator hR]
    simp [exceptionalMassCoefficient, Set.indicator_apply, R, f]
  rw [hidentity]
  exact (le_abs_self _).trans (by
    simpa only [Real.norm_eq_abs] using norm_setIntegral_le_of_norm_le_const hfinite hnorm)

theorem exceptionalMassCoefficient_le_normalizedPolytope_volume (j : Fin 2) :
    exceptionalMassCoefficient j ≤
      ((481 : ℝ) / 100000) ^ 4 /
        (((9519 : ℝ) / 50000) ^ 4 * (1 - 4 * ((9519 : ℝ) / 50000))) *
          (volume : Measure (Fin 4 → ℝ)).real
            {z : Fin 4 → ℝ | (∀ i, (-2 : ℝ) ≤ z i) ∧ -2 ≤ -(∑ i, z i) ∧
              (if j.val = 0 then
                z 1 ≤ z 0 ∧ z 2 ≤ z 1 ∧ z 3 ≤ z 2 ∧
                z 3 ≤ -(∑ i, z i) ∧ z 0 + z 1 ≤ 1 ∧ -1 ≤ z 1 + z 2 + z 3
              else
                z 1 ≤ z 0 ∧ z 1 ≤ z 2 ∧ z 3 ≤ -(∑ i, z i) ∧
                z 0 + z 2 ≤ 1 ∧ -1 ≤ z 0 + z 1 + z 3)} := by
  have h := exceptionalMassCoefficient_le_density_mul_volume j
  rw [exceptionalCut_eq_affine_normalized_image j,
    volume_real_sourceAlpha_image] at h
  simpa only [div_eq_mul_inv, mul_assoc, mul_left_comm, mul_comm] using h

end

theorem minorant_halfspaces1_volume_le :
    (volume : Measure (Fin 4 → ℝ)).real
      {z : Fin 4 → ℝ | (∀ j, -2 ≤ z j) ∧ -2 ≤ -(∑ j, z j) ∧
        z 1 ≤ z 0 ∧ z 2 ≤ z 1 ∧ z 3 ≤ z 2 ∧
        z 3 ≤ -(∑ j, z j) ∧ z 0 + z 1 ≤ 1 ∧ -1 ≤ z 1 + z 2 + z 3} ≤
      (125 : ℝ) / 864 := by
  rw [minorant_halfspaces1_eq_iUnion]
  calc
    _ ≤ ∑ j : Fin 3, (volume : Measure (Fin 4 → ℝ)).real
        (convexHull ℝ (Set.range fun k : Fin 5 =>
          minorantVertices1 (minorantSimplexIndices1 j k))) :=
      measureReal_iUnion_fintype_le _
    _ = (125 : ℝ) / 864 := by
      norm_num [measureReal_def, minorantSimplex1_volume, Fin.sum_univ_succ]

theorem minorant_halfspaces2_volume_le :
    (volume : Measure (Fin 4 → ℝ)).real
      {z : Fin 4 → ℝ | (∀ j, -2 ≤ z j) ∧ -2 ≤ -(∑ j, z j) ∧
        z 1 ≤ z 0 ∧ z 1 ≤ z 2 ∧ z 3 ≤ -(∑ j, z j) ∧
        z 0 + z 2 ≤ 1 ∧ -1 ≤ z 0 + z 1 + z 3} ≤
      (3125 : ℝ) / 576 := by
  rw [minorant_halfspaces2_eq_iUnion]
  calc
    _ ≤ ∑ j : Fin 3, (volume : Measure (Fin 4 → ℝ)).real
        (convexHull ℝ (Set.range fun k : Fin 5 =>
          minorantVertices2 (minorantSimplexIndices2 j k))) :=
      measureReal_iUnion_fintype_le _
    _ = (3125 : ℝ) / 576 := by
      norm_num [measureReal_def, minorantSimplex2_volume, Fin.sum_univ_succ]

end

section
open Set

theorem exceptionalMassCoefficient_sum_bound :
    0 ≤ exceptionalMassCoefficient 0 + exceptionalMassCoefficient 1 ∧
      exceptionalMassCoefficient 0 + exceptionalMassCoefficient 1 ≤
        (146365385252734375 : ℝ) / 15379362287924882625792 ∧
      (146365385252734375 : ℝ) / 15379362287924882625792 < (1 : ℝ) / 50000 := by
  have hc : 0 ≤ ((481 : ℝ) / 100000) ^ 4 /
      (((9519 : ℝ) / 50000) ^ 4 * (1 - 4 * ((9519 : ℝ) / 50000))) := by norm_num
  have hzero : exceptionalMassCoefficient 0 ≤
      ((481 : ℝ) / 100000) ^ 4 /
        (((9519 : ℝ) / 50000) ^ 4 * (1 - 4 * ((9519 : ℝ) / 50000))) *
          ((125 : ℝ) / 864) := by
    have h := exceptionalMassCoefficient_le_normalizedPolytope_volume 0
    simp only [Fin.val_zero, ↓reduceIte] at h
    exact h.trans (mul_le_mul_of_nonneg_left
      minorant_halfspaces1_volume_le hc)
  have hone : exceptionalMassCoefficient 1 ≤
      ((481 : ℝ) / 100000) ^ 4 /
        (((9519 : ℝ) / 50000) ^ 4 * (1 - 4 * ((9519 : ℝ) / 50000))) *
          ((3125 : ℝ) / 576) := by
    have h := exceptionalMassCoefficient_le_normalizedPolytope_volume 1
    simp only [Fin.val_one, one_ne_zero, ↓reduceIte] at h
    exact h.trans (mul_le_mul_of_nonneg_left
      minorant_halfspaces2_volume_le hc)
  refine ⟨add_nonneg (exceptionalMassCoefficient_nonneg 0)
    (exceptionalMassCoefficient_nonneg 1), ?_, ?_⟩
  · have h := add_le_add hzero hone
    norm_num at h ⊢
    exact h
  · norm_num

end

open Classical in
theorem literal_minorant_closed_true_mass :
    let kappa : ℝ :=
      exceptionalMassCoefficient 0 + exceptionalMassCoefficient 1
    0 ≤ kappa ∧
      kappa ≤ (146365385252734375 : ℝ) / 15379362287924882625792 ∧
      (146365385252734375 : ℝ) / 15379362287924882625792 <
        (1 : ℝ) / 50000 ∧
      Filter.Tendsto
        (fun x : ℝ =>
          Real.log x / x *
            (∑ n ∈ Finset.Icc (Nat.ceil x) (Nat.floor (2 * x)),
              ((if n.Prime then (1 : ℝ) else 0) -
                exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n)))
        Filter.atTop (nhds (1 - kappa)) := by
  obtain ⟨hnonneg, hupper, hstrict⟩ := exceptionalMassCoefficient_sum_bound
  exact ⟨hnonneg, hupper, hstrict, literal_minorant_signed_mean⟩

section
open Filter Asymptotics
open Classical in
theorem repeated_five_prime_tuple_mass_le (N r : ℕ) (hr : 2 ≤ r) :
    (∑ n ∈ Finset.Icc 1 N,
      ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
        if (∏ i, p i) = n ∧ (∀ i, r ≤ p i) ∧ ¬Function.Injective p
        then (1 : ℝ) else 0) ≤
      3125 * (N : ℝ) / ((r - 1 : ℕ) : ℝ) := by
  let D (n : ℕ) : Prop := ∃ m ∈ Finset.Icc r N, m ^ 2 ∣ n
  have hpoint (n : ℕ) (hn : n ∈ Finset.Icc 1 N) :
      (∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
        if (∏ i, p i) = n ∧ (∀ i, r ≤ p i) ∧ ¬Function.Injective p
        then (1 : ℝ) else 0) ≤ if D n then 3125 else 0 := by
    by_cases hd : D n
    · rw [ite_eq_left hd]
      exact sum_five_prime_tuple_indicator_le n _ (fun _ _ h => h.1)
    · rw [ite_eq_right hd]
      apply le_of_eq
      apply Finset.sum_eq_zero
      intro p hp
      apply ite_eq_right
      intro h
      rcases Function.not_injective_iff.mp h.2.2 with ⟨i, j, heq, hij⟩
      have hdiv : p i ^ 2 ∣ n := by
        have hpair := Finset.prod_dvd_prod_of_subset
          ({i, j} : Finset (Fin 5)) Finset.univ p (Finset.subset_univ _)
        rw [Finset.prod_pair hij, ← heq, ← pow_two, h.1] at hpair
        exact hpair
      apply hd
      refine ⟨p i, Finset.mem_Icc.mpr ⟨h.2.1 i, ?_⟩, hdiv⟩
      exact (Nat.le_of_mem_primesLE (Fintype.mem_piFinset.mp hp i)).trans
        (Finset.mem_Icc.mp hn).2
  calc
    _ ≤ ∑ n ∈ Finset.Icc 1 N, if D n then (3125 : ℝ) else 0 :=
      Finset.sum_le_sum hpoint
    _ = 3125 * (∑ n ∈ Finset.Icc 1 N, if D n then (1 : ℝ) else 0) := by
      rw [Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro n hn
      split_ifs <;> norm_num
    _ = 3125 * (((Finset.Icc 1 N).filter D).card : ℝ) := by
      rw [Finset.sum_boole]
    _ ≤ 3125 * ((N : ℝ) / ((r - 1 : ℕ) : ℝ)) :=
      mul_le_mul_of_nonneg_left (large_square_divisor_count_le N r hr) (by norm_num)
    _ = _ := by ring

open Classical in
theorem repeated_five_prime_tuple_mass_isBigO :
    (fun x : ℝ =>
      ∑ n ∈ Finset.Icc (Nat.ceil x) (Nat.floor (2 * x)),
        ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
          if (∏ i, p i) = n ∧
              (∀ i, x ^ ((9519 : ℝ) / 50000) ≤ (p i : ℝ)) ∧
              ¬Function.Injective p
          then (1 : ℝ) else 0) =O[atTop]
      (fun x : ℝ => x ^ (1 - (9519 : ℝ) / 50000)) := by
  apply Asymptotics.IsBigO.of_bound 12500
  have hpower := tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 9519 / 50000)
  filter_upwards [Filter.eventually_gt_atTop (1 : ℝ),
    hpower.eventually_ge_atTop 2] with x hx hY
  let Y : ℝ := x ^ ((9519 : ℝ) / 50000)
  let r : ℕ := Nat.ceil Y
  let N : ℕ := Nat.floor (2 * x)
  have hx0 : 0 < x := lt_trans zero_lt_one hx
  have hY0 : 0 < Y := Real.rpow_pos_of_pos hx0 _
  have hY2 : 2 ≤ Y := hY
  have hYr : Y ≤ (r : ℝ) := Nat.le_ceil Y
  have hr : 2 ≤ r := by exact_mod_cast hY2.trans hYr
  have hr1 : 1 ≤ r := by omega
  have hden : Y / 2 ≤ ((r - 1 : ℕ) : ℝ) := by
    rw [Nat.cast_sub hr1, Nat.cast_one]
    linarith
  have hden0 : 0 < ((r - 1 : ℕ) : ℝ) := (half_pos hY0).trans_le hden
  have hN : (N : ℝ) ≤ 2 * x := Nat.floor_le (by positivity)
  have hceil : 1 ≤ Nat.ceil x := Nat.one_le_ceil_iff.mpr hx0
  have hnonneg : 0 ≤
      ∑ n ∈ Finset.Icc (Nat.ceil x) N,
        ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
          if (∏ i, p i) = n ∧ (∀ i, Y ≤ (p i : ℝ)) ∧ ¬Function.Injective p
          then (1 : ℝ) else 0 := by
    apply Finset.sum_nonneg
    intro n hn
    apply Finset.sum_nonneg
    intro p hp
    split_ifs <;> norm_num
  have hcompare :
      (∑ n ∈ Finset.Icc (Nat.ceil x) N,
        ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
          if (∏ i, p i) = n ∧ (∀ i, Y ≤ (p i : ℝ)) ∧ ¬Function.Injective p
          then (1 : ℝ) else 0) ≤
        3125 * (N : ℝ) / ((r - 1 : ℕ) : ℝ) := by
    calc
      _ ≤ ∑ n ∈ Finset.Icc 1 N,
          ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
            if (∏ i, p i) = n ∧ (∀ i, Y ≤ (p i : ℝ)) ∧ ¬Function.Injective p
            then (1 : ℝ) else 0 := by
        apply Finset.sum_le_sum_of_subset_of_nonneg
        · intro n hn
          exact Finset.mem_Icc.mpr
            ⟨hceil.trans (Finset.mem_Icc.mp hn).1, (Finset.mem_Icc.mp hn).2⟩
        · intro n hn hnot
          apply Finset.sum_nonneg
          intro p hp
          split_ifs <;> norm_num
      _ = ∑ n ∈ Finset.Icc 1 N,
          ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
            if (∏ i, p i) = n ∧ (∀ i, r ≤ p i) ∧ ¬Function.Injective p
            then (1 : ℝ) else 0 := by
        simp only [r, Nat.ceil_le]
      _ ≤ _ := repeated_five_prime_tuple_mass_le N r hr
  have hbound : 3125 * (N : ℝ) / ((r - 1 : ℕ) : ℝ) ≤
      12500 * x ^ (1 - (9519 : ℝ) / 50000) := by
    calc
      _ ≤ 3125 * (2 * x) / ((r - 1 : ℕ) : ℝ) :=
        div_le_div_of_nonneg_right (mul_le_mul_of_nonneg_left hN (by norm_num)) hden0.le
      _ ≤ 3125 * (2 * x) / (Y / 2) :=
        div_le_div_of_nonneg_left (by positivity) (half_pos hY0) hden
      _ = 12500 * x ^ (1 - (9519 : ℝ) / 50000) := by
        rw [Real.rpow_sub hx0, Real.rpow_one]
        dsimp only [Y]
        ring
  have hpow0 : 0 ≤ x ^ (1 - (9519 : ℝ) / 50000) := Real.rpow_nonneg hx0.le _
  dsimp only [N, Y] at hnonneg hcompare
  simpa only [Real.norm_eq_abs, abs_of_nonneg hnonneg, abs_of_nonneg hpow0] using
    hcompare.trans hbound

theorem log_normalized_tendsto_zero_of_isBigO_rpow {f : ℝ → ℝ} {xi : ℝ}
    (hxi : 0 < xi) (hf : f =O[atTop] (fun x : ℝ => x ^ (1 - xi))) :
    Tendsto (fun x : ℝ => Real.log x / x * f x) atTop (nhds 0) := by
  apply ((isBigO_refl (fun x : ℝ => Real.log x / x) atTop).mul hf).trans_tendsto
  refine (isLittleO_log_rpow_atTop hxi).tendsto_div_nhds_zero.congr' ?_
  filter_upwards [Filter.eventually_gt_atTop (0 : ℝ)] with x hx
  rw [Real.rpow_sub hx, Real.rpow_one, div_mul_div_cancel₀ hx.ne']

open Classical in
theorem repeated_five_prime_tuple_normalized_tendsto_zero :
    Tendsto
      (fun x : ℝ => Real.log x / x *
        (∑ n ∈ Finset.Icc (Nat.ceil x) (Nat.floor (2 * x)),
          ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
            if (∏ i, p i) = n ∧
                (∀ i, x ^ ((9519 : ℝ) / 50000) ≤ (p i : ℝ)) ∧
                ¬Function.Injective p
            then (1 : ℝ) else 0)) atTop (nhds 0) :=
  log_normalized_tendsto_zero_of_isBigO_rpow (by norm_num)
    repeated_five_prime_tuple_mass_isBigO

open Classical in
theorem literal_repeated_five_prime_tuple_mass_isBigO (j : Fin 2) :
    (fun x : ℝ =>
      ∑ n ∈ Finset.Icc (Nat.ceil x) (Nat.floor (2 * x)),
        ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
          let alpha : Fin 5 → ℝ := fun i => Real.logb x (p i : ℝ)
          if (∏ i, p i) = n ∧
              (if j.val = 0 then
                (9519 : ℝ) / 50000 ≤ alpha 3 ∧
                alpha 3 < alpha 2 ∧ alpha 2 < alpha 1 ∧ alpha 1 < alpha 0 ∧
                alpha 0 < (40481 : ℝ) / 100000 ∧
                alpha 0 + alpha 1 < (40481 : ℝ) / 100000 ∧
                (59519 : ℝ) / 100000 < alpha 1 + alpha 2 + alpha 3 ∧
                (p 3 : ℝ) ≤ (p 4 : ℝ)
              else
                (∀ i, (9519 : ℝ) / 50000 ≤ alpha i ∧
                  alpha i ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
                alpha 1 < alpha 0 ∧ alpha 1 < alpha 2 ∧
                alpha 0 + alpha 2 < (40481 : ℝ) / 100000 ∧
                (59519 : ℝ) / 100000 < alpha 0 + alpha 1 + alpha 3 ∧
                alpha 3 ≤ alpha 4) ∧ ¬Function.Injective p
          then (1 : ℝ) else 0) =O[atTop]
      (fun x : ℝ => x ^ (1 - (9519 : ℝ) / 50000)) := by
  refine Asymptotics.IsBigO.trans ?_ repeated_five_prime_tuple_mass_isBigO
  apply Asymptotics.IsBigO.of_norm_eventuallyLE
  filter_upwards [Filter.eventually_gt_atTop (1 : ℝ)] with x hx
  rw [Real.norm_eq_abs, abs_of_nonneg (by positivity)]
  apply Finset.sum_le_sum
  intro n hn
  apply Finset.sum_le_sum
  intro p hp
  dsimp only
  have hpos (i : Fin 5) : 0 < (p i : ℝ) :=
    Nat.cast_pos.mpr
      (Nat.prime_of_mem_primesLE (Fintype.mem_piFinset.mp hp i)).pos
  by_cases hj : j.val = 0
  · simp only [ite_eq_left hj]
    split
    · rename_i h
      rcases h with ⟨hprod, ⟨hxi, h32, h21, h10, _, _, _, h34⟩, hrep⟩
      have h3 : x ^ ((9519 : ℝ) / 50000) ≤ (p 3 : ℝ) :=
        (Real.le_logb_iff_rpow_le hx (hpos 3)).mp hxi
      have hrough : ∀ i, x ^ ((9519 : ℝ) / 50000) ≤ (p i : ℝ) := by
        intro i
        fin_cases i
        · apply (Real.le_logb_iff_rpow_le hx (hpos 0)).mp
          linarith
        · apply (Real.le_logb_iff_rpow_le hx (hpos 1)).mp
          linarith
        · apply (Real.le_logb_iff_rpow_le hx (hpos 2)).mp
          linarith
        · exact h3
        · exact h3.trans h34
      rw [ite_eq_left ⟨hprod, hrough, hrep⟩]
    · positivity
  · simp only [ite_eq_right hj]
    split
    · rename_i h
      have hrough : ∀ i, x ^ ((9519 : ℝ) / 50000) ≤ (p i : ℝ) :=
        fun i => (Real.le_logb_iff_rpow_le hx (hpos i)).mp (h.2.1.1 i).1
      rw [ite_eq_left ⟨h.1, hrough, h.2.2⟩]
    · positivity

open Classical in
theorem literal_repeated_five_prime_tuple_normalized_tendsto_zero (j : Fin 2) :
    Tendsto (fun x : ℝ => Real.log x / x *
      (∑ n ∈ Finset.Icc (Nat.ceil x) (Nat.floor (2 * x)),
        ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
          let alpha : Fin 5 → ℝ := fun i => Real.logb x (p i : ℝ)
          if (∏ i, p i) = n ∧
              (if j.val = 0 then
                (9519 : ℝ) / 50000 ≤ alpha 3 ∧
                alpha 3 < alpha 2 ∧ alpha 2 < alpha 1 ∧ alpha 1 < alpha 0 ∧
                alpha 0 < (40481 : ℝ) / 100000 ∧
                alpha 0 + alpha 1 < (40481 : ℝ) / 100000 ∧
                (59519 : ℝ) / 100000 < alpha 1 + alpha 2 + alpha 3 ∧
                (p 3 : ℝ) ≤ (p 4 : ℝ)
              else
                (∀ i, (9519 : ℝ) / 50000 ≤ alpha i ∧
                  alpha i ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
                alpha 1 < alpha 0 ∧ alpha 1 < alpha 2 ∧
                alpha 0 + alpha 2 < (40481 : ℝ) / 100000 ∧
                (59519 : ℝ) / 100000 < alpha 0 + alpha 1 + alpha 3 ∧
                alpha 3 ≤ alpha 4) ∧ ¬Function.Injective p
          then (1 : ℝ) else 0)) atTop (nhds 0) :=
  log_normalized_tendsto_zero_of_isBigO_rpow (by norm_num)
    (literal_repeated_five_prime_tuple_mass_isBigO j)

end

section
open scoped Matrix

theorem minorant_halfspaces1_eq_convexHull :
    {z : Fin 4 → ℝ | (∀ j, -2 ≤ z j) ∧ -2 ≤ -(∑ j, z j) ∧
      z 1 ≤ z 0 ∧ z 2 ≤ z 1 ∧ z 3 ≤ z 2 ∧
      z 3 ≤ -(∑ j, z j) ∧ z 0 + z 1 ≤ 1 ∧
      -1 ≤ z 1 + z 2 + z 3} = convexHull ℝ (Set.range minorantVertices1) := by
  apply Set.Subset.antisymm
  · rw [minorant_halfspaces1_eq_iUnion]
    apply Set.iUnion_subset
    intro j
    exact convexHull_mono (Set.range_comp_subset_range _ _)
  · exact convexHull_min (Set.range_subset_iff.mpr minorantVertices1_mem_halfspaces)
      convex_minorant_halfspaces1

theorem minorantVertices1_mem_exposedPoints (i : Fin 7) :
    minorantVertices1 i ∈
      ({z : Fin 4 → ℝ | (∀ j, -2 ≤ z j) ∧ -2 ≤ -(∑ j, z j) ∧
        z 1 ≤ z 0 ∧ z 2 ≤ z 1 ∧ z 3 ≤ z 2 ∧
        z 3 ≤ -(∑ j, z j) ∧ z 0 + z 1 ≤ 1 ∧
        -1 ≤ z 1 + z 2 + z 3}).exposedPoints ℝ := by
  let a : Fin 7 → (Fin 4 → ℝ) :=
    ![![-1, -1, -1, 0], ![0, 1, 1, 3], ![0, 1, -2, 0],
      ![1, 3, 0, 3], ![0, 0, 0, -1], ![1, 2, 2, 2], ![1, 0, 0, 1]]
  refine exposed_point_def.mpr ⟨minorantVertices1_mem_halfspaces i,
    (dotProductBilin ℝ ℝ (a i)).toContinuousLinearMap, ?_⟩
  intro y hy
  rcases hy with ⟨_, _, hy10, hy21, hy32, hy3, hy01, hy123⟩
  simp only [Fin.sum_univ_four] at hy3
  change dotProduct (a i) y ≤ dotProduct (a i) (minorantVertices1 i) ∧
    (dotProduct (a i) (minorantVertices1 i) ≤ dotProduct (a i) y →
      y = minorantVertices1 i)
  fin_cases i
  all_goals
    norm_num [a, minorantVertices1, dotProduct, Fin.sum_univ_four, Fin.reduceFinMk,
      Matrix.cons_val_two, Matrix.cons_val_three, Matrix.vecHead, Matrix.vecTail]
    constructor
    · linarith
    · intro h
      funext k
      fin_cases k <;>
        norm_num [Fin.reduceFinMk, Matrix.cons_val_two, Matrix.cons_val_three,
          Matrix.vecHead, Matrix.vecTail] <;> linarith!

theorem minorant_halfspaces1_extremePoints :
    ({z : Fin 4 → ℝ | (∀ j, -2 ≤ z j) ∧ -2 ≤ -(∑ j, z j) ∧
      z 1 ≤ z 0 ∧ z 2 ≤ z 1 ∧ z 3 ≤ z 2 ∧
      z 3 ≤ -(∑ j, z j) ∧ z 0 + z 1 ≤ 1 ∧
      -1 ≤ z 1 + z 2 + z 3}).extremePoints ℝ = Set.range minorantVertices1 := by
  apply Set.Subset.antisymm
  · rw [minorant_halfspaces1_eq_convexHull]
    exact extremePoints_convexHull_subset
  · rintro _ ⟨i, rfl⟩
    exact exposedPoints_subset_extremePoints (minorantVertices1_mem_exposedPoints i)

theorem minorantVertices1_injective : Function.Injective minorantVertices1 := by
  intro i j h
  fin_cases i <;> fin_cases j <;>
    norm_num [minorantVertices1, funext_iff, Fin.forall_fin_succ] at *

theorem minorant_halfspaces1_extremePoints_ncard :
    (({z : Fin 4 → ℝ | (∀ j, -2 ≤ z j) ∧ -2 ≤ -(∑ j, z j) ∧
      z 1 ≤ z 0 ∧ z 2 ≤ z 1 ∧ z 3 ≤ z 2 ∧
      z 3 ≤ -(∑ j, z j) ∧ z 0 + z 1 ≤ 1 ∧
      -1 ≤ z 1 + z 2 + z 3}).extremePoints ℝ).ncard = 7 := by
  rw [minorant_halfspaces1_extremePoints,
    Set.ncard_range_of_injective minorantVertices1_injective]
  simp

theorem minorant_halfspaces2_eq_convexHull :
    {z : Fin 4 → ℝ | (∀ j, -2 ≤ z j) ∧ -2 ≤ -(∑ j, z j) ∧
      z 1 ≤ z 0 ∧ z 1 ≤ z 2 ∧ z 3 ≤ -(∑ j, z j) ∧
      z 0 + z 2 ≤ 1 ∧ -1 ≤ z 0 + z 1 + z 3} =
      convexHull ℝ (Set.range minorantVertices2) := by
  apply Set.Subset.antisymm
  · rw [minorant_halfspaces2_eq_iUnion]
    exact Set.iUnion_subset fun j => convexHull_mono
      (Set.range_comp_subset_range (minorantSimplexIndices2 j) minorantVertices2)
  · exact convexHull_min (Set.range_subset_iff.mpr minorantVertices2_mem_halfspaces)
      convex_minorant_halfspaces2

theorem minorantVertices2_mem_exposedPoints (i : Fin 7) :
    minorantVertices2 i ∈
      ({z : Fin 4 → ℝ | (∀ j, -2 ≤ z j) ∧ -2 ≤ -(∑ j, z j) ∧
        z 1 ≤ z 0 ∧ z 1 ≤ z 2 ∧ z 3 ≤ -(∑ j, z j) ∧
        z 0 + z 2 ≤ 1 ∧ -1 ≤ z 0 + z 1 + z 3} : Set (Fin 4 → ℝ)).exposedPoints ℝ := by
  classical
  refine exposed_point_def.mpr ⟨minorantVertices2_mem_halfspaces i, ?_⟩
  let c : Fin 7 → Fin 4 → ℝ :=
    ![![0, 0, 0, 1], ![0, 1, 2, 1], ![1, -1, 2, 1], ![0, 2, 0, -1],
      ![1, 3, 1, 2], ![1, -1, 0, -1], ![2, 0, 1, 2]]
  refine ⟨(dotProductBilin ℝ ℝ (c i)).toContinuousLinearMap, ?_⟩
  intro y hy
  change (∑ k, c i k * y k) ≤ (∑ k, c i k * minorantVertices2 i k) ∧
    ((∑ k, c i k * minorantVertices2 i k) ≤ (∑ k, c i k * y k) →
      y = minorantVertices2 i)
  rcases hy with ⟨hyl, _, hy01, hy12, hyd, hy02, hy013⟩
  have hy0 := hyl 0
  have hy1 := hyl 1
  have hy2 := hyl 2
  have hy3 := hyl 3
  simp only [Fin.sum_univ_four] at hyd
  fin_cases i
  all_goals
    norm_num [c, minorantVertices2, Fin.sum_univ_four, Fin.reduceFinMk,
      Matrix.cons_val_two, Matrix.cons_val_three, Matrix.vecHead, Matrix.vecTail]
    constructor
    · linarith
    · intro h
      ext k
      fin_cases k
      all_goals
        norm_num [minorantVertices2, Fin.reduceFinMk, Matrix.cons_val_two, Matrix.cons_val_three,
          Matrix.vecHead, Matrix.vecTail]
        linarith!

theorem minorant_halfspaces2_extremePoints :
    ({z : Fin 4 → ℝ | (∀ j, -2 ≤ z j) ∧ -2 ≤ -(∑ j, z j) ∧
      z 1 ≤ z 0 ∧ z 1 ≤ z 2 ∧ z 3 ≤ -(∑ j, z j) ∧
      z 0 + z 2 ≤ 1 ∧ -1 ≤ z 0 + z 1 + z 3} : Set (Fin 4 → ℝ)).extremePoints ℝ =
      Set.range minorantVertices2 := by
  refine Set.Subset.antisymm ?_ ?_
  · rw [minorant_halfspaces2_eq_convexHull]
    exact extremePoints_convexHull_subset
  · rintro _ ⟨i, rfl⟩
    exact exposedPoints_subset_extremePoints (minorantVertices2_mem_exposedPoints i)

theorem minorant_halfspaces2_extremePoints_ncard :
    (({z : Fin 4 → ℝ | (∀ j, -2 ≤ z j) ∧ -2 ≤ -(∑ j, z j) ∧
      z 1 ≤ z 0 ∧ z 1 ≤ z 2 ∧ z 3 ≤ -(∑ j, z j) ∧
      z 0 + z 2 ≤ 1 ∧ -1 ≤ z 0 + z 1 + z 3} : Set (Fin 4 → ℝ)).extremePoints ℝ).ncard = 7 := by
  rw [minorant_halfspaces2_extremePoints, Set.ncard_range_of_injective]
  · simp
  · intro i j hij
    fin_cases i <;> fin_cases j
    all_goals
      norm_num [minorantVertices2, funext_iff, Fin.forall_fin_succ,
        Matrix.cons_val_two, Matrix.cons_val_three, Matrix.vecHead, Matrix.vecTail] at *

end

/--
The width of the uniform partition of `[2 * (9519 / 50000), 40481 / 100000]` into `1024` bins.
-/
def exceptionalBinStep : ℚ :=
  ((40481 / 100000 : ℚ) - 2 * (9519 / 50000 : ℚ)) / 1024

/-- The right endpoint of bin `j` in the `1024`-bin exceptional-mass partition. -/
def exceptionalBinRight (j : Fin 1024) : ℚ :=
  2 * (9519 / 50000 : ℚ) + ((j.val + 1 : ℕ) : ℚ) * exceptionalBinStep

theorem squarefree_five_prime_rank_model
    (n : ℕ) (hn : Squarefree n) (v : Fin 5 → ℕ)
    (hv : ∀ i, Nat.Prime (v i)) (hprod : (∏ i, v i) = n) :
    ∃ f : Fin 5 ↪o ℕ,
      (∀ i, Nat.Prime (f i)) ∧ (∏ i, f i) = n ∧
      (∀ i, ∃ j, f i = v j) ∧
      ∀ p : Fin 5 → ℕ, (∀ i, Nat.Prime (p i)) → (∏ i, p i) = n →
        ∃ σ : Equiv.Perm (Fin 5), p = fun i => f (σ i) := by
  classical
  have hinj (p : Fin 5 → ℕ) (hp : ∀ i, Nat.Prime (p i))
      (hpn : (∏ i, p i) = n) : Function.Injective p := by
    intro i j hij
    by_contra hne
    have hdiv := Finset.prod_dvd_prod_of_subset
      ({i, j} : Finset (Fin 5)) Finset.univ p (Finset.subset_univ _)
    rw [Finset.prod_pair hne, ← hij, hpn] at hdiv
    exact (Nat.squarefree_iff_prime_squarefree.mp hn (p i) (hp i)) hdiv
  let S : Finset ℕ := Finset.univ.image v
  have hcard : S.card = 5 := by
    dsimp only [S]
    rw [Finset.card_image_of_injective _ (hinj v hv hprod)]
    simp
  let f : Fin 5 ↪o ℕ := S.orderEmbOfFin hcard
  have hcover (i : Fin 5) : ∃ j, f i = v j := by
    obtain ⟨j, _, hj⟩ := Finset.mem_image.mp (S.orderEmbOfFin_mem hcard i)
    exact ⟨j, hj.symm⟩
  have hfprime (i : Fin 5) : Nat.Prime (f i) := by
    obtain ⟨j, hj⟩ := hcover i
    simpa only [hj] using hv j
  have hfprod : (∏ i, f i) = n := by
    have himage : Finset.univ.image f = S := S.image_orderEmbOfFin_univ hcard
    calc
      (∏ i, f i) = ∏ p ∈ Finset.univ.image f, p :=
        (Finset.prod_image (s := Finset.univ) (f := fun p : ℕ => p)
          f.injective.injOn).symm
      _ = ∏ p ∈ S, p := by rw [himage]
      _ = n := by
        dsimp only [S]
        rw [Finset.prod_image (hinj v hv hprod).injOn]
        exact hprod
  refine ⟨f, hfprime, hfprod, hcover, ?_⟩
  intro p hp hpn
  have hmem (i : Fin 5) : p i ∈ S := by
    have hdiv : p i ∣ ∏ j, v j := by
      rw [hprod, ← hpn]
      exact Finset.dvd_prod_of_mem p (Finset.mem_univ i)
    obtain ⟨j, hj, hd⟩ := (hp i).prime.exists_mem_finset_dvd hdiv
    exact Finset.mem_image.mpr
      ⟨j, hj, ((Nat.prime_dvd_prime_iff_eq (hp i) (hv j)).mp hd).symm⟩
  let e : Fin 5 ≃o S := S.orderIsoOfFin hcard
  let g : Fin 5 → Fin 5 := fun i => e.symm ⟨p i, hmem i⟩
  have hfg (i : Fin 5) : f (g i) = p i := by
    change ((e (e.symm ⟨p i, hmem i⟩) : S) : ℕ) = p i
    exact congrArg Subtype.val (e.apply_symm_apply ⟨p i, hmem i⟩)
  have hg : Function.Injective g := by
    intro i j hij
    apply hinj p hp hpn
    rw [← hfg i, ← hfg j, hij]
  let σ : Equiv.Perm (Fin 5) := Equiv.ofBijective g hg.bijective_of_finite
  refine ⟨σ, ?_⟩
  funext i
  exact (hfg i).symm

theorem eventually_exceptionalPrimeDefect_pair_majorant :
    ∀ᶠ x : ℝ in Filter.atTop, ∀ n : ℕ,
      x ≤ (n : ℝ) → (n : ℝ) ≤ 2 * x → Squarefree n →
      exceptionalPrimeDefect x 0 n + exceptionalPrimeDefect x 1 n ≤
        (12 / 5 : ℝ) *
          ((((Nat.primesLE n) ×ˢ (Nat.primesLE n)).filter
            (fun pq => pq.1 < pq.2 ∧ pq.1 * pq.2 ∣ n ∧
              x ^ ((9519 : ℝ) / 50000) ≤ (pq.1 : ℝ) ∧
              x ^ ((9519 : ℝ) / 50000) ≤ (pq.2 : ℝ) ∧
              ((pq.1 * pq.2 : ℕ) : ℝ) < x ^ ((40481 : ℝ) / 100000))).card : ℝ) := by
  classical
  filter_upwards [eventually_exceptional_large] with x hx
  intro n hlo hhi hsf
  have hx0 : 0 < x := zero_lt_one.trans hx.1
  have hn0 : 0 < n := Nat.cast_pos.mp (hx0.trans_le hlo)
  let a : ℝ := 40481 / 100000
  let b : ℝ := 59519 / 100000
  let xi : ℝ := 9519 / 50000
  let alpha : ℕ → ℝ := fun p => Real.logb x (p : ℝ)
  let T := Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n)
  let P0 : (Fin 5 → ℕ) → Prop := fun p =>
    (∏ i, p i) = n ∧ xi ≤ alpha (p 3) ∧
      alpha (p 3) < alpha (p 2) ∧ alpha (p 2) < alpha (p 1) ∧
      alpha (p 1) < alpha (p 0) ∧ alpha (p 0) < a ∧
      alpha (p 0) + alpha (p 1) < a ∧
      b < alpha (p 1) + alpha (p 2) + alpha (p 3) ∧
      (p 3 : ℝ) ≤ (p 4 : ℝ)
  let P1 : (Fin 5 → ℕ) → Prop := fun p =>
    (∏ i, p i) = n ∧
      (∀ i, xi ≤ alpha (p i) ∧ alpha (p i) ≤ 1 - 4 * xi) ∧
      alpha (p 1) < alpha (p 0) ∧ alpha (p 1) < alpha (p 2) ∧
      alpha (p 0) + alpha (p 2) < a ∧
      b < alpha (p 0) + alpha (p 1) + alpha (p 3) ∧
      alpha (p 3) ≤ alpha (p 4)
  let S0 := T.filter P0
  let S1 := T.filter P1
  let N2 := ((Nat.primesLE n) ×ˢ (Nat.primesLE n)).filter
    (fun pq => pq.1 < pq.2 ∧ pq.1 * pq.2 ∣ n ∧
      x ^ xi ≤ (pq.1 : ℝ) ∧ x ^ xi ≤ (pq.2 : ℝ) ∧
      ((pq.1 * pq.2 : ℕ) : ℝ) < x ^ a)
  have hb0 : exceptionalPrimeDefect x 0 n = (S0.card : ℝ) := by
    rw [exceptionalPrimeDefect_zero_eq_five hx.1 hx.2 hlo hhi]
    change (∑ p ∈ T, if P0 p then (1 : ℝ) else 0) = _
    rw [Finset.sum_boole]
  have hb1 : exceptionalPrimeDefect x 1 n = (S1.card : ℝ) := by
    change (∑ p ∈ T, if P1 p then (1 : ℝ) else 0) = _
    rw [Finset.sum_boole]
  have hprime (p : Fin 5 → ℕ) (hp : p ∈ T) (i : Fin 5) : Nat.Prime (p i) :=
    Nat.prime_of_mem_primesLE (Fintype.mem_piFinset.mp hp i)
  have hpos (p : Fin 5 → ℕ) (hp : p ∈ T) (i : Fin 5) : 0 < (p i : ℝ) :=
    Nat.cast_pos.mpr (hprime p hp i).pos
  have hproduct (p : Fin 5 → ℕ) (hp : p ∈ T) (r s : Fin 5)
      (h : alpha (p r) + alpha (p s) < a) :
      (p r : ℝ) * (p s : ℝ) < x ^ a := by
    apply (Real.logb_lt_iff_lt_rpow hx.1
      (mul_pos (hpos p hp r) (hpos p hp s))).mp
    rw [Real.logb_mul (hpos p hp r).ne' (hpos p hp s).ne']
    exact h
  have hrough0 (p : Fin 5 → ℕ) (hp : p ∈ T) (h : P0 p) :
      ∀ i, x ^ xi ≤ (p i : ℝ) := by
    rcases h with ⟨_, hxi, h32, h21, h10, _, _, _, h34⟩
    have h3 : x ^ xi ≤ (p 3 : ℝ) :=
      (Real.le_logb_iff_rpow_le hx.1 (hpos p hp 3)).mp hxi
    intro i
    fin_cases i
    · apply (Real.le_logb_iff_rpow_le hx.1 (hpos p hp 0)).mp
      change xi ≤ alpha (p 0)
      linarith
    · apply (Real.le_logb_iff_rpow_le hx.1 (hpos p hp 1)).mp
      change xi ≤ alpha (p 1)
      linarith
    · apply (Real.le_logb_iff_rpow_le hx.1 (hpos p hp 2)).mp
      change xi ≤ alpha (p 2)
      linarith
    · exact h3
    · exact h3.trans h34
  have hrough1 (p : Fin 5 → ℕ) (hp : p ∈ T) (h : P1 p) :
      ∀ i, x ^ xi ≤ (p i : ℝ) := by
    intro i
    exact (Real.le_logb_iff_rpow_le hx.1 (hpos p hp i)).mp (h.2.1 i).1
  by_cases hex : ∃ v ∈ T, P0 v ∨ P1 v
  · obtain ⟨v, hvT, hv⟩ := hex
    have hvprod : (∏ i, v i) = n := hv.elim And.left And.left
    have hvrough : ∀ i, x ^ xi ≤ (v i : ℝ) :=
      hv.elim (hrough0 v hvT) (hrough1 v hvT)
    obtain ⟨f, hfprime, hfprod, hfcover, hperm⟩ :=
      squarefree_five_prime_rank_model n hsf v (hprime v hvT) hvprod
    have hfpos (i : Fin 5) : 0 < (f i : ℝ) := Nat.cast_pos.mpr (hfprime i).pos
    have hfrough (i : Fin 5) : x ^ xi ≤ (f i : ℝ) := by
      obtain ⟨j, hj⟩ := hfcover i
      simpa only [hj] using hvrough j
    have hfdvd (i : Fin 5) : f i ∣ n := by
      rw [← hfprod]
      exact Finset.dvd_prod_of_mem f (Finset.mem_univ i)
    have hfloglt (r s : Fin 5) : alpha (f r) < alpha (f s) ↔ r < s := by
      dsimp only [alpha]
      rw [Real.logb_lt_logb_iff hx.1 (hfpos r) (hfpos s)]
      exact_mod_cast (f.lt_iff_lt : f r < f s ↔ r < s)
    have hflogle (r s : Fin 5) : alpha (f r) ≤ alpha (f s) ↔ r ≤ s := by
      dsimp only [alpha]
      rw [Real.logb_le_logb hx.1 (hfpos r) (hfpos s)]
      exact_mod_cast (f.le_iff_le : f r ≤ f s ↔ r ≤ s)
    let E : Finset (Fin 5 × Fin 5) := Finset.univ.filter
      (fun t => t.1 < t.2 ∧ ((f t.1 * f t.2 : ℕ) : ℝ) < x ^ a)
    have hE (t : Fin 5 × Fin 5) (ht : t ∈ E) : t.1 < t.2 :=
      (Finset.mem_filter.mp ht).2.1
    have hlower : ∀ t ∈ E, ∀ r s : Fin 5,
        r < s → r ≤ t.1 → s ≤ t.2 → (r, s) ∈ E := by
      intro t ht r s hrs hr hs
      have hmul : ((f r * f s : ℕ) : ℝ) ≤ ((f t.1 * f t.2 : ℕ) : ℝ) := by
        exact_mod_cast Nat.mul_le_mul (f.monotone hr) (f.monotone hs)
      exact Finset.mem_filter.mpr
        ⟨Finset.mem_univ _, hrs, hmul.trans_lt (Finset.mem_filter.mp ht).2.2⟩
    have hcardE : E.card ≤ N2.card := by
      apply Finset.card_le_card_of_injOn
        (fun t : Fin 5 × Fin 5 => (f t.1, f t.2))
      · intro t ht
        have htlt := hE t ht
        exact Finset.mem_filter.mpr
          ⟨Finset.mem_product.mpr
            ⟨Nat.mem_primesLE.mpr ⟨Nat.le_of_dvd hn0 (hfdvd t.1), hfprime t.1⟩,
              Nat.mem_primesLE.mpr ⟨Nat.le_of_dvd hn0 (hfdvd t.2), hfprime t.2⟩⟩,
            f.strictMono htlt,
            Nat.Prime.dvd_mul_of_dvd_ne (f.strictMono htlt).ne
              (hfprime t.1) (hfprime t.2) (hfdvd t.1) (hfdvd t.2),
            hfrough t.1, hfrough t.2,
            (Finset.mem_filter.mp ht).2.2⟩
      · exact (f.injective.prodMap f.injective).injOn
    let R0 := (Finset.univ : Finset (Equiv.Perm (Fin 5))).filter
      (fun σ => σ 3 < σ 2 ∧ σ 2 < σ 1 ∧ σ 1 < σ 0 ∧
        σ 3 ≤ σ 4 ∧ (σ 1, σ 0) ∈ E)
    let R1 := (Finset.univ : Finset (Equiv.Perm (Fin 5))).filter
      (fun σ => σ 1 < σ 0 ∧ σ 1 < σ 2 ∧ σ 3 ≤ σ 4 ∧
        (min (σ 0) (σ 2), max (σ 0) (σ 2)) ∈ E)
    have hS0 : S0 ⊆ R0.image (fun σ : Equiv.Perm (Fin 5) => fun i => f (σ i)) := by
      intro p hp
      obtain ⟨hpT, hp0⟩ := Finset.mem_filter.mp hp
      obtain ⟨σ, hσ⟩ := hperm p (hprime p hpT) hp0.1
      rcases hp0 with ⟨_, _, h32, h21, h10, _, hsum, _, h34⟩
      have h32' : σ 3 < σ 2 := (hfloglt _ _).mp (by simpa only [hσ] using h32)
      have h21' : σ 2 < σ 1 := (hfloglt _ _).mp (by simpa only [hσ] using h21)
      have h10' : σ 1 < σ 0 := (hfloglt _ _).mp (by simpa only [hσ] using h10)
      have h34' : σ 3 ≤ σ 4 := by
        apply f.le_iff_le.mp
        have hn : p 3 ≤ p 4 := by exact_mod_cast h34
        simpa only [hσ] using hn
      have hpair : (σ 1, σ 0) ∈ E := by
        apply Finset.mem_filter.mpr
        refine ⟨Finset.mem_univ _, h10', ?_⟩
        simpa only [hσ, Nat.cast_mul, mul_comm] using hproduct p hpT 0 1 hsum
      exact Finset.mem_image.mpr
        ⟨σ, Finset.mem_filter.mpr
          ⟨Finset.mem_univ _, h32', h21', h10', h34', hpair⟩, hσ.symm⟩
    have hS1 : S1 ⊆ R1.image (fun σ : Equiv.Perm (Fin 5) => fun i => f (σ i)) := by
      intro p hp
      obtain ⟨hpT, hp1⟩ := Finset.mem_filter.mp hp
      obtain ⟨σ, hσ⟩ := hperm p (hprime p hpT) hp1.1
      rcases hp1 with ⟨_, _, h10, h12, hsum, _, h34⟩
      have h10' : σ 1 < σ 0 := (hfloglt _ _).mp (by simpa only [hσ] using h10)
      have h12' : σ 1 < σ 2 := (hfloglt _ _).mp (by simpa only [hσ] using h12)
      have h34' : σ 3 ≤ σ 4 := (hflogle _ _).mp (by simpa only [hσ] using h34)
      have h02 : σ 0 ≠ σ 2 := fun h => (by decide : (0 : Fin 5) ≠ 2) (σ.injective h)
      have hpair : (min (σ 0) (σ 2), max (σ 0) (σ 2)) ∈ E := by
        apply Finset.mem_filter.mpr
        refine ⟨Finset.mem_univ _, min_lt_max.mpr h02, ?_⟩
        rw [fn_min_mul_fn_max f]
        simpa only [hσ, Nat.cast_mul] using hproduct p hpT 0 2 hsum
      exact Finset.mem_image.mpr
        ⟨σ, Finset.mem_filter.mpr
          ⟨Finset.mem_univ _, h10', h12', h34', hpair⟩, hσ.symm⟩
    have hcard0 : S0.card ≤ R0.card :=
      (Finset.card_le_card hS0).trans Finset.card_image_le
    have hcard1 : S1.card ≤ R1.card :=
      (Finset.card_le_card hS1).trans Finset.card_image_le
    have hcounts := exceptional_rank_permutation_counts E hE
    have hbound := exceptional_rank_lower_set_bound E hE hlower
    have hnat : 5 * (S0.card + S1.card) ≤ 12 * N2.card := by
      calc
        _ ≤ 5 * (R0.card + R1.card) := Nat.mul_le_mul_left 5 (Nat.add_le_add hcard0 hcard1)
        _ = 5 * ((if (3, 4) ∈ E then 2 else 0) +
            (if (2, 4) ∈ E then 1 else 0) +
            (if (2, 3) ∈ E then 1 else 0) + 2 * ∑ t ∈ E, t.1.val) := by
          rw [hcounts.1, hcounts.2]
        _ ≤ 12 * E.card := hbound
        _ ≤ 12 * N2.card := Nat.mul_le_mul_left 12 hcardE
    have hreal : (5 : ℝ) * ((S0.card : ℝ) + (S1.card : ℝ)) ≤
        12 * (N2.card : ℝ) := by exact_mod_cast hnat
    rw [hb0, hb1]
    change (S0.card : ℝ) + (S1.card : ℝ) ≤ (12 / 5 : ℝ) * (N2.card : ℝ)
    linarith
  · have hempty0 : S0 = ∅ := Finset.filter_eq_empty_iff.mpr
      (fun p hp h => hex ⟨p, hp, Or.inl h⟩)
    have hempty1 : S1 = ∅ := Finset.filter_eq_empty_iff.mpr
      (fun p hp h => hex ⟨p, hp, Or.inr h⟩)
    rw [hb0, hb1, hempty0, hempty1]
    simpa only [Finset.card_empty, Nat.cast_zero, zero_add] using
      (mul_nonneg (by norm_num : (0 : ℝ) ≤ 12 / 5) (Nat.cast_nonneg N2.card))

open Real Finset Filter Asymptotics

theorem exceptionalPrimeDefect_le_divisors_fifth (x : ℝ) (j : Fin 2) (n : ℕ) :
    exceptionalPrimeDefect x j n ≤ (n.divisors.card : ℝ) ^ 5 := by
  classical
  by_cases hn : n = 0
  · simp only [hn, ArithmeticFunction.map_zero, Nat.divisors_zero, Finset.card_empty,
      Nat.cast_zero, zero_pow (by decide : (5 : ℕ) ≠ 0), le_refl]
  have hcount {k : ℕ} (S : Finset (Fin k → ℕ)) :
      (∑ p ∈ S, if (∏ i, p i) = n then (1 : ℝ) else 0) ≤
        (n.divisors.card : ℝ) ^ k := by
    rw [Finset.sum_boole]
    have hsub : S.filter (fun p => (∏ i, p i) = n) ⊆
        Fintype.piFinset (fun _ : Fin k => n.divisors) := by
      intro p hp
      apply Fintype.mem_piFinset.mpr
      intro i
      refine Nat.mem_divisors.mpr ⟨?_, hn⟩
      rw [← (Finset.mem_filter.mp hp).2]
      exact Finset.dvd_prod_of_mem p (Finset.mem_univ i)
    have hcard := Finset.card_le_card hsub
    rw [Fintype.card_piFinset_const] at hcard
    exact_mod_cast hcard
  have hrough (z : ℝ) (r : ℕ) : roughWeight z r ≤ 1 := by
    change (if r ≠ 0 ∧ ∀ p ∈ r.primeFactors, z ≤ (p : ℝ) then (1 : ℝ) else 0) ≤ 1
    split_ifs <;> norm_num
  dsimp only [exceptionalPrimeDefect, ArithmeticFunction.coe_mk]
  split_ifs
  · let P := Fintype.piFinset (fun _ : Fin 4 => Nat.primesLE n)
    let T := P ×ˢ Finset.Icc 1 n
    let f : ((Fin 4 → ℕ) × ℕ) → (Fin 5 → ℕ) := fun v => Fin.snoc v.1 v.2
    have hf : Function.Injective f := fun _ _ he => Prod.ext_iff.mpr (Fin.snoc_inj.mp he)
    calc
      _ ≤ ∑ p ∈ P, ∑ r ∈ Finset.Icc 1 n,
          if (∏ i, p i) * r = n then (1 : ℝ) else 0 := by
        apply Finset.sum_le_sum
        intro p hp
        apply Finset.sum_le_sum
        intro r hr
        by_cases he : (∏ i, p i) * r = n
        · rw [ite_eq_left he]
          split_ifs
          · exact hrough _ _
          · norm_num
        · simp only [he, false_and, ite_false, le_refl]
      _ = ∑ v ∈ T, if (∏ i, f v i) = n then (1 : ℝ) else 0 := by
        simp only [T, Finset.sum_product, f, Fin.prod_snoc]
      _ = ∑ p ∈ T.image f, if (∏ i, p i) = n then (1 : ℝ) else 0 := by
        rw [Finset.sum_image hf.injOn]
      _ ≤ _ := hcount (T.image f)
  · calc
      _ ≤ ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
          if (∏ i, p i) = n then (1 : ℝ) else 0 := by
        apply Finset.sum_le_sum
        intro p hp
        by_cases he : (∏ i, p i) = n
        · rw [ite_eq_left he]
          split_ifs <;> norm_num
        · simp only [he, false_and, ite_false, le_refl]
      _ ≤ _ := hcount _

theorem exceptionalPrimeDefect_uniform_subpower (ε : ℝ) (hε : 0 < ε) :
    ∃ D : ℝ, 0 < D ∧ ∀ x : ℝ, ∀ j : Fin 2, ∀ n : ℕ, n ≠ 0 →
      exceptionalPrimeDefect x j n ≤ D * (n : ℝ) ^ ε := by
  obtain ⟨D, hD, hbound⟩ := exists_divisorPower_bound 5 hε
  exact ⟨D, hD, fun x j n hn =>
    (exceptionalPrimeDefect_le_divisors_fifth x j n).trans (hbound n hn)⟩

open Classical in
theorem exceptionalPrimeDefect_shifted_endpoint_error
    (h : ℕ) (w : ℝ → ℕ → ℝ)
    (hw : ∃ C : ℝ, 0 < C ∧ ∀ᶠ x : ℝ in atTop,
      ∀ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, |w x n| ≤ C * x ^ (1 / 8 : ℝ)) :
    (fun x : ℝ => ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
      if 2 * x < ((n + h : ℕ) : ℝ) then
        (exceptionalPrimeDefect x 0 (n + h) + exceptionalPrimeDefect x 1 (n + h)) *
          w x n ^ 2 else 0) =O[atTop] (fun x : ℝ => x ^ (1 / 2 : ℝ)) := by
  obtain ⟨C, hC, hw⟩ := hw
  obtain ⟨D, hD, hd⟩ := exceptionalPrimeDefect_uniform_subpower (1 / 4 : ℝ) (by norm_num)
  let F : ℝ := 2 * D * (3 : ℝ) ^ (1 / 4 : ℝ) * C ^ 2
  have hF : 0 ≤ F := by dsimp only [F]; positivity
  apply Asymptotics.IsBigO.of_bound ((h : ℝ) * F)
  filter_upwards [hw, Filter.eventually_ge_atTop (max (1 : ℝ) (h : ℝ))] with x hwx hx
  have hx1 : 1 ≤ x := (le_max_left _ _).trans hx
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hh : (h : ℝ) ≤ x := (le_max_right _ _).trans hx
  let I := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
  let T := I.filter (fun n => 2 * x < ((n + h : ℕ) : ℝ))
  let b : ℕ → ℝ := fun n =>
    exceptionalPrimeDefect x 0 (n + h) + exceptionalPrimeDefect x 1 (n + h)
  have hb0 (n : ℕ) : 0 ≤ b n :=
    add_nonneg (exceptionalPrimeDefect_nonneg x 0 _) (exceptionalPrimeDefect_nonneg x 1 _)
  have hsum : (∑ n ∈ I, if 2 * x < ((n + h : ℕ) : ℝ) then b n * w x n ^ 2 else 0) =
      ∑ n ∈ T, b n * w x n ^ 2 := (Finset.sum_filter _ _).symm
  have hsum0 : 0 ≤ ∑ n ∈ T, b n * w x n ^ 2 :=
    Finset.sum_nonneg fun n _ => mul_nonneg (hb0 n) (sq_nonneg _)
  have hmap : Set.MapsTo (fun n : ℕ => n + h) T
      (Finset.Ioc ⌊2 * x⌋₊ (⌊2 * x⌋₊ + h)) := by
    intro n hn
    obtain ⟨hnI, htail⟩ := Finset.mem_filter.mp hn
    apply Finset.mem_Ioc.mpr
    refine ⟨?_, Nat.add_le_add_right (Finset.mem_Icc.mp hnI).2 h⟩
    have hfloor : (⌊2 * x⌋₊ : ℝ) ≤ 2 * x := Nat.floor_le (by positivity)
    exact_mod_cast hfloor.trans_lt htail
  have hcard : T.card ≤ h := by
    have ht := Finset.card_le_card_of_injOn (fun n : ℕ => n + h) hmap
      (fun _ _ _ _ he => Nat.add_right_cancel he)
    simpa only [Nat.card_Ioc, Nat.add_sub_cancel_left] using ht
  have hbound (n : ℕ) (hn : n ∈ T) : b n * w x n ^ 2 ≤ F * x ^ (1 / 2 : ℝ) := by
    have hnI := (Finset.mem_filter.mp hn).1
    have hnx : x ≤ (n : ℝ) := Nat.le_of_ceil_le (Finset.mem_Icc.mp hnI).1
    have hn2 : (n : ℝ) ≤ 2 * x :=
      (Nat.le_floor_iff (by positivity)).mp (Finset.mem_Icc.mp hnI).2
    have hnh0 : n + h ≠ 0 := by
      have hn0 : 0 < n := Nat.cast_pos.mp (hx0.trans_le hnx)
      exact (Nat.add_pos_left hn0 h).ne'
    have hnh3 : ((n + h : ℕ) : ℝ) ≤ 3 * x := by
      push_cast
      linarith
    have hb : b n ≤ 2 * D * (3 : ℝ) ^ (1 / 4 : ℝ) * x ^ (1 / 4 : ℝ) := by
      calc
        _ ≤ D * ((n + h : ℕ) : ℝ) ^ (1 / 4 : ℝ) +
            D * ((n + h : ℕ) : ℝ) ^ (1 / 4 : ℝ) :=
          add_le_add (hd x 0 (n + h) hnh0) (hd x 1 (n + h) hnh0)
        _ = 2 * D * ((n + h : ℕ) : ℝ) ^ (1 / 4 : ℝ) := by ring
        _ ≤ 2 * D * (3 * x) ^ (1 / 4 : ℝ) :=
          mul_le_mul_of_nonneg_left
            (Real.rpow_le_rpow (Nat.cast_nonneg _) hnh3 (by norm_num)) (by positivity)
        _ = _ := by rw [Real.mul_rpow (by norm_num : (0 : ℝ) ≤ 3) hx0.le]; ring
    have hw2 : w x n ^ 2 ≤ C ^ 2 * x ^ (1 / 4 : ℝ) := by
      have ht := pow_le_pow_left₀ (abs_nonneg (w x n)) (hwx n hnI) 2
      rw [sq_abs, mul_pow, ← Real.rpow_mul_natCast hx0.le] at ht
      norm_num at ht
      exact ht
    calc
      _ ≤ (2 * D * (3 : ℝ) ^ (1 / 4 : ℝ) * x ^ (1 / 4 : ℝ)) *
          (C ^ 2 * x ^ (1 / 4 : ℝ)) := mul_le_mul hb hw2 (sq_nonneg _) (by positivity)
      _ = F * (x ^ (1 / 4 : ℝ) * x ^ (1 / 4 : ℝ)) := by dsimp only [F]; ring
      _ = F * x ^ (1 / 2 : ℝ) := by rw [← Real.rpow_add hx0]; norm_num
  have htotal : (∑ n ∈ T, b n * w x n ^ 2) ≤ (h : ℝ) * F * x ^ (1 / 2 : ℝ) := by
    calc
      _ ≤ ∑ _n ∈ T, F * x ^ (1 / 2 : ℝ) := Finset.sum_le_sum hbound
      _ = (T.card : ℝ) * (F * x ^ (1 / 2 : ℝ)) := by simp
      _ ≤ (h : ℝ) * (F * x ^ (1 / 2 : ℝ)) :=
        mul_le_mul_of_nonneg_right (Nat.cast_le.mpr hcard) (by positivity)
      _ = _ := by ring
  change ‖∑ n ∈ I, if 2 * x < ((n + h : ℕ) : ℝ) then b n * w x n ^ 2 else 0‖ ≤
    (h : ℝ) * F * ‖x ^ (1 / 2 : ℝ)‖
  rw [hsum, Real.norm_of_nonneg hsum0, Real.norm_of_nonneg (Real.rpow_nonneg hx0.le _)]
  exact htotal

end PrimeGap186

section
open Filter Asymptotics
open Classical in
theorem PrimeGap186.shifted_nonsquarefree_exceptional_weighted_isBigO
    (h : ℕ) (w : ℝ → ℕ → ℝ)
    (hw : ∃ C : ℝ, 0 < C ∧ ∀ᶠ x : ℝ in Filter.atTop,
      ∀ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        |w x n| ≤ C * x ^ (((9519 : ℝ) / 50000) / 4)) :
    (fun x : ℝ => ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
      if ¬Squarefree (n + h) ∧ ((n + h : ℕ) : ℝ) ≤ 2 * x then
        (PrimeGap186.exceptionalPrimeDefect x 0 (n + h) +
          PrimeGap186.exceptionalPrimeDefect x 1 (n + h)) * (w x n) ^ 2
      else 0) =O[Filter.atTop]
      (fun x : ℝ => x ^ (1 - ((9519 : ℝ) / 50000) / 2)) := by
  obtain ⟨C, hC, hw⟩ := hw
  apply Asymptotics.IsBigO.of_bound (25004 * C ^ 2)
  let ξ : ℝ := 9519 / 50000
  have hpower := tendsto_rpow_atTop (by norm_num [ξ] : 0 < ξ)
  filter_upwards [hw, PrimeGap186.eventually_literal_minorant_pointwise,
    Filter.eventually_gt_atTop (1 : ℝ), hpower.eventually_ge_atTop 2]
    with x hwx hminor hx hY
  let Y : ℝ := x ^ ξ
  let r : ℕ := Nat.ceil Y
  let N : ℕ := Nat.floor (2 * x)
  let I := Finset.Icc (Nat.ceil x) N
  let B : ℕ → ℝ := fun n =>
    PrimeGap186.exceptionalPrimeDefect x 0 (n + h) + PrimeGap186.exceptionalPrimeDefect x 1 (n + h)
  let S := I.filter (fun n =>
    (¬Squarefree (n + h) ∧ ((n + h : ℕ) : ℝ) ≤ 2 * x) ∧ B n ≠ 0)
  let T := (Finset.Icc 1 N).filter
    (fun n => ∃ m ∈ Finset.Icc r N, m ^ 2 ∣ n)
  let K : ℝ := 6251 * (C ^ 2 * x ^ (ξ / 2))
  have hx0 : 0 < x := lt_trans zero_lt_one hx
  have hY0 : 0 < Y := Real.rpow_pos_of_pos hx0 _
  have hY2 : 2 ≤ Y := hY
  have hYr : Y ≤ (r : ℝ) := Nat.le_ceil Y
  have hr : 2 ≤ r := by exact_mod_cast hY2.trans hYr
  have hr1 : 1 ≤ r := by omega
  have hden : Y / 2 ≤ ((r - 1 : ℕ) : ℝ) := by
    rw [Nat.cast_sub hr1, Nat.cast_one]
    linarith
  have hden0 : 0 < ((r - 1 : ℕ) : ℝ) := (half_pos hY0).trans_le hden
  have hN : (N : ℝ) ≤ 2 * x := Nat.floor_le (by positivity)
  have hBnonneg (n : ℕ) : 0 ≤ B n :=
    add_nonneg (PrimeGap186.exceptionalPrimeDefect_nonneg x 0 (n + h))
      (PrimeGap186.exceptionalPrimeDefect_nonneg x 1 (n + h))
  have hproperties (n : ℕ) (hn : n ∈ I)
      (hbad : ¬Squarefree (n + h)) (hupper : ((n + h : ℕ) : ℝ) ≤ 2 * x) :
      B n ≤ 6251 ∧ (B n ≠ 0 → n + h ≠ 0 ∧
        ∀ p ∈ (n + h).primeFactors, Y ≤ (p : ℝ)) := by
    have hlower : x ≤ ((n + h : ℕ) : ℝ) :=
      (Nat.le_of_ceil_le (Finset.mem_Icc.mp hn).1).trans
        (Nat.cast_le.mpr (Nat.le_add_right n h))
    have hp : ¬(n + h).Prime := fun hp => hbad hp.squarefree
    have hm := hminor (n + h) hlower hupper
    dsimp only at hm
    have hrho : (if (n + h).Prime then (1 : ℝ) else 0) -
        PrimeGap186.exceptionalPrimeDefect x 0 (n + h) -
          PrimeGap186.exceptionalPrimeDefect x 1 (n + h) =
        -B n := by
      simp only [hp, ite_false, B, sub_eq_add_neg, neg_add, zero_add]
    rw [hrho] at hm
    refine ⟨?_, fun hnz => hm.2.2.1 (neg_ne_zero.mpr hnz)⟩
    simpa only [abs_neg, abs_of_nonneg (hBnonneg n)] using hm.2.2.2
  have hcard_nat : S.card ≤ T.card := by
    apply Finset.card_le_card_of_injOn (fun n => n + h)
    · intro n hn
      obtain ⟨hn, hcond, hnz⟩ := Finset.mem_filter.mp hn
      obtain ⟨hm0, hrough⟩ := (hproperties n hn hcond.1 hcond.2).2 hnz
      have hmN : n + h ≤ N := Nat.le_floor hcond.2
      obtain ⟨p, hp, hpp⟩ : ∃ p : ℕ, p.Prime ∧ p * p ∣ n + h := by
        simpa only [Nat.squarefree_iff_prime_squarefree, not_forall,
          not_imp, not_not, exists_prop] using hcond.1
      have hpd : p ∣ n + h := (dvd_mul_right p p).trans hpp
      have hpm := hp.mem_primeFactors hpd hm0
      have hplow : r ≤ p := Nat.ceil_le.mpr (hrough p hpm)
      have hphi : p ≤ N := (Nat.le_of_mem_primeFactors hpm).trans hmN
      exact Finset.mem_filter.mpr
        ⟨Finset.mem_Icc.mpr ⟨Nat.one_le_iff_ne_zero.mpr hm0, hmN⟩,
          p, Finset.mem_Icc.mpr ⟨hplow, hphi⟩, by simpa only [pow_two] using hpp⟩
    · intro n _ m _ hnm
      exact Nat.add_right_cancel hnm
  have hcard : (S.card : ℝ) ≤ 4 * x ^ (1 - ξ) := by
    calc
      _ ≤ (T.card : ℝ) := by exact_mod_cast hcard_nat
      _ ≤ (N : ℝ) / ((r - 1 : ℕ) : ℝ) := PrimeGap186.large_square_divisor_count_le N r hr
      _ ≤ (2 * x) / ((r - 1 : ℕ) : ℝ) := div_le_div_of_nonneg_right hN hden0.le
      _ ≤ (2 * x) / (Y / 2) :=
        div_le_div_of_nonneg_left (by positivity) (half_pos hY0) hden
      _ = 4 * x ^ (1 - ξ) := by
        rw [Real.rpow_sub hx0, Real.rpow_one]
        dsimp only [Y]
        ring
  have hweight (n : ℕ) (hn : n ∈ I) : (w x n) ^ 2 ≤ C ^ 2 * x ^ (ξ / 2) := by
    calc
      _ = |w x n| ^ 2 := (sq_abs _).symm
      _ ≤ (C * x ^ (ξ / 4)) ^ 2 :=
        pow_le_pow_left₀ (abs_nonneg _) (hwx n hn) 2
      _ = C ^ 2 * x ^ (ξ / 2) := by
        rw [mul_pow, ← Real.rpow_mul_natCast hx0.le]
        congr 2
        ring
  have hpoint (n : ℕ) (hn : n ∈ I) :
      (if ¬Squarefree (n + h) ∧ ((n + h : ℕ) : ℝ) ≤ 2 * x then
        B n * (w x n) ^ 2 else 0) ≤
      if (¬Squarefree (n + h) ∧ ((n + h : ℕ) : ℝ) ≤ 2 * x) ∧ B n ≠ 0
        then K else 0 := by
    by_cases hc : ¬Squarefree (n + h) ∧ ((n + h : ℕ) : ℝ) ≤ 2 * x
    · by_cases hb : B n = 0
      · simp [hc, hb]
      · rw [ite_eq_left hc, ite_eq_left ⟨hc, hb⟩]
        exact mul_le_mul (hproperties n hn hc.1 hc.2).1 (hweight n hn)
          (sq_nonneg _) (by norm_num)
    · simpa only [hc, false_and, ite_false] using (le_refl (0 : ℝ))
  have hsum_nonneg : 0 ≤ ∑ n ∈ I,
      if ¬Squarefree (n + h) ∧ ((n + h : ℕ) : ℝ) ≤ 2 * x then
        B n * (w x n) ^ 2 else 0 :=
    Finset.sum_nonneg fun n _ => by
      split_ifs
      · exact mul_nonneg (hBnonneg n) (sq_nonneg _)
      · exact le_rfl
  have hsum : (∑ n ∈ I,
      if ¬Squarefree (n + h) ∧ ((n + h : ℕ) : ℝ) ≤ 2 * x then
        B n * (w x n) ^ 2 else 0) ≤ (S.card : ℝ) * K := by
    calc
      _ ≤ ∑ n ∈ I,
          if (¬Squarefree (n + h) ∧ ((n + h : ℕ) : ℝ) ≤ 2 * x) ∧ B n ≠ 0
            then K else 0 := Finset.sum_le_sum hpoint
      _ = _ := by rw [← Finset.sum_filter, Finset.sum_const, nsmul_eq_mul]
  have hbound : (∑ n ∈ I,
      if ¬Squarefree (n + h) ∧ ((n + h : ℕ) : ℝ) ≤ 2 * x then
        B n * (w x n) ^ 2 else 0) ≤ 25004 * C ^ 2 * x ^ (1 - ξ / 2) := by
    calc
      _ ≤ (S.card : ℝ) * K := hsum
      _ ≤ (4 * x ^ (1 - ξ)) * K :=
        mul_le_mul_of_nonneg_right hcard (by positivity)
      _ = 25004 * C ^ 2 * (x ^ (1 - ξ) * x ^ (ξ / 2)) := by
        dsimp only [K]
        ring
      _ = 25004 * C ^ 2 * x ^ (1 - ξ / 2) := by
        rw [← Real.rpow_add hx0, show (1 - ξ) + ξ / 2 = 1 - ξ / 2 by ring]
  have htarget_nonneg : 0 ≤ x ^ (1 - ξ / 2) := Real.rpow_nonneg hx0.le _
  dsimp only [I, N, B, ξ] at hsum_nonneg hbound htarget_nonneg
  simpa only [Real.norm_eq_abs, abs_of_nonneg hsum_nonneg,
    abs_of_nonneg htarget_nonneg] using hbound

end

namespace PrimeGap186

theorem exceptional_pair_count_eq_sum_bin_card
    (x : ℝ) (hx : 1 < x) (n : ℕ) (hn : 0 < n) :
    (((Nat.primesLE n) ×ˢ (Nat.primesLE n)).filter
      (fun pq => pq.1 < pq.2 ∧ pq.1 * pq.2 ∣ n ∧
        x ^ ((9519 : ℝ) / 50000) ≤ (pq.1 : ℝ) ∧
        x ^ ((9519 : ℝ) / 50000) ≤ (pq.2 : ℝ) ∧
        ((pq.1 * pq.2 : ℕ) : ℝ) < x ^ ((40481 : ℝ) / 100000))).card =
      ∑ j : Fin 1024,
        ((markedPrimePairBin x ((9519 : ℝ) / 50000)
          ((40481 : ℝ) / 100000)
          ((exceptionalBinRight j : ℝ) -
            (exceptionalBinStep : ℝ))
          (exceptionalBinRight j : ℝ)).filter
            (fun pq => pq.1 * pq.2 ∣ n)).card := by
  classical
  let xi : ℝ := 9519 / 50000
  let a : ℝ := 40481 / 100000
  let h : ℝ := (exceptionalBinStep : ℝ)
  let R (j : Fin 1024) : ℝ := (exceptionalBinRight j : ℝ)
  let s (pq : ℕ × ℕ) : ℝ := Real.logb x ((pq.1 * pq.2 : ℕ) : ℝ)
  let U : Finset (ℕ × ℕ) := ((Nat.primesLE n) ×ˢ (Nat.primesLE n)).filter
    (fun pq => pq.1 < pq.2 ∧ pq.1 * pq.2 ∣ n ∧
      x ^ xi ≤ (pq.1 : ℝ) ∧ x ^ xi ≤ (pq.2 : ℝ) ∧
      ((pq.1 * pq.2 : ℕ) : ℝ) < x ^ a)
  let B (j : Fin 1024) : Finset (ℕ × ℕ) :=
    (markedPrimePairBin x xi a (R j - h) (R j)).filter
      (fun pq => pq.1 * pq.2 ∣ n)
  change U.card = ∑ j : Fin 1024, (B j).card
  have hh : 0 < h := by norm_num [h, exceptionalBinStep]
  have ha : 2 * xi + 1024 * h = a := by
    norm_num [a, xi, h, exceptionalBinStep]
  have hR (j : Fin 1024) : R j = 2 * xi + ((j.val : ℝ) + 1) * h := by
    norm_num [R, h, xi, exceptionalBinRight]
  have hB (j : Fin 1024) (pq : ℕ × ℕ) :
      pq ∈ B j ↔ pq ∈ U ∧ R j - h < s pq ∧ s pq ≤ R j := by
    constructor
    · intro hpq
      obtain ⟨hbin, hd⟩ := Finset.mem_filter.mp hpq
      obtain ⟨hbox, hlt, hp, hq, hl, hu, hprod⟩ := Finset.mem_filter.mp hbin
      have hpp := Nat.prime_of_mem_primesLE (Finset.mem_product.mp hbox).1
      have hqp := Nat.prime_of_mem_primesLE (Finset.mem_product.mp hbox).2
      refine ⟨Finset.mem_filter.mpr
        ⟨Finset.mem_product.mpr ⟨?_, ?_⟩, hlt, hd, hp, hq, hprod⟩, hl, hu⟩
      · exact Nat.mem_primesLE.mpr
          ⟨Nat.le_of_dvd hn ((dvd_mul_right pq.1 pq.2).trans hd), hpp⟩
      · exact Nat.mem_primesLE.mpr
          ⟨Nat.le_of_dvd hn ((dvd_mul_left pq.2 pq.1).trans hd), hqp⟩
    · rintro ⟨hpq, hl, hu⟩
      obtain ⟨hbox, hlt, hd, hp, hq, hprod⟩ := Finset.mem_filter.mp hpq
      have hpp := Nat.prime_of_mem_primesLE (Finset.mem_product.mp hbox).1
      have hqp := Nat.prime_of_mem_primesLE (Finset.mem_product.mp hbox).2
      have hpbound : pq.1 ≤ ⌊x ^ a⌋₊ := Nat.le_floor
        ((Nat.cast_le.mpr (Nat.le_mul_of_pos_right pq.1 hqp.pos)).trans hprod.le)
      have hqbound : pq.2 ≤ ⌊x ^ a⌋₊ := Nat.le_floor
        ((Nat.cast_le.mpr (Nat.le_mul_of_pos_left pq.2 hpp.pos)).trans hprod.le)
      exact Finset.mem_filter.mpr ⟨Finset.mem_filter.mpr
        ⟨Finset.mem_product.mpr
          ⟨Nat.mem_primesLE.mpr ⟨hpbound, hpp⟩, Nat.mem_primesLE.mpr ⟨hqbound, hqp⟩⟩,
          hlt, hp, hq, hl, hu, hprod⟩, hd⟩
  have hbounds (pq : ℕ × ℕ) (hpq : pq ∈ U) : 2 * xi < s pq ∧ s pq < a := by
    obtain ⟨hbox, hlt, _, hp, _, hprod⟩ := Finset.mem_filter.mp hpq
    have hpp := Nat.prime_of_mem_primesLE (Finset.mem_product.mp hbox).1
    have hqp := Nat.prime_of_mem_primesLE (Finset.mem_product.mp hbox).2
    have hp0 : 0 < (pq.1 : ℝ) := Nat.cast_pos.mpr hpp.pos
    have hq0 : 0 < (pq.2 : ℝ) := Nat.cast_pos.mpr hqp.pos
    have hplog : xi ≤ Real.logb x (pq.1 : ℝ) :=
      (Real.le_logb_iff_rpow_le hx hp0).mpr hp
    have hpqlog : Real.logb x (pq.1 : ℝ) < Real.logb x (pq.2 : ℝ) :=
      Real.logb_lt_logb hx hp0 (Nat.cast_lt.mpr hlt)
    have hs : s pq = Real.logb x (pq.1 : ℝ) + Real.logb x (pq.2 : ℝ) := by
      dsimp only [s]
      rw [Nat.cast_mul, Real.logb_mul hp0.ne' hq0.ne']
    constructor
    · rw [hs]
      linarith
    · exact (Real.logb_lt_iff_lt_rpow hx
        (Nat.cast_pos.mpr (Nat.mul_pos hpp.pos hqp.pos))).mpr hprod
  have hceil (z : ℝ) (j : Fin 1024) (hz : R j - h < z ∧ z ≤ R j) :
      ⌈(z - 2 * xi) / h⌉₊ = j.val + 1 := by
    rw [Nat.ceil_eq_iff (Nat.add_one_ne_zero j.val)]
    simp only [Nat.add_sub_cancel, Nat.cast_add, Nat.cast_one]
    rw [lt_div_iff₀ hh, div_le_iff₀ hh]
    simp only [hR] at hz
    constructor <;> nlinarith [hz.1, hz.2]
  have hexist (z : ℝ) (hz : 2 * xi < z ∧ z < a) :
      ∃ j : Fin 1024, R j - h < z ∧ z ≤ R j := by
    have hcover :=
      Ioc_subset_biUnion_Ioc 1024 (fun i : ℕ => 2 * xi + (i : ℝ) * h)
        (by simpa only [Nat.cast_zero, zero_mul, add_zero, Nat.cast_ofNat, ha] using
          (show z ∈ Set.Ioc (2 * xi) a from ⟨hz.1, hz.2.le⟩))
    simp only [Set.mem_iUnion, Finset.mem_range, Set.mem_Ioc, exists_prop] at hcover
    obtain ⟨i, hi, hl, hu⟩ := hcover
    refine ⟨⟨i, hi⟩, ?_⟩
    simp only [Nat.cast_add, Nat.cast_one] at hu
    simp only [hR]
    constructor <;> nlinarith
  have hUnion : U = Finset.univ.biUnion B := by
    ext pq
    simp only [Finset.mem_biUnion, Finset.mem_univ, true_and]
    constructor
    · intro hpq
      obtain ⟨j, hj⟩ := hexist (s pq) (hbounds pq hpq)
      exact ⟨j, (hB j pq).mpr ⟨hpq, hj⟩⟩
    · rintro ⟨j, hj⟩
      exact ((hB j pq).mp hj).1
  have hdisj :
      (↑(Finset.univ : Finset (Fin 1024)) : Set (Fin 1024)).PairwiseDisjoint B := by
    intro i _ j _ hij
    apply Finset.disjoint_left.mpr
    intro pq hpi hpj
    have hi := hceil (s pq) i ((hB i pq).mp hpi).2
    have hj := hceil (s pq) j ((hB j pq).mp hpj).2
    exact hij (Fin.ext (Nat.add_right_cancel (hi.symm.trans hj)))
  rw [hUnion]
  exact Finset.card_biUnion hdisj

theorem eventually_exceptionalPrimeDefect_bin_square_majorant :
    ∀ᶠ x : ℝ in Filter.atTop, ∀ L : Fin 1024 → ℕ → ℝ,
      (∀ j : Fin 1024, ∀ t : ℕ, t ≠ 0 →
        (∀ p : ℕ, Nat.Prime p → p ∣ t →
          x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ)) → L j t = 1) →
      ∀ n : ℕ, ∀ c : ℝ, x ≤ (n : ℝ) → (n : ℝ) ≤ 2 * x → Squarefree n →
        (exceptionalPrimeDefect x 0 n + exceptionalPrimeDefect x 1 n) * c ^ 2 ≤
          (12 / 5 : ℝ) * ∑ j : Fin 1024,
            ∑ pq ∈ markedPrimePairBin x ((9519 : ℝ) / 50000)
              ((40481 : ℝ) / 100000)
              ((exceptionalBinRight j : ℝ) -
                (exceptionalBinStep : ℝ))
              (exceptionalBinRight j : ℝ),
              if pq.1 * pq.2 ∣ n then (L j n * c) ^ 2 else 0 := by
  classical
  filter_upwards [eventually_exceptionalPrimeDefect_pair_majorant,
    eventually_literal_minorant_pointwise, Filter.eventually_gt_atTop (1 : ℝ)]
    with x hmajorant hpointwise hx
  intro L hL n c hlo hhi hsf
  have hn : 0 < n := Nat.cast_pos.mp ((zero_lt_one.trans hx).trans_le hlo)
  let N2 := ((Nat.primesLE n) ×ˢ (Nat.primesLE n)).filter
    (fun pq => pq.1 < pq.2 ∧ pq.1 * pq.2 ∣ n ∧
      x ^ ((9519 : ℝ) / 50000) ≤ (pq.1 : ℝ) ∧
      x ^ ((9519 : ℝ) / 50000) ≤ (pq.2 : ℝ) ∧
      ((pq.1 * pq.2 : ℕ) : ℝ) < x ^ ((40481 : ℝ) / 100000))
  let P : Fin 1024 → Finset (ℕ × ℕ) := fun j =>
    markedPrimePairBin x ((9519 : ℝ) / 50000)
      ((40481 : ℝ) / 100000)
      ((exceptionalBinRight j : ℝ) -
        (exceptionalBinStep : ℝ))
      (exceptionalBinRight j : ℝ)
  change (exceptionalPrimeDefect x 0 n + exceptionalPrimeDefect x 1 n) * c ^ 2 ≤
    (12 / 5 : ℝ) * ∑ j : Fin 1024,
      ∑ pq ∈ P j, if pq.1 * pq.2 ∣ n then (L j n * c) ^ 2 else 0
  by_cases hb : exceptionalPrimeDefect x 0 n + exceptionalPrimeDefect x 1 n = 0
  · rw [hb, zero_mul]
    apply mul_nonneg (by norm_num : (0 : ℝ) ≤ 12 / 5)
    apply Finset.sum_nonneg
    intro j _
    apply Finset.sum_nonneg
    intro pq _
    split_ifs <;> positivity
  · have hpoint := hpointwise n hlo hhi
    dsimp only at hpoint
    have hprime : ¬n.Prime := by
      intro hp
      have h := hpoint.1 hp
      simp only [hp, ite_true] at h
      apply hb
      linarith
    have hrho : (if n.Prime then (1 : ℝ) else 0) -
        exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n ≠ 0 := by
      intro h
      simp only [hprime, ite_false] at h
      apply hb
      linarith
    have hrough := hpoint.2.2.1 hrho
    have hLn (j : Fin 1024) : L j n = 1 :=
      hL j n hrough.1 (fun p hp hdiv =>
        hrough.2 p (hp.mem_primeFactors hdiv hrough.1))
    have hcount : (N2.card : ℝ) =
        ∑ j : Fin 1024, (((P j).filter (fun pq => pq.1 * pq.2 ∣ n)).card : ℝ) := by
      have h : N2.card =
          ∑ j : Fin 1024, ((P j).filter (fun pq => pq.1 * pq.2 ∣ n)).card :=
        exceptional_pair_count_eq_sum_bin_card x hx n hn
      exact_mod_cast h
    have hsum : (∑ j : Fin 1024,
        ∑ pq ∈ P j, if pq.1 * pq.2 ∣ n then (L j n * c) ^ 2 else 0) =
        (N2.card : ℝ) * c ^ 2 := by
      calc
        _ = ∑ j : Fin 1024,
            (((P j).filter (fun pq => pq.1 * pq.2 ∣ n)).card : ℝ) * c ^ 2 := by
          apply Finset.sum_congr rfl
          intro j _
          rw [hLn j, one_mul, ← Finset.sum_filter]
          simp only [Finset.sum_const, nsmul_eq_mul]
        _ = _ := by rw [← Finset.sum_mul, ← hcount]
    have hbound : exceptionalPrimeDefect x 0 n + exceptionalPrimeDefect x 1 n ≤
        (12 / 5 : ℝ) * (N2.card : ℝ) := hmajorant n hlo hhi hsf
    calc
      _ ≤ ((12 / 5 : ℝ) * (N2.card : ℝ)) * c ^ 2 :=
        mul_le_mul_of_nonneg_right hbound (sq_nonneg c)
      _ = _ := by rw [hsum, mul_assoc]

theorem literal_minorant_signed_completion
    (x : ℝ) (n : ℕ) (A B C η : ℝ) (hη : 0 < η) :
    let P : ℝ := if n.Prime then 1 else 0
    let b : ℝ := exceptionalPrimeDefect x 0 n + exceptionalPrimeDefect x 1 n
    let ρ : ℝ := P - exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n
    let D : ℝ := A - B
    let L : ℝ := P * (2 * A * B - B ^ 2) + 2 * ρ * D * C - P * C ^ 2 -
      η * b * D ^ 2 - η⁻¹ * b * C ^ 2
    P * A ^ 2 - L = P * (D - C) ^ 2 + (b / η) * (η * D + C) ^ 2 ∧
      L ≤ P * A ^ 2 ∧
      b * C ^ 2 = P * C ^ 2 - ρ * C ^ 2 := by
  intro P b ρ D L
  have hρ : ρ = P - b := sub_sub P _ _
  have heq : P * A ^ 2 - L =
      P * (D - C) ^ 2 + (b / η) * (η * D + C) ^ 2 := by
    dsimp only [L, D]
    rw [hρ]
    field_simp (disch := positivity)
    ring
  refine ⟨heq, ?_, ?_⟩
  · rw [← sub_nonneg, heq]
    dsimp only [P, b]
    positivity [exceptionalPrimeDefect_nonneg x 0 n, exceptionalPrimeDefect_nonneg x 1 n]
  · rw [hρ]
    ring

theorem literal_minorant_finite_first_moment_lower_bound
    {𝓗 : Finset ℕ}
    (s : Finset ℕ) (x : ℝ) (A : ℕ → ℝ) (B H : ℕ → ℕ → ℝ) :
    let t : ℝ := 49599 / 50000
    let η : ℝ := 49599 / 20000000
    let P : ℕ → ℝ := fun n => if n.Prime then 1 else 0
    let b : ℕ → ℝ := fun n =>
      exceptionalPrimeDefect x 0 n + exceptionalPrimeDefect x 1 n
    let ρ : ℕ → ℝ := fun n =>
      P n - exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n
    (∑ n ∈ s,
      ((∑ h ∈ 𝓗,
        (P (n + h) * (2 * A n * B h n - B h n ^ 2) +
          2 * ρ (n + h) * (A n - B h n) * (t * H h n) -
          P (n + h) * (t * H h n) ^ 2 -
          η * b (n + h) * (A n - B h n) ^ 2 -
          η⁻¹ * b (n + h) * (t * H h n) ^ 2)) - A n ^ 2)) ≤
      ∑ n ∈ s,
        (((𝓗.filter (fun h => (n + h).Prime)).card : ℝ) - 1) *
          A n ^ 2 := by
  intro t η P b ρ
  refine Finset.sum_le_sum fun n _ => ?_
  have hs := Finset.sum_le_sum (s := 𝓗) fun h _ =>
    (literal_minorant_signed_completion x (n + h) (A n) (B h n) (t * H h n) η
      (by norm_num [η])).2.1
  calc
    _ ≤ (∑ h ∈ 𝓗, P (n + h) * A n ^ 2) - A n ^ 2 :=
      sub_le_sub_right hs _
    _ = _ := by
      rw [← Finset.sum_mul]
      simp only [P, Finset.sum_boole, sub_mul, one_mul]

theorem literal_minorant_fixed_rational_increment
    (u v : ℝ) (hu : 0 ≤ u) :
    let κ : ℝ := exceptionalMassCoefficient 0 + exceptionalMassCoefficient 1
    let m : ℝ := 1 - κ
    let t : ℝ := 49599 / 50000
    let η : ℝ := 49599 / 20000000
    (2479900401 / 2500000000 : ℝ) * u +
        (-843183 / 1000000000 : ℝ) * v ≤
      2 * m * t * u - t ^ 2 * u - η⁻¹ * κ * t ^ 2 * u -
        η * (17 / 50 : ℝ) * v := by
  intro κ m t η
  have hκ : κ ≤ (1 : ℝ) / 50000 :=
    exceptionalMassCoefficient_sum_bound.2.1.trans
      exceptionalMassCoefficient_sum_bound.2.2.le
  dsimp only [m, t, η]
  nlinarith only [mul_nonneg (sub_nonneg.mpr hκ) hu]

section
open scoped ContDiff

theorem primeFactors_sup_succ_le_iff
    (p m : ℕ) (hp : Nat.Prime p) (hm : 0 < m) :
    m.primeFactors.sup id + 1 ≤ p ↔
      ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p := by
  classical
  rw [Nat.add_one_le_iff, Finset.sup_lt_iff hp.pos]
  constructor
  · intro h t ht htm
    exact h t (ht.mem_primeFactors htm hm.ne')
  · intro h t ht
    exact h t (Nat.prime_of_mem_primeFactors ht) (Nat.dvd_of_mem_primeFactors ht)

theorem theta6_a0_first_prime_window_iff
    (p m u : ℕ) (hp : Nat.Prime p) (hm : 0 < m)
    (H S M0 L U : ℝ) (hH : 0 < H) (hS : 0 < S) :
    ((∀ t : ℕ, Nat.Prime t → t ∣ m → t < p) ∧
      u < p ∧ (p : ℝ) < H ∧ (p : ℝ) < S ∧
      L ≤ ((p * m : ℕ) : ℝ) ∧ ((p * m : ℕ) : ℝ) ≤ U ∧
      ((p * m : ℕ) : ℝ) ≤ M0) ↔
      p ∈ Finset.Icc
        (max (m.primeFactors.sup id + 1) (max (Nat.ceil (L / (m : ℝ))) (u + 1)))
        (min (Nat.floor (min U M0 / (m : ℝ)))
          (min (Nat.ceil H - 1) (Nat.ceil S - 1))) := by
  classical
  have hm0 : 0 < (m : ℝ) := Nat.cast_pos.mpr hm
  simp only [Finset.mem_Icc, max_le_iff, le_min_iff,
    primeFactors_sup_succ_le_iff p m hp hm, Nat.ceil_le,
    Nat.le_floor_iff' hp.ne_zero, div_le_iff₀ hm0, le_div_iff₀ hm0,
    Nat.le_sub_one_iff_lt (Nat.ceil_pos.mpr hH),
    Nat.le_sub_one_iff_lt (Nat.ceil_pos.mpr hS), Nat.lt_ceil,
    Nat.add_one_le_iff, Nat.cast_mul]
  tauto

theorem theta6_a0_second_prime_window_iff
    (p m v : ℕ) (hp : Nat.Prime p) (hm : 0 < m) (hv : 0 < v)
    (H M0 L U : ℝ) (hH : 0 < H) :
    ((∀ t : ℕ, Nat.Prime t → t ∣ m → t < p) ∧
      v ≤ p ∧ ((v * p : ℕ) : ℝ) < H ∧
      L ≤ ((p * m : ℕ) : ℝ) ∧ ((p * m : ℕ) : ℝ) ≤ U ∧
      ((p * m : ℕ) : ℝ) ≤ M0) ↔
      p ∈ Finset.Icc
        (max (m.primeFactors.sup id + 1) (max (Nat.ceil (L / (m : ℝ))) v))
        (min (Nat.floor (min U M0 / (m : ℝ)))
          (Nat.ceil (H / (v : ℝ)) - 1)) := by
  classical
  have hm0 : 0 < (m : ℝ) := Nat.cast_pos.mpr hm
  have hv0 : 0 < (v : ℝ) := Nat.cast_pos.mpr hv
  simp only [Finset.mem_Icc, max_le_iff, le_min_iff,
    primeFactors_sup_succ_le_iff p m hp hm, Nat.ceil_le,
    Nat.le_floor_iff' hp.ne_zero, div_le_iff₀ hm0, le_div_iff₀ hm0,
    Nat.le_sub_one_iff_lt (Nat.ceil_pos.mpr (div_pos hH hv0)), Nat.lt_ceil,
    lt_div_iff₀ hv0, Nat.cast_mul, mul_comm]
  tauto

open Classical in
theorem theta6_a0_first_prime_window_indicator
    (p m u v : ℕ) (hp : Nat.Prime p) (hm : 0 < m)
    (z H S M0 L U : ℝ) (hH : 0 < H) (hS : 0 < S) :
    (if (∀ t : ℕ, Nat.Prime t → t ∣ m → t < p) ∧
        L ≤ ((p * m : ℕ) : ℝ) ∧ ((p * m : ℕ) : ℝ) ≤ U then
      if 1 < z ∧ ((p * m : ℕ) : ℝ) ≤ M0 then
        if u * v ∣ m ∧ z ≤ (u : ℝ) ∧ u < p ∧ (p : ℝ) < H ∧
            u ≤ v ∧ ((u * v : ℕ) : ℝ) < H ∧ (p : ℝ) < S ∧
            m / (u * v) ∈ Nat.smoothNumbers (Nat.ceil z)
        then ArithmeticFunction.moebius (m / (u * v)) else 0
      else 0
    else 0) =
    if 1 < z ∧ u * v ∣ m ∧ z ≤ (u : ℝ) ∧
        u ≤ v ∧ ((u * v : ℕ) : ℝ) < H ∧
        m / (u * v) ∈ Nat.smoothNumbers (Nat.ceil z) then
      if p ∈ Finset.Icc
          (max (m.primeFactors.sup id + 1) (max (Nat.ceil (L / (m : ℝ))) (u + 1)))
          (min (Nat.floor (min U M0 / (m : ℝ)))
            (min (Nat.ceil H - 1) (Nat.ceil S - 1)))
      then ArithmeticFunction.moebius (m / (u * v)) else 0
    else 0 := by
  simp only [← ite_and,
    ← theta6_a0_first_prime_window_iff p m u hp hm H S M0 L U hH hS,
    and_assoc, and_left_comm, and_comm]

open Classical in
theorem theta6_a0_second_prime_window_indicator
    (p m u v : ℕ) (hp : Nat.Prime p) (hm : 0 < m) (hv : 0 < v)
    (z H S M0 L U : ℝ) (hH : 0 < H) :
    (if (∀ t : ℕ, Nat.Prime t → t ∣ m → t < p) ∧
        L ≤ ((p * m : ℕ) : ℝ) ∧ ((p * m : ℕ) : ℝ) ≤ U then
      if 1 < z ∧ ((p * m : ℕ) : ℝ) ≤ M0 then
        if u * v ∣ m ∧ z ≤ (v : ℝ) ∧ v < u ∧ (u : ℝ) < H ∧
            v ≤ p ∧ ((v * p : ℕ) : ℝ) < H ∧ (u : ℝ) < S ∧
            m / (u * v) ∈ Nat.smoothNumbers (Nat.ceil z)
        then ArithmeticFunction.moebius (m / (u * v)) else 0
      else 0
    else 0) =
    if 1 < z ∧ u * v ∣ m ∧ z ≤ (v : ℝ) ∧
        v < u ∧ (u : ℝ) < H ∧ (u : ℝ) < S ∧
        m / (u * v) ∈ Nat.smoothNumbers (Nat.ceil z) then
      if p ∈ Finset.Icc
          (max (m.primeFactors.sup id + 1) (max (Nat.ceil (L / (m : ℝ))) v))
          (min (Nat.floor (min U M0 / (m : ℝ)))
            (Nat.ceil (H / (v : ℝ)) - 1))
      then ArithmeticFunction.moebius (m / (u * v)) else 0
    else 0 := by
  simp only [← ite_and,
    ← theta6_a0_second_prime_window_iff p m v hp hm hv H M0 L U hH,
    and_assoc, and_left_comm, and_comm]

theorem exists_cofactor_log_fourth_envelope (T C : ℝ) (hT : 0 < T) (hC : 0 < C) :
    ∃ H : ℝ, 0 < H ∧ ∃ X0 : ℝ, Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, 0 ≤ N → N ≤ x ^ C →
        (1 + Real.log (Nat.floor (T * N) : ℝ)) ^ 4 ≤ H * (Real.log x) ^ 4 := by
  refine ⟨(2 + |Real.log T| + C) ^ 4, by positivity, Real.exp 1, le_rfl, ?_⟩
  intro x hx N hN hNx
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hx
  have hlogx : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hx
  have hlogx0 : 0 ≤ Real.log x := by linarith
  have hlogfloor :
      Real.log (Nat.floor (T * N) : ℝ) ≤ |Real.log T| + C * Real.log x := by
    by_cases hf : Nat.floor (T * N) = 0
    · rw [hf, Nat.cast_zero, Real.log_zero]
      exact add_nonneg (abs_nonneg _) (mul_nonneg hC.le hlogx0)
    · have hfpos : (0 : ℝ) < Nat.floor (T * N) := by
        exact_mod_cast Nat.pos_of_ne_zero hf
      have hfloor : (Nat.floor (T * N) : ℝ) ≤ T * x ^ C :=
        (Nat.floor_le (mul_nonneg hT.le hN)).trans
          (mul_le_mul_of_nonneg_left hNx hT.le)
      calc
        Real.log (Nat.floor (T * N) : ℝ) ≤ Real.log (T * x ^ C) :=
          Real.log_le_log hfpos hfloor
        _ = Real.log T + C * Real.log x := by
          rw [Real.log_mul hT.ne' (Real.rpow_pos_of_pos hxpos C).ne',
            Real.log_rpow hxpos C]
        _ ≤ |Real.log T| + C * Real.log x :=
          add_le_add (le_abs_self _) le_rfl
  have hbase : 1 + Real.log (Nat.floor (T * N) : ℝ) ≤
      (2 + |Real.log T| + C) * Real.log x := by
    nlinarith only [hlogfloor, hlogx,
      mul_nonneg (abs_nonneg (Real.log T)) (sub_nonneg.mpr hlogx)]
  calc
    (1 + Real.log (Nat.floor (T * N) : ℝ)) ^ 4 ≤
        ((2 + |Real.log T| + C) * Real.log x) ^ 4 :=
      pow_le_pow_left₀ (by linarith [Real.log_natCast_nonneg (Nat.floor (T * N))])
        hbase 4
    _ = (2 + |Real.log T| + C) ^ 4 * (Real.log x) ^ 4 := mul_pow _ _ 4

theorem finite_five_prime_full_box_convolution (P : Fin 5 → Finset ℕ) :
    (∑ p ∈ Fintype.piFinset P, Finsupp.single (∏ i, p i) (1 : ℂ)) =
      finiteConvolution
        (∑ p ∈ Fintype.piFinset (fun i : Fin 4 => P i.castSucc),
          Finsupp.single (∏ i, p i) (1 : ℂ))
        (∑ n ∈ P 4, Finsupp.single n (1 : ℂ)) := by
  classical
  have hpi : Fintype.piFinset P =
      (P 4 ×ˢ Fintype.piFinset (fun i : Fin 4 => P i.castSucc)).map
        (Fin.snocEquiv (fun _ : Fin 5 => ℕ)).toEmbedding := by
    have hi : Fin.init P = (fun i : Fin 4 => P i.castSucc) := rfl
    have hl : Fin.last 4 = (4 : Fin 5) := rfl
    simpa only [Finset.filter_true, hi, hl] using
      Finset.filter_piFinset_eq_map_snocEquiv P (fun _ : Fin 4 → ℕ => True)
  rw [hpi, Finset.sum_map, Finset.sum_product, Finset.sum_comm]
  simp only [Equiv.toEmbedding_apply, Fin.snocEquiv_apply, Fin.prod_snoc]
  simp only [finiteConvolution, MonoidAlgebra.ofCoeff_sum,
    MonoidAlgebra.ofCoeff_single, Finset.sum_mul, Finset.mul_sum,
    MonoidAlgebra.single_mul_single, one_mul, MonoidAlgebra.coeff_sum,
    MonoidAlgebra.coeff_single]
  exact Finset.sum_comm

theorem harman_crossing_nat_quotient_window_iff
    (p m k : ℕ) (hm : 0 < m) (hk : 0 < k) (hkm : k ∣ m)
    (H : ℝ) (hH : 0 < H) :
    ((((p * m) / k : ℕ) : ℝ) < H ∧ H ≤ ((p * m : ℕ) : ℝ)) ↔
      p ∈ Finset.Icc (Nat.ceil (H / (m : ℝ)))
        (Nat.ceil (H * (k : ℝ) / (m : ℝ)) - 1) := by
  have hm0 : 0 < (m : ℝ) := Nat.cast_pos.mpr hm
  have hk0 : 0 < (k : ℝ) := Nat.cast_pos.mpr hk
  have hquot : (((p * m) / k : ℕ) : ℝ) =
      (p : ℝ) * (m : ℝ) / (k : ℝ) := by
    rw [Nat.cast_div (dvd_mul_of_dvd_right hkm p) (by exact_mod_cast hk.ne'), Nat.cast_mul]
  rw [Finset.mem_Icc, Nat.ceil_le, div_le_iff₀ hm0,
    Nat.le_sub_one_iff_lt (Nat.ceil_pos.mpr (div_pos (mul_pos hH hk0) hm0)),
    Nat.lt_ceil, lt_div_iff₀ hm0, hquot, div_lt_iff₀ hk0]
  simp only [Nat.cast_mul]
  tauto

theorem harmanA_named_prime_window_iff
    (p r' h m : ℕ) (hp : Nat.Prime p) (hr : 0 < r') (hm : 0 < m)
    (hcofactor : r' * h = m) (H : ℝ) (hH : 0 < H) :
    ((∀ t : ℕ, Nat.Prime t → t ∣ m → t < p) ∧
      (((p * m) / h.minFac : ℕ) : ℝ) < H ∧
      H ≤ ((p * m : ℕ) : ℝ) ∧ ((p * r' : ℕ) : ℝ) < H) ↔
    p ∈ Finset.Icc
      (max (m.primeFactors.sup id + 1) (Nat.ceil (H / (m : ℝ))))
      (min (Nat.ceil (H * (h.minFac : ℝ) / (m : ℝ)) - 1)
        (Nat.ceil (H / (r' : ℝ)) - 1)) := by
  classical
  have hdiv : h.minFac ∣ m := by
    rw [← hcofactor]
    exact dvd_mul_of_dvd_right (Nat.minFac_dvd h) r'
  have hcross := harman_crossing_nat_quotient_window_iff p m h.minFac hm
    (Nat.minFac_pos h) hdiv H hH
  rw [Finset.mem_Icc] at hcross
  have hr0 : 0 < (r' : ℝ) := Nat.cast_pos.mpr hr
  have hnamed : p ≤ Nat.ceil (H / (r' : ℝ)) - 1 ↔ ((p * r' : ℕ) : ℝ) < H := by
    simp only [Nat.cast_mul]
    rw [Nat.le_sub_one_iff_lt (Nat.ceil_pos.mpr (div_pos hH hr0)),
      Nat.lt_ceil, lt_div_iff₀ hr0]
  have hmax := primeFactors_sup_succ_le_iff p m hp hm
  rw [Finset.mem_Icc, max_le_iff, le_min_iff, hmax, hnamed]
  tauto

open Classical in
theorem harmanA_named_prime_window_indicator
    (p r' h m : ℕ) (hp : Nat.Prime p) (hr : 0 < r') (hm : 0 < m)
    (hcofactor : r' * h = m) (z H : ℝ) (hH : 0 < H) :
    (if 1 < h ∧ ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧
        (∀ t : ℕ, Nat.Prime t → t ∣ m → t < p) ∧
        (((p * m) / h.minFac : ℕ) : ℝ) < H ∧
        H ≤ ((p * m : ℕ) : ℝ) ∧ ((p * r' : ℕ) : ℝ) < H
      then ArithmeticFunction.moebius h else 0) =
    if 1 < h ∧ ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z then
      if p ∈ Finset.Icc
          (max (m.primeFactors.sup id + 1) (Nat.ceil (H / (m : ℝ))))
          (min (Nat.ceil (H * (h.minFac : ℝ) / (m : ℝ)) - 1)
            (Nat.ceil (H / (r' : ℝ)) - 1))
      then ArithmeticFunction.moebius h else 0
    else 0 := by
  have hw := harmanA_named_prime_window_iff p r' h m hp hr hm hcofactor H hH
  simp only [← ite_and]
  simp only [← hw, and_assoc]

theorem harmanA_mobius_prime_factor_data
    (p d : ℕ) (hp : Nat.Prime p) (hd : 0 < d)
    (hmax : ∀ t : ℕ, Nat.Prime t → t ∣ d → t < p) :
    ¬ p ∣ d ∧ Nat.Coprime p d ∧
      ArithmeticFunction.moebius (p * d) = -ArithmeticFunction.moebius d ∧
      max 1 ((p * d).primeFactors.sup id) = p ∧
      (p * d).minFac = (if d = 1 then p else d.minFac) ∧ 1 < p * d := by
  classical
  have hnot : ¬ p ∣ d := fun h => (lt_irrefl p) (hmax p hp h)
  have hcop : Nat.Coprime p d := hp.coprime_iff_not_dvd.mpr hnot
  have hmu : ArithmeticFunction.moebius (p * d) = -ArithmeticFunction.moebius d := by
    rw [ArithmeticFunction.isMultiplicative_moebius.map_mul_of_coprime hcop,
      ArithmeticFunction.moebius_apply_prime hp, neg_one_mul]
  have hsupd : d.primeFactors.sup id < p :=
    (Finset.sup_lt_iff hp.pos).mpr (fun t ht =>
      hmax t (Nat.prime_of_mem_primeFactors ht) (Nat.dvd_of_mem_primeFactors ht))
  have hsup : max 1 ((p * d).primeFactors.sup id) = p := by
    rw [Nat.primeFactors_mul hp.ne_zero hd.ne', hp.primeFactors,
      Finset.sup_union, Finset.sup_singleton]
    simp only [id_eq, max_eq_left hsupd.le, max_eq_right hp.one_lt.le]
  have hpd : 1 < p * d := hp.one_lt.trans_le (Nat.le_mul_of_pos_right p hd)
  refine ⟨hnot, hcop, hmu, hsup, ?_, hpd⟩
  by_cases hd1 : d = 1
  · simp only [hd1, mul_one, hp.minFac_eq, ite_true]
  · rw [ite_eq_right hd1]
    have hdp : Nat.Prime d.minFac := Nat.minFac_prime hd1
    have hdp_lt : d.minFac < p := hmax d.minFac hdp (Nat.minFac_dvd d)
    apply le_antisymm
    · exact Nat.minFac_le_of_dvd hdp.two_le
        (dvd_mul_of_dvd_right (Nat.minFac_dvd d) p)
    · have hbound : p * d = 1 ∨ d.minFac ≤ (p * d).minFac := by
        apply Nat.le_minFac.mpr
        intro q hq hqpd
        rcases hq.dvd_or_dvd hqpd with hqp | hqd
        · have hqp' : q = p := (Nat.prime_dvd_prime_iff_eq hq hp).mp hqp
          simpa only [hqp'] using hdp_lt.le
        · exact Nat.minFac_le_of_dvd hq.two_le hqd
      exact hbound.resolve_left (ne_of_gt hpd)

theorem harmanA_mobius_prime_window_iff
    (p r d : ℕ) (hp : Nat.Prime p) (hr : 0 < r) (hd : 0 < d)
    (hmax : ∀ t : ℕ, Nat.Prime t → t ∣ d → t < p)
    (z H : ℝ) (hz : 0 < z) (hH : 0 < H) :
    (1 < p * d ∧ ((max 1 ((p * d).primeFactors.sup id) : ℕ) : ℝ) < z ∧
      (r : ℝ) < H ∧
      (((r * (p * d)) / (p * d).minFac : ℕ) : ℝ) < H ∧
      H ≤ ((r * (p * d) : ℕ) : ℝ)) ↔
    (r : ℝ) < H ∧
      p ∈ (if d = 1 then
        Finset.Icc (Nat.ceil (H / (r : ℝ))) (Nat.ceil z - 1)
      else
        Finset.Icc (Nat.ceil (H / ((r * d : ℕ) : ℝ)))
          (min (Nat.ceil z - 1)
            (Nat.ceil (H * (d.minFac : ℝ) / ((r * d : ℕ) : ℝ)) - 1))) := by
  classical
  obtain ⟨hnot, hcop, hmu, hsup, hmin, hpd⟩ :=
    harmanA_mobius_prime_factor_data p d hp hd hmax
  have hzcut : p ≤ Nat.ceil z - 1 ↔ (p : ℝ) < z := by
    rw [Nat.le_sub_one_iff_lt (Nat.ceil_pos.mpr hz), Nat.lt_ceil]
  simp only [hpd, true_and, hsup]
  by_cases hd1 : d = 1
  · have hr0 : 0 < (r : ℝ) := Nat.cast_pos.mpr hr
    have hlo : Nat.ceil (H / (r : ℝ)) ≤ p ↔ H ≤ ((r * p : ℕ) : ℝ) := by
      have h : Nat.ceil (H / (r : ℝ)) ≤ p ↔ H ≤ (p : ℝ) * (r : ℝ) := by
        rw [Nat.ceil_le, div_le_iff₀ hr0]
      simpa only [Nat.cast_mul, mul_comm] using h
    simp only [hd1, mul_one, hp.minFac_eq, Nat.mul_div_cancel r hp.pos,
      ite_true, Finset.mem_Icc, hlo, hzcut]
    tauto
  · have hrd : 0 < r * d := Nat.mul_pos hr hd
    have hdiv : d.minFac ∣ r * d := dvd_mul_of_dvd_right (Nat.minFac_dvd d) r
    have hcross :
        ((((r * (p * d)) / d.minFac : ℕ) : ℝ) < H ∧
          H ≤ ((r * (p * d) : ℕ) : ℝ)) ↔
        p ∈ Finset.Icc (Nat.ceil (H / ((r * d : ℕ) : ℝ)))
          (Nat.ceil (H * (d.minFac : ℝ) / ((r * d : ℕ) : ℝ)) - 1) := by
      simpa only [Nat.mul_assoc, Nat.mul_left_comm, Nat.mul_comm] using
        harman_crossing_nat_quotient_window_iff p (r * d) d.minFac hrd
          (Nat.minFac_pos d) hdiv H hH
    rw [Finset.mem_Icc] at hcross
    have hmin' : (p * d).minFac = d.minFac := by
      simpa only [ite_eq_right hd1] using hmin
    rw [hmin']
    simp only [ite_eq_right hd1, Finset.mem_Icc, le_min_iff, hzcut]
    tauto

open Classical in
theorem harmanA_mobius_prime_window_indicator
    (p r d : ℕ) (hp : Nat.Prime p) (hr : 0 < r) (hd : 0 < d)
    (hmax : ∀ t : ℕ, Nat.Prime t → t ∣ d → t < p)
    (z H : ℝ) (hz : 0 < z) (hH : 0 < H) :
    (if 1 < p * d ∧ ((max 1 ((p * d).primeFactors.sup id) : ℕ) : ℝ) < z ∧
        (r : ℝ) < H ∧
        (((r * (p * d)) / (p * d).minFac : ℕ) : ℝ) < H ∧
        H ≤ ((r * (p * d) : ℕ) : ℝ)
      then ArithmeticFunction.moebius (p * d) else 0) =
    if (r : ℝ) < H then
      if p ∈ (if d = 1 then
          Finset.Icc (Nat.ceil (H / (r : ℝ))) (Nat.ceil z - 1)
        else
          Finset.Icc (Nat.ceil (H / ((r * d : ℕ) : ℝ)))
            (min (Nat.ceil z - 1)
              (Nat.ceil (H * (d.minFac : ℝ) / ((r * d : ℕ) : ℝ)) - 1)))
      then -ArithmeticFunction.moebius d else 0
    else 0 := by
  have hwindow := harmanA_mobius_prime_window_iff p r d hp hr hd hmax z H hz hH
  have hmu := (harmanA_mobius_prime_factor_data p d hp hd hmax).2.2.1
  simp only [hwindow, hmu, ite_and]

theorem finite_nat_closed_band_card_le
    (T : Finset ℕ) (L U δ : ℝ) (hδ : 0 ≤ δ)
    (hband : ∀ n ∈ T, L ≤ (n : ℝ) ∧ (n : ℝ) ≤ U)
    (hwidth : U - L ≤ δ) : (T.card : ℝ) ≤ δ + 1 := by
  classical
  by_cases hT : T.Nonempty
  · let a := T.min' hT
    let b := T.max' hT
    have hab : a ≤ b := T.min'_le_max' hT
    have hsubset : T ⊆ Finset.Icc a b := by
      intro n hn
      exact Finset.mem_Icc.mpr ⟨T.min'_le n hn, T.le_max' n hn⟩
    have hcard : (T.card : ℝ) ≤ (b : ℝ) + 1 - a := by
      have hc := Finset.card_le_card hsubset
      rw [Nat.card_Icc] at hc
      have hcast : ((b + 1 - a : ℕ) : ℝ) = (b : ℝ) + 1 - a := by
        rw [Nat.cast_sub (by omega : a ≤ b + 1), Nat.cast_add, Nat.cast_one]
      exact (Nat.cast_le.mpr hc).trans_eq hcast
    have hL := (hband a (T.min'_mem hT)).1
    have hU := (hband b (T.max'_mem hT)).2
    linarith
  · rw [Finset.not_nonempty_iff_eq_empty.mp hT]
    simp only [Finset.card_empty, Nat.cast_zero]
    linarith

theorem finite_positive_tuple_product_moments
    (k N : ℕ) (S : Finset (Fin k → ℕ))
    (hS : ∀ r ∈ S, (∀ j, 0 < r j) ∧ (∏ j, r j) ≤ N) :
    (S.card : ℝ) ≤ (N : ℝ) * (1 + Real.log (N : ℝ)) ^ (2 ^ k - 1) ∧
      (∑ r ∈ S, 1 / ((∏ j, r j : ℕ) : ℝ)) ≤
        (1 + Real.log (N : ℝ)) ^ (2 ^ k) := by
  classical
  let p : (Fin k → ℕ) → ℕ := fun r => ∏ j, r j
  have hmap : ∀ r ∈ S, p r ∈ Finset.Icc 1 N := by
    intro r hr
    exact Finset.mem_Icc.mpr ⟨Finset.prod_pos (fun j _ => (hS r hr).1 j), (hS r hr).2⟩
  have hfiber (m : ℕ) :
      (S.filter (fun r => p r = m)).card ≤ m.divisors.card ^ k := by
    have hsubset : S.filter (fun r => p r = m) ⊆
        Fintype.piFinset (fun _ : Fin k => m.divisors) := by
      intro r hr
      obtain ⟨hrS, hrm⟩ := Finset.mem_filter.mp hr
      apply Fintype.mem_piFinset.mpr
      intro j
      apply Nat.mem_divisors.mpr
      constructor
      · rw [← hrm]
        exact Finset.dvd_prod_of_mem r (Finset.mem_univ j)
      · rw [← hrm]
        exact (Finset.prod_pos fun j _ => (hS r hrS).1 j).ne'
    simpa only [Fintype.card_piFinset, Finset.prod_const, Finset.card_univ,
      Fintype.card_fin] using Finset.card_le_card hsubset
  have hcard : (S.card : ℝ) =
      ∑ m ∈ Finset.Icc 1 N, ((S.filter (fun r => p r = m)).card : ℝ) := by
    exact_mod_cast Finset.card_eq_sum_card_fiberwise hmap
  have hrec : (∑ r ∈ S, 1 / (p r : ℝ)) =
      ∑ m ∈ Finset.Icc 1 N, ((S.filter (fun r => p r = m)).card : ℝ) / (m : ℝ) := by
    rw [← Finset.sum_fiberwise_of_maps_to' hmap (fun m => 1 / (m : ℝ))]
    simp only [Finset.sum_const, nsmul_eq_mul, mul_one_div]
  constructor
  · calc
      _ = ∑ m ∈ Finset.Icc 1 N, ((S.filter (fun r => p r = m)).card : ℝ) := hcard
      _ ≤ ∑ m ∈ Finset.Icc 1 N, (m.divisors.card : ℝ) ^ k := by
        apply Finset.sum_le_sum
        intro m _hm
        exact_mod_cast hfiber m
      _ ≤ _ := sum_card_divisors_pow_le_mul_log_pow k N
  · calc
      _ = ∑ m ∈ Finset.Icc 1 N,
          ((S.filter (fun r => p r = m)).card : ℝ) / (m : ℝ) := hrec
      _ ≤ ∑ m ∈ Finset.Icc 1 N,
          (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (2 ^ k)) m : ℝ) /
            (m : ℝ) := by
        apply Finset.sum_le_sum
        intro m hm
        apply div_le_div_of_nonneg_right _ (Nat.cast_nonneg m)
        exact_mod_cast (hfiber m).trans
          (card_divisors_pow_le_zeta_pow k m (Finset.mem_Icc.mp hm).1)
      _ ≤ (harmonic N : ℝ) ^ (2 ^ k) :=
        sum_zeta_pow_div_le_harmonic_pow (2 ^ k) N
      _ ≤ _ := pow_le_pow_left₀ (by unfold harmonic; positivity)
        (harmonic_le_one_add_log N) (2 ^ k)

theorem finite_five_tuple_monomial_boundary_count
    (x η : ℝ) (hx : 2 ≤ x) (hη : 0 ≤ η) (i : Fin 5)
    (S : Finset (Fin 5 → ℕ)) (L U : (Fin 4 → ℕ) → ℝ)
    (hS : ∀ t ∈ S,
      (∀ j, x ^ ((9519 : ℝ) / 50000) ≤ (t j : ℝ)) ∧
        ((∏ j, t j : ℕ) : ℝ) ≤ 64 * x ∧
        L (Fin.removeNth i t) ≤ (t i : ℝ) ∧
        (t i : ℝ) ≤ U (Fin.removeNth i t))
    (hwidth : ∀ r : Fin 4 → ℕ, (∀ j, 0 < r j) →
      ((∏ j, r j : ℕ) : ℝ) ≤ 64 * x / x ^ ((9519 : ℝ) / 50000) →
        U r - L r ≤ η * (64 * x / ((∏ j, r j : ℕ) : ℝ))) :
    (S.card : ℝ) ≤
      64 * (η * x + x ^ (1 - (9519 : ℝ) / 50000)) *
        (1 + Real.log (64 * x)) ^ 16 := by
  classical
  let ξ : ℝ := 9519 / 50000
  let Z : ℝ := 64 * x
  let Y : ℝ := Z / x ^ ξ
  let N : ℕ := ⌊Y⌋₊
  let R : Finset (Fin 4 → ℕ) := S.image (Fin.removeNth i)
  let H : ℝ := 1 + Real.log Z
  have hx1 : 1 ≤ x := (by norm_num : (1 : ℝ) ≤ 2).trans hx
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hξ0 : 0 ≤ ξ := by norm_num [ξ]
  have hξ1 : ξ ≤ 1 := by norm_num [ξ]
  have hxξ : 1 ≤ x ^ ξ := Real.one_le_rpow hx1 hξ0
  have hxξ0 : 0 < x ^ ξ := Real.rpow_pos_of_pos hx0 ξ
  have hZ : 0 < Z := by dsimp [Z]; positivity
  have hY1 : 1 ≤ Y := by
    apply (le_div_iff₀ hxξ0).mpr
    have hpow := Real.rpow_le_self_of_one_le hx1 hξ1
    dsimp [Z]
    linarith
  have hY0 : 0 ≤ Y := zero_le_one.trans hY1
  have hYZ : Y ≤ Z := div_le_self hZ.le hxξ
  have hN1 : 1 ≤ N := Nat.le_floor (by simpa only [Nat.cast_one] using hY1)
  have hNY : (N : ℝ) ≤ Y := Nat.floor_le hY0
  have hNZ : (N : ℝ) ≤ Z := hNY.trans hYZ
  have hH1 : 1 ≤ H := by
    have hZ1 : 1 ≤ Z := (by exact_mod_cast hN1 : (1 : ℝ) ≤ N).trans hNZ
    exact le_add_of_nonneg_right (Real.log_nonneg hZ1)
  have hlogN0 : 0 ≤ 1 + Real.log (N : ℝ) := by
    have hN1r : (1 : ℝ) ≤ N := by exact_mod_cast hN1
    positivity
  have hlogNZ : 1 + Real.log (N : ℝ) ≤ H := by
    exact add_le_add (le_refl 1)
      (Real.log_le_log (by exact_mod_cast hN1 : (0 : ℝ) < N) hNZ)
  have hpositive (t : Fin 5 → ℕ) (ht : t ∈ S) (j : Fin 5) : 0 < t j :=
    Nat.cast_pos.mp (hxξ0.trans_le ((hS t ht).1 j))
  have hR (r : Fin 4 → ℕ) (hr : r ∈ R) :
      (∀ j, 0 < r j) ∧ ((∏ j, r j : ℕ) : ℝ) ≤ Y := by
    obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hr
    refine ⟨fun j => hpositive t ht (i.succAbove j), ?_⟩
    have hprod : (t i : ℝ) * ((∏ j, Fin.removeNth i t j : ℕ) : ℝ) =
        ((∏ j, t j : ℕ) : ℝ) := by
      exact_mod_cast Fin.mul_prod_removeNth i t
    apply (le_div_iff₀ hxξ0).mpr
    calc
      _ ≤ (t i : ℝ) * ((∏ j, Fin.removeNth i t j : ℕ) : ℝ) := by
        have hti : x ^ ξ ≤ (t i : ℝ) := (hS t ht).1 i
        exact (mul_le_mul_of_nonneg_left hti
          (Nat.cast_nonneg (∏ j, Fin.removeNth i t j))).trans_eq (mul_comm _ _)
      _ ≤ Z := hprod ▸ (hS t ht).2.1
  have hRnat : ∀ r ∈ R, (∀ j, 0 < r j) ∧ (∏ j, r j) ≤ N := by
    intro r hr
    exact ⟨(hR r hr).1, Nat.le_floor (hR r hr).2⟩
  obtain ⟨hRcard, hRrec⟩ := finite_positive_tuple_product_moments 4 N R hRnat
  have hRcard' : (R.card : ℝ) ≤ Y * H ^ 15 := by
    refine hRcard.trans ?_
    norm_num only [show 2 ^ (4 : ℕ) - 1 = 15 by norm_num]
    exact mul_le_mul hNY (pow_le_pow_left₀ hlogN0 hlogNZ 15)
      (pow_nonneg hlogN0 _) hY0
  have hRrec' : (∑ r ∈ R, 1 / ((∏ j, r j : ℕ) : ℝ)) ≤ H ^ 16 := by
    refine hRrec.trans ?_
    norm_num only [show 2 ^ (4 : ℕ) = 16 by norm_num]
    exact pow_le_pow_left₀ hlogN0 hlogNZ 16
  have hfiber (r : Fin 4 → ℕ) (hr : r ∈ R) :
      ((S.filter (fun t => Fin.removeNth i t = r)).card : ℝ) ≤
        η * (Z / ((∏ j, r j : ℕ) : ℝ)) + 1 := by
    let T := S.filter (fun t => Fin.removeNth i t = r)
    have hinj : Set.InjOn (fun t : Fin 5 → ℕ => t i) T := by
      intro t ht u hu htu
      change t i = u i at htu
      have htR := (Finset.mem_filter.mp ht).2
      have huR := (Finset.mem_filter.mp hu).2
      calc
        t = Fin.insertNth i (t i) (Fin.removeNth i t) :=
          (Fin.insertNth_self_removeNth i t).symm
        _ = Fin.insertNth i (u i) (Fin.removeNth i u) := by rw [htR, huR, htu]
        _ = u := Fin.insertNth_self_removeNth i u
    have hcard : (T.image (fun t => t i)).card = T.card :=
      Finset.card_image_of_injOn hinj
    rw [← hcard]
    apply finite_nat_closed_band_card_le _ (L r) (U r) _ (by positivity)
    · intro n hn
      obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hn
      obtain ⟨htS, htr⟩ := Finset.mem_filter.mp ht
      simpa only [htr] using (hS t htS).2.2
    · exact hwidth r (hR r hr).1 (hR r hr).2
  have hcount : (S.card : ℝ) ≤
      η * Z * (∑ r ∈ R, 1 / ((∏ j, r j : ℕ) : ℝ)) + (R.card : ℝ) := by
    calc
      _ = ∑ r ∈ R, ((S.filter (fun t => Fin.removeNth i t = r)).card : ℝ) := by
        exact_mod_cast Finset.card_eq_sum_card_image (Fin.removeNth i) S
      _ ≤ ∑ r ∈ R, (η * (Z / ((∏ j, r j : ℕ) : ℝ)) + 1) :=
        Finset.sum_le_sum hfiber
      _ = _ := by
        simp only [Finset.sum_add_distrib, Finset.mul_sum, Finset.sum_const,
          nsmul_eq_mul, mul_one, div_eq_mul_inv, one_mul, mul_assoc]
  have hYeq : Y = 64 * x ^ (1 - ξ) := by
    dsimp [Y, Z]
    rw [Real.rpow_sub hx0, Real.rpow_one]
    ring
  have hHpow : H ^ 15 ≤ H ^ 16 := by
    exact pow_le_pow_right₀ hH1 (by norm_num)
  calc
    _ ≤ η * Z * H ^ 16 + Y * H ^ 15 :=
      hcount.trans (add_le_add
        (mul_le_mul_of_nonneg_left hRrec' (mul_nonneg hη hZ.le)) hRcard')
    _ ≤ η * Z * H ^ 16 + Y * H ^ 16 :=
      add_le_add (le_refl _) (mul_le_mul_of_nonneg_left hHpow hY0)
    _ = _ := by rw [hYeq]; dsimp [Z, H, ξ]; ring

open Classical in
theorem finite_positive_tuple_coefficient_support_and_bound
    {k : ℕ} (P : Fin k → Finset ℕ)
    (hP : ∀ i, ∀ p ∈ P i, 0 < p) :
    let T := Fintype.piFinset P
    let F : ℕ →₀ ℂ := ∑ p ∈ T, Finsupp.single (∏ i, p i) 1
    (∀ n ∈ F.support, ∃ p ∈ T, (∏ i, p i) = n) ∧
      ∀ n : ℕ, ‖F n‖ ≤ (n.divisors.card : ℝ) ^ k := by
  intro T F
  have hsupport (n : ℕ) (hn : n ∈ F.support) :
      ∃ p ∈ T, (∏ i, p i) = n := by
    obtain ⟨p, hp, hsingle⟩ := Finsupp.mem_support_finsetSum n hn
    have heq := (Finsupp.mem_support_single n (∏ i, p i) (1 : ℂ)).mp hsingle
    exact ⟨p, hp, heq.1.symm⟩
  refine ⟨hsupport, ?_⟩
  intro n
  by_cases hn : n = 0
  · subst n
    have hzero : F 0 = 0 := by
      apply Finsupp.notMem_support_iff.mp
      intro h
      obtain ⟨p, hp, he⟩ := hsupport 0 h
      have hp0 : 0 < ∏ i, p i := Finset.prod_pos fun i _ =>
        hP i (p i) (Fintype.mem_piFinset.mp hp i)
      omega
    rw [hzero, norm_zero]
    positivity
  · have hvalue : F n = ((T.filter (fun p => (∏ i, p i) = n)).card : ℂ) := by
      simp only [F, Finsupp.finsetSum_apply, Finsupp.single_apply,
        Finset.sum_boole]
    have hsub : T.filter (fun p => (∏ i, p i) = n) ⊆
        Fintype.piFinset (fun _ : Fin k => n.divisors) := by
      intro p hp
      apply Fintype.mem_piFinset.mpr
      intro i
      refine Nat.mem_divisors.mpr ⟨?_, hn⟩
      rw [← (Finset.mem_filter.mp hp).2]
      exact Finset.dvd_prod_of_mem p (Finset.mem_univ i)
    rw [hvalue, Complex.norm_natCast]
    have hcard := Finset.card_le_card hsub
    rw [Fintype.card_piFinset_const] at hcard
    exact_mod_cast hcard

open Classical in
theorem prime_closed_interval_all_moduli_siegelWalfisz
    (A : ℝ) (hA : 0 < A) :
    ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ N L U : ℝ,
      x ^ (1 / 10 : ℝ) ≤ N → N ≤ x ^ (2 : ℝ) →
      N ≤ L → U ≤ 2 * N →
      ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
        ‖fullDiscrepancy
          ((∑ n ∈ Finset.Icc ⌈L⌉₊ ⌊U⌋₊,
            Finsupp.single n (if Nat.Prime n then (1 : ℂ) else 0)).filter
              (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
          K * ((q * r).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨K, Xs, hK, hXs, hSW⟩ :=
    largest_prime_windows_all_moduli_siegelWalfisz
      0 1 (1 / 10) 1 3 2 0 1 A (by norm_num) (by norm_num)
        (by norm_num) (by norm_num) hA
  refine ⟨K, max Xs (Real.exp 100), hK, le_max_right _ _, ?_⟩
  intro x hx N L U hNL hNU hL hU q r a hq hr ha
  have hxs : Xs ≤ x := (le_max_left _ _).trans hx
  have hx100 : Real.exp 100 ≤ x := (le_max_right _ _).trans hx
  have hx0 : 0 < x := (Real.exp_pos 100).trans_le hx100
  have hx1 : 1 ≤ x := (Real.one_le_exp_iff.mpr (by norm_num)).trans hx100
  have hlog100 : 100 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hx100
  have hlog0 : 0 ≤ Real.log x := by linarith
  have hN1 : 1 ≤ N := (Real.one_le_rpow hx1 (by norm_num : (0 : ℝ) ≤ 1 / 10)).trans hNL
  have hN0 : 0 < N := zero_lt_one.trans_le hN1
  let V := Finset.Icc ⌈L⌉₊ ⌊U⌋₊
  let β : ℕ →₀ ℂ := ∑ n ∈ V,
    Finsupp.single n (if Nat.Prime n then 1 else 0)
  have hβ (n : ℕ) : β n = if n ∈ V ∧ Nat.Prime n then 1 else 0 := by
    simp only [β, Finsupp.finsetSum_apply, Finsupp.single_apply]
    by_cases hn : n ∈ V <;> simp [Finset.sum_ite_eq', hn]
  have hsupport (n : ℕ) (hn : n ∈ β.support) :
      N ≤ (n : ℝ) ∧ (n : ℝ) ≤ 3 * N := by
    have hmem : n ∈ V ∧ Nat.Prime n := by
      by_contra h
      exact (Finsupp.mem_support_iff.mp hn) (by rw [hβ, ite_eq_right h])
    have hlo := (Nat.le_ceil L).trans (Nat.cast_le.mpr (Finset.mem_Icc.mp hmem.1).1)
    have hhi : (n : ℝ) ≤ U := (Nat.le_floor_iff' hmem.2.ne_zero).mp
      (Finset.mem_Icc.mp hmem.1).2
    exact ⟨hL.trans hlo, hhi.trans (hU.trans (by linarith))⟩
  have hcoeff (n : ℕ) : ‖β n‖ ≤ 1 := by rw [hβ]; split_ifs <;> simp
  have hroot : Real.exp (Real.sqrt (Real.log x)) ≤ N := by
    have hs10 : (10 : ℝ) ≤ Real.sqrt (Real.log x) := by
      nlinarith [Real.sq_sqrt hlog0, Real.sqrt_nonneg (Real.log x)]
    have hs : Real.sqrt (Real.log x) ≤ Real.log x * (1 / 10 : ℝ) := by
      nlinarith [Real.sq_sqrt hlog0,
        mul_nonneg (Real.sqrt_nonneg (Real.log x)) (sub_nonneg.mpr hs10)]
    calc
      _ ≤ Real.exp (Real.log x * (1 / 10 : ℝ)) := Real.exp_monotone hs
      _ = x ^ (1 / 10 : ℝ) := (Real.rpow_def_of_pos hx0 _).symm
      _ ≤ N := hNL
  have hXupper : (⌈2 * N⌉₊ : ℝ) ≤ 3 * N := by
    have hceil := Nat.ceil_lt_add_one (by positivity : 0 ≤ 2 * N)
    linarith
  have hcap : ⌊U⌋₊ ≤ ⌈2 * N⌉₊ := by
    simpa only [Nat.floor_natCast] using
      Nat.floor_mono (hU.trans (Nat.le_ceil (2 * N)))
  have hsource := hSW x hxs N hNL hNU ({()} : Finset Unit)
    (fun _ => 1) (fun _ => (1 : ℂ)) (fun _ => ⌈L⌉₊)
    (fun _ => ⌊U⌋₊) (fun _ => ⌈2 * N⌉₊)
    (by simp) (by
      intro i hi
      exact hroot.trans ((by linarith : N ≤ 2 * N).trans (Nat.le_ceil (2 * N))))
    (by simpa using hXupper) (by simpa using hcap) (by simp)
  have hsource' := hsource
    (by simpa only [Finset.sum_singleton, one_mul, β, V] using hsupport)
    (by
      intro n hn
      simpa only [Finset.sum_singleton, one_mul, Real.rpow_zero]
        using hcoeff n) q hq r hr a ha
  have hfilter : β.filter (fun n : ℕ => Nat.Coprime n r) =
      ∑ n ∈ V, Finsupp.single n
        (if Nat.Prime n ∧ Nat.Coprime n r then (1 : ℂ) else 0) := by
    rw [Finsupp.filter_sum]
    apply Finset.sum_congr rfl
    intro n hn
    ext m
    simp only [Finsupp.filter_apply, Finsupp.single_apply]
    by_cases hnm : n = m
    · subst m
      by_cases hc : Nat.Coprime n r <;> by_cases hp : Nat.Prime n <;> simp [hc, hp]
    · simp only [hnm, ite_false, ite_self]
  simpa only [Finset.sum_singleton, one_mul, ← hfilter, β, V] using hsource'

open Classical in
theorem five_prime_closed_box_bv_uniform_log_saving :
    ∀ A : ℝ, 0 < A →
      ∃ B K X : ℝ, 0 < B ∧ 0 < K ∧ Real.exp 100 ≤ X ∧
        ∀ x : ℝ, X ≤ x → ∀ L U : Fin 5 → ℝ,
          (∀ i, x ^ (1 / 10 : ℝ) ≤ L i ∧ L i ≤ U i ∧ U i ≤ 2 * L i) →
          x / 32 ≤ (∏ i, L i) → (∏ i, L i) ≤ 2 * x →
          ∀ h : ℕ, 0 < h →
          let P (i : Fin 5) := (Finset.Icc ⌈L i⌉₊ ⌊U i⌋₊).filter Nat.Prime
          (∑ q ∈ Finset.Ioc 0 ⌊Real.sqrt x / (Real.log x) ^ B⌋₊,
            ⨆ a : (ZMod q)ˣ,
              ‖fullDiscrepancy
                ((∑ p ∈ Fintype.piFinset P,
                  Finsupp.single (∏ i, p i) (1 : ℂ)).filter
                    (fun n : ℕ => Nat.Coprime n h)) q (a : ZMod q).val‖) ≤
            K * (h.divisors.card : ℝ) * x / (Real.log x) ^ A := by
  let G (x : ℝ) (z : (Fin 5 → ℝ) × (Fin 5 → ℝ)) : Prop :=
    (∀ i, x ^ (1 / 10 : ℝ) ≤ z.1 i ∧ z.1 i ≤ z.2 i ∧ z.2 i ≤ 2 * z.1 i) ∧
      x / 32 ≤ (∏ i, z.1 i) ∧ (∏ i, z.1 i) ≤ 2 * x
  let P (z : (Fin 5 → ℝ) × (Fin 5 → ℝ)) (i : Fin 5) :=
    (Finset.Icc ⌈z.1 i⌉₊ ⌊z.2 i⌋₊).filter Nat.Prime
  let M (x : ℝ) (z : (Fin 5 → ℝ) × (Fin 5 → ℝ)) : ℝ :=
    if G x z then ∏ i : Fin 4, z.1 i.castSucc else Real.sqrt x
  let N (x : ℝ) (z : (Fin 5 → ℝ) × (Fin 5 → ℝ)) : ℝ :=
    if G x z then z.1 4 else Real.sqrt x
  let α (x : ℝ) (z : (Fin 5 → ℝ) × (Fin 5 → ℝ)) : ℕ →₀ ℂ :=
    if G x z then ∑ p ∈ Fintype.piFinset (fun i : Fin 4 => P z i.castSucc),
      Finsupp.single (∏ i, p i) 1 else 0
  let β (x : ℝ) (z : (Fin 5 → ℝ) × (Fin 5 → ℝ)) : ℕ →₀ ℂ :=
    if G x z then ∑ n ∈ P z 4, Finsupp.single n 1 else 0
  have hxbase (x : ℝ) (hx : Real.exp 100 ≤ x) :
      32 ≤ x ∧ 1 ≤ Real.log x ∧ 1 ≤ x ^ (1 / 10 : ℝ) := by
    have hx0 : 0 < x := (Real.exp_pos 100).trans_le hx
    have he : (32 : ℝ) ≤ Real.exp 100 := by
      have := Real.add_one_le_exp (100 : ℝ)
      linarith
    have hx32 := he.trans hx
    refine ⟨hx32, ?_, Real.one_le_rpow (by linarith) (by norm_num)⟩
    have := (Real.le_log_iff_exp_le hx0).mpr hx
    linarith
  have hgeom (x : ℝ) (hx : Real.exp 100 ≤ x)
      (z : (Fin 5 → ℝ) × (Fin 5 → ℝ)) (hg : G x z) :
      (∀ i, 1 ≤ z.1 i) ∧
      (M x z * N x z = ∏ i, z.1 i) ∧
      x ^ (1 / 10 : ℝ) ≤ M x z ∧ x ^ (1 / 10 : ℝ) ≤ N x z ∧
      N x z ≤ x ^ (2 : ℝ) := by
    have hb := hxbase x hx
    have hL (i : Fin 5) : 1 ≤ z.1 i := hb.2.2.trans (hg.1 i).1
    have hM : x ^ (1 / 10 : ℝ) ≤ ∏ i : Fin 4, z.1 i.castSucc := by
      apply (hg.1 (0 : Fin 5)).1.trans
      have hs := Finset.prod_le_prod_of_subset_of_one_le
        (Finset.singleton_subset_iff.mpr (Finset.mem_univ (0 : Fin 4)))
        (fun i _ => (zero_le_one.trans (hL i.castSucc)))
        (fun i _ _ => hL i.castSucc)
      simpa only [Finset.prod_singleton,
        show (0 : Fin 4).castSucc = (0 : Fin 5) from rfl] using hs
    have hprod : (∏ i : Fin 4, z.1 i.castSucc) * z.1 4 = ∏ i, z.1 i := by
      simpa only [show Fin.last 4 = (4 : Fin 5) from rfl] using
        (Fin.prod_univ_castSucc (n := 4) z.1).symm
    have hNone : z.1 4 ≤ ∏ i, z.1 i := by
      have hs := Finset.prod_le_prod_of_subset_of_one_le
        (Finset.singleton_subset_iff.mpr (Finset.mem_univ (4 : Fin 5)))
        (fun i _ => zero_le_one.trans (hL i)) (fun i _ _ => hL i)
      simpa only [Finset.prod_singleton] using hs
    refine ⟨hL, ?_, ?_, ?_, ?_⟩
    · simpa only [M, N, ite_eq_left hg] using hprod
    · simpa only [M, ite_eq_left hg] using hM
    · simpa only [N, ite_eq_left hg] using (hg.1 4).1
    · simp only [N, ite_eq_left hg, Real.rpow_two]
      nlinarith [hNone.trans hg.2.2]
  have hscale : ∀ x : ℝ, Real.exp 100 ≤ x → ∀ z,
      x / 32 ≤ M x z * N x z ∧ M x z * N x z ≤ 32 * x ∧
      x ^ (1 / 10 : ℝ) ≤ M x z ∧ x ^ (1 / 10 : ℝ) ≤ N x z := by
    intro x hx z
    have hb := hxbase x hx
    by_cases hg : G x z
    · obtain ⟨hL, hprod, hM, hN, hNU⟩ := hgeom x hx z hg
      refine ⟨?_, ?_, hM, hN⟩
      · rw [hprod]; exact hg.2.1
      · rw [hprod]; nlinarith [hg.2.2]
    · have hs : x ^ (1 / 10 : ℝ) ≤ Real.sqrt x := by
        rw [Real.sqrt_eq_rpow]
        exact Real.rpow_le_rpow_of_exponent_le (by linarith) (by norm_num)
      simp only [M, N, ite_eq_right hg, Real.mul_self_sqrt (by linarith : 0 ≤ x)]
      exact ⟨by linarith, by linarith, hs, hs⟩
  have hP (z : (Fin 5 → ℝ) × (Fin 5 → ℝ)) (i : Fin 5) (p : ℕ)
      (hp : p ∈ P z i) : 0 < p := (Finset.mem_filter.mp hp).2.pos
  have hbeta (z : (Fin 5 → ℝ) × (Fin 5 → ℝ)) :
      (∑ n ∈ P z 4, Finsupp.single n (1 : ℂ)) =
      ∑ n ∈ Finset.Icc ⌈z.1 4⌉₊ ⌊z.2 4⌋₊,
        Finsupp.single n (if Nat.Prime n then (1 : ℂ) else 0) := by
    rw [Finset.sum_filter]
    apply Finset.sum_congr rfl
    intro n hn
    split_ifs <;> simp
  have hsupport : ∀ x : ℝ, Real.exp 100 ≤ x → ∀ z,
      (∀ n ∈ (α x z).support, 1 * M x z ≤ (n : ℝ) ∧ (n : ℝ) ≤ 32 * M x z) ∧
      (∀ n ∈ (β x z).support, 1 * N x z ≤ (n : ℝ) ∧ (n : ℝ) ≤ 32 * N x z) := by
    intro x hx z
    by_cases hg : G x z
    · have hL := (hgeom x hx z hg).1
      have hcoord (i : Fin 5) (p : ℕ) (hp : p ∈ P z i) :
          z.1 i ≤ (p : ℝ) ∧ (p : ℝ) ≤ 2 * z.1 i := by
        have hm := Finset.mem_filter.mp hp
        refine ⟨(Nat.le_ceil _).trans (Nat.cast_le.mpr (Finset.mem_Icc.mp hm.1).1), ?_⟩
        exact ((Nat.le_floor_iff' hm.2.ne_zero).mp (Finset.mem_Icc.mp hm.1).2).trans
          (hg.1 i).2.2
      constructor
      · intro n hn
        have hn' : n ∈ (∑ p ∈ Fintype.piFinset (fun i : Fin 4 => P z i.castSucc),
            Finsupp.single (∏ i, p i) (1 : ℂ)).support := by
          simpa only [α, ite_eq_left hg] using hn
        obtain ⟨p, hp, rfl⟩ :=
          (finite_positive_tuple_coefficient_support_and_bound
            (fun i : Fin 4 => P z i.castSucc) (fun i => hP z i.castSucc)).1 n hn'
        have hpcoord (i : Fin 4) := hcoord i.castSucc (p i) (Fintype.mem_piFinset.mp hp i)
        simp only [M, ite_eq_left hg, one_mul, Nat.cast_prod]
        constructor
        · exact Finset.prod_le_prod (fun i _ => (by linarith [hL i.castSucc]))
            (fun i _ => (hpcoord i).1)
        · have hu : (∏ i : Fin 4, (p i : ℝ)) ≤
              ∏ i : Fin 4, 2 * z.1 i.castSucc :=
            Finset.prod_le_prod (fun i _ => Nat.cast_nonneg _) (fun i _ => (hpcoord i).2)
          have hprod0 : 0 ≤ ∏ i : Fin 4, z.1 i.castSucc :=
            Finset.prod_nonneg fun i _ => (by linarith [hL i.castSucc])
          simpa only [Finset.prod_mul_distrib, Finset.prod_const, Finset.card_univ,
            Fintype.card_fin, show (2 : ℝ) ^ 4 = 16 by norm_num] using
            hu.trans (by
              rw [Finset.prod_mul_distrib]
              simp only [Finset.prod_const, Finset.card_univ, Fintype.card_fin]
              nlinarith)
      · intro n hn
        have hn' : n ∈ (∑ p ∈ P z 4, Finsupp.single p (1 : ℂ)).support := by
          simpa only [β, ite_eq_left hg] using hn
        obtain ⟨p, hp, hsingle⟩ := Finsupp.mem_support_finsetSum n hn'
        have heq := (Finsupp.mem_support_single n p (1 : ℂ)).mp hsingle
        rcases heq with ⟨rfl, h1⟩
        have hc := hcoord 4 n hp
        simp only [N, ite_eq_left hg, one_mul]
        exact ⟨hc.1, by linarith [hc.2, hL 4]⟩
    · simp only [α, β, ite_eq_right hg, Finsupp.support_zero, Finset.notMem_empty,
        false_implies, implies_true, and_self]
  have hcoeff : ∀ x : ℝ, Real.exp 100 ≤ x → ∀ z, ∀ n : ℕ,
      ‖α x z n‖ ≤ 1 * (n.divisors.card : ℝ) ^ 4 * (Real.log x) ^ 4 ∧
      ‖β x z n‖ ≤ 1 * (n.divisors.card : ℝ) ^ 4 * (Real.log x) ^ 4 := by
    intro x hx z n
    have hlog := (hxbase x hx).2.1
    have hlogpow : 1 ≤ (Real.log x) ^ 4 := one_le_pow₀ hlog
    have hα := (finite_positive_tuple_coefficient_support_and_bound
      (fun i : Fin 4 => P z i.castSucc) (fun i => hP z i.castSucc)).2 n
    by_cases hg : G x z
    · simp only [α, β, ite_eq_left hg, one_mul]
      constructor
      · exact hα.trans (le_mul_of_one_le_right (pow_nonneg (Nat.cast_nonneg _) _) hlogpow)
      · have hvalue : (∑ p ∈ P z 4, Finsupp.single p (1 : ℂ)) n =
            if n ∈ P z 4 then 1 else 0 := by
          simp only [Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_ite_eq']
        rw [hvalue]
        by_cases hn : n ∈ P z 4
        · rw [ite_eq_left hn, norm_one]
          have hτ : (1 : ℝ) ≤ n.divisors.card := by
            exact_mod_cast Finset.card_pos.mpr (Nat.nonempty_divisors.mpr (hP z 4 n hn).ne')
          exact (one_le_pow₀ hτ).trans
            (le_mul_of_one_le_right (pow_nonneg (Nat.cast_nonneg _) _) hlogpow)
        · rw [ite_eq_right hn, norm_zero]
          positivity
    · simp only [α, β, ite_eq_right hg, Finsupp.zero_apply, norm_zero, one_mul]
      exact ⟨by positivity, by positivity⟩
  have hSW : ∀ A : ℝ, 0 < A →
      ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
        ∀ x : ℝ, X ≤ x → ∀ z,
        ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
          ‖fullDiscrepancy
            ((β x z).filter (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
            K * ((q * r).divisors.card : ℝ) ^ 1 * N x z / (Real.log x) ^ A := by
    intro A hA
    obtain ⟨K, X, hK, hX, hs⟩ := prime_closed_interval_all_moduli_siegelWalfisz A hA
    refine ⟨K, X, hK, hX, ?_⟩
    intro x hx z q r a hq hr ha
    have hx100 := hX.trans hx
    by_cases hg : G x z
    · have hg' := hgeom x hx100 z hg
      have hh := hs x hx (z.1 4) (z.1 4) (z.2 4)
        (hg.1 4).1 (by simpa only [N, ite_eq_left hg] using hg'.2.2.2.2)
        le_rfl (hg.1 4).2.2 q r a hq hr ha
      simpa only [β, N, ite_eq_left hg, hbeta, pow_one] using hh
    · simp only [β, N, ite_eq_right hg, Finsupp.filter_zero,
        fullDiscrepancy,
        progressionMass, reducedMass,
        Finsupp.support_zero,
        Finset.sum_empty, zero_div, sub_self, norm_zero]
      have hlog : 0 ≤ Real.log x := zero_le_one.trans (hxbase x hx100).2.1
      positivity
  have hbase : Real.exp 1 ≤ Real.exp 100 := Real.exp_le_exp.mpr (by norm_num)
  have hBV := balanced_bv_masked_uniform_log_saving
    M N α β 1 32 1 (1 / 10) (Real.exp 100) 4 1
    (by norm_num) (by norm_num) (by norm_num) (by norm_num) hbase
    hscale hsupport hcoeff hSW
  intro A hA
  obtain ⟨B, K, X, hB, hK, hX, hbound⟩ := hBV A hA
  refine ⟨B, K, X, hB, hK, hX, ?_⟩
  intro x hx L U hLU hlow hhigh h hh P'
  have hg : G x (L, U) := ⟨hLU, hlow, hhigh⟩
  have hconv := finite_five_prime_full_box_convolution (P (L, U))
  have hfinal := hbound x hx (L, U) h hh
  simpa only [α, β, ite_eq_left hg, ← hconv, pow_one, P, P'] using hfinal

theorem geometric_bin_integer_interval (h : ℝ) (hh : 0 < h)
    (n k : ℕ) (hn : 1 ≤ n) :
    ⌊Real.logb (1 + h) (n : ℝ)⌋₊ = k ↔
      ⌈(1 + h) ^ k⌉₊ ≤ n ∧ n ≤ ⌈(1 + h) ^ (k + 1)⌉₊ - 1 := by
  have hb : 1 < 1 + h := by linarith
  have hn0 : 0 < (n : ℝ) := by exact_mod_cast (zero_lt_one.trans_le hn)
  have hlog : 0 ≤ Real.logb (1 + h) (n : ℝ) :=
    Real.logb_nonneg hb (by exact_mod_cast hn)
  rw [Nat.floor_eq_iff hlog, Nat.ceil_le]
  have hk : 0 < ⌈(1 + h) ^ (k + 1)⌉₊ := by
    exact Nat.ceil_pos.mpr (by positivity)
  rw [Nat.le_sub_one_iff_lt hk, Nat.lt_ceil]
  rw [Real.le_logb_iff_rpow_le hb hn0,
    Real.logb_lt_iff_lt_rpow hb hn0]
  rw [show (k : ℝ) + 1 = ((k + 1 : ℕ) : ℝ) by norm_cast]
  simp only [Real.rpow_natCast]

theorem geometric_bin_pair_ratios (h : ℝ) (hh : 0 < h)
    (m n : ℕ) (hm : 1 ≤ m) (hn : 1 ≤ n)
    (heq : ⌊Real.logb (1 + h) (m : ℝ)⌋₊ =
      ⌊Real.logb (1 + h) (n : ℝ)⌋₊) :
    (m : ℝ) ≤ (1 + h) * n ∧ (n : ℝ) ≤ (1 + h) * m := by
  have one_way (a b : ℕ) (ha : 1 ≤ a) (hb : 1 ≤ b)
      (hab : ⌊Real.logb (1 + h) (a : ℝ)⌋₊ =
        ⌊Real.logb (1 + h) (b : ℝ)⌋₊) : (a : ℝ) ≤ (1 + h) * b := by
    have hbase : 1 < 1 + h := by linarith
    have ha0 : 0 < (a : ℝ) := by exact_mod_cast (zero_lt_one.trans_le ha)
    have hb0 : 0 < (b : ℝ) := by exact_mod_cast (zero_lt_one.trans_le hb)
    have hlogb : 0 ≤ Real.logb (1 + h) (b : ℝ) :=
      Real.logb_nonneg hbase (by exact_mod_cast hb)
    have hlo := Nat.floor_le hlogb
    have hhi := Nat.lt_floor_add_one (Real.logb (1 + h) (a : ℝ))
    rw [hab] at hhi
    have hlt : Real.logb (1 + h) (a : ℝ) <
        Real.logb (1 + h) (b : ℝ) + 1 := by linarith
    have hmul : Real.logb (1 + h) ((1 + h) * b) =
        Real.logb (1 + h) (b : ℝ) + 1 := by
      rw [Real.logb_mul (by positivity) hb0.ne', Real.logb_self_eq_one hbase]
      ring
    rw [← hmul] at hlt
    exact ((Real.logb_lt_logb_iff hbase ha0 (by positivity)).mp hlt).le
  exact ⟨one_way m n hm hn heq, one_way n m hn hm heq.symm⟩

theorem geometric_bin_label_bound (h x : ℝ) (hh : 0 < h)
    (n : ℕ) (hn : 1 ≤ n) (hnx : (n : ℝ) ≤ 2 * x) :
    ⌊Real.logb (1 + h) (n : ℝ)⌋₊ <
      ⌈Real.logb (1 + h) (2 * x)⌉₊ + 1 := by
  have hb : 1 < 1 + h := by linarith
  have hn0 : 0 < (n : ℝ) := by exact_mod_cast (zero_lt_one.trans_le hn)
  have hlog : 0 ≤ Real.logb (1 + h) (n : ℝ) :=
    Real.logb_nonneg hb (by exact_mod_cast hn)
  apply Nat.lt_succ_of_le
  exact_mod_cast (Nat.floor_le hlog).trans
    ((Real.logb_le_logb_of_le hb hn0 hnx).trans (Nat.le_ceil _))

theorem geometric_five_box_product_bound (h x : ℝ) (hh : 0 < h) (hh1 : h ≤ 1)
    (p q : Fin 5 → ℕ) (hp : ∀ i, 1 ≤ p i) (hq : ∀ i, 1 ≤ q i)
    (hlabel : ∀ i, ⌊Real.logb (1 + h) (p i : ℝ)⌋₊ =
      ⌊Real.logb (1 + h) (q i : ℝ)⌋₊)
    (hprod : ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x) :
    ((∏ i, q i : ℕ) : ℝ) ≤ 64 * x := by
  have hp0 : 0 ≤ ∏ i, (p i : ℝ) := Finset.prod_nonneg fun _ _ => Nat.cast_nonneg _
  have hprod' : (∏ i, (p i : ℝ)) ≤ 2 * x := by exact_mod_cast hprod
  have hratio : (∏ i, (q i : ℝ)) ≤ (1 + h) ^ 5 * ∏ i, (p i : ℝ) := by
    calc
      _ ≤ ∏ i, ((1 + h) * p i) :=
        Finset.prod_le_prod (fun _ _ => Nat.cast_nonneg _)
          (fun i _ => (geometric_bin_pair_ratios h hh (p i) (q i)
            (hp i) (hq i) (hlabel i)).2)
      _ = _ := by rw [Finset.prod_mul_distrib]; simp
  have hpow : (1 + h) ^ 5 ≤ (32 : ℝ) := by
    calc
      (1 + h) ^ 5 ≤ 2 ^ 5 := pow_le_pow_left₀ (by positivity) (by linarith) _
      _ = 32 := by norm_num
  have := hratio.trans (mul_le_mul_of_nonneg_right hpow hp0)
  exact_mod_cast this.trans (by nlinarith only [hprod'])

/--
A multiplicative inequality on five coordinates, specified by a quotient of coordinate products,
a real threshold, and flags selecting a lower or upper bound and strictness.
-/
structure MinorantMonomialCut where
  /--
  Indices of the five coordinates multiplied in the quotient's numerator; the empty product is
  `1`.
  -/
  numerator : Finset (Fin 5)
  /--
  Indices of the five coordinates multiplied in the quotient's denominator; the empty product is
  `1`.
  -/
  denominator : Finset (Fin 5)
  /--
  The real comparison level for the coordinate-product quotient; the structure imposes no
  positivity condition on this field.
  -/
  threshold : ℝ
  /--
  Select a lower bound (`threshold ≤ value`) when `true`, and an upper bound (`value ≤
  threshold`) when `false`; `strict` changes `≤` to `<`.
  -/
  lower : Bool
  /--
  Select `<` when `true` and `≤` when `false`; `lower` determines which side contains the
  threshold.
  -/
  strict : Bool

/--
The real quotient of the coordinate products selected by the numerator and denominator of a
five-coordinate cut. Division uses Lean's totalized real-field convention, including zero
denominators.
-/
noncomputable def MinorantMonomialCut.value (d : MinorantMonomialCut)
    (p : Fin 5 → ℕ) : ℝ :=
  (∏ i ∈ d.numerator, (p i : ℝ)) / ∏ i ∈ d.denominator, (p i : ℝ)

open Classical in
/--
The multiplicative cuts for exceptional region `j`, including the closed total-product window
`[x, 2 * x]` and the corresponding prime-size and ordering inequalities.
-/
noncomputable def minorantMonomialCuts (x : ℝ) (j : Fin 2) :
    Finset MinorantMonomialCut :=
  {⟨Finset.univ, ∅, x, true, false⟩,
    ⟨Finset.univ, ∅, 2 * x, false, false⟩} ∪
  if j.val = 0 then
    {⟨{3}, ∅, x ^ ((9519 : ℝ) / 50000), true, false⟩,
      ⟨{3}, {2}, 1, false, true⟩,
      ⟨{2}, {1}, 1, false, true⟩,
      ⟨{1}, {0}, 1, false, true⟩,
      ⟨{0}, ∅, x ^ ((40481 : ℝ) / 100000), false, true⟩,
      ⟨{0, 1}, ∅, x ^ ((40481 : ℝ) / 100000), false, true⟩,
      ⟨{1, 2, 3}, ∅, x ^ ((59519 : ℝ) / 100000), true, true⟩,
      ⟨{3}, {4}, 1, false, false⟩}
  else
    (Finset.univ.biUnion fun i : Fin 5 =>
      {⟨{i}, ∅, x ^ ((9519 : ℝ) / 50000), true, false⟩,
        ⟨{i}, ∅, x ^ (1 - 4 * ((9519 : ℝ) / 50000)), false, false⟩}) ∪
      {⟨{1}, {0}, 1, false, true⟩,
        ⟨{1}, {2}, 1, false, true⟩,
        ⟨{0, 2}, ∅, x ^ ((40481 : ℝ) / 100000), false, true⟩,
        ⟨{0, 1, 3}, ∅, x ^ ((59519 : ℝ) / 100000), true, true⟩,
        ⟨{3}, {4}, 1, false, false⟩}

theorem literal_minorant_monomial_cuts_iff (x : ℝ) (hx : 1 < x)
    (j : Fin 2) (p : Fin 5 → ℕ) (hp : ∀ i, 0 < p i) :
    let α : Fin 5 → ℝ := fun i => Real.logb x (p i : ℝ)
    let C : Prop := if j.val = 0 then
      (9519 : ℝ) / 50000 ≤ α 3 ∧
      α 3 < α 2 ∧ α 2 < α 1 ∧ α 1 < α 0 ∧
      α 0 < (40481 : ℝ) / 100000 ∧
      α 0 + α 1 < (40481 : ℝ) / 100000 ∧
      (59519 : ℝ) / 100000 < α 1 + α 2 + α 3 ∧ (p 3 : ℝ) ≤ p 4
    else
      (∀ i, (9519 : ℝ) / 50000 ≤ α i ∧
        α i ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
      α 1 < α 0 ∧ α 1 < α 2 ∧
      α 0 + α 2 < (40481 : ℝ) / 100000 ∧
      (59519 : ℝ) / 100000 < α 0 + α 1 + α 3 ∧ α 3 ≤ α 4
    ((∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧ C) ↔
      ∀ d ∈ minorantMonomialCuts x j,
        if d.lower then
          if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
        else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold := by
  classical
  intro α C
  have hpos (i : Fin 5) : 0 < (p i : ℝ) := by exact_mod_cast hp i
  have horder (i k : Fin 5) :
      (α i < α k ↔ (p i : ℝ) / p k < 1) ∧
      (α i ≤ α k ↔ (p i : ℝ) / p k ≤ 1) := by
    dsimp [α]
    rw [Real.logb_lt_logb_iff hx (hpos i) (hpos k),
      Real.logb_le_logb hx (hpos i) (hpos k),
      div_lt_one (hpos k), div_le_one (hpos k)]
    exact ⟨Iff.rfl, Iff.rfl⟩
  have hlow (i : Fin 5) (t : ℝ) : t ≤ α i ↔ x ^ t ≤ (p i : ℝ) :=
    Real.le_logb_iff_rpow_le hx (hpos i)
  have hupp (i : Fin 5) (t : ℝ) : α i ≤ t ↔ (p i : ℝ) ≤ x ^ t :=
    Real.logb_le_iff_le_rpow hx (hpos i)
  have hlt (i : Fin 5) (t : ℝ) : α i < t ↔ (p i : ℝ) < x ^ t :=
    Real.logb_lt_iff_lt_rpow hx (hpos i)
  have hpair (i k : Fin 5) (t : ℝ) :
      α i + α k < t ↔ (p i : ℝ) * p k < x ^ t := by
    dsimp [α]
    rw [← Real.logb_mul (hpos i).ne' (hpos k).ne',
      Real.logb_lt_iff_lt_rpow hx (mul_pos (hpos i) (hpos k))]
  have htriple (i k l : Fin 5) (t : ℝ) :
      t < α i + α k + α l ↔ x ^ t < (p i : ℝ) * p k * p l := by
    dsimp [α]
    rw [← Real.logb_mul (hpos i).ne' (hpos k).ne',
      ← Real.logb_mul (mul_pos (hpos i) (hpos k)).ne' (hpos l).ne',
      Real.lt_logb_iff_rpow_lt hx (mul_pos (mul_pos (hpos i) (hpos k)) (hpos l))]
  have hcarrier : (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ↔
      x ≤ ∏ i, (p i : ℝ) ∧ (∏ i, (p i : ℝ)) ≤ 2 * x := by
    rw [Finset.mem_Icc, Nat.ceil_le, Nat.le_floor_iff (by positivity)]
    push_cast
    rfl
  have hforall (F : Fin 5 → Finset MinorantMonomialCut) (G : MinorantMonomialCut → Prop) :
      (∀ d ∈ Finset.univ.biUnion F, G d) ↔ ∀ i, ∀ d ∈ F i, G d := by
    constructor
    · intro H i d hd
      exact H d (Finset.mem_biUnion.mpr ⟨i, Finset.mem_univ i, hd⟩)
    · intro H d hd
      obtain ⟨i, _, hi⟩ := Finset.mem_biUnion.mp hd
      exact H i d hi
  by_cases hj : j.val = 0
  · simp only [C, hj, ite_true, hcarrier]
    rw [(horder 3 2).1, (horder 2 1).1, (horder 1 0).1]
    simp only [hlow, hlt, hpair, htriple]
    simp [minorantMonomialCuts, hj, MinorantMonomialCut.value,
      div_le_one (hpos 4), mul_assoc, and_assoc]
    tauto
  · simp only [C, hj, ite_false, hcarrier]
    rw [(horder 1 0).1, (horder 1 2).1, (horder 3 4).2]
    simp only [hlow, hupp, hpair, htriple]
    simp only [minorantMonomialCuts, hj, ite_false, Finset.forall_mem_union, hforall]
    simp [MinorantMonomialCut.value, mul_assoc, and_assoc, forall_and]

theorem minorantMonomialCuts_data (x : ℝ) (hx : 0 < x) (j : Fin 2)
    (d : MinorantMonomialCut) (hd : d ∈ minorantMonomialCuts x j) :
    d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
      d.numerator.card + d.denominator.card ≤ 5 ∧ 0 < d.threshold := by
  classical
  by_cases hj : j.val = 0
  · simp only [minorantMonomialCuts, hj, ite_true, Finset.mem_union,
      Finset.mem_insert, Finset.mem_singleton] at hd
    rcases hd with (rfl | rfl) | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl <;>
      norm_num [Finset.card_fin, Finset.disjoint_left] <;>
        first | positivity | decide | exact ⟨Finset.card_le_univ _, by positivity⟩
  · simp only [minorantMonomialCuts, hj, ite_false, Finset.mem_union,
      Finset.mem_insert, Finset.mem_singleton, Finset.mem_biUnion,
      Finset.mem_univ, true_and] at hd
    rcases hd with (rfl | rfl) | (⟨i, rfl | rfl⟩ | rfl | rfl | rfl | rfl | rfl) <;>
      norm_num [Finset.card_fin, Finset.disjoint_left] <;>
        first | positivity | decide | exact ⟨Finset.card_le_univ _, by positivity⟩

theorem minorantMonomialCuts_card_le (x : ℝ) (j : Fin 2) :
    (minorantMonomialCuts x j).card ≤ 17 := by
  classical
  have height (a b c d e f g k : MinorantMonomialCut) :
      ({a, b, c, d, e, f, g, k} : Finset MinorantMonomialCut).card ≤ 8 :=
    (Finset.card_insert_le _ _).trans (Nat.succ_le_succ
      ((Finset.card_insert_le _ _).trans (Nat.succ_le_succ Finset.card_le_six)))
  have hten (F : Fin 5 → Finset MinorantMonomialCut) (hF : ∀ i, (F i).card ≤ 2) :
      (Finset.univ.biUnion F).card ≤ 10 := by
    calc
      _ ≤ ∑ i : Fin 5, (F i).card := Finset.card_biUnion_le
      _ ≤ ∑ _i : Fin 5, 2 := Finset.sum_le_sum fun i _ => hF i
      _ = 10 := by norm_num
  unfold minorantMonomialCuts
  split_ifs
  · exact (Finset.card_union_le _ _).trans
      ((Nat.add_le_add Finset.card_le_two (height _ _ _ _ _ _ _ _)).trans (by decide))
  · exact (Finset.card_union_le _ _).trans
      ((Nat.add_le_add Finset.card_le_two
        ((Finset.card_union_le _ _).trans
          (Nat.add_le_add (hten _ (fun _ => Finset.card_le_two))
            Finset.card_le_five))).trans (by decide))

theorem geometric_monomial_comparison (h : ℝ) (hh : 0 < h)
    (p q : Fin 5 → ℕ) (hp : ∀ i, 1 ≤ p i) (hq : ∀ i, 1 ≤ q i)
    (hlabel : ∀ i, ⌊Real.logb (1 + h) (p i : ℝ)⌋₊ =
      ⌊Real.logb (1 + h) (q i : ℝ)⌋₊)
    (d : MinorantMonomialCut) :
    d.value p ≤ (1 + h) ^ (d.numerator.card + d.denominator.card) * d.value q ∧
    d.value q ≤ (1 + h) ^ (d.numerator.card + d.denominator.card) * d.value p := by
  have one_way (p q : Fin 5 → ℕ) (hp : ∀ i, 1 ≤ p i) (hq : ∀ i, 1 ≤ q i)
      (hlab : ∀ i, ⌊Real.logb (1 + h) (p i : ℝ)⌋₊ =
        ⌊Real.logb (1 + h) (q i : ℝ)⌋₊) :
      d.value p ≤ (1 + h) ^ (d.numerator.card + d.denominator.card) * d.value q := by
    have hp0 (i : Fin 5) : 0 < (p i : ℝ) := by exact_mod_cast hp i
    have hq0 (i : Fin 5) : 0 < (q i : ℝ) := by exact_mod_cast hq i
    have hnum : (∏ i ∈ d.numerator, (p i : ℝ)) ≤
        (1 + h) ^ d.numerator.card * ∏ i ∈ d.numerator, (q i : ℝ) := by
      calc
        _ ≤ ∏ i ∈ d.numerator, ((1 + h) * q i) :=
          Finset.prod_le_prod (fun i _ => (hp0 i).le)
            (fun i _ => (geometric_bin_pair_ratios h hh (p i) (q i)
              (hp i) (hq i) (hlab i)).1)
        _ = _ := by rw [Finset.prod_mul_distrib, Finset.prod_const]
    have hden : (∏ i ∈ d.denominator, (q i : ℝ)) ≤
        (1 + h) ^ d.denominator.card * ∏ i ∈ d.denominator, (p i : ℝ) := by
      calc
        _ ≤ ∏ i ∈ d.denominator, ((1 + h) * p i) :=
          Finset.prod_le_prod (fun i _ => (hq0 i).le)
            (fun i _ => (geometric_bin_pair_ratios h hh (p i) (q i)
              (hp i) (hq i) (hlab i)).2)
        _ = _ := by rw [Finset.prod_mul_distrib, Finset.prod_const]
    have hpd : 0 < ∏ i ∈ d.denominator, (p i : ℝ) :=
      Finset.prod_pos fun i _ => hp0 i
    have hqd : 0 < ∏ i ∈ d.denominator, (q i : ℝ) :=
      Finset.prod_pos fun i _ => hq0 i
    dsimp [MinorantMonomialCut.value]
    rw [pow_add, ← mul_div_assoc, div_le_div_iff₀ hpd hqd]
    calc
      _ ≤ ((1 + h) ^ d.numerator.card * ∏ i ∈ d.numerator, (q i : ℝ)) *
          ((1 + h) ^ d.denominator.card * ∏ i ∈ d.denominator, (p i : ℝ)) :=
        mul_le_mul hnum hden hqd.le (by positivity)
      _ = _ := by ring
  exact ⟨one_way p q hp hq hlabel, one_way q p hq hp (fun i => (hlabel i).symm)⟩

theorem threshold_bands_of_crossing (a b t R : ℝ) (ht : 0 ≤ t)
    (hR : 1 ≤ R) (hab : a ≤ R * b) (hba : b ≤ R * a)
    (hcross : (a ≤ t ∧ t ≤ b) ∨ (b ≤ t ∧ t ≤ a)) :
    (t / R ≤ a ∧ a ≤ t * R) ∧ (t / R ≤ b ∧ b ≤ t * R) := by
  have hR0 : 0 < R := zero_lt_one.trans_le hR
  have hlo : t / R ≤ t := div_le_self ht hR
  have hhi : t ≤ t * R := le_mul_of_one_le_right ht hR
  rcases hcross with ⟨hat, htb⟩ | ⟨hbt, hta⟩
  · refine ⟨⟨(div_le_iff₀ hR0).mpr (by nlinarith only [htb, hba]), hat.trans hhi⟩,
      ⟨hlo.trans htb, ?_⟩⟩
    exact hba.trans (by nlinarith only [mul_le_mul_of_nonneg_left hat hR0.le])
  · refine ⟨⟨hlo.trans hta, ?_⟩,
      ⟨(div_le_iff₀ hR0).mpr (by nlinarith only [hta, hab]), hbt.trans hhi⟩⟩
    exact hab.trans (by nlinarith only [mul_le_mul_of_nonneg_left hbt hR0.le])

theorem geometric_minorant_boundary_cover (x h : ℝ) (hx : 1 < x) (hh : 0 < h)
    (j : Fin 2) (p q : Fin 5 → ℕ) (hp : ∀ i, 1 ≤ p i) (hq : ∀ i, 1 ≤ q i)
    (hlabel : ∀ i, ⌊Real.logb (1 + h) (p i : ℝ)⌋₊ =
      ⌊Real.logb (1 + h) (q i : ℝ)⌋₊)
    (hpass : ∀ d ∈ minorantMonomialCuts x j,
      if d.lower then
        if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
      else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold)
    (hfail : ¬∀ d ∈ minorantMonomialCuts x j,
      if d.lower then
        if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
      else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold) :
    ∃ d ∈ minorantMonomialCuts x j,
      (d.threshold / (1 + h) ^ (d.numerator.card + d.denominator.card) ≤ d.value p ∧
        d.value p ≤ d.threshold * (1 + h) ^ (d.numerator.card + d.denominator.card)) ∧
      (d.threshold / (1 + h) ^ (d.numerator.card + d.denominator.card) ≤ d.value q ∧
        d.value q ≤ d.threshold * (1 + h) ^ (d.numerator.card + d.denominator.card)) := by
  classical
  have hex : ∃ d ∈ minorantMonomialCuts x j,
      ¬(if d.lower then
        if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
      else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold) := by
    simpa only [not_forall, exists_prop] using hfail
  obtain ⟨d, hd, hbad⟩ := hex
  refine ⟨d, hd, ?_⟩
  have hgood := hpass d hd
  have hcompare := geometric_monomial_comparison h hh p q hp hq hlabel d
  have hR : 1 ≤ (1 + h) ^ (d.numerator.card + d.denominator.card) :=
    one_le_pow₀ (by linarith)
  have ht := (minorantMonomialCuts_data x (zero_lt_one.trans hx) j d hd).2.2.2
  apply threshold_bands_of_crossing _ _ _ _ ht.le hR hcompare.1 hcompare.2
  cases hl : d.lower <;> cases hs : d.strict <;>
    simp only [hl, hs, Bool.false_eq_true, ite_false, ite_true, not_le, not_lt] at hgood hbad
  · exact Or.inl ⟨hgood, hbad.le⟩
  · exact Or.inl ⟨hgood.le, hbad⟩
  · exact Or.inr ⟨hbad.le, hgood⟩
  · exact Or.inr ⟨hbad, hgood.le⟩

theorem geometric_mixed_box_boundary_cover (x h : ℝ) (hx : 1 < x) (hh : 0 < h)
    (j : Fin 2) (p₀ p₁ q : Fin 5 → ℕ)
    (hp₀ : ∀ i, 1 ≤ p₀ i) (hp₁ : ∀ i, 1 ≤ p₁ i) (hq : ∀ i, 1 ≤ q i)
    (hlabel₀ : ∀ i, ⌊Real.logb (1 + h) (p₀ i : ℝ)⌋₊ =
      ⌊Real.logb (1 + h) (q i : ℝ)⌋₊)
    (hlabel₁ : ∀ i, ⌊Real.logb (1 + h) (p₁ i : ℝ)⌋₊ =
      ⌊Real.logb (1 + h) (q i : ℝ)⌋₊)
    (hpass : ∀ d ∈ minorantMonomialCuts x j,
      if d.lower then
        if d.strict then d.threshold < d.value p₀ else d.threshold ≤ d.value p₀
      else if d.strict then d.value p₀ < d.threshold else d.value p₀ ≤ d.threshold)
    (hfail : ¬∀ d ∈ minorantMonomialCuts x j,
      if d.lower then
        if d.strict then d.threshold < d.value p₁ else d.threshold ≤ d.value p₁
      else if d.strict then d.value p₁ < d.threshold else d.value p₁ ≤ d.threshold) :
    ∃ d ∈ minorantMonomialCuts x j,
      d.threshold / (1 + h) ^ (d.numerator.card + d.denominator.card) ≤ d.value q ∧
      d.value q ≤ d.threshold * (1 + h) ^ (d.numerator.card + d.denominator.card) := by
  classical
  by_cases hqpass : ∀ d ∈ minorantMonomialCuts x j,
      if d.lower then
        if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
      else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold
  · obtain ⟨d, hd, hband, _⟩ := geometric_minorant_boundary_cover x h hx hh j q p₁
      hq hp₁ (fun i => (hlabel₁ i).symm) hqpass hfail
    exact ⟨d, hd, hband⟩
  · obtain ⟨d, hd, _, hband⟩ := geometric_minorant_boundary_cover x h hx hh j p₀ q
      hp₀ hq hlabel₀ hpass hqpass
    exact ⟨d, hd, hband⟩

theorem geometric_degree_five_width (h : ℝ) (hh : 0 ≤ h) (hh1 : h ≤ 1)
    (n : ℕ) (hn : n ≤ 5) : ((1 + h) ^ n) ^ 2 - 1 ≤ 1023 * h := by
  have hpow : ((1 + h) ^ n) ^ 2 ≤ (1 + h) ^ 10 := by
    rw [← pow_mul]
    exact pow_le_pow_right₀ (by linarith) (by omega)
  have hsum : (∑ k ∈ Finset.range 10, (1 + h) ^ k) ≤ (1023 : ℝ) := by
    calc
      _ ≤ ∑ k ∈ Finset.range 10, (2 : ℝ) ^ k :=
        Finset.sum_le_sum fun k _ => pow_le_pow_left₀ (by positivity) (by linarith) k
      _ = 1023 := by norm_num [Finset.sum_range_succ]
  calc
    _ ≤ (1 + h) ^ 10 - 1 := sub_le_sub_right hpow 1
    _ = (∑ k ∈ Finset.range 10, (1 + h) ^ k) * h := by
      simpa only [add_sub_cancel_left] using (geom_sum_mul (1 + h) 10).symm
    _ ≤ 1023 * h := mul_le_mul_of_nonneg_right hsum hh

theorem monomial_clipped_band_width (t R Z : ℝ)
    (ht : 0 ≤ t) (hR : 1 ≤ R) (hZ : 0 ≤ Z) :
    min (t * R) Z - t / R ≤ (R ^ 2 - 1) * Z := by
  have hR0 : 0 < R := zero_lt_one.trans_le hR
  have hmin0 : 0 ≤ min (t * R) Z := le_min (mul_nonneg ht hR0.le) hZ
  have hminT := min_le_left (t * R) Z
  have hminZ := min_le_right (t * R) Z
  have hR2 : 1 ≤ R ^ 2 := one_le_pow₀ hR
  have hscale : min (t * R) Z ≤ (t / R) * R ^ 2 := by
    calc
      _ ≤ t * R := hminT
      _ = _ := by field_simp
  by_cases hnonempty : t / R ≤ min (t * R) Z
  · have hmul : (R ^ 2 - 1) * (t / R) ≤ (R ^ 2 - 1) * Z :=
      mul_le_mul_of_nonneg_left (hnonempty.trans hminZ) (sub_nonneg.mpr hR2)
    nlinarith only [hscale, hmul]
  · have hrhs : 0 ≤ (R ^ 2 - 1) * Z := mul_nonneg (sub_nonneg.mpr hR2) hZ
    linarith

theorem MinorantMonomialCut.value_insertNth_factor (d : MinorantMonomialCut)
    (i : Fin 5) (hi : i ∈ d.numerator) (hid : i ∉ d.denominator)
    (p : Fin 5 → ℕ) :
    d.value p = (p i : ℝ) * d.value (i.insertNth 1 (i.removeNth p)) := by
  classical
  rw [Fin.insertNth_removeNth]
  simp only [MinorantMonomialCut.value,
    Function.apply_update (fun (_ : Fin 5) (n : ℕ) => (n : ℝ)), Nat.cast_one]
  rw [Finset.prod_update_of_mem hi, Finset.prod_update_of_notMem hid,
    one_mul, Finset.sdiff_singleton_eq_erase, ← Finset.mul_prod_erase _ _ hi]
  ring

theorem MinorantMonomialCut.closed_coordinate_band (d : MinorantMonomialCut)
    (i : Fin 5) (hi : i ∈ d.numerator) (hid : i ∉ d.denominator)
    (p : Fin 5 → ℕ) (hp : ∀ k, 0 < p k) (R Z : ℝ) (hR : 0 < R)
    (hsupport : (p i : ℝ) ≤ Z)
    (hband : d.threshold / R ≤ d.value p ∧ d.value p ≤ d.threshold * R) :
    let t := d.threshold / d.value (i.insertNth 1 (i.removeNth p))
    t / R ≤ (p i : ℝ) ∧ (p i : ℝ) ≤ min (t * R) Z := by
  intro t
  have hbase : ∀ k : Fin 5, 0 < (i.insertNth 1 (i.removeNth p) k : ℝ) := by
    rw [Fin.insertNth_removeNth,
      Function.forall_update_iff p (fun _ (n : ℕ) => 0 < (n : ℝ))]
    exact ⟨by norm_num, fun k _ => Nat.cast_pos.mpr (hp k)⟩
  have hv : 0 < d.value (i.insertNth 1 (i.removeNth p)) :=
    div_pos (Finset.prod_pos fun k _ => hbase k) (Finset.prod_pos fun k _ => hbase k)
  rw [d.value_insertNth_factor i hi hid p] at hband
  constructor
  · dsimp [t]
    rw [div_div, div_le_iff₀ (mul_pos hv hR)]
    have hh := (div_le_iff₀ hR).mp hband.1
    nlinarith only [hh]
  · apply le_min _ hsupport
    dsimp [t]
    rw [div_mul_eq_mul_div, le_div_iff₀ hv]
    exact hband.2

open Classical in
theorem literal_minorant_mixed_geometric_box_card
    (x h : ℝ) (hx : 2 ≤ x) (hh : 0 < h) (hh1 : h ≤ 1) (j : Fin 2) :
    let P : Finset ℕ :=
      (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((6 : ℝ) / 25)⌋₊).filter Nat.Prime
    let T := Fintype.piFinset (fun _ : Fin 5 => P)
    let label (p : Fin 5 → ℕ) : Fin 5 → ℕ :=
      fun i => ⌊Real.logb (1 + h) (p i : ℝ)⌋₊
    let U (b : Fin 5 → ℕ) := T.filter (fun p => label p = b)
    let C (p : Fin 5 → ℕ) : Prop := ∀ d ∈ minorantMonomialCuts x j,
      if d.lower then
        if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
      else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold
    let D := (T.image label).filter
      (fun b => (∃ p ∈ U b, C p) ∧ ¬∀ p ∈ U b, C p)
    (∑ b ∈ D, ((U b).card : ℝ)) ≤
      17 * 64 * (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
        (1 + Real.log (64 * x)) ^ 16 := by
  intro P T label U C D
  let S := T.filter (fun q => label q ∈ D)
  let M := minorantMonomialCuts x j
  let R (d : MinorantMonomialCut) : ℝ := (1 + h) ^
    (d.numerator.card + d.denominator.card)
  let E (d : MinorantMonomialCut) := S.filter
    (fun q => d.threshold / R d ≤ d.value q ∧ d.value q ≤ d.threshold * R d)
  let V : ℝ := 64 * (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
    (1 + Real.log (64 * x)) ^ 16
  have hx1 : 1 < x := lt_of_lt_of_le (by norm_num) hx
  have hx0 : 0 < x := zero_lt_one.trans hx1
  have hpositive (p : Fin 5 → ℕ) (hp : p ∈ T) (i : Fin 5) : 1 ≤ p i := by
    have hprime : (p i).Prime :=
      (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).2
    exact hprime.one_lt.le
  have hlower (p : Fin 5 → ℕ) (hp : p ∈ T) (i : Fin 5) :
      x ^ ((9519 : ℝ) / 50000) ≤ (p i : ℝ) := by
    have hnat := (Finset.mem_Icc.mp
      (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).1).1
    exact (Nat.le_ceil _).trans (Nat.cast_le.mpr hnat)
  have hboundary (q : Fin 5 → ℕ) (hq : q ∈ S) :
      ((∏ i, q i : ℕ) : ℝ) ≤ 64 * x ∧
        ∃ d ∈ M, d.threshold / R d ≤ d.value q ∧ d.value q ≤ d.threshold * R d := by
    obtain ⟨hqT, hqD⟩ := Finset.mem_filter.mp hq
    have hmix := (Finset.mem_filter.mp hqD).2
    obtain ⟨p₀, hp₀, hpass⟩ := hmix.1
    have hex : ∃ p₁ ∈ U (label q), ¬C p₁ := by
      simpa only [not_forall, exists_prop] using hmix.2
    obtain ⟨p₁, hp₁, hfail⟩ := hex
    have hp₀T : p₀ ∈ T := (Finset.mem_filter.mp hp₀).1
    have hp₁T : p₁ ∈ T := (Finset.mem_filter.mp hp₁).1
    have hlab₀ (i : Fin 5) :
        ⌊Real.logb (1 + h) (p₀ i : ℝ)⌋₊ =
          ⌊Real.logb (1 + h) (q i : ℝ)⌋₊ :=
      congrFun (Finset.mem_filter.mp hp₀).2 i
    have hlab₁ (i : Fin 5) :
        ⌊Real.logb (1 + h) (p₁ i : ℝ)⌋₊ =
          ⌊Real.logb (1 + h) (q i : ℝ)⌋₊ :=
      congrFun (Finset.mem_filter.mp hp₁).2 i
    have hprod₀ : ((∏ i, p₀ i : ℕ) : ℝ) ≤ 2 * x := by
      have hd : (⟨Finset.univ, ∅, 2 * x, false, false⟩ : MinorantMonomialCut) ∈
          minorantMonomialCuts x j := by
        simp [minorantMonomialCuts]
      have ht := hpass _ hd
      simpa [MinorantMonomialCut.value] using ht
    refine ⟨geometric_five_box_product_bound h x hh hh1 p₀ q
      (hpositive p₀ hp₀T) (hpositive q hqT) hlab₀ hprod₀, ?_⟩
    exact geometric_mixed_box_boundary_cover x h hx1 hh j p₀ p₁ q
      (hpositive p₀ hp₀T) (hpositive p₁ hp₁T) (hpositive q hqT)
      hlab₀ hlab₁ hpass hfail
  have hE (d : MinorantMonomialCut) (hd : d ∈ M) : ((E d).card : ℝ) ≤ V := by
    have hdata := minorantMonomialCuts_data x hx0 j d hd
    obtain ⟨i, hi⟩ := hdata.1
    have hid : i ∉ d.denominator := fun hb => Finset.disjoint_left.mp hdata.2.1 hi hb
    have hR : 1 ≤ R d := one_le_pow₀ (by linarith)
    have hR0 : 0 < R d := zero_lt_one.trans_le hR
    let t (r : Fin 4 → ℕ) := d.threshold / d.value (i.insertNth 1 r)
    let L (r : Fin 4 → ℕ) := t r / R d
    let U₀ (r : Fin 4 → ℕ) := min (t r * R d) (64 * x / ((∏ k, r k : ℕ) : ℝ))
    have hwidth (r : Fin 4 → ℕ) (hr : ∀ k, 0 < r k) :
        U₀ r - L r ≤ (1023 * h) * (64 * x / ((∏ k, r k : ℕ) : ℝ)) := by
      have hbase : ∀ k : Fin 5,
          0 < ((Fin.insertNth (α := fun _ : Fin 5 => ℕ) i 1 r k : ℕ) : ℝ) := by
        rw [Fin.forall_iff_succAbove i]
        simpa using hr
      have ht : 0 ≤ t r :=
        div_nonneg hdata.2.2.2.le
          (div_nonneg (Finset.prod_nonneg fun k _ => (hbase k).le)
            (Finset.prod_nonneg fun k _ => (hbase k).le))
      have hZ : 0 ≤ 64 * x / ((∏ k, r k : ℕ) : ℝ) := by positivity
      exact (monomial_clipped_band_width (t r) (R d) _ ht hR hZ).trans
        (mul_le_mul_of_nonneg_right
          (geometric_degree_five_width h hh.le hh1 _ hdata.2.2.1) hZ)
    apply finite_five_tuple_monomial_boundary_count x (1023 * h) hx (by positivity)
      i (E d) L U₀
    · intro q hq
      obtain ⟨hqS, hband⟩ := Finset.mem_filter.mp hq
      have hqT := (Finset.mem_filter.mp hqS).1
      have hco : 0 < ((∏ k, i.removeNth q k : ℕ) : ℝ) := by
        exact_mod_cast Finset.prod_pos fun k _ =>
          zero_lt_one.trans_le (hpositive q hqT (i.succAbove k))
      have hsupport : (q i : ℝ) ≤ 64 * x / ((∏ k, i.removeNth q k : ℕ) : ℝ) := by
        rw [le_div_iff₀ hco]
        have heq : (q i : ℝ) * ((∏ k, i.removeNth q k : ℕ) : ℝ) =
            ((∏ k, q k : ℕ) : ℝ) := by exact_mod_cast Fin.mul_prod_removeNth i q
        rw [heq]
        exact (hboundary q hqS).1
      exact ⟨hlower q hqT, (hboundary q hqS).1,
        d.closed_coordinate_band i hi hid q
          (fun k => zero_lt_one.trans_le (hpositive q hqT k))
          (R d) _ hR0 hsupport hband⟩
    · intro r hr _hprod
      exact hwidth r hr
  have hcover : S ⊆ M.biUnion E := by
    intro q hq
    obtain ⟨d, hd, hband⟩ := (hboundary q hq).2
    exact Finset.mem_biUnion.mpr ⟨d, hd, Finset.mem_filter.mpr ⟨hq, hband⟩⟩
  have hcard : (S.card : ℝ) = ∑ b ∈ D, ((U b).card : ℝ) := by
    have hc : S.card = ∑ b ∈ D, (U b).card := by
      calc
        _ = ∑ b ∈ D, (S.filter (fun q => label q = b)).card :=
          Finset.card_eq_sum_card_fiberwise (fun q hq => (Finset.mem_filter.mp hq).2)
        _ = _ := by
          apply Finset.sum_congr rfl
          intro b hb
          congr 1
          ext q
          by_cases heq : label q = b <;> simp [S, U, heq, hb]
    exact_mod_cast hc
  rw [← hcard]
  have hV : 0 ≤ V := by dsimp [V]; positivity
  calc
    _ ≤ ∑ d ∈ M, ((E d).card : ℝ) := by
      exact_mod_cast (Finset.card_le_card hcover).trans Finset.card_biUnion_le
    _ ≤ ∑ _d ∈ M, V := Finset.sum_le_sum hE
    _ = (M.card : ℝ) * V := by simp
    _ ≤ 17 * V := mul_le_mul_of_nonneg_right
      (Nat.cast_le.mpr (minorantMonomialCuts_card_le x j)) hV
    _ = _ := by dsimp [V]; ring

theorem compact_prime_geometric_bin_eq_closed_interval
    (x h : ℝ) (hx : 0 < x) (hh : 0 < h) (k : ℕ) :
    let P : Finset ℕ :=
      (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((6 : ℝ) / 25)⌋₊).filter Nat.Prime
    let L : ℝ := max (x ^ ((9519 : ℝ) / 50000)) ((1 + h) ^ k)
    let U : ℝ := min (x ^ ((6 : ℝ) / 25))
      ((⌈(1 + h) ^ (k + 1)⌉₊ - 1 : ℕ) : ℝ)
    P.filter (fun n : ℕ => ⌊Real.logb (1 + h) (n : ℝ)⌋₊ = k) =
      (Finset.Icc ⌈L⌉₊ ⌊U⌋₊).filter Nat.Prime := by
  classical
  intro P L U
  have hpow : 0 ≤ x ^ ((6 : ℝ) / 25) := (Real.rpow_pos_of_pos hx _).le
  have hU : 0 ≤ U := le_min hpow (Nat.cast_nonneg _)
  ext n
  by_cases hp : n.Prime
  · simp only [P, Finset.mem_filter, Finset.mem_Icc, hp, and_true,
      geometric_bin_integer_interval h hh n k hp.one_lt.le,
      Nat.ceil_le, Nat.le_floor_iff hpow, Nat.le_floor_iff hU]
    dsimp [L, U]
    rw [max_le_iff, le_min_iff, Nat.cast_le]
    tauto
  · simp [P, hp]

theorem compact_prime_geometric_active_scales
    (x h : ℝ) (hx : 2 ≤ x) (hh : 0 < h) (hh1 : h ≤ 1)
    (b p : Fin 5 → ℕ) :
    let P : Finset ℕ :=
      (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((6 : ℝ) / 25)⌋₊).filter Nat.Prime
    let L (i : Fin 5) : ℝ := max (x ^ ((9519 : ℝ) / 50000)) ((1 + h) ^ b i)
    let U (i : Fin 5) : ℝ := min (x ^ ((6 : ℝ) / 25))
      ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ)
    (∀ i, p i ∈ P) →
    (∀ i, ⌊Real.logb (1 + h) (p i : ℝ)⌋₊ = b i) →
    (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ →
    (∀ i, x ^ ((1 : ℝ) / 10) ≤ L i ∧ L i ≤ U i ∧ U i ≤ 2 * L i) ∧
      x / 32 ≤ ∏ i, L i ∧ (∏ i, L i) ≤ 2 * x := by
  classical
  intro P L U hp hlabel hprod
  have hx1 : 1 ≤ x := (by norm_num : (1 : ℝ) ≤ 2).trans hx
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hbase : 0 < 1 + h := by linarith
  have hL (i : Fin 5) : 0 ≤ L i :=
    (Real.rpow_pos_of_pos hx0 _).le.trans (le_max_left _ _)
  have hpLU (i : Fin 5) : L i ≤ (p i : ℝ) ∧ (p i : ℝ) ≤ U i := by
    have hm : p i ∈ P.filter (fun n : ℕ => ⌊Real.logb (1 + h) (n : ℝ)⌋₊ = b i) :=
      Finset.mem_filter.mpr ⟨hp i, hlabel i⟩
    rw [compact_prime_geometric_bin_eq_closed_interval x h hx0 hh (b i)] at hm
    have hm' := Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1
    exact ⟨Nat.le_of_ceil_le hm'.1,
      (Nat.cast_le.mpr hm'.2).trans (Nat.floor_le (by positivity))⟩
  have hU (i : Fin 5) : U i ≤ 2 * L i := by
    have hceil : 0 < ⌈(1 + h) ^ (b i + 1)⌉₊ :=
      Nat.ceil_pos.mpr (pow_pos hbase _)
    have htop : ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ) <
        (1 + h) ^ (b i + 1) := Nat.lt_ceil.mp (by omega)
    calc
      U i ≤ ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ) := min_le_right _ _
      _ ≤ (1 + h) ^ (b i + 1) := htop.le
      _ = (1 + h) * (1 + h) ^ b i := by rw [pow_succ]; ring
      _ ≤ 2 * L i := mul_le_mul (by linarith) (le_max_right _ _)
        (pow_nonneg hbase.le _) (by norm_num)
  have hproduct : x ≤ ∏ i, (p i : ℝ) ∧ (∏ i, (p i : ℝ)) ≤ 2 * x := by
    have hmem := Finset.mem_Icc.mp hprod
    constructor
    · exact_mod_cast Nat.le_of_ceil_le hmem.1
    · exact_mod_cast (Nat.cast_le.mpr hmem.2).trans (Nat.floor_le (by positivity))
  have hupper : (∏ i, L i) ≤ 2 * x :=
    (Finset.prod_le_prod (fun i _ => hL i) (fun i _ => (hpLU i).1)).trans hproduct.2
  have hcompare : (∏ i, (p i : ℝ)) ≤ 32 * ∏ i, L i := by
    calc
      _ ≤ ∏ i, 2 * L i := Finset.prod_le_prod (fun _ _ => Nat.cast_nonneg _)
        (fun i _ => (hpLU i).2.trans (hU i))
      _ = _ := by rw [Finset.prod_mul_distrib]; norm_num
  refine ⟨?_, ?_, hupper⟩
  · intro i
    exact ⟨(Real.rpow_le_rpow_of_exponent_le hx1 (by norm_num :
      (1 : ℝ) / 10 ≤ (9519 : ℝ) / 50000)).trans (le_max_left _ _),
      (hpLU i).1.trans (hpLU i).2, hU i⟩
  · linarith [hproduct.1, hcompare]

theorem geometric_label_ceiling_le (x h : ℝ)
    (hx : Real.exp 1 ≤ x) (hh : 0 < h) (hh1 : h ≤ 1) :
    ((⌈Real.logb (1 + h) (2 * x)⌉₊ + 1 : ℕ) : ℝ) ≤ 6 * Real.log x / h := by
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le hx
  have hx1 : 1 ≤ x := (Real.one_le_exp (by norm_num : (0 : ℝ) ≤ 1)).trans hx
  have hlogx : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hx
  have hlogx0 : 0 ≤ Real.log x := zero_le_one.trans hlogx
  have hbase : 1 < 1 + h := by linarith
  have hlogbase : h / 2 ≤ Real.log (1 + h) := by
    apply le_trans _ (Real.le_log_one_add_of_nonneg hh.le)
    apply (le_div_iff₀ (by linarith : 0 < h + 2)).mpr
    nlinarith [mul_nonneg hh.le (sub_nonneg.mpr hh1)]
  have hlog2x0 : 0 ≤ Real.log (2 * x) := Real.log_nonneg (by linarith)
  have hlog2x : Real.log (2 * x) ≤ 2 * Real.log x := by
    rw [Real.log_mul (by norm_num) hx0.ne']
    have hlog2 : Real.log 2 ≤ 1 := by
      have ht := Real.log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2)
      norm_num at ht
      exact ht
    linarith
  have hlogb : Real.logb (1 + h) (2 * x) ≤ 4 * Real.log x / h := by
    rw [Real.logb, div_le_iff₀ (Real.log_pos hbase)]
    calc
      Real.log (2 * x) ≤ 2 * Real.log x := hlog2x
      _ = (4 * Real.log x / h) * (h / 2) := by field_simp; norm_num
      _ ≤ (4 * Real.log x / h) * Real.log (1 + h) :=
        mul_le_mul_of_nonneg_left hlogbase (by positivity)
  have hlogb0 : 0 ≤ Real.logb (1 + h) (2 * x) :=
    div_nonneg hlog2x0 (Real.log_pos hbase).le
  have hceil := (Nat.ceil_lt_add_one hlogb0).le
  have hratio : 1 ≤ Real.log x / h := (le_div_iff₀ hh).mpr (by linarith)
  push_cast
  rw [mul_div_assoc] at hlogb ⊢
  linarith only [hceil, hlogb, hratio]

theorem geometric_log_mesh_spec (D x : ℝ) (hD : 0 ≤ D) (hx : Real.exp 1 ≤ x) :
    let h := (Real.log x) ^ (-D)
    0 < h ∧ h ≤ 1 ∧
      (((⌈Real.logb (1 + h) (2 * x)⌉₊ + 1 : ℕ) : ℝ) ^ 5 ≤
        (6 : ℝ) ^ 5 * (Real.log x) ^ (5 * (D + 1))) := by
  intro h
  have hlogx : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hx
  have hlogx0 : 0 < Real.log x := zero_lt_one.trans_le hlogx
  have hh : 0 < h := Real.rpow_pos_of_pos hlogx0 _
  have hh1 : h ≤ 1 :=
    Real.rpow_le_one_of_one_le_of_nonpos hlogx (neg_nonpos.mpr hD)
  refine ⟨hh, hh1, ?_⟩
  have halgebra : (6 * Real.log x / h) ^ 5 =
      (6 : ℝ) ^ 5 * (Real.log x) ^ (5 * (D + 1)) := by
    have hquot : 6 * Real.log x / h = 6 * (Real.log x) ^ (D + 1) := by
      dsimp [h]
      rw [Real.rpow_neg hlogx0.le, div_inv_eq_mul,
        Real.rpow_add hlogx0, Real.rpow_one]
      ring
    rw [hquot, mul_pow, ← Real.rpow_mul_natCast hlogx0.le (D + 1) 5]
    congr 2
    ring
  exact (pow_le_pow_left₀ (Nat.cast_nonneg _)
    (geometric_label_ceiling_le x h hx hh hh1) 5).trans_eq halgebra

theorem reciprocal_integer_comparison_band_le (ℓ : ℕ) (hℓ : 1 ≤ ℓ)
    (h : ℝ) (hh : 0 ≤ h) :
    (∑ p ∈ Finset.Icc ℓ (Nat.floor ((1 + h) * (ℓ : ℝ))), (p : ℝ)⁻¹) ≤
      h + (ℓ : ℝ)⁻¹ := by
  have hℓpos : 0 < (ℓ : ℝ) := Nat.cast_pos.mpr (by omega)
  have htop : 0 ≤ (1 + h) * (ℓ : ℝ) := by positivity
  have hle : ℓ ≤ Nat.floor ((1 + h) * (ℓ : ℝ)) :=
    Nat.le_floor (by nlinarith)
  have hcard :
      ((Finset.Icc ℓ (Nat.floor ((1 + h) * (ℓ : ℝ)))).card : ℝ) ≤
        h * (ℓ : ℝ) + 1 := by
    rw [Nat.card_Icc, Nat.cast_sub (by omega), Nat.cast_add, Nat.cast_one]
    have hfloor := Nat.floor_le htop
    nlinarith
  calc
    _ ≤ ∑ _p ∈ Finset.Icc ℓ (Nat.floor ((1 + h) * (ℓ : ℝ))), (ℓ : ℝ)⁻¹ := by
      apply Finset.sum_le_sum
      intro p hp
      simpa only [one_div] using one_div_le_one_div_of_le hℓpos
        (Nat.cast_le.mpr (Finset.mem_Icc.mp hp).1)
    _ = ((Finset.Icc ℓ (Nat.floor ((1 + h) * (ℓ : ℝ)))).card : ℝ) *
        (ℓ : ℝ)⁻¹ := by simp
    _ ≤ (h * (ℓ : ℝ) + 1) * (ℓ : ℝ)⁻¹ :=
      mul_le_mul_of_nonneg_right hcard (inv_nonneg.mpr hℓpos.le)
    _ = h * ((ℓ : ℝ) * (ℓ : ℝ)⁻¹) + (ℓ : ℝ)⁻¹ := by ring
    _ = h + (ℓ : ℝ)⁻¹ := by rw [mul_inv_cancel₀ hℓpos.ne', mul_one]

theorem reciprocal_integer_comparison_boundary_le (Z X : ℕ) (hZ : 1 ≤ Z)
    (h : ℝ) (hh : 0 ≤ h) :
    (∑ ℓ ∈ Finset.Icc (Z + 1) X, (ℓ : ℝ)⁻¹ *
      ∑ p ∈ Finset.Icc ℓ (Nat.floor ((1 + h) * (ℓ : ℝ))), (p : ℝ)⁻¹) ≤
      h * (1 + Real.log (X : ℝ)) + 1 / (Z : ℝ) := by
  have hharmonic :
      (∑ ℓ ∈ Finset.Icc (Z + 1) X, (ℓ : ℝ)⁻¹) ≤
        1 + Real.log (X : ℝ) := by
    calc
      _ ≤ ∑ ℓ ∈ Finset.Icc 1 X, (ℓ : ℝ)⁻¹ := by
        apply Finset.sum_le_sum_of_subset_of_nonneg
        · intro ℓ hℓ
          obtain ⟨hlo, hhi⟩ := Finset.mem_Icc.mp hℓ
          exact Finset.mem_Icc.mpr ⟨by omega, hhi⟩
        · intro ℓ _ _
          positivity
      _ = (harmonic X : ℝ) := by
        simp only [harmonic_eq_sum_Icc, Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast]
      _ ≤ 1 + Real.log (X : ℝ) := harmonic_le_one_add_log X
  have htail :
      (∑ ℓ ∈ Finset.Icc (Z + 1) X, (1 : ℝ) / (ℓ : ℝ) ^ 2) ≤
        1 / (Z : ℝ) := by
    simpa only [Nat.add_sub_cancel] using sum_Icc_inv_sq_le X (Z + 1) (by omega)
  calc
    _ ≤ ∑ ℓ ∈ Finset.Icc (Z + 1) X,
        (h * (ℓ : ℝ)⁻¹ + 1 / (ℓ : ℝ) ^ 2) := by
      apply Finset.sum_le_sum
      intro ℓ hℓ
      have hℓone : 1 ≤ ℓ := by
        have := (Finset.mem_Icc.mp hℓ).1
        omega
      calc
        _ ≤ (ℓ : ℝ)⁻¹ * (h + (ℓ : ℝ)⁻¹) :=
          mul_le_mul_of_nonneg_left
            (reciprocal_integer_comparison_band_le ℓ hℓone h hh)
            (inv_nonneg.mpr (Nat.cast_nonneg ℓ))
        _ = h * (ℓ : ℝ)⁻¹ + 1 / (ℓ : ℝ) ^ 2 := by
          simp [one_div, pow_two, mul_add, mul_comm]
    _ = h * (∑ ℓ ∈ Finset.Icc (Z + 1) X, (ℓ : ℝ)⁻¹) +
        ∑ ℓ ∈ Finset.Icc (Z + 1) X, (1 : ℝ) / (ℓ : ℝ) ^ 2 := by
      rw [Finset.sum_add_distrib, Finset.mul_sum]
    _ ≤ h * (1 + Real.log (X : ℝ)) + 1 / (Z : ℝ) :=
      add_le_add (mul_le_mul_of_nonneg_left hharmonic hh) htail

theorem reciprocal_prime_comparison_boundary_le (Z X : ℕ) (hZ : 1 ≤ Z)
    (h : ℝ) (hh : 0 ≤ h) :
    (∑ ℓ ∈ (Finset.Icc (Z + 1) X).filter Nat.Prime, (ℓ : ℝ)⁻¹ *
      ∑ p ∈ (Finset.Icc ℓ (Nat.floor ((1 + h) * (ℓ : ℝ)))).filter Nat.Prime,
        (p : ℝ)⁻¹) ≤
      h * (1 + Real.log (X : ℝ)) + 1 / (Z : ℝ) := by
  calc
    _ ≤ ∑ ℓ ∈ (Finset.Icc (Z + 1) X).filter Nat.Prime, (ℓ : ℝ)⁻¹ *
        ∑ p ∈ Finset.Icc ℓ (Nat.floor ((1 + h) * (ℓ : ℝ))), (p : ℝ)⁻¹ := by
      apply Finset.sum_le_sum
      intro ℓ _
      apply mul_le_mul_of_nonneg_left _ (inv_nonneg.mpr (Nat.cast_nonneg ℓ))
      apply Finset.sum_le_sum_of_subset_of_nonneg (Finset.filter_subset _ _)
      intro p _ _
      positivity
    _ ≤ ∑ ℓ ∈ Finset.Icc (Z + 1) X, (ℓ : ℝ)⁻¹ *
        ∑ p ∈ Finset.Icc ℓ (Nat.floor ((1 + h) * (ℓ : ℝ))), (p : ℝ)⁻¹ := by
      apply Finset.sum_le_sum_of_subset_of_nonneg (Finset.filter_subset _ _)
      intro ℓ _ _
      positivity
    _ ≤ h * (1 + Real.log (X : ℝ)) + 1 / (Z : ℝ) :=
      reciprocal_integer_comparison_boundary_le Z X hZ h hh

theorem prime_pair_cofactor_reciprocal_moment_le (N : ℕ)
    (w : ℕ → ℕ → ℕ → ℂ)
    (hw : ∀ m ∈ Finset.Icc 1 N, ∀ u ∈ m.primeFactors,
      ∀ v ∈ m.primeFactors, ‖w m u v‖ ≤ 1) :
    (∑ m ∈ Finset.Icc 1 N, ∑ u ∈ m.primeFactors, ∑ v ∈ m.primeFactors,
      ‖w m u v‖ / (m : ℝ)) ≤ (1 + Real.log (N : ℝ)) ^ 4 := by
  have hrow (m : ℕ) (hm : m ∈ Finset.Icc 1 N) :
      (∑ u ∈ m.primeFactors, ∑ v ∈ m.primeFactors,
        ‖w m u v‖ / (m : ℝ)) ≤
      (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 4) m : ℝ) / (m : ℝ) := by
    have hmpos : 0 < m := (Finset.mem_Icc.mp hm).1
    have hcard : m.primeFactors.card ≤ m.divisors.card := by
      rw [Nat.primeFactors_eq_to_filter_divisors_prime]
      exact Finset.card_filter_le _ _
    have hzeta : m.primeFactors.card ^ 2 ≤
        ((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 4) m := by
      apply (Nat.pow_le_pow_left hcard 2).trans
      simpa using card_divisors_pow_le_zeta_pow 2 m hmpos
    calc
      _ ≤ ∑ _u ∈ m.primeFactors, ∑ _v ∈ m.primeFactors, (1 : ℝ) / (m : ℝ) := by
        apply Finset.sum_le_sum
        intro u hu
        apply Finset.sum_le_sum
        intro v hv
        exact div_le_div_of_nonneg_right (hw m hm u hu v hv) (Nat.cast_nonneg m)
      _ = (m.primeFactors.card : ℝ) ^ 2 / (m : ℝ) := by
        simp only [Finset.sum_const, nsmul_eq_mul]
        ring
      _ ≤ _ := div_le_div_of_nonneg_right (by exact_mod_cast hzeta) (Nat.cast_nonneg m)
  have hH : 0 ≤ (harmonic N : ℝ) := by
    simp only [harmonic_eq_sum_Icc, Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast]
    exact Finset.sum_nonneg fun m _ => inv_nonneg.mpr (Nat.cast_nonneg m)
  calc
    _ ≤ ∑ m ∈ Finset.Icc 1 N,
        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 4) m : ℝ) / (m : ℝ) :=
      Finset.sum_le_sum hrow
    _ ≤ (harmonic N : ℝ) ^ 4 :=
      sum_zeta_pow_div_le_harmonic_pow 4 N
    _ ≤ (1 + Real.log (N : ℝ)) ^ 4 :=
      pow_le_pow_left₀ hH (harmonic_le_one_add_log N) 4

open Classical in
theorem moebius_prime_pair_cofactor_reciprocal_moment_le (N : ℕ)
    (P : ℕ → ℕ → ℕ → Prop) :
    (∑ m ∈ Finset.Icc 1 N, ∑ u ∈ m.primeFactors, ∑ v ∈ m.primeFactors,
      ‖if P m u v then (ArithmeticFunction.moebius (m / (u * v)) : ℂ) else 0‖ /
        (m : ℝ)) ≤ (1 + Real.log (N : ℝ)) ^ 4 := by
  apply prime_pair_cofactor_reciprocal_moment_le
  intro m _ u _ v _
  split_ifs
  · exact_mod_cast (ArithmeticFunction.abs_moebius_le_one (n := m / (u * v)))
  · norm_num

theorem largest_prime_no_large_square_cofactor_iff
    (m p Y : ℕ) (hp : Nat.Prime p)
    (hmax : ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p) :
    (¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ m * p) ↔
      ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ m := by
  constructor
  · intro h hbad
    obtain ⟨r, hr, hYr, hrm⟩ := hbad
    exact h ⟨r, hr, hYr, dvd_mul_of_dvd_left hrm p⟩
  · intro h hbad
    obtain ⟨r, hr, hYr, hrmp⟩ := hbad
    by_cases hrp : r = p
    · subst r
      have hpm : p ∣ m := (Nat.mul_dvd_mul_iff_right hp.pos).mp
        (by simpa only [pow_two] using hrmp)
      exact (lt_irrefl p) (hmax p hp hpm)
    · have hrnp : ¬ r ∣ p := fun hdiv =>
        hrp ((Nat.prime_dvd_prime_iff_eq hr hp).mp hdiv)
      have hcop : Nat.Coprime (r ^ 2) p := (hr.coprime_iff_not_dvd.mpr hrnp).pow_left 2
      exact h ⟨r, hr, hYr, hcop.dvd_of_dvd_mul_right hrmp⟩

open Classical in
theorem good_integer_largest_prime_finsupp_reindex
    (N Y : ℕ) (f : ℕ → ℂ) :
    (∑ n ∈ (Finset.Icc 1 N).filter (fun n =>
        n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
          ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ n),
      Finsupp.single n (f n)) =
    ∑ m ∈ (Finset.Icc 1 N).filter (fun m =>
        ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ m),
      ∑ p ∈ (Finset.Icc (Y + 1) (N / m)).filter (fun p =>
          Nat.Prime p ∧ ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p),
        Finsupp.single (m * p) (f (m * p)) := by
  let G : Finset ℕ := (Finset.Icc 1 N).filter (fun n =>
    n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
      ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ n)
  let M : Finset ℕ := (Finset.Icc 1 N).filter (fun m =>
    ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ m)
  let P : ℕ → Finset ℕ := fun m =>
    (Finset.Icc (Y + 1) (N / m)).filter (fun p =>
      Nat.Prime p ∧ ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p)
  have hdata (z : Σ _ : ℕ, ℕ) (hz : z ∈ M.sigma P) :
      0 < z.1 ∧ Nat.Prime z.2 ∧ Y < z.2 ∧ z.1 * z.2 ≤ N ∧
        (∀ t : ℕ, Nat.Prime t → t ∣ z.1 → t < z.2) ∧
        ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ z.1 := by
    simp only [M, P, Finset.mem_sigma, Finset.mem_filter, Finset.mem_Icc] at hz
    obtain ⟨⟨⟨hm1, hmN⟩, hmSq⟩, ⟨⟨hYp, hpN⟩, hp, hmax⟩⟩ := hz
    have hm0 : 0 < z.1 := by omega
    have hprod : z.1 * z.2 ≤ N := by
      simpa only [Nat.mul_comm] using (Nat.le_div_iff_mul_le hm0).mp hpN
    exact ⟨hm0, hp, by omega, hprod, hmax, hmSq⟩
  have hgood (z : Σ _ : ℕ, ℕ) (hz : z ∈ M.sigma P) : z.1 * z.2 ∈ G := by
    obtain ⟨hm, hp, hYp, hprod, hmax, hmSq⟩ := hdata z hz
    have hnot : z.1 * z.2 ∉ Nat.factoredNumbers (Nat.primesLE Y) := by
      intro hsmooth
      have hpY : z.2 ∈ Nat.primesLE Y :=
        (Nat.mem_factoredNumbers'.mp hsmooth) z.2 hp
          (dvd_mul_of_dvd_right (dvd_refl z.2) z.1)
      exact (not_le_of_gt hYp) (Nat.mem_primesLE.mp hpY).1
    exact Finset.mem_filter.mpr
      ⟨Finset.mem_Icc.mpr ⟨Nat.succ_le_of_lt (Nat.mul_pos hm hp.pos), hprod⟩,
        hnot, (largest_prime_no_large_square_cofactor_iff z.1 z.2 Y hp hmax).mpr hmSq⟩
  change (∑ n ∈ G, Finsupp.single n (f n)) =
    ∑ m ∈ M, ∑ p ∈ P m, Finsupp.single (m * p) (f (m * p))
  calc
    _ = ∑ z ∈ M.sigma P, Finsupp.single (z.1 * z.2) (f (z.1 * z.2)) := by
      symm
      refine Finset.sum_bij (fun (z : Σ _ : ℕ, ℕ) _ => z.1 * z.2)
        hgood ?_ ?_ (fun _ _ => rfl)
      · intro z hz w hw heq
        obtain ⟨hmz, hpz, hYz, hNz, hmaxz, hSqz⟩ := hdata z hz
        obtain ⟨hmw, hpw, hYw, hNw, hmaxw, hSqw⟩ := hdata w hw
        have hg := hgood z hz
        simp only [G, Finset.mem_filter, Finset.mem_Icc] at hg
        obtain ⟨⟨hn1, hnN⟩, hnot, hnosq⟩ := hg
        obtain ⟨t, ht, huniq⟩ :=
          existsUnique_largest_prime_factorization
            (z.1 * z.2) Y (by omega) hnot hnosq
        have hzspec :
            Nat.Prime z.2 ∧ Y < z.2 ∧ 0 < z.1 ∧ z.2 * z.1 = z.1 * z.2 ∧
              ∀ r : ℕ, Nat.Prime r → r ∣ z.1 → r < z.2 :=
          ⟨hpz, hYz, hmz, Nat.mul_comm _ _, hmaxz⟩
        have hwspec :
            Nat.Prime w.2 ∧ Y < w.2 ∧ 0 < w.1 ∧ w.2 * w.1 = z.1 * z.2 ∧
              ∀ r : ℕ, Nat.Prime r → r ∣ w.1 → r < w.2 := by
          refine ⟨hpw, hYw, hmw, ?_, hmaxw⟩
          exact (Nat.mul_comm _ _).trans heq.symm
        have hpair : (z.2, z.1) = (w.2, w.1) :=
          (huniq (z.2, z.1) hzspec).trans (huniq (w.2, w.1) hwspec).symm
        exact Sigma.ext (congrArg Prod.snd hpair) (heq_of_eq (congrArg Prod.fst hpair))
      · intro n hn
        simp only [G, Finset.mem_filter, Finset.mem_Icc] at hn
        obtain ⟨⟨hn1, hnN⟩, hnot, hnosq⟩ := hn
        obtain ⟨⟨p, m⟩, ⟨hp, hYp, hm, hpm, hmax⟩, huniq⟩ :=
          existsUnique_largest_prime_factorization
            n Y (by omega) hnot hnosq
        have hpmN : p * m ≤ N := by simpa only [hpm] using hnN
        have hmN : m ≤ N := (Nat.le_mul_of_pos_left m hp.pos).trans hpmN
        have hpN : p ≤ N / m := (Nat.le_div_iff_mul_le hm).mpr hpmN
        have hmSq : ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ m := by
          rintro ⟨r, hr, hYr, hrm⟩
          apply hnosq
          refine ⟨r, hr, hYr, ?_⟩
          rw [← hpm]
          exact dvd_mul_of_dvd_right hrm p
        refine ⟨⟨m, p⟩, ?_, (Nat.mul_comm m p).trans hpm⟩
        apply Finset.mem_sigma.mpr
        constructor
        · exact Finset.mem_filter.mpr
            ⟨Finset.mem_Icc.mpr ⟨Nat.succ_le_of_lt hm, hmN⟩, hmSq⟩
        · exact Finset.mem_filter.mpr
            ⟨Finset.mem_Icc.mpr ⟨Nat.succ_le_of_lt hYp, hpN⟩, hp, hmax⟩
    _ = _ := Finset.sum_sigma M P _

open Classical in
theorem theta6_a0_norm_le_divisor_cube
    (n : ℕ) (z H S M0 : ℝ) :
    ‖if 1 < z ∧ (n : ℝ) ≤ M0 then
      ∑ p2 ∈ n.primeFactors, ∑ p3 ∈ n.primeFactors, ∑ p4 ∈ n.primeFactors,
        if p2 * p3 * p4 ∣ n ∧
            z ≤ (p3 : ℝ) ∧ p3 < p2 ∧ (p2 : ℝ) < H ∧
            p3 ≤ p4 ∧ ((p3 * p4 : ℕ) : ℝ) < H ∧
            (p2 : ℝ) < S ∧ n / (p2 * p3 * p4) ∈ Nat.smoothNumbers (Nat.ceil z)
        then (ArithmeticFunction.moebius (n / (p2 * p3 * p4)) : ℂ)
        else 0
      else 0‖ ≤ (n.divisors.card : ℝ) ^ 3 := by
  by_cases houter : 1 < z ∧ (n : ℝ) ≤ M0
  · rw [ite_eq_left houter]
    calc
      _ ≤ ∑ _p2 ∈ n.primeFactors, ∑ _p3 ∈ n.primeFactors,
          ∑ _p4 ∈ n.primeFactors, (1 : ℝ) := by
        apply norm_sum_le_of_le
        intro p2 _hp2
        apply norm_sum_le_of_le
        intro p3 _hp3
        apply norm_sum_le_of_le
        intro p4 _hp4
        split_ifs
        · exact_mod_cast
            (ArithmeticFunction.abs_moebius_le_one (n := n / (p2 * p3 * p4)))
        · norm_num
      _ = (n.primeFactors.card : ℝ) ^ 3 := by
        simp only [Finset.sum_const, nsmul_eq_mul]
        ring
      _ ≤ (n.divisors.card : ℝ) ^ 3 := by
        apply pow_le_pow_left₀ (Nat.cast_nonneg _)
        exact_mod_cast (show n.primeFactors.card ≤ n.divisors.card by
          rw [Nat.primeFactors_eq_to_filter_divisors_prime]
          exact Finset.card_filter_le _ _)
  · rw [ite_eq_right houter, norm_zero]
    positivity

open Classical in
theorem theta6_a0_good_part_prime_windows
    (N Y r0 : ℕ) (z H S M0 lo hi : ℝ) (hH : 0 < H) (hS : 0 < S) :
    let A0 : ℕ → ℤ := fun n =>
      if 1 < z ∧ (n : ℝ) ≤ M0 then
        ∑ p2 ∈ n.primeFactors, ∑ p3 ∈ n.primeFactors, ∑ p4 ∈ n.primeFactors,
          if p2 * p3 * p4 ∣ n ∧ z ≤ (p3 : ℝ) ∧ p3 < p2 ∧ (p2 : ℝ) < H ∧
              p3 ≤ p4 ∧ ((p3 * p4 : ℕ) : ℝ) < H ∧ (p2 : ℝ) < S ∧
              n / (p2 * p3 * p4) ∈ Nat.smoothNumbers (Nat.ceil z)
          then ArithmeticFunction.moebius (n / (p2 * p3 * p4)) else 0
      else 0
    let C1 : ℕ → ℕ → ℕ → ℤ := fun m u v =>
      if 1 < z ∧ u * v ∣ m ∧ z ≤ (u : ℝ) ∧ u ≤ v ∧
          ((u * v : ℕ) : ℝ) < H ∧ m / (u * v) ∈ Nat.smoothNumbers (Nat.ceil z)
      then ArithmeticFunction.moebius (m / (u * v)) else 0
    let C2 : ℕ → ℕ → ℕ → ℤ := fun m u v =>
      if 1 < z ∧ u * v ∣ m ∧ z ≤ (v : ℝ) ∧ v < u ∧
          (u : ℝ) < H ∧ (u : ℝ) < S ∧
          m / (u * v) ∈ Nat.smoothNumbers (Nat.ceil z)
      then ArithmeticFunction.moebius (m / (u * v)) else 0
    let W1 : ℕ → ℕ → Finset ℕ := fun m u =>
      Finset.Icc
        (max (Y + 1)
          (max (m.primeFactors.sup id + 1) (max (Nat.ceil (lo / (m : ℝ))) (u + 1))))
        (min (N / m) (min (Nat.floor (min hi M0 / (m : ℝ)))
          (min (Nat.ceil H - 1) (Nat.ceil S - 1))))
    let W2 : ℕ → ℕ → Finset ℕ := fun m v =>
      Finset.Icc
        (max (Y + 1)
          (max (m.primeFactors.sup id + 1) (max (Nat.ceil (lo / (m : ℝ))) v)))
        (min (N / m) (min (Nat.floor (min hi M0 / (m : ℝ)))
          (Nat.ceil (H / (v : ℝ)) - 1)))
    (∑ n ∈ (Finset.Icc 1 N).filter (fun n =>
        n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
          ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ n),
      Finsupp.single n (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n r0
        then (A0 n : ℂ) else 0)) =
    ∑ m ∈ (Finset.Icc 1 N).filter (fun m =>
        ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ m),
      ∑ u ∈ m.primeFactors, ∑ v ∈ m.primeFactors,
        ((∑ p ∈ (W1 m u).filter Nat.Prime,
          Finsupp.single (m * p)
            (if Nat.Coprime (m * p) r0 then (C1 m u v : ℂ) else 0)) +
        (∑ p ∈ (W2 m v).filter Nat.Prime,
          Finsupp.single (m * p)
            (if Nat.Coprime (m * p) r0 then (C2 m u v : ℂ) else 0))) := by
  dsimp only
  let A0 : ℕ → ℤ := fun n =>
    if 1 < z ∧ (n : ℝ) ≤ M0 then
      ∑ p2 ∈ n.primeFactors, ∑ p3 ∈ n.primeFactors, ∑ p4 ∈ n.primeFactors,
        if p2 * p3 * p4 ∣ n ∧ z ≤ (p3 : ℝ) ∧ p3 < p2 ∧ (p2 : ℝ) < H ∧
            p3 ≤ p4 ∧ ((p3 * p4 : ℕ) : ℝ) < H ∧ (p2 : ℝ) < S ∧
            n / (p2 * p3 * p4) ∈ Nat.smoothNumbers (Nat.ceil z)
        then ArithmeticFunction.moebius (n / (p2 * p3 * p4)) else 0
    else 0
  let C1 : ℕ → ℕ → ℕ → ℤ := fun m u v =>
    if 1 < z ∧ u * v ∣ m ∧ z ≤ (u : ℝ) ∧ u ≤ v ∧
        ((u * v : ℕ) : ℝ) < H ∧ m / (u * v) ∈ Nat.smoothNumbers (Nat.ceil z)
    then ArithmeticFunction.moebius (m / (u * v)) else 0
  let C2 : ℕ → ℕ → ℕ → ℤ := fun m u v =>
    if 1 < z ∧ u * v ∣ m ∧ z ≤ (v : ℝ) ∧ v < u ∧
        (u : ℝ) < H ∧ (u : ℝ) < S ∧
        m / (u * v) ∈ Nat.smoothNumbers (Nat.ceil z)
    then ArithmeticFunction.moebius (m / (u * v)) else 0
  let W1 : ℕ → ℕ → Finset ℕ := fun m u =>
    Finset.Icc
      (max (Y + 1)
        (max (m.primeFactors.sup id + 1) (max (Nat.ceil (lo / (m : ℝ))) (u + 1))))
      (min (N / m) (min (Nat.floor (min hi M0 / (m : ℝ)))
        (min (Nat.ceil H - 1) (Nat.ceil S - 1))))
  let W2 : ℕ → ℕ → Finset ℕ := fun m v =>
    Finset.Icc
      (max (Y + 1)
        (max (m.primeFactors.sup id + 1) (max (Nat.ceil (lo / (m : ℝ))) v)))
      (min (N / m) (min (Nat.floor (min hi M0 / (m : ℝ)))
        (Nat.ceil (H / (v : ℝ)) - 1)))
  change (∑ n ∈ (Finset.Icc 1 N).filter (fun n =>
        n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
          ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ n),
      Finsupp.single n (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n r0
        then (A0 n : ℂ) else 0)) =
    ∑ m ∈ (Finset.Icc 1 N).filter (fun m =>
        ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ m),
      ∑ u ∈ m.primeFactors, ∑ v ∈ m.primeFactors,
      ((∑ p ∈ (W1 m u).filter Nat.Prime,
          Finsupp.single (m * p)
            (if Nat.Coprime (m * p) r0 then (C1 m u v : ℂ) else 0)) +
        (∑ p ∈ (W2 m v).filter Nat.Prime,
          Finsupp.single (m * p)
          (if Nat.Coprime (m * p) r0 then (C2 m u v : ℂ) else 0)))
  rw [good_integer_largest_prime_finsupp_reindex]
  apply Finset.sum_congr rfl
  intro m hm
  have hm0 : 0 < m := by
    have h := (Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1).1
    omega
  let T : Finset ℕ := (Finset.Icc (Y + 1) (N / m)).filter (fun p =>
    Nat.Prime p ∧ ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p)
  let V1 : ℕ → Finset ℕ := fun u =>
    Finset.Icc
      (max (m.primeFactors.sup id + 1) (max (Nat.ceil (lo / (m : ℝ))) (u + 1)))
      (min (Nat.floor (min hi M0 / (m : ℝ)))
        (min (Nat.ceil H - 1) (Nat.ceil S - 1)))
  let V2 : ℕ → Finset ℕ := fun v =>
    Finset.Icc
      (max (m.primeFactors.sup id + 1) (max (Nat.ceil (lo / (m : ℝ))) v))
      (min (Nat.floor (min hi M0 / (m : ℝ))) (Nat.ceil (H / (v : ℝ)) - 1))
  let R1 : ℕ → ℕ → ℕ → ℤ := fun u v p =>
    if u * v ∣ m ∧ z ≤ (u : ℝ) ∧ u < p ∧ (p : ℝ) < H ∧
        u ≤ v ∧ ((u * v : ℕ) : ℝ) < H ∧ (p : ℝ) < S ∧
        m / (u * v) ∈ Nat.smoothNumbers (Nat.ceil z)
    then ArithmeticFunction.moebius (m / (u * v)) else 0
  let R2 : ℕ → ℕ → ℕ → ℤ := fun u v p =>
    if u * v ∣ m ∧ z ≤ (v : ℝ) ∧ v < u ∧ (u : ℝ) < H ∧
        v ≤ p ∧ ((v * p : ℕ) : ℝ) < H ∧ (u : ℝ) < S ∧
        m / (u * v) ∈ Nat.smoothNumbers (Nat.ceil z)
    then ArithmeticFunction.moebius (m / (u * v)) else 0
  let F1 : ℕ → ℕ → ℕ → ℕ →₀ ℂ := fun u v p =>
    Finsupp.single (m * p) (if Nat.Coprime (m * p) r0 then
      (if p ∈ V1 u then (C1 m u v : ℂ) else 0) else 0)
  let F2 : ℕ → ℕ → ℕ → ℕ →₀ ℂ := fun u v p =>
    Finsupp.single (m * p) (if Nat.Coprime (m * p) r0 then
      (if p ∈ V2 v then (C2 m u v : ℂ) else 0) else 0)
  have hpoint (p : ℕ) (hpT : p ∈ T) :
      Finsupp.single (m * p)
        (if lo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ hi ∧
            Nat.Coprime (m * p) r0 then (A0 (m * p) : ℂ) else 0) =
      ∑ u ∈ m.primeFactors, ∑ v ∈ m.primeFactors, (F1 u v p + F2 u v p) := by
    obtain ⟨hp, hmax⟩ := (Finset.mem_filter.mp hpT).2
    have hsource :
        A0 (m * p) =
          if 1 < z ∧ ((m * p : ℕ) : ℝ) ≤ M0 then
            (∑ u ∈ m.primeFactors, ∑ v ∈ m.primeFactors, R1 u v p) +
            (∑ u ∈ m.primeFactors, ∑ v ∈ m.primeFactors, R2 u v p)
          else 0 := by
      simpa only [A0, R1, R2, Nat.mul_comm m p] using
        theta6_a0_largest_prime_split p m hp hm0 hmax z H S M0
    have hi1 (u v : ℕ) :
        (if lo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ hi then
          if 1 < z ∧ ((m * p : ℕ) : ℝ) ≤ M0 then R1 u v p else 0
        else 0) = if p ∈ V1 u then C1 m u v else 0 := by
      simpa only [R1, C1, V1, eq_true hmax, true_and, Nat.mul_comm m p,
        ← ite_and, and_assoc, and_left_comm, and_comm] using
        theta6_a0_first_prime_window_indicator p m u v hp hm0 z H S M0 lo hi hH hS
    have hi2 (u v : ℕ) (hv : v ∈ m.primeFactors) :
        (if lo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ hi then
          if 1 < z ∧ ((m * p : ℕ) : ℝ) ≤ M0 then R2 u v p else 0
        else 0) = if p ∈ V2 v then C2 m u v else 0 := by
      simpa only [R2, C2, V2, eq_true hmax, true_and, Nat.mul_comm m p,
        ← ite_and, and_assoc, and_left_comm, and_comm] using
        theta6_a0_second_prime_window_indicator p m u v hp hm0
          (Nat.prime_of_mem_primeFactors hv).pos z H S M0 lo hi hH
    have hscalar :
        (if lo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ hi
          then A0 (m * p) else 0) =
        ∑ u ∈ m.primeFactors, ∑ v ∈ m.primeFactors,
          ((if p ∈ V1 u then C1 m u v else 0) +
            (if p ∈ V2 v then C2 m u v else 0)) := by
      calc
        _ = ∑ u ∈ m.primeFactors, ∑ v ∈ m.primeFactors,
            ((if lo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ hi then
              if 1 < z ∧ ((m * p : ℕ) : ℝ) ≤ M0 then R1 u v p else 0 else 0) +
             (if lo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ hi then
              if 1 < z ∧ ((m * p : ℕ) : ℝ) ≤ M0 then R2 u v p else 0 else 0)) := by
          rw [hsource]
          by_cases hlocal : lo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ hi
          · by_cases houter : 1 < z ∧ ((m * p : ℕ) : ℝ) ≤ M0
            · simp only [eq_true hlocal, eq_true houter, ite_true,
                Finset.sum_add_distrib]
            · simp only [eq_true hlocal, eq_false houter, ite_true, ite_false,
                zero_add, Finset.sum_const_zero]
          · simp only [eq_false hlocal, ite_false, zero_add, Finset.sum_const_zero]
        _ = _ := by
          apply Finset.sum_congr rfl
          intro u hu
          apply Finset.sum_congr rfl
          intro v hv
          rw [hi1 u v, hi2 u v hv]
    by_cases hcop : Nat.Coprime (m * p) r0
    · have hcast := congrArg (fun a : ℤ => (a : ℂ)) hscalar
      simp only [Int.cast_sum, Int.cast_add, apply_ite (fun a : ℤ => (a : ℂ)),
        Int.cast_zero] at hcast
      have h := congrArg (Finsupp.single (m * p)) hcast
      simp only [Finsupp.single_finsetSum, Finsupp.single_add] at h
      simpa only [F1, F2, eq_true hcop, and_true, ite_true] using h
    · simp [F1, F2, hcop]
  have hclip (a b : ℕ)
      (hwin : ∀ p : ℕ, Nat.Prime p → p ∈ Finset.Icc a b →
        ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p) :
      T.filter (fun p => p ∈ Finset.Icc a b) =
        (Finset.Icc (max (Y + 1) a) (min (N / m) b)).filter Nat.Prime := by
    ext p
    simp only [T, Finset.mem_filter, Finset.mem_Icc, max_le_iff, le_min_iff]
    constructor
    · rintro ⟨⟨hbase, hp, hmax⟩, hab⟩
      exact ⟨⟨⟨hbase.1, hab.1⟩, ⟨hbase.2, hab.2⟩⟩, hp⟩
    · rintro ⟨⟨⟨hY, ha⟩, ⟨hN, hb⟩⟩, hp⟩
      exact ⟨⟨⟨hY, hN⟩, hp, hwin p hp (Finset.mem_Icc.mpr ⟨ha, hb⟩)⟩, ha, hb⟩
  have hW1 (u : ℕ) :
      T.filter (fun p => p ∈ V1 u) = (W1 m u).filter Nat.Prime := by
    apply hclip
    intro p hp hmem
    exact ((theta6_a0_first_prime_window_iff p m u hp hm0 H S M0 lo hi hH hS).mpr
      hmem).1
  have hW2 (v : ℕ) (hv : v ∈ m.primeFactors) :
      T.filter (fun p => p ∈ V2 v) = (W2 m v).filter Nat.Prime := by
    apply hclip
    intro p hp hmem
    exact ((theta6_a0_second_prime_window_iff p m v hp hm0
      (Nat.prime_of_mem_primeFactors hv).pos H M0 lo hi hH).mpr hmem).1
  have hrestrict (V W : Finset ℕ) (hVW : T.filter (fun p => p ∈ V) = W) (c : ℤ) :
      (∑ p ∈ T, Finsupp.single (m * p)
        (if Nat.Coprime (m * p) r0 then
          (if p ∈ V then (c : ℂ) else 0) else 0)) =
      ∑ p ∈ W, Finsupp.single (m * p)
        (if Nat.Coprime (m * p) r0 then (c : ℂ) else 0) := by
    rw [← hVW]
    conv_rhs => rw [Finset.sum_filter]
    apply Finset.sum_congr rfl
    intro p hp
    by_cases hmem : p ∈ V <;>
      by_cases hcop : Nat.Coprime (m * p) r0 <;> simp [hmem, hcop]
  have hsum1 (u v : ℕ) :
      (∑ p ∈ T, F1 u v p) =
        ∑ p ∈ (W1 m u).filter Nat.Prime, Finsupp.single (m * p)
          (if Nat.Coprime (m * p) r0 then (C1 m u v : ℂ) else 0) :=
    hrestrict (V1 u) ((W1 m u).filter Nat.Prime) (hW1 u) (C1 m u v)
  have hsum2 (u v : ℕ) (hv : v ∈ m.primeFactors) :
      (∑ p ∈ T, F2 u v p) =
        ∑ p ∈ (W2 m v).filter Nat.Prime, Finsupp.single (m * p)
          (if Nat.Coprime (m * p) r0 then (C2 m u v : ℂ) else 0) :=
    hrestrict (V2 v) ((W2 m v).filter Nat.Prime) (hW2 v hv) (C2 m u v)
  change (∑ p ∈ T, Finsupp.single (m * p)
    (if lo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ hi ∧
      Nat.Coprime (m * p) r0 then (A0 (m * p) : ℂ) else 0)) = _
  calc
    _ = ∑ p ∈ T, ∑ u ∈ m.primeFactors, ∑ v ∈ m.primeFactors,
        (F1 u v p + F2 u v p) := Finset.sum_congr rfl hpoint
    _ = ∑ u ∈ m.primeFactors, ∑ v ∈ m.primeFactors, ∑ p ∈ T,
        (F1 u v p + F2 u v p) := by
      rw [Finset.sum_comm]
      apply Finset.sum_congr rfl
      intro u hu
      exact Finset.sum_comm
    _ = ∑ u ∈ m.primeFactors, ∑ v ∈ m.primeFactors,
        ((∑ p ∈ T, F1 u v p) + (∑ p ∈ T, F2 u v p)) := by
      simp only [Finset.sum_add_distrib]
    _ = _ := by
      apply Finset.sum_congr rfl
      intro u hu
      apply Finset.sum_congr rfl
      intro v hv
      rw [hsum1 u v, hsum2 u v hv]

theorem cofactor_clipped_prime_window_eq_empty
    (N Y m a b : ℕ) (hm : N / (Y + 1) < m) :
    Finset.Icc (max (Y + 1) a) (min (N / m) b) = ∅ := by
  have hm0 : 0 < m := (Nat.zero_le (N / (Y + 1))).trans_lt hm
  have hprod : N < m * (Y + 1) :=
    (Nat.div_lt_iff_lt_mul (Nat.succ_pos Y)).mp hm
  have hsmall : N / m < Y + 1 :=
    (Nat.div_lt_iff_lt_mul hm0).mpr (by simpa only [Nat.mul_comm] using hprod)
  exact Finset.Icc_eq_empty_of_lt
    ((min_le_left _ _).trans_lt (hsmall.trans_le (le_max_left _ _)))

open Classical in
theorem good_integer_largest_prime_finsupp_reindex_truncated
    (N Y : ℕ) (f : ℕ → ℂ) :
    (∑ n ∈ (Finset.Icc 1 N).filter (fun n =>
        n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
          ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ n),
      Finsupp.single n (f n)) =
    ∑ m ∈ (Finset.Icc 1 (N / (Y + 1))).filter (fun m =>
        ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ m),
      ∑ p ∈ (Finset.Icc (Y + 1) (N / m)).filter (fun p =>
          Nat.Prime p ∧ ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p),
        Finsupp.single (m * p) (f (m * p)) := by
  rw [good_integer_largest_prime_finsupp_reindex]
  symm
  apply Finset.sum_subset
  · intro m hm
    obtain ⟨hmI, hmSq⟩ := Finset.mem_filter.mp hm
    obtain ⟨hm1, hmN⟩ := Finset.mem_Icc.mp hmI
    exact Finset.mem_filter.mpr
      ⟨Finset.mem_Icc.mpr ⟨hm1, hmN.trans (Nat.div_le_self N (Y + 1))⟩, hmSq⟩
  · intro m hm hnot
    obtain ⟨hmI, hmSq⟩ := Finset.mem_filter.mp hm
    obtain ⟨hm1, hmN⟩ := Finset.mem_Icc.mp hmI
    have hlarge : N / (Y + 1) < m := by
      apply lt_of_not_ge
      intro hle
      exact hnot (Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr ⟨hm1, hle⟩, hmSq⟩)
    have hempty : Finset.Icc (Y + 1) (N / m) = ∅ := by
      simpa only [max_eq_left (Nat.zero_le _), min_self] using
        cofactor_clipped_prime_window_eq_empty N Y m 0 (N / m) hlarge
    simp only [hempty, Finset.filter_empty, Finset.sum_empty]

theorem cofactor_prime_scale_above_real_cutoff
    (N m : ℕ) (Y : ℝ) (hm : 0 < m)
    (hcap : m ≤ N / (Nat.floor Y + 1)) :
    Y < ((N / m : ℕ) : ℝ) := by
  have hprod : m * (Nat.floor Y + 1) ≤ N :=
    (Nat.le_div_iff_mul_le (Nat.succ_pos (Nat.floor Y))).mp hcap
  have hscale : Nat.floor Y + 1 ≤ N / m :=
    (Nat.le_div_iff_mul_le hm).mpr (by simpa only [Nat.mul_comm] using hprod)
  calc
    Y < (Nat.floor Y : ℝ) + 1 := Nat.lt_floor_add_one Y
    _ = ((Nat.floor Y + 1 : ℕ) : ℝ) := by simp only [Nat.cast_add, Nat.cast_one]
    _ ≤ ((N / m : ℕ) : ℝ) := by exact_mod_cast hscale

open Classical in
theorem named_prime_pair_norm_le_divisors
    (n : ℕ) (P : ℕ → ℕ → Prop) :
    ‖∑ p ∈ n.primeFactors,
      if (n / p).Prime ∧ p * (n / p) = n ∧ P p (n / p) then (1 : ℂ) else 0‖ ≤
      (n.divisors.card : ℝ) := by
  calc
    _ ≤ ∑ _p ∈ n.primeFactors, (1 : ℝ) := by
      apply norm_sum_le_of_le
      intro p _hp
      split_ifs <;> norm_num
    _ = (n.primeFactors.card : ℝ) := by simp only [Finset.sum_const, nsmul_eq_mul, mul_one]
    _ ≤ (n.divisors.card : ℝ) := by
      exact_mod_cast (show n.primeFactors.card ≤ n.divisors.card by
        rw [Nat.primeFactors_eq_to_filter_divisors_prime]
        exact Finset.card_filter_le _ _)

open Classical in
theorem harmanA_norm_le_divisor_power
    (n k : ℕ) (u : ℕ → ℂ)
    (hu : ∀ r ∈ n.divisors, ‖u r‖ ≤ (r.divisors.card : ℝ) ^ k)
    (z H : ℝ) :
    ‖∑ rh ∈ n.divisorsAntidiagonal,
      if 1 < rh.2 ∧ ((max 1 (rh.2.primeFactors.sup id) : ℕ) : ℝ) < z ∧
          (rh.1 : ℝ) < H ∧ (((rh.1 * rh.2) / rh.2.minFac : ℕ) : ℝ) < H ∧
          H ≤ ((rh.1 * rh.2 : ℕ) : ℝ)
      then u rh.1 * (ArithmeticFunction.moebius rh.2 : ℂ) else 0‖ ≤
      (n.divisors.card : ℝ) ^ (k + 1) := by
  rw [Nat.sum_divisorsAntidiagonal (fun r h =>
    if 1 < h ∧ ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧
        (r : ℝ) < H ∧ (((r * h) / h.minFac : ℕ) : ℝ) < H ∧
        H ≤ ((r * h : ℕ) : ℝ)
    then u r * (ArithmeticFunction.moebius h : ℂ) else 0)]
  calc
    _ ≤ ∑ _r ∈ n.divisors, (n.divisors.card : ℝ) ^ k := by
      apply norm_sum_le_of_le
      intro r hr
      have hrd := (Nat.mem_divisors.mp hr).1
      have hn := (Nat.mem_divisors.mp hr).2
      have hcard : (r.divisors.card : ℝ) ≤ (n.divisors.card : ℝ) := by
        exact_mod_cast Finset.card_le_card (Nat.divisors_subset_of_dvd hn hrd)
      have hur : ‖u r‖ ≤ (n.divisors.card : ℝ) ^ k :=
        (hu r hr).trans (pow_le_pow_left₀ (Nat.cast_nonneg _) hcard k)
      split_ifs
      · rw [norm_mul]
        have hmu : ‖(ArithmeticFunction.moebius (n / r) : ℂ)‖ ≤ 1 := by
          exact_mod_cast (ArithmeticFunction.abs_moebius_le_one (n := n / r))
        exact (mul_le_mul hur hmu (norm_nonneg _) (by positivity)).trans_eq (mul_one _)
      · rw [norm_zero]
        positivity
    _ = (n.divisors.card : ℝ) ^ (k + 1) := by
      rw [Finset.sum_const, nsmul_eq_mul, pow_succ]
      ring

theorem three_divisor_sum_norm_le_divisor_sq (n : ℕ)
    (w : ℕ → ℕ → ℕ → ℂ)
    (hw : ∀ a ∈ n.divisorsAntidiagonal, ∀ b ∈ a.2.divisorsAntidiagonal,
      ‖w a.1 b.1 b.2‖ ≤ 1) :
    (∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
      ‖w a.1 b.1 b.2‖) ≤ (n.divisors.card : ℝ) ^ 2 := by
  calc
    _ ≤ ∑ _a ∈ n.divisorsAntidiagonal, (n.divisors.card : ℝ) := by
      apply Finset.sum_le_sum
      intro a ha
      have hcard : a.2.divisors.card ≤ n.divisors.card :=
        Finset.card_le_card (Nat.divisors_subset_of_dvd
          (Nat.mem_divisorsAntidiagonal.mp ha).2
          (Nat.dvd_of_mem_divisors (Nat.snd_mem_divisors_of_mem_antidiagonal ha)))
      calc
        _ ≤ ∑ _b ∈ a.2.divisorsAntidiagonal, (1 : ℝ) :=
          Finset.sum_le_sum fun b hb => hw a ha b hb
        _ = (a.2.divisors.card : ℝ) := by simp [← Nat.map_div_right_divisors]
        _ ≤ (n.divisors.card : ℝ) := by exact_mod_cast hcard
    _ = (n.divisors.card : ℝ) ^ 2 := by
      simp [← Nat.map_div_right_divisors, pow_two]

theorem norm_three_divisor_sum_le_divisor_sq (n : ℕ)
    (w : ℕ → ℕ → ℕ → ℂ)
    (hw : ∀ a ∈ n.divisorsAntidiagonal, ∀ b ∈ a.2.divisorsAntidiagonal,
      ‖w a.1 b.1 b.2‖ ≤ 1) :
    ‖∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
      w a.1 b.1 b.2‖ ≤ (n.divisors.card : ℝ) ^ 2 :=
  ((norm_sum_le _ _).trans
    (Finset.sum_le_sum fun _ _ => norm_sum_le _ _)).trans
      (three_divisor_sum_norm_le_divisor_sq n w hw)

theorem three_divisor_reciprocal_moment_le (N : ℕ)
    (w : ℕ → ℕ → ℕ → ℕ → ℂ)
    (hw : ∀ m ∈ Finset.Icc 1 N, ∀ a ∈ m.divisorsAntidiagonal,
      ∀ b ∈ a.2.divisorsAntidiagonal, ‖w m a.1 b.1 b.2‖ ≤ 1) :
    (∑ m ∈ Finset.Icc 1 N, ∑ a ∈ m.divisorsAntidiagonal,
      ∑ b ∈ a.2.divisorsAntidiagonal, ‖w m a.1 b.1 b.2‖ / (m : ℝ)) ≤
        (1 + Real.log (N : ℝ)) ^ 4 := by
  have hrow (m : ℕ) (hm : m ∈ Finset.Icc 1 N) :
      (∑ a ∈ m.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
        ‖w m a.1 b.1 b.2‖ / (m : ℝ)) ≤
      (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 4) m : ℝ) / (m : ℝ) := by
    have hzeta : m.divisors.card ^ 2 ≤
        ((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 4) m := by
      simpa using card_divisors_pow_le_zeta_pow 2 m
        (Finset.mem_Icc.mp hm).1
    simp only [← Finset.sum_div]
    apply div_le_div_of_nonneg_right _ (Nat.cast_nonneg m)
    exact (three_divisor_sum_norm_le_divisor_sq m (w m) (hw m hm)).trans
      (by exact_mod_cast hzeta)
  have hH : 0 ≤ (harmonic N : ℝ) := by
    simp only [harmonic_eq_sum_Icc, Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast]
    exact Finset.sum_nonneg fun m _ => inv_nonneg.mpr (Nat.cast_nonneg m)
  calc
    _ ≤ ∑ m ∈ Finset.Icc 1 N,
        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 4) m : ℝ) / (m : ℝ) :=
      Finset.sum_le_sum hrow
    _ ≤ (harmonic N : ℝ) ^ 4 :=
      sum_zeta_pow_div_le_harmonic_pow 4 N
    _ ≤ (1 + Real.log (N : ℝ)) ^ 4 :=
      pow_le_pow_left₀ hH (harmonic_le_one_add_log N) 4

theorem four_divisor_sum_norm_le_divisor_cube (n : ℕ)
    (w : ℕ → ℕ → ℕ → ℕ → ℂ)
    (hw : ∀ a ∈ n.divisorsAntidiagonal, ∀ b ∈ a.2.divisorsAntidiagonal,
      ∀ c ∈ b.2.divisorsAntidiagonal, ‖w a.1 b.1 c.1 c.2‖ ≤ 1) :
    (∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
      ∑ c ∈ b.2.divisorsAntidiagonal, ‖w a.1 b.1 c.1 c.2‖) ≤
        (n.divisors.card : ℝ) ^ 3 := by
  calc
    _ ≤ ∑ _a ∈ n.divisorsAntidiagonal, (n.divisors.card : ℝ) ^ 2 := by
      apply Finset.sum_le_sum
      intro a ha
      have hcard : (a.2.divisors.card : ℝ) ≤ (n.divisors.card : ℝ) := by
        exact_mod_cast Finset.card_le_card (Nat.divisors_subset_of_dvd
          (Nat.mem_divisorsAntidiagonal.mp ha).2
          (Nat.dvd_of_mem_divisors (Nat.snd_mem_divisors_of_mem_antidiagonal ha)))
      exact (three_divisor_sum_norm_le_divisor_sq a.2 (w a.1) (hw a ha)).trans
        (pow_le_pow_left₀ (Nat.cast_nonneg _) hcard 2)
    _ = (n.divisors.card : ℝ) ^ 3 := by
      simp only [Finset.sum_const, nsmul_eq_mul,
        ← Nat.map_div_right_divisors, Finset.card_map]
      ring

theorem norm_four_divisor_sum_le_divisor_cube (n : ℕ)
    (w : ℕ → ℕ → ℕ → ℕ → ℂ)
    (hw : ∀ a ∈ n.divisorsAntidiagonal, ∀ b ∈ a.2.divisorsAntidiagonal,
      ∀ c ∈ b.2.divisorsAntidiagonal, ‖w a.1 b.1 c.1 c.2‖ ≤ 1) :
    ‖∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
      ∑ c ∈ b.2.divisorsAntidiagonal, w a.1 b.1 c.1 c.2‖ ≤
        (n.divisors.card : ℝ) ^ 3 := by
  apply le_trans (norm_sum_le _ _)
  apply le_trans (Finset.sum_le_sum fun _ _ => norm_sum_le _ _)
  apply le_trans (Finset.sum_le_sum fun _ _ =>
    Finset.sum_le_sum fun _ _ => norm_sum_le _ _)
  exact four_divisor_sum_norm_le_divisor_cube n w hw

open Classical in
theorem norm_fullDiscrepancy_sample_le_two_sum_norm
    (S : Finset ℕ) (f : ℕ → ℂ) (q a : ℕ) (hq : 0 < q) :
    ‖fullDiscrepancy (∑ n ∈ S, Finsupp.single n (f n)) q a‖ ≤
      2 * ∑ n ∈ S, ‖f n‖ := by
  have hφ : 1 ≤ (q.totient : ℝ) := by
    exact_mod_cast Nat.totient_pos.mpr hq
  have hmask (P : Prop) [Decidable P] (z : ℂ) :
      ‖if P then z else 0‖ ≤ ‖z‖ := by
    split_ifs <;> simp
  rw [fullDiscrepancy_sample]
  calc
    _ ≤ ∑ n ∈ S, ‖(if n % q = a % q then f n else 0) -
        (if Nat.Coprime n q then f n else 0) / (q.totient : ℂ)‖ := norm_sum_le _ _
    _ ≤ ∑ n ∈ S, 2 * ‖f n‖ := by
      apply Finset.sum_le_sum
      intro n _hn
      calc
        _ ≤ ‖if n % q = a % q then f n else 0‖ +
            ‖(if Nat.Coprime n q then f n else 0) / (q.totient : ℂ)‖ :=
          norm_sub_le _ _
        _ = ‖if n % q = a % q then f n else 0‖ +
            ‖if Nat.Coprime n q then f n else 0‖ / (q.totient : ℝ) := by
          rw [norm_div, Complex.norm_natCast]
        _ ≤ ‖f n‖ + ‖f n‖ := by
          apply add_le_add (hmask _ _)
          exact (div_le_div_of_nonneg_right (hmask _ _) (Nat.cast_nonneg _)).trans
            (div_le_self (norm_nonneg _) hφ)
        _ = 2 * ‖f n‖ := by ring
    _ = _ := (Finset.mul_sum _ _ _).symm

open Classical in
theorem eventually_exceptional_coefficient_discrepancy_le
    (k : ℕ) (D A B C ε T : ℝ) (hD : 0 ≤ D) (hε : 0 < ε) (hT : 0 < T) :
    ∀ᶠ x : ℝ in Filter.atTop, ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ f : ℕ → ℂ,
        (∀ n ∈ Finset.Icc 1 (Nat.floor (T * N)),
          ‖f n‖ ≤ D * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ B) →
      ∀ q a r0 : ℕ, 0 < q →
        ‖fullDiscrepancy
          (∑ n ∈ (Finset.Icc 1 (Nat.floor (T * N))).filter (fun n =>
              n ∈ Nat.factoredNumbers
                (Nat.primesLE (Nat.floor (Real.exp (Real.sqrt (Real.log x))))) ∨
              ∃ p : ℕ, Nat.Prime p ∧
                Real.exp (Real.sqrt (Real.log x)) < (p : ℝ) ∧ p ^ 2 ∣ n),
            Finsupp.single n (if Nat.Coprime n r0 then f n else 0)) q a‖ ≤
          2 * D * N * (Real.log x) ^ (-A) := by
  filter_upwards [eventually_exceptional_divisor_mass_le
    k A B C ε T hε hT] with x hmass
  intro N hNL hNU f hf q a r0 hq
  let S : Finset ℕ := (Finset.Icc 1 (Nat.floor (T * N))).filter (fun n =>
    n ∈ Nat.factoredNumbers
      (Nat.primesLE (Nat.floor (Real.exp (Real.sqrt (Real.log x))))) ∨
    ∃ p : ℕ, Nat.Prime p ∧
      Real.exp (Real.sqrt (Real.log x)) < (p : ℝ) ∧ p ^ 2 ∣ n)
  have hmask (n : ℕ) (hn : n ∈ S) :
      ‖if Nat.Coprime n r0 then f n else 0‖ ≤
        D * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ B := by
    calc
      _ ≤ ‖f n‖ := by split_ifs <;> simp
      _ ≤ _ := hf n (Finset.mem_of_mem_filter n hn)
  calc
    _ ≤ 2 * ∑ n ∈ S, ‖if Nat.Coprime n r0 then f n else 0‖ :=
      norm_fullDiscrepancy_sample_le_two_sum_norm S
        (fun n => if Nat.Coprime n r0 then f n else 0) q a hq
    _ ≤ 2 * ∑ n ∈ S, D * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ B :=
      mul_le_mul_of_nonneg_left (Finset.sum_le_sum hmask) (by norm_num)
    _ = 2 * D * ((Real.log x) ^ B * ∑ n ∈ S, (n.divisors.card : ℝ) ^ k) := by
      simp only [Finset.mul_sum, mul_assoc, mul_left_comm, mul_comm]
    _ ≤ 2 * D * (N * (Real.log x) ^ (-A)) :=
      mul_le_mul_of_nonneg_left (hmass N hNL hNU) (by positivity)
    _ = _ := by ring

open Classical in
theorem theta6_a0_good_part_small_modulus_siegelWalfisz
    (ε T C D A : ℝ) (hε : 0 < ε) (hT : 0 < T) (hC : 0 < C) (hD : 0 < D) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ z H S M0 lo hi : ℝ, 0 < H → 0 < S →
      ∀ (q : ℕ) [NeZero q], (q : ℝ) ≤ (Real.log x) ^ D →
      ∀ r0 : ℕ, 0 < r0 → ∀ a : ℕ, Nat.Coprime a q →
      let NN := Nat.floor (T * N)
      let Y := Nat.floor (Real.exp (Real.sqrt (Real.log x)))
      let A0 : ℕ → ℤ := fun n =>
        if 1 < z ∧ (n : ℝ) ≤ M0 then
          ∑ p2 ∈ n.primeFactors, ∑ p3 ∈ n.primeFactors, ∑ p4 ∈ n.primeFactors,
            if p2 * p3 * p4 ∣ n ∧ z ≤ (p3 : ℝ) ∧ p3 < p2 ∧ (p2 : ℝ) < H ∧
                p3 ≤ p4 ∧ ((p3 * p4 : ℕ) : ℝ) < H ∧ (p2 : ℝ) < S ∧
                n / (p2 * p3 * p4) ∈ Nat.smoothNumbers (Nat.ceil z)
            then ArithmeticFunction.moebius (n / (p2 * p3 * p4)) else 0
        else 0
      ‖fullDiscrepancy
        (∑ n ∈ (Finset.Icc 1 NN).filter (fun n : ℕ =>
            n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
              ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ n),
          Finsupp.single n
            (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n r0
             then (A0 n : ℂ) else 0)) q a‖ ≤
        K * (r0.divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨E, hE, Xe, _hXe, henvelope⟩ := exists_cofactor_log_fourth_envelope T C hT hC
  obtain ⟨K, Xs, hK, hXs, hsmall⟩ :=
    largest_prime_windows_fixedPower_siegelWalfisz
      D 4 (2 * E) T A hD (by positivity) hT.le
  refine ⟨K, max Xs Xe, hK, hXs.trans (le_max_left _ _), ?_⟩
  intro x hx N hNL hNU z H S M0 lo hi hH hS q _ hq r0 hr0 a ha NN Y A0
  have hxexp : Real.exp 1 ≤ x := hXs.trans ((le_max_left _ _).trans hx)
  have hxone : 1 ≤ x := by
    have hexp : (1 : ℝ) ≤ Real.exp 1 := by
      simpa only [Real.exp_zero] using
        (Real.exp_le_exp.mpr (by norm_num : (0 : ℝ) ≤ 1))
    exact hexp.trans hxexp
  have hN : 0 ≤ N := (zero_le_one.trans (Real.one_le_rpow hxone hε.le)).trans hNL
  have hNN : (NN : ℝ) ≤ T * N := Nat.floor_le (mul_nonneg hT.le hN)
  have hlogenv : (1 + Real.log (NN : ℝ)) ^ 4 ≤ E * (Real.log x) ^ 4 :=
    henvelope x ((le_max_right _ _).trans hx) N hN hNU
  let C1 : ℕ → ℕ → ℕ → ℤ := fun m u v =>
    if 1 < z ∧ u * v ∣ m ∧ z ≤ (u : ℝ) ∧ u ≤ v ∧
        ((u * v : ℕ) : ℝ) < H ∧ m / (u * v) ∈ Nat.smoothNumbers (Nat.ceil z)
    then ArithmeticFunction.moebius (m / (u * v)) else 0
  let C2 : ℕ → ℕ → ℕ → ℤ := fun m u v =>
    if 1 < z ∧ u * v ∣ m ∧ z ≤ (v : ℝ) ∧ v < u ∧
        (u : ℝ) < H ∧ (u : ℝ) < S ∧
        m / (u * v) ∈ Nat.smoothNumbers (Nat.ceil z)
    then ArithmeticFunction.moebius (m / (u * v)) else 0
  let L1 : ℕ → ℕ → ℕ := fun m u =>
    max (Y + 1)
      (max (m.primeFactors.sup id + 1) (max (Nat.ceil (lo / (m : ℝ))) (u + 1)))
  let U1 : ℕ → ℕ := fun m =>
    min (NN / m) (min (Nat.floor (min hi M0 / (m : ℝ)))
      (min (Nat.ceil H - 1) (Nat.ceil S - 1)))
  let L2 : ℕ → ℕ → ℕ := fun m v =>
    max (Y + 1)
      (max (m.primeFactors.sup id + 1) (max (Nat.ceil (lo / (m : ℝ))) v))
  let U2 : ℕ → ℕ → ℕ := fun m v =>
    min (NN / m) (min (Nat.floor (min hi M0 / (m : ℝ)))
      (Nat.ceil (H / (v : ℝ)) - 1))
  let W : Fin 2 → ℕ → ℕ → ℕ → ℂ := fun b m u v =>
    if b = 0 then (C1 m u v : ℂ) else (C2 m u v : ℂ)
  let LL : Fin 2 → ℕ → ℕ → ℕ → ℕ := fun b m u v =>
    if b = 0 then L1 m u else L2 m v
  let UU : Fin 2 → ℕ → ℕ → ℕ → ℕ := fun b m _u v =>
    if b = 0 then U1 m else U2 m v
  let Psum : Fin 2 → ℕ → ℕ → ℕ → ℕ →₀ ℂ := fun b m u v =>
    ∑ p ∈ Finset.Icc (LL b m u v) (UU b m u v),
      Finsupp.single (m * p)
        (if Nat.Prime p ∧ Nat.Coprime (m * p) r0 then W b m u v else 0)
  let MF : Finset ℕ := (Finset.Icc 1 NN).filter (fun m : ℕ =>
    ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ m)
  let M : Finset ℕ := (Finset.Icc 1 (NN / (Y + 1))).filter (fun m : ℕ =>
    ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ m)
  let J : Finset (Σ _m : ℕ, Σ _u : ℕ, ℕ) :=
    M.sigma (fun m => m.primeFactors.sigma (fun _u => m.primeFactors))
  let I : Finset (Fin 2 × (Σ _m : ℕ, Σ _u : ℕ, ℕ)) := Finset.univ ×ˢ J
  have hnorm (b : Fin 2) (m u v : ℕ) : ‖W b m u v‖ ≤ 1 := by
    dsimp only [W, C1, C2]
    split_ifs <;> first
      | exact_mod_cast (ArithmeticFunction.abs_moebius_le_one (n := m / (u * v)))
      | norm_num
  have hMfull : M ⊆ MF := by
    intro m hm
    obtain ⟨hmI, hmSq⟩ := Finset.mem_filter.mp hm
    obtain ⟨hm1, hmN⟩ := Finset.mem_Icc.mp hmI
    exact Finset.mem_filter.mpr
      ⟨Finset.mem_Icc.mpr ⟨hm1, hmN.trans (Nat.div_le_self NN (Y + 1))⟩, hmSq⟩
  have hMbox : M ⊆ Finset.Icc 1 NN :=
    hMfull.trans (Finset.filter_subset _ _)
  have hindex (i : Fin 2 × (Σ _m : ℕ, Σ _u : ℕ, ℕ)) (hi : i ∈ I) :
      i.2.1 ∈ M ∧ i.2.2.1 ∈ i.2.1.primeFactors ∧ i.2.2.2 ∈ i.2.1.primeFactors := by
    have hiJ := (Finset.mem_product.mp hi).2
    obtain ⟨hm, huv⟩ := Finset.mem_sigma.mp hiJ
    obtain ⟨hu, hv⟩ := Finset.mem_sigma.mp huv
    exact ⟨hm, hu, hv⟩
  have hmpos (i : Fin 2 × (Σ _m : ℕ, Σ _u : ℕ, ℕ)) (hi : i ∈ I) :
      0 < i.2.1 := (Finset.mem_Icc.mp (hMbox (hindex i hi).1)).1
  have hmoment :
      (∑ i ∈ I, ‖W i.1 i.2.1 i.2.2.1 i.2.2.2‖ / (i.2.1 : ℝ)) ≤
        (2 * E) * (Real.log x) ^ (4 : ℝ) := by
    have hbranch (b : Fin 2) :
        (∑ m ∈ M, ∑ u ∈ m.primeFactors, ∑ v ∈ m.primeFactors,
          ‖W b m u v‖ / (m : ℝ)) ≤ E * (Real.log x) ^ 4 := by
      calc
        _ ≤ ∑ m ∈ Finset.Icc 1 NN, ∑ u ∈ m.primeFactors, ∑ v ∈ m.primeFactors,
            ‖W b m u v‖ / (m : ℝ) := by
          apply Finset.sum_le_sum_of_subset_of_nonneg hMbox
          intro m _hm _hnot
          positivity
        _ ≤ (1 + Real.log (NN : ℝ)) ^ 4 :=
          prime_pair_cofactor_reciprocal_moment_le NN (W b)
            (fun m _hm u _hu v _hv => hnorm b m u v)
        _ ≤ E * (Real.log x) ^ 4 := hlogenv
    calc
      _ = ∑ b : Fin 2, ∑ m ∈ M, ∑ u ∈ m.primeFactors, ∑ v ∈ m.primeFactors,
          ‖W b m u v‖ / (m : ℝ) := by
        simp only [I, J, Finset.sum_product, Finset.sum_sigma]
      _ ≤ ∑ _b : Fin 2, E * (Real.log x) ^ 4 := Finset.sum_le_sum fun b _ => hbranch b
      _ = (2 * E) * (Real.log x) ^ (4 : ℝ) := by
        norm_num only [Finset.sum_const, Finset.card_univ, Fintype.card_fin,
          nsmul_eq_mul, Real.rpow_ofNat]
        ring
  have hXL (i : Fin 2 × (Σ _m : ℕ, Σ _u : ℕ, ℕ)) (hi : i ∈ I) :
      Real.exp (Real.sqrt (Real.log x)) ≤ ((NN / i.2.1 : ℕ) : ℝ) := by
    have hcap := (Finset.mem_Icc.mp (Finset.mem_filter.mp (hindex i hi).1).1).2
    exact (cofactor_prime_scale_above_real_cutoff NN i.2.1
      (Real.exp (Real.sqrt (Real.log x))) (hmpos i hi) hcap).le
  have hXU (i : Fin 2 × (Σ _m : ℕ, Σ _u : ℕ, ℕ)) (hi : i ∈ I) :
      ((NN / i.2.1 : ℕ) : ℝ) ≤ T * N / (i.2.1 : ℝ) :=
    (Nat.cast_div_le (m := NN) (n := i.2.1) (α := ℝ)).trans
      (div_le_div_of_nonneg_right hNN (Nat.cast_pos.mpr (hmpos i hi)).le)
  have hLU (i : Fin 2 × (Σ _m : ℕ, Σ _u : ℕ, ℕ)) (_hi : i ∈ I) :
      UU i.1 i.2.1 i.2.2.1 i.2.2.2 ≤ NN / i.2.1 := by
    dsimp only [UU, U1, U2]
    split_ifs <;> exact min_le_left _ _
  have hprimefilter (m l u : ℕ) (w : ℂ) :
      (∑ p ∈ (Finset.Icc l u).filter Nat.Prime,
        Finsupp.single (m * p) (if Nat.Coprime (m * p) r0 then w else 0)) =
      ∑ p ∈ Finset.Icc l u, Finsupp.single (m * p)
        (if Nat.Prime p ∧ Nat.Coprime (m * p) r0 then w else 0) := by
    rw [Finset.sum_filter]
    apply Finset.sum_congr rfl
    intro p _hp
    by_cases hp : Nat.Prime p <;> simp [hp]
  have hsource :
      (∑ n ∈ (Finset.Icc 1 NN).filter (fun n : ℕ =>
          n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
            ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ n),
        Finsupp.single n
          (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n r0
           then (A0 n : ℂ) else 0)) =
      ∑ m ∈ MF, ∑ u ∈ m.primeFactors, ∑ v ∈ m.primeFactors,
        (Psum 0 m u v + Psum 1 m u v) := by
    have hs := theta6_a0_good_part_prime_windows NN Y r0 z H S M0 lo hi hH hS
    dsimp only at hs
    simp only [hprimefilter] at hs
    have hone : (1 : Fin 2) ≠ 0 := by decide
    simpa only [A0, MF, Psum, W, LL, UU, L1, U1, L2, U2, C1, C2,
      eq_self, hone, ite_true, ite_false] using hs
  have htruncate :
      (∑ m ∈ MF, ∑ u ∈ m.primeFactors, ∑ v ∈ m.primeFactors,
        (Psum 0 m u v + Psum 1 m u v)) =
      ∑ m ∈ M, ∑ u ∈ m.primeFactors, ∑ v ∈ m.primeFactors,
        (Psum 0 m u v + Psum 1 m u v) := by
    symm
    apply Finset.sum_subset hMfull
    intro m hm hnot
    have hlarge : NN / (Y + 1) < m := by
      apply lt_of_not_ge
      intro hcap
      have hm1 := (Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1).1
      exact hnot (Finset.mem_filter.mpr
        ⟨Finset.mem_Icc.mpr ⟨hm1, hcap⟩, (Finset.mem_filter.mp hm).2⟩)
    have hempty (l u : ℕ) :
        Finset.Icc (max (Y + 1) l) (min (NN / m) u) = ∅ :=
      cofactor_clipped_prime_window_eq_empty NN Y m l u hlarge
    have hzero (b : Fin 2) (u v : ℕ) : Psum b m u v = 0 := by
      dsimp only [Psum, LL, UU, L1, U1, L2, U2]
      by_cases hb : b = 0
      · simp only [eq_true hb, ite_true, hempty, Finset.sum_empty]
      · simp only [eq_false hb, ite_false, hempty, Finset.sum_empty]
    simp only [hzero, zero_add, Finset.sum_const_zero]
  have hfamily :
      (∑ n ∈ (Finset.Icc 1 NN).filter (fun n : ℕ =>
          n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
            ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ n),
        Finsupp.single n
          (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n r0
           then (A0 n : ℂ) else 0)) =
      ∑ i ∈ I, ∑ p ∈ Finset.Icc
          (LL i.1 i.2.1 i.2.2.1 i.2.2.2) (UU i.1 i.2.1 i.2.2.1 i.2.2.2),
        Finsupp.single (i.2.1 * p)
          (if Nat.Prime p ∧ Nat.Coprime (i.2.1 * p) r0
           then W i.1 i.2.1 i.2.2.1 i.2.2.2 else 0) := by
    rw [hsource, htruncate]
    simp only [I, J, Finset.sum_product, Finset.sum_sigma]
    rw [Fin.sum_univ_two]
    simp only [Psum, Finset.sum_add_distrib]
  rw [hfamily]
  exact hsmall x ((le_max_left _ _).trans hx) N hN I
    (fun i => i.2.1) (fun i => W i.1 i.2.1 i.2.2.1 i.2.2.2)
    (fun i => LL i.1 i.2.1 i.2.2.1 i.2.2.2)
    (fun i => UU i.1 i.2.1 i.2.2.1 i.2.2.2)
    (fun i => NN / i.2.1) hmpos hXL hXU hLU hmoment q hq r0 hr0 a ha

open Classical in
theorem theta6_a0_all_moduli_siegelWalfisz
    (ε T c C A : ℝ) (hε : 0 < ε) (hT : 0 < T) (hc : 0 < c)
    (hC : 0 < C) (hA : 0 < A) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ z H S M0 lo hi : ℝ, 0 < H → 0 < S → c * N ≤ lo →
      ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 → ∀ a : ℕ, Nat.Coprime a q →
      let A0 : ℕ → ℤ := fun n =>
        if 1 < z ∧ (n : ℝ) ≤ M0 then
          ∑ p2 ∈ n.primeFactors, ∑ p3 ∈ n.primeFactors, ∑ p4 ∈ n.primeFactors,
            if p2 * p3 * p4 ∣ n ∧ z ≤ (p3 : ℝ) ∧ p3 < p2 ∧ (p2 : ℝ) < H ∧
                p3 ≤ p4 ∧ ((p3 * p4 : ℕ) : ℝ) < H ∧ (p2 : ℝ) < S ∧
                n / (p2 * p3 * p4) ∈ Nat.smoothNumbers (Nat.ceil z)
            then ArithmeticFunction.moebius (n / (p2 * p3 * p4)) else 0
        else 0
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
          (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n r0
           then (A0 n : ℂ) else 0)) q a‖ ≤
        K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨D, hD, hlarge⟩ :=
    eventually_large_modulus_finsupp_discrepancy_le
      3 1 ε c T C hε hc hT A hA
  obtain ⟨Kg, Xg, hKg, hXg, hgood⟩ :=
    theta6_a0_good_part_small_modulus_siegelWalfisz ε T C D A hε hT hC hD
  obtain ⟨Xl, hXl⟩ := Filter.eventually_atTop.mp hlarge
  obtain ⟨Xb, hXb⟩ := Filter.eventually_atTop.mp
    (eventually_exceptional_coefficient_discrepancy_le
      3 1 A 0 C ε T (by norm_num) hε hT)
  refine ⟨Kg + 2, max Xg (max Xl Xb), by linarith,
    hXg.trans (le_max_left _ _), ?_⟩
  intro x hx N hNL hNU z H S M0 lo hi hH hS hlo q hq r0 hr0 a ha A0
  have hxg : Xg ≤ x := (le_max_left _ _).trans hx
  have hxl : Xl ≤ x := (le_max_left Xl Xb).trans ((le_max_right _ _).trans hx)
  have hxb : Xb ≤ x := (le_max_right Xl Xb).trans ((le_max_right _ _).trans hx)
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le (hXg.trans hxg)
  have hlog1 : 1 ≤ Real.log x :=
    (Real.le_log_iff_exp_le hx0).mpr (hXg.trans hxg)
  have hlog : 0 ≤ Real.log x := zero_le_one.trans hlog1
  have hN : 0 ≤ N := (Real.rpow_pos_of_pos hx0 ε).le.trans hNL
  have hden : 0 ≤ (Real.log x) ^ A := Real.rpow_nonneg hlog A
  let NN := Nat.floor (T * N)
  let Y := Nat.floor (Real.exp (Real.sqrt (Real.log x)))
  let V : Finset ℕ := Finset.Icc 1 NN
  let f : ℕ → ℂ := fun n => if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi then (A0 n : ℂ) else 0
  let g : ℕ → ℂ := fun n => if Nat.Coprime n r0 then f n else 0
  let F0 : ℕ →₀ ℂ := ∑ n ∈ V, Finsupp.single n (f n)
  let GOOD : Finset ℕ := V.filter (fun n : ℕ =>
    n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
      ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n)
  let BAD : Finset ℕ := V.filter (fun n : ℕ =>
    n ∈ Nat.factoredNumbers (Nat.primesLE Y) ∨
      ∃ p : ℕ, Nat.Prime p ∧
        Real.exp (Real.sqrt (Real.log x)) < (p : ℝ) ∧ p ^ 2 ∣ n)
  have hA0 (n : ℕ) : ‖(A0 n : ℂ)‖ ≤ (n.divisors.card : ℝ) ^ 3 := by
    simpa [A0] using theta6_a0_norm_le_divisor_cube n z H S M0
  have hf (n : ℕ) : ‖f n‖ ≤ (n.divisors.card : ℝ) ^ 3 := by
    dsimp only [f]
    split_ifs
    · exact hA0 n
    · simp only [norm_zero]
      positivity
  have hmasked (n : ℕ) : g n =
      if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n r0
      then (A0 n : ℂ) else 0 := by
    by_cases h1 : lo ≤ (n : ℝ) <;> by_cases h2 : (n : ℝ) ≤ hi <;>
      by_cases h3 : Nat.Coprime n r0 <;> simp [f, g, h1, h2, h3]
  have htarget :
      (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
        (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n r0
         then (A0 n : ℂ) else 0)) =
      ∑ n ∈ V, Finsupp.single n (g n) := by
    apply Finset.sum_congr rfl
    intro n _hn
    rw [hmasked]
  rw [htarget]
  have hqr0 : q * r0 ≠ 0 := Nat.mul_ne_zero hq.ne' hr0.ne'
  have hτq : (q.divisors.card : ℝ) ≤ ((q * r0).divisors.card : ℝ) := by
    exact_mod_cast Finset.card_le_card
      (Nat.divisors_subset_of_dvd hqr0 (show q ∣ q * r0 from ⟨r0, rfl⟩))
  have hτr : (r0.divisors.card : ℝ) ≤ ((q * r0).divisors.card : ℝ) := by
    exact_mod_cast Finset.card_le_card
      (Nat.divisors_subset_of_dvd hqr0
        (show r0 ∣ q * r0 from ⟨q, Nat.mul_comm q r0⟩))
  have hτ1 : (1 : ℝ) ≤ ((q * r0).divisors.card : ℝ) := by
    exact_mod_cast (Finset.one_le_card.mpr
      ⟨1, Nat.one_mem_divisors.mpr hqr0⟩ : 1 ≤ (q * r0).divisors.card)
  by_cases hqsmall : (q : ℝ) ≤ (Real.log x) ^ D
  · let : NeZero q := ⟨hq.ne'⟩
    have hgoodbound :
        ‖fullDiscrepancy (∑ n ∈ GOOD, Finsupp.single n (g n)) q a‖ ≤
          Kg * (r0.divisors.card : ℝ) * N / (Real.log x) ^ A := by
      have hg := hgood x hxg N hNL hNU z H S M0 lo hi hH hS q hqsmall r0 hr0 a ha
      change ‖fullDiscrepancy
        (∑ n ∈ GOOD, Finsupp.single n
          (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n r0
           then (A0 n : ℂ) else 0)) q a‖ ≤ _ at hg
      simpa only [← hmasked] using hg
    have hbadbound :
        ‖fullDiscrepancy (∑ n ∈ BAD, Finsupp.single n (g n)) q a‖ ≤
          2 * N * (Real.log x) ^ (-A) := by
      have hb := hXb x hxb N hNL hNU f
        (fun n _hn => by simpa using hf n) q a r0 hq
      simpa only [BAD, V, NN, Y, g, one_mul, mul_one] using hb
    have hbadfilter :
        V.filter (fun n : ℕ =>
          ¬(n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
            ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n)) = BAD := by
      ext n
      simp only [BAD, Finset.mem_filter, not_and_or, not_not]
      apply and_congr_right
      intro _hn
      constructor
      · rintro (hn | ⟨p, hp, hY, hpn⟩)
        · exact Or.inl hn
        · exact Or.inr ⟨p, hp, (Nat.floor_lt' hp.ne_zero).mp hY, hpn⟩
      · rintro (hn | ⟨p, hp, hY, hpn⟩)
        · exact Or.inl hn
        · exact Or.inr ⟨p, hp, (Nat.floor_lt' hp.ne_zero).mpr hY, hpn⟩
    have hsplit :
        fullDiscrepancy (∑ n ∈ V, Finsupp.single n (g n)) q a =
          fullDiscrepancy (∑ n ∈ GOOD, Finsupp.single n (g n)) q a +
          fullDiscrepancy (∑ n ∈ BAD, Finsupp.single n (g n)) q a := by
      simp only [fullDiscrepancy_sample]
      rw [← hbadfilter]
      simpa only [GOOD] using
        (Finset.sum_filter_add_sum_filter_not V
          (fun n : ℕ => n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
            ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n)
          (fun n : ℕ =>
            (if n % q = a % q then g n else 0) -
              (if Nat.Coprime n q then g n else 0) / (q.totient : ℂ))).symm
    rw [hsplit]
    calc
      _ ≤ ‖fullDiscrepancy (∑ n ∈ GOOD, Finsupp.single n (g n)) q a‖ +
          ‖fullDiscrepancy (∑ n ∈ BAD, Finsupp.single n (g n)) q a‖ := norm_add_le _ _
      _ ≤ Kg * (r0.divisors.card : ℝ) * N / (Real.log x) ^ A +
          2 * N * (Real.log x) ^ (-A) := add_le_add hgoodbound hbadbound
      _ = Kg * (r0.divisors.card : ℝ) * N / (Real.log x) ^ A +
          2 * N / (Real.log x) ^ A := by
        rw [Real.rpow_neg hlog]
        ring
      _ ≤ Kg * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A +
          2 * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
        apply add_le_add
        · exact div_le_div_of_nonneg_right
            (mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_left hτr hKg.le) hN) hden
        · apply div_le_div_of_nonneg_right _ hden
          apply mul_le_mul_of_nonneg_right _ hN
          simpa only [mul_one] using mul_le_mul_of_nonneg_left hτ1 (by norm_num : (0 : ℝ) ≤ 2)
      _ = (Kg + 2) * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by ring
  · have hF0 (n : ℕ) : F0 n = if n ∈ V then f n else 0 := by
      simp [F0, Finsupp.finsetSum_apply, Finsupp.single_apply]
    have hsupport : ∀ n ∈ F0.support, c * N ≤ (n : ℝ) ∧ (n : ℝ) ≤ T * N := by
      intro n hn
      have hne := Finsupp.mem_support_iff.mp hn
      rw [hF0] at hne
      have hparts : n ∈ V ∧ f n ≠ 0 := by
        simpa only [ite_ne_right_iff] using hne
      have hlocal : lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi := by
        have hfne := hparts.2
        dsimp only [f] at hfne
        exact (ite_ne_right_iff.mp hfne).1
      exact ⟨hlo.trans hlocal.1,
        (Nat.cast_le.mpr (Finset.mem_Icc.mp hparts.1).2).trans
          (Nat.floor_le (mul_nonneg hT.le hN))⟩
    have hFbound (n : ℕ) : ‖F0 n‖ ≤ (n.divisors.card : ℝ) ^ (3 : ℝ) := by
      rw [hF0]
      split_ifs
      · simpa only [Real.rpow_ofNat] using hf n
      · simp only [norm_zero]
        exact Real.rpow_nonneg (Nat.cast_nonneg _) _
    have henvelope : ∀ n ∈ F0.support,
        ‖F0 n‖ ≤ 1 * (n.divisors.card : ℝ) ^ (3 : ℝ) * (Real.log x) ^ (3 : ℝ) := by
      intro n _hn
      exact (hFbound n).trans (by
        simpa only [one_mul] using
          le_mul_of_one_le_right (Real.rpow_nonneg (Nat.cast_nonneg n.divisors.card) (3 : ℝ))
            (Real.one_le_rpow hlog1 (by norm_num : (0 : ℝ) ≤ 3)))
    have hfilter : F0.filter (fun n : ℕ => Nat.Coprime n r0) =
        ∑ n ∈ V, Finsupp.single n (g n) := by
      dsimp only [F0]
      rw [Finsupp.filter_sum]
      apply Finset.sum_congr rfl
      intro n _hn
      by_cases hcop : Nat.Coprime n r0
      · rw [Finsupp.filter_single_of_pos (fun n => Nat.Coprime n r0) hcop]
        simp only [g, eq_true hcop, ite_true]
      · rw [Finsupp.filter_single_of_neg (fun n => Nat.Coprime n r0) hcop]
        simp [g, hcop]
    have hdiscrepancy :
        fullDiscrepancy (F0.filter (fun n : ℕ => Nat.Coprime n r0)) q a =
          (∑ n ∈ F0.support with Nat.ModEq q n a ∧ Nat.Coprime n r0, F0 n) -
            (q.totient : ℂ)⁻¹ *
              (∑ n ∈ F0.support with Nat.Coprime n q ∧ Nat.Coprime n r0, F0 n) := by
      have hp :
          (∑ n ∈ F0.support.filter (fun n : ℕ => Nat.Coprime n r0),
            if n % q = a % q then F0 n else 0) =
          ∑ n ∈ F0.support with Nat.ModEq q n a ∧ Nat.Coprime n r0, F0 n := by
        simp only [Finset.sum_filter]
        apply Finset.sum_congr rfl
        intro n _hn
        by_cases hnr : Nat.Coprime n r0 <;> by_cases hna : n % q = a % q <;>
          simp [hnr, hna, Nat.ModEq]
      have hr :
          (∑ n ∈ F0.support.filter (fun n : ℕ => Nat.Coprime n r0),
            if Nat.Coprime n q then F0 n else 0) =
          ∑ n ∈ F0.support with Nat.Coprime n q ∧ Nat.Coprime n r0, F0 n := by
        simp only [Finset.sum_filter]
        apply Finset.sum_congr rfl
        intro n _hn
        simp only [← ite_and, and_comm]
      rw [Finsupp.filter_eq_sum, fullDiscrepancy_sample,
        Finset.sum_sub_distrib, ← Finset.sum_div, hp, hr]
      ring
    have hbound := hXl x hxl N hNL hNU q hq (lt_of_not_ge hqsmall)
      a ha r0 hr0 F0 hsupport henvelope
    rw [← hdiscrepancy, hfilter] at hbound
    have hτK : (q.divisors.card : ℝ) ≤
        (Kg + 2) * ((q * r0).divisors.card : ℝ) :=
      hτq.trans (by
        simpa only [one_mul] using
          mul_le_mul_of_nonneg_right (show (1 : ℝ) ≤ Kg + 2 by linarith)
            (Nat.cast_nonneg (q * r0).divisors.card))
    calc
      _ ≤ (q.divisors.card : ℝ) * N * (Real.log x) ^ (-A) := hbound
      _ = (q.divisors.card : ℝ) * N / (Real.log x) ^ A := by
        rw [Real.rpow_neg hlog]
        ring
      _ ≤ (Kg + 2) * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A :=
        div_le_div_of_nonneg_right (mul_le_mul_of_nonneg_right hτK hN) hden

theorem literal_minorant_closedInterval_support_and_envelope :
    ∀ᶠ x : ℝ in Filter.atTop,
      let rho : ℕ →₀ ℂ :=
        ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
          Finsupp.single n (((if n.Prime then (1 : ℝ) else 0) -
            exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n) : ℂ)
      (∀ n ∈ rho.support, 0 < n ∧ (n : ℝ) ≤ 2 * x) ∧
        (∀ n ∈ rho.support, ‖rho n‖ ≤ 6251) := by
  classical
  filter_upwards [eventually_literal_minorant_pointwise,
    Filter.eventually_gt_atTop (1 : ℝ)] with x hpoint hx
  intro rho
  let T := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hvalue (n : ℕ) :
      rho n = if n ∈ T then
        (((if n.Prime then (1 : ℝ) else 0) -
          exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n) : ℂ) else 0 := by
    simp only [rho, T, Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_ite_eq']
  have hmem (n : ℕ) (hn : n ∈ rho.support) : n ∈ T := by
    by_contra hnot
    exact (Finsupp.mem_support_iff.mp hn) (by rw [hvalue, ite_eq_right hnot])
  have hinterval (n : ℕ) (hn : n ∈ rho.support) :
      x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x := by
    obtain ⟨hlo, hhi⟩ := Finset.mem_Icc.mp (hmem n hn)
    exact ⟨(Nat.le_ceil x).trans (Nat.cast_le.mpr hlo),
      (Nat.cast_le.mpr hhi).trans (Nat.floor_le (by positivity))⟩
  refine ⟨?_, ?_⟩
  · intro n hn
    exact ⟨Nat.cast_pos.mp (hx0.trans_le (hinterval n hn).1), (hinterval n hn).2⟩
  · intro n hn
    rw [hvalue, ite_eq_left (hmem n hn)]
    simpa only [← Complex.ofReal_sub, Complex.norm_real, Real.norm_eq_abs] using
      (hpoint n (hinterval n hn).1 (hinterval n hn).2).2.2.2

theorem literal_minorant_divisor_weight_log_growth
    (θ : ℝ) (hθ0 : 0 < θ) (hθ1 : θ < 1) (J : ℕ) :
    ∃ P : ℕ, ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ S : Finset ℕ, S ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
        let rho : ℕ →₀ ℂ :=
          ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n (((if n.Prime then (1 : ℝ) else 0) -
              exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n) : ℂ)
        (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy rho q (a q)‖) ≤
          K * x * (Real.log x) ^ P := by
  obtain ⟨P, Kg, hKg, hgrowth⟩ :=
    weighted_fullDiscrepancy_positiveSupport_log_growth
      θ hθ0 hθ1 0 J 0 2 (by norm_num)
  obtain ⟨Xe, hXe⟩ :=
    Filter.eventually_atTop.mp literal_minorant_closedInterval_support_and_envelope
  let X : ℝ := max (max Xe (Real.exp 1)) 2
  refine ⟨P, Kg * 6251, X, by positivity,
    lt_of_lt_of_le (by norm_num : (1 : ℝ) < 2) (le_max_right _ _), ?_⟩
  intro x hx S hS a ha rho
  have hxe : Xe ≤ x := (le_max_left _ _).trans ((le_max_left _ _).trans hx)
  have hxexp : Real.exp 1 ≤ x := (le_max_right _ _).trans ((le_max_left _ _).trans hx)
  have henv := hXe x hxe
  have hg := hgrowth x hxexp 6251 (by norm_num) S hS a ha rho henv.1
    (fun n hn => by simpa only [pow_zero, Real.rpow_zero, mul_one] using henv.2 n hn)
  simpa only [mul_assoc] using hg

theorem literal_minorant_divisor_weight_log_saving_of_unweighted
    {ι : Type*} (θ : ℝ) (hθ0 : 0 < θ) (hθ1 : θ < 1)
    (Q : ℝ → ι → Finset ℕ) (a : ℝ → ι → ℕ → ℕ)
    (hQ : ∀ᶠ x : ℝ in Filter.atTop, ∀ i : ι,
      Q x i ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊)
    (ha : ∀ᶠ x : ℝ in Filter.atTop, ∀ i : ι,
      ∀ q ∈ Q x i, Nat.Coprime (a x i q) q) (J : ℕ) :
    let rho : ℝ → ℕ →₀ ℂ := fun x =>
      ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        Finsupp.single n (((if n.Prime then (1 : ℝ) else 0) -
          exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n) : ℂ)
    (∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ i : ι,
        (∑ q ∈ Q x i, ‖fullDiscrepancy (rho x) q (a x i q)‖) ≤
          K * x / (Real.log x) ^ A) →
      ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
        ∀ x : ℝ, X ≤ x → ∀ i : ι,
          (∑ q ∈ Q x i, (q.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy (rho x) q (a x i q)‖) ≤ K * x / (Real.log x) ^ A := by
  intro rho hunweighted A hA
  obtain ⟨P, Kc, Xc, hKc, _hXc, hcrude⟩ :=
    literal_minorant_divisor_weight_log_growth θ hθ0 hθ1 (2 * J)
  have hrequested : 0 < 2 * A + (P : ℝ) := by positivity
  obtain ⟨Ks, Xs, hKs, hXs, hsmall⟩ := hunweighted (2 * A + (P : ℝ)) hrequested
  obtain ⟨Xf, hXf⟩ := Filter.eventually_atTop.mp (hQ.and ha)
  let X : ℝ := max Xs (max Xc Xf)
  refine ⟨Ks + Kc, X, add_pos hKs hKc,
    hXs.trans_le (le_max_left _ _), ?_⟩
  intro x hx i
  have hxxs : Xs ≤ x := (le_max_left _ _).trans hx
  have hxxc : Xc ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans hx)
  have hxxf : Xf ≤ x := (le_max_right _ _).trans ((le_max_right _ _).trans hx)
  have hx1 : 1 < x := hXs.trans_le hxxs
  have hraw := hsmall x hxxs i
  have hlarge' :
      (∑ q ∈ Q x i, (q.divisors.card : ℝ) ^ (2 * J) *
        ‖fullDiscrepancy (rho x) q (a x i q)‖) ≤ Kc * x * (Real.log x) ^ P :=
    hcrude x hxxc (Q x i) ((hXf x hxxf).1 i) (a x i) ((hXf x hxxf).2 i)
  exact sum_divisor_weighted_log_saving_of_two_bounds
    (Q x i) J (fun q => ‖fullDiscrepancy (rho x) q (a x i q)‖)
    (fun q _hq => norm_nonneg _) x (Real.log x) A Ks Kc P
    (zero_lt_one.trans hx1).le (Real.log_pos hx1) hKs hKc hraw hlarge'

theorem literal_minorant_fixed_shift_divisor_weight_log_saving
    (h : ℕ) (θ : ℝ) (hθ0 : 0 < θ) (hθ1 : θ < 1) (J : ℕ) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ a : ℕ → ℕ,
        let alpha : ℕ →₀ ℂ :=
          ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n (((if n.Prime then (1 : ℝ) else 0) -
              exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n) : ℂ)
        let alphaShift : ℕ →₀ ℂ :=
          ∑ n ∈ Finset.Icc (⌈x⌉₊ + h) (⌊2 * x⌋₊ + h),
            Finsupp.single n (((if n.Prime then (1 : ℝ) else 0) -
              exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n) : ℂ)
        (∑ q ∈ Finset.Icc 1 ⌊x ^ θ⌋₊, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy (alphaShift - alpha) q (a q)‖) ≤
            K * x / (Real.log x) ^ A := by
  classical
  intro A _hA
  let ε : ℝ := (1 - θ) / 4
  let β : ℝ := θ + 2 * ε
  let γ : ℝ := 1 - β
  have hε : 0 < ε := by dsimp [ε]; positivity
  have hγ : 0 < γ := by dsimp [γ, β, ε]; linarith
  obtain ⟨Cd, hCd, hdefect⟩ := exceptionalPrimeDefect_uniform_subpower ε hε
  obtain ⟨Cq, hCq, hdivisor⟩ := exists_divisorPower_bound J hε
  let C : ℝ := 1 + 2 * Cd * (3 : ℝ) ^ ε
  let F : ℝ := 4 * ((h : ℝ) + 1) * C
  let K : ℝ := F * Cq
  have hC : 0 < C := by dsimp [C]; positivity
  have hF : 0 < F := by dsimp [F]; positivity
  have hK : 0 < K := mul_pos hF hCq
  obtain ⟨Xlog, hXlog⟩ := Filter.eventually_atTop.mp
    ((isLittleO_log_rpow_rpow_atTop A hγ).bound zero_lt_one)
  let X : ℝ := max (max Xlog ((h : ℝ) + 2)) 2
  refine ⟨K, X, hK,
    lt_of_lt_of_le (by norm_num : (1 : ℝ) < 2) (le_max_right _ _), ?_⟩
  intro x hx a alpha alphaShift
  let f : ℕ → ℂ := fun n =>
    (((if n.Prime then (1 : ℝ) else 0) -
      exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n) : ℂ)
  let I₀ := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
  let I₁ := Finset.Icc (⌈x⌉₊ + h) (⌊2 * x⌋₊ + h)
  let u : ℕ →₀ ℂ := alphaShift - alpha
  let T := Finset.Ico ⌈x⌉₊ (⌈x⌉₊ + h) ∪ Finset.Ioc ⌊2 * x⌋₊ (⌊2 * x⌋₊ + h)
  have hx2 : 2 ≤ x := (le_max_right _ _).trans hx
  have hx1 : 1 ≤ x := (by norm_num : (1 : ℝ) ≤ 2).trans hx2
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hhx : (h : ℝ) ≤ x := by
    have hh := (le_max_right _ _).trans ((le_max_left _ _).trans hx)
    linarith
  have hxε : 1 ≤ x ^ ε := Real.one_le_rpow hx1 hε.le
  have hvalue (n : ℕ) :
      u n = (if n ∈ I₁ then f n else 0) - (if n ∈ I₀ then f n else 0) := by
    simp only [u, alphaShift, alpha, I₀, I₁, f, Finsupp.sub_apply,
      Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_ite_eq']
  have hcases (n : ℕ) (hn : n ∈ u.support) :
      (n ∈ I₁ ∧ n ∉ I₀) ∨ (n ∈ I₀ ∧ n ∉ I₁) := by
    by_cases hs : n ∈ I₁
    · by_cases ho : n ∈ I₀
      · exact False.elim ((Finsupp.mem_support_iff.mp hn)
          (by rw [hvalue, ite_eq_left hs, ite_eq_left ho, sub_self]))
      · exact Or.inl ⟨hs, ho⟩
    · by_cases ho : n ∈ I₀
      · exact Or.inr ⟨ho, hs⟩
      · exact False.elim ((Finsupp.mem_support_iff.mp hn)
          (by rw [hvalue, ite_eq_right hs, ite_eq_right ho, sub_zero]))
  have hsupport : u.support ⊆ T := by
    intro n hn
    rcases hcases n hn with ⟨hs, ho⟩ | ⟨ho, hs⟩
    · simp only [I₀, I₁, Finset.mem_Icc] at hs ho
      exact Finset.mem_union.mpr (Or.inr (Finset.mem_Ioc.mpr ⟨by omega, hs.2⟩))
    · simp only [I₀, I₁, Finset.mem_Icc] at hs ho
      exact Finset.mem_union.mpr (Or.inl (Finset.mem_Ico.mpr ⟨ho.1, by omega⟩))
  have hcard : u.support.card ≤ 2 * h := by
    refine (Finset.card_le_card hsupport).trans ?_
    exact (Finset.card_union_le _ _).trans (by
      simp only [Nat.card_Ico, Nat.card_Ioc, Nat.add_sub_cancel_left]
      omega)
  have hrange (n : ℕ) (hn : n ∈ u.support) : 0 < n ∧ (n : ℝ) ≤ 3 * x := by
    have hbounds : ⌈x⌉₊ ≤ n ∧ n ≤ ⌊2 * x⌋₊ + h := by
      rcases hcases n hn with ⟨hs, _⟩ | ⟨ho, _⟩
      · have hb := Finset.mem_Icc.mp hs
        exact ⟨by omega, hb.2⟩
      · have hb := Finset.mem_Icc.mp ho
        exact ⟨hb.1, hb.2.trans (Nat.le_add_right _ _)⟩
    have hlo : x ≤ (n : ℝ) := (Nat.le_ceil x).trans (Nat.cast_le.mpr hbounds.1)
    have hhi : (n : ℝ) ≤ (⌊2 * x⌋₊ : ℝ) + h := by exact_mod_cast hbounds.2
    have hfloor := Nat.floor_le (show 0 ≤ 2 * x by positivity)
    exact ⟨Nat.cast_pos.mp (hx0.trans_le hlo), by linarith⟩
  have henv (n : ℕ) (hn : n ∈ u.support) : ‖u n‖ ≤ C * x ^ ε := by
    have hn0 : n ≠ 0 := (hrange n hn).1.ne'
    have hnon0 := exceptionalPrimeDefect_nonneg x 0 n
    have hnon1 := exceptionalPrimeDefect_nonneg x 1 n
    have hb0 := hdefect x 0 n hn0
    have hb1 := hdefect x 1 n hn0
    have hp0 : 0 ≤ (if n.Prime then (1 : ℝ) else 0) := by split_ifs <;> norm_num
    have hp1 : (if n.Prime then (1 : ℝ) else 0) ≤ 1 := by split_ifs <;> norm_num
    have hreal : |(if n.Prime then (1 : ℝ) else 0) -
        exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n| ≤
          1 + 2 * Cd * (n : ℝ) ^ ε := by
      apply abs_le.mpr
      constructor <;> linarith
    have hf : ‖f n‖ ≤ 1 + 2 * Cd * (n : ℝ) ^ ε := by
      simpa only [f, ← Complex.ofReal_sub, Complex.norm_real, Real.norm_eq_abs] using hreal
    have huf : ‖u n‖ = ‖f n‖ := by
      rcases hcases n hn with ⟨hs, ho⟩ | ⟨ho, hs⟩
      · rw [hvalue, ite_eq_left hs, ite_eq_right ho, sub_zero]
      · rw [hvalue, ite_eq_right hs, ite_eq_left ho, zero_sub, norm_neg]
    rw [huf]
    calc
      _ ≤ 1 + 2 * Cd * (3 * x) ^ ε := by
        apply hf.trans
        gcongr
        exact (hrange n hn).2
      _ = 1 + 2 * Cd * (3 : ℝ) ^ ε * x ^ ε := by
        rw [Real.mul_rpow (by norm_num : (0 : ℝ) ≤ 3) hx0.le]
        ring
      _ ≤ C * x ^ ε := by dsimp [C]; nlinarith only [hxε]
  let M : ℝ := ∑ n ∈ u.support, ‖u n‖
  have hM0 : 0 ≤ M := Finset.sum_nonneg fun _ _ => norm_nonneg _
  have hM : M ≤ (2 * h : ℕ) * (C * x ^ ε) := by
    calc
      _ ≤ ∑ _n ∈ u.support, C * x ^ ε := Finset.sum_le_sum henv
      _ = (u.support.card : ℝ) * (C * x ^ ε) := by simp
      _ ≤ _ := mul_le_mul_of_nonneg_right (Nat.cast_le.mpr hcard) (by positivity)
  have hmask (p : ℕ → Prop) [DecidablePred p] :
      ‖∑ n ∈ u.support, if p n then u n else 0‖ ≤ M := by
    apply (norm_sum_le _ _).trans
    apply Finset.sum_le_sum
    intro n _hn
    split_ifs <;> simp
  have hdelta (q b : ℕ) (hq : 0 < q) :
      ‖fullDiscrepancy u q b‖ ≤ F * x ^ ε := by
    have hφ : (1 : ℝ) ≤ q.totient := by
      exact_mod_cast Nat.totient_pos.mpr hq
    have hprogress : ‖progressionMass u q b‖ ≤ M := hmask (fun n => n % q = b % q)
    have hreduced : ‖reducedMass u q‖ ≤ M := hmask (fun n => Nat.Coprime n q)
    rw [fullDiscrepancy]
    calc
      _ ≤ M + M / (q.totient : ℝ) := norm_sub_le_of_le hprogress (by
        rw [norm_div, Complex.norm_natCast]
        exact div_le_div_of_nonneg_right hreduced (Nat.cast_nonneg _))
      _ ≤ 2 * M := by linarith only [div_le_self hM0 hφ]
      _ ≤ 2 * ((2 * h : ℕ) * (C * x ^ ε)) := mul_le_mul_of_nonneg_left hM (by norm_num)
      _ ≤ F * x ^ ε := by
        dsimp [F]
        push_cast
        nlinarith only [mul_nonneg hC.le (Real.rpow_nonneg hx0.le ε)]
  have hweight (q : ℕ) (hq : q ∈ Finset.Icc 1 ⌊x ^ θ⌋₊) :
      (q.divisors.card : ℝ) ^ J ≤ Cq * x ^ ε := by
    obtain ⟨hqpos, hqle⟩ := Finset.mem_Icc.mp hq
    have hqx : (q : ℝ) ≤ x :=
      ((Nat.cast_le.mpr hqle).trans
        (Nat.floor_le (zero_le_one.trans (Real.one_le_rpow hx1 hθ0.le)))).trans
        (Real.rpow_le_self_of_one_le hx1 hθ1.le)
    exact (hdivisor q (Nat.ne_zero_of_lt hqpos)).trans
      (mul_le_mul_of_nonneg_left (Real.rpow_le_rpow (Nat.cast_nonneg _) hqx hε.le) hCq.le)
  have hpower :
      (∑ q ∈ Finset.Icc 1 ⌊x ^ θ⌋₊, (q.divisors.card : ℝ) ^ J *
        ‖fullDiscrepancy u q (a q)‖) ≤ K * x ^ β := by
    calc
      _ ≤ ∑ _q ∈ Finset.Icc 1 ⌊x ^ θ⌋₊, (Cq * x ^ ε) * (F * x ^ ε) := by
        apply Finset.sum_le_sum
        intro q hq
        exact mul_le_mul (hweight q hq) (hdelta q (a q) (Finset.mem_Icc.mp hq).1)
          (norm_nonneg _) (by positivity)
      _ = (⌊x ^ θ⌋₊ : ℝ) * ((Cq * x ^ ε) * (F * x ^ ε)) := by simp
      _ ≤ x ^ θ * ((Cq * x ^ ε) * (F * x ^ ε)) :=
        mul_le_mul_of_nonneg_right (Nat.floor_le (Real.rpow_nonneg hx0.le θ)) (by positivity)
      _ = K * x ^ β := by
        dsimp only [K, β]
        rw [show θ + 2 * ε = (θ + ε) + ε by ring,
          Real.rpow_add hx0, Real.rpow_add hx0]
        ring
  have hxxlog : Xlog ≤ x := (le_max_left _ _).trans ((le_max_left _ _).trans hx)
  have hlog0 : 0 < Real.log x := Real.log_pos (lt_of_lt_of_le (by norm_num : (1 : ℝ) < 2) hx2)
  have hlogbound : (Real.log x) ^ A ≤ x ^ γ := by
    simpa only [Real.norm_of_nonneg (Real.rpow_nonneg hlog0.le A),
      Real.norm_of_nonneg (Real.rpow_nonneg hx0.le γ), one_mul] using hXlog x hxxlog
  have habsorb : x ^ β ≤ x / (Real.log x) ^ A := by
    apply (le_div_iff₀ (Real.rpow_pos_of_pos hlog0 A)).mpr
    calc
      _ ≤ x ^ β * x ^ γ := mul_le_mul_of_nonneg_left hlogbound (Real.rpow_nonneg hx0.le β)
      _ = x := by
        rw [← Real.rpow_add hx0, show β + γ = 1 by dsimp [γ]; ring, Real.rpow_one]
  exact hpower.trans (by
    simpa only [mul_div_assoc] using mul_le_mul_of_nonneg_left habsorb hK.le)

end

section
open scoped ContDiff

open Classical in
theorem exceptionalPrimeDefect_compact_tuple_pointwise :
    ∀ᶠ x : ℝ in atTop, ∀ j : Fin 2,
    let P : Finset ℕ :=
      (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((6 : ℝ) / 25)⌋₊).filter Nat.Prime
    let T := Fintype.piFinset (fun _ : Fin 5 => P)
    let C (p : Fin 5 → ℕ) : Prop :=
      let α : Fin 5 → ℝ := fun i => Real.logb x (p i : ℝ)
      if j.val = 0 then
        (9519 : ℝ) / 50000 ≤ α 3 ∧
        α 3 < α 2 ∧ α 2 < α 1 ∧ α 1 < α 0 ∧
        α 0 < (40481 : ℝ) / 100000 ∧
        α 0 + α 1 < (40481 : ℝ) / 100000 ∧
        (59519 : ℝ) / 100000 < α 1 + α 2 + α 3 ∧
        (p 3 : ℝ) ≤ (p 4 : ℝ)
      else
        (∀ i, (9519 : ℝ) / 50000 ≤ α i ∧
          α i ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
        α 1 < α 0 ∧ α 1 < α 2 ∧
        α 0 + α 2 < (40481 : ℝ) / 100000 ∧
        (59519 : ℝ) / 100000 < α 0 + α 1 + α 3 ∧ α 3 ≤ α 4
    ∀ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
      exceptionalPrimeDefect x j n =
        ∑ p ∈ T, if (∏ i, p i) = n ∧ C p then (1 : ℝ) else 0 := by
  filter_upwards [exceptionalPrimeDefect_interval_as_compact_tuple,
    eventually_gt_atTop (1 : ℝ)] with x hx hx1
  intro j P T C n hn
  have hx0 : 0 < x := zero_lt_one.trans hx1
  have hnx : x ≤ (n : ℝ) :=
    (Nat.le_ceil x).trans (Nat.cast_le.mpr (Finset.mem_Icc.mp hn).1)
  have hnx2 : (n : ℝ) ≤ 2 * x :=
    (Nat.cast_le.mpr (Finset.mem_Icc.mp hn).2).trans
      (Nat.floor_le (by positivity))
  have hu : 1 ≤ (n : ℝ) / x := (le_div_iff₀ hx0).mpr (by simpa using hnx)
  have hv : (n : ℝ) / x ≤ 2 := (div_le_iff₀ hx0).mpr (by nlinarith only [hnx2])
  have heq := hx j ((n : ℝ) / x) ((n : ℝ) / x) hu le_rfl hv
  have hcancel : ((n : ℝ) / x) * x = n := div_mul_cancel₀ _ hx0.ne'
  simpa only [hcancel, Nat.ceil_natCast, Nat.floor_natCast, Finset.Icc_self,
    Finset.sum_singleton, Finset.mem_singleton] using heq

open Classical in
theorem exceptionalPrimeDefect_weighted_interval_as_compact_tuple :
    ∀ᶠ x : ℝ in atTop, ∀ j : Fin 2,
    let P : Finset ℕ :=
      (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((6 : ℝ) / 25)⌋₊).filter Nat.Prime
    let T := Fintype.piFinset (fun _ : Fin 5 => P)
    let C (p : Fin 5 → ℕ) : Prop :=
      let α : Fin 5 → ℝ := fun i => Real.logb x (p i : ℝ)
      if j.val = 0 then
        (9519 : ℝ) / 50000 ≤ α 3 ∧
        α 3 < α 2 ∧ α 2 < α 1 ∧ α 1 < α 0 ∧
        α 0 < (40481 : ℝ) / 100000 ∧
        α 0 + α 1 < (40481 : ℝ) / 100000 ∧
        (59519 : ℝ) / 100000 < α 1 + α 2 + α 3 ∧
        (p 3 : ℝ) ≤ (p 4 : ℝ)
      else
        (∀ i, (9519 : ℝ) / 50000 ≤ α i ∧
          α i ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
        α 1 < α 0 ∧ α 1 < α 2 ∧
        α 0 + α 2 < (40481 : ℝ) / 100000 ∧
        (59519 : ℝ) / 100000 < α 0 + α 1 + α 3 ∧ α 3 ≤ α 4
    ∀ w : ℕ → ℂ,
      (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        w n * (exceptionalPrimeDefect x j n : ℂ)) =
      ∑ p ∈ T,
        if (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧ C p
        then w (∏ i, p i) else 0 := by
  filter_upwards [exceptionalPrimeDefect_compact_tuple_pointwise] with x hx
  intro j P T C w
  let S := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
  have hpoint (n : ℕ) (hn : n ∈ S) :
      (exceptionalPrimeDefect x j n : ℂ) =
        ∑ p ∈ T, if (∏ i, p i) = n ∧ C p then (1 : ℂ) else 0 := by
    have h : exceptionalPrimeDefect x j n =
        ∑ p ∈ T, if (∏ i, p i) = n ∧ C p then (1 : ℝ) else 0 := hx j n hn
    have hc := congrArg (fun t : ℝ => (t : ℂ)) h
    push_cast at hc
    refine hc.trans (Finset.sum_congr rfl ?_)
    intro p hp
    split_ifs <;> norm_num
  change (∑ n ∈ S, w n * (exceptionalPrimeDefect x j n : ℂ)) = _
  calc
    _ = ∑ n ∈ S, ∑ p ∈ T,
        if (∏ i, p i) = n ∧ C p then w n else 0 := by
      apply Finset.sum_congr rfl
      intro n hn
      rw [hpoint n hn, Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro p hp
      split_ifs <;> simp
    _ = ∑ p ∈ T, ∑ n ∈ S,
        if (∏ i, p i) = n ∧ C p then w n else 0 := Finset.sum_comm
    _ = ∑ p ∈ T,
        if (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧ C p
        then w (∏ i, p i) else 0 := by
      apply Finset.sum_congr rfl
      intro p hp
      by_cases hc : C p
      · simp only [hc, and_true, Finset.sum_ite_eq, S]
      · simp only [hc, and_false, ite_false, Finset.sum_const_zero]

end

section
open scoped ContDiff

theorem sum_divisorsAntidiagonal_mul_prime
    {α : Type*} [AddCommMonoid α] (p m : ℕ) (hp : Nat.Prime p)
    (hcop : Nat.Coprime p m) (F : ℕ → ℕ → α) :
    (∑ d ∈ (p * m).divisorsAntidiagonal, F d.1 d.2) =
      ∑ d ∈ m.divisorsAntidiagonal, (F (p * d.1) d.2 + F d.1 (p * d.2)) := by
  classical
  rw [Nat.sum_divisorsAntidiagonal F, Nat.divisors_mul, Finset.mul_def,
    Finset.sum_image hcop.mul_injOn_divisors, Finset.sum_product,
    Nat.sum_divisorsAntidiagonal (fun a b => F (p * a) b + F a (p * b)),
    hp.divisors, Finset.sum_pair (Ne.symm hp.ne_one)]
  simp only [one_mul]
  rw [← Finset.sum_add_distrib]
  apply Finset.sum_congr rfl
  intro d hd
  rw [Nat.mul_div_mul_left _ _ hp.pos,
    Nat.mul_div_assoc p (Nat.mem_divisors.mp hd).1]
  exact add_comm _ _

theorem sum_three_divisors_mul_prime
    {α : Type*} [AddCommMonoid α] (p m : ℕ) (hp : Nat.Prime p)
    (hcop : Nat.Coprime p m) (F : ℕ → ℕ → ℕ → α) :
    (∑ a ∈ (p * m).divisorsAntidiagonal,
      ∑ b ∈ a.2.divisorsAntidiagonal, F a.1 b.1 b.2) =
      ∑ a ∈ m.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
        (F (p * a.1) b.1 b.2 + F a.1 (p * b.1) b.2 + F a.1 b.1 (p * b.2)) := by
  classical
  rw [sum_divisorsAntidiagonal_mul_prime p m hp hcop
    (fun s dk => ∑ b ∈ dk.divisorsAntidiagonal, F s b.1 b.2)]
  refine Finset.sum_congr rfl fun a ha => ?_
  rw [sum_divisorsAntidiagonal_mul_prime p a.2 hp
    (hcop.coprime_dvd_right (Nat.dvd_of_mem_divisors
      (Nat.snd_mem_divisors_of_mem_antidiagonal ha))) (F a.1)]
  simp only [← Finset.sum_add_distrib, add_assoc]

end

section
open scoped ContDiff

open Classical in
theorem harmanA_largest_prime_window_split
    (p m : ℕ) (hp : Nat.Prime p) (hm : 0 < m)
    (hmax : ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p)
    (u : ℕ → ℤ) (z H : ℝ) (hz : 0 < z) (hH : 0 < H) :
    (∑ rh ∈ (p * m).divisorsAntidiagonal,
      u rh.1 *
        (if 1 < rh.2 ∧ ((max 1 (rh.2.primeFactors.sup id) : ℕ) : ℝ) < z ∧
            (rh.1 : ℝ) < H ∧ (((rh.1 * rh.2) / rh.2.minFac : ℕ) : ℝ) < H ∧
            H ≤ ((rh.1 * rh.2 : ℕ) : ℝ)
        then ArithmeticFunction.moebius rh.2 else 0)) =
    ∑ rd ∈ m.divisorsAntidiagonal,
      (u (p * rd.1) *
          (if 1 < rd.2 ∧ ((max 1 (rd.2.primeFactors.sup id) : ℕ) : ℝ) < z then
            if p ∈ Finset.Icc
                (max (m.primeFactors.sup id + 1) (Nat.ceil (H / (m : ℝ))))
                (min (Nat.ceil (H * (rd.2.minFac : ℝ) / (m : ℝ)) - 1)
                  (Nat.ceil (H / (rd.1 : ℝ)) - 1))
            then ArithmeticFunction.moebius rd.2 else 0
          else 0) +
        u rd.1 *
          (if (rd.1 : ℝ) < H then
            if p ∈ (if rd.2 = 1 then
                Finset.Icc (Nat.ceil (H / (rd.1 : ℝ))) (Nat.ceil z - 1)
              else
                Finset.Icc (Nat.ceil (H / ((rd.1 * rd.2 : ℕ) : ℝ)))
                  (min (Nat.ceil z - 1)
                    (Nat.ceil (H * (rd.2.minFac : ℝ) /
                      ((rd.1 * rd.2 : ℕ) : ℝ)) - 1)))
            then -ArithmeticFunction.moebius rd.2 else 0
          else 0)) := by
  let F (r h : ℕ) : ℤ := u r *
    (if 1 < h ∧ ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧
        (r : ℝ) < H ∧ (((r * h) / h.minFac : ℕ) : ℝ) < H ∧
        H ≤ ((r * h : ℕ) : ℝ)
    then ArithmeticFunction.moebius h else 0)
  have hcop : Nat.Coprime p m := hp.coprime_iff_not_dvd.mpr
    (fun hpm => (lt_irrefl p) (hmax p hp hpm))
  change (∑ rh ∈ (p * m).divisorsAntidiagonal, F rh.1 rh.2) = _
  rw [sum_divisorsAntidiagonal_mul_prime p m hp hcop F]
  apply Finset.sum_congr rfl
  intro rd hrd
  have hprod : rd.1 * rd.2 = m := (Nat.mem_divisorsAntidiagonal.mp hrd).1
  have hr : 0 < rd.1 := by
    apply Nat.pos_of_ne_zero
    intro hzero
    have : m = 0 := by simpa only [hzero, zero_mul] using hprod.symm
    exact hm.ne' this
  have hd : 0 < rd.2 := by
    apply Nat.pos_of_ne_zero
    intro hzero
    have : m = 0 := by simpa only [hzero, mul_zero] using hprod.symm
    exact hm.ne' this
  have hmaxd : ∀ t : ℕ, Nat.Prime t → t ∣ rd.2 → t < p := by
    intro t ht htd
    apply hmax t ht
    rw [← hprod]
    exact dvd_mul_of_dvd_right htd rd.1
  have hnamed := harmanA_named_prime_window_indicator p rd.1 rd.2 m hp hr hm
    hprod z H hH
  have hnamed' :
      (if 1 < rd.2 ∧ ((max 1 (rd.2.primeFactors.sup id) : ℕ) : ℝ) < z ∧
          ((p * rd.1 : ℕ) : ℝ) < H ∧ (((p * m) / rd.2.minFac : ℕ) : ℝ) < H ∧
          H ≤ ((p * m : ℕ) : ℝ)
        then ArithmeticFunction.moebius rd.2 else 0) =
      (if 1 < rd.2 ∧ ((max 1 (rd.2.primeFactors.sup id) : ℕ) : ℝ) < z then
        if p ∈ Finset.Icc
            (max (m.primeFactors.sup id + 1) (Nat.ceil (H / (m : ℝ))))
            (min (Nat.ceil (H * (rd.2.minFac : ℝ) / (m : ℝ)) - 1)
              (Nat.ceil (H / (rd.1 : ℝ)) - 1))
        then ArithmeticFunction.moebius rd.2 else 0
      else 0) := by
    simpa only [eq_true hmax, true_and, and_assoc, and_left_comm, and_comm] using hnamed
  have hmobius := harmanA_mobius_prime_window_indicator p rd.1 rd.2 hp hr hd
    hmaxd z H hz hH
  have hnamedProduct : (p * rd.1) * rd.2 = p * m := by
    rw [Nat.mul_assoc, hprod]
  dsimp only [F]
  rw [hnamedProduct, hnamed', hmobius]

theorem sum_four_divisors_mul_prime
    {α : Type*} [AddCommMonoid α] (p m : ℕ) (hp : Nat.Prime p)
    (hcop : Nat.Coprime p m) (F : ℕ → ℕ → ℕ → ℕ → α) :
    (∑ a ∈ (p * m).divisorsAntidiagonal,
      ∑ b ∈ a.2.divisorsAntidiagonal, ∑ c ∈ b.2.divisorsAntidiagonal,
        F a.1 b.1 c.1 c.2) =
      ∑ a ∈ m.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
        ∑ c ∈ b.2.divisorsAntidiagonal,
          (F (p * a.1) b.1 c.1 c.2 + F a.1 (p * b.1) c.1 c.2 +
            F a.1 b.1 (p * c.1) c.2 + F a.1 b.1 c.1 (p * c.2)) := by
  classical
  rw [sum_divisorsAntidiagonal_mul_prime p m hp hcop
    (fun s t => ∑ b ∈ t.divisorsAntidiagonal,
      ∑ c ∈ b.2.divisorsAntidiagonal, F s b.1 c.1 c.2)]
  refine Finset.sum_congr rfl fun a ha => ?_
  rw [sum_three_divisors_mul_prime p a.2 hp
    (hcop.coprime_dvd_right (Nat.dvd_of_mem_divisors
      (Nat.snd_mem_divisors_of_mem_antidiagonal ha))) (F a.1)]
  simp only [← Finset.sum_add_distrib, add_assoc]

open Classical in
theorem fullDiscrepancy_sample_le_positive_majorant
    (S : Finset ℕ) (e : ℕ → ℂ) (g : ℕ → ℝ)
    (hg : ∀ n ∈ S, 0 ≤ g n) (heg : ∀ n ∈ S, ‖e n‖ ≤ g n)
    (q a : ℕ) :
    ‖fullDiscrepancy (∑ n ∈ S, Finsupp.single n (e n)) q a‖ ≤
      ‖fullDiscrepancy (∑ n ∈ S, Finsupp.single n (g n : ℂ)) q a‖ +
        2 * (∑ n ∈ S, g n) / (q.totient : ℝ) := by
  let P : ℝ := ∑ n ∈ S, if n % q = a % q then g n else 0
  let R : ℝ := ∑ n ∈ S, if Nat.Coprime n q then g n else 0
  let M : ℝ := ∑ n ∈ S, g n
  have hP : 0 ≤ P := Finset.sum_nonneg fun n hn => by
    split_ifs <;> simp_all
  have hR : 0 ≤ R := Finset.sum_nonneg fun n hn => by
    split_ifs <;> simp_all
  have hRM : R ≤ M := Finset.sum_le_sum fun n hn => by
    split_ifs <;> simp_all
  have hprogress :
      ‖∑ n ∈ S, if n % q = a % q then e n else 0‖ ≤ P := by
    apply (norm_sum_le _ _).trans
    apply Finset.sum_le_sum
    intro n hn
    split_ifs <;> simp_all
  have hreduced :
      ‖∑ n ∈ S, if Nat.Coprime n q then e n else 0‖ ≤ R := by
    apply (norm_sum_le _ _).trans
    apply Finset.sum_le_sum
    intro n hn
    split_ifs <;> simp_all
  have hfirst :
      ‖fullDiscrepancy (∑ n ∈ S, Finsupp.single n (e n)) q a‖ ≤
        P + R / (q.totient : ℝ) := by
    have hδ := fullDiscrepancy_sample S e q a
    rw [Finset.sum_sub_distrib, ← Finset.sum_div] at hδ
    rw [hδ]
    apply (norm_sub_le _ _).trans
    rw [norm_div, Complex.norm_natCast]
    exact add_le_add hprogress
      (div_le_div_of_nonneg_right hreduced (Nat.cast_nonneg _))
  have hreal :
      fullDiscrepancy (∑ n ∈ S, Finsupp.single n (g n : ℂ)) q a =
        ((P - R / (q.totient : ℝ) : ℝ) : ℂ) := by
    rw [fullDiscrepancy_sample, Finset.sum_sub_distrib, Finset.sum_div]
    dsimp only [P, R]
    push_cast
    congr 1 <;> apply Finset.sum_congr rfl <;>
      intro n hn <;> split_ifs <;> rfl
  rw [hreal, Complex.norm_real, Real.norm_eq_abs]
  have hdiv : R / (q.totient : ℝ) ≤ M / (q.totient : ℝ) :=
    div_le_div_of_nonneg_right hRM (Nat.cast_nonneg _)
  have habs := le_abs_self (P - R / (q.totient : ℝ))
  change _ ≤ |P - R / (q.totient : ℝ)| + 2 * M / (q.totient : ℝ)
  calc
    _ ≤ P + R / (q.totient : ℝ) := hfirst
    _ ≤ |P - R / (q.totient : ℝ)| + 2 * (M / (q.totient : ℝ)) := by
      linarith only [hdiv, habs]
    _ = _ := by ring

open Classical in
theorem fullDiscrepancy_indexed_sample
    {α : Type*} (S : Finset α) (v : α → ℕ) (f : α → ℂ) (q a : ℕ) :
    fullDiscrepancy (∑ t ∈ S, Finsupp.single (v t) (f t)) q a =
      ∑ t ∈ S, f t *
        ((if v t % q = a % q then (1 : ℂ) else 0) -
          (if Nat.Coprime (v t) q then (1 : ℂ) else 0) / (q.totient : ℂ)) := by
  rw [fullDiscrepancy_eq_finsupp_sum]
  rw [← Finsupp.sum_finsetSum_index
    (fun n => by simp)
    (fun n z w => by split_ifs <;> ring)]
  apply Finset.sum_congr rfl
  intro t _ht
  rw [Finsupp.sum_single_index (by simp)]
  split_ifs <;> ring

end

open Classical in
theorem harmanA_named_good_part_prime_windows
    (N Y r0 : ℕ) (j : Fin 2) (P : ℕ → ℕ → Prop) (L U : ℕ → ℕ → ℝ)
    (z H nlo nhi : ℝ) (_hz : 0 < z) (hH : 0 < H) (b : Bool) :
    let A0 : ℕ → ℤ := fun n =>
      ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
        if (if j = 0 then aa.1 = 1 else
            Nat.Prime aa.1 ∧ z ≤ (aa.1 : ℝ) ∧ aa.1 ≤ bb.1) ∧
            Nat.Prime bb.1 ∧ z ≤ (bb.1 : ℝ) ∧ 1 < bb.2 ∧
            ((max 1 (bb.2.primeFactors.sup id) : ℕ) : ℝ) < z ∧ P aa.1 bb.2 ∧
            L aa.1 bb.2 ≤ (bb.1 : ℝ) ∧ (bb.1 : ℝ) ≤ U aa.1 bb.2 ∧
            ((aa.1 * bb.1 : ℕ) : ℝ) < H ∧ (((n / bb.2.minFac : ℕ) : ℝ)) < H ∧
            H ≤ (n : ℝ)
        then (if b then |ArithmeticFunction.moebius bb.2| else ArithmeticFunction.moebius bb.2)
        else 0
    let C : ℕ → ℕ → ℤ := fun q h =>
      if (if j = 0 then q = 1 else Nat.Prime q ∧ z ≤ (q : ℝ)) ∧
          1 < h ∧ ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧ P q h
      then (if b then |ArithmeticFunction.moebius h| else ArithmeticFunction.moebius h)
      else 0
    let WW : ℕ → ℕ → ℕ → Finset ℕ := fun m q h =>
      Finset.Icc
        (max (Y + 1) (max (m.primeFactors.sup id + 1)
          (max (Nat.ceil (nlo / (m : ℝ))) (max (Nat.ceil (H / (m : ℝ)))
            (max (Nat.ceil z) (max q (Nat.ceil (L q h))))))))
        (min (N / m) (min (Nat.floor (nhi / (m : ℝ)))
          (min (Nat.floor (U q h))
            (min (Nat.ceil (H * (h.minFac : ℝ) / (m : ℝ)) - 1)
              (Nat.ceil (H / (q : ℝ)) - 1)))))
    (∑ n ∈ (Finset.Icc 1 N).filter (fun n =>
        n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
          ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ n),
      Finsupp.single n (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
        then (A0 n : ℂ) else 0)) =
    ∑ m ∈ (Finset.Icc 1 (N / (Y + 1))).filter (fun m =>
        ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ m),
      ∑ qh ∈ m.divisorsAntidiagonal, ∑ p ∈ (WW m qh.1 qh.2).filter Nat.Prime,
        Finsupp.single (m * p)
          (if Nat.Coprime (m * p) r0 then (C qh.1 qh.2 : ℂ) else 0) := by
  intro A0 C WW
  rw [good_integer_largest_prime_finsupp_reindex_truncated]
  apply Finset.sum_congr rfl
  intro m hm
  have hm0 : 0 < m := (Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1).1
  let T : Finset ℕ := (Finset.Icc (Y + 1) (N / m)).filter (fun p =>
    Nat.Prime p ∧ ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p)
  let V : ℕ → ℕ → Finset ℕ := fun q h =>
    Finset.Icc
      (max (m.primeFactors.sup id + 1)
        (max (Nat.ceil (nlo / (m : ℝ))) (max (Nat.ceil (H / (m : ℝ)))
          (max (Nat.ceil z) (max q (Nat.ceil (L q h)))))))
      (min (Nat.floor (nhi / (m : ℝ)))
        (min (Nat.floor (U q h))
          (min (Nat.ceil (H * (h.minFac : ℝ) / (m : ℝ)) - 1)
            (Nat.ceil (H / (q : ℝ)) - 1))))
  have hwindow (p q h : ℕ) (hp : Nat.Prime p) (hq : 0 < q) (hprod : q * h = m) :
      p ∈ V q h ↔ (∀ t : ℕ, Nat.Prime t → t ∣ m → t < p) ∧
        nlo ≤ ((p * m : ℕ) : ℝ) ∧ ((p * m : ℕ) : ℝ) ≤ nhi ∧
        z ≤ (p : ℝ) ∧ q ≤ p ∧ L q h ≤ (p : ℝ) ∧ (p : ℝ) ≤ U q h ∧
        ((p * q : ℕ) : ℝ) < H ∧ (((p * m) / h.minFac : ℕ) : ℝ) < H ∧
        H ≤ ((p * m : ℕ) : ℝ) := by
    have hcross := harmanA_named_prime_window_iff p q h m hp hq hm0 hprod H hH
    simp only [Finset.mem_Icc, max_le_iff, le_min_iff] at hcross
    have hlo : Nat.ceil (nlo / (m : ℝ)) ≤ p ↔ nlo ≤ ((p * m : ℕ) : ℝ) := by
      simp only [Nat.cast_mul]
      rw [Nat.ceil_le, div_le_iff₀ (Nat.cast_pos.mpr hm0)]
    have hhi : p ≤ Nat.floor (nhi / (m : ℝ)) ↔ ((p * m : ℕ) : ℝ) ≤ nhi := by
      simp only [Nat.cast_mul]
      rw [Nat.le_floor_iff' hp.ne_zero, le_div_iff₀ (Nat.cast_pos.mpr hm0)]
    have hzl : Nat.ceil z ≤ p ↔ z ≤ (p : ℝ) := Nat.ceil_le
    have hL : Nat.ceil (L q h) ≤ p ↔ L q h ≤ (p : ℝ) := Nat.ceil_le
    have hU : p ≤ Nat.floor (U q h) ↔ (p : ℝ) ≤ U q h := Nat.le_floor_iff' hp.ne_zero
    simp only [V, Finset.mem_Icc, max_le_iff, le_min_iff]
    constructor
    · rintro ⟨⟨hmaxp, hlop, hHp, hzp, hqp, hLp⟩, hhip, hUp, hminp, hqHp⟩
      have hc := hcross.mpr ⟨⟨hmaxp, hHp⟩, hminp, hqHp⟩
      exact ⟨hc.1, hlo.mp hlop, hhi.mp hhip, hzl.mp hzp, hqp,
        hL.mp hLp, hU.mp hUp, hc.2.2.2, hc.2.1, hc.2.2.1⟩
    · rintro ⟨hmaxp, hlop, hhip, hzp, hqp, hLp, hUp, hqHp, hminp, hHp⟩
      have hc := hcross.mp ⟨hmaxp, hminp, hHp, hqHp⟩
      exact ⟨⟨hc.1.1, hlo.mpr hlop, hc.1.2, hzl.mpr hzp, hqp, hL.mpr hLp⟩,
        hhi.mpr hhip, hU.mpr hUp, hc.2.1, hc.2.2⟩
  let R : ℕ → ℕ → ℕ → ℤ := fun q h p =>
    if (if j = 0 then q = 1 else Nat.Prime q ∧ z ≤ (q : ℝ) ∧ q ≤ p) ∧
        Nat.Prime p ∧ z ≤ (p : ℝ) ∧ 1 < h ∧
        ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧ P q h ∧
        L q h ≤ (p : ℝ) ∧ (p : ℝ) ≤ U q h ∧ ((q * p : ℕ) : ℝ) < H ∧
        (((p * m) / h.minFac : ℕ) : ℝ) < H ∧ H ≤ ((p * m : ℕ) : ℝ)
    then (if b then |ArithmeticFunction.moebius h| else ArithmeticFunction.moebius h)
    else 0
  let S : ℕ → ℕ → ℕ → ℕ →₀ ℂ := fun q h p =>
    Finsupp.single (m * p) (if Nat.Coprime (m * p) r0 then
      (if p ∈ V q h then (C q h : ℂ) else 0) else 0)
  have hpoint (p : ℕ) (hpT : p ∈ T) :
      Finsupp.single (m * p)
        (if nlo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ nhi ∧
            Nat.Coprime (m * p) r0 then (A0 (m * p) : ℂ) else 0) =
      ∑ qh ∈ m.divisorsAntidiagonal, S qh.1 qh.2 p := by
    obtain ⟨hp, hmax⟩ := (Finset.mem_filter.mp hpT).2
    have hsource0 : A0 (p * m) =
        ∑ qh ∈ m.divisorsAntidiagonal, R qh.1 qh.2 p := by
      let F : ℕ → ℕ → ℕ → ℤ := fun q r h =>
        if (if j = 0 then q = 1 else Nat.Prime q ∧ z ≤ (q : ℝ) ∧ q ≤ r) ∧
            Nat.Prime r ∧ z ≤ (r : ℝ) ∧ 1 < h ∧
            ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧ P q h ∧
            L q h ≤ (r : ℝ) ∧ (r : ℝ) ≤ U q h ∧ ((q * r : ℕ) : ℝ) < H ∧
            (((p * m) / h.minFac : ℕ) : ℝ) < H ∧ H ≤ ((p * m : ℕ) : ℝ)
        then (if b then |ArithmeticFunction.moebius h| else ArithmeticFunction.moebius h)
        else 0
      have hcop := (harmanA_mobius_prime_factor_data p m hp hm0 hmax).2.1
      change (∑ aa ∈ (p * m).divisorsAntidiagonal,
        ∑ bb ∈ aa.2.divisorsAntidiagonal, F aa.1 bb.1 bb.2) = _
      rw [sum_three_divisors_mul_prime p m hp hcop F]
      apply Finset.sum_congr rfl
      intro aa haa
      have haq : 0 < aa.1 :=
        Nat.pos_of_ne_zero (Nat.left_ne_zero_of_mem_divisorsAntidiagonal haa)
      have ham : aa.2 ∣ m :=
        (Nat.mem_divisors.mp (Nat.snd_mem_divisors_of_mem_antidiagonal haa)).1
      have hfirst (bb : ℕ × ℕ) (hbb : bb ∈ aa.2.divisorsAntidiagonal) :
          F (p * aa.1) bb.1 bb.2 = 0 := by
        dsimp only [F]
        apply ite_eq_right
        intro hc
        have hbm : bb.1 ∣ m :=
          (Nat.mem_divisors.mp (Nat.fst_mem_divisors_of_mem_antidiagonal hbb)).1.trans ham
        have hrp : bb.1 < p := hmax bb.1 hc.2.1 hbm
        have hle : p ≤ p * aa.1 := Nat.le_mul_of_pos_right p haq
        by_cases hj : j = 0
        · have heq : p * aa.1 = 1 := by simpa only [ite_eq_left hj] using hc.1
          have hp2 := hp.two_le
          omega
        · have hn : Nat.Prime (p * aa.1) ∧ z ≤ ((p * aa.1 : ℕ) : ℝ) ∧
              p * aa.1 ≤ bb.1 := by
            simpa only [ite_eq_right hj] using hc.1
          exact (not_lt_of_ge (hle.trans hn.2.2)) hrp
      have hthird (bb : ℕ × ℕ) (hbb : bb ∈ aa.2.divisorsAntidiagonal) :
          F aa.1 bb.1 (p * bb.2) = 0 := by
        have hbd : 0 < bb.2 :=
          Nat.pos_of_ne_zero (Nat.right_ne_zero_of_mem_divisorsAntidiagonal hbb)
        have hbm : bb.2 ∣ m :=
          (Nat.mem_divisors.mp (Nat.snd_mem_divisors_of_mem_antidiagonal hbb)).1.trans ham
        have hsup := (harmanA_mobius_prime_factor_data p bb.2 hp hbd
          (fun t ht htd => hmax t ht (htd.trans hbm))).2.2.2.1
        dsimp only [F]
        apply ite_eq_right
        intro hc
        have hrm : bb.1 ∣ m :=
          (Nat.mem_divisors.mp (Nat.fst_mem_divisors_of_mem_antidiagonal hbb)).1.trans ham
        have hrp : (bb.1 : ℝ) < (p : ℝ) := by
          exact_mod_cast hmax bb.1 hc.2.1 hrm
        have hpz : (p : ℝ) < z := by
          simpa only [hsup] using hc.2.2.2.2.1
        have hzr : z ≤ (bb.1 : ℝ) := hc.2.2.1
        linarith only [hpz, hzr, hrp]
      calc
        _ = ∑ bb ∈ aa.2.divisorsAntidiagonal, F aa.1 (p * bb.1) bb.2 := by
          apply Finset.sum_congr rfl
          intro bb hbb
          rw [hfirst bb hbb, hthird bb hbb, zero_add, add_zero]
        _ = F aa.1 p aa.2 := by
          rw [Finset.sum_eq_single (1, aa.2)]
          · simp only [mul_one]
          · intro bb hbb hne
            dsimp only [F]
            apply ite_eq_right
            intro hc
            have hb1 : bb.1 = 1 := by
              simpa only [Nat.prime_mul_iff, hp, hp.ne_one,
                true_and, and_false, or_false] using hc.2.1
            have hb2 : bb.2 = aa.2 := by
              have hmul := (Nat.mem_divisorsAntidiagonal.mp hbb).1
              simpa only [hb1, one_mul] using hmul
            exact hne (Prod.ext hb1 hb2)
          · intro hnot
            exact (hnot (Nat.mem_divisorsAntidiagonal.mpr
              ⟨one_mul _, Nat.right_ne_zero_of_mem_divisorsAntidiagonal haa⟩)).elim
        _ = R aa.1 aa.2 p := rfl
    have hsource : A0 (m * p) =
        ∑ qh ∈ m.divisorsAntidiagonal, R qh.1 qh.2 p := by
      simpa only [Nat.mul_comm m p] using hsource0
    have hnamed (q : ℕ) :
        (if j = 0 then q = 1 else Nat.Prime q ∧ z ≤ (q : ℝ) ∧ q ≤ p) ↔
          (if j = 0 then q = 1 else Nat.Prime q ∧ z ≤ (q : ℝ)) ∧ q ≤ p := by
      by_cases hj : j = 0
      · simp only [ite_eq_left hj]
        constructor
        · rintro rfl
          exact ⟨rfl, hp.one_lt.le⟩
        · exact And.left
      · simp only [ite_eq_right hj, and_assoc]
    have hind (qh : ℕ × ℕ) (hqh : qh ∈ m.divisorsAntidiagonal) :
        (if nlo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ nhi
          then R qh.1 qh.2 p else 0) = if p ∈ V qh.1 qh.2 then C qh.1 qh.2 else 0 := by
      have hq : 0 < qh.1 :=
        Nat.pos_of_ne_zero (Nat.left_ne_zero_of_mem_divisorsAntidiagonal hqh)
      have hw := hwindow p qh.1 qh.2 hp hq (Nat.mem_divisorsAntidiagonal.mp hqh).1
      have hpred :
          ((nlo ≤ ((p * m : ℕ) : ℝ) ∧ ((p * m : ℕ) : ℝ) ≤ nhi) ∧
            (if j = 0 then qh.1 = 1 else
              Nat.Prime qh.1 ∧ z ≤ (qh.1 : ℝ) ∧ qh.1 ≤ p) ∧
            Nat.Prime p ∧ z ≤ (p : ℝ) ∧ 1 < qh.2 ∧
            ((max 1 (qh.2.primeFactors.sup id) : ℕ) : ℝ) < z ∧ P qh.1 qh.2 ∧
            L qh.1 qh.2 ≤ (p : ℝ) ∧ (p : ℝ) ≤ U qh.1 qh.2 ∧
            ((qh.1 * p : ℕ) : ℝ) < H ∧
            (((p * m) / qh.2.minFac : ℕ) : ℝ) < H ∧ H ≤ ((p * m : ℕ) : ℝ)) ↔
          p ∈ V qh.1 qh.2 ∧
            (if j = 0 then qh.1 = 1 else Nat.Prime qh.1 ∧ z ≤ (qh.1 : ℝ)) ∧
            1 < qh.2 ∧ ((max 1 (qh.2.primeFactors.sup id) : ℕ) : ℝ) < z ∧ P qh.1 qh.2 := by
        constructor
        · rintro ⟨⟨hlo, hhi⟩, hn, _hp, hz, hh, hsmall, hP, hL, hU, hprod, hcross, hH⟩
          have hn' := (hnamed qh.1).mp hn
          have hprod' : ((p * qh.1 : ℕ) : ℝ) < H := by
            simpa only [Nat.mul_comm qh.1 p] using hprod
          exact ⟨hw.mpr ⟨hmax, hlo, hhi, hz, hn'.2, hL, hU, hprod', hcross, hH⟩,
            hn'.1, hh, hsmall, hP⟩
        · rintro ⟨hV, hn, hh, hsmall, hP⟩
          obtain ⟨_hmax, hlo, hhi, hz, hqp, hL, hU, hprod, hcross, hH⟩ := hw.mp hV
          have hprod' : ((qh.1 * p : ℕ) : ℝ) < H := by
            simpa only [Nat.mul_comm qh.1 p] using hprod
          exact ⟨⟨hlo, hhi⟩, (hnamed qh.1).mpr ⟨hn, hqp⟩, hp, hz, hh, hsmall,
            hP, hL, hU, hprod', hcross, hH⟩
      simp only [R, C, ← ite_and, Nat.mul_comm m p, hpred]
    have hscalar :
        (if nlo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ nhi
          then A0 (m * p) else 0) =
        ∑ qh ∈ m.divisorsAntidiagonal, if p ∈ V qh.1 qh.2 then C qh.1 qh.2 else 0 := by
      calc
        _ = ∑ qh ∈ m.divisorsAntidiagonal,
            if nlo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ nhi
            then R qh.1 qh.2 p else 0 := by
          rw [hsource]
          by_cases hlocal : nlo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ nhi
          · simp only [eq_true hlocal, ite_true]
          · simp only [eq_false hlocal, ite_false, Finset.sum_const_zero]
        _ = _ := Finset.sum_congr rfl hind
    by_cases hcop : Nat.Coprime (m * p) r0
    · have hcast := congrArg (fun a : ℤ => (a : ℂ)) hscalar
      simp only [Int.cast_sum, apply_ite (fun a : ℤ => (a : ℂ)), Int.cast_zero] at hcast
      have h := congrArg (Finsupp.single (m * p)) hcast
      simp only [Finsupp.single_finsetSum] at h
      simpa only [S, eq_true hcop, and_true, ite_true] using h
    · simp [S, hcop]
  have hclip (a c : ℕ)
      (hwin : ∀ p : ℕ, Nat.Prime p → p ∈ Finset.Icc a c →
        ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p) :
      T.filter (fun p => p ∈ Finset.Icc a c) =
        (Finset.Icc (max (Y + 1) a) (min (N / m) c)).filter Nat.Prime := by
    ext p
    simp only [T, Finset.mem_filter, Finset.mem_Icc, max_le_iff, le_min_iff]
    constructor
    · rintro ⟨⟨hbase, hp, hmax⟩, hab⟩
      exact ⟨⟨⟨hbase.1, hab.1⟩, ⟨hbase.2, hab.2⟩⟩, hp⟩
    · rintro ⟨⟨⟨hY, ha⟩, ⟨hN, hc⟩⟩, hp⟩
      exact ⟨⟨⟨hY, hN⟩, hp, hwin p hp (Finset.mem_Icc.mpr ⟨ha, hc⟩)⟩, ha, hc⟩
  have hW (qh : ℕ × ℕ) (hqh : qh ∈ m.divisorsAntidiagonal) :
      T.filter (fun p => p ∈ V qh.1 qh.2) = (WW m qh.1 qh.2).filter Nat.Prime := by
    apply hclip
    intro p hp hmem
    have hq : 0 < qh.1 :=
      Nat.pos_of_ne_zero (Nat.left_ne_zero_of_mem_divisorsAntidiagonal hqh)
    exact ((hwindow p qh.1 qh.2 hp hq (Nat.mem_divisorsAntidiagonal.mp hqh).1).mp hmem).1
  have hsum (qh : ℕ × ℕ) (hqh : qh ∈ m.divisorsAntidiagonal) :
      (∑ p ∈ T, S qh.1 qh.2 p) =
        ∑ p ∈ (WW m qh.1 qh.2).filter Nat.Prime,
          Finsupp.single (m * p)
            (if Nat.Coprime (m * p) r0 then (C qh.1 qh.2 : ℂ) else 0) := by
    rw [← hW qh hqh]
    conv_rhs => rw [Finset.sum_filter]
    apply Finset.sum_congr rfl
    intro p hp
    by_cases hmem : p ∈ V qh.1 qh.2 <;>
      by_cases hcop : Nat.Coprime (m * p) r0 <;> simp [S, hmem, hcop]
  change (∑ p ∈ T, Finsupp.single (m * p)
    (if nlo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ nhi ∧
      Nat.Coprime (m * p) r0 then (A0 (m * p) : ℂ) else 0)) = _
  calc
    _ = ∑ p ∈ T, ∑ qh ∈ m.divisorsAntidiagonal, S qh.1 qh.2 p :=
      Finset.sum_congr rfl hpoint
    _ = ∑ qh ∈ m.divisorsAntidiagonal, ∑ p ∈ T, S qh.1 qh.2 p := Finset.sum_comm
    _ = _ := Finset.sum_congr rfl hsum

open Classical in
theorem harmanA0_named_good_part_prime_windows
    (N Y r0 : ℕ) (j k : Fin 2) (P : ℕ → ℕ → ℕ → Prop)
    (L U : ℕ → ℕ → ℕ → ℝ) (z M0 nlo nhi : ℝ) (_hz : 0 < z) (b : Bool) :
    let A0 : ℕ → ℤ := fun n =>
      if (n : ℝ) ≤ M0 then
        ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
          ∑ cc ∈ bb.2.divisorsAntidiagonal,
            if Nat.Prime aa.1 ∧ z ≤ (aa.1 : ℝ) ∧
                (if j = 0 then bb.1 = 1 else Nat.Prime bb.1 ∧ z ≤ (bb.1 : ℝ)) ∧
                bb.1 ≤ aa.1 ∧
                (if k = 0 then cc.1 = 1 else Nat.Prime cc.1 ∧ z ≤ (cc.1 : ℝ)) ∧
                cc.1 ≤ aa.1 ∧ ((max 1 (cc.2.primeFactors.sup id) : ℕ) : ℝ) < z ∧
                P bb.1 cc.1 cc.2 ∧ L bb.1 cc.1 cc.2 ≤ (aa.1 : ℝ) ∧
                (aa.1 : ℝ) ≤ U bb.1 cc.1 cc.2
            then (if b then |ArithmeticFunction.moebius cc.2| else ArithmeticFunction.moebius cc.2)
            else 0
      else 0
    let C : ℕ → ℕ → ℕ → ℤ := fun q r h =>
      if (if j = 0 then q = 1 else Nat.Prime q ∧ z ≤ (q : ℝ)) ∧
          (if k = 0 then r = 1 else Nat.Prime r ∧ z ≤ (r : ℝ)) ∧
          ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧ P q r h
      then (if b then |ArithmeticFunction.moebius h| else ArithmeticFunction.moebius h)
      else 0
    let WW : ℕ → ℕ → ℕ → ℕ → Finset ℕ := fun m q r h =>
      Finset.Icc
        (max (Y + 1) (max (m.primeFactors.sup id + 1)
          (max q (max r (max (Nat.ceil z)
            (max (Nat.ceil (L q r h)) (Nat.ceil (nlo / (m : ℝ)))))))))
        (min (N / m) (min (Nat.floor (M0 / (m : ℝ)))
          (min (Nat.floor (U q r h)) (Nat.floor (nhi / (m : ℝ))))))
    (∑ n ∈ (Finset.Icc 1 N).filter (fun n =>
        n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
          ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ n),
      Finsupp.single n (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
        then (A0 n : ℂ) else 0)) =
    ∑ m ∈ (Finset.Icc 1 (N / (Y + 1))).filter (fun m =>
        ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ m),
      ∑ aa ∈ m.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
        ∑ p ∈ (WW m aa.1 bb.1 bb.2).filter Nat.Prime,
          Finsupp.single (m * p)
            (if Nat.Coprime (m * p) r0 then (C aa.1 bb.1 bb.2 : ℂ) else 0) := by
  intro A0 C WW
  rw [good_integer_largest_prime_finsupp_reindex_truncated]
  apply Finset.sum_congr rfl
  intro m hm
  have hm0 : 0 < m := (Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1).1
  let T : Finset ℕ := (Finset.Icc (Y + 1) (N / m)).filter (fun p =>
    Nat.Prime p ∧ ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p)
  let V : ℕ → ℕ → ℕ → Finset ℕ := fun q r h =>
    Finset.Icc
      (max (m.primeFactors.sup id + 1)
        (max q (max r (max (Nat.ceil z)
          (max (Nat.ceil (L q r h)) (Nat.ceil (nlo / (m : ℝ))))))))
      (min (Nat.floor (M0 / (m : ℝ)))
        (min (Nat.floor (U q r h)) (Nat.floor (nhi / (m : ℝ)))))
  have hwindow (p q r h : ℕ) (hp : Nat.Prime p) :
      p ∈ V q r h ↔ (∀ t : ℕ, Nat.Prime t → t ∣ m → t < p) ∧
        q ≤ p ∧ r ≤ p ∧ z ≤ (p : ℝ) ∧ L q r h ≤ (p : ℝ) ∧
        nlo ≤ ((p * m : ℕ) : ℝ) ∧ ((p * m : ℕ) : ℝ) ≤ M0 ∧
        (p : ℝ) ≤ U q r h ∧ ((p * m : ℕ) : ℝ) ≤ nhi := by
    have hlo : Nat.ceil (nlo / (m : ℝ)) ≤ p ↔ nlo ≤ ((p * m : ℕ) : ℝ) := by
      simp only [Nat.cast_mul]
      rw [Nat.ceil_le, div_le_iff₀ (Nat.cast_pos.mpr hm0)]
    have hcap : p ≤ Nat.floor (M0 / (m : ℝ)) ↔ ((p * m : ℕ) : ℝ) ≤ M0 := by
      simp only [Nat.cast_mul]
      rw [Nat.le_floor_iff' hp.ne_zero, le_div_iff₀ (Nat.cast_pos.mpr hm0)]
    have hhi : p ≤ Nat.floor (nhi / (m : ℝ)) ↔ ((p * m : ℕ) : ℝ) ≤ nhi := by
      simp only [Nat.cast_mul]
      rw [Nat.le_floor_iff' hp.ne_zero, le_div_iff₀ (Nat.cast_pos.mpr hm0)]
    have hzl : Nat.ceil z ≤ p ↔ z ≤ (p : ℝ) := Nat.ceil_le
    have hL : Nat.ceil (L q r h) ≤ p ↔ L q r h ≤ (p : ℝ) := Nat.ceil_le
    have hU : p ≤ Nat.floor (U q r h) ↔ (p : ℝ) ≤ U q r h :=
      Nat.le_floor_iff' hp.ne_zero
    simp only [V, Finset.mem_Icc, max_le_iff, le_min_iff,
      primeFactors_sup_succ_le_iff p m hp hm0, hlo, hcap, hhi, hzl, hL, hU]
    simp only [and_assoc]
  let F : ℕ → ℕ → ℕ → ℕ → ℤ := fun s q r h =>
    if Nat.Prime s ∧ z ≤ (s : ℝ) ∧
        (if j = 0 then q = 1 else Nat.Prime q ∧ z ≤ (q : ℝ)) ∧ q ≤ s ∧
        (if k = 0 then r = 1 else Nat.Prime r ∧ z ≤ (r : ℝ)) ∧ r ≤ s ∧
        ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧ P q r h ∧
        L q r h ≤ (s : ℝ) ∧ (s : ℝ) ≤ U q r h
    then (if b then |ArithmeticFunction.moebius h| else ArithmeticFunction.moebius h)
    else 0
  let S : ℕ → ℕ → ℕ → ℕ → ℕ →₀ ℂ := fun q r h p =>
    Finsupp.single (m * p) (if Nat.Coprime (m * p) r0 then
      (if p ∈ V q r h then (C q r h : ℂ) else 0) else 0)
  have hpoint (p : ℕ) (hpT : p ∈ T) :
      Finsupp.single (m * p)
        (if nlo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ nhi ∧
            Nat.Coprime (m * p) r0 then (A0 (m * p) : ℂ) else 0) =
      ∑ aa ∈ m.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
        S aa.1 bb.1 bb.2 p := by
    obtain ⟨hp, hmax⟩ := (Finset.mem_filter.mp hpT).2
    have hraw :
        (∑ a ∈ (p * m).divisorsAntidiagonal, ∑ d ∈ a.2.divisorsAntidiagonal,
          ∑ e ∈ d.2.divisorsAntidiagonal, F a.1 d.1 e.1 e.2) =
        ∑ a ∈ m.divisorsAntidiagonal, ∑ d ∈ a.2.divisorsAntidiagonal,
          F p a.1 d.1 d.2 := by
      have hcop := (harmanA_mobius_prime_factor_data p m hp hm0 hmax).2.1
      rw [sum_four_divisors_mul_prime p m hp hcop F]
      calc
        _ = ∑ a ∈ m.divisorsAntidiagonal, ∑ d ∈ a.2.divisorsAntidiagonal,
            ∑ e ∈ d.2.divisorsAntidiagonal, F (p * a.1) d.1 e.1 e.2 := by
          apply Finset.sum_congr rfl
          intro a ha
          have has : a.1 ∣ m :=
            (Nat.mem_divisors.mp (Nat.fst_mem_divisors_of_mem_antidiagonal ha)).1
          have ham : a.2 ∣ m :=
            (Nat.mem_divisors.mp (Nat.snd_mem_divisors_of_mem_antidiagonal ha)).1
          apply Finset.sum_congr rfl
          intro d hd
          have hdp : 0 < d.1 :=
            Nat.pos_of_ne_zero (Nat.left_ne_zero_of_mem_divisorsAntidiagonal hd)
          have hdm : d.2 ∣ m :=
            (Nat.mem_divisors.mp (Nat.snd_mem_divisors_of_mem_antidiagonal hd)).1.trans ham
          apply Finset.sum_congr rfl
          intro e he
          have hep : 0 < e.1 :=
            Nat.pos_of_ne_zero (Nat.left_ne_zero_of_mem_divisorsAntidiagonal he)
          have heh : 0 < e.2 :=
            Nat.pos_of_ne_zero (Nat.right_ne_zero_of_mem_divisorsAntidiagonal he)
          have hem : e.2 ∣ m :=
            (Nat.mem_divisors.mp (Nat.snd_mem_divisors_of_mem_antidiagonal he)).1.trans hdm
          have hsecond : F a.1 (p * d.1) e.1 e.2 = 0 := by
            dsimp only [F]
            apply ite_eq_right
            intro hc
            have hsp : a.1 < p := hmax a.1 hc.1 has
            have hple : p ≤ p * d.1 := Nat.le_mul_of_pos_right p hdp
            exact (not_lt_of_ge (hple.trans hc.2.2.2.1)) hsp
          have hthird : F a.1 d.1 (p * e.1) e.2 = 0 := by
            dsimp only [F]
            apply ite_eq_right
            intro hc
            have hsp : a.1 < p := hmax a.1 hc.1 has
            have hple : p ≤ p * e.1 := Nat.le_mul_of_pos_right p hep
            exact (not_lt_of_ge (hple.trans hc.2.2.2.2.2.1)) hsp
          have hfourth : F a.1 d.1 e.1 (p * e.2) = 0 := by
            have hsup := (harmanA_mobius_prime_factor_data p e.2 hp heh
              (fun t ht htd => hmax t ht (htd.trans hem))).2.2.2.1
            dsimp only [F]
            apply ite_eq_right
            intro hc
            have hsp : (a.1 : ℝ) < (p : ℝ) := by
              exact_mod_cast hmax a.1 hc.1 has
            have hpz : (p : ℝ) < z := by
              simpa only [hsup] using hc.2.2.2.2.2.2.1
            have hzs : z ≤ (a.1 : ℝ) := hc.2.1
            linarith only [hpz, hzs, hsp]
          simp only [hsecond, hthird, hfourth, add_zero]
        _ = ∑ a ∈ m.divisorsAntidiagonal, ∑ d ∈ a.2.divisorsAntidiagonal,
            F p a.1 d.1 d.2 := by
          have hunit : (1, m) ∈ m.divisorsAntidiagonal :=
            Nat.mem_divisorsAntidiagonal.mpr ⟨one_mul _, hm0.ne'⟩
          rw [Finset.sum_eq_single_of_mem (1, m) hunit]
          · simp only [mul_one]
          · intro a ha hne
            apply Finset.sum_eq_zero
            intro d _hd
            apply Finset.sum_eq_zero
            intro e _he
            dsimp only [F]
            apply ite_eq_right
            intro hc
            have ha1 : a.1 = 1 := by
              simpa only [Nat.prime_mul_iff, hp, hp.ne_one,
                true_and, and_false, or_false] using hc.1
            have ha2 : a.2 = m := by
              have hmul := (Nat.mem_divisorsAntidiagonal.mp ha).1
              simpa only [ha1, one_mul] using hmul
            exact hne (Prod.ext ha1 ha2)
    have hsource : A0 (m * p) =
        if ((m * p : ℕ) : ℝ) ≤ M0 then
          ∑ aa ∈ m.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
            F p aa.1 bb.1 bb.2
        else 0 := by
      change (if ((m * p : ℕ) : ℝ) ≤ M0 then
        ∑ aa ∈ (m * p).divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
          ∑ cc ∈ bb.2.divisorsAntidiagonal, F aa.1 bb.1 cc.1 cc.2 else 0) = _
      rw [Nat.mul_comm m p, hraw]
    have hind (q r h : ℕ) :
        (if nlo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ nhi then
          if ((m * p : ℕ) : ℝ) ≤ M0 then F p q r h else 0
        else 0) = if p ∈ V q r h then C q r h else 0 := by
      have hpred :
          ((nlo ≤ ((p * m : ℕ) : ℝ) ∧ ((p * m : ℕ) : ℝ) ≤ nhi) ∧
            ((p * m : ℕ) : ℝ) ≤ M0 ∧ Nat.Prime p ∧ z ≤ (p : ℝ) ∧
            (if j = 0 then q = 1 else Nat.Prime q ∧ z ≤ (q : ℝ)) ∧ q ≤ p ∧
            (if k = 0 then r = 1 else Nat.Prime r ∧ z ≤ (r : ℝ)) ∧ r ≤ p ∧
            ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧ P q r h ∧
            L q r h ≤ (p : ℝ) ∧ (p : ℝ) ≤ U q r h) ↔
          p ∈ V q r h ∧
            (if j = 0 then q = 1 else Nat.Prime q ∧ z ≤ (q : ℝ)) ∧
            (if k = 0 then r = 1 else Nat.Prime r ∧ z ≤ (r : ℝ)) ∧
            ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧ P q r h := by
        constructor
        · rintro ⟨⟨hlo, hhi⟩, hcap, _hp, hz, hq, hqp, hr, hrp, hsmall, hP, hL, hU⟩
          exact ⟨(hwindow p q r h hp).mpr
            ⟨hmax, hqp, hrp, hz, hL, hlo, hcap, hU, hhi⟩, hq, hr, hsmall, hP⟩
        · rintro ⟨hV, hq, hr, hsmall, hP⟩
          obtain ⟨_hmax, hqp, hrp, hz, hL, hlo, hcap, hU, hhi⟩ :=
            (hwindow p q r h hp).mp hV
          exact ⟨⟨hlo, hhi⟩, hcap, hp, hz, hq, hqp, hr, hrp, hsmall, hP, hL, hU⟩
      simp only [F, C, ← ite_and, Nat.mul_comm m p, hpred]
    have hscalar :
        (if nlo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ nhi
          then A0 (m * p) else 0) =
        ∑ aa ∈ m.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
          if p ∈ V aa.1 bb.1 bb.2 then C aa.1 bb.1 bb.2 else 0 := by
      calc
        _ = ∑ aa ∈ m.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
            if nlo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ nhi then
              if ((m * p : ℕ) : ℝ) ≤ M0 then F p aa.1 bb.1 bb.2 else 0
            else 0 := by
          rw [hsource]
          by_cases hlocal : nlo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ nhi <;>
            by_cases hcap : ((m * p : ℕ) : ℝ) ≤ M0 <;>
            simp only [hlocal, hcap, and_true, ite_true, ite_false, Finset.sum_const_zero]
        _ = _ := by
          apply Finset.sum_congr rfl
          intro aa haa
          apply Finset.sum_congr rfl
          intro bb hbb
          exact hind aa.1 bb.1 bb.2
    by_cases hcop : Nat.Coprime (m * p) r0
    · have hcast := congrArg (fun a : ℤ => (a : ℂ)) hscalar
      simp only [Int.cast_sum, apply_ite (fun a : ℤ => (a : ℂ)), Int.cast_zero] at hcast
      have h := congrArg (Finsupp.single (m * p)) hcast
      simp only [Finsupp.single_finsetSum] at h
      simpa only [S, eq_true hcop, and_true, ite_true] using h
    · simp [S, hcop]
  have hclip (a c : ℕ)
      (hwin : ∀ p : ℕ, Nat.Prime p → p ∈ Finset.Icc a c →
        ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p) :
      T.filter (fun p => p ∈ Finset.Icc a c) =
        (Finset.Icc (max (Y + 1) a) (min (N / m) c)).filter Nat.Prime := by
    ext p
    simp only [T, Finset.mem_filter, Finset.mem_Icc, max_le_iff, le_min_iff]
    constructor
    · rintro ⟨⟨hbase, hp, hmax⟩, hab⟩
      exact ⟨⟨⟨hbase.1, hab.1⟩, ⟨hbase.2, hab.2⟩⟩, hp⟩
    · rintro ⟨⟨⟨hY, ha⟩, ⟨hN, hc⟩⟩, hp⟩
      exact ⟨⟨⟨hY, hN⟩, hp, hwin p hp (Finset.mem_Icc.mpr ⟨ha, hc⟩)⟩, ha, hc⟩
  have hW (q r h : ℕ) :
      T.filter (fun p => p ∈ V q r h) = (WW m q r h).filter Nat.Prime := by
    apply hclip
    intro p hp hmem
    exact ((hwindow p q r h hp).mp hmem).1
  have hsum (q r h : ℕ) :
      (∑ p ∈ T, S q r h p) =
        ∑ p ∈ (WW m q r h).filter Nat.Prime,
          Finsupp.single (m * p)
            (if Nat.Coprime (m * p) r0 then (C q r h : ℂ) else 0) := by
    rw [← hW q r h]
    conv_rhs => rw [Finset.sum_filter]
    apply Finset.sum_congr rfl
    intro p hp
    by_cases hmem : p ∈ V q r h <;>
      by_cases hcop : Nat.Coprime (m * p) r0 <;> simp [S, hmem, hcop]
  change (∑ p ∈ T, Finsupp.single (m * p)
    (if nlo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ nhi ∧
      Nat.Coprime (m * p) r0 then (A0 (m * p) : ℂ) else 0)) = _
  calc
    _ = ∑ p ∈ T, ∑ aa ∈ m.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
        S aa.1 bb.1 bb.2 p := Finset.sum_congr rfl hpoint
    _ = ∑ aa ∈ m.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal, ∑ p ∈ T,
        S aa.1 bb.1 bb.2 p := by
      rw [Finset.sum_comm]
      apply Finset.sum_congr rfl
      intro aa haa
      exact Finset.sum_comm
    _ = _ := by
      apply Finset.sum_congr rfl
      intro aa haa
      apply Finset.sum_congr rfl
      intro bb hbb
      exact hsum aa.1 bb.1 bb.2

open Classical in
theorem harmanB_signed_or_absolute_largest_prime_split
    (p m : ℕ) (hp : Nat.Prime p) (hm : 0 < m)
    (hmax : ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p)
    (j : Fin 2) (absolute : Bool) (slo shi Z L U : ℝ) :
    let B : ℕ → ℤ := fun n =>
      ∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
        if (if j = 0 then a.1 = 1 else Nat.Prime a.1) ∧
            slo ≤ (a.1 : ℝ) ∧ (a.1 : ℝ) ≤ shi ∧
            ((max 1 (b.1.primeFactors.sup id) : ℕ) : ℝ) < Z ∧
            L ≤ ((a.1 * b.1 : ℕ) : ℝ) ∧ ((a.1 * b.1 : ℕ) : ℝ) ≤ U
        then (if absolute then |ArithmeticFunction.moebius b.1|
              else ArithmeticFunction.moebius b.1) else 0
    B (p * m) =
      ∑ a ∈ m.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
        ((if j = 1 ∧ a.1 = 1 ∧ slo ≤ (p : ℝ) ∧ (p : ℝ) ≤ shi ∧
            ((max 1 (b.1.primeFactors.sup id) : ℕ) : ℝ) < Z ∧
            L ≤ ((p * b.1 : ℕ) : ℝ) ∧ ((p * b.1 : ℕ) : ℝ) ≤ U
          then (if absolute then |ArithmeticFunction.moebius b.1|
                else ArithmeticFunction.moebius b.1) else 0) +
         (if (if j = 0 then a.1 = 1 else Nat.Prime a.1) ∧
            slo ≤ (a.1 : ℝ) ∧ (a.1 : ℝ) ≤ shi ∧ (p : ℝ) < Z ∧
            L ≤ ((p * (a.1 * b.1) : ℕ) : ℝ) ∧
              ((p * (a.1 * b.1) : ℕ) : ℝ) ≤ U
          then (if absolute then |ArithmeticFunction.moebius b.1|
                else -ArithmeticFunction.moebius b.1) else 0) +
         (if (if j = 0 then a.1 = 1 else Nat.Prime a.1) ∧
            slo ≤ (a.1 : ℝ) ∧ (a.1 : ℝ) ≤ shi ∧
            ((max 1 (b.1.primeFactors.sup id) : ℕ) : ℝ) < Z ∧
            L ≤ ((a.1 * b.1 : ℕ) : ℝ) ∧ ((a.1 * b.1 : ℕ) : ℝ) ≤ U
          then (if absolute then |ArithmeticFunction.moebius b.1|
                else ArithmeticFunction.moebius b.1) else 0)) := by
  intro B
  let F : ℕ → ℕ → ℕ → ℤ := fun s d _k =>
    if (if j = 0 then s = 1 else Nat.Prime s) ∧
        slo ≤ (s : ℝ) ∧ (s : ℝ) ≤ shi ∧
        ((max 1 (d.primeFactors.sup id) : ℕ) : ℝ) < Z ∧
        L ≤ ((s * d : ℕ) : ℝ) ∧ ((s * d : ℕ) : ℝ) ≤ U
    then (if absolute then |ArithmeticFunction.moebius d| else ArithmeticFunction.moebius d) else 0
  have hcop := (harmanA_mobius_prime_factor_data p m hp hm hmax).2.1
  have hfirst (s d k : ℕ) :
      F (p * s) d k =
        if j = 1 ∧ s = 1 ∧ slo ≤ (p : ℝ) ∧ (p : ℝ) ≤ shi ∧
            ((max 1 (d.primeFactors.sup id) : ℕ) : ℝ) < Z ∧
            L ≤ ((p * d : ℕ) : ℝ) ∧ ((p * d : ℕ) : ℝ) ≤ U
        then (if absolute then |ArithmeticFunction.moebius d|
              else ArithmeticFunction.moebius d) else 0 := by
    have hps : p * s ≠ 1 := fun h => hp.ne_one (Nat.eq_one_of_mul_eq_one_right h)
    fin_cases j <;> by_cases hs : s = 1 <;>
      simp [F, hs, hp, hp.ne_one, Nat.prime_mul_iff, hps]
  change (∑ a ∈ (p * m).divisorsAntidiagonal,
    ∑ b ∈ a.2.divisorsAntidiagonal, F a.1 b.1 b.2) = _
  rw [sum_three_divisors_mul_prime p m hp hcop F]
  apply Finset.sum_congr rfl
  intro a ha
  apply Finset.sum_congr rfl
  intro b hb
  have hd : 0 < b.1 :=
    Nat.pos_of_ne_zero (Nat.left_ne_zero_of_mem_divisorsAntidiagonal hb)
  have hdm : b.1 ∣ m :=
    (Nat.mem_divisors.mp (Nat.fst_mem_divisors_of_mem_antidiagonal hb)).1.trans
      (Nat.mem_divisors.mp (Nat.snd_mem_divisors_of_mem_antidiagonal ha)).1
  obtain ⟨_hnot, _hcopd, hmu, hsup, _hmin, _hpd⟩ :=
    harmanA_mobius_prime_factor_data p b.1 hp hd
      (fun t ht htd => hmax t ht (htd.trans hdm))
  rw [hfirst a.1 b.1 b.2]
  simp only [F, hmu, hsup, Nat.mul_left_comm, abs_neg]

open Classical in
theorem harmanB_signed_or_absolute_good_part_prime_windows
    (N Y r0 : ℕ) (j : Fin 2) (absolute : Bool) (slo shi Z L U nlo nhi : ℝ) (hZ : 0 < Z) :
    let B : ℕ → ℤ := fun n =>
      ∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
        if (if j = 0 then a.1 = 1 else Nat.Prime a.1) ∧
            slo ≤ (a.1 : ℝ) ∧ (a.1 : ℝ) ≤ shi ∧
            ((max 1 (b.1.primeFactors.sup id) : ℕ) : ℝ) < Z ∧
            L ≤ ((a.1 * b.1 : ℕ) : ℝ) ∧ ((a.1 * b.1 : ℕ) : ℝ) ≤ U
        then (if absolute then |ArithmeticFunction.moebius b.1|
              else ArithmeticFunction.moebius b.1) else 0
    let C0 : ℕ → ℕ → ℤ := fun s d =>
      if j = 1 ∧ s = 1 ∧ ((max 1 (d.primeFactors.sup id) : ℕ) : ℝ) < Z
      then (if absolute then |ArithmeticFunction.moebius d|
            else ArithmeticFunction.moebius d) else 0
    let C1 : ℕ → ℕ → ℤ := fun s d =>
      if (if j = 0 then s = 1 else Nat.Prime s) ∧ slo ≤ (s : ℝ) ∧ (s : ℝ) ≤ shi
      then (if absolute then |ArithmeticFunction.moebius d|
            else -ArithmeticFunction.moebius d) else 0
    let C2 : ℕ → ℕ → ℤ := fun s d =>
      if (if j = 0 then s = 1 else Nat.Prime s) ∧
          slo ≤ (s : ℝ) ∧ (s : ℝ) ≤ shi ∧
          ((max 1 (d.primeFactors.sup id) : ℕ) : ℝ) < Z ∧
          L ≤ ((s * d : ℕ) : ℝ) ∧ ((s * d : ℕ) : ℝ) ≤ U
      then (if absolute then |ArithmeticFunction.moebius d|
            else ArithmeticFunction.moebius d) else 0
    let W0 : ℕ → ℕ → Finset ℕ := fun m d =>
      Finset.Icc
        (max (Y + 1) (max (m.primeFactors.sup id + 1)
          (max (Nat.ceil (nlo / (m : ℝ)))
            (max (Nat.ceil slo) (Nat.ceil (L / (d : ℝ)))))))
        (min (N / m) (min (Nat.floor (nhi / (m : ℝ)))
          (min (Nat.floor shi) (Nat.floor (U / (d : ℝ))))))
    let W1 : ℕ → ℕ → ℕ → Finset ℕ := fun m s d =>
      Finset.Icc
        (max (Y + 1) (max (m.primeFactors.sup id + 1)
          (max (Nat.ceil (nlo / (m : ℝ))) (Nat.ceil (L / ((s * d : ℕ) : ℝ))))))
        (min (N / m) (min (Nat.floor (nhi / (m : ℝ)))
          (min (Nat.floor (U / ((s * d : ℕ) : ℝ))) (Nat.ceil Z - 1))))
    let W2 : ℕ → Finset ℕ := fun m =>
      Finset.Icc
        (max (Y + 1) (max (m.primeFactors.sup id + 1) (Nat.ceil (nlo / (m : ℝ)))))
        (min (N / m) (Nat.floor (nhi / (m : ℝ))))
    (∑ n ∈ (Finset.Icc 1 N).filter (fun n =>
        n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
          ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ n),
      Finsupp.single n (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
        then (B n : ℂ) else 0)) =
    ∑ m ∈ (Finset.Icc 1 N).filter (fun m =>
        ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ m),
      ∑ a ∈ m.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
        ((∑ p ∈ (W0 m b.1).filter Nat.Prime,
          Finsupp.single (m * p)
            (if Nat.Coprime (m * p) r0 then (C0 a.1 b.1 : ℂ) else 0)) +
         (∑ p ∈ (W1 m a.1 b.1).filter Nat.Prime,
          Finsupp.single (m * p)
            (if Nat.Coprime (m * p) r0 then (C1 a.1 b.1 : ℂ) else 0)) +
         (∑ p ∈ (W2 m).filter Nat.Prime,
          Finsupp.single (m * p)
            (if Nat.Coprime (m * p) r0 then (C2 a.1 b.1 : ℂ) else 0))) := by
  intro B C0 C1 C2 W0 W1 W2
  rw [good_integer_largest_prime_finsupp_reindex]
  apply Finset.sum_congr rfl
  intro m hm
  have hm0 : 0 < m := (Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1).1
  let T : Finset ℕ := (Finset.Icc (Y + 1) (N / m)).filter (fun p =>
    Nat.Prime p ∧ ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p)
  let V0 : ℕ → Finset ℕ := fun d =>
    Finset.Icc
      (max (m.primeFactors.sup id + 1)
        (max (Nat.ceil (nlo / (m : ℝ)))
          (max (Nat.ceil slo) (Nat.ceil (L / (d : ℝ))))))
      (min (Nat.floor (nhi / (m : ℝ)))
        (min (Nat.floor shi) (Nat.floor (U / (d : ℝ)))))
  let V1 : ℕ → ℕ → Finset ℕ := fun s d =>
    Finset.Icc
      (max (m.primeFactors.sup id + 1)
        (max (Nat.ceil (nlo / (m : ℝ))) (Nat.ceil (L / ((s * d : ℕ) : ℝ)))))
      (min (Nat.floor (nhi / (m : ℝ)))
        (min (Nat.floor (U / ((s * d : ℕ) : ℝ))) (Nat.ceil Z - 1)))
  let V2 : Finset ℕ :=
    Finset.Icc
      (max (m.primeFactors.sup id + 1) (Nat.ceil (nlo / (m : ℝ))))
      (Nat.floor (nhi / (m : ℝ)))
  have hceil (p k : ℕ) (hk : 0 < k) (A : ℝ) :
      Nat.ceil (A / (k : ℝ)) ≤ p ↔ A ≤ ((p * k : ℕ) : ℝ) := by
    simp only [Nat.cast_mul]
    rw [Nat.ceil_le, div_le_iff₀ (Nat.cast_pos.mpr hk)]
  have hfloor (p k : ℕ) (hp : Nat.Prime p) (hk : 0 < k) (A : ℝ) :
      p ≤ Nat.floor (A / (k : ℝ)) ↔ ((p * k : ℕ) : ℝ) ≤ A := by
    simp only [Nat.cast_mul]
    rw [Nat.le_floor_iff' hp.ne_zero, le_div_iff₀ (Nat.cast_pos.mpr hk)]
  have hZcut (p : ℕ) : p ≤ Nat.ceil Z - 1 ↔ (p : ℝ) < Z := by
    rw [Nat.le_sub_one_iff_lt (Nat.ceil_pos.mpr hZ), Nat.lt_ceil]
  have hV0 (p d : ℕ) (hp : Nat.Prime p) (hd : 0 < d) :
      p ∈ V0 d ↔
        (∀ t : ℕ, Nat.Prime t → t ∣ m → t < p) ∧
          nlo ≤ ((p * m : ℕ) : ℝ) ∧ ((p * m : ℕ) : ℝ) ≤ nhi ∧
          slo ≤ (p : ℝ) ∧ (p : ℝ) ≤ shi ∧
          L ≤ ((p * d : ℕ) : ℝ) ∧ ((p * d : ℕ) : ℝ) ≤ U := by
    simp only [V0, Finset.mem_Icc, max_le_iff, le_min_iff,
      primeFactors_sup_succ_le_iff p m hp hm0,
      hceil p m hm0 nlo, hceil p d hd L, hfloor p m hp hm0 nhi,
      hfloor p d hp hd U, Nat.ceil_le, Nat.le_floor_iff' hp.ne_zero]
    constructor
    · rintro ⟨⟨hmax, hlo, hslo, hL⟩, hhi, hshi, hU⟩
      exact ⟨hmax, hlo, hhi, hslo, hshi, hL, hU⟩
    · rintro ⟨hmax, hlo, hhi, hslo, hshi, hL, hU⟩
      exact ⟨⟨hmax, hlo, hslo, hL⟩, hhi, hshi, hU⟩
  have hV1 (p s d : ℕ) (hp : Nat.Prime p) (hs : 0 < s) (hd : 0 < d) :
      p ∈ V1 s d ↔
        (∀ t : ℕ, Nat.Prime t → t ∣ m → t < p) ∧
          nlo ≤ ((p * m : ℕ) : ℝ) ∧ ((p * m : ℕ) : ℝ) ≤ nhi ∧
          (p : ℝ) < Z ∧ L ≤ ((p * (s * d) : ℕ) : ℝ) ∧
          ((p * (s * d) : ℕ) : ℝ) ≤ U := by
    simp only [V1, Finset.mem_Icc, max_le_iff, le_min_iff,
      primeFactors_sup_succ_le_iff p m hp hm0,
      hceil p m hm0 nlo, hceil p (s * d) (Nat.mul_pos hs hd) L,
      hfloor p m hp hm0 nhi, hfloor p (s * d) hp (Nat.mul_pos hs hd) U, hZcut]
    constructor
    · rintro ⟨⟨hmax, hlo, hL⟩, hhi, hU, hZ⟩
      exact ⟨hmax, hlo, hhi, hZ, hL, hU⟩
    · rintro ⟨hmax, hlo, hhi, hZ, hL, hU⟩
      exact ⟨⟨hmax, hlo, hL⟩, hhi, hU, hZ⟩
  have hV2 (p : ℕ) (hp : Nat.Prime p) :
      p ∈ V2 ↔ (∀ t : ℕ, Nat.Prime t → t ∣ m → t < p) ∧
        nlo ≤ ((p * m : ℕ) : ℝ) ∧ ((p * m : ℕ) : ℝ) ≤ nhi := by
    simp only [V2, Finset.mem_Icc, max_le_iff,
      primeFactors_sup_succ_le_iff p m hp hm0,
      hceil p m hm0 nlo, hfloor p m hp hm0 nhi]
    constructor
    · rintro ⟨⟨hmax, hlo⟩, hhi⟩
      exact ⟨hmax, hlo, hhi⟩
    · rintro ⟨hmax, hlo, hhi⟩
      exact ⟨⟨hmax, hlo⟩, hhi⟩
  let R0 : ℕ → ℕ → ℕ → ℤ := fun s d p =>
    if j = 1 ∧ s = 1 ∧ slo ≤ (p : ℝ) ∧ (p : ℝ) ≤ shi ∧
        ((max 1 (d.primeFactors.sup id) : ℕ) : ℝ) < Z ∧
        L ≤ ((p * d : ℕ) : ℝ) ∧ ((p * d : ℕ) : ℝ) ≤ U
    then (if absolute then |ArithmeticFunction.moebius d| else ArithmeticFunction.moebius d) else 0
  let R1 : ℕ → ℕ → ℕ → ℤ := fun s d p =>
    if (if j = 0 then s = 1 else Nat.Prime s) ∧
        slo ≤ (s : ℝ) ∧ (s : ℝ) ≤ shi ∧ (p : ℝ) < Z ∧
        L ≤ ((p * (s * d) : ℕ) : ℝ) ∧ ((p * (s * d) : ℕ) : ℝ) ≤ U
    then (if absolute then |ArithmeticFunction.moebius d| else -ArithmeticFunction.moebius d) else 0
  let F0 : ℕ → ℕ → ℕ → ℕ →₀ ℂ := fun s d p =>
    Finsupp.single (m * p) (if Nat.Coprime (m * p) r0 then
      (if p ∈ V0 d then (C0 s d : ℂ) else 0) else 0)
  let F1 : ℕ → ℕ → ℕ → ℕ →₀ ℂ := fun s d p =>
    Finsupp.single (m * p) (if Nat.Coprime (m * p) r0 then
      (if p ∈ V1 s d then (C1 s d : ℂ) else 0) else 0)
  let F2 : ℕ → ℕ → ℕ → ℕ →₀ ℂ := fun s d p =>
    Finsupp.single (m * p) (if Nat.Coprime (m * p) r0 then
      (if p ∈ V2 then (C2 s d : ℂ) else 0) else 0)
  have hpoint (p : ℕ) (hpT : p ∈ T) :
      Finsupp.single (m * p)
        (if nlo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ nhi ∧
            Nat.Coprime (m * p) r0 then (B (m * p) : ℂ) else 0) =
      ∑ a ∈ m.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
        (F0 a.1 b.1 p + F1 a.1 b.1 p + F2 a.1 b.1 p) := by
    obtain ⟨hp, hmax⟩ := (Finset.mem_filter.mp hpT).2
    have hsource : B (m * p) =
        ∑ a ∈ m.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
          (R0 a.1 b.1 p + R1 a.1 b.1 p + C2 a.1 b.1) := by
      simpa only [B, R0, R1, C2, Nat.mul_comm m p] using
        harmanB_signed_or_absolute_largest_prime_split p m hp hm0 hmax j absolute slo shi Z L U
    have hi0 (s d : ℕ) (hd : 0 < d) :
        (if nlo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ nhi
          then R0 s d p else 0) = if p ∈ V0 d then C0 s d else 0 := by
      simp only [R0, C0, ← ite_and, hV0 p d hp hd, eq_true hmax, true_and,
        Nat.mul_comm m p, and_assoc, and_left_comm, and_comm]
    have hi1 (s d : ℕ) (hs : 0 < s) (hd : 0 < d) :
        (if nlo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ nhi
          then R1 s d p else 0) = if p ∈ V1 s d then C1 s d else 0 := by
      simp only [R1, C1, ← ite_and, hV1 p s d hp hs hd, eq_true hmax, true_and,
        Nat.mul_comm m p, and_assoc, and_left_comm, and_comm]
    have hi2 (s d : ℕ) :
        (if nlo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ nhi
          then C2 s d else 0) = if p ∈ V2 then C2 s d else 0 := by
      simp only [hV2 p hp, eq_true hmax, true_and, Nat.mul_comm m p]
    have hscalar :
        (if nlo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ nhi
          then B (m * p) else 0) =
        ∑ a ∈ m.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
          ((if p ∈ V0 b.1 then C0 a.1 b.1 else 0) +
           (if p ∈ V1 a.1 b.1 then C1 a.1 b.1 else 0) +
           (if p ∈ V2 then C2 a.1 b.1 else 0)) := by
      calc
        _ = ∑ a ∈ m.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
            ((if nlo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ nhi
              then R0 a.1 b.1 p else 0) +
             (if nlo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ nhi
              then R1 a.1 b.1 p else 0) +
             (if nlo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ nhi
              then C2 a.1 b.1 else 0)) := by
          rw [hsource]
          by_cases hlocal : nlo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ nhi
          · simp only [eq_true hlocal, ite_true]
          · simp only [eq_false hlocal, ite_false, zero_add, Finset.sum_const_zero]
        _ = _ := by
          apply Finset.sum_congr rfl
          intro a ha
          apply Finset.sum_congr rfl
          intro b hb
          have hs : 0 < a.1 :=
            Nat.pos_of_ne_zero (Nat.left_ne_zero_of_mem_divisorsAntidiagonal ha)
          have hd : 0 < b.1 :=
            Nat.pos_of_ne_zero (Nat.left_ne_zero_of_mem_divisorsAntidiagonal hb)
          rw [hi0 a.1 b.1 hd, hi1 a.1 b.1 hs hd, hi2 a.1 b.1]
    by_cases hcop : Nat.Coprime (m * p) r0
    · have hcast := congrArg (fun a : ℤ => (a : ℂ)) hscalar
      simp only [Int.cast_sum, Int.cast_add, apply_ite (fun a : ℤ => (a : ℂ)),
        Int.cast_zero] at hcast
      have h := congrArg (Finsupp.single (m * p)) hcast
      simp only [Finsupp.single_finsetSum, Finsupp.single_add] at h
      simpa only [F0, F1, F2, eq_true hcop, and_true, ite_true] using h
    · simp [F0, F1, F2, hcop]
  have hclip (a b : ℕ)
      (hwin : ∀ p : ℕ, Nat.Prime p → p ∈ Finset.Icc a b →
        ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p) :
      T.filter (fun p => p ∈ Finset.Icc a b) =
        (Finset.Icc (max (Y + 1) a) (min (N / m) b)).filter Nat.Prime := by
    ext p
    simp only [T, Finset.mem_filter, Finset.mem_Icc, max_le_iff, le_min_iff]
    constructor
    · rintro ⟨⟨hbase, hp, hmax⟩, hab⟩
      exact ⟨⟨⟨hbase.1, hab.1⟩, ⟨hbase.2, hab.2⟩⟩, hp⟩
    · rintro ⟨⟨⟨hY, ha⟩, ⟨hN, hb⟩⟩, hp⟩
      exact ⟨⟨⟨hY, hN⟩, hp, hwin p hp (Finset.mem_Icc.mpr ⟨ha, hb⟩)⟩, ha, hb⟩
  have hW0 (d : ℕ) (hd : 0 < d) :
      T.filter (fun p => p ∈ V0 d) = (W0 m d).filter Nat.Prime := by
    apply hclip
    intro p hp hmem
    exact ((hV0 p d hp hd).mp hmem).1
  have hW1 (s d : ℕ) (hs : 0 < s) (hd : 0 < d) :
      T.filter (fun p => p ∈ V1 s d) = (W1 m s d).filter Nat.Prime := by
    apply hclip
    intro p hp hmem
    exact ((hV1 p s d hp hs hd).mp hmem).1
  have hW2 : T.filter (fun p => p ∈ V2) = (W2 m).filter Nat.Prime := by
    apply hclip
    intro p hp hmem
    exact ((hV2 p hp).mp hmem).1
  have hrestrict (V W : Finset ℕ) (hVW : T.filter (fun p => p ∈ V) = W) (c : ℤ) :
      (∑ p ∈ T, Finsupp.single (m * p)
        (if Nat.Coprime (m * p) r0 then
          (if p ∈ V then (c : ℂ) else 0) else 0)) =
      ∑ p ∈ W, Finsupp.single (m * p)
        (if Nat.Coprime (m * p) r0 then (c : ℂ) else 0) := by
    rw [← hVW]
    conv_rhs => rw [Finset.sum_filter]
    apply Finset.sum_congr rfl
    intro p hp
    by_cases hmem : p ∈ V <;>
      by_cases hcop : Nat.Coprime (m * p) r0 <;> simp [hmem, hcop]
  have hsum0 (s d : ℕ) (hd : 0 < d) :
      (∑ p ∈ T, F0 s d p) =
        ∑ p ∈ (W0 m d).filter Nat.Prime, Finsupp.single (m * p)
          (if Nat.Coprime (m * p) r0 then (C0 s d : ℂ) else 0) :=
    hrestrict (V0 d) ((W0 m d).filter Nat.Prime) (hW0 d hd) (C0 s d)
  have hsum1 (s d : ℕ) (hs : 0 < s) (hd : 0 < d) :
      (∑ p ∈ T, F1 s d p) =
        ∑ p ∈ (W1 m s d).filter Nat.Prime, Finsupp.single (m * p)
          (if Nat.Coprime (m * p) r0 then (C1 s d : ℂ) else 0) :=
    hrestrict (V1 s d) ((W1 m s d).filter Nat.Prime) (hW1 s d hs hd) (C1 s d)
  have hsum2 (s d : ℕ) :
      (∑ p ∈ T, F2 s d p) =
        ∑ p ∈ (W2 m).filter Nat.Prime, Finsupp.single (m * p)
          (if Nat.Coprime (m * p) r0 then (C2 s d : ℂ) else 0) :=
    hrestrict V2 ((W2 m).filter Nat.Prime) hW2 (C2 s d)
  change (∑ p ∈ T, Finsupp.single (m * p)
    (if nlo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ nhi ∧
      Nat.Coprime (m * p) r0 then (B (m * p) : ℂ) else 0)) = _
  calc
    _ = ∑ p ∈ T, ∑ a ∈ m.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
        (F0 a.1 b.1 p + F1 a.1 b.1 p + F2 a.1 b.1 p) :=
      Finset.sum_congr rfl hpoint
    _ = ∑ a ∈ m.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal, ∑ p ∈ T,
        (F0 a.1 b.1 p + F1 a.1 b.1 p + F2 a.1 b.1 p) := by
      rw [Finset.sum_comm]
      apply Finset.sum_congr rfl
      intro a ha
      exact Finset.sum_comm
    _ = ∑ a ∈ m.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
        ((∑ p ∈ T, F0 a.1 b.1 p) + (∑ p ∈ T, F1 a.1 b.1 p) +
          (∑ p ∈ T, F2 a.1 b.1 p)) := by
      simp only [Finset.sum_add_distrib]
    _ = _ := by
      apply Finset.sum_congr rfl
      intro a ha
      apply Finset.sum_congr rfl
      intro b hb
      have hs : 0 < a.1 :=
        Nat.pos_of_ne_zero (Nat.left_ne_zero_of_mem_divisorsAntidiagonal ha)
      have hd : 0 < b.1 :=
        Nat.pos_of_ne_zero (Nat.left_ne_zero_of_mem_divisorsAntidiagonal hb)
      rw [hsum0 a.1 b.1 hd, hsum1 a.1 b.1 hs hd, hsum2 a.1 b.1]

open Classical in
theorem sifted_short_sixth_primeFactors_coefficient_eq
    (x : ℝ) (hx : 1 < x) (n : ℕ) :
    let z : ℝ := x ^ ((9519 : ℝ) / 50000)
    let H : ℝ := x ^ ((40481 : ℝ) / 100000)
    let S : ℝ := x ^ (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000)
    (∑ ps ∈ siftedPrimeTuples x (5 : Fin 6), ∑ d ∈ n.divisorsAntidiagonal,
      if d.1 = ps.prod then smallPrimeMobius z d.2 else 0) =
    ((∑ p2 ∈ n.primeFactors, ∑ p3 ∈ n.primeFactors, ∑ p4 ∈ n.primeFactors,
      if p2 * p3 * p4 ∣ n ∧ z ≤ (p3 : ℝ) ∧ p3 < p2 ∧ (p2 : ℝ) < H ∧
          p3 ≤ p4 ∧ ((p3 * p4 : ℕ) : ℝ) < H ∧ (p2 : ℝ) < S ∧
          n / (p2 * p3 * p4) ∈ Nat.smoothNumbers (Nat.ceil z)
      then ArithmeticFunction.moebius (n / (p2 * p3 * p4)) else 0 : ℤ) : ℝ) := by
  intro z H S
  by_cases hn : n = 0
  · subst n
    simp
  have hn0 : 0 < n := Nat.pos_of_ne_zero hn
  have hz : 1 < z := Real.one_lt_rpow hx (by norm_num)
  have htriple (p q r : ℕ) : [p, q, r] ∈ siftedPrimeTuples x (5 : Fin 6) ↔
      Nat.Prime p ∧ Nat.Prime q ∧ Nat.Prime r ∧ z ≤ (q : ℝ) ∧ q < p ∧
        (p : ℝ) < H ∧ q ≤ r ∧ ((q * r : ℕ) : ℝ) < H ∧ (p : ℝ) < S := by
    have hmem := mem_siftedPrimeTuples_iff x hx (5 : Fin 6) [p, q, r]
    dsimp only at hmem
    rw [hmem]
    apply and_congr_right
    intro hp
    apply and_congr_right
    intro hq
    apply and_congr_right
    intro hr
    have hp0 : 0 < (p : ℝ) := Nat.cast_pos.mpr hp.pos
    have hq0 : 0 < (q : ℝ) := Nat.cast_pos.mpr hq.pos
    have hr0 : 0 < (r : ℝ) := Nat.cast_pos.mpr hr.pos
    have hlo : (9519 : ℝ) / 50000 ≤ Real.logb x (q : ℝ) ↔ z ≤ (q : ℝ) :=
      Real.le_logb_iff_rpow_le hx hq0
    have hord : Real.logb x (q : ℝ) < Real.logb x (p : ℝ) ↔ q < p := by
      simpa only [Nat.cast_lt] using Real.logb_lt_logb_iff hx hq0 hp0
    have hHcut : Real.logb x (p : ℝ) < (40481 : ℝ) / 100000 ↔ (p : ℝ) < H :=
      Real.logb_lt_iff_lt_rpow hx hp0
    have hweak : Real.logb x (q : ℝ) ≤ Real.logb x (r : ℝ) ↔ q ≤ r := by
      simpa only [Nat.cast_le] using Real.logb_le_logb hx hq0 hr0
    have hprodcut :
        Real.logb x (q : ℝ) + Real.logb x (r : ℝ) < (40481 : ℝ) / 100000 ↔
          ((q * r : ℕ) : ℝ) < H := by
      simp only [H, Nat.cast_mul]
      rw [← Real.logb_mul hq0.ne' hr0.ne',
        Real.logb_lt_iff_lt_rpow hx (mul_pos hq0 hr0)]
    have hScut :
        Real.logb x (p : ℝ) < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000 ↔
          (p : ℝ) < S := Real.logb_lt_iff_lt_rpow hx hp0
    exact and_congr hlo (and_congr hord
      (and_congr hHcut (and_congr hweak (and_congr hprodcut hScut))))
  have hshape (ps : List ℕ) (hps : ps ∈ siftedPrimeTuples x (5 : Fin 6)) :
      ∃ p q r : ℕ, ps = [p, q, r] := by
    have hmem := (mem_siftedPrimeTuples_iff x hx (5 : Fin 6) ps).mp hps
    rcases ps with _ | ⟨p, _ | ⟨q, _ | ⟨r, _ | ⟨s, ss⟩⟩⟩⟩ <;>
      simp at hmem ⊢
  have hsmall (d : ℕ) (hd : d ≠ 0) :
      smallPrimeMobius z d =
        ((if d ∈ Nat.smoothNumbers (Nat.ceil z) then ArithmeticFunction.moebius d
          else 0 : ℤ) : ℝ) := by
    have hceil : 0 < Nat.ceil z := Nat.ceil_pos.mpr (zero_lt_one.trans hz)
    have hcut : ((max 1 (d.primeFactors.sup id) : ℕ) : ℝ) < z ↔
        d ∈ Nat.smoothNumbers (Nat.ceil z) := by
      rw [← Nat.lt_ceil, max_lt_iff, Finset.sup_lt_iff hceil]
      simp only [id_eq, Nat.lt_ceil, Nat.cast_one, hz, true_and]
      constructor
      · intro h
        apply Nat.mem_smoothNumbers'.mpr
        intro p hp hpd
        exact Nat.lt_ceil.mpr (h p (hp.mem_primeFactors hpd hd))
      · intro h p hp
        exact Nat.lt_ceil.mp ((Nat.mem_smoothNumbers'.mp h) p
          (Nat.prime_of_mem_primeFactors hp) (Nat.dvd_of_mem_primeFactors hp))
    change (if ((max 1 (d.primeFactors.sup id) : ℕ) : ℝ) < z then
      (ArithmeticFunction.moebius d : ℝ) else 0) = _
    simp only [hcut]
    by_cases hs : d ∈ Nat.smoothNumbers (Nat.ceil z)
    · simp only [eq_true hs, ite_true]
    · simp only [eq_false hs, ite_false, Int.cast_zero]
  let D : Finset (List ℕ × (ℕ × ℕ)) :=
    ((siftedPrimeTuples x (5 : Fin 6)).product n.divisorsAntidiagonal).filter
      (fun u => u.2.1 = u.1.prod)
  let V : Finset (ℕ × (ℕ × ℕ)) :=
    (n.primeFactors.product (n.primeFactors.product n.primeFactors)).filter
      (fun v => [v.1, v.2.1, v.2.2] ∈ siftedPrimeTuples x (5 : Fin 6) ∧
        v.1 * v.2.1 * v.2.2 ∣ n)
  let f : (ℕ × (ℕ × ℕ)) → List ℕ × (ℕ × ℕ) := fun v =>
    ([v.1, v.2.1, v.2.2], (v.1 * v.2.1 * v.2.2, n / (v.1 * v.2.1 * v.2.2)))
  calc
    _ = ∑ u ∈ D, smallPrimeMobius z u.2.2 := by
      simpa only [D, Finset.sum_filter, Finset.product_eq_sprod] using
        (Finset.sum_product (siftedPrimeTuples x (5 : Fin 6)) n.divisorsAntidiagonal
          (fun u : List ℕ × (ℕ × ℕ) =>
            if u.2.1 = u.1.prod then smallPrimeMobius z u.2.2 else 0)).symm
    _ = ∑ v ∈ V, smallPrimeMobius z (n / (v.1 * v.2.1 * v.2.2)) := by
      symm
      refine Finset.sum_bij (fun v _ => f v) ?_ ?_ ?_ (fun _ _ => rfl)
      · intro v hv
        obtain ⟨_hvP, htuple, hdiv⟩ := Finset.mem_filter.mp hv
        apply Finset.mem_filter.mpr
        refine ⟨Finset.mem_product.mpr ⟨htuple, ?_⟩, ?_⟩
        · exact Nat.mem_divisorsAntidiagonal.mpr ⟨Nat.mul_div_cancel' hdiv, hn⟩
        · simp only [f, List.prod_cons, List.prod_nil, mul_one, Nat.mul_assoc]
      · intro v _hv w _hw heq
        have hlist : [v.1, v.2.1, v.2.2] = [w.1, w.2.1, w.2.2] :=
          congrArg Prod.fst heq
        simp only [List.cons.injEq, and_true] at hlist
        exact Prod.ext hlist.1 (Prod.ext hlist.2.1 hlist.2.2)
      · intro u hu
        obtain ⟨huD, hproduct⟩ := Finset.mem_filter.mp hu
        obtain ⟨hps, hd⟩ := Finset.mem_product.mp huD
        obtain ⟨p, q, r, hpshape⟩ := hshape u.1 hps
        have htuple : [p, q, r] ∈ siftedPrimeTuples x (5 : Fin 6) := by
          simpa only [hpshape] using hps
        obtain ⟨hp, hq, hr, _hcuts⟩ := (htriple p q r).mp htuple
        have hprod : u.2.1 = p * q * r := by
          simpa only [hpshape, List.prod_cons, List.prod_nil, mul_one, Nat.mul_assoc]
            using hproduct
        have htotal : (p * q * r) * u.2.2 = n := by
          simpa only [hprod] using (Nat.mem_divisorsAntidiagonal.mp hd).1
        have hdiv : p * q * r ∣ n := ⟨u.2.2, htotal.symm⟩
        have hprod0 : 0 < p * q * r := Nat.mul_pos (Nat.mul_pos hp.pos hq.pos) hr.pos
        have hquot : n / (p * q * r) = u.2.2 := by
          rw [← htotal, Nat.mul_div_cancel_left _ hprod0]
        have hpdiv : p ∣ p * q * r := ⟨q * r, by ring⟩
        have hqdiv : q ∣ p * q * r := ⟨p * r, by ring⟩
        have hrdiv : r ∣ p * q * r := ⟨p * q, by ring⟩
        let v : ℕ × (ℕ × ℕ) := (p, (q, r))
        have hv : v ∈ V := by
          apply Finset.mem_filter.mpr
          exact ⟨Finset.mem_product.mpr
            ⟨Nat.mem_primeFactors.mpr ⟨hp, hpdiv.trans hdiv, hn⟩,
              Finset.mem_product.mpr
                ⟨Nat.mem_primeFactors.mpr ⟨hq, hqdiv.trans hdiv, hn⟩,
                  Nat.mem_primeFactors.mpr ⟨hr, hrdiv.trans hdiv, hn⟩⟩⟩,
            htuple, hdiv⟩
        refine ⟨v, hv, ?_⟩
        exact Prod.ext hpshape.symm (Prod.ext hprod.symm hquot)
    _ = ((∑ v ∈ V,
        if n / (v.1 * v.2.1 * v.2.2) ∈ Nat.smoothNumbers (Nat.ceil z)
        then ArithmeticFunction.moebius (n / (v.1 * v.2.1 * v.2.2)) else 0 : ℤ) : ℝ) := by
      rw [Int.cast_sum]
      apply Finset.sum_congr rfl
      intro v hv
      obtain ⟨hvP, _htuple, hdiv⟩ := Finset.mem_filter.mp hv
      obtain ⟨hp, hqr⟩ := Finset.mem_product.mp hvP
      obtain ⟨hq, hr⟩ := Finset.mem_product.mp hqr
      have hprod0 : 0 < v.1 * v.2.1 * v.2.2 :=
        Nat.mul_pos (Nat.mul_pos (Nat.prime_of_mem_primeFactors hp).pos
          (Nat.prime_of_mem_primeFactors hq).pos) (Nat.prime_of_mem_primeFactors hr).pos
      exact hsmall _ (Nat.div_pos (Nat.le_of_dvd hn0 hdiv) hprod0).ne'
    _ = _ := by
      apply congrArg (fun t : ℤ => (t : ℝ))
      simp only [V, Finset.sum_filter, Finset.product_eq_sprod]
      rw [Finset.sum_product n.primeFactors (n.primeFactors ×ˢ n.primeFactors)
        (fun v : ℕ × (ℕ × ℕ) =>
          if [v.1, v.2.1, v.2.2] ∈ siftedPrimeTuples x (5 : Fin 6) ∧
              v.1 * v.2.1 * v.2.2 ∣ n then
            if n / (v.1 * v.2.1 * v.2.2) ∈ Nat.smoothNumbers (Nat.ceil z)
            then ArithmeticFunction.moebius (n / (v.1 * v.2.1 * v.2.2)) else 0
          else 0)]
      apply Finset.sum_congr rfl
      intro p hp
      rw [Finset.sum_product n.primeFactors n.primeFactors
        (fun qr : ℕ × ℕ =>
          if [p, qr.1, qr.2] ∈ siftedPrimeTuples x (5 : Fin 6) ∧ p * qr.1 * qr.2 ∣ n then
            if n / (p * qr.1 * qr.2) ∈ Nat.smoothNumbers (Nat.ceil z)
            then ArithmeticFunction.moebius (n / (p * qr.1 * qr.2)) else 0
          else 0)]
      apply Finset.sum_congr rfl
      intro q hq
      apply Finset.sum_congr rfl
      intro r hr
      have hp' := Nat.prime_of_mem_primeFactors hp
      have hq' := Nat.prime_of_mem_primeFactors hq
      have hr' := Nat.prime_of_mem_primeFactors hr
      have hcondition :
          (([p, q, r] ∈ siftedPrimeTuples x (5 : Fin 6) ∧ p * q * r ∣ n) ∧
            n / (p * q * r) ∈ Nat.smoothNumbers (Nat.ceil z)) ↔
          p * q * r ∣ n ∧ z ≤ (q : ℝ) ∧ q < p ∧ (p : ℝ) < H ∧
            q ≤ r ∧ ((q * r : ℕ) : ℝ) < H ∧ (p : ℝ) < S ∧
            n / (p * q * r) ∈ Nat.smoothNumbers (Nat.ceil z) := by
        rw [htriple]
        simp only [eq_true hp', eq_true hq', eq_true hr', true_and]
        constructor
        · rintro ⟨⟨⟨hzq, hqp, hpH, hqr, hqrH, hpS⟩, hdiv⟩, hs⟩
          exact ⟨hdiv, hzq, hqp, hpH, hqr, hqrH, hpS, hs⟩
        · rintro ⟨hdiv, hzq, hqp, hpH, hqr, hqrH, hpS, hs⟩
          exact ⟨⟨⟨hzq, hqp, hpH, hqr, hqrH, hpS⟩, hdiv⟩, hs⟩
      simp only [← ite_and, hcondition]

open Classical in
theorem sifted_short_sixth_raw_norm_le (x : ℝ) (hx : 1 < x) (n : ℕ) :
    ‖((∑ ps ∈ siftedPrimeTuples x (5 : Fin 6), ∑ d ∈ n.divisorsAntidiagonal,
      if d.1 = ps.prod then smallPrimeMobius (x ^ ((9519 : ℝ) / 50000)) d.2
      else 0 : ℝ) : ℂ)‖ ≤ (n.divisors.card : ℝ) ^ 3 := by
  let z := x ^ ((9519 : ℝ) / 50000)
  let H := x ^ ((40481 : ℝ) / 100000)
  let S := x ^ (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000)
  have hz : 1 < z := Real.one_lt_rpow hx (by norm_num)
  have hb := theta6_a0_norm_le_divisor_cube n z H S (n : ℝ)
  simp only [eq_true hz, le_refl, true_and, ite_true] at hb
  have hs := congrArg (fun t : ℝ => (t : ℂ))
    (sifted_short_sixth_primeFactors_coefficient_eq x hx n)
  simp only [Complex.ofReal_intCast] at hs
  rw [hs]
  simpa only [Int.cast_sum, apply_ite (fun t : ℤ => (t : ℂ)), Int.cast_zero] using hb

theorem roughWeight_eq_ite_minFac (z : ℝ) {n : ℕ} (hn0 : n ≠ 0)
    (hn1 : n ≠ 1) :
    roughWeight z n = if z ≤ (n.minFac : ℝ) then 1 else 0 := by
  classical
  have hmin : n.minFac ∈ n.primeFactors :=
    (Nat.mem_primeFactors_of_ne_zero hn0).mpr
      ⟨Nat.minFac_prime hn1, Nat.minFac_dvd n⟩
  have hrough : (∀ p ∈ n.primeFactors, z ≤ (p : ℝ)) ↔
      z ≤ (n.minFac : ℝ) := by
    constructor
    · intro h
      exact h _ hmin
    · intro h p hp
      exact h.trans (Nat.cast_le.mpr (Nat.minFac_le_of_dvd
        (Nat.prime_of_mem_primeFactors hp).two_le (Nat.dvd_of_mem_primeFactors hp)))
  simp only [roughWeight, ArithmeticFunction.coe_mk, ne_eq, hn0,
    not_false_eq_true, true_and, hrough]

theorem roughWeight_prime_quotient {n p : ℕ} (hn : n ≠ 0) (hp : p.Prime)
    (hpn : p ∣ n) :
    roughWeight (p : ℝ) (n / p) = if p = n.minFac then 1 else 0 := by
  classical
  have hnpos : 0 < n := Nat.pos_of_ne_zero hn
  have hn1 : n ≠ 1 := by
    intro h
    exact hp.not_dvd_one (h ▸ hpn)
  have hquot : n / p ≠ 0 :=
    ne_of_gt (Nat.div_pos (Nat.le_of_dvd hnpos hpn) hp.pos)
  have hmul : p * (n / p) = n := Nat.mul_div_cancel' hpn
  have hleast := Nat.minFac_prime hn1
  by_cases heq : p = n.minFac
  · have hrough : ∀ q ∈ (n / p).primeFactors, (p : ℝ) ≤ (q : ℝ) := by
      intro q hq
      rw [heq]
      exact Nat.cast_le.mpr (Nat.minFac_le_of_dvd
        (Nat.prime_of_mem_primeFactors hq).two_le
        ((Nat.dvd_of_mem_primeFactors hq).trans (Nat.div_dvd_of_dvd hpn)))
    change (if n / p ≠ 0 ∧ ∀ q ∈ (n / p).primeFactors,
      (p : ℝ) ≤ (q : ℝ) then (1 : ℝ) else 0) = _
    rw [ite_eq_left ⟨hquot, hrough⟩, ite_eq_left heq]
  · have hnot : ¬n.minFac ∣ p := by
      intro h
      exact heq ((Nat.prime_dvd_prime_iff_eq hleast hp).mp h).symm
    have hdiv : n.minFac ∣ n / p := by
      apply (hleast.dvd_mul.mp (show n.minFac ∣ p * (n / p) by
        rw [hmul]
        exact Nat.minFac_dvd n)).resolve_left hnot
    have hmem : n.minFac ∈ (n / p).primeFactors :=
      (Nat.mem_primeFactors_of_ne_zero hquot).mpr ⟨hleast, hdiv⟩
    have hlt : n.minFac < p := lt_of_le_of_ne
      (Nat.minFac_le_of_dvd hp.two_le hpn) (Ne.symm heq)
    have hrough : ¬∀ q ∈ (n / p).primeFactors, (p : ℝ) ≤ (q : ℝ) := by
      intro h
      exact not_le_of_gt (Nat.cast_lt.mpr hlt) (h _ hmem)
    change (if n / p ≠ 0 ∧ ∀ q ∈ (n / p).primeFactors,
      (p : ℝ) ≤ (q : ℝ) then (1 : ℝ) else 0) = _
    rw [ite_eq_right (fun h => hrough h.2), ite_eq_right heq]

theorem roughWeight_buchstab {z₁ z₂ : ℝ} (hz : z₁ ≤ z₂) (n : ℕ) :
    roughWeight z₂ n = roughWeight z₁ n -
      ∑ p ∈ (Nat.primesLE n).filter
        (fun p : ℕ => z₁ ≤ (p : ℝ) ∧ (p : ℝ) < z₂ ∧ p ∣ n),
        roughWeight (p : ℝ) (n / p) := by
  classical
  by_cases hn0 : n = 0
  · subst n
    simp
  by_cases hn1 : n = 1
  · subst n
    have hone (z : ℝ) : roughWeight z 1 = 1 := by
      simp only [roughWeight, ArithmeticFunction.coe_mk, Nat.primeFactors_one]
      simp
    simp only [hone]
    simp
  have hnpos : 0 < n := Nat.pos_of_ne_zero hn0
  have hsum :
      (∑ p ∈ (Nat.primesLE n).filter
        (fun p : ℕ => z₁ ≤ (p : ℝ) ∧ (p : ℝ) < z₂ ∧ p ∣ n),
        roughWeight (p : ℝ) (n / p)) =
        if z₁ ≤ (n.minFac : ℝ) ∧ (n.minFac : ℝ) < z₂ then 1 else 0 := by
    calc
      _ = ∑ p ∈ (Nat.primesLE n).filter
          (fun p : ℕ => z₁ ≤ (p : ℝ) ∧ (p : ℝ) < z₂ ∧ p ∣ n),
          if p = n.minFac then (1 : ℝ) else 0 := by
        apply Finset.sum_congr rfl
        intro p hp
        rcases Finset.mem_filter.mp hp with ⟨hp, hcut⟩
        exact roughWeight_prime_quotient hn0 (Nat.prime_of_mem_primesLE hp) hcut.2.2
      _ = _ := by
        simp [Finset.mem_filter, Nat.mem_primesLE, Nat.minFac_le hnpos,
          Nat.minFac_prime hn1, Nat.minFac_dvd n]
  rw [roughWeight_eq_ite_minFac z₂ hn0 hn1,
    roughWeight_eq_ite_minFac z₁ hn0 hn1, hsum]
  by_cases h₁ : z₁ ≤ (n.minFac : ℝ)
  · by_cases h₂ : z₂ ≤ (n.minFac : ℝ)
    · simp [h₁, h₂, not_lt_of_ge h₂]
    · simp [h₁, h₂, lt_of_not_ge h₂]
  · have h₂ : ¬z₂ ≤ (n.minFac : ℝ) := fun h => h₁ (hz.trans h)
    simp [h₁, h₂]

theorem roughWeight_buchstab_twice {z₁ z₂ : ℝ} (hz : z₁ ≤ z₂) (n : ℕ) :
    roughWeight z₂ n = roughWeight z₁ n -
      (∑ p ∈ (Nat.primesLE n).filter
        (fun p : ℕ => z₁ ≤ (p : ℝ) ∧ (p : ℝ) < z₂ ∧ p ∣ n),
        roughWeight z₁ (n / p)) +
      ∑ p ∈ (Nat.primesLE n).filter
        (fun p : ℕ => z₁ ≤ (p : ℝ) ∧ (p : ℝ) < z₂ ∧ p ∣ n),
        ∑ q ∈ (Nat.primesLE (n / p)).filter
          (fun q : ℕ => z₁ ≤ (q : ℝ) ∧ (q : ℝ) < (p : ℝ) ∧ q ∣ n / p),
          roughWeight (q : ℝ) ((n / p) / q) := by
  classical
  calc
    _ = roughWeight z₁ n -
        ∑ p ∈ (Nat.primesLE n).filter
          (fun p : ℕ => z₁ ≤ (p : ℝ) ∧ (p : ℝ) < z₂ ∧ p ∣ n),
          (roughWeight z₁ (n / p) -
            ∑ q ∈ (Nat.primesLE (n / p)).filter
              (fun q : ℕ => z₁ ≤ (q : ℝ) ∧ (q : ℝ) < (p : ℝ) ∧ q ∣ n / p),
              roughWeight (q : ℝ) ((n / p) / q)) := by
      rw [roughWeight_buchstab hz n]
      congr 1
      apply Finset.sum_congr rfl
      intro p hp
      exact roughWeight_buchstab (Finset.mem_filter.mp hp).2.1 (n / p)
    _ = _ := by
      rw [Finset.sum_sub_distrib]
      ring

theorem roughWeight_sqrt_three_mul_eq_prime {x : ℝ} (hx : 3 ≤ x)
    {n : ℕ} (hlo : x ≤ (n : ℝ)) (hhi : (n : ℝ) ≤ 2 * x) :
    roughWeight (Real.sqrt (3 * x)) n = if n.Prime then 1 else 0 := by
  classical
  have hx0 : 0 < x := by linarith
  have hn0 : n ≠ 0 := by
    intro h
    simp only [h, Nat.cast_zero] at hlo
    linarith
  have hn1 : n ≠ 1 := by
    intro h
    simp only [h, Nat.cast_one] at hlo
    linarith
  rw [roughWeight_eq_ite_minFac _ hn0 hn1]
  by_cases hp : n.Prime
  · have hsqrt : Real.sqrt (3 * x) ≤ (n : ℝ) := by
      apply Real.sqrt_le_iff.mpr
      refine ⟨Nat.cast_nonneg _, ?_⟩
      calc
        3 * x ≤ x * x := mul_le_mul_of_nonneg_right hx hx0.le
        _ ≤ (n : ℝ) * (n : ℝ) := mul_self_le_mul_self hx0.le hlo
        _ = (n : ℝ) ^ 2 := by ring
    simp only [ite_eq_left hp, hp.minFac_eq, ite_eq_left hsqrt]
  · have hmin : (n.minFac : ℝ) ^ 2 ≤ (n : ℝ) := by
      exact_mod_cast Nat.minFac_sq_le_self (Nat.pos_of_ne_zero hn0) hp
    have hnot : ¬Real.sqrt (3 * x) ≤ (n.minFac : ℝ) := by
      intro h
      have hsquare := pow_le_pow_left₀ (Real.sqrt_nonneg (3 * x)) h 2
      have hsqrt := Real.sq_sqrt (show 0 ≤ 3 * x by positivity)
      nlinarith
    rw [ite_eq_right hp, ite_eq_right hnot]

theorem roughWeight_buchstab_first_split {z H T : ℝ}
    (hzH : z ≤ H) (hHT : H ≤ T) (n : ℕ) :
    roughWeight T n = roughWeight z n -
      (∑ p ∈ (Nat.primesLE n).filter
        (fun p : ℕ => z ≤ (p : ℝ) ∧ (p : ℝ) < H ∧ p ∣ n),
        roughWeight z (n / p)) -
      (∑ p ∈ (Nat.primesLE n).filter
        (fun p : ℕ => H ≤ (p : ℝ) ∧ (p : ℝ) < T ∧ p ∣ n),
        roughWeight (p : ℝ) (n / p)) +
      ∑ p ∈ (Nat.primesLE n).filter
        (fun p : ℕ => z ≤ (p : ℝ) ∧ (p : ℝ) < H ∧ p ∣ n),
        ∑ q ∈ (Nat.primesLE (n / p)).filter
          (fun q : ℕ => z ≤ (q : ℝ) ∧ (q : ℝ) < (p : ℝ) ∧ q ∣ n / p),
          roughWeight (q : ℝ) ((n / p) / q) := by
  classical
  rw [roughWeight_buchstab hHT n, roughWeight_buchstab_twice hzH n]
  ring

theorem primeIndicator_buchstab_first_split {x z H : ℝ} (hx : 3 ≤ x)
    (hzH : z ≤ H) (hHT : H ≤ Real.sqrt (3 * x))
    {n : ℕ} (hlo : x ≤ (n : ℝ)) (hhi : (n : ℝ) ≤ 2 * x) :
    (if n.Prime then (1 : ℝ) else 0) = roughWeight z n -
      (∑ p ∈ (Nat.primesLE n).filter
        (fun p : ℕ => z ≤ (p : ℝ) ∧ (p : ℝ) < H ∧ p ∣ n),
        roughWeight z (n / p)) -
      (∑ p ∈ (Nat.primesLE n).filter
        (fun p : ℕ => H ≤ (p : ℝ) ∧ (p : ℝ) < Real.sqrt (3 * x) ∧ p ∣ n),
        roughWeight (p : ℝ) (n / p)) +
      ∑ p ∈ (Nat.primesLE n).filter
        (fun p : ℕ => z ≤ (p : ℝ) ∧ (p : ℝ) < H ∧ p ∣ n),
        ∑ q ∈ (Nat.primesLE (n / p)).filter
          (fun q : ℕ => z ≤ (q : ℝ) ∧ (q : ℝ) < (p : ℝ) ∧ q ∣ n / p),
          roughWeight (q : ℝ) ((n / p) / q) := by
  classical
  rw [← roughWeight_sqrt_three_mul_eq_prime hx hlo hhi]
  exact roughWeight_buchstab_first_split hzH hHT n

theorem siftedTheta_eq_weighted_divisor_sum (x : ℝ) (j : Fin 6)
    (w : List ℕ → ℝ) (n : ℕ) :
    siftedTheta x j w n =
      ∑ p ∈ siftedPrimeTuples x j,
        if p.prod ∣ n then
          w p * roughWeight (x ^ ((9519 : ℝ) / 50000)) (n / p.prod)
        else 0 := by
  classical
  by_cases hn : n = 0
  · subst n
    simp [siftedTheta]
  change (∑ p ∈ siftedPrimeTuples x j, ∑ d ∈ n.divisorsAntidiagonal,
    if d.1 = p.prod then
      w p * roughWeight (x ^ ((9519 : ℝ) / 50000)) d.2 else 0) = _
  apply Finset.sum_congr rfl
  intro p _
  rw [Nat.sum_divisorsAntidiagonal (fun d e =>
    if d = p.prod then w p * roughWeight (x ^ ((9519 : ℝ) / 50000)) e else 0),
    Finset.sum_ite_eq']
  simp [Nat.mem_divisors, hn]

theorem siftedTheta_zero_eq_roughWeight (x : ℝ) (n : ℕ) :
    siftedTheta x (0 : Fin 6) (fun _ => 1) n =
      roughWeight (x ^ ((9519 : ℝ) / 50000)) n := by
  classical
  rw [siftedTheta_eq_weighted_divisor_sum]
  simp [siftedPrimeTuples]

theorem siftedTheta_one_eq_buchstab_prime_sum (x : ℝ) (hx : 1 < x) (n : ℕ) :
    siftedTheta x (1 : Fin 6) (fun _ => 1) n =
      ∑ p ∈ (Nat.primesLE n).filter (fun p : ℕ =>
        x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ) ∧
        (p : ℝ) < x ^ ((40481 : ℝ) / 100000) ∧ p ∣ n),
        roughWeight (x ^ ((9519 : ℝ) / 50000)) (n / p) := by
  classical
  by_cases hn : n = 0
  · subst n
    simp
  have hcarrier :
      (((Nat.primesBelow (Nat.ceil (x ^ ((40481 : ℝ) / 100000)))).filter
        (fun p : ℕ => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ))).filter
          (fun p : ℕ => p ∣ n)) =
      (Nat.primesLE n).filter (fun p : ℕ =>
        x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ) ∧
        (p : ℝ) < x ^ ((40481 : ℝ) / 100000) ∧ p ∣ n) := by
    ext p
    simp only [Finset.mem_filter, Nat.mem_primesBelow, Nat.lt_ceil,
      Nat.mem_primesLE]
    constructor
    · rintro ⟨⟨⟨hhi, hp⟩, hlo⟩, hpn⟩
      exact ⟨⟨Nat.le_of_dvd (Nat.pos_of_ne_zero hn) hpn, hp⟩, hlo, hhi, hpn⟩
    · rintro ⟨⟨_, hp⟩, hlo, hhi, hpn⟩
      exact ⟨⟨⟨hhi, hp⟩, hlo⟩, hpn⟩
  rw [siftedTheta_eq_weighted_divisor_sum,
    theta2_prime_tuples_eq x hx,
    Finset.sum_image List.singleton_injective.injOn]
  simp only [List.prod_cons, List.prod_nil, mul_one, one_mul]
  rw [← Finset.sum_filter, hcarrier]

theorem primeIndicator_eq_siftedTheta_zero_sub_one {x : ℝ} (hx : 3 ≤ x)
    {n : ℕ} (hlo : x ≤ (n : ℝ)) (hhi : (n : ℝ) ≤ 2 * x) :
    (if n.Prime then (1 : ℝ) else 0) =
      siftedTheta x (0 : Fin 6) (fun _ => 1) n -
      siftedTheta x (1 : Fin 6) (fun _ => 1) n -
      (∑ p ∈ (Nat.primesLE n).filter (fun p : ℕ =>
        x ^ ((40481 : ℝ) / 100000) ≤ (p : ℝ) ∧
        (p : ℝ) < Real.sqrt (3 * x) ∧ p ∣ n),
        roughWeight (p : ℝ) (n / p)) +
      ∑ p ∈ (Nat.primesLE n).filter (fun p : ℕ =>
        x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ) ∧
        (p : ℝ) < x ^ ((40481 : ℝ) / 100000) ∧ p ∣ n),
        ∑ q ∈ (Nat.primesLE (n / p)).filter (fun q : ℕ =>
          x ^ ((9519 : ℝ) / 50000) ≤ (q : ℝ) ∧
          (q : ℝ) < (p : ℝ) ∧ q ∣ n / p),
          roughWeight (q : ℝ) ((n / p) / q) := by
  classical
  have hx1 : 1 < x := by linarith
  have hzH : x ^ ((9519 : ℝ) / 50000) ≤ x ^ ((40481 : ℝ) / 100000) :=
    Real.rpow_le_rpow_of_exponent_le hx1.le (by norm_num)
  have hHT : x ^ ((40481 : ℝ) / 100000) ≤ Real.sqrt (3 * x) := by
    calc
      x ^ ((40481 : ℝ) / 100000) ≤ x ^ (1 / (2 : ℝ)) :=
        Real.rpow_le_rpow_of_exponent_le hx1.le (by norm_num)
      _ = Real.sqrt x := (Real.sqrt_eq_rpow x).symm
      _ ≤ Real.sqrt (3 * x) := Real.sqrt_le_sqrt (by linarith)
  rw [siftedTheta_zero_eq_roughWeight, siftedTheta_one_eq_buchstab_prime_sum x hx1]
  exact primeIndicator_buchstab_first_split hx hzH hHT hlo hhi

open Classical in
theorem roughWeight_eq_prime_add_ordered_semiprime
    (z : ℝ) (m : ℕ) (hz : 1 < z) (hm : z ≤ (m : ℝ))
    (hbound : (m : ℝ) < z ^ (3 : ℕ)) :
    roughWeight z m = (if m.Prime then 1 else 0) +
      ∑ e ∈ m.divisorsAntidiagonal,
        if e.1.Prime ∧ e.2.Prime ∧ z ≤ (e.1 : ℝ) ∧ e.1 ≤ e.2 then 1 else 0 := by
  have hm0 : m ≠ 0 := by
    intro h
    simp only [h, Nat.cast_zero] at hm
    linarith
  have hm1 : m ≠ 1 := by
    intro h
    simp only [h, Nat.cast_one] at hm
    linarith
  have hp : m.minFac.Prime := Nat.minFac_prime hm1
  have hpair_min (e : ℕ × ℕ) (he : e ∈ m.divisorsAntidiagonal)
      (he1 : e.1.Prime) (he2 : e.2.Prime) (hle : e.1 ≤ e.2) :
      e.1 = m.minFac := by
    have hprod : e.1 * e.2 = m := (Nat.mem_divisorsAntidiagonal.mp he).1
    have hminle : m.minFac ≤ e.1 :=
      Nat.minFac_le_of_dvd he1.two_le ⟨e.2, hprod.symm⟩
    have hdiv : m.minFac ∣ e.1 * e.2 := by
      rw [hprod]
      exact Nat.minFac_dvd m
    apply le_antisymm ?_ hminle
    rcases hp.dvd_mul.mp hdiv with hleft | hright
    · exact ((Nat.prime_dvd_prime_iff_eq hp he1).mp hleft).symm.le
    · exact hle.trans ((Nat.prime_dvd_prime_iff_eq hp he2).mp hright).symm.le
  rw [roughWeight_eq_ite_minFac z hm0 hm1]
  by_cases hprime : m.Prime
  · have hsum : (∑ e ∈ m.divisorsAntidiagonal,
        if e.1.Prime ∧ e.2.Prime ∧ z ≤ (e.1 : ℝ) ∧ e.1 ≤ e.2
        then (1 : ℝ) else 0) = 0 := by
      apply Finset.sum_eq_zero
      intro e he
      apply ite_eq_right
      intro hcond
      exact Nat.not_prime_of_mul_eq (Nat.mem_divisorsAntidiagonal.mp he).1
        hcond.1.ne_one hcond.2.1.ne_one hprime
    rw [hprime.minFac_eq, ite_eq_left hm, ite_eq_left hprime, hsum, add_zero]
  · rw [ite_eq_right hprime, zero_add]
    by_cases hrough : z ≤ (m.minFac : ℝ)
    · rw [ite_eq_left hrough]
      let p : ℕ := m.minFac
      let q : ℕ := m / p
      have hpp : p.Prime := hp
      have hpq : p ≤ q := Nat.minFac_le_div (Nat.pos_of_ne_zero hm0) hprime
      have hprod : p * q = m := Nat.mul_div_cancel' (Nat.minFac_dvd m)
      have hqdvd : q ∣ m := Nat.div_dvd_of_dvd (Nat.minFac_dvd m)
      have hqprime : q.Prime := by
        by_contra hqprime
        have hqpos : 0 < q := hpp.pos.trans_le hpq
        have hq1 : q ≠ 1 := by
          have hptwo := hpp.two_le
          omega
        have hqmin : q.minFac.Prime := Nat.minFac_prime hq1
        have hleast : p ≤ q.minFac := Nat.minFac_le_of_dvd hqmin.two_le
          ((Nat.minFac_dvd q).trans hqdvd)
        have hqsquare : (q.minFac : ℝ) ^ 2 ≤ (q : ℝ) := by
          exact_mod_cast Nat.minFac_sq_le_self hqpos hqprime
        have hpsquare : (p : ℝ) ^ 2 ≤ (q : ℝ) :=
          (pow_le_pow_left₀ (Nat.cast_nonneg p) (Nat.cast_le.mpr hleast) 2).trans hqsquare
        have hpcube : (p : ℝ) ^ 3 ≤ (m : ℝ) := by
          calc
            (p : ℝ) ^ 3 = (p : ℝ) * (p : ℝ) ^ 2 := by ring
            _ ≤ (p : ℝ) * (q : ℝ) :=
              mul_le_mul_of_nonneg_left hpsquare (Nat.cast_nonneg p)
            _ = (m : ℝ) := by exact_mod_cast hprod
        exact (not_le_of_gt hbound)
          ((pow_le_pow_left₀ (by linarith : 0 ≤ z) hrough 3).trans hpcube)
      have hpqmem : (p, q) ∈ m.divisorsAntidiagonal :=
        Nat.mem_divisorsAntidiagonal.mpr ⟨hprod, hm0⟩
      have hsingle (e : ℕ × ℕ) (he : e ∈ m.divisorsAntidiagonal)
          (hne : e ≠ (p, q)) :
          (if e.1.Prime ∧ e.2.Prime ∧ z ≤ (e.1 : ℝ) ∧ e.1 ≤ e.2
            then (1 : ℝ) else 0) = 0 := by
        apply ite_eq_right
        intro hcond
        have he1 : e.1 = p := hpair_min e he hcond.1 hcond.2.1 hcond.2.2.2
        have he2 : e.2 = q := by
          apply Nat.eq_of_mul_eq_mul_left hpp.pos
          calc
            p * e.2 = m := by
              simpa only [he1] using (Nat.mem_divisorsAntidiagonal.mp he).1
            _ = p * q := hprod.symm
        exact hne (Prod.ext he1 he2)
      symm
      calc
        _ = (if p.Prime ∧ q.Prime ∧ z ≤ (p : ℝ) ∧ p ≤ q then (1 : ℝ) else 0) :=
          Finset.sum_eq_single_of_mem (p, q) hpqmem hsingle
        _ = 1 := ite_eq_left ⟨hpp, hqprime, hrough, hpq⟩
    · rw [ite_eq_right hrough]
      symm
      apply Finset.sum_eq_zero
      intro e he
      apply ite_eq_right
      intro hcond
      have hemin := hpair_min e he hcond.1 hcond.2.1 hcond.2.2.2
      exact hrough (by simpa only [hemin] using hcond.2.2.1)

theorem five_exponent_subset_mass_bounds
    (α : Fin 5 → ℝ) (ε : ℝ)
    (hα : ∀ i, (9519 : ℝ) / 50000 ≤ α i)
    (hsum : ∑ i, α i ≤ 1 + ε) (s : Finset (Fin 5)) :
    (s.card : ℝ) * ((9519 : ℝ) / 50000) ≤ ∑ i ∈ s, α i ∧
      (∑ i ∈ s, α i) +
        ((5 - s.card : ℕ) : ℝ) * ((9519 : ℝ) / 50000) ≤ 1 + ε := by
  classical
  have hlower (t : Finset (Fin 5)) :
      (t.card : ℝ) * ((9519 : ℝ) / 50000) ≤ ∑ i ∈ t, α i := by
    simpa only [Finset.sum_const, nsmul_eq_mul] using
      (Finset.sum_le_sum (s := t)
        (f := fun _ => (9519 : ℝ) / 50000) (g := α) fun i _ => hα i)
  refine ⟨hlower s, ?_⟩
  have hcompl := hlower sᶜ
  have hpartition := Finset.sum_add_sum_compl s α
  simp only [Finset.card_compl, Fintype.card_fin] at hcompl
  linarith

theorem five_exponent_no_central_geometry
    (α : Fin 5 → ℝ) (ε : ℝ)
    (hε : ε < (59519 : ℝ) / 100000 - 3 * ((9519 : ℝ) / 50000))
    (hα : ∀ i, (9519 : ℝ) / 50000 ≤ α i)
    (hsum : ∑ i, α i ≤ 1 + ε)
    (hcentral : ∀ s : Finset (Fin 5),
      (40481 : ℝ) / 100000 ≤ ∑ i ∈ s, α i →
        (59519 : ℝ) / 100000 < ∑ i ∈ s, α i) :
    (∀ i, α i ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
      (∀ s : Finset (Fin 5), s.card = 2 →
        (∑ i ∈ s, α i) < (40481 : ℝ) / 100000) ∧
      (∀ s : Finset (Fin 5), s.card = 3 →
        (59519 : ℝ) / 100000 < ∑ i ∈ s, α i) := by
  classical
  have hpairs (s : Finset (Fin 5)) (hs : s.card = 2) :
      (∑ i ∈ s, α i) < (40481 : ℝ) / 100000 := by
    have hupper := (five_exponent_subset_mass_bounds α ε hα hsum s).2
    rw [hs] at hupper
    norm_num only [Nat.reduceSub, Nat.cast_ofNat] at hupper
    have hbelow : (∑ i ∈ s, α i) < (59519 : ℝ) / 100000 := by
      linarith
    by_contra hnot
    have habove := hcentral s (le_of_not_gt hnot)
    linarith
  refine ⟨?_, hpairs, ?_⟩
  · intro i
    obtain ⟨j, hji⟩ := exists_ne i
    have hpair := hpairs {i, j} (Finset.card_pair hji.symm)
    rw [Finset.sum_pair hji.symm] at hpair
    have hj := hα j
    linarith
  · intro s hs
    have hlower := (five_exponent_subset_mass_bounds α ε hα hsum s).1
    rw [hs] at hlower
    norm_num only [Nat.cast_ofNat] at hlower
    apply hcentral s
    linarith

theorem five_exponent_central_subset_card
    (α : Fin 5 → ℝ) (ε : ℝ)
    (hε : ε < (59519 : ℝ) / 100000 - 3 * ((9519 : ℝ) / 50000))
    (hα : ∀ i, (9519 : ℝ) / 50000 ≤ α i)
    (hsum : ∑ i, α i ≤ 1 + ε)
    (s : Finset (Fin 5))
    (hlower : (40481 : ℝ) / 100000 ≤ ∑ i ∈ s, α i)
    (hupper : (∑ i ∈ s, α i) ≤ (59519 : ℝ) / 100000) :
    s.card = 2 ∨ s.card = 3 := by
  classical
  have hcard : s.card ≤ 5 := by
    simpa only [Fintype.card_fin] using Finset.card_le_univ s
  rcases five_exponent_subset_mass_bounds α ε hα hsum s with ⟨hmin, hmax⟩
  have hcases : s.card = 0 ∨ s.card = 1 ∨ s.card = 2 ∨
      s.card = 3 ∨ s.card = 4 ∨ s.card = 5 := by omega
  rcases hcases with h | h | h | h | h | h
  · norm_num [h] at hmax
    linarith
  · norm_num [h] at hmax
    linarith
  · exact Or.inl h
  · exact Or.inr h
  · norm_num [h] at hmin
    linarith
  · norm_num [h] at hmin
    linarith

theorem five_exponent_reversal_exceptional_of_no_central
    (α : Fin 5 → ℝ) (ε : ℝ)
    (hε : ε < (59519 : ℝ) / 100000 - 3 * ((9519 : ℝ) / 50000))
    (hα : ∀ i, (9519 : ℝ) / 50000 ≤ α i)
    (hsum : ∑ i, α i ≤ 1 + ε)
    (h10 : α 1 < α 0) (h12 : α 1 < α 2) (h34 : α 3 ≤ α 4)
    (hcentral : ∀ s : Finset (Fin 5),
      (40481 : ℝ) / 100000 ≤ ∑ i ∈ s, α i →
        (59519 : ℝ) / 100000 < ∑ i ∈ s, α i) :
    (∀ i, (9519 : ℝ) / 50000 ≤ α i ∧
      α i ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
      α 1 < α 0 ∧ α 1 < α 2 ∧
      α 0 + α 2 < (40481 : ℝ) / 100000 ∧
      (59519 : ℝ) / 100000 < α 1 + α 2 + α 3 ∧ α 3 ≤ α 4 := by
  classical
  rcases five_exponent_no_central_geometry α ε hε hα hsum hcentral with
    ⟨hcap, hpair, htriple⟩
  refine ⟨fun i => ⟨hα i, hcap i⟩, h10, h12, ?_, ?_, h34⟩
  · have h := hpair ({0, 2} : Finset (Fin 5)) (by decide)
    simpa using h
  · have h := htriple ({1, 2, 3} : Finset (Fin 5)) (by decide)
    simpa [add_assoc] using h

theorem five_exponent_reversal_complement_central_or_diagonal
    (α : Fin 5 → ℝ) (ε : ℝ)
    (hε : ε < (59519 : ℝ) / 100000 - 3 * ((9519 : ℝ) / 50000))
    (hα : ∀ i, (9519 : ℝ) / 50000 ≤ α i)
    (hsum : ∑ i, α i ≤ 1 + ε)
    (h10 : α 1 < α 0) (h12 : α 1 ≤ α 2) (h34 : α 3 ≤ α 4)
    (hnot :
      ¬ ((∀ i, (9519 : ℝ) / 50000 ≤ α i ∧
          α i ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
        α 1 < α 0 ∧ α 1 < α 2 ∧
        α 0 + α 2 < (40481 : ℝ) / 100000 ∧
        (59519 : ℝ) / 100000 < α 1 + α 2 + α 3 ∧ α 3 ≤ α 4)) :
    (∃ s : Finset (Fin 5), (s.card = 2 ∨ s.card = 3) ∧
      (40481 : ℝ) / 100000 ≤ ∑ i ∈ s, α i ∧
      (∑ i ∈ s, α i) ≤ (59519 : ℝ) / 100000) ∨ α 2 = α 1 := by
  classical
  by_cases hdiag : α 2 = α 1
  · exact Or.inr hdiag
  by_cases hcentral : ∃ s : Finset (Fin 5),
      (40481 : ℝ) / 100000 ≤ ∑ i ∈ s, α i ∧
        (∑ i ∈ s, α i) ≤ (59519 : ℝ) / 100000
  · obtain ⟨s, hslo, hshi⟩ := hcentral
    exact Or.inl ⟨s,
      five_exponent_central_subset_card α ε hε hα hsum s hslo hshi, hslo, hshi⟩
  · exfalso
    apply hnot
    apply five_exponent_reversal_exceptional_of_no_central α ε hε hα hsum h10
      (lt_of_le_of_ne h12 (Ne.symm hdiag)) h34
    intro s hs
    by_contra hle
    exact hcentral ⟨s, hs, le_of_not_gt hle⟩

theorem minorantHB_logarithmic_product_norm_le
    {ι : Type*} (s : Finset ι) (hs : s.Nonempty)
    (f : ι → ArithmeticFunction ℝ)
    (hf : ∀ i ∈ s, ∀ n, ‖f i n‖ ≤ 1 + Real.log (n : ℝ)) (n : ℕ) :
    ‖(∏ i ∈ s, f i) n‖ ≤
      (n.divisors.card : ℝ) ^ (s.card - 1) *
        (1 + Real.log (n : ℝ)) ^ s.card := by
  classical
  let L : ℝ := 1 + Real.log (n : ℝ)
  let g (i : ι) : ArithmeticFunction ℝ :=
    arithmeticFunctionLowCutoff (n : ℝ) (f i)
  have hL : 0 ≤ L := add_nonneg zero_le_one (Real.log_natCast_nonneg n)
  have hg (i : ι) (hi : i ∈ s) (m : ℕ) : ‖g i m‖ ≤ L := by
    by_cases hm : (m : ℝ) ≤ (n : ℝ)
    · change ‖arithmeticFunctionLowCutoff
          (n : ℝ) (f i) m‖ ≤ L
      rw [arithmeticFunctionLowCutoff_apply_of_le hm]
      by_cases hm0 : m = 0
      · simpa [hm0] using hL
      · apply (hf i hi m).trans
        simpa only [L, add_comm] using add_le_add_left
          (Real.log_le_log (by exact_mod_cast Nat.pos_of_ne_zero hm0) hm) 1
    · change ‖if (m : ℝ) ≤ (n : ℝ) then f i m else 0‖ ≤ L
      rw [ite_eq_right hm, norm_zero]
      exact hL
  have hgrowth : ∀ t : Finset ι, t.Nonempty → t ⊆ s → ∀ m : ℕ,
      ‖(∏ i ∈ t, g i) m‖ ≤
        (m.divisors.card : ℝ) ^ (t.card - 1) * L ^ t.card := by
    intro t ht
    induction ht using Finset.Nonempty.cons_induction with
    | singleton i =>
        intro hts m
        simpa using hg i (hts (Finset.mem_singleton_self i)) m
    | cons i t hit htne ih =>
        intro hts m
        have hi : i ∈ s := hts (by simp)
        have ht : t ⊆ s := fun j hj => hts (by simp [hj])
        have hexp :
            0 + (t.card - 1) + 1 = (Finset.cons i t hit).card - 1 := by
          simpa [hit] using Nat.sub_add_cancel (Finset.one_le_card.mpr htne)
        have hlogexp : 1 + t.card = (Finset.cons i t hit).card := by
          simp [Nat.add_comm, hit]
        simpa only [Finset.prod_cons, hexp, hlogexp, one_mul] using
          convolution_growth_bound
            (g i) (∏ j ∈ t, g j) (C := 1) (D := 1) (L := L)
            zero_le_one zero_le_one hL 0 (t.card - 1) 1 t.card
            (by simpa using hg i hi) (by simpa using ih ht) m
  have hcut : ∀ t : Finset ι, ∀ m : ℕ, m ≤ n →
      (∏ i ∈ t, g i) m = (∏ i ∈ t, f i) m := by
    intro t
    induction t using Finset.induction_on with
    | empty => simp
    | @insert i t hit ih =>
        intro m hm
        simp only [Finset.prod_insert hit, ArithmeticFunction.mul_apply]
        apply Finset.sum_congr rfl
        intro d hd
        have hd₁ : d.1 ≤ n :=
          (Nat.divisor_le (Nat.fst_mem_divisors_of_mem_antidiagonal hd)).trans hm
        have hd₂ : d.2 ≤ n :=
          (Nat.divisor_le (Nat.snd_mem_divisors_of_mem_antidiagonal hd)).trans hm
        have hgi : g i d.1 = f i d.1 :=
          arithmeticFunctionLowCutoff_apply_of_le
            (by exact_mod_cast hd₁)
        rw [hgi, ih d.2 hd₂]
  rw [← hcut s n le_rfl]
  exact hgrowth s hs (Finset.Subset.refl s) n

theorem minorantHB_coeff_product_real {ι : Type*}
    (β : ι → MonoidAlgebra ℂ ℕ) (f : ι → ArithmeticFunction ℝ)
    (hβ : ∀ i n, (β i).coeff n = (f i n : ℂ)) (s : Finset ι) (n : ℕ) :
    (∏ i ∈ s, β i).coeff n = ((∏ i ∈ s, f i) n : ℂ) := by
  classical
  have hmul (P Q : MonoidAlgebra ℂ ℕ) (p q : ArithmeticFunction ℝ)
      (hP : ∀ n, P.coeff n = (p n : ℂ)) (hQ : ∀ n, Q.coeff n = (q n : ℂ)) :
      ∀ n, (P * Q).coeff n = ((p * q) n : ℂ) := by
    intro n
    by_cases hn : n = 0
    · subst n
      simp only [ArithmeticFunction.map_zero, Complex.ofReal_zero,
        MonoidAlgebra.coeff_mul, Finsupp.sum]
      apply Finset.sum_eq_zero
      intro x _
      apply Finset.sum_eq_zero
      intro y _
      split_ifs with hxy
      · rcases Nat.mul_eq_zero.mp hxy with hx | hy
        · subst x
          rw [hP]
          simp
        · subst y
          rw [hQ]
          simp
      · rfl
    · rw [MonoidAlgebra.coeff_mul_antidiag P Q n n.divisorsAntidiagonal
        (by
          intro d
          exact ⟨fun hd => (Nat.mem_divisorsAntidiagonal.mp hd).1,
            fun hd => Nat.mem_divisorsAntidiagonal.mpr ⟨hd, hn⟩⟩)]
      simp only [ArithmeticFunction.mul_apply, Complex.ofReal_sum,
        Complex.ofReal_mul, hP, hQ]
  induction s using Finset.induction_on generalizing n with
  | empty =>
      simp only [Finset.prod_empty]
      by_cases hn : n = 1
      · subst n
        simp
      · rw [ArithmeticFunction.one_apply_ne hn, Complex.ofReal_zero,
          MonoidAlgebra.one_def, MonoidAlgebra.coeff_single]
        exact Finsupp.single_eq_of_ne hn
  | @insert i s hi ih =>
      simp only [Finset.prod_insert hi]
      exact hmul (β i) (∏ k ∈ s, β k) (f i) (∏ k ∈ s, f k)
        (hβ i) ih n

theorem minorantHB_abs_product_le {ι : Type*}
    (f g : ι → ArithmeticFunction ℝ) (hfg : ∀ i n, |f i n| ≤ g i n)
    (s : Finset ι) (n : ℕ) : |(∏ i ∈ s, f i) n| ≤ (∏ i ∈ s, g i) n := by
  classical
  induction s using Finset.induction_on generalizing n with
  | empty =>
      simp only [Finset.prod_empty, ArithmeticFunction.one_apply]
      split_ifs <;> norm_num
  | @insert i s hi ih =>
      simp only [Finset.prod_insert hi, ArithmeticFunction.mul_apply]
      refine (Finset.abs_sum_le_sum_abs _ _).trans ?_
      apply Finset.sum_le_sum
      intro d _
      rw [abs_mul]
      exact mul_le_mul (hfg i d.1) (ih d.2) (abs_nonneg _)
        ((abs_nonneg _).trans (hfg i d.1))

theorem minorantHB_family_norm_le {κ ι : Type*} [Fintype ι]
    (T J : Finset κ) (hTJ : T ⊆ J) (β : κ → ι → MonoidAlgebra ℂ ℕ)
    (a aa : κ → ι → ArithmeticFunction ℝ) (b : ι → ArithmeticFunction ℝ)
    (hβ : ∀ ν i k, (β ν i).coeff k = (a ν i k : ℂ))
    (haabs : ∀ ν i k, |a ν i k| = aa ν i k) (n : ℕ)
    (hsum : (∑ ν ∈ J, (∏ i : ι, aa ν i) n) = (∏ i : ι, b i) n) :
    (∑ ν ∈ T, ‖(∏ i : ι, β ν i).coeff n‖) ≤ (∏ i : ι, b i) n := by
  classical
  have haa (ν : κ) (i : ι) (k : ℕ) : 0 ≤ aa ν i k := by
    rw [← haabs]
    exact abs_nonneg _
  have hnonneg (ν : κ) : 0 ≤ (∏ i : ι, aa ν i) n :=
    (abs_nonneg _).trans (minorantHB_abs_product_le (aa ν) (aa ν)
      (fun i k => (abs_of_nonneg (haa ν i k)).le) Finset.univ n)
  calc
    _ = ∑ ν ∈ T, |(∏ i : ι, a ν i) n| := by
      apply Finset.sum_congr rfl
      intro ν _
      rw [minorantHB_coeff_product_real (β ν) (a ν) (hβ ν) Finset.univ n,
        Complex.norm_real, Real.norm_eq_abs]
    _ ≤ ∑ ν ∈ T, (∏ i : ι, aa ν i) n := by
      apply Finset.sum_le_sum
      intro ν _
      exact minorantHB_abs_product_le (a ν) (aa ν)
        (fun i k => (haabs ν i k).le) Finset.univ n
    _ ≤ ∑ ν ∈ J, (∏ i : ι, aa ν i) n :=
      Finset.sum_le_sum_of_subset_of_nonneg hTJ (fun ν _ _ => hnonneg ν)
    _ = _ := hsum

theorem minorantHBLocalizedSlot_coefficient_full
    (j : ℕ) (U Θ t : ℝ) (ν : Fin (2 * j) → ℕ) (i : Fin (2 * j)) (k : ℕ)
    (hΘpos : 0 < Θ)
    (hηsupport : Function.support (minorantHBProfile Θ) = Set.Ioo Θ⁻¹ Θ) :
    (minorantHBLocalizedSlot j U Θ t ν i).coeff k =
      ((minorantHBProfile Θ ((k : ℝ) / Θ ^ (ν i)) *
        Real.rpow (k : ℝ) (-t) * minorantHBSlot j U i k : ℝ) : ℂ) := by
  classical
  rw [minorantHBLocalizedSlot_coefficient]
  by_cases hk : k ∈ Finset.Icc 1 ⌊Θ * Θ ^ (ν i)⌋₊
  · exact ite_eq_left hk
  · rw [ite_eq_right hk]
    have ha : minorantHBProfile Θ ((k : ℝ) / Θ ^ (ν i)) *
        Real.rpow (k : ℝ) (-t) * minorantHBSlot j U i k = 0 := by
      by_contra ha
      have hηne : minorantHBProfile Θ ((k : ℝ) / Θ ^ (ν i)) ≠ 0 :=
        left_ne_zero_of_mul (left_ne_zero_of_mul ha)
      have hηmem : (k : ℝ) / Θ ^ (ν i) ∈
          Function.support (minorantHBProfile Θ) := hηne
      rw [hηsupport] at hηmem
      have hpow : 0 < Θ ^ (ν i) := pow_pos hΘpos _
      have hlo := (lt_div_iff₀ hpow).mp hηmem.1
      have hup := (div_lt_iff₀ hpow).mp hηmem.2
      have hkpos : 0 < k := by
        exact_mod_cast (mul_pos (inv_pos.mpr hΘpos) hpow).trans hlo
      exact hk (Finset.mem_Icc.mpr ⟨hkpos, Nat.le_floor hup.le⟩)
    rw [ha, Complex.ofReal_zero]

open Classical in
theorem minorantHB_three_box_family_coefficient_norm_sum_le
    (A B t : Fin 3 → ℝ) (U Θ : ℝ)
    (hA : ∀ c, 1 ≤ A c) (hAB : ∀ c, A c ≤ B c)
    (hΘ : 1 < Θ) (hΘtwo : Θ ≤ 2)
    (ht : ∀ c, 0 ≤ t c) (_ : ∀ c, t c ≤ 10)
    (r : Fin 3 → Fin 5)
    (T : Finset ((c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ))
    (hT : T ⊆ Fintype.piFinset (fun c : Fin 3 =>
      minorantHBBoxes ((r c).val + 1) (A c) (B c) Θ)) (n : ℕ) :
    (∑ ν ∈ T, ‖(∏ s : Σ c : Fin 3, Fin (2 * ((r c).val + 1)),
      minorantHBLocalizedSlot ((r s.1).val + 1)
        U Θ (t s.1) (ν s.1) s.2).coeff n‖) ≤
      (n.divisors.card : ℝ) ^ 29 * (1 + Real.log (n : ℝ)) ^ 40 := by
  let I := Σ c : Fin 3, Fin (2 * ((r c).val + 1))
  let M : Fin 3 → ℕ := fun c => ⌈Real.log (B c) / Real.log Θ⌉₊
  let J₀ : (c : Fin 3) → Finset (Fin (2 * ((r c).val + 1)) → ℕ) :=
    fun c => Fintype.piFinset (fun _ => Finset.range (M c + 1))
  let J := Fintype.piFinset J₀
  let f : I → ArithmeticFunction ℝ := fun s =>
    minorantHBSlot ((r s.1).val + 1) U s.2
  let β : ((c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ) →
      I → MonoidAlgebra ℂ ℕ := fun ν s =>
    minorantHBLocalizedSlot ((r s.1).val + 1) U Θ (t s.1) (ν s.1) s.2
  let a : ℕ → I → ArithmeticFunction ℝ := fun m s =>
    ⟨fun k => minorantHBProfile Θ ((k : ℝ) / Θ ^ m) *
      Real.rpow (k : ℝ) (-t s.1) * f s k, by simp⟩
  let aa : ℕ → I → ArithmeticFunction ℝ := fun m s =>
    ⟨fun k => minorantHBProfile Θ ((k : ℝ) / Θ ^ m) *
      Real.rpow (k : ℝ) (-t s.1) * |f s k|, by simp⟩
  let b : I → ArithmeticFunction ℝ := fun s =>
    ∑ m ∈ Finset.range (M s.1 + 1), aa m s
  let ev (k : ℕ) : ArithmeticFunction ℝ →+ ℝ :=
    { toFun := fun F => F k
      map_zero' := rfl
      map_add' := fun _ _ => rfl }
  have hΘpos : 0 < Θ := zero_lt_one.trans hΘ
  obtain ⟨_, _, hprofiles⟩ :=
    heathBrown_geometric_profiles_uniform
  rcases hprofiles Θ hΘ hΘtwo with ⟨_, hηsupport, hηbounds, _, hgrid⟩
  change Function.support (minorantHBProfile Θ) = Set.Ioo Θ⁻¹ Θ at hηsupport
  change ∀ u : ℝ, 0 ≤ minorantHBProfile Θ u ∧ minorantHBProfile Θ u ≤ 1 at hηbounds
  have hmass (c : Fin 3) (y : ℝ) (hy : 1 ≤ y) :
      (∑ m ∈ Finset.range (M c + 1), minorantHBProfile Θ (y / Θ ^ m)) ≤ 1 :=
    ((hgrid (B c) ((hA c).trans (hAB c))).2.1 y hy).2
  have hTJ : T ⊆ J := by
    intro ν hν
    apply Fintype.mem_piFinset.mpr
    intro c
    exact (Finset.mem_filter.mp (Fintype.mem_piFinset.mp (hT hν) c)).1
  have haabs (m : ℕ) (s : I) (k : ℕ) : |a m s k| = aa m s k := by
    change |minorantHBProfile Θ ((k : ℝ) / Θ ^ m) *
      Real.rpow (k : ℝ) (-t s.1) * f s k| =
        minorantHBProfile Θ ((k : ℝ) / Θ ^ m) *
          Real.rpow (k : ℝ) (-t s.1) * |f s k|
    simp only [Real.rpow_eq_pow]
    rw [abs_mul, abs_mul, abs_of_nonneg (hηbounds _).1,
      abs_of_nonneg (Real.rpow_nonneg (Nat.cast_nonneg k) (-t s.1))]
  have haanonneg (m : ℕ) (s : I) (k : ℕ) : 0 ≤ aa m s k := by
    rw [← haabs]
    exact abs_nonneg _
  have hβ (ν : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ)
      (s : I) (k : ℕ) : (β ν s).coeff k = (a (ν s.1 s.2) s k : ℂ) :=
    minorantHBLocalizedSlot_coefficient_full _ _ _ _ _ _ _ hΘpos hηsupport
  have hfsmall (s : I) (k : ℕ) : |f s k| ≤ 1 + Real.log (k : ℝ) := by
    have hlog := Real.log_natCast_nonneg k
    have hμ : |(arithmeticFunctionLowCutoff U
        (ArithmeticFunction.moebius : ArithmeticFunction ℝ)) k| ≤ 1 := by
      change |if (k : ℝ) ≤ U then (ArithmeticFunction.moebius k : ℝ) else 0| ≤ 1
      split_ifs
      · exact_mod_cast ArithmeticFunction.abs_moebius_le_one (n := k)
      · norm_num
    have hζ : |(ArithmeticFunction.zeta : ArithmeticFunction ℝ) k| ≤ 1 := by
      by_cases hk : k = 0
      · simp [hk]
      · simp [ArithmeticFunction.zeta_apply_ne hk]
    dsimp only [f, minorantHBSlot]
    split_ifs
    · exact hμ.trans (le_add_of_nonneg_right hlog)
    · change |Real.log (k : ℝ)| ≤ 1 + Real.log (k : ℝ)
      rw [abs_of_nonneg hlog]
      exact le_add_of_nonneg_left zero_le_one
    · exact hζ.trans (le_add_of_nonneg_right hlog)
  have hbnonneg (s : I) (k : ℕ) : 0 ≤ b s k := by
    change 0 ≤ ev k (∑ m ∈ Finset.range (M s.1 + 1), aa m s)
    rw [map_sum]
    exact Finset.sum_nonneg fun m _ => haanonneg m s k
  have hbbound (s : I) (k : ℕ) : ‖b s k‖ ≤ 1 + Real.log (k : ℝ) := by
    rw [Real.norm_eq_abs, abs_of_nonneg (hbnonneg s k)]
    by_cases hk : k = 0
    · simp [hk]
    · have hkone : 1 ≤ (k : ℝ) := by
        exact_mod_cast Nat.one_le_iff_ne_zero.mpr hk
      calc
        b s k = (∑ m ∈ Finset.range (M s.1 + 1),
            minorantHBProfile Θ ((k : ℝ) / Θ ^ m)) *
              Real.rpow (k : ℝ) (-t s.1) * |f s k| := by
          change ev k (∑ m ∈ Finset.range (M s.1 + 1), aa m s) = _
          rw [map_sum]
          change (∑ m ∈ Finset.range (M s.1 + 1),
            minorantHBProfile Θ ((k : ℝ) / Θ ^ m) *
              Real.rpow (k : ℝ) (-t s.1) * |f s k|) = _
          rw [Finset.sum_mul, Finset.sum_mul]
        _ ≤ 1 * 1 * |f s k| := by
          apply mul_le_mul_of_nonneg_right _ (abs_nonneg _)
          exact mul_le_mul (hmass s.1 (k : ℝ) hkone)
            (Real.rpow_le_one_of_one_le_of_nonpos hkone (neg_nonpos.mpr (ht s.1)))
            (Real.rpow_nonneg (Nat.cast_nonneg k) (-t s.1)) zero_le_one
        _ = |f s k| := by ring
        _ ≤ _ := hfsmall s k
  have hsumJ :
      (∑ ν ∈ J, (∏ s : I, aa (ν s.1 s.2) s) n) = (∏ s : I, b s) n := by
    change (∑ ν ∈ J, ev n (∏ s : I, aa (ν s.1 s.2) s)) = ev n _
    rw [← map_sum]
    congr 1
    calc
      (∑ ν ∈ J, ∏ s : I, aa (ν s.1 s.2) s) =
          ∑ ν ∈ J, ∏ c : Fin 3, ∏ i : Fin (2 * ((r c).val + 1)),
            aa (ν c i) ⟨c, i⟩ := by
        apply Finset.sum_congr rfl
        intro ν _
        exact Fintype.prod_sigma _
      _ = ∏ c : Fin 3, ∑ ν ∈ J₀ c,
          ∏ i : Fin (2 * ((r c).val + 1)), aa (ν i) ⟨c, i⟩ :=
        (Finset.prod_univ_sum J₀
          (fun c ν => ∏ i : Fin (2 * ((r c).val + 1)), aa (ν i) ⟨c, i⟩)).symm
      _ = ∏ c : Fin 3, ∏ i : Fin (2 * ((r c).val + 1)), b ⟨c, i⟩ := by
        apply Finset.prod_congr rfl
        intro c _
        exact Finset.sum_prod_piFinset (Finset.range (M c + 1))
          (fun i m => aa m ⟨c, i⟩)
      _ = ∏ s : I, b s := (Fintype.prod_sigma _).symm
  have hnorm : (∑ ν ∈ T, ‖(∏ s : I, β ν s).coeff n‖) ≤
      (∏ s : I, b s) n :=
    minorantHB_family_norm_le T J hTJ β
      (fun ν s => a (ν s.1 s.2) s) (fun ν s => aa (ν s.1 s.2) s) b hβ
      (fun ν s k => haabs (ν s.1 s.2) s k) n hsumJ
  have hcard : Fintype.card I ≤ 30 := by
    rw [Fintype.card_sigma]
    calc
      _ ≤ ∑ _c : Fin 3, (10 : ℕ) := by
        apply Finset.sum_le_sum
        intro c _
        simp only [Fintype.card_fin]
        have hc := (r c).isLt
        omega
      _ = 30 := by norm_num
  have hI : (Finset.univ : Finset I).Nonempty := by
    refine ⟨⟨0, ⟨0, by omega⟩⟩, Finset.mem_univ _⟩
  have hgrowth := minorantHB_logarithmic_product_norm_le
    (Finset.univ : Finset I) hI b (fun s _ k => hbbound s k) n
  simp only [Finset.card_univ] at hgrowth
  have hmain : (∏ s : I, b s) n ≤
      (n.divisors.card : ℝ) ^ 29 * (1 + Real.log (n : ℝ)) ^ 40 := by
    by_cases hn : n = 0
    · subst n
      simp
    · have hτ : 1 ≤ (n.divisors.card : ℝ) := by
        exact_mod_cast Finset.one_le_card.mpr
          ⟨1, Nat.mem_divisors.mpr ⟨one_dvd n, hn⟩⟩
      have hlog : 1 ≤ 1 + Real.log (n : ℝ) :=
        le_add_of_nonneg_right (Real.log_natCast_nonneg n)
      calc
        _ ≤ ‖(∏ s : I, b s) n‖ := le_abs_self _
        _ ≤ (n.divisors.card : ℝ) ^ (Fintype.card I - 1) *
            (1 + Real.log (n : ℝ)) ^ Fintype.card I := hgrowth
        _ ≤ _ := mul_le_mul
          (pow_le_pow_right₀ hτ (by omega))
          (pow_le_pow_right₀ hlog (by omega))
          (pow_nonneg (zero_le_one.trans hlog) _) (by positivity)
  exact hnorm.trans hmain

theorem divisor_weighted_prime_feature_boundary_mass (K Z X Y : ℕ)
    (hZ : 1 ≤ Z) (hX : 1 ≤ X) (h : ℝ) (hh : 0 ≤ h) :
    (∑ ℓ ∈ Finset.Icc (Z + 1) Y,
      ∑ p ∈ Finset.Icc ℓ ⌊(1 + h) * (ℓ : ℝ)⌋₊,
        ∑ m ∈ Finset.Icc 1 (X / (ℓ * p)), (m.divisors.card : ℝ) ^ K) ≤
      (X : ℝ) * (1 + Real.log (X : ℝ)) ^ (2 ^ K - 1) *
        (h * (1 + Real.log (Y : ℝ)) + 1 / (Z : ℝ)) := by
  let C : ℝ := (X : ℝ) * (1 + Real.log (X : ℝ)) ^ (2 ^ K - 1)
  have hlogX : 0 ≤ Real.log (X : ℝ) :=
    Real.log_nonneg (by exact_mod_cast hX)
  have hC : 0 ≤ C := by
    dsimp [C]
    positivity
  have hcofactor (d : ℕ) :
      (∑ m ∈ Finset.Icc 1 (X / d), (m.divisors.card : ℝ) ^ K) ≤ C / (d : ℝ) := by
    by_cases hzero : X / d = 0
    · rw [hzero, Finset.Icc_eq_empty_of_lt (by omega : (0 : ℕ) < 1),
        Finset.sum_empty]
      exact div_nonneg hC (Nat.cast_nonneg d)
    · have hquotient : (1 : ℝ) ≤ ((X / d : ℕ) : ℝ) := by
        exact_mod_cast Nat.one_le_iff_ne_zero.mpr hzero
      have hlogquotient : 0 ≤ Real.log ((X / d : ℕ) : ℝ) :=
        Real.log_nonneg hquotient
      have hlogle : Real.log ((X / d : ℕ) : ℝ) ≤ Real.log (X : ℝ) :=
        Real.log_le_log (by linarith) (by exact_mod_cast Nat.div_le_self X d)
      calc
        _ ≤ ((X / d : ℕ) : ℝ) *
            (1 + Real.log ((X / d : ℕ) : ℝ)) ^ (2 ^ K - 1) :=
          sum_card_divisors_pow_le_mul_log_pow K (X / d)
        _ ≤ ((X / d : ℕ) : ℝ) *
            (1 + Real.log (X : ℝ)) ^ (2 ^ K - 1) :=
          mul_le_mul_of_nonneg_left
            (pow_le_pow_left₀ (by linarith)
              (show 1 + Real.log ((X / d : ℕ) : ℝ) ≤ 1 + Real.log (X : ℝ) by
                linarith only [hlogle]) _)
            (Nat.cast_nonneg (X / d))
        _ ≤ ((X : ℝ) / (d : ℝ)) *
            (1 + Real.log (X : ℝ)) ^ (2 ^ K - 1) :=
          mul_le_mul_of_nonneg_right Nat.cast_div_le (by positivity)
        _ = C / (d : ℝ) := by
          dsimp [C]
          ring
  calc
    _ ≤ ∑ ℓ ∈ Finset.Icc (Z + 1) Y,
        ∑ p ∈ Finset.Icc ℓ ⌊(1 + h) * (ℓ : ℝ)⌋₊,
          C * (ℓ : ℝ)⁻¹ * (p : ℝ)⁻¹ := by
      refine Finset.sum_le_sum fun ℓ _ => Finset.sum_le_sum fun p _ => ?_
      calc
        _ ≤ C / ((ℓ * p : ℕ) : ℝ) := hcofactor (ℓ * p)
        _ = C * (ℓ : ℝ)⁻¹ * (p : ℝ)⁻¹ := by
          simp only [Nat.cast_mul, div_eq_mul_inv, mul_inv_rev]
          ring
    _ = C * (∑ ℓ ∈ Finset.Icc (Z + 1) Y, (ℓ : ℝ)⁻¹ *
        ∑ p ∈ Finset.Icc ℓ ⌊(1 + h) * (ℓ : ℝ)⌋₊, (p : ℝ)⁻¹) := by
      simp only [Finset.mul_sum, mul_assoc]
    _ ≤ C * (h * (1 + Real.log (Y : ℝ)) + 1 / (Z : ℝ)) :=
      mul_le_mul_of_nonneg_left
        (reciprocal_integer_comparison_boundary_le Z Y hZ h hh) hC

section
open scoped ContDiff

open Classical in
theorem harmanB_largest_prime_split
    (p m : ℕ) (hp : Nat.Prime p) (hm : 0 < m)
    (hmax : ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p)
    (j : Fin 2) (slo shi Z L U : ℝ) :
    let B : ℕ → ℤ := fun n =>
      ∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
        if (if j = 0 then a.1 = 1 else Nat.Prime a.1) ∧
            slo ≤ (a.1 : ℝ) ∧ (a.1 : ℝ) ≤ shi ∧
            ((max 1 (b.1.primeFactors.sup id) : ℕ) : ℝ) < Z ∧
            L ≤ ((a.1 * b.1 : ℕ) : ℝ) ∧ ((a.1 * b.1 : ℕ) : ℝ) ≤ U
        then ArithmeticFunction.moebius b.1 else 0
    B (p * m) =
      ∑ a ∈ m.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
        ((if j = 1 ∧ a.1 = 1 ∧ slo ≤ (p : ℝ) ∧ (p : ℝ) ≤ shi ∧
            ((max 1 (b.1.primeFactors.sup id) : ℕ) : ℝ) < Z ∧
            L ≤ ((p * b.1 : ℕ) : ℝ) ∧ ((p * b.1 : ℕ) : ℝ) ≤ U
          then ArithmeticFunction.moebius b.1 else 0) +
         (if (if j = 0 then a.1 = 1 else Nat.Prime a.1) ∧
            slo ≤ (a.1 : ℝ) ∧ (a.1 : ℝ) ≤ shi ∧ (p : ℝ) < Z ∧
            L ≤ ((p * (a.1 * b.1) : ℕ) : ℝ) ∧
              ((p * (a.1 * b.1) : ℕ) : ℝ) ≤ U
          then -ArithmeticFunction.moebius b.1 else 0) +
         (if (if j = 0 then a.1 = 1 else Nat.Prime a.1) ∧
            slo ≤ (a.1 : ℝ) ∧ (a.1 : ℝ) ≤ shi ∧
            ((max 1 (b.1.primeFactors.sup id) : ℕ) : ℝ) < Z ∧
            L ≤ ((a.1 * b.1 : ℕ) : ℝ) ∧ ((a.1 * b.1 : ℕ) : ℝ) ≤ U
          then ArithmeticFunction.moebius b.1 else 0)) := by
  simpa only [Bool.false_eq_true, ite_false] using
    harmanB_signed_or_absolute_largest_prime_split
      p m hp hm hmax j false slo shi Z L U

end

section
open scoped ContDiff

open Classical in
theorem harmanB_good_part_prime_windows
    (N Y r0 : ℕ) (j : Fin 2) (slo shi Z L U nlo nhi : ℝ) (hZ : 0 < Z) :
    let B : ℕ → ℤ := fun n =>
      ∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
        if (if j = 0 then a.1 = 1 else Nat.Prime a.1) ∧
            slo ≤ (a.1 : ℝ) ∧ (a.1 : ℝ) ≤ shi ∧
            ((max 1 (b.1.primeFactors.sup id) : ℕ) : ℝ) < Z ∧
            L ≤ ((a.1 * b.1 : ℕ) : ℝ) ∧ ((a.1 * b.1 : ℕ) : ℝ) ≤ U
        then ArithmeticFunction.moebius b.1 else 0
    let C0 : ℕ → ℕ → ℤ := fun s d =>
      if j = 1 ∧ s = 1 ∧ ((max 1 (d.primeFactors.sup id) : ℕ) : ℝ) < Z
      then ArithmeticFunction.moebius d else 0
    let C1 : ℕ → ℕ → ℤ := fun s d =>
      if (if j = 0 then s = 1 else Nat.Prime s) ∧ slo ≤ (s : ℝ) ∧ (s : ℝ) ≤ shi
      then -ArithmeticFunction.moebius d else 0
    let C2 : ℕ → ℕ → ℤ := fun s d =>
      if (if j = 0 then s = 1 else Nat.Prime s) ∧
          slo ≤ (s : ℝ) ∧ (s : ℝ) ≤ shi ∧
          ((max 1 (d.primeFactors.sup id) : ℕ) : ℝ) < Z ∧
          L ≤ ((s * d : ℕ) : ℝ) ∧ ((s * d : ℕ) : ℝ) ≤ U
      then ArithmeticFunction.moebius d else 0
    let W0 : ℕ → ℕ → Finset ℕ := fun m d =>
      Finset.Icc
        (max (Y + 1) (max (m.primeFactors.sup id + 1)
          (max (Nat.ceil (nlo / (m : ℝ)))
            (max (Nat.ceil slo) (Nat.ceil (L / (d : ℝ)))))))
        (min (N / m) (min (Nat.floor (nhi / (m : ℝ)))
          (min (Nat.floor shi) (Nat.floor (U / (d : ℝ))))))
    let W1 : ℕ → ℕ → ℕ → Finset ℕ := fun m s d =>
      Finset.Icc
        (max (Y + 1) (max (m.primeFactors.sup id + 1)
          (max (Nat.ceil (nlo / (m : ℝ))) (Nat.ceil (L / ((s * d : ℕ) : ℝ))))))
        (min (N / m) (min (Nat.floor (nhi / (m : ℝ)))
          (min (Nat.floor (U / ((s * d : ℕ) : ℝ))) (Nat.ceil Z - 1))))
    let W2 : ℕ → Finset ℕ := fun m =>
      Finset.Icc
        (max (Y + 1) (max (m.primeFactors.sup id + 1) (Nat.ceil (nlo / (m : ℝ)))))
        (min (N / m) (Nat.floor (nhi / (m : ℝ))))
    (∑ n ∈ (Finset.Icc 1 N).filter (fun n =>
        n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
          ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ n),
      Finsupp.single n (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
        then (B n : ℂ) else 0)) =
    ∑ m ∈ (Finset.Icc 1 N).filter (fun m =>
        ¬ ∃ r : ℕ, Nat.Prime r ∧ Y < r ∧ r ^ 2 ∣ m),
      ∑ a ∈ m.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
        ((∑ p ∈ (W0 m b.1).filter Nat.Prime,
          Finsupp.single (m * p)
            (if Nat.Coprime (m * p) r0 then (C0 a.1 b.1 : ℂ) else 0)) +
         (∑ p ∈ (W1 m a.1 b.1).filter Nat.Prime,
          Finsupp.single (m * p)
            (if Nat.Coprime (m * p) r0 then (C1 a.1 b.1 : ℂ) else 0)) +
         (∑ p ∈ (W2 m).filter Nat.Prime,
          Finsupp.single (m * p)
            (if Nat.Coprime (m * p) r0 then (C2 a.1 b.1 : ℂ) else 0))) := by
  simpa only [Bool.false_eq_true, ite_false] using
    harmanB_signed_or_absolute_good_part_prime_windows
      N Y r0 j false slo shi Z L U nlo nhi hZ

end

theorem norm_harman_int_cut_le_one
    (P : Prop) [Decidable P] (z : ℤ) (hz : ‖(z : ℂ)‖ ≤ 1) :
    ‖((if P then z else 0 : ℤ) : ℂ)‖ ≤ 1 := by
  by_cases hP : P
  · simpa only [ite_eq_left hP] using hz
  · simp only [ite_eq_right hP, Int.cast_zero, norm_zero, zero_le_one]

open Classical in
theorem harmanA_named_all_moduli_siegelWalfisz
    (ε T c C A : ℝ) (hε : 0 < ε) (hT : 0 < T) (hc : 0 < c)
    (hC : 0 < C) (hA : 0 < A) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ j : Fin 2, ∀ P : ℕ → ℕ → Prop, ∀ L U : ℕ → ℕ → ℝ,
      ∀ z H nlo nhi : ℝ, 0 < z → 0 < H → c * N ≤ nlo →
      ∀ b : Bool, ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 →
      ∀ a : ℕ, Nat.Coprime a q →
      let A0 : ℕ → ℤ := fun n =>
        ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
          if (if j = 0 then aa.1 = 1 else
                Nat.Prime aa.1 ∧ z ≤ (aa.1 : ℝ) ∧ aa.1 ≤ bb.1) ∧
              Nat.Prime bb.1 ∧ z ≤ (bb.1 : ℝ) ∧ 1 < bb.2 ∧
              ((max 1 (bb.2.primeFactors.sup id) : ℕ) : ℝ) < z ∧ P aa.1 bb.2 ∧
              L aa.1 bb.2 ≤ (bb.1 : ℝ) ∧ (bb.1 : ℝ) ≤ U aa.1 bb.2 ∧
              ((aa.1 * bb.1 : ℕ) : ℝ) < H ∧
              ((n / bb.2.minFac : ℕ) : ℝ) < H ∧ H ≤ (n : ℝ)
          then (if b then |ArithmeticFunction.moebius bb.2| else ArithmeticFunction.moebius bb.2)
          else 0
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
          (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
           then (A0 n : ℂ) else 0)) q a‖ ≤
        K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨E, hE, Xe, hXe, henv⟩ := exists_cofactor_log_fourth_envelope T C hT hC
  obtain ⟨Kg, Xg, hKg, hXg, hgood⟩ :=
    largest_prime_windows_all_moduli_siegelWalfisz
      2 1 ε c T C 4 E A hε hc hT hE.le hA
  obtain ⟨Xb, hXb⟩ := Filter.eventually_atTop.mp
    (eventually_exceptional_coefficient_discrepancy_le
      2 1 A 0 C ε T (by norm_num) hε hT)
  refine ⟨Kg + 2, max Xg (max Xe Xb), by linarith,
    hXg.trans (le_max_left _ _), ?_⟩
  intro x hx N hNL hNU j P L U z H nlo nhi hz hH hlo b q hq r0 hr0 a ha A0
  have hxg : Xg ≤ x := (le_max_left _ _).trans hx
  have hxe : Xe ≤ x := (le_max_left Xe Xb).trans ((le_max_right _ _).trans hx)
  have hxb : Xb ≤ x := (le_max_right Xe Xb).trans ((le_max_right _ _).trans hx)
  have hxexp : Real.exp 1 ≤ x := hXg.trans hxg
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hxexp
  have hlog : 0 ≤ Real.log x := zero_le_one.trans hlog1
  have hN : 0 ≤ N := (Real.rpow_pos_of_pos hx0 ε).le.trans hNL
  have hden : 0 ≤ (Real.log x) ^ A := Real.rpow_nonneg hlog A
  let NN := Nat.floor (T * N)
  let Y := Nat.floor (Real.exp (Real.sqrt (Real.log x)))
  let V : Finset ℕ := Finset.Icc 1 NN
  let GOOD : Finset ℕ := V.filter (fun n =>
    n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
      ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n)
  let BAD : Finset ℕ := V.filter (fun n =>
    n ∈ Nat.factoredNumbers (Nat.primesLE Y) ∨
      ∃ p : ℕ, Nat.Prime p ∧
        Real.exp (Real.sqrt (Real.log x)) < (p : ℝ) ∧ p ^ 2 ∣ n)
  let M : Finset ℕ := (Finset.Icc 1 (NN / (Y + 1))).filter (fun m =>
    ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ m)
  let C0 : ℕ → ℕ → ℤ := fun s h =>
    if (if j = 0 then s = 1 else Nat.Prime s ∧ z ≤ (s : ℝ)) ∧
        1 < h ∧ ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧ P s h
    then (if b then |ArithmeticFunction.moebius h| else ArithmeticFunction.moebius h)
    else 0
  let LL : ℕ → ℕ → ℕ → ℕ := fun m s h =>
    max (Y + 1) (max (m.primeFactors.sup id + 1)
      (max (Nat.ceil (nlo / (m : ℝ))) (max (Nat.ceil (H / (m : ℝ)))
        (max (Nat.ceil z) (max s (Nat.ceil (L s h)))))))
  let UU : ℕ → ℕ → ℕ → ℕ := fun m s h =>
    min (NN / m) (min (Nat.floor (nhi / (m : ℝ)))
      (min (Nat.floor (U s h)) (min (Nat.ceil (H * (h.minFac : ℝ) / (m : ℝ)) - 1)
        (Nat.ceil (H / (s : ℝ)) - 1))))
  let I : Finset (Σ _m : ℕ, ℕ × ℕ) := M.sigma (fun m => m.divisorsAntidiagonal)
  let f : ℕ → ℂ := fun n =>
    if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi then (A0 n : ℂ) else 0
  let g : ℕ → ℂ := fun n => if Nat.Coprime n r0 then f n else 0
  let F0 : ℕ →₀ ℂ := ∑ i ∈ I, ∑ p ∈ Finset.Icc
      (LL i.1 i.2.1 i.2.2) (UU i.1 i.2.1 i.2.2),
    Finsupp.single (i.1 * p) (if Nat.Prime p then (C0 i.2.1 i.2.2 : ℂ) else 0)
  have hmu (n : ℕ) :
      ‖((if b then |ArithmeticFunction.moebius n|
        else ArithmeticFunction.moebius n : ℤ) : ℂ)‖ ≤ 1 := by
    rcases ArithmeticFunction.moebius_eq_or n with h | h | h <;> cases b <;> simp [h]
  have hA0 (n : ℕ) : ‖(A0 n : ℂ)‖ ≤ (n.divisors.card : ℝ) ^ 2 := by
    have hh := norm_three_divisor_sum_le_divisor_sq n
      (fun s p h => ((if (if j = 0 then s = 1 else Nat.Prime s ∧ z ≤ (s : ℝ) ∧ s ≤ p) ∧
          Nat.Prime p ∧ z ≤ (p : ℝ) ∧ 1 < h ∧
          ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧ P s h ∧
          L s h ≤ (p : ℝ) ∧ (p : ℝ) ≤ U s h ∧ ((s * p : ℕ) : ℝ) < H ∧
          ((n / h.minFac : ℕ) : ℝ) < H ∧ H ≤ (n : ℝ)
        then (if b then |ArithmeticFunction.moebius h| else ArithmeticFunction.moebius h)
        else 0 : ℤ) : ℂ)) (by
          intro aa _haa bb _hbb
          exact norm_harman_int_cut_le_one _ _ (hmu bb.2))
    simpa only [A0, Int.cast_sum] using hh
  have hC0 (s h : ℕ) : ‖(C0 s h : ℂ)‖ ≤ 1 := by
    dsimp only [C0]
    exact norm_harman_int_cut_le_one _ _ (hmu h)
  have hf (n : ℕ) : ‖f n‖ ≤ (n.divisors.card : ℝ) ^ 2 := by
    dsimp only [f]
    split_ifs
    · exact hA0 n
    · simp only [norm_zero]
      positivity
  have hindex (i : Σ _m : ℕ, ℕ × ℕ) (hi : i ∈ I) :
      i.1 ∈ M ∧ i.2 ∈ i.1.divisorsAntidiagonal := Finset.mem_sigma.mp hi
  have hmpos (i : Σ _m : ℕ, ℕ × ℕ) (hi : i ∈ I) : 0 < i.1 :=
    (Finset.mem_Icc.mp (Finset.mem_filter.mp (hindex i hi).1).1).1
  have hMbox : M ⊆ Finset.Icc 1 NN := by
    intro m hm
    have hI := Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1
    exact Finset.mem_Icc.mpr ⟨hI.1, hI.2.trans (Nat.div_le_self NN (Y + 1))⟩
  have hprimefilter (R m l u : ℕ) (w : ℂ) :
      (∑ p ∈ (Finset.Icc l u).filter Nat.Prime,
        Finsupp.single (m * p) (if Nat.Coprime (m * p) R then w else 0)) =
      ∑ p ∈ Finset.Icc l u, Finsupp.single (m * p)
        (if Nat.Prime p ∧ Nat.Coprime (m * p) R then w else 0) := by
    rw [Finset.sum_filter]
    apply Finset.sum_congr rfl
    intro p hp
    by_cases hp' : Nat.Prime p <;> simp [hp']
  have hsource (R : ℕ) :
      (∑ n ∈ GOOD, Finsupp.single n
        (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n R
          then (A0 n : ℂ) else 0)) =
      ∑ i ∈ I, ∑ p ∈ Finset.Icc (LL i.1 i.2.1 i.2.2) (UU i.1 i.2.1 i.2.2),
        Finsupp.single (i.1 * p)
          (if Nat.Prime p ∧ Nat.Coprime (i.1 * p) R then (C0 i.2.1 i.2.2 : ℂ) else 0) := by
    have hs := harmanA_named_good_part_prime_windows NN Y R j P L U z H nlo nhi hz hH b
    dsimp only at hs
    simp only [hprimefilter] at hs
    simpa only [A0, C0, LL, UU, GOOD, V, M, I, Finset.sum_sigma] using hs
  have hF0eq : F0 = ∑ n ∈ GOOD, Finsupp.single n (f n) := by
    simpa only [F0, f, Nat.coprime_one_right_eq_true, and_true] using (hsource 1).symm
  have hF0 (n : ℕ) : F0 n = if n ∈ GOOD then f n else 0 := by
    rw [hF0eq]
    simp [Finsupp.finsetSum_apply, Finsupp.single_apply]
  have hsupport : ∀ n ∈ F0.support, c * N ≤ (n : ℝ) ∧ (n : ℝ) ≤ T * N := by
    intro n hn
    have hne := Finsupp.mem_support_iff.mp hn
    rw [hF0] at hne
    have hparts : n ∈ GOOD ∧ f n ≠ 0 := by
      simpa only [ite_ne_right_iff] using hne
    have hlocal : nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi := by
      have hfne := hparts.2
      dsimp only [f] at hfne
      exact (ite_ne_right_iff.mp hfne).1
    exact ⟨hlo.trans hlocal.1,
      (Nat.cast_le.mpr (Finset.mem_Icc.mp (Finset.mem_filter.mp hparts.1).1).2).trans
        (Nat.floor_le (mul_nonneg hT.le hN))⟩
  have hFbound (n : ℕ) : ‖F0 n‖ ≤ (n.divisors.card : ℝ) ^ (2 : ℝ) := by
    rw [hF0]
    split_ifs
    · simpa only [Real.rpow_ofNat] using hf n
    · simp only [norm_zero]
      exact Real.rpow_nonneg (Nat.cast_nonneg _) _
  have henvelope : ∀ n ∈ F0.support,
      ‖F0 n‖ ≤ 1 * (n.divisors.card : ℝ) ^ (2 : ℝ) *
        (Real.log x) ^ (2 : ℝ) := by
    intro n hn
    exact (hFbound n).trans (by
      simpa only [one_mul] using
        le_mul_of_one_le_right (Real.rpow_nonneg (Nat.cast_nonneg n.divisors.card) (2 : ℝ))
          (Real.one_le_rpow hlog1 (by norm_num : (0 : ℝ) ≤ 2)))
  have hNN : (NN : ℝ) ≤ T * N := Nat.floor_le (mul_nonneg hT.le hN)
  have hXL (i : Σ _m : ℕ, ℕ × ℕ) (hi : i ∈ I) :
      Real.exp (Real.sqrt (Real.log x)) ≤ ((NN / i.1 : ℕ) : ℝ) :=
    (cofactor_prime_scale_above_real_cutoff NN i.1 (Real.exp (Real.sqrt (Real.log x)))
      (hmpos i hi) (Finset.mem_Icc.mp (Finset.mem_filter.mp (hindex i hi).1).1).2).le
  have hXU (i : Σ _m : ℕ, ℕ × ℕ) (hi : i ∈ I) :
      ((NN / i.1 : ℕ) : ℝ) ≤ T * N / (i.1 : ℝ) :=
    (Nat.cast_div_le (m := NN) (n := i.1) (α := ℝ)).trans
      (div_le_div_of_nonneg_right hNN (Nat.cast_pos.mpr (hmpos i hi)).le)
  have hLU (i : Σ _m : ℕ, ℕ × ℕ) (hi : i ∈ I) :
      UU i.1 i.2.1 i.2.2 ≤ NN / i.1 := min_le_left _ _
  have hmoment :
      (∑ i ∈ I, ‖(C0 i.2.1 i.2.2 : ℂ)‖ / (i.1 : ℝ)) ≤
        E * (Real.log x) ^ (4 : ℝ) := by
    have hrow (m : ℕ) (hm : m ∈ Finset.Icc 1 NN) :
        (∑ a ∈ m.divisorsAntidiagonal, ‖(C0 a.1 a.2 : ℂ)‖ / (m : ℝ)) ≤
          (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 2) m : ℝ) / (m : ℝ) := by
      have hcard : (m.divisors.card : ℝ) ≤
          (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 2) m : ℝ) := by
        exact_mod_cast (show m.divisors.card ≤
            ((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 2) m by
          simpa using card_divisors_pow_le_zeta_pow 1 m
            (Finset.mem_Icc.mp hm).1)
      calc
        _ ≤ ∑ _a ∈ m.divisorsAntidiagonal, (1 : ℝ) / (m : ℝ) :=
          Finset.sum_le_sum fun a ha =>
            div_le_div_of_nonneg_right (hC0 a.1 a.2) (Nat.cast_nonneg m)
        _ = (m.divisors.card : ℝ) / (m : ℝ) := by
          simp [← Nat.map_div_right_divisors, Finset.sum_const, nsmul_eq_mul,
            div_eq_mul_inv]
        _ ≤ _ := div_le_div_of_nonneg_right hcard (Nat.cast_nonneg m)
    have hHarm : 0 ≤ (harmonic NN : ℝ) := by
      simp only [harmonic_eq_sum_Icc, Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast]
      exact Finset.sum_nonneg fun m hm => inv_nonneg.mpr (Nat.cast_nonneg m)
    calc
      _ = ∑ m ∈ M, ∑ a ∈ m.divisorsAntidiagonal,
          ‖(C0 a.1 a.2 : ℂ)‖ / (m : ℝ) := by simp only [I, Finset.sum_sigma]
      _ ≤ ∑ m ∈ Finset.Icc 1 NN, ∑ a ∈ m.divisorsAntidiagonal,
          ‖(C0 a.1 a.2 : ℂ)‖ / (m : ℝ) :=
        Finset.sum_le_sum_of_subset_of_nonneg hMbox (fun m hm hnot => by positivity)
      _ ≤ ∑ m ∈ Finset.Icc 1 NN,
          (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 2) m : ℝ) / (m : ℝ) :=
        Finset.sum_le_sum hrow
      _ ≤ (harmonic NN : ℝ) ^ 2 :=
        sum_zeta_pow_div_le_harmonic_pow 2 NN
      _ ≤ (1 + Real.log (NN : ℝ)) ^ 2 :=
        pow_le_pow_left₀ hHarm (harmonic_le_one_add_log NN) 2
      _ ≤ (1 + Real.log (NN : ℝ)) ^ 4 :=
        pow_le_pow_right₀ (by linarith [Real.log_natCast_nonneg NN]) (by decide)
      _ ≤ E * (Real.log x) ^ (4 : ℝ) := by
        simpa only [Real.rpow_ofNat] using henv x hxe N hN hNU
  have hmasked (n : ℕ) : g n =
      if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0 then (A0 n : ℂ) else 0 := by
    by_cases h1 : nlo ≤ (n : ℝ) <;> by_cases h2 : (n : ℝ) ≤ nhi <;>
      by_cases h3 : Nat.Coprime n r0 <;> simp [f, g, h1, h2, h3]
  have hgoodbound :
      ‖fullDiscrepancy (∑ n ∈ GOOD, Finsupp.single n (g n)) q a‖ ≤
        Kg * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
    have hb := hgood x hxg N hNL hNU I (fun i => i.1)
      (fun i => (C0 i.2.1 i.2.2 : ℂ))
      (fun i => LL i.1 i.2.1 i.2.2) (fun i => UU i.1 i.2.1 i.2.2)
      (fun i => NN / i.1) hmpos hXL hXU hLU hmoment hsupport henvelope q hq r0 hr0 a ha
    rw [← hsource r0] at hb
    simpa only [← hmasked] using hb
  have hbadbound :
      ‖fullDiscrepancy (∑ n ∈ BAD, Finsupp.single n (g n)) q a‖ ≤
        2 * N * (Real.log x) ^ (-A) := by
    have hb := hXb x hxb N hNL hNU f (fun n hn => by simpa using hf n) q a r0 hq
    simpa only [BAD, V, NN, Y, g, one_mul, mul_one] using hb
  have hbadfilter :
      V.filter (fun n =>
        ¬(n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
          ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n)) = BAD := by
    ext n
    simp only [BAD, Finset.mem_filter, not_and_or, not_not]
    apply and_congr_right
    intro hn
    constructor
    · rintro (hn | ⟨p, hp, hY, hpn⟩)
      · exact Or.inl hn
      · exact Or.inr ⟨p, hp, (Nat.floor_lt' hp.ne_zero).mp hY, hpn⟩
    · rintro (hn | ⟨p, hp, hY, hpn⟩)
      · exact Or.inl hn
      · exact Or.inr ⟨p, hp, (Nat.floor_lt' hp.ne_zero).mpr hY, hpn⟩
  have hsplit :
      fullDiscrepancy (∑ n ∈ V, Finsupp.single n (g n)) q a =
        fullDiscrepancy (∑ n ∈ GOOD, Finsupp.single n (g n)) q a +
        fullDiscrepancy (∑ n ∈ BAD, Finsupp.single n (g n)) q a := by
    simp only [fullDiscrepancy_sample]
    rw [← hbadfilter]
    simpa only [GOOD] using
      (Finset.sum_filter_add_sum_filter_not V
        (fun n => n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
          ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n)
        (fun n => (if n % q = a % q then g n else 0) -
          (if Nat.Coprime n q then g n else 0) / (q.totient : ℂ))).symm
  have htarget :
      (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
        (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
         then (A0 n : ℂ) else 0)) =
        ∑ n ∈ V, Finsupp.single n (g n) := by
    apply Finset.sum_congr rfl
    intro n hn
    rw [hmasked]
  rw [htarget, hsplit]
  have hτ1 : (1 : ℝ) ≤ ((q * r0).divisors.card : ℝ) := by
    exact_mod_cast (Finset.one_le_card.mpr
      ⟨1, Nat.one_mem_divisors.mpr (Nat.mul_ne_zero hq.ne' hr0.ne')⟩ :
        1 ≤ (q * r0).divisors.card)
  calc
    _ ≤ ‖fullDiscrepancy (∑ n ∈ GOOD, Finsupp.single n (g n)) q a‖ +
        ‖fullDiscrepancy (∑ n ∈ BAD, Finsupp.single n (g n)) q a‖ := norm_add_le _ _
    _ ≤ Kg * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A +
        2 * N * (Real.log x) ^ (-A) := add_le_add hgoodbound hbadbound
    _ = Kg * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A +
        2 * N / (Real.log x) ^ A := by
      rw [Real.rpow_neg hlog]
      ring
    _ ≤ Kg * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A +
        2 * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
      apply add_le_add le_rfl
      apply div_le_div_of_nonneg_right _ hden
      apply mul_le_mul_of_nonneg_right _ hN
      simpa only [mul_one] using mul_le_mul_of_nonneg_left hτ1 (by norm_num : (0 : ℝ) ≤ 2)
    _ = (Kg + 2) * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by ring

open Classical in
theorem harmanA_unit_minFac_interval_prime_value
    (p m : ℕ) (hp : Nat.Prime p) (hm : 0 < m)
    (hmax : ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p)
    (z H fLo fHi : ℝ) (hz : 0 < z) (hH : 1 < H) (b : Bool) :
    let A0 : ℕ → ℤ := fun n =>
      if (1 < n ∧ ((max 1 (n.primeFactors.sup id) : ℕ) : ℝ) < z ∧
          ((n / n.minFac : ℕ) : ℝ) < H ∧ H ≤ (n : ℝ)) ∧
          fLo ≤ (n.minFac : ℝ) ∧ (n.minFac : ℝ) ≤ fHi
      then (if b then |ArithmeticFunction.moebius n| else ArithmeticFunction.moebius n)
      else 0
    let raww : ℂ :=
      ((if b then |ArithmeticFunction.moebius m| else -ArithmeticFunction.moebius m : ℤ) : ℂ)
    let w : ℂ :=
      if m = 1 ∨ (fLo ≤ (m.minFac : ℝ) ∧ (m.minFac : ℝ) ≤ fHi) then raww else 0
    let cap : ℕ := if m = 1 then Nat.ceil z - 1 else
      min (Nat.ceil z - 1) (Nat.ceil (H * (m.minFac : ℝ) / (m : ℝ)) - 1)
    let Wbase : Finset ℕ := Finset.Icc (Nat.ceil (H / (m : ℝ))) cap
    let W : Finset ℕ := if m = 1 then
      Finset.Icc (max (Nat.ceil (H / (m : ℝ))) (Nat.ceil fLo))
        (min cap (Nat.floor fHi)) else Wbase
    (A0 (m * p) : ℂ) = if p ∈ W then w else 0 := by
  intro A0 raww w cap Wbase W
  have hwindow :
      (1 < m * p ∧ ((max 1 ((m * p).primeFactors.sup id) : ℕ) : ℝ) < z ∧
        (((m * p) / (m * p).minFac : ℕ) : ℝ) < H ∧ H ≤ ((m * p : ℕ) : ℝ)) ↔
      p ∈ Wbase := by
    have h := harmanA_mobius_prime_window_iff p 1 m hp (by decide) hm
      hmax z H hz (zero_lt_one.trans hH)
    simp only [Nat.cast_one, one_mul, hH, true_and, div_one] at h
    by_cases hm1 : m = 1
    · simpa [Wbase, cap, hm1] using h
    · simpa only [Wbase, cap, ite_eq_right hm1, Nat.mul_comm m p] using h
  obtain ⟨_hnot, _hcop, hmu0, _hsup, hmin0, _hpd⟩ :=
    harmanA_mobius_prime_factor_data p m hp hm hmax
  have hmu : ArithmeticFunction.moebius (m * p) = -ArithmeticFunction.moebius m := by
    simpa only [Nat.mul_comm m p] using hmu0
  have hmin : (m * p).minFac = if m = 1 then p else m.minFac := by
    simpa only [Nat.mul_comm m p] using hmin0
  have hweight :
      ((if b then |ArithmeticFunction.moebius (m * p)|
        else ArithmeticFunction.moebius (m * p) : ℤ) : ℂ) = raww := by
    cases b <;> simp [raww, hmu]
  have hAvalue : (A0 (m * p) : ℂ) =
      if p ∈ Wbase ∧ fLo ≤ ((m * p).minFac : ℝ) ∧
          ((m * p).minFac : ℝ) ≤ fHi then raww else 0 := by
    dsimp only [A0]
    simp only [hwindow]
    by_cases hcut : p ∈ Wbase ∧ fLo ≤ ((m * p).minFac : ℝ) ∧
        ((m * p).minFac : ℝ) ≤ fHi
    · simpa only [eq_true hcut, ite_true] using hweight
    · simp only [eq_false hcut, ite_false, Int.cast_zero]
  by_cases hm1 : m = 1
  · have hW : p ∈ W ↔ p ∈ Wbase ∧ fLo ≤ (p : ℝ) ∧ (p : ℝ) ≤ fHi := by
      simp only [W, Wbase, ite_eq_left hm1, Finset.mem_Icc, max_le_iff,
        le_min_iff, Nat.ceil_le, Nat.le_floor_iff' hp.ne_zero]
      constructor
      · rintro ⟨⟨hHlo, hflo⟩, hcap, hfhi⟩
        exact ⟨⟨hHlo, hcap⟩, hflo, hfhi⟩
      · rintro ⟨⟨hHlo, hcap⟩, hflo, hfhi⟩
        exact ⟨⟨hHlo, hflo⟩, hcap, hfhi⟩
    have hmin' : (m * p).minFac = p := by
      simpa only [eq_true hm1, ite_true] using hmin
    have hw : w = raww := by
      simp only [w, eq_true hm1, true_or, ite_true]
    simp only [hAvalue, hmin', hw, ← hW]
  · have hW : p ∈ W ↔ p ∈ Wbase := by
      simp only [W, eq_false hm1, ite_false]
    have hmin' : (m * p).minFac = m.minFac := by
      simpa only [eq_false hm1, ite_false] using hmin
    rw [hAvalue, hmin']
    simp only [hW, w, eq_false hm1, false_or, ite_and]

open Classical in
theorem harmanA_unit_minFac_interval_all_moduli_siegelWalfisz
    (ε T c C A : ℝ) (hε : 0 < ε) (hT : 0 < T) (hc : 0 < c)
    (hC : 0 < C) (hA : 0 < A) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ z H lo hi fLo fHi : ℝ, 0 < z → 1 < H → c * N ≤ lo →
      ∀ b : Bool, ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 →
      ∀ a : ℕ, Nat.Coprime a q →
      let A0 : ℕ → ℤ := fun n =>
        if (1 < n ∧ ((max 1 (n.primeFactors.sup id) : ℕ) : ℝ) < z ∧
            ((n / n.minFac : ℕ) : ℝ) < H ∧ H ≤ (n : ℝ)) ∧
            fLo ≤ (n.minFac : ℝ) ∧ (n.minFac : ℝ) ≤ fHi
        then (if b then |ArithmeticFunction.moebius n| else ArithmeticFunction.moebius n)
        else 0
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
          (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n r0
           then (A0 n : ℂ) else 0)) q a‖ ≤
        K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨E, hE, Xe, hXe, henv⟩ := exists_cofactor_log_fourth_envelope T C hT hC
  obtain ⟨Kg, Xg, hKg, hXg, hgood⟩ :=
    largest_prime_windows_all_moduli_siegelWalfisz
      0 1 ε c T C 4 E A hε hc hT hE.le hA
  obtain ⟨Xb, hXb⟩ := Filter.eventually_atTop.mp
    (eventually_exceptional_coefficient_discrepancy_le
      0 1 A 0 C ε T (by norm_num) hε hT)
  refine ⟨Kg + 2, max Xg (max Xe Xb), by linarith,
    hXg.trans (le_max_left _ _), ?_⟩
  intro x hx N hNL hNU z H lo hi fLo fHi hz hH hlo b q hq r0 hr0 a ha A0
  have hxg : Xg ≤ x := (le_max_left _ _).trans hx
  have hxe : Xe ≤ x := (le_max_left Xe Xb).trans ((le_max_right _ _).trans hx)
  have hxb : Xb ≤ x := (le_max_right Xe Xb).trans ((le_max_right _ _).trans hx)
  have hxexp : Real.exp 1 ≤ x := hXg.trans hxg
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hxexp
  have hlog : 0 ≤ Real.log x := zero_le_one.trans hlog1
  have hN : 0 ≤ N := (Real.rpow_pos_of_pos hx0 ε).le.trans hNL
  have hden : 0 ≤ (Real.log x) ^ A := Real.rpow_nonneg hlog A
  let NN := Nat.floor (T * N)
  let Y := Nat.floor (Real.exp (Real.sqrt (Real.log x)))
  let V : Finset ℕ := Finset.Icc 1 NN
  let GOOD : Finset ℕ := V.filter (fun n =>
    n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
      ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n)
  let BAD : Finset ℕ := V.filter (fun n =>
    n ∈ Nat.factoredNumbers (Nat.primesLE Y) ∨
      ∃ p : ℕ, Nat.Prime p ∧
        Real.exp (Real.sqrt (Real.log x)) < (p : ℝ) ∧ p ^ 2 ∣ n)
  let M : Finset ℕ := (Finset.Icc 1 (NN / (Y + 1))).filter (fun m =>
    ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ m)
  let raww : ℕ → ℂ := fun m =>
    ((if b then |ArithmeticFunction.moebius m| else -ArithmeticFunction.moebius m : ℤ) : ℂ)
  let w : ℕ → ℂ := fun m =>
    if m = 1 ∨ (fLo ≤ (m.minFac : ℝ) ∧ (m.minFac : ℝ) ≤ fHi)
    then raww m else 0
  let cap : ℕ → ℕ := fun m =>
    if m = 1 then Nat.ceil z - 1 else
      min (Nat.ceil z - 1) (Nat.ceil (H * (m.minFac : ℝ) / (m : ℝ)) - 1)
  let baseLL : ℕ → ℕ := fun m => max (Y + 1)
    (max (m.primeFactors.sup id + 1)
      (max (Nat.ceil (lo / (m : ℝ))) (Nat.ceil (H / (m : ℝ)))))
  let baseUU : ℕ → ℕ := fun m =>
    min (NN / m) (min (Nat.floor (hi / (m : ℝ))) (cap m))
  let LL : ℕ → ℕ := fun m =>
    if m = 1 then max (baseLL m) (Nat.ceil fLo) else baseLL m
  let UU : ℕ → ℕ := fun m =>
    if m = 1 then min (baseUU m) (Nat.floor fHi) else baseUU m
  let f : ℕ → ℂ := fun n =>
    if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi then (A0 n : ℂ) else 0
  let g : ℕ → ℂ := fun n => if Nat.Coprime n r0 then f n else 0
  let F0 : ℕ →₀ ℂ := ∑ m ∈ M, ∑ p ∈ Finset.Icc (LL m) (UU m),
    Finsupp.single (m * p) (if Nat.Prime p then w m else 0)
  have hA0 (n : ℕ) : ‖(A0 n : ℂ)‖ ≤ 1 := by
    dsimp only [A0]
    split
    · rcases ArithmeticFunction.moebius_eq_or n with h | h | h <;> cases b <;> simp [h]
    · simp
  have hw (m : ℕ) : ‖w m‖ ≤ 1 := by
    have hr : ‖raww m‖ ≤ 1 := by
      dsimp only [raww]
      rcases ArithmeticFunction.moebius_eq_or m with h | h | h <;> cases b <;> simp [h]
    dsimp only [w]
    split_ifs
    · exact hr
    · simp
  have hf (n : ℕ) : ‖f n‖ ≤ 1 := by
    dsimp only [f]
    split_ifs
    · exact hA0 n
    · simp
  have hmpos (m : ℕ) (hm : m ∈ M) : 0 < m :=
    (Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1).1
  have hMbox : M ⊆ Finset.Icc 1 NN := by
    intro m hm
    have hI := Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1
    exact Finset.mem_Icc.mpr ⟨hI.1, hI.2.trans (Nat.div_le_self NN (Y + 1))⟩
  have hsource (R : ℕ) :
      (∑ n ∈ GOOD, Finsupp.single n
        (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n R
          then (A0 n : ℂ) else 0)) =
      ∑ m ∈ M, ∑ p ∈ Finset.Icc (LL m) (UU m), Finsupp.single (m * p)
        (if Nat.Prime p ∧ Nat.Coprime (m * p) R then w m else 0) := by
    change (∑ n ∈ (Finset.Icc 1 NN).filter (fun n =>
        n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
          ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n),
      Finsupp.single n (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n R
        then (A0 n : ℂ) else 0)) = _
    rw [good_integer_largest_prime_finsupp_reindex_truncated]
    apply Finset.sum_congr rfl
    intro m hm
    have hm0 := hmpos m hm
    have hmR : 0 < (m : ℝ) := Nat.cast_pos.mpr hm0
    let P : Finset ℕ := (Finset.Icc (Y + 1) (NN / m)).filter (fun p =>
      Nat.Prime p ∧ ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p)
    let Wbase : Finset ℕ := Finset.Icc (Nat.ceil (H / (m : ℝ))) (cap m)
    let W : Finset ℕ := if m = 1 then
      Finset.Icc (max (Nat.ceil (H / (m : ℝ))) (Nat.ceil fLo))
        (min (cap m) (Nat.floor fHi)) else Wbase
    have hvalue (p : ℕ) (hp : Nat.Prime p)
        (hmax : ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p) :
        (A0 (m * p) : ℂ) = if p ∈ W then w m else 0 :=
      harmanA_unit_minFac_interval_prime_value p m hp hm0 hmax
        z H fLo fHi hz hH b
    have hcarrier :
        P.filter (fun p =>
          lo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ hi ∧ p ∈ W) =
        (Finset.Icc (LL m) (UU m)).filter Nat.Prime := by
      ext p
      by_cases hp : Nat.Prime p
      · have hmax :
            m.primeFactors.sup id + 1 ≤ p ↔
              ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p := by
          rw [Nat.add_one_le_iff, Finset.sup_lt_iff hp.pos]
          constructor
          · intro ht t htp htm
            exact ht t (htp.mem_primeFactors htm hm0.ne')
          · intro ht t htm
            exact ht t (Nat.prime_of_mem_primeFactors htm) (Nat.dvd_of_mem_primeFactors htm)
        have hlo' : Nat.ceil (lo / (m : ℝ)) ≤ p ↔ lo ≤ ((m * p : ℕ) : ℝ) := by
          have h : Nat.ceil (lo / (m : ℝ)) ≤ p ↔ lo ≤ (p : ℝ) * (m : ℝ) := by
            rw [Nat.ceil_le, div_le_iff₀ hmR]
          simpa only [Nat.cast_mul, mul_comm] using h
        have hhi' : p ≤ Nat.floor (hi / (m : ℝ)) ↔ ((m * p : ℕ) : ℝ) ≤ hi := by
          have h : p ≤ Nat.floor (hi / (m : ℝ)) ↔ (p : ℝ) * (m : ℝ) ≤ hi := by
            rw [Nat.le_floor_iff' hp.ne_zero, le_div_iff₀ hmR]
          simpa only [Nat.cast_mul, mul_comm] using h
        by_cases hm1 : m = 1
        · simp only [P, W, Wbase, LL, UU, baseLL, baseUU, ite_eq_left hm1,
            Finset.mem_filter, Finset.mem_Icc, max_le_iff, le_min_iff, hp,
            true_and, and_true, hmax, hlo', hhi']
          constructor
          · rintro ⟨⟨⟨hYp, hNp⟩, hmp⟩, hloP, hhiP, ⟨hHp, hfl⟩, hzp, hfh⟩
            exact ⟨⟨⟨hYp, hmp, hloP, hHp⟩, hfl⟩,
              ⟨⟨hNp, hhiP, hzp⟩, hfh⟩⟩
          · rintro ⟨⟨⟨hYp, hmp, hloP, hHp⟩, hfl⟩,
                ⟨⟨hNp, hhiP, hzp⟩, hfh⟩⟩
            exact ⟨⟨⟨hYp, hNp⟩, hmp⟩, hloP, hhiP, ⟨hHp, hfl⟩, hzp, hfh⟩
        · simp only [P, W, Wbase, LL, UU, baseLL, baseUU, ite_eq_right hm1,
            Finset.mem_filter, Finset.mem_Icc, max_le_iff, le_min_iff, hp,
            true_and, and_true, hmax, hlo', hhi']
          constructor
          · rintro ⟨⟨⟨hYp, hNp⟩, hmp⟩, hloP, hhiP, hHp, hzp⟩
            exact ⟨⟨hYp, hmp, hloP, hHp⟩, hNp, hhiP, hzp⟩
          · rintro ⟨⟨hYp, hmp, hloP, hHp⟩, hNp, hhiP, hzp⟩
            exact ⟨⟨⟨hYp, hNp⟩, hmp⟩, hloP, hhiP, hHp, hzp⟩
      · simp only [P, Finset.mem_filter, hp, false_and, and_false]
    change (∑ p ∈ P, Finsupp.single (m * p)
      (if lo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ hi ∧
        Nat.Coprime (m * p) R then (A0 (m * p) : ℂ) else 0)) = _
    calc
      _ = ∑ p ∈ P.filter (fun p =>
          lo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ hi ∧ p ∈ W),
          Finsupp.single (m * p) (if Nat.Coprime (m * p) R then w m else 0) := by
        conv_rhs => rw [Finset.sum_filter]
        apply Finset.sum_congr rfl
        intro p hpP
        obtain ⟨hp, hmax⟩ := (Finset.mem_filter.mp hpP).2
        rw [hvalue p hp hmax]
        simp only [ite_and, apply_ite (Finsupp.single (m * p)), Finsupp.single_zero]
        by_cases hW : p ∈ W
        · simp only [eq_true hW, ite_true]
        · simp only [eq_false hW, ite_false, ite_self]
      _ = _ := by
        rw [hcarrier, Finset.sum_filter]
        apply Finset.sum_congr rfl
        intro p hpP
        by_cases hp : Nat.Prime p <;> simp [hp]
  have hF0eq : F0 = ∑ n ∈ GOOD, Finsupp.single n (f n) := by
    simpa only [F0, f, Nat.coprime_one_right_eq_true, and_true] using (hsource 1).symm
  have hF0 (n : ℕ) : F0 n = if n ∈ GOOD then f n else 0 := by
    rw [hF0eq]
    simp [Finsupp.finsetSum_apply, Finsupp.single_apply]
  have hsupport : ∀ n ∈ F0.support, c * N ≤ (n : ℝ) ∧ (n : ℝ) ≤ T * N := by
    intro n hn
    have hne := Finsupp.mem_support_iff.mp hn
    rw [hF0] at hne
    have hparts : n ∈ GOOD ∧ f n ≠ 0 := by
      simpa only [ite_ne_right_iff] using hne
    have hlocal : lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi := by
      have hfne := hparts.2
      dsimp only [f] at hfne
      exact (ite_ne_right_iff.mp hfne).1
    exact ⟨hlo.trans hlocal.1,
      (Nat.cast_le.mpr (Finset.mem_Icc.mp (Finset.mem_filter.mp hparts.1).1).2).trans
        (Nat.floor_le (mul_nonneg hT.le hN))⟩
  have henvelope : ∀ n ∈ F0.support,
      ‖F0 n‖ ≤ 1 * (n.divisors.card : ℝ) ^ (0 : ℝ) *
        (Real.log x) ^ (0 : ℝ) := by
    intro n hn
    rw [hF0]
    split_ifs
    · simpa using hf n
    · simp
  have hNN : (NN : ℝ) ≤ T * N := Nat.floor_le (mul_nonneg hT.le hN)
  have hXL (m : ℕ) (hm : m ∈ M) :
      Real.exp (Real.sqrt (Real.log x)) ≤ ((NN / m : ℕ) : ℝ) :=
    (cofactor_prime_scale_above_real_cutoff NN m (Real.exp (Real.sqrt (Real.log x)))
      (hmpos m hm) (Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1).2).le
  have hXU (m : ℕ) (hm : m ∈ M) :
      ((NN / m : ℕ) : ℝ) ≤ T * N / (m : ℝ) :=
    (Nat.cast_div_le (m := NN) (n := m) (α := ℝ)).trans
      (div_le_div_of_nonneg_right hNN (Nat.cast_pos.mpr (hmpos m hm)).le)
  have hLU (m : ℕ) (hm : m ∈ M) : UU m ≤ NN / m := by
    dsimp only [UU]
    split_ifs
    · exact (min_le_left _ _).trans (min_le_left _ _)
    · exact min_le_left _ _
  have hmoment : (∑ m ∈ M, ‖w m‖ / (m : ℝ)) ≤ E * (Real.log x) ^ (4 : ℝ) := by
    calc
      _ ≤ ∑ m ∈ M, (1 : ℝ) / (m : ℝ) :=
        Finset.sum_le_sum fun m hm =>
          div_le_div_of_nonneg_right (hw m) (Nat.cast_nonneg m)
      _ ≤ ∑ m ∈ Finset.Icc 1 NN, (1 : ℝ) / (m : ℝ) :=
        Finset.sum_le_sum_of_subset_of_nonneg hMbox (fun m hm hnot => by positivity)
      _ = (harmonic NN : ℝ) := by
        simp only [harmonic_eq_sum_Icc, Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast, one_div]
      _ ≤ 1 + Real.log (NN : ℝ) := harmonic_le_one_add_log NN
      _ ≤ (1 + Real.log (NN : ℝ)) ^ 4 :=
        le_self_pow₀ (by linarith [Real.log_natCast_nonneg NN]) (by decide)
      _ ≤ E * (Real.log x) ^ (4 : ℝ) := by
        simpa only [Real.rpow_ofNat] using henv x hxe N hN hNU
  have hmasked (n : ℕ) : g n =
      if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n r0 then (A0 n : ℂ) else 0 := by
    by_cases h1 : lo ≤ (n : ℝ) <;> by_cases h2 : (n : ℝ) ≤ hi <;>
      by_cases h3 : Nat.Coprime n r0 <;> simp [f, g, h1, h2, h3]
  have hgoodbound :
      ‖fullDiscrepancy (∑ n ∈ GOOD, Finsupp.single n (g n)) q a‖ ≤
        Kg * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
    have hb := hgood x hxg N hNL hNU M id w LL UU (fun m => NN / m)
      hmpos hXL hXU hLU hmoment hsupport henvelope q hq r0 hr0 a ha
    simp only [id_eq] at hb
    rw [← hsource r0] at hb
    simpa only [← hmasked] using hb
  have hbadbound :
      ‖fullDiscrepancy (∑ n ∈ BAD, Finsupp.single n (g n)) q a‖ ≤
        2 * N * (Real.log x) ^ (-A) := by
    have hb := hXb x hxb N hNL hNU f (fun n hn => by simpa using hf n) q a r0 hq
    simpa only [BAD, V, NN, Y, g, one_mul, mul_one, pow_zero, Real.rpow_zero] using hb
  have hbadfilter :
      V.filter (fun n =>
        ¬(n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
          ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n)) = BAD := by
    ext n
    simp only [BAD, Finset.mem_filter, not_and_or, not_not]
    apply and_congr_right
    intro hn
    constructor
    · rintro (hn | ⟨p, hp, hY, hpn⟩)
      · exact Or.inl hn
      · exact Or.inr ⟨p, hp, (Nat.floor_lt' hp.ne_zero).mp hY, hpn⟩
    · rintro (hn | ⟨p, hp, hY, hpn⟩)
      · exact Or.inl hn
      · exact Or.inr ⟨p, hp, (Nat.floor_lt' hp.ne_zero).mpr hY, hpn⟩
  have hsplit :
      fullDiscrepancy (∑ n ∈ V, Finsupp.single n (g n)) q a =
        fullDiscrepancy (∑ n ∈ GOOD, Finsupp.single n (g n)) q a +
        fullDiscrepancy (∑ n ∈ BAD, Finsupp.single n (g n)) q a := by
    simp only [fullDiscrepancy_sample]
    rw [← hbadfilter]
    simpa only [GOOD] using
      (Finset.sum_filter_add_sum_filter_not V
        (fun n => n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
          ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n)
        (fun n => (if n % q = a % q then g n else 0) -
          (if Nat.Coprime n q then g n else 0) / (q.totient : ℂ))).symm
  have htarget :
      (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
        (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n r0
         then (A0 n : ℂ) else 0)) =
        ∑ n ∈ V, Finsupp.single n (g n) := by
    apply Finset.sum_congr rfl
    intro n hn
    rw [hmasked]
  rw [htarget, hsplit]
  have hτ1 : (1 : ℝ) ≤ ((q * r0).divisors.card : ℝ) := by
    exact_mod_cast (Finset.one_le_card.mpr
      ⟨1, Nat.one_mem_divisors.mpr (Nat.mul_ne_zero hq.ne' hr0.ne')⟩ :
        1 ≤ (q * r0).divisors.card)
  calc
    _ ≤ ‖fullDiscrepancy (∑ n ∈ GOOD, Finsupp.single n (g n)) q a‖ +
        ‖fullDiscrepancy (∑ n ∈ BAD, Finsupp.single n (g n)) q a‖ := norm_add_le _ _
    _ ≤ Kg * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A +
        2 * N * (Real.log x) ^ (-A) := add_le_add hgoodbound hbadbound
    _ = Kg * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A +
        2 * N / (Real.log x) ^ A := by
      rw [Real.rpow_neg hlog]
      ring
    _ ≤ Kg * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A +
        2 * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
      apply add_le_add le_rfl
      apply div_le_div_of_nonneg_right _ hden
      apply mul_le_mul_of_nonneg_right _ hN
      simpa only [mul_one] using mul_le_mul_of_nonneg_left hτ1 (by norm_num : (0 : ℝ) ≤ 2)
    _ = (Kg + 2) * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by ring

open Classical in
theorem harmanA_unit_all_moduli_siegelWalfisz_of_minFac_interval
    (ε T c C A : ℝ) (hε : 0 < ε) (hT : 0 < T) (hc : 0 < c)
    (hC : 0 < C) (hA : 0 < A) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ z H lo hi : ℝ, 0 < z → 1 < H → c * N ≤ lo →
      ∀ b : Bool, ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 →
      ∀ a : ℕ, Nat.Coprime a q →
      let A0 : ℕ → ℤ := fun n =>
        if 1 < n ∧ ((max 1 (n.primeFactors.sup id) : ℕ) : ℝ) < z ∧
            ((n / n.minFac : ℕ) : ℝ) < H ∧ H ≤ (n : ℝ)
        then (if b then |ArithmeticFunction.moebius n| else ArithmeticFunction.moebius n)
        else 0
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
          (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n r0
           then (A0 n : ℂ) else 0)) q a‖ ≤
        K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨K, X0, hK, hX0, hmain⟩ :=
    harmanA_unit_minFac_interval_all_moduli_siegelWalfisz ε T c C A hε hT hc hC hA
  refine ⟨K, X0, hK, hX0, ?_⟩
  intro x hx N hNL hNU z H lo hi hz hH hlo b q hq r0 hr0 a ha A0
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le (hX0.trans hx)
  have hN : 0 ≤ N := (Real.rpow_pos_of_pos hx0 ε).le.trans hNL
  let A1 : ℕ → ℤ := fun n =>
    if (1 < n ∧ ((max 1 (n.primeFactors.sup id) : ℕ) : ℝ) < z ∧
        ((n / n.minFac : ℕ) : ℝ) < H ∧ H ≤ (n : ℝ)) ∧
        0 ≤ (n.minFac : ℝ) ∧ (n.minFac : ℝ) ≤ T * N
    then (if b then |ArithmeticFunction.moebius n| else ArithmeticFunction.moebius n)
    else 0
  have hsample (n : ℕ) (hn : n ∈ Finset.Icc 1 (Nat.floor (T * N))) :
      A1 n = A0 n := by
    have hn0 : 0 < n := (Finset.mem_Icc.mp hn).1
    have hmin : (n.minFac : ℝ) ≤ T * N :=
      (Nat.cast_le.mpr (Nat.minFac_le hn0)).trans
        ((Nat.cast_le.mpr (Finset.mem_Icc.mp hn).2).trans
          (Nat.floor_le (mul_nonneg hT.le hN)))
    simp only [A1, A0, Nat.cast_nonneg, hmin, and_self, and_true]
  have hsource :
      (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
        (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n r0
          then (A1 n : ℂ) else 0)) =
      ∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
        (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n r0
          then (A0 n : ℂ) else 0) := by
    apply Finset.sum_congr rfl
    intro n hn
    rw [hsample n hn]
  have hbound := hmain x hx N hNL hNU z H lo hi 0 (T * N) hz hH hlo
    b q hq r0 hr0 a ha
  change ‖fullDiscrepancy
    (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
      (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n r0
        then (A1 n : ℂ) else 0)) q a‖ ≤ _ at hbound
  rw [hsource] at hbound
  exact hbound

open Classical in
theorem harmanA0_named_coefficient_norm_le
    (n : ℕ) (j k : Fin 2) (P : ℕ → ℕ → ℕ → Prop)
    (L U : ℕ → ℕ → ℕ → ℝ) (z M0 : ℝ) (b : Bool) :
    let A0 : ℕ → ℤ := fun n =>
      if (n : ℝ) ≤ M0 then
        ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
          ∑ cc ∈ bb.2.divisorsAntidiagonal,
            if Nat.Prime aa.1 ∧ z ≤ (aa.1 : ℝ) ∧
                (if j = 0 then bb.1 = 1 else Nat.Prime bb.1 ∧ z ≤ (bb.1 : ℝ)) ∧
                bb.1 ≤ aa.1 ∧
                (if k = 0 then cc.1 = 1 else Nat.Prime cc.1 ∧ z ≤ (cc.1 : ℝ)) ∧
                cc.1 ≤ aa.1 ∧ ((max 1 (cc.2.primeFactors.sup id) : ℕ) : ℝ) < z ∧
                P bb.1 cc.1 cc.2 ∧ L bb.1 cc.1 cc.2 ≤ (aa.1 : ℝ) ∧
                (aa.1 : ℝ) ≤ U bb.1 cc.1 cc.2
            then (if b then |ArithmeticFunction.moebius cc.2|
                  else ArithmeticFunction.moebius cc.2)
            else 0
      else 0
    ‖(A0 n : ℂ)‖ ≤ (n.divisors.card : ℝ) ^ 3 := by
  intro A0
  have hmu (m : ℕ) :
      ‖((if b then |ArithmeticFunction.moebius m|
        else ArithmeticFunction.moebius m : ℤ) : ℂ)‖ ≤ 1 := by
    rcases ArithmeticFunction.moebius_eq_or m with h | h | h <;> cases b <;> simp [h]
  by_cases hn : (n : ℝ) ≤ M0
  · have hh := norm_four_divisor_sum_le_divisor_cube n
      (fun p s t h => ((if Nat.Prime p ∧ z ≤ (p : ℝ) ∧
          (if j = 0 then s = 1 else Nat.Prime s ∧ z ≤ (s : ℝ)) ∧ s ≤ p ∧
          (if k = 0 then t = 1 else Nat.Prime t ∧ z ≤ (t : ℝ)) ∧ t ≤ p ∧
          ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧ P s t h ∧
          L s t h ≤ (p : ℝ) ∧ (p : ℝ) ≤ U s t h
        then (if b then |ArithmeticFunction.moebius h| else ArithmeticFunction.moebius h)
        else 0 : ℤ) : ℂ)) (by
          intro aa _haa bb _hbb cc _hcc
          exact norm_harman_int_cut_le_one _ _ (hmu cc.2))
    simpa only [A0, ite_eq_left hn, Int.cast_sum] using hh
  · simpa only [A0, ite_eq_right hn, Int.cast_zero, norm_zero] using
      pow_nonneg (Nat.cast_nonneg n.divisors.card : (0 : ℝ) ≤ n.divisors.card) 3

open Classical in
theorem harmanA0_named_all_moduli_siegelWalfisz
    (ε T c C A : ℝ) (hε : 0 < ε) (hT : 0 < T) (hc : 0 < c)
    (hC : 0 < C) (hA : 0 < A) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ j k : Fin 2, ∀ P : ℕ → ℕ → ℕ → Prop, ∀ L U : ℕ → ℕ → ℕ → ℝ,
      ∀ z M0 nlo nhi : ℝ, 0 < z → c * N ≤ nlo →
      ∀ b : Bool, ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 →
      ∀ a : ℕ, Nat.Coprime a q →
      let A0 : ℕ → ℤ := fun n =>
        if (n : ℝ) ≤ M0 then
          ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
            ∑ cc ∈ bb.2.divisorsAntidiagonal,
              if Nat.Prime aa.1 ∧ z ≤ (aa.1 : ℝ) ∧
                  (if j = 0 then bb.1 = 1 else Nat.Prime bb.1 ∧ z ≤ (bb.1 : ℝ)) ∧
                  bb.1 ≤ aa.1 ∧
                  (if k = 0 then cc.1 = 1 else Nat.Prime cc.1 ∧ z ≤ (cc.1 : ℝ)) ∧
                  cc.1 ≤ aa.1 ∧ ((max 1 (cc.2.primeFactors.sup id) : ℕ) : ℝ) < z ∧
                  P bb.1 cc.1 cc.2 ∧ L bb.1 cc.1 cc.2 ≤ (aa.1 : ℝ) ∧
                  (aa.1 : ℝ) ≤ U bb.1 cc.1 cc.2
              then (if b then |ArithmeticFunction.moebius cc.2|
                    else ArithmeticFunction.moebius cc.2)
              else 0
        else 0
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
          (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
           then (A0 n : ℂ) else 0)) q a‖ ≤
        K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨E, hE, Xe, _hXe, henv⟩ := exists_cofactor_log_fourth_envelope T C hT hC
  obtain ⟨Kg, Xg, hKg, hXg, hgood⟩ :=
    largest_prime_windows_all_moduli_siegelWalfisz
      3 1 ε c T C 4 E A hε hc hT hE.le hA
  obtain ⟨Xb, hXb⟩ := Filter.eventually_atTop.mp
    (eventually_exceptional_coefficient_discrepancy_le
      3 1 A 0 C ε T (by norm_num) hε hT)
  refine ⟨Kg + 2, max Xg (max Xe Xb), by linarith,
    hXg.trans (le_max_left _ _), ?_⟩
  intro x hx N hNL hNU j k P L U z M0 nlo nhi hz hlo b q hq r0 hr0 a ha A0
  have hxg : Xg ≤ x := (le_max_left _ _).trans hx
  have hxe : Xe ≤ x := (le_max_left Xe Xb).trans ((le_max_right _ _).trans hx)
  have hxb : Xb ≤ x := (le_max_right Xe Xb).trans ((le_max_right _ _).trans hx)
  have hxexp : Real.exp 1 ≤ x := hXg.trans hxg
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hxexp
  have hlog : 0 ≤ Real.log x := zero_le_one.trans hlog1
  have hN : 0 ≤ N := (Real.rpow_pos_of_pos hx0 ε).le.trans hNL
  have hden : 0 ≤ (Real.log x) ^ A := Real.rpow_nonneg hlog A
  let NN := Nat.floor (T * N)
  let Y := Nat.floor (Real.exp (Real.sqrt (Real.log x)))
  let V : Finset ℕ := Finset.Icc 1 NN
  let GOOD : Finset ℕ := V.filter (fun n =>
    n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
      ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n)
  let BAD : Finset ℕ := V.filter (fun n =>
    n ∈ Nat.factoredNumbers (Nat.primesLE Y) ∨
      ∃ p : ℕ, Nat.Prime p ∧
        Real.exp (Real.sqrt (Real.log x)) < (p : ℝ) ∧ p ^ 2 ∣ n)
  let M : Finset ℕ := (Finset.Icc 1 (NN / (Y + 1))).filter (fun m =>
    ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ m)
  let C0 : ℕ → ℕ → ℕ → ℤ := fun s t h =>
    if (if j = 0 then s = 1 else Nat.Prime s ∧ z ≤ (s : ℝ)) ∧
        (if k = 0 then t = 1 else Nat.Prime t ∧ z ≤ (t : ℝ)) ∧
        ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧ P s t h
    then (if b then |ArithmeticFunction.moebius h| else ArithmeticFunction.moebius h)
    else 0
  let LL : ℕ → ℕ → ℕ → ℕ → ℕ := fun m s t h =>
    max (Y + 1) (max (m.primeFactors.sup id + 1)
      (max s (max t (max (Nat.ceil z)
        (max (Nat.ceil (L s t h)) (Nat.ceil (nlo / (m : ℝ))))))))
  let UU : ℕ → ℕ → ℕ → ℕ → ℕ := fun m s t h =>
    min (NN / m) (min (Nat.floor (M0 / (m : ℝ)))
      (min (Nat.floor (U s t h)) (Nat.floor (nhi / (m : ℝ)))))
  let I : Finset (Σ _m : ℕ, Σ _aa : ℕ × ℕ, ℕ × ℕ) :=
    M.sigma (fun m => m.divisorsAntidiagonal.sigma (fun aa => aa.2.divisorsAntidiagonal))
  let f : ℕ → ℂ := fun n =>
    if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi then (A0 n : ℂ) else 0
  let g : ℕ → ℂ := fun n => if Nat.Coprime n r0 then f n else 0
  let F0 : ℕ →₀ ℂ := ∑ i ∈ I, ∑ p ∈ Finset.Icc
      (LL i.1 i.2.1.1 i.2.2.1 i.2.2.2) (UU i.1 i.2.1.1 i.2.2.1 i.2.2.2),
    Finsupp.single (i.1 * p)
      (if Nat.Prime p then (C0 i.2.1.1 i.2.2.1 i.2.2.2 : ℂ) else 0)
  have hmu (n : ℕ) :
      ‖((if b then |ArithmeticFunction.moebius n|
        else ArithmeticFunction.moebius n : ℤ) : ℂ)‖ ≤ 1 := by
    rcases ArithmeticFunction.moebius_eq_or n with h | h | h <;> cases b <;> simp [h]
  have hA0 (n : ℕ) : ‖(A0 n : ℂ)‖ ≤ (n.divisors.card : ℝ) ^ 3 :=
    harmanA0_named_coefficient_norm_le n j k P L U z M0 b
  have hC0 (s t h : ℕ) : ‖(C0 s t h : ℂ)‖ ≤ 1 := by
    dsimp only [C0]
    exact norm_harman_int_cut_le_one _ _ (hmu h)
  have hf (n : ℕ) : ‖f n‖ ≤ (n.divisors.card : ℝ) ^ 3 := by
    by_cases hlocal : nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi
    · simpa only [f, ite_eq_left hlocal] using hA0 n
    · simpa only [f, ite_eq_right hlocal, norm_zero] using
        pow_nonneg (Nat.cast_nonneg n.divisors.card : (0 : ℝ) ≤ n.divisors.card) 3
  have hindex (i : Σ _m : ℕ, Σ _aa : ℕ × ℕ, ℕ × ℕ) (hi : i ∈ I) :
      i.1 ∈ M ∧ i.2.1 ∈ i.1.divisorsAntidiagonal ∧
        i.2.2 ∈ i.2.1.2.divisorsAntidiagonal := by
    obtain ⟨hm, ha⟩ := Finset.mem_sigma.mp hi
    exact ⟨hm, Finset.mem_sigma.mp ha⟩
  have hmpos (i : Σ _m : ℕ, Σ _aa : ℕ × ℕ, ℕ × ℕ) (hi : i ∈ I) : 0 < i.1 :=
    (Finset.mem_Icc.mp (Finset.mem_filter.mp (hindex i hi).1).1).1
  have hMbox : M ⊆ Finset.Icc 1 NN := by
    intro m hm
    have hI := Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1
    exact Finset.mem_Icc.mpr ⟨hI.1, hI.2.trans (Nat.div_le_self NN (Y + 1))⟩
  have hprimefilter (R m l u : ℕ) (w : ℂ) :
      (∑ p ∈ (Finset.Icc l u).filter Nat.Prime,
        Finsupp.single (m * p) (if Nat.Coprime (m * p) R then w else 0)) =
      ∑ p ∈ Finset.Icc l u, Finsupp.single (m * p)
        (if Nat.Prime p ∧ Nat.Coprime (m * p) R then w else 0) := by
    rw [Finset.sum_filter]
    apply Finset.sum_congr rfl
    intro p hp
    by_cases hp' : Nat.Prime p <;> simp [hp']
  have hsource (R : ℕ) :
      (∑ n ∈ GOOD, Finsupp.single n
        (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n R
          then (A0 n : ℂ) else 0)) =
      ∑ i ∈ I, ∑ p ∈ Finset.Icc
          (LL i.1 i.2.1.1 i.2.2.1 i.2.2.2) (UU i.1 i.2.1.1 i.2.2.1 i.2.2.2),
        Finsupp.single (i.1 * p)
          (if Nat.Prime p ∧ Nat.Coprime (i.1 * p) R
           then (C0 i.2.1.1 i.2.2.1 i.2.2.2 : ℂ) else 0) := by
    have hs := harmanA0_named_good_part_prime_windows
      NN Y R j k P L U z M0 nlo nhi hz b
    dsimp only at hs
    simp only [hprimefilter] at hs
    simpa only [A0, C0, LL, UU, GOOD, V, M, I, Finset.sum_sigma] using hs
  have hF0eq : F0 = ∑ n ∈ GOOD, Finsupp.single n (f n) := by
    simpa only [F0, f, Nat.coprime_one_right_eq_true, and_true] using (hsource 1).symm
  have hF0 (n : ℕ) : F0 n = if n ∈ GOOD then f n else 0 := by
    rw [hF0eq]
    simp [Finsupp.finsetSum_apply, Finsupp.single_apply]
  have hsupport : ∀ n ∈ F0.support, c * N ≤ (n : ℝ) ∧ (n : ℝ) ≤ T * N := by
    intro n hn
    have hne := Finsupp.mem_support_iff.mp hn
    rw [hF0] at hne
    have hparts : n ∈ GOOD ∧ f n ≠ 0 := by
      simpa only [ite_ne_right_iff] using hne
    have hlocal : nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi := by
      have hfne := hparts.2
      dsimp only [f] at hfne
      exact (ite_ne_right_iff.mp hfne).1
    exact ⟨hlo.trans hlocal.1,
      (Nat.cast_le.mpr (Finset.mem_Icc.mp (Finset.mem_filter.mp hparts.1).1).2).trans
        (Nat.floor_le (mul_nonneg hT.le hN))⟩
  have hFbound (n : ℕ) : ‖F0 n‖ ≤ (n.divisors.card : ℝ) ^ (3 : ℝ) := by
    rw [hF0]
    split_ifs
    · simpa only [Real.rpow_ofNat] using hf n
    · simp only [norm_zero]
      exact Real.rpow_nonneg (Nat.cast_nonneg _) _
  have henvelope : ∀ n ∈ F0.support,
      ‖F0 n‖ ≤ 1 * (n.divisors.card : ℝ) ^ (3 : ℝ) *
        (Real.log x) ^ (3 : ℝ) := by
    intro n hn
    exact (hFbound n).trans (by
      simpa only [one_mul] using
        le_mul_of_one_le_right (Real.rpow_nonneg (Nat.cast_nonneg n.divisors.card) (3 : ℝ))
          (Real.one_le_rpow hlog1 (by norm_num : (0 : ℝ) ≤ 3)))
  have hNN : (NN : ℝ) ≤ T * N := Nat.floor_le (mul_nonneg hT.le hN)
  have hXL (i : Σ _m : ℕ, Σ _aa : ℕ × ℕ, ℕ × ℕ) (hi : i ∈ I) :
      Real.exp (Real.sqrt (Real.log x)) ≤ ((NN / i.1 : ℕ) : ℝ) :=
    (cofactor_prime_scale_above_real_cutoff NN i.1 (Real.exp (Real.sqrt (Real.log x)))
      (hmpos i hi) (Finset.mem_Icc.mp (Finset.mem_filter.mp (hindex i hi).1).1).2).le
  have hXU (i : Σ _m : ℕ, Σ _aa : ℕ × ℕ, ℕ × ℕ) (hi : i ∈ I) :
      ((NN / i.1 : ℕ) : ℝ) ≤ T * N / (i.1 : ℝ) :=
    (Nat.cast_div_le (m := NN) (n := i.1) (α := ℝ)).trans
      (div_le_div_of_nonneg_right hNN (Nat.cast_pos.mpr (hmpos i hi)).le)
  have hLU (i : Σ _m : ℕ, Σ _aa : ℕ × ℕ, ℕ × ℕ) (_hi : i ∈ I) :
      UU i.1 i.2.1.1 i.2.2.1 i.2.2.2 ≤ NN / i.1 := min_le_left _ _
  have hmoment :
      (∑ i ∈ I, ‖(C0 i.2.1.1 i.2.2.1 i.2.2.2 : ℂ)‖ / (i.1 : ℝ)) ≤
        E * (Real.log x) ^ (4 : ℝ) := by
    calc
      _ = ∑ m ∈ M, ∑ aa ∈ m.divisorsAntidiagonal,
          ∑ bb ∈ aa.2.divisorsAntidiagonal,
            ‖(C0 aa.1 bb.1 bb.2 : ℂ)‖ / (m : ℝ) := by
        simp only [I, Finset.sum_sigma]
      _ ≤ ∑ m ∈ Finset.Icc 1 NN, ∑ aa ∈ m.divisorsAntidiagonal,
          ∑ bb ∈ aa.2.divisorsAntidiagonal,
            ‖(C0 aa.1 bb.1 bb.2 : ℂ)‖ / (m : ℝ) :=
        Finset.sum_le_sum_of_subset_of_nonneg hMbox (fun m hm hnot => by positivity)
      _ ≤ (1 + Real.log (NN : ℝ)) ^ 4 :=
        three_divisor_reciprocal_moment_le NN
          (fun _m s t h => (C0 s t h : ℂ)) (fun m hm aa haa bb hbb => hC0 aa.1 bb.1 bb.2)
      _ ≤ E * (Real.log x) ^ (4 : ℝ) := by
        simpa only [Real.rpow_ofNat] using henv x hxe N hN hNU
  have hmasked (n : ℕ) : g n =
      if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0 then (A0 n : ℂ) else 0 := by
    by_cases h1 : nlo ≤ (n : ℝ) <;> by_cases h2 : (n : ℝ) ≤ nhi <;>
      by_cases h3 : Nat.Coprime n r0 <;> simp [f, g, h1, h2, h3]
  have hgoodbound :
      ‖fullDiscrepancy (∑ n ∈ GOOD, Finsupp.single n (g n)) q a‖ ≤
        Kg * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
    have hb := hgood x hxg N hNL hNU I (fun i => i.1)
      (fun i => (C0 i.2.1.1 i.2.2.1 i.2.2.2 : ℂ))
      (fun i => LL i.1 i.2.1.1 i.2.2.1 i.2.2.2)
      (fun i => UU i.1 i.2.1.1 i.2.2.1 i.2.2.2)
      (fun i => NN / i.1) hmpos hXL hXU hLU hmoment hsupport henvelope q hq r0 hr0 a ha
    rw [← hsource r0] at hb
    simpa only [← hmasked] using hb
  have hbadbound :
      ‖fullDiscrepancy (∑ n ∈ BAD, Finsupp.single n (g n)) q a‖ ≤
        2 * N * (Real.log x) ^ (-A) := by
    have hb := hXb x hxb N hNL hNU f (fun n hn => by simpa using hf n) q a r0 hq
    simpa only [BAD, V, NN, Y, g, one_mul, mul_one] using hb
  have hbadfilter :
      V.filter (fun n =>
        ¬(n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
          ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n)) = BAD := by
    ext n
    simp only [BAD, Finset.mem_filter, not_and_or, not_not]
    apply and_congr_right
    intro hn
    constructor
    · rintro (hn | ⟨p, hp, hY, hpn⟩)
      · exact Or.inl hn
      · exact Or.inr ⟨p, hp, (Nat.floor_lt' hp.ne_zero).mp hY, hpn⟩
    · rintro (hn | ⟨p, hp, hY, hpn⟩)
      · exact Or.inl hn
      · exact Or.inr ⟨p, hp, (Nat.floor_lt' hp.ne_zero).mpr hY, hpn⟩
  have hsplit :
      fullDiscrepancy (∑ n ∈ V, Finsupp.single n (g n)) q a =
        fullDiscrepancy (∑ n ∈ GOOD, Finsupp.single n (g n)) q a +
        fullDiscrepancy (∑ n ∈ BAD, Finsupp.single n (g n)) q a := by
    simp only [fullDiscrepancy_sample]
    rw [← hbadfilter]
    simpa only [GOOD] using
      (Finset.sum_filter_add_sum_filter_not V
        (fun n => n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
          ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n)
        (fun n => (if n % q = a % q then g n else 0) -
          (if Nat.Coprime n q then g n else 0) / (q.totient : ℂ))).symm
  have htarget :
      (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
        (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
         then (A0 n : ℂ) else 0)) =
        ∑ n ∈ V, Finsupp.single n (g n) := by
    apply Finset.sum_congr rfl
    intro n hn
    rw [hmasked]
  rw [htarget, hsplit]
  have hτ1 : (1 : ℝ) ≤ ((q * r0).divisors.card : ℝ) := by
    exact_mod_cast (Finset.one_le_card.mpr
      ⟨1, Nat.one_mem_divisors.mpr (Nat.mul_ne_zero hq.ne' hr0.ne')⟩ :
        1 ≤ (q * r0).divisors.card)
  calc
    _ ≤ ‖fullDiscrepancy (∑ n ∈ GOOD, Finsupp.single n (g n)) q a‖ +
        ‖fullDiscrepancy (∑ n ∈ BAD, Finsupp.single n (g n)) q a‖ := norm_add_le _ _
    _ ≤ Kg * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A +
        2 * N * (Real.log x) ^ (-A) := add_le_add hgoodbound hbadbound
    _ = Kg * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A +
        2 * N / (Real.log x) ^ A := by
      rw [Real.rpow_neg hlog]
      ring
    _ ≤ Kg * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A +
        2 * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
      apply add_le_add le_rfl
      apply div_le_div_of_nonneg_right _ hden
      apply mul_le_mul_of_nonneg_right _ hN
      simpa only [mul_one] using mul_le_mul_of_nonneg_left hτ1 (by norm_num : (0 : ℝ) ≤ 2)
    _ = (Kg + 2) * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by ring

open Classical in
theorem norm_fullDiscrepancy_Icc_weighted_le_of_prefix
    (L U q a r0 : ℕ) (f w : ℕ → ℂ) (E : ℝ) (hE : 0 ≤ E)
    (hprefix : ∀ k : ℕ, L ≤ k → k ≤ U →
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc L k, Finsupp.single n
          (if Nat.Coprime n r0 then f n else 0)) q a‖ ≤ E) :
    ‖fullDiscrepancy
      (∑ n ∈ Finset.Icc L U, Finsupp.single n
        (if Nat.Coprime n r0 then w n * f n else 0)) q a‖ ≤
      E * (‖w U‖ + ∑ n ∈ Finset.Ico L U, ‖w (n + 1) - w n‖) := by
  by_cases hLU : L ≤ U
  · let N : ℕ := U + 1 - L
    let g : ℕ → ℂ := fun n => if Nat.Coprime n r0 then f n else 0
    let d : ℕ → ℂ := fun n =>
      (if n % q = a % q then g n else 0) -
        (if Nat.Coprime n q then g n else 0) / (q.totient : ℂ)
    have hsample (k : ℕ) :
        (∑ n ∈ Finset.range k, d (L + n)) =
          fullDiscrepancy (∑ n ∈ Finset.Ico L (L + k),
            Finsupp.single n (if Nat.Coprime n r0 then f n else 0)) q a := by
      rw [fullDiscrepancy_sample, Finset.sum_Ico_eq_sum_range]
      simp only [Nat.add_sub_cancel_left]
      rfl
    have hbound (k : ℕ) (hk : k ≤ N) :
        ‖∑ n ∈ Finset.range k, d (L + n)‖ ≤ E := by
      by_cases hk0 : k = 0
      · simpa only [hk0, Finset.range_zero, Finset.sum_empty, norm_zero] using hE
      · have hset : Finset.Ico L (L + k) = Finset.Icc L (L + k - 1) := by
          ext n
          simp only [Finset.mem_Ico, Finset.mem_Icc]
          omega
        rw [hsample, hset]
        apply hprefix
        · omega
        · dsimp only [N] at hk
          omega
    have hlast : L + (N - 1) = U := by
      dsimp only [N]
      omega
    have hpred : N - 1 = U - L := by
      dsimp only [N]
      omega
    have hvariation :
        ‖w (L + (N - 1))‖ +
          (∑ n ∈ Finset.range (N - 1), ‖w (L + (n + 1)) - w (L + n)‖) =
        ‖w U‖ + ∑ n ∈ Finset.Ico L U, ‖w (n + 1) - w n‖ := by
      rw [hlast, Finset.sum_Ico_eq_sum_range, hpred]
      simp only [Nat.add_assoc]
    have hweighted :
        (∑ n ∈ Finset.range N, w (L + n) • d (L + n)) =
          fullDiscrepancy (∑ n ∈ Finset.Icc L U, Finsupp.single n
            (if Nat.Coprime n r0 then w n * f n else 0)) q a := by
      have hset : Finset.Icc L U = Finset.Ico L (U + 1) := by
        ext n
        simp only [Finset.mem_Icc, Finset.mem_Ico]
        omega
      rw [fullDiscrepancy_sample, hset, Finset.sum_Ico_eq_sum_range]
      apply Finset.sum_congr rfl
      intro n hn
      dsimp only [d, g]
      simp only [smul_eq_mul]
      split_ifs <;> ring
    have hparts := norm_sum_range_smul_le_of_partial_sum_bound
      (fun n => w (L + n)) (fun n => d (L + n)) N E hbound
    rw [hweighted, hvariation] at hparts
    exact hparts
  · rw [fullDiscrepancy_sample, Finset.Icc_eq_empty_of_lt (lt_of_not_ge hLU),
      Finset.sum_empty, norm_zero]
    exact mul_nonneg hE (add_nonneg (norm_nonneg _) (Finset.sum_nonneg fun _ _ => norm_nonneg _))

open Classical in
theorem harmanA0_unit_all_moduli_siegelWalfisz
    (ε T c C A : ℝ) (hε : 0 < ε) (hT : 0 < T) (hc : 0 < c)
    (hC : 0 < C) (hA : 0 < A) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ z M0 lo hi : ℝ, 0 < z → c * N ≤ lo →
      ∀ b : Bool, ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 →
      ∀ a : ℕ, Nat.Coprime a q →
      let A0 : ℕ → ℤ := fun n =>
        if (n : ℝ) ≤ M0 ∧ ((max 1 (n.primeFactors.sup id) : ℕ) : ℝ) < z
        then (if b then |ArithmeticFunction.moebius n| else ArithmeticFunction.moebius n)
        else 0
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
          (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n r0
           then (A0 n : ℂ) else 0)) q a‖ ≤
        K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨E, hE, Xe, hXe, henv⟩ := exists_cofactor_log_fourth_envelope T C hT hC
  obtain ⟨Kg, Xg, hKg, hXg, hgood⟩ :=
    largest_prime_windows_all_moduli_siegelWalfisz
      0 1 ε c T C 4 E A hε hc hT hE.le hA
  obtain ⟨Xb, hXb⟩ := Filter.eventually_atTop.mp
    (eventually_exceptional_coefficient_discrepancy_le
      0 1 A 0 C ε T (by norm_num) hε hT)
  refine ⟨Kg + 2, max Xg (max Xe Xb), by linarith,
    hXg.trans (le_max_left _ _), ?_⟩
  intro x hx N hNL hNU z M0 lo hi hz hlo b q hq r0 hr0 a ha A0
  have hxg : Xg ≤ x := (le_max_left _ _).trans hx
  have hxe : Xe ≤ x := (le_max_left Xe Xb).trans ((le_max_right _ _).trans hx)
  have hxb : Xb ≤ x := (le_max_right Xe Xb).trans ((le_max_right _ _).trans hx)
  have hxexp : Real.exp 1 ≤ x := hXg.trans hxg
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hxexp
  have hlog : 0 ≤ Real.log x := zero_le_one.trans hlog1
  have hN : 0 ≤ N := (Real.rpow_pos_of_pos hx0 ε).le.trans hNL
  have hden : 0 ≤ (Real.log x) ^ A := Real.rpow_nonneg hlog A
  let NN := Nat.floor (T * N)
  let Y := Nat.floor (Real.exp (Real.sqrt (Real.log x)))
  let V : Finset ℕ := Finset.Icc 1 NN
  let GOOD : Finset ℕ := V.filter (fun n =>
    n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
      ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n)
  let BAD : Finset ℕ := V.filter (fun n =>
    n ∈ Nat.factoredNumbers (Nat.primesLE Y) ∨
      ∃ p : ℕ, Nat.Prime p ∧
        Real.exp (Real.sqrt (Real.log x)) < (p : ℝ) ∧ p ^ 2 ∣ n)
  let M : Finset ℕ := (Finset.Icc 1 (NN / (Y + 1))).filter (fun m =>
    ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ m)
  let w : ℕ → ℂ := fun m =>
    ((if b then |ArithmeticFunction.moebius m| else -ArithmeticFunction.moebius m : ℤ) : ℂ)
  let cap : ℕ → ℕ := fun m =>
    min (Nat.floor (M0 / (m : ℝ))) (Nat.ceil z - 1)
  let LL : ℕ → ℕ := fun m => max (Y + 1)
    (max (m.primeFactors.sup id + 1) (Nat.ceil (lo / (m : ℝ))))
  let UU : ℕ → ℕ := fun m =>
    min (NN / m) (min (Nat.floor (hi / (m : ℝ))) (cap m))
  let f : ℕ → ℂ := fun n =>
    if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi then (A0 n : ℂ) else 0
  let g : ℕ → ℂ := fun n => if Nat.Coprime n r0 then f n else 0
  let F0 : ℕ →₀ ℂ := ∑ m ∈ M, ∑ p ∈ Finset.Icc (LL m) (UU m),
    Finsupp.single (m * p) (if Nat.Prime p then w m else 0)
  have hA0 (n : ℕ) : ‖(A0 n : ℂ)‖ ≤ 1 := by
    dsimp only [A0]
    split
    · rcases ArithmeticFunction.moebius_eq_or n with h | h | h <;> cases b <;> simp [h]
    · simp
  have hw (m : ℕ) : ‖w m‖ ≤ 1 := by
    dsimp only [w]
    rcases ArithmeticFunction.moebius_eq_or m with h | h | h <;> cases b <;> simp [h]
  have hf (n : ℕ) : ‖f n‖ ≤ 1 := by
    dsimp only [f]
    split_ifs
    · exact hA0 n
    · simp
  have hmpos (m : ℕ) (hm : m ∈ M) : 0 < m :=
    (Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1).1
  have hMbox : M ⊆ Finset.Icc 1 NN := by
    intro m hm
    have hI := Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1
    exact Finset.mem_Icc.mpr ⟨hI.1, hI.2.trans (Nat.div_le_self NN (Y + 1))⟩
  have hsource (R : ℕ) :
      (∑ n ∈ GOOD, Finsupp.single n
        (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n R
          then (A0 n : ℂ) else 0)) =
      ∑ m ∈ M, ∑ p ∈ Finset.Icc (LL m) (UU m), Finsupp.single (m * p)
        (if Nat.Prime p ∧ Nat.Coprime (m * p) R then w m else 0) := by
    change (∑ n ∈ (Finset.Icc 1 NN).filter (fun n =>
        n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
          ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n),
      Finsupp.single n (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n R
        then (A0 n : ℂ) else 0)) = _
    rw [good_integer_largest_prime_finsupp_reindex_truncated]
    apply Finset.sum_congr rfl
    intro m hm
    have hm0 := hmpos m hm
    have hmR : 0 < (m : ℝ) := Nat.cast_pos.mpr hm0
    let P : Finset ℕ := (Finset.Icc (Y + 1) (NN / m)).filter (fun p =>
      Nat.Prime p ∧ ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p)
    let W : Finset ℕ := Finset.Icc 0 (cap m)
    have hvalue (p : ℕ) (hp : Nat.Prime p)
        (hmax : ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p) :
        (A0 (m * p) : ℂ) = if p ∈ W then w m else 0 := by
      have hmu : ArithmeticFunction.moebius (m * p) = -ArithmeticFunction.moebius m := by
        simpa only [Nat.mul_comm m p] using
          (harmanA_mobius_prime_factor_data p m hp hm0 hmax).2.2.1
      have hsup : max 1 ((m * p).primeFactors.sup id) = p := by
        simpa only [Nat.mul_comm m p] using
          (harmanA_mobius_prime_factor_data p m hp hm0 hmax).2.2.2.1
      have hcut : p ≤ Nat.floor (M0 / (m : ℝ)) ↔ ((m * p : ℕ) : ℝ) ≤ M0 := by
        have h : p ≤ Nat.floor (M0 / (m : ℝ)) ↔ (p : ℝ) * (m : ℝ) ≤ M0 := by
          rw [Nat.le_floor_iff' hp.ne_zero, le_div_iff₀ hmR]
        simpa only [Nat.cast_mul, mul_comm] using h
      have hzcut : p ≤ Nat.ceil z - 1 ↔ (p : ℝ) < z := by
        rw [Nat.le_sub_one_iff_lt (Nat.ceil_pos.mpr hz), Nat.lt_ceil]
      have hwindow :
          (((m * p : ℕ) : ℝ) ≤ M0 ∧
            ((max 1 ((m * p).primeFactors.sup id) : ℕ) : ℝ) < z) ↔ p ∈ W := by
        simp only [W, cap, Finset.mem_Icc, Nat.zero_le, true_and, le_min_iff,
          hcut, hzcut, hsup]
      dsimp only [A0, w]
      simp only [hwindow, hmu]
      cases b <;> simp
    have hcarrier :
        P.filter (fun p =>
          lo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ hi ∧ p ∈ W) =
        (Finset.Icc (LL m) (UU m)).filter Nat.Prime := by
      ext p
      by_cases hp : Nat.Prime p
      · have hmax :
            m.primeFactors.sup id + 1 ≤ p ↔
              ∀ t : ℕ, Nat.Prime t → t ∣ m → t < p := by
          rw [Nat.add_one_le_iff, Finset.sup_lt_iff hp.pos]
          constructor
          · intro ht t htp htm
            exact ht t (htp.mem_primeFactors htm hm0.ne')
          · intro ht t htm
            exact ht t (Nat.prime_of_mem_primeFactors htm) (Nat.dvd_of_mem_primeFactors htm)
        have hlo' : Nat.ceil (lo / (m : ℝ)) ≤ p ↔ lo ≤ ((m * p : ℕ) : ℝ) := by
          have h : Nat.ceil (lo / (m : ℝ)) ≤ p ↔ lo ≤ (p : ℝ) * (m : ℝ) := by
            rw [Nat.ceil_le, div_le_iff₀ hmR]
          simpa only [Nat.cast_mul, mul_comm] using h
        have hhi' : p ≤ Nat.floor (hi / (m : ℝ)) ↔ ((m * p : ℕ) : ℝ) ≤ hi := by
          have h : p ≤ Nat.floor (hi / (m : ℝ)) ↔ (p : ℝ) * (m : ℝ) ≤ hi := by
            rw [Nat.le_floor_iff' hp.ne_zero, le_div_iff₀ hmR]
          simpa only [Nat.cast_mul, mul_comm] using h
        simp only [P, W, LL, UU, Finset.mem_filter, Finset.mem_Icc,
          max_le_iff, le_min_iff, hp, Nat.zero_le, true_and, and_true, hmax, hlo', hhi']
        tauto
      · simp only [P, Finset.mem_filter, hp, false_and, and_false]
    change (∑ p ∈ P, Finsupp.single (m * p)
      (if lo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ hi ∧
        Nat.Coprime (m * p) R then (A0 (m * p) : ℂ) else 0)) = _
    calc
      _ = ∑ p ∈ P.filter (fun p =>
          lo ≤ ((m * p : ℕ) : ℝ) ∧ ((m * p : ℕ) : ℝ) ≤ hi ∧ p ∈ W),
          Finsupp.single (m * p) (if Nat.Coprime (m * p) R then w m else 0) := by
        conv_rhs => rw [Finset.sum_filter]
        apply Finset.sum_congr rfl
        intro p hpP
        obtain ⟨hp, hmax⟩ := (Finset.mem_filter.mp hpP).2
        rw [hvalue p hp hmax]
        simp only [ite_and, apply_ite (Finsupp.single (m * p)), Finsupp.single_zero]
        by_cases hW : p ∈ W
        · simp only [eq_true hW, ite_true]
        · simp only [eq_false hW, ite_false, ite_self]
      _ = _ := by
        rw [hcarrier, Finset.sum_filter]
        apply Finset.sum_congr rfl
        intro p hpP
        by_cases hp : Nat.Prime p <;> simp [hp]
  have hF0eq : F0 = ∑ n ∈ GOOD, Finsupp.single n (f n) := by
    simpa only [F0, f, Nat.coprime_one_right_eq_true, and_true] using (hsource 1).symm
  have hF0 (n : ℕ) : F0 n = if n ∈ GOOD then f n else 0 := by
    rw [hF0eq]
    simp [Finsupp.finsetSum_apply, Finsupp.single_apply]
  have hsupport : ∀ n ∈ F0.support, c * N ≤ (n : ℝ) ∧ (n : ℝ) ≤ T * N := by
    intro n hn
    have hne := Finsupp.mem_support_iff.mp hn
    rw [hF0] at hne
    have hparts : n ∈ GOOD ∧ f n ≠ 0 := by
      simpa only [ite_ne_right_iff] using hne
    have hlocal : lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi := by
      have hfne := hparts.2
      dsimp only [f] at hfne
      exact (ite_ne_right_iff.mp hfne).1
    exact ⟨hlo.trans hlocal.1,
      (Nat.cast_le.mpr (Finset.mem_Icc.mp (Finset.mem_filter.mp hparts.1).1).2).trans
        (Nat.floor_le (mul_nonneg hT.le hN))⟩
  have henvelope : ∀ n ∈ F0.support,
      ‖F0 n‖ ≤ 1 * (n.divisors.card : ℝ) ^ (0 : ℝ) *
        (Real.log x) ^ (0 : ℝ) := by
    intro n hn
    rw [hF0]
    split_ifs
    · simpa using hf n
    · simp
  have hNN : (NN : ℝ) ≤ T * N := Nat.floor_le (mul_nonneg hT.le hN)
  have hXL (m : ℕ) (hm : m ∈ M) :
      Real.exp (Real.sqrt (Real.log x)) ≤ ((NN / m : ℕ) : ℝ) :=
    (cofactor_prime_scale_above_real_cutoff NN m (Real.exp (Real.sqrt (Real.log x)))
      (hmpos m hm) (Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1).2).le
  have hXU (m : ℕ) (hm : m ∈ M) :
      ((NN / m : ℕ) : ℝ) ≤ T * N / (m : ℝ) :=
    (Nat.cast_div_le (m := NN) (n := m) (α := ℝ)).trans
      (div_le_div_of_nonneg_right hNN (Nat.cast_pos.mpr (hmpos m hm)).le)
  have hLU (m : ℕ) (hm : m ∈ M) : UU m ≤ NN / m := min_le_left _ _
  have hmoment : (∑ m ∈ M, ‖w m‖ / (m : ℝ)) ≤ E * (Real.log x) ^ (4 : ℝ) := by
    calc
      _ ≤ ∑ m ∈ M, (1 : ℝ) / (m : ℝ) :=
        Finset.sum_le_sum fun m hm =>
          div_le_div_of_nonneg_right (hw m) (Nat.cast_nonneg m)
      _ ≤ ∑ m ∈ Finset.Icc 1 NN, (1 : ℝ) / (m : ℝ) :=
        Finset.sum_le_sum_of_subset_of_nonneg hMbox (fun m hm hnot => by positivity)
      _ = (harmonic NN : ℝ) := by
        simp only [harmonic_eq_sum_Icc, Rat.cast_sum, Rat.cast_inv, Rat.cast_natCast, one_div]
      _ ≤ 1 + Real.log (NN : ℝ) := harmonic_le_one_add_log NN
      _ ≤ (1 + Real.log (NN : ℝ)) ^ 4 :=
        le_self_pow₀ (by linarith [Real.log_natCast_nonneg NN]) (by decide)
      _ ≤ E * (Real.log x) ^ (4 : ℝ) := by
        simpa only [Real.rpow_ofNat] using henv x hxe N hN hNU
  have hmasked (n : ℕ) : g n =
      if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n r0 then (A0 n : ℂ) else 0 := by
    by_cases h1 : lo ≤ (n : ℝ) <;> by_cases h2 : (n : ℝ) ≤ hi <;>
      by_cases h3 : Nat.Coprime n r0 <;> simp [f, g, h1, h2, h3]
  have hgoodbound :
      ‖fullDiscrepancy (∑ n ∈ GOOD, Finsupp.single n (g n)) q a‖ ≤
        Kg * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
    have hb := hgood x hxg N hNL hNU M id w LL UU (fun m => NN / m)
      hmpos hXL hXU hLU hmoment hsupport henvelope q hq r0 hr0 a ha
    simp only [id_eq] at hb
    rw [← hsource r0] at hb
    simpa only [← hmasked] using hb
  have hbadbound :
      ‖fullDiscrepancy (∑ n ∈ BAD, Finsupp.single n (g n)) q a‖ ≤
        2 * N * (Real.log x) ^ (-A) := by
    have hb := hXb x hxb N hNL hNU f (fun n hn => by simpa using hf n) q a r0 hq
    simpa only [BAD, V, NN, Y, g, one_mul, mul_one, pow_zero, Real.rpow_zero] using hb
  have hbadfilter :
      V.filter (fun n =>
        ¬(n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
          ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n)) = BAD := by
    ext n
    simp only [BAD, Finset.mem_filter, not_and_or, not_not]
    apply and_congr_right
    intro hn
    constructor
    · rintro (hn | ⟨p, hp, hY, hpn⟩)
      · exact Or.inl hn
      · exact Or.inr ⟨p, hp, (Nat.floor_lt' hp.ne_zero).mp hY, hpn⟩
    · rintro (hn | ⟨p, hp, hY, hpn⟩)
      · exact Or.inl hn
      · exact Or.inr ⟨p, hp, (Nat.floor_lt' hp.ne_zero).mpr hY, hpn⟩
  have hsplit :
      fullDiscrepancy (∑ n ∈ V, Finsupp.single n (g n)) q a =
        fullDiscrepancy (∑ n ∈ GOOD, Finsupp.single n (g n)) q a +
        fullDiscrepancy (∑ n ∈ BAD, Finsupp.single n (g n)) q a := by
    simp only [fullDiscrepancy_sample]
    rw [← hbadfilter]
    simpa only [GOOD] using
      (Finset.sum_filter_add_sum_filter_not V
        (fun n => n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
          ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n)
        (fun n => (if n % q = a % q then g n else 0) -
          (if Nat.Coprime n q then g n else 0) / (q.totient : ℂ))).symm
  have htarget :
      (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
        (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n r0
         then (A0 n : ℂ) else 0)) =
        ∑ n ∈ V, Finsupp.single n (g n) := by
    apply Finset.sum_congr rfl
    intro n hn
    rw [hmasked]
  rw [htarget, hsplit]
  have hτ1 : (1 : ℝ) ≤ ((q * r0).divisors.card : ℝ) := by
    exact_mod_cast (Finset.one_le_card.mpr
      ⟨1, Nat.one_mem_divisors.mpr (Nat.mul_ne_zero hq.ne' hr0.ne')⟩ :
        1 ≤ (q * r0).divisors.card)
  calc
    _ ≤ ‖fullDiscrepancy (∑ n ∈ GOOD, Finsupp.single n (g n)) q a‖ +
        ‖fullDiscrepancy (∑ n ∈ BAD, Finsupp.single n (g n)) q a‖ := norm_add_le _ _
    _ ≤ Kg * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A +
        2 * N * (Real.log x) ^ (-A) := add_le_add hgoodbound hbadbound
    _ = Kg * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A +
        2 * N / (Real.log x) ^ A := by
      rw [Real.rpow_neg hlog]
      ring
    _ ≤ Kg * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A +
        2 * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
      apply add_le_add le_rfl
      apply div_le_div_of_nonneg_right _ hden
      apply mul_le_mul_of_nonneg_right _ hN
      simpa only [mul_one] using mul_le_mul_of_nonneg_left hτ1 (by norm_num : (0 : ℝ) ≤ 2)
    _ = (Kg + 2) * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by ring

open Classical in
theorem harmanB_signed_or_absolute_all_moduli_siegelWalfisz
    (ε T c C A : ℝ) (hε : 0 < ε) (hT : 0 < T) (hc : 0 < c)
    (hC : 0 < C) (hA : 0 < A) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ j : Fin 2, ∀ absolute : Bool, ∀ slo shi Z L U nlo nhi : ℝ, 0 < Z → c * N ≤ nlo →
      ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 → ∀ a : ℕ, Nat.Coprime a q →
      let B : ℕ → ℤ := fun n =>
        ∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
          if (if j = 0 then a.1 = 1 else Nat.Prime a.1) ∧
              slo ≤ (a.1 : ℝ) ∧ (a.1 : ℝ) ≤ shi ∧
              ((max 1 (b.1.primeFactors.sup id) : ℕ) : ℝ) < Z ∧
              L ≤ ((a.1 * b.1 : ℕ) : ℝ) ∧ ((a.1 * b.1 : ℕ) : ℝ) ≤ U
          then (if absolute then |ArithmeticFunction.moebius b.1|
                else ArithmeticFunction.moebius b.1) else 0
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
          (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
           then (B n : ℂ) else 0)) q a‖ ≤
        K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨E, hE, Xe, _hXe, hlogenv⟩ := exists_cofactor_log_fourth_envelope T C hT hC
  obtain ⟨Kg, Xg, hKg, hXg, hwin⟩ :=
    largest_prime_windows_all_moduli_siegelWalfisz
      2 1 ε c T C 4 (3 * E) A hε hc hT (by positivity) hA
  obtain ⟨Xb, hXb⟩ := Filter.eventually_atTop.mp
    (eventually_exceptional_coefficient_discrepancy_le
      2 1 A 0 C ε T (by norm_num) hε hT)
  refine ⟨Kg + 2, max Xg (max Xe Xb), by linarith,
    hXg.trans (le_max_left _ _), ?_⟩
  intro x hx N hNL hNU j absolute slo shi Z L U nlo nhi hZ hnlo q hq r0 hr0 a ha B
  have hxg : Xg ≤ x := (le_max_left _ _).trans hx
  have hxe : Xe ≤ x := (le_max_left Xe Xb).trans ((le_max_right _ _).trans hx)
  have hxb : Xb ≤ x := (le_max_right Xe Xb).trans ((le_max_right _ _).trans hx)
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le (hXg.trans hxg)
  have hlog1 : 1 ≤ Real.log x :=
    (Real.le_log_iff_exp_le hx0).mpr (hXg.trans hxg)
  have hlog : 0 ≤ Real.log x := zero_le_one.trans hlog1
  have hN : 0 ≤ N := (Real.rpow_pos_of_pos hx0 ε).le.trans hNL
  have hden : 0 ≤ (Real.log x) ^ A := Real.rpow_nonneg hlog A
  let NN := Nat.floor (T * N)
  let Y := Nat.floor (Real.exp (Real.sqrt (Real.log x)))
  let V : Finset ℕ := Finset.Icc 1 NN
  let f : ℕ → ℂ := fun n =>
    if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi then (B n : ℂ) else 0
  let g : ℕ → ℂ := fun n => if Nat.Coprime n r0 then f n else 0
  let GOOD : Finset ℕ := V.filter (fun n : ℕ =>
    n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
      ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n)
  let BAD : Finset ℕ := V.filter (fun n : ℕ =>
    n ∈ Nat.factoredNumbers (Nat.primesLE Y) ∨
      ∃ p : ℕ, Nat.Prime p ∧
        Real.exp (Real.sqrt (Real.log x)) < (p : ℝ) ∧ p ^ 2 ∣ n)
  let FGOOD : ℕ →₀ ℂ := ∑ n ∈ GOOD, Finsupp.single n (f n)
  have hweight (d : ℕ) (negative : Bool) :
      ‖((if absolute then |ArithmeticFunction.moebius d| else
        if negative then -ArithmeticFunction.moebius d
        else ArithmeticFunction.moebius d : ℤ) : ℂ)‖ ≤ 1 := by
    rcases ArithmeticFunction.moebius_eq_or d with h | h | h <;>
      cases absolute <;> cases negative <;> simp [h]
  have hB (n : ℕ) : ‖(B n : ℂ)‖ ≤ (n.divisors.card : ℝ) ^ 2 := by
    have hbound := norm_three_divisor_sum_le_divisor_sq n
      (fun s d _k => ((if (if j = 0 then s = 1 else Nat.Prime s) ∧
          slo ≤ (s : ℝ) ∧ (s : ℝ) ≤ shi ∧
          ((max 1 (d.primeFactors.sup id) : ℕ) : ℝ) < Z ∧
          L ≤ ((s * d : ℕ) : ℝ) ∧ ((s * d : ℕ) : ℝ) ≤ U
        then (if absolute then |ArithmeticFunction.moebius d| else ArithmeticFunction.moebius d)
        else 0 : ℤ) : ℂ)) (by
          intro aa _haa bb _hbb
          exact norm_harman_int_cut_le_one _ _ (hweight bb.1 false))
    simpa only [B, Int.cast_sum] using hbound
  have hf (n : ℕ) : ‖f n‖ ≤ (n.divisors.card : ℝ) ^ 2 := by
    dsimp only [f]
    split_ifs
    · exact hB n
    · simp only [norm_zero]
      positivity
  have hmask (r n : ℕ) :
      (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r
       then (B n : ℂ) else 0) = if Nat.Coprime n r then f n else 0 := by
    by_cases h1 : nlo ≤ (n : ℝ) <;> by_cases h2 : (n : ℝ) ≤ nhi <;>
      by_cases h3 : Nat.Coprime n r <;> simp [f, h1, h2, h3]
  have htarget :
      (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
        (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
         then (B n : ℂ) else 0)) =
      ∑ n ∈ V, Finsupp.single n (g n) := by
    apply Finset.sum_congr rfl
    intro n _hn
    rw [hmask]
  rw [htarget]
  let C0 : ℕ → ℕ → ℤ := fun s d =>
    if j = 1 ∧ s = 1 ∧ ((max 1 (d.primeFactors.sup id) : ℕ) : ℝ) < Z
    then (if absolute then |ArithmeticFunction.moebius d| else ArithmeticFunction.moebius d) else 0
  let C1 : ℕ → ℕ → ℤ := fun s d =>
    if (if j = 0 then s = 1 else Nat.Prime s) ∧ slo ≤ (s : ℝ) ∧ (s : ℝ) ≤ shi
    then (if absolute then |ArithmeticFunction.moebius d| else -ArithmeticFunction.moebius d) else 0
  let C2 : ℕ → ℕ → ℤ := fun s d =>
    if (if j = 0 then s = 1 else Nat.Prime s) ∧
        slo ≤ (s : ℝ) ∧ (s : ℝ) ≤ shi ∧
        ((max 1 (d.primeFactors.sup id) : ℕ) : ℝ) < Z ∧
        L ≤ ((s * d : ℕ) : ℝ) ∧ ((s * d : ℕ) : ℝ) ≤ U
    then (if absolute then |ArithmeticFunction.moebius d| else ArithmeticFunction.moebius d) else 0
  let L0 : ℕ → ℕ → ℕ := fun m d =>
    max (Y + 1) (max (m.primeFactors.sup id + 1)
      (max (Nat.ceil (nlo / (m : ℝ)))
        (max (Nat.ceil slo) (Nat.ceil (L / (d : ℝ))))))
  let U0 : ℕ → ℕ → ℕ := fun m d =>
    min (NN / m) (min (Nat.floor (nhi / (m : ℝ)))
      (min (Nat.floor shi) (Nat.floor (U / (d : ℝ)))))
  let L1 : ℕ → ℕ → ℕ → ℕ := fun m s d =>
    max (Y + 1) (max (m.primeFactors.sup id + 1)
      (max (Nat.ceil (nlo / (m : ℝ))) (Nat.ceil (L / ((s * d : ℕ) : ℝ)))))
  let U1 : ℕ → ℕ → ℕ → ℕ := fun m s d =>
    min (NN / m) (min (Nat.floor (nhi / (m : ℝ)))
      (min (Nat.floor (U / ((s * d : ℕ) : ℝ))) (Nat.ceil Z - 1)))
  let L2 : ℕ → ℕ := fun m =>
    max (Y + 1) (max (m.primeFactors.sup id + 1) (Nat.ceil (nlo / (m : ℝ))))
  let U2 : ℕ → ℕ := fun m => min (NN / m) (Nat.floor (nhi / (m : ℝ)))
  let W : Fin 3 → ℕ → ℕ → ℂ := fun b s d =>
    if b = 0 then (C0 s d : ℂ) else if b = 1 then (C1 s d : ℂ) else (C2 s d : ℂ)
  let LL : Fin 3 → ℕ → ℕ → ℕ → ℕ := fun b m s d =>
    if b = 0 then L0 m d else if b = 1 then L1 m s d else L2 m
  let UU : Fin 3 → ℕ → ℕ → ℕ → ℕ := fun b m s d =>
    if b = 0 then U0 m d else if b = 1 then U1 m s d else U2 m
  let Psum : Fin 3 → ℕ → ℕ → ℕ → ℕ → ℕ →₀ ℂ := fun b m s d r =>
    ∑ p ∈ Finset.Icc (LL b m s d) (UU b m s d),
      Finsupp.single (m * p)
        (if Nat.Prime p ∧ Nat.Coprime (m * p) r then W b s d else 0)
  let MF : Finset ℕ := V.filter (fun m : ℕ =>
    ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ m)
  let M : Finset ℕ := (Finset.Icc 1 (NN / (Y + 1))).filter (fun m : ℕ =>
    ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ m)
  let J : Finset (Σ _m : ℕ, Σ _a : ℕ × ℕ, ℕ × ℕ) :=
    M.sigma (fun m => m.divisorsAntidiagonal.sigma (fun aa => aa.2.divisorsAntidiagonal))
  let I : Finset (Fin 3 × (Σ _m : ℕ, Σ _a : ℕ × ℕ, ℕ × ℕ)) := Finset.univ ×ˢ J
  have hnorm (b : Fin 3) (s d : ℕ) : ‖W b s d‖ ≤ 1 := by
    by_cases hb0 : b = 0
    · simp only [W, eq_true hb0, ite_true]
      exact norm_harman_int_cut_le_one _ _ (hweight d false)
    · by_cases hb1 : b = 1
      · simp only [W, eq_false hb0, eq_true hb1, ite_false, ite_true]
        exact norm_harman_int_cut_le_one _ _ (hweight d true)
      · simp only [W, eq_false hb0, eq_false hb1, ite_false]
        exact norm_harman_int_cut_le_one _ _ (hweight d false)
  have hMfull : M ⊆ MF := by
    intro m hm
    obtain ⟨hmI, hmSq⟩ := Finset.mem_filter.mp hm
    obtain ⟨hm1, hmN⟩ := Finset.mem_Icc.mp hmI
    exact Finset.mem_filter.mpr
      ⟨Finset.mem_Icc.mpr ⟨hm1, hmN.trans (Nat.div_le_self NN (Y + 1))⟩, hmSq⟩
  have hMbox : M ⊆ Finset.Icc 1 NN := hMfull.trans (Finset.filter_subset _ _)
  have hindex (i : Fin 3 × (Σ _m : ℕ, Σ _a : ℕ × ℕ, ℕ × ℕ)) (hi : i ∈ I) :
      i.2.1 ∈ M ∧ i.2.2.1 ∈ i.2.1.divisorsAntidiagonal ∧
        i.2.2.2 ∈ i.2.2.1.2.divisorsAntidiagonal := by
    have hiJ := (Finset.mem_product.mp hi).2
    obtain ⟨hm, hab⟩ := Finset.mem_sigma.mp hiJ
    obtain ⟨haa, hbb⟩ := Finset.mem_sigma.mp hab
    exact ⟨hm, haa, hbb⟩
  have hmpos (i : Fin 3 × (Σ _m : ℕ, Σ _a : ℕ × ℕ, ℕ × ℕ)) (hi : i ∈ I) :
      0 < i.2.1 := (Finset.mem_Icc.mp (hMbox (hindex i hi).1)).1
  have hmoment :
      (∑ i ∈ I, ‖W i.1 i.2.2.1.1 i.2.2.2.1‖ / (i.2.1 : ℝ)) ≤
        (3 * E) * (Real.log x) ^ (4 : ℝ) := by
    have hbranch (b : Fin 3) :
        (∑ m ∈ M, ∑ aa ∈ m.divisorsAntidiagonal,
          ∑ bb ∈ aa.2.divisorsAntidiagonal, ‖W b aa.1 bb.1‖ / (m : ℝ)) ≤
          E * (Real.log x) ^ 4 := by
      calc
        _ ≤ ∑ m ∈ Finset.Icc 1 NN, ∑ aa ∈ m.divisorsAntidiagonal,
            ∑ bb ∈ aa.2.divisorsAntidiagonal, ‖W b aa.1 bb.1‖ / (m : ℝ) := by
          apply Finset.sum_le_sum_of_subset_of_nonneg hMbox
          intro m _hm _hnot
          positivity
        _ ≤ (1 + Real.log (NN : ℝ)) ^ 4 :=
          three_divisor_reciprocal_moment_le NN (fun _m s d _k => W b s d)
            (fun _m _hm aa _haa bb _hbb => hnorm b aa.1 bb.1)
        _ ≤ E * (Real.log x) ^ 4 := hlogenv x hxe N hN hNU
    calc
      _ = ∑ b : Fin 3, ∑ m ∈ M, ∑ aa ∈ m.divisorsAntidiagonal,
          ∑ bb ∈ aa.2.divisorsAntidiagonal, ‖W b aa.1 bb.1‖ / (m : ℝ) := by
        simp only [I, J, Finset.sum_product, Finset.sum_sigma]
      _ ≤ ∑ _b : Fin 3, E * (Real.log x) ^ 4 := Finset.sum_le_sum fun b _ => hbranch b
      _ = (3 * E) * (Real.log x) ^ (4 : ℝ) := by
        norm_num only [Finset.sum_const, Finset.card_univ, Fintype.card_fin,
          nsmul_eq_mul, Real.rpow_ofNat]
        ring
  have hXL (i : Fin 3 × (Σ _m : ℕ, Σ _a : ℕ × ℕ, ℕ × ℕ)) (hi : i ∈ I) :
      Real.exp (Real.sqrt (Real.log x)) ≤ ((NN / i.2.1 : ℕ) : ℝ) := by
    have hcap := (Finset.mem_Icc.mp (Finset.mem_filter.mp (hindex i hi).1).1).2
    exact (cofactor_prime_scale_above_real_cutoff NN i.2.1
      (Real.exp (Real.sqrt (Real.log x))) (hmpos i hi) hcap).le
  have hXU (i : Fin 3 × (Σ _m : ℕ, Σ _a : ℕ × ℕ, ℕ × ℕ)) (hi : i ∈ I) :
      ((NN / i.2.1 : ℕ) : ℝ) ≤ T * N / (i.2.1 : ℝ) :=
    (Nat.cast_div_le (m := NN) (n := i.2.1) (α := ℝ)).trans
      (div_le_div_of_nonneg_right (Nat.floor_le (mul_nonneg hT.le hN))
        (Nat.cast_pos.mpr (hmpos i hi)).le)
  have hLU (i : Fin 3 × (Σ _m : ℕ, Σ _a : ℕ × ℕ, ℕ × ℕ)) (_hi : i ∈ I) :
      UU i.1 i.2.1 i.2.2.1.1 i.2.2.2.1 ≤ NN / i.2.1 := by
    dsimp only [UU, U0, U1, U2]
    split_ifs <;> exact min_le_left _ _
  have hprimefilter (r m l u : ℕ) (w : ℂ) :
      (∑ p ∈ (Finset.Icc l u).filter Nat.Prime,
        Finsupp.single (m * p) (if Nat.Coprime (m * p) r then w else 0)) =
      ∑ p ∈ Finset.Icc l u, Finsupp.single (m * p)
        (if Nat.Prime p ∧ Nat.Coprime (m * p) r then w else 0) := by
    rw [Finset.sum_filter]
    apply Finset.sum_congr rfl
    intro p _hp
    by_cases hp : Nat.Prime p <;> simp [hp]
  have hsource (r : ℕ) :
      (∑ n ∈ GOOD, Finsupp.single n
        (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r
         then (B n : ℂ) else 0)) =
      ∑ m ∈ MF, ∑ aa ∈ m.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
        (Psum 0 m aa.1 bb.1 r + Psum 1 m aa.1 bb.1 r + Psum 2 m aa.1 bb.1 r) := by
    have hs := harmanB_signed_or_absolute_good_part_prime_windows
      NN Y r j absolute slo shi Z L U nlo nhi hZ
    dsimp only at hs
    simp only [hprimefilter] at hs
    have h10 : (1 : Fin 3) ≠ 0 := by decide
    have h20 : (2 : Fin 3) ≠ 0 := by decide
    have h21 : (2 : Fin 3) ≠ 1 := by decide
    simpa only [B, GOOD, V, MF, Psum, W, LL, UU, L0, U0, L1, U1, L2, U2,
      C0, C1, C2, eq_self, h10, h20, h21, ite_true, ite_false] using hs
  have htruncate (r : ℕ) :
      (∑ m ∈ MF, ∑ aa ∈ m.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
        (Psum 0 m aa.1 bb.1 r + Psum 1 m aa.1 bb.1 r + Psum 2 m aa.1 bb.1 r)) =
      ∑ m ∈ M, ∑ aa ∈ m.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
        (Psum 0 m aa.1 bb.1 r + Psum 1 m aa.1 bb.1 r + Psum 2 m aa.1 bb.1 r) := by
    symm
    apply Finset.sum_subset hMfull
    intro m hm hnot
    have hlarge : NN / (Y + 1) < m := by
      apply lt_of_not_ge
      intro hcap
      have hm1 := (Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1).1
      exact hnot (Finset.mem_filter.mpr
        ⟨Finset.mem_Icc.mpr ⟨hm1, hcap⟩, (Finset.mem_filter.mp hm).2⟩)
    have hempty (l u : ℕ) :
        Finset.Icc (max (Y + 1) l) (min (NN / m) u) = ∅ :=
      cofactor_clipped_prime_window_eq_empty NN Y m l u hlarge
    have hzero (b : Fin 3) (s d : ℕ) : Psum b m s d r = 0 := by
      dsimp only [Psum, LL, UU, L0, U0, L1, U1, L2, U2]
      by_cases hb0 : b = 0
      · simp only [eq_true hb0, ite_true, hempty, Finset.sum_empty]
      · by_cases hb1 : b = 1
        · simp only [eq_false hb0, eq_true hb1, ite_true, ite_false, hempty, Finset.sum_empty]
        · simp only [eq_false hb0, eq_false hb1, ite_false, hempty, Finset.sum_empty]
    simp only [hzero, zero_add, Finset.sum_const_zero]
  have hfamily (r : ℕ) :
      (∑ n ∈ GOOD, Finsupp.single n (if Nat.Coprime n r then f n else 0)) =
      ∑ i ∈ I, ∑ p ∈ Finset.Icc
          (LL i.1 i.2.1 i.2.2.1.1 i.2.2.2.1) (UU i.1 i.2.1 i.2.2.1.1 i.2.2.2.1),
        Finsupp.single (i.2.1 * p)
          (if Nat.Prime p ∧ Nat.Coprime (i.2.1 * p) r
           then W i.1 i.2.2.1.1 i.2.2.2.1 else 0) := by
    have hs := hsource r
    simp only [hmask] at hs
    rw [hs, htruncate]
    simp only [I, J, Finset.sum_product, Finset.sum_sigma]
    rw [Fin.sum_univ_three]
    simp only [Psum, Finset.sum_add_distrib]
  have hunmasked :
      (∑ i ∈ I, ∑ p ∈ Finset.Icc
          (LL i.1 i.2.1 i.2.2.1.1 i.2.2.2.1) (UU i.1 i.2.1 i.2.2.1.1 i.2.2.2.1),
        Finsupp.single (i.2.1 * p)
          (if Nat.Prime p then W i.1 i.2.2.1.1 i.2.2.2.1 else 0)) = FGOOD := by
    simpa only [FGOOD, Nat.coprime_one_right_eq_true, and_true, ite_true] using (hfamily 1).symm
  have hFeval (n : ℕ) : FGOOD n = if n ∈ GOOD then f n else 0 := by
    simp [FGOOD, Finsupp.finsetSum_apply, Finsupp.single_apply]
  have hsupport : ∀ n ∈ FGOOD.support, c * N ≤ (n : ℝ) ∧ (n : ℝ) ≤ T * N := by
    intro n hn
    have hne := Finsupp.mem_support_iff.mp hn
    rw [hFeval] at hne
    have hparts : n ∈ GOOD ∧ f n ≠ 0 := by
      simpa only [ite_ne_right_iff] using hne
    have hlocal : nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi := by
      have hfne := hparts.2
      dsimp only [f] at hfne
      exact (ite_ne_right_iff.mp hfne).1
    exact ⟨hnlo.trans hlocal.1,
      (Nat.cast_le.mpr (Finset.mem_Icc.mp (Finset.mem_filter.mp hparts.1).1).2).trans
        (Nat.floor_le (mul_nonneg hT.le hN))⟩
  have hFbound (n : ℕ) : ‖FGOOD n‖ ≤ (n.divisors.card : ℝ) ^ 2 := by
    rw [hFeval]
    split_ifs
    · exact hf n
    · simp only [norm_zero]
      exact pow_nonneg (Nat.cast_nonneg _) 2
  have henvelope : ∀ n ∈ FGOOD.support,
      ‖FGOOD n‖ ≤ 1 * (n.divisors.card : ℝ) ^ (2 : ℝ) * (Real.log x) ^ (2 : ℝ) := by
    intro n _hn
    have hbound := (hFbound n).trans
      (le_mul_of_one_le_right (pow_nonneg (Nat.cast_nonneg n.divisors.card) 2)
        (one_le_pow₀ hlog1 : (1 : ℝ) ≤ (Real.log x) ^ (2 : ℕ)))
    simpa only [one_mul, Real.rpow_ofNat] using hbound
  have hgoodbound :
      ‖fullDiscrepancy (∑ n ∈ GOOD, Finsupp.single n (g n)) q a‖ ≤
        Kg * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
    change ‖fullDiscrepancy
      (∑ n ∈ GOOD, Finsupp.single n (if Nat.Coprime n r0 then f n else 0)) q a‖ ≤ _
    rw [hfamily]
    exact hwin x hxg N hNL hNU I
      (fun i => i.2.1) (fun i => W i.1 i.2.2.1.1 i.2.2.2.1)
      (fun i => LL i.1 i.2.1 i.2.2.1.1 i.2.2.2.1)
      (fun i => UU i.1 i.2.1 i.2.2.1.1 i.2.2.2.1)
      (fun i => NN / i.2.1) hmpos hXL hXU hLU hmoment
      (by simpa only [hunmasked] using hsupport)
      (by simpa only [hunmasked] using henvelope) q hq r0 hr0 a ha
  have hbadbound :
      ‖fullDiscrepancy (∑ n ∈ BAD, Finsupp.single n (g n)) q a‖ ≤
        2 * N * (Real.log x) ^ (-A) := by
    have hb := hXb x hxb N hNL hNU f
      (fun n _hn => by simpa using hf n) q a r0 hq
    simpa only [BAD, V, NN, Y, g, one_mul, mul_one] using hb
  have hbadfilter :
      V.filter (fun n : ℕ =>
        ¬(n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
          ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n)) = BAD := by
    ext n
    simp only [BAD, Finset.mem_filter, not_and_or, not_not]
    apply and_congr_right
    intro _hn
    constructor
    · rintro (hn | ⟨p, hp, hY, hpn⟩)
      · exact Or.inl hn
      · exact Or.inr ⟨p, hp, (Nat.floor_lt' hp.ne_zero).mp hY, hpn⟩
    · rintro (hn | ⟨p, hp, hY, hpn⟩)
      · exact Or.inl hn
      · exact Or.inr ⟨p, hp, (Nat.floor_lt' hp.ne_zero).mpr hY, hpn⟩
  have hsplit :
      fullDiscrepancy (∑ n ∈ V, Finsupp.single n (g n)) q a =
        fullDiscrepancy (∑ n ∈ GOOD, Finsupp.single n (g n)) q a +
        fullDiscrepancy (∑ n ∈ BAD, Finsupp.single n (g n)) q a := by
    simp only [fullDiscrepancy_sample]
    rw [← hbadfilter]
    simpa only [GOOD] using
      (Finset.sum_filter_add_sum_filter_not V
        (fun n : ℕ => n ∉ Nat.factoredNumbers (Nat.primesLE Y) ∧
          ¬ ∃ p : ℕ, Nat.Prime p ∧ Y < p ∧ p ^ 2 ∣ n)
        (fun n : ℕ =>
          (if n % q = a % q then g n else 0) -
            (if Nat.Coprime n q then g n else 0) / (q.totient : ℂ))).symm
  have hτ1 : (1 : ℝ) ≤ ((q * r0).divisors.card : ℝ) := by
    exact_mod_cast (Finset.one_le_card.mpr
      ⟨1, Nat.one_mem_divisors.mpr (Nat.mul_ne_zero hq.ne' hr0.ne')⟩ :
        1 ≤ (q * r0).divisors.card)
  rw [hsplit]
  calc
    _ ≤ ‖fullDiscrepancy (∑ n ∈ GOOD, Finsupp.single n (g n)) q a‖ +
        ‖fullDiscrepancy (∑ n ∈ BAD, Finsupp.single n (g n)) q a‖ := norm_add_le _ _
    _ ≤ Kg * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A +
        2 * N * (Real.log x) ^ (-A) := add_le_add hgoodbound hbadbound
    _ = Kg * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A +
        2 * N / (Real.log x) ^ A := by
      rw [Real.rpow_neg hlog]
      ring
    _ ≤ Kg * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A +
        2 * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
      apply add_le_add le_rfl
      apply div_le_div_of_nonneg_right _ hden
      apply mul_le_mul_of_nonneg_right _ hN
      simpa only [mul_one] using mul_le_mul_of_nonneg_left hτ1 (by norm_num : (0 : ℝ) ≤ 2)
    _ = (Kg + 2) * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by ring

open Classical in
theorem harmanB_absolute_all_moduli_siegelWalfisz
    (ε T c C A : ℝ) (hε : 0 < ε) (hT : 0 < T) (hc : 0 < c)
    (hC : 0 < C) (hA : 0 < A) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ j : Fin 2, ∀ slo shi Z L U nlo nhi : ℝ, 0 < Z → c * N ≤ nlo →
      ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 → ∀ a : ℕ, Nat.Coprime a q →
      let B : ℕ → ℤ := fun n =>
        ∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
          if (if j = 0 then a.1 = 1 else Nat.Prime a.1) ∧
              slo ≤ (a.1 : ℝ) ∧ (a.1 : ℝ) ≤ shi ∧
              ((max 1 (b.1.primeFactors.sup id) : ℕ) : ℝ) < Z ∧
              L ≤ ((a.1 * b.1 : ℕ) : ℝ) ∧ ((a.1 * b.1 : ℕ) : ℝ) ≤ U
          then |ArithmeticFunction.moebius b.1| else 0
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
          (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
           then (B n : ℂ) else 0)) q a‖ ≤
        K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨K, X0, hK, hX0, hmain⟩ :=
    harmanB_signed_or_absolute_all_moduli_siegelWalfisz ε T c C A hε hT hc hC hA
  refine ⟨K, X0, hK, hX0, ?_⟩
  intro x hx N hNL hNU j slo shi Z L U nlo nhi hZ hnlo q hq r0 hr0 a ha
  simpa using hmain x hx N hNL hNU j true slo shi Z L U nlo nhi hZ hnlo
    q hq r0 hr0 a ha

open Classical in
theorem sifted_short_one_prime_coefficient_eq
    (x : ℝ) (hx : 1 < x) (n : ℕ) :
    (∑ ps ∈ siftedPrimeTuples x (1 : Fin 6), ∑ d ∈ n.divisorsAntidiagonal,
      if d.1 = ps.prod then smallPrimeMobius (x ^ ((9519 : ℝ) / 50000)) d.2 else 0) =
    ∑ d ∈ n.divisorsAntidiagonal,
      if Nat.Prime d.1 ∧ x ^ ((9519 : ℝ) / 50000) ≤ (d.1 : ℝ) ∧
          (d.1 : ℝ) < x ^ ((40481 : ℝ) / 100000)
      then smallPrimeMobius (x ^ ((9519 : ℝ) / 50000)) d.2 else 0 := by
  rw [theta2_prime_tuples_eq x hx,
    Finset.sum_image List.singleton_injective.injOn]
  simp only [List.prod_cons, List.prod_nil, Nat.mul_one]
  rw [Finset.sum_comm]
  apply Finset.sum_congr rfl
  intro d hd
  rw [Finset.sum_ite_eq]
  simp only [Finset.mem_filter, Nat.mem_primesBelow, Nat.lt_ceil,
    and_left_comm, and_comm]

open Classical in
theorem sifted_short_one_prime_unit_row
    (z H : ℝ) (hH : 0 < H) (p m : ℕ) (hm : 0 < m) :
    let U0 : ℝ := ((Nat.ceil H - 1 : ℕ) : ℝ)
    ((∑ bb ∈ m.divisorsAntidiagonal, ∑ cc ∈ bb.2.divisorsAntidiagonal,
      if Nat.Prime p ∧ z ≤ (p : ℝ) ∧ bb.1 = 1 ∧ bb.1 ≤ p ∧
          cc.1 = 1 ∧ cc.1 ≤ p ∧
          ((max 1 (cc.2.primeFactors.sup id) : ℕ) : ℝ) < z ∧
          True ∧ 0 ≤ (p : ℝ) ∧ (p : ℝ) ≤ U0
      then ArithmeticFunction.moebius cc.2 else 0 : ℤ) : ℝ) =
    if Nat.Prime p ∧ z ≤ (p : ℝ) ∧ (p : ℝ) < H
    then smallPrimeMobius z m else 0 := by
  intro U0
  have hupper : (p : ℝ) ≤ U0 ↔ (p : ℝ) < H := by
    dsimp only [U0]
    rw [Nat.cast_le, Nat.le_sub_one_iff_lt (Nat.ceil_pos.mpr hH), Nat.lt_ceil]
  have hunit : (1, m) ∈ m.divisorsAntidiagonal :=
    Nat.mem_divisorsAntidiagonal.mpr ⟨one_mul _, hm.ne'⟩
  rw [Finset.sum_eq_single_of_mem (1, m) hunit]
  · simp only
    rw [Finset.sum_eq_single_of_mem (1, m) hunit]
    · simp only
      have hguard :
          (Nat.Prime p ∧ z ≤ (p : ℝ) ∧ True ∧ 1 ≤ p ∧ True ∧ 1 ≤ p ∧
            ((max 1 (m.primeFactors.sup id) : ℕ) : ℝ) < z ∧
            True ∧ 0 ≤ (p : ℝ) ∧ (p : ℝ) ≤ U0) ↔
          (Nat.Prime p ∧ z ≤ (p : ℝ) ∧ (p : ℝ) < H) ∧
            ((max 1 (m.primeFactors.sup id) : ℕ) : ℝ) < z := by
        have hp0 : 0 ≤ (p : ℝ) := Nat.cast_nonneg p
        constructor
        · rintro ⟨hp, hz, _h1, _hp1, _h2, _hp2, hmz, _h3, _hp0, hpU⟩
          exact ⟨⟨hp, hz, hupper.mp hpU⟩, hmz⟩
        · rintro ⟨⟨hp, hz, hpH⟩, hmz⟩
          exact ⟨hp, hz, True.intro, hp.one_lt.le, True.intro, hp.one_lt.le,
            hmz, True.intro, hp0, hupper.mpr hpH⟩
      simp only [hguard, smallPrimeMobius, ArithmeticFunction.coe_mk,
        apply_ite (fun t : ℤ => (t : ℝ)), Int.cast_zero, ← ite_and]
    · intro cc hcc hne
      apply ite_eq_right
      intro h
      have hc1 : cc.1 = 1 := h.2.2.2.2.1
      have hc2 : cc.2 = m := by
        simpa only [hc1, one_mul] using (Nat.mem_divisorsAntidiagonal.mp hcc).1
      exact hne (Prod.ext hc1 hc2)
  · intro bb hbb hne
    apply Finset.sum_eq_zero
    intro cc _hcc
    apply ite_eq_right
    intro h
    have hb1 : bb.1 = 1 := h.2.2.1
    have hb2 : bb.2 = m := by
      simpa only [hb1, one_mul] using (Nat.mem_divisorsAntidiagonal.mp hbb).1
    exact hne (Prod.ext hb1 hb2)

open Classical in
theorem sifted_short_one_prime_named_coefficient_eq
    (x : ℝ) (hx : 1 < x) (n : ℕ) :
    let z := x ^ ((9519 : ℝ) / 50000)
    let H := x ^ ((40481 : ℝ) / 100000)
    let U0 : ℝ := ((Nat.ceil H - 1 : ℕ) : ℝ)
    let Q0 : ℤ :=
      ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
        ∑ cc ∈ bb.2.divisorsAntidiagonal,
          if Nat.Prime aa.1 ∧ z ≤ (aa.1 : ℝ) ∧ bb.1 = 1 ∧ bb.1 ≤ aa.1 ∧
              cc.1 = 1 ∧ cc.1 ≤ aa.1 ∧
              ((max 1 (cc.2.primeFactors.sup id) : ℕ) : ℝ) < z ∧
              True ∧ 0 ≤ (aa.1 : ℝ) ∧ (aa.1 : ℝ) ≤ U0
          then ArithmeticFunction.moebius cc.2 else 0
    (∑ ps ∈ siftedPrimeTuples x (1 : Fin 6), ∑ d ∈ n.divisorsAntidiagonal,
      if d.1 = ps.prod then smallPrimeMobius z d.2 else 0) = (Q0 : ℝ) := by
  intro z H U0 Q0
  rw [sifted_short_one_prime_coefficient_eq x hx]
  simp only [Q0, Int.cast_sum]
  apply Finset.sum_congr rfl
  intro d hd
  simpa only [Int.cast_sum] using
    (sifted_short_one_prime_unit_row z H
      (Real.rpow_pos_of_pos (zero_lt_one.trans hx) _) d.1 d.2
      (Nat.pos_of_ne_zero (Nat.right_ne_zero_of_mem_divisorsAntidiagonal hd))).symm

open Classical in
theorem sifted_short_one_prime_all_moduli_siegelWalfisz
    (ε T c C A : ℝ) (hε : 0 < ε) (hT : 0 < T) (hc : 0 < c)
    (hC : 0 < C) (hA : 0 < A) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ nlo nhi : ℝ, c * N ≤ nlo →
      ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 →
      ∀ a : ℕ, Nat.Coprime a q →
      let z := x ^ ((9519 : ℝ) / 50000)
      let M0 := x ^ (1 - (1058 : ℝ) / 3125)
      let S0 : ℕ → ℝ := fun n =>
        if (n : ℝ) ≤ M0 then
          ∑ ps ∈ siftedPrimeTuples x (1 : Fin 6), ∑ d ∈ n.divisorsAntidiagonal,
            if d.1 = ps.prod then smallPrimeMobius z d.2 else 0
        else 0
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
          (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
           then (S0 n : ℂ) else 0)) q a‖ ≤
        K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨K, X0, hK, hX0, hbound⟩ :=
    harmanA0_named_all_moduli_siegelWalfisz ε T c C A hε hT hc hC hA
  refine ⟨K, X0, hK, hX0, ?_⟩
  intro x hx N hNL hNU nlo nhi hlo q hq r0 hr0 a ha z M0 S0
  have hx1 : 1 < x :=
    (Real.one_lt_exp_iff.mpr (by norm_num : (0 : ℝ) < 1)).trans_le (hX0.trans hx)
  have hz : 0 < z := Real.rpow_pos_of_pos (zero_lt_one.trans hx1) _
  let H := x ^ ((40481 : ℝ) / 100000)
  let U0 : ℝ := ((Nat.ceil H - 1 : ℕ) : ℝ)
  let Q0 : ℕ → ℤ := fun n =>
    ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
      ∑ cc ∈ bb.2.divisorsAntidiagonal,
        if Nat.Prime aa.1 ∧ z ≤ (aa.1 : ℝ) ∧ bb.1 = 1 ∧ bb.1 ≤ aa.1 ∧
            cc.1 = 1 ∧ cc.1 ≤ aa.1 ∧
            ((max 1 (cc.2.primeFactors.sup id) : ℕ) : ℝ) < z ∧
            True ∧ 0 ≤ (aa.1 : ℝ) ∧ (aa.1 : ℝ) ≤ U0
        then ArithmeticFunction.moebius cc.2 else 0
  have hcoeff (n : ℕ) : (Q0 n : ℂ) =
      ((∑ ps ∈ siftedPrimeTuples x (1 : Fin 6), ∑ d ∈ n.divisorsAntidiagonal,
        if d.1 = ps.prod then smallPrimeMobius z d.2 else 0 : ℝ) : ℂ) := by
    have hs := congrArg (fun t : ℝ => (t : ℂ))
      (sifted_short_one_prime_named_coefficient_eq x hx1 n)
    simpa only [Complex.ofReal_intCast] using hs.symm
  have hb := hbound x hx N hNL hNU (0 : Fin 2) (0 : Fin 2)
    (fun _ _ _ => True) (fun _ _ _ => (0 : ℝ)) (fun _ _ _ => U0)
    z M0 nlo nhi hz hlo false q hq r0 hr0 a ha
  dsimp only at hb
  simp only [ite_true,
    ite_eq_right (show ¬(false : Bool) by decide)] at hb
  dsimp only [Q0] at hcoeff
  simpa only [apply_ite (fun t : ℤ => (t : ℂ)), Int.cast_zero, hcoeff,
    S0, apply_ite (fun t : ℝ => (t : ℂ)), Complex.ofReal_zero] using hb

open Classical in
theorem sifted_short_pair_window_iff
    (x : ℝ) (hx : 1 < x) (e : Fin 2) (p q : ℕ)
    (hp : Nat.Prime p) (hq : Nat.Prime q) :
    let z := x ^ ((9519 : ℝ) / 50000)
    let H := x ^ ((40481 : ℝ) / 100000)
    let B := x ^ ((59519 : ℝ) / 100000)
    let P := if e = 0 then True else
      Real.logb x (q : ℝ) < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000
    let L := if e = 0 then (q : ℝ) + 1 else
      max ((q : ℝ) + 1) ((Nat.floor (B / (q : ℝ)) : ℝ) + 1)
    let U := if e = 0 then
      min ((Nat.ceil H - 1 : ℕ) : ℝ) ((Nat.ceil (H / (q : ℝ)) - 1 : ℕ) : ℝ)
      else ((Nat.ceil H - 1 : ℕ) : ℝ)
    (z ≤ (p : ℝ) ∧ z ≤ (q : ℝ) ∧ q ≤ p ∧ P ∧ L ≤ (p : ℝ) ∧ (p : ℝ) ≤ U) ↔
      (9519 : ℝ) / 50000 ≤ Real.logb x (q : ℝ) ∧
        Real.logb x (q : ℝ) < Real.logb x (p : ℝ) ∧
        Real.logb x (p : ℝ) < (40481 : ℝ) / 100000 ∧
        (if e = 0 then
          Real.logb x (p : ℝ) + Real.logb x (q : ℝ) < (40481 : ℝ) / 100000 else
          (59519 : ℝ) / 100000 < Real.logb x (p : ℝ) + Real.logb x (q : ℝ) ∧
            Real.logb x (q : ℝ) < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000) := by
  intro z H B P L U
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hp0 : 0 < (p : ℝ) := Nat.cast_pos.mpr hp.pos
  have hq0 : 0 < (q : ℝ) := Nat.cast_pos.mpr hq.pos
  have hH : 0 < H := Real.rpow_pos_of_pos hx0 _
  have hlo : (9519 : ℝ) / 50000 ≤ Real.logb x (q : ℝ) ↔ z ≤ (q : ℝ) :=
    Real.le_logb_iff_rpow_le hx hq0
  have horder : Real.logb x (q : ℝ) < Real.logb x (p : ℝ) ↔ q < p := by
    simpa only [Nat.cast_lt] using Real.logb_lt_logb_iff hx hq0 hp0
  have htop : Real.logb x (p : ℝ) < (40481 : ℝ) / 100000 ↔ (p : ℝ) < H :=
    Real.logb_lt_iff_lt_rpow hx hp0
  have hlogs : Real.logb x (p : ℝ) + Real.logb x (q : ℝ) =
      Real.logb x ((p : ℝ) * (q : ℝ)) := (Real.logb_mul hp0.ne' hq0.ne').symm
  have hproduct :
      Real.logb x (p : ℝ) + Real.logb x (q : ℝ) < (40481 : ℝ) / 100000 ↔
        (p : ℝ) < H / (q : ℝ) := by
    rw [hlogs]
    exact (Real.logb_lt_iff_lt_rpow hx (mul_pos hp0 hq0)).trans (lt_div_iff₀ hq0).symm
  have hproductLower :
      (59519 : ℝ) / 100000 < Real.logb x (p : ℝ) + Real.logb x (q : ℝ) ↔
        B / (q : ℝ) < (p : ℝ) := by
    rw [hlogs]
    exact (Real.lt_logb_iff_rpow_lt hx (mul_pos hp0 hq0)).trans (div_lt_iff₀ hq0).symm
  have hsucc : (q : ℝ) + 1 ≤ (p : ℝ) ↔ q < p := by
    exact_mod_cast (Nat.succ_le_iff : q + 1 ≤ p ↔ q < p)
  have hfloor :
      (Nat.floor (B / (q : ℝ)) : ℝ) + 1 ≤ (p : ℝ) ↔ B / (q : ℝ) < (p : ℝ) := by
    calc
      _ ↔ Nat.floor (B / (q : ℝ)) + 1 ≤ p := by norm_cast
      _ ↔ Nat.floor (B / (q : ℝ)) < p := Nat.succ_le_iff
      _ ↔ B / (q : ℝ) < (p : ℝ) := Nat.floor_lt' hp.ne_zero
  have hcap : (p : ℝ) ≤ ((Nat.ceil H - 1 : ℕ) : ℝ) ↔ (p : ℝ) < H := by
    rw [Nat.cast_le, Nat.le_sub_one_iff_lt (Nat.ceil_pos.mpr hH), Nat.lt_ceil]
  have hcapDiv :
      (p : ℝ) ≤ ((Nat.ceil (H / (q : ℝ)) - 1 : ℕ) : ℝ) ↔
        (p : ℝ) < H / (q : ℝ) := by
    rw [Nat.cast_le, Nat.le_sub_one_iff_lt (Nat.ceil_pos.mpr (div_pos hH hq0)), Nat.lt_ceil]
  by_cases he : e = 0
  · simp only [P, L, U, eq_true he, ite_true, true_and, le_min_iff,
      hsucc, hcap, hcapDiv, hlo, horder, htop, hproduct]
    constructor
    · rintro ⟨_hzp, hzq, _hqp, hqp, htop', hproduct'⟩
      exact ⟨hzq, hqp, htop', hproduct'⟩
    · rintro ⟨hzq, hqp, htop', hproduct'⟩
      exact ⟨hzq.trans (Nat.cast_le.mpr hqp.le), hzq, hqp.le, hqp, htop', hproduct'⟩
  · simp only [P, L, U, eq_false he, ite_false, max_le_iff,
      hsucc, hfloor, hcap, hlo, horder, htop, hproductLower]
    constructor
    · rintro ⟨_hzp, hzq, _hqp, hsmall, ⟨hqp, hproduct'⟩, htop'⟩
      exact ⟨hzq, hqp, htop', hproduct', hsmall⟩
    · rintro ⟨hzq, hqp, htop', hproduct', hsmall⟩
      exact ⟨hzq.trans (Nat.cast_le.mpr hqp.le), hzq, hqp.le, hsmall,
        ⟨hqp, hproduct'⟩, htop'⟩

open Classical in
theorem sifted_short_triple_window_iff
    (x : ℝ) (hx : 1 < x) (p q r : ℕ)
    (hp : Nat.Prime p) (hq : Nat.Prime q) (hr : Nat.Prime r) :
    let z := x ^ ((9519 : ℝ) / 50000)
    let H := x ^ ((40481 : ℝ) / 100000)
    let P := r < q ∧
      Real.logb x (r : ℝ) < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000
    let L := (q : ℝ) + 1
    let U :=
      min ((Nat.ceil H - 1 : ℕ) : ℝ) ((Nat.ceil (H / (q : ℝ)) - 1 : ℕ) : ℝ)
    (z ≤ (p : ℝ) ∧ z ≤ (q : ℝ) ∧ q ≤ p ∧ z ≤ (r : ℝ) ∧ r ≤ p ∧
      P ∧ L ≤ (p : ℝ) ∧ (p : ℝ) ≤ U) ↔
      (9519 : ℝ) / 50000 ≤ Real.logb x (r : ℝ) ∧
        Real.logb x (r : ℝ) < Real.logb x (q : ℝ) ∧
        Real.logb x (q : ℝ) < Real.logb x (p : ℝ) ∧
        Real.logb x (p : ℝ) < (40481 : ℝ) / 100000 ∧
        Real.logb x (p : ℝ) + Real.logb x (q : ℝ) < (40481 : ℝ) / 100000 ∧
        Real.logb x (r : ℝ) < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000 := by
  intro z H P L U
  have hw :
      (z ≤ (p : ℝ) ∧ z ≤ (q : ℝ) ∧ q ≤ p ∧ True ∧
        L ≤ (p : ℝ) ∧ (p : ℝ) ≤ U) ↔
      (9519 : ℝ) / 50000 ≤ Real.logb x (q : ℝ) ∧
        Real.logb x (q : ℝ) < Real.logb x (p : ℝ) ∧
        Real.logb x (p : ℝ) < (40481 : ℝ) / 100000 ∧
        Real.logb x (p : ℝ) + Real.logb x (q : ℝ) < (40481 : ℝ) / 100000 := by
    simpa only [ite_true] using sifted_short_pair_window_iff x hx (0 : Fin 2) p q hp hq
  have hrlo : (9519 : ℝ) / 50000 ≤ Real.logb x (r : ℝ) ↔ z ≤ (r : ℝ) :=
    Real.le_logb_iff_rpow_le hx (Nat.cast_pos.mpr hr.pos)
  have hrorder : Real.logb x (r : ℝ) < Real.logb x (q : ℝ) ↔ r < q := by
    simpa only [Nat.cast_lt] using
      Real.logb_lt_logb_iff hx (Nat.cast_pos.mpr hr.pos) (Nat.cast_pos.mpr hq.pos)
  constructor
  · rintro ⟨hzp, hzq, hqp, hzr, _hrp, ⟨hrq, hsmall⟩, hL, hU⟩
    obtain ⟨_hxiq, hqp', htop, hproduct⟩ := hw.mp ⟨hzp, hzq, hqp, True.intro, hL, hU⟩
    exact ⟨hrlo.mpr hzr, hrorder.mpr hrq, hqp', htop, hproduct, hsmall⟩
  · rintro ⟨hxir, hrq, hqp, htop, hproduct, hsmall⟩
    obtain ⟨hzp, hzq, hqp', _htrue, hL, hU⟩ :=
      hw.mpr ⟨hxir.trans hrq.le, hqp, htop, hproduct⟩
    exact ⟨hzp, hzq, hqp', hrlo.mp hxir, (hrorder.mp hrq).le.trans hqp',
      ⟨hrorder.mp hrq, hsmall⟩, hL, hU⟩

open Classical in
theorem fullDiscrepancy_sample_sub
    (S : Finset ℕ) (f g : ℕ → ℂ) (q a : ℕ) :
    fullDiscrepancy (∑ n ∈ S, Finsupp.single n (f n - g n)) q a =
      fullDiscrepancy (∑ n ∈ S, Finsupp.single n (f n)) q a -
        fullDiscrepancy (∑ n ∈ S, Finsupp.single n (g n)) q a := by
  simp only [fullDiscrepancy_sample, ← Finset.sum_sub_distrib, sub_sub_sub_comm,
    ← sub_div, ite_sub_ite, sub_self]

open Classical in
theorem harmanB_primeFactor_band_coefficient_eq
    (n : ℕ) (j : Fin 2) (absolute : Bool) (slo shi Zlo Zhi L U : ℝ) :
    let B : ℕ → ℤ := fun n =>
      ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
        if (if j = 0 then aa.1 = 1 else Nat.Prime aa.1) ∧
            slo ≤ (aa.1 : ℝ) ∧ (aa.1 : ℝ) ≤ shi ∧
            Zlo ≤ ((max 1 (bb.1.primeFactors.sup id) : ℕ) : ℝ) ∧
            ((max 1 (bb.1.primeFactors.sup id) : ℕ) : ℝ) < Zhi ∧
            L ≤ ((aa.1 * bb.1 : ℕ) : ℝ) ∧ ((aa.1 * bb.1 : ℕ) : ℝ) ≤ U
        then (if absolute then |ArithmeticFunction.moebius bb.1|
              else ArithmeticFunction.moebius bb.1)
        else 0
    let Bcut : ℝ → ℕ → ℤ := fun Z n =>
      ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
        if (if j = 0 then aa.1 = 1 else Nat.Prime aa.1) ∧
            slo ≤ (aa.1 : ℝ) ∧ (aa.1 : ℝ) ≤ shi ∧
            ((max 1 (bb.1.primeFactors.sup id) : ℕ) : ℝ) < Z ∧
            L ≤ ((aa.1 * bb.1 : ℕ) : ℝ) ∧ ((aa.1 * bb.1 : ℕ) : ℝ) ≤ U
        then (if absolute then |ArithmeticFunction.moebius bb.1|
              else ArithmeticFunction.moebius bb.1)
        else 0
    B n = if Zlo ≤ Zhi then Bcut Zhi n - Bcut Zlo n else 0 := by
  intro B Bcut
  by_cases horder : Zlo ≤ Zhi
  · rw [ite_eq_left horder]
    dsimp only [B, Bcut]
    rw [← Finset.sum_sub_distrib]
    apply Finset.sum_congr rfl
    intro aa _haa
    rw [← Finset.sum_sub_distrib]
    apply Finset.sum_congr rfl
    intro bb _hbb
    by_cases hlo : Zlo ≤ ((max 1 (bb.1.primeFactors.sup id) : ℕ) : ℝ)
    · have hnot : ¬ ((max 1 (bb.1.primeFactors.sup id) : ℕ) : ℝ) < Zlo :=
        not_lt.mpr hlo
      simp only [eq_true hlo, true_and, eq_false hnot, false_and, and_false,
        ite_false, sub_zero]
    · have hlt : ((max 1 (bb.1.primeFactors.sup id) : ℕ) : ℝ) < Zlo :=
        lt_of_not_ge hlo
      have hhi := hlt.trans_le horder
      simp only [eq_false hlo, false_and, and_false, ite_false, eq_true hlt,
        eq_true hhi, true_and, sub_self]
  · rw [ite_eq_right horder]
    dsimp only [B]
    apply Finset.sum_eq_zero
    intro aa _haa
    apply Finset.sum_eq_zero
    intro bb _hbb
    apply ite_eq_right
    intro h
    exact horder (h.2.2.2.1.trans h.2.2.2.2.1.le)

open Classical in
theorem harmanB_primeFactor_band_all_moduli_siegelWalfisz
    (ε T c C A : ℝ) (hε : 0 < ε) (hT : 0 < T) (hc : 0 < c)
    (hC : 0 < C) (hA : 0 < A) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ j : Fin 2, ∀ absolute : Bool,
      ∀ slo shi Zlo Zhi L U nlo nhi : ℝ,
        0 < Zlo → 0 < Zhi → c * N ≤ nlo →
      ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 → ∀ a : ℕ, Nat.Coprime a q →
      let B : ℕ → ℤ := fun n =>
        ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
          if (if j = 0 then aa.1 = 1 else Nat.Prime aa.1) ∧
              slo ≤ (aa.1 : ℝ) ∧ (aa.1 : ℝ) ≤ shi ∧
              Zlo ≤ ((max 1 (bb.1.primeFactors.sup id) : ℕ) : ℝ) ∧
              ((max 1 (bb.1.primeFactors.sup id) : ℕ) : ℝ) < Zhi ∧
              L ≤ ((aa.1 * bb.1 : ℕ) : ℝ) ∧ ((aa.1 * bb.1 : ℕ) : ℝ) ≤ U
          then (if absolute then |ArithmeticFunction.moebius bb.1|
                else ArithmeticFunction.moebius bb.1)
          else 0
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
          (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
           then (B n : ℂ) else 0)) q a‖ ≤
        K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨K0, X0, hK0, hX0, hmain⟩ :=
    harmanB_signed_or_absolute_all_moduli_siegelWalfisz ε T c C A hε hT hc hC hA
  refine ⟨2 * K0, X0, by positivity, hX0, ?_⟩
  intro x hx N hNL hNU j absolute slo shi Zlo Zhi L U nlo nhi
    hZlo hZhi hnlo q hq r0 hr0 a ha B
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le (hX0.trans hx)
  have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr (hX0.trans hx)
  have hlog : 0 ≤ Real.log x := zero_le_one.trans hlog1
  have hN : 0 ≤ N := (Real.rpow_pos_of_pos hx0 ε).le.trans hNL
  let S : Finset ℕ := Finset.Icc 1 (Nat.floor (T * N))
  let Bcut : ℝ → ℕ → ℤ := fun Z n =>
    ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
      if (if j = 0 then aa.1 = 1 else Nat.Prime aa.1) ∧
          slo ≤ (aa.1 : ℝ) ∧ (aa.1 : ℝ) ≤ shi ∧
          ((max 1 (bb.1.primeFactors.sup id) : ℕ) : ℝ) < Z ∧
          L ≤ ((aa.1 * bb.1 : ℕ) : ℝ) ∧ ((aa.1 * bb.1 : ℕ) : ℝ) ≤ U
      then (if absolute then |ArithmeticFunction.moebius bb.1|
            else ArithmeticFunction.moebius bb.1)
      else 0
  let f : ℝ → ℕ → ℂ := fun Z n =>
    if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
    then (Bcut Z n : ℂ) else 0
  have hcut (Z : ℝ) (hZ : 0 < Z) :
      ‖fullDiscrepancy (∑ n ∈ S, Finsupp.single n (f Z n)) q a‖ ≤
        K0 * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A :=
    hmain x hx N hNL hNU j absolute slo shi Z L U nlo nhi hZ hnlo q hq r0 hr0 a ha
  have hfinite (n : ℕ) :
      B n = if Zlo ≤ Zhi then Bcut Zhi n - Bcut Zlo n else 0 :=
    harmanB_primeFactor_band_coefficient_eq n j absolute slo shi Zlo Zhi L U
  by_cases horder : Zlo ≤ Zhi
  · have hcoefficient (n : ℕ) : B n = Bcut Zhi n - Bcut Zlo n := by
      simpa only [ite_eq_left horder] using hfinite n
    have hsample :
        (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
          (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
           then (B n : ℂ) else 0)) =
        ∑ n ∈ S, Finsupp.single n (f Zhi n - f Zlo n) := by
      apply Finset.sum_congr rfl
      intro n _hn
      rw [hcoefficient, Int.cast_sub]
      by_cases hlocal : nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
      · simp only [f, eq_true hlocal, ite_true]
      · simp only [f, eq_false hlocal, ite_false, sub_self]
    rw [hsample, fullDiscrepancy_sample_sub]
    calc
      _ ≤ ‖fullDiscrepancy (∑ n ∈ S, Finsupp.single n (f Zhi n)) q a‖ +
          ‖fullDiscrepancy (∑ n ∈ S, Finsupp.single n (f Zlo n)) q a‖ :=
        norm_sub_le _ _
      _ ≤ K0 * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A +
          K0 * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A :=
        add_le_add (hcut Zhi hZhi) (hcut Zlo hZlo)
      _ = (2 * K0) * ((q * r0).divisors.card : ℝ) * N /
          (Real.log x) ^ A := by ring
  · have hzero (n : ℕ) : B n = 0 := by
      simpa only [ite_eq_right horder] using hfinite n
    rw [fullDiscrepancy_sample]
    simp only [hzero, Int.cast_zero, ite_self, zero_div, sub_self,
      Finset.sum_const_zero, norm_zero]
    positivity

theorem mellin_weight_discrete_variation_le_one
    (U : ℕ) (t : ℝ) (ht : 0 ≤ t) :
    let w : ℕ → ℂ := fun n => (((n : ℝ) ^ (-t) : ℝ) : ℂ)
    ‖w U‖ + (∑ n ∈ Finset.Ico 1 U, ‖w (n + 1) - w n‖) ≤ 1 := by
  intro w
  let r : ℕ → ℝ := fun n => (n : ℝ) ^ (-t)
  have hr (n : ℕ) : 0 ≤ r n := Real.rpow_nonneg (Nat.cast_nonneg n) (-t)
  have hnorm (n : ℕ) : ‖w n‖ = r n := by
    change ‖(r n : ℂ)‖ = r n
    rw [Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg (hr n)]
  have hmono (n : ℕ) (hn : 1 ≤ n) : r (n + 1) ≤ r n :=
    Real.rpow_le_rpow_of_nonpos (Nat.cast_pos.mpr hn)
      (Nat.cast_le.mpr (Nat.le_succ n)) (neg_nonpos.mpr ht)
  have hdiff (n : ℕ) (hn : 1 ≤ n) :
      ‖w (n + 1) - w n‖ = r n - r (n + 1) := by
    change ‖(r (n + 1) : ℂ) - (r n : ℂ)‖ = r n - r (n + 1)
    rw [← Complex.ofReal_sub, Complex.norm_real, Real.norm_eq_abs,
      abs_of_nonpos (sub_nonpos.mpr (hmono n hn))]
    ring
  by_cases hU : U = 0
  · subst U
    rw [hnorm]
    simpa only [Finset.Ico_eq_empty_of_le (Nat.zero_le 1), Finset.sum_empty,
      add_zero, r, Nat.cast_zero] using Real.zero_rpow_le_one (-t)
  · have hU1 : 1 ≤ U := Nat.pos_of_ne_zero hU
    have hsum :
        (∑ n ∈ Finset.Ico 1 U, ‖w (n + 1) - w n‖) =
          ∑ n ∈ Finset.Ico 1 U, (r n - r (n + 1)) :=
      Finset.sum_congr rfl fun n hn => hdiff n (Finset.mem_Ico.mp hn).1
    have htel := Finset.sum_Ico_sub (fun n : ℕ => -r n) hU1
    simp only [neg_sub_neg] at htel
    have hr1 : r 1 = 1 := by simp only [r, Nat.cast_one, Real.one_rpow]
    rw [hnorm, hsum, htel, hr1]
    linarith

open Classical in
theorem sifted_short_empty_coefficient_eq (x : ℝ) (n : ℕ) :
    (∑ ps ∈ siftedPrimeTuples x (0 : Fin 6), ∑ d ∈ n.divisorsAntidiagonal,
      if d.1 = ps.prod then smallPrimeMobius (x ^ ((9519 : ℝ) / 50000)) d.2 else 0) =
      smallPrimeMobius (x ^ ((9519 : ℝ) / 50000)) n := by
  have hs : siftedPrimeTuples x (0 : Fin 6) = {[]} := rfl
  rw [hs, Finset.sum_singleton, List.prod_nil]
  by_cases hn : n = 0
  · subst n
    simp
  have hunit : (1, n) ∈ n.divisorsAntidiagonal :=
    Nat.mem_divisorsAntidiagonal.mpr ⟨one_mul _, hn⟩
  rw [Finset.sum_eq_single_of_mem (1, n) hunit]
  · rfl
  · intro d hd hne
    apply ite_eq_right
    intro hd1
    have hd2 : d.2 = n := by
      simpa only [hd1, one_mul] using (Nat.mem_divisorsAntidiagonal.mp hd).1
    exact hne (Prod.ext hd1 hd2)

open Classical in
theorem sifted_short_empty_all_moduli_siegelWalfisz
    (ε T c C A : ℝ) (hε : 0 < ε) (hT : 0 < T) (hc : 0 < c)
    (hC : 0 < C) (hA : 0 < A) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ nlo nhi : ℝ, c * N ≤ nlo →
      ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 →
      ∀ a : ℕ, Nat.Coprime a q →
      let z := x ^ ((9519 : ℝ) / 50000)
      let M0 := x ^ (1 - (1058 : ℝ) / 3125)
      let S0 : ℕ → ℝ := fun n =>
        if (n : ℝ) ≤ M0 then
          ∑ ps ∈ siftedPrimeTuples x (0 : Fin 6), ∑ d ∈ n.divisorsAntidiagonal,
            if d.1 = ps.prod then smallPrimeMobius z d.2 else 0
        else 0
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
          (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
           then (S0 n : ℂ) else 0)) q a‖ ≤
        K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨K, X0, hK, hX0, hbound⟩ :=
    harmanA0_unit_all_moduli_siegelWalfisz ε T c C A hε hT hc hC hA
  refine ⟨K, X0, hK, hX0, ?_⟩
  intro x hx N hNL hNU nlo nhi hlo q hq r0 hr0 a ha z M0 S0
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le (hX0.trans hx)
  have hz : 0 < z := Real.rpow_pos_of_pos hx0 _
  have hS0 (n : ℕ) :
      S0 n = if (n : ℝ) ≤ M0 then smallPrimeMobius z n else 0 := by
    dsimp only [S0]
    rw [sifted_short_empty_coefficient_eq]
  have hb := hbound x hx N hNL hNU z M0 nlo nhi hz hlo false q hq r0 hr0 a ha
  dsimp only at hb
  simp only [Bool.coe_sort_false, ite_false] at hb
  simpa only [hS0, smallPrimeMobius,
    ArithmeticFunction.coe_mk, apply_ite (fun t : ℝ => (t : ℂ)),
    apply_ite (fun t : ℤ => (t : ℂ)), Complex.ofReal_intCast,
    Complex.ofReal_zero, Int.cast_zero, ← ite_and] using hb

open Classical in
theorem sifted_short_sixth_all_moduli_siegelWalfisz
    (ε T c C A : ℝ) (hε : 0 < ε) (hT : 0 < T) (hc : 0 < c)
    (hC : 0 < C) (hA : 0 < A) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ nlo nhi : ℝ, c * N ≤ nlo →
      ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 →
      ∀ a : ℕ, Nat.Coprime a q →
      let z := x ^ ((9519 : ℝ) / 50000)
      let M0 := x ^ (1 - (1058 : ℝ) / 3125)
      let S0 : ℕ → ℝ := fun n =>
        if (n : ℝ) ≤ M0 then
          ∑ ps ∈ siftedPrimeTuples x (5 : Fin 6), ∑ d ∈ n.divisorsAntidiagonal,
            if d.1 = ps.prod then smallPrimeMobius z d.2 else 0
        else 0
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
          (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
           then (S0 n : ℂ) else 0)) q a‖ ≤
        K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨K, X0, hK, hX0, hbound⟩ :=
    theta6_a0_all_moduli_siegelWalfisz ε T c C A hε hT hc hC hA
  refine ⟨K, X0, hK, hX0, ?_⟩
  intro x hx N hNL hNU nlo nhi hlo q hq r0 hr0 a ha z M0 S0
  have hx1 : 1 < x :=
    (Real.one_lt_exp_iff.mpr (by norm_num : (0 : ℝ) < 1)).trans_le (hX0.trans hx)
  have hx0 : 0 < x := zero_lt_one.trans hx1
  have hz1 : 1 < z := Real.one_lt_rpow hx1 (by norm_num)
  let H := x ^ ((40481 : ℝ) / 100000)
  let S := x ^ (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000)
  have hH : 0 < H := Real.rpow_pos_of_pos hx0 _
  have hS : 0 < S := Real.rpow_pos_of_pos hx0 _
  let Q0 : ℕ → ℤ := fun n =>
    ∑ p2 ∈ n.primeFactors, ∑ p3 ∈ n.primeFactors, ∑ p4 ∈ n.primeFactors,
      if p2 * p3 * p4 ∣ n ∧ z ≤ (p3 : ℝ) ∧ p3 < p2 ∧ (p2 : ℝ) < H ∧
          p3 ≤ p4 ∧ ((p3 * p4 : ℕ) : ℝ) < H ∧ (p2 : ℝ) < S ∧
          n / (p2 * p3 * p4) ∈ Nat.smoothNumbers (Nat.ceil z)
      then ArithmeticFunction.moebius (n / (p2 * p3 * p4)) else 0
  have hcoeff (n : ℕ) : (Q0 n : ℂ) =
      ((∑ ps ∈ siftedPrimeTuples x (5 : Fin 6), ∑ d ∈ n.divisorsAntidiagonal,
        if d.1 = ps.prod then smallPrimeMobius z d.2 else 0 : ℝ) : ℂ) := by
    have hs := congrArg (fun t : ℝ => (t : ℂ))
      (sifted_short_sixth_primeFactors_coefficient_eq x hx1 n)
    simpa only [Complex.ofReal_intCast] using hs.symm
  have hb := hbound x hx N hNL hNU z H S M0 nlo nhi hH hS hlo q hq r0 hr0 a ha
  dsimp only at hb
  simp only [eq_true hz1, true_and] at hb
  change ‖fullDiscrepancy
    (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
      (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
       then ((if (n : ℝ) ≤ M0 then Q0 n else 0 : ℤ) : ℂ) else 0)) q a‖ ≤
    K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A at hb
  simpa only [apply_ite (fun t : ℤ => (t : ℂ)),
    Int.cast_zero, hcoeff, S0, apply_ite (fun t : ℝ => (t : ℂ)),
    Complex.ofReal_zero] using hb

section
open scoped ContDiff

open Classical in
theorem harmanA_unit_all_moduli_siegelWalfisz
    (ε T c C A : ℝ) (hε : 0 < ε) (hT : 0 < T) (hc : 0 < c)
    (hC : 0 < C) (hA : 0 < A) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ z H lo hi : ℝ, 0 < z → 1 < H → c * N ≤ lo →
      ∀ b : Bool, ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 →
      ∀ a : ℕ, Nat.Coprime a q →
      let A0 : ℕ → ℤ := fun n =>
        if 1 < n ∧ ((max 1 (n.primeFactors.sup id) : ℕ) : ℝ) < z ∧
            ((n / n.minFac : ℕ) : ℝ) < H ∧ H ≤ (n : ℝ)
        then (if b then |ArithmeticFunction.moebius n| else ArithmeticFunction.moebius n)
        else 0
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
          (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n r0
           then (A0 n : ℂ) else 0)) q a‖ ≤
        K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A :=
  harmanA_unit_all_moduli_siegelWalfisz_of_minFac_interval
    ε T c C A hε hT hc hC hA

open Classical in
theorem harmanB_all_moduli_siegelWalfisz
    (ε T c C A : ℝ) (hε : 0 < ε) (hT : 0 < T) (hc : 0 < c)
    (hC : 0 < C) (hA : 0 < A) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ j : Fin 2, ∀ slo shi Z L U nlo nhi : ℝ, 0 < Z → c * N ≤ nlo →
      ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 → ∀ a : ℕ, Nat.Coprime a q →
      let B : ℕ → ℤ := fun n =>
        ∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
          if (if j = 0 then a.1 = 1 else Nat.Prime a.1) ∧
              slo ≤ (a.1 : ℝ) ∧ (a.1 : ℝ) ≤ shi ∧
              ((max 1 (b.1.primeFactors.sup id) : ℕ) : ℝ) < Z ∧
              L ≤ ((a.1 * b.1 : ℕ) : ℝ) ∧ ((a.1 * b.1 : ℕ) : ℝ) ≤ U
          then ArithmeticFunction.moebius b.1 else 0
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
          (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
           then (B n : ℂ) else 0)) q a‖ ≤
        K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨K, X0, hK, hX0, hmain⟩ :=
    harmanB_signed_or_absolute_all_moduli_siegelWalfisz ε T c C A hε hT hc hC hA
  refine ⟨K, X0, hK, hX0, ?_⟩
  intro x hx N hNL hNU j slo shi Z L U nlo nhi hZ hnlo q hq r0 hr0 a ha
  simpa only [Bool.false_eq_true, ite_false] using
    hmain x hx N hNL hNU j false slo shi Z L U nlo nhi hZ hnlo q hq r0 hr0 a ha

end

open Classical in
theorem harmanB_weighted_all_moduli_siegelWalfisz
    (ε T c C A D : ℝ) (hε : 0 < ε) (hT : 0 < T) (hc : 0 < c)
    (hC : 0 < C) (hA : 0 < A) (hD : 0 ≤ D) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ j : Fin 2, ∀ slo shi Z L U nlo nhi : ℝ, 0 < Z → c * N ≤ nlo →
      ∀ w : ℕ → ℂ,
        ‖w (Nat.floor (T * N))‖ +
          (∑ n ∈ Finset.Ico 1 (Nat.floor (T * N)), ‖w (n + 1) - w n‖) ≤
            (Real.log x) ^ D →
      ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 → ∀ a : ℕ, Nat.Coprime a q →
      let B : ℕ → ℤ := fun n =>
        ∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
          if (if j = 0 then a.1 = 1 else Nat.Prime a.1) ∧
              slo ≤ (a.1 : ℝ) ∧ (a.1 : ℝ) ≤ shi ∧
              ((max 1 (b.1.primeFactors.sup id) : ℕ) : ℝ) < Z ∧
              L ≤ ((a.1 * b.1 : ℕ) : ℝ) ∧ ((a.1 * b.1 : ℕ) : ℝ) ≤ U
          then ArithmeticFunction.moebius b.1 else 0
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
          (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
           then w n * (B n : ℂ) else 0)) q a‖ ≤
        K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨K, X0, hK, hX0, hmain⟩ :=
    harmanB_all_moduli_siegelWalfisz ε T c C (A + D) hε hT hc hC (by linarith)
  refine ⟨K, X0, hK, hX0, ?_⟩
  intro x hx N hNL hNU j slo shi Z L U nlo nhi hZ hnlo w hw q hq r0 hr0 a ha B
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le (hX0.trans hx)
  have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr (hX0.trans hx)
  have hlog : 0 < Real.log x := zero_lt_one.trans_le hlog1
  have hN : 0 ≤ N := (Real.rpow_pos_of_pos hx0 ε).le.trans hNL
  let NN := Nat.floor (T * N)
  let f : ℕ → ℂ := fun n =>
    if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi then (B n : ℂ) else 0
  let E : ℝ := K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ (A + D)
  have hE : 0 ≤ E := by
    dsimp only [E]
    positivity
  have hmask (n : ℕ) :
      (if Nat.Coprime n r0 then f n else 0) =
        if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
        then (B n : ℂ) else 0 := by
    by_cases h1 : nlo ≤ (n : ℝ) <;> by_cases h2 : (n : ℝ) ≤ nhi <;>
      by_cases h3 : Nat.Coprime n r0 <;> simp [f, h1, h2, h3]
  have hprefix (k : ℕ) (hk1 : 1 ≤ k) (hkN : k ≤ NN) :
      ‖fullDiscrepancy (∑ n ∈ Finset.Icc 1 k, Finsupp.single n
        (if Nat.Coprime n r0 then f n else 0)) q a‖ ≤ E := by
    have hset : Finset.Icc 1 k = (Finset.Icc 1 NN).filter (fun n => n ≤ k) := by
      ext n
      simp only [Finset.mem_Icc, Finset.mem_filter]
      omega
    have hsource :
        (∑ n ∈ Finset.Icc 1 k, Finsupp.single n
          (if Nat.Coprime n r0 then f n else 0)) =
        ∑ n ∈ Finset.Icc 1 NN, Finsupp.single n
          (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ min nhi (k : ℝ) ∧ Nat.Coprime n r0
           then (B n : ℂ) else 0) := by
      rw [hset, Finset.sum_filter]
      apply Finset.sum_congr rfl
      intro n hn
      rw [hmask]
      by_cases hnk : n ≤ k <;>
        simp [hnk, Nat.cast_le]
    have hb := hmain x hx N hNL hNU j slo shi Z L U nlo (min nhi (k : ℝ))
      hZ hnlo q hq r0 hr0 a ha
    change ‖fullDiscrepancy (∑ n ∈ Finset.Icc 1 NN, Finsupp.single n
      (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ min nhi (k : ℝ) ∧ Nat.Coprime n r0
       then (B n : ℂ) else 0)) q a‖ ≤ E at hb
    rw [hsource]
    exact hb
  have hparts := norm_fullDiscrepancy_Icc_weighted_le_of_prefix
    1 NN q a r0 f w E hE hprefix
  have hsource :
      (∑ n ∈ Finset.Icc 1 NN, Finsupp.single n
        (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
         then w n * (B n : ℂ) else 0)) =
      ∑ n ∈ Finset.Icc 1 NN, Finsupp.single n
        (if Nat.Coprime n r0 then w n * f n else 0) := by
    apply Finset.sum_congr rfl
    intro n hn
    by_cases h1 : nlo ≤ (n : ℝ) <;> by_cases h2 : (n : ℝ) ≤ nhi <;>
      by_cases h3 : Nat.Coprime n r0 <;> simp [f, h1, h2, h3]
  change ‖fullDiscrepancy (∑ n ∈ Finset.Icc 1 NN, Finsupp.single n
    (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
     then w n * (B n : ℂ) else 0)) q a‖ ≤ _
  rw [hsource]
  calc
    _ ≤ E * (‖w NN‖ + ∑ n ∈ Finset.Ico 1 NN, ‖w (n + 1) - w n‖) := hparts
    _ ≤ E * (Real.log x) ^ D := mul_le_mul_of_nonneg_left hw hE
    _ = K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
      dsimp only [E]
      rw [Real.rpow_add hlog, div_mul_eq_div_div,
        div_mul_cancel₀ _ (Real.rpow_pos_of_pos hlog D).ne']

open Classical in
theorem harmanB_mellin_all_moduli_siegelWalfisz
    (ε T c C A : ℝ) (hε : 0 < ε) (hT : 0 < T) (hc : 0 < c)
    (hC : 0 < C) (hA : 0 < A) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ j : Fin 2, ∀ slo shi Z L U nlo nhi : ℝ, 0 < Z → c * N ≤ nlo →
      ∀ t : ℝ, 0 ≤ t →
      ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 → ∀ a : ℕ, Nat.Coprime a q →
      let B : ℕ → ℤ := fun n =>
        ∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
          if (if j = 0 then a.1 = 1 else Nat.Prime a.1) ∧
              slo ≤ (a.1 : ℝ) ∧ (a.1 : ℝ) ≤ shi ∧
              ((max 1 (b.1.primeFactors.sup id) : ℕ) : ℝ) < Z ∧
              L ≤ ((a.1 * b.1 : ℕ) : ℝ) ∧ ((a.1 * b.1 : ℕ) : ℝ) ≤ U
          then ArithmeticFunction.moebius b.1 else 0
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
          (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
           then (((n : ℝ) ^ (-t) : ℝ) : ℂ) * (B n : ℂ) else 0)) q a‖ ≤
        K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨K, X0, hK, hX0, hmain⟩ :=
    harmanB_weighted_all_moduli_siegelWalfisz ε T c C A 0 hε hT hc hC hA le_rfl
  refine ⟨K, X0, hK, hX0, ?_⟩
  intro x hx N hNL hNU j slo shi Z L U nlo nhi hZ hnlo t ht q hq r0 hr0 a ha
  have hvariation :
      ‖(((Nat.floor (T * N) : ℝ) ^ (-t) : ℝ) : ℂ)‖ +
        (∑ n ∈ Finset.Ico 1 (Nat.floor (T * N)),
          ‖((((n + 1 : ℕ) : ℝ) ^ (-t) : ℝ) : ℂ) -
            (((n : ℝ) ^ (-t) : ℝ) : ℂ)‖) ≤
          (Real.log x) ^ (0 : ℝ) := by
    simpa only [Real.rpow_zero] using
      mellin_weight_discrete_variation_le_one (Nat.floor (T * N)) t ht
  exact hmain x hx N hNL hNU j slo shi Z L U nlo nhi hZ hnlo
    (fun n => (((n : ℝ) ^ (-t) : ℝ) : ℂ)) hvariation q hq r0 hr0 a ha

open Classical in
theorem sifted_short_empty_raw_norm_le (x : ℝ) (n : ℕ) :
    ‖((∑ ps ∈ siftedPrimeTuples x (0 : Fin 6), ∑ d ∈ n.divisorsAntidiagonal,
      if d.1 = ps.prod then smallPrimeMobius (x ^ ((9519 : ℝ) / 50000)) d.2
      else 0 : ℝ) : ℂ)‖ ≤ (n.divisors.card : ℝ) ^ 3 := by
  rw [sifted_short_empty_coefficient_eq]
  by_cases hn : n = 0
  · subst n
    simp
  have hτ : (1 : ℝ) ≤ n.divisors.card := by
    exact_mod_cast (Finset.one_le_card.mpr
      ⟨1, Nat.one_mem_divisors.mpr hn⟩ : 1 ≤ n.divisors.card)
  have hτ3 : (1 : ℝ) ≤ (n.divisors.card : ℝ) ^ 3 := by
    calc
      (1 : ℝ) = (1 : ℝ) ^ 3 := by norm_num
      _ ≤ _ := pow_le_pow_left₀ zero_le_one hτ 3
  have hmu : ‖(ArithmeticFunction.moebius n : ℂ)‖ ≤ 1 := by
    exact_mod_cast (ArithmeticFunction.abs_moebius_le_one (n := n))
  have hcut := norm_harman_int_cut_le_one
    (((max 1 (n.primeFactors.sup id) : ℕ) : ℝ) <
      x ^ ((9519 : ℝ) / 50000)) (ArithmeticFunction.moebius n) hmu
  have hsmall : ‖(smallPrimeMobius (x ^ ((9519 : ℝ) / 50000)) n : ℂ)‖ ≤ 1 := by
    simpa only [smallPrimeMobius, ArithmeticFunction.coe_mk,
      apply_ite (fun t : ℝ => (t : ℂ)), apply_ite (fun t : ℤ => (t : ℂ)),
      Complex.ofReal_intCast, Complex.ofReal_zero, Int.cast_zero] using hcut
  exact hsmall.trans hτ3

open Classical in
theorem sifted_short_one_raw_norm_le (x : ℝ) (hx : 1 < x) (n : ℕ) :
    ‖((∑ ps ∈ siftedPrimeTuples x (1 : Fin 6), ∑ d ∈ n.divisorsAntidiagonal,
      if d.1 = ps.prod then smallPrimeMobius (x ^ ((9519 : ℝ) / 50000)) d.2
      else 0 : ℝ) : ℂ)‖ ≤ (n.divisors.card : ℝ) ^ 3 := by
  let z := x ^ ((9519 : ℝ) / 50000)
  let H := x ^ ((40481 : ℝ) / 100000)
  let U0 : ℝ := ((Nat.ceil H - 1 : ℕ) : ℝ)
  let Q0 : ℤ :=
    ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
      ∑ cc ∈ bb.2.divisorsAntidiagonal,
        if Nat.Prime aa.1 ∧ z ≤ (aa.1 : ℝ) ∧ bb.1 = 1 ∧ bb.1 ≤ aa.1 ∧
            cc.1 = 1 ∧ cc.1 ≤ aa.1 ∧
            ((max 1 (cc.2.primeFactors.sup id) : ℕ) : ℝ) < z ∧
            True ∧ 0 ≤ (aa.1 : ℝ) ∧ (aa.1 : ℝ) ≤ U0
        then ArithmeticFunction.moebius cc.2 else 0
  have hb := harmanA0_named_coefficient_norm_le n (0 : Fin 2) (0 : Fin 2)
    (fun _ _ _ => True) (fun _ _ _ => (0 : ℝ)) (fun _ _ _ => U0) z (n : ℝ) false
  dsimp only at hb
  simp only [le_refl, ite_true] at hb
  change ‖(Q0 : ℂ)‖ ≤ (n.divisors.card : ℝ) ^ 3 at hb
  have hs := congrArg (fun t : ℝ => (t : ℂ))
    (sifted_short_one_prime_named_coefficient_eq x hx n)
  simp only [Complex.ofReal_intCast] at hs
  rw [← hs] at hb
  exact hb

theorem minorant_boundary_log_arithmetic (A x m z : ℝ)
    (hA : 0 < A) (hx : Real.exp 1 ≤ x) (hm : 0 ≤ m) (hz : 0 ≤ z)
    (hmass : m ≤ 17 * 64 *
      (1023 * (Real.log x) ^ (-(A + 20)) * x +
        x ^ (1 - (9519 : ℝ) / 50000)) * (1 + Real.log (64 * x)) ^ 16)
    (hzbound : z ≤ 4 * (Real.log x) ^ 2)
    (hsmall : (Real.log x) ^ (A + 18) ≤ x ^ ((9519 : ℝ) / 50000)) :
    2 * m * z ≤
      (8 * (17 * 64) * (1023 + 1) * (2 + Real.log 64) ^ 16) *
        x / (Real.log x) ^ A := by
  let D : ℝ := A + 20
  let l : ℝ := Real.log x
  let h : ℝ := l ^ (-D)
  let C0 : ℝ := 2 + Real.log 64
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le hx
  have hx1 : 1 ≤ x := (Real.one_le_exp (by norm_num : (0 : ℝ) ≤ 1)).trans hx
  have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hx
  have hlog0 : 0 < Real.log x := zero_lt_one.trans_le hlog1
  have hLA : 0 < l ^ A := zero_lt_one.trans_le (Real.one_le_rpow hlog1 hA.le)
  have hh : 0 < h := Real.rpow_pos_of_pos hlog0 _
  have hC0 : 0 < C0 := by
    have hlog64 := Real.log_nonneg (by norm_num : (1 : ℝ) ≤ 64)
    dsimp [C0]
    linarith
  have hlog64 : 1 + Real.log (64 * x) ≤ C0 * l := by
    rw [Real.log_mul (by norm_num : (64 : ℝ) ≠ 0) hx0.ne']
    dsimp only [C0, l]
    nlinarith [Real.log_nonneg (by norm_num : (1 : ℝ) ≤ 64)]
  have hH0 : 0 ≤ 1 + Real.log (64 * x) := by
    have := Real.log_nonneg (show (1 : ℝ) ≤ 64 * x by nlinarith)
    linarith
  have hlog64pow : (1 + Real.log (64 * x)) ^ 16 ≤ C0 ^ 16 * l ^ 16 := by
    simpa only [mul_pow] using pow_le_pow_left₀ hH0 hlog64 16
  have hmeshdecay : h * l ^ 18 ≤ 1 / l ^ A := by
    have heq : h * l ^ 18 = l ^ (18 - D) := by
      dsimp only [h, l]
      rw [show (l ^ 18 : ℝ) = l ^ (18 : ℝ) from (Real.rpow_natCast l 18).symm,
        ← Real.rpow_add hlog0]
      congr 1
      ring
    rw [heq, one_div, ← Real.rpow_neg hlog0.le]
    exact Real.rpow_le_rpow_of_exponent_le hlog1 (by dsimp [D]; linarith)
  have hpowerdecay : x ^ (1 - (9519 : ℝ) / 50000) * l ^ 18 ≤ x / l ^ A := by
    apply (le_div_iff₀ hLA).mpr
    calc
      _ = x ^ (1 - (9519 : ℝ) / 50000) * l ^ (A + 18) := by
        dsimp only [l]
        rw [Real.rpow_add hlog0,
          show (Real.log x) ^ (18 : ℝ) = (Real.log x) ^ (18 : ℕ) from Real.rpow_natCast _ 18]
        ring
      _ ≤ x ^ (1 - (9519 : ℝ) / 50000) * x ^ ((9519 : ℝ) / 50000) :=
        mul_le_mul_of_nonneg_left hsmall (Real.rpow_nonneg hx0.le _)
      _ = x := by rw [← Real.rpow_add hx0]; norm_num
  have hmass' : m ≤
      17 * 64 * (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
        (C0 ^ 16 * l ^ 16) :=
    hmass.trans (mul_le_mul_of_nonneg_left hlog64pow (by positivity))
  calc
    2 * m * z ≤ 2 *
        (17 * 64 * (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
          (C0 ^ 16 * l ^ 16)) * (4 * l ^ 2) :=
      mul_le_mul (mul_le_mul_of_nonneg_left hmass' (by norm_num)) hzbound hz
        (mul_nonneg (by norm_num) (hm.trans hmass'))
    _ = (8 * (17 * 64) * C0 ^ 16) *
        (1023 * x * (h * l ^ 18) + x ^ (1 - (9519 : ℝ) / 50000) * l ^ 18) := by ring
    _ ≤ (8 * (17 * 64) * C0 ^ 16) *
        (1023 * x * (1 / l ^ A) + x / l ^ A) :=
      mul_le_mul_of_nonneg_left
        (add_le_add (mul_le_mul_of_nonneg_left hmeshdecay (by positivity)) hpowerdecay)
        (by positivity)
    _ = _ := by dsimp only [C0, l]; ring

theorem sum_pair_list_divisorsAntidiagonal
    {A : Type*} [AddCommMonoid A]
    (F : Finset (List ℕ))
    (hshape : ∀ ps ∈ F, ∃ p q : ℕ, ps = [p, q])
    (w : List ℕ → ℕ → A) (n : ℕ) :
    (∑ ps ∈ F, ∑ d ∈ n.divisorsAntidiagonal,
      if d.1 = ps.prod then w ps d.2 else 0) =
      ∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
        if [a.1, b.1] ∈ F then w [a.1, b.1] b.2 else 0 := by
  classical
  let S : Finset (List ℕ × (ℕ × ℕ)) :=
    ((F).product n.divisorsAntidiagonal).filter
      (fun u => u.2.1 = u.1.prod)
  let T : Finset (Σ _ : ℕ × ℕ, ℕ × ℕ) :=
    (n.divisorsAntidiagonal.sigma (fun a => a.2.divisorsAntidiagonal)).filter
      (fun v => [v.1.1, v.2.1] ∈ F)
  let f : (Σ _ : ℕ × ℕ, ℕ × ℕ) → List ℕ × (ℕ × ℕ) := fun v =>
    ([v.1.1, v.2.1], (v.1.1 * v.2.1, v.2.2))
  calc
    _ = ∑ u ∈ S, w u.1 u.2.2 := by
      simpa only [S, Finset.sum_filter, Finset.product_eq_sprod] using
        (Finset.sum_product (F) n.divisorsAntidiagonal
          (fun u : List ℕ × (ℕ × ℕ) =>
            if u.2.1 = u.1.prod then w u.1 u.2.2 else 0)).symm
    _ = ∑ v ∈ T, w [v.1.1, v.2.1] v.2.2 := by
      symm
      refine Finset.sum_bij (fun v _ => f v) ?_ ?_ ?_ (fun _ _ => rfl)
      · intro v hv
        obtain ⟨hvS, hvP⟩ := Finset.mem_filter.mp hv
        obtain ⟨ha, hb⟩ := Finset.mem_sigma.mp hvS
        have hprod : (v.1.1 * v.2.1) * v.2.2 = n := by
          rw [Nat.mul_assoc, (Nat.mem_divisorsAntidiagonal.mp hb).1,
            (Nat.mem_divisorsAntidiagonal.mp ha).1]
        apply Finset.mem_filter.mpr
        refine ⟨Finset.mem_product.mpr ⟨hvP, ?_⟩, ?_⟩
        · exact Nat.mem_divisorsAntidiagonal.mpr
            ⟨hprod, (Nat.mem_divisorsAntidiagonal.mp ha).2⟩
        · simp only [f, List.prod_cons, List.prod_nil, mul_one]
      · intro v hv w hw heq
        have hlist : [v.1.1, v.2.1] = [w.1.1, w.2.1] := congrArg Prod.fst heq
        simp only [List.cons.injEq, and_true] at hlist
        have hlast : v.2.2 = w.2.2 :=
          congrArg (fun u : List ℕ × (ℕ × ℕ) => u.2.2) heq
        have hvb : v.2 ∈ v.1.2.divisorsAntidiagonal :=
          (Finset.mem_sigma.mp (Finset.mem_filter.mp hv).1).2
        have hwb : w.2 ∈ w.1.2.divisorsAntidiagonal :=
          (Finset.mem_sigma.mp (Finset.mem_filter.mp hw).1).2
        have htail : v.1.2 = w.1.2 := by
          rw [← (Nat.mem_divisorsAntidiagonal.mp hvb).1,
            ← (Nat.mem_divisorsAntidiagonal.mp hwb).1, hlist.2, hlast]
        exact Sigma.ext (Prod.ext hlist.1 htail) (heq_of_eq (Prod.ext hlist.2 hlast))
      · intro u hu
        obtain ⟨huS, hproduct⟩ := Finset.mem_filter.mp hu
        obtain ⟨hps, hd⟩ := Finset.mem_product.mp huS
        obtain ⟨p, q, hpshape⟩ := hshape u.1 hps
        have hprod : u.2.1 = p * q := by
          simpa only [hpshape, List.prod_cons, List.prod_nil, mul_one] using hproduct
        have htotal : (p * q) * u.2.2 = n := by
          simpa only [hprod] using (Nat.mem_divisorsAntidiagonal.mp hd).1
        have hn : n ≠ 0 := (Nat.mem_divisorsAntidiagonal.mp hd).2
        have hqh : q * u.2.2 ≠ 0 := by
          intro hzero
          apply hn
          rw [← htotal, Nat.mul_assoc, hzero, Nat.mul_zero]
        let v : Σ _ : ℕ × ℕ, ℕ × ℕ := ⟨(p, q * u.2.2), (q, u.2.2)⟩
        have hv : v ∈ T := by
          apply Finset.mem_filter.mpr
          refine ⟨Finset.mem_sigma.mpr ⟨?_, ?_⟩, ?_⟩
          · exact Nat.mem_divisorsAntidiagonal.mpr
              ⟨by simpa only [Nat.mul_assoc] using htotal, hn⟩
          · exact Nat.mem_divisorsAntidiagonal.mpr ⟨rfl, hqh⟩
          · simpa only [v, hpshape] using hps
        refine ⟨v, hv, ?_⟩
        exact Prod.ext hpshape.symm (Prod.ext hprod.symm rfl)
    _ = _ := by
      simp only [T, Finset.sum_filter, Finset.sum_sigma]

theorem sum_triple_list_divisorsAntidiagonal
    {A : Type*} [AddCommMonoid A]
    (F : Finset (List ℕ))
    (hshape : ∀ ps ∈ F, ∃ p q r : ℕ, ps = [p, q, r])
    (w : List ℕ → ℕ → A) (n : ℕ) :
    (∑ ps ∈ F, ∑ d ∈ n.divisorsAntidiagonal,
      if d.1 = ps.prod then w ps d.2 else 0) =
      ∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
        ∑ c ∈ b.2.divisorsAntidiagonal,
          if [a.1, b.1, c.1] ∈ F then w [a.1, b.1, c.1] c.2 else 0 := by
  classical
  let S : Finset (List ℕ × (ℕ × ℕ)) :=
    ((F).product n.divisorsAntidiagonal).filter
      (fun u => u.2.1 = u.1.prod)
  let T : Finset (Σ _ : ℕ × ℕ, Σ _ : ℕ × ℕ, ℕ × ℕ) :=
    (n.divisorsAntidiagonal.sigma (fun a =>
      a.2.divisorsAntidiagonal.sigma (fun b => b.2.divisorsAntidiagonal))).filter
      (fun v => [v.1.1, v.2.1.1, v.2.2.1] ∈ F)
  let f : (Σ _ : ℕ × ℕ, Σ _ : ℕ × ℕ, ℕ × ℕ) → List ℕ × (ℕ × ℕ) := fun v =>
    ([v.1.1, v.2.1.1, v.2.2.1], (v.1.1 * v.2.1.1 * v.2.2.1, v.2.2.2))
  calc
    _ = ∑ u ∈ S, w u.1 u.2.2 := by
      simpa only [S, Finset.sum_filter, Finset.product_eq_sprod] using
        (Finset.sum_product (F) n.divisorsAntidiagonal
          (fun u : List ℕ × (ℕ × ℕ) =>
            if u.2.1 = u.1.prod then w u.1 u.2.2 else 0)).symm
    _ = ∑ v ∈ T, w [v.1.1, v.2.1.1, v.2.2.1] v.2.2.2 := by
      symm
      refine Finset.sum_bij (fun v _ => f v) ?_ ?_ ?_ (fun _ _ => rfl)
      · intro v hv
        obtain ⟨hvS, hvP⟩ := Finset.mem_filter.mp hv
        obtain ⟨ha, hbc⟩ := Finset.mem_sigma.mp hvS
        obtain ⟨hb, hc⟩ := Finset.mem_sigma.mp hbc
        have hprod : (v.1.1 * v.2.1.1 * v.2.2.1) * v.2.2.2 = n := by
          simp only [Nat.mul_assoc, (Nat.mem_divisorsAntidiagonal.mp hc).1,
            (Nat.mem_divisorsAntidiagonal.mp hb).1,
            (Nat.mem_divisorsAntidiagonal.mp ha).1]
        apply Finset.mem_filter.mpr
        refine ⟨Finset.mem_product.mpr ⟨hvP, ?_⟩, ?_⟩
        · exact Nat.mem_divisorsAntidiagonal.mpr
            ⟨hprod, (Nat.mem_divisorsAntidiagonal.mp ha).2⟩
        · simp only [f, List.prod_cons, List.prod_nil, mul_one, Nat.mul_assoc]
      · intro v hv w hw heq
        have hlist : [v.1.1, v.2.1.1, v.2.2.1] = [w.1.1, w.2.1.1, w.2.2.1] :=
          congrArg Prod.fst heq
        simp only [List.cons.injEq, and_true] at hlist
        have hlast : v.2.2.2 = w.2.2.2 :=
          congrArg (fun u : List ℕ × (ℕ × ℕ) => u.2.2) heq
        obtain ⟨_hva, hvtail⟩ := Finset.mem_sigma.mp (Finset.mem_filter.mp hv).1
        obtain ⟨hvb, hvc⟩ := Finset.mem_sigma.mp hvtail
        obtain ⟨_hwa, hwtail⟩ := Finset.mem_sigma.mp (Finset.mem_filter.mp hw).1
        obtain ⟨hwb, hwc⟩ := Finset.mem_sigma.mp hwtail
        have hbtail : v.2.1.2 = w.2.1.2 := by
          rw [← (Nat.mem_divisorsAntidiagonal.mp hvc).1,
            ← (Nat.mem_divisorsAntidiagonal.mp hwc).1, hlist.2.2, hlast]
        have hatail : v.1.2 = w.1.2 := by
          rw [← (Nat.mem_divisorsAntidiagonal.mp hvb).1,
            ← (Nat.mem_divisorsAntidiagonal.mp hwb).1, hlist.2.1, hbtail]
        exact Sigma.ext (Prod.ext hlist.1 hatail)
          (heq_of_eq (Sigma.ext (Prod.ext hlist.2.1 hbtail)
            (heq_of_eq (Prod.ext hlist.2.2 hlast))))
      · intro u hu
        obtain ⟨huS, hproduct⟩ := Finset.mem_filter.mp hu
        obtain ⟨hps, hd⟩ := Finset.mem_product.mp huS
        obtain ⟨p, q, r, hpshape⟩ := hshape u.1 hps
        have hprod : u.2.1 = p * q * r := by
          simpa only [hpshape, List.prod_cons, List.prod_nil, mul_one, Nat.mul_assoc]
            using hproduct
        have htotal : (p * q * r) * u.2.2 = n := by
          simpa only [hprod] using (Nat.mem_divisorsAntidiagonal.mp hd).1
        have htotal' : p * (q * (r * u.2.2)) = n := by
          simpa only [Nat.mul_assoc] using htotal
        have hn : n ≠ 0 := (Nat.mem_divisorsAntidiagonal.mp hd).2
        have hqrh : q * (r * u.2.2) ≠ 0 := by
          intro hzero
          apply hn
          rw [← htotal', hzero, Nat.mul_zero]
        have hrh : r * u.2.2 ≠ 0 := by
          intro hzero
          apply hqrh
          rw [hzero, Nat.mul_zero]
        let v : Σ _ : ℕ × ℕ, Σ _ : ℕ × ℕ, ℕ × ℕ :=
          ⟨(p, q * (r * u.2.2)), ⟨(q, r * u.2.2), (r, u.2.2)⟩⟩
        have hv : v ∈ T := by
          apply Finset.mem_filter.mpr
          refine ⟨Finset.mem_sigma.mpr ⟨?_, Finset.mem_sigma.mpr ⟨?_, ?_⟩⟩, ?_⟩
          · exact Nat.mem_divisorsAntidiagonal.mpr ⟨htotal', hn⟩
          · exact Nat.mem_divisorsAntidiagonal.mpr ⟨rfl, hqrh⟩
          · exact Nat.mem_divisorsAntidiagonal.mpr ⟨rfl, hrh⟩
          · simpa only [v, hpshape] using hps
        refine ⟨v, hv, ?_⟩
        exact Prod.ext hpshape.symm (Prod.ext hprod.symm rfl)
    _ = _ := by
      simp only [T, Finset.sum_filter, Finset.sum_sigma]

/-!
## Prime-factor decompositions and minorant distribution

Assemble the Buchstab pieces and establish the distribution estimates needed for the prime
minorant.
-/

/--
The Buchstab contribution from factorizations `n = p * r` with prime `p` in `[x^(40481 /
100000), sqrt (3 * x))`, weighted by the `p`-roughness of `r`.
-/
noncomputable def sourceLargeFirst (x : ℝ) : ArithmeticFunction ℝ := by
  classical
  exact ⟨fun n => ∑ d ∈ n.divisorsAntidiagonal,
    if d.1.Prime ∧ x ^ ((40481 : ℝ) / 100000) ≤ (d.1 : ℝ) ∧
        (d.1 : ℝ) < Real.sqrt (3 * x)
    then roughWeight (d.1 : ℝ) d.2 else 0, by simp⟩

/--
The contribution of two prime factors with ordered exponents between `9519 / 50000` and `40481 /
100000`, whose exponent sum lies in the closed central interval `[40481 / 100000, 59519 /
100000]`. The remaining cofactor is weighted by roughness at the smaller prime.
-/
noncomputable def sourceCentralPair (x : ℝ) : ArithmeticFunction ℝ := by
  classical
  let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
  exact ⟨fun n => ∑ d ∈ n.divisorsAntidiagonal, ∑ e ∈ d.2.divisorsAntidiagonal,
    if d.1.Prime ∧ e.1.Prime ∧ (9519 : ℝ) / 50000 ≤ α e.1 ∧
        α e.1 < α d.1 ∧ α d.1 < (40481 : ℝ) / 100000 ∧
        (40481 : ℝ) / 100000 ≤ α d.1 + α e.1 ∧
        α d.1 + α e.1 ≤ (59519 : ℝ) / 100000
    then roughWeight (e.1 : ℝ) e.2 else 0, by simp⟩

/--
The two-prime Buchstab contribution above the central exponent-sum interval, with the smaller
prime exponent at least `1 - 1058 / 3125 - 40481 / 100000`. The cofactor is weighted by
roughness at that smaller prime.
-/
noncomputable def sourceT3 (x : ℝ) : ArithmeticFunction ℝ := by
  classical
  let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
  exact ⟨fun n => ∑ d ∈ n.divisorsAntidiagonal, ∑ e ∈ d.2.divisorsAntidiagonal,
    if d.1.Prime ∧ e.1.Prime ∧ (9519 : ℝ) / 50000 ≤ α e.1 ∧
        α e.1 < α d.1 ∧ α d.1 < (40481 : ℝ) / 100000 ∧
        (59519 : ℝ) / 100000 < α d.1 + α e.1 ∧
        1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000 ≤ α e.1
    then roughWeight (e.1 : ℝ) e.2 else 0, by simp⟩

/--
The three-prime Buchstab contribution with strictly decreasing prime exponents, first-two
exponent sum greater than `59519 / 100000`, and second exponent below `1 - 1058 / 3125 - 40481 /
100000`. The cofactor is weighted by roughness at the third prime.
-/
noncomputable def sourceT4 (x : ℝ) : ArithmeticFunction ℝ := by
  classical
  let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
  exact ⟨fun n => ∑ d ∈ n.divisorsAntidiagonal, ∑ e ∈ d.2.divisorsAntidiagonal,
    ∑ f ∈ e.2.divisorsAntidiagonal,
      if d.1.Prime ∧ e.1.Prime ∧ f.1.Prime ∧
          (9519 : ℝ) / 50000 ≤ α f.1 ∧ α f.1 < α e.1 ∧ α e.1 < α d.1 ∧
          α d.1 < (40481 : ℝ) / 100000 ∧
          (59519 : ℝ) / 100000 < α d.1 + α e.1 ∧
          α e.1 < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000
      then roughWeight (f.1 : ℝ) f.2 else 0, by simp⟩

/--
The four-prime Buchstab contribution with strictly decreasing prime exponents at least `9519 /
50000` and first-two exponent sum below `40481 / 100000`. The cofactor is weighted by roughness
at the fourth prime.
-/
noncomputable def sourceT5 (x : ℝ) : ArithmeticFunction ℝ := by
  classical
  let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
  exact ⟨fun n => ∑ d ∈ n.divisorsAntidiagonal, ∑ e ∈ d.2.divisorsAntidiagonal,
    ∑ f ∈ e.2.divisorsAntidiagonal, ∑ g ∈ f.2.divisorsAntidiagonal,
      if d.1.Prime ∧ e.1.Prime ∧ f.1.Prime ∧ g.1.Prime ∧
          (9519 : ℝ) / 50000 ≤ α g.1 ∧ α g.1 < α f.1 ∧ α f.1 < α e.1 ∧
          α e.1 < α d.1 ∧ α d.1 < (40481 : ℝ) / 100000 ∧
          α d.1 + α e.1 < (40481 : ℝ) / 100000
      then roughWeight (g.1 : ℝ) g.2 else 0, by simp⟩

/--
The contribution of two prime factors with strictly ordered exponents in the interval from `9519
/ 50000` to `40481 / 100000`, with a cofactor rough at the smaller prime. No restriction on the
sum of the two exponents is imposed.
-/
noncomputable def sourceOrderedPair (x : ℝ) : ArithmeticFunction ℝ := by
  classical
  let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
  exact ⟨fun n => ∑ d ∈ n.divisorsAntidiagonal, ∑ e ∈ d.2.divisorsAntidiagonal,
    if d.1.Prime ∧ e.1.Prime ∧ (9519 : ℝ) / 50000 ≤ α e.1 ∧
        α e.1 < α d.1 ∧ α d.1 < (40481 : ℝ) / 100000
    then roughWeight (e.1 : ℝ) e.2 else 0, by simp⟩

/--
The contribution from sifted two-prime region `2` when `e = 0`, and region `3` otherwise, with
the remaining cofactor weighted by roughness at the second prime.
-/
noncomputable def sourceRoughPair (x : ℝ) (e : Fin 2) : ArithmeticFunction ℝ := by
  classical
  let j : Fin 6 := if e = 0 then 2 else 3
  exact ⟨fun n => ∑ d ∈ n.divisorsAntidiagonal, ∑ f ∈ d.2.divisorsAntidiagonal,
    if [d.1, f.1] ∈ siftedPrimeTuples x j
    then roughWeight (f.1 : ℝ) f.2 else 0, by simp⟩

/--
The contribution from sifted three-prime region `4`, with the remaining cofactor weighted by
roughness at the third prime.
-/
noncomputable def sourceRoughTriple (x : ℝ) : ArithmeticFunction ℝ := by
  classical
  exact ⟨fun n => ∑ d ∈ n.divisorsAntidiagonal, ∑ e ∈ d.2.divisorsAntidiagonal,
    ∑ f ∈ e.2.divisorsAntidiagonal,
      if [d.1, e.1, f.1] ∈ siftedPrimeTuples x (4 : Fin 6)
      then roughWeight (f.1 : ℝ) f.2 else 0, by simp⟩

theorem sum_prime_divisorsAntidiagonal
    {A : Type*} [AddCommMonoid A] (n : ℕ) (P : ℕ → Prop) [DecidablePred P]
    (w : ℕ → ℕ → A) :
    (∑ d ∈ n.divisorsAntidiagonal, if d.1.Prime ∧ P d.1 then w d.1 d.2 else 0) =
      ∑ p ∈ (Nat.primesLE n).filter (fun p => P p ∧ p ∣ n), w p (n / p) := by
  classical
  by_cases hn : n = 0
  · subst n
    simp
  rw [Nat.sum_divisorsAntidiagonal (fun p r => if p.Prime ∧ P p then w p r else 0)]
  have hcarrier : n.divisors.filter (fun p => p.Prime ∧ P p) =
      (Nat.primesLE n).filter (fun p => P p ∧ p ∣ n) := by
    ext p
    simp only [Finset.mem_filter, Nat.mem_divisors, Nat.mem_primesLE]
    constructor
    · rintro ⟨⟨hpn, _⟩, hp, hP⟩
      exact ⟨⟨Nat.le_of_dvd (Nat.pos_of_ne_zero hn) hpn, hp⟩, hP, hpn⟩
    · rintro ⟨⟨_, hp⟩, hP, hpn⟩
      exact ⟨⟨hpn, hn⟩, hp, hP⟩
  rw [← Finset.sum_filter, hcarrier]

theorem roughWeight_buchstab_antidiagonal {z Z : ℝ} (hzZ : z ≤ Z) (n : ℕ) :
    roughWeight Z n = roughWeight z n -
      ∑ d ∈ n.divisorsAntidiagonal,
        if d.1.Prime ∧ z ≤ (d.1 : ℝ) ∧ (d.1 : ℝ) < Z
        then roughWeight (d.1 : ℝ) d.2 else 0 := by
  rw [sum_prime_divisorsAntidiagonal n (fun p => z ≤ (p : ℝ) ∧ (p : ℝ) < Z)
    (fun p r => roughWeight (p : ℝ) r)]
  simpa only [and_assoc] using roughWeight_buchstab hzZ n

theorem siftedTheta_pair_antidiagonal (x : ℝ) (hx : 1 < x) (e : Fin 2) (n : ℕ) :
    let j : Fin 6 := if e = 0 then 2 else 3
    siftedTheta x j (fun _ => 1) n =
      ∑ d ∈ n.divisorsAntidiagonal, ∑ f ∈ d.2.divisorsAntidiagonal,
        if [d.1, f.1] ∈ siftedPrimeTuples x j
        then roughWeight (x ^ ((9519 : ℝ) / 50000)) f.2 else 0 := by
  classical
  intro j
  have hshape (ps : List ℕ) (hps : ps ∈ siftedPrimeTuples x j) :
      ∃ p q : ℕ, ps = [p, q] := by
    have hmem := (mem_siftedPrimeTuples_iff x hx j ps).mp hps
    by_cases he : e = 0 <;>
      rcases ps with _ | ⟨p, _ | ⟨q, _ | ⟨r, rs⟩⟩⟩ <;>
      simp [j, he] at hmem ⊢
  simpa only [siftedTheta, ArithmeticFunction.coe_mk, one_mul] using
    sum_pair_list_divisorsAntidiagonal (siftedPrimeTuples x j) hshape
      (fun _ r => roughWeight (x ^ ((9519 : ℝ) / 50000)) r) n

theorem siftedTheta_triple_antidiagonal (x : ℝ) (hx : 1 < x) (e : Fin 2) (n : ℕ) :
    let j : Fin 6 := if e = 0 then 4 else 5
    siftedTheta x j (fun _ => 1) n =
      ∑ d ∈ n.divisorsAntidiagonal, ∑ f ∈ d.2.divisorsAntidiagonal,
        ∑ g ∈ f.2.divisorsAntidiagonal,
          if [d.1, f.1, g.1] ∈ siftedPrimeTuples x j
          then roughWeight (x ^ ((9519 : ℝ) / 50000)) g.2 else 0 := by
  classical
  intro j
  have hshape (ps : List ℕ) (hps : ps ∈ siftedPrimeTuples x j) :
      ∃ p q r : ℕ, ps = [p, q, r] := by
    have hmem := (mem_siftedPrimeTuples_iff x hx j ps).mp hps
    by_cases he : e = 0 <;>
      rcases ps with _ | ⟨p, _ | ⟨q, _ | ⟨r, _ | ⟨s, ss⟩⟩⟩⟩ <;>
      simp [j, he] at hmem ⊢
  simpa only [siftedTheta, ArithmeticFunction.coe_mk, one_mul] using
    sum_triple_list_divisorsAntidiagonal (siftedPrimeTuples x j) hshape
      (fun _ r => roughWeight (x ^ ((9519 : ℝ) / 50000)) r) n

theorem roughWeight_buchstab_indicator (P : Prop) [Decidable P] (z : ℝ) (p n : ℕ)
    (hP : P → z ≤ (p : ℝ)) :
    (if P then roughWeight (p : ℝ) n else 0) =
      (if P then roughWeight z n else 0) -
        ∑ d ∈ n.divisorsAntidiagonal,
          if P ∧ d.1.Prime ∧ z ≤ (d.1 : ℝ) ∧ (d.1 : ℝ) < (p : ℝ)
          then roughWeight (d.1 : ℝ) d.2 else 0 := by
  classical
  by_cases h : P
  · simpa only [h, ite_true, true_and] using
      roughWeight_buchstab_antidiagonal (hP h) n
  · simp only [h, ite_false, false_and, Finset.sum_const_zero, sub_zero]

theorem prime_logb_buchstab_band (x : ℝ) (hx : 1 < x) (p q : ℕ)
    (hp : p.Prime) (hq : q.Prime) :
    (x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ) ∧ (p : ℝ) < (q : ℝ)) ↔
      (9519 : ℝ) / 50000 ≤ Real.logb x (p : ℝ) ∧
        Real.logb x (p : ℝ) < Real.logb x (q : ℝ) := by
  rw [Real.le_logb_iff_rpow_le hx (Nat.cast_pos.mpr hp.pos),
    Real.logb_lt_logb_iff hx (Nat.cast_pos.mpr hp.pos) (Nat.cast_pos.mpr hq.pos)]

theorem sourceRoughPair_zero_buchstab (x : ℝ) (hx : 1 < x) (n : ℕ) :
    sourceRoughPair x 0 n = siftedTheta x 2 (fun _ => 1) n - sourceRoughTriple x n := by
  classical
  let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
  let z : ℝ := x ^ ((9519 : ℝ) / 50000)
  have hpair (p q : ℕ) : [p, q] ∈ siftedPrimeTuples x (2 : Fin 6) ↔
      p.Prime ∧ q.Prime ∧ (9519 : ℝ) / 50000 ≤ α q ∧ α q < α p ∧
        α p < (40481 : ℝ) / 100000 ∧ α p + α q < (40481 : ℝ) / 100000 := by
    simpa [α] using mem_siftedPrimeTuples_iff x hx (2 : Fin 6) [p, q]
  have htriple (p q r : ℕ) : [p, q, r] ∈ siftedPrimeTuples x (4 : Fin 6) ↔
      p.Prime ∧ q.Prime ∧ r.Prime ∧ (9519 : ℝ) / 50000 ≤ α r ∧ α r < α q ∧
        α q < α p ∧ α p < (40481 : ℝ) / 100000 ∧
        α p + α q < (40481 : ℝ) / 100000 ∧
        α r < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000 := by
    simpa [α] using mem_siftedPrimeTuples_iff x hx (4 : Fin 6) [p, q, r]
  have hcut (p q r : ℕ) :
      ([p, q] ∈ siftedPrimeTuples x (2 : Fin 6) ∧ r.Prime ∧
        z ≤ (r : ℝ) ∧ (r : ℝ) < (q : ℝ)) ↔
      [p, q, r] ∈ siftedPrimeTuples x (4 : Fin 6) := by
    rw [hpair, htriple]
    constructor
    · rintro ⟨⟨hp, hq, hqlo, hqp, hphi, hpq⟩, hr, hrlo, hrq⟩
      obtain ⟨hrlog, hrqlog⟩ := (prime_logb_buchstab_band x hx r q hr hq).mp
        ⟨hrlo, hrq⟩
      exact ⟨hp, hq, hr, hrlog, hrqlog, hqp, hphi, hpq, by dsimp [α] at *; linarith⟩
    · rintro ⟨hp, hq, hr, hrlo, hrq, hqp, hphi, hpq, _⟩
      obtain ⟨hrreal, hrqreal⟩ := (prime_logb_buchstab_band x hx r q hr hq).mpr
        ⟨hrlo, hrq⟩
      exact ⟨⟨hp, hq, hrlo.trans hrq.le, hqp, hphi, hpq⟩, hr, hrreal, hrqreal⟩
  have hstep (p q r : ℕ) := roughWeight_buchstab_indicator
    ([p, q] ∈ siftedPrimeTuples x (2 : Fin 6)) z q r (by
      intro h
      have hm := (hpair p q).mp h
      exact (Real.le_logb_iff_rpow_le hx (Nat.cast_pos.mpr hm.2.1.pos)).mp hm.2.2.1)
  have hθ : siftedTheta x (2 : Fin 6) (fun _ => 1) n =
      ∑ d ∈ n.divisorsAntidiagonal, ∑ e ∈ d.2.divisorsAntidiagonal,
        if [d.1, e.1] ∈ siftedPrimeTuples x (2 : Fin 6) then roughWeight z e.2 else 0 := by
    simpa only [ite_true] using siftedTheta_pair_antidiagonal x hx (0 : Fin 2) n
  rw [hθ]
  simp only [sourceRoughPair, sourceRoughTriple, ArithmeticFunction.coe_mk, ite_true]
  simp_rw [hstep, hcut, Finset.sum_sub_distrib]

theorem sourceRoughPair_one_buchstab (x : ℝ) (hx : 1 < x) (n : ℕ) :
    sourceRoughPair x 1 n = siftedTheta x 3 (fun _ => 1) n - sourceT4 x n := by
  classical
  let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
  let z : ℝ := x ^ ((9519 : ℝ) / 50000)
  have hpair (p q : ℕ) : [p, q] ∈ siftedPrimeTuples x (3 : Fin 6) ↔
      p.Prime ∧ q.Prime ∧ (9519 : ℝ) / 50000 ≤ α q ∧ α q < α p ∧
        α p < (40481 : ℝ) / 100000 ∧ (59519 : ℝ) / 100000 < α p + α q ∧
        α q < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000 := by
    simpa [α] using mem_siftedPrimeTuples_iff x hx (3 : Fin 6) [p, q]
  have hcut (p q r : ℕ) :
      ([p, q] ∈ siftedPrimeTuples x (3 : Fin 6) ∧ r.Prime ∧
        z ≤ (r : ℝ) ∧ (r : ℝ) < (q : ℝ)) ↔
      p.Prime ∧ q.Prime ∧ r.Prime ∧ (9519 : ℝ) / 50000 ≤ α r ∧ α r < α q ∧
        α q < α p ∧ α p < (40481 : ℝ) / 100000 ∧
        (59519 : ℝ) / 100000 < α p + α q ∧
        α q < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000 := by
    rw [hpair]
    constructor
    · rintro ⟨⟨hp, hq, _, hqp, hphi, hpq, hqhi⟩, hr, hrlo, hrq⟩
      obtain ⟨hrlog, hrqlog⟩ := (prime_logb_buchstab_band x hx r q hr hq).mp
        ⟨hrlo, hrq⟩
      exact ⟨hp, hq, hr, hrlog, hrqlog, hqp, hphi, hpq, hqhi⟩
    · rintro ⟨hp, hq, hr, hrlo, hrq, hqp, hphi, hpq, hqhi⟩
      obtain ⟨hrreal, hrqreal⟩ := (prime_logb_buchstab_band x hx r q hr hq).mpr
        ⟨hrlo, hrq⟩
      exact ⟨⟨hp, hq, hrlo.trans hrq.le, hqp, hphi, hpq, hqhi⟩, hr, hrreal, hrqreal⟩
  have hstep (p q r : ℕ) := roughWeight_buchstab_indicator
    ([p, q] ∈ siftedPrimeTuples x (3 : Fin 6)) z q r (by
      intro h
      have hm := (hpair p q).mp h
      exact (Real.le_logb_iff_rpow_le hx (Nat.cast_pos.mpr hm.2.1.pos)).mp hm.2.2.1)
  have hθ : siftedTheta x (3 : Fin 6) (fun _ => 1) n =
      ∑ d ∈ n.divisorsAntidiagonal, ∑ e ∈ d.2.divisorsAntidiagonal,
        if [d.1, e.1] ∈ siftedPrimeTuples x (3 : Fin 6) then roughWeight z e.2 else 0 := by
    simpa only [show (1 : Fin 2) ≠ 0 by decide, ite_false] using
      siftedTheta_pair_antidiagonal x hx (1 : Fin 2) n
  rw [hθ]
  simp only [sourceRoughPair, sourceT4, ArithmeticFunction.coe_mk,
    show (1 : Fin 2) ≠ 0 by decide, ite_false]
  simp_rw [hstep, hcut, Finset.sum_sub_distrib]
  rfl

theorem sourceRoughTriple_buchstab (x : ℝ) (hx : 1 < x) (n : ℕ) :
    sourceRoughTriple x n = siftedTheta x 4 (fun _ => 1) n - sourceT5 x n := by
  classical
  let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
  let z : ℝ := x ^ ((9519 : ℝ) / 50000)
  have htriple (p q r : ℕ) : [p, q, r] ∈ siftedPrimeTuples x (4 : Fin 6) ↔
      p.Prime ∧ q.Prime ∧ r.Prime ∧ (9519 : ℝ) / 50000 ≤ α r ∧ α r < α q ∧
        α q < α p ∧ α p < (40481 : ℝ) / 100000 ∧
        α p + α q < (40481 : ℝ) / 100000 ∧
        α r < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000 := by
    simpa [α] using mem_siftedPrimeTuples_iff x hx (4 : Fin 6) [p, q, r]
  have hcut (p q r s : ℕ) :
      ([p, q, r] ∈ siftedPrimeTuples x (4 : Fin 6) ∧ s.Prime ∧
        z ≤ (s : ℝ) ∧ (s : ℝ) < (r : ℝ)) ↔
      p.Prime ∧ q.Prime ∧ r.Prime ∧ s.Prime ∧
        (9519 : ℝ) / 50000 ≤ α s ∧ α s < α r ∧ α r < α q ∧ α q < α p ∧
        α p < (40481 : ℝ) / 100000 ∧ α p + α q < (40481 : ℝ) / 100000 := by
    rw [htriple]
    constructor
    · rintro ⟨⟨hp, hq, hr, _, hrq, hqp, hphi, hpq, _⟩, hs, hslo, hsr⟩
      obtain ⟨hslog, hsrlog⟩ := (prime_logb_buchstab_band x hx s r hs hr).mp
        ⟨hslo, hsr⟩
      exact ⟨hp, hq, hr, hs, hslog, hsrlog, hrq, hqp, hphi, hpq⟩
    · rintro ⟨hp, hq, hr, hs, hslo, hsr, hrq, hqp, hphi, hpq⟩
      obtain ⟨hsreal, hsrreal⟩ := (prime_logb_buchstab_band x hx s r hs hr).mpr
        ⟨hslo, hsr⟩
      exact ⟨⟨hp, hq, hr, hslo.trans hsr.le, hrq, hqp, hphi, hpq,
        by dsimp [α] at *; linarith⟩, hs, hsreal, hsrreal⟩
  have hstep (p q r s : ℕ) := roughWeight_buchstab_indicator
    ([p, q, r] ∈ siftedPrimeTuples x (4 : Fin 6)) z r s (by
      intro h
      have hm := (htriple p q r).mp h
      exact (Real.le_logb_iff_rpow_le hx (Nat.cast_pos.mpr hm.2.2.1.pos)).mp hm.2.2.2.1)
  have hθ : siftedTheta x (4 : Fin 6) (fun _ => 1) n =
      ∑ d ∈ n.divisorsAntidiagonal, ∑ e ∈ d.2.divisorsAntidiagonal,
        ∑ f ∈ e.2.divisorsAntidiagonal,
          if [d.1, e.1, f.1] ∈ siftedPrimeTuples x (4 : Fin 6)
          then roughWeight z f.2 else 0 := by
    simpa only [ite_true] using siftedTheta_triple_antidiagonal x hx (0 : Fin 2) n
  rw [hθ]
  simp only [sourceRoughTriple, sourceT5, ArithmeticFunction.coe_mk]
  simp_rw [hstep, hcut, Finset.sum_sub_distrib]
  rfl

theorem pair_cut_partition (P : Prop) [Decidable P]
    (a b ζ s t v : ℝ) (hab : a ≤ b) :
    (if P then v else 0) =
      (if P ∧ s < a then v else 0) +
      (if P ∧ b < s ∧ t < ζ then v else 0) +
      (if P ∧ a ≤ s ∧ s ≤ b then v else 0) +
      (if P ∧ b < s ∧ ζ ≤ t then v else 0) := by
  classical
  by_cases hP : P
  · by_cases hlo : s < a
    · have hnb : ¬ b < s := by linarith
      simp only [hP, true_and, hlo, not_le.mpr hlo, hnb, false_and,
        ite_true, ite_false, add_zero]
    · have hla : a ≤ s := le_of_not_gt hlo
      by_cases hhi : s ≤ b
      · simp only [hP, true_and, hlo, hla, hhi, not_lt.mpr hhi, false_and,
          true_and, ite_true, ite_false, zero_add, add_zero]
      · have hbs : b < s := lt_of_not_ge hhi
        by_cases ht : t < ζ
        · simp only [hP, true_and, hlo, hla, hhi, hbs, ht, not_le.mpr ht,
            true_and, ite_true, ite_false, zero_add, add_zero]
        · simp only [hP, true_and, hlo, hla, hhi, hbs, ht, le_of_not_gt ht,
            true_and, ite_true, ite_false, zero_add, add_zero]
  · simp only [hP, false_and, ite_false, add_zero]

theorem sourceOrderedPair_partition (x : ℝ) (hx : 1 < x) (n : ℕ) :
    sourceOrderedPair x n = sourceRoughPair x 0 n + sourceRoughPair x 1 n +
      sourceCentralPair x n + sourceT3 x n := by
  classical
  let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
  have hpair0 (p q : ℕ) : [p, q] ∈ siftedPrimeTuples x (2 : Fin 6) ↔
      p.Prime ∧ q.Prime ∧ (9519 : ℝ) / 50000 ≤ α q ∧ α q < α p ∧
        α p < (40481 : ℝ) / 100000 ∧ α p + α q < (40481 : ℝ) / 100000 := by
    simpa [α] using mem_siftedPrimeTuples_iff x hx (2 : Fin 6) [p, q]
  have hpair1 (p q : ℕ) : [p, q] ∈ siftedPrimeTuples x (3 : Fin 6) ↔
      p.Prime ∧ q.Prime ∧ (9519 : ℝ) / 50000 ≤ α q ∧ α q < α p ∧
        α p < (40481 : ℝ) / 100000 ∧ (59519 : ℝ) / 100000 < α p + α q ∧
        α q < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000 := by
    simpa [α] using mem_siftedPrimeTuples_iff x hx (3 : Fin 6) [p, q]
  simp only [sourceOrderedPair, sourceRoughPair, sourceCentralPair, sourceT3,
    ArithmeticFunction.coe_mk, ite_true, show (1 : Fin 2) ≠ 0 by decide, ite_false]
  simp only [← Finset.sum_add_distrib]
  apply Finset.sum_congr rfl
  intro d hd
  apply Finset.sum_congr rfl
  intro e he
  simp only [hpair0, hpair1]
  simpa only [and_assoc, α] using pair_cut_partition
    (d.1.Prime ∧ e.1.Prime ∧ (9519 : ℝ) / 50000 ≤ α e.1 ∧
      α e.1 < α d.1 ∧ α d.1 < (40481 : ℝ) / 100000)
    ((40481 : ℝ) / 100000) ((59519 : ℝ) / 100000)
    (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000)
    (α d.1 + α e.1) (α e.1) (roughWeight (e.1 : ℝ) e.2) (by norm_num)

theorem sum_prime_pair_divisorsAntidiagonal
    {A : Type*} [AddCommMonoid A] (n : ℕ) (P : ℕ → Prop) (Q : ℕ → ℕ → Prop)
    [DecidablePred P] [∀ p, DecidablePred (Q p)]
    (w : ℕ → ℕ → ℕ → A) :
    (∑ d ∈ n.divisorsAntidiagonal, ∑ e ∈ d.2.divisorsAntidiagonal,
      if (d.1.Prime ∧ P d.1) ∧ (e.1.Prime ∧ Q d.1 e.1) then w d.1 e.1 e.2 else 0) =
    ∑ p ∈ (Nat.primesLE n).filter (fun p => P p ∧ p ∣ n),
      ∑ q ∈ (Nat.primesLE (n / p)).filter (fun q => Q p q ∧ q ∣ n / p),
        w p q ((n / p) / q) := by
  classical
  calc
    _ = ∑ d ∈ n.divisorsAntidiagonal,
        if d.1.Prime ∧ P d.1 then
          ∑ e ∈ d.2.divisorsAntidiagonal,
            if e.1.Prime ∧ Q d.1 e.1 then w d.1 e.1 e.2 else 0
        else 0 := by
      apply Finset.sum_congr rfl
      intro d hd
      by_cases h : d.1.Prime ∧ P d.1
      · simp only [h, true_and, ite_true]
      · simp only [h, false_and, ite_false, Finset.sum_const_zero]
    _ = _ := by
      simp_rw [sum_prime_divisorsAntidiagonal]
      exact sum_prime_divisorsAntidiagonal n P
        (fun p r => ∑ q ∈ (Nat.primesLE r).filter (fun q => Q p q ∧ q ∣ r),
          w p q (r / q))

theorem sourceOrderedPair_eq_prime_divisor_sum (x : ℝ) (hx : 1 < x) (n : ℕ) :
    sourceOrderedPair x n =
      ∑ p ∈ (Nat.primesLE n).filter (fun p : ℕ =>
        x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ) ∧
        (p : ℝ) < x ^ ((40481 : ℝ) / 100000) ∧ p ∣ n),
        ∑ q ∈ (Nat.primesLE (n / p)).filter (fun q : ℕ =>
          x ^ ((9519 : ℝ) / 50000) ≤ (q : ℝ) ∧
          (q : ℝ) < (p : ℝ) ∧ q ∣ n / p),
          roughWeight (q : ℝ) ((n / p) / q) := by
  classical
  have hmask (p q : ℕ) :
      (p.Prime ∧ q.Prime ∧
        (9519 : ℝ) / 50000 ≤ Real.logb x (q : ℝ) ∧
        Real.logb x (q : ℝ) < Real.logb x (p : ℝ) ∧
        Real.logb x (p : ℝ) < (40481 : ℝ) / 100000) ↔
      (p.Prime ∧ x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ) ∧
        (p : ℝ) < x ^ ((40481 : ℝ) / 100000)) ∧
      (q.Prime ∧ x ^ ((9519 : ℝ) / 50000) ≤ (q : ℝ) ∧ (q : ℝ) < (p : ℝ)) := by
    by_cases hp : p.Prime
    · by_cases hq : q.Prime
      · simp only [hp, hq, true_and,
          Real.le_logb_iff_rpow_le hx (Nat.cast_pos.mpr hq.pos),
          Real.logb_lt_logb_iff hx (Nat.cast_pos.mpr hq.pos) (Nat.cast_pos.mpr hp.pos),
          Real.logb_lt_iff_lt_rpow hx (Nat.cast_pos.mpr hp.pos)]
        constructor
        · rintro ⟨hlo, hqp, hphi⟩
          exact ⟨⟨hlo.trans hqp.le, hphi⟩, hlo, hqp⟩
        · rintro ⟨⟨_, hphi⟩, hlo, hqp⟩
          exact ⟨hlo, hqp, hphi⟩
      · simp only [hq, false_and, and_false]
    · simp only [hp, false_and]
  simp only [sourceOrderedPair, ArithmeticFunction.coe_mk, hmask]
  simpa only [and_assoc] using sum_prime_pair_divisorsAntidiagonal n
    (fun p => x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ) ∧
      (p : ℝ) < x ^ ((40481 : ℝ) / 100000))
    (fun p q => x ^ ((9519 : ℝ) / 50000) ≤ (q : ℝ) ∧ (q : ℝ) < (p : ℝ))
    (fun _ q r => roughWeight (q : ℝ) r)

theorem primeIndicator_source_buchstab {x : ℝ} (hx : 3 ≤ x)
    {n : ℕ} (hlo : x ≤ (n : ℝ)) (hhi : (n : ℝ) ≤ 2 * x) :
    (if n.Prime then (1 : ℝ) else 0) =
      siftedTheta x 0 (fun _ => 1) n - siftedTheta x 1 (fun _ => 1) n +
      siftedTheta x 2 (fun _ => 1) n + siftedTheta x 3 (fun _ => 1) n -
      siftedTheta x 4 (fun _ => 1) n - sourceLargeFirst x n + sourceCentralPair x n +
      sourceT3 x n + sourceT5 x n - sourceT4 x n := by
  have hx1 : 1 < x := by linarith
  have hlarge : sourceLargeFirst x n =
      ∑ p ∈ (Nat.primesLE n).filter (fun p : ℕ =>
        x ^ ((40481 : ℝ) / 100000) ≤ (p : ℝ) ∧
        (p : ℝ) < Real.sqrt (3 * x) ∧ p ∣ n),
        roughWeight (p : ℝ) (n / p) := by
    classical
    simpa only [sourceLargeFirst, ArithmeticFunction.coe_mk, and_assoc] using
      sum_prime_divisorsAntidiagonal n
        (fun p => x ^ ((40481 : ℝ) / 100000) ≤ (p : ℝ) ∧
          (p : ℝ) < Real.sqrt (3 * x)) (fun p r => roughWeight (p : ℝ) r)
  have hstart := primeIndicator_eq_siftedTheta_zero_sub_one hx hlo hhi
  rw [← hlarge, ← sourceOrderedPair_eq_prime_divisor_sum x hx1 n] at hstart
  have hparts := sourceOrderedPair_partition x hx1 n
  have hlow := sourceRoughPair_zero_buchstab x hx1 n
  have hhigh := sourceRoughPair_one_buchstab x hx1 n
  have hlast := sourceRoughTriple_buchstab x hx1 n
  linarith

/--
The number of factorizations of `n` into a prime tuple from sifted region `5` and a prime
cofactor.
-/
noncomputable def sourceU1 (x : ℝ) : ArithmeticFunction ℝ := by
  classical
  exact ⟨fun n =>
    ∑ ps ∈ siftedPrimeTuples x (5 : Fin 6), ∑ d ∈ n.divisorsAntidiagonal,
      if d.1 = ps.prod then (if d.2.Prime then 1 else 0) else 0, by simp⟩

/--
The number of factorizations of `n` into a prime tuple from sifted region `5` and two additional
primes in nondecreasing order, with the smaller additional prime at least `x^(9519 / 50000)`.
-/
noncomputable def sourceU3 (x : ℝ) : ArithmeticFunction ℝ := by
  classical
  exact ⟨fun n =>
    ∑ ps ∈ siftedPrimeTuples x (5 : Fin 6), ∑ d ∈ n.divisorsAntidiagonal,
      if d.1 = ps.prod then
        ∑ e ∈ d.2.divisorsAntidiagonal,
          if e.1.Prime ∧ e.2.Prime ∧ x ^ ((9519 : ℝ) / 50000) ≤ (e.1 : ℝ) ∧
              e.1 ≤ e.2 then 1 else 0
      else 0, by simp⟩

theorem sourceU1_eventually_eq_siftedTheta_five_sub_sourceU3 :
    ∃ X : ℝ, 3 ≤ X ∧ ∀ x : ℝ, X ≤ x → ∀ n : ℕ,
      x ≤ (n : ℝ) → (n : ℝ) ≤ 2 * x →
      sourceU1 x n = siftedTheta x (5 : Fin 6) (fun _ => 1) n - sourceU3 x n := by
  classical
  obtain ⟨X, hX⟩ := eventually_exceptional_large.exists_forall_of_atTop
  refine ⟨max 3 X, le_max_left _ _, ?_⟩
  intro x hx n hnlo hnhi
  obtain ⟨hx1, hgrowth⟩ := hX x ((le_max_right _ _).trans hx)
  have hx0 : 0 < x := zero_lt_one.trans hx1
  let z : ℝ := x ^ ((9519 : ℝ) / 50000)
  have hz : 1 < z := Real.one_lt_rpow hx1 (by norm_num)
  have hz0 : 0 ≤ z := (zero_lt_one.trans hz).le
  have hpoint (ps : List ℕ) (hps : ps ∈ siftedPrimeTuples x (5 : Fin 6))
      (d : ℕ × ℕ) (hd : d ∈ n.divisorsAntidiagonal) (heq : d.1 = ps.prod) :
      roughWeight z d.2 = (if d.2.Prime then 1 else 0) +
        ∑ e ∈ d.2.divisorsAntidiagonal,
          if e.1.Prime ∧ e.2.Prime ∧ z ≤ (e.1 : ℝ) ∧ e.1 ≤ e.2 then 1 else 0 := by
    have hmul : ps.prod * d.2 = n := by
      simpa only [heq] using (Nat.mem_divisorsAntidiagonal.mp hd).1
    have hmpos : 0 < (d.2 : ℝ) := Nat.cast_pos.mpr
      (Nat.pos_of_ne_zero (Nat.right_ne_zero_of_mem_divisorsAntidiagonal hd))
    have hmulR : (ps.prod : ℝ) * (d.2 : ℝ) = (n : ℝ) := by exact_mod_cast hmul
    obtain ⟨_hgp, hgq, hgeq, hgphi, hgqhi, hprimes⟩ :=
      siftedPrimeTuples_group_bounds x hx1 (5 : Fin 6) ps hps
    have hprodhi : (ps.prod : ℝ) < x ^ (1 - (1058 : ℝ) / 3125) := by
      rw [← Real.rpow_sub hx0] at hgqhi
      calc
        (ps.prod : ℝ) =
            ((siftedPrimeGroups (5 : Fin 6) ps).1 : ℝ) *
              ((siftedPrimeGroups (5 : Fin 6) ps).2 : ℝ) := by
          exact_mod_cast hgeq.symm
        _ < x ^ ((40481 : ℝ) / 100000) *
            x ^ (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000) :=
          mul_lt_mul hgphi hgqhi.le (Nat.cast_pos.mpr hgq)
            (Real.rpow_nonneg hx0.le _)
        _ = _ := by rw [← Real.rpow_add hx0]; congr 1; ring
    have hmlarge : x ^ ((1058 : ℝ) / 3125) < (d.2 : ℝ) := by
      by_contra hbad
      have hmle := le_of_not_gt hbad
      have hnsmall : (n : ℝ) <
          x ^ (1 - (1058 : ℝ) / 3125) * x ^ ((1058 : ℝ) / 3125) := by
        rw [← hmulR]
        exact mul_lt_mul hprodhi hmle hmpos (Real.rpow_nonneg hx0.le _)
      rw [← Real.rpow_add hx0, sub_add_cancel, Real.rpow_one] at hnsmall
      exact (not_lt_of_ge hnlo) hnsmall
    have hmlo : z ≤ (d.2 : ℝ) :=
      (Real.rpow_le_rpow_of_exponent_le hx1.le
        (by norm_num : (9519 : ℝ) / 50000 ≤ (1058 : ℝ) / 3125)).trans hmlarge.le
    have hshape : ∃ p q r : ℕ, ps = [p, q, r] := by
      have hmem := (mem_siftedPrimeTuples_iff x hx1 (5 : Fin 6) ps).mp hps
      dsimp only at hmem
      rcases ps with _ | ⟨p, _ | ⟨q, _ | ⟨r, _ | ⟨s, ss⟩⟩⟩⟩
      · exact False.elim hmem
      · exact False.elim hmem
      · exact False.elim hmem
      · exact ⟨p, q, r, rfl⟩
      · exact False.elim hmem
    have hprodlo : z ^ (3 : ℕ) ≤ (ps.prod : ℝ) := by
      obtain ⟨p, q, r, rfl⟩ := hshape
      have hpz := (hprimes p (by simp)).2
      have hqz := (hprimes q (by simp)).2
      have hrz := (hprimes r (by simp)).2
      calc
        z ^ (3 : ℕ) = z * z * z := by ring
        _ ≤ (p : ℝ) * (q : ℝ) * (r : ℝ) :=
          mul_le_mul (mul_le_mul hpz hqz hz0 (Nat.cast_nonneg _)) hrz hz0
            (mul_nonneg (Nat.cast_nonneg _) (Nat.cast_nonneg _))
        _ = (([p, q, r] : List ℕ).prod : ℝ) := by
          simp only [List.prod_cons, List.prod_nil, Nat.cast_mul, mul_one, mul_assoc]
    have hmsmall : (d.2 : ℝ) < z ^ (3 : ℕ) := by
      by_contra hbad
      have hmge := le_of_not_gt hbad
      have hlarge : x ^ (6 * ((9519 : ℝ) / 50000)) ≤ (n : ℝ) := by
        calc
          x ^ (6 * ((9519 : ℝ) / 50000)) = z ^ (3 : ℕ) * z ^ (3 : ℕ) := by
            dsimp only [z]
            rw [← pow_add, ← Real.rpow_mul_natCast hx0.le]
            congr 1
            norm_num
          _ ≤ (ps.prod : ℝ) * (d.2 : ℝ) :=
            mul_le_mul hprodlo hmge (pow_nonneg hz0 _)
              (Nat.cast_nonneg _)
          _ = (n : ℝ) := hmulR
      exact (not_lt_of_ge hnhi) (hgrowth.trans_le hlarge)
    exact roughWeight_eq_prime_add_ordered_semiprime z d.2 hz hmlo hmsmall
  apply (eq_sub_iff_add_eq).mpr
  simp only [sourceU1, sourceU3, siftedTheta, ArithmeticFunction.coe_mk, one_mul]
  rw [← Finset.sum_add_distrib]
  apply Finset.sum_congr rfl
  intro ps hps
  rw [← Finset.sum_add_distrib]
  apply Finset.sum_congr rfl
  intro d hd
  by_cases heq : d.1 = ps.prod
  · simp only [ite_eq_left heq]
    exact (hpoint ps hps d hd heq).symm
  · simp only [ite_eq_right heq, add_zero]

open Classical in
theorem roughWeight_eq_prime_add_ordered_two_three
    (z : ℝ) (m : ℕ) (hz : 1 < z) (hm : z ≤ (m : ℝ))
    (hbound : (m : ℝ) < z ^ (4 : ℕ)) :
    roughWeight z m = (if m.Prime then 1 else 0) +
      (∑ e ∈ m.divisorsAntidiagonal,
        if e.1.Prime ∧ e.2.Prime ∧ z ≤ (e.1 : ℝ) ∧ e.1 ≤ e.2 then 1 else 0) +
      ∑ e ∈ m.divisorsAntidiagonal, ∑ f ∈ e.2.divisorsAntidiagonal,
        if e.1.Prime ∧ f.1.Prime ∧ f.2.Prime ∧ z ≤ (e.1 : ℝ) ∧
            e.1 ≤ f.1 ∧ f.1 ≤ f.2 then 1 else 0 := by
  have hpair_min (a b n : ℕ) (ha : a.Prime) (hb : b.Prime)
      (hab : a ≤ b) (hprod : a * b = n) : a = n.minFac := by
    have hadvd : a ∣ n := ⟨b, hprod.symm⟩
    have hn1 : n ≠ 1 := fun hn => ha.not_dvd_one (hn ▸ hadvd)
    have hminprime : n.minFac.Prime := Nat.minFac_prime hn1
    have hminle : n.minFac ≤ a := Nat.minFac_le_of_dvd ha.two_le hadvd
    have hdiv : n.minFac ∣ a * b := by
      rw [hprod]
      exact Nat.minFac_dvd n
    apply le_antisymm ?_ hminle
    rcases hminprime.dvd_mul.mp hdiv with hleft | hright
    · exact ((Nat.prime_dvd_prime_iff_eq hminprime ha).mp hleft).symm.le
    · exact hab.trans ((Nat.prime_dvd_prime_iff_eq hminprime hb).mp hright).symm.le
  have htriple_min (a b c n : ℕ) (ha : a.Prime) (hb : b.Prime) (hc : c.Prime)
      (hab : a ≤ b) (hbc : b ≤ c) (hprod : a * (b * c) = n) : a = n.minFac := by
    have hadvd : a ∣ n := ⟨b * c, hprod.symm⟩
    have hn1 : n ≠ 1 := fun hn => ha.not_dvd_one (hn ▸ hadvd)
    have hminprime : n.minFac.Prime := Nat.minFac_prime hn1
    have hminle : n.minFac ≤ a := Nat.minFac_le_of_dvd ha.two_le hadvd
    have hdiv : n.minFac ∣ a * (b * c) := by
      rw [hprod]
      exact Nat.minFac_dvd n
    apply le_antisymm ?_ hminle
    rcases hminprime.dvd_mul.mp hdiv with hleft | hright
    · exact ((Nat.prime_dvd_prime_iff_eq hminprime ha).mp hleft).symm.le
    · have hcofactor : (b * c).minFac ≤ n.minFac :=
        Nat.minFac_le_of_dvd hminprime.two_le hright
      rw [← hpair_min b c (b * c) hb hc hbc rfl] at hcofactor
      exact hab.trans hcofactor
  have hm0 : m ≠ 0 := by
    intro h
    simp only [h, Nat.cast_zero] at hm
    linarith
  have hm1 : m ≠ 1 := by
    intro h
    simp only [h, Nat.cast_one] at hm
    linarith
  have htwo_min (e : ℕ × ℕ) (he : e ∈ m.divisorsAntidiagonal)
      (h : e.1.Prime ∧ e.2.Prime ∧ z ≤ (e.1 : ℝ) ∧ e.1 ≤ e.2) :
      e.1 = m.minFac :=
    hpair_min e.1 e.2 m h.1 h.2.1 h.2.2.2 (Nat.mem_divisorsAntidiagonal.mp he).1
  have hthree_min (e f : ℕ × ℕ) (he : e ∈ m.divisorsAntidiagonal)
      (hf : f ∈ e.2.divisorsAntidiagonal)
      (h : e.1.Prime ∧ f.1.Prime ∧ f.2.Prime ∧ z ≤ (e.1 : ℝ) ∧
        e.1 ≤ f.1 ∧ f.1 ≤ f.2) : e.1 = m.minFac := by
    apply htriple_min e.1 f.1 f.2 m h.1 h.2.1 h.2.2.1 h.2.2.2.2.1 h.2.2.2.2.2
    rw [(Nat.mem_divisorsAntidiagonal.mp hf).1]
    exact (Nat.mem_divisorsAntidiagonal.mp he).1
  rw [roughWeight_eq_ite_minFac z hm0 hm1]
  by_cases hprime : m.Prime
  · have hsum2 : (∑ e ∈ m.divisorsAntidiagonal,
        if e.1.Prime ∧ e.2.Prime ∧ z ≤ (e.1 : ℝ) ∧ e.1 ≤ e.2
        then (1 : ℝ) else 0) = 0 := by
      apply Finset.sum_eq_zero
      intro e he
      apply ite_eq_right
      intro h
      exact Nat.not_prime_of_mul_eq (Nat.mem_divisorsAntidiagonal.mp he).1
        h.1.ne_one h.2.1.ne_one hprime
    have hsum3 : (∑ e ∈ m.divisorsAntidiagonal, ∑ f ∈ e.2.divisorsAntidiagonal,
        if e.1.Prime ∧ f.1.Prime ∧ f.2.Prime ∧ z ≤ (e.1 : ℝ) ∧
          e.1 ≤ f.1 ∧ f.1 ≤ f.2 then (1 : ℝ) else 0) = 0 := by
      apply Finset.sum_eq_zero
      intro e he
      apply Finset.sum_eq_zero
      intro f hf
      apply ite_eq_right
      intro h
      have he2 : e.2 ≠ 1 := by
        intro he2
        have hprod : f.1 * f.2 = 1 := (Nat.mem_divisorsAntidiagonal.mp hf).1.trans he2
        exact h.2.1.not_dvd_one ⟨f.2, hprod.symm⟩
      exact Nat.not_prime_of_mul_eq (Nat.mem_divisorsAntidiagonal.mp he).1
        h.1.ne_one he2 hprime
    simp only [hprime.minFac_eq, ite_eq_left hm, ite_eq_left hprime, hsum2, hsum3,
      add_zero]
  · rw [ite_eq_right hprime, zero_add]
    by_cases hrough : z ≤ (m.minFac : ℝ)
    · rw [ite_eq_left hrough]
      let p : ℕ := m.minFac
      let q : ℕ := m / p
      have hpp : p.Prime := Nat.minFac_prime hm1
      have hpq : p ≤ q := Nat.minFac_le_div (Nat.pos_of_ne_zero hm0) hprime
      have hpz : z ≤ (p : ℝ) := hrough
      have hprod : p * q = m := Nat.mul_div_cancel' (Nat.minFac_dvd m)
      have hqdvd : q ∣ m := Nat.div_dvd_of_dvd (Nat.minFac_dvd m)
      have hpqmem : (p, q) ∈ m.divisorsAntidiagonal :=
        Nat.mem_divisorsAntidiagonal.mpr ⟨hprod, hm0⟩
      have hcofactor (e : ℕ × ℕ) (he : e ∈ m.divisorsAntidiagonal)
          (he1 : e.1 = p) : e = (p, q) := by
        apply Prod.ext he1
        apply Nat.eq_of_mul_eq_mul_left hpp.pos
        calc
          p * e.2 = m := by simpa only [he1] using (Nat.mem_divisorsAntidiagonal.mp he).1
          _ = p * q := hprod.symm
      have hsum2 : (∑ e ∈ m.divisorsAntidiagonal,
          if e.1.Prime ∧ e.2.Prime ∧ z ≤ (e.1 : ℝ) ∧ e.1 ≤ e.2
          then (1 : ℝ) else 0) = if q.Prime then 1 else 0 := by
        calc
          _ = (if p.Prime ∧ q.Prime ∧ z ≤ (p : ℝ) ∧ p ≤ q then (1 : ℝ) else 0) := by
            apply Finset.sum_eq_single_of_mem (p, q) hpqmem
            intro e he hne
            apply ite_eq_right
            intro h
            exact hne (hcofactor e he (htwo_min e he h))
          _ = _ := by simp only [hpp, hpz, hpq, true_and, and_true]
      have hsum3 : (∑ e ∈ m.divisorsAntidiagonal, ∑ f ∈ e.2.divisorsAntidiagonal,
          if e.1.Prime ∧ f.1.Prime ∧ f.2.Prime ∧ z ≤ (e.1 : ℝ) ∧
            e.1 ≤ f.1 ∧ f.1 ≤ f.2 then (1 : ℝ) else 0) =
          ∑ f ∈ q.divisorsAntidiagonal,
            if f.1.Prime ∧ f.2.Prime ∧ (p : ℝ) ≤ (f.1 : ℝ) ∧ f.1 ≤ f.2
              then (1 : ℝ) else 0 := by
        calc
          _ = ∑ f ∈ q.divisorsAntidiagonal,
              if p.Prime ∧ f.1.Prime ∧ f.2.Prime ∧ z ≤ (p : ℝ) ∧
                p ≤ f.1 ∧ f.1 ≤ f.2 then (1 : ℝ) else 0 := by
            apply Finset.sum_eq_single_of_mem (p, q) hpqmem
            intro e he hne
            apply Finset.sum_eq_zero
            intro f hf
            apply ite_eq_right
            intro h
            exact hne (hcofactor e he (hthree_min e f he hf h))
          _ = _ := by
            apply Finset.sum_congr rfl
            intro f _hf
            simp only [hpp, hpz, Nat.cast_le, true_and]
      have hp0 : 0 < (p : ℝ) := Nat.cast_pos.mpr hpp.pos
      have hqbound : (q : ℝ) < (p : ℝ) ^ (3 : ℕ) := by
        apply (mul_lt_mul_iff_of_pos_left hp0).mp
        calc
          (p : ℝ) * (q : ℝ) = (m : ℝ) := by exact_mod_cast hprod
          _ < z ^ (4 : ℕ) := hbound
          _ ≤ (p : ℝ) ^ (4 : ℕ) := pow_le_pow_left₀ (by linarith : 0 ≤ z) hpz 4
          _ = (p : ℝ) * (p : ℝ) ^ (3 : ℕ) := by ring
      have hqpos : 0 < q := hpp.pos.trans_le hpq
      have hq1 : q ≠ 1 := by
        have hptwo := hpp.two_le
        omega
      have hleast : p ≤ q.minFac := Nat.minFac_le_of_dvd
        (Nat.minFac_prime hq1).two_le ((Nat.minFac_dvd q).trans hqdvd)
      have hqrough : roughWeight (p : ℝ) q = 1 := by
        rw [roughWeight_eq_ite_minFac (p : ℝ) (ne_of_gt hqpos) hq1,
          ite_eq_left (Nat.cast_le.mpr hleast)]
      have hqexpand := roughWeight_eq_prime_add_ordered_semiprime (p : ℝ) q
        (by exact_mod_cast hpp.one_lt) (Nat.cast_le.mpr hpq) hqbound
      rw [hqrough] at hqexpand
      rw [hsum2, hsum3]
      exact hqexpand
    · rw [ite_eq_right hrough]
      have hsum2 : (∑ e ∈ m.divisorsAntidiagonal,
          if e.1.Prime ∧ e.2.Prime ∧ z ≤ (e.1 : ℝ) ∧ e.1 ≤ e.2
          then (1 : ℝ) else 0) = 0 := by
        apply Finset.sum_eq_zero
        intro e he
        apply ite_eq_right
        intro h
        exact hrough (by simpa only [htwo_min e he h] using h.2.2.1)
      have hsum3 : (∑ e ∈ m.divisorsAntidiagonal, ∑ f ∈ e.2.divisorsAntidiagonal,
          if e.1.Prime ∧ f.1.Prime ∧ f.2.Prime ∧ z ≤ (e.1 : ℝ) ∧
            e.1 ≤ f.1 ∧ f.1 ≤ f.2 then (1 : ℝ) else 0) = 0 := by
        apply Finset.sum_eq_zero
        intro e he
        apply Finset.sum_eq_zero
        intro f hf
        apply ite_eq_right
        intro h
        exact hrough (by simpa only [hthree_min e f he hf h] using h.2.2.2.1)
      rw [hsum2, hsum3, add_zero]

open Classical in
theorem exceptionalPrimeDefect_one_swapped_triple (x : ℝ) (n : ℕ) :
    exceptionalPrimeDefect x 1 n =
      let a : ℝ := 40481 / 100000
      let b : ℝ := 59519 / 100000
      let xi : ℝ := 9519 / 50000
      let uStar : ℝ := 1 - 4 * xi
      let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
      ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
        if (∏ i, p i) = n ∧
            (∀ i, xi ≤ α (p i) ∧ α (p i) ≤ uStar) ∧
            α (p 1) < α (p 0) ∧
            α (p 1) < α (p 2) ∧
            α (p 0) + α (p 2) < a ∧
            b < α (p 1) + α (p 2) + α (p 3) ∧
            α (p 3) ≤ α (p 4)
        then 1 else 0 := by
  let a : ℝ := 40481 / 100000
  let b : ℝ := 59519 / 100000
  let xi : ℝ := 9519 / 50000
  let uStar : ℝ := 1 - 4 * xi
  let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
  let swap : (Fin 5 → ℕ) → (Fin 5 → ℕ) :=
    fun p => ![p 2, p 1, p 0, p 3, p 4]
  have hmem (p : Fin 5 → ℕ)
      (hp : p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n)) :
      swap p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n) := by
    rw [Fintype.mem_piFinset] at hp ⊢
    intro i
    fin_cases i <;> exact hp _
  have hinv (p : Fin 5 → ℕ) :
      swap (swap p) = p := by
    funext i
    fin_cases i <;> rfl
  change (∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
    if (∏ i, p i) = n ∧
        (∀ i, xi ≤ α (p i) ∧ α (p i) ≤ uStar) ∧
        α (p 1) < α (p 0) ∧ α (p 1) < α (p 2) ∧
        α (p 0) + α (p 2) < a ∧
        b < α (p 0) + α (p 1) + α (p 3) ∧
        α (p 3) ≤ α (p 4) then (1 : ℝ) else 0) = _
  apply Finset.sum_nbij' swap swap hmem hmem
    (fun p _ => hinv p) (fun p _ => hinv p)
  intro p hp
  have hprod : (∏ i, swap p i) = ∏ i, p i := by
    simp only [Fin.prod_univ_succ]
    change p 2 * (p 1 * (p 0 * (p 3 * (p 4 * 1)))) =
      p 0 * (p 1 * (p 2 * (p 3 * (p 4 * 1))))
    ring
  have hbounds :
      (∀ i, xi ≤ α (swap p i) ∧ α (swap p i) ≤ uStar) ↔
        (∀ i, xi ≤ α (p i) ∧ α (p i) ≤ uStar) := by
    simp only [Fin.forall_fin_succ, IsEmpty.forall_iff]
    change
      ((xi ≤ α (p 2) ∧ α (p 2) ≤ uStar) ∧
        (xi ≤ α (p 1) ∧ α (p 1) ≤ uStar) ∧
        (xi ≤ α (p 0) ∧ α (p 0) ≤ uStar) ∧
        (xi ≤ α (p 3) ∧ α (p 3) ≤ uStar) ∧
        (xi ≤ α (p 4) ∧ α (p 4) ≤ uStar) ∧ True) ↔
      ((xi ≤ α (p 0) ∧ α (p 0) ≤ uStar) ∧
        (xi ≤ α (p 1) ∧ α (p 1) ≤ uStar) ∧
        (xi ≤ α (p 2) ∧ α (p 2) ≤ uStar) ∧
        (xi ≤ α (p 3) ∧ α (p 3) ≤ uStar) ∧
        (xi ≤ α (p 4) ∧ α (p 4) ≤ uStar) ∧ True)
    tauto
  change (if (∏ i, p i) = n ∧
      (∀ i, xi ≤ α (p i) ∧ α (p i) ≤ uStar) ∧
      α (p 1) < α (p 0) ∧ α (p 1) < α (p 2) ∧
      α (p 0) + α (p 2) < a ∧
      b < α (p 0) + α (p 1) + α (p 3) ∧
      α (p 3) ≤ α (p 4) then (1 : ℝ) else 0) = _
  congr 1
  apply propext
  rw [hprod, hbounds]
  change
    ((∏ i, p i) = n ∧ (∀ i, xi ≤ α (p i) ∧ α (p i) ≤ uStar) ∧
      α (p 1) < α (p 0) ∧ α (p 1) < α (p 2) ∧
      α (p 0) + α (p 2) < a ∧ b < α (p 0) + α (p 1) + α (p 3) ∧
      α (p 3) ≤ α (p 4)) ↔
    ((∏ i, p i) = n ∧ (∀ i, xi ≤ α (p i) ∧ α (p i) ≤ uStar) ∧
      α (p 1) < α (p 2) ∧ α (p 1) < α (p 0) ∧
      α (p 2) + α (p 0) < a ∧ b < α (p 1) + α (p 0) + α (p 3) ∧
      α (p 3) ≤ α (p 4))
  constructor
  · rintro ⟨he, hb, h10, h12, h02, ht, h34⟩
    exact ⟨he, hb, h12, h10, by linarith, by linarith, h34⟩
  · rintro ⟨he, hb, h12, h10, h20, ht, h34⟩
    exact ⟨he, hb, h10, h12, by linarith, by linarith, h34⟩

open Classical in
theorem sourceU3_eq_five_prime_sum (x : ℝ) (hx : 1 < x) (n : ℕ) :
    sourceU3 x n =
      ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
        if (∏ i, p i) = n ∧ [p 0, p 1, p 2] ∈ siftedPrimeTuples x (5 : Fin 6) ∧
            x ^ ((9519 : ℝ) / 50000) ≤ (p 3 : ℝ) ∧ p 3 ≤ p 4
        then 1 else 0 := by
  let F := siftedPrimeTuples x (5 : Fin 6)
  let z : ℝ := x ^ ((9519 : ℝ) / 50000)
  let S : Finset (Σ _ : List ℕ × (ℕ × ℕ), ℕ × ℕ) :=
    ((F.product n.divisorsAntidiagonal).sigma
      (fun u => u.2.2.divisorsAntidiagonal)).filter
      (fun t => t.1.2.1 = t.1.1.prod ∧ t.2.1.Prime ∧ t.2.2.Prime ∧
        z ≤ (t.2.1 : ℝ) ∧ t.2.1 ≤ t.2.2)
  let T := (Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n)).filter
    (fun p => (∏ i, p i) = n ∧ [p 0, p 1, p 2] ∈ F ∧
      z ≤ (p 3 : ℝ) ∧ p 3 ≤ p 4)
  let f : (Fin 5 → ℕ) → (Σ _ : List ℕ × (ℕ × ℕ), ℕ × ℕ) := fun p =>
    ⟨([p 0, p 1, p 2], (p 0 * p 1 * p 2, p 3 * p 4)), (p 3, p 4)⟩
  have hprod (p : Fin 5 → ℕ) :
      (∏ i, p i) = (p 0 * p 1 * p 2) * (p 3 * p 4) := by
    simp only [Fin.prod_univ_succ]
    change p 0 * (p 1 * (p 2 * (p 3 * (p 4 * 1)))) =
      (p 0 * p 1 * p 2) * (p 3 * p 4)
    ring
  have hshape (ps : List ℕ) (hps : ps ∈ F) : ∃ a b c : ℕ, ps = [a, b, c] := by
    have hm := (mem_siftedPrimeTuples_iff x hx (5 : Fin 6) ps).mp hps
    dsimp only at hm
    rcases ps with _ | ⟨a, _ | ⟨b, _ | ⟨c, _ | ⟨d, ds⟩⟩⟩⟩
    · exact False.elim hm
    · exact False.elim hm
    · exact False.elim hm
    · exact ⟨a, b, c, rfl⟩
    · exact False.elim hm
  have hsum : (∑ p ∈ T, (1 : ℝ)) = ∑ t ∈ S, (1 : ℝ) := by
    refine Finset.sum_bij (fun p _ => f p) ?_ ?_ ?_ (fun _ _ => rfl)
    · intro p hp
      obtain ⟨hpP, hpN, hpF, hpz, hp34⟩ := Finset.mem_filter.mp hp
      have hprime (i : Fin 5) : (p i).Prime :=
        Nat.prime_of_mem_primesLE ((Fintype.mem_piFinset.mp hpP) i)
      have hn0 : n ≠ 0 := by
        rw [← hpN]
        exact Finset.prod_ne_zero_iff.mpr (fun i _ => (hprime i).ne_zero)
      have hpN' : (p 0 * p 1 * p 2) * (p 3 * p 4) = n :=
        (hprod p).symm.trans hpN
      apply Finset.mem_filter.mpr
      refine ⟨Finset.mem_sigma.mpr ⟨Finset.mem_product.mpr ⟨hpF, ?_⟩, ?_⟩, ?_⟩
      · exact Nat.mem_divisorsAntidiagonal.mpr ⟨hpN', hn0⟩
      · exact Nat.mem_divisorsAntidiagonal.mpr
          ⟨rfl, mul_ne_zero (hprime 3).ne_zero (hprime 4).ne_zero⟩
      · refine ⟨?_, hprime 3, hprime 4, hpz, hp34⟩
        simp only [f, List.prod_cons, List.prod_nil, mul_one, mul_assoc]
    · intro p _hp q _hq heq
      have hhead : [p 0, p 1, p 2] = [q 0, q 1, q 2] :=
        congrArg (fun t : Σ _ : List ℕ × (ℕ × ℕ), ℕ × ℕ => t.1.1) heq
      simp only [List.cons.injEq, and_true] at hhead
      have h3 : p 3 = q 3 :=
        congrArg (fun t : Σ _ : List ℕ × (ℕ × ℕ), ℕ × ℕ => t.2.1) heq
      have h4 : p 4 = q 4 :=
        congrArg (fun t : Σ _ : List ℕ × (ℕ × ℕ), ℕ × ℕ => t.2.2) heq
      funext i
      fin_cases i
      · exact hhead.1
      · exact hhead.2.1
      · exact hhead.2.2
      · exact h3
      · exact h4
    · intro t ht
      obtain ⟨htS, htprod, ht3, ht4, htz, ht34⟩ := Finset.mem_filter.mp ht
      obtain ⟨htP, hte⟩ := Finset.mem_sigma.mp htS
      obtain ⟨htF, htd⟩ := Finset.mem_product.mp htP
      obtain ⟨a, b, c, hlist⟩ := hshape t.1.1 htF
      have hmem := (mem_siftedPrimeTuples_iff x hx (5 : Fin 6) t.1.1).mp htF
      rw [hlist] at hmem
      dsimp only at hmem
      have htd1 : t.1.2.1 = a * b * c := by
        simpa only [hlist, List.prod_cons, List.prod_nil, mul_one, mul_assoc] using htprod
      let p : Fin 5 → ℕ := ![a, b, c, t.2.1, t.2.2]
      have hprime : ∀ i, (p i).Prime := by
        intro i
        fin_cases i
        · exact hmem.1
        · exact hmem.2.1
        · exact hmem.2.2.1
        · exact ht3
        · exact ht4
      have hpN : (∏ i, p i) = n := by
        rw [hprod]
        change (a * b * c) * (t.2.1 * t.2.2) = n
        rw [(Nat.mem_divisorsAntidiagonal.mp hte).1, ← htd1]
        exact (Nat.mem_divisorsAntidiagonal.mp htd).1
      have hpP : p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n) := by
        apply Fintype.mem_piFinset.mpr
        intro i
        apply Nat.mem_primesLE.mpr
        refine ⟨?_, hprime i⟩
        apply Nat.le_of_dvd (Nat.pos_of_ne_zero
          (Nat.mem_divisorsAntidiagonal.mp htd).2)
        rw [← hpN]
        exact Finset.dvd_prod_of_mem p (Finset.mem_univ i)
      have hpT : p ∈ T := by
        apply Finset.mem_filter.mpr
        refine ⟨hpP, hpN, ?_, htz, ht34⟩
        change [a, b, c] ∈ F
        simpa only [hlist] using htF
      refine ⟨p, hpT, ?_⟩
      apply Sigma.ext
      · exact Prod.ext hlist.symm
          (Prod.ext htd1.symm (Nat.mem_divisorsAntidiagonal.mp hte).1)
      · exact heq_of_eq rfl
  calc
    sourceU3 x n = ∑ t ∈ S, (1 : ℝ) := by
      simp only [sourceU3, ArithmeticFunction.coe_mk, S, Finset.sum_filter,
        Finset.sum_sigma, Finset.product_eq_sprod, Finset.sum_product]
      apply Finset.sum_congr rfl
      intro ps _hps
      apply Finset.sum_congr rfl
      intro d _hd
      by_cases heq : d.1 = ps.prod
      · simp only [z, ite_and, ite_eq_left heq]
      · simp only [ite_and, ite_eq_right heq, Finset.sum_const_zero]
    _ = ∑ p ∈ T, (1 : ℝ) := hsum.symm
    _ = _ := by simp only [T, F, z, Finset.sum_filter]

open Classical in
theorem sourceU3_offDiagonal_monomial_representation (x : ℝ) (hx : 1 < x) :
    ∃ M : Finset MinorantMonomialCut, M.card ≤ 32 ∧
      (∀ d ∈ M, d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
        d.numerator.card + d.denominator.card ≤ 5 ∧ 0 < d.threshold) ∧
      let P := (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((6 : ℝ) / 25)⌋₊).filter Nat.Prime
      let T := Fintype.piFinset (fun _ : Fin 5 => P)
      let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
      let E (p : Fin 5 → ℕ) : Prop :=
        (∀ i, (9519 : ℝ) / 50000 ≤ α (p i) ∧
          α (p i) ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
        α (p 1) < α (p 0) ∧ α (p 1) < α (p 2) ∧
        α (p 0) + α (p 2) < (40481 : ℝ) / 100000 ∧
        (59519 : ℝ) / 100000 < α (p 1) + α (p 2) + α (p 3) ∧
        α (p 3) ≤ α (p 4)
      let C (p : Fin 5 → ℕ) : Prop :=
        x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x ∧
        [p 0, p 1, p 2] ∈ siftedPrimeTuples x (5 : Fin 6) ∧
        x ^ ((9519 : ℝ) / 50000) ≤ (p 3 : ℝ) ∧ p 3 ≤ p 4 ∧
        ¬ E p ∧ p 2 ≠ p 1
      ∀ p ∈ T, ∀ q ∈ T,
        (∀ d ∈ M,
          (if d.lower then
            if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
          else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
          (if d.lower then
            if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
          else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
        (C p ↔ C q) := by
  have hx0 : 0 < x := zero_lt_one.trans hx
  let M : Finset MinorantMonomialCut := minorantMonomialCuts x (1 : Fin 2) ∪
    {⟨{1, 2}, ∅, x ^ ((40481 : ℝ) / 100000), false, true⟩,
      ⟨{1, 2, 3}, ∅, x ^ ((59519 : ℝ) / 100000), true, true⟩}
  have hMcard : M.card ≤ 32 := by
    dsimp only [M]
    exact (Finset.card_union_le _ _).trans
      ((Nat.add_le_add (minorantMonomialCuts_card_le x (1 : Fin 2))
        Finset.card_le_two).trans (by decide))
  have hMdata (d : MinorantMonomialCut) (hd : d ∈ M) :
      d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
        d.numerator.card + d.denominator.card ≤ 5 ∧ 0 < d.threshold := by
    rcases Finset.mem_union.mp hd with hbase | hextra
    · exact minorantMonomialCuts_data x hx0 (1 : Fin 2) d hbase
    · simp only [Finset.mem_insert, Finset.mem_singleton] at hextra
      rcases hextra with rfl | rfl
      · exact ⟨by simp, by simp, by
          change ({1, 2} : Finset (Fin 5)).card + (∅ : Finset (Fin 5)).card ≤ 5
          simp only [Finset.card_empty, add_zero]
          exact Finset.card_le_two.trans (by decide),
          Real.rpow_pos_of_pos hx0 _⟩
      · exact ⟨by simp, by simp, by
          change ({1, 2, 3} : Finset (Fin 5)).card + (∅ : Finset (Fin 5)).card ≤ 5
          simp only [Finset.card_empty, add_zero]
          exact Finset.card_le_three.trans (by decide),
          Real.rpow_pos_of_pos hx0 _⟩
  have hbase (d : MinorantMonomialCut)
      (hd : d ∈ minorantMonomialCuts x (1 : Fin 2)) : d ∈ M :=
    Finset.mem_union_left _ hd
  have h12 : (⟨{1, 2}, ∅, x ^ ((40481 : ℝ) / 100000), false, true⟩ :
      MinorantMonomialCut) ∈ M :=
    Finset.mem_union_right _ (Finset.mem_insert_self _ _)
  have h123 : (⟨{1, 2, 3}, ∅, x ^ ((59519 : ℝ) / 100000), true, true⟩ :
      MinorantMonomialCut) ∈ M :=
    Finset.mem_union_right _ (Finset.mem_insert_of_mem (Finset.mem_singleton_self _))
  refine ⟨M, hMcard, hMdata, ?_⟩
  clear_value M
  intro P T α E C
  have hprime (p : Fin 5 → ℕ) (hp : p ∈ T) (i : Fin 5) : (p i).Prime :=
    (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).2
  have hpos (p : Fin 5 → ℕ) (hp : p ∈ T) (i : Fin 5) : 0 < (p i : ℝ) :=
    Nat.cast_pos.mpr (hprime p hp i).pos
  have hlower (p : Fin 5 → ℕ) (hp : p ∈ T) (i : Fin 5) :
      x ^ ((9519 : ℝ) / 50000) ≤ (p i : ℝ) := by
    have hnat := (Finset.mem_Icc.mp
      (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).1).1
    exact (Nat.le_ceil _).trans (Nat.cast_le.mpr hnat)
  have hloglower (p : Fin 5 → ℕ) (hp : p ∈ T) (i : Fin 5) :
      (9519 : ℝ) / 50000 ≤ α (p i) :=
    (Real.le_logb_iff_rpow_le hx (hpos p hp i)).mpr (hlower p hp i)
  have hlogupper (p : Fin 5 → ℕ) (hp : p ∈ T) (i : Fin 5) :
      α (p i) ≤ (6 : ℝ) / 25 := by
    apply (Real.logb_le_iff_le_rpow hx (hpos p hp i)).mpr
    have hnat := (Finset.mem_Icc.mp
      (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).1).2
    exact (Nat.cast_le.mpr hnat).trans (Nat.floor_le (by positivity))
  have hUoff (p : Fin 5 → ℕ) (hp : p ∈ T) :
      ([p 0, p 1, p 2] ∈ siftedPrimeTuples x (5 : Fin 6) ∧
        x ^ ((9519 : ℝ) / 50000) ≤ (p 3 : ℝ) ∧ p 3 ≤ p 4 ∧ p 2 ≠ p 1) ↔
      (α (p 1) < α (p 0) ∧ α (p 1) < α (p 2) ∧
        α (p 1) + α (p 2) < (40481 : ℝ) / 100000 ∧ α (p 3) ≤ α (p 4)) := by
    constructor
    · rintro ⟨hm, _h3, h34, hne⟩
      have hm' := (mem_siftedPrimeTuples_iff x hx (5 : Fin 6)
        [p 0, p 1, p 2]).mp hm
      dsimp only at hm'
      obtain ⟨_hp0, _hp1, _hp2, _h1, h10, _h0a, hle, hsum, _h0ζ⟩ := hm'
      have hnat : p 1 ≤ p 2 := Nat.cast_le.mp
        ((Real.logb_le_logb hx (hpos p hp 1) (hpos p hp 2)).mp hle)
      have hlt : p 1 < p 2 := by omega
      exact ⟨h10, (Real.logb_lt_logb_iff hx (hpos p hp 1) (hpos p hp 2)).mpr
        (Nat.cast_lt.mpr hlt), hsum,
        Real.logb_le_logb_of_le hx (hpos p hp 3) (Nat.cast_le.mpr h34)⟩
    · rintro ⟨h10, hlt, hsum, h34⟩
      have hnat : p 1 < p 2 := Nat.cast_lt.mp
        ((Real.logb_lt_logb_iff hx (hpos p hp 1) (hpos p hp 2)).mp hlt)
      refine ⟨?_, hlower p hp 3, ?_, by omega⟩
      · apply (mem_siftedPrimeTuples_iff x hx (5 : Fin 6)
          [p 0, p 1, p 2]).mpr
        exact ⟨hprime p hp 0, hprime p hp 1, hprime p hp 2, hloglower p hp 1,
          h10, (hlogupper p hp 0).trans_lt (by norm_num), hlt.le, hsum,
          (hlogupper p hp 0).trans_lt (by norm_num)⟩
      · exact Nat.cast_le.mp
          ((Real.logb_le_logb hx (hpos p hp 3) (hpos p hp 4)).mp h34)
  have horder (p : Fin 5 → ℕ) (hp : p ∈ T) (i k : Fin 5) :
      (α (p i) < α (p k) ↔ (p i : ℝ) / p k < 1) ∧
      (α (p i) ≤ α (p k) ↔ (p i : ℝ) / p k ≤ 1) := by
    dsimp only [α]
    rw [Real.logb_lt_logb_iff hx (hpos p hp i) (hpos p hp k),
      Real.logb_le_logb hx (hpos p hp i) (hpos p hp k),
      div_lt_one (hpos p hp k), div_le_one (hpos p hp k)]
    exact ⟨Iff.rfl, Iff.rfl⟩
  have hupp (p : Fin 5 → ℕ) (hp : p ∈ T) (i : Fin 5) (t : ℝ) :
      α (p i) ≤ t ↔ (p i : ℝ) ≤ x ^ t :=
    Real.logb_le_iff_le_rpow hx (hpos p hp i)
  have hpair (p : Fin 5 → ℕ) (hp : p ∈ T) (i k : Fin 5) (t : ℝ) :
      α (p i) + α (p k) < t ↔ (p i : ℝ) * p k < x ^ t := by
    dsimp only [α]
    rw [← Real.logb_mul (hpos p hp i).ne' (hpos p hp k).ne',
      Real.logb_lt_iff_lt_rpow hx (mul_pos (hpos p hp i) (hpos p hp k))]
  have htriple (p : Fin 5 → ℕ) (hp : p ∈ T) (i k l : Fin 5) (t : ℝ) :
      t < α (p i) + α (p k) + α (p l) ↔ x ^ t < (p i : ℝ) * p k * p l := by
    dsimp only [α]
    rw [← Real.logb_mul (hpos p hp i).ne' (hpos p hp k).ne',
      ← Real.logb_mul (mul_pos (hpos p hp i) (hpos p hp k)).ne' (hpos p hp l).ne',
      Real.lt_logb_iff_rpow_lt hx (mul_pos (mul_pos (hpos p hp i) (hpos p hp k))
        (hpos p hp l))]
  clear_value P T
  intro p hp q hq hbits
  have hbandlo : (x ≤ ((∏ i, p i : ℕ) : ℝ)) ↔
      x ≤ ((∏ i, q i : ℕ) : ℝ) := by
    have hb := hbits ⟨Finset.univ, ∅, x, true, false⟩
      (hbase _ (by simp [minorantMonomialCuts]))
    simpa [MinorantMonomialCut.value, Nat.cast_prod] using hb
  have hbandhi : (((∏ i, p i : ℕ) : ℝ) ≤ 2 * x) ↔
      ((∏ i, q i : ℕ) : ℝ) ≤ 2 * x := by
    have hb := hbits ⟨Finset.univ, ∅, 2 * x, false, false⟩
      (hbase _ (by simp [minorantMonomialCuts]))
    simpa [MinorantMonomialCut.value, Nat.cast_prod] using hb
  have h10 : (α (p 1) < α (p 0)) ↔ α (q 1) < α (q 0) := by
    rw [(horder p hp 1 0).1, (horder q hq 1 0).1]
    simpa [MinorantMonomialCut.value] using hbits ⟨{1}, {0}, 1, false, true⟩
      (hbase _ (by simp [minorantMonomialCuts]))
  have hlt12 : (α (p 1) < α (p 2)) ↔ α (q 1) < α (q 2) := by
    rw [(horder p hp 1 2).1, (horder q hq 1 2).1]
    simpa [MinorantMonomialCut.value] using hbits ⟨{1}, {2}, 1, false, true⟩
      (hbase _ (by simp [minorantMonomialCuts]))
  have h34 : (α (p 3) ≤ α (p 4)) ↔ α (q 3) ≤ α (q 4) := by
    rw [(horder p hp 3 4).2, (horder q hq 3 4).2]
    simpa [MinorantMonomialCut.value] using hbits ⟨{3}, {4}, 1, false, false⟩
      (hbase _ (by simp [minorantMonomialCuts]))
  have hsum12 : (α (p 1) + α (p 2) < (40481 : ℝ) / 100000) ↔
      α (q 1) + α (q 2) < (40481 : ℝ) / 100000 := by
    rw [hpair p hp, hpair q hq]
    simpa [MinorantMonomialCut.value] using hbits _ h12
  have hsum02 : (α (p 0) + α (p 2) < (40481 : ℝ) / 100000) ↔
      α (q 0) + α (q 2) < (40481 : ℝ) / 100000 := by
    rw [hpair p hp, hpair q hq]
    simpa [MinorantMonomialCut.value] using
      hbits ⟨{0, 2}, ∅, x ^ ((40481 : ℝ) / 100000), false, true⟩
        (hbase _ (by simp [minorantMonomialCuts]))
  have hsum123 : ((59519 : ℝ) / 100000 < α (p 1) + α (p 2) + α (p 3)) ↔
      (59519 : ℝ) / 100000 < α (q 1) + α (q 2) + α (q 3) := by
    rw [htriple p hp, htriple q hq]
    simpa [MinorantMonomialCut.value, mul_assoc] using hbits _ h123
  have hu (i : Fin 5) :
      (α (p i) ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ↔
      α (q i) ≤ 1 - 4 * ((9519 : ℝ) / 50000) := by
    rw [hupp p hp, hupp q hq]
    simpa [MinorantMonomialCut.value] using
      hbits ⟨{i}, ∅, x ^ (1 - 4 * ((9519 : ℝ) / 50000)), false, false⟩
        (hbase _ (by simp [minorantMonomialCuts]))
  have hE : E p ↔ E q := by
    dsimp only [E]
    simp only [hloglower p hp, hloglower q hq, true_and]
    exact and_congr (forall_congr' hu)
      (and_congr h10 (and_congr hlt12 (and_congr hsum02 (and_congr hsum123 h34))))
  have hU := and_congr h10 (and_congr hlt12 (and_congr hsum12 h34))
  have hU' := (hUoff p hp).trans (hU.trans (hUoff q hq).symm)
  dsimp only [C]
  constructor
  · rintro ⟨hlo, hhi, hm, h3, h34p, he, hne⟩
    obtain ⟨hmq, h3q, h34q, hneq⟩ := hU'.mp ⟨hm, h3, h34p, hne⟩
    exact ⟨hbandlo.mp hlo, hbandhi.mp hhi, hmq, h3q, h34q,
      fun h => he (hE.mpr h), hneq⟩
  · rintro ⟨hlo, hhi, hm, h3, h34q, he, hne⟩
    obtain ⟨hmp, h3p, h34p, hnep⟩ := hU'.mpr ⟨hm, h3, h34q, hne⟩
    exact ⟨hbandlo.mpr hlo, hbandhi.mpr hhi, hmp, h3p, h34p,
      fun h => he (hE.mp h), hnep⟩

open Classical in
theorem finite_five_diagonal_pushforward
    (P : Finset ℕ) (C : (Fin 5 → ℕ) → Prop) :
    (∑ q ∈ Fintype.piFinset (fun _ : Fin 5 => P),
      Finsupp.single (∏ i, q i) (if C q ∧ q 2 = q 1 then (1 : ℂ) else 0)) =
    ∑ p ∈ P, ∑ r ∈ Fintype.piFinset (fun _ : Fin 3 => P),
      Finsupp.single (p ^ 2 * ∏ i, r i)
        (if C ![r 0, p, p, r 1, r 2] then (1 : ℂ) else 0) := by
  let T := Fintype.piFinset (fun _ : Fin 5 => P)
  let R := Fintype.piFinset (fun _ : Fin 3 => P)
  let D := T.filter (fun q => q 2 = q 1)
  let pack (u : ℕ × (Fin 3 → ℕ)) : Fin 5 → ℕ :=
    ![u.2 0, u.1, u.1, u.2 1, u.2 2]
  have hpack (p : ℕ) (r : Fin 3 → ℕ) :
      (∏ i, pack (p, r) i) = p ^ 2 * ∏ i, r i := by
    simp only [Fin.prod_univ_succ]
    change r 0 * (p * (p * (r 1 * (r 2 * 1)))) =
      p ^ 2 * (r 0 * (r 1 * (r 2 * 1)))
    ring
  calc
    _ = ∑ q ∈ D, Finsupp.single (∏ i, q i) (if C q then (1 : ℂ) else 0) := by
      rw [Finset.sum_filter]
      apply Finset.sum_congr rfl
      intro q _hq
      by_cases hC : C q <;> by_cases hd : q 2 = q 1 <;> simp [hC, hd]
    _ = ∑ u ∈ P.product R,
        Finsupp.single (u.1 ^ 2 * ∏ i, u.2 i) (if C (pack u) then (1 : ℂ) else 0) := by
      symm
      refine Finset.sum_bij (fun u _ => pack u) ?_ ?_ ?_ ?_
      · intro u hu
        obtain ⟨hp, hr⟩ := Finset.mem_product.mp hu
        apply Finset.mem_filter.mpr
        refine ⟨Fintype.mem_piFinset.mpr ?_, rfl⟩
        intro i
        fin_cases i
        · exact Fintype.mem_piFinset.mp hr 0
        · exact hp
        · exact hp
        · exact Fintype.mem_piFinset.mp hr 1
        · exact Fintype.mem_piFinset.mp hr 2
      · intro u _hu v _hv heq
        apply Prod.ext
        · exact congrFun heq 1
        · funext i
          fin_cases i
          · exact congrFun heq 0
          · exact congrFun heq 3
          · exact congrFun heq 4
      · intro q hq
        obtain ⟨hqT, hdiag⟩ := Finset.mem_filter.mp hq
        let r : Fin 3 → ℕ := ![q 0, q 3, q 4]
        refine ⟨(q 1, r), Finset.mem_product.mpr ⟨Fintype.mem_piFinset.mp hqT 1, ?_⟩, ?_⟩
        · apply Fintype.mem_piFinset.mpr
          intro i
          fin_cases i
          · exact Fintype.mem_piFinset.mp hqT 0
          · exact Fintype.mem_piFinset.mp hqT 3
          · exact Fintype.mem_piFinset.mp hqT 4
        · funext i
          fin_cases i
          · rfl
          · rfl
          · exact hdiag.symm
          · rfl
          · rfl
      · intro u _hu
        rw [hpack]
    _ = _ := by rw [Finset.product_eq_sprod, Finset.sum_product]

open Classical in
theorem finite_three_tuple_cut_coefficient_bound
    (P : Finset ℕ) (C : (Fin 3 → ℕ) → Prop) (m : ℕ) (hm : 0 < m) :
    ‖∑ r ∈ Fintype.piFinset (fun _ : Fin 3 => P),
      if (∏ i, r i) = m ∧ C r then (1 : ℂ) else 0‖ ≤
        (m.divisors.card : ℝ) ^ 3 := by
  let T := (Fintype.piFinset (fun _ : Fin 3 => P)).filter
    (fun r => (∏ i, r i) = m ∧ C r)
  have heq : (∑ r ∈ Fintype.piFinset (fun _ : Fin 3 => P),
      if (∏ i, r i) = m ∧ C r then (1 : ℂ) else 0) = (T.card : ℂ) := by
    simp only [T, Finset.sum_boole]
  have hsub : T ⊆ Fintype.piFinset (fun _ : Fin 3 => m.divisors) := by
    intro r hr
    have hprod := (Finset.mem_filter.mp hr).2.1
    apply Fintype.mem_piFinset.mpr
    intro i
    refine Nat.mem_divisors.mpr ⟨?_, hm.ne'⟩
    rw [← hprod]
    exact Finset.dvd_prod_of_mem r (Finset.mem_univ i)
  rw [heq, Complex.norm_natCast]
  have hcard := Finset.card_le_card hsub
  rw [Fintype.card_piFinset_const] at hcard
  exact_mod_cast hcard

open Classical in
theorem finite_five_diagonal_square_cofactor
    (x : ℝ) (P : Finset ℕ) (hP : ∀ p ∈ P, 0 < p)
    (C : (Fin 5 → ℕ) → Prop)
    (hsupport : ∀ q ∈ Fintype.piFinset (fun _ : Fin 5 => P), C q →
      ((∏ i, q i : ℕ) : ℝ) ≤ 2 * x)
    (hrepeated : ∀ q ∈ Fintype.piFinset (fun _ : Fin 5 => P),
      C q → q 2 = q 1 → (q 1 : ℝ) ≤ x ^ ((40481 : ℝ) / 200000)) :
    let D : Finset ℕ := P.filter (fun p : ℕ => (p : ℝ) ≤ x ^ ((40481 : ℝ) / 200000))
    let R := Fintype.piFinset (fun _ : Fin 3 => P)
    let u (p m : ℕ) : ℂ := ∑ r ∈ R,
      if (∏ i, r i) = m ∧ C ![r 0, p, p, r 1, r 2] then 1 else 0
    (∑ q ∈ Fintype.piFinset (fun _ : Fin 5 => P),
      Finsupp.single (∏ i, q i) (if C q ∧ q 2 = q 1 then (1 : ℂ) else 0)) =
      Finset.sum D (fun p : ℕ =>
        Finset.sum (Finset.Icc 1 ⌈2 * x / (p : ℝ) ^ 2⌉₊) (fun m : ℕ =>
          Finsupp.single (p ^ 2 * m) (u p m))) := by
  intro D R u
  let pack (p : ℕ) (r : Fin 3 → ℕ) : Fin 5 → ℕ := ![r 0, p, p, r 1, r 2]
  have hpack_mem (p : ℕ) (hp : p ∈ P) (r : Fin 3 → ℕ) (hr : r ∈ R) :
      pack p r ∈ Fintype.piFinset (fun _ : Fin 5 => P) := by
    apply Fintype.mem_piFinset.mpr
    intro i
    fin_cases i
    · exact Fintype.mem_piFinset.mp hr 0
    · exact hp
    · exact hp
    · exact Fintype.mem_piFinset.mp hr 1
    · exact Fintype.mem_piFinset.mp hr 2
  have hprod (p : ℕ) (r : Fin 3 → ℕ) :
      (∏ i, pack p r i) = p ^ 2 * ∏ i, r i := by
    simp only [Fin.prod_univ_succ]
    change r 0 * (p * (p * (r 1 * (r 2 * 1)))) =
      p ^ 2 * (r 0 * (r 1 * (r 2 * 1)))
    ring
  rw [finite_five_diagonal_pushforward]
  calc
    _ = ∑ p ∈ D, ∑ r ∈ R,
        Finsupp.single (p ^ 2 * ∏ i, r i)
          (if C (pack p r) then (1 : ℂ) else 0) := by
      symm
      apply Finset.sum_subset (Finset.filter_subset _ _)
      intro p hp hpD
      apply Finset.sum_eq_zero
      intro r hr
      have hnot : ¬C (pack p r) := by
        intro hC
        exact hpD (Finset.mem_filter.mpr ⟨hp,
          hrepeated (pack p r) (hpack_mem p hp r hr) hC rfl⟩)
      simp only [ite_eq_right hnot, Finsupp.single_zero]
    _ = _ := by
      apply Finset.sum_congr rfl
      intro p hpD
      have hpP := (Finset.mem_filter.mp hpD).1
      have hp0 : 0 < (p : ℝ) := Nat.cast_pos.mpr (hP p hpP)
      let M := Finset.Icc 1 ⌈2 * x / ((p : ℕ) : ℝ) ^ 2⌉₊
      have hmember (r : Fin 3 → ℕ) (hr : r ∈ R) (hC : C (pack p r)) :
          (∏ i, r i) ∈ M := by
        have hr0 : 0 < ∏ i, r i := Finset.prod_pos fun i _ =>
          hP (r i) (Fintype.mem_piFinset.mp hr i)
        refine Finset.mem_Icc.mpr ⟨hr0, ?_⟩
        have hreal : ((∏ i, r i : ℕ) : ℝ) ≤ 2 * x / (p : ℝ) ^ 2 := by
          apply (le_div_iff₀ (pow_pos hp0 2)).mpr
          have hh := hsupport (pack p r) (hpack_mem p hpP r hr) hC
          rw [hprod, Nat.cast_mul, Nat.cast_pow] at hh
          nlinarith only [hh]
        exact_mod_cast hreal.trans (Nat.le_ceil (2 * x / (p : ℝ) ^ 2))
      change (∑ r ∈ R, Finsupp.single (p ^ 2 * ∏ i, r i)
        (if C (pack p r) then (1 : ℂ) else 0)) =
          ∑ m ∈ M, Finsupp.single (p ^ 2 * m)
            (∑ r ∈ R, if (∏ i, r i) = m ∧ C (pack p r) then (1 : ℂ) else 0)
      simp_rw [Finsupp.single_finsetSum]
      rw [Finset.sum_comm]
      apply Finset.sum_congr rfl
      intro r hr
      by_cases hC : C (pack p r)
      · symm
        calc
          _ = Finsupp.single (p ^ 2 * ∏ i, r i)
              (if (∏ i, r i) = ∏ i, r i ∧ C (pack p r) then (1 : ℂ) else 0) := by
            apply Finset.sum_eq_single_of_mem (∏ i, r i) (hmember r hr hC)
            intro m _hm hne
            simp only [and_iff_left hC, ite_eq_right (Ne.symm hne), Finsupp.single_zero]
          _ = _ := by simp only [hC, and_true, ite_true]
      · simp only [hC, and_false, ite_false, Finsupp.single_zero, Finset.sum_const_zero]

/--
The multiplicative generating function for choosing one prime from each closed interval `[L i, U
i]` with `i ∈ s`. Its coefficient at `n` counts choices whose product is `n`.
-/
noncomputable def primeIntervalBoxAlgebra {k : ℕ}
    (L U : Fin k → ℝ) (s : Finset (Fin k)) : MonoidAlgebra ℂ ℕ := by
  classical
  exact ∏ i ∈ s, ∑ p ∈ (Finset.Icc ⌈L i⌉₊ ⌊U i⌋₊).filter Nat.Prime,
    MonoidAlgebra.single p (1 : ℂ)

theorem geometric_monomial_test_crossing
    (h : ℝ) (hh : 0 < h) (d : MinorantMonomialCut) (hd : 0 ≤ d.threshold)
    (p q : Fin 5 → ℕ) (hp : ∀ i, 1 ≤ p i) (hq : ∀ i, 1 ≤ q i)
    (hlabel : ∀ i, ⌊Real.logb (1 + h) (p i : ℝ)⌋₊ =
      ⌊Real.logb (1 + h) (q i : ℝ)⌋₊)
    (hchange : ¬((if d.lower then
        if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
      else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
      (if d.lower then
        if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
      else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold))) :
    (d.threshold / (1 + h) ^ (d.numerator.card + d.denominator.card) ≤ d.value p ∧
      d.value p ≤ d.threshold * (1 + h) ^ (d.numerator.card + d.denominator.card)) ∧
    (d.threshold / (1 + h) ^ (d.numerator.card + d.denominator.card) ≤ d.value q ∧
      d.value q ≤ d.threshold * (1 + h) ^ (d.numerator.card + d.denominator.card)) := by
  have hcompare := geometric_monomial_comparison h hh p q hp hq hlabel d
  apply threshold_bands_of_crossing _ _ _ _ hd
    (one_le_pow₀ (by linarith)) hcompare.1 hcompare.2
  rw [not_iff, iff_iff_and_or_not_and_not] at hchange
  cases hl : d.lower <;> cases hs : d.strict <;>
    simp only [hl, hs, Bool.false_eq_true, ite_false, ite_true,
      not_le, not_lt] at hchange <;>
    rcases hchange with ⟨hp, hq⟩ | ⟨hp, hq⟩ <;>
    first | exact Or.inl ⟨by linarith, by linarith⟩
          | exact Or.inr ⟨by linarith, by linarith⟩

open Classical in
theorem boolean_monomial_mixed_geometric_box_card
    (x h : ℝ) (hx : 2 ≤ x) (hh : 0 < h) (hh1 : h ≤ 1)
    (M : Finset MinorantMonomialCut) (C : (Fin 5 → ℕ) → Prop)
    (hM : ∀ d ∈ M, d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
      d.numerator.card + d.denominator.card ≤ 5 ∧ 0 < d.threshold) :
    let P : Finset ℕ :=
      (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((6 : ℝ) / 25)⌋₊).filter Nat.Prime
    let T := Fintype.piFinset (fun _ : Fin 5 => P)
    (∀ p ∈ T, ∀ q ∈ T,
      (∀ d ∈ M,
        (if d.lower then
          if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
        else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
        (if d.lower then
          if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
        else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
      (C p ↔ C q)) →
    (∀ p ∈ T, C p → ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x) →
    let label (p : Fin 5 → ℕ) : Fin 5 → ℕ :=
      fun i => ⌊Real.logb (1 + h) (p i : ℝ)⌋₊
    let U (b : Fin 5 → ℕ) := T.filter (fun p => label p = b)
    let D := (T.image label).filter
      (fun b => (∃ p ∈ U b, C p) ∧ ¬∀ p ∈ U b, C p)
    (∑ b ∈ D, ((U b).card : ℝ)) ≤
      (M.card : ℝ) * 64 *
        (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
          (1 + Real.log (64 * x)) ^ 16 := by
  intro P T hboolean hsupport label U D
  let S := T.filter (fun q => label q ∈ D)
  let R (d : MinorantMonomialCut) : ℝ := (1 + h) ^
    (d.numerator.card + d.denominator.card)
  let E (d : MinorantMonomialCut) := S.filter
    (fun q => d.threshold / R d ≤ d.value q ∧ d.value q ≤ d.threshold * R d)
  let V : ℝ := 64 * (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
    (1 + Real.log (64 * x)) ^ 16
  have hpositive (p : Fin 5 → ℕ) (hp : p ∈ T) (i : Fin 5) : 1 ≤ p i := by
    have hprime : (p i).Prime :=
      (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).2
    exact hprime.one_lt.le
  have hlower (p : Fin 5 → ℕ) (hp : p ∈ T) (i : Fin 5) :
      x ^ ((9519 : ℝ) / 50000) ≤ (p i : ℝ) := by
    have hnat := (Finset.mem_Icc.mp
      (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).1).1
    exact (Nat.le_ceil _).trans (Nat.cast_le.mpr hnat)
  have hchanged (p q : Fin 5 → ℕ) (hp : p ∈ T) (hq : q ∈ T)
      (hlab : ∀ i, ⌊Real.logb (1 + h) (p i : ℝ)⌋₊ =
        ⌊Real.logb (1 + h) (q i : ℝ)⌋₊) (hpass : C p) (hfail : ¬C q) :
      ∃ d ∈ M,
        (d.threshold / R d ≤ d.value p ∧ d.value p ≤ d.threshold * R d) ∧
        (d.threshold / R d ≤ d.value q ∧ d.value q ≤ d.threshold * R d) := by
    have hex : ∃ d ∈ M, ¬((if d.lower then
          if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
        else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
        (if d.lower then
          if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
        else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) := by
      by_contra! hnone
      exact hfail ((hboolean p hp q hq hnone).mp hpass)
    obtain ⟨d, hd, hchange⟩ := hex
    exact ⟨d, hd, geometric_monomial_test_crossing h hh d (hM d hd).2.2.2.le
      p q (hpositive p hp) (hpositive q hq) hlab hchange⟩
  have hboundary (q : Fin 5 → ℕ) (hq : q ∈ S) :
      ((∏ i, q i : ℕ) : ℝ) ≤ 64 * x ∧
        ∃ d ∈ M, d.threshold / R d ≤ d.value q ∧ d.value q ≤ d.threshold * R d := by
    obtain ⟨hqT, hqD⟩ := Finset.mem_filter.mp hq
    have hmix := (Finset.mem_filter.mp hqD).2
    obtain ⟨p₀, hp₀, hpass⟩ := hmix.1
    have hex : ∃ p₁ ∈ U (label q), ¬C p₁ := by
      simpa only [not_forall, exists_prop] using hmix.2
    obtain ⟨p₁, hp₁, hfail⟩ := hex
    have hp₀T : p₀ ∈ T := (Finset.mem_filter.mp hp₀).1
    have hp₁T : p₁ ∈ T := (Finset.mem_filter.mp hp₁).1
    have hlab₀ (i : Fin 5) :
        ⌊Real.logb (1 + h) (p₀ i : ℝ)⌋₊ =
          ⌊Real.logb (1 + h) (q i : ℝ)⌋₊ :=
      congrFun (Finset.mem_filter.mp hp₀).2 i
    have hlab₁ (i : Fin 5) :
        ⌊Real.logb (1 + h) (p₁ i : ℝ)⌋₊ =
          ⌊Real.logb (1 + h) (q i : ℝ)⌋₊ :=
      congrFun (Finset.mem_filter.mp hp₁).2 i
    refine ⟨geometric_five_box_product_bound h x hh hh1 p₀ q
      (hpositive p₀ hp₀T) (hpositive q hqT) hlab₀ (hsupport p₀ hp₀T hpass), ?_⟩
    by_cases hqpass : C q
    · obtain ⟨d, hd, hb, _⟩ := hchanged q p₁ hqT hp₁T
        (fun i => (hlab₁ i).symm) hqpass hfail
      exact ⟨d, hd, hb⟩
    · obtain ⟨d, hd, _, hb⟩ := hchanged p₀ q hp₀T hqT hlab₀ hpass hqpass
      exact ⟨d, hd, hb⟩
  have hE (d : MinorantMonomialCut) (hd : d ∈ M) : ((E d).card : ℝ) ≤ V := by
    have hdata := hM d hd
    obtain ⟨i, hi⟩ := hdata.1
    have hid : i ∉ d.denominator := fun hb => Finset.disjoint_left.mp hdata.2.1 hi hb
    have hR : 1 ≤ R d := one_le_pow₀ (by linarith)
    have hR0 : 0 < R d := zero_lt_one.trans_le hR
    let t (r : Fin 4 → ℕ) := d.threshold / d.value (i.insertNth 1 r)
    let L (r : Fin 4 → ℕ) := t r / R d
    let U₀ (r : Fin 4 → ℕ) := min (t r * R d) (64 * x / ((∏ k, r k : ℕ) : ℝ))
    have hwidth (r : Fin 4 → ℕ) (hr : ∀ k, 0 < r k) :
        U₀ r - L r ≤ (1023 * h) * (64 * x / ((∏ k, r k : ℕ) : ℝ)) := by
      have hbase : ∀ k : Fin 5,
          0 < ((Fin.insertNth (α := fun _ : Fin 5 => ℕ) i 1 r k : ℕ) : ℝ) := by
        rw [Fin.forall_iff_succAbove i]
        simpa using hr
      have ht : 0 ≤ t r :=
        div_nonneg hdata.2.2.2.le
          (div_nonneg (Finset.prod_nonneg fun k _ => (hbase k).le)
            (Finset.prod_nonneg fun k _ => (hbase k).le))
      have hZ : 0 ≤ 64 * x / ((∏ k, r k : ℕ) : ℝ) := by positivity
      exact (monomial_clipped_band_width (t r) (R d) _ ht hR hZ).trans
        (mul_le_mul_of_nonneg_right
          (geometric_degree_five_width h hh.le hh1 _ hdata.2.2.1) hZ)
    apply finite_five_tuple_monomial_boundary_count x (1023 * h) hx (by positivity)
      i (E d) L U₀
    · intro q hq
      obtain ⟨hqS, hband⟩ := Finset.mem_filter.mp hq
      have hqT := (Finset.mem_filter.mp hqS).1
      have hco : 0 < ((∏ k, i.removeNth q k : ℕ) : ℝ) := by
        exact_mod_cast Finset.prod_pos fun k _ =>
          zero_lt_one.trans_le (hpositive q hqT (i.succAbove k))
      have hsupport : (q i : ℝ) ≤ 64 * x / ((∏ k, i.removeNth q k : ℕ) : ℝ) := by
        rw [le_div_iff₀ hco]
        have heq : (q i : ℝ) * ((∏ k, i.removeNth q k : ℕ) : ℝ) =
            ((∏ k, q k : ℕ) : ℝ) := by exact_mod_cast Fin.mul_prod_removeNth i q
        rw [heq]
        exact (hboundary q hqS).1
      exact ⟨hlower q hqT, (hboundary q hqS).1,
        d.closed_coordinate_band i hi hid q
          (fun k => zero_lt_one.trans_le (hpositive q hqT k))
          (R d) _ hR0 hsupport hband⟩
    · intro r hr _hprod
      exact hwidth r hr
  have hcover : S ⊆ M.biUnion E := by
    intro q hq
    obtain ⟨d, hd, hband⟩ := (hboundary q hq).2
    exact Finset.mem_biUnion.mpr ⟨d, hd, Finset.mem_filter.mpr ⟨hq, hband⟩⟩
  have hcard : (S.card : ℝ) = ∑ b ∈ D, ((U b).card : ℝ) := by
    have hc : S.card = ∑ b ∈ D, (U b).card := by
      calc
        _ = ∑ b ∈ D, (S.filter (fun q => label q = b)).card :=
          Finset.card_eq_sum_card_fiberwise (fun q hq => (Finset.mem_filter.mp hq).2)
        _ = _ := by
          apply Finset.sum_congr rfl
          intro b hb
          congr 1
          ext q
          by_cases heq : label q = b <;> simp [S, U, heq, hb]
    exact_mod_cast hc
  rw [← hcard]
  calc
    _ ≤ ∑ d ∈ M, ((E d).card : ℝ) := by
      exact_mod_cast (Finset.card_le_card hcover).trans Finset.card_biUnion_le
    _ ≤ ∑ _d ∈ M, V := Finset.sum_le_sum hE
    _ = (M.card : ℝ) * V := by simp
    _ = _ := by dsimp [V]; ring

theorem sum_finMulAntidiag_succ_weighted
    {A : Type*} [AddCommMonoid A] (k n : ℕ) (w : (Fin (k + 1) → ℕ) → A) :
    (∑ p ∈ Nat.finMulAntidiag (k + 1) n, w p) =
      ∑ d ∈ n.divisorsAntidiagonal, ∑ p ∈ Nat.finMulAntidiag k d.2,
        w (Fin.cons d.1 p) := by
  classical
  calc
    _ = ∑ t ∈ n.divisorsAntidiagonal.sigma (fun d => Nat.finMulAntidiag k d.2),
        w (Fin.cons t.1.1 t.2) := by
      refine Finset.sum_nbij'
        (fun p => ⟨(p 0, ∏ i, Fin.tail p i), Fin.tail p⟩)
        (fun t => Fin.cons t.1.1 t.2) ?_ ?_ ?_ ?_ ?_
      · intro p hp
        have hd : (p 0, ∏ i, Fin.tail p i) ∈ n.divisorsAntidiagonal :=
          Nat.mem_divisorsAntidiagonal.mpr
            ⟨(Fin.prod_univ_succ p).symm.trans (Nat.mem_finMulAntidiag.mp hp).1,
              (Nat.mem_finMulAntidiag.mp hp).2⟩
        exact Finset.mem_sigma.mpr ⟨hd, Nat.mem_finMulAntidiag.mpr
          ⟨rfl, Nat.right_ne_zero_of_mem_divisorsAntidiagonal hd⟩⟩
      · rintro ⟨⟨a, b⟩, p⟩ hp
        rcases Finset.mem_sigma.mp hp with ⟨hd, hp⟩
        rcases Nat.mem_divisorsAntidiagonal.mp hd with ⟨hd, hn⟩
        refine Nat.mem_finMulAntidiag.mpr ⟨?_, hn⟩
        rw [Fin.prod_cons, (Nat.mem_finMulAntidiag.mp hp).1]
        exact hd
      · intro p _
        exact Fin.cons_self_tail p
      · rintro ⟨⟨a, b⟩, p⟩ hp
        have hprod := (Nat.mem_finMulAntidiag.mp (Finset.mem_sigma.mp hp).2).1
        simp only [Fin.cons_zero, Fin.tail_cons, hprod]
      · intro p _
        rw [Fin.cons_self_tail]
    _ = _ := (Finset.sum_sigma' n.divisorsAntidiagonal
      (fun d => Nat.finMulAntidiag k d.2) (fun d p => w (Fin.cons d.1 p))).symm

theorem sum_finMulAntidiag_one_weighted
    {A : Type*} [AddCommMonoid A] (n : ℕ) (hn : n ≠ 0) (w : (Fin 1 → ℕ) → A) :
    (∑ p ∈ Nat.finMulAntidiag 1 n, w p) = w (fun _ => n) := by
  classical
  have hs : Nat.finMulAntidiag 1 n = {fun _ => n} := by
    ext p
    simp only [Nat.mem_finMulAntidiag, Finset.mem_singleton]
    constructor
    · rintro ⟨hp, _⟩
      funext i
      have hi : i = 0 := Subsingleton.elim _ _
      rw [hi]
      simpa only [Fin.prod_univ_one] using hp
    · rintro rfl
      exact ⟨by simp, hn⟩
  rw [hs, Finset.sum_singleton]

theorem sum_four_divisorsAntidiagonal
    {A : Type*} [AddCommMonoid A] (n : ℕ) (w : (Fin 5 → ℕ) → A) :
    (∑ d ∈ n.divisorsAntidiagonal, ∑ e ∈ d.2.divisorsAntidiagonal,
      ∑ f ∈ e.2.divisorsAntidiagonal, ∑ g ∈ f.2.divisorsAntidiagonal,
        w ![d.1, e.1, f.1, g.1, g.2]) =
      ∑ p ∈ Nat.finMulAntidiag 5 n, w p := by
  classical
  symm
  rw [sum_finMulAntidiag_succ_weighted]
  apply Finset.sum_congr rfl
  intro d _
  rw [sum_finMulAntidiag_succ_weighted]
  apply Finset.sum_congr rfl
  intro e _
  rw [sum_finMulAntidiag_succ_weighted]
  apply Finset.sum_congr rfl
  intro f _
  rw [sum_finMulAntidiag_succ_weighted]
  apply Finset.sum_congr rfl
  intro g hg
  rw [sum_finMulAntidiag_one_weighted _
    (Nat.right_ne_zero_of_mem_divisorsAntidiagonal hg)]
  congr 1
  funext i
  fin_cases i <;> rfl

theorem prime_finMulAntidiag_eq_filter (n k : ℕ) :
    (Nat.finMulAntidiag k n).filter (fun p => ∀ i, (p i).Prime) =
      (Fintype.piFinset (fun _ : Fin k => Nat.primesLE n)).filter
        (fun p => (∏ i, p i) = n) := by
  classical
  ext p
  simp only [Finset.mem_filter, Nat.mem_finMulAntidiag, Fintype.mem_piFinset]
  constructor
  · rintro ⟨⟨hprod, hn⟩, hp⟩
    refine ⟨fun i => Nat.mem_primesLE.mpr ⟨?_, hp i⟩, hprod⟩
    apply Nat.le_of_dvd (Nat.pos_of_ne_zero hn)
    rw [← hprod]
    exact Finset.dvd_prod_of_mem p (Finset.mem_univ i)
  · rintro ⟨hp, hprod⟩
    refine ⟨⟨hprod, ?_⟩, fun i => (Nat.mem_primesLE.mp (hp i)).2⟩
    rw [← hprod]
    exact Finset.prod_ne_zero_iff.mpr (fun i _ => (Nat.mem_primesLE.mp (hp i)).2.ne_zero)

theorem sourceT5_eq_five {x : ℝ} (hx : 1 < x)
    (hg : 2 * x < x ^ (6 * ((9519 : ℝ) / 50000)))
    {n : ℕ} (hlo : x ≤ (n : ℝ)) (hhi : (n : ℝ) ≤ 2 * x) :
    sourceT5 x n =
      ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
        if (∏ i, p i) = n ∧
            (9519 : ℝ) / 50000 ≤ Real.logb x (p 3 : ℝ) ∧
            Real.logb x (p 3 : ℝ) < Real.logb x (p 2 : ℝ) ∧
            Real.logb x (p 2 : ℝ) < Real.logb x (p 1 : ℝ) ∧
            Real.logb x (p 1 : ℝ) < Real.logb x (p 0 : ℝ) ∧
            Real.logb x (p 0 : ℝ) < (40481 : ℝ) / 100000 ∧
            Real.logb x (p 0 : ℝ) + Real.logb x (p 1 : ℝ) < (40481 : ℝ) / 100000 ∧
            (p 3 : ℝ) ≤ (p 4 : ℝ)
        then (1 : ℝ) else 0 := by
  classical
  let C (p : Fin 5 → ℕ) : Prop :=
    (9519 : ℝ) / 50000 ≤ Real.logb x (p 3 : ℝ) ∧
      Real.logb x (p 3 : ℝ) < Real.logb x (p 2 : ℝ) ∧
      Real.logb x (p 2 : ℝ) < Real.logb x (p 1 : ℝ) ∧
      Real.logb x (p 1 : ℝ) < Real.logb x (p 0 : ℝ) ∧
      Real.logb x (p 0 : ℝ) < (40481 : ℝ) / 100000 ∧
      Real.logb x (p 0 : ℝ) + Real.logb x (p 1 : ℝ) < (40481 : ℝ) / 100000
  have hsource : sourceT5 x n =
      ∑ p ∈ Nat.finMulAntidiag 5 n,
        if (p 0).Prime ∧ (p 1).Prime ∧ (p 2).Prime ∧ (p 3).Prime ∧ C p
        then roughWeight (p 3 : ℝ) (p 4) else 0 := by
    rw [← sum_four_divisorsAntidiagonal]
    simp only [sourceT5, ArithmeticFunction.coe_mk, C, Matrix.cons_val]
    apply Finset.sum_congr rfl
    intro d _
    apply Finset.sum_congr rfl
    intro e _
    apply Finset.sum_congr rfl
    intro f _
    apply Finset.sum_congr rfl
    intro g _
    exact if_congr Iff.rfl rfl rfl
  rw [hsource]
  calc
    _ = ∑ p ∈ Nat.finMulAntidiag 5 n,
        if (∀ i, (p i).Prime) ∧ C p ∧ (p 3 : ℝ) ≤ (p 4 : ℝ)
        then (1 : ℝ) else 0 := by
      refine Finset.sum_congr rfl ?_
      intro p hp
      by_cases h : (p 0).Prime ∧ (p 1).Prime ∧ (p 2).Prime ∧ (p 3).Prime ∧ C p
      · rcases h with ⟨h0, h1, h2, h3, hc⟩
        have hrough :
            (p 4 ≠ 0 ∧ ∀ q ∈ (p 4).primeFactors, (p 3 : ℝ) ≤ (q : ℝ)) ↔
              (p 4).Prime ∧ (p 3 : ℝ) ≤ (p 4 : ℝ) := by
          constructor
          · intro hr
            apply exceptional_residual_prime hx hg hlo hhi
              ![p 0, p 1, p 2, p 3] (by intro i; fin_cases i <;> assumption) (p 4)
              ?_ hc.1 hc.2.1 hc.2.2.1 hc.2.2.2.1 hc.2.2.2.2.2 hr
            simpa only [Fin.prod_univ_four, Fin.prod_univ_five, Matrix.cons_val] using
              (Nat.mem_finMulAntidiag.mp hp).1
          · rintro ⟨hr, hle⟩
            refine ⟨hr.ne_zero, ?_⟩
            simpa only [hr.primeFactors, Finset.mem_singleton, forall_eq] using hle
        have hprime : (∀ i : Fin 5, (p i).Prime) ↔ (p 4).Prime := by
          refine ⟨fun h => h 4, ?_⟩
          intro h4 i
          fin_cases i <;> assumption
        simp only [h0, h1, h2, h3, hc, and_self, ite_true, roughWeight, ArithmeticFunction.coe_mk,
          hrough, hprime, true_and]
      · have hnot : ¬ ((∀ i, (p i).Prime) ∧ C p ∧ (p 3 : ℝ) ≤ (p 4 : ℝ)) := by
          rintro ⟨hp, hc, _⟩
          exact h ⟨hp 0, hp 1, hp 2, hp 3, hc⟩
        rw [ite_eq_right h, ite_eq_right hnot]
    _ = ∑ p ∈ (Nat.finMulAntidiag 5 n).filter (fun p => ∀ i, (p i).Prime),
        if C p ∧ (p 3 : ℝ) ≤ (p 4 : ℝ) then (1 : ℝ) else 0 := by
      simp only [Finset.sum_filter, ite_and]
    _ = _ := by
      rw [prime_finMulAntidiag_eq_filter]
      simp only [Finset.sum_filter, ite_and, C]

theorem sourceT5_sub_exceptionalPrimeDefect_zero_eq_central
    {x : ℝ} (hx : 1 < x) (hg : 2 * x < x ^ (6 * ((9519 : ℝ) / 50000)))
    {n : ℕ} (hlo : x ≤ (n : ℝ)) (hhi : (n : ℝ) ≤ 2 * x) :
    sourceT5 x n - exceptionalPrimeDefect x 0 n =
      ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
        if (∏ i, p i) = n ∧
            (9519 : ℝ) / 50000 ≤ Real.logb x (p 3 : ℝ) ∧
            Real.logb x (p 3 : ℝ) < Real.logb x (p 2 : ℝ) ∧
            Real.logb x (p 2 : ℝ) < Real.logb x (p 1 : ℝ) ∧
            Real.logb x (p 1 : ℝ) < Real.logb x (p 0 : ℝ) ∧
            Real.logb x (p 0 : ℝ) < (40481 : ℝ) / 100000 ∧
            Real.logb x (p 0 : ℝ) + Real.logb x (p 1 : ℝ) < (40481 : ℝ) / 100000 ∧
            (p 3 : ℝ) ≤ (p 4 : ℝ) ∧
            (40481 : ℝ) / 100000 < Real.logb x (p 1 : ℝ) +
              Real.logb x (p 2 : ℝ) + Real.logb x (p 3 : ℝ) ∧
            Real.logb x (p 1 : ℝ) + Real.logb x (p 2 : ℝ) +
              Real.logb x (p 3 : ℝ) ≤ (59519 : ℝ) / 100000
        then (1 : ℝ) else 0 := by
  classical
  rw [sourceT5_eq_five hx hg hlo hhi, exceptionalPrimeDefect_zero_eq_five hx hg hlo hhi,
    ← Finset.sum_sub_distrib]
  refine Finset.sum_congr rfl ?_
  intro p _
  let C : Prop := (∏ i, p i) = n ∧
    (9519 : ℝ) / 50000 ≤ Real.logb x (p 3 : ℝ) ∧
    Real.logb x (p 3 : ℝ) < Real.logb x (p 2 : ℝ) ∧
    Real.logb x (p 2 : ℝ) < Real.logb x (p 1 : ℝ) ∧
    Real.logb x (p 1 : ℝ) < Real.logb x (p 0 : ℝ) ∧
    Real.logb x (p 0 : ℝ) < (40481 : ℝ) / 100000 ∧
    Real.logb x (p 0 : ℝ) + Real.logb x (p 1 : ℝ) < (40481 : ℝ) / 100000 ∧
    (p 3 : ℝ) ≤ (p 4 : ℝ)
  let t := Real.logb x (p 1 : ℝ) + Real.logb x (p 2 : ℝ) + Real.logb x (p 3 : ℝ)
  have hlow : C → (40481 : ℝ) / 100000 < t := by
    rintro ⟨_, h3, h32, h21, _⟩
    dsimp only [t]
    linarith
  have hbad :
      ((∏ i, p i) = n ∧ (9519 : ℝ) / 50000 ≤ Real.logb x (p 3 : ℝ) ∧
        Real.logb x (p 3 : ℝ) < Real.logb x (p 2 : ℝ) ∧
        Real.logb x (p 2 : ℝ) < Real.logb x (p 1 : ℝ) ∧
        Real.logb x (p 1 : ℝ) < Real.logb x (p 0 : ℝ) ∧
        Real.logb x (p 0 : ℝ) < (40481 : ℝ) / 100000 ∧
        Real.logb x (p 0 : ℝ) + Real.logb x (p 1 : ℝ) < (40481 : ℝ) / 100000 ∧
        (59519 : ℝ) / 100000 < t ∧ (p 3 : ℝ) ≤ (p 4 : ℝ)) ↔
      C ∧ (59519 : ℝ) / 100000 < t := by
    dsimp only [C]
    tauto
  have hgood :
      ((∏ i, p i) = n ∧ (9519 : ℝ) / 50000 ≤ Real.logb x (p 3 : ℝ) ∧
        Real.logb x (p 3 : ℝ) < Real.logb x (p 2 : ℝ) ∧
        Real.logb x (p 2 : ℝ) < Real.logb x (p 1 : ℝ) ∧
        Real.logb x (p 1 : ℝ) < Real.logb x (p 0 : ℝ) ∧
        Real.logb x (p 0 : ℝ) < (40481 : ℝ) / 100000 ∧
        Real.logb x (p 0 : ℝ) + Real.logb x (p 1 : ℝ) < (40481 : ℝ) / 100000 ∧
        (p 3 : ℝ) ≤ (p 4 : ℝ) ∧ (40481 : ℝ) / 100000 < t ∧ t ≤ (59519 : ℝ) / 100000) ↔
      C ∧ t ≤ (59519 : ℝ) / 100000 := by
    dsimp only [C] at hlow ⊢
    tauto
  change (if C then (1 : ℝ) else 0) - (if _ then 1 else 0) = (if _ then 1 else 0)
  dsimp only [t] at hbad hgood
  simp only [hbad, hgood]
  by_cases hc : C
  · by_cases ht : t ≤ (59519 : ℝ) / 100000
    · dsimp only [t] at ht
      simp [hc, ht, not_lt.mpr ht]
    · dsimp only [t] at ht
      simp [hc, ht, not_le.mp ht]
  · simp [hc]

/--
Five-tuples of primes from `[x^(9519 / 50000), x^(6 / 25)]` satisfying the ordered `T5`
conditions and the central restriction on the sum of exponents `1`, `2`, and `3`. The fourth
prime is no larger than the fifth.
-/
noncomputable def sourceT5CentralTuples (x : ℝ) : Finset (Fin 5 → ℕ) := by
  classical
  let P := (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
    (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime
  exact (Fintype.piFinset (fun _ : Fin 5 => P)).filter (fun p =>
    (9519 : ℝ) / 50000 ≤ Real.logb x (p 3 : ℝ) ∧
      Real.logb x (p 3 : ℝ) < Real.logb x (p 2 : ℝ) ∧
      Real.logb x (p 2 : ℝ) < Real.logb x (p 1 : ℝ) ∧
      Real.logb x (p 1 : ℝ) < Real.logb x (p 0 : ℝ) ∧
      Real.logb x (p 0 : ℝ) < (40481 : ℝ) / 100000 ∧
      Real.logb x (p 0 : ℝ) + Real.logb x (p 1 : ℝ) < (40481 : ℝ) / 100000 ∧
      (p 3 : ℝ) ≤ (p 4 : ℝ) ∧
      (40481 : ℝ) / 100000 < Real.logb x (p 1 : ℝ) +
        Real.logb x (p 2 : ℝ) + Real.logb x (p 3 : ℝ) ∧
      Real.logb x (p 1 : ℝ) + Real.logb x (p 2 : ℝ) +
        Real.logb x (p 3 : ℝ) ≤ (59519 : ℝ) / 100000)

theorem sourceT5_sub_exceptionalPrimeDefect_zero_weighted_compact :
    ∀ᶠ x : ℝ in Filter.atTop,
      ∀ u v : ℝ, 1 ≤ u → u ≤ v → v ≤ 2 → ∀ w : ℕ → ℝ,
        (∑ n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)),
          w n * (sourceT5 x n - exceptionalPrimeDefect x 0 n)) =
        ∑ p ∈ sourceT5CentralTuples x,
          if (∏ i, p i) ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x))
          then w (∏ i, p i) else 0 := by
  classical
  have hg := tendsto_rpow_atTop (by norm_num :
    (0 : ℝ) < (6 : ℝ) / 25 - (1 - 4 * ((9519 : ℝ) / 50000)))
  filter_upwards [eventually_exceptional_large, hg.eventually_ge_atTop 2] with x hx hgap
  intro u v hu huv hv w
  let P := (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
    (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime
  let Q := Nat.primesLE (Nat.floor (v * x))
  let C (p : Fin 5 → ℕ) : Prop :=
    (9519 : ℝ) / 50000 ≤ Real.logb x (p 3 : ℝ) ∧
      Real.logb x (p 3 : ℝ) < Real.logb x (p 2 : ℝ) ∧
      Real.logb x (p 2 : ℝ) < Real.logb x (p 1 : ℝ) ∧
      Real.logb x (p 1 : ℝ) < Real.logb x (p 0 : ℝ) ∧
      Real.logb x (p 0 : ℝ) < (40481 : ℝ) / 100000 ∧
      Real.logb x (p 0 : ℝ) + Real.logb x (p 1 : ℝ) < (40481 : ℝ) / 100000 ∧
      (p 3 : ℝ) ≤ (p 4 : ℝ) ∧
      (40481 : ℝ) / 100000 < Real.logb x (p 1 : ℝ) +
        Real.logb x (p 2 : ℝ) + Real.logb x (p 3 : ℝ) ∧
      Real.logb x (p 1 : ℝ) + Real.logb x (p 2 : ℝ) +
        Real.logb x (p 3 : ℝ) ≤ (59519 : ℝ) / 100000
  let I := Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x))
  have hx0 : 0 < x := zero_lt_one.trans hx.1
  have hux : x ≤ u * x := by nlinarith
  have hvx : 0 ≤ v * x := by nlinarith
  have hpoint (n : ℕ) (hn : n ∈ I) :
      w n * (sourceT5 x n - exceptionalPrimeDefect x 0 n) =
        ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
          if (∏ i, p i) = n then (if C p then w (∏ i, p i) else 0) else 0 := by
    have hlo : x ≤ (n : ℝ) := hux.trans (Nat.ceil_le.mp (Finset.mem_Icc.mp hn).1)
    have hhi : (n : ℝ) ≤ 2 * x :=
      ((Nat.le_floor_iff hvx).mp (Finset.mem_Icc.mp hn).2).trans
        (mul_le_mul_of_nonneg_right hv hx0.le)
    rw [sourceT5_sub_exceptionalPrimeDefect_zero_eq_central hx.1 hx.2 hlo hhi,
      Finset.mul_sum]
    refine Finset.sum_congr rfl ?_
    intro p _
    by_cases hp : (∏ i, p i) = n
    · simp only [hp, true_and, ite_true, mul_ite, mul_one, mul_zero, C]
    · simp only [hp, false_and, ite_false, mul_zero]
  have hfirst :
      (∑ n ∈ I, w n * (sourceT5 x n - exceptionalPrimeDefect x 0 n)) =
        ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Q),
          if (∏ i, p i) ∈ I ∧ C p then w (∏ i, p i) else 0 := by
    rw [Finset.sum_congr rfl hpoint]
    simpa only [I, Q, ite_and] using sum_primeTuples_Icc
      (Nat.ceil (u * x)) (Nat.floor (v * x))
      (fun p => if C p then w (∏ i, p i) else 0)
  have hPQ : P ⊆ Q := by
    intro p hp
    rcases Finset.mem_filter.mp hp with ⟨hi, hprime⟩
    have hpow : x ^ ((6 : ℝ) / 25) ≤ x := by
      simpa only [Real.rpow_one] using Real.rpow_le_rpow_of_exponent_le hx.1.le
        (by norm_num : (6 : ℝ) / 25 ≤ 1)
    have hxvx : x ≤ v * x := by nlinarith
    exact Nat.mem_primesLE.mpr
      ⟨(Finset.mem_Icc.mp hi).2.trans (Nat.floor_mono (hpow.trans hxvx)), hprime⟩
  have hsecond :
      (∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => P),
        if (∏ i, p i) ∈ I ∧ C p then w (∏ i, p i) else 0) =
      ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Q),
        if (∏ i, p i) ∈ I ∧ C p then w (∏ i, p i) else 0 := by
    apply Finset.sum_subset (Fintype.piFinset_subset _ _ (fun _ => hPQ))
    intro p hpQ hpnot
    apply ite_eq_right
    rintro ⟨hprod, hc⟩
    have hpprime : ∀ i, (p i).Prime := fun i =>
      Nat.prime_of_mem_primesLE (Fintype.mem_piFinset.mp hpQ i)
    rcases hc with ⟨h3, h32, h21, h10, _, _, h34, _⟩
    have hlog34 := Real.logb_le_logb_of_le hx.1
      (Nat.cast_pos.mpr (hpprime 3).pos) h34
    have hl : ∀ i, (9519 : ℝ) / 50000 ≤ Real.logb x (p i : ℝ) := by
      intro i
      fin_cases i
      · exact h3.trans (h32.le.trans (h21.le.trans h10.le))
      · exact h3.trans (h32.le.trans h21.le)
      · exact h3.trans h32.le
      · exact h3
      · exact h3.trans hlog34
    have hupper : ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x :=
      ((Nat.le_floor_iff hvx).mp (Finset.mem_Icc.mp hprod).2).trans
        (mul_le_mul_of_nonneg_right hv hx0.le)
    exact hpnot (Fintype.mem_piFinset.mpr
      (prime_five_mem_compact_band x hx.1 hgap p hpprime hl hupper))
  change (∑ n ∈ I, w n * (sourceT5 x n - exceptionalPrimeDefect x 0 n)) = _
  rw [hfirst, ← hsecond]
  simp only [sourceT5CentralTuples, Finset.sum_filter]
  refine Finset.sum_congr rfl ?_
  intro p _
  change (if (∏ i, p i) ∈ I ∧ C p then w (∏ i, p i) else 0) =
    (if C p then (if (∏ i, p i) ∈ I then w (∏ i, p i) else 0) else 0)
  by_cases hp : (∏ i, p i) ∈ I <;> by_cases hc : C p <;> simp [hp, hc]

theorem sourceT5_sub_exceptionalPrimeDefect_zero_finsupp :
    ∀ᶠ x : ℝ in Filter.atTop,
      ∀ u v : ℝ, 1 ≤ u → u ≤ v → v ≤ 2 →
        (∑ n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)),
          Finsupp.single n (sourceT5 x n - exceptionalPrimeDefect x 0 n)) =
        ∑ p ∈ sourceT5CentralTuples x,
          if (∏ i, p i) ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x))
          then Finsupp.single (∏ i, p i) (1 : ℝ) else 0 := by
  classical
  filter_upwards [sourceT5_sub_exceptionalPrimeDefect_zero_weighted_compact] with x hx
  intro u v hu huv hv
  ext m
  have h := hx u v hu huv hv (fun n => if n = m then 1 else 0)
  simp only [ite_mul, one_mul, zero_mul] at h
  simp only [Finsupp.finsetSum_apply, Finsupp.single_apply]
  rw [h]
  refine Finset.sum_congr rfl ?_
  intro p _
  by_cases hp : (∏ i, p i) ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x))
  · simp only [ite_eq_left hp, Finsupp.single_apply]
  · simp only [ite_eq_right hp, Finsupp.zero_apply]

open Classical in
/--
The multiplicative boundary cuts for the central five-prime `T5` region, together with the
closed total-product window `[x, 2 * x]`. The central triple product lies strictly above
`x^(40481 / 100000)` and at most `x^(59519 / 100000)`.
-/
noncomputable def sourceT5CentralMonomialCuts (x : ℝ) : Finset MinorantMonomialCut :=
  ({⟨Finset.univ, ∅, x, true, false⟩,
      ⟨Finset.univ, ∅, 2 * x, false, false⟩} ∪
    {⟨{3}, ∅, x ^ ((9519 : ℝ) / 50000), true, false⟩,
      ⟨{3}, {2}, 1, false, true⟩,
      ⟨{2}, {1}, 1, false, true⟩,
      ⟨{1}, {0}, 1, false, true⟩,
      ⟨{0}, ∅, x ^ ((40481 : ℝ) / 100000), false, true⟩,
      ⟨{0, 1}, ∅, x ^ ((40481 : ℝ) / 100000), false, true⟩}) ∪
    {⟨{3}, {4}, 1, false, false⟩,
      ⟨{1, 2, 3}, ∅, x ^ ((40481 : ℝ) / 100000), true, true⟩,
      ⟨{1, 2, 3}, ∅, x ^ ((59519 : ℝ) / 100000), false, false⟩}

theorem sourceT5CentralMonomialCuts_data (x : ℝ) (hx : 0 < x)
    (d : MinorantMonomialCut) (hd : d ∈ sourceT5CentralMonomialCuts x) :
    d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
      d.numerator.card + d.denominator.card ≤ 5 ∧ 0 < d.threshold := by
  classical
  simp only [sourceT5CentralMonomialCuts, Finset.mem_union,
    Finset.mem_insert, Finset.mem_singleton] at hd
  rcases hd with ((rfl | rfl) | rfl | rfl | rfl | rfl | rfl | rfl) |
    rfl | rfl | rfl <;>
      norm_num [Finset.card_fin, Finset.disjoint_left] <;>
        first | positivity | decide | exact ⟨Finset.card_le_univ _, by positivity⟩

theorem sourceT5CentralMonomialCuts_card_le (x : ℝ) :
    (sourceT5CentralMonomialCuts x).card ≤ 32 := by
  classical
  unfold sourceT5CentralMonomialCuts
  exact (Finset.card_union_le _ _).trans
    ((Nat.add_le_add ((Finset.card_union_le _ _).trans
      (Nat.add_le_add Finset.card_le_two Finset.card_le_six))
      Finset.card_le_three).trans (by decide))

theorem sourceT5CentralTuples_monomial_iff (x : ℝ) (hx : 1 < x)
    (p : Fin 5 → ℕ)
    (hp : ∀ i, p i ∈ (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
      (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime) :
    ((∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧ p ∈ sourceT5CentralTuples x) ↔
      ∀ d ∈ sourceT5CentralMonomialCuts x,
        if d.lower then
          if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
        else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold := by
  classical
  have hpos (i : Fin 5) : 0 < (p i : ℝ) :=
    Nat.cast_pos.mpr (Finset.mem_filter.mp (hp i)).2.pos
  have hmem : p ∈ Fintype.piFinset (fun _ : Fin 5 =>
      (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
        (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime) :=
    Fintype.mem_piFinset.mpr hp
  have horder (i k : Fin 5) :
      Real.logb x (p i : ℝ) < Real.logb x (p k : ℝ) ↔ (p i : ℝ) / p k < 1 := by
    rw [Real.logb_lt_logb_iff hx (hpos i) (hpos k), div_lt_one (hpos k)]
  have hlow (i : Fin 5) (t : ℝ) :
      t ≤ Real.logb x (p i : ℝ) ↔ x ^ t ≤ (p i : ℝ) :=
    Real.le_logb_iff_rpow_le hx (hpos i)
  have hlt (i : Fin 5) (t : ℝ) :
      Real.logb x (p i : ℝ) < t ↔ (p i : ℝ) < x ^ t :=
    Real.logb_lt_iff_lt_rpow hx (hpos i)
  have hpair (i k : Fin 5) (t : ℝ) :
      Real.logb x (p i : ℝ) + Real.logb x (p k : ℝ) < t ↔
        (p i : ℝ) * p k < x ^ t := by
    rw [← Real.logb_mul (hpos i).ne' (hpos k).ne',
      Real.logb_lt_iff_lt_rpow hx (mul_pos (hpos i) (hpos k))]
  have htriple (t : ℝ) :
      (t < Real.logb x (p 1 : ℝ) + Real.logb x (p 2 : ℝ) + Real.logb x (p 3 : ℝ) ↔
        x ^ t < (p 1 : ℝ) * p 2 * p 3) ∧
      (Real.logb x (p 1 : ℝ) + Real.logb x (p 2 : ℝ) + Real.logb x (p 3 : ℝ) ≤ t ↔
        (p 1 : ℝ) * p 2 * p 3 ≤ x ^ t) := by
    rw [← Real.logb_mul (hpos 1).ne' (hpos 2).ne',
      ← Real.logb_mul (mul_pos (hpos 1) (hpos 2)).ne' (hpos 3).ne',
      Real.lt_logb_iff_rpow_lt hx (mul_pos (mul_pos (hpos 1) (hpos 2)) (hpos 3)),
      Real.logb_le_iff_le_rpow hx (mul_pos (mul_pos (hpos 1) (hpos 2)) (hpos 3))]
    exact ⟨Iff.rfl, Iff.rfl⟩
  have hcarrier : (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ↔
      x ≤ ∏ i, (p i : ℝ) ∧ (∏ i, (p i : ℝ)) ≤ 2 * x := by
    rw [Finset.mem_Icc, Nat.ceil_le, Nat.le_floor_iff (by positivity)]
    push_cast
    rfl
  simp only [sourceT5CentralTuples, Finset.mem_filter, hmem, true_and, hcarrier]
  rw [horder 3 2, horder 2 1, horder 1 0]
  simp only [hlow, hlt, hpair, (htriple ((40481 : ℝ) / 100000)).1,
    (htriple ((59519 : ℝ) / 100000)).2]
  simp [sourceT5CentralMonomialCuts, MinorantMonomialCut.value,
    div_le_one (hpos 4), mul_assoc, and_assoc]
  tauto

theorem sourceT5CentralTuples_monomial_truth_invariant
    (x : ℝ) (hx : 1 < x) (p q : Fin 5 → ℕ)
    (hp : ∀ i, p i ∈ (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
      (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime)
    (hq : ∀ i, q i ∈ (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
      (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime)
    (htruth : ∀ d ∈ sourceT5CentralMonomialCuts x,
      (if d.lower then
        if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
      else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
      (if d.lower then
        if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
      else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) :
    ((∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧ p ∈ sourceT5CentralTuples x) ↔
      ((∏ i, q i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧ q ∈ sourceT5CentralTuples x) := by
  rw [sourceT5CentralTuples_monomial_iff x hx p hp,
    sourceT5CentralTuples_monomial_iff x hx q hq]
  exact forall_congr' (fun d => forall_congr' (fun hd => htruth d hd))

theorem minorant_three_prime_localized_exponent_geometry :
    let τ : ℝ := 1 / 10 ^ 10
    let a : ℝ := 40481 / 100000
    let ζ : ℝ := 1 - 1058 / 3125 - a
    ∃ X : ℝ, 2 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ Θ : ℝ, 1 < Θ → Θ ≤ 2 →
      ∀ (r : Fin 3 → Fin 5) (p : Fin 3 → ℕ)
        (ν d : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ),
        (∀ c : Fin 3, ∏ i, d c i = p c) →
        (∀ (c : Fin 3) (i : Fin (2 * ((r c).val + 1))),
          Θ ^ ν c i / Θ ≤ (d c i : ℝ) ∧
            (d c i : ℝ) ≤ Θ * Θ ^ ν c i) →
        (∀ c : Fin 3, x ^ (ζ - τ / 10) ≤ (p c : ℝ) ∧
          (p c : ℝ) ≤ x ^ (a + τ / 10)) →
        (x ≤ ((∏ c, p c : ℕ) : ℝ) ∧ ((∏ c, p c : ℕ) : ℝ) ≤ 3 * x) →
        (∀ (c : Fin 3) (i : Fin (2 * ((r c).val + 1))),
          i.val < (r c).val + 1 → (d c i : ℝ) ≤ x ^ (9 / 100 : ℝ)) →
        let α : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℝ :=
          fun c i => Real.logb x (Θ ^ ν c i)
        Fintype.card (Σ c : Fin 3, Fin (2 * ((r c).val + 1))) ≤ 30 ∧
          (∀ c i, 0 ≤ α c i) ∧
          (∀ c : Fin 3, ζ - τ / 5 ≤ ∑ i, α c i) ∧
          |(∑ c, ∑ i, α c i) - 1| ≤ τ / 1000 ∧
          ∀ (c : Fin 3) (i : Fin (2 * ((r c).val + 1))),
            i.val < (r c).val + 1 → α c i ≤ 1 / 10 := by
  classical
  intro τ a ζ
  have hτ : 0 < τ := by norm_num [τ]
  have hlog2 : 0 ≤ Real.log 2 := Real.log_nonneg (by norm_num)
  have hlog3 : 0 ≤ Real.log 3 := Real.log_nonneg (by norm_num)
  let X : ℝ := max 2 (Real.exp (100000 * (Real.log 2 + Real.log 3) / τ))
  refine ⟨X, le_max_left _ _, ?_⟩
  intro x hx Θ hΘ hΘtwo r p ν d hprod hslot hscale htotal hmu α
  have hxTwo : 2 ≤ x := (le_max_left _ _).trans hx
  have hxOne : 1 < x := lt_of_lt_of_le (by norm_num : (1 : ℝ) < 2) hxTwo
  have hxPos : 0 < x := zero_lt_one.trans hxOne
  have hlogx : 0 < Real.log x := Real.log_pos hxOne
  have hΘpos : 0 < Θ := zero_lt_one.trans hΘ
  have hlarge : 100000 * (Real.log 2 + Real.log 3) / τ ≤ Real.log x :=
    (Real.le_log_iff_exp_le hxPos).mpr ((le_max_right _ _).trans hx)
  have hsmall : (Real.log 2 + Real.log 3) / Real.log x ≤ τ / 100000 := by
    apply (div_le_iff₀ hlogx).mpr
    have hh := (div_le_iff₀ hτ).mp hlarge
    calc
      Real.log 2 + Real.log 3 ≤ (Real.log x * τ) / 100000 :=
        (le_div_iff₀ (by norm_num : (0 : ℝ) < 100000)).mpr
          (by simpa only [mul_comm] using hh)
      _ = τ / 100000 * Real.log x := by ring
  let e : ℝ := Real.logb x Θ
  have he : 0 ≤ e := Real.logb_nonneg hxOne hΘ.le
  have heSmall : e ≤ τ / 100000 := by
    calc
      e ≤ (Real.log 2 + Real.log 3) / Real.log x := by
        apply div_le_div_of_nonneg_right _ hlogx.le
        exact (Real.log_le_log hΘpos hΘtwo).trans (le_add_of_nonneg_right hlog3)
      _ ≤ τ / 100000 := hsmall
  have hthreeSmall : Real.logb x 3 ≤ τ / 100000 :=
    (div_le_div_of_nonneg_right (le_add_of_nonneg_left hlog2) hlogx.le).trans hsmall
  have hslots (c : Fin 3) : 2 * ((r c).val + 1) ≤ 10 := by
    have hr := (r c).isLt
    omega
  have hdPos (c : Fin 3) (i : Fin (2 * ((r c).val + 1))) : 0 < (d c i : ℝ) :=
    (div_pos (pow_pos hΘpos _) hΘpos).trans_le (hslot c i).1
  have hpPos (c : Fin 3) : 0 < (p c : ℝ) :=
    (Real.rpow_pos_of_pos hxPos _).trans_le (hscale c).1
  have hlogSlot (c : Fin 3) (i : Fin (2 * ((r c).val + 1))) :
      α c i - e ≤ Real.logb x (d c i : ℝ) ∧
        Real.logb x (d c i : ℝ) ≤ α c i + e := by
    have hlo := Real.logb_le_logb_of_le hxOne
      (div_pos (pow_pos hΘpos _) hΘpos) (hslot c i).1
    rw [Real.logb_div (pow_ne_zero _ hΘpos.ne') hΘpos.ne'] at hlo
    have hhi := Real.logb_le_logb_of_le hxOne (hdPos c i) (hslot c i).2
    rw [Real.logb_mul hΘpos.ne' (pow_ne_zero _ hΘpos.ne')] at hhi
    exact ⟨hlo, by simpa only [add_comm] using hhi⟩
  have hcolorLog (c : Fin 3) :
      Real.logb x (p c : ℝ) = ∑ i, Real.logb x (d c i : ℝ) := by
    calc
      Real.logb x (p c : ℝ) = Real.logb x (∏ i, (d c i : ℝ)) := by
        rw [← Nat.cast_prod, hprod c]
      _ = ∑ i, Real.logb x (d c i : ℝ) :=
        Real.logb_prod Finset.univ _ (fun i _ => (hdPos c i).ne')
  have hcolorBounds (c : Fin 3) :
      Real.logb x (p c : ℝ) - 10 * e ≤ ∑ i, α c i ∧
        (∑ i, α c i) ≤ Real.logb x (p c : ℝ) + 10 * e := by
    have hlo := Finset.sum_le_sum
      (fun (i : Fin (2 * ((r c).val + 1))) (_ : i ∈ Finset.univ) => (hlogSlot c i).1)
    have hhi := Finset.sum_le_sum
      (fun (i : Fin (2 * ((r c).val + 1))) (_ : i ∈ Finset.univ) => (hlogSlot c i).2)
    simp only [Finset.sum_sub_distrib, Finset.sum_add_distrib, Finset.sum_const,
      Finset.card_univ, Fintype.card_fin, nsmul_eq_mul, ← hcolorLog c] at hlo hhi
    have hcount : ((2 * ((r c).val + 1) : ℕ) : ℝ) ≤ 10 := by exact_mod_cast hslots c
    have herr := mul_le_mul_of_nonneg_right hcount he
    constructor <;> linarith only [hlo, hhi, herr]
  have htotalLog :
      Real.logb x ((∏ c, p c : ℕ) : ℝ) = ∑ c, Real.logb x (p c : ℝ) := by
    calc
      Real.logb x ((∏ c, p c : ℕ) : ℝ) = Real.logb x (∏ c, (p c : ℝ)) := by
        rw [Nat.cast_prod]
      _ = ∑ c, Real.logb x (p c : ℝ) :=
        Real.logb_prod Finset.univ _ (fun c _ => (hpPos c).ne')
  have htotalBounds :
      1 ≤ ∑ c, Real.logb x (p c : ℝ) ∧
        (∑ c, Real.logb x (p c : ℝ)) ≤ 1 + Real.logb x 3 := by
    have hlo := Real.logb_le_logb_of_le hxOne hxPos htotal.1
    have hhi := Real.logb_le_logb_of_le hxOne (hxPos.trans_le htotal.1) htotal.2
    rw [Real.logb_self_eq_one hxOne, htotalLog] at hlo
    rw [htotalLog, Real.logb_mul (by norm_num : (3 : ℝ) ≠ 0) hxPos.ne',
      Real.logb_self_eq_one hxOne] at hhi
    exact ⟨hlo, by simpa only [add_comm] using hhi⟩
  have hallBounds :
      (∑ c, Real.logb x (p c : ℝ)) - 30 * e ≤ ∑ c, ∑ i, α c i ∧
        (∑ c, ∑ i, α c i) ≤ (∑ c, Real.logb x (p c : ℝ)) + 30 * e := by
    have hlo := Finset.sum_le_sum
      (fun (c : Fin 3) (_ : c ∈ Finset.univ) => (hcolorBounds c).1)
    have hhi := Finset.sum_le_sum
      (fun (c : Fin 3) (_ : c ∈ Finset.univ) => (hcolorBounds c).2)
    simp only [Finset.sum_sub_distrib, Finset.sum_add_distrib, Finset.sum_const,
      Finset.card_univ, Fintype.card_fin, nsmul_eq_mul, Nat.cast_ofNat] at hlo hhi
    constructor <;> linarith only [hlo, hhi]
  refine ⟨?_, ?_, ?_, ?_, ?_⟩
  · rw [Fintype.card_sigma]
    calc
      (∑ c : Fin 3, Fintype.card (Fin (2 * ((r c).val + 1)))) ≤
          ∑ _c : Fin 3, (10 : ℕ) := by
        apply Finset.sum_le_sum
        intro c _
        simpa only [Fintype.card_fin] using hslots c
      _ = 30 := by norm_num
  · intro c i
    exact Real.logb_nonneg hxOne (one_le_pow₀ hΘ.le)
  · intro c
    have hpLo : ζ - τ / 10 ≤ Real.logb x (p c : ℝ) :=
      (Real.le_logb_iff_rpow_le hxOne (hpPos c)).mpr (hscale c).1
    have hc := (hcolorBounds c).1
    linarith only [hpLo, hc, heSmall, hτ]
  · apply abs_le.mpr
    constructor <;> linarith only [hallBounds.1, hallBounds.2,
      htotalBounds.1, htotalBounds.2, heSmall, hthreeSmall, hτ]
  · intro c i hi
    have hdHi : Real.logb x (d c i : ℝ) ≤ 9 / 100 :=
      (Real.logb_le_iff_le_rpow hxOne (hdPos c i)).mpr (hmu c i hi)
    have hsl := (hlogSlot c i).1
    have hτsmall : τ ≤ 1 := by norm_num [τ]
    linarith only [hdHi, hsl, heSmall, hτsmall]

open Classical in
theorem minorantHB_three_rejected_box_radial_support
    (A B t : Fin 3 → ℝ) (U Θ x : ℝ)
    (hA : ∀ c, 1 ≤ A c) (hAB : ∀ c, A c ≤ B c)
    (hΘ : 1 < Θ) (hΘtwo : Θ ≤ 2)
    (ht : ∀ c, 0 ≤ t c) (htten : ∀ c, t c ≤ 10)
    (r : Fin 3 → Fin 5)
    (ν : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ)
    (hν : ν ∈ Fintype.piFinset (fun c : Fin 3 =>
      minorantHBBoxes ((r c).val + 1) (A c) (B c) Θ)) :
    let I := Σ c : Fin 3, Fin (2 * ((r c).val + 1))
    let β : I → MonoidAlgebra ℂ ℕ := fun s =>
      minorantHBLocalizedSlot ((r s.1).val + 1) U Θ (t s.1) (ν s.1) s.2
    let P : ℝ := ∏ s : I, Θ ^ (ν s.1 s.2)
    ¬(x * Θ ^ 30 ≤ P ∧ P * Θ ^ 30 ≤ 2 * x) →
      ∀ n ∈ (∏ s : I, β s).coeff.support,
        x ≤ (n : ℝ) → (n : ℝ) ≤ 2 * x →
        (x ≤ (n : ℝ) ∧ (n : ℝ) ≤ x * Θ ^ 60) ∨
          (2 * x / Θ ^ 60 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x) := by
  intro I β P hnot n hn hxn hnx
  have hΘpos : 0 < Θ := zero_lt_one.trans hΘ
  have hpow30 : 0 < Θ ^ 30 := pow_pos hΘpos _
  have hpow60 : 0 < Θ ^ 60 := pow_pos hΘpos _
  have hpowadd : Θ ^ 30 * Θ ^ 30 = Θ ^ 60 := (pow_add Θ 30 30).symm
  have hrad := minorantHB_three_box_radial_support A B t U Θ
    hA hAB hΘ hΘtwo ht htten r ν hν n hn
  by_cases hlo : x * Θ ^ 30 ≤ P
  · have hhi : 2 * x < P * Θ ^ 30 :=
      lt_of_not_ge (fun h => hnot ⟨hlo, h⟩)
    have hP : P ≤ (n : ℝ) * Θ ^ 30 := (div_le_iff₀ hpow30).mp hrad.1
    have hbound : 2 * x ≤ (n : ℝ) * Θ ^ 60 := by
      calc
        2 * x ≤ P * Θ ^ 30 := hhi.le
        _ ≤ ((n : ℝ) * Θ ^ 30) * Θ ^ 30 :=
          mul_le_mul_of_nonneg_right hP hpow30.le
        _ = (n : ℝ) * Θ ^ 60 := by rw [mul_assoc, hpowadd]
    exact Or.inr ⟨(div_le_iff₀ hpow60).mpr hbound, hnx⟩
  · have hP : P ≤ x * Θ ^ 30 := (lt_of_not_ge hlo).le
    refine Or.inl ⟨hxn, ?_⟩
    calc
      (n : ℝ) ≤ P * Θ ^ 30 := hrad.2
      _ ≤ (x * Θ ^ 30) * Θ ^ 30 := mul_le_mul_of_nonneg_right hP hpow30.le
      _ = x * Θ ^ 60 := by rw [mul_assoc, hpowadd]

theorem minorantHB_radial_power_sixty_width
    (Θ u : ℝ) (hΘ : Θ = 1 + u) (hu : 0 ≤ u) (hu1 : u ≤ 1) :
    0 ≤ Θ ^ 60 - 1 ∧ Θ ^ 60 - 1 ≤ (2 : ℝ) ^ 60 * u := by
  have hΘone : 1 ≤ Θ := by linarith
  have hΘzero : 0 ≤ Θ := zero_le_one.trans hΘone
  have hΘtwo : Θ ≤ 2 := by linarith
  have hgeom : (∑ i ∈ Finset.range 60, Θ ^ i) * u = Θ ^ 60 - 1 := by
    simpa only [hΘ, add_sub_cancel_left] using geom_sum_mul Θ 60
  have hsum : (∑ i ∈ Finset.range 60, Θ ^ i) ≤ (2 : ℝ) ^ 60 := by
    calc
      (∑ i ∈ Finset.range 60, Θ ^ i) ≤
          ∑ i ∈ Finset.range 60, (2 : ℝ) ^ i :=
        Finset.sum_le_sum fun i _hi => pow_le_pow_left₀ hΘzero hΘtwo i
      _ = (2 : ℝ) ^ 60 - 1 := by
        simpa only [show (2 : ℝ) - 1 = 1 by norm_num, mul_one] using
          geom_sum_mul (2 : ℝ) 60
      _ ≤ (2 : ℝ) ^ 60 := sub_le_self _ zero_le_one
  refine ⟨sub_nonneg.mpr (one_le_pow₀ hΘone), ?_⟩
  rw [← hgeom]
  exact mul_le_mul_of_nonneg_right hsum hu

theorem minorantHB_radial_real_strip_widths
    (Θ u x : ℝ) (hΘ : Θ = 1 + u) (hu : 0 ≤ u) (hu1 : u ≤ 1)
    (hx : 0 ≤ x) :
    (0 ≤ x * Θ ^ 60 - x ∧ x * Θ ^ 60 - x ≤ (2 : ℝ) ^ 60 * x * u) ∧
      (0 ≤ 2 * x - 2 * x / Θ ^ 60 ∧
        2 * x - 2 * x / Θ ^ 60 ≤ (2 : ℝ) ^ 61 * x * u) := by
  have hΘone : 1 ≤ Θ := by linarith
  have hp : 1 ≤ Θ ^ 60 := one_le_pow₀ hΘone
  have hp0 : 0 < Θ ^ 60 := zero_lt_one.trans_le hp
  have hw := minorantHB_radial_power_sixty_width Θ u hΘ hu hu1
  have hx2 : 0 ≤ 2 * x := mul_nonneg (by norm_num) hx
  constructor
  · constructor
    · nlinarith [mul_nonneg hx hw.1]
    · calc
        x * Θ ^ 60 - x = x * (Θ ^ 60 - 1) := by ring
        _ ≤ x * ((2 : ℝ) ^ 60 * u) := mul_le_mul_of_nonneg_left hw.2 hx
        _ = (2 : ℝ) ^ 60 * x * u := by ring
  · refine ⟨sub_nonneg.mpr (div_le_self hx2 hp), ?_⟩
    calc
      2 * x - 2 * x / Θ ^ 60 = (2 * x) * (Θ ^ 60 - 1) / Θ ^ 60 := by
        field_simp [ne_of_gt hp0]
      _ ≤ (2 * x) * (Θ ^ 60 - 1) :=
        div_le_self (mul_nonneg hx2 hw.1) hp
      _ ≤ (2 * x) * ((2 : ℝ) ^ 60 * u) := mul_le_mul_of_nonneg_left hw.2 hx2
      _ = (2 : ℝ) ^ 61 * x * u := by
        rw [show 61 = 60 + 1 from rfl, pow_succ]
        ring

theorem minorantHB_closed_interval_carrier_width
    (lo hi : ℝ) (hlo : 0 ≤ lo) (hlohi : lo ≤ hi) :
    Finset.Icc ⌈lo⌉₊ ⌊hi⌋₊ = Finset.Ico ⌈lo⌉₊ (⌊hi⌋₊ + 1) ∧
      ((⌊hi⌋₊ + 1 - ⌈lo⌉₊ : ℕ) : ℝ) ≤ hi - lo + 1 := by
  have hceil : ⌈lo⌉₊ ≤ ⌊hi⌋₊ + 1 :=
    (Nat.ceil_mono hlohi).trans (Nat.ceil_le_floor_add_one hi)
  refine ⟨(Finset.Ico_add_one_right_eq_Icc _ _).symm, ?_⟩
  rw [Nat.cast_sub hceil, Nat.cast_add, Nat.cast_one]
  have hfloor := Nat.floor_le (hlo.trans hlohi)
  have hceilreal := Nat.le_ceil lo
  linarith

theorem minorantHB_lower_radial_strip_carrier_width
    (Θ u x : ℝ) (hΘ : Θ = 1 + u) (hu : 0 ≤ u) (hu1 : u ≤ 1)
    (hx : 0 ≤ x) :
    Finset.Icc ⌈x⌉₊ ⌊x * Θ ^ 60⌋₊ =
        Finset.Ico ⌈x⌉₊ (⌊x * Θ ^ 60⌋₊ + 1) ∧
      ((⌊x * Θ ^ 60⌋₊ + 1 - ⌈x⌉₊ : ℕ) : ℝ) ≤
        (2 : ℝ) ^ 60 * x * u + 1 := by
  have hw := (minorantHB_radial_real_strip_widths Θ u x hΘ hu hu1 hx).1
  have hcarrier := minorantHB_closed_interval_carrier_width
    x (x * Θ ^ 60) hx (sub_nonneg.mp hw.1)
  exact ⟨hcarrier.1, hcarrier.2.trans (add_le_add_left hw.2 1)⟩

theorem minorantHB_upper_radial_strip_carrier_width
    (Θ u x : ℝ) (hΘ : Θ = 1 + u) (hu : 0 ≤ u) (hu1 : u ≤ 1)
    (hx : 0 ≤ x) :
    Finset.Icc ⌈2 * x / Θ ^ 60⌉₊ ⌊2 * x⌋₊ =
        Finset.Ico ⌈2 * x / Θ ^ 60⌉₊ (⌊2 * x⌋₊ + 1) ∧
      ((⌊2 * x⌋₊ + 1 - ⌈2 * x / Θ ^ 60⌉₊ : ℕ) : ℝ) ≤
        (2 : ℝ) ^ 61 * x * u + 1 := by
  have hΘone : 1 ≤ Θ := by linarith
  have hp : 0 ≤ Θ ^ 60 := zero_le_one.trans (one_le_pow₀ hΘone)
  have hleft : 0 ≤ 2 * x / Θ ^ 60 := div_nonneg (by positivity) hp
  have hw := (minorantHB_radial_real_strip_widths Θ u x hΘ hu hu1 hx).2
  have hcarrier := minorantHB_closed_interval_carrier_width
    (2 * x / Θ ^ 60) (2 * x) hleft (sub_nonneg.mp hw.1)
  exact ⟨hcarrier.1, hcarrier.2.trans (add_le_add_left hw.2 1)⟩

theorem minorantHB_radial_mesh_carrier_widths
    (D₀ : ℕ) :
    ∃ X : ℝ, Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ D : ℕ, D₀ + 2 ≤ D →
        let Θ : ℝ := 1 + (Real.log x) ^ (-(D : ℝ))
        1 < Θ ∧ Θ ≤ 2 ∧ Θ ^ 60 ≤ 2 ∧
          (1 ≤ ⌈x⌉₊ ∧ ⌈x⌉₊ ≤ ⌊x * Θ ^ 60⌋₊ + 1 ∧
            ⌊x * Θ ^ 60⌋₊ + 1 ≤ ⌈2 * x⌉₊ + 1 ∧
            ((⌊x * Θ ^ 60⌋₊ + 1 - ⌈x⌉₊ : ℕ) : ℝ) ≤
              x / (Real.log x) ^ D₀) ∧
          (1 ≤ ⌈2 * x / Θ ^ 60⌉₊ ∧
            ⌈2 * x / Θ ^ 60⌉₊ ≤ ⌊2 * x⌋₊ + 1 ∧
            ⌊2 * x⌋₊ + 1 ≤ ⌈2 * x⌉₊ + 1 ∧
            ((⌊2 * x⌋₊ + 1 - ⌈2 * x / Θ ^ 60⌉₊ : ℕ) : ℝ) ≤
              x / (Real.log x) ^ D₀) := by
  let C : ℝ := (2 : ℝ) ^ 61
  have hC : 0 < C := by positivity
  obtain ⟨X₀, hX₀⟩ := Filter.eventually_atTop.mp
    ((isLittleO_log_rpow_rpow_atTop (D₀ : ℝ) zero_lt_one).const_mul_left
      (2 : ℝ)).eventuallyLE
  refine ⟨max X₀ (Real.exp (max 1 (2 * C))),
    (Real.exp_monotone (le_max_left _ _)).trans (le_max_right _ _), ?_⟩
  intro x hx D hD Θ
  have hxexp : Real.exp (max 1 (2 * C)) ≤ x := (le_max_right _ _).trans hx
  have hxpos : 0 < x := (Real.exp_pos _).trans_le hxexp
  have hloglarge : max 1 (2 * C) ≤ Real.log x :=
    (Real.le_log_iff_exp_le hxpos).mpr hxexp
  let L : ℝ := Real.log x
  let u : ℝ := L ^ (-(D : ℝ))
  have hL1 : 1 ≤ L := (le_max_left _ _).trans hloglarge
  have hLpos : 0 < L := zero_lt_one.trans_le hL1
  have hLlarge : 2 * C ≤ L := (le_max_right _ _).trans hloglarge
  have hu : 0 < u := Real.rpow_pos_of_pos hLpos _
  have hu1 : u ≤ 1 :=
    Real.rpow_le_one_of_one_le_of_nonpos hL1 (neg_nonpos.mpr (Nat.cast_nonneg D))
  have hΘ : Θ = 1 + u := rfl
  have hΘgt : 1 < Θ := by rw [hΘ]; linarith
  have hΘtwo : Θ ≤ 2 := by rw [hΘ]; linarith
  have hLp : 0 < L ^ D₀ := pow_pos hLpos _
  have hLp1 : 1 ≤ L ^ D₀ := one_le_pow₀ hL1
  have hloghalf : L ^ D₀ ≤ x / 2 := by
    have he := hX₀ x ((le_max_left _ _).trans hx)
    have he' : ‖2 * L ^ D₀‖ ≤ ‖x‖ := by
      simpa only [Real.rpow_one, Real.rpow_natCast] using he
    have hnlog : 0 ≤ 2 * L ^ D₀ :=
      mul_nonneg (by norm_num) (pow_nonneg hLpos.le _)
    have htwo : 2 * L ^ D₀ ≤ x := by
      simpa only [Real.norm_of_nonneg hnlog, Real.norm_of_nonneg hxpos.le] using he'
    linarith
  have huSmall : u ≤ (L ^ (D₀ + 2))⁻¹ := by
    have hDreal : ((D₀ + 2 : ℕ) : ℝ) ≤ (D : ℝ) := by exact_mod_cast hD
    have he : -(D : ℝ) ≤ -((D₀ + 2 : ℕ) : ℝ) := neg_le_neg hDreal
    have hh := Real.rpow_le_rpow_of_exponent_le hL1 he
    simpa only [u, Real.rpow_neg hLpos.le, Real.rpow_natCast] using hh
  have hCscaled : C * u * L ^ D₀ ≤ (1 / 2 : ℝ) := by
    calc
      C * u * L ^ D₀ ≤ C * (L ^ (D₀ + 2))⁻¹ * L ^ D₀ :=
        mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_left huSmall hC.le) hLp.le
      _ = C / L ^ 2 := by
        rw [pow_add]
        field_simp [hLpos.ne']
      _ ≤ (1 / 2 : ℝ) := by
        apply (div_le_iff₀ (pow_pos hLpos 2)).mpr
        have hsq : 2 * C ≤ L ^ 2 :=
          hLlarge.trans (le_self_pow₀ hL1 (by decide))
        linarith
  have hCu : C * u ≤ (1 / 2 : ℝ) :=
    (le_mul_of_one_le_right (mul_nonneg hC.le hu.le) hLp1).trans hCscaled
  have hpowbound : Θ ^ 60 ≤ 2 := by
    have hwidth := (minorantHB_radial_power_sixty_width Θ u hΘ hu.le hu1).2
    have hC60 : (2 : ℝ) ^ 60 ≤ C :=
      pow_le_pow_right₀ (by norm_num) (by decide)
    have hsmall := (mul_le_mul_of_nonneg_right hC60 hu.le).trans hCu
    linarith
  have hbound : C * x * u + 1 ≤ x / L ^ D₀ := by
    apply (le_div_iff₀ hLp).mpr
    calc
      (C * x * u + 1) * L ^ D₀ = x * (C * u * L ^ D₀) + L ^ D₀ := by ring
      _ ≤ x * (1 / 2) + x / 2 :=
        add_le_add (mul_le_mul_of_nonneg_left hCscaled hxpos.le) hloghalf
      _ = x := by ring
  have hpowpos : 0 < Θ ^ 60 := pow_pos (zero_lt_one.trans hΘgt) _
  have hpowone : 1 ≤ Θ ^ 60 := one_le_pow₀ hΘgt.le
  have hlower : x ≤ x * Θ ^ 60 := le_mul_of_one_le_right hxpos.le hpowone
  have hlowerUpper : x * Θ ^ 60 ≤ 2 * x := by
    simpa only [mul_comm] using mul_le_mul_of_nonneg_left hpowbound hxpos.le
  have hupperLower : x ≤ 2 * x / Θ ^ 60 :=
    (le_div_iff₀ hpowpos).mpr hlowerUpper
  have hupper : 2 * x / Θ ^ 60 ≤ 2 * x :=
    div_le_self (mul_nonneg (by norm_num) hxpos.le) hpowone
  have hlo := minorantHB_lower_radial_strip_carrier_width Θ u x hΘ hu.le hu1 hxpos.le
  have hhi := minorantHB_upper_radial_strip_carrier_width Θ u x hΘ hu.le hu1 hxpos.le
  refine ⟨hΘgt, hΘtwo, hpowbound, ?_, ?_⟩
  · refine ⟨Nat.ceil_pos.mpr hxpos,
      (Nat.ceil_mono hlower).trans (Nat.ceil_le_floor_add_one _),
      Nat.add_le_add_right ((Nat.floor_mono hlowerUpper).trans (Nat.floor_le_ceil _)) 1,
      ?_⟩
    apply hlo.2.trans
    apply le_trans _ hbound
    apply add_le_add_left _ 1
    exact mul_le_mul_of_nonneg_right
      (mul_le_mul_of_nonneg_right
        (pow_le_pow_right₀ (by norm_num : (1 : ℝ) ≤ 2) (by decide : 60 ≤ 61))
        hxpos.le) hu.le
  · exact ⟨Nat.ceil_pos.mpr (hxpos.trans_le hupperLower),
      (Nat.ceil_mono hupper).trans (Nat.ceil_le_floor_add_one _),
      Nat.add_le_add_right (Nat.floor_le_ceil _) 1, hhi.2.trans hbound⟩

theorem short_interval_divisor_mass_log_saving
    (η γ : ℝ) (hη : 0 < η) (hγ : 0 < γ) (_hηγ : η ≤ γ)
    (k : ℕ) (C A : ℝ) (hC : 1 ≤ C) (hA : 0 < A) :
    ∃ D : ℕ, 1 ≤ D ∧ ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ N : ℝ, x ^ η ≤ N → N ≤ x ^ γ →
      ∀ lo hi : ℕ, 1 ≤ lo → lo ≤ hi → hi ≤ ⌈C * N⌉₊ + 1 →
        ((hi - lo : ℕ) : ℝ) ≤ N / (Real.log x) ^ D →
        (∑ m ∈ Finset.Ico lo hi, (m.divisors.card : ℝ) ^ k) ≤
          K * N / (Real.log x) ^ A := by
  classical
  let P : ℕ := 2 ^ (4 * k)
  let D : ℕ := ⌈A + (P : ℝ) + 1⌉₊
  have hD1 : 1 ≤ D := Nat.one_le_ceil_iff.mpr (by positivity)
  have hD : (P : ℝ) + A ≤ D := by
    have h := Nat.le_ceil (A + (P : ℝ) + 1)
    change A + (P : ℝ) + 1 ≤ (D : ℝ) at h
    linarith only [h]
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  let b : ℝ := 32 * C
  have hb1 : 1 ≤ b := by dsimp only [b]; linarith only [hC]
  have hbpos : 0 < b := zero_lt_one.trans_le hb1
  have hlogb : 0 ≤ Real.log b := Real.log_nonneg hb1
  let d : ℝ := 2 + Real.log b + γ
  have hdpos : 0 < d := by dsimp only [d]; positivity
  let F : ℝ := (2 : ℝ) ^ (4 * k) * d ^ P
  have hF : 0 < F := by dsimp only [F]; positivity
  have hsmall := (isLittleO_log_rpow_rpow_atTop ((P : ℝ) + A)
    (show 0 < η / 2 by positivity)).eventuallyLE
  obtain ⟨X₀, hX₀⟩ := hsmall.exists_forall_of_atTop
  refine ⟨D, hD1, F * (1 + b), max (Real.exp 1) X₀,
    mul_pos hF (by positivity), le_max_left _ _, ?_⟩
  intro x hx N hNlower hNupper lo hi hlo hlohi hhi hwidth
  have hxExp : Real.exp 1 ≤ x := (le_max_left _ _).trans hx
  have hxPos : 0 < x := (Real.exp_pos 1).trans_le hxExp
  have hxOne : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hxExp
  have hlogOne : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxPos).mpr hxExp
  have hlogPos : 0 < Real.log x := zero_lt_one.trans_le hlogOne
  have hNone : 1 ≤ N := (Real.one_le_rpow hxOne hη.le).trans hNlower
  have hNpos : 0 < N := zero_lt_one.trans_le hNone
  have hLA : 0 < (Real.log x) ^ A := Real.rpow_pos_of_pos hlogPos A
  let Z : ℕ := ⌈C * N⌉₊
  let t : ℝ := (Z : ℝ) ^ (1 / 4 : ℝ)
  let Y : ℕ := 2 + ⌈t⌉₊
  have hCN : 1 ≤ C * N := one_le_mul_of_one_le_of_one_le hC hNone
  have hZone : (1 : ℝ) ≤ Z := hCN.trans (Nat.le_ceil _)
  have hZnonneg : (0 : ℝ) ≤ Z := Nat.cast_nonneg Z
  have hZupper : (Z : ℝ) ≤ 2 * C * N := by
    have h := (Nat.ceil_lt_add_one (zero_le_one.trans hCN)).le
    change (Z : ℝ) ≤ C * N + 1 at h
    nlinarith only [h, hCN]
  have htOne : 1 ≤ t := Real.one_le_rpow hZone (by norm_num)
  have htNonneg : 0 ≤ t := zero_le_one.trans htOne
  have hY : 2 ≤ Y := by dsimp only [Y]; omega
  have htY : t ≤ (Y : ℝ) := by
    simpa only [Y, Nat.cast_add, Nat.cast_ofNat] using
      (Nat.le_ceil t).trans (le_add_of_nonneg_left zero_le_two)
  have hYupper : (Y : ℝ) ≤ 4 * t := by
    have h := (Nat.ceil_lt_add_one htNonneg).le
    change ((2 + ⌈t⌉₊ : ℕ) : ℝ) ≤ 4 * t
    push_cast
    linarith only [h, htOne]
  have htTwo : t ^ 2 = (Z : ℝ) ^ (1 / 2 : ℝ) := by
    dsimp only [t]
    rw [← Real.rpow_mul_natCast hZnonneg]
    norm_num
  have hZscale : Z ≤ Y ^ 4 := by
    have h := (Real.rpow_inv_le_iff_of_pos hZnonneg (Nat.cast_nonneg Y)
      (show (0 : ℝ) < 4 by norm_num)).mp
        (by simpa only [t, one_div] using htY)
    rw [show (4 : ℝ) = (4 : ℕ) by norm_num, Real.rpow_natCast] at h
    exact_mod_cast h
  have hCpow : (2 * C) ^ (1 / 2 : ℝ) ≤ 2 * C :=
    Real.rpow_le_self_of_one_le (by linarith only [hC]) (by norm_num)
  have hYtwo : ((Y ^ 2 : ℕ) : ℝ) ≤ b * N ^ (1 / 2 : ℝ) := by
    calc
      _ = (Y : ℝ) ^ 2 := by simp only [Nat.cast_pow]
      _ ≤ (4 * t) ^ 2 := pow_le_pow_left₀ (Nat.cast_nonneg _) hYupper 2
      _ = 16 * (Z : ℝ) ^ (1 / 2 : ℝ) := by
        rw [show (4 * t) ^ 2 = 16 * t ^ 2 by ring, htTwo]
      _ ≤ 16 * (2 * C * N) ^ (1 / 2 : ℝ) :=
        mul_le_mul_of_nonneg_left
          (Real.rpow_le_rpow hZnonneg hZupper (by norm_num)) (by norm_num)
      _ = 16 * (2 * C) ^ (1 / 2 : ℝ) * N ^ (1 / 2 : ℝ) := by
        rw [Real.mul_rpow (by positivity) hNpos.le]
        ring
      _ ≤ 16 * (2 * C) * N ^ (1 / 2 : ℝ) :=
        mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left hCpow (by norm_num))
          (Real.rpow_nonneg hNpos.le _)
      _ = _ := by dsimp only [b]; ring
  have hYsqOne : (1 : ℝ) ≤ (Y ^ 2 : ℕ) := by
    exact_mod_cast (one_le_pow₀ (show 1 ≤ Y by omega) : 1 ≤ Y ^ 2)
  have hYsqPos : (0 : ℝ) < (Y ^ 2 : ℕ) := zero_lt_one.trans_le hYsqOne
  have hYsmall : ((Y ^ 2 : ℕ) : ℝ) ≤ b * x ^ γ :=
    hYtwo.trans (mul_le_mul_of_nonneg_left
      ((Real.rpow_le_self_of_one_le hNone (by norm_num)).trans hNupper) hbpos.le)
  have hlogYnonneg : 0 ≤ 1 + Real.log (Y ^ 2 : ℕ) :=
    add_nonneg zero_le_one (Real.log_nonneg hYsqOne)
  have hlogY : 1 + Real.log (Y ^ 2 : ℕ) ≤ d * Real.log x := by
    have h := Real.log_le_log hYsqPos hYsmall
    rw [Real.log_mul hbpos.ne' (Real.rpow_pos_of_pos hxPos γ).ne',
      Real.log_rpow hxPos] at h
    dsimp only [d]
    nlinarith only [h, hlogOne, hlogb,
      mul_nonneg hlogb (sub_nonneg.mpr hlogOne)]
  have hraw :
      (∑ m ∈ Finset.Ico lo hi, (m.divisors.card : ℝ) ^ k) ≤
        (2 : ℝ) ^ (4 * k) * (1 + Real.log (Y ^ 2 : ℕ)) ^ P *
          (((hi - lo : ℕ) : ℝ) + (Y ^ 2 : ℕ)) := by
    simpa only [Nat.mod_one, Finset.filter_true, Nat.cast_one, div_one] using
      sum_Ico_card_divisors_pow_modEq_le Y 4 k Z
        hY hZscale lo hi 1 0 hlo hlohi hhi (by decide) (by decide)
  have hscaled :
      (∑ m ∈ Finset.Ico lo hi, (m.divisors.card : ℝ) ^ k) ≤
        F * (((hi - lo : ℕ) : ℝ) + b * N ^ (1 / 2 : ℝ)) * (Real.log x) ^ P := by
    calc
      _ ≤ (2 : ℝ) ^ (4 * k) * (1 + Real.log (Y ^ 2 : ℕ)) ^ P *
          (((hi - lo : ℕ) : ℝ) + (Y ^ 2 : ℕ)) := hraw
      _ ≤ (2 : ℝ) ^ (4 * k) * (d * Real.log x) ^ P *
          (((hi - lo : ℕ) : ℝ) + b * N ^ (1 / 2 : ℝ)) :=
        mul_le_mul
          (mul_le_mul_of_nonneg_left (pow_le_pow_left₀ hlogYnonneg hlogY P)
            (by positivity))
          (add_le_add le_rfl hYtwo) (by positivity) (by positivity)
      _ = _ := by dsimp only [F]; rw [mul_pow]; ring
  have hratio : (Real.log x) ^ P / (Real.log x) ^ D ≤ 1 / (Real.log x) ^ A := by
    apply (div_le_div_iff₀ (pow_pos hlogPos D) hLA).mpr
    have hpow := Real.rpow_le_rpow_of_exponent_le hlogOne hD
    simpa only [Real.rpow_add hlogPos, Real.rpow_natCast, one_mul] using hpow
  have hwidthTerm :
      ((hi - lo : ℕ) : ℝ) * (Real.log x) ^ P ≤ N / (Real.log x) ^ A := by
    calc
      _ ≤ (N / (Real.log x) ^ D) * (Real.log x) ^ P :=
        mul_le_mul_of_nonneg_right hwidth (pow_nonneg hlogPos.le P)
      _ = N * ((Real.log x) ^ P / (Real.log x) ^ D) := by ring
      _ ≤ N * (1 / (Real.log x) ^ A) := mul_le_mul_of_nonneg_left hratio hNpos.le
      _ = _ := by ring
  have hpower : (Real.log x) ^ ((P : ℝ) + A) ≤ N ^ (1 / 2 : ℝ) := by
    calc
      _ ≤ x ^ (η / 2) := by
        simpa only [Real.norm_of_nonneg (Real.rpow_nonneg hlogPos.le _),
          Real.norm_of_nonneg (Real.rpow_nonneg hxPos.le _)] using
            hX₀ x ((le_max_right _ _).trans hx)
      _ = (x ^ η) ^ (1 / 2 : ℝ) := by
        rw [← Real.rpow_mul hxPos.le]
        congr 1
        ring
      _ ≤ N ^ (1 / 2 : ℝ) :=
        Real.rpow_le_rpow (Real.rpow_nonneg hxPos.le _) hNlower (by norm_num)
  have hpowerTerm : N ^ (1 / 2 : ℝ) * (Real.log x) ^ P ≤ N / (Real.log x) ^ A := by
    apply (le_div_iff₀ hLA).mpr
    calc
      _ = N ^ (1 / 2 : ℝ) * (Real.log x) ^ ((P : ℝ) + A) := by
        rw [Real.rpow_add hlogPos, Real.rpow_natCast]
        ring
      _ ≤ N ^ (1 / 2 : ℝ) * N ^ (1 / 2 : ℝ) :=
        mul_le_mul_of_nonneg_left hpower (Real.rpow_nonneg hNpos.le _)
      _ = N := by rw [← Real.rpow_add hNpos]; norm_num
  calc
    _ ≤ F * (((hi - lo : ℕ) : ℝ) + b * N ^ (1 / 2 : ℝ)) * (Real.log x) ^ P := hscaled
    _ = F * (((hi - lo : ℕ) : ℝ) * (Real.log x) ^ P +
        b * (N ^ (1 / 2 : ℝ) * (Real.log x) ^ P)) := by ring
    _ ≤ F * (N / (Real.log x) ^ A + b * (N / (Real.log x) ^ A)) :=
      mul_le_mul_of_nonneg_left
        (add_le_add hwidthTerm (mul_le_mul_of_nonneg_left hpowerTerm hbpos.le)) hF.le
    _ = (F * (1 + b)) * N / (Real.log x) ^ A := by ring

/--
The normalized von Mangoldt contribution from proper prime powers, with primes removed. At `n =
p^k` for prime `p` and `k ≥ 2`, its value is `1 / k`.
-/
noncomputable def minorantProperPrimePowerWeight (n : ℕ) : ℝ :=
  if n.Prime then 0 else ArithmeticFunction.vonMangoldt n / Real.log (n : ℝ)

theorem minorantProperPrimePowerWeight_identity (n : ℕ) :
    ArithmeticFunction.vonMangoldt n / Real.log (n : ℝ) =
      (if n.Prime then (1 : ℝ) else 0) + minorantProperPrimePowerWeight n := by
  by_cases hn : n.Prime
  · have hlog : Real.log (n : ℝ) ≠ 0 :=
      (Real.log_pos (by exact_mod_cast hn.one_lt)).ne'
    simp only [minorantProperPrimePowerWeight, ite_eq_left hn,
      ArithmeticFunction.vonMangoldt_apply_prime hn, div_self hlog, add_zero]
  · simp only [minorantProperPrimePowerWeight, ite_eq_right hn, zero_add]

theorem minorantProperPrimePowerWeight_nonneg (n : ℕ) :
    0 ≤ minorantProperPrimePowerWeight n := by
  rcases n with _ | n
  · simp [minorantProperPrimePowerWeight]
  · unfold minorantProperPrimePowerWeight
    split_ifs
    · exact le_rfl
    · exact div_nonneg ArithmeticFunction.vonMangoldt_nonneg
        (Real.log_nonneg (by exact_mod_cast Nat.succ_le_succ (Nat.zero_le n)))

theorem minorantProperPrimePowerWeight_mass (X : ℝ) (hX : 1 ≤ X)
    (S : Finset ℕ) (hS : S ⊆ Finset.Icc 2 ⌊X⌋₊) :
    (∑ n ∈ S, minorantProperPrimePowerWeight n) ≤
      2 * Real.sqrt X * Real.log X / Real.log 2 := by
  classical
  have hlog2 : 0 < Real.log 2 := Real.log_pos (by norm_num)
  have hbound (n : ℕ) (hn : 2 ≤ n) :
      minorantProperPrimePowerWeight n ≤
        (if n.Prime then 0 else ArithmeticFunction.vonMangoldt n) / Real.log 2 := by
    by_cases hp : n.Prime
    · simp only [minorantProperPrimePowerWeight, ite_eq_left hp, zero_div, le_refl]
    · simp only [minorantProperPrimePowerWeight, ite_eq_right hp]
      exact div_le_div_of_nonneg_left ArithmeticFunction.vonMangoldt_nonneg hlog2
        (Real.log_le_log (by norm_num) (by exact_mod_cast hn))
  have hsub : S ⊆ Finset.Ioc 0 ⌊X⌋₊ := by
    intro n hn
    obtain ⟨hnlo, hnhi⟩ := Finset.mem_Icc.mp (hS hn)
    exact Finset.mem_Ioc.mpr ⟨by omega, hnhi⟩
  have hproper : (∑ n ∈ S, if n.Prime then (0 : ℝ) else ArithmeticFunction.vonMangoldt n) ≤
      Chebyshev.psi X - Chebyshev.theta X := by
    rw [Chebyshev.psi_sub_theta_eq_sum_not_prime, Finset.sum_filter]
    have hle := Finset.sum_le_sum_of_subset_of_nonneg hsub
      (fun n _ _ => show 0 ≤ (if n.Prime then (0 : ℝ) else ArithmeticFunction.vonMangoldt n) by
        split_ifs <;> first | exact le_rfl | exact ArithmeticFunction.vonMangoldt_nonneg)
    refine hle.trans_eq ?_
    apply Finset.sum_congr rfl
    intro n hn
    by_cases hp : n.Prime <;> simp only [hp, ite_true, ite_false, not_true_eq_false,
      not_false_eq_true]
  calc
    _ ≤ ∑ n ∈ S,
        (if n.Prime then (0 : ℝ) else ArithmeticFunction.vonMangoldt n) / Real.log 2 :=
      Finset.sum_le_sum fun n hn => hbound n (Finset.mem_Icc.mp (hS hn)).1
    _ = (∑ n ∈ S,
        if n.Prime then (0 : ℝ) else ArithmeticFunction.vonMangoldt n) / Real.log 2 := by
      rw [Finset.sum_div]
    _ ≤ (Chebyshev.psi X - Chebyshev.theta X) / Real.log 2 :=
      div_le_div_of_nonneg_right hproper hlog2.le
    _ ≤ _ := div_le_div_of_nonneg_right (Chebyshev.psi_sub_theta_le hX) hlog2.le

theorem reciprocal_log_finite_mellin (v : ℝ) (hv : 1 < v) (T : ℝ) :
    1 / Real.log v = (∫ t in (0 : ℝ)..T, v ^ (-t)) + v ^ (-T) / Real.log v := by
  have hv0 : 0 < v := zero_lt_one.trans hv
  have hlog : Real.log v ≠ 0 := (Real.log_pos hv).ne'
  have hderiv (t : ℝ) :
      HasDerivAt (fun t : ℝ => -(v ^ (-t)) / Real.log v) (v ^ (-t)) t := by
    have hraw := (((hasDerivAt_id t).neg.const_rpow hv0).neg.div_const (Real.log v))
    change HasDerivAt (fun s : ℝ => -(v ^ (-s)) / Real.log v)
      (-(Real.log v * (-1) * v ^ (-t)) / Real.log v) t at hraw
    have hvalue : -(Real.log v * (-1) * v ^ (-t)) / Real.log v = v ^ (-t) := by
      field_simp
    rw [hvalue] at hraw
    exact hraw
  have hcont : Continuous (fun t : ℝ => v ^ (-t)) :=
    (Real.continuous_const_rpow hv0.ne').comp continuous_neg
  have hint := intervalIntegral.integral_eq_sub_of_hasDerivAt
    (fun t _ => hderiv t) (hcont.intervalIntegrable (0 : ℝ) T)
  rw [hint]
  simp only [neg_zero, Real.rpow_zero]
  ring

/--
The von Mangoldt function multiplied by the truncated Mellin integral of `n^(-t)` over `0 ≤ t ≤
10`.
-/
noncomputable def minorantMangoldtMellinWeight (n : ℕ) : ℝ :=
  ArithmeticFunction.vonMangoldt n * ∫ t in (0 : ℝ)..10, (n : ℝ) ^ (-t)

theorem minorantMangoldtMellinWeight_bounds (n : ℕ) (hn : 2 ≤ n) :
    0 ≤ minorantMangoldtMellinWeight n ∧
      minorantMangoldtMellinWeight n ≤ ArithmeticFunction.vonMangoldt n / Real.log (n : ℝ) ∧
      ArithmeticFunction.vonMangoldt n / Real.log (n : ℝ) ≤ 1 ∧
      ArithmeticFunction.vonMangoldt n / Real.log (n : ℝ) - minorantMangoldtMellinWeight n ≤
        (n : ℝ) ^ (-10 : ℝ) := by
  have hn1 : (1 : ℝ) < n := by exact_mod_cast (by omega : 1 < n)
  have hn0 : (0 : ℝ) < n := zero_lt_one.trans hn1
  have hlog : 0 < Real.log (n : ℝ) := Real.log_pos hn1
  let u : ℝ := ArithmeticFunction.vonMangoldt n / Real.log (n : ℝ)
  let r : ℝ := (n : ℝ) ^ (-10 : ℝ)
  have hu0 : 0 ≤ u := div_nonneg ArithmeticFunction.vonMangoldt_nonneg hlog.le
  have hu1 : u ≤ 1 := (div_le_one hlog).mpr ArithmeticFunction.vonMangoldt_le_log
  have hr0 : 0 ≤ r := Real.rpow_nonneg hn0.le _
  have hr1 : r ≤ 1 := Real.rpow_le_one_of_one_le_of_nonpos hn1.le (by norm_num)
  have hsplit : u = minorantMangoldtMellinWeight n + u * r := by
    calc
      _ = ArithmeticFunction.vonMangoldt n * (1 / Real.log (n : ℝ)) := by
        dsimp only [u]
        ring
      _ = ArithmeticFunction.vonMangoldt n *
          ((∫ t in (0 : ℝ)..10, (n : ℝ) ^ (-t)) +
            (n : ℝ) ^ (-10 : ℝ) / Real.log (n : ℝ)) :=
        congrArg (fun z : ℝ => ArithmeticFunction.vonMangoldt n * z)
          (reciprocal_log_finite_mellin (n : ℝ) hn1 10)
      _ = _ := by dsimp only [minorantMangoldtMellinWeight, u, r]; ring
  have hmul0 : 0 ≤ u * r := mul_nonneg hu0 hr0
  have hmulU : u * r ≤ u := by simpa only [mul_one] using mul_le_mul_of_nonneg_left hr1 hu0
  have hmulR : u * r ≤ r := by simpa only [one_mul] using mul_le_mul_of_nonneg_right hu1 hr0
  exact ⟨by linarith, by linarith, hu1, by linarith⟩

theorem positive_product_difference_le {ι : Type*} (S : Finset ι)
    (a b : ι → ℝ) (h : ∀ i ∈ S, 0 ≤ b i ∧ b i ≤ a i ∧ a i ≤ 1) :
    0 ≤ (∏ i ∈ S, a i) - ∏ i ∈ S, b i ∧
      (∏ i ∈ S, a i) - ∏ i ∈ S, b i ≤ ∑ i ∈ S, (a i - b i) := by
  classical
  induction S using Finset.induction_on with
  | empty => simp
  | @insert i S hi ih =>
    have hS : ∀ j ∈ S, 0 ≤ b j ∧ b j ≤ a j ∧ a j ≤ 1 :=
      fun j hj => h j (Finset.mem_insert_of_mem hj)
    obtain ⟨hrest0, hrest⟩ := ih hS
    obtain ⟨hbi, hbia, hai⟩ := h i (Finset.mem_insert_self i S)
    have hbS0 : 0 ≤ ∏ j ∈ S, b j := Finset.prod_nonneg fun j hj => (hS j hj).1
    have hbS1 : (∏ j ∈ S, b j) ≤ 1 :=
      Finset.prod_le_one (fun j hj => (hS j hj).1)
        (fun j hj => (hS j hj).2.1.trans (hS j hj).2.2)
    have hai0 : 0 ≤ a i := hbi.trans hbia
    have hi0 : 0 ≤ a i - b i := sub_nonneg.mpr hbia
    have hexpand : a i * (∏ j ∈ S, a j) - b i * (∏ j ∈ S, b j) =
        a i * ((∏ j ∈ S, a j) - ∏ j ∈ S, b j) +
          (a i - b i) * ∏ j ∈ S, b j := by ring
    rw [Finset.prod_insert hi, Finset.prod_insert hi, Finset.sum_insert hi, hexpand]
    refine ⟨add_nonneg (mul_nonneg hai0 hrest0) (mul_nonneg hi0 hbS0), ?_⟩
    calc
      _ ≤ 1 * ((∏ j ∈ S, a j) - ∏ j ∈ S, b j) + (a i - b i) * 1 :=
        add_le_add (mul_le_mul_of_nonneg_right hai hrest0)
          (mul_le_mul_of_nonneg_left hbS1 hi0)
      _ ≤ _ := by simp only [one_mul, mul_one]; linarith

theorem three_mangoldt_mellin_tail (p : Fin 3 → ℕ) (hp : ∀ i, 2 ≤ p i) :
    0 ≤ (∏ i, ArithmeticFunction.vonMangoldt (p i) / Real.log (p i : ℝ)) -
      ∏ i, minorantMangoldtMellinWeight (p i) ∧
    (∏ i, ArithmeticFunction.vonMangoldt (p i) / Real.log (p i : ℝ)) -
      ∏ i, minorantMangoldtMellinWeight (p i) ≤ ∑ i, (p i : ℝ) ^ (-10 : ℝ) := by
  have hbound := positive_product_difference_le Finset.univ
    (fun i : Fin 3 => ArithmeticFunction.vonMangoldt (p i) / Real.log (p i : ℝ))
    (fun i : Fin 3 => minorantMangoldtMellinWeight (p i)) (by
      intro i hi
      have h := minorantMangoldtMellinWeight_bounds (p i) (hp i)
      exact ⟨h.1, h.2.1, h.2.2.1⟩)
  refine ⟨hbound.1, hbound.2.trans ?_⟩
  exact Finset.sum_le_sum fun i _ => (minorantMangoldtMellinWeight_bounds (p i) (hp i)).2.2.2

theorem three_mangoldt_mellin_tail_rpow (x η : ℝ) (hx : 0 < x)
    (p : Fin 3 → ℕ) (hp : ∀ i, 2 ≤ p i) (hscale : ∀ i, x ^ η ≤ (p i : ℝ)) :
    (∏ i, ArithmeticFunction.vonMangoldt (p i) / Real.log (p i : ℝ)) -
      ∏ i, minorantMangoldtMellinWeight (p i) ≤ 3 * x ^ (-10 * η) := by
  refine (three_mangoldt_mellin_tail p hp).2.trans ?_
  calc
    _ ≤ ∑ _i : Fin 3, x ^ (-10 * η) := by
      apply Finset.sum_le_sum
      intro i hi
      calc
        (p i : ℝ) ^ (-10 : ℝ) ≤ (x ^ η) ^ (-10 : ℝ) :=
          Real.rpow_le_rpow_of_nonpos (Real.rpow_pos_of_pos hx η) (hscale i) (by norm_num)
        _ = x ^ (-10 * η) := by rw [← Real.rpow_mul hx.le]; congr 1; ring
    _ = _ := by simp

theorem integral_three_separated_finsetSum
    {ι E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]
    (S : Finset ι) (f g h : ι → ℝ → ℝ)
    (hf : ∀ i ∈ S, Continuous (f i)) (hg : ∀ i ∈ S, Continuous (g i))
    (hh : ∀ i ∈ S, Continuous (h i)) (c : ι → E) :
    (∫ t in (0 : ℝ)..10, ∫ u in (0 : ℝ)..10, ∫ v in (0 : ℝ)..10,
      ∑ i ∈ S, (f i t * g i u * h i v) • c i) =
      ∑ i ∈ S, ((∫ t in (0 : ℝ)..10, f i t) *
        (∫ u in (0 : ℝ)..10, g i u) * (∫ v in (0 : ℝ)..10, h i v)) • c i := by
  have hinner (t u : ℝ) :
      (∫ v in (0 : ℝ)..10, ∑ i ∈ S, (f i t * g i u * h i v) • c i) =
        ∑ i ∈ S, (f i t * g i u * (∫ v in (0 : ℝ)..10, h i v)) • c i := by
    rw [intervalIntegral.integral_finsetSum
      (f := fun i v => (f i t * g i u * h i v) • c i) (fun i hi =>
      ((continuous_const.mul (hh i hi)).smul continuous_const).intervalIntegrable 0 10)]
    simp only [intervalIntegral.integral_smul_const, intervalIntegral.integral_const_mul]
  have hmiddle (t : ℝ) :
      (∫ u in (0 : ℝ)..10, ∑ i ∈ S,
        (f i t * g i u * (∫ v in (0 : ℝ)..10, h i v)) • c i) =
        ∑ i ∈ S, (f i t * (∫ u in (0 : ℝ)..10, g i u) *
          (∫ v in (0 : ℝ)..10, h i v)) • c i := by
    rw [intervalIntegral.integral_finsetSum
      (f := fun i u => (f i t * g i u * (∫ v in (0 : ℝ)..10, h i v)) • c i)
      (fun i hi =>
      (((continuous_const.mul (hg i hi)).mul continuous_const).smul
        continuous_const).intervalIntegrable 0 10)]
    simp only [intervalIntegral.integral_smul_const, intervalIntegral.integral_mul_const,
      intervalIntegral.integral_const_mul]
  simp_rw [hinner, hmiddle]
  rw [intervalIntegral.integral_finsetSum
    (f := fun i t => (f i t * (∫ u in (0 : ℝ)..10, g i u) *
      (∫ v in (0 : ℝ)..10, h i v)) • c i) (fun i hi =>
    ((((hf i hi).mul continuous_const).mul continuous_const).smul
      continuous_const).intervalIntegrable 0 10)]
  simp only [intervalIntegral.integral_smul_const, intervalIntegral.integral_mul_const]

theorem three_mangoldt_mellin_finset_interchange
    {ι E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]
    (S : Finset ι) (p : ι → Fin 3 → ℕ)
    (hp : ∀ i ∈ S, ∀ j, 0 < p i j) (c : ι → E) :
    (∑ i ∈ S, (∏ j, minorantMangoldtMellinWeight (p i j)) • c i) =
      ∫ t in (0 : ℝ)..10, ∫ u in (0 : ℝ)..10, ∫ v in (0 : ℝ)..10,
        ∑ i ∈ S, (∏ j, ArithmeticFunction.vonMangoldt (p i j) *
          (p i j : ℝ) ^ (-(![t, u, v] j))) • c i := by
  have hcont (i : ι) (hi : i ∈ S) (j : Fin 3) :
      Continuous (fun t : ℝ => ArithmeticFunction.vonMangoldt (p i j) *
        (p i j : ℝ) ^ (-t)) := by
    exact continuous_const.mul ((Real.continuous_const_rpow
      (by exact_mod_cast (hp i hi j).ne')).comp continuous_neg)
  simpa [Fin.prod_univ_three, minorantMangoldtMellinWeight,
    intervalIntegral.integral_const_mul] using
    (integral_three_separated_finsetSum S
      (fun i t => ArithmeticFunction.vonMangoldt (p i 0) * (p i 0 : ℝ) ^ (-t))
      (fun i u => ArithmeticFunction.vonMangoldt (p i 1) * (p i 1 : ℝ) ^ (-u))
      (fun i v => ArithmeticFunction.vonMangoldt (p i 2) * (p i 2 : ℝ) ^ (-v))
      (fun i hi => hcont i hi 0) (fun i hi => hcont i hi 1)
      (fun i hi => hcont i hi 2) c).symm

theorem norm_three_interval_integral_le
    {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E]
    (F : ℝ → ℝ → ℝ → E) (B : ℝ)
    (hF : ∀ t ∈ Set.Icc (0 : ℝ) 10, ∀ u ∈ Set.Icc (0 : ℝ) 10,
      ∀ v ∈ Set.Icc (0 : ℝ) 10, ‖F t u v‖ ≤ B) :
    ‖∫ t in (0 : ℝ)..10, ∫ u in (0 : ℝ)..10, ∫ v in (0 : ℝ)..10, F t u v‖ ≤
      1000 * B := by
  have hmem {t : ℝ} (ht : t ∈ Set.uIoc (0 : ℝ) 10) : t ∈ Set.Icc (0 : ℝ) 10 := by
    rw [Set.uIoc_of_le (by norm_num : (0 : ℝ) ≤ 10)] at ht
    exact ⟨ht.1.le, ht.2⟩
  have hbound := intervalIntegral.norm_integral_le_of_norm_le_const
    (fun t ht => intervalIntegral.norm_integral_le_of_norm_le_const
      (fun u hu => intervalIntegral.norm_integral_le_of_norm_le_const
        (fun v hv => hF t (hmem ht) u (hmem hu) v (hmem hv))))
  convert hbound using 1
  norm_num
  ring

theorem three_mangoldt_mellin_sum_norm_transfer
    {ι κ : Type*} [Fintype κ] (S : Finset ι) (p : ι → Fin 3 → ℕ)
    (hp : ∀ i ∈ S, ∀ j, 0 < p i j) (c : ι → κ → ℂ) (B : ℝ)
    (hbound : ∀ t ∈ Set.Icc (0 : ℝ) 10, ∀ u ∈ Set.Icc (0 : ℝ) 10,
      ∀ v ∈ Set.Icc (0 : ℝ) 10,
        (∑ q, ‖∑ i ∈ S, (∏ j, ArithmeticFunction.vonMangoldt (p i j) *
          (p i j : ℝ) ^ (-(![t, u, v] j))) • c i q‖) ≤ B) :
    (∑ q, ‖∑ i ∈ S, (∏ j, minorantMangoldtMellinWeight (p i j)) • c i q‖) ≤
      1000 * B := by
  classical
  let d : ι → PiLp 1 (fun _ : κ => ℂ) := fun i => WithLp.toLp 1 (c i)
  have hrow (a : ι → ℝ) (q : κ) :
      (∑ i ∈ S, a i • d i) q = ∑ i ∈ S, a i • c i q := by
    change (PiLp.projₗ (𝕜 := ℝ) (β := fun _ : κ => ℂ) 1 q)
      (∑ i ∈ S, a i • d i) = _
    rw [map_sum]
    apply Finset.sum_congr rfl
    intro i hi
    rfl
  have hnorm (a : ι → ℝ) :
      ‖∑ i ∈ S, a i • d i‖ = ∑ q, ‖∑ i ∈ S, a i • c i q‖ := by
    rw [PiLp.norm_eq_of_L1]
    simp only [hrow]
  rw [← hnorm]
  rw [three_mangoldt_mellin_finset_interchange S p hp d]
  apply norm_three_interval_integral_le
  intro t ht u hu v hv
  rw [hnorm]
  exact hbound t ht u hu v hv

theorem three_tuple_product_fiber_card_le
    (T : Finset (Fin 3 → ℕ)) (hpos : ∀ p ∈ T, ∀ i, 0 < p i) (n : ℕ) :
    (T.filter (fun p => ∏ i, p i = n)).card ≤ n.divisors.card ^ 2 := by
  classical
  have hmap : Set.MapsTo (fun p : Fin 3 → ℕ => (p 0, p 1))
      (T.filter (fun p => ∏ i, p i = n))
      (↑(n.divisors ×ˢ n.divisors) : Set (ℕ × ℕ)) := by
    intro p hp
    obtain ⟨hpT, hpn⟩ := Finset.mem_filter.mp hp
    have hn : n ≠ 0 := by
      rw [← hpn]
      exact Finset.prod_ne_zero_iff.mpr fun i _ => (hpos p hpT i).ne'
    have hdiv (i : Fin 3) : p i ∈ n.divisors := by
      apply Nat.mem_divisors.mpr
      refine ⟨?_, hn⟩
      rw [← hpn]
      exact Finset.dvd_prod_of_mem _ (Finset.mem_univ i)
    exact Finset.mem_product.mpr ⟨hdiv 0, hdiv 1⟩
  have hinj : (T.filter (fun p => ∏ i, p i = n) : Set (Fin 3 → ℕ)).InjOn
      (fun p => (p 0, p 1)) := by
    intro p hp q hq heq
    have h0 : p 0 = q 0 := congrArg Prod.fst heq
    have h1 : p 1 = q 1 := congrArg Prod.snd heq
    have hprod : p 0 * p 1 * p 2 = q 0 * q 1 * q 2 := by
      simpa only [Fin.prod_univ_three] using
        (Finset.mem_filter.mp hp).2.trans (Finset.mem_filter.mp hq).2.symm
    rw [← h0, ← h1] at hprod
    have h2 : p 2 = q 2 := Nat.eq_of_mul_eq_mul_left
      (Nat.mul_pos (hpos p (Finset.mem_filter.mp hp).1 0)
        (hpos p (Finset.mem_filter.mp hp).1 1)) hprod
    funext i
    fin_cases i
    · exact h0
    · exact h1
    · exact h2
  simpa only [Finset.card_product, pow_two] using
    Finset.card_le_card_of_injOn (fun p : Fin 3 → ℕ => (p 0, p 1)) hmap hinj

theorem roughWeight_prime_of_lt_square (z : ℝ) (hz : 0 ≤ z) (n : ℕ)
    (hnOne : n ≠ 1) (hrough : roughWeight z n ≠ 0) (hnSmall : (n : ℝ) < z ^ 2) :
    n.Prime ∧ z ≤ (n : ℝ) := by
  classical
  have hr : n ≠ 0 ∧ ∀ p ∈ n.primeFactors, z ≤ (p : ℝ) :=
    (ite_ne_right_iff.mp hrough).1
  have hnPrime : n.Prime := by
    by_contra hn
    have hm := Nat.minFac_sq_le_self (Nat.pos_of_ne_zero hr.1) hn
    have hmPrime := Nat.minFac_prime hnOne
    have hmMem : n.minFac ∈ n.primeFactors :=
      (Nat.mem_primeFactors_of_ne_zero hr.1).mpr ⟨hmPrime, Nat.minFac_dvd n⟩
    have hmLo := hr.2 n.minFac hmMem
    have hmSquare : (n.minFac : ℝ) ^ 2 ≤ (n : ℝ) := by exact_mod_cast hm
    have hnLo : z ^ 2 ≤ (n : ℝ) := (pow_le_pow_left₀ hz hmLo 2).trans hmSquare
    exact (not_lt_of_ge hnLo) hnSmall
  exact ⟨hnPrime, hr.2 n hnPrime.mem_primeFactors_self⟩

theorem eventually_sourceT3_T4_large :
    ∀ᶠ x : ℝ in Filter.atTop,
      3 ≤ x ∧ 2 * x < x ^ (4 * (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000)) := by
  have h := tendsto_rpow_atTop
    (by norm_num : (0 : ℝ) < 4 * (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000) - 1)
  filter_upwards [Filter.eventually_ge_atTop (3 : ℝ), h.eventually_gt_atTop 2]
    with x hx hg
  have hxPos : 0 < x := lt_of_lt_of_le (by norm_num : (0 : ℝ) < 3) hx
  refine ⟨hx, ?_⟩
  calc
    2 * x < x ^ (4 * (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000) - 1) * x :=
      mul_lt_mul_of_pos_right hg hxPos
    _ = x ^ ((4 * (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000) - 1) + 1) := by
      rw [Real.rpow_add hxPos, Real.rpow_one]
    _ = _ := by congr 1; ring

theorem sourceT3_eventually_residual_prime :
    ∃ X : ℝ, 3 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ n p q r : ℕ,
        x ≤ (n : ℝ) → (n : ℝ) ≤ 2 * x → n = p * q * r →
        p.Prime → q.Prime →
        (9519 : ℝ) / 50000 ≤ Real.logb x (q : ℝ) →
        Real.logb x (q : ℝ) < Real.logb x (p : ℝ) →
        Real.logb x (p : ℝ) < (40481 : ℝ) / 100000 →
        (59519 : ℝ) / 100000 < Real.logb x (p : ℝ) + Real.logb x (q : ℝ) →
        1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000 ≤ Real.logb x (q : ℝ) →
        roughWeight (q : ℝ) r ≠ 0 →
        r.Prime ∧ (q : ℝ) ≤ (r : ℝ) := by
  classical
  obtain ⟨X, hX⟩ := eventually_sourceT3_T4_large.exists_forall_of_atTop
  refine ⟨max 3 X, le_max_left _ _, ?_⟩
  intro x hx n p q r hnLo hnHi hn hp hq _hξ hqp hpa _hpq hζ hrough
  obtain ⟨hxThree, hlarge⟩ := hX x ((le_max_right _ _).trans hx)
  have hxOne : 1 < x := lt_of_lt_of_le (by norm_num : (1 : ℝ) < 3) hxThree
  have hxPos : 0 < x := zero_lt_one.trans hxOne
  have hpPos : 0 < (p : ℝ) := Nat.cast_pos.mpr hp.pos
  have hqPos : 0 < (q : ℝ) := Nat.cast_pos.mpr hq.pos
  have hnReal : (n : ℝ) = (p : ℝ) * (q : ℝ) * (r : ℝ) := by exact_mod_cast hn
  have hrOne : r ≠ 1 := by
    intro hr
    have hnProduct : (n : ℝ) = (p : ℝ) * (q : ℝ) := by
      simpa only [hr, Nat.cast_one, mul_one] using hnReal
    have hlogn := Real.logb_le_logb_of_le hxOne hxPos hnLo
    rw [Real.logb_self_eq_one hxOne, hnProduct, Real.logb_mul hpPos.ne' hqPos.ne'] at hlogn
    linarith only [hlogn, hqp, hpa]
  have hrSmall : (r : ℝ) < (q : ℝ) ^ 2 := by
    by_contra hbad
    have hrSquare : (q : ℝ) ^ 2 ≤ (r : ℝ) := le_of_not_gt hbad
    have hqLeP : (q : ℝ) ≤ (p : ℝ) :=
      ((Real.logb_lt_logb_iff hxOne hqPos hpPos).mp hqp).le
    have hqLo : x ^ (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000) ≤ (q : ℝ) :=
      (Real.le_logb_iff_rpow_le hxOne hqPos).mp hζ
    have hpair : (q : ℝ) * (q : ℝ) ≤ (p : ℝ) * (q : ℝ) :=
      mul_le_mul_of_nonneg_right hqLeP hqPos.le
    have hfour : (q : ℝ) ^ 4 ≤ (p : ℝ) * (q : ℝ) * (r : ℝ) := by
      calc
        (q : ℝ) ^ 4 = ((q : ℝ) * (q : ℝ)) * (q : ℝ) ^ 2 := by ring
        _ ≤ _ := mul_le_mul hpair hrSquare (sq_nonneg _) (mul_pos hpPos hqPos).le
    have hbig : x ^ (4 * (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000)) ≤ (n : ℝ) := by
      calc
        _ = (x ^ (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000)) ^ (4 : ℕ) := by
          rw [← Real.rpow_mul_natCast hxPos.le]
          congr 1
          ring
        _ ≤ (q : ℝ) ^ 4 := pow_le_pow_left₀ (Real.rpow_nonneg hxPos.le _) hqLo 4
        _ ≤ (p : ℝ) * (q : ℝ) * (r : ℝ) := hfour
        _ = (n : ℝ) := hnReal.symm
    exact (not_lt_of_ge hnHi) (hlarge.trans_le hbig)
  exact roughWeight_prime_of_lt_square (q : ℝ) hqPos.le r hrOne hrough hrSmall

theorem sourceT4_eventually_residual_prime :
    ∃ X : ℝ, 3 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ n p q r s : ℕ,
        x ≤ (n : ℝ) → (n : ℝ) ≤ 2 * x → n = p * q * r * s →
        p.Prime → q.Prime → r.Prime →
        (9519 : ℝ) / 50000 ≤ Real.logb x (r : ℝ) →
        Real.logb x (r : ℝ) < Real.logb x (q : ℝ) →
        Real.logb x (q : ℝ) < Real.logb x (p : ℝ) →
        Real.logb x (p : ℝ) < (40481 : ℝ) / 100000 →
        (59519 : ℝ) / 100000 < Real.logb x (p : ℝ) + Real.logb x (q : ℝ) →
        Real.logb x (q : ℝ) < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000 →
        roughWeight (r : ℝ) s ≠ 0 →
        s.Prime ∧ (r : ℝ) ≤ (s : ℝ) := by
  classical
  obtain ⟨X, hX⟩ := eventually_sourceT3_T4_large.exists_forall_of_atTop
  refine ⟨max 3 X, le_max_left _ _, ?_⟩
  intro x hx n p q r s hnLo hnHi hn hp hq hr hξ hrq _hqp hpa hpq hζ hrough
  obtain ⟨hxThree, hlarge⟩ := hX x ((le_max_right _ _).trans hx)
  have hxOne : 1 < x := lt_of_lt_of_le (by norm_num : (1 : ℝ) < 3) hxThree
  have hxPos : 0 < x := zero_lt_one.trans hxOne
  have hpPos : 0 < (p : ℝ) := Nat.cast_pos.mpr hp.pos
  have hqPos : 0 < (q : ℝ) := Nat.cast_pos.mpr hq.pos
  have hrPos : 0 < (r : ℝ) := Nat.cast_pos.mpr hr.pos
  have hnReal : (n : ℝ) = (p : ℝ) * (q : ℝ) * (r : ℝ) * (s : ℝ) := by
    exact_mod_cast hn
  have hsOne : s ≠ 1 := by
    intro hs
    have hnProduct : (n : ℝ) = (p : ℝ) * (q : ℝ) * (r : ℝ) := by
      simpa only [hs, Nat.cast_one, mul_one] using hnReal
    have hlogn := Real.logb_le_logb_of_le hxOne hxPos hnLo
    rw [Real.logb_self_eq_one hxOne, hnProduct,
      Real.logb_mul (mul_pos hpPos hqPos).ne' hrPos.ne',
      Real.logb_mul hpPos.ne' hqPos.ne'] at hlogn
    linarith only [hlogn, hrq, hpa, hζ]
  have hsSmall : (s : ℝ) < (r : ℝ) ^ 2 := by
    by_contra hbad
    have hsSquare : (r : ℝ) ^ 2 ≤ (s : ℝ) := le_of_not_gt hbad
    have hrLo : x ^ ((9519 : ℝ) / 50000) ≤ (r : ℝ) :=
      (Real.le_logb_iff_rpow_le hxOne hrPos).mp hξ
    have hpqLo : x ^ ((59519 : ℝ) / 100000) ≤ (p : ℝ) * (q : ℝ) := by
      apply (Real.le_logb_iff_rpow_le hxOne (mul_pos hpPos hqPos)).mp
      simpa only [Real.logb_mul hpPos.ne' hqPos.ne'] using hpq.le
    have hrs : (x ^ ((9519 : ℝ) / 50000)) ^ (3 : ℕ) ≤ (r : ℝ) * (s : ℝ) := by
      calc
        _ ≤ (r : ℝ) ^ 3 := pow_le_pow_left₀ (Real.rpow_nonneg hxPos.le _) hrLo 3
        _ = (r : ℝ) * (r : ℝ) ^ 2 := by ring
        _ ≤ (r : ℝ) * (s : ℝ) := mul_le_mul_of_nonneg_left hsSquare hrPos.le
    have hbig :
        x ^ ((59519 : ℝ) / 100000 + 3 * ((9519 : ℝ) / 50000)) ≤ (n : ℝ) := by
      calc
        _ = x ^ ((59519 : ℝ) / 100000) *
            (x ^ ((9519 : ℝ) / 50000)) ^ (3 : ℕ) := by
          rw [Real.rpow_add hxPos, ← Real.rpow_mul_natCast hxPos.le]
          congr 2
          ring
        _ ≤ ((p : ℝ) * (q : ℝ)) * ((r : ℝ) * (s : ℝ)) :=
          mul_le_mul hpqLo hrs (by positivity) (mul_pos hpPos hqPos).le
        _ = (n : ℝ) := by rw [hnReal]; ring
    have hpower :
        x ^ (4 * (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000)) ≤
          x ^ ((59519 : ℝ) / 100000 + 3 * ((9519 : ℝ) / 50000)) :=
      Real.rpow_le_rpow_of_exponent_le hxOne.le (by norm_num)
    exact (not_lt_of_ge hnHi) (hlarge.trans_le (hpower.trans hbig))
  exact roughWeight_prime_of_lt_square (r : ℝ) hrPos.le s hsOne hrough hsSmall

open Classical in
/--
The Boolean test for the three-exponent `T3` region, including the condition that the remaining
exponent is at least the smaller of the two selected prime exponents.
-/
noncomputable def sourceT3ExponentMask (α : Fin 3 → ℝ) : Bool :=
  decide ((9519 : ℝ) / 50000 ≤ α 1 ∧ α 1 < α 0 ∧
    α 0 < (40481 : ℝ) / 100000 ∧ (59519 : ℝ) / 100000 < α 0 + α 1 ∧
    1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000 ≤ α 1 ∧ α 1 ≤ α 2)

open Classical in
theorem sum_three_prime_divisorsAntidiagonal {A : Type*} [AddCommMonoid A]
    (n : ℕ) (w : (Fin 3 → ℕ) → A) :
    (∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
      if a.1.Prime ∧ b.1.Prime ∧ b.2.Prime then w ![a.1, b.1, b.2] else 0) =
      ∑ p ∈ Fintype.piFinset (fun _ : Fin 3 => Nat.primesLE n),
        if (∏ i, p i) = n then w p else 0 := by
  let S : Finset (Σ _ : ℕ × ℕ, ℕ × ℕ) :=
    (n.divisorsAntidiagonal.sigma (fun a => a.2.divisorsAntidiagonal)).filter
      (fun v => v.1.1.Prime ∧ v.2.1.Prime ∧ v.2.2.Prime)
  let T : Finset (Fin 3 → ℕ) :=
    (Fintype.piFinset (fun _ : Fin 3 => Nat.primesLE n)).filter (fun p => ∏ i, p i = n)
  let f : (Σ _ : ℕ × ℕ, ℕ × ℕ) → Fin 3 → ℕ := fun v => ![v.1.1, v.2.1, v.2.2]
  calc
    _ = ∑ v ∈ S, w (f v) := by
      simp only [S, f, Finset.sum_filter, Finset.sum_sigma]
    _ = ∑ p ∈ T, w p := by
      refine Finset.sum_bij (fun v _ => f v) ?_ ?_ ?_ (fun _ _ => rfl)
      · intro v hv
        obtain ⟨hvs, hp, hq, hr⟩ := Finset.mem_filter.mp hv
        obtain ⟨ha, hb⟩ := Finset.mem_sigma.mp hvs
        have hproduct : ∏ i, f v i = n := by
          rw [Fin.prod_univ_three]
          change v.1.1 * v.2.1 * v.2.2 = n
          rw [Nat.mul_assoc, (Nat.mem_divisorsAntidiagonal.mp hb).1,
            (Nat.mem_divisorsAntidiagonal.mp ha).1]
        have hprime (i : Fin 3) : (f v i).Prime := by
          fin_cases i
          · simpa [f] using hp
          · simpa [f] using hq
          · simpa [f] using hr
        apply Finset.mem_filter.mpr
        refine ⟨Fintype.mem_piFinset.mpr (fun i => ?_), hproduct⟩
        apply Nat.mem_primesLE.mpr
        refine ⟨Nat.le_of_dvd (Nat.pos_of_ne_zero (Nat.mem_divisorsAntidiagonal.mp ha).2) ?_,
          hprime i⟩
        rw [← hproduct]
        exact Finset.dvd_prod_of_mem _ (Finset.mem_univ i)
      · intro v hv u hu heq
        have h0 : v.1.1 = u.1.1 := congrArg (fun p : Fin 3 → ℕ => p 0) heq
        have h1 : v.2.1 = u.2.1 := congrArg (fun p : Fin 3 → ℕ => p 1) heq
        have h2 : v.2.2 = u.2.2 := congrArg (fun p : Fin 3 → ℕ => p 2) heq
        obtain ⟨_, hvb⟩ := Finset.mem_sigma.mp (Finset.mem_filter.mp hv).1
        obtain ⟨_, hub⟩ := Finset.mem_sigma.mp (Finset.mem_filter.mp hu).1
        have ha : v.1.2 = u.1.2 := by
          rw [← (Nat.mem_divisorsAntidiagonal.mp hvb).1,
            ← (Nat.mem_divisorsAntidiagonal.mp hub).1, h1, h2]
        exact Sigma.ext (Prod.ext h0 ha) (heq_of_eq (Prod.ext h1 h2))
      · intro p hp
        obtain ⟨hpp, hpn⟩ := Finset.mem_filter.mp hp
        have hprime (i : Fin 3) := Nat.prime_of_mem_primesLE (Fintype.mem_piFinset.mp hpp i)
        have hn : n ≠ 0 := by
          rw [← hpn]
          exact Finset.prod_ne_zero_iff.mpr (fun i _ => (hprime i).ne_zero)
        have hprod : p 0 * (p 1 * p 2) = n := by
          simpa only [Fin.prod_univ_three, Nat.mul_assoc] using hpn
        let v : Σ _ : ℕ × ℕ, ℕ × ℕ := ⟨(p 0, p 1 * p 2), (p 1, p 2)⟩
        have hv : v ∈ S := by
          apply Finset.mem_filter.mpr
          refine ⟨Finset.mem_sigma.mpr ⟨?_, ?_⟩, hprime 0, hprime 1, hprime 2⟩
          · exact Nat.mem_divisorsAntidiagonal.mpr ⟨hprod, hn⟩
          · exact Nat.mem_divisorsAntidiagonal.mpr
              ⟨rfl, mul_ne_zero (hprime 1).ne_zero (hprime 2).ne_zero⟩
        refine ⟨v, hv, ?_⟩
        funext i
        fin_cases i <;> simp [f, v]
    _ = _ := by simp only [T, Finset.sum_filter]

open Classical in
theorem sourceT3_eventually_eq_three_prime_tuple_sum :
    ∃ X : ℝ, 3 ≤ X ∧ ∀ x : ℝ, X ≤ x → ∀ n : ℕ,
      x ≤ (n : ℝ) → (n : ℝ) ≤ 2 * x →
      sourceT3 x n =
        ∑ p ∈ Fintype.piFinset (fun _ : Fin 3 => Nat.primesLE n),
          if (∏ i, p i) = n then
            (if sourceT3ExponentMask (fun i => Real.logb x (p i : ℝ)) then (1 : ℝ) else 0)
          else 0 := by
  obtain ⟨X, hX, hres⟩ := sourceT3_eventually_residual_prime
  refine ⟨X, hX, ?_⟩
  intro x hx n hnlo hnhi
  have hxOne : 1 < x := (by norm_num : (1 : ℝ) < 3).trans_le (hX.trans hx)
  rw [← sum_three_prime_divisorsAntidiagonal n
    (fun p => if sourceT3ExponentMask (fun i => Real.logb x (p i : ℝ)) then 1 else 0)]
  change (∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal, _) = _
  refine Finset.sum_congr rfl (fun a ha => ?_)
  refine Finset.sum_congr rfl (fun b hb => ?_)
  let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
  let P : Prop := a.1.Prime ∧ b.1.Prime ∧
    (9519 : ℝ) / 50000 ≤ α b.1 ∧ α b.1 < α a.1 ∧
    α a.1 < (40481 : ℝ) / 100000 ∧ (59519 : ℝ) / 100000 < α a.1 + α b.1 ∧
    1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000 ≤ α b.1
  change (if P then roughWeight (b.1 : ℝ) b.2 else 0) =
    if a.1.Prime ∧ b.1.Prime ∧ b.2.Prime then
      (if sourceT3ExponentMask ![α a.1, α b.1, α b.2] then 1 else 0) else 0
  by_cases hP : P
  · rw [ite_eq_left hP]
    obtain ⟨hp, hq, hξ, hqp, hpa, hpq, hζ⟩ := hP
    by_cases hr : b.2.Prime
    · have horder : α b.1 ≤ α b.2 ↔ (b.1 : ℝ) ≤ (b.2 : ℝ) :=
        Real.logb_le_logb hxOne (Nat.cast_pos.mpr hq.pos) (Nat.cast_pos.mpr hr.pos)
      have hm : sourceT3ExponentMask ![α a.1, α b.1, α b.2] =
          decide ((b.1 : ℝ) ≤ (b.2 : ℝ)) := by
        simp [sourceT3ExponentMask, hξ, hqp, hpa, hpq, hζ, horder]
      rw [ite_eq_left ⟨hp, hq, hr⟩, hm]
      rw [roughWeight_eq_ite_minFac (b.1 : ℝ) hr.ne_zero hr.ne_one, hr.minFac_eq]
      simp
    · rw [ite_eq_right (fun h => hr h.2.2)]
      by_contra hrough
      have hn : n = a.1 * b.1 * b.2 := by
        symm
        rw [Nat.mul_assoc, (Nat.mem_divisorsAntidiagonal.mp hb).1,
          (Nat.mem_divisorsAntidiagonal.mp ha).1]
      exact hr ((hres x hx n a.1 b.1 b.2 hnlo hnhi hn
        hp hq hξ hqp hpa hpq hζ hrough).1)
  · rw [ite_eq_right hP]
    by_cases hprime : a.1.Prime ∧ b.1.Prime ∧ b.2.Prime
    · rw [ite_eq_left hprime]
      symm
      apply ite_eq_right
      intro hm
      have hcuts : (9519 : ℝ) / 50000 ≤ α b.1 ∧ α b.1 < α a.1 ∧
          α a.1 < (40481 : ℝ) / 100000 ∧ (59519 : ℝ) / 100000 < α a.1 + α b.1 ∧
          1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000 ≤ α b.1 ∧ α b.1 ≤ α b.2 := by
        unfold sourceT3ExponentMask at hm
        simpa using of_decide_eq_true hm
      exact hP ⟨hprime.1, hprime.2.1, hcuts.1, hcuts.2.1,
        hcuts.2.2.1, hcuts.2.2.2.1, hcuts.2.2.2.2.1⟩
    · rw [ite_eq_right hprime]

open Classical in
theorem sourceT3_prime_tuple_exponent_bounds
    (x : ℝ) (hx : 1 < x) (p : Fin 3 → ℕ) (hp : ∀ i, (p i).Prime)
    (hproduct : ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x)
    (hcut : sourceT3ExponentMask (fun i => Real.logb x (p i : ℝ)) = true) :
    ∀ i, 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000 ≤
      Real.logb x (p i : ℝ) ∧
      Real.logb x (p i : ℝ) ≤ (40481 : ℝ) / 100000 + Real.logb x 2 := by
  let α (i : Fin 3) : ℝ := Real.logb x (p i : ℝ)
  have hcuts : (9519 : ℝ) / 50000 ≤ α 1 ∧ α 1 < α 0 ∧
      α 0 < (40481 : ℝ) / 100000 ∧ (59519 : ℝ) / 100000 < α 0 + α 1 ∧
      1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000 ≤ α 1 ∧ α 1 ≤ α 2 :=
    of_decide_eq_true hcut
  have hxpos : 0 < x := zero_lt_one.trans hx
  have hpPos (i : Fin 3) : (0 : ℝ) < p i := Nat.cast_pos.mpr (hp i).pos
  have hproductPos : (0 : ℝ) < (∏ i, p i : ℕ) := by
    exact_mod_cast Finset.prod_pos (fun i _ => (hp i).pos)
  have hsum : α 0 + α 1 + α 2 ≤ 1 + Real.logb x 2 := by
    have h := Real.logb_le_logb_of_le hx hproductPos hproduct
    rw [Fin.prod_univ_three, Nat.cast_mul, Nat.cast_mul,
      Real.logb_mul (mul_pos (hpPos 0) (hpPos 1)).ne' (hpPos 2).ne',
      Real.logb_mul (hpPos 0).ne' (hpPos 1).ne',
      Real.logb_mul (by norm_num : (2 : ℝ) ≠ 0) hxpos.ne',
      Real.logb_self_eq_one hx] at h
    simpa only [α, add_comm (Real.logb x 2) 1] using h
  have htwo : 0 ≤ Real.logb x 2 := Real.logb_nonneg hx (by norm_num)
  obtain ⟨_, h10, h0a, h01b, hζ, h12⟩ := hcuts
  intro i
  fin_cases i
  · change _ ≤ α 0 ∧ α 0 ≤ _
    exact ⟨hζ.trans h10.le, h0a.le.trans (le_add_of_nonneg_right htwo)⟩
  · change _ ≤ α 1 ∧ α 1 ≤ _
    exact ⟨hζ, h10.le.trans (h0a.le.trans (le_add_of_nonneg_right htwo))⟩
  · change _ ≤ α 2 ∧ α 2 ≤ _
    exact ⟨hζ.trans h12, by linarith⟩

open Classical in
theorem minorant_t4_sub_u1_typeII_support (α : Fin 4 → ℝ)
    (_ : ∀ i, 0 ≤ α i)
    (hslo : 1 ≤ ∑ i, α i)
    (hshi : ∑ i, α i ≤ 1 + (1 / 10 ^ 10 : ℝ)) :
    let C4 : Prop :=
      (9519 / 50000 : ℝ) ≤ α 2 ∧ α 2 < α 1 ∧ α 1 < α 0 ∧
        α 0 < 40481 / 100000 ∧ 59519 / 100000 < α 0 + α 1 ∧
        α 1 < 1 - 1058 / 3125 - 40481 / 100000 ∧ α 2 ≤ α 3
    let U1 : Prop :=
      (9519 / 50000 : ℝ) ≤ α 2 ∧ α 2 < α 1 ∧ α 1 < 40481 / 100000 ∧
        α 2 + α 3 < 40481 / 100000 ∧
        α 1 < 1 - 1058 / 3125 - 40481 / 100000 ∧ α 2 ≤ α 3
    (if C4 then (1 : ℝ) else 0) - (if U1 then 1 else 0) ≠ 0 →
      (∀ i, (9519 / 50000 : ℝ) ≤ α i) ∧
        ∃ S : Finset (Fin 4), S.Nonempty ∧ S ≠ Finset.univ ∧
          (40481 / 100000 : ℝ) ≤ ∑ i ∈ S, α i ∧
            ∑ i ∈ S, α i ≤ (59519 / 100000 : ℝ) := by
  intro C4 U1 hmask
  rw [Fin.sum_univ_four] at hslo hshi
  by_cases hC : C4
  · by_cases hU : U1
    · simp [hC, hU] at hmask
    · rcases hC with ⟨h2, h21, h10, h0a, h01, h1z, h23⟩
      have h23lo : (40481 / 100000 : ℝ) ≤ α 2 + α 3 := by
        by_contra h
        apply hU
        exact ⟨h2, h21, h10.trans h0a, lt_of_not_ge h, h1z, h23⟩
      have h23hi : α 2 + α 3 ≤ (59519 / 100000 : ℝ) := by
        linarith
      refine ⟨?_, {2, 3}, by simp, by decide, ?_, ?_⟩
      · intro i
        fin_cases i <;> dsimp <;> linarith
      · simpa using h23lo
      · simpa using h23hi
  · by_cases hU : U1
    · rcases hU with ⟨h2, h21, h1a, h23a, h1z, h23⟩
      have h01 : (59519 / 100000 : ℝ) < α 0 + α 1 := by
        linarith
      have h10 : α 1 < α 0 := by
        linarith
      have h0lo : (40481 / 100000 : ℝ) ≤ α 0 := by
        by_contra h
        apply hC
        exact ⟨h2, h21, h10, lt_of_not_ge h, h01, h1z, h23⟩
      have h0hi : α 0 ≤ (59519 / 100000 : ℝ) := by
        linarith
      refine ⟨?_, {0}, by simp, by decide, ?_, ?_⟩
      · intro i
        fin_cases i <;> dsimp <;> linarith
      · simpa using h0lo
      · simpa using h0hi
    · simp [hC, hU] at hmask

theorem four_prime_geometric_bin_eq_closed_interval
    (x h : ℝ) (hx : 0 < x) (hh : 0 < h) (k : ℕ) :
    let P : Finset ℕ :=
      (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((11 : ℝ) / 25)⌋₊).filter Nat.Prime
    let L : ℝ := max (x ^ ((9519 : ℝ) / 50000)) ((1 + h) ^ k)
    let U : ℝ := min (x ^ ((11 : ℝ) / 25))
      ((⌈(1 + h) ^ (k + 1)⌉₊ - 1 : ℕ) : ℝ)
    P.filter (fun n : ℕ => ⌊Real.logb (1 + h) (n : ℝ)⌋₊ = k) =
      (Finset.Icc ⌈L⌉₊ ⌊U⌋₊).filter Nat.Prime := by
  classical
  intro P L U
  have hpow : 0 ≤ x ^ ((11 : ℝ) / 25) := (Real.rpow_pos_of_pos hx _).le
  have hU : 0 ≤ U := le_min hpow (Nat.cast_nonneg _)
  ext n
  by_cases hp : n.Prime
  · simp only [P, Finset.mem_filter, Finset.mem_Icc, hp, and_true,
      geometric_bin_integer_interval h hh n k hp.one_lt.le,
      Nat.ceil_le, Nat.le_floor_iff hpow, Nat.le_floor_iff hU]
    dsimp [L, U]
    rw [max_le_iff, le_min_iff, Nat.cast_le]
    tauto
  · simp [P, hp]

theorem four_prime_geometric_active_scales
    (x h : ℝ) (hx : 2 ≤ x) (hh : 0 < h) (hh1 : h ≤ 1)
    (b p : Fin 4 → ℕ) :
    let P : Finset ℕ :=
      (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((11 : ℝ) / 25)⌋₊).filter Nat.Prime
    let L (i : Fin 4) : ℝ := max (x ^ ((9519 : ℝ) / 50000)) ((1 + h) ^ b i)
    let U (i : Fin 4) : ℝ := min (x ^ ((11 : ℝ) / 25))
      ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ)
    (∀ i, p i ∈ P) →
    (∀ i, ⌊Real.logb (1 + h) (p i : ℝ)⌋₊ = b i) →
    (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ →
    (∀ i, x ^ ((1 : ℝ) / 10) ≤ L i ∧ L i ≤ U i ∧ U i ≤ 2 * L i) ∧
      x / 32 ≤ ∏ i, L i ∧ (∏ i, L i) ≤ 2 * x := by
  classical
  intro P L U hp hlabel hprod
  have hx1 : 1 ≤ x := (by norm_num : (1 : ℝ) ≤ 2).trans hx
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hbase : 0 < 1 + h := by linarith
  have hL (i : Fin 4) : 0 ≤ L i :=
    (Real.rpow_pos_of_pos hx0 _).le.trans (le_max_left _ _)
  have hpLU (i : Fin 4) : L i ≤ (p i : ℝ) ∧ (p i : ℝ) ≤ U i := by
    have hm : p i ∈ P.filter (fun n : ℕ => ⌊Real.logb (1 + h) (n : ℝ)⌋₊ = b i) :=
      Finset.mem_filter.mpr ⟨hp i, hlabel i⟩
    rw [four_prime_geometric_bin_eq_closed_interval x h hx0 hh (b i)] at hm
    have hm' := Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1
    exact ⟨Nat.le_of_ceil_le hm'.1,
      (Nat.cast_le.mpr hm'.2).trans (Nat.floor_le (by positivity))⟩
  have hU (i : Fin 4) : U i ≤ 2 * L i := by
    have hceil : 0 < ⌈(1 + h) ^ (b i + 1)⌉₊ :=
      Nat.ceil_pos.mpr (pow_pos hbase _)
    have htop : ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ) <
        (1 + h) ^ (b i + 1) := Nat.lt_ceil.mp (by omega)
    calc
      U i ≤ ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ) := min_le_right _ _
      _ ≤ (1 + h) ^ (b i + 1) := htop.le
      _ = (1 + h) * (1 + h) ^ b i := by rw [pow_succ]; ring
      _ ≤ 2 * L i := mul_le_mul (by linarith) (le_max_right _ _)
        (pow_nonneg hbase.le _) (by norm_num)
  have hproduct : x ≤ ∏ i, (p i : ℝ) ∧ (∏ i, (p i : ℝ)) ≤ 2 * x := by
    have hmem := Finset.mem_Icc.mp hprod
    constructor
    · exact_mod_cast Nat.le_of_ceil_le hmem.1
    · exact_mod_cast (Nat.cast_le.mpr hmem.2).trans (Nat.floor_le (by positivity))
  have hupper : (∏ i, L i) ≤ 2 * x :=
    (Finset.prod_le_prod (fun i _ => hL i) (fun i _ => (hpLU i).1)).trans hproduct.2
  have hcompare : (∏ i, (p i : ℝ)) ≤ 32 * ∏ i, L i := by
    calc
      _ ≤ ∏ i, 2 * L i := Finset.prod_le_prod (fun _ _ => Nat.cast_nonneg _)
        (fun i _ => (hpLU i).2.trans (hU i))
      _ = (16 : ℝ) * ∏ i, L i := by rw [Finset.prod_mul_distrib]; norm_num
      _ ≤ 32 * ∏ i, L i := mul_le_mul_of_nonneg_right (by norm_num)
        (Finset.prod_nonneg fun i _ => hL i)
  refine ⟨?_, ?_, hupper⟩
  · intro i
    exact ⟨(Real.rpow_le_rpow_of_exponent_le hx1 (by norm_num :
      (1 : ℝ) / 10 ≤ (9519 : ℝ) / 50000)).trans (le_max_left _ _),
      (hpLU i).1.trans (hpLU i).2, hU i⟩
  · linarith [hproduct.1, hcompare]

theorem four_geometric_label_ceiling_le (x h : ℝ)
    (hx : Real.exp 1 ≤ x) (hh : 0 < h) (hh1 : h ≤ 1) :
    ((⌈Real.logb (1 + h) (2 * x)⌉₊ + 1 : ℕ) : ℝ) ≤ 6 * Real.log x / h :=
  geometric_label_ceiling_le x h hx hh hh1

theorem four_geometric_log_mesh_spec (D x : ℝ) (hD : 0 ≤ D) (hx : Real.exp 1 ≤ x) :
    let h := (Real.log x) ^ (-D)
    0 < h ∧ h ≤ 1 ∧
      (((⌈Real.logb (1 + h) (2 * x)⌉₊ + 1 : ℕ) : ℝ) ^ 4 ≤
        (6 : ℝ) ^ 4 * (Real.log x) ^ (4 * (D + 1))) := by
  intro h
  have hlogx : 1 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 1) hx
  have hlogx0 : 0 < Real.log x := zero_lt_one.trans_le hlogx
  have hh : 0 < h := Real.rpow_pos_of_pos hlogx0 _
  have hh1 : h ≤ 1 :=
    Real.rpow_le_one_of_one_le_of_nonpos hlogx (neg_nonpos.mpr hD)
  refine ⟨hh, hh1, ?_⟩
  have halgebra : (6 * Real.log x / h) ^ 4 =
      (6 : ℝ) ^ 4 * (Real.log x) ^ (4 * (D + 1)) := by
    have hquot : 6 * Real.log x / h = 6 * (Real.log x) ^ (D + 1) := by
      dsimp [h]
      rw [Real.rpow_neg hlogx0.le, div_inv_eq_mul,
        Real.rpow_add hlogx0, Real.rpow_one]
      ring
    rw [hquot, mul_pow, ← Real.rpow_mul_natCast hlogx0.le (D + 1) 4]
    congr 2
    ring
  exact (pow_le_pow_left₀ (Nat.cast_nonneg _)
    (four_geometric_label_ceiling_le x h hx hh hh1) 4).trans_eq halgebra

/--
A multiplicative inequality on `k` coordinates, recorded as a quotient of coordinate products, a
threshold, and flags for lower versus upper comparison and strictness.
-/
structure MinorantSmallMonomialCut (k : ℕ) where
  /--
  Indices of the `k` coordinates multiplied in the quotient's numerator; the empty product is
  `1`.
  -/
  numerator : Finset (Fin k)
  /--
  Indices of the `k` coordinates multiplied in the quotient's denominator; the empty product is
  `1`.
  -/
  denominator : Finset (Fin k)
  /--
  The real comparison level for the coordinate-product quotient; the structure imposes no
  positivity condition on this field.
  -/
  threshold : ℝ
  /--
  Select a lower bound (`threshold ≤ value`) when `true`, and an upper bound (`value ≤
  threshold`) when `false`; `strict` changes `≤` to `<`.
  -/
  lower : Bool
  /--
  Select `<` when `true` and `≤` when `false`; `lower` determines which side contains the
  threshold.
  -/
  strict : Bool

/--
The real quotient of the numerator and denominator coordinate products of a `k`-coordinate cut,
using totalized real division.
-/
noncomputable def MinorantSmallMonomialCut.value {k : ℕ}
    (d : MinorantSmallMonomialCut k) (p : Fin k → ℕ) : ℝ :=
  (∏ i ∈ d.numerator, (p i : ℝ)) / ∏ i ∈ d.denominator, (p i : ℝ)

open Classical in
theorem prime_tuple_closed_sample_eq_compact
    (k A B : ℕ) (P : Finset ℕ) (hP : ∀ p ∈ P, p.Prime)
    (w : (Fin k → ℕ) → ℂ)
    (hcompact : ∀ p : Fin k → ℕ, (∀ i, (p i).Prime) →
      (∏ i, p i) ∈ Finset.Icc A B → w p ≠ 0 → ∀ i, p i ∈ P) :
    (∑ n ∈ Finset.Icc A B,
      Finsupp.single n
        (∑ p ∈ Fintype.piFinset (fun _ : Fin k => Nat.primesLE n),
          if (∏ i, p i) = n then w p else 0)) =
      ∑ p ∈ Fintype.piFinset (fun _ : Fin k => P),
        Finsupp.single (∏ i, p i)
          (if (∏ i, p i) ∈ Finset.Icc A B then w p else 0) := by
  let N := Finset.Icc A B
  let T := Fintype.piFinset (fun _ : Fin k => P)
  have hprime (p : Fin k → ℕ) (hp : p ∈ T) (i : Fin k) : (p i).Prime :=
    hP (p i) (Fintype.mem_piFinset.mp hp i)
  ext n
  simp only [Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_ite_eq']
  by_cases hn : n ∈ N
  · rw [ite_eq_left hn]
    have heq :
        (∑ p ∈ Fintype.piFinset (fun _ : Fin k => Nat.primesLE n),
          if (∏ i, p i) = n then w p else 0) =
        ∑ p ∈ T, if (∏ i, p i) = n then w p else 0 := by
      apply Finset.sum_congr_of_eq_on_inter
      · intro p hp hpT
        by_cases hpn : (∏ i, p i) = n
        · by_cases hw : w p = 0
          · simp only [ite_eq_left hpn, hw]
          · exfalso
            apply hpT
            apply Fintype.mem_piFinset.mpr
            exact hcompact p
              (fun i => Nat.prime_of_mem_primesLE (Fintype.mem_piFinset.mp hp i))
              (by simpa only [hpn] using hn) hw
        · exact ite_eq_right hpn
      · intro p hp hpN
        by_cases hpn : (∏ i, p i) = n
        · exfalso
          apply hpN
          apply Fintype.mem_piFinset.mpr
          intro i
          apply Nat.mem_primesLE.mpr
          refine ⟨Nat.le_of_dvd (by
            rw [← hpn]
            exact Finset.prod_pos (fun i _ => (hprime p hp i).pos)) ?_, hprime p hp i⟩
          rw [← hpn]
          exact Finset.dvd_prod_of_mem p (Finset.mem_univ i)
        · exact ite_eq_right hpn
      · intro _ _ _
        rfl
    rw [heq]
    apply Finset.sum_congr rfl
    intro p _hp
    by_cases hpn : (∏ i, p i) = n
    · have hm : (∏ i, p i) ∈ N := by simpa only [hpn] using hn
      dsimp only [N] at hm
      simp only [ite_eq_left hpn, ite_eq_left hm]
    · simp only [ite_eq_right hpn]
  · rw [ite_eq_right hn]
    symm
    apply Finset.sum_eq_zero
    intro p _hp
    by_cases hpn : (∏ i, p i) = n
    · have hm : (∏ i, p i) ∉ N := by simpa only [hpn] using hn
      dsimp only [N] at hm
      simp only [ite_eq_left hpn, ite_eq_right hm]
    · simp only [ite_eq_right hpn]

open Classical in
theorem sourceCentralPair_three_monomial_representation (x : ℝ) (hx : 1 < x) :
    ∃ M : Finset (MinorantSmallMonomialCut 3), M.card ≤ 32 ∧
      (∀ d ∈ M, d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
        d.numerator.card + d.denominator.card ≤ 3 ∧ 0 < d.threshold) ∧
      let P := (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
        (Nat.floor (x ^ ((9 : ℝ) / 10)))).filter Nat.Prime
      let T := Fintype.piFinset (fun _ : Fin 3 => P)
      let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
      let C (p : Fin 3 → ℕ) : Prop :=
        x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x ∧
        (9519 : ℝ) / 50000 ≤ α (p 1) ∧ α (p 1) < α (p 0) ∧
        α (p 0) < (40481 : ℝ) / 100000 ∧
        (40481 : ℝ) / 100000 ≤ α (p 0) + α (p 1) ∧
        α (p 0) + α (p 1) ≤ (59519 : ℝ) / 100000 ∧ p 1 ≤ p 2
      ∀ p ∈ T, ∀ q ∈ T,
        (∀ d ∈ M,
          (if d.lower then
            if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
          else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
          (if d.lower then
            if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
          else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
        (C p ↔ C q) := by
  have hx0 : 0 < x := zero_lt_one.trans hx
  let M : Finset (MinorantSmallMonomialCut 3) :=
    {⟨Finset.univ, ∅, x, true, false⟩,
      ⟨Finset.univ, ∅, 2 * x, false, false⟩,
      ⟨{1}, ∅, x ^ ((9519 : ℝ) / 50000), true, false⟩,
      ⟨{1}, {0}, 1, false, true⟩,
      ⟨{0}, ∅, x ^ ((40481 : ℝ) / 100000), false, true⟩} ∪
    {⟨{0, 1}, ∅, x ^ ((40481 : ℝ) / 100000), true, false⟩,
      ⟨{0, 1}, ∅, x ^ ((59519 : ℝ) / 100000), false, false⟩,
      ⟨{1}, {2}, 1, false, false⟩}
  have hMcard : M.card ≤ 32 := by
    dsimp only [M]
    exact (Finset.card_union_le _ _).trans
      ((Nat.add_le_add Finset.card_le_five Finset.card_le_three).trans (by decide))
  have hMdata (d : MinorantSmallMonomialCut 3) (hd : d ∈ M) :
      d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
        d.numerator.card + d.denominator.card ≤ 3 ∧ 0 < d.threshold := by
    simp only [M, Finset.mem_union, Finset.mem_insert, Finset.mem_singleton] at hd
    rcases hd with (rfl | rfl | rfl | rfl | rfl) | (rfl | rfl | rfl) <;>
      norm_num [Finset.card_fin, Finset.disjoint_left] <;>
        first | positivity | decide
  refine ⟨M, hMcard, hMdata, ?_⟩
  intro P T α C
  have hCeq (p : Fin 3 → ℕ) (hp : p ∈ T) :
      C p ↔ ∀ d ∈ M,
        if d.lower then
          if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
        else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold := by
    have hpos (i : Fin 3) : 0 < (p i : ℝ) :=
      Nat.cast_pos.mpr (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).2.pos
    have hlo : (9519 : ℝ) / 50000 ≤ α (p 1) ↔
        x ^ ((9519 : ℝ) / 50000) ≤ (p 1 : ℝ) :=
      Real.le_logb_iff_rpow_le hx (hpos 1)
    have h10 : α (p 1) < α (p 0) ↔ (p 1 : ℝ) / p 0 < 1 := by
      dsimp only [α]
      rw [Real.logb_lt_logb_iff hx (hpos 1) (hpos 0), div_lt_one (hpos 0)]
    have h0 : α (p 0) < (40481 : ℝ) / 100000 ↔
        (p 0 : ℝ) < x ^ ((40481 : ℝ) / 100000) :=
      Real.logb_lt_iff_lt_rpow hx (hpos 0)
    have hpairlo : (40481 : ℝ) / 100000 ≤ α (p 0) + α (p 1) ↔
        x ^ ((40481 : ℝ) / 100000) ≤ (p 0 : ℝ) * p 1 := by
      dsimp only [α]
      rw [← Real.logb_mul (hpos 0).ne' (hpos 1).ne',
        Real.le_logb_iff_rpow_le hx (mul_pos (hpos 0) (hpos 1))]
    have hpairhi : α (p 0) + α (p 1) ≤ (59519 : ℝ) / 100000 ↔
        (p 0 : ℝ) * p 1 ≤ x ^ ((59519 : ℝ) / 100000) := by
      dsimp only [α]
      rw [← Real.logb_mul (hpos 0).ne' (hpos 1).ne',
        Real.logb_le_iff_le_rpow hx (mul_pos (hpos 0) (hpos 1))]
    have h12 : p 1 ≤ p 2 ↔ (p 1 : ℝ) / p 2 ≤ 1 := by
      rw [div_le_one (hpos 2), Nat.cast_le]
    dsimp only [C]
    rw [hlo, h10, h0, hpairlo, hpairhi, h12]
    suffices h :
        ((x ≤ (∏ i, (p i : ℝ))) ∧
        ((∏ i, (p i : ℝ)) ≤ 2 * x) ∧
        (x ^ ((9519 : ℝ) / 50000) ≤ (p 1 : ℝ)) ∧
        ((p 1 : ℝ) / p 0 < 1) ∧
        ((p 0 : ℝ) < x ^ ((40481 : ℝ) / 100000)) ∧
        (x ^ ((40481 : ℝ) / 100000) ≤ (p 0 : ℝ) * p 1) ∧
        ((p 0 : ℝ) * p 1 ≤ x ^ ((59519 : ℝ) / 100000)) ∧
        ((p 1 : ℝ) / p 2 ≤ 1)) ↔
        ((x ^ ((40481 : ℝ) / 100000) ≤ (p 0 : ℝ) * p 1) ∧
        ((p 0 : ℝ) * p 1 ≤ x ^ ((59519 : ℝ) / 100000)) ∧
        (x ≤ (∏ i, (p i : ℝ))) ∧
        ((∏ i, (p i : ℝ)) ≤ 2 * x) ∧
        (x ^ ((9519 : ℝ) / 50000) ≤ (p 1 : ℝ)) ∧
        ((p 1 : ℝ) / p 0 < 1) ∧
        ((p 0 : ℝ) < x ^ ((40481 : ℝ) / 100000)) ∧
        ((p 1 : ℝ) / p 2 ≤ 1)) by
      simpa [M, MinorantSmallMonomialCut.value, Nat.cast_prod] using h
    constructor
    · rintro ⟨ha, hb, hc, hd, he, hf, hg, hh⟩
      exact ⟨hf, hg, ha, hb, hc, hd, he, hh⟩
    · rintro ⟨hf, hg, ha, hb, hc, hd, he, hh⟩
      exact ⟨ha, hb, hc, hd, he, hf, hg, hh⟩
  clear_value M P T
  intro p hp q hq hbits
  constructor
  · intro h
    apply (hCeq q hq).mpr
    intro d hd
    exact (hbits d hd).mp ((hCeq p hp).mp h d hd)
  · intro h
    apply (hCeq p hp).mpr
    intro d hd
    exact (hbits d hd).mpr ((hCeq q hq).mp h d hd)

open Classical in
theorem sourceCentralPair_four_monomial_representation (x : ℝ) (hx : 1 < x) :
    ∃ M : Finset (MinorantSmallMonomialCut 4), M.card ≤ 32 ∧
      (∀ d ∈ M, d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
        d.numerator.card + d.denominator.card ≤ 4 ∧ 0 < d.threshold) ∧
      let P := (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
        (Nat.floor (x ^ ((9 : ℝ) / 10)))).filter Nat.Prime
      let T := Fintype.piFinset (fun _ : Fin 4 => P)
      let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
      let C (p : Fin 4 → ℕ) : Prop :=
        x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x ∧
        (9519 : ℝ) / 50000 ≤ α (p 1) ∧ α (p 1) < α (p 0) ∧
        α (p 0) < (40481 : ℝ) / 100000 ∧
        (40481 : ℝ) / 100000 ≤ α (p 0) + α (p 1) ∧
        α (p 0) + α (p 1) ≤ (59519 : ℝ) / 100000 ∧ p 1 ≤ p 2 ∧ p 2 ≤ p 3
      ∀ p ∈ T, ∀ q ∈ T,
        (∀ d ∈ M,
          (if d.lower then
            if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
          else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
          (if d.lower then
            if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
          else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
        (C p ↔ C q) := by
  have hx0 : 0 < x := zero_lt_one.trans hx
  let M : Finset (MinorantSmallMonomialCut 4) :=
    {⟨Finset.univ, ∅, x, true, false⟩,
      ⟨Finset.univ, ∅, 2 * x, false, false⟩,
      ⟨{1}, ∅, x ^ ((9519 : ℝ) / 50000), true, false⟩,
      ⟨{1}, {0}, 1, false, true⟩,
      ⟨{0}, ∅, x ^ ((40481 : ℝ) / 100000), false, true⟩} ∪
    {⟨{0, 1}, ∅, x ^ ((40481 : ℝ) / 100000), true, false⟩,
      ⟨{0, 1}, ∅, x ^ ((59519 : ℝ) / 100000), false, false⟩,
      ⟨{1}, {2}, 1, false, false⟩,
      ⟨{2}, {3}, 1, false, false⟩}
  have hMcard : M.card ≤ 32 := by
    dsimp only [M]
    exact (Finset.card_union_le _ _).trans
      ((Nat.add_le_add Finset.card_le_five Finset.card_le_four).trans (by decide))
  have hMdata (d : MinorantSmallMonomialCut 4) (hd : d ∈ M) :
      d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
        d.numerator.card + d.denominator.card ≤ 4 ∧ 0 < d.threshold := by
    simp only [M, Finset.mem_union, Finset.mem_insert, Finset.mem_singleton] at hd
    rcases hd with (rfl | rfl | rfl | rfl | rfl) | (rfl | rfl | rfl | rfl) <;>
      norm_num [Finset.card_fin, Finset.disjoint_left] <;>
        first | positivity | decide
  refine ⟨M, hMcard, hMdata, ?_⟩
  intro P T α C
  have hCeq (p : Fin 4 → ℕ) (hp : p ∈ T) :
      C p ↔ ∀ d ∈ M,
        if d.lower then
          if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
        else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold := by
    have hpos (i : Fin 4) : 0 < (p i : ℝ) :=
      Nat.cast_pos.mpr (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).2.pos
    have hlo : (9519 : ℝ) / 50000 ≤ α (p 1) ↔
        x ^ ((9519 : ℝ) / 50000) ≤ (p 1 : ℝ) :=
      Real.le_logb_iff_rpow_le hx (hpos 1)
    have h10 : α (p 1) < α (p 0) ↔ (p 1 : ℝ) / p 0 < 1 := by
      dsimp only [α]
      rw [Real.logb_lt_logb_iff hx (hpos 1) (hpos 0), div_lt_one (hpos 0)]
    have h0 : α (p 0) < (40481 : ℝ) / 100000 ↔
        (p 0 : ℝ) < x ^ ((40481 : ℝ) / 100000) :=
      Real.logb_lt_iff_lt_rpow hx (hpos 0)
    have hpairlo : (40481 : ℝ) / 100000 ≤ α (p 0) + α (p 1) ↔
        x ^ ((40481 : ℝ) / 100000) ≤ (p 0 : ℝ) * p 1 := by
      dsimp only [α]
      rw [← Real.logb_mul (hpos 0).ne' (hpos 1).ne',
        Real.le_logb_iff_rpow_le hx (mul_pos (hpos 0) (hpos 1))]
    have hpairhi : α (p 0) + α (p 1) ≤ (59519 : ℝ) / 100000 ↔
        (p 0 : ℝ) * p 1 ≤ x ^ ((59519 : ℝ) / 100000) := by
      dsimp only [α]
      rw [← Real.logb_mul (hpos 0).ne' (hpos 1).ne',
        Real.logb_le_iff_le_rpow hx (mul_pos (hpos 0) (hpos 1))]
    have h12 : p 1 ≤ p 2 ↔ (p 1 : ℝ) / p 2 ≤ 1 := by
      rw [div_le_one (hpos 2), Nat.cast_le]
    have h23 : p 2 ≤ p 3 ↔ (p 2 : ℝ) / p 3 ≤ 1 := by
      rw [div_le_one (hpos 3), Nat.cast_le]
    dsimp only [C]
    rw [hlo, h10, h0, hpairlo, hpairhi, h12, h23]
    suffices h :
        ((x ≤ (∏ i, (p i : ℝ))) ∧
        ((∏ i, (p i : ℝ)) ≤ 2 * x) ∧
        (x ^ ((9519 : ℝ) / 50000) ≤ (p 1 : ℝ)) ∧
        ((p 1 : ℝ) / p 0 < 1) ∧
        ((p 0 : ℝ) < x ^ ((40481 : ℝ) / 100000)) ∧
        (x ^ ((40481 : ℝ) / 100000) ≤ (p 0 : ℝ) * p 1) ∧
        ((p 0 : ℝ) * p 1 ≤ x ^ ((59519 : ℝ) / 100000)) ∧
        ((p 1 : ℝ) / p 2 ≤ 1) ∧
        ((p 2 : ℝ) / p 3 ≤ 1)) ↔
        ((x ^ ((40481 : ℝ) / 100000) ≤ (p 0 : ℝ) * p 1) ∧
        ((p 0 : ℝ) * p 1 ≤ x ^ ((59519 : ℝ) / 100000)) ∧
        ((p 1 : ℝ) / p 2 ≤ 1) ∧
        (x ≤ (∏ i, (p i : ℝ))) ∧
        ((∏ i, (p i : ℝ)) ≤ 2 * x) ∧
        (x ^ ((9519 : ℝ) / 50000) ≤ (p 1 : ℝ)) ∧
        ((p 1 : ℝ) / p 0 < 1) ∧
        ((p 0 : ℝ) < x ^ ((40481 : ℝ) / 100000)) ∧
        ((p 2 : ℝ) / p 3 ≤ 1)) by
      simpa [M, MinorantSmallMonomialCut.value, Nat.cast_prod] using h
    constructor
    · rintro ⟨ha, hb, hc, hd, he, hf, hg, hh, hi⟩
      exact ⟨hf, hg, hh, ha, hb, hc, hd, he, hi⟩
    · rintro ⟨hf, hg, hh, ha, hb, hc, hd, he, hi⟩
      exact ⟨ha, hb, hc, hd, he, hf, hg, hh, hi⟩
  clear_value M P T
  intro p hp q hq hbits
  constructor
  · intro h
    apply (hCeq q hq).mpr
    intro d hd
    exact (hbits d hd).mp ((hCeq p hp).mp h d hd)
  · intro h
    apply (hCeq p hp).mpr
    intro d hd
    exact (hbits d hd).mpr ((hCeq q hq).mp h d hd)

open Classical in
theorem sourceCentralPair_five_monomial_representation (x : ℝ) (hx : 1 < x) :
    ∃ M : Finset MinorantMonomialCut, M.card ≤ 32 ∧
      (∀ d ∈ M, d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
        d.numerator.card + d.denominator.card ≤ 5 ∧ 0 < d.threshold) ∧
      let P := (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((6 : ℝ) / 25)⌋₊).filter Nat.Prime
      let T := Fintype.piFinset (fun _ : Fin 5 => P)
      let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
      let C (p : Fin 5 → ℕ) : Prop :=
        x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x ∧
        (9519 : ℝ) / 50000 ≤ α (p 1) ∧ α (p 1) < α (p 0) ∧
        α (p 0) < (40481 : ℝ) / 100000 ∧
        (40481 : ℝ) / 100000 ≤ α (p 0) + α (p 1) ∧
        α (p 0) + α (p 1) ≤ (59519 : ℝ) / 100000 ∧
        p 1 ≤ p 2 ∧ p 2 ≤ p 3 ∧ p 3 ≤ p 4
      ∀ p ∈ T, ∀ q ∈ T,
        (∀ d ∈ M,
          (if d.lower then
            if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
          else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
          (if d.lower then
            if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
          else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
        (C p ↔ C q) := by
  have hx0 : 0 < x := zero_lt_one.trans hx
  let M : Finset MinorantMonomialCut :=
    {⟨Finset.univ, ∅, x, true, false⟩,
      ⟨Finset.univ, ∅, 2 * x, false, false⟩,
      ⟨{1}, ∅, x ^ ((9519 : ℝ) / 50000), true, false⟩,
      ⟨{1}, {0}, 1, false, true⟩,
      ⟨{0}, ∅, x ^ ((40481 : ℝ) / 100000), false, true⟩} ∪
    {⟨{0, 1}, ∅, x ^ ((40481 : ℝ) / 100000), true, false⟩,
      ⟨{0, 1}, ∅, x ^ ((59519 : ℝ) / 100000), false, false⟩,
      ⟨{1}, {2}, 1, false, false⟩,
      ⟨{2}, {3}, 1, false, false⟩,
      ⟨{3}, {4}, 1, false, false⟩}
  have hMcard : M.card ≤ 32 :=
    (Finset.card_union_le _ _).trans
      ((Nat.add_le_add Finset.card_le_five Finset.card_le_five).trans (by decide))
  have hMdata (d : MinorantMonomialCut) (hd : d ∈ M) :
      d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
        d.numerator.card + d.denominator.card ≤ 5 ∧ 0 < d.threshold := by
    simp only [M, Finset.mem_union, Finset.mem_insert, Finset.mem_singleton] at hd
    rcases hd with (rfl | rfl | rfl | rfl | rfl) | rfl | rfl | rfl | rfl | rfl <;>
      norm_num [Finset.card_fin, Finset.disjoint_left] <;>
        first | positivity | decide
  refine ⟨M, hMcard, hMdata, ?_⟩
  intro P T α C
  have hpos (p : Fin 5 → ℕ) (hp : p ∈ T) (i : Fin 5) : 0 < (p i : ℝ) :=
    Nat.cast_pos.mpr (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).2.pos
  have hCeq (p : Fin 5 → ℕ) (hp : p ∈ T) : C p ↔
      ∀ d ∈ M,
        if d.lower then
          if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
        else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold := by
    have hlow : ((9519 : ℝ) / 50000 ≤ α (p 1)) ↔
        x ^ ((9519 : ℝ) / 50000) ≤ (p 1 : ℝ) :=
      Real.le_logb_iff_rpow_le hx (hpos p hp 1)
    have horder : (α (p 1) < α (p 0)) ↔ (p 1 : ℝ) / p 0 < 1 := by
      dsimp only [α]
      rw [Real.logb_lt_logb_iff hx (hpos p hp 1) (hpos p hp 0),
        div_lt_one (hpos p hp 0)]
    have htop : (α (p 0) < (40481 : ℝ) / 100000) ↔
        (p 0 : ℝ) < x ^ ((40481 : ℝ) / 100000) :=
      Real.logb_lt_iff_lt_rpow hx (hpos p hp 0)
    have hpairlo : ((40481 : ℝ) / 100000 ≤ α (p 0) + α (p 1)) ↔
        x ^ ((40481 : ℝ) / 100000) ≤ (p 0 : ℝ) * p 1 := by
      dsimp only [α]
      rw [← Real.logb_mul (hpos p hp 0).ne' (hpos p hp 1).ne',
        Real.le_logb_iff_rpow_le hx (mul_pos (hpos p hp 0) (hpos p hp 1))]
    have hpairhi : (α (p 0) + α (p 1) ≤ (59519 : ℝ) / 100000) ↔
        (p 0 : ℝ) * p 1 ≤ x ^ ((59519 : ℝ) / 100000) := by
      dsimp only [α]
      rw [← Real.logb_mul (hpos p hp 0).ne' (hpos p hp 1).ne',
        Real.logb_le_iff_le_rpow hx (mul_pos (hpos p hp 0) (hpos p hp 1))]
    have hnatorder (i k : Fin 5) : (p i ≤ p k) ↔ (p i : ℝ) / p k ≤ 1 := by
      rw [div_le_one (hpos p hp k)]
      exact Nat.cast_le.symm
    simp only [C, hlow, horder, htop, hpairlo, hpairhi, hnatorder, Nat.cast_prod]
    suffices h :
        ((x ≤ (∏ i, (p i : ℝ))) ∧
        ((∏ i, (p i : ℝ)) ≤ 2 * x) ∧
        (x ^ ((9519 : ℝ) / 50000) ≤ (p 1 : ℝ)) ∧
        ((p 1 : ℝ) / p 0 < 1) ∧
        ((p 0 : ℝ) < x ^ ((40481 : ℝ) / 100000)) ∧
        (x ^ ((40481 : ℝ) / 100000) ≤ (p 0 : ℝ) * p 1) ∧
        ((p 0 : ℝ) * p 1 ≤ x ^ ((59519 : ℝ) / 100000)) ∧
        ((p 1 : ℝ) / p 2 ≤ 1) ∧
        ((p 2 : ℝ) / p 3 ≤ 1) ∧
        ((p 3 : ℝ) / p 4 ≤ 1)) ↔
        ((x ^ ((40481 : ℝ) / 100000) ≤ (p 0 : ℝ) * p 1) ∧
        ((p 0 : ℝ) * p 1 ≤ x ^ ((59519 : ℝ) / 100000)) ∧
        ((p 1 : ℝ) / p 2 ≤ 1) ∧
        ((p 2 : ℝ) / p 3 ≤ 1) ∧
        (x ≤ (∏ i, (p i : ℝ))) ∧
        ((∏ i, (p i : ℝ)) ≤ 2 * x) ∧
        (x ^ ((9519 : ℝ) / 50000) ≤ (p 1 : ℝ)) ∧
        ((p 1 : ℝ) / p 0 < 1) ∧
        ((p 0 : ℝ) < x ^ ((40481 : ℝ) / 100000)) ∧
        ((p 3 : ℝ) / p 4 ≤ 1)) by
      simpa [M, MinorantMonomialCut.value] using h
    constructor
    · rintro ⟨ha, hb, hc, hd, he, hf, hg, hh, hi, hj⟩
      exact ⟨hf, hg, hh, hi, ha, hb, hc, hd, he, hj⟩
    · rintro ⟨hf, hg, hh, hi, ha, hb, hc, hd, he, hj⟩
      exact ⟨ha, hb, hc, hd, he, hf, hg, hh, hi, hj⟩
  intro p hp q hq hbits
  rw [hCeq p hp, hCeq q hq]
  constructor
  · intro h d hd
    exact (hbits d hd).mp (h d hd)
  · intro h d hd
    exact (hbits d hd).mpr (h d hd)

open Classical in
/--
The multiplicative cuts for the three-factor `T3` region, including its prime ordering, exponent
thresholds, and the closed total-product window `[x, 2 * x]`.
-/
noncomputable def sourceT3MonomialCuts (x : ℝ) : Finset (MinorantSmallMonomialCut 3) :=
  {⟨Finset.univ, ∅, x, true, false⟩,
    ⟨Finset.univ, ∅, 2 * x, false, false⟩,
    ⟨{1}, ∅, x ^ ((9519 : ℝ) / 50000), true, false⟩,
    ⟨{1}, {0}, 1, false, true⟩} ∪
  {⟨{0}, ∅, x ^ ((40481 : ℝ) / 100000), false, true⟩,
    ⟨{0, 1}, ∅, x ^ ((59519 : ℝ) / 100000), true, true⟩,
    ⟨{1}, ∅, x ^ (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000), true, false⟩,
    ⟨{1}, {2}, 1, false, false⟩}

theorem sourceT3MonomialCuts_card_le (x : ℝ) : (sourceT3MonomialCuts x).card ≤ 32 := by
  classical
  unfold sourceT3MonomialCuts
  exact (Finset.card_union_le _ _).trans
    ((Nat.add_le_add Finset.card_le_four Finset.card_le_four).trans (by decide))

theorem sourceT3MonomialCuts_data (x : ℝ) (hx : 0 < x)
    (d : MinorantSmallMonomialCut 3) (hd : d ∈ sourceT3MonomialCuts x) :
    d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
      d.numerator.card + d.denominator.card ≤ 3 ∧ 0 < d.threshold := by
  classical
  simp only [sourceT3MonomialCuts, Finset.mem_union,
    Finset.mem_insert, Finset.mem_singleton] at hd
  rcases hd with (rfl | rfl | rfl | rfl) | (rfl | rfl | rfl | rfl) <;>
    norm_num [Finset.card_fin, Finset.disjoint_left] <;>
      first | positivity | decide

open Classical in
theorem sourceT3MonomialCuts_boolean (x : ℝ) (hx : 1 < x)
    (p q : Fin 3 → ℕ) (hp : ∀ i, 0 < p i) (hq : ∀ i, 0 < q i)
    (htests : ∀ d ∈ sourceT3MonomialCuts x,
      (if d.lower then
        if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
      else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
      (if d.lower then
        if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
      else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) :
    ((∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧
      sourceT3ExponentMask (fun i => Real.logb x (p i : ℝ)) = true) ↔
    ((∏ i, q i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧
      sourceT3ExponentMask (fun i => Real.logb x (q i : ℝ)) = true) := by
  have hmask (r : Fin 3 → ℕ) (hr : ∀ i, 0 < r i) :
      sourceT3ExponentMask (fun i => Real.logb x (r i : ℝ)) = true ↔
        x ^ ((9519 : ℝ) / 50000) ≤ (r 1 : ℝ) ∧ (r 1 : ℝ) / r 0 < 1 ∧
        (r 0 : ℝ) < x ^ ((40481 : ℝ) / 100000) ∧
        x ^ ((59519 : ℝ) / 100000) < (r 0 : ℝ) * r 1 ∧
        x ^ (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000) ≤ (r 1 : ℝ) ∧
        (r 1 : ℝ) / r 2 ≤ 1 := by
    have hpos (i : Fin 3) : (0 : ℝ) < r i := by exact_mod_cast hr i
    have horder : Real.logb x (r 1 : ℝ) < Real.logb x (r 0 : ℝ) ↔
        (r 1 : ℝ) / r 0 < 1 := by
      rw [Real.logb_lt_logb_iff hx (hpos 1) (hpos 0), div_lt_one (hpos 0)]
    have hlast : Real.logb x (r 1 : ℝ) ≤ Real.logb x (r 2 : ℝ) ↔
        (r 1 : ℝ) / r 2 ≤ 1 := by
      rw [Real.logb_le_logb hx (hpos 1) (hpos 2), div_le_one (hpos 2)]
    have hpair : (59519 : ℝ) / 100000 <
        Real.logb x (r 0 : ℝ) + Real.logb x (r 1 : ℝ) ↔
        x ^ ((59519 : ℝ) / 100000) < (r 0 : ℝ) * r 1 := by
      rw [← Real.logb_mul (hpos 0).ne' (hpos 1).ne',
        Real.lt_logb_iff_rpow_lt hx (mul_pos (hpos 0) (hpos 1))]
    simp only [sourceT3ExponentMask, decide_eq_true_eq]
    rw [Real.le_logb_iff_rpow_le hx (hpos 1), horder,
      Real.logb_lt_iff_lt_rpow hx (hpos 0), hpair,
      Real.le_logb_iff_rpow_le hx (hpos 1), hlast]
  have hcarrier (r : Fin 3 → ℕ) :
      (∏ i, r i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ↔
        x ≤ ∏ i, (r i : ℝ) ∧ (∏ i, (r i : ℝ)) ≤ 2 * x := by
    rw [Finset.mem_Icc, Nat.ceil_le, Nat.le_floor_iff (by positivity)]
    push_cast
    rfl
  simp only [sourceT3MonomialCuts, Finset.forall_mem_union,
    Finset.forall_mem_insert, Finset.mem_singleton, forall_eq] at htests
  obtain ⟨⟨hlo, hhi, hxi, h10⟩, h0a, h01, h1z, h12⟩ := htests
  simp only [MinorantSmallMonomialCut.value, Bool.false_eq_true, ite_true, ite_false,
    Finset.prod_empty, Finset.prod_singleton, div_one,
    Finset.prod_pair (by decide : (0 : Fin 3) ≠ 1)] at hlo hhi hxi h10 h0a h01 h1z h12
  rw [hcarrier p, hcarrier q, hmask p hp, hmask q hq]
  exact and_congr (and_congr hlo hhi)
    (and_congr hxi (and_congr h10 (and_congr h0a (and_congr h01 (and_congr h1z h12)))))

theorem sourceT3_nearby_original_box_bounds (τ : ℝ) (hτ : 0 < τ)
    (hτsmall : τ ≤ 1 / 10 ^ 10) :
    let a : ℝ := 40481 / 100000
    let ζ : ℝ := 1 - 1058 / 3125 - a
    ∃ X : ℝ, 3 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      ∀ p : Fin 3 → ℕ, (∀ i, (p i).Prime) →
      ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x →
      sourceT3ExponentMask (fun i => Real.logb x (p i : ℝ)) = true →
      ∀ L U : Fin 3 → ℝ,
        (∀ i, L i ≤ (p i : ℝ) ∧ (p i : ℝ) ≤ U i ∧ U i ≤ 2 * L i) →
        ∀ i, x ^ (ζ - τ / 10) ≤ L i ∧ U i ≤ x ^ (a + τ / 10) ∧
          x ^ ((1 : ℝ) / 4) ≤ L i ∧ U i ≤ x ^ ((41 : ℝ) / 100) := by
  intro a ζ
  have hε : 0 < τ / 10 := div_pos hτ (by norm_num)
  obtain ⟨X, hX⟩ := ((tendsto_rpow_atTop hε).eventually_ge_atTop (4 : ℝ)).exists_forall_of_atTop
  refine ⟨max 3 X, le_max_left _ _, ?_⟩
  intro x hx p hp hprod hcut L U hLU i
  have hx3 : 3 ≤ x := (le_max_left _ _).trans hx
  have hx1 : 1 < x := (by norm_num : (1 : ℝ) < 3).trans_le hx3
  have hxpos : 0 < x := zero_lt_one.trans hx1
  have hεlarge : 4 ≤ x ^ (τ / 10) := hX x ((le_max_right _ _).trans hx)
  have hscale := sourceT3_prime_tuple_exponent_bounds x hx1 p hp hprod hcut i
  have hpPos : (0 : ℝ) < p i := Nat.cast_pos.mpr (hp i).pos
  have hpLo : x ^ ζ ≤ (p i : ℝ) :=
    (Real.le_logb_iff_rpow_le hx1 hpPos).mp hscale.1
  have hpHi : (p i : ℝ) ≤ 2 * x ^ a := by
    have h := (Real.logb_le_iff_le_rpow hx1 hpPos).mp hscale.2
    have htwo : x ^ Real.logb x 2 = 2 := Real.rpow_logb hxpos hx1.ne' (by norm_num)
    rw [Real.rpow_add hxpos, htwo] at h
    simpa only [a, mul_comm] using h
  have hL : x ^ (ζ - τ / 10) ≤ L i := by
    rw [Real.rpow_sub hxpos]
    calc
      _ ≤ x ^ ζ / 2 := div_le_div_of_nonneg_left (Real.rpow_nonneg hxpos.le _) (by norm_num)
        (by linarith : 2 ≤ x ^ (τ / 10))
      _ ≤ L i := (div_le_iff₀ (by norm_num : (0 : ℝ) < 2)).mpr
        (by nlinarith only [hpLo, (hLU i).2.1, (hLU i).2.2])
  have hU : U i ≤ x ^ (a + τ / 10) := by
    rw [Real.rpow_add hxpos]
    calc
      _ ≤ 2 * (p i : ℝ) := (hLU i).2.2.trans
        (mul_le_mul_of_nonneg_left (hLU i).1 (by norm_num))
      _ ≤ 4 * x ^ a := by linarith only [hpHi]
      _ ≤ _ := by
        simpa only [mul_comm] using mul_le_mul_of_nonneg_left hεlarge
          (Real.rpow_nonneg hxpos.le a)
  refine ⟨hL, hU, ?_, ?_⟩
  · exact (Real.rpow_le_rpow_of_exponent_le hx1.le (by
      dsimp only [ζ, a]
      linarith only [hτsmall])).trans hL
  · exact hU.trans (Real.rpow_le_rpow_of_exponent_le hx1.le (by
      dsimp only [a]
      linarith only [hτsmall]))

open Classical in
theorem sourceT3_eventually_compact_prime_finsupp :
    ∃ X : ℝ, 3 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      let P := (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((9 : ℝ) / 10)⌋₊).filter Nat.Prime
      let T := Fintype.piFinset (fun _ : Fin 3 => P)
      (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        Finsupp.single n ((sourceT3 x n : ℝ) : ℂ)) =
        ∑ p ∈ T, Finsupp.single (∏ i, p i)
          (if (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧
            sourceT3ExponentMask (fun i => Real.logb x (p i : ℝ)) = true
          then (1 : ℂ) else 0) := by
  obtain ⟨X₁, hX₁, hsource⟩ := sourceT3_eventually_eq_three_prime_tuple_sum
  obtain ⟨X₂, _hX₂, hnearby⟩ :=
    sourceT3_nearby_original_box_bounds (1 / 10 ^ 10) (by norm_num) le_rfl
  refine ⟨max X₁ X₂, hX₁.trans (le_max_left _ _), ?_⟩
  intro x hx P T
  have hx₁ : X₁ ≤ x := (le_max_left _ _).trans hx
  have hx₂ : X₂ ≤ x := (le_max_right _ _).trans hx
  have hx1 : 1 < x := (by norm_num : (1 : ℝ) < 3).trans_le (hX₁.trans hx₁)
  have hx0 : 0 < x := zero_lt_one.trans hx1
  let N := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
  let w : (Fin 3 → ℕ) → ℝ := fun p =>
    if sourceT3ExponentMask (fun i => Real.logb x (p i : ℝ)) then 1 else 0
  have hcompact (p : Fin 3 → ℕ) (hp : ∀ i, (p i).Prime)
      (hpn : (∏ i, p i) ∈ N)
      (hm : sourceT3ExponentMask (fun i => Real.logb x (p i : ℝ)) = true) : p ∈ T := by
    have hnhi : ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x :=
      (Nat.cast_le.mpr (Finset.mem_Icc.mp hpn).2).trans (Nat.floor_le (by positivity))
    have hbounds := hnearby x hx₂ p hp hnhi hm (fun i => (p i : ℝ))
      (fun i => (p i : ℝ)) (fun i => ⟨le_rfl, le_rfl, by
        nlinarith only [Nat.cast_nonneg (α := ℝ) (p i)]⟩)
    apply Fintype.mem_piFinset.mpr
    intro i
    apply Finset.mem_filter.mpr
    refine ⟨Finset.mem_Icc.mpr ⟨?_, ?_⟩, hp i⟩
    · apply Nat.ceil_le.mpr
      exact (Real.rpow_le_rpow_of_exponent_le hx1.le
        (by norm_num : (9519 : ℝ) / 50000 ≤ 1 / 4)).trans (hbounds i).2.2.1
    · apply Nat.le_floor
      exact (hbounds i).2.2.2.trans (Real.rpow_le_rpow_of_exponent_le hx1.le
        (by norm_num : (41 : ℝ) / 100 ≤ 9 / 10))
  have hprime (p : Fin 3 → ℕ) (hp : p ∈ T) (i : Fin 3) : (p i).Prime :=
    (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).2
  ext n
  simp only [Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_ite_eq']
  by_cases hn : n ∈ N
  · have hnlo : x ≤ (n : ℝ) := Nat.le_of_ceil_le (Finset.mem_Icc.mp hn).1
    have hnhi : (n : ℝ) ≤ 2 * x :=
      (Nat.cast_le.mpr (Finset.mem_Icc.mp hn).2).trans (Nat.floor_le (by positivity))
    have hcast : ((sourceT3 x n : ℝ) : ℂ) =
        ∑ p ∈ Fintype.piFinset (fun _ : Fin 3 => Nat.primesLE n),
          if (∏ i, p i) = n then (w p : ℂ) else 0 := by
      rw [hsource x hx₁ n hnlo hnhi, Complex.ofReal_sum]
      apply Finset.sum_congr rfl
      intro p _hp
      by_cases hpn : (∏ i, p i) = n
      · simp only [ite_eq_left hpn]
        rfl
      · simp only [ite_eq_right hpn, Complex.ofReal_zero]
    rw [ite_eq_left hn, hcast]
    have heq :
        (∑ p ∈ Fintype.piFinset (fun _ : Fin 3 => Nat.primesLE n),
          if (∏ i, p i) = n then (w p : ℂ) else 0) =
        ∑ p ∈ T, if (∏ i, p i) = n then (w p : ℂ) else 0 := by
      apply Finset.sum_congr_of_eq_on_inter
      · intro p hp hpT
        by_cases hpn : (∏ i, p i) = n
        · by_cases hm : sourceT3ExponentMask (fun i => Real.logb x (p i : ℝ)) = true
          · exact False.elim (hpT (hcompact p
              (fun i => Nat.prime_of_mem_primesLE (Fintype.mem_piFinset.mp hp i))
              (by simpa only [hpn] using hn) hm))
          · simp only [ite_eq_left hpn, w, ite_eq_right hm, Complex.ofReal_zero]
        · exact ite_eq_right hpn
      · intro p hp hpN
        by_cases hpn : (∏ i, p i) = n
        · exfalso
          apply hpN
          apply Fintype.mem_piFinset.mpr
          intro i
          apply Nat.mem_primesLE.mpr
          refine ⟨Nat.le_of_dvd (by
            rw [← hpn]
            exact Finset.prod_pos (fun i _ => (hprime p hp i).pos)) ?_, hprime p hp i⟩
          rw [← hpn]
          exact Finset.dvd_prod_of_mem p (Finset.mem_univ i)
        · exact ite_eq_right hpn
      · intro _ _ _
        rfl
    rw [heq]
    apply Finset.sum_congr rfl
    intro p _hp
    by_cases hpn : (∏ i, p i) = n
    · have hm : (∏ i, p i) ∈ N := by simpa only [hpn] using hn
      dsimp only [N] at hm
      simp only [ite_eq_left hpn, hm, true_and, w]
      split_ifs <;> rfl
    · simp only [ite_eq_right hpn]
  · rw [ite_eq_right hn]
    symm
    apply Finset.sum_eq_zero
    intro p _hp
    by_cases hpn : (∏ i, p i) = n
    · have hm : ¬(∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ := by
        simpa only [hpn] using hn
      simp only [ite_eq_left hpn, hm, false_and, ite_false]
    · exact ite_eq_right hpn

theorem harman_positive_feature_mesh (U L : ℕ) (h : ℝ)
    (hU : 1 ≤ U) (hL : 1 ≤ L) (hh : 0 < h) (hh1 : h ≤ 1) :
    ∃ (K : ℕ) (b : ℕ → ℕ) (lo hi : ℕ → ℝ),
      (K : ℝ) ≤ (L : ℝ) + 3 + 2 * Real.log (max 1 (U : ℝ)) / h ∧
      (∀ n, 1 ≤ n → n ≤ U → b n < K) ∧
      (∀ n i, 1 ≤ n →
        (b n = i ↔
          (i ≤ L ∧ n = i) ∨
            (L < i ∧ L < n ∧ lo i ≤ (n : ℝ) ∧ (n : ℝ) < hi i))) ∧
      (∀ n, n ≤ L → b n = n) ∧
      (∀ n, b n ≤ L ↔ n ≤ L) ∧
      (∀ n, 1 ≤ n → lo (b n) ≤ (n : ℝ) ∧ (n : ℝ) < hi (b n)) ∧
      (∀ i, L < i → (L : ℝ) ≤ lo i ∧ hi i = (1 + h) * lo i) ∧
      (∀ n m, b n < b m → n < m) ∧
      (∀ n m, 1 ≤ n → 1 ≤ m → L < b n → b n = b m →
        |(n : ℝ) - m| ≤ h * lo (b n)) ∧
      (∀ i, i ≤ L → lo i = (i : ℝ) ∧ hi i = (i : ℝ) + 1) ∧
      (∀ n, 1 ≤ n →
        lo (b n) ≤ (n : ℝ) ∧
          (n : ℝ) ≤ (if b n ≤ L then lo (b n) else hi (b n)) ∧
          (if b n ≤ L then lo (b n) else hi (b n)) ≤ (1 + h) * lo (b n)) := by
  classical
  have hbase : 1 < 1 + h := by linarith
  have hLreal : 1 ≤ (L : ℝ) := by exact_mod_cast hL
  have hLpos : 0 < (L : ℝ) := zero_lt_one.trans_le hLreal
  have hUreal : 1 ≤ (U : ℝ) := by exact_mod_cast hU
  let f : ℕ → ℕ := fun n =>
    ⌊Real.logb (1 + h) ((n : ℝ) / (L : ℝ))⌋₊
  let K : ℕ := L + 2 + ⌊Real.logb (1 + h) (U : ℝ)⌋₊
  let b : ℕ → ℕ := fun n => if n ≤ L then n else L + 1 + f n
  let lo : ℕ → ℝ := fun i =>
    if i ≤ L then (i : ℝ) else (L : ℝ) * (1 + h) ^ (i - (L + 1))
  let hi : ℕ → ℝ := fun i =>
    if i ≤ L then (i : ℝ) + 1 else (L : ℝ) * (1 + h) ^ (i - (L + 1) + 1)
  have hsmall (n : ℕ) (hn : n ≤ L) : b n = n := by
    simp only [b, hn, ite_true]
  have hlarge (n : ℕ) (hn : L < n) : b n = L + 1 + f n := by
    simp only [b, not_le.mpr hn, ite_false]
  have hlarge_index (n : ℕ) (hn : L < n) : L < b n := by
    rw [hlarge n hn]
    omega
  have hsmall_iff (n : ℕ) : b n ≤ L ↔ n ≤ L := by
    by_cases hn : n ≤ L
    · rw [hsmall n hn]
    · have hbn := hlarge_index n (lt_of_not_ge hn)
      exact iff_of_false (not_le.mpr hbn) hn
  have hcell (n k : ℕ) (hn : L < n) :
      f n = k ↔
        (L : ℝ) * (1 + h) ^ k ≤ (n : ℝ) ∧
          (n : ℝ) < (L : ℝ) * (1 + h) ^ (k + 1) := by
    have hnreal : (L : ℝ) < (n : ℝ) := by exact_mod_cast hn
    have hnpos : 0 < (n : ℝ) := hLpos.trans hnreal
    have hratio : 0 < (n : ℝ) / (L : ℝ) := div_pos hnpos hLpos
    have hlog : 0 ≤ Real.logb (1 + h) ((n : ℝ) / (L : ℝ)) :=
      Real.logb_nonneg hbase ((one_le_div hLpos).mpr hnreal.le)
    dsimp only [f]
    rw [Nat.floor_eq_iff hlog, Real.le_logb_iff_rpow_le hbase hratio,
      Real.logb_lt_iff_lt_rpow hbase hratio]
    rw [show (k : ℝ) + 1 = ((k + 1 : ℕ) : ℝ) by norm_cast]
    simp only [Real.rpow_natCast, le_div_iff₀ hLpos, div_lt_iff₀ hLpos, mul_comm]
  have hmembership (n : ℕ) :
      lo (b n) ≤ (n : ℝ) ∧ (n : ℝ) < hi (b n) := by
    by_cases hnL : n ≤ L
    · rw [hsmall n hnL]
      simp only [lo, hi, hnL, ite_true]
      exact ⟨le_rfl, by linarith⟩
    · have hLn : L < n := lt_of_not_ge hnL
      have hidx : ¬L + 1 + f n ≤ L := by omega
      have hsub : L + 1 + f n - (L + 1) = f n := by omega
      have hc := (hcell n (f n) hLn).mp rfl
      rw [hlarge n hLn]
      simpa only [lo, hi, hidx, ite_false, hsub] using hc
  have hcharacterization (n i : ℕ) :
      b n = i ↔
        (i ≤ L ∧ n = i) ∨
          (L < i ∧ L < n ∧ lo i ≤ (n : ℝ) ∧ (n : ℝ) < hi i) := by
    constructor
    · intro hni
      subst i
      by_cases hnL : n ≤ L
      · exact Or.inl ⟨(hsmall_iff n).mpr hnL, (hsmall n hnL).symm⟩
      · have hLn : L < n := lt_of_not_ge hnL
        exact Or.inr ⟨hlarge_index n hLn, hLn,
          (hmembership n).1, (hmembership n).2⟩
    · rintro (⟨hiL, hni⟩ | ⟨hLi, hLn, hlo, hhi⟩)
      · rw [hni]
        exact hsmall i hiL
      · have hiL : ¬i ≤ L := not_le.mpr hLi
        have hf : f n = i - (L + 1) :=
          (hcell n (i - (L + 1)) hLn).mpr (by
            simpa only [lo, hi, hiL, ite_false] using And.intro hlo hhi)
        rw [hlarge n hLn, hf]
        omega
  have hgeometry (i : ℕ) (hiL : L < i) :
      (L : ℝ) ≤ lo i ∧ hi i = (1 + h) * lo i := by
    have hpow : 1 ≤ (1 + h) ^ (i - (L + 1)) := one_le_pow₀ hbase.le
    simp only [lo, hi, not_le.mpr hiL, ite_false]
    constructor
    · simpa only [mul_one] using mul_le_mul_of_nonneg_left hpow hLpos.le
    · rw [pow_succ]
      ring
  have hsingleton (i : ℕ) (hiL : i ≤ L) :
      lo i = (i : ℝ) ∧ hi i = (i : ℝ) + 1 := by
    constructor <;> simp only [lo, hi, hiL, ite_true]
  have hmono : Monotone b := by
    intro n m hnm
    by_cases hmL : m ≤ L
    · rw [hsmall n (hnm.trans hmL), hsmall m hmL]
      exact hnm
    · have hLm : L < m := lt_of_not_ge hmL
      by_cases hnL : n ≤ L
      · rw [hsmall n hnL]
        exact hnL.trans (hlarge_index m hLm).le
      · have hLn : L < n := lt_of_not_ge hnL
        rw [hlarge n hLn, hlarge m hLm]
        apply Nat.add_le_add_left
        apply Nat.floor_mono
        apply Real.logb_le_logb_of_le hbase
        · exact div_pos (hLpos.trans (by exact_mod_cast hLn)) hLpos
        · exact div_le_div_of_nonneg_right (by exact_mod_cast hnm) hLpos.le
  have hbound (n : ℕ) (hn : 1 ≤ n) (hnU : n ≤ U) : b n < K := by
    by_cases hnL : n ≤ L
    · rw [hsmall n hnL]
      dsimp only [K]
      omega
    · have hLn : L < n := lt_of_not_ge hnL
      have hnpos : 0 < (n : ℝ) := by exact_mod_cast (zero_lt_one.trans_le hn)
      have hratio : (n : ℝ) / (L : ℝ) ≤ (U : ℝ) :=
        (div_le_self (Nat.cast_nonneg n) hLreal).trans (by exact_mod_cast hnU)
      have hf : f n ≤ ⌊Real.logb (1 + h) (U : ℝ)⌋₊ :=
        Nat.floor_mono (Real.logb_le_logb_of_le hbase (div_pos hnpos hLpos) hratio)
      rw [hlarge n hLn]
      dsimp only [K]
      omega
  have hloglower : h / 2 ≤ Real.log (1 + h) := by
    have hsq : h * h ≤ h := by
      nlinarith [mul_nonneg hh.le (sub_nonneg.mpr hh1)]
    have hfrac : h / 2 ≤ 2 * h / (h + 2) :=
      (le_div_iff₀ (by linarith : 0 < h + 2)).mpr (by nlinarith)
    exact hfrac.trans (Real.le_log_one_add_of_nonneg hh.le)
  have hlogU : 0 ≤ Real.log (U : ℝ) := Real.log_nonneg hUreal
  have hcount : Real.logb (1 + h) (U : ℝ) ≤ 2 * Real.log (U : ℝ) / h := by
    calc
      Real.logb (1 + h) (U : ℝ) =
          Real.log (U : ℝ) / Real.log (1 + h) := rfl
      _ ≤ Real.log (U : ℝ) / (h / 2) :=
        div_le_div_of_nonneg_left hlogU (by positivity) hloglower
      _ = 2 * Real.log (U : ℝ) / h := by rw [div_div_eq_mul_div, mul_comm]
  have hcard : (K : ℝ) ≤ (L : ℝ) + 3 + 2 * Real.log (max 1 (U : ℝ)) / h := by
    have hfloor := Nat.floor_le (Real.logb_nonneg hbase hUreal)
    simp only [K, Nat.cast_add, Nat.cast_ofNat, max_eq_right hUreal]
    linarith
  refine ⟨K, b, lo, hi, hcard, hbound, fun n i _ => hcharacterization n i, hsmall,
    hsmall_iff, fun n _ => hmembership n, hgeometry, ?_, ?_, hsingleton, ?_⟩
  · intro n m hnm
    by_contra hnot
    exact (not_le.mpr hnm) (hmono (Nat.le_of_not_gt hnot))
  · intro n m _ _ hbn heq
    obtain ⟨hnlo, hnhi⟩ := hmembership n
    obtain ⟨hmlo, hmhi⟩ := hmembership m
    rw [← heq] at hmlo hmhi
    rw [(hgeometry (b n) hbn).2] at hnhi hmhi
    exact abs_le.mpr ⟨by nlinarith, by nlinarith⟩
  · intro n _
    refine ⟨(hmembership n).1, ?_⟩
    by_cases hbn : b n ≤ L
    · have hnL : n ≤ L := (hsmall_iff n).mp hbn
      have hlo : lo (b n) = (n : ℝ) := by
        rw [hsmall n hnL]
        exact (hsingleton n hnL).1
      simp only [hbn, ite_true, hlo]
      refine ⟨le_rfl, ?_⟩
      nlinarith [mul_nonneg hh.le (Nat.cast_nonneg n : 0 ≤ (n : ℝ))]
    · simp only [hbn, ite_false]
      exact ⟨(hmembership n).2.le, (hgeometry (b n) (lt_of_not_ge hbn)).2.le⟩

theorem restricted_harman_long_source_scales
    (x : ℝ) (hx : 1 < x) (r s h d k : ℕ)
    (hs : 0 < s) (hh : 1 < h) (hd : 0 < d) (hk : 0 < k)
    (hcap : ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) <
      x ^ ((9519 : ℝ) / 50000))
    (hprevious : ((r * h : ℕ) : ℝ) / (h.minFac : ℝ) <
      x ^ ((40481 : ℝ) / 100000))
    (hcrossing : x ^ ((40481 : ℝ) / 100000) ≤ ((r * h : ℕ) : ℝ))
    (hproduct : x ≤ ((r * s * h * d * k : ℕ) : ℝ) ∧
      ((r * s * h * d * k : ℕ) : ℝ) ≤ 2 * x)
    (hlong : x ^ (1 - (1058 : ℝ) / 3125) < ((r * s * h * d : ℕ) : ℝ)) :
    x ^ ((40481 : ℝ) / 100000) ≤ ((r * h : ℕ) : ℝ) ∧
      ((r * h : ℕ) : ℝ) < x ^ ((59519 : ℝ) / 100000) ∧
      x ^ ((40481 : ℝ) / 100000) < ((s * d * k : ℕ) : ℝ) ∧
      ((s * d * k : ℕ) : ℝ) ≤ 2 * x ^ ((59519 : ℝ) / 100000) ∧
      (k : ℝ) < 2 * x ^ ((1058 : ℝ) / 3125) := by
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hmin : h.minFac.Prime := Nat.minFac_prime hh.ne'
  have hminmem : h.minFac ∈ h.primeFactors :=
    hmin.mem_primeFactors (Nat.minFac_dvd h) (by omega)
  have hminle : (h.minFac : ℝ) ≤ ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) := by
    exact_mod_cast (Finset.le_sup (f := id) hminmem).trans (le_max_right _ _)
  have hminpos : (0 : ℝ) < h.minFac := Nat.cast_pos.mpr hmin.pos
  have hupper : ((r * h : ℕ) : ℝ) < x ^ ((59519 : ℝ) / 100000) := by
    calc
      ((r * h : ℕ) : ℝ) <
          x ^ ((40481 : ℝ) / 100000) * (h.minFac : ℝ) :=
        (div_lt_iff₀ hminpos).mp hprevious
      _ < x ^ ((40481 : ℝ) / 100000) * x ^ ((9519 : ℝ) / 50000) :=
        mul_lt_mul_of_pos_left (hminle.trans_lt hcap) (Real.rpow_pos_of_pos hx0 _)
      _ = x ^ ((59519 : ℝ) / 100000) := by
        rw [← Real.rpow_add hx0]
        norm_num
  have hnpos : (0 : ℝ) < ((s * d * k : ℕ) : ℝ) := by positivity
  have hfactor : ((r * h : ℕ) : ℝ) * ((s * d * k : ℕ) : ℝ) =
      ((r * s * h * d * k : ℕ) : ℝ) := by
    push_cast
    ring
  have hcomplement :
      x ^ ((40481 : ℝ) / 100000) * x ^ ((59519 : ℝ) / 100000) = x := by
    rw [← Real.rpow_add hx0]
    norm_num
  have hnlo : x ^ ((40481 : ℝ) / 100000) < ((s * d * k : ℕ) : ℝ) := by
    apply (mul_lt_mul_iff_left₀ (Real.rpow_pos_of_pos hx0 ((59519 : ℝ) / 100000))).mp
    rw [hcomplement]
    calc
      x ≤ ((r * s * h * d * k : ℕ) : ℝ) := hproduct.1
      _ = ((s * d * k : ℕ) : ℝ) * ((r * h : ℕ) : ℝ) :=
        hfactor.symm.trans (mul_comm _ _)
      _ < ((s * d * k : ℕ) : ℝ) * x ^ ((59519 : ℝ) / 100000) :=
        mul_lt_mul_of_pos_left hupper hnpos
  have hnhi : ((s * d * k : ℕ) : ℝ) ≤ 2 * x ^ ((59519 : ℝ) / 100000) := by
    apply (mul_le_mul_iff_right₀ (Real.rpow_pos_of_pos hx0 ((40481 : ℝ) / 100000))).mp
    calc
      x ^ ((40481 : ℝ) / 100000) * ((s * d * k : ℕ) : ℝ) ≤
          ((r * h : ℕ) : ℝ) * ((s * d * k : ℕ) : ℝ) :=
        mul_le_mul_of_nonneg_right hcrossing hnpos.le
      _ = ((r * s * h * d * k : ℕ) : ℝ) := hfactor
      _ ≤ 2 * x := hproduct.2
      _ = x ^ ((40481 : ℝ) / 100000) *
          (2 * x ^ ((59519 : ℝ) / 100000)) := by
        rw [mul_left_comm, hcomplement]
  have hkhi : (k : ℝ) < 2 * x ^ ((1058 : ℝ) / 3125) := by
    apply (mul_lt_mul_iff_right₀ (Real.rpow_pos_of_pos hx0 (1 - (1058 : ℝ) / 3125))).mp
    calc
      x ^ (1 - (1058 : ℝ) / 3125) * (k : ℝ) <
          ((r * s * h * d : ℕ) : ℝ) * (k : ℝ) :=
        mul_lt_mul_of_pos_right hlong (Nat.cast_pos.mpr hk)
      _ = ((r * s * h * d * k : ℕ) : ℝ) := by push_cast; ring
      _ ≤ 2 * x := hproduct.2
      _ = x ^ (1 - (1058 : ℝ) / 3125) *
          (2 * x ^ ((1058 : ℝ) / 3125)) := by
        rw [mul_left_comm, ← Real.rpow_add hx0]
        norm_num
  exact ⟨hcrossing, hupper, hnlo, hnhi, hkhi⟩

theorem harman_strict_comparison_cells (L : ℕ) (b : ℕ → ℕ)
    (hlow : ∀ n, b n ≤ L ↔ n ≤ L)
    (hsingleton : ∀ n, n ≤ L → b n = n)
    (horder : ∀ n m, b n < b m → n < m) (p q : ℕ) :
    p < q ↔ b p < b q ∨ (L < b p ∧ b p = b q ∧ p < q) := by
  constructor
  · intro hpq
    rcases lt_trichotomy (b p) (b q) with hlt | heq | hgt
    · exact Or.inl hlt
    · refine Or.inr ⟨?_, heq, hpq⟩
      by_contra hnot
      have hpL : p ≤ L := (hlow p).mp (Nat.le_of_not_gt hnot)
      have hqL : q ≤ L := (hlow q).mp (by simpa only [← heq] using (hlow p).mpr hpL)
      have heq' : p = q := by simpa only [hsingleton p hpL, hsingleton q hqL] using heq
      exact hpq.ne heq'
    · exact (hpq.not_gt (horder q p hgt)).elim
  · rintro (h | ⟨_, _, h⟩)
    · exact horder p q h
    · exact h

theorem harman_same_high_cell_comparison_band
    (L : ℕ) (b : ℕ → ℕ) (lo : ℕ → ℝ) (h : ℝ) (hh : 0 ≤ h)
    (hlow : ∀ n, b n ≤ L ↔ n ≤ L)
    (hlower : ∀ n, 1 ≤ n → lo (b n) ≤ (n : ℝ))
    (hdiameter : ∀ n m, 1 ≤ n → 1 ≤ m → L < b n → b n = b m →
      |(n : ℝ) - m| ≤ h * lo (b n))
    (p q : ℕ) (hp : 1 ≤ p) (hq : 1 ≤ q)
    (hhigh : L < b p) (heq : b p = b q) :
    L < min p q ∧
      ((max p q : ℕ) : ℝ) ≤ (1 + h) * ((min p q : ℕ) : ℝ) := by
  have hpL : L < p := (lt_iff_lt_of_le_iff_le (hlow p)).mp hhigh
  have hqL : L < q := (lt_iff_lt_of_le_iff_le (hlow q)).mp (heq ▸ hhigh)
  refine ⟨lt_min hpL hqL, ?_⟩
  have hband := hdiameter p q hp hq hhigh heq
  have hplower := hlower p hp
  have hqlower := hlower q hq
  rw [← heq] at hqlower
  rcases le_total p q with hpq | hqp
  · rw [max_eq_right hpq, min_eq_left hpq]
    have hpqreal : (p : ℝ) ≤ q := by exact_mod_cast hpq
    rw [abs_of_nonpos (sub_nonpos.mpr hpqreal)] at hband
    have hmul := mul_le_mul_of_nonneg_left hplower hh
    nlinarith only [hband, hmul]
  · rw [max_eq_left hqp, min_eq_right hqp]
    have hqpreal : (q : ℝ) ≤ p := by exact_mod_cast hqp
    rw [abs_of_nonneg (sub_nonneg.mpr hqpreal)] at hband
    have hmul := mul_le_mul_of_nonneg_left hqlower hh
    nlinarith only [hband, hmul]

theorem harman_product_threshold_full_box_band
    (h T l₁ u₁ l₂ u₂ m n : ℝ) (hh : 0 ≤ h)
    (hl₁ : 0 ≤ l₁) (hl₂ : 0 ≤ l₂)
    (hm : l₁ ≤ m ∧ m ≤ u₁) (hn : l₂ ≤ n ∧ n ≤ u₂)
    (hu₁ : u₁ ≤ (1 + h) * l₁) (hu₂ : u₂ ≤ (1 + h) * l₂)
    (hboundary : l₁ * l₂ ≤ T ∧ T ≤ u₁ * u₂) :
    T / (1 + h) ^ 2 ≤ m * n ∧ m * n ≤ T * (1 + h) ^ 2 := by
  have hratio : 0 < (1 + h) ^ 2 := by positivity
  have hm0 : 0 ≤ m := hl₁.trans hm.1
  have hn0 : 0 ≤ n := hl₂.trans hn.1
  have hu₁0 : 0 ≤ u₁ := hm0.trans hm.2
  have hu₂0 : 0 ≤ u₂ := hn0.trans hn.2
  have hlow : l₁ * l₂ ≤ m * n := mul_le_mul hm.1 hn.1 hl₂ hm0
  have hhigh : m * n ≤ u₁ * u₂ := mul_le_mul hm.2 hn.2 hn0 hu₁0
  have hratioUpper : u₁ * u₂ ≤ (1 + h) ^ 2 * (l₁ * l₂) := by
    calc
      u₁ * u₂ ≤ ((1 + h) * l₁) * ((1 + h) * l₂) :=
        mul_le_mul hu₁ hu₂ hu₂0 (by positivity)
      _ = (1 + h) ^ 2 * (l₁ * l₂) := by ring
  constructor
  · apply (div_le_iff₀ hratio).mpr
    calc
      T ≤ u₁ * u₂ := hboundary.2
      _ ≤ (1 + h) ^ 2 * (l₁ * l₂) := hratioUpper
      _ ≤ (1 + h) ^ 2 * (m * n) :=
        mul_le_mul_of_nonneg_left hlow hratio.le
      _ = m * n * (1 + h) ^ 2 := by ring
  · calc
      m * n ≤ u₁ * u₂ := hhigh
      _ ≤ (1 + h) ^ 2 * (l₁ * l₂) := hratioUpper
      _ ≤ (1 + h) ^ 2 * T :=
        mul_le_mul_of_nonneg_left hboundary.1 hratio.le
      _ = T * (1 + h) ^ 2 := mul_comm _ _

theorem harman_product_comparison_crossing
    (T l₁ u₁ l₂ u₂ m n m' n' : ℝ)
    (hl₁ : 0 ≤ l₁) (hl₂ : 0 ≤ l₂)
    (hm : l₁ ≤ m ∧ m ≤ u₁) (hn : l₂ ≤ n ∧ n ≤ u₂)
    (hm' : l₁ ≤ m' ∧ m' ≤ u₁) (hn' : l₂ ≤ n' ∧ n' ≤ u₂)
    (hcross : (m * n < T ∧ T ≤ m' * n') ∨
      (m * n ≤ T ∧ T < m' * n')) :
    l₁ * l₂ ≤ T ∧ T ≤ u₁ * u₂ := by
  have hm0 : 0 ≤ m := hl₁.trans hm.1
  have hn'0 : 0 ≤ n' := hl₂.trans hn'.1
  have hu₁0 : 0 ≤ u₁ := (hl₁.trans hm'.1).trans hm'.2
  have hlo : l₁ * l₂ ≤ m * n := mul_le_mul hm.1 hn.1 hl₂ hm0
  have hhi : m' * n' ≤ u₁ * u₂ := mul_le_mul hm'.2 hn'.2 hn'0 hu₁0
  rcases hcross with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩
  · exact ⟨hlo.trans h₁.le, h₂.trans hhi⟩
  · exact ⟨hlo.trans h₁, h₂.le.trans hhi⟩

open Classical in
theorem centralPair_primeTuples_cons (k n : ℕ)
    (w : (Fin (k + 1) → ℕ) → ℝ) :
    (∑ d ∈ n.divisorsAntidiagonal, if d.1.Prime then
      ∑ r ∈ Fintype.piFinset (fun _ : Fin k => Nat.primesLE d.2),
        if (∏ i, r i) = d.2 then w (Fin.cons d.1 r) else 0
      else 0) =
    ∑ r ∈ Fintype.piFinset (fun _ : Fin (k + 1) => Nat.primesLE n),
      if (∏ i, r i) = n then w r else 0 := by
  by_cases hn : n = 0
  · subst n
    simp
  have hs : Fintype.piFinset (fun _ : Fin (k + 1) => Nat.primesLE n) =
      (Nat.primesLE n ×ˢ Fintype.piFinset (fun _ : Fin k => Nat.primesLE n)).map
        (Fin.consEquiv (fun _ : Fin (k + 1) => ℕ)).toEmbedding := by
    have htail : Fin.tail (fun _ : Fin (k + 1) => Nat.primesLE n) =
        (fun _ : Fin k => Nat.primesLE n) := rfl
    simpa only [Finset.filter_true, htail] using
      Finset.filter_piFinset_eq_map_consEquiv
        (fun _ : Fin (k + 1) => Nat.primesLE n) (fun _ : Fin k → ℕ => True)
  rw [hs, Finset.sum_map, Finset.sum_product]
  simp only [Equiv.toEmbedding_apply, Fin.consEquiv_apply, Fin.prod_cons]
  rw [Nat.sum_divisorsAntidiagonal (fun p m => if p.Prime then
    ∑ r ∈ Fintype.piFinset (fun _ : Fin k => Nat.primesLE m),
      if (∏ i, r i) = m then w (Fin.cons p r) else 0 else 0)]
  rw [← Finset.sum_filter]
  calc
    (∑ p ∈ n.divisors.filter Nat.Prime,
        ∑ r ∈ Fintype.piFinset (fun _ : Fin k => Nat.primesLE (n / p)),
          if (∏ i, r i) = n / p then w (Fin.cons p r) else 0) =
        ∑ p ∈ n.divisors.filter Nat.Prime,
          ∑ r ∈ Fintype.piFinset (fun _ : Fin k => Nat.primesLE n),
            if p * (∏ i, r i) = n then w (Fin.cons p r) else 0 := by
      apply Finset.sum_congr rfl
      intro p hp
      obtain ⟨hpd, hprime⟩ := Finset.mem_filter.mp hp
      have hpn : p ∣ n := (Nat.mem_divisors.mp hpd).1
      have hiff (r : Fin k → ℕ) : (∏ i, r i) = n / p ↔ p * (∏ i, r i) = n := by
        constructor
        · intro h
          rw [h, Nat.mul_div_cancel' hpn]
        · intro h
          apply mul_left_cancel₀ hprime.ne_zero
          exact h.trans (Nat.mul_div_cancel' hpn).symm
      simp only [hiff]
      apply Finset.sum_subset
        (Fintype.piFinset_subset _ _ fun _ => Nat.primesLE_mono (Nat.div_le_self n p))
      intro r hr hrnot
      apply ite_eq_right
      intro hprod
      apply hrnot
      apply Fintype.mem_piFinset.mpr
      intro i
      have hpr (j : Fin k) : (r j).Prime :=
        Nat.prime_of_mem_primesLE (Fintype.mem_piFinset.mp hr j)
      have hri : r i ≤ ∏ j, r j := Finset.single_le_prod'
        (fun j _ => (hpr j).one_le) (Finset.mem_univ i)
      exact Nat.mem_primesLE.mpr ⟨by simpa only [hiff r |>.mpr hprod] using hri, hpr i⟩
    _ = ∑ p ∈ Nat.primesLE n,
          ∑ r ∈ Fintype.piFinset (fun _ : Fin k => Nat.primesLE n),
            if p * (∏ i, r i) = n then w (Fin.cons p r) else 0 := by
      apply Finset.sum_subset
      · intro p hp
        obtain ⟨hpd, hprime⟩ := Finset.mem_filter.mp hp
        exact Nat.mem_primesLE.mpr
          ⟨Nat.le_of_dvd (Nat.pos_of_ne_zero hn) (Nat.mem_divisors.mp hpd).1, hprime⟩
      · intro p hp hpnot
        apply Finset.sum_eq_zero
        intro r _hr
        apply ite_eq_right
        intro hprod
        exact hpnot (Finset.mem_filter.mpr
          ⟨Nat.mem_divisors.mpr ⟨⟨∏ i, r i, hprod.symm⟩, hn⟩,
            Nat.prime_of_mem_primesLE hp⟩)

open Classical in
theorem centralPair_primeTuples_one (n : ℕ) (w : (Fin 1 → ℕ) → ℝ) :
    (∑ r ∈ Fintype.piFinset (fun _ : Fin 1 => Nat.primesLE n),
      if (∏ i, r i) = n then w r else 0) =
      if n.Prime then w (fun _ => n) else 0 := by
  by_cases hn : n.Prime
  · rw [ite_eq_left hn]
    calc
      _ = (if (∏ _i : Fin 1, n) = n then w (fun _ => n) else 0) := by
        apply Finset.sum_eq_single (fun _ : Fin 1 => n)
        · intro r _hr hrne
          apply ite_eq_right
          intro hprod
          apply hrne
          funext i
          have hi : i = 0 := Fin.eq_zero i
          subst i
          simpa only [Fin.prod_univ_one] using hprod
        · intro hnot
          exact False.elim (hnot (Fintype.mem_piFinset.mpr
            (fun _ => Nat.mem_primesLE.mpr ⟨le_rfl, hn⟩)))
      _ = _ := by simp
  · rw [ite_eq_right hn]
    apply Finset.sum_eq_zero
    intro r hr
    apply ite_eq_right
    intro hprod
    have heq : r 0 = n := by simpa only [Fin.prod_univ_one] using hprod
    exact hn (heq ▸ Nat.prime_of_mem_primesLE (Fintype.mem_piFinset.mp hr 0))

open Classical in
theorem centralPair_three_weighted (n : ℕ) (w : ℕ → ℕ → ℕ → ℝ) :
    (∑ d ∈ n.divisorsAntidiagonal, if d.1.Prime then
      ∑ e ∈ d.2.divisorsAntidiagonal, if e.1.Prime then
        if e.2.Prime then w d.1 e.1 e.2 else 0 else 0 else 0) =
    ∑ r ∈ Fintype.piFinset (fun _ : Fin 3 => Nat.primesLE n),
      if (∏ i, r i) = n then w (r 0) (r 1) (r 2) else 0 := by
  have h := centralPair_primeTuples_cons 2 n (fun r => w (r 0) (r 1) (r 2))
  simp_rw [← centralPair_primeTuples_cons 1, centralPair_primeTuples_one] at h
  have htwo (p : ℕ) (r : Fin 2 → ℕ) : (Fin.cons p r : Fin 3 → ℕ) 2 = r 1 :=
    Fin.cons_succ (α := fun _ : Fin 3 => ℕ) p r (1 : Fin 2)
  simpa only [Fin.cons_zero, Fin.cons_one, htwo] using h

open Classical in
theorem centralPair_four_weighted (n : ℕ) (w : ℕ → ℕ → ℕ → ℕ → ℝ) :
    (∑ d ∈ n.divisorsAntidiagonal, if d.1.Prime then
      ∑ e ∈ d.2.divisorsAntidiagonal, if e.1.Prime then
        ∑ f ∈ e.2.divisorsAntidiagonal, if f.1.Prime then
          if f.2.Prime then w d.1 e.1 f.1 f.2 else 0 else 0 else 0 else 0) =
    ∑ r ∈ Fintype.piFinset (fun _ : Fin 4 => Nat.primesLE n),
      if (∏ i, r i) = n then w (r 0) (r 1) (r 2) (r 3) else 0 := by
  have h := centralPair_primeTuples_cons 3 n (fun r => w (r 0) (r 1) (r 2) (r 3))
  have htwo (p : ℕ) (r : Fin 3 → ℕ) : (Fin.cons p r : Fin 4 → ℕ) 2 = r 1 :=
    Fin.cons_succ (α := fun _ : Fin 4 => ℕ) p r (1 : Fin 3)
  have hthree (p : ℕ) (r : Fin 3 → ℕ) : (Fin.cons p r : Fin 4 → ℕ) 3 = r 2 :=
    Fin.cons_succ (α := fun _ : Fin 4 => ℕ) p r (2 : Fin 3)
  simp only [Fin.cons_zero, Fin.cons_one, htwo, hthree] at h
  simpa only [← centralPair_three_weighted] using h

open Classical in
theorem centralPair_five_weighted (n : ℕ) (w : ℕ → ℕ → ℕ → ℕ → ℕ → ℝ) :
    (∑ d ∈ n.divisorsAntidiagonal, if d.1.Prime then
      ∑ e ∈ d.2.divisorsAntidiagonal, if e.1.Prime then
        ∑ f ∈ e.2.divisorsAntidiagonal, if f.1.Prime then
          ∑ g ∈ f.2.divisorsAntidiagonal, if g.1.Prime then
            if g.2.Prime then w d.1 e.1 f.1 g.1 g.2 else 0 else 0 else 0 else 0 else 0) =
    ∑ r ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
      if (∏ i, r i) = n then w (r 0) (r 1) (r 2) (r 3) (r 4) else 0 := by
  have h := centralPair_primeTuples_cons 4 n
    (fun r => w (r 0) (r 1) (r 2) (r 3) (r 4))
  have htwo (p : ℕ) (r : Fin 4 → ℕ) : (Fin.cons p r : Fin 5 → ℕ) 2 = r 1 :=
    Fin.cons_succ (α := fun _ : Fin 5 => ℕ) p r (1 : Fin 4)
  have hthree (p : ℕ) (r : Fin 4 → ℕ) : (Fin.cons p r : Fin 5 → ℕ) 3 = r 2 :=
    Fin.cons_succ (α := fun _ : Fin 5 => ℕ) p r (2 : Fin 4)
  have hfour (p : ℕ) (r : Fin 4 → ℕ) : (Fin.cons p r : Fin 5 → ℕ) 4 = r 3 :=
    Fin.cons_succ (α := fun _ : Fin 5 => ℕ) p r (3 : Fin 4)
  simp only [Fin.cons_zero, Fin.cons_one, htwo, hthree, hfour] at h
  simpa only [← centralPair_four_weighted] using h

open Classical in
theorem centralPair_expanded_antidiagonal_eq_prime_tuples
    (n : ℕ) (C : ℕ → ℕ → Prop) :
    (∑ d ∈ n.divisorsAntidiagonal, ∑ e ∈ d.2.divisorsAntidiagonal,
      if d.1.Prime ∧ e.1.Prime ∧ C d.1 e.1 then
        (if e.2.Prime ∧ e.1 ≤ e.2 then (1 : ℝ) else 0) +
        (∑ f ∈ e.2.divisorsAntidiagonal,
          if f.1.Prime ∧ f.2.Prime ∧ e.1 ≤ f.1 ∧ f.1 ≤ f.2 then 1 else 0) +
        (∑ f ∈ e.2.divisorsAntidiagonal, ∑ g ∈ f.2.divisorsAntidiagonal,
          if f.1.Prime ∧ g.1.Prime ∧ g.2.Prime ∧
            e.1 ≤ f.1 ∧ f.1 ≤ g.1 ∧ g.1 ≤ g.2 then 1 else 0)
      else 0) =
    (∑ r ∈ Fintype.piFinset (fun _ : Fin 3 => Nat.primesLE n),
      if (∏ i, r i) = n ∧ C (r 0) (r 1) ∧ r 1 ≤ r 2 then (1 : ℝ) else 0) +
    (∑ r ∈ Fintype.piFinset (fun _ : Fin 4 => Nat.primesLE n),
      if (∏ i, r i) = n ∧ C (r 0) (r 1) ∧ r 1 ≤ r 2 ∧ r 2 ≤ r 3
      then (1 : ℝ) else 0) +
    (∑ r ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
      if (∏ i, r i) = n ∧ C (r 0) (r 1) ∧ r 1 ≤ r 2 ∧ r 2 ≤ r 3 ∧ r 3 ≤ r 4
      then (1 : ℝ) else 0) := by
  have h3 := centralPair_three_weighted n
    (fun p q r => if C p q ∧ q ≤ r then 1 else 0)
  have h4 := centralPair_four_weighted n
    (fun p q r s => if C p q ∧ q ≤ r ∧ r ≤ s then 1 else 0)
  have h5 := centralPair_five_weighted n
    (fun p q r s t => if C p q ∧ q ≤ r ∧ r ≤ s ∧ s ≤ t then 1 else 0)
  simp only [ite_and] at h3 h4 h5 ⊢
  rw [← h3, ← h4, ← h5]
  conv_rhs => rw [← Finset.sum_add_distrib, ← Finset.sum_add_distrib]
  apply Finset.sum_congr rfl
  intro d _hd
  by_cases hp : d.1.Prime
  · simp only [hp, ite_true]
    conv_rhs => rw [← Finset.sum_add_distrib, ← Finset.sum_add_distrib]
    apply Finset.sum_congr rfl
    intro e _he
    by_cases hq : e.1.Prime <;> by_cases hc : C d.1 e.1 <;>
      simp [hq, hc, Finset.sum_ite_irrel]
  · simp [hp]

open Classical in
theorem sifted_short_two_prime_coefficient_eq
    (x : ℝ) (hx : 1 < x) (e : Fin 2) (n : ℕ) :
    let j : Fin 6 := if e = 0 then 2 else 3
    let z : ℝ := x ^ ((9519 : ℝ) / 50000)
    let alpha : ℕ → ℝ := fun p => Real.logb x (p : ℝ)
    (∑ ps ∈ siftedPrimeTuples x j, ∑ d ∈ n.divisorsAntidiagonal,
      if d.1 = ps.prod then smallPrimeMobius z d.2 else 0) =
    ∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
      if Nat.Prime a.1 ∧ Nat.Prime b.1 ∧ (9519 : ℝ) / 50000 ≤ alpha b.1 ∧
          alpha b.1 < alpha a.1 ∧ alpha a.1 < (40481 : ℝ) / 100000 ∧
          (if e = 0 then alpha a.1 + alpha b.1 < (40481 : ℝ) / 100000 else
            (59519 : ℝ) / 100000 < alpha a.1 + alpha b.1 ∧
              alpha b.1 < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000)
      then smallPrimeMobius z b.2 else 0 := by
  intro j z alpha
  have hpair (p q : ℕ) : [p, q] ∈ siftedPrimeTuples x j ↔
      Nat.Prime p ∧ Nat.Prime q ∧ (9519 : ℝ) / 50000 ≤ alpha q ∧
        alpha q < alpha p ∧ alpha p < (40481 : ℝ) / 100000 ∧
        (if e = 0 then alpha p + alpha q < (40481 : ℝ) / 100000 else
          (59519 : ℝ) / 100000 < alpha p + alpha q ∧
            alpha q < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000) := by
    have hmem := mem_siftedPrimeTuples_iff x hx j [p, q]
    by_cases he : e = 0 <;> simpa [j, he, alpha] using hmem
  have hshape (ps : List ℕ) (hps : ps ∈ siftedPrimeTuples x j) :
      ∃ p q : ℕ, ps = [p, q] := by
    have hmem := (mem_siftedPrimeTuples_iff x hx j ps).mp hps
    by_cases he : e = 0 <;>
      rcases ps with _ | ⟨p, _ | ⟨q, _ | ⟨r, rs⟩⟩⟩ <;>
      simp [j, he] at hmem ⊢
  simpa only [hpair] using
    sum_pair_list_divisorsAntidiagonal (siftedPrimeTuples x j) hshape
      (fun _ m => smallPrimeMobius z m) n

open Classical in
theorem sifted_short_three_prime_coefficient_eq
    (x : ℝ) (hx : 1 < x) (n : ℕ) :
    let z : ℝ := x ^ ((9519 : ℝ) / 50000)
    let alpha : ℕ → ℝ := fun p => Real.logb x (p : ℝ)
    (∑ ps ∈ siftedPrimeTuples x (4 : Fin 6), ∑ d ∈ n.divisorsAntidiagonal,
      if d.1 = ps.prod then smallPrimeMobius z d.2 else 0) =
    ∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
      ∑ c ∈ b.2.divisorsAntidiagonal,
        if Nat.Prime a.1 ∧ Nat.Prime b.1 ∧ Nat.Prime c.1 ∧
            (9519 : ℝ) / 50000 ≤ alpha c.1 ∧ alpha c.1 < alpha b.1 ∧
            alpha b.1 < alpha a.1 ∧ alpha a.1 < (40481 : ℝ) / 100000 ∧
            alpha a.1 + alpha b.1 < (40481 : ℝ) / 100000 ∧
            alpha c.1 < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000
        then smallPrimeMobius z c.2 else 0 := by
  intro z alpha
  have htriple (p q r : ℕ) : [p, q, r] ∈ siftedPrimeTuples x (4 : Fin 6) ↔
      Nat.Prime p ∧ Nat.Prime q ∧ Nat.Prime r ∧ (9519 : ℝ) / 50000 ≤ alpha r ∧
        alpha r < alpha q ∧ alpha q < alpha p ∧ alpha p < (40481 : ℝ) / 100000 ∧
        alpha p + alpha q < (40481 : ℝ) / 100000 ∧
        alpha r < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000 := by
    simpa [alpha] using mem_siftedPrimeTuples_iff x hx (4 : Fin 6) [p, q, r]
  have hshape (ps : List ℕ) (hps : ps ∈ siftedPrimeTuples x (4 : Fin 6)) :
      ∃ p q r : ℕ, ps = [p, q, r] := by
    have hmem := (mem_siftedPrimeTuples_iff x hx (4 : Fin 6) ps).mp hps
    rcases ps with _ | ⟨p, _ | ⟨q, _ | ⟨r, _ | ⟨s, ss⟩⟩⟩⟩ <;>
      simp at hmem ⊢
  simpa only [htriple] using
    sum_triple_list_divisorsAntidiagonal (siftedPrimeTuples x (4 : Fin 6)) hshape
      (fun _ m => smallPrimeMobius z m) n

open Classical in
theorem sifted_short_two_prime_named_coefficient_eq
    (x : ℝ) (hx : 1 < x) (e : Fin 2) (n : ℕ) :
    let j : Fin 6 := if e = 0 then 2 else 3
    let z := x ^ ((9519 : ℝ) / 50000)
    let H := x ^ ((40481 : ℝ) / 100000)
    let B := x ^ ((59519 : ℝ) / 100000)
    let P : ℕ → ℕ → ℕ → Prop := fun q _r _h =>
      if e = 0 then True else
        Real.logb x (q : ℝ) < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000
    let L : ℕ → ℕ → ℕ → ℝ := fun q _r _h =>
      if e = 0 then (q : ℝ) + 1 else
        max ((q : ℝ) + 1) ((Nat.floor (B / (q : ℝ)) : ℝ) + 1)
    let U : ℕ → ℕ → ℕ → ℝ := fun q _r _h =>
      if e = 0 then
        min ((Nat.ceil H - 1 : ℕ) : ℝ) ((Nat.ceil (H / (q : ℝ)) - 1 : ℕ) : ℝ)
      else ((Nat.ceil H - 1 : ℕ) : ℝ)
    let Q0 : ℤ :=
      ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
        ∑ cc ∈ bb.2.divisorsAntidiagonal,
          if Nat.Prime aa.1 ∧ z ≤ (aa.1 : ℝ) ∧
              (Nat.Prime bb.1 ∧ z ≤ (bb.1 : ℝ)) ∧ bb.1 ≤ aa.1 ∧
              cc.1 = 1 ∧ cc.1 ≤ aa.1 ∧
              ((max 1 (cc.2.primeFactors.sup id) : ℕ) : ℝ) < z ∧
              P bb.1 cc.1 cc.2 ∧ L bb.1 cc.1 cc.2 ≤ (aa.1 : ℝ) ∧
              (aa.1 : ℝ) ≤ U bb.1 cc.1 cc.2
          then ArithmeticFunction.moebius cc.2 else 0
    (∑ ps ∈ siftedPrimeTuples x j, ∑ d ∈ n.divisorsAntidiagonal,
      if d.1 = ps.prod then smallPrimeMobius z d.2 else 0) = (Q0 : ℝ) := by
  intro j z H B P L U Q0
  have hrow (p q m : ℕ) (hm : 0 < m) :
      ((∑ cc ∈ m.divisorsAntidiagonal,
        if Nat.Prime p ∧ z ≤ (p : ℝ) ∧ (Nat.Prime q ∧ z ≤ (q : ℝ)) ∧ q ≤ p ∧
            cc.1 = 1 ∧ cc.1 ≤ p ∧ ((max 1 (cc.2.primeFactors.sup id) : ℕ) : ℝ) < z ∧
            P q cc.1 cc.2 ∧ L q cc.1 cc.2 ≤ (p : ℝ) ∧ (p : ℝ) ≤ U q cc.1 cc.2
        then ArithmeticFunction.moebius cc.2 else 0 : ℤ) : ℝ) =
      if Nat.Prime p ∧ Nat.Prime q ∧ (9519 : ℝ) / 50000 ≤ Real.logb x (q : ℝ) ∧
          Real.logb x (q : ℝ) < Real.logb x (p : ℝ) ∧
          Real.logb x (p : ℝ) < (40481 : ℝ) / 100000 ∧
          (if e = 0 then
            Real.logb x (p : ℝ) + Real.logb x (q : ℝ) < (40481 : ℝ) / 100000 else
            (59519 : ℝ) / 100000 < Real.logb x (p : ℝ) + Real.logb x (q : ℝ) ∧
              Real.logb x (q : ℝ) < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000)
      then smallPrimeMobius z m else 0 := by
    have hunit : (1, m) ∈ m.divisorsAntidiagonal :=
      Nat.mem_divisorsAntidiagonal.mpr ⟨one_mul _, hm.ne'⟩
    rw [Finset.sum_eq_single_of_mem (1, m) hunit]
    · simp only
      by_cases hp : Nat.Prime p
      · by_cases hq : Nat.Prime q
        · have hw := sifted_short_pair_window_iff x hx e p q hp hq
          dsimp only at hw
          have hp1 : 1 ≤ p := hp.one_lt.le
          have hguard :
              (Nat.Prime p ∧ z ≤ (p : ℝ) ∧ (Nat.Prime q ∧ z ≤ (q : ℝ)) ∧ q ≤ p ∧
                True ∧ 1 ≤ p ∧ ((max 1 (m.primeFactors.sup id) : ℕ) : ℝ) < z ∧
                P q 1 m ∧ L q 1 m ≤ (p : ℝ) ∧ (p : ℝ) ≤ U q 1 m) ↔
              (Nat.Prime p ∧ Nat.Prime q ∧ (9519 : ℝ) / 50000 ≤ Real.logb x (q : ℝ) ∧
                Real.logb x (q : ℝ) < Real.logb x (p : ℝ) ∧
                Real.logb x (p : ℝ) < (40481 : ℝ) / 100000 ∧
                (if e = 0 then
                  Real.logb x (p : ℝ) + Real.logb x (q : ℝ) < (40481 : ℝ) / 100000 else
                  (59519 : ℝ) / 100000 < Real.logb x (p : ℝ) + Real.logb x (q : ℝ) ∧
                    Real.logb x (q : ℝ) < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000)) ∧
                ((max 1 (m.primeFactors.sup id) : ℕ) : ℝ) < z := by
            dsimp only [P, L, U, z, H, B] at hw ⊢
            tauto
          simp only [hguard]
          simp only [smallPrimeMobius, ArithmeticFunction.coe_mk,
            apply_ite (fun t : ℤ => (t : ℝ)), Int.cast_zero, ← ite_and]
        · simp [hq]
      · simp [hp]
    · intro cc hcc hne
      apply ite_eq_right
      intro h
      have hc1 : cc.1 = 1 := h.2.2.2.2.1
      have hc2 : cc.2 = m := by
        simpa only [hc1, one_mul] using (Nat.mem_divisorsAntidiagonal.mp hcc).1
      exact hne (Prod.ext hc1 hc2)
  have hs := sifted_short_two_prime_coefficient_eq x hx e n
  dsimp only at hs
  rw [hs]
  simp only [Q0, Int.cast_sum]
  apply Finset.sum_congr rfl
  intro aa haa
  apply Finset.sum_congr rfl
  intro bb hbb
  simpa only [Int.cast_sum] using (hrow aa.1 bb.1 bb.2
    (Nat.pos_of_ne_zero (Nat.right_ne_zero_of_mem_divisorsAntidiagonal hbb))).symm

open Classical in
theorem sifted_short_two_prime_all_moduli_siegelWalfisz
    (ε T c C A : ℝ) (hε : 0 < ε) (hT : 0 < T) (hc : 0 < c)
    (hC : 0 < C) (hA : 0 < A) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ e : Fin 2, ∀ nlo nhi : ℝ, c * N ≤ nlo →
      ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 →
      ∀ a : ℕ, Nat.Coprime a q →
      let j : Fin 6 := if e = 0 then 2 else 3
      let z := x ^ ((9519 : ℝ) / 50000)
      let M0 := x ^ (1 - (1058 : ℝ) / 3125)
      let S0 : ℕ → ℝ := fun n =>
        if (n : ℝ) ≤ M0 then
          ∑ ps ∈ siftedPrimeTuples x j, ∑ d ∈ n.divisorsAntidiagonal,
            if d.1 = ps.prod then smallPrimeMobius z d.2 else 0
        else 0
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
          (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
           then (S0 n : ℂ) else 0)) q a‖ ≤
        K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨K, X0, hK, hX0, hbound⟩ :=
    harmanA0_named_all_moduli_siegelWalfisz ε T c C A hε hT hc hC hA
  refine ⟨K, X0, hK, hX0, ?_⟩
  intro x hx N hNL hNU e nlo nhi hlo q hq r0 hr0 a ha j z M0 S0
  have hx1 : 1 < x :=
    (Real.one_lt_exp_iff.mpr (by norm_num : (0 : ℝ) < 1)).trans_le (hX0.trans hx)
  have hz : 0 < z := Real.rpow_pos_of_pos (zero_lt_one.trans hx1) _
  let H := x ^ ((40481 : ℝ) / 100000)
  let B := x ^ ((59519 : ℝ) / 100000)
  let P : ℕ → ℕ → ℕ → Prop := fun s _r _h =>
    if e = 0 then True else
      Real.logb x (s : ℝ) < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000
  let L : ℕ → ℕ → ℕ → ℝ := fun s _r _h =>
    if e = 0 then (s : ℝ) + 1 else
      max ((s : ℝ) + 1) ((Nat.floor (B / (s : ℝ)) : ℝ) + 1)
  let U : ℕ → ℕ → ℕ → ℝ := fun s _r _h =>
    if e = 0 then
      min ((Nat.ceil H - 1 : ℕ) : ℝ) ((Nat.ceil (H / (s : ℝ)) - 1 : ℕ) : ℝ)
    else ((Nat.ceil H - 1 : ℕ) : ℝ)
  let Q0 : ℕ → ℤ := fun n =>
    ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
      ∑ cc ∈ bb.2.divisorsAntidiagonal,
        if Nat.Prime aa.1 ∧ z ≤ (aa.1 : ℝ) ∧
            (Nat.Prime bb.1 ∧ z ≤ (bb.1 : ℝ)) ∧ bb.1 ≤ aa.1 ∧
            cc.1 = 1 ∧ cc.1 ≤ aa.1 ∧
            ((max 1 (cc.2.primeFactors.sup id) : ℕ) : ℝ) < z ∧
            P bb.1 cc.1 cc.2 ∧ L bb.1 cc.1 cc.2 ≤ (aa.1 : ℝ) ∧
            (aa.1 : ℝ) ≤ U bb.1 cc.1 cc.2
        then ArithmeticFunction.moebius cc.2 else 0
  have hcoeff (n : ℕ) : (Q0 n : ℂ) =
      ((∑ ps ∈ siftedPrimeTuples x j, ∑ d ∈ n.divisorsAntidiagonal,
        if d.1 = ps.prod then smallPrimeMobius z d.2 else 0 : ℝ) : ℂ) := by
    have hs := congrArg (fun t : ℝ => (t : ℂ))
      (sifted_short_two_prime_named_coefficient_eq x hx1 e n)
    simpa only [Complex.ofReal_intCast] using hs.symm
  have hb := hbound x hx N hNL hNU (1 : Fin 2) (0 : Fin 2)
    P L U z M0 nlo nhi hz hlo false q hq r0 hr0 a ha
  dsimp only at hb
  simp only [show (1 : Fin 2) ≠ 0 by decide, ite_true, ite_false,
    ite_eq_right (show ¬(false : Bool) by decide)] at hb
  dsimp only [Q0] at hcoeff
  simpa only [apply_ite (fun t : ℤ => (t : ℂ)), Int.cast_zero, hcoeff,
    S0, apply_ite (fun t : ℝ => (t : ℂ)), Complex.ofReal_zero] using hb

open Classical in
theorem sifted_short_three_prime_named_coefficient_eq
    (x : ℝ) (hx : 1 < x) (n : ℕ) :
    let z := x ^ ((9519 : ℝ) / 50000)
    let H := x ^ ((40481 : ℝ) / 100000)
    let P : ℕ → ℕ → ℕ → Prop := fun q r _h => r < q ∧
      Real.logb x (r : ℝ) < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000
    let L : ℕ → ℕ → ℕ → ℝ := fun q _r _h => (q : ℝ) + 1
    let U : ℕ → ℕ → ℕ → ℝ := fun q _r _h =>
      min ((Nat.ceil H - 1 : ℕ) : ℝ) ((Nat.ceil (H / (q : ℝ)) - 1 : ℕ) : ℝ)
    let Q0 : ℤ :=
      ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
        ∑ cc ∈ bb.2.divisorsAntidiagonal,
          if Nat.Prime aa.1 ∧ z ≤ (aa.1 : ℝ) ∧
              (Nat.Prime bb.1 ∧ z ≤ (bb.1 : ℝ)) ∧ bb.1 ≤ aa.1 ∧
              (Nat.Prime cc.1 ∧ z ≤ (cc.1 : ℝ)) ∧ cc.1 ≤ aa.1 ∧
              ((max 1 (cc.2.primeFactors.sup id) : ℕ) : ℝ) < z ∧
              P bb.1 cc.1 cc.2 ∧ L bb.1 cc.1 cc.2 ≤ (aa.1 : ℝ) ∧
              (aa.1 : ℝ) ≤ U bb.1 cc.1 cc.2
          then ArithmeticFunction.moebius cc.2 else 0
    (∑ ps ∈ siftedPrimeTuples x (4 : Fin 6), ∑ d ∈ n.divisorsAntidiagonal,
      if d.1 = ps.prod then smallPrimeMobius z d.2 else 0) = (Q0 : ℝ) := by
  intro z H P L U Q0
  have hscalar (p q r h : ℕ) :
      (if Nat.Prime p ∧ Nat.Prime q ∧ Nat.Prime r ∧
          (9519 : ℝ) / 50000 ≤ Real.logb x (r : ℝ) ∧
          Real.logb x (r : ℝ) < Real.logb x (q : ℝ) ∧
          Real.logb x (q : ℝ) < Real.logb x (p : ℝ) ∧
          Real.logb x (p : ℝ) < (40481 : ℝ) / 100000 ∧
          Real.logb x (p : ℝ) + Real.logb x (q : ℝ) < (40481 : ℝ) / 100000 ∧
          Real.logb x (r : ℝ) < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000
       then smallPrimeMobius z h else 0) =
      ((if Nat.Prime p ∧ z ≤ (p : ℝ) ∧
          (Nat.Prime q ∧ z ≤ (q : ℝ)) ∧ q ≤ p ∧
          (Nat.Prime r ∧ z ≤ (r : ℝ)) ∧ r ≤ p ∧
          ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧
          P q r h ∧ L q r h ≤ (p : ℝ) ∧ (p : ℝ) ≤ U q r h
        then ArithmeticFunction.moebius h else 0 : ℤ) : ℝ) := by
    by_cases hp : Nat.Prime p
    · by_cases hq : Nat.Prime q
      · by_cases hr : Nat.Prime r
        · have hw := sifted_short_triple_window_iff x hx p q r hp hq hr
          dsimp only at hw
          have hguard :
              (Nat.Prime p ∧ z ≤ (p : ℝ) ∧ (Nat.Prime q ∧ z ≤ (q : ℝ)) ∧ q ≤ p ∧
                (Nat.Prime r ∧ z ≤ (r : ℝ)) ∧ r ≤ p ∧
                ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧
                P q r h ∧ L q r h ≤ (p : ℝ) ∧ (p : ℝ) ≤ U q r h) ↔
              (Nat.Prime p ∧ Nat.Prime q ∧ Nat.Prime r ∧
                (9519 : ℝ) / 50000 ≤ Real.logb x (r : ℝ) ∧
                Real.logb x (r : ℝ) < Real.logb x (q : ℝ) ∧
                Real.logb x (q : ℝ) < Real.logb x (p : ℝ) ∧
                Real.logb x (p : ℝ) < (40481 : ℝ) / 100000 ∧
                Real.logb x (p : ℝ) + Real.logb x (q : ℝ) < (40481 : ℝ) / 100000 ∧
                Real.logb x (r : ℝ) < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000) ∧
                ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z := by
            dsimp only [P, L, U, z, H] at hw ⊢
            tauto
          simp only [hguard]
          simp only [smallPrimeMobius, ArithmeticFunction.coe_mk,
            apply_ite (fun t : ℤ => (t : ℝ)), Int.cast_zero, ← ite_and]
        · simp [hr]
      · simp [hq]
    · simp [hp]
  have hs := sifted_short_three_prime_coefficient_eq x hx n
  dsimp only at hs
  rw [hs]
  simp only [Q0, Int.cast_sum]
  apply Finset.sum_congr rfl
  intro aa haa
  apply Finset.sum_congr rfl
  intro bb hbb
  apply Finset.sum_congr rfl
  intro cc hcc
  exact hscalar aa.1 bb.1 cc.1 cc.2

open Classical in
theorem sifted_short_three_prime_all_moduli_siegelWalfisz
    (ε T c C A : ℝ) (hε : 0 < ε) (hT : 0 < T) (hc : 0 < c)
    (hC : 0 < C) (hA : 0 < A) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ nlo nhi : ℝ, c * N ≤ nlo →
      ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 →
      ∀ a : ℕ, Nat.Coprime a q →
      let z := x ^ ((9519 : ℝ) / 50000)
      let M0 := x ^ (1 - (1058 : ℝ) / 3125)
      let S0 : ℕ → ℝ := fun n =>
        if (n : ℝ) ≤ M0 then
          ∑ ps ∈ siftedPrimeTuples x (4 : Fin 6), ∑ d ∈ n.divisorsAntidiagonal,
            if d.1 = ps.prod then smallPrimeMobius z d.2 else 0
        else 0
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
          (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
           then (S0 n : ℂ) else 0)) q a‖ ≤
        K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨K, X0, hK, hX0, hbound⟩ :=
    harmanA0_named_all_moduli_siegelWalfisz ε T c C A hε hT hc hC hA
  refine ⟨K, X0, hK, hX0, ?_⟩
  intro x hx N hNL hNU nlo nhi hlo q hq r0 hr0 a ha z M0 S0
  have hx1 : 1 < x :=
    (Real.one_lt_exp_iff.mpr (by norm_num : (0 : ℝ) < 1)).trans_le (hX0.trans hx)
  have hz : 0 < z := Real.rpow_pos_of_pos (zero_lt_one.trans hx1) _
  let H := x ^ ((40481 : ℝ) / 100000)
  let P : ℕ → ℕ → ℕ → Prop := fun s t _h => t < s ∧
    Real.logb x (t : ℝ) < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000
  let L : ℕ → ℕ → ℕ → ℝ := fun s _t _h => (s : ℝ) + 1
  let U : ℕ → ℕ → ℕ → ℝ := fun s _t _h =>
    min ((Nat.ceil H - 1 : ℕ) : ℝ) ((Nat.ceil (H / (s : ℝ)) - 1 : ℕ) : ℝ)
  let Q0 : ℕ → ℤ := fun n =>
    ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
      ∑ cc ∈ bb.2.divisorsAntidiagonal,
        if Nat.Prime aa.1 ∧ z ≤ (aa.1 : ℝ) ∧
            (Nat.Prime bb.1 ∧ z ≤ (bb.1 : ℝ)) ∧ bb.1 ≤ aa.1 ∧
            (Nat.Prime cc.1 ∧ z ≤ (cc.1 : ℝ)) ∧ cc.1 ≤ aa.1 ∧
            ((max 1 (cc.2.primeFactors.sup id) : ℕ) : ℝ) < z ∧
            P bb.1 cc.1 cc.2 ∧ L bb.1 cc.1 cc.2 ≤ (aa.1 : ℝ) ∧
            (aa.1 : ℝ) ≤ U bb.1 cc.1 cc.2
        then ArithmeticFunction.moebius cc.2 else 0
  have hcoeff (n : ℕ) : (Q0 n : ℂ) =
      ((∑ ps ∈ siftedPrimeTuples x (4 : Fin 6), ∑ d ∈ n.divisorsAntidiagonal,
        if d.1 = ps.prod then smallPrimeMobius z d.2 else 0 : ℝ) : ℂ) := by
    have hs := congrArg (fun t : ℝ => (t : ℂ))
      (sifted_short_three_prime_named_coefficient_eq x hx1 n)
    simpa only [Complex.ofReal_intCast] using hs.symm
  have hb := hbound x hx N hNL hNU (1 : Fin 2) (1 : Fin 2)
    P L U z M0 nlo nhi hz hlo false q hq r0 hr0 a ha
  dsimp only at hb
  simp only [show (1 : Fin 2) ≠ 0 by decide, ite_false,
    ite_eq_right (show ¬(false : Bool) by decide)] at hb
  dsimp only [Q0] at hcoeff
  simpa only [apply_ite (fun t : ℤ => (t : ℂ)), Int.cast_zero, hcoeff,
    S0, apply_ite (fun t : ℝ => (t : ℂ)), Complex.ofReal_zero] using hb

open Classical in
theorem sifted_short_all_moduli_siegelWalfisz
    (ε T c C A : ℝ) (hε : 0 < ε) (hT : 0 < T) (hc : 0 < c)
    (hC : 0 < C) (hA : 0 < A) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ j : Fin 6, ∀ nlo nhi : ℝ, c * N ≤ nlo →
      ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 →
      ∀ a : ℕ, Nat.Coprime a q →
      let z := x ^ ((9519 : ℝ) / 50000)
      let M0 := x ^ (1 - (1058 : ℝ) / 3125)
      let S0 : ℕ → ℝ := fun n =>
        if (n : ℝ) ≤ M0 then
          ∑ ps ∈ siftedPrimeTuples x j, ∑ d ∈ n.divisorsAntidiagonal,
            if d.1 = ps.prod then smallPrimeMobius z d.2 else 0
        else 0
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
          (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
           then (S0 n : ℂ) else 0)) q a‖ ≤
        K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨K0, X0, hK0, hX0, h0⟩ :=
    sifted_short_empty_all_moduli_siegelWalfisz ε T c C A hε hT hc hC hA
  obtain ⟨K1, X1, hK1, _hX1, h1⟩ :=
    sifted_short_one_prime_all_moduli_siegelWalfisz ε T c C A hε hT hc hC hA
  obtain ⟨K2, X2, hK2, _hX2, h2⟩ :=
    sifted_short_two_prime_all_moduli_siegelWalfisz ε T c C A hε hT hc hC hA
  obtain ⟨K3, X3, hK3, _hX3, h3⟩ :=
    sifted_short_three_prime_all_moduli_siegelWalfisz ε T c C A hε hT hc hC hA
  obtain ⟨K5, X5, hK5, _hX5, h5⟩ :=
    sifted_short_sixth_all_moduli_siegelWalfisz ε T c C A hε hT hc hC hA
  let K := K0 + K1 + K2 + K3 + K5
  let X := max X0 (max X1 (max X2 (max X3 X5)))
  refine ⟨K, X, by dsimp only [K]; positivity, hX0.trans (le_max_left _ _), ?_⟩
  intro x hx N hNL hNU j nlo nhi hlo q hq r0 hr0 a ha z M0 S0
  have hx0 : X0 ≤ x := (le_max_left _ _).trans hx
  have hx1 : X1 ≤ x :=
    (le_max_left X1 _).trans ((le_max_right X0 _).trans hx)
  have hx2 : X2 ≤ x :=
    (le_max_left X2 _).trans
      ((le_max_right X1 _).trans ((le_max_right X0 _).trans hx))
  have hx3 : X3 ≤ x :=
    (le_max_left X3 X5).trans
      ((le_max_right X2 _).trans
        ((le_max_right X1 _).trans ((le_max_right X0 _).trans hx)))
  have hx5 : X5 ≤ x :=
    (le_max_right X3 X5).trans
      ((le_max_right X2 _).trans
        ((le_max_right X1 _).trans ((le_max_right X0 _).trans hx)))
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le (hX0.trans hx0)
  have hN : 0 ≤ N := (Real.rpow_pos_of_pos hxpos ε).le.trans hNL
  have hlog : 0 ≤ Real.log x := by
    have hlog1 := (Real.le_log_iff_exp_le hxpos).mpr (hX0.trans hx0)
    exact zero_le_one.trans hlog1
  have hmono (k : ℝ) (hk : k ≤ K) :
      k * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A ≤
        K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A :=
    div_le_div_of_nonneg_right
      (mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_right hk (Nat.cast_nonneg _)) hN)
      (Real.rpow_nonneg hlog A)
  have hk0 : K0 ≤ K := by dsimp only [K]; linarith
  have hk1 : K1 ≤ K := by dsimp only [K]; linarith
  have hk2 : K2 ≤ K := by dsimp only [K]; linarith
  have hk3 : K3 ≤ K := by dsimp only [K]; linarith
  have hk5 : K5 ≤ K := by dsimp only [K]; linarith
  fin_cases j
  · exact (h0 x hx0 N hNL hNU nlo nhi hlo q hq r0 hr0 a ha).trans (hmono K0 hk0)
  · exact (h1 x hx1 N hNL hNU nlo nhi hlo q hq r0 hr0 a ha).trans (hmono K1 hk1)
  · exact (h2 x hx2 N hNL hNU (0 : Fin 2) nlo nhi hlo q hq r0 hr0 a ha).trans
      (hmono K2 hk2)
  · exact (h2 x hx2 N hNL hNU (1 : Fin 2) nlo nhi hlo q hq r0 hr0 a ha).trans
      (hmono K2 hk2)
  · exact (h3 x hx3 N hNL hNU nlo nhi hlo q hq r0 hr0 a ha).trans (hmono K3 hk3)
  · exact (h5 x hx5 N hNL hNU nlo nhi hlo q hq r0 hr0 a ha).trans (hmono K5 hk5)

open Classical in
theorem sifted_short_weighted_all_moduli_siegelWalfisz
    (ε T c C A D : ℝ) (hε : 0 < ε) (hT : 0 < T) (hc : 0 < c)
    (hC : 0 < C) (hA : 0 < A) (hD : 0 ≤ D) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ j : Fin 6, ∀ nlo nhi : ℝ, c * N ≤ nlo →
      ∀ w : ℕ → ℂ,
        ‖w (Nat.floor (T * N))‖ +
          (∑ n ∈ Finset.Ico 1 (Nat.floor (T * N)), ‖w (n + 1) - w n‖) ≤
            (Real.log x) ^ D →
      ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 → ∀ a : ℕ, Nat.Coprime a q →
      let z := x ^ ((9519 : ℝ) / 50000)
      let M0 := x ^ (1 - (1058 : ℝ) / 3125)
      let S0 : ℕ → ℝ := fun n =>
        if (n : ℝ) ≤ M0 then
          ∑ ps ∈ siftedPrimeTuples x j, ∑ d ∈ n.divisorsAntidiagonal,
            if d.1 = ps.prod then smallPrimeMobius z d.2 else 0
        else 0
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
          (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
           then w n * (S0 n : ℂ) else 0)) q a‖ ≤
        K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨K, X0, hK, hX0, hmain⟩ :=
    sifted_short_all_moduli_siegelWalfisz ε T c C (A + D) hε hT hc hC (by linarith)
  refine ⟨K, X0, hK, hX0, ?_⟩
  intro x hx N hNL hNU j nlo nhi hnlo w hw q hq r0 hr0 a ha z M0 S0
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le (hX0.trans hx)
  have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr (hX0.trans hx)
  have hlog : 0 < Real.log x := zero_lt_one.trans_le hlog1
  have hN : 0 ≤ N := (Real.rpow_pos_of_pos hx0 ε).le.trans hNL
  let NN := Nat.floor (T * N)
  let f : ℕ → ℂ := fun n =>
    if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi then (S0 n : ℂ) else 0
  let E : ℝ := K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ (A + D)
  have hE : 0 ≤ E := by
    dsimp only [E]
    positivity
  have hmask (n : ℕ) :
      (if Nat.Coprime n r0 then f n else 0) =
        if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
        then (S0 n : ℂ) else 0 := by
    by_cases h1 : nlo ≤ (n : ℝ) <;> by_cases h2 : (n : ℝ) ≤ nhi <;>
      by_cases h3 : Nat.Coprime n r0 <;> simp [f, h1, h2, h3]
  have hprefix (k : ℕ) (hk1 : 1 ≤ k) (hkN : k ≤ NN) :
      ‖fullDiscrepancy (∑ n ∈ Finset.Icc 1 k, Finsupp.single n
        (if Nat.Coprime n r0 then f n else 0)) q a‖ ≤ E := by
    have hset : Finset.Icc 1 k = (Finset.Icc 1 NN).filter (fun n => n ≤ k) := by
      ext n
      simp only [Finset.mem_Icc, Finset.mem_filter]
      omega
    have hsource :
        (∑ n ∈ Finset.Icc 1 k, Finsupp.single n
          (if Nat.Coprime n r0 then f n else 0)) =
        ∑ n ∈ Finset.Icc 1 NN, Finsupp.single n
          (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ min nhi (k : ℝ) ∧ Nat.Coprime n r0
           then (S0 n : ℂ) else 0) := by
      rw [hset, Finset.sum_filter]
      apply Finset.sum_congr rfl
      intro n _hn
      rw [hmask]
      by_cases hnk : n ≤ k <;> simp [hnk, Nat.cast_le]
    rw [hsource]
    simpa only [S0, z, M0, NN, E] using
      hmain x hx N hNL hNU j nlo (min nhi (k : ℝ)) hnlo q hq r0 hr0 a ha
  have hparts := norm_fullDiscrepancy_Icc_weighted_le_of_prefix
    1 NN q a r0 f w E hE hprefix
  have hsource :
      (∑ n ∈ Finset.Icc 1 NN, Finsupp.single n
        (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
         then w n * (S0 n : ℂ) else 0)) =
      ∑ n ∈ Finset.Icc 1 NN, Finsupp.single n
        (if Nat.Coprime n r0 then w n * f n else 0) := by
    apply Finset.sum_congr rfl
    intro n _hn
    by_cases h1 : nlo ≤ (n : ℝ) <;> by_cases h2 : (n : ℝ) ≤ nhi <;>
      by_cases h3 : Nat.Coprime n r0 <;> simp [f, h1, h2, h3]
  change ‖fullDiscrepancy (∑ n ∈ Finset.Icc 1 NN, Finsupp.single n
    (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
     then w n * (S0 n : ℂ) else 0)) q a‖ ≤ _
  rw [hsource]
  calc
    _ ≤ E * (‖w NN‖ + ∑ n ∈ Finset.Ico 1 NN, ‖w (n + 1) - w n‖) := hparts
    _ ≤ E * (Real.log x) ^ D := mul_le_mul_of_nonneg_left hw hE
    _ = K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
      dsimp only [E]
      rw [Real.rpow_add hlog, div_mul_eq_div_div,
        div_mul_cancel₀ _ (Real.rpow_pos_of_pos hlog D).ne']

open Classical in
theorem sifted_short_mellin_all_moduli_siegelWalfisz
    (ε T c C A : ℝ) (hε : 0 < ε) (hT : 0 < T) (hc : 0 < c)
    (hC : 0 < C) (hA : 0 < A) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ N : ℝ, x ^ ε ≤ N → N ≤ x ^ C →
      ∀ j : Fin 6, ∀ nlo nhi : ℝ, c * N ≤ nlo → ∀ t : ℝ, 0 ≤ t →
      ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 → ∀ a : ℕ, Nat.Coprime a q →
      let z := x ^ ((9519 : ℝ) / 50000)
      let M0 := x ^ (1 - (1058 : ℝ) / 3125)
      let S0 : ℕ → ℝ := fun n =>
        if (n : ℝ) ≤ M0 then
          ∑ ps ∈ siftedPrimeTuples x j, ∑ d ∈ n.divisorsAntidiagonal,
            if d.1 = ps.prod then smallPrimeMobius z d.2 else 0
        else 0
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc 1 (Nat.floor (T * N)), Finsupp.single n
          (if nlo ≤ (n : ℝ) ∧ (n : ℝ) ≤ nhi ∧ Nat.Coprime n r0
           then (((n : ℝ) ^ (-t) : ℝ) : ℂ) * (S0 n : ℂ) else 0)) q a‖ ≤
        K * ((q * r0).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨K, X0, hK, hX0, hmain⟩ :=
    sifted_short_weighted_all_moduli_siegelWalfisz ε T c C A 0 hε hT hc hC hA le_rfl
  refine ⟨K, X0, hK, hX0, ?_⟩
  intro x hx N hNL hNU j nlo nhi hnlo t ht q hq r0 hr0 a ha
  have hvariation :
      ‖(((Nat.floor (T * N) : ℝ) ^ (-t) : ℝ) : ℂ)‖ +
        (∑ n ∈ Finset.Ico 1 (Nat.floor (T * N)),
          ‖((((n + 1 : ℕ) : ℝ) ^ (-t) : ℝ) : ℂ) - (((n : ℝ) ^ (-t) : ℝ) : ℂ)‖) ≤
          (Real.log x) ^ (0 : ℝ) := by
    simpa only [Real.rpow_zero] using
      mellin_weight_discrete_variation_le_one (Nat.floor (T * N)) t ht
  exact hmain x hx N hNL hNU j nlo nhi hnlo
    (fun n => (((n : ℝ) ^ (-t) : ℝ) : ℂ)) hvariation q hq r0 hr0 a ha

open Classical in
theorem sifted_short_two_raw_norm_le
    (x : ℝ) (hx : 1 < x) (e : Fin 2) (n : ℕ) :
    let j : Fin 6 := if e = 0 then 2 else 3
    ‖((∑ ps ∈ siftedPrimeTuples x j, ∑ d ∈ n.divisorsAntidiagonal,
      if d.1 = ps.prod then smallPrimeMobius (x ^ ((9519 : ℝ) / 50000)) d.2
      else 0 : ℝ) : ℂ)‖ ≤ (n.divisors.card : ℝ) ^ 3 := by
  intro j
  let z := x ^ ((9519 : ℝ) / 50000)
  let H := x ^ ((40481 : ℝ) / 100000)
  let B := x ^ ((59519 : ℝ) / 100000)
  let P : ℕ → ℕ → ℕ → Prop := fun q _r _h =>
    if e = 0 then True else
      Real.logb x (q : ℝ) < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000
  let L : ℕ → ℕ → ℕ → ℝ := fun q _r _h =>
    if e = 0 then (q : ℝ) + 1 else
      max ((q : ℝ) + 1) ((Nat.floor (B / (q : ℝ)) : ℝ) + 1)
  let U : ℕ → ℕ → ℕ → ℝ := fun q _r _h =>
    if e = 0 then
      min ((Nat.ceil H - 1 : ℕ) : ℝ) ((Nat.ceil (H / (q : ℝ)) - 1 : ℕ) : ℝ)
    else ((Nat.ceil H - 1 : ℕ) : ℝ)
  let Q0 : ℤ :=
    ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
      ∑ cc ∈ bb.2.divisorsAntidiagonal,
        if Nat.Prime aa.1 ∧ z ≤ (aa.1 : ℝ) ∧
            (Nat.Prime bb.1 ∧ z ≤ (bb.1 : ℝ)) ∧ bb.1 ≤ aa.1 ∧
            cc.1 = 1 ∧ cc.1 ≤ aa.1 ∧
            ((max 1 (cc.2.primeFactors.sup id) : ℕ) : ℝ) < z ∧
            P bb.1 cc.1 cc.2 ∧ L bb.1 cc.1 cc.2 ≤ (aa.1 : ℝ) ∧
            (aa.1 : ℝ) ≤ U bb.1 cc.1 cc.2
        then ArithmeticFunction.moebius cc.2 else 0
  have hb := harmanA0_named_coefficient_norm_le n (1 : Fin 2) (0 : Fin 2)
    P L U z (n : ℝ) false
  dsimp only at hb
  simp only [le_refl, ite_true] at hb
  change ‖(Q0 : ℂ)‖ ≤ (n.divisors.card : ℝ) ^ 3 at hb
  have hs := congrArg (fun t : ℝ => (t : ℂ))
    (sifted_short_two_prime_named_coefficient_eq x hx e n)
  simp only [Complex.ofReal_intCast] at hs
  rw [← hs] at hb
  exact hb

open Classical in
theorem sifted_short_three_raw_norm_le (x : ℝ) (hx : 1 < x) (n : ℕ) :
    ‖((∑ ps ∈ siftedPrimeTuples x (4 : Fin 6), ∑ d ∈ n.divisorsAntidiagonal,
      if d.1 = ps.prod then smallPrimeMobius (x ^ ((9519 : ℝ) / 50000)) d.2
      else 0 : ℝ) : ℂ)‖ ≤ (n.divisors.card : ℝ) ^ 3 := by
  let z := x ^ ((9519 : ℝ) / 50000)
  let H := x ^ ((40481 : ℝ) / 100000)
  let P : ℕ → ℕ → ℕ → Prop := fun q r _h => r < q ∧
    Real.logb x (r : ℝ) < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000
  let L : ℕ → ℕ → ℕ → ℝ := fun q _r _h => (q : ℝ) + 1
  let U : ℕ → ℕ → ℕ → ℝ := fun q _r _h =>
    min ((Nat.ceil H - 1 : ℕ) : ℝ) ((Nat.ceil (H / (q : ℝ)) - 1 : ℕ) : ℝ)
  let Q0 : ℤ :=
    ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
      ∑ cc ∈ bb.2.divisorsAntidiagonal,
        if Nat.Prime aa.1 ∧ z ≤ (aa.1 : ℝ) ∧
            (Nat.Prime bb.1 ∧ z ≤ (bb.1 : ℝ)) ∧ bb.1 ≤ aa.1 ∧
            (Nat.Prime cc.1 ∧ z ≤ (cc.1 : ℝ)) ∧ cc.1 ≤ aa.1 ∧
            ((max 1 (cc.2.primeFactors.sup id) : ℕ) : ℝ) < z ∧
            P bb.1 cc.1 cc.2 ∧ L bb.1 cc.1 cc.2 ≤ (aa.1 : ℝ) ∧
            (aa.1 : ℝ) ≤ U bb.1 cc.1 cc.2
        then ArithmeticFunction.moebius cc.2 else 0
  have hb := harmanA0_named_coefficient_norm_le n (1 : Fin 2) (1 : Fin 2)
    P L U z (n : ℝ) false
  dsimp only at hb
  simp only [le_refl, show (1 : Fin 2) ≠ 0 by decide,
    Bool.coe_sort_false, ite_false, ite_true] at hb
  change ‖(Q0 : ℂ)‖ ≤ (n.divisors.card : ℝ) ^ 3 at hb
  have hs := congrArg (fun t : ℝ => (t : ℂ))
    (sifted_short_three_prime_named_coefficient_eq x hx n)
  simp only [Complex.ofReal_intCast] at hs
  rw [← hs] at hb
  exact hb

open Classical in
theorem sifted_short_source_bounds (x : ℝ) (hx : 1 < x) (j : Fin 6) (n : ℕ) :
    let z := x ^ ((9519 : ℝ) / 50000)
    let M0 := x ^ (1 - (1058 : ℝ) / 3125)
    let S0 : ℕ → ℝ := fun m =>
      if (m : ℝ) ≤ M0 then
        ∑ ps ∈ siftedPrimeTuples x j, ∑ d ∈ m.divisorsAntidiagonal,
          if d.1 = ps.prod then smallPrimeMobius z d.2 else 0
      else 0
    ‖(S0 n : ℂ)‖ ≤ (n.divisors.card : ℝ) ^ 3 ∧
      S0 0 = 0 ∧ (S0 n ≠ 0 → (n : ℝ) ≤ M0) := by
  intro z M0 S0
  refine ⟨?_, ?_, ?_⟩
  · by_cases hn : (n : ℝ) ≤ M0
    · simp only [S0, ite_eq_left hn]
      fin_cases j
      · exact sifted_short_empty_raw_norm_le x n
      · exact sifted_short_one_raw_norm_le x hx n
      · exact sifted_short_two_raw_norm_le x hx (0 : Fin 2) n
      · exact sifted_short_two_raw_norm_le x hx (1 : Fin 2) n
      · exact sifted_short_three_raw_norm_le x hx n
      · exact sifted_short_sixth_raw_norm_le x hx n
    · simp only [S0, ite_eq_right hn, Complex.ofReal_zero, norm_zero]
      exact pow_nonneg (Nat.cast_nonneg _) 3
  · simp [S0]
  · intro hne
    dsimp only [S0] at hne
    exact (ite_ne_right_iff.mp hne).1

open Classical in
theorem five_prime_closed_box_bv_power_cutoff
    (θ : ℝ) (hθ : θ < 1 / 2) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ L U : Fin 5 → ℝ,
      (∀ i, x ^ (1 / 10 : ℝ) ≤ L i ∧ L i ≤ U i ∧ U i ≤ 2 * L i) →
      x / 32 ≤ (∏ i, L i) → (∏ i, L i) ≤ 2 * x →
      ∀ Q : Finset ℕ, Q ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ Q, Nat.Coprime (a q) q) →
      let P (i : Fin 5) := (Finset.Icc ⌈L i⌉₊ ⌊U i⌋₊).filter Nat.Prime
      (∑ q ∈ Q, ‖fullDiscrepancy
        (∑ p ∈ Fintype.piFinset P, Finsupp.single (∏ i, p i) (1 : ℂ)) q (a q)‖) ≤
        K * x / (Real.log x) ^ A := by
  intro A hA
  obtain ⟨B, K, Xb, hB, hK, hXb, hb⟩ := five_prime_closed_box_bv_uniform_log_saving A hA
  have hsmall := (isLittleO_log_rpow_rpow_atTop B (sub_pos.mpr hθ)).eventuallyLE
  obtain ⟨Xs, hXs⟩ := Filter.eventually_atTop.mp hsmall
  refine ⟨K, max Xb Xs, hK, hXb.trans (le_max_left _ _), ?_⟩
  intro x hx L U hLU hlo hhi Q hQ a ha P
  have hxb : Xb ≤ x := (le_max_left _ _).trans hx
  have hxs : Xs ≤ x := (le_max_right _ _).trans hx
  have hx100 : Real.exp 100 ≤ x := hXb.trans hxb
  have hx0 : 0 < x := (Real.exp_pos 100).trans_le hx100
  have hlog : 0 < Real.log x := by
    have := (Real.le_log_iff_exp_le hx0).mpr hx100
    linarith
  have hLB : 0 < (Real.log x) ^ B := Real.rpow_pos_of_pos hlog B
  have hpow : (Real.log x) ^ B ≤ x ^ ((1 / 2 : ℝ) - θ) := by
    simpa only [Real.norm_of_nonneg hLB.le,
      Real.norm_of_nonneg (Real.rpow_nonneg hx0.le _)] using hXs x hxs
  have hcut : x ^ θ ≤ Real.sqrt x / (Real.log x) ^ B := by
    apply (le_div_iff₀ hLB).mpr
    calc
      _ ≤ x ^ θ * x ^ ((1 / 2 : ℝ) - θ) :=
        mul_le_mul_of_nonneg_left hpow (Real.rpow_nonneg hx0.le θ)
      _ = Real.sqrt x := by
        rw [← Real.rpow_add hx0, add_sub_cancel, Real.sqrt_eq_rpow]
  let F : ℕ →₀ ℂ := ∑ p ∈ Fintype.piFinset P,
    Finsupp.single (∏ i, p i) 1
  let V := Finset.Ioc 0 ⌊Real.sqrt x / (Real.log x) ^ B⌋₊
  let Z (q : ℕ) : ℝ := ⨆ b : (ZMod q)ˣ,
    ‖fullDiscrepancy F q (b : ZMod q).val‖
  have hQV : Q ⊆ V := by
    intro q hq
    have hmem := Finset.mem_Icc.mp (hQ hq)
    exact Finset.mem_Ioc.mpr ⟨hmem.1, hmem.2.trans (Nat.floor_mono hcut)⟩
  have hZnonneg (q : ℕ) (hq : q ∈ V) : 0 ≤ Z q := by
    let _ : NeZero q := ⟨(Finset.mem_Ioc.mp hq).1.ne'⟩
    have hh : ‖fullDiscrepancy F q ((1 : (ZMod q)ˣ) : ZMod q).val‖ ≤ Z q :=
      le_ciSup (f := fun b : (ZMod q)ˣ => ‖fullDiscrepancy F q (b : ZMod q).val‖)
        (Set.finite_range _).bddAbove 1
    exact (norm_nonneg _).trans hh
  have hnorm (q : ℕ) (hq : q ∈ Q) : ‖fullDiscrepancy F q (a q)‖ ≤ Z q := by
    let _ : NeZero q := ⟨Nat.ne_of_gt (show 0 < q from (Finset.mem_Icc.mp (hQ hq)).1)⟩
    have heq : fullDiscrepancy F q
        ((ZMod.unitOfCoprime (a q) (ha q hq) : (ZMod q)ˣ) : ZMod q).val =
          fullDiscrepancy F q (a q) := by
      simp only [fullDiscrepancy, progressionMass, ZMod.coe_unitOfCoprime,
        ZMod.val_natCast, Nat.mod_mod]
    exact heq.symm ▸ le_ciSup
      (f := fun b : (ZMod q)ˣ => ‖fullDiscrepancy F q (b : ZMod q).val‖)
      (Set.finite_range _).bddAbove
      (ZMod.unitOfCoprime (a q) (ha q hq))
  have hbound := hb x hxb L U hLU hlo hhi 1 (by decide)
  have hfilter : F.filter (fun n : ℕ => Nat.Coprime n 1) = F := by
    exact (Finsupp.filter_eq_self_iff _ _).mpr (by intro n hn; simp)
  have hbound' : (∑ q ∈ V, Z q) ≤ K * x / (Real.log x) ^ A := by
    simpa only [F, P, V, Z, hfilter, Nat.divisors_one, Finset.card_singleton,
      Nat.cast_one, mul_one] using hbound
  calc
    _ ≤ ∑ q ∈ Q, Z q := Finset.sum_le_sum hnorm
    _ ≤ ∑ q ∈ V, Z q :=
      Finset.sum_le_sum_of_subset_of_nonneg hQV (fun q hq _ => hZnonneg q hq)
    _ ≤ _ := hbound'

open Classical in
theorem exceptionalPrimeDefect_closed_finsupp_eq_monomial_tuples :
    ∀ᶠ x : ℝ in atTop, ∀ j : Fin 2,
    let P : Finset ℕ :=
      (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((6 : ℝ) / 25)⌋₊).filter Nat.Prime
    let T := Fintype.piFinset (fun _ : Fin 5 => P)
    let C (p : Fin 5 → ℕ) : Prop := ∀ d ∈ minorantMonomialCuts x j,
      if d.lower then
        if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
      else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold
    (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
      Finsupp.single n (exceptionalPrimeDefect x j n : ℂ)) =
      ∑ p ∈ T, Finsupp.single (∏ i, p i) (if C p then (1 : ℂ) else 0) := by
  filter_upwards [exceptionalPrimeDefect_weighted_interval_as_compact_tuple,
    eventually_gt_atTop (1 : ℝ)] with x hx hx1
  intro j P T C
  ext n
  have hw := hx j (fun m : ℕ => if m = n then (1 : ℂ) else 0)
  calc
    _ = ∑ m ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        (if m = n then (1 : ℂ) else 0) * (exceptionalPrimeDefect x j m : ℂ) := by
      simp only [Finsupp.finsetSum_apply, Finsupp.single_apply]
      apply Finset.sum_congr rfl
      intro m hm
      split_ifs <;> simp
    _ = _ := hw
    _ = _ := by
      simp only [Finsupp.finsetSum_apply, Finsupp.single_apply]
      apply Finset.sum_congr rfl
      intro p hp
      have hp0 (i : Fin 5) : 0 < p i :=
        (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).2.pos
      have hc := literal_minorant_monomial_cuts_iff x hx1 j p hp0
      change (_ ↔ C p) at hc
      by_cases hC : C p
      · simp only [ite_eq_left (hc.mpr hC), ite_eq_left hC]
      · simp only [ite_eq_right (fun h => hC (hc.mp h)), ite_eq_right hC, ite_self]

open Classical in
theorem hbBoundary_masked_pair_norm
    (E P : ℕ →₀ ℂ) (x : ℝ) (hxpos : 0 < x) (hlogone : 1 ≤ Real.log x)
    (hE : ∀ n : ℕ, ‖E n‖ ≤ 31 * (n.divisors.card : ℝ) ^ 9 * Real.log (n : ℝ))
    (hP : ∀ n : ℕ, ‖P n‖ ≤
      1024 * (n.divisors.card : ℝ) ^ 19 * (Real.log (n : ℝ)) ^ 2)
    (T : ℕ → Prop) (n m : ℕ) (hn1 : 1 ≤ n) (hm1 : 1 ≤ m) :
    ‖if x ≤ ((n * m : ℕ) : ℝ) ∧ ((n * m : ℕ) : ℝ) ≤ 2 * x
      then (E.filter T) n * P m else 0‖ ≤
        (31 * 1024 * 8 : ℝ) * (n.divisors.card : ℝ) ^ 9 *
          (m.divisors.card : ℝ) ^ 19 * (Real.log x) ^ 3 := by
  have hlognonneg : 0 ≤ Real.log x := zero_le_one.trans hlogone
  have hlogfactor (v : ℕ) (hv : 0 < v) (hvhi : (v : ℝ) ≤ 2 * x) :
      Real.log (v : ℝ) ≤ 2 * Real.log x := by
    calc
      _ ≤ Real.log (2 * x) := Real.log_le_log (by exact_mod_cast hv) hvhi
      _ = Real.log 2 + Real.log x := Real.log_mul (by norm_num) hxpos.ne'
      _ ≤ 2 * Real.log x := by
        have htwo := Real.log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2)
        linarith
  by_cases hproduct : x ≤ ((n * m : ℕ) : ℝ) ∧ ((n * m : ℕ) : ℝ) ≤ 2 * x
  · rw [ite_eq_left hproduct, norm_mul]
    have hnreal : (1 : ℝ) ≤ n := by exact_mod_cast hn1
    have hmreal : (1 : ℝ) ≤ m := by exact_mod_cast hm1
    have hprod : (n : ℝ) * m ≤ 2 * x := by exact_mod_cast hproduct.2
    have hnhi : (n : ℝ) ≤ 2 * x :=
      (le_mul_of_one_le_right (Nat.cast_nonneg n) hmreal).trans hprod
    have hmhi : (m : ℝ) ≤ 2 * x :=
      (le_mul_of_one_le_left (Nat.cast_nonneg m) hnreal).trans hprod
    have hln := hlogfactor n hn1 hnhi
    have hlm := hlogfactor m hm1 hmhi
    have hEn : ‖(E.filter T) n‖ ≤
        31 * (n.divisors.card : ℝ) ^ 9 * Real.log (n : ℝ) := by
      rw [Finsupp.filter_apply]
      split_ifs
      · exact hE n
      · rw [norm_zero]
        exact mul_nonneg (by positivity) (Real.log_natCast_nonneg n)
    calc
      _ ≤ (31 * (n.divisors.card : ℝ) ^ 9 * (2 * Real.log x)) *
          (1024 * (m.divisors.card : ℝ) ^ 19 * (2 * Real.log x) ^ 2) := by
        apply mul_le_mul
        · exact hEn.trans (mul_le_mul_of_nonneg_left hln (by positivity))
        · exact (hP m).trans (mul_le_mul_of_nonneg_left
            (pow_le_pow_left₀ (Real.log_natCast_nonneg m) hlm 2) (by positivity))
        · exact norm_nonneg _
        · positivity
      _ = _ := by ring
  · rw [ite_eq_right hproduct, norm_zero]
    positivity

theorem prime_five_dyadic_log_geometry
    (x : ℝ) (p : Fin 5 → ℕ) (n : ℕ)
    (hx : 1 < x) (hp : ∀ i, (p i).Prime) (hprod : (∏ i, p i) = n)
    (hxn : x ≤ (n : ℝ)) (hnx : (n : ℝ) ≤ 2 * x) :
    (∑ i, Real.logb x (p i : ℝ)) = Real.logb x (n : ℝ) ∧
      1 ≤ ∑ i, Real.logb x (p i : ℝ) ∧
      (∑ i, Real.logb x (p i : ℝ)) ≤ 1 + Real.log 2 / Real.log x := by
  classical
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hp0 (i : Fin 5) : 0 < (p i : ℝ) := Nat.cast_pos.mpr (hp i).pos
  have hn0 : 0 < (n : ℝ) := hx0.trans_le hxn
  have hcast : (∏ i, (p i : ℝ)) = (n : ℝ) := by exact_mod_cast hprod
  have hlog : (∑ i, Real.logb x (p i : ℝ)) = Real.logb x (n : ℝ) := by
    rw [← hcast]
    exact (Real.logb_prod Finset.univ (fun i : Fin 5 => (p i : ℝ))
      (fun i _ => (hp0 i).ne')).symm
  refine ⟨hlog, ?_, ?_⟩
  · rw [hlog]
    calc
      1 = Real.logb x x := (Real.logb_self_eq_one hx).symm
      _ ≤ Real.logb x (n : ℝ) := Real.logb_le_logb_of_le hx hx0 hxn
  · rw [hlog]
    calc
      Real.logb x (n : ℝ) ≤ Real.logb x (2 * x) :=
        Real.logb_le_logb_of_le hx hn0 hnx
      _ = 1 + Real.log 2 / Real.log x := by
        rw [Real.logb_mul (by norm_num : (2 : ℝ) ≠ 0) hx0.ne',
          Real.logb_self_eq_one hx, Real.logb]
        ring

theorem prime_five_reversal_complement_central_or_diagonal
    (x : ℝ) (p : Fin 5 → ℕ) (n : ℕ)
    (hx : 1 < x) (hp : ∀ i, (p i).Prime) (hprod : (∏ i, p i) = n)
    (hxn : x ≤ (n : ℝ)) (hnx : (n : ℝ) ≤ 2 * x)
    (hε : Real.log 2 / Real.log x <
      (59519 : ℝ) / 100000 - 3 * ((9519 : ℝ) / 50000))
    (hlower : ∀ i, (9519 : ℝ) / 50000 ≤ Real.logb x (p i : ℝ))
    (h10 : Real.logb x (p 1 : ℝ) < Real.logb x (p 0 : ℝ))
    (h12 : Real.logb x (p 1 : ℝ) ≤ Real.logb x (p 2 : ℝ))
    (h34 : Real.logb x (p 3 : ℝ) ≤ Real.logb x (p 4 : ℝ))
    (hnot :
      ¬ ((∀ i, (9519 : ℝ) / 50000 ≤ Real.logb x (p i : ℝ) ∧
          Real.logb x (p i : ℝ) ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
        Real.logb x (p 1 : ℝ) < Real.logb x (p 0 : ℝ) ∧
        Real.logb x (p 1 : ℝ) < Real.logb x (p 2 : ℝ) ∧
        Real.logb x (p 0 : ℝ) + Real.logb x (p 2 : ℝ) < (40481 : ℝ) / 100000 ∧
        (59519 : ℝ) / 100000 <
          Real.logb x (p 1 : ℝ) + Real.logb x (p 2 : ℝ) + Real.logb x (p 3 : ℝ) ∧
        Real.logb x (p 3 : ℝ) ≤ Real.logb x (p 4 : ℝ))) :
    (∃ s : Finset (Fin 5), (s.card = 2 ∨ s.card = 3) ∧
      (40481 : ℝ) / 100000 ≤ ∑ i ∈ s, Real.logb x (p i : ℝ) ∧
      (∑ i ∈ s, Real.logb x (p i : ℝ)) ≤ (59519 : ℝ) / 100000) ∨ p 2 = p 1 := by
  classical
  have hgeometry := prime_five_dyadic_log_geometry x p n hx hp hprod hxn hnx
  rcases five_exponent_reversal_complement_central_or_diagonal
    (fun i => Real.logb x (p i : ℝ)) (Real.log 2 / Real.log x)
    hε hlower hgeometry.2.2 h10 h12 h34 hnot with hcentral | hdiag
  · exact Or.inl hcentral
  · right
    have hcast : (p 2 : ℝ) = (p 1 : ℝ) :=
      Real.logb_injOn_pos hx (Set.mem_Ioi.mpr (Nat.cast_pos.mpr (hp 2).pos))
        (Set.mem_Ioi.mpr (Nat.cast_pos.mpr (hp 1).pos)) hdiag
    exact_mod_cast hcast

theorem prime_five_reversal_complement_product_central_or_diagonal
    (x : ℝ) (p : Fin 5 → ℕ) (n : ℕ)
    (hx : 1 < x) (hp : ∀ i, (p i).Prime) (hprod : (∏ i, p i) = n)
    (hxn : x ≤ (n : ℝ)) (hnx : (n : ℝ) ≤ 2 * x)
    (hε : Real.log 2 / Real.log x <
      (59519 : ℝ) / 100000 - 3 * ((9519 : ℝ) / 50000))
    (hlower : ∀ i, (9519 : ℝ) / 50000 ≤ Real.logb x (p i : ℝ))
    (h10 : Real.logb x (p 1 : ℝ) < Real.logb x (p 0 : ℝ))
    (h12 : Real.logb x (p 1 : ℝ) ≤ Real.logb x (p 2 : ℝ))
    (h34 : Real.logb x (p 3 : ℝ) ≤ Real.logb x (p 4 : ℝ))
    (hnot :
      ¬ ((∀ i, (9519 : ℝ) / 50000 ≤ Real.logb x (p i : ℝ) ∧
          Real.logb x (p i : ℝ) ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
        Real.logb x (p 1 : ℝ) < Real.logb x (p 0 : ℝ) ∧
        Real.logb x (p 1 : ℝ) < Real.logb x (p 2 : ℝ) ∧
        Real.logb x (p 0 : ℝ) + Real.logb x (p 2 : ℝ) < (40481 : ℝ) / 100000 ∧
        (59519 : ℝ) / 100000 <
          Real.logb x (p 1 : ℝ) + Real.logb x (p 2 : ℝ) + Real.logb x (p 3 : ℝ) ∧
        Real.logb x (p 3 : ℝ) ≤ Real.logb x (p 4 : ℝ))) :
    (∃ s : Finset (Fin 5), (s.card = 2 ∨ s.card = 3) ∧
      x ^ ((40481 : ℝ) / 100000) ≤ ((∏ i ∈ s, p i : ℕ) : ℝ) ∧
      ((∏ i ∈ s, p i : ℕ) : ℝ) ≤ x ^ ((59519 : ℝ) / 100000)) ∨ p 2 = p 1 := by
  classical
  rcases prime_five_reversal_complement_central_or_diagonal x p n hx hp hprod
    hxn hnx hε hlower h10 h12 h34 hnot with hcentral | hdiag
  · obtain ⟨s, hcard, hslo, hshi⟩ := hcentral
    have hp0 (i : Fin 5) : 0 < (p i : ℝ) := Nat.cast_pos.mpr (hp i).pos
    have hP0 : 0 < ∏ i ∈ s, (p i : ℝ) := Finset.prod_pos (fun i _ => hp0 i)
    have hlog : Real.logb x (∏ i ∈ s, (p i : ℝ)) =
        ∑ i ∈ s, Real.logb x (p i : ℝ) :=
      Real.logb_prod s (fun i : Fin 5 => (p i : ℝ)) (fun i _ => (hp0 i).ne')
    have hPlo : x ^ ((40481 : ℝ) / 100000) ≤ ∏ i ∈ s, (p i : ℝ) :=
      (Real.le_logb_iff_rpow_le hx hP0).mp (by rw [hlog]; exact hslo)
    have hPhi : (∏ i ∈ s, (p i : ℝ)) ≤ x ^ ((59519 : ℝ) / 100000) :=
      (Real.logb_le_iff_le_rpow hx hP0).mp (by rw [hlog]; exact hshi)
    exact Or.inl ⟨s, hcard, by simpa only [Nat.cast_prod] using hPlo,
      by simpa only [Nat.cast_prod] using hPhi⟩
  · exact Or.inr hdiag

theorem eventually_five_prime_log_error_small :
    ∀ᶠ x : ℝ in atTop, 1 < x ∧ 0 ≤ Real.log 2 / Real.log x ∧
      Real.log 2 / Real.log x <
        (59519 : ℝ) / 100000 - 3 * ((9519 : ℝ) / 50000) := by
  have hlim : Tendsto (fun x : ℝ => Real.log 2 / Real.log x) atTop (nhds 0) :=
    Real.tendsto_log_atTop.const_div_atTop (Real.log 2)
  have hsmall : ∀ᶠ x : ℝ in atTop,
      Real.log 2 / Real.log x <
        (59519 : ℝ) / 100000 - 3 * ((9519 : ℝ) / 50000) :=
    hlim.eventually (gt_mem_nhds (by norm_num))
  filter_upwards [Filter.eventually_gt_atTop (1 : ℝ), hsmall] with x hx hbound
  exact ⟨hx, div_nonneg (Real.log_nonneg (by norm_num)) (Real.log_pos hx).le, hbound⟩

open Classical in
theorem sourceU3_sub_exceptionalPrimeDefect_one_eventually_positive_central :
    ∃ X : ℝ, 3 ≤ X ∧ ∀ x : ℝ, X ≤ x → ∀ n : ℕ,
      x ≤ (n : ℝ) → (n : ℝ) ≤ 2 * x →
      let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
      let U (p : Fin 5 → ℕ) : Prop :=
        [p 0, p 1, p 2] ∈ siftedPrimeTuples x (5 : Fin 6) ∧
          x ^ ((9519 : ℝ) / 50000) ≤ (p 3 : ℝ) ∧ p 3 ≤ p 4
      let E (p : Fin 5 → ℕ) : Prop :=
        (∀ i, (9519 : ℝ) / 50000 ≤ α (p i) ∧
          α (p i) ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
        α (p 1) < α (p 0) ∧ α (p 1) < α (p 2) ∧
        α (p 0) + α (p 2) < (40481 : ℝ) / 100000 ∧
        (59519 : ℝ) / 100000 < α (p 1) + α (p 2) + α (p 3) ∧
        α (p 3) ≤ α (p 4)
      let P := (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
        (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime
      let C := (Fintype.piFinset (fun _ : Fin 5 => P)).filter
        (fun p => (∏ i, p i) = n ∧ U p ∧ ¬ E p)
      sourceU3 x n - exceptionalPrimeDefect x (1 : Fin 2) n = ∑ _p ∈ C, (1 : ℝ) ∧
        0 ≤ sourceU3 x n - exceptionalPrimeDefect x (1 : Fin 2) n ∧
        ∀ p ∈ C,
          (∃ s : Finset (Fin 5), (s.card = 2 ∨ s.card = 3) ∧
            x ^ ((40481 : ℝ) / 100000) ≤ ((∏ i ∈ s, p i : ℕ) : ℝ) ∧
            ((∏ i ∈ s, p i : ℕ) : ℝ) ≤ x ^ ((59519 : ℝ) / 100000)) ∨
            p 2 = p 1 := by
  have hcompact : ∀ᶠ x : ℝ in Filter.atTop,
      2 ≤ x ^ ((6 : ℝ) / 25 - (1 - 4 * ((9519 : ℝ) / 50000))) :=
    (tendsto_rpow_atTop (by norm_num :
      (0 : ℝ) < 6 / 25 - (1 - 4 * ((9519 : ℝ) / 50000)))).eventually_ge_atTop 2
  obtain ⟨X, hX⟩ :=
    (eventually_five_prime_log_error_small.and hcompact).exists_forall_of_atTop
  refine ⟨max 3 X, le_max_left _ _, ?_⟩
  intro x hx n hnlo hnhi α U E P C
  obtain ⟨⟨hx1, _hεnonneg, hε⟩, hband⟩ := hX x ((le_max_right _ _).trans hx)
  have hnpos : 0 < n := Nat.cast_pos.mp ((zero_lt_one.trans hx1).trans_le hnlo)
  let Q := Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n)
  have hprime (p : Fin 5 → ℕ) (hp : p ∈ Q) (i : Fin 5) : (p i).Prime :=
    Nat.prime_of_mem_primesLE ((Fintype.mem_piFinset.mp hp) i)
  have hUdata (p : Fin 5 → ℕ) (hp : ∀ i, (p i).Prime) (hu : U p) :
      (∀ i, (9519 : ℝ) / 50000 ≤ α (p i)) ∧
        α (p 1) < α (p 0) ∧ α (p 1) ≤ α (p 2) ∧ α (p 3) ≤ α (p 4) := by
    obtain ⟨hmem, h3, h34⟩ := hu
    have hm := (mem_siftedPrimeTuples_iff x hx1 (5 : Fin 6) [p 0, p 1, p 2]).mp hmem
    dsimp only at hm
    obtain ⟨_hp0, _hp1, _hp2, h1, h10, _h0a, h12, _hsum, _h0ζ⟩ := hm
    have h3log : (9519 : ℝ) / 50000 ≤ α (p 3) :=
      (Real.le_logb_iff_rpow_le hx1 (Nat.cast_pos.mpr (hp 3).pos)).mpr h3
    have h34log : α (p 3) ≤ α (p 4) := Real.logb_le_logb_of_le hx1
      (Nat.cast_pos.mpr (hp 3).pos) (Nat.cast_le.mpr h34)
    refine ⟨?_, h10, h12, h34log⟩
    intro i
    fin_cases i
    · exact h1.trans h10.le
    · exact h1
    · exact h1.trans h12
    · exact h3log
    · exact h3log.trans h34log
  have hsubset (p : Fin 5 → ℕ) (hp : p ∈ Q) (he : E p) : U p := by
    obtain ⟨hbounds, h10, h12, h02, _h123, h34⟩ := he
    have h0a : α (p 0) < (40481 : ℝ) / 100000 :=
      (hbounds 0).2.trans_lt (by norm_num)
    have h0ζ : α (p 0) < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000 :=
      (hbounds 0).2.trans_lt (by norm_num)
    have hsum : α (p 1) + α (p 2) < (40481 : ℝ) / 100000 := by
      linarith only [h10, h02]
    refine ⟨?_, ?_, ?_⟩
    · apply (mem_siftedPrimeTuples_iff x hx1 (5 : Fin 6) [p 0, p 1, p 2]).mpr
      exact ⟨hprime p hp 0, hprime p hp 1, hprime p hp 2,
        (hbounds 1).1, h10, h0a, h12.le, hsum, h0ζ⟩
    · exact (Real.le_logb_iff_rpow_le hx1 (Nat.cast_pos.mpr (hprime p hp 3).pos)).mp
        (hbounds 3).1
    · exact Nat.cast_le.mp ((Real.logb_le_logb hx1
        (Nat.cast_pos.mpr (hprime p hp 3).pos)
        (Nat.cast_pos.mpr (hprime p hp 4).pos)).mp h34)
  have hC : C = Q.filter (fun p => (∏ i, p i) = n ∧ U p ∧ ¬ E p) := by
    ext p
    simp only [C, Finset.mem_filter]
    constructor
    · rintro ⟨hp, hprod, hu, he⟩
      refine ⟨?_, hprod, hu, he⟩
      apply Fintype.mem_piFinset.mpr
      intro i
      refine Nat.mem_primesLE.mpr ⟨?_,
        (Finset.mem_filter.mp ((Fintype.mem_piFinset.mp hp) i)).2⟩
      apply Nat.le_of_dvd hnpos
      rw [← hprod]
      exact Finset.dvd_prod_of_mem p (Finset.mem_univ i)
    · rintro ⟨hp, hprod, hu, he⟩
      refine ⟨Fintype.mem_piFinset.mpr ?_, hprod, hu, he⟩
      apply prime_five_mem_compact_band x hx1 hband p (hprime p hp)
        (hUdata p (hprime p hp) hu).1
      rw [hprod]
      exact hnhi
  have hUsum : sourceU3 x n =
      ∑ p ∈ Q, if (∏ i, p i) = n ∧ U p then (1 : ℝ) else 0 :=
    sourceU3_eq_five_prime_sum x hx1 n
  have hEsum : exceptionalPrimeDefect x (1 : Fin 2) n =
      ∑ p ∈ Q, if (∏ i, p i) = n ∧ E p then (1 : ℝ) else 0 :=
    exceptionalPrimeDefect_one_swapped_triple x n
  have hid : sourceU3 x n - exceptionalPrimeDefect x (1 : Fin 2) n =
      ∑ _p ∈ C, (1 : ℝ) := by
    rw [hUsum, hEsum, ← Finset.sum_sub_distrib, hC, Finset.sum_filter]
    apply Finset.sum_congr rfl
    intro p hp
    by_cases hprod : (∏ i, p i) = n
    · by_cases he : E p
      · have hu := hsubset p hp he
        simp [hprod, hu, he]
      · by_cases hu : U p
        · simp [hprod, hu, he]
        · simp [hprod, hu, he]
    · simp [hprod]
  refine ⟨hid, ?_, ?_⟩
  · rw [hid]
    exact Finset.sum_nonneg (fun _ _ => zero_le_one)
  · intro p hp
    rw [hC] at hp
    obtain ⟨hpQ, hprod, hu, he⟩ := Finset.mem_filter.mp hp
    obtain ⟨hlower, h10, h12, h34⟩ := hUdata p (hprime p hpQ) hu
    exact prime_five_reversal_complement_product_central_or_diagonal x p n hx1
      (hprime p hpQ) hprod hnlo hnhi hε hlower h10 h12 h34 he

theorem primeIntervalBoxAlgebra_eq_tuple_sum {k : ℕ}
    (L U : Fin k → ℝ) (s : Finset (Fin k)) :
    primeIntervalBoxAlgebra L U s =
      ∑ p ∈ Fintype.piFinset (fun i : Fin k =>
        if i ∈ s then (Finset.Icc ⌈L i⌉₊ ⌊U i⌋₊).filter Nat.Prime else {1}),
        MonoidAlgebra.single (∏ i : Fin k, p i) (1 : ℂ) := by
  classical
  let P : Fin k → Finset ℕ := fun i =>
    if i ∈ s then (Finset.Icc ⌈L i⌉₊ ⌊U i⌋₊).filter Nat.Prime else {1}
  have hpad (i : Fin k) :
      (∑ p ∈ P i, MonoidAlgebra.single p (1 : ℂ) : MonoidAlgebra ℂ ℕ) =
        if i ∈ s then
          ∑ p ∈ (Finset.Icc ⌈L i⌉₊ ⌊U i⌋₊).filter Nat.Prime,
            MonoidAlgebra.single p (1 : ℂ)
        else 1 := by
    by_cases hi : i ∈ s
    · simp only [P, ite_eq_left hi]
    · simp only [P, ite_eq_right hi, Finset.sum_singleton, MonoidAlgebra.one_def]
  calc
    primeIntervalBoxAlgebra L U s =
        ∏ i : Fin k, ∑ p ∈ P i, MonoidAlgebra.single p (1 : ℂ) := by
      simp only [hpad, Finset.prod_ite_mem_eq, primeIntervalBoxAlgebra]
    _ = ∑ p ∈ Fintype.piFinset P,
        ∏ i : Fin k, MonoidAlgebra.single (p i) (1 : ℂ) :=
      Finset.prod_univ_sum P (fun _ p => MonoidAlgebra.single p (1 : ℂ))
    _ = _ := by
      apply Finset.sum_congr rfl
      intro p _
      rw [MonoidAlgebra.prod_single, Finset.prod_const_one]

theorem primeIntervalBoxAlgebra_univ_eq_tuple_sum {k : ℕ} (L U : Fin k → ℝ) :
    primeIntervalBoxAlgebra L U Finset.univ =
      ∑ p ∈ Fintype.piFinset
        (fun i : Fin k => (Finset.Icc ⌈L i⌉₊ ⌊U i⌋₊).filter Nat.Prime),
        MonoidAlgebra.single (∏ i : Fin k, p i) (1 : ℂ) := by
  simpa only [Finset.mem_univ, ↓reduceIte] using
    primeIntervalBoxAlgebra_eq_tuple_sum L U Finset.univ

theorem primeIntervalBoxAlgebra_partition {k : ℕ}
    (L U : Fin k → ℝ) (s : Finset (Fin k)) :
    finiteConvolution (primeIntervalBoxAlgebra L U sᶜ).coeff
        (primeIntervalBoxAlgebra L U s).coeff =
      (primeIntervalBoxAlgebra L U Finset.univ).coeff := by
  classical
  simp only [finiteConvolution, MonoidAlgebra.ofCoeff_coeff, primeIntervalBoxAlgebra,
    Finset.prod_compl_mul_prod]

theorem primeIntervalBoxAlgebra_support_bounds {k : ℕ}
    (Y L U : Fin k → ℝ) (hY : ∀ i, 1 ≤ Y i)
    (hcuts : ∀ i, Y i ≤ L i ∧ U i ≤ 2 * Y i)
    (s : Finset (Fin k)) (n : ℕ)
    (hn : n ∈ (primeIntervalBoxAlgebra L U s).coeff.support) :
    (∏ i ∈ s, Y i) ≤ (n : ℝ) ∧
      (n : ℝ) ≤ (2 : ℝ) ^ k * ∏ i ∈ s, Y i := by
  classical
  let P : Fin k → Finset ℕ := fun i =>
    if i ∈ s then (Finset.Icc ⌈L i⌉₊ ⌊U i⌋₊).filter Nat.Prime else {1}
  have hP (i : Fin k) (p : ℕ) (hp : p ∈ P i) : 0 < p := by
    by_cases hi : i ∈ s
    · have hm : p ∈ (Finset.Icc ⌈L i⌉₊ ⌊U i⌋₊).filter Nat.Prime := by
        simpa only [P, ite_eq_left hi] using hp
      exact (Finset.mem_filter.mp hm).2.pos
    · have he : p = 1 := by
        simpa only [P, ite_eq_right hi, Finset.mem_singleton] using hp
      omega
  have hcoeff : (primeIntervalBoxAlgebra L U s).coeff =
      ∑ p ∈ Fintype.piFinset P, Finsupp.single (∏ i : Fin k, p i) (1 : ℂ) := by
    simpa only [MonoidAlgebra.coeff_sum, MonoidAlgebra.coeff_single] using
      congrArg (fun a : MonoidAlgebra ℂ ℕ => a.coeff)
        (primeIntervalBoxAlgebra_eq_tuple_sum L U s)
  rw [hcoeff] at hn
  obtain ⟨p, hp, hpn⟩ :=
    (finite_positive_tuple_coefficient_support_and_bound P hP).1 n hn
  have hpcoord (i : Fin k) (hi : i ∈ s) :
      Y i ≤ (p i : ℝ) ∧ (p i : ℝ) ≤ 2 * Y i := by
    have hm : p i ∈ (Finset.Icc ⌈L i⌉₊ ⌊U i⌋₊).filter Nat.Prime := by
      simpa only [P, ite_eq_left hi] using Fintype.mem_piFinset.mp hp i
    obtain ⟨hlo, hhi⟩ := Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1
    have hl : L i ≤ (p i : ℝ) := (Nat.le_ceil (L i)).trans (Nat.cast_le.mpr hlo)
    have hu : (p i : ℝ) ≤ U i :=
      (Nat.le_floor_iff' (Finset.mem_filter.mp hm).2.ne_zero).mp hhi
    exact ⟨(hcuts i).1.trans hl, hu.trans (hcuts i).2⟩
  have hnreal : (n : ℝ) = ∏ i ∈ s, (p i : ℝ) := by
    rw [← hpn, Nat.cast_prod]
    symm
    apply Finset.prod_subset (Finset.subset_univ s)
    intro i _hi his
    have he : p i = 1 := by
      simpa only [P, ite_eq_right his, Finset.mem_singleton] using
        Fintype.mem_piFinset.mp hp i
    simp only [he, Nat.cast_one]
  rw [hnreal]
  refine ⟨Finset.prod_le_prod (fun i _ => zero_le_one.trans (hY i))
    (fun i hi => (hpcoord i hi).1), ?_⟩
  have hcard : s.card ≤ k := by simpa only [Fintype.card_fin] using s.card_le_univ
  calc
    (∏ i ∈ s, (p i : ℝ)) ≤ ∏ i ∈ s, 2 * Y i :=
      Finset.prod_le_prod (fun i _ => Nat.cast_nonneg (p i))
        (fun i hi => (hpcoord i hi).2)
    _ = (2 : ℝ) ^ s.card * ∏ i ∈ s, Y i := by
      rw [Finset.prod_mul_distrib, Finset.prod_const]
    _ ≤ (2 : ℝ) ^ k * ∏ i ∈ s, Y i :=
      mul_le_mul_of_nonneg_right
        (pow_le_pow_right₀ (by norm_num : (1 : ℝ) ≤ 2) hcard)
        (Finset.prod_nonneg (fun i _ => zero_le_one.trans (hY i)))

theorem primeIntervalBoxAlgebra_coeff_norm_le {k : ℕ}
    (L U : Fin k → ℝ) (s : Finset (Fin k)) (n : ℕ) :
    ‖(primeIntervalBoxAlgebra L U s).coeff n‖ ≤ (n.divisors.card : ℝ) ^ k := by
  classical
  let P : Fin k → Finset ℕ := fun i =>
    if i ∈ s then (Finset.Icc ⌈L i⌉₊ ⌊U i⌋₊).filter Nat.Prime else {1}
  have hP (i : Fin k) (p : ℕ) (hp : p ∈ P i) : 0 < p := by
    by_cases hi : i ∈ s
    · have hm : p ∈ (Finset.Icc ⌈L i⌉₊ ⌊U i⌋₊).filter Nat.Prime := by
        simpa only [P, ite_eq_left hi] using hp
      exact (Finset.mem_filter.mp hm).2.pos
    · have he : p = 1 := by
        simpa only [P, ite_eq_right hi, Finset.mem_singleton] using hp
      omega
  have hcoeff : (primeIntervalBoxAlgebra L U s).coeff =
      ∑ p ∈ Fintype.piFinset P, Finsupp.single (∏ i : Fin k, p i) (1 : ℂ) := by
    simpa only [MonoidAlgebra.coeff_sum, MonoidAlgebra.coeff_single] using
      congrArg (fun a : MonoidAlgebra ℂ ℕ => a.coeff)
        (primeIntervalBoxAlgebra_eq_tuple_sum L U s)
  rw [hcoeff]
  exact (finite_positive_tuple_coefficient_support_and_bound P hP).2 n

theorem primeIntervalBoxAlgebra_mass_le {k : ℕ}
    (Y L U : Fin k → ℝ) (hY : ∀ i, 1 ≤ Y i)
    (hcuts : ∀ i, Y i ≤ L i ∧ U i ≤ 2 * Y i)
    (s : Finset (Fin k)) :
    (∑ n ∈ (primeIntervalBoxAlgebra L U s).coeff.support,
      ‖(primeIntervalBoxAlgebra L U s).coeff n‖) ≤
        (3 : ℝ) ^ k * ∏ i ∈ s, Y i := by
  classical
  let P : Fin k → Finset ℕ := fun i =>
    if i ∈ s then (Finset.Icc ⌈L i⌉₊ ⌊U i⌋₊).filter Nat.Prime else {1}
  have hcoeff : (primeIntervalBoxAlgebra L U s).coeff =
      ∑ p ∈ Fintype.piFinset P, Finsupp.single (∏ i : Fin k, p i) (1 : ℂ) := by
    simpa only [MonoidAlgebra.coeff_sum, MonoidAlgebra.coeff_single] using
      congrArg (fun a : MonoidAlgebra ℂ ℕ => a.coeff)
        (primeIntervalBoxAlgebra_eq_tuple_sum L U s)
  have hmass_tuple {α : Type} (S : Finset α) (f : α → ℕ) :
      let F : ℕ →₀ ℂ := ∑ a ∈ S, Finsupp.single (f a) (1 : ℂ)
      ∑ n ∈ F.support, ‖F n‖ ≤ (S.card : ℝ) := by
    classical
    intro F
    have hvalue (n : ℕ) : F n = ((S.filter fun a => f a = n).card : ℂ) := by
      simp only [F, Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_boole]
    simp_rw [hvalue, Complex.norm_natCast]
    rw [← Nat.cast_sum, Finset.sum_card_fiberwise_eq_card_filter]
    exact Nat.cast_le.mpr (Finset.card_filter_le S (fun a => f a ∈ F.support))
  have hPcard (i : Fin k) (hi : i ∈ s) : ((P i).card : ℝ) ≤ 3 * Y i := by
    have hsub : P i ⊆ Finset.range (⌊2 * Y i⌋₊ + 1) := by
      intro p hp
      have hm : p ∈ (Finset.Icc ⌈L i⌉₊ ⌊U i⌋₊).filter Nat.Prime := by
        simpa only [P, ite_eq_left hi] using hp
      apply Finset.mem_range.mpr
      have hu := (Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1).2
      have hf := Nat.floor_mono (hcuts i).2
      omega
    have hc : ((P i).card : ℝ) ≤ (⌊2 * Y i⌋₊ : ℝ) + 1 := by
      have hcNat := Finset.card_le_card hsub
      rw [Finset.card_range] at hcNat
      exact_mod_cast hcNat
    have hf : (⌊2 * Y i⌋₊ : ℝ) ≤ 2 * Y i :=
      Nat.floor_le (mul_nonneg (by norm_num) (zero_le_one.trans (hY i)))
    linarith only [hc, hf, hY i]
  have hcardprod : ((Fintype.piFinset P).card : ℝ) =
      ∏ i ∈ s, ((P i).card : ℝ) := by
    rw [Fintype.card_piFinset, Nat.cast_prod]
    symm
    apply Finset.prod_subset (Finset.subset_univ s)
    intro i _hi his
    simp only [P, ite_eq_right his, Finset.card_singleton, Nat.cast_one]
  have hcard : s.card ≤ k := by simpa only [Fintype.card_fin] using s.card_le_univ
  rw [hcoeff]
  calc
    (∑ n ∈ (∑ p ∈ Fintype.piFinset P,
        Finsupp.single (∏ i : Fin k, p i) (1 : ℂ)).support,
        ‖(∑ p ∈ Fintype.piFinset P,
          Finsupp.single (∏ i : Fin k, p i) (1 : ℂ)) n‖) ≤
        ((Fintype.piFinset P).card : ℝ) :=
      hmass_tuple (Fintype.piFinset P) (fun p => ∏ i : Fin k, p i)
    _ = ∏ i ∈ s, ((P i).card : ℝ) := hcardprod
    _ ≤ ∏ i ∈ s, 3 * Y i :=
      Finset.prod_le_prod (fun i _ => Nat.cast_nonneg (P i).card) hPcard
    _ = (3 : ℝ) ^ s.card * ∏ i ∈ s, Y i := by
      rw [Finset.prod_mul_distrib, Finset.prod_const]
    _ ≤ (3 : ℝ) ^ k * ∏ i ∈ s, Y i :=
      mul_le_mul_of_nonneg_right
        (pow_le_pow_right₀ (by norm_num : (1 : ℝ) ≤ 3) hcard)
        (Finset.prod_nonneg (fun i _ => zero_le_one.trans (hY i)))

open Classical in
theorem prime_closed_interval_siegelWalfisz_of_exponent
    (η : ℝ) (hη : 0 < η) (A : ℝ) (hA : 0 < A) :
    ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ N L U : ℝ,
      x ^ η ≤ N → N ≤ x ^ (2 : ℝ) →
      N ≤ L → U ≤ 2 * N →
      ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
        ‖fullDiscrepancy
          ((∑ n ∈ Finset.Icc ⌈L⌉₊ ⌊U⌋₊,
            Finsupp.single n (if Nat.Prime n then (1 : ℂ) else 0)).filter
              (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
          K * ((q * r).divisors.card : ℝ) * N / (Real.log x) ^ A := by
  obtain ⟨K, Xs, hK, _hXs, hSW⟩ :=
    largest_prime_windows_all_moduli_siegelWalfisz
      0 1 η 1 3 2 0 1 A hη (by norm_num) (by norm_num) (by norm_num) hA
  refine ⟨K, max Xs (Real.exp (max 100 ((η⁻¹) ^ 2))), hK,
    (Real.exp_monotone (le_max_left _ _)).trans (le_max_right _ _), ?_⟩
  intro x hx N L U hNL hNU hL hU q r a hq hr ha
  have hxs : Xs ≤ x := (le_max_left _ _).trans hx
  have hxscale : Real.exp (max 100 ((η⁻¹) ^ 2)) ≤ x := (le_max_right _ _).trans hx
  have hx100 : Real.exp 100 ≤ x :=
    (Real.exp_monotone (le_max_left _ _)).trans hxscale
  have hx0 : 0 < x := (Real.exp_pos 100).trans_le hx100
  have hx1 : 1 ≤ x := (Real.one_le_exp_iff.mpr (by norm_num)).trans hx100
  have hlogscale : max 100 ((η⁻¹) ^ 2) ≤ Real.log x :=
    (Real.le_log_iff_exp_le hx0).mpr hxscale
  have hlog100 : 100 ≤ Real.log x := (le_max_left _ _).trans hlogscale
  have hlog0 : 0 ≤ Real.log x := by linarith
  have hN1 : 1 ≤ N := (Real.one_le_rpow hx1 hη.le).trans hNL
  have hN0 : 0 < N := zero_lt_one.trans_le hN1
  let V := Finset.Icc ⌈L⌉₊ ⌊U⌋₊
  let β : ℕ →₀ ℂ := ∑ n ∈ V,
    Finsupp.single n (if Nat.Prime n then 1 else 0)
  have hβ (n : ℕ) : β n = if n ∈ V ∧ Nat.Prime n then 1 else 0 := by
    simp only [β, Finsupp.finsetSum_apply, Finsupp.single_apply]
    by_cases hn : n ∈ V <;> simp [Finset.sum_ite_eq', hn]
  have hsupport (n : ℕ) (hn : n ∈ β.support) :
      N ≤ (n : ℝ) ∧ (n : ℝ) ≤ 3 * N := by
    have hmem : n ∈ V ∧ Nat.Prime n := by
      by_contra h
      exact (Finsupp.mem_support_iff.mp hn) (by rw [hβ, ite_eq_right h])
    have hlo := (Nat.le_ceil L).trans (Nat.cast_le.mpr (Finset.mem_Icc.mp hmem.1).1)
    have hhi : (n : ℝ) ≤ U := (Nat.le_floor_iff' hmem.2.ne_zero).mp
      (Finset.mem_Icc.mp hmem.1).2
    exact ⟨hL.trans hlo, hhi.trans (hU.trans (by linarith))⟩
  have hcoeff (n : ℕ) : ‖β n‖ ≤ 1 := by rw [hβ]; split_ifs <;> simp
  have hroot : Real.exp (Real.sqrt (Real.log x)) ≤ N := by
    have hsInv : η⁻¹ ≤ Real.sqrt (Real.log x) := by
      calc
        η⁻¹ = Real.sqrt ((η⁻¹) ^ 2) :=
          (Real.sqrt_sq (inv_nonneg.mpr hη.le)).symm
        _ ≤ Real.sqrt (Real.log x) :=
          Real.sqrt_le_sqrt ((le_max_right _ _).trans hlogscale)
    have hηs : 1 ≤ η * Real.sqrt (Real.log x) := by
      calc
        1 = η * η⁻¹ := (mul_inv_cancel₀ hη.ne').symm
        _ ≤ η * Real.sqrt (Real.log x) :=
          mul_le_mul_of_nonneg_left hsInv hη.le
    have hs : Real.sqrt (Real.log x) ≤ Real.log x * η := by
      calc
        Real.sqrt (Real.log x) = 1 * Real.sqrt (Real.log x) := (one_mul _).symm
        _ ≤ (η * Real.sqrt (Real.log x)) * Real.sqrt (Real.log x) :=
          mul_le_mul_of_nonneg_right hηs (Real.sqrt_nonneg _)
        _ = Real.log x * η := by
          rw [mul_assoc, ← pow_two, Real.sq_sqrt hlog0]
          exact mul_comm _ _
    calc
      _ ≤ Real.exp (Real.log x * η) := Real.exp_monotone hs
      _ = x ^ η := (Real.rpow_def_of_pos hx0 _).symm
      _ ≤ N := hNL
  have hXupper : (⌈2 * N⌉₊ : ℝ) ≤ 3 * N := by
    have hceil := Nat.ceil_lt_add_one (by positivity : 0 ≤ 2 * N)
    linarith
  have hcap : ⌊U⌋₊ ≤ ⌈2 * N⌉₊ := by
    simpa only [Nat.floor_natCast] using
      Nat.floor_mono (hU.trans (Nat.le_ceil (2 * N)))
  have hsource := hSW x hxs N hNL hNU ({()} : Finset Unit)
    (fun _ => 1) (fun _ => (1 : ℂ)) (fun _ => ⌈L⌉₊)
    (fun _ => ⌊U⌋₊) (fun _ => ⌈2 * N⌉₊)
    (by simp) (by
      intro i hi
      exact hroot.trans ((by linarith : N ≤ 2 * N).trans (Nat.le_ceil (2 * N))))
    (by simpa using hXupper) (by simpa using hcap) (by simp)
  have hsource' := hsource
    (by simpa only [Finset.sum_singleton, one_mul, β, V] using hsupport)
    (by
      intro n hn
      simpa only [Finset.sum_singleton, one_mul, Real.rpow_zero]
        using hcoeff n) q hq r hr a ha
  have hfilter : β.filter (fun n : ℕ => Nat.Coprime n r) =
      ∑ n ∈ V, Finsupp.single n
        (if Nat.Prime n ∧ Nat.Coprime n r then (1 : ℂ) else 0) := by
    rw [Finsupp.filter_sum]
    apply Finset.sum_congr rfl
    intro n hn
    ext m
    simp only [Finsupp.filter_apply, Finsupp.single_apply]
    by_cases hnm : n = m
    · subst m
      by_cases hc : Nat.Coprime n r <;> by_cases hp : Nat.Prime n <;> simp [hc, hp]
    · simp only [hnm, ite_false, ite_self]
  simpa only [Finset.sum_singleton, one_mul, ← hfilter, β, V] using hsource'

open Classical in
theorem prime_interval_box_all_moduli_siegelWalfisz
    (k : ℕ) (η : ℝ) (hη : 0 < η) (A : ℝ) (hA : 0 < A) :
    ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y L U : Fin k → ℝ, ∀ s : Finset (Fin k),
        s.Nonempty →
        (∀ i, x ^ η ≤ Y i ∧ Y i ≤ x ^ (2 : ℝ)) →
        (∀ i, Y i ≤ L i ∧ U i ≤ 2 * Y i) →
        ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
          ‖fullDiscrepancy
            ((primeIntervalBoxAlgebra L U s).coeff.filter
              (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
            K * ((q * r).divisors.card : ℝ) *
              (∏ i ∈ s, Y i) / (Real.log x) ^ A := by
  obtain ⟨K, X, hK, hX, hprime⟩ :=
    prime_closed_interval_siegelWalfisz_of_exponent η hη A hA
  refine ⟨(3 : ℝ) ^ k * K, X, mul_pos (by positivity) hK, hX, ?_⟩
  intro x hx Y L U s hs hscale hcuts q r a hq hr ha
  let : NeZero q := ⟨hq.ne'⟩
  obtain ⟨j, hj⟩ := hs
  have hx100 : Real.exp 100 ≤ x := hX.trans hx
  have hx1 : 1 ≤ x := (Real.one_le_exp_iff.mpr (by norm_num)).trans hx100
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hlog0 : 0 < Real.log x := by
    have := (Real.le_log_iff_exp_le hx0).mpr hx100
    linarith
  have hY (i : Fin k) : 1 ≤ Y i :=
    (Real.one_le_rpow hx1 hη.le).trans (hscale i).1
  let F (i : Fin k) : MonoidAlgebra ℂ ℕ :=
    ∑ p ∈ (Finset.Icc ⌈L i⌉₊ ⌊U i⌋₊).filter Nat.Prime,
      MonoidAlgebra.single p (1 : ℂ)
  let α : ℕ →₀ ℂ := (primeIntervalBoxAlgebra L U (s.erase j)).coeff
  let β : ℕ →₀ ℂ :=
    ∑ n ∈ Finset.Icc ⌈L j⌉₊ ⌊U j⌋₊,
      Finsupp.single n (if Nat.Prime n then (1 : ℂ) else 0)
  have hβ : (F j).coeff = β := by
    dsimp only [F, β]
    rw [MonoidAlgebra.coeff_sum, Finset.sum_filter]
    apply Finset.sum_congr rfl
    intro p hp
    by_cases hprime : Nat.Prime p <;> simp [hprime]
  have hprod : primeIntervalBoxAlgebra L U s =
      primeIntervalBoxAlgebra L U (s.erase j) * F j := by
    simpa only [primeIntervalBoxAlgebra, F] using
      (Finset.prod_erase_mul s F hj).symm
  have hconv : (primeIntervalBoxAlgebra L U s).coeff =
      finiteConvolution α β := by
    rw [hprod]
    simp only [finiteConvolution, α, ← hβ, MonoidAlgebra.ofCoeff_coeff]
  let αr := α.filter (fun n : ℕ => Nat.Coprime n r)
  let βr := β.filter (fun n : ℕ => Nat.Coprime n r)
  let C : ℝ := K * ((q * r).divisors.card : ℝ) * Y j / (Real.log x) ^ A
  have hC : 0 ≤ C := by
    dsimp only [C]
    exact div_nonneg
      (mul_nonneg (mul_nonneg hK.le (Nat.cast_nonneg _))
        (zero_le_one.trans (hY j)))
      (Real.rpow_nonneg hlog0.le A)
  have hsingle (u : (ZMod q)ˣ) :
      ‖fullDiscrepancy βr q (u : ZMod q).val‖ ≤ C :=
    hprime x hx (Y j) (L j) (U j) (hscale j).1 (hscale j).2
      (hcuts j).1 (hcuts j).2 q r (u : ZMod q).val hq hr
      (ZMod.val_coe_unit_coprime u)
  have hmass :
      (∑ m ∈ αr.support with Nat.Coprime m q, ‖αr m‖) ≤
        (3 : ℝ) ^ k * ∏ i ∈ s.erase j, Y i := by
    calc
      _ = ∑ m ∈ αr.support with Nat.Coprime m q, ‖α m‖ := by
        apply Finset.sum_congr rfl
        intro m hm
        have hmr : Nat.Coprime m r :=
          (Finset.mem_filter.mp (Finset.mem_filter.mp hm).1).2
        change ‖α.filter (fun n : ℕ => Nat.Coprime n r) m‖ = ‖α m‖
        rw [Finsupp.filter_apply, ite_eq_left hmr]
      _ ≤ ∑ m ∈ α.support, ‖α m‖ := by
        apply Finset.sum_le_sum_of_subset_of_nonneg
        · intro m hm
          exact (Finset.mem_filter.mp (Finset.mem_filter.mp hm).1).1
        · intro m hm hnot
          exact norm_nonneg _
      _ ≤ (3 : ℝ) ^ k * ∏ i ∈ s.erase j, Y i :=
        primeIntervalBoxAlgebra_mass_le Y L U hY hcuts (s.erase j)
  rw [hconv, finiteConvolution_filter_coprime]
  change ‖fullDiscrepancy (finiteConvolution αr βr) q a‖ ≤ _
  rw [typeZero_fullDiscrepancy_convolution q αr βr a ha]
  calc
    _ ≤ ∑ m ∈ αr.support with Nat.Coprime m q, ‖αr m‖ * C := by
      apply norm_sum_le_of_le
      intro m hm
      have hmq := (Finset.mem_filter.mp hm).2
      let u : (ZMod q)ˣ :=
        ZMod.unitOfCoprime a ha * (ZMod.unitOfCoprime m hmq)⁻¹
      simpa only [u, Units.val_mul, ← ZMod.inv_coe_unit,
        ZMod.coe_unitOfCoprime] using
        norm_mul_le_of_le (le_refl ‖αr m‖) (hsingle u)
    _ = C * ∑ m ∈ αr.support with Nat.Coprime m q, ‖αr m‖ := by
      rw [← Finset.sum_mul, mul_comm]
    _ ≤ C * ((3 : ℝ) ^ k * ∏ i ∈ s.erase j, Y i) :=
      mul_le_mul_of_nonneg_left hmass hC
    _ = ((3 : ℝ) ^ k * K) * ((q * r).divisors.card : ℝ) *
        (∏ i ∈ s, Y i) / (Real.log x) ^ A := by
      rw [← Finset.mul_prod_erase s Y hj]
      dsimp only [C]
      ring

open Classical in
theorem central_prime_box_distribution_backend
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : ℕ) («ω» δ σ : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hσ : 0 < σ)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1))
    {ι : Type*} (M N : ℝ → ι → ℝ) (α β : ℝ → ι → ℕ →₀ ℂ)
    (c C W X₀ : ℝ) (k s : ℕ)
    (hc : 0 < c) (hC : 1 ≤ C) (hW : 0 ≤ W) (hX₀ : Real.exp 1 ≤ X₀)
    (hscale : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι,
      x / C ≤ M x i * N x i ∧ M x i * N x i ≤ C * x ∧
      x ^ (1 / 2 - σ) ≤ N x i ∧ N x i ≤ x ^ (1 / 2 : ℝ))
    (hsupport : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι,
      (∀ n ∈ (α x i).support,
        c * M x i ≤ (n : ℝ) ∧ (n : ℝ) ≤ C * M x i) ∧
      (∀ n ∈ (β x i).support,
        c * N x i ≤ (n : ℝ) ∧ (n : ℝ) ≤ C * N x i))
    (hcoeff : ∀ x : ℝ, X₀ ≤ x → ∀ i : ι, ∀ n : ℕ,
      ‖α x i n‖ ≤ W * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ k ∧
      ‖β x i n‖ ≤ W * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ k)
    (hSW : ∀ A : ℝ, 0 < A →
      ∃ KSW XSW : ℝ, 0 < KSW ∧ X₀ ≤ XSW ∧
        ∀ x : ℝ, XSW ≤ x → ∀ i : ι,
        ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
          ‖fullDiscrepancy
              ((β x i).filter (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
            KSW * ((q * r).divisors.card : ℝ) ^ s * N x i /
              (Real.log x) ^ A) :
    ∀ A : ℝ, 0 < A →
      ∃ K X : ℝ, 0 < K ∧ X₀ ≤ X ∧
        ∀ x : ℝ, X ≤ x → ∀ i : ι,
        ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
        ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
          (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
              q ∣ (∏ p ∈ I, p) ∧
                Nonempty (DenseDivisibilityWitness
                  ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩
                  j q)),
            ‖fullDiscrepancy (finiteConvolution (α x i) (β x i)) q a‖) ≤
              K * x / (Real.log x) ^ A := by
  rcases hsource with ⟨rfl, hI, hII⟩ | ⟨rfl, hI, hII⟩ | ⟨rfl, hI, hII, hIII⟩
  · exact sourceTypeI_II_lowerOrder_dense_uniform_log_saving 1 «ω» δ σ
      hω hδ hσ (Or.inl ⟨rfl, hI⟩) hII M N α β c C W X₀ k s
      hc hC hW hX₀ hscale hsupport hcoeff hSW
  · exact sourceTypeI_II_lowerOrder_dense_uniform_log_saving 2 «ω» δ σ
      hω hδ hσ (Or.inr ⟨rfl, hI⟩) hII M N α β c C W X₀ k s
      hc hC hW hX₀ hscale hsupport hcoeff hSW
  · simpa only [tripleSourceModuli] using
      sourceTypeI_II_triply_dense_uniform_log_saving_of_deligne
        hDeligne «ω» δ σ hω hδ hσ hI hII hIII M N α β c C W X₀ k s
        hc hC hW hX₀ hscale hsupport hcoeff hSW

open Classical in
theorem central_prime_box_typeII_coherent_log_saving
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j k : ℕ) («ω» δ σ η C : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hσ : 0 < σ) (hη : 0 < η) (hC : 1 ≤ C)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1)) :
    ∀ A : ℝ, 0 < A →
      ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
        ∀ x : ℝ, X ≤ x → ∀ Y L U : Fin k → ℝ, ∀ S : Finset (Fin k),
          S.Nonempty → S ≠ Finset.univ →
          (∀ i, x ^ η ≤ Y i ∧ Y i ≤ x ^ (2 : ℝ)) →
          (∀ i, Y i ≤ L i ∧ U i ≤ 2 * Y i) →
          x / C ≤ ∏ i, Y i → (∏ i, Y i) ≤ C * x →
          x ^ (1 / 2 - σ) ≤ ∏ i ∈ S, Y i →
          (∏ i ∈ S, Y i) ≤ x ^ (1 / 2 : ℝ) →
          ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
          ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
            (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
                q ∣ (∏ p ∈ I, p) ∧
                  Nonempty (DenseDivisibilityWitness
                    ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩
                    j q)),
              ‖fullDiscrepancy (primeIntervalBoxAlgebra L U Finset.univ).coeff q a‖) ≤
                K * x / (Real.log x) ^ A := by
  let ι := (Fin k → ℝ) × (Fin k → ℝ) × (Fin k → ℝ) × Finset (Fin k)
  let good (x : ℝ) (b : ι) : Prop :=
    b.2.2.2.Nonempty ∧ b.2.2.2 ≠ Finset.univ ∧
      (∀ i, x ^ η ≤ b.1 i ∧ b.1 i ≤ x ^ (2 : ℝ)) ∧
      (∀ i, b.1 i ≤ b.2.1 i ∧ b.2.2.1 i ≤ 2 * b.1 i) ∧
      x / C ≤ ∏ i, b.1 i ∧ (∏ i, b.1 i) ≤ C * x ∧
      x ^ (1 / 2 - σ) ≤ ∏ i ∈ b.2.2.2, b.1 i ∧
      (∏ i ∈ b.2.2.2, b.1 i) ≤ x ^ (1 / 2 : ℝ)
  let C₀ : ℝ := max C ((2 : ℝ) ^ k)
  let X₀ : ℝ := Real.exp 100
  let M (x : ℝ) (b : ι) : ℝ :=
    if good x b then ∏ i ∈ b.2.2.2ᶜ, b.1 i else x ^ (1 / 2 : ℝ)
  let N (x : ℝ) (b : ι) : ℝ :=
    if good x b then ∏ i ∈ b.2.2.2, b.1 i else x ^ (1 / 2 : ℝ)
  let α (x : ℝ) (b : ι) : ℕ →₀ ℂ :=
    if good x b then (primeIntervalBoxAlgebra b.2.1 b.2.2.1 b.2.2.2ᶜ).coeff else 0
  let β (x : ℝ) (b : ι) : ℕ →₀ ℂ :=
    if good x b then (primeIntervalBoxAlgebra b.2.1 b.2.2.1 b.2.2.2).coeff else 0
  have hC₀ : 1 ≤ C₀ := hC.trans (le_max_left _ _)
  have hCC₀ : C ≤ C₀ := le_max_left _ _
  have htwoC₀ : (2 : ℝ) ^ k ≤ C₀ := le_max_right _ _
  have hX₀ : Real.exp 1 ≤ X₀ := Real.exp_le_exp.mpr (by norm_num)
  have hxOne (x : ℝ) (hx : X₀ ≤ x) : 1 ≤ x :=
    (Real.one_le_exp_iff.mpr (by norm_num : (0 : ℝ) ≤ 100)).trans hx
  have hxPos (x : ℝ) (hx : X₀ ≤ x) : 0 < x :=
    zero_lt_one.trans_le (hxOne x hx)
  have hlog (x : ℝ) (hx : X₀ ≤ x) : 1 ≤ Real.log x := by
    have h := (Real.le_log_iff_exp_le (hxPos x hx)).mpr hx
    linarith
  have hYOne (x : ℝ) (hx : X₀ ≤ x) (b : ι) (hg : good x b) :
      ∀ i, 1 ≤ b.1 i := fun i =>
    (Real.one_le_rpow (hxOne x hx) hη.le).trans (hg.2.2.1 i).1
  have hscale : ∀ x : ℝ, X₀ ≤ x → ∀ b : ι,
      x / C₀ ≤ M x b * N x b ∧ M x b * N x b ≤ C₀ * x ∧
      x ^ (1 / 2 - σ) ≤ N x b ∧ N x b ≤ x ^ (1 / 2 : ℝ) := by
    intro x hx b
    by_cases hg : good x b
    · simp only [M, N, ite_eq_left hg]
      rw [Finset.prod_compl_mul_prod]
      exact ⟨(div_le_div_of_nonneg_left (hxPos x hx).le
          (zero_lt_one.trans_le hC) hCC₀).trans hg.2.2.2.2.1,
        hg.2.2.2.2.2.1.trans (mul_le_mul_of_nonneg_right hCC₀ (hxPos x hx).le),
        hg.2.2.2.2.2.2⟩
    · simp only [M, N, ite_eq_right hg]
      have hsq : x ^ (1 / 2 : ℝ) * x ^ (1 / 2 : ℝ) = x := by
        rw [← Real.rpow_add (hxPos x hx)]
        norm_num
      rw [hsq]
      exact ⟨div_le_self (hxPos x hx).le hC₀,
        le_mul_of_one_le_left (hxPos x hx).le hC₀,
        Real.rpow_le_rpow_of_exponent_le (hxOne x hx) (by linarith), le_rfl⟩
  have hsupport : ∀ x : ℝ, X₀ ≤ x → ∀ b : ι,
      (∀ n ∈ (α x b).support, 1 * M x b ≤ (n : ℝ) ∧ (n : ℝ) ≤ C₀ * M x b) ∧
      (∀ n ∈ (β x b).support, 1 * N x b ≤ (n : ℝ) ∧ (n : ℝ) ≤ C₀ * N x b) := by
    intro x hx b
    by_cases hg : good x b
    · simp only [α, β, M, N, ite_eq_left hg, one_mul]
      have hbound (s : Finset (Fin k)) (n : ℕ)
          (hn : n ∈ (primeIntervalBoxAlgebra b.2.1 b.2.2.1 s).coeff.support) :
          (∏ i ∈ s, b.1 i) ≤ (n : ℝ) ∧ (n : ℝ) ≤ C₀ * ∏ i ∈ s, b.1 i := by
        obtain ⟨hlo, hhi⟩ := primeIntervalBoxAlgebra_support_bounds
          b.1 b.2.1 b.2.2.1 (hYOne x hx b hg) hg.2.2.2.1 s n hn
        exact ⟨hlo, hhi.trans (mul_le_mul_of_nonneg_right htwoC₀
          (Finset.prod_nonneg fun i _ => zero_le_one.trans (hYOne x hx b hg i)))⟩
      exact ⟨hbound _, hbound _⟩
    · constructor
      · intro n hn
        simp only [α, ite_eq_right hg, Finsupp.support_zero, Finset.notMem_empty] at hn
      · intro n hn
        simp only [β, ite_eq_right hg, Finsupp.support_zero, Finset.notMem_empty] at hn
  have hcoeff : ∀ x : ℝ, X₀ ≤ x → ∀ b : ι, ∀ n : ℕ,
      ‖α x b n‖ ≤ 1 * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ k ∧
      ‖β x b n‖ ≤ 1 * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ k := by
    intro x hx b n
    have hnorm (s : Finset (Fin k)) :
        ‖(primeIntervalBoxAlgebra b.2.1 b.2.2.1 s).coeff n‖ ≤
          1 * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ k := by
      have hpow : 1 ≤ (Real.log x) ^ k := one_le_pow₀ (hlog x hx)
      exact (primeIntervalBoxAlgebra_coeff_norm_le b.2.1 b.2.2.1 s n).trans
        (by simpa only [one_mul] using
          le_mul_of_one_le_right (pow_nonneg (Nat.cast_nonneg _) _) hpow)
    by_cases hg : good x b
    · simpa only [α, β, ite_eq_left hg] using And.intro (hnorm b.2.2.2ᶜ) (hnorm b.2.2.2)
    · simp only [α, β, ite_eq_right hg, Finsupp.zero_apply, norm_zero, one_mul, and_self]
      exact mul_nonneg (pow_nonneg (Nat.cast_nonneg _) _)
        (pow_nonneg (zero_le_one.trans (hlog x hx)) _)
  have hSW : ∀ A : ℝ, 0 < A →
      ∃ KSW XSW : ℝ, 0 < KSW ∧ X₀ ≤ XSW ∧
        ∀ x : ℝ, XSW ≤ x → ∀ b : ι,
        ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
          ‖fullDiscrepancy ((β x b).filter (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
            KSW * ((q * r).divisors.card : ℝ) ^ 1 * N x b /
              (Real.log x) ^ A := by
    intro A hA
    obtain ⟨KSW, XSW, hKSW, hXSW, hsw⟩ :=
      prime_interval_box_all_moduli_siegelWalfisz k η hη A hA
    refine ⟨KSW, XSW, hKSW, hXSW, ?_⟩
    intro x hx b q r a hq hr ha
    by_cases hg : good x b
    · simpa only [β, N, ite_eq_left hg, pow_one] using
        hsw x hx b.1 b.2.1 b.2.2.1 b.2.2.2 hg.1 hg.2.2.1 hg.2.2.2.1 q r a hq hr ha
    · simp only [β, N, ite_eq_right hg, Finsupp.filter_zero, fullDiscrepancy,
        progressionMass, reducedMass, Finsupp.support_zero, Finset.sum_empty,
        zero_div, sub_self, norm_zero]
      exact div_nonneg
        (mul_nonneg (mul_nonneg hKSW.le (pow_nonneg (Nat.cast_nonneg _) _))
          (Real.rpow_nonneg (hxPos x (hXSW.trans hx)).le _))
        (Real.rpow_nonneg (zero_le_one.trans (hlog x (hXSW.trans hx))) _)
  intro A hA
  obtain ⟨K, X, hK, hX, hdist⟩ :=
    central_prime_box_distribution_backend hDeligne j «ω» δ σ hω hδ hσ hsource
      M N α β 1 C₀ 1 X₀ k 1 (by norm_num) hC₀ (by norm_num) hX₀
      hscale hsupport hcoeff hSW A hA
  refine ⟨K, X, hK, hX, ?_⟩
  intro x hx Y L U S hS hSproper hY hcuts hprodLo hprodHi hNlo hNhi I hI a ha
  let b : ι := (Y, L, U, S)
  have hg : good x b := ⟨hS, hSproper, hY, hcuts, hprodLo, hprodHi, hNlo, hNhi⟩
  have hd := hdist x hx b I hI a ha
  simpa only [α, β, ite_eq_left hg, b, primeIntervalBoxAlgebra_partition] using hd

open Classical in
theorem sum_divisor_weight_inv_totient_le_log
    (Q J : ℕ) :
    (∑ q ∈ Finset.Icc 1 Q,
      (q.divisors.card : ℝ) ^ J / (q.totient : ℝ)) ≤
        (1 + Real.log (Q : ℝ)) ^ (2 ^ (J + 1)) := by
  calc
    _ ≤ ∑ q ∈ Finset.Icc 1 Q,
        (q.divisors.card : ℝ) ^ (J + 1) / (q : ℝ) := by
      apply Finset.sum_le_sum
      intro q hq
      have hq0 : 0 < (q : ℝ) := Nat.cast_pos.mpr (Finset.mem_Icc.mp hq).1
      calc
        _ = ((q.divisors.card : ℝ) ^ J / (q : ℝ)) *
            ((q : ℝ) / (q.totient : ℝ)) := by field_simp
        _ ≤ ((q.divisors.card : ℝ) ^ J / (q : ℝ)) *
            (q.divisors.card : ℝ) :=
          mul_le_mul_of_nonneg_left
            (div_totient_le_card_divisors q) (by positivity)
        _ = _ := by rw [pow_succ]; ring
    _ ≤ ∑ q ∈ Finset.Icc 1 Q,
        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (2 ^ (J + 1))) q : ℝ) /
          (q : ℝ) := by
      apply Finset.sum_le_sum
      intro q hq
      apply div_le_div_of_nonneg_right _ (Nat.cast_nonneg _)
      exact_mod_cast card_divisors_pow_le_zeta_pow (J + 1) q
        (Finset.mem_Icc.mp hq).1
    _ ≤ (harmonic Q : ℝ) ^ (2 ^ (J + 1)) :=
      sum_zeta_pow_div_le_harmonic_pow _ _
    _ ≤ _ := pow_le_pow_left₀ (by unfold harmonic; positivity)
      (harmonic_le_one_add_log Q) _

open Classical in
theorem harman_literal_box_typeII_coherent_log_saving
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : ℕ) («ω» δ σ C : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hσ : 0 < σ) (hC : 4 ≤ C)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1)) :
    ∀ A : ℝ, 0 < A →
      ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
        ∀ x : ℝ, X ≤ x → ∀ M N : ℝ, 0 < M → 0 < N →
        x / C ≤ M * N → M * N ≤ C * x →
        x ^ (1 / 2 - σ) ≤ min M N / 2 → min M N / 2 ≤ x ^ (1 / 2 : ℝ) →
        M ≤ x ^ (2 : ℝ) → N ≤ x ^ (2 : ℝ) →
        ∀ jA : Fin 3, ∀ jB : Fin 2, ∀ bA bB : Bool,
        ∀ P : ℕ → ℕ → Prop, ∀ L U : ℕ → ℕ → ℝ,
        ∀ z H fLo fHi loA hiA slo shi Zlo Zhi Lsd Usd loB hiB : ℝ,
        0 < z → 1 < H → 0 < Zlo → 0 < Zhi →
        M ≤ loA → hiA ≤ 2 * M → N ≤ loB → hiB ≤ 2 * N →
        let A0 : ℕ → ℤ := fun n =>
          if jA = 0 then
            if (1 < n ∧ ((max 1 (n.primeFactors.sup id) : ℕ) : ℝ) < z ∧
                ((n / n.minFac : ℕ) : ℝ) < H ∧ H ≤ (n : ℝ)) ∧
                fLo ≤ (n.minFac : ℝ) ∧ (n.minFac : ℝ) ≤ fHi
            then (if bA then |ArithmeticFunction.moebius n| else ArithmeticFunction.moebius n)
            else 0
          else
            ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
              if (if jA = 1 then aa.1 = 1 else
                    Nat.Prime aa.1 ∧ z ≤ (aa.1 : ℝ) ∧ aa.1 ≤ bb.1) ∧
                  Nat.Prime bb.1 ∧ z ≤ (bb.1 : ℝ) ∧ 1 < bb.2 ∧
                  ((max 1 (bb.2.primeFactors.sup id) : ℕ) : ℝ) < z ∧
                  (P aa.1 bb.2 ∧ fLo ≤ (bb.2.minFac : ℝ) ∧
                    (bb.2.minFac : ℝ) ≤ fHi) ∧
                  L aa.1 bb.2 ≤ (bb.1 : ℝ) ∧ (bb.1 : ℝ) ≤ U aa.1 bb.2 ∧
                  ((aa.1 * bb.1 : ℕ) : ℝ) < H ∧
                  ((n / bb.2.minFac : ℕ) : ℝ) < H ∧ H ≤ (n : ℝ)
              then (if bA then |ArithmeticFunction.moebius bb.2|
                    else ArithmeticFunction.moebius bb.2) else 0
        let B0 : ℕ → ℤ := fun n =>
          ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
            if (if jB = 0 then aa.1 = 1 else Nat.Prime aa.1) ∧
                slo ≤ (aa.1 : ℝ) ∧ (aa.1 : ℝ) ≤ shi ∧
                Zlo ≤ ((max 1 (bb.1.primeFactors.sup id) : ℕ) : ℝ) ∧
                ((max 1 (bb.1.primeFactors.sup id) : ℕ) : ℝ) < Zhi ∧
                Lsd ≤ ((aa.1 * bb.1 : ℕ) : ℝ) ∧ ((aa.1 * bb.1 : ℕ) : ℝ) ≤ Usd
            then (if bB then |ArithmeticFunction.moebius bb.1|
                  else ArithmeticFunction.moebius bb.1) else 0
        let α : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc 1 ⌊2 * M⌋₊,
          Finsupp.single n (if loA ≤ (n : ℝ) ∧ (n : ℝ) ≤ hiA then (A0 n : ℂ) else 0)
        let β : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc 1 ⌊2 * N⌋₊,
          Finsupp.single n (if loB ≤ (n : ℝ) ∧ (n : ℝ) ≤ hiB then (B0 n : ℂ) else 0)
        ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
        ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
          (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
              q ∣ (∏ p ∈ I, p) ∧
                Nonempty (DenseDivisibilityWitness
                  ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩
                  j q)),
            ‖fullDiscrepancy (finiteConvolution α β) q a‖) ≤
              K * x / (Real.log x) ^ A := by
  let η : ℝ := 1 / 2 - σ
  have hη : 0 < η := by
    rcases hsource with h | h | h
    · dsimp only [η]
      linarith [h.2.1]
    · dsimp only [η]
      linarith [h.2.1]
    · dsimp only [η]
      linarith [h.2.2.1]
  let ι := (Fin 16 → ℝ) × Fin 3 × Fin 2 × Bool × Bool ×
    (ℕ → ℕ → Prop) × (ℕ → ℕ → ℝ) × (ℕ → ℕ → ℝ)
  let rawA (d : ι) (n : ℕ) : ℤ :=
    if d.2.1 = 0 then
      if (1 < n ∧ ((max 1 (n.primeFactors.sup id) : ℕ) : ℝ) < d.1 2 ∧
          ((n / n.minFac : ℕ) : ℝ) < d.1 3 ∧ d.1 3 ≤ (n : ℝ)) ∧
          d.1 4 ≤ (n.minFac : ℝ) ∧ (n.minFac : ℝ) ≤ d.1 5
      then (if d.2.2.2.1 then |ArithmeticFunction.moebius n| else ArithmeticFunction.moebius n)
      else 0
    else
      ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
        if (if d.2.1 = 1 then aa.1 = 1 else
              Nat.Prime aa.1 ∧ d.1 2 ≤ (aa.1 : ℝ) ∧ aa.1 ≤ bb.1) ∧
            Nat.Prime bb.1 ∧ d.1 2 ≤ (bb.1 : ℝ) ∧ 1 < bb.2 ∧
            ((max 1 (bb.2.primeFactors.sup id) : ℕ) : ℝ) < d.1 2 ∧
            (d.2.2.2.2.2.1 aa.1 bb.2 ∧ d.1 4 ≤ (bb.2.minFac : ℝ) ∧
              (bb.2.minFac : ℝ) ≤ d.1 5) ∧
            d.2.2.2.2.2.2.1 aa.1 bb.2 ≤ (bb.1 : ℝ) ∧
            (bb.1 : ℝ) ≤ d.2.2.2.2.2.2.2 aa.1 bb.2 ∧
            ((aa.1 * bb.1 : ℕ) : ℝ) < d.1 3 ∧
            ((n / bb.2.minFac : ℕ) : ℝ) < d.1 3 ∧ d.1 3 ≤ (n : ℝ)
        then (if d.2.2.2.1 then |ArithmeticFunction.moebius bb.2|
              else ArithmeticFunction.moebius bb.2) else 0
  let rawB (d : ι) (n : ℕ) : ℤ :=
    ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
      if (if d.2.2.1 = 0 then aa.1 = 1 else Nat.Prime aa.1) ∧
          d.1 8 ≤ (aa.1 : ℝ) ∧ (aa.1 : ℝ) ≤ d.1 9 ∧
          d.1 10 ≤ ((max 1 (bb.1.primeFactors.sup id) : ℕ) : ℝ) ∧
          ((max 1 (bb.1.primeFactors.sup id) : ℕ) : ℝ) < d.1 11 ∧
          d.1 12 ≤ ((aa.1 * bb.1 : ℕ) : ℝ) ∧ ((aa.1 * bb.1 : ℕ) : ℝ) ≤ d.1 13
      then (if d.2.2.2.2.1 then |ArithmeticFunction.moebius bb.1|
            else ArithmeticFunction.moebius bb.1) else 0
  let sample (T lo hi : ℝ) (f : ℕ → ℤ) : ℕ →₀ ℂ :=
    ∑ n ∈ Finset.Icc 1 ⌊2 * T⌋₊,
      Finsupp.single n (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi then (f n : ℂ) else 0)
  let arow (d : ι) := sample (d.1 0) (d.1 6) (d.1 7) (rawA d)
  let brow (d : ι) := sample (d.1 1) (d.1 14) (d.1 15) (rawB d)
  let good (x : ℝ) (d : ι) : Prop :=
    0 < d.1 0 ∧ 0 < d.1 1 ∧
    x / C ≤ d.1 0 * d.1 1 ∧ d.1 0 * d.1 1 ≤ C * x ∧
    x ^ (1 / 2 - σ) ≤ min (d.1 0) (d.1 1) / 2 ∧
    min (d.1 0) (d.1 1) / 2 ≤ x ^ (1 / 2 : ℝ) ∧
    d.1 0 ≤ x ^ (2 : ℝ) ∧ d.1 1 ≤ x ^ (2 : ℝ) ∧
    0 < d.1 2 ∧ 1 < d.1 3 ∧ 0 < d.1 10 ∧ 0 < d.1 11 ∧
    d.1 0 ≤ d.1 6 ∧ d.1 7 ≤ 2 * d.1 0 ∧
    d.1 1 ≤ d.1 14 ∧ d.1 15 ≤ 2 * d.1 1
  let C₀ : ℝ := max C 4
  let X₀ : ℝ := Real.exp 100
  let Mformal (x : ℝ) (d : ι) : ℝ :=
    if good x d then 2 * max (d.1 0) (d.1 1) else x ^ (1 / 2 : ℝ)
  let Nformal (x : ℝ) (d : ι) : ℝ :=
    if good x d then min (d.1 0) (d.1 1) / 2 else x ^ (1 / 2 : ℝ)
  let α (x : ℝ) (d : ι) : ℕ →₀ ℂ :=
    if good x d then if d.1 0 ≤ d.1 1 then brow d else arow d else 0
  let β (x : ℝ) (d : ι) : ℕ →₀ ℂ :=
    if good x d then if d.1 0 ≤ d.1 1 then arow d else brow d else 0
  have hC₀four : 4 ≤ C₀ := le_max_right _ _
  have hC₀ : 1 ≤ C₀ := by linarith
  have hCpos : 0 < C := by linarith
  have hX₀ : Real.exp 1 ≤ X₀ := Real.exp_le_exp.mpr (by norm_num)
  have hxOne (x : ℝ) (hx : X₀ ≤ x) : 1 ≤ x :=
    (Real.one_le_exp_iff.mpr (by norm_num : (0 : ℝ) ≤ 100)).trans hx
  have hxPos (x : ℝ) (hx : X₀ ≤ x) : 0 < x :=
    zero_lt_one.trans_le (hxOne x hx)
  have hlog (x : ℝ) (hx : X₀ ≤ x) : 1 ≤ Real.log x := by
    have h := (Real.le_log_iff_exp_le (hxPos x hx)).mpr hx
    linarith
  have hsampleValue (T lo hi : ℝ) (f : ℕ → ℤ) (n : ℕ) :
      sample T lo hi f n =
        if n ∈ Finset.Icc 1 ⌊2 * T⌋₊ then
          if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi then (f n : ℂ) else 0
        else 0 := by
    simp only [sample, Finsupp.finsetSum_apply, Finsupp.single_apply,
      Finset.sum_ite_eq']
  have hsampleFilter (T lo hi : ℝ) (f : ℕ → ℤ) (r : ℕ) :
      (sample T lo hi f).filter (fun n : ℕ => Nat.Coprime n r) =
        ∑ n ∈ Finset.Icc 1 ⌊2 * T⌋₊, Finsupp.single n
          (if lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi ∧ Nat.Coprime n r then (f n : ℂ) else 0) := by
    dsimp only [sample]
    rw [Finsupp.filter_sum]
    apply Finset.sum_congr rfl
    intro n _hn
    ext m
    simp only [Finsupp.filter_apply, Finsupp.single_apply]
    by_cases hnm : n = m
    · subst m
      by_cases hlo : lo ≤ (n : ℝ) <;> by_cases hhi : (n : ℝ) ≤ hi <;>
        by_cases hcop : Nat.Coprime n r <;> simp [hlo, hhi, hcop]
    · simp only [hnm, ite_false, ite_self]
  have hsampleSupport (T lo hi : ℝ) (f : ℕ → ℤ) (n : ℕ)
      (hn : n ∈ (sample T lo hi f).support) : lo ≤ (n : ℝ) ∧ (n : ℝ) ≤ hi := by
    have hne := Finsupp.mem_support_iff.mp hn
    rw [hsampleValue] at hne
    split_ifs at hne with hmem hcut
    · exact hcut
    · exact (hne rfl).elim
    · exact (hne rfl).elim
  have hmu (b : Bool) (n : ℕ) :
      ‖((if b then |ArithmeticFunction.moebius n|
        else ArithmeticFunction.moebius n : ℤ) : ℂ)‖ ≤ 1 := by
    rcases ArithmeticFunction.moebius_eq_or n with h | h | h <;>
      cases b <;> simp [h]
  have hcut (p : Prop) [Decidable p] (w : ℤ) (hw : ‖(w : ℂ)‖ ≤ 1) :
      ‖((if p then w else 0 : ℤ) : ℂ)‖ ≤ 1 := by
    by_cases hp : p
    · simpa only [ite_eq_left hp] using hw
    · simp only [ite_eq_right hp, Int.cast_zero, norm_zero, zero_le_one]
  have hrawA (d : ι) (n : ℕ) (hn : 0 < n) :
      ‖(rawA d n : ℂ)‖ ≤ (n.divisors.card : ℝ) ^ 2 := by
    by_cases hj : d.2.1 = 0
    · simp only [rawA, ite_eq_left hj]
      have hcard : (1 : ℝ) ≤ n.divisors.card := by
        have hc : 1 ≤ n.divisors.card := Finset.card_pos.mpr
          ⟨1, Nat.one_mem_divisors.mpr (Nat.ne_of_gt hn)⟩
        exact_mod_cast hc
      exact (hcut _ _ (hmu d.2.2.2.1 n)).trans
        (show (1 : ℝ) ≤ (n.divisors.card : ℝ) ^ 2 from one_le_pow₀ hcard)
    · have hh := norm_three_divisor_sum_le_divisor_sq n
        (fun s p h => ((if (if d.2.1 = 1 then s = 1 else
              Nat.Prime s ∧ d.1 2 ≤ (s : ℝ) ∧ s ≤ p) ∧
            Nat.Prime p ∧ d.1 2 ≤ (p : ℝ) ∧ 1 < h ∧
            ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < d.1 2 ∧
            (d.2.2.2.2.2.1 s h ∧ d.1 4 ≤ (h.minFac : ℝ) ∧ (h.minFac : ℝ) ≤ d.1 5) ∧
            d.2.2.2.2.2.2.1 s h ≤ (p : ℝ) ∧ (p : ℝ) ≤ d.2.2.2.2.2.2.2 s h ∧
            ((s * p : ℕ) : ℝ) < d.1 3 ∧
            ((n / h.minFac : ℕ) : ℝ) < d.1 3 ∧ d.1 3 ≤ (n : ℝ)
          then (if d.2.2.2.1 then |ArithmeticFunction.moebius h|
                else ArithmeticFunction.moebius h) else 0 : ℤ) : ℂ)) (by
            intro aa _haa bb _hbb
            exact hcut _ _ (hmu d.2.2.2.1 bb.2))
      simpa only [rawA, ite_eq_right hj, Int.cast_sum] using hh
  have hrawB (d : ι) (n : ℕ) :
      ‖(rawB d n : ℂ)‖ ≤ (n.divisors.card : ℝ) ^ 2 := by
    have hh := norm_three_divisor_sum_le_divisor_sq n
      (fun s t _k => ((if (if d.2.2.1 = 0 then s = 1 else Nat.Prime s) ∧
          d.1 8 ≤ (s : ℝ) ∧ (s : ℝ) ≤ d.1 9 ∧
          d.1 10 ≤ ((max 1 (t.primeFactors.sup id) : ℕ) : ℝ) ∧
          ((max 1 (t.primeFactors.sup id) : ℕ) : ℝ) < d.1 11 ∧
          d.1 12 ≤ ((s * t : ℕ) : ℝ) ∧ ((s * t : ℕ) : ℝ) ≤ d.1 13
        then (if d.2.2.2.2.1 then |ArithmeticFunction.moebius t|
              else ArithmeticFunction.moebius t) else 0 : ℤ) : ℂ)) (by
          intro aa _haa bb _hbb
          exact hcut _ _ (hmu d.2.2.2.2.1 bb.1))
    simpa only [rawB, Int.cast_sum] using hh
  have hsampleNorm (T lo hi : ℝ) (f : ℕ → ℤ)
      (hf : ∀ n : ℕ, 0 < n → ‖(f n : ℂ)‖ ≤ (n.divisors.card : ℝ) ^ 2) (n : ℕ) :
      ‖sample T lo hi f n‖ ≤ (n.divisors.card : ℝ) ^ 2 := by
    rw [hsampleValue]
    split_ifs with hmem _hcut
    · exact hf n (Finset.mem_Icc.mp hmem).1
    · simpa only [norm_zero] using sq_nonneg (n.divisors.card : ℝ)
    · simpa only [norm_zero] using sq_nonneg (n.divisors.card : ℝ)
  have hrowNorm (d : ι) (n : ℕ) :
      ‖arow d n‖ ≤ (n.divisors.card : ℝ) ^ 2 ∧
      ‖brow d n‖ ≤ (n.divisors.card : ℝ) ^ 2 :=
    ⟨hsampleNorm _ _ _ _ (hrawA d) n,
      hsampleNorm _ _ _ _ (fun n _ => hrawB d n) n⟩
  have hscale : ∀ x : ℝ, X₀ ≤ x → ∀ d : ι,
      x / C₀ ≤ Mformal x d * Nformal x d ∧
      Mformal x d * Nformal x d ≤ C₀ * x ∧
      x ^ (1 / 2 - σ) ≤ Nformal x d ∧ Nformal x d ≤ x ^ (1 / 2 : ℝ) := by
    intro x hx d
    by_cases hg : good x d
    · have hgood := hg
      obtain ⟨_hM, _hN, hprodlo, hprodhi, hminlo, hminhi, _hrest⟩ := hgood
      simp only [Mformal, Nformal, ite_eq_left hg]
      have hp : 2 * max (d.1 0) (d.1 1) * (min (d.1 0) (d.1 1) / 2) =
          d.1 0 * d.1 1 := by
        calc
          _ = max (d.1 0) (d.1 1) * min (d.1 0) (d.1 1) := by ring
          _ = _ := max_mul_min _ _
      rw [hp]
      exact ⟨(div_le_div_of_nonneg_left (hxPos x hx).le hCpos
          (le_max_left _ _)).trans hprodlo,
        hprodhi.trans (mul_le_mul_of_nonneg_right (le_max_left _ _) (hxPos x hx).le),
        hminlo, hminhi⟩
    · simp only [Mformal, Nformal, ite_eq_right hg]
      have hsq : x ^ (1 / 2 : ℝ) * x ^ (1 / 2 : ℝ) = x := by
        rw [← Real.rpow_add (hxPos x hx)]
        norm_num
      rw [hsq]
      exact ⟨div_le_self (hxPos x hx).le hC₀,
        le_mul_of_one_le_left (hxPos x hx).le hC₀,
        Real.rpow_le_rpow_of_exponent_le (hxOne x hx) (by linarith), le_rfl⟩
  have hsupport : ∀ x : ℝ, X₀ ≤ x → ∀ d : ι,
      (∀ n ∈ (α x d).support,
        (1 / 2 : ℝ) * Mformal x d ≤ (n : ℝ) ∧ (n : ℝ) ≤ C₀ * Mformal x d) ∧
      (∀ n ∈ (β x d).support,
        (1 / 2 : ℝ) * Nformal x d ≤ (n : ℝ) ∧ (n : ℝ) ≤ C₀ * Nformal x d) := by
    intro x _hx d
    by_cases hg : good x d
    · have hgood := hg
      obtain ⟨hM, hN, _hpL, _hpU, _hminL, _hminU, _hMU, _hNU,
          _hz, _hH, _hZl, _hZh, hAl, hAu, hBl, hBu⟩ := hgood
      have hCM := mul_le_mul_of_nonneg_right hC₀four hM.le
      have hCN := mul_le_mul_of_nonneg_right hC₀four hN.le
      have ha (n : ℕ) (hn : n ∈ (arow d).support) :
          d.1 0 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * d.1 0 := by
        obtain ⟨hl, hu⟩ := hsampleSupport _ _ _ _ n hn
        exact ⟨hAl.trans hl, hu.trans hAu⟩
      have hb (n : ℕ) (hn : n ∈ (brow d).support) :
          d.1 1 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * d.1 1 := by
        obtain ⟨hl, hu⟩ := hsampleSupport _ _ _ _ n hn
        exact ⟨hBl.trans hl, hu.trans hBu⟩
      by_cases hMN : d.1 0 ≤ d.1 1
      · simp only [α, β, Mformal, Nformal, ite_eq_left hg, ite_eq_left hMN,
          min_eq_left hMN, max_eq_right hMN]
        constructor
        · intro n hn
          obtain ⟨hl, hu⟩ := hb n hn
          constructor <;> nlinarith only [hl, hu, hCM, hCN]
        · intro n hn
          obtain ⟨hl, hu⟩ := ha n hn
          constructor <;> nlinarith only [hl, hu, hCM, hCN]
      · have hNM : d.1 1 ≤ d.1 0 := (lt_of_not_ge hMN).le
        simp only [α, β, Mformal, Nformal, ite_eq_left hg, ite_eq_right hMN,
          min_eq_right hNM, max_eq_left hNM]
        constructor
        · intro n hn
          obtain ⟨hl, hu⟩ := ha n hn
          constructor <;> nlinarith only [hl, hu, hCM, hCN]
        · intro n hn
          obtain ⟨hl, hu⟩ := hb n hn
          constructor <;> nlinarith only [hl, hu, hCM, hCN]
    · constructor
      · intro n hn
        exfalso
        simp only [α, ite_eq_right hg, Finsupp.support_zero, Finset.notMem_empty] at hn
      · intro n hn
        exfalso
        simp only [β, ite_eq_right hg, Finsupp.support_zero, Finset.notMem_empty] at hn
  have hcoeff : ∀ x : ℝ, X₀ ≤ x → ∀ d : ι, ∀ n : ℕ,
      ‖α x d n‖ ≤ 1 * (n.divisors.card : ℝ) ^ 2 * (Real.log x) ^ 2 ∧
      ‖β x d n‖ ≤ 1 * (n.divisors.card : ℝ) ^ 2 * (Real.log x) ^ 2 := by
    intro x hx d n
    have hraise : (n.divisors.card : ℝ) ^ 2 ≤
        1 * (n.divisors.card : ℝ) ^ 2 * (Real.log x) ^ 2 := by
      simpa only [one_mul] using le_mul_of_one_le_right
        (sq_nonneg (n.divisors.card : ℝ)) (one_le_pow₀ (hlog x hx))
    have ha := (hrowNorm d n).1.trans hraise
    have hb := (hrowNorm d n).2.trans hraise
    by_cases hg : good x d
    · by_cases hMN : d.1 0 ≤ d.1 1
      · simpa only [α, β, ite_eq_left hg, ite_eq_left hMN] using And.intro hb ha
      · simpa only [α, β, ite_eq_left hg, ite_eq_right hMN] using And.intro ha hb
    · simp only [α, β, ite_eq_right hg, Finsupp.zero_apply, norm_zero, one_mul, and_self]
      exact mul_nonneg (sq_nonneg (n.divisors.card : ℝ)) (sq_nonneg (Real.log x))
  have hSW : ∀ A : ℝ, 0 < A →
      ∃ KSW XSW : ℝ, 0 < KSW ∧ X₀ ≤ XSW ∧
        ∀ x : ℝ, XSW ≤ x → ∀ d : ι,
        ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
          ‖fullDiscrepancy ((β x d).filter (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
            KSW * ((q * r).divisors.card : ℝ) ^ 1 * Nformal x d /
              (Real.log x) ^ A := by
    intro A hA
    obtain ⟨Ku, Xu, hKu, _hXu, hunit⟩ :=
      harmanA_unit_minFac_interval_all_moduli_siegelWalfisz η 2 1 2 A
        hη (by norm_num) (by norm_num) (by norm_num) hA
    obtain ⟨Ka, Xa, hKa, _hXa, hnamed⟩ :=
      harmanA_named_all_moduli_siegelWalfisz η 2 1 2 A
        hη (by norm_num) (by norm_num) (by norm_num) hA
    obtain ⟨Kb, Xb, hKb, _hXb, hright⟩ :=
      harmanB_primeFactor_band_all_moduli_siegelWalfisz η 2 1 2 A
        hη (by norm_num) (by norm_num) (by norm_num) hA
    let Kall : ℝ := Ku + Ka + Kb
    refine ⟨2 * Kall, max X₀ (max Xu (max Xa Xb)), by dsimp [Kall]; positivity,
      le_max_left _ _, ?_⟩
    intro x hx d q r a hq hr ha
    have hx₀ : X₀ ≤ x := (le_max_left _ _).trans hx
    have hxu : Xu ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans hx)
    have hxa : Xa ≤ x := (le_max_left _ _).trans
      ((le_max_right _ _).trans ((le_max_right _ _).trans hx))
    have hxb : Xb ≤ x := (le_max_right _ _).trans
      ((le_max_right _ _).trans ((le_max_right _ _).trans hx))
    have hden : 0 ≤ (Real.log x) ^ A :=
      Real.rpow_nonneg (zero_le_one.trans (hlog x hx₀)) A
    have htau : 0 ≤ ((q * r).divisors.card : ℝ) := Nat.cast_nonneg _
    have hKall : 0 < Kall := by dsimp [Kall]; positivity
    have hrelax (K0 S : ℝ) (hK0 : K0 ≤ Kall) (hS : 0 ≤ S) :
        K0 * ((q * r).divisors.card : ℝ) * S / (Real.log x) ^ A ≤
          Kall * ((q * r).divisors.card : ℝ) * S / (Real.log x) ^ A :=
      div_le_div_of_nonneg_right
        (mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_right hK0 htau) hS) hden
    by_cases hg : good x d
    · have hgood := hg
      obtain ⟨hM, hN, _hpL, _hpU, hminL, _hminU, hMU, hNU,
          hz, hH, hZl, hZh, hAl, _hAu, hBl, _hBu⟩ := hgood
      have hML : x ^ η ≤ d.1 0 := by
        have hh := min_le_left (d.1 0) (d.1 1)
        have hpos := Real.rpow_pos_of_pos (hxPos x hx₀) η
        change x ^ η ≤ min (d.1 0) (d.1 1) / 2 at hminL
        linarith
      have hNL : x ^ η ≤ d.1 1 := by
        have hh := min_le_right (d.1 0) (d.1 1)
        have hpos := Real.rpow_pos_of_pos (hxPos x hx₀) η
        change x ^ η ≤ min (d.1 0) (d.1 1) / 2 at hminL
        linarith
      have hArow : ‖fullDiscrepancy ((arow d).filter (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
          Kall * ((q * r).divisors.card : ℝ) * d.1 0 / (Real.log x) ^ A := by
        by_cases hj : d.2.1 = 0
        · have hh := hunit x hxu (d.1 0) hML hMU (d.1 2) (d.1 3)
            (d.1 6) (d.1 7) (d.1 4) (d.1 5) hz hH
            (by simpa only [one_mul] using hAl) d.2.2.2.1 q hq r hr a ha
          have hu : ‖fullDiscrepancy ((arow d).filter (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
              Ku * ((q * r).divisors.card : ℝ) * d.1 0 / (Real.log x) ^ A := by
            simpa only [arow, hsampleFilter, rawA, ite_eq_left hj] using hh
          exact hu.trans (hrelax Ku _ (by dsimp [Kall]; linarith) hM.le)
        · let j0 : Fin 2 := if d.2.1 = 1 then 0 else 1
          let P0 : ℕ → ℕ → Prop := fun s h =>
            d.2.2.2.2.2.1 s h ∧ d.1 4 ≤ (h.minFac : ℝ) ∧ (h.minFac : ℝ) ≤ d.1 5
          have hh := hnamed x hxa (d.1 0) hML hMU j0 P0
            d.2.2.2.2.2.2.1 d.2.2.2.2.2.2.2 (d.1 2) (d.1 3)
            (d.1 6) (d.1 7) hz (by linarith) (by simpa only [one_mul] using hAl)
            d.2.2.2.1 q hq r hr a ha
          have hn : ‖fullDiscrepancy ((arow d).filter (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
              Ka * ((q * r).divisors.card : ℝ) * d.1 0 / (Real.log x) ^ A := by
            by_cases hj1 : d.2.1 = 1
            · simpa only [arow, hsampleFilter, rawA, ite_eq_right hj, j0, P0,
                ite_eq_left hj1, ite_eq_left (rfl : (0 : Fin 2) = 0), ite_true] using hh
            · simpa only [arow, hsampleFilter, rawA, ite_eq_right hj, j0, P0,
                ite_eq_right hj1, ite_eq_right (by decide : (1 : Fin 2) ≠ 0)] using hh
          exact hn.trans (hrelax Ka _ (by dsimp [Kall]; linarith) hM.le)
      have hBrow : ‖fullDiscrepancy ((brow d).filter (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
          Kall * ((q * r).divisors.card : ℝ) * d.1 1 / (Real.log x) ^ A := by
        have hh := hright x hxb (d.1 1) hNL hNU d.2.2.1 d.2.2.2.2.1
          (d.1 8) (d.1 9) (d.1 10) (d.1 11) (d.1 12) (d.1 13)
          (d.1 14) (d.1 15) hZl hZh (by simpa only [one_mul] using hBl)
          q hq r hr a ha
        have hb : ‖fullDiscrepancy ((brow d).filter (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
            Kb * ((q * r).divisors.card : ℝ) * d.1 1 / (Real.log x) ^ A := by
          simpa only [brow, hsampleFilter, rawB] using hh
        exact hb.trans (hrelax Kb _ (by dsimp [Kall]; linarith) hN.le)
      by_cases hMN : d.1 0 ≤ d.1 1
      · simp only [β, Nformal, ite_eq_left hg, ite_eq_left hMN, min_eq_left hMN, pow_one]
        convert hArow using 1
        ring
      · have hNM : d.1 1 ≤ d.1 0 := (lt_of_not_ge hMN).le
        simp only [β, Nformal, ite_eq_left hg, ite_eq_right hMN, min_eq_right hNM, pow_one]
        convert hBrow using 1
        ring
    · simp only [β, Nformal, ite_eq_right hg, Finsupp.filter_zero, fullDiscrepancy,
        progressionMass, reducedMass, Finsupp.support_zero, Finset.sum_empty,
        zero_div, sub_self, norm_zero]
      exact div_nonneg
        (mul_nonneg (mul_nonneg (by positivity : 0 ≤ 2 * Kall)
          (pow_nonneg htau _)) (Real.rpow_nonneg (hxPos x hx₀).le _)) hden
  intro A hA
  obtain ⟨K, X, hK, hX, hdist⟩ :=
    central_prime_box_distribution_backend hDeligne j «ω» δ σ hω hδ hσ hsource
      Mformal Nformal α β (1 / 2) C₀ 1 X₀ 2 1 (by norm_num) hC₀ (by norm_num) hX₀
      hscale hsupport hcoeff hSW A hA
  refine ⟨K, X, hK, hX, ?_⟩
  intro x hx M N hM hN hpL hpU hminL hminU hMU hNU jA jB bA bB P L U
    z H fLo fHi loA hiA slo shi Zlo Zhi Lsd Usd loB hiB
    hz hH hZl hZh hAl hAu hBl hBu A0 B0 α0 β0 I hI a ha
  let v : Fin 16 → ℝ := ![M, N, z, H, fLo, fHi, loA, hiA,
    slo, shi, Zlo, Zhi, Lsd, Usd, loB, hiB]
  let d : ι := (v, jA, jB, bA, bB, P, L, U)
  have hg : good x d :=
    ⟨hM, hN, hpL, hpU, hminL, hminU, hMU, hNU,
      hz, hH, hZl, hZh, hAl, hAu, hBl, hBu⟩
  have hα : arow d = α0 := rfl
  have hβ : brow d = β0 := rfl
  have hd := hdist x hx d I hI a ha
  have hcomm : finiteConvolution β0 α0 = finiteConvolution α0 β0 := by
    unfold finiteConvolution
    rw [mul_comm]
  by_cases hMN : M ≤ N
  · have hMN' : d.1 0 ≤ d.1 1 := hMN
    simpa only [α, β, ite_eq_left hg, ite_eq_left hMN', hα, hβ, hcomm] using hd
  · have hMN' : ¬ d.1 0 ≤ d.1 1 := hMN
    simpa only [α, β, ite_eq_left hg, ite_eq_right hMN', hα, hβ] using hd

open Classical in
theorem harman_finite_box_error_decomposition {α β ι κ : Type*}
    (A : Finset α) (B : Finset β) (keyA : α → ι) (keyB : β → κ)
    (mA : α → ℕ) (mB : β → ℕ) (wa : α → ℝ) (wb : β → ℝ)
    (Good : α → β → Prop) :
    let IA := A.image keyA
    let IB := B.image keyB
    let SA (i : ι) := A.filter (fun a => keyA a = i)
    let SB (j : κ) := B.filter (fun b => keyB b = j)
    let C := IA ×ˢ IB
    let interior (t : ι × κ) := ∀ a ∈ SA t.1, ∀ b ∈ SB t.2, Good a b
    let boundary (t : ι × κ) :=
      (∃ a ∈ SA t.1, ∃ b ∈ SB t.2, Good a b) ∧
        ∃ a ∈ SA t.1, ∃ b ∈ SB t.2, ¬Good a b
    let W (t : ι × κ) (n : ℕ) : ℝ :=
      ∑ a ∈ SA t.1, ∑ b ∈ SB t.2,
        if mA a * mB b = n then wa a * wb b else 0
    let V (t : ι × κ) (n : ℕ) : ℝ :=
      ∑ a ∈ SA t.1, ∑ b ∈ SB t.2,
        if Good a b ∧ mA a * mB b = n then wa a * wb b else 0
    let P (t : ι × κ) (n : ℕ) : ℝ :=
      ∑ a ∈ SA t.1, ∑ b ∈ SB t.2,
        if mA a * mB b = n then |wa a| * |wb b| else 0
    let F (n : ℕ) : ℝ :=
      ∑ a ∈ A, ∑ b ∈ B,
        if Good a b ∧ mA a * mB b = n then wa a * wb b else 0
    let I (n : ℕ) : ℝ := ∑ t ∈ C, if interior t then W t n else 0
    let E (n : ℕ) : ℝ := ∑ t ∈ C, if boundary t then V t n else 0
    let G (n : ℕ) : ℝ := ∑ t ∈ C, if boundary t then P t n else 0
    ∀ n, F n = I n + E n ∧ |F n - I n| ≤ G n ∧ 0 ≤ G n := by
  intro IA IB SA SB C interior boundary W V P F I E G
  have hbox (t : ι × κ) :
      ((A ×ˢ B).filter (fun p => (keyA p.1, keyB p.2) = t)) =
        SA t.1 ×ˢ SB t.2 := by
    rcases t with ⟨i, j⟩
    simpa only [SA, SB, Prod.mk.injEq] using
      (Finset.filter_product (s := A) (t := B)
        (fun a => keyA a = i) (fun b => keyB b = j))
  have hfiber (n : ℕ) : (∑ t ∈ C, V t n) = F n := by
    have hmaps (p : α × β) (hp : p ∈ A ×ˢ B) :
        (keyA p.1, keyB p.2) ∈ C := by
      obtain ⟨ha, hb⟩ := Finset.mem_product.mp hp
      exact Finset.mem_product.mpr
        ⟨Finset.mem_image_of_mem keyA ha, Finset.mem_image_of_mem keyB hb⟩
    simpa only [V, F, hbox, Finset.sum_product] using
      (Finset.sum_fiberwise_of_maps_to hmaps
        (fun p : α × β =>
          if Good p.1 p.2 ∧ mA p.1 * mB p.2 = n then wa p.1 * wb p.2 else 0))
  have hsplit (t : ι × κ) (n : ℕ) :
      V t n = (if interior t then W t n else 0) +
        if boundary t then V t n else 0 := by
    by_cases hi : interior t
    · have hnb : ¬boundary t := by
        intro hb
        obtain ⟨a, ha, b, hb, hbad⟩ := hb.2
        exact hbad (hi a ha b hb)
      have hVW : V t n = W t n := by
        apply Finset.sum_congr rfl
        intro a ha
        apply Finset.sum_congr rfl
        intro b hb
        simp only [hi a ha b hb, true_and]
      rw [ite_eq_left hi, ite_eq_right hnb, add_zero]
      exact hVW
    · have hbad : ∃ a ∈ SA t.1, ∃ b ∈ SB t.2, ¬Good a b := by
        simpa [interior] using hi
      by_cases hg : ∃ a ∈ SA t.1, ∃ b ∈ SB t.2, Good a b
      · have hb : boundary t := ⟨hg, hbad⟩
        rw [ite_eq_right hi, ite_eq_left hb, zero_add]
      · have hnb : ¬boundary t := fun hb => hg hb.1
        have hzero : V t n = 0 := by
          apply Finset.sum_eq_zero
          intro a ha
          apply Finset.sum_eq_zero
          intro b hb
          exact ite_eq_right (fun hp => hg ⟨a, ha, b, hb, hp.1⟩)
        rw [ite_eq_right hi, ite_eq_right hnb, zero_add]
        exact hzero
  have hdecomposition (n : ℕ) : F n = I n + E n := by
    rw [← hfiber n]
    calc
      (∑ t ∈ C, V t n) = ∑ t ∈ C,
          ((if interior t then W t n else 0) +
            if boundary t then V t n else 0) :=
        Finset.sum_congr rfl (fun t _ => hsplit t n)
      _ = I n + E n := by rw [Finset.sum_add_distrib]
  have hVabs (t : ι × κ) (n : ℕ) : |V t n| ≤ P t n := by
    calc
      |V t n| ≤ ∑ a ∈ SA t.1,
          |∑ b ∈ SB t.2,
            if Good a b ∧ mA a * mB b = n then wa a * wb b else 0| :=
        Finset.abs_sum_le_sum_abs _ _
      _ ≤ ∑ a ∈ SA t.1, ∑ b ∈ SB t.2,
          |if Good a b ∧ mA a * mB b = n then wa a * wb b else 0| :=
        Finset.sum_le_sum (fun a _ => Finset.abs_sum_le_sum_abs _ _)
      _ ≤ P t n := by
        apply Finset.sum_le_sum
        intro a _
        apply Finset.sum_le_sum
        intro b _
        by_cases hn : mA a * mB b = n
        · by_cases hg : Good a b
          · simp only [hn, hg, true_and, ite_true, abs_mul, le_refl]
          · simp only [hg, false_and, hn, ite_false, ite_true, abs_zero]
            exact mul_nonneg (abs_nonneg _) (abs_nonneg _)
        · simp only [hn, and_false, ite_false, abs_zero, le_refl]
  have hEabs (n : ℕ) : |E n| ≤ G n := by
    calc
      |E n| ≤ ∑ t ∈ C, |if boundary t then V t n else 0| :=
        Finset.abs_sum_le_sum_abs _ _
      _ ≤ G n := by
        apply Finset.sum_le_sum
        intro t _
        by_cases hb : boundary t
        · simpa only [hb, ite_true] using hVabs t n
        · simp only [hb, ite_false, abs_zero, le_refl]
  intro n
  refine ⟨hdecomposition n, ?_, (abs_nonneg _).trans (hEabs n)⟩
  simpa only [hdecomposition n, add_sub_cancel_left] using hEabs n

theorem siftedPrimeTuples_named_cuts (x : ℝ) (hx : 1 < x) (l : Fin 6)
    (p q s : ℕ)
    (hdummy : match l.val with
      | 0 => p = 1 ∧ q = 1 ∧ s = 1
      | 1 => q = 1 ∧ s = 1
      | 2 => q = 1
      | 3 => q = 1
      | _ => True) :
    let z : ℝ := x ^ ((9519 : ℝ) / 50000)
    let H : ℝ := x ^ ((40481 : ℝ) / 100000)
    let B : ℝ := x ^ ((59519 : ℝ) / 100000)
    let S : ℝ := x ^ (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000)
    let ps : List ℕ := match l.val with
      | 0 => []
      | 1 => [p]
      | 2 => [p, s]
      | 3 => [p, s]
      | 4 => [q, p, s]
      | _ => [s, p, q]
    let r : ℕ := if l.val ≤ 3 then (if l.val = 0 then 1 else p) else p * q
    siftedPrimeGroups l ps = (r, s) ∧ ps.prod = r * s ∧
      (ps ∈ siftedPrimeTuples x l ↔ match l.val with
        | 0 => True
        | 1 => p.Prime ∧ z ≤ (p : ℝ) ∧ (p : ℝ) < H
        | 2 => p.Prime ∧ s.Prime ∧ z ≤ (s : ℝ) ∧ s < p ∧
            (p : ℝ) < H ∧ ((p * s : ℕ) : ℝ) < H
        | 3 => p.Prime ∧ s.Prime ∧ z ≤ (s : ℝ) ∧ s < p ∧
            (p : ℝ) < H ∧ B < ((p * s : ℕ) : ℝ) ∧ (s : ℝ) < S
        | 4 => p.Prime ∧ q.Prime ∧ s.Prime ∧ z ≤ (s : ℝ) ∧ s < p ∧
            p < q ∧ ((p * q : ℕ) : ℝ) < H ∧ (s : ℝ) < S
        | _ => s.Prime ∧ p.Prime ∧ q.Prime ∧ z ≤ (p : ℝ) ∧ p < s ∧
            (s : ℝ) < H ∧ p ≤ q ∧ ((p * q : ℕ) : ℝ) < H ∧ (s : ℝ) < S) := by
  have hlo (n : ℕ) (hn : n.Prime) (t : ℝ) :
      t ≤ Real.logb x (n : ℝ) ↔ x ^ t ≤ (n : ℝ) :=
    Real.le_logb_iff_rpow_le hx (Nat.cast_pos.mpr hn.pos)
  have hlt (n : ℕ) (hn : n.Prime) (t : ℝ) :
      Real.logb x (n : ℝ) < t ↔ (n : ℝ) < x ^ t :=
    Real.logb_lt_iff_lt_rpow hx (Nat.cast_pos.mpr hn.pos)
  have horder (n m : ℕ) (hn : n.Prime) (hm : m.Prime) :
      Real.logb x (n : ℝ) < Real.logb x (m : ℝ) ↔ n < m := by
    simpa only [Nat.cast_lt] using
      Real.logb_lt_logb_iff hx (Nat.cast_pos.mpr hn.pos) (Nat.cast_pos.mpr hm.pos)
  have horder_le (n m : ℕ) (hn : n.Prime) (hm : m.Prime) :
      Real.logb x (n : ℝ) ≤ Real.logb x (m : ℝ) ↔ n ≤ m := by
    simpa only [Nat.cast_le] using
      Real.logb_le_logb hx (Nat.cast_pos.mpr hn.pos) (Nat.cast_pos.mpr hm.pos)
  have hproduct_lt (n m : ℕ) (hn : n.Prime) (hm : m.Prime) (t : ℝ) :
      Real.logb x (n : ℝ) + Real.logb x (m : ℝ) < t ↔
        ((n * m : ℕ) : ℝ) < x ^ t := by
    rw [Nat.cast_mul, ← Real.logb_mul (Nat.cast_ne_zero.mpr hn.ne_zero)
      (Nat.cast_ne_zero.mpr hm.ne_zero)]
    exact Real.logb_lt_iff_lt_rpow hx
      (mul_pos (Nat.cast_pos.mpr hn.pos) (Nat.cast_pos.mpr hm.pos))
  have hlt_product (n m : ℕ) (hn : n.Prime) (hm : m.Prime) (t : ℝ) :
      t < Real.logb x (n : ℝ) + Real.logb x (m : ℝ) ↔
        x ^ t < ((n * m : ℕ) : ℝ) := by
    rw [Nat.cast_mul, ← Real.logb_mul (Nat.cast_ne_zero.mpr hn.ne_zero)
      (Nat.cast_ne_zero.mpr hm.ne_zero)]
    exact Real.lt_logb_iff_rpow_lt hx
      (mul_pos (Nat.cast_pos.mpr hn.pos) (Nat.cast_pos.mpr hm.pos))
  dsimp only
  fin_cases l
  · change p = 1 ∧ q = 1 ∧ s = 1 at hdummy
    rcases hdummy with ⟨rfl, rfl, rfl⟩
    simp [siftedPrimeGroups, mem_siftedPrimeTuples_iff x hx]
  · change q = 1 ∧ s = 1 at hdummy
    rcases hdummy with ⟨rfl, rfl⟩
    refine ⟨by simp [siftedPrimeGroups], by simp, ?_⟩
    change [p] ∈ siftedPrimeTuples x (1 : Fin 6) ↔
      p.Prime ∧ x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ) ∧
        (p : ℝ) < x ^ ((40481 : ℝ) / 100000)
    have hm := mem_siftedPrimeTuples_iff x hx (1 : Fin 6) [p]
    dsimp only at hm ⊢
    rw [hm]
    constructor
    · rintro ⟨hp, hz, hH⟩
      exact ⟨hp, (hlo p hp _).mp hz, (hlt p hp _).mp hH⟩
    · rintro ⟨hp, hz, hH⟩
      exact ⟨hp, (hlo p hp _).mpr hz, (hlt p hp _).mpr hH⟩
  · change q = 1 at hdummy
    subst q
    refine ⟨by simp [siftedPrimeGroups], by simp, ?_⟩
    change [p, s] ∈ siftedPrimeTuples x (2 : Fin 6) ↔
      p.Prime ∧ s.Prime ∧ x ^ ((9519 : ℝ) / 50000) ≤ (s : ℝ) ∧ s < p ∧
        (p : ℝ) < x ^ ((40481 : ℝ) / 100000) ∧
        ((p * s : ℕ) : ℝ) < x ^ ((40481 : ℝ) / 100000)
    have hm := mem_siftedPrimeTuples_iff x hx (2 : Fin 6) [p, s]
    dsimp only at hm ⊢
    rw [hm]
    constructor
    · rintro ⟨hp, hs, hz, hsp, hH, hprod⟩
      exact ⟨hp, hs, (hlo s hs _).mp hz, (horder s p hs hp).mp hsp,
        (hlt p hp _).mp hH, (hproduct_lt p s hp hs _).mp hprod⟩
    · rintro ⟨hp, hs, hz, hsp, hH, hprod⟩
      exact ⟨hp, hs, (hlo s hs _).mpr hz, (horder s p hs hp).mpr hsp,
        (hlt p hp _).mpr hH, (hproduct_lt p s hp hs _).mpr hprod⟩
  · change q = 1 at hdummy
    subst q
    refine ⟨by simp [siftedPrimeGroups], by simp, ?_⟩
    change [p, s] ∈ siftedPrimeTuples x (3 : Fin 6) ↔
      p.Prime ∧ s.Prime ∧ x ^ ((9519 : ℝ) / 50000) ≤ (s : ℝ) ∧ s < p ∧
        (p : ℝ) < x ^ ((40481 : ℝ) / 100000) ∧
        x ^ ((59519 : ℝ) / 100000) < ((p * s : ℕ) : ℝ) ∧
        (s : ℝ) < x ^ (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000)
    have hm := mem_siftedPrimeTuples_iff x hx (3 : Fin 6) [p, s]
    dsimp only at hm ⊢
    rw [hm]
    constructor
    · rintro ⟨hp, hs, hz, hsp, hH, hprod, hS⟩
      exact ⟨hp, hs, (hlo s hs _).mp hz, (horder s p hs hp).mp hsp,
        (hlt p hp _).mp hH, (hlt_product p s hp hs _).mp hprod,
        (hlt s hs _).mp hS⟩
    · rintro ⟨hp, hs, hz, hsp, hH, hprod, hS⟩
      exact ⟨hp, hs, (hlo s hs _).mpr hz, (horder s p hs hp).mpr hsp,
        (hlt p hp _).mpr hH, (hlt_product p s hp hs _).mpr hprod,
        (hlt s hs _).mpr hS⟩
  · clear hdummy
    refine ⟨by simp [siftedPrimeGroups, mul_comm],
      by simp [mul_comm, mul_left_comm], ?_⟩
    change [q, p, s] ∈ siftedPrimeTuples x (4 : Fin 6) ↔
      p.Prime ∧ q.Prime ∧ s.Prime ∧ x ^ ((9519 : ℝ) / 50000) ≤ (s : ℝ) ∧
        s < p ∧ p < q ∧ ((p * q : ℕ) : ℝ) < x ^ ((40481 : ℝ) / 100000) ∧
        (s : ℝ) < x ^ (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000)
    have hm := mem_siftedPrimeTuples_iff x hx (4 : Fin 6) [q, p, s]
    dsimp only at hm ⊢
    rw [hm]
    constructor
    · rintro ⟨hq, hp, hs, hz, hsp, hpq, _hqH, hprod, hS⟩
      refine ⟨hp, hq, hs, (hlo s hs _).mp hz, (horder s p hs hp).mp hsp,
        (horder p q hp hq).mp hpq, ?_, (hlt s hs _).mp hS⟩
      simpa only [Nat.mul_comm] using (hproduct_lt q p hq hp _).mp hprod
    · rintro ⟨hp, hq, hs, hz, hsp, hpq, hprod, hS⟩
      have hqH : (q : ℝ) < x ^ ((40481 : ℝ) / 100000) :=
        (Nat.cast_le.mpr (Nat.le_mul_of_pos_left q hp.pos)).trans_lt hprod
      have hprod' : ((q * p : ℕ) : ℝ) < x ^ ((40481 : ℝ) / 100000) := by
        simpa only [Nat.mul_comm] using hprod
      exact ⟨hq, hp, hs, (hlo s hs _).mpr hz, (horder s p hs hp).mpr hsp,
        (horder p q hp hq).mpr hpq, (hlt q hq _).mpr hqH,
        (hproduct_lt q p hq hp _).mpr hprod', (hlt s hs _).mpr hS⟩
  · clear hdummy
    refine ⟨by simp [siftedPrimeGroups], by simp [mul_comm, mul_left_comm], ?_⟩
    change [s, p, q] ∈ siftedPrimeTuples x (5 : Fin 6) ↔
      s.Prime ∧ p.Prime ∧ q.Prime ∧ x ^ ((9519 : ℝ) / 50000) ≤ (p : ℝ) ∧
        p < s ∧ (s : ℝ) < x ^ ((40481 : ℝ) / 100000) ∧ p ≤ q ∧
        ((p * q : ℕ) : ℝ) < x ^ ((40481 : ℝ) / 100000) ∧
        (s : ℝ) < x ^ (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000)
    have hm := mem_siftedPrimeTuples_iff x hx (5 : Fin 6) [s, p, q]
    dsimp only at hm ⊢
    rw [hm]
    constructor
    · rintro ⟨hs, hp, hq, hz, hps, hH, hpq, hprod, hS⟩
      exact ⟨hs, hp, hq, (hlo p hp _).mp hz, (horder p s hp hs).mp hps,
        (hlt s hs _).mp hH, (horder_le p q hp hq).mp hpq,
        (hproduct_lt p q hp hq _).mp hprod, (hlt s hs _).mp hS⟩
    · rintro ⟨hs, hp, hq, hz, hps, hH, hpq, hprod, hS⟩
      exact ⟨hs, hp, hq, (hlo p hp _).mpr hz, (horder p s hp hs).mpr hps,
        (hlt s hs _).mpr hH, (horder_le p q hp hq).mpr hpq,
        (hproduct_lt p q hp hq _).mpr hprod, (hlt s hs _).mpr hS⟩

open Classical in
theorem prime_feature_full_tuple_boundary_mass
    (k X Z : ℕ) (i j : Fin k) (hij : i ≠ j)
    (hX : 1 ≤ X) (hZ : 1 ≤ Z) (h : ℝ) (hh : 0 ≤ h) :
    let S := (Fintype.piFinset (fun _ : Fin k => Finset.Icc 1 X)).filter
      (fun v => (∏ r, v r) ≤ X ∧ 1 < v i ∧
        Z < min (v i).minFac (max 1 ((v j).primeFactors.sup id)) ∧
        max ((v i).minFac : ℝ) ((max 1 ((v j).primeFactors.sup id) : ℕ) : ℝ) ≤
          (1 + h) * min ((v i).minFac : ℝ)
            ((max 1 ((v j).primeFactors.sup id) : ℕ) : ℝ))
    (S.card : ℝ) ≤
      2 * (X : ℝ) * (1 + Real.log (X : ℝ)) ^ (2 ^ k - 1) *
        (h * (1 + Real.log (X : ℝ)) + 1 / (Z : ℝ)) := by
  let C : ℝ := (X : ℝ) * (1 + Real.log (X : ℝ)) ^ (2 ^ k - 1) *
    (h * (1 + Real.log (X : ℝ)) + 1 / (Z : ℝ))
  have hquotient_count (a b : Fin k) (hab : a ≠ b) (p ℓ : ℕ)
      (hp : 0 < p) (hℓ : 0 < ℓ) (T : Finset (Fin k → ℕ))
      (hT : ∀ v ∈ T, (∀ r, 0 < v r) ∧ (∏ r, v r) ≤ X ∧
        p ∣ v a ∧ ℓ ∣ v b) :
      (T.card : ℝ) ≤ ∑ m ∈ Finset.Icc 1 (X / (p * ℓ)),
        (m.divisors.card : ℝ) ^ k := by
    let d : Fin k → ℕ := fun r =>
      (if r = a then p else 1) * (if r = b then ℓ else 1)
    let q : (Fin k → ℕ) → (Fin k → ℕ) := fun v r => v r / d r
    let R := T.image q
    have hdpos (r : Fin k) : 0 < d r := by
      dsimp [d]
      split_ifs <;> positivity
    have hdprod : (∏ r, d r) = p * ℓ := by
      dsimp [d]
      rw [Finset.prod_mul_distrib, Fintype.prod_ite_eq', Fintype.prod_ite_eq']
    have hdvd (v : Fin k → ℕ) (hv : v ∈ T) (r : Fin k) : d r ∣ v r := by
      by_cases hra : r = a
      · subst r
        simpa [d, hab] using (hT v hv).2.2.1
      · by_cases hrb : r = b
        · subst r
          simpa [d, hab.symm] using (hT v hv).2.2.2
        · simp [d, hra, hrb]
    have hrestore (v : Fin k → ℕ) (hv : v ∈ T) (r : Fin k) :
        q v r * d r = v r := Nat.div_mul_cancel (hdvd v hv r)
    have hqpos (v : Fin k → ℕ) (hv : v ∈ T) (r : Fin k) : 0 < q v r :=
      Nat.div_pos (Nat.le_of_dvd ((hT v hv).1 r) (hdvd v hv r)) (hdpos r)
    have hqprod (v : Fin k → ℕ) (hv : v ∈ T) :
        (∏ r, q v r) * (p * ℓ) = ∏ r, v r := by
      calc
        _ = (∏ r, q v r) * (∏ r, d r) := by rw [hdprod]
        _ = ∏ r, q v r * d r := Finset.prod_mul_distrib.symm
        _ = _ := Finset.prod_congr rfl fun r _ => hrestore v hv r
    have hinj : Set.InjOn q T := by
      intro v hv w hw hvw
      funext r
      calc
        v r = q v r * d r := (hrestore v hv r).symm
        _ = q w r * d r := by rw [hvw]
        _ = w r := hrestore w hw r
    have hR (v : Fin k → ℕ) (hv : v ∈ R) :
        (∀ r, 0 < v r) ∧ (∏ r, v r) ≤ X / (p * ℓ) := by
      obtain ⟨w, hw, rfl⟩ := Finset.mem_image.mp hv
      refine ⟨hqpos w hw, (Nat.le_div_iff_mul_le (Nat.mul_pos hp hℓ)).mpr ?_⟩
      exact (hqprod w hw).trans_le (hT w hw).2.1
    have hmap : ∀ v ∈ R, (∏ r, v r) ∈ Finset.Icc 1 (X / (p * ℓ)) := by
      intro v hv
      exact Finset.mem_Icc.mpr
        ⟨Finset.prod_pos (fun r _ => (hR v hv).1 r), (hR v hv).2⟩
    have hfiber (m : ℕ) :
        ((R.filter (fun v => (∏ r, v r) = m)).card : ℝ) ≤
          (m.divisors.card : ℝ) ^ k := by
      have hsubset : R.filter (fun v => (∏ r, v r) = m) ⊆
          Fintype.piFinset (fun _ : Fin k => m.divisors) := by
        intro v hv
        obtain ⟨hvR, hvm⟩ := Finset.mem_filter.mp hv
        apply Fintype.mem_piFinset.mpr
        intro r
        apply Nat.mem_divisors.mpr
        rw [← hvm]
        exact ⟨Finset.dvd_prod_of_mem v (Finset.mem_univ r),
          (Finset.prod_pos fun r _ => (hR v hvR).1 r).ne'⟩
      have hnat : (R.filter (fun v => (∏ r, v r) = m)).card ≤
          m.divisors.card ^ k := by
        simpa only [Fintype.card_piFinset, Finset.prod_const,
          Finset.card_univ, Fintype.card_fin] using Finset.card_le_card hsubset
      exact_mod_cast hnat
    calc
      (T.card : ℝ) = (R.card : ℝ) := by
        exact_mod_cast (Finset.card_image_of_injOn hinj).symm
      _ = ∑ m ∈ Finset.Icc 1 (X / (p * ℓ)),
          ((R.filter (fun v => (∏ r, v r) = m)).card : ℝ) := by
        exact_mod_cast Finset.card_eq_sum_card_fiberwise hmap
      _ ≤ _ := Finset.sum_le_sum fun m _ => hfiber m
  have hordered (a b : Fin k) (hab : a ≠ b)
      (f g : (Fin k → ℕ) → ℕ) (T : Finset (Fin k → ℕ))
      (hT : ∀ v ∈ T, (∀ r, 0 < v r) ∧ (∏ r, v r) ≤ X ∧
        f v ∣ v a ∧ g v ∣ v b ∧ Z < f v ∧ f v ≤ X ∧ f v ≤ g v ∧
        (g v : ℝ) ≤ (1 + h) * (f v : ℝ)) : (T.card : ℝ) ≤ C := by
    have hmapf : ∀ v ∈ T, f v ∈ Finset.Icc (Z + 1) X := by
      intro v hv
      exact Finset.mem_Icc.mpr ⟨(hT v hv).2.2.2.2.1, (hT v hv).2.2.2.2.2.1⟩
    have hfiber (p : ℕ) (hp : p ∈ Finset.Icc (Z + 1) X) :
        ((T.filter (fun v => f v = p)).card : ℝ) ≤
          ∑ ℓ ∈ Finset.Icc p ⌊(1 + h) * (p : ℝ)⌋₊,
            ∑ m ∈ Finset.Icc 1 (X / (p * ℓ)), (m.divisors.card : ℝ) ^ k := by
      have hmapg : ∀ v ∈ T.filter (fun v => f v = p),
          g v ∈ Finset.Icc p ⌊(1 + h) * (p : ℝ)⌋₊ := by
        intro v hv
        obtain ⟨hvT, hvp⟩ := Finset.mem_filter.mp hv
        obtain ⟨_, _, _, _, _, _, hfg, hband⟩ := hT v hvT
        rw [hvp] at hfg hband
        exact Finset.mem_Icc.mpr ⟨hfg, Nat.le_floor hband⟩
      calc
        _ = ∑ ℓ ∈ Finset.Icc p ⌊(1 + h) * (p : ℝ)⌋₊,
            (((T.filter (fun v => f v = p)).filter (fun v => g v = ℓ)).card : ℝ) := by
          exact_mod_cast Finset.card_eq_sum_card_fiberwise hmapg
        _ ≤ _ := by
          apply Finset.sum_le_sum
          intro ℓ hℓ
          have hp0 : 0 < p := lt_of_lt_of_le (by omega : 0 < Z + 1)
            (Finset.mem_Icc.mp hp).1
          have hℓ0 : 0 < ℓ := hp0.trans_le (Finset.mem_Icc.mp hℓ).1
          apply hquotient_count a b hab p ℓ hp0 hℓ0
          intro v hv
          obtain ⟨hvf, hvℓ⟩ := Finset.mem_filter.mp hv
          obtain ⟨hvT, hvp⟩ := Finset.mem_filter.mp hvf
          obtain ⟨hvpos, hvprod, hf, hg, _, _, _, _⟩ := hT v hvT
          exact ⟨hvpos, hvprod, hvp ▸ hf, hvℓ ▸ hg⟩
    calc
      (T.card : ℝ) = ∑ p ∈ Finset.Icc (Z + 1) X,
          ((T.filter (fun v => f v = p)).card : ℝ) := by
        exact_mod_cast Finset.card_eq_sum_card_fiberwise hmapf
      _ ≤ ∑ p ∈ Finset.Icc (Z + 1) X,
          ∑ ℓ ∈ Finset.Icc p ⌊(1 + h) * (p : ℝ)⌋₊,
            ∑ m ∈ Finset.Icc 1 (X / (p * ℓ)), (m.divisors.card : ℝ) ^ k :=
        Finset.sum_le_sum hfiber
      _ ≤ C := divisor_weighted_prime_feature_boundary_mass k Z X X hZ hX h hh
  let p : (Fin k → ℕ) → ℕ := fun v => (v i).minFac
  let ℓ : (Fin k → ℕ) → ℕ := fun v => max 1 ((v j).primeFactors.sup id)
  let S := (Fintype.piFinset (fun _ : Fin k => Finset.Icc 1 X)).filter
    (fun v => (∏ r, v r) ≤ X ∧ 1 < v i ∧ Z < min (p v) (ℓ v) ∧
      max (p v : ℝ) (ℓ v : ℝ) ≤ (1 + h) * min (p v : ℝ) (ℓ v : ℝ))
  change (S.card : ℝ) ≤ _
  have hdata (v : Fin k → ℕ) (hv : v ∈ S) :
      (∀ r, 0 < v r) ∧ (∏ r, v r) ≤ X ∧ p v ∣ v i ∧ ℓ v ∣ v j ∧
      Z < p v ∧ Z < ℓ v ∧ p v ≤ X ∧ ℓ v ≤ X ∧
      max (p v : ℝ) (ℓ v : ℝ) ≤ (1 + h) * min (p v : ℝ) (ℓ v : ℝ) := by
    obtain ⟨hvbox, hvprod, _, hvZ, hvband⟩ := Finset.mem_filter.mp hv
    have hvcoords := Fintype.mem_piFinset.mp hvbox
    have hvpos (r : Fin k) : 0 < v r := (Finset.mem_Icc.mp (hvcoords r)).1
    obtain ⟨hZp, hZℓ⟩ := lt_min_iff.mp hvZ
    have hpdvd : p v ∣ v i := Nat.minFac_dvd (v i)
    have hsupgt : 1 < (v j).primeFactors.sup id := by
      have hlarge : 1 < max 1 ((v j).primeFactors.sup id) := hZ.trans_lt hZℓ
      omega
    obtain ⟨q, hq, _⟩ := Finset.lt_sup_iff.mp hsupgt
    have hsupmem : (v j).primeFactors.sup id ∈ (v j).primeFactors := by
      simpa using (Finset.sup_mem_of_nonempty (f := id)
        (s := (v j).primeFactors) ⟨q, hq⟩)
    have hℓeq : ℓ v = (v j).primeFactors.sup id :=
      max_eq_right hsupgt.le
    have hℓdvd : ℓ v ∣ v j := by
      rw [hℓeq]
      exact Nat.dvd_of_mem_primeFactors hsupmem
    have hpX : p v ≤ X :=
      (Nat.le_of_dvd (hvpos i) hpdvd).trans (Finset.mem_Icc.mp (hvcoords i)).2
    have hℓX : ℓ v ≤ X :=
      (Nat.le_of_dvd (hvpos j) hℓdvd).trans (Finset.mem_Icc.mp (hvcoords j)).2
    exact ⟨hvpos, hvprod, hpdvd, hℓdvd, hZp, hZℓ, hpX, hℓX, hvband⟩
  let S₁ := S.filter (fun v => p v ≤ ℓ v)
  let S₂ := S.filter (fun v => ℓ v ≤ p v)
  have hS₁ : (S₁.card : ℝ) ≤ C := by
    apply hordered i j hij p ℓ S₁
    intro v hv
    obtain ⟨hvS, horder⟩ := Finset.mem_filter.mp hv
    obtain ⟨hvpos, hvprod, hpdvd, hℓdvd, hZp, _, hpX, _, hband⟩ := hdata v hvS
    have horderR : (p v : ℝ) ≤ (ℓ v : ℝ) := by exact_mod_cast horder
    exact ⟨hvpos, hvprod, hpdvd, hℓdvd, hZp, hpX, horder,
      by simpa only [max_eq_right horderR, min_eq_left horderR] using hband⟩
  have hS₂ : (S₂.card : ℝ) ≤ C := by
    apply hordered j i hij.symm ℓ p S₂
    intro v hv
    obtain ⟨hvS, horder⟩ := Finset.mem_filter.mp hv
    obtain ⟨hvpos, hvprod, hpdvd, hℓdvd, _, hZℓ, _, hℓX, hband⟩ := hdata v hvS
    have horderR : (ℓ v : ℝ) ≤ (p v : ℝ) := by exact_mod_cast horder
    exact ⟨hvpos, hvprod, hℓdvd, hpdvd, hZℓ, hℓX, horder,
      by simpa only [max_eq_left horderR, min_eq_right horderR] using hband⟩
  have hcover : S ⊆ S₁ ∪ S₂ := by
    intro v hv
    rcases le_total (p v) (ℓ v) with hvle | hvle
    · exact Finset.mem_union.mpr (Or.inl (Finset.mem_filter.mpr ⟨hv, hvle⟩))
    · exact Finset.mem_union.mpr (Or.inr (Finset.mem_filter.mpr ⟨hv, hvle⟩))
  have hcard : (S.card : ℝ) ≤ (S₁.card : ℝ) + (S₂.card : ℝ) := by
    exact_mod_cast (Finset.card_le_card hcover).trans (Finset.card_union_le S₁ S₂)
  calc
    (S.card : ℝ) ≤ C + C := hcard.trans (add_le_add hS₁ hS₂)
    _ = _ := by dsimp [C]; ring

theorem short_relative_divisor_mass_log_saving
    (η γ : ℝ) (hη : 0 < η) (hγ : 0 < γ) (hηγ : η ≤ γ)
    (k : ℕ) (A : ℝ) (hA : 0 < A) :
    ∃ D : ℕ, 1 ≤ D ∧ ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ T : ℝ, x ^ η ≤ T → T ≤ x ^ γ →
        let h : ℝ := (Real.log x) ^ (-(D : ℝ))
        ∀ S : Finset ℕ,
          (∀ m ∈ S, T / (1 + h) ^ 2 ≤ (m : ℝ) ∧
            (m : ℝ) ≤ T * (1 + h) ^ 2) →
          (∑ m ∈ S, (m.divisors.card : ℝ) ^ k) ≤
            K * T / (Real.log x) ^ A := by
  classical
  obtain ⟨D₀, hD₀, K, X₀, hK, hX₀, hshort⟩ :=
    short_interval_divisor_mass_log_saving η γ hη hγ hηγ k 4 A (by norm_num) hA
  obtain ⟨X₁, hX₁⟩ := Filter.eventually_atTop.1
    (isLittleO_log_rpow_rpow_atTop (((D₀ + 1 : ℕ) : ℝ)) hη).eventuallyLE
  let D : ℕ := D₀ + 4
  refine ⟨D, by dsimp only [D]; omega, K, max X₀ (max (Real.exp 2) X₁),
    hK, hX₀.trans (le_max_left _ _), ?_⟩
  intro x hx T hTlo hThi h S hS
  have hx₀ : X₀ ≤ x := (le_max_left _ _).trans hx
  have hxrest : max (Real.exp 2) X₁ ≤ x := (le_max_right _ _).trans hx
  have hx₂ : Real.exp 2 ≤ x := (le_max_left _ _).trans hxrest
  have hx₁ : X₁ ≤ x := (le_max_right _ _).trans hxrest
  have hxpos : 0 < x := (Real.exp_pos 2).trans_le hx₂
  let L : ℝ := Real.log x
  have hLtwo : 2 ≤ L := (Real.le_log_iff_exp_le hxpos).mpr hx₂
  have hLone : 1 ≤ L := one_le_two.trans hLtwo
  have hLpos : 0 < L := zero_lt_one.trans_le hLone
  have hTpos : 0 < T := (Real.rpow_pos_of_pos hxpos η).trans_le hTlo
  have hpower : L ^ (D₀ + 1) ≤ x ^ η := by
    simpa only [L, Real.rpow_natCast,
      Real.norm_of_nonneg (pow_nonneg hLpos.le _),
      Real.norm_of_nonneg (Real.rpow_nonneg hxpos.le _)] using hX₁ x hx₁
  have hendpoint : 2 * L ^ D₀ ≤ T := by
    calc
      2 * L ^ D₀ ≤ L * L ^ D₀ :=
        mul_le_mul_of_nonneg_right hLtwo (pow_nonneg hLpos.le _)
      _ = L ^ (D₀ + 1) := (pow_succ' L D₀).symm
      _ ≤ x ^ η := hpower
      _ ≤ T := hTlo
  have hTfour : 4 ≤ T := by
    have hLp : L ≤ L ^ D₀ := le_self_pow₀ hLone (by omega)
    linarith only [hLtwo, hLp, hendpoint]
  have hhpos : 0 < h := Real.rpow_pos_of_pos hLpos _
  have hh : 0 ≤ h := hhpos.le
  have hhone : h ≤ 1 :=
    Real.rpow_le_one_of_one_le_of_nonpos hLone (neg_nonpos.mpr (Nat.cast_nonneg D))
  have hhEq : h = 1 / L ^ (D₀ + 4) := by
    simp only [h, D, L, Real.rpow_neg (zero_le_one.trans hLone),
      Real.rpow_natCast, one_div]
  have hratioPos : 0 < (1 + h) ^ 2 := by positivity
  have hratioOne : 1 ≤ (1 + h) ^ 2 :=
    one_le_pow₀ (le_add_of_nonneg_right hh)
  have hratioFour : (1 + h) ^ 2 ≤ 4 := by
    have hb : 1 + h ≤ 2 := by linarith only [hhone]
    simpa only [show (2 : ℝ) ^ (2 : ℕ) = 4 by norm_num] using
      pow_le_pow_left₀ (add_nonneg zero_le_one hh) hb 2
  let loR : ℝ := T / (1 + h) ^ 2
  let hiR : ℝ := T * (1 + h) ^ 2
  have hloR : 1 ≤ loR := by
    apply (le_div_iff₀ hratioPos).2
    simpa only [one_mul] using hratioFour.trans hTfour
  have hhiR : 0 ≤ hiR := mul_nonneg hTpos.le hratioPos.le
  have hhiFour : hiR ≤ 4 * T :=
    (mul_le_mul_of_nonneg_left hratioFour hTpos.le).trans_eq (mul_comm T 4)
  have hlohiR : loR ≤ hiR :=
    (div_le_self hTpos.le hratioOne).trans
      (le_mul_of_one_le_right hTpos.le hratioOne)
  have hwidthR : hiR - loR ≤ 8 * T * h := by
    have hhsq : h ^ 2 ≤ h := by
      nlinarith only [mul_nonneg hh (sub_nonneg.mpr hhone)]
    have hinv : 1 - 2 * h ≤ 1 / (1 + h) ^ 2 := by
      apply (le_div_iff₀ hratioPos).2
      have hcubic : 0 ≤ h ^ 2 * h := mul_nonneg (sq_nonneg h) hh
      nlinarith only [sq_nonneg h, hcubic]
    have hlower : T * (1 - 2 * h) ≤ loR := by
      calc
        T * (1 - 2 * h) ≤ T * (1 / (1 + h) ^ 2) :=
          mul_le_mul_of_nonneg_left hinv hTpos.le
        _ = loR := by dsimp only [loR]; ring
    have hupper : hiR ≤ T * (1 + 3 * h) :=
      mul_le_mul_of_nonneg_left (by nlinarith only [hhsq]) hTpos.le
    have hTh : 0 ≤ T * h := mul_nonneg hTpos.le hh
    nlinarith only [hlower, hupper, hTh]
  let lo : ℕ := ⌈loR⌉₊
  let hi : ℕ := ⌊hiR⌋₊ + 1
  have hlo : 1 ≤ lo := by exact_mod_cast hloR.trans (Nat.le_ceil loR)
  have hlohi : lo ≤ hi :=
    (Nat.ceil_mono hlohiR).trans (Nat.ceil_le_floor_add_one hiR)
  have hhi : hi ≤ ⌈4 * T⌉₊ + 1 :=
    Nat.add_le_add_right (Nat.floor_le_of_le (hhiFour.trans (Nat.le_ceil (4 * T)))) 1
  have hwidthNat : ((hi - lo : ℕ) : ℝ) ≤ hiR - loR + 1 := by
    rw [Nat.cast_sub hlohi]
    change ((⌊hiR⌋₊ + 1 : ℕ) : ℝ) - (⌈loR⌉₊ : ℝ) ≤ hiR - loR + 1
    push_cast
    have hl := Nat.le_ceil loR
    have hu := Nat.floor_le hhiR
    linarith only [hl, hu]
  have hLfour : (16 : ℝ) ≤ L ^ 4 := by
    exact (by norm_num : (16 : ℝ) = 2 ^ 4).trans_le
      (pow_le_pow_left₀ zero_le_two hLtwo 4)
  have hwidthMain : 8 * T * h ≤ T / (2 * L ^ D₀) := by
    have hr : 8 / L ^ 4 ≤ (1 / 2 : ℝ) :=
      (div_le_iff₀ (pow_pos hLpos 4)).2 (by linarith only [hLfour])
    calc
      8 * T * h = (T / L ^ D₀) * (8 / L ^ 4) := by
        rw [hhEq, pow_add]
        simp only [div_eq_mul_inv, mul_inv_rev]
        ring
      _ ≤ (T / L ^ D₀) * (1 / 2) :=
        mul_le_mul_of_nonneg_left hr (div_nonneg hTpos.le (pow_nonneg hLpos.le _))
      _ = T / (2 * L ^ D₀) := by rw [div_mul_eq_div_div]; ring
  have hendpointOne : 1 ≤ T / (2 * L ^ D₀) :=
    (le_div_iff₀ (mul_pos zero_lt_two (pow_pos hLpos _))).2 (by simpa using hendpoint)
  have hwidth : ((hi - lo : ℕ) : ℝ) ≤ T / (Real.log x) ^ D₀ := by
    calc
      _ ≤ hiR - loR + 1 := hwidthNat
      _ ≤ 8 * T * h + 1 := by linarith only [hwidthR]
      _ ≤ T / (2 * L ^ D₀) + T / (2 * L ^ D₀) := add_le_add hwidthMain hendpointOne
      _ = T / (Real.log x) ^ D₀ := by
        dsimp only [L]
        simp only [div_mul_eq_div_div]
        ring
  have hsubset : S ⊆ Finset.Ico lo hi := by
    intro m hm
    exact Finset.mem_Ico.mpr
      ⟨Nat.ceil_le.mpr (hS m hm).1, Nat.lt_succ_of_le (Nat.le_floor (hS m hm).2)⟩
  calc
    _ ≤ ∑ m ∈ Finset.Ico lo hi, (m.divisors.card : ℝ) ^ k :=
      Finset.sum_le_sum_of_subset_of_nonneg hsubset
        (fun m _ _ => pow_nonneg (Nat.cast_nonneg _) _)
    _ ≤ K * T / (Real.log x) ^ A :=
      hshort x hx₀ T hTlo hThi lo hi hlo hlohi hhi hwidth

theorem product_feature_boundary_mass_log_saving
    (k R : ℕ) (_hk : 1 ≤ k)
    (η γ : ℝ) (hη : 0 < η) (hγ : 0 < γ) (hηγ : η ≤ γ)
    (A : ℝ) (hA : 0 < A) :
    ∃ D : ℕ, 1 ≤ D ∧ ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ T : ℝ, x ^ η ≤ T → T ≤ x ^ γ →
        let h : ℝ := (Real.log x) ^ (-(D : ℝ))
        (∑ t ∈ Fintype.piFinset (fun _ : Fin k => Finset.Icc 1 ⌊2 * x⌋₊),
          ∑ u ∈ Finset.Icc 1 ⌊2 * x⌋₊,
            if T / (1 + h) ^ 2 ≤ ((∏ j, t j : ℕ) : ℝ) ∧
                ((∏ j, t j : ℕ) : ℝ) ≤ T * (1 + h) ^ 2 ∧
                (∏ j, t j) * u ≤ ⌊2 * x⌋₊ then
              (u.divisors.card : ℝ) ^ R else 0) ≤
          K * x / (Real.log x) ^ A := by
  classical
  have hfinite :
      ∀ (k R N : ℕ) (S : Finset ℕ), (∀ m ∈ S, 0 < m) →
        (∑ t ∈ Fintype.piFinset (fun _ : Fin k => Finset.Icc 1 N),
          ∑ u ∈ Finset.Icc 1 N,
            if (∏ j, t j) ∈ S ∧ (∏ j, t j) * u ≤ N then
              (u.divisors.card : ℝ) ^ R else 0) ≤
          (N : ℝ) * (1 + Real.log (N : ℝ)) ^ (2 ^ R - 1) *
            ∑ m ∈ S, (m.divisors.card : ℝ) ^ k / (m : ℝ) := by
    intro k R N S hS
    classical
    by_cases hNzero : N = 0
    · subst N
      simp
    have hN : 1 ≤ N := Nat.one_le_iff_ne_zero.mpr hNzero
    let U := Fintype.piFinset (fun _ : Fin k => Finset.Icc 1 N)
    let p : (Fin k → ℕ) → ℕ := fun t => ∏ j, t j
    let T := U.filter (fun t => p t ∈ S)
    let W : ℕ → ℝ := fun m => ∑ u ∈ Finset.Icc 1 N,
      if m * u ≤ N then (u.divisors.card : ℝ) ^ R else 0
    let C : ℝ := (N : ℝ) * (1 + Real.log (N : ℝ)) ^ (2 ^ R - 1)
    have hlogN : 0 ≤ Real.log (N : ℝ) :=
      Real.log_nonneg (by exact_mod_cast hN)
    have hC : 0 ≤ C := by dsimp [C]; positivity
    have hWnonneg (m : ℕ) : 0 ≤ W m := by
      apply Finset.sum_nonneg
      intro u _
      split_ifs <;> positivity
    have hinner (m : ℕ) (hm : 0 < m) : W m ≤ C / (m : ℝ) := by
      have hfilter : (Finset.Icc 1 N).filter (fun u => m * u ≤ N) =
          Finset.Icc 1 (N / m) := by
        ext u
        simp only [Finset.mem_filter, Finset.mem_Icc]
        constructor
        · rintro ⟨⟨hu1, _⟩, hmu⟩
          refine ⟨hu1, (Nat.le_div_iff_mul_le hm).mpr ?_⟩
          simpa only [Nat.mul_comm] using hmu
        · rintro ⟨hu1, huq⟩
          refine ⟨⟨hu1, huq.trans (Nat.div_le_self N m)⟩, ?_⟩
          simpa only [Nat.mul_comm] using (Nat.le_div_iff_mul_le hm).mp huq
      dsimp only [W]
      rw [← Finset.sum_filter, hfilter]
      by_cases hzero : N / m = 0
      · rw [hzero, Finset.Icc_eq_empty_of_lt (by omega : (0 : ℕ) < 1),
          Finset.sum_empty]
        exact div_nonneg hC (Nat.cast_nonneg m)
      · have hquotient : (1 : ℝ) ≤ ((N / m : ℕ) : ℝ) := by
          exact_mod_cast Nat.one_le_iff_ne_zero.mpr hzero
        have hlogquotient : 0 ≤ Real.log ((N / m : ℕ) : ℝ) :=
          Real.log_nonneg hquotient
        have hlogle : Real.log ((N / m : ℕ) : ℝ) ≤ Real.log (N : ℝ) :=
          Real.log_le_log (by linarith) (by exact_mod_cast Nat.div_le_self N m)
        calc
          _ ≤ ((N / m : ℕ) : ℝ) *
              (1 + Real.log ((N / m : ℕ) : ℝ)) ^ (2 ^ R - 1) :=
            sum_card_divisors_pow_le_mul_log_pow R (N / m)
          _ ≤ ((N / m : ℕ) : ℝ) *
              (1 + Real.log (N : ℝ)) ^ (2 ^ R - 1) :=
            mul_le_mul_of_nonneg_left
              (pow_le_pow_left₀ (by linarith)
                (show 1 + Real.log ((N / m : ℕ) : ℝ) ≤ 1 + Real.log (N : ℝ) by
                  linarith only [hlogle]) _)
              (Nat.cast_nonneg (N / m))
          _ ≤ ((N : ℝ) / (m : ℝ)) *
              (1 + Real.log (N : ℝ)) ^ (2 ^ R - 1) :=
            mul_le_mul_of_nonneg_right Nat.cast_div_le (by positivity)
          _ = C / (m : ℝ) := by dsimp [C]; ring
    have hmap : ∀ t ∈ T, p t ∈ S := fun t ht => (Finset.mem_filter.mp ht).2
    have hfiber (m : ℕ) :
        (T.filter (fun t => p t = m)).card ≤ m.divisors.card ^ k := by
      have hsubset : T.filter (fun t => p t = m) ⊆
          Fintype.piFinset (fun _ : Fin k => m.divisors) := by
        intro t ht
        obtain ⟨htT, htm⟩ := Finset.mem_filter.mp ht
        apply Fintype.mem_piFinset.mpr
        intro j
        apply Nat.mem_divisors.mpr
        constructor
        · rw [← htm]
          exact Finset.dvd_prod_of_mem t (Finset.mem_univ j)
        · rw [← htm]
          exact (hS (p t) (hmap t htT)).ne'
      simpa only [Fintype.card_piFinset, Finset.prod_const, Finset.card_univ,
        Fintype.card_fin] using Finset.card_le_card hsubset
    have houter :
        (∑ t ∈ U, ∑ u ∈ Finset.Icc 1 N,
          if p t ∈ S ∧ p t * u ≤ N then (u.divisors.card : ℝ) ^ R else 0) =
          ∑ t ∈ T, W (p t) := by
      dsimp only [T]
      rw [Finset.sum_filter]
      apply Finset.sum_congr rfl
      intro t _
      by_cases ht : p t ∈ S <;> simp [W, ht]
    have hregroup : (∑ t ∈ T, W (p t)) =
        ∑ m ∈ S, ((T.filter (fun t => p t = m)).card : ℝ) * W m := by
      rw [← Finset.sum_fiberwise_of_maps_to' hmap W]
      simp only [Finset.sum_const, nsmul_eq_mul]
    change (∑ t ∈ U, ∑ u ∈ Finset.Icc 1 N,
      if p t ∈ S ∧ p t * u ≤ N then (u.divisors.card : ℝ) ^ R else 0) ≤
        C * ∑ m ∈ S, (m.divisors.card : ℝ) ^ k / (m : ℝ)
    calc
      _ = ∑ m ∈ S, ((T.filter (fun t => p t = m)).card : ℝ) * W m :=
        houter.trans hregroup
      _ ≤ ∑ m ∈ S, C * ((m.divisors.card : ℝ) ^ k / (m : ℝ)) := by
        apply Finset.sum_le_sum
        intro m hm
        have hfiberReal : ((T.filter (fun t => p t = m)).card : ℝ) ≤
            (m.divisors.card : ℝ) ^ k := by exact_mod_cast hfiber m
        calc
          _ ≤ (m.divisors.card : ℝ) ^ k * (C / (m : ℝ)) :=
            mul_le_mul hfiberReal (hinner m (hS m hm)) (hWnonneg m)
              (pow_nonneg (Nat.cast_nonneg _) _)
          _ = C * ((m.divisors.card : ℝ) ^ k / (m : ℝ)) := by ring
      _ = _ := by rw [Finset.mul_sum]
  let P : ℕ := 2 ^ R - 1
  let B : ℝ := A + (P : ℝ)
  have hB : 0 < B := add_pos_of_pos_of_nonneg hA (Nat.cast_nonneg P)
  obtain ⟨D, hD, K₀, X, hK₀, hX, hmass⟩ :=
    short_relative_divisor_mass_log_saving η γ hη hγ hηγ k B hB
  refine ⟨D, hD, 8 * (3 : ℝ) ^ P * K₀, X, by positivity, hX, ?_⟩
  intro x hx T hTlo hThi h
  have hxexp : Real.exp 1 ≤ x := hX.trans hx
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hxone : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hxexp
  have hlog : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxpos).mpr hxexp
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlog
  have hTpos : 0 < T := (Real.rpow_pos_of_pos hxpos η).trans_le hTlo
  have hh : 0 ≤ h := Real.rpow_nonneg hlogpos.le _
  have hhone : h ≤ 1 :=
    Real.rpow_le_one_of_one_le_of_nonpos hlog (neg_nonpos.mpr (Nat.cast_nonneg D))
  have hratioPos : 0 < (1 + h) ^ 2 := by positivity
  have hratioFour : (1 + h) ^ 2 ≤ 4 := by
    have hb : 1 + h ≤ 2 := by linarith only [hhone]
    simpa only [show (2 : ℝ) ^ (2 : ℕ) = 4 by norm_num] using
      pow_le_pow_left₀ (add_nonneg zero_le_one hh) hb 2
  let N : ℕ := ⌊2 * x⌋₊
  have hN : 1 ≤ N := Nat.le_floor (show ((1 : ℕ) : ℝ) ≤ 2 * x from by
    simpa only [Nat.cast_one] using (show (1 : ℝ) ≤ 2 * x by linarith only [hxone]))
  have hNpos : (0 : ℝ) < N := by exact_mod_cast hN
  have hNupper : (N : ℝ) ≤ 2 * x := Nat.floor_le (by positivity)
  let S : Finset ℕ := (Finset.Icc 1 N).filter (fun m =>
    T / (1 + h) ^ 2 ≤ (m : ℝ) ∧ (m : ℝ) ≤ T * (1 + h) ^ 2)
  have hSpos (m : ℕ) (hm : m ∈ S) : 0 < m :=
    (Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1).1
  have hSband (m : ℕ) (hm : m ∈ S) :
      T / (1 + h) ^ 2 ≤ (m : ℝ) ∧ (m : ℝ) ≤ T * (1 + h) ^ 2 :=
    (Finset.mem_filter.mp hm).2
  have hSquarter (m : ℕ) (hm : m ∈ S) : T / 4 ≤ (m : ℝ) :=
    (div_le_div_of_nonneg_left hTpos.le hratioPos hratioFour).trans (hSband m hm).1
  have hSmass : (∑ m ∈ S, (m.divisors.card : ℝ) ^ k) ≤
      K₀ * T / (Real.log x) ^ B := hmass x hx T hTlo hThi S hSband
  have hreciprocal :
      (∑ m ∈ S, (m.divisors.card : ℝ) ^ k / (m : ℝ)) ≤
        4 * K₀ / (Real.log x) ^ B := by
    calc
      _ ≤ ∑ m ∈ S, (4 / T) * (m.divisors.card : ℝ) ^ k := by
        apply Finset.sum_le_sum
        intro m hm
        calc
          (m.divisors.card : ℝ) ^ k / (m : ℝ) ≤
              (m.divisors.card : ℝ) ^ k / (T / 4) :=
            div_le_div_of_nonneg_left (pow_nonneg (Nat.cast_nonneg _) _)
              (div_pos hTpos (by norm_num)) (hSquarter m hm)
          _ = (4 / T) * (m.divisors.card : ℝ) ^ k := by
            field_simp [hTpos.ne']
      _ = (4 / T) * ∑ m ∈ S, (m.divisors.card : ℝ) ^ k := (Finset.mul_sum ..).symm
      _ ≤ (4 / T) * (K₀ * T / (Real.log x) ^ B) :=
        mul_le_mul_of_nonneg_left hSmass (div_nonneg (by norm_num) hTpos.le)
      _ = 4 * K₀ / (Real.log x) ^ B := by
        field_simp [hTpos.ne', (Real.rpow_pos_of_pos hlogpos B).ne']
  have hlogNnonneg : 0 ≤ 1 + Real.log (N : ℝ) :=
    add_nonneg zero_le_one (Real.log_natCast_nonneg N)
  have hlogN : 1 + Real.log (N : ℝ) ≤ 3 * Real.log x := by
    have hn := Real.log_le_log hNpos hNupper
    rw [Real.log_mul two_ne_zero hxpos.ne'] at hn
    have htwo := Real.log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2)
    linarith only [hn, htwo, hlog]
  have hmoment : (N : ℝ) * (1 + Real.log (N : ℝ)) ^ P ≤
      2 * (3 : ℝ) ^ P * x * (Real.log x) ^ P := by
    calc
      _ ≤ (2 * x) * (3 * Real.log x) ^ P :=
        mul_le_mul hNupper (pow_le_pow_left₀ hlogNnonneg hlogN P)
          (pow_nonneg hlogNnonneg _) (by positivity)
      _ = _ := by rw [mul_pow]; ring
  have hcancel : (Real.log x) ^ P / (Real.log x) ^ B =
      1 / (Real.log x) ^ A := by
    dsimp only [B]
    rw [Real.rpow_add hlogpos, Real.rpow_natCast]
    simpa only [one_mul] using mul_div_mul_right (1 : ℝ)
      ((Real.log x) ^ A) (pow_ne_zero P hlogpos.ne')
  have hexact :
      (∑ t ∈ Fintype.piFinset (fun _ : Fin k => Finset.Icc 1 N),
        ∑ u ∈ Finset.Icc 1 N,
          if T / (1 + h) ^ 2 ≤ ((∏ j, t j : ℕ) : ℝ) ∧
              ((∏ j, t j : ℕ) : ℝ) ≤ T * (1 + h) ^ 2 ∧
              (∏ j, t j) * u ≤ N then (u.divisors.card : ℝ) ^ R else 0) =
      ∑ t ∈ Fintype.piFinset (fun _ : Fin k => Finset.Icc 1 N),
        ∑ u ∈ Finset.Icc 1 N,
          if (∏ j, t j) ∈ S ∧ (∏ j, t j) * u ≤ N then
            (u.divisors.card : ℝ) ^ R else 0 := by
    apply Finset.sum_congr rfl
    intro t ht
    apply Finset.sum_congr rfl
    intro u hu
    have htpos (j : Fin k) : 0 < t j :=
      (Finset.mem_Icc.mp (Fintype.mem_piFinset.mp ht j)).1
    have hp : 0 < ∏ j, t j := Finset.prod_pos fun j _ => htpos j
    have huone : 1 ≤ u := (Finset.mem_Icc.mp hu).1
    have hcond :
        (T / (1 + h) ^ 2 ≤ ((∏ j, t j : ℕ) : ℝ) ∧
          ((∏ j, t j : ℕ) : ℝ) ≤ T * (1 + h) ^ 2 ∧ (∏ j, t j) * u ≤ N) ↔
        ((∏ j, t j) ∈ S ∧ (∏ j, t j) * u ≤ N) := by
      constructor
      · rintro ⟨hlo, hhi, hprod⟩
        exact ⟨Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr ⟨hp,
          (le_mul_of_one_le_right (Nat.zero_le _) huone).trans hprod⟩, hlo, hhi⟩, hprod⟩
      · rintro ⟨hm, hprod⟩
        exact ⟨(hSband _ hm).1, (hSband _ hm).2, hprod⟩
    simp only [hcond]
  change (∑ t ∈ Fintype.piFinset (fun _ : Fin k => Finset.Icc 1 N),
    ∑ u ∈ Finset.Icc 1 N,
      if T / (1 + h) ^ 2 ≤ ((∏ j, t j : ℕ) : ℝ) ∧
          ((∏ j, t j : ℕ) : ℝ) ≤ T * (1 + h) ^ 2 ∧
          (∏ j, t j) * u ≤ N then (u.divisors.card : ℝ) ^ R else 0) ≤
    (8 * (3 : ℝ) ^ P * K₀) * x / (Real.log x) ^ A
  calc
    _ = ∑ t ∈ Fintype.piFinset (fun _ : Fin k => Finset.Icc 1 N),
        ∑ u ∈ Finset.Icc 1 N,
          if (∏ j, t j) ∈ S ∧ (∏ j, t j) * u ≤ N then
            (u.divisors.card : ℝ) ^ R else 0 := hexact
    _ ≤ (N : ℝ) * (1 + Real.log (N : ℝ)) ^ P *
        ∑ m ∈ S, (m.divisors.card : ℝ) ^ k / (m : ℝ) :=
      hfinite k R N S hSpos
    _ ≤ (2 * (3 : ℝ) ^ P * x * (Real.log x) ^ P) *
        (4 * K₀ / (Real.log x) ^ B) :=
      mul_le_mul hmoment hreciprocal
        (Finset.sum_nonneg fun m _ =>
          div_nonneg (pow_nonneg (Nat.cast_nonneg _) _) (Nat.cast_nonneg m))
        (by positivity)
    _ = (8 * (3 : ℝ) ^ P * K₀) * x *
        ((Real.log x) ^ P / (Real.log x) ^ B) := by ring
    _ = (8 * (3 : ℝ) ^ P * K₀) * x / (Real.log x) ^ A := by rw [hcancel]; ring

theorem harman_feature_boundary_full_cell_cover
    (l : Fin 6) (T0 x B h : ℝ) (hh : 0 ≤ h)
    (L : ℕ) (b : ℕ → ℕ) (lo hi : ℕ → ℝ)
    (hlow : ∀ n, b n ≤ L ↔ n ≤ L)
    (hsingleton : ∀ n, n ≤ L → b n = n)
    (horder : ∀ n m, b n < b m → n < m)
    (hdiameter : ∀ n m, 1 ≤ n → 1 ≤ m → L < b n → b n = b m →
      |(n : ℝ) - m| ≤ h * lo (b n))
    (hends : ∀ n, 1 ≤ n → lo (b n) ≤ (n : ℝ) ∧
      (n : ℝ) ≤ (if b n ≤ L then lo (b n) else hi (b n)) ∧
      (if b n ≤ L then lo (b n) else hi (b n)) ≤ (1 + h) * lo (b n))
    (g bad v : Fin 7 → ℕ)
    (hgpos : ∀ r, 1 ≤ g r) (hbadpos : ∀ r, 1 ≤ bad r) (hvpos : ∀ r, 1 ≤ v r)
    (hgb : ∀ r, b (g r) = b (bad r)) (hgv : ∀ r, b (g r) = b (v r)) :
    let Good : (Fin 7 → ℕ) → Prop := fun f =>
      f 5 < f 1 ∧ T0 < ((f 0 * f 4 : ℕ) : ℝ) ∧
      x ≤ ((f 0 * f 3 : ℕ) : ℝ) ∧ ((f 0 * f 3 : ℕ) : ℝ) ≤ 2 * x ∧
      match l.val with
      | 2 => f 6 < f 2 ∧ ((f 2 * f 6 : ℕ) : ℝ) < x ^ ((40481 : ℝ) / 100000)
      | 3 => f 6 < f 2 ∧ B < ((f 2 * f 6 : ℕ) : ℝ)
      | 4 => f 6 < f 2
      | 5 => f 2 < f 6
      | _ => True
    Good g → ¬Good bad →
      (L < min (v 5) (v 1) ∧
        ((max (v 5) (v 1) : ℕ) : ℝ) ≤ (1 + h) * ((min (v 5) (v 1) : ℕ) : ℝ)) ∨
      (T0 / (1 + h) ^ 2 ≤ ((v 0 * v 4 : ℕ) : ℝ) ∧
        ((v 0 * v 4 : ℕ) : ℝ) ≤ T0 * (1 + h) ^ 2) ∨
      (x / (1 + h) ^ 2 ≤ ((v 0 * v 3 : ℕ) : ℝ) ∧
        ((v 0 * v 3 : ℕ) : ℝ) ≤ x * (1 + h) ^ 2) ∨
      ((2 * x) / (1 + h) ^ 2 ≤ ((v 0 * v 3 : ℕ) : ℝ) ∧
        ((v 0 * v 3 : ℕ) : ℝ) ≤ (2 * x) * (1 + h) ^ 2) ∨
      (L < min (v 2) (v 6) ∧
        ((max (v 2) (v 6) : ℕ) : ℝ) ≤ (1 + h) * ((min (v 2) (v 6) : ℕ) : ℝ)) ∨
      (x ^ ((40481 : ℝ) / 100000) / (1 + h) ^ 2 ≤ ((v 2 * v 6 : ℕ) : ℝ) ∧
        ((v 2 * v 6 : ℕ) : ℝ) ≤ x ^ ((40481 : ℝ) / 100000) * (1 + h) ^ 2) ∨
      (B / (1 + h) ^ 2 ≤ ((v 2 * v 6 : ℕ) : ℝ) ∧
        ((v 2 * v 6 : ℕ) : ℝ) ≤ B * (1 + h) ^ 2) := by
  let u : ℕ → ℝ := fun q => if q ≤ L then lo q else hi q
  have hgends (r : Fin 7) : lo (b (g r)) ≤ (g r : ℝ) ∧
      (g r : ℝ) ≤ u (b (g r)) ∧ u (b (g r)) ≤ (1 + h) * lo (b (g r)) :=
    hends (g r) (hgpos r)
  have hbends (r : Fin 7) : lo (b (g r)) ≤ (bad r : ℝ) ∧
      (bad r : ℝ) ≤ u (b (g r)) ∧ u (b (g r)) ≤ (1 + h) * lo (b (g r)) := by
    rw [hgb r]
    exact hends (bad r) (hbadpos r)
  have hvends (r : Fin 7) : lo (b (g r)) ≤ (v r : ℝ) ∧
      (v r : ℝ) ≤ u (b (g r)) ∧ u (b (g r)) ≤ (1 + h) * lo (b (g r)) := by
    rw [hgv r]
    exact hends (v r) (hvpos r)
  have hlo0 (r : Fin 7) : 0 ≤ lo (b (g r)) := by
    have hgpositive : (0 : ℝ) < g r := by exact_mod_cast hgpos r
    have hmulpositive : 0 < (1 + h) * lo (b (g r)) :=
      hgpositive.trans_le ((hgends r).2.1.trans (hgends r).2.2)
    exact (pos_of_mul_pos_right hmulpositive (by positivity : (0 : ℝ) ≤ 1 + h)).le
  have hcomparison (a c : Fin 7) (hgood : g a < g c) (hbad : ¬bad a < bad c) :
      L < min (v a) (v c) ∧
        ((max (v a) (v c) : ℕ) : ℝ) ≤
          (1 + h) * ((min (v a) (v c) : ℕ) : ℝ) := by
    rcases (harman_strict_comparison_cells L b hlow hsingleton horder
      (g a) (g c)).mp hgood with hbetween | ⟨hhigh, heq, _⟩
    · have hbadbetween : b (bad a) < b (bad c) := by
        simpa only [hgb a, hgb c] using hbetween
      exact (hbad (horder (bad a) (bad c) hbadbetween)).elim
    · have hvhigh : L < b (v a) := by simpa only [hgv a] using hhigh
      have hveq : b (v a) = b (v c) := by simpa only [hgv a, hgv c] using heq
      exact harman_same_high_cell_comparison_band L b lo h hh hlow
        (fun n hn => (hends n hn).1) hdiameter (v a) (v c)
        (hvpos a) (hvpos c) hvhigh hveq
  have hproduct (a c : Fin 7) (T : ℝ)
      (hcross :
        (((g a * g c : ℕ) : ℝ) < T ∧ T ≤ ((bad a * bad c : ℕ) : ℝ)) ∨
        (((g a * g c : ℕ) : ℝ) ≤ T ∧ T < ((bad a * bad c : ℕ) : ℝ)) ∨
        (((bad a * bad c : ℕ) : ℝ) < T ∧ T ≤ ((g a * g c : ℕ) : ℝ)) ∨
        (((bad a * bad c : ℕ) : ℝ) ≤ T ∧ T < ((g a * g c : ℕ) : ℝ))) :
      T / (1 + h) ^ 2 ≤ ((v a * v c : ℕ) : ℝ) ∧
        ((v a * v c : ℕ) : ℝ) ≤ T * (1 + h) ^ 2 := by
    have hstraddle : lo (b (g a)) * lo (b (g c)) ≤ T ∧
        T ≤ u (b (g a)) * u (b (g c)) := by
      simp only [Nat.cast_mul] at hcross
      rw [← or_assoc] at hcross
      rcases hcross with hcross | hcross
      · exact harman_product_comparison_crossing T
          (lo (b (g a))) (u (b (g a))) (lo (b (g c))) (u (b (g c)))
          (g a) (g c) (bad a) (bad c) (hlo0 a) (hlo0 c)
          ⟨(hgends a).1, (hgends a).2.1⟩ ⟨(hgends c).1, (hgends c).2.1⟩
          ⟨(hbends a).1, (hbends a).2.1⟩ ⟨(hbends c).1, (hbends c).2.1⟩ hcross
      · exact harman_product_comparison_crossing T
          (lo (b (g a))) (u (b (g a))) (lo (b (g c))) (u (b (g c)))
          (bad a) (bad c) (g a) (g c) (hlo0 a) (hlo0 c)
          ⟨(hbends a).1, (hbends a).2.1⟩ ⟨(hbends c).1, (hbends c).2.1⟩
          ⟨(hgends a).1, (hgends a).2.1⟩ ⟨(hgends c).1, (hgends c).2.1⟩ hcross
    simpa only [Nat.cast_mul] using
      (harman_product_threshold_full_box_band h T
        (lo (b (g a))) (u (b (g a))) (lo (b (g c))) (u (b (g c)))
        (v a) (v c) hh (hlo0 a) (hlo0 c)
        ⟨(hvends a).1, (hvends a).2.1⟩ ⟨(hvends c).1, (hvends c).2.1⟩
        (hvends a).2.2 (hvends c).2.2 hstraddle)
  dsimp only
  rintro ⟨hgp, hgT0, hgxlow, hgxhigh, hgextra⟩ hbad
  simp only [not_and_or] at hbad
  rcases hbad with hbad | hbad | hbad | hbad | hbad
  · exact Or.inl (hcomparison 5 1 hgp hbad)
  · exact Or.inr (Or.inl (hproduct 0 4 T0
      (Or.inr (Or.inr (Or.inr ⟨le_of_not_gt hbad, hgT0⟩)))))
  · exact Or.inr (Or.inr (Or.inl (hproduct 0 3 x
      (Or.inr (Or.inr (Or.inl ⟨lt_of_not_ge hbad, hgxlow⟩))))))
  · exact Or.inr (Or.inr (Or.inr (Or.inl (hproduct 0 3 (2 * x)
      (Or.inr (Or.inl ⟨hgxhigh, lt_of_not_ge hbad⟩))))))
  · fin_cases l
    · exact (hbad True.intro).elim
    · exact (hbad True.intro).elim
    · change g 6 < g 2 ∧ ((g 2 * g 6 : ℕ) : ℝ) < x ^ ((40481 : ℝ) / 100000)
        at hgextra
      change ¬(bad 6 < bad 2 ∧
        ((bad 2 * bad 6 : ℕ) : ℝ) < x ^ ((40481 : ℝ) / 100000)) at hbad
      rcases not_and_or.mp hbad with hbad | hbad
      · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ?_))))
        simpa only [min_comm (v 6) (v 2), max_comm (v 6) (v 2)] using
          hcomparison 6 2 hgextra.1 hbad
      · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl
          (hproduct 2 6 (x ^ ((40481 : ℝ) / 100000))
            (Or.inl ⟨hgextra.2, le_of_not_gt hbad⟩)))))))
    · change g 6 < g 2 ∧ B < ((g 2 * g 6 : ℕ) : ℝ) at hgextra
      change ¬(bad 6 < bad 2 ∧ B < ((bad 2 * bad 6 : ℕ) : ℝ)) at hbad
      rcases not_and_or.mp hbad with hbad | hbad
      · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ?_))))
        simpa only [min_comm (v 6) (v 2), max_comm (v 6) (v 2)] using
          hcomparison 6 2 hgextra.1 hbad
      · exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr
          (hproduct 2 6 B
            (Or.inr (Or.inr (Or.inr ⟨le_of_not_gt hbad, hgextra.2⟩)))))))))
    · change g 6 < g 2 at hgextra
      change ¬bad 6 < bad 2 at hbad
      refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ?_))))
      simpa only [min_comm (v 6) (v 2), max_comm (v 6) (v 2)] using
        hcomparison 6 2 hgextra hbad
    · change g 2 < g 6 at hgextra
      change ¬bad 2 < bad 6 at hbad
      exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inl
        (hcomparison 2 6 hgextra hbad)))))

open Classical in
theorem three_positive_factor_pushforward (U : ℕ) (f : ℕ → ℕ → ℕ → ℂ) :
    (∑ v ∈ Fintype.piFinset (fun _ : Fin 3 => Finset.Icc 1 U),
      Finsupp.single (∏ j, v j)
        (if (∏ j, v j) ≤ U then f (v 0) (v 1) (v 2) else 0)) =
      ∑ n ∈ Finset.Icc 1 U, Finsupp.single n
        (∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
          f aa.1 bb.1 bb.2) := by
  let T := Fintype.piFinset (fun _ : Fin 3 => Finset.Icc 1 U)
  have hfixed (n : ℕ) (hn : 1 ≤ n) (hnU : n ≤ U) :
      (∑ v ∈ T, if (∏ j, v j) = n then f (v 0) (v 1) (v 2) else 0) =
        ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
          f aa.1 bb.1 bb.2 := by
    let A : Finset (Σ _ : ℕ × ℕ, ℕ × ℕ) :=
      n.divisorsAntidiagonal.sigma fun aa => aa.2.divisorsAntidiagonal
    let B : Finset (Fin 3 → ℕ) := T.filter fun v => (∏ j, v j) = n
    let vec : (Σ _ : ℕ × ℕ, ℕ × ℕ) → Fin 3 → ℕ :=
      fun v => ![v.1.1, v.2.1, v.2.2]
    symm
    calc
      _ = ∑ v ∈ A, f (vec v 0) (vec v 1) (vec v 2) := by
        simp [A, vec, Finset.sum_sigma]
      _ = ∑ v ∈ B, f (v 0) (v 1) (v 2) := by
        refine Finset.sum_bij (fun v _ => vec v) ?_ ?_ ?_ (fun _ _ => rfl)
        · intro v hv
          obtain ⟨ha, hb⟩ := Finset.mem_sigma.mp hv
          have hproduct : (∏ j, vec v j) = n := by
            rw [Fin.prod_univ_three]
            change v.1.1 * v.2.1 * v.2.2 = n
            rw [Nat.mul_assoc, (Nat.mem_divisorsAntidiagonal.mp hb).1,
              (Nat.mem_divisorsAntidiagonal.mp ha).1]
          have hpositive (i : Fin 3) : 0 < vec v i := by
            fin_cases i
            · simpa [vec] using
                Nat.pos_of_ne_zero (Nat.left_ne_zero_of_mem_divisorsAntidiagonal ha)
            · simpa [vec] using
                Nat.pos_of_ne_zero (Nat.left_ne_zero_of_mem_divisorsAntidiagonal hb)
            · simpa [vec] using
                Nat.pos_of_ne_zero (Nat.right_ne_zero_of_mem_divisorsAntidiagonal hb)
          apply Finset.mem_filter.mpr
          refine ⟨Fintype.mem_piFinset.mpr (fun i => ?_), hproduct⟩
          apply Finset.mem_Icc.mpr
          refine ⟨hpositive i, (Nat.le_of_dvd hn ?_).trans hnU⟩
          rw [← hproduct]
          exact Finset.dvd_prod_of_mem _ (Finset.mem_univ i)
        · intro v hv w hw heq
          have h0 : v.1.1 = w.1.1 := congrArg (fun z : Fin 3 → ℕ => z 0) heq
          have h1 : v.2.1 = w.2.1 := congrArg (fun z : Fin 3 → ℕ => z 1) heq
          have h2 : v.2.2 = w.2.2 := congrArg (fun z : Fin 3 → ℕ => z 2) heq
          have hvb := (Finset.mem_sigma.mp hv).2
          have hwb := (Finset.mem_sigma.mp hw).2
          have htail : v.1.2 = w.1.2 := by
            rw [← (Nat.mem_divisorsAntidiagonal.mp hvb).1,
              ← (Nat.mem_divisorsAntidiagonal.mp hwb).1, h1, h2]
          exact Sigma.ext (Prod.ext h0 htail) (heq_of_eq (Prod.ext h1 h2))
        · intro v hv
          obtain ⟨hvT, hvn⟩ := Finset.mem_filter.mp hv
          have hpositive (i : Fin 3) : 0 < v i :=
            (Finset.mem_Icc.mp (Fintype.mem_piFinset.mp hvT i)).1
          have hproduct : v 0 * (v 1 * v 2) = n := by
            simpa only [Fin.prod_univ_three, Nat.mul_assoc] using hvn
          let w : Σ _ : ℕ × ℕ, ℕ × ℕ :=
            ⟨(v 0, v 1 * v 2), (v 1, v 2)⟩
          have hw : w ∈ A :=
            Finset.mem_sigma.mpr
              ⟨Nat.mem_divisorsAntidiagonal.mpr
                ⟨hproduct, Nat.ne_zero_of_lt hn⟩,
                Nat.mem_divisorsAntidiagonal.mpr
                  ⟨rfl, mul_ne_zero (hpositive 1).ne' (hpositive 2).ne'⟩⟩
          refine ⟨w, hw, ?_⟩
          funext i
          fin_cases i <;> simp [vec, w]
      _ = _ := by simp only [B, Finset.sum_filter]
  ext n
  simp only [Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_ite_eq']
  by_cases hn : n ∈ Finset.Icc 1 U
  · rw [ite_eq_left hn]
    calc
      _ = ∑ v ∈ T, if (∏ j, v j) = n then f (v 0) (v 1) (v 2) else 0 := by
        apply Finset.sum_congr rfl
        intro v _hv
        by_cases hvn : (∏ j, v j) = n
        · simp only [hvn, ite_true, ite_eq_left (Finset.mem_Icc.mp hn).2]
        · simp only [ite_eq_right hvn]
      _ = _ := hfixed n (Finset.mem_Icc.mp hn).1 (Finset.mem_Icc.mp hn).2
  · rw [ite_eq_right hn]
    apply Finset.sum_eq_zero
    intro v hv
    by_cases hvn : (∏ j, v j) = n
    · have hp : 0 < ∏ j, v j :=
        Finset.prod_pos fun j _ => (Finset.mem_Icc.mp (Fintype.mem_piFinset.mp hv j)).1
      have hcut : ¬(∏ j, v j) ≤ U := by
        intro hu
        exact hn (Finset.mem_Icc.mpr ⟨hvn ▸ hp, hvn ▸ hu⟩)
      simp only [ite_eq_left hvn, ite_eq_right hcut]
    · simp only [ite_eq_right hvn]

open Classical in
theorem finiteConvolution_indexed_pushforward
    {ι κ : Type*} (S : Finset ι) (T : Finset κ)
    (a : ι → ℕ) (b : κ → ℕ) (f : ι → ℂ) (g : κ → ℂ) :
    finiteConvolution (∑ i ∈ S, Finsupp.single (a i) (f i))
        (∑ j ∈ T, Finsupp.single (b j) (g j)) =
      ∑ i ∈ S, ∑ j ∈ T, Finsupp.single (a i * b j) (f i * g j) := by
  simp only [finiteConvolution, MonoidAlgebra.ofCoeff_sum, MonoidAlgebra.ofCoeff_single,
    Finset.sum_mul, Finset.mul_sum, MonoidAlgebra.single_mul_single,
    MonoidAlgebra.coeff_sum, MonoidAlgebra.coeff_single]
  exact Finset.sum_comm

theorem harman_named_factor_cuts
    (x : ℝ) (hx : 1 < x) (l : Fin 6) (u v s : ℕ) :
    let z := x ^ ((9519 : ℝ) / 50000)
    let H := x ^ ((40481 : ℝ) / 100000)
    let B := x ^ ((59519 : ℝ) / 100000)
    let S := x ^ (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000)
    let ps : List ℕ := match l.val with
      | 0 => []
      | 1 => [v]
      | 2 => [v, s]
      | 3 => [v, s]
      | 4 => [v, u, s]
      | _ => [s, u, v]
    ((match l.val with
      | 0 => u = 1 ∧ v = 1 ∧ s = 1
      | 1 => u = 1 ∧ s = 1
      | 2 => u = 1
      | 3 => u = 1
      | _ => True) ∧ ps ∈ siftedPrimeTuples x l) ↔
      (match l.val with
        | 0 => u = 1 ∧ v = 1
        | 1 | 2 | 3 => u = 1 ∧ v.Prime ∧ z ≤ (v : ℝ)
        | 4 => u.Prime ∧ v.Prime ∧ z ≤ (u : ℝ) ∧ u < v
        | _ => u.Prime ∧ v.Prime ∧ z ≤ (u : ℝ) ∧ u ≤ v) ∧
      ((u * v : ℕ) : ℝ) < H ∧
      (if l.val ≤ 1 then s = 1 else s.Prime ∧ z ≤ (s : ℝ)) ∧
      (s : ℝ) < S ∧
      (match l.val with
        | 2 => s < v ∧ ((v * s : ℕ) : ℝ) < H
        | 3 => s < v ∧ B < ((v * s : ℕ) : ℝ)
        | 4 => s < u
        | 5 => u < s
        | _ => True) := by
  intro z H B S ps
  have hH : (1 : ℝ) < H := Real.one_lt_rpow hx (by norm_num)
  have hS : (1 : ℝ) < S := Real.one_lt_rpow hx (by norm_num)
  have hSH : S < H := Real.rpow_lt_rpow_of_exponent_lt hx (by norm_num)
  have hsize (j : Fin 6) (p : List ℕ) (hp : p ∈ siftedPrimeTuples x j) :
      ((siftedPrimeGroups j p).2 : ℝ) < S := by
    have hg := (siftedPrimeTuples_group_bounds x hx j p hp).2.2.2.2.1
    simpa only [S, ← Real.rpow_sub (zero_lt_one.trans hx)] using hg
  fin_cases l
  · change ((u = 1 ∧ v = 1 ∧ s = 1) ∧ [] ∈ siftedPrimeTuples x (0 : Fin 6)) ↔
      (u = 1 ∧ v = 1) ∧ ((u * v : ℕ) : ℝ) < H ∧ s = 1 ∧ (s : ℝ) < S ∧ True
    have hempty : [] ∈ siftedPrimeTuples x (0 : Fin 6) := by
      have hm := mem_siftedPrimeTuples_iff x hx (0 : Fin 6) []
      simpa only using hm.mpr True.intro
    constructor
    · rintro ⟨⟨rfl, rfl, rfl⟩, _⟩
      exact ⟨⟨rfl, rfl⟩, by simpa using hH, rfl,
        by simpa only [Nat.cast_one] using hS, True.intro⟩
    · rintro ⟨⟨rfl, rfl⟩, _, rfl, _, _⟩
      exact ⟨⟨rfl, rfl, rfl⟩, hempty⟩
  · have hm := (siftedPrimeTuples_named_cuts x hx (1 : Fin 6) v 1 1
      ⟨rfl, rfl⟩).2.2
    change [v] ∈ siftedPrimeTuples x (1 : Fin 6) ↔
      v.Prime ∧ z ≤ (v : ℝ) ∧ (v : ℝ) < H at hm
    change ((u = 1 ∧ s = 1) ∧ [v] ∈ siftedPrimeTuples x (1 : Fin 6)) ↔
      (u = 1 ∧ v.Prime ∧ z ≤ (v : ℝ)) ∧ ((u * v : ℕ) : ℝ) < H ∧
        s = 1 ∧ (s : ℝ) < S ∧ True
    rw [hm]
    constructor
    · rintro ⟨⟨rfl, rfl⟩, hv, hzv, hvH⟩
      exact ⟨⟨rfl, hv, hzv⟩, by simpa using hvH, rfl,
        by simpa only [Nat.cast_one] using hS, True.intro⟩
    · rintro ⟨⟨rfl, hv, hzv⟩, hvH, rfl, _, _⟩
      exact ⟨⟨rfl, rfl⟩, hv, hzv, by simpa using hvH⟩
  · have hm := (siftedPrimeTuples_named_cuts x hx (2 : Fin 6) v 1 s rfl).2.2
    change [v, s] ∈ siftedPrimeTuples x (2 : Fin 6) ↔
      v.Prime ∧ s.Prime ∧ z ≤ (s : ℝ) ∧ s < v ∧ (v : ℝ) < H ∧
        ((v * s : ℕ) : ℝ) < H at hm
    change (u = 1 ∧ [v, s] ∈ siftedPrimeTuples x (2 : Fin 6)) ↔
      (u = 1 ∧ v.Prime ∧ z ≤ (v : ℝ)) ∧ ((u * v : ℕ) : ℝ) < H ∧
        (s.Prime ∧ z ≤ (s : ℝ)) ∧ (s : ℝ) < S ∧ s < v ∧
          ((v * s : ℕ) : ℝ) < H
    rw [hm]
    constructor
    · rintro ⟨rfl, hv, hs, hzs, hsv, hvH, hprod⟩
      have hzv : z ≤ (v : ℝ) := hzs.trans (Nat.cast_le.mpr hsv.le)
      have hsS := hsize (2 : Fin 6) [v, s] (hm.mpr ⟨hv, hs, hzs, hsv, hvH, hprod⟩)
      exact ⟨⟨rfl, hv, hzv⟩, by simpa using hvH, ⟨hs, hzs⟩,
        by simpa [siftedPrimeGroups] using hsS, hsv, hprod⟩
    · rintro ⟨⟨rfl, hv, _⟩, hvH, ⟨hs, hzs⟩, _, hsv, hprod⟩
      exact ⟨rfl, hv, hs, hzs, hsv, by simpa using hvH, hprod⟩
  · have hm := (siftedPrimeTuples_named_cuts x hx (3 : Fin 6) v 1 s rfl).2.2
    change [v, s] ∈ siftedPrimeTuples x (3 : Fin 6) ↔
      v.Prime ∧ s.Prime ∧ z ≤ (s : ℝ) ∧ s < v ∧ (v : ℝ) < H ∧
        B < ((v * s : ℕ) : ℝ) ∧ (s : ℝ) < S at hm
    change (u = 1 ∧ [v, s] ∈ siftedPrimeTuples x (3 : Fin 6)) ↔
      (u = 1 ∧ v.Prime ∧ z ≤ (v : ℝ)) ∧ ((u * v : ℕ) : ℝ) < H ∧
        (s.Prime ∧ z ≤ (s : ℝ)) ∧ (s : ℝ) < S ∧ s < v ∧
          B < ((v * s : ℕ) : ℝ)
    rw [hm]
    constructor
    · rintro ⟨rfl, hv, hs, hzs, hsv, hvH, hprod, hsS⟩
      exact ⟨⟨rfl, hv, hzs.trans (Nat.cast_le.mpr hsv.le)⟩,
        by simpa using hvH, ⟨hs, hzs⟩, hsS, hsv, hprod⟩
    · rintro ⟨⟨rfl, hv, _⟩, hvH, ⟨hs, hzs⟩, hsS, hsv, hprod⟩
      exact ⟨rfl, hv, hs, hzs, hsv, by simpa using hvH, hprod, hsS⟩
  · have hm := (siftedPrimeTuples_named_cuts x hx (4 : Fin 6) u v s True.intro).2.2
    change [v, u, s] ∈ siftedPrimeTuples x (4 : Fin 6) ↔
      u.Prime ∧ v.Prime ∧ s.Prime ∧ z ≤ (s : ℝ) ∧ s < u ∧ u < v ∧
        ((u * v : ℕ) : ℝ) < H ∧ (s : ℝ) < S at hm
    change (True ∧ [v, u, s] ∈ siftedPrimeTuples x (4 : Fin 6)) ↔
      (u.Prime ∧ v.Prime ∧ z ≤ (u : ℝ) ∧ u < v) ∧
        ((u * v : ℕ) : ℝ) < H ∧ (s.Prime ∧ z ≤ (s : ℝ)) ∧ (s : ℝ) < S ∧ s < u
    rw [hm]
    constructor
    · rintro ⟨_, hu, hv, hs, hzs, hsu, huv, hprod, hsS⟩
      exact ⟨⟨hu, hv, hzs.trans (Nat.cast_le.mpr hsu.le), huv⟩,
        hprod, ⟨hs, hzs⟩, hsS, hsu⟩
    · rintro ⟨⟨hu, hv, _hzu, huv⟩, hprod, ⟨hs, hzs⟩, hsS, hsu⟩
      exact ⟨True.intro, hu, hv, hs, hzs, hsu, huv, hprod, hsS⟩
  · have hm := (siftedPrimeTuples_named_cuts x hx (5 : Fin 6) u v s True.intro).2.2
    change [s, u, v] ∈ siftedPrimeTuples x (5 : Fin 6) ↔
      s.Prime ∧ u.Prime ∧ v.Prime ∧ z ≤ (u : ℝ) ∧ u < s ∧ (s : ℝ) < H ∧
        u ≤ v ∧ ((u * v : ℕ) : ℝ) < H ∧ (s : ℝ) < S at hm
    change (True ∧ [s, u, v] ∈ siftedPrimeTuples x (5 : Fin 6)) ↔
      (u.Prime ∧ v.Prime ∧ z ≤ (u : ℝ) ∧ u ≤ v) ∧
        ((u * v : ℕ) : ℝ) < H ∧ (s.Prime ∧ z ≤ (s : ℝ)) ∧ (s : ℝ) < S ∧ u < s
    rw [hm]
    constructor
    · rintro ⟨_, hs, hu, hv, hzu, hus, _hsH, huv, hprod, hsS⟩
      exact ⟨⟨hu, hv, hzu, huv⟩, hprod,
        ⟨hs, hzu.trans (Nat.cast_le.mpr hus.le)⟩, hsS, hus⟩
    · rintro ⟨⟨hu, hv, hzu, huv⟩, hprod, ⟨hs, _hzs⟩, hsS, hus⟩
      exact ⟨True.intro, hs, hu, hv, hzu, hus, hsS.trans hSH, huv, hprod, hsS⟩

theorem harman_feature_cell_closed_interval
    (L : ℕ) (b : ℕ → ℕ) (lo hi : ℕ → ℝ)
    (hcell : ∀ n i, 1 ≤ n →
      (b n = i ↔ (i ≤ L ∧ n = i) ∨
        (L < i ∧ L < n ∧ lo i ≤ (n : ℝ) ∧ (n : ℝ) < hi i)))
    (hlowends : ∀ i, i ≤ L → lo i = (i : ℝ) ∧ hi i = (i : ℝ) + 1) :
    let lower : ℕ → ℕ := fun i => max 1
      (if i ≤ L then i else max (L + 1) ⌈lo i⌉₊)
    let upper : ℕ → ℕ := fun i => if i ≤ L then i else ⌈hi i⌉₊ - 1
    (∀ i, 1 ≤ lower i) ∧
      (∀ n i, 1 ≤ n → (b n = i ↔ lower i ≤ n ∧ n ≤ upper i)) ∧
      (∀ n i, 1 ≤ n → b n = i →
        lo i ≤ (lower i : ℝ) ∧ (lower i : ℝ) ≤ (n : ℝ) ∧
          (n : ℝ) ≤ (upper i : ℝ) ∧
          (upper i : ℝ) ≤ (if i ≤ L then lo i else hi i)) := by
  intro lower upper
  have hpositive (i : ℕ) : 1 ≤ lower i := le_max_left _ _
  have hupper (n i : ℕ) (hn : 1 ≤ n) :
      n ≤ ⌈hi i⌉₊ - 1 ↔ (n : ℝ) < hi i := by
    rw [← Nat.lt_ceil]
    omega
  have hiff (n i : ℕ) (hn : 1 ≤ n) : b n = i ↔ lower i ≤ n ∧ n ≤ upper i := by
    constructor
    · intro hni
      rcases (hcell n i hn).mp hni with ⟨hiL, rfl⟩ | ⟨hLi, hLn, hlo, hhi⟩
      · simp only [lower, upper, hiL, ite_true, max_le_iff, le_refl, and_true]
        exact hn
      · have hiL : ¬i ≤ L := not_le.mpr hLi
        simp only [lower, upper, hiL, ite_false]
        exact ⟨max_le hn (max_le hLn (Nat.ceil_le.mpr hlo)), (hupper n i hn).mpr hhi⟩
    · rintro ⟨hlo, hhi⟩
      apply (hcell n i hn).mpr
      by_cases hiL : i ≤ L
      · have hlo' : max 1 i ≤ n := by simpa only [lower, hiL, ite_true] using hlo
        have hhi' : n ≤ i := by simpa only [upper, hiL, ite_true] using hhi
        exact Or.inl ⟨hiL, Nat.le_antisymm hhi' ((le_max_right 1 i).trans hlo')⟩
      · have hlo' : max 1 (max (L + 1) ⌈lo i⌉₊) ≤ n := by
          simpa only [lower, hiL, ite_false] using hlo
        have hhi' : n ≤ ⌈hi i⌉₊ - 1 := by simpa only [upper, hiL, ite_false] using hhi
        have hLceil : max (L + 1) ⌈lo i⌉₊ ≤ n := (le_max_right _ _).trans hlo'
        exact Or.inr ⟨lt_of_not_ge hiL, (le_max_left _ _).trans hLceil,
          Nat.ceil_le.mp ((le_max_right _ _).trans hLceil), (hupper n i hn).mp hhi'⟩
  refine ⟨hpositive, hiff, ?_⟩
  intro n i hn hni
  obtain ⟨hln, hnu⟩ := (hiff n i hn).mp hni
  refine ⟨?_, by exact_mod_cast hln, by exact_mod_cast hnu, ?_⟩
  · by_cases hiL : i ≤ L
    · rw [(hlowends i hiL).1]
      have hile : i ≤ lower i := by
        simpa only [lower, hiL, ite_true] using le_max_right 1 i
      exact_mod_cast hile
    · have hceil : ⌈lo i⌉₊ ≤ lower i := by
        dsimp only [lower]
        rw [ite_eq_right hiL]
        exact (le_max_right (L + 1) ⌈lo i⌉₊).trans (le_max_right 1 _)
      exact (Nat.le_ceil (lo i)).trans (Nat.cast_le.mpr hceil)
  · by_cases hiL : i ≤ L
    · simp only [upper, hiL, ite_true, (hlowends i hiL).1, le_refl]
    · have hnu' : n ≤ ⌈hi i⌉₊ - 1 := by
        simpa only [upper, hiL, ite_false] using hnu
      have hceilpos : 0 < ⌈hi i⌉₊ := by omega
      have hpred : ⌈hi i⌉₊ - 1 < ⌈hi i⌉₊ := by omega
      have hreal : ((⌈hi i⌉₊ - 1 : ℕ) : ℝ) < hi i := Nat.lt_ceil.mp hpred
      simpa only [upper, hiL, ite_false] using hreal.le

theorem harman_feature_mesh_seven_label_polylog
    (D E : ℕ) (hD : 1 ≤ D) (hE : 1 ≤ E) (x : ℝ) (hx : Real.exp 2 ≤ x) :
    let U : ℕ := ⌊8 * x⌋₊
    let L : ℕ := ⌊Real.log x⌋₊ ^ E
    let h : ℝ := (Real.log x) ^ (-(D : ℝ))
    ∀ K : ℕ, (K : ℝ) ≤ (L : ℝ) + 3 + 2 * Real.log (max 1 (U : ℝ)) / h →
      (K : ℝ) ^ 7 ≤ (20 : ℝ) ^ 7 * (Real.log x) ^ (7 * (D + E + 1)) := by
  intro U L h K hK
  have hx0 : 0 < x := (Real.exp_pos 2).trans_le hx
  have hx1 : 1 ≤ x := (Real.one_le_exp (by norm_num : (0 : ℝ) ≤ 2)).trans hx
  have hy2 : 2 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 2) hx
  have hy1 : 1 ≤ Real.log x := by linarith only [hy2]
  have hy0 : 0 ≤ Real.log x := zero_le_one.trans hy1
  have hU : (U : ℝ) ≤ 8 * x := Nat.floor_le (by positivity)
  have hmax : max 1 (U : ℝ) ≤ 8 * x := max_le (by linarith only [hx1]) hU
  have hlog8 : Real.log 8 ≤ 7 := by
    have ht := Real.log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 8)
    norm_num at ht
    exact ht
  have hlogU : Real.log (max 1 (U : ℝ)) ≤ 8 * Real.log x := by
    calc
      Real.log (max 1 (U : ℝ)) ≤ Real.log (8 * x) :=
        Real.log_le_log (zero_lt_one.trans_le (le_max_left _ _)) hmax
      _ = Real.log 8 + Real.log x := Real.log_mul (by norm_num) hx0.ne'
      _ ≤ 8 * Real.log x := by linarith only [hlog8, hy1]
  have hL : (L : ℝ) ≤ (Real.log x) ^ E := by
    dsimp only [L]
    rw [Nat.cast_pow]
    exact pow_le_pow_left₀ (Nat.cast_nonneg _) (Nat.floor_le hy0) E
  have hterm : 2 * Real.log (max 1 (U : ℝ)) / h ≤
      16 * (Real.log x) ^ (D + 1) := by
    dsimp only [h]
    rw [Real.rpow_neg hy0, Real.rpow_natCast, div_inv_eq_mul]
    calc
      2 * Real.log (max 1 (U : ℝ)) * (Real.log x) ^ D ≤
          (16 * Real.log x) * (Real.log x) ^ D :=
        mul_le_mul_of_nonneg_right (by linarith only [hlogU]) (pow_nonneg hy0 D)
      _ = 16 * (Real.log x) ^ (D + 1) := by rw [pow_succ]; ring
  have hDE : E ≤ D + E + 1 := by
    have hD0 : 0 ≤ D := (by norm_num : (0 : ℕ) ≤ 1).trans hD
    exact (show E ≤ D + E by simpa only [zero_add] using Nat.add_le_add_right hD0 E).trans
      (Nat.le_succ (D + E))
  have hED : D + 1 ≤ D + E + 1 := by
    have hE0 : 0 ≤ E := (by norm_num : (0 : ℕ) ≤ 1).trans hE
    simpa only [Nat.add_zero, Nat.add_assoc, Nat.add_comm E 1] using
      Nat.add_le_add_left hE0 (D + 1)
  have hLE : (Real.log x) ^ E ≤ (Real.log x) ^ (D + E + 1) :=
    pow_le_pow_right₀ hy1 hDE
  have hLD : (Real.log x) ^ (D + 1) ≤ (Real.log x) ^ (D + E + 1) :=
    pow_le_pow_right₀ hy1 hED
  have hLP : 1 ≤ (Real.log x) ^ (D + E + 1) := one_le_pow₀ hy1
  have hbound : (K : ℝ) ≤ 20 * (Real.log x) ^ (D + E + 1) := by
    have hsum := hK.trans (add_le_add (add_le_add hL (le_refl 3)) hterm)
    linarith only [hsum, hLE, hLD, hLP]
  calc
    (K : ℝ) ^ 7 ≤ (20 * (Real.log x) ^ (D + E + 1)) ^ 7 :=
      pow_le_pow_left₀ (Nat.cast_nonneg K) hbound 7
    _ = (20 : ℝ) ^ 7 * (Real.log x) ^ (7 * (D + E + 1)) := by
      rw [mul_pow, ← pow_mul, Nat.mul_comm (D + E + 1) 7]

open Classical in
theorem finite_subproduct_divisor_mass_bound
    (k U : ℕ) (hU : 1 ≤ U) (s : Finset (Fin k)) (S : Finset ℕ)
    (hS : ∀ m ∈ S, 0 < m) :
    let T := (Fintype.piFinset (fun _ : Fin k => Finset.Icc 1 U)).filter
      (fun v => (∏ i, v i) ≤ U ∧ (∏ i ∈ s, v i) ∈ S)
    (T.card : ℝ) ≤ (U : ℝ) * (1 + Real.log (U : ℝ)) ^ (2 ^ k - 1) *
      ∑ m ∈ S, (m.divisors.card : ℝ) ^ k / (m : ℝ) := by
  intro T
  let P : (Fin k → ℕ) → ℕ := fun v => ∏ i ∈ s, v i
  let Q : (Fin k → ℕ) → ℕ := fun v => ∏ i ∈ sᶜ, v i
  let C : ℝ := (U : ℝ) * (1 + Real.log (U : ℝ)) ^ (2 ^ k - 1)
  have hlogU : 0 ≤ Real.log (U : ℝ) :=
    Real.log_nonneg (by exact_mod_cast hU)
  have hC : 0 ≤ C := by dsimp only [C]; positivity
  have hpositive (v : Fin k → ℕ) (hv : v ∈ T) (i : Fin k) : 0 < v i :=
    (Finset.mem_Icc.mp (Fintype.mem_piFinset.mp (Finset.mem_filter.mp hv).1 i)).1
  have hprod (v : Fin k → ℕ) : P v * Q v = ∏ i, v i :=
    Finset.prod_mul_prod_compl s v
  have htotal (v : Fin k → ℕ) (hv : v ∈ T) : (∏ i, v i) ≤ U :=
    (Finset.mem_filter.mp hv).2.1
  have hmapP : ∀ v ∈ T, P v ∈ S := fun v hv => (Finset.mem_filter.mp hv).2.2
  have hquotient (m : ℕ) :
      (∑ u ∈ Finset.Icc 1 (U / m), (u.divisors.card : ℝ) ^ k) ≤ C / (m : ℝ) := by
    by_cases hzero : U / m = 0
    · rw [hzero, Finset.Icc_eq_empty_of_lt (by omega : (0 : ℕ) < 1), Finset.sum_empty]
      exact div_nonneg hC (Nat.cast_nonneg m)
    · have hq1 : (1 : ℝ) ≤ ((U / m : ℕ) : ℝ) := by
        exact_mod_cast Nat.one_le_iff_ne_zero.mpr hzero
      have hlogq : 0 ≤ Real.log ((U / m : ℕ) : ℝ) := Real.log_nonneg hq1
      have hlogle : Real.log ((U / m : ℕ) : ℝ) ≤ Real.log (U : ℝ) :=
        Real.log_le_log (by linarith only [hq1])
          (by exact_mod_cast Nat.div_le_self U m)
      calc
        _ ≤ ((U / m : ℕ) : ℝ) *
            (1 + Real.log ((U / m : ℕ) : ℝ)) ^ (2 ^ k - 1) :=
          sum_card_divisors_pow_le_mul_log_pow k (U / m)
        _ ≤ ((U / m : ℕ) : ℝ) * (1 + Real.log (U : ℝ)) ^ (2 ^ k - 1) :=
          mul_le_mul_of_nonneg_left
            (pow_le_pow_left₀ (by linarith only [hlogq])
              (show 1 + Real.log ((U / m : ℕ) : ℝ) ≤ 1 + Real.log (U : ℝ) by
                linarith only [hlogle]) _)
            (Nat.cast_nonneg (U / m))
        _ ≤ ((U : ℝ) / (m : ℝ)) * (1 + Real.log (U : ℝ)) ^ (2 ^ k - 1) :=
          mul_le_mul_of_nonneg_right Nat.cast_div_le (by positivity)
        _ = C / (m : ℝ) := by dsimp only [C]; ring
  have hfiber (m : ℕ) (hm : m ∈ S) :
      ((T.filter (fun v => P v = m)).card : ℝ) ≤
        C * ((m.divisors.card : ℝ) ^ k / (m : ℝ)) := by
    let V := T.filter (fun v => P v = m)
    have hm0 : 0 < m := hS m hm
    have hmapQ : ∀ v ∈ V, Q v ∈ Finset.Icc 1 (U / m) := by
      intro v hv
      obtain ⟨hvT, hvm⟩ := Finset.mem_filter.mp hv
      refine Finset.mem_Icc.mpr
        ⟨Finset.prod_pos (fun i _ => hpositive v hvT i),
          (Nat.le_div_iff_mul_le hm0).mpr ?_⟩
      calc
        Q v * m = P v * Q v := by rw [← hvm]; exact mul_comm _ _
        _ = ∏ i, v i := hprod v
        _ ≤ U := htotal v hvT
    have hpair (u : ℕ) (hu : u ∈ Finset.Icc 1 (U / m)) :
        ((V.filter (fun v => Q v = u)).card : ℝ) ≤
          (m.divisors.card : ℝ) ^ k * (u.divisors.card : ℝ) ^ k := by
      have hu0 : 0 < u := (Finset.mem_Icc.mp hu).1
      have hmcard : 1 ≤ m.divisors.card :=
        Finset.one_le_card.mpr (Nat.nonempty_divisors.mpr hm0.ne')
      have hucard : 1 ≤ u.divisors.card :=
        Finset.one_le_card.mpr (Nat.nonempty_divisors.mpr hu0.ne')
      have hsubset : V.filter (fun v => Q v = u) ⊆
          Fintype.piFinset (fun i : Fin k => if i ∈ s then m.divisors else u.divisors) := by
        intro v hv
        obtain ⟨hvV, hvu⟩ := Finset.mem_filter.mp hv
        obtain ⟨_, hvm⟩ := Finset.mem_filter.mp hvV
        apply Fintype.mem_piFinset.mpr
        intro i
        by_cases his : i ∈ s
        · rw [ite_eq_left his]
          apply Nat.mem_divisors.mpr
          refine ⟨?_, hm0.ne'⟩
          rw [← hvm]
          exact Finset.dvd_prod_of_mem v his
        · rw [ite_eq_right his]
          apply Nat.mem_divisors.mpr
          refine ⟨?_, hu0.ne'⟩
          rw [← hvu]
          exact Finset.dvd_prod_of_mem v (Finset.mem_compl.mpr his)
      have hpi :
          (Fintype.piFinset
            (fun i : Fin k => if i ∈ s then m.divisors else u.divisors)).card ≤
              m.divisors.card ^ k * u.divisors.card ^ k := by
        rw [Fintype.card_piFinset]
        calc
          (∏ i : Fin k, (if i ∈ s then m.divisors else u.divisors).card) ≤
              ∏ _i : Fin k, m.divisors.card * u.divisors.card := by
            apply Finset.prod_le_prod'
            intro i _
            by_cases his : i ∈ s
            · simp only [his, ite_true]
              simpa only [Nat.mul_one] using Nat.mul_le_mul_left m.divisors.card hucard
            · simp only [his, ite_false]
              simpa only [Nat.one_mul] using Nat.mul_le_mul_right u.divisors.card hmcard
          _ = m.divisors.card ^ k * u.divisors.card ^ k := by
            simp only [Finset.prod_const, Finset.card_univ, Fintype.card_fin, mul_pow]
      exact_mod_cast (Finset.card_le_card hsubset).trans hpi
    calc
      ((T.filter (fun v => P v = m)).card : ℝ) =
          ∑ u ∈ Finset.Icc 1 (U / m), ((V.filter (fun v => Q v = u)).card : ℝ) := by
        exact_mod_cast Finset.card_eq_sum_card_fiberwise hmapQ
      _ ≤ ∑ u ∈ Finset.Icc 1 (U / m),
          (m.divisors.card : ℝ) ^ k * (u.divisors.card : ℝ) ^ k :=
        Finset.sum_le_sum hpair
      _ = (m.divisors.card : ℝ) ^ k *
          (∑ u ∈ Finset.Icc 1 (U / m), (u.divisors.card : ℝ) ^ k) := by
        rw [Finset.mul_sum]
      _ ≤ (m.divisors.card : ℝ) ^ k * (C / (m : ℝ)) :=
        mul_le_mul_of_nonneg_left (hquotient m) (pow_nonneg (Nat.cast_nonneg _) _)
      _ = C * ((m.divisors.card : ℝ) ^ k / (m : ℝ)) := by ring
  calc
    (T.card : ℝ) = ∑ m ∈ S, ((T.filter (fun v => P v = m)).card : ℝ) := by
      exact_mod_cast Finset.card_eq_sum_card_fiberwise hmapP
    _ ≤ ∑ m ∈ S, C * ((m.divisors.card : ℝ) ^ k / (m : ℝ)) :=
      Finset.sum_le_sum hfiber
    _ = C * ∑ m ∈ S, (m.divisors.card : ℝ) ^ k / (m : ℝ) := by rw [Finset.mul_sum]

open Classical in
theorem harman_uniform_boundary_mass_log_saving (A : ℝ) (hA : 0 < A) :
    ∃ D E : ℕ, 1 ≤ D ∧ 1 ≤ E ∧ ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      let U : ℕ := ⌊8 * x⌋₊
      let L : ℕ := ⌊Real.log x⌋₊ ^ E
      let h : ℝ := (Real.log x) ^ (-(D : ℝ))
      (∀ i j : Fin 6, i ≠ j →
        (((Fintype.piFinset (fun _ : Fin 6 => Finset.Icc 1 U)).filter
          (fun v : Fin 6 → ℕ => (∏ r, v r) ≤ U ∧ 1 < v i ∧
            L < min (v i).minFac (max 1 ((v j).primeFactors.sup id)) ∧
            max ((v i).minFac : ℝ) ((max 1 ((v j).primeFactors.sup id) : ℕ) : ℝ) ≤
              (1 + h) * min ((v i).minFac : ℝ)
                ((max 1 ((v j).primeFactors.sup id) : ℕ) : ℝ))).card : ℝ) ≤
          K * x / (Real.log x) ^ A) ∧
      (∀ s : Finset (Fin 6), ∀ T : ℝ, x ^ (1 / 10 : ℝ) ≤ T → T ≤ x ^ (2 : ℝ) →
        (((Fintype.piFinset (fun _ : Fin 6 => Finset.Icc 1 U)).filter
          (fun v : Fin 6 → ℕ => (∏ r, v r) ≤ U ∧
            T / (1 + h) ^ 2 ≤ ((∏ r ∈ s, v r : ℕ) : ℝ) ∧
            ((∏ r ∈ s, v r : ℕ) : ℝ) ≤ T * (1 + h) ^ 2)).card : ℝ) ≤
          K * x / (Real.log x) ^ A) := by
  let B : ℝ := A + 63
  have hB : 0 < B := by dsimp only [B]; linarith
  obtain ⟨D₀, hD₀, K₀, X₀, hK₀, _hX₀, hmass⟩ :=
    short_relative_divisor_mass_log_saving (1 / 10) 2
      (by norm_num) (by norm_num) (by norm_num) 6 B hB
  let E : ℕ := ⌈A + 66⌉₊ + 1
  let D : ℕ := max D₀ E
  let Kp : ℝ := 16 * (9 : ℝ) ^ 63 * (9 + (2 : ℝ) ^ E)
  let Km : ℝ := 32 * (9 : ℝ) ^ 63 * K₀
  have hE : 1 ≤ E := by dsimp only [E]; omega
  have hD : 1 ≤ D := hE.trans (le_max_right _ _)
  have hED : E ≤ D := le_max_right _ _
  have hD₀D : D₀ ≤ D := le_max_left _ _
  have hElarge : A + 66 ≤ (E : ℝ) := by
    exact (Nat.le_ceil (A + 66)).trans (by dsimp only [E]; norm_cast; omega)
  have hDlarge : A + 66 ≤ (D : ℝ) :=
    hElarge.trans (Nat.cast_le.mpr hED)
  have hKp : 0 < Kp := by dsimp only [Kp]; positivity
  have hKm : 0 < Km := by dsimp only [Km]; positivity
  refine ⟨D, E, hD, hE, Kp + Km, max (Real.exp 100) X₀,
    add_pos hKp hKm, le_max_left _ _, ?_⟩
  intro x hx U L h
  have hx100 : Real.exp 100 ≤ x := (le_max_left _ _).trans hx
  have hx₀ : X₀ ≤ x := (le_max_right _ _).trans hx
  have hxpos : 0 < x := (Real.exp_pos 100).trans_le hx100
  have hxone : 1 ≤ x :=
    (Real.one_le_exp_iff.mpr (by norm_num : (0 : ℝ) ≤ 100)).trans hx100
  let R : ℝ := Real.log x
  have hR100 : 100 ≤ R := (Real.le_log_iff_exp_le hxpos).mpr hx100
  have hRone : 1 ≤ R := by linarith only [hR100]
  have hRpos : 0 < R := zero_lt_one.trans_le hRone
  have hU : 1 ≤ U := Nat.le_floor
    (show ((1 : ℕ) : ℝ) ≤ 8 * x by norm_num; linarith only [hxone])
  have hUpos : (0 : ℝ) < U := by exact_mod_cast hU
  have hUupper : (U : ℝ) ≤ 8 * x := Nat.floor_le (by positivity)
  have hlogU : 1 + Real.log (U : ℝ) ≤ 9 * R := by
    have hh := Real.log_le_log hUpos hUupper
    rw [Real.log_mul (by norm_num : (8 : ℝ) ≠ 0) hxpos.ne'] at hh
    have h8 := Real.log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 8)
    dsimp only [R]
    change 1 ≤ Real.log x at hRone
    linarith only [hh, h8, hRone]
  have hlogUnonneg : 0 ≤ 1 + Real.log (U : ℝ) :=
    add_nonneg zero_le_one (Real.log_natCast_nonneg U)
  have hmoment : (U : ℝ) * (1 + Real.log (U : ℝ)) ^ 63 ≤
      8 * (9 : ℝ) ^ 63 * x * R ^ 63 := by
    calc
      _ ≤ (8 * x) * (9 * R) ^ 63 :=
        mul_le_mul hUupper (pow_le_pow_left₀ hlogUnonneg hlogU 63)
          (pow_nonneg hlogUnonneg _) (by positivity)
      _ = _ := by rw [mul_pow]; ring
  have hhpos : 0 < h := Real.rpow_pos_of_pos hRpos _
  have hh : 0 ≤ h := hhpos.le
  have hhone : h ≤ 1 :=
    Real.rpow_le_one_of_one_le_of_nonpos hRone (neg_nonpos.mpr (Nat.cast_nonneg D))
  have hLbase : 1 ≤ ⌊R⌋₊ := Nat.le_floor
    (show ((1 : ℕ) : ℝ) ≤ R by simpa only [Nat.cast_one] using hRone)
  have hL : 1 ≤ L :=
    one_le_pow₀ hLbase
  have hLlower : R ^ E / (2 : ℝ) ^ E ≤ (L : ℝ) := by
    have hf : R / 2 ≤ (⌊R⌋₊ : ℝ) := (Nat.div_two_lt_floor hRone).le
    have hp := pow_le_pow_left₀ (by positivity : 0 ≤ R / 2) hf E
    simpa only [L, R, Nat.cast_pow, div_pow] using hp
  have hLinv : 1 / (L : ℝ) ≤ (2 : ℝ) ^ E / R ^ E := by
    calc
      1 / (L : ℝ) ≤ 1 / (R ^ E / (2 : ℝ) ^ E) :=
        div_le_div_of_nonneg_left zero_le_one (by positivity) hLlower
      _ = _ := by field_simp [hRpos.ne']
  have hdecayD : R ^ 63 * (h * R) ≤ 1 / R ^ A := by
    have hexponent : (64 : ℝ) - (D : ℝ) ≤ -A := by linarith only [hDlarge]
    calc
      R ^ 63 * (h * R) = R ^ ((64 : ℝ) - (D : ℝ)) := by
        change R ^ 63 * (R ^ (-(D : ℝ)) * R) = _
        rw [← Real.rpow_natCast R 63]
        calc
          _ = (R ^ (63 : ℝ) * R ^ (-(D : ℝ))) * R ^ (1 : ℝ) := by
            rw [Real.rpow_one]; ring_nf
          _ = R ^ ((63 : ℝ) + (-(D : ℝ)) + 1) := by
            rw [← Real.rpow_add hRpos, ← Real.rpow_add hRpos]
          _ = _ := by congr 1; ring
      _ ≤ R ^ (-A) := Real.rpow_le_rpow_of_exponent_le hRone hexponent
      _ = 1 / R ^ A := by rw [Real.rpow_neg hRpos.le, one_div]
  have hdecayE : R ^ 63 / R ^ E ≤ 1 / R ^ A := by
    have hexponent : (63 : ℝ) - (E : ℝ) ≤ -A := by linarith only [hElarge]
    calc
      R ^ 63 / R ^ E = R ^ ((63 : ℝ) - (E : ℝ)) := by
        simp only [Real.rpow_sub hRpos, Real.rpow_natCast, Real.rpow_ofNat]
      _ ≤ R ^ (-A) := Real.rpow_le_rpow_of_exponent_le hRone hexponent
      _ = 1 / R ^ A := by rw [Real.rpow_neg hRpos.le, one_div]
  have htail : R ^ 63 * (h * (1 + Real.log (U : ℝ)) + 1 / (L : ℝ)) ≤
      (9 + (2 : ℝ) ^ E) / R ^ A := by
    calc
      _ ≤ R ^ 63 * (9 * (h * R) + (2 : ℝ) ^ E / R ^ E) := by
        apply mul_le_mul_of_nonneg_left _ (pow_nonneg hRpos.le _)
        apply add_le_add _ hLinv
        calc
          h * (1 + Real.log (U : ℝ)) ≤ h * (9 * R) :=
            mul_le_mul_of_nonneg_left hlogU hh
          _ = _ := by ring
      _ = 9 * (R ^ 63 * (h * R)) + (2 : ℝ) ^ E * (R ^ 63 / R ^ E) := by ring
      _ ≤ 9 * (1 / R ^ A) + (2 : ℝ) ^ E * (1 / R ^ A) :=
        add_le_add (mul_le_mul_of_nonneg_left hdecayD (by norm_num))
          (mul_le_mul_of_nonneg_left hdecayE (by positivity))
      _ = _ := by ring
  have hraise (K : ℝ) (hK : K ≤ Kp + Km) : K * x / R ^ A ≤
      (Kp + Km) * x / R ^ A :=
    div_le_div_of_nonneg_right (mul_le_mul_of_nonneg_right hK hxpos.le)
      (Real.rpow_nonneg hRpos.le A)
  constructor
  · intro i j hij
    have hp := prime_feature_full_tuple_boundary_mass 6 U L i j hij hU hL h hh
    norm_num only at hp
    apply le_trans hp
    calc
      2 * (U : ℝ) * (1 + Real.log (U : ℝ)) ^ 63 *
          (h * (1 + Real.log (U : ℝ)) + 1 / (L : ℝ)) ≤
          16 * (9 : ℝ) ^ 63 * x *
            (R ^ 63 * (h * (1 + Real.log (U : ℝ)) + 1 / (L : ℝ))) := by
        have ht : 0 ≤ h * (1 + Real.log (U : ℝ)) + 1 / (L : ℝ) := by positivity
        have hm := mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left hmoment (by norm_num : (0 : ℝ) ≤ 2)) ht
        simpa only [← mul_assoc, show (2 : ℝ) * 8 = 16 by norm_num] using hm
      _ ≤ 16 * (9 : ℝ) ^ 63 * x * ((9 + (2 : ℝ) ^ E) / R ^ A) :=
        mul_le_mul_of_nonneg_left htail (by positivity)
      _ = Kp * x / R ^ A := by dsimp only [Kp]; ring
      _ ≤ (Kp + Km) * x / R ^ A := hraise Kp (by linarith only [hKm])
  · intro s T hTlo hThi
    have hTpos : 0 < T := (Real.rpow_pos_of_pos hxpos (1 / 10)).trans_le hTlo
    let h₀ : ℝ := R ^ (-(D₀ : ℝ))
    have hh₀ : h ≤ h₀ := Real.rpow_le_rpow_of_exponent_le hRone (by
      exact neg_le_neg (Nat.cast_le.mpr hD₀D))
    have hratio : 0 < (1 + h) ^ 2 := by positivity
    have hratioLe : (1 + h) ^ 2 ≤ (1 + h₀) ^ 2 :=
      pow_le_pow_left₀ (by positivity)
        (show 1 + h ≤ 1 + h₀ by linarith only [hh₀]) 2
    have hratioFour : (1 + h) ^ 2 ≤ 4 := by nlinarith only [hh, hhone]
    let S : Finset ℕ := (Finset.Icc 1 U).filter (fun m =>
      T / (1 + h) ^ 2 ≤ (m : ℝ) ∧ (m : ℝ) ≤ T * (1 + h) ^ 2)
    have hSpos (m : ℕ) (hm : m ∈ S) : 0 < m :=
      (Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1).1
    have hSband (m : ℕ) (hm : m ∈ S) :
        T / (1 + h) ^ 2 ≤ (m : ℝ) ∧ (m : ℝ) ≤ T * (1 + h) ^ 2 :=
      (Finset.mem_filter.mp hm).2
    have hSband₀ (m : ℕ) (hm : m ∈ S) :
        T / (1 + h₀) ^ 2 ≤ (m : ℝ) ∧ (m : ℝ) ≤ T * (1 + h₀) ^ 2 :=
      ⟨(div_le_div_of_nonneg_left hTpos.le hratio hratioLe).trans (hSband m hm).1,
        (hSband m hm).2.trans (mul_le_mul_of_nonneg_left hratioLe hTpos.le)⟩
    have hSmass : (∑ m ∈ S, (m.divisors.card : ℝ) ^ 6) ≤ K₀ * T / R ^ B :=
      hmass x hx₀ T hTlo hThi S hSband₀
    have hreciprocal : (∑ m ∈ S, (m.divisors.card : ℝ) ^ 6 / (m : ℝ)) ≤
        4 * K₀ / R ^ B := by
      calc
        _ ≤ (4 / T) * ∑ m ∈ S, (m.divisors.card : ℝ) ^ 6 := by
          rw [Finset.mul_sum]
          apply Finset.sum_le_sum
          intro m hm
          have hquarter : T / 4 ≤ (m : ℝ) :=
            (div_le_div_of_nonneg_left hTpos.le hratio hratioFour).trans (hSband m hm).1
          calc
            (m.divisors.card : ℝ) ^ 6 / (m : ℝ) ≤
                (m.divisors.card : ℝ) ^ 6 / (T / 4) :=
              div_le_div_of_nonneg_left (pow_nonneg (Nat.cast_nonneg _) _)
                (by positivity) hquarter
            _ = _ := by field_simp [hTpos.ne']
        _ ≤ (4 / T) * (K₀ * T / R ^ B) :=
          mul_le_mul_of_nonneg_left hSmass (by positivity)
        _ = 4 * K₀ / R ^ B := by
          field_simp [hTpos.ne', (Real.rpow_pos_of_pos hRpos B).ne']
    have hset :
        (Fintype.piFinset (fun _ : Fin 6 => Finset.Icc 1 U)).filter
          (fun v : Fin 6 → ℕ => (∏ r, v r) ≤ U ∧
            T / (1 + h) ^ 2 ≤ ((∏ r ∈ s, v r : ℕ) : ℝ) ∧
            ((∏ r ∈ s, v r : ℕ) : ℝ) ≤ T * (1 + h) ^ 2) =
        (Fintype.piFinset (fun _ : Fin 6 => Finset.Icc 1 U)).filter
          (fun v => (∏ r, v r) ≤ U ∧ (∏ r ∈ s, v r) ∈ S) := by
      ext v
      simp only [Finset.mem_filter]
      constructor
      · rintro ⟨hv, hp, hlo, hhi⟩
        have hvone (r : Fin 6) : 1 ≤ v r :=
          (Finset.mem_Icc.mp (Fintype.mem_piFinset.mp hv r)).1
        have hspos : 0 < ∏ r ∈ s, v r := Finset.prod_pos fun r _ => hvone r
        have hsle : (∏ r ∈ s, v r) ≤ ∏ r, v r :=
          Finset.prod_le_prod_of_subset_of_one_le' (Finset.subset_univ s)
            (fun r _ _ => hvone r)
        exact ⟨hv, hp, Finset.mem_filter.mpr
          ⟨Finset.mem_Icc.mpr ⟨hspos, hsle.trans hp⟩, hlo, hhi⟩⟩
      · rintro ⟨hv, hp, hm⟩
        exact ⟨hv, hp, (hSband _ hm).1, (hSband _ hm).2⟩
    rw [hset]
    have hf := finite_subproduct_divisor_mass_bound 6 U hU s S hSpos
    norm_num only at hf
    apply le_trans hf
    calc
      (U : ℝ) * (1 + Real.log (U : ℝ)) ^ 63 *
          (∑ m ∈ S, (m.divisors.card : ℝ) ^ 6 / (m : ℝ)) ≤
          (8 * (9 : ℝ) ^ 63 * x * R ^ 63) * (4 * K₀ / R ^ B) :=
        mul_le_mul hmoment hreciprocal
          (Finset.sum_nonneg fun m _ => by positivity) (by positivity)
      _ = Km * x / R ^ A := by
        have hcancel : R ^ 63 / R ^ B = 1 / R ^ A := by
          dsimp only [B]
          rw [Real.rpow_add hRpos, Real.rpow_ofNat]
          simpa only [one_mul] using mul_div_mul_right (1 : ℝ)
            (R ^ A) (pow_ne_zero 63 hRpos.ne')
        calc
          _ = Km * x * (R ^ 63 / R ^ B) := by dsimp only [Km]; ring
          _ = _ := by rw [hcancel]; ring
      _ ≤ (Kp + Km) * x / R ^ A := hraise Km (by linarith only [hKp])

open Classical in
theorem sifted_long_active_feature_cell_log_saving
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : ℕ) («ω» δ σ : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hσ : 0 < σ)
    (hσa : 1 / 2 - σ < (40481 : ℝ) / 100000)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1)) :
    ∀ E : ℝ, 0 < E →
      ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
        ∀ x : ℝ, X ≤ x → ∀ l : Fin 6,
        let H := x ^ ((40481 : ℝ) / 100000)
        let z := x ^ ((9519 : ℝ) / 50000)
        let M0 := x ^ (1 - (1058 : ℝ) / 3125)
        let S := x ^ (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000)
        let Bthreshold := x ^ ((59519 : ℝ) / 100000)
        let U := ⌊8 * x⌋₊
        let C := Finset.Icc 1 U
        let A := (Fintype.piFinset (fun _ : Fin 3 => C)).filter (fun a : Fin 3 → ℕ =>
          let u := a 0
          let v := a 1
          let h := a 2
          let r := u * v
          let m := r * h
          m ≤ U ∧
            (match l.val with
              | 0 => u = 1 ∧ v = 1
              | 1 | 2 | 3 => u = 1 ∧ v.Prime ∧ z ≤ (v : ℝ)
              | 4 => u.Prime ∧ v.Prime ∧ z ≤ (u : ℝ) ∧ u < v
              | _ => u.Prime ∧ v.Prime ∧ z ≤ (u : ℝ) ∧ u ≤ v) ∧
            (r : ℝ) < H ∧ 1 < h ∧ ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧
            ((m / h.minFac : ℕ) : ℝ) < H ∧ H ≤ (m : ℝ))
        let B := (Fintype.piFinset (fun _ : Fin 3 => C)).filter (fun b : Fin 3 → ℕ =>
          let s := b 0
          let d := b 1
          let k := b 2
          let n := s * d * k
          n ≤ U ∧ (if l.val ≤ 1 then s = 1 else s.Prime ∧ z ≤ (s : ℝ)) ∧ (s : ℝ) < S)
        let feature (a b : Fin 3 → ℕ) : Fin 7 → ℕ :=
          ![a 0 * a 1 * a 2, (a 2).minFac, if l.val ≤ 3 then a 1 else a 0,
            b 0 * b 1 * b 2, b 0 * b 1, max 1 ((b 1).primeFactors.sup id), b 0]
        let Good (f : Fin 7 → ℕ) : Prop :=
          f 5 < f 1 ∧ M0 < ((f 0 * f 4 : ℕ) : ℝ) ∧
            x ≤ ((f 0 * f 3 : ℕ) : ℝ) ∧ ((f 0 * f 3 : ℕ) : ℝ) ≤ 2 * x ∧
            match l.val with
            | 2 => f 6 < f 2 ∧ ((f 2 * f 6 : ℕ) : ℝ) < H
            | 3 => f 6 < f 2 ∧ Bthreshold < ((f 2 * f 6 : ℕ) : ℝ)
            | 4 => f 6 < f 2
            | 5 => f 2 < f 6
            | _ => True
        ∀ (L : ℕ) (b : ℕ → ℕ) (lo hi : ℕ → ℝ) (h : ℝ),
          0 < h → h ≤ 1 →
        (∀ n i, 1 ≤ n →
          (b n = i ↔ (i ≤ L ∧ n = i) ∨
            (L < i ∧ L < n ∧ lo i ≤ (n : ℝ) ∧ (n : ℝ) < hi i))) →
        (∀ i, i ≤ L → lo i = (i : ℝ) ∧ hi i = (i : ℝ) + 1) →
        (∀ n, 1 ≤ n →
          lo (b n) ≤ (n : ℝ) ∧
            (n : ℝ) ≤ (if b n ≤ L then lo (b n) else hi (b n)) ∧
            (if b n ≤ L then lo (b n) else hi (b n)) ≤ (1 + h) * lo (b n)) →
        ∀ c : Fin 7 → ℕ,
        (∃ a ∈ A, ∃ d ∈ B, Good (feature a d) ∧
          ∀ r : Fin 7, b (feature a d r) = c r) →
        ∀ positive : Bool,
        let w : (Fin 3 → ℕ) → (Fin 3 → ℕ) → ℂ := fun a d =>
          ((if positive then |ArithmeticFunction.moebius (a 2)|
            else ArithmeticFunction.moebius (a 2) : ℤ) : ℂ) *
          ((if positive then |ArithmeticFunction.moebius (d 1)|
            else ArithmeticFunction.moebius (d 1) : ℤ) : ℂ)
        let F : ℕ →₀ ℂ := ∑ a ∈ A, ∑ d ∈ B,
          Finsupp.single (feature a d 0 * feature a d 3)
            (if ∀ r : Fin 7, b (feature a d r) = c r then w a d else 0)
        ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
        ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
          (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
              q ∣ (∏ p ∈ I, p) ∧
                Nonempty (DenseDivisibilityWitness
                  ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩
                  j q)),
            ‖fullDiscrepancy F q a‖) ≤ K * x / (Real.log x) ^ E := by
  have hgeometry (x σ h M N m n : ℝ)
      (hx : 1 < x) (hx8 : 8 ≤ x)
      (hthreshold : 4 ≤ x ^ ((40481 : ℝ) / 100000 - (1 / 2 - σ)))
      (hh : h ≤ 1) (hM : 0 < M) (hN : 0 < N)
      (hm : M ≤ m ∧ m ≤ (1 + h) * M)
      (hn : N ≤ n ∧ n ≤ (1 + h) * N)
      (hprod : x ≤ m * n ∧ m * n ≤ 2 * x)
      (hma : x ^ ((40481 : ℝ) / 100000) ≤ m)
      (hna : x ^ ((40481 : ℝ) / 100000) ≤ n)
      (hmcap : m ≤ 2 * x) (hncap : n ≤ 2 * x) :
      x / 16 ≤ M * N ∧ M * N ≤ 16 * x ∧
        x ^ (1 / 2 - σ) ≤ min M N / 2 ∧
        min M N / 2 ≤ x ^ (1 / 2 : ℝ) ∧ M ≤ x ^ 2 ∧ N ≤ x ^ 2 := by
    clear * - x σ h M N m n hx hx8 hthreshold hh hM hN hm hn hprod hma hna hmcap hncap
    let a : ℝ := 40481 / 100000
    let c : ℝ := 1 / 2 - σ
    change 4 ≤ x ^ (a - c) at hthreshold
    change x ^ a ≤ m at hma
    change x ^ a ≤ n at hna
    have hx0 : 0 < x := zero_lt_one.trans hx
    have hm0 : 0 < m := hM.trans_le hm.1
    have hn0 : 0 < n := hN.trans_le hn.1
    have hmhi : m ≤ 2 * M := hm.2.trans
      (mul_le_mul_of_nonneg_right (by linarith only [hh] : 1 + h ≤ 2) hM.le)
    have hnhi : n ≤ 2 * N := hn.2.trans
      (mul_le_mul_of_nonneg_right (by linarith only [hh] : 1 + h ≤ 2) hN.le)
    have hMN0 : 0 < M * N := mul_pos hM hN
    have hMNhi : M * N ≤ 2 * x :=
      (mul_le_mul hm.1 hn.1 hN.le hm0.le).trans hprod.2
    have hmnhi : m * n ≤ 4 * (M * N) := by
      calc
        m * n ≤ (2 * M) * (2 * N) :=
          mul_le_mul hmhi hnhi hn0.le (by positivity)
        _ = 4 * (M * N) := by ring
    have hpower : 4 * x ^ c ≤ x ^ a := by
      calc
        4 * x ^ c ≤ x ^ (a - c) * x ^ c :=
          mul_le_mul_of_nonneg_right hthreshold (Real.rpow_pos_of_pos hx0 c).le
        _ = x ^ a := by
          rw [← Real.rpow_add hx0]
          congr 1
          ring
    have hminlo : x ^ c ≤ min M N / 2 := by
      have hlow : 2 * x ^ c ≤ min M N :=
        le_min (by linarith only [hpower.trans hma, hmhi])
          (by linarith only [hpower.trans hna, hnhi])
      linarith only [hlow]
    have hmin0 : 0 ≤ min M N := le_min hM.le hN.le
    have hminsq : (min M N) ^ 2 ≤ M * N := by
      simpa only [pow_two] using
        mul_le_mul (min_le_left M N) (min_le_right M N) hmin0 hM.le
    have hminhi : min M N / 2 ≤ x ^ (1 / 2 : ℝ) := by
      rw [← Real.sqrt_eq_rpow]
      apply Real.le_sqrt_of_sq_le
      nlinarith only [hminsq, hMNhi, hx0]
    have htwo : 2 * x ≤ x ^ 2 := by
      have hx2 : (2 : ℝ) ≤ x := by linarith only [hx8]
      simpa only [pow_two] using mul_le_mul_of_nonneg_right hx2 hx0.le
    exact ⟨by nlinarith only [hprod.1.trans hmnhi, hMN0],
      by nlinarith only [hMNhi, hx0],
      hminlo, hminhi, hm.1.trans (hmcap.trans htwo), hn.1.trans (hncap.trans htwo)⟩
  have hpush (U : ℕ) (P : ℕ → ℕ → ℕ → Prop)
      [∀ u v t, Decidable (P u v t)] (w : ℕ → ℕ → ℕ → ℂ) :
      (∑ v ∈ (Fintype.piFinset (fun _ : Fin 3 => Finset.Icc 1 U)).filter
          (fun v => v 0 * v 1 * v 2 ≤ U ∧ P (v 0) (v 1) (v 2)),
        Finsupp.single (v 0 * v 1 * v 2) (w (v 0) (v 1) (v 2))) =
        ∑ n ∈ Finset.Icc 1 U, Finsupp.single n
          (∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
            if P aa.1 bb.1 bb.2 then w aa.1 bb.1 bb.2 else 0) := by
    clear * - U P w
    classical
    calc
      _ = ∑ v ∈ Fintype.piFinset (fun _ : Fin 3 => Finset.Icc 1 U),
          Finsupp.single (∏ j, v j)
            (if (∏ j, v j) ≤ U then
              if P (v 0) (v 1) (v 2) then w (v 0) (v 1) (v 2) else 0
            else 0) := by
        rw [Finset.sum_filter]
        apply Finset.sum_congr rfl
        intro v _
        simp only [Fin.prod_univ_three]
        by_cases hcut : v 0 * v 1 * v 2 ≤ U <;>
          by_cases hp : P (v 0) (v 1) (v 2) <;> simp [hcut, hp]
      _ = _ := three_positive_factor_pushforward U
        (fun a b c => if P a b c then w a b c else 0)
  have hresize (U : ℕ) (M a b : ℝ)
      (hMU : ⌊2 * M⌋₊ ≤ U) (hb : b ≤ 2 * M) (w : ℕ → ℂ) :
      (∑ n ∈ Finset.Icc 1 U,
        Finsupp.single n (if a ≤ (n : ℝ) ∧ (n : ℝ) ≤ b then w n else 0)) =
        ∑ n ∈ Finset.Icc 1 ⌊2 * M⌋₊,
          Finsupp.single n (if a ≤ (n : ℝ) ∧ (n : ℝ) ≤ b then w n else 0) := by
    clear * - U M a b hMU hb w
    classical
    symm
    apply Finset.sum_subset
    · intro n hn
      exact Finset.mem_Icc.mpr
        ⟨(Finset.mem_Icc.mp hn).1, (Finset.mem_Icc.mp hn).2.trans hMU⟩
    · intro n hn hnsmall
      have hnot : ¬(a ≤ (n : ℝ) ∧ (n : ℝ) ≤ b) := by
        intro hband
        exact hnsmall (Finset.mem_Icc.mpr
          ⟨(Finset.mem_Icc.mp hn).1, Nat.le_floor (hband.2.trans hb)⟩)
      simp [hnot]
  have hunitFiber (n : ℕ) (hn : 0 < n) (W : ℕ → ℂ) (P : ℕ → Prop)
      [DecidablePred P] :
      (∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
        if aa.1 = 1 ∧ bb.1 = 1 ∧ P bb.2 then W bb.2 else 0) =
        if P n then W n else 0 := by
    clear * - n hn W P
    have hmem : (1, n) ∈ n.divisorsAntidiagonal :=
      Nat.mem_divisorsAntidiagonal.mpr ⟨one_mul n, hn.ne'⟩
    have hfirstNe (v : ℕ × ℕ) (hv : v ∈ n.divisorsAntidiagonal)
        (hne : v ≠ (1, n)) : v.1 ≠ 1 := by
      intro hfirst
      apply hne
      exact Prod.ext hfirst (by
        simpa [hfirst] using (Nat.mem_divisorsAntidiagonal.mp hv).1)
    calc
      _ = ∑ bb ∈ n.divisorsAntidiagonal,
          if bb.1 = 1 ∧ P bb.2 then W bb.2 else 0 := by
        refine (Finset.sum_eq_single_of_mem (1, n) hmem ?_).trans ?_
        · intro aa haa hne
          apply Finset.sum_eq_zero
          intro bb _
          exact ite_eq_right (fun h => hfirstNe aa haa hne h.1)
        · simp
      _ = if P n then W n else 0 := by
        refine (Finset.sum_eq_single_of_mem (1, n) hmem ?_).trans ?_
        · intro bb hbb hne
          exact ite_eq_right (fun h => hfirstNe bb hbb hne h.1)
        · simp
  have hBpredicate (l : Fin 6) (z S : ℝ) (b : ℕ → ℕ) (c : Fin 7 → ℕ)
      (lower upper : ℕ → ℕ)
      (hiff : ∀ n i : ℕ, 1 ≤ n →
        (b n = i ↔ lower i ≤ n ∧ n ≤ upper i))
      (hlo : ∀ i : ℕ, 1 ≤ lower i)
      (s d k : ℕ) (hs : 0 < s) (hd : 0 < d) (hk : 0 < k) :
      ((if l.val ≤ 1 then s = 1 else s.Prime ∧ z ≤ (s : ℝ)) ∧
        (s : ℝ) < S ∧ b (s * d * k) = c 3 ∧ b (s * d) = c 4 ∧
        b (max 1 (d.primeFactors.sup id)) = c 5 ∧ b s = c 6) ↔
      ((lower (c 3) : ℝ) ≤ ((s * d * k : ℕ) : ℝ) ∧
        ((s * d * k : ℕ) : ℝ) ≤ (upper (c 3) : ℝ)) ∧
      ((if (if l.val ≤ 1 then (0 : Fin 2) else 1) = 0
          then s = 1 else s.Prime) ∧
        max (lower (c 6) : ℝ) (if l.val ≤ 1 then 0 else z) ≤ (s : ℝ) ∧
        (s : ℝ) ≤ min (upper (c 6) : ℝ) ((⌈S⌉₊ - 1 : ℕ) : ℝ) ∧
        (lower (c 5) : ℝ) ≤ ((max 1 (d.primeFactors.sup id) : ℕ) : ℝ) ∧
        ((max 1 (d.primeFactors.sup id) : ℕ) : ℝ) <
          ((upper (c 5) + 1 : ℕ) : ℝ) ∧
        (lower (c 4) : ℝ) ≤ ((s * d : ℕ) : ℝ) ∧
        ((s * d : ℕ) : ℝ) ≤ (upper (c 4) : ℝ)) := by
    clear * - l z S b c lower upper hiff hlo s d k hs hd hk
    have hbin (m i : ℕ) (hm : 1 ≤ m) :
        b m = i ↔ (lower i : ℝ) ≤ (m : ℝ) ∧ (m : ℝ) ≤ (upper i : ℝ) := by
      simpa only [Nat.cast_le] using hiff m i hm
    have hscut : (s : ℝ) < S ↔ (s : ℝ) ≤ ((⌈S⌉₊ - 1 : ℕ) : ℝ) := by
      rw [← Nat.lt_ceil, Nat.cast_le]
      omega
    have hPmax :
        ((max 1 (d.primeFactors.sup id) : ℕ) : ℝ) ≤ (upper (c 5) : ℝ) ↔
        ((max 1 (d.primeFactors.sup id) : ℕ) : ℝ) <
          ((upper (c 5) + 1 : ℕ) : ℝ) := by
      exact_mod_cast (show max 1 (d.primeFactors.sup id) ≤ upper (c 5) ↔
        max 1 (d.primeFactors.sup id) < upper (c 5) + 1 by omega)
    have hloR : (0 : ℝ) ≤ (lower (c 6) : ℝ) := by
      exact_mod_cast (Nat.zero_le 1).trans (hlo (c 6))
    rw [hscut,
      hbin (s * d * k) (c 3) (Nat.succ_le_of_lt (Nat.mul_pos (Nat.mul_pos hs hd) hk)),
      hbin (s * d) (c 4) (Nat.succ_le_of_lt (Nat.mul_pos hs hd)),
      hbin (max 1 (d.primeFactors.sup id)) (c 5) (le_max_left _ _),
      hbin s (c 6) (Nat.succ_le_of_lt hs), ← hPmax]
    by_cases hl : l.val ≤ 1
    · simp only [ite_eq_left hl]
      rw [max_eq_left hloR]
      norm_num [le_min_iff]; tauto
    · simp only [ite_eq_right hl]
      norm_num [max_le_iff, le_min_iff]; tauto
  have hAunitPredicate (H z : ℝ) (hH : 1 < H) (b : ℕ → ℕ)
      (c : Fin 7 → ℕ) (lower upper : ℕ → ℕ)
      (hiff : ∀ n i : ℕ, 1 ≤ n →
        (b n = i ↔ lower i ≤ n ∧ n ≤ upper i))
      (hlabel : b 1 = c 2) (u v t : ℕ) :
      (((u = 1 ∧ v = 1) ∧ ((u * v : ℕ) : ℝ) < H ∧ 1 < t ∧
          ((max 1 (t.primeFactors.sup id) : ℕ) : ℝ) < z ∧
          ((u * v * t / t.minFac : ℕ) : ℝ) < H ∧
          H ≤ ((u * v * t : ℕ) : ℝ)) ∧
        (b (u * v * t) = c 0 ∧ b t.minFac = c 1 ∧ b v = c 2)) ↔
      u = 1 ∧ v = 1 ∧
        (b t = c 0 ∧
          ((1 < t ∧ ((max 1 (t.primeFactors.sup id) : ℕ) : ℝ) < z ∧
              ((t / t.minFac : ℕ) : ℝ) < H ∧ H ≤ (t : ℝ)) ∧
            (lower (c 1) : ℝ) ≤ (t.minFac : ℝ) ∧
            (t.minFac : ℝ) ≤ (upper (c 1) : ℝ))) := by
    clear * - H z hH b c lower upper hiff hlabel u v t
    have hminBin : b t.minFac = c 1 ↔
        (lower (c 1) : ℝ) ≤ (t.minFac : ℝ) ∧
        (t.minFac : ℝ) ≤ (upper (c 1) : ℝ) := by
      simpa only [Nat.cast_le] using
        hiff t.minFac (c 1) (Nat.succ_le_of_lt (Nat.minFac_pos t))
    by_cases hu : u = 1
    · subst u
      by_cases hv : v = 1
      · subst v
        simp [hH, hlabel, hminBin]; tauto
      · simp [hv]
    · simp [hu]
  intro E hE
  obtain ⟨K, X₀, hK, hX₀, htypeII⟩ :=
    harman_literal_box_typeII_coherent_log_saving hDeligne j «ω» δ σ 16
      hω hδ hσ (by norm_num) hsource E hE
  have hpower : ∀ᶠ x : ℝ in Filter.atTop,
      4 ≤ x ^ ((40481 : ℝ) / 100000 - (1 / 2 - σ)) :=
    (tendsto_rpow_atTop (sub_pos.mpr hσa)).eventually (Filter.eventually_ge_atTop 4)
  obtain ⟨X₁, hX₁⟩ := Filter.eventually_atTop.mp hpower
  refine ⟨K, max X₀ (max 8 X₁), hK, hX₀.trans (le_max_left _ _), ?_⟩
  intro x hx l H z M0 S Bthreshold U C A B feature Good
    L b lo hi h hh hh1 hcell hlowends hends c hactive positive w F I hI a ha
  have hx₀ : X₀ ≤ x := (le_max_left _ _).trans hx
  have hx8 : 8 ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans hx)
  have hx1 : 1 < x := by linarith only [hx8]
  have hxpos : 0 < x := zero_lt_one.trans hx1
  have hpow := hX₁ x ((le_max_right _ _).trans ((le_max_right _ _).trans hx))
  have hz : 0 < z := Real.rpow_pos_of_pos hxpos _
  have hH : 1 < H := Real.one_lt_rpow hx1 (by norm_num)
  let lower : ℕ → ℕ := fun i => max 1
    (if i ≤ L then i else max (L + 1) ⌈lo i⌉₊)
  let upper : ℕ → ℕ := fun i => if i ≤ L then i else ⌈hi i⌉₊ - 1
  have hclosed := harman_feature_cell_closed_interval L b lo hi hcell hlowends
  change (∀ i, 1 ≤ lower i) ∧
    (∀ n i, 1 ≤ n → (b n = i ↔ lower i ≤ n ∧ n ≤ upper i)) ∧
    (∀ n i, 1 ≤ n → b n = i →
      lo i ≤ (lower i : ℝ) ∧ (lower i : ℝ) ≤ (n : ℝ) ∧
      (n : ℝ) ≤ (upper i : ℝ) ∧
      (upper i : ℝ) ≤ (if i ≤ L then lo i else hi i)) at hclosed
  obtain ⟨hlower, hcellNat, hcellBounds⟩ := hclosed
  have hcellReal (n : ℕ) (r : Fin 7) (hn : 1 ≤ n) :
      b n = c r ↔ (lower (c r) : ℝ) ≤ (n : ℝ) ∧ (n : ℝ) ≤ (upper (c r) : ℝ) := by
    simpa only [Nat.cast_le] using hcellNat n (c r) hn
  obtain ⟨a₀, ha₀, d₀, hd₀, hgood, hkey⟩ := hactive
  obtain ⟨haT, _haU, haCase, _haR, haH, haCap, haPrevious, haCrossing⟩ :=
    Finset.mem_filter.mp ha₀
  obtain ⟨hdT, _hdU, _hdCase, _hdSmall⟩ := Finset.mem_filter.mp hd₀
  have haPos (i : Fin 3) : 1 ≤ a₀ i :=
    (Finset.mem_Icc.mp (Fintype.mem_piFinset.mp haT i)).1
  have hdPos (i : Fin 3) : 1 ≤ d₀ i :=
    (Finset.mem_Icc.mp (Fintype.mem_piFinset.mp hdT i)).1
  let m₀ : ℕ := a₀ 0 * a₀ 1 * a₀ 2
  let n₀ : ℕ := d₀ 0 * d₀ 1 * d₀ 2
  have hmpos : 0 < m₀ := by
    dsimp only [m₀]
    exact Nat.mul_pos (Nat.mul_pos (haPos 0) (haPos 1)) (haPos 2)
  have hnpos : 0 < n₀ := by
    dsimp only [n₀]
    exact Nat.mul_pos (Nat.mul_pos (hdPos 0) (hdPos 1)) (hdPos 2)
  obtain ⟨_hprime, hlong, hprodLo, hprodHi, _hextra⟩ := hgood
  change M0 < ((m₀ * (d₀ 0 * d₀ 1) : ℕ) : ℝ) at hlong
  change x ≤ ((m₀ * n₀ : ℕ) : ℝ) at hprodLo
  change ((m₀ * n₀ : ℕ) : ℝ) ≤ 2 * x at hprodHi
  have hproduct : x ≤ (m₀ : ℝ) * (n₀ : ℝ) ∧ (m₀ : ℝ) * (n₀ : ℝ) ≤ 2 * x := by
    simpa only [Nat.cast_mul] using And.intro hprodLo hprodHi
  have hprevious : ((a₀ 0 * a₀ 1 * a₀ 2 : ℕ) : ℝ) /
      ((a₀ 2).minFac : ℝ) < H := by
    rw [← Nat.cast_div_charZero
      (dvd_mul_of_dvd_right (Nat.minFac_dvd (a₀ 2)) (a₀ 0 * a₀ 1))]
    exact haPrevious
  have hproductEq :
      a₀ 0 * a₀ 1 * d₀ 0 * a₀ 2 * d₀ 1 * d₀ 2 = m₀ * n₀ := by
    dsimp only [m₀, n₀]
    ring
  have hlongEq :
      a₀ 0 * a₀ 1 * d₀ 0 * a₀ 2 * d₀ 1 = m₀ * (d₀ 0 * d₀ 1) := by
    dsimp only [m₀]
    ring
  have hscales := restricted_harman_long_source_scales x hx1
    (a₀ 0 * a₀ 1) (d₀ 0) (a₀ 2) (d₀ 1) (d₀ 2)
    (hdPos 0) haH (hdPos 1) (hdPos 2) haCap hprevious haCrossing
    (by simpa only [hproductEq] using And.intro hprodLo hprodHi)
    (by simpa only [hlongEq] using hlong)
  have hma : x ^ ((40481 : ℝ) / 100000) ≤ (m₀ : ℝ) := hscales.1
  have hna : x ^ ((40481 : ℝ) / 100000) ≤ (n₀ : ℝ) := hscales.2.2.1.le
  have hmcap : (m₀ : ℝ) ≤ 2 * x :=
    (le_mul_of_one_le_right (Nat.cast_nonneg m₀) (by exact_mod_cast hnpos)).trans hproduct.2
  have hncap : (n₀ : ℝ) ≤ 2 * x :=
    (le_mul_of_one_le_left (Nat.cast_nonneg n₀) (by exact_mod_cast hmpos)).trans hproduct.2
  have hkm : b m₀ = c 0 := hkey 0
  have hkn : b n₀ = c 3 := hkey 3
  let M : ℝ := lo (c 0)
  let N : ℝ := lo (c 3)
  have hmEnds := hends m₀ hmpos
  have hnEnds := hends n₀ hnpos
  rw [hkm] at hmEnds
  rw [hkn] at hnEnds
  have hmBox : M ≤ (m₀ : ℝ) ∧ (m₀ : ℝ) ≤ (1 + h) * M :=
    ⟨hmEnds.1, hmEnds.2.1.trans hmEnds.2.2⟩
  have hnBox : N ≤ (n₀ : ℝ) ∧ (n₀ : ℝ) ≤ (1 + h) * N :=
    ⟨hnEnds.1, hnEnds.2.1.trans hnEnds.2.2⟩
  have hM : 0 < M := pos_of_mul_pos_right
    ((by exact_mod_cast hmpos : (0 : ℝ) < m₀).trans_le hmBox.2) (by linarith only [hh])
  have hN : 0 < N := pos_of_mul_pos_right
    ((by exact_mod_cast hnpos : (0 : ℝ) < n₀).trans_le hnBox.2) (by linarith only [hh])
  have hmClosed := hcellBounds m₀ (c 0) hmpos hkm
  have hnClosed := hcellBounds n₀ (c 3) hnpos hkn
  have hAl : M ≤ (lower (c 0) : ℝ) := hmClosed.1
  have hAu : (upper (c 0) : ℝ) ≤ 2 * M := by
    have hup := hmClosed.2.2.2.trans hmEnds.2.2
    have hlast := mul_le_mul_of_nonneg_right
      (by linarith only [hh1] : 1 + h ≤ 2) hM.le
    exact hup.trans hlast
  have hBl : N ≤ (lower (c 3) : ℝ) := hnClosed.1
  have hBu : (upper (c 3) : ℝ) ≤ 2 * N := by
    have hup := hnClosed.2.2.2.trans hnEnds.2.2
    exact hup.trans (mul_le_mul_of_nonneg_right
      (by linarith only [hh1] : 1 + h ≤ 2) hN.le)
  have hMU : ⌊2 * M⌋₊ ≤ U := Nat.floor_mono (by
    have hm := hmBox.1.trans hmcap
    linarith only [hm, hxpos])
  have hNU : ⌊2 * N⌋₊ ≤ U := Nat.floor_mono (by
    have hn := hnBox.1.trans hncap
    linarith only [hn, hxpos])
  obtain ⟨hpLo, hpHi, hminLo, hminHi, hMpow, hNpow⟩ :=
    hgeometry x σ h M N (m₀ : ℝ) (n₀ : ℝ) hx1 hx8 hpow hh1 hM hN
      hmBox hnBox hproduct hma hna hmcap hncap
  let caseA : ℕ → ℕ → Prop := fun u v =>
    match l.val with
    | 0 => u = 1 ∧ v = 1
    | 1 | 2 | 3 => u = 1 ∧ v.Prime ∧ z ≤ (v : ℝ)
    | 4 => u.Prime ∧ v.Prime ∧ z ≤ (u : ℝ) ∧ u < v
    | _ => u.Prime ∧ v.Prime ∧ z ≤ (u : ℝ) ∧ u ≤ v
  let baseA : ℕ → ℕ → ℕ → Prop := fun u v t =>
    caseA u v ∧ ((u * v : ℕ) : ℝ) < H ∧ 1 < t ∧
      ((max 1 (t.primeFactors.sup id) : ℕ) : ℝ) < z ∧
      ((u * v * t / t.minFac : ℕ) : ℝ) < H ∧ H ≤ ((u * v * t : ℕ) : ℝ)
  let baseB : ℕ → ℕ → ℕ → Prop := fun s _ _ =>
    (if l.val ≤ 1 then s = 1 else s.Prime ∧ z ≤ (s : ℝ)) ∧ (s : ℝ) < S
  let labelsA : (Fin 3 → ℕ) → Prop := fun v =>
    b (v 0 * v 1 * v 2) = c 0 ∧ b ((v 2).minFac) = c 1 ∧
      b (if l.val ≤ 3 then v 1 else v 0) = c 2
  let labelsB : (Fin 3 → ℕ) → Prop := fun v =>
    b (v 0 * v 1 * v 2) = c 3 ∧ b (v 0 * v 1) = c 4 ∧
      b (max 1 ((v 1).primeFactors.sup id)) = c 5 ∧ b (v 0) = c 6
  let PA : ℕ → ℕ → ℕ → Prop := fun u v t =>
    baseA u v t ∧ b (u * v * t) = c 0 ∧ b t.minFac = c 1 ∧
      b (if l.val ≤ 3 then v else u) = c 2
  let PB : ℕ → ℕ → ℕ → Prop := fun s d k =>
    baseB s d k ∧ b (s * d * k) = c 3 ∧ b (s * d) = c 4 ∧
      b (max 1 (d.primeFactors.sup id)) = c 5 ∧ b s = c 6
  let Ac := A.filter labelsA
  let Bc := B.filter labelsB
  let wZ : ℕ → ℤ := fun t =>
    if positive then |ArithmeticFunction.moebius t| else ArithmeticFunction.moebius t
  let wC : ℕ → ℂ := fun t => (wZ t : ℂ)
  let jA : Fin 3 := if l.val = 0 then 0 else if l.val ≤ 3 then 1 else 2
  let jB : Fin 2 := if l.val ≤ 1 then 0 else 1
  let P : ℕ → ℕ → Prop := fun u _ =>
    if l.val ≤ 3 then True else
      (lower (c 2) : ℝ) ≤ (u : ℝ) ∧ (u : ℝ) ≤ (upper (c 2) : ℝ)
  clear_value (hPdef : P = _)
  let Lfn : ℕ → ℕ → ℝ := fun u _ =>
    if l.val ≤ 3 then (lower (c 2) : ℝ)
    else if l.val = 4 then ((u + 1 : ℕ) : ℝ) else 0
  let Ufn : ℕ → ℕ → ℝ := fun _ _ =>
    if l.val ≤ 3 then (upper (c 2) : ℝ) else (U : ℝ)
  let slo : ℝ := max (lower (c 6) : ℝ) (if l.val ≤ 1 then 0 else z)
  let shi : ℝ := min (upper (c 6) : ℝ) ((⌈S⌉₊ - 1 : ℕ) : ℝ)
  let Zlo : ℝ := (lower (c 5) : ℝ)
  let Zhi : ℝ := ((upper (c 5) + 1 : ℕ) : ℝ)
  let unitP : ℕ → Prop := fun n =>
    (1 < n ∧ ((max 1 (n.primeFactors.sup id) : ℕ) : ℝ) < z ∧
      ((n / n.minFac : ℕ) : ℝ) < H ∧ H ≤ (n : ℝ)) ∧
      (lower (c 1) : ℝ) ≤ (n.minFac : ℝ) ∧
      (n.minFac : ℝ) ≤ (upper (c 1) : ℝ)
  let Acond : ℕ → ℕ → ℕ → ℕ → Prop := fun n u v t =>
    (if jA = 1 then u = 1 else u.Prime ∧ z ≤ (u : ℝ) ∧ u ≤ v) ∧
      v.Prime ∧ z ≤ (v : ℝ) ∧ 1 < t ∧
      ((max 1 (t.primeFactors.sup id) : ℕ) : ℝ) < z ∧
      (P u t ∧ (lower (c 1) : ℝ) ≤ (t.minFac : ℝ) ∧
        (t.minFac : ℝ) ≤ (upper (c 1) : ℝ)) ∧
      Lfn u t ≤ (v : ℝ) ∧ (v : ℝ) ≤ Ufn u t ∧
      ((u * v : ℕ) : ℝ) < H ∧
      ((n / t.minFac : ℕ) : ℝ) < H ∧ H ≤ (n : ℝ)
  let Bcond : ℕ → ℕ → ℕ → Prop := fun s d _ =>
    (if jB = 0 then s = 1 else s.Prime) ∧
      slo ≤ (s : ℝ) ∧ (s : ℝ) ≤ shi ∧
      Zlo ≤ ((max 1 (d.primeFactors.sup id) : ℕ) : ℝ) ∧
      ((max 1 (d.primeFactors.sup id) : ℕ) : ℝ) < Zhi ∧
      (lower (c 4) : ℝ) ≤ ((s * d : ℕ) : ℝ) ∧
      ((s * d : ℕ) : ℝ) ≤ (upper (c 4) : ℝ)
  let A0 : ℕ → ℤ := fun n =>
    if jA = 0 then if unitP n then wZ n else 0 else
      ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
        if Acond n aa.1 bb.1 bb.2 then wZ bb.2 else 0
  let B0 : ℕ → ℤ := fun n =>
    ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
      if Bcond aa.1 bb.1 bb.2 then wZ bb.1 else 0
  have hAc :
      Ac = (Fintype.piFinset (fun _ : Fin 3 => Finset.Icc 1 U)).filter
        (fun v => v 0 * v 1 * v 2 ≤ U ∧ PA (v 0) (v 1) (v 2)) := by
    ext v
    simp only [Ac, A, C, PA, baseA, caseA, labelsA,
      Finset.mem_filter, and_assoc]
  have hBc :
      Bc = (Fintype.piFinset (fun _ : Fin 3 => Finset.Icc 1 U)).filter
        (fun v => v 0 * v 1 * v 2 ≤ U ∧ PB (v 0) (v 1) (v 2)) := by
    ext v
    simp only [Bc, B, C, PB, baseB, labelsB, Finset.mem_filter, and_assoc]
  have hnamed (hl : l.val ≠ 0) (u v t : ℕ) (hu : 1 ≤ u) (hv : 1 ≤ v)
      (hvU : v ≤ U) :
      (caseA u v ∧ b (if l.val ≤ 3 then v else u) = c 2) ↔
        (if jA = 1 then u = 1 else u.Prime ∧ z ≤ (u : ℝ) ∧ u ≤ v) ∧
          v.Prime ∧ z ≤ (v : ℝ) ∧ P u t ∧
          Lfn u t ≤ (v : ℝ) ∧ (v : ℝ) ≤ Ufn u t := by
    rw [hPdef]
    clear * - hl hu hv hvU hcellReal
    have hvUR : (v : ℝ) ≤ (U : ℝ) := by exact_mod_cast hvU
    fin_cases l
    · exact (hl rfl).elim
    · simp [caseA, jA, Lfn, Ufn, hcellReal v 2 hv, and_assoc]
    · simp [caseA, jA, Lfn, Ufn, hcellReal v 2 hv, and_assoc]
    · simp [caseA, jA, Lfn, Ufn, hcellReal v 2 hv, and_assoc]
    · change (u.Prime ∧ v.Prime ∧ z ≤ (u : ℝ) ∧ u < v) ∧ b u = c 2 ↔
        (u.Prime ∧ z ≤ (u : ℝ) ∧ u ≤ v) ∧ v.Prime ∧ z ≤ (v : ℝ) ∧
          ((lower (c 2) : ℝ) ≤ (u : ℝ) ∧ (u : ℝ) ≤ (upper (c 2) : ℝ)) ∧
          ((u + 1 : ℕ) : ℝ) ≤ (v : ℝ) ∧ (v : ℝ) ≤ (U : ℝ)
      rw [hcellReal u 2 hu]
      constructor
      · rintro ⟨⟨hup, hvp, hzu, huv⟩, hbin⟩
        have huvR : (u : ℝ) ≤ (v : ℝ) := by exact_mod_cast huv.le
        have hsucc : ((u + 1 : ℕ) : ℝ) ≤ (v : ℝ) := by
          exact_mod_cast (Nat.succ_le_iff.mpr huv)
        exact ⟨⟨hup, hzu, huv.le⟩, hvp, hzu.trans huvR, hbin, hsucc, hvUR⟩
      · rintro ⟨⟨hup, hzu, _huv⟩, hvp, _hzv, hbin, hsucc, _hvU⟩
        have huv : u < v := Nat.lt_of_succ_le (by exact_mod_cast hsucc)
        exact ⟨⟨hup, hvp, hzu, huv⟩, hbin⟩
    · change (u.Prime ∧ v.Prime ∧ z ≤ (u : ℝ) ∧ u ≤ v) ∧ b u = c 2 ↔
        (u.Prime ∧ z ≤ (u : ℝ) ∧ u ≤ v) ∧ v.Prime ∧ z ≤ (v : ℝ) ∧
          ((lower (c 2) : ℝ) ≤ (u : ℝ) ∧ (u : ℝ) ≤ (upper (c 2) : ℝ)) ∧
          (0 : ℝ) ≤ (v : ℝ) ∧ (v : ℝ) ≤ (U : ℝ)
      rw [hcellReal u 2 hu]
      constructor
      · rintro ⟨⟨hup, hvp, hzu, huv⟩, hbin⟩
        have huvR : (u : ℝ) ≤ (v : ℝ) := by exact_mod_cast huv
        exact ⟨⟨hup, hzu, huv⟩, hvp, hzu.trans huvR, hbin, Nat.cast_nonneg v, hvUR⟩
      · rintro ⟨⟨hup, hzu, huv⟩, hvp, _hzv, hbin, _hv0, _hvU⟩
        exact ⟨⟨hup, hvp, hzu, huv⟩, hbin⟩
  have hPA_named (hl : l.val ≠ 0) (n u v t : ℕ) (hn : 1 ≤ n) (hnU : n ≤ U)
      (hu : 1 ≤ u) (hv : 1 ≤ v) (_ht : 1 ≤ t) (hproduct : u * v * t = n) :
      PA u v t ↔
        ((lower (c 0) : ℝ) ≤ (n : ℝ) ∧ (n : ℝ) ≤ (upper (c 0) : ℝ)) ∧
          Acond n u v t := by
    clear * - hl hn hnU hu hv hproduct hnamed hcellReal
    have hvd : v ∣ n := ⟨u * t, by rw [← hproduct]; ring⟩
    have hvU : v ≤ U := (Nat.le_of_dvd hn hvd).trans hnU
    by_cases ht1 : 1 < t
    · have hmin : 1 ≤ t.minFac := (Nat.minFac_prime ht1.ne').pos
      constructor
      · rintro ⟨⟨hcase, hr, _ht, hcap, hprev, hcross⟩, hpc, hmc, hnc⟩
        obtain ⟨hj, hpv, hzv, hP, hL, hU⟩ := (hnamed hl u v t hu hv hvU).mp ⟨hcase, hnc⟩
        have hpbin := (hcellReal n 0 hn).mp (by simpa only [hproduct] using hpc)
        have hmbin := (hcellReal t.minFac 1 hmin).mp hmc
        refine ⟨hpbin, hj, hpv, hzv, ht1, hcap, ⟨hP, hmbin⟩, hL, hU, hr, ?_, ?_⟩
        · simpa only [hproduct] using hprev
        · simpa only [hproduct] using hcross
      · rintro ⟨hpc, hj, hpv, hzv, _ht, hcap, ⟨hP, hml, hmu⟩, hL, hU, hr, hprev, hcross⟩
        obtain ⟨hcase, hnc⟩ := (hnamed hl u v t hu hv hvU).mpr
          ⟨hj, hpv, hzv, hP, hL, hU⟩
        refine ⟨⟨hcase, hr, ht1, hcap, ?_, ?_⟩, ?_, ?_, hnc⟩
        · simpa only [hproduct] using hprev
        · simpa only [hproduct] using hcross
        · simpa only [hproduct] using (hcellReal n 0 hn).mpr hpc
        · exact (hcellReal t.minFac 1 hmin).mpr ⟨hml, hmu⟩
    · simp only [PA, baseA, Acond, ht1, false_and, and_false]
  have hunitLabel (hl : l.val = 0) : b 1 = c 2 := by
    clear * - hl haCase hkey
    have hcase : a₀ 0 = 1 ∧ a₀ 1 = 1 := by simpa only [hl] using haCase
    simpa [feature, hl, hcase.2] using hkey 2
  have hPA_unit (hl : l.val = 0) (u v t : ℕ) :
      PA u v t ↔ u = 1 ∧ v = 1 ∧ (b t = c 0 ∧ unitP t) := by
    clear * - hl hAunitPredicate hH hcellNat hunitLabel
    simpa only [PA, baseA, caseA, unitP, hl, show (0 : ℕ) ≤ 3 from by decide,
      ite_true] using
      hAunitPredicate H z hH b c lower upper hcellNat (hunitLabel hl) u v t
  have hdivData (n : ℕ) (_hn : 1 ≤ n) (aa bb : ℕ × ℕ)
      (haa : aa ∈ n.divisorsAntidiagonal) (hbb : bb ∈ aa.2.divisorsAntidiagonal) :
      1 ≤ aa.1 ∧ 1 ≤ bb.1 ∧ 1 ≤ bb.2 ∧ aa.1 * bb.1 * bb.2 = n := by
    clear * - haa hbb
    refine ⟨Nat.pos_of_ne_zero (Nat.left_ne_zero_of_mem_divisorsAntidiagonal haa),
      Nat.pos_of_ne_zero (Nat.left_ne_zero_of_mem_divisorsAntidiagonal hbb),
      Nat.pos_of_ne_zero (Nat.right_ne_zero_of_mem_divisorsAntidiagonal hbb), ?_⟩
    rw [Nat.mul_assoc, (Nat.mem_divisorsAntidiagonal.mp hbb).1,
      (Nat.mem_divisorsAntidiagonal.mp haa).1]
  have hAraw (n : ℕ) (hn : 1 ≤ n) (hnU : n ≤ U) :
      (∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
        if PA aa.1 bb.1 bb.2 then wC bb.2 else 0) =
      if (lower (c 0) : ℝ) ≤ (n : ℝ) ∧ (n : ℝ) ≤ (upper (c 0) : ℝ)
        then (A0 n : ℂ) else 0 := by
    clear * - hn hnU hunitFiber hPA_unit hcellReal hPA_named hdivData
    by_cases hl : l.val = 0
    · calc
        _ = ∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
            if aa.1 = 1 ∧ bb.1 = 1 ∧ (b bb.2 = c 0 ∧ unitP bb.2)
              then wC bb.2 else 0 := by
          apply Finset.sum_congr rfl
          intro aa _
          apply Finset.sum_congr rfl
          intro bb _
          simp only [hPA_unit hl]
        _ = if b n = c 0 ∧ unitP n then wC n else 0 :=
          hunitFiber n hn wC (fun t => b t = c 0 ∧ unitP t)
        _ = _ := by
          simp only [hcellReal n 0 hn]
          simp [A0, jA, hl, wC, Int.cast_ite, ite_and]
    · have hjA : jA ≠ 0 := by
        dsimp only [jA]
        rw [ite_eq_right hl]
        split_ifs <;> decide
      simp only [A0, ite_eq_right hjA, Int.cast_sum, Int.cast_ite, Int.cast_zero]
      by_cases hc : (lower (c 0) : ℝ) ≤ (n : ℝ) ∧ (n : ℝ) ≤ (upper (c 0) : ℝ)
      · rw [ite_eq_left hc]
        apply Finset.sum_congr rfl
        intro aa haa
        apply Finset.sum_congr rfl
        intro bb hbb
        obtain ⟨hu, hv, ht, hp⟩ := hdivData n hn aa bb haa hbb
        simp only [hPA_named hl n aa.1 bb.1 bb.2 hn hnU hu hv ht hp, hc, true_and, wC]
      · rw [ite_eq_right hc]
        apply Finset.sum_eq_zero
        intro aa haa
        apply Finset.sum_eq_zero
        intro bb hbb
        obtain ⟨hu, hv, ht, hp⟩ := hdivData n hn aa bb haa hbb
        simp only [hPA_named hl n aa.1 bb.1 bb.2 hn hnU hu hv ht hp, hc, false_and, ite_false]
  have hBraw (n : ℕ) (hn : 1 ≤ n) :
      (∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
        if PB aa.1 bb.1 bb.2 then wC bb.1 else 0) =
      if (lower (c 3) : ℝ) ≤ (n : ℝ) ∧ (n : ℝ) ≤ (upper (c 3) : ℝ)
        then (B0 n : ℂ) else 0 := by
    clear * - hn hdivData hBpredicate hcellNat hlower
    have hpred (aa bb : ℕ × ℕ) (haa : aa ∈ n.divisorsAntidiagonal)
        (hbb : bb ∈ aa.2.divisorsAntidiagonal) :
        PB aa.1 bb.1 bb.2 ↔
          ((lower (c 3) : ℝ) ≤ (n : ℝ) ∧ (n : ℝ) ≤ (upper (c 3) : ℝ)) ∧
            Bcond aa.1 bb.1 bb.2 := by
      obtain ⟨hu, hv, ht, hp⟩ := hdivData n hn aa bb haa hbb
      simpa only [PB, baseB, Bcond, jB, slo, shi, Zlo, Zhi, hp, and_assoc] using
        hBpredicate l z S b c lower upper hcellNat hlower aa.1 bb.1 bb.2 hu hv ht
    simp only [B0, Int.cast_sum, Int.cast_ite, Int.cast_zero]
    by_cases hc : (lower (c 3) : ℝ) ≤ (n : ℝ) ∧ (n : ℝ) ≤ (upper (c 3) : ℝ)
    · rw [ite_eq_left hc]
      apply Finset.sum_congr rfl
      intro aa haa
      apply Finset.sum_congr rfl
      intro bb hbb
      simp only [hpred aa bb haa hbb, hc, true_and, wC]
    · rw [ite_eq_right hc]
      apply Finset.sum_eq_zero
      intro aa haa
      apply Finset.sum_eq_zero
      intro bb hbb
      simp only [hpred aa bb haa hbb, hc, false_and, ite_false]
  have hα :
      (∑ v ∈ Ac, Finsupp.single (v 0 * v 1 * v 2) (wC (v 2))) =
        ∑ n ∈ Finset.Icc 1 ⌊2 * M⌋₊,
          Finsupp.single n
            (if (lower (c 0) : ℝ) ≤ (n : ℝ) ∧ (n : ℝ) ≤ (upper (c 0) : ℝ)
              then (A0 n : ℂ) else 0) := by
    clear * - hAc hpush hAraw hresize hMU hAu
    rw [hAc]
    calc
      _ = ∑ n ∈ Finset.Icc 1 U, Finsupp.single n
          (∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
            if PA aa.1 bb.1 bb.2 then wC bb.2 else 0) :=
        hpush U PA (fun _ _ t => wC t)
      _ = ∑ n ∈ Finset.Icc 1 U, Finsupp.single n
          (if (lower (c 0) : ℝ) ≤ (n : ℝ) ∧ (n : ℝ) ≤ (upper (c 0) : ℝ)
            then (A0 n : ℂ) else 0) := by
        apply Finset.sum_congr rfl
        intro n hn
        exact congrArg (Finsupp.single n)
          (hAraw n (Finset.mem_Icc.mp hn).1 (Finset.mem_Icc.mp hn).2)
      _ = _ := hresize U M (lower (c 0) : ℝ) (upper (c 0) : ℝ) hMU hAu
        (fun n => (A0 n : ℂ))
  have hβ :
      (∑ v ∈ Bc, Finsupp.single (v 0 * v 1 * v 2) (wC (v 1))) =
        ∑ n ∈ Finset.Icc 1 ⌊2 * N⌋₊,
          Finsupp.single n
            (if (lower (c 3) : ℝ) ≤ (n : ℝ) ∧ (n : ℝ) ≤ (upper (c 3) : ℝ)
              then (B0 n : ℂ) else 0) := by
    clear * - hBc hpush hBraw hresize hNU hBu
    rw [hBc]
    calc
      _ = ∑ n ∈ Finset.Icc 1 U, Finsupp.single n
          (∑ aa ∈ n.divisorsAntidiagonal, ∑ bb ∈ aa.2.divisorsAntidiagonal,
            if PB aa.1 bb.1 bb.2 then wC bb.1 else 0) :=
        hpush U PB (fun _ d _ => wC d)
      _ = ∑ n ∈ Finset.Icc 1 U, Finsupp.single n
          (if (lower (c 3) : ℝ) ≤ (n : ℝ) ∧ (n : ℝ) ≤ (upper (c 3) : ℝ)
            then (B0 n : ℂ) else 0) := by
        apply Finset.sum_congr rfl
        intro n hn
        exact congrArg (Finsupp.single n) (hBraw n (Finset.mem_Icc.mp hn).1)
      _ = _ := hresize U N (lower (c 3) : ℝ) (upper (c 3) : ℝ) hNU hBu
        (fun n => (B0 n : ℂ))
  have hlabels (v d : Fin 3 → ℕ) :
      (∀ r : Fin 7, b (feature v d r) = c r) ↔ labelsA v ∧ labelsB d := by
    constructor
    · intro hk
      exact ⟨⟨hk 0, hk 1, hk 2⟩, hk 3, hk 4, hk 5, hk 6⟩
    · rintro ⟨⟨h0, h1, h2⟩, h3, h4, h5, h6⟩ r
      fin_cases r <;> assumption
  have hrectangle (A B : Finset (Fin 3 → ℕ))
      (p q : (Fin 3 → ℕ) → Prop) [DecidablePred p] [DecidablePred q]
      (wa wb : (Fin 3 → ℕ) → ℂ) :
      (∑ v ∈ A, ∑ d ∈ B,
        Finsupp.single ((v 0 * v 1 * v 2) * (d 0 * d 1 * d 2))
          (if p v ∧ q d then wa v * wb d else 0)) =
        finiteConvolution
          (∑ v ∈ A.filter p, Finsupp.single (v 0 * v 1 * v 2) (wa v))
          (∑ d ∈ B.filter q, Finsupp.single (d 0 * d 1 * d 2) (wb d)) := by
    clear * - A B p q wa wb
    rw [finiteConvolution_indexed_pushforward]
    simp only [Finset.sum_filter]
    apply Finset.sum_congr rfl
    intro v _
    by_cases hp : p v
    · simp only [hp, true_and, ite_true]
      apply Finset.sum_congr rfl
      intro d _
      by_cases hq : q d <;> simp [hq]
    · simp only [hp, false_and, ite_false, Finsupp.single_zero, Finset.sum_const_zero]
  have hF : F = finiteConvolution
      (∑ v ∈ Ac, Finsupp.single (v 0 * v 1 * v 2) (wC (v 2)))
      (∑ d ∈ Bc, Finsupp.single (d 0 * d 1 * d 2) (wC (d 1))) := by
    clear * - hrectangle hlabels
    have hproduct (v d : Fin 3 → ℕ) :
        feature v d 0 * feature v d 3 =
          (v 0 * v 1 * v 2) * (d 0 * d 1 * d 2) := rfl
    have hweight (v d : Fin 3 → ℕ) : w v d = wC (v 2) * wC (d 1) := rfl
    simpa only [F, Ac, Bc, hlabels, hproduct, hweight] using
      hrectangle A B labelsA labelsB (fun v => wC (v 2)) (fun d => wC (d 1))
  have hZlo : 0 < Zlo := by
    dsimp only [Zlo]
    exact_mod_cast zero_lt_one.trans_le (hlower (c 5))
  have hZhi : 0 < Zhi := by
    dsimp only [Zhi]
    exact_mod_cast Nat.succ_pos (upper (c 5))
  have hbound := htypeII x hx₀ M N hM hN hpLo hpHi hminLo hminHi
    (by simpa only [Real.rpow_two] using hMpow)
    (by simpa only [Real.rpow_two] using hNpow)
    jA jB positive positive P Lfn Ufn z H
    (lower (c 1) : ℝ) (upper (c 1) : ℝ)
    (lower (c 0) : ℝ) (upper (c 0) : ℝ)
    slo shi Zlo Zhi (lower (c 4) : ℝ) (upper (c 4) : ℝ)
    (lower (c 3) : ℝ) (upper (c 3) : ℝ)
    hz hH hZlo hZhi hAl hAu hBl hBu I hI a ha
  change (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
      q ∣ (∏ p ∈ I, p) ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩
          j q)),
    ‖fullDiscrepancy (finiteConvolution
      (∑ n ∈ Finset.Icc 1 ⌊2 * M⌋₊, Finsupp.single n
        (if (lower (c 0) : ℝ) ≤ (n : ℝ) ∧ (n : ℝ) ≤ (upper (c 0) : ℝ)
          then (A0 n : ℂ) else 0))
      (∑ n ∈ Finset.Icc 1 ⌊2 * N⌋₊, Finsupp.single n
        (if (lower (c 3) : ℝ) ≤ (n : ℝ) ∧ (n : ℝ) ≤ (upper (c 3) : ℝ)
          then (B0 n : ℂ) else 0))) q a‖) ≤
      K * x / (Real.log x) ^ E at hbound
  rw [← hα, ← hβ, ← hF] at hbound
  exact hbound

theorem harman_long_feature_bounds
    (l : Fin 6) (U : ℕ) (a d : Fin 3 → ℕ)
    (ha : ∀ i, 1 ≤ a i ∧ a i ≤ U) (hd : ∀ i, 1 ≤ d i ∧ d i ≤ U)
    (haU : a 0 * a 1 * a 2 ≤ U) (hdU : d 0 * d 1 * d 2 ≤ U) :
    let feature : Fin 7 → ℕ :=
      ![a 0 * a 1 * a 2, (a 2).minFac, if l.val ≤ 3 then a 1 else a 0,
        d 0 * d 1 * d 2, d 0 * d 1, max 1 ((d 1).primeFactors.sup id), d 0]
    ∀ r, 1 ≤ feature r ∧ feature r ≤ U := by
  intro feature r
  have ha01 : 1 ≤ a 0 * a 1 :=
    one_le_mul_of_one_le_of_one_le (ha 0).1 (ha 1).1
  have ha012 : 1 ≤ a 0 * a 1 * a 2 :=
    one_le_mul_of_one_le_of_one_le ha01 (ha 2).1
  have hd01 : 1 ≤ d 0 * d 1 :=
    one_le_mul_of_one_le_of_one_le (hd 0).1 (hd 1).1
  have hd012 : 1 ≤ d 0 * d 1 * d 2 :=
    one_le_mul_of_one_le_of_one_le hd01 (hd 2).1
  have hd01U : d 0 * d 1 ≤ U := by
    calc
      d 0 * d 1 = d 0 * d 1 * 1 := (mul_one _).symm
      _ ≤ d 0 * d 1 * d 2 := Nat.mul_le_mul_left _ (hd 2).1
      _ ≤ U := hdU
  have hdmax : max 1 ((d 1).primeFactors.sup id) ≤ d 1 :=
    max_le (hd 1).1 (Finset.sup_le fun _ hp => Nat.le_of_mem_primeFactors hp)
  fin_cases r
  · exact ⟨ha012, haU⟩
  · exact ⟨Nat.minFac_pos _, (Nat.minFac_le (ha 2).1).trans (ha 2).2⟩
  · change 1 ≤ (if l.val ≤ 3 then a 1 else a 0) ∧
      (if l.val ≤ 3 then a 1 else a 0) ≤ U
    by_cases hl : l.val ≤ 3
    · simpa only [hl, ite_true] using ha 1
    · simpa only [hl, ite_false] using ha 0
  · exact ⟨hd012, hdU⟩
  · exact ⟨hd01, hd01U⟩
  · exact ⟨le_max_left _ _, hdmax.trans (hd 1).2⟩
  · exact hd 0

open Classical in
theorem harman_seven_feature_label_card_le
    {ι : Type*} (S : Finset ι) (feature : ι → Fin 7 → ℕ)
    (U K : ℕ) (b : ℕ → ℕ)
    (hfeature : ∀ t ∈ S, ∀ r, 1 ≤ feature t r ∧ feature t r ≤ U)
    (hb : ∀ n, 1 ≤ n → n ≤ U → b n < K) :
    (S.image (fun t => fun r => b (feature t r))).card ≤ K ^ 7 := by
  have hsubset : S.image (fun t => fun r => b (feature t r)) ⊆
      Fintype.piFinset (fun _ : Fin 7 => Finset.range K) := by
    intro f hf
    obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hf
    apply Fintype.mem_piFinset.mpr
    intro r
    exact Finset.mem_range.mpr (hb _ (hfeature t ht r).1 (hfeature t ht r).2)
  calc
    (S.image (fun t => fun r => b (feature t r))).card ≤
        (Fintype.piFinset (fun _ : Fin 7 => Finset.range K)).card :=
      Finset.card_le_card hsubset
    _ = K ^ 7 := by simp

open Classical in
theorem harman_dense_moduli_inv_totient_le
    (x c : ℝ) (hx : Real.exp 100 ≤ x) (hc : 0 < c) (hc1 : c ≤ 1)
    (Q : Finset ℕ) (hQ : Q ⊆ Finset.Icc 1 ⌊x ^ c⌋₊) :
    (∑ q ∈ Q, 1 / (q.totient : ℝ)) ≤ 4 * (Real.log x) ^ 2 := by
  have hx1 : 1 ≤ x :=
    (Real.one_le_exp (by norm_num : (0 : ℝ) ≤ 100)).trans hx
  have hlog100 : 100 ≤ Real.log x := by
    simpa only [Real.log_exp] using Real.log_le_log (Real.exp_pos 100) hx
  have hpow1 : 1 ≤ x ^ c := Real.one_le_rpow hx1 hc.le
  have hN1 : 1 ≤ ⌊x ^ c⌋₊ := (Nat.one_le_floor_iff _).mpr hpow1
  have hNreal : 1 ≤ (⌊x ^ c⌋₊ : ℝ) := by exact_mod_cast hN1
  have hNle : (⌊x ^ c⌋₊ : ℝ) ≤ x :=
    (Nat.floor_le (zero_le_one.trans hpow1)).trans
      (Real.rpow_le_self_of_one_le hx1 hc1)
  have hlogN0 : 0 ≤ Real.log (⌊x ^ c⌋₊ : ℝ) := Real.log_nonneg hNreal
  have hlogN : Real.log (⌊x ^ c⌋₊ : ℝ) ≤ Real.log x :=
    Real.log_le_log (zero_lt_one.trans_le hNreal) hNle
  have hlogbound : 1 + Real.log (⌊x ^ c⌋₊ : ℝ) ≤ 2 * Real.log x := by
    linarith only [hlog100, hlogN]
  calc
    (∑ q ∈ Q, 1 / (q.totient : ℝ)) ≤
        ∑ q ∈ Finset.Icc 1 ⌊x ^ c⌋₊, 1 / (q.totient : ℝ) :=
      Finset.sum_le_sum_of_subset_of_nonneg hQ (fun _ _ _ => by positivity)
    _ ≤ (1 + Real.log (⌊x ^ c⌋₊ : ℝ)) ^ 2 := by
      simpa only [pow_zero, Nat.zero_add, pow_one] using
        sum_divisor_weight_inv_totient_le_log ⌊x ^ c⌋₊ 0
    _ ≤ (2 * Real.log x) ^ 2 :=
      pow_le_pow_left₀ (by linarith only [hlogN0]) hlogbound 2
    _ = 4 * (Real.log x) ^ 2 := by ring

open Classical in
theorem harman_mixed_cell_mass_le_sum_band_card {α ι β : Type*} [DecidableEq ι]
    (T : Finset α) (key : α → ι) (Good : α → Prop) [DecidablePred Good] (w : α → ℝ)
    (embed : α → β) (bands : Fin 7 → Finset β)
    (hweight : ∀ t ∈ T, |w t| ≤ 1)
    (hinj : Set.InjOn embed (↑T : Set α))
    (hcover : ∀ c ∈ (T.image key).filter (fun c =>
        (∃ t ∈ T.filter (fun t => key t = c), Good t) ∧
          ∃ t ∈ T.filter (fun t => key t = c), ¬Good t),
      ∀ t ∈ T.filter (fun t => key t = c),
        ∃ i : Fin 7, embed t ∈ bands i) :
    let B := T.image key
    let U (c : ι) := T.filter (fun t => key t = c)
    let D := B.filter (fun c =>
      (∃ t ∈ U c, Good t) ∧ ∃ t ∈ U c, ¬Good t)
    (∑ c ∈ D, ∑ t ∈ U c, |w t|) ≤
      ∑ i : Fin 7, ((bands i).card : ℝ) := by
  intro B U D
  let S := T.filter (fun t => key t ∈ D)
  let V := Finset.univ.biUnion bands
  have hST : S ⊆ T := Finset.filter_subset _ _
  have hmass : (∑ c ∈ D, ∑ t ∈ U c, |w t|) = ∑ t ∈ S, |w t| :=
    Finset.sum_fiberwise_eq_sum_filter T D key (fun t => |w t|)
  have hmaps : Set.MapsTo embed (↑S : Set α) (↑V : Set β) := by
    intro t ht
    have ht' : t ∈ T ∧ key t ∈ D := Finset.mem_filter.mp ht
    obtain ⟨i, hi⟩ := hcover (key t) ht'.2 t
      (Finset.mem_filter.mpr ⟨ht'.1, rfl⟩)
    exact Finset.mem_biUnion.mpr ⟨i, Finset.mem_univ i, hi⟩
  have hinjS : Set.InjOn embed (↑S : Set α) :=
    fun _ ha _ hb hab => hinj (hST ha) (hST hb) hab
  have hcard : S.card ≤ V.card :=
    Finset.card_le_card_of_injOn embed hmaps hinjS
  have hbands : V.card ≤ ∑ i : Fin 7, (bands i).card :=
    Finset.card_biUnion_le
  calc
    _ = ∑ t ∈ S, |w t| := hmass
    _ ≤ ∑ _t ∈ S, (1 : ℝ) :=
      Finset.sum_le_sum fun t ht => hweight t (hST ht)
    _ = (S.card : ℝ) := by simp
    _ ≤ (V.card : ℝ) := by exact_mod_cast hcard
    _ ≤ ∑ i : Fin 7, ((bands i).card : ℝ) := by exact_mod_cast hbands

open Classical in
theorem harman_long_mixed_cell_mass_le
    (x R K h : ℝ) (L : ℕ) (l : Fin 6)
    (hx : Real.exp 100 ≤ x) (hL : 1 ≤ L) (hh : 0 ≤ h) (hh1 : h ≤ 1) :
    let U := ⌊8 * x⌋₊
    (∀ i j : Fin 6, i ≠ j →
      (((Fintype.piFinset (fun _ : Fin 6 => Finset.Icc 1 U)).filter
        (fun v : Fin 6 → ℕ => (∏ r, v r) ≤ U ∧ 1 < v i ∧
          L < min (v i).minFac (max 1 ((v j).primeFactors.sup id)) ∧
          max ((v i).minFac : ℝ) ((max 1 ((v j).primeFactors.sup id) : ℕ) : ℝ) ≤
            (1 + h) * min ((v i).minFac : ℝ)
              ((max 1 ((v j).primeFactors.sup id) : ℕ) : ℝ))).card : ℝ) ≤
        K * x / (Real.log x) ^ R) →
    (∀ s : Finset (Fin 6), ∀ T : ℝ, x ^ (1 / 10 : ℝ) ≤ T → T ≤ x ^ (2 : ℝ) →
      (((Fintype.piFinset (fun _ : Fin 6 => Finset.Icc 1 U)).filter
        (fun v : Fin 6 → ℕ => (∏ r, v r) ≤ U ∧
          T / (1 + h) ^ 2 ≤ ((∏ r ∈ s, v r : ℕ) : ℝ) ∧
          ((∏ r ∈ s, v r : ℕ) : ℝ) ≤ T * (1 + h) ^ 2)).card : ℝ) ≤
        K * x / (Real.log x) ^ R) →
    let H := x ^ ((40481 : ℝ) / 100000)
    let z := x ^ ((9519 : ℝ) / 50000)
    let M0 := x ^ (1 - (1058 : ℝ) / 3125)
    let S := x ^ (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000)
    let Bthreshold := x ^ ((59519 : ℝ) / 100000)
    let C := Finset.Icc 1 U
    let A := (Fintype.piFinset (fun _ : Fin 3 => C)).filter (fun a : Fin 3 → ℕ =>
      let u := a 0
      let v := a 1
      let h₀ := a 2
      let r := u * v
      let m := r * h₀
      m ≤ U ∧
        (match l.val with
          | 0 => u = 1 ∧ v = 1
          | 1 | 2 | 3 => u = 1 ∧ v.Prime ∧ z ≤ (v : ℝ)
          | 4 => u.Prime ∧ v.Prime ∧ z ≤ (u : ℝ) ∧ u < v
          | _ => u.Prime ∧ v.Prime ∧ z ≤ (u : ℝ) ∧ u ≤ v) ∧
        (r : ℝ) < H ∧ 1 < h₀ ∧ ((max 1 (h₀.primeFactors.sup id) : ℕ) : ℝ) < z ∧
        ((m / h₀.minFac : ℕ) : ℝ) < H ∧ H ≤ (m : ℝ))
    let B := (Fintype.piFinset (fun _ : Fin 3 => C)).filter (fun b : Fin 3 → ℕ =>
      let s := b 0
      let d := b 1
      let k := b 2
      let n := s * d * k
      n ≤ U ∧ (if l.val ≤ 1 then s = 1 else s.Prime ∧ z ≤ (s : ℝ)) ∧ (s : ℝ) < S)
    let feature (a b : Fin 3 → ℕ) : Fin 7 → ℕ :=
      ![a 0 * a 1 * a 2, (a 2).minFac, if l.val ≤ 3 then a 1 else a 0,
        b 0 * b 1 * b 2, b 0 * b 1, max 1 ((b 1).primeFactors.sup id), b 0]
    let Good (f : Fin 7 → ℕ) : Prop :=
      f 5 < f 1 ∧ M0 < ((f 0 * f 4 : ℕ) : ℝ) ∧
        x ≤ ((f 0 * f 3 : ℕ) : ℝ) ∧ ((f 0 * f 3 : ℕ) : ℝ) ≤ 2 * x ∧
        match l.val with
        | 2 => f 6 < f 2 ∧ ((f 2 * f 6 : ℕ) : ℝ) < H
        | 3 => f 6 < f 2 ∧ Bthreshold < ((f 2 * f 6 : ℕ) : ℝ)
        | 4 => f 6 < f 2
        | 5 => f 2 < f 6
        | _ => True
    ∀ (b : ℕ → ℕ) (lo hi : ℕ → ℝ),
      (∀ n, b n ≤ L ↔ n ≤ L) →
      (∀ n, n ≤ L → b n = n) →
      (∀ n m, b n < b m → n < m) →
      (∀ n m, 1 ≤ n → 1 ≤ m → L < b n → b n = b m →
        |(n : ℝ) - m| ≤ h * lo (b n)) →
      (∀ n, 1 ≤ n → lo (b n) ≤ (n : ℝ) ∧
        (n : ℝ) ≤ (if b n ≤ L then lo (b n) else hi (b n)) ∧
        (if b n ≤ L then lo (b n) else hi (b n)) ≤ (1 + h) * lo (b n)) →
    let T := A ×ˢ B
    let key (t : (Fin 3 → ℕ) × (Fin 3 → ℕ)) : Fin 7 → ℕ :=
      fun i => b (feature t.1 t.2 i)
    let cells := T.image key
    let cell (c : Fin 7 → ℕ) := T.filter (fun t => key t = c)
    let D := cells.filter (fun c =>
      (∃ t ∈ cell c, Good (feature t.1 t.2)) ∧
        ∃ t ∈ cell c, ¬Good (feature t.1 t.2))
    (∑ c ∈ D, ∑ t ∈ cell c,
      |(ArithmeticFunction.moebius (t.1 2) : ℝ) *
        (ArithmeticFunction.moebius (t.2 1) : ℝ)|) ≤
      7 * K * x / (Real.log x) ^ R := by
  intro U hprime hproduct H z M0 S Bthreshold C A B feature Good
    b lo hi hlow hsingleton horder hdiameter hends T key cells cell D
  let flat : ((Fin 3 → ℕ) × (Fin 3 → ℕ)) → Fin 6 → ℕ := fun t =>
    ![t.1 0, t.1 1, t.1 2, t.2 0, t.2 1, t.2 2]
  let named : Fin 6 := if l.val ≤ 3 then 1 else 0
  let C6 := Fintype.piFinset (fun _ : Fin 6 => C)
  let P (i j : Fin 6) := C6.filter (fun v : Fin 6 → ℕ =>
    (∏ r, v r) ≤ U ∧ 1 < v i ∧
      L < min (v i).minFac (max 1 ((v j).primeFactors.sup id)) ∧
      max ((v i).minFac : ℝ) ((max 1 ((v j).primeFactors.sup id) : ℕ) : ℝ) ≤
        (1 + h) * min ((v i).minFac : ℝ)
          ((max 1 ((v j).primeFactors.sup id) : ℕ) : ℝ))
  let V (s : Finset (Fin 6)) (q : ℝ) := C6.filter (fun v : Fin 6 → ℕ =>
    (∏ r, v r) ≤ U ∧
      q / (1 + h) ^ 2 ≤ ((∏ r ∈ s, v r : ℕ) : ℝ) ∧
      ((∏ r ∈ s, v r : ℕ) : ℝ) ≤ q * (1 + h) ^ 2)
  let bands : Fin 7 → Finset (Fin 6 → ℕ) :=
    ![P 2 4, V {0, 1, 2, 3, 4} M0, V Finset.univ x,
      V Finset.univ (2 * x), P named 3, V {named, 3} H,
      V {named, 3} Bthreshold]
  have hx2 : 2 ≤ x := by linarith [Real.add_one_le_exp (100 : ℝ)]
  have hxone : 1 ≤ x := by linarith only [hx2]
  have hxpos : 0 < x := zero_lt_one.trans_le hxone
  have hpower (q : ℝ) (hql : 1 / 10 ≤ q) (hqu : q ≤ 2) :
      x ^ (1 / 10 : ℝ) ≤ x ^ q ∧ x ^ q ≤ x ^ (2 : ℝ) :=
    ⟨Real.rpow_le_rpow_of_exponent_le hxone hql,
      Real.rpow_le_rpow_of_exponent_le hxone hqu⟩
  have hxband : x ^ (1 / 10 : ℝ) ≤ x ∧ x ≤ x ^ (2 : ℝ) := by
    simpa only [Real.rpow_one] using hpower 1 (by norm_num) (by norm_num)
  have htwoxband : x ^ (1 / 10 : ℝ) ≤ 2 * x ∧ 2 * x ≤ x ^ (2 : ℝ) := by
    refine ⟨hxband.1.trans (by linarith only [hxpos]), ?_⟩
    rw [Real.rpow_two]
    nlinarith only [hx2]
  have hMband : x ^ (1 / 10 : ℝ) ≤ M0 ∧ M0 ≤ x ^ (2 : ℝ) :=
    hpower _ (by norm_num) (by norm_num)
  have hHband : x ^ (1 / 10 : ℝ) ≤ H ∧ H ≤ x ^ (2 : ℝ) :=
    hpower _ (by norm_num) (by norm_num)
  have hBband : x ^ (1 / 10 : ℝ) ≤ Bthreshold ∧ Bthreshold ≤ x ^ (2 : ℝ) :=
    hpower _ (by norm_num) (by norm_num)
  have hnamedne : named ≠ 3 := by dsimp only [named]; split_ifs <;> decide
  have hcards (i : Fin 7) : ((bands i).card : ℝ) ≤ K * x / (Real.log x) ^ R := by
    fin_cases i
    · exact hprime 2 4 (by decide)
    · exact hproduct {0, 1, 2, 3, 4} M0 hMband.1 hMband.2
    · exact hproduct Finset.univ x hxband.1 hxband.2
    · exact hproduct Finset.univ (2 * x) htwoxband.1 htwoxband.2
    · exact hprime named 3 hnamedne
    · exact hproduct {named, 3} H hHband.1 hHband.2
    · exact hproduct {named, 3} Bthreshold hBband.1 hBband.2
  have haC (a : Fin 3 → ℕ) (ha : a ∈ A) (i : Fin 3) : a i ∈ C :=
    Fintype.mem_piFinset.mp (Finset.mem_filter.mp ha).1 i
  have hbC (d : Fin 3 → ℕ) (hd : d ∈ B) (i : Fin 3) : d i ∈ C :=
    Fintype.mem_piFinset.mp (Finset.mem_filter.mp hd).1 i
  have hah (a : Fin 3 → ℕ) (ha : a ∈ A) : 1 < a 2 := by
    obtain ⟨_, _, _, hh, _, _, _⟩ := (Finset.mem_filter.mp ha).2
    exact hh
  have hanamed (a : Fin 3 → ℕ) (ha : a ∈ A) :
      (if l.val ≤ 3 then a 1 else a 0) = 1 ∨
        (if l.val ≤ 3 then a 1 else a 0).Prime := by
    have hn := (Finset.mem_filter.mp ha).2.2.1
    fin_cases l
    · exact Or.inl hn.2
    · exact Or.inr hn.2.1
    · exact Or.inr hn.2.1
    · exact Or.inr hn.2.1
    · exact Or.inr hn.1
    · exact Or.inr hn.1
  have hbnamed (d : Fin 3 → ℕ) (hd : d ∈ B) : d 0 = 1 ∨ (d 0).Prime := by
    have hn := (Finset.mem_filter.mp hd).2.2.1
    by_cases hl : l.val ≤ 1
    · exact Or.inl (by simpa only [hl, ite_true] using hn)
    · have hs : (d 0).Prime ∧ z ≤ (d 0 : ℝ) := by
        simpa only [hl, ite_false] using hn
      exact Or.inr hs.1
  have hfpos (t : (Fin 3 → ℕ) × (Fin 3 → ℕ)) (ht : t ∈ T) :
      ∀ i : Fin 7, 1 ≤ feature t.1 t.2 i := by
    obtain ⟨ha, hd⟩ := Finset.mem_product.mp ht
    have hf := harman_long_feature_bounds l U t.1 t.2
      (fun i => Finset.mem_Icc.mp (haC _ ha i))
      (fun i => Finset.mem_Icc.mp (hbC _ hd i))
      (Finset.mem_filter.mp ha).2.1 (Finset.mem_filter.mp hd).2.1
    exact fun i => (hf i).1
  have hflat (t : (Fin 3 → ℕ) × (Fin 3 → ℕ)) (ht : t ∈ T) : flat t ∈ C6 := by
    obtain ⟨ha, hd⟩ := Finset.mem_product.mp ht
    apply Fintype.mem_piFinset.mpr
    intro i
    fin_cases i
    · exact haC _ ha 0
    · exact haC _ ha 1
    · exact haC _ ha 2
    · exact hbC _ hd 0
    · exact hbC _ hd 1
    · exact hbC _ hd 2
  have hflatnamed (t : (Fin 3 → ℕ) × (Fin 3 → ℕ)) :
      flat t named = if l.val ≤ 3 then t.1 1 else t.1 0 := by
    by_cases hl : l.val ≤ 3 <;> simp [flat, named, hl]
  have hfnamed (t : (Fin 3 → ℕ) × (Fin 3 → ℕ)) :
      feature t.1 t.2 2 = flat t named := by
    rw [hflatnamed]
    rfl
  have hfs (t : (Fin 3 → ℕ) × (Fin 3 → ℕ)) : feature t.1 t.2 6 = flat t 3 := rfl
  have hprod (t : (Fin 3 → ℕ) × (Fin 3 → ℕ)) :
      (∏ i : Fin 6, flat t i) = feature t.1 t.2 0 * feature t.1 t.2 3 := by
    change _ = (t.1 0 * t.1 1 * t.1 2) * (t.2 0 * t.2 1 * t.2 2)
    norm_num [flat, Fin.prod_univ_succ]
    ring
  have hprodlong (t : (Fin 3 → ℕ) × (Fin 3 → ℕ)) :
      (∏ i ∈ ({0, 1, 2, 3, 4} : Finset (Fin 6)), flat t i) =
        feature t.1 t.2 0 * feature t.1 t.2 4 := by
    change _ = (t.1 0 * t.1 1 * t.1 2) * (t.2 0 * t.2 1)
    rw [Finset.prod_insert (by decide : (0 : Fin 6) ∉ ({1, 2, 3, 4} : Finset (Fin 6))),
      Finset.prod_insert (by decide : (1 : Fin 6) ∉ ({2, 3, 4} : Finset (Fin 6))),
      Finset.prod_insert (by decide : (2 : Fin 6) ∉ ({3, 4} : Finset (Fin 6))),
      Finset.prod_insert (by decide : (3 : Fin 6) ∉ ({4} : Finset (Fin 6))),
      Finset.prod_singleton]
    change t.1 0 * (t.1 1 * (t.1 2 * (t.2 0 * t.2 1))) = _
    ring
  have hprodname (t : (Fin 3 → ℕ) × (Fin 3 → ℕ)) :
      (∏ i ∈ ({named, 3} : Finset (Fin 6)), flat t i) =
        feature t.1 t.2 2 * feature t.1 t.2 6 := by
    by_cases hl : l.val ≤ 3 <;> simp [named, flat, feature, hl]
  have hinj : Set.InjOn flat (↑T : Set ((Fin 3 → ℕ) × (Fin 3 → ℕ))) := by
    intro t _ u _ heq
    apply Prod.ext
    · funext i
      fin_cases i
      · simpa [flat] using congrFun heq (0 : Fin 6)
      · simpa [flat] using congrFun heq (1 : Fin 6)
      · simpa [flat] using congrFun heq (2 : Fin 6)
    · funext i
      fin_cases i
      · simpa [flat] using congrFun heq (3 : Fin 6)
      · simpa [flat] using congrFun heq (4 : Fin 6)
      · simpa [flat] using congrFun heq (5 : Fin 6)
  have hcover (c : Fin 7 → ℕ) (hc : c ∈ D)
      (v : (Fin 3 → ℕ) × (Fin 3 → ℕ)) (hv : v ∈ cell c) :
      ∃ i : Fin 7, flat v ∈ bands i := by
    obtain ⟨⟨g, hgc, hg⟩, bad, hbc, hbad⟩ := (Finset.mem_filter.mp hc).2
    have hgt := (Finset.mem_filter.mp hgc).1
    have hbt := (Finset.mem_filter.mp hbc).1
    have hvt := (Finset.mem_filter.mp hv).1
    have hgb (i : Fin 7) : b (feature g.1 g.2 i) = b (feature bad.1 bad.2 i) :=
      congrFun ((Finset.mem_filter.mp hgc).2.trans (Finset.mem_filter.mp hbc).2.symm) i
    have hgv (i : Fin 7) : b (feature g.1 g.2 i) = b (feature v.1 v.2 i) :=
      congrFun ((Finset.mem_filter.mp hgc).2.trans (Finset.mem_filter.mp hv).2.symm) i
    have hnear (i : Fin 7) :
        (feature v.1 v.2 i : ℝ) ≤ 2 * (feature g.1 g.2 i : ℝ) := by
      have hge := hends (feature g.1 g.2 i) (hfpos g hgt i)
      have hve := hends (feature v.1 v.2 i) (hfpos v hvt i)
      rw [← hgv i] at hve
      calc
        _ ≤ (if b (feature g.1 g.2 i) ≤ L then lo (b (feature g.1 g.2 i))
            else hi (b (feature g.1 g.2 i))) := hve.2.1
        _ ≤ (1 + h) * lo (b (feature g.1 g.2 i)) := hve.2.2
        _ ≤ (1 + h) * (feature g.1 g.2 i : ℝ) :=
          mul_le_mul_of_nonneg_left hge.1 (by linarith only [hh])
        _ ≤ _ := mul_le_mul_of_nonneg_right (by linarith only [hh1]) (Nat.cast_nonneg _)
    have hfull : (∏ i : Fin 6, flat v i) ≤ U := by
      apply Nat.le_floor
      rw [hprod, Nat.cast_mul]
      have hgupper : ((feature g.1 g.2 0 * feature g.1 g.2 3 : ℕ) : ℝ) ≤ 2 * x :=
        hg.2.2.2.1
      calc
        _ ≤ (2 * (feature g.1 g.2 0 : ℝ)) * (2 * (feature g.1 g.2 3 : ℝ)) :=
          mul_le_mul (hnear 0) (hnear 3) (Nat.cast_nonneg _) (by positivity)
        _ = 4 * ((feature g.1 g.2 0 * feature g.1 g.2 3 : ℕ) : ℝ) := by
          push_cast
          ring
        _ ≤ 4 * (2 * x) := mul_le_mul_of_nonneg_left hgupper (by norm_num)
        _ = 8 * x := by ring
    have hseven := harman_feature_boundary_full_cell_cover l M0 x Bthreshold h hh
      L b lo hi hlow hsingleton horder hdiameter hends
      (feature g.1 g.2) (feature bad.1 bad.2) (feature v.1 v.2)
      (hfpos g hgt) (hfpos bad hbt) (hfpos v hvt) hgb hgv hg hbad
    rcases hseven with hp | hp | hp | hp | hp | hp | hp
    · refine ⟨0, Finset.mem_filter.mpr ⟨hflat v hvt, hfull,
      hah v.1 (Finset.mem_product.mp hvt).1, ?_, ?_⟩⟩
      · simpa [flat, feature, min_comm] using hp.1
      · simpa [flat, feature, max_comm, min_comm] using hp.2
    · refine ⟨1, Finset.mem_filter.mpr ⟨hflat v hvt, hfull, ?_⟩⟩
      simpa only [hprodlong] using hp
    · refine ⟨2, Finset.mem_filter.mpr ⟨hflat v hvt, hfull, ?_⟩⟩
      simpa only [hprod] using hp
    · refine ⟨3, Finset.mem_filter.mpr ⟨hflat v hvt, hfull, ?_⟩⟩
      simpa only [hprod] using hp
    · have hp' : L < min (flat v named) (flat v 3) ∧
          ((max (flat v named) (flat v 3) : ℕ) : ℝ) ≤
            (1 + h) * ((min (flat v named) (flat v 3) : ℕ) : ℝ) := by
        simpa only [hfnamed, hfs] using hp
      have hn1 : 1 < flat v named := hL.trans_lt (hp'.1.trans_le (min_le_left _ _))
      have hs1 : 1 < flat v 3 := hL.trans_lt (hp'.1.trans_le (min_le_right _ _))
      have hnalt : flat v named = 1 ∨ (flat v named).Prime := by
        rw [hflatnamed]
        exact hanamed v.1 (Finset.mem_product.mp hvt).1
      have hsalt : flat v 3 = 1 ∨ (flat v 3).Prime :=
        hbnamed v.2 (Finset.mem_product.mp hvt).2
      have hnprime := hnalt.resolve_left (ne_of_gt hn1)
      have hsprime := hsalt.resolve_left (ne_of_gt hs1)
      have hmax : max 1 ((flat v 3).primeFactors.sup id) = flat v 3 := by
        simp [hsprime.primeFactors, max_eq_right hsprime.one_le]
      refine ⟨4, Finset.mem_filter.mpr ⟨hflat v hvt, hfull, hn1, ?_, ?_⟩⟩
      · simpa only [hnprime.minFac_eq, hmax] using hp'.1
      · simpa only [hnprime.minFac_eq, hmax, Nat.cast_max, Nat.cast_min] using hp'.2
    · refine ⟨5, Finset.mem_filter.mpr ⟨hflat v hvt, hfull, ?_⟩⟩
      simpa only [hprodname] using hp
    · refine ⟨6, Finset.mem_filter.mpr ⟨hflat v hvt, hfull, ?_⟩⟩
      simpa only [hprodname] using hp
  have hw (v : (Fin 3 → ℕ) × (Fin 3 → ℕ)) (_ : v ∈ T) :
      |(ArithmeticFunction.moebius (v.1 2) : ℝ) *
        (ArithmeticFunction.moebius (v.2 1) : ℝ)| ≤ 1 := by
    have ha : |(ArithmeticFunction.moebius (v.1 2) : ℝ)| ≤ 1 := by
      exact_mod_cast ArithmeticFunction.abs_moebius_le_one (n := v.1 2)
    have hb : |(ArithmeticFunction.moebius (v.2 1) : ℝ)| ≤ 1 := by
      exact_mod_cast ArithmeticFunction.abs_moebius_le_one (n := v.2 1)
    rw [abs_mul]
    simpa only [one_mul] using mul_le_mul ha hb (abs_nonneg _) zero_le_one
  clear hprime hproduct
  have hm := harman_mixed_cell_mass_le_sum_band_card T key
    (fun v => Good (feature v.1 v.2))
    (fun v => (ArithmeticFunction.moebius (v.1 2) : ℝ) *
      (ArithmeticFunction.moebius (v.2 1) : ℝ)) flat bands hw hinj hcover
  calc
    _ ≤ ∑ i : Fin 7, ((bands i).card : ℝ) := hm
    _ ≤ ∑ _i : Fin 7, K * x / (Real.log x) ^ R :=
      Finset.sum_le_sum fun i _ => hcards i
    _ = _ := by
      simp only [Finset.sum_const, Finset.card_univ, Fintype.card_fin, nsmul_eq_mul]
      ring

theorem central_box_one_coordinate_scales
    (x : ℝ) (hx : 0 ≤ x) (L U : Fin 5 → ℝ)
    (hL : ∀ i, 0 < L i) (hLU : ∀ i, L i ≤ U i ∧ U i ≤ (4 / 3 : ℝ) * L i)
    (hprod : (∏ i, L i) ≤ 2 * x) (S : Finset (Fin 5))
    (hS : S.Nonempty) (hSne : S ≠ Finset.univ) :
    ∃ R : Finset (Fin 5), ∃ Y : Fin 5 → ℝ,
      (R = S ∨ R = Sᶜ) ∧ R.Nonempty ∧ R ≠ Finset.univ ∧
      (∀ i, L i / 2 ≤ Y i ∧ Y i ≤ L i ∧ U i ≤ 2 * Y i) ∧
      (∏ i, L i) / 2 ≤ ∏ i, Y i ∧ (∏ i, Y i) ≤ ∏ i, L i ∧
      (∏ i ∈ R, L i) / 2 ≤ ∏ i ∈ R, Y i ∧
      (∏ i ∈ R, Y i) ≤ x ^ (1 / 2 : ℝ) := by
  classical
  have hSc : Sᶜ.Nonempty := Finset.nonempty_iff_ne_empty.mpr
    (fun h => hSne ((Finset.compl_eq_empty_iff S).mp h))
  obtain ⟨R, hR, hRn, hRne, hsmall⟩ :
      ∃ R : Finset (Fin 5), (R = S ∨ R = Sᶜ) ∧ R.Nonempty ∧
        R ≠ Finset.univ ∧ (∏ i ∈ R, L i) ≤ ∏ i ∈ Rᶜ, L i := by
    by_cases hs : (∏ i ∈ S, L i) ≤ ∏ i ∈ Sᶜ, L i
    · exact ⟨S, Or.inl rfl, hS, hSne, hs⟩
    · refine ⟨Sᶜ, Or.inr rfl, hSc,
        (Finset.compl_ne_univ_iff_nonempty S).mpr hS, ?_⟩
      simpa only [compl_compl] using (le_of_not_ge hs)
  obtain ⟨i, hi⟩ := hRn
  let Y : Fin 5 → ℝ := Function.update L i (U i / 2)
  have hY (j : Fin 5) : L j / 2 ≤ Y j ∧ Y j ≤ L j ∧ U j ≤ 2 * Y j := by
    by_cases hji : j = i
    · subst j
      simp only [Y, Function.update_self]
      constructor
      · linarith [(hLU i).1]
      · constructor <;> nlinarith [(hLU i).2, hL i]
    · simp only [Y, Function.update_of_ne hji]
      exact ⟨by linarith [hL j], le_refl _, by nlinarith [(hLU j).2, hL j]⟩
  have hYpos (j : Fin 5) : 0 < Y j :=
    (div_pos (hL j) (by norm_num)).trans_le (hY j).1
  have hblock (T : Finset (Fin 5)) (hiT : i ∈ T) :
      (∏ j ∈ T, L j) / 2 ≤ ∏ j ∈ T, Y j ∧
        (∏ j ∈ T, Y j) ≤ (2 / 3 : ℝ) * ∏ j ∈ T, L j := by
    have htail : 0 ≤ ∏ j ∈ T \ {i}, L j :=
      Finset.prod_nonneg fun j _ => (hL j).le
    have hlo := mul_le_mul_of_nonneg_right (hLU i).1 htail
    have hhi := mul_le_mul_of_nonneg_right (hLU i).2 htail
    dsimp only [Y]
    rw [Finset.prod_update_of_mem hiT,
      Finset.prod_eq_mul_prod_sdiff_singleton_of_mem hiT L]
    constructor <;> nlinarith
  have hA0 : 0 ≤ ∏ j ∈ R, L j := Finset.prod_nonneg fun j _ => (hL j).le
  have hA2 : (∏ j ∈ R, L j) ^ 2 ≤ 2 * x := by
    calc
      _ = (∏ j ∈ R, L j) * ∏ j ∈ R, L j := by ring
      _ ≤ (∏ j ∈ R, L j) * ∏ j ∈ Rᶜ, L j :=
        mul_le_mul_of_nonneg_left hsmall hA0
      _ = ∏ j, L j := Finset.prod_mul_prod_compl R L
      _ ≤ 2 * x := hprod
  have hN0 : 0 ≤ ∏ j ∈ R, Y j := Finset.prod_nonneg fun j _ => (hYpos j).le
  have hNsq : (∏ j ∈ R, Y j) ^ 2 ≤ x := by
    have hs := (sq_le_sq₀ hN0 (by positivity :
      0 ≤ (2 / 3 : ℝ) * ∏ j ∈ R, L j)).mpr (hblock R hi).2
    nlinarith
  refine ⟨R, Y, hR, ⟨i, hi⟩, hRne, hY,
    (hblock Finset.univ (Finset.mem_univ i)).1, ?_, (hblock R hi).1, ?_⟩
  · exact Finset.prod_le_prod (fun j _ => (hYpos j).le) (fun j _ => (hY j).2.1)
  · rw [← Real.sqrt_eq_rpow]
    exact Real.le_sqrt_of_sq_le hNsq

open Classical in
theorem compact_prime_geometric_central_scales (τ : ℝ) (hτ : 0 < τ) :
    ∀ᶠ x : ℝ in atTop, ∀ h : ℝ, 0 < h → h ≤ 1 / 4 → ∀ b p : Fin 5 → ℕ,
      let P : Finset ℕ :=
        (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
          ⌊x ^ ((6 : ℝ) / 25)⌋₊).filter Nat.Prime
      let L (i : Fin 5) : ℝ := max (x ^ ((9519 : ℝ) / 50000)) ((1 + h) ^ b i)
      let U (i : Fin 5) : ℝ := min (x ^ ((6 : ℝ) / 25))
        ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ)
      (∀ i, p i ∈ P) →
      (∀ i, ⌊Real.logb (1 + h) (p i : ℝ)⌋₊ = b i) →
      (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ →
      ∀ S : Finset (Fin 5), (S.card = 2 ∨ S.card = 3) →
        x ^ ((40481 : ℝ) / 100000) ≤ ∏ i ∈ S, (p i : ℝ) →
        (∏ i ∈ S, (p i : ℝ)) ≤ x ^ ((59519 : ℝ) / 100000) →
        ∃ R : Finset (Fin 5), ∃ Y : Fin 5 → ℝ,
          (R = S ∨ R = Sᶜ) ∧ R.Nonempty ∧ R ≠ Finset.univ ∧
          (∀ i, x ^ ((9519 : ℝ) / 100000) ≤ Y i ∧ Y i ≤ x ^ (2 : ℝ)) ∧
          (∀ i, Y i ≤ L i ∧ U i ≤ 2 * Y i) ∧
          x / 64 ≤ ∏ i, Y i ∧ (∏ i, Y i) ≤ 64 * x ∧
          x ^ ((40481 : ℝ) / 100000 - τ) ≤ ∏ i ∈ R, Y i ∧
          (∏ i ∈ R, Y i) ≤ x ^ (1 / 2 : ℝ) := by
  filter_upwards [eventually_ge_atTop (2 : ℝ),
    (tendsto_rpow_atTop hτ).eventually (eventually_ge_atTop (64 : ℝ)),
    (tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 9519 / 100000)).eventually
      (eventually_ge_atTop (2 : ℝ))] with x hx hxτ hxξ
  intro h hh hh4 b p P L U hp hlabel hprod S hcard hcentralLo hcentralHi
  have hx1 : 1 ≤ x := by linarith
  have hx0 : 0 < x := by linarith
  have hbase : 0 < 1 + h := by linarith
  have hscales := compact_prime_geometric_active_scales x h hx hh (by linarith)
    b p hp hlabel hprod
  have hLpos (i : Fin 5) : 0 < L i :=
    (Real.rpow_pos_of_pos hx0 _).trans_le (le_max_left _ _)
  have hpLU (i : Fin 5) : L i ≤ (p i : ℝ) ∧ (p i : ℝ) ≤ U i := by
    have hm : p i ∈ P.filter (fun n : ℕ => ⌊Real.logb (1 + h) (n : ℝ)⌋₊ = b i) :=
      Finset.mem_filter.mpr ⟨hp i, hlabel i⟩
    rw [compact_prime_geometric_bin_eq_closed_interval x h hx0 hh (b i)] at hm
    have hm' := Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1
    exact ⟨Nat.le_of_ceil_le hm'.1,
      (Nat.cast_le.mpr hm'.2).trans (Nat.floor_le (by positivity))⟩
  have hUnarrow (i : Fin 5) : U i ≤ (4 / 3 : ℝ) * L i := by
    have hceil : 0 < ⌈(1 + h) ^ (b i + 1)⌉₊ :=
      Nat.ceil_pos.mpr (pow_pos hbase _)
    have htop : ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ) <
        (1 + h) ^ (b i + 1) := Nat.lt_ceil.mp (by omega)
    calc
      U i ≤ ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ) := min_le_right _ _
      _ ≤ (1 + h) ^ (b i + 1) := htop.le
      _ = (1 + h) * (1 + h) ^ b i := by rw [pow_succ]; ring
      _ ≤ (4 / 3 : ℝ) * L i := mul_le_mul (by linarith) (le_max_right _ _)
        (pow_nonneg hbase.le _) (by norm_num)
  have hSnon : S.Nonempty := Finset.card_pos.mp (by rcases hcard with h | h <;> omega)
  have hSne : S ≠ Finset.univ := by
    intro heq
    have hc : S.card = 5 := by simp [heq]
    rcases hcard with h | h <;> omega
  have hsubcompare (T : Finset (Fin 5)) :
      (∏ i ∈ T, (p i : ℝ)) ≤ 32 * ∏ i ∈ T, L i := by
    have hT : T.card ≤ 5 := by
      simpa using (Finset.card_le_card (Finset.subset_univ T))
    have hpow : (2 : ℝ) ^ T.card ≤ 32 := by
      calc
        _ ≤ (2 : ℝ) ^ 5 := pow_le_pow_right₀ (by norm_num) hT
        _ = 32 := by norm_num
    calc
      _ ≤ ∏ i ∈ T, 2 * L i := Finset.prod_le_prod (fun _ _ => Nat.cast_nonneg _)
        (fun i _ => (hpLU i).2.trans (hscales.1 i).2.2)
      _ = (2 : ℝ) ^ T.card * ∏ i ∈ T, L i := by
        rw [Finset.prod_mul_distrib, Finset.prod_const]
      _ ≤ 32 * ∏ i ∈ T, L i := mul_le_mul_of_nonneg_right hpow
        (Finset.prod_nonneg fun i _ => (hLpos i).le)
  have hpfull : x ≤ ∏ i, (p i : ℝ) := by
    exact_mod_cast Nat.le_of_ceil_le (Finset.mem_Icc.mp hprod).1
  have hpower : x ^ ((59519 : ℝ) / 100000) * x ^ ((40481 : ℝ) / 100000) = x := by
    rw [← Real.rpow_add hx0]
    norm_num
  have hcomp : x ^ ((40481 : ℝ) / 100000) ≤ ∏ i ∈ Sᶜ, (p i : ℝ) := by
    apply le_of_mul_le_mul_left (a := x ^ ((59519 : ℝ) / 100000))
      ?_ (Real.rpow_pos_of_pos hx0 _)
    calc
      _ = x := hpower
      _ ≤ ∏ i, (p i : ℝ) := hpfull
      _ = (∏ i ∈ S, (p i : ℝ)) * ∏ i ∈ Sᶜ, (p i : ℝ) :=
        (Finset.prod_mul_prod_compl S (fun i => (p i : ℝ))).symm
      _ ≤ x ^ ((59519 : ℝ) / 100000) * ∏ i ∈ Sᶜ, (p i : ℝ) :=
        mul_le_mul_of_nonneg_right hcentralHi (Finset.prod_nonneg fun _ _ => Nat.cast_nonneg _)
  obtain ⟨R, Y, hR, hRn, hRne, hY, hprodLo, hprodHi, hblockLo, hblockHi⟩ :=
    central_box_one_coordinate_scales x hx0.le L U hLpos
      (fun i => ⟨(hpLU i).1.trans (hpLU i).2, hUnarrow i⟩)
      hscales.2.2 S hSnon hSne
  have hRlower : x ^ ((40481 : ℝ) / 100000) / 32 ≤ ∏ i ∈ R, L i := by
    rcases hR with hRS | hRS
    · rw [hRS]
      linarith [hsubcompare S]
    · rw [hRS]
      linarith [hsubcompare Sᶜ]
  refine ⟨R, Y, hR, hRn, hRne, ?_, (fun i => (hY i).2), ?_, ?_, ?_, hblockHi⟩
  · intro i
    constructor
    · have hξpos : 0 < x ^ ((9519 : ℝ) / 100000) := Real.rpow_pos_of_pos hx0 _
      have hξsq : x ^ ((9519 : ℝ) / 50000) =
          x ^ ((9519 : ℝ) / 100000) * x ^ ((9519 : ℝ) / 100000) := by
        rw [← Real.rpow_add hx0]
        congr 1
        norm_num
      have hξL : x ^ ((9519 : ℝ) / 50000) ≤ L i := le_max_left _ _
      have hξmul := mul_le_mul_of_nonneg_right hxξ hξpos.le
      nlinarith [(hY i).1]
    · exact (hY i).2.1.trans ((hscales.1 i).2.1.trans
        ((min_le_left _ _).trans (Real.rpow_le_rpow_of_exponent_le hx1 (by norm_num))))
  · linarith [hscales.2.1]
  · linarith [hscales.2.2]
  · rw [Real.rpow_sub hx0]
    exact (div_le_div_of_nonneg_left (Real.rpow_pos_of_pos hx0 _).le
      (by norm_num : (0 : ℝ) < 64) hxτ).trans (by linarith)

/--
The twelve arithmetic pieces in the literal Buchstab minorant expansion, before applying their
signs. The exceptional defects and the `U1` correction are already subtracted within their
respective pieces.
-/
noncomputable def literalMinorantBuchstabPiece (x : ℝ) (i : Fin 12) (n : ℕ) : ℝ :=
  ![siftedTheta x 0 (fun _ => 1) n,
    siftedTheta x 1 (fun _ => 1) n,
    siftedTheta x 2 (fun _ => 1) n,
    siftedTheta x 3 (fun _ => 1) n,
    siftedTheta x 4 (fun _ => 1) n,
    sourceLargeFirst x n,
    sourceCentralPair x n,
    sourceT3 x n,
    sourceT5 x n - exceptionalPrimeDefect x 0 n,
    sourceT4 x n - sourceU1 x n,
    siftedTheta x 5 (fun _ => 1) n,
    sourceU3 x n - exceptionalPrimeDefect x 1 n] i

/-- The signs of the twelve Buchstab pieces, in the same index order as the piece array. -/
def literalMinorantBuchstabSign : Fin 12 → ℝ :=
  ![1, -1, 1, 1, -1, -1, 1, 1, 1, -1, -1, 1]

theorem literalMinorantBuchstabSign_norm (i : Fin 12) :
    ‖(literalMinorantBuchstabSign i : ℂ)‖ = 1 := by
  fin_cases i <;> norm_num [literalMinorantBuchstabSign]

theorem literal_minorant_buchstab_pointwise :
    ∀ᶠ x : ℝ in atTop, ∀ n : ℕ, x ≤ (n : ℝ) → (n : ℝ) ≤ 2 * x →
      (if n.Prime then (1 : ℝ) else 0) - exceptionalPrimeDefect x 0 n -
          exceptionalPrimeDefect x 1 n =
        ∑ i : Fin 12, literalMinorantBuchstabSign i * literalMinorantBuchstabPiece x i n := by
  classical
  obtain ⟨X, hX, hreverse⟩ := sourceU1_eventually_eq_siftedTheta_five_sub_sourceU3
  filter_upwards [eventually_ge_atTop X] with x hx
  intro n hnlo hnhi
  have hprime := primeIndicator_source_buchstab (hX.trans hx) hnlo hnhi
  have hU := hreverse x hx n hnlo hnhi
  simp only [literalMinorantBuchstabPiece, literalMinorantBuchstabSign,
    Fin.sum_univ_succ, Matrix.cons_val_zero, Matrix.cons_val_succ,
    Fin.sum_univ_zero, one_mul, neg_one_mul, add_zero]
  linarith

open Classical in
theorem literal_minorant_buchstab_finsupp :
    ∀ᶠ x : ℝ in atTop, ∀ S : Finset ℕ,
      S ⊆ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ →
      (∑ n ∈ S, Finsupp.single n
        (((if n.Prime then (1 : ℝ) else 0) - exceptionalPrimeDefect x 0 n -
          exceptionalPrimeDefect x 1 n : ℝ) : ℂ)) =
        ∑ i : Fin 12, (literalMinorantBuchstabSign i : ℂ) •
          (∑ n ∈ S, Finsupp.single n (literalMinorantBuchstabPiece x i n : ℂ)) := by
  filter_upwards [literal_minorant_buchstab_pointwise,
    eventually_gt_atTop (1 : ℝ)] with x hx hx1
  intro S hS
  have hpoint (n : ℕ) (hn : n ∈ S) :
      (((if n.Prime then (1 : ℝ) else 0) - exceptionalPrimeDefect x 0 n -
        exceptionalPrimeDefect x 1 n : ℝ) : ℂ) =
      ∑ i : Fin 12, (literalMinorantBuchstabSign i : ℂ) *
        (literalMinorantBuchstabPiece x i n : ℂ) := by
    obtain ⟨hnlo, hnhi⟩ := Finset.mem_Icc.mp (hS hn)
    have hlo : x ≤ (n : ℝ) := (Nat.le_ceil x).trans (Nat.cast_le.mpr hnlo)
    have hhi : (n : ℝ) ≤ 2 * x :=
      (Nat.cast_le.mpr hnhi).trans (Nat.floor_le (by linarith))
    simpa only [Complex.ofReal_sum, Complex.ofReal_mul] using
      congrArg Complex.ofReal (hx n hlo hhi)
  calc
    _ = ∑ n ∈ S, Finsupp.single n
        (∑ i : Fin 12, (literalMinorantBuchstabSign i : ℂ) *
          (literalMinorantBuchstabPiece x i n : ℂ)) := by
      apply Finset.sum_congr rfl
      intro n hn
      rw [hpoint n hn]
    _ = ∑ n ∈ S, ∑ i : Fin 12,
        Finsupp.single n ((literalMinorantBuchstabSign i : ℂ) *
          (literalMinorantBuchstabPiece x i n : ℂ)) := by
      simp only [Finsupp.single_finsetSum]
    _ = _ := by
      rw [Finset.sum_comm]
      apply Finset.sum_congr rfl
      intro i _hi
      rw [Finset.smul_sum]
      apply Finset.sum_congr rfl
      intro n _hn
      simp only [Finsupp.smul_single, smul_eq_mul]

theorem four_central_box_one_coordinate_scales
    (x : ℝ) (hx : 0 ≤ x) (L U : Fin 4 → ℝ)
    (hL : ∀ i, 0 < L i) (hLU : ∀ i, L i ≤ U i ∧ U i ≤ (4 / 3 : ℝ) * L i)
    (hprod : (∏ i, L i) ≤ 2 * x) (S : Finset (Fin 4))
    (hS : S.Nonempty) (hSne : S ≠ Finset.univ) :
    ∃ R : Finset (Fin 4), ∃ Y : Fin 4 → ℝ,
      (R = S ∨ R = Sᶜ) ∧ R.Nonempty ∧ R ≠ Finset.univ ∧
      (∀ i, L i / 2 ≤ Y i ∧ Y i ≤ L i ∧ U i ≤ 2 * Y i) ∧
      (∏ i, L i) / 2 ≤ ∏ i, Y i ∧ (∏ i, Y i) ≤ ∏ i, L i ∧
      (∏ i ∈ R, L i) / 2 ≤ ∏ i ∈ R, Y i ∧
      (∏ i ∈ R, Y i) ≤ x ^ (1 / 2 : ℝ) := by
  classical
  have hSc : Sᶜ.Nonempty := Finset.nonempty_iff_ne_empty.mpr
    (fun h => hSne ((Finset.compl_eq_empty_iff S).mp h))
  obtain ⟨R, hR, hRn, hRne, hsmall⟩ :
      ∃ R : Finset (Fin 4), (R = S ∨ R = Sᶜ) ∧ R.Nonempty ∧
        R ≠ Finset.univ ∧ (∏ i ∈ R, L i) ≤ ∏ i ∈ Rᶜ, L i := by
    by_cases hs : (∏ i ∈ S, L i) ≤ ∏ i ∈ Sᶜ, L i
    · exact ⟨S, Or.inl rfl, hS, hSne, hs⟩
    · refine ⟨Sᶜ, Or.inr rfl, hSc,
        (Finset.compl_ne_univ_iff_nonempty S).mpr hS, ?_⟩
      simpa only [compl_compl] using (le_of_not_ge hs)
  obtain ⟨i, hi⟩ := hRn
  let Y : Fin 4 → ℝ := Function.update L i (U i / 2)
  have hY (j : Fin 4) : L j / 2 ≤ Y j ∧ Y j ≤ L j ∧ U j ≤ 2 * Y j := by
    by_cases hji : j = i
    · subst j
      simp only [Y, Function.update_self]
      constructor
      · linarith [(hLU i).1]
      · constructor <;> nlinarith [(hLU i).2, hL i]
    · simp only [Y, Function.update_of_ne hji]
      exact ⟨by linarith [hL j], le_refl _, by nlinarith [(hLU j).2, hL j]⟩
  have hYpos (j : Fin 4) : 0 < Y j :=
    (div_pos (hL j) (by norm_num)).trans_le (hY j).1
  have hblock (T : Finset (Fin 4)) (hiT : i ∈ T) :
      (∏ j ∈ T, L j) / 2 ≤ ∏ j ∈ T, Y j ∧
        (∏ j ∈ T, Y j) ≤ (2 / 3 : ℝ) * ∏ j ∈ T, L j := by
    have htail : 0 ≤ ∏ j ∈ T \ {i}, L j :=
      Finset.prod_nonneg fun j _ => (hL j).le
    have hlo := mul_le_mul_of_nonneg_right (hLU i).1 htail
    have hhi := mul_le_mul_of_nonneg_right (hLU i).2 htail
    dsimp only [Y]
    rw [Finset.prod_update_of_mem hiT,
      Finset.prod_eq_mul_prod_sdiff_singleton_of_mem hiT L]
    constructor <;> nlinarith
  have hA0 : 0 ≤ ∏ j ∈ R, L j := Finset.prod_nonneg fun j _ => (hL j).le
  have hA2 : (∏ j ∈ R, L j) ^ 2 ≤ 2 * x := by
    calc
      _ = (∏ j ∈ R, L j) * ∏ j ∈ R, L j := by ring
      _ ≤ (∏ j ∈ R, L j) * ∏ j ∈ Rᶜ, L j :=
        mul_le_mul_of_nonneg_left hsmall hA0
      _ = ∏ j, L j := Finset.prod_mul_prod_compl R L
      _ ≤ 2 * x := hprod
  have hN0 : 0 ≤ ∏ j ∈ R, Y j := Finset.prod_nonneg fun j _ => (hYpos j).le
  have hNsq : (∏ j ∈ R, Y j) ^ 2 ≤ x := by
    have hs := (sq_le_sq₀ hN0 (by positivity :
      0 ≤ (2 / 3 : ℝ) * ∏ j ∈ R, L j)).mpr (hblock R hi).2
    nlinarith
  refine ⟨R, Y, hR, ⟨i, hi⟩, hRne, hY,
    (hblock Finset.univ (Finset.mem_univ i)).1, ?_, (hblock R hi).1, ?_⟩
  · exact Finset.prod_le_prod (fun j _ => (hYpos j).le) (fun j _ => (hY j).2.1)
  · rw [← Real.sqrt_eq_rpow]
    exact Real.le_sqrt_of_sq_le hNsq

open Classical in
theorem four_prime_geometric_central_scales (τ : ℝ) (hτ : 0 < τ) :
    ∀ᶠ x : ℝ in atTop, ∀ h : ℝ, 0 < h → h ≤ 1 / 4 → ∀ b p : Fin 4 → ℕ,
      let P : Finset ℕ :=
        (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
          ⌊x ^ ((11 : ℝ) / 25)⌋₊).filter Nat.Prime
      let L (i : Fin 4) : ℝ := max (x ^ ((9519 : ℝ) / 50000)) ((1 + h) ^ b i)
      let U (i : Fin 4) : ℝ := min (x ^ ((11 : ℝ) / 25))
        ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ)
      (∀ i, p i ∈ P) →
      (∀ i, ⌊Real.logb (1 + h) (p i : ℝ)⌋₊ = b i) →
      (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ →
      ∀ S : Finset (Fin 4), S.Nonempty → S ≠ Finset.univ →
        x ^ ((40481 : ℝ) / 100000) ≤ ∏ i ∈ S, (p i : ℝ) →
        (∏ i ∈ S, (p i : ℝ)) ≤ x ^ ((59519 : ℝ) / 100000) →
        ∃ R : Finset (Fin 4), ∃ Y : Fin 4 → ℝ,
          (R = S ∨ R = Sᶜ) ∧ R.Nonempty ∧ R ≠ Finset.univ ∧
          (∀ i, x ^ ((9519 : ℝ) / 100000) ≤ Y i ∧ Y i ≤ x ^ (2 : ℝ)) ∧
          (∀ i, Y i ≤ L i ∧ U i ≤ 2 * Y i) ∧
          x / 64 ≤ ∏ i, Y i ∧ (∏ i, Y i) ≤ 64 * x ∧
          x ^ ((40481 : ℝ) / 100000 - τ) ≤ ∏ i ∈ R, Y i ∧
          (∏ i ∈ R, Y i) ≤ x ^ (1 / 2 : ℝ) := by
  filter_upwards [eventually_ge_atTop (2 : ℝ),
    (tendsto_rpow_atTop hτ).eventually (eventually_ge_atTop (64 : ℝ)),
    (tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 9519 / 100000)).eventually
      (eventually_ge_atTop (2 : ℝ))] with x hx hxτ hxξ
  intro h hh hh4 b p P L U hp hlabel hprod S hSnon hSne hcentralLo hcentralHi
  have hx1 : 1 ≤ x := by linarith
  have hx0 : 0 < x := by linarith
  have hbase : 0 < 1 + h := by linarith
  have hscales := four_prime_geometric_active_scales x h hx hh (by linarith)
    b p hp hlabel hprod
  have hLpos (i : Fin 4) : 0 < L i :=
    (Real.rpow_pos_of_pos hx0 _).trans_le (le_max_left _ _)
  have hpLU (i : Fin 4) : L i ≤ (p i : ℝ) ∧ (p i : ℝ) ≤ U i := by
    have hm : p i ∈ P.filter (fun n : ℕ => ⌊Real.logb (1 + h) (n : ℝ)⌋₊ = b i) :=
      Finset.mem_filter.mpr ⟨hp i, hlabel i⟩
    rw [four_prime_geometric_bin_eq_closed_interval x h hx0 hh (b i)] at hm
    have hm' := Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1
    exact ⟨Nat.le_of_ceil_le hm'.1,
      (Nat.cast_le.mpr hm'.2).trans (Nat.floor_le (by positivity))⟩
  have hUnarrow (i : Fin 4) : U i ≤ (4 / 3 : ℝ) * L i := by
    have hceil : 0 < ⌈(1 + h) ^ (b i + 1)⌉₊ :=
      Nat.ceil_pos.mpr (pow_pos hbase _)
    have htop : ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ) <
        (1 + h) ^ (b i + 1) := Nat.lt_ceil.mp (by omega)
    calc
      U i ≤ ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ) := min_le_right _ _
      _ ≤ (1 + h) ^ (b i + 1) := htop.le
      _ = (1 + h) * (1 + h) ^ b i := by rw [pow_succ]; ring
      _ ≤ (4 / 3 : ℝ) * L i := mul_le_mul (by linarith) (le_max_right _ _)
        (pow_nonneg hbase.le _) (by norm_num)
  have hsubcompare (T : Finset (Fin 4)) :
      (∏ i ∈ T, (p i : ℝ)) ≤ 32 * ∏ i ∈ T, L i := by
    have hT : T.card ≤ 5 := by
      have ht : T.card ≤ 4 := by
        simpa using (Finset.card_le_card (Finset.subset_univ T))
      omega
    have hpow : (2 : ℝ) ^ T.card ≤ 32 := by
      calc
        _ ≤ (2 : ℝ) ^ 5 := pow_le_pow_right₀ (by norm_num) hT
        _ = 32 := by norm_num
    calc
      _ ≤ ∏ i ∈ T, 2 * L i := Finset.prod_le_prod (fun _ _ => Nat.cast_nonneg _)
        (fun i _ => (hpLU i).2.trans (hscales.1 i).2.2)
      _ = (2 : ℝ) ^ T.card * ∏ i ∈ T, L i := by
        rw [Finset.prod_mul_distrib, Finset.prod_const]
      _ ≤ 32 * ∏ i ∈ T, L i := mul_le_mul_of_nonneg_right hpow
        (Finset.prod_nonneg fun i _ => (hLpos i).le)
  have hpfull : x ≤ ∏ i, (p i : ℝ) := by
    exact_mod_cast Nat.le_of_ceil_le (Finset.mem_Icc.mp hprod).1
  have hpower : x ^ ((59519 : ℝ) / 100000) * x ^ ((40481 : ℝ) / 100000) = x := by
    rw [← Real.rpow_add hx0]
    norm_num
  have hcomp : x ^ ((40481 : ℝ) / 100000) ≤ ∏ i ∈ Sᶜ, (p i : ℝ) := by
    apply le_of_mul_le_mul_left (a := x ^ ((59519 : ℝ) / 100000))
      ?_ (Real.rpow_pos_of_pos hx0 _)
    calc
      _ = x := hpower
      _ ≤ ∏ i, (p i : ℝ) := hpfull
      _ = (∏ i ∈ S, (p i : ℝ)) * ∏ i ∈ Sᶜ, (p i : ℝ) :=
        (Finset.prod_mul_prod_compl S (fun i => (p i : ℝ))).symm
      _ ≤ x ^ ((59519 : ℝ) / 100000) * ∏ i ∈ Sᶜ, (p i : ℝ) :=
        mul_le_mul_of_nonneg_right hcentralHi (Finset.prod_nonneg fun _ _ => Nat.cast_nonneg _)
  obtain ⟨R, Y, hR, hRn, hRne, hY, hprodLo, hprodHi, hblockLo, hblockHi⟩ :=
    four_central_box_one_coordinate_scales x hx0.le L U hLpos
      (fun i => ⟨(hpLU i).1.trans (hpLU i).2, hUnarrow i⟩)
      hscales.2.2 S hSnon hSne
  have hRlower : x ^ ((40481 : ℝ) / 100000) / 32 ≤ ∏ i ∈ R, L i := by
    rcases hR with hRS | hRS
    · rw [hRS]
      linarith [hsubcompare S]
    · rw [hRS]
      linarith [hsubcompare Sᶜ]
  refine ⟨R, Y, hR, hRn, hRne, ?_, (fun i => (hY i).2), ?_, ?_, ?_, hblockHi⟩
  · intro i
    constructor
    · have hξpos : 0 < x ^ ((9519 : ℝ) / 100000) := Real.rpow_pos_of_pos hx0 _
      have hξsq : x ^ ((9519 : ℝ) / 50000) =
          x ^ ((9519 : ℝ) / 100000) * x ^ ((9519 : ℝ) / 100000) := by
        rw [← Real.rpow_add hx0]
        congr 1
        norm_num
      have hξL : x ^ ((9519 : ℝ) / 50000) ≤ L i := le_max_left _ _
      have hξmul := mul_le_mul_of_nonneg_right hxξ hξpos.le
      nlinarith [(hY i).1]
    · exact (hY i).2.1.trans ((hscales.1 i).2.1.trans
        ((min_le_left _ _).trans (Real.rpow_le_rpow_of_exponent_le hx1 (by norm_num))))
  · linarith [hscales.2.1]
  · linarith [hscales.2.2]
  · rw [Real.rpow_sub hx0]
    exact (div_le_div_of_nonneg_left (Real.rpow_pos_of_pos hx0 _).le
      (by norm_num : (0 : ℝ) < 64) hxτ).trans (by linarith)

/--
A multiplicative inequality on four coordinates, specified by numerator and denominator index
sets, a threshold, and lower-bound and strictness flags.
-/
structure MinorantFourMonomialCut where
  /--
  Indices of the four coordinates multiplied in the quotient's numerator; the empty product is
  `1`.
  -/
  numerator : Finset (Fin 4)
  /--
  Indices of the four coordinates multiplied in the quotient's denominator; the empty product is
  `1`.
  -/
  denominator : Finset (Fin 4)
  /--
  The real comparison level for the coordinate-product quotient; the structure imposes no
  positivity condition on this field.
  -/
  threshold : ℝ
  /--
  Select a lower bound (`threshold ≤ value`) when `true`, and an upper bound (`value ≤
  threshold`) when `false`; `strict` changes `≤` to `<`.
  -/
  lower : Bool
  /--
  Select `<` when `true` and `≤` when `false`; `lower` determines which side contains the
  threshold.
  -/
  strict : Bool

/--
The real quotient of the selected numerator and denominator products for a four-coordinate cut,
using totalized real division.
-/
noncomputable def MinorantFourMonomialCut.value (d : MinorantFourMonomialCut)
    (p : Fin 4 → ℕ) : ℝ :=
  (∏ i ∈ d.numerator, (p i : ℝ)) / ∏ i ∈ d.denominator, (p i : ℝ)

theorem geometric_four_box_product_bound (h x : ℝ) (hh : 0 < h) (hh1 : h ≤ 1)
    (p q : Fin 4 → ℕ) (hp : ∀ i, 1 ≤ p i) (hq : ∀ i, 1 ≤ q i)
    (hlabel : ∀ i, ⌊Real.logb (1 + h) (p i : ℝ)⌋₊ =
      ⌊Real.logb (1 + h) (q i : ℝ)⌋₊)
    (hprod : ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x) :
    ((∏ i, q i : ℕ) : ℝ) ≤ 64 * x := by
  have hp0 : 0 ≤ ∏ i, (p i : ℝ) := Finset.prod_nonneg fun _ _ => Nat.cast_nonneg _
  have hprod' : (∏ i, (p i : ℝ)) ≤ 2 * x := by exact_mod_cast hprod
  have hratio : (∏ i, (q i : ℝ)) ≤ (1 + h) ^ 4 * ∏ i, (p i : ℝ) := by
    calc
      _ ≤ ∏ i, ((1 + h) * p i) :=
        Finset.prod_le_prod (fun _ _ => Nat.cast_nonneg _)
          (fun i _ => (geometric_bin_pair_ratios h hh (p i) (q i)
            (hp i) (hq i) (hlabel i)).2)
      _ = _ := by rw [Finset.prod_mul_distrib]; simp
  have hpow : (1 + h) ^ 4 ≤ (32 : ℝ) := by
    calc
      (1 + h) ^ 4 ≤ 2 ^ 4 := pow_le_pow_left₀ (by positivity) (by linarith) _
      _ ≤ 32 := by norm_num
  have := hratio.trans (mul_le_mul_of_nonneg_right hpow hp0)
  exact_mod_cast this.trans (by nlinarith only [hprod'])

theorem finite_four_tuple_monomial_boundary_count
    (x η : ℝ) (hx : 2 ≤ x) (hη : 0 ≤ η) (i : Fin 4)
    (S : Finset (Fin 4 → ℕ)) (L U : (Fin 3 → ℕ) → ℝ)
    (hS : ∀ t ∈ S,
      (∀ j, x ^ ((9519 : ℝ) / 50000) ≤ (t j : ℝ)) ∧
        ((∏ j, t j : ℕ) : ℝ) ≤ 64 * x ∧
        L (Fin.removeNth i t) ≤ (t i : ℝ) ∧
        (t i : ℝ) ≤ U (Fin.removeNth i t))
    (hwidth : ∀ r : Fin 3 → ℕ, (∀ j, 0 < r j) →
      ((∏ j, r j : ℕ) : ℝ) ≤ 64 * x / x ^ ((9519 : ℝ) / 50000) →
        U r - L r ≤ η * (64 * x / ((∏ j, r j : ℕ) : ℝ))) :
    (S.card : ℝ) ≤
      64 * (η * x + x ^ (1 - (9519 : ℝ) / 50000)) *
        (1 + Real.log (64 * x)) ^ 16 := by
  classical
  let ξ : ℝ := 9519 / 50000
  let Z : ℝ := 64 * x
  let Y : ℝ := Z / x ^ ξ
  let N : ℕ := ⌊Y⌋₊
  let R : Finset (Fin 3 → ℕ) := S.image (Fin.removeNth i)
  let H : ℝ := 1 + Real.log Z
  have hx1 : 1 ≤ x := (by norm_num : (1 : ℝ) ≤ 2).trans hx
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hξ0 : 0 ≤ ξ := by norm_num [ξ]
  have hξ1 : ξ ≤ 1 := by norm_num [ξ]
  have hxξ : 1 ≤ x ^ ξ := Real.one_le_rpow hx1 hξ0
  have hxξ0 : 0 < x ^ ξ := Real.rpow_pos_of_pos hx0 ξ
  have hZ : 0 < Z := by dsimp [Z]; positivity
  have hY1 : 1 ≤ Y := by
    apply (le_div_iff₀ hxξ0).mpr
    have hpow := Real.rpow_le_self_of_one_le hx1 hξ1
    dsimp [Z]
    linarith
  have hY0 : 0 ≤ Y := zero_le_one.trans hY1
  have hYZ : Y ≤ Z := div_le_self hZ.le hxξ
  have hN1 : 1 ≤ N := Nat.le_floor (by simpa only [Nat.cast_one] using hY1)
  have hNY : (N : ℝ) ≤ Y := Nat.floor_le hY0
  have hNZ : (N : ℝ) ≤ Z := hNY.trans hYZ
  have hH1 : 1 ≤ H := by
    have hZ1 : 1 ≤ Z := (by exact_mod_cast hN1 : (1 : ℝ) ≤ N).trans hNZ
    exact le_add_of_nonneg_right (Real.log_nonneg hZ1)
  have hlogN0 : 0 ≤ 1 + Real.log (N : ℝ) := by
    have hN1r : (1 : ℝ) ≤ N := by exact_mod_cast hN1
    positivity
  have hlogNZ : 1 + Real.log (N : ℝ) ≤ H := by
    exact add_le_add (le_refl 1)
      (Real.log_le_log (by exact_mod_cast hN1 : (0 : ℝ) < N) hNZ)
  have hpositive (t : Fin 4 → ℕ) (ht : t ∈ S) (j : Fin 4) : 0 < t j :=
    Nat.cast_pos.mp (hxξ0.trans_le ((hS t ht).1 j))
  have hR (r : Fin 3 → ℕ) (hr : r ∈ R) :
      (∀ j, 0 < r j) ∧ ((∏ j, r j : ℕ) : ℝ) ≤ Y := by
    obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hr
    refine ⟨fun j => hpositive t ht (i.succAbove j), ?_⟩
    have hprod : (t i : ℝ) * ((∏ j, Fin.removeNth i t j : ℕ) : ℝ) =
        ((∏ j, t j : ℕ) : ℝ) := by
      exact_mod_cast Fin.mul_prod_removeNth i t
    apply (le_div_iff₀ hxξ0).mpr
    calc
      _ ≤ (t i : ℝ) * ((∏ j, Fin.removeNth i t j : ℕ) : ℝ) := by
        have hti : x ^ ξ ≤ (t i : ℝ) := (hS t ht).1 i
        exact (mul_le_mul_of_nonneg_left hti
          (Nat.cast_nonneg (∏ j, Fin.removeNth i t j))).trans_eq (mul_comm _ _)
      _ ≤ Z := hprod ▸ (hS t ht).2.1
  have hRnat : ∀ r ∈ R, (∀ j, 0 < r j) ∧ (∏ j, r j) ≤ N := by
    intro r hr
    exact ⟨(hR r hr).1, Nat.le_floor (hR r hr).2⟩
  obtain ⟨hRcard, hRrec⟩ := finite_positive_tuple_product_moments 3 N R hRnat
  have hRcard' : (R.card : ℝ) ≤ Y * H ^ 15 := by
    refine hRcard.trans ?_
    norm_num only [show 2 ^ (3 : ℕ) - 1 = 7 by norm_num]
    exact mul_le_mul hNY
      ((pow_le_pow_left₀ hlogN0 hlogNZ 7).trans
        (pow_le_pow_right₀ hH1 (by norm_num : 7 ≤ 15)))
      (pow_nonneg hlogN0 _) hY0
  have hRrec' : (∑ r ∈ R, 1 / ((∏ j, r j : ℕ) : ℝ)) ≤ H ^ 16 := by
    refine hRrec.trans ?_
    norm_num only [show 2 ^ (3 : ℕ) = 8 by norm_num]
    exact (pow_le_pow_left₀ hlogN0 hlogNZ 8).trans
      (pow_le_pow_right₀ hH1 (by norm_num : 8 ≤ 16))
  have hfiber (r : Fin 3 → ℕ) (hr : r ∈ R) :
      ((S.filter (fun t => Fin.removeNth i t = r)).card : ℝ) ≤
        η * (Z / ((∏ j, r j : ℕ) : ℝ)) + 1 := by
    let T := S.filter (fun t => Fin.removeNth i t = r)
    have hinj : Set.InjOn (fun t : Fin 4 → ℕ => t i) T := by
      intro t ht u hu htu
      change t i = u i at htu
      have htR := (Finset.mem_filter.mp ht).2
      have huR := (Finset.mem_filter.mp hu).2
      calc
        t = Fin.insertNth i (t i) (Fin.removeNth i t) :=
          (Fin.insertNth_self_removeNth i t).symm
        _ = Fin.insertNth i (u i) (Fin.removeNth i u) := by rw [htR, huR, htu]
        _ = u := Fin.insertNth_self_removeNth i u
    have hcard : (T.image (fun t => t i)).card = T.card :=
      Finset.card_image_of_injOn hinj
    rw [← hcard]
    apply finite_nat_closed_band_card_le _ (L r) (U r) _ (by positivity)
    · intro n hn
      obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hn
      obtain ⟨htS, htr⟩ := Finset.mem_filter.mp ht
      simpa only [htr] using (hS t htS).2.2
    · exact hwidth r (hR r hr).1 (hR r hr).2
  have hcount : (S.card : ℝ) ≤
      η * Z * (∑ r ∈ R, 1 / ((∏ j, r j : ℕ) : ℝ)) + (R.card : ℝ) := by
    calc
      _ = ∑ r ∈ R, ((S.filter (fun t => Fin.removeNth i t = r)).card : ℝ) := by
        exact_mod_cast Finset.card_eq_sum_card_image (Fin.removeNth i) S
      _ ≤ ∑ r ∈ R, (η * (Z / ((∏ j, r j : ℕ) : ℝ)) + 1) :=
        Finset.sum_le_sum hfiber
      _ = _ := by
        simp only [Finset.sum_add_distrib, Finset.mul_sum, Finset.sum_const,
          nsmul_eq_mul, mul_one, div_eq_mul_inv, one_mul, mul_assoc]
  have hYeq : Y = 64 * x ^ (1 - ξ) := by
    dsimp [Y, Z]
    rw [Real.rpow_sub hx0, Real.rpow_one]
    ring
  have hHpow : H ^ 15 ≤ H ^ 16 := by
    exact pow_le_pow_right₀ hH1 (by norm_num)
  calc
    _ ≤ η * Z * H ^ 16 + Y * H ^ 15 :=
      hcount.trans (add_le_add
        (mul_le_mul_of_nonneg_left hRrec' (mul_nonneg hη hZ.le)) hRcard')
    _ ≤ η * Z * H ^ 16 + Y * H ^ 16 :=
      add_le_add (le_refl _) (mul_le_mul_of_nonneg_left hHpow hY0)
    _ = _ := by rw [hYeq]; dsimp [Z, H, ξ]; ring

theorem geometric_four_monomial_comparison (h : ℝ) (hh : 0 < h)
    (p q : Fin 4 → ℕ) (hp : ∀ i, 1 ≤ p i) (hq : ∀ i, 1 ≤ q i)
    (hlabel : ∀ i, ⌊Real.logb (1 + h) (p i : ℝ)⌋₊ =
      ⌊Real.logb (1 + h) (q i : ℝ)⌋₊)
    (d : MinorantFourMonomialCut) :
    d.value p ≤ (1 + h) ^ (d.numerator.card + d.denominator.card) * d.value q ∧
    d.value q ≤ (1 + h) ^ (d.numerator.card + d.denominator.card) * d.value p := by
  have one_way (p q : Fin 4 → ℕ) (hp : ∀ i, 1 ≤ p i) (hq : ∀ i, 1 ≤ q i)
      (hlab : ∀ i, ⌊Real.logb (1 + h) (p i : ℝ)⌋₊ =
        ⌊Real.logb (1 + h) (q i : ℝ)⌋₊) :
      d.value p ≤ (1 + h) ^ (d.numerator.card + d.denominator.card) * d.value q := by
    have hp0 (i : Fin 4) : 0 < (p i : ℝ) := by exact_mod_cast hp i
    have hq0 (i : Fin 4) : 0 < (q i : ℝ) := by exact_mod_cast hq i
    have hnum : (∏ i ∈ d.numerator, (p i : ℝ)) ≤
        (1 + h) ^ d.numerator.card * ∏ i ∈ d.numerator, (q i : ℝ) := by
      calc
        _ ≤ ∏ i ∈ d.numerator, ((1 + h) * q i) :=
          Finset.prod_le_prod (fun i _ => (hp0 i).le)
            (fun i _ => (geometric_bin_pair_ratios h hh (p i) (q i)
              (hp i) (hq i) (hlab i)).1)
        _ = _ := by rw [Finset.prod_mul_distrib, Finset.prod_const]
    have hden : (∏ i ∈ d.denominator, (q i : ℝ)) ≤
        (1 + h) ^ d.denominator.card * ∏ i ∈ d.denominator, (p i : ℝ) := by
      calc
        _ ≤ ∏ i ∈ d.denominator, ((1 + h) * p i) :=
          Finset.prod_le_prod (fun i _ => (hq0 i).le)
            (fun i _ => (geometric_bin_pair_ratios h hh (p i) (q i)
              (hp i) (hq i) (hlab i)).2)
        _ = _ := by rw [Finset.prod_mul_distrib, Finset.prod_const]
    have hpd : 0 < ∏ i ∈ d.denominator, (p i : ℝ) :=
      Finset.prod_pos fun i _ => hp0 i
    have hqd : 0 < ∏ i ∈ d.denominator, (q i : ℝ) :=
      Finset.prod_pos fun i _ => hq0 i
    dsimp [MinorantFourMonomialCut.value]
    rw [pow_add, ← mul_div_assoc, div_le_div_iff₀ hpd hqd]
    calc
      _ ≤ ((1 + h) ^ d.numerator.card * ∏ i ∈ d.numerator, (q i : ℝ)) *
          ((1 + h) ^ d.denominator.card * ∏ i ∈ d.denominator, (p i : ℝ)) :=
        mul_le_mul hnum hden hqd.le (by positivity)
      _ = _ := by ring
  exact ⟨one_way p q hp hq hlabel, one_way q p hq hp (fun i => (hlabel i).symm)⟩

theorem MinorantFourMonomialCut.value_insertNth_factor (d : MinorantFourMonomialCut)
    (i : Fin 4) (hi : i ∈ d.numerator) (hid : i ∉ d.denominator)
    (p : Fin 4 → ℕ) :
    d.value p = (p i : ℝ) * d.value (i.insertNth 1 (i.removeNth p)) := by
  classical
  rw [Fin.insertNth_removeNth]
  simp only [MinorantFourMonomialCut.value,
    Function.apply_update (fun (_ : Fin 4) (n : ℕ) => (n : ℝ)), Nat.cast_one]
  rw [Finset.prod_update_of_mem hi, Finset.prod_update_of_notMem hid,
    one_mul, Finset.sdiff_singleton_eq_erase, ← Finset.mul_prod_erase _ _ hi]
  ring

theorem MinorantFourMonomialCut.closed_coordinate_band (d : MinorantFourMonomialCut)
    (i : Fin 4) (hi : i ∈ d.numerator) (hid : i ∉ d.denominator)
    (p : Fin 4 → ℕ) (hp : ∀ k, 0 < p k) (R Z : ℝ) (hR : 0 < R)
    (hsupport : (p i : ℝ) ≤ Z)
    (hband : d.threshold / R ≤ d.value p ∧ d.value p ≤ d.threshold * R) :
    let t := d.threshold / d.value (i.insertNth 1 (i.removeNth p))
    t / R ≤ (p i : ℝ) ∧ (p i : ℝ) ≤ min (t * R) Z := by
  intro t
  have hbase : ∀ k : Fin 4, 0 < (i.insertNth 1 (i.removeNth p) k : ℝ) := by
    rw [Fin.insertNth_removeNth,
      Function.forall_update_iff p (fun _ (n : ℕ) => 0 < (n : ℝ))]
    exact ⟨by norm_num, fun k _ => Nat.cast_pos.mpr (hp k)⟩
  have hv : 0 < d.value (i.insertNth 1 (i.removeNth p)) :=
    div_pos (Finset.prod_pos fun k _ => hbase k) (Finset.prod_pos fun k _ => hbase k)
  rw [d.value_insertNth_factor i hi hid p] at hband
  constructor
  · dsimp [t]
    rw [div_div, div_le_iff₀ (mul_pos hv hR)]
    have hh := (div_le_iff₀ hR).mp hband.1
    nlinarith only [hh]
  · apply le_min _ hsupport
    dsimp [t]
    rw [div_mul_eq_mul_div, le_div_iff₀ hv]
    exact hband.2

theorem geometric_four_monomial_test_crossing
    (h : ℝ) (hh : 0 < h) (d : MinorantFourMonomialCut) (hd : 0 ≤ d.threshold)
    (p q : Fin 4 → ℕ) (hp : ∀ i, 1 ≤ p i) (hq : ∀ i, 1 ≤ q i)
    (hlabel : ∀ i, ⌊Real.logb (1 + h) (p i : ℝ)⌋₊ =
      ⌊Real.logb (1 + h) (q i : ℝ)⌋₊)
    (hchange : ¬((if d.lower then
        if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
      else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
      (if d.lower then
        if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
      else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold))) :
    (d.threshold / (1 + h) ^ (d.numerator.card + d.denominator.card) ≤ d.value p ∧
      d.value p ≤ d.threshold * (1 + h) ^ (d.numerator.card + d.denominator.card)) ∧
    (d.threshold / (1 + h) ^ (d.numerator.card + d.denominator.card) ≤ d.value q ∧
      d.value q ≤ d.threshold * (1 + h) ^ (d.numerator.card + d.denominator.card)) := by
  have hcompare := geometric_four_monomial_comparison h hh p q hp hq hlabel d
  apply threshold_bands_of_crossing _ _ _ _ hd
    (one_le_pow₀ (by linarith)) hcompare.1 hcompare.2
  rw [not_iff, iff_iff_and_or_not_and_not] at hchange
  cases hl : d.lower <;> cases hs : d.strict <;>
    simp only [hl, hs, Bool.false_eq_true, ite_false, ite_true,
      not_le, not_lt] at hchange <;>
    rcases hchange with ⟨hp, hq⟩ | ⟨hp, hq⟩ <;>
    first | exact Or.inl ⟨by linarith, by linarith⟩
          | exact Or.inr ⟨by linarith, by linarith⟩

open Classical in
theorem boolean_four_monomial_mixed_geometric_box_card
    (x h : ℝ) (hx : 2 ≤ x) (hh : 0 < h) (hh1 : h ≤ 1)
    (M : Finset MinorantFourMonomialCut) (C : (Fin 4 → ℕ) → Prop)
    (hM : ∀ d ∈ M, d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
      d.numerator.card + d.denominator.card ≤ 4 ∧ 0 < d.threshold) :
    let P : Finset ℕ :=
      (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((11 : ℝ) / 25)⌋₊).filter Nat.Prime
    let T := Fintype.piFinset (fun _ : Fin 4 => P)
    (∀ p ∈ T, ∀ q ∈ T,
      (∀ d ∈ M,
        (if d.lower then
          if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
        else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
        (if d.lower then
          if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
        else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
      (C p ↔ C q)) →
    (∀ p ∈ T, C p → ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x) →
    let label (p : Fin 4 → ℕ) : Fin 4 → ℕ :=
      fun i => ⌊Real.logb (1 + h) (p i : ℝ)⌋₊
    let U (b : Fin 4 → ℕ) := T.filter (fun p => label p = b)
    let D := (T.image label).filter
      (fun b => (∃ p ∈ U b, C p) ∧ ¬∀ p ∈ U b, C p)
    (∑ b ∈ D, ((U b).card : ℝ)) ≤
      (M.card : ℝ) * 64 *
        (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
          (1 + Real.log (64 * x)) ^ 16 := by
  intro P T hboolean hsupport label U D
  let S := T.filter (fun q => label q ∈ D)
  let R (d : MinorantFourMonomialCut) : ℝ := (1 + h) ^
    (d.numerator.card + d.denominator.card)
  let E (d : MinorantFourMonomialCut) := S.filter
    (fun q => d.threshold / R d ≤ d.value q ∧ d.value q ≤ d.threshold * R d)
  let V : ℝ := 64 * (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
    (1 + Real.log (64 * x)) ^ 16
  have hpositive (p : Fin 4 → ℕ) (hp : p ∈ T) (i : Fin 4) : 1 ≤ p i := by
    have hprime : (p i).Prime :=
      (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).2
    exact hprime.one_lt.le
  have hlower (p : Fin 4 → ℕ) (hp : p ∈ T) (i : Fin 4) :
      x ^ ((9519 : ℝ) / 50000) ≤ (p i : ℝ) := by
    have hnat := (Finset.mem_Icc.mp
      (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).1).1
    exact (Nat.le_ceil _).trans (Nat.cast_le.mpr hnat)
  have hchanged (p q : Fin 4 → ℕ) (hp : p ∈ T) (hq : q ∈ T)
      (hlab : ∀ i, ⌊Real.logb (1 + h) (p i : ℝ)⌋₊ =
        ⌊Real.logb (1 + h) (q i : ℝ)⌋₊) (hpass : C p) (hfail : ¬C q) :
      ∃ d ∈ M,
        (d.threshold / R d ≤ d.value p ∧ d.value p ≤ d.threshold * R d) ∧
        (d.threshold / R d ≤ d.value q ∧ d.value q ≤ d.threshold * R d) := by
    have hex : ∃ d ∈ M, ¬((if d.lower then
          if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
        else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
        (if d.lower then
          if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
        else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) := by
      by_contra! hnone
      exact hfail ((hboolean p hp q hq hnone).mp hpass)
    obtain ⟨d, hd, hchange⟩ := hex
    exact ⟨d, hd, geometric_four_monomial_test_crossing h hh d (hM d hd).2.2.2.le
      p q (hpositive p hp) (hpositive q hq) hlab hchange⟩
  have hboundary (q : Fin 4 → ℕ) (hq : q ∈ S) :
      ((∏ i, q i : ℕ) : ℝ) ≤ 64 * x ∧
        ∃ d ∈ M, d.threshold / R d ≤ d.value q ∧ d.value q ≤ d.threshold * R d := by
    obtain ⟨hqT, hqD⟩ := Finset.mem_filter.mp hq
    have hmix := (Finset.mem_filter.mp hqD).2
    obtain ⟨p₀, hp₀, hpass⟩ := hmix.1
    have hex : ∃ p₁ ∈ U (label q), ¬C p₁ := by
      simpa only [not_forall, exists_prop] using hmix.2
    obtain ⟨p₁, hp₁, hfail⟩ := hex
    have hp₀T : p₀ ∈ T := (Finset.mem_filter.mp hp₀).1
    have hp₁T : p₁ ∈ T := (Finset.mem_filter.mp hp₁).1
    have hlab₀ (i : Fin 4) :
        ⌊Real.logb (1 + h) (p₀ i : ℝ)⌋₊ =
          ⌊Real.logb (1 + h) (q i : ℝ)⌋₊ :=
      congrFun (Finset.mem_filter.mp hp₀).2 i
    have hlab₁ (i : Fin 4) :
        ⌊Real.logb (1 + h) (p₁ i : ℝ)⌋₊ =
          ⌊Real.logb (1 + h) (q i : ℝ)⌋₊ :=
      congrFun (Finset.mem_filter.mp hp₁).2 i
    refine ⟨geometric_four_box_product_bound h x hh hh1 p₀ q
      (hpositive p₀ hp₀T) (hpositive q hqT) hlab₀ (hsupport p₀ hp₀T hpass), ?_⟩
    by_cases hqpass : C q
    · obtain ⟨d, hd, hb, _⟩ := hchanged q p₁ hqT hp₁T
        (fun i => (hlab₁ i).symm) hqpass hfail
      exact ⟨d, hd, hb⟩
    · obtain ⟨d, hd, _, hb⟩ := hchanged p₀ q hp₀T hqT hlab₀ hpass hqpass
      exact ⟨d, hd, hb⟩
  have hE (d : MinorantFourMonomialCut) (hd : d ∈ M) : ((E d).card : ℝ) ≤ V := by
    have hdata := hM d hd
    obtain ⟨i, hi⟩ := hdata.1
    have hid : i ∉ d.denominator := fun hb => Finset.disjoint_left.mp hdata.2.1 hi hb
    have hR : 1 ≤ R d := one_le_pow₀ (by linarith)
    have hR0 : 0 < R d := zero_lt_one.trans_le hR
    let t (r : Fin 3 → ℕ) := d.threshold / d.value (i.insertNth 1 r)
    let L (r : Fin 3 → ℕ) := t r / R d
    let U₀ (r : Fin 3 → ℕ) := min (t r * R d) (64 * x / ((∏ k, r k : ℕ) : ℝ))
    have hwidth (r : Fin 3 → ℕ) (hr : ∀ k, 0 < r k) :
        U₀ r - L r ≤ (1023 * h) * (64 * x / ((∏ k, r k : ℕ) : ℝ)) := by
      have hbase : ∀ k : Fin 4,
          0 < ((Fin.insertNth (α := fun _ : Fin 4 => ℕ) i 1 r k : ℕ) : ℝ) := by
        rw [Fin.forall_iff_succAbove i]
        simpa using hr
      have ht : 0 ≤ t r :=
        div_nonneg hdata.2.2.2.le
          (div_nonneg (Finset.prod_nonneg fun k _ => (hbase k).le)
            (Finset.prod_nonneg fun k _ => (hbase k).le))
      have hZ : 0 ≤ 64 * x / ((∏ k, r k : ℕ) : ℝ) := by positivity
      exact (monomial_clipped_band_width (t r) (R d) _ ht hR hZ).trans
        (mul_le_mul_of_nonneg_right
          (geometric_degree_five_width h hh.le hh1 _
            (hdata.2.2.1.trans (by decide))) hZ)
    apply finite_four_tuple_monomial_boundary_count x (1023 * h) hx (by positivity)
      i (E d) L U₀
    · intro q hq
      obtain ⟨hqS, hband⟩ := Finset.mem_filter.mp hq
      have hqT := (Finset.mem_filter.mp hqS).1
      have hco : 0 < ((∏ k, i.removeNth q k : ℕ) : ℝ) := by
        exact_mod_cast Finset.prod_pos fun k _ =>
          zero_lt_one.trans_le (hpositive q hqT (i.succAbove k))
      have hsupport : (q i : ℝ) ≤ 64 * x / ((∏ k, i.removeNth q k : ℕ) : ℝ) := by
        rw [le_div_iff₀ hco]
        have heq : (q i : ℝ) * ((∏ k, i.removeNth q k : ℕ) : ℝ) =
            ((∏ k, q k : ℕ) : ℝ) := by exact_mod_cast Fin.mul_prod_removeNth i q
        rw [heq]
        exact (hboundary q hqS).1
      exact ⟨hlower q hqT, (hboundary q hqS).1,
        d.closed_coordinate_band i hi hid q
          (fun k => zero_lt_one.trans_le (hpositive q hqT k))
          (R d) _ hR0 hsupport hband⟩
    · intro r hr _hprod
      exact hwidth r hr
  have hcover : S ⊆ M.biUnion E := by
    intro q hq
    obtain ⟨d, hd, hband⟩ := (hboundary q hq).2
    exact Finset.mem_biUnion.mpr ⟨d, hd, Finset.mem_filter.mpr ⟨hq, hband⟩⟩
  have hcard : (S.card : ℝ) = ∑ b ∈ D, ((U b).card : ℝ) := by
    have hc : S.card = ∑ b ∈ D, (U b).card := by
      calc
        _ = ∑ b ∈ D, (S.filter (fun q => label q = b)).card :=
          Finset.card_eq_sum_card_fiberwise (fun q hq => (Finset.mem_filter.mp hq).2)
        _ = _ := by
          apply Finset.sum_congr rfl
          intro b hb
          congr 1
          ext q
          by_cases heq : label q = b <;> simp [S, U, heq, hb]
    exact_mod_cast hc
  rw [← hcard]
  calc
    _ ≤ ∑ d ∈ M, ((E d).card : ℝ) := by
      exact_mod_cast (Finset.card_le_card hcover).trans Finset.card_biUnion_le
    _ ≤ ∑ _d ∈ M, V := Finset.sum_le_sum hE
    _ = (M.card : ℝ) * V := by simp
    _ = _ := by dsimp [V]; ring

open Classical in
theorem sum_two_prime_divisorsAntidiagonal {A : Type*} [AddCommMonoid A]
    (n : ℕ) (w : (Fin 2 → ℕ) → A) :
    (∑ d ∈ n.divisorsAntidiagonal,
      if d.1.Prime ∧ d.2.Prime then w ![d.1, d.2] else 0) =
      ∑ p ∈ Fintype.piFinset (fun _ : Fin 2 => Nat.primesLE n),
        if (∏ i, p i) = n then w p else 0 := by
  let S := n.divisorsAntidiagonal.filter (fun d => d.1.Prime ∧ d.2.Prime)
  let T := (Fintype.piFinset (fun _ : Fin 2 => Nat.primesLE n)).filter
    (fun p => ∏ i, p i = n)
  let f (d : ℕ × ℕ) : Fin 2 → ℕ := ![d.1, d.2]
  calc
    _ = ∑ d ∈ S, w (f d) := by simp only [S, f, Finset.sum_filter]
    _ = ∑ p ∈ T, w p := by
      refine Finset.sum_bij (fun d _ => f d) ?_ ?_ ?_ (fun _ _ => rfl)
      · intro d hd
        obtain ⟨hd, hp, hq⟩ := Finset.mem_filter.mp hd
        have heq : ∏ i, f d i = n := by
          simpa only [f, Fin.prod_univ_two, Matrix.cons_val_zero,
            Matrix.cons_val_one] using (Nat.mem_divisorsAntidiagonal.mp hd).1
        have hprime (i : Fin 2) : (f d i).Prime := by
          fin_cases i
          · exact hp
          · exact hq
        apply Finset.mem_filter.mpr
        refine ⟨Fintype.mem_piFinset.mpr (fun i => ?_), heq⟩
        apply Nat.mem_primesLE.mpr
        refine ⟨Nat.le_of_dvd (Nat.pos_of_ne_zero (Nat.mem_divisorsAntidiagonal.mp hd).2) ?_,
          hprime i⟩
        rw [← heq]
        exact Finset.dvd_prod_of_mem _ (Finset.mem_univ i)
      · intro d _hd e _he hde
        exact Prod.ext (congrArg (fun p : Fin 2 → ℕ => p 0) hde)
          (congrArg (fun p : Fin 2 → ℕ => p 1) hde)
      · intro p hp
        obtain ⟨hpp, hpn⟩ := Finset.mem_filter.mp hp
        have hprime (i : Fin 2) := Nat.prime_of_mem_primesLE (Fintype.mem_piFinset.mp hpp i)
        have hprod : p 0 * p 1 = n := by simpa only [Fin.prod_univ_two] using hpn
        have hn : n ≠ 0 := by
          rw [← hprod]
          exact mul_ne_zero (hprime 0).ne_zero (hprime 1).ne_zero
        refine ⟨(p 0, p 1), Finset.mem_filter.mpr
          ⟨Nat.mem_divisorsAntidiagonal.mpr ⟨hprod, hn⟩, hprime 0, hprime 1⟩, ?_⟩
        funext i
        fin_cases i <;> rfl
    _ = _ := by simp only [T, Finset.sum_filter]

theorem source_large_first_power_gates :
    ∀ᶠ x : ℝ in atTop, 3 < x ∧
      2 * x < x ^ (3 * ((40481 : ℝ) / 100000)) ∧
      Real.sqrt (3 * x) < x ^ ((59519 : ℝ) / 100000) ∧
      2 * x ^ ((59519 : ℝ) / 100000) ≤ x ^ ((9 : ℝ) / 10) := by
  have hc := tendsto_rpow_atTop (by norm_num :
    (0 : ℝ) < 3 * (40481 / 100000) - 1)
  have hs := tendsto_rpow_atTop (by norm_num :
    (0 : ℝ) < 2 * (59519 / 100000) - 1)
  have hu := tendsto_rpow_atTop (by norm_num :
    (0 : ℝ) < 9 / 10 - 59519 / 100000)
  filter_upwards [eventually_gt_atTop (3 : ℝ), hc.eventually_gt_atTop 2,
    hs.eventually_gt_atTop 3, hu.eventually_ge_atTop 2] with x hx hcx hsx hux
  have hx0 : 0 < x := by linarith
  have hmul (r : ℝ) : x * x ^ (r - 1) = x ^ r := by
    conv_lhs => lhs; rw [← Real.rpow_one x]
    rw [← Real.rpow_add hx0]
    congr 1
    ring
  refine ⟨hx, ?_, ?_, ?_⟩
  · calc
      2 * x < x * x ^ (3 * (40481 / 100000) - 1) := by nlinarith
      _ = _ := hmul _
  · apply (Real.sqrt_lt' (Real.rpow_pos_of_pos hx0 _)).mpr
    calc
      3 * x < x * x ^ (2 * (59519 / 100000) - 1) := by nlinarith
      _ = x ^ (2 * (59519 / 100000)) := hmul _
      _ = (x ^ ((59519 : ℝ) / 100000)) ^ (2 : ℕ) := by
        rw [← Real.rpow_mul_natCast hx0.le]
        congr 1
        ring
  · calc
      2 * x ^ ((59519 : ℝ) / 100000) ≤
          x ^ ((59519 : ℝ) / 100000) * x ^ ((9 : ℝ) / 10 - 59519 / 100000) := by
        simpa only [mul_comm] using
          mul_le_mul_of_nonneg_left hux (Real.rpow_nonneg hx0.le ((59519 : ℝ) / 100000))
      _ = _ := by rw [← Real.rpow_add hx0]; congr 1; ring

open Classical in
theorem sourceLargeFirst_eq_two_primes {x : ℝ} (hx : 3 < x)
    (hcube : 2 * x < x ^ (3 * ((40481 : ℝ) / 100000)))
    (n : ℕ) (hnlo : x ≤ (n : ℝ)) (hnhi : (n : ℝ) ≤ 2 * x) :
    sourceLargeFirst x n =
      ∑ p ∈ Fintype.piFinset (fun _ : Fin 2 => Nat.primesLE n),
        if (∏ i, p i) = n ∧ x ^ ((40481 : ℝ) / 100000) ≤ (p 0 : ℝ) ∧
          (p 0 : ℝ) < Real.sqrt (3 * x) ∧ p 0 ≤ p 1 then (1 : ℝ) else 0 := by
  have hx0 : 0 < x := by linarith
  have hn0 : n ≠ 0 := by intro h; simp only [h, Nat.cast_zero] at hnlo; linarith
  have hsqrt : Real.sqrt (3 * x) < x :=
    (Real.sqrt_lt' hx0).mpr (by nlinarith)
  have hrough (d : ℕ × ℕ) (hd : d ∈ n.divisorsAntidiagonal)
      (hcut : d.1.Prime ∧ x ^ ((40481 : ℝ) / 100000) ≤ (d.1 : ℝ) ∧
        (d.1 : ℝ) < Real.sqrt (3 * x)) :
      roughWeight (d.1 : ℝ) d.2 = if d.2.Prime ∧ d.1 ≤ d.2 then 1 else 0 := by
    have hprod : d.1 * d.2 = n := (Nat.mem_divisorsAntidiagonal.mp hd).1
    have hr0 : d.2 ≠ 0 := by intro h; simp only [h, mul_zero] at hprod; exact hn0 hprod.symm
    have hr1 : d.2 ≠ 1 := by
      intro h
      have hp : d.1 = n := by simpa only [h, mul_one] using hprod
      have := hcut.2.2.trans hsqrt
      rw [hp] at this
      exact (not_lt_of_ge hnlo) this
    rw [roughWeight_eq_ite_minFac _ hr0 hr1]
    by_cases hp : d.2.Prime
    · rw [hp.minFac_eq]
      simp only [hp, true_and, Nat.cast_le]
    · have hnot : ¬ (d.1 : ℝ) ≤ (d.2.minFac : ℝ) := by
        intro hmin
        have hsq : (d.2.minFac : ℝ) ^ 2 ≤ (d.2 : ℝ) := by
          exact_mod_cast Nat.minFac_sq_le_self (Nat.pos_of_ne_zero hr0) hp
        have hpsq : (d.1 : ℝ) ^ 2 ≤ (d.2 : ℝ) :=
          (pow_le_pow_left₀ (Nat.cast_nonneg _) hmin 2).trans hsq
        have hcube' : (d.1 : ℝ) ^ 3 ≤ (n : ℝ) := by
          calc
            (d.1 : ℝ) ^ 3 = (d.1 : ℝ) * (d.1 : ℝ) ^ 2 := by ring
            _ ≤ (d.1 : ℝ) * (d.2 : ℝ) :=
              mul_le_mul_of_nonneg_left hpsq (Nat.cast_nonneg _)
            _ = _ := by exact_mod_cast hprod
        have hg : x ^ (3 * ((40481 : ℝ) / 100000)) ≤ (d.1 : ℝ) ^ 3 := by
          calc
            _ = (x ^ ((40481 : ℝ) / 100000)) ^ (3 : ℕ) := by
              rw [← Real.rpow_mul_natCast hx0.le]
              congr 1
              ring
            _ ≤ _ := pow_le_pow_left₀ (Real.rpow_nonneg hx0.le _) hcut.2.1 3
        exact (not_le_of_gt hcube) (hg.trans (hcube'.trans hnhi))
      simp only [hp, false_and, ite_false, ite_eq_right hnot]
  let w (p : Fin 2 → ℕ) : ℝ :=
    if x ^ ((40481 : ℝ) / 100000) ≤ (p 0 : ℝ) ∧
      (p 0 : ℝ) < Real.sqrt (3 * x) ∧ p 0 ≤ p 1 then 1 else 0
  calc
    sourceLargeFirst x n = ∑ d ∈ n.divisorsAntidiagonal,
        if d.1.Prime ∧ d.2.Prime then w ![d.1, d.2] else 0 := by
      change (∑ d ∈ n.divisorsAntidiagonal, _) = _
      apply Finset.sum_congr rfl
      intro d hd
      change (if d.1.Prime ∧ x ^ ((40481 : ℝ) / 100000) ≤ (d.1 : ℝ) ∧
          (d.1 : ℝ) < Real.sqrt (3 * x) then roughWeight (d.1 : ℝ) d.2 else 0) =
        (if d.1.Prime ∧ d.2.Prime then
          if x ^ ((40481 : ℝ) / 100000) ≤ (d.1 : ℝ) ∧
            (d.1 : ℝ) < Real.sqrt (3 * x) ∧ d.1 ≤ d.2 then 1 else 0 else 0)
      by_cases hcut : d.1.Prime ∧ x ^ ((40481 : ℝ) / 100000) ≤ (d.1 : ℝ) ∧
          (d.1 : ℝ) < Real.sqrt (3 * x)
      · rw [ite_eq_left hcut, hrough d hd hcut]
        by_cases hr : d.2.Prime <;> by_cases hord : d.1 ≤ d.2 <;>
          simp only [hcut.1, hcut.2.1, hcut.2.2, hr, hord, true_and, false_and,
            ite_true, ite_false]
      · rw [ite_eq_right hcut]
        split_ifs with hprime hbound
        · exact False.elim (hcut ⟨hprime.1, hbound.1, hbound.2.1⟩)
        · rfl
        · rfl
    _ = _ := by
      rw [sum_two_prime_divisorsAntidiagonal]
      apply Finset.sum_congr rfl
      intro p _hp
      dsimp only [w]
      split_ifs <;> simp_all only [and_self, not_true_eq_false, false_and]

open Classical in
theorem sourceLargeFirst_eventually_compact_central :
    ∀ᶠ x : ℝ in atTop,
      let P := (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((9 : ℝ) / 10)⌋₊).filter Nat.Prime
      let T := Fintype.piFinset (fun _ : Fin 2 => P)
      (∀ n : ℕ, x ≤ (n : ℝ) → (n : ℝ) ≤ 2 * x →
        sourceLargeFirst x n = ∑ p ∈ T,
          if (∏ i, p i) = n ∧ x ^ ((40481 : ℝ) / 100000) ≤ (p 0 : ℝ) ∧
            (p 0 : ℝ) < Real.sqrt (3 * x) ∧ p 0 ≤ p 1 then (1 : ℝ) else 0) ∧
      (∀ p ∈ T, x ^ ((40481 : ℝ) / 100000) ≤ (p 0 : ℝ) →
        (p 0 : ℝ) < Real.sqrt (3 * x) →
        ∃ S : Finset (Fin 2), S.Nonempty ∧ S ≠ Finset.univ ∧
          x ^ ((40481 : ℝ) / 100000) ≤ ((∏ i ∈ S, p i : ℕ) : ℝ) ∧
          ((∏ i ∈ S, p i : ℕ) : ℝ) ≤ x ^ ((59519 : ℝ) / 100000)) := by
  filter_upwards [source_large_first_power_gates] with x hx
  intro P T
  have hx1 : 1 < x := by linarith [hx.1]
  have hx0 : 0 < x := zero_lt_one.trans hx1
  have hab : x ^ ((40481 : ℝ) / 100000) * x ^ ((59519 : ℝ) / 100000) = x := by
    rw [← Real.rpow_add hx0]
    norm_num
  have halow : x ^ ((9519 : ℝ) / 50000) ≤ x ^ ((40481 : ℝ) / 100000) :=
    Real.rpow_le_rpow_of_exponent_le hx1.le (by norm_num)
  have hcompact (p : Fin 2 → ℕ) (hprime : ∀ i, (p i).Prime)
      (hprod : ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x)
      (hlo : x ^ ((40481 : ℝ) / 100000) ≤ (p 0 : ℝ)) (horder : p 0 ≤ p 1) : p ∈ T := by
    have hlo1 := hlo.trans (Nat.cast_le.mpr horder)
    have hproduct : (p 0 : ℝ) * (p 1 : ℝ) ≤ 2 * x := by
      simpa only [Fin.prod_univ_two, Nat.cast_mul] using hprod
    have ha0 : 0 < x ^ ((40481 : ℝ) / 100000) := Real.rpow_pos_of_pos hx0 _
    have hupper (i : Fin 2) : (p i : ℝ) ≤ 2 * x ^ ((59519 : ℝ) / 100000) := by
      fin_cases i
      · change (p 0 : ℝ) ≤ 2 * x ^ ((59519 : ℝ) / 100000)
        apply (mul_le_mul_iff_right₀ ha0).mp
        have hm := mul_le_mul_of_nonneg_left hlo1 (Nat.cast_nonneg (p 0))
        nlinarith
      · change (p 1 : ℝ) ≤ 2 * x ^ ((59519 : ℝ) / 100000)
        apply (mul_le_mul_iff_right₀ ha0).mp
        have hm := mul_le_mul_of_nonneg_right hlo (Nat.cast_nonneg (p 1))
        nlinarith
    apply Fintype.mem_piFinset.mpr
    intro i
    apply Finset.mem_filter.mpr
    refine ⟨Finset.mem_Icc.mpr ⟨Nat.ceil_le.mpr ?_,
      (Nat.le_floor_iff (Real.rpow_nonneg hx0.le _)).mpr ((hupper i).trans hx.2.2.2)⟩,
      hprime i⟩
    fin_cases i
    · exact halow.trans hlo
    · exact halow.trans hlo1
  constructor
  · intro n hnlo hnhi
    rw [sourceLargeFirst_eq_two_primes hx.1 hx.2.1 n hnlo hnhi]
    symm
    apply Finset.sum_subset
    · intro p hp
      apply Fintype.mem_piFinset.mpr
      intro i
      obtain ⟨hpi, hpprime⟩ := Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)
      apply Nat.mem_primesLE.mpr
      refine ⟨?_, hpprime⟩
      have hpupper := (Nat.le_floor_iff (Real.rpow_nonneg hx0.le _)).mp
        (Finset.mem_Icc.mp hpi).2
      have hxupper : x ^ ((9 : ℝ) / 10) ≤ x := by
        simpa only [Real.rpow_one] using
          Real.rpow_le_rpow_of_exponent_le hx1.le (by norm_num : (9 : ℝ) / 10 ≤ 1)
      exact_mod_cast hpupper.trans (hxupper.trans hnlo)
    · intro p hp hpnot
      apply ite_eq_right
      intro hcut
      have hprime (i : Fin 2) := Nat.prime_of_mem_primesLE (Fintype.mem_piFinset.mp hp i)
      have hprod : ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x := by rw [hcut.1]; exact hnhi
      exact hpnot (hcompact p hprime hprod hcut.2.1 hcut.2.2.2)
  · intro p _hp hlo hhi
    refine ⟨{0}, Finset.singleton_nonempty 0, ?_, ?_, ?_⟩
    · intro h
      have hm : (1 : Fin 2) ∈ ({0} : Finset (Fin 2)) := by rw [h]; exact Finset.mem_univ _
      norm_num at hm
    · simpa only [Finset.prod_singleton] using hlo
    · simpa only [Finset.prod_singleton] using (hhi.trans hx.2.2.1).le

open Classical in
theorem sourceLargeFirst_eventually_finsupp :
    ∀ᶠ x : ℝ in atTop,
      let P := (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((9 : ℝ) / 10)⌋₊).filter Nat.Prime
      let T := Fintype.piFinset (fun _ : Fin 2 => P)
      let C (p : Fin 2 → ℕ) : Prop :=
        x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x ∧
          x ^ ((40481 : ℝ) / 100000) ≤ (p 0 : ℝ) ∧
          (p 0 : ℝ) < Real.sqrt (3 * x) ∧ p 0 ≤ p 1
      (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        Finsupp.single n (sourceLargeFirst x n : ℂ)) =
        ∑ p ∈ T, Finsupp.single (∏ i, p i) (if C p then (1 : ℂ) else 0) := by
  filter_upwards [sourceLargeFirst_eventually_compact_central,
    eventually_gt_atTop (1 : ℝ)] with x hx hx1
  intro P T C
  let I := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
  let D (p : Fin 2 → ℕ) : Prop := x ^ ((40481 : ℝ) / 100000) ≤ (p 0 : ℝ) ∧
    (p 0 : ℝ) < Real.sqrt (3 * x) ∧ p 0 ≤ p 1
  have hband (p : Fin 2 → ℕ) :
      (∏ i, p i) ∈ I ↔ x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x := by
    simp only [I, Finset.mem_Icc, Nat.ceil_le, Nat.le_floor_iff (by linarith : 0 ≤ 2 * x)]
  have hpoint (n : ℕ) (hn : n ∈ I) :
      (sourceLargeFirst x n : ℂ) =
        ∑ p ∈ T, if (∏ i, p i) = n ∧ D p then (1 : ℂ) else 0 := by
    have hlo := Nat.ceil_le.mp (Finset.mem_Icc.mp hn).1
    have hhi := (Nat.le_floor_iff (by linarith : 0 ≤ 2 * x)).mp (Finset.mem_Icc.mp hn).2
    have h := congrArg Complex.ofReal ((hx.1) n hlo hhi)
    simpa only [Complex.ofReal_sum, apply_ite, Complex.ofReal_one, Complex.ofReal_zero] using h
  calc
    _ = ∑ n ∈ I, ∑ p ∈ T,
        Finsupp.single n (if (∏ i, p i) = n ∧ D p then (1 : ℂ) else 0) := by
      apply Finset.sum_congr rfl
      intro n hn
      rw [hpoint n hn, Finsupp.single_finsetSum]
    _ = ∑ p ∈ T, ∑ n ∈ I,
        Finsupp.single n (if (∏ i, p i) = n ∧ D p then (1 : ℂ) else 0) := Finset.sum_comm
    _ = _ := by
      apply Finset.sum_congr rfl
      intro p _hp
      by_cases hd : D p
      · by_cases hp : (∏ i, p i) ∈ I
        · have hc : C p := ⟨(hband p).mp hp |>.1, (hband p).mp hp |>.2, hd⟩
          rw [ite_eq_left hc]
          rw [Finset.sum_eq_single_of_mem (∏ i, p i) hp]
          · rw [ite_eq_left ⟨rfl, hd⟩]
          · intro n _hn hne
            rw [ite_eq_right (fun h => hne h.1.symm), Finsupp.single_zero]
        · have hc : ¬ C p := fun h => hp ((hband p).mpr ⟨h.1, h.2.1⟩)
          rw [ite_eq_right hc, Finsupp.single_zero]
          apply Finset.sum_eq_zero
          intro n hn
          have hnot : ¬ ((∏ i, p i) = n ∧ D p) := by
            intro h
            apply hp
            rw [h.1]
            exact hn
          rw [ite_eq_right hnot, Finsupp.single_zero]
      · have hc : ¬ C p := fun h => hd h.2.2
        rw [ite_eq_right hc, Finsupp.single_zero]
        apply Finset.sum_eq_zero
        intro n _hn
        rw [ite_eq_right (fun h => hd h.2), Finsupp.single_zero]

open Classical in
theorem sourceLargeFirst_small_monomial_representation (x : ℝ) (hx : 0 < x) :
    ∃ M : Finset (MinorantSmallMonomialCut 2), M.card ≤ 32 ∧
      (∀ d ∈ M, d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
        d.numerator.card + d.denominator.card ≤ 2 ∧ 0 < d.threshold) ∧
      ∀ p q : Fin 2 → ℕ, (∀ i, 0 < p i) → (∀ i, 0 < q i) →
      (∀ d ∈ M,
        (if d.lower then
          if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
        else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
        (if d.lower then
          if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
        else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
      ((x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x ∧
          x ^ ((40481 : ℝ) / 100000) ≤ (p 0 : ℝ) ∧
          (p 0 : ℝ) < Real.sqrt (3 * x) ∧ p 0 ≤ p 1) ↔
        (x ≤ ((∏ i, q i : ℕ) : ℝ) ∧ ((∏ i, q i : ℕ) : ℝ) ≤ 2 * x ∧
          x ^ ((40481 : ℝ) / 100000) ≤ (q 0 : ℝ) ∧
          (q 0 : ℝ) < Real.sqrt (3 * x) ∧ q 0 ≤ q 1)) := by
  let d : Fin 5 → MinorantSmallMonomialCut 2 :=
    ![⟨Finset.univ, ∅, x, true, false⟩,
      ⟨Finset.univ, ∅, 2 * x, false, false⟩,
      ⟨{0}, ∅, x ^ ((40481 : ℝ) / 100000), true, false⟩,
      ⟨{0}, ∅, Real.sqrt (3 * x), false, true⟩,
      ⟨{0}, {1}, 1, false, false⟩]
  let M := Finset.univ.image d
  have hmem (i : Fin 5) : d i ∈ M := Finset.mem_image.mpr ⟨i, Finset.mem_univ _, rfl⟩
  have hcard : M.card ≤ 32 := by
    calc
      M.card ≤ (Finset.univ : Finset (Fin 5)).card := Finset.card_image_le
      _ ≤ 32 := by norm_num
  refine ⟨M, hcard, ?_, ?_⟩
  · intro e he
    obtain ⟨i, _hi, rfl⟩ := Finset.mem_image.mp he
    fin_cases i <;> norm_num [d, Finset.disjoint_left] <;> positivity
  · intro p q hp hq htest
    have h0 := htest (d 0) (hmem 0)
    have h1 := htest (d 1) (hmem 1)
    have h2 := htest (d 2) (hmem 2)
    have h3 := htest (d 3) (hmem 3)
    have h4 := htest (d 4) (hmem 4)
    change (x ≤ (d 0).value p) ↔ (x ≤ (d 0).value q) at h0
    change ((d 1).value p ≤ 2 * x) ↔ ((d 1).value q ≤ 2 * x) at h1
    change (x ^ ((40481 : ℝ) / 100000) ≤ (d 2).value p) ↔
      (x ^ ((40481 : ℝ) / 100000) ≤ (d 2).value q) at h2
    change ((d 3).value p < Real.sqrt (3 * x)) ↔
      ((d 3).value q < Real.sqrt (3 * x)) at h3
    change ((d 4).value p ≤ 1) ↔ ((d 4).value q ≤ 1) at h4
    have hv0 (r : Fin 2 → ℕ) : (d 0).value r = ((∏ i, r i : ℕ) : ℝ) := by
      simp [d, MinorantSmallMonomialCut.value]
    have hv1 (r : Fin 2 → ℕ) : (d 1).value r = ((∏ i, r i : ℕ) : ℝ) := by
      simp [d, MinorantSmallMonomialCut.value]
    have hv2 (r : Fin 2 → ℕ) : (d 2).value r = (r 0 : ℝ) := by
      change (∏ i ∈ ({0} : Finset (Fin 2)), (r i : ℝ)) /
        (∏ i ∈ (∅ : Finset (Fin 2)), (r i : ℝ)) = (r 0 : ℝ)
      simp only [Finset.prod_singleton, Finset.prod_empty, div_one]
    have hv3 (r : Fin 2 → ℕ) : (d 3).value r = (r 0 : ℝ) := by
      change (∏ i ∈ ({0} : Finset (Fin 2)), (r i : ℝ)) /
        (∏ i ∈ (∅ : Finset (Fin 2)), (r i : ℝ)) = (r 0 : ℝ)
      simp only [Finset.prod_singleton, Finset.prod_empty, div_one]
    have hv4 (r : Fin 2 → ℕ) : (d 4).value r = (r 0 : ℝ) / (r 1 : ℝ) := by
      change (∏ i ∈ ({0} : Finset (Fin 2)), (r i : ℝ)) /
        (∏ i ∈ ({1} : Finset (Fin 2)), (r i : ℝ)) = (r 0 : ℝ) / (r 1 : ℝ)
      simp only [Finset.prod_singleton]
    rw [hv0 p, hv0 q] at h0
    rw [hv1 p, hv1 q] at h1
    rw [hv2 p, hv2 q] at h2
    rw [hv3 p, hv3 q] at h3
    rw [hv4 p, hv4 q, div_le_one (Nat.cast_pos.mpr (hp 1)),
      div_le_one (Nat.cast_pos.mpr (hq 1)), Nat.cast_le, Nat.cast_le] at h4
    exact and_congr h0 (and_congr h1 (and_congr h2 (and_congr h3 h4)))

theorem hbBoundary_original_mesh_smallness (D₀ : ℕ) :
    ∃ X : ℝ, Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x → ∀ D : ℕ, D₀ + 2 ≤ D →
      ∀ N : ℝ, x ^ ((1 : ℝ) / 4) ≤ N →
      let u : ℝ := (Real.log x) ^ (-(D : ℝ))
      0 < u ∧ u ≤ 1 ∧ 1 < 1 + u ∧ 1 + u ≤ 2 ∧ (1 + u) ^ 60 ≤ 2 ∧
        (2 : ℝ) ^ 61 * N * u + 1 ≤ N / (Real.log x) ^ D₀ := by
  let C : ℝ := (2 : ℝ) ^ 61
  have hC : 0 < C := by positivity
  obtain ⟨X₀, hX₀⟩ := Filter.eventually_atTop.mp
    ((isLittleO_log_rpow_rpow_atTop (D₀ : ℝ)
      (by norm_num : (0 : ℝ) < 1 / 4)).const_mul_left (2 : ℝ)).eventuallyLE
  refine ⟨max X₀ (Real.exp (max 1 (2 * C))), ?_, ?_⟩
  · exact (Real.exp_monotone (le_max_left _ _)).trans (le_max_right _ _)
  intro x hx D hD N hNlo u
  let Θ : ℝ := 1 + u
  have hx₀ : X₀ ≤ x := (le_max_left _ _).trans hx
  have hxexp : Real.exp (max 1 (2 * C)) ≤ x := (le_max_right _ _).trans hx
  have hxpos : 0 < x := (Real.exp_pos _).trans_le hxexp
  have hxone : 1 ≤ x := (Real.one_le_exp (zero_le_one.trans (le_max_left _ _))).trans hxexp
  have hloglarge : max 1 (2 * C) ≤ Real.log x := (Real.le_log_iff_exp_le hxpos).mpr hxexp
  let L : ℝ := Real.log x
  have hL1 : 1 ≤ L := (le_max_left _ _).trans hloglarge
  have hLpos : 0 < L := zero_lt_one.trans_le hL1
  have hLlarge : 2 * C ≤ L := (le_max_right _ _).trans hloglarge
  have hN1 : 1 ≤ N := (Real.one_le_rpow hxone (by norm_num : (0 : ℝ) ≤ 1 / 4)).trans hNlo
  have hNpos : 0 < N := zero_lt_one.trans_le hN1
  have hu : 0 < u := Real.rpow_pos_of_pos hLpos _
  have hu1 : u ≤ 1 :=
    Real.rpow_le_one_of_one_le_of_nonpos hL1 (neg_nonpos.mpr (Nat.cast_nonneg D))
  have hΘ : Θ = 1 + u := rfl
  have hΘgt : 1 < Θ := by rw [hΘ]; linarith
  have hΘtwo : Θ ≤ 2 := by rw [hΘ]; linarith
  have hLp : 0 < L ^ D₀ := pow_pos hLpos _
  have hLp1 : 1 ≤ L ^ D₀ := one_le_pow₀ hL1
  have hloghalf : L ^ D₀ ≤ N / 2 := by
    have he := hX₀ x hx₀
    have hnlog : 0 ≤ 2 * (Real.log x) ^ (D₀ : ℝ) := by positivity
    have htwor : 2 * (Real.log x) ^ (D₀ : ℝ) ≤ x ^ ((1 : ℝ) / 4) := by
      simpa only [Real.norm_of_nonneg hnlog,
        Real.norm_of_nonneg (Real.rpow_nonneg hxpos.le _)] using he
    have htwo : 2 * L ^ D₀ ≤ x ^ ((1 : ℝ) / 4) := by
      simpa only [Real.rpow_natCast] using htwor
    linarith
  have huSmall : u ≤ (L ^ (D₀ + 2))⁻¹ := by
    change L ^ (-(D : ℝ)) ≤ (L ^ (D₀ + 2))⁻¹
    have hDreal : ((D₀ + 2 : ℕ) : ℝ) ≤ (D : ℝ) := by exact_mod_cast hD
    calc
      L ^ (-(D : ℝ)) ≤ L ^ (-((D₀ + 2 : ℕ) : ℝ)) :=
        Real.rpow_le_rpow_of_exponent_le hL1 (neg_le_neg hDreal)
      _ = _ := by rw [Real.rpow_neg hLpos.le, Real.rpow_natCast]
  have hCscaled : C * u * L ^ D₀ ≤ (1 / 2 : ℝ) := by
    calc
      C * u * L ^ D₀ ≤ C * (L ^ (D₀ + 2))⁻¹ * L ^ D₀ :=
        mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_left huSmall hC.le) hLp.le
      _ = C / L ^ 2 := by
        rw [pow_add]
        field_simp [hLpos.ne']
      _ ≤ (1 / 2 : ℝ) := by
        apply (div_le_iff₀ (pow_pos hLpos 2)).mpr
        have hsq : 2 * C ≤ L ^ 2 := hLlarge.trans (le_self_pow₀ hL1 (by decide))
        linarith
  have hCu : C * u ≤ (1 / 2 : ℝ) :=
    (le_mul_of_one_le_right (mul_nonneg hC.le hu.le) hLp1).trans hCscaled
  have hwidth := minorantHB_radial_power_sixty_width Θ u hΘ hu.le hu1
  have hpowbound : Θ ^ 60 ≤ 2 := by
    have hC60 : (2 : ℝ) ^ 60 ≤ C := pow_le_pow_right₀ (by norm_num) (by decide)
    have hs := (mul_le_mul_of_nonneg_right hC60 hu.le).trans hCu
    linarith
  have hbound : C * N * u + 1 ≤ N / L ^ D₀ := by
    apply (le_div_iff₀ hLp).mpr
    calc
      (C * N * u + 1) * L ^ D₀ = N * (C * u * L ^ D₀) + L ^ D₀ := by ring
      _ ≤ N * (1 / 2) + N / 2 :=
        add_le_add (mul_le_mul_of_nonneg_left hCscaled hNpos.le) hloghalf
      _ = N := by ring
  exact ⟨hu, hu1, hΘgt, hΘtwo, hpowbound, hbound⟩

theorem minorantHB_original_mesh_carrier_widths (D₀ : ℕ) :
    ∃ X : ℝ, Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x → ∀ D : ℕ, D₀ + 2 ≤ D →
      ∀ N : ℝ, x ^ ((1 : ℝ) / 4) ≤ N → N ≤ x ^ ((41 : ℝ) / 100) →
      ∀ A B : ℝ, N ≤ A → A ≤ B → B ≤ 2 * N →
      let Θ : ℝ := 1 + (Real.log x) ^ (-(D : ℝ))
      1 < Θ ∧ Θ ≤ 2 ∧ Θ ^ 60 ≤ 2 ∧ B ≤ (x ^ ((9 : ℝ) / 100)) ^ (5 : ℕ) ∧
      (1 ≤ ⌈A / Θ ^ 60⌉₊ ∧ ⌈A / Θ ^ 60⌉₊ ≤ ⌊A⌋₊ + 1 ∧
        ⌊A⌋₊ + 1 ≤ ⌈8 * N⌉₊ + 1 ∧
        ((⌊A⌋₊ + 1 - ⌈A / Θ ^ 60⌉₊ : ℕ) : ℝ) ≤ N / (Real.log x) ^ D₀) ∧
      (1 ≤ ⌈B⌉₊ ∧ ⌈B⌉₊ ≤ ⌊B * Θ ^ 60⌋₊ + 1 ∧
        ⌊B * Θ ^ 60⌋₊ + 1 ≤ ⌈8 * N⌉₊ + 1 ∧
        ((⌊B * Θ ^ 60⌋₊ + 1 - ⌈B⌉₊ : ℕ) : ℝ) ≤ N / (Real.log x) ^ D₀) := by
  obtain ⟨X₀, hX₀, hsmall⟩ := hbBoundary_original_mesh_smallness D₀
  obtain ⟨X₁, hX₁⟩ := Filter.eventually_atTop.mp
    ((tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 25)).eventually_ge_atTop (2 : ℝ))
  refine ⟨max X₀ X₁, hX₀.trans (le_max_left _ _), ?_⟩
  intro x hx D hD N hNlo hNhi A B hNA hAB hBN Θ
  have hx₀ : X₀ ≤ x := (le_max_left _ _).trans hx
  have hx₁ : X₁ ≤ x := (le_max_right _ _).trans hx
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le (hX₀.trans hx₀)
  have hNpos : 0 < N := (Real.rpow_pos_of_pos hxpos _).trans_le hNlo
  have hApos : 0 < A := hNpos.trans_le hNA
  have hBpos : 0 < B := hApos.trans_le hAB
  let C : ℝ := (2 : ℝ) ^ 61
  let u : ℝ := (Real.log x) ^ (-(D : ℝ))
  have hΘ : Θ = 1 + u := rfl
  obtain ⟨hu, hu1, hΘgt, hΘtwo, hpowbound, hbound⟩ := hsmall x hx₀ D hD N hNlo
  have hwidth := minorantHB_radial_power_sixty_width Θ u hΘ hu.le hu1
  have hpowpos : 0 < Θ ^ 60 := pow_pos (zero_lt_one.trans hΘgt) _
  have hpowone : 1 ≤ Θ ^ 60 := one_le_pow₀ hΘgt.le
  have hloLe : A / Θ ^ 60 ≤ A := div_le_self hApos.le hpowone
  have hhiLe : B ≤ B * Θ ^ 60 := le_mul_of_one_le_right hBpos.le hpowone
  have hAupper : A ≤ 8 * N := by linarith
  have hBupper : B * Θ ^ 60 ≤ 8 * N := by
    calc
      B * Θ ^ 60 ≤ (2 * N) * 2 :=
        mul_le_mul hBN hpowbound hpowpos.le (mul_nonneg zero_le_two hNpos.le)
      _ ≤ 8 * N := by nlinarith only [hNpos]
  have hlowWidth : A - A / Θ ^ 60 ≤ C * N * u := by
    calc
      A - A / Θ ^ 60 = A * (Θ ^ 60 - 1) / Θ ^ 60 := by
        rw [mul_sub, mul_one, sub_div, mul_div_cancel_right₀ _ hpowpos.ne']
      _ ≤ A * (Θ ^ 60 - 1) := div_le_self (mul_nonneg hApos.le hwidth.1) hpowone
      _ ≤ (2 * N) * ((2 : ℝ) ^ 60 * u) :=
        mul_le_mul (hAB.trans hBN) hwidth.2 hwidth.1 (by positivity)
      _ = C * N * u := by dsimp only [C]; rw [pow_succ]; ring
  have hhighWidth : B * Θ ^ 60 - B ≤ C * N * u := by
    calc
      B * Θ ^ 60 - B = B * (Θ ^ 60 - 1) := by ring
      _ ≤ (2 * N) * ((2 : ℝ) ^ 60 * u) :=
        mul_le_mul hBN hwidth.2 hwidth.1 (by positivity)
      _ = C * N * u := by dsimp only [C]; rw [pow_succ]; ring
  have hBU : B ≤ (x ^ ((9 : ℝ) / 100)) ^ (5 : ℕ) := by
    have hsmall := hX₁ x hx₁
    have hmul : x ^ ((1 : ℝ) / 25) * x ^ ((41 : ℝ) / 100) =
        (x ^ ((9 : ℝ) / 100)) ^ (5 : ℕ) := by
      rw [← Real.rpow_add hxpos, ← Real.rpow_mul_natCast hxpos.le]
      congr 1
      norm_num
    calc
      B ≤ 2 * N := hBN
      _ ≤ x ^ ((1 : ℝ) / 25) * x ^ ((41 : ℝ) / 100) :=
        mul_le_mul hsmall hNhi hNpos.le (Real.rpow_nonneg hxpos.le _)
      _ = _ := hmul
  have hlo := minorantHB_closed_interval_carrier_width
    (A / Θ ^ 60) A (by positivity) hloLe
  have hhi := minorantHB_closed_interval_carrier_width B (B * Θ ^ 60) hBpos.le hhiLe
  refine ⟨hΘgt, hΘtwo, hpowbound, hBU, ?_, ?_⟩
  · exact ⟨Nat.ceil_pos.mpr (by positivity),
      (Nat.ceil_mono hloLe).trans (Nat.ceil_le_floor_add_one _),
      Nat.add_le_add_right ((Nat.floor_mono hAupper).trans (Nat.floor_le_ceil _)) 1,
      hlo.2.trans ((add_le_add hlowWidth le_rfl).trans hbound)⟩
  · exact ⟨Nat.ceil_pos.mpr hBpos,
      (Nat.ceil_mono hhiLe).trans (Nat.ceil_le_floor_add_one _),
      Nat.add_le_add_right ((Nat.floor_mono hBupper).trans (Nat.floor_le_ceil _)) 1,
      hhi.2.trans ((add_le_add hhighWidth le_rfl).trans hbound)⟩

open Classical in
theorem finite_product_sample_filter {ι : Type*} [Fintype ι] [DecidableEq ι]
    (S : ι → Finset ℕ) (w : ι → ℕ → ℂ) (R : ℕ → Prop) :
    ((∏ i, (MonoidAlgebra.ofCoeff (∑ n ∈ S i, Finsupp.single n (w i n)) :
      MonoidAlgebra ℂ ℕ)).coeff).filter R =
      ∑ p ∈ (Fintype.piFinset S).filter (fun p => R (∏ i, p i)),
        Finsupp.single (∏ i, p i) (∏ i, w i (p i)) := by
  simp only [MonoidAlgebra.ofCoeff_sum, MonoidAlgebra.ofCoeff_single]
  rw [Finset.prod_univ_sum]
  simp only [MonoidAlgebra.prod_single, MonoidAlgebra.coeff_sum,
    MonoidAlgebra.coeff_single, Finsupp.filter_sum, Finset.sum_filter]
  apply Finset.sum_congr rfl
  intro p _hp
  by_cases h : R (∏ i, p i) <;> simp [h]

open Classical in
theorem three_closed_prime_box_eq_tuple_sum
    (A B : Fin 3 → ℝ) (R : ℕ → Prop) :
    (primeIntervalBoxAlgebra A B Finset.univ).coeff.filter R =
      ∑ p ∈ (Fintype.piFinset (fun i : Fin 3 => Finset.Icc ⌈A i⌉₊ ⌊B i⌋₊)).filter
        (fun p => R (∏ i, p i)),
        Finsupp.single (∏ i, p i)
          ((∏ i, if (p i).Prime then (1 : ℝ) else 0) • (1 : ℂ)) := by
  have hprime : primeIntervalBoxAlgebra A B Finset.univ =
      ∏ i : Fin 3, (MonoidAlgebra.ofCoeff
        (∑ n ∈ Finset.Icc ⌈A i⌉₊ ⌊B i⌋₊,
          Finsupp.single n ((if n.Prime then (1 : ℝ) else 0) • (1 : ℂ))) :
          MonoidAlgebra ℂ ℕ) := by
    simp only [primeIntervalBoxAlgebra, MonoidAlgebra.ofCoeff_sum,
      MonoidAlgebra.ofCoeff_single, Finset.sum_filter]
    apply Finset.prod_congr rfl
    intro i _hi
    apply Finset.sum_congr rfl
    intro n _hn
    by_cases hn : n.Prime <;> simp [hn]
  rw [hprime, finite_product_sample_filter]
  apply Finset.sum_congr rfl
  intro p _hp
  congr 1
  simp only [Complex.real_smul, mul_one, Complex.ofReal_prod]

theorem sourceCentralPair_eventually_residual_bounds :
    ∃ X : ℝ, 3 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      ∀ n p q m : ℕ, p.Prime → q.Prime → p * (q * m) = n →
      x ≤ (n : ℝ) → (n : ℝ) ≤ 2 * x →
      (9519 : ℝ) / 50000 ≤ Real.logb x (q : ℝ) →
      Real.logb x (q : ℝ) < Real.logb x (p : ℝ) →
      Real.logb x (p : ℝ) < (40481 : ℝ) / 100000 →
      (40481 : ℝ) / 100000 ≤ Real.logb x (p : ℝ) + Real.logb x (q : ℝ) →
      Real.logb x (p : ℝ) + Real.logb x (q : ℝ) ≤ (59519 : ℝ) / 100000 →
        q ≤ m ∧ (m : ℝ) < (q : ℝ) ^ (4 : ℕ) ∧
        x ^ ((40481 : ℝ) / 100000) ≤ (p : ℝ) * q ∧
        (p : ℝ) * q ≤ x ^ ((59519 : ℝ) / 100000) ∧
        x ^ ((9519 : ℝ) / 50000) ≤ (q : ℝ) ∧ q < p ∧
        (p : ℝ) < x ^ ((40481 : ℝ) / 100000) := by
  have hlarge : ∀ᶠ x : ℝ in atTop,
      2 < x ^ (4 * ((9519 : ℝ) / 50000) - (59519 : ℝ) / 100000) :=
    (tendsto_rpow_atTop (by norm_num :
      (0 : ℝ) < 4 * ((9519 : ℝ) / 50000) - (59519 : ℝ) / 100000)).eventually_gt_atTop 2
  obtain ⟨X, hX⟩ := hlarge.exists_forall_of_atTop
  refine ⟨max 3 X, le_max_left _ _, ?_⟩
  intro x hx n p q m hp hq hprod hxn hnx hqlo hqp hpa hsumlo hsumhi
  have hx3 : 3 ≤ x := (le_max_left _ _).trans hx
  have hx1 : 1 < x := by linarith
  have hx0 : 0 < x := zero_lt_one.trans hx1
  have hp0 : 0 < (p : ℝ) := Nat.cast_pos.mpr hp.pos
  have hq0 : 0 < (q : ℝ) := Nat.cast_pos.mpr hq.pos
  have hprodR : (p : ℝ) * q * m = n := by
    exact_mod_cast (mul_assoc p q m).trans hprod
  have hpairlo : x ^ ((40481 : ℝ) / 100000) ≤ (p : ℝ) * q :=
    (Real.le_logb_iff_rpow_le hx1 (mul_pos hp0 hq0)).mp (by
      rw [Real.logb_mul hp0.ne' hq0.ne']
      exact hsumlo)
  have hpairhi : (p : ℝ) * q ≤ x ^ ((59519 : ℝ) / 100000) :=
    (Real.logb_le_iff_le_rpow hx1 (mul_pos hp0 hq0)).mp (by
      rw [Real.logb_mul hp0.ne' hq0.ne']
      exact hsumhi)
  have hqpow : x ^ ((9519 : ℝ) / 50000) ≤ (q : ℝ) :=
    (Real.le_logb_iff_rpow_le hx1 hq0).mp hqlo
  have hqpR : (q : ℝ) < p := (Real.logb_lt_logb_iff hx1 hq0 hp0).mp hqp
  have hppow : (p : ℝ) < x ^ ((40481 : ℝ) / 100000) :=
    (Real.logb_lt_iff_lt_rpow hx1 hp0).mp hpa
  have hunit : x ^ ((59519 : ℝ) / 100000) * x ^ ((40481 : ℝ) / 100000) = x := by
    rw [← Real.rpow_add hx0]
    norm_num
  have hmlower : x ^ ((40481 : ℝ) / 100000) ≤ (m : ℝ) := by
    apply (mul_le_mul_iff_right₀ (Real.rpow_pos_of_pos hx0 ((59519 : ℝ) / 100000))).mp
    calc
      x ^ ((59519 : ℝ) / 100000) * x ^ ((40481 : ℝ) / 100000) = x := hunit
      _ ≤ (n : ℝ) := hxn
      _ = (p : ℝ) * q * m := hprodR.symm
      _ ≤ x ^ ((59519 : ℝ) / 100000) * m :=
        mul_le_mul_of_nonneg_right hpairhi (Nat.cast_nonneg m)
  have hmupper : (m : ℝ) ≤ 2 * x ^ ((59519 : ℝ) / 100000) := by
    apply (mul_le_mul_iff_right₀ (Real.rpow_pos_of_pos hx0 ((40481 : ℝ) / 100000))).mp
    calc
      x ^ ((40481 : ℝ) / 100000) * m ≤ (p : ℝ) * q * m :=
        mul_le_mul_of_nonneg_right hpairlo (Nat.cast_nonneg m)
      _ = (n : ℝ) := hprodR
      _ ≤ 2 * x := hnx
      _ = x ^ ((40481 : ℝ) / 100000) * (2 * x ^ ((59519 : ℝ) / 100000)) := by
        calc
          2 * x = 2 * (x ^ ((59519 : ℝ) / 100000) *
              x ^ ((40481 : ℝ) / 100000)) := congrArg (fun z : ℝ => 2 * z) hunit.symm
          _ = _ := by ring
  have hfour : 2 * x ^ ((59519 : ℝ) / 100000) <
      x ^ (4 * ((9519 : ℝ) / 50000)) := by
    calc
      _ < x ^ (4 * ((9519 : ℝ) / 50000) - (59519 : ℝ) / 100000) *
          x ^ ((59519 : ℝ) / 100000) :=
        mul_lt_mul_of_pos_right (hX x ((le_max_right _ _).trans hx))
          (Real.rpow_pos_of_pos hx0 _)
      _ = _ := by
        rw [← Real.rpow_add hx0]
        congr 1
        ring
  have hqfour : x ^ (4 * ((9519 : ℝ) / 50000)) ≤ (q : ℝ) ^ (4 : ℕ) := by
    calc
      _ = (x ^ ((9519 : ℝ) / 50000)) ^ (4 : ℕ) := by
        rw [← Real.rpow_mul_natCast hx0.le]
        congr 1
        norm_num
      _ ≤ (q : ℝ) ^ (4 : ℕ) :=
        pow_le_pow_left₀ (Real.rpow_nonneg hx0.le _) hqpow 4
  exact ⟨Nat.cast_le.mp ((hqpR.trans hppow).le.trans hmlower),
    hmupper.trans_lt (hfour.trans_le hqfour), hpairlo, hpairhi, hqpow,
    Nat.cast_lt.mp hqpR, hppow⟩

open Classical in
theorem sourceCentralPair_eventually_eq_expanded_antidiagonal :
    ∃ X : ℝ, 3 ≤ X ∧ ∀ x : ℝ, X ≤ x → ∀ n : ℕ,
      x ≤ (n : ℝ) → (n : ℝ) ≤ 2 * x →
      let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
      let C (p q : ℕ) : Prop :=
        (9519 : ℝ) / 50000 ≤ α q ∧ α q < α p ∧
        α p < (40481 : ℝ) / 100000 ∧
        (40481 : ℝ) / 100000 ≤ α p + α q ∧ α p + α q ≤ (59519 : ℝ) / 100000
      sourceCentralPair x n =
        ∑ d ∈ n.divisorsAntidiagonal, ∑ e ∈ d.2.divisorsAntidiagonal,
          if d.1.Prime ∧ e.1.Prime ∧ C d.1 e.1 then
            (if e.2.Prime ∧ e.1 ≤ e.2 then (1 : ℝ) else 0) +
            (∑ f ∈ e.2.divisorsAntidiagonal,
              if f.1.Prime ∧ f.2.Prime ∧ e.1 ≤ f.1 ∧ f.1 ≤ f.2 then 1 else 0) +
            (∑ f ∈ e.2.divisorsAntidiagonal, ∑ g ∈ f.2.divisorsAntidiagonal,
              if f.1.Prime ∧ g.1.Prime ∧ g.2.Prime ∧
                e.1 ≤ f.1 ∧ f.1 ≤ g.1 ∧ g.1 ≤ g.2 then 1 else 0)
          else 0 := by
  obtain ⟨X, hX, hresidual⟩ := sourceCentralPair_eventually_residual_bounds
  refine ⟨X, hX, ?_⟩
  intro x hx n hxn hnx α C
  change (∑ d ∈ n.divisorsAntidiagonal, ∑ e ∈ d.2.divisorsAntidiagonal,
    if d.1.Prime ∧ e.1.Prime ∧ C d.1 e.1 then roughWeight (e.1 : ℝ) e.2 else 0) = _
  apply Finset.sum_congr rfl
  intro d hd
  apply Finset.sum_congr rfl
  intro e he
  by_cases hc : d.1.Prime ∧ e.1.Prime ∧ C d.1 e.1
  · rw [ite_eq_left hc, ite_eq_left hc]
    obtain ⟨hp, hq, hqlo, hqp, hpa, hsumlo, hsumhi⟩ := hc
    have hprod : d.1 * (e.1 * e.2) = n := by
      rw [(Nat.mem_divisorsAntidiagonal.mp he).1]
      exact (Nat.mem_divisorsAntidiagonal.mp hd).1
    obtain ⟨hqm, hmfour, _⟩ :=
      hresidual x hx n d.1 e.1 e.2 hp hq hprod hxn hnx hqlo hqp hpa hsumlo hsumhi
    have hqone : (1 : ℝ) < e.1 := by exact_mod_cast hq.one_lt
    simpa only [Nat.cast_le, and_iff_left hqm] using
      roughWeight_eq_prime_add_ordered_two_three (e.1 : ℝ) e.2 hqone
        (Nat.cast_le.mpr hqm) hmfour
  · rw [ite_eq_right hc, ite_eq_right hc]

theorem prime_tuple_eventually_mem_common_power_band
    (k : ℕ) (β : ℝ)
    (hgap : 1 < (k : ℝ) * ((9519 : ℝ) / 50000) + β) :
    ∃ X : ℝ, 3 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      ∀ p : Fin (k + 1) → ℕ, (∀ i, (p i).Prime) →
      (∀ i, x ^ ((9519 : ℝ) / 50000) ≤ (p i : ℝ)) →
      ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x →
      ∀ i, p i ∈ (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊ ⌊x ^ β⌋₊).filter Nat.Prime := by
  classical
  let γ : ℝ := (k : ℝ) * ((9519 : ℝ) / 50000) + β - 1
  have hγ : 0 < γ := sub_pos.mpr hgap
  obtain ⟨X, hX⟩ :=
    ((tendsto_rpow_atTop hγ).eventually_ge_atTop (2 : ℝ)).exists_forall_of_atTop
  refine ⟨max 3 X, le_max_left _ _, ?_⟩
  intro x hx p hp hlo hprod i
  have hx3 : 3 ≤ x := (le_max_left _ _).trans hx
  have hx0 : 0 < x := by linarith
  have hrest : (x ^ ((9519 : ℝ) / 50000)) ^ k ≤
      ∏ j : Fin k, (p (i.succAbove j) : ℝ) := by
    simpa only [Finset.prod_const, Finset.card_univ, Fintype.card_fin] using
      Finset.prod_le_prod (s := (Finset.univ : Finset (Fin k)))
        (fun _ _ => Real.rpow_nonneg hx0.le ((9519 : ℝ) / 50000))
        (fun j _ => hlo (i.succAbove j))
  have hpower : (x ^ ((9519 : ℝ) / 50000)) ^ k * x ^ β = x ^ γ * x := by
    calc
      _ = x ^ (((9519 : ℝ) / 50000) * (k : ℝ) + β) := by
        rw [← Real.rpow_mul_natCast hx0.le, ← Real.rpow_add hx0]
      _ = x ^ (γ + 1) := by congr 1; dsimp only [γ]; ring
      _ = x ^ γ * x := by rw [Real.rpow_add hx0, Real.rpow_one]
  have hupper : (p i : ℝ) ≤ x ^ β := by
    apply (mul_le_mul_iff_right₀ (pow_pos
      (Real.rpow_pos_of_pos hx0 ((9519 : ℝ) / 50000)) k)).mp
    calc
      (x ^ ((9519 : ℝ) / 50000)) ^ k * (p i : ℝ) ≤
          (∏ j : Fin k, (p (i.succAbove j) : ℝ)) * p i :=
        mul_le_mul_of_nonneg_right hrest (Nat.cast_nonneg _)
      _ = ∏ j : Fin (k + 1), (p j : ℝ) := by
        rw [Fin.prod_univ_succAbove (fun j => (p j : ℝ)) i]
        ring
      _ ≤ 2 * x := by simpa only [Nat.cast_prod] using hprod
      _ ≤ x ^ γ * x := mul_le_mul_of_nonneg_right
        (hX x ((le_max_right _ _).trans hx)) hx0.le
      _ = (x ^ ((9519 : ℝ) / 50000)) ^ k * x ^ β := hpower.symm
  exact Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr
    ⟨Nat.ceil_le.mpr (hlo i), Nat.le_floor hupper⟩, hp i⟩

open Classical in
theorem sourceCentralPair_eventually_finsupp :
    ∃ X : ℝ, 3 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
      let C (p q : ℕ) : Prop :=
        (9519 : ℝ) / 50000 ≤ α q ∧ α q < α p ∧
        α p < (40481 : ℝ) / 100000 ∧
        (40481 : ℝ) / 100000 ≤ α p + α q ∧ α p + α q ≤ (59519 : ℝ) / 100000
      let Ps := (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((9 : ℝ) / 10)⌋₊).filter Nat.Prime
      let Pf := (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((6 : ℝ) / 25)⌋₊).filter Nat.Prime
      (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        Finsupp.single n (sourceCentralPair x n : ℂ)) =
      (∑ p ∈ Fintype.piFinset (fun _ : Fin 3 => Ps),
        Finsupp.single (∏ i, p i)
          (if x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x ∧
            C (p 0) (p 1) ∧ p 1 ≤ p 2 then (1 : ℂ) else 0)) +
      (∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => Ps),
        Finsupp.single (∏ i, p i)
          (if x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x ∧
            C (p 0) (p 1) ∧ p 1 ≤ p 2 ∧ p 2 ≤ p 3 then (1 : ℂ) else 0)) +
      (∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Pf),
        Finsupp.single (∏ i, p i)
          (if x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x ∧
            C (p 0) (p 1) ∧ p 1 ≤ p 2 ∧ p 2 ≤ p 3 ∧ p 3 ≤ p 4 then (1 : ℂ) else 0)) := by
  obtain ⟨Xr, hXr, hsource⟩ := sourceCentralPair_eventually_eq_expanded_antidiagonal
  obtain ⟨X3, _hX3, hc3⟩ :=
    prime_tuple_eventually_mem_common_power_band 2 (9 / 10) (by norm_num)
  obtain ⟨X4, _hX4, hc4⟩ :=
    prime_tuple_eventually_mem_common_power_band 3 (9 / 10) (by norm_num)
  obtain ⟨X5, _hX5, hc5⟩ :=
    prime_tuple_eventually_mem_common_power_band 4 (6 / 25) (by norm_num)
  refine ⟨max (max Xr X3) (max X4 X5),
    hXr.trans ((le_max_left _ _).trans (le_max_left _ _)), ?_⟩
  intro x hx α C Ps Pf
  have hxr : Xr ≤ x := ((le_max_left _ _).trans (le_max_left _ _)).trans hx
  have hx3 : X3 ≤ x := ((le_max_right _ _).trans (le_max_left _ _)).trans hx
  have hx4 : X4 ≤ x := ((le_max_left _ _).trans (le_max_right _ _)).trans hx
  have hx5 : X5 ≤ x := ((le_max_right _ _).trans (le_max_right _ _)).trans hx
  have hx1 : 1 < x := (by norm_num : (1 : ℝ) < 3).trans_le (hXr.trans hxr)
  have hx2 : 0 ≤ 2 * x := by linarith
  let N : Finset ℕ := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
  let w3 (p : Fin 3 → ℕ) : ℝ := if C (p 0) (p 1) ∧ p 1 ≤ p 2 then 1 else 0
  let w4 (p : Fin 4 → ℕ) : ℝ :=
    if C (p 0) (p 1) ∧ p 1 ≤ p 2 ∧ p 2 ≤ p 3 then 1 else 0
  let w5 (p : Fin 5 → ℕ) : ℝ :=
    if C (p 0) (p 1) ∧ p 1 ≤ p 2 ∧ p 2 ≤ p 3 ∧ p 3 ≤ p 4 then 1 else 0
  let f3 : ℕ →₀ ℂ := ∑ n ∈ N, Finsupp.single n
    (∑ p ∈ Fintype.piFinset (fun _ : Fin 3 => Nat.primesLE n),
      if (∏ i, p i) = n then (w3 p : ℂ) else 0)
  let f4 : ℕ →₀ ℂ := ∑ n ∈ N, Finsupp.single n
    (∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => Nat.primesLE n),
      if (∏ i, p i) = n then (w4 p : ℂ) else 0)
  let f5 : ℕ →₀ ℂ := ∑ n ∈ N, Finsupp.single n
    (∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
      if (∏ i, p i) = n then (w5 p : ℂ) else 0)
  have hpi {n : ℕ} (t : Fin n → Finset ℕ) (dec : DecidableEq (Fin n)) :
      @Fintype.piFinset (Fin n) dec _ (fun _ => ℕ) t =
        @Fintype.piFinset (Fin n) (Classical.typeDecidableEq _) _ (fun _ => ℕ) t := by
    ext r
    simp only [Fintype.mem_piFinset]
  have hite {V : Type} (p : Prop) (dec : Decidable p) (z w : V) :
      @ite V p dec z w = @ite V p (Classical.propDecidable p) z w :=
    @ite_cond_congr V p p dec (Classical.propDecidable p) z w rfl
  have handite {V : Type} (p q : Prop) (dec : Decidable (p ∧ q)) (z w : V) :
      @ite V (p ∧ q) dec z w = if p then (if q then z else w) else w := by
    by_cases hp : p <;> by_cases hq : q <;> simp [hp, hq]
  have hpoint (n : ℕ) (hn : n ∈ N) :
      (sourceCentralPair x n : ℂ) =
      (∑ p ∈ Fintype.piFinset (fun _ : Fin 3 => Nat.primesLE n),
        if (∏ i, p i) = n then (w3 p : ℂ) else 0) +
      (∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => Nat.primesLE n),
        if (∏ i, p i) = n then (w4 p : ℂ) else 0) +
      (∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Nat.primesLE n),
        if (∏ i, p i) = n then (w5 p : ℂ) else 0) := by
    have hnlo : x ≤ (n : ℝ) := Nat.ceil_le.mp (Finset.mem_Icc.mp hn).1
    have hnhi : (n : ℝ) ≤ 2 * x :=
      (Nat.le_floor_iff hx2).mp (Finset.mem_Icc.mp hn).2
    have hsrc := hsource x hxr n hnlo hnhi
    have hreindex := centralPair_expanded_antidiagonal_eq_prime_tuples n C
    simp only [hite] at hsrc hreindex
    have hreal := hsrc.trans hreindex
    have hcast := congrArg Complex.ofReal hreal
    simpa only [Complex.ofReal_add, Complex.ofReal_sum, apply_ite Complex.ofReal,
      Complex.ofReal_zero, Complex.ofReal_one, w3, w4, w5, handite, hpi, hite] using hcast
  have hsplit : (∑ n ∈ N, Finsupp.single n (sourceCentralPair x n : ℂ)) =
      f3 + f4 + f5 := by
    dsimp only [f3, f4, f5]
    rw [← Finset.sum_add_distrib, ← Finset.sum_add_distrib]
    simp_rw [← Finsupp.single_add]
    apply Finset.sum_congr rfl
    intro n hn
    rw [hpoint n hn]
  have hcompact3 (p : Fin 3 → ℕ) (hp : ∀ i, (p i).Prime)
      (hprod : (∏ i, p i) ∈ N) (hne : (w3 p : ℂ) ≠ 0) : ∀ i, p i ∈ Ps := by
    have hw : C (p 0) (p 1) ∧ p 1 ≤ p 2 :=
      (ite_ne_right_iff.mp (Complex.ofReal_ne_zero.mp hne)).1
    have hqpow : x ^ ((9519 : ℝ) / 50000) ≤ (p 1 : ℝ) :=
      (Real.le_logb_iff_rpow_le hx1 (Nat.cast_pos.mpr (hp 1).pos)).mp hw.1.1
    have hppow : x ^ ((9519 : ℝ) / 50000) ≤ (p 0 : ℝ) :=
      hqpow.trans ((Real.logb_lt_logb_iff hx1
        (Nat.cast_pos.mpr (hp 1).pos) (Nat.cast_pos.mpr (hp 0).pos)).mp hw.1.2.1).le
    have hlo : ∀ i : Fin 3, x ^ ((9519 : ℝ) / 50000) ≤ (p i : ℝ) := by
      intro i
      fin_cases i
      · exact hppow
      · exact hqpow
      · exact hqpow.trans (Nat.cast_le.mpr hw.2)
    exact hc3 x hx3 p hp hlo
      ((Nat.le_floor_iff hx2).mp (Finset.mem_Icc.mp hprod).2)
  have hf3 : f3 =
      ∑ p ∈ Fintype.piFinset (fun _ : Fin 3 => Ps),
        Finsupp.single (∏ i, p i)
          (if (∏ i, p i) ∈ N then (w3 p : ℂ) else 0) :=
    prime_tuple_closed_sample_eq_compact 3 ⌈x⌉₊ ⌊2 * x⌋₊ Ps
      (fun _ hp => (Finset.mem_filter.mp hp).2) (fun p => (w3 p : ℂ)) hcompact3
  have hcompact4 (p : Fin 4 → ℕ) (hp : ∀ i, (p i).Prime)
      (hprod : (∏ i, p i) ∈ N) (hne : (w4 p : ℂ) ≠ 0) : ∀ i, p i ∈ Ps := by
    have hw : C (p 0) (p 1) ∧ p 1 ≤ p 2 ∧ p 2 ≤ p 3 :=
      (ite_ne_right_iff.mp (Complex.ofReal_ne_zero.mp hne)).1
    have hqpow : x ^ ((9519 : ℝ) / 50000) ≤ (p 1 : ℝ) :=
      (Real.le_logb_iff_rpow_le hx1 (Nat.cast_pos.mpr (hp 1).pos)).mp hw.1.1
    have hppow : x ^ ((9519 : ℝ) / 50000) ≤ (p 0 : ℝ) :=
      hqpow.trans ((Real.logb_lt_logb_iff hx1
        (Nat.cast_pos.mpr (hp 1).pos) (Nat.cast_pos.mpr (hp 0).pos)).mp hw.1.2.1).le
    have hlo : ∀ i : Fin 4, x ^ ((9519 : ℝ) / 50000) ≤ (p i : ℝ) := by
      intro i
      fin_cases i
      · exact hppow
      · exact hqpow
      · exact hqpow.trans (Nat.cast_le.mpr hw.2.1)
      · exact hqpow.trans (Nat.cast_le.mpr (hw.2.1.trans hw.2.2))
    exact hc4 x hx4 p hp hlo
      ((Nat.le_floor_iff hx2).mp (Finset.mem_Icc.mp hprod).2)
  have hf4 : f4 =
      ∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => Ps),
        Finsupp.single (∏ i, p i)
          (if (∏ i, p i) ∈ N then (w4 p : ℂ) else 0) :=
    prime_tuple_closed_sample_eq_compact 4 ⌈x⌉₊ ⌊2 * x⌋₊ Ps
      (fun _ hp => (Finset.mem_filter.mp hp).2) (fun p => (w4 p : ℂ)) hcompact4
  have hcompact5 (p : Fin 5 → ℕ) (hp : ∀ i, (p i).Prime)
      (hprod : (∏ i, p i) ∈ N) (hne : (w5 p : ℂ) ≠ 0) : ∀ i, p i ∈ Pf := by
    have hw : C (p 0) (p 1) ∧ p 1 ≤ p 2 ∧ p 2 ≤ p 3 ∧ p 3 ≤ p 4 :=
      (ite_ne_right_iff.mp (Complex.ofReal_ne_zero.mp hne)).1
    have hqpow : x ^ ((9519 : ℝ) / 50000) ≤ (p 1 : ℝ) :=
      (Real.le_logb_iff_rpow_le hx1 (Nat.cast_pos.mpr (hp 1).pos)).mp hw.1.1
    have hppow : x ^ ((9519 : ℝ) / 50000) ≤ (p 0 : ℝ) :=
      hqpow.trans ((Real.logb_lt_logb_iff hx1
        (Nat.cast_pos.mpr (hp 1).pos) (Nat.cast_pos.mpr (hp 0).pos)).mp hw.1.2.1).le
    have hlo : ∀ i : Fin 5, x ^ ((9519 : ℝ) / 50000) ≤ (p i : ℝ) := by
      intro i
      fin_cases i
      · exact hppow
      · exact hqpow
      · exact hqpow.trans (Nat.cast_le.mpr hw.2.1)
      · exact hqpow.trans (Nat.cast_le.mpr (hw.2.1.trans hw.2.2.1))
      · exact hqpow.trans (Nat.cast_le.mpr (hw.2.1.trans (hw.2.2.1.trans hw.2.2.2)))
    exact hc5 x hx5 p hp hlo
      ((Nat.le_floor_iff hx2).mp (Finset.mem_Icc.mp hprod).2)
  have hf5 : f5 =
      ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => Pf),
        Finsupp.single (∏ i, p i)
          (if (∏ i, p i) ∈ N then (w5 p : ℂ) else 0) :=
    prime_tuple_closed_sample_eq_compact 5 ⌈x⌉₊ ⌊2 * x⌋₊ Pf
      (fun _ hp => (Finset.mem_filter.mp hp).2) (fun p => (w5 p : ℂ)) hcompact5
  change (∑ n ∈ N, Finsupp.single n (sourceCentralPair x n : ℂ)) = _
  rw [hsplit, hf3, hf4, hf5]
  simp only [N, w3, w4, w5, Finset.mem_Icc, Nat.ceil_le,
    Nat.le_floor_iff hx2, apply_ite Complex.ofReal, Complex.ofReal_one,
    Complex.ofReal_zero, ite_and]

theorem central_typeII_parameter_retreat (j : ℕ) («ω» δ σ : ℝ)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1)) :
    ∃ r : ℝ, 0 < r ∧
      ((j = 1 ∧ 54 * («ω» + r) + 15 * (δ + r) + 5 * σ < 1 ∧
          68 * («ω» + r) + 14 * (δ + r) < 1) ∨
        (j = 2 ∧ 56 * («ω» + r) + 16 * (δ + r) + 4 * σ < 1 ∧
          68 * («ω» + r) + 14 * (δ + r) < 1) ∨
        (j = 3 ∧ 72 * («ω» + r) + 24 * (δ + r) < 1 ∧
          48 * («ω» + r) + 16 * (δ + r) + 4 * σ < 1 ∧
          64 * («ω» + r) + 20 * (δ + r) + 2 * σ < 1)) := by
  rcases hsource with ⟨hj, h₁, h₂⟩ | ⟨hj, h₁, h₂⟩ | ⟨hj, h₁, h₂, h₃⟩
  · let m := min (1 - (54 * «ω» + 15 * δ + 5 * σ)) (1 - (68 * «ω» + 14 * δ))
    have hm : 0 < m := lt_min (sub_pos.mpr h₁) (sub_pos.mpr h₂)
    have hm₁ : m ≤ 1 - (54 * «ω» + 15 * δ + 5 * σ) := min_le_left _ _
    have hm₂ : m ≤ 1 - (68 * «ω» + 14 * δ) := min_le_right _ _
    refine ⟨m / 1000, by positivity, Or.inl ⟨hj, ?_, ?_⟩⟩ <;> linarith
  · let m := min (1 - (56 * «ω» + 16 * δ + 4 * σ)) (1 - (68 * «ω» + 14 * δ))
    have hm : 0 < m := lt_min (sub_pos.mpr h₁) (sub_pos.mpr h₂)
    have hm₁ : m ≤ 1 - (56 * «ω» + 16 * δ + 4 * σ) := min_le_left _ _
    have hm₂ : m ≤ 1 - (68 * «ω» + 14 * δ) := min_le_right _ _
    refine ⟨m / 1000, by positivity, Or.inr (Or.inl ⟨hj, ?_, ?_⟩)⟩ <;> linarith
  · let m := min (1 - (72 * «ω» + 24 * δ))
      (min (1 - (48 * «ω» + 16 * δ + 4 * σ)) (1 - (64 * «ω» + 20 * δ + 2 * σ)))
    have hm : 0 < m := lt_min (sub_pos.mpr h₁)
      (lt_min (sub_pos.mpr h₂) (sub_pos.mpr h₃))
    have hm₁ : m ≤ 1 - (72 * «ω» + 24 * δ) := min_le_left _ _
    have hm₂ : m ≤ 1 - (48 * «ω» + 16 * δ + 4 * σ) :=
      (min_le_right _ _).trans (min_le_left _ _)
    have hm₃ : m ≤ 1 - (64 * «ω» + 20 * δ + 2 * σ) :=
      (min_le_right _ _).trans (min_le_right _ _)
    refine ⟨m / 1000, by positivity, Or.inr (Or.inr ⟨hj, ?_, ?_, ?_⟩)⟩ <;> linarith

open Classical in
theorem central_subpower_modulus_family_subset
    (j : ℕ) («ω» δ r : ℝ) (hr : 0 < r)
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x) atTop (nhds 0)) :
    ∀ᶠ x : ℝ in atTop, ∀ Y : Set.Ici (1 : ℝ), (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ,
        (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter (fun q =>
          q ∣ (∏ p ∈ I, p) ∧
            Nonempty (DenseDivisibilityWitness Y j q)) ⊆
        (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * («ω» + r))⌋₊).filter (fun q =>
          q ∣ (∏ p ∈ I, p) ∧
            Nonempty (DenseDivisibilityWitness
              ⟨max 1 (x ^ (δ + r)), le_max_left (1 : ℝ) (x ^ (δ + r))⟩ j q)) := by
  have hsmall := (tendsto_order.mp hL0sub).2 r hr
  filter_upwards [hsmall, eventually_gt_atTop (1 : ℝ)] with x hxsmall hx1
  intro Y hY I
  have hx0 : 0 < x := zero_lt_one.trans hx1
  have hL : L0 x ≤ x ^ r := by
    apply (Real.log_le_log_iff (hL0 x) (Real.rpow_pos_of_pos hx0 r)).mp
    rw [Real.log_rpow hx0]
    exact ((div_lt_iff₀ (Real.log_pos hx1)).mp hxsmall).le
  have hlevel : x ^ (1 / 2 + 2 * «ω») * L0 x ≤ x ^ (1 / 2 + 2 * («ω» + r)) := by
    calc
      _ ≤ x ^ (1 / 2 + 2 * «ω») * x ^ r :=
        mul_le_mul_of_nonneg_left hL (Real.rpow_nonneg hx0.le _)
      _ = x ^ ((1 / 2 + 2 * «ω») + r) := (Real.rpow_add hx0 _ _).symm
      _ ≤ _ := Real.rpow_le_rpow_of_exponent_le hx1.le (by linarith)
  have hdensity : (Y : ℝ) ≤ max 1 (x ^ (δ + r)) := by
    rw [hY]
    exact (Real.rpow_le_rpow_of_exponent_le hx1.le (by linarith : δ ≤ δ + r)).trans
      (le_max_right _ _)
  intro q hq
  obtain ⟨hqI, hqdiv, hqDD⟩ := Finset.mem_filter.mp hq
  exact Finset.mem_filter.mpr
    ⟨Finset.mem_Icc.mpr ⟨(Finset.mem_Icc.mp hqI).1,
      (Finset.mem_Icc.mp hqI).2.trans (Nat.floor_mono hlevel)⟩,
      hqdiv, denseDivisibility_mono_scale hdensity hqDD⟩

theorem sourceT5_sub_exceptionalPrimeDefect_zero_complex_finsupp :
    ∀ᶠ x : ℝ in atTop,
      ∀ u v : ℝ, 1 ≤ u → u ≤ v → v ≤ 2 →
        (∑ n ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x)),
          Finsupp.single n ((sourceT5 x n - exceptionalPrimeDefect x 0 n : ℝ) : ℂ)) =
        ∑ p ∈ sourceT5CentralTuples x,
          if (∏ i, p i) ∈ Finset.Icc (Nat.ceil (u * x)) (Nat.floor (v * x))
          then Finsupp.single (∏ i, p i) (1 : ℂ) else 0 := by
  classical
  filter_upwards [sourceT5_sub_exceptionalPrimeDefect_zero_finsupp] with x hx
  intro u v hu huv hv
  have h := congrArg (Finsupp.mapRange Complex.ofRealHom (map_zero Complex.ofRealHom))
    (hx u v hu huv hv)
  simpa only [Finsupp.mapRange_finsetSum, Finsupp.mapRange_single,
    apply_ite, Finsupp.mapRange_zero, map_one, Complex.ofRealHom_eq_coe] using h

theorem sourceT5CentralTuples_central_support
    (x : ℝ) (hx : 1 < x) (p : Fin 5 → ℕ) (hp : p ∈ sourceT5CentralTuples x) :
    ∃ S : Finset (Fin 5), (S.card = 2 ∨ S.card = 3) ∧
      x ^ ((40481 : ℝ) / 100000) ≤ ((∏ i ∈ S, p i : ℕ) : ℝ) ∧
      ((∏ i ∈ S, p i : ℕ) : ℝ) ≤ x ^ ((59519 : ℝ) / 100000) := by
  classical
  simp only [sourceT5CentralTuples, Finset.mem_filter] at hp
  rcases hp with ⟨hp, _, _, _, _, _, _, _, hlo, hhi⟩
  have hpos (i : Fin 5) : 0 < (p i : ℝ) := Nat.cast_pos.mpr
    (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).2.pos
  rw [← Real.logb_mul (hpos 1).ne' (hpos 2).ne',
    ← Real.logb_mul (mul_pos (hpos 1) (hpos 2)).ne' (hpos 3).ne'] at hlo hhi
  have hproduct : ((∏ i ∈ ({1, 2, 3} : Finset (Fin 5)), p i : ℕ) : ℝ) =
      (p 1 : ℝ) * p 2 * p 3 := by simp [mul_assoc]
  refine ⟨{1, 2, 3}, Or.inr (by decide), ?_, ?_⟩
  · rw [hproduct]
    exact ((Real.lt_logb_iff_rpow_lt hx
      (mul_pos (mul_pos (hpos 1) (hpos 2)) (hpos 3))).mp hlo).le
  · rw [hproduct]
    exact (Real.logb_le_iff_le_rpow hx
      (mul_pos (mul_pos (hpos 1) (hpos 2)) (hpos 3))).mp hhi

theorem sourceT5CentralTuples_pushforward_eq (x : ℝ) (I : Finset ℕ) :
    (∑ p ∈ sourceT5CentralTuples x,
      if (∏ i, p i) ∈ I then Finsupp.single (∏ i, p i) (1 : ℂ) else 0) =
    let P := (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
      ⌊x ^ ((6 : ℝ) / 25)⌋₊).filter Nat.Prime
    ∑ p ∈ Fintype.piFinset (fun _ : Fin 5 => P),
      Finsupp.single (∏ i, p i)
        (if (∏ i, p i) ∈ I ∧ p ∈ sourceT5CentralTuples x then (1 : ℂ) else 0) := by
  classical
  let P := (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
    ⌊x ^ ((6 : ℝ) / 25)⌋₊).filter Nat.Prime
  let T := Fintype.piFinset (fun _ : Fin 5 => P)
  have hsub : sourceT5CentralTuples x ⊆ T := Finset.filter_subset _ _
  have heq : T.filter (fun p => p ∈ sourceT5CentralTuples x) = sourceT5CentralTuples x :=
    Finset.filter_mem_eq_of_subset hsub
  change _ = ∑ p ∈ T, _
  conv_lhs => rw [← heq, Finset.sum_filter]
  refine Finset.sum_congr rfl ?_
  intro p _
  by_cases hp : (∏ i, p i) ∈ I <;>
    by_cases hc : p ∈ sourceT5CentralTuples x <;>
      simp [hp, hc, Finsupp.single_zero]

open Classical in
theorem sourceU3_sub_exceptionalPrimeDefect_one_eventually_split :
    ∃ X : ℝ, 3 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
      let U (p : Fin 5 → ℕ) : Prop :=
        [p 0, p 1, p 2] ∈ siftedPrimeTuples x (5 : Fin 6) ∧
          x ^ ((9519 : ℝ) / 50000) ≤ (p 3 : ℝ) ∧ p 3 ≤ p 4
      let E (p : Fin 5 → ℕ) : Prop :=
        (∀ i, (9519 : ℝ) / 50000 ≤ α (p i) ∧
          α (p i) ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
        α (p 1) < α (p 0) ∧ α (p 1) < α (p 2) ∧
        α (p 0) + α (p 2) < (40481 : ℝ) / 100000 ∧
        (59519 : ℝ) / 100000 < α (p 1) + α (p 2) + α (p 3) ∧
        α (p 3) ≤ α (p 4)
      let P := (Finset.Icc (Nat.ceil (x ^ ((9519 : ℝ) / 50000)))
        (Nat.floor (x ^ ((6 : ℝ) / 25)))).filter Nat.Prime
      let T := Fintype.piFinset (fun _ : Fin 5 => P)
      let B (p : Fin 5 → ℕ) : Prop :=
        x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x ∧ U p ∧ ¬ E p
      let Foff : ℕ →₀ ℂ := ∑ p ∈ T,
        Finsupp.single (∏ i, p i) (if B p ∧ p 2 ≠ p 1 then (1 : ℂ) else 0)
      let Fdiag : ℕ →₀ ℂ := ∑ p ∈ T,
        Finsupp.single (∏ i, p i) (if B p ∧ p 2 = p 1 then (1 : ℂ) else 0)
      (∑ n ∈ Finset.Icc (Nat.ceil x) (Nat.floor (2 * x)),
        Finsupp.single n
          (((sourceU3 x n - exceptionalPrimeDefect x (1 : Fin 2) n) : ℝ) : ℂ)) =
        Foff + Fdiag := by
  obtain ⟨X, hX3, hX⟩ :=
    sourceU3_sub_exceptionalPrimeDefect_one_eventually_positive_central
  refine ⟨X, hX3, ?_⟩
  intro x hx α U E P T B Foff Fdiag
  have hx3 : 3 ≤ x := hX3.trans hx
  have h2x : 0 ≤ 2 * x := by linarith
  let I : Finset ℕ := Finset.Icc (Nat.ceil x) (Nat.floor (2 * x))
  have hband (p : Fin 5 → ℕ) :
      (∏ i, p i) ∈ I ↔ x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x := by
    simp only [I, Finset.mem_Icc, Nat.ceil_le, Nat.le_floor_iff h2x]
  have hpoint (n : ℕ) (hn : n ∈ I) :
      (((sourceU3 x n - exceptionalPrimeDefect x (1 : Fin 2) n) : ℝ) : ℂ) =
        ∑ p ∈ T, if (∏ i, p i) = n ∧ U p ∧ ¬ E p then (1 : ℂ) else 0 := by
    have hnlo : x ≤ (n : ℝ) := Nat.ceil_le.mp (Finset.mem_Icc.mp hn).1
    have hnhi : (n : ℝ) ≤ 2 * x :=
      (Nat.le_floor_iff h2x).mp (Finset.mem_Icc.mp hn).2
    have hreal : sourceU3 x n - exceptionalPrimeDefect x (1 : Fin 2) n =
        ∑ _p ∈ T.filter (fun p => (∏ i, p i) = n ∧ U p ∧ ¬ E p), (1 : ℝ) :=
      (hX x hx n hnlo hnhi).1
    rw [hreal, Complex.ofReal_sum]
    simp only [Complex.ofReal_one, Finset.sum_filter]
  have hmass :
      (∑ n ∈ I, Finsupp.single n
        (((sourceU3 x n - exceptionalPrimeDefect x (1 : Fin 2) n) : ℝ) : ℂ)) =
      ∑ p ∈ T, Finsupp.single (∏ i, p i) (if B p then (1 : ℂ) else 0) := by
    calc
      _ = ∑ n ∈ I, ∑ p ∈ T,
          Finsupp.single n
            (if (∏ i, p i) = n ∧ U p ∧ ¬ E p then (1 : ℂ) else 0) := by
        apply Finset.sum_congr rfl
        intro n hn
        rw [hpoint n hn, Finsupp.single_finsetSum]
      _ = ∑ p ∈ T, ∑ n ∈ I,
          Finsupp.single n
            (if (∏ i, p i) = n ∧ U p ∧ ¬ E p then (1 : ℂ) else 0) :=
        Finset.sum_comm
      _ = _ := by
        apply Finset.sum_congr rfl
        intro p _hp
        by_cases hUE : U p ∧ ¬ E p
        · by_cases hprod : (∏ i, p i) ∈ I
          · obtain ⟨hlo, hhi⟩ := (hband p).mp hprod
            have hB : B p := ⟨hlo, hhi, hUE⟩
            rw [ite_eq_left hB]
            have hzero (n : ℕ) (_hn : n ∈ I) (hne : n ≠ ∏ i, p i) :
                Finsupp.single n
                  (if (∏ i, p i) = n ∧ U p ∧ ¬ E p then (1 : ℂ) else 0) = 0 := by
              have hnot : ¬ ((∏ i, p i) = n ∧ U p ∧ ¬ E p) :=
                fun h => hne h.1.symm
              rw [ite_eq_right hnot, Finsupp.single_zero]
            rw [Finset.sum_eq_single_of_mem (∏ i, p i) hprod hzero,
              ite_eq_left ⟨rfl, hUE⟩]
          · have hB : ¬ B p :=
              fun h => hprod ((hband p).mpr ⟨h.1, h.2.1⟩)
            rw [ite_eq_right hB, Finsupp.single_zero]
            apply Finset.sum_eq_zero
            intro n hn
            have hnot : ¬ ((∏ i, p i) = n ∧ U p ∧ ¬ E p) := by
              rintro ⟨heq, _⟩
              apply hprod
              rw [heq]
              exact hn
            rw [ite_eq_right hnot, Finsupp.single_zero]
        · have hB : ¬ B p := fun h => hUE h.2.2
          rw [ite_eq_right hB, Finsupp.single_zero]
          apply Finset.sum_eq_zero
          intro n _hn
          have hnot : ¬ ((∏ i, p i) = n ∧ U p ∧ ¬ E p) := fun h => hUE h.2
          rw [ite_eq_right hnot, Finsupp.single_zero]
  change (∑ n ∈ I, Finsupp.single n
    (((sourceU3 x n - exceptionalPrimeDefect x (1 : Fin 2) n) : ℝ) : ℂ)) = Foff + Fdiag
  rw [hmass]
  dsimp only [Foff, Fdiag]
  rw [← Finset.sum_add_distrib]
  apply Finset.sum_congr rfl
  intro p _hp
  rw [← Finsupp.single_add]
  congr 1
  by_cases hB : B p
  · by_cases hdiag : p 2 = p 1
    · have hoff : ¬ (B p ∧ p 2 ≠ p 1) := fun h => h.2 hdiag
      rw [ite_eq_left hB, ite_eq_right hoff, ite_eq_left ⟨hB, hdiag⟩, zero_add]
    · have hnotdiag : ¬ (B p ∧ p 2 = p 1) := fun h => hdiag h.2
      rw [ite_eq_left hB, ite_eq_left ⟨hB, hdiag⟩, ite_eq_right hnotdiag, add_zero]
  · have hoff : ¬ (B p ∧ p 2 ≠ p 1) := fun h => hB h.1
    have hdiag : ¬ (B p ∧ p 2 = p 1) := fun h => hB h.1
    rw [ite_eq_right hB, ite_eq_right hoff, ite_eq_right hdiag, zero_add]

theorem sparse_factor_fullDiscrepancy_bound
    (θ : ℝ) (hθ0 : 0 < θ) (hθ1 : θ < 1)
    (k : ℕ) (Cscale : ℝ) (hCscale : 1 ≤ Cscale) :
    ∃ P : ℕ, ∃ K : ℝ, 0 < K ∧
      ∀ M : ℝ, Real.exp 1 ≤ M →
      ∀ q a : ℕ, 0 < q → (q : ℝ) ≤ M ^ θ → Nat.Coprime a q →
      ∀ (D : Finset ℕ) (w : ℕ → ℕ → ℂ) (v : ℕ → ℝ),
        (∀ d ∈ D, 0 ≤ v d) →
        (∀ d ∈ D, ∀ m ∈ Finset.Icc 1 ⌈Cscale * M⌉₊,
          ‖w d m‖ ≤ v d * (m.divisors.card : ℝ) ^ k) →
        let f : ℕ →₀ ℂ :=
          ∑ d ∈ D, ∑ m ∈ Finset.Icc 1 ⌈Cscale * M⌉₊, Finsupp.single (d * m) (w d m)
        ‖fullDiscrepancy f q a‖ ≤
          K * M * (Real.log M) ^ P * (q.divisors.card : ℝ) / q * ∑ d ∈ D, v d := by
  classical
  obtain ⟨P, Kraw, hKraw, hprogression⟩ :=
    long_progression_card_divisors_pow_bound
      θ hθ0 hθ1 k Cscale hCscale
  refine ⟨P, 2 * Kraw, mul_pos (by norm_num) hKraw, ?_⟩
  intro M hM q a hq hqM ha D w v hv hw f
  let : NeZero q := ⟨hq.ne'⟩
  have hMpos : 0 < M := (Real.exp_pos 1).trans_le hM
  have hMone : 1 ≤ M := (Real.one_le_exp zero_le_one).trans hM
  have hlogOne : 1 ≤ Real.log M := (Real.le_log_iff_exp_le hMpos).mpr hM
  have hlogPos : 0 < Real.log M := zero_lt_one.trans_le hlogOne
  have hqPos : (0 : ℝ) < q := Nat.cast_pos.mpr hq
  have hφPos : (0 : ℝ) < q.totient := Nat.cast_pos.mpr (Nat.totient_pos.mpr hq)
  have hφq : (q.totient : ℝ) ≤ q := Nat.cast_le.mpr (Nat.totient_le q)
  let I : Finset ℕ := Finset.Icc 1 ⌈Cscale * M⌉₊
  let F : ℝ := Kraw * M * (Real.log M) ^ P
  have hF : 0 ≤ F := by dsimp only [F]; positivity
  have hall : (∑ m ∈ I, (m.divisors.card : ℝ) ^ k) ≤ F := by
    simpa only [I, F, Nat.mod_one, eq_self_iff_true, Finset.filter_true,
      Nat.cast_one, div_one] using
      hprogression M hM 1 0 (by decide)
        (by simpa only [Nat.cast_one] using Real.one_le_rpow hMone hθ0.le) (by decide)
  let B : ℕ → ℕ := fun d => (((a : ZMod q) * (d : ZMod q)⁻¹).val)
  let kernel : ℕ → ℕ → ℂ := fun b n =>
    (if n % q = b % q then 1 else 0) -
      (if Nat.Coprime n q then 1 else 0) / (q.totient : ℂ)
  have hfull (u : ℕ →₀ ℂ) :
      fullDiscrepancy u q a = u.sum (fun n z => z * kernel a n) := by
    change fullDiscrepancy u q a = ∑ n ∈ u.support, u n * kernel a n
    simp only [fullDiscrepancy, progressionMass, reducedMass, kernel,
      div_eq_mul_inv, mul_sub, mul_ite, ite_mul, one_mul, mul_one,
      zero_mul, mul_zero, Finset.sum_sub_distrib, Finset.sum_mul]
  have hpair :
      fullDiscrepancy f q a = ∑ d ∈ D, ∑ m ∈ I, w d m * kernel a (d * m) := by
    rw [hfull]
    change (∑ d ∈ D, ∑ m ∈ I, Finsupp.single (d * m) (w d m)).sum
      (fun n z => z * kernel a n) = _
    rw [← Finsupp.sum_finsetSum_index (fun _ => zero_mul _) (fun _ _ _ => add_mul _ _ _)]
    apply Finset.sum_congr rfl
    intro d _
    rw [← Finsupp.sum_finsetSum_index (fun _ => zero_mul _) (fun _ _ _ => add_mul _ _ _)]
    apply Finset.sum_congr rfl
    intro m _
    exact Finsupp.sum_single_index (zero_mul _)
  have hkernel (d m : ℕ) :
      kernel a (d * m) = if Nat.Coprime d q then kernel (B d) m else 0 := by
    by_cases hd : Nat.Coprime d q
    · have hmod : (d * m) % q = a % q ↔ m % q = (B d) % q := by
        dsimp only [B]
        rw [← ZMod.natCast_eq_natCast_iff', ← ZMod.natCast_eq_natCast_iff',
          ZMod.natCast_zmod_val, Nat.cast_mul]
        let u := ZMod.unitOfCoprime d hd
        change (u : ZMod q) * (m : ZMod q) = (a : ZMod q) ↔
          (m : ZMod q) = (a : ZMod q) * (u : ZMod q)⁻¹
        rw [ZMod.inv_coe_unit, mul_comm (a : ZMod q)]
        exact (Units.eq_inv_mul_iff_mul_eq (b := u)).symm
      have hcop : Nat.Coprime (d * m) q ↔ Nat.Coprime m q :=
        ⟨Nat.Coprime.coprime_mul_left, hd.mul_left⟩
      simp only [ite_eq_left hd, kernel, hmod, hcop]
    · have hprod : ¬ Nat.Coprime (d * m) q :=
        fun h => hd h.coprime_mul_right
      have hres : ¬ (d * m) % q = a % q := by
        intro h
        exact hprod ((show Nat.ModEq q (d * m) a from h).gcd_eq.trans ha)
      simp only [ite_eq_right hd, kernel, ite_eq_right hres, ite_eq_right hprod,
        zero_div, sub_self]
  have hBcoprime (d : ℕ) (hd : Nat.Coprime d q) : Nat.Coprime (B d) q := by
    simpa only [B, Units.val_mul, ← ZMod.inv_coe_unit, ZMod.coe_unitOfCoprime] using
      ZMod.val_coe_unit_coprime
        (ZMod.unitOfCoprime a ha * (ZMod.unitOfCoprime d hd)⁻¹)
  have hnormMask (d : ℕ) (hd : d ∈ D) (χ : ℕ → Prop) [DecidablePred χ] :
      ‖∑ m ∈ I, if χ m then w d m else 0‖ ≤
        v d * ∑ m ∈ I, if χ m then (m.divisors.card : ℝ) ^ k else 0 := by
    rw [Finset.mul_sum]
    apply norm_sum_le_of_le
    intro m hm
    by_cases hχ : χ m
    · simpa only [ite_eq_left hχ] using hw d hd m hm
    · simp only [ite_eq_right hχ, norm_zero, mul_zero, le_refl]
  have hrow (d : ℕ) (hd : d ∈ D) :
      ‖∑ m ∈ I, w d m * kernel a (d * m)‖ ≤
        (2 * F * (q.divisors.card : ℝ) / q) * v d := by
    have hvd : 0 ≤ v d := hv d hd
    by_cases hdq : Nat.Coprime d q
    · have hrowEq :
          (∑ m ∈ I, w d m * kernel a (d * m)) =
            (∑ m ∈ I, if m % q = (B d) % q then w d m else 0) -
              (∑ m ∈ I, if Nat.Coprime m q then w d m else 0) / (q.totient : ℂ) := by
        simp_rw [hkernel, ite_eq_left hdq]
        simp only [kernel, div_eq_mul_inv, mul_sub,
          mul_ite, ite_mul, one_mul, mul_one, zero_mul, mul_zero,
          Finset.sum_sub_distrib, Finset.sum_mul]
      have hfirst :
          ‖∑ m ∈ I, if m % q = (B d) % q then w d m else 0‖ ≤ F * v d / q := by
        calc
          _ ≤ v d * ∑ m ∈ I,
              if m % q = (B d) % q then (m.divisors.card : ℝ) ^ k else 0 :=
            hnormMask d hd (fun m => m % q = (B d) % q)
          _ ≤ v d * (Kraw * M / q * (Real.log M) ^ P) := by
            apply mul_le_mul_of_nonneg_left _ hvd
            rw [← Finset.sum_filter]
            exact hprogression M hM q (B d) hq hqM (hBcoprime d hdq)
          _ = F * v d / q := by dsimp only [F]; ring
      have hsecond :
          ‖∑ m ∈ I, if Nat.Coprime m q then w d m else 0‖ ≤ F * v d := by
        calc
          _ ≤ v d * ∑ m ∈ I,
              if Nat.Coprime m q then (m.divisors.card : ℝ) ^ k else 0 :=
            hnormMask d hd (fun m => Nat.Coprime m q)
          _ ≤ v d * ∑ m ∈ I, (m.divisors.card : ℝ) ^ k := by
            apply mul_le_mul_of_nonneg_left _ hvd
            apply Finset.sum_le_sum
            intro m _
            split_ifs <;> first | exact le_rfl | positivity
          _ ≤ v d * F := mul_le_mul_of_nonneg_left hall hvd
          _ = F * v d := mul_comm _ _
      rw [hrowEq]
      calc
        _ ≤ F * v d / q + F * v d / q.totient := norm_sub_le_of_le hfirst (by
          rw [norm_div, Complex.norm_natCast]
          exact div_le_div_of_nonneg_right hsecond hφPos.le)
        _ ≤ F * v d / q.totient + F * v d / q.totient :=
          add_le_add (div_le_div_of_nonneg_left (mul_nonneg hF hvd) hφPos hφq) le_rfl
        _ = (2 * (F * v d) / q) * ((q : ℝ) / q.totient) := by
          rw [div_mul_div_cancel₀ hqPos.ne']
          ring
        _ ≤ (2 * (F * v d) / q) * (q.divisors.card : ℝ) :=
          mul_le_mul_of_nonneg_left
            (div_totient_le_card_divisors q) (by positivity)
        _ = (2 * F * (q.divisors.card : ℝ) / q) * v d := by ring
    · have hz : (∑ m ∈ I, w d m * kernel a (d * m)) = 0 := by
        apply Finset.sum_eq_zero
        intro m _
        rw [hkernel, ite_eq_right hdq, mul_zero]
      rw [hz, norm_zero]
      positivity
  rw [hpair]
  calc
    _ ≤ ∑ d ∈ D, (2 * F * (q.divisors.card : ℝ) / q) * v d :=
      norm_sum_le_of_le D hrow
    _ = (2 * F * (q.divisors.card : ℝ) / q) * ∑ d ∈ D, v d :=
      (Finset.mul_sum _ _ _).symm
    _ = (2 * Kraw) * M * (Real.log M) ^ P * (q.divisors.card : ℝ) / q *
        ∑ d ∈ D, v d := by
      dsimp only [F]
      ring

theorem sparse_factor_moduli_bound
    (γ θ : ℝ) (hγ : 0 ≤ γ) (hθ : 0 < θ) (hθγ : θ < 1 - γ)
    (k J : ℕ) (Cscale : ℝ) (hCscale : 1 ≤ Cscale) :
    ∃ P : ℕ, ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ N : ℝ, 1 ≤ N → N ≤ x ^ γ →
      ∀ (S : Finset ℕ), S ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
      ∀ (D : Finset ℕ) (w : ℕ → ℕ → ℂ) (v : ℕ → ℝ),
        (∀ d ∈ D, 0 ≤ v d) →
        (∀ d ∈ D, ∀ m ∈ Finset.Icc 1 ⌈Cscale * (x / N)⌉₊,
          ‖w d m‖ ≤ v d * (m.divisors.card : ℝ) ^ k) →
        let f : ℕ →₀ ℂ :=
          ∑ d ∈ D, ∑ m ∈ Finset.Icc 1 ⌈Cscale * (x / N)⌉₊,
            Finsupp.single (d * m) (w d m)
        (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy f q (a q)‖) ≤
          K * (x / N) * (Real.log x) ^ P * ∑ d ∈ D, v d := by
  classical
  let ρ : ℝ := 1 - γ
  have hθρ : θ < ρ := hθγ
  have hρ : 0 < ρ := hθ.trans hθρ
  have hratio0 : 0 < θ / ρ := div_pos hθ hρ
  have hratio1 : θ / ρ < 1 := (div_lt_iff₀ hρ).mpr (by simpa only [one_mul] using hθρ)
  let κ : ℝ := (θ / ρ + 1) / 2
  have hκ0 : 0 < κ := by dsimp only [κ]; linarith only [hratio0]
  have hκ1 : κ < 1 := by dsimp only [κ]; linarith only [hratio1]
  have hθκ : θ ≤ ρ * κ := by
    calc
      θ = ρ * (θ / ρ) := by field_simp [hρ.ne']
      _ ≤ ρ * κ := mul_le_mul_of_nonneg_left
        (by dsimp only [κ]; linarith only [hratio1]) hρ.le
  obtain ⟨P₀, Kraw, hKraw, hAP⟩ :=
    sparse_factor_fullDiscrepancy_bound κ hκ0 hκ1 k Cscale hCscale
  let R : ℕ := 2 ^ (J + 1)
  have hlarge : ∀ᶠ x : ℝ in Filter.atTop, Real.exp 1 ≤ x ^ ρ :=
    (tendsto_rpow_atTop hρ).eventually_ge_atTop (Real.exp 1)
  obtain ⟨X, hX⟩ := hlarge.exists_forall_of_atTop
  refine ⟨P₀ + R, Kraw * (2 : ℝ) ^ R, max (Real.exp 1) X,
    mul_pos hKraw (pow_pos (by norm_num) _), le_max_left _ _, ?_⟩
  intro x hx N hNone hNupper S hS a ha D w v hv hw f
  have hxExp : Real.exp 1 ≤ x := (le_max_left _ _).trans hx
  have hxPos : 0 < x := (Real.exp_pos 1).trans_le hxExp
  have hxOne : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hxExp
  have hlogOne : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxPos).mpr hxExp
  have hlogPos : 0 < Real.log x := zero_lt_one.trans_le hlogOne
  have hNpos : 0 < N := zero_lt_one.trans_le hNone
  let M : ℝ := x / N
  have hMpos : 0 < M := div_pos hxPos hNpos
  have hMlower : x ^ ρ ≤ M := by
    calc
      x ^ ρ = x / x ^ γ := by
        dsimp only [ρ]
        rw [Real.rpow_sub hxPos, Real.rpow_one]
      _ ≤ x / N := div_le_div_of_nonneg_left hxPos.le hNpos hNupper
  have hMexp : Real.exp 1 ≤ M :=
    (hX x ((le_max_right _ _).trans hx)).trans hMlower
  have hMupper : M ≤ x := div_le_self hxPos.le hNone
  have hlogM0 : 0 ≤ Real.log M :=
    Real.log_nonneg ((Real.one_le_exp zero_le_one).trans hMexp)
  have hlogM : Real.log M ≤ Real.log x := Real.log_le_log hMpos hMupper
  have hθ1 : θ < 1 := by linarith only [hθγ, hγ]
  let Q : ℕ := ⌊x ^ θ⌋₊
  have hQone : 1 ≤ Q := (Nat.one_le_floor_iff _).mpr (Real.one_le_rpow hxOne hθ.le)
  have hQpos : (0 : ℝ) < Q := Nat.cast_pos.mpr (zero_lt_one.trans_le hQone)
  have hQpower : (Q : ℝ) ≤ x ^ θ := Nat.floor_le (Real.rpow_nonneg hxPos.le _)
  have hQx : (Q : ℝ) ≤ x := hQpower.trans (Real.rpow_le_self_of_one_le hxOne hθ1.le)
  have hQlog0 : 0 ≤ 1 + Real.log (Q : ℝ) :=
    add_nonneg zero_le_one (Real.log_nonneg (by exact_mod_cast hQone))
  have hQlog : 1 + Real.log (Q : ℝ) ≤ 2 * Real.log x := by
    have hh := Real.log_le_log hQpos hQx
    linarith only [hh, hlogOne]
  let V : ℝ := ∑ d ∈ D, v d
  have hV : 0 ≤ V := Finset.sum_nonneg hv
  let F : ℝ := Kraw * M * (Real.log M) ^ P₀ * V
  have hF : 0 ≤ F := by dsimp only [F]; positivity
  have hpoint (q : ℕ) (hqS : q ∈ S) :
      (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy f q (a q)‖ ≤
        F * (q.divisors.card : ℝ) ^ (J + 1) / q := by
    have hq : 0 < q := (Finset.mem_Icc.mp (hS hqS)).1
    have hqM : (q : ℝ) ≤ M ^ κ := by
      calc
        (q : ℝ) ≤ x ^ θ :=
          (Nat.cast_le.mpr (Finset.mem_Icc.mp (hS hqS)).2).trans hQpower
        _ ≤ x ^ (ρ * κ) := Real.rpow_le_rpow_of_exponent_le hxOne hθκ
        _ = (x ^ ρ) ^ κ := Real.rpow_mul hxPos.le _ _
        _ ≤ M ^ κ := Real.rpow_le_rpow (Real.rpow_nonneg hxPos.le _) hMlower hκ0.le
    have hraw := hAP M hMexp q (a q) hq hqM (ha q hqS) D w v hv hw
    calc
      _ ≤ (q.divisors.card : ℝ) ^ J *
          (Kraw * M * (Real.log M) ^ P₀ * (q.divisors.card : ℝ) / q * ∑ d ∈ D, v d) :=
        mul_le_mul_of_nonneg_left hraw (pow_nonneg (Nat.cast_nonneg _) _)
      _ = F * (q.divisors.card : ℝ) ^ (J + 1) / q := by
        dsimp only [F, V]
        rw [pow_succ]
        ring
  have hweight :
      (∑ q ∈ S, (q.divisors.card : ℝ) ^ (J + 1) / (q : ℝ)) ≤
        (1 + Real.log (Q : ℝ)) ^ R := by
    refine (Finset.sum_le_sum_of_subset_of_nonneg hS (fun q _ _ => by positivity)).trans ?_
    exact sum_card_divisors_pow_div_le_log_pow (J + 1) Q
  have hFupper : F ≤ Kraw * M * (Real.log x) ^ P₀ * V :=
    mul_le_mul_of_nonneg_right
      (mul_le_mul_of_nonneg_left (pow_le_pow_left₀ hlogM0 hlogM P₀)
        (mul_nonneg hKraw.le hMpos.le)) hV
  calc
    _ ≤ ∑ q ∈ S, F * (q.divisors.card : ℝ) ^ (J + 1) / q := Finset.sum_le_sum hpoint
    _ = F * ∑ q ∈ S, (q.divisors.card : ℝ) ^ (J + 1) / q := by
      simp only [Finset.mul_sum, mul_div_assoc]
    _ ≤ F * (1 + Real.log (Q : ℝ)) ^ R := mul_le_mul_of_nonneg_left hweight hF
    _ ≤ (Kraw * M * (Real.log x) ^ P₀ * V) * (2 * Real.log x) ^ R :=
      mul_le_mul hFupper (pow_le_pow_left₀ hQlog0 hQlog R)
        (pow_nonneg hQlog0 _) (by positivity)
    _ = (Kraw * (2 : ℝ) ^ R) * (x / N) * (Real.log x) ^ (P₀ + R) * ∑ d ∈ D, v d := by
      dsimp only [M, V]
      rw [mul_pow, pow_add]
      ring

theorem repeated_factor_polynomial_band_moduli_log_saving (J : ℕ)
    (A : ℝ) (hA : 0 < A) :
    ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ (S : Finset ℕ), S ⊆ Finset.Icc 1 ⌊x ^ (53 / 100 : ℝ)⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
      ∀ D : Finset ℕ,
        (∀ p ∈ D, x ^ (9519 / 50000 : ℝ) ≤ (p : ℝ) ∧
          (p : ℝ) ≤ x ^ (40481 / 200000 : ℝ)) →
      ∀ u : ℕ → ℕ → ℂ,
        (∀ p ∈ D, ∀ m ∈ Finset.Icc 1 ⌈2 * x / (p : ℝ) ^ 2⌉₊,
          ‖u p m‖ ≤ (m.divisors.card : ℝ) ^ 3) →
        let f : ℕ →₀ ℂ :=
          ∑ p ∈ D, ∑ m ∈ Finset.Icc 1 ⌈2 * x / (p : ℝ) ^ 2⌉₊,
            Finsupp.single (p ^ 2 * m) (u p m)
        (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy f q (a q)‖) ≤
          K * x / (Real.log x) ^ A := by
  classical
  let ξ : ℝ := 9519 / 50000
  let β : ℝ := 40481 / 200000
  let ρ : ℝ := 2 * ξ - β
  have hξ : 0 < ξ := by norm_num [ξ]
  have hρ : 0 < ρ := by norm_num [ρ, ξ, β]
  obtain ⟨P, Kraw, X₀, hKraw, hX₀, haggregate⟩ :=
    sparse_factor_moduli_bound (2 * ξ) (53 / 100)
      (by positivity) (by norm_num) (by norm_num [ξ]) 3 J 2 (by norm_num)
  have hsmall := (isLittleO_log_rpow_rpow_atTop ((P : ℝ) + A) hρ).eventuallyLE
  obtain ⟨X₁, hX₁⟩ := hsmall.exists_forall_of_atTop
  refine ⟨Kraw, max X₀ X₁, hKraw, hX₀.trans (le_max_left _ _), ?_⟩
  intro x hx S hS a ha D hD u hu f
  have hxExp : Real.exp 1 ≤ x := hX₀.trans ((le_max_left _ _).trans hx)
  have hxPos : 0 < x := (Real.exp_pos 1).trans_le hxExp
  have hxOne : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hxExp
  have hlogOne : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxPos).mpr hxExp
  have hlogPos : 0 < Real.log x := zero_lt_one.trans_le hlogOne
  let N : ℝ := x ^ (2 * ξ)
  have hNone : 1 ≤ N := Real.one_le_rpow hxOne (by positivity)
  have hNpos : 0 < N := zero_lt_one.trans_le hNone
  let I : Finset ℕ := Finset.Icc 1 ⌈2 * (x / N)⌉₊
  let Ds : Finset ℕ := D.image (fun p => p ^ 2)
  let w : ℕ → ℕ → ℂ := fun d m =>
    if m ≤ ⌈2 * x / (Nat.sqrt d : ℝ) ^ 2⌉₊ then u (Nat.sqrt d) m else 0
  have hsqInj : Function.Injective (fun p : ℕ => p ^ 2) :=
    Nat.pow_left_injective (by decide)
  have hpOne (p : ℕ) (hp : p ∈ D) : (1 : ℝ) ≤ p :=
    (Real.one_le_rpow hxOne hξ.le).trans (hD p hp).1
  have hcap (p : ℕ) (hp : p ∈ D) :
      ⌈2 * x / (p : ℝ) ^ 2⌉₊ ≤ ⌈2 * (x / N)⌉₊ := by
    have hNsquare : N ≤ (p : ℝ) ^ 2 := by
      calc
        N = (x ^ ξ) ^ (2 : ℕ) := by
          dsimp only [N]
          rw [← Real.rpow_mul_natCast hxPos.le]
          congr 1
          norm_num
        _ ≤ (p : ℝ) ^ 2 :=
          pow_le_pow_left₀ (Real.rpow_nonneg hxPos.le _) (hD p hp).1 2
    apply Nat.ceil_mono
    calc
      2 * x / (p : ℝ) ^ 2 ≤ 2 * x / N :=
        div_le_div_of_nonneg_left (by positivity) hNpos hNsquare
      _ = 2 * (x / N) := by ring
  have hsubset (p : ℕ) (hp : p ∈ D) :
      Finset.Icc 1 ⌈2 * x / (p : ℝ) ^ 2⌉₊ ⊆ I := by
    intro m hm
    exact Finset.mem_Icc.mpr ⟨(Finset.mem_Icc.mp hm).1,
      (Finset.mem_Icc.mp hm).2.trans (hcap p hp)⟩
  have hcoeff : ∀ d ∈ Ds, ∀ m ∈ I,
      ‖w d m‖ ≤ (1 : ℝ) * (m.divisors.card : ℝ) ^ 3 := by
    intro d hd m hm
    obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hd
    dsimp only [w]
    rw [Nat.sqrt_eq']
    split_ifs with h
    · simpa only [one_mul] using hu p hp m
        (Finset.mem_Icc.mpr ⟨(Finset.mem_Icc.mp hm).1, h⟩)
    · simp only [norm_zero, one_mul]
      positivity
  have hf : (∑ d ∈ Ds, ∑ m ∈ I, Finsupp.single (d * m) (w d m) : ℕ →₀ ℂ) = f := by
    dsimp only [Ds, f]
    rw [Finset.sum_image (fun p _ q _ h => hsqInj h)]
    apply Finset.sum_congr rfl
    intro p hp
    simp only [w, Nat.sqrt_eq']
    calc
      _ = ∑ m ∈ Finset.Icc 1 ⌈2 * x / (p : ℝ) ^ 2⌉₊,
          Finsupp.single (p ^ 2 * m)
            (if m ≤ ⌈2 * x / (p : ℝ) ^ 2⌉₊ then u p m else 0) := by
        apply (Finset.sum_subset (hsubset p hp) ?_).symm
        intro m hm hmnot
        have hnot : ¬ m ≤ ⌈2 * x / (p : ℝ) ^ 2⌉₊ := fun h =>
          hmnot (Finset.mem_Icc.mpr ⟨(Finset.mem_Icc.mp hm).1, h⟩)
        simp only [ite_eq_right hnot, Finsupp.single_zero]
      _ = _ := by
        apply Finset.sum_congr rfl
        intro m hm
        rw [ite_eq_left (Finset.mem_Icc.mp hm).2]
  have hDsubset : D ⊆ Finset.Icc 1 ⌊x ^ β⌋₊ := by
    intro p hp
    exact Finset.mem_Icc.mpr ⟨by exact_mod_cast hpOne p hp,
      Nat.le_floor (hD p hp).2⟩
  have hDcardNat : D.card ≤ ⌊x ^ β⌋₊ := by
    simpa only [Nat.card_Icc, Nat.add_sub_cancel] using Finset.card_le_card hDsubset
  have hDcard : (Ds.card : ℝ) ≤ x ^ β := by
    dsimp only [Ds]
    rw [Finset.card_image_of_injective D hsqInj]
    exact (Nat.cast_le.mpr hDcardNat).trans (Nat.floor_le (Real.rpow_nonneg hxPos.le _))
  have hraw := haggregate x ((le_max_left _ _).trans hx) N hNone le_rfl
    S hS a ha Ds w (fun _ => 1) (fun _ _ => zero_le_one) hcoeff
  change (∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
      ‖fullDiscrepancy (∑ d ∈ Ds, ∑ m ∈ I, Finsupp.single (d * m) (w d m)) q (a q)‖) ≤ _ at hraw
  rw [hf] at hraw
  have hsumWeight : (∑ _d ∈ Ds, (1 : ℝ)) ≤ x ^ β := by
    simpa only [Finset.sum_const, nsmul_eq_mul, mul_one] using hDcard
  have hpower : (Real.log x) ^ ((P : ℝ) + A) ≤ x ^ ρ := by
    simpa only [Real.norm_of_nonneg (Real.rpow_nonneg hlogPos.le _),
      Real.norm_of_nonneg (Real.rpow_nonneg hxPos.le _)] using
        hX₁ x ((le_max_right _ _).trans hx)
  have hLA : 0 < (Real.log x) ^ A :=
    zero_lt_one.trans_le (Real.one_le_rpow hlogOne hA.le)
  have hratio : x ^ β * (Real.log x) ^ P ≤ N / (Real.log x) ^ A := by
    apply (le_div_iff₀ hLA).mpr
    calc
      _ = x ^ β * (Real.log x) ^ ((P : ℝ) + A) := by
        rw [Real.rpow_add hlogPos, Real.rpow_natCast]
        ring
      _ ≤ x ^ β * x ^ ρ := mul_le_mul_of_nonneg_left hpower (Real.rpow_nonneg hxPos.le _)
      _ = N := by
        rw [← Real.rpow_add hxPos]
        congr 1
        dsimp only [ρ]
        ring
  calc
    _ ≤ Kraw * (x / N) * (Real.log x) ^ P * ∑ _d ∈ Ds, (1 : ℝ) := hraw
    _ ≤ Kraw * (x / N) * (Real.log x) ^ P * x ^ β :=
      mul_le_mul_of_nonneg_left hsumWeight (by positivity)
    _ = Kraw * (x / N) * (x ^ β * (Real.log x) ^ P) := by ring
    _ ≤ Kraw * (x / N) * (N / (Real.log x) ^ A) :=
      mul_le_mul_of_nonneg_left hratio (by positivity)
    _ = Kraw * x / (Real.log x) ^ A := by field_simp [hNpos.ne']

theorem proper_prime_power_factor_moduli_log_saving
    (η γ θ : ℝ) (hη : 0 < η) (hγ : 0 ≤ γ) (hθ : 0 < θ)
    (hθγ : θ < 1 - γ) (k E J : ℕ) (C A : ℝ) (hC : 1 ≤ C) (_ : 0 < A) :
    ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ L : ℝ, 0 ≤ L →
      ∀ N : ℝ, x ^ η ≤ N → N ≤ x ^ γ →
      ∀ (S : Finset ℕ), S ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
      ∀ D : Finset ℕ, (∀ d ∈ D, N ≤ (d : ℝ) ∧ (d : ℝ) ≤ C * N) →
      ∀ w : ℕ → ℕ → ℂ,
        (∀ d ∈ D, ∀ m ∈ Finset.Icc 1 ⌈C * (x / N)⌉₊,
          ‖w d m‖ ≤ L * minorantProperPrimePowerWeight d *
            (m.divisors.card : ℝ) ^ k * (Real.log x) ^ E) →
        let f : ℕ →₀ ℂ :=
          ∑ d ∈ D, ∑ m ∈ Finset.Icc 1 ⌈C * (x / N)⌉₊,
            Finsupp.single (d * m) (w d m)
        (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy f q (a q)‖) ≤
          K * L * x / (Real.log x) ^ A := by
  classical
  obtain ⟨P, K₀, X₀, hK₀, hX₀, hbound⟩ :=
    sparse_factor_moduli_bound γ θ hγ hθ hθγ k J C hC
  let T : ℕ := P + E + 1
  let C₁ : ℝ := 2 * Real.sqrt C * (1 + Real.log C) / Real.log 2
  let K : ℝ := K₀ * C₁
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  have hlogC : 0 ≤ Real.log C := Real.log_nonneg hC
  have hlog2 : 0 < Real.log 2 := Real.log_pos (by norm_num)
  have hC₁ : 0 < C₁ := by
    dsimp only [C₁]
    exact div_pos (mul_pos (mul_pos (by norm_num) (Real.sqrt_pos.mpr hCpos))
      (by linarith)) hlog2
  have hK : 0 < K := mul_pos hK₀ hC₁
  have hsmall := (isLittleO_log_rpow_rpow_atTop ((T : ℝ) + A) (half_pos hη)).def
    (by norm_num : (0 : ℝ) < 1)
  have hlarge := (tendsto_rpow_atTop hη).eventually_ge_atTop 2
  obtain ⟨X₁, hX₁⟩ := Filter.eventually_atTop.mp (hsmall.and hlarge)
  refine ⟨K, max X₀ X₁, hK, hX₀.trans (le_max_left _ _), ?_⟩
  intro x hx L hL N hNlo hNhi S hS a ha D hD w hw f
  have hx₀ : X₀ ≤ x := (le_max_left _ _).trans hx
  have hx₁ : X₁ ≤ x := (le_max_right _ _).trans hx
  have hxExp : Real.exp 1 ≤ x := hX₀.trans hx₀
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxExp
  have hxone : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hxExp
  have hlogone : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxpos).mpr hxExp
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlogone
  have hNtwo : 2 ≤ N := (hX₁ x hx₁).2.trans hNlo
  have hNpos : 0 < N := by linarith
  have hNle : N ≤ x := hNhi.trans (Real.rpow_le_self_of_one_le hxone (by linarith))
  have hCN : 1 ≤ C * N := one_le_mul_of_one_le_of_one_le hC (by linarith)
  have hD' : D ⊆ Finset.Icc 2 ⌊C * N⌋₊ := by
    intro d hd
    exact Finset.mem_Icc.mpr ⟨by exact_mod_cast hNtwo.trans (hD d hd).1,
      (Nat.le_floor_iff (by positivity)).mpr (hD d hd).2⟩
  have hlogCN : Real.log (C * N) ≤ (1 + Real.log C) * Real.log x := by
    rw [Real.log_mul hCpos.ne' hNpos.ne']
    have hlogN := Real.log_le_log hNpos hNle
    nlinarith only [hlogN, hlogone, hlogC]
  have hmass : (∑ d ∈ D, minorantProperPrimePowerWeight d) ≤
      C₁ * Real.sqrt N * Real.log x := by
    refine (minorantProperPrimePowerWeight_mass (C * N) hCN D hD').trans ?_
    calc
      _ ≤ 2 * (Real.sqrt C * Real.sqrt N) *
          ((1 + Real.log C) * Real.log x) / Real.log 2 := by
        rw [Real.sqrt_mul hCpos.le]
        gcongr
      _ = _ := by dsimp only [C₁]; ring
  let v : ℕ → ℝ := fun d => L * minorantProperPrimePowerWeight d * (Real.log x) ^ E
  have hv (d : ℕ) (hd : d ∈ D) : 0 ≤ v d :=
    mul_nonneg (mul_nonneg hL (minorantProperPrimePowerWeight_nonneg d))
      (pow_nonneg hlogpos.le E)
  have hw' (d : ℕ) (hd : d ∈ D) (m : ℕ)
      (hm : m ∈ Finset.Icc 1 ⌈C * (x / N)⌉₊) :
      ‖w d m‖ ≤ v d * (m.divisors.card : ℝ) ^ k := by
    exact (hw d hd m hm).trans_eq (by dsimp only [v]; ring)
  have hsumv : (∑ d ∈ D, v d) ≤
      L * (Real.log x) ^ E * (C₁ * Real.sqrt N * Real.log x) := by
    calc
      _ = L * (Real.log x) ^ E * ∑ d ∈ D, minorantProperPrimePowerWeight d := by
        simp only [v, Finset.mul_sum]
        apply Finset.sum_congr rfl
        intro d hd
        ring
      _ ≤ _ := mul_le_mul_of_nonneg_left hmass (mul_nonneg hL (pow_nonneg hlogpos.le E))
  have hraw := hbound x hx₀ N (by linarith) hNhi S hS a ha D w v hv hw'
  have hsqrtpos : 0 < Real.sqrt N := Real.sqrt_pos.mpr hNpos
  have hcancel : (x / N) * Real.sqrt N = x / Real.sqrt N := by
    calc
      _ = x * (Real.sqrt N / N) := by ring
      _ = _ := by rw [Real.sqrt_div_self']; ring
  have hraw' : (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy f q (a q)‖) ≤
      K * L * x * (Real.log x) ^ T / Real.sqrt N := by
    refine hraw.trans ((mul_le_mul_of_nonneg_left hsumv (by positivity)).trans_eq ?_)
    dsimp only [K, T]
    rw [pow_succ, pow_add]
    calc
      _ = (K₀ * C₁) * L * ((x / N) * Real.sqrt N) *
          ((Real.log x) ^ P * (Real.log x) ^ E * Real.log x) := by ring
      _ = _ := by rw [hcancel]; ring
  have hroot : x ^ (η / 2) ≤ Real.sqrt N := by
    rw [Real.sqrt_eq_rpow]
    calc
      _ = (x ^ η) ^ (1 / 2 : ℝ) := by rw [← Real.rpow_mul hxpos.le]; congr 1; ring
      _ ≤ _ := Real.rpow_le_rpow (Real.rpow_nonneg hxpos.le _) hNlo (by norm_num)
  have hlogsmall : (Real.log x) ^ T * (Real.log x) ^ A ≤ x ^ (η / 2) := by
    simpa only [Real.norm_of_nonneg (Real.rpow_nonneg hlogpos.le _),
      Real.norm_of_nonneg (Real.rpow_nonneg hxpos.le _), one_mul,
      Real.rpow_add hlogpos, Real.rpow_natCast,
      Real.norm_of_nonneg (mul_nonneg (pow_nonneg hlogpos.le T)
        (Real.rpow_nonneg hlogpos.le A))] using (hX₁ x hx₁).1
  have hfrac : (Real.log x) ^ T / x ^ (η / 2) ≤ 1 / (Real.log x) ^ A := by
    apply (div_le_div_iff₀ (Real.rpow_pos_of_pos hxpos _) (Real.rpow_pos_of_pos hlogpos _)).mpr
    simpa only [one_mul] using hlogsmall
  refine hraw'.trans ?_
  calc
    _ ≤ K * L * x * (Real.log x) ^ T / x ^ (η / 2) :=
      div_le_div_of_nonneg_left (by positivity) (Real.rpow_pos_of_pos hxpos _) hroot
    _ = K * L * x * ((Real.log x) ^ T / x ^ (η / 2)) := by ring
    _ ≤ K * L * x * (1 / (Real.log x) ^ A) :=
      mul_le_mul_of_nonneg_left hfrac (by positivity)
    _ = _ := by ring

theorem repeated_factor_moduli_log_saving
    (η γ θ : ℝ) (hη : 0 < η) (hγ : 0 < γ) (hθ : 0 < θ)
    (_hηγ : η ≤ γ) (hrange : θ + 2 * γ < 1)
    (k E J : ℕ) (C A : ℝ) (hC : 1 ≤ C) (hA : 0 < A) :
    ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ L : ℝ, 0 ≤ L →
      ∀ P : ℝ, x ^ η ≤ P → P ≤ x ^ γ →
      ∀ (S : Finset ℕ), S ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
      ∀ D : Finset ℕ, (∀ p ∈ D, P ≤ (p : ℝ) ∧ (p : ℝ) ≤ C * P) →
      ∀ u : ℕ → ℕ → ℂ,
        (∀ p ∈ D, ∀ m ∈ Finset.Icc 1 ⌈C * (x / P ^ 2)⌉₊,
          ‖u p m‖ ≤ L * (m.divisors.card : ℝ) ^ k * (Real.log x) ^ E) →
        let f : ℕ →₀ ℂ :=
          ∑ p ∈ D, ∑ m ∈ Finset.Icc 1 ⌈C * (x / P ^ 2)⌉₊,
            Finsupp.single (p ^ 2 * m) (u p m)
        (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy f q (a q)‖) ≤
          K * L * x / (Real.log x) ^ A := by
  classical
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  obtain ⟨P₀, Kraw, X₀, hKraw, hX₀, haggregate⟩ :=
    sparse_factor_moduli_bound (2 * γ) θ (by positivity) hθ
      (by linarith only [hrange]) k J C hC
  let T : ℝ := ((P₀ + E : ℕ) : ℝ) + A
  have hsmall := (isLittleO_log_rpow_rpow_atTop T hη).eventuallyLE
  obtain ⟨X₁, hX₁⟩ := hsmall.exists_forall_of_atTop
  refine ⟨Kraw * C, max X₀ X₁, mul_pos hKraw hCpos,
    hX₀.trans (le_max_left _ _), ?_⟩
  intro x hx L hL P hPlower hPupper S hS a ha D hD u hu f
  have hxExp : Real.exp 1 ≤ x := hX₀.trans ((le_max_left _ _).trans hx)
  have hxPos : 0 < x := (Real.exp_pos 1).trans_le hxExp
  have hxOne : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hxExp
  have hlogOne : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxPos).mpr hxExp
  have hlogPos : 0 < Real.log x := zero_lt_one.trans_le hlogOne
  have hPone : 1 ≤ P := (Real.one_le_rpow hxOne hη.le).trans hPlower
  have hPpos : 0 < P := zero_lt_one.trans_le hPone
  have hP2one : 1 ≤ P ^ 2 := one_le_pow₀ hPone
  have hP2upper : P ^ 2 ≤ x ^ (2 * γ) := by
    calc
      P ^ 2 ≤ (x ^ γ) ^ (2 : ℕ) := pow_le_pow_left₀ hPpos.le hPupper 2
      _ = x ^ (2 * γ) := by
        rw [← Real.rpow_mul_natCast hxPos.le]
        congr 1
        norm_num
        ring
  let I : Finset ℕ := Finset.Icc 1 ⌈C * (x / P ^ 2)⌉₊
  let Ds : Finset ℕ := D.image (fun p => p ^ 2)
  have hsqInj : Function.Injective (fun p : ℕ => p ^ 2) :=
    Nat.pow_left_injective (by decide)
  have hDsubset : D ⊆ Finset.Icc 1 ⌊C * P⌋₊ := by
    intro p hp
    refine Finset.mem_Icc.mpr ⟨?_, Nat.le_floor (hD p hp).2⟩
    exact_mod_cast hPone.trans (hD p hp).1
  have hDcardNat : D.card ≤ ⌊C * P⌋₊ := by
    simpa only [Nat.card_Icc, Nat.add_sub_cancel] using Finset.card_le_card hDsubset
  have hDcard : (Ds.card : ℝ) ≤ C * P := by
    dsimp only [Ds]
    rw [Finset.card_image_of_injective D hsqInj]
    exact (Nat.cast_le.mpr hDcardNat).trans (Nat.floor_le (mul_pos hCpos hPpos).le)
  have hweight : 0 ≤ L * (Real.log x) ^ E := mul_nonneg hL (pow_nonneg hlogPos.le _)
  have hcoeff : ∀ d ∈ Ds, ∀ m ∈ I,
      ‖u (Nat.sqrt d) m‖ ≤ (L * (Real.log x) ^ E) * (m.divisors.card : ℝ) ^ k := by
    intro d hd m hm
    obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hd
    simpa only [Nat.sqrt_eq', mul_assoc, mul_comm, mul_left_comm] using hu p hp m hm
  have hf :
      (∑ d ∈ Ds, ∑ m ∈ I, Finsupp.single (d * m) (u (Nat.sqrt d) m) : ℕ →₀ ℂ) = f := by
    dsimp only [Ds, f]
    rw [Finset.sum_image (fun p _ q _ h => hsqInj h)]
    simp only [Nat.sqrt_eq', I]
  have hraw := haggregate x ((le_max_left _ _).trans hx) (P ^ 2) hP2one hP2upper
    S hS a ha Ds (fun d m => u (Nat.sqrt d) m) (fun _ => L * (Real.log x) ^ E)
      (fun _ _ => hweight) hcoeff
  change (∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
    ‖fullDiscrepancy (∑ d ∈ Ds, ∑ m ∈ I, Finsupp.single (d * m) (u (Nat.sqrt d) m))
      q (a q)‖) ≤ _ at hraw
  rw [hf] at hraw
  have hsumWeight :
      (∑ _d ∈ Ds, L * (Real.log x) ^ E) ≤ C * P * (L * (Real.log x) ^ E) := by
    rw [Finset.sum_const, nsmul_eq_mul]
    exact mul_le_mul_of_nonneg_right hDcard hweight
  have hpower : (Real.log x) ^ T ≤ x ^ η := by
    simpa only [Real.norm_eq_abs,
      abs_of_nonneg (Real.rpow_nonneg hlogPos.le T),
      abs_of_nonneg (Real.rpow_nonneg hxPos.le η)] using
      hX₁ x ((le_max_right _ _).trans hx)
  have hlogProduct : (Real.log x) ^ (P₀ + E) * (Real.log x) ^ A ≤ P := by
    calc
      _ = (Real.log x) ^ T := by
        dsimp only [T]
        rw [Real.rpow_add hlogPos, Real.rpow_natCast]
      _ ≤ x ^ η := hpower
      _ ≤ P := hPlower
  have hLA : 0 < (Real.log x) ^ A :=
    zero_lt_one.trans_le (Real.one_le_rpow hlogOne hA.le)
  have hquotient : (Real.log x) ^ (P₀ + E) / P ≤ 1 / (Real.log x) ^ A := by
    apply (div_le_div_iff₀ hPpos hLA).mpr
    simpa only [one_mul] using hlogProduct
  calc
    _ ≤ Kraw * (x / P ^ 2) * (Real.log x) ^ P₀ * ∑ _d ∈ Ds, L * (Real.log x) ^ E := hraw
    _ ≤ Kraw * (x / P ^ 2) * (Real.log x) ^ P₀ *
        (C * P * (L * (Real.log x) ^ E)) :=
      mul_le_mul_of_nonneg_left hsumWeight (by positivity)
    _ = (Kraw * C * L * x) * ((Real.log x) ^ (P₀ + E) / P) := by
      rw [pow_add]
      field_simp [hPpos.ne']
    _ ≤ (Kraw * C * L * x) * (1 / (Real.log x) ^ A) :=
      mul_le_mul_of_nonneg_left hquotient (by positivity)
    _ = (Kraw * C) * L * x / (Real.log x) ^ A := by ring

theorem radial_short_interval_moduli_log_saving
    (θ : ℝ) (hθ0 : 0 < θ) (hθ1 : θ < 1)
    (k E J : ℕ) (C A : ℝ) (hC : 1 ≤ C) (hA : 0 < A) :
    ∃ D : ℕ, 1 ≤ D ∧ ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ L : ℝ, 0 ≤ L →
      ∀ lo hi : ℕ, 1 ≤ lo → lo ≤ hi → hi ≤ ⌈C * x⌉₊ + 1 →
        ((hi - lo : ℕ) : ℝ) ≤ x / (Real.log x) ^ D →
      ∀ (S : Finset ℕ), S ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
      ∀ w : ℕ → ℂ,
        (∀ n ∈ Finset.Ico lo hi,
          ‖w n‖ ≤ L * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ E) →
        let f : ℕ →₀ ℂ := ∑ n ∈ Finset.Ico lo hi, Finsupp.single n (w n)
        (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy f q (a q)‖) ≤
          K * L * x / (Real.log x) ^ A := by
  classical
  obtain ⟨D, hD, K, X, hK, hX, hbound⟩ :=
    weighted_boundary_fullDiscrepancy_log_saving
      θ hθ0 hθ1 k E J 1 C 1 hC zero_le_one A hA
  refine ⟨D, hD, K, X, hK, hX, ?_⟩
  intro x hx L hL lo hi hlo hlohi hhi hwidth S hS a ha w hw f
  have hf (n : ℕ) : f n = if n ∈ Finset.Ico lo hi then w n else 0 := by
    simp [f, Finsupp.finsetSum_apply, Finsupp.single_apply]
  have hmem (n : ℕ) (hn : n ∈ f.support) : n ∈ Finset.Ico lo hi := by
    by_contra h
    exact (Finsupp.mem_support_iff.mp hn) (by simp only [hf, ite_eq_right h])
  apply hbound x hx L hL S hS a ha (fun _ => lo) (fun _ => hi)
    (fun _ => ⟨hlo, hlohi, hhi⟩) (by simpa using hwidth) f
  · intro n hn
    exact ⟨0, (Finset.mem_Ico.mp (hmem n hn)).1, (Finset.mem_Ico.mp (hmem n hn)).2⟩
  · intro n hn
    rw [hf, ite_eq_left (hmem n hn)]
    exact hw n (hmem n hn)

theorem power_coefficient_moduli_log_saving
    (η θ : ℝ) (hη : 0 < η) (hθ0 : 0 < θ) (hθ1 : θ < 1)
    (k E J : ℕ) (C A : ℝ) (hC : 1 ≤ C) (hA : 0 < A) :
    ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ L : ℝ, 0 ≤ L →
      ∀ (S : Finset ℕ), S ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
      ∀ w : ℕ → ℂ,
        (∀ n ∈ Finset.Icc 1 ⌈C * x⌉₊,
          ‖w n‖ ≤ L * x ^ (-η) * (n.divisors.card : ℝ) ^ k * (Real.log x) ^ E) →
        let f : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc 1 ⌈C * x⌉₊, Finsupp.single n (w n)
        (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy f q (a q)‖) ≤
          K * L * x / (Real.log x) ^ A := by
  classical
  obtain ⟨P, Kraw, X₀, hKraw, hX₀, haggregate⟩ :=
    sparse_factor_moduli_bound 0 θ le_rfl hθ0 (by simpa using hθ1) k J C hC
  have hsmall := (isLittleO_log_rpow_rpow_atTop (((P + E : ℕ) : ℝ) + A) hη).eventuallyLE
  obtain ⟨X₁, hX₁⟩ := hsmall.exists_forall_of_atTop
  refine ⟨Kraw, max X₀ X₁, hKraw, hX₀.trans (le_max_left _ _), ?_⟩
  intro x hx L hL S hS a ha w hw f
  have hxExp : Real.exp 1 ≤ x := hX₀.trans ((le_max_left _ _).trans hx)
  have hxPos : 0 < x := (Real.exp_pos 1).trans_le hxExp
  have hlogOne : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxPos).mpr hxExp
  have hlogPos : 0 < Real.log x := zero_lt_one.trans_le hlogOne
  let v : ℝ := L * x ^ (-η) * (Real.log x) ^ E
  have hv : 0 ≤ v := by dsimp only [v]; positivity
  have hcoeff : ∀ d ∈ ({1} : Finset ℕ),
      ∀ n ∈ Finset.Icc 1 ⌈C * (x / 1)⌉₊,
        ‖w n‖ ≤ v * (n.divisors.card : ℝ) ^ k := by
    intro d hd n hn
    simpa only [v, mul_assoc, mul_comm, mul_left_comm] using
      hw n (by simpa only [div_one] using hn)
  have hraw := haggregate x ((le_max_left _ _).trans hx) 1 le_rfl (by simp)
    S hS a ha {1} (fun _ n => w n) (fun _ => v) (fun _ _ => hv) hcoeff
  simp only [Finset.sum_singleton, one_mul, div_one] at hraw
  change (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy f q (a q)‖) ≤
    Kraw * x * (Real.log x) ^ P * v at hraw
  have hpower : (Real.log x) ^ (((P + E : ℕ) : ℝ) + A) ≤ x ^ η := by
    simpa only [Real.norm_of_nonneg (Real.rpow_nonneg hlogPos.le _),
      Real.norm_of_nonneg (Real.rpow_nonneg hxPos.le _)] using
        hX₁ x ((le_max_right _ _).trans hx)
  have hLA : 0 < (Real.log x) ^ A :=
    zero_lt_one.trans_le (Real.one_le_rpow hlogOne hA.le)
  have hratio : x ^ (-η) * (Real.log x) ^ (P + E) ≤ 1 / (Real.log x) ^ A := by
    apply (le_div_iff₀ hLA).mpr
    calc
      _ = x ^ (-η) * (Real.log x) ^ (((P + E : ℕ) : ℝ) + A) := by
        rw [Real.rpow_add hlogPos, Real.rpow_natCast]
        ring
      _ ≤ x ^ (-η) * x ^ η :=
        mul_le_mul_of_nonneg_left hpower (Real.rpow_nonneg hxPos.le _)
      _ = 1 := by rw [← Real.rpow_add hxPos]; simp
  calc
    _ ≤ Kraw * x * (Real.log x) ^ P * v := hraw
    _ = (Kraw * L * x) * (x ^ (-η) * (Real.log x) ^ (P + E)) := by
      dsimp only [v]
      rw [pow_add]
      ring
    _ ≤ (Kraw * L * x) * (1 / (Real.log x) ^ A) :=
      mul_le_mul_of_nonneg_left hratio (by positivity)
    _ = Kraw * L * x / (Real.log x) ^ A := by ring

theorem mul_inverse_residue_coprime (q a d : ℕ) (hq : 0 < q)
    (ha : Nat.Coprime a q) (hd : Nat.Coprime d q) :
    Nat.Coprime (((a : ZMod q) * (d : ZMod q)⁻¹).val) q := by
  let : NeZero q := ⟨hq.ne'⟩
  simpa only [Units.val_mul, ← ZMod.inv_coe_unit, ZMod.coe_unitOfCoprime] using
    ZMod.val_coe_unit_coprime
      (ZMod.unitOfCoprime a ha * (ZMod.unitOfCoprime d hd)⁻¹)

theorem fullDiscrepancy_mul_finite_family
    (q a : ℕ) (hq : 0 < q) (ha : Nat.Coprime a q)
    (D : Finset ℕ) (I : ℕ → Finset ℕ) (w : ℕ → ℕ → ℂ) :
    fullDiscrepancy
        (∑ d ∈ D, ∑ m ∈ I d, Finsupp.single (d * m) (w d m)) q a =
      ∑ d ∈ D.filter (fun d => Nat.Coprime d q),
        fullDiscrepancy (∑ m ∈ I d, Finsupp.single m (w d m)) q
          (((a : ZMod q) * (d : ZMod q)⁻¹).val) := by
  classical
  let : NeZero q := ⟨hq.ne'⟩
  let B : ℕ → ℕ := fun d => (((a : ZMod q) * (d : ZMod q)⁻¹).val)
  let kernel : ℕ → ℕ → ℂ := fun b n =>
    (if n % q = b % q then 1 else 0) -
      (if Nat.Coprime n q then 1 else 0) / (q.totient : ℂ)
  have hfull (u : ℕ →₀ ℂ) (b : ℕ) :
      fullDiscrepancy u q b = u.sum (fun n z => z * kernel b n) := by
    change fullDiscrepancy u q b = ∑ n ∈ u.support, u n * kernel b n
    simp only [fullDiscrepancy, progressionMass, reducedMass, kernel,
      div_eq_mul_inv, mul_sub, mul_ite, ite_mul, one_mul, mul_one,
      zero_mul, mul_zero, Finset.sum_sub_distrib, Finset.sum_mul]
  have hpair :
      fullDiscrepancy (∑ d ∈ D, ∑ m ∈ I d, Finsupp.single (d * m) (w d m)) q a =
        ∑ d ∈ D, ∑ m ∈ I d, w d m * kernel a (d * m) := by
    simp only [hfull, ← Finsupp.sum_finsetSum_index
      (h := fun n z => z * kernel a n)
      (fun _ => zero_mul _) (fun _ _ _ => add_mul _ _ _),
      Finsupp.sum_single_index (h := fun n z => z * kernel a n) (zero_mul _)]
  have hrow (d b : ℕ) :
      fullDiscrepancy (∑ m ∈ I d, Finsupp.single m (w d m)) q b =
        ∑ m ∈ I d, w d m * kernel b m :=
    fullDiscrepancy_indexed_sample (I d) id (w d) q b
  have hkernel (d m : ℕ) :
      kernel a (d * m) = if Nat.Coprime d q then kernel (B d) m else 0 := by
    by_cases hd : Nat.Coprime d q
    · have hmod : (d * m) % q = a % q ↔ m % q = (B d) % q := by
        dsimp only [B]
        rw [← ZMod.natCast_eq_natCast_iff', ← ZMod.natCast_eq_natCast_iff',
          ZMod.natCast_zmod_val, Nat.cast_mul]
        let u := ZMod.unitOfCoprime d hd
        change (u : ZMod q) * (m : ZMod q) = (a : ZMod q) ↔
          (m : ZMod q) = (a : ZMod q) * (u : ZMod q)⁻¹
        rw [ZMod.inv_coe_unit, mul_comm (a : ZMod q)]
        exact (Units.eq_inv_mul_iff_mul_eq (b := u)).symm
      have hcop : Nat.Coprime (d * m) q ↔ Nat.Coprime m q :=
        ⟨Nat.Coprime.coprime_mul_left, hd.mul_left⟩
      simp only [ite_eq_left hd, kernel, hmod, hcop]
    · have hprod : ¬ Nat.Coprime (d * m) q :=
        fun h => hd h.coprime_mul_right
      have hres : ¬ (d * m) % q = a % q := by
        intro h
        exact hprod ((show Nat.ModEq q (d * m) a from h).gcd_eq.trans ha)
      simp only [ite_eq_right hd, kernel, ite_eq_right hres, ite_eq_right hprod,
        zero_div, sub_self]
  rw [hpair, Finset.sum_filter]
  simp only [hkernel, mul_ite, mul_zero, Finset.sum_ite_irrel,
    Finset.sum_const_zero, hrow, B]

theorem short_cofactor_family_moduli_log_saving
    (γ θ : ℝ) (hγ : 0 ≤ γ) (hθ : 0 < θ) (hθγ : θ < 1 - γ)
    (k E J : ℕ) (C A : ℝ) (hC : 1 ≤ C) (hA : 0 < A) :
    ∃ D : ℕ, 1 ≤ D ∧ ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ N : ℝ, 1 ≤ N → N ≤ x ^ γ →
      ∀ (S : Finset ℕ), S ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
      ∀ (F : Finset ℕ) (v : ℕ → ℝ), (∀ d ∈ F, 0 ≤ v d) →
      ∀ lo hi : ℕ → ℕ,
        (∀ d ∈ F, 1 ≤ lo d ∧ lo d ≤ hi d ∧ hi d ≤ ⌈C * (x / N)⌉₊ + 1) →
        (∀ d ∈ F, ((hi d - lo d : ℕ) : ℝ) ≤ (x / N) / (Real.log x) ^ D) →
      ∀ w : ℕ → ℕ → ℂ,
        (∀ d ∈ F, ∀ m ∈ Finset.Ico (lo d) (hi d),
          ‖w d m‖ ≤ v d * (m.divisors.card : ℝ) ^ k * (Real.log x) ^ E) →
        let f : ℕ →₀ ℂ :=
          ∑ d ∈ F, ∑ m ∈ Finset.Ico (lo d) (hi d), Finsupp.single (d * m) (w d m)
        (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy f q (a q)‖) ≤
          K * (x / N) * (∑ d ∈ F, v d) / (Real.log x) ^ A := by
  classical
  let ρ : ℝ := 1 - γ
  have hρ : 0 < ρ := hθ.trans hθγ
  have hratio1 : θ / ρ < 1 := (div_lt_iff₀ hρ).mpr (by simpa only [one_mul] using hθγ)
  let κ : ℝ := (θ / ρ + 1) / 2
  have hκ0 : 0 < κ := by dsimp only [κ]; positivity
  have hκ1 : κ < 1 := by dsimp only [κ]; linarith only [hratio1]
  have hθκ : θ ≤ ρ * κ := by
    calc
      θ = ρ * (θ / ρ) := by field_simp [hρ.ne']
      _ ≤ ρ * κ := mul_le_mul_of_nonneg_left
        (by dsimp only [κ]; linarith only [hratio1]) hρ.le
  obtain ⟨D, hD, Kraw, X₀, hKraw, hX₀, hradial⟩ :=
    radial_short_interval_moduli_log_saving κ hκ0 hκ1 k E J C A hC hA
  let c : ℝ := 1 / ρ
  have hcOne : 1 ≤ c := (le_div_iff₀ hρ).mpr (by dsimp only [ρ]; linarith only [hγ])
  have hc : 0 < c := zero_lt_one.trans_le hcOne
  let K : ℝ := Kraw * c ^ E * c ^ A
  have hK : 0 < K := by dsimp only [K]; positivity
  have hlarge : ∀ᶠ x : ℝ in Filter.atTop, X₀ ≤ x ^ ρ :=
    (tendsto_rpow_atTop hρ).eventually_ge_atTop X₀
  obtain ⟨X₁, hX₁⟩ := hlarge.exists_forall_of_atTop
  refine ⟨D, hD, K, max (Real.exp 1) X₁, hK, le_max_left _ _, ?_⟩
  intro x hx N hNone hNupper S hS a ha F v hv lo hi hinterval hwidth w hw f
  have hxExp : Real.exp 1 ≤ x := (le_max_left _ _).trans hx
  have hxPos : 0 < x := (Real.exp_pos 1).trans_le hxExp
  have hxOne : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hxExp
  have hlogOne : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxPos).mpr hxExp
  have hlogPos : 0 < Real.log x := zero_lt_one.trans_le hlogOne
  have hNpos : 0 < N := zero_lt_one.trans_le hNone
  let M : ℝ := x / N
  have hMpos : 0 < M := div_pos hxPos hNpos
  have hMlower : x ^ ρ ≤ M := by
    calc
      x ^ ρ = x / x ^ γ := by
        dsimp only [ρ]
        rw [Real.rpow_sub hxPos, Real.rpow_one]
      _ ≤ x / N := div_le_div_of_nonneg_left hxPos.le hNpos hNupper
  have hMX : X₀ ≤ M := (hX₁ x ((le_max_right _ _).trans hx)).trans hMlower
  have hMexp : Real.exp 1 ≤ M := hX₀.trans hMX
  have hMlogOne : 1 ≤ Real.log M := (Real.le_log_iff_exp_le hMpos).mpr hMexp
  have hMlogPos : 0 < Real.log M := zero_lt_one.trans_le hMlogOne
  have hMupper : M ≤ x := div_le_self hxPos.le hNone
  have hMlogUpper : Real.log M ≤ Real.log x := Real.log_le_log hMpos hMupper
  have hMlogLower : ρ * Real.log x ≤ Real.log M := by
    simpa only [Real.log_rpow hxPos] using
      Real.log_le_log (Real.rpow_pos_of_pos hxPos ρ) hMlower
  have hlogScale : Real.log x ≤ c * Real.log M := by
    calc
      Real.log x = c * (ρ * Real.log x) := by dsimp only [c]; field_simp [hρ.ne']
      _ ≤ c * Real.log M := mul_le_mul_of_nonneg_left hMlogLower hc.le
  have hlogE : (Real.log x) ^ E ≤ c ^ E * (Real.log M) ^ E := by
    simpa only [mul_pow] using pow_le_pow_left₀ hlogPos.le hlogScale E
  have hlogA : (Real.log x) ^ A ≤ c ^ A * (Real.log M) ^ A := by
    simpa only [Real.mul_rpow hc.le hMlogPos.le] using
      Real.rpow_le_rpow hlogPos.le hlogScale hA.le
  have hLA : 0 < (Real.log x) ^ A := Real.rpow_pos_of_pos hlogPos A
  have hMA : 0 < (Real.log M) ^ A := Real.rpow_pos_of_pos hMlogPos A
  have hden : 1 / (Real.log M) ^ A ≤ c ^ A / (Real.log x) ^ A := by
    apply (div_le_div_iff₀ hMA hLA).mpr
    simpa only [one_mul] using hlogA
  let b : ℕ → ℕ → ℕ := fun d q => (((a q : ZMod q) * (d : ZMod q)⁻¹).val)
  let g : ℕ → ℕ →₀ ℂ := fun d =>
    ∑ m ∈ Finset.Ico (lo d) (hi d), Finsupp.single m (w d m)
  have hqM (q : ℕ) (hq : q ∈ S) : (q : ℝ) ≤ M ^ κ := by
    calc
      (q : ℝ) ≤ x ^ θ :=
        (Nat.cast_le.mpr (Finset.mem_Icc.mp (hS hq)).2).trans
          (Nat.floor_le (Real.rpow_nonneg hxPos.le _))
      _ ≤ x ^ (ρ * κ) := Real.rpow_le_rpow_of_exponent_le hxOne hθκ
      _ = (x ^ ρ) ^ κ := Real.rpow_mul hxPos.le _ _
      _ ≤ M ^ κ := Real.rpow_le_rpow (Real.rpow_nonneg hxPos.le _) hMlower hκ0.le
  have hrow (d : ℕ) (hd : d ∈ F) :
      (∑ q ∈ S.filter (fun q => Nat.Coprime d q),
        (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy (g d) q (b d q)‖) ≤
          K * M * v d / (Real.log x) ^ A := by
    have hvd : 0 ≤ v d := hv d hd
    let Sd := S.filter (fun q => Nat.Coprime d q)
    have hSd : Sd ⊆ Finset.Icc 1 ⌊M ^ κ⌋₊ := by
      intro q hq
      have hqS := (Finset.mem_filter.mp hq).1
      exact Finset.mem_Icc.mpr ⟨(Finset.mem_Icc.mp (hS hqS)).1, Nat.le_floor (hqM q hqS)⟩
    have hbc : ∀ q ∈ Sd, Nat.Coprime (b d q) q := by
      intro q hq
      obtain ⟨hqS, hdq⟩ := Finset.mem_filter.mp hq
      exact mul_inverse_residue_coprime q (a q) d
        (Finset.mem_Icc.mp (hS hqS)).1 (ha q hqS) hdq
    have hwidthM : ((hi d - lo d : ℕ) : ℝ) ≤ M / (Real.log M) ^ D :=
      (hwidth d hd).trans
        (div_le_div_of_nonneg_left hMpos.le (pow_pos hMlogPos D)
          (pow_le_pow_left₀ hMlogPos.le hMlogUpper D))
    have hcoeff : ∀ m ∈ Finset.Ico (lo d) (hi d),
        ‖w d m‖ ≤ (v d * c ^ E) * (m.divisors.card : ℝ) ^ k * (Real.log M) ^ E := by
      intro m hm
      calc
        _ ≤ v d * (m.divisors.card : ℝ) ^ k * (Real.log x) ^ E := hw d hd m hm
        _ ≤ v d * (m.divisors.card : ℝ) ^ k * (c ^ E * (Real.log M) ^ E) :=
          mul_le_mul_of_nonneg_left hlogE (mul_nonneg (hv d hd) (by positivity))
        _ = _ := by ring
    have hh := hradial M hMX (v d * c ^ E) (mul_nonneg (hv d hd) (pow_nonneg hc.le E))
      (lo d) (hi d) (hinterval d hd).1 (hinterval d hd).2.1 (hinterval d hd).2.2
        hwidthM Sd hSd (b d) hbc (w d) hcoeff
    calc
      _ ≤ Kraw * (v d * c ^ E) * M / (Real.log M) ^ A := hh
      _ = (Kraw * (v d * c ^ E) * M) * (1 / (Real.log M) ^ A) := by ring
      _ ≤ (Kraw * (v d * c ^ E) * M) * (c ^ A / (Real.log x) ^ A) :=
        mul_le_mul_of_nonneg_left hden (by positivity)
      _ = K * M * v d / (Real.log x) ^ A := by dsimp only [K]; ring
  have hpoint (q : ℕ) (hq : q ∈ S) :
      (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy f q (a q)‖ ≤
        ∑ d ∈ F, if Nat.Coprime d q then
          (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy (g d) q (b d q)‖ else 0 := by
    have hfinite := fullDiscrepancy_mul_finite_family q (a q)
      (Finset.mem_Icc.mp (hS hq)).1 (ha q hq) F
        (fun d => Finset.Ico (lo d) (hi d)) w
    change fullDiscrepancy f q (a q) =
      ∑ d ∈ F.filter (fun d => Nat.Coprime d q), fullDiscrepancy (g d) q (b d q) at hfinite
    rw [hfinite]
    calc
      _ ≤ (q.divisors.card : ℝ) ^ J *
          ∑ d ∈ F.filter (fun d => Nat.Coprime d q), ‖fullDiscrepancy (g d) q (b d q)‖ :=
        mul_le_mul_of_nonneg_left (norm_sum_le _ _) (by positivity)
      _ = _ := by rw [Finset.mul_sum, Finset.sum_filter]
  calc
    _ ≤ ∑ q ∈ S, ∑ d ∈ F, if Nat.Coprime d q then
        (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy (g d) q (b d q)‖ else 0 :=
      Finset.sum_le_sum hpoint
    _ = ∑ d ∈ F, ∑ q ∈ S.filter (fun q => Nat.Coprime d q),
        (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy (g d) q (b d q)‖ := by
      rw [Finset.sum_comm]
      simp only [Finset.sum_filter]
    _ ≤ ∑ d ∈ F, K * M * v d / (Real.log x) ^ A := Finset.sum_le_sum hrow
    _ = K * (x / N) * (∑ d ∈ F, v d) / (Real.log x) ^ A := by
      rw [← Finset.sum_div, ← Finset.mul_sum]

theorem three_mangoldt_mellin_fullDiscrepancy_transfer
    {ι : Type*} (S : Finset ι) (p : ι → Fin 3 → ℕ)
    (hp : ∀ i ∈ S, ∀ j, 0 < p i j) (n : ι → ℕ) (z : ι → ℂ)
    (Q : Finset ℕ) (a : ℕ → ℕ) (W : ℕ → ℝ) (hW : ∀ q ∈ Q, 0 ≤ W q)
    (B : ℝ)
    (hbound : ∀ t ∈ Set.Icc (0 : ℝ) 10, ∀ u ∈ Set.Icc (0 : ℝ) 10,
      ∀ v ∈ Set.Icc (0 : ℝ) 10,
        let f : ℕ →₀ ℂ := ∑ i ∈ S, Finsupp.single (n i)
          ((∏ j, ArithmeticFunction.vonMangoldt (p i j) *
            (p i j : ℝ) ^ (-(![t, u, v] j))) • z i)
        (∑ q ∈ Q, W q * ‖fullDiscrepancy f q (a q)‖) ≤ B) :
    let f : ℕ →₀ ℂ := ∑ i ∈ S, Finsupp.single (n i)
      ((∏ j, minorantMangoldtMellinWeight (p i j)) • z i)
    (∑ q ∈ Q, W q * ‖fullDiscrepancy f q (a q)‖) ≤ 1000 * B := by
  classical
  let kernel : ℕ → ℕ → ℂ := fun q m =>
    (if m % q = a q % q then 1 else 0) -
      (if Nat.Coprime m q then 1 else 0) / (q.totient : ℂ)
  have hsample (b : ι → ℝ) (q : ℕ) :
      fullDiscrepancy (∑ i ∈ S, Finsupp.single (n i) (b i • z i)) q (a q) =
        ∑ i ∈ S, b i • (z i * kernel q (n i)) := by
    simpa only [kernel, smul_mul_assoc] using
      fullDiscrepancy_indexed_sample S n (fun i => b i • z i) q (a q)
  let c : ι → (q : ↥Q) → ℂ := fun i q => W q • (z i * kernel q (n i))
  have hnorm (b : ι → ℝ) :
      (∑ q : ↥Q, ‖∑ i ∈ S, b i • c i q‖) =
        ∑ q ∈ Q, W q * ‖fullDiscrepancy
          (∑ i ∈ S, Finsupp.single (n i) (b i • z i)) q (a q)‖ := by
    rw [← Finset.sum_coe_sort Q (fun q => W q * ‖fullDiscrepancy
      (∑ i ∈ S, Finsupp.single (n i) (b i • z i)) q (a q)‖)]
    apply Finset.sum_congr rfl
    intro q hq
    have hcomm : (∑ i ∈ S, b i • c i q) =
        W q • ∑ i ∈ S, b i • (z i * kernel q (n i)) := by
      rw [Finset.smul_sum]
      exact Finset.sum_congr rfl fun i _ => smul_comm _ _ _
    rw [hcomm, norm_smul, Real.norm_of_nonneg (hW q q.property), ← hsample]
  dsimp only
  rw [← hnorm]
  apply three_mangoldt_mellin_sum_norm_transfer S p hp c B
  intro t ht u hu v hv
  rw [hnorm]
  exact hbound t ht u hu v hv

theorem original_factor_short_interval_moduli_log_saving
    (η γ θ : ℝ) (hη : 0 < η) (hγ : 0 < γ) (hηγ : η ≤ γ)
    (hθ : 0 < θ) (hθγ : θ < 1 - γ) (k₁ k₂ E J : ℕ)
    (C A : ℝ) (hC : 1 ≤ C) (hA : 0 < A) :
    ∃ D : ℕ, 1 ≤ D ∧ ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ L : ℝ, 0 ≤ L →
      ∀ N : ℝ, x ^ η ≤ N → N ≤ x ^ γ →
      ∀ lo hi : ℕ, 1 ≤ lo → lo ≤ hi → hi ≤ ⌈C * N⌉₊ + 1 →
        ((hi - lo : ℕ) : ℝ) ≤ N / (Real.log x) ^ D →
      ∀ S : Finset ℕ, S ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
      ∀ w : ℕ → ℕ → ℂ,
        (∀ d ∈ Finset.Ico lo hi, ∀ m ∈ Finset.Icc 1 ⌈C * (x / N)⌉₊,
          ‖w d m‖ ≤ L * (d.divisors.card : ℝ) ^ k₁ *
            (m.divisors.card : ℝ) ^ k₂ * (Real.log x) ^ E) →
        let f : ℕ →₀ ℂ :=
          ∑ d ∈ Finset.Ico lo hi, ∑ m ∈ Finset.Icc 1 ⌈C * (x / N)⌉₊,
            Finsupp.single (d * m) (w d m)
        (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy f q (a q)‖) ≤
          K * L * x / (Real.log x) ^ A := by
  classical
  obtain ⟨P, K₀, X₀, hK₀, hX₀, hAP⟩ :=
    sparse_factor_moduli_bound γ θ hγ.le hθ hθγ k₂ J C hC
  let A' : ℝ := A + (P : ℝ) + E
  have hA' : 0 < A' := by dsimp only [A']; positivity
  obtain ⟨D, hD, K₁, X₁, hK₁, hX₁, hmass⟩ :=
    short_interval_divisor_mass_log_saving η γ hη hγ hηγ k₁ C A' hC hA'
  refine ⟨D, hD, K₀ * K₁, max X₀ X₁, mul_pos hK₀ hK₁,
    hX₀.trans (le_max_left _ _), ?_⟩
  intro x hx L hL N hNlo hNhi lo hi hlo hlohi hhi hwidth S hS a ha w hw f
  have hx₀ : X₀ ≤ x := (le_max_left _ _).trans hx
  have hx₁ : X₁ ≤ x := (le_max_right _ _).trans hx
  have hxExp : Real.exp 1 ≤ x := hX₀.trans hx₀
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxExp
  have hxone : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hxExp
  have hlogone : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxpos).mpr hxExp
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlogone
  have hNone : 1 ≤ N := (Real.one_le_rpow hxone hη.le).trans hNlo
  have hNpos : 0 < N := zero_lt_one.trans_le hNone
  let v : ℕ → ℝ := fun d => L * (Real.log x) ^ E * (d.divisors.card : ℝ) ^ k₁
  have hv (d : ℕ) (_ : d ∈ Finset.Ico lo hi) : 0 ≤ v d := by
    dsimp only [v]
    positivity
  have hw' (d : ℕ) (hd : d ∈ Finset.Ico lo hi)
      (m : ℕ) (hm : m ∈ Finset.Icc 1 ⌈C * (x / N)⌉₊) :
      ‖w d m‖ ≤ v d * (m.divisors.card : ℝ) ^ k₂ := by
    convert hw d hd m hm using 1
    dsimp only [v]
    ring
  have hraw := hAP x hx₀ N hNone hNhi S hS a ha (Finset.Ico lo hi) w v hv hw'
  have hvsum : (∑ d ∈ Finset.Ico lo hi, v d) ≤
      L * (Real.log x) ^ E * (K₁ * N / (Real.log x) ^ A') := by
    dsimp only [v]
    rw [← Finset.mul_sum]
    exact mul_le_mul_of_nonneg_left
      (hmass x hx₁ N hNlo hNhi lo hi hlo hlohi hhi hwidth) (by positivity)
  have hpow : (Real.log x) ^ A' =
      (Real.log x) ^ A * (Real.log x) ^ P * (Real.log x) ^ E := by
    dsimp only [A']
    rw [Real.rpow_add hlogpos, Real.rpow_add hlogpos, Real.rpow_natCast,
      Real.rpow_natCast]
  calc
    _ ≤ K₀ * (x / N) * (Real.log x) ^ P * ∑ d ∈ Finset.Ico lo hi, v d := hraw
    _ ≤ K₀ * (x / N) * (Real.log x) ^ P *
        (L * (Real.log x) ^ E * (K₁ * N / (Real.log x) ^ A')) :=
      mul_le_mul_of_nonneg_left hvsum (by positivity)
    _ = _ := by
      rw [hpow]
      field_simp [hNpos.ne', (Real.rpow_pos_of_pos hlogpos A).ne',
        (pow_pos hlogpos P).ne', (pow_pos hlogpos E).ne']

theorem three_tuple_cyclic_product (p : Fin 3 → ℕ) (i : Fin 3) :
    (∏ j, p j) = p i * (p (i + 1) * p (i + 2)) := by
  fin_cases i <;> simp [Fin.prod_univ_three, mul_comm, mul_assoc]
  ring

theorem three_tuple_designated_fiber_card_le
    (T : Finset (Fin 3 → ℕ)) (hpos : ∀ p ∈ T, ∀ i, 0 < p i)
    (i : Fin 3) (d m : ℕ) :
    (T.filter (fun p => p i = d ∧ p (i + 1) * p (i + 2) = m)).card ≤
      m.divisors.card := by
  classical
  apply Finset.card_le_card_of_injOn (fun p : Fin 3 → ℕ => p (i + 1))
  · intro p hp
    obtain ⟨hpT, hpi, hprod⟩ := Finset.mem_filter.mp hp
    apply Nat.mem_divisors.mpr
    refine ⟨?_, ?_⟩
    · rw [← hprod]
      exact dvd_mul_right _ _
    · rw [← hprod]
      exact (Nat.mul_pos (hpos p hpT _) (hpos p hpT _)).ne'
  · intro p hp s hs heq
    change p (i + 1) = s (i + 1) at heq
    obtain ⟨hpT, hpi, hpm⟩ := Finset.mem_filter.mp hp
    obtain ⟨hsT, hsi, hsm⟩ := Finset.mem_filter.mp hs
    have hfirst : p i = s i := hpi.trans hsi.symm
    have hlast : p (i + 2) = s (i + 2) := by
      apply Nat.eq_of_mul_eq_mul_left (hpos p hpT (i + 1))
      calc
        p (i + 1) * p (i + 2) = m := hpm
        _ = s (i + 1) * s (i + 2) := hsm.symm
        _ = p (i + 1) * s (i + 2) := by rw [heq]
    funext j
    have hj : j = i ∨ j = i + 1 ∨ j = i + 2 := by
      fin_cases i <;> fin_cases j <;> decide
    rcases hj with rfl | rfl | rfl
    · exact hfirst
    · exact heq
    · exact hlast

theorem three_tuple_designated_finite_reindex
    (T : Finset (Fin 3 → ℕ)) (hpos : ∀ p ∈ T, ∀ i, 0 < p i)
    (i : Fin 3) (M : ℕ)
    (hM : ∀ p ∈ T, p (i + 1) * p (i + 2) ≤ M) (z : (Fin 3 → ℕ) → ℂ) :
    (∑ p ∈ T, Finsupp.single (∏ j, p j) (z p) : ℕ →₀ ℂ) =
      ∑ d ∈ T.image (fun p => p i), ∑ m ∈ Finset.Icc 1 M,
        Finsupp.single (d * m)
          (∑ p ∈ T.filter (fun p => p i = d ∧ p (i + 1) * p (i + 2) = m), z p) := by
  classical
  calc
    _ = ∑ d ∈ T.image (fun p => p i),
        ∑ p ∈ T.filter (fun p => p i = d), Finsupp.single (∏ j, p j) (z p) :=
      (Finset.sum_fiberwise_of_maps_to
        (fun p hp => Finset.mem_image_of_mem (fun p => p i) hp) _).symm
    _ = ∑ d ∈ T.image (fun p => p i), ∑ m ∈ Finset.Icc 1 M,
        ∑ p ∈ (T.filter (fun p => p i = d)).filter
          (fun p => p (i + 1) * p (i + 2) = m),
            Finsupp.single (∏ j, p j) (z p) := by
      apply Finset.sum_congr rfl
      intro d hd
      apply (Finset.sum_fiberwise_of_maps_to ?_ _).symm
      intro p hp
      have hpT := (Finset.mem_filter.mp hp).1
      exact Finset.mem_Icc.mpr
        ⟨Nat.mul_pos (hpos p hpT _) (hpos p hpT _), hM p hpT⟩
    _ = _ := by
      simp only [Finset.filter_filter]
      apply Finset.sum_congr rfl
      intro d hd
      apply Finset.sum_congr rfl
      intro m hm
      rw [Finsupp.single_finsetSum]
      apply Finset.sum_congr rfl
      intro p hp
      obtain ⟨hpT, hpd, hpm⟩ := Finset.mem_filter.mp hp
      rw [three_tuple_cyclic_product p i, hpd, hpm]

theorem fullDiscrepancy_finset_sum {ι : Type*} (S : Finset ι)
    (f : ι → ℕ →₀ ℂ) (q a : ℕ) :
    fullDiscrepancy (∑ i ∈ S, f i) q a = ∑ i ∈ S, fullDiscrepancy (f i) q a := by
  classical
  let kernel : ℕ → ℂ := fun n =>
    (if n % q = a % q then 1 else 0) -
      (if Nat.Coprime n q then 1 else 0) / (q.totient : ℂ)
  have hfull (u : ℕ →₀ ℂ) :
      fullDiscrepancy u q a = u.sum (fun n z => z * kernel n) := by
    change fullDiscrepancy u q a = ∑ n ∈ u.support, u n * kernel n
    simp only [fullDiscrepancy, progressionMass, reducedMass, kernel,
      div_eq_mul_inv, mul_sub, mul_ite, ite_mul, one_mul, mul_one,
      zero_mul, mul_zero, Finset.sum_sub_distrib, Finset.sum_mul]
  simp only [hfull]
  rw [← Finsupp.sum_finsetSum_index (fun _ => zero_mul _) (fun _ _ _ => add_mul _ _ _)]

theorem three_tuple_prime_power_moduli_log_saving
    (η γ θ : ℝ) (hη : 0 < η) (hγ : 0 ≤ γ) (hθ : 0 < θ) (hθγ : θ < 1 - γ)
    (J : ℕ) (C A : ℝ) (hC : 1 ≤ C) (hA : 0 < A) :
    ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ L : ℝ, 0 ≤ L →
      ∀ N : Fin 3 → ℝ, (∀ i, x ^ η ≤ N i ∧ N i ≤ x ^ γ) →
      ∀ (S : Finset ℕ), S ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
      ∀ T : Finset (Fin 3 → ℕ),
        (∀ p ∈ T, ∀ i, N i ≤ (p i : ℝ) ∧ (p i : ℝ) ≤ C * N i) →
        (∀ p ∈ T, ((∏ i, p i : ℕ) : ℝ) ≤ C * x) →
      ∀ z : (Fin 3 → ℕ) → ℂ, (∀ p ∈ T, ‖z p‖ ≤ L) →
        let f : ℕ →₀ ℂ := ∑ p ∈ T, Finsupp.single (∏ i, p i)
          (((∏ i, ArithmeticFunction.vonMangoldt (p i) / Real.log (p i : ℝ)) -
            ∏ i, if (p i).Prime then (1 : ℝ) else 0) • z p)
        (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy f q (a q)‖) ≤
          K * L * x / (Real.log x) ^ A := by
  classical
  obtain ⟨Kraw, X₀, hKraw, hX₀, hproper⟩ :=
    proper_prime_power_factor_moduli_log_saving η γ θ hη hγ hθ hθγ 1 0 J C A hC hA
  obtain ⟨X₁, hX₁⟩ := ((tendsto_rpow_atTop hη).eventually_ge_atTop 2).exists_forall_of_atTop
  refine ⟨3 * Kraw, max X₀ X₁, mul_pos (by norm_num) hKraw,
    hX₀.trans (le_max_left _ _), ?_⟩
  intro x hx L hL N hN S hS a ha T hT hprod z hz f
  have hxExp : Real.exp 1 ≤ x := hX₀.trans ((le_max_left _ _).trans hx)
  have hxPos : 0 < x := (Real.exp_pos 1).trans_le hxExp
  have hNtwo (i : Fin 3) : 2 ≤ N i :=
    (hX₁ x ((le_max_right _ _).trans hx)).trans (hN i).1
  have hpTwo (p : Fin 3 → ℕ) (hp : p ∈ T) (i : Fin 3) : 2 ≤ p i := by
    exact_mod_cast (hNtwo i).trans (hT p hp i).1
  have hpPos : ∀ p ∈ T, ∀ i, 0 < p i := fun p hp i =>
    lt_of_lt_of_le (by decide) (hpTwo p hp i)
  let α : ℕ → ℝ := fun n => ArithmeticFunction.vonMangoldt n / Real.log (n : ℝ)
  let β : ℕ → ℝ := fun n => if n.Prime then 1 else 0
  let c : Fin 3 → (Fin 3 → ℕ) → ℝ := fun i p =>
    ![minorantProperPrimePowerWeight (p 0) * α (p 1) * α (p 2),
      β (p 0) * minorantProperPrimePowerWeight (p 1) * α (p 2),
      β (p 0) * β (p 1) * minorantProperPrimePowerWeight (p 2)] i
  have hα (p : Fin 3 → ℕ) (hp : p ∈ T) (i : Fin 3) :
      0 ≤ α (p i) ∧ α (p i) ≤ 1 := by
    have h := minorantMangoldtMellinWeight_bounds (p i) (hpTwo p hp i)
    exact ⟨h.1.trans h.2.1, h.2.2.1⟩
  have hβ (n : ℕ) : 0 ≤ β n ∧ β n ≤ 1 := by
    dsimp only [β]
    split_ifs <;> norm_num
  have htriple (u v w : ℝ) (hu : 0 ≤ u)
      (hv : 0 ≤ v ∧ v ≤ 1) (hw : 0 ≤ w ∧ w ≤ 1) :
      0 ≤ u * v * w ∧ u * v * w ≤ u := by
    refine ⟨mul_nonneg (mul_nonneg hu hv.1) hw.1, ?_⟩
    have hfirst : u * v ≤ u := by
      simpa only [mul_one] using (mul_le_mul_of_nonneg_left hv.2 hu)
    simpa only [mul_one] using (mul_le_mul hfirst hw.2 hw.1 hu)
  have hc (i : Fin 3) (p : Fin 3 → ℕ) (hp : p ∈ T) :
      0 ≤ c i p ∧ c i p ≤ minorantProperPrimePowerWeight (p i) := by
    fin_cases i
    · simpa [c] using htriple _ _ _ (minorantProperPrimePowerWeight_nonneg (p 0))
        (hα p hp 1) (hα p hp 2)
    · simpa [c, mul_comm, mul_left_comm, mul_assoc] using
        htriple _ _ _ (minorantProperPrimePowerWeight_nonneg (p 1)) (hβ (p 0)) (hα p hp 2)
    · simpa [c, mul_comm, mul_left_comm, mul_assoc] using
        htriple _ _ _ (minorantProperPrimePowerWeight_nonneg (p 2)) (hβ (p 0)) (hβ (p 1))
  have hsplit (p : Fin 3 → ℕ) :
      (∏ i, α (p i)) - ∏ i, β (p i) = ∑ i, c i p := by
    rw [Fin.prod_univ_three, Fin.prod_univ_three, Fin.sum_univ_three]
    change α (p 0) * α (p 1) * α (p 2) - β (p 0) * β (p 1) * β (p 2) =
      minorantProperPrimePowerWeight (p 0) * α (p 1) * α (p 2) +
        β (p 0) * minorantProperPrimePowerWeight (p 1) * α (p 2) +
        β (p 0) * β (p 1) * minorantProperPrimePowerWeight (p 2)
    have hid (n : ℕ) : α n = β n + minorantProperPrimePowerWeight n :=
      minorantProperPrimePowerWeight_identity n
    rw [hid (p 0), hid (p 1), hid (p 2)]
    ring
  let fᵢ : Fin 3 → ℕ →₀ ℂ := fun i =>
    ∑ p ∈ T, Finsupp.single (∏ j, p j) (c i p • z p)
  have hf : f = ∑ i, fᵢ i := by
    dsimp only [f, fᵢ]
    change (∑ p ∈ T, Finsupp.single (∏ j, p j)
      (((∏ i, α (p i)) - ∏ i, β (p i)) • z p)) = _
    simp only [hsplit, Finset.sum_smul, Finsupp.single_finsetSum]
    rw [Finset.sum_comm]
  have hfi (i : Fin 3) :
      (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy (fᵢ i) q (a q)‖) ≤
        Kraw * L * x / (Real.log x) ^ A := by
    let D := T.image (fun p => p i)
    let M : ℕ := ⌈C * (x / N i)⌉₊
    let W : ℕ → ℕ → ℂ := fun d m =>
      ∑ p ∈ T.filter (fun p => p i = d ∧ p (i + 1) * p (i + 2) = m), c i p • z p
    have hD : ∀ d ∈ D, N i ≤ (d : ℝ) ∧ (d : ℝ) ≤ C * N i := by
      intro d hd
      obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hd
      exact hT p hp i
    have hNiPos : 0 < N i := lt_of_lt_of_le (by norm_num) (hNtwo i)
    have hM : ∀ p ∈ T, p (i + 1) * p (i + 2) ≤ M := by
      intro p hp
      have hm : ((p (i + 1) * p (i + 2) : ℕ) : ℝ) ≤ C * (x / N i) := by
        calc
          _ ≤ C * x / N i := by
            apply (le_div_iff₀ hNiPos).mpr
            calc
              _ ≤ ((p (i + 1) * p (i + 2) : ℕ) : ℝ) * (p i : ℝ) :=
                mul_le_mul_of_nonneg_left (hT p hp i).1 (Nat.cast_nonneg _)
              _ = ((∏ j, p j : ℕ) : ℝ) := by
                rw [three_tuple_cyclic_product p i]
                push_cast
                ring
              _ ≤ C * x := hprod p hp
          _ = _ := by ring
      exact_mod_cast hm.trans (Nat.le_ceil _)
    have hW : ∀ d ∈ D, ∀ m ∈ Finset.Icc 1 M,
        ‖W d m‖ ≤ L * minorantProperPrimePowerWeight d *
          (m.divisors.card : ℝ) ^ 1 * (Real.log x) ^ 0 := by
      intro d hd m hm
      let U := T.filter (fun p => p i = d ∧ p (i + 1) * p (i + 2) = m)
      have hterm (p : Fin 3 → ℕ) (hp : p ∈ U) :
          ‖c i p • z p‖ ≤ L * minorantProperPrimePowerWeight d := by
        obtain ⟨hpT, hpd, hpm⟩ := Finset.mem_filter.mp hp
        rw [norm_smul, Real.norm_eq_abs, abs_of_nonneg (hc i p hpT).1]
        calc
          _ ≤ minorantProperPrimePowerWeight (p i) * L :=
            mul_le_mul (hc i p hpT).2 (hz p hpT) (norm_nonneg _)
              (minorantProperPrimePowerWeight_nonneg _)
          _ = _ := by rw [hpd]; ring
      have hcard : (U.card : ℝ) ≤ m.divisors.card := by
        exact_mod_cast three_tuple_designated_fiber_card_le T hpPos i d m
      calc
        _ ≤ ∑ _p ∈ U, L * minorantProperPrimePowerWeight d := norm_sum_le_of_le U hterm
        _ = (U.card : ℝ) * (L * minorantProperPrimePowerWeight d) := by
          rw [Finset.sum_const, nsmul_eq_mul]
        _ ≤ (m.divisors.card : ℝ) * (L * minorantProperPrimePowerWeight d) :=
          mul_le_mul_of_nonneg_right hcard
            (mul_nonneg hL (minorantProperPrimePowerWeight_nonneg _))
        _ = _ := by rw [pow_one, pow_zero]; ring
    have hrepr : fᵢ i = ∑ d ∈ D, ∑ m ∈ Finset.Icc 1 M, Finsupp.single (d * m) (W d m) :=
      three_tuple_designated_finite_reindex T hpPos i M hM (fun p => c i p • z p)
    have hraw := hproper x ((le_max_left _ _).trans hx) L hL (N i) (hN i).1 (hN i).2
      S hS a ha D hD W hW
    change (∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
      ‖fullDiscrepancy (∑ d ∈ D, ∑ m ∈ Finset.Icc 1 M,
        Finsupp.single (d * m) (W d m)) q (a q)‖) ≤ _ at hraw
    rwa [← hrepr] at hraw
  have hpoint (q : ℕ) :
      (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy f q (a q)‖ ≤
        ∑ i : Fin 3, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy (fᵢ i) q (a q)‖ := by
    rw [hf, fullDiscrepancy_finset_sum]
    calc
      _ ≤ (q.divisors.card : ℝ) ^ J * ∑ i : Fin 3, ‖fullDiscrepancy (fᵢ i) q (a q)‖ :=
        mul_le_mul_of_nonneg_left (norm_sum_le _ _) (by positivity)
      _ = _ := Finset.mul_sum _ _ _
  calc
    _ ≤ ∑ q ∈ S, ∑ i : Fin 3,
        (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy (fᵢ i) q (a q)‖ :=
      Finset.sum_le_sum fun q hq => hpoint q
    _ = ∑ i : Fin 3, ∑ q ∈ S,
        (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy (fᵢ i) q (a q)‖ := Finset.sum_comm
    _ ≤ ∑ _i : Fin 3, Kraw * L * x / (Real.log x) ^ A :=
      Finset.sum_le_sum fun i hi => hfi i
    _ = (3 * Kraw) * L * x / (Real.log x) ^ A := by
      simp only [Finset.sum_const, Finset.card_univ, Fintype.card_fin, nsmul_eq_mul]
      ring

theorem three_tuple_mellin_tail_moduli_log_saving
    (η θ : ℝ) (hη : 0 < η) (hθ0 : 0 < θ) (hθ1 : θ < 1)
    (J : ℕ) (C A : ℝ) (hC : 1 ≤ C) (hA : 0 < A) :
    ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ L : ℝ, 0 ≤ L →
      ∀ T : Finset (Fin 3 → ℕ),
        (∀ p ∈ T, (∀ i, x ^ η ≤ (p i : ℝ)) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ C * x) →
      ∀ z : (Fin 3 → ℕ) → ℂ, (∀ p ∈ T, ‖z p‖ ≤ L) →
      ∀ S : Finset ℕ, S ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
        let f : ℕ →₀ ℂ := ∑ p ∈ T, Finsupp.single (∏ i, p i)
          (((∏ i, ArithmeticFunction.vonMangoldt (p i) / Real.log (p i : ℝ)) -
            ∏ i, minorantMangoldtMellinWeight (p i)) • z p)
        (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy f q (a q)‖) ≤
          K * L * x / (Real.log x) ^ A := by
  classical
  obtain ⟨K₀, X₀, hK₀, hX₀, hAP⟩ :=
    power_coefficient_moduli_log_saving (10 * η) θ (by positivity) hθ0 hθ1
      2 0 J C A hC hA
  obtain ⟨X₁, hX₁⟩ := ((tendsto_rpow_atTop hη).eventually_ge_atTop (2 : ℝ)).exists_forall_of_atTop
  refine ⟨3 * K₀, max X₀ X₁, mul_pos (by norm_num) hK₀,
    hX₀.trans (le_max_left _ _), ?_⟩
  intro x hx L hL T hT z hz S hS a ha f
  have hx₀ : X₀ ≤ x := (le_max_left _ _).trans hx
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le (hX₀.trans hx₀)
  have hlarge : 2 ≤ x ^ η := hX₁ x ((le_max_right _ _).trans hx)
  have hp (p : Fin 3 → ℕ) (hpT : p ∈ T) (i : Fin 3) : 2 ≤ p i := by
    exact_mod_cast hlarge.trans ((hT p hpT).1 i)
  have hpos (p : Fin 3 → ℕ) (hpT : p ∈ T) (i : Fin 3) : 0 < p i := by
    have := hp p hpT i
    omega
  let e : (Fin 3 → ℕ) → ℝ := fun p =>
    (∏ i, ArithmeticFunction.vonMangoldt (p i) / Real.log (p i : ℝ)) -
      ∏ i, minorantMangoldtMellinWeight (p i)
  have he (p : Fin 3 → ℕ) (hpT : p ∈ T) :
      ‖e p • z p‖ ≤ 3 * L * x ^ (-(10 * η)) := by
    have hnonneg := (three_mangoldt_mellin_tail p (hp p hpT)).1
    have htail := three_mangoldt_mellin_tail_rpow x η hxpos p (hp p hpT) (hT p hpT).1
    rw [norm_smul, Real.norm_of_nonneg hnonneg]
    calc
      _ ≤ (3 * x ^ (-10 * η)) * L :=
        mul_le_mul htail (hz p hpT) (norm_nonneg _) (by positivity)
      _ = _ := by rw [neg_mul]; ring
  have hf (n : ℕ) : f n = ∑ p ∈ T.filter (fun p => ∏ i, p i = n), e p • z p := by
    simp only [f, Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_filter, e]
  have hcoeff (n : ℕ) :
      ‖f n‖ ≤ (3 * L) * x ^ (-(10 * η)) * (n.divisors.card : ℝ) ^ 2 * (Real.log x) ^ 0 := by
    rw [hf]
    calc
      _ ≤ ∑ _p ∈ T.filter (fun p => ∏ i, p i = n), 3 * L * x ^ (-(10 * η)) :=
        norm_sum_le_of_le _ (fun p hpT => he p (Finset.mem_filter.mp hpT).1)
      _ = ((T.filter (fun p => ∏ i, p i = n)).card : ℝ) *
          (3 * L * x ^ (-(10 * η))) := by simp
      _ ≤ (n.divisors.card : ℝ) ^ 2 * (3 * L * x ^ (-(10 * η))) :=
        mul_le_mul_of_nonneg_right (by exact_mod_cast three_tuple_product_fiber_card_le T hpos n)
          (by positivity)
      _ = _ := by simp only [pow_zero, mul_one]; ring
  let I : Finset ℕ := Finset.Icc 1 ⌈C * x⌉₊
  have hprodmem (p : Fin 3 → ℕ) (hpT : p ∈ T) : (∏ i, p i) ∈ I := by
    apply Finset.mem_Icc.mpr
    refine ⟨Finset.prod_pos (fun i _ => hpos p hpT i), ?_⟩
    exact_mod_cast (hT p hpT).2.trans (Nat.le_ceil (C * x))
  have hzero (n : ℕ) (hn : n ∉ I) : f n = 0 := by
    rw [hf]
    apply Finset.sum_eq_zero
    intro p hpT
    obtain ⟨hpT, hpn⟩ := Finset.mem_filter.mp hpT
    exact False.elim (hn (hpn ▸ hprodmem p hpT))
  have hreconstruct : (∑ n ∈ I, Finsupp.single n (f n)) = f :=
    (Finsupp.sum_of_support_subset f
      (Finsupp.support_subset_iff.mpr hzero) Finsupp.single
      (fun n _ => Finsupp.single_zero n)).symm.trans (Finsupp.sum_single f)
  have hraw := hAP x hx₀ (3 * L) (by positivity) S hS a ha f (fun n _ => hcoeff n)
  change (∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
    ‖fullDiscrepancy (∑ n ∈ I, Finsupp.single n (f n)) q (a q)‖) ≤ _ at hraw
  rw [hreconstruct] at hraw
  convert hraw using 1
  ring

theorem three_prime_mellin_moduli_transfer
    (η γ θ : ℝ) (hη : 0 < η) (hγ : 0 ≤ γ) (hθ : 0 < θ) (hθγ : θ < 1 - γ)
    (J : ℕ) (C A : ℝ) (hC : 1 ≤ C) (hA : 0 < A) :
    ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ L : ℝ, 0 ≤ L →
      ∀ N : Fin 3 → ℝ, (∀ i, x ^ η ≤ N i ∧ N i ≤ x ^ γ) →
      ∀ (S : Finset ℕ), S ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
      ∀ T : Finset (Fin 3 → ℕ),
        (∀ p ∈ T, ∀ i, N i ≤ (p i : ℝ) ∧ (p i : ℝ) ≤ C * N i) →
        (∀ p ∈ T, ((∏ i, p i : ℕ) : ℝ) ≤ C * x) →
      ∀ z : (Fin 3 → ℕ) → ℂ, (∀ p ∈ T, ‖z p‖ ≤ L) →
      ∀ B : ℝ,
        (∀ t ∈ Set.Icc (0 : ℝ) 10, ∀ u ∈ Set.Icc (0 : ℝ) 10,
          ∀ v ∈ Set.Icc (0 : ℝ) 10,
            let f : ℕ →₀ ℂ := ∑ p ∈ T, Finsupp.single (∏ j, p j)
              ((∏ j, ArithmeticFunction.vonMangoldt (p j) *
                (p j : ℝ) ^ (-(![t, u, v] j))) • z p)
            (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy f q (a q)‖) ≤ B) →
        let f : ℕ →₀ ℂ := ∑ p ∈ T, Finsupp.single (∏ i, p i)
          ((∏ i, if (p i).Prime then (1 : ℝ) else 0) • z p)
        (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy f q (a q)‖) ≤
          1000 * B + K * L * x / (Real.log x) ^ A := by
  classical
  obtain ⟨Kp, Xp, hKp, hXp, hPP⟩ :=
    three_tuple_prime_power_moduli_log_saving η γ θ hη hγ hθ hθγ J C A hC hA
  have hθone : θ < 1 := by linarith only [hθγ, hγ]
  obtain ⟨Kt, Xt, hKt, hXt, hTail⟩ :=
    three_tuple_mellin_tail_moduli_log_saving η θ hη hθ hθone J C A hC hA
  refine ⟨Kp + Kt, max Xp Xt, add_pos hKp hKt, hXp.trans (le_max_left _ _), ?_⟩
  intro x hx L hL N hN S hS a ha T hT hprod z hz B hB f
  have hxp : Xp ≤ x := (le_max_left _ _).trans hx
  have hxt : Xt ≤ x := (le_max_right _ _).trans hx
  have hxPos : 0 < x := (Real.exp_pos 1).trans_le (hXp.trans hxp)
  have hscale (p : Fin 3 → ℕ) (hp : p ∈ T) (i : Fin 3) : x ^ η ≤ (p i : ℝ) :=
    (hN i).1.trans (hT p hp i).1
  have hpos (p : Fin 3 → ℕ) (hp : p ∈ T) (i : Fin 3) : 0 < p i := by
    exact_mod_cast (Real.rpow_pos_of_pos hxPos η).trans_le (hscale p hp i)
  let fM : ℕ →₀ ℂ := ∑ p ∈ T, Finsupp.single (∏ i, p i)
    ((∏ i, minorantMangoldtMellinWeight (p i)) • z p)
  let fT : ℕ →₀ ℂ := ∑ p ∈ T, Finsupp.single (∏ i, p i)
    (((∏ i, ArithmeticFunction.vonMangoldt (p i) / Real.log (p i : ℝ)) -
      ∏ i, minorantMangoldtMellinWeight (p i)) • z p)
  let fP : ℕ →₀ ℂ := ∑ p ∈ T, Finsupp.single (∏ i, p i)
    (((∏ i, ArithmeticFunction.vonMangoldt (p i) / Real.log (p i : ℝ)) -
      ∏ i, if (p i).Prime then (1 : ℝ) else 0) • z p)
  have hM :
      (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy fM q (a q)‖) ≤ 1000 * B :=
    three_mangoldt_mellin_fullDiscrepancy_transfer T (fun p => p) hpos
      (fun p => ∏ i, p i) z S a (fun q => (q.divisors.card : ℝ) ^ J)
        (fun q hq => by positivity) B hB
  have hTbound :
      (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy fT q (a q)‖) ≤
        Kt * L * x / (Real.log x) ^ A :=
    hTail x hxt L hL T (fun p hp => ⟨hscale p hp, hprod p hp⟩) z hz S hS a ha
  have hPbound :
      (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy fP q (a q)‖) ≤
        Kp * L * x / (Real.log x) ^ A :=
    hPP x hxp L hL N hN S hS a ha T hT hprod z hz
  have hf : f = fM + fT - fP := by
    dsimp only [f, fM, fT, fP]
    rw [← Finset.sum_add_distrib, ← Finset.sum_sub_distrib]
    apply Finset.sum_congr rfl
    intro p hp
    simp only [sub_smul, Finsupp.single_sub]
    abel
  let kernel : ℕ → ℕ → ℂ := fun q n =>
    (if n % q = a q % q then 1 else 0) -
      (if Nat.Coprime n q then 1 else 0) / (q.totient : ℂ)
  have hfull (u : ℕ →₀ ℂ) (q : ℕ) :
      fullDiscrepancy u q (a q) = u.sum (fun n z => z * kernel q n) := by
    change fullDiscrepancy u q (a q) = ∑ n ∈ u.support, u n * kernel q n
    simp only [fullDiscrepancy, progressionMass, reducedMass, kernel,
      div_eq_mul_inv, mul_sub, mul_ite, ite_mul, one_mul, mul_one,
      zero_mul, mul_zero, Finset.sum_sub_distrib, Finset.sum_mul]
  have hlinear (q : ℕ) :
      fullDiscrepancy f q (a q) =
        fullDiscrepancy fM q (a q) + fullDiscrepancy fT q (a q) -
          fullDiscrepancy fP q (a q) := by
    rw [hf]
    simp only [hfull]
    rw [Finsupp.sum_sub_index (fun _ _ _ => sub_mul _ _ _),
      Finsupp.sum_add_index' (fun _ => zero_mul _) (fun _ _ _ => add_mul _ _ _)]
  have hpoint (q : ℕ) :
      (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy f q (a q)‖ ≤
        (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy fM q (a q)‖ +
          (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy fT q (a q)‖ +
          (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy fP q (a q)‖ := by
    rw [hlinear]
    calc
      _ ≤ (q.divisors.card : ℝ) ^ J *
          (‖fullDiscrepancy fM q (a q)‖ + ‖fullDiscrepancy fT q (a q)‖ +
            ‖fullDiscrepancy fP q (a q)‖) :=
        mul_le_mul_of_nonneg_left
          ((norm_sub_le _ _).trans
            (add_le_add (norm_add_le _ _) le_rfl)) (by positivity)
      _ = _ := by ring
  calc
    _ ≤ ∑ q ∈ S,
        ((q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy fM q (a q)‖ +
          (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy fT q (a q)‖ +
          (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy fP q (a q)‖) :=
      Finset.sum_le_sum fun q hq => hpoint q
    _ ≤ 1000 * B + Kt * L * x / (Real.log x) ^ A + Kp * L * x / (Real.log x) ^ A := by
      rw [Finset.sum_add_distrib, Finset.sum_add_distrib]
      exact add_le_add (add_le_add hM hTbound) hPbound
    _ = 1000 * B + (Kp + Kt) * L * x / (Real.log x) ^ A := by ring

open Classical in
theorem hbBoundary_filtered_pair_sum
    (f g : ℕ →₀ ℂ) (R : ℕ → Prop) [DecidablePred R] :
    ((MonoidAlgebra.ofCoeff f * MonoidAlgebra.ofCoeff g : MonoidAlgebra ℂ ℕ).coeff).filter R =
      ∑ d ∈ f.support, ∑ m ∈ g.support,
        Finsupp.single (d * m) (if R (d * m) then f d * g m else 0) := by
  simp only [MonoidAlgebra.mul_def, Finsupp.sum,
    MonoidAlgebra.coeff_sum, MonoidAlgebra.coeff_single, Finsupp.filter_sum]
  apply Finset.sum_congr rfl
  intro d _hd
  apply Finset.sum_congr rfl
  intro m _hm
  by_cases h : R (d * m)
  · rw [Finsupp.filter_single_of_pos R h, ite_eq_left h]
  · rw [Finsupp.filter_single_of_neg R h, ite_eq_right h, Finsupp.single_zero]

open Classical in
theorem minorantHB_boundary_filtered_pair_rectangle
    (f g : ℕ →₀ ℂ) (x N : ℝ) (hx : 0 < x) (hN : 0 < N)
    (D : Finset ℕ)
    (hf : ∀ d ∈ f.support, d ∈ D ∧ N / 4 ≤ (d : ℝ)) :
    ((MonoidAlgebra.ofCoeff f * MonoidAlgebra.ofCoeff g : MonoidAlgebra ℂ ℕ).coeff).filter
        (fun n : ℕ => x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x) =
      ∑ d ∈ D, ∑ m ∈ Finset.Icc 1 ⌈8 * (x / N)⌉₊,
        Finsupp.single (d * m)
          (if x ≤ ((d * m : ℕ) : ℝ) ∧ ((d * m : ℕ) : ℝ) ≤ 2 * x
            then f d * g m else 0) := by
  rw [hbBoundary_filtered_pair_sum]
  let w (v : ℕ × ℕ) : ℕ →₀ ℂ := Finsupp.single (v.1 * v.2)
    (if x ≤ ((v.1 * v.2 : ℕ) : ℝ) ∧ ((v.1 * v.2 : ℕ) : ℝ) ≤ 2 * x
      then f v.1 * g v.2 else 0)
  change (∑ d ∈ f.support, ∑ m ∈ g.support, w (d, m)) =
    ∑ d ∈ D, ∑ m ∈ Finset.Icc 1 ⌈8 * (x / N)⌉₊, w (d, m)
  rw [← Finset.sum_product _ _ w, ← Finset.sum_product _ _ w]
  apply Finset.sum_congr_of_eq_on_inter
  all_goals dsimp only [w]
  · intro v hv hvD
    obtain ⟨hd, _hm⟩ := Finset.mem_product.mp hv
    by_cases hr : x ≤ ((v.1 * v.2 : ℕ) : ℝ) ∧ ((v.1 * v.2 : ℕ) : ℝ) ≤ 2 * x
    · exfalso
      apply hvD
      apply Finset.mem_product.mpr
      refine ⟨(hf v.1 hd).1, Finset.mem_Icc.mpr ⟨?_, ?_⟩⟩
      · have hmul : 0 < v.1 * v.2 := by exact_mod_cast hx.trans_le hr.1
        exact Nat.pos_of_ne_zero (by
          intro hzero
          simp only [hzero, mul_zero, lt_self_iff_false] at hmul)
      · have hmhi : (v.2 : ℝ) ≤ 8 * (x / N) := by
          rw [← mul_div_assoc]
          apply (le_div_iff₀ hN).mpr
          have hprod := hr.2
          rw [Nat.cast_mul] at hprod
          have hlow := mul_le_mul_of_nonneg_right (hf v.1 hd).2 (Nat.cast_nonneg v.2)
          nlinarith
        exact_mod_cast hmhi.trans (Nat.le_ceil _)
    · simp only [ite_eq_right hr, Finsupp.single_zero]
  · intro v _hv hvS
    by_cases hd : v.1 ∈ f.support
    · have hm : v.2 ∉ g.support := fun hm => hvS (Finset.mem_product.mpr ⟨hd, hm⟩)
      simp only [Finsupp.notMem_support_iff.mp hm, mul_zero, ite_self, Finsupp.single_zero]
    · simp only [Finsupp.notMem_support_iff.mp hd, zero_mul, ite_self, Finsupp.single_zero]
  · intro _ _ _
    rfl

theorem hbBoundary_fullDiscrepancy_add (f g : ℕ →₀ ℂ) (q a : ℕ) :
    fullDiscrepancy (f + g) q a = fullDiscrepancy f q a + fullDiscrepancy g q a := by
  have heq (h : ℕ →₀ ℂ) : fullDiscrepancy h q a =
      h.sum (fun n z => (if n % q = a % q then z else 0) -
        (if Nat.Coprime n q then z else 0) / (q.totient : ℂ)) := by
    unfold fullDiscrepancy progressionMass reducedMass Finsupp.sum
    rw [Finset.sum_sub_distrib, Finset.sum_div]
  rw [heq, heq, heq]
  exact Finsupp.sum_add_index' (fun n => by simp)
    (fun n z w => by split_ifs <;> ring)

theorem hbBoundary_weighted_discrepancy_add_le
    (f g : ℕ →₀ ℂ) (Q : Finset ℕ) (a : ℕ → ℕ) (J : ℕ) :
    (∑ q ∈ Q, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy (f + g) q (a q)‖) ≤
      (∑ q ∈ Q, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy f q (a q)‖) +
        ∑ q ∈ Q, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy g q (a q)‖ := by
  rw [← Finset.sum_add_distrib]
  apply Finset.sum_le_sum
  intro q _hq
  rw [hbBoundary_fullDiscrepancy_add, ← mul_add]
  exact mul_le_mul_of_nonneg_left (norm_add_le _ _) (by positivity)

open Classical in
theorem sourceU3_diagonal_moduli_log_saving (J : ℕ) (A : ℝ) (hA : 0 < A) :
    ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
      let U (p : Fin 5 → ℕ) : Prop :=
        [p 0, p 1, p 2] ∈ siftedPrimeTuples x (5 : Fin 6) ∧
          x ^ ((9519 : ℝ) / 50000) ≤ (p 3 : ℝ) ∧ p 3 ≤ p 4
      let E (p : Fin 5 → ℕ) : Prop :=
        (∀ i, (9519 : ℝ) / 50000 ≤ α (p i) ∧
          α (p i) ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
        α (p 1) < α (p 0) ∧ α (p 1) < α (p 2) ∧
        α (p 0) + α (p 2) < (40481 : ℝ) / 100000 ∧
        (59519 : ℝ) / 100000 < α (p 1) + α (p 2) + α (p 3) ∧
        α (p 3) ≤ α (p 4)
      let P := (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((6 : ℝ) / 25)⌋₊).filter Nat.Prime
      let T := Fintype.piFinset (fun _ : Fin 5 => P)
      let B (p : Fin 5 → ℕ) : Prop :=
        x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x ∧
          U p ∧ ¬ E p
      let Fdiag : ℕ →₀ ℂ := ∑ p ∈ T, Finsupp.single (∏ i, p i)
        (if B p ∧ p 2 = p 1 then 1 else 0)
      ∀ S : Finset ℕ, S ⊆ Finset.Icc 1 ⌊x ^ (53 / 100 : ℝ)⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
        (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy Fdiag q (a q)‖) ≤
          K * x / (Real.log x) ^ A := by
  obtain ⟨K, X, hK, _hX, hbound⟩ :=
    repeated_factor_polynomial_band_moduli_log_saving J A hA
  refine ⟨K, max X (Real.exp 100), hK, le_max_right _ _, ?_⟩
  intro x hx α U E P T B Fdiag S hS a ha
  have hx1 : 1 < x :=
    (Real.one_lt_exp_iff.mpr (by norm_num : (0 : ℝ) < 100)).trans_le
      ((le_max_right _ _).trans hx)
  have hprime (p : ℕ) (hp : p ∈ P) : p.Prime :=
    (Finset.mem_filter.mp hp).2
  have hpi {n : ℕ} (t : Fin n → Finset ℕ) (dec : DecidableEq (Fin n)) :
      @Fintype.piFinset (Fin n) dec _ (fun _ => ℕ) t =
        @Fintype.piFinset (Fin n) (Classical.typeDecidableEq _) _ (fun _ => ℕ) t := by
    ext r
    simp only [Fintype.mem_piFinset]
  have hfilter (s : Finset ℕ) (p : ℕ → Prop) (dec : DecidablePred p) :
      @Finset.filter _ p dec s =
        @Finset.filter _ p (fun n => Classical.propDecidable (p n)) s :=
    @Finset.filter_congr_decidable _ s p dec (fun n => Classical.propDecidable (p n))
  have hite (p : Prop) (dec : Decidable p) (z w : ℂ) :
      @ite ℂ p dec z w = @ite ℂ p (Classical.propDecidable p) z w :=
    @ite_cond_congr ℂ p p dec (Classical.propDecidable p) z w rfl
  have hrepeated (p : Fin 5 → ℕ) (hp : p ∈ T) (hB : B p) (hd : p 2 = p 1) :
      (p 1 : ℝ) ≤ x ^ ((40481 : ℝ) / 200000) := by
    have hm := (mem_siftedPrimeTuples_iff x hx1 (5 : Fin 6)
      [p 0, p 1, p 2]).mp hB.2.2.1.1
    dsimp only at hm
    obtain ⟨_hp0, _hp1, _hp2, _hξ, _h10, _h0a, _h12, hpair, _h0ζ⟩ := hm
    rw [hd] at hpair
    apply (Real.logb_le_iff_le_rpow hx1
      (Nat.cast_pos.mpr (hprime (p 1) (Fintype.mem_piFinset.mp hp 1)).pos)).mp
    linarith only [hpair]
  let D : Finset ℕ := P.filter
    (fun p : ℕ => (p : ℝ) ≤ x ^ ((40481 : ℝ) / 200000))
  let u (p m : ℕ) : ℂ := ∑ r ∈ Fintype.piFinset (fun _ : Fin 3 => P),
    if (∏ i, r i) = m ∧ B ![r 0, p, p, r 1, r 2] then 1 else 0
  have hsplit : Fdiag =
      ∑ p ∈ D, ∑ m ∈ Finset.Icc 1 ⌈2 * x / (p : ℝ) ^ 2⌉₊,
        Finsupp.single (p ^ 2 * m) (u p m) := by
    simpa only [Fdiag, T, D, u, hpi, hfilter, hite] using
      finite_five_diagonal_square_cofactor x P (fun p hp => (hprime p hp).pos) B
        (fun _ _ hB => hB.2.1) hrepeated
  have hband (p : ℕ) (hp : p ∈ D) :
      x ^ (9519 / 50000 : ℝ) ≤ (p : ℝ) ∧
        (p : ℝ) ≤ x ^ (40481 / 200000 : ℝ) := by
    obtain ⟨hpP, hpupper⟩ := Finset.mem_filter.mp hp
    have hplower := (Finset.mem_Icc.mp (Finset.mem_filter.mp hpP).1).1
    exact ⟨(Nat.le_ceil _).trans (Nat.cast_le.mpr hplower), hpupper⟩
  have hcoeff (p : ℕ) (_hp : p ∈ D) (m : ℕ)
      (hm : m ∈ Finset.Icc 1 ⌈2 * x / (p : ℝ) ^ 2⌉₊) :
      ‖u p m‖ ≤ (m.divisors.card : ℝ) ^ 3 := by
    simpa only [u, hpi, hite] using finite_three_tuple_cut_coefficient_bound P
      (fun r => B ![r 0, p, p, r 1, r 2]) m (Finset.mem_Icc.mp hm).1
  rw [hsplit]
  exact hbound x ((le_max_left _ _).trans hx) S hS a ha D hband u hcoeff

open Classical in
theorem literal_minorant_buchstab_discrepancy :
    ∀ᶠ x : ℝ in atTop, ∀ S : Finset ℕ,
      S ⊆ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ → ∀ q a : ℕ,
      fullDiscrepancy
        (∑ n ∈ S, Finsupp.single n
          (((if n.Prime then (1 : ℝ) else 0) - exceptionalPrimeDefect x 0 n -
            exceptionalPrimeDefect x 1 n : ℝ) : ℂ)) q a =
        ∑ i : Fin 12, (literalMinorantBuchstabSign i : ℂ) *
          fullDiscrepancy
            (∑ n ∈ S, Finsupp.single n (literalMinorantBuchstabPiece x i n : ℂ)) q a := by
  filter_upwards [literal_minorant_buchstab_pointwise,
    eventually_gt_atTop (1 : ℝ)] with x hx hx1
  intro S hS q a
  let w (n : ℕ) : ℂ :=
    (if n % q = a % q then 1 else 0) -
      (if Nat.Coprime n q then 1 else 0) / (q.totient : ℂ)
  have hpoint (n : ℕ) (hn : n ∈ S) :
      (((if n.Prime then (1 : ℝ) else 0) - exceptionalPrimeDefect x 0 n -
        exceptionalPrimeDefect x 1 n : ℝ) : ℂ) =
      ∑ i : Fin 12, (literalMinorantBuchstabSign i : ℂ) *
        (literalMinorantBuchstabPiece x i n : ℂ) := by
    obtain ⟨hnlo, hnhi⟩ := Finset.mem_Icc.mp (hS hn)
    have hlo : x ≤ (n : ℝ) := (Nat.le_ceil x).trans (Nat.cast_le.mpr hnlo)
    have hhi : (n : ℝ) ≤ 2 * x :=
      (Nat.cast_le.mpr hnhi).trans (Nat.floor_le (by linarith))
    simpa only [Complex.ofReal_sum, Complex.ofReal_mul] using
      congrArg Complex.ofReal (hx n hlo hhi)
  simp only [fullDiscrepancy_indexed_sample]
  change (∑ n ∈ S,
      (((if n.Prime then (1 : ℝ) else 0) - exceptionalPrimeDefect x 0 n -
        exceptionalPrimeDefect x 1 n : ℝ) : ℂ) * w n) =
    ∑ i : Fin 12, (literalMinorantBuchstabSign i : ℂ) *
      ∑ n ∈ S, (literalMinorantBuchstabPiece x i n : ℂ) * w n
  calc
    _ = ∑ n ∈ S, (∑ i : Fin 12, (literalMinorantBuchstabSign i : ℂ) *
        (literalMinorantBuchstabPiece x i n : ℂ)) * w n := by
      apply Finset.sum_congr rfl
      intro n hn
      rw [hpoint n hn]
    _ = _ := by
      simp only [Finset.sum_mul, Finset.mul_sum, mul_assoc]
      exact Finset.sum_comm

open Classical in
theorem literal_minorant_buchstab_weighted_discrepancy_cover :
    ∀ᶠ x : ℝ in atTop, ∀ S : Finset ℕ,
      S ⊆ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ →
      ∀ Q : Finset ℕ, ∀ a : ℕ → ℕ, ∀ w : ℕ → ℝ,
      (∀ q ∈ Q, 0 ≤ w q) →
      (∑ q ∈ Q, w q * ‖fullDiscrepancy
        (∑ n ∈ S, Finsupp.single n
          (((if n.Prime then (1 : ℝ) else 0) - exceptionalPrimeDefect x 0 n -
            exceptionalPrimeDefect x 1 n : ℝ) : ℂ)) q (a q)‖) ≤
        ∑ i : Fin 12, ∑ q ∈ Q, w q * ‖fullDiscrepancy
          (∑ n ∈ S, Finsupp.single n (literalMinorantBuchstabPiece x i n : ℂ)) q (a q)‖ := by
  filter_upwards [literal_minorant_buchstab_discrepancy] with x hx
  intro S hS Q a w hw
  have hpoint (q : ℕ) (hq : q ∈ Q) :
      w q * ‖fullDiscrepancy
        (∑ n ∈ S, Finsupp.single n
          (((if n.Prime then (1 : ℝ) else 0) - exceptionalPrimeDefect x 0 n -
            exceptionalPrimeDefect x 1 n : ℝ) : ℂ)) q (a q)‖ ≤
      ∑ i : Fin 12, w q * ‖fullDiscrepancy
        (∑ n ∈ S, Finsupp.single n (literalMinorantBuchstabPiece x i n : ℂ)) q (a q)‖ := by
    rw [hx S hS q (a q), ← Finset.mul_sum]
    apply mul_le_mul_of_nonneg_left _ (hw q hq)
    apply (norm_sum_le _ _).trans
    apply Finset.sum_le_sum
    intro i _hi
    rw [norm_mul, literalMinorantBuchstabSign_norm, one_mul]
  exact (Finset.sum_le_sum hpoint).trans_eq (Finset.sum_comm ..)

section

open scoped ContDiff

open Classical in
theorem sifted_short_geometric_profiles :
    ∃ B : ℕ → ℝ, (∀ r : ℕ, 0 < B r) ∧
      ∀ Θ : ℝ, 1 < Θ → Θ ≤ 2 →
        let η : ℝ → ℝ := fun u =>
          if 0 < u then
            Real.smoothTransition (Real.log u / Real.log Θ + 1) -
              Real.smoothTransition (Real.log u / Real.log Θ)
          else 0
        ContDiff ℝ ∞ (fun u => (η u : ℂ)) ∧
          Function.support (fun u => (η u : ℂ)) = Set.Ioo Θ⁻¹ Θ ∧
          (∀ u : ℝ, 0 ≤ η u ∧ η u ≤ 1) ∧
          ∀ (r : ℕ) (u : ℝ),
            ‖iteratedDeriv r (fun u => (η u : ℂ)) u‖ ≤ B r / (Θ - 1) ^ r := by
  obtain ⟨B, hB, hmain⟩ :=
    heathBrown_geometric_profiles_uniform
  refine ⟨B, hB, ?_⟩
  intro Θ hΘ hΘ₂ η
  obtain ⟨hη, hsupp, hrange, hderiv, _⟩ := hmain Θ hΘ hΘ₂
  change ContDiff ℝ ∞ η at hη
  change Function.support η = Set.Ioo Θ⁻¹ Θ at hsupp
  change ∀ u : ℝ, 0 ≤ η u ∧ η u ≤ 1 at hrange
  have hc : ContDiff ℝ ∞ (fun u => (η u : ℂ)) :=
    Complex.ofRealCLM.contDiff.comp hη
  refine ⟨hc, ?_, hrange, ?_⟩
  · rw [← hsupp]
    ext u
    exact Complex.ofReal_ne_zero
  · intro r u
    have hd := (hderiv 1 0 false le_rfl le_rfl (by norm_num)).2.2 r u
    simp only [neg_zero, Real.rpow_eq_pow, Real.rpow_zero, mul_one, Bool.false_eq_true, ite_false,
      Real.log_one, add_zero] at hd
    have hn := Complex.ofRealLI.norm_iteratedFDeriv_comp_left (x := u)
      hη.contDiffAt (show (r : ℕ∞ω) ≤ (∞ : ℕ∞ω) by simp)
    have hn' : ‖iteratedDeriv r (fun u => (η u : ℂ)) u‖ =
        ‖iteratedDeriv r η u‖ := by
      simpa only [norm_iteratedFDeriv_eq_norm_iteratedDeriv,
        Function.comp_def, Complex.ofRealLI_apply] using hn
    rw [hn']
    exact hd

open Classical in
theorem sifted_short_geometric_profile_bounds (D : ℝ) (hD : 1 ≤ D) :
    ∃ B : ℕ → ℝ, (∀ r : ℕ, 0 < B r) ∧
      ∀ x : ℝ, Real.exp 1 ≤ x →
        let Θ := 1 + (Real.log x) ^ (-D)
        let η : ℝ → ℝ := fun u =>
          if 0 < u then
            Real.smoothTransition (Real.log u / Real.log Θ + 1) -
              Real.smoothTransition (Real.log u / Real.log Θ)
          else 0
        1 < Θ ∧ Θ ≤ 2 ∧ ContDiff ℝ ∞ (fun u => (η u : ℂ)) ∧
          Function.support (fun u => (η u : ℂ)) = Set.Ioo Θ⁻¹ Θ ∧
          (∀ u : ℝ, 0 ≤ η u ∧ η u ≤ 1) ∧
          ∀ (r : ℕ) (u : ℝ),
            ‖iteratedDeriv r (fun u => (η u : ℂ)) u‖ ≤
              B r * (Real.log x) ^ (D * (r : ℝ)) := by
  obtain ⟨B, hB, hmain⟩ := sifted_short_geometric_profiles
  refine ⟨B, hB, ?_⟩
  intro x hx Θ η
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le hx
  have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hx
  have hlog : 0 < Real.log x := zero_lt_one.trans_le hlog1
  have hΘ : 1 < Θ := by
    dsimp only [Θ]
    exact lt_add_of_pos_right _ (Real.rpow_pos_of_pos hlog _)
  have hΘ₂ : Θ ≤ 2 := by
    have hp := Real.rpow_le_one_of_one_le_of_nonpos hlog1
      (show -D ≤ 0 by linarith)
    dsimp only [Θ]
    linarith
  obtain ⟨hc, hs, hr, hd⟩ := hmain Θ hΘ hΘ₂
  refine ⟨hΘ, hΘ₂, hc, hs, hr, ?_⟩
  intro r u
  calc
    _ ≤ B r / (Θ - 1) ^ r := hd r u
    _ = B r * (Real.log x) ^ (D * (r : ℝ)) := by
      rw [show Θ - 1 = (Real.log x) ^ (-D) by dsimp only [Θ]; ring]
      rw [← Real.rpow_natCast, ← Real.rpow_mul hlog.le,
        show -D * (r : ℝ) = -(D * (r : ℝ)) by ring,
        Real.rpow_neg hlog.le, div_inv_eq_mul]

open Classical in
theorem sifted_short_geometric_coefficient_bounds
    (x Θ M : ℝ) (hx : 1 < x) (hΘ : 1 < Θ) (hΘ₂ : Θ ≤ 2) (hM : 0 < M)
    (j : Fin 6) :
    let η : ℝ → ℝ := fun u =>
      if 0 < u then
        Real.smoothTransition (Real.log u / Real.log Θ + 1) -
          Real.smoothTransition (Real.log u / Real.log Θ)
      else 0
    let z := x ^ ((9519 : ℝ) / 50000)
    let M0 := x ^ (1 - (1058 : ℝ) / 3125)
    let S0 : ℕ → ℝ := fun n =>
      if (n : ℝ) ≤ M0 then
        ∑ ps ∈ siftedPrimeTuples x j, ∑ d ∈ n.divisorsAntidiagonal,
          if d.1 = ps.prod then smallPrimeMobius z d.2 else 0
      else 0
    let α : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc 1 (Nat.floor (Θ * M)),
      Finsupp.single n ((η ((n : ℝ) / M) * S0 n : ℝ) : ℂ)
    (∀ n : ℕ, α n = ((η ((n : ℝ) / M) * S0 n : ℝ) : ℂ)) ∧
      (∀ n ∈ α.support, M / 2 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * M) ∧
      ∀ n : ℕ, ‖α n‖ ≤ (n.divisors.card : ℝ) ^ 3 := by
  intro η z M0 S0 α
  obtain ⟨B, _, hprofile⟩ := sifted_short_geometric_profiles
  obtain ⟨_, hsupp, hrange, _⟩ := hprofile Θ hΘ hΘ₂
  change Function.support (fun u => (η u : ℂ)) = Set.Ioo Θ⁻¹ Θ at hsupp
  have hΘ0 : 0 < Θ := zero_lt_one.trans hΘ
  have hhalf : (1 / 2 : ℝ) ≤ Θ⁻¹ := by
    simpa only [one_div] using one_div_le_one_div_of_le hΘ0 hΘ₂
  have hηmem (n : ℕ) (hn : η ((n : ℝ) / M) ≠ 0) :
      n ∈ Finset.Icc 1 (Nat.floor (Θ * M)) ∧
        M / 2 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * M := by
    have hn' : (η ((n : ℝ) / M) : ℂ) ≠ 0 := by exact_mod_cast hn
    have hh : Θ⁻¹ < (n : ℝ) / M ∧ (n : ℝ) / M < Θ := by
      change (n : ℝ) / M ∈ Set.Ioo Θ⁻¹ Θ
      rw [← hsupp]
      exact hn'
    have hn0 : 0 < (n : ℝ) :=
      (mul_pos (inv_pos.mpr hΘ0) hM).trans ((lt_div_iff₀ hM).mp hh.1)
    have hnupper : (n : ℝ) ≤ Θ * M := ((div_lt_iff₀ hM).mp hh.2).le
    refine ⟨Finset.mem_Icc.mpr ⟨Nat.cast_pos.mp hn0, Nat.le_floor hnupper⟩, ?_, ?_⟩
    · have hh' := (le_div_iff₀ hM).mp (hhalf.trans hh.1.le)
      linarith
    · exact hnupper.trans (mul_le_mul_of_nonneg_right hΘ₂ hM.le)
  have happly (n : ℕ) : α n = ((η ((n : ℝ) / M) * S0 n : ℝ) : ℂ) := by
    simp only [α, Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_ite_eq']
    by_cases hn : n ∈ Finset.Icc 1 (Nat.floor (Θ * M))
    · simp [hn]
    · have hz : η ((n : ℝ) / M) = 0 := by
        by_contra he
        exact hn (hηmem n he).1
      simp [hn, hz]
  refine ⟨happly, ?_, ?_⟩
  · intro n hn
    have he : η ((n : ℝ) / M) ≠ 0 := by
      intro hz
      have hn' := Finsupp.mem_support_iff.mp hn
      rw [happly, hz, zero_mul, Complex.ofReal_zero] at hn'
      exact hn' rfl
    exact (hηmem n he).2
  · intro n
    rw [happly, Complex.ofReal_mul, norm_mul]
    have hηnorm : ‖(η ((n : ℝ) / M) : ℂ)‖ ≤ 1 := by
      rw [Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg (hrange _).1]
      exact (hrange _).2
    have hS := (sifted_short_source_bounds x hx j n).1
    change ‖(S0 n : ℂ)‖ ≤ (n.divisors.card : ℝ) ^ 3 at hS
    exact (mul_le_mul_of_nonneg_right hηnorm (norm_nonneg _)).trans
      (by simpa only [one_mul] using hS)

open Classical in
theorem sifted_short_geometric_free_eq
    (Θ N : ℝ) (hΘ : 1 < Θ) (hΘ₂ : Θ ≤ 2) (hN : 0 < N) :
    let η : ℝ → ℝ := fun u =>
      if 0 < u then
        Real.smoothTransition (Real.log u / Real.log Θ + 1) -
          Real.smoothTransition (Real.log u / Real.log Θ)
      else 0
    positiveCompactProfileSequence (fun u => (η u : ℂ)) 2 N 0 =
      ∑ n ∈ Finset.Icc 1 (Nat.floor (Θ * N)), Finsupp.single n
        ((η ((n : ℝ) / N) * (ArithmeticFunction.zeta n : ℝ) : ℝ) : ℂ) := by
  intro η
  obtain ⟨B, _, hprofile⟩ := sifted_short_geometric_profiles
  obtain ⟨_, hsupp, _, _⟩ := hprofile Θ hΘ hΘ₂
  change Function.support (fun u => (η u : ℂ)) = Set.Ioo Θ⁻¹ Θ at hsupp
  have hΘ0 : 0 < Θ := zero_lt_one.trans hΘ
  have hhalf : (1 / 2 : ℝ) ≤ Θ⁻¹ := by
    simpa only [one_div] using one_div_le_one_div_of_le hΘ0 hΘ₂
  have hs : Function.support (fun u => (η u : ℂ)) ⊆ Set.Icc (1 / 2 : ℝ) 2 := by
    rw [hsupp]
    exact Set.Ioo_subset_Icc_self.trans (Set.Icc_subset_Icc hhalf hΘ₂)
  ext n
  rw [positiveCompactProfileSequence_apply (1 / 2) 2 N (by norm_num) hN _ hs]
  simp only [Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_ite_eq']
  by_cases hn : n ∈ Finset.Icc 1 (Nat.floor (Θ * N))
  · have hn0 : n ≠ 0 := by have := (Finset.mem_Icc.mp hn).1; omega
    simp [hn, ArithmeticFunction.zeta_apply_ne hn0]
  · have he : (η ((n : ℝ) / N) : ℂ) = 0 := by
      by_contra hne
      have hh : Θ⁻¹ < (n : ℝ) / N ∧ (n : ℝ) / N < Θ := by
        change (n : ℝ) / N ∈ Set.Ioo Θ⁻¹ Θ
        rw [← hsupp]
        exact hne
      have hnpos : 0 < (n : ℝ) :=
        (mul_pos (inv_pos.mpr hΘ0) hN).trans ((lt_div_iff₀ hN).mp hh.1)
      exact hn (Finset.mem_Icc.mpr ⟨Nat.cast_pos.mp hnpos,
        Nat.le_floor ((div_lt_iff₀ hN).mp hh.2).le⟩)
    simp [hn, he]

open Classical in
theorem sifted_short_geometric_all_moduli_siegelWalfisz
    (ε C A D : ℝ) (hε : 0 < ε) (hC : 0 < C) (hA : 0 < A) (hD : 1 ≤ D) :
    ∃ K X0 : ℝ, 0 < K ∧ Real.exp 1 ≤ X0 ∧
      ∀ x : ℝ, X0 ≤ x → ∀ M : ℝ, x ^ ε ≤ M → M ≤ x ^ C →
      ∀ j : Fin 6, ∀ u v : ℝ,
      ∀ q : ℕ, 0 < q → ∀ r0 : ℕ, 0 < r0 → ∀ a : ℕ, Nat.Coprime a q →
      let Θ := 1 + (Real.log x) ^ (-D)
      let η : ℝ → ℝ := fun u =>
        if 0 < u then
          Real.smoothTransition (Real.log u / Real.log Θ + 1) -
            Real.smoothTransition (Real.log u / Real.log Θ)
        else 0
      let z := x ^ ((9519 : ℝ) / 50000)
      let M0 := x ^ (1 - (1058 : ℝ) / 3125)
      let S0 : ℕ → ℝ := fun n =>
        if (n : ℝ) ≤ M0 then
          ∑ ps ∈ siftedPrimeTuples x j, ∑ d ∈ n.divisorsAntidiagonal,
            if d.1 = ps.prod then smallPrimeMobius z d.2 else 0
        else 0
      let α : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc 1 (Nat.floor (Θ * M)),
        Finsupp.single n ((η ((n : ℝ) / M) * S0 n : ℝ) : ℂ)
      ‖fullDiscrepancy
        (α.filter (fun n : ℕ => u ≤ (n : ℝ) ∧ (n : ℝ) ≤ v ∧ Nat.Coprime n r0)) q a‖ ≤
        K * ((q * r0).divisors.card : ℝ) * M / (Real.log x) ^ A := by
  obtain ⟨B, hB, hprofile⟩ := sifted_short_geometric_profile_bounds D hD
  have hB1 : 0 < B 1 := hB 1
  obtain ⟨K, X1, hK, hX1, hsw⟩ :=
    sifted_short_weighted_all_moduli_siegelWalfisz
      ε 2 (1 / 2) C A (D + 1) hε (by norm_num) (by norm_num) hC hA (by linarith)
  refine ⟨K, max X1 (Real.exp (1 + 2 * B 1)), hK, hX1.trans (le_max_left _ _), ?_⟩
  intro x hx M hML hMU j u v q hq r0 hr0 a ha Θ η z M0 S0 α
  have hx1 := (le_max_left _ _).trans hx
  have hxexp := (le_max_right _ _).trans hx
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le (hX1.trans hx1)
  have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr (hX1.trans hx1)
  have hlog : 0 < Real.log x := zero_lt_one.trans_le hlog1
  have hlogB : 1 + 2 * B 1 ≤ Real.log x :=
    (Real.le_log_iff_exp_le hx0).mpr hxexp
  have hxgt : 1 < x := (Real.one_lt_exp_iff.mpr (by norm_num : (0 : ℝ) < 1)).trans_le
    (hX1.trans hx1)
  have hM : 0 < M := (Real.rpow_pos_of_pos hx0 ε).trans_le hML
  obtain ⟨hΘ, hΘ₂, hηsmooth, hηsupport, hηrange, hηderiv⟩ :=
    hprofile x (hX1.trans hx1)
  change 1 < Θ at hΘ
  change Θ ≤ 2 at hΘ₂
  change ContDiff ℝ ∞ (fun u => (η u : ℂ)) at hηsmooth
  change Function.support (fun u => (η u : ℂ)) = Set.Ioo Θ⁻¹ Θ at hηsupport
  change ∀ u : ℝ, 0 ≤ η u ∧ η u ≤ 1 at hηrange
  change ∀ (r : ℕ) (u : ℝ), ‖iteratedDeriv r (fun u => (η u : ℂ)) u‖ ≤
    B r * (Real.log x) ^ (D * (r : ℝ)) at hηderiv
  have hbound (t : ℝ) : ‖deriv (fun u => (η u : ℂ)) t‖ ≤
      B 1 * (Real.log x) ^ D := by
    simpa only [iteratedDeriv_one, Nat.cast_one, mul_one] using hηderiv 1 t
  let w : ℕ → ℂ := fun n => (η ((n : ℝ) / M) : ℂ)
  let NN := Nat.floor (2 * M)
  have hterminal : ‖w NN‖ ≤ 1 := by
    change ‖(η ((NN : ℝ) / M) : ℂ)‖ ≤ 1
    rw [Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg (hηrange _).1]
    exact (hηrange _).2
  have hstep (n : ℕ) : ‖w (n + 1) - w n‖ ≤ B 1 * (Real.log x) ^ D / M := by
    have hm := Convex.norm_image_sub_le_of_norm_deriv_le
      (fun t (_ : t ∈ (Set.univ : Set ℝ)) => hηsmooth.differentiable (by simp) t)
      (fun t _ => hbound t) (convex_univ : Convex ℝ (Set.univ : Set ℝ))
      (Set.mem_univ ((n : ℝ) / M)) (Set.mem_univ (((n + 1 : ℕ) : ℝ) / M))
    have hdist : ‖(((n + 1 : ℕ) : ℝ) / M) - (n : ℝ) / M‖ = 1 / M := by
      rw [show (((n + 1 : ℕ) : ℝ) / M) - (n : ℝ) / M = 1 / M by push_cast; ring]
      exact Real.norm_of_nonneg (by positivity)
    calc
      _ ≤ B 1 * (Real.log x) ^ D *
          ‖(((n + 1 : ℕ) : ℝ) / M) - (n : ℝ) / M‖ := hm
      _ = B 1 * (Real.log x) ^ D / M := by rw [hdist]; ring
  have hvar : ‖w NN‖ + (∑ n ∈ Finset.Ico 1 NN, ‖w (n + 1) - w n‖) ≤
      (Real.log x) ^ (D + 1) := by
    have hcard : ((Finset.Ico 1 NN).card : ℝ) ≤ 2 * M := by
      calc
        _ ≤ (NN : ℝ) := by exact_mod_cast (show (Finset.Ico 1 NN).card ≤ NN by simp)
        _ ≤ 2 * M := Nat.floor_le (by positivity)
    have hs : (∑ n ∈ Finset.Ico 1 NN, ‖w (n + 1) - w n‖) ≤
        2 * B 1 * (Real.log x) ^ D := by
      calc
        _ ≤ ∑ _n ∈ Finset.Ico 1 NN, B 1 * (Real.log x) ^ D / M :=
          Finset.sum_le_sum (fun n _ => hstep n)
        _ = ((Finset.Ico 1 NN).card : ℝ) * (B 1 * (Real.log x) ^ D / M) := by
          simp only [Finset.sum_const, nsmul_eq_mul]
        _ ≤ (2 * M) * (B 1 * (Real.log x) ^ D / M) :=
          mul_le_mul_of_nonneg_right hcard (by positivity)
        _ = 2 * B 1 * (Real.log x) ^ D := by field_simp [hM.ne']
    have hp : 1 ≤ (Real.log x) ^ D := Real.one_le_rpow hlog1 (by linarith)
    calc
      _ ≤ 1 + 2 * B 1 * (Real.log x) ^ D := add_le_add hterminal hs
      _ ≤ (1 + 2 * B 1) * (Real.log x) ^ D := by nlinarith only [hp]
      _ ≤ Real.log x * (Real.log x) ^ D :=
        mul_le_mul_of_nonneg_right hlogB (Real.rpow_nonneg hlog.le D)
      _ = (Real.log x) ^ (D + 1) := by rw [Real.rpow_add hlog, Real.rpow_one]; ring
  have hα := sifted_short_geometric_coefficient_bounds x Θ M hxgt hΘ hΘ₂ hM j
  change (∀ n : ℕ, α n = ((η ((n : ℝ) / M) * S0 n : ℝ) : ℂ)) ∧
    (∀ n ∈ α.support, M / 2 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * M) ∧
    ∀ n : ℕ, ‖α n‖ ≤ (n.divisors.card : ℝ) ^ 3 at hα
  have heq :
      α.filter (fun n : ℕ => u ≤ (n : ℝ) ∧ (n : ℝ) ≤ v ∧ Nat.Coprime n r0) =
        ∑ n ∈ Finset.Icc 1 NN, Finsupp.single n
          (if max (M / 2) u ≤ (n : ℝ) ∧ (n : ℝ) ≤ v ∧ Nat.Coprime n r0
           then w n * (S0 n : ℂ) else 0) := by
    ext n
    rw [Finsupp.filter_apply]
    simp only [Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_ite_eq']
    have hw : w n * (S0 n : ℂ) = α n := by
      rw [hα.1 n, Complex.ofReal_mul]
    rw [hw]
    by_cases hn : α n = 0
    · simp [hn]
    · have hs := hα.2.1 n (Finsupp.mem_support_iff.mpr hn)
      have hn0 : 0 < n := by
        have hh : 0 < (n : ℝ) := (half_pos hM).trans_le hs.1
        exact_mod_cast hh
      have hm : n ∈ Finset.Icc 1 NN :=
        Finset.mem_Icc.mpr ⟨hn0, Nat.le_floor hs.2⟩
      simp only [hm, ite_true, max_le_iff, hs.1, true_and]
  rw [heq]
  simpa only [S0, z, M0, NN] using
    hsw x hx1 M hML hMU j (max (M / 2) u) v
      (by simpa only [one_div, inv_mul_eq_div] using le_max_left (M / 2) u)
      w hvar q hq r0 hr0 a ha

open Classical in
theorem arithmeticFunction_geometric_typeZero_log_saving
    (Dmesh : ℝ) (k : ℕ) (C θ ε A : ℝ)
    (hDmesh : 1 ≤ Dmesh) (hC : 1 ≤ C)
    (_hθ : 0 < θ) (hθhi : θ < 1) (hε : 0 < ε) (_hA : 0 < A) :
    ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ M N : ℝ, 1 ≤ M → 1 ≤ N → M * N ≤ C * x → x ^ (θ + ε) ≤ N →
      ∀ a₀ : ArithmeticFunction ℝ,
        (∀ n : ℕ, |a₀ n| ≤ (n.divisors.card : ℝ) ^ k) →
      let Θ : ℝ := 1 + (Real.log x) ^ (-Dmesh)
      let η : ℝ → ℝ := fun u =>
        if 0 < u then
          Real.smoothTransition (Real.log u / Real.log Θ + 1) -
            Real.smoothTransition (Real.log u / Real.log Θ)
        else 0
      let α : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc 1 ⌊Θ * M⌋₊,
        Finsupp.single n ((η ((n : ℝ) / M) * a₀ n : ℝ) : ℂ)
      let β : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc 1 ⌊Θ * N⌋₊,
        Finsupp.single n
          ((η ((n : ℝ) / N) * (ArithmeticFunction.zeta n : ℝ) : ℝ) : ℂ)
      ∀ S : Finset ℕ, S ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
        (∑ q ∈ S, ‖fullDiscrepancy (finiteConvolution α β) q (a q)‖) ≤
          K * x / (Real.log x) ^ A := by
  obtain ⟨B, _hB, hprofile⟩ := sifted_short_geometric_profile_bounds Dmesh hDmesh
  let m : ℕ := Nat.ceil ((((k + 3 : ℕ) : ℝ) + 1) / ε)
  let L : ℝ := max 1 (B (m + 2))
  let E : ℝ := Dmesh * ((m + 2 : ℕ) : ℝ)
  have hL : 0 ≤ L := zero_le_one.trans (le_max_left _ _)
  have hE : 0 ≤ E := mul_nonneg (zero_le_one.trans hDmesh) (Nat.cast_nonneg _)
  obtain ⟨X₀, _hX₀, hzero⟩ :=
    (positiveCompactProfile_typeZero_uniform_log_saving A ((k + 3 : ℕ) : ℝ) ε
      (Nat.cast_nonneg _) hε).2 (1 / 2) 2 L E 0 (by norm_num) (by norm_num) hL
  refine ⟨1, max (Real.exp 1) (max X₀ ((2 * C) ^ (k + 1))),
    zero_lt_one, le_max_left _ _, ?_⟩
  intro x hx M N hM hN hMN hlarge a₀ ha₀ Θ η α β S hS a ha
  have hxexp : Real.exp 1 ≤ x := (le_max_left _ _).trans hx
  have hx₀ : X₀ ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans hx)
  have hxconstant : (2 * C) ^ (k + 1) ≤ x :=
    (le_max_right _ _).trans ((le_max_right _ _).trans hx)
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hxone : 1 ≤ x :=
    (Real.one_le_exp_iff.mpr (by norm_num : (0 : ℝ) ≤ 1)).trans hxexp
  have hlogone : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxpos).mpr hxexp
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlogone
  have hMpos : 0 < M := zero_lt_one.trans_le hM
  have hNpos : 0 < N := zero_lt_one.trans_le hN
  have hCpos : 0 < C := zero_lt_one.trans_le hC
  obtain ⟨hΘ, hΘtwo, hηsmooth, hηsupport, hηrange, hηderiv⟩ := hprofile x hxexp
  change 1 < Θ at hΘ
  change Θ ≤ 2 at hΘtwo
  change ContDiff ℝ ∞ (fun u => (η u : ℂ)) at hηsmooth
  change Function.support (fun u => (η u : ℂ)) = Set.Ioo Θ⁻¹ Θ at hηsupport
  change ∀ u : ℝ, 0 ≤ η u ∧ η u ≤ 1 at hηrange
  change ∀ (r : ℕ) (u : ℝ),
    ‖iteratedDeriv r (fun u => (η u : ℂ)) u‖ ≤
      B r * (Real.log x) ^ (Dmesh * (r : ℝ)) at hηderiv
  have hΘpos : 0 < Θ := zero_lt_one.trans hΘ
  have hhalf : (1 / 2 : ℝ) ≤ Θ⁻¹ := by
    simpa only [one_div] using one_div_le_one_div_of_le hΘpos hΘtwo
  have hsupp : Function.support (fun u => (η u : ℂ)) ⊆ Set.Icc (1 / 2 : ℝ) 2 := by
    rw [hηsupport]
    exact Set.Ioo_subset_Icc_self.trans (Set.Icc_subset_Icc hhalf hΘtwo)
  have hηnorm (u : ℝ) : ‖(η u : ℂ)‖ ≤ 1 := by
    rw [Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg (hηrange u).1]
    exact (hηrange u).2
  have hbounds (u : ℝ) :
      ‖(η u : ℂ)‖ ≤ L * (Real.log x) ^ E ∧
      ‖iteratedDeriv (m + 2) (fun u => (η u : ℂ)) u‖ ≤ L * (Real.log x) ^ E := by
    constructor
    · exact (hηnorm u).trans (by
        have hh := mul_le_mul (le_max_left (1 : ℝ) (B (m + 2)))
          (Real.one_le_rpow hlogone hE) zero_le_one hL
        simpa only [one_mul] using hh)
    · exact (hηderiv (m + 2) u).trans
        (mul_le_mul_of_nonneg_right (le_max_right (1 : ℝ) (B (m + 2)))
          (Real.rpow_nonneg hlogpos.le _))
  have hβ : positiveCompactProfileSequence (fun u => (η u : ℂ)) 2 N 0 = β :=
    sifted_short_geometric_free_eq Θ N hΘ hΘtwo hNpos
  have hαeval (n : ℕ) :
      α n = if n ∈ Finset.Icc 1 ⌊Θ * M⌋₊ then
        ((η ((n : ℝ) / M) * a₀ n : ℝ) : ℂ) else 0 := by
    simp only [α, Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_ite_eq']
  have hαsupport : α.support ⊆ Finset.Icc 1 ⌊Θ * M⌋₊ := by
    intro n hn
    by_contra hnot
    exact Finsupp.mem_support_iff.mp hn (by rw [hαeval, ite_eq_right hnot])
  have hMx : M ≤ C * x := (le_mul_of_one_le_right hMpos.le hN).trans hMN
  have hcut : (⌊Θ * M⌋₊ : ℝ) ≤ 2 * C * x := by
    calc
      _ ≤ Θ * M := Nat.floor_le (mul_pos hΘpos hMpos).le
      _ ≤ 2 * M := mul_le_mul_of_nonneg_right hΘtwo hMpos.le
      _ ≤ 2 * (C * x) := mul_le_mul_of_nonneg_left hMx (by norm_num)
      _ = _ := by ring
  have hαcard : (α.support.card : ℝ) ≤ 2 * C * x := by
    have hc : α.support.card ≤ ⌊Θ * M⌋₊ := by
      simpa only [Nat.card_Icc, Nat.add_sub_cancel] using Finset.card_le_card hαsupport
    exact (Nat.cast_le.mpr hc).trans hcut
  have hαterm (n : ℕ) (hn : n ∈ α.support) : ‖α n‖ ≤ (2 * C * x) ^ k := by
    have hmem := hαsupport hn
    have hncut : (n : ℝ) ≤ 2 * C * x :=
      (Nat.cast_le.mpr (Finset.mem_Icc.mp hmem).2).trans hcut
    have hτn : (n.divisors.card : ℝ) ≤ (n : ℝ) := by
      exact_mod_cast Nat.card_divisors_le_self n
    calc
      ‖α n‖ = η ((n : ℝ) / M) * |a₀ n| := by
        rw [hαeval, ite_eq_left hmem, Complex.norm_real, Real.norm_eq_abs, abs_mul,
          abs_of_nonneg (hηrange _).1]
      _ ≤ |a₀ n| := mul_le_of_le_one_left (abs_nonneg _) (hηrange _).2
      _ ≤ (n.divisors.card : ℝ) ^ k := ha₀ n
      _ ≤ (2 * C * x) ^ k := pow_le_pow_left₀ (Nat.cast_nonneg _) (hτn.trans hncut) k
  have hαmass : (∑ n ∈ α.support, ‖α n‖) ≤ (2 * C * x) ^ (k + 1) := by
    calc
      _ ≤ ∑ _n ∈ α.support, (2 * C * x) ^ k := Finset.sum_le_sum hαterm
      _ = (α.support.card : ℝ) * (2 * C * x) ^ k := by simp
      _ ≤ (2 * C * x) * (2 * C * x) ^ k :=
        mul_le_mul_of_nonneg_right hαcard (pow_nonneg (by positivity) _)
      _ = _ := by rw [pow_succ]; ring
  have hqbound (q : ℕ) (hq : q ∈ S) : 0 < q ∧ (q : ℝ) ≤ x ^ θ := by
    have hh := Finset.mem_Icc.mp (hS hq)
    exact ⟨hh.1, (Nat.cast_le.mpr hh.2).trans (Nat.floor_le (Real.rpow_nonneg hxpos.le _))⟩
  have hScard : (S.card : ℝ) ≤ x := by
    have hc : S.card ≤ ⌊x ^ θ⌋₊ := by
      simpa only [Nat.card_Icc, Nat.add_sub_cancel] using Finset.card_le_card hS
    calc
      (S.card : ℝ) ≤ (⌊x ^ θ⌋₊ : ℝ) := Nat.cast_le.mpr hc
      _ ≤ x ^ θ := Nat.floor_le (Real.rpow_nonneg hxpos.le _)
      _ ≤ x := by simpa only [Real.rpow_one] using
        Real.rpow_le_rpow_of_exponent_le hxone hθhi.le
  have hbudget : (∑ _q ∈ S, ∑ n ∈ α.support, ‖α n‖) ≤ x ^ ((k + 3 : ℕ) : ℝ) := by
    calc
      _ = (S.card : ℝ) * ∑ n ∈ α.support, ‖α n‖ := by simp
      _ ≤ x * (2 * C * x) ^ (k + 1) :=
        mul_le_mul hScard hαmass (Finset.sum_nonneg fun _ _ => norm_nonneg _) hxpos.le
      _ = (2 * C) ^ (k + 1) * x ^ (k + 2) := by
        rw [mul_pow, show k + 2 = (k + 1) + 1 by omega, pow_succ]
        ring
      _ ≤ x * x ^ (k + 2) :=
        mul_le_mul_of_nonneg_right hxconstant (pow_nonneg hxpos.le _)
      _ = x ^ ((k + 3 : ℕ) : ℝ) := by
        rw [Real.rpow_natCast, show k + 3 = (k + 2) + 1 by omega, pow_succ]
        ring
  have hlong (q : ℕ) (hq : q ∈ S) : x ^ ε * (q : ℝ) ≤ N := by
    calc
      x ^ ε * (q : ℝ) ≤ x ^ ε * x ^ θ :=
        mul_le_mul_of_nonneg_left (hqbound q hq).2 (Real.rpow_nonneg hxpos.le _)
      _ = x ^ (θ + ε) := by rw [← Real.rpow_add hxpos, add_comm]
      _ ≤ N := hlarge
  have hz := hzero x hx₀ S (fun q hq => (hqbound q hq).1)
    (fun _ => 1) (fun _ _ => zero_le_one) (fun _ => α)
    (by simpa only [one_mul, Real.rpow_zero, mul_one] using hbudget)
    (fun _ => N) (fun _ => 0) (fun _ _ => hNpos) hlong
    (fun _ _ => by positivity)
    (fun _ u => (η u : ℂ)) (fun _ _ => hηsmooth) (fun _ _ => hsupp)
    (fun _ _ u => hbounds u) a ha
  simp only [one_mul, hβ] at hz
  simpa only [one_mul, Real.rpow_neg hlogpos.le, div_eq_mul_inv] using hz

open Classical in
theorem sifted_short_geometric_typeII_coherent_log_saving
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : ℕ) («ω» δ σ C D : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ) (hσ : 0 < σ) (hC : 1 ≤ C) (hD : 1 ≤ D)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1)) :
    ∀ A : ℝ, 0 < A →
      ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
        ∀ x : ℝ, X ≤ x → ∀ l : Fin 6, ∀ M N : ℝ,
        x / C ≤ M * N → M * N ≤ C * x → 1 ≤ N →
        x ^ (1 / 2 - σ) ≤ M → M ≤ x ^ (1 / 2 : ℝ) →
        let Θ := 1 + (Real.log x) ^ (-D)
        let η : ℝ → ℝ := fun u =>
          if 0 < u then
            Real.smoothTransition (Real.log u / Real.log Θ + 1) -
              Real.smoothTransition (Real.log u / Real.log Θ)
          else 0
        let z := x ^ ((9519 : ℝ) / 50000)
        let M0 := x ^ (1 - (1058 : ℝ) / 3125)
        let S0 : ℕ → ℝ := fun n =>
          if (n : ℝ) ≤ M0 then
            ∑ ps ∈ siftedPrimeTuples x l, ∑ d ∈ n.divisorsAntidiagonal,
              if d.1 = ps.prod then smallPrimeMobius z d.2 else 0
          else 0
        let α : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc 1 (Nat.floor (Θ * M)),
          Finsupp.single n ((η ((n : ℝ) / M) * S0 n : ℝ) : ℂ)
        let β : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc 1 (Nat.floor (Θ * N)),
          Finsupp.single n
            ((η ((n : ℝ) / N) * (ArithmeticFunction.zeta n : ℝ) : ℝ) : ℂ)
        ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
        ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
          (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
              q ∣ (∏ p ∈ I, p) ∧
                Nonempty (DenseDivisibilityWitness
                  ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩
                  j q)),
            ‖fullDiscrepancy (finiteConvolution α β) q a‖) ≤
              K * x / (Real.log x) ^ A := by
  have hε : 0 < (1 / 2 : ℝ) - σ := by
    rcases hsource with h | h | h
    · linarith [h.2.1]
    · linarith [h.2.1]
    · linarith [h.2.2.1]
  let ι := Fin 6 × ℝ × ℝ
  let good (x : ℝ) (b : ι) : Prop :=
    x / C ≤ b.2.1 * b.2.2 ∧ b.2.1 * b.2.2 ≤ C * x ∧ 1 ≤ b.2.2 ∧
      x ^ (1 / 2 - σ) ≤ b.2.1 ∧ b.2.1 ≤ x ^ (1 / 2 : ℝ)
  let Θ (x : ℝ) := 1 + (Real.log x) ^ (-D)
  let η (x : ℝ) : ℝ → ℝ := fun u =>
    if 0 < u then
      Real.smoothTransition (Real.log u / Real.log (Θ x) + 1) -
        Real.smoothTransition (Real.log u / Real.log (Θ x))
    else 0
  let S0 (x : ℝ) (l : Fin 6) : ℕ → ℝ := fun n =>
    if (n : ℝ) ≤ x ^ (1 - (1058 : ℝ) / 3125) then
      ∑ ps ∈ siftedPrimeTuples x l, ∑ d ∈ n.divisorsAntidiagonal,
        if d.1 = ps.prod then smallPrimeMobius (x ^ ((9519 : ℝ) / 50000)) d.2 else 0
    else 0
  let rawShort (x : ℝ) (b : ι) : ℕ →₀ ℂ :=
    ∑ n ∈ Finset.Icc 1 (Nat.floor (Θ x * b.2.1)), Finsupp.single n
      ((η x ((n : ℝ) / b.2.1) * S0 x b.1 n : ℝ) : ℂ)
  let rawFree (x : ℝ) (b : ι) : ℕ →₀ ℂ :=
    positiveCompactProfileSequence (fun u => (η x u : ℂ)) 2 b.2.2 0
  let C₀ : ℝ := max C 2
  let X₀ : ℝ := Real.exp 1
  let Mformal (x : ℝ) (b : ι) : ℝ :=
    if good x b then b.2.2 else x ^ (1 / 2 : ℝ)
  let Nformal (x : ℝ) (b : ι) : ℝ :=
    if good x b then b.2.1 else x ^ (1 / 2 : ℝ)
  let α (x : ℝ) (b : ι) : ℕ →₀ ℂ := if good x b then rawFree x b else 0
  let β (x : ℝ) (b : ι) : ℕ →₀ ℂ := if good x b then rawShort x b else 0
  have hC₀ : 1 ≤ C₀ := hC.trans (le_max_left _ _)
  have hCC₀ : C ≤ C₀ := le_max_left _ _
  have htwoC₀ : (2 : ℝ) ≤ C₀ := le_max_right _ _
  have hxOne (x : ℝ) (hx : X₀ ≤ x) : 1 ≤ x :=
    (Real.one_le_exp_iff.mpr (by norm_num : (0 : ℝ) ≤ 1)).trans hx
  have hxPos (x : ℝ) (hx : X₀ ≤ x) : 0 < x :=
    zero_lt_one.trans_le (hxOne x hx)
  have hxGt (x : ℝ) (hx : X₀ ≤ x) : 1 < x :=
    (Real.one_lt_exp_iff.mpr (by norm_num : (0 : ℝ) < 1)).trans_le hx
  have hlog (x : ℝ) (hx : X₀ ≤ x) : 1 ≤ Real.log x :=
    (Real.le_log_iff_exp_le (hxPos x hx)).mpr hx
  obtain ⟨B, _, hprofiles⟩ := sifted_short_geometric_profile_bounds D hD
  have hp (x : ℝ) (hx : X₀ ≤ x) :
      1 < Θ x ∧ Θ x ≤ 2 ∧
        Function.support (fun u => (η x u : ℂ)) ⊆ Set.Icc (1 / 2 : ℝ) 2 ∧
        (∀ u : ℝ, 0 ≤ η x u ∧ η x u ≤ 1) := by
    obtain ⟨hΘ, hΘ₂, _, hs, hr, _⟩ := hprofiles x hx
    refine ⟨hΘ, hΘ₂, ?_, hr⟩
    change Function.support (fun u => (η x u : ℂ)) = Set.Ioo (Θ x)⁻¹ (Θ x) at hs
    rw [hs]
    apply Set.Ioo_subset_Icc_self.trans
    apply Set.Icc_subset_Icc _ hΘ₂
    simpa only [one_div] using
      one_div_le_one_div_of_le (zero_lt_one.trans hΘ) hΘ₂
  have hshort (x : ℝ) (hx : X₀ ≤ x) (b : ι) (hg : good x b) :
      (∀ n : ℕ, rawShort x b n = ((η x ((n : ℝ) / b.2.1) * S0 x b.1 n : ℝ) : ℂ)) ∧
        (∀ n ∈ (rawShort x b).support,
          b.2.1 / 2 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * b.2.1) ∧
        ∀ n : ℕ, ‖rawShort x b n‖ ≤ (n.divisors.card : ℝ) ^ 3 := by
    have hM : 0 < b.2.1 := (Real.rpow_pos_of_pos (hxPos x hx) _).trans_le hg.2.2.2.1
    exact sifted_short_geometric_coefficient_bounds x (Θ x) b.2.1
      (hxGt x hx) (hp x hx).1 (hp x hx).2.1 hM b.1
  have hfree (x : ℝ) (hx : X₀ ≤ x) (b : ι) (hg : good x b) :
      (∀ n ∈ (rawFree x b).support,
        b.2.2 / 2 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * b.2.2) ∧
        ∀ n : ℕ, ‖rawFree x b n‖ ≤ (n.divisors.card : ℝ) ^ 3 := by
    have hN : 0 < b.2.2 := zero_lt_one.trans_le hg.2.2.1
    have happly (n : ℕ) : rawFree x b n = (η x ((n : ℝ) / b.2.2) : ℂ) :=
      positiveCompactProfileSequence_apply (1 / 2) 2 b.2.2 (by norm_num) hN
        (fun u => (η x u : ℂ)) (hp x hx).2.2.1 n
    refine ⟨?_, ?_⟩
    · intro n hn
      have he : (η x ((n : ℝ) / b.2.2) : ℂ) ≠ 0 := by
        simpa only [happly] using Finsupp.mem_support_iff.mp hn
      have hs := (hp x hx).2.2.1 he
      have hl := (le_div_iff₀ hN).mp hs.1
      exact ⟨by linarith, (div_le_iff₀ hN).mp hs.2⟩
    · intro n
      rw [happly]
      by_cases hn : n = 0
      · subst n
        simp [η]
      · have htau : (1 : ℝ) ≤ (n.divisors.card : ℝ) := by
          exact_mod_cast Finset.one_le_card.mpr ⟨1, Nat.one_mem_divisors.mpr hn⟩
        have hrange := (hp x hx).2.2.2 ((n : ℝ) / b.2.2)
        rw [Complex.norm_real, Real.norm_eq_abs, abs_of_nonneg hrange.1]
        exact hrange.2.trans (one_le_pow₀ htau)
  have hscale : ∀ x : ℝ, X₀ ≤ x → ∀ b : ι,
      x / C₀ ≤ Mformal x b * Nformal x b ∧
        Mformal x b * Nformal x b ≤ C₀ * x ∧
        x ^ (1 / 2 - σ) ≤ Nformal x b ∧ Nformal x b ≤ x ^ (1 / 2 : ℝ) := by
    intro x hx b
    by_cases hg : good x b
    · simp only [Mformal, Nformal, ite_eq_left hg]
      rw [mul_comm b.2.2 b.2.1]
      exact ⟨(div_le_div_of_nonneg_left (hxPos x hx).le
          (zero_lt_one.trans_le hC) hCC₀).trans hg.1,
        hg.2.1.trans (mul_le_mul_of_nonneg_right hCC₀ (hxPos x hx).le), hg.2.2.2⟩
    · simp only [Mformal, Nformal, ite_eq_right hg]
      have hsq : x ^ (1 / 2 : ℝ) * x ^ (1 / 2 : ℝ) = x := by
        rw [← Real.rpow_add (hxPos x hx)]
        norm_num
      rw [hsq]
      exact ⟨div_le_self (hxPos x hx).le hC₀,
        le_mul_of_one_le_left (hxPos x hx).le hC₀,
        Real.rpow_le_rpow_of_exponent_le (hxOne x hx) (by linarith), le_rfl⟩
  have hsupport : ∀ x : ℝ, X₀ ≤ x → ∀ b : ι,
      (∀ n ∈ (α x b).support,
        (1 / 2 : ℝ) * Mformal x b ≤ (n : ℝ) ∧ (n : ℝ) ≤ C₀ * Mformal x b) ∧
      (∀ n ∈ (β x b).support,
        (1 / 2 : ℝ) * Nformal x b ≤ (n : ℝ) ∧ (n : ℝ) ≤ C₀ * Nformal x b) := by
    intro x hx b
    by_cases hg : good x b
    · simp only [α, β, Mformal, Nformal, ite_eq_left hg]
      have hM : 0 < b.2.1 := (Real.rpow_pos_of_pos (hxPos x hx) _).trans_le hg.2.2.2.1
      have hN : 0 < b.2.2 := zero_lt_one.trans_le hg.2.2.1
      constructor
      · intro n hn
        obtain ⟨hl, hu⟩ := (hfree x hx b hg).1 n hn
        exact ⟨by linarith, hu.trans (mul_le_mul_of_nonneg_right htwoC₀ hN.le)⟩
      · intro n hn
        obtain ⟨hl, hu⟩ := (hshort x hx b hg).2.1 n hn
        exact ⟨by linarith, hu.trans (mul_le_mul_of_nonneg_right htwoC₀ hM.le)⟩
    · constructor
      · intro n hn
        simp only [α, ite_eq_right hg, Finsupp.support_zero, Finset.notMem_empty] at hn
      · intro n hn
        simp only [β, ite_eq_right hg, Finsupp.support_zero, Finset.notMem_empty] at hn
  have hcoeff : ∀ x : ℝ, X₀ ≤ x → ∀ b : ι, ∀ n : ℕ,
      ‖α x b n‖ ≤ 1 * (n.divisors.card : ℝ) ^ 3 * (Real.log x) ^ 3 ∧
      ‖β x b n‖ ≤ 1 * (n.divisors.card : ℝ) ^ 3 * (Real.log x) ^ 3 := by
    intro x hx b n
    have hlogpow : 1 ≤ (Real.log x) ^ (3 : ℕ) := one_le_pow₀ (hlog x hx)
    have hbound : (n.divisors.card : ℝ) ^ 3 ≤
        1 * (n.divisors.card : ℝ) ^ 3 * (Real.log x) ^ 3 := by
      simpa only [one_mul] using
        le_mul_of_one_le_right (pow_nonneg (Nat.cast_nonneg _) 3) hlogpow
    by_cases hg : good x b
    · simp only [α, β, ite_eq_left hg]
      exact ⟨((hfree x hx b hg).2 n).trans hbound,
        ((hshort x hx b hg).2.2 n).trans hbound⟩
    · simp only [α, β, ite_eq_right hg, Finsupp.zero_apply, norm_zero, one_mul, and_self]
      exact mul_nonneg (pow_nonneg (Nat.cast_nonneg _) _)
        (pow_nonneg (zero_le_one.trans (hlog x hx)) _)
  have hSW : ∀ A : ℝ, 0 < A →
      ∃ KSW XSW : ℝ, 0 < KSW ∧ X₀ ≤ XSW ∧
        ∀ x : ℝ, XSW ≤ x → ∀ b : ι,
        ∀ q r a : ℕ, 0 < q → 0 < r → Nat.Coprime a q →
          ‖fullDiscrepancy ((β x b).filter (fun n : ℕ => Nat.Coprime n r)) q a‖ ≤
            KSW * ((q * r).divisors.card : ℝ) ^ 1 * Nformal x b /
              (Real.log x) ^ A := by
    intro A hA
    obtain ⟨KSW, XSW, hKSW, hXSW, hsw⟩ :=
      sifted_short_geometric_all_moduli_siegelWalfisz
        (1 / 2 - σ) 1 A D hε (by norm_num) hA hD
    refine ⟨KSW, XSW, hKSW, hXSW, ?_⟩
    intro x hx b q r a hq hr ha
    have hx₀ : X₀ ≤ x := hXSW.trans hx
    by_cases hg : good x b
    · have hMU : b.2.1 ≤ x ^ (1 : ℝ) := hg.2.2.2.2.trans
        (Real.rpow_le_rpow_of_exponent_le (hxOne x hx₀) (by norm_num))
      have hd := hsw x hx b.2.1 hg.2.2.2.1 hMU b.1 0 (2 * b.2.1) q hq r hr a ha
      change ‖fullDiscrepancy ((rawShort x b).filter
        (fun n : ℕ => 0 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * b.2.1 ∧ Nat.Coprime n r)) q a‖ ≤
          KSW * ((q * r).divisors.card : ℝ) * b.2.1 / (Real.log x) ^ A at hd
      have hf : (rawShort x b).filter
          (fun n : ℕ => 0 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * b.2.1 ∧ Nat.Coprime n r) =
          (rawShort x b).filter (fun n : ℕ => Nat.Coprime n r) := by
        ext n
        simp only [Finsupp.filter_apply]
        by_cases hn : rawShort x b n = 0
        · simp [hn]
        · have hu := ((hshort x hx₀ b hg).2.1 n (Finsupp.mem_support_iff.mpr hn)).2
          simp only [Nat.cast_nonneg, hu, true_and]
      rw [hf] at hd
      simpa only [β, Nformal, ite_eq_left hg, pow_one] using hd
    · simp only [β, Nformal, ite_eq_right hg, Finsupp.filter_zero, fullDiscrepancy,
        progressionMass, reducedMass, Finsupp.support_zero, Finset.sum_empty,
        zero_div, sub_self, norm_zero]
      exact div_nonneg
        (mul_nonneg (mul_nonneg hKSW.le (pow_nonneg (Nat.cast_nonneg _) _))
          (Real.rpow_nonneg (hxPos x hx₀).le _))
        (Real.rpow_nonneg (zero_le_one.trans (hlog x hx₀)) _)
  intro A hA
  obtain ⟨K, X, hK, hX, hdist⟩ :=
    central_prime_box_distribution_backend hDeligne j «ω» δ σ hω hδ hσ hsource
      Mformal Nformal α β (1 / 2) C₀ 1 X₀ 3 1
      (by norm_num) hC₀ (by norm_num) le_rfl hscale hsupport hcoeff hSW A hA
  refine ⟨K, X, hK, hX, ?_⟩
  intro x hx l M N hpL hpU hN hML hMU Θ0 η0 z M0 S00 α0 β0 I hI a ha
  let b : ι := (l, M, N)
  have hg : good x b := ⟨hpL, hpU, hN, hML, hMU⟩
  have hx₀ : X₀ ≤ x := hX.trans hx
  have hα : α x b = β0 := by
    simp only [α, ite_eq_left hg]
    exact sifted_short_geometric_free_eq (Θ x) N (hp x hx₀).1 (hp x hx₀).2.1
      (zero_lt_one.trans_le hN)
  have hβ : β x b = α0 := by
    simp only [β, ite_eq_left hg]
    rfl
  have hcomm : finiteConvolution β0 α0 = finiteConvolution α0 β0 := by
    unfold finiteConvolution
    rw [mul_comm]
  simpa only [hα, hβ, hcomm] using hdist x hx b I hI a ha

open Classical in
theorem arithmeticFunction_zeta_finite_smooth_box_boundary
    (a₀ : ArithmeticFunction ℝ) (k : ℕ)
    (ha₀ : ∀ n : ℕ, |a₀ n| ≤ (n.divisors.card : ℝ) ^ k)
    (A B Θ : ℝ) (hA : 1 ≤ A) (hAB : A ≤ B)
    (hΘ : 1 < Θ) (hΘtwo : Θ ≤ 2) :
    let η : ℝ → ℝ := fun u =>
      if 0 < u then
        Real.smoothTransition (Real.log u / Real.log Θ + 1) -
          Real.smoothTransition (Real.log u / Real.log Θ)
      else 0
    let M : ℕ := ⌈Real.log B / Real.log Θ⌉₊
    let J : Finset (Fin 2 → ℕ) :=
      Fintype.piFinset (fun _ : Fin 2 => Finset.range (M + 1))
    let scale : (Fin 2 → ℕ) → Fin 2 → ℝ := fun ν i => Θ ^ (ν i)
    let E : Finset (Fin 2 → ℕ) := J.filter (fun ν =>
      A / Θ ^ 2 ≤ (∏ i : Fin 2, scale ν i) ∧
        (∏ i : Fin 2, scale ν i) ≤ B * Θ ^ 2)
    let f : Fin 2 → ArithmeticFunction ℝ :=
      ![a₀, (ArithmeticFunction.zeta : ArithmeticFunction ℝ)]
    let β : (Fin 2 → ℕ) → Fin 2 → MonoidAlgebra ℂ ℕ := fun ν i =>
      ∑ n ∈ Finset.Icc 1 ⌊Θ * scale ν i⌋₊,
        MonoidAlgebra.single n ((η ((n : ℝ) / scale ν i) * f i n : ℝ) : ℂ)
    let g : ℕ →₀ ℂ := ∑ ν ∈ E, (∏ i : Fin 2, β ν i).coeff
    let target : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc ⌈A⌉₊ ⌊B⌋₊,
      Finsupp.single n (((a₀ * (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n : ℝ) : ℂ)
    let error : ℕ →₀ ℂ := g - target
    E.card ≤ (M + 1) ^ 2 ∧
      target = g.filter (fun n : ℕ => A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B) ∧
      (∀ ν ∈ E, ∀ i : Fin 2, ∀ n ∈ (β ν i).coeff.support,
        scale ν i / Θ ≤ (n : ℝ) ∧ (n : ℝ) ≤ Θ * scale ν i ∧
          ‖(β ν i).coeff n‖ ≤ if i = 0 then (n.divisors.card : ℝ) ^ k else 1) ∧
      (∀ n ∈ error.support,
        (A / Θ ^ 4 ≤ (n : ℝ) ∧ (n : ℝ) < A) ∨
          (B < (n : ℝ) ∧ (n : ℝ) ≤ B * Θ ^ 4)) ∧
      ∀ n : ℕ, ‖error n‖ ≤ (n.divisors.card : ℝ) ^ (k + 1) := by
  intro η M J scale E f β g target error
  let H : ArithmeticFunction ℝ := a₀ * (ArithmeticFunction.zeta : ArithmeticFunction ℝ)
  have hB : 1 ≤ B := hA.trans hAB
  have hΘpos : 0 < Θ := zero_lt_one.trans hΘ
  have hpow (m : ℕ) : 0 < Θ ^ m := pow_pos hΘpos m
  obtain ⟨_, _, hprofiles⟩ := heathBrown_geometric_profiles_uniform
  rcases hprofiles Θ hΘ hΘtwo with ⟨_, hηsupport, hηbounds, _, hgrid⟩
  change Function.support η = Set.Ioo Θ⁻¹ Θ at hηsupport
  change ∀ u : ℝ, 0 ≤ η u ∧ η u ≤ 1 at hηbounds
  rcases hgrid B hB with ⟨_, hmass, hpartition⟩
  change ∀ y : ℝ, 1 ≤ y →
    0 ≤ (∑ m ∈ Finset.range (M + 1), η (y / Θ ^ m)) ∧
      (∑ m ∈ Finset.range (M + 1), η (y / Θ ^ m)) ≤ 1 at hmass
  change ∀ y : ℝ, 1 ≤ y → y ≤ B →
    ∑ m ∈ Finset.range (M + 1), η (y / Θ ^ m) = 1 at hpartition
  have hηmem {u : ℝ} (hu : η u ≠ 0) : Θ⁻¹ < u ∧ u < Θ := by
    have hu' : u ∈ Function.support η := hu
    rwa [hηsupport] at hu'
  let a : ℕ → Fin 2 → ArithmeticFunction ℝ := fun m i =>
    ⟨fun n => η ((n : ℝ) / Θ ^ m) * f i n, by simp⟩
  let aabs : ℕ → Fin 2 → ArithmeticFunction ℝ := fun m i =>
    ⟨fun n => η ((n : ℝ) / Θ ^ m) * |f i n|, by simp⟩
  let a₀abs : ArithmeticFunction ℝ := ⟨fun n => |a₀ n|, by simp⟩
  let z : Fin 2 → ArithmeticFunction ℝ :=
    ![a₀abs, (ArithmeticFunction.zeta : ArithmeticFunction ℝ)]
  let ev (n : ℕ) : ArithmeticFunction ℝ →+ ℝ :=
    { toFun := fun F => F n
      map_zero' := rfl
      map_add' := fun _ _ => rfl }
  have hasupport (m : ℕ) (i : Fin 2) (n : ℕ)
      (han : a m i n ≠ 0) :
      0 < n ∧ Θ ^ m / Θ ≤ (n : ℝ) ∧ (n : ℝ) ≤ Θ * Θ ^ m := by
    have hηne : η ((n : ℝ) / Θ ^ m) ≠ 0 :=
      left_ne_zero_of_mul han
    rcases hηmem hηne with ⟨hl, hu⟩
    have hlo : Θ⁻¹ * Θ ^ m < (n : ℝ) := (lt_div_iff₀ (hpow m)).mp hl
    have hup : (n : ℝ) < Θ * Θ ^ m := (div_lt_iff₀ (hpow m)).mp hu
    refine ⟨?_, ?_, hup.le⟩
    · exact_mod_cast (mul_pos (inv_pos.mpr hΘpos) (hpow m)).trans hlo
    · simpa only [div_eq_mul_inv, mul_comm] using hlo.le
  have hβ (ν : Fin 2 → ℕ) (i : Fin 2) (n : ℕ) :
      (β ν i).coeff n = (a (ν i) i n : ℂ) := by
    have hcut : (β ν i).coeff n =
        if n ∈ Finset.Icc 1 ⌊Θ * scale ν i⌋₊ then (a (ν i) i n : ℂ) else 0 := by
      simp only [β, a, scale, MonoidAlgebra.coeff_sum, MonoidAlgebra.coeff_single,
        Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_ite_eq',
        ArithmeticFunction.coe_mk]
    rw [hcut]
    by_cases hn : n ∈ Finset.Icc 1 ⌊Θ * scale ν i⌋₊
    · exact ite_eq_left hn
    · rw [ite_eq_right hn]
      have ha : a (ν i) i n = 0 := by
        by_contra ha
        rcases hasupport (ν i) i n ha with ⟨hnpos, _, hnup⟩
        exact hn (Finset.mem_Icc.mpr ⟨hnpos, Nat.le_floor (by simpa only [scale] using hnup)⟩)
      rw [ha, Complex.ofReal_zero]
  have hcoeffMul (P Q : MonoidAlgebra ℂ ℕ) (p q : ArithmeticFunction ℝ)
      (hP : ∀ n, P.coeff n = (p n : ℂ)) (hQ : ∀ n, Q.coeff n = (q n : ℂ)) :
      ∀ n : ℕ, (P * Q).coeff n = ((p * q) n : ℂ) := by
    intro n
    by_cases hn : n = 0
    · subst n
      simp only [ArithmeticFunction.map_zero, Complex.ofReal_zero,
        MonoidAlgebra.coeff_mul, Finsupp.sum]
      apply Finset.sum_eq_zero
      intro x _
      apply Finset.sum_eq_zero
      intro y _
      split_ifs with hxy
      · rcases Nat.mul_eq_zero.mp hxy with hx0 | hy0
        · subst x
          rw [hP]
          simp
        · subst y
          rw [hQ]
          simp
      · rfl
    · rw [MonoidAlgebra.coeff_mul_antidiag P Q n n.divisorsAntidiagonal
        (by intro d; exact Nat.prodMk_mem_divisorsAntidiag hn)]
      simp only [ArithmeticFunction.mul_apply, Complex.ofReal_sum, Complex.ofReal_mul, hP, hQ]
  have hβprod (ν : Fin 2 → ℕ) (s : Finset (Fin 2)) :
      ∀ n : ℕ, (∏ i ∈ s, β ν i).coeff n = ((∏ i ∈ s, a (ν i) i) n : ℂ) := by
    induction s using Finset.induction_on with
    | empty =>
        intro n
        simp only [Finset.prod_empty, ArithmeticFunction.one_apply, MonoidAlgebra.one_def,
          MonoidAlgebra.coeff_single, Finsupp.single_apply, eq_comm]
        split_ifs <;> norm_num
    | @insert i s hi ih =>
        intro n
        simp only [Finset.prod_insert hi]
        exact hcoeffMul (β ν i) (∏ k ∈ s, β ν k)
          (a (ν i) i) (∏ k ∈ s, a (ν k) k) (hβ ν i) ih n
  have hg (n : ℕ) :
      g n = ∑ ν ∈ E, ((∏ i : Fin 2, a (ν i) i) n : ℂ) := by
    simp only [g, Finsupp.finsetSum_apply, hβprod]
  have hfprod : (∏ i : Fin 2, f i) = H := by
    simp only [f, H, Fin.prod_univ_two, Matrix.cons_val_zero, Matrix.cons_val_one]
  have hzprod : (∏ i : Fin 2, z i) =
      a₀abs * (ArithmeticFunction.zeta : ArithmeticFunction ℝ) := by
    simp only [z, Fin.prod_univ_two, Matrix.cons_val_zero, Matrix.cons_val_one]
  have hfz (i : Fin 2) (n : ℕ) : |f i n| ≤ z i n := by
    fin_cases i
    · exact le_rfl
    · change |(ArithmeticFunction.zeta n : ℝ)| ≤ (ArithmeticFunction.zeta n : ℝ)
      exact (abs_of_nonneg (Nat.cast_nonneg _)).le
  have hzsmall (i : Fin 2) (n : ℕ) :
      z i n ≤ if i = 0 then (n.divisors.card : ℝ) ^ k else 1 := by
    fin_cases i
    · change |a₀ n| ≤ (n.divisors.card : ℝ) ^ k
      exact ha₀ n
    · change (ArithmeticFunction.zeta : ArithmeticFunction ℝ) n ≤ 1
      by_cases hn : n = 0
      · simp [hn]
      · simp only [ArithmeticFunction.natCoe_apply, ArithmeticFunction.zeta_apply_ne hn,
          Nat.cast_one, le_refl]
  have haabs (m : ℕ) (i : Fin 2) (n : ℕ) :
      |a m i n| = aabs m i n := by
    simp only [a, aabs, ArithmeticFunction.coe_mk]
    rw [abs_mul, abs_of_nonneg (hηbounds _).1]
  have haabs_nonneg (m : ℕ) (i : Fin 2) (n : ℕ) : 0 ≤ aabs m i n := by
    rw [← haabs]
    exact abs_nonneg _
  have ha_le_absf (m : ℕ) (i : Fin 2) (n : ℕ) : aabs m i n ≤ |f i n| :=
    mul_le_of_le_one_left (abs_nonneg _) (hηbounds _).2
  have hprod_bound (F G : Fin 2 → ArithmeticFunction ℝ)
      (hFG : ∀ i n, |F i n| ≤ G i n) (s : Finset (Fin 2)) :
      ∀ n : ℕ, |(∏ i ∈ s, F i) n| ≤ (∏ i ∈ s, G i) n := by
    induction s using Finset.induction_on with
    | empty =>
        intro n
        simp only [Finset.prod_empty, ArithmeticFunction.one_apply]
        split_ifs <;> norm_num
    | @insert i s hi ih =>
        intro n
        simp only [Finset.prod_insert hi, ArithmeticFunction.mul_apply]
        refine (Finset.abs_sum_le_sum_abs _ _).trans ?_
        apply Finset.sum_le_sum
        intro d _
        rw [abs_mul]
        exact mul_le_mul (hFG i d.1) (ih d.2) (abs_nonneg _)
          ((abs_nonneg _).trans (hFG i d.1))
  have hprod_nonneg (F : Fin 2 → ArithmeticFunction ℝ)
      (hF : ∀ i n, 0 ≤ F i n) (s : Finset (Fin 2)) :
      ∀ n : ℕ, 0 ≤ (∏ i ∈ s, F i) n := by
    intro n
    exact (abs_nonneg _).trans
      (hprod_bound F F (fun i k => (abs_of_nonneg (hF i k)).le) s n)
  have hsumJ (F : ℕ → Fin 2 → ArithmeticFunction ℝ) (n : ℕ) :
      (∑ ν ∈ J, (∏ i : Fin 2, F (ν i) i) n) =
        (∏ i : Fin 2, ∑ m ∈ Finset.range (M + 1), F m i) n := by
    change (∑ ν ∈ J, ev n (∏ i : Fin 2, F (ν i) i)) =
      ev n (∏ i : Fin 2, ∑ m ∈ Finset.range (M + 1), F m i)
    rw [← map_sum]
    congr 1
    exact Finset.sum_prod_piFinset (Finset.range (M + 1)) (fun i m => F m i)
  let b : Fin 2 → ArithmeticFunction ℝ := fun i =>
    ∑ m ∈ Finset.range (M + 1), aabs m i
  have hbnonneg (i : Fin 2) (n : ℕ) : 0 ≤ b i n := by
    change 0 ≤ ev n (∑ m ∈ Finset.range (M + 1), aabs m i)
    rw [map_sum]
    exact Finset.sum_nonneg fun m _ => haabs_nonneg m i n
  have hbbound (i : Fin 2) (n : ℕ) : |b i n| ≤ z i n := by
    rw [abs_of_nonneg (hbnonneg i n)]
    by_cases hn : n = 0
    · simp [hn]
    · have hn1 : 1 ≤ (n : ℝ) := by exact_mod_cast Nat.one_le_iff_ne_zero.mpr hn
      calc
        b i n = (∑ m ∈ Finset.range (M + 1), η ((n : ℝ) / Θ ^ m)) * |f i n| := by
          change ev n (∑ m ∈ Finset.range (M + 1), aabs m i) = _
          rw [map_sum]
          change (∑ m ∈ Finset.range (M + 1), η ((n : ℝ) / Θ ^ m) * |f i n|) = _
          rw [Finset.sum_mul]
        _ ≤ |f i n| := mul_le_of_le_one_left (abs_nonneg _) (hmass (n : ℝ) hn1).2
        _ ≤ z i n := hfz i n
  have hmajor (n : ℕ) : (∏ i : Fin 2, z i) n ≤ (n.divisors.card : ℝ) ^ (k + 1) := by
    rw [hzprod, ArithmeticFunction.coe_mul_zeta_apply]
    by_cases hn : n = 0
    · simp [hn]
    calc
      (∑ d ∈ n.divisors, a₀abs d) ≤ ∑ d ∈ n.divisors, (d.divisors.card : ℝ) ^ k :=
        Finset.sum_le_sum fun d _ => ha₀ d
      _ ≤ ∑ _d ∈ n.divisors, (n.divisors.card : ℝ) ^ k := by
        apply Finset.sum_le_sum
        intro d hd
        apply pow_le_pow_left₀ (Nat.cast_nonneg _) ?_ k
        exact_mod_cast Finset.card_le_card
          (Nat.divisors_subset_of_dvd hn (Nat.dvd_of_mem_divisors hd))
      _ = (n.divisors.card : ℝ) ^ (k + 1) := by
        rw [Finset.sum_const, nsmul_eq_mul, pow_succ]
        ring
  have hgnorm (n : ℕ) : ‖g n‖ ≤ (n.divisors.card : ℝ) ^ (k + 1) := by
    rw [hg]
    calc
      _ ≤ ∑ ν ∈ E, ‖((∏ i : Fin 2, a (ν i) i) n : ℂ)‖ := norm_sum_le _ _
      _ = ∑ ν ∈ E, |(∏ i : Fin 2, a (ν i) i) n| := by
        simp only [Complex.norm_real, Real.norm_eq_abs]
      _ ≤ ∑ ν ∈ E, (∏ i : Fin 2, aabs (ν i) i) n := by
        apply Finset.sum_le_sum
        intro ν _
        exact hprod_bound (fun i => a (ν i) i) (fun i => aabs (ν i) i)
          (fun i n => (haabs (ν i) i n).le) Finset.univ n
      _ ≤ ∑ ν ∈ J, (∏ i : Fin 2, aabs (ν i) i) n :=
        Finset.sum_le_sum_of_subset_of_nonneg (Finset.filter_subset _ _)
          (fun ν _ _ => hprod_nonneg (fun i => aabs (ν i) i)
            (fun i n => haabs_nonneg (ν i) i n) Finset.univ n)
      _ = (∏ i : Fin 2, b i) n := hsumJ aabs n
      _ ≤ (∏ i : Fin 2, z i) n := by
        simpa only [abs_of_nonneg (hprod_nonneg b hbnonneg Finset.univ n)] using
          hprod_bound b z hbbound Finset.univ n
      _ ≤ _ := hmajor n
  have hgeom (ν : Fin 2 → ℕ) (s : Finset (Fin 2)) :
      ∀ n : ℕ, (∏ i ∈ s, a (ν i) i) n ≠ 0 →
        (∏ i ∈ s, scale ν i) / Θ ^ s.card ≤ (n : ℝ) ∧
          (n : ℝ) ≤ (∏ i ∈ s, scale ν i) * Θ ^ s.card := by
    induction s using Finset.induction_on with
    | empty =>
        intro n hn
        have hn1 : n = 1 := by
          by_contra h
          exact hn (by simp [h])
        simp [hn1]
    | @insert i s hi ih =>
        intro n hn
        rw [Finset.prod_insert hi, ArithmeticFunction.mul_apply] at hn
        obtain ⟨d, hd, hdn⟩ := Finset.exists_ne_zero_of_sum_ne_zero hn
        rcases mul_ne_zero_iff.mp hdn with ⟨hd1, hd2⟩
        rcases hasupport (ν i) i d.1 hd1 with ⟨_, hlo, hup⟩
        rcases ih d.2 hd2 with ⟨hlo', hup'⟩
        have hP : 0 < ∏ k ∈ s, scale ν k :=
          Finset.prod_pos fun k _ => hpow (ν k)
        have hdprod : (d.1 : ℝ) * (d.2 : ℝ) = (n : ℝ) := by
          exact_mod_cast (Nat.mem_divisorsAntidiagonal.mp hd).1
        simp only [Finset.prod_insert hi, Finset.card_insert_of_notMem hi]
        constructor
        · calc
            (scale ν i * ∏ k ∈ s, scale ν k) / Θ ^ (s.card + 1) =
                (Θ ^ (ν i) / Θ) * ((∏ k ∈ s, scale ν k) / Θ ^ s.card) := by
              simp only [scale, pow_succ, div_eq_mul_inv, mul_inv_rev]
              ring
            _ ≤ (d.1 : ℝ) * (d.2 : ℝ) :=
              mul_le_mul hlo hlo' (div_nonneg hP.le (hpow s.card).le) (Nat.cast_nonneg _)
            _ = (n : ℝ) := hdprod
        · calc
            (n : ℝ) = (d.1 : ℝ) * (d.2 : ℝ) := hdprod.symm
            _ ≤ (Θ * Θ ^ (ν i)) * ((∏ k ∈ s, scale ν k) * Θ ^ s.card) :=
              mul_le_mul hup hup' (Nat.cast_nonneg _) (mul_pos hΘpos (hpow (ν i))).le
            _ = (scale ν i * ∏ k ∈ s, scale ν k) * Θ ^ (s.card + 1) := by
              simp only [scale, pow_succ]
              ring
  have hgeomFull (ν : Fin 2 → ℕ) (n : ℕ)
      (hn : (∏ i : Fin 2, a (ν i) i) n ≠ 0) :
      (∏ i : Fin 2, scale ν i) / Θ ^ 2 ≤ (n : ℝ) ∧
        (n : ℝ) ≤ (∏ i : Fin 2, scale ν i) * Θ ^ 2 := by
    simpa only [Finset.card_univ, Fintype.card_fin] using hgeom ν Finset.univ n hn
  have hlocal (F G : Fin 2 → ArithmeticFunction ℝ)
      (s : Finset (Fin 2)) :
      ∀ n : ℕ, (∀ i d, d ∣ n → F i d = G i d) →
        (∏ i ∈ s, F i) n = (∏ i ∈ s, G i) n := by
    induction s using Finset.induction_on with
    | empty => intro n _; rfl
    | @insert i s hi ih =>
        intro n h
        simp only [Finset.prod_insert hi, ArithmeticFunction.mul_apply]
        apply Finset.sum_congr rfl
        intro d hd
        have hd1 := Nat.dvd_of_mem_divisors (Nat.fst_mem_divisors_of_mem_antidiagonal hd)
        have hd2 := Nat.dvd_of_mem_divisors (Nat.snd_mem_divisors_of_mem_antidiagonal hd)
        rw [h i d.1 hd1, ih d.2 (fun k e he => h k e (he.trans hd2))]
  have hinside (n : ℕ) (hn : A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B) :
      g n = (H n : ℂ) := by
    have hn0 : n ≠ 0 := by
      intro hz
      have hh := hA.trans hn.1
      norm_num [hz] at hh
    have hEJ : (∑ ν ∈ E, (∏ i : Fin 2, a (ν i) i) n) =
        ∑ ν ∈ J, (∏ i : Fin 2, a (ν i) i) n := by
      apply Finset.sum_subset (Finset.filter_subset _ _)
      intro ν hν hnot
      by_contra hne
      rcases hgeomFull ν n hne with ⟨hl, hu⟩
      apply hnot
      exact Finset.mem_filter.mpr ⟨hν,
        (div_le_iff₀ (hpow 2)).mpr (hn.1.trans hu),
        (div_le_iff₀ (hpow 2)).mp (hl.trans hn.2)⟩
    rw [hg, ← Complex.ofReal_sum, hEJ, hsumJ]
    congr 1
    calc
      (∏ i : Fin 2, ∑ m ∈ Finset.range (M + 1), a m i) n =
          (∏ i : Fin 2, f i) n := by
        apply hlocal _ _ Finset.univ n
        intro i d hd
        have hdmem : d ∈ n.divisors := Nat.mem_divisors.mpr ⟨hd, hn0⟩
        have hd1 : 1 ≤ (d : ℝ) := by exact_mod_cast Nat.pos_of_mem_divisors hdmem
        have hdB : (d : ℝ) ≤ B :=
          (show (d : ℝ) ≤ (n : ℝ) by exact_mod_cast Nat.divisor_le hdmem).trans hn.2
        change ev d (∑ m ∈ Finset.range (M + 1), a m i) = f i d
        rw [map_sum]
        change (∑ m ∈ Finset.range (M + 1), η ((d : ℝ) / Θ ^ m) * f i d) = _
        rw [← Finset.sum_mul, hpartition (d : ℝ) hd1 hdB, one_mul]
      _ = H n := by rw [hfprod]
  have htarget (n : ℕ) :
      target n = if A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B
        then (H n : ℂ) else 0 := by
    have hmem : n ∈ Finset.Icc ⌈A⌉₊ ⌊B⌋₊ ↔ A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B := by
      rw [Finset.mem_Icc, Nat.ceil_le, Nat.le_floor_iff (zero_le_one.trans hB)]
    simp only [target, H, Finsupp.finsetSum_apply, Finsupp.single_apply,
      Finset.sum_ite_eq', hmem]
  have herror (n : ℕ) :
      error n = if A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B then 0 else g n := by
    by_cases hn : A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B
    · simp only [error, Finsupp.sub_apply, htarget, ite_eq_left hn, hinside n hn, sub_self]
    · simp only [error, Finsupp.sub_apply, htarget, ite_eq_right hn, sub_zero]
  refine ⟨?_, ?_, ?_, ?_, ?_⟩
  · calc
      E.card ≤ J.card := Finset.card_le_card (Finset.filter_subset _ _)
      _ = (M + 1) ^ 2 := by simp [J, Fintype.card_piFinset]
  · ext n
    by_cases hn : A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B
    · simp only [htarget, Finsupp.filter_apply, ite_eq_left hn, hinside n hn]
    · simp only [htarget, Finsupp.filter_apply, ite_eq_right hn]
  · intro ν _ i n hn
    have han : a (ν i) i n ≠ 0 :=
      Complex.ofReal_ne_zero.mp (by simpa only [hβ] using Finsupp.mem_support_iff.mp hn)
    rcases hasupport (ν i) i n han with ⟨_, hl, hu⟩
    refine ⟨hl, hu, ?_⟩
    rw [hβ, Complex.norm_real, Real.norm_eq_abs, haabs]
    exact (ha_le_absf (ν i) i n).trans ((hfz i n).trans (hzsmall i n))
  · intro n hn
    have hne := Finsupp.mem_support_iff.mp hn
    have hout : ¬(A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B) := by
      intro hin
      exact hne (by rw [herror, ite_eq_left hin])
    have hgn : g n ≠ 0 := by simpa only [herror, ite_eq_right hout] using hne
    rw [hg] at hgn
    obtain ⟨ν, hν, hνn⟩ := Finset.exists_ne_zero_of_sum_ne_zero hgn
    have hpn : (∏ i : Fin 2, a (ν i) i) n ≠ 0 :=
      Complex.ofReal_ne_zero.mp hνn
    rcases hgeomFull ν n hpn with ⟨hl, hu⟩
    have hbox := (Finset.mem_filter.mp hν).2
    have hlow : A / Θ ^ 4 ≤ (n : ℝ) := by
      calc
        A / Θ ^ 4 = (A / Θ ^ 2) / Θ ^ 2 := by
          rw [div_div, ← pow_add, show (2 : ℕ) + 2 = 4 by omega]
        _ ≤ (∏ i : Fin 2, scale ν i) / Θ ^ 2 :=
          div_le_div_of_nonneg_right hbox.1 (hpow 2).le
        _ ≤ (n : ℝ) := hl
    have hupp : (n : ℝ) ≤ B * Θ ^ 4 := by
      calc
        (n : ℝ) ≤ (∏ i : Fin 2, scale ν i) * Θ ^ 2 := hu
        _ ≤ (B * Θ ^ 2) * Θ ^ 2 :=
          mul_le_mul_of_nonneg_right hbox.2 (hpow 2).le
        _ = B * Θ ^ 4 := by
          rw [mul_assoc, ← pow_add, show (2 : ℕ) + 2 = 4 by omega]
    by_cases hleft : (n : ℝ) < A
    · exact Or.inl ⟨hlow, hleft⟩
    · exact Or.inr ⟨lt_of_not_ge (fun hright => hout ⟨le_of_not_gt hleft, hright⟩), hupp⟩
  · intro n
    rw [herror]
    split_ifs
    · simp only [norm_zero]
      exact pow_nonneg (Nat.cast_nonneg _) _
    · exact hgnorm n

open Classical in
theorem arithmeticFunction_zeta_closedCutoff_log_saving
    (θ : ℝ) (k : ℕ) (Asave : ℝ)
    (hθ0 : 0 < θ) (hθ1 : θ < 1) (hAsave : 0 < Asave) :
    ∃ D : ℕ, 1 ≤ D ∧ ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ a₀ : ArithmeticFunction ℝ,
        (∀ n : ℕ, |a₀ n| ≤ (n.divisors.card : ℝ) ^ k) →
      let Θ : ℝ := 1 + (Real.log x) ^ (-(D : ℝ))
      let η : ℝ → ℝ := fun u =>
        if 0 < u then
          Real.smoothTransition (Real.log u / Real.log Θ + 1) -
            Real.smoothTransition (Real.log u / Real.log Θ)
        else 0
      let M : ℕ := ⌈Real.log (2 * x) / Real.log Θ⌉₊
      let grid : Finset (Fin 2 → ℕ) :=
        Fintype.piFinset (fun _ : Fin 2 => Finset.range (M + 1))
      let scale : (Fin 2 → ℕ) → Fin 2 → ℝ := fun ν i => Θ ^ (ν i)
      let E : Finset (Fin 2 → ℕ) := grid.filter (fun ν =>
        x / Θ ^ 2 ≤ (∏ i : Fin 2, scale ν i) ∧
          (∏ i : Fin 2, scale ν i) ≤ (2 * x) * Θ ^ 2)
      let f : Fin 2 → ArithmeticFunction ℝ :=
        ![a₀, (ArithmeticFunction.zeta : ArithmeticFunction ℝ)]
      let β : (Fin 2 → ℕ) → Fin 2 → MonoidAlgebra ℂ ℕ := fun ν i =>
        ∑ n ∈ Finset.Icc 1 ⌊Θ * scale ν i⌋₊,
          MonoidAlgebra.single n ((η ((n : ℝ) / scale ν i) * f i n : ℝ) : ℂ)
      let target : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        Finsupp.single n
          (((a₀ * (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n : ℝ) : ℂ)
      ∀ S : Finset ℕ, S ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
        (∑ q ∈ S, ‖fullDiscrepancy target q (a q) -
          ∑ ν ∈ E, fullDiscrepancy (∏ i : Fin 2, β ν i).coeff q (a q)‖) ≤
            K * x / (Real.log x) ^ Asave := by
  obtain ⟨Db, hDb, K, Xb, hK, hXb, hboundary⟩ :=
    weighted_boundary_fullDiscrepancy_log_saving
      θ hθ0 hθ1 (k + 1) 0 0 2 32 256 (by norm_num) (by norm_num) Asave hAsave
  have hevent : ∀ᶠ x : ℝ in Filter.atTop, (Real.log x) ^ Db ≤ x := by
    filter_upwards [Filter.eventually_ge_atTop (0 : ℝ),
      (isLittleO_log_rpow_rpow_atTop (Db : ℝ) zero_lt_one).eventuallyLE] with x hx hsmall
    refine (Real.le_norm_self _).trans ?_
    simpa only [Real.rpow_natCast, Real.rpow_one, Real.norm_of_nonneg hx] using hsmall
  obtain ⟨Xr, hXr⟩ := Filter.eventually_atTop.mp hevent
  let D : ℕ := Db + 1
  refine ⟨D, hDb.trans (Nat.le_succ Db), K, max Xb Xr, hK,
    hXb.trans (le_max_left _ _), ?_⟩
  intro x hx a₀ ha₀ Θ η M grid scale E f β target S hS a ha
  have hxxb : Xb ≤ x := (le_max_left _ _).trans hx
  have hxxr : Xr ≤ x := (le_max_right _ _).trans hx
  have hxexp : Real.exp 1 ≤ x := hXb.trans hxxb
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hxone : 1 ≤ x :=
    (Real.one_le_exp_iff.mpr (by norm_num : (0 : ℝ) ≤ 1)).trans hxexp
  let ell : ℝ := Real.log x
  let δ : ℝ := ell ^ (-(D : ℝ))
  have hell : 1 ≤ ell := (Real.le_log_iff_exp_le hxpos).mpr hxexp
  have hellpos : 0 < ell := zero_lt_one.trans_le hell
  have hellDbpos : 0 < ell ^ Db := pow_pos hellpos Db
  have hδbound : δ ≤ 1 / ell ^ Db := by
    calc
      δ ≤ ell ^ (-(Db : ℝ)) := by
        apply Real.rpow_le_rpow_of_exponent_le hell
        dsimp only [D]
        push_cast
        linarith
      _ = 1 / ell ^ Db := by
        rw [Real.rpow_neg hellpos.le, Real.rpow_natCast, one_div]
  have hδone : δ ≤ 1 :=
    Real.rpow_le_one_of_one_le_of_nonpos hell (neg_nonpos.mpr (Nat.cast_nonneg D))
  have hΘeq : Θ = 1 + δ := rfl
  have hΘ : 1 < Θ := lt_add_of_pos_right 1 (Real.rpow_pos_of_pos hellpos _)
  have hΘtwo : Θ ≤ 2 := by rw [hΘeq]; linarith only [hδone]
  have hΘpos : 0 < Θ := zero_lt_one.trans hΘ
  let R : ℝ := Θ ^ 4
  have hRone : 1 ≤ R := one_le_pow₀ hΘ.le
  have hRpos : 0 < R := zero_lt_one.trans_le hRone
  have hRupper : R ≤ 16 := by
    have hh := pow_le_pow_left₀ hΘpos.le hΘtwo 4
    norm_num at hh
    exact hh
  have hRsub : 0 ≤ R - 1 := sub_nonneg.mpr hRone
  have hΘsub : 0 ≤ Θ - 1 := sub_nonneg.mpr hΘ.le
  have hgap : R - 1 ≤ 32 * δ := by
    have hp := abs_pow_sub_pow_le (a := Θ) (b := (1 : ℝ)) (n := 4)
    rw [one_pow] at hp
    change |R - 1| ≤ |Θ - 1| * (4 : ℕ) * max |Θ| |(1 : ℝ)| ^ (4 - 1) at hp
    have hp' : R - 1 ≤ (Θ - 1) * 4 * Θ ^ 3 := by
      simpa only [abs_of_nonneg hRsub, abs_of_nonneg hΘsub,
        abs_of_pos hΘpos, abs_one, max_eq_left hΘ.le, Nat.cast_ofNat] using hp
    calc
      R - 1 ≤ (Θ - 1) * 4 * Θ ^ 3 := hp'
      _ ≤ (Θ - 1) * 4 * (2 : ℝ) ^ 3 :=
        mul_le_mul_of_nonneg_left (pow_le_pow_left₀ hΘpos.le hΘtwo 3)
          (mul_nonneg hΘsub (by norm_num))
      _ = 32 * δ := by rw [hΘeq]; ring
  have hxRpos : 0 < x / R := div_pos hxpos hRpos
  have hBle : 2 * x ≤ (2 * x) * R := le_mul_of_one_le_right (by positivity) hRone
  have hBupper : (2 * x) * R ≤ 32 * x := by
    have hh := mul_le_mul_of_nonneg_left hRupper (show 0 ≤ 2 * x by positivity)
    nlinarith only [hh]
  have hxupper : x ≤ 32 * x := by linarith only [hxpos]
  let b : (Fin 2 → ℕ) → ℕ →₀ ℂ := fun ν => (∏ i : Fin 2, β ν i).coeff
  let error : ℕ →₀ ℂ := (∑ ν ∈ E, b ν) - target
  obtain ⟨_, _, _, hshell, herror⟩ :=
    arithmeticFunction_zeta_finite_smooth_box_boundary a₀ k ha₀
      x (2 * x) Θ hxone (by linarith only [hxpos]) hΘ hΘtwo
  change (∀ n ∈ error.support,
    (x / R ≤ (n : ℝ) ∧ (n : ℝ) < x) ∨
      (2 * x < (n : ℝ) ∧ (n : ℝ) ≤ (2 * x) * R)) at hshell
  change ∀ n : ℕ, ‖error n‖ ≤ (n.divisors.card : ℝ) ^ (k + 1) at herror
  let lo : Fin 2 → ℕ := fun i => if i = 0 then ⌈x / R⌉₊ else ⌊2 * x⌋₊ + 1
  let hi : Fin 2 → ℕ := fun i => if i = 0 then ⌈x⌉₊ else ⌊(2 * x) * R⌋₊ + 1
  have hceil : 1 ≤ ⌈x / R⌉₊ := Nat.one_le_ceil_iff.mpr hxRpos
  have horder0 : ⌈x / R⌉₊ ≤ ⌈x⌉₊ := Nat.ceil_mono (div_le_self hxpos.le hRone)
  have horder1 : ⌊2 * x⌋₊ + 1 ≤ ⌊(2 * x) * R⌋₊ + 1 :=
    Nat.add_le_add_right (Nat.floor_mono hBle) 1
  have hinterval (i : Fin 2) :
      1 ≤ lo i ∧ lo i ≤ hi i ∧ hi i ≤ ⌈32 * x⌉₊ + 1 := by
    by_cases hi0 : i = 0
    · simp only [lo, hi, ite_eq_left hi0]
      exact ⟨hceil, horder0, (Nat.ceil_mono hxupper).trans (Nat.le_succ _)⟩
    · simp only [lo, hi, ite_eq_right hi0]
      exact ⟨by omega, horder1, Nat.add_le_add_right
        ((Nat.floor_mono hBupper).trans (Nat.floor_le_ceil (32 * x))) 1⟩
  have hcover (n : ℕ) (hn : n ∈ error.support) : ∃ i : Fin 2, lo i ≤ n ∧ n < hi i := by
    rcases hshell n hn with hl | hr
    · refine ⟨0, ?_⟩
      simpa [lo, hi] using
        And.intro (Nat.ceil_le.mpr hl.1) (Nat.lt_ceil.mpr hl.2)
    · refine ⟨1, ?_⟩
      simpa [lo, hi] using
        And.intro ((Nat.floor_lt (show 0 ≤ 2 * x by positivity)).mpr hr.1)
          (Nat.lt_succ_of_le (Nat.le_floor hr.2))
  have hleftwidth : ((⌈x⌉₊ - ⌈x / R⌉₊ : ℕ) : ℝ) ≤ x - x / R + 1 := by
    rw [Nat.cast_sub horder0]
    linarith only [(Nat.ceil_lt_add_one hxpos.le).le, Nat.le_ceil (x / R)]
  have hrightwidth :
      ((⌊(2 * x) * R⌋₊ + 1 - (⌊2 * x⌋₊ + 1) : ℕ) : ℝ) ≤
        (2 * x) * R - 2 * x + 1 := by
    rw [Nat.cast_sub horder1]
    simp only [Nat.cast_add, Nat.cast_one]
    linarith only [Nat.floor_le (show 0 ≤ (2 * x) * R by positivity),
      Nat.lt_floor_add_one (2 * x)]
  have hlength : (∑ i : Fin 2, ((hi i - lo i : ℕ) : ℝ)) ≤
      x - x / R + 1 + ((2 * x) * R - 2 * x + 1) := by
    simpa [Fin.sum_univ_two, lo, hi] using add_le_add hleftwidth hrightwidth
  have hfirstreal : x - x / R ≤ x * (R - 1) := by
    calc
      x - x / R = x * ((R - 1) / R) := by field_simp [hRpos.ne']
      _ ≤ x * (R - 1) := mul_le_mul_of_nonneg_left (div_le_self hRsub hRone) hxpos.le
  have hrealwidth : x - x / R + ((2 * x) * R - 2 * x) ≤ 3 * x * (R - 1) := by
    nlinarith only [hfirstreal]
  have hunit : 1 ≤ x / ell ^ Db := (one_le_div hellDbpos).mpr (hXr x hxxr)
  have hwidth : (∑ i : Fin 2, ((hi i - lo i : ℕ) : ℝ)) ≤
      256 * x / (Real.log x) ^ Db := by
    calc
      _ ≤ x - x / R + 1 + ((2 * x) * R - 2 * x + 1) := hlength
      _ = (x - x / R + ((2 * x) * R - 2 * x)) + 2 := by ring
      _ ≤ 3 * x * (R - 1) + 2 := add_le_add hrealwidth le_rfl
      _ ≤ 3 * x * (32 * δ) + 2 :=
        add_le_add (mul_le_mul_of_nonneg_left hgap (by positivity)) le_rfl
      _ = (96 * x) * δ + 2 := by ring
      _ ≤ (96 * x) * (1 / ell ^ Db) + 2 :=
        add_le_add (mul_le_mul_of_nonneg_left hδbound (by positivity)) le_rfl
      _ ≤ (96 * x) * (1 / ell ^ Db) + 2 * (x / ell ^ Db) :=
        add_le_add le_rfl (le_mul_of_one_le_right zero_le_two hunit)
      _ = 98 * x / ell ^ Db := by ring
      _ ≤ 256 * x / ell ^ Db :=
        div_le_div_of_nonneg_right
          (mul_le_mul_of_nonneg_right (by norm_num : (98 : ℝ) ≤ 256) hxpos.le) hellDbpos.le
  have henvelope (n : ℕ) (_hn : n ∈ error.support) :
      ‖error n‖ ≤ (1 : ℝ) * (n.divisors.card : ℝ) ^ (k + 1) * (Real.log x) ^ (0 : ℕ) := by
    simpa only [one_mul, pow_zero, mul_one] using herror n
  have hmask_error (P : ℕ → Prop) [DecidablePred P] :
      error.sum (fun n z => if P n then z else (0 : ℂ)) =
        (∑ ν ∈ E, (b ν).sum (fun n z => if P n then z else (0 : ℂ))) -
          target.sum (fun n z => if P n then z else (0 : ℂ)) := by
    change ((∑ ν ∈ E, b ν) - target).sum
      (fun n z => if P n then z else (0 : ℂ)) = _
    rw [Finsupp.sum_sub_index
      (h := fun n z => if P n then z else (0 : ℂ)) (by
        intro n z w
        by_cases h : P n <;> simp [h]),
      Finsupp.sum_finsetSum b E (fun n z => if P n then z else (0 : ℂ))
        (fun _ => by simp) (by
          intro n z w
          by_cases h : P n <;> simp [h])]
  have hdelta_error (q a : ℕ) :
      PrimeGap186.fullDiscrepancy error q a =
        (∑ ν ∈ E, PrimeGap186.fullDiscrepancy (b ν) q a) -
          PrimeGap186.fullDiscrepancy target q a := by
    have hp := hmask_error (fun n => n % q = a % q)
    have hr := hmask_error (fun n => Nat.Coprime n q)
    simp only [Finsupp.sum] at hp hr
    simp only [PrimeGap186.fullDiscrepancy,
      progressionMass, reducedMass,
      hp, hr, Finset.sum_sub_distrib, sub_div, Finset.sum_div]
    ring
  calc
    _ = ∑ q ∈ S, ‖fullDiscrepancy error q (a q)‖ := by
      apply Finset.sum_congr rfl
      intro q _
      rw [hdelta_error, norm_sub_rev]
    _ ≤ K * x / (Real.log x) ^ Asave := by
      have hh := hboundary x hxxb 1 zero_le_one S hS a ha lo hi
        hinterval hwidth error hcover henvelope
      simpa only [pow_zero, one_mul, mul_one] using hh

open Classical in
theorem sifted_short_geometric_smooth_log_saving
    (D «ω» δ γ₀ C : ℝ) (hD : 1 ≤ D)
    (hω : 0 < «ω») (hδ : 0 < δ) (hγ₀ : 0 < γ₀)
    (hgap : 1 / 4 + 7 * «ω» + 2 * δ < γ₀) (hγhi : γ₀ ≤ 1 / 2)
    (hC : 1 ≤ C) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ l : Fin 6, ∀ M N : ℝ,
        0 < M → x / C ≤ M * N → M * N ≤ C * x →
        x ^ γ₀ ≤ N → N ≤ C * Real.sqrt x →
      let Θ := 1 + (Real.log x) ^ (-D)
      let η : ℝ → ℝ := fun u => if 0 < u then
        Real.smoothTransition (Real.log u / Real.log Θ + 1) -
          Real.smoothTransition (Real.log u / Real.log Θ) else 0
      let z := x ^ ((9519 : ℝ) / 50000)
      let M0 := x ^ (1 - (1058 : ℝ) / 3125)
      let S0 : ℕ → ℝ := fun n => if (n : ℝ) ≤ M0 then
        ∑ ps ∈ siftedPrimeTuples x l, ∑ d ∈ n.divisorsAntidiagonal,
          if d.1 = ps.prod then smallPrimeMobius z d.2 else 0 else 0
      let α : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc 1 ⌊Θ * M⌋₊,
        Finsupp.single n ((η ((n : ℝ) / M) * S0 n : ℝ) : ℂ)
      let β : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc 1 ⌊Θ * N⌋₊,
        Finsupp.single n ((η ((n : ℝ) / N) *
          (ArithmeticFunction.zeta n : ℝ) : ℝ) : ℂ)
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
            q ∣ (∏ p ∈ I, p) ∧ Nonempty
              (DenseDivisibilityWitness
                ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ 1 q)),
          ‖fullDiscrepancy (finiteConvolution α β) q a‖) ≤
            K * x / (Real.log x) ^ A := by
  let ι := Fin 6 × ℝ × ℝ
  let good (x : ℝ) (i : ι) : Prop :=
    0 < i.2.1 ∧ x / C ≤ i.2.1 * i.2.2 ∧ i.2.1 * i.2.2 ≤ C * x ∧
      x ^ γ₀ ≤ i.2.2 ∧ i.2.2 ≤ C * Real.sqrt x
  let Θ (x : ℝ) := 1 + (Real.log x) ^ (-D)
  let η (x u : ℝ) : ℝ := if 0 < u then
    Real.smoothTransition (Real.log u / Real.log (Θ x) + 1) -
      Real.smoothTransition (Real.log u / Real.log (Θ x)) else 0
  let S0 (x : ℝ) (l : Fin 6) (n : ℕ) : ℝ :=
    if (n : ℝ) ≤ x ^ (1 - (1058 : ℝ) / 3125) then
      ∑ ps ∈ siftedPrimeTuples x l, ∑ d ∈ n.divisorsAntidiagonal,
        if d.1 = ps.prod then smallPrimeMobius (x ^ ((9519 : ℝ) / 50000)) d.2 else 0
    else 0
  let α₀ (x : ℝ) (i : ι) : ℕ →₀ ℂ :=
    ∑ n ∈ Finset.Icc 1 ⌊Θ x * i.2.1⌋₊,
      Finsupp.single n ((η x ((n : ℝ) / i.2.1) * S0 x i.1 n : ℝ) : ℂ)
  let Mf (x : ℝ) (i : ι) := if good x i then i.2.1 else Real.sqrt x
  let Nf (x : ℝ) (i : ι) := if good x i then i.2.2 else Real.sqrt x
  let αf (x : ℝ) (i : ι) : ℕ →₀ ℂ := if good x i then α₀ x i else 0
  let ψ (x : ℝ) (i : ι) : ℝ → ℂ :=
    if good x i then fun u => (η x u : ℂ) else 0
  let C' : ℝ := max C 2
  have hC' : 1 ≤ C' := hC.trans (le_max_left _ _)
  have hCC' : C ≤ C' := le_max_left _ _
  have htwoC' : 2 ≤ C' := le_max_right _ _
  have hCp : 0 < C := zero_lt_one.trans_le hC
  have hC'p : 0 < C' := zero_lt_one.trans_le hC'
  have hxpos (x : ℝ) (hx : Real.exp 1 ≤ x) : 0 < x :=
    (Real.exp_pos 1).trans_le hx
  have hxone (x : ℝ) (hx : Real.exp 1 ≤ x) : 1 ≤ x :=
    (Real.one_le_exp (by norm_num : (0 : ℝ) ≤ 1)).trans hx
  have hxgt (x : ℝ) (hx : Real.exp 1 ≤ x) : 1 < x :=
    (Real.one_lt_exp_iff.mpr (by norm_num : (0 : ℝ) < 1)).trans_le hx
  have hlogone (x : ℝ) (hx : Real.exp 1 ≤ x) : 1 ≤ Real.log x :=
    (Real.le_log_iff_exp_le (hxpos x hx)).mpr hx
  obtain ⟨B, hB, hprofiles⟩ := sifted_short_geometric_profile_bounds D hD
  have hprofile (x : ℝ) (hx : Real.exp 1 ≤ x) := hprofiles x hx
  have hsuppη (x : ℝ) (hx : Real.exp 1 ≤ x) :
      Function.support (fun u => (η x u : ℂ)) ⊆ Set.Icc (1 / 2 : ℝ) C' := by
    have hp := hprofile x hx
    have hs := hp.2.2.2.1
    change Function.support (fun u => (η x u : ℂ)) = Set.Ioo (Θ x)⁻¹ (Θ x) at hs
    rw [hs]
    have hh : (1 / 2 : ℝ) ≤ (Θ x)⁻¹ := by
      simpa only [one_div] using
        one_div_le_one_div_of_le (zero_lt_one.trans hp.1) hp.2.1
    exact Set.Ioo_subset_Icc_self.trans
      (Set.Icc_subset_Icc hh (hp.2.1.trans htwoC'))
  have hscale : ∀ x : ℝ, Real.exp 1 ≤ x → ∀ i : ι,
      x / C' ≤ Mf x i * Nf x i ∧ Mf x i * Nf x i ≤ C' * x ∧
      x ^ γ₀ ≤ Nf x i ∧ Nf x i ≤ Real.sqrt x * C := by
    intro x hx i
    by_cases hg : good x i
    · simp only [Mf, Nf, ite_eq_left hg]
      exact ⟨(div_le_div_of_nonneg_left (hxpos x hx).le hCp hCC').trans hg.2.1,
        hg.2.2.1.trans (mul_le_mul_of_nonneg_right hCC' (hxpos x hx).le),
        hg.2.2.2.1, by simpa only [mul_comm] using hg.2.2.2.2⟩
    · simp only [Mf, Nf, ite_eq_right hg]
      rw [Real.mul_self_sqrt (hxpos x hx).le]
      refine ⟨div_le_self (hxpos x hx).le hC',
        le_mul_of_one_le_left (hxpos x hx).le hC', ?_, ?_⟩
      · rw [Real.sqrt_eq_rpow]
        exact Real.rpow_le_rpow_of_exponent_le (hxone x hx) hγhi
      · exact le_mul_of_one_le_right (Real.sqrt_nonneg x) hC
  have hαsupport : ∀ x : ℝ, Real.exp 1 ≤ x → ∀ i : ι,
      ∀ n ∈ (αf x i).support,
        (1 / 2 : ℝ) * Mf x i ≤ (n : ℝ) ∧ (n : ℝ) ≤ C' * Mf x i := by
    intro x hx i n hn
    by_cases hg : good x i
    · have hp := hprofile x hx
      have hb := (sifted_short_geometric_coefficient_bounds x (Θ x) i.2.1
        (hxgt x hx) hp.1 hp.2.1 hg.1 i.1).2.1
      change ∀ n ∈ (α₀ x i).support,
        i.2.1 / 2 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * i.2.1 at hb
      simp only [αf, ite_eq_left hg] at hn
      obtain ⟨hlo, hhi⟩ := hb n hn
      simp only [Mf, ite_eq_left hg]
      exact ⟨by linarith, hhi.trans
        (mul_le_mul_of_nonneg_right htwoC' hg.1.le)⟩
    · simp only [αf, ite_eq_right hg, Finsupp.support_zero, Finset.notMem_empty] at hn
  have hαbound : ∀ x : ℝ, Real.exp 1 ≤ x → ∀ i : ι, ∀ n : ℕ,
      ‖αf x i n‖ ≤ 1 * (n.divisors.card : ℝ) ^ 3 * (Real.log x) ^ 3 := by
    intro x hx i n
    by_cases hg : good x i
    · have hp := hprofile x hx
      have hb := (sifted_short_geometric_coefficient_bounds x (Θ x) i.2.1
        (hxgt x hx) hp.1 hp.2.1 hg.1 i.1).2.2 n
      change ‖α₀ x i n‖ ≤ (n.divisors.card : ℝ) ^ 3 at hb
      simp only [αf, ite_eq_left hg, one_mul]
      exact hb.trans (le_mul_of_one_le_right (by positivity)
        (one_le_pow₀ (hlogone x hx)))
    · simp only [αf, ite_eq_right hg, Finsupp.zero_apply, norm_zero, one_mul]
      exact mul_nonneg (pow_nonneg (Nat.cast_nonneg _) _)
        (pow_nonneg (zero_le_one.trans (hlogone x hx)) _)
  have hψsmooth : ∀ x : ℝ, Real.exp 1 ≤ x → ∀ i : ι, ContDiff ℝ ∞ (ψ x i) := by
    intro x hx i
    by_cases hg : good x i
    · simpa only [ψ, ite_eq_left hg] using (hprofile x hx).2.2.1
    · simpa only [ψ, ite_eq_right hg, Pi.zero_def] using
        (contDiff_const : ContDiff ℝ ∞ (fun _ : ℝ => (0 : ℂ)))
  have hψsupport : ∀ x : ℝ, Real.exp 1 ≤ x → ∀ i : ι,
      Function.support (ψ x i) ⊆ Set.Icc (1 / 2 : ℝ) C' := by
    intro x hx i
    by_cases hg : good x i
    · simpa only [ψ, ite_eq_left hg] using hsuppη x hx
    · simp only [ψ, ite_eq_right hg, Function.support_zero, Set.empty_subset]
  have hψbounds : ∀ J : ℕ, ∃ L E : ℝ, 0 ≤ L ∧
      ∀ x : ℝ, Real.exp 1 ≤ x → ∀ i : ι, ∀ r : ℕ, r ≤ J → ∀ t : ℝ,
        ‖iteratedDeriv r (ψ x i) t‖ ≤ L * (Real.log x) ^ E := by
    intro J
    let L : ℝ := ∑ r ∈ Finset.range (J + 1), B r
    have hL : 0 ≤ L := Finset.sum_nonneg (fun r _ => (hB r).le)
    refine ⟨L, D * J, hL, ?_⟩
    intro x hx i r hr t
    by_cases hg : good x i
    · have hb : B r ≤ L := Finset.single_le_sum (fun k _ => (hB k).le)
        (Finset.mem_range_succ_iff.mpr hr)
      have he : D * (r : ℝ) ≤ D * J :=
        mul_le_mul_of_nonneg_left (Nat.cast_le.mpr hr) (zero_le_one.trans hD)
      have hd := (hprofile x hx).2.2.2.2.2 r t
      change ‖iteratedDeriv r (fun u => (η x u : ℂ)) t‖ ≤
        B r * (Real.log x) ^ (D * (r : ℝ)) at hd
      simp only [ψ, ite_eq_left hg]
      exact hd.trans (mul_le_mul hb
        (Real.rpow_le_rpow_of_exponent_le (hlogone x hx) he)
        (Real.rpow_nonneg (zero_le_one.trans (hlogone x hx)) _) hL)
    · simp only [ψ, ite_eq_right hg, iteratedDeriv_const_zero, norm_zero]
      exact mul_nonneg hL (Real.rpow_nonneg
        (zero_le_one.trans (hlogone x hx)) _)
  have hsub : ∀ ε : ℝ, 0 < ε →
      ∀ᶠ x : ℝ in Filter.atTop, (1 : ℝ) ≤ x ^ ε ∧ C ≤ x ^ ε := by
    intro ε hε
    filter_upwards [(tendsto_rpow_atTop hε).eventually_ge_atTop C] with x hx
    exact ⟨hC.trans hx, hx⟩
  have hglobal := sourceSmoothFactor_dense_uniform_log_saving
    «ω» δ γ₀ hω hδ hγ₀ hgap hγhi Mf Nf αf ψ (fun _ => 1) (fun _ => C)
    (1 / 2) C' 1 (Real.exp 1) 3 (by norm_num) (by linarith) hC'
    (by norm_num) le_rfl (fun _ _ => ⟨zero_lt_one, hCp⟩) hsub
    hscale hαsupport hαbound hψsmooth hψsupport hψbounds
  dsimp only at hglobal
  intro A hA
  obtain ⟨K, X, hK, hX, hmain⟩ := hglobal A hA
  refine ⟨K, X, hK, hX, ?_⟩
  intro x hx l M N hM hMNlo hMNhi hNlo hNhi Θ₀ η₀ z M0 S α β I hI a ha
  let i : ι := (l, M, N)
  have hg : good x i := ⟨hM, hMNlo, hMNhi, hNlo, hNhi⟩
  have hxexp : Real.exp 1 ≤ x := hX.trans hx
  have hp := hprofile x hxexp
  have hN : 0 < N := (Real.rpow_pos_of_pos (hxpos x hxexp) γ₀).trans_le hNlo
  have hβeq : positiveCompactProfileSequence (ψ x i) C' (Nf x i) 0 = β := by
    simp only [ψ, Nf, ite_eq_left hg]
    change positiveCompactProfileSequence (fun u => (η x u : ℂ)) C' N 0 = β
    have heq : positiveCompactProfileSequence (fun u => (η x u : ℂ)) C' N 0 =
        positiveCompactProfileSequence (fun u => (η x u : ℂ)) 2 N 0 := by
      ext n
      rw [positiveCompactProfileSequence_apply (1 / 2) C' N (by norm_num) hN _
        (hsuppη x hxexp)]
      have hs2 : Function.support (fun u => (η x u : ℂ)) ⊆ Set.Icc (1 / 2 : ℝ) 2 := by
        rw [hp.2.2.2.1]
        have hh : (1 / 2 : ℝ) ≤ (Θ x)⁻¹ := by
          simpa only [one_div] using one_div_le_one_div_of_le
            (zero_lt_one.trans hp.1) hp.2.1
        exact Set.Ioo_subset_Icc_self.trans (Set.Icc_subset_Icc hh hp.2.1)
      rw [positiveCompactProfileSequence_apply (1 / 2) 2 N (by norm_num) hN _ hs2]
    rw [heq]
    exact sifted_short_geometric_free_eq (Θ x) N hp.1 hp.2.1 hN
  have hh := hmain x hx i I hI a ha
  rw [hβeq] at hh
  simpa only [αf, ite_eq_left hg, α₀, i, Θ, η, S0, mul_one] using hh

open Classical in
theorem sifted_short_pure_power_coherent_log_saving
    (τ : ℝ) (hτ : 0 < τ) (hτsmall : τ ≤ 1 / 10 ^ 10)
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : ℕ) («ω» δ : ℝ) (hω : 0 < «ω») (hδ : 0 < δ)
    (hlevel : (1 / 2 : ℝ) + 2 * «ω» < 59519 / 100000 - τ)
    (hsmooth : (1 / 4 : ℝ) + 7 * «ω» + 2 * δ < 1058 / 3125 - τ)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ +
          5 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1 ∧
        68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ +
          4 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1 ∧
        68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ +
          4 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1 ∧
        64 * «ω» + 20 * δ +
          2 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ l : Fin 6,
      let z := x ^ ((9519 : ℝ) / 50000)
      let M0 := x ^ (1 - (1058 : ℝ) / 3125)
      let S0 : ArithmeticFunction ℝ :=
        ⟨fun n => if (n : ℝ) ≤ M0 then
          ∑ ps ∈ siftedPrimeTuples x l, ∑ d ∈ n.divisorsAntidiagonal,
            if d.1 = ps.prod then smallPrimeMobius z d.2 else 0 else 0, by simp⟩
      let ρx : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        Finsupp.single n
          (((S0 * (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n : ℝ) : ℂ)
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
            q ∣ (∏ p ∈ I, p) ∧ Nonempty
              (DenseDivisibilityWitness
                ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ j q)),
          ‖fullDiscrepancy ρx q a‖) ≤ K * x / (Real.log x) ^ A := by
  let a₀ : ℝ := 40481 / 100000
  let b₀ : ℝ := 59519 / 100000
  let c₀ : ℝ := 1058 / 3125
  let σ : ℝ := 1 / 2 - a₀ + τ
  let γ₀ : ℝ := c₀ - τ
  let θ : ℝ := 1 / 2 + 2 * «ω»
  let ε : ℝ := (b₀ - τ - θ) / 2
  have hσ : 0 < σ := by dsimp only [σ, a₀]; linarith only [hτ]
  have hγ₀ : 0 < γ₀ := by dsimp only [γ₀, c₀]; linarith only [hτsmall]
  have hγhi : γ₀ ≤ (1 / 2 : ℝ) := by dsimp only [γ₀, c₀]; linarith only [hτ]
  have hθ : 0 < θ := by dsimp only [θ]; linarith
  have hθhi : θ < 1 := by dsimp only [θ] at *; linarith only [hlevel, hτ]
  have hε : 0 < ε := by
    change (1 / 2 : ℝ) + 2 * «ω» < b₀ - τ at hlevel
    dsimp only [ε, θ]
    linarith only [hlevel]
  have hj : 1 ≤ j := by
    rcases hsource with h | h | h <;> omega
  intro A hA
  obtain ⟨D, hD, Kb, Xb, hKb, hXb, hboundary⟩ :=
    arithmeticFunction_zeta_closedCutoff_log_saving θ 3 A hθ hθhi hA
  let A' : ℝ := A + 2 * (D : ℝ) + 3
  have hA' : 0 < A' := by dsimp only [A']; positivity
  have hD' : 1 ≤ (D : ℝ) := by exact_mod_cast hD
  obtain ⟨Ks, Xs, hKs, hXs, hsmoothBoxes⟩ :=
    sifted_short_geometric_smooth_log_saving (D : ℝ) «ω» δ γ₀ 8
      hD' hω hδ hγ₀ hsmooth hγhi (by norm_num) A' hA'
  obtain ⟨Kt, Xt, hKt, hXt, htypeIIBoxes⟩ :=
    sifted_short_geometric_typeII_coherent_log_saving hDeligne j «ω» δ σ 8 (D : ℝ)
      hω hδ hσ (by norm_num) hD' hsource A' hA'
  obtain ⟨Kz, Xz, hKz, hXz, hzeroBoxes⟩ :=
    arithmeticFunction_geometric_typeZero_log_saving (D : ℝ) 3 8 θ ε A'
      hD' (by norm_num) hθ hθhi hε hA'
  obtain ⟨Xτ, hXτ⟩ := Filter.eventually_atTop.mp
    ((tendsto_rpow_atTop hτ).eventually_ge_atTop (8 : ℝ))
  let K : ℝ := Kb + 36 * (Ks + Kt + Kz)
  let X : ℝ := max Xb (max Xs (max Xt (max Xz Xτ)))
  refine ⟨K, X, by dsimp only [K]; positivity,
    hXb.trans (le_max_left _ _), ?_⟩
  intro x hx l z M0 S0 ρx I hI a ha
  have hxb : Xb ≤ x := (le_max_left _ _).trans hx
  have hxs : Xs ≤ x :=
    (le_max_left _ _).trans ((le_max_right _ _).trans hx)
  have hxt : Xt ≤ x :=
    (le_max_left _ _).trans ((le_max_right _ _).trans ((le_max_right _ _).trans hx))
  have hxz : Xz ≤ x :=
    (le_max_left _ _).trans ((le_max_right _ _).trans
      ((le_max_right _ _).trans ((le_max_right _ _).trans hx)))
  have hxτ : Xτ ≤ x :=
    (le_max_right _ _).trans ((le_max_right _ _).trans
      ((le_max_right _ _).trans ((le_max_right _ _).trans hx)))
  have hxexp : Real.exp 1 ≤ x := hXb.trans hxb
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxexp
  have hxone : 1 ≤ x :=
    (Real.one_le_exp_iff.mpr (by norm_num : (0 : ℝ) ≤ 1)).trans hxexp
  have hxgt : 1 < x :=
    (Real.one_lt_exp_iff.mpr (by norm_num : (0 : ℝ) < 1)).trans_le hxexp
  have hxτbound : 8 ≤ x ^ τ := hXτ x hxτ
  let ell : ℝ := Real.log x
  have hell : 1 ≤ ell := (Real.le_log_iff_exp_le hxpos).mpr hxexp
  have hellpos : 0 < ell := zero_lt_one.trans_le hell
  let Θ : ℝ := 1 + ell ^ (-(D : ℝ))
  let η : ℝ → ℝ := fun u => if 0 < u then
    Real.smoothTransition (Real.log u / Real.log Θ + 1) -
      Real.smoothTransition (Real.log u / Real.log Θ) else 0
  let R : ℕ := ⌈Real.log (2 * x) / Real.log Θ⌉₊
  let grid : Finset (Fin 2 → ℕ) :=
    Fintype.piFinset (fun _ : Fin 2 => Finset.range (R + 1))
  let scale (ν : Fin 2 → ℕ) (i : Fin 2) : ℝ := Θ ^ (ν i)
  let E : Finset (Fin 2 → ℕ) := grid.filter (fun ν =>
    x / Θ ^ 2 ≤ (∏ i : Fin 2, scale ν i) ∧
      (∏ i : Fin 2, scale ν i) ≤ (2 * x) * Θ ^ 2)
  let f : Fin 2 → ArithmeticFunction ℝ :=
    ![S0, (ArithmeticFunction.zeta : ArithmeticFunction ℝ)]
  let βm (ν : Fin 2 → ℕ) (i : Fin 2) : MonoidAlgebra ℂ ℕ :=
    ∑ n ∈ Finset.Icc 1 ⌊Θ * scale ν i⌋₊,
      MonoidAlgebra.single n ((η ((n : ℝ) / scale ν i) * f i n : ℝ) : ℂ)
  let α (ν : Fin 2 → ℕ) : ℕ →₀ ℂ := (βm ν 0).coeff
  let β (ν : Fin 2 → ℕ) : ℕ →₀ ℂ := (βm ν 1).coeff
  let F (ν : Fin 2 → ℕ) : ℕ →₀ ℂ := finiteConvolution (α ν) (β ν)
  let Q : Finset ℕ := (Finset.Icc 1 ⌊x ^ θ⌋₊).filter (fun q =>
    q ∣ (∏ p ∈ I, p) ∧ Nonempty
      (DenseDivisibilityWitness
        ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ j q))
  have hQ : Q ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ := Finset.filter_subset _ _
  have haq (q : ℕ) (hq : q ∈ Q) : Nat.Coprime a q :=
    ha.of_dvd_right (Finset.mem_filter.mp hq).2.1
  have hS0 (n : ℕ) : |S0 n| ≤ (n.divisors.card : ℝ) ^ 3 := by
    have hh := (sifted_short_source_bounds x hxgt l n).1
    simpa only [S0, ArithmeticFunction.coe_mk, Complex.norm_real,
      Real.norm_eq_abs] using hh
  have hΘ : 1 < Θ := lt_add_of_pos_right 1 (Real.rpow_pos_of_pos hellpos _)
  have hΘtwo : Θ ≤ 2 := by
    have hh := Real.rpow_le_one_of_one_le_of_nonpos hell
      (neg_nonpos.mpr (Nat.cast_nonneg D))
    dsimp only [Θ]
    linarith only [hh]
  have hΘpos : 0 < Θ := zero_lt_one.trans hΘ
  have hscale (ν : Fin 2 → ℕ) (i : Fin 2) : 1 ≤ scale ν i :=
    one_le_pow₀ hΘ.le
  have hscalePos (ν : Fin 2 → ℕ) (i : Fin 2) : 0 < scale ν i :=
    zero_lt_one.trans_le (hscale ν i)
  have hproduct (ν : Fin 2 → ℕ) :
      (∏ i : Fin 2, βm ν i).coeff = F ν := by
    simp only [Fin.prod_univ_two, F, finiteConvolution, α, β,
      MonoidAlgebra.ofCoeff_coeff]
  have hα (ν : Fin 2 → ℕ) :
      α ν = ∑ n ∈ Finset.Icc 1 ⌊Θ * scale ν 0⌋₊,
        Finsupp.single n ((η ((n : ℝ) / scale ν 0) * S0 n : ℝ) : ℂ) := by
    simp only [α, βm, f, Matrix.cons_val_zero, MonoidAlgebra.coeff_sum,
      MonoidAlgebra.coeff_single]
  have hβ (ν : Fin 2 → ℕ) :
      β ν = ∑ n ∈ Finset.Icc 1 ⌊Θ * scale ν 1⌋₊,
        Finsupp.single n ((η ((n : ℝ) / scale ν 1) *
          (ArithmeticFunction.zeta n : ℝ) : ℝ) : ℂ) := by
    simp only [β, βm, f, Matrix.cons_val_one, Matrix.cons_val_zero,
      MonoidAlgebra.coeff_sum, MonoidAlgebra.coeff_single, ArithmeticFunction.natCoe_apply]
  have hboundary' := hboundary x hxb S0 hS0 Q hQ (fun _ => a) haq
  change (∑ q ∈ Q, ‖fullDiscrepancy ρx q a -
    ∑ ν ∈ E, fullDiscrepancy (∏ i : Fin 2, βm ν i).coeff q a‖) ≤
      Kb * x / ell ^ A at hboundary'
  simp_rw [hproduct] at hboundary'
  obtain ⟨hcard, _, _, _, _⟩ :=
    arithmeticFunction_zeta_finite_smooth_box_boundary S0 3 hS0
      x (2 * x) Θ hxone (by linarith only [hxpos]) hΘ hΘtwo
  change E.card ≤ (R + 1) ^ 2 at hcard
  have hcardReal : (E.card : ℝ) ≤ 36 * ell ^ (2 * (D : ℝ) + 2) := by
    obtain ⟨_, _, hp⟩ := heathBrown_geometric_profiles_uniform
    have hcount := ((hp Θ hΘ hΘtwo).2.2.2.2 (2 * x)
      (by linarith only [hxone])).1
    change ((R + 1 : ℕ) : ℝ) ≤ 2 * Real.log (2 * x) / (Θ - 1) + 2 at hcount
    have hlog2 : Real.log 2 ≤ 1 := by
      simpa only [show (2 : ℝ) - 1 = 1 by norm_num] using
        Real.log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2)
    have hlog2x : Real.log (2 * x) ≤ 2 * ell := by
      rw [Real.log_mul (by norm_num : (2 : ℝ) ≠ 0) hxpos.ne']
      change Real.log 2 + ell ≤ 2 * ell
      linarith only [hlog2, hell]
    have hinv : (Θ - 1)⁻¹ = ell ^ (D : ℝ) := by
      simp only [Θ, add_sub_cancel_left, Real.rpow_neg hellpos.le, inv_inv]
    have hpower : ell * ell ^ (D : ℝ) = ell ^ ((D : ℝ) + 1) := by
      rw [Real.rpow_add hellpos, Real.rpow_one]
      ring
    have hpowone : 1 ≤ ell ^ ((D : ℝ) + 1) :=
      Real.one_le_rpow hell (by positivity)
    have hcount' : ((R + 1 : ℕ) : ℝ) ≤ 6 * ell ^ ((D : ℝ) + 1) := by
      rw [div_eq_mul_inv, hinv] at hcount
      have hh := mul_le_mul_of_nonneg_right hlog2x
        (Real.rpow_nonneg hellpos.le (D : ℝ))
      nlinarith only [hcount, hh, hpower, hpowone]
    have hc : (E.card : ℝ) ≤ (((R + 1 : ℕ) : ℝ)) ^ 2 := by
      exact_mod_cast hcard
    calc
      (E.card : ℝ) ≤ (((R + 1 : ℕ) : ℝ)) ^ 2 := hc
      _ ≤ (6 * ell ^ ((D : ℝ) + 1)) ^ 2 :=
        pow_le_pow_left₀ (Nat.cast_nonneg _) hcount' 2
      _ = 36 * ell ^ (2 * (D : ℝ) + 2) := by
        have hh : (ell ^ ((D : ℝ) + 1)) ^ 2 = ell ^ (2 * (D : ℝ) + 2) := by
          rw [sq, ← Real.rpow_add hellpos]
          congr 1
          ring
        rw [mul_pow, hh]
        norm_num
  have hMN (ν : Fin 2 → ℕ) (hν : ν ∈ E) :
      x / 4 ≤ scale ν 0 * scale ν 1 ∧ scale ν 0 * scale ν 1 ≤ 8 * x := by
    have he := (Finset.mem_filter.mp hν).2
    simp only [Fin.prod_univ_two] at he
    have hΘsq : Θ ^ 2 ≤ (4 : ℝ) := by nlinarith only [hΘtwo, hΘpos]
    have hsqpos : 0 < Θ ^ 2 := pow_pos hΘpos 2
    exact ⟨(div_le_div_of_nonneg_left hxpos.le hsqpos hΘsq).trans he.1,
      he.2.trans (by nlinarith only [hΘsq, hxpos])⟩
  have hMupper (ν : Fin 2 → ℕ) (hαν : α ν ≠ 0) :
      scale ν 0 ≤ 2 * x ^ (1 - c₀) := by
    obtain ⟨n, hn⟩ := Finsupp.support_nonempty_iff.mpr hαν
    have hc := sifted_short_geometric_coefficient_bounds x Θ (scale ν 0)
      hxgt hΘ hΘtwo (hscalePos ν 0) l
    change (∀ n : ℕ, (∑ n ∈ Finset.Icc 1 ⌊Θ * scale ν 0⌋₊,
      Finsupp.single n ((η ((n : ℝ) / scale ν 0) * S0 n : ℝ) : ℂ)) n =
        ((η ((n : ℝ) / scale ν 0) * S0 n : ℝ) : ℂ)) ∧
      (∀ n ∈ (∑ n ∈ Finset.Icc 1 ⌊Θ * scale ν 0⌋₊,
        Finsupp.single n ((η ((n : ℝ) / scale ν 0) * S0 n : ℝ) : ℂ)).support,
        scale ν 0 / 2 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * scale ν 0) ∧ _ at hc
    rw [← hα ν] at hc
    have hn0 : α ν n ≠ 0 := Finsupp.mem_support_iff.mp hn
    have hS0n : S0 n ≠ 0 := by
      intro hz
      rw [hc.1 n, hz, mul_zero, Complex.ofReal_zero] at hn0
      exact hn0 rfl
    have hs := (sifted_short_source_bounds x hxgt l n).2.2 hS0n
    change (n : ℝ) ≤ x ^ (1 - c₀) at hs
    have hnlo := (hc.2.1 n hn).1
    linarith only [hs, hnlo]
  have hNlower (ν : Fin 2 → ℕ) (hν : ν ∈ E) (hαν : α ν ≠ 0) :
      x ^ γ₀ ≤ scale ν 1 := by
    have hMhi := hMupper ν hαν
    have hprod := (hMN ν hν).1
    have hmul := mul_le_mul_of_nonneg_right hMhi (hscalePos ν 1).le
    have hp : x ^ c₀ * x ^ (1 - c₀) = x := by
      rw [← Real.rpow_add hxpos, show c₀ + (1 - c₀) = 1 by ring, Real.rpow_one]
    have hratio : x / (8 * x ^ (1 - c₀)) ≤ scale ν 1 := by
      apply (div_le_iff₀ (by positivity : 0 < 8 * x ^ (1 - c₀))).mpr
      nlinarith only [hprod, hmul]
    have heq : x / (8 * x ^ (1 - c₀)) = x ^ c₀ / 8 := by
      apply (div_eq_div_iff (by positivity) (by norm_num : (8 : ℝ) ≠ 0)).mpr
      nlinarith only [hp]
    rw [heq] at hratio
    have hg : x ^ γ₀ * 8 ≤ x ^ c₀ := by
      calc
        _ ≤ x ^ γ₀ * x ^ τ :=
          mul_le_mul_of_nonneg_left hxτbound (Real.rpow_nonneg hxpos.le _)
        _ = x ^ c₀ := by
          rw [← Real.rpow_add hxpos]
          congr 1
          dsimp only [γ₀]
          ring
    exact ((le_div_iff₀ (by norm_num : (0 : ℝ) < 8)).mpr hg).trans hratio
  have hbox (ν : Fin 2 → ℕ) (hν : ν ∈ E) :
      (∑ q ∈ Q, ‖fullDiscrepancy (F ν) q a‖) ≤
        (Ks + Kt + Kz) * x / ell ^ A' := by
    have hnonneg : 0 ≤ (Ks + Kt + Kz) * x / ell ^ A' := by positivity
    by_cases hαzero : α ν = 0
    · simpa [F, hαzero, finiteConvolution, fullDiscrepancy,
        progressionMass, reducedMass] using hnonneg
    have hMpos := hscalePos ν 0
    have hNpos := hscalePos ν 1
    have hMNone := hMN ν hν
    have hMNlo : x / 8 ≤ scale ν 0 * scale ν 1 :=
      (by linarith only [hxpos] : x / 8 ≤ x / 4).trans hMNone.1
    by_cases hnear : scale ν 1 ≤ 8 * Real.sqrt x
    · have hs := hsmoothBoxes x hxs l (scale ν 0) (scale ν 1) hMpos
        hMNlo hMNone.2 (hNlower ν hν hαzero) hnear I hI a ha
      change (∑ q ∈ (Finset.Icc 1 ⌊x ^ θ⌋₊).filter (fun q =>
        q ∣ (∏ p ∈ I, p) ∧ Nonempty
          (DenseDivisibilityWitness
            ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ 1 q)),
        ‖fullDiscrepancy (finiteConvolution
          (∑ n ∈ Finset.Icc 1 ⌊Θ * scale ν 0⌋₊,
            Finsupp.single n ((η ((n : ℝ) / scale ν 0) * S0 n : ℝ) : ℂ))
          (∑ n ∈ Finset.Icc 1 ⌊Θ * scale ν 1⌋₊,
            Finsupp.single n ((η ((n : ℝ) / scale ν 1) *
              (ArithmeticFunction.zeta n : ℝ) : ℝ) : ℂ))) q a‖) ≤
        Ks * x / ell ^ A' at hs
      rw [← hα ν, ← hβ ν] at hs
      have hsub : Q ⊆ (Finset.Icc 1 ⌊x ^ θ⌋₊).filter (fun q =>
        q ∣ (∏ p ∈ I, p) ∧ Nonempty
          (DenseDivisibilityWitness
            ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ 1 q)) := by
        intro q hq
        obtain ⟨hqI, hqd, hqdense⟩ := Finset.mem_filter.mp hq
        exact Finset.mem_filter.mpr ⟨hqI, hqd,
          denseDivisibility_mono_order hqdense hj⟩
      exact (Finset.sum_le_sum_of_subset_of_nonneg hsub (fun _ _ _ => norm_nonneg _)).trans
        (hs.trans (div_le_div_of_nonneg_right
          (mul_le_mul_of_nonneg_right (by linarith only [hKt, hKz]) hxpos.le)
          (Real.rpow_nonneg hellpos.le _)))
    have hfar : 8 * Real.sqrt x < scale ν 1 := lt_of_not_ge hnear
    have hMhi : scale ν 0 ≤ x ^ (1 / 2 : ℝ) := by
      rw [← Real.sqrt_eq_rpow]
      have hsqrt := Real.sq_sqrt hxpos.le
      have hsqrtpos := Real.sqrt_pos.2 hxpos
      by_contra hm
      have hm' : Real.sqrt x < scale ν 0 := lt_of_not_ge hm
      have hh := mul_lt_mul_of_pos_left hfar hMpos
      have hh' := mul_lt_mul_of_pos_right hm' (by positivity : 0 < 8 * Real.sqrt x)
      nlinarith only [hMNone.2, hsqrt, hh, hh']
    by_cases hmiddle : x ^ (a₀ - τ) ≤ scale ν 0
    · have ht := htypeIIBoxes x hxt l (scale ν 0) (scale ν 1)
        hMNlo hMNone.2 (hscale ν 1) (by
          have he : (1 / 2 : ℝ) - σ = a₀ - τ := by dsimp only [σ]; ring
          simpa only [he] using hmiddle) hMhi I hI a ha
      change (∑ q ∈ Q, ‖fullDiscrepancy (finiteConvolution
        (∑ n ∈ Finset.Icc 1 ⌊Θ * scale ν 0⌋₊,
          Finsupp.single n ((η ((n : ℝ) / scale ν 0) * S0 n : ℝ) : ℂ))
        (∑ n ∈ Finset.Icc 1 ⌊Θ * scale ν 1⌋₊,
          Finsupp.single n ((η ((n : ℝ) / scale ν 1) *
            (ArithmeticFunction.zeta n : ℝ) : ℝ) : ℂ))) q a‖) ≤
          Kt * x / ell ^ A' at ht
      rw [← hα ν, ← hβ ν] at ht
      exact ht.trans (div_le_div_of_nonneg_right
        (mul_le_mul_of_nonneg_right (by linarith only [hKs, hKz]) hxpos.le)
        (Real.rpow_nonneg hellpos.le _))
    have hshort : scale ν 0 < x ^ (a₀ - τ) := lt_of_not_ge hmiddle
    have hlarge : x ^ (θ + ε) ≤ scale ν 1 := by
      have hmul := mul_le_mul_of_nonneg_right hshort.le hNpos.le
      have hp : x ^ (b₀ + τ) * x ^ (a₀ - τ) = x := by
        rw [← Real.rpow_add hxpos,
          show b₀ + τ + (a₀ - τ) = 1 by dsimp only [a₀, b₀]; ring, Real.rpow_one]
      have hratio : x / (4 * x ^ (a₀ - τ)) ≤ scale ν 1 := by
        apply (div_le_iff₀ (by positivity : 0 < 4 * x ^ (a₀ - τ))).mpr
        nlinarith only [hMNone.1, hmul]
      have heq : x / (4 * x ^ (a₀ - τ)) = x ^ (b₀ + τ) / 4 := by
        apply (div_eq_div_iff (by positivity) (by norm_num : (4 : ℝ) ≠ 0)).mpr
        nlinarith only [hp]
      rw [heq] at hratio
      have hlarge' : x ^ b₀ ≤ x ^ (b₀ + τ) / 4 := by
        have hh := mul_le_mul_of_nonneg_left
          (show (4 : ℝ) ≤ x ^ τ by linarith only [hxτbound])
          (Real.rpow_nonneg hxpos.le b₀)
        rw [← Real.rpow_add hxpos] at hh
        exact (le_div_iff₀ (by norm_num : (0 : ℝ) < 4)).mpr hh
      exact (Real.rpow_le_rpow_of_exponent_le hxone (by
        have he : θ < b₀ - τ := hlevel
        calc
          θ + ε = (θ + (b₀ - τ)) / 2 := by dsimp only [ε]; ring
          _ ≤ ((b₀ - τ) + (b₀ - τ)) / 2 :=
            div_le_div_of_nonneg_right (add_le_add he.le le_rfl) (by norm_num)
          _ = b₀ - τ := by ring
          _ ≤ b₀ := sub_le_self b₀ hτ.le : θ + ε ≤ b₀)).trans (hlarge'.trans hratio)
    have hz := hzeroBoxes x hxz (scale ν 0) (scale ν 1)
      (hscale ν 0) (hscale ν 1) hMNone.2 hlarge S0 hS0 Q hQ (fun _ => a) haq
    change (∑ q ∈ Q, ‖fullDiscrepancy (finiteConvolution
      (∑ n ∈ Finset.Icc 1 ⌊Θ * scale ν 0⌋₊,
        Finsupp.single n ((η ((n : ℝ) / scale ν 0) * S0 n : ℝ) : ℂ))
      (∑ n ∈ Finset.Icc 1 ⌊Θ * scale ν 1⌋₊,
        Finsupp.single n ((η ((n : ℝ) / scale ν 1) *
          (ArithmeticFunction.zeta n : ℝ) : ℝ) : ℂ))) q a‖) ≤
        Kz * x / ell ^ A' at hz
    rw [← hα ν, ← hβ ν] at hz
    exact hz.trans (div_le_div_of_nonneg_right
      (mul_le_mul_of_nonneg_right (by linarith only [hKs, hKt]) hxpos.le)
      (Real.rpow_nonneg hellpos.le _))
  have htotal : (∑ ν ∈ E, ∑ q ∈ Q, ‖fullDiscrepancy (F ν) q a‖) ≤
      36 * (Ks + Kt + Kz) * x / ell ^ A := by
    calc
      _ ≤ ∑ _ν ∈ E, (Ks + Kt + Kz) * x / ell ^ A' :=
        Finset.sum_le_sum hbox
      _ = (E.card : ℝ) * ((Ks + Kt + Kz) * x / ell ^ A') := by
        rw [Finset.sum_const, nsmul_eq_mul]
      _ ≤ (36 * ell ^ (2 * (D : ℝ) + 2)) *
          ((Ks + Kt + Kz) * x / ell ^ A') :=
        mul_le_mul_of_nonneg_right hcardReal (by positivity)
      _ ≤ 36 * (Ks + Kt + Kz) * x / ell ^ A := by
        have hp : ell ^ A' = ell ^ A * ell ^ (2 * (D : ℝ) + 2) * ell := by
          calc
            ell ^ A' = ell ^ ((A + (2 * (D : ℝ) + 2)) + 1) := by
              congr 1
              dsimp only [A']
              ring
            _ = ell ^ (A + (2 * (D : ℝ) + 2)) * ell := by
              rw [Real.rpow_add hellpos, Real.rpow_one]
            _ = _ := by rw [Real.rpow_add hellpos]
        rw [hp]
        have hpowpos := Real.rpow_pos_of_pos hellpos (2 * (D : ℝ) + 2)
        have hAp := Real.rpow_pos_of_pos hellpos A
        calc
          _ = (36 * (Ks + Kt + Kz) * x / ell ^ A) / ell := by
            field_simp [hAp.ne', hpowpos.ne', hellpos.ne']
          _ ≤ _ := div_le_self (by positivity) hell
  change (∑ q ∈ Q, ‖fullDiscrepancy ρx q a‖) ≤ K * x / ell ^ A
  calc
    _ ≤ ∑ q ∈ Q, (‖fullDiscrepancy ρx q a -
        ∑ ν ∈ E, fullDiscrepancy (F ν) q a‖ +
          ∑ ν ∈ E, ‖fullDiscrepancy (F ν) q a‖) := by
      apply Finset.sum_le_sum
      intro q hq
      exact (norm_le_norm_sub_add _ _).trans
        (add_le_add le_rfl (norm_sum_le _ _))
    _ = (∑ q ∈ Q, ‖fullDiscrepancy ρx q a -
        ∑ ν ∈ E, fullDiscrepancy (F ν) q a‖) +
          ∑ ν ∈ E, ∑ q ∈ Q, ‖fullDiscrepancy (F ν) q a‖ := by
      rw [Finset.sum_add_distrib, Finset.sum_comm]
    _ ≤ Kb * x / ell ^ A + 36 * (Ks + Kt + Kz) * x / ell ^ A :=
      add_le_add hboundary' htotal
    _ = K * x / ell ^ A := by dsimp only [K]; ring

end

section

open scoped ContDiff

open Classical in
theorem sifted_short_subpower_coherent_log_saving
    (τ : ℝ) (hτ : 0 < τ) (hτsmall : τ ≤ 1 / 10 ^ 10)
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : ℕ) («ω» δ : ℝ) (hω : 0 < «ω») (hδ : 0 < δ)
    (hlevel : (1 / 2 : ℝ) + 2 * «ω» < 59519 / 100000 - τ)
    (hsmooth : (1 / 4 : ℝ) + 7 * «ω» + 2 * δ < 1058 / 3125 - τ)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ +
          5 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1 ∧
        68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ +
          4 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1 ∧
        68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ +
          4 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1 ∧
        64 * «ω» + 20 * δ +
          2 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1))
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x) atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ l : Fin 6,
      ∀ Y : Set.Ici (1 : ℝ), (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
      let z := x ^ ((9519 : ℝ) / 50000)
      let M0 := x ^ (1 - (1058 : ℝ) / 3125)
      let S0 : ArithmeticFunction ℝ :=
        ⟨fun n => if (n : ℝ) ≤ M0 then
          ∑ ps ∈ siftedPrimeTuples x l, ∑ d ∈ n.divisorsAntidiagonal,
            if d.1 = ps.prod then smallPrimeMobius z d.2 else 0 else 0, by simp⟩
      let ρx : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        Finsupp.single n
          (((S0 * (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n : ℝ) : ℂ)
      let Q : Finset ℕ :=
        (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter
          (fun q => q ∣ ∏ p ∈ I, p ∧
            Nonempty (DenseDivisibilityWitness Y j q))
      (∑ q ∈ Q, ‖fullDiscrepancy ρx q a‖) ≤ K * x / (Real.log x) ^ A := by
  obtain ⟨r0, hr0, hretreat⟩ := central_typeII_parameter_retreat j «ω» δ
    ((1 / 2 : ℝ) - 40481 / 100000 + τ) hsource
  let dl : ℝ := 59519 / 100000 - τ - ((1 / 2 : ℝ) + 2 * «ω»)
  let ds : ℝ := 1058 / 3125 - τ - ((1 / 4 : ℝ) + 7 * «ω» + 2 * δ)
  have hdl : 0 < dl := sub_pos.mpr hlevel
  have hds : 0 < ds := sub_pos.mpr hsmooth
  let r : ℝ := min r0 (min (dl / 4) (ds / 18))
  have hr : 0 < r := lt_min hr0 (lt_min (by positivity) (by positivity))
  have hrr0 : r ≤ r0 := min_le_left _ _
  have hrl : r ≤ dl / 4 := (min_le_right _ _).trans (min_le_left _ _)
  have hrs : r ≤ ds / 18 := (min_le_right _ _).trans (min_le_right _ _)
  have hlevel' : (1 / 2 : ℝ) + 2 * («ω» + r) <
      59519 / 100000 - τ := by
    dsimp only [dl] at hdl hrl
    linarith
  have hsmooth' : (1 / 4 : ℝ) + 7 * («ω» + r) + 2 * (δ + r) <
      1058 / 3125 - τ := by
    dsimp only [ds] at hds hrs
    linarith
  have hsource' :
      (j = 1 ∧ 54 * («ω» + r) + 15 * (δ + r) +
          5 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1 ∧
        68 * («ω» + r) + 14 * (δ + r) < 1) ∨
      (j = 2 ∧ 56 * («ω» + r) + 16 * (δ + r) +
          4 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1 ∧
        68 * («ω» + r) + 14 * (δ + r) < 1) ∨
      (j = 3 ∧ 72 * («ω» + r) + 24 * (δ + r) < 1 ∧
        48 * («ω» + r) + 16 * (δ + r) +
          4 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1 ∧
        64 * («ω» + r) + 20 * (δ + r) +
          2 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1) := by
    rcases hretreat with ⟨hj, h₁, h₂⟩ | ⟨hj, h₁, h₂⟩ | ⟨hj, h₁, h₂, h₃⟩
    · exact Or.inl ⟨hj, by linarith, by linarith⟩
    · exact Or.inr (Or.inl ⟨hj, by linarith, by linarith⟩)
    · exact Or.inr (Or.inr ⟨hj, by linarith, by linarith, by linarith⟩)
  obtain ⟨Xr, hXr⟩ := eventually_atTop.mp
    (central_subpower_modulus_family_subset j «ω» δ r hr L0 hL0 hL0sub)
  intro A hA
  obtain ⟨K, Xp, hK, hXp, hp⟩ :=
    sifted_short_pure_power_coherent_log_saving τ hτ hτsmall hDeligne j («ω» + r) (δ + r)
      (by linarith) (by linarith) hlevel' hsmooth' hsource' A hA
  refine ⟨K, max Xp Xr, hK,
    (Real.one_lt_exp_iff.mpr (by norm_num : (0 : ℝ) < 1)).trans_le
      (hXp.trans (le_max_left _ _)), ?_⟩
  intro x hx l Y hY I hI a ha z M0 S0 ρx Q
  have hxp : Xp ≤ x := (le_max_left _ _).trans hx
  have hxr : Xr ≤ x := (le_max_right _ _).trans hx
  have hsubset := hXr x hxr Y hY I
  have hbound := hp x hxp l I hI a ha
  exact (Finset.sum_le_sum_of_subset_of_nonneg hsubset
    (fun q _ _ => norm_nonneg (fullDiscrepancy ρx q a))).trans hbound

open Classical in
theorem sifted_short_lower_tier_distribution
    (l : Fin 6)
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : Fin 2) («ω» δ : ℝ) (hω : 0 < «ω») (hδ : 0 < δ)
    (hlevel : (1 / 2 : ℝ) + 2 * «ω» <
      59519 / 100000 - 1 / (10 : ℝ) ^ 10)
    (hsmooth : (1 / 4 : ℝ) + 7 * «ω» + 2 * δ <
      1058 / 3125 - 1 / (10 : ℝ) ^ 10)
    (hI : if j = 0 then
      54 * «ω» + 15 * δ + 5 * (1 / 2 - 40481 / 100000 + 1 / (10 : ℝ) ^ 10) < 1
      else
      56 * «ω» + 16 * δ + 4 * (1 / 2 - 40481 / 100000 + 1 / (10 : ℝ) ^ 10) < 1)
    (hII : 68 * «ω» + 14 * δ < 1)
    (_hIIIold : (1 / 18 : ℝ) + 28 * «ω» / 9 + 2 * δ / 9 <
      1 / 2 - 40481 / 100000 + 1 / (10 : ℝ) ^ 10)
    (_hthree : (1 / 18 : ℝ) + 28 * «ω» / 9 + 2 * δ / 9 <
      19 / 200 - 1 / (10 : ℝ) ^ 10)
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x) atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ), (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
      let z := x ^ ((9519 : ℝ) / 50000)
      let M0 := x ^ (1 - (1058 : ℝ) / 3125)
      let S0 : ArithmeticFunction ℝ :=
        ⟨fun n => if (n : ℝ) ≤ M0 then
          ∑ ps ∈ siftedPrimeTuples x l, ∑ d ∈ n.divisorsAntidiagonal,
            if d.1 = ps.prod then smallPrimeMobius z d.2 else 0 else 0, by simp⟩
      let ρx : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        Finsupp.single n
          (((S0 * (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n : ℝ) : ℂ)
      let Q : Finset ℕ :=
        (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter
          (fun q => q ∣ ∏ p ∈ I, p ∧ Nonempty
            (DenseDivisibilityWitness Y (j.val + 1) q))
      (∑ q ∈ Q, ‖fullDiscrepancy ρx q a‖) ≤ K * x / (Real.log x) ^ A := by
  have hsource :
      (j.val + 1 = 1 ∧ 54 * «ω» + 15 * δ +
          5 * ((1 / 2 : ℝ) - 40481 / 100000 + 1 / 10 ^ 10) < 1 ∧
        68 * «ω» + 14 * δ < 1) ∨
      (j.val + 1 = 2 ∧ 56 * «ω» + 16 * δ +
          4 * ((1 / 2 : ℝ) - 40481 / 100000 + 1 / 10 ^ 10) < 1 ∧
        68 * «ω» + 14 * δ < 1) ∨
      (j.val + 1 = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ +
          4 * ((1 / 2 : ℝ) - 40481 / 100000 + 1 / 10 ^ 10) < 1 ∧
        64 * «ω» + 20 * δ +
          2 * ((1 / 2 : ℝ) - 40481 / 100000 + 1 / 10 ^ 10) < 1) := by
    by_cases hj : j = 0
    · exact Or.inl ⟨by simp [hj], by simpa only [ite_eq_left hj] using hI, hII⟩
    · have hjval : j.val = 1 := by
        have hlt := j.isLt
        have hne : j.val ≠ 0 := by
          intro he
          exact hj (Fin.ext he)
        omega
      exact Or.inr (Or.inl ⟨by omega, by simpa only [ite_eq_right hj] using hI, hII⟩)
  intro A hA
  obtain ⟨K, X, hK, hX, hdist⟩ :=
    sifted_short_subpower_coherent_log_saving
      (1 / 10 ^ 10) (by norm_num) (le_refl _) hDeligne (j.val + 1) «ω» δ hω hδ
      hlevel hsmooth hsource L0 hL0 hL0sub A hA
  exact ⟨K, X, hK, hX, fun x hx Y hY I hI a ha => hdist x hx l Y hY I hI a ha⟩

open Classical in
theorem sifted_short_triply_dense_distribution
    (l : Fin 6)
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    («ω» δ : ℝ) (hω : 0 < «ω») (hδ : 0 < δ)
    (hlevel : (1 / 2 : ℝ) + 2 * «ω» <
      59519 / 100000 - 1 / (10 : ℝ) ^ 10)
    (hsmooth : (1 / 4 : ℝ) + 7 * «ω» + 2 * δ <
      1058 / 3125 - 1 / (10 : ℝ) ^ 10)
    (hI : 72 * «ω» + 24 * δ < 1)
    (hII : (1 / 4 : ℝ) + 12 * «ω» + 4 * δ <
      40481 / 100000 - 1 / (10 : ℝ) ^ 10)
    (hIII : 32 * «ω» + 10 * δ <
      40481 / 100000 - 1 / (10 : ℝ) ^ 10)
    (_hthree : (1 / 18 : ℝ) + 28 * «ω» / 9 + 2 * δ / 9 <
      19 / 200 - 1 / (10 : ℝ) ^ 10)
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x) atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ), (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
      let z := x ^ ((9519 : ℝ) / 50000)
      let M0 := x ^ (1 - (1058 : ℝ) / 3125)
      let S0 : ArithmeticFunction ℝ :=
        ⟨fun n => if (n : ℝ) ≤ M0 then
          ∑ ps ∈ siftedPrimeTuples x l, ∑ d ∈ n.divisorsAntidiagonal,
            if d.1 = ps.prod then smallPrimeMobius z d.2 else 0 else 0, by simp⟩
      let ρx : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        Finsupp.single n
          (((S0 * (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n : ℝ) : ℂ)
      let Q : Finset ℕ :=
        (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter
          (fun q => q ∣ ∏ p ∈ I, p ∧
            Nonempty (DenseDivisibilityWitness Y 3 q))
      (∑ q ∈ Q, ‖fullDiscrepancy ρx q a‖) ≤ K * x / (Real.log x) ^ A := by
  have hsource :
      (3 = 1 ∧ 54 * «ω» + 15 * δ +
          5 * ((1 / 2 : ℝ) - 40481 / 100000 + 1 / 10 ^ 10) < 1 ∧
        68 * «ω» + 14 * δ < 1) ∨
      (3 = 2 ∧ 56 * «ω» + 16 * δ +
          4 * ((1 / 2 : ℝ) - 40481 / 100000 + 1 / 10 ^ 10) < 1 ∧
        68 * «ω» + 14 * δ < 1) ∨
      (3 = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ +
          4 * ((1 / 2 : ℝ) - 40481 / 100000 + 1 / 10 ^ 10) < 1 ∧
        64 * «ω» + 20 * δ +
          2 * ((1 / 2 : ℝ) - 40481 / 100000 + 1 / 10 ^ 10) < 1) := by
    exact Or.inr (Or.inr ⟨rfl, hI, by linarith, by linarith⟩)
  intro A hA
  obtain ⟨K, X, hK, hX, hdist⟩ :=
    sifted_short_subpower_coherent_log_saving
      (1 / 10 ^ 10) (by norm_num) (le_refl _) hDeligne 3 «ω» δ hω hδ
      hlevel hsmooth hsource L0 hL0 hL0sub A hA
  exact ⟨K, X, hK, hX, fun x hx Y hY I hI a ha => hdist x hx l Y hY I hI a ha⟩

end

open Classical in
theorem minorantHB_five_closed_expansion
    (A B U Θ t : ℝ) (hA : 1 ≤ A) (hAB : A ≤ B) (hU : 0 ≤ U)
    (hBU : B ≤ U ^ 5) (hΘ : 1 < Θ) (hΘtwo : Θ ≤ 2)
    (ht : 0 ≤ t) (htten : t ≤ 10) (n : ℕ) :
    (if A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B then
      ((Real.rpow (n : ℝ) (-t) * ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)
    else 0) =
      ∑ r : Fin 5, (((-1 : ℝ) ^ r.val * ((5 : ℕ).choose (r.val + 1) : ℝ) : ℝ) : ℂ) *
        (if A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B then
          ∑ ν ∈ minorantHBBoxes (r.val + 1) A B Θ,
            (∏ i, minorantHBLocalizedSlot (r.val + 1) U Θ t ν i).coeff n
        else 0) := by
  by_cases hn : A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B
  · simp only [ite_eq_left hn]
    have hid := heathBrown_identity
      (K := 5) (by norm_num) hU (hn.2.trans hBU)
    have heval : ArithmeticFunction.vonMangoldt n =
        ∑ r ∈ Finset.range 5, ((-1 : ℝ) ^ r * ((5 : ℕ).choose (r + 1) : ℝ)) *
          ((arithmeticFunctionLowCutoff U
            (ArithmeticFunction.moebius : ArithmeticFunction ℝ)) ^ (r + 1) *
            (ArithmeticFunction.zeta : ArithmeticFunction ℝ) ^ r * ArithmeticFunction.log) n := by
      rw [hid, heathBrownSum]
      have hsum (s : Finset ℕ) (f : ℕ → ArithmeticFunction ℝ) :
          (∑ r ∈ s, f r) n = ∑ r ∈ s, f r n :=
        map_sum (⟨⟨fun g : ArithmeticFunction ℝ => g n, rfl⟩,
          fun _ _ => rfl⟩ : ArithmeticFunction ℝ →+ ℝ) f s
      rw [hsum]
      simp only [ArithmeticFunction.smul_map, smul_eq_mul]
    rw [heval, ← Fin.sum_univ_eq_sum_range, Finset.mul_sum]
    simp only [Complex.ofReal_sum, Complex.ofReal_mul]
    refine Finset.sum_congr rfl (fun r _ => ?_)
    have hl := (minorantHB_box_localization (r.val + 1) (by omega)
      A B U Θ t hA hAB hΘ hΘtwo ht htten).2.1 n
    simp only [ite_eq_left hn, Nat.add_sub_cancel] at hl
    rw [← hl]
    push_cast
    ring
  · simp only [ite_eq_right hn, mul_zero, Finset.sum_const_zero]

open Classical in
theorem minorantHB_three_closed_factor_expansion
    (A B t : Fin 3 → ℝ) (U Θ : ℝ) (p : Fin 3 → ℕ)
    (hA : ∀ c, 1 ≤ A c) (hAB : ∀ c, A c ≤ B c) (hU : 0 ≤ U)
    (hBU : ∀ c, B c ≤ U ^ 5) (hΘ : 1 < Θ) (hΘtwo : Θ ≤ 2)
    (ht : ∀ c, 0 ≤ t c) (htten : ∀ c, t c ≤ 10) :
    (∏ c : Fin 3, if A c ≤ (p c : ℝ) ∧ (p c : ℝ) ≤ B c then
      ((Real.rpow (p c : ℝ) (-t c) * ArithmeticFunction.vonMangoldt (p c) : ℝ) : ℂ)
      else 0) =
    ∑ r : Fin 3 → Fin 5,
      (∏ c : Fin 3,
        (((-1 : ℝ) ^ (r c).val * ((5 : ℕ).choose ((r c).val + 1) : ℝ) : ℝ) : ℂ)) *
      ∑ ν ∈ Fintype.piFinset (fun c : Fin 3 =>
        minorantHBBoxes ((r c).val + 1) (A c) (B c) Θ),
        ∏ c : Fin 3, if A c ≤ (p c : ℝ) ∧ (p c : ℝ) ≤ B c then
          ∑ d ∈ Fintype.piFinset (fun i : Fin (2 * ((r c).val + 1)) =>
            (minorantHBLocalizedSlot ((r c).val + 1) U Θ (t c) (ν c) i).coeff.support),
            if (∏ i, d i) = p c then
              ∏ i, (minorantHBLocalizedSlot ((r c).val + 1) U Θ (t c) (ν c) i).coeff (d i)
            else 0
        else 0 := by
  have hscalar (c : Fin 3) := minorantHB_five_closed_expansion
    (A c) (B c) U Θ (t c) (hA c) (hAB c) hU (hBU c)
      hΘ hΘtwo (ht c) (htten c) (p c)
  simp_rw [hscalar]
  rw [Fintype.prod_sum]
  refine Finset.sum_congr rfl (fun r _ => ?_)
  rw [Finset.prod_mul_distrib]
  congr 1
  conv_lhs => simp only [Finset.ite_sum_zero]
  rw [Finset.prod_univ_sum]
  refine Finset.sum_congr rfl (fun ν _ => ?_)
  refine Finset.prod_congr rfl (fun c _ => ?_)
  split_ifs
  · exact minorantHB_product_coefficient
      (fun i : Fin (2 * ((r c).val + 1)) =>
        minorantHBLocalizedSlot ((r c).val + 1) U Θ (t c) (ν c) i) (p c)
  · rfl

open Classical in
theorem minorantHB_three_factor_term_support
    (A B t : Fin 3 → ℝ) (U Θ : ℝ) (p : Fin 3 → ℕ) (r : Fin 3 → Fin 5)
    (ν d : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ)
    (hterm : (∏ c : Fin 3,
      if A c ≤ (p c : ℝ) ∧ (p c : ℝ) ≤ B c ∧ (∏ i, d c i) = p c then
        ∏ i, (minorantHBLocalizedSlot ((r c).val + 1) U Θ (t c) (ν c) i).coeff (d c i)
      else 0) ≠ 0) :
    (∀ c, A c ≤ (p c : ℝ) ∧ (p c : ℝ) ≤ B c ∧ (∏ i, d c i) = p c) ∧
    (∀ c i, d c i ∈
      (minorantHBLocalizedSlot ((r c).val + 1) U Θ (t c) (ν c) i).coeff.support) ∧
    (∀ c i, i.val < (r c).val + 1 → 0 < d c i ∧ (d c i : ℝ) ≤ U) := by
  have hnz (c : Fin 3) :
      (if A c ≤ (p c : ℝ) ∧ (p c : ℝ) ≤ B c ∧ (∏ i, d c i) = p c then
        ∏ i, (minorantHBLocalizedSlot ((r c).val + 1) U Θ (t c) (ν c) i).coeff (d c i)
      else 0) ≠ 0 := (Finset.prod_ne_zero_iff.mp hterm) c (Finset.mem_univ c)
  have hc (c : Fin 3) :
      A c ≤ (p c : ℝ) ∧ (p c : ℝ) ≤ B c ∧ (∏ i, d c i) = p c := by
    by_contra h
    exact hnz c (ite_eq_right h)
  have hs (c : Fin 3) (i : Fin (2 * ((r c).val + 1))) :
      d c i ∈ (minorantHBLocalizedSlot ((r c).val + 1) U Θ (t c) (ν c) i).coeff.support := by
    apply Finsupp.mem_support_iff.mpr
    have h := hnz c
    rw [ite_eq_left (hc c)] at h
    exact (Finset.prod_ne_zero_iff.mp h) i (Finset.mem_univ i)
  exact ⟨hc, hs, fun c i hi => minorantHBLocalizedSlot_moebius_support
    ((r c).val + 1) U Θ (t c) (ν c) i hi (d c i) (hs c i)⟩

theorem minorantHB_five_source_cutoff (x : ℝ) (hx : 1 ≤ x) :
    0 ≤ Real.rpow x (9 / 100 : ℝ) ∧
      Real.rpow x (40481 / 100000 + (1 / 10 ^ 10 : ℝ) / 10) ≤
        (Real.rpow x (9 / 100 : ℝ)) ^ 5 := by
  refine ⟨Real.rpow_nonneg (zero_le_one.trans hx) _, ?_⟩
  change x ^ (40481 / 100000 + (1 / 10 ^ 10 : ℝ) / 10) ≤
    (x ^ (9 / 100 : ℝ)) ^ (5 : ℕ)
  rw [← Real.rpow_mul_natCast (zero_le_one.trans hx)]
  apply Real.rpow_le_rpow_of_exponent_le hx
  norm_num

open Classical in
/--
The Boolean test for the four-exponent `T4` region: three ordered selected exponents satisfying
its size restrictions, and a remaining exponent at least as large as the third.
-/
noncomputable def sourceT4ExponentMask (α : Fin 4 → ℝ) : Bool :=
  decide ((9519 : ℝ) / 50000 ≤ α 2 ∧ α 2 < α 1 ∧ α 1 < α 0 ∧
    α 0 < (40481 : ℝ) / 100000 ∧ (59519 : ℝ) / 100000 < α 0 + α 1 ∧
    α 1 < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000 ∧ α 2 ≤ α 3)

open Classical in
/--
The Boolean test for the four-exponent `U1` region. Its inequalities involve coordinates `1`,
`2`, and `3`; coordinate `0` is unrestricted by this mask.
-/
noncomputable def sourceU1ExponentMask (α : Fin 4 → ℝ) : Bool :=
  decide ((9519 : ℝ) / 50000 ≤ α 2 ∧ α 2 < α 1 ∧ α 1 < (40481 : ℝ) / 100000 ∧
    α 2 + α 3 < (40481 : ℝ) / 100000 ∧
    α 1 < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000 ∧ α 2 ≤ α 3)

open Classical in
theorem sum_four_prime_divisorsAntidiagonal {A : Type*} [AddCommMonoid A]
    (n : ℕ) (w : (Fin 4 → ℕ) → A) :
    (∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
      ∑ c ∈ b.2.divisorsAntidiagonal,
        if a.1.Prime ∧ b.1.Prime ∧ c.1.Prime ∧ c.2.Prime then
          w ![a.1, b.1, c.1, c.2] else 0) =
      ∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => Nat.primesLE n),
        if (∏ i, p i) = n then w p else 0 := by
  let S : Finset (Σ _ : ℕ × ℕ, Σ _ : ℕ × ℕ, ℕ × ℕ) :=
    (n.divisorsAntidiagonal.sigma (fun a =>
      a.2.divisorsAntidiagonal.sigma (fun b => b.2.divisorsAntidiagonal))).filter
        (fun v => v.1.1.Prime ∧ v.2.1.1.Prime ∧ v.2.2.1.Prime ∧ v.2.2.2.Prime)
  let T : Finset (Fin 4 → ℕ) :=
    (Fintype.piFinset (fun _ : Fin 4 => Nat.primesLE n)).filter (fun p => ∏ i, p i = n)
  let f : (Σ _ : ℕ × ℕ, Σ _ : ℕ × ℕ, ℕ × ℕ) → Fin 4 → ℕ :=
    fun v => ![v.1.1, v.2.1.1, v.2.2.1, v.2.2.2]
  calc
    _ = ∑ v ∈ S, w (f v) := by
      simp only [S, f, Finset.sum_filter, Finset.sum_sigma]
    _ = ∑ p ∈ T, w p := by
      refine Finset.sum_bij (fun v _ => f v) ?_ ?_ ?_ (fun _ _ => rfl)
      · intro v hv
        obtain ⟨hvs, hp, hq, hr, hs⟩ := Finset.mem_filter.mp hv
        obtain ⟨ha, hbc⟩ := Finset.mem_sigma.mp hvs
        obtain ⟨hb, hc⟩ := Finset.mem_sigma.mp hbc
        have hproduct : ∏ i, f v i = n := by
          rw [Fin.prod_univ_four]
          change v.1.1 * v.2.1.1 * v.2.2.1 * v.2.2.2 = n
          rw [Nat.mul_assoc, Nat.mul_assoc, (Nat.mem_divisorsAntidiagonal.mp hc).1,
            (Nat.mem_divisorsAntidiagonal.mp hb).1, (Nat.mem_divisorsAntidiagonal.mp ha).1]
        have hprime (i : Fin 4) : (f v i).Prime := by
          fin_cases i
          · simpa [f] using hp
          · simpa [f] using hq
          · simpa [f] using hr
          · simpa [f] using hs
        apply Finset.mem_filter.mpr
        refine ⟨Fintype.mem_piFinset.mpr (fun i => ?_), hproduct⟩
        apply Nat.mem_primesLE.mpr
        refine ⟨Nat.le_of_dvd (Nat.pos_of_ne_zero (Nat.mem_divisorsAntidiagonal.mp ha).2) ?_,
          hprime i⟩
        rw [← hproduct]
        exact Finset.dvd_prod_of_mem _ (Finset.mem_univ i)
      · intro v hv u hu heq
        have h0 : v.1.1 = u.1.1 := congrArg (fun p : Fin 4 → ℕ => p 0) heq
        have h1 : v.2.1.1 = u.2.1.1 := congrArg (fun p : Fin 4 → ℕ => p 1) heq
        have h2 : v.2.2.1 = u.2.2.1 := congrArg (fun p : Fin 4 → ℕ => p 2) heq
        have h3 : v.2.2.2 = u.2.2.2 := congrArg (fun p : Fin 4 → ℕ => p 3) heq
        obtain ⟨_, hvt⟩ := Finset.mem_sigma.mp (Finset.mem_filter.mp hv).1
        obtain ⟨hvb, hvc⟩ := Finset.mem_sigma.mp hvt
        obtain ⟨_, hut⟩ := Finset.mem_sigma.mp (Finset.mem_filter.mp hu).1
        obtain ⟨hub, huc⟩ := Finset.mem_sigma.mp hut
        have hb : v.2.1.2 = u.2.1.2 := by
          rw [← (Nat.mem_divisorsAntidiagonal.mp hvc).1,
            ← (Nat.mem_divisorsAntidiagonal.mp huc).1, h2, h3]
        have ha : v.1.2 = u.1.2 := by
          rw [← (Nat.mem_divisorsAntidiagonal.mp hvb).1,
            ← (Nat.mem_divisorsAntidiagonal.mp hub).1, h1, hb]
        exact Sigma.ext (Prod.ext h0 ha)
          (heq_of_eq (Sigma.ext (Prod.ext h1 hb) (heq_of_eq (Prod.ext h2 h3))))
      · intro p hp
        obtain ⟨hpp, hpn⟩ := Finset.mem_filter.mp hp
        have hprime (i : Fin 4) := Nat.prime_of_mem_primesLE (Fintype.mem_piFinset.mp hpp i)
        have hn : n ≠ 0 := by
          rw [← hpn]
          exact Finset.prod_ne_zero_iff.mpr (fun i _ => (hprime i).ne_zero)
        have hprod : p 0 * (p 1 * (p 2 * p 3)) = n := by
          simpa only [Fin.prod_univ_four, Nat.mul_assoc] using hpn
        let v : Σ _ : ℕ × ℕ, Σ _ : ℕ × ℕ, ℕ × ℕ :=
          ⟨(p 0, p 1 * (p 2 * p 3)), ⟨(p 1, p 2 * p 3), (p 2, p 3)⟩⟩
        have hv : v ∈ S := by
          apply Finset.mem_filter.mpr
          refine ⟨Finset.mem_sigma.mpr ⟨?_, Finset.mem_sigma.mpr ⟨?_, ?_⟩⟩,
            hprime 0, hprime 1, hprime 2, hprime 3⟩
          · exact Nat.mem_divisorsAntidiagonal.mpr ⟨hprod, hn⟩
          · exact Nat.mem_divisorsAntidiagonal.mpr ⟨rfl,
              mul_ne_zero (hprime 1).ne_zero (mul_ne_zero (hprime 2).ne_zero (hprime 3).ne_zero)⟩
          · exact Nat.mem_divisorsAntidiagonal.mpr
              ⟨rfl, mul_ne_zero (hprime 2).ne_zero (hprime 3).ne_zero⟩
        refine ⟨v, hv, ?_⟩
        funext i
        fin_cases i <;> simp [f, v]
    _ = _ := by simp only [T, Finset.sum_filter]

open Classical in
theorem sum_four_prime_divisorsAntidiagonal_residual_first
    {A : Type*} [AddCommMonoid A] (n : ℕ) (w : (Fin 4 → ℕ) → A) :
    (∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
      ∑ c ∈ b.2.divisorsAntidiagonal,
        if a.1.Prime ∧ b.1.Prime ∧ c.1.Prime ∧ c.2.Prime then
          w ![c.2, a.1, b.1, c.1] else 0) =
      ∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => Nat.primesLE n),
        if (∏ i, p i) = n then w p else 0 := by
  let f : (Fin 4 → ℕ) → Fin 4 → ℕ := fun p => ![p 3, p 0, p 1, p 2]
  have hstart :
      (∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
        ∑ c ∈ b.2.divisorsAntidiagonal,
          if a.1.Prime ∧ b.1.Prime ∧ c.1.Prime ∧ c.2.Prime then
            w ![c.2, a.1, b.1, c.1] else 0) =
      ∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => Nat.primesLE n),
        if (∏ i, p i) = n then w (f p) else 0 := by
    simpa [f] using sum_four_prime_divisorsAntidiagonal n (fun p => w (f p))
  rw [hstart]
  refine Finset.sum_bij (fun p _ => f p) ?_ ?_ ?_ ?_
  · intro p hp
    apply Fintype.mem_piFinset.mpr
    intro i
    fin_cases i
    · simpa [f] using Fintype.mem_piFinset.mp hp 3
    · simpa [f] using Fintype.mem_piFinset.mp hp 0
    · simpa [f] using Fintype.mem_piFinset.mp hp 1
    · simpa [f] using Fintype.mem_piFinset.mp hp 2
  · intro p _ q _ hpq
    funext i
    fin_cases i
    · exact congrArg (fun p : Fin 4 → ℕ => p 1) hpq
    · exact congrArg (fun p : Fin 4 → ℕ => p 2) hpq
    · exact congrArg (fun p : Fin 4 → ℕ => p 3) hpq
    · exact congrArg (fun p : Fin 4 → ℕ => p 0) hpq
  · intro p hp
    refine ⟨![p 1, p 2, p 3, p 0], ?_, ?_⟩
    · apply Fintype.mem_piFinset.mpr
      intro i
      fin_cases i
      · simpa using Fintype.mem_piFinset.mp hp 1
      · simpa using Fintype.mem_piFinset.mp hp 2
      · simpa using Fintype.mem_piFinset.mp hp 3
      · simpa using Fintype.mem_piFinset.mp hp 0
    · funext i
      fin_cases i <;> simp [f]
  · intro p _
    have hprod : (∏ i, f p i) = ∏ i, p i := by
      simp only [Fin.prod_univ_four]
      change p 3 * p 0 * p 1 * p 2 = p 0 * p 1 * p 2 * p 3
      ac_rfl
    rw [hprod]

open Classical in
theorem sourceU1_eq_four_prime_tuple_sum (x : ℝ) (hx : 1 < x) (n : ℕ) :
    sourceU1 x n =
      ∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => Nat.primesLE n),
        if (∏ i, p i) = n then
          (if sourceU1ExponentMask (fun i => Real.logb x (p i : ℝ)) then (1 : ℝ) else 0)
        else 0 := by
  have hshape (ps : List ℕ) (hps : ps ∈ siftedPrimeTuples x (5 : Fin 6)) :
      ∃ p q r : ℕ, ps = [p, q, r] := by
    have hm := (mem_siftedPrimeTuples_iff x hx (5 : Fin 6) ps).mp hps
    rcases ps with _ | ⟨p, _ | ⟨q, _ | ⟨r, _ | ⟨s, ss⟩⟩⟩⟩ <;> simp at hm ⊢
  have hstart := sum_triple_list_divisorsAntidiagonal (siftedPrimeTuples x (5 : Fin 6))
    hshape (fun _ r => if r.Prime then (1 : ℝ) else 0) n
  change sourceU1 x n = _ at hstart
  rw [hstart, ← sum_four_prime_divisorsAntidiagonal_residual_first n
    (fun p => if sourceU1ExponentMask (fun i => Real.logb x (p i : ℝ)) then 1 else 0)]
  refine Finset.sum_congr rfl (fun a _ => ?_)
  refine Finset.sum_congr rfl (fun b _ => ?_)
  refine Finset.sum_congr rfl (fun c _ => ?_)
  have hm := mem_siftedPrimeTuples_iff x hx (5 : Fin 6) [a.1, b.1, c.1]
  dsimp only at hm
  simp only [hm]
  simp [sourceU1ExponentMask, ← ite_and, and_assoc, and_left_comm, and_comm]

open Classical in
theorem sourceT4_eventually_eq_four_prime_tuple_sum :
    ∃ X : ℝ, 3 ≤ X ∧ ∀ x : ℝ, X ≤ x → ∀ n : ℕ,
      x ≤ (n : ℝ) → (n : ℝ) ≤ 2 * x →
      sourceT4 x n =
        ∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => Nat.primesLE n),
          if (∏ i, p i) = n then
            (if sourceT4ExponentMask (fun i => Real.logb x (p i : ℝ)) then (1 : ℝ) else 0)
          else 0 := by
  obtain ⟨X, hX, hres⟩ := sourceT4_eventually_residual_prime
  refine ⟨X, hX, ?_⟩
  intro x hx n hnlo hnhi
  have hxOne : 1 < x := (by norm_num : (1 : ℝ) < 3).trans_le (hX.trans hx)
  rw [← sum_four_prime_divisorsAntidiagonal n
    (fun p => if sourceT4ExponentMask (fun i => Real.logb x (p i : ℝ)) then 1 else 0)]
  change (∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
    ∑ c ∈ b.2.divisorsAntidiagonal, _) = _
  refine Finset.sum_congr rfl (fun a ha => ?_)
  refine Finset.sum_congr rfl (fun b hb => ?_)
  refine Finset.sum_congr rfl (fun c hc => ?_)
  let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
  let P : Prop := a.1.Prime ∧ b.1.Prime ∧ c.1.Prime ∧
    (9519 : ℝ) / 50000 ≤ α c.1 ∧ α c.1 < α b.1 ∧ α b.1 < α a.1 ∧
    α a.1 < (40481 : ℝ) / 100000 ∧ (59519 : ℝ) / 100000 < α a.1 + α b.1 ∧
    α b.1 < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000
  change (if P then roughWeight (c.1 : ℝ) c.2 else 0) =
    if a.1.Prime ∧ b.1.Prime ∧ c.1.Prime ∧ c.2.Prime then
      (if sourceT4ExponentMask ![α a.1, α b.1, α c.1, α c.2] then 1 else 0) else 0
  by_cases hP : P
  · rw [ite_eq_left hP]
    obtain ⟨hp, hq, hr, hξ, hrq, hqp, hpa, hpq, hζ⟩ := hP
    by_cases hs : c.2.Prime
    · have horder : α c.1 ≤ α c.2 ↔ (c.1 : ℝ) ≤ (c.2 : ℝ) :=
        Real.logb_le_logb hxOne (Nat.cast_pos.mpr hr.pos) (Nat.cast_pos.mpr hs.pos)
      have hm : sourceT4ExponentMask ![α a.1, α b.1, α c.1, α c.2] =
          decide ((c.1 : ℝ) ≤ (c.2 : ℝ)) := by
        simp [sourceT4ExponentMask, hξ, hrq, hqp, hpa, hpq, hζ, horder]
      rw [ite_eq_left ⟨hp, hq, hr, hs⟩, hm]
      rw [roughWeight_eq_ite_minFac (c.1 : ℝ) hs.ne_zero hs.ne_one, hs.minFac_eq]
      simp
    · rw [ite_eq_right (fun h => hs h.2.2.2)]
      by_contra hrough
      have hn : n = a.1 * b.1 * c.1 * c.2 := by
        symm
        rw [Nat.mul_assoc, Nat.mul_assoc, (Nat.mem_divisorsAntidiagonal.mp hc).1,
          (Nat.mem_divisorsAntidiagonal.mp hb).1, (Nat.mem_divisorsAntidiagonal.mp ha).1]
      exact hs ((hres x hx n a.1 b.1 c.1 c.2 hnlo hnhi hn
        hp hq hr hξ hrq hqp hpa hpq hζ hrough).1)
  · rw [ite_eq_right hP]
    by_cases hprime : a.1.Prime ∧ b.1.Prime ∧ c.1.Prime ∧ c.2.Prime
    · rw [ite_eq_left hprime]
      symm
      apply ite_eq_right
      intro hm
      have hcuts : (9519 : ℝ) / 50000 ≤ α c.1 ∧ α c.1 < α b.1 ∧
          α b.1 < α a.1 ∧ α a.1 < (40481 : ℝ) / 100000 ∧
          (59519 : ℝ) / 100000 < α a.1 + α b.1 ∧
          α b.1 < 1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000 ∧ α c.1 ≤ α c.2 := by
        unfold sourceT4ExponentMask at hm
        simpa using of_decide_eq_true hm
      exact hP ⟨hprime.1, hprime.2.1, hprime.2.2.1, hcuts.1, hcuts.2.1,
        hcuts.2.2.1, hcuts.2.2.2.1, hcuts.2.2.2.2.1, hcuts.2.2.2.2.2.1⟩
    · rw [ite_eq_right hprime]

open Classical in
theorem sourceT4_sub_sourceU1_eventually_central_tuple_sum :
    ∃ X : ℝ, 3 ≤ X ∧ ∀ x : ℝ, X ≤ x → ∀ n : ℕ,
      x ≤ (n : ℝ) → (n : ℝ) ≤ 2 * x →
      let α : (Fin 4 → ℕ) → Fin 4 → ℝ := fun p i => Real.logb x (p i : ℝ)
      let w : (Fin 4 → ℕ) → ℝ := fun p =>
        (if sourceT4ExponentMask (α p) then 1 else 0) -
          (if sourceU1ExponentMask (α p) then 1 else 0)
      sourceT4 x n - sourceU1 x n =
        (∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => Nat.primesLE n),
          if (∏ i, p i) = n then w p else 0) ∧
      (∀ p : Fin 4 → ℕ, |w p| ≤ 1) ∧
      ∀ p ∈ Fintype.piFinset (fun _ : Fin 4 => Nat.primesLE n),
        (∏ i, p i) = n → w p ≠ 0 →
        (∀ i, (9519 : ℝ) / 50000 ≤ α p i) ∧
        ∃ S : Finset (Fin 4), S.Nonempty ∧ S ≠ Finset.univ ∧
          (40481 : ℝ) / 100000 ≤ ∑ i ∈ S, α p i ∧
            (∑ i ∈ S, α p i) ≤ (59519 : ℝ) / 100000 := by
  obtain ⟨X, hX, hT4⟩ := sourceT4_eventually_eq_four_prime_tuple_sum
  let Y : ℝ := max X (Real.exp ((10 : ℝ) ^ 10 * Real.log 2))
  refine ⟨Y, hX.trans (le_max_left _ _), ?_⟩
  intro x hx n hnlo hnhi α w
  have hxX : X ≤ x := (le_max_left _ _).trans hx
  have hxOne : 1 < x := (by norm_num : (1 : ℝ) < 3).trans_le (hX.trans hxX)
  have hxPos : 0 < x := zero_lt_one.trans hxOne
  have hlogx : 0 < Real.log x := Real.log_pos hxOne
  have hlogLarge : (10 : ℝ) ^ 10 * Real.log 2 ≤ Real.log x :=
    (Real.le_log_iff_exp_le hxPos).mpr ((le_max_right _ _).trans hx)
  have hsmall : Real.logb x 2 ≤ (1 / 10 ^ 10 : ℝ) := by
    apply (div_le_iff₀ hlogx).mpr
    nlinarith only [hlogLarge]
  refine ⟨?_, ?_, ?_⟩
  · rw [hT4 x hxX n hnlo hnhi, sourceU1_eq_four_prime_tuple_sum x hxOne,
      ← Finset.sum_sub_distrib]
    refine Finset.sum_congr rfl (fun p _ => ?_)
    by_cases hp : (∏ i, p i) = n <;> simp only [hp, ite_true, ite_false, w, α, sub_zero]
  · intro p
    dsimp only [w]
    cases sourceT4ExponentMask (α p) <;> cases sourceU1ExponentMask (α p) <;> norm_num
  · intro p hp hprod hw
    have hprime (i : Fin 4) := Nat.prime_of_mem_primesLE (Fintype.mem_piFinset.mp hp i)
    have hnonneg (i : Fin 4) : 0 ≤ α p i :=
      Real.logb_nonneg hxOne (by exact_mod_cast (hprime i).one_le)
    have hsum : (∑ i, α p i) = Real.logb x (n : ℝ) := by
      rw [← hprod, Nat.cast_prod]
      exact (Real.logb_prod Finset.univ _
        (fun i _ => (Nat.cast_pos.mpr (hprime i).pos).ne')).symm
    have hslo : 1 ≤ ∑ i, α p i := by
      rw [hsum]
      have h := Real.logb_le_logb_of_le hxOne hxPos hnlo
      simpa only [Real.logb_self_eq_one hxOne] using h
    have hshi : (∑ i, α p i) ≤ 1 + (1 / 10 ^ 10 : ℝ) := by
      rw [hsum]
      have h := Real.logb_le_logb_of_le hxOne (hxPos.trans_le hnlo) hnhi
      rw [Real.logb_mul (by norm_num : (2 : ℝ) ≠ 0) hxPos.ne',
        Real.logb_self_eq_one hxOne] at h
      linarith only [h, hsmall]
    apply minorant_t4_sub_u1_typeII_support (α p) hnonneg hslo hshi
    simpa only [w, sourceT4ExponentMask, sourceU1ExponentMask, decide_eq_true_eq] using hw

open Classical in
theorem minorantHB_three_closed_tuple_expansion
    (A B t : Fin 3 → ℝ) (U Θ : ℝ) (p : Fin 3 → ℕ)
    (hA : ∀ c, 1 ≤ A c) (hAB : ∀ c, A c ≤ B c) (hU : 0 ≤ U)
    (hBU : ∀ c, B c ≤ U ^ 5) (hΘ : 1 < Θ) (hΘtwo : Θ ≤ 2)
    (ht : ∀ c, 0 ≤ t c) (htten : ∀ c, t c ≤ 10) :
    (∏ c : Fin 3, if A c ≤ (p c : ℝ) ∧ (p c : ℝ) ≤ B c then
      ((Real.rpow (p c : ℝ) (-t c) * ArithmeticFunction.vonMangoldt (p c) : ℝ) : ℂ)
      else 0) =
    ∑ r : Fin 3 → Fin 5,
      (∏ c : Fin 3,
        (((-1 : ℝ) ^ (r c).val * ((5 : ℕ).choose ((r c).val + 1) : ℝ) : ℝ) : ℂ)) *
      ∑ ν ∈ Fintype.piFinset (fun c : Fin 3 =>
        minorantHBBoxes ((r c).val + 1) (A c) (B c) Θ),
        ∑ d ∈ Fintype.piFinset (fun c : Fin 3 =>
          Fintype.piFinset (fun i : Fin (2 * ((r c).val + 1)) =>
            (minorantHBLocalizedSlot ((r c).val + 1) U Θ (t c) (ν c) i).coeff.support)),
          ∏ c : Fin 3,
            if A c ≤ (p c : ℝ) ∧ (p c : ℝ) ≤ B c ∧ (∏ i, d c i) = p c then
              ∏ i, (minorantHBLocalizedSlot ((r c).val + 1) U Θ (t c) (ν c) i).coeff (d c i)
            else 0 := by
  rw [minorantHB_three_closed_factor_expansion A B t U Θ p hA hAB hU hBU
    hΘ hΘtwo ht htten]
  refine Finset.sum_congr rfl (fun r _ => ?_)
  congr 1
  refine Finset.sum_congr rfl (fun ν _ => ?_)
  have hprod := Finset.prod_univ_sum
    (fun c : Fin 3 => Fintype.piFinset
      (fun i : Fin (2 * ((r c).val + 1)) =>
        (minorantHBLocalizedSlot ((r c).val + 1) U Θ (t c) (ν c) i).coeff.support))
    (fun (c : Fin 3) (d : Fin (2 * ((r c).val + 1)) → ℕ) =>
      if A c ≤ (p c : ℝ) ∧ (p c : ℝ) ≤ B c ∧ (∏ i, d i) = p c then
        ∏ i, (minorantHBLocalizedSlot ((r c).val + 1) U Θ (t c) (ν c) i).coeff (d i)
      else (0 : ℂ))
  refine Eq.trans ?_ hprod
  refine Finset.prod_congr rfl (fun c _ => ?_)
  by_cases hc : A c ≤ (p c : ℝ) ∧ (p c : ℝ) ≤ B c
  · simp only [ite_eq_left hc]
    refine Finset.sum_congr rfl (fun d _ => ?_)
    by_cases hd : (∏ i, d i) = p c
    · rw [ite_eq_left hd, ite_eq_left ⟨hc.1, hc.2, hd⟩]
    · rw [ite_eq_right hd, ite_eq_right (fun h => hd h.2.2)]
  · rw [ite_eq_right hc]
    symm
    apply Finset.sum_eq_zero
    intro d _
    exact ite_eq_right (fun h => hc ⟨h.1, h.2.1⟩)

open Classical in
theorem minorantHB_three_source_term_geometry :
    let τ : ℝ := 1 / 10 ^ 10
    let a : ℝ := 40481 / 100000
    let ζ : ℝ := 1 - 1058 / 3125 - a
    ∃ X : ℝ, 2 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ Θ : ℝ, 1 < Θ → Θ ≤ 2 →
      ∀ (r : Fin 3 → Fin 5) (p : Fin 3 → ℕ) (t : Fin 3 → ℝ),
        (∀ c, 0 ≤ t c) → (∀ c, t c ≤ 10) →
      ∀ ν d : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ,
        ν ∈ Fintype.piFinset (fun c : Fin 3 =>
          minorantHBBoxes ((r c).val + 1) (x ^ (ζ - τ / 10)) (x ^ (a + τ / 10)) Θ) →
        (x ≤ ((∏ c, p c : ℕ) : ℝ) ∧ ((∏ c, p c : ℕ) : ℝ) ≤ 3 * x) →
        (∏ c : Fin 3,
          if x ^ (ζ - τ / 10) ≤ (p c : ℝ) ∧ (p c : ℝ) ≤ x ^ (a + τ / 10) ∧
            (∏ i, d c i) = p c then
            ∏ i, (minorantHBLocalizedSlot ((r c).val + 1) (x ^ (9 / 100 : ℝ))
              Θ (t c) (ν c) i).coeff (d c i)
          else 0) ≠ 0 →
        let α : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℝ :=
          fun c i => Real.logb x (Θ ^ ν c i)
        Fintype.card (Σ c : Fin 3, Fin (2 * ((r c).val + 1))) ≤ 30 ∧
          (∀ c i, 0 ≤ α c i) ∧
          (∀ c : Fin 3, ζ - τ / 5 ≤ ∑ i, α c i) ∧
          |(∑ c, ∑ i, α c i) - 1| ≤ τ / 1000 ∧
          ∀ (c : Fin 3) (i : Fin (2 * ((r c).val + 1))),
            i.val < (r c).val + 1 → α c i ≤ 1 / 10 := by
  intro τ a ζ
  obtain ⟨X, hX, hgeometry⟩ := minorant_three_prime_localized_exponent_geometry
  refine ⟨X, hX, ?_⟩
  intro x hx Θ hΘ hΘtwo r p t ht htten ν d hν htotal hterm
  have hxone : 1 ≤ x := (by norm_num : (1 : ℝ) ≤ 2).trans (hX.trans hx)
  have hA : 1 ≤ x ^ (ζ - τ / 10) :=
    Real.one_le_rpow hxone (by norm_num [ζ, a, τ])
  have hAB : x ^ (ζ - τ / 10) ≤ x ^ (a + τ / 10) :=
    Real.rpow_le_rpow_of_exponent_le hxone (by norm_num [ζ, a, τ])
  obtain ⟨hc, hs, hmu⟩ := minorantHB_three_factor_term_support
    (fun _ => x ^ (ζ - τ / 10)) (fun _ => x ^ (a + τ / 10)) t
      (x ^ (9 / 100 : ℝ)) Θ p r ν d hterm
  apply hgeometry x hx Θ hΘ hΘtwo r p ν d
  · exact fun c => (hc c).2.2
  · intro c i
    have hb := (minorantHB_box_localization ((r c).val + 1) (by omega)
      (x ^ (ζ - τ / 10)) (x ^ (a + τ / 10)) (x ^ (9 / 100 : ℝ))
        Θ (t c) hA hAB hΘ hΘtwo (ht c) (htten c)).2.2
    have hw := hb (ν c) (Fintype.mem_piFinset.mp hν c) i (d c i) (hs c i)
    exact ⟨hw.1, hw.2.1⟩
  · exact fun c => ⟨(hc c).1, (hc c).2.1⟩
  · exact htotal
  · exact fun c i hi => (hmu c i hi).2

open Classical in
theorem minorantHB_three_source_term_cases :
    let τ : ℝ := 1 / 10 ^ 10
    let a : ℝ := 40481 / 100000
    let ζ : ℝ := 1 - 1058 / 3125 - a
    ∃ X : ℝ, 2 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ Θ : ℝ, 1 < Θ → Θ ≤ 2 →
      ∀ (r : Fin 3 → Fin 5) (p : Fin 3 → ℕ) (t : Fin 3 → ℝ),
        (∀ c, 0 ≤ t c) → (∀ c, t c ≤ 10) →
      ∀ ν d : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ,
        ν ∈ Fintype.piFinset (fun c : Fin 3 =>
          minorantHBBoxes ((r c).val + 1) (x ^ (ζ - τ / 10)) (x ^ (a + τ / 10)) Θ) →
        (x ≤ ((∏ c, p c : ℕ) : ℝ) ∧ ((∏ c, p c : ℕ) : ℝ) ≤ 3 * x) →
        (∏ c : Fin 3,
          if x ^ (ζ - τ / 10) ≤ (p c : ℝ) ∧ (p c : ℝ) ≤ x ^ (a + τ / 10) ∧
            (∏ i, d c i) = p c then
            ∏ i, (minorantHBLocalizedSlot ((r c).val + 1) (x ^ (9 / 100 : ℝ))
              Θ (t c) (ν c) i).coeff (d c i)
          else 0) ≠ 0 →
        let α : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℝ :=
          fun c i => Real.logb x (Θ ^ ν c i)
        let I := Σ c : Fin 3, Fin (2 * ((r c).val + 1))
        Fintype.card I ≤ 30 ∧
          ((∃ s : I,
            (r s.1).val + 1 ≤ s.2.val ∧ 1058 / 3125 - τ ≤ α s.1 s.2) ∨
          (∃ S : Finset I,
            a - τ ≤ ∑ s ∈ S, α s.1 s.2 ∧
              (∑ s ∈ S, α s.1 s.2) ≤ 59519 / 100000 + τ) ∨
          (∃ s t u : I,
            s ≠ t ∧ s ≠ u ∧ t ≠ u ∧
            (r s.1).val + 1 ≤ s.2.val ∧ (r t.1).val + 1 ≤ t.2.val ∧
            (r u.1).val + 1 ≤ u.2.val ∧
            (19 / 100 - τ ≤ α s.1 s.2 ∧ α s.1 s.2 ≤ 81 / 200 + τ) ∧
            (19 / 100 - τ ≤ α t.1 t.2 ∧ α t.1 t.2 ≤ 81 / 200 + τ) ∧
            (19 / 100 - τ ≤ α u.1 u.2 ∧ α u.1 u.2 ≤ 81 / 200 + τ) ∧
            119 / 200 - τ ≤ α s.1 s.2 + α t.1 t.2 ∧
            119 / 200 - τ ≤ α s.1 s.2 + α u.1 u.2 ∧
            119 / 200 - τ ≤ α t.1 t.2 + α u.1 u.2)) := by
  intro τ a ζ
  obtain ⟨X, hX, hgeometry⟩ := minorantHB_three_source_term_geometry
  refine ⟨X, hX, ?_⟩
  intro x hx Θ hΘ hΘtwo r p t ht htten ν d hν htotal hterm α I
  have hg := hgeometry x hx Θ hΘ hΘtwo r p t ht htten ν d hν htotal hterm
  refine ⟨hg.1, ?_⟩
  exact minorant_three_prime_colored_slot_trichotomy τ
    (by norm_num [τ]) (by norm_num [τ]) r α hg.2.1 hg.2.2.1
    hg.2.2.2.1 hg.2.2.2.2

section

open scoped ContDiff
open Classical in
/--
The order-five Heath–Brown expansion assembled from all localized boxes, with alternating
binomial coefficients and Mellin-weighted convolution slots. No final coefficient mask
restricting the product to `[A, B]` is applied.
-/
noncomputable def minorantHBUnmaskedFive (A B U Θ t : ℝ) : ℕ →₀ ℂ :=
  ∑ r : Fin 5,
    (((-1 : ℝ) ^ r.val * ((5 : ℕ).choose (r.val + 1) : ℝ) : ℝ) : ℂ) •
      ∑ ν ∈ minorantHBBoxes (r.val + 1) A B Θ,
        (∏ i, minorantHBLocalizedSlot (r.val + 1) U Θ t ν i).coeff

/--
The finitely supported Mellin-weighted von Mangoldt sequence on the closed integer window from
`⌈A⌉₊` to `⌊B⌋₊`.
-/
noncomputable def minorantHBClosedMangoldt (A B t : ℝ) : ℕ →₀ ℂ :=
  ∑ n ∈ Finset.Icc ⌈A⌉₊ ⌊B⌋₊,
    Finsupp.single n ((Real.rpow (n : ℝ) (-t) * ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)

open Classical in
theorem minorantHBClosedMangoldt_apply (A B t : ℝ)
    (hB : 0 ≤ B) (n : ℕ) :
    minorantHBClosedMangoldt A B t n =
      if A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B then
        ((Real.rpow (n : ℝ) (-t) * ArithmeticFunction.vonMangoldt n : ℝ) : ℂ)
      else 0 := by
  have hmem : n ∈ Finset.Icc ⌈A⌉₊ ⌊B⌋₊ ↔ A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B := by
    rw [Finset.mem_Icc, Nat.ceil_le, Nat.le_floor_iff hB]
  simp only [minorantHBClosedMangoldt, Finsupp.finsetSum_apply,
    Finsupp.single_apply, Finset.sum_ite_eq', hmem]

open Classical in
theorem minorantHB_box_remainder
    (j : ℕ) (hj : 0 < j) (A B U Θ t : ℝ)
    (hA : 1 ≤ A) (hAB : A ≤ B) (hΘ : 1 < Θ) (hΘtwo : Θ ≤ 2)
    (ht : 0 ≤ t) (htten : t ≤ 10) :
    let g : ℕ →₀ ℂ := ∑ ν ∈ minorantHBBoxes j A B Θ,
      (∏ i, minorantHBLocalizedSlot j U Θ t ν i).coeff
    let e : ℕ →₀ ℂ := g - g.filter (fun n : ℕ => A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B)
    (∀ n ∈ e.support,
      (A / Θ ^ (4 * j) ≤ (n : ℝ) ∧ (n : ℝ) < A) ∨
        (B < (n : ℝ) ∧ (n : ℝ) ≤ B * Θ ^ (4 * j))) ∧
    ∀ n : ℕ, ‖e n‖ ≤ (n.divisors.card : ℝ) ^ (2 * j - 1) * Real.log (n : ℝ) := by
  have h := heathBrown_finite_smooth_box_boundary
    j hj A B U Θ t hA hAB hΘ hΘtwo ht htten
  dsimp only at h
  have he := h.2.2.2
  rw [h.2.1] at he
  exact he

open Classical in
theorem minorantHB_five_boundary
    (A B U Θ t : ℝ) (hA : 1 ≤ A) (hAB : A ≤ B) (hU : 0 ≤ U)
    (hBU : B ≤ U ^ 5) (hΘ : 1 < Θ) (hΘtwo : Θ ≤ 2)
    (ht : 0 ≤ t) (htten : t ≤ 10) :
    let E : ℕ →₀ ℂ := minorantHBUnmaskedFive A B U Θ t - minorantHBClosedMangoldt A B t
    (∀ n ∈ E.support,
      (A / Θ ^ 20 ≤ (n : ℝ) ∧ (n : ℝ) < A) ∨
        (B < (n : ℝ) ∧ (n : ℝ) ≤ B * Θ ^ 20)) ∧
    ∀ n : ℕ, ‖E n‖ ≤ 31 * (n.divisors.card : ℝ) ^ 9 * Real.log (n : ℝ) := by
  intro E
  let a : Fin 5 → ℂ := fun r =>
    (((-1 : ℝ) ^ r.val * ((5 : ℕ).choose (r.val + 1) : ℝ) : ℝ) : ℂ)
  let g : Fin 5 → ℕ →₀ ℂ := fun r =>
    ∑ ν ∈ minorantHBBoxes (r.val + 1) A B Θ,
      (∏ i, minorantHBLocalizedSlot (r.val + 1) U Θ t ν i).coeff
  let e : Fin 5 → ℕ →₀ ℂ := fun r =>
    g r - (g r).filter (fun n : ℕ => A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B)
  have hB : 0 ≤ B := zero_le_one.trans (hA.trans hAB)
  have hΘpos : 0 < Θ := zero_lt_one.trans hΘ
  have hF : minorantHBClosedMangoldt A B t =
      ∑ r : Fin 5, a r • (g r).filter (fun n : ℕ => A ≤ (n : ℝ) ∧ (n : ℝ) ≤ B) := by
    ext n
    rw [minorantHBClosedMangoldt_apply A B t hB n]
    simpa only [Finsupp.finsetSum_apply, Finsupp.smul_apply, smul_eq_mul,
      Finsupp.filter_apply, a, g] using
      minorantHB_five_closed_expansion A B U Θ t hA hAB hU hBU hΘ hΘtwo ht htten n
  have hE : E = ∑ r : Fin 5, a r • e r := by
    dsimp only [E, minorantHBUnmaskedFive]
    rw [hF]
    simp only [e, smul_sub, Finset.sum_sub_distrib, a, g]
  have hEn (n : ℕ) : E n = ∑ r : Fin 5, a r * e r n := by
    rw [hE]
    simp only [Finsupp.finsetSum_apply, Finsupp.smul_apply, smul_eq_mul]
  have he (r : Fin 5) := minorantHB_box_remainder (r.val + 1) (by omega)
    A B U Θ t hA hAB hΘ hΘtwo ht htten
  change ∀ r : Fin 5,
    (∀ n ∈ (e r).support,
      (A / Θ ^ (4 * (r.val + 1)) ≤ (n : ℝ) ∧ (n : ℝ) < A) ∨
        (B < (n : ℝ) ∧ (n : ℝ) ≤ B * Θ ^ (4 * (r.val + 1)))) ∧
    ∀ n, ‖e r n‖ ≤ (n.divisors.card : ℝ) ^ (2 * (r.val + 1) - 1) *
      Real.log (n : ℝ) at he
  have hpow (r : Fin 5) : Θ ^ (4 * (r.val + 1)) ≤ Θ ^ (20 : ℕ) :=
    pow_le_pow_right₀ hΘ.le (by have := r.isLt; omega)
  constructor
  · intro n hn
    by_contra hout
    have hz (r : Fin 5) : e r n = 0 := by
      by_contra hr
      rcases (he r).1 n (Finsupp.mem_support_iff.mpr hr) with hl | hu
      · apply hout
        exact Or.inl ⟨(div_le_div_of_nonneg_left (zero_le_one.trans hA)
          (pow_pos hΘpos _) (hpow r)).trans hl.1, hl.2⟩
      · apply hout
        exact Or.inr ⟨hu.1, hu.2.trans (mul_le_mul_of_nonneg_left (hpow r) hB)⟩
    have hne := Finsupp.mem_support_iff.mp hn
    rw [hEn] at hne
    simp only [hz, mul_zero, Finset.sum_const_zero, ne_eq, not_true_eq_false] at hne
  · intro n
    have hlog : 0 ≤ Real.log (n : ℝ) := Real.log_natCast_nonneg n
    have hlocal (r : Fin 5) : ‖e r n‖ ≤ (n.divisors.card : ℝ) ^ 9 * Real.log (n : ℝ) := by
      by_cases hn : n = 0
      · simpa only [hn, Nat.cast_zero, Real.log_zero, mul_zero] using (he r).2 n
      · have hd : 1 ≤ (n.divisors.card : ℝ) := by
          exact_mod_cast Finset.card_pos.mpr ⟨1, Nat.one_mem_divisors.mpr hn⟩
        exact ((he r).2 n).trans (mul_le_mul_of_nonneg_right
          (pow_le_pow_right₀ hd (by have := r.isLt; omega)) hlog)
    have ha (r : Fin 5) : ‖a r‖ = ((5 : ℕ).choose (r.val + 1) : ℝ) := by
      simp [a]
    have hsum : (∑ r : Fin 5, ((5 : ℕ).choose (r.val + 1) : ℝ)) = 31 := by
      norm_num [Fin.sum_univ_succ, Nat.choose]
    rw [hEn]
    calc
      ‖∑ r : Fin 5, a r * e r n‖ ≤ ∑ r : Fin 5, ‖a r * e r n‖ := norm_sum_le _ _
      _ ≤ ∑ r : Fin 5, ((5 : ℕ).choose (r.val + 1) : ℝ) *
          ((n.divisors.card : ℝ) ^ 9 * Real.log (n : ℝ)) := by
        apply Finset.sum_le_sum
        intro r _
        rw [norm_mul, ha]
        exact mul_le_mul_of_nonneg_left (hlocal r) (Nat.cast_nonneg _)
      _ = 31 * (n.divisors.card : ℝ) ^ 9 * Real.log (n : ℝ) := by
        rw [← Finset.sum_mul, hsum]
        ring

open Classical in
theorem minorantHB_three_boundary_telescope
    (A B t : Fin 3 → ℝ) (U Θ : ℝ) (p : Fin 3 → ℕ) :
    let G : Fin 3 → ℂ := fun c => minorantHBUnmaskedFive (A c) (B c) U Θ (t c) (p c)
    let F : Fin 3 → ℂ := fun c => minorantHBClosedMangoldt (A c) (B c) (t c) (p c)
    let E : Fin 3 → ℂ := fun c => G c - F c
    ((∏ c, G c) - ∏ c, F c =
      E 0 * G 1 * G 2 + F 0 * E 1 * G 2 + F 0 * F 1 * E 2) ∧
    ‖(∏ c, G c) - ∏ c, F c‖ ≤
      ‖E 0‖ * ‖G 1‖ * ‖G 2‖ + ‖F 0‖ * ‖E 1‖ * ‖G 2‖ +
        ‖F 0‖ * ‖F 1‖ * ‖E 2‖ := by
  intro G F E
  have hid : (∏ c, G c) - ∏ c, F c =
      E 0 * G 1 * G 2 + F 0 * E 1 * G 2 + F 0 * F 1 * E 2 := by
    norm_num [Fin.prod_univ_succ, E]
    ring
  refine ⟨hid, ?_⟩
  rw [hid]
  simpa only [norm_mul] using
    (norm_add₃_le (a := E 0 * G 1 * G 2) (b := F 0 * E 1 * G 2)
      (c := F 0 * F 1 * E 2))

theorem minorantHBClosedMangoldt_norm_le (A B t : ℝ)
    (hA : 1 ≤ A) (hAB : A ≤ B) (ht : 0 ≤ t) (n : ℕ) :
    ‖minorantHBClosedMangoldt A B t n‖ ≤ Real.log (n : ℝ) := by
  rw [minorantHBClosedMangoldt_apply A B t (zero_le_one.trans (hA.trans hAB)) n]
  split_ifs with hn
  · have hnn : 1 ≤ (n : ℝ) := hA.trans hn.1
    have hw : 0 ≤ Real.rpow (n : ℝ) (-t) := Real.rpow_nonneg (Nat.cast_nonneg _) _
    have hwone : Real.rpow (n : ℝ) (-t) ≤ 1 :=
      Real.rpow_le_one_of_one_le_of_nonpos hnn (neg_nonpos.mpr ht)
    rw [Complex.norm_real, Real.norm_eq_abs,
      abs_of_nonneg (mul_nonneg hw ArithmeticFunction.vonMangoldt_nonneg)]
    exact (mul_le_of_le_one_left ArithmeticFunction.vonMangoldt_nonneg hwone).trans
      ArithmeticFunction.vonMangoldt_le_log
  · exact (norm_zero : ‖(0 : ℂ)‖ = 0).le.trans (Real.log_natCast_nonneg n)

theorem minorantHBUnmaskedFive_norm_le
    (A B U Θ t : ℝ) (hA : 1 ≤ A) (hAB : A ≤ B) (hU : 0 ≤ U)
    (hBU : B ≤ U ^ 5) (hΘ : 1 < Θ) (hΘtwo : Θ ≤ 2)
    (ht : 0 ≤ t) (htten : t ≤ 10) (n : ℕ) :
    ‖minorantHBUnmaskedFive A B U Θ t n‖ ≤
      32 * (n.divisors.card : ℝ) ^ 9 * Real.log (n : ℝ) := by
  have hF := minorantHBClosedMangoldt_norm_le A B t hA hAB ht n
  have hE := (minorantHB_five_boundary A B U Θ t hA hAB hU hBU hΘ hΘtwo ht htten).2 n
  simp only [Finsupp.sub_apply] at hE
  have hnorm := norm_add_le
    (minorantHBUnmaskedFive A B U Θ t n - minorantHBClosedMangoldt A B t n)
    (minorantHBClosedMangoldt A B t n)
  rw [sub_add_cancel] at hnorm
  by_cases hn : n = 0
  · subst n
    simp only [Nat.cast_zero, Real.log_zero, mul_zero] at hF hE ⊢
    exact hnorm.trans (by linarith)
  · have hd : 1 ≤ (n.divisors.card : ℝ) := by
      exact_mod_cast Finset.card_pos.mpr ⟨1, Nat.one_mem_divisors.mpr hn⟩
    have hl : Real.log (n : ℝ) ≤ (n.divisors.card : ℝ) ^ 9 * Real.log (n : ℝ) :=
      (one_mul _).symm.le.trans
        (mul_le_mul_of_nonneg_right (one_le_pow₀ hd) (Real.log_natCast_nonneg n))
    nlinarith only [hnorm, hE, hF, hl]

open Classical in
theorem minorantHB_three_unmasked_convolution
    (A B t : Fin 3 → ℝ) (U Θ : ℝ) :
    (∏ c : Fin 3,
      (MonoidAlgebra.ofCoeff (minorantHBUnmaskedFive (A c) (B c) U Θ (t c)) :
        MonoidAlgebra ℂ ℕ)) =
    ∑ r : Fin 3 → Fin 5,
      (∏ c : Fin 3,
        (((-1 : ℝ) ^ (r c).val * ((5 : ℕ).choose ((r c).val + 1) : ℝ) : ℝ) : ℂ)) •
      ∑ ν ∈ Fintype.piFinset (fun c : Fin 3 =>
        minorantHBBoxes ((r c).val + 1) (A c) (B c) Θ),
        ∏ s : Σ c : Fin 3, Fin (2 * ((r c).val + 1)),
          minorantHBLocalizedSlot ((r s.1).val + 1) U Θ (t s.1) (ν s.1) s.2 := by
  simp only [minorantHBUnmaskedFive, MonoidAlgebra.ofCoeff_sum,
    MonoidAlgebra.ofCoeff_smul, MonoidAlgebra.ofCoeff_coeff]
  rw [Fintype.prod_sum]
  refine Finset.sum_congr rfl (fun r _ => ?_)
  rw [Finset.prod_smul]
  congr 1
  rw [Finset.prod_univ_sum]
  refine Finset.sum_congr rfl (fun ν _ => ?_)
  exact (Fintype.prod_sigma' (fun (c : Fin 3) (i : Fin (2 * ((r c).val + 1))) =>
    minorantHBLocalizedSlot ((r c).val + 1) U Θ (t c) (ν c) i)).symm

open Classical in
theorem minorantHB_three_unmasked_convolution_coefficient
    (A B t : Fin 3 → ℝ) (U Θ : ℝ) (n : ℕ) :
    (∏ c : Fin 3,
      (MonoidAlgebra.ofCoeff (minorantHBUnmaskedFive (A c) (B c) U Θ (t c)) :
        MonoidAlgebra ℂ ℕ)).coeff n =
    ∑ r : Fin 3 → Fin 5,
      (∏ c : Fin 3,
        (((-1 : ℝ) ^ (r c).val * ((5 : ℕ).choose ((r c).val + 1) : ℝ) : ℝ) : ℂ)) *
      ∑ ν ∈ Fintype.piFinset (fun c : Fin 3 =>
        minorantHBBoxes ((r c).val + 1) (A c) (B c) Θ),
        (∏ s : Σ c : Fin 3, Fin (2 * ((r c).val + 1)),
          minorantHBLocalizedSlot ((r s.1).val + 1) U Θ (t s.1) (ν s.1) s.2).coeff n := by
  rw [minorantHB_three_unmasked_convolution]
  simp only [MonoidAlgebra.coeff_sum, MonoidAlgebra.coeff_smul,
    Finsupp.finsetSum_apply, Finsupp.smul_apply, smul_eq_mul]

end

open Classical in
theorem minorantHB_three_radial_selection
    (A B t : Fin 3 → ℝ) (U Θ x : ℝ)
    (hA : ∀ c, 1 ≤ A c) (hAB : ∀ c, A c ≤ B c)
    (hΘ : 1 < Θ) (hΘtwo : Θ ≤ 2)
    (ht : ∀ c, 0 ≤ t c) (htten : ∀ c, t c ≤ 10) :
    let boxes (r : Fin 3 → Fin 5) :=
      Fintype.piFinset (fun c : Fin 3 =>
        minorantHBBoxes ((r c).val + 1) (A c) (B c) Θ)
    let β (r : Fin 3 → Fin 5)
        (ν : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ) : ℕ →₀ ℂ :=
      (∏ s : Σ c : Fin 3, Fin (2 * ((r c).val + 1)),
        minorantHBLocalizedSlot ((r s.1).val + 1) U Θ (t s.1) (ν s.1) s.2).coeff
    let P (r : Fin 3 → Fin 5)
        (ν : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ) : ℝ :=
      ∏ s : Σ c : Fin 3, Fin (2 * ((r c).val + 1)), Θ ^ ν s.1 s.2
    let selected (r : Fin 3 → Fin 5) :=
      (boxes r).filter (fun ν => x * Θ ^ 30 ≤ P r ν ∧ P r ν * Θ ^ 30 ≤ 2 * x)
    let a (r : Fin 3 → Fin 5) : ℂ :=
      ∏ c : Fin 3,
        (((-1 : ℝ) ^ (r c).val * ((5 : ℕ).choose ((r c).val + 1) : ℝ) : ℝ) : ℂ)
    let F : ℕ →₀ ℂ :=
      (∏ c : Fin 3,
        (MonoidAlgebra.ofCoeff (minorantHBUnmaskedFive (A c) (B c) U Θ (t c)) :
          MonoidAlgebra ℂ ℕ)).coeff
    let S : ℕ →₀ ℂ := ∑ r : Fin 3 → Fin 5, a r • ∑ ν ∈ selected r, β r ν
    let R : ℕ →₀ ℂ := F.filter (fun n : ℕ => x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x) - S
    (∀ n ∈ R.support,
      (x ≤ (n : ℝ) ∧ (n : ℝ) ≤ x * Θ ^ 60) ∨
        (2 * x / Θ ^ 60 ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x)) ∧
      ∀ n : ℕ, ‖R n‖ ≤
        (31 : ℝ) ^ 3 * (n.divisors.card : ℝ) ^ 29 *
          (1 + Real.log (n : ℝ)) ^ 40 := by
  intro boxes β P selected a F S R
  let rejected (r : Fin 3 → Fin 5) :=
    (boxes r).filter (fun ν => ¬(x * Θ ^ 30 ≤ P r ν ∧ P r ν * Θ ^ 30 ≤ 2 * x))
  have hselected (r : Fin 3 → Fin 5)
      (ν : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ)
      (hν : ν ∈ selected r) (n : ℕ) (hn : n ∈ (β r ν).support) :
      x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x := by
    have hmem := Finset.mem_filter.mp hν
    exact minorantHB_three_radial_selected_support
      A B t U Θ x hA hAB hΘ hΘtwo ht htten r ν hmem.1
        hmem.2.1 hmem.2.2 n hn
  have hselected_zero (r : Fin 3 → Fin 5)
      (ν : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ)
      (hν : ν ∈ selected r) (n : ℕ)
      (hn : ¬(x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x)) : β r ν n = 0 := by
    apply Finsupp.notMem_support_iff.mp
    exact fun hm => hn (hselected r ν hν n hm)
  have hF (n : ℕ) :
      F n = ∑ r : Fin 3 → Fin 5, a r * ∑ ν ∈ boxes r, β r ν n :=
    minorantHB_three_unmasked_convolution_coefficient A B t U Θ n
  have hS (n : ℕ) :
      S n = ∑ r : Fin 3 → Fin 5, a r * ∑ ν ∈ selected r, β r ν n := by
    simp only [S, Finsupp.finsetSum_apply, Finsupp.smul_apply, smul_eq_mul]
  have hR (n : ℕ) :
      R n = if x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x then
        ∑ r : Fin 3 → Fin 5, a r * ∑ ν ∈ rejected r, β r ν n else 0 := by
    change (F.filter (fun m : ℕ => x ≤ (m : ℝ) ∧ (m : ℝ) ≤ 2 * x)) n - S n = _
    rw [Finsupp.filter_apply, hF, hS]
    by_cases hn : x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x
    · rw [ite_eq_left hn, ite_eq_left hn, ← Finset.sum_sub_distrib]
      apply Finset.sum_congr rfl
      intro r _
      rw [← mul_sub]
      congr 1
      apply sub_eq_iff_eq_add.mpr
      have hpartition := Finset.sum_filter_add_sum_filter_not (boxes r)
        (fun ν => x * Θ ^ 30 ≤ P r ν ∧ P r ν * Θ ^ 30 ≤ 2 * x)
        (fun ν => β r ν n)
      simpa only [selected, rejected, add_comm] using hpartition.symm
    · rw [ite_eq_right hn, ite_eq_right hn]
      have hzero :
          (∑ r : Fin 3 → Fin 5, a r * ∑ ν ∈ selected r, β r ν n) = 0 := by
        apply Finset.sum_eq_zero
        intro r _
        rw [Finset.sum_eq_zero (fun ν hν => hselected_zero r ν hν n hn), mul_zero]
      rw [hzero, sub_zero]
  have hbinomial :
      (∑ r : Fin 3 → Fin 5, ‖a r‖) = (31 : ℝ) ^ 3 := by
    have ha (r : Fin 3 → Fin 5) :
        ‖a r‖ = ∏ c : Fin 3, ((5 : ℕ).choose ((r c).val + 1) : ℝ) := by
      simp [a]
    simp_rw [ha]
    rw [← Fintype.prod_sum (fun (_c : Fin 3) (v : Fin 5) =>
      ((5 : ℕ).choose (v.val + 1) : ℝ))]
    have hsum : (∑ r : Fin 5, ((5 : ℕ).choose (r.val + 1) : ℝ)) = 31 := by
      norm_num [Fin.sum_univ_succ, Nat.choose]
    simp only [hsum, Finset.prod_const, Finset.card_univ, Fintype.card_fin]
  constructor
  · intro n hn
    have hne := Finsupp.mem_support_iff.mp hn
    rw [hR] at hne
    have hclosed : x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x := by
      by_contra hout
      exact hne (ite_eq_right hout)
    rw [ite_eq_left hclosed] at hne
    by_contra hout
    have hzero (r : Fin 3 → Fin 5)
        (ν : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ)
        (hν : ν ∈ rejected r) : β r ν n = 0 := by
      by_contra hcoef
      have hmem := Finset.mem_filter.mp hν
      exact hout (minorantHB_three_rejected_box_radial_support
        A B t U Θ x hA hAB hΘ hΘtwo ht htten r ν hmem.1 hmem.2
          n (Finsupp.mem_support_iff.mpr hcoef) hclosed.1 hclosed.2)
    apply hne
    apply Finset.sum_eq_zero
    intro r _
    rw [Finset.sum_eq_zero (fun ν hν => hzero r ν hν), mul_zero]
  · intro n
    let H : ℝ := (n.divisors.card : ℝ) ^ 29 * (1 + Real.log (n : ℝ)) ^ 40
    have hH : 0 ≤ H :=
      mul_nonneg (pow_nonneg (Nat.cast_nonneg _) _)
        (pow_nonneg (add_nonneg zero_le_one (Real.log_natCast_nonneg n)) _)
    have hsum (r : Fin 3 → Fin 5) :
        ‖∑ ν ∈ rejected r, β r ν n‖ ≤ H :=
      (norm_sum_le _ _).trans
        (minorantHB_three_box_family_coefficient_norm_sum_le
          A B t U Θ hA hAB hΘ hΘtwo ht htten r (rejected r)
          (Finset.filter_subset _ _) n)
    rw [hR]
    by_cases hn : x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x
    · rw [ite_eq_left hn]
      calc
        _ ≤ ∑ r : Fin 3 → Fin 5, ‖a r * ∑ ν ∈ rejected r, β r ν n‖ :=
          norm_sum_le _ _
        _ ≤ ∑ r : Fin 3 → Fin 5, ‖a r‖ * H := by
          apply Finset.sum_le_sum
          intro r _
          rw [norm_mul]
          exact mul_le_mul_of_nonneg_left (hsum r) (norm_nonneg _)
        _ = (31 : ℝ) ^ 3 * H := by rw [← Finset.sum_mul, hbinomial]
        _ = _ := by dsimp only [H]; ring
    · rw [ite_eq_right hn, norm_zero]
      exact (mul_nonneg (by positivity : 0 ≤ (31 : ℝ) ^ 3) hH).trans_eq
        (by dsimp only [H]; ring)

theorem minorantHB_two_original_cofactor_norm_le
    (A B t : Fin 3 → ℝ) (U Θ : ℝ)
    (hA : ∀ c, 1 ≤ A c) (hAB : ∀ c, A c ≤ B c)
    (hU : 0 ≤ U) (hBU : ∀ c, B c ≤ U ^ 5)
    (hΘ : 1 < Θ) (hΘtwo : Θ ≤ 2)
    (ht : ∀ c, 0 ≤ t c) (htten : ∀ c, t c ≤ 10)
    (c d : Fin 3) (e f : Bool) :
    let H : Fin 3 → Bool → ℕ →₀ ℂ := fun i b =>
      if b then minorantHBUnmaskedFive (A i) (B i) U Θ (t i)
      else minorantHBClosedMangoldt (A i) (B i) (t i)
    (∀ m : ℕ,
      ‖((MonoidAlgebra.ofCoeff (H c e) : MonoidAlgebra ℂ ℕ) *
        MonoidAlgebra.ofCoeff (H d f)).coeff m‖ ≤
          1024 * (m.divisors.card : ℝ) ^ 19 * (Real.log (m : ℝ)) ^ 2) ∧
      ((MonoidAlgebra.ofCoeff (H c e) : MonoidAlgebra ℂ ℕ) *
        MonoidAlgebra.ofCoeff (H d f)).coeff 0 = 0 := by
  classical
  intro H
  have hH (i : Fin 3) (b : Bool) (m : ℕ) :
      ‖H i b m‖ ≤ 32 * (m.divisors.card : ℝ) ^ 9 * Real.log (m : ℝ) := by
    cases b
    · simp only [H, Bool.false_eq_true, ite_false]
      have hmF := minorantHBClosedMangoldt_norm_le
        (A i) (B i) (t i) (hA i) (hAB i) (ht i) m
      by_cases hm : m = 0
      · simpa only [hm, Nat.cast_zero, Real.log_zero, mul_zero] using hmF
      · have hτ : 1 ≤ (m.divisors.card : ℝ) := by
          exact_mod_cast Finset.card_pos.mpr ⟨1, Nat.one_mem_divisors.mpr hm⟩
        have hscale : 1 ≤ 32 * (m.divisors.card : ℝ) ^ 9 :=
          (by norm_num : (1 : ℝ) ≤ 32).trans
            (le_mul_of_one_le_right (by norm_num) (one_le_pow₀ hτ))
        exact hmF.trans (le_mul_of_one_le_left (Real.log_natCast_nonneg m) hscale)
    · simpa only [H, ite_true] using minorantHBUnmaskedFive_norm_le
        (A i) (B i) U Θ (t i) (hA i) (hAB i) hU (hBU i)
        hΘ hΘtwo (ht i) (htten i) m
  have hzero (i : Fin 3) (b : Bool) : H i b 0 = 0 := by
    apply norm_eq_zero.mp
    apply le_antisymm ?_ (norm_nonneg _)
    simpa only [Nat.cast_zero, Real.log_zero, mul_zero] using hH i b 0
  let v : MonoidAlgebra ℂ ℕ := MonoidAlgebra.ofCoeff (H c e)
  let w : MonoidAlgebra ℂ ℕ := MonoidAlgebra.ofCoeff (H d f)
  change (∀ m : ℕ, ‖(v * w).coeff m‖ ≤
    1024 * (m.divisors.card : ℝ) ^ 19 * (Real.log (m : ℝ)) ^ 2) ∧
      (v * w).coeff 0 = 0
  have hvwzero : (v * w).coeff 0 = 0 := by
    simp only [MonoidAlgebra.coeff_mul, Finsupp.sum]
    apply Finset.sum_eq_zero
    intro a _
    apply Finset.sum_eq_zero
    intro b _
    split_ifs with hab
    · rcases Nat.mul_eq_zero.mp hab with ha | hb
      · subst a
        change H c e 0 * H d f b = 0
        rw [hzero, zero_mul]
      · subst b
        change H c e a * H d f 0 = 0
        rw [hzero, mul_zero]
    · rfl
  refine ⟨?_, hvwzero⟩
  intro m
  by_cases hm : m = 0
  · simp only [hm, hvwzero, norm_zero, Nat.cast_zero, Real.log_zero,
      zero_pow (by decide : 2 ≠ 0), mul_zero, le_refl]
  · have hfactor (i : Fin 3) (b : Bool) (a : ℕ) (ha : a ∈ m.divisors) :
        ‖H i b a‖ ≤ 32 * (m.divisors.card : ℝ) ^ 9 * Real.log (m : ℝ) := by
      have hτ : (a.divisors.card : ℝ) ≤ (m.divisors.card : ℝ) := by
        exact_mod_cast Finset.card_le_card
          (Nat.divisors_subset_of_dvd hm (Nat.dvd_of_mem_divisors ha))
      have hlog : Real.log (a : ℝ) ≤ Real.log (m : ℝ) :=
        Real.log_le_log (by exact_mod_cast Nat.pos_of_mem_divisors ha)
          (by exact_mod_cast Nat.divisor_le ha)
      exact (hH i b a).trans
        (mul_le_mul (mul_le_mul_of_nonneg_left
          (pow_le_pow_left₀ (Nat.cast_nonneg _) hτ 9) (by norm_num))
          hlog (Real.log_natCast_nonneg a) (by positivity))
    rw [MonoidAlgebra.coeff_mul_antidiag v w m m.divisorsAntidiagonal
      (by simp [Nat.mem_divisorsAntidiagonal, hm])]
    change ‖∑ z ∈ m.divisorsAntidiagonal, H c e z.1 * H d f z.2‖ ≤ _
    calc
      _ ≤ ∑ z ∈ m.divisorsAntidiagonal, ‖H c e z.1 * H d f z.2‖ :=
        norm_sum_le _ _
      _ ≤ ∑ _z ∈ m.divisorsAntidiagonal,
          1024 * (m.divisors.card : ℝ) ^ 18 * (Real.log (m : ℝ)) ^ 2 := by
        apply Finset.sum_le_sum
        intro z hz
        rw [norm_mul]
        have hlog : 0 ≤ Real.log (m : ℝ) := Real.log_natCast_nonneg m
        calc
          _ ≤ (32 * (m.divisors.card : ℝ) ^ 9 * Real.log (m : ℝ)) *
              (32 * (m.divisors.card : ℝ) ^ 9 * Real.log (m : ℝ)) :=
            mul_le_mul
              (hfactor c e z.1 (Nat.fst_mem_divisors_of_mem_antidiagonal hz))
              (hfactor d f z.2 (Nat.snd_mem_divisors_of_mem_antidiagonal hz))
              (norm_nonneg _) (by positivity)
          _ = _ := by ring
      _ = _ := by
        rw [Finset.sum_const, nsmul_eq_mul, ← Nat.map_div_right_divisors,
          Finset.card_map]
        ring

open Classical in
theorem sourceT4U1_eventually_compact_tuple_geometry :
    ∃ X : ℝ, 3 ≤ X ∧ ∀ x : ℝ, X ≤ x → ∀ p : Fin 4 → ℕ,
      (∀ i, (p i).Prime) →
      (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ →
      let α : Fin 4 → ℝ := fun i => Real.logb x (p i : ℝ)
      ((if sourceT4ExponentMask α then (1 : ℝ) else 0) -
        (if sourceU1ExponentMask α then 1 else 0)) ≠ 0 →
      (∀ i, p i ∈ (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((11 : ℝ) / 25)⌋₊).filter Nat.Prime) ∧
      ∃ S : Finset (Fin 4), S.Nonempty ∧ S ≠ Finset.univ ∧
        x ^ ((40481 : ℝ) / 100000) ≤ ((∏ i ∈ S, p i : ℕ) : ℝ) ∧
        ((∏ i ∈ S, p i : ℕ) : ℝ) ≤ x ^ ((59519 : ℝ) / 100000) := by
  obtain ⟨X₀, hX₀, hsource⟩ := sourceT4_sub_sourceU1_eventually_central_tuple_sum
  refine ⟨max X₀ (Real.exp (100 * Real.log 2)), hX₀.trans (le_max_left _ _), ?_⟩
  intro x hx p hp hprod α hw
  have hxX : X₀ ≤ x := (le_max_left _ _).trans hx
  have hx1 : 1 < x := (by norm_num : (1 : ℝ) < 3).trans_le (hX₀.trans hxX)
  have hx0 : 0 < x := zero_lt_one.trans hx1
  have hlogx : 0 < Real.log x := Real.log_pos hx1
  have hp0 (i : Fin 4) : 0 < (p i : ℝ) := Nat.cast_pos.mpr (hp i).pos
  have hpn : 0 < ∏ i, p i := Finset.prod_pos (fun i _ => (hp i).pos)
  have hpN : p ∈ Fintype.piFinset (fun _ : Fin 4 => Nat.primesLE (∏ i, p i)) := by
    apply Fintype.mem_piFinset.mpr
    intro i
    exact Nat.mem_primesLE.mpr ⟨Nat.le_of_dvd hpn
      (Finset.dvd_prod_of_mem p (Finset.mem_univ i)), hp i⟩
  have hnlo : x ≤ ((∏ i, p i : ℕ) : ℝ) :=
    Nat.le_of_ceil_le (Finset.mem_Icc.mp hprod).1
  have hnhi : ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x :=
    (Nat.cast_le.mpr (Finset.mem_Icc.mp hprod).2).trans (Nat.floor_le (by positivity))
  obtain ⟨hlow, S, hS, hSproper, hSlo, hShi⟩ :=
    (hsource x hxX (∏ i, p i) hnlo hnhi).2.2 p hpN rfl hw
  have hsum : (∑ i, α i) = Real.logb x ((∏ i, p i : ℕ) : ℝ) := by
    rw [Nat.cast_prod]
    exact (Real.logb_prod Finset.univ _ (fun i _ => (hp0 i).ne')).symm
  have hlogLarge : 100 * Real.log 2 ≤ Real.log x :=
    (Real.le_log_iff_exp_le hx0).mpr ((le_max_right _ _).trans hx)
  have hsmall : Real.logb x 2 ≤ (1 / 100 : ℝ) := by
    apply (div_le_iff₀ hlogx).mpr
    nlinarith only [hlogLarge]
  have htotal : (∑ i, α i) ≤ 1 + (1 / 100 : ℝ) := by
    rw [hsum]
    have h := Real.logb_le_logb_of_le hx1 (by exact_mod_cast hpn) hnhi
    rw [Real.logb_mul (by norm_num : (2 : ℝ) ≠ 0) hx0.ne',
      Real.logb_self_eq_one hx1] at h
    linarith only [h, hsmall]
  have hupper (i : Fin 4) : α i ≤ (11 : ℝ) / 25 := by
    have h0 := hlow 0
    have h1 := hlow 1
    have h2 := hlow 2
    have h3 := hlow 3
    change (9519 : ℝ) / 50000 ≤ α 0 at h0
    change (9519 : ℝ) / 50000 ≤ α 1 at h1
    change (9519 : ℝ) / 50000 ≤ α 2 at h2
    change (9519 : ℝ) / 50000 ≤ α 3 at h3
    rw [Fin.sum_univ_four] at htotal
    fin_cases i
    · change α 0 ≤ (11 : ℝ) / 25
      linarith
    · change α 1 ≤ (11 : ℝ) / 25
      linarith
    · change α 2 ≤ (11 : ℝ) / 25
      linarith
    · change α 3 ≤ (11 : ℝ) / 25
      linarith
  have hSpos : 0 < ((∏ i ∈ S, p i : ℕ) : ℝ) := by
    exact_mod_cast Finset.prod_pos (fun i _ => (hp i).pos)
  refine ⟨?_, S, hS, hSproper, ?_, ?_⟩
  · intro i
    apply Finset.mem_filter.mpr
    refine ⟨Finset.mem_Icc.mpr ⟨?_, ?_⟩, hp i⟩
    · apply Nat.ceil_le.mpr
      exact (Real.le_logb_iff_rpow_le hx1 (hp0 i)).mp (hlow i)
    · apply Nat.le_floor
      exact (Real.logb_le_iff_le_rpow hx1 (hp0 i)).mp (hupper i)
  · have hlogprod : Real.logb x ((∏ i ∈ S, p i : ℕ) : ℝ) = ∑ i ∈ S, α i := by
      rw [Nat.cast_prod]
      exact Real.logb_prod S _ (fun i _ => (hp0 i).ne')
    apply (Real.le_logb_iff_rpow_le hx1 hSpos).mp
    rw [hlogprod]
    exact hSlo
  · have hlogprod : Real.logb x ((∏ i ∈ S, p i : ℕ) : ℝ) = ∑ i ∈ S, α i := by
      rw [Nat.cast_prod]
      exact Real.logb_prod S _ (fun i _ => (hp0 i).ne')
    apply (Real.logb_le_iff_le_rpow hx1 hSpos).mp
    rw [hlogprod]
    exact hShi

open Classical in
theorem sourceT4_sub_sourceU1_eventually_four_prime_finsupp :
    ∃ X : ℝ, 3 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      let P := (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((11 : ℝ) / 25)⌋₊).filter Nat.Prime
      let T := Fintype.piFinset (fun _ : Fin 4 => P)
      let α : (Fin 4 → ℕ) → Fin 4 → ℝ := fun p i => Real.logb x (p i : ℝ)
      let w : (Fin 4 → ℕ) → ℝ := fun p =>
        (if sourceT4ExponentMask (α p) then 1 else 0) -
          (if sourceU1ExponentMask (α p) then 1 else 0)
      (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        Finsupp.single n ((sourceT4 x n - sourceU1 x n : ℝ) : ℂ)) =
      ∑ p ∈ T, Finsupp.single (∏ i, p i)
        (if (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ then (w p : ℂ) else 0) := by
  obtain ⟨X₁, hX₁, hsource⟩ := sourceT4_sub_sourceU1_eventually_central_tuple_sum
  obtain ⟨X₂, _hX₂, hcompact⟩ := sourceT4U1_eventually_compact_tuple_geometry
  refine ⟨max X₁ X₂, hX₁.trans (le_max_left _ _), ?_⟩
  intro x hx P T α w
  have hx₁ : X₁ ≤ x := (le_max_left _ _).trans hx
  have hx₂ : X₂ ≤ x := (le_max_right _ _).trans hx
  have hx0 : 0 < x := (by norm_num : (0 : ℝ) < 3).trans_le (hX₁.trans hx₁)
  let N := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
  have hprime (p : Fin 4 → ℕ) (hp : p ∈ T) (i : Fin 4) : (p i).Prime :=
    (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).2
  ext n
  simp only [Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_ite_eq']
  by_cases hn : n ∈ N
  · have hnlo : x ≤ (n : ℝ) := Nat.le_of_ceil_le (Finset.mem_Icc.mp hn).1
    have hnhi : (n : ℝ) ≤ 2 * x :=
      (Nat.cast_le.mpr (Finset.mem_Icc.mp hn).2).trans (Nat.floor_le (by positivity))
    have hs := (hsource x hx₁ n hnlo hnhi).1
    have hcast : ((sourceT4 x n - sourceU1 x n : ℝ) : ℂ) =
        ∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => Nat.primesLE n),
          if (∏ i, p i) = n then (w p : ℂ) else 0 := by
      rw [hs, Complex.ofReal_sum]
      apply Finset.sum_congr rfl
      intro p _hp
      by_cases hpn : (∏ i, p i) = n
      · simp only [ite_eq_left hpn]
        rfl
      · simp only [ite_eq_right hpn, Complex.ofReal_zero]
    rw [ite_eq_left hn, hcast]
    have heq :
        (∑ p ∈ Fintype.piFinset (fun _ : Fin 4 => Nat.primesLE n),
          if (∏ i, p i) = n then (w p : ℂ) else 0) =
        ∑ p ∈ T, if (∏ i, p i) = n then (w p : ℂ) else 0 := by
      apply Finset.sum_congr_of_eq_on_inter
      · intro p hp hpT
        by_cases hpn : (∏ i, p i) = n
        · by_cases hw : w p = 0
          · simp only [ite_eq_left hpn, hw, Complex.ofReal_zero]
          · exfalso
            apply hpT
            apply Fintype.mem_piFinset.mpr
            exact (hcompact x hx₂ p
              (fun i => Nat.prime_of_mem_primesLE (Fintype.mem_piFinset.mp hp i))
              (by simpa only [hpn] using hn) hw).1
        · exact ite_eq_right hpn
      · intro p hp hpN
        by_cases hpn : (∏ i, p i) = n
        · exfalso
          apply hpN
          apply Fintype.mem_piFinset.mpr
          intro i
          apply Nat.mem_primesLE.mpr
          refine ⟨Nat.le_of_dvd (by
            rw [← hpn]
            exact Finset.prod_pos (fun i _ => (hprime p hp i).pos)) ?_, hprime p hp i⟩
          rw [← hpn]
          exact Finset.dvd_prod_of_mem p (Finset.mem_univ i)
        · exact ite_eq_right hpn
      · intro _ _ _
        rfl
    rw [heq]
    apply Finset.sum_congr rfl
    intro p _hp
    by_cases hpn : (∏ i, p i) = n
    · have hm : (∏ i, p i) ∈ N := by simpa only [hpn] using hn
      dsimp only [N] at hm
      simp only [ite_eq_left hpn, ite_eq_left hm]
    · simp only [ite_eq_right hpn]
  · rw [ite_eq_right hn]
    symm
    apply Finset.sum_eq_zero
    intro p _hp
    by_cases hpn : (∏ i, p i) = n
    · have hm : (∏ i, p i) ∉ N := by simpa only [hpn] using hn
      dsimp only [N] at hm
      simp only [ite_eq_left hpn, ite_eq_right hm]
    · simp only [ite_eq_right hpn]

open Classical in
/--
The combined collection of multiplicative boundary cuts needed for the `T4` and `U1` regions,
including the total-product window `[x, 2 * x]`. The collection supplies their boundaries rather
than defining either region by a single conjunction.
-/
noncomputable def sourceT4U1MonomialCuts (x : ℝ) : Finset MinorantFourMonomialCut :=
  {⟨Finset.univ, ∅, x, true, false⟩,
    ⟨Finset.univ, ∅, 2 * x, false, false⟩,
    ⟨{2}, ∅, x ^ ((9519 : ℝ) / 50000), true, false⟩,
    ⟨{2}, {1}, 1, false, true⟩,
    ⟨{1}, {0}, 1, false, true⟩,
    ⟨{0}, ∅, x ^ ((40481 : ℝ) / 100000), false, true⟩} ∪
  {⟨{0, 1}, ∅, x ^ ((59519 : ℝ) / 100000), true, true⟩,
    ⟨{1}, ∅, x ^ (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000), false, true⟩,
    ⟨{2}, {3}, 1, false, false⟩,
    ⟨{1}, ∅, x ^ ((40481 : ℝ) / 100000), false, true⟩,
    ⟨{2, 3}, ∅, x ^ ((40481 : ℝ) / 100000), false, true⟩}

theorem sourceT4U1MonomialCuts_card_le (x : ℝ) :
    (sourceT4U1MonomialCuts x).card ≤ 32 := by
  classical
  unfold sourceT4U1MonomialCuts
  exact (Finset.card_union_le _ _).trans
    ((Nat.add_le_add Finset.card_le_six Finset.card_le_five).trans (by decide))

theorem sourceT4U1MonomialCuts_data (x : ℝ) (hx : 0 < x)
    (d : MinorantFourMonomialCut) (hd : d ∈ sourceT4U1MonomialCuts x) :
    d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
      d.numerator.card + d.denominator.card ≤ 4 ∧ 0 < d.threshold := by
  classical
  simp only [sourceT4U1MonomialCuts, Finset.mem_union,
    Finset.mem_insert, Finset.mem_singleton] at hd
  rcases hd with (rfl | rfl | rfl | rfl | rfl | rfl) |
    (rfl | rfl | rfl | rfl | rfl) <;>
      norm_num [Finset.card_fin, Finset.disjoint_left] <;>
        first | positivity | decide | exact ⟨Finset.card_le_univ _, by positivity⟩

open Classical in
theorem sourceT4U1MonomialCuts_boolean (x : ℝ) (hx : 1 < x)
    (p q : Fin 4 → ℕ) (hp : ∀ i, 0 < p i) (hq : ∀ i, 0 < q i)
    (htests : ∀ d ∈ sourceT4U1MonomialCuts x,
      (if d.lower then
        if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
      else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
      (if d.lower then
        if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
      else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) :
    (((∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧
        sourceT4ExponentMask (fun i => Real.logb x (p i : ℝ)) = true ∧
        sourceU1ExponentMask (fun i => Real.logb x (p i : ℝ)) = false) ↔
      ((∏ i, q i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧
        sourceT4ExponentMask (fun i => Real.logb x (q i : ℝ)) = true ∧
        sourceU1ExponentMask (fun i => Real.logb x (q i : ℝ)) = false)) ∧
    (((∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧
        sourceU1ExponentMask (fun i => Real.logb x (p i : ℝ)) = true ∧
        sourceT4ExponentMask (fun i => Real.logb x (p i : ℝ)) = false) ↔
      ((∏ i, q i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧
        sourceU1ExponentMask (fun i => Real.logb x (q i : ℝ)) = true ∧
        sourceT4ExponentMask (fun i => Real.logb x (q i : ℝ)) = false)) := by
  have hmask (r : Fin 4 → ℕ) (hr : ∀ i, 0 < r i) :
      (sourceT4ExponentMask (fun i => Real.logb x (r i : ℝ)) = true ↔
        x ^ ((9519 : ℝ) / 50000) ≤ (r 2 : ℝ) ∧
          (r 2 : ℝ) / r 1 < 1 ∧ (r 1 : ℝ) / r 0 < 1 ∧
          (r 0 : ℝ) < x ^ ((40481 : ℝ) / 100000) ∧
          x ^ ((59519 : ℝ) / 100000) < (r 0 : ℝ) * r 1 ∧
          (r 1 : ℝ) < x ^ (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000) ∧
          (r 2 : ℝ) / r 3 ≤ 1) ∧
      (sourceU1ExponentMask (fun i => Real.logb x (r i : ℝ)) = true ↔
        x ^ ((9519 : ℝ) / 50000) ≤ (r 2 : ℝ) ∧
          (r 2 : ℝ) / r 1 < 1 ∧ (r 1 : ℝ) < x ^ ((40481 : ℝ) / 100000) ∧
          (r 2 : ℝ) * r 3 < x ^ ((40481 : ℝ) / 100000) ∧
          (r 1 : ℝ) < x ^ (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000) ∧
          (r 2 : ℝ) / r 3 ≤ 1) := by
    have hpos (i : Fin 4) : 0 < (r i : ℝ) := by exact_mod_cast hr i
    have horder (i k : Fin 4) :
        (Real.logb x (r i : ℝ) < Real.logb x (r k : ℝ) ↔ (r i : ℝ) / r k < 1) ∧
        (Real.logb x (r i : ℝ) ≤ Real.logb x (r k : ℝ) ↔ (r i : ℝ) / r k ≤ 1) := by
      rw [Real.logb_lt_logb_iff hx (hpos i) (hpos k),
        Real.logb_le_logb hx (hpos i) (hpos k),
        div_lt_one (hpos k), div_le_one (hpos k)]
      exact ⟨Iff.rfl, Iff.rfl⟩
    have hlow (i : Fin 4) (t : ℝ) :
        t ≤ Real.logb x (r i : ℝ) ↔ x ^ t ≤ (r i : ℝ) :=
      Real.le_logb_iff_rpow_le hx (hpos i)
    have hlt (i : Fin 4) (t : ℝ) :
        Real.logb x (r i : ℝ) < t ↔ (r i : ℝ) < x ^ t :=
      Real.logb_lt_iff_lt_rpow hx (hpos i)
    have hpairlt (i k : Fin 4) (t : ℝ) :
        Real.logb x (r i : ℝ) + Real.logb x (r k : ℝ) < t ↔
          (r i : ℝ) * r k < x ^ t := by
      rw [← Real.logb_mul (hpos i).ne' (hpos k).ne',
        Real.logb_lt_iff_lt_rpow hx (mul_pos (hpos i) (hpos k))]
    have hpairgt (i k : Fin 4) (t : ℝ) :
        t < Real.logb x (r i : ℝ) + Real.logb x (r k : ℝ) ↔
          x ^ t < (r i : ℝ) * r k := by
      rw [← Real.logb_mul (hpos i).ne' (hpos k).ne',
        Real.lt_logb_iff_rpow_lt hx (mul_pos (hpos i) (hpos k))]
    constructor
    · simp only [sourceT4ExponentMask, decide_eq_true_eq]
      rw [(horder 2 1).1, (horder 1 0).1, (horder 2 3).2]
      simp only [hlow, hlt, hpairgt]
    · simp only [sourceU1ExponentMask, decide_eq_true_eq]
      rw [(horder 2 1).1, (horder 2 3).2]
      simp only [hlow, hlt, hpairlt]
  have hcarrier (r : Fin 4 → ℕ) :
      (∏ i, r i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ↔
        x ≤ ∏ i, (r i : ℝ) ∧ (∏ i, (r i : ℝ)) ≤ 2 * x := by
    rw [Finset.mem_Icc, Nat.ceil_le, Nat.le_floor_iff (by positivity)]
    push_cast
    rfl
  simp only [sourceT4U1MonomialCuts, Finset.forall_mem_union,
    Finset.forall_mem_insert, Finset.mem_singleton, forall_eq] at htests
  obtain ⟨⟨hlo, hhi, hxi, h21, h10, h0a⟩, h01, h1z, h23, h1a, h23a⟩ := htests
  simp only [MinorantFourMonomialCut.value, Bool.false_eq_true, ite_true, ite_false,
    Finset.prod_empty, Finset.prod_singleton, div_one,
    Finset.prod_pair (by decide : (0 : Fin 4) ≠ 1),
    Finset.prod_pair (by decide : (2 : Fin 4) ≠ 3)] at hlo hhi hxi h21 h10 h0a h01 h1z h23 h1a h23a
  have hc : ((∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊) ↔
      ((∏ i, q i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊) := by
    rw [hcarrier p, hcarrier q]
    exact and_congr hlo hhi
  have hT : sourceT4ExponentMask (fun i => Real.logb x (p i : ℝ)) =
      sourceT4ExponentMask (fun i => Real.logb x (q i : ℝ)) := by
    apply Bool.eq_iff_iff.mpr
    rw [(hmask p hp).1, (hmask q hq).1]
    exact and_congr hxi (and_congr h21 (and_congr h10
      (and_congr h0a (and_congr h01 (and_congr h1z h23)))))
  have hU : sourceU1ExponentMask (fun i => Real.logb x (p i : ℝ)) =
      sourceU1ExponentMask (fun i => Real.logb x (q i : ℝ)) := by
    apply Bool.eq_iff_iff.mpr
    rw [(hmask p hp).2, (hmask q hq).2]
    exact and_congr hxi (and_congr h21 (and_congr h1a
      (and_congr h23a (and_congr h1z h23))))
  constructor <;> rw [hT, hU] <;> exact and_congr hc Iff.rfl

open Classical in
theorem sourceT4U1_tuple_discrepancy_split
    (x : ℝ) (T : Finset (Fin 4 → ℕ)) (N : Finset ℕ) (q a : ℕ) :
    fullDiscrepancy (∑ p ∈ T, Finsupp.single (∏ i, p i)
      (if (∏ i, p i) ∈ N then
        (((if sourceT4ExponentMask (fun i => Real.logb x (p i : ℝ)) then (1 : ℝ) else 0) -
          (if sourceU1ExponentMask (fun i => Real.logb x (p i : ℝ)) then 1 else 0) : ℝ) : ℂ)
      else 0)) q a =
    fullDiscrepancy (∑ p ∈ T, Finsupp.single (∏ i, p i)
      (@ite ℂ ((∏ i, p i) ∈ N ∧
        sourceT4ExponentMask (fun i => Real.logb x (p i : ℝ)) = true ∧
        sourceU1ExponentMask (fun i => Real.logb x (p i : ℝ)) = false)
        (Classical.propDecidable _) 1 0)) q a -
    fullDiscrepancy (∑ p ∈ T, Finsupp.single (∏ i, p i)
      (@ite ℂ ((∏ i, p i) ∈ N ∧
        sourceU1ExponentMask (fun i => Real.logb x (p i : ℝ)) = true ∧
        sourceT4ExponentMask (fun i => Real.logb x (p i : ℝ)) = false)
        (Classical.propDecidable _) 1 0)) q a := by
  simp only [fullDiscrepancy_indexed_sample, ← Finset.sum_sub_distrib]
  apply Finset.sum_congr rfl
  intro p _hp
  by_cases hn : (∏ i, p i) ∈ N
  · simp only [hn, ite_true, true_and]
    cases sourceT4ExponentMask (fun i => Real.logb x (p i : ℝ)) <;>
      cases sourceU1ExponentMask (fun i => Real.logb x (p i : ℝ)) <;> norm_num
  · simp [hn]

section

variable {arity : ℕ}
open Classical in
theorem finite_small_prime_box_cut_decomposition
    (P : Finset ℕ) (bin : ℕ → ℕ) (C : (Fin (arity + 1) → ℕ) → Prop) :
    let T := Fintype.piFinset (fun _ : Fin (arity + 1) => P)
    let label (p : Fin (arity + 1) → ℕ) : Fin (arity + 1) → ℕ := fun i => bin (p i)
    let B := T.image label
    let U (b : Fin (arity + 1) → ℕ) := T.filter (fun p => label p = b)
    let I := B.filter (fun b => ∀ p ∈ U b, C p)
    let D := B.filter (fun b => (∃ p ∈ U b, C p) ∧ ¬∀ p ∈ U b, C p)
    (∀ b, U b = Fintype.piFinset (fun i : Fin (arity + 1) =>
      P.filter (fun p => bin p = b i))) ∧
    (∀ b ∈ B, (U b).Nonempty) ∧
    (∀ K : ℕ, (∀ p ∈ P, bin p < K) → B.card ≤ K ^ (arity + 1)) ∧
    (∀ b ∈ D, (∃ p ∈ U b, C p) ∧ ∃ p ∈ U b, ¬C p) ∧
    (∀ w : ℕ → ℂ,
      (∑ p ∈ T, if C p then w (∏ i, p i) else 0) =
        (∑ b ∈ I, ∑ p ∈ U b, w (∏ i, p i)) +
          ∑ b ∈ D, ∑ p ∈ U b, if C p then w (∏ i, p i) else 0) ∧
    (∀ n : ℕ,
      0 ≤ (∑ b ∈ D, ∑ p ∈ U b,
        if (∏ i, p i) = n ∧ C p then (1 : ℝ) else 0) ∧
      (∑ b ∈ D, ∑ p ∈ U b,
        if (∏ i, p i) = n ∧ C p then (1 : ℝ) else 0) ≤
        ∑ b ∈ D, ∑ p ∈ U b,
          if (∏ i, p i) = n then (1 : ℝ) else 0) := by
  intro T label B U I D
  have hbox (b : Fin (arity + 1) → ℕ) :
      U b = Fintype.piFinset (fun i : Fin (arity + 1) => P.filter (fun p => bin p = b i)) := by
    ext p
    simp only [U, T, label, Finset.mem_filter, Fintype.mem_piFinset, funext_iff,
      forall_and]
  refine ⟨hbox, ?_, ?_, ?_, ?_, ?_⟩
  · intro b hb
    obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hb
    exact ⟨p, Finset.mem_filter.mpr ⟨hp, rfl⟩⟩
  · intro K hK
    have hsub : B ⊆ Fintype.piFinset (fun _ : Fin (arity + 1) => Finset.range K) := by
      intro b hb
      obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hb
      exact Fintype.mem_piFinset.mpr fun i =>
        Finset.mem_range.mpr (hK (p i) (Fintype.mem_piFinset.mp hp i))
    simpa only [Fintype.card_piFinset_const, Finset.card_range, Fintype.card_fin]
      using Finset.card_le_card hsub
  · intro b hb
    have h := (Finset.mem_filter.mp hb).2
    exact ⟨h.1, by simpa only [not_forall, exists_prop] using h.2⟩
  · intro w
    let F (b : Fin (arity + 1) → ℕ) : ℂ :=
      ∑ p ∈ U b, if C p then w (∏ i, p i) else 0
    let G (b : Fin (arity + 1) → ℕ) : ℂ := ∑ p ∈ U b, w (∏ i, p i)
    have hfiber :
        (∑ b ∈ B, F b) = ∑ p ∈ T, if C p then w (∏ i, p i) else 0 :=
      Finset.sum_fiberwise_of_maps_to
        (fun p hp => Finset.mem_image.mpr ⟨p, hp, rfl⟩)
        (fun p => if C p then w (∏ i, p i) else 0)
    have hsplit (b : Fin (arity + 1) → ℕ) :
        F b = (if ∀ p ∈ U b, C p then G b else 0) +
          if (∃ p ∈ U b, C p) ∧ ¬∀ p ∈ U b, C p then F b else 0 := by
      by_cases hg : ∀ p ∈ U b, C p
      · have hFG : F b = G b := by
          apply Finset.sum_congr rfl
          intro p hp
          exact ite_eq_left (hg p hp)
        rw [ite_eq_left hg, ite_eq_right (fun h => h.2 hg), add_zero]
        exact hFG
      · by_cases ha : ∃ p ∈ U b, C p
        · rw [ite_eq_right hg, ite_eq_left ⟨ha, hg⟩, zero_add]
        · have hzero : F b = 0 := by
            apply Finset.sum_eq_zero
            intro p hp
            exact ite_eq_right (fun hCp => ha ⟨p, hp, hCp⟩)
          rw [ite_eq_right hg, ite_eq_right (fun h => ha h.1), zero_add]
          exact hzero
    rw [← hfiber]
    calc
      (∑ b ∈ B, F b) = ∑ b ∈ B,
          ((if ∀ p ∈ U b, C p then G b else 0) +
            if (∃ p ∈ U b, C p) ∧ ¬∀ p ∈ U b, C p then F b else 0) :=
        Finset.sum_congr rfl (fun b _ => hsplit b)
      _ = _ := by
        rw [Finset.sum_add_distrib]
        simp only [I, D, Finset.sum_filter]
        rfl
  · intro n
    constructor
    · apply Finset.sum_nonneg
      intro b hb
      exact Finset.sum_nonneg fun p hp => by split_ifs <;> norm_num
    · apply Finset.sum_le_sum
      intro b hb
      apply Finset.sum_le_sum
      intro p hp
      by_cases hn : (∏ i, p i) = n <;> by_cases hc : C p <;> simp [hn, hc]

theorem small_prime_geometric_bin_eq_closed_interval
    (x h : ℝ) (hx : 0 < x) (hh : 0 < h) (k : ℕ) :
    let P : Finset ℕ :=
      (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((9 : ℝ) / 10)⌋₊).filter Nat.Prime
    let L : ℝ := max (x ^ ((9519 : ℝ) / 50000)) ((1 + h) ^ k)
    let U : ℝ := min (x ^ ((9 : ℝ) / 10))
      ((⌈(1 + h) ^ (k + 1)⌉₊ - 1 : ℕ) : ℝ)
    P.filter (fun n : ℕ => ⌊Real.logb (1 + h) (n : ℝ)⌋₊ = k) =
      (Finset.Icc ⌈L⌉₊ ⌊U⌋₊).filter Nat.Prime := by
  classical
  intro P L U
  have hpow : 0 ≤ x ^ ((9 : ℝ) / 10) := (Real.rpow_pos_of_pos hx _).le
  have hU : 0 ≤ U := le_min hpow (Nat.cast_nonneg _)
  ext n
  by_cases hp : n.Prime
  · simp only [P, Finset.mem_filter, Finset.mem_Icc, hp, and_true,
      geometric_bin_integer_interval h hh n k hp.one_lt.le,
      Nat.ceil_le, Nat.le_floor_iff hpow, Nat.le_floor_iff hU]
    dsimp [L, U]
    rw [max_le_iff, le_min_iff, Nat.cast_le]
    tauto
  · simp [P, hp]

theorem small_prime_geometric_active_scales (hArity : arity ≤ 3)
    (x h : ℝ) (hx : 2 ≤ x) (hh : 0 < h) (hh1 : h ≤ 1)
    (b p : Fin (arity + 1) → ℕ) :
    let P : Finset ℕ :=
      (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((9 : ℝ) / 10)⌋₊).filter Nat.Prime
    let L (i : Fin (arity + 1)) : ℝ := max (x ^ ((9519 : ℝ) / 50000)) ((1 + h) ^ b i)
    let U (i : Fin (arity + 1)) : ℝ := min (x ^ ((9 : ℝ) / 10))
      ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ)
    (∀ i, p i ∈ P) →
    (∀ i, ⌊Real.logb (1 + h) (p i : ℝ)⌋₊ = b i) →
    (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ →
    (∀ i, x ^ ((1 : ℝ) / 10) ≤ L i ∧ L i ≤ U i ∧ U i ≤ 2 * L i) ∧
      x / 32 ≤ ∏ i, L i ∧ (∏ i, L i) ≤ 2 * x := by
  classical
  intro P L U hp hlabel hprod
  have hx1 : 1 ≤ x := (by norm_num : (1 : ℝ) ≤ 2).trans hx
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hbase : 0 < 1 + h := by linarith
  have hL (i : Fin (arity + 1)) : 0 ≤ L i :=
    (Real.rpow_pos_of_pos hx0 _).le.trans (le_max_left _ _)
  have hpLU (i : Fin (arity + 1)) : L i ≤ (p i : ℝ) ∧ (p i : ℝ) ≤ U i := by
    have hm : p i ∈ P.filter (fun n : ℕ => ⌊Real.logb (1 + h) (n : ℝ)⌋₊ = b i) :=
      Finset.mem_filter.mpr ⟨hp i, hlabel i⟩
    rw [small_prime_geometric_bin_eq_closed_interval x h hx0 hh (b i)] at hm
    have hm' := Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1
    exact ⟨Nat.le_of_ceil_le hm'.1,
      (Nat.cast_le.mpr hm'.2).trans (Nat.floor_le (by positivity))⟩
  have hU (i : Fin (arity + 1)) : U i ≤ 2 * L i := by
    have hceil : 0 < ⌈(1 + h) ^ (b i + 1)⌉₊ :=
      Nat.ceil_pos.mpr (pow_pos hbase _)
    have htop : ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ) <
        (1 + h) ^ (b i + 1) := Nat.lt_ceil.mp (by omega)
    calc
      U i ≤ ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ) := min_le_right _ _
      _ ≤ (1 + h) ^ (b i + 1) := htop.le
      _ = (1 + h) * (1 + h) ^ b i := by rw [pow_succ]; ring
      _ ≤ 2 * L i := mul_le_mul (by linarith) (le_max_right _ _)
        (pow_nonneg hbase.le _) (by norm_num)
  have hproduct : x ≤ ∏ i, (p i : ℝ) ∧ (∏ i, (p i : ℝ)) ≤ 2 * x := by
    have hmem := Finset.mem_Icc.mp hprod
    constructor
    · exact_mod_cast Nat.le_of_ceil_le hmem.1
    · exact_mod_cast (Nat.cast_le.mpr hmem.2).trans (Nat.floor_le (by positivity))
  have hupper : (∏ i, L i) ≤ 2 * x :=
    (Finset.prod_le_prod (fun i _ => hL i) (fun i _ => (hpLU i).1)).trans hproduct.2
  have hcompare : (∏ i, (p i : ℝ)) ≤ 32 * ∏ i, L i := by
    calc
      _ ≤ ∏ i, 2 * L i := Finset.prod_le_prod (fun _ _ => Nat.cast_nonneg _)
        (fun i _ => (hpLU i).2.trans (hU i))
      _ = (2 : ℝ) ^ (arity + 1) * ∏ i, L i := by
        rw [Finset.prod_mul_distrib]
        simp
      _ ≤ 32 * ∏ i, L i := mul_le_mul_of_nonneg_right
        ((pow_le_pow_right₀ (by norm_num : (1 : ℝ) ≤ 2)
          (by omega : arity + 1 ≤ 5)).trans_eq (by norm_num))
        (Finset.prod_nonneg fun i _ => hL i)
  refine ⟨?_, ?_, hupper⟩
  · intro i
    exact ⟨(Real.rpow_le_rpow_of_exponent_le hx1 (by norm_num :
      (1 : ℝ) / 10 ≤ (9519 : ℝ) / 50000)).trans (le_max_left _ _),
      (hpLU i).1.trans (hpLU i).2, hU i⟩
  · linarith [hproduct.1, hcompare]

open Classical in
theorem small_prime_geometric_box_card_polylog (hArity : arity ≤ 3)
    (D x : ℝ) (hD : 0 ≤ D) (hx : Real.exp 1 ≤ x) :
    let h := (Real.log x) ^ (-D)
    let P : Finset ℕ :=
      (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((9 : ℝ) / 10)⌋₊).filter Nat.Prime
    let T := Fintype.piFinset (fun _ : Fin (arity + 1) => P)
    let label (p : Fin (arity + 1) → ℕ) : Fin (arity + 1) → ℕ :=
      fun i => ⌊Real.logb (1 + h) (p i : ℝ)⌋₊
    ((T.image label).card : ℝ) ≤
      (6 : ℝ) ^ 4 * (Real.log x) ^ (4 * (D + 1)) := by
  intro h P T label
  have hmesh := four_geometric_log_mesh_spec D x hD hx
  have hx1 : 1 ≤ x := (Real.one_le_exp (by norm_num : (0 : ℝ) ≤ 1)).trans hx
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  let K : ℕ := ⌈Real.logb (1 + h) (2 * x)⌉₊ + 1
  have hK (n : ℕ) (hn : n ∈ P) : ⌊Real.logb (1 + h) (n : ℝ)⌋₊ < K := by
    obtain ⟨hnI, hnprime⟩ := Finset.mem_filter.mp hn
    have hupper : (n : ℝ) ≤ 2 * x := by
      calc
        _ ≤ x ^ ((9 : ℝ) / 10) :=
          (Nat.cast_le.mpr (Finset.mem_Icc.mp hnI).2).trans
            (Nat.floor_le (Real.rpow_pos_of_pos hx0 _).le)
        _ ≤ x := Real.rpow_le_self_of_one_le hx1 (by norm_num)
        _ ≤ 2 * x := by linarith
    exact geometric_bin_label_bound h x hmesh.1 n hnprime.one_lt.le hupper
  have hcard : (T.image label).card ≤ K ^ (arity + 1) :=
    (finite_small_prime_box_cut_decomposition P
      (fun n : ℕ => ⌊Real.logb (1 + h) (n : ℝ)⌋₊) (fun _ => True)).2.2.1 K hK
  have hKone : (1 : ℝ) ≤ K := by dsimp only [K]; exact_mod_cast Nat.succ_le_succ (Nat.zero_le _)
  exact (show ((T.image label).card : ℝ) ≤ (K : ℝ) ^ (arity + 1)
    by exact_mod_cast hcard).trans
      ((pow_le_pow_right₀ hKone (by omega : arity + 1 ≤ 4)).trans hmesh.2.2)

end

section
open scoped ContDiff

open Classical in
theorem finite_five_prime_box_cut_decomposition
    (P : Finset ℕ) (bin : ℕ → ℕ) (C : (Fin 5 → ℕ) → Prop) :
    let T := Fintype.piFinset (fun _ : Fin 5 => P)
    let label (p : Fin 5 → ℕ) : Fin 5 → ℕ := fun i => bin (p i)
    let B := T.image label
    let U (b : Fin 5 → ℕ) := T.filter (fun p => label p = b)
    let I := B.filter (fun b => ∀ p ∈ U b, C p)
    let D := B.filter (fun b => (∃ p ∈ U b, C p) ∧ ¬∀ p ∈ U b, C p)
    (∀ b, U b = Fintype.piFinset (fun i : Fin 5 =>
      P.filter (fun p => bin p = b i))) ∧
    (∀ b ∈ B, (U b).Nonempty) ∧
    (∀ K : ℕ, (∀ p ∈ P, bin p < K) → B.card ≤ K ^ 5) ∧
    (∀ b ∈ D, (∃ p ∈ U b, C p) ∧ ∃ p ∈ U b, ¬C p) ∧
    (∀ w : ℕ → ℂ,
      (∑ p ∈ T, if C p then w (∏ i, p i) else 0) =
        (∑ b ∈ I, ∑ p ∈ U b, w (∏ i, p i)) +
          ∑ b ∈ D, ∑ p ∈ U b, if C p then w (∏ i, p i) else 0) ∧
    (∀ n : ℕ,
      0 ≤ (∑ b ∈ D, ∑ p ∈ U b,
        if (∏ i, p i) = n ∧ C p then (1 : ℝ) else 0) ∧
      (∑ b ∈ D, ∑ p ∈ U b,
        if (∏ i, p i) = n ∧ C p then (1 : ℝ) else 0) ≤
        ∑ b ∈ D, ∑ p ∈ U b,
          if (∏ i, p i) = n then (1 : ℝ) else 0) :=
  finite_small_prime_box_cut_decomposition (arity := 4) P bin C

open Classical in
theorem compact_prime_geometric_box_card_polylog
    (D x : ℝ) (hD : 0 ≤ D) (hx : Real.exp 1 ≤ x) :
    let h := (Real.log x) ^ (-D)
    let P : Finset ℕ :=
      (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((6 : ℝ) / 25)⌋₊).filter Nat.Prime
    let T := Fintype.piFinset (fun _ : Fin 5 => P)
    let label (p : Fin 5 → ℕ) : Fin 5 → ℕ :=
      fun i => ⌊Real.logb (1 + h) (p i : ℝ)⌋₊
    ((T.image label).card : ℝ) ≤
      (6 : ℝ) ^ 5 * (Real.log x) ^ (5 * (D + 1)) := by
  intro h P T label
  have hmesh := geometric_log_mesh_spec D x hD hx
  have hx1 : 1 ≤ x := (Real.one_le_exp (by norm_num : (0 : ℝ) ≤ 1)).trans hx
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  let K : ℕ := ⌈Real.logb (1 + h) (2 * x)⌉₊ + 1
  have hK (n : ℕ) (hn : n ∈ P) : ⌊Real.logb (1 + h) (n : ℝ)⌋₊ < K := by
    obtain ⟨hnI, hnprime⟩ := Finset.mem_filter.mp hn
    have hupper : (n : ℝ) ≤ 2 * x := by
      calc
        _ ≤ x ^ ((6 : ℝ) / 25) :=
          (Nat.cast_le.mpr (Finset.mem_Icc.mp hnI).2).trans
            (Nat.floor_le (Real.rpow_pos_of_pos hx0 _).le)
        _ ≤ x := Real.rpow_le_self_of_one_le hx1 (by norm_num)
        _ ≤ 2 * x := by linarith
    exact geometric_bin_label_bound h x hmesh.1 n hnprime.one_lt.le hupper
  have hcard : (T.image label).card ≤ K ^ 5 :=
    (finite_five_prime_box_cut_decomposition P
      (fun n : ℕ => ⌊Real.logb (1 + h) (n : ℝ)⌋₊) (fun _ => True)).2.2.1 K hK
  exact (show ((T.image label).card : ℝ) ≤ (K : ℝ) ^ 5 by exact_mod_cast hcard).trans
    hmesh.2.2

end

open Classical in
theorem finite_four_prime_box_cut_decomposition
    (P : Finset ℕ) (bin : ℕ → ℕ) (C : (Fin 4 → ℕ) → Prop) :
    let T := Fintype.piFinset (fun _ : Fin 4 => P)
    let label (p : Fin 4 → ℕ) : Fin 4 → ℕ := fun i => bin (p i)
    let B := T.image label
    let U (b : Fin 4 → ℕ) := T.filter (fun p => label p = b)
    let I := B.filter (fun b => ∀ p ∈ U b, C p)
    let D := B.filter (fun b => (∃ p ∈ U b, C p) ∧ ¬∀ p ∈ U b, C p)
    (∀ b, U b = Fintype.piFinset (fun i : Fin 4 =>
      P.filter (fun p => bin p = b i))) ∧
    (∀ b ∈ B, (U b).Nonempty) ∧
    (∀ K : ℕ, (∀ p ∈ P, bin p < K) → B.card ≤ K ^ 4) ∧
    (∀ b ∈ D, (∃ p ∈ U b, C p) ∧ ∃ p ∈ U b, ¬C p) ∧
    (∀ w : ℕ → ℂ,
      (∑ p ∈ T, if C p then w (∏ i, p i) else 0) =
        (∑ b ∈ I, ∑ p ∈ U b, w (∏ i, p i)) +
          ∑ b ∈ D, ∑ p ∈ U b, if C p then w (∏ i, p i) else 0) ∧
    (∀ n : ℕ,
      0 ≤ (∑ b ∈ D, ∑ p ∈ U b,
        if (∏ i, p i) = n ∧ C p then (1 : ℝ) else 0) ∧
      (∑ b ∈ D, ∑ p ∈ U b,
        if (∏ i, p i) = n ∧ C p then (1 : ℝ) else 0) ≤
        ∑ b ∈ D, ∑ p ∈ U b,
          if (∏ i, p i) = n then (1 : ℝ) else 0) :=
  finite_small_prime_box_cut_decomposition (arity := 3) P bin C

open Classical in
theorem four_prime_geometric_box_card_polylog
    (D x : ℝ) (hD : 0 ≤ D) (hx : Real.exp 1 ≤ x) :
    let h := (Real.log x) ^ (-D)
    let P : Finset ℕ :=
      (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((11 : ℝ) / 25)⌋₊).filter Nat.Prime
    let T := Fintype.piFinset (fun _ : Fin 4 => P)
    let label (p : Fin 4 → ℕ) : Fin 4 → ℕ :=
      fun i => ⌊Real.logb (1 + h) (p i : ℝ)⌋₊
    ((T.image label).card : ℝ) ≤
      (6 : ℝ) ^ 4 * (Real.log x) ^ (4 * (D + 1)) := by
  intro h P T label
  have hmesh := four_geometric_log_mesh_spec D x hD hx
  have hx1 : 1 ≤ x := (Real.one_le_exp (by norm_num : (0 : ℝ) ≤ 1)).trans hx
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  let K : ℕ := ⌈Real.logb (1 + h) (2 * x)⌉₊ + 1
  have hK (n : ℕ) (hn : n ∈ P) : ⌊Real.logb (1 + h) (n : ℝ)⌋₊ < K := by
    obtain ⟨hnI, hnprime⟩ := Finset.mem_filter.mp hn
    have hupper : (n : ℝ) ≤ 2 * x := by
      calc
        _ ≤ x ^ ((11 : ℝ) / 25) :=
          (Nat.cast_le.mpr (Finset.mem_Icc.mp hnI).2).trans
            (Nat.floor_le (Real.rpow_pos_of_pos hx0 _).le)
        _ ≤ x := Real.rpow_le_self_of_one_le hx1 (by norm_num)
        _ ≤ 2 * x := by linarith
    exact geometric_bin_label_bound h x hmesh.1 n hnprime.one_lt.le hupper
  have hcard : (T.image label).card ≤ K ^ 4 :=
    (finite_four_prime_box_cut_decomposition P
      (fun n : ℕ => ⌊Real.logb (1 + h) (n : ℝ)⌋₊) (fun _ => True)).2.2.1 K hK
  exact (show ((T.image label).card : ℝ) ≤ (K : ℝ) ^ 4 by exact_mod_cast hcard).trans
    hmesh.2.2

section

variable {arity : ℕ}

open Classical in
theorem finite_small_prime_box_discrepancy_cover
    (P : Finset ℕ) (bin : ℕ → ℕ) (C : (Fin (arity + 1) → ℕ) → Prop)
    (Q : Finset ℕ) (a : ℕ → ℕ) :
    let T := Fintype.piFinset (fun _ : Fin (arity + 1) => P)
    let label (p : Fin (arity + 1) → ℕ) : Fin (arity + 1) → ℕ := fun i => bin (p i)
    let B := T.image label
    let U (b : Fin (arity + 1) → ℕ) := T.filter (fun p => label p = b)
    let A := B.filter (fun b => ∃ p ∈ U b, C p)
    let D := A.filter (fun b => ¬∀ p ∈ U b, C p)
    let Fcut : ℕ →₀ ℂ :=
      ∑ p ∈ T, Finsupp.single (∏ i, p i) (if C p then 1 else 0)
    let Fbox (b : Fin (arity + 1) → ℕ) : ℕ →₀ ℂ :=
      ∑ p ∈ U b, Finsupp.single (∏ i, p i) 1
    (∑ q ∈ Q, ‖fullDiscrepancy Fcut q (a q)‖) ≤
      (∑ b ∈ A, ∑ q ∈ Q, ‖fullDiscrepancy (Fbox b) q (a q)‖) +
        2 * (∑ b ∈ D, ((U b).card : ℝ)) * ∑ q ∈ Q, 1 / (q.totient : ℝ) := by
  intro T label B U A D Fcut Fbox
  let I := B.filter (fun b => ∀ p ∈ U b, C p)
  let E (b : Fin (arity + 1) → ℕ) : ℕ →₀ ℂ :=
    ∑ p ∈ U b, Finsupp.single (∏ i, p i) (if C p then 1 else 0)
  obtain ⟨_, hnonempty, _, _, hsplit, _⟩ :=
    finite_small_prime_box_cut_decomposition P bin C
  have hsplit' (w : ℕ → ℂ) :
      (∑ p ∈ T, if C p then w (∏ i, p i) else 0) =
        (∑ b ∈ I, ∑ p ∈ U b, w (∏ i, p i)) +
          ∑ b ∈ D, ∑ p ∈ U b, if C p then w (∏ i, p i) else 0 := by
    simpa only [D, A, Finset.filter_filter] using hsplit w
  have hIA : I ⊆ A := by
    intro b hb
    obtain ⟨hbB, hbC⟩ := Finset.mem_filter.mp hb
    obtain ⟨p, hp⟩ := hnonempty b hbB
    exact Finset.mem_filter.mpr ⟨hbB, p, hp, hbC p hp⟩
  have hdisjoint : Disjoint I D := by
    apply Finset.disjoint_left.mpr
    intro b hbI hbD
    exact (Finset.mem_filter.mp hbD).2 (Finset.mem_filter.mp hbI).2
  have hunion : I ∪ D = A := by
    apply Finset.Subset.antisymm
    · exact Finset.union_subset hIA (Finset.filter_subset _ _)
    · intro b hbA
      by_cases hall : ∀ p ∈ U b, C p
      · exact Finset.mem_union.mpr (Or.inl
          (Finset.mem_filter.mpr ⟨(Finset.mem_filter.mp hbA).1, hall⟩))
      · exact Finset.mem_union.mpr (Or.inr (Finset.mem_filter.mpr ⟨hbA, hall⟩))
  have hpush (V : Finset (Fin (arity + 1) → ℕ)) (f : (Fin (arity + 1) → ℕ) → ℂ) :
      (∑ p ∈ V, Finsupp.single (∏ i, p i) (f p)) =
        ∑ n ∈ V.image (fun p => ∏ i, p i),
          Finsupp.single n (∑ p ∈ V, if (∏ i, p i) = n then f p else 0) := by
    ext n
    simp only [Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_ite_eq']
    by_cases hn : n ∈ V.image (fun p => ∏ i, p i)
    · rw [ite_eq_left hn]
    · rw [ite_eq_right hn]
      apply Finset.sum_eq_zero
      intro p hp
      exact ite_eq_right (fun heq => hn (Finset.mem_image.mpr ⟨p, hp, heq⟩))
  have hboundary (b : Fin (arity + 1) → ℕ) (q r : ℕ) :
      ‖fullDiscrepancy (E b) q r‖ ≤
        ‖fullDiscrepancy (Fbox b) q r‖ + 2 * ((U b).card : ℝ) / (q.totient : ℝ) := by
    let V := (U b).image (fun p => ∏ i, p i)
    let e : ℕ → ℂ := fun n =>
      ∑ p ∈ U b, if (∏ i, p i) = n then (if C p then 1 else 0) else 0
    let g : ℕ → ℝ := fun n =>
      ∑ p ∈ U b, if (∏ i, p i) = n then 1 else 0
    have hE : E b = ∑ n ∈ V, Finsupp.single n (e n) :=
      hpush (U b) (fun p => if C p then 1 else 0)
    have hcast (n : ℕ) : (g n : ℂ) =
        ∑ p ∈ U b, if (∏ i, p i) = n then (1 : ℂ) else 0 := by
      simp only [g, Complex.ofReal_sum, apply_ite Complex.ofReal,
        Complex.ofReal_one, Complex.ofReal_zero]
    have hFbox : Fbox b = ∑ n ∈ V, Finsupp.single n (g n : ℂ) := by
      change (∑ p ∈ U b, Finsupp.single (∏ i, p i) (1 : ℂ)) = _
      rw [hpush]
      apply Finset.sum_congr rfl
      intro n _hn
      rw [hcast]
    have hg : ∀ n ∈ V, 0 ≤ g n := by
      intro n _hn
      exact Finset.sum_nonneg fun p _ => by split_ifs <;> norm_num
    have heg : ∀ n ∈ V, ‖e n‖ ≤ g n := by
      intro n _hn
      apply (norm_sum_le _ _).trans
      apply Finset.sum_le_sum
      intro p _hp
      by_cases hp : (∏ i, p i) = n <;> by_cases hc : C p <;> simp [hp, hc]
    have hmass : (∑ n ∈ V, g n) = ((U b).card : ℝ) := by
      dsimp only [g]
      rw [Finset.sum_comm]
      calc
        _ = ∑ _p ∈ U b, (1 : ℝ) := by
          apply Finset.sum_congr rfl
          intro p hp
          exact Finset.sum_ite_eq_of_mem V (∏ i, p i) (fun _ => (1 : ℝ))
            (Finset.mem_image_of_mem _ hp)
        _ = _ := by simp
    have hbound := fullDiscrepancy_sample_le_positive_majorant V e g hg heg q r
    rw [← hE, ← hFbox, hmass] at hbound
    exact hbound
  have hdelta (q : ℕ) :
      fullDiscrepancy Fcut q (a q) =
        (∑ b ∈ I, fullDiscrepancy (Fbox b) q (a q)) +
          ∑ b ∈ D, fullDiscrepancy (E b) q (a q) := by
    let w : ℕ → ℂ := fun n =>
      (if n % q = a q % q then 1 else 0) -
        (if Nat.Coprime n q then 1 else 0) / (q.totient : ℂ)
    simpa only [Fcut, Fbox, E, fullDiscrepancy_indexed_sample, ite_mul, one_mul, zero_mul]
      using hsplit' w
  have hpoint (q : ℕ) :
      ‖fullDiscrepancy Fcut q (a q)‖ ≤
        (∑ b ∈ A, ‖fullDiscrepancy (Fbox b) q (a q)‖) +
          2 * (∑ b ∈ D, ((U b).card : ℝ)) / (q.totient : ℝ) := by
    calc
      _ = ‖(∑ b ∈ I, fullDiscrepancy (Fbox b) q (a q)) +
          ∑ b ∈ D, fullDiscrepancy (E b) q (a q)‖ := by rw [hdelta]
      _ ≤ (∑ b ∈ I, ‖fullDiscrepancy (Fbox b) q (a q)‖) +
          ∑ b ∈ D, ‖fullDiscrepancy (E b) q (a q)‖ :=
        (norm_add_le _ _).trans (add_le_add (norm_sum_le _ _) (norm_sum_le _ _))
      _ ≤ (∑ b ∈ I, ‖fullDiscrepancy (Fbox b) q (a q)‖) +
          ∑ b ∈ D, (‖fullDiscrepancy (Fbox b) q (a q)‖ +
            2 * ((U b).card : ℝ) / (q.totient : ℝ)) :=
        add_le_add (le_refl _) (Finset.sum_le_sum fun b _hb => hboundary b q (a q))
      _ = _ := by
        rw [Finset.sum_add_distrib, ← add_assoc, ← Finset.sum_union hdisjoint, hunion]
        congr 1
        rw [← Finset.sum_div, ← Finset.mul_sum]
  calc
    _ ≤ ∑ q ∈ Q,
        ((∑ b ∈ A, ‖fullDiscrepancy (Fbox b) q (a q)‖) +
          2 * (∑ b ∈ D, ((U b).card : ℝ)) / (q.totient : ℝ)) :=
      Finset.sum_le_sum fun q _hq => hpoint q
    _ = _ := by
      rw [Finset.sum_add_distrib, Finset.sum_comm]
      congr 1
      simp only [div_eq_mul_inv, one_mul, Finset.mul_sum]

open Classical in
theorem finite_small_prime_box_relative_discrepancy_cover
    (P : Finset ℕ) (bin : ℕ → ℕ) (C : (Fin (arity + 1) → ℕ) → Prop)
    (R : ℕ → Prop)
    (hCR : ∀ p ∈ Fintype.piFinset (fun _ : Fin (arity + 1) => P),
      C p → R (∏ i, p i))
    (Q : Finset ℕ) (a : ℕ → ℕ) :
    let T := Fintype.piFinset (fun _ : Fin (arity + 1) => P)
    let label (p : Fin (arity + 1) → ℕ) : Fin (arity + 1) → ℕ := fun i => bin (p i)
    let B := T.image label
    let U (b : Fin (arity + 1) → ℕ) := T.filter (fun p => label p = b)
    let A := B.filter (fun b => ∃ p ∈ U b, C p)
    let D := A.filter (fun b => ¬∀ p ∈ U b, C p)
    let Fcut : ℕ →₀ ℂ :=
      ∑ p ∈ T, Finsupp.single (∏ i, p i) (if C p then 1 else 0)
    let Fbox (b : Fin (arity + 1) → ℕ) : ℕ →₀ ℂ :=
      ∑ p ∈ U b, Finsupp.single (∏ i, p i) (if R (∏ i, p i) then 1 else 0)
    (∑ q ∈ Q, ‖fullDiscrepancy Fcut q (a q)‖) ≤
      (∑ b ∈ A, ∑ q ∈ Q, ‖fullDiscrepancy (Fbox b) q (a q)‖) +
        2 * (∑ b ∈ D, ((U b).card : ℝ)) * ∑ q ∈ Q, 1 / (q.totient : ℝ) := by
  intro T label B U A D Fcut Fbox
  let I := B.filter (fun b => ∀ p ∈ U b, C p)
  let E (b : Fin (arity + 1) → ℕ) : ℕ →₀ ℂ :=
    ∑ p ∈ U b, Finsupp.single (∏ i, p i) (if C p then 1 else 0)
  obtain ⟨_, hnonempty, _, _, hsplit, _⟩ :=
    finite_small_prime_box_cut_decomposition P bin C
  have hsplit' (w : ℕ → ℂ) :
      (∑ p ∈ T, if C p then w (∏ i, p i) else 0) =
        (∑ b ∈ I, ∑ p ∈ U b, if R (∏ i, p i) then w (∏ i, p i) else 0) +
          ∑ b ∈ D, ∑ p ∈ U b, if C p then w (∏ i, p i) else 0 := by
    have hold :
        (∑ p ∈ T, if C p then w (∏ i, p i) else 0) =
          (∑ b ∈ I, ∑ p ∈ U b, w (∏ i, p i)) +
            ∑ b ∈ D, ∑ p ∈ U b, if C p then w (∏ i, p i) else 0 := by
      simpa only [D, A, Finset.filter_filter] using hsplit w
    rw [hold]
    congr 1
    apply Finset.sum_congr rfl
    intro b hb
    apply Finset.sum_congr rfl
    intro p hp
    exact (ite_eq_left (hCR p (Finset.mem_filter.mp hp).1
      ((Finset.mem_filter.mp hb).2 p hp))).symm
  have hIA : I ⊆ A := by
    intro b hb
    obtain ⟨hbB, hbC⟩ := Finset.mem_filter.mp hb
    obtain ⟨p, hp⟩ := hnonempty b hbB
    exact Finset.mem_filter.mpr ⟨hbB, p, hp, hbC p hp⟩
  have hdisjoint : Disjoint I D := by
    apply Finset.disjoint_left.mpr
    intro b hbI hbD
    exact (Finset.mem_filter.mp hbD).2 (Finset.mem_filter.mp hbI).2
  have hunion : I ∪ D = A := by
    apply Finset.Subset.antisymm
    · exact Finset.union_subset hIA (Finset.filter_subset _ _)
    · intro b hbA
      by_cases hall : ∀ p ∈ U b, C p
      · exact Finset.mem_union.mpr (Or.inl
          (Finset.mem_filter.mpr ⟨(Finset.mem_filter.mp hbA).1, hall⟩))
      · exact Finset.mem_union.mpr (Or.inr (Finset.mem_filter.mpr ⟨hbA, hall⟩))
  have hpush (V : Finset (Fin (arity + 1) → ℕ)) (f : (Fin (arity + 1) → ℕ) → ℂ) :
      (∑ p ∈ V, Finsupp.single (∏ i, p i) (f p)) =
        ∑ n ∈ V.image (fun p => ∏ i, p i),
          Finsupp.single n (∑ p ∈ V, if (∏ i, p i) = n then f p else 0) := by
    ext n
    simp only [Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_ite_eq']
    by_cases hn : n ∈ V.image (fun p => ∏ i, p i)
    · rw [ite_eq_left hn]
    · rw [ite_eq_right hn]
      apply Finset.sum_eq_zero
      intro p hp
      exact ite_eq_right (fun heq => hn (Finset.mem_image.mpr ⟨p, hp, heq⟩))
  have hboundary (b : Fin (arity + 1) → ℕ) (q r : ℕ) :
      ‖fullDiscrepancy (E b) q r‖ ≤
        ‖fullDiscrepancy (Fbox b) q r‖ + 2 * ((U b).card : ℝ) / (q.totient : ℝ) := by
    let V := (U b).image (fun p => ∏ i, p i)
    let e : ℕ → ℂ := fun n =>
      ∑ p ∈ U b, if (∏ i, p i) = n then (if C p then 1 else 0) else 0
    let g : ℕ → ℝ := fun n =>
      ∑ p ∈ U b, if (∏ i, p i) = n then
        (if R (∏ i, p i) then 1 else 0) else 0
    have hE : E b = ∑ n ∈ V, Finsupp.single n (e n) :=
      hpush (U b) (fun p => if C p then 1 else 0)
    have hcast (n : ℕ) : (g n : ℂ) =
        ∑ p ∈ U b, if (∏ i, p i) = n then
          (if R (∏ i, p i) then (1 : ℂ) else 0) else 0 := by
      simp only [g, Complex.ofReal_sum, apply_ite Complex.ofReal,
        Complex.ofReal_one, Complex.ofReal_zero]
    have hFbox : Fbox b = ∑ n ∈ V, Finsupp.single n (g n : ℂ) := by
      change (∑ p ∈ U b, Finsupp.single (∏ i, p i)
        (if R (∏ i, p i) then (1 : ℂ) else 0)) = _
      rw [hpush]
      apply Finset.sum_congr rfl
      intro n _hn
      rw [hcast]
    have hg : ∀ n ∈ V, 0 ≤ g n := by
      intro n _hn
      exact Finset.sum_nonneg fun p _ => by split_ifs <;> norm_num
    have heg : ∀ n ∈ V, ‖e n‖ ≤ g n := by
      intro n _hn
      apply (norm_sum_le _ _).trans
      apply Finset.sum_le_sum
      intro p hpU
      by_cases hp : (∏ i, p i) = n
      · by_cases hc : C p
        · have hr := hCR p (Finset.mem_filter.mp hpU).1 hc
          simp only [ite_eq_left hp, ite_eq_left hc, ite_eq_left hr, norm_one, le_refl]
        · simp only [ite_eq_left hp, ite_eq_right hc, norm_zero]
          split_ifs <;> norm_num
      · simp only [ite_eq_right hp, norm_zero, le_refl]
    have hmass : (∑ n ∈ V, g n) ≤ ((U b).card : ℝ) := by
      dsimp only [g]
      calc
        _ ≤ ∑ n ∈ V, ∑ p ∈ U b, if (∏ i, p i) = n then (1 : ℝ) else 0 := by
          apply Finset.sum_le_sum
          intro n hn
          apply Finset.sum_le_sum
          intro p hp
          split_ifs <;> norm_num
        _ = ((U b).card : ℝ) := by
          rw [Finset.sum_comm]
          calc
            _ = ∑ _p ∈ U b, (1 : ℝ) := by
              apply Finset.sum_congr rfl
              intro p hp
              exact Finset.sum_ite_eq_of_mem V (∏ i, p i) (fun _ => (1 : ℝ))
                (Finset.mem_image_of_mem _ hp)
            _ = _ := by simp
    have hbound := fullDiscrepancy_sample_le_positive_majorant V e g hg heg q r
    rw [← hE, ← hFbox] at hbound
    exact hbound.trans (add_le_add le_rfl
      (div_le_div_of_nonneg_right
        (mul_le_mul_of_nonneg_left hmass zero_le_two) (Nat.cast_nonneg _)))
  have hdelta (q : ℕ) :
      fullDiscrepancy Fcut q (a q) =
        (∑ b ∈ I, fullDiscrepancy (Fbox b) q (a q)) +
          ∑ b ∈ D, fullDiscrepancy (E b) q (a q) := by
    let w : ℕ → ℂ := fun n =>
      (if n % q = a q % q then 1 else 0) -
        (if Nat.Coprime n q then 1 else 0) / (q.totient : ℂ)
    simpa only [Fcut, Fbox, E, fullDiscrepancy_indexed_sample, ite_mul, one_mul, zero_mul]
      using hsplit' w
  have hpoint (q : ℕ) :
      ‖fullDiscrepancy Fcut q (a q)‖ ≤
        (∑ b ∈ A, ‖fullDiscrepancy (Fbox b) q (a q)‖) +
          2 * (∑ b ∈ D, ((U b).card : ℝ)) / (q.totient : ℝ) := by
    calc
      _ = ‖(∑ b ∈ I, fullDiscrepancy (Fbox b) q (a q)) +
          ∑ b ∈ D, fullDiscrepancy (E b) q (a q)‖ := by rw [hdelta]
      _ ≤ (∑ b ∈ I, ‖fullDiscrepancy (Fbox b) q (a q)‖) +
          ∑ b ∈ D, ‖fullDiscrepancy (E b) q (a q)‖ :=
        (norm_add_le _ _).trans (add_le_add (norm_sum_le _ _) (norm_sum_le _ _))
      _ ≤ (∑ b ∈ I, ‖fullDiscrepancy (Fbox b) q (a q)‖) +
          ∑ b ∈ D, (‖fullDiscrepancy (Fbox b) q (a q)‖ +
            2 * ((U b).card : ℝ) / (q.totient : ℝ)) :=
        add_le_add (le_refl _) (Finset.sum_le_sum fun b _hb => hboundary b q (a q))
      _ = _ := by
        rw [Finset.sum_add_distrib, ← add_assoc, ← Finset.sum_union hdisjoint, hunion]
        congr 1
        rw [← Finset.sum_div, ← Finset.mul_sum]
  calc
    _ ≤ ∑ q ∈ Q,
        ((∑ b ∈ A, ‖fullDiscrepancy (Fbox b) q (a q)‖) +
          2 * (∑ b ∈ D, ((U b).card : ℝ)) / (q.totient : ℝ)) :=
      Finset.sum_le_sum fun q _hq => hpoint q
    _ = _ := by
      rw [Finset.sum_add_distrib, Finset.sum_comm]
      congr 1
      simp only [div_eq_mul_inv, one_mul, Finset.mul_sum]

end

section
open scoped ContDiff

open Classical in
theorem finite_five_prime_box_discrepancy_cover
    (P : Finset ℕ) (bin : ℕ → ℕ) (C : (Fin 5 → ℕ) → Prop)
    (Q : Finset ℕ) (a : ℕ → ℕ) :
    let T := Fintype.piFinset (fun _ : Fin 5 => P)
    let label (p : Fin 5 → ℕ) : Fin 5 → ℕ := fun i => bin (p i)
    let B := T.image label
    let U (b : Fin 5 → ℕ) := T.filter (fun p => label p = b)
    let A := B.filter (fun b => ∃ p ∈ U b, C p)
    let D := A.filter (fun b => ¬∀ p ∈ U b, C p)
    let Fcut : ℕ →₀ ℂ :=
      ∑ p ∈ T, Finsupp.single (∏ i, p i) (if C p then 1 else 0)
    let Fbox (b : Fin 5 → ℕ) : ℕ →₀ ℂ :=
      ∑ p ∈ U b, Finsupp.single (∏ i, p i) 1
    (∑ q ∈ Q, ‖fullDiscrepancy Fcut q (a q)‖) ≤
      (∑ b ∈ A, ∑ q ∈ Q, ‖fullDiscrepancy (Fbox b) q (a q)‖) +
        2 * (∑ b ∈ D, ((U b).card : ℝ)) * ∑ q ∈ Q, 1 / (q.totient : ℝ) :=
  finite_small_prime_box_discrepancy_cover (arity := 4) P bin C Q a

end

open Classical in
theorem exceptionalPrimeDefect_ordinary_bv_log_saving
    (θ : ℝ) (hθ0 : 0 < θ) (hθ : θ < 1 / 2) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ j : Fin 2,
      ∀ a : ℕ → ℕ,
      (∀ q ∈ Finset.Icc 1 ⌊x ^ θ⌋₊, Nat.Coprime (a q) q) →
        (∑ q ∈ Finset.Icc 1 ⌊x ^ θ⌋₊,
          ‖fullDiscrepancy
            (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
              Finsupp.single n (exceptionalPrimeDefect x j n : ℂ)) q (a q)‖) ≤
            K * x / (Real.log x) ^ A := by
  intro A hA
  let D : ℝ := A + 20
  let E : ℝ := 5 * (D + 1)
  have hD : 0 ≤ D := by dsimp [D]; linarith
  have hE : 0 ≤ E := by dsimp [E]; positivity
  obtain ⟨Kb, Xb, hKb, hXb, hbox⟩ :=
    five_prime_closed_box_bv_power_cutoff θ hθ (A + E) (by linarith)
  obtain ⟨Xt, hXt⟩ := Filter.eventually_atTop.mp
    exceptionalPrimeDefect_closed_finsupp_eq_monomial_tuples
  have hsmall :=
    (isLittleO_log_rpow_rpow_atTop (A + 18)
      (by norm_num : (0 : ℝ) < 9519 / 50000)).eventuallyLE
  obtain ⟨Xs, hXs⟩ := Filter.eventually_atTop.mp hsmall
  let C0 : ℝ := 2 + Real.log 64
  let K : ℝ := (6 : ℝ) ^ 5 * Kb + 8 * (17 * 64) * (1023 + 1) * C0 ^ 16
  have hC0 : 0 < C0 := by
    have hlog64 := Real.log_nonneg (by norm_num : (1 : ℝ) ≤ 64)
    dsimp [C0]
    linarith
  have hK : 0 < K := by dsimp [K]; positivity
  refine ⟨K, max Xb (max Xt Xs), hK, ?_, ?_⟩
  · have h1 : 1 < Real.exp 100 := Real.one_lt_exp_iff.mpr (by norm_num)
    exact h1.trans_le (hXb.trans (le_max_left _ _))
  intro x hx j a ha
  have hxb : Xb ≤ x := (le_max_left _ _).trans hx
  have hxt : Xt ≤ x := (le_max_left Xt Xs).trans ((le_max_right _ _).trans hx)
  have hxs : Xs ≤ x := (le_max_right Xt Xs).trans ((le_max_right _ _).trans hx)
  have hx100 : Real.exp 100 ≤ x := hXb.trans hxb
  have hx0 : 0 < x := (Real.exp_pos 100).trans_le hx100
  have hx2 : 2 ≤ x := by
    have := Real.add_one_le_exp (100 : ℝ)
    linarith
  have hx1 : 1 ≤ x := by linarith
  have hxexp : Real.exp 1 ≤ x :=
    (Real.exp_le_exp.mpr (by norm_num : (1 : ℝ) ≤ 100)).trans hx100
  have hlog1 : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hxexp
  have hlog0 : 0 < Real.log x := zero_lt_one.trans_le hlog1
  let l : ℝ := Real.log x
  let h : ℝ := l ^ (-D)
  let P : Finset ℕ :=
    (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
      ⌊x ^ ((6 : ℝ) / 25)⌋₊).filter Nat.Prime
  let T := Fintype.piFinset (fun _ : Fin 5 => P)
  let bin (p : ℕ) := ⌊Real.logb (1 + h) (p : ℝ)⌋₊
  let label (p : Fin 5 → ℕ) : Fin 5 → ℕ := fun i => bin (p i)
  let B := T.image label
  let U (b : Fin 5 → ℕ) := T.filter (fun p => label p = b)
  let C (p : Fin 5 → ℕ) : Prop := ∀ d ∈ minorantMonomialCuts x j,
    if d.lower then
      if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
    else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold
  have hCdef : C = fun p : Fin 5 → ℕ => ∀ d ∈ minorantMonomialCuts x j,
      if d.lower then
        if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
      else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold := rfl
  clear_value C
  let V := B.filter (fun b => ∃ p ∈ U b, C p)
  let W := V.filter (fun b => ¬∀ p ∈ U b, C p)
  let Q := Finset.Icc 1 ⌊x ^ θ⌋₊
  let Fbox (b : Fin 5 → ℕ) : ℕ →₀ ℂ :=
    ∑ p ∈ U b, Finsupp.single (∏ i, p i) 1
  have hmesh := geometric_log_mesh_spec D x hD hxexp
  have hh : 0 < h := hmesh.1
  have hh1 : h ≤ 1 := hmesh.2.1
  have hcardB : (B.card : ℝ) ≤ (6 : ℝ) ^ 5 * l ^ E :=
    compact_prime_geometric_box_card_polylog D x hD hxexp
  have hcardV : (V.card : ℝ) ≤ (6 : ℝ) ^ 5 * l ^ E :=
    (Nat.cast_le.mpr (Finset.card_filter_le B _)).trans hcardB
  have hBbound (b : Fin 5 → ℕ) (hb : b ∈ V) :
      (∑ q ∈ Q, ‖fullDiscrepancy (Fbox b) q (a q)‖) ≤ Kb * x / l ^ (A + E) := by
    obtain ⟨p, hp, hCp⟩ := (Finset.mem_filter.mp hb).2
    have hpT := (Finset.mem_filter.mp hp).1
    have hlabel := (Finset.mem_filter.mp hp).2
    have hp0 (i : Fin 5) : 0 < p i :=
      (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hpT i)).2.pos
    rw [hCdef] at hCp
    have hprod := ((literal_minorant_monomial_cuts_iff x
      (lt_of_lt_of_le (by norm_num) hx2) j p hp0).mpr hCp).1
    let Lb (i : Fin 5) : ℝ := max (x ^ ((9519 : ℝ) / 50000)) ((1 + h) ^ b i)
    let Rb (i : Fin 5) : ℝ := min (x ^ ((6 : ℝ) / 25))
      ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ)
    have hscales := compact_prime_geometric_active_scales x h hx2 hh hh1 b p
      (Fintype.mem_piFinset.mp hpT) (fun i => congrFun hlabel i) hprod
    have hU : U b = Fintype.piFinset (fun i : Fin 5 =>
        (Finset.Icc ⌈Lb i⌉₊ ⌊Rb i⌋₊).filter Nat.Prime) := by
      have hboxes := (finite_five_prime_box_cut_decomposition P bin C).1 b
      change U b = Fintype.piFinset (fun i : Fin 5 => P.filter (fun p => bin p = b i)) at hboxes
      rw [hboxes]
      congr 1
      funext i
      exact compact_prime_geometric_bin_eq_closed_interval x h hx0 hh (b i)
    have hb' := hbox x hxb Lb Rb hscales.1 hscales.2.1 hscales.2.2 Q
      (by intro q hq; exact hq) a ha
    simpa only [Fbox, hU, l] using hb'
  have hinterior :
      (∑ b ∈ V, ∑ q ∈ Q, ‖fullDiscrepancy (Fbox b) q (a q)‖) ≤
        (6 : ℝ) ^ 5 * Kb * x / l ^ A := by
    calc
      _ ≤ ∑ b ∈ V, Kb * x / l ^ (A + E) := Finset.sum_le_sum hBbound
      _ = (V.card : ℝ) * (Kb * x / l ^ (A + E)) := by simp
      _ ≤ ((6 : ℝ) ^ 5 * l ^ E) * (Kb * x / l ^ (A + E)) :=
        mul_le_mul_of_nonneg_right hcardV (by positivity)
      _ = _ := by
        dsimp only [l]
        rw [Real.rpow_add hlog0]
        field_simp [(Real.rpow_pos_of_pos hlog0 A).ne',
          (Real.rpow_pos_of_pos hlog0 E).ne']
  have hW : W = B.filter
      (fun b => (∃ p ∈ U b, C p) ∧ ¬∀ p ∈ U b, C p) := by
    ext b
    simp only [W, V, Finset.mem_filter, and_assoc]
  have hmass : (∑ b ∈ W, ((U b).card : ℝ)) ≤
      17 * 64 * (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
        (1 + Real.log (64 * x)) ^ 16 := by
    rw [hW]
    simpa only [hCdef] using
      literal_minorant_mixed_geometric_box_card x h hx2 hh hh1 j
  have hφsum : (∑ q ∈ Q, 1 / (q.totient : ℝ)) ≤ 4 * l ^ 2 := by
    have hq1 : 1 ≤ ⌊x ^ θ⌋₊ :=
      Nat.le_floor (by simpa only [Nat.cast_one] using Real.one_le_rpow hx1 hθ0.le)
    have hqx : (⌊x ^ θ⌋₊ : ℝ) ≤ x :=
      (Nat.floor_le (Real.rpow_nonneg hx0.le θ)).trans
        (Real.rpow_le_self_of_one_le hx1 (by linarith))
    have hlogQ : Real.log (⌊x ^ θ⌋₊ : ℝ) ≤ l :=
      Real.log_le_log (by exact_mod_cast zero_lt_one.trans_le hq1) hqx
    have hharm := harmonic_le_one_add_log ⌊x ^ θ⌋₊
    have hmoment : (∑ q ∈ Q, 1 / (q.totient : ℝ)) ≤
        (harmonic ⌊x ^ θ⌋₊ : ℝ) ^ 2 := by
      calc
        _ ≤ ∑ q ∈ Q, (q.divisors.card : ℝ) / (q : ℝ) := by
          apply Finset.sum_le_sum
          intro q hq
          have hq0 : 0 < (q : ℝ) := Nat.cast_pos.mpr (Finset.mem_Icc.mp hq).1
          have hh := div_totient_le_card_divisors q
          calc
            1 / (q.totient : ℝ) = ((q : ℝ) / (q.totient : ℝ)) / q := by
              field_simp [hq0.ne']
            _ ≤ _ := div_le_div_of_nonneg_right hh hq0.le
        _ ≤ ∑ q ∈ Q,
            (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 2) q : ℝ) / (q : ℝ) := by
          apply Finset.sum_le_sum
          intro q hq
          apply div_le_div_of_nonneg_right _ (Nat.cast_nonneg q)
          have hh := card_divisors_pow_le_zeta_pow 1 q
            (Finset.mem_Icc.mp hq).1
          norm_num only [pow_one, pow_one] at hh
          exact_mod_cast hh
        _ ≤ _ := sum_zeta_pow_div_le_harmonic_pow 2 _
    have hH : (harmonic ⌊x ^ θ⌋₊ : ℝ) ≤ 2 * l := by
      have := hharm.trans (add_le_add (le_refl 1) hlogQ)
      dsimp only [l] at *
      linarith
    exact hmoment.trans ((pow_le_pow_left₀ (by unfold harmonic; positivity) hH 2).trans_eq
      (by ring))
  have hsmallx : l ^ (A + 18) ≤ x ^ ((9519 : ℝ) / 50000) := by
    simpa only [Real.norm_of_nonneg (Real.rpow_nonneg hlog0.le _),
      Real.norm_of_nonneg (Real.rpow_nonneg hx0.le _), l] using hXs x hxs
  have hboundary :
      2 * (∑ b ∈ W, ((U b).card : ℝ)) * (∑ q ∈ Q, 1 / (q.totient : ℝ)) ≤
        (8 * (17 * 64) * (1023 + 1) * C0 ^ 16) * x / l ^ A := by
    exact minorant_boundary_log_arithmetic A x
      (∑ b ∈ W, ((U b).card : ℝ)) (∑ q ∈ Q, 1 / (q.totient : ℝ))
      hA hxexp (Finset.sum_nonneg fun _ _ => Nat.cast_nonneg _)
      (Finset.sum_nonneg fun _ _ => by positivity) hmass hφsum hsmallx
  have heq :
      (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        Finsupp.single n (exceptionalPrimeDefect x j n : ℂ)) =
        ∑ p ∈ T, Finsupp.single (∏ i, p i) (if C p then (1 : ℂ) else 0) :=
    by simpa only [hCdef] using hXt x hxt j
  have harith : (6 : ℝ) ^ 5 * Kb * x / l ^ A +
      (8 * (17 * 64) * (1023 + 1) * C0 ^ 16) * x / l ^ A = K * x / l ^ A := by
    dsimp only [K]
    ring
  clear_value P bin
  have hcover := finite_five_prime_box_discrepancy_cover P bin C Q a
  rw [heq]
  exact hcover.trans ((add_le_add hinterior hboundary).trans_eq harith)

open Classical in
theorem literal_minorant_closed_ordinary_bv_divisor_weight_log_saving
    (η : ℝ) (hη : 0 < η) (J : ℕ) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ a : ℕ → ℕ,
        (∀ q ∈ Finset.Icc 1 ⌊x ^ (1 / 2 - η)⌋₊, Nat.Coprime (a q) q) →
        let ρx : ℕ →₀ ℂ :=
          ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n
              (((if n.Prime then (1 : ℝ) else 0) -
                exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n : ℝ) : ℂ)
        (∑ q ∈ Finset.Icc 1 ⌊x ^ (1 / 2 - η)⌋₊,
          (q.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy ρx q (a q)‖) ≤
          K * x / (Real.log x) ^ A := by
  let θ : ℝ := 1 / 2 - η
  have hθ : θ < 1 / 2 := by dsimp [θ]; linarith
  by_cases hθ0 : 0 < θ
  · let Q (x : ℝ) (_a : ℕ → ℕ) := Finset.Icc 1 ⌊x ^ θ⌋₊
    let a' (_x : ℝ) (a : ℕ → ℕ) (q : ℕ) := if Nat.Coprime (a q) q then a q else 1
    have hprimitive (x : ℝ) (a : ℕ → ℕ) (q : ℕ) : Nat.Coprime (a' x a q) q := by
      dsimp only [a']
      split_ifs with h
      · exact h
      · simp
    let ρ : ℝ → ℕ →₀ ℂ := fun x =>
      ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        Finsupp.single n
          (((if n.Prime then (1 : ℝ) else 0) -
            exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n : ℝ) : ℂ)
    have hunweighted : ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
        ∀ x : ℝ, X ≤ x → ∀ a : ℕ → ℕ,
          (∑ q ∈ Q x a, ‖fullDiscrepancy (ρ x) q (a' x a q)‖) ≤
            K * x / (Real.log x) ^ A := by
      intro A hA
      obtain ⟨Kp, Xp, hKp, hXp, hp⟩ :=
        primeIndicator_dyadic_allModuli_bombieriVinogradov θ hθ0 hθ A hA
      obtain ⟨Kd, Xd, hKd, hXd, hd⟩ :=
        exceptionalPrimeDefect_ordinary_bv_log_saving θ hθ0 hθ A hA
      refine ⟨Kp + Kd + Kd, max Xp Xd, by positivity,
        hXd.trans_le (le_max_right _ _), ?_⟩
      intro x hx a
      let S := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
      let P : ℕ →₀ ℂ := ∑ n ∈ S,
        Finsupp.single n (if n.Prime then 1 else 0)
      let D (j : Fin 2) : ℕ →₀ ℂ := ∑ n ∈ S,
        Finsupp.single n (exceptionalPrimeDefect x j n : ℂ)
      have hΔ (q b : ℕ) : fullDiscrepancy (ρ x) q b =
          fullDiscrepancy P q b - fullDiscrepancy (D 0) q b -
            fullDiscrepancy (D 1) q b := by
        simp only [ρ, P, D, fullDiscrepancy_sample, ← Finset.sum_sub_distrib, S]
        apply Finset.sum_congr rfl
        intro n _hn
        simp only [Complex.ofReal_sub, apply_ite Complex.ofReal,
          Complex.ofReal_zero, Complex.ofReal_one]
        split_ifs <;> ring
      have hnorm (q : ℕ) : ‖fullDiscrepancy (ρ x) q (a' x a q)‖ ≤
          ‖fullDiscrepancy P q (a' x a q)‖ +
            ‖fullDiscrepancy (D 0) q (a' x a q)‖ +
              ‖fullDiscrepancy (D 1) q (a' x a q)‖ := by
        rw [hΔ]
        exact (norm_sub_le _ _).trans
          (add_le_add (norm_sub_le _ _) (le_refl _))
      have hprime := hp x ((le_max_left _ _).trans hx) (Q x a)
        (by intro q hq; exact hq) (a' x a) (fun q _ => hprimitive x a q)
      have hzero := hd x ((le_max_right _ _).trans hx) 0 (a' x a)
        (fun q _ => hprimitive x a q)
      have hone := hd x ((le_max_right _ _).trans hx) 1 (a' x a)
        (fun q _ => hprimitive x a q)
      calc
        _ ≤ ∑ q ∈ Q x a,
            (‖fullDiscrepancy P q (a' x a q)‖ +
              ‖fullDiscrepancy (D 0) q (a' x a q)‖ +
                ‖fullDiscrepancy (D 1) q (a' x a q)‖) :=
          Finset.sum_le_sum fun q _ => hnorm q
        _ ≤ Kp * x / (Real.log x) ^ A + Kd * x / (Real.log x) ^ A +
              Kd * x / (Real.log x) ^ A := by
          rw [Finset.sum_add_distrib, Finset.sum_add_distrib]
          exact add_le_add (add_le_add hprime hzero) hone
        _ = _ := by ring
    have hweighted := literal_minorant_divisor_weight_log_saving_of_unweighted
      θ hθ0 (by linarith) Q a'
      (Filter.Eventually.of_forall fun x a q hq => hq)
      (Filter.Eventually.of_forall fun x a q _ => hprimitive x a q) J
      (by simpa only [ρ, Complex.ofReal_sub] using hunweighted)
    intro A hA
    obtain ⟨K, X, hK, hX, hw⟩ := hweighted A hA
    refine ⟨K, X, hK, hX, ?_⟩
    intro x hx a ha ρx
    have hh := hw x hx a
    change (∑ q ∈ Finset.Icc 1 ⌊x ^ θ⌋₊,
      (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy ρx q (a q)‖) ≤ _
    refine (Finset.sum_congr rfl (fun q hq => ?_)).trans_le hh
    rw [show a' x a q = a q from ite_eq_left (ha q hq)]
    simp only [ρx, Complex.ofReal_sub]
  · intro A hA
    refine ⟨1, 2, by norm_num, by norm_num, ?_⟩
    intro x hx a _ha ρx
    have hx1 : 1 ≤ x := by linarith
    have hpow : x ^ θ ≤ 1 := Real.rpow_le_one_of_one_le_of_nonpos hx1 (le_of_not_gt hθ0)
    have hfloor : ⌊x ^ θ⌋₊ ≤ 1 := by
      simpa only [Nat.floor_one] using Nat.floor_mono hpow
    have hzero : ∀ q ∈ Finset.Icc 1 ⌊x ^ θ⌋₊,
        (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy ρx q (a q)‖ = 0 := by
      intro q hq
      have hq1 : q = 1 := by have hmem := Finset.mem_Icc.mp hq; omega
      subst q
      simp [fullDiscrepancy, progressionMass, reducedMass, Nat.mod_one]
    change (∑ q ∈ Finset.Icc 1 ⌊x ^ θ⌋₊,
      (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy ρx q (a q)‖) ≤ _
    rw [Finset.sum_eq_zero hzero]
    have hx0 : 0 ≤ x := by linarith
    have hlog : 0 ≤ Real.log x := Real.log_nonneg hx1
    positivity

theorem minorantHB_original_boundary_pair_moduli_log_saving
    (J : ℕ) (saving : ℝ) (hsaving : 0 < saving) :
    ∃ D₀ : ℕ, 1 ≤ D₀ ∧ ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ D : ℕ, D₀ ≤ D →
      ∀ N A B t : Fin 3 → ℝ,
        (∀ i, x ^ ((1 : ℝ) / 4) ≤ N i ∧ N i ≤ x ^ ((41 : ℝ) / 100)) →
        (∀ i, N i ≤ A i ∧ A i ≤ B i ∧ B i ≤ 2 * N i) →
        (∀ i, 0 ≤ t i ∧ t i ≤ 10) →
      ∀ c d k : Fin 3, ∀ e f : Bool,
      ∀ S : Finset ℕ, S ⊆ Finset.Icc 1 ⌊x ^ ((53 : ℝ) / 100)⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
      let Θ : ℝ := 1 + (Real.log x) ^ (-(D : ℝ))
      let U : ℝ := x ^ ((9 : ℝ) / 100)
      let H : Fin 3 → Bool → ℕ →₀ ℂ := fun i b =>
        if b then minorantHBUnmaskedFive (A i) (B i) U Θ (t i)
        else minorantHBClosedMangoldt (A i) (B i) (t i)
      let E : ℕ →₀ ℂ := H c true - H c false
      let P : ℕ →₀ ℂ :=
        ((MonoidAlgebra.ofCoeff (H d e) : MonoidAlgebra ℂ ℕ) *
          MonoidAlgebra.ofCoeff (H k f)).coeff
      let R : ℕ →₀ ℂ :=
        ((MonoidAlgebra.ofCoeff E : MonoidAlgebra ℂ ℕ) *
          MonoidAlgebra.ofCoeff P).coeff.filter
            (fun n : ℕ => x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x)
      (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy R q (a q)‖) ≤
        K * x / (Real.log x) ^ saving := by
  classical
  obtain ⟨D₁, hD₁, K₀, X₀, hK₀, hX₀, hAP⟩ :=
    original_factor_short_interval_moduli_log_saving
      ((1 : ℝ) / 4) ((41 : ℝ) / 100) ((53 : ℝ) / 100)
      (by norm_num) (by norm_num) (by norm_num) (by norm_num) (by norm_num)
      9 19 3 J 8 saving (by norm_num) hsaving
  obtain ⟨X₁, hX₁, hmesh⟩ := minorantHB_original_mesh_carrier_widths D₁
  let L : ℝ := 31 * 1024 * 8
  have hL : 0 < L := by norm_num [L]
  refine ⟨D₁ + 2, by omega, 2 * K₀ * L, max X₀ X₁, by positivity,
    hX₀.trans (le_max_left _ _), ?_⟩
  intro x hx D hD N A B t hN hAB ht c d k e f S hS a ha Θ U H E P R
  have hx₀ : X₀ ≤ x := (le_max_left _ _).trans hx
  have hx₁ : X₁ ≤ x := (le_max_right _ _).trans hx
  have hxExp : Real.exp 1 ≤ x := hX₀.trans hx₀
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le hxExp
  have hxone : 1 ≤ x := (Real.one_le_exp zero_le_one).trans hxExp
  have hlogone : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxpos).mpr hxExp
  have hN1 (i : Fin 3) : 1 ≤ N i :=
    (Real.one_le_rpow hxone (by norm_num : (0 : ℝ) ≤ 1 / 4)).trans (hN i).1
  have hNpos (i : Fin 3) : 0 < N i := zero_lt_one.trans_le (hN1 i)
  have hA1 (i : Fin 3) : 1 ≤ A i := (hN1 i).trans (hAB i).1
  have hBpos (i : Fin 3) : 0 < B i :=
    zero_lt_one.trans_le ((hA1 i).trans (hAB i).2.1)
  have hm (i : Fin 3) := hmesh x hx₁ D hD (N i) (hN i).1 (hN i).2
    (A i) (B i) (hAB i).1 (hAB i).2.1 (hAB i).2.2
  change ∀ i : Fin 3,
    1 < Θ ∧ Θ ≤ 2 ∧ Θ ^ 60 ≤ 2 ∧ B i ≤ U ^ 5 ∧
      (1 ≤ ⌈A i / Θ ^ 60⌉₊ ∧ ⌈A i / Θ ^ 60⌉₊ ≤ ⌊A i⌋₊ + 1 ∧
        ⌊A i⌋₊ + 1 ≤ ⌈8 * N i⌉₊ + 1 ∧
        ((⌊A i⌋₊ + 1 - ⌈A i / Θ ^ 60⌉₊ : ℕ) : ℝ) ≤
          N i / (Real.log x) ^ D₁) ∧
      (1 ≤ ⌈B i⌉₊ ∧ ⌈B i⌉₊ ≤ ⌊B i * Θ ^ 60⌋₊ + 1 ∧
        ⌊B i * Θ ^ 60⌋₊ + 1 ≤ ⌈8 * N i⌉₊ + 1 ∧
        ((⌊B i * Θ ^ 60⌋₊ + 1 - ⌈B i⌉₊ : ℕ) : ℝ) ≤
          N i / (Real.log x) ^ D₁) at hm
  have hΘ : 1 < Θ := (hm c).1
  have hΘpos : 0 < Θ := zero_lt_one.trans hΘ
  have hΘtwo : Θ ≤ 2 := (hm c).2.1
  have hpow : Θ ^ 20 ≤ Θ ^ 60 := pow_le_pow_right₀ hΘ.le (by decide)
  have h60pos : 0 < Θ ^ 60 := pow_pos hΘpos _
  have hApos : 0 < A c := zero_lt_one.trans_le (hA1 c)
  have hAlow : A c / Θ ^ 60 ≤ A c / Θ ^ 20 :=
    div_le_div_of_nonneg_left hApos.le (pow_pos hΘpos _) hpow
  have hQuarter : N c / 4 ≤ A c / Θ ^ 60 := by
    apply (le_div_iff₀ h60pos).mpr
    have hh := mul_le_mul_of_nonneg_left (hm c).2.2.1
      (div_nonneg (hNpos c).le (by norm_num : (0 : ℝ) ≤ 4))
    nlinarith [(hAB c).1]
  have hboundary := minorantHB_five_boundary (A c) (B c) U Θ (t c)
    (hA1 c) (hAB c).2.1 (Real.rpow_nonneg hxpos.le _) (hm c).2.2.2.1
    hΘ hΘtwo (ht c).1 (ht c).2
  change (∀ n ∈ E.support,
    (A c / Θ ^ 20 ≤ (n : ℝ) ∧ (n : ℝ) < A c) ∨
      (B c < (n : ℝ) ∧ (n : ℝ) ≤ B c * Θ ^ 20)) ∧
    ∀ n : ℕ, ‖E n‖ ≤ 31 * (n.divisors.card : ℝ) ^ 9 * Real.log (n : ℝ)
    at hboundary
  have hcofactor := minorantHB_two_original_cofactor_norm_le A B t U Θ hA1
    (fun i => (hAB i).2.1) (Real.rpow_nonneg hxpos.le _)
    (fun i => (hm i).2.2.2.1) hΘ hΘtwo (fun i => (ht i).1)
    (fun i => (ht i).2) d k e f
  change (∀ m : ℕ, ‖P m‖ ≤
    1024 * (m.divisors.card : ℝ) ^ 19 * (Real.log (m : ℝ)) ^ 2) ∧ P 0 = 0
    at hcofactor
  let E₀ : ℕ →₀ ℂ := E.filter (fun n : ℕ => (n : ℝ) < A c)
  let E₁ : ℕ →₀ ℂ := E.filter (fun n : ℕ => B c < (n : ℝ))
  have hsplit : E = E₀ + E₁ := by
    ext n
    by_cases hlo : (n : ℝ) < A c
    · have hhi : ¬B c < (n : ℝ) := by linarith [(hAB c).2.1]
      simp only [E₀, E₁, Finsupp.add_apply, Finsupp.filter_apply,
        ite_eq_left hlo, ite_eq_right hhi, add_zero]
    · by_cases hhi : B c < (n : ℝ)
      · simp only [E₀, E₁, Finsupp.add_apply, Finsupp.filter_apply,
          ite_eq_right hlo, ite_eq_left hhi, zero_add]
      · have hn : E n = 0 := by
          by_contra hn
          rcases hboundary.1 n (Finsupp.mem_support_iff.mpr hn) with hn | hn
          · exact hlo hn.2
          · exact hhi hn.1
        simp only [E₀, E₁, Finsupp.add_apply, Finsupp.filter_apply,
          ite_eq_right hlo, ite_eq_right hhi, hn, add_zero]
  have hsupp₀ (n : ℕ) (hn : n ∈ E₀.support) :
      n ∈ Finset.Ico ⌈A c / Θ ^ 60⌉₊ (⌊A c⌋₊ + 1) ∧ N c / 4 ≤ (n : ℝ) := by
    change n ∈ E.support.filter (fun n : ℕ => (n : ℝ) < A c) at hn
    obtain ⟨hnE, hnA⟩ := Finset.mem_filter.mp hn
    have hnlo : A c / Θ ^ 20 ≤ (n : ℝ) := by
      rcases hboundary.1 n hnE with h | h
      · exact h.1
      · linarith [(hAB c).2.1]
    have hn60 := hAlow.trans hnlo
    refine ⟨Finset.mem_Ico.mpr ⟨Nat.ceil_le.mpr hn60, ?_⟩, hQuarter.trans hn60⟩
    exact Nat.lt_succ_of_le ((Nat.le_floor_iff hApos.le).mpr hnA.le)
  have hsupp₁ (n : ℕ) (hn : n ∈ E₁.support) :
      n ∈ Finset.Ico ⌈B c⌉₊ (⌊B c * Θ ^ 60⌋₊ + 1) ∧ N c / 4 ≤ (n : ℝ) := by
    change n ∈ E.support.filter (fun n : ℕ => B c < (n : ℝ)) at hn
    obtain ⟨hnE, hnB⟩ := Finset.mem_filter.mp hn
    have hnhi : (n : ℝ) ≤ B c * Θ ^ 20 := by
      rcases hboundary.1 n hnE with h | h
      · linarith [(hAB c).2.1]
      · exact h.2
    have hn60 := hnhi.trans (mul_le_mul_of_nonneg_left hpow (hBpos c).le)
    refine ⟨Finset.mem_Ico.mpr ⟨Nat.ceil_le.mpr hnB.le, ?_⟩, ?_⟩
    · exact Nat.lt_succ_of_le ((Nat.le_floor_iff
        (mul_nonneg (hBpos c).le h60pos.le)).mpr hn60)
    · linarith [(hAB c).1, (hAB c).2.1, (hNpos c)]
  have hpart (T : ℕ → Prop) (lo hi : ℕ) (hlo : 1 ≤ lo) (hlohi : lo ≤ hi)
      (hhi : hi ≤ ⌈8 * N c⌉₊ + 1)
      (hwidth : ((hi - lo : ℕ) : ℝ) ≤ N c / (Real.log x) ^ D₁)
      (hsupp : ∀ n ∈ (E.filter T).support,
        n ∈ Finset.Ico lo hi ∧ N c / 4 ≤ (n : ℝ)) :
      (∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
        ‖fullDiscrepancy
          (((MonoidAlgebra.ofCoeff (E.filter T) : MonoidAlgebra ℂ ℕ) *
            MonoidAlgebra.ofCoeff P).coeff.filter
              (fun n : ℕ => x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x)) q (a q)‖) ≤
        K₀ * L * x / (Real.log x) ^ saving := by
    rw [minorantHB_boundary_filtered_pair_rectangle (E.filter T) P x (N c)
      hxpos (hNpos c) (Finset.Ico lo hi) hsupp]
    apply hAP x hx₀ L hL.le (N c) (hN c).1 (hN c).2
      lo hi hlo hlohi hhi hwidth S hS a ha
    intro n hn m hm'
    exact hbBoundary_masked_pair_norm E P x hxpos hlogone hboundary.2 hcofactor.1
      T n m (hlo.trans (Finset.mem_Ico.mp hn).1) (Finset.mem_Icc.mp hm').1
  let R₀ : ℕ →₀ ℂ :=
    ((MonoidAlgebra.ofCoeff E₀ : MonoidAlgebra ℂ ℕ) *
      MonoidAlgebra.ofCoeff P).coeff.filter
        (fun n : ℕ => x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x)
  let R₁ : ℕ →₀ ℂ :=
    ((MonoidAlgebra.ofCoeff E₁ : MonoidAlgebra ℂ ℕ) *
      MonoidAlgebra.ofCoeff P).coeff.filter
        (fun n : ℕ => x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x)
  have hR : R = R₀ + R₁ := by
    change ((MonoidAlgebra.ofCoeff E : MonoidAlgebra ℂ ℕ) *
      MonoidAlgebra.ofCoeff P).coeff.filter _ = _
    rw [hsplit, MonoidAlgebra.ofCoeff_add, add_mul, MonoidAlgebra.coeff_add,
      Finsupp.filter_add]
  have hlo := (hm c).2.2.2.2.1
  have hhi := (hm c).2.2.2.2.2
  have hR₀ := hpart (fun n : ℕ => (n : ℝ) < A c)
    ⌈A c / Θ ^ 60⌉₊ (⌊A c⌋₊ + 1) hlo.1 hlo.2.1 hlo.2.2.1 hlo.2.2.2 hsupp₀
  have hR₁ := hpart (fun n : ℕ => B c < (n : ℝ))
    ⌈B c⌉₊ (⌊B c * Θ ^ 60⌋₊ + 1) hhi.1 hhi.2.1 hhi.2.2.1 hhi.2.2.2 hsupp₁
  rw [hR]
  calc
    _ ≤ (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy R₀ q (a q)‖) +
        ∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy R₁ q (a q)‖ :=
      hbBoundary_weighted_discrepancy_add_le R₀ R₁ S a J
    _ ≤ K₀ * L * x / (Real.log x) ^ saving +
        K₀ * L * x / (Real.log x) ^ saving := add_le_add hR₀ hR₁
    _ = _ := by ring

open Classical in
theorem minorantHB_three_original_boundary_telescope
    (A B t : Fin 3 → ℝ) (U Θ : ℝ) (R : ℕ → Prop) [DecidablePred R] :
    (((∏ c : Fin 3, (MonoidAlgebra.ofCoeff
        (minorantHBUnmaskedFive (A c) (B c) U Θ (t c)) : MonoidAlgebra ℂ ℕ)).coeff -
      (∏ c : Fin 3, (MonoidAlgebra.ofCoeff
        (minorantHBClosedMangoldt (A c) (B c) (t c)) : MonoidAlgebra ℂ ℕ)).coeff).filter R) =
    ((MonoidAlgebra.ofCoeff (minorantHBUnmaskedFive (A 0) (B 0) U Θ (t 0) -
        minorantHBClosedMangoldt (A 0) (B 0) (t 0)) *
      (MonoidAlgebra.ofCoeff (minorantHBUnmaskedFive (A 1) (B 1) U Θ (t 1)) *
        MonoidAlgebra.ofCoeff (minorantHBUnmaskedFive (A 2) (B 2) U Θ (t 2))) :
        MonoidAlgebra ℂ ℕ).coeff.filter R) +
    ((MonoidAlgebra.ofCoeff (minorantHBUnmaskedFive (A 1) (B 1) U Θ (t 1) -
        minorantHBClosedMangoldt (A 1) (B 1) (t 1)) *
      (MonoidAlgebra.ofCoeff (minorantHBClosedMangoldt (A 0) (B 0) (t 0)) *
        MonoidAlgebra.ofCoeff (minorantHBUnmaskedFive (A 2) (B 2) U Θ (t 2))) :
        MonoidAlgebra ℂ ℕ).coeff.filter R) +
    ((MonoidAlgebra.ofCoeff (minorantHBUnmaskedFive (A 2) (B 2) U Θ (t 2) -
        minorantHBClosedMangoldt (A 2) (B 2) (t 2)) *
      (MonoidAlgebra.ofCoeff (minorantHBClosedMangoldt (A 0) (B 0) (t 0)) *
        MonoidAlgebra.ofCoeff (minorantHBClosedMangoldt (A 1) (B 1) (t 1))) :
        MonoidAlgebra ℂ ℕ).coeff.filter R) := by
  rw [← Finsupp.filter_add, ← Finsupp.filter_add,
    ← MonoidAlgebra.coeff_add, ← MonoidAlgebra.coeff_add, ← MonoidAlgebra.coeff_sub]
  apply congrArg (fun p : MonoidAlgebra ℂ ℕ => p.coeff.filter R)
  simp only [Fin.prod_univ_three, MonoidAlgebra.ofCoeff_sub, MonoidAlgebra.ofCoeff_coeff]
  ring

open Classical in
theorem minorantHB_three_original_boundary_moduli_log_saving
    (J : ℕ) (saving : ℝ) (hSaving : 0 < saving) :
    ∃ D₀ : ℕ, 1 ≤ D₀ ∧ ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ D : ℕ, D₀ ≤ D →
      ∀ N A B t : Fin 3 → ℝ,
        (∀ c, x ^ ((1 : ℝ) / 4) ≤ N c ∧ N c ≤ x ^ ((41 : ℝ) / 100)) →
        (∀ c, N c ≤ A c ∧ A c ≤ B c ∧ B c ≤ 2 * N c) →
        (∀ c, 0 ≤ t c ∧ t c ≤ 10) →
      ∀ S : Finset ℕ, S ⊆ Finset.Icc 1 ⌊x ^ ((53 : ℝ) / 100)⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
        let Θ : ℝ := 1 + (Real.log x) ^ (-(D : ℝ))
        let U : ℝ := x ^ ((9 : ℝ) / 100)
        let R : ℕ →₀ ℂ :=
          ((∏ c : Fin 3, (MonoidAlgebra.ofCoeff
              (minorantHBUnmaskedFive (A c) (B c) U Θ (t c)) : MonoidAlgebra ℂ ℕ)).coeff -
            (∏ c : Fin 3, (MonoidAlgebra.ofCoeff
              (minorantHBClosedMangoldt (A c) (B c) (t c)) : MonoidAlgebra ℂ ℕ)).coeff).filter
                (fun n : ℕ => x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x)
        (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy R q (a q)‖) ≤
          K * x / (Real.log x) ^ saving := by
  obtain ⟨D₀, hD₀, K, X, hK, hX, hpair⟩ :=
    minorantHB_original_boundary_pair_moduli_log_saving J saving hSaving
  refine ⟨D₀, hD₀, 3 * K, X, by positivity, hX, ?_⟩
  intro x hx D hD N A B t hN hAB ht S hS a ha Θ U R
  let H (c : Fin 3) (b : Bool) : ℕ →₀ ℂ :=
    if b then minorantHBUnmaskedFive (A c) (B c) U Θ (t c)
    else minorantHBClosedMangoldt (A c) (B c) (t c)
  let T (c d k : Fin 3) (e f : Bool) : ℕ →₀ ℂ :=
    ((MonoidAlgebra.ofCoeff (minorantHBUnmaskedFive (A c) (B c) U Θ (t c) -
        minorantHBClosedMangoldt (A c) (B c) (t c)) *
      MonoidAlgebra.ofCoeff ((MonoidAlgebra.ofCoeff (H d e) *
        MonoidAlgebra.ofCoeff (H k f) : MonoidAlgebra ℂ ℕ).coeff) :
          MonoidAlgebra ℂ ℕ).coeff).filter
            (fun n : ℕ => x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x)
  have hb (c d k : Fin 3) (e f : Bool) :
      (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy (T c d k e f) q (a q)‖) ≤
        K * x / (Real.log x) ^ saving :=
    hpair x hx D hD N A B t hN hAB ht c d k e f S hS a ha
  have hR : R = T 0 1 2 true true + T 1 0 2 false true + T 2 0 1 false false := by
    simpa only [R, T, H, Bool.true_eq, Bool.false_eq_true, ite_true, ite_false,
      MonoidAlgebra.ofCoeff_coeff] using
      minorantHB_three_original_boundary_telescope A B t U Θ
        (fun n : ℕ => x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x)
  rw [hR]
  calc
    _ ≤ (∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy (T 0 1 2 true true + T 1 0 2 false true) q (a q)‖) +
        ∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy (T 2 0 1 false false) q (a q)‖ :=
      hbBoundary_weighted_discrepancy_add_le _ _ S a J
    _ ≤ ((∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy (T 0 1 2 true true) q (a q)‖) +
        ∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy (T 1 0 2 false true) q (a q)‖) +
        ∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy (T 2 0 1 false false) q (a q)‖ :=
      add_le_add (hbBoundary_weighted_discrepancy_add_le _ _ S a J) le_rfl
    _ ≤ (K * x / (Real.log x) ^ saving + K * x / (Real.log x) ^ saving) +
        K * x / (Real.log x) ^ saving :=
      add_le_add (add_le_add (hb 0 1 2 true true) (hb 1 0 2 false true)) (hb 2 0 1 false false)
    _ = _ := by ring

theorem minorantHB_three_radial_error_moduli_log_saving (A₀ : ℝ) (hA₀ : 0 < A₀)
    (J : ℕ) :
    ∃ D₀ : ℕ, 1 ≤ D₀ ∧ ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ D : ℕ, D₀ ≤ D →
      ∀ (A B t : Fin 3 → ℝ) (U : ℝ),
        (∀ c, 1 ≤ A c) → (∀ c, A c ≤ B c) →
        (∀ c, 0 ≤ t c) → (∀ c, t c ≤ 10) →
        let Θ : ℝ := 1 + (Real.log x) ^ (-(D : ℝ))
        let boxes (r : Fin 3 → Fin 5) :=
          Fintype.piFinset (fun c : Fin 3 =>
            minorantHBBoxes ((r c).val + 1) (A c) (B c) Θ)
        let β (r : Fin 3 → Fin 5)
            (ν : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ) : ℕ →₀ ℂ :=
          (∏ s : Σ c : Fin 3, Fin (2 * ((r c).val + 1)),
            minorantHBLocalizedSlot ((r s.1).val + 1) U Θ (t s.1) (ν s.1) s.2).coeff
        let P (r : Fin 3 → Fin 5)
            (ν : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ) : ℝ :=
          ∏ s : Σ c : Fin 3, Fin (2 * ((r c).val + 1)), Θ ^ ν s.1 s.2
        let selected (r : Fin 3 → Fin 5) :=
          (boxes r).filter (fun ν => x * Θ ^ 30 ≤ P r ν ∧ P r ν * Θ ^ 30 ≤ 2 * x)
        let c (r : Fin 3 → Fin 5) : ℂ :=
          ∏ j : Fin 3,
            (((-1 : ℝ) ^ (r j).val * ((5 : ℕ).choose ((r j).val + 1) : ℝ) : ℝ) : ℂ)
        let F : ℕ →₀ ℂ :=
          (∏ j : Fin 3,
            (MonoidAlgebra.ofCoeff (minorantHBUnmaskedFive (A j) (B j) U Θ (t j)) :
              MonoidAlgebra ℂ ℕ)).coeff
        let S : ℕ →₀ ℂ := ∑ r : Fin 3 → Fin 5, c r • ∑ ν ∈ selected r, β r ν
        let R : ℕ →₀ ℂ := F.filter (fun n : ℕ => x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x) - S
        ∀ Q : Finset ℕ, Q ⊆ Finset.Icc 1 ⌊x ^ (53 / 100 : ℝ)⌋₊ →
        ∀ a : ℕ → ℕ, (∀ q ∈ Q, Nat.Coprime (a q) q) →
          (∑ q ∈ Q, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy R q (a q)‖) ≤
            K * x / (Real.log x) ^ A₀ := by
  classical
  obtain ⟨D₁, hD₁, Kraw, X₁, hKraw, hX₁, hAP⟩ :=
    radial_short_interval_moduli_log_saving (53 / 100) (by norm_num) (by norm_num)
      29 40 J 2 A₀ (by norm_num) hA₀
  obtain ⟨X₂, hX₂, hwidth⟩ := minorantHB_radial_mesh_carrier_widths D₁
  let L : ℝ := (31 : ℝ) ^ 3 * (3 : ℝ) ^ 40
  have hL : 0 < L := by dsimp only [L]; positivity
  refine ⟨D₁ + 2, by omega, 2 * Kraw * L, max X₁ X₂,
    by positivity, hX₁.trans (le_max_left _ _), ?_⟩
  intro x hx D hD A B t U hA hAB ht htten Θ boxes β P selected c F S R Q hQ a ha
  have hx₁ : X₁ ≤ x := (le_max_left _ _).trans hx
  have hx₂ : X₂ ≤ x := (le_max_right _ _).trans hx
  have hxExp : Real.exp 1 ≤ x := hX₁.trans hx₁
  have hxPos : 0 < x := (Real.exp_pos 1).trans_le hxExp
  have hlogOne : 1 ≤ Real.log x := (Real.le_log_iff_exp_le hxPos).mpr hxExp
  have hlogPos : 0 < Real.log x := zero_lt_one.trans_le hlogOne
  obtain ⟨hΘ, hΘtwo, hΘsixty, hlo, hhi⟩ := hwidth x hx₂ D hD
  have hΘpos : 0 < Θ := zero_lt_one.trans hΘ
  have hfinite := minorantHB_three_radial_selection A B t U Θ x hA hAB hΘ hΘtwo ht htten
  extract_lets c' F' S' R' at hfinite
  have hR : R' = R := by
    dsimp only [R']
  rw [hR] at hfinite
  let I₀ : Finset ℕ := Finset.Ico ⌈x⌉₊ (⌊x * Θ ^ 60⌋₊ + 1)
  let I₁ : Finset ℕ := Finset.Ico ⌈2 * x / Θ ^ 60⌉₊ (⌊2 * x⌋₊ + 1)
  have hsupport (n : ℕ) (hn : n ∈ R.support) : n ∈ I₀ ∨ n ∈ I₁ := by
    rcases hfinite.1 n hn with h | h
    · exact Or.inl (Finset.mem_Ico.mpr
        ⟨Nat.ceil_le.mpr h.1, Nat.lt_succ_iff.mpr (Nat.le_floor h.2)⟩)
    · exact Or.inr (Finset.mem_Ico.mpr
        ⟨Nat.ceil_le.mpr h.1, Nat.lt_succ_iff.mpr (Nat.le_floor h.2)⟩)
  have hcarrier (n : ℕ) (hn : n ∈ I₀ ∨ n ∈ I₁) :
      1 ≤ n ∧ (n : ℝ) ≤ 2 * x := by
    rcases hn with hn | hn
    · have hm := Finset.mem_Ico.mp hn
      refine ⟨hlo.1.trans hm.1, ?_⟩
      calc
        (n : ℝ) ≤ ⌊x * Θ ^ 60⌋₊ := by exact_mod_cast Nat.le_of_lt_succ hm.2
        _ ≤ x * Θ ^ 60 := Nat.floor_le (by positivity)
        _ ≤ 2 * x := by nlinarith only [hΘsixty, hxPos]
    · have hm := Finset.mem_Ico.mp hn
      refine ⟨hhi.1.trans hm.1, ?_⟩
      exact (Nat.cast_le.mpr (Nat.le_of_lt_succ hm.2)).trans (Nat.floor_le (by positivity))
  have hcoeff (n : ℕ) (hn : n ∈ I₀ ∨ n ∈ I₁) :
      ‖R n‖ ≤ L * (n.divisors.card : ℝ) ^ 29 * (Real.log x) ^ 40 := by
    have hc := hcarrier n hn
    have hnPos : (0 : ℝ) < n := by exact_mod_cast (zero_lt_one.trans_le hc.1)
    have hlogN := Real.log_le_log hnPos hc.2
    rw [Real.log_mul (by norm_num : (2 : ℝ) ≠ 0) hxPos.ne'] at hlogN
    have hlogTwo : Real.log 2 ≤ 1 := by
      have h := Real.log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2)
      norm_num at h
      exact h
    have hlogBound : 1 + Real.log (n : ℝ) ≤ 3 * Real.log x := by
      linarith only [hlogN, hlogTwo, hlogOne]
    calc
      _ ≤ (31 : ℝ) ^ 3 * (n.divisors.card : ℝ) ^ 29 *
          (1 + Real.log (n : ℝ)) ^ 40 := hfinite.2 n
      _ ≤ (31 : ℝ) ^ 3 * (n.divisors.card : ℝ) ^ 29 *
          (3 * Real.log x) ^ 40 :=
        mul_le_mul_of_nonneg_left
          (pow_le_pow_left₀
            (add_nonneg zero_le_one (Real.log_natCast_nonneg n)) hlogBound 40) (by positivity)
      _ = _ := by dsimp only [L]; rw [mul_pow]; ring
  let R₀ : ℕ →₀ ℂ := ∑ n ∈ I₀, Finsupp.single n (R n)
  let R₁ : ℕ →₀ ℂ :=
    ∑ n ∈ I₁, Finsupp.single n (if n ∈ I₀ then (0 : ℂ) else R n)
  have hsplit : R = R₀ + R₁ := by
    ext n
    simp only [R₀, R₁, Finsupp.add_apply, Finsupp.finsetSum_apply,
      Finsupp.single_apply, Finset.sum_ite_eq']
    by_cases hn₀ : n ∈ I₀
    · simp only [ite_eq_left hn₀, ite_self, add_zero]
    · by_cases hn₁ : n ∈ I₁
      · simp only [ite_eq_right hn₀, ite_eq_left hn₁, zero_add]
      · have hz : R n = 0 := Finsupp.notMem_support_iff.mp (fun hn =>
          (hsupport n hn).elim hn₀ hn₁)
        simp only [ite_eq_right hn₀, ite_eq_right hn₁, hz, add_zero]
  have h₀ :
      (∑ q ∈ Q, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy R₀ q (a q)‖) ≤
        Kraw * L * x / (Real.log x) ^ A₀ :=
    hAP x hx₁ L hL.le ⌈x⌉₊ (⌊x * Θ ^ 60⌋₊ + 1)
      hlo.1 hlo.2.1 hlo.2.2.1 hlo.2.2.2 Q hQ a ha R
        (fun n hn => hcoeff n (Or.inl hn))
  have h₁ :
      (∑ q ∈ Q, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy R₁ q (a q)‖) ≤
        Kraw * L * x / (Real.log x) ^ A₀ := by
    apply hAP x hx₁ L hL.le ⌈2 * x / Θ ^ 60⌉₊ (⌊2 * x⌋₊ + 1)
      hhi.1 hhi.2.1 hhi.2.2.1 hhi.2.2.2 Q hQ a ha
        (fun n => if n ∈ I₀ then 0 else R n)
    intro n hn
    by_cases hn₀ : n ∈ I₀
    · simp only [ite_eq_left hn₀, norm_zero]
      exact mul_nonneg (mul_nonneg hL.le (pow_nonneg (Nat.cast_nonneg _) 29))
        (pow_nonneg hlogPos.le 40)
    · simpa only [ite_eq_right hn₀] using hcoeff n (Or.inr hn)
  let kernel : ℕ → ℕ → ℂ := fun q n =>
    (if n % q = a q % q then 1 else 0) -
      (if Nat.Coprime n q then 1 else 0) / (q.totient : ℂ)
  have hfull (u : ℕ →₀ ℂ) (q : ℕ) :
      fullDiscrepancy u q (a q) = u.sum (fun n z => z * kernel q n) := by
    change fullDiscrepancy u q (a q) = ∑ n ∈ u.support, u n * kernel q n
    simp only [fullDiscrepancy, progressionMass, reducedMass, kernel,
      div_eq_mul_inv, mul_sub, mul_ite, ite_mul, one_mul, mul_one,
      zero_mul, mul_zero, Finset.sum_sub_distrib, Finset.sum_mul]
  have hdelta (q : ℕ) :
      fullDiscrepancy R q (a q) = fullDiscrepancy R₀ q (a q) + fullDiscrepancy R₁ q (a q) := by
    rw [hsplit]
    simp only [hfull]
    rw [Finsupp.sum_add_index' (fun _ => zero_mul _) (fun _ _ _ => add_mul _ _ _)]
  calc
    _ ≤ ∑ q ∈ Q, ((q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy R₀ q (a q)‖ +
        (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy R₁ q (a q)‖) := by
      apply Finset.sum_le_sum
      intro q hq
      rw [hdelta, ← mul_add]
      exact mul_le_mul_of_nonneg_left (norm_add_le _ _)
        (pow_nonneg (Nat.cast_nonneg _) J)
    _ ≤ Kraw * L * x / (Real.log x) ^ A₀ + Kraw * L * x / (Real.log x) ^ A₀ := by
      rw [Finset.sum_add_distrib]
      exact add_le_add h₀ h₁
    _ = (2 * Kraw * L) * x / (Real.log x) ^ A₀ := by ring

open Classical in
theorem central_five_prime_boolean_cut_coherent_log_saving
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : ℕ) («ω» δ σ : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ)
    (hσgap : (1 / 2 : ℝ) - 40481 / 100000 < σ)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ M : Finset MinorantMonomialCut, ∀ C : (Fin 5 → ℕ) → Prop,
      M.card ≤ 32 →
      (∀ d ∈ M, d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
        d.numerator.card + d.denominator.card ≤ 5 ∧ 0 < d.threshold) →
      let P : Finset ℕ :=
        (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
          ⌊x ^ ((6 : ℝ) / 25)⌋₊).filter Nat.Prime
      let T := Fintype.piFinset (fun _ : Fin 5 => P)
      (∀ p ∈ T, ∀ q ∈ T,
        (∀ d ∈ M,
          (if d.lower then
            if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
          else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
          (if d.lower then
            if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
          else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
        (C p ↔ C q)) →
      (∀ p ∈ T, C p →
        (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧
        ∃ S : Finset (Fin 5), (S.card = 2 ∨ S.card = 3) ∧
          x ^ ((40481 : ℝ) / 100000) ≤ ((∏ i ∈ S, p i : ℕ) : ℝ) ∧
          ((∏ i ∈ S, p i : ℕ) : ℝ) ≤ x ^ ((59519 : ℝ) / 100000)) →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let F : ℕ →₀ ℂ :=
          ∑ p ∈ T, Finsupp.single (∏ i, p i) (if C p then 1 else 0)
        let Q := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
          q ∣ (∏ p ∈ I, p) ∧
            Nonempty (DenseDivisibilityWitness
              ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ j q))
        (∑ q ∈ Q, ‖fullDiscrepancy F q a‖) ≤ K * x / (Real.log x) ^ A := by
  intro A hA
  let τ : ℝ := σ - (1 / 2 - 40481 / 100000)
  have hτ : 0 < τ := sub_pos.mpr hσgap
  have hσ : 0 < σ := by linarith
  let θ : ℝ := 1 / 2 + 2 * «ω»
  have hθ0 : 0 < θ := by dsimp [θ]; linarith
  have hθ1 : θ < 1 := by
    rcases hsource with ⟨_, _, hi⟩ | ⟨_, _, hi⟩ | ⟨_, hi, _, _⟩ <;>
      dsimp [θ] <;> nlinarith
  let D : ℝ := A + 20
  let E : ℝ := 5 * (D + 1)
  have hD : 0 ≤ D := by dsimp [D]; linarith
  have hE : 0 ≤ E := by dsimp [E]; positivity
  obtain ⟨Kb, Xb, hKb, hXb, hbox⟩ :=
    central_prime_box_typeII_coherent_log_saving hDeligne j 5 «ω» δ σ
      (9519 / 100000) 64 hω hδ hσ (by norm_num) (by norm_num) hsource
      (A + E) (by linarith)
  obtain ⟨Xc, hXc⟩ := Filter.eventually_atTop.mp
    (compact_prime_geometric_central_scales τ hτ)
  obtain ⟨Xs, hXs⟩ := Filter.eventually_atTop.mp
    ((isLittleO_log_rpow_rpow_atTop (A + 18)
      (by norm_num : (0 : ℝ) < 9519 / 50000)).eventuallyLE)
  let C0 : ℝ := 2 + Real.log 64
  let Cb : ℝ := 8 * (17 * 64) * (1023 + 1) * C0 ^ 16
  let K : ℝ := (6 : ℝ) ^ 5 * Kb + 32 * Cb
  have hC0 : 0 < C0 := by
    have := Real.log_nonneg (by norm_num : (1 : ℝ) ≤ 64)
    dsimp only [C0]
    linarith
  have hK : 0 < K := by dsimp only [K, Cb]; positivity
  refine ⟨K, max Xb (max Xc Xs), hK, hXb.trans (le_max_left _ _), ?_⟩
  intro x hx M C hMcard hM P T hboolean hsupport I hI a ha F Q
  have hxb : Xb ≤ x := (le_max_left _ _).trans hx
  have hxc : Xc ≤ x := (le_max_left Xc Xs).trans ((le_max_right _ _).trans hx)
  have hxs : Xs ≤ x := (le_max_right Xc Xs).trans ((le_max_right _ _).trans hx)
  have hx100 : Real.exp 100 ≤ x := hXb.trans hxb
  have hx0 : 0 < x := (Real.exp_pos 100).trans_le hx100
  have hx2 : 2 ≤ x := by
    have := Real.add_one_le_exp (100 : ℝ)
    linarith
  have hx1 : 1 ≤ x := by linarith
  have hxexp : Real.exp 1 ≤ x :=
    (Real.exp_le_exp.mpr (by norm_num : (1 : ℝ) ≤ 100)).trans hx100
  have hlog100 : 100 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hx100
  have hlog1 : 1 ≤ Real.log x := by linarith
  have hlog0 : 0 < Real.log x := by linarith
  let l : ℝ := Real.log x
  let h : ℝ := l ^ (-D)
  let bin (p : ℕ) := ⌊Real.logb (1 + h) (p : ℝ)⌋₊
  let label (p : Fin 5 → ℕ) : Fin 5 → ℕ := fun i => bin (p i)
  let B := T.image label
  let U (b : Fin 5 → ℕ) := T.filter (fun p => label p = b)
  let V := B.filter (fun b => ∃ p ∈ U b, C p)
  let W := V.filter (fun b => ¬∀ p ∈ U b, C p)
  let Fbox (b : Fin 5 → ℕ) : ℕ →₀ ℂ :=
    ∑ p ∈ U b, Finsupp.single (∏ i, p i) 1
  have hmesh := geometric_log_mesh_spec D x hD hxexp
  have hh : 0 < h := hmesh.1
  have hh1 : h ≤ 1 := hmesh.2.1
  have hhquarter : h ≤ 1 / 4 := by
    calc
      h ≤ l ^ (-1 : ℝ) :=
        Real.rpow_le_rpow_of_exponent_le hlog1 (by dsimp only [D]; linarith)
      _ = 1 / l := by rw [Real.rpow_neg_one, one_div]
      _ ≤ 1 / 4 := one_div_le_one_div_of_le (by norm_num) (by dsimp only [l]; linarith)
  have hcardB : (B.card : ℝ) ≤ (6 : ℝ) ^ 5 * l ^ E :=
    compact_prime_geometric_box_card_polylog D x hD hxexp
  have hcardV : (V.card : ℝ) ≤ (6 : ℝ) ^ 5 * l ^ E :=
    (Nat.cast_le.mpr (Finset.card_filter_le B _)).trans hcardB
  have hBbound (b : Fin 5 → ℕ) (hb : b ∈ V) :
      (∑ q ∈ Q, ‖fullDiscrepancy (Fbox b) q a‖) ≤ Kb * x / l ^ (A + E) := by
    obtain ⟨p, hp, hCp⟩ := (Finset.mem_filter.mp hb).2
    have hpT := (Finset.mem_filter.mp hp).1
    have hlabel := (Finset.mem_filter.mp hp).2
    obtain ⟨hprod, S, hS, hSlo, hShi⟩ := hsupport p hpT hCp
    let Lb (i : Fin 5) : ℝ := max (x ^ ((9519 : ℝ) / 50000)) ((1 + h) ^ b i)
    let Rb (i : Fin 5) : ℝ := min (x ^ ((6 : ℝ) / 25))
      ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ)
    obtain ⟨R, Y, _hRS, hRne, hRproper, hY, hcuts, hYlo, hYhi, hNlo, hNhi⟩ :=
      hXc x hxc h hh hhquarter b p (Fintype.mem_piFinset.mp hpT)
        (fun i => congrFun hlabel i) hprod S hS
        (by simpa only [Nat.cast_prod] using hSlo)
        (by simpa only [Nat.cast_prod] using hShi)
    have hexponent : (40481 : ℝ) / 100000 - τ = 1 / 2 - σ := by
      dsimp only [τ]
      ring
    rw [hexponent] at hNlo
    have hU : U b = Fintype.piFinset (fun i : Fin 5 =>
        (Finset.Icc ⌈Lb i⌉₊ ⌊Rb i⌋₊).filter Nat.Prime) := by
      have hboxes := (finite_five_prime_box_cut_decomposition P bin C).1 b
      change U b = Fintype.piFinset (fun i : Fin 5 => P.filter (fun p => bin p = b i)) at hboxes
      rw [hboxes]
      congr 1
      funext i
      exact compact_prime_geometric_bin_eq_closed_interval x h hx0 hh (b i)
    have hcoeff : (primeIntervalBoxAlgebra Lb Rb Finset.univ).coeff = Fbox b := by
      simpa only [MonoidAlgebra.coeff_sum, MonoidAlgebra.coeff_single, Fbox, hU] using
        congrArg (fun f : MonoidAlgebra ℂ ℕ => f.coeff)
          (primeIntervalBoxAlgebra_univ_eq_tuple_sum Lb Rb)
    have hb' := hbox x hxb Y Lb Rb R hRne hRproper hY hcuts hYlo hYhi
      hNlo hNhi I hI a ha
    rw [hcoeff] at hb'
    exact hb'
  have hinterior :
      (∑ b ∈ V, ∑ q ∈ Q, ‖fullDiscrepancy (Fbox b) q a‖) ≤
        (6 : ℝ) ^ 5 * Kb * x / l ^ A := by
    calc
      _ ≤ ∑ b ∈ V, Kb * x / l ^ (A + E) := Finset.sum_le_sum hBbound
      _ = (V.card : ℝ) * (Kb * x / l ^ (A + E)) := by simp
      _ ≤ ((6 : ℝ) ^ 5 * l ^ E) * (Kb * x / l ^ (A + E)) :=
        mul_le_mul_of_nonneg_right hcardV (by positivity)
      _ = _ := by
        dsimp only [l]
        rw [Real.rpow_add hlog0]
        field_simp [(Real.rpow_pos_of_pos hlog0 A).ne',
          (Real.rpow_pos_of_pos hlog0 E).ne']
  have hW : W = B.filter
      (fun b => (∃ p ∈ U b, C p) ∧ ¬∀ p ∈ U b, C p) := by
    ext b
    simp only [W, V, Finset.mem_filter, and_assoc]
  have hmass : (∑ b ∈ W, ((U b).card : ℝ)) ≤
      (M.card : ℝ) * 64 * (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
        (1 + Real.log (64 * x)) ^ 16 := by
    rw [hW]
    apply boolean_monomial_mixed_geometric_box_card x h hx2 hh hh1 M C hM hboolean
    intro p hp hCp
    exact (Nat.cast_le.mpr (Finset.mem_Icc.mp (hsupport p hp hCp).1).2).trans
      (Nat.floor_le (by positivity))
  have hQsub : Q ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ := Finset.filter_subset _ _
  clear_value P bin Q
  have hφsum : (∑ q ∈ Q, 1 / (q.totient : ℝ)) ≤ 4 * l ^ 2 := by
    let Q₀ := Finset.Icc 1 ⌊x ^ θ⌋₊
    have hq1 : 1 ≤ ⌊x ^ θ⌋₊ :=
      Nat.le_floor (by simpa only [Nat.cast_one] using Real.one_le_rpow hx1 hθ0.le)
    have hqx : (⌊x ^ θ⌋₊ : ℝ) ≤ x :=
      (Nat.floor_le (Real.rpow_nonneg hx0.le θ)).trans
        (Real.rpow_le_self_of_one_le hx1 hθ1.le)
    have hlogQ : Real.log (⌊x ^ θ⌋₊ : ℝ) ≤ l :=
      Real.log_le_log (by exact_mod_cast zero_lt_one.trans_le hq1) hqx
    have hmoment : (∑ q ∈ Q₀, 1 / (q.totient : ℝ)) ≤
        (harmonic ⌊x ^ θ⌋₊ : ℝ) ^ 2 := by
      calc
        _ ≤ ∑ q ∈ Q₀, (q.divisors.card : ℝ) / (q : ℝ) := by
          apply Finset.sum_le_sum
          intro q hq
          have hq0 : 0 < (q : ℝ) := Nat.cast_pos.mpr (Finset.mem_Icc.mp hq).1
          have ht := div_totient_le_card_divisors q
          calc
            1 / (q.totient : ℝ) = ((q : ℝ) / (q.totient : ℝ)) / q := by
              field_simp [hq0.ne']
            _ ≤ _ := div_le_div_of_nonneg_right ht hq0.le
        _ ≤ ∑ q ∈ Q₀,
            (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 2) q : ℝ) / (q : ℝ) := by
          apply Finset.sum_le_sum
          intro q hq
          apply div_le_div_of_nonneg_right _ (Nat.cast_nonneg q)
          have ht := card_divisors_pow_le_zeta_pow 1 q
            (Finset.mem_Icc.mp hq).1
          norm_num only [pow_one, pow_one] at ht
          exact_mod_cast ht
        _ ≤ _ := sum_zeta_pow_div_le_harmonic_pow 2 _
    have hH : (harmonic ⌊x ^ θ⌋₊ : ℝ) ≤ 2 * l := by
      have ht := (harmonic_le_one_add_log ⌊x ^ θ⌋₊).trans (add_le_add (le_refl 1) hlogQ)
      dsimp only [l] at *
      linarith
    have hsub : Q ⊆ Q₀ := hQsub
    exact (Finset.sum_le_sum_of_subset_of_nonneg hsub
      (fun _ _ _ => by positivity)).trans
      (hmoment.trans ((pow_le_pow_left₀ (by unfold harmonic; positivity) hH 2).trans_eq
        (by ring)))
  have hsmallx : l ^ (A + 18) ≤ x ^ ((9519 : ℝ) / 50000) := by
    simpa only [Real.norm_of_nonneg (Real.rpow_nonneg hlog0.le _),
      Real.norm_of_nonneg (Real.rpow_nonneg hx0.le _), l] using hXs x hxs
  have hmassScaled : (∑ b ∈ W, ((U b).card : ℝ)) / 32 ≤
      17 * 64 * (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
        (1 + Real.log (64 * x)) ^ 16 := by
    apply (div_le_iff₀ (by norm_num : (0 : ℝ) < 32)).mpr
    have hcount : (M.card : ℝ) ≤ 32 := by exact_mod_cast hMcard
    have hz : 0 ≤ 64 * (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
        (1 + Real.log (64 * x)) ^ 16 := by positivity
    nlinarith only [hmass, mul_le_mul_of_nonneg_right hcount hz, hz]
  have hboundary :
      2 * (∑ b ∈ W, ((U b).card : ℝ)) * (∑ q ∈ Q, 1 / (q.totient : ℝ)) ≤
        (32 * Cb) * x / l ^ A := by
    have hmassNonneg : 0 ≤ ∑ b ∈ W, ((U b).card : ℝ) :=
      Finset.sum_nonneg fun _ _ => Nat.cast_nonneg _
    have hφNonneg : 0 ≤ ∑ q ∈ Q, 1 / (q.totient : ℝ) :=
      Finset.sum_nonneg fun _ _ => one_div_nonneg.mpr (Nat.cast_nonneg _)
    have hb := minorant_boundary_log_arithmetic A x
      ((∑ b ∈ W, ((U b).card : ℝ)) / 32) (∑ q ∈ Q, 1 / (q.totient : ℝ))
      hA hxexp (div_nonneg hmassNonneg (by norm_num)) hφNonneg hmassScaled hφsum hsmallx
    calc
      _ = 32 * (2 * ((∑ b ∈ W, ((U b).card : ℝ)) / 32) *
          (∑ q ∈ Q, 1 / (q.totient : ℝ))) := by ring
      _ ≤ 32 * (Cb * x / l ^ A) := mul_le_mul_of_nonneg_left hb (by norm_num)
      _ = _ := by ring
  have harith : (6 : ℝ) ^ 5 * Kb * x / l ^ A +
      (32 * Cb) * x / l ^ A = K * x / l ^ A := by
    dsimp only [K]
    ring
  have hcover := finite_five_prime_box_discrepancy_cover P bin C Q (fun _ => a)
  exact hcover.trans ((add_le_add hinterior hboundary).trans_eq harith)

open Classical in
theorem central_five_prime_boolean_cut_subpower_coherent_log_saving
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : ℕ) («ω» δ σ : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ)
    (hσgap : (1 / 2 : ℝ) - 40481 / 100000 < σ)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1))
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x) atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ), (Y : ℝ) = x ^ δ →
      ∀ M : Finset MinorantMonomialCut, ∀ C : (Fin 5 → ℕ) → Prop,
      M.card ≤ 32 →
      (∀ d ∈ M, d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
        d.numerator.card + d.denominator.card ≤ 5 ∧ 0 < d.threshold) →
      let P : Finset ℕ :=
        (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
          ⌊x ^ ((6 : ℝ) / 25)⌋₊).filter Nat.Prime
      let T := Fintype.piFinset (fun _ : Fin 5 => P)
      (∀ p ∈ T, ∀ q ∈ T,
        (∀ d ∈ M,
          (if d.lower then
            if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
          else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
          (if d.lower then
            if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
          else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
        (C p ↔ C q)) →
      (∀ p ∈ T, C p →
        (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧
        ∃ S : Finset (Fin 5), (S.card = 2 ∨ S.card = 3) ∧
          x ^ ((40481 : ℝ) / 100000) ≤ ((∏ i ∈ S, p i : ℕ) : ℝ) ∧
          ((∏ i ∈ S, p i : ℕ) : ℝ) ≤ x ^ ((59519 : ℝ) / 100000)) →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let F : ℕ →₀ ℂ :=
          ∑ p ∈ T, Finsupp.single (∏ i, p i) (if C p then 1 else 0)
        let Q := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter (fun q =>
          q ∣ (∏ p ∈ I, p) ∧
            Nonempty (DenseDivisibilityWitness Y j q))
        (∑ q ∈ Q, ‖fullDiscrepancy F q a‖) ≤ K * x / (Real.log x) ^ A := by
  obtain ⟨r, hr, hretreat⟩ := central_typeII_parameter_retreat j «ω» δ σ hsource
  obtain ⟨Xr, hXr⟩ := eventually_atTop.mp
    (central_subpower_modulus_family_subset j «ω» δ r hr L0 hL0 hL0sub)
  intro A hA
  obtain ⟨K, Xp, hK, hXp, hp⟩ :=
    central_five_prime_boolean_cut_coherent_log_saving hDeligne j («ω» + r) (δ + r) σ
      (by linarith) (by linarith) hσgap hretreat A hA
  refine ⟨K, max Xp Xr, hK, hXp.trans (le_max_left _ _), ?_⟩
  intro x hx Y hY M C hMcard hM P T hboolean hsupport I hI a ha F Q
  have hxp : Xp ≤ x := (le_max_left _ _).trans hx
  have hxr : Xr ≤ x := (le_max_right _ _).trans hx
  have hsubset := hXr x hxr Y hY I
  have hbound := hp x hxp M C hMcard hM hboolean hsupport I hI a ha
  exact (Finset.sum_le_sum_of_subset_of_nonneg hsubset
    (fun q _ _ => norm_nonneg (fullDiscrepancy F q a))).trans hbound

open Classical in
theorem sourceU3_offDiagonal_subpower_coherent_log_saving
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : ℕ) («ω» δ σ : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ)
    (hσgap : (1 / 2 : ℝ) - 40481 / 100000 < σ)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1))
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x) atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ), (Y : ℝ) = x ^ δ →
      let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
      let U (p : Fin 5 → ℕ) : Prop :=
        [p 0, p 1, p 2] ∈ siftedPrimeTuples x (5 : Fin 6) ∧
          x ^ ((9519 : ℝ) / 50000) ≤ (p 3 : ℝ) ∧ p 3 ≤ p 4
      let E (p : Fin 5 → ℕ) : Prop :=
        (∀ i, (9519 : ℝ) / 50000 ≤ α (p i) ∧
          α (p i) ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
        α (p 1) < α (p 0) ∧ α (p 1) < α (p 2) ∧
        α (p 0) + α (p 2) < (40481 : ℝ) / 100000 ∧
        (59519 : ℝ) / 100000 < α (p 1) + α (p 2) + α (p 3) ∧
        α (p 3) ≤ α (p 4)
      let P := (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((6 : ℝ) / 25)⌋₊).filter Nat.Prime
      let T := Fintype.piFinset (fun _ : Fin 5 => P)
      let B (p : Fin 5 → ℕ) : Prop :=
        x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x ∧
          U p ∧ ¬ E p
      let Foff : ℕ →₀ ℂ := ∑ p ∈ T, Finsupp.single (∏ i, p i)
        (if B p ∧ p 2 ≠ p 1 then 1 else 0)
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let Q := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter (fun q =>
          q ∣ (∏ p ∈ I, p) ∧
            Nonempty (DenseDivisibilityWitness Y j q))
        (∑ q ∈ Q, ‖fullDiscrepancy Foff q a‖) ≤ K * x / (Real.log x) ^ A := by
  obtain ⟨Xc, hXc, hc⟩ :=
    sourceU3_sub_exceptionalPrimeDefect_one_eventually_positive_central
  intro A hA
  obtain ⟨K, Xg, hK, hXg, hg⟩ :=
    central_five_prime_boolean_cut_subpower_coherent_log_saving hDeligne j «ω» δ σ
      hω hδ hσgap hsource L0 hL0 hL0sub A hA
  refine ⟨K, max Xg Xc, hK, hXg.trans (le_max_left _ _), ?_⟩
  intro x hx Y hY α U E P T B Foff I hI a ha Q
  have hxg : Xg ≤ x := (le_max_left _ _).trans hx
  have hxc : Xc ≤ x := (le_max_right _ _).trans hx
  have hx1 : 1 < x := (by norm_num : (1 : ℝ) < 3).trans_le (hXc.trans hxc)
  obtain ⟨M, hMcard, hMdata, hbits⟩ := sourceU3_offDiagonal_monomial_representation x hx1
  have hboolean : ∀ p ∈ T, ∀ q ∈ T,
      (∀ d ∈ M,
        (if d.lower then
          if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
        else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
        (if d.lower then
          if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
        else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
      ((B p ∧ p 2 ≠ p 1) ↔ (B q ∧ q 2 ≠ q 1)) := by
    intro p hp q hq htests
    simpa only [B, U, and_assoc] using hbits p hp q hq htests
  have hsupport (p : Fin 5 → ℕ) (hp : p ∈ T) (hC : B p ∧ p 2 ≠ p 1) :
      (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧
      ∃ S : Finset (Fin 5), (S.card = 2 ∨ S.card = 3) ∧
        x ^ ((40481 : ℝ) / 100000) ≤ ((∏ i ∈ S, p i : ℕ) : ℝ) ∧
        ((∏ i ∈ S, p i : ℕ) : ℝ) ≤ x ^ ((59519 : ℝ) / 100000) := by
    obtain ⟨⟨hlo, hhi, hu, he⟩, hne⟩ := hC
    refine ⟨Finset.mem_Icc.mpr ⟨Nat.ceil_le.mpr hlo,
      (Nat.le_floor_iff (by positivity : (0 : ℝ) ≤ 2 * x)).mpr hhi⟩, ?_⟩
    have hcentral := (hc x hxc (∏ i, p i) hlo hhi).2.2 p
      (Finset.mem_filter.mpr ⟨hp, rfl, hu, he⟩)
    exact hcentral.resolve_right hne
  let C : (Fin 5 → ℕ) → Prop := fun p => B p ∧ p 2 ≠ p 1
  have hbooleanC : ∀ p ∈ T, ∀ q ∈ T,
      (∀ d ∈ M,
        (if d.lower then
          if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
        else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
        (if d.lower then
          if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
        else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
      (C p ↔ C q) := hboolean
  have hsupportC : ∀ p ∈ T, C p →
      (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧
      ∃ S : Finset (Fin 5), (S.card = 2 ∨ S.card = 3) ∧
        x ^ ((40481 : ℝ) / 100000) ≤ ((∏ i ∈ S, p i : ℕ) : ℝ) ∧
        ((∏ i ∈ S, p i : ℕ) : ℝ) ≤ x ^ ((59519 : ℝ) / 100000) := hsupport
  have hF : Foff = ∑ p ∈ T, Finsupp.single (∏ i, p i)
      (@ite ℂ (C p) (Classical.propDecidable _) 1 0) := by
    apply Finset.sum_congr rfl
    intro p _hp
    congr 1
    by_cases h : C p
    · rw [ite_eq_left (show B p ∧ p 2 ≠ p 1 from h), ite_eq_left h]
    · rw [ite_eq_right (show ¬(B p ∧ p 2 ≠ p 1) from h), ite_eq_right h]
  rw [hF]
  clear hF Foff hc hbits hboolean hsupport
  clear_value C
  exact hg x hxg Y hY M C hMcard hMdata hbooleanC hsupportC I hI a ha

open Classical in
theorem sourceU3_sub_exceptionalPrimeDefect_one_coherent_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : ℕ) («ω» δ σ : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ)
    (hσgap : (1 / 2 : ℝ) - 40481 / 100000 < σ)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1))
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x) atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ), (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let f : ℕ →₀ ℂ :=
          ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n
              (((sourceU3 x n - exceptionalPrimeDefect x (1 : Fin 2) n) : ℝ) : ℂ)
        let Q := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter (fun q =>
          q ∣ (∏ p ∈ I, p) ∧
            Nonempty (DenseDivisibilityWitness Y j q))
        (∑ q ∈ Q, ‖fullDiscrepancy f q a‖) ≤ K * x / (Real.log x) ^ A := by
  have hlevel : (1 / 2 : ℝ) + 2 * «ω» < 53 / 100 := by
    rcases hsource with ⟨_, _, hII⟩ | ⟨_, _, hII⟩ | ⟨_, hI, _, _⟩
    · linarith only [hII, hδ]
    · linarith only [hII, hδ]
    · linarith only [hI, hδ]
  let ε : ℝ := 53 / 100 - (1 / 2 + 2 * «ω»)
  have hε : 0 < ε := sub_pos.mpr hlevel
  have hmodulus : ∀ᶠ x : ℝ in atTop,
      x ^ (1 / 2 + 2 * «ω») * L0 x ≤ x ^ (53 / 100 : ℝ) := by
    filter_upwards [(tendsto_order.mp hL0sub).2 ε hε,
      eventually_gt_atTop (1 : ℝ)] with x hsmall hx1
    have hx0 : 0 < x := zero_lt_one.trans hx1
    have hL : L0 x ≤ x ^ ε := by
      apply (Real.log_le_log_iff (hL0 x) (Real.rpow_pos_of_pos hx0 ε)).mp
      rw [Real.log_rpow hx0]
      exact ((div_lt_iff₀ (Real.log_pos hx1)).mp hsmall).le
    calc
      _ ≤ x ^ (1 / 2 + 2 * «ω») * x ^ ε :=
        mul_le_mul_of_nonneg_left hL (Real.rpow_nonneg hx0.le _)
      _ = x ^ ((1 / 2 + 2 * «ω») + ε) := (Real.rpow_add hx0 _ _).symm
      _ = x ^ (53 / 100 : ℝ) := by congr 1; dsimp only [ε]; ring
  obtain ⟨Xr, hXr⟩ := hmodulus.exists_forall_of_atTop
  obtain ⟨Xs, _hXs, hsplit⟩ :=
    sourceU3_sub_exceptionalPrimeDefect_one_eventually_split
  intro A hA
  obtain ⟨Ko, Xo, hKo, hXo, hoff⟩ :=
    sourceU3_offDiagonal_subpower_coherent_log_saving
      hDeligne j «ω» δ σ hω hδ hσgap hsource L0 hL0 hL0sub A hA
  obtain ⟨Kd, Xd, hKd, _hXd, hdiag⟩ := sourceU3_diagonal_moduli_log_saving 0 A hA
  refine ⟨Ko + Kd, max (max Xo Xd) (max Xs Xr), add_pos hKo hKd,
    hXo.trans ((le_max_left _ _).trans (le_max_left _ _)), ?_⟩
  intro x hx Y hY I hI a ha f Q
  have hxo : Xo ≤ x := ((le_max_left _ _).trans (le_max_left _ _)).trans hx
  have hxd : Xd ≤ x := ((le_max_right _ _).trans (le_max_left _ _)).trans hx
  have hxs : Xs ≤ x := ((le_max_left _ _).trans (le_max_right _ _)).trans hx
  have hxr : Xr ≤ x := ((le_max_right _ _).trans (le_max_right _ _)).trans hx
  let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
  let U (p : Fin 5 → ℕ) : Prop :=
    [p 0, p 1, p 2] ∈ siftedPrimeTuples x (5 : Fin 6) ∧
      x ^ ((9519 : ℝ) / 50000) ≤ (p 3 : ℝ) ∧ p 3 ≤ p 4
  let E (p : Fin 5 → ℕ) : Prop :=
    (∀ i, (9519 : ℝ) / 50000 ≤ α (p i) ∧
      α (p i) ≤ 1 - 4 * ((9519 : ℝ) / 50000)) ∧
    α (p 1) < α (p 0) ∧ α (p 1) < α (p 2) ∧
    α (p 0) + α (p 2) < (40481 : ℝ) / 100000 ∧
    (59519 : ℝ) / 100000 < α (p 1) + α (p 2) + α (p 3) ∧
    α (p 3) ≤ α (p 4)
  let P := (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
    ⌊x ^ ((6 : ℝ) / 25)⌋₊).filter Nat.Prime
  let T := Fintype.piFinset (fun _ : Fin 5 => P)
  let B (p : Fin 5 → ℕ) : Prop :=
    x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x ∧ U p ∧ ¬ E p
  let Foff : ℕ →₀ ℂ := ∑ p ∈ T, Finsupp.single (∏ i, p i)
    (if B p ∧ p 2 ≠ p 1 then 1 else 0)
  let Fdiag : ℕ →₀ ℂ := ∑ p ∈ T, Finsupp.single (∏ i, p i)
    (if B p ∧ p 2 = p 1 then 1 else 0)
  have hidentity : f = Foff + Fdiag := hsplit x hxs
  have hQ : Q ⊆ Finset.Icc 1 ⌊x ^ (53 / 100 : ℝ)⌋₊ := by
    intro q hq
    have hqI := Finset.mem_Icc.mp (Finset.mem_filter.mp hq).1
    exact Finset.mem_Icc.mpr ⟨hqI.1,
      hqI.2.trans (Nat.floor_mono (hXr x hxr))⟩
  have hcoprime (q : ℕ) (hq : q ∈ Q) : Nat.Coprime a q :=
    Nat.Coprime.of_dvd_right (Finset.mem_filter.mp hq).2.1 ha
  have ho : (∑ q ∈ Q, ‖fullDiscrepancy Foff q a‖) ≤
      Ko * x / (Real.log x) ^ A := hoff x hxo Y hY I hI a ha
  have hd : (∑ q ∈ Q, ‖fullDiscrepancy Fdiag q a‖) ≤
      Kd * x / (Real.log x) ^ A := by
    simpa only [pow_zero, one_mul] using hdiag x hxd Q hQ (fun _ => a) hcoprime
  have hadd (q : ℕ) : fullDiscrepancy (Foff + Fdiag) q a =
      fullDiscrepancy Foff q a + fullDiscrepancy Fdiag q a := by
    simp_rw [fullDiscrepancy_eq_finsupp_sum]
    rw [Finsupp.sum_add_index' (fun n => by simp)
      (fun n z w => by split_ifs <;> ring)]
  rw [hidentity]
  calc
    _ ≤ ∑ q ∈ Q, (‖fullDiscrepancy Foff q a‖ + ‖fullDiscrepancy Fdiag q a‖) := by
      apply Finset.sum_le_sum
      intro q _hq
      rw [hadd]
      exact norm_add_le _ _
    _ = (∑ q ∈ Q, ‖fullDiscrepancy Foff q a‖) +
        ∑ q ∈ Q, ‖fullDiscrepancy Fdiag q a‖ := Finset.sum_add_distrib
    _ ≤ Ko * x / (Real.log x) ^ A + Kd * x / (Real.log x) ^ A :=
      add_le_add ho hd
    _ = (Ko + Kd) * x / (Real.log x) ^ A := by ring

open Classical in
theorem sourceT5_sub_exceptionalPrimeDefect_zero_coherent_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : ℕ) («ω» δ σ : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ)
    (hσgap : (1 / 2 : ℝ) - 40481 / 100000 < σ)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1))
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x) atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ), (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let F : ℕ →₀ ℂ :=
          ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n ((sourceT5 x n - exceptionalPrimeDefect x 0 n : ℝ) : ℂ)
        let Q := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter (fun q =>
          q ∣ (∏ p ∈ I, p) ∧
            Nonempty (DenseDivisibilityWitness Y j q))
        (∑ q ∈ Q, ‖fullDiscrepancy F q a‖) ≤ K * x / (Real.log x) ^ A := by
  intro A hA
  obtain ⟨K, Xb, hK, hXb, hbound⟩ :=
    central_five_prime_boolean_cut_subpower_coherent_log_saving
      hDeligne j «ω» δ σ hω hδ hσgap hsource L0 hL0 hL0sub A hA
  obtain ⟨Xt, hXt⟩ := eventually_atTop.mp
    sourceT5_sub_exceptionalPrimeDefect_zero_complex_finsupp
  refine ⟨K, max Xb Xt, hK, hXb.trans (le_max_left _ _), ?_⟩
  intro x hx Y hY I hI a ha F Q
  have hxb : Xb ≤ x := (le_max_left _ _).trans hx
  have hxt : Xt ≤ x := (le_max_right _ _).trans hx
  have hx1 : 1 < x := (Real.one_lt_exp_iff.mpr (by norm_num : (0 : ℝ) < 100)).trans_le
    (hXb.trans hxb)
  let P := (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
    ⌊x ^ ((6 : ℝ) / 25)⌋₊).filter Nat.Prime
  let T := Fintype.piFinset (fun _ : Fin 5 => P)
  let M := sourceT5CentralMonomialCuts x
  let C (p : Fin 5 → ℕ) : Prop :=
    (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧ p ∈ sourceT5CentralTuples x
  have hCdef : C = fun p =>
      (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧ p ∈ sourceT5CentralTuples x := rfl
  clear_value C
  have hboolean : ∀ p ∈ T, ∀ q ∈ T,
      (∀ d ∈ M,
        (if d.lower then
          if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
        else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
        (if d.lower then
          if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
        else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
      (C p ↔ C q) := by
    intro p hp q hq htruth
    rw [hCdef]
    exact sourceT5CentralTuples_monomial_truth_invariant x hx1 p q
      (Fintype.mem_piFinset.mp hp) (Fintype.mem_piFinset.mp hq) htruth
  have hsupport : ∀ p ∈ T, C p →
      (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧
      ∃ S : Finset (Fin 5), (S.card = 2 ∨ S.card = 3) ∧
        x ^ ((40481 : ℝ) / 100000) ≤ ((∏ i ∈ S, p i : ℕ) : ℝ) ∧
        ((∏ i ∈ S, p i : ℕ) : ℝ) ≤ x ^ ((59519 : ℝ) / 100000) := by
    intro p _ hp
    rw [hCdef] at hp
    exact ⟨hp.1, sourceT5CentralTuples_central_support x hx1 p hp.2⟩
  have hF : F = ∑ p ∈ T, Finsupp.single (∏ i, p i) (if C p then (1 : ℂ) else 0) := by
    rw [hCdef]
    have h := hXt x hxt 1 2 le_rfl (by norm_num) le_rfl
    simp only [one_mul] at h
    have h' := h.trans (sourceT5CentralTuples_pushforward_eq x (Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊))
    refine h'.trans (Finset.sum_congr rfl ?_)
    intro p _
    apply congrArg (Finsupp.single (∏ i, p i))
    exact @ite_cond_congr ℂ _ _ inferInstance (Classical.propDecidable _) _ _ rfl
  have h := hbound x hxb Y hY M C (sourceT5CentralMonomialCuts_card_le x)
    (sourceT5CentralMonomialCuts_data x (zero_lt_one.trans hx1)) hboolean hsupport I hI a ha
  rw [hF]
  exact h

open Classical in
theorem finite_four_prime_box_discrepancy_cover
    (P : Finset ℕ) (bin : ℕ → ℕ) (C : (Fin 4 → ℕ) → Prop)
    (Q : Finset ℕ) (a : ℕ → ℕ) :
    let T := Fintype.piFinset (fun _ : Fin 4 => P)
    let label (p : Fin 4 → ℕ) : Fin 4 → ℕ := fun i => bin (p i)
    let B := T.image label
    let U (b : Fin 4 → ℕ) := T.filter (fun p => label p = b)
    let A := B.filter (fun b => ∃ p ∈ U b, C p)
    let D := A.filter (fun b => ¬∀ p ∈ U b, C p)
    let Fcut : ℕ →₀ ℂ :=
      ∑ p ∈ T, Finsupp.single (∏ i, p i) (if C p then 1 else 0)
    let Fbox (b : Fin 4 → ℕ) : ℕ →₀ ℂ :=
      ∑ p ∈ U b, Finsupp.single (∏ i, p i) 1
    (∑ q ∈ Q, ‖fullDiscrepancy Fcut q (a q)‖) ≤
      (∑ b ∈ A, ∑ q ∈ Q, ‖fullDiscrepancy (Fbox b) q (a q)‖) +
        2 * (∑ b ∈ D, ((U b).card : ℝ)) * ∑ q ∈ Q, 1 / (q.totient : ℝ) :=
  finite_small_prime_box_discrepancy_cover (arity := 3) P bin C Q a

open Classical in
theorem central_four_prime_boolean_cut_coherent_log_saving
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : ℕ) («ω» δ σ : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ)
    (hσgap : (1 / 2 : ℝ) - 40481 / 100000 < σ)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ M : Finset MinorantFourMonomialCut, ∀ C : (Fin 4 → ℕ) → Prop,
      M.card ≤ 32 →
      (∀ d ∈ M, d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
        d.numerator.card + d.denominator.card ≤ 4 ∧ 0 < d.threshold) →
      let P : Finset ℕ :=
        (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
          ⌊x ^ ((11 : ℝ) / 25)⌋₊).filter Nat.Prime
      let T := Fintype.piFinset (fun _ : Fin 4 => P)
      (∀ p ∈ T, ∀ q ∈ T,
        (∀ d ∈ M,
          (if d.lower then
            if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
          else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
          (if d.lower then
            if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
          else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
        (C p ↔ C q)) →
      (∀ p ∈ T, C p →
        (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧
        ∃ S : Finset (Fin 4), S.Nonempty ∧ S ≠ Finset.univ ∧
          x ^ ((40481 : ℝ) / 100000) ≤ ((∏ i ∈ S, p i : ℕ) : ℝ) ∧
          ((∏ i ∈ S, p i : ℕ) : ℝ) ≤ x ^ ((59519 : ℝ) / 100000)) →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let F : ℕ →₀ ℂ :=
          ∑ p ∈ T, Finsupp.single (∏ i, p i) (if C p then 1 else 0)
        let Q := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
          q ∣ (∏ p ∈ I, p) ∧
            Nonempty (DenseDivisibilityWitness
              ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ j q))
        (∑ q ∈ Q, ‖fullDiscrepancy F q a‖) ≤ K * x / (Real.log x) ^ A := by
  intro A hA
  let τ : ℝ := σ - (1 / 2 - 40481 / 100000)
  have hτ : 0 < τ := sub_pos.mpr hσgap
  have hσ : 0 < σ := by linarith
  let θ : ℝ := 1 / 2 + 2 * «ω»
  have hθ0 : 0 < θ := by dsimp [θ]; linarith
  have hθ1 : θ < 1 := by
    rcases hsource with ⟨_, _, hi⟩ | ⟨_, _, hi⟩ | ⟨_, hi, _, _⟩ <;>
      dsimp [θ] <;> nlinarith
  let D : ℝ := A + 20
  let E : ℝ := 4 * (D + 1)
  have hD : 0 ≤ D := by dsimp [D]; linarith
  have hE : 0 ≤ E := by dsimp [E]; positivity
  obtain ⟨Kb, Xb, hKb, hXb, hbox⟩ :=
    central_prime_box_typeII_coherent_log_saving hDeligne j 4 «ω» δ σ
      (9519 / 100000) 64 hω hδ hσ (by norm_num) (by norm_num) hsource
      (A + E) (by linarith)
  obtain ⟨Xc, hXc⟩ := Filter.eventually_atTop.mp
    (four_prime_geometric_central_scales τ hτ)
  obtain ⟨Xs, hXs⟩ := Filter.eventually_atTop.mp
    ((isLittleO_log_rpow_rpow_atTop (A + 18)
      (by norm_num : (0 : ℝ) < 9519 / 50000)).eventuallyLE)
  let C0 : ℝ := 2 + Real.log 64
  let Cb : ℝ := 8 * (17 * 64) * (1023 + 1) * C0 ^ 16
  let K : ℝ := (6 : ℝ) ^ 4 * Kb + 32 * Cb
  have hC0 : 0 < C0 := by
    have := Real.log_nonneg (by norm_num : (1 : ℝ) ≤ 64)
    dsimp only [C0]
    linarith
  have hK : 0 < K := by dsimp only [K, Cb]; positivity
  refine ⟨K, max Xb (max Xc Xs), hK, hXb.trans (le_max_left _ _), ?_⟩
  intro x hx M C hMcard hM P T hboolean hsupport I hI a ha F Q
  have hxb : Xb ≤ x := (le_max_left _ _).trans hx
  have hxc : Xc ≤ x := (le_max_left Xc Xs).trans ((le_max_right _ _).trans hx)
  have hxs : Xs ≤ x := (le_max_right Xc Xs).trans ((le_max_right _ _).trans hx)
  have hx100 : Real.exp 100 ≤ x := hXb.trans hxb
  have hx0 : 0 < x := (Real.exp_pos 100).trans_le hx100
  have hx2 : 2 ≤ x := by
    have := Real.add_one_le_exp (100 : ℝ)
    linarith
  have hx1 : 1 ≤ x := by linarith
  have hxexp : Real.exp 1 ≤ x :=
    (Real.exp_le_exp.mpr (by norm_num : (1 : ℝ) ≤ 100)).trans hx100
  have hlog100 : 100 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hx100
  have hlog1 : 1 ≤ Real.log x := by linarith
  have hlog0 : 0 < Real.log x := by linarith
  let l : ℝ := Real.log x
  let h : ℝ := l ^ (-D)
  let bin (p : ℕ) := ⌊Real.logb (1 + h) (p : ℝ)⌋₊
  let label (p : Fin 4 → ℕ) : Fin 4 → ℕ := fun i => bin (p i)
  let B := T.image label
  let U (b : Fin 4 → ℕ) := T.filter (fun p => label p = b)
  let V := B.filter (fun b => ∃ p ∈ U b, C p)
  let W := V.filter (fun b => ¬∀ p ∈ U b, C p)
  let Fbox (b : Fin 4 → ℕ) : ℕ →₀ ℂ :=
    ∑ p ∈ U b, Finsupp.single (∏ i, p i) 1
  have hmesh := four_geometric_log_mesh_spec D x hD hxexp
  have hh : 0 < h := hmesh.1
  have hh1 : h ≤ 1 := hmesh.2.1
  have hhquarter : h ≤ 1 / 4 := by
    calc
      h ≤ l ^ (-1 : ℝ) :=
        Real.rpow_le_rpow_of_exponent_le hlog1 (by dsimp only [D]; linarith)
      _ = 1 / l := by rw [Real.rpow_neg_one, one_div]
      _ ≤ 1 / 4 := one_div_le_one_div_of_le (by norm_num) (by dsimp only [l]; linarith)
  have hcardB : (B.card : ℝ) ≤ (6 : ℝ) ^ 4 * l ^ E :=
    four_prime_geometric_box_card_polylog D x hD hxexp
  have hcardV : (V.card : ℝ) ≤ (6 : ℝ) ^ 4 * l ^ E :=
    (Nat.cast_le.mpr (Finset.card_filter_le B _)).trans hcardB
  have hBbound (b : Fin 4 → ℕ) (hb : b ∈ V) :
      (∑ q ∈ Q, ‖fullDiscrepancy (Fbox b) q a‖) ≤ Kb * x / l ^ (A + E) := by
    obtain ⟨p, hp, hCp⟩ := (Finset.mem_filter.mp hb).2
    have hpT := (Finset.mem_filter.mp hp).1
    have hlabel := (Finset.mem_filter.mp hp).2
    obtain ⟨hprod, S, hS, hSproper, hSlo, hShi⟩ := hsupport p hpT hCp
    let Lb (i : Fin 4) : ℝ := max (x ^ ((9519 : ℝ) / 50000)) ((1 + h) ^ b i)
    let Rb (i : Fin 4) : ℝ := min (x ^ ((11 : ℝ) / 25))
      ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ)
    obtain ⟨R, Y, _hRS, hRne, hRproper, hY, hcuts, hYlo, hYhi, hNlo, hNhi⟩ :=
      hXc x hxc h hh hhquarter b p (Fintype.mem_piFinset.mp hpT)
        (fun i => congrFun hlabel i) hprod S hS hSproper
        (by simpa only [Nat.cast_prod] using hSlo)
        (by simpa only [Nat.cast_prod] using hShi)
    have hexponent : (40481 : ℝ) / 100000 - τ = 1 / 2 - σ := by
      dsimp only [τ]
      ring
    rw [hexponent] at hNlo
    have hU : U b = Fintype.piFinset (fun i : Fin 4 =>
        (Finset.Icc ⌈Lb i⌉₊ ⌊Rb i⌋₊).filter Nat.Prime) := by
      have hboxes := (finite_four_prime_box_cut_decomposition P bin C).1 b
      change U b = Fintype.piFinset (fun i : Fin 4 => P.filter (fun p => bin p = b i)) at hboxes
      rw [hboxes]
      congr 1
      funext i
      exact four_prime_geometric_bin_eq_closed_interval x h hx0 hh (b i)
    have hcoeff : (primeIntervalBoxAlgebra Lb Rb Finset.univ).coeff = Fbox b := by
      simpa only [MonoidAlgebra.coeff_sum, MonoidAlgebra.coeff_single, Fbox, hU] using
        congrArg (fun f : MonoidAlgebra ℂ ℕ => f.coeff)
          (primeIntervalBoxAlgebra_univ_eq_tuple_sum Lb Rb)
    have hb' := hbox x hxb Y Lb Rb R hRne hRproper hY hcuts hYlo hYhi
      hNlo hNhi I hI a ha
    rw [hcoeff] at hb'
    exact hb'
  have hinterior :
      (∑ b ∈ V, ∑ q ∈ Q, ‖fullDiscrepancy (Fbox b) q a‖) ≤
        (6 : ℝ) ^ 4 * Kb * x / l ^ A := by
    calc
      _ ≤ ∑ b ∈ V, Kb * x / l ^ (A + E) := Finset.sum_le_sum hBbound
      _ = (V.card : ℝ) * (Kb * x / l ^ (A + E)) := by simp
      _ ≤ ((6 : ℝ) ^ 4 * l ^ E) * (Kb * x / l ^ (A + E)) :=
        mul_le_mul_of_nonneg_right hcardV (by positivity)
      _ = _ := by
        dsimp only [l]
        rw [Real.rpow_add hlog0]
        field_simp [(Real.rpow_pos_of_pos hlog0 A).ne',
          (Real.rpow_pos_of_pos hlog0 E).ne']
  have hW : W = B.filter
      (fun b => (∃ p ∈ U b, C p) ∧ ¬∀ p ∈ U b, C p) := by
    ext b
    simp only [W, V, Finset.mem_filter, and_assoc]
  have hmass : (∑ b ∈ W, ((U b).card : ℝ)) ≤
      (M.card : ℝ) * 64 * (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
        (1 + Real.log (64 * x)) ^ 16 := by
    rw [hW]
    apply boolean_four_monomial_mixed_geometric_box_card x h hx2 hh hh1 M C hM hboolean
    intro p hp hCp
    exact (Nat.cast_le.mpr (Finset.mem_Icc.mp (hsupport p hp hCp).1).2).trans
      (Nat.floor_le (by positivity))
  have hQsub : Q ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ := Finset.filter_subset _ _
  clear_value P bin Q
  have hφsum : (∑ q ∈ Q, 1 / (q.totient : ℝ)) ≤ 4 * l ^ 2 := by
    let Q₀ := Finset.Icc 1 ⌊x ^ θ⌋₊
    have hq1 : 1 ≤ ⌊x ^ θ⌋₊ :=
      Nat.le_floor (by simpa only [Nat.cast_one] using Real.one_le_rpow hx1 hθ0.le)
    have hqx : (⌊x ^ θ⌋₊ : ℝ) ≤ x :=
      (Nat.floor_le (Real.rpow_nonneg hx0.le θ)).trans
        (Real.rpow_le_self_of_one_le hx1 hθ1.le)
    have hlogQ : Real.log (⌊x ^ θ⌋₊ : ℝ) ≤ l :=
      Real.log_le_log (by exact_mod_cast zero_lt_one.trans_le hq1) hqx
    have hmoment : (∑ q ∈ Q₀, 1 / (q.totient : ℝ)) ≤
        (harmonic ⌊x ^ θ⌋₊ : ℝ) ^ 2 := by
      calc
        _ ≤ ∑ q ∈ Q₀, (q.divisors.card : ℝ) / (q : ℝ) := by
          apply Finset.sum_le_sum
          intro q hq
          have hq0 : 0 < (q : ℝ) := Nat.cast_pos.mpr (Finset.mem_Icc.mp hq).1
          have ht := div_totient_le_card_divisors q
          calc
            1 / (q.totient : ℝ) = ((q : ℝ) / (q.totient : ℝ)) / q := by
              field_simp [hq0.ne']
            _ ≤ _ := div_le_div_of_nonneg_right ht hq0.le
        _ ≤ ∑ q ∈ Q₀,
            (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 2) q : ℝ) / (q : ℝ) := by
          apply Finset.sum_le_sum
          intro q hq
          apply div_le_div_of_nonneg_right _ (Nat.cast_nonneg q)
          have ht := card_divisors_pow_le_zeta_pow 1 q
            (Finset.mem_Icc.mp hq).1
          norm_num only [pow_one, pow_one] at ht
          exact_mod_cast ht
        _ ≤ _ := sum_zeta_pow_div_le_harmonic_pow 2 _
    have hH : (harmonic ⌊x ^ θ⌋₊ : ℝ) ≤ 2 * l := by
      have ht := (harmonic_le_one_add_log ⌊x ^ θ⌋₊).trans (add_le_add (le_refl 1) hlogQ)
      dsimp only [l] at *
      linarith
    have hsub : Q ⊆ Q₀ := hQsub
    exact (Finset.sum_le_sum_of_subset_of_nonneg hsub
      (fun _ _ _ => by positivity)).trans
      (hmoment.trans ((pow_le_pow_left₀ (by unfold harmonic; positivity) hH 2).trans_eq
        (by ring)))
  have hsmallx : l ^ (A + 18) ≤ x ^ ((9519 : ℝ) / 50000) := by
    simpa only [Real.norm_of_nonneg (Real.rpow_nonneg hlog0.le _),
      Real.norm_of_nonneg (Real.rpow_nonneg hx0.le _), l] using hXs x hxs
  have hmassScaled : (∑ b ∈ W, ((U b).card : ℝ)) / 32 ≤
      17 * 64 * (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
        (1 + Real.log (64 * x)) ^ 16 := by
    apply (div_le_iff₀ (by norm_num : (0 : ℝ) < 32)).mpr
    have hcount : (M.card : ℝ) ≤ 32 := by exact_mod_cast hMcard
    have hz : 0 ≤ 64 * (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
        (1 + Real.log (64 * x)) ^ 16 := by positivity
    nlinarith only [hmass, mul_le_mul_of_nonneg_right hcount hz, hz]
  have hboundary :
      2 * (∑ b ∈ W, ((U b).card : ℝ)) * (∑ q ∈ Q, 1 / (q.totient : ℝ)) ≤
        (32 * Cb) * x / l ^ A := by
    have hmassNonneg : 0 ≤ ∑ b ∈ W, ((U b).card : ℝ) :=
      Finset.sum_nonneg fun _ _ => Nat.cast_nonneg _
    have hφNonneg : 0 ≤ ∑ q ∈ Q, 1 / (q.totient : ℝ) :=
      Finset.sum_nonneg fun _ _ => one_div_nonneg.mpr (Nat.cast_nonneg _)
    have hb := minorant_boundary_log_arithmetic A x
      ((∑ b ∈ W, ((U b).card : ℝ)) / 32) (∑ q ∈ Q, 1 / (q.totient : ℝ))
      hA hxexp (div_nonneg hmassNonneg (by norm_num)) hφNonneg hmassScaled hφsum hsmallx
    calc
      _ = 32 * (2 * ((∑ b ∈ W, ((U b).card : ℝ)) / 32) *
          (∑ q ∈ Q, 1 / (q.totient : ℝ))) := by ring
      _ ≤ 32 * (Cb * x / l ^ A) := mul_le_mul_of_nonneg_left hb (by norm_num)
      _ = _ := by ring
  have harith : (6 : ℝ) ^ 4 * Kb * x / l ^ A +
      (32 * Cb) * x / l ^ A = K * x / l ^ A := by
    dsimp only [K]
    ring
  have hcover := finite_four_prime_box_discrepancy_cover P bin C Q (fun _ => a)
  exact hcover.trans ((add_le_add hinterior hboundary).trans_eq harith)

open Classical in
theorem central_four_prime_boolean_cut_subpower_coherent_log_saving
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : ℕ) («ω» δ σ : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ)
    (hσgap : (1 / 2 : ℝ) - 40481 / 100000 < σ)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1))
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x) atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ), (Y : ℝ) = x ^ δ →
      ∀ M : Finset MinorantFourMonomialCut, ∀ C : (Fin 4 → ℕ) → Prop,
      M.card ≤ 32 →
      (∀ d ∈ M, d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
        d.numerator.card + d.denominator.card ≤ 4 ∧ 0 < d.threshold) →
      let P : Finset ℕ :=
        (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
          ⌊x ^ ((11 : ℝ) / 25)⌋₊).filter Nat.Prime
      let T := Fintype.piFinset (fun _ : Fin 4 => P)
      (∀ p ∈ T, ∀ q ∈ T,
        (∀ d ∈ M,
          (if d.lower then
            if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
          else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
          (if d.lower then
            if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
          else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
        (C p ↔ C q)) →
      (∀ p ∈ T, C p →
        (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧
        ∃ S : Finset (Fin 4), S.Nonempty ∧ S ≠ Finset.univ ∧
          x ^ ((40481 : ℝ) / 100000) ≤ ((∏ i ∈ S, p i : ℕ) : ℝ) ∧
          ((∏ i ∈ S, p i : ℕ) : ℝ) ≤ x ^ ((59519 : ℝ) / 100000)) →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let F : ℕ →₀ ℂ :=
          ∑ p ∈ T, Finsupp.single (∏ i, p i) (if C p then 1 else 0)
        let Q := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter (fun q =>
          q ∣ (∏ p ∈ I, p) ∧
            Nonempty (DenseDivisibilityWitness Y j q))
        (∑ q ∈ Q, ‖fullDiscrepancy F q a‖) ≤ K * x / (Real.log x) ^ A := by
  obtain ⟨r, hr, hretreat⟩ := central_typeII_parameter_retreat j «ω» δ σ hsource
  obtain ⟨Xr, hXr⟩ := eventually_atTop.mp
    (central_subpower_modulus_family_subset j «ω» δ r hr L0 hL0 hL0sub)
  intro A hA
  obtain ⟨K, Xp, hK, hXp, hp⟩ :=
    central_four_prime_boolean_cut_coherent_log_saving hDeligne j («ω» + r) (δ + r) σ
      (by linarith) (by linarith) hσgap hretreat A hA
  refine ⟨K, max Xp Xr, hK, hXp.trans (le_max_left _ _), ?_⟩
  intro x hx Y hY M C hMcard hM P T hboolean hsupport I hI a ha F Q
  have hxp : Xp ≤ x := (le_max_left _ _).trans hx
  have hxr : Xr ≤ x := (le_max_right _ _).trans hx
  have hsubset := hXr x hxr Y hY I
  have hbound := hp x hxp M C hMcard hM hboolean hsupport I hI a ha
  exact (Finset.sum_le_sum_of_subset_of_nonneg hsubset
    (fun q _ _ => norm_nonneg (fullDiscrepancy F q a))).trans hbound

open Classical in
theorem sourceT4_sub_sourceU1_coherent_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : ℕ) («ω» δ σ : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ)
    (hσgap : (1 / 2 : ℝ) - 40481 / 100000 < σ)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1))
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x) atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ), (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let F : ℕ →₀ ℂ :=
          ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n ((sourceT4 x n - sourceU1 x n : ℝ) : ℂ)
        let Q := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter (fun q =>
          q ∣ (∏ p ∈ I, p) ∧
            Nonempty (DenseDivisibilityWitness Y j q))
        (∑ q ∈ Q, ‖fullDiscrepancy F q a‖) ≤ K * x / (Real.log x) ^ A := by
  intro A hA
  obtain ⟨K, Xb, hK, hXb, hbound⟩ :=
    central_four_prime_boolean_cut_subpower_coherent_log_saving
      hDeligne j «ω» δ σ hω hδ hσgap hsource L0 hL0 hL0sub A hA
  obtain ⟨Xt, _hXt, htransport⟩ := sourceT4_sub_sourceU1_eventually_four_prime_finsupp
  obtain ⟨Xg, _hXg, hgeometry⟩ := sourceT4U1_eventually_compact_tuple_geometry
  refine ⟨2 * K, max Xb (max Xt Xg), by positivity,
    hXb.trans (le_max_left _ _), ?_⟩
  intro x hx Y hY I hI a ha F Q
  have hxb : Xb ≤ x := (le_max_left _ _).trans hx
  have hxt : Xt ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans hx)
  have hxg : Xg ≤ x := (le_max_right _ _).trans ((le_max_right _ _).trans hx)
  have hx1 : 1 < x := (Real.one_lt_exp_iff.mpr (by norm_num : (0 : ℝ) < 100)).trans_le
    (hXb.trans hxb)
  let P := (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
    ⌊x ^ ((11 : ℝ) / 25)⌋₊).filter Nat.Prime
  let T := Fintype.piFinset (fun _ : Fin 4 => P)
  let N := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
  let α : (Fin 4 → ℕ) → Fin 4 → ℝ := fun p i => Real.logb x (p i : ℝ)
  let w : (Fin 4 → ℕ) → ℝ := fun p =>
    (if sourceT4ExponentMask (α p) then 1 else 0) -
      (if sourceU1ExponentMask (α p) then 1 else 0)
  let Cp (p : Fin 4 → ℕ) : Prop := (∏ i, p i) ∈ N ∧
    sourceT4ExponentMask (α p) = true ∧ sourceU1ExponentMask (α p) = false
  let Cm (p : Fin 4 → ℕ) : Prop := (∏ i, p i) ∈ N ∧
    sourceU1ExponentMask (α p) = true ∧ sourceT4ExponentMask (α p) = false
  have hCp : Cp = fun p => (∏ i, p i) ∈ N ∧
      sourceT4ExponentMask (α p) = true ∧ sourceU1ExponentMask (α p) = false := rfl
  have hCm : Cm = fun p => (∏ i, p i) ∈ N ∧
      sourceU1ExponentMask (α p) = true ∧ sourceT4ExponentMask (α p) = false := rfl
  clear_value Cp Cm
  let Fp : ℕ →₀ ℂ := ∑ p ∈ T, Finsupp.single (∏ i, p i) (if Cp p then 1 else 0)
  let Fm : ℕ →₀ ℂ := ∑ p ∈ T, Finsupp.single (∏ i, p i) (if Cm p then 1 else 0)
  let M := sourceT4U1MonomialCuts x
  have hFp : Fp = ∑ p ∈ T, Finsupp.single (∏ i, p i) (if Cp p then 1 else 0) := rfl
  have hFm : Fm = ∑ p ∈ T, Finsupp.single (∏ i, p i) (if Cm p then 1 else 0) := rfl
  have hM : M = sourceT4U1MonomialCuts x := rfl
  clear_value Fp Fm M
  have hMcard : M.card ≤ 32 := by
    rw [hM]
    exact sourceT4U1MonomialCuts_card_le x
  have hMdata : ∀ d ∈ M, d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
      d.numerator.card + d.denominator.card ≤ 4 ∧ 0 < d.threshold := by
    rw [hM]
    exact sourceT4U1MonomialCuts_data x (zero_lt_one.trans hx1)
  have hprime (p : Fin 4 → ℕ) (hp : p ∈ T) (i : Fin 4) : (p i).Prime :=
    (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).2
  have hbooleanp : ∀ p ∈ T, ∀ q ∈ T,
      (∀ d ∈ M,
        (if d.lower then
          if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
        else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
        (if d.lower then
          if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
        else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
      (Cp p ↔ Cp q) := by
    intro p hp q hq ht
    rw [hCp]
    rw [hM] at ht
    exact (sourceT4U1MonomialCuts_boolean x hx1 p q
      (fun i => (hprime p hp i).pos) (fun i => (hprime q hq i).pos) ht).1
  have hbooleanm : ∀ p ∈ T, ∀ q ∈ T,
      (∀ d ∈ M,
        (if d.lower then
          if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
        else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
        (if d.lower then
          if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
        else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
      (Cm p ↔ Cm q) := by
    intro p hp q hq ht
    rw [hCm]
    rw [hM] at ht
    exact (sourceT4U1MonomialCuts_boolean x hx1 p q
      (fun i => (hprime p hp i).pos) (fun i => (hprime q hq i).pos) ht).2
  have hsupp (p : Fin 4 → ℕ) (hp : p ∈ T)
      (hn : (∏ i, p i) ∈ N) (hw : w p ≠ 0) :
      ∃ S : Finset (Fin 4), S.Nonempty ∧ S ≠ Finset.univ ∧
        x ^ ((40481 : ℝ) / 100000) ≤ ((∏ i ∈ S, p i : ℕ) : ℝ) ∧
        ((∏ i ∈ S, p i : ℕ) : ℝ) ≤ x ^ ((59519 : ℝ) / 100000) :=
    (hgeometry x hxg p (hprime p hp) hn hw).2
  have hsuppp : ∀ p ∈ T, Cp p →
      (∏ i, p i) ∈ N ∧ ∃ S : Finset (Fin 4), S.Nonempty ∧ S ≠ Finset.univ ∧
        x ^ ((40481 : ℝ) / 100000) ≤ ((∏ i ∈ S, p i : ℕ) : ℝ) ∧
        ((∏ i ∈ S, p i : ℕ) : ℝ) ≤ x ^ ((59519 : ℝ) / 100000) := by
    intro p hp hC
    rw [hCp] at hC
    refine ⟨hC.1, hsupp p hp hC.1 ?_⟩
    simp [w, hC.2.1, hC.2.2]
  have hsuppm : ∀ p ∈ T, Cm p →
      (∏ i, p i) ∈ N ∧ ∃ S : Finset (Fin 4), S.Nonempty ∧ S ≠ Finset.univ ∧
        x ^ ((40481 : ℝ) / 100000) ≤ ((∏ i ∈ S, p i : ℕ) : ℝ) ∧
        ((∏ i ∈ S, p i : ℕ) : ℝ) ≤ x ^ ((59519 : ℝ) / 100000) := by
    intro p hp hC
    rw [hCm] at hC
    refine ⟨hC.1, hsupp p hp hC.1 ?_⟩
    simp [w, hC.2.1, hC.2.2]
  have hbp : (∑ q ∈ Q, ‖fullDiscrepancy Fp q a‖) ≤ K * x / (Real.log x) ^ A := by
    rw [hFp]
    exact hbound x hxb Y hY M Cp hMcard hMdata hbooleanp hsuppp I hI a ha
  have hbm : (∑ q ∈ Q, ‖fullDiscrepancy Fm q a‖) ≤ K * x / (Real.log x) ^ A := by
    rw [hFm]
    exact hbound x hxb Y hY M Cm hMcard hMdata hbooleanm hsuppm I hI a ha
  have hF : F = ∑ p ∈ T, Finsupp.single (∏ i, p i)
      (if (∏ i, p i) ∈ N then (w p : ℂ) else 0) := htransport x hxt
  have hdelta (q : ℕ) : fullDiscrepancy F q a =
      fullDiscrepancy Fp q a - fullDiscrepancy Fm q a := by
    rw [hF, hFp, hFm, hCp, hCm]
    exact sourceT4U1_tuple_discrepancy_split x T N q a
  calc
    _ ≤ ∑ q ∈ Q, (‖fullDiscrepancy Fp q a‖ + ‖fullDiscrepancy Fm q a‖) := by
      apply Finset.sum_le_sum
      intro q _hq
      rw [hdelta]
      exact norm_sub_le _ _
    _ = (∑ q ∈ Q, ‖fullDiscrepancy Fp q a‖) +
        ∑ q ∈ Q, ‖fullDiscrepancy Fm q a‖ := Finset.sum_add_distrib
    _ ≤ K * x / (Real.log x) ^ A + K * x / (Real.log x) ^ A := add_le_add hbp hbm
    _ = _ := by ring

section

variable {arity : ℕ}
theorem small_central_box_one_coordinate_scales
    (x : ℝ) (hx : 0 ≤ x) (L U : Fin (arity + 1) → ℝ)
    (hL : ∀ i, 0 < L i) (hLU : ∀ i, L i ≤ U i ∧ U i ≤ (4 / 3 : ℝ) * L i)
    (hprod : (∏ i, L i) ≤ 2 * x) (S : Finset (Fin (arity + 1)))
    (hS : S.Nonempty) (hSne : S ≠ Finset.univ) :
    ∃ R : Finset (Fin (arity + 1)), ∃ Y : Fin (arity + 1) → ℝ,
      (R = S ∨ R = Sᶜ) ∧ R.Nonempty ∧ R ≠ Finset.univ ∧
      (∀ i, L i / 2 ≤ Y i ∧ Y i ≤ L i ∧ U i ≤ 2 * Y i) ∧
      (∏ i, L i) / 2 ≤ ∏ i, Y i ∧ (∏ i, Y i) ≤ ∏ i, L i ∧
      (∏ i ∈ R, L i) / 2 ≤ ∏ i ∈ R, Y i ∧
      (∏ i ∈ R, Y i) ≤ x ^ (1 / 2 : ℝ) := by
  classical
  have hSc : Sᶜ.Nonempty := Finset.nonempty_iff_ne_empty.mpr
    (fun h => hSne ((Finset.compl_eq_empty_iff S).mp h))
  obtain ⟨R, hR, hRn, hRne, hsmall⟩ :
      ∃ R : Finset (Fin (arity + 1)), (R = S ∨ R = Sᶜ) ∧ R.Nonempty ∧
        R ≠ Finset.univ ∧ (∏ i ∈ R, L i) ≤ ∏ i ∈ Rᶜ, L i := by
    by_cases hs : (∏ i ∈ S, L i) ≤ ∏ i ∈ Sᶜ, L i
    · exact ⟨S, Or.inl rfl, hS, hSne, hs⟩
    · refine ⟨Sᶜ, Or.inr rfl, hSc,
        (Finset.compl_ne_univ_iff_nonempty S).mpr hS, ?_⟩
      simpa only [compl_compl] using (le_of_not_ge hs)
  obtain ⟨i, hi⟩ := hRn
  let Y : Fin (arity + 1) → ℝ := Function.update L i (U i / 2)
  have hY (j : Fin (arity + 1)) : L j / 2 ≤ Y j ∧ Y j ≤ L j ∧ U j ≤ 2 * Y j := by
    by_cases hji : j = i
    · subst j
      simp only [Y, Function.update_self]
      constructor
      · linarith [(hLU i).1]
      · constructor <;> nlinarith [(hLU i).2, hL i]
    · simp only [Y, Function.update_of_ne hji]
      exact ⟨by linarith [hL j], le_refl _, by nlinarith [(hLU j).2, hL j]⟩
  have hYpos (j : Fin (arity + 1)) : 0 < Y j :=
    (div_pos (hL j) (by norm_num)).trans_le (hY j).1
  have hblock (T : Finset (Fin (arity + 1))) (hiT : i ∈ T) :
      (∏ j ∈ T, L j) / 2 ≤ ∏ j ∈ T, Y j ∧
        (∏ j ∈ T, Y j) ≤ (2 / 3 : ℝ) * ∏ j ∈ T, L j := by
    have htail : 0 ≤ ∏ j ∈ T \ {i}, L j :=
      Finset.prod_nonneg fun j _ => (hL j).le
    have hlo := mul_le_mul_of_nonneg_right (hLU i).1 htail
    have hhi := mul_le_mul_of_nonneg_right (hLU i).2 htail
    dsimp only [Y]
    rw [Finset.prod_update_of_mem hiT,
      Finset.prod_eq_mul_prod_sdiff_singleton_of_mem hiT L]
    constructor <;> nlinarith
  have hA0 : 0 ≤ ∏ j ∈ R, L j := Finset.prod_nonneg fun j _ => (hL j).le
  have hA2 : (∏ j ∈ R, L j) ^ 2 ≤ 2 * x := by
    calc
      _ = (∏ j ∈ R, L j) * ∏ j ∈ R, L j := by ring
      _ ≤ (∏ j ∈ R, L j) * ∏ j ∈ Rᶜ, L j :=
        mul_le_mul_of_nonneg_left hsmall hA0
      _ = ∏ j, L j := Finset.prod_mul_prod_compl R L
      _ ≤ 2 * x := hprod
  have hN0 : 0 ≤ ∏ j ∈ R, Y j := Finset.prod_nonneg fun j _ => (hYpos j).le
  have hNsq : (∏ j ∈ R, Y j) ^ 2 ≤ x := by
    have hs := (sq_le_sq₀ hN0 (by positivity :
      0 ≤ (2 / 3 : ℝ) * ∏ j ∈ R, L j)).mpr (hblock R hi).2
    nlinarith
  refine ⟨R, Y, hR, ⟨i, hi⟩, hRne, hY,
    (hblock Finset.univ (Finset.mem_univ i)).1, ?_, (hblock R hi).1, ?_⟩
  · exact Finset.prod_le_prod (fun j _ => (hYpos j).le) (fun j _ => (hY j).2.1)
  · rw [← Real.sqrt_eq_rpow]
    exact Real.le_sqrt_of_sq_le hNsq

open Classical in
theorem small_prime_geometric_central_scales (hArity : arity ≤ 3) (τ : ℝ) (hτ : 0 < τ) :
    ∀ᶠ x : ℝ in atTop, ∀ h : ℝ, 0 < h → h ≤ 1 / 4 → ∀ b p : Fin (arity + 1) → ℕ,
      let P : Finset ℕ :=
        (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
          ⌊x ^ ((9 : ℝ) / 10)⌋₊).filter Nat.Prime
      let L (i : Fin (arity + 1)) : ℝ := max (x ^ ((9519 : ℝ) / 50000)) ((1 + h) ^ b i)
      let U (i : Fin (arity + 1)) : ℝ := min (x ^ ((9 : ℝ) / 10))
        ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ)
      (∀ i, p i ∈ P) →
      (∀ i, ⌊Real.logb (1 + h) (p i : ℝ)⌋₊ = b i) →
      (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ →
      ∀ S : Finset (Fin (arity + 1)), S.Nonempty → S ≠ Finset.univ →
        x ^ ((40481 : ℝ) / 100000) ≤ ∏ i ∈ S, (p i : ℝ) →
        (∏ i ∈ S, (p i : ℝ)) ≤ x ^ ((59519 : ℝ) / 100000) →
        ∃ R : Finset (Fin (arity + 1)), ∃ Y : Fin (arity + 1) → ℝ,
          (R = S ∨ R = Sᶜ) ∧ R.Nonempty ∧ R ≠ Finset.univ ∧
          (∀ i, x ^ ((9519 : ℝ) / 100000) ≤ Y i ∧ Y i ≤ x ^ (2 : ℝ)) ∧
          (∀ i, Y i ≤ L i ∧ U i ≤ 2 * Y i) ∧
          x / 64 ≤ ∏ i, Y i ∧ (∏ i, Y i) ≤ 64 * x ∧
          x ^ ((40481 : ℝ) / 100000 - τ) ≤ ∏ i ∈ R, Y i ∧
          (∏ i ∈ R, Y i) ≤ x ^ (1 / 2 : ℝ) := by
  filter_upwards [eventually_ge_atTop (2 : ℝ),
    (tendsto_rpow_atTop hτ).eventually (eventually_ge_atTop (64 : ℝ)),
    (tendsto_rpow_atTop (by norm_num : (0 : ℝ) < 9519 / 100000)).eventually
      (eventually_ge_atTop (2 : ℝ))] with x hx hxτ hxξ
  intro h hh hh4 b p P L U hp hlabel hprod S hSnon hSne hcentralLo hcentralHi
  have hx1 : 1 ≤ x := by linarith
  have hx0 : 0 < x := by linarith
  have hbase : 0 < 1 + h := by linarith
  have hscales := small_prime_geometric_active_scales hArity x h hx hh (by linarith)
    b p hp hlabel hprod
  have hLpos (i : Fin (arity + 1)) : 0 < L i :=
    (Real.rpow_pos_of_pos hx0 _).trans_le (le_max_left _ _)
  have hpLU (i : Fin (arity + 1)) : L i ≤ (p i : ℝ) ∧ (p i : ℝ) ≤ U i := by
    have hm : p i ∈ P.filter (fun n : ℕ => ⌊Real.logb (1 + h) (n : ℝ)⌋₊ = b i) :=
      Finset.mem_filter.mpr ⟨hp i, hlabel i⟩
    rw [small_prime_geometric_bin_eq_closed_interval x h hx0 hh (b i)] at hm
    have hm' := Finset.mem_Icc.mp (Finset.mem_filter.mp hm).1
    exact ⟨Nat.le_of_ceil_le hm'.1,
      (Nat.cast_le.mpr hm'.2).trans (Nat.floor_le (by positivity))⟩
  have hUnarrow (i : Fin (arity + 1)) : U i ≤ (4 / 3 : ℝ) * L i := by
    have hceil : 0 < ⌈(1 + h) ^ (b i + 1)⌉₊ :=
      Nat.ceil_pos.mpr (pow_pos hbase _)
    have htop : ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ) <
        (1 + h) ^ (b i + 1) := Nat.lt_ceil.mp (by omega)
    calc
      U i ≤ ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ) := min_le_right _ _
      _ ≤ (1 + h) ^ (b i + 1) := htop.le
      _ = (1 + h) * (1 + h) ^ b i := by rw [pow_succ]; ring
      _ ≤ (4 / 3 : ℝ) * L i := mul_le_mul (by linarith) (le_max_right _ _)
        (pow_nonneg hbase.le _) (by norm_num)
  have hsubcompare (T : Finset (Fin (arity + 1))) :
      (∏ i ∈ T, (p i : ℝ)) ≤ 32 * ∏ i ∈ T, L i := by
    have hT : T.card ≤ 5 := by
      have ht : T.card ≤ arity + 1 := by
        simpa using (Finset.card_le_card (Finset.subset_univ T))
      omega
    have hpow : (2 : ℝ) ^ T.card ≤ 32 := by
      calc
        _ ≤ (2 : ℝ) ^ 5 := pow_le_pow_right₀ (by norm_num) hT
        _ = 32 := by norm_num
    calc
      _ ≤ ∏ i ∈ T, 2 * L i := Finset.prod_le_prod (fun _ _ => Nat.cast_nonneg _)
        (fun i _ => (hpLU i).2.trans (hscales.1 i).2.2)
      _ = (2 : ℝ) ^ T.card * ∏ i ∈ T, L i := by
        rw [Finset.prod_mul_distrib, Finset.prod_const]
      _ ≤ 32 * ∏ i ∈ T, L i := mul_le_mul_of_nonneg_right hpow
        (Finset.prod_nonneg fun i _ => (hLpos i).le)
  have hpfull : x ≤ ∏ i, (p i : ℝ) := by
    exact_mod_cast Nat.le_of_ceil_le (Finset.mem_Icc.mp hprod).1
  have hpower : x ^ ((59519 : ℝ) / 100000) * x ^ ((40481 : ℝ) / 100000) = x := by
    rw [← Real.rpow_add hx0]
    norm_num
  have hcomp : x ^ ((40481 : ℝ) / 100000) ≤ ∏ i ∈ Sᶜ, (p i : ℝ) := by
    apply le_of_mul_le_mul_left (a := x ^ ((59519 : ℝ) / 100000))
      ?_ (Real.rpow_pos_of_pos hx0 _)
    calc
      _ = x := hpower
      _ ≤ ∏ i, (p i : ℝ) := hpfull
      _ = (∏ i ∈ S, (p i : ℝ)) * ∏ i ∈ Sᶜ, (p i : ℝ) :=
        (Finset.prod_mul_prod_compl S (fun i => (p i : ℝ))).symm
      _ ≤ x ^ ((59519 : ℝ) / 100000) * ∏ i ∈ Sᶜ, (p i : ℝ) :=
        mul_le_mul_of_nonneg_right hcentralHi (Finset.prod_nonneg fun _ _ => Nat.cast_nonneg _)
  obtain ⟨R, Y, hR, hRn, hRne, hY, hprodLo, hprodHi, hblockLo, hblockHi⟩ :=
    small_central_box_one_coordinate_scales x hx0.le L U hLpos
      (fun i => ⟨(hpLU i).1.trans (hpLU i).2, hUnarrow i⟩)
      hscales.2.2 S hSnon hSne
  have hRlower : x ^ ((40481 : ℝ) / 100000) / 32 ≤ ∏ i ∈ R, L i := by
    rcases hR with hRS | hRS
    · rw [hRS]
      linarith [hsubcompare S]
    · rw [hRS]
      linarith [hsubcompare Sᶜ]
  refine ⟨R, Y, hR, hRn, hRne, ?_, (fun i => (hY i).2), ?_, ?_, ?_, hblockHi⟩
  · intro i
    constructor
    · have hξpos : 0 < x ^ ((9519 : ℝ) / 100000) := Real.rpow_pos_of_pos hx0 _
      have hξsq : x ^ ((9519 : ℝ) / 50000) =
          x ^ ((9519 : ℝ) / 100000) * x ^ ((9519 : ℝ) / 100000) := by
        rw [← Real.rpow_add hx0]
        congr 1
        norm_num
      have hξL : x ^ ((9519 : ℝ) / 50000) ≤ L i := le_max_left _ _
      have hξmul := mul_le_mul_of_nonneg_right hxξ hξpos.le
      nlinarith [(hY i).1]
    · exact (hY i).2.1.trans ((hscales.1 i).2.1.trans
        ((min_le_left _ _).trans (Real.rpow_le_rpow_of_exponent_le hx1 (by norm_num))))
  · linarith [hscales.2.1]
  · linarith [hscales.2.2]
  · rw [Real.rpow_sub hx0]
    exact (div_le_div_of_nonneg_left (Real.rpow_pos_of_pos hx0 _).le
      (by norm_num : (0 : ℝ) < 64) hxτ).trans (by linarith)

theorem geometric_small_box_product_bound (hArity : arity ≤ 3) (h x : ℝ) (hh : 0 < h) (hh1 : h ≤ 1)
    (p q : Fin (arity + 1) → ℕ) (hp : ∀ i, 1 ≤ p i) (hq : ∀ i, 1 ≤ q i)
    (hlabel : ∀ i, ⌊Real.logb (1 + h) (p i : ℝ)⌋₊ =
      ⌊Real.logb (1 + h) (q i : ℝ)⌋₊)
    (hprod : ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x) :
    ((∏ i, q i : ℕ) : ℝ) ≤ 64 * x := by
  have hp0 : 0 ≤ ∏ i, (p i : ℝ) := Finset.prod_nonneg fun _ _ => Nat.cast_nonneg _
  have hprod' : (∏ i, (p i : ℝ)) ≤ 2 * x := by exact_mod_cast hprod
  have hratio : (∏ i, (q i : ℝ)) ≤ (1 + h) ^ (arity + 1) * ∏ i, (p i : ℝ) := by
    calc
      _ ≤ ∏ i, ((1 + h) * p i) :=
        Finset.prod_le_prod (fun _ _ => Nat.cast_nonneg _)
          (fun i _ => (geometric_bin_pair_ratios h hh (p i) (q i)
            (hp i) (hq i) (hlabel i)).2)
      _ = _ := by rw [Finset.prod_mul_distrib]; simp
  have hpow : (1 + h) ^ (arity + 1) ≤ (32 : ℝ) := by
    calc
      (1 + h) ^ (arity + 1) ≤ (2 : ℝ) ^ (arity + 1) :=
        pow_le_pow_left₀ (by positivity) (by linarith) _
      _ ≤ 2 ^ 5 := pow_le_pow_right₀ (by norm_num) (by omega)
      _ = 32 := by norm_num
  have := hratio.trans (mul_le_mul_of_nonneg_right hpow hp0)
  exact_mod_cast this.trans (by nlinarith only [hprod'])

theorem finite_small_tuple_monomial_boundary_count (hArity : arity ≤ 3)
    (x η : ℝ) (hx : 2 ≤ x) (hη : 0 ≤ η) (i : Fin (arity + 1))
    (S : Finset (Fin (arity + 1) → ℕ)) (L U : (Fin arity → ℕ) → ℝ)
    (hS : ∀ t ∈ S,
      (∀ j, x ^ ((9519 : ℝ) / 50000) ≤ (t j : ℝ)) ∧
        ((∏ j, t j : ℕ) : ℝ) ≤ 64 * x ∧
        L (Fin.removeNth i t) ≤ (t i : ℝ) ∧
        (t i : ℝ) ≤ U (Fin.removeNth i t))
    (hwidth : ∀ r : Fin arity → ℕ, (∀ j, 0 < r j) →
      ((∏ j, r j : ℕ) : ℝ) ≤ 64 * x / x ^ ((9519 : ℝ) / 50000) →
        U r - L r ≤ η * (64 * x / ((∏ j, r j : ℕ) : ℝ))) :
    (S.card : ℝ) ≤
      64 * (η * x + x ^ (1 - (9519 : ℝ) / 50000)) *
        (1 + Real.log (64 * x)) ^ 16 := by
  classical
  let ξ : ℝ := 9519 / 50000
  let Z : ℝ := 64 * x
  let Y : ℝ := Z / x ^ ξ
  let N : ℕ := ⌊Y⌋₊
  let R : Finset (Fin arity → ℕ) := S.image (Fin.removeNth i)
  let H : ℝ := 1 + Real.log Z
  have hx1 : 1 ≤ x := (by norm_num : (1 : ℝ) ≤ 2).trans hx
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hξ0 : 0 ≤ ξ := by norm_num [ξ]
  have hξ1 : ξ ≤ 1 := by norm_num [ξ]
  have hxξ : 1 ≤ x ^ ξ := Real.one_le_rpow hx1 hξ0
  have hxξ0 : 0 < x ^ ξ := Real.rpow_pos_of_pos hx0 ξ
  have hZ : 0 < Z := by dsimp [Z]; positivity
  have hY1 : 1 ≤ Y := by
    apply (le_div_iff₀ hxξ0).mpr
    have hpow := Real.rpow_le_self_of_one_le hx1 hξ1
    dsimp [Z]
    linarith
  have hY0 : 0 ≤ Y := zero_le_one.trans hY1
  have hYZ : Y ≤ Z := div_le_self hZ.le hxξ
  have hN1 : 1 ≤ N := Nat.le_floor (by simpa only [Nat.cast_one] using hY1)
  have hNY : (N : ℝ) ≤ Y := Nat.floor_le hY0
  have hNZ : (N : ℝ) ≤ Z := hNY.trans hYZ
  have hH1 : 1 ≤ H := by
    have hZ1 : 1 ≤ Z := (by exact_mod_cast hN1 : (1 : ℝ) ≤ N).trans hNZ
    exact le_add_of_nonneg_right (Real.log_nonneg hZ1)
  have hlogN0 : 0 ≤ 1 + Real.log (N : ℝ) := by
    have hN1r : (1 : ℝ) ≤ N := by exact_mod_cast hN1
    positivity
  have hlogNZ : 1 + Real.log (N : ℝ) ≤ H := by
    exact add_le_add (le_refl 1)
      (Real.log_le_log (by exact_mod_cast hN1 : (0 : ℝ) < N) hNZ)
  have hpositive (t : Fin (arity + 1) → ℕ) (ht : t ∈ S) (j : Fin (arity + 1)) : 0 < t j :=
    Nat.cast_pos.mp (hxξ0.trans_le ((hS t ht).1 j))
  have hR (r : Fin arity → ℕ) (hr : r ∈ R) :
      (∀ j, 0 < r j) ∧ ((∏ j, r j : ℕ) : ℝ) ≤ Y := by
    obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hr
    refine ⟨fun j => hpositive t ht (i.succAbove j), ?_⟩
    have hprod : (t i : ℝ) * ((∏ j, Fin.removeNth i t j : ℕ) : ℝ) =
        ((∏ j, t j : ℕ) : ℝ) := by
      exact_mod_cast Fin.mul_prod_removeNth i t
    apply (le_div_iff₀ hxξ0).mpr
    calc
      _ ≤ (t i : ℝ) * ((∏ j, Fin.removeNth i t j : ℕ) : ℝ) := by
        have hti : x ^ ξ ≤ (t i : ℝ) := (hS t ht).1 i
        exact (mul_le_mul_of_nonneg_left hti
          (Nat.cast_nonneg (∏ j, Fin.removeNth i t j))).trans_eq (mul_comm _ _)
      _ ≤ Z := hprod ▸ (hS t ht).2.1
  have hRnat : ∀ r ∈ R, (∀ j, 0 < r j) ∧ (∏ j, r j) ≤ N := by
    intro r hr
    exact ⟨(hR r hr).1, Nat.le_floor (hR r hr).2⟩
  obtain ⟨hRcard, hRrec⟩ := finite_positive_tuple_product_moments arity N R hRnat
  have hmoment : 2 ^ arity ≤ (8 : ℕ) :=
    (Nat.pow_le_pow_right (by norm_num : 0 < 2) hArity).trans_eq (by norm_num)
  have hRcard' : (R.card : ℝ) ≤ Y * H ^ 15 := by
    refine hRcard.trans ?_
    exact mul_le_mul hNY
      ((pow_le_pow_left₀ hlogN0 hlogNZ (2 ^ arity - 1)).trans
        (pow_le_pow_right₀ hH1 (by omega)))
      (pow_nonneg hlogN0 _) hY0
  have hRrec' : (∑ r ∈ R, 1 / ((∏ j, r j : ℕ) : ℝ)) ≤ H ^ 16 := by
    refine hRrec.trans ?_
    exact (pow_le_pow_left₀ hlogN0 hlogNZ (2 ^ arity)).trans
      (pow_le_pow_right₀ hH1 (by omega))
  have hfiber (r : Fin arity → ℕ) (hr : r ∈ R) :
      ((S.filter (fun t => Fin.removeNth i t = r)).card : ℝ) ≤
        η * (Z / ((∏ j, r j : ℕ) : ℝ)) + 1 := by
    let T := S.filter (fun t => Fin.removeNth i t = r)
    have hinj : Set.InjOn (fun t : Fin (arity + 1) → ℕ => t i) T := by
      intro t ht u hu htu
      change t i = u i at htu
      have htR := (Finset.mem_filter.mp ht).2
      have huR := (Finset.mem_filter.mp hu).2
      calc
        t = Fin.insertNth i (t i) (Fin.removeNth i t) :=
          (Fin.insertNth_self_removeNth i t).symm
        _ = Fin.insertNth i (u i) (Fin.removeNth i u) := by rw [htR, huR, htu]
        _ = u := Fin.insertNth_self_removeNth i u
    have hcard : (T.image (fun t => t i)).card = T.card :=
      Finset.card_image_of_injOn hinj
    rw [← hcard]
    apply finite_nat_closed_band_card_le _ (L r) (U r) _ (by positivity)
    · intro n hn
      obtain ⟨t, ht, rfl⟩ := Finset.mem_image.mp hn
      obtain ⟨htS, htr⟩ := Finset.mem_filter.mp ht
      simpa only [htr] using (hS t htS).2.2
    · exact hwidth r (hR r hr).1 (hR r hr).2
  have hcount : (S.card : ℝ) ≤
      η * Z * (∑ r ∈ R, 1 / ((∏ j, r j : ℕ) : ℝ)) + (R.card : ℝ) := by
    calc
      _ = ∑ r ∈ R, ((S.filter (fun t => Fin.removeNth i t = r)).card : ℝ) := by
        exact_mod_cast Finset.card_eq_sum_card_image (Fin.removeNth i) S
      _ ≤ ∑ r ∈ R, (η * (Z / ((∏ j, r j : ℕ) : ℝ)) + 1) :=
        Finset.sum_le_sum hfiber
      _ = _ := by
        simp only [Finset.sum_add_distrib, Finset.mul_sum, Finset.sum_const,
          nsmul_eq_mul, mul_one, div_eq_mul_inv, one_mul, mul_assoc]
  have hYeq : Y = 64 * x ^ (1 - ξ) := by
    dsimp [Y, Z]
    rw [Real.rpow_sub hx0, Real.rpow_one]
    ring
  have hHpow : H ^ 15 ≤ H ^ 16 := by
    exact pow_le_pow_right₀ hH1 (by norm_num)
  calc
    _ ≤ η * Z * H ^ 16 + Y * H ^ 15 :=
      hcount.trans (add_le_add
        (mul_le_mul_of_nonneg_left hRrec' (mul_nonneg hη hZ.le)) hRcard')
    _ ≤ η * Z * H ^ 16 + Y * H ^ 16 :=
      add_le_add (le_refl _) (mul_le_mul_of_nonneg_left hHpow hY0)
    _ = _ := by rw [hYeq]; dsimp [Z, H, ξ]; ring

theorem geometric_small_monomial_comparison (h : ℝ) (hh : 0 < h)
    (p q : Fin (arity + 1) → ℕ) (hp : ∀ i, 1 ≤ p i) (hq : ∀ i, 1 ≤ q i)
    (hlabel : ∀ i, ⌊Real.logb (1 + h) (p i : ℝ)⌋₊ =
      ⌊Real.logb (1 + h) (q i : ℝ)⌋₊)
    (d : MinorantSmallMonomialCut (arity + 1)) :
    d.value p ≤ (1 + h) ^ (d.numerator.card + d.denominator.card) * d.value q ∧
    d.value q ≤ (1 + h) ^ (d.numerator.card + d.denominator.card) * d.value p := by
  have one_way (p q : Fin (arity + 1) → ℕ) (hp : ∀ i, 1 ≤ p i) (hq : ∀ i, 1 ≤ q i)
      (hlab : ∀ i, ⌊Real.logb (1 + h) (p i : ℝ)⌋₊ =
        ⌊Real.logb (1 + h) (q i : ℝ)⌋₊) :
      d.value p ≤ (1 + h) ^ (d.numerator.card + d.denominator.card) * d.value q := by
    have hp0 (i : Fin (arity + 1)) : 0 < (p i : ℝ) := by exact_mod_cast hp i
    have hq0 (i : Fin (arity + 1)) : 0 < (q i : ℝ) := by exact_mod_cast hq i
    have hnum : (∏ i ∈ d.numerator, (p i : ℝ)) ≤
        (1 + h) ^ d.numerator.card * ∏ i ∈ d.numerator, (q i : ℝ) := by
      calc
        _ ≤ ∏ i ∈ d.numerator, ((1 + h) * q i) :=
          Finset.prod_le_prod (fun i _ => (hp0 i).le)
            (fun i _ => (geometric_bin_pair_ratios h hh (p i) (q i)
              (hp i) (hq i) (hlab i)).1)
        _ = _ := by rw [Finset.prod_mul_distrib, Finset.prod_const]
    have hden : (∏ i ∈ d.denominator, (q i : ℝ)) ≤
        (1 + h) ^ d.denominator.card * ∏ i ∈ d.denominator, (p i : ℝ) := by
      calc
        _ ≤ ∏ i ∈ d.denominator, ((1 + h) * p i) :=
          Finset.prod_le_prod (fun i _ => (hq0 i).le)
            (fun i _ => (geometric_bin_pair_ratios h hh (p i) (q i)
              (hp i) (hq i) (hlab i)).2)
        _ = _ := by rw [Finset.prod_mul_distrib, Finset.prod_const]
    have hpd : 0 < ∏ i ∈ d.denominator, (p i : ℝ) :=
      Finset.prod_pos fun i _ => hp0 i
    have hqd : 0 < ∏ i ∈ d.denominator, (q i : ℝ) :=
      Finset.prod_pos fun i _ => hq0 i
    dsimp [MinorantSmallMonomialCut.value]
    rw [pow_add, ← mul_div_assoc, div_le_div_iff₀ hpd hqd]
    calc
      _ ≤ ((1 + h) ^ d.numerator.card * ∏ i ∈ d.numerator, (q i : ℝ)) *
          ((1 + h) ^ d.denominator.card * ∏ i ∈ d.denominator, (p i : ℝ)) :=
        mul_le_mul hnum hden hqd.le (by positivity)
      _ = _ := by ring
  exact ⟨one_way p q hp hq hlabel, one_way q p hq hp (fun i => (hlabel i).symm)⟩

theorem MinorantSmallMonomialCut.value_insertNth_factor (d : MinorantSmallMonomialCut (arity + 1))
    (i : Fin (arity + 1)) (hi : i ∈ d.numerator) (hid : i ∉ d.denominator)
    (p : Fin (arity + 1) → ℕ) :
    d.value p = (p i : ℝ) * d.value (i.insertNth 1 (i.removeNth p)) := by
  classical
  rw [Fin.insertNth_removeNth]
  simp only [MinorantSmallMonomialCut.value,
    Function.apply_update (fun (_ : Fin (arity + 1)) (n : ℕ) => (n : ℝ)), Nat.cast_one]
  rw [Finset.prod_update_of_mem hi, Finset.prod_update_of_notMem hid,
    one_mul, Finset.sdiff_singleton_eq_erase, ← Finset.mul_prod_erase _ _ hi]
  ring

theorem MinorantSmallMonomialCut.closed_coordinate_band (d : MinorantSmallMonomialCut (arity + 1))
    (i : Fin (arity + 1)) (hi : i ∈ d.numerator) (hid : i ∉ d.denominator)
    (p : Fin (arity + 1) → ℕ) (hp : ∀ k, 0 < p k) (R Z : ℝ) (hR : 0 < R)
    (hsupport : (p i : ℝ) ≤ Z)
    (hband : d.threshold / R ≤ d.value p ∧ d.value p ≤ d.threshold * R) :
    let t := d.threshold / d.value (i.insertNth 1 (i.removeNth p))
    t / R ≤ (p i : ℝ) ∧ (p i : ℝ) ≤ min (t * R) Z := by
  intro t
  have hbase : ∀ k : Fin (arity + 1), 0 < (i.insertNth 1 (i.removeNth p) k : ℝ) := by
    rw [Fin.insertNth_removeNth,
      Function.forall_update_iff p (fun _ (n : ℕ) => 0 < (n : ℝ))]
    exact ⟨by norm_num, fun k _ => Nat.cast_pos.mpr (hp k)⟩
  have hv : 0 < d.value (i.insertNth 1 (i.removeNth p)) :=
    div_pos (Finset.prod_pos fun k _ => hbase k) (Finset.prod_pos fun k _ => hbase k)
  rw [d.value_insertNth_factor i hi hid p] at hband
  constructor
  · dsimp [t]
    rw [div_div, div_le_iff₀ (mul_pos hv hR)]
    have hh := (div_le_iff₀ hR).mp hband.1
    nlinarith only [hh]
  · apply le_min _ hsupport
    dsimp [t]
    rw [div_mul_eq_mul_div, le_div_iff₀ hv]
    exact hband.2

theorem geometric_small_monomial_test_crossing
    (h : ℝ) (hh : 0 < h) (d : MinorantSmallMonomialCut (arity + 1)) (hd : 0 ≤ d.threshold)
    (p q : Fin (arity + 1) → ℕ) (hp : ∀ i, 1 ≤ p i) (hq : ∀ i, 1 ≤ q i)
    (hlabel : ∀ i, ⌊Real.logb (1 + h) (p i : ℝ)⌋₊ =
      ⌊Real.logb (1 + h) (q i : ℝ)⌋₊)
    (hchange : ¬((if d.lower then
        if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
      else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
      (if d.lower then
        if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
      else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold))) :
    (d.threshold / (1 + h) ^ (d.numerator.card + d.denominator.card) ≤ d.value p ∧
      d.value p ≤ d.threshold * (1 + h) ^ (d.numerator.card + d.denominator.card)) ∧
    (d.threshold / (1 + h) ^ (d.numerator.card + d.denominator.card) ≤ d.value q ∧
      d.value q ≤ d.threshold * (1 + h) ^ (d.numerator.card + d.denominator.card)) := by
  have hcompare := geometric_small_monomial_comparison h hh p q hp hq hlabel d
  apply threshold_bands_of_crossing _ _ _ _ hd
    (one_le_pow₀ (by linarith)) hcompare.1 hcompare.2
  rw [not_iff, iff_iff_and_or_not_and_not] at hchange
  cases hl : d.lower <;> cases hs : d.strict <;>
    simp only [hl, hs, Bool.false_eq_true, ite_false, ite_true,
      not_le, not_lt] at hchange <;>
    rcases hchange with ⟨hp, hq⟩ | ⟨hp, hq⟩ <;>
    first | exact Or.inl ⟨by linarith, by linarith⟩
          | exact Or.inr ⟨by linarith, by linarith⟩

open Classical in
theorem boolean_small_monomial_mixed_geometric_box_card (hArity : arity ≤ 3)
    (x h : ℝ) (hx : 2 ≤ x) (hh : 0 < h) (hh1 : h ≤ 1)
    (M : Finset (MinorantSmallMonomialCut (arity + 1))) (C : (Fin (arity + 1) → ℕ) → Prop)
    (hM : ∀ d ∈ M, d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
      d.numerator.card + d.denominator.card ≤ arity + 1 ∧ 0 < d.threshold) :
    let P : Finset ℕ :=
      (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
        ⌊x ^ ((9 : ℝ) / 10)⌋₊).filter Nat.Prime
    let T := Fintype.piFinset (fun _ : Fin (arity + 1) => P)
    (∀ p ∈ T, ∀ q ∈ T,
      (∀ d ∈ M,
        (if d.lower then
          if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
        else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
        (if d.lower then
          if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
        else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
      (C p ↔ C q)) →
    (∀ p ∈ T, C p → ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x) →
    let label (p : Fin (arity + 1) → ℕ) : Fin (arity + 1) → ℕ :=
      fun i => ⌊Real.logb (1 + h) (p i : ℝ)⌋₊
    let U (b : Fin (arity + 1) → ℕ) := T.filter (fun p => label p = b)
    let D := (T.image label).filter
      (fun b => (∃ p ∈ U b, C p) ∧ ¬∀ p ∈ U b, C p)
    (∑ b ∈ D, ((U b).card : ℝ)) ≤
      (M.card : ℝ) * 64 *
        (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
          (1 + Real.log (64 * x)) ^ 16 := by
  intro P T hboolean hsupport label U D
  let S := T.filter (fun q => label q ∈ D)
  let R (d : MinorantSmallMonomialCut (arity + 1)) : ℝ := (1 + h) ^
    (d.numerator.card + d.denominator.card)
  let E (d : MinorantSmallMonomialCut (arity + 1)) := S.filter
    (fun q => d.threshold / R d ≤ d.value q ∧ d.value q ≤ d.threshold * R d)
  let V : ℝ := 64 * (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
    (1 + Real.log (64 * x)) ^ 16
  have hpositive (p : Fin (arity + 1) → ℕ) (hp : p ∈ T) (i : Fin (arity + 1)) : 1 ≤ p i := by
    have hprime : (p i).Prime :=
      (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).2
    exact hprime.one_lt.le
  have hlower (p : Fin (arity + 1) → ℕ) (hp : p ∈ T) (i : Fin (arity + 1)) :
      x ^ ((9519 : ℝ) / 50000) ≤ (p i : ℝ) := by
    have hnat := (Finset.mem_Icc.mp
      (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).1).1
    exact (Nat.le_ceil _).trans (Nat.cast_le.mpr hnat)
  have hchanged (p q : Fin (arity + 1) → ℕ) (hp : p ∈ T) (hq : q ∈ T)
      (hlab : ∀ i, ⌊Real.logb (1 + h) (p i : ℝ)⌋₊ =
        ⌊Real.logb (1 + h) (q i : ℝ)⌋₊) (hpass : C p) (hfail : ¬C q) :
      ∃ d ∈ M,
        (d.threshold / R d ≤ d.value p ∧ d.value p ≤ d.threshold * R d) ∧
        (d.threshold / R d ≤ d.value q ∧ d.value q ≤ d.threshold * R d) := by
    have hex : ∃ d ∈ M, ¬((if d.lower then
          if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
        else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
        (if d.lower then
          if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
        else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) := by
      by_contra! hnone
      exact hfail ((hboolean p hp q hq hnone).mp hpass)
    obtain ⟨d, hd, hchange⟩ := hex
    exact ⟨d, hd, geometric_small_monomial_test_crossing h hh d (hM d hd).2.2.2.le
      p q (hpositive p hp) (hpositive q hq) hlab hchange⟩
  have hboundary (q : Fin (arity + 1) → ℕ) (hq : q ∈ S) :
      ((∏ i, q i : ℕ) : ℝ) ≤ 64 * x ∧
        ∃ d ∈ M, d.threshold / R d ≤ d.value q ∧ d.value q ≤ d.threshold * R d := by
    obtain ⟨hqT, hqD⟩ := Finset.mem_filter.mp hq
    have hmix := (Finset.mem_filter.mp hqD).2
    obtain ⟨p₀, hp₀, hpass⟩ := hmix.1
    have hex : ∃ p₁ ∈ U (label q), ¬C p₁ := by
      simpa only [not_forall, exists_prop] using hmix.2
    obtain ⟨p₁, hp₁, hfail⟩ := hex
    have hp₀T : p₀ ∈ T := (Finset.mem_filter.mp hp₀).1
    have hp₁T : p₁ ∈ T := (Finset.mem_filter.mp hp₁).1
    have hlab₀ (i : Fin (arity + 1)) :
        ⌊Real.logb (1 + h) (p₀ i : ℝ)⌋₊ =
          ⌊Real.logb (1 + h) (q i : ℝ)⌋₊ :=
      congrFun (Finset.mem_filter.mp hp₀).2 i
    have hlab₁ (i : Fin (arity + 1)) :
        ⌊Real.logb (1 + h) (p₁ i : ℝ)⌋₊ =
          ⌊Real.logb (1 + h) (q i : ℝ)⌋₊ :=
      congrFun (Finset.mem_filter.mp hp₁).2 i
    refine ⟨geometric_small_box_product_bound hArity h x hh hh1 p₀ q
      (hpositive p₀ hp₀T) (hpositive q hqT) hlab₀ (hsupport p₀ hp₀T hpass), ?_⟩
    by_cases hqpass : C q
    · obtain ⟨d, hd, hb, _⟩ := hchanged q p₁ hqT hp₁T
        (fun i => (hlab₁ i).symm) hqpass hfail
      exact ⟨d, hd, hb⟩
    · obtain ⟨d, hd, _, hb⟩ := hchanged p₀ q hp₀T hqT hlab₀ hpass hqpass
      exact ⟨d, hd, hb⟩
  have hE (d : MinorantSmallMonomialCut (arity + 1)) (hd : d ∈ M) : ((E d).card : ℝ) ≤ V := by
    have hdata := hM d hd
    obtain ⟨i, hi⟩ := hdata.1
    have hid : i ∉ d.denominator := fun hb => Finset.disjoint_left.mp hdata.2.1 hi hb
    have hR : 1 ≤ R d := one_le_pow₀ (by linarith)
    have hR0 : 0 < R d := zero_lt_one.trans_le hR
    let t (r : Fin arity → ℕ) := d.threshold / d.value (i.insertNth 1 r)
    let L (r : Fin arity → ℕ) := t r / R d
    let U₀ (r : Fin arity → ℕ) := min (t r * R d) (64 * x / ((∏ k, r k : ℕ) : ℝ))
    have hwidth (r : Fin arity → ℕ) (hr : ∀ k, 0 < r k) :
        U₀ r - L r ≤ (1023 * h) * (64 * x / ((∏ k, r k : ℕ) : ℝ)) := by
      have hbase : ∀ k : Fin (arity + 1),
          0 < ((Fin.insertNth (α := fun _ : Fin (arity + 1) => ℕ) i 1 r k : ℕ) : ℝ) := by
        rw [Fin.forall_iff_succAbove i]
        simpa using hr
      have ht : 0 ≤ t r :=
        div_nonneg hdata.2.2.2.le
          (div_nonneg (Finset.prod_nonneg fun k _ => (hbase k).le)
            (Finset.prod_nonneg fun k _ => (hbase k).le))
      have hZ : 0 ≤ 64 * x / ((∏ k, r k : ℕ) : ℝ) := by positivity
      exact (monomial_clipped_band_width (t r) (R d) _ ht hR hZ).trans
        (mul_le_mul_of_nonneg_right
          (geometric_degree_five_width h hh.le hh1 _
            (hdata.2.2.1.trans (by omega))) hZ)
    apply finite_small_tuple_monomial_boundary_count hArity x (1023 * h) hx (by positivity)
      i (E d) L U₀
    · intro q hq
      obtain ⟨hqS, hband⟩ := Finset.mem_filter.mp hq
      have hqT := (Finset.mem_filter.mp hqS).1
      have hco : 0 < ((∏ k, i.removeNth q k : ℕ) : ℝ) := by
        exact_mod_cast Finset.prod_pos fun k _ =>
          zero_lt_one.trans_le (hpositive q hqT (i.succAbove k))
      have hsupport : (q i : ℝ) ≤ 64 * x / ((∏ k, i.removeNth q k : ℕ) : ℝ) := by
        rw [le_div_iff₀ hco]
        have heq : (q i : ℝ) * ((∏ k, i.removeNth q k : ℕ) : ℝ) =
            ((∏ k, q k : ℕ) : ℝ) := by exact_mod_cast Fin.mul_prod_removeNth i q
        rw [heq]
        exact (hboundary q hqS).1
      exact ⟨hlower q hqT, (hboundary q hqS).1,
        d.closed_coordinate_band i hi hid q
          (fun k => zero_lt_one.trans_le (hpositive q hqT k))
          (R d) _ hR0 hsupport hband⟩
    · intro r hr _hprod
      exact hwidth r hr
  have hcover : S ⊆ M.biUnion E := by
    intro q hq
    obtain ⟨d, hd, hband⟩ := (hboundary q hq).2
    exact Finset.mem_biUnion.mpr ⟨d, hd, Finset.mem_filter.mpr ⟨hq, hband⟩⟩
  have hcard : (S.card : ℝ) = ∑ b ∈ D, ((U b).card : ℝ) := by
    have hc : S.card = ∑ b ∈ D, (U b).card := by
      calc
        _ = ∑ b ∈ D, (S.filter (fun q => label q = b)).card :=
          Finset.card_eq_sum_card_fiberwise (fun q hq => (Finset.mem_filter.mp hq).2)
        _ = _ := by
          apply Finset.sum_congr rfl
          intro b hb
          congr 1
          ext q
          by_cases heq : label q = b <;> simp [S, U, heq, hb]
    exact_mod_cast hc
  rw [← hcard]
  calc
    _ ≤ ∑ d ∈ M, ((E d).card : ℝ) := by
      exact_mod_cast (Finset.card_le_card hcover).trans Finset.card_biUnion_le
    _ ≤ ∑ _d ∈ M, V := Finset.sum_le_sum hE
    _ = (M.card : ℝ) * V := by simp
    _ = _ := by dsimp [V]; ring

end

section

variable {arity : ℕ}
open Classical in
theorem central_small_prime_boolean_cut_coherent_log_saving (hArity : arity ≤ 3)
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : ℕ) («ω» δ σ : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ)
    (hσgap : (1 / 2 : ℝ) - 40481 / 100000 < σ)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ M : Finset (MinorantSmallMonomialCut (arity + 1)), ∀ C : (Fin (arity + 1) → ℕ) → Prop,
      M.card ≤ 32 →
      (∀ d ∈ M, d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
        d.numerator.card + d.denominator.card ≤ arity + 1 ∧ 0 < d.threshold) →
      let P : Finset ℕ :=
        (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
          ⌊x ^ ((9 : ℝ) / 10)⌋₊).filter Nat.Prime
      let T := Fintype.piFinset (fun _ : Fin (arity + 1) => P)
      (∀ p ∈ T, ∀ q ∈ T,
        (∀ d ∈ M,
          (if d.lower then
            if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
          else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
          (if d.lower then
            if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
          else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
        (C p ↔ C q)) →
      (∀ p ∈ T, C p →
        (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧
        ∃ S : Finset (Fin (arity + 1)), S.Nonempty ∧ S ≠ Finset.univ ∧
          x ^ ((40481 : ℝ) / 100000) ≤ ((∏ i ∈ S, p i : ℕ) : ℝ) ∧
          ((∏ i ∈ S, p i : ℕ) : ℝ) ≤ x ^ ((59519 : ℝ) / 100000)) →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let F : ℕ →₀ ℂ :=
          ∑ p ∈ T, Finsupp.single (∏ i, p i) (if C p then 1 else 0)
        let Q := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
          q ∣ (∏ p ∈ I, p) ∧
            Nonempty (DenseDivisibilityWitness
              ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ j q))
        (∑ q ∈ Q, ‖fullDiscrepancy F q a‖) ≤ K * x / (Real.log x) ^ A := by
  intro A hA
  let τ : ℝ := σ - (1 / 2 - 40481 / 100000)
  have hτ : 0 < τ := sub_pos.mpr hσgap
  have hσ : 0 < σ := by linarith
  let θ : ℝ := 1 / 2 + 2 * «ω»
  have hθ0 : 0 < θ := by dsimp [θ]; linarith
  have hθ1 : θ < 1 := by
    rcases hsource with ⟨_, _, hi⟩ | ⟨_, _, hi⟩ | ⟨_, hi, _, _⟩ <;>
      dsimp [θ] <;> nlinarith
  let D : ℝ := A + 20
  let E : ℝ := 4 * (D + 1)
  have hD : 0 ≤ D := by dsimp [D]; linarith
  have hE : 0 ≤ E := by dsimp [E]; positivity
  obtain ⟨Kb, Xb, hKb, hXb, hbox⟩ :=
    central_prime_box_typeII_coherent_log_saving hDeligne j (arity + 1) «ω» δ σ
      (9519 / 100000) 64 hω hδ hσ (by norm_num) (by norm_num) hsource
      (A + E) (by linarith)
  obtain ⟨Xc, hXc⟩ := Filter.eventually_atTop.mp
    (small_prime_geometric_central_scales hArity τ hτ)
  obtain ⟨Xs, hXs⟩ := Filter.eventually_atTop.mp
    ((isLittleO_log_rpow_rpow_atTop (A + 18)
      (by norm_num : (0 : ℝ) < 9519 / 50000)).eventuallyLE)
  let C0 : ℝ := 2 + Real.log 64
  let Cb : ℝ := 8 * (17 * 64) * (1023 + 1) * C0 ^ 16
  let K : ℝ := (6 : ℝ) ^ 4 * Kb + 32 * Cb
  have hC0 : 0 < C0 := by
    have := Real.log_nonneg (by norm_num : (1 : ℝ) ≤ 64)
    dsimp only [C0]
    linarith
  have hK : 0 < K := by dsimp only [K, Cb]; positivity
  refine ⟨K, max Xb (max Xc Xs), hK, hXb.trans (le_max_left _ _), ?_⟩
  intro x hx M C hMcard hM P T hboolean hsupport I hI a ha F Q
  have hxb : Xb ≤ x := (le_max_left _ _).trans hx
  have hxc : Xc ≤ x := (le_max_left Xc Xs).trans ((le_max_right _ _).trans hx)
  have hxs : Xs ≤ x := (le_max_right Xc Xs).trans ((le_max_right _ _).trans hx)
  have hx100 : Real.exp 100 ≤ x := hXb.trans hxb
  have hx0 : 0 < x := (Real.exp_pos 100).trans_le hx100
  have hx2 : 2 ≤ x := by
    have := Real.add_one_le_exp (100 : ℝ)
    linarith
  have hx1 : 1 ≤ x := by linarith
  have hxexp : Real.exp 1 ≤ x :=
    (Real.exp_le_exp.mpr (by norm_num : (1 : ℝ) ≤ 100)).trans hx100
  have hlog100 : 100 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hx100
  have hlog1 : 1 ≤ Real.log x := by linarith
  have hlog0 : 0 < Real.log x := by linarith
  let l : ℝ := Real.log x
  let h : ℝ := l ^ (-D)
  let bin (p : ℕ) := ⌊Real.logb (1 + h) (p : ℝ)⌋₊
  let label (p : Fin (arity + 1) → ℕ) : Fin (arity + 1) → ℕ := fun i => bin (p i)
  let B := T.image label
  let U (b : Fin (arity + 1) → ℕ) := T.filter (fun p => label p = b)
  let V := B.filter (fun b => ∃ p ∈ U b, C p)
  let W := V.filter (fun b => ¬∀ p ∈ U b, C p)
  let Fbox (b : Fin (arity + 1) → ℕ) : ℕ →₀ ℂ :=
    ∑ p ∈ U b, Finsupp.single (∏ i, p i) 1
  have hmesh := four_geometric_log_mesh_spec D x hD hxexp
  have hh : 0 < h := hmesh.1
  have hh1 : h ≤ 1 := hmesh.2.1
  have hhquarter : h ≤ 1 / 4 := by
    calc
      h ≤ l ^ (-1 : ℝ) :=
        Real.rpow_le_rpow_of_exponent_le hlog1 (by dsimp only [D]; linarith)
      _ = 1 / l := by rw [Real.rpow_neg_one, one_div]
      _ ≤ 1 / 4 := one_div_le_one_div_of_le (by norm_num) (by dsimp only [l]; linarith)
  have hcardB : (B.card : ℝ) ≤ (6 : ℝ) ^ 4 * l ^ E :=
    small_prime_geometric_box_card_polylog hArity D x hD hxexp
  have hcardV : (V.card : ℝ) ≤ (6 : ℝ) ^ 4 * l ^ E :=
    (Nat.cast_le.mpr (Finset.card_filter_le B _)).trans hcardB
  have hBbound (b : Fin (arity + 1) → ℕ) (hb : b ∈ V) :
      (∑ q ∈ Q, ‖fullDiscrepancy (Fbox b) q a‖) ≤ Kb * x / l ^ (A + E) := by
    obtain ⟨p, hp, hCp⟩ := (Finset.mem_filter.mp hb).2
    have hpT := (Finset.mem_filter.mp hp).1
    have hlabel := (Finset.mem_filter.mp hp).2
    obtain ⟨hprod, S, hS, hSproper, hSlo, hShi⟩ := hsupport p hpT hCp
    let Lb (i : Fin (arity + 1)) : ℝ := max (x ^ ((9519 : ℝ) / 50000)) ((1 + h) ^ b i)
    let Rb (i : Fin (arity + 1)) : ℝ := min (x ^ ((9 : ℝ) / 10))
      ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ)
    obtain ⟨R, Y, _hRS, hRne, hRproper, hY, hcuts, hYlo, hYhi, hNlo, hNhi⟩ :=
      hXc x hxc h hh hhquarter b p (Fintype.mem_piFinset.mp hpT)
        (fun i => congrFun hlabel i) hprod S hS hSproper
        (by simpa only [Nat.cast_prod] using hSlo)
        (by simpa only [Nat.cast_prod] using hShi)
    have hexponent : (40481 : ℝ) / 100000 - τ = 1 / 2 - σ := by
      dsimp only [τ]
      ring
    rw [hexponent] at hNlo
    have hU : U b = Fintype.piFinset (fun i : Fin (arity + 1) =>
        (Finset.Icc ⌈Lb i⌉₊ ⌊Rb i⌋₊).filter Nat.Prime) := by
      have hboxes := (finite_small_prime_box_cut_decomposition P bin C).1 b
      change U b = Fintype.piFinset
        (fun i : Fin (arity + 1) => P.filter (fun p => bin p = b i)) at hboxes
      rw [hboxes]
      congr 1
      funext i
      exact small_prime_geometric_bin_eq_closed_interval x h hx0 hh (b i)
    have hcoeff : (primeIntervalBoxAlgebra Lb Rb Finset.univ).coeff = Fbox b := by
      simpa only [MonoidAlgebra.coeff_sum, MonoidAlgebra.coeff_single, Fbox, hU] using
        congrArg (fun f : MonoidAlgebra ℂ ℕ => f.coeff)
          (primeIntervalBoxAlgebra_univ_eq_tuple_sum Lb Rb)
    have hb' := hbox x hxb Y Lb Rb R hRne hRproper hY hcuts hYlo hYhi
      hNlo hNhi I hI a ha
    rw [hcoeff] at hb'
    exact hb'
  have hinterior :
      (∑ b ∈ V, ∑ q ∈ Q, ‖fullDiscrepancy (Fbox b) q a‖) ≤
        (6 : ℝ) ^ 4 * Kb * x / l ^ A := by
    calc
      _ ≤ ∑ b ∈ V, Kb * x / l ^ (A + E) := Finset.sum_le_sum hBbound
      _ = (V.card : ℝ) * (Kb * x / l ^ (A + E)) := by simp
      _ ≤ ((6 : ℝ) ^ 4 * l ^ E) * (Kb * x / l ^ (A + E)) :=
        mul_le_mul_of_nonneg_right hcardV (by positivity)
      _ = _ := by
        dsimp only [l]
        rw [Real.rpow_add hlog0]
        field_simp [(Real.rpow_pos_of_pos hlog0 A).ne',
          (Real.rpow_pos_of_pos hlog0 E).ne']
  have hW : W = B.filter
      (fun b => (∃ p ∈ U b, C p) ∧ ¬∀ p ∈ U b, C p) := by
    ext b
    simp only [W, V, Finset.mem_filter, and_assoc]
  have hmass : (∑ b ∈ W, ((U b).card : ℝ)) ≤
      (M.card : ℝ) * 64 * (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
        (1 + Real.log (64 * x)) ^ 16 := by
    rw [hW]
    apply boolean_small_monomial_mixed_geometric_box_card hArity x h hx2 hh hh1 M C hM hboolean
    intro p hp hCp
    exact (Nat.cast_le.mpr (Finset.mem_Icc.mp (hsupport p hp hCp).1).2).trans
      (Nat.floor_le (by positivity))
  have hQsub : Q ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ := Finset.filter_subset _ _
  clear_value P bin Q
  have hφsum : (∑ q ∈ Q, 1 / (q.totient : ℝ)) ≤ 4 * l ^ 2 := by
    let Q₀ := Finset.Icc 1 ⌊x ^ θ⌋₊
    have hq1 : 1 ≤ ⌊x ^ θ⌋₊ :=
      Nat.le_floor (by simpa only [Nat.cast_one] using Real.one_le_rpow hx1 hθ0.le)
    have hqx : (⌊x ^ θ⌋₊ : ℝ) ≤ x :=
      (Nat.floor_le (Real.rpow_nonneg hx0.le θ)).trans
        (Real.rpow_le_self_of_one_le hx1 hθ1.le)
    have hlogQ : Real.log (⌊x ^ θ⌋₊ : ℝ) ≤ l :=
      Real.log_le_log (by exact_mod_cast zero_lt_one.trans_le hq1) hqx
    have hmoment : (∑ q ∈ Q₀, 1 / (q.totient : ℝ)) ≤
        (harmonic ⌊x ^ θ⌋₊ : ℝ) ^ 2 := by
      calc
        _ ≤ ∑ q ∈ Q₀, (q.divisors.card : ℝ) / (q : ℝ) := by
          apply Finset.sum_le_sum
          intro q hq
          have hq0 : 0 < (q : ℝ) := Nat.cast_pos.mpr (Finset.mem_Icc.mp hq).1
          have ht := div_totient_le_card_divisors q
          calc
            1 / (q.totient : ℝ) = ((q : ℝ) / (q.totient : ℝ)) / q := by
              field_simp [hq0.ne']
            _ ≤ _ := div_le_div_of_nonneg_right ht hq0.le
        _ ≤ ∑ q ∈ Q₀,
            (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 2) q : ℝ) / (q : ℝ) := by
          apply Finset.sum_le_sum
          intro q hq
          apply div_le_div_of_nonneg_right _ (Nat.cast_nonneg q)
          have ht := card_divisors_pow_le_zeta_pow 1 q
            (Finset.mem_Icc.mp hq).1
          norm_num only [pow_one, pow_one] at ht
          exact_mod_cast ht
        _ ≤ _ := sum_zeta_pow_div_le_harmonic_pow 2 _
    have hH : (harmonic ⌊x ^ θ⌋₊ : ℝ) ≤ 2 * l := by
      have ht := (harmonic_le_one_add_log ⌊x ^ θ⌋₊).trans (add_le_add (le_refl 1) hlogQ)
      dsimp only [l] at *
      linarith
    have hsub : Q ⊆ Q₀ := hQsub
    exact (Finset.sum_le_sum_of_subset_of_nonneg hsub
      (fun _ _ _ => by positivity)).trans
      (hmoment.trans ((pow_le_pow_left₀ (by unfold harmonic; positivity) hH 2).trans_eq
        (by ring)))
  have hsmallx : l ^ (A + 18) ≤ x ^ ((9519 : ℝ) / 50000) := by
    simpa only [Real.norm_of_nonneg (Real.rpow_nonneg hlog0.le _),
      Real.norm_of_nonneg (Real.rpow_nonneg hx0.le _), l] using hXs x hxs
  have hmassScaled : (∑ b ∈ W, ((U b).card : ℝ)) / 32 ≤
      17 * 64 * (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
        (1 + Real.log (64 * x)) ^ 16 := by
    apply (div_le_iff₀ (by norm_num : (0 : ℝ) < 32)).mpr
    have hcount : (M.card : ℝ) ≤ 32 := by exact_mod_cast hMcard
    have hz : 0 ≤ 64 * (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
        (1 + Real.log (64 * x)) ^ 16 := by positivity
    nlinarith only [hmass, mul_le_mul_of_nonneg_right hcount hz, hz]
  have hboundary :
      2 * (∑ b ∈ W, ((U b).card : ℝ)) * (∑ q ∈ Q, 1 / (q.totient : ℝ)) ≤
        (32 * Cb) * x / l ^ A := by
    have hmassNonneg : 0 ≤ ∑ b ∈ W, ((U b).card : ℝ) :=
      Finset.sum_nonneg fun _ _ => Nat.cast_nonneg _
    have hφNonneg : 0 ≤ ∑ q ∈ Q, 1 / (q.totient : ℝ) :=
      Finset.sum_nonneg fun _ _ => one_div_nonneg.mpr (Nat.cast_nonneg _)
    have hb := minorant_boundary_log_arithmetic A x
      ((∑ b ∈ W, ((U b).card : ℝ)) / 32) (∑ q ∈ Q, 1 / (q.totient : ℝ))
      hA hxexp (div_nonneg hmassNonneg (by norm_num)) hφNonneg hmassScaled hφsum hsmallx
    calc
      _ = 32 * (2 * ((∑ b ∈ W, ((U b).card : ℝ)) / 32) *
          (∑ q ∈ Q, 1 / (q.totient : ℝ))) := by ring
      _ ≤ 32 * (Cb * x / l ^ A) := mul_le_mul_of_nonneg_left hb (by norm_num)
      _ = _ := by ring
  have harith : (6 : ℝ) ^ 4 * Kb * x / l ^ A +
      (32 * Cb) * x / l ^ A = K * x / l ^ A := by
    dsimp only [K]
    ring
  have hcover := finite_small_prime_box_discrepancy_cover P bin C Q (fun _ => a)
  exact hcover.trans ((add_le_add hinterior hboundary).trans_eq harith)

end

section

variable {arity : ℕ}
open Classical in
theorem central_small_prime_boolean_cut_subpower_coherent_log_saving (hArity : arity ≤ 3)
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : ℕ) («ω» δ σ : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ)
    (hσgap : (1 / 2 : ℝ) - 40481 / 100000 < σ)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1))
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x) atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ), (Y : ℝ) = x ^ δ →
      ∀ M : Finset (MinorantSmallMonomialCut (arity + 1)), ∀ C : (Fin (arity + 1) → ℕ) → Prop,
      M.card ≤ 32 →
      (∀ d ∈ M, d.numerator.Nonempty ∧ Disjoint d.numerator d.denominator ∧
        d.numerator.card + d.denominator.card ≤ arity + 1 ∧ 0 < d.threshold) →
      let P : Finset ℕ :=
        (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
          ⌊x ^ ((9 : ℝ) / 10)⌋₊).filter Nat.Prime
      let T := Fintype.piFinset (fun _ : Fin (arity + 1) => P)
      (∀ p ∈ T, ∀ q ∈ T,
        (∀ d ∈ M,
          (if d.lower then
            if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
          else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
          (if d.lower then
            if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
          else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
        (C p ↔ C q)) →
      (∀ p ∈ T, C p →
        (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧
        ∃ S : Finset (Fin (arity + 1)), S.Nonempty ∧ S ≠ Finset.univ ∧
          x ^ ((40481 : ℝ) / 100000) ≤ ((∏ i ∈ S, p i : ℕ) : ℝ) ∧
          ((∏ i ∈ S, p i : ℕ) : ℝ) ≤ x ^ ((59519 : ℝ) / 100000)) →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let F : ℕ →₀ ℂ :=
          ∑ p ∈ T, Finsupp.single (∏ i, p i) (if C p then 1 else 0)
        let Q := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter (fun q =>
          q ∣ (∏ p ∈ I, p) ∧
            Nonempty (DenseDivisibilityWitness Y j q))
        (∑ q ∈ Q, ‖fullDiscrepancy F q a‖) ≤ K * x / (Real.log x) ^ A := by
  obtain ⟨r, hr, hretreat⟩ := central_typeII_parameter_retreat j «ω» δ σ hsource
  obtain ⟨Xr, hXr⟩ := eventually_atTop.mp
    (central_subpower_modulus_family_subset j «ω» δ r hr L0 hL0 hL0sub)
  intro A hA
  obtain ⟨K, Xp, hK, hXp, hp⟩ :=
    central_small_prime_boolean_cut_coherent_log_saving hArity hDeligne j («ω» + r) (δ + r) σ
      (by linarith) (by linarith) hσgap hretreat A hA
  refine ⟨K, max Xp Xr, hK, hXp.trans (le_max_left _ _), ?_⟩
  intro x hx Y hY M C hMcard hM P T hboolean hsupport I hI a ha F Q
  have hxp : Xp ≤ x := (le_max_left _ _).trans hx
  have hxr : Xr ≤ x := (le_max_right _ _).trans hx
  have hsubset := hXr x hxr Y hY I
  have hbound := hp x hxp M C hMcard hM hboolean hsupport I hI a ha
  exact (Finset.sum_le_sum_of_subset_of_nonneg hsubset
    (fun q _ _ => norm_nonneg (fullDiscrepancy F q a))).trans hbound

end

open Classical in
theorem sourceLargeFirst_coherent_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : ℕ) («ω» δ σ : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ)
    (hσgap : (1 / 2 : ℝ) - 40481 / 100000 < σ)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1))
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x) atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ), (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let F : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
          Finsupp.single n (sourceLargeFirst x n : ℂ)
        let Q := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter (fun q =>
          q ∣ (∏ p ∈ I, p) ∧
            Nonempty (DenseDivisibilityWitness Y j q))
        (∑ q ∈ Q, ‖fullDiscrepancy F q a‖) ≤ K * x / (Real.log x) ^ A := by
  intro A hA
  obtain ⟨K, Xb, hK, hXb, hbound⟩ :=
    central_small_prime_boolean_cut_subpower_coherent_log_saving
      (arity := 1) (by norm_num) hDeligne j «ω» δ σ hω hδ hσgap hsource
      L0 hL0 hL0sub A hA
  obtain ⟨Xf, hXf⟩ := eventually_atTop.mp sourceLargeFirst_eventually_finsupp
  obtain ⟨Xc, hXc⟩ := eventually_atTop.mp sourceLargeFirst_eventually_compact_central
  refine ⟨K, max Xb (max Xf Xc), hK, hXb.trans (le_max_left _ _), ?_⟩
  intro x hx Y hY I hI a ha F Q
  have hxb : Xb ≤ x := (le_max_left _ _).trans hx
  have hxf : Xf ≤ x := (le_max_left Xf Xc).trans ((le_max_right _ _).trans hx)
  have hxc : Xc ≤ x := (le_max_right Xf Xc).trans ((le_max_right _ _).trans hx)
  have hx0 : 0 < x := (Real.exp_pos 100).trans_le (hXb.trans hxb)
  let P := (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
    ⌊x ^ ((9 : ℝ) / 10)⌋₊).filter Nat.Prime
  let T := Fintype.piFinset (fun _ : Fin 2 => P)
  let C (p : Fin 2 → ℕ) : Prop :=
    x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x ∧
      x ^ ((40481 : ℝ) / 100000) ≤ (p 0 : ℝ) ∧
      (p 0 : ℝ) < Real.sqrt (3 * x) ∧ p 0 ≤ p 1
  have hCdef : C = fun p =>
      x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x ∧
        x ^ ((40481 : ℝ) / 100000) ≤ (p 0 : ℝ) ∧
        (p 0 : ℝ) < Real.sqrt (3 * x) ∧ p 0 ≤ p 1 := rfl
  clear_value C
  obtain ⟨M, hMcard, hM, hboolean⟩ := sourceLargeFirst_small_monomial_representation x hx0
  have hpositive (p : Fin 2 → ℕ) (hp : p ∈ T) (i : Fin 2) : 0 < p i :=
    (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).2.pos
  have hbooleanC : ∀ p ∈ T, ∀ q ∈ T,
      (∀ d ∈ M,
        (if d.lower then
          if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
        else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
        (if d.lower then
          if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
        else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
      (C p ↔ C q) := by
    intro p hp q hq ht
    rw [hCdef]
    exact hboolean p q (hpositive p hp) (hpositive q hq) ht
  have hsupport (p : Fin 2 → ℕ) (hp : p ∈ T) (hCp : C p) :
      (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧
      ∃ S : Finset (Fin 2), S.Nonempty ∧ S ≠ Finset.univ ∧
        x ^ ((40481 : ℝ) / 100000) ≤ ((∏ i ∈ S, p i : ℕ) : ℝ) ∧
        ((∏ i ∈ S, p i : ℕ) : ℝ) ≤ x ^ ((59519 : ℝ) / 100000) := by
    rw [hCdef] at hCp
    refine ⟨Finset.mem_Icc.mpr ⟨Nat.ceil_le.mpr hCp.1,
      (Nat.le_floor_iff (by positivity : 0 ≤ 2 * x)).mpr hCp.2.1⟩, ?_⟩
    exact (hXc x hxc).2 p hp hCp.2.2.1 hCp.2.2.2.1
  have hFeq : F = ∑ p ∈ T,
      Finsupp.single (∏ i, p i) (if C p then (1 : ℂ) else 0) := by
    rw [hCdef]
    have h := hXf x hxf
    refine h.trans (Finset.sum_congr rfl ?_)
    intro p _hp
    apply congrArg (Finsupp.single (∏ i, p i))
    exact @ite_cond_congr ℂ _ _ inferInstance (Classical.propDecidable _) _ _ rfl
  have h := hbound x hxb Y hY M C hMcard hM hbooleanC hsupport I hI a ha
  rw [hFeq]
  exact h

open Classical in
theorem three_closed_mangoldt_box_eq_tuple_sum
    (A B t : Fin 3 → ℝ) (R : ℕ → Prop) :
    ((∏ i : Fin 3, (MonoidAlgebra.ofCoeff
      (minorantHBClosedMangoldt (A i) (B i) (t i)) : MonoidAlgebra ℂ ℕ)).coeff).filter R =
      ∑ p ∈ (Fintype.piFinset (fun i : Fin 3 => Finset.Icc ⌈A i⌉₊ ⌊B i⌋₊)).filter
        (fun p => R (∏ i, p i)),
        Finsupp.single (∏ i, p i)
          ((∏ i, ArithmeticFunction.vonMangoldt (p i) * (p i : ℝ) ^ (-(t i))) • (1 : ℂ)) := by
  unfold minorantHBClosedMangoldt
  rw [finite_product_sample_filter]
  apply Finset.sum_congr rfl
  intro p _hp
  congr 1
  simp only [Complex.real_smul, mul_one, Complex.ofReal_prod, Complex.ofReal_mul]
  apply Finset.prod_congr rfl
  intro i _hi
  exact mul_comm _ _

theorem three_closed_prime_box_mellin_transfer
    (η γ θ : ℝ) (hη : 0 < η) (hγ : 0 ≤ γ) (hθ : 0 < θ) (hθγ : θ < 1 - γ)
    (J : ℕ) (A : ℝ) (hA : 0 < A) :
    ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x →
      ∀ L U : Fin 3 → ℝ,
        (∀ i, x ^ η ≤ L i ∧ L i ≤ x ^ γ) →
        (∀ i, L i ≤ U i ∧ U i ≤ 2 * L i) →
      ∀ S : Finset ℕ, S ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ →
      ∀ a : ℕ → ℕ, (∀ q ∈ S, Nat.Coprime (a q) q) →
      ∀ B : ℝ,
        (∀ t : Fin 3 → ℝ, (∀ i, 0 ≤ t i) → (∀ i, t i ≤ 10) →
          (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy
            (((∏ i : Fin 3, (MonoidAlgebra.ofCoeff
              (minorantHBClosedMangoldt (L i) (U i) (t i)) : MonoidAlgebra ℂ ℕ)).coeff).filter
                (fun n => n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊)) q (a q)‖) ≤ B) →
        (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy
          ((primeIntervalBoxAlgebra L U Finset.univ).coeff.filter
            (fun n => n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊)) q (a q)‖) ≤
          1000 * B + K * x / (Real.log x) ^ A := by
  classical
  obtain ⟨K, X, hK, hX, htransfer⟩ :=
    three_prime_mellin_moduli_transfer η γ θ hη hγ hθ hθγ J 2 A (by norm_num) hA
  refine ⟨K, X, hK, hX, ?_⟩
  intro x hx L U hL hU S hS a ha B hraw
  have hxpos : 0 < x := (Real.exp_pos 1).trans_le (hX.trans hx)
  let R : ℕ → Prop := fun n => n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
  let T := (Fintype.piFinset (fun i : Fin 3 => Finset.Icc ⌈L i⌉₊ ⌊U i⌋₊)).filter
    (fun p => R (∏ i, p i))
  have hT (p : Fin 3 → ℕ) (hp : p ∈ T) (i : Fin 3) :
      L i ≤ (p i : ℝ) ∧ (p i : ℝ) ≤ 2 * L i := by
    have hmem := Finset.mem_Icc.mp (Fintype.mem_piFinset.mp (Finset.mem_filter.mp hp).1 i)
    have hUpos : 0 ≤ U i := (Real.rpow_pos_of_pos hxpos η).le.trans
      ((hL i).1.trans (hU i).1)
    exact ⟨Nat.le_of_ceil_le hmem.1,
      ((Nat.cast_le.mpr hmem.2).trans (Nat.floor_le hUpos)).trans (hU i).2⟩
  have hprod (p : Fin 3 → ℕ) (hp : p ∈ T) : ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x :=
    (Nat.cast_le.mpr (Finset.mem_Icc.mp (Finset.mem_filter.mp hp).2).2).trans
      (Nat.floor_le (by positivity))
  have hM : ∀ t ∈ Set.Icc (0 : ℝ) 10, ∀ u ∈ Set.Icc (0 : ℝ) 10,
      ∀ v ∈ Set.Icc (0 : ℝ) 10,
        (∑ q ∈ S, (q.divisors.card : ℝ) ^ J * ‖fullDiscrepancy
          (∑ p ∈ T, Finsupp.single (∏ j, p j)
            ((∏ j, ArithmeticFunction.vonMangoldt (p j) *
              (p j : ℝ) ^ (-(![t, u, v] j))) • (1 : ℂ))) q (a q)‖) ≤ B := by
    intro t ht u hu v hv
    have ht0 : ∀ i : Fin 3, 0 ≤ (![t, u, v] i : ℝ) := by
      simpa [Fin.forall_fin_succ] using And.intro ht.1 (And.intro hu.1 hv.1)
    have ht10 : ∀ i : Fin 3, (![t, u, v] i : ℝ) ≤ 10 := by
      simpa [Fin.forall_fin_succ] using And.intro ht.2 (And.intro hu.2 hv.2)
    have h := hraw ![t, u, v] ht0 ht10
    have heq :
        (((∏ i : Fin 3, (MonoidAlgebra.ofCoeff
          (minorantHBClosedMangoldt (L i) (U i) (![t, u, v] i)) :
            MonoidAlgebra ℂ ℕ)).coeff).filter
              (fun n => n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊)) =
          ∑ p ∈ T, Finsupp.single (∏ j, p j)
            ((∏ j, ArithmeticFunction.vonMangoldt (p j) *
              (p j : ℝ) ^ (-(![t, u, v] j))) • (1 : ℂ)) := by
      convert three_closed_mangoldt_box_eq_tuple_sum L U ![t, u, v] R
    rw [heq] at h
    exact h
  have h := htransfer x hx 1 (by norm_num) L hL S hS a ha T hT hprod
    (fun _ => (1 : ℂ)) (fun _ _ => by norm_num) B hM
  have heq : (primeIntervalBoxAlgebra L U Finset.univ).coeff.filter
      (fun n => n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊) =
        ∑ p ∈ T, Finsupp.single (∏ i, p i)
          ((∏ i, if (p i).Prime then (1 : ℝ) else 0) • (1 : ℂ)) := by
    convert three_closed_prime_box_eq_tuple_sum L U R
  rw [heq]
  simpa only [R, T, mul_one] using h

open Classical in
theorem sourceT3_closed_prime_boxes_log_saving_of_deligne
    (τ : ℝ) (hτ : 0 < τ) (hτsmall : τ ≤ (1 / 10 ^ 10 : ℝ))
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (density : ℕ) (hdensity : 1 ≤ density) («ω» δ : ℝ)
    (hω : 0 < «ω») (hωupper : «ω» < 1 / 12) (hδ : 0 < δ) :
    let a : ℝ := 40481 / 100000
    let ζ : ℝ := 1 - 1058 / 3125 - a
    let σclass : ℝ := 1 / 2 - a + τ
    let γ₀ : ℝ := 1058 / 3125 - τ
    ∀ σdist σIII : ℝ, σclass < σdist → σdist < 1 / 2 →
      1 / 18 + 28 / 9 * «ω» + 2 / 9 * δ < σIII →
      σIII < 19 / 200 - τ →
      1 / 4 + 7 * «ω» + 2 * δ < γ₀ →
      ((density = 1 ∧ 54 * «ω» + 15 * δ + 5 * σdist < 1 ∧
          68 * «ω» + 14 * δ < 1) ∨
        (density = 2 ∧ 56 * «ω» + 16 * δ + 4 * σdist < 1 ∧
          68 * «ω» + 14 * δ < 1) ∨
        (density = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
          48 * «ω» + 16 * δ + 4 * σdist < 1 ∧
          64 * «ω» + 20 * δ + 2 * σdist < 1)) →
      ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
        ∀ x : ℝ, X ≤ x → ∀ L U : Fin 3 → ℝ,
          (∀ c, x ^ (ζ - τ / 10) ≤ L c) →
          (∀ c, L c ≤ U c ∧ U c ≤ 2 * L c) →
          (∀ c, U c ≤ x ^ (a + τ / 10)) →
        ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
        ∀ a₀ : ℕ, Nat.Coprime a₀ (∏ p ∈ I, p) →
          let Q := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
            q ∣ (∏ p ∈ I, p) ∧
              Nonempty (DenseDivisibilityWitness
                ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩ density q))
          (∑ q ∈ Q, ‖PrimeGap186.fullDiscrepancy
            ((primeIntervalBoxAlgebra L U Finset.univ).coeff.filter
              (fun n : ℕ => n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊)) q a₀‖) ≤
            K * x / (Real.log x) ^ A := by
  intro a ζ σclass γ₀ σdist σIII hσσ hσhalf hIIIlo hIIIhi hgap hdist A hA
  obtain ⟨Dr, hDr, Kr, Xr, hKr, hXr, hradial⟩ :=
    minorantHB_three_radial_error_moduli_log_saving A hA 0
  obtain ⟨Do, hDo, Ko, Xo, hKo, hXo, horiginal⟩ :=
    minorantHB_three_original_boundary_moduli_log_saving 0 A hA
  let D : ℕ := max Dr Do
  have hD : 1 ≤ D := hDr.trans (le_max_left _ _)
  obtain ⟨Ks, Xs, hKs, hXs, hselected⟩ :=
    sourceT3_selected_boxes_log_saving_of_deligne τ hτ hτsmall
      hDeligne density hdensity D hD «ω» δ hω hωupper hδ
      σdist σIII hσσ hσhalf hIIIlo hIIIhi hgap hdist A hA
  obtain ⟨Km, Xm, hKm, hXm, hmellin⟩ :=
    three_closed_prime_box_mellin_transfer (1 / 4) (41 / 100) (53 / 100)
      (by norm_num) (by norm_num) (by norm_num) (by norm_num) 0 A hA
  let Kraw : ℝ := Ks + Kr + Ko
  let X : ℝ := max (max Xr Xo) (max Xs Xm)
  refine ⟨1000 * Kraw + Km, X, ?_, ?_, ?_⟩
  · dsimp only [Kraw]
    positivity
  · exact hXr.trans ((le_max_left Xr Xo).trans (le_max_left _ _))
  intro x hx L U hLwide hLU hUwide I hI a₀ ha₀ Q
  have hxr : Xr ≤ x := ((le_max_left Xr Xo).trans (le_max_left _ _)).trans hx
  have hxo : Xo ≤ x := ((le_max_right Xr Xo).trans (le_max_left _ _)).trans hx
  have hxs : Xs ≤ x := ((le_max_left Xs Xm).trans (le_max_right _ _)).trans hx
  have hxm : Xm ≤ x := ((le_max_right Xs Xm).trans (le_max_right _ _)).trans hx
  have hxexp : Real.exp 1 ≤ x := hXr.trans hxr
  have hxone : 1 < x := (Real.one_lt_exp_iff.mpr zero_lt_one).trans_le hxexp
  have hxpos : 0 < x := zero_lt_one.trans hxone
  have hlogpos : 0 < Real.log x := Real.log_pos hxone
  have hscale (c : Fin 3) :
      x ^ ((1 : ℝ) / 4) ≤ L c ∧ L c ≤ x ^ ((41 : ℝ) / 100) := by
    refine ⟨?_, (hLU c).1.trans ((hUwide c).trans ?_)⟩
    · exact (Real.rpow_le_rpow_of_exponent_le hxone.le
        (by dsimp only [ζ, a]; linarith only [hτ, hτsmall])).trans (hLwide c)
    · exact Real.rpow_le_rpow_of_exponent_le hxone.le (by
        dsimp only [a]
        linarith only [hτ, hτsmall])
  have hLone (c : Fin 3) : 1 ≤ L c :=
    (Real.one_le_rpow hxone.le (by norm_num : (0 : ℝ) ≤ 1 / 4)).trans (hscale c).1
  have hθ : (1 / 2 : ℝ) + 2 * «ω» ≤ 53 / 100 := by
    have hγ : γ₀ < (339 : ℝ) / 1000 := by dsimp only [γ₀]; linarith only [hτ, hτsmall]
    linarith only [hgap, hδ, hγ]
  have hQ : Q ⊆ Finset.Icc 1 ⌊x ^ ((53 : ℝ) / 100)⌋₊ := by
    intro q hq
    obtain ⟨hrange, _hdvd, _hdd⟩ := Finset.mem_filter.mp hq
    obtain ⟨hqone, hqhi⟩ := Finset.mem_Icc.mp hrange
    exact Finset.mem_Icc.mpr ⟨hqone, hqhi.trans
      (Nat.floor_mono (Real.rpow_le_rpow_of_exponent_le hxone.le hθ))⟩
  have hcop (q : ℕ) (hq : q ∈ Q) : Nat.Coprime a₀ q :=
    Nat.Coprime.of_dvd_right (Finset.mem_filter.mp hq).2.1 ha₀
  have hmask (n : ℕ) :
      (x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x) ↔ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ := by
    rw [Finset.mem_Icc, Nat.ceil_le, Nat.le_floor_iff (by positivity : (0 : ℝ) ≤ 2 * x)]
  have hfilter (f : ℕ →₀ ℂ) :
      f.filter (fun n : ℕ => x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x) =
        f.filter (fun n : ℕ => n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊) := by
    ext n
    simp only [Finsupp.filter_apply, hmask]
  have hraw (t : Fin 3 → ℝ) (ht : ∀ c, 0 ≤ t c) (htten : ∀ c, t c ≤ 10) :
      (∑ q ∈ Q, (q.divisors.card : ℝ) ^ 0 * ‖fullDiscrepancy
        (((∏ c : Fin 3, (MonoidAlgebra.ofCoeff
          (minorantHBClosedMangoldt (L c) (U c) (t c)) : MonoidAlgebra ℂ ℕ)).coeff).filter
            (fun n : ℕ => n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊)) q a₀‖) ≤
          Kraw * x / (Real.log x) ^ A := by
    let Θ : ℝ := 1 + (Real.log x) ^ (-(D : ℝ))
    let Uhb : ℝ := x ^ ((9 : ℝ) / 100)
    let boxes (r : Fin 3 → Fin 5) :=
      Fintype.piFinset (fun c : Fin 3 => minorantHBBoxes ((r c).val + 1) (L c) (U c) Θ)
    let β (r : Fin 3 → Fin 5)
        (ν : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ) : ℕ →₀ ℂ :=
      (∏ s : Σ c : Fin 3, Fin (2 * ((r c).val + 1)),
        minorantHBLocalizedSlot ((r s.1).val + 1) Uhb Θ (t s.1) (ν s.1) s.2).coeff
    let P (r : Fin 3 → Fin 5)
        (ν : (c : Fin 3) → Fin (2 * ((r c).val + 1)) → ℕ) : ℝ :=
      ∏ s : Σ c : Fin 3, Fin (2 * ((r c).val + 1)), Θ ^ ν s.1 s.2
    let selected : ℕ →₀ ℂ :=
      ∑ r : Fin 3 → Fin 5,
        (∏ c : Fin 3,
          (((-1 : ℝ) ^ (r c).val * ((5 : ℕ).choose ((r c).val + 1) : ℝ) : ℝ) : ℂ)) •
            ∑ ν ∈ (boxes r).filter
              (fun ν => x * Θ ^ 30 ≤ P r ν ∧ P r ν * Θ ^ 30 ≤ 2 * x), β r ν
    let G : ℕ →₀ ℂ :=
      (∏ c : Fin 3, (MonoidAlgebra.ofCoeff
        (minorantHBUnmaskedFive (L c) (U c) Uhb Θ (t c)) : MonoidAlgebra ℂ ℕ)).coeff
    let F : ℕ →₀ ℂ :=
      (∏ c : Fin 3, (MonoidAlgebra.ofCoeff
        (minorantHBClosedMangoldt (L c) (U c) (t c)) : MonoidAlgebra ℂ ℕ)).coeff
    let R : ℕ →₀ ℂ :=
      G.filter (fun n : ℕ => x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x) - selected
    let E : ℕ →₀ ℂ :=
      (G - F).filter (fun n : ℕ => x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x)
    have hs : (∑ q ∈ Q, ‖fullDiscrepancy selected q a₀‖) ≤
        Ks * x / (Real.log x) ^ A :=
      hselected x hxs t ht htten L U hLwide (fun c => (hLU c).1) hUwide I hI a₀ ha₀
    have hr : (∑ q ∈ Q, ‖fullDiscrepancy R q a₀‖) ≤
        Kr * x / (Real.log x) ^ A := by
      simpa only [pow_zero, one_mul] using
        hradial x hxr D (le_max_left Dr Do) L U t Uhb hLone
          (fun c => (hLU c).1) ht htten Q hQ (fun _ => a₀) hcop
    have he : (∑ q ∈ Q, ‖fullDiscrepancy E q a₀‖) ≤
        Ko * x / (Real.log x) ^ A := by
      simpa only [pow_zero, one_mul] using
        horiginal x hxo D (le_max_right Dr Do) L L U t hscale
          (fun c => ⟨le_rfl, (hLU c).1, (hLU c).2⟩)
          (fun c => ⟨ht c, htten c⟩) Q hQ (fun _ => a₀) hcop
    have hF : F.filter (fun n : ℕ => n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊) =
        selected + R - E := by
      rw [← hfilter F]
      dsimp only [R, E]
      rw [Finsupp.filter_sub]
      abel
    let kernel : ℕ → ℕ → ℂ := fun q n =>
      (if n % q = a₀ % q then 1 else 0) -
        (if Nat.Coprime n q then 1 else 0) / (q.totient : ℂ)
    have hfull (f : ℕ →₀ ℂ) (q : ℕ) :
        fullDiscrepancy f q a₀ = f.sum (fun n z => z * kernel q n) := by
      change fullDiscrepancy f q a₀ = ∑ n ∈ f.support, f n * kernel q n
      simp only [fullDiscrepancy, progressionMass, reducedMass, kernel,
        div_eq_mul_inv, mul_sub, mul_ite, ite_mul, one_mul, mul_one,
        zero_mul, mul_zero, Finset.sum_sub_distrib, Finset.sum_mul]
    have hlinear (q : ℕ) :
        fullDiscrepancy (F.filter (fun n : ℕ => n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊)) q a₀ =
          fullDiscrepancy selected q a₀ + fullDiscrepancy R q a₀ -
            fullDiscrepancy E q a₀ := by
      rw [hF]
      simp only [hfull]
      rw [Finsupp.sum_sub_index (fun _ _ _ => sub_mul _ _ _),
        Finsupp.sum_add_index' (fun _ => zero_mul _) (fun _ _ _ => add_mul _ _ _)]
    simp only [pow_zero, one_mul]
    change (∑ q ∈ Q, ‖fullDiscrepancy
      (F.filter (fun n : ℕ => n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊)) q a₀‖) ≤ _
    calc
      _ ≤ ∑ q ∈ Q, (‖fullDiscrepancy selected q a₀‖ +
          ‖fullDiscrepancy R q a₀‖ + ‖fullDiscrepancy E q a₀‖) := by
        apply Finset.sum_le_sum
        intro q _hq
        rw [hlinear]
        exact (norm_sub_le _ _).trans (add_le_add (norm_add_le _ _) le_rfl)
      _ ≤ Ks * x / (Real.log x) ^ A + Kr * x / (Real.log x) ^ A +
          Ko * x / (Real.log x) ^ A := by
        rw [Finset.sum_add_distrib, Finset.sum_add_distrib]
        exact add_le_add (add_le_add hs hr) he
      _ = Kraw * x / (Real.log x) ^ A := by dsimp only [Kraw]; ring
  have hprime := hmellin x hxm L U hscale hLU Q hQ (fun _ => a₀) hcop
    (Kraw * x / (Real.log x) ^ A) hraw
  simp only [pow_zero, one_mul] at hprime
  calc
    _ ≤ 1000 * (Kraw * x / (Real.log x) ^ A) + Km * x / (Real.log x) ^ A := hprime
    _ = (1000 * Kraw + Km) * x / (Real.log x) ^ A := by ring

open Classical in
theorem sourceT3_selected_dense_log_saving_of_deligne
    (τ : ℝ) (hτ : 0 < τ) (hτsmall : τ ≤ (1 / 10 ^ 10 : ℝ))
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (density : ℕ) (hdensity : 1 ≤ density) («ω» δ : ℝ)
    (hω : 0 < «ω») (hωupper : «ω» < 1 / 12) (hδ : 0 < δ) :
    let a : ℝ := 40481 / 100000
    let _ζ : ℝ := 1 - 1058 / 3125 - a
    let σclass : ℝ := 1 / 2 - a + τ
    let γ₀ : ℝ := 1058 / 3125 - τ
    ∀ σdist σIII : ℝ, σclass < σdist → σdist < 1 / 2 →
      1 / 18 + 28 / 9 * «ω» + 2 / 9 * δ < σIII →
      σIII < 19 / 200 - τ →
      1 / 4 + 7 * «ω» + 2 * δ < γ₀ →
      ((density = 1 ∧ 54 * «ω» + 15 * δ + 5 * σdist < 1 ∧
          68 * «ω» + 14 * δ < 1) ∨
        (density = 2 ∧ 56 * «ω» + 16 * δ + 4 * σdist < 1 ∧
          68 * «ω» + 14 * δ < 1) ∨
        (density = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
          48 * «ω» + 16 * δ + 4 * σdist < 1 ∧
          64 * «ω» + 20 * δ + 2 * σdist < 1)) →
      ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
        ∀ x : ℝ, X ≤ x →
        ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
        ∀ a₀ : ℕ, Nat.Coprime a₀ (∏ p ∈ I, p) →
          let Q := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
            q ∣ (∏ p ∈ I, p) ∧
              Nonempty (DenseDivisibilityWitness
                ⟨max 1 (x ^ δ), by exact le_max_left (1 : ℝ) (x ^ δ)⟩ density q))
          let F : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n (sourceT3 x n : ℂ)
          (∑ q ∈ Q, ‖fullDiscrepancy F q a₀‖) ≤ K * x / (Real.log x) ^ A := by
  intro a _ζ σclass γ₀ σdist σIII hσclass hσdist hσIIIlo hσIIIhi hsmooth hsource A hA
  let θ : ℝ := 1 / 2 + 2 * «ω»
  have hθ0 : 0 < θ := by dsimp only [θ]; linarith
  have hθ1 : θ < 1 := by dsimp only [θ]; linarith
  let D : ℝ := A + 20
  let E : ℝ := 4 * (D + 1)
  have hD : 0 ≤ D := by dsimp only [D]; linarith
  have hE : 0 ≤ E := by dsimp only [E]; positivity
  obtain ⟨Kb, Xb, hKb, _hXb, hbox⟩ :=
    sourceT3_closed_prime_boxes_log_saving_of_deligne τ hτ hτsmall
      hDeligne density hdensity «ω» δ
      hω hωupper hδ σdist σIII hσclass hσdist hσIIIlo hσIIIhi hsmooth hsource
      (A + E) (by linarith)
  obtain ⟨Xn, _hXn, hnearby⟩ := sourceT3_nearby_original_box_bounds τ hτ hτsmall
  obtain ⟨Xf, _hXf, hcompact⟩ := sourceT3_eventually_compact_prime_finsupp
  obtain ⟨Xs, hXs⟩ := Filter.eventually_atTop.mp
    ((isLittleO_log_rpow_rpow_atTop (A + 18)
      (by norm_num : (0 : ℝ) < 9519 / 50000)).eventuallyLE)
  let C0 : ℝ := 2 + Real.log 64
  let Cb : ℝ := 8 * (17 * 64) * (1023 + 1) * C0 ^ 16
  let K : ℝ := (6 : ℝ) ^ 4 * Kb + 32 * Cb
  have hC0 : 0 < C0 := by
    have := Real.log_nonneg (by norm_num : (1 : ℝ) ≤ 64)
    dsimp only [C0]
    linarith
  have hK : 0 < K := by dsimp only [K, Cb]; positivity
  refine ⟨K, max (Real.exp 100) (max Xb (max Xn (max Xf Xs))),
    hK, le_max_left _ _, ?_⟩
  intro x hx I hI a₀ ha Q F
  have hx100 : Real.exp 100 ≤ x := (le_max_left _ _).trans hx
  have htail : max Xb (max Xn (max Xf Xs)) ≤ x := (le_max_right _ _).trans hx
  have hxb : Xb ≤ x := (le_max_left _ _).trans htail
  have hxn : Xn ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans htail)
  have hxtail : max Xf Xs ≤ x :=
    (le_max_right _ _).trans ((le_max_right _ _).trans htail)
  have hxf : Xf ≤ x := (le_max_left _ _).trans hxtail
  have hxs : Xs ≤ x := (le_max_right _ _).trans hxtail
  have hx0 : 0 < x := (Real.exp_pos 100).trans_le hx100
  have hx2 : 2 ≤ x := by linarith [Real.add_one_le_exp (100 : ℝ)]
  have hx1 : 1 ≤ x := by linarith
  have hxgt : 1 < x := by linarith
  have hxexp : Real.exp 1 ≤ x :=
    (Real.exp_le_exp.mpr (by norm_num : (1 : ℝ) ≤ 100)).trans hx100
  have hlog100 : 100 ≤ Real.log x := (Real.le_log_iff_exp_le hx0).mpr hx100
  have hlog1 : 1 ≤ Real.log x := by linarith
  have hlog0 : 0 < Real.log x := by linarith
  let P := (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
    ⌊x ^ ((9 : ℝ) / 10)⌋₊).filter Nat.Prime
  let T := Fintype.piFinset (fun _ : Fin 3 => P)
  let N := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
  let R (n : ℕ) : Prop := n ∈ N
  have hRdef : R = fun n => n ∈ N := rfl
  clear_value R
  let C (p : Fin 3 → ℕ) : Prop :=
    (∏ i, p i) ∈ N ∧ sourceT3ExponentMask (fun i => Real.logb x (p i : ℝ)) = true
  have hCdef : C = fun p =>
      (∏ i, p i) ∈ N ∧ sourceT3ExponentMask (fun i => Real.logb x (p i : ℝ)) = true := rfl
  clear_value C
  let M := sourceT3MonomialCuts x
  have hMcard : M.card ≤ 32 := sourceT3MonomialCuts_card_le x
  have hM := sourceT3MonomialCuts_data x hx0
  have hprime (p : Fin 3 → ℕ) (hp : p ∈ T) (i : Fin 3) : (p i).Prime :=
    (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).2
  have hboolean : ∀ p ∈ T, ∀ q ∈ T,
      (∀ d ∈ M,
        (if d.lower then
          if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
        else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
        (if d.lower then
          if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
        else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
      (C p ↔ C q) := by
    intro p hp q hq ht
    rw [hCdef]
    exact sourceT3MonomialCuts_boolean x hxgt p q
      (fun i => (hprime p hp i).pos) (fun i => (hprime q hq i).pos) ht
  have hCR (p : Fin 3 → ℕ) (_hp : p ∈ T) (hCp : C p) : R (∏ i, p i) := by
    rw [hRdef]
    rw [hCdef] at hCp
    exact hCp.1
  have hF : F = ∑ p ∈ T,
      Finsupp.single (∏ i, p i) (if C p then (1 : ℂ) else 0) := by
    rw [hCdef]
    refine (hcompact x hxf).trans (Finset.sum_congr rfl ?_)
    intro p _hp
    apply congrArg (Finsupp.single (∏ i, p i))
    exact @ite_cond_congr ℂ _ _ inferInstance (Classical.propDecidable _) _ _ rfl
  rw [hF]
  let l : ℝ := Real.log x
  let h : ℝ := l ^ (-D)
  let bin (p : ℕ) := ⌊Real.logb (1 + h) (p : ℝ)⌋₊
  let label (p : Fin 3 → ℕ) : Fin 3 → ℕ := fun i => bin (p i)
  let B := T.image label
  let U (b : Fin 3 → ℕ) := T.filter (fun p => label p = b)
  let V := B.filter (fun b => ∃ p ∈ U b, C p)
  let W := V.filter (fun b => ¬∀ p ∈ U b, C p)
  let Fbox (b : Fin 3 → ℕ) : ℕ →₀ ℂ :=
    ∑ p ∈ U b, Finsupp.single (∏ i, p i) (if R (∏ i, p i) then 1 else 0)
  have hmesh := four_geometric_log_mesh_spec D x hD hxexp
  have hh : 0 < h := hmesh.1
  have hh1 : h ≤ 1 := hmesh.2.1
  have hcardB : (B.card : ℝ) ≤ (6 : ℝ) ^ 4 * l ^ E :=
    small_prime_geometric_box_card_polylog (arity := 2) (by decide) D x hD hxexp
  have hcardV : (V.card : ℝ) ≤ (6 : ℝ) ^ 4 * l ^ E :=
    (Nat.cast_le.mpr (Finset.card_filter_le B _)).trans hcardB
  have hBbound (b : Fin 3 → ℕ) (hb : b ∈ V) :
      (∑ q ∈ Q, ‖fullDiscrepancy (Fbox b) q a₀‖) ≤ Kb * x / l ^ (A + E) := by
    obtain ⟨p, hp, hCp⟩ := (Finset.mem_filter.mp hb).2
    have hpT := (Finset.mem_filter.mp hp).1
    have hlabel := (Finset.mem_filter.mp hp).2
    have hCp' := hCp
    rw [hCdef] at hCp'
    let Lb (i : Fin 3) : ℝ := max (x ^ ((9519 : ℝ) / 50000)) ((1 + h) ^ b i)
    let Rb (i : Fin 3) : ℝ := min (x ^ ((9 : ℝ) / 10))
      ((⌈(1 + h) ^ (b i + 1)⌉₊ - 1 : ℕ) : ℝ)
    have hscales := small_prime_geometric_active_scales (arity := 2) (by decide)
      x h hx2 hh hh1 b p (Fintype.mem_piFinset.mp hpT)
        (fun i => congrFun hlabel i) hCp'.1
    have hU : U b = Fintype.piFinset (fun i : Fin 3 =>
        (Finset.Icc ⌈Lb i⌉₊ ⌊Rb i⌋₊).filter Nat.Prime) := by
      have hboxes := (finite_small_prime_box_cut_decomposition P bin C).1 b
      change U b = Fintype.piFinset
        (fun i : Fin 3 => P.filter (fun p => bin p = b i)) at hboxes
      rw [hboxes]
      congr 1
      funext i
      exact small_prime_geometric_bin_eq_closed_interval x h hx0 hh (b i)
    have hpLU (i : Fin 3) : Lb i ≤ (p i : ℝ) ∧ (p i : ℝ) ≤ Rb i ∧ Rb i ≤ 2 * Lb i := by
      have hpbox : p ∈ Fintype.piFinset (fun i : Fin 3 =>
          (Finset.Icc ⌈Lb i⌉₊ ⌊Rb i⌋₊).filter Nat.Prime) := hU ▸ hp
      have hpi := Finset.mem_Icc.mp (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hpbox i)).1
      have hRb : 0 ≤ Rb i := le_min (Real.rpow_nonneg hx0.le _) (Nat.cast_nonneg _)
      exact ⟨Nat.ceil_le.mp hpi.1, (Nat.le_floor_iff hRb).mp hpi.2,
        (hscales.1 i).2.2⟩
    have hprod : ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x :=
      (Nat.le_floor_iff (by positivity : 0 ≤ 2 * x)).mp (Finset.mem_Icc.mp hCp'.1).2
    have hwide := hnearby x hxn p (hprime p hpT) hprod hCp'.2 Lb Rb hpLU
    have hcoeff : ((primeIntervalBoxAlgebra Lb Rb Finset.univ).coeff.filter R) = Fbox b := by
      have hbase : (primeIntervalBoxAlgebra Lb Rb Finset.univ).coeff =
          ∑ p ∈ U b, Finsupp.single (∏ i, p i) (1 : ℂ) := by
        simpa only [MonoidAlgebra.coeff_sum, MonoidAlgebra.coeff_single, hU] using
          congrArg (fun f : MonoidAlgebra ℂ ℕ => f.coeff)
            (primeIntervalBoxAlgebra_univ_eq_tuple_sum Lb Rb)
      rw [hbase, Finsupp.filter_sum]
      apply Finset.sum_congr rfl
      intro q _hq
      by_cases hr : R (∏ i, q i)
      · rw [Finsupp.filter_single_of_pos R hr, ite_eq_left hr]
      · rw [Finsupp.filter_single_of_neg R hr, ite_eq_right hr, Finsupp.single_zero]
    have hb' := hbox x hxb Lb Rb (fun i => (hwide i).1)
      (fun i => ⟨(hscales.1 i).2.1, (hscales.1 i).2.2⟩)
      (fun i => (hwide i).2.1) I hI a₀ ha
    change (∑ q ∈ Q, ‖fullDiscrepancy
      ((primeIntervalBoxAlgebra Lb Rb Finset.univ).coeff.filter (fun n => n ∈ N)) q a₀‖) ≤ _ at hb'
    have hcoeffN :
        ((primeIntervalBoxAlgebra Lb Rb Finset.univ).coeff.filter (fun n => n ∈ N)) =
          Fbox b := by
      simpa only [hRdef] using hcoeff
    rw [hcoeffN] at hb'
    exact hb'
  have hinterior :
      (∑ b ∈ V, ∑ q ∈ Q, ‖fullDiscrepancy (Fbox b) q a₀‖) ≤
        (6 : ℝ) ^ 4 * Kb * x / l ^ A := by
    calc
      _ ≤ ∑ b ∈ V, Kb * x / l ^ (A + E) := Finset.sum_le_sum hBbound
      _ = (V.card : ℝ) * (Kb * x / l ^ (A + E)) := by simp
      _ ≤ ((6 : ℝ) ^ 4 * l ^ E) * (Kb * x / l ^ (A + E)) :=
        mul_le_mul_of_nonneg_right hcardV (by positivity)
      _ = _ := by
        dsimp only [l]
        rw [Real.rpow_add hlog0]
        field_simp [(Real.rpow_pos_of_pos hlog0 A).ne',
          (Real.rpow_pos_of_pos hlog0 E).ne']
  have hW : W = B.filter
      (fun b => (∃ p ∈ U b, C p) ∧ ¬∀ p ∈ U b, C p) := by
    ext b
    simp only [W, V, Finset.mem_filter, and_assoc]
  have hmass : (∑ b ∈ W, ((U b).card : ℝ)) ≤
      (M.card : ℝ) * 64 * (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
        (1 + Real.log (64 * x)) ^ 16 := by
    rw [hW]
    apply boolean_small_monomial_mixed_geometric_box_card
      (arity := 2) (by decide) x h hx2 hh hh1 M C hM hboolean
    intro p hp hCp
    have hN := hCR p hp hCp
    rw [hRdef] at hN
    exact (Nat.cast_le.mpr (Finset.mem_Icc.mp hN).2).trans
      (Nat.floor_le (by positivity))
  have hQsub : Q ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ := Finset.filter_subset _ _
  clear_value P bin Q
  have hφsum : (∑ q ∈ Q, 1 / (q.totient : ℝ)) ≤ 4 * l ^ 2 := by
    let Q₀ := Finset.Icc 1 ⌊x ^ θ⌋₊
    have hq1 : 1 ≤ ⌊x ^ θ⌋₊ :=
      Nat.le_floor (by simpa only [Nat.cast_one] using Real.one_le_rpow hx1 hθ0.le)
    have hqx : (⌊x ^ θ⌋₊ : ℝ) ≤ x :=
      (Nat.floor_le (Real.rpow_nonneg hx0.le θ)).trans
        (Real.rpow_le_self_of_one_le hx1 hθ1.le)
    have hlogQ : Real.log (⌊x ^ θ⌋₊ : ℝ) ≤ l :=
      Real.log_le_log (by exact_mod_cast zero_lt_one.trans_le hq1) hqx
    have hmoment : (∑ q ∈ Q₀, 1 / (q.totient : ℝ)) ≤
        (harmonic ⌊x ^ θ⌋₊ : ℝ) ^ 2 := by
      calc
        _ ≤ ∑ q ∈ Q₀, (q.divisors.card : ℝ) / (q : ℝ) := by
          apply Finset.sum_le_sum
          intro q hq
          have hq0 : 0 < (q : ℝ) := Nat.cast_pos.mpr (Finset.mem_Icc.mp hq).1
          have ht := div_totient_le_card_divisors q
          calc
            1 / (q.totient : ℝ) = ((q : ℝ) / (q.totient : ℝ)) / q := by
              field_simp [hq0.ne']
            _ ≤ _ := div_le_div_of_nonneg_right ht hq0.le
        _ ≤ ∑ q ∈ Q₀,
            (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 2) q : ℝ) / (q : ℝ) := by
          apply Finset.sum_le_sum
          intro q hq
          apply div_le_div_of_nonneg_right _ (Nat.cast_nonneg q)
          have ht := card_divisors_pow_le_zeta_pow 1 q
            (Finset.mem_Icc.mp hq).1
          norm_num only [pow_one, pow_one] at ht
          exact_mod_cast ht
        _ ≤ _ := sum_zeta_pow_div_le_harmonic_pow 2 _
    have hH : (harmonic ⌊x ^ θ⌋₊ : ℝ) ≤ 2 * l := by
      have ht := (harmonic_le_one_add_log ⌊x ^ θ⌋₊).trans (add_le_add (le_refl 1) hlogQ)
      dsimp only [l] at *
      linarith
    have hsub : Q ⊆ Q₀ := hQsub
    exact (Finset.sum_le_sum_of_subset_of_nonneg hsub
      (fun _ _ _ => by positivity)).trans
      (hmoment.trans ((pow_le_pow_left₀ (by unfold harmonic; positivity) hH 2).trans_eq
        (by ring)))
  have hsmallx : l ^ (A + 18) ≤ x ^ ((9519 : ℝ) / 50000) := by
    simpa only [Real.norm_of_nonneg (Real.rpow_nonneg hlog0.le _),
      Real.norm_of_nonneg (Real.rpow_nonneg hx0.le _), l] using hXs x hxs
  have hmassScaled : (∑ b ∈ W, ((U b).card : ℝ)) / 32 ≤
      17 * 64 * (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
        (1 + Real.log (64 * x)) ^ 16 := by
    apply (div_le_iff₀ (by norm_num : (0 : ℝ) < 32)).mpr
    have hcount : (M.card : ℝ) ≤ 32 := by exact_mod_cast hMcard
    have hz : 0 ≤ 64 * (1023 * h * x + x ^ (1 - (9519 : ℝ) / 50000)) *
        (1 + Real.log (64 * x)) ^ 16 := by positivity
    nlinarith only [hmass, mul_le_mul_of_nonneg_right hcount hz, hz]
  have hboundary :
      2 * (∑ b ∈ W, ((U b).card : ℝ)) * (∑ q ∈ Q, 1 / (q.totient : ℝ)) ≤
        (32 * Cb) * x / l ^ A := by
    have hmassNonneg : 0 ≤ ∑ b ∈ W, ((U b).card : ℝ) :=
      Finset.sum_nonneg fun _ _ => Nat.cast_nonneg _
    have hφNonneg : 0 ≤ ∑ q ∈ Q, 1 / (q.totient : ℝ) :=
      Finset.sum_nonneg fun _ _ => one_div_nonneg.mpr (Nat.cast_nonneg _)
    have hb := minorant_boundary_log_arithmetic A x
      ((∑ b ∈ W, ((U b).card : ℝ)) / 32) (∑ q ∈ Q, 1 / (q.totient : ℝ))
      hA hxexp (div_nonneg hmassNonneg (by norm_num)) hφNonneg hmassScaled hφsum hsmallx
    calc
      _ = 32 * (2 * ((∑ b ∈ W, ((U b).card : ℝ)) / 32) *
          (∑ q ∈ Q, 1 / (q.totient : ℝ))) := by ring
      _ ≤ 32 * (Cb * x / l ^ A) := mul_le_mul_of_nonneg_left hb (by norm_num)
      _ = _ := by ring
  have harith : (6 : ℝ) ^ 4 * Kb * x / l ^ A +
      (32 * Cb) * x / l ^ A = K * x / l ^ A := by
    dsimp only [K]
    ring
  have hcover := finite_small_prime_box_relative_discrepancy_cover
    (arity := 2) P bin C R hCR Q (fun _ => a₀)
  exact hcover.trans ((add_le_add hinterior hboundary).trans_eq harith)

open Classical in
theorem sourceT3_lower_dense_log_saving_of_deligne
    (τ : ℝ) (hτ : 0 < τ) (hτsmall : τ ≤ (1 / 10 ^ 10 : ℝ))
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : Fin 2) («ω» δ : ℝ) (hω : 0 < «ω») (hδ : 0 < δ)
    (hlevel : (1 / 2 : ℝ) + 2 * «ω» <
      59519 / 100000 - τ)
    (hsmooth : (1 / 4 : ℝ) + 7 * «ω» + 2 * δ <
      1058 / 3125 - τ)
    (hI : if j = 0 then
      54 * «ω» + 15 * δ + 5 * (1 / 2 - 40481 / 100000 + τ) < 1
      else
      56 * «ω» + 16 * δ + 4 * (1 / 2 - 40481 / 100000 + τ) < 1)
    (hII : 68 * «ω» + 14 * δ < 1)
    (hthree : (1 / 18 : ℝ) + 28 * «ω» / 9 + 2 * δ / 9 <
      19 / 200 - τ)
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Filter.Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x)
      Filter.atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ),
        (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let ρx : ℕ →₀ ℂ :=
          ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n ((sourceT3 x n : ℝ) : ℂ)
        let Q : Finset ℕ :=
          (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter
            (fun q => q ∣ ∏ p ∈ I, p ∧
              Nonempty (DenseDivisibilityWitness
                Y (j.val + 1) q))
        (∑ q ∈ Q, ‖fullDiscrepancy ρx q a‖) ≤
          K * x / (Real.log x) ^ A := by
  let σ : ℝ := 1 / 2 - 40481 / 100000 + τ
  have hsource :
      ((j.val + 1) = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      ((j.val + 1) = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      ((j.val + 1) = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1) := by
    fin_cases j
    · left
      exact ⟨rfl, by simpa [σ] using hI, hII⟩
    · right
      left
      exact ⟨rfl, by simpa [σ] using hI, hII⟩
  have hthree' : (1 / 18 : ℝ) + 28 / 9 * «ω» + 2 / 9 * δ <
      19 / 200 - τ := by linarith only [hthree]
  obtain ⟨ω', δ', σdist, σIII, _hωretreat, _hδretreat, hω', hωupper, hδ',
    hσclass, hσhalf, hσIIIlo, hσIIIhi, _hlevel', hsmooth', hsource', hfamily⟩ :=
    sourceT3_scalar_retreat τ hτ hτsmall
      (j.val + 1) «ω» δ hω hδ hlevel hsmooth hthree' hsource
      L0 hL0 hL0sub
  obtain ⟨Xr, hXr⟩ := eventually_atTop.mp hfamily
  intro A hA
  obtain ⟨K, Xb, hK, hXb, hb⟩ :=
    sourceT3_selected_dense_log_saving_of_deligne τ hτ hτsmall
      hDeligne (j.val + 1) (by omega) ω' δ'
      hω' hωupper hδ' σdist σIII hσclass hσhalf hσIIIlo hσIIIhi hsmooth' hsource' A hA
  refine ⟨K, max Xb Xr, hK, ?_, ?_⟩
  · exact (Real.one_lt_exp_iff.mpr (by norm_num : (0 : ℝ) < 100)).trans_le
      (hXb.trans (le_max_left _ _))
  · intro x hx Y hY I hIprime a₀ ha F Q
    have hxb : Xb ≤ x := (le_max_left _ _).trans hx
    have hxr : Xr ≤ x := (le_max_right _ _).trans hx
    have hsubset := (hXr x hxr).2.2 Y hY I
    have h := hb x hxb I hIprime a₀ ha
    exact (Finset.sum_le_sum_of_subset_of_nonneg hsubset
      (fun q _ _ => norm_nonneg (fullDiscrepancy F q a₀))).trans h

open Classical in
theorem sourceT3_triply_dense_log_saving_of_deligne
    (τ : ℝ) (hτ : 0 < τ) (hτsmall : τ ≤ (1 / 10 ^ 10 : ℝ))
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    («ω» δ : ℝ) (hω : 0 < «ω») (hδ : 0 < δ)
    (hlevel : (1 / 2 : ℝ) + 2 * «ω» <
      59519 / 100000 - τ)
    (hsmooth : (1 / 4 : ℝ) + 7 * «ω» + 2 * δ <
      1058 / 3125 - τ)
    (hI : 72 * «ω» + 24 * δ < 1)
    (hII : (1 / 4 : ℝ) + 12 * «ω» + 4 * δ <
      40481 / 100000 - τ)
    (hIII : 32 * «ω» + 10 * δ <
      40481 / 100000 - τ)
    (hthree : (1 / 18 : ℝ) + 28 * «ω» / 9 + 2 * δ / 9 <
      19 / 200 - τ)
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Filter.Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x)
      Filter.atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ),
        (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let ρx : ℕ →₀ ℂ :=
          ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n ((sourceT3 x n : ℝ) : ℂ)
        let Q : Finset ℕ :=
          (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter
            (fun q => q ∣ ∏ p ∈ I, p ∧
              Nonempty (DenseDivisibilityWitness Y 3 q))
        (∑ q ∈ Q, ‖fullDiscrepancy ρx q a‖) ≤
          K * x / (Real.log x) ^ A := by
  let σ : ℝ := 1 / 2 - 40481 / 100000 + τ
  have hsource :
      (3 = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (3 = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (3 = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1) := by
    right
    right
    refine ⟨rfl, hI, ?_, ?_⟩
    · dsimp only [σ]
      linarith
    · dsimp only [σ]
      linarith
  have hthree' : (1 / 18 : ℝ) + 28 / 9 * «ω» + 2 / 9 * δ <
      19 / 200 - τ := by linarith only [hthree]
  obtain ⟨ω', δ', σdist, σIII, _hωretreat, _hδretreat, hω', hωupper, hδ',
    hσclass, hσhalf, hσIIIlo, hσIIIhi, _hlevel', hsmooth', hsource', hfamily⟩ :=
    sourceT3_scalar_retreat τ hτ hτsmall 3 «ω» δ hω hδ hlevel hsmooth hthree' hsource
      L0 hL0 hL0sub
  obtain ⟨Xr, hXr⟩ := eventually_atTop.mp hfamily
  intro A hA
  obtain ⟨K, Xb, hK, hXb, hb⟩ :=
    sourceT3_selected_dense_log_saving_of_deligne τ hτ hτsmall
      hDeligne 3 (by omega) ω' δ'
      hω' hωupper hδ' σdist σIII hσclass hσhalf hσIIIlo hσIIIhi hsmooth' hsource' A hA
  refine ⟨K, max Xb Xr, hK, ?_, ?_⟩
  · exact (Real.one_lt_exp_iff.mpr (by norm_num : (0 : ℝ) < 100)).trans_le
      (hXb.trans (le_max_left _ _))
  · intro x hx Y hY I hIprime a₀ ha F Q
    have hxb : Xb ≤ x := (le_max_left _ _).trans hx
    have hxr : Xr ≤ x := (le_max_right _ _).trans hx
    have hsubset := (hXr x hxr).2.2 Y hY I
    have h := hb x hxb I hIprime a₀ ha
    exact (Finset.sum_le_sum_of_subset_of_nonneg hsubset
      (fun q _ _ => norm_nonneg (fullDiscrepancy F q a₀))).trans h

open Classical in
theorem siftedTheta_restricted_harman_raw_long_identity
    (x : ℝ) (hx : 1 < x) (l : Fin 6) (w : List ℕ → ℝ)
    (n : ℕ) (hn : n ≤ ⌊2 * x⌋₊) :
    let H := x ^ ((40481 : ℝ) / 100000)
    let z := x ^ ((9519 : ℝ) / 50000)
    let M0 := x ^ (1 - (1058 : ℝ) / 3125)
    let C := Finset.Icc 1 ⌊2 * x⌋₊
    let U (ps : List ℕ) : ArithmeticFunction ℝ :=
      ⟨fun r => if r = 0 then 0 else
        if r = (siftedPrimeGroups l ps).1 then 1 else 0, by simp⟩
    let V (ps : List ℕ) : ArithmeticFunction ℝ :=
      ⟨fun s => if s = 0 then 0 else
        if s = (siftedPrimeGroups l ps).2 then 1 else 0, by simp⟩
    let rawLong : ℝ := ∑ ps ∈ siftedPrimeTuples x l,
      let r := (siftedPrimeGroups l ps).1
      let s := (siftedPrimeGroups l ps).2
      w ps * ∑ h ∈ C, ∑ d ∈ C, ∑ k ∈ C,
        if ps.prod * h * d * k = n ∧ 1 < h ∧
            ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧
            ((r * h : ℕ) : ℝ) / (h.minFac : ℝ) < H ∧
            H ≤ ((r * h : ℕ) : ℝ) ∧
            max 1 (d.primeFactors.sup id) < h.minFac ∧
            M0 < ((r * s * h * d : ℕ) : ℝ) then
          (ArithmeticFunction.moebius h : ℝ) * (ArithmeticFunction.moebius d : ℝ)
        else 0
    (∑ ps ∈ siftedPrimeTuples x l, w ps *
      ∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
        ∑ c ∈ b.2.divisorsAntidiagonal, ∑ e ∈ c.2.divisorsAntidiagonal,
          if 1 < c.1 ∧
              ((max 1 (c.1.primeFactors.sup id) : ℕ) : ℝ) < z ∧
              ((a.1 * c.1 : ℕ) : ℝ) / (c.1.minFac : ℝ) < H ∧
              H ≤ ((a.1 * c.1 : ℕ) : ℝ) ∧
              max 1 (e.1.primeFactors.sup id) < c.1.minFac ∧
              M0 < ((a.1 * b.1 * c.1 * e.1 : ℕ) : ℝ) then
            U ps a.1 * V ps b.1 * (ArithmeticFunction.moebius c.1 : ℝ) *
              (ArithmeticFunction.moebius e.1 : ℝ)
          else 0) = rawLong ∧
      siftedTheta x l w n =
        (∑ ps ∈ siftedPrimeTuples x l, w ps *
          (harmanA0 (U ps) (V ps) z M0 *
            (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n) + rawLong := by
  intro H z M0 C U V rawLong
  have hfinite (r s : ℕ) (hr : 0 < r) (hs : 0 < s) (F : ℕ → ℕ → ℝ) :
      (∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
        ∑ c ∈ b.2.divisorsAntidiagonal, ∑ e ∈ c.2.divisorsAntidiagonal,
          if a.1 = r ∧ b.1 = s then F c.1 e.1 else 0) =
        ∑ h ∈ C, ∑ d ∈ C, ∑ k ∈ C,
          if r * s * h * d * k = n then F h d else 0 := by
    let T : Finset (Σ _ : ℕ × ℕ, Σ _ : ℕ × ℕ, Σ _ : ℕ × ℕ, ℕ × ℕ) :=
      (n.divisorsAntidiagonal.sigma (fun a =>
        a.2.divisorsAntidiagonal.sigma (fun b =>
          b.2.divisorsAntidiagonal.sigma (fun c => c.2.divisorsAntidiagonal)))).filter
        (fun v => v.1.1 = r ∧ v.2.1.1 = s)
    let R : Finset (ℕ × (ℕ × ℕ)) :=
      (C ×ˢ (C ×ˢ C)).filter (fun u => r * s * u.1 * u.2.1 * u.2.2 = n)
    let f : (Σ _ : ℕ × ℕ, Σ _ : ℕ × ℕ, Σ _ : ℕ × ℕ, ℕ × ℕ) →
        ℕ × (ℕ × ℕ) := fun v => (v.2.2.1.1, (v.2.2.2.1, v.2.2.2.2))
    calc
      _ = ∑ v ∈ T, F v.2.2.1.1 v.2.2.2.1 := by
        simp only [T, Finset.sum_filter, Finset.sum_sigma]
      _ = ∑ u ∈ R, F u.1 u.2.1 := by
        refine Finset.sum_bij (fun v _ => f v) ?_ ?_ ?_ (fun _ _ => rfl)
        · intro v hv
          obtain ⟨hvT, hvEq⟩ := Finset.mem_filter.mp hv
          obtain ⟨ha, hbc⟩ := Finset.mem_sigma.mp hvT
          obtain ⟨hb, hce⟩ := Finset.mem_sigma.mp hbc
          obtain ⟨hc, he⟩ := Finset.mem_sigma.mp hce
          have htotal : r * s * v.2.2.1.1 * v.2.2.2.1 * v.2.2.2.2 = n := by
            rw [← hvEq.1, ← hvEq.2]
            simp only [Nat.mul_assoc, (Nat.mem_divisorsAntidiagonal.mp he).1,
              (Nat.mem_divisorsAntidiagonal.mp hc).1,
              (Nat.mem_divisorsAntidiagonal.mp hb).1,
              (Nat.mem_divisorsAntidiagonal.mp ha).1]
          have hnpos : 0 < n :=
            Nat.pos_of_ne_zero (Nat.mem_divisorsAntidiagonal.mp ha).2
          have hbox (m : ℕ) (hm : 0 < m) (hmd : m ∣ n) : m ∈ C :=
            Finset.mem_Icc.mpr ⟨hm, (Nat.le_of_dvd hnpos hmd).trans hn⟩
          have hhdiv : v.2.2.1.1 ∣ n := by
            refine ⟨r * s * v.2.2.2.1 * v.2.2.2.2, ?_⟩
            rw [← htotal]
            ring
          have hddiv : v.2.2.2.1 ∣ n := by
            refine ⟨r * s * v.2.2.1.1 * v.2.2.2.2, ?_⟩
            rw [← htotal]
            ring
          have hkdiv : v.2.2.2.2 ∣ n := by
            refine ⟨r * s * v.2.2.1.1 * v.2.2.2.1, ?_⟩
            rw [← htotal]
            ring
          apply Finset.mem_filter.mpr
          refine ⟨Finset.mem_product.mpr ⟨?_, Finset.mem_product.mpr ⟨?_, ?_⟩⟩,
            htotal⟩
          · exact hbox _
              (Nat.pos_of_ne_zero (Nat.left_ne_zero_of_mem_divisorsAntidiagonal hc)) hhdiv
          · exact hbox _
              (Nat.pos_of_ne_zero (Nat.left_ne_zero_of_mem_divisorsAntidiagonal he)) hddiv
          · exact hbox _
              (Nat.pos_of_ne_zero (Nat.right_ne_zero_of_mem_divisorsAntidiagonal he)) hkdiv
        · intro v hv v' hv' heq
          dsimp only [f] at heq
          have hh : v.2.2.1.1 = v'.2.2.1.1 :=
            congrArg (fun u : ℕ × (ℕ × ℕ) => u.1) heq
          have hd : v.2.2.2.1 = v'.2.2.2.1 :=
            congrArg (fun u : ℕ × (ℕ × ℕ) => u.2.1) heq
          have hk : v.2.2.2.2 = v'.2.2.2.2 :=
            congrArg (fun u : ℕ × (ℕ × ℕ) => u.2.2) heq
          obtain ⟨hvT, hvEq⟩ := Finset.mem_filter.mp hv
          obtain ⟨hv'T, hv'Eq⟩ := Finset.mem_filter.mp hv'
          obtain ⟨_ha, hbc⟩ := Finset.mem_sigma.mp hvT
          obtain ⟨hb, hce⟩ := Finset.mem_sigma.mp hbc
          obtain ⟨hc, he⟩ := Finset.mem_sigma.mp hce
          obtain ⟨_ha', hbc'⟩ := Finset.mem_sigma.mp hv'T
          obtain ⟨hb', hce'⟩ := Finset.mem_sigma.mp hbc'
          obtain ⟨hc', he'⟩ := Finset.mem_sigma.mp hce'
          have hctail : v.2.2.1.2 = v'.2.2.1.2 := by
            rw [← (Nat.mem_divisorsAntidiagonal.mp he).1,
              ← (Nat.mem_divisorsAntidiagonal.mp he').1, hd, hk]
          have hbtail : v.2.1.2 = v'.2.1.2 := by
            rw [← (Nat.mem_divisorsAntidiagonal.mp hc).1,
              ← (Nat.mem_divisorsAntidiagonal.mp hc').1, hh, hctail]
          have hatail : v.1.2 = v'.1.2 := by
            rw [← (Nat.mem_divisorsAntidiagonal.mp hb).1,
              ← (Nat.mem_divisorsAntidiagonal.mp hb').1,
              hvEq.2.trans hv'Eq.2.symm, hbtail]
          exact Sigma.ext (Prod.ext (hvEq.1.trans hv'Eq.1.symm) hatail)
            (heq_of_eq (Sigma.ext (Prod.ext (hvEq.2.trans hv'Eq.2.symm) hbtail)
              (heq_of_eq (Sigma.ext (Prod.ext hh hctail) (heq_of_eq (Prod.ext hd hk))))))
        · intro u hu
          obtain ⟨huR, hproduct⟩ := Finset.mem_filter.mp hu
          obtain ⟨hhC, hdkC⟩ := Finset.mem_product.mp huR
          obtain ⟨hdC, hkC⟩ := Finset.mem_product.mp hdkC
          have hhpos : 0 < u.1 := (Finset.mem_Icc.mp hhC).1
          have hdpos : 0 < u.2.1 := (Finset.mem_Icc.mp hdC).1
          have hkpos : 0 < u.2.2 := (Finset.mem_Icc.mp hkC).1
          have hdk : u.2.1 * u.2.2 ≠ 0 := (Nat.mul_pos hdpos hkpos).ne'
          have hhdk : u.1 * (u.2.1 * u.2.2) ≠ 0 :=
            (Nat.mul_pos hhpos (Nat.mul_pos hdpos hkpos)).ne'
          have hshdk : s * (u.1 * (u.2.1 * u.2.2)) ≠ 0 :=
            (Nat.mul_pos hs (Nat.mul_pos hhpos (Nat.mul_pos hdpos hkpos))).ne'
          have hnzero : n ≠ 0 := by
            rw [← hproduct]
            exact (Nat.mul_pos (Nat.mul_pos (Nat.mul_pos (Nat.mul_pos hr hs) hhpos)
              hdpos) hkpos).ne'
          let v : Σ _ : ℕ × ℕ, Σ _ : ℕ × ℕ, Σ _ : ℕ × ℕ, ℕ × ℕ :=
            ⟨(r, s * (u.1 * (u.2.1 * u.2.2))),
              ⟨(s, u.1 * (u.2.1 * u.2.2)), ⟨(u.1, u.2.1 * u.2.2), u.2⟩⟩⟩
          have hv : v ∈ T := by
            apply Finset.mem_filter.mpr
            refine ⟨Finset.mem_sigma.mpr ⟨?_,
              Finset.mem_sigma.mpr ⟨?_, Finset.mem_sigma.mpr ⟨?_, ?_⟩⟩⟩, ⟨rfl, rfl⟩⟩
            · exact Nat.mem_divisorsAntidiagonal.mpr
                ⟨by simpa only [Nat.mul_assoc] using hproduct, hnzero⟩
            · exact Nat.mem_divisorsAntidiagonal.mpr ⟨rfl, hshdk⟩
            · exact Nat.mem_divisorsAntidiagonal.mpr ⟨rfl, hhdk⟩
            · exact Nat.mem_divisorsAntidiagonal.mpr ⟨rfl, hdk⟩
          exact ⟨v, hv, rfl⟩
      _ = _ := by
        simp only [R, Finset.sum_filter, Finset.sum_product]
  have hdelta (d : ℕ) (hd : 0 < d) (m : ℕ) :
      (if m = 0 then (0 : ℝ) else if m = d then 1 else 0) =
        if m = d then 1 else 0 := by
    by_cases hm : m = 0 <;> simp [hm, hd.ne]
  have hraw : (∑ ps ∈ siftedPrimeTuples x l, w ps *
      ∑ a ∈ n.divisorsAntidiagonal, ∑ b ∈ a.2.divisorsAntidiagonal,
        ∑ c ∈ b.2.divisorsAntidiagonal, ∑ e ∈ c.2.divisorsAntidiagonal,
          if 1 < c.1 ∧
              ((max 1 (c.1.primeFactors.sup id) : ℕ) : ℝ) < z ∧
              ((a.1 * c.1 : ℕ) : ℝ) / (c.1.minFac : ℝ) < H ∧
              H ≤ ((a.1 * c.1 : ℕ) : ℝ) ∧
              max 1 (e.1.primeFactors.sup id) < c.1.minFac ∧
              M0 < ((a.1 * b.1 * c.1 * e.1 : ℕ) : ℝ) then
            U ps a.1 * V ps b.1 * (ArithmeticFunction.moebius c.1 : ℝ) *
              (ArithmeticFunction.moebius e.1 : ℝ)
          else 0) = rawLong := by
    dsimp only [rawLong]
    apply Finset.sum_congr rfl
    intro ps hps
    apply congrArg (fun t : ℝ => w ps * t)
    let r := (siftedPrimeGroups l ps).1
    let s := (siftedPrimeGroups l ps).2
    obtain ⟨hr, hs, hprod, _, _, _⟩ := siftedPrimeTuples_group_bounds x hx l ps hps
    have hU (a : ℕ) : U ps a = if a = r then 1 else 0 := hdelta _ hr a
    have hV (b : ℕ) : V ps b = if b = s then 1 else 0 := hdelta _ hs b
    let F (h d : ℕ) : ℝ :=
      if 1 < h ∧ ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧
          ((r * h : ℕ) : ℝ) / (h.minFac : ℝ) < H ∧
          H ≤ ((r * h : ℕ) : ℝ) ∧
          max 1 (d.primeFactors.sup id) < h.minFac ∧
          M0 < ((r * s * h * d : ℕ) : ℝ) then
        (ArithmeticFunction.moebius h : ℝ) * (ArithmeticFunction.moebius d : ℝ)
      else 0
    have hpoint (a b h d : ℕ) :
        (if 1 < h ∧ ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧
            ((a * h : ℕ) : ℝ) / (h.minFac : ℝ) < H ∧
            H ≤ ((a * h : ℕ) : ℝ) ∧
            max 1 (d.primeFactors.sup id) < h.minFac ∧
            M0 < ((a * b * h * d : ℕ) : ℝ) then
          U ps a * V ps b * (ArithmeticFunction.moebius h : ℝ) *
            (ArithmeticFunction.moebius d : ℝ) else 0) =
          if a = r ∧ b = s then F h d else 0 := by
      by_cases ha : a = r <;> by_cases hb : b = s <;> simp [hU, hV, ha, hb, F]
    simp_rw [hpoint]
    simpa only [F, r, s, ← ite_and, hprod] using hfinite r s hr hs F
  refine ⟨hraw, ?_⟩
  rw [← hraw]
  simpa only [mul_add, Finset.sum_add_distrib] using
    siftedTheta_restricted_harman_decomposition x hx l w n

open Classical in
theorem signed_finite_box_discrepancy_cover {α ι : Type*} [DecidableEq ι]
    (T : Finset α) (key : α → ι) (v : α → ℕ) (w : α → ℝ)
    (Good : α → Prop) [DecidablePred Good] (Q : Finset ℕ) (a : ℕ → ℕ) :
    let B := T.image key
    let U (b : ι) := T.filter (fun t => key t = b)
    let I := B.filter (fun b => ∀ t ∈ U b, Good t)
    let D := B.filter (fun b =>
      (∃ t ∈ U b, Good t) ∧ ∃ t ∈ U b, ¬Good t)
    let Fcut : ℕ →₀ ℂ :=
      ∑ t ∈ T, Finsupp.single (v t) (if Good t then (w t : ℂ) else 0)
    let Fbox (b : ι) : ℕ →₀ ℂ :=
      ∑ t ∈ U b, Finsupp.single (v t) (w t : ℂ)
    let Gbox (b : ι) : ℕ →₀ ℂ :=
      ∑ t ∈ U b, Finsupp.single (v t) ((|w t| : ℝ) : ℂ)
    (∑ q ∈ Q, ‖fullDiscrepancy Fcut q (a q)‖) ≤
      (∑ b ∈ I, ∑ q ∈ Q, ‖fullDiscrepancy (Fbox b) q (a q)‖) +
        (∑ b ∈ D, ∑ q ∈ Q, ‖fullDiscrepancy (Gbox b) q (a q)‖) +
        2 * (∑ b ∈ D, ∑ t ∈ U b, |w t|) * ∑ q ∈ Q, 1 / (q.totient : ℝ) := by
  intro B U I D Fcut Fbox Gbox
  let E (b : ι) : ℕ →₀ ℂ :=
    ∑ t ∈ U b, Finsupp.single (v t) (if Good t then (w t : ℂ) else 0)
  have hsplit (test : α → ℂ) :
      (∑ t ∈ T, if Good t then test t else 0) =
        (∑ b ∈ I, ∑ t ∈ U b, test t) +
          ∑ b ∈ D, ∑ t ∈ U b, if Good t then test t else 0 := by
    have hbox (b : ι) :
        (∑ t ∈ U b, if Good t then test t else 0) =
          (if ∀ t ∈ U b, Good t then ∑ t ∈ U b, test t else 0) +
            if (∃ t ∈ U b, Good t) ∧ ∃ t ∈ U b, ¬Good t then
              ∑ t ∈ U b, if Good t then test t else 0
            else 0 := by
      by_cases hi : ∀ t ∈ U b, Good t
      · have hnb : ¬((∃ t ∈ U b, Good t) ∧ ∃ t ∈ U b, ¬Good t) := by
          rintro ⟨_, t, ht, hbad⟩
          exact hbad (hi t ht)
        rw [ite_eq_left hi, ite_eq_right hnb, add_zero]
        exact Finset.sum_congr rfl fun t ht => ite_eq_left (hi t ht)
      · have hbad : ∃ t ∈ U b, ¬Good t := by
          simpa only [not_forall, exists_prop] using hi
        by_cases hg : ∃ t ∈ U b, Good t
        · rw [ite_eq_right hi, ite_eq_left (And.intro hg hbad), zero_add]
        · have hnb : ¬((∃ t ∈ U b, Good t) ∧ ∃ t ∈ U b, ¬Good t) :=
            fun hb => hg hb.1
          rw [ite_eq_right hi, ite_eq_right hnb, zero_add]
          exact Finset.sum_eq_zero fun t ht =>
            ite_eq_right (fun hgood => hg ⟨t, ht, hgood⟩)
    calc
      _ = ∑ b ∈ B, ∑ t ∈ U b, if Good t then test t else 0 := by
        symm
        exact Finset.sum_fiberwise_of_maps_to
          (fun t ht => Finset.mem_image_of_mem key ht)
          (fun t => if Good t then test t else 0)
      _ = (∑ b ∈ B, if ∀ t ∈ U b, Good t then ∑ t ∈ U b, test t else 0) +
          ∑ b ∈ B,
            if (∃ t ∈ U b, Good t) ∧ ∃ t ∈ U b, ¬Good t then
              ∑ t ∈ U b, if Good t then test t else 0
            else 0 := by
        rw [← Finset.sum_add_distrib]
        exact Finset.sum_congr rfl fun b _ => hbox b
      _ = _ := by simp only [I, D, Finset.sum_filter]
  have hpush (S : Finset α) (f : α → ℂ) :
      (∑ t ∈ S, Finsupp.single (v t) (f t)) =
        ∑ n ∈ S.image v, Finsupp.single n (∑ t ∈ S, if v t = n then f t else 0) := by
    ext n
    simp only [Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_ite_eq']
    by_cases hn : n ∈ S.image v
    · rw [ite_eq_left hn]
    · rw [ite_eq_right hn]
      exact Finset.sum_eq_zero fun t ht =>
        ite_eq_right (fun heq => hn (Finset.mem_image.mpr ⟨t, ht, heq⟩))
  have hcutnorm (t : α) : ‖if Good t then (w t : ℂ) else 0‖ ≤ |w t| := by
    by_cases ht : Good t
    · simp only [ite_eq_left ht, Complex.norm_real, Real.norm_eq_abs, le_refl]
    · simpa only [ite_eq_right ht, norm_zero] using abs_nonneg (w t)
  have hboundary (b : ι) (q r : ℕ) :
      ‖fullDiscrepancy (E b) q r‖ ≤ ‖fullDiscrepancy (Gbox b) q r‖ +
        2 * (∑ t ∈ U b, |w t|) / (q.totient : ℝ) := by
    let V := (U b).image v
    let e : ℕ → ℂ := fun n =>
      ∑ t ∈ U b, if v t = n then (if Good t then (w t : ℂ) else 0) else 0
    let g : ℕ → ℝ := fun n => ∑ t ∈ U b, if v t = n then |w t| else 0
    have hE : E b = ∑ n ∈ V, Finsupp.single n (e n) :=
      hpush (U b) (fun t => if Good t then (w t : ℂ) else 0)
    have hcast (n : ℕ) : (g n : ℂ) =
        ∑ t ∈ U b, if v t = n then ((|w t| : ℝ) : ℂ) else 0 := by
      simp only [g, Complex.ofReal_sum, apply_ite Complex.ofReal, Complex.ofReal_zero]
    have hGbox : Gbox b = ∑ n ∈ V, Finsupp.single n (g n : ℂ) := by
      change (∑ t ∈ U b, Finsupp.single (v t) ((|w t| : ℝ) : ℂ)) = _
      rw [hpush]
      apply Finset.sum_congr rfl
      intro n _
      rw [hcast]
    have hg : ∀ n ∈ V, 0 ≤ g n := by
      intro n _
      exact Finset.sum_nonneg fun t _ => by split_ifs <;> positivity
    have heg : ∀ n ∈ V, ‖e n‖ ≤ g n := by
      intro n _
      apply (norm_sum_le _ _).trans
      apply Finset.sum_le_sum
      intro t _
      by_cases htn : v t = n
      · simpa only [ite_eq_left htn] using hcutnorm t
      · simp only [ite_eq_right htn, norm_zero, le_refl]
    have hmass : (∑ n ∈ V, g n) = ∑ t ∈ U b, |w t| := by
      dsimp only [g]
      rw [Finset.sum_comm]
      apply Finset.sum_congr rfl
      intro t ht
      exact Finset.sum_ite_eq_of_mem V (v t) (fun _ => |w t|)
        (Finset.mem_image_of_mem v ht)
    have hbound := fullDiscrepancy_sample_le_positive_majorant V e g hg heg q r
    rw [← hE, ← hGbox, hmass] at hbound
    exact hbound
  have hdelta (q : ℕ) : fullDiscrepancy Fcut q (a q) =
      (∑ b ∈ I, fullDiscrepancy (Fbox b) q (a q)) +
        ∑ b ∈ D, fullDiscrepancy (E b) q (a q) := by
    simpa only [Fcut, Fbox, E, fullDiscrepancy_indexed_sample, ite_mul, zero_mul] using
      hsplit (fun t => (w t : ℂ) *
        ((if v t % q = a q % q then (1 : ℂ) else 0) -
          (if Nat.Coprime (v t) q then (1 : ℂ) else 0) / (q.totient : ℂ)))
  have hpoint (q : ℕ) :
      ‖fullDiscrepancy Fcut q (a q)‖ ≤
        (∑ b ∈ I, ‖fullDiscrepancy (Fbox b) q (a q)‖) +
          (∑ b ∈ D, ‖fullDiscrepancy (Gbox b) q (a q)‖) +
          2 * (∑ b ∈ D, ∑ t ∈ U b, |w t|) / (q.totient : ℝ) := by
    calc
      _ = ‖(∑ b ∈ I, fullDiscrepancy (Fbox b) q (a q)) +
          ∑ b ∈ D, fullDiscrepancy (E b) q (a q)‖ := by rw [hdelta]
      _ ≤ (∑ b ∈ I, ‖fullDiscrepancy (Fbox b) q (a q)‖) +
          ∑ b ∈ D, ‖fullDiscrepancy (E b) q (a q)‖ :=
        (norm_add_le _ _).trans (add_le_add (norm_sum_le _ _) (norm_sum_le _ _))
      _ ≤ (∑ b ∈ I, ‖fullDiscrepancy (Fbox b) q (a q)‖) +
          ∑ b ∈ D, (‖fullDiscrepancy (Gbox b) q (a q)‖ +
            2 * (∑ t ∈ U b, |w t|) / (q.totient : ℝ)) :=
        add_le_add (le_refl _) (Finset.sum_le_sum fun b _ => hboundary b q (a q))
      _ = _ := by
        rw [Finset.sum_add_distrib, ← add_assoc, ← Finset.sum_div, ← Finset.mul_sum]
  calc
    _ ≤ ∑ q ∈ Q,
        ((∑ b ∈ I, ‖fullDiscrepancy (Fbox b) q (a q)‖) +
          (∑ b ∈ D, ‖fullDiscrepancy (Gbox b) q (a q)‖) +
          2 * (∑ b ∈ D, ∑ t ∈ U b, |w t|) / (q.totient : ℝ)) :=
      Finset.sum_le_sum fun q _ => hpoint q
    _ = _ := by
      rw [Finset.sum_add_distrib, Finset.sum_add_distrib]
      congr 1
      · congr 1 <;> exact Finset.sum_comm
      · simp only [div_eq_mul_inv, one_mul, Finset.mul_sum]

open Classical in
theorem siftedPrimeTuples_named_enumeration
    (x : ℝ) (hx : 1 < x) (l : Fin 6) (U : ℕ)
    (hU : ⌈x ^ ((40481 : ℝ) / 100000)⌉₊ ≤ U) (hUone : 1 ≤ U)
    (w : List ℕ → ℝ) :
    let C := Finset.Icc 1 U
    let ps (p q s : ℕ) : List ℕ := match l.val with
      | 0 => []
      | 1 => [p]
      | 2 => [p, s]
      | 3 => [p, s]
      | 4 => [q, p, s]
      | _ => [s, p, q]
    (∑ zs ∈ siftedPrimeTuples x l, w zs) =
      ∑ p ∈ C, ∑ q ∈ C, ∑ s ∈ C,
        if (match l.val with
          | 0 => p = 1 ∧ q = 1 ∧ s = 1
          | 1 => q = 1 ∧ s = 1
          | 2 => q = 1
          | 3 => q = 1
          | _ => True) ∧ ps p q s ∈ siftedPrimeTuples x l then
            w (ps p q s)
        else 0 := by
  intro C ps
  have hone : 1 ∈ C := Finset.mem_Icc.mpr ⟨le_refl _, hUone⟩
  have hentries (zs : List ℕ) (hzs : zs ∈ siftedPrimeTuples x l) :
      ∀ p ∈ zs, p ∈ C := by
    obtain ⟨_, _, _, hR, hS, hprime⟩ := siftedPrimeTuples_group_bounds x hx l zs hzs
    have hSle : x ^ (1 - (1058 : ℝ) / 3125) /
        x ^ ((40481 : ℝ) / 100000) ≤ x ^ ((40481 : ℝ) / 100000) := by
      rw [← Real.rpow_sub (zero_lt_one.trans hx)]
      exact Real.rpow_le_rpow_of_exponent_le hx.le (by norm_num)
    have htake (k p : ℕ) (hp : p ∈ zs.take k) : p ≤ (zs.take k).prod :=
      List.single_le_prod (fun q hq =>
        (hprime q (List.mem_of_mem_take hq)).1.one_le) p hp
    have hdrop (k p : ℕ) (hp : p ∈ zs.drop k) : p ≤ (zs.drop k).prod :=
      List.single_le_prod (fun q hq =>
        (hprime q (List.mem_of_mem_drop hq)).1.one_le) p hp
    intro p hp
    have hloc (k : ℕ) : p ∈ zs.take k ∨ p ∈ zs.drop k := by
      rw [← List.mem_append, List.take_append_drop]
      exact hp
    have hpH : (p : ℝ) < x ^ ((40481 : ℝ) / 100000) := by
      by_cases hl : l.val = 5
      · rcases hloc 1 with ht | hd
        · have hle : p ≤ (siftedPrimeGroups l zs).2 := by
            simpa only [siftedPrimeGroups, ite_eq_left hl] using htake 1 p ht
          exact (Nat.cast_le.mpr hle).trans_lt (hS.trans_le hSle)
        · have hle : p ≤ (siftedPrimeGroups l zs).1 := by
            simpa only [siftedPrimeGroups, ite_eq_left hl] using hdrop 1 p hd
          exact (Nat.cast_le.mpr hle).trans_lt hR
      · rcases hloc (if l.val = 4 then 2 else 1) with ht | hd
        · have hle : p ≤ (siftedPrimeGroups l zs).1 := by
            simpa only [siftedPrimeGroups, ite_eq_right hl] using
              htake (if l.val = 4 then 2 else 1) p ht
          exact (Nat.cast_le.mpr hle).trans_lt hR
        · have hle : p ≤ (siftedPrimeGroups l zs).2 := by
            simpa only [siftedPrimeGroups, ite_eq_right hl] using
              hdrop (if l.val = 4 then 2 else 1) p hd
          exact (Nat.cast_le.mpr hle).trans_lt (hS.trans_le hSle)
    exact Finset.mem_Icc.mpr ⟨(hprime p hp).1.pos, (Nat.lt_ceil.mpr hpH).le.trans hU⟩
  have hshape (zs : List ℕ) (hzs : zs ∈ siftedPrimeTuples x l) :
      match l.val with
      | 0 => zs = []
      | 1 => ∃ p, zs = [p]
      | 2 => ∃ p s, zs = [p, s]
      | 3 => ∃ p s, zs = [p, s]
      | 4 => ∃ p q s, zs = [q, p, s]
      | _ => ∃ p q s, zs = [s, p, q] := by
    have hmem := (mem_siftedPrimeTuples_iff x hx l zs).mp hzs
    fin_cases l <;>
      rcases zs with _ | ⟨p, _ | ⟨q, _ | ⟨s, _ | ⟨t, ts⟩⟩⟩⟩ <;>
      simp at hmem ⊢
  let R : Finset (ℕ × (ℕ × ℕ)) :=
    (C ×ˢ (C ×ˢ C)).filter (fun t =>
      (match l.val with
        | 0 => t.1 = 1 ∧ t.2.1 = 1 ∧ t.2.2 = 1
        | 1 => t.2.1 = 1 ∧ t.2.2 = 1
        | 2 => t.2.1 = 1
        | 3 => t.2.1 = 1
        | _ => True) ∧ ps t.1 t.2.1 t.2.2 ∈ siftedPrimeTuples x l)
  calc
    _ = ∑ t ∈ R, w (ps t.1 t.2.1 t.2.2) := by
      symm
      refine Finset.sum_bij (fun t _ => ps t.1 t.2.1 t.2.2) ?_ ?_ ?_
        (fun _ _ => rfl)
      · intro t ht
        exact (Finset.mem_filter.mp ht).2.2
      · intro t ht t' ht' heq
        have htDummy := (Finset.mem_filter.mp ht).2.1
        have ht'Dummy := (Finset.mem_filter.mp ht').2.1
        rcases t with ⟨p, q, s⟩
        rcases t' with ⟨p', q', s'⟩
        fin_cases l
        · change p = 1 ∧ q = 1 ∧ s = 1 at htDummy
          change p' = 1 ∧ q' = 1 ∧ s' = 1 at ht'Dummy
          exact Prod.ext (htDummy.1.trans ht'Dummy.1.symm)
            (Prod.ext (htDummy.2.1.trans ht'Dummy.2.1.symm)
              (htDummy.2.2.trans ht'Dummy.2.2.symm))
        · change [p] = [p'] at heq
          change q = 1 ∧ s = 1 at htDummy
          change q' = 1 ∧ s' = 1 at ht'Dummy
          exact Prod.ext (List.cons.inj heq).1
            (Prod.ext (htDummy.1.trans ht'Dummy.1.symm)
              (htDummy.2.trans ht'Dummy.2.symm))
        · change [p, s] = [p', s'] at heq
          change q = 1 at htDummy
          change q' = 1 at ht'Dummy
          obtain ⟨hpp, htail⟩ := List.cons.inj heq
          exact Prod.ext hpp (Prod.ext (htDummy.trans ht'Dummy.symm)
            (List.cons.inj htail).1)
        · change [p, s] = [p', s'] at heq
          change q = 1 at htDummy
          change q' = 1 at ht'Dummy
          obtain ⟨hpp, htail⟩ := List.cons.inj heq
          exact Prod.ext hpp (Prod.ext (htDummy.trans ht'Dummy.symm)
            (List.cons.inj htail).1)
        · change [q, p, s] = [q', p', s'] at heq
          obtain ⟨hqq, htail⟩ := List.cons.inj heq
          obtain ⟨hpp, hlast⟩ := List.cons.inj htail
          exact Prod.ext hpp (Prod.ext hqq (List.cons.inj hlast).1)
        · change [s, p, q] = [s', p', q'] at heq
          obtain ⟨hss, htail⟩ := List.cons.inj heq
          obtain ⟨hpp, hlast⟩ := List.cons.inj htail
          exact Prod.ext hpp (Prod.ext (List.cons.inj hlast).1 hss)
      · intro zs hzs
        have hzC := hentries zs hzs
        have hzshape := hshape zs hzs
        have hmk (p q s : ℕ) (hp : p ∈ C) (hq : q ∈ C) (hs : s ∈ C)
            (hdummy : match l.val with
              | 0 => p = 1 ∧ q = 1 ∧ s = 1
              | 1 => q = 1 ∧ s = 1
              | 2 => q = 1
              | 3 => q = 1
              | _ => True)
            (heq : ps p q s = zs) :
            ∃ t, ∃ _ht : t ∈ R, ps t.1 t.2.1 t.2.2 = zs := by
          refine ⟨(p, (q, s)), Finset.mem_filter.mpr
            ⟨Finset.mem_product.mpr ⟨hp, Finset.mem_product.mpr ⟨hq, hs⟩⟩,
              ⟨hdummy, ?_⟩⟩, heq⟩
          rw [heq]
          exact hzs
        fin_cases l
        · change zs = [] at hzshape
          subst zs
          exact hmk 1 1 1 hone hone hone (by simp) (by simp [ps])
        · change ∃ p, zs = [p] at hzshape
          obtain ⟨p, rfl⟩ := hzshape
          exact hmk p 1 1 (hzC p (by simp)) hone hone (by simp) (by simp [ps])
        · change ∃ p s, zs = [p, s] at hzshape
          obtain ⟨p, s, rfl⟩ := hzshape
          exact hmk p 1 s (hzC p (by simp)) hone (hzC s (by simp))
            rfl (by simp [ps])
        · change ∃ p s, zs = [p, s] at hzshape
          obtain ⟨p, s, rfl⟩ := hzshape
          exact hmk p 1 s (hzC p (by simp)) hone (hzC s (by simp))
            rfl (by simp [ps])
        · change ∃ p q s, zs = [q, p, s] at hzshape
          obtain ⟨p, q, s, rfl⟩ := hzshape
          exact hmk p q s (hzC p (by simp)) (hzC q (by simp)) (hzC s (by simp))
            True.intro (by simp [ps])
        · change ∃ p q s, zs = [s, p, q] at hzshape
          obtain ⟨p, q, s, rfl⟩ := hzshape
          exact hmk p q s (hzC p (by simp)) (hzC q (by simp)) (hzC s (by simp))
            True.intro (by simp [ps])
    _ = _ := by simp only [R, Finset.sum_filter, Finset.sum_product]

open Classical in
theorem sifted_short_harmanA0_arithmetic_identity
    (x : ℝ) (hx : 1 < x) (l : Fin 6) :
    let z := x ^ ((9519 : ℝ) / 50000)
    let M0 := x ^ (1 - (1058 : ℝ) / 3125)
    let U (p : List ℕ) : ArithmeticFunction ℝ :=
      ⟨fun r => if r = 0 then 0 else
        if r = (siftedPrimeGroups l p).1 then 1 else 0, by simp⟩
    let V (p : List ℕ) : ArithmeticFunction ℝ :=
      ⟨fun s => if s = 0 then 0 else
        if s = (siftedPrimeGroups l p).2 then 1 else 0, by simp⟩
    let S0 : ArithmeticFunction ℝ :=
      ⟨fun n => if (n : ℝ) ≤ M0 then
        ∑ ps ∈ siftedPrimeTuples x l, ∑ d ∈ n.divisorsAntidiagonal,
          if d.1 = ps.prod then smallPrimeMobius z d.2 else 0 else 0, by simp⟩
    S0 = ∑ ps ∈ siftedPrimeTuples x l, harmanA0 (U ps) (V ps) z M0 ∧
      S0 * (ArithmeticFunction.zeta : ArithmeticFunction ℝ) =
        ∑ ps ∈ siftedPrimeTuples x l,
          harmanA0 (U ps) (V ps) z M0 *
            (ArithmeticFunction.zeta : ArithmeticFunction ℝ) := by
  intro z M0 U V S0
  have hdelta (d : ℕ) (hd : 0 < d) (m : ℕ) :
      (if m = 0 then (0 : ℝ) else if m = d then 1 else 0) =
        if m = d then 1 else 0 := by
    by_cases hm : m = 0 <;> simp [hm, hd.ne]
  have hA0 (p : List ℕ) (hp : p ∈ siftedPrimeTuples x l) (m : ℕ) :
      harmanA0 (U p) (V p) z M0 m =
        if (m : ℝ) ≤ M0 then
          ∑ d ∈ m.divisorsAntidiagonal,
            if d.1 = p.prod then smallPrimeMobius z d.2 else 0
        else 0 := by
    obtain ⟨hrpos, hspos, hprod, _, _, _⟩ :=
      siftedPrimeTuples_group_bounds x hx l p hp
    have hU (r : ℕ) : U p r = if r = (siftedPrimeGroups l p).1 then 1 else 0 :=
      hdelta _ hrpos r
    have hV (s : ℕ) : V p s = if s = (siftedPrimeGroups l p).2 then 1 else 0 :=
      hdelta _ hspos s
    have hprodpos : 0 < p.prod := hprod ▸ Nat.mul_pos hrpos hspos
    have hUV (k : ℕ) : (U p * V p) k = if k = p.prod then 1 else 0 := by
      rw [ArithmeticFunction.mul_apply]
      have hpoint (d : ℕ × ℕ) :
          U p d.1 * V p d.2 = if d = siftedPrimeGroups l p then 1 else 0 := by
        simp only [hU, hV, ite_mul, one_mul, zero_mul, Prod.ext_iff, ite_and]
      simp_rw [hpoint]
      rw [Finset.sum_ite_eq']
      by_cases hk : k = p.prod <;>
        simp [Nat.mem_divisorsAntidiagonal, hprod, hk, hprodpos.ne', eq_comm]
    change (if (m : ℝ) ≤ M0 then (U p * V p * smallPrimeMobius z) m else 0) = _
    rw [ArithmeticFunction.mul_apply]
    simp_rw [hUV]
    simp only [ite_mul, one_mul, zero_mul]
  have hshort (m : ℕ) :
      (∑ ps ∈ siftedPrimeTuples x l, harmanA0 (U ps) (V ps) z M0 m) = S0 m := by
    change (∑ ps ∈ siftedPrimeTuples x l, harmanA0 (U ps) (V ps) z M0 m) =
      if (m : ℝ) ≤ M0 then
        ∑ ps ∈ siftedPrimeTuples x l, ∑ d ∈ m.divisorsAntidiagonal,
          if d.1 = ps.prod then smallPrimeMobius z d.2 else 0
      else 0
    by_cases hm : (m : ℝ) ≤ M0
    · rw [ite_eq_left hm]
      exact Finset.sum_congr rfl (fun ps hps => by
        simpa only [ite_eq_left hm] using hA0 ps hps m)
    · rw [ite_eq_right hm]
      exact Finset.sum_eq_zero (fun ps hps => by
        simpa only [ite_eq_right hm] using hA0 ps hps m)
  have hidentity : S0 = ∑ ps ∈ siftedPrimeTuples x l,
      harmanA0 (U ps) (V ps) z M0 := by
    apply ArithmeticFunction.ext
    intro n
    let ev : ArithmeticFunction ℝ →+ ℝ :=
      { toFun := fun F => F n
        map_zero' := rfl
        map_add' := fun _ _ => rfl }
    change S0 n = ev (∑ ps ∈ siftedPrimeTuples x l, harmanA0 (U ps) (V ps) z M0)
    rw [map_sum]
    exact (hshort n).symm
  refine ⟨hidentity, ?_⟩
  rw [hidentity, Finset.sum_mul]

open Classical in
theorem sifted_long_independent_factor_identity (x : ℝ) (hx : 1 < x) (l : Fin 6) :
    let H := x ^ ((40481 : ℝ) / 100000)
    let z := x ^ ((9519 : ℝ) / 50000)
    let M0 := x ^ (1 - (1058 : ℝ) / 3125)
    let S := x ^ (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000)
    let Bthreshold := x ^ ((59519 : ℝ) / 100000)
    let U := ⌊8 * x⌋₊
    let C := Finset.Icc 1 U
    let A := (Fintype.piFinset (fun _ : Fin 3 => C)).filter (fun a : Fin 3 → ℕ =>
      let u : ℕ := a 0
      let v : ℕ := a 1
      let h : ℕ := a 2
      let r : ℕ := u * v
      let m : ℕ := r * h
      m ≤ U ∧
        (match l.val with
          | 0 => u = 1 ∧ v = 1
          | 1 | 2 | 3 => u = 1 ∧ v.Prime ∧ z ≤ (v : ℝ)
          | 4 => u.Prime ∧ v.Prime ∧ z ≤ (u : ℝ) ∧ u < v
          | _ => u.Prime ∧ v.Prime ∧ z ≤ (u : ℝ) ∧ u ≤ v) ∧
        (r : ℝ) < H ∧ 1 < h ∧ ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧
        ((m / h.minFac : ℕ) : ℝ) < H ∧ H ≤ (m : ℝ))
    let B := (Fintype.piFinset (fun _ : Fin 3 => C)).filter (fun b : Fin 3 → ℕ =>
      let s : ℕ := b 0
      let d : ℕ := b 1
      let k : ℕ := b 2
      let n : ℕ := s * d * k
      n ≤ U ∧ (if l.val ≤ 1 then s = 1 else s.Prime ∧ z ≤ (s : ℝ)) ∧ (s : ℝ) < S)
    let feature (a b : Fin 3 → ℕ) : Fin 7 → ℕ :=
      ![a 0 * a 1 * a 2, (a 2).minFac, if l.val ≤ 3 then a 1 else a 0,
        b 0 * b 1 * b 2, b 0 * b 1, max 1 ((b 1).primeFactors.sup id), b 0]
    let Good (f : Fin 7 → ℕ) : Prop :=
      f 5 < f 1 ∧ M0 < ((f 0 * f 4 : ℕ) : ℝ) ∧
        x ≤ ((f 0 * f 3 : ℕ) : ℝ) ∧ ((f 0 * f 3 : ℕ) : ℝ) ≤ 2 * x ∧
        match l.val with
        | 2 => f 6 < f 2 ∧ ((f 2 * f 6 : ℕ) : ℝ) < H
        | 3 => f 6 < f 2 ∧ Bthreshold < ((f 2 * f 6 : ℕ) : ℝ)
        | 4 => f 6 < f 2
        | 5 => f 2 < f 6
        | _ => True
    let S0 : ArithmeticFunction ℝ :=
      ⟨fun n => if (n : ℝ) ≤ M0 then
        ∑ ps ∈ siftedPrimeTuples x l, ∑ d ∈ n.divisorsAntidiagonal,
          if d.1 = ps.prod then smallPrimeMobius z d.2 else 0 else 0, by simp⟩
    (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
      Finsupp.single n
        ((siftedTheta x l (fun _ => 1) n -
          (S0 * (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n : ℝ) : ℂ)) =
      ∑ a ∈ A, ∑ b ∈ B,
        Finsupp.single (feature a b 0 * feature a b 3)
          ((if Good (feature a b) then
            (ArithmeticFunction.moebius (a 2) : ℝ) *
              (ArithmeticFunction.moebius (b 1) : ℝ) else 0 : ℝ) : ℂ) := by
  intro H z M0 S Bthreshold U C A B feature Good S0
  let W := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
  let C2 := Finset.Icc 1 ⌊2 * x⌋₊
  let cube := Fintype.piFinset (fun _ : Fin 3 => C)
  let ps (u v s : ℕ) : List ℕ := match l.val with
    | 0 => [] | 1 => [v] | 2 => [v, s] | 3 => [v, s]
    | 4 => [v, u, s] | _ => [s, u, v]
  let Dummy (u v s : ℕ) : Prop := match l.val with
    | 0 => u = 1 ∧ v = 1 ∧ s = 1
    | 1 => u = 1 ∧ s = 1 | 2 => u = 1 | 3 => u = 1 | _ => True
  let NamedA (u v : ℕ) : Prop := match l.val with
    | 0 => u = 1 ∧ v = 1
    | 1 | 2 | 3 => u = 1 ∧ v.Prime ∧ z ≤ (v : ℝ)
    | 4 => u.Prime ∧ v.Prime ∧ z ≤ (u : ℝ) ∧ u < v
    | _ => u.Prime ∧ v.Prime ∧ z ≤ (u : ℝ) ∧ u ≤ v
  let NamedB (s : ℕ) : Prop := if l.val ≤ 1 then s = 1 else s.Prime ∧ z ≤ (s : ℝ)
  let Cross (u v s : ℕ) : Prop := match l.val with
    | 2 => s < v ∧ ((v * s : ℕ) : ℝ) < H
    | 3 => s < v ∧ Bthreshold < ((v * s : ℕ) : ℝ)
    | 4 => s < u | 5 => u < s | _ => True
  let RA (u v h : ℕ) : Prop :=
    u * v * h ≤ U ∧ NamedA u v ∧ ((u * v : ℕ) : ℝ) < H ∧ 1 < h ∧
      ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧
      ((u * v * h / h.minFac : ℕ) : ℝ) < H ∧ H ≤ ((u * v * h : ℕ) : ℝ)
  let RB (s d k : ℕ) : Prop := s * d * k ≤ U ∧ NamedB s ∧ (s : ℝ) < S
  let Raw (n : ℕ) (zs : List ℕ) (h d k : ℕ) : Prop :=
    zs.prod * h * d * k = n ∧ 1 < h ∧
      ((max 1 (h.primeFactors.sup id) : ℕ) : ℝ) < z ∧
      (((siftedPrimeGroups l zs).1 * h : ℕ) : ℝ) / (h.minFac : ℝ) < H ∧
      H ≤ (((siftedPrimeGroups l zs).1 * h : ℕ) : ℝ) ∧
      max 1 (d.primeFactors.sup id) < h.minFac ∧
      M0 < (((siftedPrimeGroups l zs).1 * (siftedPrimeGroups l zs).2 * h * d : ℕ) : ℝ)
  let U0 (zs : List ℕ) : ArithmeticFunction ℝ :=
    ⟨fun r => if r = 0 then 0 else
      if r = (siftedPrimeGroups l zs).1 then 1 else 0, by simp⟩
  let V0 (zs : List ℕ) : ArithmeticFunction ℝ :=
    ⟨fun s => if s = 0 then 0 else
      if s = (siftedPrimeGroups l zs).2 then 1 else 0, by simp⟩
  have hxpos : 0 < x := zero_lt_one.trans hx
  have h2nonneg : 0 ≤ 2 * x := by positivity
  have hUone : 1 ≤ U := (Nat.one_le_floor_iff (8 * x)).mpr (by linarith)
  have h2U : ⌊2 * x⌋₊ ≤ U := Nat.floor_mono (by linarith)
  have hU : ⌈H⌉₊ ≤ U := by
    have hHle : H ≤ x := Real.rpow_le_self_of_one_le hx.le (by norm_num)
    have hceil : (⌈H⌉₊ : ℝ) < H + 1 := Nat.ceil_lt_add_one (by positivity)
    exact Nat.le_floor (by linarith)
  have hCsub : C2 ⊆ C := by
    intro n hn
    exact Finset.mem_Icc.mpr ⟨(Finset.mem_Icc.mp hn).1,
      (Finset.mem_Icc.mp hn).2.trans h2U⟩
  have hW (n : ℕ) : n ∈ W ↔ x ≤ (n : ℝ) ∧ (n : ℝ) ≤ 2 * x := by
    simp only [W, Finset.mem_Icc, Nat.ceil_le, Nat.le_floor_iff h2nonneg]
  have hcuts (u v s : ℕ) :
      (Dummy u v s ∧ ps u v s ∈ siftedPrimeTuples x l) ↔
        NamedA u v ∧ ((u * v : ℕ) : ℝ) < H ∧ NamedB s ∧ (s : ℝ) < S ∧
          Cross u v s := harman_named_factor_cuts x hx l u v s
  have hgroups (u v s : ℕ) (hd : Dummy u v s) :
      siftedPrimeGroups l (ps u v s) = (u * v, s) ∧ (ps u v s).prod = u * v * s := by
    fin_cases l
    · change u = 1 ∧ v = 1 ∧ s = 1 at hd
      rcases hd with ⟨rfl, rfl, rfl⟩
      simp [ps, siftedPrimeGroups]
    · change u = 1 ∧ s = 1 at hd
      rcases hd with ⟨rfl, rfl⟩
      simp [ps, siftedPrimeGroups]
    · change u = 1 at hd
      subst u
      simp [ps, siftedPrimeGroups]
    · change u = 1 at hd
      subst u
      simp [ps, siftedPrimeGroups]
    · simp [ps, siftedPrimeGroups, Nat.mul_comm]
      ring
    · simp [ps, siftedPrimeGroups, Nat.mul_comm, Nat.mul_left_comm]
  have hgood (u v h s d k : ℕ) :
      Good (feature ![u, v, h] ![s, d, k]) ↔
        max 1 (d.primeFactors.sup id) < h.minFac ∧
          M0 < (((u * v * h) * (s * d) : ℕ) : ℝ) ∧
          x ≤ (((u * v * h) * (s * d * k) : ℕ) : ℝ) ∧
          (((u * v * h) * (s * d * k) : ℕ) : ℝ) ≤ 2 * x ∧ Cross u v s := by
    fin_cases l <;> rfl
  have henum (w : List ℕ → ℝ) :
      (∑ zs ∈ siftedPrimeTuples x l, w zs) =
        ∑ u ∈ C, ∑ v ∈ C, ∑ s ∈ C,
          if Dummy u v s ∧ ps u v s ∈ siftedPrimeTuples x l then w (ps u v s) else 0 := by
    have he := siftedPrimeTuples_named_enumeration x hx l U hU hUone w
    dsimp only at he
    fin_cases l
    · rw [Finset.sum_comm] at he
      simpa only [Dummy, ps, and_left_comm] using he
    · rw [Finset.sum_comm] at he
      simpa only [Dummy, ps] using he
    · rw [Finset.sum_comm] at he
      simpa only [Dummy, ps] using he
    · rw [Finset.sum_comm] at he
      simpa only [Dummy, ps] using he
    · simpa only [Dummy, ps] using he
    · simpa only [Dummy, ps] using he
  have hcube (f : (Fin 3 → ℕ) → ℝ) :
      (∑ a ∈ cube, f a) = ∑ u ∈ C, ∑ v ∈ C, ∑ h ∈ C, f ![u, v, h] := by
    calc
      _ = ∑ t ∈ C ×ˢ (C ×ˢ C), f ![t.1, t.2.1, t.2.2] := by
        symm
        refine Finset.sum_bij (fun t _ => ![t.1, t.2.1, t.2.2]) ?_ ?_ ?_
          (fun _ _ => rfl)
        · intro t ht
          obtain ⟨hu, hvh⟩ := Finset.mem_product.mp ht
          obtain ⟨hv, hh⟩ := Finset.mem_product.mp hvh
          apply Fintype.mem_piFinset.mpr
          intro i
          fin_cases i <;> assumption
        · intro t _ht t' _ht' heq
          exact Prod.ext (congrFun heq 0)
            (Prod.ext (congrFun heq 1) (congrFun heq 2))
        · intro a ha
          have haC := Fintype.mem_piFinset.mp ha
          refine ⟨(a 0, (a 1, a 2)), Finset.mem_product.mpr
            ⟨haC 0, Finset.mem_product.mpr ⟨haC 1, haC 2⟩⟩, ?_⟩
          funext i
          fin_cases i <;> rfl
      _ = _ := by simp only [Finset.sum_product]
  have hext (n : ℕ) (hn : n ≤ ⌊2 * x⌋₊)
      (zs : List ℕ) (hzs : zs ∈ siftedPrimeTuples x l) :
      (∑ h ∈ C2, ∑ d ∈ C2, ∑ k ∈ C2,
        if Raw n zs h d k then
          (ArithmeticFunction.moebius h : ℝ) * (ArithmeticFunction.moebius d : ℝ) else 0) =
      ∑ h ∈ C, ∑ d ∈ C, ∑ k ∈ C,
        if Raw n zs h d k then
          (ArithmeticFunction.moebius h : ℝ) * (ArithmeticFunction.moebius d : ℝ) else 0 := by
    obtain ⟨hr, hs, hp, _, _, _⟩ := siftedPrimeTuples_group_bounds x hx l zs hzs
    have hpPos : 0 < zs.prod := hp ▸ Nat.mul_pos hr hs
    calc
      _ = ∑ t ∈ C2 ×ˢ (C2 ×ˢ C2),
          if Raw n zs t.1 t.2.1 t.2.2 then
            (ArithmeticFunction.moebius t.1 : ℝ) *
              (ArithmeticFunction.moebius t.2.1 : ℝ) else 0 := by
        simp only [Finset.sum_product]
      _ = ∑ t ∈ C ×ˢ (C ×ˢ C),
          if Raw n zs t.1 t.2.1 t.2.2 then
            (ArithmeticFunction.moebius t.1 : ℝ) *
              (ArithmeticFunction.moebius t.2.1 : ℝ) else 0 := by
        apply Finset.sum_subset
        · intro t ht
          obtain ⟨hh, hdk⟩ := Finset.mem_product.mp ht
          obtain ⟨hd, hk⟩ := Finset.mem_product.mp hdk
          exact Finset.mem_product.mpr ⟨hCsub hh,
            Finset.mem_product.mpr ⟨hCsub hd, hCsub hk⟩⟩
        · intro t ht hnot
          by_cases hraw : Raw n zs t.1 t.2.1 t.2.2
          · obtain ⟨hh, hdk⟩ := Finset.mem_product.mp ht
            obtain ⟨hd, hk⟩ := Finset.mem_product.mp hdk
            have hhpos : 0 < t.1 := (Finset.mem_Icc.mp hh).1
            have hdpos : 0 < t.2.1 := (Finset.mem_Icc.mp hd).1
            have hkpos : 0 < t.2.2 := (Finset.mem_Icc.mp hk).1
            have hnpos : 0 < n := hraw.1 ▸
              Nat.mul_pos (Nat.mul_pos (Nat.mul_pos hpPos hhpos) hdpos) hkpos
            have hbound (m : ℕ) (hm : 0 < m) (hmd : m ∣ n) : m ∈ C2 :=
              Finset.mem_Icc.mpr ⟨hm, (Nat.le_of_dvd hnpos hmd).trans hn⟩
            have hhdiv : t.1 ∣ n := by
              refine ⟨zs.prod * t.2.1 * t.2.2, ?_⟩
              rw [← hraw.1]
              ring
            have hddiv : t.2.1 ∣ n := by
              refine ⟨zs.prod * t.1 * t.2.2, ?_⟩
              rw [← hraw.1]
              ring
            have hkdiv : t.2.2 ∣ n := by
              refine ⟨zs.prod * t.1 * t.2.1, ?_⟩
              rw [← hraw.1]
              ring
            exact (hnot (Finset.mem_product.mpr ⟨hbound _ hhpos hhdiv,
              Finset.mem_product.mpr ⟨hbound _ hdpos hddiv, hbound _ hkpos hkdiv⟩⟩)).elim
          · exact ite_eq_right hraw
      _ = _ := by simp only [Finset.sum_product]
  have hshort (n : ℕ) :
      (S0 * (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n =
        ∑ zs ∈ siftedPrimeTuples x l,
          (harmanA0 (U0 zs) (V0 zs) z M0 *
            (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n := by
    have he := (sifted_short_harmanA0_arithmetic_identity x hx l).2
    change S0 * (ArithmeticFunction.zeta : ArithmeticFunction ℝ) =
      ∑ zs ∈ siftedPrimeTuples x l,
        harmanA0 (U0 zs) (V0 zs) z M0 *
          (ArithmeticFunction.zeta : ArithmeticFunction ℝ) at he
    let ev : ArithmeticFunction ℝ →+ ℝ :=
      { toFun := fun F => F n
        map_zero' := rfl
        map_add' := fun _ _ => rfl }
    change ev (S0 * (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) = _
    rw [he, map_sum]
    rfl
  have hrawCoefficient (n : ℕ) (hn : n ≤ ⌊2 * x⌋₊) :
      siftedTheta x l (fun _ => 1) n -
          (S0 * (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n =
        ∑ zs ∈ siftedPrimeTuples x l, ∑ h ∈ C, ∑ d ∈ C, ∑ k ∈ C,
          if Raw n zs h d k then
            (ArithmeticFunction.moebius h : ℝ) * (ArithmeticFunction.moebius d : ℝ) else 0 := by
    have he := (siftedTheta_restricted_harman_raw_long_identity x hx l (fun _ => 1) n hn).2
    change siftedTheta x l (fun _ => 1) n =
      (∑ zs ∈ siftedPrimeTuples x l, 1 *
        (harmanA0 (U0 zs) (V0 zs) z M0 *
          (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n) +
      ∑ zs ∈ siftedPrimeTuples x l, 1 * ∑ h ∈ C2, ∑ d ∈ C2, ∑ k ∈ C2,
        if Raw n zs h d k then
          (ArithmeticFunction.moebius h : ℝ) * (ArithmeticFunction.moebius d : ℝ) else 0 at he
    simp only [one_mul] at he
    rw [hshort]
    calc
      _ = ∑ zs ∈ siftedPrimeTuples x l, ∑ h ∈ C2, ∑ d ∈ C2, ∑ k ∈ C2,
          if Raw n zs h d k then
            (ArithmeticFunction.moebius h : ℝ) * (ArithmeticFunction.moebius d : ℝ) else 0 := by
        linarith [he]
      _ = _ := Finset.sum_congr rfl (fun zs hzs => hext n hn zs hzs)
  have hgate (n : ℕ) (hn : n ∈ W) (u v h s d k : ℕ) :
      ((Dummy u v s ∧ ps u v s ∈ siftedPrimeTuples x l) ∧ Raw n (ps u v s) h d k) ↔
        RA u v h ∧ RB s d k ∧
          feature ![u, v, h] ![s, d, k] 0 * feature ![u, v, h] ![s, d, k] 3 = n ∧
          Good (feature ![u, v, h] ![s, d, k]) := by
    have hnreal := (hW n).mp hn
    have hnpos : 0 < n := Nat.cast_pos.mp (hxpos.trans_le hnreal.1)
    have hnU : n ≤ U := (Finset.mem_Icc.mp hn).2.trans h2U
    have hquot : ((u * v * h / h.minFac : ℕ) : ℝ) =
        ((u * v * h : ℕ) : ℝ) / (h.minFac : ℝ) :=
      Nat.cast_div_charZero (dvd_mul_of_dvd_right (Nat.minFac_dvd h) (u * v))
    have hbound (heq : (u * v * h) * (s * d * k) = n) :
        u * v * h ≤ U ∧ s * d * k ≤ U := by
      constructor
      · exact (Nat.le_of_dvd hnpos ⟨s * d * k, heq.symm⟩).trans hnU
      · exact (Nat.le_of_dvd hnpos ⟨u * v * h, by rw [← heq]; ring⟩).trans hnU
    constructor
    · rintro ⟨hnamed, hraw⟩
      obtain ⟨hna, hrH, hnb, hsS, hcross⟩ := (hcuts u v s).mp hnamed
      obtain ⟨hgrp, hprod⟩ := hgroups u v s hnamed.1
      dsimp only [Raw] at hraw
      rw [hgrp, hprod] at hraw
      obtain ⟨heq, hhone, hhP, hhquot, hhH, hdP, hM⟩ := hraw
      have hmn : (u * v * h) * (s * d * k) = n := by
        calc
          _ = u * v * s * h * d * k := by ring
          _ = n := heq
      obtain ⟨hmU, hnBU⟩ := hbound hmn
      refine ⟨⟨hmU, hna, hrH, hhone, hhP, by simpa only [hquot] using hhquot, hhH⟩,
        ⟨hnBU, hnb, hsS⟩, hmn, (hgood u v h s d k).mpr ?_⟩
      refine ⟨hdP, ?_, ?_, ?_, hcross⟩
      · convert hM using 1
        congr 1
        ring
      · simpa only [hmn] using hnreal.1
      · simpa only [hmn] using hnreal.2
    · rintro ⟨⟨_hmU, hna, hrH, hhone, hhP, hhquot, hhH⟩,
        ⟨_hnBU, hnb, hsS⟩, heq, hg⟩
      obtain ⟨hdP, hM, _hlo, _hhi, hcross⟩ := (hgood u v h s d k).mp hg
      have hnamed := (hcuts u v s).mpr ⟨hna, hrH, hnb, hsS, hcross⟩
      obtain ⟨hgrp, hprod⟩ := hgroups u v s hnamed.1
      refine ⟨hnamed, ?_⟩
      dsimp only [Raw]
      rw [hgrp, hprod]
      refine ⟨?_, hhone, hhP, by simpa only [hquot] using hhquot, hhH, hdP, ?_⟩
      · change (u * v * h) * (s * d * k) = n at heq
        calc
          _ = (u * v * h) * (s * d * k) := by ring
          _ = n := heq
      · convert hM using 1
        congr 1
        ring
  have hbox (n : ℕ) :
      (∑ a ∈ A, ∑ b ∈ B,
        if feature a b 0 * feature a b 3 = n ∧ Good (feature a b) then
          (ArithmeticFunction.moebius (a 2) : ℝ) *
            (ArithmeticFunction.moebius (b 1) : ℝ) else 0) =
      ∑ u ∈ C, ∑ v ∈ C, ∑ h ∈ C, ∑ s ∈ C, ∑ d ∈ C, ∑ k ∈ C,
        if RA u v h ∧ RB s d k ∧
            feature ![u, v, h] ![s, d, k] 0 * feature ![u, v, h] ![s, d, k] 3 = n ∧
            Good (feature ![u, v, h] ![s, d, k]) then
          (ArithmeticFunction.moebius h : ℝ) * (ArithmeticFunction.moebius d : ℝ) else 0 := by
    change (∑ a ∈ cube.filter (fun a => RA (a 0) (a 1) (a 2)),
      ∑ b ∈ cube.filter (fun b => RB (b 0) (b 1) (b 2)),
        if feature a b 0 * feature a b 3 = n ∧ Good (feature a b) then
          (ArithmeticFunction.moebius (a 2) : ℝ) *
            (ArithmeticFunction.moebius (b 1) : ℝ) else 0) = _
    simp only [Finset.sum_filter]
    simp_rw [hcube, Finset.ite_sum_zero, ← ite_and]
    rfl
  have hreal (n : ℕ) :
      (if n ∈ W then siftedTheta x l (fun _ => 1) n -
          (S0 * (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n else 0) =
      ∑ a ∈ A, ∑ b ∈ B,
        if feature a b 0 * feature a b 3 = n ∧ Good (feature a b) then
          (ArithmeticFunction.moebius (a 2) : ℝ) *
            (ArithmeticFunction.moebius (b 1) : ℝ) else 0 := by
    by_cases hn : n ∈ W
    · rw [ite_eq_left hn, hrawCoefficient n (Finset.mem_Icc.mp hn).2, hbox]
      calc
        _ = ∑ u ∈ C, ∑ v ∈ C, ∑ s ∈ C,
            if Dummy u v s ∧ ps u v s ∈ siftedPrimeTuples x l then
              ∑ h ∈ C, ∑ d ∈ C, ∑ k ∈ C,
                if Raw n (ps u v s) h d k then
                  (ArithmeticFunction.moebius h : ℝ) *
                    (ArithmeticFunction.moebius d : ℝ) else 0
            else 0 := henum (fun zs => ∑ h ∈ C, ∑ d ∈ C, ∑ k ∈ C,
              if Raw n zs h d k then
                (ArithmeticFunction.moebius h : ℝ) *
                  (ArithmeticFunction.moebius d : ℝ) else 0)
        _ = ∑ u ∈ C, ∑ v ∈ C, ∑ s ∈ C, ∑ h ∈ C, ∑ d ∈ C, ∑ k ∈ C,
            if (Dummy u v s ∧ ps u v s ∈ siftedPrimeTuples x l) ∧
                Raw n (ps u v s) h d k then
              (ArithmeticFunction.moebius h : ℝ) *
                (ArithmeticFunction.moebius d : ℝ) else 0 := by
          simp only [Finset.ite_sum_zero, ← ite_and]
        _ = ∑ u ∈ C, ∑ v ∈ C, ∑ h ∈ C, ∑ s ∈ C, ∑ d ∈ C, ∑ k ∈ C,
            if (Dummy u v s ∧ ps u v s ∈ siftedPrimeTuples x l) ∧
                Raw n (ps u v s) h d k then
              (ArithmeticFunction.moebius h : ℝ) *
                (ArithmeticFunction.moebius d : ℝ) else 0 := by
          apply Finset.sum_congr rfl
          intro u _hu
          apply Finset.sum_congr rfl
          intro v _hv
          rw [Finset.sum_comm]
        _ = _ := by
          apply Finset.sum_congr rfl
          intro u _hu
          apply Finset.sum_congr rfl
          intro v _hv
          apply Finset.sum_congr rfl
          intro h _hh
          apply Finset.sum_congr rfl
          intro s _hs
          apply Finset.sum_congr rfl
          intro d _hd
          apply Finset.sum_congr rfl
          intro k _hk
          simp only [hgate n hn u v h s d k]
    · rw [ite_eq_right hn]
      symm
      apply Finset.sum_eq_zero
      intro a _ha
      apply Finset.sum_eq_zero
      intro b _hb
      apply ite_eq_right
      rintro ⟨heq, hg⟩
      apply hn
      apply (hW n).mpr
      have hlo : x ≤ ((feature a b 0 * feature a b 3 : ℕ) : ℝ) := hg.2.2.1
      have hhi : ((feature a b 0 * feature a b 3 : ℕ) : ℝ) ≤ 2 * x := hg.2.2.2.1
      exact ⟨heq ▸ hlo, heq ▸ hhi⟩
  ext n
  simp only [Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_ite_eq']
  have he := congrArg (fun r : ℝ => (r : ℂ)) (hreal n)
  simpa only [W, Complex.ofReal_sum, apply_ite, Complex.ofReal_zero, ← ite_and] using he

open Classical in
theorem sifted_long_pure_power_distribution
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : ℕ) («ω» δ σ : ℝ) (hω : 0 < «ω») (hδ : 0 < δ) (hσ : 0 < σ)
    (hσa : (1 / 2 : ℝ) - σ < 40481 / 100000)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ l : Fin 6,
      let z := x ^ ((9519 : ℝ) / 50000)
      let M0 := x ^ (1 - (1058 : ℝ) / 3125)
      let S0 : ArithmeticFunction ℝ :=
        ⟨fun n => if (n : ℝ) ≤ M0 then
          ∑ ps ∈ siftedPrimeTuples x l, ∑ d ∈ n.divisorsAntidiagonal,
            if d.1 = ps.prod then smallPrimeMobius z d.2 else 0 else 0, by simp⟩
      let ρx : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        Finsupp.single n
          (((siftedTheta x l (fun _ => 1) n -
            (S0 * (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n : ℝ)) : ℂ)
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
            q ∣ (∏ p ∈ I, p) ∧ Nonempty
              (DenseDivisibilityWitness
                ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ j q)),
          ‖fullDiscrepancy ρx q a‖) ≤ K * x / (Real.log x) ^ A := by
  intro A hA
  have hAmass : 0 < A + 2 := by linarith
  obtain ⟨D, E, hD, hE, Km, Xm, hKm, hXm, hmass⟩ :=
    harman_uniform_boundary_mass_log_saving (A + 2) hAmass
  let J : ℕ := 7 * (D + E + 1)
  let Abox : ℝ := A + (J : ℝ)
  have hAbox : 0 < Abox := by
    dsimp only [Abox]
    exact add_pos_of_pos_of_nonneg hA (Nat.cast_nonneg J)
  obtain ⟨Kb, Xb, hKb, _hXb, hbox⟩ :=
    sifted_long_active_feature_cell_log_saving hDeligne j «ω» δ σ
      hω hδ hσ hσa hsource Abox hAbox
  let K : ℝ := 2 * (20 : ℝ) ^ 7 * Kb + 56 * Km
  let X : ℝ := max Xm Xb
  have hK : 0 < K := by dsimp only [K]; positivity
  have hX : Real.exp 100 ≤ X := hXm.trans (le_max_left _ _)
  refine ⟨K, X, hK, hX, ?_⟩
  intro x hx l
  have hxm : Xm ≤ x := (le_max_left _ _).trans hx
  have hxb : Xb ≤ x := (le_max_right _ _).trans hx
  have hx100 : Real.exp 100 ≤ x := hX.trans hx
  have hxpos : 0 < x := (Real.exp_pos 100).trans_le hx100
  have hxone : 1 < x :=
    (Real.one_lt_exp_iff.mpr (by norm_num : (0 : ℝ) < 100)).trans_le hx100
  have hlog100 : 100 ≤ Real.log x := (Real.le_log_iff_exp_le hxpos).mpr hx100
  have hlogone : 1 ≤ Real.log x := by linarith only [hlog100]
  have hlogpos : 0 < Real.log x := zero_lt_one.trans_le hlogone
  have hx2 : Real.exp 2 ≤ x :=
    (Real.exp_le_exp.mpr (by norm_num : (2 : ℝ) ≤ 100)).trans hx100
  let H := x ^ ((40481 : ℝ) / 100000)
  let z := x ^ ((9519 : ℝ) / 50000)
  let M0 := x ^ (1 - (1058 : ℝ) / 3125)
  let S := x ^ (1 - (1058 : ℝ) / 3125 - (40481 : ℝ) / 100000)
  let Bthreshold := x ^ ((59519 : ℝ) / 100000)
  let U := ⌊8 * x⌋₊
  let C := Finset.Icc 1 U
  let TA := (Fintype.piFinset (fun _ : Fin 3 => C)).filter (fun a : Fin 3 → ℕ =>
    let u := a 0
    let v := a 1
    let h₀ := a 2
    let r := u * v
    let m := r * h₀
    m ≤ U ∧
      (match l.val with
        | 0 => u = 1 ∧ v = 1
        | 1 | 2 | 3 => u = 1 ∧ v.Prime ∧ z ≤ (v : ℝ)
        | 4 => u.Prime ∧ v.Prime ∧ z ≤ (u : ℝ) ∧ u < v
        | _ => u.Prime ∧ v.Prime ∧ z ≤ (u : ℝ) ∧ u ≤ v) ∧
      (r : ℝ) < H ∧ 1 < h₀ ∧ ((max 1 (h₀.primeFactors.sup id) : ℕ) : ℝ) < z ∧
      ((m / h₀.minFac : ℕ) : ℝ) < H ∧ H ≤ (m : ℝ))
  let TB := (Fintype.piFinset (fun _ : Fin 3 => C)).filter (fun b : Fin 3 → ℕ =>
    let s := b 0
    let d := b 1
    let k := b 2
    let n := s * d * k
    n ≤ U ∧ (if l.val ≤ 1 then s = 1 else s.Prime ∧ z ≤ (s : ℝ)) ∧ (s : ℝ) < S)
  let feature (a b : Fin 3 → ℕ) : Fin 7 → ℕ :=
    ![a 0 * a 1 * a 2, (a 2).minFac, if l.val ≤ 3 then a 1 else a 0,
      b 0 * b 1 * b 2, b 0 * b 1, max 1 ((b 1).primeFactors.sup id), b 0]
  let Good (f : Fin 7 → ℕ) : Prop :=
    f 5 < f 1 ∧ M0 < ((f 0 * f 4 : ℕ) : ℝ) ∧
      x ≤ ((f 0 * f 3 : ℕ) : ℝ) ∧ ((f 0 * f 3 : ℕ) : ℝ) ≤ 2 * x ∧
      match l.val with
      | 2 => f 6 < f 2 ∧ ((f 2 * f 6 : ℕ) : ℝ) < H
      | 3 => f 6 < f 2 ∧ Bthreshold < ((f 2 * f 6 : ℕ) : ℝ)
      | 4 => f 6 < f 2
      | 5 => f 2 < f 6
      | _ => True
  let S0 : ArithmeticFunction ℝ :=
    ⟨fun n => if (n : ℝ) ≤ M0 then
      ∑ ps ∈ siftedPrimeTuples x l, ∑ d ∈ n.divisorsAntidiagonal,
        if d.1 = ps.prod then smallPrimeMobius z d.2 else 0 else 0, by simp⟩
  let ρx : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
    Finsupp.single n
      ((siftedTheta x l (fun _ => 1) n -
        (S0 * (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n : ℝ) : ℂ)
  let T := TA ×ˢ TB
  let value (t : (Fin 3 → ℕ) × (Fin 3 → ℕ)) :=
    feature t.1 t.2 0 * feature t.1 t.2 3
  let weight (t : (Fin 3 → ℕ) × (Fin 3 → ℕ)) : ℝ :=
    (ArithmeticFunction.moebius (t.1 2) : ℝ) *
      (ArithmeticFunction.moebius (t.2 1) : ℝ)
  let good (t : (Fin 3 → ℕ) × (Fin 3 → ℕ)) : Prop := Good (feature t.1 t.2)
  have hfeature (t : (Fin 3 → ℕ) × (Fin 3 → ℕ)) (ht : t ∈ T) :
      ∀ r : Fin 7, 1 ≤ feature t.1 t.2 r ∧ feature t.1 t.2 r ≤ U := by
    clear hmass hbox
    obtain ⟨hta, htb⟩ := Finset.mem_product.mp ht
    obtain ⟨hpa, hca⟩ := Finset.mem_filter.mp hta
    obtain ⟨hpb, hcb⟩ := Finset.mem_filter.mp htb
    exact harman_long_feature_bounds l U t.1 t.2
      (fun i => Finset.mem_Icc.mp ((Fintype.mem_piFinset.mp hpa) i))
      (fun i => Finset.mem_Icc.mp ((Fintype.mem_piFinset.mp hpb) i))
      hca.1 hcb.1
  have hρ : ρx = ∑ t ∈ T, Finsupp.single (value t)
      (if good t then (weight t : ℂ) else 0) := by
    clear hmass hbox
    have hid := sifted_long_independent_factor_identity x hxone l
    change ρx = ∑ a ∈ TA, ∑ d ∈ TB,
      Finsupp.single (feature a d 0 * feature a d 3)
        ((if Good (feature a d) then
          (ArithmeticFunction.moebius (a 2) : ℝ) *
            (ArithmeticFunction.moebius (d 1) : ℝ) else 0 : ℝ) : ℂ) at hid
    rw [hid]
    change _ = ∑ t ∈ TA ×ˢ TB, Finsupp.single (value t)
      (if good t then (weight t : ℂ) else 0)
    rw [Finset.sum_product]
    apply Finset.sum_congr rfl
    intro a _ha
    apply Finset.sum_congr rfl
    intro d _hd
    congr 1
    change ((if Good (feature a d) then weight (a, d) else 0 : ℝ) : ℂ) =
      if Good (feature a d) then (weight (a, d) : ℂ) else 0
    split_ifs <;> rfl
  let L : ℕ := ⌊Real.log x⌋₊ ^ E
  let h : ℝ := (Real.log x) ^ (-(D : ℝ))
  have hU : 1 ≤ U := Nat.le_floor
    (show ((1 : ℕ) : ℝ) ≤ 8 * x by norm_num; linarith only [hxone])
  have hL : 1 ≤ L := one_le_pow₀
    (Nat.le_floor (show ((1 : ℕ) : ℝ) ≤ Real.log x by
      simpa only [Nat.cast_one] using hlogone))
  have hh : 0 < h := Real.rpow_pos_of_pos hlogpos _
  have hh1 : h ≤ 1 :=
    Real.rpow_le_one_of_one_le_of_nonpos hlogone (neg_nonpos.mpr (Nat.cast_nonneg D))
  obtain ⟨N, b, lo, hi, hN, hindex, hcell, hsingleton, hlow,
    _hopenends, _hhighends, horder, hdiameter, hlowends, hends⟩ :=
      harman_positive_feature_mesh U L h hU hL hh hh1
  let key (t : (Fin 3 → ℕ) × (Fin 3 → ℕ)) : Fin 7 → ℕ :=
    fun r => b (feature t.1 t.2 r)
  let labels := T.image key
  let cell (c : Fin 7 → ℕ) := T.filter (fun t => key t = c)
  let interior := labels.filter (fun c => ∀ t ∈ cell c, good t)
  let boundary := labels.filter (fun c =>
    (∃ t ∈ cell c, good t) ∧ ∃ t ∈ cell c, ¬good t)
  let signed (c : Fin 7 → ℕ) : ℕ →₀ ℂ :=
    ∑ t ∈ cell c, Finsupp.single (value t) (weight t : ℂ)
  let positive (c : Fin 7 → ℕ) : ℕ →₀ ℂ :=
    ∑ t ∈ cell c, Finsupp.single (value t) ((|weight t| : ℝ) : ℂ)
  have hlabelcard : labels.card ≤ N ^ 7 :=
    harman_seven_feature_label_card_le T (fun t => feature t.1 t.2)
      U N b hfeature hindex
  have hlabelpoly : (N : ℝ) ^ 7 ≤ (20 : ℝ) ^ 7 * (Real.log x) ^ J :=
    harman_feature_mesh_seven_label_polylog D E hD hE x hx2 N hN
  have hmassx := hmass x hxm
  have hboundarymass :
      (∑ c ∈ boundary, ∑ t ∈ cell c, |weight t|) ≤
        7 * Km * x / (Real.log x) ^ (A + 2) :=
    harman_long_mixed_cell_mass_le x (A + 2) Km h L l
      hx100 hL hh.le hh1 hmassx.1 hmassx.2 b lo hi
      hlow hsingleton horder hdiameter hends
  clear hmass hmassx
  change ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
    ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
      (∑ q ∈ (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
          q ∣ (∏ p ∈ I, p) ∧ Nonempty
            (DenseDivisibilityWitness
              ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ j q)),
        ‖fullDiscrepancy ρx q a‖) ≤ K * x / (Real.log x) ^ A
  intro I hI a ha
  let Q := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
    q ∣ (∏ p ∈ I, p) ∧ Nonempty
      (DenseDivisibilityWitness
        ⟨max 1 (x ^ δ), show (1 : ℝ) ≤ max 1 (x ^ δ) from le_max_left _ _⟩ j q))
  change (∑ q ∈ Q, ‖fullDiscrepancy ρx q a‖) ≤ K * x / (Real.log x) ^ A
  have hcover := signed_finite_box_discrepancy_cover T key value weight good Q (fun _ => a)
  change (∑ q ∈ Q,
      ‖fullDiscrepancy
        (∑ t ∈ T, Finsupp.single (value t) (if good t then (weight t : ℂ) else 0))
        q a‖) ≤
      (∑ c ∈ interior, ∑ q ∈ Q, ‖fullDiscrepancy (signed c) q a‖) +
        (∑ c ∈ boundary, ∑ q ∈ Q, ‖fullDiscrepancy (positive c) q a‖) +
        2 * (∑ c ∈ boundary, ∑ t ∈ cell c, |weight t|) *
          ∑ q ∈ Q, 1 / (q.totient : ℝ) at hcover
  rw [← hρ] at hcover
  have hactive (c : Fin 7 → ℕ)
      (hc : (∃ t ∈ cell c, good t)) :
      ∃ a ∈ TA, ∃ d ∈ TB, Good (feature a d) ∧
        ∀ r : Fin 7, b (feature a d r) = c r := by
    obtain ⟨t, ht, hgood⟩ := hc
    obtain ⟨htT, htc⟩ := Finset.mem_filter.mp ht
    obtain ⟨hta, htd⟩ := Finset.mem_product.mp htT
    exact ⟨t.1, hta, t.2, htd, hgood, fun r => congrFun htc r⟩
  have hactiveInterior (c : Fin 7 → ℕ) (hc : c ∈ interior) :
      ∃ t ∈ cell c, good t := by
    obtain ⟨hcLabel, hcGood⟩ := Finset.mem_filter.mp hc
    obtain ⟨t, ht, htc⟩ := Finset.mem_image.mp hcLabel
    have htcell : t ∈ cell c := Finset.mem_filter.mpr ⟨ht, htc⟩
    exact ⟨t, htcell, hcGood t htcell⟩
  have hfiltered (c : Fin 7 → ℕ)
      (f : ((Fin 3 → ℕ) × (Fin 3 → ℕ)) → ℂ) :
      (∑ t ∈ cell c, Finsupp.single (value t) (f t)) =
        ∑ aa ∈ TA, ∑ d ∈ TB,
          Finsupp.single (feature aa d 0 * feature aa d 3)
            (if ∀ r : Fin 7, b (feature aa d r) = c r then f (aa, d) else 0) := by
    change (∑ t ∈ T.filter (fun t => key t = c),
      Finsupp.single (value t) (f t)) = _
    rw [Finset.sum_filter]
    change (∑ t ∈ TA ×ˢ TB,
      if key t = c then Finsupp.single (value t) (f t) else 0) = _
    rw [Finset.sum_product]
    apply Finset.sum_congr rfl
    intro aa _haa
    apply Finset.sum_congr rfl
    intro d _hd
    by_cases heq : key (aa, d) = c
    · have heq' : ∀ r : Fin 7, b (feature aa d r) = c r :=
        fun r => congrFun heq r
      simp only [ite_eq_left heq, ite_eq_left heq']
      rfl
    · have heq' : ¬∀ r : Fin 7, b (feature aa d r) = c r :=
        fun heq' => heq (funext heq')
      simp only [ite_eq_right heq, ite_eq_right heq', Finsupp.single_zero]
  have hcellbound (c : Fin 7 → ℕ) (hc : ∃ t ∈ cell c, good t)
      (takeAbs : Bool) :
      (∑ q ∈ Q,
        ‖fullDiscrepancy
          (∑ t ∈ cell c, Finsupp.single (value t)
            ((if takeAbs then |weight t| else weight t : ℝ) : ℂ)) q a‖) ≤
        Kb * x / (Real.log x) ^ Abox := by
    have hb := hbox x hxb l L b lo hi h hh hh1 hcell hlowends hends
      c (hactive c hc) takeAbs I hI a ha
    have hcoeff (aa d : Fin 3 → ℕ) :
        ((if takeAbs then |weight (aa, d)| else weight (aa, d) : ℝ) : ℂ) =
          ((if takeAbs then |ArithmeticFunction.moebius (aa 2)|
            else ArithmeticFunction.moebius (aa 2) : ℤ) : ℂ) *
          ((if takeAbs then |ArithmeticFunction.moebius (d 1)|
            else ArithmeticFunction.moebius (d 1) : ℤ) : ℂ) := by
      clear * - aa d takeAbs weight
      cases takeAbs
      · dsimp only [Bool.false_eq_true, ite_false, weight]
        norm_cast
      · simp only [ite_true, weight]
        rw [abs_mul, Complex.ofReal_mul]
        congr 1 <;> norm_cast
    have hF :
        (∑ t ∈ cell c, Finsupp.single (value t)
          ((if takeAbs then |weight t| else weight t : ℝ) : ℂ)) =
          ∑ aa ∈ TA, ∑ d ∈ TB,
            Finsupp.single (feature aa d 0 * feature aa d 3)
              (if ∀ r : Fin 7, b (feature aa d r) = c r then
                ((if takeAbs then |ArithmeticFunction.moebius (aa 2)|
                  else ArithmeticFunction.moebius (aa 2) : ℤ) : ℂ) *
                ((if takeAbs then |ArithmeticFunction.moebius (d 1)|
                  else ArithmeticFunction.moebius (d 1) : ℤ) : ℂ)
                else 0) := by
      rw [hfiltered]
      apply Finset.sum_congr rfl
      intro aa _haa
      apply Finset.sum_congr rfl
      intro d _hd
      rw [hcoeff aa d]
    rw [hF]
    exact hb
  have hIbound (c : Fin 7 → ℕ) (hc : c ∈ interior) :
      (∑ q ∈ Q, ‖fullDiscrepancy (signed c) q a‖) ≤
        Kb * x / (Real.log x) ^ Abox := by
    simpa only [Bool.false_eq_true, ite_false] using
      hcellbound c (hactiveInterior c hc) false
  have hDbound (c : Fin 7 → ℕ) (hc : c ∈ boundary) :
      (∑ q ∈ Q, ‖fullDiscrepancy (positive c) q a‖) ≤
        Kb * x / (Real.log x) ^ Abox := by
    simpa only [Bool.coe_sort_true, ite_true] using
      hcellbound c (Finset.mem_filter.mp hc).2.1 true
  clear hbox hcellbound hactive hactiveInterior hfiltered
  have hbudget : 0 ≤ Kb * x / (Real.log x) ^ Abox := by
    clear * - Kb x Abox hKb hxpos hlogpos
    positivity
  have hinteriorcard : (interior.card : ℝ) ≤ (N : ℝ) ^ 7 := by
    have hc : interior.card ≤ labels.card :=
      Finset.card_le_card (Finset.filter_subset _ _)
    exact_mod_cast hc.trans hlabelcard
  have hboundarycard : (boundary.card : ℝ) ≤ (N : ℝ) ^ 7 := by
    have hc : boundary.card ≤ labels.card :=
      Finset.card_le_card (Finset.filter_subset _ _)
    exact_mod_cast hc.trans hlabelcard
  have hlevel : 0 < (1 / 2 : ℝ) + 2 * «ω» ∧ (1 / 2 : ℝ) + 2 * «ω» ≤ 1 := by
    clear * - hsource hω hδ
    constructor
    · linarith only [hω]
    · rcases hsource with ⟨_, _, hi⟩ | ⟨_, _, hi⟩ | ⟨_, hi, _, _⟩
      all_goals linarith only [hi, hδ, hω]
  have htotient :
      (∑ q ∈ Q, 1 / (q.totient : ℝ)) ≤ 4 * (Real.log x) ^ 2 :=
    harman_dense_moduli_inv_totient_le x (1 / 2 + 2 * «ω»)
      hx100 hlevel.1 hlevel.2 Q (Finset.filter_subset _ _)
  have htotientnonneg : 0 ≤ ∑ q ∈ Q, 1 / (q.totient : ℝ) :=
    Finset.sum_nonneg fun q _ => by positivity
  clear_value key labels cell interior boundary signed positive Q
  clear * - hcover hIbound hDbound hinteriorcard hboundarycard hlabelpoly
    hboundarymass hbudget htotient htotientnonneg hlogpos hKb hKm hxpos
  have hsumInterior :
      (∑ c ∈ interior, ∑ q ∈ Q, ‖fullDiscrepancy (signed c) q a‖) ≤
        (N : ℝ) ^ 7 * (Kb * x / (Real.log x) ^ Abox) := by
    calc
      _ ≤ ∑ _c ∈ interior, Kb * x / (Real.log x) ^ Abox :=
        Finset.sum_le_sum hIbound
      _ = (interior.card : ℝ) * (Kb * x / (Real.log x) ^ Abox) := by simp
      _ ≤ _ := mul_le_mul_of_nonneg_right hinteriorcard hbudget
  have hsumBoundary :
      (∑ c ∈ boundary, ∑ q ∈ Q, ‖fullDiscrepancy (positive c) q a‖) ≤
        (N : ℝ) ^ 7 * (Kb * x / (Real.log x) ^ Abox) := by
    calc
      _ ≤ ∑ _c ∈ boundary, Kb * x / (Real.log x) ^ Abox :=
        Finset.sum_le_sum hDbound
      _ = (boundary.card : ℝ) * (Kb * x / (Real.log x) ^ Abox) := by simp
      _ ≤ _ := mul_le_mul_of_nonneg_right hboundarycard hbudget
  have hpolyCancellation :
      ((20 : ℝ) ^ 7 * (Real.log x) ^ J) *
          (Kb * x / (Real.log x) ^ Abox) =
        (20 : ℝ) ^ 7 * Kb * x / (Real.log x) ^ A := by
    clear * - A J Abox Kb x hlogpos
    dsimp only [Abox]
    rw [Real.rpow_add hlogpos, Real.rpow_natCast]
    field_simp [hlogpos.ne', (Real.rpow_pos_of_pos hlogpos A).ne']
  have hsinglebudget :
      (N : ℝ) ^ 7 * (Kb * x / (Real.log x) ^ Abox) ≤
        (20 : ℝ) ^ 7 * Kb * x / (Real.log x) ^ A := by
    calc
      _ ≤ ((20 : ℝ) ^ 7 * (Real.log x) ^ J) *
          (Kb * x / (Real.log x) ^ Abox) :=
        mul_le_mul_of_nonneg_right hlabelpoly hbudget
      _ = _ := hpolyCancellation
  have hmeanbound :
      2 * (∑ c ∈ boundary, ∑ t ∈ cell c, |weight t|) *
          (∑ q ∈ Q, 1 / (q.totient : ℝ)) ≤
        56 * Km * x / (Real.log x) ^ A := by
    calc
      _ ≤ 2 * (7 * Km * x / (Real.log x) ^ (A + 2)) *
          (4 * (Real.log x) ^ 2) :=
        mul_le_mul (mul_le_mul_of_nonneg_left hboundarymass (by norm_num))
          htotient htotientnonneg (by positivity)
      _ = _ := by
        clear * - x A Km hlogpos
        rw [Real.rpow_add hlogpos, Real.rpow_two]
        field_simp [hlogpos.ne', (Real.rpow_pos_of_pos hlogpos A).ne']
        ring
  calc
    _ ≤ (∑ c ∈ interior, ∑ q ∈ Q, ‖fullDiscrepancy (signed c) q a‖) +
        (∑ c ∈ boundary, ∑ q ∈ Q, ‖fullDiscrepancy (positive c) q a‖) +
        2 * (∑ c ∈ boundary, ∑ t ∈ cell c, |weight t|) *
          ∑ q ∈ Q, 1 / (q.totient : ℝ) := hcover
    _ ≤ ((20 : ℝ) ^ 7 * Kb * x / (Real.log x) ^ A) +
        ((20 : ℝ) ^ 7 * Kb * x / (Real.log x) ^ A) +
        56 * Km * x / (Real.log x) ^ A :=
      add_le_add (add_le_add (hsumInterior.trans hsinglebudget)
        (hsumBoundary.trans hsinglebudget)) hmeanbound
    _ = K * x / (Real.log x) ^ A := by
      clear * - A Km Kb K x
      dsimp only [K]
      ring

open Classical in
theorem siftedTheta_coherent_distribution_assembly
    (τ : ℝ) (hτ : 0 < τ) (hτsmall : τ ≤ 1 / 10 ^ 10)
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : ℕ) («ω» δ : ℝ) (hω : 0 < «ω») (hδ : 0 < δ)
    (hlevel : (1 / 2 : ℝ) + 2 * «ω» < 59519 / 100000 - τ)
    (hsmooth : (1 / 4 : ℝ) + 7 * «ω» + 2 * δ < 1058 / 3125 - τ)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ +
          5 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1 ∧
        68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ +
          4 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1 ∧
        68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ +
          4 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1 ∧
        64 * «ω» + 20 * δ +
          2 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1))
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x) atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ l : Fin 6,
      ∀ Y : Set.Ici (1 : ℝ), (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
      let ρx : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        Finsupp.single n ((siftedTheta x l (fun _ => 1) n : ℝ) : ℂ)
      let Q : Finset ℕ :=
        (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter
          (fun q => q ∣ ∏ p ∈ I, p ∧
            Nonempty (DenseDivisibilityWitness Y j q))
      (∑ q ∈ Q, ‖fullDiscrepancy ρx q a‖) ≤ K * x / (Real.log x) ^ A := by
  let σ : ℝ := 1 / 2 - 40481 / 100000 + τ
  have hσ : 0 < σ := by dsimp only [σ]; linarith only [hτ]
  have hσa : (1 / 2 : ℝ) - σ < 40481 / 100000 := by
    dsimp only [σ]
    linarith only [hτ]
  obtain ⟨r, hr, hretreat⟩ := central_typeII_parameter_retreat j «ω» δ σ hsource
  obtain ⟨Xr, hXr⟩ := eventually_atTop.mp
    (central_subpower_modulus_family_subset j «ω» δ r hr L0 hL0 hL0sub)
  intro A hA
  obtain ⟨Ks, Xs, hKs, hXs, hs⟩ :=
    sifted_short_subpower_coherent_log_saving τ hτ hτsmall hDeligne j «ω» δ hω hδ
      hlevel hsmooth hsource L0 hL0 hL0sub A hA
  obtain ⟨Kl, Xl, hKl, _hXl, hl⟩ :=
    sifted_long_pure_power_distribution hDeligne j («ω» + r) (δ + r) σ
      (by linarith) (by linarith) hσ hσa hretreat A hA
  refine ⟨Ks + Kl, max Xs (max Xl Xr), by positivity,
    hXs.trans_le (le_max_left _ _), ?_⟩
  intro x hx l Y hY I hI a ha ρx Q
  have hxs : Xs ≤ x := (le_max_left _ _).trans hx
  have hxl : Xl ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans hx)
  have hxr : Xr ≤ x := (le_max_right _ _).trans ((le_max_right _ _).trans hx)
  let z : ℝ := x ^ ((9519 : ℝ) / 50000)
  let M0 : ℝ := x ^ (1 - (1058 : ℝ) / 3125)
  let S0 : ArithmeticFunction ℝ :=
    ⟨fun n => if (n : ℝ) ≤ M0 then
      ∑ ps ∈ siftedPrimeTuples x l, ∑ d ∈ n.divisorsAntidiagonal,
        if d.1 = ps.prod then smallPrimeMobius z d.2 else 0 else 0, by simp⟩
  let short : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
    Finsupp.single n
      (((S0 * (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n : ℝ) : ℂ)
  let long : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
    Finsupp.single n
      ((siftedTheta x l (fun _ => 1) n -
        (S0 * (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n : ℝ) : ℂ)
  have hshort : (∑ q ∈ Q, ‖fullDiscrepancy short q a‖) ≤
      Ks * x / (Real.log x) ^ A := hs x hxs l Y hY I hI a ha
  have hlong : (∑ q ∈ Q, ‖fullDiscrepancy long q a‖) ≤
      Kl * x / (Real.log x) ^ A := by
    have hsubset := hXr x hxr Y hY I
    have hbound := hl x hxl l I hI a ha
    exact (Finset.sum_le_sum_of_subset_of_nonneg hsubset
      (fun q _ _ => norm_nonneg (fullDiscrepancy long q a))).trans hbound
  have hsplit : ρx = short + long := by
    change (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
      Finsupp.single n ((siftedTheta x l (fun _ => 1) n : ℝ) : ℂ)) =
        (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
          Finsupp.single n
            (((S0 * (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n : ℝ) : ℂ)) +
        (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
          Finsupp.single n
            ((siftedTheta x l (fun _ => 1) n -
              (S0 * (ArithmeticFunction.zeta : ArithmeticFunction ℝ)) n : ℝ) : ℂ))
    rw [← Finset.sum_add_distrib]
    apply Finset.sum_congr rfl
    intro n _
    rw [← Finsupp.single_add]
    congr 1
    push_cast
    ring
  have hmask (P : ℕ → Prop) [DecidablePred P] :
      (short + long).sum (fun n c => if P n then c else (0 : ℂ)) =
        short.sum (fun n c => if P n then c else (0 : ℂ)) +
          long.sum (fun n c => if P n then c else (0 : ℂ)) := by
    apply Finsupp.sum_add_index'
    · intro n
      simp
    · intro n c d
      by_cases hp : P n <;> simp [hp]
  have hdiscrepancy (q : ℕ) :
      fullDiscrepancy ρx q a =
        fullDiscrepancy short q a + fullDiscrepancy long q a := by
    rw [hsplit]
    have hp := hmask (fun n => n % q = a % q)
    have hr := hmask (fun n => Nat.Coprime n q)
    simp only [Finsupp.sum] at hp hr
    simp only [fullDiscrepancy, progressionMass, reducedMass, hp, hr, add_div]
    ring
  calc
    (∑ q ∈ Q, ‖fullDiscrepancy ρx q a‖) ≤
        ∑ q ∈ Q, (‖fullDiscrepancy short q a‖ + ‖fullDiscrepancy long q a‖) := by
      apply Finset.sum_le_sum
      intro q _
      rw [hdiscrepancy]
      exact norm_add_le _ _
    _ = (∑ q ∈ Q, ‖fullDiscrepancy short q a‖) +
        (∑ q ∈ Q, ‖fullDiscrepancy long q a‖) := Finset.sum_add_distrib
    _ ≤ Ks * x / (Real.log x) ^ A + Kl * x / (Real.log x) ^ A :=
      add_le_add hshort hlong
    _ = (Ks + Kl) * x / (Real.log x) ^ A := by ring

open Classical in
theorem siftedTheta_lower_dense_log_saving_of_deligne
    (τ : ℝ) (hτ : 0 < τ) (hτsmall : τ ≤ 1 / 10 ^ 10)
    (l : Fin 6)
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : Fin 2) («ω» δ : ℝ) (hω : 0 < «ω») (hδ : 0 < δ)
    (hlevel : (1 / 2 : ℝ) + 2 * «ω» <
      59519 / 100000 - τ)
    (hsmooth : (1 / 4 : ℝ) + 7 * «ω» + 2 * δ <
      1058 / 3125 - τ)
    (hI : if j = 0 then
      54 * «ω» + 15 * δ + 5 * (1 / 2 - 40481 / 100000 + τ) < 1
      else
      56 * «ω» + 16 * δ + 4 * (1 / 2 - 40481 / 100000 + τ) < 1)
    (hII : 68 * «ω» + 14 * δ < 1)
    (_hthree : (1 / 18 : ℝ) + 28 * «ω» / 9 + 2 * δ / 9 <
      19 / 200 - τ)
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Filter.Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x)
      Filter.atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ),
        (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let ρx : ℕ →₀ ℂ :=
          ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n ((siftedTheta x l (fun _ => 1) n : ℝ) : ℂ)
        let Q : Finset ℕ :=
          (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter
            (fun q => q ∣ ∏ p ∈ I, p ∧
              Nonempty (DenseDivisibilityWitness
                Y (j.val + 1) q))
        (∑ q ∈ Q, ‖fullDiscrepancy ρx q a‖) ≤
          K * x / (Real.log x) ^ A := by
  have hsource :
      (j.val + 1 = 1 ∧ 54 * «ω» + 15 * δ +
          5 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1 ∧
        68 * «ω» + 14 * δ < 1) ∨
      (j.val + 1 = 2 ∧ 56 * «ω» + 16 * δ +
          4 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1 ∧
        68 * «ω» + 14 * δ < 1) ∨
      (j.val + 1 = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ +
          4 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1 ∧
        64 * «ω» + 20 * δ +
          2 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1) := by
    by_cases hj : j = 0
    · exact Or.inl ⟨by simp [hj], by simpa only [ite_eq_left hj] using hI, hII⟩
    · have hjval : j.val = 1 := by
        have hlt := j.isLt
        have hne : j.val ≠ 0 := by
          intro he
          exact hj (Fin.ext he)
        omega
      exact Or.inr (Or.inl ⟨by omega, by simpa only [ite_eq_right hj] using hI, hII⟩)
  intro A hA
  obtain ⟨K, X, hK, hX, hdist⟩ :=
    siftedTheta_coherent_distribution_assembly τ hτ hτsmall hDeligne (j.val + 1) «ω» δ hω hδ
      hlevel hsmooth hsource L0 hL0 hL0sub A hA
  exact ⟨K, X, hK, hX, fun x hx Y hY I hI a ha => hdist x hx l Y hY I hI a ha⟩

open Classical in
theorem siftedTheta_triply_dense_log_saving_of_deligne
    (τ : ℝ) (hτ : 0 < τ) (hτsmall : τ ≤ 1 / 10 ^ 10)
    (l : Fin 6)
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    («ω» δ : ℝ) (hω : 0 < «ω») (hδ : 0 < δ)
    (hlevel : (1 / 2 : ℝ) + 2 * «ω» <
      59519 / 100000 - τ)
    (hsmooth : (1 / 4 : ℝ) + 7 * «ω» + 2 * δ <
      1058 / 3125 - τ)
    (hI : 72 * «ω» + 24 * δ < 1)
    (hII : (1 / 4 : ℝ) + 12 * «ω» + 4 * δ <
      40481 / 100000 - τ)
    (hIII : 32 * «ω» + 10 * δ <
      40481 / 100000 - τ)
    (_hthree : (1 / 18 : ℝ) + 28 * «ω» / 9 + 2 * δ / 9 <
      19 / 200 - τ)
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Filter.Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x)
      Filter.atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ),
        (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let ρx : ℕ →₀ ℂ :=
          ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n ((siftedTheta x l (fun _ => 1) n : ℝ) : ℂ)
        let Q : Finset ℕ :=
          (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter
            (fun q => q ∣ ∏ p ∈ I, p ∧
              Nonempty (DenseDivisibilityWitness Y 3 q))
        (∑ q ∈ Q, ‖fullDiscrepancy ρx q a‖) ≤
          K * x / (Real.log x) ^ A := by
  have hsource :
      (3 = 1 ∧ 54 * «ω» + 15 * δ +
          5 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1 ∧
        68 * «ω» + 14 * δ < 1) ∨
      (3 = 2 ∧ 56 * «ω» + 16 * δ +
          4 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1 ∧
        68 * «ω» + 14 * δ < 1) ∨
      (3 = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ +
          4 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1 ∧
        64 * «ω» + 20 * δ +
          2 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1) := by
    exact Or.inr (Or.inr ⟨rfl, hI, by linarith, by linarith⟩)
  intro A hA
  obtain ⟨K, X, hK, hX, hdist⟩ :=
    siftedTheta_coherent_distribution_assembly τ hτ hτsmall hDeligne 3 «ω» δ hω hδ
      hlevel hsmooth hsource L0 hL0 hL0sub A hA
  exact ⟨K, X, hK, hX, fun x hx Y hY I hI a ha => hdist x hx l Y hY I hI a ha⟩

open Classical in
theorem sourceCentralPair_coherent_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : ℕ) («ω» δ σ : ℝ)
    (hω : 0 < «ω») (hδ : 0 < δ)
    (hσgap : (1 / 2 : ℝ) - 40481 / 100000 < σ)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1))
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x) atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 100 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ), (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let F : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
          Finsupp.single n (sourceCentralPair x n : ℂ)
        let Q := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter (fun q =>
          q ∣ (∏ p ∈ I, p) ∧
            Nonempty (DenseDivisibilityWitness Y j q))
        (∑ q ∈ Q, ‖fullDiscrepancy F q a‖) ≤ K * x / (Real.log x) ^ A := by
  intro A hA
  obtain ⟨K3, X3, hK3, hX3, hb3⟩ :=
    central_small_prime_boolean_cut_subpower_coherent_log_saving
      (arity := 2) (by norm_num) hDeligne j «ω» δ σ hω hδ hσgap hsource
      L0 hL0 hL0sub A hA
  obtain ⟨K4, X4, hK4, _hX4, hb4⟩ :=
    central_small_prime_boolean_cut_subpower_coherent_log_saving
      (arity := 3) (by norm_num) hDeligne j «ω» δ σ hω hδ hσgap hsource
      L0 hL0 hL0sub A hA
  obtain ⟨K5, X5, hK5, _hX5, hb5⟩ :=
    central_five_prime_boolean_cut_subpower_coherent_log_saving
      hDeligne j «ω» δ σ hω hδ hσgap hsource
      L0 hL0 hL0sub A hA
  obtain ⟨Xf, _hXf, hfinite⟩ := sourceCentralPair_eventually_finsupp
  refine ⟨K3 + K4 + K5, max (max X3 X4) (max X5 Xf),
    add_pos (add_pos hK3 hK4) hK5,
    hX3.trans ((le_max_left _ _).trans (le_max_left _ _)), ?_⟩
  intro x hx Y hY I hI a ha F Q
  have hx3 : X3 ≤ x := ((le_max_left _ _).trans (le_max_left _ _)).trans hx
  have hx4 : X4 ≤ x := ((le_max_right _ _).trans (le_max_left _ _)).trans hx
  have hx5 : X5 ≤ x := ((le_max_left _ _).trans (le_max_right _ _)).trans hx
  have hxf : Xf ≤ x := ((le_max_right _ _).trans (le_max_right _ _)).trans hx
  have hx1 : 1 < x :=
    (Real.one_lt_exp_iff.mpr (by norm_num : (0 : ℝ) < 100)).trans_le (hX3.trans hx3)
  have hx2 : 0 ≤ 2 * x := by linarith
  let α (p : ℕ) : ℝ := Real.logb x (p : ℝ)
  let Ps := (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
    ⌊x ^ ((9 : ℝ) / 10)⌋₊).filter Nat.Prime
  let Pf := (Finset.Icc ⌈x ^ ((9519 : ℝ) / 50000)⌉₊
    ⌊x ^ ((6 : ℝ) / 25)⌋₊).filter Nat.Prime
  let T3 := Fintype.piFinset (fun _ : Fin 3 => Ps)
  let C3 (p : Fin 3 → ℕ) : Prop :=
    x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x ∧
      (9519 : ℝ) / 50000 ≤ α (p 1) ∧ α (p 1) < α (p 0) ∧
      α (p 0) < (40481 : ℝ) / 100000 ∧
      (40481 : ℝ) / 100000 ≤ α (p 0) + α (p 1) ∧
      α (p 0) + α (p 1) ≤ (59519 : ℝ) / 100000 ∧ p 1 ≤ p 2
  have hC3def : C3 = fun p =>
    x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x ∧
      (9519 : ℝ) / 50000 ≤ α (p 1) ∧ α (p 1) < α (p 0) ∧
      α (p 0) < (40481 : ℝ) / 100000 ∧
      (40481 : ℝ) / 100000 ≤ α (p 0) + α (p 1) ∧
      α (p 0) + α (p 1) ≤ (59519 : ℝ) / 100000 ∧ p 1 ≤ p 2 := rfl
  clear_value C3
  let F3 : ℕ →₀ ℂ := ∑ p ∈ T3, Finsupp.single (∏ i, p i)
    (if C3 p then 1 else 0)
  obtain ⟨M3, hM3card, hM3data, hM3bits⟩ :=
    sourceCentralPair_three_monomial_representation x hx1
  have hbits3 : ∀ p ∈ T3, ∀ q ∈ T3,
      (∀ d ∈ M3,
        (if d.lower then
          if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
        else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
        (if d.lower then
          if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
        else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
      (C3 p ↔ C3 q) := by
    intro p hp q hq ht
    rw [hC3def]
    exact hM3bits p hp q hq ht
  have hs3 (p : Fin 3 → ℕ) (hp : p ∈ T3) (hC : C3 p) :
      (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧
      ∃ S : Finset (Fin 3), S.Nonempty ∧ S ≠ Finset.univ ∧
        x ^ ((40481 : ℝ) / 100000) ≤ ((∏ i ∈ S, p i : ℕ) : ℝ) ∧
        ((∏ i ∈ S, p i : ℕ) : ℝ) ≤ x ^ ((59519 : ℝ) / 100000) := by
    rw [hC3def] at hC
    obtain ⟨hlo, hhi, _hξ, _hqp, _hpa, hpairlo, hpairhi, _horders⟩ := hC
    have hpos (i : Fin 3) : 0 < (p i : ℝ) :=
      Nat.cast_pos.mpr (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).2.pos
    have hprod : ((∏ i ∈ ({0, 1} : Finset (Fin 3)), p i : ℕ) : ℝ) =
        (p 0 : ℝ) * p 1 := by simp
    refine ⟨Finset.mem_Icc.mpr ⟨Nat.ceil_le.mpr hlo, (Nat.le_floor_iff hx2).mpr hhi⟩,
      {0, 1}, by decide, by decide, ?_, ?_⟩
    · rw [hprod]
      apply (Real.le_logb_iff_rpow_le hx1 (mul_pos (hpos 0) (hpos 1))).mp
      rw [Real.logb_mul (hpos 0).ne' (hpos 1).ne']
      exact hpairlo
    · rw [hprod]
      apply (Real.logb_le_iff_le_rpow hx1 (mul_pos (hpos 0) (hpos 1))).mp
      rw [Real.logb_mul (hpos 0).ne' (hpos 1).ne']
      exact hpairhi
  have h3 : (∑ q ∈ Q, ‖fullDiscrepancy F3 q a‖) ≤
      K3 * x / (Real.log x) ^ A :=
    hb3 x hx3 Y hY M3 C3 hM3card hM3data hbits3 hs3 I hI a ha
  let T4 := Fintype.piFinset (fun _ : Fin 4 => Ps)
  let C4 (p : Fin 4 → ℕ) : Prop :=
    x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x ∧
      (9519 : ℝ) / 50000 ≤ α (p 1) ∧ α (p 1) < α (p 0) ∧
      α (p 0) < (40481 : ℝ) / 100000 ∧
      (40481 : ℝ) / 100000 ≤ α (p 0) + α (p 1) ∧
      α (p 0) + α (p 1) ≤ (59519 : ℝ) / 100000 ∧ p 1 ≤ p 2 ∧ p 2 ≤ p 3
  have hC4def : C4 = fun p =>
    x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x ∧
      (9519 : ℝ) / 50000 ≤ α (p 1) ∧ α (p 1) < α (p 0) ∧
      α (p 0) < (40481 : ℝ) / 100000 ∧
      (40481 : ℝ) / 100000 ≤ α (p 0) + α (p 1) ∧
      α (p 0) + α (p 1) ≤ (59519 : ℝ) / 100000 ∧ p 1 ≤ p 2 ∧ p 2 ≤ p 3 := rfl
  clear_value C4
  let F4 : ℕ →₀ ℂ := ∑ p ∈ T4, Finsupp.single (∏ i, p i)
    (if C4 p then 1 else 0)
  obtain ⟨M4, hM4card, hM4data, hM4bits⟩ :=
    sourceCentralPair_four_monomial_representation x hx1
  have hbits4 : ∀ p ∈ T4, ∀ q ∈ T4,
      (∀ d ∈ M4,
        (if d.lower then
          if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
        else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
        (if d.lower then
          if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
        else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
      (C4 p ↔ C4 q) := by
    intro p hp q hq ht
    rw [hC4def]
    exact hM4bits p hp q hq ht
  have hs4 (p : Fin 4 → ℕ) (hp : p ∈ T4) (hC : C4 p) :
      (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧
      ∃ S : Finset (Fin 4), S.Nonempty ∧ S ≠ Finset.univ ∧
        x ^ ((40481 : ℝ) / 100000) ≤ ((∏ i ∈ S, p i : ℕ) : ℝ) ∧
        ((∏ i ∈ S, p i : ℕ) : ℝ) ≤ x ^ ((59519 : ℝ) / 100000) := by
    rw [hC4def] at hC
    obtain ⟨hlo, hhi, _hξ, _hqp, _hpa, hpairlo, hpairhi, _horders⟩ := hC
    have hpos (i : Fin 4) : 0 < (p i : ℝ) :=
      Nat.cast_pos.mpr (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).2.pos
    have hprod : ((∏ i ∈ ({0, 1} : Finset (Fin 4)), p i : ℕ) : ℝ) =
        (p 0 : ℝ) * p 1 := by simp
    refine ⟨Finset.mem_Icc.mpr ⟨Nat.ceil_le.mpr hlo, (Nat.le_floor_iff hx2).mpr hhi⟩,
      {0, 1}, by decide, by decide, ?_, ?_⟩
    · rw [hprod]
      apply (Real.le_logb_iff_rpow_le hx1 (mul_pos (hpos 0) (hpos 1))).mp
      rw [Real.logb_mul (hpos 0).ne' (hpos 1).ne']
      exact hpairlo
    · rw [hprod]
      apply (Real.logb_le_iff_le_rpow hx1 (mul_pos (hpos 0) (hpos 1))).mp
      rw [Real.logb_mul (hpos 0).ne' (hpos 1).ne']
      exact hpairhi
  have h4 : (∑ q ∈ Q, ‖fullDiscrepancy F4 q a‖) ≤
      K4 * x / (Real.log x) ^ A :=
    hb4 x hx4 Y hY M4 C4 hM4card hM4data hbits4 hs4 I hI a ha
  let T5 := Fintype.piFinset (fun _ : Fin 5 => Pf)
  let C5 (p : Fin 5 → ℕ) : Prop :=
    x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x ∧
      (9519 : ℝ) / 50000 ≤ α (p 1) ∧ α (p 1) < α (p 0) ∧
      α (p 0) < (40481 : ℝ) / 100000 ∧
      (40481 : ℝ) / 100000 ≤ α (p 0) + α (p 1) ∧
      α (p 0) + α (p 1) ≤ (59519 : ℝ) / 100000 ∧ p 1 ≤ p 2 ∧ p 2 ≤ p 3 ∧ p 3 ≤ p 4
  have hC5def : C5 = fun p =>
    x ≤ ((∏ i, p i : ℕ) : ℝ) ∧ ((∏ i, p i : ℕ) : ℝ) ≤ 2 * x ∧
      (9519 : ℝ) / 50000 ≤ α (p 1) ∧ α (p 1) < α (p 0) ∧
      α (p 0) < (40481 : ℝ) / 100000 ∧
      (40481 : ℝ) / 100000 ≤ α (p 0) + α (p 1) ∧
      α (p 0) + α (p 1) ≤ (59519 : ℝ) / 100000 ∧ p 1 ≤ p 2 ∧ p 2 ≤ p 3 ∧ p 3 ≤ p 4 := rfl
  clear_value C5
  let F5 : ℕ →₀ ℂ := ∑ p ∈ T5, Finsupp.single (∏ i, p i)
    (if C5 p then 1 else 0)
  obtain ⟨M5, hM5card, hM5data, hM5bits⟩ :=
    sourceCentralPair_five_monomial_representation x hx1
  have hbits5 : ∀ p ∈ T5, ∀ q ∈ T5,
      (∀ d ∈ M5,
        (if d.lower then
          if d.strict then d.threshold < d.value p else d.threshold ≤ d.value p
        else if d.strict then d.value p < d.threshold else d.value p ≤ d.threshold) ↔
        (if d.lower then
          if d.strict then d.threshold < d.value q else d.threshold ≤ d.value q
        else if d.strict then d.value q < d.threshold else d.value q ≤ d.threshold)) →
      (C5 p ↔ C5 q) := by
    intro p hp q hq ht
    rw [hC5def]
    exact hM5bits p hp q hq ht
  have hs5 (p : Fin 5 → ℕ) (hp : p ∈ T5) (hC : C5 p) :
      (∏ i, p i) ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ ∧
      ∃ S : Finset (Fin 5), (S.card = 2 ∨ S.card = 3) ∧
        x ^ ((40481 : ℝ) / 100000) ≤ ((∏ i ∈ S, p i : ℕ) : ℝ) ∧
        ((∏ i ∈ S, p i : ℕ) : ℝ) ≤ x ^ ((59519 : ℝ) / 100000) := by
    rw [hC5def] at hC
    obtain ⟨hlo, hhi, _hξ, _hqp, _hpa, hpairlo, hpairhi, _horders⟩ := hC
    have hpos (i : Fin 5) : 0 < (p i : ℝ) :=
      Nat.cast_pos.mpr (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hp i)).2.pos
    have hprod : ((∏ i ∈ ({0, 1} : Finset (Fin 5)), p i : ℕ) : ℝ) =
        (p 0 : ℝ) * p 1 := by simp
    refine ⟨Finset.mem_Icc.mpr ⟨Nat.ceil_le.mpr hlo, (Nat.le_floor_iff hx2).mpr hhi⟩,
      {0, 1}, Or.inl (by decide), ?_, ?_⟩
    · rw [hprod]
      apply (Real.le_logb_iff_rpow_le hx1 (mul_pos (hpos 0) (hpos 1))).mp
      rw [Real.logb_mul (hpos 0).ne' (hpos 1).ne']
      exact hpairlo
    · rw [hprod]
      apply (Real.logb_le_iff_le_rpow hx1 (mul_pos (hpos 0) (hpos 1))).mp
      rw [Real.logb_mul (hpos 0).ne' (hpos 1).ne']
      exact hpairhi
  have h5 : (∑ q ∈ Q, ‖fullDiscrepancy F5 q a‖) ≤
      K5 * x / (Real.log x) ^ A :=
    hb5 x hx5 Y hY M5 C5 hM5card hM5data hbits5 hs5 I hI a ha
  have hpi {n : ℕ} (t : Fin n → Finset ℕ) (dec : DecidableEq (Fin n)) :
      @Fintype.piFinset (Fin n) dec _ (fun _ => ℕ) t =
        @Fintype.piFinset (Fin n) (Classical.typeDecidableEq _) _ (fun _ => ℕ) t := by
    ext r
    simp only [Fintype.mem_piFinset]
  have hite (p : Prop) (dec : Decidable p) (z w : ℂ) :
      @ite ℂ p dec z w = @ite ℂ p (Classical.propDecidable p) z w :=
    @ite_cond_congr ℂ p p dec (Classical.propDecidable p) z w rfl
  have hidentity : F = F3 + F4 + F5 := by
    dsimp only [F3, F4, F5]
    rw [hC3def, hC4def, hC5def]
    simpa only [T3, T4, T5, α, and_assoc, hpi, hite] using hfinite x hxf
  have hadd (f g : ℕ →₀ ℂ) (q : ℕ) : fullDiscrepancy (f + g) q a =
      fullDiscrepancy f q a + fullDiscrepancy g q a := by
    simp_rw [fullDiscrepancy_eq_finsupp_sum]
    rw [Finsupp.sum_add_index' (fun n => by simp)
      (fun n z w => by split_ifs <;> ring)]
  rw [hidentity]
  calc
    _ ≤ ∑ q ∈ Q,
        (‖fullDiscrepancy F3 q a‖ + ‖fullDiscrepancy F4 q a‖ +
          ‖fullDiscrepancy F5 q a‖) := by
      apply Finset.sum_le_sum
      intro q _hq
      rw [hadd, hadd]
      exact (norm_add_le _ _).trans (add_le_add (norm_add_le _ _) (le_refl _))
    _ = (∑ q ∈ Q, ‖fullDiscrepancy F3 q a‖) +
        (∑ q ∈ Q, ‖fullDiscrepancy F4 q a‖) +
        ∑ q ∈ Q, ‖fullDiscrepancy F5 q a‖ := by
      rw [Finset.sum_add_distrib, Finset.sum_add_distrib]
    _ ≤ K3 * x / (Real.log x) ^ A + K4 * x / (Real.log x) ^ A +
        K5 * x / (Real.log x) ^ A := add_le_add (add_le_add h3 h4) h5
    _ = (K3 + K4 + K5) * x / (Real.log x) ^ A := by ring

open Classical in
theorem literal_minorant_log_saving_of_twelve_components
    (j : ℕ) («ω» δ A : ℝ) (L0 : ℝ → ℝ)
    (hparts : ∀ i : Fin 12, ∃ K X : ℝ, 0 < K ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ), (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let F : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
          Finsupp.single n (literalMinorantBuchstabPiece x i n : ℂ)
        let Q := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter (fun q =>
          q ∣ (∏ p ∈ I, p) ∧
            Nonempty (DenseDivisibilityWitness Y j q))
        (∑ q ∈ Q, ‖fullDiscrepancy F q a‖) ≤ K * x / (Real.log x) ^ A) :
    ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ), (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let ρx : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
          Finsupp.single n
            (((if n.Prime then (1 : ℝ) else 0) - exceptionalPrimeDefect x 0 n -
              exceptionalPrimeDefect x 1 n : ℝ) : ℂ)
        let Q := (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter (fun q =>
          q ∣ (∏ p ∈ I, p) ∧
            Nonempty (DenseDivisibilityWitness Y j q))
        (∑ q ∈ Q, ‖fullDiscrepancy ρx q a‖) ≤ K * x / (Real.log x) ^ A := by
  choose K X hK hb using hparts
  obtain ⟨Xc, hXc⟩ := eventually_atTop.mp literal_minorant_buchstab_weighted_discrepancy_cover
  let X0 := max 2 (max Xc (∑ i : Fin 12, |X i|))
  have hsumpos : 0 < ∑ i : Fin 12, K i :=
    Finset.sum_pos (fun i _hi => hK i) Finset.univ_nonempty
  refine ⟨∑ i : Fin 12, K i, X0, hsumpos, ?_, ?_⟩
  · exact (by norm_num : (1 : ℝ) < 2).trans_le (le_max_left _ _)
  · intro x hx Y hY I hI a ha ρx Q
    have hxc : Xc ≤ x :=
      (le_max_left Xc _).trans ((le_max_right _ _).trans hx)
    have hxi (i : Fin 12) : X i ≤ x := by
      calc
        X i ≤ |X i| := le_abs_self _
        _ ≤ ∑ l : Fin 12, |X l| :=
          Finset.single_le_sum (fun l _hl => abs_nonneg (X l)) (Finset.mem_univ i)
        _ ≤ x := (le_max_right Xc _).trans ((le_max_right _ _).trans hx)
    have hcover := hXc x hxc (Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊) Finset.Subset.rfl
      Q (fun _ => a) (fun _ => 1) (fun _ _ => by norm_num)
    simp only [one_mul] at hcover
    calc
      (∑ q ∈ Q, ‖fullDiscrepancy ρx q a‖) ≤
          ∑ i : Fin 12, ∑ q ∈ Q, ‖fullDiscrepancy
            (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
              Finsupp.single n (literalMinorantBuchstabPiece x i n : ℂ)) q a‖ := hcover
      _ ≤ ∑ i : Fin 12, K i * x / (Real.log x) ^ A := by
        apply Finset.sum_le_sum
        intro i _hi
        exact hb i x (hxi i) Y hY I hI a ha
      _ = (∑ i : Fin 12, K i) * x / (Real.log x) ^ A := by
        rw [← Finset.sum_div, ← Finset.sum_mul]

open Classical in
theorem literal_minorant_lower_coherent_log_saving_of_deligne
    (τ : ℝ) (hτ : 0 < τ) (hτsmall : τ ≤ 1 / 10 ^ 10)
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : Fin 2) («ω» δ : ℝ) (hω : 0 < «ω») (hδ : 0 < δ)
    (hlevel : (1 / 2 : ℝ) + 2 * «ω» <
      59519 / 100000 - τ)
    (hsmooth : (1 / 4 : ℝ) + 7 * «ω» + 2 * δ <
      1058 / 3125 - τ)
    (hI : if j = 0 then
      54 * «ω» + 15 * δ + 5 * (1 / 2 - 40481 / 100000 + τ) < 1
      else
      56 * «ω» + 16 * δ + 4 * (1 / 2 - 40481 / 100000 + τ) < 1)
    (hII : 68 * «ω» + 14 * δ < 1)
    (hthree : (1 / 18 : ℝ) + 28 * «ω» / 9 + 2 * δ / 9 <
      19 / 200 - τ)
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Filter.Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x)
      Filter.atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ),
        (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let ρx : ℕ →₀ ℂ :=
          ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n
              (((if n.Prime then (1 : ℝ) else 0) -
                exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n : ℝ) : ℂ)
        let Q : Finset ℕ :=
          (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter
            (fun q => q ∣ ∏ p ∈ I, p ∧
              Nonempty (DenseDivisibilityWitness
                Y (j.val + 1) q))
        (∑ q ∈ Q, ‖fullDiscrepancy ρx q a‖) ≤
          K * x / (Real.log x) ^ A := by
  let σ : ℝ := 1 / 2 - 40481 / 100000 + τ
  have hσgap : (1 / 2 : ℝ) - 40481 / 100000 < σ := by
    dsimp only [σ]
    exact lt_add_of_pos_right _ hτ
  have hsource :
      ((j.val + 1) = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      ((j.val + 1) = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      ((j.val + 1) = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1) := by
    fin_cases j
    · left
      exact ⟨rfl, by simpa [σ] using hI, hII⟩
    · right
      left
      exact ⟨rfl, by simpa [σ] using hI, hII⟩
  intro A hA
  apply literal_minorant_log_saving_of_twelve_components (j.val + 1) «ω» δ A L0
  intro i
  fin_cases i
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      siftedTheta_lower_dense_log_saving_of_deligne τ hτ hτsmall (0 : Fin 6) hDeligne j «ω» δ hω hδ
        hlevel hsmooth hI hII hthree L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      siftedTheta_lower_dense_log_saving_of_deligne τ hτ hτsmall (1 : Fin 6) hDeligne j «ω» δ hω hδ
        hlevel hsmooth hI hII hthree L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      siftedTheta_lower_dense_log_saving_of_deligne τ hτ hτsmall (2 : Fin 6) hDeligne j «ω» δ hω hδ
        hlevel hsmooth hI hII hthree L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      siftedTheta_lower_dense_log_saving_of_deligne τ hτ hτsmall (3 : Fin 6) hDeligne j «ω» δ hω hδ
        hlevel hsmooth hI hII hthree L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      siftedTheta_lower_dense_log_saving_of_deligne τ hτ hτsmall (4 : Fin 6) hDeligne j «ω» δ hω hδ
        hlevel hsmooth hI hII hthree L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      sourceLargeFirst_coherent_log_saving_of_deligne hDeligne
        (j.val + 1) «ω» δ σ hω hδ hσgap hsource L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      sourceCentralPair_coherent_log_saving_of_deligne hDeligne
        (j.val + 1) «ω» δ σ hω hδ hσgap hsource L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      sourceT3_lower_dense_log_saving_of_deligne τ hτ hτsmall hDeligne j «ω» δ hω hδ
        hlevel hsmooth hI hII hthree L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      sourceT5_sub_exceptionalPrimeDefect_zero_coherent_log_saving_of_deligne hDeligne
        (j.val + 1) «ω» δ σ hω hδ hσgap hsource L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      sourceT4_sub_sourceU1_coherent_log_saving_of_deligne hDeligne
        (j.val + 1) «ω» δ σ hω hδ hσgap hsource L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      siftedTheta_lower_dense_log_saving_of_deligne τ hτ hτsmall (5 : Fin 6) hDeligne j «ω» δ hω hδ
        hlevel hsmooth hI hII hthree L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      sourceU3_sub_exceptionalPrimeDefect_one_coherent_log_saving_of_deligne hDeligne
        (j.val + 1) «ω» δ σ hω hδ hσgap hsource L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩

open Classical in
theorem literal_minorant_coherent_log_saving_of_deligne
    (τ : ℝ) (hτ : 0 < τ) (hτsmall : τ ≤ 1 / 10 ^ 10)
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    («ω» δ : ℝ) (hω : 0 < «ω») (hδ : 0 < δ)
    (hlevel : (1 / 2 : ℝ) + 2 * «ω» <
      59519 / 100000 - τ)
    (hsmooth : (1 / 4 : ℝ) + 7 * «ω» + 2 * δ <
      1058 / 3125 - τ)
    (hI : 72 * «ω» + 24 * δ < 1)
    (hII : (1 / 4 : ℝ) + 12 * «ω» + 4 * δ <
      40481 / 100000 - τ)
    (hIII : 32 * «ω» + 10 * δ <
      40481 / 100000 - τ)
    (hthree : (1 / 18 : ℝ) + 28 * «ω» / 9 + 2 * δ / 9 <
      19 / 200 - τ)
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Filter.Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x)
      Filter.atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ),
        (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let ρx : ℕ →₀ ℂ :=
          ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n
              (((if n.Prime then (1 : ℝ) else 0) -
                exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n : ℝ) : ℂ)
        let Q : Finset ℕ :=
          (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter
            (fun q => q ∣ ∏ p ∈ I, p ∧
              Nonempty (DenseDivisibilityWitness Y 3 q))
        (∑ q ∈ Q, ‖fullDiscrepancy ρx q a‖) ≤
          K * x / (Real.log x) ^ A := by
  let σ : ℝ := 1 / 2 - 40481 / 100000 + τ
  have hσgap : (1 / 2 : ℝ) - 40481 / 100000 < σ := by
    dsimp only [σ]
    exact lt_add_of_pos_right _ hτ
  have hsource :
      (3 = 1 ∧ 54 * «ω» + 15 * δ + 5 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (3 = 2 ∧ 56 * «ω» + 16 * δ + 4 * σ < 1 ∧ 68 * «ω» + 14 * δ < 1) ∨
      (3 = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * σ < 1 ∧ 64 * «ω» + 20 * δ + 2 * σ < 1) := by
    right
    right
    refine ⟨rfl, hI, ?_, ?_⟩
    · dsimp only [σ]
      linarith
    · dsimp only [σ]
      linarith
  intro A hA
  apply literal_minorant_log_saving_of_twelve_components 3 «ω» δ A L0
  intro i
  fin_cases i
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      siftedTheta_triply_dense_log_saving_of_deligne τ hτ hτsmall (0 : Fin 6) hDeligne «ω» δ hω hδ
        hlevel hsmooth hI hII hIII hthree L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      siftedTheta_triply_dense_log_saving_of_deligne τ hτ hτsmall (1 : Fin 6) hDeligne «ω» δ hω hδ
        hlevel hsmooth hI hII hIII hthree L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      siftedTheta_triply_dense_log_saving_of_deligne τ hτ hτsmall (2 : Fin 6) hDeligne «ω» δ hω hδ
        hlevel hsmooth hI hII hIII hthree L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      siftedTheta_triply_dense_log_saving_of_deligne τ hτ hτsmall (3 : Fin 6) hDeligne «ω» δ hω hδ
        hlevel hsmooth hI hII hIII hthree L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      siftedTheta_triply_dense_log_saving_of_deligne τ hτ hτsmall (4 : Fin 6) hDeligne «ω» δ hω hδ
        hlevel hsmooth hI hII hIII hthree L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      sourceLargeFirst_coherent_log_saving_of_deligne hDeligne
        3 «ω» δ σ hω hδ hσgap hsource L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      sourceCentralPair_coherent_log_saving_of_deligne hDeligne
        3 «ω» δ σ hω hδ hσgap hsource L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      sourceT3_triply_dense_log_saving_of_deligne τ hτ hτsmall hDeligne «ω» δ hω hδ
        hlevel hsmooth hI hII hIII hthree L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      sourceT5_sub_exceptionalPrimeDefect_zero_coherent_log_saving_of_deligne hDeligne
        3 «ω» δ σ hω hδ hσgap hsource L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      sourceT4_sub_sourceU1_coherent_log_saving_of_deligne hDeligne
        3 «ω» δ σ hω hδ hσgap hsource L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      siftedTheta_triply_dense_log_saving_of_deligne τ hτ hτsmall (5 : Fin 6) hDeligne «ω» δ hω hδ
        hlevel hsmooth hI hII hIII hthree L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩
  · obtain ⟨K, X, hK, _hX, h⟩ :=
      sourceU3_sub_exceptionalPrimeDefect_one_coherent_log_saving_of_deligne hDeligne
        3 «ω» δ σ hω hδ hσgap hsource L0 hL0 hL0sub A hA
    exact ⟨K, X, hK, h⟩

open Classical in
theorem exists_minorant_parameter_tolerance (j : ℕ) («ω» δ : ℝ)
    (hlevel : (1 / 2 : ℝ) + 2 * «ω» < 59519 / 100000)
    (hsmooth : (1 / 4 : ℝ) + 7 * «ω» + 2 * δ < 1058 / 3125)
    (hthree : (1 / 18 : ℝ) + 28 * «ω» / 9 + 2 * δ / 9 < 19 / 200)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * ((1 / 2 : ℝ) - 40481 / 100000) < 1 ∧
        68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * ((1 / 2 : ℝ) - 40481 / 100000) < 1 ∧
        68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * ((1 / 2 : ℝ) - 40481 / 100000) < 1 ∧
        64 * «ω» + 20 * δ + 2 * ((1 / 2 : ℝ) - 40481 / 100000) < 1)) :
    ∃ τ : ℝ, 0 < τ ∧ τ ≤ 1 / 10 ^ 10 ∧
      (1 / 2 : ℝ) + 2 * «ω» < 59519 / 100000 - τ ∧
      (1 / 4 : ℝ) + 7 * «ω» + 2 * δ < 1058 / 3125 - τ ∧
      (1 / 18 : ℝ) + 28 * «ω» / 9 + 2 * δ / 9 < 19 / 200 - τ ∧
      ((j = 1 ∧ 54 * «ω» + 15 * δ +
          5 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1 ∧
          68 * «ω» + 14 * δ < 1) ∨
        (j = 2 ∧ 56 * «ω» + 16 * δ +
          4 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1 ∧
          68 * «ω» + 14 * δ < 1) ∨
        (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
          48 * «ω» + 16 * δ + 4 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1 ∧
          64 * «ω» + 20 * δ + 2 * ((1 / 2 : ℝ) - 40481 / 100000 + τ) < 1)) := by
  have small (η : ℝ) (hη : 0 < η) :
      ∃ τ : ℝ, 0 < τ ∧ τ ≤ 1 / 10 ^ 10 ∧ τ < η ∧
        (1 / 2 : ℝ) + 2 * «ω» < 59519 / 100000 - τ ∧
        (1 / 4 : ℝ) + 7 * «ω» + 2 * δ < 1058 / 3125 - τ ∧
        (1 / 18 : ℝ) + 28 * «ω» / 9 + 2 * δ / 9 < 19 / 200 - τ := by
    obtain ⟨τ, hτ, hbound⟩ := exists_between
      (lt_min (by norm_num : (0 : ℝ) < 1 / 10 ^ 10)
        (lt_min hη (lt_min (sub_pos.mpr hlevel)
          (lt_min (sub_pos.mpr hsmooth) (sub_pos.mpr hthree)))))
    simp only [lt_min_iff] at hbound
    obtain ⟨hcap, hη', hlevel', hsmooth', hthree'⟩ := hbound
    exact ⟨τ, hτ, hcap.le, hη', by linarith, by linarith, by linarith⟩
  rcases hsource with ⟨hj, hI, hII⟩ | ⟨hj, hI, hII⟩ | ⟨hj, hII, hI, hI'⟩
  · obtain ⟨τ, hτ, hcap, hsmall, hlevel', hsmooth', hthree'⟩ :=
      small ((1 - (54 * «ω» + 15 * δ + 5 * ((1 / 2 : ℝ) - 40481 / 100000))) / 5)
        (by linarith)
    exact ⟨τ, hτ, hcap, hlevel', hsmooth', hthree',
      Or.inl ⟨hj, by linarith, hII⟩⟩
  · obtain ⟨τ, hτ, hcap, hsmall, hlevel', hsmooth', hthree'⟩ :=
      small ((1 - (56 * «ω» + 16 * δ + 4 * ((1 / 2 : ℝ) - 40481 / 100000))) / 4)
        (by linarith)
    exact ⟨τ, hτ, hcap, hlevel', hsmooth', hthree',
      Or.inr (Or.inl ⟨hj, by linarith, hII⟩)⟩
  · obtain ⟨τ, hτ, hcap, hsmall, hlevel', hsmooth', hthree'⟩ :=
      small (min
        ((1 - (48 * «ω» + 16 * δ + 4 * ((1 / 2 : ℝ) - 40481 / 100000))) / 4)
        ((1 - (64 * «ω» + 20 * δ + 2 * ((1 / 2 : ℝ) - 40481 / 100000))) / 2))
        (lt_min (by linarith) (by linarith))
    rcases lt_min_iff.mp hsmall with ⟨hsmall, hsmall'⟩
    exact ⟨τ, hτ, hcap, hlevel', hsmooth', hthree',
      Or.inr (Or.inr ⟨hj, hII, by linarith, by linarith⟩)⟩

open Classical in
theorem literal_minorant_closed_source_coherent_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : ℕ) («ω» δ : ℝ) (hω : 0 < «ω») (hδ : 0 < δ)
    (hlevel : (1 / 2 : ℝ) + 2 * «ω» < 59519 / 100000)
    (hsmooth : (1 / 4 : ℝ) + 7 * «ω» + 2 * δ < 1058 / 3125)
    (hthree : (1 / 18 : ℝ) + 28 * «ω» / 9 + 2 * δ / 9 < 19 / 200)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * ((1 / 2 : ℝ) - 40481 / 100000) < 1 ∧
        68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * ((1 / 2 : ℝ) - 40481 / 100000) < 1 ∧
        68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * ((1 / 2 : ℝ) - 40481 / 100000) < 1 ∧
        64 * «ω» + 20 * δ + 2 * ((1 / 2 : ℝ) - 40481 / 100000) < 1))
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Filter.Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x)
      Filter.atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ),
        (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let ρx : ℕ →₀ ℂ :=
          ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            Finsupp.single n
              (((if n.Prime then (1 : ℝ) else 0) -
                exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n : ℝ) : ℂ)
        let Q : Finset ℕ :=
          (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter
            (fun q => q ∣ ∏ p ∈ I, p ∧
              Nonempty (DenseDivisibilityWitness Y j q))
        (∑ q ∈ Q, ‖fullDiscrepancy ρx q a‖) ≤
          K * x / (Real.log x) ^ A := by
  obtain ⟨τ, hτ, hτsmall, hlevelτ, hsmoothτ, hthreeτ, hsourceτ⟩ :=
    exists_minorant_parameter_tolerance j «ω» δ hlevel hsmooth hthree hsource
  rcases hsourceτ with ⟨rfl, hI, hII⟩ | ⟨rfl, hI, hII⟩ | ⟨rfl, hI, hII, hIII⟩
  · exact literal_minorant_lower_coherent_log_saving_of_deligne τ hτ hτsmall
      hDeligne 0 «ω» δ hω hδ hlevelτ hsmoothτ (by simpa using hI) hII hthreeτ
      L0 hL0 hL0sub
  · exact literal_minorant_lower_coherent_log_saving_of_deligne τ hτ hτsmall
      hDeligne 1 «ω» δ hω hδ hlevelτ hsmoothτ (by simpa using hI) hII hthreeτ
      L0 hL0 hL0sub
  · exact literal_minorant_coherent_log_saving_of_deligne τ hτ hτsmall
      hDeligne «ω» δ hω hδ hlevelτ hsmoothτ hI
      (by linarith only [hII]) (by linarith only [hIII]) hthreeτ L0 hL0 hL0sub

section
open Filter Asymptotics

theorem closed_interval_sum_eq_half_open_add_endpoint
    {M : Type*} [AddCommMonoid M] (x : ℝ) (hx : 0 ≤ x) (f : ℕ → M) :
    (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, f n) =
      (∑ n ∈ Finset.Ico ⌈x⌉₊ ⌈2 * x⌉₊, f n) +
        if (⌊2 * x⌋₊ : ℝ) = 2 * x then f ⌊2 * x⌋₊ else 0 := by
  classical
  by_cases h : (⌊2 * x⌋₊ : ℝ) = 2 * x
  · have hc : ⌈2 * x⌉₊ = ⌊2 * x⌋₊ := by rw [← h, Nat.ceil_natCast, Nat.floor_natCast]
    rw [hc, ite_eq_left h]
    exact (Finset.sum_Ico_add_eq_sum_Icc (Nat.ceil_le.mpr (by linarith))).symm
  · have hc : ⌈2 * x⌉₊ = ⌊2 * x⌋₊ + 1 := by
      have hle := Nat.ceil_le_floor_add_one (2 * x)
      have hlt : ⌊2 * x⌋₊ < ⌈2 * x⌉₊ := Nat.lt_ceil.mpr
        (lt_of_le_of_ne (Nat.floor_le (mul_nonneg zero_le_two hx)) h)
      omega
    rw [hc, ite_eq_right h, add_zero, Finset.Ico_add_one_right_eq_Icc]

theorem closed_interval_sum_sub_half_open_abs_le
    (x : ℝ) (hx : 0 ≤ x) (f : ℕ → ℝ) :
    |(∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, f n) -
        ∑ n ∈ Finset.Ico ⌈x⌉₊ ⌈2 * x⌉₊, f n| ≤ |f ⌊2 * x⌋₊| := by
  rw [closed_interval_sum_eq_half_open_add_endpoint x hx f, add_sub_cancel_left]
  split_ifs <;> simp only [abs_zero, le_rfl, abs_nonneg]

/--
The finitely supported restriction of `f` to natural numbers in the half-open real window `[x, 2
* x)`, represented by natural-number ceiling endpoints.
-/
noncomputable def halfOpenSample (x : ℝ) (f : ℕ → ℂ) : ℕ →₀ ℂ :=
  ∑ n ∈ Finset.Ico ⌈x⌉₊ ⌈2 * x⌉₊, Finsupp.single n (f n)

@[simp] theorem halfOpenSample_apply (x : ℝ) (f : ℕ → ℂ) (n : ℕ) :
    halfOpenSample x f n = if x ≤ (n : ℝ) ∧ (n : ℝ) < 2 * x then f n else 0 := by
  classical
  simp only [halfOpenSample, Finsupp.finsetSum_apply, Finsupp.single_apply,
    Finset.sum_ite_eq', Finset.mem_Ico, Nat.ceil_le, Nat.lt_ceil]

theorem sum_Icc_single_eq_halfOpenSample_add_endpoint
    (x : ℝ) (hx : 0 ≤ x) (f : ℕ → ℂ) :
    (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, Finsupp.single n (f n)) =
      halfOpenSample x f +
        if (⌊2 * x⌋₊ : ℝ) = 2 * x then Finsupp.single ⌊2 * x⌋₊ (f ⌊2 * x⌋₊) else 0 :=
  closed_interval_sum_eq_half_open_add_endpoint x hx (fun n => Finsupp.single n (f n))

theorem norm_fullDiscrepancy_closed_sub_halfOpen_le
    (x : ℝ) (hx : 0 ≤ x) (f : ℕ → ℂ) (q a : ℕ) (hq : 0 < q) :
    ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, Finsupp.single n (f n)) q a -
      fullDiscrepancy (halfOpenSample x f) q a‖ ≤
        2 * ‖f ⌊2 * x⌋₊‖ := by
  classical
  simp only [halfOpenSample, fullDiscrepancy_sample]
  rw [closed_interval_sum_eq_half_open_add_endpoint x hx, add_sub_cancel_left]
  by_cases hend : (⌊2 * x⌋₊ : ℝ) = 2 * x
  · rw [ite_eq_left hend]
    have h := norm_fullDiscrepancy_sample_le_two_sum_norm
      {⌊2 * x⌋₊} f q a hq
    rw [fullDiscrepancy_sample] at h
    simpa only [Finset.sum_singleton] using h
  · rw [ite_eq_right hend, norm_zero]
    exact mul_nonneg (by norm_num : (0 : ℝ) ≤ 2) (norm_nonneg _)

theorem norm_fullDiscrepancy_halfOpen_le
    (x : ℝ) (hx : 0 ≤ x) (f : ℕ → ℂ) (q a : ℕ) (hq : 0 < q) :
    ‖fullDiscrepancy (halfOpenSample x f) q a‖ ≤
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, Finsupp.single n (f n)) q a‖ +
        2 * ‖f ⌊2 * x⌋₊‖ :=
  (norm_le_norm_add_norm_sub _ _).trans
    (add_le_add (le_refl _) (norm_fullDiscrepancy_closed_sub_halfOpen_le x hx f q a hq))

theorem halfOpenSample_divisor_weight_log_transfer
    (θ : ℝ) (hθ : θ < 1) (J C : ℕ) (f : ℝ → ℕ → ℂ)
    (hbound : ∀ᶠ x : ℝ in atTop, ‖f x ⌊2 * x⌋₊‖ ≤ (C : ℝ)) (A : ℝ) :
    ∀ᶠ x : ℝ in atTop,
      ∀ S : Finset ℕ, S ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ → ∀ a : ℕ → ℕ,
        (∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy (halfOpenSample x (f x)) q (a q)‖) ≤
          (∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy
              (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, Finsupp.single n (f x n))
              q (a q)‖) + x / (Real.log x) ^ A := by
  classical
  filter_upwards [hbound,
    fixed_shift_divisor_moment_eventually
      θ hθ J C A,
    eventually_ge_atTop (2 : ℝ)] with x hfx hmoment hx
  intro S hS a
  have hx0 : 0 ≤ x := (by norm_num : (0 : ℝ) ≤ 2).trans hx
  have hpoint (q : ℕ) (hq : q ∈ S) :
      ‖fullDiscrepancy (halfOpenSample x (f x)) q (a q)‖ ≤
        ‖fullDiscrepancy
          (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, Finsupp.single n (f x n))
          q (a q)‖ + 4 * (C : ℝ) := by
    refine (norm_fullDiscrepancy_halfOpen_le x hx0 (f x) q (a q)
      (Finset.mem_Icc.mp (hS hq)).1).trans ?_
    exact add_le_add le_rfl
      (by nlinarith only [hfx, (show (0 : ℝ) ≤ C from Nat.cast_nonneg C)])
  calc
    _ ≤ ∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
        (‖fullDiscrepancy
          (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, Finsupp.single n (f x n))
          q (a q)‖ + 4 * (C : ℝ)) :=
      Finset.sum_le_sum fun q hq =>
        mul_le_mul_of_nonneg_left (hpoint q hq) (pow_nonneg (Nat.cast_nonneg _) _)
    _ = (∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
        ‖fullDiscrepancy
          (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, Finsupp.single n (f x n))
          q (a q)‖) + 4 * (C : ℝ) * ∑ q ∈ S, (q.divisors.card : ℝ) ^ J := by
      simp only [mul_add, Finset.sum_add_distrib, ← Finset.sum_mul]
      ring
    _ ≤ (∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
        ‖fullDiscrepancy
          (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, Finsupp.single n (f x n))
          q (a q)‖) + 4 * (C : ℝ) *
        ∑ q ∈ Finset.Icc 1 ⌊x ^ θ⌋₊, (q.divisors.card : ℝ) ^ J := by
      have hsum : (∑ q ∈ S, (q.divisors.card : ℝ) ^ J) ≤
          ∑ q ∈ Finset.Icc 1 ⌊x ^ θ⌋₊, (q.divisors.card : ℝ) ^ J :=
        Finset.sum_le_sum_of_subset_of_nonneg hS (fun q _ _ => by positivity)
      exact add_le_add le_rfl (mul_le_mul_of_nonneg_left hsum (by positivity))
    _ ≤ (∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
        ‖fullDiscrepancy
          (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, Finsupp.single n (f x n))
          q (a q)‖) + 4 * (C : ℝ) *
        ((⌊x ^ θ⌋₊ : ℝ) * (1 + Real.log (⌊x ^ θ⌋₊ : ℝ)) ^ (2 ^ J - 1)) := by
      exact add_le_add le_rfl (mul_le_mul_of_nonneg_left
        (sum_card_divisors_pow_le_mul_log_pow J ⌊x ^ θ⌋₊)
        (by positivity))
    _ = (∑ q ∈ S, (q.divisors.card : ℝ) ^ J *
        ‖fullDiscrepancy
          (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, Finsupp.single n (f x n))
          q (a q)‖) +
        4 * (C : ℝ) * (⌊x ^ θ⌋₊ : ℝ) *
          (1 + Real.log (⌊x ^ θ⌋₊ : ℝ)) ^ (2 ^ J - 1) := by ring
    _ ≤ _ := add_le_add le_rfl hmoment

theorem literal_minorant_endpoint_norm_le :
    ∀ᶠ x : ℝ in atTop,
      ‖(((if (⌊2 * x⌋₊).Prime then (1 : ℝ) else 0) -
        exceptionalPrimeDefect x 0 ⌊2 * x⌋₊ -
        exceptionalPrimeDefect x 1 ⌊2 * x⌋₊ : ℝ) : ℂ)‖ ≤ 6251 := by
  classical
  filter_upwards [eventually_literal_minorant_pointwise,
    eventually_ge_atTop (2 : ℝ)] with x hpoint hx
  have hx0 : 0 ≤ x := (by norm_num : (0 : ℝ) ≤ 2).trans hx
  have hlo : x ≤ (⌊2 * x⌋₊ : ℝ) := by
    have hfloor := Nat.lt_floor_add_one (2 * x)
    linarith
  have hhi : (⌊2 * x⌋₊ : ℝ) ≤ 2 * x := Nat.floor_le (by positivity)
  simpa only [Complex.norm_real, Real.norm_eq_abs] using
    (hpoint ⌊2 * x⌋₊ hlo hhi).2.2.2

open Classical in
theorem literal_minorant_true_mass :
    let kappa : ℝ := exceptionalMassCoefficient 0 + exceptionalMassCoefficient 1
    0 ≤ kappa ∧
      kappa ≤ (146365385252734375 : ℝ) / 15379362287924882625792 ∧
      (146365385252734375 : ℝ) / 15379362287924882625792 < (1 : ℝ) / 50000 ∧
      Tendsto
        (fun x : ℝ => Real.log x / x *
          (∑ n ∈ Finset.Ico ⌈x⌉₊ ⌈2 * x⌉₊,
            ((if n.Prime then (1 : ℝ) else 0) -
              exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n)))
        atTop (nhds (1 - kappa)) ∧
      Tendsto
        (fun x : ℝ => Real.log x / x *
          (∑ n ∈ Finset.Ico ⌈x⌉₊ ⌈2 * x⌉₊,
            (exceptionalPrimeDefect x 0 n + exceptionalPrimeDefect x 1 n)))
        atTop (nhds kappa) := by
  intro kappa
  have hlog : Tendsto (fun x : ℝ => Real.log x / x) atTop (nhds 0) := by
    simpa only [Real.rpow_one] using
      (isLittleO_log_rpow_atTop (show (0 : ℝ) < 1 from zero_lt_one)).tendsto_div_nhds_zero
  have transfer (f : ℝ → ℕ → ℝ) (C m : ℝ)
      (hf : ∀ᶠ x : ℝ in atTop, ∀ n : ℕ,
        x ≤ (n : ℝ) → (n : ℝ) ≤ 2 * x → |f x n| ≤ C)
      (hm : Tendsto
        (fun x : ℝ => Real.log x / x *
          (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, f x n)) atTop (nhds m)) :
      Tendsto
        (fun x : ℝ => Real.log x / x *
          (∑ n ∈ Finset.Ico ⌈x⌉₊ ⌈2 * x⌉₊, f x n)) atTop (nhds m) := by
    have hmajorant : Tendsto (fun x : ℝ => Real.log x / x * C) atTop (nhds 0) := by
      simpa only [zero_mul] using hlog.mul_const C
    have herror : Tendsto
        (fun x : ℝ => Real.log x / x *
          ((∑ n ∈ Finset.Ico ⌈x⌉₊ ⌈2 * x⌉₊, f x n) -
            ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, f x n)) atTop (nhds 0) := by
      apply squeeze_zero_norm' _ hmajorant
      filter_upwards [hf, eventually_gt_atTop (1 : ℝ)] with x hfx hx
      have hx0 : 0 < x := zero_lt_one.trans hx
      have hlo : x ≤ (⌊2 * x⌋₊ : ℝ) := by
        have hfloor := Nat.lt_floor_add_one (2 * x)
        linarith only [hfloor, hx]
      have hhi : (⌊2 * x⌋₊ : ℝ) ≤ 2 * x := Nat.floor_le (by positivity)
      have hbound :=
        (closed_interval_sum_sub_half_open_abs_le x hx0.le (f x)).trans
          (hfx _ hlo hhi)
      have hcoef : 0 ≤ Real.log x / x := div_nonneg (Real.log_nonneg hx.le) hx0.le
      rw [Real.norm_eq_abs, abs_mul, abs_of_nonneg hcoef, abs_sub_comm]
      exact mul_le_mul_of_nonneg_left hbound hcoef
    simpa only [← mul_add, sub_add_cancel, zero_add] using herror.add hm
  obtain ⟨hkappa, hupper, hstrict, hrho⟩ := literal_minorant_closed_true_mass
  refine ⟨hkappa, hupper, hstrict, ?_, ?_⟩
  · apply transfer _ 6251 (1 - kappa) _ hrho
    filter_upwards [eventually_literal_minorant_pointwise] with x hx n hlo hhi
    exact (hx n hlo hhi).2.2.2
  · have hclosed : Tendsto
        (fun x : ℝ => Real.log x / x *
          (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            (exceptionalPrimeDefect x 0 n + exceptionalPrimeDefect x 1 n)))
        atTop (nhds kappa) := by
      simpa only [Finset.sum_add_distrib, mul_add] using
        (exceptionalPrimeDefect_dyadic_mass_tendsto 0).add
          (exceptionalPrimeDefect_dyadic_mass_tendsto 1)
    apply transfer _ 6251 kappa _ hclosed
    filter_upwards [eventually_literal_minorant_pointwise] with x hx n hlo hhi
    have hpoint := hx n hlo hhi
    by_cases hp : n.Prime
    · have hprime := hpoint.1 hp
      simp only [hp, ite_true] at hprime
      have hzero : exceptionalPrimeDefect x 0 n + exceptionalPrimeDefect x 1 n = 0 := by
        linarith only [hprime]
      rw [hzero]
      norm_num
    · simpa only [hp, ite_false, sub_eq_add_neg, zero_add, ← neg_add, abs_neg] using
        hpoint.2.2.2

open Classical in
theorem literal_minorant_source_coherent_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (j : ℕ) («ω» δ : ℝ) (hω : 0 < «ω») (hδ : 0 < δ)
    (hlevel : (1 / 2 : ℝ) + 2 * «ω» < 59519 / 100000)
    (hsmooth : (1 / 4 : ℝ) + 7 * «ω» + 2 * δ < 1058 / 3125)
    (hthree : (1 / 18 : ℝ) + 28 * «ω» / 9 + 2 * δ / 9 < 19 / 200)
    (hsource :
      (j = 1 ∧ 54 * «ω» + 15 * δ + 5 * ((1 / 2 : ℝ) - 40481 / 100000) < 1 ∧
        68 * «ω» + 14 * δ < 1) ∨
      (j = 2 ∧ 56 * «ω» + 16 * δ + 4 * ((1 / 2 : ℝ) - 40481 / 100000) < 1 ∧
        68 * «ω» + 14 * δ < 1) ∨
      (j = 3 ∧ 72 * «ω» + 24 * δ < 1 ∧
        48 * «ω» + 16 * δ + 4 * ((1 / 2 : ℝ) - 40481 / 100000) < 1 ∧
        64 * «ω» + 20 * δ + 2 * ((1 / 2 : ℝ) - 40481 / 100000) < 1))
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Filter.Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x)
      Filter.atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ),
        (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let ρx : ℕ →₀ ℂ :=
          halfOpenSample x (fun n =>
            (((if n.Prime then (1 : ℝ) else 0) -
              exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n : ℝ) : ℂ))
        let Q : Finset ℕ :=
          (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω») * L0 x⌋₊).filter
            (fun q => q ∣ ∏ p ∈ I, p ∧
              Nonempty (DenseDivisibilityWitness Y j q))
        (∑ q ∈ Q, ‖PrimeGap186.fullDiscrepancy ρx q a‖) ≤
          K * x / (Real.log x) ^ A := by
  let f : ℝ → ℕ → ℂ := fun x n =>
    (((if n.Prime then (1 : ℝ) else 0) -
      exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n : ℝ) : ℂ)
  let θ : ℝ := (1 + (1 / 2 + 2 * «ω»)) / 2
  have hθ : θ < 1 := by dsimp only [θ]; linarith only [hlevel]
  have hgap : 0 < θ - (1 / 2 + 2 * «ω») := by
    dsimp only [θ]
    linarith only [hlevel]
  have hcut : ∀ᶠ x : ℝ in atTop,
      x ^ (1 / 2 + 2 * «ω») * L0 x ≤ x ^ θ := by
    have hsmall := (tendsto_order.mp hL0sub).2 _ hgap
    filter_upwards [hsmall, eventually_gt_atTop (1 : ℝ)] with x hsmallx hx
    have hx0 : 0 < x := zero_lt_one.trans hx
    have hL : L0 x ≤ x ^ (θ - (1 / 2 + 2 * «ω»)) := by
      apply (Real.log_le_log_iff (hL0 x) (Real.rpow_pos_of_pos hx0 _)).mp
      rw [Real.log_rpow hx0]
      exact ((div_lt_iff₀ (Real.log_pos hx)).mp hsmallx).le
    calc
      _ ≤ x ^ (1 / 2 + 2 * «ω») * x ^ (θ - (1 / 2 + 2 * «ω»)) :=
        mul_le_mul_of_nonneg_left hL (Real.rpow_nonneg hx0.le _)
      _ = x ^ θ := by rw [← Real.rpow_add hx0]; congr 1; ring
  intro A hA
  obtain ⟨K, X, hK, hX, hclosed⟩ :=
    literal_minorant_closed_source_coherent_log_saving_of_deligne hDeligne
      j «ω» δ hω hδ hlevel hsmooth hthree hsource L0 hL0 hL0sub A hA
  obtain ⟨Xe, hXe⟩ := Filter.eventually_atTop.mp
    (halfOpenSample_divisor_weight_log_transfer θ hθ 0 6251 f
      (by simpa only [f, Nat.cast_ofNat] using literal_minorant_endpoint_norm_le) A)
  obtain ⟨Xc, hXc⟩ := Filter.eventually_atTop.mp hcut
  refine ⟨K + 1, max X (max Xe Xc), by positivity,
    hX.trans_le (le_max_left _ _), ?_⟩
  intro x hx Y hY I hI a ha ρx Q
  have hxx : X ≤ x := (le_max_left _ _).trans hx
  have hxe : Xe ≤ x := (le_max_left _ _).trans ((le_max_right _ _).trans hx)
  have hxc : Xc ≤ x := (le_max_right _ _).trans ((le_max_right _ _).trans hx)
  have hQ : Q ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ := by
    intro q hq
    have hmem := Finset.mem_Icc.mp (Finset.mem_filter.mp hq).1
    exact Finset.mem_Icc.mpr ⟨hmem.1, hmem.2.trans (Nat.floor_mono (hXc x hxc))⟩
  have he := hXe x hxe Q hQ (fun _ => a)
  simp only [pow_zero, one_mul] at he
  have hc : (∑ q ∈ Q,
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, Finsupp.single n (f x n)) q a‖) ≤
      K * x / (Real.log x) ^ A := by
    simpa only [f] using hclosed x hxx Y hY I hI a ha
  calc
    _ ≤ _ := he
    _ ≤ K * x / (Real.log x) ^ A + x / (Real.log x) ^ A :=
      add_le_add hc le_rfl
    _ = _ := by ring

open Classical in
theorem literal_minorant_ordinary_bv_divisor_weight_log_saving
    (η : ℝ) (hη : 0 < η) (J : ℕ) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ a : ℕ → ℕ,
        (∀ q ∈ Finset.Icc 1 ⌊x ^ (1 / 2 - η)⌋₊, Nat.Coprime (a q) q) →
        let ρx : ℕ →₀ ℂ :=
          halfOpenSample x (fun n =>
            (((if n.Prime then (1 : ℝ) else 0) -
              exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n : ℝ) : ℂ))
        (∑ q ∈ Finset.Icc 1 ⌊x ^ (1 / 2 - η)⌋₊,
          (q.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy ρx q (a q)‖) ≤
          K * x / (Real.log x) ^ A := by
  let f : ℝ → ℕ → ℂ := fun x n =>
    (((if n.Prime then (1 : ℝ) else 0) -
      exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n : ℝ) : ℂ)
  intro A hA
  obtain ⟨K, X, hK, hX, hclosed⟩ :=
    literal_minorant_closed_ordinary_bv_divisor_weight_log_saving η hη J A hA
  obtain ⟨Xe, hXe⟩ := Filter.eventually_atTop.mp
    (halfOpenSample_divisor_weight_log_transfer
      (1 / 2 - η) (by linarith only [hη]) J 6251 f
      (by simpa only [f, Nat.cast_ofNat] using literal_minorant_endpoint_norm_le) A)
  refine ⟨K + 1, max X Xe, by positivity, hX.trans_le (le_max_left _ _), ?_⟩
  intro x hx a ha ρx
  have he := hXe x ((le_max_right _ _).trans hx)
    (Finset.Icc 1 ⌊x ^ (1 / 2 - η)⌋₊) (Finset.Subset.refl _) a
  have hc := hclosed x ((le_max_left _ _).trans hx) a ha
  change (∑ q ∈ Finset.Icc 1 ⌊x ^ (1 / 2 - η)⌋₊,
    (q.divisors.card : ℝ) ^ J *
      ‖fullDiscrepancy
        (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, Finsupp.single n (f x n)) q (a q)‖) ≤
      K * x / (Real.log x) ^ A at hc
  calc
    _ ≤ _ := he
    _ ≤ K * x / (Real.log x) ^ A + x / (Real.log x) ^ A :=
      add_le_add hc le_rfl
    _ = _ := by ring

open Classical in
theorem literal_minorant_terminal_coherent_log_saving_of_deligne
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (δ : ℝ) (hδ : 0 < δ) (hδsmall : δ < 1 / (10 : ℝ) ^ 6)
    (L0 : ℝ → ℝ) (hL0 : ∀ x : ℝ, 0 < L0 x)
    (hL0sub : Filter.Tendsto (fun x : ℝ => Real.log (L0 x) / Real.log x)
      Filter.atTop (nhds 0)) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ Y : Set.Ici (1 : ℝ),
        (Y : ℝ) = x ^ δ →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        let ρx : ℕ →₀ ℂ :=
          halfOpenSample x (fun n =>
            (((if n.Prime then (1 : ℝ) else 0) -
              exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n : ℝ) : ℂ))
        let Q : Finset ℕ :=
          (Finset.Icc 1 ⌊x ^ ((5253 : ℝ) / 10000) * L0 x⌋₊).filter
            (fun q => q ∣ ∏ p ∈ I, p ∧
              Nonempty (DenseDivisibilityWitness Y 3 q))
        (∑ q ∈ Q, ‖fullDiscrepancy ρx q a‖) ≤
          K * x / (Real.log x) ^ A := by
  have h := literal_minorant_source_coherent_log_saving_of_deligne hDeligne
    3 (253 / 20000) δ (by norm_num) hδ (by norm_num)
    (by linarith only [hδsmall]) (by linarith only [hδsmall])
    (Or.inr (Or.inr ⟨rfl, by linarith only [hδsmall],
      by linarith only [hδsmall], by linarith only [hδsmall]⟩)) L0 hL0 hL0sub
  norm_num only at h ⊢
  exact h

end

section
open Finset

/--
The selected coordinate set encoded by a Boolean choice of the distinguished coordinate `i` and
an optional coordinate from its `39`-element complement.
-/
def auxiliaryPrimeState (i : Fin 40) (s : Bool × Option (Fin 39)) :
    Finset (Fin 40) :=
  (if s.1 then {i} else ∅) ∪ s.2.toFinset.map i.succAboveEmb

/--
The local divisibility contrast `(1 - p * 1_{p ∣ n + h j}) / (p - 1)`. For prime `p`, it equals
`-1` on the forbidden residue class and `1 / (p - 1)` elsewhere.
-/
noncomputable def selbergPrimePsi
    (p : ℕ) (h : Fin 40 → ℕ) (j : Fin 40) (n : ℕ) : ℝ :=
  (1 - (p : ℝ) * (if p ∣ n + h j then 1 else 0)) / ((p : ℝ) - 1)

/--
The normalized residue average of the product of the two auxiliary-state basis functions modulo
`p`. Each basis function is the product of the local divisibility contrasts at its selected
coordinates.
-/
noncomputable def auxiliaryCategoricalGram
    (p : ℕ) (h : Fin 40 → ℕ) (i : Fin 40)
    (s t : Bool × Option (Fin 39)) : ℝ :=
  (1 / (p : ℝ)) * ∑ n ∈ Finset.range p,
    (∏ j ∈ auxiliaryPrimeState i s, selbergPrimePsi p h j n) *
      (∏ j ∈ auxiliaryPrimeState i t, selbergPrimePsi p h j n)

/--
The analogous auxiliary-state Gram entry in the independent Boolean model, where each coordinate
has weight `1 / p` for `true` and `1 - 1 / p` for `false`. The sum runs over all `40`-coordinate
Boolean assignments.
-/
noncomputable def auxiliaryIndependentGram
    (p : ℕ) (i : Fin 40) (s t : Bool × Option (Fin 39)) : ℝ :=
  let ψ : Bool → ℝ :=
    fun b => (1 - (p : ℝ) * (if b then 1 else 0)) / ((p : ℝ) - 1)
  ∑ ω : Fin 40 → Bool,
    (∏ j : Fin 40, if ω j then 1 / (p : ℝ) else 1 - 1 / (p : ℝ)) *
      (∏ j ∈ auxiliaryPrimeState i s, ψ (ω j)) *
        (∏ j ∈ auxiliaryPrimeState i t, ψ (ω j))

theorem difference_prime_dvd_presieving (H : Finset ℕ) (x : ℝ)
    {a b p : ℕ} (ha : a ∈ H) (hb : b ∈ H) (hab : a ≠ b)
    (hp : p.Prime) (hpd : p ∣ Nat.dist a b) : p ∣ presievingModulus H x := by
  classical
  unfold presievingModulus
  apply Finset.dvd_prod_of_mem (fun q : ℕ => q)
  apply Finset.mem_union_right
  exact Finset.mem_biUnion.mpr ⟨a, ha, Finset.mem_biUnion.mpr ⟨b, hb,
    Nat.mem_primeFactors.mpr ⟨hp, hpd, fun hzero => hab (Nat.eq_of_dist_eq_zero hzero)⟩⟩⟩

theorem auxiliaryPrimeState_false_none (i : Fin 40) :
    auxiliaryPrimeState i (false, none) = ∅ := by
  simp [auxiliaryPrimeState]

theorem auxiliaryPrimeState_true_none (i : Fin 40) :
    auxiliaryPrimeState i (true, none) = {i} := by
  simp [auxiliaryPrimeState]

theorem auxiliaryPrimeState_false_some (i : Fin 40) (j : Fin 39) :
    auxiliaryPrimeState i (false, some j) = {i.succAbove j} := by
  simp [auxiliaryPrimeState]

theorem auxiliaryPrimeState_true_some (i : Fin 40) (j : Fin 39) :
    auxiliaryPrimeState i (true, some j) = {i, i.succAbove j} := by
  simp [auxiliaryPrimeState]

theorem auxiliaryPrimeState_injective (i : Fin 40) :
    Function.Injective (auxiliaryPrimeState i) := by
  classical
  have hmem (s : Bool × Option (Fin 39)) :
      i ∈ auxiliaryPrimeState i s ↔ s.1 := by
    rcases s with ⟨b, o⟩
    cases b <;> cases o <;> simp [auxiliaryPrimeState]
  have herase (s : Bool × Option (Fin 39)) :
      (auxiliaryPrimeState i s).erase i = s.2.toFinset.map i.succAboveEmb := by
    rcases s with ⟨b, o⟩
    cases b <;> cases o <;> simp [auxiliaryPrimeState]
  intro s t hst
  have hb : s.1 = t.1 := by
    apply Bool.eq_iff_iff.mpr
    rw [← hmem s, ← hmem t, hst]
  have ho : s.2.toFinset = t.2.toFinset := by
    apply Finset.map_injective i.succAboveEmb
    rw [← herase s, ← herase t, hst]
  apply Prod.ext hb
  cases hs : s.2 <;> cases ht : t.2 <;> simp_all

theorem auxiliaryPrimeState_image (i : Fin 40) :
    Finset.univ.image (auxiliaryPrimeState i) =
      ({∅, {i}} : Finset (Finset (Fin 40))) ∪
        ((Finset.univ.erase i).image fun j => {j}) ∪
        ((Finset.univ.erase i).image fun j => {i, j}) := by
  classical
  ext S
  constructor
  · intro hS
    obtain ⟨⟨b, o⟩, _, rfl⟩ := Finset.mem_image.mp hS
    cases b with
    | false =>
      cases o with
      | none => simp [auxiliaryPrimeState_false_none]
      | some j =>
        rw [auxiliaryPrimeState_false_some]
        exact Finset.mem_union_left _ (Finset.mem_union_right _
          (Finset.mem_image.mpr ⟨i.succAbove j, by simp, rfl⟩))
    | true =>
      cases o with
      | none => simp [auxiliaryPrimeState_true_none]
      | some j =>
        rw [auxiliaryPrimeState_true_some]
        exact Finset.mem_union_right _
          (Finset.mem_image.mpr ⟨i.succAbove j, by simp, rfl⟩)
  · intro hS
    rcases Finset.mem_union.mp hS with hS | hS
    · rcases Finset.mem_union.mp hS with hS | hS
      · simp only [Finset.mem_insert, Finset.mem_singleton] at hS
        rcases hS with rfl | rfl
        · exact Finset.mem_image.mpr ⟨(false, none), Finset.mem_univ _,
            auxiliaryPrimeState_false_none i⟩
        · exact Finset.mem_image.mpr ⟨(true, none), Finset.mem_univ _,
            auxiliaryPrimeState_true_none i⟩
      · obtain ⟨j, hj, rfl⟩ := Finset.mem_image.mp hS
        obtain ⟨k, hk⟩ := Fin.exists_succAbove_eq (Finset.ne_of_mem_erase hj)
        refine Finset.mem_image.mpr ⟨(false, some k), Finset.mem_univ _, ?_⟩
        rw [auxiliaryPrimeState_false_some, hk]
    · obtain ⟨j, hj, rfl⟩ := Finset.mem_image.mp hS
      obtain ⟨k, hk⟩ := Fin.exists_succAbove_eq (Finset.ne_of_mem_erase hj)
      refine Finset.mem_image.mpr ⟨(true, some k), Finset.mem_univ _, ?_⟩
      rw [auxiliaryPrimeState_true_some, hk]

theorem auxiliaryPrimeState_card_states (i : Fin 40) :
    (Finset.univ.image (auxiliaryPrimeState i)).card = 80 := by
  classical
  rw [Finset.card_image_of_injective _ (auxiliaryPrimeState_injective i)]
  simp

theorem auxiliaryIndependentGram_mass (p : ℕ) (i : Fin 40) (hp : p.Prime)
    (hD : ∀ s t : Bool × Option (Fin 39),
      auxiliaryIndependentGram p i s t =
        if s = t then 1 / ((p : ℝ) - 1) ^ (auxiliaryPrimeState i s).card else 0) :
    let a : ℝ := (p : ℝ) - 1
    let d : ℝ := ∑ s : Bool × Option (Fin 39),
      ∑ t : Bool × Option (Fin 39), auxiliaryIndependentGram p i s t
    d = (1 + 39 / a) * (1 + 1 / a) ∧
      1 ≤ d ∧ d ≤ (1 + 1 / a) ^ 40 := by
  classical
  dsimp only
  let a : ℝ := (p : ℝ) - 1
  have ha1 : 1 ≤ a := by
    have hp2 : (2 : ℝ) ≤ p := by exact_mod_cast hp.two_le
    dsimp [a]
    linarith
  have ha : a ≠ 0 := ne_of_gt (lt_of_lt_of_le zero_lt_one ha1)
  have hb : 0 ≤ 1 / a := div_nonneg zero_le_one (le_trans zero_le_one ha1)
  have hdiag :
      (∑ s : Bool × Option (Fin 39),
        ∑ t : Bool × Option (Fin 39), auxiliaryIndependentGram p i s t) =
      ∑ s : Bool × Option (Fin 39), 1 / a ^ (auxiliaryPrimeState i s).card := by
    simp only [a, hD, Finset.sum_ite_eq, Finset.mem_univ, ite_true]
  have hmass :
      (∑ s : Bool × Option (Fin 39), 1 / a ^ (auxiliaryPrimeState i s).card) =
        (1 + 39 / a) * (1 + 1 / a) := by
    rw [Fintype.sum_prod_type, Fintype.sum_bool]
    simp [auxiliaryPrimeState]
    field_simp [ha]
    ring
  have hd := hdiag.trans hmass
  refine ⟨hd, ?_, ?_⟩
  · rw [hd]
    have h39 : 0 ≤ 39 / a := div_nonneg (by norm_num) (le_trans zero_le_one ha1)
    nlinarith [mul_nonneg h39 hb]
  · rw [hd]
    have hpow : 1 + (39 : ℝ) * (1 / a) ≤ (1 + 1 / a) ^ 39 :=
      one_add_mul_le_pow (by linarith : (-2 : ℝ) ≤ 1 / a) 39
    calc
      (1 + 39 / a) * (1 + 1 / a) =
          (1 + (39 : ℝ) * (1 / a)) * (1 + 1 / a) := by ring
      _ ≤ (1 + 1 / a) ^ 39 * (1 + 1 / a) :=
        mul_le_mul_of_nonneg_right hpow (by linarith)
      _ = (1 + 1 / a) ^ 40 := (pow_succ _ 39).symm

theorem auxiliaryIndependentGram_product (p : ℕ) (i : Fin 40)
    (s t : Bool × Option (Fin 39)) :
    let ψ : Bool → ℝ :=
      fun b => (1 - (p : ℝ) * (if b then 1 else 0)) / ((p : ℝ) - 1)
    auxiliaryIndependentGram p i s t =
      ∏ j : Fin 40, ∑ b : Bool,
        (if b then 1 / (p : ℝ) else 1 - 1 / (p : ℝ)) *
          (if j ∈ auxiliaryPrimeState i s then ψ b else 1) *
            (if j ∈ auxiliaryPrimeState i t then ψ b else 1) := by
  classical
  dsimp only
  rw [Fintype.prod_sum]
  simp only [auxiliaryIndependentGram, Finset.prod_mul_distrib,
    Finset.prod_ite_mem_eq]

theorem auxiliaryIndependentGram_eq (p : ℕ) (i : Fin 40)
    (s t : Bool × Option (Fin 39)) (hp : p.Prime)
    (hinj : Function.Injective (auxiliaryPrimeState i)) :
    auxiliaryIndependentGram p i s t =
      if s = t then 1 / ((p : ℝ) - 1) ^ (auxiliaryPrimeState i s).card else 0 := by
  classical
  let S := auxiliaryPrimeState i s
  let T := auxiliaryPrimeState i t
  let ψ : Bool → ℝ :=
    fun b => (1 - (p : ℝ) * (if b then 1 else 0)) / ((p : ℝ) - 1)
  have hp0 : (p : ℝ) ≠ 0 := by exact_mod_cast hp.ne_zero
  have hp1 : (p : ℝ) ≠ 1 := by exact_mod_cast hp.ne_one
  have ha : (p : ℝ) - 1 ≠ 0 := sub_ne_zero.mpr hp1
  have hmoment (j : Fin 40) :
      (∑ b : Bool,
        (if b then 1 / (p : ℝ) else 1 - 1 / (p : ℝ)) *
          (if j ∈ S then ψ b else 1) * (if j ∈ T then ψ b else 1)) =
        if j ∈ S then (if j ∈ T then 1 / ((p : ℝ) - 1) else 0)
        else (if j ∈ T then 0 else 1) := by
    dsimp only [ψ]
    rw [Fintype.sum_bool]
    by_cases hs : j ∈ S <;> by_cases ht : j ∈ T
    all_goals
      simp only [hs, ht, Bool.false_eq_true, ↓reduceIte, mul_one, mul_zero, sub_zero]
      field_simp [hp0, ha]
      ring
  calc
    auxiliaryIndependentGram p i s t =
        ∏ j : Fin 40,
          if j ∈ S then (if j ∈ T then 1 / ((p : ℝ) - 1) else 0)
          else (if j ∈ T then 0 else 1) := by
      rw [auxiliaryIndependentGram_product]
      exact Finset.prod_congr rfl fun j _ => hmoment j
    _ = if s = t then 1 / ((p : ℝ) - 1) ^ S.card else 0 := by
      by_cases hst : s = t
      · subst t
        rw [ite_eq_left rfl]
        simp +contextual [S, T]
      · rw [ite_eq_right hst]
        have hST : S ≠ T := fun h => hst (hinj h)
        have hdiff : ∃ j : Fin 40, ¬ (j ∈ S ↔ j ∈ T) := by
          by_contra! h
          exact hST (Finset.ext h)
        obtain ⟨j, hj⟩ := hdiff
        apply Finset.prod_eq_zero (Finset.mem_univ j)
        by_cases hs : j ∈ S <;> by_cases ht : j ∈ T <;> simp_all

theorem physical_residues_injective
    {𝓗 : Finset ℕ} {h𝓗_card : 𝓗.card = 40}
    (x : ℝ) (p : ℕ) (hp : p.Prime)
    (hpW : ¬ p ∣ presievingModulus 𝓗 x) :
    Function.Injective (fun j : Fin 40 =>
      (𝓗.orderEmbOfFin h𝓗_card j : ZMod p)) := by
  intro j k heq
  apply (𝓗.orderEmbOfFin h𝓗_card).injective
  by_contra hne
  apply hpW
  apply difference_prime_dvd_presieving 𝓗 x
    (𝓗.orderEmbOfFin_mem h𝓗_card j)
    (𝓗.orderEmbOfFin_mem h𝓗_card k) hne hp
  have hmod := (ZMod.natCast_eq_natCast_iff _ _ p).mp heq
  rw [Nat.dist]
  exact dvd_add hmod.symm.dvd' hmod.dvd'

theorem residue_hit_unique (p : ℕ) (h : Fin 40 → ℕ)
    (hinj : Function.Injective (fun j => (h j : ZMod p)))
    (n : ℕ) (j k : Fin 40) (hj : p ∣ n + h j) (hk : p ∣ n + h k) : j = k := by
  apply hinj
  have hj' : (n : ZMod p) + (h j : ZMod p) = 0 := by
    simpa only [Nat.cast_add] using (ZMod.natCast_eq_zero_iff (n + h j) p).mpr hj
  have hk' : (n : ZMod p) + (h k : ZMod p) = 0 := by
    simpa only [Nat.cast_add] using (ZMod.natCast_eq_zero_iff (n + h k) p).mpr hk
  exact add_left_cancel (hj'.trans hk'.symm)

theorem single_pole_count (p c : ℕ) (hp : 0 < p) :
    (∑ n ∈ Finset.range p, if p ∣ n + c then (1 : ℝ) else 0) = 1 := by
  classical
  let : NeZero p := ⟨ne_of_gt hp⟩
  let m : ℕ := (-(c : ZMod p)).val
  have hm : m ∈ Finset.range p := Finset.mem_range.mpr (ZMod.val_lt _)
  have hiff (n : ℕ) (hn : n ∈ Finset.range p) : p ∣ n + c ↔ n = m := by
    constructor
    · intro hd
      have heq : (n : ZMod p) = -(c : ZMod p) := by
        apply eq_neg_iff_add_eq_zero.mpr
        simpa only [Nat.cast_add] using (ZMod.natCast_eq_zero_iff (n + c) p).mpr hd
      have hv := congrArg ZMod.val heq
      simpa only [ZMod.val_natCast_of_lt (Finset.mem_range.mp hn)] using hv
    · rintro rfl
      apply (ZMod.natCast_eq_zero_iff (m + c) p).mp
      simp only [Nat.cast_add, m, ZMod.natCast_zmod_val, neg_add_cancel]
  calc
    _ = ∑ n ∈ Finset.range p, if n = m then (1 : ℝ) else 0 :=
      Finset.sum_congr rfl fun n hn => by simp only [hiff n hn]
    _ = 1 := by simp [hm]

theorem categorical_numerator_identity (p : ℕ) (h : Fin 40 → ℕ)
    (hinj : Function.Injective (fun j => (h j : ZMod p)))
    (S T : Finset (Fin 40)) (n : ℕ) :
    (∏ j ∈ S, (1 - (p : ℝ) * (if p ∣ n + h j then 1 else 0))) *
        (∏ j ∈ T, (1 - (p : ℝ) * (if p ∣ n + h j then 1 else 0))) =
      1 - (p : ℝ) * (∑ j ∈ S ∪ T, if p ∣ n + h j then 1 else 0) +
        (p : ℝ) * ((p : ℝ) - 1) *
          (∑ j ∈ S ∩ T, if p ∣ n + h j then 1 else 0) := by
  classical
  by_cases hex : ∃ j : Fin 40, p ∣ n + h j
  · obtain ⟨j, hj⟩ := hex
    have hiff (k : Fin 40) : p ∣ n + h k ↔ k = j :=
      ⟨fun hk => residue_hit_unique p h hinj n k j hk hj, fun hk => hk ▸ hj⟩
    simp_rw [hiff, mul_ite, mul_one, mul_zero, sub_ite, sub_zero]
    by_cases hs : j ∈ S <;> by_cases ht : j ∈ T <;> simp [hs, ht]
    ring
  · simp [not_exists.mp hex]

theorem auxiliaryCategoricalGram_eq (p : ℕ) (h : Fin 40 → ℕ) (i : Fin 40)
    (s t : Bool × Option (Fin 39)) (hp : p.Prime)
    (hinj : Function.Injective (fun j => (h j : ZMod p))) :
    let a : ℝ := (p : ℝ) - 1
    let S := auxiliaryPrimeState i s
    let T := auxiliaryPrimeState i t
    auxiliaryCategoricalGram p h i s t =
      (1 - ((S ∪ T).card : ℝ) + a * ((S ∩ T).card : ℝ)) /
        a ^ (S.card + T.card) := by
  classical
  let a : ℝ := (p : ℝ) - 1
  let S := auxiliaryPrimeState i s
  let T := auxiliaryPrimeState i t
  have hp0 : (p : ℝ) ≠ 0 := by exact_mod_cast hp.ne_zero
  have hp1 : (p : ℝ) ≠ 1 := by exact_mod_cast hp.ne_one
  have ha : a ≠ 0 := sub_ne_zero.mpr hp1
  have hterm (n : ℕ) :
      (∏ j ∈ S, selbergPrimePsi p h j n) *
          (∏ j ∈ T, selbergPrimePsi p h j n) =
        (1 - (p : ℝ) * (∑ j ∈ S ∪ T, if p ∣ n + h j then 1 else 0) +
          (p : ℝ) * a * (∑ j ∈ S ∩ T, if p ∣ n + h j then 1 else 0)) /
            a ^ (S.card + T.card) := by
    simp only [selbergPrimePsi, Finset.prod_div_distrib, Finset.prod_const,
      div_mul_div_comm, ← pow_add]
    exact congrArg (fun z : ℝ => z / a ^ (S.card + T.card))
      (categorical_numerator_identity p h hinj S T n)
  have hmass (R : Finset (Fin 40)) :
      (∑ n ∈ Finset.range p, ∑ j ∈ R, if p ∣ n + h j then (1 : ℝ) else 0) =
        (R.card : ℝ) := by
    rw [Finset.sum_comm]
    simp_rw [single_pole_count p _ hp.pos]
    simp
  change (1 / (p : ℝ)) * (∑ n ∈ Finset.range p,
      (∏ j ∈ S, selbergPrimePsi p h j n) * (∏ j ∈ T, selbergPrimePsi p h j n)) =
    (1 - ((S ∪ T).card : ℝ) + a * ((S ∩ T).card : ℝ)) / a ^ (S.card + T.card)
  simp_rw [hterm]
  rw [← Finset.sum_div, Finset.sum_add_distrib, Finset.sum_sub_distrib,
    ← Finset.mul_sum, ← Finset.mul_sum, hmass (S ∪ T), hmass (S ∩ T)]
  simp only [Finset.sum_const, Finset.card_range, nsmul_eq_mul, mul_one]
  field_simp [hp0, ha]

theorem selbergPrimePsi_pair (p : ℕ) (h : Fin 40 → ℕ) (hp : p.Prime)
    (hinj : Function.Injective (fun j => (h j : ZMod p)))
    (j k : Fin 40) (hjk : j ≠ k) (n : ℕ) :
    selbergPrimePsi p h j n * selbergPrimePsi p h k n =
      (selbergPrimePsi p h j n + selbergPrimePsi p h k n) / ((p : ℝ) - 1) -
        1 / ((p : ℝ) - 1) ^ 2 := by
  have hp1 : (p : ℝ) ≠ 1 := by exact_mod_cast hp.ne_one
  have ha : (p : ℝ) - 1 ≠ 0 := sub_ne_zero.mpr hp1
  have hnot : ¬ (p ∣ n + h j ∧ p ∣ n + h k) :=
    fun hh => hjk (residue_hit_unique p h hinj n j k hh.1 hh.2)
  unfold selbergPrimePsi
  by_cases hj : p ∣ n + h j <;> by_cases hk : p ∣ n + h k
  · exact (hnot ⟨hj, hk⟩).elim
  all_goals
    simp only [hj, hk, ↓reduceIte, mul_one, mul_zero, sub_zero]
    field_simp [ha]
    ring

theorem auxiliary_abs_div_four_le (a z : ℝ) (ha : 0 < a)
    (hz : |z| ≤ 2 * a ^ 2) : |z / a ^ 4| ≤ 2 / a ^ 2 := by
  rw [abs_div, abs_of_pos (pow_pos ha 4),
    div_le_div_iff₀ (pow_pos ha 4) (pow_pos ha 2)]
  nlinarith [mul_le_mul_of_nonneg_right hz (sq_nonneg a)]

theorem auxiliary_state_formula_error (p : ℕ) (hp : p.Prime)
    (i : Fin 40) (s t : Bool × Option (Fin 39)) :
    let a : ℝ := (p : ℝ) - 1
    let S := auxiliaryPrimeState i s
    let T := auxiliaryPrimeState i t
    |(1 - ((S ∪ T).card : ℝ) + a * ((S ∩ T).card : ℝ)) /
        a ^ (S.card + T.card) - (if s = t then 1 / a ^ S.card else 0)| ≤
      8 / (p : ℝ) ^ 2 := by
  classical
  let a : ℝ := (p : ℝ) - 1
  let S := auxiliaryPrimeState i s
  let T := auxiliaryPrimeState i t
  let e : ℝ := (1 - ((S ∪ T).card : ℝ) + a * ((S ∩ T).card : ℝ)) /
    a ^ (S.card + T.card) - (if s = t then 1 / a ^ S.card else 0)
  change |e| ≤ 8 / (p : ℝ) ^ 2
  have hpcast : (2 : ℝ) ≤ p := by exact_mod_cast hp.two_le
  have ha : 1 ≤ a := by dsimp [a]; linarith
  have hapos : 0 < a := lt_of_lt_of_le zero_lt_one ha
  have haa : a ≤ a ^ 2 := by
    nlinarith [mul_nonneg (sub_nonneg.mpr ha) hapos.le]
  have hcases :
      e = 0 / a ^ 4 ∨ e = -(a ^ 2) / a ^ 4 ∨
        e = (a ^ 2 - a) / a ^ 4 ∨ e = -(2 * a) / a ^ 4 ∨
        e = -((a - 1) ^ 2) / a ^ 4 ∨ e = (a - 2) / a ^ 4 := by
    rcases s with ⟨b, u⟩
    rcases t with ⟨c, v⟩
    dsimp [e, S, T]
    by_cases huv : u = v <;>
      cases b <;> cases c <;> cases u <;> cases v <;>
      simp_all only [Nat.ofNat_le_cast, auxiliaryPrimeState, Bool.false_eq_true, ↓reduceIte,
        Option.toFinset_none, map_empty, union_idempotent, card_empty, CharP.cast_eq_zero,
        sub_zero, inter_self, mul_zero, add_zero, pow_zero, ne_eq, eq_comm, zero_ne_one,
        not_false_eq_true, div_self, sub_self, zero_div, true_or, reduceCtorEq,
        Option.some.injEq, Option.toFinset_some, map_singleton, Fin.succAboveEmb_apply,
        empty_union, card_singleton, Nat.cast_one, mul_one, zero_add, Nat.reduceAdd, pow_one,
        one_div, union_empty, notMem_empty, inter_singleton_of_notMem, Prod.mk.injEq, and_true,
        singleton_union, union_insert, mem_singleton, Fin.ne_succAbove, card_insert_of_notMem,
        Nat.cast_ofNat, inter_insert_of_notMem, inter_empty, insert_union, mem_insert, or_true,
        inter_singleton_of_mem, not_true_eq_false, and_false, Fin.succAbove_inj, and_self,
        or_self, or_false, insert_eq_of_mem, inter_insert_of_mem, insert_empty_eq] <;>
      solve
      | left; field_simp [ne_of_gt hapos]; ring
      | right; left; field_simp [ne_of_gt hapos]; ring
      | right; right; left; field_simp [ne_of_gt hapos]; ring
      | right; right; right; left; field_simp [ne_of_gt hapos]; ring
      | right; right; right; right; left; field_simp [ne_of_gt hapos]; ring
      | right; right; right; right; right; field_simp [ne_of_gt hapos]; ring
  have hsmall : |e| ≤ 2 / a ^ 2 := by
    rcases hcases with h | h | h | h | h | h <;> rw [h] <;>
      apply auxiliary_abs_div_four_le a _ hapos <;>
      rw [abs_le] <;> constructor <;> nlinarith [sq_nonneg (a - 1)]
  refine hsmall.trans ?_
  have hp_eq : (p : ℝ) = a + 1 := by dsimp [a]; ring
  apply (div_le_div_iff₀ (pow_pos hapos 2) (sq_pos_of_pos (by linarith))).mpr
  rw [hp_eq]
  nlinarith [sq_nonneg (a - 1)]

open Classical in
theorem selberg40_auxiliary_local_gram
    {𝓗 : Finset ℕ} {h𝓗_card : 𝓗.card = 40}
    (x : ℝ) (i : Fin 40) (p : ℕ)
    (hp : p.Prime) (hpW : ¬ p ∣ presievingModulus 𝓗 x) :
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    let a : ℝ := (p : ℝ) - 1
    let A : Finset (Finset (Fin 40)) := Finset.univ.image (auxiliaryPrimeState i)
    let d : ℝ := ∑ s : Bool × Option (Fin 39),
      ∑ t : Bool × Option (Fin 39), auxiliaryIndependentGram p i s t
    Function.Injective (auxiliaryPrimeState i) ∧
      A = ({∅, {i}} : Finset (Finset (Fin 40))) ∪
        ((Finset.univ.erase i).image fun j => {j}) ∪
        ((Finset.univ.erase i).image fun j => {i, j}) ∧
      A.card = 80 ∧
      (∀ j : Fin 39, ∀ n : ℕ,
        selbergPrimePsi p h i n * selbergPrimePsi p h (i.succAbove j) n =
          (selbergPrimePsi p h i n + selbergPrimePsi p h (i.succAbove j) n) / a -
            1 / a ^ 2) ∧
      (∀ s t : Bool × Option (Fin 39),
        let S := auxiliaryPrimeState i s
        let T := auxiliaryPrimeState i t
        auxiliaryCategoricalGram p h i s t =
            (1 - ((S ∪ T).card : ℝ) + a * ((S ∩ T).card : ℝ)) /
              a ^ (S.card + T.card) ∧
          auxiliaryIndependentGram p i s t =
            (if s = t then 1 / a ^ S.card else 0) ∧
          |auxiliaryCategoricalGram p h i s t -
            auxiliaryIndependentGram p i s t| ≤ 8 / (p : ℝ) ^ 2) ∧
      (∑ s : Bool × Option (Fin 39), ∑ t : Bool × Option (Fin 39),
        |auxiliaryCategoricalGram p h i s t -
          auxiliaryIndependentGram p i s t|) ≤ 51200 / (p : ℝ) ^ 2 ∧
      d = (1 + 39 / a) * (1 + 1 / a) ∧
      1 ≤ d ∧ d ≤ (1 + 1 / a) ^ 40 := by
  dsimp only
  let h : Fin 40 → ℕ :=
    𝓗.orderEmbOfFin h𝓗_card
  have hres : Function.Injective (fun j => (h j : ZMod p)) :=
    physical_residues_injective (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) x p hp hpW
  have hD := fun s t => auxiliaryIndependentGram_eq p i s t hp
    (auxiliaryPrimeState_injective i)
  have hK := fun s t => auxiliaryCategoricalGram_eq p h i s t hp hres
  have herr (s t : Bool × Option (Fin 39)) :
      |auxiliaryCategoricalGram p h i s t - auxiliaryIndependentGram p i s t| ≤
        8 / (p : ℝ) ^ 2 := by
    rw [hK s t, hD s t]
    exact auxiliary_state_formula_error p hp i s t
  refine ⟨auxiliaryPrimeState_injective i, auxiliaryPrimeState_image i,
    auxiliaryPrimeState_card_states i, ?_, ?_, ?_,
    auxiliaryIndependentGram_mass p i hp hD⟩
  · intro j n
    exact selbergPrimePsi_pair p h hp hres i (i.succAbove j) (Fin.ne_succAbove i j) n
  · intro s t
    exact ⟨hK s t, hD s t, herr s t⟩
  · calc
      _ ≤ ∑ s : Bool × Option (Fin 39), ∑ t : Bool × Option (Fin 39),
          (8 / (p : ℝ) ^ 2) :=
        Finset.sum_le_sum fun s _ => Finset.sum_le_sum fun t _ => herr s t
      _ = 51200 / (p : ℝ) ^ 2 := by
        simp only [Finset.sum_const, Finset.card_univ, Fintype.card_prod,
          Fintype.card_bool, Fintype.card_option, Fintype.card_fin, nsmul_eq_mul]
        ring

/-!
## Selberg coefficients and quadratic moments
-/

/-- The normalized input in Equation (3.2) of the main paper is `Y(r) = y_r / B_R^m`.
For a nonzero divisor sum, squarefree product support gives Moebius multiplicativity.
The scalar and product identities below make this normalization explicit. -/
noncomputable def selbergCoefficient
    {ι : Type*} [Fintype ι] (y : (ι → ℕ) →₀ ℝ) (d : ι → ℕ) : ℝ := by
  classical
  exact (ArithmeticFunction.moebius (∏ i, d i) : ℝ) *
    (∏ i, (d i : ℝ)) *
    y.sum (fun r yr =>
      if ∀ i, d i ∣ r i then yr / (∏ i, ((r i).totient : ℝ)) else 0)

theorem coprime_of_squarefree_fintype_prod
    {ι : Type*} [Fintype ι] (d : ι → ℕ)
    (hd : Squarefree (∏ i, d i)) {i j : ι} (hij : i ≠ j) :
    Nat.Coprime (d i) (d j) := by
  classical
  apply Nat.coprime_of_squarefree_mul
  apply hd.squarefree_of_dvd
  simpa [Finset.prod_pair hij] using
    Finset.prod_dvd_prod_of_subset ({i, j} : Finset ι) Finset.univ d (by simp)

theorem selbergCoefficient_eq_prod
    {ι : Type*} [Fintype ι] (y : (ι → ℕ) →₀ ℝ)
    (hy : ∀ r ∈ y.support, Squarefree (∏ i, r i)) (d : ι → ℕ) :
    selbergCoefficient y d =
      (∏ i, (ArithmeticFunction.moebius (d i) : ℝ) * (d i : ℝ)) *
        y.sum (fun r yr =>
          if ∀ i, d i ∣ r i then yr / (∏ i, ((r i).totient : ℝ)) else 0) := by
  classical
  rw [selbergCoefficient, Finsupp.mul_sum, Finsupp.mul_sum]
  apply Finsupp.sum_congr
  intro r hr
  by_cases hdr : ∀ i, d i ∣ r i
  · have hd : Squarefree (∏ i, d i) :=
      (hy r hr).squarefree_of_dvd (Finset.prod_dvd_prod_of_dvd d r (fun i _ => hdr i))
    have hmu : (ArithmeticFunction.moebius (∏ i, d i) : ℝ) =
        ∏ i, (ArithmeticFunction.moebius (d i) : ℝ) := by
      exact_mod_cast ArithmeticFunction.IsMultiplicative.map_prod d
        ArithmeticFunction.isMultiplicative_moebius Finset.univ
        (fun i _ j _ hij => coprime_of_squarefree_fintype_prod d hd hij)
    simp only [ite_eq_left hdr, hmu, Finset.prod_mul_distrib]
  · simp only [ite_eq_right hdr, mul_zero]

theorem auxiliary_prime_selection_mem (P : Finset ℕ)
    (hP : ∀ p ∈ P, p.Prime) (b : P → Bool) :
    (∏ p : P, if b p then (p : ℕ) else 1) ∈ (∏ p ∈ P, p).divisors := by
  classical
  refine Nat.mem_divisors.mpr ⟨?_, (squarefree_prime_prod P hP).ne_zero⟩
  rw [← Finset.prod_coe_sort P (fun p : ℕ => p)]
  apply Finset.prod_dvd_prod_of_dvd
  intro p _
  split_ifs <;> simp

theorem auxiliary_prime_selection_dvd_iff (P : Finset ℕ)
    (hP : ∀ p ∈ P, p.Prime) (b : P → Bool) (p : P) :
    (p : ℕ) ∣ (∏ a : P, if b a then (a : ℕ) else 1) ↔ b p = true := by
  classical
  rw [(hP p.val p.property).prime.dvd_finsetProd_iff]
  constructor
  · rintro ⟨a, _, ha⟩
    by_cases hb : b a = true
    · rw [ite_eq_left hb] at ha
      have hap : a = p := Subtype.ext
        (((hP a.val a.property).dvd_iff_eq (hP p.val p.property).ne_one).mp ha)
      simpa only [hap] using hb
    · rw [ite_eq_right hb] at ha
      exact False.elim ((hP p.val p.property).ne_one (Nat.dvd_one.mp ha))
  · intro hp
    refine ⟨p, Finset.mem_univ p, ?_⟩
    simp only [hp, ite_true, dvd_refl]

theorem auxiliary_prime_selection_recover (P : Finset ℕ)
    (hP : ∀ p ∈ P, p.Prime) (r : ℕ) (hr : r ∈ (∏ p ∈ P, p).divisors) :
    (∏ p : P, if decide ((p : ℕ) ∣ r) then (p : ℕ) else 1) = r := by
  classical
  have hq := (squarefree_prime_prod P hP).ne_zero
  calc
    _ = ∏ p ∈ P.filter (fun p => p ∣ r), p := by
      simp only [Finset.prod_filter, decide_eq_true_eq]
      exact Finset.prod_coe_sort P (fun p : ℕ => if p ∣ r then p else 1)
    _ = ∏ p ∈ r.primeFactors, p := by
      rw [← Nat.primeFactors_prod hP,
        Nat.primeFactors_filter_dvd_of_dvd hq (Nat.mem_divisors.mp hr).1]
    _ = r := Nat.prod_primeFactors_of_squarefree
      ((squarefree_prime_prod P hP).squarefree_of_dvd (Nat.mem_divisors.mp hr).1)

theorem auxiliary_root_valid (P : Finset ℕ) (hP : ∀ p ∈ P, p.Prime)
    (σ : P → Bool × Option (Fin 39)) :
    let q : ℕ := ∏ p ∈ P, p
    let rootA : Fin 1 → ℕ := fun _ => ∏ p : P, if (σ p).1 then (p : ℕ) else 1
    let rootR : Fin 39 → ℕ :=
      fun j => ∏ p : P, if (σ p).2 = some j then (p : ℕ) else 1
    rootA 0 ∈ q.divisors ∧ Squarefree (∏ j, rootR j) ∧
      ∀ j, rootR j ∈ q.divisors := by
  classical
  dsimp only
  refine ⟨auxiliary_prime_selection_mem P hP (fun p => (σ p).1), ?_, ?_⟩
  · have hprod :
        (∏ j : Fin 39, ∏ p : P, if (σ p).2 = some j then (p : ℕ) else 1) =
          ∏ p : P, if (σ p).2.isSome then (p : ℕ) else 1 := by
      rw [Finset.prod_comm]
      apply Finset.prod_congr rfl
      intro p _
      cases (σ p).2 <;> simp
    rw [hprod]
    exact (squarefree_prime_prod P hP).squarefree_of_dvd
      (Nat.mem_divisors.mp
        (auxiliary_prime_selection_mem P hP (fun p => (σ p).2.isSome))).1
  · intro j
    simpa only [decide_eq_true_eq] using
      auxiliary_prime_selection_mem P hP (fun p => decide ((σ p).2 = some j))

theorem auxiliary_root_injective (P : Finset ℕ) (hP : ∀ p ∈ P, p.Prime) :
    let rootA : (P → Bool × Option (Fin 39)) → (Fin 1 → ℕ) :=
      fun σ _ => ∏ p : P, if (σ p).1 then (p : ℕ) else 1
    let rootR : (P → Bool × Option (Fin 39)) → (Fin 39 → ℕ) :=
      fun σ j => ∏ p : P, if (σ p).2 = some j then (p : ℕ) else 1
    Function.Injective (fun σ => (rootA σ, rootR σ)) := by
  classical
  intro rootA rootR σ τ hστ
  have hA : rootA σ = rootA τ := congrArg Prod.fst hστ
  have hR : rootR σ = rootR τ := congrArg Prod.snd hστ
  have hRiff (ω : P → Bool × Option (Fin 39)) (p : P) (j : Fin 39) :
      (p : ℕ) ∣ rootR ω j ↔ (ω p).2 = some j := by
    simpa only [rootR, decide_eq_true_eq] using
      auxiliary_prime_selection_dvd_iff P hP
        (fun a => decide ((ω a).2 = some j)) p
  funext p
  apply Prod.ext
  · apply Bool.eq_iff_iff.mpr
    rw [← auxiliary_prime_selection_dvd_iff P hP (fun a => (σ a).1) p,
      ← auxiliary_prime_selection_dvd_iff P hP (fun a => (τ a).1) p]
    change (p : ℕ) ∣ rootA σ 0 ↔ (p : ℕ) ∣ rootA τ 0
    rw [hA]
  · apply Option.ext
    intro j
    rw [← hRiff σ p j, ← hRiff τ p j, hR]

theorem auxiliary_root_configuration (P : Finset ℕ)
    (hP : ∀ p ∈ P, p.Prime) :
    let q : ℕ := ∏ p ∈ P, p
    let rootA : (P → Bool × Option (Fin 39)) → (Fin 1 → ℕ) :=
      fun σ _ => ∏ p : P, if (σ p).1 then (p : ℕ) else 1
    let rootR : (P → Bool × Option (Fin 39)) → (Fin 39 → ℕ) :=
      fun σ j => ∏ p : P, if (σ p).2 = some j then (p : ℕ) else 1
    ∀ (s : Fin 1 → ℕ) (r : Fin 39 → ℕ),
      (s 0 ∈ q.divisors ∧ Squarefree (∏ j, r j) ∧ ∀ j, r j ∈ q.divisors) ↔
        ∃! σ : P → Bool × Option (Fin 39), rootA σ = s ∧ rootR σ = r := by
  classical
  intro q rootA rootR s r
  constructor
  · rintro ⟨hs, hsq, hr⟩
    have howner_unique (p : P) (j k : Fin 39)
        (hj : (p : ℕ) ∣ r j) (hk : (p : ℕ) ∣ r k) : j = k := by
      by_contra hjk
      exact (hP p.val p.property).ne_one
        (Nat.eq_one_of_dvd_coprimes
          (coprime_of_squarefree_fintype_prod r hsq hjk) hj hk)
    let owner (p : P) : Option (Fin 39) :=
      if H : ∃ j, (p : ℕ) ∣ r j then some H.choose else none
    have howner (p : P) (j : Fin 39) : owner p = some j ↔ (p : ℕ) ∣ r j := by
      dsimp only [owner]
      split_ifs with H
      · constructor
        · intro heq
          have hj : H.choose = j := Option.some.inj heq
          exact hj ▸ H.choose_spec
        · intro hj
          exact congrArg some (howner_unique p H.choose j H.choose_spec hj)
      · constructor
        · intro heq
          cases heq
        · intro hj
          exact False.elim (H ⟨j, hj⟩)
    let σ (p : P) : Bool × Option (Fin 39) := (decide ((p : ℕ) ∣ s 0), owner p)
    have hA : rootA σ = s := by
      funext j
      have hj : j = 0 := Subsingleton.elim _ _
      subst j
      exact auxiliary_prime_selection_recover P hP (s 0) hs
    have hR : rootR σ = r := by
      funext j
      simpa only [rootR, σ, howner, decide_eq_true_eq] using
        auxiliary_prime_selection_recover P hP (r j) (hr j)
    refine ⟨σ, ⟨hA, hR⟩, ?_⟩
    intro τ hτ
    apply auxiliary_root_injective P hP
    exact Prod.ext (hτ.1.trans hA.symm) (hτ.2.trans hR.symm)
  · rintro ⟨σ, ⟨hA, hR⟩, _⟩
    have hv := auxiliary_root_valid P hP σ
    change rootA σ 0 ∈ q.divisors ∧ Squarefree (∏ j, rootR σ j) ∧
      (∀ j, rootR σ j ∈ q.divisors) at hv
    rw [hA, hR] at hv
    exact hv

theorem auxiliary_root_sum {M : Type*} [AddCommMonoid M]
    (P : Finset ℕ) (hP : ∀ p ∈ P, p.Prime)
    (f : (Fin 1 → ℕ) → (Fin 39 → ℕ) → M) :
    let q : ℕ := ∏ p ∈ P, p
    let rootA : (P → Bool × Option (Fin 39)) → (Fin 1 → ℕ) :=
      fun σ _ => ∏ p : P, if (σ p).1 then (p : ℕ) else 1
    let rootR : (P → Bool × Option (Fin 39)) → (Fin 39 → ℕ) :=
      fun σ j => ∏ p : P, if (σ p).2 = some j then (p : ℕ) else 1
    (∑ σ : P → Bool × Option (Fin 39), f (rootA σ) (rootR σ)) =
      ∑ s ∈ Fintype.piFinset (fun _ : Fin 1 => q.divisors),
        ∑ r ∈ (Fintype.piFinset (fun _ : Fin 39 => q.divisors)).filter
          (fun r => Squarefree (∏ j, r j)), f s r := by
  classical
  intro q rootA rootR
  let SA := Fintype.piFinset (fun _ : Fin 1 => q.divisors)
  let SR := (Fintype.piFinset (fun _ : Fin 39 => q.divisors)).filter
    (fun r => Squarefree (∏ j, r j))
  have hmem (s : Fin 1 → ℕ) (r : Fin 39 → ℕ) :
      (s, r) ∈ SA ×ˢ SR ↔
        s 0 ∈ q.divisors ∧ Squarefree (∏ j, r j) ∧ ∀ j, r j ∈ q.divisors := by
    simp only [SA, SR, Finset.mem_product, Fintype.mem_piFinset, Finset.mem_filter,
      Fin.forall_fin_one, and_left_comm, and_comm]
  calc
    _ = ∑ sr ∈ SA ×ˢ SR, f sr.1 sr.2 := by
      refine Finset.sum_bij (fun σ _ => (rootA σ, rootR σ)) ?_ ?_ ?_ ?_
      · intro σ _
        exact (hmem _ _).mpr (auxiliary_root_valid P hP σ)
      · intro σ _ τ _ hστ
        exact auxiliary_root_injective P hP hστ
      · rintro ⟨s, r⟩ hsr
        obtain ⟨σ, hσ, _⟩ :=
          (auxiliary_root_configuration P hP s r).mp ((hmem s r).mp hsr)
        exact ⟨σ, Finset.mem_univ _, Prod.ext hσ.1 hσ.2⟩
      · intro σ _
        rfl
    _ = _ := Finset.sum_product SA SR (fun sr => f sr.1 sr.2)

theorem totient_eq_primeFactors_prod (n : ℕ) (hn : Squarefree n) :
    (n.totient : ℝ) = ∏ p ∈ n.primeFactors, ((p : ℝ) - 1) := by
  have hnat : n.totient = ∏ p ∈ n.primeFactors, (p - 1) := by
    apply mul_right_cancel₀ hn.ne_zero
    simpa only [Nat.prod_primeFactors_of_squarefree hn, mul_comm] using
      Nat.totient_mul_prod_primeFactors n
  rw [hnat, Nat.cast_prod]
  apply Finset.prod_congr rfl
  intro p hp
  rw [Nat.cast_sub (Nat.one_le_iff_ne_zero.mpr
    (Nat.prime_of_mem_primeFactors hp).ne_zero), Nat.cast_one]

theorem selberg_scalar_pointwise_expansion (r t : ℕ) (hr : Squarefree r) :
    (∑ d ∈ r.divisors,
      if d ∣ t then (ArithmeticFunction.moebius d : ℝ) * (d : ℝ) else 0) /
        (r.totient : ℝ) =
      ∏ p ∈ r.primeFactors,
        (1 - (p : ℝ) * (if p ∣ t then 1 else 0)) / ((p : ℝ) - 1) := by
  classical
  let f : ArithmeticFunction ℝ :=
    ⟨fun d => if d ∣ t then (d : ℝ) else 0, by simp⟩
  have hf : f.IsMultiplicative := by
    refine ⟨?_, ?_⟩
    · simp [f]
    · intro m n hmn
      change (if m * n ∣ t then ((m * n : ℕ) : ℝ) else 0) =
        (if m ∣ t then (m : ℝ) else 0) * (if n ∣ t then (n : ℝ) else 0)
      have hdiv : m * n ∣ t ↔ m ∣ t ∧ n ∣ t :=
        ⟨fun h => ⟨dvd_trans (dvd_mul_right m n) h,
          dvd_trans (dvd_mul_left n m) h⟩,
          fun h => hmn.mul_dvd_of_dvd_of_dvd h.1 h.2⟩
      by_cases hm : m ∣ t <;> by_cases hn : n ∣ t <;>
        simp [hdiv, hm, hn, Nat.cast_mul]
  rw [Finset.prod_div_distrib, totient_eq_primeFactors_prod r hr]
  congr 1
  calc
    (∑ d ∈ r.divisors,
        if d ∣ t then (ArithmeticFunction.moebius d : ℝ) * (d : ℝ) else 0) =
        ∑ d ∈ r.divisors, (ArithmeticFunction.moebius d : ℝ) * f d := by
      simp [f, mul_ite]
    _ = ∏ p ∈ r.primeFactors, (1 - f p) :=
      (ArithmeticFunction.IsMultiplicative.prodPrimeFactors_one_sub_of_squarefree
        f hf hr).symm
    _ = ∏ p ∈ r.primeFactors, (1 - (p : ℝ) * (if p ∣ t then 1 else 0)) := by
      simp [f, mul_ite]

theorem selberg_pointwise_expansion
    {ι : Type*} [Fintype ι] [DecidableEq ι] (y : (ι → ℕ) →₀ ℝ) (t : ι → ℕ)
    (hy : ∀ r ∈ y.support, Squarefree (∏ j, r j)) :
    let D := y.support.biUnion
      (fun r => Fintype.piFinset (fun j => (r j).divisors))
    (∑ d ∈ D, if ∀ j, d j ∣ t j then selbergCoefficient y d else 0) =
      ∑ r ∈ y.support, y r * ∏ j, ∏ p ∈ (r j).primeFactors,
        (1 - (p : ℝ) * (if p ∣ t j then 1 else 0)) / ((p : ℝ) - 1) := by
  classical
  intro D
  have hmuProd (d : ι → ℕ) (hd : Squarefree (∏ j, d j)) :
      (ArithmeticFunction.moebius (∏ j, d j) : ℝ) =
        ∏ j, (ArithmeticFunction.moebius (d j) : ℝ) := by
    exact_mod_cast ArithmeticFunction.IsMultiplicative.map_prod d
      ArithmeticFunction.isMultiplicative_moebius Finset.univ
      (fun i _ j _ hij => coprime_of_squarefree_fintype_prod d hd hij)
  have hbox (r : ι → ℕ) (hr : Squarefree (∏ j, r j)) :
      (∑ d ∈ Fintype.piFinset (fun j => (r j).divisors),
        if ∀ j, d j ∣ t j then
          (ArithmeticFunction.moebius (∏ j, d j) : ℝ) * ∏ j, (d j : ℝ) else 0) /
          (∏ j, ((r j).totient : ℝ)) =
        ∏ j, ∏ p ∈ (r j).primeFactors,
          (1 - (p : ℝ) * (if p ∣ t j then 1 else 0)) / ((p : ℝ) - 1) := by
    calc
      _ = (∏ j, ∑ d ∈ (r j).divisors,
          if d ∣ t j then (ArithmeticFunction.moebius d : ℝ) * (d : ℝ) else 0) /
            (∏ j, ((r j).totient : ℝ)) := by
        congr 1
        calc
          _ = ∑ d ∈ Fintype.piFinset (fun j => (r j).divisors),
              ∏ j, if d j ∣ t j then
                (ArithmeticFunction.moebius (d j) : ℝ) * (d j : ℝ) else 0 := by
            apply Finset.sum_congr rfl
            intro d hd
            have hdr : ∀ j, d j ∣ r j := fun j =>
              Nat.dvd_of_mem_divisors (Fintype.mem_piFinset.mp hd j)
            rw [hmuProd d (hr.squarefree_of_dvd (Finset.prod_dvd_prod_of_dvd d r
              (fun j _ => hdr j))), Fintype.prod_ite_zero, Finset.prod_mul_distrib]
          _ = _ := (Finset.prod_univ_sum (fun j => (r j).divisors)
            (fun j d => if d ∣ t j then
              (ArithmeticFunction.moebius d : ℝ) * (d : ℝ) else 0)).symm
      _ = ∏ j, (∑ d ∈ (r j).divisors,
          if d ∣ t j then (ArithmeticFunction.moebius d : ℝ) * (d : ℝ) else 0) /
            ((r j).totient : ℝ) := by rw [Finset.prod_div_distrib]
      _ = _ := by
        apply Finset.prod_congr rfl
        intro j _
        exact selberg_scalar_pointwise_expansion (r j) (t j)
          (hr.squarefree_of_dvd (Finset.dvd_prod_of_mem r (Finset.mem_univ j)))
  calc
    _ = ∑ d ∈ D, ∑ r ∈ y.support,
        (if (∀ j, d j ∣ t j) ∧ (∀ j, d j ∣ r j) then
          (ArithmeticFunction.moebius (∏ j, d j) : ℝ) * ∏ j, (d j : ℝ) else 0) *
            (y r / (∏ j, ((r j).totient : ℝ))) := by
      apply Finset.sum_congr rfl
      intro d _
      rw [selbergCoefficient, Finsupp.sum]
      by_cases hdt : ∀ j, d j ∣ t j
      · simp [hdt, Finset.mul_sum, mul_ite, ite_mul]
      · simp [hdt]
    _ = ∑ r ∈ y.support, ∑ d ∈ D,
        (if (∀ j, d j ∣ t j) ∧ (∀ j, d j ∣ r j) then
          (ArithmeticFunction.moebius (∏ j, d j) : ℝ) * ∏ j, (d j : ℝ) else 0) *
            (y r / (∏ j, ((r j).totient : ℝ))) := Finset.sum_comm
    _ = ∑ r ∈ y.support, y r *
        ((∑ d ∈ Fintype.piFinset (fun j => (r j).divisors),
          if ∀ j, d j ∣ t j then
            (ArithmeticFunction.moebius (∏ j, d j) : ℝ) * ∏ j, (d j : ℝ) else 0) /
              (∏ j, ((r j).totient : ℝ))) := by
      apply Finset.sum_congr rfl
      intro r hr
      rw [← Finset.sum_mul]
      have hset : D.filter (fun d => ∀ j, d j ∣ r j) =
          Fintype.piFinset (fun j => (r j).divisors) := by
        ext d
        simp only [Finset.mem_filter, Fintype.mem_piFinset, Nat.mem_divisors]
        constructor
        · rintro ⟨_, hdr⟩ j
          exact ⟨hdr j, ((hy r hr).squarefree_of_dvd
            (Finset.dvd_prod_of_mem r (Finset.mem_univ j))).ne_zero⟩
        · intro hdr
          refine ⟨Finset.mem_biUnion.mpr ⟨r, hr, ?_⟩, fun j => (hdr j).1⟩
          exact Fintype.mem_piFinset.mpr fun j => Nat.mem_divisors.mpr (hdr j)
      have hrestrict :
          (∑ d ∈ D, if (∀ j, d j ∣ t j) ∧ (∀ j, d j ∣ r j) then
            (ArithmeticFunction.moebius (∏ j, d j) : ℝ) * ∏ j, (d j : ℝ) else 0) =
          ∑ d ∈ Fintype.piFinset (fun j => (r j).divisors),
            if ∀ j, d j ∣ t j then
              (ArithmeticFunction.moebius (∏ j, d j) : ℝ) * ∏ j, (d j : ℝ) else 0 := by
        rw [← hset, Finset.sum_filter]
        simp only [← ite_and, and_comm]
      rw [hrestrict]
      ring
    _ = _ := by
      apply Finset.sum_congr rfl
      intro r hr
      rw [hbox r (hy r hr)]

theorem auxiliary_prime_selection_product (P : Finset ℕ)
    (hP : ∀ p ∈ P, p.Prime) (b : P → Bool) (f : ℕ → ℝ) :
    (∏ r ∈ (∏ p : P, if b p then (p : ℕ) else 1).primeFactors, f r) =
      ∏ p : P, if b p then f (p : ℕ) else 1 := by
  classical
  let n : ℕ := ∏ p : P, if b p then (p : ℕ) else 1
  have hn := Nat.mem_divisors.mp (auxiliary_prime_selection_mem P hP b)
  have hfilter := Nat.primeFactors_filter_dvd_of_dvd
    (squarefree_prime_prod P hP).ne_zero hn.1
  rw [Nat.primeFactors_prod hP] at hfilter
  change (∏ r ∈ n.primeFactors, f r) = _
  calc
    _ = ∏ r ∈ P, if r ∣ n then f r else 1 := by
      rw [← hfilter, Finset.prod_filter]
    _ = ∏ p : P, if b p then f (p : ℕ) else 1 := by
      rw [← Finset.prod_coe_sort P (fun r : ℕ => if r ∣ n then f r else 1)]
      apply Finset.prod_congr rfl
      intro p _
      change (if (p : ℕ) ∣ (∏ a : P, if b a then (a : ℕ) else 1)
        then f (p : ℕ) else 1) = _
      simp only [auxiliary_prime_selection_dvd_iff P hP b p]

theorem auxiliary_root_totient (P : Finset ℕ) (hP : ∀ p ∈ P, p.Prime)
    (i : Fin 40) (σ : P → Bool × Option (Fin 39)) :
    let rootA : Fin 1 → ℕ := fun _ => ∏ p : P, if (σ p).1 then (p : ℕ) else 1
    let rootR : Fin 39 → ℕ :=
      fun j => ∏ p : P, if (σ p).2 = some j then (p : ℕ) else 1
    ((rootA 0).totient : ℝ) * (∏ j, ((rootR j).totient : ℝ)) =
      ∏ p : P, ((p : ℝ) - 1) ^ (auxiliaryPrimeState i (σ p)).card := by
  classical
  dsimp only
  have hphi (b : P → Bool) :
      ((∏ p : P, if b p then (p : ℕ) else 1).totient : ℝ) =
        ∏ p : P, if b p then (p : ℝ) - 1 else 1 := by
    have hn := (squarefree_prime_prod P hP).squarefree_of_dvd
      (Nat.mem_divisors.mp (auxiliary_prime_selection_mem P hP b)).1
    rw [totient_eq_primeFactors_prod _ hn]
    exact auxiliary_prime_selection_product P hP b (fun p => (p : ℝ) - 1)
  have hR (j : Fin 39) :
      ((∏ p : P, if (σ p).2 = some j then (p : ℕ) else 1).totient : ℝ) =
        ∏ p : P, if (σ p).2 = some j then (p : ℝ) - 1 else 1 := by
    simpa only [decide_eq_true_eq] using hphi (fun p => decide ((σ p).2 = some j))
  rw [hphi (fun p => (σ p).1)]
  simp_rw [hR]
  rw [Finset.prod_comm, ← Finset.prod_mul_distrib]
  apply Finset.prod_congr rfl
  intro p _
  rcases σ p with ⟨b, o⟩
  cases b <;> cases o <;> simp [auxiliaryPrimeState, pow_two]

theorem auxiliary_independent_tensor (P : Finset ℕ)
    (hP : ∀ p ∈ P, p.Prime) (i : Fin 40)
    (amplitude : (P → Bool × Option (Fin 39)) → ℝ) :
    let rootA : (P → Bool × Option (Fin 39)) → (Fin 1 → ℕ) :=
      fun σ _ => ∏ p : P, if (σ p).1 then (p : ℕ) else 1
    let rootR : (P → Bool × Option (Fin 39)) → (Fin 39 → ℕ) :=
      fun σ j => ∏ p : P, if (σ p).2 = some j then (p : ℕ) else 1
    (∑ σ : P → Bool × Option (Fin 39), ∑ τ : P → Bool × Option (Fin 39),
      amplitude σ * amplitude τ *
        ∏ p : P, auxiliaryIndependentGram (p : ℕ) i (σ p) (τ p)) =
      ∑ σ : P → Bool × Option (Fin 39),
        amplitude σ ^ 2 /
          (((rootA σ 0).totient : ℝ) * ∏ j, ((rootR σ j).totient : ℝ)) := by
  classical
  intro rootA rootR
  let Φ (σ : P → Bool × Option (Fin 39)) : ℝ :=
    ((rootA σ 0).totient : ℝ) * ∏ j, ((rootR σ j).totient : ℝ)
  have hprod (σ τ : P → Bool × Option (Fin 39)) :
      (∏ p : P, auxiliaryIndependentGram (p : ℕ) i (σ p) (τ p)) =
        if σ = τ then 1 / Φ σ else 0 := by
    have hlocal (p : P) := auxiliaryIndependentGram_eq (p : ℕ) i (σ p) (τ p)
      (hP p.val p.property) (auxiliaryPrimeState_injective i)
    simp only [hlocal, Fintype.prod_ite_zero, ← funext_iff]
    congr 1
    rw [show Φ σ = ∏ p : P, ((p : ℝ) - 1) ^ (auxiliaryPrimeState i (σ p)).card from
      auxiliary_root_totient P hP i σ]
    simp only [one_div, Finset.prod_inv_distrib]
  simp_rw [hprod, mul_ite, mul_zero]
  simp only [Finset.sum_ite_eq, Finset.mem_univ, ite_true]
  simp only [Φ, pow_two, div_eq_mul_inv, one_mul]

theorem auxiliary_independent_harmonic (P : Finset ℕ)
    (hP : ∀ p ∈ P, p.Prime) (i : Fin 40)
    (u : (Fin 1 → ℕ) →₀ ℝ) (z : (Fin 39 → ℕ) →₀ ℝ)
    (hu : ∀ s ∈ u.support, s 0 ∈ (∏ p ∈ P, p).divisors)
    (hz : ∀ r ∈ z.support, Squarefree (∏ j, r j) ∧
      ∀ j, r j ∈ (∏ p ∈ P, p).divisors) :
    let rootA : (P → Bool × Option (Fin 39)) → (Fin 1 → ℕ) :=
      fun σ _ => ∏ p : P, if (σ p).1 then (p : ℕ) else 1
    let rootR : (P → Bool × Option (Fin 39)) → (Fin 39 → ℕ) :=
      fun σ j => ∏ p : P, if (σ p).2 = some j then (p : ℕ) else 1
    (∑ σ : P → Bool × Option (Fin 39), ∑ τ : P → Bool × Option (Fin 39),
      (u (rootA σ) * z (rootR σ)) * (u (rootA τ) * z (rootR τ)) *
        ∏ p : P, auxiliaryIndependentGram (p : ℕ) i (σ p) (τ p)) =
      u.sum (fun s us => us ^ 2 / ((s 0).totient : ℝ)) *
        z.sum (fun r zr => zr ^ 2 / (∏ j, ((r j).totient : ℝ))) := by
  classical
  intro rootA rootR
  let q : ℕ := ∏ p ∈ P, p
  let SA := Fintype.piFinset (fun _ : Fin 1 => q.divisors)
  let SR := (Fintype.piFinset (fun _ : Fin 39 => q.divisors)).filter
    (fun r => Squarefree (∏ j, r j))
  have hSA : u.support ⊆ SA := by
    intro s hs
    simpa only [SA, Fintype.mem_piFinset, Fin.forall_fin_one] using hu s hs
  have hSR : z.support ⊆ SR := by
    intro r hr
    exact Finset.mem_filter.mpr ⟨Fintype.mem_piFinset.mpr (hz r hr).2, (hz r hr).1⟩
  have huSum :
      (∑ s ∈ SA, u s ^ 2 / ((s 0).totient : ℝ)) =
        u.sum (fun s us => us ^ 2 / ((s 0).totient : ℝ)) :=
    (Finsupp.sum_of_support_subset u hSA
      (fun s us => us ^ 2 / ((s 0).totient : ℝ)) (fun _ _ => by simp)).symm
  have hzSum :
      (∑ r ∈ SR, z r ^ 2 / (∏ j, ((r j).totient : ℝ))) =
        z.sum (fun r zr => zr ^ 2 / (∏ j, ((r j).totient : ℝ))) :=
    (Finsupp.sum_of_support_subset z hSR
      (fun r zr => zr ^ 2 / (∏ j, ((r j).totient : ℝ))) (fun _ _ => by simp)).symm
  rw [auxiliary_independent_tensor P hP i]
  calc
    _ = ∑ s ∈ SA, ∑ r ∈ SR,
        (u s * z r) ^ 2 /
          (((s 0).totient : ℝ) * ∏ j, ((r j).totient : ℝ)) :=
      auxiliary_root_sum P hP (fun s r =>
        (u s * z r) ^ 2 / (((s 0).totient : ℝ) * ∏ j, ((r j).totient : ℝ)))
    _ = (∑ s ∈ SA, u s ^ 2 / ((s 0).totient : ℝ)) *
        (∑ r ∈ SR, z r ^ 2 / (∏ j, ((r j).totient : ℝ))) := by
      simp only [mul_pow, div_mul_div_comm, Finset.sum_mul_sum]
    _ = _ := by rw [huSum, hzSum]

theorem sum_range_eq_sum_zmod (q : ℕ) [NeZero q] (f : ZMod q → ℝ) :
    (∑ n ∈ Finset.range q, f (n : ZMod q)) = ∑ n : ZMod q, f n := by
  cases q with
  | zero => exact (NeZero.ne 0 rfl).elim
  | succ q =>
    rw [← Fin.sum_univ_eq_sum_range]
    change (∑ n : ZMod (q + 1), f (n.val : ZMod (q + 1))) = _
    simp only [ZMod.natCast_zmod_val]

theorem prime_product_average (P : Finset ℕ)
    (hP : ∀ p ∈ P, p.Prime) (f : ∀ p : P, ZMod (p : ℕ) → ℝ) :
    let q : ℕ := ∏ p ∈ P, p
    (1 / (q : ℝ)) * ∑ n ∈ Finset.range q, ∏ p : P, f p (n : ZMod (p : ℕ)) =
      ∏ p : P, (1 / ((p : ℕ) : ℝ)) *
        ∑ n ∈ Finset.range (p : ℕ), f p (n : ZMod (p : ℕ)) := by
  classical
  dsimp only
  let q : ℕ := ∏ p : P, (p : ℕ)
  have hq_eq : q = ∏ p ∈ P, p := by
    dsimp only [q]
    exact Finset.prod_coe_sort P (fun p : ℕ => p)
  rw [← hq_eq]
  have hp_pos (p : P) : 0 < (p : ℕ) := (hP p p.property).pos
  have hq : 0 < q := by
    dsimp only [q]
    exact Finset.prod_pos (fun p _ => hp_pos p)
  let : NeZero q := ⟨ne_of_gt hq⟩
  let : ∀ p : P, NeZero (p : ℕ) := fun p => ⟨ne_of_gt (hp_pos p)⟩
  have hc : Pairwise (fun p r : P => Nat.Coprime (p : ℕ) (r : ℕ)) := by
    intro p r hpr
    apply (Nat.coprime_primes (hP p p.property) (hP r r.property)).mpr
    exact fun h => hpr (Subtype.ext h)
  let E : ZMod q ≃+* (∀ p : P, ZMod (p : ℕ)) :=
    ZMod.prodEquivPi (fun p : P => (p : ℕ)) hc
  have hE (n : ℕ) (p : P) : E (n : ZMod q) p = (n : ZMod (p : ℕ)) := by
    dsimp only [E]
    rw [ZMod.prodEquivPi_apply]
    exact map_natCast _ n
  have hsum : (∑ n ∈ Finset.range q, ∏ p : P, f p (n : ZMod (p : ℕ))) =
      ∏ p : P, ∑ n : ZMod (p : ℕ), f p n := by
    calc
      _ = ∑ n ∈ Finset.range q, ∏ p : P, f p (E (n : ZMod q) p) := by
        simp only [hE]
      _ = ∑ n : ZMod q, ∏ p : P, f p (E n p) :=
        sum_range_eq_sum_zmod q (fun n : ZMod q => ∏ p : P, f p (E n p))
      _ = ∑ n : ∀ p : P, ZMod (p : ℕ), ∏ p : P, f p (n p) :=
        E.toEquiv.sum_comp (fun n : ∀ p : P, ZMod (p : ℕ) => ∏ p : P, f p (n p))
      _ = ∏ p : P, ∑ n : ZMod (p : ℕ), f p n := (Fintype.prod_sum f).symm
  rw [hsum]
  simp_rw [sum_range_eq_sum_zmod]
  rw [Finset.prod_mul_distrib]
  congr 1
  simp only [q, one_div, Finset.prod_inv_distrib, Nat.cast_prod]

theorem auxiliary_categorical_product_average (P : Finset ℕ)
    (hP : ∀ p ∈ P, p.Prime) (h : Fin 40 → ℕ) (i : Fin 40)
    (σ τ : P → Bool × Option (Fin 39)) :
    let q : ℕ := ∏ p ∈ P, p
    (1 / (q : ℝ)) * ∑ n ∈ Finset.range q, ∏ p : P,
      (∏ j ∈ auxiliaryPrimeState i (σ p), selbergPrimePsi (p : ℕ) h j n) *
        (∏ j ∈ auxiliaryPrimeState i (τ p), selbergPrimePsi (p : ℕ) h j n) =
      ∏ p : P, auxiliaryCategoricalGram (p : ℕ) h i (σ p) (τ p) := by
  classical
  let f : ∀ p : P, ZMod (p : ℕ) → ℝ := fun p t =>
    (∏ j ∈ auxiliaryPrimeState i (σ p), selbergPrimePsi (p : ℕ) h j t.val) *
      (∏ j ∈ auxiliaryPrimeState i (τ p), selbergPrimePsi (p : ℕ) h j t.val)
  have hpsi (p : P) (n : ℕ) (j : Fin 40) :
      selbergPrimePsi (p : ℕ) h j (n : ZMod (p : ℕ)).val =
        selbergPrimePsi (p : ℕ) h j n := by
    simp only [selbergPrimePsi, ZMod.val_natCast, Nat.dvd_iff_mod_eq_zero,
      Nat.add_mod, Nat.mod_mod]
  simpa only [f, hpsi, auxiliaryCategoricalGram] using prime_product_average P hP f

theorem auxiliary_affine_bijective (q W : ℕ)
    (hcop : Nat.Coprime q W) (b : ℕ) :
    Function.Bijective (fun t : ZMod q => (b : ZMod q) + (W : ZMod q) * t) :=
  ((ZMod.unitOfCoprime W hcop.symm).mulLeft.trans
    (Equiv.addLeft (b : ZMod q))).bijective

theorem auxiliary_affine_period_average (q W : ℕ) (hq : 0 < q)
    (hcop : Nat.Coprime q W) (V : ℕ → ℝ) (hV : Function.Periodic V q) (b : ℕ) :
    (1 / (q : ℝ)) * ∑ n ∈ Finset.range q, (V (b + W * n)) ^ 2 =
      (1 / (q : ℝ)) * ∑ n ∈ Finset.range q, (V n) ^ 2 := by
  classical
  let : NeZero q := ⟨ne_of_gt hq⟩
  have hs := (auxiliary_affine_bijective q W hcop b).sum_comp
    (fun t : ZMod q => (V t.val) ^ 2)
  rw [← sum_range_eq_sum_zmod q, ← sum_range_eq_sum_zmod q] at hs
  apply congrArg (fun s : ℝ => (1 / (q : ℝ)) * s)
  simpa only [← Nat.cast_add, ← Nat.cast_mul, ZMod.val_natCast,
    hV.map_mod_nat] using hs

theorem auxiliaryPrimeState_prod {M : Type*} [CommMonoid M]
    (i : Fin 40) (b : Bool) (o : Option (Fin 39)) (f : Fin 40 → M) :
    (if b then f i else 1) *
        (∏ j : Fin 39, if o = some j then f (i.succAbove j) else 1) =
      ∏ j ∈ auxiliaryPrimeState i (b, o), f j := by
  classical
  cases b <;> cases o <;> simp [auxiliaryPrimeState, Finset.prod_ite_eq]

open Classical in
theorem auxiliary_pointwise_expansion
    (P : Finset ℕ) (hP : ∀ p ∈ P, p.Prime) (h : Fin 40 → ℕ) (i : Fin 40)
    (u : (Fin 1 → ℕ) →₀ ℝ) (z : (Fin 39 → ℕ) →₀ ℝ)
    (hu : ∀ s ∈ u.support, s 0 ∈ (∏ p ∈ P, p).divisors)
    (hz : ∀ r ∈ z.support,
      Squarefree (∏ j, r j) ∧ ∀ j, r j ∈ (∏ p ∈ P, p).divisors) :
    let rootA : (P → Bool × Option (Fin 39)) → (Fin 1 → ℕ) :=
      fun σ _ => ∏ p : P, if (σ p).1 then (p : ℕ) else 1
    let rootR : (P → Bool × Option (Fin 39)) → (Fin 39 → ℕ) :=
      fun σ j => ∏ p : P, if (σ p).2 = some j then (p : ℕ) else 1
    let Du := u.support.biUnion
      (fun s => Fintype.piFinset (fun j => (s j).divisors))
    let Dz := z.support.biUnion
      (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let L : ℕ → ℝ := fun t =>
      ∑ e ∈ Du, if e 0 ∣ t then selbergCoefficient u e else 0
    let C : ℕ → ℝ := fun n =>
      ∑ d ∈ Dz, if ∀ j, d j ∣ n + h (i.succAbove j) then
        selbergCoefficient z d else 0
    let V : ℕ → ℝ := fun n => L (n + h i) * C n
    let amplitude : (P → Bool × Option (Fin 39)) → ℝ :=
      fun σ => u (rootA σ) * z (rootR σ)
    ∀ n : ℕ,
      V n = ∑ σ : P → Bool × Option (Fin 39),
        amplitude σ * ∏ p : P, ∏ j ∈ auxiliaryPrimeState i (σ p),
          selbergPrimePsi (p : ℕ) h j n := by
  intro rootA rootR Du Dz L C V amplitude n
  let q : ℕ := ∏ p ∈ P, p
  let SA := Fintype.piFinset (fun _ : Fin 1 => q.divisors)
  let SR := (Fintype.piFinset (fun _ : Fin 39 => q.divisors)).filter
    (fun r => Squarefree (∏ j, r j))
  let FA (s : Fin 1 → ℕ) : ℝ :=
    u s * ∏ p ∈ (s 0).primeFactors, selbergPrimePsi p h i n
  let FR (r : Fin 39 → ℕ) : ℝ :=
    z r * ∏ j, ∏ p ∈ (r j).primeFactors, selbergPrimePsi p h (i.succAbove j) n
  have huSq : ∀ s ∈ u.support, Squarefree (∏ j, s j) := by
    intro s hs
    simpa only [Fin.prod_univ_one] using
      (squarefree_prime_prod P hP).squarefree_of_dvd
        (Nat.mem_divisors.mp (hu s hs)).1
  have hL : L (n + h i) = ∑ s ∈ u.support, FA s := by
    simpa only [L, Du, FA, Fin.forall_fin_one, Fin.prod_univ_one, selbergPrimePsi] using
      selberg_pointwise_expansion u (fun _ => n + h i) huSq
  have hC : C n = ∑ r ∈ z.support, FR r := by
    have he := selberg_pointwise_expansion z (fun j => n + h (i.succAbove j))
      (fun r hr => (hz r hr).1)
    refine Eq.trans ?_ he
    apply Finset.sum_congr rfl
    intro d _
    by_cases hdt : ∀ j : Fin 39, d j ∣ n + h (i.succAbove j) <;> simp [hdt]
  have huSA : u.support ⊆ SA := by
    intro s hs
    simpa only [SA, Fintype.mem_piFinset, Fin.forall_fin_one] using hu s hs
  have hzSR : z.support ⊆ SR := by
    intro r hr
    exact Finset.mem_filter.mpr
      ⟨Fintype.mem_piFinset.mpr (hz r hr).2, (hz r hr).1⟩
  have hsumA : (∑ s ∈ u.support, FA s) = ∑ s ∈ SA, FA s := by
    apply Finset.sum_subset huSA
    intro s _ hs
    simp only [FA, Finsupp.notMem_support_iff.mp hs, zero_mul]
  have hsumR : (∑ r ∈ z.support, FR r) = ∑ r ∈ SR, FR r := by
    apply Finset.sum_subset hzSR
    intro r _ hr
    simp only [FR, Finsupp.notMem_support_iff.mp hr, zero_mul]
  have hAprod (σ : P → Bool × Option (Fin 39)) :
      (∏ p ∈ (rootA σ 0).primeFactors, selbergPrimePsi p h i n) =
        ∏ p : P, if (σ p).1 then selbergPrimePsi (p : ℕ) h i n else 1 :=
    auxiliary_prime_selection_product P hP (fun p => (σ p).1)
      (fun p => selbergPrimePsi p h i n)
  have hRprod (σ : P → Bool × Option (Fin 39)) :
      (∏ j : Fin 39, ∏ p ∈ (rootR σ j).primeFactors,
        selbergPrimePsi p h (i.succAbove j) n) =
        ∏ p : P, ∏ j : Fin 39,
          if (σ p).2 = some j then selbergPrimePsi (p : ℕ) h (i.succAbove j) n
          else 1 := by
    calc
      _ = ∏ j : Fin 39, ∏ p : P,
          if (σ p).2 = some j then selbergPrimePsi (p : ℕ) h (i.succAbove j) n
          else 1 := by
        apply Finset.prod_congr rfl
        intro j _
        simpa only [decide_eq_true_eq] using
          auxiliary_prime_selection_product P hP
            (fun p => decide ((σ p).2 = some j))
            (fun p => selbergPrimePsi p h (i.succAbove j) n)
      _ = _ := Finset.prod_comm
  have hconfigured (σ : P → Bool × Option (Fin 39)) :
      FA (rootA σ) * FR (rootR σ) =
        amplitude σ * ∏ p : P, ∏ j ∈ auxiliaryPrimeState i (σ p),
          selbergPrimePsi (p : ℕ) h j n := by
    dsimp only [FA, FR, amplitude]
    rw [hAprod, hRprod]
    calc
      _ = (u (rootA σ) * z (rootR σ)) * ∏ p : P,
          (if (σ p).1 then selbergPrimePsi (p : ℕ) h i n else 1) *
            (∏ j : Fin 39, if (σ p).2 = some j then
              selbergPrimePsi (p : ℕ) h (i.succAbove j) n else 1) := by
        rw [Finset.prod_mul_distrib]
        ring
      _ = _ := by
        congr 1
        apply Finset.prod_congr rfl
        intro p _
        exact auxiliaryPrimeState_prod i (σ p).1 (σ p).2
          (fun j => selbergPrimePsi (p : ℕ) h j n)
  calc
    V n = (∑ s ∈ u.support, FA s) * (∑ r ∈ z.support, FR r) := by
      change L (n + h i) * C n = _
      rw [hL, hC]
    _ = (∑ s ∈ SA, FA s) * (∑ r ∈ SR, FR r) := by rw [hsumA, hsumR]
    _ = ∑ s ∈ SA, ∑ r ∈ SR, FA s * FR r := by rw [Finset.sum_mul_sum]
    _ = ∑ σ : P → Bool × Option (Fin 39), FA (rootA σ) * FR (rootR σ) :=
      (auxiliary_root_sum P hP (fun s r => FA s * FR r)).symm
    _ = _ := Finset.sum_congr rfl fun σ _ => hconfigured σ

theorem selberg_sum_periodic {ι : Type*} [Fintype ι] [DecidableEq ι]
    (q : ℕ) (y : (ι → ℕ) →₀ ℝ) (h : ι → ℕ)
    (hy : ∀ r ∈ y.support, ∀ j, r j ∣ q) :
    let D := y.support.biUnion
      (fun r => Fintype.piFinset (fun j => (r j).divisors))
    Function.Periodic
      (fun n => ∑ d ∈ D, if ∀ j, d j ∣ n + h j then selbergCoefficient y d else 0) q := by
  classical
  intro D n
  apply Finset.sum_congr rfl
  intro d hd
  obtain ⟨r, hr, hdr⟩ := Finset.mem_biUnion.mp hd
  have hdq (j : ι) : d j ∣ q :=
    (Nat.dvd_of_mem_divisors (Fintype.mem_piFinset.mp hdr j)).trans (hy r hr j)
  have hiff : (∀ j, d j ∣ n + q + h j) ↔ (∀ j, d j ∣ n + h j) := by
    exact forall_congr' fun j => by
      rw [Nat.add_right_comm]
      exact (Nat.dvd_add_iff_left (hdq j)).symm
  simp only [hiff]

theorem auxiliary_categorical_tensor (P : Finset ℕ)
    (hP : ∀ p ∈ P, p.Prime) (h : Fin 40 → ℕ) (i : Fin 40)
    (amplitude : (P → Bool × Option (Fin 39)) → ℝ) (V : ℕ → ℝ)
    (hexp : ∀ n, V n = ∑ σ : P → Bool × Option (Fin 39),
      amplitude σ * ∏ p : P, ∏ j ∈ auxiliaryPrimeState i (σ p),
        selbergPrimePsi (p : ℕ) h j n) :
    let q : ℕ := ∏ p ∈ P, p
    (1 / (q : ℝ)) * ∑ n ∈ Finset.range q, V n ^ 2 =
      ∑ σ : P → Bool × Option (Fin 39), ∑ τ : P → Bool × Option (Fin 39),
        amplitude σ * amplitude τ *
          ∏ p : P, auxiliaryCategoricalGram (p : ℕ) h i (σ p) (τ p) := by
  classical
  intro q
  have hpoint (n : ℕ) :
      V n ^ 2 = ∑ σ : P → Bool × Option (Fin 39),
        ∑ τ : P → Bool × Option (Fin 39), amplitude σ * amplitude τ *
          ∏ p : P,
            (∏ j ∈ auxiliaryPrimeState i (σ p), selbergPrimePsi (p : ℕ) h j n) *
              (∏ j ∈ auxiliaryPrimeState i (τ p), selbergPrimePsi (p : ℕ) h j n) := by
    simp only [hexp n, pow_two, Finset.sum_mul_sum, Finset.prod_mul_distrib,
      mul_assoc, mul_left_comm]
  simp_rw [hpoint]
  calc
    _ = ∑ σ : P → Bool × Option (Fin 39), ∑ τ : P → Bool × Option (Fin 39),
        amplitude σ * amplitude τ * ((1 / (q : ℝ)) *
          ∑ n ∈ Finset.range q, ∏ p : P,
            (∏ j ∈ auxiliaryPrimeState i (σ p), selbergPrimePsi (p : ℕ) h j n) *
              (∏ j ∈ auxiliaryPrimeState i (τ p), selbergPrimePsi (p : ℕ) h j n)) := by
      rw [Finset.sum_comm, Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro σ _
      rw [Finset.sum_comm, Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro τ _
      rw [← Finset.mul_sum]
      ring
    _ = _ := by
      simp only [q, auxiliary_categorical_product_average P hP h i]

open Classical in
theorem selberg40_auxiliary_exact_period_bridge
    {𝓗 : Finset ℕ} {h𝓗_card : 𝓗.card = 40}
    (i : Fin 40) (x κ : ℝ) (hx : 1 < x) (hκ : 0 < κ) :
    let ρ : ℝ := 2624989 / 10000000
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    let W := presievingModulus 𝓗 x
    let R := x ^ ρ
    let P := fragmentPrimes W R κ
    let q : ℕ := ∏ p ∈ P, p
    let rootA : (P → Bool × Option (Fin 39)) → (Fin 1 → ℕ) :=
      fun σ _ => ∏ p : P, if (σ p).1 then (p : ℕ) else 1
    let rootR : (P → Bool × Option (Fin 39)) → (Fin 39 → ℕ) :=
      fun σ j => ∏ p : P, if (σ p).2 = some j then (p : ℕ) else 1
    ∀ (u : (Fin 1 → ℕ) →₀ ℝ) (z : (Fin 39 → ℕ) →₀ ℝ),
      (∀ s ∈ u.support, s 0 ∈ q.divisors) →
      (∀ r ∈ z.support, Squarefree (∏ j, r j) ∧ ∀ j, r j ∈ q.divisors) →
      let Du := u.support.biUnion
        (fun s => Fintype.piFinset (fun j => (s j).divisors))
      let Dz := z.support.biUnion
        (fun r => Fintype.piFinset (fun j => (r j).divisors))
      let L : ℕ → ℝ := fun t =>
        ∑ e ∈ Du, if e 0 ∣ t then selbergCoefficient u e else 0
      let C : ℕ → ℝ := fun n =>
        ∑ d ∈ Dz, if ∀ j, d j ∣ n + h (i.succAbove j) then
          selbergCoefficient z d else 0
      let V : ℕ → ℝ := fun n => L (n + h i) * C n
      let amplitude : (P → Bool × Option (Fin 39)) → ℝ :=
        fun σ => u (rootA σ) * z (rootR σ)
      let mean : ℝ := (1 / (q : ℝ)) * ∑ n ∈ Finset.range q, V n ^ 2
      let tensorK : ℝ := ∑ σ : P → Bool × Option (Fin 39),
        ∑ τ : P → Bool × Option (Fin 39),
          amplitude σ * amplitude τ *
            ∏ p : P, auxiliaryCategoricalGram (p : ℕ) h i (σ p) (τ p)
      let tensorD : ℝ := ∑ σ : P → Bool × Option (Fin 39),
        ∑ τ : P → Bool × Option (Fin 39),
          amplitude σ * amplitude τ *
            ∏ p : P, auxiliaryIndependentGram (p : ℕ) i (σ p) (τ p)
      let harmonic : ℝ :=
        u.sum (fun s us => us ^ 2 / ((s 0).totient : ℝ)) *
          z.sum (fun r zr => zr ^ 2 / (∏ j, ((r j).totient : ℝ)))
      0 < q ∧ Nat.Coprime q W ∧
        (∀ (s : Fin 1 → ℕ) (r : Fin 39 → ℕ),
          (s 0 ∈ q.divisors ∧ Squarefree (∏ j, r j) ∧
            ∀ j, r j ∈ q.divisors) ↔
          ∃! σ : P → Bool × Option (Fin 39), rootA σ = s ∧ rootR σ = r) ∧
        (∀ n : ℕ,
          V n = ∑ σ : P → Bool × Option (Fin 39),
            amplitude σ * ∏ p : P, ∏ j ∈ auxiliaryPrimeState i (σ p),
              selbergPrimePsi (p : ℕ) h j n) ∧
        mean = tensorK ∧ tensorD = harmonic ∧
        (∀ n : ℕ, L (n + q) = L n) ∧
        (∀ n : ℕ, C (n + q) = C n) ∧
        (∀ b : ℕ,
          Function.Bijective (fun t : ZMod q => (b : ZMod q) + (W : ZMod q) * t)) ∧
        (∀ b : ℕ,
          (1 / (q : ℝ)) * (∑ n ∈ Finset.range q, V (b + W * n) ^ 2) = mean) := by
  refine (fun (_ : 1 < x) (_ : 0 < κ) => ?_) hx hκ
  classical
  intro ρ h W R P q rootA rootR u z hu hz Du Dz L C V amplitude mean tensorK tensorD harmonic
  have hP (p : ℕ) (hp : p ∈ P) : p.Prime :=
    Nat.prime_of_mem_primesLE (Finset.mem_filter.mp hp).1
  have hpW (p : ℕ) (hp : p ∈ P) : ¬ p ∣ W := (Finset.mem_filter.mp hp).2
  have hq : 0 < q := Finset.prod_pos fun p hp => (hP p hp).pos
  have hcop : Nat.Coprime q W :=
    Nat.Coprime.prod_left fun p hp => (hP p hp).coprime_iff_not_dvd.mpr (hpW p hp)
  have hexp : ∀ n : ℕ,
      V n = ∑ σ : P → Bool × Option (Fin 39),
        amplitude σ * ∏ p : P, ∏ j ∈ auxiliaryPrimeState i (σ p),
          selbergPrimePsi (p : ℕ) h j n :=
    auxiliary_pointwise_expansion P hP h i u z hu hz
  have huq : ∀ s ∈ u.support, ∀ j : Fin 1, s j ∣ q := by
    intro s hs j
    have hj : j = 0 := Subsingleton.elim _ _
    simpa only [hj] using (Nat.mem_divisors.mp (hu s hs)).1
  have hzq : ∀ r ∈ z.support, ∀ j : Fin 39, r j ∣ q :=
    fun r hr j => (Nat.mem_divisors.mp ((hz r hr).2 j)).1
  have hL : Function.Periodic L q := by
    simpa only [L, Du, Nat.add_zero, Fin.forall_fin_one] using
      selberg_sum_periodic q u (fun _ : Fin 1 => 0) huq
  have hC : Function.Periodic C q := by
    have hperiod := selberg_sum_periodic q z (fun j => h (i.succAbove j)) hzq
    intro n
    refine Eq.trans ?_ (Eq.trans (hperiod n) ?_)
    · apply Finset.sum_congr rfl
      intro d _
      by_cases hdt : ∀ j : Fin 39, d j ∣ n + q + h (i.succAbove j) <;> simp [hdt]
    · apply Finset.sum_congr rfl
      intro d _
      by_cases hdt : ∀ j : Fin 39, d j ∣ n + h (i.succAbove j) <;> simp [hdt]
  have hV : Function.Periodic V q := (hL.add_const (h i)).mul hC
  refine ⟨hq, hcop, auxiliary_root_configuration P hP, hexp, ?_, ?_, hL, hC, ?_, ?_⟩
  · exact auxiliary_categorical_tensor P hP h i amplitude V hexp
  · exact auxiliary_independent_harmonic P hP i u z hu hz
  · intro b
    exact auxiliary_affine_bijective q W hcop b
  · intro b
    exact auxiliary_affine_period_average q W hq hcop V hV b

end

section
open Real Finset Filter Asymptotics Topology

open ArithmeticFunction hiding log

theorem auxiliary_abs_prod_sub_prod_le {ι : Type*} (S : Finset ι)
    (k d : ι → ℝ) (hd : ∀ p ∈ S, 0 ≤ d p) :
    |(∏ p ∈ S, k p) - ∏ p ∈ S, d p| ≤
      (∏ p ∈ S, (d p + |k p - d p|)) - ∏ p ∈ S, d p := by
  classical
  revert hd
  induction S using Finset.induction with
  | empty => simp
  | insert a S ha ih =>
      intro hd
      have hda : 0 ≤ d a := hd a (Finset.mem_insert_self a S)
      have hdS : ∀ p ∈ S, 0 ≤ d p :=
        fun p hp => hd p (Finset.mem_insert_of_mem hp)
      have hk : |∏ p ∈ S, k p| ≤ ∏ p ∈ S, (d p + |k p - d p|) := by
        rw [Finset.abs_prod]
        refine Finset.prod_le_prod (fun _ _ => abs_nonneg _) ?_
        intro p hp
        calc
          |k p| = |k p - d p + d p| := by rw [sub_add_cancel]
          _ ≤ |k p - d p| + |d p| := abs_add_le _ _
          _ = d p + |k p - d p| := by rw [abs_of_nonneg (hdS p hp), add_comm]
      simp only [Finset.prod_insert ha]
      calc
        |k a * (∏ p ∈ S, k p) - d a * ∏ p ∈ S, d p| =
            |(k a - d a) * (∏ p ∈ S, k p) +
              d a * ((∏ p ∈ S, k p) - ∏ p ∈ S, d p)| := by
          congr 1
          ring
        _ ≤ |(k a - d a) * (∏ p ∈ S, k p)| +
            |d a * ((∏ p ∈ S, k p) - ∏ p ∈ S, d p)| := abs_add_le _ _
        _ = |k a - d a| * |∏ p ∈ S, k p| +
            d a * |(∏ p ∈ S, k p) - ∏ p ∈ S, d p| := by
          simp only [abs_mul, abs_of_nonneg hda]
        _ ≤ |k a - d a| * (∏ p ∈ S, (d p + |k p - d p|)) +
            d a * ((∏ p ∈ S, (d p + |k p - d p|)) - ∏ p ∈ S, d p) :=
          add_le_add (mul_le_mul_of_nonneg_left hk (abs_nonneg _))
            (mul_le_mul_of_nonneg_left (ih hdS) hda)
        _ = (d a + |k a - d a|) * (∏ p ∈ S, (d p + |k p - d p|)) -
            d a * ∏ p ∈ S, d p := by ring

theorem auxiliary_tensor_perturbation {ι α : Type*}
    [Fintype ι] [DecidableEq ι] [Fintype α]
    (K D : ι → α → α → ℝ) (e : ι → ℝ)
    (hD : ∀ p s t, 0 ≤ D p s t) (he : ∀ p, 0 ≤ e p)
    (hd : ∀ p, 1 ≤ ∑ s : α, ∑ t : α, D p s t)
    (hδ : ∀ p, (∑ s : α, ∑ t : α, |K p s t - D p s t|) ≤ e p) :
    (∑ σ : ι → α, ∑ τ : ι → α,
      |(∏ p, K p (σ p) (τ p)) - ∏ p, D p (σ p) (τ p)|) ≤
      (∏ p, ∑ s : α, ∑ t : α, D p s t) * (Real.exp (∑ p, e p) - 1) := by
  classical
  let d : ι → ℝ := fun p => ∑ s : α, ∑ t : α, D p s t
  let δ : ι → ℝ := fun p => ∑ s : α, ∑ t : α, |K p s t - D p s t|
  have hd₀ (p : ι) : 0 ≤ d p := zero_le_one.trans (hd p)
  have hδ₀ (p : ι) : 0 ≤ δ p :=
    Finset.sum_nonneg fun _ _ => Finset.sum_nonneg fun _ _ => abs_nonneg _
  have hsum (F : ι → α → α → ℝ) :
      (∑ σ : ι → α, ∑ τ : ι → α, ∏ p, F p (σ p) (τ p)) =
        ∏ p, ∑ s : α, ∑ t : α, F p s t := by
    simpa only [← Fintype.prod_sum] using
      (Fintype.prod_sum (fun p s => ∑ t : α, F p s t)).symm
  have hde (p : ι) : d p + δ p ≤ d p * (1 + e p) := by
    calc
      d p + δ p ≤ d p + e p := add_le_add le_rfl (hδ p)
      _ ≤ d p + d p * e p := by
        apply add_le_add le_rfl
        simpa only [one_mul] using mul_le_mul_of_nonneg_right (hd p) (he p)
      _ = d p * (1 + e p) := by ring
  calc
    _ ≤ ∑ σ : ι → α, ∑ τ : ι → α,
        ((∏ p, (D p (σ p) (τ p) + |K p (σ p) (τ p) - D p (σ p) (τ p)|)) -
          ∏ p, D p (σ p) (τ p)) := by
      refine Finset.sum_le_sum fun σ _ => Finset.sum_le_sum fun τ _ => ?_
      exact auxiliary_abs_prod_sub_prod_le Finset.univ
        (fun p => K p (σ p) (τ p)) (fun p => D p (σ p) (τ p))
        (fun p _ => hD p (σ p) (τ p))
    _ = (∏ p, (d p + δ p)) - ∏ p, d p := by
      simp_rw [Finset.sum_sub_distrib]
      rw [hsum (fun p s t => D p s t + |K p s t - D p s t|), hsum D]
      congr 1
      refine Finset.prod_congr rfl fun p _ => ?_
      simp only [d, δ, Finset.sum_add_distrib]
    _ ≤ (∏ p, d p * (1 + e p)) - ∏ p, d p :=
      sub_le_sub_right
        (Finset.prod_le_prod (fun p _ => add_nonneg (hd₀ p) (hδ₀ p))
          (fun p _ => hde p)) _
    _ = (∏ p, d p) * ((∏ p, (1 + e p)) - 1) := by
      rw [Finset.prod_mul_distrib]
      ring
    _ ≤ (∏ p, d p) * (Real.exp (∑ p, e p) - 1) :=
      mul_le_mul_of_nonneg_left
        (sub_le_sub_right (Real.prod_one_add_le_exp_sum Finset.univ he) 1)
        (Finset.prod_nonneg fun p _ => hd₀ p)

theorem auxiliary_weighted_tensor_error
    {𝓗 : Finset ℕ} {h𝓗_card : 𝓗.card = 40}
    (x : ℝ) (i : Fin 40) (P : Finset ℕ) (hP : ∀ p ∈ P, p.Prime)
    (hpW : ∀ p ∈ P, ¬ p ∣ presievingModulus 𝓗 x)
    (a : (P → Bool × Option (Fin 39)) → ℝ) (A : ℝ)
    (hA : 0 ≤ A) (ha : ∀ σ, |a σ| ≤ A) :
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    |(∑ σ : P → Bool × Option (Fin 39), ∑ τ : P → Bool × Option (Fin 39),
        a σ * a τ * ∏ p : P, auxiliaryCategoricalGram (p : ℕ) h i (σ p) (τ p)) -
      (∑ σ : P → Bool × Option (Fin 39), ∑ τ : P → Bool × Option (Fin 39),
        a σ * a τ * ∏ p : P, auxiliaryIndependentGram (p : ℕ) i (σ p) (τ p))| ≤
      A ^ 2 * (∏ p ∈ P, (1 + 1 / ((p : ℝ) - 1))) ^ 40 *
        (Real.exp (51200 * (∑' p : ℕ,
          if p.Prime ∧ ¬ p ∣ presievingModulus 𝓗 x
          then 1 / (p : ℝ) ^ 2 else 0)) - 1) := by
  classical
  dsimp only
  let h : Fin 40 → ℕ :=
    𝓗.orderEmbOfFin h𝓗_card
  let K : P → (Bool × Option (Fin 39)) → (Bool × Option (Fin 39)) → ℝ :=
    fun p s t => auxiliaryCategoricalGram (p : ℕ) h i s t
  let D : P → (Bool × Option (Fin 39)) → (Bool × Option (Fin 39)) → ℝ :=
    fun p s t => auxiliaryIndependentGram (p : ℕ) i s t
  let e : P → ℝ := fun p => 51200 / ((p : ℕ) : ℝ) ^ 2
  have hlocal (p : P) :
      (∀ s t, 0 ≤ D p s t) ∧
      (∑ s : Bool × Option (Fin 39), ∑ t : Bool × Option (Fin 39),
        |K p s t - D p s t|) ≤ e p ∧
      1 ≤ (∑ s : Bool × Option (Fin 39), ∑ t : Bool × Option (Fin 39), D p s t) ∧
      (∑ s : Bool × Option (Fin 39), ∑ t : Bool × Option (Fin 39), D p s t) ≤
        (1 + 1 / (((p : ℕ) : ℝ) - 1)) ^ 40 := by
    have hm := selberg40_auxiliary_local_gram
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) x i p (hP p p.property) (hpW p p.property)
    dsimp only at hm
    refine ⟨?_, hm.2.2.2.2.2.1, hm.2.2.2.2.2.2.2.1, hm.2.2.2.2.2.2.2.2⟩
    intro s t
    change 0 ≤ auxiliaryIndependentGram (p : ℕ) i s t
    rw [(hm.2.2.2.2.1 s t).2.1]
    have hp2 : (2 : ℝ) ≤ (p : ℕ) := by exact_mod_cast (hP p p.property).two_le
    have hp1 : 0 < ((p : ℕ) : ℝ) - 1 := by linarith
    split_ifs <;> positivity
  have he (p : P) : 0 ≤ e p := by dsimp only [e]; positivity
  have hT := auxiliary_tensor_perturbation K D e
    (fun p => (hlocal p).1) he
    (fun p => (hlocal p).2.2.1) (fun p => (hlocal p).2.1)
  have hd0 : 0 ≤ ∏ p : P,
      ∑ s : Bool × Option (Fin 39), ∑ t : Bool × Option (Fin 39), D p s t :=
    Finset.prod_nonneg fun p _ => zero_le_one.trans (hlocal p).2.2.1
  have hmass : (∏ p : P,
      ∑ s : Bool × Option (Fin 39), ∑ t : Bool × Option (Fin 39), D p s t) ≤
      (∏ p ∈ P, (1 + 1 / ((p : ℝ) - 1))) ^ 40 := by
    calc
      _ ≤ ∏ p : P, (1 + 1 / (((p : ℕ) : ℝ) - 1)) ^ 40 :=
        Finset.prod_le_prod (fun p _ => zero_le_one.trans (hlocal p).2.2.1)
          (fun p _ => (hlocal p).2.2.2)
      _ = _ := by
        rw [Finset.prod_pow]
        congr 1
        exact Finset.prod_coe_sort P (fun p : ℕ => (1 : ℝ) + 1 / ((p : ℝ) - 1))
  let f : ℕ → ℝ := fun p =>
    if p.Prime ∧ ¬ p ∣ presievingModulus 𝓗 x
    then 1 / (p : ℝ) ^ 2 else 0
  have hf0 (p : ℕ) : 0 ≤ f p := by dsimp only [f]; split_ifs <;> positivity
  have hf : Summable f :=
    Summable.of_nonneg_of_le hf0 (fun p => by
      dsimp only [f]
      split_ifs
      · exact le_rfl
      · positivity) (Real.summable_one_div_nat_pow.mpr (by norm_num))
  have htail : (∑ p : P, e p) ≤ 51200 * ∑' p, f p := by
    calc
      _ = 51200 * ∑ p ∈ P, f p := by
        rw [← Finset.sum_coe_sort P f, Finset.mul_sum]
        apply Finset.sum_congr rfl
        intro p _
        dsimp only [e, f]
        rw [ite_eq_left ⟨hP p p.property, hpW p p.property⟩]
        ring
      _ ≤ _ := mul_le_mul_of_nonneg_left
        (hf.sum_le_tsum P fun p _ => hf0 p) (by norm_num)
  have hexp : Real.exp (∑ p : P, e p) - 1 ≤
      Real.exp (51200 * ∑' p, f p) - 1 :=
    sub_le_sub_right (Real.exp_le_exp.mpr htail) 1
  have hexp0 : 0 ≤ Real.exp (∑ p : P, e p) - 1 :=
    sub_nonneg.mpr (Real.one_le_exp (Finset.sum_nonneg fun p _ => he p))
  have hweighted :
      |(∑ σ : P → Bool × Option (Fin 39), ∑ τ : P → Bool × Option (Fin 39),
          a σ * a τ * ∏ p : P, K p (σ p) (τ p)) -
        (∑ σ : P → Bool × Option (Fin 39), ∑ τ : P → Bool × Option (Fin 39),
          a σ * a τ * ∏ p : P, D p (σ p) (τ p))| ≤
        A ^ 2 * (∑ σ : P → Bool × Option (Fin 39),
          ∑ τ : P → Bool × Option (Fin 39),
            |(∏ p : P, K p (σ p) (τ p)) - ∏ p : P, D p (σ p) (τ p)|) := by
    calc
      _ = |∑ σ : P → Bool × Option (Fin 39), ∑ τ : P → Bool × Option (Fin 39),
          a σ * a τ * ((∏ p : P, K p (σ p) (τ p)) -
            ∏ p : P, D p (σ p) (τ p))| := by
        simp only [mul_sub, Finset.sum_sub_distrib]
      _ ≤ ∑ σ : P → Bool × Option (Fin 39),
          |∑ τ : P → Bool × Option (Fin 39),
            a σ * a τ * ((∏ p : P, K p (σ p) (τ p)) -
              ∏ p : P, D p (σ p) (τ p))| := Finset.abs_sum_le_sum_abs _ _
      _ ≤ ∑ σ : P → Bool × Option (Fin 39), ∑ τ : P → Bool × Option (Fin 39),
          |a σ * a τ * ((∏ p : P, K p (σ p) (τ p)) -
            ∏ p : P, D p (σ p) (τ p))| := by
        apply Finset.sum_le_sum
        intro σ _
        exact Finset.abs_sum_le_sum_abs _ _
      _ ≤ ∑ σ : P → Bool × Option (Fin 39), ∑ τ : P → Bool × Option (Fin 39),
          A ^ 2 * |(∏ p : P, K p (σ p) (τ p)) -
            ∏ p : P, D p (σ p) (τ p)| := by
        apply Finset.sum_le_sum
        intro σ _
        apply Finset.sum_le_sum
        intro τ _
        rw [abs_mul]
        apply mul_le_mul_of_nonneg_right _ (abs_nonneg _)
        rw [abs_mul, pow_two]
        exact mul_le_mul (ha σ) (ha τ) (abs_nonneg _) hA
      _ = _ := by simp only [Finset.mul_sum]
  have hmass0 : 0 ≤ (∏ p ∈ P, (1 + 1 / ((p : ℝ) - 1))) ^ 40 :=
    le_trans hd0 hmass
  change
    |(∑ σ : P → Bool × Option (Fin 39), ∑ τ : P → Bool × Option (Fin 39),
        a σ * a τ * ∏ p : P, K p (σ p) (τ p)) -
      (∑ σ : P → Bool × Option (Fin 39), ∑ τ : P → Bool × Option (Fin 39),
        a σ * a τ * ∏ p : P, D p (σ p) (τ p))| ≤
      A ^ 2 * (∏ p ∈ P, (1 + 1 / ((p : ℝ) - 1))) ^ 40 *
        (Real.exp (51200 * ∑' p, f p) - 1)
  calc
    _ ≤ A ^ 2 * (∑ σ : P → Bool × Option (Fin 39),
        ∑ τ : P → Bool × Option (Fin 39),
          |(∏ p : P, K p (σ p) (τ p)) - ∏ p : P, D p (σ p) (τ p)|) :=
      hweighted
    _ ≤ A ^ 2 * ((∏ p : P,
        ∑ s : Bool × Option (Fin 39), ∑ t : Bool × Option (Fin 39), D p s t) *
          (Real.exp (∑ p : P, e p) - 1)) :=
      mul_le_mul_of_nonneg_left hT (sq_nonneg A)
    _ ≤ A ^ 2 * ((∏ p ∈ P, (1 + 1 / ((p : ℝ) - 1))) ^ 40 *
        (Real.exp (51200 * ∑' p, f p) - 1)) := by
      apply mul_le_mul_of_nonneg_left _ (sq_nonneg A)
      exact mul_le_mul hmass hexp hexp0 hmass0
    _ = _ := by ring

theorem auxiliary_exp_sub_one_le (t : ℝ) (ht0 : 0 ≤ t) (ht1 : t ≤ 1) :
    Real.exp t - 1 ≤ Real.exp 1 * t := by
  have h := Real.abs_exp_sub_one_le (x := t) (by rwa [abs_of_nonneg ht0])
  have htwo : (2 : ℝ) ≤ Real.exp 1 := by linarith [Real.add_one_le_exp (1 : ℝ)]
  rw [abs_of_nonneg ht0] at h
  exact (le_abs_self _).trans (h.trans (mul_le_mul_of_nonneg_right htwo ht0))

open Classical in
theorem selberg40_auxiliary_period_comparison
    {𝓗 : Finset ℕ} {h𝓗_card : 𝓗.card = 40}
    (i : Fin 40) (κ M N : ℝ) (hκ : 0 < κ) (hM : 0 ≤ M) (hN : 0 ≤ N) :
    ∀ ε : ℝ, 0 < ε →
      ∀ᶠ x : ℝ in Filter.atTop,
        let ρ : ℝ := 2624989 / 10000000
        let h : Fin 40 → ℕ :=
          𝓗.orderEmbOfFin h𝓗_card
        let W := presievingModulus 𝓗 x
        let R := x ^ ρ
        let B := fragmentNormalization W R
        let P := fragmentPrimes W R κ
        let q : ℕ := ∏ p ∈ P, p
        let mass := harmonicFragmentMass W R κ
        let tail : ℝ := ∑' p : ℕ,
          if Nat.Prime p ∧ ¬ p ∣ W then 1 / (p : ℝ) ^ 2 else 0
        0 < B ∧
          ∀ (u : (Fin 1 → ℕ) →₀ ℝ) (z : (Fin 39 → ℕ) →₀ ℝ),
            (∀ s ∈ u.support, s 0 ∈ q.divisors) →
            (∀ r ∈ z.support, Squarefree (∏ j, r j) ∧ ∀ j, r j ∈ q.divisors) →
            (∀ s, |u s| ≤ N / B) →
            (∀ r, |z r| ≤ M / B ^ 39) →
            let Du := u.support.biUnion
              (fun s => Fintype.piFinset (fun j => (s j).divisors))
            let Dz := z.support.biUnion
              (fun r => Fintype.piFinset (fun j => (r j).divisors))
            let L : ℕ → ℝ := fun t =>
              ∑ e ∈ Du, if e 0 ∣ t then selbergCoefficient u e else 0
            let C : ℕ → ℝ := fun n =>
              ∑ d ∈ Dz, if ∀ j, d j ∣ n + h (i.succAbove j) then
                selbergCoefficient z d else 0
            let harmonic : ℝ :=
              u.sum (fun s us => us ^ 2 / ((s 0).totient : ℝ)) *
                z.sum (fun r zr => zr ^ 2 / (∏ j, ((r j).totient : ℝ)))
            ∀ b : ℕ,
              let error : ℝ :=
                |(1 / (q : ℝ)) * (∑ n ∈ Finset.range q,
                  (L (b + W * n + h i) * C (b + W * n)) ^ 2) - harmonic|
              error ≤ M ^ 2 * N ^ 2 / B ^ 80 * mass ^ 40 *
                  (Real.exp (51200 * tail) - 1) ∧
                error ≤ (51200 * Real.exp 1) *
                    (M ^ 2 * N ^ 2 / B ^ 80 * mass ^ 40) * tail ∧
                error ≤ ε / B ^ 40 := by
  intro ε hε
  let ρ : ℝ := 2624989 / 10000000
  have hρ : 0 < ρ := by norm_num [ρ]
  have hm := harmonic_fragment_normalizer_tendsto 𝓗 ρ κ hρ hκ
  have ht := presieved_prime_square_tail_tendsto 𝓗
  have htSmall : Tendsto
      (fun x : ℝ => 51200 * (∑' p : ℕ,
        if Nat.Prime p ∧ ¬ p ∣ presievingModulus 𝓗 x
        then 1 / (p : ℝ) ^ 2 else 0)) atTop (nhds 0) := by
    simpa only [mul_zero] using ht.const_mul (51200 : ℝ)
  have heSmall : Tendsto
      (fun x : ℝ => (51200 * Real.exp 1) * (M ^ 2 * N ^ 2) *
        (harmonicFragmentMass (presievingModulus 𝓗 x) (x ^ ρ) κ /
          fragmentNormalization (presievingModulus 𝓗 x) (x ^ ρ)) ^ 40 *
        (∑' p : ℕ, if Nat.Prime p ∧ ¬ p ∣ presievingModulus 𝓗 x
          then 1 / (p : ℝ) ^ 2 else 0)) atTop (nhds 0) := by
    have h := ((hm.pow 40).mul ht).const_mul
      ((51200 * Real.exp 1) * (M ^ 2 * N ^ 2))
    simpa only [mul_zero, mul_assoc] using h
  filter_upwards [eventually_gt_atTop (1 : ℝ),
    htSmall.eventually_le_const (by norm_num : (0 : ℝ) < 1),
    heSmall.eventually_le_const hε] with x hx htSmall heSmall
  intro ρ' h W R B P q mass tail
  have hW : 0 < W := presieving_pos 𝓗 x
  have hB : 0 < B := by
    apply mul_pos
    · exact div_pos (by exact_mod_cast Nat.totient_pos.mpr hW) (by exact_mod_cast hW)
    · exact Real.log_pos (Real.one_lt_rpow hx hρ)
  refine ⟨hB, ?_⟩
  intro u z hu hz huBound hzBound Du Dz L C harmonic b error
  let rootA : (P → Bool × Option (Fin 39)) → (Fin 1 → ℕ) :=
    fun σ _ => ∏ p : P, if (σ p).1 then (p : ℕ) else 1
  let rootR : (P → Bool × Option (Fin 39)) → (Fin 39 → ℕ) :=
    fun σ j => ∏ p : P, if (σ p).2 = some j then (p : ℕ) else 1
  let amplitude : (P → Bool × Option (Fin 39)) → ℝ :=
    fun σ => u (rootA σ) * z (rootR σ)
  have hP (p : ℕ) (hp : p ∈ P) : p.Prime :=
    Nat.prime_of_mem_primesLE (Finset.mem_filter.mp hp).1
  have hpW (p : ℕ) (hp : p ∈ P) : ¬ p ∣ W := (Finset.mem_filter.mp hp).2
  have hA : 0 ≤ M * N / B ^ 40 :=
    div_nonneg (mul_nonneg hM hN) (pow_nonneg hB.le _)
  have hamp (σ : P → Bool × Option (Fin 39)) :
      |amplitude σ| ≤ M * N / B ^ 40 := by
    dsimp only [amplitude]
    rw [abs_mul]
    calc
      _ ≤ (N / B) * (M / B ^ 39) :=
        mul_le_mul (huBound (rootA σ)) (hzBound (rootR σ))
          (abs_nonneg _) (div_nonneg hN hB.le)
      _ = M * N / B ^ 40 := by
        field_simp [ne_of_gt hB]
  have hbridge := selberg40_auxiliary_exact_period_bridge
    (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i x κ hx hκ u z hu hz
  rcases hbridge with ⟨_, _, _, _, hmean, hdiag, _, _, _, haffine⟩
  have hmean' :
      (1 / (q : ℝ)) * (∑ n ∈ Finset.range q,
        (L (b + W * n + h i) * C (b + W * n)) ^ 2) =
      ∑ σ : P → Bool × Option (Fin 39), ∑ τ : P → Bool × Option (Fin 39),
        amplitude σ * amplitude τ *
          ∏ p : P, auxiliaryCategoricalGram (p : ℕ) h i (σ p) (τ p) :=
    (haffine b).trans hmean
  have hdiag' :
      (∑ σ : P → Bool × Option (Fin 39), ∑ τ : P → Bool × Option (Fin 39),
        amplitude σ * amplitude τ *
          ∏ p : P, auxiliaryIndependentGram (p : ℕ) i (σ p) (τ p)) = harmonic :=
    hdiag
  have hexponential :
      error ≤ M ^ 2 * N ^ 2 / B ^ 80 * mass ^ 40 *
        (Real.exp (51200 * tail) - 1) := by
    have hf := auxiliary_weighted_tensor_error (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) x i P hP hpW amplitude
      (M * N / B ^ 40) hA hamp
    have hpow : (M * N / B ^ 40) ^ 2 = M ^ 2 * N ^ 2 / B ^ 80 := by
      rw [div_pow, mul_pow, ← pow_mul]
    have hmass :
        (∏ p ∈ P, (1 + 1 / ((p : ℝ) - 1))) = mass :=
      (harmonic_fragment_mass_eq_product W R κ).symm
    rw [hpow, hmass] at hf
    change |(1 / (q : ℝ)) * (∑ n ∈ Finset.range q,
      (L (b + W * n + h i) * C (b + W * n)) ^ 2) - harmonic| ≤ _
    rw [hmean', ← hdiag']
    exact hf
  have ht0 : 0 ≤ tail := tsum_nonneg fun p : ℕ =>
    ite_nonneg (one_div_nonneg.mpr (sq_nonneg (p : ℝ))) le_rfl
  have ht1 : 51200 * tail ≤ 1 := htSmall
  have hfactor : 0 ≤ M ^ 2 * N ^ 2 / B ^ 80 * mass ^ 40 := by positivity
  have hlinear :
      error ≤ (51200 * Real.exp 1) *
        (M ^ 2 * N ^ 2 / B ^ 80 * mass ^ 40) * tail := by
    calc
      error ≤ M ^ 2 * N ^ 2 / B ^ 80 * mass ^ 40 *
          (Real.exp 1 * (51200 * tail)) :=
        hexponential.trans (mul_le_mul_of_nonneg_left
          (auxiliary_exp_sub_one_le (51200 * tail)
            (mul_nonneg (by norm_num) ht0) ht1) hfactor)
      _ = _ := by ring
  have heBound :
      (51200 * Real.exp 1) * (M ^ 2 * N ^ 2) * (mass / B) ^ 40 * tail ≤ ε :=
    heSmall
  refine ⟨hexponential, hlinear, ?_⟩
  calc
    error ≤ (51200 * Real.exp 1) *
        (M ^ 2 * N ^ 2 / B ^ 80 * mass ^ 40) * tail := hlinear
    _ = ((51200 * Real.exp 1) * (M ^ 2 * N ^ 2) * (mass / B) ^ 40 * tail) /
        B ^ 40 := by
      field_simp [ne_of_gt hB]
    _ ≤ ε / B ^ 40 := div_le_div_of_nonneg_right heBound (pow_nonneg hB.le _)

open Classical in
theorem selberg_square_period_mean
    {ι : Type*} [Fintype ι] (h : ι → ℕ) (hinj : Function.Injective h)
    (D : Finset (ι → ℕ)) (lam : (ι → ℕ) → ℝ) (W q : ℕ) (hq : 0 < q)
    (hD : ∀ d ∈ D,
      Squarefree (∏ i, d i) ∧ Nat.Coprime (∏ i, d i) W ∧ ∀ i, d i ∣ q)
    (hcover : ∀ a b : ι, h a ≠ h b → ∀ p : ℕ,
      p.Prime → p ∣ Nat.dist (h a) (h b) → p ∣ W) :
    (1 / (q : ℝ)) * (∑ n ∈ Finset.range q,
      (∑ d ∈ D, if ∀ i, d i ∣ n + h i then lam d else 0) ^ 2) =
      ∑ d ∈ D, ∑ e ∈ D,
        if ∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b) then
          lam d * lam e / (∏ i, (Nat.lcm (d i) (e i) : ℝ)) else 0 := by
  have hcoordW (d : ι → ℕ) (hd : d ∈ D) (i : ι) : Nat.Coprime (d i) W :=
    Nat.coprime_fintype_prod_left_iff.mp (hD d hd).2.1 i
  have hcoord0 (d : ι → ℕ) (hd : d ∈ D) (i : ι) : d i ≠ 0 :=
    ((hD d hd).1.squarefree_of_dvd
      (Finset.dvd_prod_of_mem d (Finset.mem_univ i))).ne_zero
  have hcross (d : ι → ℕ) (hd : d ∈ D) (e : ι → ℕ) (n : ℕ)
      (hnd : ∀ i, d i ∣ n + h i) (hne : ∀ i, e i ∣ n + h i) :
      ∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b) := by
    intro a b hab
    by_contra hc
    obtain ⟨p, hp, hpa, hpb⟩ := Nat.Prime.not_coprime_iff_dvd.mp hc
    have hpa' := dvd_trans hpa (hnd a)
    have hpb' := dvd_trans hpb (hne b)
    have hdist : p ∣ Nat.dist (h a) (h b) := by
      rw [← Nat.dist_add_add_left n, Nat.dist]
      exact dvd_add (Nat.dvd_sub hpa' hpb') (Nat.dvd_sub hpb' hpa')
    have hpW := hcover a b (fun hh => hab (hinj hh)) p hp hdist
    exact (hp.coprime_iff_not_dvd.mp
      (Nat.Coprime.of_dvd_left hpa (hcoordW d hd a))) hpW
  have hneg (m t n : ℕ) (hm : 0 < m) :
      Nat.ModEq m n (m - t % m) ↔ m ∣ n + t := by
    have hres : Nat.ModEq m (m - t % m + t) 0 := by
      have ht := (Nat.mod_modEq t m).add_left (m - t % m)
      rw [Nat.sub_add_cancel (Nat.mod_lt t hm).le] at ht
      exact ht.symm.trans (Nat.modEq_zero_iff_dvd.mpr (dvd_refl m))
    constructor
    · intro hn
      exact Nat.modEq_zero_iff_dvd.mp ((hn.add_right t).trans hres)
    · intro hn
      exact Nat.ModEq.add_right_cancel' t
        ((Nat.modEq_zero_iff_dvd.mpr hn).trans hres.symm)
  have hcrt (d : ι → ℕ) (hd : d ∈ D) (e : ι → ℕ) (he : e ∈ D)
      (hc : ∀ i j : ι, i ≠ j → Nat.Coprime (d i) (e j)) :
      (∏ i, Nat.lcm (d i) (e i)) ∣ q ∧
        ∃ c : ℕ, ∀ n : ℕ,
          Nat.ModEq (∏ i, Nat.lcm (d i) (e i)) n c ↔
            (∀ i, d i ∣ n + h i) ∧ (∀ i, e i ∣ n + h i) := by
    let m : ι → ℕ := fun i => Nat.lcm (d i) (e i)
    let a : ι → ℕ := fun i => m i - h i % m i
    let l := (Finset.univ : Finset ι).toList
    have hpos (i : ι) : 0 < m i :=
      Nat.pos_of_ne_zero (Nat.lcm_ne_zero (hcoord0 d hd i) (hcoord0 e he i))
    have hss (i j : ι) (hij : i ≠ j) : Nat.Coprime (m i) (m j) := by
      have h₁ : Nat.Coprime (d i) (d j * e j) :=
        (coprime_of_squarefree_fintype_prod d (hD d hd).1 hij).mul_right (hc i j hij)
      have h₂ : Nat.Coprime (e i) (d j * e j) :=
        ((hc j i hij.symm).symm).mul_right
          (coprime_of_squarefree_fintype_prod e (hD e he).1 hij)
      exact Nat.Coprime.of_dvd (Nat.lcm_dvd_mul _ _) (Nat.lcm_dvd_mul _ _)
        (h₁.mul_left h₂)
    have hmq : (∏ i, m i) ∣ q :=
      Fintype.prod_dvd_of_isRelPrime
        (fun i j hij => Nat.coprime_iff_isRelPrime.mp (hss i j hij))
        (fun i => Nat.lcm_dvd ((hD d hd).2.2 i) ((hD e he).2.2 i))
    have co : l.Pairwise (fun i j => Nat.Coprime (m i) (m j)) := by
      refine ((Finset.univ : Finset ι).nodup_toList).pairwise_of_forall_ne ?_
      intro i _ j _ hij
      exact hss i j hij
    let c : ℕ := Nat.chineseRemainderOfList a m l co
    have hprod : (l.map m).prod = ∏ i, Nat.lcm (d i) (e i) :=
      Finset.prod_map_toList Finset.univ m
    have hclass (n : ℕ) :
        Nat.ModEq (∏ i, Nat.lcm (d i) (e i)) n c ↔
          ∀ i, Nat.ModEq (m i) n (a i) := by
      rw [← hprod]
      change Nat.ModEq (l.map m).prod n
        (Nat.chineseRemainderOfList a m l co : ℕ) ↔ _
      constructor
      · intro hn i
        have hi : i ∈ l := by simp [l]
        exact ((Nat.modEq_list_map_prod_iff co).mp hn i hi).trans
          ((Nat.chineseRemainderOfList a m l co).property i hi)
      · intro hn
        exact Nat.chineseRemainderOfList_modEq_unique a m l co (fun i _ => hn i)
    refine ⟨hmq, c, ?_⟩
    intro n
    rw [hclass]
    constructor
    · intro hn
      constructor
      · intro i
        exact (Nat.lcm_dvd_iff.mp ((hneg _ _ _ (hpos i)).mp (hn i))).1
      · intro i
        exact (Nat.lcm_dvd_iff.mp ((hneg _ _ _ (hpos i)).mp (hn i))).2
    · rintro ⟨hdn, hen⟩ i
      exact (hneg _ _ _ (hpos i)).mpr (Nat.lcm_dvd (hdn i) (hen i))
  let C (d e : ι → ℕ) :=
    {n ∈ Finset.range q | (∀ i, d i ∣ n + h i) ∧ (∀ i, e i ∣ n + h i)}.card
  have hcount (d : ι → ℕ) (hd : d ∈ D) (e : ι → ℕ) (he : e ∈ D)
      (hc : ∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b)) :
      (C d e : ℝ) = (q : ℝ) / (∏ i, (Nat.lcm (d i) (e i) : ℝ)) := by
    obtain ⟨hmq, c, hclass⟩ := hcrt d hd e he hc
    have hm : 0 < ∏ i, Nat.lcm (d i) (e i) :=
      Finset.prod_pos fun i _ =>
        Nat.pos_of_ne_zero (Nat.lcm_ne_zero (hcoord0 d hd i) (hcoord0 e he i))
    have hcard : C d e = q / (∏ i, Nat.lcm (d i) (e i)) := by
      dsimp only [C]
      simp_rw [← hclass]
      rw [← Nat.count_eq_card_filter_range]
      simpa only [Nat.mod_eq_zero_of_dvd hmq, Nat.not_lt_zero, ite_false, add_zero] using
        Nat.count_modEq_card q hm c
    rw [hcard, Nat.cast_div_charZero hmq, Nat.cast_prod]
  have hexpand :
      (∑ n ∈ Finset.range q,
        (∑ d ∈ D, if ∀ i, d i ∣ n + h i then lam d else 0) ^ 2) =
        ∑ d ∈ D, ∑ e ∈ D, (C d e : ℝ) * (lam d * lam e) := by
    calc
      _ = ∑ n ∈ Finset.range q, ∑ d ∈ D, ∑ e ∈ D,
          if (∀ i, d i ∣ n + h i) ∧ (∀ i, e i ∣ n + h i)
          then lam d * lam e else 0 := by
        apply Finset.sum_congr rfl
        intro n _
        simp only [pow_two, Finset.sum_mul_sum, ite_mul, mul_ite, mul_zero, zero_mul,
          ← ite_and, and_comm]
      _ = ∑ d ∈ D, ∑ e ∈ D, ∑ n ∈ Finset.range q,
          if (∀ i, d i ∣ n + h i) ∧ (∀ i, e i ∣ n + h i)
          then lam d * lam e else 0 := by
        rw [Finset.sum_comm]
        apply Finset.sum_congr rfl
        intro d _
        exact Finset.sum_comm
      _ = _ := by
        apply Finset.sum_congr rfl
        intro d _
        apply Finset.sum_congr rfl
        intro e _
        rw [← Finset.sum_filter, Finset.sum_const, nsmul_eq_mul]
  rw [hexpand, Finset.mul_sum]
  apply Finset.sum_congr rfl
  intro d hd
  rw [Finset.mul_sum]
  apply Finset.sum_congr rfl
  intro e he
  by_cases hc : ∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b)
  · rw [ite_eq_left hc, hcount d hd e he hc]
    have hqR : (q : ℝ) ≠ 0 := Nat.cast_ne_zero.mpr (ne_of_gt hq)
    calc
      _ = ((1 / (q : ℝ)) * (q : ℝ)) *
          (lam d * lam e / (∏ i, (Nat.lcm (d i) (e i) : ℝ))) := by ring
      _ = _ := by rw [one_div, inv_mul_cancel₀ hqR, one_mul]
  · have hz : C d e = 0 :=
      Finset.card_eq_zero.mpr (Finset.filter_eq_empty_iff.mpr
        (fun n _ hn => hc (hcross d hd e n hn.1 hn.2)))
    simp [hc, hz]

end

section
open Real Finset Filter Asymptotics Topology
open ArithmeticFunction hiding log

open Classical in
theorem selbergCoefficient_l1_le
    {ι : Type*} [Fintype ι] (y : (ι → ℕ) →₀ ℝ) (L : ℕ) (B : ℝ)
    (hy : ∀ r ∈ y.support,
      Squarefree (∏ i, r i) ∧ (∏ i, r i) ≤ L)
    (hB : ∀ r, |y r| ≤ B) :
    let D := y.support.biUnion
      (fun r => Fintype.piFinset (fun i => (r i).divisors))
    (∑ d ∈ D, |selbergCoefficient y d|) ≤
      B * (L : ℝ) *
        (1 + Real.log (L : ℝ)) ^ (2 ^ (Fintype.card ι + 2) - 1) := by
  dsimp only
  let D := y.support.biUnion
    (fun r => Fintype.piFinset (fun i => (r i).divisors))
  let P (r : ι → ℕ) := ∏ i, r i
  have hB0 : 0 ≤ B := (abs_nonneg (y (fun _ => 0))).trans (hB _)
  have hprod (r : ι → ℕ) (s : Finset ι) :
      Squarefree (∏ i ∈ s, r i) →
        (∏ i ∈ s, r i).divisors.card = ∏ i ∈ s, (r i).divisors.card ∧
        (∏ i ∈ s, r i).totient = ∏ i ∈ s, (r i).totient := by
    induction s using Finset.induction_on with
    | empty => simp
    | @insert i s hi ih =>
      intro hs
      rw [Finset.prod_insert hi] at hs
      obtain ⟨hc, _, hs⟩ := Nat.squarefree_mul_iff.mp hs
      simp only [Finset.prod_insert hi, hc.card_divisors_mul, Nat.totient_mul hc,
        (ih hs).1, (ih hs).2, and_self]
  have hpos (r : ι → ℕ) (hr : r ∈ y.support) : 0 < P r :=
    Nat.pos_of_ne_zero (hy r hr).1.ne_zero
  have hphi (r : ι → ℕ) (hr : r ∈ y.support) :
      (∏ i, ((r i).totient : ℝ)) = ((P r).totient : ℝ) := by
    exact_mod_cast (hprod r Finset.univ (hy r hr).1).2.symm
  have hcoeff (d : ι → ℕ) :
      |selbergCoefficient y d| ≤
        ∑ r ∈ y.support, if ∀ i, d i ∣ r i then
          B * (P r : ℝ) / ((P r).totient : ℝ) else 0 := by
    unfold selbergCoefficient Finsupp.sum
    rw [Finset.mul_sum]
    apply (Finset.abs_sum_le_sum_abs _ _).trans
    apply Finset.sum_le_sum
    intro r hr
    by_cases hdr : ∀ i, d i ∣ r i
    · simp only [ite_eq_left hdr]
      rw [← mul_div_assoc, abs_div, abs_mul, abs_mul,
        hphi r hr, Nat.abs_cast]
      have hmu : |(ArithmeticFunction.moebius (P d) : ℝ)| ≤ 1 := by
        exact_mod_cast (ArithmeticFunction.abs_moebius_le_one (n := P d))
      have hpd : P d ≤ P r :=
        Nat.le_of_dvd (hpos r hr) (Finset.prod_dvd_prod_of_dvd d r (fun i _ => hdr i))
      rw [← Nat.cast_prod, Nat.abs_cast]
      apply div_le_div_of_nonneg_right _ (Nat.cast_nonneg _)
      calc
        _ ≤ 1 * (P d : ℝ) * B :=
          mul_le_mul (mul_le_mul_of_nonneg_right hmu (Nat.cast_nonneg _))
            (hB r) (abs_nonneg _) (by positivity)
        _ ≤ 1 * (P r : ℝ) * B :=
          mul_le_mul_of_nonneg_right
            (by simpa only [one_mul] using (Nat.cast_le (α := ℝ)).mpr hpd) hB0
        _ = _ := by ring
    · simp [hdr]
  have hroot (r : ι → ℕ) (hr : r ∈ y.support) :
      (∑ d ∈ D, if ∀ i, d i ∣ r i then
        B * (P r : ℝ) / ((P r).totient : ℝ) else 0) ≤
        B * ((P r).divisors.card : ℝ) ^ 2 := by
    have hf : D.filter (fun d => ∀ i, d i ∣ r i) =
        Fintype.piFinset (fun i => (r i).divisors) := by
      ext d
      simp only [Finset.mem_filter, Fintype.mem_piFinset, Nat.mem_divisors]
      constructor
      · rintro ⟨_, hd⟩ i
        exact ⟨hd i, (ne_zero_of_dvd_ne_zero (hpos r hr).ne'
          (Finset.dvd_prod_of_mem r (Finset.mem_univ i)))⟩
      · intro hd
        refine ⟨Finset.mem_biUnion.mpr
          ⟨r, hr, Fintype.mem_piFinset.mpr (fun i => Nat.mem_divisors.mpr (hd i))⟩,
          fun i => (hd i).1⟩
    rw [← Finset.sum_filter, hf, Finset.sum_const, nsmul_eq_mul,
      Fintype.card_piFinset, ← (hprod r Finset.univ (hy r hr).1).1]
    calc
      _ = B * ((P r : ℝ) / ((P r).totient : ℝ)) *
          ((P r).divisors.card : ℝ) := by ring
      _ ≤ B * ((P r).divisors.card : ℝ) * ((P r).divisors.card : ℝ) :=
        mul_le_mul_of_nonneg_right
          (mul_le_mul_of_nonneg_left
            (div_totient_le_card_divisors (P r)) hB0)
          (Nat.cast_nonneg _)
      _ = _ := by ring
  have hfiber :
      (∑ r ∈ y.support, ((P r).divisors.card : ℝ) ^ 2) ≤
        ∑ n ∈ Finset.Icc 1 L, (n.divisors.card : ℝ) ^ (Fintype.card ι + 2) := by
    have hmap : ∀ r ∈ y.support, P r ∈ Finset.Icc 1 L :=
      fun r hr => Finset.mem_Icc.mpr ⟨hpos r hr, (hy r hr).2⟩
    rw [← Finset.sum_fiberwise_of_maps_to' hmap (fun n => (n.divisors.card : ℝ) ^ 2)]
    apply Finset.sum_le_sum
    intro n hn
    have hn0 : n ≠ 0 := Nat.ne_of_gt (Finset.mem_Icc.mp hn).1
    have hsub : {r ∈ y.support | P r = n} ⊆
        Fintype.piFinset (fun _ : ι => n.divisors) := by
      intro r hr
      apply Fintype.mem_piFinset.mpr
      intro i
      apply Nat.mem_divisors.mpr
      refine ⟨?_, hn0⟩
      rw [← (Finset.mem_filter.mp hr).2]
      exact Finset.dvd_prod_of_mem r (Finset.mem_univ i)
    have hcard :
        ({r ∈ y.support | P r = n}.card : ℝ) ≤
          (n.divisors.card : ℝ) ^ Fintype.card ι := by
      have hh := Finset.card_le_card hsub
      simpa only [Fintype.card_piFinset, Finset.prod_const, Finset.card_univ,
        Nat.cast_pow] using (Nat.cast_le (α := ℝ)).mpr hh
    calc
      _ = ({r ∈ y.support | P r = n}.card : ℝ) * (n.divisors.card : ℝ) ^ 2 := by
        simp
      _ ≤ (n.divisors.card : ℝ) ^ Fintype.card ι * (n.divisors.card : ℝ) ^ 2 :=
        mul_le_mul_of_nonneg_right hcard (sq_nonneg _)
      _ = _ := (pow_add _ _ _).symm
  calc
    _ ≤ ∑ d ∈ D, ∑ r ∈ y.support, if ∀ i, d i ∣ r i then
        B * (P r : ℝ) / ((P r).totient : ℝ) else 0 :=
      Finset.sum_le_sum fun d _ => hcoeff d
    _ = ∑ r ∈ y.support, ∑ d ∈ D, if ∀ i, d i ∣ r i then
        B * (P r : ℝ) / ((P r).totient : ℝ) else 0 := Finset.sum_comm
    _ ≤ ∑ r ∈ y.support, B * ((P r).divisors.card : ℝ) ^ 2 :=
      Finset.sum_le_sum hroot
    _ = B * ∑ r ∈ y.support, ((P r).divisors.card : ℝ) ^ 2 :=
      (Finset.mul_sum _ _ _).symm
    _ ≤ B * ∑ n ∈ Finset.Icc 1 L,
        (n.divisors.card : ℝ) ^ (Fintype.card ι + 2) :=
      mul_le_mul_of_nonneg_left hfiber hB0
    _ ≤ _ := by
      simpa only [mul_assoc] using mul_le_mul_of_nonneg_left
        (sum_card_divisors_pow_le_mul_log_pow
          (Fintype.card ι + 2) L) hB0

open Classical in
theorem selberg_forward_inverse
    {ι : Type*} [Fintype ι] (y : (ι → ℕ) →₀ ℝ)
    (hy : ∀ r ∈ y.support, Squarefree (∏ i, r i)) (r : ι → ℕ) :
    let D := y.support.biUnion
      (fun s => Fintype.piFinset (fun i => (s i).divisors))
    (ArithmeticFunction.moebius (∏ i, r i) : ℝ) *
        (∏ i, ((r i).totient : ℝ)) *
        (∑ d ∈ D, if ∀ i, r i ∣ d i then
          selbergCoefficient y d / (∏ i, (d i : ℝ)) else 0) = y r := by
  intro D
  have hmuSum (n : ℕ) :
      (∑ a ∈ n.divisors, (ArithmeticFunction.moebius a : ℝ)) =
        if n = 1 then 1 else 0 := by
    simpa only [ArithmeticFunction.coe_mul_zeta_apply, ArithmeticFunction.one_apply,
      ArithmeticFunction.intCoe_apply] using
      congrArg (fun f : ArithmeticFunction ℝ => f n)
        (ArithmeticFunction.coe_moebius_mul_coe_zeta (R := ℝ))
  have hscalar (e : ℕ) (he : Squarefree e) (a : ℕ) :
      (∑ d ∈ e.divisors, if a ∣ d then (ArithmeticFunction.moebius d : ℝ) else 0) =
        if a = e then (ArithmeticFunction.moebius a : ℝ) else 0 := by
    by_cases hae : a ∣ e
    · have ha0 : a ≠ 0 := ne_zero_of_dvd_ne_zero he.ne_zero hae
      have hq0 : e / a ≠ 0 :=
        (Nat.div_pos (Nat.le_of_dvd he.ne_zero.bot_lt hae) ha0.bot_lt).ne'
      have hset : e.divisors.filter (a ∣ ·) = (e / a).divisors.image (a * ·) := by
        ext d
        simp only [Finset.mem_filter, Nat.mem_divisors, Finset.mem_image]
        constructor
        · rintro ⟨⟨hde, _⟩, had⟩
          exact ⟨d / a, ⟨Nat.div_dvd_div had hde, hq0⟩, Nat.mul_div_cancel' had⟩
        · rintro ⟨b, ⟨hb, _⟩, rfl⟩
          refine ⟨⟨?_, he.ne_zero⟩, dvd_mul_right a b⟩
          rw [← Nat.mul_div_cancel' hae]
          exact Nat.mul_dvd_mul_left a hb
      have hcop : Nat.Coprime a (e / a) := by
        apply Nat.coprime_of_squarefree_mul
        rwa [Nat.mul_div_cancel' hae]
      rw [← Finset.sum_filter, hset, Finset.sum_image]
      · calc
          (∑ b ∈ (e / a).divisors, (ArithmeticFunction.moebius (a * b) : ℝ)) =
              ∑ b ∈ (e / a).divisors,
                (ArithmeticFunction.moebius a : ℝ) * ArithmeticFunction.moebius b := by
            apply Finset.sum_congr rfl
            intro b hb
            rw [ArithmeticFunction.isMultiplicative_moebius.map_mul_of_coprime
              (hcop.of_dvd_right (Nat.dvd_of_mem_divisors hb)), Int.cast_mul]
          _ = (ArithmeticFunction.moebius a : ℝ) * (if e / a = 1 then 1 else 0) := by
            rw [← Finset.mul_sum, hmuSum]
          _ = if a = e then (ArithmeticFunction.moebius a : ℝ) else 0 := by
            by_cases h : a = e
            · subst e
              simp [Nat.div_self ha0.bot_lt]
            · have hq : e / a ≠ 1 := fun hq => h (Nat.eq_of_dvd_of_div_eq_one hae hq)
              simp [h, hq]
      · exact fun _ _ _ _ => mul_left_cancel₀ ha0
    · have hne : a ≠ e := by
        rintro rfl
        exact hae dvd_rfl
      rw [ite_eq_right hne]
      apply Finset.sum_eq_zero
      intro d hd
      exact ite_eq_right (fun had => hae (had.trans (Nat.dvd_of_mem_divisors hd)))
  have hmuProd (d : ι → ℕ) (hd : Squarefree (∏ i, d i)) :
      (ArithmeticFunction.moebius (∏ i, d i) : ℝ) =
        ∏ i, (ArithmeticFunction.moebius (d i) : ℝ) := by
    exact_mod_cast ArithmeticFunction.IsMultiplicative.map_prod d
      ArithmeticFunction.isMultiplicative_moebius Finset.univ
      (fun i _ j _ hij => coprime_of_squarefree_fintype_prod d hd hij)
  have hbox (s : ι → ℕ) (hs : Squarefree (∏ i, s i)) :
      (∑ d ∈ Fintype.piFinset (fun i => (s i).divisors),
        if ∀ i, r i ∣ d i then (ArithmeticFunction.moebius (∏ i, d i) : ℝ) else 0) =
          if r = s then (ArithmeticFunction.moebius (∏ i, r i) : ℝ) else 0 := by
    calc
      _ = ∑ d ∈ Fintype.piFinset (fun i => (s i).divisors),
          ∏ i, if r i ∣ d i then (ArithmeticFunction.moebius (d i) : ℝ) else 0 := by
        apply Finset.sum_congr rfl
        intro d hd
        have hds : ∀ i, d i ∣ s i := fun i =>
          Nat.dvd_of_mem_divisors (Fintype.mem_piFinset.mp hd i)
        rw [hmuProd d (hs.squarefree_of_dvd (Finset.prod_dvd_prod_of_dvd d s
          (fun i _ => hds i))), Fintype.prod_ite_zero]
      _ = ∏ i, ∑ d ∈ (s i).divisors,
          if r i ∣ d then (ArithmeticFunction.moebius d : ℝ) else 0 :=
        (Finset.prod_univ_sum (fun i => (s i).divisors)
          (fun i d => if r i ∣ d then (ArithmeticFunction.moebius d : ℝ) else 0)).symm
      _ = ∏ i, if r i = s i then (ArithmeticFunction.moebius (r i) : ℝ) else 0 := by
        apply Finset.prod_congr rfl
        intro i hi
        exact hscalar (s i) (hs.squarefree_of_dvd
          (Finset.dvd_prod_of_mem s (Finset.mem_univ i))) (r i)
      _ = if r = s then (ArithmeticFunction.moebius (∏ i, r i) : ℝ) else 0 := by
        simp only [Fintype.prod_ite_zero, ← funext_iff]
        split_ifs with hrs
        · subst s
          exact (hmuProd r hs).symm
        · rfl
  have hforward :
      (∑ d ∈ D, if ∀ i, r i ∣ d i then
        selbergCoefficient y d / (∏ i, (d i : ℝ)) else 0) =
      (ArithmeticFunction.moebius (∏ i, r i) : ℝ) * y r /
        (∏ i, ((r i).totient : ℝ)) := by
    calc
      _ = ∑ d ∈ D, ∑ s ∈ y.support,
          (if (∀ i, r i ∣ d i) ∧ (∀ i, d i ∣ s i) then
            (ArithmeticFunction.moebius (∏ i, d i) : ℝ) else 0) *
              (y s / (∏ i, ((s i).totient : ℝ))) := by
        apply Finset.sum_congr rfl
        intro d hd
        have hprod : (∏ i, (d i : ℝ)) ≠ 0 := by
          obtain ⟨s, hs, hds⟩ := Finset.mem_biUnion.mp hd
          exact_mod_cast ((hy s hs).squarefree_of_dvd (Finset.prod_dvd_prod_of_dvd d s
            (fun i _ => Nat.dvd_of_mem_divisors (Fintype.mem_piFinset.mp hds i)))).ne_zero
        rw [selbergCoefficient, mul_right_comm, mul_div_cancel_right₀ _ hprod, Finsupp.sum]
        by_cases hrd : ∀ i, r i ∣ d i <;>
          simp [hrd, Finset.mul_sum, mul_ite, ite_mul]
      _ = ∑ s ∈ y.support, ∑ d ∈ D,
          (if (∀ i, r i ∣ d i) ∧ (∀ i, d i ∣ s i) then
            (ArithmeticFunction.moebius (∏ i, d i) : ℝ) else 0) *
              (y s / (∏ i, ((s i).totient : ℝ))) := Finset.sum_comm
      _ = ∑ s ∈ y.support,
          (if r = s then (ArithmeticFunction.moebius (∏ i, r i) : ℝ) else 0) *
            (y s / (∏ i, ((s i).totient : ℝ))) := by
        apply Finset.sum_congr rfl
        intro s hs
        rw [← Finset.sum_mul]
        congr 1
        have hset : D.filter (fun d => ∀ i, d i ∣ s i) =
            Fintype.piFinset (fun i => (s i).divisors) := by
          ext d
          simp only [Finset.mem_filter, Fintype.mem_piFinset, Nat.mem_divisors]
          constructor
          · rintro ⟨_, hds⟩ i
            exact ⟨hds i, ((hy s hs).squarefree_of_dvd
              (Finset.dvd_prod_of_mem s (Finset.mem_univ i))).ne_zero⟩
          · intro hds
            refine ⟨Finset.mem_biUnion.mpr ⟨s, hs, ?_⟩, fun i => (hds i).1⟩
            exact Fintype.mem_piFinset.mpr fun i => Nat.mem_divisors.mpr (hds i)
        calc
          _ = ∑ d ∈ Fintype.piFinset (fun i => (s i).divisors),
              if ∀ i, r i ∣ d i then (ArithmeticFunction.moebius (∏ i, d i) : ℝ) else 0 := by
            rw [← hset, Finset.sum_filter]
            simp only [← ite_and, and_comm]
          _ = _ := hbox s (hy s hs)
      _ = _ := by
        simp only [ite_mul, zero_mul, Finset.sum_ite_eq]
        split_ifs with hr
        · ring
        · simp [Finsupp.notMem_support_iff.mp hr]
  rw [hforward]
  by_cases hyr : y r = 0
  · simp [hyr]
  have hsr := hy r (Finsupp.mem_support_iff.mpr hyr)
  have hphi : (∏ i, ((r i).totient : ℝ)) ≠ 0 := by
    apply Finset.prod_ne_zero_iff.mpr
    intro i hi
    have hri := (hsr.squarefree_of_dvd (Finset.dvd_prod_of_mem r hi)).ne_zero
    exact_mod_cast (Nat.totient_pos.mpr hri.bot_lt).ne'
  have hmu : (ArithmeticFunction.moebius (∏ i, r i) : ℝ) ^ 2 = 1 := by
    exact_mod_cast ArithmeticFunction.moebius_sq_eq_one_of_squarefree hsr
  calc
    _ = (ArithmeticFunction.moebius (∏ i, r i) : ℝ) ^ 2 * y r := by
      field_simp
    _ = y r := by rw [hmu, one_mul]

open Classical in
theorem selberg_square_real_interval_crt
    {ι : Type*} [Fintype ι] (h : ι → ℕ) (hinj : Function.Injective h)
    (D : Finset (ι → ℕ)) (lam : (ι → ℕ) → ℝ)
    (W v : ℕ) (hW : 0 < W)
    (hD : ∀ d ∈ D,
      Squarefree (∏ i, d i) ∧ Nat.Coprime (∏ i, d i) W)
    (hcover : ∀ a b : ι, h a ≠ h b → ∀ p : ℕ,
      p.Prime → p ∣ Nat.dist (h a) (h b) → p ∣ W)
    (x : ℝ) (hx : 0 ≤ x) :
    |(∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        if Nat.ModEq W n v then
          (∑ d ∈ D, if ∀ i, d i ∣ n + h i then lam d else 0) ^ 2
        else 0) -
      x / (W : ℝ) *
        (∑ d ∈ D, ∑ e ∈ D,
          if ∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b) then
            lam d * lam e / (∏ i, (Nat.lcm (d i) (e i) : ℝ))
          else 0)| ≤
      2 * (∑ d ∈ D, ∑ e ∈ D,
        if ∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b) then
          |lam d * lam e| else 0) := by
  let I := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
  have hinterval (a b q c : ℕ) (hab : a ≤ b) (hq : 0 < q) :
      |({n ∈ Finset.Ico a b | Nat.ModEq q n c}.card : ℝ) -
        ((b : ℝ) - a) / q| ≤ 1 := by
    let u : ℚ := ((b : ℚ) - c) / q
    let v : ℚ := ((a : ℚ) - c) / q
    have hqQ : (0 : ℚ) < q := by exact_mod_cast hq
    have hvu : v ≤ u := by
      dsimp [u, v]
      exact div_le_div_of_nonneg_right
        (sub_le_sub_right (by exact_mod_cast hab) _) hqQ.le
    have hdiff : 0 ≤ (⌈u⌉ : ℤ) - ⌈v⌉ := sub_nonneg.mpr (Int.ceil_mono hvu)
    have hcardZ :
        ({n ∈ Finset.Ico a b | Nat.ModEq q n c}.card : ℤ) =
          (⌈u⌉ : ℤ) - ⌈v⌉ := by
      simpa [u, v, max_eq_left hdiff] using Nat.Ico_filter_modEq_card a b hq c
    have hcardR :
        ({n ∈ Finset.Ico a b | Nat.ModEq q n c}.card : ℝ) =
          (((⌈u⌉ : ℤ) - ⌈v⌉ : ℤ) : ℝ) := by exact_mod_cast hcardZ
    have herr : |((⌈u⌉ : ℚ) - ⌈v⌉) - (u - v)| ≤ 1 := by
      rw [abs_le]
      constructor <;>
        linarith [Int.le_ceil u, Int.ceil_lt_add_one u, Int.le_ceil v, Int.ceil_lt_add_one v]
    have herrR :
        |(((⌈u⌉ : ℤ) - ⌈v⌉ : ℤ) : ℝ) - ((u - v : ℚ) : ℝ)| ≤ 1 := by
      exact_mod_cast herr
    have huv : ((u - v : ℚ) : ℝ) = ((b : ℝ) - a) / q := by
      dsimp [u, v]
      push_cast
      ring
    rw [hcardR, ← huv]
    exact herrR
  have hrealcount (q c : ℕ) (hq : 0 < q) :
      |({n ∈ I | Nat.ModEq q n c}.card : ℝ) - x / q| ≤ 2 := by
    let a := ⌈x⌉₊
    let b := ⌊2 * x⌋₊ + 1
    have hab : a ≤ b :=
      (Nat.ceil_le_floor_add_one x).trans
        (Nat.add_le_add_right (Nat.floor_mono (by linarith)) 1)
    have hlen : |((b : ℝ) - a) - x| ≤ 1 := by
      have hfl := Nat.floor_le (show 0 ≤ 2 * x by linarith)
      have hfu := Nat.lt_floor_add_one (2 * x)
      have hcl := Nat.le_ceil x
      have hcu := Nat.ceil_lt_add_one hx
      dsimp [a, b]
      push_cast
      rw [abs_le]
      constructor <;> linarith
    have hc : |({n ∈ I | Nat.ModEq q n c}.card : ℝ) -
        ((b : ℝ) - a) / q| ≤ 1 := by
      simpa [a, b, I, Finset.Ico_add_one_right_eq_Icc] using hinterval a b q c hab hq
    have hqR : (0 : ℝ) < q := by exact_mod_cast hq
    calc
      _ = |(({n ∈ I | Nat.ModEq q n c}.card : ℝ) - ((b : ℝ) - a) / q) +
          (((b : ℝ) - a) - x) / q| := congrArg abs (by ring)
      _ ≤ |({n ∈ I | Nat.ModEq q n c}.card : ℝ) - ((b : ℝ) - a) / q| +
          |(((b : ℝ) - a) - x) / q| := abs_add_le _ _
      _ ≤ 1 + 1 := add_le_add hc (by
        rw [abs_div, abs_of_pos hqR]
        exact (div_le_one hqR).mpr
          (hlen.trans (by exact_mod_cast (show 1 ≤ q from hq))))
      _ = 2 := by norm_num
  have hcoordW (d : ι → ℕ) (hd : d ∈ D) (i : ι) :
      Nat.Coprime (d i) W :=
    Nat.coprime_fintype_prod_left_iff.mp (hD d hd).2 i
  have hcross (d : ι → ℕ) (hd : d ∈ D) (e : ι → ℕ)
      (n : ℕ) (hnd : ∀ i, d i ∣ n + h i) (hne : ∀ i, e i ∣ n + h i) :
      ∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b) := by
    intro a b hab
    by_contra hc
    obtain ⟨p, hp, hpa, hpb⟩ := Nat.Prime.not_coprime_iff_dvd.mp hc
    have hpa' := dvd_trans hpa (hnd a)
    have hpb' := dvd_trans hpb (hne b)
    have hdist : p ∣ Nat.dist (h a) (h b) := by
      rw [← Nat.dist_add_add_left n, Nat.dist]
      exact dvd_add (Nat.dvd_sub hpa' hpb') (Nat.dvd_sub hpb' hpa')
    have hpW := hcover a b (fun hh => hab (hinj hh)) p hp hdist
    exact (hp.coprime_iff_not_dvd.mp
      (Nat.Coprime.of_dvd_left hpa (hcoordW d hd a))) hpW
  have hcoord0 (d : ι → ℕ) (hd : d ∈ D) (i : ι) : d i ≠ 0 :=
    ((hD d hd).1.squarefree_of_dvd
      (Finset.dvd_prod_of_mem d (Finset.mem_univ i))).ne_zero
  have hneg (m t n : ℕ) (hm : 0 < m) :
      Nat.ModEq m n (m - t % m) ↔ m ∣ n + t := by
    have hres : Nat.ModEq m (m - t % m + t) 0 := by
      have ht := (Nat.mod_modEq t m).add_left (m - t % m)
      rw [Nat.sub_add_cancel (Nat.mod_lt t hm).le] at ht
      exact ht.symm.trans (Nat.modEq_zero_iff_dvd.mpr (dvd_refl m))
    constructor
    · intro hn
      exact Nat.modEq_zero_iff_dvd.mp ((hn.add_right t).trans hres)
    · intro hn
      exact Nat.ModEq.add_right_cancel' t
        ((Nat.modEq_zero_iff_dvd.mpr hn).trans hres.symm)
  have hcrt (d : ι → ℕ) (hd : d ∈ D) (e : ι → ℕ) (he : e ∈ D)
      (hc : ∀ i j : ι, i ≠ j → Nat.Coprime (d i) (e j)) :
      ∃ c : ℕ, ∀ n : ℕ,
        Nat.ModEq (W * ∏ i, Nat.lcm (d i) (e i)) n c ↔
          Nat.ModEq W n v ∧ (∀ i, d i ∣ n + h i) ∧
            (∀ i, e i ∣ n + h i) := by
    let s : Option ι → ℕ
      | none => W
      | some i => Nat.lcm (d i) (e i)
    let a : Option ι → ℕ
      | none => v
      | some i => Nat.lcm (d i) (e i) - h i % Nat.lcm (d i) (e i)
    let l := (Finset.univ : Finset (Option ι)).toList
    have hpos (i : ι) : 0 < Nat.lcm (d i) (e i) :=
      Nat.pos_of_ne_zero (Nat.lcm_ne_zero (hcoord0 d hd i) (hcoord0 e he i))
    have hWs (i : ι) : Nat.Coprime W (s (some i)) := by
      change Nat.Coprime W (Nat.lcm (d i) (e i))
      exact Nat.Coprime.of_dvd_right (Nat.lcm_dvd_mul _ _)
        ((hcoordW d hd i).symm.mul_right (hcoordW e he i).symm)
    have hss (i j : ι) (hij : i ≠ j) :
        Nat.Coprime (s (some i)) (s (some j)) := by
      have h₁ : Nat.Coprime (d i) (d j * e j) :=
        (coprime_of_squarefree_fintype_prod d (hD d hd).1 hij).mul_right (hc i j hij)
      have h₂ : Nat.Coprime (e i) (d j * e j) :=
        ((hc j i hij.symm).symm).mul_right
          (coprime_of_squarefree_fintype_prod e (hD e he).1 hij)
      exact Nat.Coprime.of_dvd (Nat.lcm_dvd_mul _ _) (Nat.lcm_dvd_mul _ _)
        (h₁.mul_left h₂)
    have co : l.Pairwise (fun u z => Nat.Coprime (s u) (s z)) := by
      change ((Finset.univ : Finset (Option ι)).toList).Pairwise _
      refine ((Finset.univ : Finset (Option ι)).nodup_toList).pairwise_of_forall_ne ?_
      intro u hu z hz huz
      cases u with
      | none =>
        cases z with
        | none => exact (huz rfl).elim
        | some j => exact hWs j
      | some i =>
        cases z with
        | none => exact (hWs i).symm
        | some j => exact hss i j (by simpa using huz)
    let c : ℕ := Nat.chineseRemainderOfList a s l co
    have hprod : (l.map s).prod = W * ∏ i, Nat.lcm (d i) (e i) := by
      dsimp [l]
      rw [Finset.prod_map_toList, Fintype.prod_option]
    have hcrtOption (n : ℕ) :
        Nat.ModEq (W * ∏ i, Nat.lcm (d i) (e i)) n c ↔
          ∀ o : Option ι, Nat.ModEq (s o) n (a o) := by
      rw [← hprod]
      change Nat.ModEq (l.map s).prod n
        (Nat.chineseRemainderOfList a s l co : ℕ) ↔ _
      constructor
      · intro hn o
        have ho : o ∈ l := by simp [l]
        exact ((Nat.modEq_list_map_prod_iff co).mp hn o ho).trans
          ((Nat.chineseRemainderOfList a s l co).property o ho)
      · intro hn
        exact Nat.chineseRemainderOfList_modEq_unique a s l co
          (fun o _ => hn o)
    refine ⟨c, ?_⟩
    intro n
    rw [hcrtOption]
    constructor
    · intro hn
      refine ⟨hn none, ?_, ?_⟩
      · intro i
        exact (Nat.lcm_dvd_iff.mp ((hneg _ _ _ (hpos i)).mp (hn (some i)))).1
      · intro i
        exact (Nat.lcm_dvd_iff.mp ((hneg _ _ _ (hpos i)).mp (hn (some i)))).2
    · rintro ⟨hn, hdn, hen⟩ o
      cases o with
      | none => exact hn
      | some i =>
        exact (hneg _ _ _ (hpos i)).mpr (Nat.lcm_dvd (hdn i) (hen i))
  let C (d e : ι → ℕ) :=
    {n ∈ I | Nat.ModEq W n v ∧ (∀ i, d i ∣ n + h i) ∧
      (∀ i, e i ∣ n + h i)}.card
  have hcount (d : ι → ℕ) (hd : d ∈ D) (e : ι → ℕ) (he : e ∈ D)
      (hc : ∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b)) :
      |(C d e : ℝ) - x / ((W * ∏ i, Nat.lcm (d i) (e i) : ℕ) : ℝ)| ≤ 2 := by
    obtain ⟨c, hclass⟩ := hcrt d hd e he hc
    have hq : 0 < W * ∏ i, Nat.lcm (d i) (e i) := by
      apply Nat.mul_pos hW
      exact Finset.prod_pos fun i _ =>
        Nat.pos_of_ne_zero (Nat.lcm_ne_zero (hcoord0 d hd i) (hcoord0 e he i))
    simpa only [C, ← hclass] using hrealcount _ c hq
  have hexpand :
      (∑ n ∈ I, if Nat.ModEq W n v then
        (∑ d ∈ D, if ∀ i, d i ∣ n + h i then lam d else 0) ^ 2 else 0) =
      ∑ d ∈ D, ∑ e ∈ D, (C d e : ℝ) * (lam d * lam e) := by
    calc
      _ = ∑ n ∈ I, ∑ d ∈ D, ∑ e ∈ D,
          if Nat.ModEq W n v ∧ (∀ i, d i ∣ n + h i) ∧
            (∀ i, e i ∣ n + h i) then lam d * lam e else 0 := by
        apply Finset.sum_congr rfl
        intro n _
        by_cases hn : Nat.ModEq W n v
        · simp only [hn, ite_true, pow_two, Finset.sum_mul_sum]
          simp only [ite_mul, mul_ite, mul_zero, zero_mul, ← ite_and, true_and, and_comm]
        · simp [hn]
      _ = ∑ d ∈ D, ∑ e ∈ D, ∑ n ∈ I,
          if Nat.ModEq W n v ∧ (∀ i, d i ∣ n + h i) ∧
            (∀ i, e i ∣ n + h i) then lam d * lam e else 0 := by
        rw [Finset.sum_comm]
        apply Finset.sum_congr rfl
        intro d _
        exact Finset.sum_comm
      _ = _ := by
        apply Finset.sum_congr rfl
        intro d _
        apply Finset.sum_congr rfl
        intro e _
        rw [← Finset.sum_filter, Finset.sum_const, nsmul_eq_mul]
  have hpair (d : ι → ℕ) (hd : d ∈ D) (e : ι → ℕ) (he : e ∈ D) :
      |(C d e : ℝ) * (lam d * lam e) - x / (W : ℝ) *
        (if ∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b) then
          lam d * lam e / (∏ i, (Nat.lcm (d i) (e i) : ℝ)) else 0)| ≤
      2 * (if ∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b) then
        |lam d * lam e| else 0) := by
    by_cases hc : ∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b)
    · simp only [ite_eq_left hc]
      have hf :
          (C d e : ℝ) * (lam d * lam e) - x / (W : ℝ) *
            (lam d * lam e / (∏ i, (Nat.lcm (d i) (e i) : ℝ))) =
          ((C d e : ℝ) - x / ((W * ∏ i, Nat.lcm (d i) (e i) : ℕ) : ℝ)) *
            (lam d * lam e) := by
        push_cast
        simp only [div_eq_mul_inv, mul_inv_rev]
        ring
      rw [hf, abs_mul]
      exact mul_le_mul_of_nonneg_right (hcount d hd e he hc) (abs_nonneg _)
    · have hz : C d e = 0 :=
        Finset.card_eq_zero.mpr (Finset.filter_eq_empty_iff.mpr
          (fun n _ hn => hc (hcross d hd e n hn.2.1 hn.2.2)))
      simp [hc, hz]
  change |(∑ n ∈ I, if Nat.ModEq W n v then
      (∑ d ∈ D, if ∀ i, d i ∣ n + h i then lam d else 0) ^ 2 else 0) -
      x / (W : ℝ) * _| ≤ _
  rw [hexpand, Finset.mul_sum]
  simp_rw [Finset.mul_sum, ← Finset.sum_sub_distrib]
  calc
    _ ≤ ∑ d ∈ D, ∑ e ∈ D,
        |(C d e : ℝ) * (lam d * lam e) - x / (W : ℝ) *
          (if ∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b) then
            lam d * lam e / (∏ i, (Nat.lcm (d i) (e i) : ℝ)) else 0)| :=
      (Finset.abs_sum_le_sum_abs _ _).trans
        (Finset.sum_le_sum fun _ _ => Finset.abs_sum_le_sum_abs _ _)
    _ ≤ ∑ d ∈ D, ∑ e ∈ D,
        2 * (if ∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b) then
          |lam d * lam e| else 0) :=
      Finset.sum_le_sum fun d hd => Finset.sum_le_sum fun e he => hpair d hd e he

open Classical in
theorem div_prod_lcm_eq_sum_totient_mul
    {ι : Type*} [Fintype ι] (E : Finset (ι → ℕ)) (d e : ι → ℕ)
    (hd : ∀ i, 0 < d i)
    (hE : ∀ u : ι → ℕ, (∀ i, u i ∣ d i) → u ∈ E)
    (a b : ℝ) :
    a * b / (∏ i, (Nat.lcm (d i) (e i) : ℝ)) =
      ∑ u ∈ E, if (∀ i, u i ∣ d i) ∧ (∀ i, u i ∣ e i) then
        (∏ i, ((u i).totient : ℝ)) *
          (a / (∏ i, (d i : ℝ))) * (b / (∏ i, (e i : ℝ)))
      else 0 := by
  have hbox :
      E.filter (fun u => (∀ i, u i ∣ d i) ∧ (∀ i, u i ∣ e i)) =
        Fintype.piFinset (fun i => (Nat.gcd (d i) (e i)).divisors) := by
    ext u
    simp only [Finset.mem_filter, Fintype.mem_piFinset, Nat.mem_divisors]
    constructor
    · rintro ⟨_, hud, hue⟩ i
      exact ⟨Nat.dvd_gcd (hud i) (hue i), (Nat.gcd_pos_of_pos_left (e i) (hd i)).ne'⟩
    · intro hu
      have hud : ∀ i, u i ∣ d i := fun i => (Nat.dvd_gcd_iff.mp (hu i).1).1
      exact ⟨hE u hud, hud, fun i => (Nat.dvd_gcd_iff.mp (hu i).1).2⟩
  have hphisum :
      (∑ u ∈ E, if (∀ i, u i ∣ d i) ∧ (∀ i, u i ∣ e i) then
        (∏ i, ((u i).totient : ℝ)) else 0) = ∏ i, (Nat.gcd (d i) (e i) : ℝ) := by
    rw [← Finset.sum_filter, hbox,
      ← Finset.prod_univ_sum (fun i => (Nat.gcd (d i) (e i)).divisors)
        (fun _ n => (n.totient : ℝ))]
    apply Finset.prod_congr rfl
    intro i hi
    exact_mod_cast Nat.sum_totient (Nat.gcd (d i) (e i))
  have hG : (∏ i, (Nat.gcd (d i) (e i) : ℝ)) ≠ 0 := by
    apply Finset.prod_ne_zero_iff.mpr
    intro i hi
    exact_mod_cast (Nat.gcd_pos_of_pos_left (e i) (hd i)).ne'
  have hprod :
      (∏ i, (Nat.gcd (d i) (e i) : ℝ)) * (∏ i, (Nat.lcm (d i) (e i) : ℝ)) =
        (∏ i, (d i : ℝ)) * (∏ i, (e i : ℝ)) := by
    rw [← Finset.prod_mul_distrib, ← Finset.prod_mul_distrib]
    apply Finset.prod_congr rfl
    intro i hi
    exact_mod_cast Nat.gcd_mul_lcm (d i) (e i)
  calc
    _ = (∏ i, (Nat.gcd (d i) (e i) : ℝ)) * (a * b) /
        ((∏ i, (Nat.gcd (d i) (e i) : ℝ)) * (∏ i, (Nat.lcm (d i) (e i) : ℝ))) :=
      (mul_div_mul_left _ _ hG).symm
    _ = (∏ i, (Nat.gcd (d i) (e i) : ℝ)) *
        (a / (∏ i, (d i : ℝ))) * (b / (∏ i, (e i : ℝ))) := by
      rw [hprod]
      simp only [div_eq_mul_inv, mul_inv]
      ring
    _ = _ := by
      rw [← hphisum]
      simp only [Finset.sum_mul, ite_mul, zero_mul]

open Classical in
theorem selberg_unrestricted_lcm_diagonal
    {ι : Type*} [Fintype ι] (y : (ι → ℕ) →₀ ℝ)
    (hy : ∀ r ∈ y.support, Squarefree (∏ i, r i)) :
    let D := y.support.biUnion
      (fun r => Fintype.piFinset (fun i => (r i).divisors))
    (∑ d ∈ D, ∑ e ∈ D,
      selbergCoefficient y d * selbergCoefficient y e /
        (∏ i, (Nat.lcm (d i) (e i) : ℝ))) =
      y.sum (fun r yr => yr ^ 2 / (∏ i, ((r i).totient : ℝ))) := by
  intro D
  let A (d : ι → ℕ) : ℝ :=
    selbergCoefficient y d / (∏ i, (d i : ℝ))
  let Φ (u : ι → ℕ) : ℝ := ∏ i, ((u i).totient : ℝ)
  have hsf (d : ι → ℕ) (hd : d ∈ D) : Squarefree (∏ i, d i) := by
    obtain ⟨r, hr, hdr⟩ := Finset.mem_biUnion.mp hd
    exact (hy r hr).squarefree_of_dvd
      (Finset.prod_dvd_prod_of_dvd d r fun i _ =>
        Nat.dvd_of_mem_divisors (Fintype.mem_piFinset.mp hdr i))
  have hpos (d : ι → ℕ) (hd : d ∈ D) (i : ι) : 0 < d i :=
    ((hsf d hd).squarefree_of_dvd
      (Finset.dvd_prod_of_mem d (Finset.mem_univ i))).ne_zero.bot_lt
  have hdown (d : ι → ℕ) (hd : d ∈ D)
      (u : ι → ℕ) (hu : ∀ i, u i ∣ d i) : u ∈ D := by
    obtain ⟨r, hr, hdr⟩ := Finset.mem_biUnion.mp hd
    refine Finset.mem_biUnion.mpr ⟨r, hr, Fintype.mem_piFinset.mpr ?_⟩
    intro i
    have hri := Nat.mem_divisors.mp (Fintype.mem_piFinset.mp hdr i)
    exact Nat.mem_divisors.mpr ⟨(hu i).trans hri.1, hri.2⟩
  have hsD : y.support ⊆ D := by
    intro r hr
    refine Finset.mem_biUnion.mpr ⟨r, hr, Fintype.mem_piFinset.mpr ?_⟩
    intro i
    exact Nat.mem_divisors.mpr ⟨dvd_rfl,
      ((hy r hr).squarefree_of_dvd
        (Finset.dvd_prod_of_mem r (Finset.mem_univ i))).ne_zero⟩
  have hkernel (d : ι → ℕ) (hd : d ∈ D) (e : ι → ℕ) :
      selbergCoefficient y d * selbergCoefficient y e /
          (∏ i, (Nat.lcm (d i) (e i) : ℝ)) =
      ∑ u ∈ D,
        if (∀ i, u i ∣ d i) ∧ (∀ i, u i ∣ e i) then
          Φ u * A d * A e else 0 :=
    div_prod_lcm_eq_sum_totient_mul D d e (hpos d hd)
      (fun u hu => hdown d hd u hu) (selbergCoefficient y d) (selbergCoefficient y e)
  have hdiag (u : ι → ℕ) (hu : u ∈ D) :
      Φ u * (∑ d ∈ D, if ∀ i, u i ∣ d i then A d else 0) ^ 2 =
      y u ^ 2 / Φ u := by
    have hφ : Φ u ≠ 0 := by
      apply Finset.prod_ne_zero_iff.mpr
      intro i hi
      exact_mod_cast (Nat.totient_pos.mpr (hpos u hu i)).ne'
    have hμ : (ArithmeticFunction.moebius (∏ i, u i) : ℝ) ^ 2 = 1 := by
      exact_mod_cast ArithmeticFunction.moebius_sq_eq_one_of_squarefree (hsf u hu)
    have hinv := selberg_forward_inverse y hy u
    change (ArithmeticFunction.moebius (∏ i, u i) : ℝ) * Φ u *
      (∑ d ∈ D, if ∀ i, u i ∣ d i then A d else 0) = y u at hinv
    have hsquare := congrArg (fun z : ℝ => z ^ (2 : ℕ)) hinv
    simp only [mul_pow, hμ, one_mul] at hsquare
    apply (eq_div_iff hφ).mpr
    linear_combination hsquare
  calc
    _ = ∑ d ∈ D, ∑ e ∈ D, ∑ u ∈ D,
        if (∀ i, u i ∣ d i) ∧ (∀ i, u i ∣ e i) then
          Φ u * A d * A e else 0 := by
      apply Finset.sum_congr rfl
      intro d hd
      exact Finset.sum_congr rfl (fun e _ => hkernel d hd e)
    _ = ∑ u ∈ D, ∑ d ∈ D, ∑ e ∈ D,
        if (∀ i, u i ∣ d i) ∧ (∀ i, u i ∣ e i) then
          Φ u * A d * A e else 0 := by
      rw [eq_comm, Finset.sum_comm,
        Finset.sum_congr rfl fun _ _ => Finset.sum_comm]
    _ = ∑ u ∈ D,
        Φ u * (∑ d ∈ D, if ∀ i, u i ∣ d i then A d else 0) ^ 2 := by
      apply Finset.sum_congr rfl
      intro u hu
      rw [pow_two, Finset.sum_mul_sum]
      simp only [Finset.mul_sum,
        mul_ite, ite_mul, mul_zero, zero_mul, ← ite_and, and_comm, mul_assoc]
    _ = ∑ u ∈ D, y u ^ 2 / Φ u := Finset.sum_congr rfl hdiag
    _ = y.sum (fun r yr => yr ^ 2 / (∏ i, ((r i).totient : ℝ))) := by
      rw [Finsupp.sum]
      exact (Finset.sum_subset hsD (fun r _ hnot => by
        simp [Φ, Finsupp.notMem_support_iff.mp hnot])).symm

open Classical in
theorem selberg_cross_correction_le
    {ι : Type*} [Fintype ι] (y : (ι → ℕ) →₀ ℝ)
    (L W D₀ : ℕ) (B : ℝ) (hD₀ : 0 < D₀)
    (hsmall : _root_.primorial D₀ ∣ W)
    (hy : ∀ r ∈ y.support,
      Squarefree (∏ i, r i) ∧
        Nat.Coprime (∏ i, r i) W ∧ (∏ i, r i) ≤ L)
    (hB : ∀ r, |y r| ≤ B) :
    let D := y.support.biUnion
      (fun r => Fintype.piFinset (fun i => (r i).divisors))
    let k := Fintype.card ι
    let K := k * (k - 1)
    let M : ℝ := ∑ n ∈ Finset.Icc 1 L,
      if Squarefree n ∧ Nat.Coprime n W then 1 / (n.totient : ℝ) else 0
    |∑ d ∈ D, ∑ e ∈ D,
      if ¬ (∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b)) then
        selbergCoefficient y d * selbergCoefficient y e /
          (∏ i, (Nat.lcm (d i) (e i) : ℝ))
      else 0| ≤
      B ^ 2 *
        ((8 * Real.exp 8 / (D₀ : ℝ)) * (K : ℝ) *
          (Real.exp 8) ^ (K - 1)) * M ^ k := by
  intro D k K M
  let Q : ℕ := L + 1
  let J : Finset (ι × ι) := (Finset.univ : Finset ι).offDiag
  let E : Finset (ι → ℕ) := Fintype.piFinset (fun _ : ι => Finset.Icc 1 L)
  let T : Finset (J → ℕ) := Fintype.piFinset (fun _ : J => Finset.Icc 1 Q)
  let ones : J → ℕ := fun _ => 1
  let Phi (r : ι → ℕ) : ℝ := ∏ i, ((r i).totient : ℝ)
  let Psi (s : J → ℕ) : ℝ := ∏ ab : J, ((s ab).totient : ℝ)
  let crossMu (s : J → ℕ) : ℝ :=
    ∏ ab : J, (ArithmeticFunction.moebius (s ab) : ℝ)
  let A (d : ι → ℕ) : ℝ := selbergCoefficient y d / (∏ i, (d i : ℝ))
  let S (r : ι → ℕ) : ℝ :=
    ∑ d ∈ D, if ∀ i, r i ∣ d i then A d else 0
  let lower (f : J → ι) (u : ι → ℕ) (s : J → ℕ) : ι → ℕ :=
    fun i => Nat.lcm (u i) ((Finset.univ.filter (fun ab : J => f ab = i)).lcm s)
  let left := lower (fun ab : J => ab.1.1)
  let right := lower (fun ab : J => ab.1.2)
  let F (s : J → ℕ) : ℝ :=
    crossMu s * ∑ u ∈ E, Phi u * S (left u s) * S (right u s)
  have hrootmem (r : ι → ℕ) (hr : r ∈ y.support)
      (d : ι → ℕ) (hdr : ∀ i, d i ∣ r i) : d ∈ D := by
    refine Finset.mem_biUnion.mpr ⟨r, hr, Fintype.mem_piFinset.mpr ?_⟩
    intro i
    exact Nat.mem_divisors.mpr ⟨hdr i,
      ((hy r hr).1.squarefree_of_dvd
        (Finset.dvd_prod_of_mem r (Finset.mem_univ i))).ne_zero⟩
  have hsD : y.support ⊆ D := fun r hr => hrootmem r hr r (fun _ => dvd_rfl)
  have hdown (d : ι → ℕ) (hd : d ∈ D)
      (r : ι → ℕ) (hrd : ∀ i, r i ∣ d i) : r ∈ D := by
    obtain ⟨t, ht, hdt⟩ := Finset.mem_biUnion.mp hd
    exact hrootmem t ht r fun i =>
      (hrd i).trans (Nat.dvd_of_mem_divisors (Fintype.mem_piFinset.mp hdt i))
  have hdata (d : ι → ℕ) (hd : d ∈ D) :
      Squarefree (∏ i, d i) ∧
        Nat.Coprime (∏ i, d i) W ∧ (∏ i, d i) ≤ L := by
    obtain ⟨r, hr, hdr⟩ := Finset.mem_biUnion.mp hd
    have hdiv : (∏ i, d i) ∣ ∏ i, r i :=
      Finset.prod_dvd_prod_of_dvd d r fun i _ =>
        Nat.dvd_of_mem_divisors (Fintype.mem_piFinset.mp hdr i)
    exact ⟨(hy r hr).1.squarefree_of_dvd hdiv,
      Nat.Coprime.of_dvd_left hdiv (hy r hr).2.1,
      (Nat.le_of_dvd (hy r hr).1.ne_zero.bot_lt hdiv).trans (hy r hr).2.2⟩
  have hDE : D ⊆ E := by
    intro d hd
    refine Fintype.mem_piFinset.mpr fun i => Finset.mem_Icc.mpr ?_
    have hcoord := Finset.dvd_prod_of_mem d (Finset.mem_univ i)
    exact ⟨((hdata d hd).1.squarefree_of_dvd hcoord).ne_zero.bot_lt,
      (Nat.le_of_dvd (hdata d hd).1.ne_zero.bot_lt hcoord).trans (hdata d hd).2.2⟩
  have hysumE (d : ι → ℕ) :
      y.sum (fun r yr => if ∀ i, d i ∣ r i then yr / Phi r else 0) =
      ∑ r ∈ E, if (∏ i, r i) ≤ L ∧ (∀ i, d i ∣ r i) then
        y r / Phi r else 0 := by
    rw [Finsupp.sum]
    calc
      _ = ∑ r ∈ y.support,
          if (∏ i, r i) ≤ L ∧ (∀ i, d i ∣ r i) then y r / Phi r else 0 := by
        apply Finset.sum_congr rfl
        intro r hr
        simp [(hy r hr).2.2]
      _ = _ := by
        apply Finset.sum_subset (hsD.trans hDE)
        intro r hr hnot
        simp [Finsupp.notMem_support_iff.mp hnot]
  have hEsumzero (d : ι → ℕ) (hd : d ∉ D) :
      (∑ r ∈ E, if (∏ i, r i) ≤ L ∧ (∀ i, d i ∣ r i) then
        y r / Phi r else 0) = 0 := by
    apply Finset.sum_eq_zero
    intro r hr
    by_cases hyr : r ∈ y.support
    · exact ite_eq_right (fun h => hd (hrootmem r hyr d h.2))
    · simp [Finsupp.notMem_support_iff.mp hyr]
  have hcoef (d : ι → ℕ) :
      selbergCoefficient y d =
        if Nat.Coprime (∏ i, d i) W then
          (∏ i, (ArithmeticFunction.moebius (d i) : ℝ) * (d i : ℝ)) *
            ∑ r ∈ E, if (∏ i, r i) ≤ L ∧ (∀ i, d i ∣ r i) then
              y r / Phi r else 0
        else 0 := by
    rw [selbergCoefficient_eq_prod y (fun r hr => (hy r hr).1) d, hysumE d]
    by_cases hd : d ∈ D
    · rw [ite_eq_left (hdata d hd).2.1]
    · simp [hEsumzero d hd]
  have hzero (d : ι → ℕ) (hd : d ∉ D) : selbergCoefficient y d = 0 := by
    rw [hcoef d]
    simp [hEsumzero d hd]
  have hS (r : ι → ℕ) :
      S r = (ArithmeticFunction.moebius (∏ i, r i) : ℝ) * y r / Phi r := by
    by_cases hr : r ∈ D
    · have hφ : Phi r ≠ 0 := by
        apply Finset.prod_ne_zero_iff.mpr
        intro i hi
        have hri := ((hdata r hr).1.squarefree_of_dvd
          (Finset.dvd_prod_of_mem r hi)).ne_zero
        exact_mod_cast (Nat.totient_pos.mpr hri.bot_lt).ne'
      have hμ : (ArithmeticFunction.moebius (∏ i, r i) : ℝ) ^ 2 = 1 := by
        exact_mod_cast ArithmeticFunction.moebius_sq_eq_one_of_squarefree (hdata r hr).1
      have hinv := selberg_forward_inverse y (fun u hu => (hy u hu).1) r
      change (ArithmeticFunction.moebius (∏ i, r i) : ℝ) * Phi r * S r = y r at hinv
      apply (eq_div_iff hφ).mpr
      calc
        S r * Phi r = (ArithmeticFunction.moebius (∏ i, r i) : ℝ) ^ 2 *
            (S r * Phi r) := by rw [hμ, one_mul]
        _ = (ArithmeticFunction.moebius (∏ i, r i) : ℝ) *
            ((ArithmeticFunction.moebius (∏ i, r i) : ℝ) * Phi r * S r) := by ring
        _ = _ := by rw [hinv]
    · have hyr : y r = 0 :=
        Finsupp.notMem_support_iff.mp (fun hrs => hr (hsD hrs))
      have hSr : S r = 0 := by
        dsimp only [S]
        apply Finset.sum_eq_zero
        intro d hd
        exact ite_eq_right (fun hrd => hr (hdown d hd r hrd))
      simp [hSr, hyr]
  have hSE (r : ι → ℕ) :
      (∑ d ∈ E, if ∀ i, r i ∣ d i then A d else 0) = S r := by
    dsimp only [S]
    symm
    apply Finset.sum_subset hDE
    intro d hd hnot
    simp [A, hzero d hnot]
  have hcoordE (d : ι → ℕ) (hd : d ∈ E) (i : ι) : 1 ≤ d i ∧ d i ≤ L :=
    Finset.mem_Icc.mp (Fintype.mem_piFinset.mp hd i)
  let theta (d e : ι → ℕ) : ℝ :=
    selbergCoefficient y d * selbergCoefficient y e /
      (∏ i, (Nat.lcm (d i) (e i) : ℝ))
  have hkernel (d : ι → ℕ) (hd : d ∈ E) (e : ι → ℕ) :
      theta d e = ∑ u ∈ E,
        if (∀ i, u i ∣ d i) ∧ (∀ i, u i ∣ e i) then
          Phi u * A d * A e else 0 := by
    refine div_prod_lcm_eq_sum_totient_mul E d e (fun i => (hcoordE d hd i).1) ?_
      (selbergCoefficient y d) (selbergCoefficient y e)
    intro u hu
    apply Fintype.mem_piFinset.mpr
    intro i
    exact Finset.mem_Icc.mpr
      ⟨(ne_zero_of_dvd_ne_zero (Nat.ne_of_gt (hcoordE d hd i).1) (hu i)).bot_lt,
        (Nat.le_of_dvd (hcoordE d hd i).1 (hu i)).trans (hcoordE d hd i).2⟩
  have hcrossBox (d : ι → ℕ) (hd : d ∈ E) (e : ι → ℕ) :
      T.filter (fun s => ∀ ab : J, s ab ∣ d ab.1.1 ∧ s ab ∣ e ab.1.2) =
        Fintype.piFinset (fun ab : J => (Nat.gcd (d ab.1.1) (e ab.1.2)).divisors) := by
    ext s
    simp only [Finset.mem_filter, Fintype.mem_piFinset, Nat.mem_divisors]
    constructor
    · rintro ⟨_, hs⟩ ab
      exact ⟨Nat.dvd_gcd (hs ab).1 (hs ab).2,
        (Nat.gcd_pos_of_pos_left (e ab.1.2) (hcoordE d hd ab.1.1).1).ne'⟩
    · intro hs
      have hdiv := fun ab => Nat.dvd_gcd_iff.mp (hs ab).1
      refine ⟨?_, hdiv⟩
      apply Fintype.mem_piFinset.mpr
      intro ab
      apply Finset.mem_Icc.mpr
      refine ⟨(ne_zero_of_dvd_ne_zero
        (Nat.ne_of_gt (hcoordE d hd ab.1.1).1) (hdiv ab).1).bot_lt, ?_⟩
      exact ((Nat.le_of_dvd (hcoordE d hd ab.1.1).1 (hdiv ab).1).trans
        (hcoordE d hd ab.1.1).2).trans (Nat.le_succ L)
  have hmuSum (a b : ℕ) :
      (∑ n ∈ (Nat.gcd a b).divisors, (ArithmeticFunction.moebius n : ℝ)) =
        if Nat.Coprime a b then 1 else 0 := by
    simpa only [ArithmeticFunction.coe_mul_zeta_apply, ArithmeticFunction.one_apply,
      ArithmeticFunction.intCoe_apply, Nat.coprime_iff_gcd_eq_one] using
      congrArg (fun f : ArithmeticFunction ℝ => f (Nat.gcd a b))
        (ArithmeticFunction.coe_moebius_mul_coe_zeta (R := ℝ))
  have hmobius (d : ι → ℕ) (hd : d ∈ E) (e : ι → ℕ) :
      (∑ s ∈ T, if ∀ ab : J, s ab ∣ d ab.1.1 ∧ s ab ∣ e ab.1.2 then
        crossMu s else 0) =
      if ∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b) then 1 else 0 := by
    rw [← Finset.sum_filter, hcrossBox d hd e]
    dsimp only [crossMu]
    rw [← Finset.prod_univ_sum
      (fun ab : J => (Nat.gcd (d ab.1.1) (e ab.1.2)).divisors)
      (fun _ n => (ArithmeticFunction.moebius n : ℝ))]
    simp_rw [hmuSum]
    rw [Fintype.prod_ite_zero]
    simp only [Finset.prod_const_one]
    congr 1
    apply propext
    constructor
    · intro hs a b hab
      exact hs ⟨(a, b), Finset.mem_offDiag.mpr ⟨Finset.mem_univ _, Finset.mem_univ _, hab⟩⟩
    · intro hs ab
      exact hs _ _ (Finset.mem_offDiag.mp ab.2).2.2
  have hLower (f : J → ι) (u : ι → ℕ) (s : J → ℕ) (d : ι → ℕ) :
      (∀ i, lower f u s i ∣ d i) ↔
        (∀ i, u i ∣ d i) ∧ (∀ ab : J, s ab ∣ d (f ab)) := by
    simp only [lower, Nat.lcm_dvd_iff, Finset.lcm_dvd_iff,
      Finset.mem_filter, Finset.mem_univ, true_and]
    constructor
    · intro h
      exact ⟨fun i => (h i).1, fun ab => (h (f ab)).2 ab rfl⟩
    · rintro ⟨hu, hs⟩ i
      refine ⟨hu i, ?_⟩
      intro ab hab
      simpa only [hab] using hs ab
  have hLowerPair (u : ι → ℕ) (s : J → ℕ) (d e : ι → ℕ) :
      ((∀ i, left u s i ∣ d i) ∧ (∀ i, right u s i ∣ e i)) ↔
        (∀ ab : J, s ab ∣ d ab.1.1 ∧ s ab ∣ e ab.1.2) ∧
          ((∀ i, u i ∣ d i) ∧ (∀ i, u i ∣ e i)) := by
    dsimp only [left, right]
    simp only [hLower, forall_and, and_assoc, and_left_comm, and_comm]
  let term (s : J → ℕ) (u d e : ι → ℕ) : ℝ :=
    crossMu s * Phi u *
      (if ∀ i, left u s i ∣ d i then A d else 0) *
      (if ∀ i, right u s i ∣ e i then A e else 0)
  have hterm (s : J → ℕ) (u d e : ι → ℕ) :
      term s u d e =
        (if ∀ ab : J, s ab ∣ d ab.1.1 ∧ s ab ∣ e ab.1.2 then crossMu s else 0) *
          (if (∀ i, u i ∣ d i) ∧ (∀ i, u i ∣ e i) then Phi u * A d * A e else 0) := by
    have hh :
        ((∀ i, right u s i ∣ e i) ∧ (∀ i, left u s i ∣ d i)) ↔
          (((∀ i, u i ∣ d i) ∧ (∀ i, u i ∣ e i)) ∧
            (∀ ab : J, s ab ∣ d ab.1.1 ∧ s ab ∣ e ab.1.2)) :=
      and_comm.trans ((hLowerPair u s d e).trans and_comm)
    simp only [term, mul_ite, ite_mul, mul_zero, zero_mul, ← ite_and, hh]
    split_ifs <;> ring
  have hpair (d : ι → ℕ) (hd : d ∈ E) (e : ι → ℕ) :
      (if ∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b) then theta d e else 0) =
        ∑ s ∈ T, ∑ u ∈ E, term s u d e := by
    simp_rw [hterm]
    simp only [← Finset.mul_sum]
    rw [← hkernel d hd e, ← Finset.sum_mul, hmobius d hd e]
    split_ifs <;> simp
  have hgood :
      (∑ d ∈ E, ∑ e ∈ E,
        if ∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b) then theta d e else 0) =
        ∑ s ∈ T, F s := by
    calc
      _ = ∑ d ∈ E, ∑ e ∈ E, ∑ s ∈ T, ∑ u ∈ E, term s u d e := by
        apply Finset.sum_congr rfl
        intro d hd
        exact Finset.sum_congr rfl (fun e _ => hpair d hd e)
      _ = ∑ s ∈ T, ∑ u ∈ E, ∑ d ∈ E, ∑ e ∈ E, term s u d e := by
        simp_rw [show ∀ d : ι → ℕ,
          (∑ e ∈ E, ∑ s ∈ T, ∑ u ∈ E, term s u d e) =
          ∑ s ∈ T, ∑ e ∈ E, ∑ u ∈ E, term s u d e from
            fun _ => Finset.sum_comm]
        rw [Finset.sum_comm]
        apply Finset.sum_congr rfl
        intro s hs
        simp_rw [show ∀ d : ι → ℕ,
          (∑ e ∈ E, ∑ u ∈ E, term s u d e) =
          ∑ u ∈ E, ∑ e ∈ E, term s u d e from fun _ => Finset.sum_comm]
        exact Finset.sum_comm
      _ = _ := by
        apply Finset.sum_congr rfl
        intro s hs
        dsimp only [F]
        rw [Finset.mul_sum]
        apply Finset.sum_congr rfl
        intro u hu
        rw [← hSE (left u s), ← hSE (right u s)]
        simp only [term, Finset.mul_sum, Finset.sum_mul, mul_assoc]
        exact Finset.sum_comm
  have hall : (∑ d ∈ E, ∑ e ∈ E, theta d e) =
      ∑ u ∈ E, Phi u * S u ^ 2 := by
    calc
      _ = ∑ d ∈ E, ∑ e ∈ E, ∑ u ∈ E,
          if (∀ i, u i ∣ d i) ∧ (∀ i, u i ∣ e i) then Phi u * A d * A e else 0 := by
        apply Finset.sum_congr rfl
        intro d hd
        exact Finset.sum_congr rfl (fun e _ => hkernel d hd e)
      _ = ∑ u ∈ E, ∑ d ∈ E, ∑ e ∈ E,
          if (∀ i, u i ∣ d i) ∧ (∀ i, u i ∣ e i) then Phi u * A d * A e else 0 := by
        rw [eq_comm, Finset.sum_comm,
          Finset.sum_congr rfl fun _ _ => Finset.sum_comm]
      _ = _ := by
        apply Finset.sum_congr rfl
        intro u hu
        rw [← hSE u, pow_two, Finset.sum_mul_sum]
        simp only [Finset.mul_sum,
          mul_ite, ite_mul, mul_zero, zero_mul, ← ite_and, and_comm, mul_assoc]
  have honeT : ones ∈ T := by simp [T, ones, Q]
  have hLowerOne (f : J → ι) (u : ι → ℕ) : lower f u ones = u := by
    funext i
    have hrow : (Finset.univ.filter (fun ab : J => f ab = i)).lcm ones = 1 :=
      Nat.eq_one_of_dvd_one (Finset.lcm_dvd fun _ _ => dvd_rfl)
    simp only [lower, hrow, Nat.lcm_one_right]
  have hFone : F ones = ∑ d ∈ E, ∑ e ∈ E, theta d e := by
    rw [hall]
    dsimp only [F, left, right]
    simp only [hLowerOne, crossMu, ones, ArithmeticFunction.moebius_apply_one,
      Int.cast_one, Finset.prod_const_one, one_mul, pow_two, mul_assoc]
  have hbadE :
      (∑ d ∈ E, ∑ e ∈ E,
        if ¬ (∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b)) then theta d e else 0) =
        -(∑ s ∈ T.erase ones, F s) := by
    have hsplit : (∑ d ∈ E, ∑ e ∈ E, theta d e) =
        (∑ d ∈ E, ∑ e ∈ E,
          if ∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b) then theta d e else 0) +
        (∑ d ∈ E, ∑ e ∈ E,
          if ¬ (∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b)) then theta d e else 0) := by
      rw [← Finset.sum_add_distrib]
      simp_rw [← Finset.sum_filter, Finset.sum_filter_add_sum_filter_not]
    have ht := Finset.sum_erase_add (s := T) (f := F) honeT
    rw [hgood, ← hFone] at hsplit
    linarith
  have hbadD :
      (∑ d ∈ D, ∑ e ∈ D,
        if ¬ (∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b)) then theta d e else 0) =
        -(∑ s ∈ T.erase ones, F s) := by
    rw [← hbadE]
    calc
      _ = ∑ d ∈ D, ∑ e ∈ E,
          if ¬ (∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b)) then theta d e else 0 := by
        apply Finset.sum_congr rfl
        intro d hd
        apply Finset.sum_subset hDE
        intro e he hnot
        simp [theta, hzero e hnot]
      _ = _ := by
        apply Finset.sum_subset hDE
        intro d hd hnot
        simp [theta, hzero d hnot]
  let fiber (f : J → ι) (i : ι) : Finset J := Finset.univ.filter (fun ab => f ab = i)
  have huLower (f : J → ι) (u : ι → ℕ) (s : J → ℕ) (i : ι) :
      u i ∣ lower f u s i := Nat.dvd_lcm_left _ _
  have hsLower (f : J → ι) (u : ι → ℕ) (s : J → ℕ) (ab : J) :
      s ab ∣ lower f u s (f ab) := by
    apply dvd_trans ?_ (Nat.dvd_lcm_right _ _)
    exact Finset.dvd_lcm (by simp)
  have hstar (u : ι → ℕ) (s : J → ℕ)
      (hl : y (left u s) ≠ 0) (hr : y (right u s) ≠ 0) :
      (∀ ab : J, Nat.Coprime (s ab) (u ab.1.1) ∧ Nat.Coprime (s ab) (u ab.1.2)) ∧
        (∀ ab cd : J, ab ≠ cd → (ab.1.1 = cd.1.1 ∨ ab.1.2 = cd.1.2) →
          Nat.Coprime (s ab) (s cd)) := by
    have hlSF := (hy _ (Finsupp.mem_support_iff.mpr hl)).1
    have hrSF := (hy _ (Finsupp.mem_support_iff.mpr hr)).1
    constructor
    · intro ab
      have hab : ab.1.1 ≠ ab.1.2 := (Finset.mem_offDiag.mp ab.2).2.2
      exact ⟨Nat.Coprime.of_dvd
        (hsLower (fun ab : J => ab.1.2) u s ab)
        (huLower (fun ab : J => ab.1.2) u s ab.1.1)
        (coprime_of_squarefree_fintype_prod _ hrSF hab).symm,
        Nat.Coprime.of_dvd
          (hsLower (fun ab : J => ab.1.1) u s ab)
          (huLower (fun ab : J => ab.1.1) u s ab.1.2)
          (coprime_of_squarefree_fintype_prod _ hlSF hab)⟩
    · intro ab cd habcd hshared
      rcases hshared with hfirst | hsecond
      · have hne : ab.1.2 ≠ cd.1.2 :=
          fun h => habcd (Subtype.ext (Prod.ext hfirst h))
        exact Nat.Coprime.of_dvd
          (hsLower (fun ab : J => ab.1.2) u s ab)
          (hsLower (fun ab : J => ab.1.2) u s cd)
          (coprime_of_squarefree_fintype_prod _ hrSF hne)
      · have hne : ab.1.1 ≠ cd.1.1 :=
          fun h => habcd (Subtype.ext (Prod.ext h hsecond))
        exact Nat.Coprime.of_dvd
          (hsLower (fun ab : J => ab.1.1) u s ab)
          (hsLower (fun ab : J => ab.1.1) u s cd)
          (coprime_of_squarefree_fintype_prod _ hlSF hne)
  have hphiProd (t : Finset J) (s : J → ℕ)
      (ht : Set.Pairwise (t : Set J) (Function.onFun Nat.Coprime s)) :
      (∏ ab ∈ t, s ab).totient = ∏ ab ∈ t, (s ab).totient := by
    have hφ : ArithmeticFunction.IsMultiplicative
        (⟨Nat.totient, Nat.totient_zero⟩ : ArithmeticFunction ℕ) :=
      ⟨Nat.totient_one, fun {_ _} h => Nat.totient_mul h⟩
    exact ArithmeticFunction.IsMultiplicative.map_prod s hφ t ht
  have hfactor (f : J → ι) (u : ι → ℕ) (s : J → ℕ)
      (hend : ∀ ab, Nat.Coprime (s ab) (u (f ab)))
      (hrow : ∀ ab cd, ab ≠ cd → f ab = f cd → Nat.Coprime (s ab) (s cd)) :
      Phi (lower f u s) = Phi u * Psi s := by
    have hi (i : ι) :
        (lower f u s i).totient = (u i).totient * ∏ ab ∈ fiber f i, (s ab).totient := by
      have hp : Set.Pairwise (fiber f i : Set J) (Function.onFun Nat.Coprime s) := by
        intro ab hab cd hcd hne
        exact hrow ab cd hne ((Finset.mem_filter.mp hab).2.trans
          (Finset.mem_filter.mp hcd).2.symm)
      have hc : Nat.Coprime (u i) (∏ ab ∈ fiber f i, s ab) := by
        apply Nat.Coprime.prod_right
        intro ab hab
        simpa only [(Finset.mem_filter.mp hab).2] using (hend ab).symm
      change (Nat.lcm (u i) ((fiber f i).lcm s)).totient = _
      rw [Finset.lcm_eq_prod hp, hc.lcm_eq_mul, Nat.totient_mul hc, hphiProd _ _ hp]
    have hnat : (∏ i, (lower f u s i).totient) =
        (∏ i, (u i).totient) * ∏ ab, (s ab).totient := by
      simp_rw [hi]
      rw [Finset.prod_mul_distrib]
      congr 1
      exact Finset.prod_fiberwise Finset.univ f (fun ab : J => (s ab).totient)
    dsimp only [Phi, Psi]
    exact_mod_cast hnat
  let P : Finset ℕ := (Finset.Icc (D₀ + 1) Q).filter Nat.Prime
  let V : Finset ℕ := insert 1
    ((Finset.Icc 2 Q).filter (fun n => Squarefree n ∧ n.primeFactors ⊆ P))
  let Tr : Finset (J → ℕ) := Fintype.piFinset (fun _ : J => V)
  let C : Finset (ι → ℕ) := Fintype.piFinset
    (fun _ : ι => (Finset.Icc 1 L).filter (fun n => Squarefree n ∧ Nat.Coprime n W))
  have hroughValue (n : ℕ) (hn : Squarefree n) (hc : Nat.Coprime n W)
      (hbound : n ≤ Q) : n ∈ V := by
    by_cases hn1 : n = 1
    · simp [V, hn1]
    apply Finset.mem_insert_of_mem
    apply Finset.mem_filter.mpr
    refine ⟨Finset.mem_Icc.mpr ⟨by have := hn.ne_zero; omega, hbound⟩, hn, ?_⟩
    intro p hp
    have hpprime := Nat.prime_of_mem_primeFactors hp
    have hpdvd := Nat.dvd_of_mem_primeFactors hp
    have hlarge : D₀ < p := by
      by_contra h
      have hpW : p ∣ W :=
        (hpprime.dvd_primorial_iff.mpr (Nat.le_of_not_gt h)).trans hsmall
      exact (hpprime.coprime_iff_not_dvd.mp (Nat.Coprime.of_dvd_left hpdvd hc)) hpW
    exact Finset.mem_filter.mpr
      ⟨Finset.mem_Icc.mpr ⟨hlarge, (Nat.le_of_dvd hn.ne_zero.bot_lt hpdvd).trans hbound⟩,
        hpprime⟩
  have hTr (u : ι → ℕ) (s : J → ℕ) (hl : y (left u s) ≠ 0) : s ∈ Tr := by
    have hr := hy _ (Finsupp.mem_support_iff.mpr hl)
    apply Fintype.mem_piFinset.mpr
    intro ab
    have hdiv : s ab ∣ ∏ i, left u s i :=
      (hsLower (fun ab : J => ab.1.1) u s ab).trans
        (Finset.dvd_prod_of_mem _ (Finset.mem_univ _))
    exact hroughValue _ (hr.1.squarefree_of_dvd hdiv)
      (Nat.Coprime.of_dvd_left hdiv hr.2.1)
      (((Nat.le_of_dvd hr.1.ne_zero.bot_lt hdiv).trans hr.2.2).trans (Nat.le_succ L))
  have hC (u : ι → ℕ) (s : J → ℕ) (hl : y (left u s) ≠ 0) : u ∈ C := by
    have hr := hy _ (Finsupp.mem_support_iff.mpr hl)
    apply Fintype.mem_piFinset.mpr
    intro i
    have hdiv : u i ∣ ∏ i, left u s i :=
      (huLower (fun ab : J => ab.1.1) u s i).trans
        (Finset.dvd_prod_of_mem _ (Finset.mem_univ _))
    have hsf := hr.1.squarefree_of_dvd hdiv
    exact Finset.mem_filter.mpr
      ⟨Finset.mem_Icc.mpr ⟨hsf.ne_zero.bot_lt,
        (Nat.le_of_dvd hr.1.ne_zero.bot_lt hdiv).trans hr.2.2⟩,
        hsf, Nat.Coprime.of_dvd_left hdiv hr.2.1⟩
  have hCE : C ⊆ E := by
    intro u hu
    exact Fintype.mem_piFinset.mpr fun i =>
      (Finset.mem_filter.mp (Fintype.mem_piFinset.mp hu i)).1
  have hTrT : Tr ⊆ T := by
    intro s hs
    apply Fintype.mem_piFinset.mpr
    intro ab
    have hv := Fintype.mem_piFinset.mp hs ab
    rcases Finset.mem_insert.mp hv with h1 | hn
    · simp [h1, Q]
    · have hq := Finset.mem_Icc.mp (Finset.mem_filter.mp hn).1
      exact Finset.mem_Icc.mpr ⟨by omega, hq.2⟩
  have hrestrict (s : J → ℕ) :
      F s = crossMu s * ∑ u ∈ C, Phi u * S (left u s) * S (right u s) := by
    dsimp only [F]
    congr 1
    symm
    apply Finset.sum_subset hCE
    intro u hu hnot
    have hl : y (left u s) = 0 := by
      by_contra h
      exact hnot (hC u s h)
    simp [hS, hl]
  have hrough : (∑ s ∈ T.erase ones, F s) = ∑ s ∈ Tr.erase ones, F s := by
    symm
    apply Finset.sum_subset
      (fun s hs => Finset.mem_erase.mpr ⟨(Finset.mem_erase.mp hs).1,
        hTrT (Finset.mem_erase.mp hs).2⟩)
    intro s hs hnot
    have hsnot : s ∉ Tr := fun h => hnot (Finset.mem_erase.mpr ⟨(Finset.mem_erase.mp hs).1, h⟩)
    have hl (u : ι → ℕ) : y (left u s) = 0 := by
      by_contra h
      exact hsnot (hTr u s h)
    simp [F, hS, hl]
  have hB0 : 0 ≤ B := (abs_nonneg (y (fun _ => 0))).trans (hB _)
  have hPhi0 (r : ι → ℕ) : 0 ≤ Phi r := by dsimp [Phi]; positivity
  have hmu (n : ℕ) : |(ArithmeticFunction.moebius n : ℝ)| ≤ 1 := by
    exact_mod_cast (ArithmeticFunction.abs_moebius_le_one (n := n))
  have hSbound (r : ι → ℕ) : |S r| ≤ B / Phi r := by
    rw [hS, abs_div, abs_of_nonneg (hPhi0 r), abs_mul]
    apply div_le_div_of_nonneg_right _ (hPhi0 r)
    exact (mul_le_mul_of_nonneg_right (hmu _) (abs_nonneg _)).trans (by simpa using hB r)
  have hcrossMu (s : J → ℕ) : |crossMu s| ≤ 1 := by
    dsimp only [crossMu]
    rw [Finset.abs_prod]
    exact Finset.prod_le_one (fun _ _ => abs_nonneg _) (fun ab _ => hmu (s ab))
  have hPhiPos (u : ι → ℕ) (hu : u ∈ C) : 0 < Phi u := by
    apply Finset.prod_pos
    intro i hi
    exact_mod_cast Nat.totient_pos.mpr (hcoordE u (hCE hu) i).1
  have hPsiPos (s : J → ℕ) (hs : s ∈ Tr) : 0 < Psi s := by
    apply Finset.prod_pos
    intro ab hab
    exact_mod_cast Nat.totient_pos.mpr
      (Finset.mem_Icc.mp (Fintype.mem_piFinset.mp (hTrT hs) ab)).1
  have hmajor (u : ι → ℕ) (hu : u ∈ C) (s : J → ℕ) (hs : s ∈ Tr) :
      |Phi u * S (left u s) * S (right u s)| ≤ B ^ 2 / (Phi u * Psi s ^ 2) := by
    by_cases hl : y (left u s) = 0
    · simp only [hS, hl, mul_zero, zero_div, zero_mul, abs_zero]
      exact div_nonneg (sq_nonneg B) (mul_nonneg (hPhi0 u) (sq_nonneg _))
    by_cases hr : y (right u s) = 0
    · simp only [hS, hr, mul_zero, zero_div, abs_zero]
      exact div_nonneg (sq_nonneg B) (mul_nonneg (hPhi0 u) (sq_nonneg _))
    have hst := hstar u s hl hr
    have hleft : Phi (left u s) = Phi u * Psi s :=
      hfactor (fun ab : J => ab.1.1) u s (fun ab => (hst.1 ab).1)
        (fun ab cd hne h => hst.2 ab cd hne (Or.inl h))
    have hright : Phi (right u s) = Phi u * Psi s :=
      hfactor (fun ab : J => ab.1.2) u s (fun ab => (hst.1 ab).2)
        (fun ab cd hne h => hst.2 ab cd hne (Or.inr h))
    calc
      _ = Phi u * |S (left u s)| * |S (right u s)| := by
        rw [abs_mul, abs_mul, abs_of_pos (hPhiPos u hu)]
      _ ≤ Phi u * (B / Phi (left u s)) * (B / Phi (right u s)) :=
        mul_le_mul (mul_le_mul_of_nonneg_left (hSbound _) (hPhi0 u)) (hSbound _)
          (abs_nonneg _) (mul_nonneg (hPhi0 u) (div_nonneg hB0 (hPhi0 _)))
      _ = _ := by
        rw [hleft, hright]
        field_simp [(hPhiPos u hu).ne', (hPsiPos s hs).ne']
  have hFbound (s : J → ℕ) (hs : s ∈ Tr) :
      |F s| ≤ B ^ 2 * (1 / Psi s ^ 2) * (∑ u ∈ C, 1 / Phi u) := by
    rw [hrestrict, Finset.mul_sum]
    calc
      _ ≤ ∑ u ∈ C, |crossMu s * (Phi u * S (left u s) * S (right u s))| :=
        Finset.abs_sum_le_sum_abs _ _
      _ ≤ ∑ u ∈ C, B ^ 2 / (Phi u * Psi s ^ 2) := by
        apply Finset.sum_le_sum
        intro u hu
        rw [abs_mul]
        exact (mul_le_mul (hcrossMu s) (hmajor u hu s hs)
          (abs_nonneg _) zero_le_one).trans_eq (one_mul _)
      _ = _ := by
        rw [Finset.mul_sum]
        apply Finset.sum_congr rfl
        intro u hu
        simp only [div_eq_mul_inv, mul_inv]
        ring
  have hcommonMean : (∑ u ∈ C, 1 / Phi u) = M ^ k := by
    calc
      _ = ∑ u ∈ C, ∏ i, 1 / ((u i).totient : ℝ) := by
        simp only [Phi, one_div, Finset.prod_inv_distrib]
      _ = ∏ _i : ι, ∑ n ∈ (Finset.Icc 1 L).filter
          (fun n => Squarefree n ∧ Nat.Coprime n W), 1 / (n.totient : ℝ) :=
        (Finset.prod_univ_sum
          (fun _ : ι => (Finset.Icc 1 L).filter (fun n => Squarefree n ∧ Nat.Coprime n W))
          (fun (_ : ι) n => 1 / (n.totient : ℝ))).symm
      _ = _ := by simp [Finset.sum_filter, M, k]
  let w (n : ℕ) : ℝ := 1 / (n.totient : ℝ) ^ 2
  let U : ℝ := ∑ n ∈ V, w n
  let Ap : ℝ := ∑ p ∈ P, w p
  let Euler : ℝ := ∏ p ∈ P, (1 + w p)
  have hw (n : ℕ) : 0 ≤ w n := by dsimp [w]; positivity
  have honeV : 1 ∈ V := by simp [V]
  have hVdata (n : ℕ) (hn : n ∈ V) : Squarefree n ∧ n.primeFactors ⊆ P := by
    rcases Finset.mem_insert.mp hn with h1 | hn
    · simp [h1]
    · exact (Finset.mem_filter.mp hn).2
  have hweight (n : ℕ) (hn : Squarefree n) : w n = ∏ p ∈ n.primeFactors, w p := by
    have htot : n.totient = ∏ p ∈ n.primeFactors, p.totient := by
      rw [Nat.totient_eq_div_primeFactors_mul, Nat.prod_primeFactors_of_squarefree hn,
        Nat.div_self hn.ne_zero.bot_lt, one_mul]
      apply Finset.prod_congr rfl
      intro p hp
      exact (Nat.totient_prime (Nat.prime_of_mem_primeFactors hp)).symm
    dsimp only [w]
    rw [htot, Nat.cast_prod, ← Finset.prod_pow]
    simp only [one_div, Finset.prod_inv_distrib]
  have hUone : 1 ≤ U := by
    simpa [U, w] using Finset.single_le_sum (fun n _ => hw n) honeV
  have hUEuler : U ≤ Euler := by
    have hinj : Set.InjOn Nat.primeFactors (V : Set ℕ) :=
      Nat.prod_primeFactors_invOn_squarefree.2.injOn.mono (fun n hn => (hVdata n hn).1)
    calc
      _ = ∑ n ∈ V, ∏ p ∈ n.primeFactors, w p :=
        Finset.sum_congr rfl (fun n hn => hweight n (hVdata n hn).1)
      _ = ∑ t ∈ V.image Nat.primeFactors, ∏ p ∈ t, w p :=
        (Finset.sum_image (f := fun t : Finset ℕ => ∏ p ∈ t, w p) hinj).symm
      _ ≤ ∑ t ∈ P.powerset, ∏ p ∈ t, w p := by
        apply Finset.sum_le_sum_of_subset_of_nonneg
        · intro t ht
          obtain ⟨n, hn, rfl⟩ := Finset.mem_image.mp ht
          exact Finset.mem_powerset.mpr (hVdata n hn).2
        · intro t ht hnot
          exact Finset.prod_nonneg (fun p _ => hw p)
      _ = Euler := (Finset.prod_one_add _).symm
  have hprimeWeight (p : ℕ) (hp : p.Prime) : w p ≤ 4 * ((p : ℝ) ^ 2)⁻¹ := by
    dsimp only [w]
    rw [Nat.totient_prime hp, Nat.cast_sub hp.one_lt.le, Nat.cast_one]
    have hpR : (2 : ℝ) ≤ p := by exact_mod_cast hp.two_le
    have hp0 : (0 : ℝ) < p := by positivity
    have hp1 : (0 : ℝ) < (p : ℝ) - 1 := by linarith
    rw [← div_eq_mul_inv]
    apply (div_le_div_iff₀ (sq_pos_of_pos hp1) (sq_pos_of_pos hp0)).mpr
    nlinarith [sq_nonneg ((p : ℝ) - 2)]
  have hD0R : (0 : ℝ) < D₀ := by exact_mod_cast hD₀
  have hAp : Ap ≤ 8 / (D₀ : ℝ) := by
    have hPsub : P ⊆ Finset.Ioo D₀ (Q + 1) := by
      intro p hp
      have hi := Finset.mem_Icc.mp (Finset.mem_filter.mp hp).1
      exact Finset.mem_Ioo.mpr ⟨hi.1, by omega⟩
    calc
      _ ≤ ∑ p ∈ P, 4 * ((p : ℝ) ^ 2)⁻¹ :=
        Finset.sum_le_sum (fun p hp => hprimeWeight p (Finset.mem_filter.mp hp).2)
      _ ≤ ∑ p ∈ Finset.Ioo D₀ (Q + 1), 4 * ((p : ℝ) ^ 2)⁻¹ :=
        Finset.sum_le_sum_of_subset_of_nonneg hPsub (fun p _ _ => by positivity)
      _ = 4 * ∑ p ∈ Finset.Ioo D₀ (Q + 1), ((p : ℝ) ^ 2)⁻¹ :=
        (Finset.mul_sum _ _ _).symm
      _ ≤ 4 * (2 / ((D₀ : ℝ) + 1)) :=
        mul_le_mul_of_nonneg_left (sum_Ioo_inv_sq_le (α := ℝ) D₀ (Q + 1)) (by norm_num)
      _ = 8 / ((D₀ : ℝ) + 1) := by ring
      _ ≤ 8 / (D₀ : ℝ) := div_le_div_of_nonneg_left (by norm_num) hD0R (by linarith)
  have hAp8 : Ap ≤ 8 := by
    apply hAp.trans
    exact (div_le_self (by norm_num : (0 : ℝ) ≤ 8) (by exact_mod_cast hD₀))
  have hEuler : Euler ≤ Real.exp 8 :=
    (Real.prod_one_add_le_exp_sum P hw).trans (Real.exp_le_exp.mpr hAp8)
  have hEulerDiff : Euler - 1 ≤ Ap * Euler := by
    dsimp only [Euler, Ap]
    nth_rw 1 [Finset.prod_one_add_ordered]
    simp only [add_sub_cancel_left]
    rw [Finset.sum_mul]
    apply Finset.sum_le_sum
    intro p hp
    apply mul_le_mul_of_nonneg_left _ (hw p)
    apply Finset.prod_le_prod_of_subset_of_one_le (Finset.filter_subset _ _)
    · intro q hq
      exact add_nonneg zero_le_one (hw q)
    · intro q hq hnot
      exact le_add_of_nonneg_right (hw q)
  have hUexp : U ≤ Real.exp 8 := hUEuler.trans hEuler
  have hUtail : U - 1 ≤ 8 * Real.exp 8 / (D₀ : ℝ) := by
    calc
      _ ≤ Euler - 1 := sub_le_sub_right hUEuler _
      _ ≤ Ap * Euler := hEulerDiff
      _ ≤ (8 / (D₀ : ℝ)) * Real.exp 8 :=
        mul_le_mul hAp hEuler (Finset.prod_nonneg (fun p _ => add_nonneg zero_le_one (hw p)))
          (div_nonneg (by norm_num) hD0R.le)
      _ = _ := by ring
  have hcardJ : Fintype.card J = K := by
    simp only [J, Fintype.card_coe, Finset.offDiag_card, Finset.card_univ]
    simp [K, k, Nat.mul_sub_left_distrib]
  have htupleMass : (∑ s ∈ Tr, 1 / Psi s ^ 2) = U ^ K := by
    calc
      _ = ∑ s ∈ Tr, ∏ ab : J, w (s ab) := by
        simp only [Psi, w, one_div, Finset.prod_inv_distrib, Finset.prod_pow]
      _ = ∏ _ab : J, U :=
        (Finset.prod_univ_sum (fun _ : J => V) (fun (_ : J) n => w n)).symm
      _ = U ^ K := by simp only [Finset.prod_const, Finset.card_univ, hcardJ]
  have honeTr : ones ∈ Tr := Fintype.mem_piFinset.mpr (fun _ => honeV)
  have heraseMass : (∑ s ∈ Tr.erase ones, 1 / Psi s ^ 2) = U ^ K - 1 := by
    rw [Finset.sum_erase_eq_sub honeTr, htupleMass]
    simp [Psi, ones]
  have htupleTail : (∑ s ∈ Tr.erase ones, 1 / Psi s ^ 2) ≤
      (8 * Real.exp 8 / (D₀ : ℝ)) * (K : ℝ) * (Real.exp 8) ^ (K - 1) := by
    rw [heraseMass]
    have hU0 : 0 ≤ U := zero_le_one.trans hUone
    have hpow := abs_pow_sub_pow_le (a := U) (b := (1 : ℝ)) (n := K)
    have hUpow : 1 ≤ U ^ K := one_le_pow₀ hUone
    norm_num only [one_pow] at hpow
    rw [abs_of_nonneg (sub_nonneg.mpr hUpow),
      abs_of_nonneg (sub_nonneg.mpr hUone), abs_of_nonneg hU0,
      max_eq_left hUone] at hpow
    exact hpow.trans (mul_le_mul
      (mul_le_mul_of_nonneg_right hUtail (Nat.cast_nonneg K))
      (pow_le_pow_left₀ hU0 hUexp (K - 1)) (pow_nonneg hU0 _)
      (mul_nonneg (div_nonneg (mul_nonneg (by norm_num) (Real.exp_pos _).le) hD0R.le)
        (Nat.cast_nonneg K)))
  change |∑ d ∈ D, ∑ e ∈ D,
    if ¬ (∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b)) then theta d e else 0| ≤ _
  rw [hbadD, abs_neg, hrough]
  calc
    _ ≤ ∑ s ∈ Tr.erase ones, |F s| := Finset.abs_sum_le_sum_abs _ _
    _ ≤ ∑ s ∈ Tr.erase ones,
        B ^ 2 * (1 / Psi s ^ 2) * (∑ u ∈ C, 1 / Phi u) :=
      Finset.sum_le_sum (fun s hs => hFbound s (Finset.mem_of_mem_erase hs))
    _ = B ^ 2 * (∑ s ∈ Tr.erase ones, 1 / Psi s ^ 2) * (∑ u ∈ C, 1 / Phi u) := by
      rw [← Finset.sum_mul, ← Finset.mul_sum]
    _ ≤ B ^ 2 *
        ((8 * Real.exp 8 / (D₀ : ℝ)) * (K : ℝ) * (Real.exp 8) ^ (K - 1)) *
          (∑ u ∈ C, 1 / Phi u) :=
      mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_left htupleTail (sq_nonneg B))
        (Finset.sum_nonneg (fun u _ => div_nonneg zero_le_one (hPhi0 u)))
    _ = _ := by rw [hcommonMean]

open Classical in
theorem selberg_square_real_interval_two_error
    {ι : Type*} [Fintype ι] (h : ι → ℕ) (hinj : Function.Injective h)
    (y : (ι → ℕ) →₀ ℝ) (L W v D₀ : ℕ) (B : ℝ)
    (hW : 0 < W) (hD₀ : 0 < D₀)
    (hsmall : _root_.primorial D₀ ∣ W)
    (hy : ∀ r ∈ y.support,
      Squarefree (∏ i, r i) ∧
        Nat.Coprime (∏ i, r i) W ∧ (∏ i, r i) ≤ L)
    (hB : ∀ r, |y r| ≤ B)
    (hcover : ∀ a b : ι, h a ≠ h b → ∀ p : ℕ,
      p.Prime → p ∣ Nat.dist (h a) (h b) → p ∣ W)
    (x : ℝ) (hx : 0 ≤ x) :
    let D := y.support.biUnion
      (fun r => Fintype.piFinset (fun i => (r i).divisors))
    let k := Fintype.card ι
    let K := k * (k - 1)
    let M : ℝ := ∑ n ∈ Finset.Icc 1 L,
      if Squarefree n ∧ Nat.Coprime n W then 1 / (n.totient : ℝ) else 0
    |(∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        if Nat.ModEq W n v then
          (∑ d ∈ D, if ∀ i, d i ∣ n + h i then selbergCoefficient y d else 0) ^ 2
        else 0) -
      x / (W : ℝ) *
        y.sum (fun r yr => yr ^ 2 / (∏ i, ((r i).totient : ℝ)))| ≤
      2 * (∑ d ∈ D, |selbergCoefficient y d|) ^ 2 +
        x / (W : ℝ) *
          (B ^ 2 *
            ((8 * Real.exp 8 / (D₀ : ℝ)) * (K : ℝ) *
              (Real.exp 8) ^ (K - 1)) * M ^ k) := by
  intro D k K M
  let Nsum : ℝ := ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
    if Nat.ModEq W n v then
      (∑ d ∈ D, if ∀ i, d i ∣ n + h i then selbergCoefficient y d else 0) ^ 2
    else 0
  let theta (d e : ι → ℕ) : ℝ :=
    selbergCoefficient y d * selbergCoefficient y e /
      (∏ i, (Nat.lcm (d i) (e i) : ℝ))
  let Qall : ℝ := ∑ d ∈ D, ∑ e ∈ D, theta d e
  let Qgood : ℝ := ∑ d ∈ D, ∑ e ∈ D,
    if ∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b) then theta d e else 0
  let Qbad : ℝ := ∑ d ∈ D, ∑ e ∈ D,
    if ¬ (∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b)) then theta d e else 0
  let Cabs : ℝ := ∑ d ∈ D, ∑ e ∈ D,
    if ∀ a b : ι, a ≠ b → Nat.Coprime (d a) (e b) then
      |selbergCoefficient y d * selbergCoefficient y e| else 0
  let error : ℝ := B ^ 2 *
    ((8 * Real.exp 8 / (D₀ : ℝ)) * (K : ℝ) * (Real.exp 8) ^ (K - 1)) * M ^ k
  have hD (d : ι → ℕ) (hd : d ∈ D) :
      Squarefree (∏ i, d i) ∧ Nat.Coprime (∏ i, d i) W := by
    obtain ⟨r, hr, hdr⟩ := Finset.mem_biUnion.mp hd
    have hdiv : (∏ i, d i) ∣ ∏ i, r i :=
      Finset.prod_dvd_prod_of_dvd d r fun i _ =>
        Nat.dvd_of_mem_divisors (Fintype.mem_piFinset.mp hdr i)
    exact ⟨(hy r hr).1.squarefree_of_dvd hdiv,
      Nat.Coprime.of_dvd_left hdiv (hy r hr).2.1⟩
  have hcrt := selberg_square_real_interval_crt h hinj D (selbergCoefficient y)
    W v hW hD hcover x hx
  change |Nsum - x / (W : ℝ) * Qgood| ≤ 2 * Cabs at hcrt
  have hdiagonal := selberg_unrestricted_lcm_diagonal y (fun r hr => (hy r hr).1)
  change Qall = y.sum (fun r yr => yr ^ 2 / (∏ i, ((r i).totient : ℝ))) at hdiagonal
  have hcross := selberg_cross_correction_le y L W D₀ B hD₀ hsmall hy hB
  change |Qbad| ≤ error at hcross
  have hpartition : Qall = Qgood + Qbad := by
    dsimp only [Qall, Qgood, Qbad]
    rw [← Finset.sum_add_distrib]
    simp_rw [← Finset.sum_filter, Finset.sum_filter_add_sum_filter_not]
  have hCabs : Cabs ≤ (∑ d ∈ D, |selbergCoefficient y d|) ^ 2 := by
    calc
      _ ≤ ∑ d ∈ D, ∑ e ∈ D, |selbergCoefficient y d * selbergCoefficient y e| := by
        apply Finset.sum_le_sum
        intro d hd
        apply Finset.sum_le_sum
        intro e he
        split_ifs
        · exact le_rfl
        · exact abs_nonneg _
      _ = _ := by
        rw [pow_two, Finset.sum_mul_sum]
        simp only [abs_mul]
  have hxW : 0 ≤ x / (W : ℝ) := div_nonneg hx (Nat.cast_nonneg W)
  change |Nsum - x / (W : ℝ) *
    y.sum (fun r yr => yr ^ 2 / (∏ i, ((r i).totient : ℝ)))| ≤
      2 * (∑ d ∈ D, |selbergCoefficient y d|) ^ 2 + x / (W : ℝ) * error
  rw [← hdiagonal]
  calc
    _ = |(Nsum - x / (W : ℝ) * Qgood) - x / (W : ℝ) * Qbad| :=
      congrArg abs (by rw [hpartition]; ring)
    _ ≤ |Nsum - x / (W : ℝ) * Qgood| + |x / (W : ℝ) * Qbad| := by
      simpa using abs_sub_le (Nsum - x / (W : ℝ) * Qgood) 0 (x / (W : ℝ) * Qbad)
    _ ≤ 2 * Cabs + x / (W : ℝ) * error :=
      add_le_add hcrt (by
        rw [abs_mul, abs_of_nonneg hxW]
        exact mul_le_mul_of_nonneg_left hcross hxW)
    _ ≤ _ := add_le_add
      (mul_le_mul_of_nonneg_left hCabs (show (0 : ℝ) ≤ 2 by norm_num)) le_rfl

theorem presieving_le_mul_log_eventually
    (H : Finset ℕ) (c : ℝ) (hc : 0 < c) :
    ∀ᶠ x : ℝ in atTop,
      (presievingModulus H x : ℝ) ≤ c * Real.log x := by
  classical
  let P : Finset ℕ :=
    H.biUnion (fun h => H.biUnion (fun k => (Nat.dist h k).primeFactors))
  have hP : ∀ p ∈ P, Nat.Prime p := by
    intro p hp
    obtain ⟨h, _, hp⟩ := Finset.mem_biUnion.mp hp
    obtain ⟨k, _, hp⟩ := Finset.mem_biUnion.mp hp
    exact Nat.prime_of_mem_primeFactors hp
  have hlog2 : Tendsto (fun x : ℝ => Real.log (Real.log x)) atTop atTop :=
    Real.tendsto_log_atTop.comp Real.tendsto_log_atTop
  have hlog3 : Tendsto (fun x : ℝ => Real.log (Real.log (Real.log x)))
      atTop atTop := Real.tendsto_log_atTop.comp hlog2
  have hsub : ∀ᶠ x : ℝ in atTop,
      P ⊆ Nat.primesLE ⌊Real.log (Real.log (Real.log x))⌋₊ := by
    apply (Filter.eventually_all_finset P).mpr
    intro p hp
    filter_upwards [hlog3.eventually_ge_atTop (p : ℝ)] with x hx
    exact Nat.mem_primesLE.mpr
      ⟨(Nat.le_floor_iff' (hP p hp).ne_zero).mpr hx, hP p hp⟩
  have hsmall : ∀ᶠ x : ℝ in atTop,
      ‖Real.log (Real.log x) ^ Real.log 4‖ ≤
        c * ‖Real.log x ^ (1 : ℝ)‖ :=
    Real.tendsto_log_atTop.eventually
      ((isLittleO_log_rpow_rpow_atTop (Real.log 4)
        (show (0 : ℝ) < 1 by norm_num)).bound hc)
  filter_upwards [hsub, hsmall,
    Real.tendsto_log_atTop.eventually_gt_atTop 0,
    hlog2.eventually_gt_atTop 0, hlog3.eventually_ge_atTop 0]
    with x hxsub hxsmall hl hll hlll
  have hW : presievingModulus H x =
      primorial ⌊Real.log (Real.log (Real.log x))⌋₊ := by
    change (∏ p ∈ Nat.primesLE ⌊Real.log (Real.log (Real.log x))⌋₊ ∪ P, p) = _
    rw [Finset.union_eq_left.mpr hxsub, primorial_eq_prod_primesLE]
  calc
    (presievingModulus H x : ℝ) ≤
        (4 : ℝ) ^ ⌊Real.log (Real.log (Real.log x))⌋₊ := by
      rw [hW]
      exact_mod_cast primorial_le_four_pow ⌊Real.log (Real.log (Real.log x))⌋₊
    _ = (4 : ℝ) ^ ((⌊Real.log (Real.log (Real.log x))⌋₊ : ℕ) : ℝ) :=
      (Real.rpow_natCast _ _).symm
    _ ≤ (4 : ℝ) ^ Real.log (Real.log (Real.log x)) :=
      Real.rpow_le_rpow_of_exponent_le (by norm_num) (Nat.floor_le hlll)
    _ = Real.log (Real.log x) ^ Real.log 4 := by
      rw [Real.rpow_def_of_pos (show (0 : ℝ) < 4 by norm_num),
        Real.rpow_def_of_pos hll]
      congr 1
      ring
    _ ≤ c * Real.log x := by
      simpa only [Real.rpow_one,
        Real.norm_of_nonneg (Real.rpow_nonneg hll.le _),
        Real.norm_of_nonneg hl.le] using hxsmall

theorem floor_rpow_log_envelope (a : ℝ) (ha : 0 < a) (ha1 : a < 1) :
    ∀ᶠ x : ℝ in atTop,
      1 ≤ ⌊x ^ a⌋₊ ∧
      0 ≤ 1 + Real.log (⌊x ^ a⌋₊ : ℝ) ∧
      1 + Real.log (⌊x ^ a⌋₊ : ℝ) ≤ Real.log x := by
  filter_upwards [(tendsto_rpow_atTop ha).eventually_ge_atTop 1,
    Real.tendsto_log_atTop.eventually_ge_atTop (1 / (1 - a)),
    eventually_gt_atTop (0 : ℝ)] with x hpow hlarge hx
  have hL : 1 ≤ ⌊x ^ a⌋₊ := (Nat.one_le_floor_iff _).mpr hpow
  have hLreal : (1 : ℝ) ≤ (⌊x ^ a⌋₊ : ℝ) := by exact_mod_cast hL
  have hlog0 : 0 ≤ Real.log (⌊x ^ a⌋₊ : ℝ) := Real.log_nonneg hLreal
  have hlog : Real.log (⌊x ^ a⌋₊ : ℝ) ≤ a * Real.log x := by
    calc
      _ ≤ Real.log (x ^ a) :=
        Real.log_le_log (zero_lt_one.trans_le hLreal)
          (Nat.floor_le (Real.rpow_nonneg hx.le a))
      _ = _ := Real.log_rpow hx a
  have hlarge' := (div_le_iff₀ (sub_pos.mpr ha1)).mp hlarge
  refine ⟨hL, add_nonneg zero_le_one hlog0, ?_⟩
  nlinarith

theorem primorial_dvd_presieving (H : Finset ℕ) (x : ℝ) :
    _root_.primorial ⌊Real.log (Real.log (Real.log x))⌋₊ ∣
      presievingModulus H x := by
  classical
  rw [primorial_eq_prod_primesLE, presievingModulus]
  exact Finset.prod_dvd_prod_of_subset _ _ id Finset.subset_union_left

theorem finite_mean_le_fragment_mass (W : ℕ) (R ζ : ℝ)
    (hcap : 1 ≤ R ^ ζ) :
    (∑ n ∈ Finset.Icc 1 ⌊R ^ ζ⌋₊,
      if Squarefree n ∧ Nat.Coprime n W then 1 / (n.totient : ℝ) else 0) ≤
      harmonicFragmentMass W R ζ := by
  classical
  rw [← Finset.sum_filter]
  unfold harmonicFragmentMass
  simp only [one_div]
  apply Finset.sum_le_sum_of_subset_of_nonneg
  · intro n hn
    obtain ⟨hn, hsq, hcop⟩ := Finset.mem_filter.mp hn
    obtain ⟨hn1, hnL⟩ := Finset.mem_Icc.mp hn
    apply (mem_fragment_divisors_iff W R ζ hcap n).mpr
    refine ⟨hsq, hcop, ?_⟩
    have hs : n.primeFactors.sup id ≤ n := by
      apply Finset.sup_le_iff.mpr
      intro p hp
      exact Nat.le_of_dvd (by omega) (Nat.dvd_of_mem_primeFactors hp)
    have hnR : (n : ℝ) ≤ R ^ ζ :=
      (Nat.cast_le.mpr hnL).trans (Nat.floor_le (zero_le_one.trans hcap))
    rw [Nat.cast_max, Nat.cast_one]
    exact max_le hcap ((Nat.cast_le.mpr hs).trans hnR)
  · intro n _ _
    positivity

theorem normalized_square_le (M B L Q x W : ℝ)
    (hB : 1 ≤ B) (hx : 0 < x) (hW : 0 < W) :
    2 * (M / B ^ 40 * L * Q) ^ 2 / (x / W / B ^ 40) ≤
      2 * M ^ 2 * W * L ^ 2 * Q ^ 2 / x := by
  have hB0 : 0 < B := zero_lt_one.trans_le hB
  have heq :
      2 * (M / B ^ 40 * L * Q) ^ 2 / (x / W / B ^ 40) =
        (2 * M ^ 2 * W * L ^ 2 * Q ^ 2 / x) / B ^ 40 := by
    field_simp [hB0.ne', hx.ne', hW.ne']
  rw [heq]
  exact div_le_self (by positivity) (one_le_pow₀ hB)

theorem normalized_cross_eq (M B F C D x W : ℝ) (k : ℕ)
    (hB : 0 < B) (hD : 0 < D) (hx : 0 < x) (hW : 0 < W) :
    (x / W * ((M / B ^ k) ^ 2 * (C / D) * F ^ k)) /
        (x / W / B ^ k) = M ^ 2 * C * (F / B) ^ k / D := by
  simp only [div_pow]
  field_simp [hB.ne', hD.ne', hx.ne', hW.ne']

theorem crt_power_identity (M x a : ℝ) (J : ℕ) (hx : 0 < x) :
    2 * M ^ 2 * Real.log x * (x ^ a) ^ 2 * (Real.log x ^ J) ^ 2 / x =
      2 * M ^ 2 * Real.log x ^ (2 * J + 1) / x ^ (1 - 2 * a) := by
  have hp : (x ^ a) ^ 2 / x = 1 / x ^ (1 - 2 * a) := by
    calc
      (x ^ a) ^ 2 / x = x ^ (a * 2) / x ^ (1 : ℝ) := by
        rw [Real.rpow_mul hx.le, Real.rpow_two, Real.rpow_one]
      _ = x ^ (a * 2 - 1) := (Real.rpow_sub hx _ _).symm
      _ = x ^ (-(1 - 2 * a)) := by congr 1; ring
      _ = 1 / x ^ (1 - 2 * a) := by rw [Real.rpow_neg hx.le, one_div]
  have hq : Real.log x * (Real.log x ^ J) ^ 2 = Real.log x ^ (2 * J + 1) := by
    rw [← pow_mul, Nat.mul_comm J 2, pow_succ']
  calc
    _ = 2 * M ^ 2 * (Real.log x * (Real.log x ^ J) ^ 2) *
        ((x ^ a) ^ 2 / x) := by ring
    _ = _ := by rw [hp, hq]; ring

open Classical in
theorem selberg40_uniform_real_diagonal
    {𝓗 : Finset ℕ} {h𝓗_card : 𝓗.card = 40}
    (M : ℝ) (hM : 0 ≤ M) :
    let ρ : ℝ := 2624989 / 10000000
    let S : ℝ := 2742997 / 2624989
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    ∀ ε : ℝ, 0 < ε →
      ∀ᶠ x : ℝ in Filter.atTop,
        let W := presievingModulus 𝓗 x
        let R := x ^ ρ
        let B := fragmentNormalization W R
        ∀ (y : (Fin 40 → ℕ) →₀ ℝ) (v : ℕ),
          (∀ r ∈ y.support,
            Squarefree (∏ i, r i) ∧ Nat.Coprime (∏ i, r i) W ∧
              ((∏ i, r i : ℕ) : ℝ) ≤ R ^ S) →
          (∀ r, |y r| ≤ M / B ^ 40) →
          let D := y.support.biUnion
            (fun r => Fintype.piFinset (fun i => (r i).divisors))
          |(∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
              if Nat.ModEq W n v then
                (∑ d ∈ D, if ∀ i, d i ∣ n + h i then
                  selbergCoefficient y d else 0) ^ 2 else 0) -
            x / (W : ℝ) *
              y.sum (fun r yr => yr ^ 2 / (∏ i, ((r i).totient : ℝ)))| ≤
            ε * (x / (W : ℝ) / B ^ 40) := by
  intro ρ S h ε hε
  let a : ℝ := 2742997 / 10000000
  let J : ℕ := 2 ^ (40 + 2) - 1
  let C : ℝ := 8 * Real.exp 8 * 1560 * (Real.exp 8) ^ 1559
  let d₀ : ℝ → ℕ := fun x => ⌊Real.log (Real.log (Real.log x))⌋₊
  have hρ : 0 < ρ := by norm_num [ρ]
  have hS : 0 < S := by norm_num [S]
  have ha : 0 < a := by norm_num [a]
  have ha1 : a < 1 := by norm_num [a]
  have hδ : 0 < 1 - 2 * a := by norm_num [a]
  have hM2 : 0 ≤ M ^ 2 := by simpa only [pow_two] using mul_nonneg hM hM
  have hC : 0 ≤ C := by dsimp only [C]; positivity
  have hε2 : 0 < ε / 2 := half_pos hε
  have hDnat : Tendsto d₀ atTop atTop :=
    tendsto_nat_floor_atTop.comp (Real.tendsto_log_atTop.comp
      (Real.tendsto_log_atTop.comp Real.tendsto_log_atTop))
  have hDreal : Tendsto (fun x => (d₀ x : ℝ)) atTop atTop :=
    tendsto_natCast_atTop_atTop.comp hDnat
  have hmass := harmonic_fragment_normalizer_tendsto 𝓗 ρ S hρ hS
  have hcrossLimit : Tendsto
      (fun x : ℝ => M ^ 2 * C *
        (harmonicFragmentMass (presievingModulus 𝓗 x) (x ^ ρ) S /
          fragmentNormalization (presievingModulus 𝓗 x) (x ^ ρ)) ^ 40 /
            (d₀ x : ℝ)) atTop (nhds 0) :=
    ((hmass.pow 40).const_mul (M ^ 2 * C)).div_atTop hDreal
  have hlogLimit : Tendsto
      (fun x : ℝ => Real.log x ^ (2 * J + 1) / x ^ (1 - 2 * a))
      atTop (nhds 0) := by
    simpa only [Real.rpow_natCast] using
      (isLittleO_log_rpow_rpow_atTop ((2 * J + 1 : ℕ) : ℝ) hδ).tendsto_div_nhds_zero
  have hcrtLimit : Tendsto
      (fun x : ℝ => 2 * M ^ 2 * Real.log x ^ (2 * J + 1) / x ^ (1 - 2 * a))
      atTop (nhds 0) := by
    simpa only [mul_zero, mul_div_assoc] using hlogLimit.const_mul (2 * M ^ 2)
  filter_upwards [eventually_gt_atTop (1 : ℝ),
    presieving_le_mul_log_eventually 𝓗 ρ hρ,
    presieving_le_mul_log_eventually 𝓗 1 zero_lt_one,
    floor_rpow_log_envelope a ha ha1, hDnat.eventually_gt_atTop 0,
    hcrtLimit.eventually_le_const hε2, hcrossLimit.eventually_le_const hε2]
    with x hx hWρ hWlog hfloor hD₀ hcrt hcross
  intro W R B
  let D₀ : ℕ := d₀ x
  let L : ℕ := ⌊R ^ S⌋₊
  let Q : ℝ := (1 + Real.log (L : ℝ)) ^ J
  let F : ℝ := ∑ n ∈ Finset.Icc 1 L,
    if Squarefree n ∧ Nat.Coprime n W then 1 / (n.totient : ℝ) else 0
  let T : ℝ := harmonicFragmentMass W R S
  let A : ℝ := x / (W : ℝ) / B ^ 40
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hlog : 0 ≤ Real.log x := Real.log_nonneg hx.le
  have hW : 0 < W := presieving_pos 𝓗 x
  have hWR : (0 : ℝ) < W := by exact_mod_cast hW
  have hD₀R : (0 : ℝ) < D₀ := by exact_mod_cast hD₀
  have hcapEq : R ^ S = x ^ a := by
    change (x ^ ρ) ^ S = x ^ a
    rw [← Real.rpow_mul hx0.le]
    congr 1
    norm_num [ρ, S, a]
  have hcap : 1 ≤ R ^ S := by
    rw [hcapEq]
    exact (Nat.one_le_floor_iff _).mp hfloor.1
  have hLle : (L : ℝ) ≤ x ^ a := by
    dsimp only [L]
    rw [hcapEq]
    exact Nat.floor_le (Real.rpow_nonneg hx0.le a)
  have hlogL0 : 0 ≤ 1 + Real.log (L : ℝ) := by
    simpa only [L, hcapEq] using hfloor.2.1
  have hlogL : 1 + Real.log (L : ℝ) ≤ Real.log x := by
    simpa only [L, hcapEq] using hfloor.2.2
  have hQ0 : 0 ≤ Q := pow_nonneg hlogL0 J
  have hQle : Q ≤ Real.log x ^ J := pow_le_pow_left₀ hlogL0 hlogL J
  have hφ : (1 : ℝ) ≤ (Nat.totient W : ℝ) := by
    exact_mod_cast (show 1 ≤ Nat.totient W from Nat.totient_pos.mpr hW)
  have hB1 : 1 ≤ B := by
    change 1 ≤ ((Nat.totient W : ℝ) / (W : ℝ)) * Real.log (x ^ ρ)
    rw [Real.log_rpow hx0, div_mul_eq_mul_div]
    exact (one_le_div hWR).mpr
      (hWρ.trans (le_mul_of_one_le_left (mul_nonneg hρ.le hlog) hφ))
  have hB : 0 < B := zero_lt_one.trans_le hB1
  have hA : 0 < A := div_pos (div_pos hx0 hWR) (pow_pos hB 40)
  have hWlog' : (W : ℝ) ≤ Real.log x := by simpa only [one_mul] using hWlog
  have hF0 : 0 ≤ F := by
    dsimp only [F]
    exact Finset.sum_nonneg fun n _ =>
      ite_nonneg (div_nonneg zero_le_one (Nat.cast_nonneg n.totient)) le_rfl
  have hFT : F ≤ T := finite_mean_le_fragment_mass W R S hcap
  have hCeq :
      (8 * Real.exp 8 / (D₀ : ℝ)) * 1560 * (Real.exp 8) ^ 1559 = C / (D₀ : ℝ) := by
    dsimp only [C]
    rw [div_mul_eq_mul_div, div_mul_eq_mul_div]
  have hinj : Function.Injective h :=
    (𝓗.orderEmbOfFin h𝓗_card).injective
  have hcover : ∀ i j : Fin 40, h i ≠ h j → ∀ p : ℕ,
      p.Prime → p ∣ Nat.dist (h i) (h j) → p ∣ W := by
    intro i j hij p hp hpd
    exact difference_prime_dvd_presieving 𝓗 x
      (𝓗.orderEmbOfFin_mem h𝓗_card i)
      (𝓗.orderEmbOfFin_mem h𝓗_card j) hij hp hpd
  intro y v hy hbound D
  have hD (e : DecidableEq (Fin 40)) :
      y.support.biUnion (fun r => @Fintype.piFinset (Fin 40) e inferInstance
        (fun _ => ℕ) (fun i => (r i).divisors)) = D := by
    ext d
    simp only [D, Finset.mem_biUnion, Fintype.mem_piFinset]
  have hyL : ∀ r ∈ y.support,
      Squarefree (∏ i, r i) ∧ Nat.Coprime (∏ i, r i) W ∧ (∏ i, r i) ≤ L := by
    intro r hr
    exact ⟨(hy r hr).1, (hy r hr).2.1,
      (Nat.le_floor_iff (zero_le_one.trans hcap)).mpr (hy r hr).2.2⟩
  have hl1 := selbergCoefficient_l1_le y L (M / B ^ 40)
    (fun r hr => ⟨(hyL r hr).1, (hyL r hr).2.2⟩) hbound
  simp only [hD, Fintype.card_fin] at hl1
  change (∑ d ∈ D, |selbergCoefficient y d|) ≤ M / B ^ 40 * (L : ℝ) * Q at hl1
  have hsum0 : 0 ≤ ∑ d ∈ D, |selbergCoefficient y d| :=
    Finset.sum_nonneg fun d _ => abs_nonneg _
  have hprod₁ :
      2 * M ^ 2 * (W : ℝ) * (L : ℝ) ^ 2 ≤
        2 * M ^ 2 * Real.log x * (x ^ a) ^ 2 :=
    mul_le_mul
      (mul_le_mul_of_nonneg_left hWlog' (mul_nonneg (by norm_num) hM2))
      (pow_le_pow_left₀ (Nat.cast_nonneg L) hLle 2)
      (sq_nonneg (L : ℝ)) (mul_nonneg (mul_nonneg (by norm_num) hM2) hlog)
  have hprod₂ :
      2 * M ^ 2 * (W : ℝ) * (L : ℝ) ^ 2 * Q ^ 2 ≤
        2 * M ^ 2 * Real.log x * (x ^ a) ^ 2 * (Real.log x ^ J) ^ 2 :=
    mul_le_mul hprod₁ (pow_le_pow_left₀ hQ0 hQle 2) (sq_nonneg Q)
      (mul_nonneg (mul_nonneg (mul_nonneg (by norm_num) hM2) hlog) (sq_nonneg _))
  have hcrtNorm :
      2 * (∑ d ∈ D, |selbergCoefficient y d|) ^ 2 / A ≤
        2 * M ^ 2 * Real.log x ^ (2 * J + 1) / x ^ (1 - 2 * a) := by
    calc
      _ ≤ 2 * (M / B ^ 40 * (L : ℝ) * Q) ^ 2 / A :=
        div_le_div_of_nonneg_right
          (mul_le_mul_of_nonneg_left (pow_le_pow_left₀ hsum0 hl1 2) (by norm_num)) hA.le
      _ ≤ 2 * M ^ 2 * (W : ℝ) * (L : ℝ) ^ 2 * Q ^ 2 / x :=
        normalized_square_le M B (L : ℝ) Q x (W : ℝ) hB1 hx0 hWR
      _ ≤ 2 * M ^ 2 * Real.log x * (x ^ a) ^ 2 * (Real.log x ^ J) ^ 2 / x :=
        div_le_div_of_nonneg_right hprod₂ hx0.le
      _ = _ := crt_power_identity M x a J hx0
  have hcrossNorm :
      (x / (W : ℝ) * ((M / B ^ 40) ^ 2 * (C / (D₀ : ℝ)) * F ^ 40)) / A ≤
        M ^ 2 * C * (T / B) ^ 40 / (D₀ : ℝ) := by
    calc
      _ = M ^ 2 * C * (F / B) ^ 40 / (D₀ : ℝ) :=
        normalized_cross_eq M B F C (D₀ : ℝ) x (W : ℝ) 40 hB hD₀R hx0 hWR
      _ ≤ _ := div_le_div_of_nonneg_right
        (mul_le_mul_of_nonneg_left
          (pow_le_pow_left₀ (div_nonneg hF0 hB.le)
            (div_le_div_of_nonneg_right hFT hB.le) 40) (mul_nonneg hM2 hC)) hD₀R.le
  have hite (n : ℕ) (d : Fin 40 → ℕ) :
      @ite ℝ (∀ i, d i ∣ n + h i) Fintype.decidableForallFintype
        (selbergCoefficient y d) 0 =
          if ∀ i, d i ∣ n + h i then selbergCoefficient y d else 0 :=
    ite_cond_congr rfl
  have htwo := selberg_square_real_interval_two_error h hinj y L W v D₀ (M / B ^ 40)
    hW hD₀ (primorial_dvd_presieving 𝓗 x) hyL hbound hcover x hx0.le
  simp only [hD, hite, Fintype.card_fin] at htwo
  change _ ≤ 2 * (∑ d ∈ D, |selbergCoefficient y d|) ^ 2 +
    x / (W : ℝ) * ((M / B ^ 40) ^ 2 *
      ((8 * Real.exp 8 / (D₀ : ℝ)) * 1560 * (Real.exp 8) ^ 1559) * F ^ 40) at htwo
  rw [hCeq] at htwo
  exact htwo.trans (by
    calc
      _ ≤ (ε / 2) * A + (ε / 2) * A := add_le_add
        ((div_le_iff₀ hA).mp (hcrtNorm.trans hcrt))
        ((div_le_iff₀ hA).mp (hcrossNorm.trans hcross))
      _ = ε * A := by ring)

end

open Classical in
theorem selbergCoefficient_mem_hereditary
    {ι : Type*} [Fintype ι] (y : (ι → ℕ) →₀ ℝ)
    (P : (ι → ℕ) → Prop)
    (hP : ∀ d r, (∀ i, d i ∣ r i) → P r → P d)
    (hy : ∀ r ∈ y.support, P r) (d : ι → ℕ)
    (hd : selbergCoefficient y d ≠ 0) : P d := by
  unfold selbergCoefficient at hd
  obtain ⟨r, hr, hterm⟩ := Finset.exists_ne_zero_of_sum_ne_zero (mul_ne_zero_iff.mp hd).2
  exact hP d r (ite_ne_right_iff.mp hterm).1 (hy r hr)

theorem mixedFace_eq_on_prime
    {k : ℕ} (h : Fin (k + 1) → ℕ) (i : Fin (k + 1))
    (D : Finset (Fin (k + 1) → ℕ)) (lam : (Fin (k + 1) → ℕ) → ℝ)
    (x : ℝ) (n : ℕ) (hn : ⌈x⌉₊ ≤ n) (hp : Nat.Prime (n + h i))
    (hsmall : ∀ d ∈ D, (d i : ℝ) < x + (h i : ℝ)) :
    (∑ d ∈ D, if ∀ j, d j ∣ n + h j then lam d else 0) =
      ∑ d ∈ D.filter (fun d => d i = 1),
        if ∀ j : Fin k, d (i.succAbove j) ∣ n + h (i.succAbove j)
        then lam d else 0 := by
  classical
  have hxn : x ≤ (n : ℝ) := Nat.le_of_ceil_le hn
  rw [Finset.sum_filter]
  apply Finset.sum_congr rfl
  intro d hd
  by_cases hdi : d i = 1
  · have hconditions : (∀ j, d j ∣ n + h j) ↔
        ∀ j : Fin k, d (i.succAbove j) ∣ n + h (i.succAbove j) := by
      rw [Fin.forall_iff_succAbove i]
      simp only [hdi, one_dvd, true_and]
    simp only [hdi, ite_eq_left, hconditions]
  · have hnot : ¬ ∀ j, d j ∣ n + h j := by
      intro hdiv
      rcases (Nat.dvd_prime hp).mp (hdiv i) with hunit | hself
      · exact hdi hunit
      · have hlt : (d i : ℝ) < ((n + h i : ℕ) : ℝ) := by
          push_cast
          exact (hsmall d hd).trans_le (add_le_add hxn le_rfl)
        exact (ne_of_lt hlt) (congrArg (fun m : ℕ => (m : ℝ)) hself)
    simp only [hdi, hnot, ite_false]

theorem mixedPair_compatible
    {k : ℕ} (h : Fin (k + 1) → ℕ) (hinj : Function.Injective h)
    (i : Fin (k + 1)) (d : Fin (k + 1) → ℕ) (e : Fin k → ℕ)
    (W : ℕ) (hdW : Nat.Coprime (∏ j, d j) W)
    (hcover : ∀ a b : Fin (k + 1), h a ≠ h b → ∀ p : ℕ,
      p.Prime → p ∣ Nat.dist (h a) (h b) → p ∣ W)
    (n : ℕ)
    (hnd : ∀ j : Fin k, d (i.succAbove j) ∣ n + h (i.succAbove j))
    (hne : ∀ j : Fin k, e j ∣ n + h (i.succAbove j)) :
    ∀ a b : Fin k, a ≠ b → Nat.Coprime (d (i.succAbove a)) (e b) := by
  intro a b hab
  apply Nat.coprime_of_dvd
  intro p hp hpa hpb
  have hpa' := dvd_trans hpa (hnd a)
  have hpb' := dvd_trans hpb (hne b)
  have hdist : p ∣ Nat.dist (h (i.succAbove a)) (h (i.succAbove b)) := by
    rw [← Nat.dist_add_add_left n, Nat.dist]
    exact dvd_add (Nat.dvd_sub hpa' hpb') (Nat.dvd_sub hpb' hpa')
  have hneShift : h (i.succAbove a) ≠ h (i.succAbove b) :=
    hinj.ne (Fin.succAbove_right_injective.ne hab)
  have hpW := hcover _ _ hneShift p hp hdist
  have hcoordW := Nat.coprime_fintype_prod_left_iff.mp hdW (i.succAbove a)
  exact Nat.not_coprime_of_dvd_of_dvd hp.one_lt hpa hpW hcoordW

theorem mixedFace_sum_expand
    {k : ℕ} (h : Fin (k + 1) → ℕ) (i : Fin (k + 1))
    (D : Finset (Fin (k + 1) → ℕ)) (E : Finset (Fin k → ℕ))
    (lamOuter : (Fin (k + 1) → ℕ) → ℝ) (lamInner : (Fin k → ℕ) → ℝ)
    (W v : ℕ) (I : Finset ℕ) (f : ℕ → ℝ) :
    (∑ n ∈ I, if Nat.ModEq W n v then
      f (n + h i) *
        (∑ d ∈ D,
          if ∀ j : Fin k, d (i.succAbove j) ∣ n + h (i.succAbove j)
          then lamOuter d else 0) *
        (∑ e ∈ E,
          if ∀ j : Fin k, e j ∣ n + h (i.succAbove j) then lamInner e else 0)
      else 0) =
      ∑ d ∈ D, ∑ e ∈ E, (lamOuter d * lamInner e) *
        ∑ n ∈ I,
          if Nat.ModEq W n v ∧
            (∀ j : Fin k, d (i.succAbove j) ∣ n + h (i.succAbove j)) ∧
            (∀ j : Fin k, e j ∣ n + h (i.succAbove j))
          then f (n + h i) else 0 := by
  classical
  calc
    _ = ∑ n ∈ I, ∑ d ∈ D, ∑ e ∈ E,
        if Nat.ModEq W n v ∧
          (∀ j : Fin k, d (i.succAbove j) ∣ n + h (i.succAbove j)) ∧
          (∀ j : Fin k, e j ∣ n + h (i.succAbove j))
        then f (n + h i) * lamOuter d * lamInner e else 0 := by
      apply Finset.sum_congr rfl
      intro n _
      by_cases hnv : Nat.ModEq W n v
      · simp only [hnv, ite_true, true_and]
        rw [mul_assoc, Finset.sum_mul_sum, Finset.mul_sum]
        apply Finset.sum_congr rfl
        intro d _
        rw [Finset.mul_sum]
        apply Finset.sum_congr rfl
        intro e _
        by_cases hnd : ∀ j : Fin k, d (i.succAbove j) ∣ n + h (i.succAbove j) <;>
          by_cases hne : ∀ j : Fin k, e j ∣ n + h (i.succAbove j) <;>
          simp [hnd, hne, mul_assoc]
      · simp only [hnv, ite_false, false_and, Finset.sum_const_zero]
    _ = ∑ d ∈ D, ∑ e ∈ E, ∑ n ∈ I,
        if Nat.ModEq W n v ∧
          (∀ j : Fin k, d (i.succAbove j) ∣ n + h (i.succAbove j)) ∧
          (∀ j : Fin k, e j ∣ n + h (i.succAbove j))
        then f (n + h i) * lamOuter d * lamInner e else 0 := by
      rw [Finset.sum_comm]
      apply Finset.sum_congr rfl
      intro d _
      exact Finset.sum_comm
    _ = _ := by
      simp only [Finset.mul_sum, mul_ite, mul_zero, mul_left_comm, mul_comm]

theorem mixedPair_crt {k : ℕ} (h : Fin (k + 1) → ℕ)
    (hinj : Function.Injective h) (i : Fin (k + 1))
    (d : Fin (k + 1) → ℕ) (e : Fin k → ℕ) (W v : ℕ) (hW : 0 < W)
    (hd : Squarefree (∏ j, d j) ∧ Nat.Coprime (∏ j, d j) W)
    (he : Squarefree (∏ j, e j) ∧ Nat.Coprime (∏ j, e j) W)
    (hc : ∀ a b : Fin k, a ≠ b → Nat.Coprime (d (i.succAbove a)) (e b))
    (hcover : ∀ a b : Fin (k + 1), h a ≠ h b → ∀ p : ℕ,
      p.Prime → p ∣ Nat.dist (h a) (h b) → p ∣ W)
    (hv : Nat.Coprime (v + h i) W) :
    let q := W * ∏ j : Fin k, Nat.lcm (d (i.succAbove j)) (e j)
    ∃ c : ℕ, 0 < q ∧ c < q ∧ Nat.Coprime (c + h i) q ∧
      ∀ n : ℕ, Nat.ModEq q n c ↔ Nat.ModEq W n v ∧
        (∀ j : Fin k, d (i.succAbove j) ∣ n + h (i.succAbove j)) ∧
        (∀ j : Fin k, e j ∣ n + h (i.succAbove j)) := by
  classical
  dsimp only
  have hd0 (j : Fin (k + 1)) : d j ≠ 0 :=
    (hd.1.squarefree_of_dvd (Finset.dvd_prod_of_mem d (Finset.mem_univ j))).ne_zero
  have he0 (j : Fin k) : e j ≠ 0 :=
    (he.1.squarefree_of_dvd (Finset.dvd_prod_of_mem e (Finset.mem_univ j))).ne_zero
  have hdW (j : Fin (k + 1)) : Nat.Coprime (d j) W :=
    Nat.coprime_fintype_prod_left_iff.mp hd.2 j
  have heW (j : Fin k) : Nat.Coprime (e j) W :=
    Nat.coprime_fintype_prod_left_iff.mp he.2 j
  have hneg (m t n : ℕ) (hm : 0 < m) :
      Nat.ModEq m n (m - t % m) ↔ m ∣ n + t := by
    have hres : Nat.ModEq m (m - t % m + t) 0 := by
      have ht := (Nat.mod_modEq t m).add_left (m - t % m)
      rw [Nat.sub_add_cancel (Nat.mod_lt t hm).le] at ht
      exact ht.symm.trans (Nat.modEq_zero_iff_dvd.mpr (dvd_refl m))
    constructor
    · intro hn
      exact Nat.modEq_zero_iff_dvd.mp ((hn.add_right t).trans hres)
    · intro hn
      exact Nat.ModEq.add_right_cancel' t
        ((Nat.modEq_zero_iff_dvd.mpr hn).trans hres.symm)
  let s : Option (Fin k) → ℕ := fun o =>
    o.elim W (fun j => Nat.lcm (d (i.succAbove j)) (e j))
  let a : Option (Fin k) → ℕ := fun o =>
    o.elim v (fun j =>
      Nat.lcm (d (i.succAbove j)) (e j) -
        h (i.succAbove j) % Nat.lcm (d (i.succAbove j)) (e j))
  let l := (Finset.univ : Finset (Option (Fin k))).toList
  have hpos (j : Fin k) : 0 < Nat.lcm (d (i.succAbove j)) (e j) :=
    Nat.pos_of_ne_zero (Nat.lcm_ne_zero (hd0 (i.succAbove j)) (he0 j))
  have hWs (j : Fin k) : Nat.Coprime W (s (some j)) := by
    change Nat.Coprime W (Nat.lcm (d (i.succAbove j)) (e j))
    exact Nat.Coprime.of_dvd_right (Nat.lcm_dvd_mul _ _)
      ((hdW (i.succAbove j)).symm.mul_right (heW j).symm)
  have hss (j m : Fin k) (hjm : j ≠ m) :
      Nat.Coprime (s (some j)) (s (some m)) := by
    have hret : i.succAbove j ≠ i.succAbove m :=
      Fin.succAbove_right_injective.ne hjm
    have h₁ : Nat.Coprime (d (i.succAbove j)) (d (i.succAbove m) * e m) :=
      (coprime_of_squarefree_fintype_prod d hd.1 hret).mul_right (hc j m hjm)
    have h₂ : Nat.Coprime (e j) (d (i.succAbove m) * e m) :=
      ((hc m j hjm.symm).symm).mul_right
        (coprime_of_squarefree_fintype_prod e he.1 hjm)
    exact Nat.Coprime.of_dvd (Nat.lcm_dvd_mul _ _) (Nat.lcm_dvd_mul _ _)
      (h₁.mul_left h₂)
  have co : l.Pairwise (fun u z => Nat.Coprime (s u) (s z)) := by
    change ((Finset.univ : Finset (Option (Fin k))).toList).Pairwise _
    refine ((Finset.univ : Finset (Option (Fin k))).nodup_toList).pairwise_of_forall_ne ?_
    intro u hu z hz huz
    cases u with
    | none =>
      cases z with
      | none => exact (huz rfl).elim
      | some j => exact hWs j
    | some j =>
      cases z with
      | none => exact (hWs j).symm
      | some m => exact hss j m (by simpa using huz)
  let c : ℕ := Nat.chineseRemainderOfList a s l co
  have hprod : (l.map s).prod = W * ∏ j : Fin k, Nat.lcm (d (i.succAbove j)) (e j) := by
    simp [l, s]
  have hcrtOption (n : ℕ) :
      Nat.ModEq (W * ∏ j : Fin k, Nat.lcm (d (i.succAbove j)) (e j)) n c ↔
        ∀ o : Option (Fin k), Nat.ModEq (s o) n (a o) := by
    rw [← hprod]
    change Nat.ModEq (l.map s).prod n
      (Nat.chineseRemainderOfList a s l co : ℕ) ↔ _
    constructor
    · intro hn o
      have ho : o ∈ l := by simp [l]
      exact ((Nat.modEq_list_map_prod_iff co).mp hn o ho).trans
        ((Nat.chineseRemainderOfList a s l co).property o ho)
    · intro hn
      exact Nat.chineseRemainderOfList_modEq_unique a s l co (fun o _ => hn o)
  have hclass (n : ℕ) :
      Nat.ModEq (W * ∏ j : Fin k, Nat.lcm (d (i.succAbove j)) (e j)) n c ↔
        Nat.ModEq W n v ∧
          (∀ j : Fin k, d (i.succAbove j) ∣ n + h (i.succAbove j)) ∧
          (∀ j : Fin k, e j ∣ n + h (i.succAbove j)) := by
    rw [hcrtOption]
    constructor
    · intro hn
      refine ⟨hn none, ?_, ?_⟩
      · intro j
        exact (Nat.lcm_dvd_iff.mp ((hneg _ _ _ (hpos j)).mp (hn (some j)))).1
      · intro j
        exact (Nat.lcm_dvd_iff.mp ((hneg _ _ _ (hpos j)).mp (hn (some j)))).2
    · rintro ⟨hn, hdn, hen⟩ o
      cases o with
      | none => exact hn
      | some j =>
        exact (hneg _ _ _ (hpos j)).mpr (Nat.lcm_dvd (hdn j) (hen j))
  have hcclass := (hclass c).mp (Nat.ModEq.refl c)
  have hcW : Nat.Coprime (c + h i) W := by
    rw [Nat.coprime_iff_gcd_eq_one, (hcclass.1.add_right (h i)).gcd_eq]
    exact hv
  have hclcm (j : Fin k) :
      Nat.Coprime (c + h i) (Nat.lcm (d (i.succAbove j)) (e j)) := by
    apply Nat.coprime_of_dvd
    intro p hp hpi hplcm
    have hpj : p ∣ c + h (i.succAbove j) :=
      dvd_trans hplcm (Nat.lcm_dvd (hcclass.2.1 j) (hcclass.2.2 j))
    have hdist : p ∣ Nat.dist (h i) (h (i.succAbove j)) := by
      rw [← Nat.dist_add_add_left c, Nat.dist]
      exact dvd_add (Nat.dvd_sub hpi hpj) (Nat.dvd_sub hpj hpi)
    have hij : h i ≠ h (i.succAbove j) := hinj.ne (Fin.ne_succAbove i j)
    have hpW := hcover i (i.succAbove j) hij p hp hdist
    exact Nat.not_coprime_of_dvd_of_dvd hp.one_lt hpi hpW hcW
  have hq : 0 < W * ∏ j : Fin k, Nat.lcm (d (i.succAbove j)) (e j) :=
    Nat.mul_pos hW (Finset.prod_pos fun j _ => hpos j)
  have hlt : c < W * ∏ j : Fin k, Nat.lcm (d (i.succAbove j)) (e j) := by
    rw [← hprod]
    apply Nat.chineseRemainderOfList_lt_prod a s l co
    intro o _
    cases o with
    | none => exact hW.ne'
    | some j => exact (hpos j).ne'
  exact ⟨c, hq, hlt,
    hcW.mul_right (Nat.coprime_fintype_prod_right_iff.mpr hclcm), hclass⟩

open Classical in
theorem selberg_mixed_vonMangoldt_real_interval_crt
    {k : ℕ} (h : Fin (k + 1) → ℕ) (hinj : Function.Injective h)
    (i : Fin (k + 1))
    (D : Finset (Fin (k + 1) → ℕ)) (E : Finset (Fin k → ℕ))
    (lamOuter : (Fin (k + 1) → ℕ) → ℝ)
    (lamInner : (Fin k → ℕ) → ℝ)
    (W v : ℕ) (hW : 0 < W)
    (hD : ∀ d ∈ D,
      Squarefree (∏ j, d j) ∧ Nat.Coprime (∏ j, d j) W)
    (hE : ∀ e ∈ E,
      Squarefree (∏ j, e j) ∧ Nat.Coprime (∏ j, e j) W)
    (hcover : ∀ a b : Fin (k + 1), h a ≠ h b → ∀ p : ℕ,
      p.Prime → p ∣ Nat.dist (h a) (h b) → p ∣ W)
    (hv : Nat.Coprime (v + h i) W)
    (x : ℝ) (_hx : 0 < x)
    (hsmall : ∀ d ∈ D, (d i : ℝ) < x + (h i : ℝ)) :
    let I := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
    let Dface := D.filter (fun d => d i = 1)
    let outerRoot : ℕ → ℝ := fun n =>
      ∑ d ∈ D, if ∀ j, d j ∣ n + h j then lamOuter d else 0
    let faceRoot : ℕ → ℝ := fun n =>
      ∑ d ∈ Dface,
        if ∀ j : Fin k, d (i.succAbove j) ∣ n + h (i.succAbove j)
        then lamOuter d else 0
    let innerRoot : ℕ → ℝ := fun n =>
      ∑ e ∈ E, if ∀ j, e j ∣ n + h (i.succAbove j) then lamInner e else 0
    let modulus : (Fin (k + 1) → ℕ) → (Fin k → ℕ) → ℕ := fun d e =>
      W * ∏ j : Fin k, Nat.lcm (d (i.succAbove j)) (e j)
    let mean : ℕ → ℝ := fun q =>
      (∑ n ∈ I,
        if Nat.Coprime (n + h i) q then ArithmeticFunction.vonMangoldt (n + h i)
        else 0) / (q.totient : ℝ)
    let primePowerCorrection : ℝ :=
      ∑ n ∈ I, if Nat.ModEq W n v then
        (ArithmeticFunction.vonMangoldt (n + h i) -
          (if Nat.Prime (n + h i) then Real.log ((n + h i : ℕ) : ℝ) else 0)) *
          (outerRoot n - faceRoot n) * innerRoot n
        else 0
    (∀ n ∈ I, Nat.Prime (n + h i) → outerRoot n = faceRoot n) ∧
      ∃ residue : (Fin (k + 1) → ℕ) → (Fin k → ℕ) → ℕ,
        (∀ d ∈ Dface, ∀ e ∈ E,
          (∀ a b : Fin k, a ≠ b → Nat.Coprime (d (i.succAbove a)) (e b)) →
          0 < modulus d e ∧ residue d e < modulus d e ∧
            Nat.Coprime (residue d e + h i) (modulus d e) ∧
            ∀ n : ℕ,
              Nat.ModEq (modulus d e) n (residue d e) ↔
                Nat.ModEq W n v ∧
                  (∀ j : Fin k, d (i.succAbove j) ∣ n + h (i.succAbove j)) ∧
                  (∀ j : Fin k, e j ∣ n + h (i.succAbove j))) ∧
        (∑ n ∈ I, if Nat.ModEq W n v then
          ArithmeticFunction.vonMangoldt (n + h i) * outerRoot n * innerRoot n
          else 0) =
          (∑ d ∈ Dface, ∑ e ∈ E,
            if ∀ a b : Fin k, a ≠ b → Nat.Coprime (d (i.succAbove a)) (e b)
            then lamOuter d * lamInner e *
              (mean (modulus d e) +
                ((∑ n ∈ I,
                  if Nat.ModEq (modulus d e) (n + h i) (residue d e + h i)
                  then ArithmeticFunction.vonMangoldt (n + h i) else 0) -
                    mean (modulus d e)))
            else 0) + primePowerCorrection := by
  intro I Dface outerRoot faceRoot innerRoot modulus mean primePowerCorrection
  have hprime : ∀ n ∈ I, Nat.Prime (n + h i) → outerRoot n = faceRoot n := by
    intro n hn hp
    exact mixedFace_eq_on_prime h i D lamOuter x n (Finset.mem_Icc.mp hn).1 hp hsmall
  have hpair (d : Fin (k + 1) → ℕ) (hd : d ∈ Dface)
      (e : Fin k → ℕ) (he : e ∈ E)
      (hc : ∀ a b : Fin k, a ≠ b → Nat.Coprime (d (i.succAbove a)) (e b)) :
      ∃ c : ℕ, 0 < modulus d e ∧ c < modulus d e ∧
        Nat.Coprime (c + h i) (modulus d e) ∧
        ∀ n : ℕ, Nat.ModEq (modulus d e) n c ↔
          Nat.ModEq W n v ∧
            (∀ j : Fin k, d (i.succAbove j) ∣ n + h (i.succAbove j)) ∧
            (∀ j : Fin k, e j ∣ n + h (i.succAbove j)) :=
    mixedPair_crt h hinj i d e W v hW (hD d (Finset.mem_filter.mp hd).1)
      (hE e he) hc hcover hv
  let residue : (Fin (k + 1) → ℕ) → (Fin k → ℕ) → ℕ := fun d e =>
    if hd : d ∈ Dface then
      if he : e ∈ E then
        if hc : ∀ a b : Fin k, a ≠ b → Nat.Coprime (d (i.succAbove a)) (e b)
        then Classical.choose (hpair d hd e he hc) else 0
      else 0
    else 0
  have hresidue (d : Fin (k + 1) → ℕ) (hd : d ∈ Dface)
      (e : Fin k → ℕ) (he : e ∈ E)
      (hc : ∀ a b : Fin k, a ≠ b → Nat.Coprime (d (i.succAbove a)) (e b)) :
      0 < modulus d e ∧ residue d e < modulus d e ∧
        Nat.Coprime (residue d e + h i) (modulus d e) ∧
        ∀ n : ℕ, Nat.ModEq (modulus d e) n (residue d e) ↔
          Nat.ModEq W n v ∧
            (∀ j : Fin k, d (i.succAbove j) ∣ n + h (i.succAbove j)) ∧
            (∀ j : Fin k, e j ∣ n + h (i.succAbove j)) := by
    simpa only [residue, dite_eq_left hd, dite_eq_left he, dite_eq_left hc] using
      Classical.choose_spec (hpair d hd e he hc)
  refine ⟨hprime, residue, hresidue, ?_⟩
  have hface :
      (∑ n ∈ I, if Nat.ModEq W n v then
        ArithmeticFunction.vonMangoldt (n + h i) * faceRoot n * innerRoot n
        else 0) =
        ∑ d ∈ Dface, ∑ e ∈ E,
          if ∀ a b : Fin k, a ≠ b → Nat.Coprime (d (i.succAbove a)) (e b)
          then lamOuter d * lamInner e *
            (mean (modulus d e) +
              ((∑ n ∈ I,
                if Nat.ModEq (modulus d e) (n + h i) (residue d e + h i)
                then ArithmeticFunction.vonMangoldt (n + h i) else 0) -
                  mean (modulus d e)))
          else 0 := by
    dsimp only [faceRoot, innerRoot]
    rw [mixedFace_sum_expand]
    apply Finset.sum_congr rfl
    intro d hd
    apply Finset.sum_congr rfl
    intro e he
    by_cases hc : ∀ a b : Fin k, a ≠ b → Nat.Coprime (d (i.succAbove a)) (e b)
    · rw [ite_eq_left hc, ← add_sub_assoc, add_sub_cancel_left]
      congr 1
      apply Finset.sum_congr rfl
      intro n _
      have hclass := (hresidue d hd e he hc).2.2.2 n
      have hshift : Nat.ModEq (modulus d e) (n + h i) (residue d e + h i) ↔
          Nat.ModEq (modulus d e) n (residue d e) :=
        Nat.ModEq.add_iff_right (Nat.ModEq.refl (h i))
      simp only [hshift, hclass]
    · rw [ite_eq_right hc]
      have hzero : (∑ n ∈ I,
          if Nat.ModEq W n v ∧
            (∀ j : Fin k, d (i.succAbove j) ∣ n + h (i.succAbove j)) ∧
            (∀ j : Fin k, e j ∣ n + h (i.succAbove j))
          then ArithmeticFunction.vonMangoldt (n + h i) else 0) = 0 := by
        apply Finset.sum_eq_zero
        intro n _
        apply ite_eq_right
        intro hconditions
        exact hc (mixedPair_compatible h hinj i d e W
          (hD d (Finset.mem_filter.mp hd).1).2 hcover n
          hconditions.2.1 hconditions.2.2)
      rw [hzero, mul_zero]
  have hcorrection :
      (∑ n ∈ I, if Nat.ModEq W n v then
        ArithmeticFunction.vonMangoldt (n + h i) * outerRoot n * innerRoot n
        else 0) =
        (∑ n ∈ I, if Nat.ModEq W n v then
          ArithmeticFunction.vonMangoldt (n + h i) * faceRoot n * innerRoot n
          else 0) + primePowerCorrection := by
    dsimp only [primePowerCorrection]
    rw [← Finset.sum_add_distrib]
    apply Finset.sum_congr rfl
    intro n hn
    by_cases hnv : Nat.ModEq W n v
    · simp only [hnv, ite_true]
      by_cases hp : Nat.Prime (n + h i)
      · rw [hprime n hn hp]
        ring
      · simp only [hp, ite_false, sub_zero]
        ring
    · simp only [hnv, ite_false, add_zero]
  exact hcorrection.trans (congrArg (fun s : ℝ => s + primePowerCorrection) hface)

theorem actual_modulus_pairwise_coprime_lcm
    {k : ℕ} (d e : Fin k → ℕ)
    (hd : Squarefree (∏ i, d i)) (he : Squarefree (∏ i, e i))
    (hcross : ∀ i j : Fin k, i ≠ j → Nat.Coprime (d i) (e j)) :
    Set.Pairwise ((Finset.univ : Finset (Fin k)) : Set (Fin k))
      (Function.onFun Nat.Coprime (fun i => Nat.lcm (d i) (e i))) := by
  intro i _ j _ hij
  have hdd := coprime_of_squarefree_fintype_prod d hd hij
  have hee := coprime_of_squarefree_fintype_prod e he hij
  have hi : Nat.Coprime (d i) (d j * e j) := hdd.mul_right (hcross i j hij)
  have hj : Nat.Coprime (e i) (d j * e j) :=
    (hcross j i hij.symm).symm.mul_right hee
  exact Nat.Coprime.of_dvd (Nat.lcm_dvd_mul (d i) (e i))
    (Nat.lcm_dvd_mul (d j) (e j)) (hi.mul_left hj)

theorem actual_modulus_coprime_W_prod_lcm
    {k : ℕ} (W : ℕ) (d e : Fin k → ℕ)
    (hd : Nat.Coprime (∏ i, d i) W) (he : Nat.Coprime (∏ i, e i) W) :
    Nat.Coprime W (∏ i, Nat.lcm (d i) (e i)) := by
  apply Nat.Coprime.prod_right
  intro i _
  have hWd := (Nat.coprime_fintype_prod_left_iff.mp hd i).symm
  have hWe := (Nat.coprime_fintype_prod_left_iff.mp he i).symm
  exact Nat.Coprime.of_dvd_right (Nat.lcm_dvd_mul (d i) (e i))
    (hWd.mul_right hWe)

theorem actual_modulus_eq_product
    {k : ℕ} (W : ℕ) (d e : Fin k → ℕ)
    (hd : Squarefree (∏ i, d i) ∧ Nat.Coprime (∏ i, d i) W)
    (he : Squarefree (∏ i, e i) ∧ Nat.Coprime (∏ i, e i) W)
    (hcross : ∀ i j : Fin k, i ≠ j → Nat.Coprime (d i) (e j)) :
    Nat.lcm W (Nat.lcm (∏ i, d i) (∏ i, e i)) =
      W * ∏ i, Nat.lcm (d i) (e i) := by
  classical
  have hpair := actual_modulus_pairwise_coprime_lcm d e hd.1 he.1 hcross
  have hprod : (∏ i, Nat.lcm (d i) (e i)) =
      Nat.lcm (∏ i, d i) (∏ i, e i) := by
    apply Nat.dvd_antisymm
    · rw [← Finset.lcm_eq_prod hpair]
      apply Finset.lcm_dvd
      intro i _
      exact Nat.lcm_dvd
        ((Finset.dvd_prod_of_mem d (Finset.mem_univ i)).trans (Nat.dvd_lcm_left _ _))
        ((Finset.dvd_prod_of_mem e (Finset.mem_univ i)).trans (Nat.dvd_lcm_right _ _))
    · apply Nat.lcm_dvd
      · exact Finset.prod_dvd_prod_of_dvd d (fun i => Nat.lcm (d i) (e i))
          (fun i _ => Nat.dvd_lcm_left (d i) (e i))
      · exact Finset.prod_dvd_prod_of_dvd e (fun i => Nat.lcm (d i) (e i))
          (fun i _ => Nat.dvd_lcm_right (d i) (e i))
  rw [← hprod]
  exact (actual_modulus_coprime_W_prod_lcm W d e hd.2 he.2).lcm_eq_mul

theorem finMulAntidiag_filter_coordinate
    {r n a : ℕ} {i : Fin (r + 1)} :
    {d ∈ (r + 1).finMulAntidiag n | d i = a} =
      if a ∣ n then (r.finMulAntidiag (n / a)).map
        ⟨i.insertNth a, Fin.insertNth_right_injective _⟩ else ∅ := by
  classical
  ext d
  obtain ⟨⟨b, d⟩, rfl⟩ := (Fin.insertNthEquiv (fun _ ↦ ℕ) i).surjective d
  have hinsert : (Fin.insertNthEquiv (fun _ ↦ ℕ) i) (b, d) =
      i.insertNth b d := rfl
  rw [hinsert]
  simp_rw [Finset.mem_filter, mem_ite, Finset.mem_map,
    Function.Embedding.coeFn_mk, Nat.mem_finMulAntidiag, Finset.notMem_empty,
    imp_false, not_not, show ∀ p q, (p → q) ∧ p ↔ p ∧ q by grind,
    Fin.insertNth_apply_same, Fin.prod_insertNth, Fin.insertNth_inj]
  constructor
  · rintro ⟨⟨rfl, hn⟩, rfl⟩
    grind [dvd_mul_right, mul_ne_zero_iff, Nat.mul_div_cancel_left]
  · rintro ⟨han, e, ⟨he, hna⟩, rfl, rfl⟩
    rw [he, Nat.mul_div_cancel' han]
    grind [Nat.div_ne_zero_iff.mp hna]

theorem zeta_pow_eq_card_finMulAntidiag {r n : ℕ} :
    ((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ r) n =
      (r.finMulAntidiag n).card := by
  classical
  induction r generalizing n with
  | zero =>
      by_cases hn : n = 1
      · rw [hn, pow_zero, ArithmeticFunction.one_one,
          Nat.finMulAntidiag_one, Finset.card_singleton]
      · rw [pow_zero, ArithmeticFunction.one_apply_ne hn,
          Nat.finMulAntidiag_zero_left hn, Finset.card_empty]
  | succ r ih =>
      obtain rfl | hn := eq_or_ne n 0
      · exact ArithmeticFunction.map_zero
      obtain rfl | hr := eq_or_ne r 0
      · rw [pow_one, ArithmeticFunction.zeta_apply_ne hn]
        refine (Finset.card_eq_one.mpr ⟨fun _ ↦ n, ?_⟩).symm
        ext d
        rw [Nat.mem_finMulAntidiag, Fin.prod_univ_one, and_iff_left hn,
          Finset.mem_singleton]
        exact ⟨fun h ↦ funext fun i ↦ (congrArg d (Fin.fin_one_eq_zero i)).trans h,
          fun h ↦ congrFun h 0⟩
      rw [pow_succ, ArithmeticFunction.mul_apply,
        Finset.card_eq_sum_card_image (fun d ↦ d (Fin.last r)),
        Nat.image_apply_finMulAntidiag (by omega),
        Nat.sum_divisorsAntidiagonal'
          (fun a b ↦ ((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ r) a *
            ArithmeticFunction.zeta b)]
      refine Finset.sum_congr rfl fun a ha ↦ ?_
      rw [Nat.mem_divisors] at ha
      rw [finMulAntidiag_filter_coordinate, ite_eq_left ha.1, Finset.card_map, ih,
        ArithmeticFunction.zeta_apply_ne (_root_.ne_zero_of_dvd_ne_zero hn ha.1), mul_one]

theorem one_le_zeta_pow {r n : ℕ} (hr : 0 < r) (hn : 0 < n) :
    1 ≤ ((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ r) n := by
  classical
  rw [zeta_pow_eq_card_finMulAntidiag, Nat.one_le_iff_ne_zero, Finset.card_ne_zero]
  refine ⟨fun i ↦ if i = (⟨0, hr⟩ : Fin r) then n else 1, ?_⟩
  rw [Nat.mem_finMulAntidiag]
  exact ⟨by simp [Finset.prod_ite_eq' Finset.univ (⟨0, hr⟩ : Fin r) (fun _ ↦ n)], hn.ne'⟩

theorem product_lcm_fiber_card_le
    {k : ℕ} (hk : 0 < k) (W : ℕ) (hW : 0 < W)
    (D E : Finset (Fin k → ℕ))
    (hD : ∀ d ∈ D, (∀ i, 0 < d i) ∧ Nat.Coprime (∏ i, d i) W)
    (hE : ∀ e ∈ E, (∀ i, 0 < e i) ∧ Nat.Coprime (∏ i, e i) W)
    (q : ℕ) :
    (((D.product E).filter fun p =>
      W * ∏ i, Nat.lcm (p.1 i) (p.2 i) = q).card) ≤
      ((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (3 * k)) q := by
  classical
  set F := (D.product E).filter fun p => W * ∏ i, Nat.lcm (p.1 i) (p.2 i) = q
  rcases Finset.eq_empty_or_nonempty F with hF | ⟨p₀, hp₀⟩
  · simp [hF]
  obtain ⟨hpD₀, hpE₀⟩ := Finset.mem_product.mp (Finset.mem_filter.mp hp₀).1
  obtain ⟨hd₀, hdcop₀⟩ := hD p₀.1 hpD₀
  obtain ⟨he₀, hecop₀⟩ := hE p₀.2 hpE₀
  have hqOf : ∀ p ∈ F, W * ∏ i, Nat.lcm (p.1 i) (p.2 i) = q :=
    fun _ hp ↦ (Finset.mem_filter.mp hp).2
  let m := ∏ i, Nat.lcm (p₀.1 i) (p₀.2 i)
  have hm : 0 < m := Finset.prod_pos fun i _ ↦ Nat.lcm_pos (hd₀ i) (he₀ i)
  have hq : q = W * m := (hqOf p₀ hp₀).symm
  have hWm : Nat.Coprime W m :=
    actual_modulus_coprime_W_prod_lcm W p₀.1 p₀.2 hdcop₀ hecop₀
  have hz : ((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (3 * k)) m ≤
      ((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (3 * k)) q := by
    rw [hq, (ArithmeticFunction.isMultiplicative_zeta.pow (k := 3 * k)).map_mul_of_coprime hWm]
    exact Nat.le_mul_of_pos_left _ (one_le_zeta_pow (by omega) hW)
  refine le_trans ?_ hz
  rw [zeta_pow_eq_card_finMulAntidiag]
  let eqv : Fin 3 × Fin k ≃ Fin (3 * k) := finProdFinEquiv
  let slot : Fin 3 → ℕ → ℕ → ℕ := fun s a b ↦
    if s = 0 then Nat.gcd a b else if s = 1 then a / Nat.gcd a b else b / Nat.gcd a b
  let encode : ((Fin k → ℕ) × (Fin k → ℕ)) → Fin (3 * k) → ℕ := fun p j ↦
    slot (eqv.symm j).1 (p.1 (eqv.symm j).2) (p.2 (eqv.symm j).2)
  apply Finset.card_le_card_of_injOn encode
  · intro p hp
    have hprod : (∏ j, encode p j) =
        ∏ x : Fin 3 × Fin k, slot x.1 (p.1 x.2) (p.2 x.2) :=
      (Fintype.prod_equiv eqv _ (encode p) fun x ↦ by
        simp [encode, Equiv.symm_apply_apply]).symm
    have hlocal : ∀ i, slot 0 (p.1 i) (p.2 i) * slot 1 (p.1 i) (p.2 i) *
        slot 2 (p.1 i) (p.2 i) = Nat.lcm (p.1 i) (p.2 i) := fun i ↦ by
      dsimp [slot]
      rw [Nat.mul_div_cancel' (Nat.gcd_dvd_left (p.1 i) (p.2 i)),
        ← Nat.mul_div_assoc _ (Nat.gcd_dvd_right (p.1 i) (p.2 i)), Nat.lcm_eq_mul_div]
    have hencode : (∏ j, encode p j) = ∏ i, Nat.lcm (p.1 i) (p.2 i) := by
      rw [hprod, Fintype.prod_prod_type' (fun a b ↦ slot a (p.1 b) (p.2 b)),
        Finset.prod_comm]
      exact Finset.prod_congr rfl fun i _ ↦ (Fin.prod_univ_three _).trans (hlocal i)
    have hmod : ∏ i, Nat.lcm (p.1 i) (p.2 i) = m :=
      Nat.eq_of_mul_eq_mul_left hW (by rw [hqOf p hp, hq])
    exact Nat.mem_finMulAntidiag.mpr ⟨hencode.trans hmod, hm.ne'⟩
  · intro p _ p' _ hencode
    have hslot : ∀ (s : Fin 3) (i : Fin k),
        slot s (p.1 i) (p.2 i) = slot s (p'.1 i) (p'.2 i) := fun s i ↦ by
      simpa only [encode, Equiv.symm_apply_apply] using congrFun hencode (eqv (s, i))
    have hcoords : ∀ i, p.1 i = p'.1 i ∧ p.2 i = p'.2 i := by
      intro i
      have hg := hslot 0 i
      have ha := hslot 1 i
      norm_num [slot] at hg ha
      have hb : p.2 i / Nat.gcd (p.1 i) (p.2 i) =
          p'.2 i / Nat.gcd (p'.1 i) (p'.2 i) := by
        simpa [slot, show (2 : Fin 3) ≠ 0 by decide, show (2 : Fin 3) ≠ 1 by decide]
          using hslot 2 i
      exact ⟨by
        rw [← Nat.mul_div_cancel' (Nat.gcd_dvd_left (p.1 i) (p.2 i)),
          ← Nat.mul_div_cancel' (Nat.gcd_dvd_left (p'.1 i) (p'.2 i)), ha, hg], by
        rw [← Nat.mul_div_cancel' (Nat.gcd_dvd_right (p.1 i) (p.2 i)),
          ← Nat.mul_div_cancel' (Nat.gcd_dvd_right (p'.1 i) (p'.2 i)), hb, hg]⟩
    ext i
    · exact (hcoords i).1
    · exact (hcoords i).2

theorem selberg_actual_modulus_fiber_card_le_zeta_pow
    {k : ℕ} (hk : 0 < k) (W : ℕ) (hW : 0 < W)
    (D E : Finset (Fin k → ℕ))
    (hD : ∀ d ∈ D,
      Squarefree (∏ i, d i) ∧ Nat.Coprime (∏ i, d i) W)
    (hE : ∀ e ∈ E,
      Squarefree (∏ i, e i) ∧ Nat.Coprime (∏ i, e i) W)
    (gate : (Fin k → ℕ) → (Fin k → ℕ) → Prop)
    [DecidableRel gate]
    (hcross : ∀ d ∈ D, ∀ e ∈ E, gate d e →
      ∀ i j : Fin k, i ≠ j → Nat.Coprime (d i) (e j))
    (q : ℕ) :
    (((D.product E).filter fun p => gate p.1 p.2 ∧
      Nat.lcm W (Nat.lcm (∏ i, p.1 i) (∏ i, p.2 i)) = q).card) ≤
        (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (3 * k)) q) := by
  classical
  have hpos {d : Fin k → ℕ} (hd : Squarefree (∏ i, d i)) : ∀ i, 0 < d i := by
    intro i
    exact Nat.pos_of_ne_zero
      ((Finset.prod_ne_zero_iff.mp hd.ne_zero) i (Finset.mem_univ i))
  refine (Finset.card_le_card ?_).trans
    (product_lcm_fiber_card_le hk W hW D E
      (fun d hd ↦ ⟨hpos (hD d hd).1, (hD d hd).2⟩)
      (fun e he ↦ ⟨hpos (hE e he).1, (hE e he).2⟩) q)
  intro p hp
  obtain ⟨hpDE, hgate, hq⟩ := Finset.mem_filter.mp hp
  obtain ⟨hpD, hpE⟩ := Finset.mem_product.mp hpDE
  refine Finset.mem_filter.mpr ⟨hpDE, ?_⟩
  rw [← actual_modulus_eq_product W p.1 p.2 (hD p.1 hpD) (hE p.2 hpE)
    (hcross p.1 hpD p.2 hpE hgate)]
  exact hq

theorem selberg_actual_modulus_weighted_error_le
    {k : ℕ} (hk : 0 < k) (W : ℕ) (hW : 0 < W)
    (D E : Finset (Fin k → ℕ))
    (hD : ∀ d ∈ D,
      Squarefree (∏ i, d i) ∧ Nat.Coprime (∏ i, d i) W)
    (hE : ∀ e ∈ E,
      Squarefree (∏ i, e i) ∧ Nat.Coprime (∏ i, e i) W)
    (gate : (Fin k → ℕ) → (Fin k → ℕ) → Prop)
    [DecidableRel gate]
    (hcross : ∀ d ∈ D, ∀ e ∈ E, gate d e →
      ∀ i j : Fin k, i ≠ j → Nat.Coprime (d i) (e j))
    (lam mu : (Fin k → ℕ) → ℝ)
    (B₁ B₂ : ℝ) (hB₁ : 0 ≤ B₁) (hB₂ : 0 ≤ B₂)
    (hlam : ∀ d ∈ D, |lam d| ≤ B₁)
    (hmu : ∀ e ∈ E, |mu e| ≤ B₂)
    (Q : Finset ℕ) (delta : ℕ → ℝ)
    (hdelta : ∀ q ∈ Q, 0 ≤ delta q)
    (hmoduli : ∀ d ∈ D, ∀ e ∈ E, gate d e →
      Nat.lcm W (Nat.lcm (∏ i, d i) (∏ i, e i)) ∈ Q) :
    (∑ p ∈ (D.product E).filter (fun p => gate p.1 p.2),
      |lam p.1| * |mu p.2| *
        delta (Nat.lcm W (Nat.lcm (∏ i, p.1 i) (∏ i, p.2 i)))) ≤
      B₁ * B₂ * ∑ q ∈ Q,
        ((((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ (3 * k)) q : ℕ) : ℝ) *
          delta q := by
  classical
  let S := (D.product E).filter fun p => gate p.1 p.2
  let mod : ((Fin k → ℕ) × (Fin k → ℕ)) → ℕ := fun p ↦
    Nat.lcm W (Nat.lcm (∏ i, p.1 i) (∏ i, p.2 i))
  have hmaps : ∀ p ∈ S, mod p ∈ Q := by
    intro p hp
    obtain ⟨hpDE, hgate⟩ := Finset.mem_filter.mp hp
    obtain ⟨hpD, hpE⟩ := Finset.mem_product.mp hpDE
    exact hmoduli p.1 hpD p.2 hpE hgate
  change (∑ p ∈ S, |lam p.1| * |mu p.2| * delta (mod p)) ≤ _
  trans B₁ * B₂ * ∑ p ∈ S, delta (mod p)
  · rw [Finset.mul_sum]
    refine Finset.sum_le_sum fun p hp ↦ ?_
    obtain ⟨hpDE, _⟩ := Finset.mem_filter.mp hp
    obtain ⟨hpD, hpE⟩ := Finset.mem_product.mp hpDE
    exact mul_le_mul_of_nonneg_right
      (mul_le_mul (hlam p.1 hpD) (hmu p.2 hpE) (abs_nonneg _) hB₁)
      (hdelta (mod p) (hmaps p hp))
  · refine mul_le_mul_of_nonneg_left ?_ (mul_nonneg hB₁ hB₂)
    rw [← Finset.sum_fiberwise_of_maps_to' hmaps delta]
    refine Finset.sum_le_sum fun q hq ↦ ?_
    rw [Finset.sum_const, nsmul_eq_mul]
    refine mul_le_mul_of_nonneg_right ?_ (hdelta q hq)
    simp only [S, mod, Finset.filter_filter]
    exact_mod_cast selberg_actual_modulus_fiber_card_le_zeta_pow
      hk W hW D E hD hE gate hcross q

/-!
## Exceptional mass and harmonic limits

Bound the exceptional exponent integrals and pass from harmonic configuration sums to the
limiting fragment measures.
-/

/--
The auxiliary radius assigned to an exceptional-mass bin, equal to half the remaining budget
after subtracting `2 * (11 / 40)` and the bin's right endpoint, with safety margin `1 / 10000`.
-/
def exceptionalBinAuxRadius (j : Fin 1024) : ℚ :=
  (1 - 2 * (11 / 40 : ℚ) - exceptionalBinRight j) / 2 - 1 / 10000

/--
The degree-21 alternating Taylor polynomial for `log (1 + t)`, used for rational upper estimates
on the relevant nonnegative range.
-/
def exceptionalLogUpper21 (t : ℚ) : ℚ :=
  ∑ m ∈ Finset.Icc (1 : ℕ) 21, (-1 : ℚ) ^ (m + 1) * t ^ m / (m : ℚ)

/--
The integer ceiling of `10^25` times the rational exceptional-bin estimate, using the bin's
right endpoint and the degree-21 logarithm polynomial.
-/
def exceptionalBinCeiling (j : Fin 1024) : ℤ :=
  ⌈(10 : ℚ) ^ 25 *
    (24 * exceptionalBinStep *
      exceptionalLogUpper21 ((exceptionalBinRight j - 2 * (9519 / 50000 : ℚ)) /
        (9519 / 50000 : ℚ)) /
      (5 * exceptionalBinRight j * ((2249 / 5000 : ℚ) - exceptionalBinRight j)))⌉

/--
The sum of the `1024` upward-rounded exceptional-bin estimates, rescaled from integers by
`10^25`.
-/
def exceptionalBinRationalSum : ℚ :=
  (∑ j : Fin 1024, (exceptionalBinCeiling j : ℚ)) / (10 : ℚ) ^ 25

theorem exceptionalBin_margins (j : Fin 1024) :
    0 < exceptionalBinStep ∧
      2 * (9519 / 50000 : ℚ) < exceptionalBinRight j ∧
      exceptionalBinRight j ≤ (40481 / 100000 : ℚ) ∧
      (4499 / 200000 : ℚ) ≤ exceptionalBinAuxRadius j ∧
      exceptionalBinAuxRadius j < (863 / 25000 : ℚ) ∧
      (863 / 25000 : ℚ) < (19037 / 100000 : ℚ) ∧
      (19037 / 100000 : ℚ) < (9519 / 50000 : ℚ) ∧
      exceptionalBinRight j + 2 * (11 / 40 : ℚ) + 2 * exceptionalBinAuxRadius j =
        1 - (1 / 5000 : ℚ) ∧
      0 ≤ (exceptionalBinRight j - 2 * (9519 / 50000 : ℚ)) /
        (9519 / 50000 : ℚ) ∧
      (exceptionalBinRight j - 2 * (9519 / 50000 : ℚ)) /
        (9519 / 50000 : ℚ) < 1 := by
  have hj0 : (0 : ℚ) ≤ (j.val : ℚ) := Nat.cast_nonneg _
  have hj1 : (j.val : ℚ) ≤ 1023 := by exact_mod_cast (Nat.le_pred_of_lt j.isLt)
  norm_num [exceptionalBinStep, exceptionalBinRight, exceptionalBinAuxRadius]
  all_goals
    repeat' constructor
    all_goals nlinarith

theorem sum_fin_mul_eq_sum_fin_prod {m n : ℕ} (f : Fin (m * n) → ℤ) :
    (∑ j : Fin (m * n), f j) =
      ∑ b : Fin m, ∑ k : Fin n, f (finProdFinEquiv (b, k)) :=
  (finProdFinEquiv.sum_comp f).symm.trans
    (Fintype.sum_prod_type (fun p : Fin m × Fin n => f (finProdFinEquiv p)))

theorem exceptionalBinCeiling_double_sum :
    (∑ b : Fin 32, ∑ k : Fin 32,
      exceptionalBinCeiling (finProdFinEquiv (b, k))) =
        (3361336040272905676441604 : ℤ) := by
  decide +kernel

theorem exceptionalBinRationalSum_value :
    exceptionalBinRationalSum =
        (840334010068226419110401 : ℚ) / 2500000000000000000000000 ∧
      exceptionalBinRationalSum < (337 / 1000 : ℚ) ∧
      (201 / 200 : ℚ) * (337 / 1000 : ℚ) < (17 / 50 : ℚ) := by
  have hQ : exceptionalBinRationalSum =
      (840334010068226419110401 : ℚ) / 2500000000000000000000000 := by
    rw [exceptionalBinRationalSum, ← Int.cast_sum,
      sum_fin_mul_eq_sum_fin_prod (m := 32) (n := 32), exceptionalBinCeiling_double_sum]
    norm_num
  exact ⟨hQ, by rw [hQ]; norm_num, by norm_num⟩

theorem exceptional_log_upper21 (t : ℝ) (ht : 0 ≤ t) (ht1 : t < 1) :
    Real.log (1 + t) ≤
      ∑ m ∈ Finset.Icc (1 : ℕ) 21, (-1 : ℝ) ^ (m + 1) * t ^ m / (m : ℝ) := by
  let f : ℕ → ℝ := fun n => t ^ (n + 1) / ((n : ℝ) + 1)
  have hanti : Antitone f := by
    refine antitone_nat_of_succ_le fun n => ?_
    dsimp only [f]
    refine div_le_div₀ (pow_nonneg ht _) ?_ (by positivity) ?_
    · exact pow_le_pow_of_le_one ht ht1.le (Nat.le_succ _)
    · exact add_le_add (Nat.cast_le.mpr (Nat.le_succ n)) le_rfl
  have hseries : HasSum (fun n : ℕ => (-1 : ℝ) ^ n * f n) (Real.log (1 + t)) := by
    have h : HasSum (fun n : ℕ => -((-t) ^ (n + 1) / ((n : ℝ) + 1)))
        (Real.log (1 + t)) := by
      simpa only [neg_neg, sub_neg_eq_add] using
        (Real.hasSum_pow_div_log_of_abs_lt_one
          (x := -t) (by rwa [abs_neg, abs_of_nonneg ht])).neg
    refine h.congr_fun fun n => ?_
    dsimp only [f]
    rw [neg_pow t (n + 1), pow_succ (-1 : ℝ) n]
    ring
  calc
    Real.log (1 + t) ≤ ∑ n ∈ Finset.range 21, (-1 : ℝ) ^ n * f n :=
      Antitone.tendsto_le_alternating_series hseries.tendsto_sum_nat hanti 10
    _ = ∑ m ∈ Finset.Icc (1 : ℕ) 21, (-1 : ℝ) ^ (m + 1) * t ^ m / (m : ℝ) := by
      rw [← Finset.Ico_succ_right_eq_Icc, Finset.sum_Ico_eq_sum_range]
      apply Finset.sum_congr rfl
      intro n _
      simp only [f, Nat.add_comm 1 n, Nat.cast_add, Nat.cast_one, pow_succ]
      ring

theorem exceptionalPairDensity_monotone :
    MonotoneOn
      (fun s : ℝ => Real.log ((s - (9519 / 50000 : ℝ)) / (9519 / 50000 : ℝ)) / s)
      (Set.Icc (2 * (9519 / 50000 : ℝ)) (40481 / 100000 : ℝ)) := by
  let ξ : ℝ := 9519 / 50000
  let a : ℝ := 40481 / 100000
  let f : ℝ → ℝ := fun s => Real.log ((s - ξ) / ξ) / s
  have hξ : 0 < ξ := by norm_num [ξ]
  have ha : a < 3 * ξ := by norm_num [a, ξ]
  have hpos (s : ℝ) (hs : s ∈ Set.Icc (2 * ξ) a) :
      0 < s ∧ 0 < s - ξ := by
    constructor <;> linarith [hs.1]
  have hderiv (s : ℝ) (hs : s ∈ Set.Icc (2 * ξ) a) :
      HasDerivAt f ((s / (s - ξ) - Real.log ((s - ξ) / ξ)) / s ^ 2) s := by
    obtain ⟨hspos, hsub⟩ := hpos s hs
    have hlog := (((hasDerivAt_id' s).sub_const ξ).div_const ξ).log
      (ne_of_gt (div_pos hsub hξ))
    rw [div_div_div_cancel_right₀ hξ.ne', one_div] at hlog
    simpa only [f, inv_mul_eq_div, mul_one] using
      hlog.fun_div (hasDerivAt_id' s) hspos.ne'
  change MonotoneOn f (Set.Icc (2 * ξ) a)
  refine (strictMonoOn_of_deriv_pos (convex_Icc _ _) ?_ ?_).monotoneOn
  · intro s hs
    exact (hderiv s hs).continuousAt.continuousWithinAt
  · intro s hs
    have hs' : s ∈ Set.Icc (2 * ξ) a := interior_subset hs
    obtain ⟨hspos, hsub⟩ := hpos s hs'
    have hqlt : (s - ξ) / ξ < 2 :=
      (div_lt_iff₀ hξ).2 (by linarith [hs'.2])
    have hloglt : Real.log ((s - ξ) / ξ) < 1 :=
      (Real.log_le_sub_one_of_pos (div_pos hsub hξ)).trans_lt (by linarith)
    have hratio : 1 < s / (s - ξ) :=
      (one_lt_div hsub).2 (sub_lt_self s hξ)
    rw [(hderiv s hs').deriv]
    exact div_pos (sub_pos.mpr (hloglt.trans hratio)) (pow_pos hspos 2)

theorem exceptionalBin_integral_upper (j : Fin 1024) :
    let D : ℝ → ℝ :=
      fun s => Real.log ((s - (9519 / 50000 : ℝ)) / (9519 / 50000 : ℝ)) / s
    let l : ℝ := (exceptionalBinRight j : ℝ) - (exceptionalBinStep : ℝ)
    let u : ℝ := (exceptionalBinRight j : ℝ)
    0 ≤ (∫ s in l..u, D s) ∧
      (12 / 5 : ℝ) * (exceptionalBinAuxRadius j : ℝ)⁻¹ *
          (∫ s in l..u, D s) ≤
        (exceptionalBinCeiling j : ℝ) / (10 : ℝ) ^ 25 := by
  intro D l u
  rcases exceptionalBin_margins j with
    ⟨hstepQ, _, huTopQ, hzQ, _, _, _, _, htQ, ht1Q⟩
  have hstep : 0 < (exceptionalBinStep : ℝ) := Rat.cast_pos.mpr hstepQ
  have huUpper : u ≤ (40481 / 100000 : ℝ) := by
    simpa only [Rat.cast_div, Rat.cast_ofNat, u] using
      (Rat.cast_le (K := ℝ)).mpr huTopQ
  have hz : 0 < (exceptionalBinAuxRadius j : ℝ) :=
    Rat.cast_pos.mpr (lt_of_lt_of_le (by norm_num) hzQ)
  have hleft : l = 2 * (9519 / 50000 : ℝ) +
      (j.val : ℝ) * (exceptionalBinStep : ℝ) := by
    dsimp only [l, exceptionalBinRight]
    push_cast
    ring
  have hlLower : 2 * (9519 / 50000 : ℝ) ≤ l := by
    rw [hleft]
    exact le_add_of_nonneg_right (mul_nonneg (Nat.cast_nonneg _) hstep.le)
  have hlu : l ≤ u := sub_le_self _ hstep.le
  have huPos : 0 < u :=
    lt_of_lt_of_le (by norm_num) (hlLower.trans hlu)
  have hwidth : u - l = (exceptionalBinStep : ℝ) := sub_sub_cancel _ _
  have hsub : Set.Icc l u ⊆
      Set.Icc (2 * (9519 / 50000 : ℝ)) (40481 / 100000 : ℝ) :=
    Set.Icc_subset_Icc hlLower huUpper
  have hmono : MonotoneOn D
      (Set.Icc (2 * (9519 / 50000 : ℝ)) (40481 / 100000 : ℝ)) :=
    exceptionalPairDensity_monotone
  have hbase : D (2 * (9519 / 50000 : ℝ)) = 0 := by norm_num [D]
  have hbaseMem : 2 * (9519 / 50000 : ℝ) ∈
      Set.Icc (2 * (9519 / 50000 : ℝ)) (40481 / 100000 : ℝ) := by
    norm_num
  have hnonneg : ∀ s ∈ Set.Icc l u, 0 ≤ D s := by
    intro s hs
    have hs' := hsub hs
    simpa only [hbase] using hmono hbaseMem hs' hs'.1
  have hint : IntervalIntegrable D MeasureTheory.volume l u := by
    apply MonotoneOn.intervalIntegrable
    rw [Set.uIcc_of_le hlu]
    exact hmono.mono hsub
  have hupper : (∫ s in l..u, D s) ≤ (exceptionalBinStep : ℝ) * D u := by
    calc
      _ ≤ ∫ _s in l..u, D u :=
        intervalIntegral.integral_mono_on hlu hint intervalIntegrable_const
          (fun s hs => hmono (hsub hs) (hsub ⟨hlu, le_rfl⟩) hs.2)
      _ = _ := by rw [intervalIntegral.integral_const, smul_eq_mul, hwidth]
  let t : ℚ := (exceptionalBinRight j - 2 * (9519 / 50000 : ℚ)) /
    (9519 / 50000 : ℚ)
  have harg : 1 + (t : ℝ) =
      (u - (9519 / 50000 : ℝ)) / (9519 / 50000 : ℝ) := by
    dsimp only [t, u]
    push_cast
    ring
  have hlog : Real.log ((u - (9519 / 50000 : ℝ)) / (9519 / 50000 : ℝ)) ≤
      (exceptionalLogUpper21 t : ℝ) := by
    simpa only [exceptionalLogUpper21, Rat.cast_sum, Rat.cast_div, Rat.cast_mul,
      Rat.cast_pow, Rat.cast_neg, Rat.cast_one, Rat.cast_natCast, harg] using
      exceptional_log_upper21 (t : ℝ) (Rat.cast_nonneg.mpr htQ)
        (by exact_mod_cast ht1Q)
  have hzEq : (exceptionalBinAuxRadius j : ℝ) =
      ((2249 / 5000 : ℝ) - u) / 2 := by
    dsimp only [exceptionalBinAuxRadius, u]
    push_cast
    ring
  let q : ℚ := 24 * exceptionalBinStep * exceptionalLogUpper21 t /
    (5 * exceptionalBinRight j * ((2249 / 5000 : ℚ) - exceptionalBinRight j))
  have hqcast : (q : ℝ) =
      24 * (exceptionalBinStep : ℝ) * (exceptionalLogUpper21 t : ℝ) /
        (5 * u * ((2249 / 5000 : ℝ) - u)) := by
    simp only [q, u, Rat.cast_div, Rat.cast_mul, Rat.cast_sub, Rat.cast_ofNat]
  have hscaled : (12 / 5 : ℝ) * (exceptionalBinAuxRadius j : ℝ)⁻¹ *
      (∫ s in l..u, D s) ≤ (q : ℝ) := by
    calc
      _ ≤ (12 / 5 : ℝ) * (exceptionalBinAuxRadius j : ℝ)⁻¹ *
          ((exceptionalBinStep : ℝ) * D u) :=
        mul_le_mul_of_nonneg_left hupper (by positivity)
      _ ≤ (12 / 5 : ℝ) * (exceptionalBinAuxRadius j : ℝ)⁻¹ *
          ((exceptionalBinStep : ℝ) * ((exceptionalLogUpper21 t : ℝ) / u)) :=
        mul_le_mul_of_nonneg_left
          (mul_le_mul_of_nonneg_left (div_le_div_of_nonneg_right hlog huPos.le) hstep.le)
          (by positivity)
      _ = (q : ℝ) := by
        rw [hqcast, hzEq]
        simp only [div_eq_mul_inv, mul_inv_rev, inv_inv]
        ring
  have hceilQ : (10 : ℚ) ^ 25 * q ≤ (exceptionalBinCeiling j : ℚ) :=
    Int.le_ceil _
  have hceil : (10 : ℝ) ^ 25 * (q : ℝ) ≤ (exceptionalBinCeiling j : ℝ) := by
    exact_mod_cast hceilQ
  refine ⟨intervalIntegral.integral_nonneg hlu hnonneg, hscaled.trans ?_⟩
  apply (le_div_iff₀ (by norm_num : (0 : ℝ) < 10 ^ 25)).2
  simpa only [mul_comm] using hceil

end PrimeGap186

section
open Real Finset Filter Asymptotics Topology

open Classical in
theorem PrimeGap186.selberg_square_real_interval_crt_marked
    {ι : Type*} [Fintype ι] (h : ι → ℕ) (hinj : Function.Injective h) (i : ι)
    (D : Finset (ι → ℕ)) (lam : (ι → ℕ) → ℝ)
    (W b M : ℕ) (hW : 0 < W) (hM : 0 < M) (hWM : Nat.Coprime W M)
    (hD : ∀ d ∈ D,
      Squarefree (∏ j, d j) ∧ Nat.Coprime (∏ j, d j) W ∧
        Nat.Coprime (∏ j, d j) M)
    (hcover : ∀ a c : ι, h a ≠ h c → ∀ p : ℕ,
      p.Prime → p ∣ Nat.dist (h a) (h c) → p ∣ W)
    (x : ℝ) (hx : 0 ≤ x) :
    |(∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        if Nat.ModEq W n b ∧ M ∣ n + h i then
          (∑ d ∈ D, if ∀ j, d j ∣ n + h j then lam d else 0) ^ 2
        else 0) -
      x / ((W : ℝ) * (M : ℝ)) *
        (∑ d ∈ D, ∑ e ∈ D,
          if ∀ a c : ι, a ≠ c → Nat.Coprime (d a) (e c) then
            lam d * lam e / (∏ j, (Nat.lcm (d j) (e j) : ℝ))
          else 0)| ≤ 2 * (∑ d ∈ D, |lam d|) ^ 2 := by
  let c := Nat.chineseRemainder hWM b (M - h i % M)
  have hres : Nat.ModEq M (M - h i % M + h i) 0 := by
    have ht := (Nat.mod_modEq (h i) M).add_left (M - h i % M)
    rw [Nat.sub_add_cancel (Nat.mod_lt (h i) hM).le] at ht
    exact ht.symm.trans (Nat.modEq_zero_iff_dvd.mpr (dvd_refl M))
  have hmark (n : ℕ) : Nat.ModEq M n (M - h i % M) ↔ M ∣ n + h i := by
    constructor
    · intro hn
      exact Nat.modEq_zero_iff_dvd.mp ((hn.add_right (h i)).trans hres)
    · intro hn
      exact Nat.ModEq.add_right_cancel' (h i)
        ((Nat.modEq_zero_iff_dvd.mpr hn).trans hres.symm)
  have hclass (n : ℕ) :
      Nat.ModEq (W * M) n (c : ℕ) ↔ Nat.ModEq W n b ∧ M ∣ n + h i := by
    constructor
    · intro hn
      exact ⟨(hn.of_mul_right M).trans c.property.1,
        (hmark n).mp ((hn.of_mul_left W).trans c.property.2)⟩
    · rintro ⟨hn, hm⟩
      exact Nat.chineseRemainder_modEq_unique hWM hn ((hmark n).mpr hm)
  have hcrt := PrimeGap186.selberg_square_real_interval_crt
    h hinj D lam (W * M) (c : ℕ) (Nat.mul_pos hW hM)
    (fun d hd => ⟨(hD d hd).1, (hD d hd).2.1.mul_right (hD d hd).2.2⟩)
    (fun a c hac p hp hdist => dvd_mul_of_dvd_left (hcover a c hac p hp hdist) M)
    x hx
  simp_rw [hclass, Nat.cast_mul] at hcrt
  refine hcrt.trans (mul_le_mul_of_nonneg_left ?_ (by norm_num))
  rw [pow_two, Finset.sum_mul_sum]
  apply Finset.sum_le_sum
  intro d _
  apply Finset.sum_le_sum
  intro e _
  split_ifs
  · exact le_of_eq (abs_mul _ _)
  · exact mul_nonneg (abs_nonneg _) (abs_nonneg _)

open Classical in
theorem PrimeGap186.selberg40_auxiliary_marked_real_interval_crt
    {𝓗 : Finset ℕ} {h𝓗_card : 𝓗.card = 40}
    (i : Fin 40) (x κ : ℝ) (hx : 1 < x) (hκ : 0 < κ) :
    let ρ : ℝ := 2624989 / 10000000
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    let W := PrimeGap186.presievingModulus 𝓗 x
    let R := x ^ ρ
    let P := PrimeGap186.fragmentPrimes W R κ
    let q : ℕ := ∏ p ∈ P, p
    ∀ (u : (Fin 1 → ℕ) →₀ ℝ) (z : (Fin 39 → ℕ) →₀ ℝ),
      (∀ s ∈ u.support, s 0 ∈ q.divisors) →
      (∀ r ∈ z.support, Squarefree (∏ j, r j) ∧ ∀ j, r j ∈ q.divisors) →
      let Du := u.support.biUnion
        (fun s => Fintype.piFinset (fun j => (s j).divisors))
      let Dz := z.support.biUnion
        (fun r => Fintype.piFinset (fun j => (r j).divisors))
      let L : ℕ → ℝ := fun t =>
        ∑ e ∈ Du, if e 0 ∣ t then PrimeGap186.selbergCoefficient u e else 0
      let C : ℕ → ℝ := fun n =>
        ∑ d ∈ Dz, if ∀ j, d j ∣ n + h (i.succAbove j) then
          PrimeGap186.selbergCoefficient z d else 0
      let mean : ℝ :=
        (1 / (q : ℝ)) *
          ∑ n ∈ Finset.range q, (L (n + h i) * C n) ^ 2
      ∀ (M : ℕ), 0 < M → Nat.Coprime W M →
        (∀ s ∈ u.support, Nat.Coprime (s 0) M) →
        (∀ r ∈ z.support, Nat.Coprime (∏ j, r j) M) →
        ∀ b : ℕ,
          |(∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
              if Nat.ModEq W n b ∧ M ∣ n + h i then
                (L (n + h i) * C n) ^ 2 else 0) -
            x / ((W : ℝ) * (M : ℝ)) * mean| ≤
            2 * (∑ e ∈ Du, |PrimeGap186.selbergCoefficient u e|) ^ 2 *
              (∑ d ∈ Dz, |PrimeGap186.selbergCoefficient z d|) ^ 2 := by
  refine (fun (_ : 0 < κ) => ?_) hκ
  classical
  intro ρ h W R P q u z hu hz Du Dz L C mean M hM hWM huM hzM b
  have hP (p : ℕ) (hp : p ∈ P) : p.Prime :=
    Nat.prime_of_mem_primesLE (Finset.mem_filter.mp hp).1
  have hpW (p : ℕ) (hp : p ∈ P) : ¬ p ∣ W := (Finset.mem_filter.mp hp).2
  have hq : 0 < q := Finset.prod_pos fun p hp => (hP p hp).pos
  have hqsf : Squarefree q := PrimeGap186.squarefree_prime_prod P hP
  have hqW : Nat.Coprime q W :=
    Nat.Coprime.prod_left fun p hp => (hP p hp).coprime_iff_not_dvd.mpr (hpW p hp)
  have hW : 0 < W := PrimeGap186.presieving_pos 𝓗 x
  have hinj : Function.Injective h :=
    (𝓗.orderEmbOfFin h𝓗_card).injective
  have hcover : ∀ a c : Fin 40, h a ≠ h c → ∀ p : ℕ,
      p.Prime → p ∣ Nat.dist (h a) (h c) → p ∣ W := by
    intro a c hac p hp hpd
    exact PrimeGap186.difference_prime_dvd_presieving 𝓗 x
      (𝓗.orderEmbOfFin_mem h𝓗_card a)
      (𝓗.orderEmbOfFin_mem h𝓗_card c) hac hp hpd
  have hU (e : Fin 1 → ℕ) (he : e ∈ Du) :
      Squarefree (e 0) ∧ e 0 ∣ q ∧ Nat.Coprime (e 0) W := by
    obtain ⟨s, hs, hes⟩ := Finset.mem_biUnion.mp he
    have hes0 := (Nat.mem_divisors.mp (Fintype.mem_piFinset.mp hes 0)).1
    have heq : e 0 ∣ q := hes0.trans (Nat.mem_divisors.mp (hu s hs)).1
    exact ⟨hqsf.squarefree_of_dvd heq, heq, hqW.of_dvd_left heq⟩
  have hZ (d : Fin 39 → ℕ) (hd : d ∈ Dz) :
      Squarefree (∏ j, d j) ∧ (∀ j, d j ∣ q) ∧ Nat.Coprime (∏ j, d j) W := by
    obtain ⟨r, hr, hdr⟩ := Finset.mem_biUnion.mp hd
    have hdr' : ∀ j, d j ∣ r j :=
      fun j => (Nat.mem_divisors.mp (Fintype.mem_piFinset.mp hdr j)).1
    have hdq : ∀ j, d j ∣ q :=
      fun j => (hdr' j).trans (Nat.mem_divisors.mp ((hz r hr).2 j)).1
    refine ⟨(hz r hr).1.squarefree_of_dvd ?_, hdq, ?_⟩
    · exact Finset.prod_dvd_prod_of_dvd _ _ (fun j _ => hdr' j)
    · exact Nat.coprime_fintype_prod_left_iff.mpr fun j => hqW.of_dvd_left (hdq j)
  have hUM (e : Fin 1 → ℕ) (he : e ∈ Du) : Nat.Coprime (e 0) M := by
    obtain ⟨s, hs, hes⟩ := Finset.mem_biUnion.mp he
    exact (huM s hs).of_dvd_left
      (Nat.mem_divisors.mp (Fintype.mem_piFinset.mp hes 0)).1
  have hZM (d : Fin 39 → ℕ) (hd : d ∈ Dz) : Nat.Coprime (∏ j, d j) M := by
    obtain ⟨r, hr, hdr⟩ := Finset.mem_biUnion.mp hd
    exact (hzM r hr).of_dvd_left
      (Finset.prod_dvd_prod_of_dvd _ _
        (fun j _ => (Nat.mem_divisors.mp (Fintype.mem_piFinset.mp hdr j)).1))
  have hcompatible (e : Fin 1 → ℕ) (he : e ∈ Du)
      (d : Fin 39 → ℕ) (n : ℕ)
      (hen : e 0 ∣ n + h i) (hdn : ∀ j, d j ∣ n + h (i.succAbove j)) :
      Nat.Coprime (e 0) (∏ j, d j) := by
    apply Nat.coprime_fintype_prod_right_iff.mpr
    intro j
    by_contra hc
    obtain ⟨p, hp, hpe, hpd⟩ := Nat.Prime.not_coprime_iff_dvd.mp hc
    have hpW' : ¬ p ∣ W := hp.coprime_iff_not_dvd.mp
      ((hU e he).2.2.of_dvd_left hpe)
    have hdist : p ∣ Nat.dist (h i) (h (i.succAbove j)) := by
      rw [← Nat.dist_add_add_left n, Nat.dist]
      exact dvd_add (Nat.dvd_sub (hpe.trans hen) (hpd.trans (hdn j)))
        (Nat.dvd_sub (hpd.trans (hdn j)) (hpe.trans hen))
    exact hpW' (hcover i (i.succAbove j)
      (fun hij => (Fin.succAbove_ne i j) (hinj hij).symm) p hp hdist)
  let E : ((Fin 1 → ℕ) × (Fin 39 → ℕ)) ≃ (Fin 40 → ℕ) :=
    ((Equiv.funUnique (Fin 1) ℕ).prodCongr (Equiv.refl (Fin 39 → ℕ))).trans
      (Fin.insertNthEquiv (fun _ : Fin 40 => ℕ) i)
  let good := (Du ×ˢ Dz).filter (fun t => Nat.Coprime (t.1 0) (∏ j, t.2 j))
  let D := good.map E.toEmbedding
  let lam : (Fin 40 → ℕ) → ℝ := fun a =>
    PrimeGap186.selbergCoefficient u (fun _ => a i) *
      PrimeGap186.selbergCoefficient z (fun j => a (i.succAbove j))
  have hE (t : (Fin 1 → ℕ) × (Fin 39 → ℕ)) :
      E t = i.insertNth (t.1 0) t.2 := rfl
  have hfun (e : Fin 1 → ℕ) : (fun _ : Fin 1 => e 0) = e :=
    funext fun j => congrArg e (Subsingleton.elim 0 j)
  have hlam (t : (Fin 1 → ℕ) × (Fin 39 → ℕ)) :
      lam (E t) = PrimeGap186.selbergCoefficient u t.1 * PrimeGap186.selbergCoefficient z t.2 := by
    simp only [lam, hE, Fin.insertNth_apply_same, Fin.insertNth_apply_succAbove, hfun]
  have hdiv (t : (Fin 1 → ℕ) × (Fin 39 → ℕ)) (n : ℕ) :
      (∀ j, E t j ∣ n + h j) ↔
        t.1 0 ∣ n + h i ∧ ∀ j, t.2 j ∣ n + h (i.succAbove j) := by
    rw [Fin.forall_iff_succAbove i]
    simp only [hE, Fin.insertNth_apply_same, Fin.insertNth_apply_succAbove]
  have hD : ∀ a ∈ D,
      Squarefree (∏ j, a j) ∧ Nat.Coprime (∏ j, a j) W ∧
        Nat.Coprime (∏ j, a j) M ∧ ∀ j, a j ∣ q := by
    intro a ha
    obtain ⟨t, ht, rfl⟩ := Finset.mem_map.mp ha
    obtain ⟨ht, hcop⟩ := Finset.mem_filter.mp ht
    obtain ⟨he, hd⟩ := Finset.mem_product.mp ht
    have hu' := hU t.1 he
    have hz' := hZ t.2 hd
    change Squarefree (∏ j, E t j) ∧ Nat.Coprime (∏ j, E t j) W ∧
      Nat.Coprime (∏ j, E t j) M ∧ _
    rw [hE, Fin.prod_insertNth]
    refine ⟨(Nat.squarefree_mul hcop).mpr ⟨hu'.1, hz'.1⟩,
      hu'.2.2.mul_left hz'.2.2, (hUM t.1 he).mul_left (hZM t.2 hd), ?_⟩
    change ∀ j, E t j ∣ q
    rw [hE]
    rw [Fin.forall_iff_succAbove i]
    simpa only [Fin.insertNth_apply_same, Fin.insertNth_apply_succAbove] using
      And.intro hu'.2.1 hz'.2.1
  have hvalue (n : ℕ) :
      L (n + h i) * C n =
        ∑ a ∈ D, if ∀ j, a j ∣ n + h j then lam a else 0 := by
    have hexpand :
        L (n + h i) * C n =
          ∑ t ∈ Du ×ˢ Dz,
            if t.1 0 ∣ n + h i ∧ ∀ j, t.2 j ∣ n + h (i.succAbove j) then
              PrimeGap186.selbergCoefficient u t.1 * PrimeGap186.selbergCoefficient z t.2
            else 0 := by
      simp only [L, C, Finset.sum_mul_sum, Finset.sum_product,
        ite_mul, mul_ite, mul_zero, zero_mul, ← ite_and, and_comm]
    rw [hexpand]
    change _ = ∑ a ∈ good.map E.toEmbedding,
      if ∀ j, a j ∣ n + h j then lam a else 0
    rw [Finset.sum_map]
    change _ = ∑ t ∈ good, if ∀ j, E t j ∣ n + h j then lam (E t) else 0
    simp_rw [hdiv, hlam]
    symm
    apply Finset.sum_subset (Finset.filter_subset _ _)
    intro t ht hnot
    have hc : ¬ Nat.Coprime (t.1 0) (∏ j, t.2 j) :=
      fun hc => hnot (Finset.mem_filter.mpr ⟨ht, hc⟩)
    have hn : ¬ (t.1 0 ∣ n + h i ∧ ∀ j, t.2 j ∣ n + h (i.succAbove j)) :=
      fun hn => hc (hcompatible t.1 (Finset.mem_product.mp ht).1 t.2 n hn.1 hn.2)
    exact ite_eq_right hn
  have hmean : mean = ∑ a ∈ D, ∑ c ∈ D,
      if ∀ j k : Fin 40, j ≠ k → Nat.Coprime (a j) (c k) then
        lam a * lam c / (∏ j, (Nat.lcm (a j) (c j) : ℝ)) else 0 := by
    dsimp only [mean]
    simp_rw [hvalue]
    convert PrimeGap186.selberg_square_period_mean h hinj D lam W q hq
      (fun a ha => ⟨(hD a ha).1, (hD a ha).2.1, (hD a ha).2.2.2⟩)
      hcover using 1 <;> congr!
  have hl1 : (∑ a ∈ D, |lam a|) ≤
      (∑ e ∈ Du, |PrimeGap186.selbergCoefficient u e|) *
        (∑ d ∈ Dz, |PrimeGap186.selbergCoefficient z d|) := by
    calc
      _ = ∑ t ∈ good,
          |PrimeGap186.selbergCoefficient u t.1| * |PrimeGap186.selbergCoefficient z t.2| := by
        rw [Finset.sum_map]
        apply Finset.sum_congr rfl
        intro t _
        change |lam (E t)| = _
        rw [hlam, abs_mul]
      _ ≤ ∑ t ∈ Du ×ˢ Dz,
          |PrimeGap186.selbergCoefficient u t.1| * |PrimeGap186.selbergCoefficient z t.2| :=
        Finset.sum_le_sum_of_subset_of_nonneg (Finset.filter_subset _ _)
          (fun _ _ _ => mul_nonneg (abs_nonneg _) (abs_nonneg _))
      _ = _ := by rw [Finset.sum_product, Finset.sum_mul_sum]
  have herror :
      2 * (∑ a ∈ D, |lam a|) ^ 2 ≤
        2 * (∑ e ∈ Du, |PrimeGap186.selbergCoefficient u e|) ^ 2 *
          (∑ d ∈ Dz, |PrimeGap186.selbergCoefficient z d|) ^ 2 := by
    calc
      _ ≤ 2 * ((∑ e ∈ Du, |PrimeGap186.selbergCoefficient u e|) *
          (∑ d ∈ Dz, |PrimeGap186.selbergCoefficient z d|)) ^ 2 :=
        mul_le_mul_of_nonneg_left
          (pow_le_pow_left₀ (Finset.sum_nonneg (fun _ _ => abs_nonneg _)) hl1 2)
          (by norm_num)
      _ = _ := by ring
  have hcrt := PrimeGap186.selberg_square_real_interval_crt_marked h hinj i D lam W b M hW hM hWM
    (fun a ha => ⟨(hD a ha).1, (hD a ha).2.1, (hD a ha).2.2.1⟩)
    hcover x (by linarith)
  have hinterval :
      |(∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
          if Nat.ModEq W n b ∧ M ∣ n + h i then (L (n + h i) * C n) ^ 2 else 0) -
        x / ((W : ℝ) * (M : ℝ)) * mean| ≤
        2 * (∑ a ∈ D, |lam a|) ^ 2 := by
    convert hcrt using 1
    · simp_rw [hvalue, hmean]
      congr!
  exact hinterval.trans herror

end

namespace PrimeGap186

open Real Finset Asymptotics Topology
open ArithmeticFunction hiding log

open Classical in
theorem selberg40_auxiliary_real_interval_crt
    {𝓗 : Finset ℕ} {h𝓗_card : 𝓗.card = 40}
    (i : Fin 40) (x κ : ℝ) (hx : 1 < x) (hκ : 0 < κ) :
    let ρ : ℝ := 2624989 / 10000000
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    let W := presievingModulus 𝓗 x
    let R := x ^ ρ
    let P := fragmentPrimes W R κ
    let q : ℕ := ∏ p ∈ P, p
    ∀ (u : (Fin 1 → ℕ) →₀ ℝ) (z : (Fin 39 → ℕ) →₀ ℝ),
      (∀ s ∈ u.support, s 0 ∈ q.divisors) →
      (∀ r ∈ z.support, Squarefree (∏ j, r j) ∧ ∀ j, r j ∈ q.divisors) →
      let Du := u.support.biUnion
        (fun s => Fintype.piFinset (fun j => (s j).divisors))
      let Dz := z.support.biUnion
        (fun r => Fintype.piFinset (fun j => (r j).divisors))
      let L : ℕ → ℝ := fun t =>
        ∑ e ∈ Du, if e 0 ∣ t then selbergCoefficient u e else 0
      let C : ℕ → ℝ := fun n =>
        ∑ d ∈ Dz, if ∀ j, d j ∣ n + h (i.succAbove j) then
          selbergCoefficient z d else 0
      let mean : ℝ :=
        (1 / (q : ℝ)) *
          ∑ n ∈ Finset.range q, (L (n + h i) * C n) ^ 2
      ∀ b : ℕ,
        |(∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            if Nat.ModEq W n b then (L (n + h i) * C n) ^ 2 else 0) -
          x / (W : ℝ) * mean| ≤
          2 * (∑ e ∈ Du, |selbergCoefficient u e|) ^ 2 *
            (∑ d ∈ Dz, |selbergCoefficient z d|) ^ 2 := by
  intro ρ h W R P q u z hu hz Du Dz L C mean b
  simpa only [Nat.cast_one, mul_one, one_dvd, and_true] using
    selberg40_auxiliary_marked_real_interval_crt
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i x κ hx hκ u z hu hz
      1 (by decide) (by simp) (fun s _ => by simp) (fun r _ => by simp) b

open Classical in
theorem auxiliary_two_radius_l1_bound
    (u : (Fin 1 → ℕ) →₀ ℝ) (z : (Fin 39 → ℕ) →₀ ℝ) (q : ℕ)
    (x r_c ζ_a M N Bx B : ℝ)
    (hx : 1 < x) (hrc : 0 ≤ r_c) (hζ_a : 0 ≤ ζ_a)
    (hM : 0 ≤ M) (hN : 0 ≤ N) (hBx : 0 < Bx) (hB : 0 < B)
    (hqsf : Squarefree q)
    (hu : ∀ s ∈ u.support, s 0 ∈ q.divisors ∧ (s 0 : ℝ) ≤ x ^ ζ_a)
    (hz : ∀ r ∈ z.support,
      Squarefree (∏ j, r j) ∧ ((∏ j, r j : ℕ) : ℝ) ≤ x ^ r_c)
    (huBound : ∀ s, |u s| ≤ N / Bx)
    (hzBound : ∀ r, |z r| ≤ M / B ^ 39)
    (hlogcap : 1 + Real.log (⌊x ^ (r_c + ζ_a)⌋₊ : ℝ) ≤ Real.log x) :
    let Du := u.support.biUnion
      (fun s => Fintype.piFinset (fun j => (s j).divisors))
    let Dz := z.support.biUnion
      (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let J : ℕ := 7 + (2 ^ (39 + 2) - 1)
    2 * (∑ e ∈ Du, |selbergCoefficient u e|) ^ 2 *
        (∑ d ∈ Dz, |selbergCoefficient z d|) ^ 2 ≤
      (2 * M ^ 2 * N ^ 2 / (Bx ^ 2 * B ^ 78)) *
        x ^ (2 * (r_c + ζ_a)) * Real.log x ^ (2 * J) := by
  intro Du Dz J
  let La : ℕ := ⌊x ^ ζ_a⌋₊
  let Lc : ℕ := ⌊x ^ r_c⌋₊
  let Ja : ℕ := 7
  let Jc : ℕ := 2 ^ (39 + 2) - 1
  let Qa : ℝ := (1 + Real.log (La : ℝ)) ^ Ja
  let Qc : ℝ := (1 + Real.log (Lc : ℝ)) ^ Jc
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hlogx : 0 ≤ Real.log x := Real.log_nonneg hx.le
  have hLa1 : 1 ≤ La :=
    (Nat.one_le_floor_iff _).mpr (Real.one_le_rpow hx.le hζ_a)
  have hLc1 : 1 ≤ Lc :=
    (Nat.one_le_floor_iff _).mpr (Real.one_le_rpow hx.le hrc)
  have hLa1R : (1 : ℝ) ≤ La := by exact_mod_cast hLa1
  have hLc1R : (1 : ℝ) ≤ Lc := by exact_mod_cast hLc1
  have hLa0 : (0 : ℝ) < La := zero_lt_one.trans_le hLa1R
  have hLc0 : (0 : ℝ) < Lc := zero_lt_one.trans_le hLc1R
  have hLaCap : La ≤ ⌊x ^ (r_c + ζ_a)⌋₊ :=
    Nat.floor_mono
      (Real.rpow_le_rpow_of_exponent_le hx.le (le_add_of_nonneg_left hrc))
  have hLcCap : Lc ≤ ⌊x ^ (r_c + ζ_a)⌋₊ :=
    Nat.floor_mono
      (Real.rpow_le_rpow_of_exponent_le hx.le (le_add_of_nonneg_right hζ_a))
  have hlogLa0 : 0 ≤ 1 + Real.log (La : ℝ) :=
    add_nonneg zero_le_one (Real.log_nonneg hLa1R)
  have hlogLc0 : 0 ≤ 1 + Real.log (Lc : ℝ) :=
    add_nonneg zero_le_one (Real.log_nonneg hLc1R)
  have hlogLa : 1 + Real.log (La : ℝ) ≤ Real.log x := by
    have hmono := Real.log_le_log hLa0
      (show (La : ℝ) ≤ (⌊x ^ (r_c + ζ_a)⌋₊ : ℝ) by exact_mod_cast hLaCap)
    linarith only [hmono, hlogcap]
  have hlogLc : 1 + Real.log (Lc : ℝ) ≤ Real.log x := by
    have hmono := Real.log_le_log hLc0
      (show (Lc : ℝ) ≤ (⌊x ^ (r_c + ζ_a)⌋₊ : ℝ) by exact_mod_cast hLcCap)
    linarith only [hmono, hlogcap]
  have hQa0 : 0 ≤ Qa := pow_nonneg hlogLa0 Ja
  have hQc0 : 0 ≤ Qc := pow_nonneg hlogLc0 Jc
  have hQa : Qa ≤ Real.log x ^ Ja := pow_le_pow_left₀ hlogLa0 hlogLa Ja
  have hQc : Qc ≤ Real.log x ^ Jc := pow_le_pow_left₀ hlogLc0 hlogLc Jc
  have hQ : Qa * Qc ≤ Real.log x ^ J := by
    calc
      Qa * Qc ≤ Real.log x ^ Ja * Real.log x ^ Jc :=
        mul_le_mul hQa hQc hQc0 (pow_nonneg hlogx Ja)
      _ = Real.log x ^ J := (pow_add (Real.log x) Ja Jc).symm
  have hLa : (La : ℝ) ≤ x ^ ζ_a := Nat.floor_le (Real.rpow_nonneg hx0.le ζ_a)
  have hLc : (Lc : ℝ) ≤ x ^ r_c := Nat.floor_le (Real.rpow_nonneg hx0.le r_c)
  have hlength : (La : ℝ) * (Lc : ℝ) ≤ x ^ (r_c + ζ_a) := by
    calc
      (La : ℝ) * (Lc : ℝ) ≤ x ^ ζ_a * x ^ r_c :=
        mul_le_mul hLa hLc (Nat.cast_nonneg Lc) (Real.rpow_nonneg hx0.le ζ_a)
      _ = x ^ (r_c + ζ_a) := by rw [← Real.rpow_add hx0, add_comm ζ_a r_c]
  have huL : ∀ s ∈ u.support, Squarefree (∏ j, s j) ∧ (∏ j, s j) ≤ La := by
    intro s hs
    have hsquare : Squarefree (s 0) :=
      hqsf.squarefree_of_dvd (Nat.mem_divisors.mp (hu s hs).1).1
    have hle : s 0 ≤ La :=
      (Nat.le_floor_iff (Real.rpow_nonneg hx0.le ζ_a)).mpr (hu s hs).2
    simpa only [Fin.prod_univ_one] using And.intro hsquare hle
  have hzL : ∀ r ∈ z.support, Squarefree (∏ j, r j) ∧ (∏ j, r j) ≤ Lc := by
    intro r hr
    exact ⟨(hz r hr).1,
      (Nat.le_floor_iff (Real.rpow_nonneg hx0.le r_c)).mpr (hz r hr).2⟩
  have hDu (e : DecidableEq (Fin 1)) :
      u.support.biUnion (fun s => @Fintype.piFinset (Fin 1) e inferInstance
        (fun _ => ℕ) (fun j => (s j).divisors)) = Du := by
    ext d
    simp only [Du, Finset.mem_biUnion, Fintype.mem_piFinset]
  have hDz (e : DecidableEq (Fin 39)) :
      z.support.biUnion (fun r => @Fintype.piFinset (Fin 39) e inferInstance
        (fun _ => ℕ) (fun j => (r j).divisors)) = Dz := by
    ext d
    simp only [Dz, Finset.mem_biUnion, Fintype.mem_piFinset]
  have hlu := selbergCoefficient_l1_le u La (N / Bx) huL huBound
  have hlz := selbergCoefficient_l1_le z Lc (M / B ^ 39) hzL hzBound
  simp only [hDu, Fintype.card_fin] at hlu
  simp only [hDz, Fintype.card_fin] at hlz
  change (∑ e ∈ Du, |selbergCoefficient u e|) ≤ N / Bx * (La : ℝ) * Qa at hlu
  change (∑ d ∈ Dz, |selbergCoefficient z d|) ≤ M / B ^ 39 * (Lc : ℝ) * Qc at hlz
  have hSu0 : 0 ≤ ∑ e ∈ Du, |selbergCoefficient u e| :=
    Finset.sum_nonneg fun e _ => abs_nonneg _
  have hSz0 : 0 ≤ ∑ d ∈ Dz, |selbergCoefficient z d| :=
    Finset.sum_nonneg fun d _ => abs_nonneg _
  have hcoef0 : 0 ≤ M * N / (Bx * B ^ 39) :=
    div_nonneg (mul_nonneg hM hN) (mul_nonneg hBx.le (pow_nonneg hB.le 39))
  have hsumprod :
      (∑ e ∈ Du, |selbergCoefficient u e|) *
          (∑ d ∈ Dz, |selbergCoefficient z d|) ≤
        M * N / (Bx * B ^ 39) * x ^ (r_c + ζ_a) * Real.log x ^ J := by
    calc
      _ ≤ (N / Bx * (La : ℝ) * Qa) * (M / B ^ 39 * (Lc : ℝ) * Qc) :=
        mul_le_mul hlu hlz hSz0
          (mul_nonneg (mul_nonneg (div_nonneg hN hBx.le) (Nat.cast_nonneg La)) hQa0)
      _ = M * N / (Bx * B ^ 39) * ((La : ℝ) * (Lc : ℝ)) * (Qa * Qc) := by
        field_simp [ne_of_gt hBx, ne_of_gt hB]
      _ ≤ M * N / (Bx * B ^ 39) * x ^ (r_c + ζ_a) * Real.log x ^ J :=
        mul_le_mul (mul_le_mul_of_nonneg_left hlength hcoef0) hQ
          (mul_nonneg hQa0 hQc0)
          (mul_nonneg hcoef0 (Real.rpow_nonneg hx0.le (r_c + ζ_a)))
  have hxpow : (x ^ (r_c + ζ_a)) ^ 2 = x ^ (2 * (r_c + ζ_a)) := by
    rw [mul_comm (2 : ℝ) (r_c + ζ_a), Real.rpow_mul hx0.le, Real.rpow_two]
  calc
    _ = 2 * ((∑ e ∈ Du, |selbergCoefficient u e|) *
        (∑ d ∈ Dz, |selbergCoefficient z d|)) ^ 2 := by ring
    _ ≤ 2 * (M * N / (Bx * B ^ 39) *
        x ^ (r_c + ζ_a) * Real.log x ^ J) ^ 2 :=
      mul_le_mul_of_nonneg_left
        (pow_le_pow_left₀ (mul_nonneg hSu0 hSz0) hsumprod 2) (by norm_num)
    _ = (2 * M ^ 2 * N ^ 2 / (Bx ^ 2 * B ^ 78)) *
        x ^ (2 * (r_c + ζ_a)) * Real.log x ^ (2 * J) := by
      rw [mul_pow, mul_pow, hxpow, ← pow_mul, mul_comm J 2]
      field_simp [ne_of_gt hBx, ne_of_gt hB]

open Classical in
theorem selberg40_auxiliary_uniform_real_harmonic
    {𝓗 : Finset ℕ} {h𝓗_card : 𝓗.card = 40}
    (i : Fin 40) (κ r_c ζ_a M N : ℝ)
    (hκ : 0 < κ) (hζ_a : 0 < ζ_a)
    (hradius : 2 * (r_c + ζ_a) < 1) (hM : 0 ≤ M) (hN : 0 ≤ N) :
    ∀ ε : ℝ, 0 < ε →
      ∀ᶠ x : ℝ in Filter.atTop,
        let ρ : ℝ := 2624989 / 10000000
        let h : Fin 40 → ℕ :=
          𝓗.orderEmbOfFin h𝓗_card
        let W := presievingModulus 𝓗 x
        let R := x ^ ρ
        let Bx := fragmentNormalization W x
        let B := fragmentNormalization W R
        let P := fragmentPrimes W R κ
        let q : ℕ := ∏ p ∈ P, p
        let J : ℕ := 7 + (2 ^ (39 + 2) - 1)
        0 < Bx ∧ 0 < B ∧
          ∀ (u : (Fin 1 → ℕ) →₀ ℝ) (z : (Fin 39 → ℕ) →₀ ℝ),
            (∀ s ∈ u.support,
              s 0 ∈ q.divisors ∧ (s 0 : ℝ) ≤ x ^ ζ_a) →
            (∀ r ∈ z.support,
              Squarefree (∏ j, r j) ∧ (∀ j, r j ∈ q.divisors) ∧
                ((∏ j, r j : ℕ) : ℝ) ≤ x ^ r_c) →
            (∀ s, |u s| ≤ N / Bx) →
            (∀ r, |z r| ≤ M / B ^ 39) →
            let Du := u.support.biUnion
              (fun s => Fintype.piFinset (fun j => (s j).divisors))
            let Dz := z.support.biUnion
              (fun r => Fintype.piFinset (fun j => (r j).divisors))
            let L : ℕ → ℝ := fun t =>
              ∑ e ∈ Du, if e 0 ∣ t then selbergCoefficient u e else 0
            let C : ℕ → ℝ := fun n =>
              ∑ d ∈ Dz, if ∀ j, d j ∣ n + h (i.succAbove j) then
                selbergCoefficient z d else 0
            let mean : ℝ := (1 / (q : ℝ)) *
              ∑ n ∈ Finset.range q, (L (n + h i) * C n) ^ 2
            let harmonic : ℝ :=
              u.sum (fun s us => us ^ 2 / ((s 0).totient : ℝ)) *
                z.sum (fun r zr => zr ^ 2 / (∏ j, ((r j).totient : ℝ)))
            ∀ b : ℕ,
              |(∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
                  if Nat.ModEq W n b then (L (n + h i) * C n) ^ 2 else 0) -
                x / (W : ℝ) * mean| ≤
                  (2 * M ^ 2 * N ^ 2 / (Bx ^ 2 * B ^ 78)) *
                    x ^ (2 * (r_c + ζ_a)) * (Real.log x) ^ (2 * J) ∧
              |(∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
                  if Nat.ModEq W n b then (L (n + h i) * C n) ^ 2 else 0) -
                x / (W : ℝ) * harmonic| ≤
                  ε * (x / (W : ℝ) / Bx / B ^ 39) := by
  intro ε hε
  let ρ₀ : ℝ := 2624989 / 10000000
  have hρ : 0 < ρ₀ := by norm_num [ρ₀]
  have hε2 : 0 < ε / 2 := half_pos hε
  have hnormalization : ∀ᶠ x : ℝ in Filter.atTop,
      1 < x ∧
        1 ≤ fragmentNormalization (presievingModulus 𝓗 x) x ∧
        1 ≤ fragmentNormalization (presievingModulus 𝓗 x) (x ^ ρ₀) ∧
        fragmentNormalization (presievingModulus 𝓗 x) (x ^ ρ₀) =
          ρ₀ * fragmentNormalization (presievingModulus 𝓗 x) x ∧
        (presievingModulus 𝓗 x : ℝ) ≤ Real.log x := by
    filter_upwards [Filter.eventually_gt_atTop (1 : ℝ),
      presieving_le_mul_log_eventually 𝓗 1 zero_lt_one,
      presieving_le_mul_log_eventually 𝓗 ρ₀ hρ]
      with x hx hWlog hWρ
    let W := presievingModulus 𝓗 x
    have hx0 : 0 < x := zero_lt_one.trans hx
    have hlog : 0 ≤ Real.log x := Real.log_nonneg hx.le
    have hW : 0 < W := presieving_pos 𝓗 x
    have hWR : (0 : ℝ) < W := by exact_mod_cast hW
    have hφ : (1 : ℝ) ≤ (Nat.totient W : ℝ) := by
      exact_mod_cast (show 1 ≤ Nat.totient W from Nat.totient_pos.mpr hW)
    have hWlog' : (W : ℝ) ≤ Real.log x := by simpa only [one_mul] using hWlog
    refine ⟨hx, ?_, ?_, ?_, hWlog'⟩
    · change 1 ≤ ((Nat.totient W : ℝ) / (W : ℝ)) * Real.log x
      rw [div_mul_eq_mul_div]
      exact (one_le_div hWR).mpr
        (hWlog'.trans (le_mul_of_one_le_left hlog hφ))
    · change 1 ≤ ((Nat.totient W : ℝ) / (W : ℝ)) * Real.log (x ^ ρ₀)
      rw [Real.log_rpow hx0, div_mul_eq_mul_div]
      exact (one_le_div hWR).mpr
        (hWρ.trans (le_mul_of_one_le_left (mul_nonneg hρ.le hlog) hφ))
    · unfold fragmentNormalization
      rw [Real.log_rpow hx0]
      ring
  by_cases hrc : 0 ≤ r_c
  · let a : ℝ := r_c + ζ_a
    let J₀ : ℕ := 7 + (2 ^ (39 + 2) - 1)
    have ha : 0 < a := add_pos_of_nonneg_of_pos hrc hζ_a
    have ha1 : a < 1 := by dsimp only [a]; linarith
    have hδ : 0 < 1 - 2 * a := by dsimp only [a]; linarith
    have hlogLimit : Filter.Tendsto
        (fun x : ℝ => Real.log x ^ (2 * J₀ + 1) / x ^ (1 - 2 * a))
        Filter.atTop (nhds 0) := by
      simpa only [Real.rpow_natCast] using
        (isLittleO_log_rpow_rpow_atTop ((2 * J₀ + 1 : ℕ) : ℝ)
          hδ).tendsto_div_nhds_zero
    have hlimit : Filter.Tendsto
        (fun x : ℝ => 2 * (M * N) ^ 2 * Real.log x ^ (2 * J₀ + 1) /
          x ^ (1 - 2 * a)) Filter.atTop (nhds 0) := by
      simpa only [mul_zero, mul_div_assoc] using hlogLimit.const_mul (2 * (M * N) ^ 2)
    have hperiod := selberg40_auxiliary_period_comparison
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i κ M (ρ₀ * N)
      hκ hM (mul_nonneg hρ.le hN) (ε * ρ₀ / 2) (half_pos (mul_pos hε hρ))
    filter_upwards [hnormalization, floor_rpow_log_envelope a ha ha1,
      hlimit.eventually_le_const hε2, hperiod] with x hn hfloor hsmall hp
    intro ρ h W R Bx B P q J
    rcases hn with ⟨hx, hBx1, hB1, hscale, hWlog⟩
    have hx0 : 0 < x := zero_lt_one.trans hx
    have hBx : 0 < Bx := zero_lt_one.trans_le hBx1
    have hB : 0 < B := zero_lt_one.trans_le hB1
    have hW : 0 < W := presieving_pos 𝓗 x
    have hWR : (0 : ℝ) < W := by exact_mod_cast hW
    have hxW : 0 < x / (W : ℝ) := div_pos hx0 hWR
    have hscale' : B = ρ₀ * Bx := hscale
    refine ⟨hBx, hB, ?_⟩
    intro u z hu hz huBound hzBound Du Dz L C mean harmonic b
    let A : ℝ := x / (W : ℝ) / Bx / B ^ 39
    let S : ℝ := ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
      if Nat.ModEq W n b then (L (n + h i) * C n) ^ 2 else 0
    let raw : ℝ := (2 * M ^ 2 * N ^ 2 / (Bx ^ 2 * B ^ 78)) *
      x ^ (2 * (r_c + ζ_a)) * (Real.log x) ^ (2 * J)
    have hA : 0 < A := div_pos (div_pos hxW hBx) (pow_pos hB 39)
    have huMem : ∀ s ∈ u.support, s 0 ∈ q.divisors :=
      fun s hs => (hu s hs).1
    have hzMem : ∀ r ∈ z.support,
        Squarefree (∏ j, r j) ∧ ∀ j, r j ∈ q.divisors :=
      fun r hr => ⟨(hz r hr).1, (hz r hr).2.1⟩
    have hP (p : ℕ) (hp : p ∈ P) : p.Prime :=
      Nat.prime_of_mem_primesLE (Finset.mem_filter.mp hp).1
    have hqsf : Squarefree q := squarefree_prime_prod P hP
    have hl1 := auxiliary_two_radius_l1_bound u z q x r_c ζ_a M N Bx B
      hx hrc hζ_a.le hM hN hBx hB hqsf hu
      (fun r hr => ⟨(hz r hr).1, (hz r hr).2.2⟩) huBound hzBound hfloor.2.2
    have hfinite := selberg40_auxiliary_real_interval_crt
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i x κ hx hκ u z huMem hzMem b
    have hCRT : |S - x / (W : ℝ) * mean| ≤ raw := hfinite.trans hl1
    have hrawNorm : raw / A ≤
        2 * (M * N) ^ 2 * Real.log x ^ (2 * J + 1) / x ^ (1 - 2 * a) := by
      have hpow : x ^ (2 * (r_c + ζ_a)) = (x ^ a) ^ 2 := by
        dsimp only [a]
        rw [mul_comm 2, Real.rpow_mul hx0.le, Real.rpow_two]
      have hlogpow : Real.log x ^ (2 * J) = (Real.log x ^ J) ^ 2 := by
        rw [Nat.mul_comm 2 J, pow_mul]
      have hden : 1 ≤ Bx * B ^ 39 :=
        (one_le_pow₀ hB1).trans
          (le_mul_of_one_le_left (pow_nonneg hB.le 39) hBx1)
      calc
        raw / A =
            (2 * (M * N) ^ 2 * (W : ℝ) * (x ^ a) ^ 2 *
              (Real.log x ^ J) ^ 2 / x) / (Bx * B ^ 39) := by
          dsimp only [raw, A]
          rw [hpow, hlogpow]
          field_simp [hBx.ne', hB.ne', hx0.ne', hWR.ne']
        _ ≤ 2 * (M * N) ^ 2 * (W : ℝ) * (x ^ a) ^ 2 *
            (Real.log x ^ J) ^ 2 / x :=
          div_le_self
            (div_nonneg
              (mul_nonneg
                (mul_nonneg
                  (mul_nonneg (mul_nonneg (by norm_num) (sq_nonneg (M * N)))
                    (Nat.cast_nonneg W)) (sq_nonneg (x ^ a)))
                (sq_nonneg (Real.log x ^ J))) hx0.le) hden
        _ ≤ 2 * (M * N) ^ 2 * Real.log x * (x ^ a) ^ 2 *
            (Real.log x ^ J) ^ 2 / x :=
          div_le_div_of_nonneg_right
            (mul_le_mul_of_nonneg_right
              (mul_le_mul_of_nonneg_right
                (mul_le_mul_of_nonneg_left hWlog
                  (mul_nonneg (by norm_num) (sq_nonneg (M * N))))
                (sq_nonneg (x ^ a))) (sq_nonneg (Real.log x ^ J))) hx0.le
        _ = _ := crt_power_identity (M * N) x a J hx0
    have hCRTsmall : |S - x / (W : ℝ) * mean| ≤ (ε / 2) * A :=
      hCRT.trans ((div_le_iff₀ hA).mp (hrawNorm.trans hsmall))
    have huScaled : ∀ s, |u s| ≤ (ρ₀ * N) / B := by
      intro s
      have heq : N / Bx = (ρ₀ * N) / B := by
        rw [hscale']
        field_simp [hBx.ne', hρ.ne']
      exact (huBound s).trans_eq heq
    have hpMean := (hp.2 u z huMem hzMem huScaled hzBound 0).2.2
    have hbridge := selberg40_auxiliary_exact_period_bridge
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i x κ hx hκ u z huMem hzMem
    rcases hbridge with ⟨_, _, _, _, _, _, _, _, _, hAffine⟩
    have hmeanEq :
        (1 / (q : ℝ)) * (∑ n ∈ Finset.range q,
          (L (0 + W * n + h i) * C (0 + W * n)) ^ 2) = mean := hAffine 0
    change |(1 / (q : ℝ)) * (∑ n ∈ Finset.range q,
      (L (0 + W * n + h i) * C (0 + W * n)) ^ 2) - harmonic| ≤
        (ε * ρ₀ / 2) / B ^ 40 at hpMean
    rw [hmeanEq] at hpMean
    have hdenom : B ^ 40 = ρ₀ * (Bx * B ^ 39) := by
      rw [show (40 : ℕ) = 39 + 1 from rfl, pow_succ, hscale']
      ring
    have hscaleError : (ε * ρ₀ / 2) / B ^ 40 = (ε / 2) / (Bx * B ^ 39) := by
      rw [hdenom]
      field_simp [hρ.ne', hBx.ne', hB.ne']
    have hmeanInterval : |x / (W : ℝ) * mean - x / (W : ℝ) * harmonic| ≤
        (ε / 2) * A := by
      rw [← mul_sub, abs_mul, abs_of_pos hxW]
      calc
        _ ≤ x / (W : ℝ) * ((ε * ρ₀ / 2) / B ^ 40) :=
          mul_le_mul_of_nonneg_left hpMean hxW.le
        _ = (ε / 2) * A := by rw [hscaleError]; dsimp only [A]; ring
    change |S - x / (W : ℝ) * mean| ≤ raw ∧
      |S - x / (W : ℝ) * harmonic| ≤ ε * A
    refine ⟨hCRT, ?_⟩
    calc
      |S - x / (W : ℝ) * harmonic| ≤
          |S - x / (W : ℝ) * mean| +
            |x / (W : ℝ) * mean - x / (W : ℝ) * harmonic| := abs_sub_le _ _ _
      _ ≤ (ε / 2) * A + (ε / 2) * A := add_le_add hCRTsmall hmeanInterval
      _ = ε * A := by ring
  · filter_upwards [hnormalization] with x hn
    intro ρ h W R Bx B P q J
    rcases hn with ⟨hx, hBx1, hB1, _, _⟩
    have hx0 : 0 < x := zero_lt_one.trans hx
    have hBx : 0 < Bx := zero_lt_one.trans_le hBx1
    have hB : 0 < B := zero_lt_one.trans_le hB1
    have hW : 0 < W := presieving_pos 𝓗 x
    have hWR : (0 : ℝ) < W := by exact_mod_cast hW
    refine ⟨hBx, hB, ?_⟩
    intro u z hu hz huBound hzBound Du Dz L C mean harmonic b
    have hz0 : z = 0 := by
      ext r
      by_contra hzr
      have hr : r ∈ z.support := Finsupp.mem_support_iff.mpr hzr
      have hp : (1 : ℝ) ≤ ((∏ j, r j : ℕ) : ℝ) := by
        exact_mod_cast (Nat.pos_of_ne_zero (hz r hr).1.ne_zero)
      have hlt : x ^ r_c < 1 :=
        Real.rpow_lt_one_of_one_lt_of_neg hx (lt_of_not_ge hrc)
      exact (not_lt_of_ge hp) ((hz r hr).2.2.trans_lt hlt)
    have hDz : Dz = ∅ := by
      simp only [Dz, hz0, Finsupp.support_zero, Finset.biUnion_empty]
    have hC (n : ℕ) : C n = 0 := by
      dsimp only [C]
      rw [hDz, Finset.sum_empty]
    have hperiodZero :
        (∑ n ∈ Finset.range q, (L (n + h i) * C n) ^ 2) = 0 := by
      simp [hC]
    have hmeanZero : mean = 0 := by
      dsimp only [mean]
      rw [hperiodZero, mul_zero]
    have hharmonicZero : harmonic = 0 := by
      dsimp only [harmonic]
      rw [hz0, Finsupp.sum_zero_index, mul_zero]
    have hintervalZero :
        (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
          if Nat.ModEq W n b then (L (n + h i) * C n) ^ 2 else 0) = 0 := by
      simp [hC]
    constructor
    · rw [hintervalZero, hmeanZero, mul_zero, sub_self, abs_zero]
      exact mul_nonneg
        (mul_nonneg
          (div_nonneg
            (mul_nonneg (mul_nonneg (by norm_num) (sq_nonneg M)) (sq_nonneg N))
            (mul_nonneg (sq_nonneg Bx) (pow_nonneg hB.le 78)))
          (Real.rpow_nonneg hx0.le _)) (pow_nonneg (Real.log_nonneg hx.le) (2 * J))
    · rw [hintervalZero, hharmonicZero, mul_zero, sub_self, abs_zero]
      exact mul_nonneg hε.le
        (div_nonneg (div_nonneg (div_nonneg hx0.le hWR.le) hBx.le)
          (pow_nonneg hB.le 39))

theorem selbergCoefficient_weighted_erase
    (i : Fin 40) (y : (Fin 40 → ℕ) →₀ ℝ) (d : Fin 39 → ℕ) :
    let z : (Fin 39 → ℕ) →₀ ℝ :=
      y.sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
        (yr / ((r i).totient : ℝ)))
    selbergCoefficient z d = selbergCoefficient y (i.insertNth 1 d) := by
  classical
  intro z
  have hprodR :
      (∏ j : Fin 40, (i.insertNth (α := fun _ => ℕ) 1 d j : ℝ)) =
        ∏ j : Fin 39, (d j : ℝ) := by
    rw [Fin.prod_univ_succAbove _ i]
    simp
  have hsum :
      z.sum (fun r yr =>
        if ∀ j, d j ∣ r j then yr / (∏ j, ((r j).totient : ℝ)) else 0) =
      y.sum (fun r yr =>
        if ∀ j, d j ∣ r (i.succAbove j) then
          (yr / ((r i).totient : ℝ)) /
            (∏ j : Fin 39, ((r (i.succAbove j)).totient : ℝ)) else 0) := by
    dsimp only [z]
    rw [Finsupp.sum_sum_index (fun r => by simp)
      (fun r a b => by split_ifs <;> simp [add_div])]
    simp
  unfold selbergCoefficient
  rw [Fin.prod_insertNth, one_mul, hprodR]
  congr 1
  refine Eq.trans ?_ (Eq.trans hsum ?_)
  · apply Finsupp.sum_congr
    intro r hr
    split_ifs <;> rfl
  · apply Finsupp.sum_congr
    intro r hr
    simp [Fin.forall_iff_succAbove i,
      Fin.prod_univ_succAbove (fun j : Fin 40 => ((r j).totient : ℝ)) i, div_div]

open Classical in
theorem selbergCoefficient_mem_divisorClosure
    {ι : Type*} [Fintype ι] (y : (ι → ℕ) →₀ ℝ) (d : ι → ℕ)
    (hd : selbergCoefficient y d ≠ 0) :
    d ∈ y.support.biUnion (fun r => Fintype.piFinset (fun j => (r j).divisors)) := by
  unfold selbergCoefficient Finsupp.sum at hd
  obtain ⟨r, hr, hterm⟩ :=
    Finset.exists_ne_zero_of_sum_ne_zero (mul_ne_zero_iff.mp hd).2
  have hdata := ite_ne_right_iff.mp hterm
  have hden : (∏ j, ((r j).totient : ℝ)) ≠ 0 :=
    (div_ne_zero_iff.mp hdata.2).2
  apply Finset.mem_biUnion.mpr
  refine ⟨r, hr, Fintype.mem_piFinset.mpr ?_⟩
  intro j
  refine Nat.mem_divisors.mpr ⟨hdata.1 j, ?_⟩
  intro hzero
  exact (Finset.prod_ne_zero_iff.mp hden j (Finset.mem_univ j)) (by simp [hzero])

open Classical in
theorem selberg_divisor_sum_weighted_erase
    (i : Fin 40) (y : (Fin 40 → ℕ) →₀ ℝ) (h : Fin 40 → ℕ) (n : ℕ) :
    let z : (Fin 39 → ℕ) →₀ ℝ :=
      y.sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
        (yr / ((r i).totient : ℝ)))
    let D := y.support.biUnion
      (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let E := z.support.biUnion
      (fun r => Fintype.piFinset (fun j => (r j).divisors))
    (∑ d ∈ D,
        if d i = 1 ∧ (∀ j, d j ∣ n + h j) then selbergCoefficient y d else 0) =
      ∑ d ∈ E,
        if ∀ j, d j ∣ n + h (i.succAbove j) then selbergCoefficient z d else 0 := by
  intro z D E
  let f (d : Fin 39 → ℕ) : ℝ :=
    if ∀ j, d j ∣ n + h (i.succAbove j) then selbergCoefficient z d else 0
  let g (d : Fin 40 → ℕ) : ℝ :=
    if d i = 1 ∧ (∀ j, d j ∣ n + h j) then selbergCoefficient y d else 0
  have hcoeff (d : Fin 39 → ℕ) :
      selbergCoefficient z d = selbergCoefficient y (i.insertNth 1 d) :=
    selbergCoefficient_weighted_erase i y d
  have hterm (d : Fin 39 → ℕ) : f d = g (i.insertNth 1 d) := by
    simp [f, g, Fin.forall_iff_succAbove i, hcoeff]
  symm
  change (∑ d ∈ E, f d) = ∑ d ∈ D, g d
  refine Finset.sum_bij_ne_zero (fun d _ _ => i.insertNth 1 d) ?_ ?_ ?_ ?_
  · intro d _ hd
    simpa only [D, Finset.mem_biUnion, Fintype.mem_piFinset] using
      selbergCoefficient_mem_divisorClosure y (i.insertNth 1 d)
        (hcoeff d ▸ (ite_ne_right_iff.mp hd).2)
  · intro d _ _ e _ _ heq
    exact Fin.insertNth_right_injective (α := fun _ => ℕ) (p := i) (1 : ℕ) heq
  · intro d _ hd
    obtain ⟨⟨hdi, _⟩, hyne⟩ := ite_ne_right_iff.mp hd
    let e : Fin 39 → ℕ := fun j => d (i.succAbove j)
    have hrecover : i.insertNth 1 e = d :=
      Fin.insertNth_eq_iff.mpr ⟨hdi.symm, rfl⟩
    have hzne : selbergCoefficient z e ≠ 0 := by
      rw [hcoeff e, hrecover]
      exact hyne
    have hfe : f e ≠ 0 := by
      rw [hterm e, hrecover]
      exact hd
    refine ⟨e, ?_, hfe, hrecover⟩
    simpa only [E, Finset.mem_biUnion, Fintype.mem_piFinset] using
      selbergCoefficient_mem_divisorClosure z e hzne
  · intro d _ _
    exact hterm d

theorem canonical_erased_profile_sum
    (i : Fin 40) (Q : Finset ℕ) (f : (Fin 40 → ℕ) → ℝ) (r : Fin 39 → ℕ) :
    let T := (Fintype.piFinset (fun _ : Fin 40 => Q)).filter
      (fun t => Squarefree (∏ j, t j))
    let y : (Fin 40 → ℕ) →₀ ℝ := ∑ t ∈ T, Finsupp.single t (f t)
    (y.sum (fun t yt => Finsupp.single (fun j => t (i.succAbove j))
      (yt / ((t i).totient : ℝ)))) r =
        ∑ s ∈ Q,
          if Squarefree (s * ∏ j, r j) ∧ (∀ j, r j ∈ Q) then
            f (i.insertNth s r) / (s.totient : ℝ) else 0 := by
  classical
  intro T y
  dsimp only [y]
  rw [Finsupp.sum_finsetSum _ _ _ (fun t => by simp)
    (fun t a b => by simp [add_div, Finsupp.single_add])]
  simp only [Finsupp.sum_single_index, Finsupp.single_zero, zero_div,
    Finsupp.finsetSum_apply, Finsupp.single_apply]
  rw [← Finset.sum_filter, ← Finset.sum_filter]
  have hrecover (t : Fin 40 → ℕ)
      (ht : (fun j => t (i.succAbove j)) = r) : t = i.insertNth (t i) r :=
    Fin.eq_insertNth_iff.mpr ⟨rfl, ht⟩
  refine Finset.sum_bij (fun t _ => t i) ?_ ?_ ?_ ?_
  · intro t ht
    obtain ⟨htT, htr⟩ := Finset.mem_filter.mp ht
    obtain ⟨htQ, htSq⟩ := Finset.mem_filter.mp htT
    have hQ := Fintype.mem_piFinset.mp htQ
    refine Finset.mem_filter.mpr ⟨hQ i, ?_, ?_⟩
    · rw [hrecover t htr, Fin.prod_insertNth] at htSq
      exact htSq
    · intro j
      rw [← htr]
      exact hQ (i.succAbove j)
  · intro t ht u hu htu
    calc
      t = i.insertNth (t i) r := hrecover t (Finset.mem_filter.mp ht).2
      _ = i.insertNth (u i) r := by rw [htu]
      _ = u := (hrecover u (Finset.mem_filter.mp hu).2).symm
  · intro s hs
    obtain ⟨hsQ, hsSq, hrQ⟩ := Finset.mem_filter.mp hs
    refine ⟨i.insertNth s r, ?_, by simp⟩
    apply Finset.mem_filter.mpr
    refine ⟨Finset.mem_filter.mpr ⟨?_, ?_⟩, ?_⟩
    · apply Fintype.mem_piFinset.mpr
      rw [Fin.forall_iff_succAbove i]
      simpa only [Fin.insertNth_apply_same, Fin.insertNth_apply_succAbove] using
        And.intro hsQ hrQ
    · simpa only [Fin.prod_insertNth] using hsSq
    · exact Fin.insertNth_comp_succAbove i s r
  · intro t ht
    rw [← hrecover t (Finset.mem_filter.mp ht).2]

open Classical in
theorem selberg40_canonical_erased_face
    {𝓗 : Finset ℕ} {h𝓗_card : 𝓗.card = 40}
    (i : Fin 40) (κ M : ℝ) (hκ : 0 < κ) (hM : 0 ≤ M) :
    let ρ : ℝ := 2624989 / 10000000
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    ∀ᶠ x : ℝ in Filter.atTop,
      let W := presievingModulus 𝓗 x
      let R := x ^ ρ
      let B := fragmentNormalization W R
      let P := fragmentPrimes W R κ
      let q := ∏ p ∈ P, p
      let T := (Fintype.piFinset (fun _ : Fin 40 => q.divisors)).filter
        (fun r => Squarefree (∏ j, r j))
      1 < x ∧ 0 < B ∧
        ∀ F : (Fin 40 → MeasureTheory.FiniteMeasure ℝ) → ℝ,
          (∀ X, |F X| ≤ M) →
          let y : (Fin 40 → ℕ) →₀ ℝ :=
            ∑ r ∈ T, Finsupp.single r
              (F (fun j => primeLogConfiguration R (r j)) / B ^ 40)
          let z : (Fin 39 → ℕ) →₀ ℝ :=
            y.sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
              (yr / ((r i).totient : ℝ)))
          let D := y.support.biUnion
            (fun r => Fintype.piFinset (fun j => (r j).divisors))
          let E := z.support.biUnion
            (fun r => Fintype.piFinset (fun j => (r j).divisors))
          (∀ r : Fin 40 → ℕ,
            y r = if r ∈ T then
              F (fun j => primeLogConfiguration R (r j)) / B ^ 40
            else 0) ∧
          (∀ r : Fin 39 → ℕ,
            z r = B⁻¹ ^ 40 *
              ∑ s ∈ q.divisors,
                if Squarefree (s * ∏ j, r j) ∧ (∀ j, r j ∈ q.divisors) then
                  F (i.insertNth (primeLogConfiguration R s)
                    (fun j => primeLogConfiguration R (r j))) /
                      (s.totient : ℝ)
                else 0) ∧
          (∀ d : Fin 39 → ℕ,
            selbergCoefficient z d = selbergCoefficient y (i.insertNth 1 d)) ∧
          (∀ n : ℕ,
            (∑ d ∈ D,
                if d i = 1 ∧ (∀ j, d j ∣ n + h j) then selbergCoefficient y d else 0) =
              ∑ d ∈ E,
                if ∀ j, d j ∣ n + h (i.succAbove j) then selbergCoefficient z d else 0) ∧
          (∀ r ∈ z.support,
            Squarefree (∏ j, r j) ∧ (∀ j, r j ∈ q.divisors) ∧
              ∃ s ∈ y.support, (fun j => s (i.succAbove j)) = r) ∧
          (∀ r : Fin 39 → ℕ,
            |z r| ≤ M * harmonicFragmentMass W R κ / B ^ 40 ∧
              |z r| ≤ (M * (Real.exp Real.eulerMascheroniConstant * κ + 1)) / B ^ 39) := by
  intro ρ h
  have hρ : 0 < ρ := by norm_num [ρ]
  have hm := harmonic_fragment_normalizer_tendsto 𝓗 ρ κ hρ hκ
  filter_upwards [eventually_gt_atTop (1 : ℝ),
    hm.eventually_le_const (lt_add_one _)] with x hx hm
  intro W R B P q T
  have hW : 0 < W := presieving_pos 𝓗 x
  have hB : 0 < B := by
    apply mul_pos
    · exact div_pos (by exact_mod_cast Nat.totient_pos.mpr hW) (by exact_mod_cast hW)
    · exact Real.log_pos (Real.one_lt_rpow hx hρ)
  refine ⟨hx, hB, ?_⟩
  intro F hF y z D E
  have hy (r : Fin 40 → ℕ) :
      y r = if r ∈ T then
        F (fun j => primeLogConfiguration R (r j)) / B ^ 40 else 0 := by
    simp [y, Finsupp.finsetSum_apply, Finsupp.single_apply]
  have hyT (r : Fin 40 → ℕ) (hr : r ∈ y.support) : r ∈ T := by
    by_contra hnot
    exact (Finsupp.mem_support_iff.mp hr) (by rw [hy, ite_eq_right hnot])
  have hzSum (r : Fin 39 → ℕ) :
      z r = B⁻¹ ^ 40 *
        ∑ s ∈ q.divisors,
          if Squarefree (s * ∏ j, r j) ∧ (∀ j, r j ∈ q.divisors) then
            F (i.insertNth (primeLogConfiguration R s)
              (fun j => primeLogConfiguration R (r j))) /
                (s.totient : ℝ) else 0 := by
    have hsum := canonical_erased_profile_sum i q.divisors
      (fun t => F (fun j => primeLogConfiguration R (t j)) / B ^ 40) r
    change z r = _ at hsum
    rw [hsum, Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro s hs
    split_ifs
    · have hconfiguration :
          (fun j => primeLogConfiguration R
            (i.insertNth (α := fun _ => ℕ) s r j)) =
            i.insertNth (primeLogConfiguration R s)
              (fun j => primeLogConfiguration R (r j)) := by
        apply Fin.eq_insertNth_iff.mpr
        simp [funext_iff, Fin.removeNth_apply]
      rw [hconfiguration]
      simp only [div_eq_mul_inv, inv_pow]
      ac_rfl
    · simp
  have hzProject (r : Fin 39 → ℕ) (hr : r ∈ z.support) :
      ∃ s ∈ y.support, (fun j => s (i.succAbove j)) = r := by
    have hmem := Finsupp.support_sum hr
    obtain ⟨s, hs, hsr⟩ := Finset.mem_biUnion.mp hmem
    exact ⟨s, hs,
      (Finset.mem_singleton.mp (Finsupp.support_single_subset hsr)).symm⟩
  have hzBound (r : Fin 39 → ℕ) :
      |z r| ≤ M * harmonicFragmentMass W R κ / B ^ 40 := by
    have hnonneg : 0 ≤ B⁻¹ ^ 40 := by positivity
    rw [hzSum, abs_mul, abs_of_nonneg hnonneg]
    calc
      _ ≤ B⁻¹ ^ 40 *
          ∑ s ∈ q.divisors,
            |if Squarefree (s * ∏ j, r j) ∧ (∀ j, r j ∈ q.divisors) then
              F (i.insertNth (primeLogConfiguration R s)
                (fun j => primeLogConfiguration R (r j))) /
                  (s.totient : ℝ) else 0| :=
        mul_le_mul_of_nonneg_left (Finset.abs_sum_le_sum_abs _ _) hnonneg
      _ ≤ B⁻¹ ^ 40 * ∑ s ∈ q.divisors, M / (s.totient : ℝ) := by
        apply mul_le_mul_of_nonneg_left _ hnonneg
        apply Finset.sum_le_sum
        intro s hs
        simp only [abs_ite, abs_div, Nat.abs_cast, abs_zero]
        split_ifs
        · exact div_le_div_of_nonneg_right (hF _) (Nat.cast_nonneg _)
        · exact div_nonneg hM (Nat.cast_nonneg _)
      _ = M * harmonicFragmentMass W R κ / B ^ 40 := by
        change B⁻¹ ^ 40 * (∑ s ∈ q.divisors, M / (s.totient : ℝ)) =
          M * (∑ s ∈ q.divisors, (s.totient : ℝ)⁻¹) / B ^ 40
        simp only [div_eq_mul_inv, ← Finset.mul_sum, inv_pow]
        ac_rfl
  refine ⟨hy, hzSum, selbergCoefficient_weighted_erase i y,
    selberg_divisor_sum_weighted_erase i y h, ?_, ?_⟩
  · intro r hr
    obtain ⟨s, hs, hsr⟩ := hzProject r hr
    obtain ⟨hsQ, hsSq⟩ := Finset.mem_filter.mp (hyT s hs)
    have hQ := Fintype.mem_piFinset.mp hsQ
    refine ⟨?_, ?_, s, hs, hsr⟩
    · rw [← hsr]
      apply hsSq.squarefree_of_dvd
      rw [Fin.prod_univ_succAbove _ i]
      exact dvd_mul_left _ _
    · intro j
      rw [← hsr]
      exact hQ (i.succAbove j)
  · intro r
    refine ⟨hzBound r, (hzBound r).trans ?_⟩
    calc
      M * harmonicFragmentMass W R κ / B ^ 40 =
          (M * (harmonicFragmentMass W R κ / B)) / B ^ 39 := by
        rw [show B ^ 40 = B * B ^ 39 from pow_succ' B 39, div_mul_eq_div_div,
          mul_div_assoc]
      _ ≤ (M * (Real.exp Real.eulerMascheroniConstant * κ + 1)) / B ^ 39 :=
        div_le_div_of_nonneg_right (mul_le_mul_of_nonneg_left hm hM)
          (pow_nonneg hB.le _)

end PrimeGap186

section
open Set

end

section
open Set
open scoped ContDiff

end

namespace PrimeGap186

section
open Set
open scoped ContDiff

theorem measure_frontier_superlevel_eq_zero {E : Type*} [MeasurableSpace E] [TopologicalSpace E]
    (μ : Measure E) (f : E → ℝ) (t : ℝ)
    (hf : ∀ᵐ z ∂μ, ContinuousAt f z) (ht : μ {z | f z = t} = 0) :
    μ (frontier {z | t ≤ f z}) = 0 := by
  have he : ∀ᵐ z ∂μ, f z ≠ t := by
    apply ae_iff.mpr
    simpa only [ne_eq, not_not, Set.ofPred_mem_eq] using ht
  have hn : ∀ᵐ z ∂μ, z ∉ frontier {z | t ≤ f z} := by
    filter_upwards [hf, he] with z hz hz'
    rcases lt_or_gt_of_ne hz' with h | h
    · have hi : z ∈ interior ({z | t ≤ f z}ᶜ) := mem_interior_iff_mem_nhds.mpr
        (Filter.mem_of_superset (hz (isOpen_Iio.mem_nhds h)) (by
          intro v hv hh; exact (not_le_of_gt (show f v < t from hv)) hh))
      have := (mem_interior_iff_notMem_frontier (interior_subset hi)).mp hi
      simpa only [frontier_compl] using this
    · have hi : z ∈ interior {z | t ≤ f z} := mem_interior_iff_mem_nhds.mpr
        (Filter.mem_of_superset (hz (isOpen_Ioi.mem_nhds h)) (by
          intro v hv; exact le_of_lt (show t < f v from hv)))
      exact (mem_interior_iff_notMem_frontier (interior_subset hi)).mp hi
  simpa only [not_not, Set.ofPred_mem_eq] using (ae_iff.mp hn)

/--
Weak convergence of probability measures gives convergence of integrals against a bounded
measurable function that is continuous almost everywhere for the limiting measure.
-/
theorem tendsto_integral_of_weak_convergence {E ι : Type*} [TopologicalSpace E] [MeasurableSpace E]
    [OpensMeasurableSpace E] [HasOuterApproxClosed E]
    {l : Filter ι} [l.IsCountablyGenerated]
    {μ : ι → ProbabilityMeasure E} {ν : ProbabilityMeasure E}
    (hw : Tendsto μ l (𝓝 ν)) (f : E → ℝ) (hf : Measurable f)
    (hb : Bornology.IsBounded (Set.range f))
    (hc : ∀ᵐ z ∂(ν : Measure E), ContinuousAt f z) :
    Tendsto (fun x => ∫ z, f z ∂(μ x : Measure E)) l (𝓝 (∫ z, f z ∂(ν : Measure E))) := by
  classical
  obtain ⟨C, _hC, hCb⟩ := hb.exists_pos_norm_le
  have hfB (z) : ‖f z‖ ≤ C := hCb _ ⟨z, rfl⟩
  let u := fun z => f z + C
  have um : Measurable u := hf.add_const _
  have u0 z : 0 ≤ u z := by
    have := hfB z; rw [Real.norm_eq_abs] at this
    dsimp [u]
    linarith [neg_le_of_abs_le this]
  have uM z : u z ≤ 2*C := by
    have := hfB z; rw [Real.norm_eq_abs] at this
    dsimp [u]; linarith [le_of_abs_le this]
  have fi (η : Measure E) [IsFiniteMeasure η] : Integrable f η :=
    Integrable.of_bound hf.aestronglyMeasurable C (Filter.Eventually.of_forall hfB)
  have ui (η : Measure E) [IsFiniteMeasure η] : Integrable u η :=
    (fi η).add (integrable_const C)
  have uc : ∀ᵐ z ∂(ν : Measure E), ContinuousAt u z := hc.mono
    (fun _ h => h.add continuousAt_const)
  have lev : ∀ᵐ t ∂volume.restrict (Ioc (0 : ℝ) (2*C)),
      (ν : Measure E) (frontier {z | t ≤ u z}) = 0 := by
    have exc := (Measure.countable_meas_level_set_pos (μ := (ν : Measure E)) um).ae_notMem
      (volume : Measure ℝ)
    filter_upwards [ae_restrict_of_ae exc] with t h
    exact measure_frontier_superlevel_eq_zero _ u t uc (not_lt.mp h |>.antisymm (bot_le))
  have meas (η : Measure E) [IsFiniteMeasure η] : Measurable
      (fun t : ℝ => η.real {z | t ≤ u z}) :=
    Antitone.measurable (fun _ _ h => ENNReal.toReal_mono
      (measure_ne_top _ _) (measure_mono (fun _ hv => le_trans h hv)))
  have hl : Tendsto (fun x => ∫ t in Ioc (0 : ℝ) (2*C),
      (μ x : Measure E).real {z | t ≤ u z}) l
      (𝓝 (∫ t in Ioc (0 : ℝ) (2*C), (ν : Measure E).real {z | t ≤ u z})) := by
    apply tendsto_integral_filter_of_dominated_convergence (fun _ : ℝ => (1 : ℝ))
    · exact Eventually.of_forall (fun x => (meas _).aestronglyMeasurable)
    · refine Eventually.of_forall (fun x => .of_forall (fun t => ?_))
      have h0 : 0 ≤ (μ x : Measure E).real {z | t ≤ u z} := by positivity
      rw [Real.norm_of_nonneg h0]
      have hx : (μ x : Measure E) Set.univ = 1 := measure_univ
      simpa only [measureReal_def, hx, ENNReal.toReal_one] using
        ENNReal.toReal_mono (by simp : (μ x : Measure E) Set.univ ≠ ⊤)
          (measure_mono (subset_univ {z | t ≤ u z}) :
            (μ x : Measure E) {z | t ≤ u z} ≤ (μ x : Measure E) Set.univ)
    · exact integrable_const 1
    · filter_upwards [lev] with t ht
      exact (ENNReal.tendsto_toReal (measure_ne_top _ _)).comp
        (ProbabilityMeasure.tendsto_measure_of_null_frontier_of_tendsto' hw ht)
  have hlU : Tendsto (fun x => ∫ z, u z ∂(μ x : Measure E)) l
      (𝓝 (∫ z, u z ∂(ν : Measure E))) := by
    simpa only [(ui _).integral_eq_integral_Ioc_meas_le
        (Filter.Eventually.of_forall u0) (Filter.Eventually.of_forall uM)] using hl
  simpa only [u, integral_add (fi _) (integrable_const C), integral_const,
    probReal_univ, one_smul, add_sub_cancel_right] using hlU.sub_const C

theorem measure_pi_nnreal_smul {E : Type*} [MeasurableSpace E] (n : ℕ)
    (P : Measure E) [IsFiniteMeasure P] (b : ℝ≥0) :
    Measure.pi (fun _ : Fin n => b • P) =
      ((b : ℝ≥0∞) ^ n) • Measure.pi (fun _ : Fin n => P) := by
  apply Measure.pi_eq
  intro t ht
  rw [Measure.smul_apply, smul_eq_mul, Measure.pi_pi]
  simp only [Measure.coe_nnreal_smul_apply, Finset.prod_mul_distrib,
    Finset.prod_const, Finset.card_univ, Fintype.card_fin]

theorem tendsto_integral_pi_smul {E : Type*} [TopologicalSpace E] [MeasurableSpace E]
    [BorelSpace E] [SecondCountableTopology E] [TopologicalSpace.PseudoMetrizableSpace E]
    (n : ℕ) (P : ℝ → ProbabilityMeasure E) (P₀ : ProbabilityMeasure E)
    (b : ℝ → ℝ≥0) (b₀ : ℝ≥0) (hb₀ : b₀ ≠ 0)
    (hP : Tendsto P atTop (𝓝 P₀)) (hb : Tendsto b atTop (𝓝 b₀))
    (f : (Fin n → E) → ℝ) (hf : Measurable f)
    (hfB : Bornology.IsBounded (Set.range f))
    (hfC : ∀ᵐ z ∂Measure.pi (fun _ : Fin n => b₀ • (P₀ : Measure E)), ContinuousAt f z) :
    Tendsto
      (fun x => ∫ z, f z ∂Measure.pi (fun _ : Fin n => b x • (P x : Measure E))) atTop
      (𝓝 (∫ z, f z ∂Measure.pi (fun _ : Fin n => b₀ • (P₀ : Measure E)))) := by
  have hw : Tendsto (fun x => ProbabilityMeasure.pi (fun _ : Fin n => P x)) atTop
      (𝓝 (ProbabilityMeasure.pi (fun _ : Fin n => P₀))) :=
    (ProbabilityMeasure.continuous_pi.tendsto _).comp (tendsto_pi_nhds.2 (fun _ => hP))
  have hc : ∀ᵐ z ∂Measure.pi (fun _ : Fin n => (P₀ : Measure E)), ContinuousAt f z := by
    rw [measure_pi_nnreal_smul] at hfC
    exact (Measure.ae_ennreal_smul_measure_iff
      (pow_ne_zero _ (by exact_mod_cast hb₀))).mp hfC
  have hw' := tendsto_integral_of_weak_convergence hw f hf hfB hc
  have hs := (((NNReal.continuous_coe.tendsto b₀).comp hb).pow n).mul hw'
  simpa only [measure_pi_nnreal_smul, integral_smul_measure, ENNReal.toReal_pow,
    ENNReal.coe_toReal, smul_eq_mul, Function.comp_def, ProbabilityMeasure.toMeasure_pi] using hs

open Classical in
theorem measure_pi_sum_dirac_eq {E α : Type*} [MeasurableSpace E] (n : ℕ)
    (Q : Finset α) (w : α → ℝ≥0) (u : α → E) :
    Measure.pi (fun _ : Fin n => (∑ s ∈ Q, w s • Measure.dirac (u s))) =
      ∑ r ∈ Fintype.piFinset (fun _ : Fin n => Q),
        (∏ j, w (r j)) • Measure.dirac (fun j => u (r j)) := by
  apply Measure.pi_eq
  intro t ht
  have htp : MeasurableSet (Set.univ.pi t) := MeasurableSet.univ_pi ht
  simp only [Measure.finsetSum_apply, Measure.coe_nnreal_smul_apply,
    Measure.dirac_apply' _ htp, Measure.dirac_apply' _ (ht _)]
  simp_rw [show (Set.univ : Set (Fin n)) = (Finset.univ : Finset (Fin n)) from (by ext; simp),
    Set.indicator_pi_one_apply]
  simp_rw [ENNReal.ofNNReal_finsetProd]
  have hp (z : Fin n → α) := Finset.prod_mul_distrib
    (s := (Finset.univ : Finset (Fin n)))
    (f := fun i : Fin n => (w (z i) : ℝ≥0∞)) (g := fun i => (t i).indicator 1 (u (z i)))
  simp_rw [← hp]
  exact Eq.symm (Finset.prod_univ_sum _
    (fun j : Fin n => fun z : α => (w z : ℝ≥0∞) * (t j).indicator 1 (u z)))

open Classical in
theorem integral_mix_pi {E α : Type*} [MeasurableSpace E]
    (n : ℕ) (Q : Finset α) (w : α → ℝ≥0) (u : α → E) (f : (Fin n → E) → ℝ)
    (hf : StronglyMeasurable f) :
    (∫ z, f z ∂Measure.pi (fun _ : Fin n => ∑ s ∈ Q, w s • Measure.dirac (u s))) =
    ∑ r ∈ Fintype.piFinset (fun _ : Fin n => Q),
      (∏ j, (w (r j) : ℝ)) * f (fun j => u (r j)) := by
  rw [measure_pi_sum_dirac_eq n Q, integral_finsetSum_measure]
  · simp only [integral_smul_nnreal_measure, NNReal.smul_def, smul_eq_mul, NNReal.coe_prod,
      integral_dirac' _ _ hf]
  · intro r _
    exact (integrable_dirac' hf (by finiteness)).smul_measure_nnreal

theorem harmonicConfigurationMass_map_fragmentBandMasses_eq_sum_dirac {m : ℕ}
    (a : Fin (m + 2) → ℝ) (W : ℕ) (R κ : ℝ) :
    ((harmonicConfigurationMass W R κ).map
      (fragmentBandMasses a) : Measure (Fin (m + 1) → ℝ)) =
      ∑ s ∈ (∏ p ∈ fragmentPrimes W R κ, p).divisors,
        ((Nat.totient s : ℝ)⁻¹).toNNReal •
          Measure.dirac (fragmentBandMasses a
            (primeLogConfiguration R s)) := by
  apply Measure.ext
  intro t ht
  rw [FiniteMeasure.toMeasure_map, Measure.map_apply
    (measurable_fragmentBandMasses a) ht]
  let atom (s : ℕ) : FiniteMeasure (FiniteMeasure ℝ) :=
    ⟨Measure.dirac (primeLogConfiguration R s), inferInstance⟩
  have ha (s : ℕ) :
      (((((s.totient : ℝ)⁻¹).toNNReal • atom s) : FiniteMeasure (FiniteMeasure ℝ)) :
        Measure (FiniteMeasure ℝ)) =
          ((s.totient : ℝ)⁻¹).toNNReal •
            Measure.dirac (primeLogConfiguration R s) := by
    rw [FiniteMeasure.toMeasure_smul]
    rfl
  change ((↑(∑ s ∈ (∏ p ∈ fragmentPrimes W R κ, p).divisors,
      ((s.totient : ℝ)⁻¹).toNNReal • atom s) : Measure (FiniteMeasure ℝ))
        (fragmentBandMasses a ⁻¹' t)) = _
  rw [FiniteMeasure.toMeasure_sum]
  simp_rw [Measure.finsetSum_apply, ha, Measure.coe_nnreal_smul_apply,
    Measure.dirac_apply' _ ((measurable_fragmentBandMasses a) ht),
    Measure.dirac_apply' _ ht]
  rfl

theorem fragmentNormalization_pos (H : Finset ℕ) (x R : ℝ) (hR : 1 < R) :
    0 < fragmentNormalization (presievingModulus H x) R := by
  have hw : 0 < presievingModulus H x := presieving_pos H x
  exact mul_pos (div_pos (by exact_mod_cast Nat.totient_pos.mpr hw)
    (by exact_mod_cast hw)) (Real.log_pos hR)

theorem tendsto_harmonic_pi_sum {m : ℕ}
    (H : Finset ℕ) (ρ κ : ℝ) (a : Fin (m + 2) → ℝ)
    (hρ : 0 < ρ) (hκ : 0 < κ) (ha : StrictMono a) (ha0 : a 0 = 0)
    (ha1 : a (Fin.last (m + 1)) = κ) (n : ℕ)
    (K : (Fin n → Fin (m + 1) → ℝ) → ℝ)
    (hK : Measurable K) (hKb : Bornology.IsBounded (Set.range K))
    (hKc : ∀ᵐ Y ∂Measure.pi (fun _ : Fin n =>
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        Measure.map (fragmentBandMasses a) (fragmentLaw κ)),
      ContinuousAt K Y) :
    let R : ℝ → ℝ := fun x => x ^ ρ
    let W := presievingModulus H
    let B : ℝ → ℝ := fun x => fragmentNormalization (W x) (R x)
    let q : ℝ → Finset ℕ := fun x =>
      (∏ p ∈ fragmentPrimes (W x) (R x) κ, p).divisors
    let u : ℝ → ℕ → Fin (m + 1) → ℝ := fun x s => fragmentBandMasses a
      (primeLogConfiguration (R x) s)
    Filter.Tendsto (fun x : ℝ => (B x ^ n)⁻¹ *
      ∑ r ∈ Fintype.piFinset (fun _ : Fin n => q x), (∏ j, (Nat.totient (r j) : ℝ)⁻¹) *
          K (fun j => u x (r j))) Filter.atTop
      (𝓝 (∫ Y, K Y ∂Measure.pi (fun _ : Fin n =>
        ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
          Measure.map (fragmentBandMasses a) (fragmentLaw κ)))) := by
  classical
  intro R W B q u
  let P : ProbabilityMeasure (FiniteMeasure ℝ) :=
    ⟨fragmentLaw κ, fragmentLaw_isProbabilityMeasure κ⟩
  let L := P.toFiniteMeasure.map (fragmentBandMasses a)
  let P₀ := L.normalize
  let V : ℝ → FiniteMeasure (Fin (m + 1) → ℝ) := fun x =>
    (harmonicConfigurationMass (W x) (R x) κ).map (fragmentBandMasses a)
  let b : ℝ → ℝ≥0 := fun x =>
    (harmonicFragmentMass (W x) (R x) κ / B x).toNNReal
  let b₀ : ℝ≥0 := (Real.exp Real.eulerMascheroniConstant * κ).toNNReal
  have hL : P₀.toFiniteMeasure = L := by
    dsimp [P₀, L]
    rw [FiniteMeasure.normalize_map _ P.toFiniteMeasure_nonzero
      (measurable_fragmentBandMasses a),
      ProbabilityMeasure.toFiniteMeasure_normalize_eq_self]
    apply FiniteMeasure.toMeasure_injective
    rfl
  have hν : ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
          Measure.map (fragmentBandMasses a) (fragmentLaw κ) =
        b₀ • (P₀ : Measure (Fin (m + 1) → ℝ)) := by
    have hP₀ : (P₀ : Measure (Fin (m + 1) → ℝ)) = (L : Measure (Fin (m + 1) → ℝ)) :=
      congrArg (fun z : FiniteMeasure (Fin (m + 1) → ℝ) => (z : Measure (Fin (m + 1) → ℝ))) hL
    rw [hP₀]
    change (ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ)) •
      (Measure.map (fragmentBandMasses a) (P : Measure _)) =
      (b₀ : ℝ≥0∞) • (Measure.map (fragmentBandMasses a) (P : Measure _))
    have hb : (b₀ : ℝ≥0∞) = ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) := by
      rw [ENNReal.ofReal_eq_coe_nnreal (mul_pos (Real.exp_pos _) hκ).le]
      congr 1
      apply Subtype.ext
      simp [b₀, Real.toNNReal_of_nonneg (mul_pos (Real.exp_pos _) hκ).le]
    rw [← hb]
  have hw := harmonic_fragment_band_vector_tendsto
    H ρ κ a hρ hκ ha ha0 ha1
  have hp : Tendsto (fun x => (V x).normalize) atTop (𝓝 P₀) := hw.fst_nhds
  have hb : Tendsto b atTop (𝓝 b₀) := tendsto_real_toNNReal
    (harmonic_fragment_normalizer_tendsto H ρ κ hρ hκ)
  have hb0 : b₀ ≠ 0 := by
    apply ne_of_gt
    exact Real.toNNReal_pos.mpr (mul_pos (Real.exp_pos _) hκ)
  rw [hν] at hKc ⊢
  have ht := tendsto_integral_pi_smul n (fun x => (V x).normalize) P₀ b b₀ hb0 hp hb K hK hKb hKc
  apply ht.congr'
  filter_upwards [(tendsto_rpow_atTop hρ).eventually_gt_atTop 1] with x hx
  have hB : 0 < B x := fragmentNormalization_pos H x (R x) hx
  have hVm : (V x).mass.toReal = harmonicFragmentMass (W x) (R x) κ := by
    dsimp [V]
    rw [FiniteMeasure.mass_map_of_aemeasurable _
        (measurable_fragmentBandMasses a).aemeasurable,
      harmonicConfigurationMass_mass]
  have heq : (b x) • ( (V x).normalize : Measure (Fin (m + 1) → ℝ)) =
      ((B x)⁻¹).toNNReal • (V x : Measure (Fin (m + 1) → ℝ)) := by
    have ht' := FiniteMeasure.inv_toNNReal_smul_eq_mass_div_smul_normalize (V x) (B x)
    apply Eq.symm
    have ht'' := congrArg (fun z : FiniteMeasure (Fin (m + 1) → ℝ) =>
      (z : Measure (Fin (m + 1) → ℝ))) ht'
    simpa only [FiniteMeasure.toMeasure_smul,
      ProbabilityMeasure.toMeasure_comp_toFiniteMeasure_eq_toMeasure, hVm, b]
      using ht''
  calc
    _ = (∫ z, K z ∂Measure.pi (fun _ : Fin n =>
      ((B x)⁻¹).toNNReal • (∑ s ∈ q x,
        ((Nat.totient s : ℝ)⁻¹).toNNReal • Measure.dirac (u x s)))) := by
      congr 2
      apply funext
      intro j
      rw [heq]
      rw [harmonicConfigurationMass_map_fragmentBandMasses_eq_sum_dirac]
    _ = _ := by
      simp_rw [Finset.smul_sum, smul_smul]
      rw [integral_mix_pi n _ _ _ K hK.stronglyMeasurable]
      simp only [NNReal.coe_mul, Real.coe_toNNReal _ (inv_nonneg.mpr hB.le),
        Real.coe_toNNReal _ (inv_nonneg.mpr (Nat.cast_nonneg _)), Finset.prod_mul_distrib,
        Finset.prod_const, Finset.card_univ, Fintype.card_fin, ← inv_pow, ← Finset.mul_sum,
        mul_assoc]

open Classical in
theorem exists_shared_prime_of_not_squarefree_prod {ι : Type*} [Fintype ι]
    (S : Finset ℕ) (hS : ∀ p ∈ S, Nat.Prime p) (r : ι → ℕ)
    (hr : ∀ j, r j ∈ (∏ p ∈ S, p).divisors) (h : ¬ Squarefree (∏ j, r j)) :
    ∃ j k, j ≠ k ∧ ∃ p ∈ S, p ∣ r j ∧ p ∣ r k := by
  by_contra! hn
  apply h
  have hq : Squarefree (∏ p ∈ S, p) := squarefree_prime_prod S hS
  apply Finset.squarefree_prod_of_pairwise_isCoprime
  · intro j _ k _ hjk
    apply Nat.coprime_iff_isRelPrime.mp
    apply Nat.coprime_of_dvd
    intro p hp hj hk
    have hpd : p ∣ ∏ q ∈ S, q := dvd_trans hj (Nat.mem_divisors.mp (hr j)).1
    have hpS : p ∈ S := by
      rw [← Nat.primeFactors_prod hS]
      exact Nat.mem_primeFactors.mpr ⟨hp, hpd, hq.ne_zero⟩
    exact hn j k hjk p hpS hj hk
  · intro j _
    exact hq.squarefree_of_dvd (Nat.mem_divisors.mp (hr j)).1

theorem reciprocal_totient_product_sum_shared_prime_eq_div_sq {ι : Type*} [Fintype ι]
    [DecidableEq ι]
    (S : Finset ℕ) (hS : ∀ p ∈ S, Nat.Prime p) (j k : ι) (hjk : j ≠ k)
    (p : ℕ) (hpS : p ∈ S) :
    let Q := (∏ p ∈ S, p).divisors
    let M : ℝ := ∑ s ∈ Q, (Nat.totient s : ℝ)⁻¹
    (∑ r ∈ Fintype.piFinset (fun _ : ι => Q),
      (∏ l, (Nat.totient (r l) : ℝ)⁻¹) *
        (if p ∣ r j ∧ p ∣ r k then 1 else 0)) = M ^ (Fintype.card ι) / (p : ℝ) ^ 2 := by
  classical
  intro Q M
  let A := ({j, k} : Finset ι)
  let u := fun l s => if l ∈ A then
      (Nat.totient s : ℝ)⁻¹ * (if p ∣ s then (1 : ℝ) else 0) else (Nat.totient s : ℝ)⁻¹
  have hu (l : ι) (s : ℕ) : u l s =
      (Nat.totient s : ℝ)⁻¹ * (if l ∈ A → p ∣ s then 1 else 0) := by
    by_cases hl : l ∈ A <;> simp [u, hl]
  have hv (r : ι → ℕ) : (∏ l, u l (r l)) = (∏ l, (Nat.totient (r l) : ℝ)⁻¹) *
      (if p ∣ r j ∧ p ∣ r k then 1 else 0) := by
    simp only [hu, Finset.prod_mul_distrib, Fintype.prod_boole]
    simp [A, or_imp, forall_and]
  simp_rw [← hv]
  rw [Finset.sum_prod_piFinset]
  have hs (l : ι) : (∑ d ∈ Q, u l d) = M * (if l ∈ A then (p : ℝ)⁻¹ else 1) := by
    by_cases hl : l ∈ A
    · simp only [u, hl, ↓reduceIte, mul_ite, mul_one, mul_zero]
      rw [← Finset.sum_filter, marked_reciprocal_totient_sum S hS hpS]
      simp only [M, Q, div_eq_mul_inv]
    · simp [u, hl, M]
  simp_rw [hs, Finset.prod_mul_distrib, Finset.prod_const, Finset.card_univ]
  rw [Finset.prod_ite_mem_eq]
  simp [A, hjk, pow_two, div_eq_mul_inv, mul_inv_rev]

theorem bad_configuration_indicator_le_shared_prime_count {ι : Type*} [Fintype ι] [DecidableEq ι]
    (S : Finset ℕ) (ok : (ι → ℕ) → Prop) [DecidablePred ok]
    (hwit : ∀ r, (∀ j, r j ∈ (∏ p ∈ S, p).divisors) → ¬ ok r →
      ∃ j k, j ≠ k ∧ ∃ p ∈ S, p ∣ r j ∧ p ∣ r k)
    (r : ι → ℕ) (hr : r ∈ Fintype.piFinset (fun _ : ι => (∏ p ∈ S, p).divisors)) :
    (if ok r then (0 : ℝ) else 1) ≤
      ∑ j, ∑ k ∈ Finset.univ.filter (fun k : ι => j ≠ k),
        ∑ p ∈ S, (if p ∣ r j ∧ p ∣ r k then (1 : ℝ) else 0) := by
  classical
  have non (j k) (p) : 0 ≤ (if p ∣ r j ∧ p ∣ r k then (1 : ℝ) else 0) := by split_ifs <;> norm_num
  by_cases hh : ok r
  · simp only [ite_eq_left hh]
    exact Finset.sum_nonneg (fun j _ => Finset.sum_nonneg (fun k _ =>
      Finset.sum_nonneg (fun p _ => non j k p)))
  · rw [ite_eq_right hh]
    obtain ⟨j,k,hne,p,hpS,hj,hk⟩ := hwit r (Fintype.mem_piFinset.mp hr) hh
    calc
      (1 : ℝ) = (if p ∣ r j ∧ p ∣ r k then (1 : ℝ) else 0) := (ite_eq_left ⟨hj,hk⟩).symm
      _ ≤ ∑ p ∈ S, if p ∣ r j ∧ p ∣ r k then (1 : ℝ) else 0 :=
        Finset.single_le_sum (f := fun z : ℕ => if z ∣ r j ∧ z ∣ r k then (1 : ℝ) else 0)
          (fun _ _ => non j k _) hpS
      _ ≤ ∑ k ∈ Finset.univ.filter (fun k : ι => j ≠ k),
          ∑ p ∈ S, if p ∣ r j ∧ p ∣ r k then (1 : ℝ) else 0 := Finset.single_le_sum
            (f := fun b => ∑ p ∈ S, if p ∣ r j ∧ p ∣ r b then (1 : ℝ) else 0)
            (by intro b _; exact Finset.sum_nonneg (fun p _ => non j b p))
            (Finset.mem_filter.mpr ⟨Finset.mem_univ k, hne⟩)
      _ ≤ ∑ j, ∑ k ∈ Finset.univ.filter (fun k : ι => j ≠ k),
          ∑ p ∈ S, if p ∣ r j ∧ p ∣ r k then (1 : ℝ) else 0 := Finset.single_le_sum
            (f := fun b => ∑ k ∈ Finset.univ.filter (fun k : ι => b ≠ k),
              ∑ p ∈ S, if p ∣ r b ∧ p ∣ r k then (1 : ℝ) else 0)
            (by intro b _; exact Finset.sum_nonneg (fun k _ => Finset.sum_nonneg
                (fun p _ => non b k p))) (Finset.mem_univ j)

theorem sum_shared_prime_weights_le {ι : Type*} [Fintype ι] [DecidableEq ι]
    (S : Finset ℕ) (hS : ∀ p ∈ S, Nat.Prime p) :
    let Q := (∏ p ∈ S, p).divisors
    let T := Fintype.piFinset (fun _ : ι => Q)
    let M := (∑ s ∈ Q, (Nat.totient s : ℝ)⁻¹)
    (∑ r ∈ T, (∏ l, (Nat.totient (r l) : ℝ)⁻¹) *
      (∑ j, ∑ k ∈ Finset.univ.filter (fun k : ι => j ≠ k), ∑ p ∈ S,
        (if p ∣ r j ∧ p ∣ r k then (1 : ℝ) else 0))) ≤
      (Fintype.card ι : ℝ) ^ 2 * M ^ (Fintype.card ι) * (∑ p ∈ S, 1 / (p : ℝ) ^ 2) := by
  classical
  intro Q T M
  have h0 : 0 ≤ M := Finset.sum_nonneg fun s _ => inv_nonneg.mpr (Nat.cast_nonneg _)
  calc
    _ = ∑ j, ∑ k ∈ Finset.univ.filter (fun k : ι => j ≠ k), ∑ p ∈ S,
        ∑ r ∈ T, (∏ l, (Nat.totient (r l) : ℝ)⁻¹) *
          (if p ∣ r j ∧ p ∣ r k then (1 : ℝ) else 0) := by
      simp_rw [Finset.mul_sum]
      rw [Finset.sum_comm]
      congr 1
      funext j
      rw [Finset.sum_comm]
      congr 1
      funext k
      rw [Finset.sum_comm]
    _ = ∑ j, ∑ k ∈ Finset.univ.filter (fun k : ι => j ≠ k), ∑ p ∈ S,
        M ^ (Fintype.card ι) / (p : ℝ) ^ 2 := by
      apply Finset.sum_congr rfl
      intro j _
      apply Finset.sum_congr rfl
      intro k hk
      apply Finset.sum_congr rfl
      intro p hp
      exact reciprocal_totient_product_sum_shared_prime_eq_div_sq S hS j k
        (Finset.mem_filter.mp hk).2 p hp
    _ ≤ ∑ j : ι, ∑ _k : ι, ∑ p ∈ S, M ^ (Fintype.card ι) / (p : ℝ) ^ 2 := by
      apply Finset.sum_le_sum
      intro j _
      exact Finset.sum_le_sum_of_subset_of_nonneg
        (Finset.filter_subset (fun k : ι => j ≠ k) Finset.univ)
        (by intro k _ _; exact Finset.sum_nonneg (fun p _ =>
          div_nonneg (pow_nonneg h0 _) (sq_nonneg _)))
    _ = _ := by simp [div_eq_mul_inv, ← Finset.mul_sum, pow_two]; ring

theorem harmonic_restriction_error_le_shared_prime_tail {ι : Type*} [Fintype ι] [DecidableEq ι]
    (S : Finset ℕ) (hS : ∀ p ∈ S, Nat.Prime p)
    (ok : (ι → ℕ) → Prop) [DecidablePred ok]
    (hwit : ∀ r, (∀ j, r j ∈ (∏ p ∈ S, p).divisors) → ¬ ok r →
      ∃ j k, j ≠ k ∧ ∃ p ∈ S, p ∣ r j ∧ p ∣ r k)
    (f : (ι → ℕ) → ℝ) (C : ℝ) (hf : ∀ r, ‖f r‖ ≤ C) :
    let Q := (∏ p ∈ S, p).divisors
    let T := Fintype.piFinset (fun _ : ι => Q)
    let M := (∑ s ∈ Q, (Nat.totient s : ℝ)⁻¹)
    ‖(∑ r ∈ T, (∏ j, (Nat.totient (r j) : ℝ)⁻¹) * (if ok r then f r else 0)) -
      (∑ r ∈ T, (∏ j, (Nat.totient (r j) : ℝ)⁻¹) * f r)‖ ≤
      C * (Fintype.card ι : ℝ) ^ 2 * M ^ (Fintype.card ι) * ∑ p ∈ S, 1 / (p : ℝ) ^ 2 := by
  classical
  intro Q T M
  have C0 : 0 ≤ C := (norm_nonneg (f (fun _ => 1))).trans (hf _)
  rw [← Finset.sum_sub_distrib]
  calc
    _ ≤ ∑ r ∈ T, ‖(∏ j, (Nat.totient (r j) : ℝ)⁻¹) * (if ok r then f r else 0) -
          (∏ j, (Nat.totient (r j) : ℝ)⁻¹) * f r‖ := norm_sum_le _ _
    _ ≤ C * (∑ r ∈ T, (∏ l, (Nat.totient (r l) : ℝ)⁻¹) *
        (∑ j, ∑ k ∈ Finset.univ.filter (fun k : ι => j ≠ k),
          ∑ p ∈ S, (if p ∣ r j ∧ p ∣ r k then (1 : ℝ) else 0))) := by
      rw [Finset.mul_sum]
      apply Finset.sum_le_sum
      intro r hr
      have hp : 0 ≤ ∏ j, (Nat.totient (r j) : ℝ)⁻¹ := Finset.prod_nonneg
        (fun j _ => inv_nonneg.mpr (Nat.cast_nonneg _))
      by_cases hgood : ok r
      · simp only [ite_eq_left hgood, sub_self, norm_zero]
        apply mul_nonneg C0
        apply mul_nonneg hp
        apply Finset.sum_nonneg; intro j hj
        apply Finset.sum_nonneg; intro k hk
        exact Finset.sum_nonneg (fun p _ => by split_ifs <;> norm_num)
      · simp only [ite_eq_right hgood, mul_zero, zero_sub, norm_neg, norm_mul]
        rw [Real.norm_eq_abs, abs_of_nonneg hp]
        calc
          _ ≤ (∏ j, (Nat.totient (r j) : ℝ)⁻¹) * C := by gcongr; exact hf r
          _ = C * (∏ j, (Nat.totient (r j) : ℝ)⁻¹) * 1 := by ring
          _ ≤ _ := by
            simpa only [mul_assoc] using mul_le_mul_of_nonneg_left
              (by simpa only [ite_eq_right hgood] using
                bad_configuration_indicator_le_shared_prime_count S ok hwit r hr)
                (mul_nonneg C0 hp)
    _ ≤ _ := by
      have hz := mul_le_mul_of_nonneg_left (sum_shared_prime_weights_le (ι := ι) S hS) C0
      simpa only [T, Q, M, mul_assoc] using hz

theorem fragmentPrimes_sum_inv_sq_le_presieved_prime_tail (H : Finset ℕ) (x R κ : ℝ) :
    (∑ p ∈ fragmentPrimes (presievingModulus H x)
        R κ, 1 / (p : ℝ) ^ 2) ≤
      ∑' p : ℕ, if Nat.Prime p ∧ ¬ p ∣ presievingModulus H x
        then 1 / (p : ℝ) ^ 2 else 0 := by
  classical
  let g : ℕ → ℝ := fun p => if Nat.Prime p ∧
      ¬ p ∣ presievingModulus H x then 1/(p : ℝ) ^ 2 else 0
  have hsum : Summable (fun p : ℕ => 1 / (p : ℝ) ^ 2) :=
    Real.summable_one_div_nat_pow.mpr (by norm_num)
  have hg : Summable g := Summable.of_nonneg_of_le
    (fun _ => by dsimp [g]; split_ifs <;> positivity)
    (fun p => by dsimp [g]; split_ifs <;> simp)
    hsum
  calc
    _ = ∑ p ∈ fragmentPrimes (presievingModulus H x)
        R κ, g p := by
      apply Finset.sum_congr rfl
      intro p hp
      have h := Finset.mem_filter.mp hp
      simp [g, Nat.prime_of_mem_primesLE h.1, h.2]
    _ ≤ _ := hg.sum_le_tsum _ fun p _ => by dsimp [g]; split_ifs <;> positivity

open Classical in
theorem normalized_harmonic_restriction_error_le {n : ℕ} (S : Finset ℕ) (hS : ∀ p ∈ S, Nat.Prime p)
    (ok : (Fin n → ℕ) → Prop) [DecidablePred ok]
    (hok : ∀ r, (∀ j, r j ∈ (∏ p ∈ S, p).divisors) → ¬ ok r →
      ∃ j k, j ≠ k ∧ ∃ p ∈ S, p ∣ r j ∧ p ∣ r k)
    (K : (Fin n → ℕ) → ℝ) (C : ℝ) (hK : ∀ r, ‖K r‖ ≤ C)
    (B : ℝ) (hB : 0 < B) :
    ‖(B ^ n)⁻¹ * (∑ r ∈ Fintype.piFinset (fun _ : Fin n => (∏ p ∈ S, p).divisors),
      (∏ j, (Nat.totient (r j) : ℝ)⁻¹) * (if ok r then K r else 0)) -
     (B ^ n)⁻¹ * (∑ r ∈ Fintype.piFinset (fun _ : Fin n => (∏ p ∈ S, p).divisors),
      (∏ j, (Nat.totient (r j) : ℝ)⁻¹) * K r)‖ ≤
      (B ^ n)⁻¹ * (C * (Fintype.card (Fin n) : ℝ) ^ 2 *
        ((∑ d ∈ (∏ p ∈ S, p).divisors, (d.totient : ℝ)⁻¹)) ^ n *
        ∑ p ∈ S, 1/(p : ℝ) ^ 2) := by
  rw [← mul_sub, norm_mul,
    Real.norm_of_nonneg (inv_nonneg.mpr (pow_nonneg hB.le _))]
  classical
  exact mul_le_mul_of_nonneg_left (by simpa only [Fintype.card_fin] using
    (harmonic_restriction_error_le_shared_prime_tail (ι := Fin n) S hS ok hok K C hK))
    (inv_nonneg.mpr (pow_nonneg hB.le _))

/--
The harmonic product-sum limit is unchanged by a restriction whose excluded configurations must
share a prime factor between distinct coordinates.
-/
theorem tendsto_restricted_harmonic_pi_sum {m n : ℕ}
    (Hs : Finset ℕ) (ρ κ : ℝ) (a : Fin (m + 2) → ℝ)
    (hρ : 0 < ρ) (hκ : 0 < κ) (ha : StrictMono a) (ha0 : a 0 = 0)
    (ha1 : a (Fin.last (m + 1)) = κ)
    (ok : (Fin n → ℕ) → Prop) [DecidablePred ok]
    (hok : ∀ (S : Finset ℕ), (∀ p ∈ S, Nat.Prime p) →
      ∀ r, (∀ j, r j ∈ (∏ p ∈ S, p).divisors) → ¬ ok r →
        ∃ j k, j ≠ k ∧ ∃ p ∈ S, p ∣ r j ∧ p ∣ r k)
    (K : (Fin n → Fin (m + 1) → ℝ) → ℝ)
    (hK : Measurable K) (hKb : Bornology.IsBounded (Set.range K))
    (hKc : ∀ᵐ Y ∂Measure.pi (fun _ : Fin n =>
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        Measure.map (fragmentBandMasses a) (fragmentLaw κ)),
      ContinuousAt K Y) :
    let R : ℝ → ℝ := fun x => x ^ ρ
    let W := presievingModulus Hs
    let B : ℝ → ℝ := fun x => fragmentNormalization (W x) (R x)
    let q : ℝ → Finset ℕ := fun x =>
      (∏ p ∈ fragmentPrimes (W x) (R x) κ, p).divisors
    let u : ℝ → ℕ → Fin (m + 1) → ℝ := fun x s => fragmentBandMasses a
      (primeLogConfiguration (R x) s)
    Filter.Tendsto (fun x : ℝ => (B x ^ n)⁻¹ *
      ∑ r ∈ Fintype.piFinset (fun _ : Fin n => q x), (∏ j, (Nat.totient (r j) : ℝ)⁻¹) *
        (if ok r then K (fun j => u x (r j)) else 0)) Filter.atTop
      (𝓝 (∫ Y, K Y ∂Measure.pi (fun _ : Fin n =>
        ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
          Measure.map (fragmentBandMasses a) (fragmentLaw κ)))) := by
  classical
  intro R W B q u
  obtain ⟨C, Cpos, hC⟩ := hKb.exists_pos_norm_le
  let good := fun x : ℝ => (B x ^ n)⁻¹ *
    ∑ r ∈ Fintype.piFinset (fun _ : Fin n => q x), (∏ j, (Nat.totient (r j) : ℝ)⁻¹) *
      (if ok r then K (fun j => u x (r j)) else 0)
  let full := fun x : ℝ => (B x ^ n)⁻¹ *
    ∑ r ∈ Fintype.piFinset (fun _ : Fin n => q x), (∏ j, (Nat.totient (r j) : ℝ)⁻¹) *
       K (fun j => u x (r j))
  have hfull : Tendsto full atTop
      (𝓝 (∫ Y, K Y ∂Measure.pi (fun _ : Fin n =>
        ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
          Measure.map (fragmentBandMasses a) (fragmentLaw κ)))) :=
    tendsto_harmonic_pi_sum Hs ρ κ a hρ hκ ha ha0 ha1 n K hK hKb hKc
  let M := fun x => harmonicFragmentMass (W x) (R x) κ
  let tail := fun x => ∑' p : ℕ,
      if Nat.Prime p ∧ ¬ p ∣ W x then 1/(p : ℝ) ^ 2 else 0
  let err := fun x => C * (Fintype.card (Fin n) : ℝ) ^ 2 * (M x / B x) ^ n * tail x
  have ht : Tendsto err atTop (𝓝 0) := by
    have h := ((harmonic_fragment_normalizer_tendsto
      Hs ρ κ hρ hκ).pow n).const_mul (C * (Fintype.card (Fin n) : ℝ) ^ 2)
    simpa only [err, M, W, R, B, mul_zero] using
      h.mul (presieved_prime_square_tail_tendsto Hs)
  have hd : ∀ᶠ x : ℝ in atTop, ‖good x - full x‖ ≤ err x := by
    filter_upwards [(tendsto_rpow_atTop hρ).eventually_gt_atTop 1] with x hx
    have hB := fragmentNormalization_pos Hs x (R x) hx
    let S := fragmentPrimes (W x) (R x) κ
    have hS : ∀ p ∈ S, Nat.Prime p := fun p hp =>
      Nat.prime_of_mem_primesLE (Finset.mem_filter.mp hp).1
    have hpnt := normalized_harmonic_restriction_error_le S hS ok (hok S hS)
      (fun r => K fun j => u x (r j)) C (fun r => hC _ ⟨_, rfl⟩) (B x) hB
    change ‖good x - full x‖ ≤ _
    have ht' : (∑ p ∈ S, 1/(p : ℝ) ^ 2) ≤ tail x :=
    fragmentPrimes_sum_inv_sq_le_presieved_prime_tail Hs x (R x) κ
    have MM : 0 ≤ M x := Finset.sum_nonneg (fun s _ => inv_nonneg.mpr (Nat.cast_nonneg _))
    calc
      _ ≤ (B x ^ n)⁻¹ * (C * (Fintype.card (Fin n) : ℝ) ^ 2 * M x ^ n *
              ∑ p ∈ S, 1/(p : ℝ) ^ 2) := hpnt
      _ ≤ (B x ^ n)⁻¹ * (C * (Fintype.card (Fin n) : ℝ) ^ 2 * M x ^ n * tail x) :=
        mul_le_mul_of_nonneg_left (mul_le_mul_of_nonneg_left ht'
          (mul_nonneg (mul_nonneg Cpos.le (sq_nonneg _)) (pow_nonneg MM n)))
          (inv_nonneg.mpr (pow_nonneg hB.le n))
      _ = err x := by simp only [err, div_pow]; ring
  have hz : Tendsto (fun x => good x - full x) atTop (𝓝 0) := squeeze_zero_norm' hd ht
  simpa [good, sub_add_cancel] using hz.add hfull

theorem sum_pi_snoc {n : ℕ} (Q : Finset ℕ) (f : (Fin (n + 1) → ℕ) → ℝ) :
    (∑ u ∈ Fintype.piFinset (fun _ : Fin (n + 1) => Q), f u) =
      ∑ r ∈ Fintype.piFinset (fun _ : Fin n => Q), ∑ s ∈ Q, f (Fin.snoc r s) := by
  classical
  have hf : Fintype.piFinset (fun _ : Fin (n + 1) => Q) =
      { r ∈ Fintype.piFinset (fun _ : Fin (n + 1) => Q) | True } := by simp
  rw [hf, Finset.filter_piFinset_eq_map_snocEquiv
    (fun _ : Fin (n + 1) => Q) (fun _ => True)]
  simp only [Finset.filter_true, Finset.sum_map, Finset.sum_product]
  rw [Finset.sum_comm]
  change (∑ x ∈ Fintype.piFinset (fun _ : Fin n => Q), ∑ s ∈ Q, f (Fin.snoc x s)) = _
  rfl

theorem squarefree_prod_of_squarefree_mul_prod {n : ℕ} (r : Fin n → ℕ) (s : ℕ) :
    Squarefree (s * ∏ j, r j) → Squarefree (∏ j, r j) := fun h =>
  h.squarefree_of_dvd (dvd_mul_left _ _)

open Classical in
theorem harmonic_sum_snoc_insertNth {n : ℕ} {E : Type*} (Q : Finset ℕ) (i : Fin (n + 1))
    (u : ℕ → E) (G : (Fin n → E) → ℝ) (F : (Fin (n + 1) → E) → ℝ) :
    (∑ t ∈ Fintype.piFinset (fun _ : Fin (n + 1) => Q),
      (∏ j, (Nat.totient (t j) : ℝ)⁻¹) *
        (if Squarefree (∏ j, t j) then G (fun j => u (t j.castSucc)) *
            F (fun l => u (i.insertNth (α := fun _ => ℕ) (t (Fin.last n))
              (Fin.init t) l)) else 0)) =
    ∑ r ∈ Fintype.piFinset (fun _ : Fin n => Q),
      (∏ j, (Nat.totient (r j) : ℝ)⁻¹) *
        (if Squarefree (∏ j, r j) then G (fun j => u (r j)) else 0) *
          ∑ a ∈ Q, (a.totient : ℝ)⁻¹ *
            (if Squarefree (a * ∏ j, r j) then
              F (fun l => u (i.insertNth (α := fun _ => ℕ) a r l)) else 0) := by
  rw [sum_pi_snoc Q]
  simp only [Fin.prod_snoc, Fin.init_snoc, Fin.snoc_castSucc, Fin.snoc_last]
  apply Finset.sum_congr rfl
  intro r _
  have hprod (b : ℕ) : (∏ j, (Nat.totient (Fin.snoc (α := fun _ => ℕ) r b j) : ℝ)⁻¹) =
      (∏ j, (Nat.totient (r j) : ℝ)⁻¹) * (Nat.totient b : ℝ)⁻¹ := by
    rw [Fin.prod_univ_castSucc]
    simp only [Fin.snoc_castSucc, Fin.snoc_last]
  rw [Finset.mul_sum]
  apply Finset.sum_congr rfl
  intro b hb
  rw [hprod]
  by_cases h : Squarefree (b * ∏ j, r j)
  · have hr : Squarefree (∏ j, r j) := squarefree_prod_of_squarefree_mul_prod r b h
    simp only [hr, h, mul_comm (∏ j : Fin n, r j) b, ite_true]
    ring
  · have h' : ¬ Squarefree ((∏ j, r j) * b) := by simpa [mul_comm] using h
    by_cases hr : Squarefree (∏ j, r j) <;> simp [h, h', hr]

open Classical in
theorem harmonic_sum_snoc_snoc_insertNth {n : ℕ} {E : Type*} (Q : Finset ℕ) (i : Fin (n + 1))
    (u : ℕ → E) (F F' : (Fin (n + 1) → E) → ℝ) :
    (∑ v ∈ Fintype.piFinset (fun _ : Fin (n + 1 + 1) => Q),
      (∏ j, (Nat.totient (v j) : ℝ)⁻¹) *
        (if Squarefree (∏ j : Fin (n + 1), v j.castSucc) ∧
              Squarefree ((∏ j : Fin n, v j.castSucc.castSucc) * v (Fin.last (n + 1))) then
           F (fun l => u (i.insertNth (α := fun _ => ℕ) (v (Fin.last n).castSucc)
              (Fin.init (Fin.init v)) l)) *
           F' (fun l => u (i.insertNth (α := fun _ => ℕ) (v (Fin.last (n + 1)))
               (Fin.init (Fin.init v)) l)) else 0)) =
    ∑ r ∈ Fintype.piFinset (fun _ : Fin n => Q), (∏ j, (Nat.totient (r j) : ℝ)⁻¹) *
      (∑ a ∈ Q, (a.totient : ℝ)⁻¹ *
          (if Squarefree (a * ∏ j, r j) then
              F (fun l => u (i.insertNth (α := fun _ => ℕ) a r l)) else 0)) *
      (∑ b ∈ Q, (b.totient : ℝ)⁻¹ *
          (if Squarefree (b * ∏ j, r j) then
            F' (fun l => u (i.insertNth (α := fun _ => ℕ) b r l)) else 0)) := by
  rw [sum_pi_snoc Q]
  simp only [Fin.snoc_castSucc, Fin.snoc_last, Fin.init_snoc]
  rw [sum_pi_snoc Q]
  simp only [Fin.prod_snoc, Fin.snoc_castSucc, Fin.snoc_last, Fin.init_snoc]
  apply Finset.sum_congr rfl
  intro r _
  have hprod (a b : ℕ) : (∏ j, (Nat.totient (Fin.snoc (α := fun _ => ℕ)
        (Fin.snoc (α := fun _ => ℕ) r a) b j) : ℝ)⁻¹) =
      ((∏ j, (Nat.totient (r j) : ℝ)⁻¹) * (a.totient : ℝ)⁻¹) * (b.totient : ℝ)⁻¹ := by
    rw [Fin.prod_univ_castSucc, Fin.prod_univ_castSucc]
    simp only [Fin.snoc_castSucc, Fin.snoc_last]
  simp_rw [hprod]
  rw [mul_assoc, Finset.mul_sum]
  conv_rhs =>
    rw [Finset.mul_sum]
  rw [Finset.sum_comm]
  apply Finset.sum_congr rfl
  intro b hb
  rw [Finset.sum_mul, Finset.mul_sum]
  apply Finset.sum_congr rfl
  intro c hc
  by_cases h : Squarefree (b * ∏ j, r j) <;> by_cases h' : Squarefree (c * ∏ j, r j) <;>
    simp only [h, h', mul_comm (∏ j : Fin n, r j), ite_true, ite_false,
      and_true, and_false] <;> ring

theorem sum_four_linear_terms {α : Type*} (T : Finset α) (f0 f1 f2 f3 : α → ℝ)
    (c d e : ℝ) :
    c * (∑ i ∈ T, f0 i) + d * (∑ i ∈ T, f1 i) + d * (∑ i ∈ T, f2 i) + e * (∑ i ∈ T, f3 i) =
      ∑ i ∈ T, (c * f0 i + d * f1 i + d * f2 i + e * f3 i) := by
  simp only [Finset.sum_add_distrib, Finset.mul_sum]

theorem polarized_harmonic_sum_expansion {E : Type*} (i : Fin 40) (Q : Finset ℕ)
    (B : ℝ) (hB : B ≠ 0) (U : ℕ → E)
    (G G' : (Fin 39 → E) → ℝ) (F F' : (Fin 40 → E) → ℝ) :
    let T39 := (Fintype.piFinset (fun _ : Fin 39 => Q)).filter
      (fun r => Squarefree (∏ j, r j))
    let T40 := (Fintype.piFinset (fun _ : Fin 40 => Q)).filter
      (fun r => Squarefree (∏ j, r j))
    let w := fun K : (Fin 39 → E) → ℝ =>
      ∑ r ∈ T39, Finsupp.single r (K (fun j => U (r j)) / B ^ 39)
    let y := fun K : (Fin 40 → E) → ℝ =>
      ∑ r ∈ T40, Finsupp.single r (K (fun j => U (r j)) / B ^ 40)
    let erase := fun v : (Fin 40 → ℕ) →₀ ℝ =>
      v.sum (fun r vr => Finsupp.single (fun j => r (i.succAbove j))
        (vr / ((r i).totient : ℝ)))
    let z := w G + erase (y F)
    let z' := w G' + erase (y F')
    B ^ 39 * z.sum (fun r zr => zr * z' r / ∏ j, ((r j).totient : ℝ)) =
      (B ^ 39)⁻¹ * (∑ r ∈ Fintype.piFinset (fun _ : Fin 39 => Q),
        (∏ j, (Nat.totient (r j) : ℝ)⁻¹) *
          (if Squarefree (∏ j, r j) then G (fun j => U (r j))*G' (fun j => U (r j)) else 0)) +
      (B ^ 40)⁻¹ * (∑ t ∈ Fintype.piFinset (fun _ : Fin 40 => Q),
        (∏ j, (Nat.totient (t j) : ℝ)⁻¹) *
          (if Squarefree (∏ j, t j) then
            G (fun j => U (t j.castSucc)) *
              F' (fun l => U (i.insertNth (α := fun _ => ℕ) (t (Fin.last 39))
                (Fin.init t) l)) else 0)) +
      (B ^ 40)⁻¹ * (∑ t ∈ Fintype.piFinset (fun _ : Fin 40 => Q),
        (∏ j, (Nat.totient (t j) : ℝ)⁻¹) *
          (if Squarefree (∏ j, t j) then
            G' (fun j => U (t j.castSucc)) *
            F (fun l => U (i.insertNth (α := fun _ => ℕ) (t (Fin.last 39))
              (Fin.init t) l)) else 0)) +
      (B ^ 41)⁻¹ * (∑ v ∈ Fintype.piFinset (fun _ : Fin 41 => Q),
        (∏ j, (Nat.totient (v j) : ℝ)⁻¹) *
          (if Squarefree (∏ j : Fin 40, v j.castSucc) ∧
              Squarefree ((∏ j : Fin 39, v j.castSucc.castSucc) * v (Fin.last 40)) then
            F (fun l => U (i.insertNth (α := fun _ => ℕ) (v (Fin.last 39).castSucc)
                (Fin.init (Fin.init v)) l)) *
            F' (fun l => U (i.insertNth (α := fun _ => ℕ) (v (Fin.last 40))
              (Fin.init (Fin.init v)) l))
          else 0)) := by
  classical
  intro T39 T40 w y e z z'
  let Ret := Fintype.piFinset (fun _ : Fin 39 => Q)
  let tw := fun r : Fin 39 → ℕ => ∏ j, (Nat.totient (r j) : ℝ)⁻¹
  let D := fun r : Fin 39 → ℕ => ∏ j, r j
  let A := fun (K : (Fin 39 → E) → ℝ) (r : Fin 39 → ℕ) =>
    if Squarefree (D r) then K (fun j => U (r j)) else 0
  let Z := fun (K : (Fin 40 → E) → ℝ) (r : Fin 39 → ℕ) (s : ℕ) =>
    K (fun l => U (i.insertNth (α := fun _ => ℕ) s r l))
  let S := fun (K : (Fin 40 → E) → ℝ) (r : Fin 39 → ℕ) =>
    ∑ s ∈ Q, (s.totient : ℝ)⁻¹ * (if Squarefree (s * D r) then Z K r s else 0)
  have Wv (K) (r : Fin 39 → ℕ) : w K r =
      if r ∈ Ret then A K r / B ^ 39 else 0 := by
    dsimp [w, T39, A, D]
    simp only [Finsupp.finsetSum_apply, Finsupp.single_apply, Finset.sum_ite_eq',
      Finset.mem_filter, Fintype.mem_piFinset]
    have ret (r : Fin 39 → ℕ) : (r ∈ Ret) ↔ ∀ j, r j ∈ Q := Fintype.mem_piFinset
    by_cases hr : r ∈ Ret
    · have h : ∀ j, r j ∈ Q := ret r |>.mp hr
      by_cases hsq : Squarefree (∏ j : Fin 39, r j) <;>
        simp [hr, h, hsq]
    · have h : ¬ ∀ j, r j ∈ Q := by simpa only [ret] using hr
      simp [hr, h]
  have Ev (K) (r : Fin 39 → ℕ) : e (y K) r =
      if r ∈ Ret then S K r / B ^ 40 else 0 := by
    rw [canonical_erased_profile_sum i Q (fun t => K (fun j => U (t j))/B ^ 40) r]
    have ret : (∀ j, r j ∈ Q) ↔ r ∈ Ret := Fintype.mem_piFinset.symm
    by_cases hr : r ∈ Ret
    · rw [ite_eq_left hr]
      simp_rw [ret, hr, and_true, S, Finset.sum_div]
      apply Finset.sum_congr rfl
      intro s hs
      by_cases ht : Squarefree (s * D r)
      · simp [ht, D, Z]
        ring
      · simp [ht, D]
    · rw [ite_eq_right hr]
      simp_rw [ret, hr, and_false, ite_false, Finset.sum_const_zero]
  have Zv (K KK) (r : Fin 39 → ℕ) : (w K + e (y KK)) r =
      if r ∈ Ret then A K r / B ^ 39 + S KK r / B ^ 40 else 0 := by
    rw [Finsupp.add_apply, Wv, Ev]
    by_cases hr : r ∈ Ret <;> simp [hr]
  have zs (K KK) : (w K + e (y KK)).support ⊆ Ret := by
    intro r hr
    by_contra hn
    exact (Finsupp.mem_support_iff.mp hr) (by rw [Zv, ite_eq_right hn])
  let expr0 := (∑ r ∈ Ret, tw r *
      (if Squarefree (D r) then G (fun j => U (r j))*G' (fun j => U (r j)) else 0))
  let expr1 := (∑ r ∈ Ret, tw r * A G r * S F' r)
  let expr2 := (∑ r ∈ Ret, tw r * A G' r * S F r)
  let expr3 := (∑ r ∈ Ret, tw r * S F r * S F' r)
  have ind1 := harmonic_sum_snoc_insertNth Q i U G F'
  have ind2 := harmonic_sum_snoc_insertNth Q i U G' F
  have ind3 := harmonic_sum_snoc_snoc_insertNth Q i U F F'
  rw [ind1, ind2, ind3]
  dsimp only [z, z']
  change B ^ 39 * _ = (B ^ 39)⁻¹ * expr0 + (B ^ 40)⁻¹ * expr1 +
    (B ^ 40)⁻¹ * expr2 + (B ^ 41)⁻¹ * expr3
  dsimp only [expr0, expr1, expr2, expr3]
  rw [sum_four_linear_terms]
  rw [Finsupp.sum_of_support_subset _ (zs G F) _ (by simp)]
  rw [Finset.mul_sum]
  apply Finset.sum_congr rfl
  intro r hr
  simp only [Zv, ite_eq_left hr]
  have hpow : B ^ 39 ≠ 0 := pow_ne_zero _ hB
  dsimp only [tw, D]
  simp only [A]
  have htinv : (∏ j, (Nat.totient (r j) : ℝ)⁻¹) = (∏ j, (Nat.totient (r j) : ℝ))⁻¹ := by
    rw [Finset.prod_inv_distrib]
  rw [htinv]
  rw [div_eq_mul_inv, show B ^ 40 = B ^ 39 * B by ring, show B ^ 41 = B ^ 39 * B ^ 2 by ring]
  simp only [mul_inv_rev]
  by_cases hh : Squarefree (∏ j : Fin 39, r j)
  · simp only [D, hh, ite_eq_left]
    rw [div_eq_mul_inv, div_eq_mul_inv, div_eq_mul_inv, div_eq_mul_inv]
    simp only [mul_inv_rev]
    field_simp [hpow, hB] ; ring
  · simp only [D, hh, ite_false, zero_div, zero_add, mul_zero, zero_mul, add_zero]
    simp only [div_eq_mul_inv, mul_inv_rev]
    field_simp [hpow, hB]

theorem measurePreserving_insertNth {E : Type*} [MeasurableSpace E] {n : ℕ}
    (μ : Measure E) [SigmaFinite μ] (i : Fin (n + 1)) :
    MeasurePreserving (fun p : (Fin n → E) × E => i.insertNth p.2 p.1)
      ((Measure.pi (fun _ : Fin n => μ)).prod μ) (Measure.pi (fun _ : Fin (n + 1) => μ)) := by
  convert ((measurePreserving_piFinSuccAbove (fun _ : Fin (n + 1) => μ) i).symm).comp
    (Measure.measurePreserving_swap (μ := Measure.pi (fun _ : Fin n => μ)) (ν := μ)) using 1
  ext p j
  rfl

theorem measurePreserving_init_last {E : Type*} [MeasurableSpace E] {n : ℕ}
    (μ : Measure E) [SigmaFinite μ] :
    MeasurePreserving (fun v : Fin (n + 1) → E => (Fin.init v, v (Fin.last n)))
      (Measure.pi (fun _ : Fin (n + 1) => μ)) ((Measure.pi (fun _ : Fin n => μ)).prod μ) := by
  convert (Measure.measurePreserving_swap (μ := μ) (ν := Measure.pi (fun _ : Fin n => μ))).comp
    (measurePreserving_piFinSuccAbove (fun _ : Fin (n + 1) => μ) (Fin.last n)) using 1
  ext v
  · simp [MeasurableEquiv.piFinSuccAbove,
      Fin.insertNthEquiv, Fin.init]
  · rfl

theorem exists_shared_prime_of_not_squarefree_overlapping_products {n : ℕ}
    (S : Finset ℕ) (hS : ∀ p ∈ S, Nat.Prime p)
    (v : Fin (n + 1 + 1) → ℕ) (hv : ∀ j : Fin (n + 1 + 1), v j ∈ (∏ p ∈ S, p).divisors)
    (hbad : ¬ (Squarefree (∏ j : Fin (n + 1), v j.castSucc) ∧
          Squarefree ((∏ j : Fin n, v j.castSucc.castSucc) * v (Fin.last (n + 1))))) :
      ∃ j k, j ≠ k ∧ ∃ p ∈ S, p ∣ v j ∧ p ∣ v k := by
  classical
  rcases not_and_or.mp hbad with h | h
  · obtain ⟨j, k, hne, p, hp, hj, hk⟩ :=
      exists_shared_prime_of_not_squarefree_prod S hS
        (fun j : Fin (n + 1) => v j.castSucc) (fun j => hv _) h
    exact ⟨j.castSucc, k.castSucc, Fin.castSucc_inj.ne.mpr hne, p, hp, hj, hk⟩
  · let e : Fin (n + 1) → Fin (n + 1 + 1) := (Fin.castSucc (Fin.last n)).succAbove
    have heq (j : Fin (n + 1)) : v (e j) = Fin.snoc (α := fun _ => ℕ)
        (fun b : Fin n => v b.castSucc.castSucc) (v (Fin.last (n + 1))) j := by
      cases j using Fin.lastCases with
      | last =>
        change v ((Fin.last n).castSucc.succAbove (Fin.last n)) = _
        rw [Fin.succAbove_castSucc_self, Fin.snoc_last]
        rfl
      | cast j =>
        simp only [Fin.snoc_castSucc]
        change v ((Fin.last n).castSucc.succAbove j.castSucc) = v j.castSucc.castSucc
        rw [Fin.succAbove_castSucc_of_lt (Fin.last n) j.castSucc (Fin.castSucc_lt_last j)]
    obtain ⟨j, k, hjk, p, hp, hj, hk⟩ := exists_shared_prime_of_not_squarefree_prod S hS
      (Fin.snoc (α := fun _ => ℕ) (fun b : Fin n => v b.castSucc.castSucc) (v (Fin.last (n + 1))))
      (fun j => by rw [← heq]; exact hv _)
      (by simpa only [Fin.prod_snoc] using h)
    exact ⟨e j, e k, Fin.succAbove_right_injective.ne hjk, p, hp,
      by rwa [← heq] at hj, by rwa [← heq] at hk⟩

theorem integrable_of_measurable_of_bounded_range {E : Type*} [MeasurableSpace E] (μ : Measure E)
    [IsFiniteMeasure μ] (f : E → ℝ) (hf : Measurable f)
    (hb : Bornology.IsBounded (Set.range f)) : Integrable f μ := by
  obtain ⟨C, _, hC⟩ := hb.exists_pos_norm_le
  exact Integrable.of_bound hf.aestronglyMeasurable C (Filter.Eventually.of_forall
    (fun t => hC _ ⟨t, rfl⟩))

theorem isBounded_range_mul_comp {D A A' : Type*} {f : A → ℝ} {g : A' → ℝ}
    (hf : Bornology.IsBounded (Set.range f)) (hg : Bornology.IsBounded (Set.range g))
    (u : D → A) (v : D → A') :
    Bornology.IsBounded (Set.range (fun x => f (u x) * g (v x))) := by
  apply (isBounded_mul hf hg).subset
  rintro _ ⟨x, rfl⟩
  exact ⟨_, ⟨u x, rfl⟩, _, ⟨v x, rfl⟩, rfl⟩

theorem integral_product_of_sums_with_marginals {Y E : Type*} [MeasurableSpace Y]
    [MeasurableSpace E]
    (η : Measure Y) (ν : Measure E) [SFinite η] [SFinite ν]
    (g g' : Y → ℝ) (f f' : Y × E → ℝ)
    (ig : Integrable (fun y => g y * g' y) η)
    (ih : Integrable (fun p : Y × E => g p.1 * f' p) (η.prod ν))
    (ih' : Integrable (fun p : Y × E => f p * g' p.1) (η.prod ν))
    (ihh : Integrable (fun p : (Y × E) × E => f p.1 * f' (p.1.1,p.2))
      ((η.prod ν).prod ν)) :
    (∫ y, (g y + ∫ t, f (y,t) ∂ν) * (g' y + ∫ t, f' (y,t) ∂ν) ∂η) =
      (∫ y, g y * g' y ∂η) +
        (∫ p : Y × E, g p.1 * f' p ∂η.prod ν) +
        (∫ p : Y × E, f p * g' p.1 ∂η.prod ν) +
        ∫ p : (Y × E) × E, f p.1 * f' (p.1.1,p.2) ∂(η.prod ν).prod ν := by
  have eqgp : (∫ p : Y × E, g p.1 * f' p ∂η.prod ν) =
      (∫ r, g r * (∫ t, f' (r, t) ∂ν) ∂η) := by
    rw [integral_prod _ ih]
    simp only [integral_const_mul]
  have eqpg : (∫ p : Y × E, f p * g' p.1 ∂η.prod ν) =
      (∫ r, (∫ t, f (r, t) ∂ν) * g' r ∂η) := by
    rw [integral_prod _ ih']
    simp only [integral_mul_const]
  have aux (p : Y × E) : (∫ t, f p * f' (p.1,t) ∂ν) = f p * (∫ t, f' (p.1,t) ∂ν) :=
    integral_const_mul _ _
  have ep : Integrable (fun p : Y × E => f p * (∫ t, f' (p.1,t) ∂ν)) (η.prod ν) := by
    convert ihh.integral_prod_left using 1
    exact (funext aux).symm
  have eqpp : (∫ p : (Y × E) × E, f p.1 * f' (p.1.1,p.2) ∂(η.prod ν).prod ν) =
      ∫ r, (∫ s, f (r, s) ∂ν) * (∫ t, f' (r, t) ∂ν) ∂η := by
    rw [integral_prod _ ihh, integral_congr_ae (.of_forall aux), integral_prod _ ep]
    simp only [integral_mul_const]
  have ieqgp := ih.integral_prod_left
  have ieqpg := ih'.integral_prod_left
  simp only [integral_const_mul] at ieqgp
  simp only [integral_mul_const] at ieqpg
  have ieqpp := ep.integral_prod_left
  simp only [integral_mul_const] at ieqpp
  rw [eqgp, eqpg, eqpp]
  calc
    _ = (∫ y, (g y * g' y + g y * (∫ t, f' (y, t) ∂ν)) +
        ((∫ t, f (y, t) ∂ν) * g' y + (∫ s, f (y, s) ∂ν) * (∫ t, f' (y, t) ∂ν)) ∂η) := by
      apply integral_congr_ae
      exact Filter.Eventually.of_forall (fun y => by ring)
    _ = _ := by
      simpa only [Pi.add_apply, integral_add ig ieqgp, integral_add ieqpg ieqpp,
        add_assoc] using integral_add (ig.add ieqgp) (ieqpg.add ieqpp)

theorem insertNth_comp {α β : Type*} {n : ℕ} (i : Fin (n + 1))
    (U : α → β) (x : α) (f : Fin n → α) :
    i.insertNth (α := fun _ => β) (U x) (fun j => U (f j)) =
      (fun j => U (i.insertNth (α := fun _ => α) x f j)) := by
  apply Fin.insertNth_eq_iff.mpr
  constructor
  · rw [Fin.insertNth_apply_same]
  · ext j
    simp [Fin.removeNth]

theorem integral_pi_product_of_sums_with_marginals {E : Type*} [MeasurableSpace E]
    (ν : Measure E) [IsFiniteMeasure ν] (i : Fin 40)
    (G G' : (Fin 39 → E) → ℝ) (F F' : (Fin 40 → E) → ℝ)
    (hG : Measurable G) (hG' : Measurable G') (hF : Measurable F) (hF' : Measurable F')
    (hbG : Bornology.IsBounded (Set.range G)) (hbG' : Bornology.IsBounded (Set.range G'))
    (hbF : Bornology.IsBounded (Set.range F)) (hbF' : Bornology.IsBounded (Set.range F')) :
    (∫ y, (G y + ∫ t, F (i.insertNth t y) ∂ν) *
      (G' y + ∫ t, F' (i.insertNth t y) ∂ν) ∂Measure.pi (fun _ : Fin 39 => ν)) =
        (∫ y, G y * G' y ∂Measure.pi (fun _ : Fin 39 => ν)) +
        (∫ v, G (Fin.init v) * F' (i.insertNth (v (Fin.last 39)) (Fin.init v))
          ∂Measure.pi (fun _ : Fin 40 => ν)) +
        (∫ v, G' (Fin.init v) * F (i.insertNth (v (Fin.last 39)) (Fin.init v))
          ∂Measure.pi (fun _ : Fin 40 => ν)) +
        (∫ v, F (i.insertNth (v (Fin.last 39).castSucc) (Fin.init (Fin.init v))) *
             F' (i.insertNth (v (Fin.last 40)) (Fin.init (Fin.init v)))
          ∂Measure.pi (fun _ : Fin 41 => ν)) := by
  let Y := Fin 39 → E
  let η := Measure.pi (fun _ : Fin 39 => ν)
  let J : Y × E → (Fin 40 → E) := fun p => i.insertNth p.2 p.1
  have jp : MeasurePreserving J ((Measure.pi (fun _ : Fin 39 => ν)).prod ν)
       (Measure.pi (fun _ : Fin 40 => ν)) := measurePreserving_insertNth ν i
  have dp : MeasurePreserving (fun r : Fin 40 → E => (Fin.init r, r (Fin.last 39)))
      (Measure.pi (fun _ : Fin 40 => ν)) (η.prod ν) := measurePreserving_init_last ν
  have d2p : MeasurePreserving
      (fun r : Fin 41 → E => ((Fin.init (Fin.init r), r (Fin.last 39).castSucc), r (Fin.last 40)))
      (Measure.pi (fun _ : Fin 41 => ν)) ((η.prod ν).prod ν) := by
    convert ((measurePreserving_init_last (n := 39) ν).prod (MeasurePreserving.id ν)).comp
      (measurePreserving_init_last (n := 40) ν) using 1
    rfl
  have jm : Measurable J := jp.measurable
  have dm : Measurable (fun r : Fin 40 → E => (Fin.init r, r (Fin.last 39))) := dp.measurable
  have d2m : Measurable (fun r : Fin 41 → E => ((Fin.init (Fin.init r),
      r (Fin.last 39).castSucc), r (Fin.last 40))) := d2p.measurable
  let gp : Y × E → ℝ := fun p => G p.1 * F' (J p)
  let pg : Y × E → ℝ := fun p => G' p.1 * F (J p)
  let pp : (Y × E) × E → ℝ := fun p => F (J p.1) * F' (J (p.1.1,p.2))
  have mp : Measurable pp := (hF.comp (jm.comp measurable_fst)).mul
    (hF'.comp (jm.comp (by fun_prop)))
  have bpm := isBounded_range_mul_comp hbF hbF' (J ∘ Prod.fst) (fun p => J (p.1.1,p.2))
  have mi : Integrable gp (η.prod ν) := integrable_of_measurable_of_bounded_range _ _
    ((hG.comp measurable_fst).mul (hF'.comp jm)) (isBounded_range_mul_comp hbG hbF' Prod.fst J)
  have mi' : Integrable (fun p : Y × E => F (J p) * G' p.1) (η.prod ν) :=
    integrable_of_measurable_of_bounded_range _ _
      ((hF.comp jm).mul (hG'.comp measurable_fst)) (isBounded_range_mul_comp hbF hbG' J Prod.fst)
  have md : Integrable pp ((η.prod ν).prod ν) :=
    integrable_of_measurable_of_bounded_range _ _ mp bpm
  have c := integral_product_of_sums_with_marginals η ν G G' (F ∘ J) (F' ∘ J)
    (integrable_of_measurable_of_bounded_range _ _ (hG.mul hG')
      (isBounded_range_mul_comp hbG hbG' id id)) mi mi' md
  have cg : (∫ p, gp p ∂η.prod ν) =
       (∫ r, gp (Fin.init r, r (Fin.last 39)) ∂Measure.pi (fun _ : Fin 40 => ν)) := by
    rw [← dp.map_eq]
    exact integral_map_of_stronglyMeasurable dm (show StronglyMeasurable gp from
      ((hG.comp measurable_fst).mul (hF'.comp jm)).stronglyMeasurable)
  have cg' : (∫ p, pg p ∂η.prod ν) =
       (∫ r, pg (Fin.init r, r (Fin.last 39)) ∂Measure.pi (fun _ : Fin 40 => ν)) := by
    rw [← dp.map_eq]
    exact integral_map_of_stronglyMeasurable dm (show StronglyMeasurable pg from
      ((hG'.comp measurable_fst).mul (hF.comp jm)).stronglyMeasurable)
  have cq : (∫ p, pp p ∂(η.prod ν).prod ν) =
       (∫ r, pp ((Fin.init (Fin.init r), r (Fin.last 39).castSucc), r (Fin.last 40))
        ∂Measure.pi (fun _ : Fin 41 => ν)) := by
    rw [← d2p.map_eq]
    exact integral_map_of_stronglyMeasurable d2m mp.stronglyMeasurable
  have flip : (∫ p : Y × E, F (J p) * G' p.1 ∂η.prod ν) = ∫ p, pg p ∂η.prod ν :=
    integral_congr_ae (.of_forall fun p => mul_comm (F (J p)) (G' p.1))
  change (∫ y, (G y + ∫ t, F (i.insertNth t y) ∂ν) *
      (G' y + ∫ t, F' (i.insertNth t y) ∂ν) ∂η) = (∫ y, G y * G' y ∂η) +
      (∫ p, gp p ∂η.prod ν) + (∫ p, (fun u => F (J u) * G' u.1) p ∂η.prod ν) +
      (∫ p, pp p ∂(η.prod ν).prod ν) at c
  rw [flip, cg, cg', cq] at c
  exact c

theorem tendsto_mixed_harmonic_sum {m : ℕ} (Hs : Finset ℕ) (ρ : ℝ) (hρ : 0 < ρ)
    (i : Fin 40) (κ : ℝ) (hκ : 0 < κ) (a : Fin (m + 2) → ℝ) (ha : StrictMono a)
    (ha0 : a 0 = 0) (haLast : a (Fin.last (m + 1)) = κ) (G : (Fin 39 → Fin (m + 1) → ℝ) → ℝ)
    (F : (Fin 40 → Fin (m + 1) → ℝ) → ℝ) (hG : Measurable G) (hF : Measurable F)
    (hbG : Bornology.IsBounded (Set.range G)) (hbF : Bornology.IsBounded (Set.range F)) :
    let ν : Measure (Fin (m + 1) → ℝ) := ENNReal.ofReal
        (Real.exp Real.eulerMascheroniConstant * κ) •
          Measure.map (fragmentBandMasses a) (fragmentLaw κ)
    (∀ᵐ X ∂Measure.pi (fun _ : Fin 39 => ν), ContinuousAt G X) →
    (∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => ν), ContinuousAt F X) →
    let W := presievingModulus Hs
    let R := fun x : ℝ => x ^ ρ
    let B := fun x : ℝ => fragmentNormalization (W x) (R x)
    let Q := fun x : ℝ => (∏ p ∈ fragmentPrimes (W x) (R x) κ, p).divisors
    let U := fun x : ℝ => fun s : ℕ =>
      fragmentBandMasses a (primeLogConfiguration (R x) s)
    Tendsto (fun x : ℝ => ((B x) ^ 40)⁻¹ * (∑ t ∈ Fintype.piFinset (fun _ : Fin 40 => Q x),
        (∏ j, (Nat.totient (t j) : ℝ)⁻¹) *
          (if Squarefree (∏ j, t j) then
            G (fun j => U x (t j.castSucc)) *
            F (fun l => U x (i.insertNth (α := fun _ => ℕ) (t (Fin.last 39))
              (Fin.init t) l)) else 0))) atTop
      (𝓝 (∫ v, G (Fin.init v) * F (i.insertNth (v (Fin.last 39)) (Fin.init v))
          ∂Measure.pi (fun _ : Fin 40 => ν))) := by
  intro ν cG cF W R B Q U
  let E := Fin (m + 1) → ℝ
  let Y := Fin 39 → E
  let : IsProbabilityMeasure (fragmentLaw κ) :=
    fragmentLaw_isProbabilityMeasure κ
  let : IsFiniteMeasure ν := by
    dsimp [ν]
    exact (Measure.map (fragmentBandMasses a)
      (fragmentLaw κ)).smul_finite (by simp)
  let η := Measure.pi (fun _ : Fin 39 => ν)
  let η' := Measure.pi (fun _ : Fin 40 => ν)
  let J : Y × E → (Fin 40 → E) := fun p => i.insertNth p.2 p.1
  have jmeas : Measurable J := by dsimp [J]; fun_prop
  have jc : Continuous J := by dsimp [J]; fun_prop
  have jp : MeasurePreserving J (η.prod ν) η' := measurePreserving_insertNth ν i
  let d : (Fin 40 → E) → Y × E := fun r => (Fin.init r, r (Fin.last 39))
  have dmeas : Measurable d := by dsimp [d]; fun_prop
  have dc : Continuous d := by dsimp [d]; fun_prop
  have dp : MeasurePreserving d η' (η.prod ν) := measurePreserving_init_last ν
  let g : Y × E → ℝ := fun p => G p.1 * F (J p)
  have gm : Measurable g := (hG.comp measurable_fst).mul (hF.comp jmeas)
  have gb : Bornology.IsBounded (Set.range g) := isBounded_range_mul_comp hbG hbF Prod.fst J
  have gc : ∀ᵐ p ∂η.prod ν, ContinuousAt g p := by
    filter_upwards [(Measure.quasiMeasurePreserving_fst (μ := η) (ν := ν)).tendsto_ae cG,
      jp.quasiMeasurePreserving.tendsto_ae cF] with p hp hq
    exact (hp.comp continuous_fst.continuousAt).mul (hq.comp jc.continuousAt)
  have gcD : ∀ᵐ r ∂η', ContinuousAt (g ∘ d) r := by
    filter_upwards [dp.quasiMeasurePreserving.tendsto_ae gc] with t ht
    exact ht.comp dc.continuousAt
  have bcom : Bornology.IsBounded (Set.range (g ∘ d)) :=
    gb.subset (Set.range_comp_subset_range d g)
  have hid (x : ℝ) (r : Fin 40 → ℕ) : ((g ∘ d) (fun j => U x (r j))) =
        (G (fun j => U x (r j.castSucc)) *
          F (fun l => U x (i.insertNth (α := fun _ => ℕ) (r (Fin.last 39)) (Fin.init r) l))) := by
    dsimp only [g, d, J, Function.comp_apply]
    simp only [Fin.init_def, insertNth_comp]
  have h := tendsto_restricted_harmonic_pi_sum (n := 40) Hs ρ κ a hρ hκ ha ha0 haLast
    (fun r : Fin 40 → ℕ => Squarefree (∏ j, r j)) (fun S hS r hr h =>
      exists_shared_prime_of_not_squarefree_prod S hS r hr h)
    (g ∘ d) (gm.comp dmeas) bcom gcD
  apply h.congr'
  exact Filter.Eventually.of_forall (fun x => by
    change ((B x) ^ 40)⁻¹ *
      (∑ t ∈ Fintype.piFinset (fun _ : Fin 40 => Q x), (∏ j, (Nat.totient (t j) : ℝ)⁻¹) *
        (if Squarefree (∏ j, t j) then (g ∘ d) (fun j => U x (t j)) else 0)) = _
    simp only [hid x])

theorem measurable_bounded_ae_continuous_insertNth_product {m n : ℕ}
    (ν : Measure (Fin (m + 1) → ℝ)) [IsFiniteMeasure ν] (i : Fin (n + 1))
    (F F' : (Fin (n + 1) → Fin (m + 1) → ℝ) → ℝ)
    (hF : Measurable F) (hF' : Measurable F')
    (hbF : Bornology.IsBounded (Set.range F)) (hbF' : Bornology.IsBounded (Set.range F'))
    (cF : ∀ᵐ X ∂Measure.pi (fun _ : Fin (n + 1) => ν), ContinuousAt F X)
    (cF' : ∀ᵐ X ∂Measure.pi (fun _ : Fin (n + 1) => ν), ContinuousAt F' X) :
    let g := fun v => F (i.insertNth (v (Fin.last n).castSucc) (Fin.init (Fin.init v))) *
              F' (i.insertNth (v (Fin.last (n + 1))) (Fin.init (Fin.init v)))
    Measurable g ∧ Bornology.IsBounded (Set.range g) ∧
      ∀ᵐ v ∂Measure.pi (fun _ : Fin (n + 1 + 1) => ν), ContinuousAt g v := by
  intro g
  let E := Fin (m + 1) → ℝ
  let Y := Fin n → E
  let η := Measure.pi (fun _ : Fin (n + 1) => ν)
  let η0 := Measure.pi (fun _ : Fin n => ν)
  let J : Y × E → (Fin (n + 1) → E) := fun p => i.insertNth p.2 p.1
  have jmeas : Measurable J := by dsimp [J]; fun_prop
  have jc : Continuous J := by dsimp [J]; fun_prop
  have jp : MeasurePreserving J ((Measure.pi (fun _ : Fin n => ν)).prod ν) η :=
    measurePreserving_insertNth ν i
  let d2 : (Fin (n + 1 + 1) → E) → (Y × E) × E := fun x =>
     ((Fin.init (Fin.init x), x (Fin.last n).castSucc), x (Fin.last (n + 1)))
  have d2m : Measurable d2 := by dsimp [d2]; fun_prop
  have d2c : Continuous d2 := by dsimp [d2]; fun_prop
  have d2p : MeasurePreserving d2 (Measure.pi (fun _ : Fin (n + 1 + 1) => ν))
      ((η0.prod ν).prod ν) := by
    convert ((measurePreserving_init_last (n := n) ν).prod (MeasurePreserving.id ν)).comp
      (measurePreserving_init_last (n := (n + 1)) ν) using 1
    rfl
  let sk : (Y × E) × E → Y × E := fun q => (q.1.1, q.2)
  have skC : Continuous sk := by dsimp [sk]; fun_prop
  have skM : Measurable sk := by dsimp [sk]; fun_prop
  have skp : Measure.QuasiMeasurePreserving sk ((η0.prod ν).prod ν) (η0.prod ν) := by
    convert (MeasureTheory.QuasiMeasurePreserving.prodMap
        (Measure.quasiMeasurePreserving_fst (μ := η0) (ν := ν))
        (Measure.QuasiMeasurePreserving.id ν)) using 1
    rfl
  let pp : (Y × E) × E → ℝ := fun q => F (J q.1) * F' (J (sk q))
  have ppm : Measurable pp := (hF.comp (jmeas.comp measurable_fst)).mul
    (hF'.comp (jmeas.comp skM))
  have ppb := isBounded_range_mul_comp hbF hbF' (J ∘ Prod.fst) (J ∘ sk)
  have mc : ∀ᵐ p ∂η0.prod ν, ContinuousAt (F ∘ J) p := by
    filter_upwards [jp.quasiMeasurePreserving.tendsto_ae cF] with p hp
    exact hp.comp jc.continuousAt
  have mc' : ∀ᵐ p ∂η0.prod ν, ContinuousAt (F' ∘ J) p := by
    filter_upwards [jp.quasiMeasurePreserving.tendsto_ae cF'] with p hp
    exact hp.comp jc.continuousAt
  have cpP : ∀ᵐ r ∂((η0.prod ν).prod ν), ContinuousAt pp r := by
    filter_upwards [(Measure.quasiMeasurePreserving_fst (μ := η0.prod ν) (ν := ν)).tendsto_ae mc,
      skp.tendsto_ae mc'] with p hp hq
    exact (hp.comp continuous_fst.continuousAt).mul (hq.comp skC.continuousAt)
  have hppD : ∀ᵐ r ∂Measure.pi (fun _ : Fin (n + 1 + 1) => ν), ContinuousAt (pp ∘ d2) r := by
    filter_upwards [d2p.quasiMeasurePreserving.tendsto_ae cpP] with t ht
    exact ht.comp d2c.continuousAt
  have bcom : Bornology.IsBounded (Set.range (pp ∘ d2)) :=
    ppb.subset (Set.range_comp_subset_range d2 pp)
  change Measurable (pp ∘ d2) ∧ Bornology.IsBounded (Set.range (pp ∘ d2)) ∧
    ∀ᵐ r ∂Measure.pi (fun _ : Fin (n + 1 + 1) => ν), ContinuousAt (pp ∘ d2) r
  exact ⟨ppm.comp d2m, bcom, hppD⟩

theorem sum_insertNth_product_map_eq {E : Type*} {n : ℕ} (i : Fin (n + 1))
    (F F' : (Fin (n + 1) → E) → ℝ)
    (V : ℕ → E) (Q : Finset ℕ) :
    (∑ r ∈ Fintype.piFinset (fun _ : Fin (n + 1 + 1) => Q), (∏ j, (Nat.totient (r j) : ℝ)⁻¹) *
      (if Squarefree (∏ j : Fin (n + 1), r j.castSucc) ∧
          Squarefree ((∏ j : Fin n, r j.castSucc.castSucc) * r (Fin.last (n + 1))) then
        (F (fun l => V (i.insertNth (α := fun _ => ℕ) (r (Fin.last n).castSucc)
                (Fin.init (Fin.init r)) l)) *
            F' (fun l => V (i.insertNth (α := fun _ => ℕ) (r (Fin.last (n + 1)))
                (Fin.init (Fin.init r)) l))) else 0)) =
    (∑ r ∈ Fintype.piFinset (fun _ : Fin (n + 1 + 1) => Q), (∏ j, (Nat.totient (r j) : ℝ)⁻¹) *
      (if Squarefree (∏ j : Fin (n + 1), r j.castSucc) ∧
          Squarefree ((∏ j : Fin n, r j.castSucc.castSucc) * r (Fin.last (n + 1))) then
        (F (i.insertNth (V (r (Fin.last n).castSucc)) (Fin.init (Fin.init (fun j => V (r j))))) *
            F' (i.insertNth (V (r (Fin.last (n + 1)))) (Fin.init (Fin.init (fun j => V (r j))))))
        else 0)) := by
  simp only [Fin.init_def, insertNth_comp]

theorem tendsto_double_marginal_harmonic_sum {m n : ℕ} (Hs : Finset ℕ) (ρ : ℝ) (hρ : 0 < ρ)
    (i : Fin (n + 1)) (κ : ℝ) (hκ : 0 < κ) (a : Fin (m + 2) → ℝ) (ha : StrictMono a)
    (ha0 : a 0 = 0) (haLast : a (Fin.last (m + 1)) = κ)
    (F F' : (Fin (n + 1) → Fin (m + 1) → ℝ) → ℝ) (hF : Measurable F) (hF' : Measurable F')
    (hbF : Bornology.IsBounded (Set.range F)) (hbF' : Bornology.IsBounded (Set.range F')) :
    let ν : Measure (Fin (m + 1) → ℝ) := ENNReal.ofReal
        (Real.exp Real.eulerMascheroniConstant * κ) •
          Measure.map (fragmentBandMasses a) (fragmentLaw κ)
    (∀ᵐ X ∂Measure.pi (fun _ : Fin (n + 1) => ν), ContinuousAt F X) →
    (∀ᵐ X ∂Measure.pi (fun _ : Fin (n + 1) => ν), ContinuousAt F' X) →
    let W := presievingModulus Hs
    let R := fun x : ℝ => x ^ ρ
    let B := fun x : ℝ => fragmentNormalization (W x) (R x)
    let Q := fun x : ℝ => (∏ p ∈ fragmentPrimes (W x) (R x) κ, p).divisors
    let U := fun x : ℝ => fun s : ℕ =>
      fragmentBandMasses a (primeLogConfiguration (R x) s)
    Tendsto (fun x : ℝ => ((B x) ^ (n + 1 + 1))⁻¹ *
      (∑ v ∈ Fintype.piFinset (fun _ : Fin (n + 1 + 1) => Q x),
        (∏ j, (Nat.totient (v j) : ℝ)⁻¹) *
          (if Squarefree (∏ j : Fin (n + 1), v j.castSucc) ∧
              Squarefree ((∏ j : Fin n, v j.castSucc.castSucc) * v (Fin.last (n + 1))) then
            F (fun l => U x (i.insertNth (α := fun _ => ℕ) (v (Fin.last n).castSucc)
                (Fin.init (Fin.init v)) l)) *
            F' (fun l => U x (i.insertNth (α := fun _ => ℕ) (v (Fin.last (n + 1)))
              (Fin.init (Fin.init v)) l)) else 0))) atTop
        (𝓝 (∫ v, F (i.insertNth (v (Fin.last n).castSucc) (Fin.init (Fin.init v))) *
             F' (i.insertNth (v (Fin.last (n + 1))) (Fin.init (Fin.init v)))
          ∂Measure.pi (fun _ : Fin (n + 1 + 1) => ν))) := by
  intro ν cF cF' W R B Q U
  let : IsProbabilityMeasure (fragmentLaw κ) :=
    fragmentLaw_isProbabilityMeasure κ
  let : IsFiniteMeasure ν := by
    dsimp [ν]
    exact (Measure.map (fragmentBandMasses a)
      (fragmentLaw κ)).smul_finite (by simp)
  let g := fun v : Fin (n + 1 + 1) → Fin (m + 1) → ℝ =>
    F (i.insertNth (v (Fin.last n).castSucc) (Fin.init (Fin.init v))) *
             F' (i.insertNth (v (Fin.last (n + 1))) (Fin.init (Fin.init v)))
  obtain ⟨pm, pb, pcont⟩ := measurable_bounded_ae_continuous_insertNth_product ν i F F' hF hF'
    hbF hbF' cF cF'
  have h := tendsto_restricted_harmonic_pi_sum (n := n + 1 + 1) Hs ρ κ a hρ hκ ha ha0 haLast
    (fun v : Fin (n + 1 + 1) → ℕ => Squarefree (∏ j : Fin (n + 1), v j.castSucc) ∧
      Squarefree ((∏ j : Fin n, v j.castSucc.castSucc) * v (Fin.last (n + 1))))
    exists_shared_prime_of_not_squarefree_overlapping_products
    g pm pb pcont
  refine h.congr' ?_
  exact Filter.Eventually.of_forall (fun x => by
    change (((B x) ^ (n + 1 + 1))⁻¹ * _) = (((B x) ^ (n + 1 + 1))⁻¹ * _)
    congr 1
    exact (sum_insertNth_product_map_eq i F F' (U x) (Q x)).symm)

theorem tendsto_polarized_harmonic_sum
    {m : ℕ} (Hs : Finset ℕ) (ρ : ℝ) (hρ : 0 < ρ) (i : Fin 40) (κ : ℝ) (hκ : 0 < κ)
    (a : Fin (m + 2) → ℝ) (ha : StrictMono a)
    (ha0 : a 0 = 0) (haLast : a (Fin.last (m + 1)) = κ)
    (G G' : (Fin 39 → Fin (m + 1) → ℝ) → ℝ)
    (F F' : (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
    (hG : Measurable G) (hG' : Measurable G')
    (hF : Measurable F) (hF' : Measurable F')
    (hbG : Bornology.IsBounded (Set.range G))
    (hbG' : Bornology.IsBounded (Set.range G'))
    (hbF : Bornology.IsBounded (Set.range F))
    (hbF' : Bornology.IsBounded (Set.range F')) :
    let ν : Measure (Fin (m + 1) → ℝ) := ENNReal.ofReal
        (Real.exp Real.eulerMascheroniConstant * κ) •
          Measure.map (fragmentBandMasses a) (fragmentLaw κ)
    (∀ᵐ X ∂Measure.pi (fun _ : Fin 39 => ν), ContinuousAt G X) →
    (∀ᵐ X ∂Measure.pi (fun _ : Fin 39 => ν), ContinuousAt G' X) →
    (∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => ν), ContinuousAt F X) →
    (∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => ν), ContinuousAt F' X) →
    let W := presievingModulus Hs
    let R := fun x : ℝ => x ^ ρ
    let B := fun x : ℝ => fragmentNormalization (W x) (R x)
    let Q := fun x : ℝ => (∏ p ∈ fragmentPrimes (W x) (R x) κ, p).divisors
    let U := fun x : ℝ => fun s : ℕ =>
      fragmentBandMasses a (primeLogConfiguration (R x) s)
    let HH := fun y => G y + ∫ t, F (i.insertNth t y) ∂ν
    let HH' := fun y => G' y + ∫ t, F' (i.insertNth t y) ∂ν
    Tendsto (fun x : ℝ =>
      ((B x) ^ 39)⁻¹ * (∑ t ∈ Fintype.piFinset (fun _ : Fin 39 => Q x),
        (∏ j, (Nat.totient (t j) : ℝ)⁻¹) *
          (if Squarefree (∏ j, t j) then
            G (fun j => U x (t j)) * G' (fun j => U x (t j)) else 0)) +
      ((B x) ^ 40)⁻¹ * (∑ t ∈ Fintype.piFinset (fun _ : Fin 40 => Q x),
        (∏ j, (Nat.totient (t j) : ℝ)⁻¹) *
          (if Squarefree (∏ j, t j) then
            G (fun j => U x (t j.castSucc)) *
            F' (fun l => U x (i.insertNth (α := fun _ => ℕ) (t (Fin.last 39))
              (Fin.init t) l)) else 0)) +
      ((B x) ^ 40)⁻¹ * (∑ t ∈ Fintype.piFinset (fun _ : Fin 40 => Q x),
        (∏ j, (Nat.totient (t j) : ℝ)⁻¹) *
          (if Squarefree (∏ j, t j) then
            G' (fun j => U x (t j.castSucc)) *
              F (fun l => U x (i.insertNth (α := fun _ => ℕ) (t (Fin.last 39))
                (Fin.init t) l)) else 0)) +
      ((B x) ^ 41)⁻¹ * (∑ v ∈ Fintype.piFinset (fun _ : Fin 41 => Q x),
        (∏ j, (Nat.totient (v j) : ℝ)⁻¹) *
          (if Squarefree (∏ j : Fin 40, v j.castSucc) ∧
              Squarefree ((∏ j : Fin 39, v j.castSucc.castSucc) * v (Fin.last 40)) then
            F (fun l => U x (i.insertNth (α := fun _ => ℕ) (v (Fin.last 39).castSucc)
                (Fin.init (Fin.init v)) l)) *
            F' (fun l => U x (i.insertNth (α := fun _ => ℕ) (v (Fin.last 40))
              (Fin.init (Fin.init v)) l)) else 0))) atTop
      (𝓝 (∫ y, HH y * HH' y ∂Measure.pi (fun _ : Fin 39 => ν))) := by
  classical
  intro ν cG cG' cF cF' W R B Q U HH HH'
  let : IsProbabilityMeasure (fragmentLaw κ) :=
    fragmentLaw_isProbabilityMeasure κ
  let : IsFiniteMeasure ν := by
    dsimp [ν]
    exact (Measure.map (fragmentBandMasses a)
      (fragmentLaw κ)).smul_finite (by simp)
  have cc : ∀ᵐ t ∂Measure.pi (fun _ : Fin 39 => ν), ContinuousAt (fun y => G y * G' y) t := by
    filter_upwards [cG, cG'] with t ht ht'
    exact ht.mul ht'
  have cb := isBounded_range_mul_comp hbG hbG' id id
  have h0 := tendsto_restricted_harmonic_pi_sum (n := 39) Hs ρ κ a hρ hκ ha ha0 haLast
    (fun r : Fin 39 → ℕ => Squarefree (∏ j, r j)) (fun S hS r hr h =>
      exists_shared_prime_of_not_squarefree_prod S hS r hr h)
    (fun y => G y * G' y) (hG.mul hG') cb cc
  have h1 := tendsto_mixed_harmonic_sum Hs ρ hρ i κ hκ a ha ha0 haLast G F' hG hF' hbG hbF' cG cF'
  have h2 := tendsto_mixed_harmonic_sum Hs ρ hρ i κ hκ a ha ha0 haLast G' F hG' hF hbG' hbF cG' cF
  have h3 := tendsto_double_marginal_harmonic_sum (n := 39) Hs ρ hρ i
    κ hκ a ha ha0 haLast F F' hF hF' hbF hbF' cF cF'
  have contr := integral_pi_product_of_sums_with_marginals ν i G G' F F'
    hG hG' hF hF' hbG hbG' hbF hbF'
  rw [contr]
  exact ((h0.add h1).add h2).add h3

open Classical in
theorem canonical_and_erased_polarized_harmonic_tendsto
    {𝓗 : Finset ℕ}
    {m : ℕ} (i : Fin 40) (κ : ℝ) (hκ : 0 < κ)
    (a : Fin (m + 2) → ℝ) (ha : StrictMono a)
    (ha0 : a 0 = 0) (haLast : a (Fin.last (m + 1)) = κ)
    (G G' : (Fin 39 → Fin (m + 1) → ℝ) → ℝ)
    (F F' : (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
    (hG : Measurable G) (hG' : Measurable G')
    (hF : Measurable F) (hF' : Measurable F')
    (hbG : Bornology.IsBounded (Set.range G))
    (hbG' : Bornology.IsBounded (Set.range G'))
    (hbF : Bornology.IsBounded (Set.range F))
    (hbF' : Bornology.IsBounded (Set.range F')) :
    let ν : Measure (Fin (m + 1) → ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        Measure.map (fragmentBandMasses a)
          (fragmentLaw κ)
    (∀ᵐ X ∂Measure.pi (fun _ : Fin 39 => ν), ContinuousAt G X) →
    (∀ᵐ X ∂Measure.pi (fun _ : Fin 39 => ν), ContinuousAt G' X) →
    (∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => ν), ContinuousAt F X) →
    (∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => ν), ContinuousAt F' X) →
    let ρ : ℝ := 2624989 / 10000000
    let W : ℝ → ℕ := presievingModulus 𝓗
    let R : ℝ → ℝ := fun x => x ^ ρ
    let B : ℝ → ℝ := fun x => fragmentNormalization (W x) (R x)
    let q : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) (R x) κ, p
    let T39 : ℝ → Finset (Fin 39 → ℕ) := fun x =>
      (Fintype.piFinset (fun _ : Fin 39 => (q x).divisors)).filter
        (fun r => Squarefree (∏ j, r j))
    let T40 : ℝ → Finset (Fin 40 → ℕ) := fun x =>
      (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
        (fun r => Squarefree (∏ j, r j))
    let X : ℝ → ℕ → Fin (m + 1) → ℝ := fun x s =>
      fragmentBandMasses a
        (primeLogConfiguration (R x) s)
    let w : ((Fin 39 → Fin (m + 1) → ℝ) → ℝ) →
        ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun K x =>
      ∑ r ∈ T39 x, Finsupp.single r (K (fun j => X x (r j)) / B x ^ 39)
    let y : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) →
        ℝ → ((Fin 40 → ℕ) →₀ ℝ) := fun K x =>
      ∑ r ∈ T40 x, Finsupp.single r (K (fun j => X x (r j)) / B x ^ 40)
    let erase : ((Fin 40 → ℕ) →₀ ℝ) → ((Fin 39 → ℕ) →₀ ℝ) := fun v =>
      v.sum (fun r vr => Finsupp.single (fun j => r (i.succAbove j))
        (vr / ((r i).totient : ℝ)))
    let z : ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun x => w G x + erase (y F x)
    let z' : ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun x => w G' x + erase (y F' x)
    let H : (Fin 39 → Fin (m + 1) → ℝ) → ℝ := fun Y =>
      G Y + ∫ t : Fin (m + 1) → ℝ, F (i.insertNth t Y) ∂ν
    let H' : (Fin 39 → Fin (m + 1) → ℝ) → ℝ := fun Y =>
      G' Y + ∫ t : Fin (m + 1) → ℝ, F' (i.insertNth t Y) ∂ν
    Filter.Tendsto
      (fun x : ℝ => B x ^ 39 *
        (z x).sum (fun r zr => zr * z' x r / (∏ j, ((r j).totient : ℝ))))
      Filter.atTop
      (nhds (∫ Y : Fin 39 → Fin (m + 1) → ℝ, H Y * H' Y
        ∂Measure.pi (fun _ : Fin 39 => ν))) := by
  intro ν cG cG' cF cF' ρ W R B q Ta Tb X w y erase z z' H H'
  have hρ : 0 < ρ := by norm_num [ρ]
  have hlim := tendsto_polarized_harmonic_sum 𝓗 ρ hρ i κ hκ a ha ha0 haLast
      G G' F F' hG hG' hF hF' hbG hbG' hbF hbF' cG cG' cF cF'
  apply hlim.congr'
  filter_upwards [(tendsto_rpow_atTop hρ).eventually_gt_atTop 1] with x hx
  have hB : B x ≠ 0 := (fragmentNormalization_pos 𝓗 x (R x) hx).ne'
  exact (polarized_harmonic_sum_expansion i (q x).divisors (B x) hB (X x) G G' F F').symm

end

open Classical in
theorem selberg_divisor_root_abs_le_primeFactor_power
    {ι : Type*} [Fintype ι] (y : (ι → ℕ) →₀ ℝ)
    (D : Finset (ι → ℕ)) (v : ι → ℕ) (hv : ∀ i, v i ≠ 0)
    (K : ℝ) (hK : 0 ≤ K)
    (hbound : ∀ d ∈ D,
      |selbergCoefficient y d| ≤
        K * ((∏ i, d i : ℕ) : ℝ) / ((∏ i, d i : ℕ).totient : ℝ)) :
    |∑ d ∈ D, if ∀ i, d i ∣ v i then selbergCoefficient y d else 0| ≤
      K * ((2 : ℝ) ^ (∏ i, v i : ℕ).primeFactors.card) ^ (Fintype.card ι + 1) := by
  let N := ∏ i, v i
  let S := N.divisors.filter Squarefree
  let T := D.filter (fun d => (∀ i, d i ∣ v i) ∧ Squarefree (∏ i, d i))
  have hN : N ≠ 0 := Finset.prod_ne_zero_iff.mpr (fun i _ => hv i)
  have hcardS : (S.card : ℝ) = (2 : ℝ) ^ N.primeFactors.card := by
    simpa [S, Nat.factors_eq] using
      (Nat.sum_divisors_filter_squarefree hN (f := fun _ => (1 : ℝ)))
  have htuple : T ⊆ Fintype.piFinset (fun _ : ι => S) := by
    intro d hd
    obtain ⟨_, hdiv, hsq⟩ := Finset.mem_filter.mp hd
    apply Fintype.mem_piFinset.mpr
    intro i
    have hdi : d i ∣ ∏ j, d j := Finset.dvd_prod_of_mem d (Finset.mem_univ i)
    exact Finset.mem_filter.mpr
      ⟨Nat.mem_divisors.mpr
        ⟨(hdiv i).trans (Finset.dvd_prod_of_mem v (Finset.mem_univ i)), hN⟩,
        Squarefree.squarefree_of_dvd hdi hsq⟩
  have hcardT : (T.card : ℝ) ≤ (S.card : ℝ) ^ Fintype.card ι := by
    have hc := Finset.card_le_card htuple
    simpa using (Nat.cast_le.mpr hc : (T.card : ℝ) ≤ _)
  have hcoeff : ∀ d ∈ T, |selbergCoefficient y d| ≤ K * (S.card : ℝ) := by
    intro d hd
    obtain ⟨hdD, hdiv, hsq⟩ := Finset.mem_filter.mp hd
    have hprod : (∏ i, d i) ∣ N :=
      Finset.prod_dvd_prod_of_dvd _ _ (fun i _ => hdiv i)
    have hsubset : (∏ i, d i : ℕ).divisors ⊆ S := by
      simpa only [S, Nat.divisors_filter_squarefree_of_squarefree hsq] using
        (Finset.filter_subset_filter Squarefree (Nat.divisors_subset_of_dvd hN hprod))
    calc
      |selbergCoefficient y d| ≤
          K * (((∏ i, d i : ℕ) : ℝ) / ((∏ i, d i : ℕ).totient : ℝ)) := by
        simpa only [mul_div_assoc] using hbound d hdD
      _ ≤ K * (((∏ i, d i : ℕ).divisors.card : ℕ) : ℝ) :=
        mul_le_mul_of_nonneg_left
          (div_totient_le_card_divisors _) hK
      _ ≤ K * (S.card : ℝ) :=
        mul_le_mul_of_nonneg_left (Nat.cast_le.mpr (Finset.card_le_card hsubset)) hK
  have hroot : (∑ d ∈ D, if ∀ i, d i ∣ v i then selbergCoefficient y d else 0) =
      ∑ d ∈ T, selbergCoefficient y d := by
    rw [Finset.sum_filter]
    apply Finset.sum_congr rfl
    intro d _
    by_cases hs : Squarefree (∏ i, d i)
    · simp [hs]
    · simp [hs, selbergCoefficient,
        ArithmeticFunction.moebius_eq_zero_of_not_squarefree hs]
  calc
    |∑ d ∈ D, if ∀ i, d i ∣ v i then selbergCoefficient y d else 0| =
        |∑ d ∈ T, selbergCoefficient y d| := congrArg abs hroot
    _ ≤ (T.card : ℝ) * (K * (S.card : ℝ)) := by
      simpa [Real.norm_eq_abs] using (norm_sum_le_of_le T (f := selbergCoefficient y) hcoeff)
    _ ≤ (S.card : ℝ) ^ Fintype.card ι * (K * (S.card : ℝ)) :=
      mul_le_mul_of_nonneg_right hcardT (mul_nonneg hK (Nat.cast_nonneg _))
    _ = K * ((2 : ℝ) ^ N.primeFactors.card) ^ (Fintype.card ι + 1) := by
      rw [pow_succ, hcardS]
      ring

open Classical in
theorem selberg_divisor_root_uniform_subpower
    {ι : Type*} [Fintype ι] (h : ι → ℕ)
    (K ε : ℝ) (hK : 0 ≤ K) (hε : 0 < ε) :
    ∃ C : ℝ, 0 < C ∧ ∀ᶠ x : ℝ in Filter.atTop,
      ∀ (y : (ι → ℕ) →₀ ℝ) (D : Finset (ι → ℕ)) (n : ℕ),
        n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊ →
        (∀ d ∈ D,
          |selbergCoefficient y d| ≤
            K * ((∏ i, d i : ℕ) : ℝ) / ((∏ i, d i : ℕ).totient : ℝ)) →
        |∑ d ∈ D, if ∀ i, d i ∣ n + h i then selbergCoefficient y d else 0| ≤
          C * x ^ ε := by
  let η : ℝ := ε / ((Fintype.card ι : ℝ) + 1)
  have hη : 0 < η := div_pos hε (by positivity)
  obtain ⟨C, hC, hCbound⟩ := exists_primeFactors_power_bound
    (a := (2 : ℝ) ^ (Fintype.card ι + 1)) (one_le_pow₀ (by norm_num)) hη
  let t : ℝ := (Fintype.card ι : ℝ) * η
  have ht : t ≤ ε := by
    dsimp [t, η]
    rw [← mul_div_assoc]
    apply (div_le_iff₀ (by positivity)).mpr
    nlinarith
  refine ⟨(K + 1) * C * (3 : ℝ) ^ t, by positivity, ?_⟩
  filter_upwards [Filter.eventually_ge_atTop
    (max (1 : ℝ) ((Finset.univ.sup h : ℕ) : ℝ))] with x hx
  intro y D n hn hbound
  have hx1 : 1 ≤ x := (le_max_left _ _).trans hx
  have hx0 : 0 < x := lt_of_lt_of_le zero_lt_one hx1
  have hnx : x ≤ (n : ℝ) := Nat.le_of_ceil_le (Finset.mem_Icc.mp hn).1
  have hnx2 : (n : ℝ) ≤ 2 * x :=
    (Nat.le_floor_iff (by positivity)).mp (Finset.mem_Icc.mp hn).2
  have hshift : ∀ i, (h i : ℝ) ≤ x := by
    intro i
    exact (Nat.cast_le.mpr (Finset.le_sup (Finset.mem_univ i))).trans
      ((le_max_right _ _).trans hx)
  let v : ι → ℕ := fun i => n + h i
  have hv : ∀ i, v i ≠ 0 := by
    intro i
    have hn0 : 0 < n := Nat.cast_pos.mp (hx0.trans_le hnx)
    exact (Nat.add_pos_left hn0 _).ne'
  have hvmax : ∀ i, (v i : ℝ) ≤ 3 * x := by
    intro i
    dsimp [v]
    push_cast
    linarith [hshift i]
  let N := ∏ i, v i
  have hN : N ≠ 0 := Finset.prod_ne_zero_iff.mpr (fun i _ => hv i)
  have hprod : (N : ℝ) ≤ (3 * x) ^ Fintype.card ι := by
    calc
      (N : ℝ) = ∏ i, (v i : ℝ) := by simp [N]
      _ ≤ ∏ _i : ι, 3 * x :=
        Finset.prod_le_prod (fun i _ => Nat.cast_nonneg _) (fun i _ => hvmax i)
      _ = _ := by simp
  have hpw := Real.rpow_le_rpow (Nat.cast_nonneg N) hprod hη.le
  rw [← Real.rpow_natCast_mul (by positivity) (Fintype.card ι) η,
    Real.mul_rpow (by norm_num : (0 : ℝ) ≤ 3) hx0.le] at hpw
  have hpw' : (N : ℝ) ^ η ≤ (3 : ℝ) ^ t * x ^ ε :=
    hpw.trans (mul_le_mul_of_nonneg_left
      (Real.rpow_le_rpow_of_exponent_le hx1 ht) (by positivity))
  calc
    |∑ d ∈ D, if ∀ i, d i ∣ n + h i then selbergCoefficient y d else 0| ≤
        K * ((2 : ℝ) ^ N.primeFactors.card) ^ (Fintype.card ι + 1) :=
      selberg_divisor_root_abs_le_primeFactor_power y D v hv K hK hbound
    _ ≤ K * (C * (N : ℝ) ^ η) := by
      rw [pow_right_comm]
      exact mul_le_mul_of_nonneg_left (hCbound N hN) hK
    _ ≤ K * (C * ((3 : ℝ) ^ t * x ^ ε)) :=
      mul_le_mul_of_nonneg_left (mul_le_mul_of_nonneg_left hpw' hC.le) hK
    _ = K * (C * (3 : ℝ) ^ t * x ^ ε) := by ring
    _ ≤ (K + 1) * (C * (3 : ℝ) ^ t * x ^ ε) :=
      mul_le_mul_of_nonneg_right (by linarith) (by positivity)
    _ = ((K + 1) * C * (3 : ℝ) ^ t) * x ^ ε := by ring

theorem weighted_primePower_error_le {S : Finset ℕ} {X : ℝ}
    {w : ℕ → ℝ} {M : ℝ} (hM : 0 ≤ M)
    (hS : S ⊆ Finset.Ioc 0 ⌊X⌋₊) (hw : ∀ n ∈ S, |w n| ≤ M) :
    |∑ n ∈ S, (ArithmeticFunction.vonMangoldt n -
        (if Nat.Prime n then Real.log (n : ℝ) else 0)) * w n| ≤
      M * (Chebyshev.psi X - Chebyshev.theta X) := by
  classical
  have heq : (∑ n ∈ S, (ArithmeticFunction.vonMangoldt n -
      (if Nat.Prime n then Real.log (n : ℝ) else 0)) * w n) =
      ∑ n ∈ S.filter (fun n => ¬Nat.Prime n), ArithmeticFunction.vonMangoldt n * w n := by
    rw [Finset.sum_filter]
    apply Finset.sum_congr rfl
    intro n _
    by_cases hp : Nat.Prime n
    · simp [hp, ArithmeticFunction.vonMangoldt_apply_prime hp]
    · simp [hp]
  rw [heq]
  calc
    |∑ n ∈ S.filter (fun n => ¬Nat.Prime n), ArithmeticFunction.vonMangoldt n * w n| ≤
        ∑ n ∈ S.filter (fun n => ¬Nat.Prime n),
          |ArithmeticFunction.vonMangoldt n * w n| := Finset.abs_sum_le_sum_abs _ _
    _ ≤ ∑ n ∈ S.filter (fun n => ¬Nat.Prime n), ArithmeticFunction.vonMangoldt n * M := by
      apply Finset.sum_le_sum
      intro n hn
      rw [abs_mul, abs_of_nonneg ArithmeticFunction.vonMangoldt_nonneg]
      exact mul_le_mul_of_nonneg_left (hw n (Finset.mem_filter.mp hn).1)
        ArithmeticFunction.vonMangoldt_nonneg
    _ = M * ∑ n ∈ S.filter (fun n => ¬Nat.Prime n),
        ArithmeticFunction.vonMangoldt n := by
      rw [← Finset.sum_mul, mul_comm]
    _ ≤ M * ∑ n ∈ (Finset.Ioc 0 ⌊X⌋₊).filter (fun n => ¬Nat.Prime n),
        ArithmeticFunction.vonMangoldt n := by
      apply mul_le_mul_of_nonneg_left _ hM
      apply Finset.sum_le_sum_of_subset_of_nonneg
      · exact Finset.filter_subset_filter _ hS
      · intro n _ _
        exact ArithmeticFunction.vonMangoldt_nonneg
    _ = M * (Chebyshev.psi X - Chebyshev.theta X) := by
      rw [Chebyshev.psi_sub_theta_eq_sum_not_prime]

open Classical in
theorem selberg_mixed_primePower_correction_uniform_log_saving
    {k : ℕ} (h : Fin (k + 1) → ℕ) (i : Fin (k + 1))
    (K₁ K₂ A : ℝ) (hK₁ : 0 ≤ K₁) (hK₂ : 0 ≤ K₂) :
    ∀ ε : ℝ, 0 < ε → ∀ᶠ x : ℝ in Filter.atTop,
      ∀ (y : (Fin (k + 1) → ℕ) →₀ ℝ) (z : (Fin k → ℕ) →₀ ℝ)
        (D : Finset (Fin (k + 1) → ℕ)) (E : Finset (Fin k → ℕ))
        (W v : ℕ),
        (∀ d ∈ D,
          |selbergCoefficient y d| ≤
            K₁ * ((∏ j, d j : ℕ) : ℝ) / ((∏ j, d j : ℕ).totient : ℝ)) →
        (∀ e ∈ E,
          |selbergCoefficient z e| ≤
            K₂ * ((∏ j, e j : ℕ) : ℝ) / ((∏ j, e j : ℕ).totient : ℝ)) →
        let I := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
        let Dface := D.filter (fun d => d i = 1)
        let outerRoot : ℕ → ℝ := fun n =>
          ∑ d ∈ D, if ∀ j, d j ∣ n + h j then selbergCoefficient y d else 0
        let faceRoot : ℕ → ℝ := fun n =>
          ∑ d ∈ Dface,
            if ∀ j : Fin k, d (i.succAbove j) ∣ n + h (i.succAbove j)
            then selbergCoefficient y d else 0
        let innerRoot : ℕ → ℝ := fun n =>
          ∑ e ∈ E, if ∀ j, e j ∣ n + h (i.succAbove j)
            then selbergCoefficient z e else 0
        (Real.log x) ^ A / x *
          |∑ n ∈ I, if Nat.ModEq W n v then
            (ArithmeticFunction.vonMangoldt (n + h i) -
              (if Nat.Prime (n + h i) then Real.log ((n + h i : ℕ) : ℝ) else 0)) *
              (outerRoot n - faceRoot n) * innerRoot n else 0| ≤ ε := by
  intro ε hε
  obtain ⟨C₁, hC₁, hroot₁⟩ :=
    selberg_divisor_root_uniform_subpower h K₁ (1 / 8) hK₁ (by norm_num)
  obtain ⟨C₂, hC₂, hroot₂⟩ :=
    selberg_divisor_root_uniform_subpower (fun j => h (i.succAbove j))
      K₂ (1 / 8) hK₂ (by norm_num)
  obtain ⟨C₀, hC₀⟩ := Chebyshev.psi_sub_theta_le_mul_sqrt
  let C := max C₀ 0
  have hC : 0 ≤ C := le_max_right _ _
  let M := 2 * C₁ * C₂
  have hM : 0 ≤ M := by positivity
  let B := M * C * Real.sqrt 3
  have hB : 0 ≤ B := by positivity
  have hlog := (isLittleO_log_rpow_rpow_atTop A (by norm_num : (0 : ℝ) < 1 / 4)).def
    (div_pos hε (by positivity : 0 < B + 1))
  filter_upwards [hroot₁, hroot₂, Filter.eventually_ge_atTop (max (2 : ℝ) (h i : ℝ)),
    hlog] with x hx₁ hx₂ hx hxlog
  intro y z D E W v hy hz
  let I := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
  let Dface := D.filter (fun d => d i = 1)
  let U : ℕ → ℝ := fun n =>
    ∑ d ∈ D, if ∀ j, d j ∣ n + h j then selbergCoefficient y d else 0
  let V : ℕ → ℝ := fun n =>
    ∑ d ∈ Dface, if ∀ j : Fin k, d (i.succAbove j) ∣ n + h (i.succAbove j)
      then selbergCoefficient y d else 0
  let T : ℕ → ℝ := fun n =>
    ∑ e ∈ E, if ∀ j, e j ∣ n + h (i.succAbove j) then selbergCoefficient z e else 0
  let w : ℕ → ℝ := fun n => if Nat.ModEq W n v then (U n - V n) * T n else 0
  have hx2 : 2 ≤ x := (le_max_left _ _).trans hx
  have hx0 : 0 < x := by linarith
  have hx1 : 1 ≤ x := by linarith
  have hshift : (h i : ℝ) ≤ x := (le_max_right _ _).trans hx
  have hface : ∀ n, V n =
      ∑ d ∈ Dface, if ∀ j, d j ∣ n + h j then selbergCoefficient y d else 0 := by
    intro n
    apply Finset.sum_congr rfl
    intro d hd
    have hdi := (Finset.mem_filter.mp hd).2
    simp only [Fin.forall_iff_succAbove i, hdi, one_dvd, true_and]
  have hw : ∀ n ∈ I, |w n| ≤ M * x ^ (1 / 4 : ℝ) := by
    intro n hn
    have hu : |U n| ≤ C₁ * x ^ (1 / 8 : ℝ) := by
      convert hx₁ y D n hn hy using 1
      congr 1
      exact Finset.sum_congr rfl (fun _ _ => (ite_eq_ite _ _ _).mpr True.intro)
    have hv : |V n| ≤ C₁ * x ^ (1 / 8 : ℝ) := by
      rw [hface]
      convert hx₁ y Dface n hn (fun d hd => hy d (Finset.mem_filter.mp hd).1) using 1
      congr 1
      exact Finset.sum_congr rfl (fun _ _ => (ite_eq_ite _ _ _).mpr True.intro)
    have ht : |T n| ≤ C₂ * x ^ (1 / 8 : ℝ) := by
      convert hx₂ z E n hn hz using 1
      congr 1
      exact Finset.sum_congr rfl (fun _ _ => (ite_eq_ite _ _ _).mpr True.intro)
    have huv : |U n - V n| ≤ 2 * C₁ * x ^ (1 / 8 : ℝ) := by
      linarith [abs_sub (U n) (V n)]
    dsimp only [w]
    split_ifs
    · rw [abs_mul]
      calc
        |U n - V n| * |T n| ≤
            (2 * C₁ * x ^ (1 / 8 : ℝ)) * (C₂ * x ^ (1 / 8 : ℝ)) :=
          mul_le_mul huv ht (abs_nonneg _) (by positivity)
        _ = M * (x ^ (1 / 8 : ℝ) * x ^ (1 / 8 : ℝ)) := by dsimp [M]; ring
        _ = M * x ^ (1 / 4 : ℝ) := by rw [← Real.rpow_add hx0]; norm_num
    · simpa using mul_nonneg hM (Real.rpow_nonneg hx0.le (1 / 4))
  let S := I.image (fun n => n + h i)
  have hS : S ⊆ Finset.Ioc 0 ⌊3 * x⌋₊ := by
    intro m hm
    obtain ⟨n, hn, rfl⟩ := Finset.mem_image.mp hm
    have hnlo : x ≤ (n : ℝ) := Nat.le_of_ceil_le (Finset.mem_Icc.mp hn).1
    have hnhi : (n : ℝ) ≤ 2 * x :=
      (Nat.le_floor_iff (by positivity)).mp (Finset.mem_Icc.mp hn).2
    apply Finset.mem_Ioc.mpr
    constructor
    · exact Nat.add_pos_left (Nat.cast_pos.mp (hx0.trans_le hnlo)) _
    · apply Nat.le_floor
      push_cast
      linarith
  have hwS : ∀ m ∈ S, |w (m - h i)| ≤ M * x ^ (1 / 4 : ℝ) := by
    intro m hm
    obtain ⟨n, hn, rfl⟩ := Finset.mem_image.mp hm
    simpa only [Nat.add_sub_cancel] using hw n hn
  have hsum : (∑ n ∈ I, if Nat.ModEq W n v then
      (ArithmeticFunction.vonMangoldt (n + h i) -
        (if Nat.Prime (n + h i) then Real.log ((n + h i : ℕ) : ℝ) else 0)) *
        (U n - V n) * T n else 0) =
      ∑ m ∈ S, (ArithmeticFunction.vonMangoldt m -
        (if Nat.Prime m then Real.log (m : ℝ) else 0)) * w (m - h i) := by
    dsimp only [S]
    rw [Finset.sum_image]
    · apply Finset.sum_congr rfl
      intro n _
      simp only [Nat.add_sub_cancel, w, mul_ite, mul_zero, mul_assoc]
    · intro a _ b _ hab
      exact Nat.add_right_cancel hab
  have herr := weighted_primePower_error_le
    (mul_nonneg hM (Real.rpow_nonneg hx0.le (1 / 4))) hS hwS
  have hcheb : Chebyshev.psi (3 * x) - Chebyshev.theta (3 * x) ≤
      C * Real.sqrt (3 * x) :=
    (hC₀ (3 * x)).trans (mul_le_mul_of_nonneg_right
      (le_max_left _ _) (Real.sqrt_nonneg _))
  have herr' : |∑ m ∈ S, (ArithmeticFunction.vonMangoldt m -
      (if Nat.Prime m then Real.log (m : ℝ) else 0)) * w (m - h i)| ≤
      B * x ^ (3 / 4 : ℝ) := by
    calc
      _ ≤ (M * x ^ (1 / 4 : ℝ)) * (C * Real.sqrt (3 * x)) :=
        herr.trans (mul_le_mul_of_nonneg_left hcheb (by positivity))
      _ = B * (x ^ (1 / 4 : ℝ) * x ^ (1 / 2 : ℝ)) := by
        rw [Real.sqrt_mul (by norm_num : (0 : ℝ) ≤ 3), Real.sqrt_eq_rpow x]
        dsimp [B]
        ring
      _ = B * x ^ (3 / 4 : ℝ) := by rw [← Real.rpow_add hx0]; norm_num
  have hlog0 : 0 ≤ (Real.log x) ^ A :=
    Real.rpow_nonneg (Real.log_nonneg hx1) _
  have hlogbound : (Real.log x) ^ A ≤ ε / (B + 1) * x ^ (1 / 4 : ℝ) := by
    simpa only [Real.norm_eq_abs, abs_of_nonneg hlog0,
      abs_of_nonneg (Real.rpow_nonneg hx0.le (1 / 4))] using hxlog
  have hscale : ε / (B + 1) * B ≤ ε := by
    rw [div_mul_eq_mul_div]
    apply (div_le_iff₀ (by positivity : 0 < B + 1)).mpr
    nlinarith
  change (Real.log x) ^ A / x * |∑ n ∈ I, if Nat.ModEq W n v then
    (ArithmeticFunction.vonMangoldt (n + h i) -
      (if Nat.Prime (n + h i) then Real.log ((n + h i : ℕ) : ℝ) else 0)) *
      (U n - V n) * T n else 0| ≤ ε
  rw [hsum, div_mul_eq_mul_div]
  apply (div_le_iff₀ hx0).mpr
  calc
    _ ≤ (ε / (B + 1) * x ^ (1 / 4 : ℝ)) * (B * x ^ (3 / 4 : ℝ)) :=
      mul_le_mul hlogbound herr' (abs_nonneg _) (by positivity)
    _ = (ε / (B + 1) * B) * (x ^ (1 / 4 : ℝ) * x ^ (3 / 4 : ℝ)) := by ring
    _ = (ε / (B + 1) * B) * x := by rw [← Real.rpow_add hx0]; norm_num
    _ ≤ ε * x := mul_le_mul_of_nonneg_right hscale hx0.le

open Real Finset Filter Asymptotics Topology
open ArithmeticFunction hiding log

theorem selbergCoefficient_abs_le_totient_ratio
    {ι : Type*} [Fintype ι] (Q : ℕ) (hQ : Squarefree Q)
    (y : (ι → ℕ) →₀ ℝ) (B : ℝ) (hB : 0 ≤ B)
    (hy : ∀ r ∈ y.support,
      Squarefree (∏ j, r j) ∧ ∀ j, r j ∣ Q)
    (hbound : ∀ r, |y r| ≤ B) (d : ι → ℕ) :
    let D : ℕ := ∏ j, d j
    |selbergCoefficient y d| ≤
      B * ((D : ℝ) / (D.totient : ℝ)) *
        (∑ r ∈ Q.divisors, (r.totient : ℝ)⁻¹) ^ Fintype.card ι := by
  classical
  intro D
  by_cases hD : Squarefree D
  · let S := y.support.filter (fun r => ∀ j, d j ∣ r j)
    let U := Fintype.piFinset (fun _ : ι => Q.divisors)
    let q : (ι → ℕ) → ι → ℕ := fun r j => r j / d j
    have hphiD : (D.totient : ℝ) = ∏ j, ((d j).totient : ℝ) := by
      have h := ArithmeticFunction.IsMultiplicative.map_prod d
        (f := (⟨Nat.totient, Nat.totient_zero⟩ : ArithmeticFunction ℕ))
        ⟨Nat.totient_one, fun {m n} hc => Nat.totient_mul hc⟩ Finset.univ
        (fun i _ j _ hij => coprime_of_squarefree_fintype_prod d hD hij)
      exact_mod_cast h
    have hsplit (r : ι → ℕ) (hr : r ∈ S) :
        (∏ j, ((r j).totient : ℝ)) =
          (D.totient : ℝ) * ∏ j, ((q r j).totient : ℝ) := by
      have hrs := (Finset.mem_filter.mp hr).1
      have hdr := (Finset.mem_filter.mp hr).2
      calc
        (∏ j, ((r j).totient : ℝ)) =
            ∏ j, (((d j).totient : ℝ) * ((q r j).totient : ℝ)) := by
          apply Finset.prod_congr rfl
          intro j _
          have hrec : d j * q r j = r j := Nat.mul_div_cancel' (hdr j)
          have hrj : Squarefree (r j) :=
            (hy r hrs).1.squarefree_of_dvd (Finset.dvd_prod_of_mem r (Finset.mem_univ j))
          have hc : Nat.Coprime (d j) (q r j) := by
            apply Nat.coprime_of_squarefree_mul
            rwa [hrec]
          exact_mod_cast
            (congrArg Nat.totient hrec).symm.trans (Nat.totient_mul hc)
        _ = (D.totient : ℝ) * ∏ j, ((q r j).totient : ℝ) := by
          rw [Finset.prod_mul_distrib, ← hphiD]
    have hq : Set.InjOn q (S : Set (ι → ℕ)) := by
      intro r hr s hs hrs
      funext j
      calc
        r j = d j * q r j :=
          (Nat.mul_div_cancel' ((Finset.mem_filter.mp hr).2 j)).symm
        _ = d j * q s j := by rw [hrs]
        _ = s j := Nat.mul_div_cancel' ((Finset.mem_filter.mp hs).2 j)
    have hqU : S.image q ⊆ U := Finset.image_subset_iff.mpr fun r hr => by
      apply Fintype.mem_piFinset.mpr
      intro j
      exact Nat.mem_divisors.mpr
        ⟨(Nat.div_dvd_of_dvd ((Finset.mem_filter.mp hr).2 j)).trans
          ((hy r (Finset.mem_filter.mp hr).1).2 j), hQ.ne_zero⟩
    have hweight :
        (∑ r ∈ S, ∏ j, ((q r j).totient : ℝ)⁻¹) ≤
          ∑ s ∈ U, ∏ j, ((s j).totient : ℝ)⁻¹ := by
      apply Finset.sum_le_sum_of_injOn q hq hqU
      · intro r _
        exact le_rfl
      · intro s _ _
        exact Finset.prod_nonneg fun j _ => inv_nonneg.mpr (Nat.cast_nonneg _)
    have hbox :
        (∑ s ∈ U, ∏ j, ((s j).totient : ℝ)⁻¹) =
          (∑ r ∈ Q.divisors, (r.totient : ℝ)⁻¹) ^ Fintype.card ι := by
      simpa [U] using (Finset.sum_prod_piFinset Q.divisors
        (fun (_ : ι) (r : ℕ) => (r.totient : ℝ)⁻¹))
    have hsum :
        y.sum (fun r yr =>
          if ∀ j, d j ∣ r j then yr / (∏ j, ((r j).totient : ℝ)) else 0) =
          ∑ r ∈ S, y r / (∏ j, ((r j).totient : ℝ)) := by
      simp only [S, Finset.sum_filter, Finsupp.sum]
    have hinner :
        |∑ r ∈ S, y r / (∏ j, ((r j).totient : ℝ))| ≤
          (B / (D.totient : ℝ)) *
            (∑ r ∈ Q.divisors, (r.totient : ℝ)⁻¹) ^ Fintype.card ι := by
      calc
        |∑ r ∈ S, y r / (∏ j, ((r j).totient : ℝ))| ≤
            ∑ r ∈ S, |y r / (∏ j, ((r j).totient : ℝ))| :=
          Finset.abs_sum_le_sum_abs _ _
        _ ≤ ∑ r ∈ S,
            (B / (D.totient : ℝ)) * ∏ j, ((q r j).totient : ℝ)⁻¹ := by
          apply Finset.sum_le_sum
          intro r hr
          rw [abs_div, abs_of_nonneg
            (show 0 ≤ ∏ j, ((r j).totient : ℝ) from
              Finset.prod_nonneg (fun j _ => Nat.cast_nonneg ((r j).totient))), hsplit r hr]
          calc
            |y r| / ((D.totient : ℝ) * ∏ j, ((q r j).totient : ℝ)) ≤
                B / ((D.totient : ℝ) * ∏ j, ((q r j).totient : ℝ)) :=
              div_le_div_of_nonneg_right (hbound r)
                (mul_nonneg (Nat.cast_nonneg _)
                  (Finset.prod_nonneg fun j _ => Nat.cast_nonneg ((q r j).totient)))
            _ = (B / (D.totient : ℝ)) * ∏ j, ((q r j).totient : ℝ)⁻¹ := by
              simp only [Finset.prod_inv_distrib, div_mul_eq_div_mul_one_div, one_div]
        _ = (B / (D.totient : ℝ)) *
            ∑ r ∈ S, ∏ j, ((q r j).totient : ℝ)⁻¹ := by
          rw [Finset.mul_sum]
        _ ≤ (B / (D.totient : ℝ)) *
            (∑ r ∈ Q.divisors, (r.totient : ℝ)⁻¹) ^ Fintype.card ι := by
          simpa only [hbox] using
            mul_le_mul_of_nonneg_left hweight (div_nonneg hB (Nat.cast_nonneg _))
    have hmu : |(ArithmeticFunction.moebius D : ℝ)| = 1 := by
      exact_mod_cast ArithmeticFunction.abs_moebius_eq_one_of_squarefree hD
    calc
      |selbergCoefficient y d| =
          (D : ℝ) * |∑ r ∈ S, y r / (∏ j, ((r j).totient : ℝ))| := by
        unfold selbergCoefficient
        rw [hsum, ← Nat.cast_prod d Finset.univ, abs_mul, abs_mul, hmu,
          abs_of_nonneg (Nat.cast_nonneg D), one_mul]
      _ ≤ (D : ℝ) * ((B / (D.totient : ℝ)) *
          (∑ r ∈ Q.divisors, (r.totient : ℝ)⁻¹) ^ Fintype.card ι) :=
        mul_le_mul_of_nonneg_left hinner (Nat.cast_nonneg D)
      _ = B * ((D : ℝ) / (D.totient : ℝ)) *
          (∑ r ∈ Q.divisors, (r.totient : ℝ)⁻¹) ^ Fintype.card ι := by
        ring
  · have hmu : ArithmeticFunction.moebius (∏ j, d j) = 0 :=
      ArithmeticFunction.moebius_eq_zero_of_not_squarefree hD
    simpa only [selbergCoefficient, hmu, Int.cast_zero, zero_mul, abs_zero] using
      (show 0 ≤ B * ((D : ℝ) / (D.totient : ℝ)) *
        (∑ r ∈ Q.divisors, (r.totient : ℝ)⁻¹) ^ Fintype.card ι by positivity)

open Classical in
theorem selberg40_canonical_erased_coefficient_bound
    {𝓗 : Finset ℕ}
    (M : ℝ) (hM : 0 ≤ M) :
    let ρ : ℝ := 2624989 / 10000000
    let ξ₀ : ℝ := 19037 / 100000
    let κ : ℝ := ξ₀ / ρ
    let C : ℝ := Real.exp Real.eulerMascheroniConstant * κ + 1
    ∀ᶠ x : ℝ in Filter.atTop,
      let W := presievingModulus 𝓗 x
      let R := x ^ ρ
      let B := fragmentNormalization W R
      let M_R := harmonicFragmentMass W R κ
      let P := fragmentPrimes W R κ
      let Q := ∏ p ∈ P, p
      let T := (Fintype.piFinset (fun _ : Fin 40 => Q.divisors)).filter
        (fun r => Squarefree (∏ j, r j))
      1 < x ∧ 0 < B ∧ 0 < M_R ∧ M_R / B ≤ C ∧
        R ^ κ = x ^ ξ₀ ∧
        ∀ F : (Fin 40 → MeasureTheory.FiniteMeasure ℝ) → ℝ,
          (∀ X, |F X| ≤ M) →
          let y : (Fin 40 → ℕ) →₀ ℝ :=
            ∑ r ∈ T, Finsupp.single r
              (F (fun j => primeLogConfiguration R (r j)) / B ^ 40)
          (∀ d : Fin 40 → ℕ,
            let D : ℕ := ∏ j, d j
            |selbergCoefficient y d| ≤
                M * (M_R / B) ^ 40 * ((D : ℝ) / (D.totient : ℝ)) ∧
              |selbergCoefficient y d| ≤
                M * C ^ 40 * ((D : ℝ) / (D.totient : ℝ))) ∧
          ∀ i : Fin 40,
            let z : (Fin 39 → ℕ) →₀ ℝ :=
              y.sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
                (yr / ((r i).totient : ℝ)))
            ∀ d : Fin 39 → ℕ,
              let D : ℕ := ∏ j, d j
              selbergCoefficient z d = selbergCoefficient y (i.insertNth 1 d) ∧
                |selbergCoefficient z d| ≤
                  M * (M_R / B) ^ 40 * ((D : ℝ) / (D.totient : ℝ)) ∧
                |selbergCoefficient z d| ≤
                  M * C ^ 40 * ((D : ℝ) / (D.totient : ℝ)) := by
  intro ρ ξ₀ κ C
  have hρ : 0 < ρ := by norm_num [ρ]
  have hκ : 0 < κ := by norm_num [κ, ξ₀, ρ]
  have hm := harmonic_fragment_normalizer_tendsto
    𝓗 ρ κ hρ hκ
  filter_upwards [Filter.eventually_gt_atTop (1 : ℝ),
    hm.eventually_le_const (lt_add_one _)] with x hx hm
  intro W R B M_R P Q T
  have hW : 0 < W := presieving_pos 𝓗 x
  have hB : 0 < B := by
    apply mul_pos
    · exact div_pos (by exact_mod_cast Nat.totient_pos.mpr hW) (by exact_mod_cast hW)
    · exact Real.log_pos (Real.one_lt_rpow hx hρ)
  have hQ : Squarefree Q :=
    squarefree_prime_prod P
      (fun _ hp => Nat.prime_of_mem_primesLE (Finset.mem_filter.mp hp).1)
  have hmass_eq : M_R = ∑ r ∈ Q.divisors, (r.totient : ℝ)⁻¹ := rfl
  have hmass : 0 < M_R := by
    rw [hmass_eq]
    exact Finset.sum_pos' (fun r _ => inv_nonneg.mpr (Nat.cast_nonneg _))
      ⟨1, Nat.one_mem_divisors.mpr hQ.ne_zero, by norm_num⟩
  change M_R / B ≤ C at hm
  have hcap : R ^ κ = x ^ ξ₀ := by
    change (x ^ ρ) ^ κ = x ^ ξ₀
    rw [← Real.rpow_mul (zero_lt_one.trans hx).le]
    norm_num [κ, ξ₀, ρ]
  refine ⟨hx, hB, hmass, hm, hcap, ?_⟩
  intro F hF y
  have hyIndicator : y = Finsupp.indicator T (fun r _ =>
      F (fun j => primeLogConfiguration R (r j)) / B ^ 40) :=
    (Finsupp.indicator_eq_sum_single T _).symm
  have hySupport (r : Fin 40 → ℕ) (hr : r ∈ y.support) :
      Squarefree (∏ j, r j) ∧ ∀ j, r j ∣ Q := by
    rw [hyIndicator] at hr
    obtain ⟨hrbox, hrsquarefree⟩ := Finset.mem_filter.mp
      (Finsupp.support_indicator_subset _ _ hr)
    exact ⟨hrsquarefree, fun j =>
      Nat.dvd_of_mem_divisors (Fintype.mem_piFinset.mp hrbox j)⟩
  have hyBound (r : Fin 40 → ℕ) : |y r| ≤ M / B ^ 40 := by
    rw [hyIndicator, Finsupp.indicator_apply]
    split_ifs
    · rw [abs_div, abs_of_pos (pow_pos hB 40)]
      exact div_le_div_of_nonneg_right (hF _) (pow_nonneg hB.le 40)
    · simpa only [abs_zero] using div_nonneg hM (pow_nonneg hB.le 40)
  have hbound40 (d : Fin 40 → ℕ) :
      let D : ℕ := ∏ j, d j
      |selbergCoefficient y d| ≤
          M * (M_R / B) ^ 40 * ((D : ℝ) / (D.totient : ℝ)) ∧
        |selbergCoefficient y d| ≤
          M * C ^ 40 * ((D : ℝ) / (D.totient : ℝ)) := by
    intro D
    have hfinite : |selbergCoefficient y d| ≤
        (M / B ^ 40) * ((D : ℝ) / (D.totient : ℝ)) * M_R ^ 40 := by
      rw [hmass_eq]
      dsimp only [D]
      simpa only [Fintype.card_fin] using
        selbergCoefficient_abs_le_totient_ratio Q hQ y (M / B ^ 40)
          (div_nonneg hM (pow_nonneg hB.le 40)) hySupport hyBound d
    have hratio : |selbergCoefficient y d| ≤
        M * (M_R / B) ^ 40 * ((D : ℝ) / (D.totient : ℝ)) :=
      hfinite.trans_eq (by simp only [div_eq_mul_inv]; ring)
    refine ⟨hratio, hratio.trans ?_⟩
    exact mul_le_mul_of_nonneg_right
      (mul_le_mul_of_nonneg_left
        (pow_le_pow_left₀ (div_nonneg hmass.le hB.le) hm 40) hM)
      (div_nonneg (Nat.cast_nonneg _) (Nat.cast_nonneg _))
  refine ⟨hbound40, ?_⟩
  intro i z d D
  have heq : selbergCoefficient z d = selbergCoefficient y (i.insertNth 1 d) :=
    selbergCoefficient_weighted_erase i y d
  refine ⟨heq, ?_⟩
  simpa only [heq, Fin.prod_insertNth, one_mul] using hbound40 (i.insertNth 1 d)

end PrimeGap186

theorem PrimeGap186.selberg_actual_modulus_totient_eq
    {k : ℕ} (W : ℕ) (hW : 0 < W) (d e : Fin k → ℕ)
    (hd : Squarefree (∏ i, d i) ∧ Nat.Coprime (∏ i, d i) W)
    (he : Squarefree (∏ i, e i) ∧ Nat.Coprime (∏ i, e i) W)
    (hcross : ∀ i j : Fin k, i ≠ j → Nat.Coprime (d i) (e j)) :
    Nat.totient (Nat.lcm W (Nat.lcm (∏ i, d i) (∏ i, e i))) =
      Nat.totient W * ∏ i, Nat.totient (Nat.lcm (d i) (e i)) := by
  classical
  obtain ⟨w, rfl⟩ := Nat.exists_eq_succ_of_ne_zero hW.ne'
  rw [PrimeGap186.actual_modulus_eq_product w.succ d e hd he hcross,
    Nat.totient_mul (PrimeGap186.actual_modulus_coprime_W_prod_lcm
      w.succ d e hd.2 he.2)]
  congr 1
  let φ : ArithmeticFunction ℕ := ⟨Nat.totient, Nat.totient_zero⟩
  have hφ : φ.IsMultiplicative :=
    ⟨Nat.totient_one, fun {_ _} h => Nat.totient_mul h⟩
  exact ArithmeticFunction.IsMultiplicative.map_prod
    (fun i : Fin k => Nat.lcm (d i) (e i)) hφ Finset.univ
    (PrimeGap186.actual_modulus_pairwise_coprime_lcm d e hd.1 he.1 hcross)

section
open scoped ContDiff

theorem PrimeGap186.selberg_diagonal_support_le_of_coefficient_le
    {ι : Type*} [Fintype ι] (y : (ι → ℕ) →₀ ℝ)
    (hy : ∀ r ∈ y.support, Squarefree (∏ j, r j))
    (B : ℝ)
    (hcoeff : ∀ d : ι → ℕ, PrimeGap186.selbergCoefficient y d ≠ 0 →
      ((∏ j, d j : ℕ) : ℝ) ≤ B) :
    ∀ r ∈ y.support, ((∏ j, r j : ℕ) : ℝ) ≤ B := by
  intro r hr
  have hnz : y r ≠ 0 := Finsupp.mem_support_iff.mp hr
  rw [← PrimeGap186.selberg_forward_inverse y hy r] at hnz
  obtain ⟨d, _, hterm⟩ :=
    Finset.exists_ne_zero_of_sum_ne_zero (mul_ne_zero_iff.mp hnz).2
  obtain ⟨hrd, hquot⟩ := ite_ne_right_iff.mp hterm
  have hdpos : 0 < ∏ j, d j :=
    Nat.pos_of_ne_zero (by exact_mod_cast (div_ne_zero_iff.mp hquot).2)
  have hle : (∏ j, r j) ≤ ∏ j, d j :=
    Nat.le_of_dvd hdpos
      (Finset.prod_dvd_prod_of_dvd r d (fun j _ => hrd j))
  exact (Nat.cast_le.mpr hle).trans (hcoeff d (div_ne_zero_iff.mp hquot).1)

theorem PrimeGap186.selberg_eventually_eq_zero_of_coefficient_radius_neg
    {ι : Type*} [Fintype ι] (y : ℝ → ((ι → ℕ) →₀ ℝ))
    (r_c : ℝ) (hr_c : r_c < 0)
    (hy : ∀ᶠ x : ℝ in Filter.atTop,
      ∀ r ∈ (y x).support, Squarefree (∏ j, r j))
    (hcoeff : ∀ᶠ x : ℝ in Filter.atTop,
      ∀ d : ι → ℕ, PrimeGap186.selbergCoefficient (y x) d ≠ 0 →
        ((∏ j, d j : ℕ) : ℝ) ≤ x ^ r_c) :
    ∀ᶠ x : ℝ in Filter.atTop, y x = 0 := by
  filter_upwards [hy, hcoeff, Filter.eventually_gt_atTop (1 : ℝ)] with x hyx hcx hx
  apply Finsupp.support_eq_empty.mp
  apply Finset.eq_empty_of_forall_notMem
  intro r hr
  have hpos : (1 : ℝ) ≤ ((∏ j, r j : ℕ) : ℝ) :=
    Nat.one_le_cast_iff_ne_zero.mpr (hyx r hr).ne_zero
  exact (not_lt_of_ge hpos)
    ((PrimeGap186.selberg_diagonal_support_le_of_coefficient_le
      (y x) hyx (x ^ r_c) hcx r hr).trans_lt
        (Real.rpow_lt_one_of_one_lt_of_neg hx hr_c))

end

namespace PrimeGap186

section
open scoped ContDiff

theorem selbergCoefficient_add
    {ι : Type*} [Fintype ι]
    (y z : (ι → ℕ) →₀ ℝ) (d : ι → ℕ) :
    selbergCoefficient (y + z) d =
      selbergCoefficient y d + selbergCoefficient z d := by
  unfold selbergCoefficient
  rw [Finsupp.sum_add_index' (fun r => by simp)
    (fun r a b => by split_ifs <;> simp [add_div]), mul_add]

open Classical in
theorem canonical_and_erased_diagonal_amplitude
    {𝓗 : Finset ℕ} {h𝓗_card : 𝓗.card = 40}
    {m : ℕ} (i : Fin 40) (κ : ℝ) (hκ : 0 < κ)
    (a : Fin (m + 2) → ℝ)
    (G : (Fin 39 → Fin (m + 1) → ℝ) → ℝ)
    (F : (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
    (hbG : Bornology.IsBounded (Set.range G))
    (hbF : Bornology.IsBounded (Set.range F)) :
    ∃ M : ℝ, 0 < M ∧
      ∀ᶠ x : ℝ in Filter.atTop,
      let ρ : ℝ := 2624989 / 10000000
      let W := presievingModulus 𝓗 x
      let R := x ^ ρ
      let B := fragmentNormalization W R
      let q : ℕ := ∏ p ∈ fragmentPrimes W R κ, p
      let T39 := (Fintype.piFinset (fun _ : Fin 39 => q.divisors)).filter
        (fun r => Squarefree (∏ j, r j))
      let T40 := (Fintype.piFinset (fun _ : Fin 40 => q.divisors)).filter
        (fun r => Squarefree (∏ j, r j))
      let X : ℕ → Fin (m + 1) → ℝ := fun s =>
        fragmentBandMasses a (primeLogConfiguration R s)
      let w : (Fin 39 → ℕ) →₀ ℝ :=
        ∑ r ∈ T39, Finsupp.single r (G (fun j => X (r j)) / B ^ 39)
      let y : (Fin 40 → ℕ) →₀ ℝ :=
        ∑ r ∈ T40, Finsupp.single r (F (fun j => X (r j)) / B ^ 40)
      let e : (Fin 39 → ℕ) →₀ ℝ :=
        y.sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
          (yr / ((r i).totient : ℝ)))
      let z : (Fin 39 → ℕ) →₀ ℝ := w + e
      1 < x ∧ 0 < B ∧
      (∀ r : Fin 39 → ℕ,
        w r = if r ∈ T39 then G (fun j => X (r j)) / B ^ 39 else 0) ∧
      (∀ r : Fin 39 → ℕ,
        r ∈ w.support ↔ r ∈ T39 ∧ G (fun j => X (r j)) ≠ 0) ∧
      (∀ r ∈ w.support,
        Squarefree (∏ j, r j) ∧ ∀ j, r j ∈ q.divisors) ∧
      (∀ r ∈ y.support,
        Squarefree (∏ j, r j) ∧ ∀ j, r j ∈ q.divisors) ∧
      (∀ d : Fin 39 → ℕ,
        selbergCoefficient e d = selbergCoefficient y (i.insertNth 1 d)) ∧
      (∀ d : Fin 39 → ℕ,
        selbergCoefficient z d =
          selbergCoefficient w d + selbergCoefficient y (i.insertNth 1 d)) ∧
      (∀ r ∈ z.support,
        Squarefree (∏ j, r j) ∧ ∀ j, r j ∈ q.divisors) ∧
      (∀ r : Fin 39 → ℕ, |z r| ≤ M / B ^ 39) := by
  obtain ⟨MG, hMG, hGb⟩ := hbG.exists_pos_norm_le
  obtain ⟨MF, hMF, hFb⟩ := hbF.exists_pos_norm_le
  simp only [Real.norm_eq_abs] at hGb hFb
  let Cκ := Real.exp Real.eulerMascheroniConstant * κ + 1
  refine ⟨MG + MF * Cκ, by dsimp [Cκ]; positivity, ?_⟩
  filter_upwards [selberg40_canonical_erased_face
    (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i κ MF hκ hMF.le] with x hx
  intro ρ W R B q T39 T40 X w y e z
  obtain ⟨hx, hB, hface⟩ := hx
  obtain ⟨hy, _, hecoeff, _, hesupp, hebound⟩ :=
    hface (fun Y => F (fun j => fragmentBandMasses a (Y j)))
      (fun Y => hFb _ ⟨fun j => fragmentBandMasses a (Y j), rfl⟩)
  have hB39 : 0 < B ^ 39 := pow_pos hB 39
  have hw (r : Fin 39 → ℕ) :
      w r = if r ∈ T39 then G (fun j => X (r j)) / B ^ 39 else 0 := by
    simp [w, Finsupp.finsetSum_apply, Finsupp.single_apply]
  have hwmem (r : Fin 39 → ℕ) :
      r ∈ w.support ↔ r ∈ T39 ∧ G (fun j => X (r j)) ≠ 0 := by
    rw [Finsupp.mem_support_iff, hw]
    split_ifs with hr <;> simp [hr, hB39.ne']
  have hwsupp : ∀ r ∈ w.support,
      Squarefree (∏ j, r j) ∧ ∀ j, r j ∈ q.divisors := by
    intro r hr
    have ht := Finset.mem_filter.mp ((hwmem r).mp hr).1
    exact ⟨ht.2, Fintype.mem_piFinset.mp ht.1⟩
  refine ⟨hx, hB, hw, hwmem, hwsupp, ?_, hecoeff, ?_, ?_, ?_⟩
  · intro r hr
    have ht : r ∈ T40 := by
      by_contra hnot
      apply Finsupp.mem_support_iff.mp hr
      exact (hy r).trans (ite_eq_right hnot)
    exact ⟨(Finset.mem_filter.mp ht).2,
      Fintype.mem_piFinset.mp (Finset.mem_filter.mp ht).1⟩
  · intro d
    change selbergCoefficient (w + e) d = _
    rw [selbergCoefficient_add, hecoeff]
  · intro r hr
    rcases Finset.mem_union.mp (Finsupp.support_add hr) with hrw | hre
    · exact hwsupp r hrw
    · exact ⟨(hesupp r hre).1, (hesupp r hre).2.1⟩
  · intro r
    have hwbound : |w r| ≤ MG / B ^ 39 := by
      rw [hw]
      split_ifs
      · rw [abs_div, abs_of_pos hB39]
        exact div_le_div_of_nonneg_right (hGb _ ⟨fun j => X (r j), rfl⟩) hB39.le
      · simpa only [abs_zero] using div_nonneg hMG.le hB39.le
    calc
      |z r| = |w r + e r| := rfl
      _ ≤ |w r| + |e r| := abs_add_le _ _
      _ ≤ MG / B ^ 39 + MF * Cκ / B ^ 39 := add_le_add hwbound (hebound r).2
      _ = (MG + MF * Cκ) / B ^ 39 := (add_div _ _ _).symm

theorem uniform_scaled_error_of_normalized_tendsto
    {α : Type*} {l : Filter α} (S : α → ℕ → ℝ) (a b e : α → ℝ) (L : ℝ)
    (hpos : ∀ᶠ x in l, 0 ≤ a x ∧ 0 < b x)
    (hlim : Tendsto (fun x => b x * e x) l (nhds L))
    (herr : ∀ ε : ℝ, 0 < ε → ∀ᶠ x in l, ∀ n : ℕ,
      |S x n - a x * e x| ≤ ε * (a x / b x)) :
    ∀ ε : ℝ, 0 < ε → ∀ᶠ x in l, ∀ n : ℕ,
      |S x n - (a x / b x) * L| ≤ ε * (a x / b x) := by
  intro ε hε
  have hhalf : 0 < ε / 2 := half_pos hε
  have hsmall : ∀ᶠ x in l, |b x * e x - L| < ε / 2 := by
    simpa only [Real.norm_eq_abs] using
      hlim.eventually (eventually_norm_sub_lt L hhalf)
  filter_upwards [hpos, herr (ε / 2) hhalf, hsmall] with x hx he hs
  intro n
  have hscale : 0 ≤ a x / b x := div_nonneg hx.1 hx.2.le
  have hid : S x n - (a x / b x) * L =
      (S x n - a x * e x) + (a x / b x) * (b x * e x - L) := by
    field_simp [ne_of_gt hx.2]
    ring
  rw [hid]
  calc
    _ ≤ |S x n - a x * e x| + |(a x / b x) * (b x * e x - L)| :=
      abs_add_le _ _
    _ = |S x n - a x * e x| + (a x / b x) * |b x * e x - L| := by
      rw [abs_mul, abs_of_nonneg hscale]
    _ ≤ (ε / 2) * (a x / b x) + (a x / b x) * (ε / 2) :=
      add_le_add (he n) (mul_le_mul_of_nonneg_left hs.le hscale)
    _ = ε * (a x / b x) := by ring

end

section
open scoped ContDiff
open Classical in
theorem canonical_diagonal_finset_smul
    {J : Type*} {n m : ℕ} (s : Finset J) (c : J → ℝ)
    (T : Finset (Fin n → ℕ)) (U : ℕ → Fin (m + 1) → ℝ) (B : ℝ)
    (G : J → (Fin n → Fin (m + 1) → ℝ) → ℝ) :
    (∑ r ∈ T, Finsupp.single r
      ((∑ j ∈ s, c j * G j (fun k => U (r k))) / B ^ n)) =
      ∑ j ∈ s, c j •
        (∑ r ∈ T, Finsupp.single r (G j (fun k => U (r k)) / B ^ n)) := by
  simp_rw [Finset.sum_div, Finsupp.single_finsetSum]
  rw [Finset.sum_comm]
  simp_rw [Finset.smul_sum, Finsupp.smul_single, smul_eq_mul, mul_div_assoc]

open Classical in
theorem weighted_erasure_finset_smul
    {J : Type*} {n : ℕ} (s : Finset J) (c : J → ℝ)
    (i : Fin (n + 1)) (y : J → ((Fin (n + 1) → ℕ) →₀ ℝ)) :
    (∑ j ∈ s, c j • y j).sum
        (fun r yr => Finsupp.single (fun k => r (i.succAbove k))
          (yr / ((r i).totient : ℝ))) =
      ∑ j ∈ s, c j • (y j).sum
        (fun r yr => Finsupp.single (fun k => r (i.succAbove k))
          (yr / ((r i).totient : ℝ))) := by
  rw [Finsupp.sum_finsetSum _ _ _ (fun _ => by simp)
    (fun _ _ _ => by simp [add_div, Finsupp.single_add])]
  apply Finset.sum_congr rfl
  intro j _
  rw [Finsupp.sum_smul_index (fun _ => by simp)]
  simp only [Finsupp.sum, Finset.smul_sum, Finsupp.smul_single,
    smul_eq_mul, mul_div_assoc]

theorem selbergCoefficient_smul
    {ι : Type*} [Fintype ι] (a : ℝ) (y : (ι → ℕ) →₀ ℝ) (d : ι → ℕ) :
    selbergCoefficient (a • y) d = a * selbergCoefficient y d := by
  unfold selbergCoefficient
  rw [Finsupp.sum_smul_index (fun _ => by simp), mul_left_comm a]
  congr 1
  rw [Finsupp.mul_sum]
  simp only [Finsupp.sum, mul_ite, mul_div_assoc, mul_zero]

open Classical in
theorem selbergCoefficient_finset_combination
    {ι J : Type*} [Fintype ι] (s : Finset J) (c : J → ℝ)
    (y : J → ((ι → ℕ) →₀ ℝ)) :
    (∀ d : ι → ℕ,
      selbergCoefficient (∑ j ∈ s, c j • y j) d =
        ∑ j ∈ s, c j * selbergCoefficient (y j) d) ∧
    (∀ d : ι → ℕ,
      selbergCoefficient (∑ j ∈ s, c j • y j) d ≠ 0 →
        ∃ j ∈ s, c j ≠ 0 ∧ selbergCoefficient (y j) d ≠ 0) := by
  have hlinear (d : ι → ℕ) :
      selbergCoefficient (∑ j ∈ s, c j • y j) d =
        ∑ j ∈ s, c j * selbergCoefficient (y j) d := by
    induction s using Finset.induction_on with
    | empty => simp [selbergCoefficient]
    | @insert j s hj ih =>
      simp only [Finset.sum_insert hj, selbergCoefficient_add, selbergCoefficient_smul, ih]
  refine ⟨hlinear, ?_⟩
  intro d hd
  rw [hlinear] at hd
  obtain ⟨j, hj, hne⟩ := Finset.exists_ne_zero_of_sum_ne_zero hd
  exact ⟨j, hj, mul_ne_zero_iff.mp hne⟩

open Classical in
theorem selbergCoefficient_finset_radius
    {ι J : Type*} [Fintype ι] (s : Finset J) (c : J → ℝ)
    (y : J → ((ι → ℕ) →₀ ℝ)) (d : ι → ℕ) (B : ℝ)
    (hindividual : ∀ j ∈ s, selbergCoefficient (y j) d ≠ 0 →
      ((∏ k, d k : ℕ) : ℝ) ≤ B)
    (haggregate : selbergCoefficient (∑ j ∈ s, c j • y j) d ≠ 0) :
    ((∏ k, d k : ℕ) : ℝ) ≤ B := by
  obtain ⟨j, hj, _, hd⟩ :=
    (selbergCoefficient_finset_combination s c y).2 d haggregate
  exact hindividual j hj hd

theorem finite_profile_combination_regular
    {E J : Type*} [TopologicalSpace E] [MeasurableSpace E]
    (μ : Measure E) (s : Finset J) (c : J → ℝ) (G : J → E → ℝ)
    (hG : ∀ j ∈ s, Measurable (G j))
    (hbG : ∀ j ∈ s, Bornology.IsBounded (Set.range (G j)))
    (hcG : ∀ j ∈ s, ∀ᵐ X ∂μ, ContinuousAt (G j) X) :
    Measurable (fun X => ∑ j ∈ s, c j * G j X) ∧
      Bornology.IsBounded (Set.range (fun X => ∑ j ∈ s, c j * G j X)) ∧
      (∀ᵐ X ∂μ, ContinuousAt (fun Y => ∑ j ∈ s, c j * G j Y) X) := by
  classical
  refine ⟨Finset.measurable_fun_sum _ (fun j hj => measurable_const.mul (hG j hj)), ?_, ?_⟩
  · clear hG hcG
    revert hbG
    induction s using Finset.induction_on with
    | empty =>
      intro _
      apply isBounded_iff_forall_norm_le.mpr
      exact ⟨0, by rintro _ ⟨X, rfl⟩; simp⟩
    | @insert j s hj ih =>
      intro hbG
      have hsmall := ih (fun k hk => hbG k (Finset.mem_insert_of_mem hk))
      have hsingle : Bornology.IsBounded (Set.range (fun X => c j * G j X)) := by
        simpa only [← smul_eq_mul, Set.range_smul] using
          (hbG j (Finset.mem_insert_self j s)).smul₀ (c j)
      apply (isBounded_add hsingle hsmall).subset
      rintro _ ⟨X, rfl⟩
      exact Set.mem_add.mpr ⟨c j * G j X, ⟨X, rfl⟩,
        ∑ k ∈ s, c k * G k X, ⟨X, rfl⟩, by simp only [Finset.sum_insert hj]⟩
  · filter_upwards [(Filter.eventually_all_finset s).2 hcG] with X hX
    exact tendsto_finsetSum s (fun j hj => continuousAt_const.mul (hX j hj))

open Classical in
theorem fixed_band_erased_finset_integral
    {J : Type*} {n m : ℕ} (s : Finset J) (c : J → ℝ)
    (i : Fin (n + 1)) (κ : ℝ) (a : Fin (m + 2) → ℝ)
    (F : J → (Fin (n + 1) → Fin (m + 1) → ℝ) → ℝ)
    (hF : ∀ j ∈ s, Measurable (F j))
    (hbF : ∀ j ∈ s, Bornology.IsBounded (Set.range (F j))) :
    let ν : Measure (Fin (m + 1) → ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        Measure.map (fragmentBandMasses a) (fragmentLaw κ)
    IsFiniteMeasure ν ∧
      (∀ j ∈ s, ∀ Y : Fin n → Fin (m + 1) → ℝ,
        Integrable (fun t => F j (i.insertNth t Y)) ν) ∧
      (∀ Y : Fin n → Fin (m + 1) → ℝ,
        Integrable (fun t => ∑ j ∈ s, c j * F j (i.insertNth t Y)) ν) ∧
      (∀ Y : Fin n → Fin (m + 1) → ℝ,
        (∫ t, (∑ j ∈ s, c j * F j (i.insertNth t Y)) ∂ν) =
          ∑ j ∈ s, c j * ∫ t, F j (i.insertNth t Y) ∂ν) := by
  intro ν
  let : IsProbabilityMeasure (fragmentLaw κ) :=
    fragmentLaw_isProbabilityMeasure κ
  let : IsFiniteMeasure ν := by
    dsimp [ν]
    exact (Measure.map (fragmentBandMasses a)
      (fragmentLaw κ)).smul_finite (by simp)
  have hslice (j : J) (hj : j ∈ s) (Y : Fin n → Fin (m + 1) → ℝ) :
      Integrable (fun t => F j (i.insertNth t Y)) ν := by
    exact integrable_of_measurable_of_bounded_range ν (fun t => F j (i.insertNth t Y))
      ((hF j hj).comp (by fun_prop))
      ((hbF j hj).subset (Set.range_comp_subset_range _ _))
  refine ⟨inferInstance, hslice, ?_, ?_⟩
  · intro Y
    exact integrable_finsetSum s (fun j hj => (hslice j hj Y).const_mul (c j))
  · intro Y
    rw [integral_finsetSum s (fun j hj => (hslice j hj Y).const_mul (c j))]
    simp only [integral_const_mul]

open Classical in
theorem selberg_divisor_root_finset_combination
    {ι J : Type*} [Fintype ι] (s : Finset J) (c : J → ℝ)
    (y : J → ((ι → ℕ) →₀ ℝ)) (v : ι → ℕ) :
    let z := ∑ j ∈ s, c j • y j
    let D := fun w : (ι → ℕ) →₀ ℝ =>
      w.support.biUnion (fun r => Fintype.piFinset (fun k => (r k).divisors))
    (∑ d ∈ D z, if ∀ k, d k ∣ v k then selbergCoefficient z d else 0) =
      ∑ j ∈ s, c j *
        (∑ d ∈ D (y j), if ∀ k, d k ∣ v k then selbergCoefficient (y j) d else 0) := by
  intro z D
  let K := D z ∪ s.biUnion (fun j => D (y j))
  have hroot (w : (ι → ℕ) →₀ ℝ) (hsub : D w ⊆ K) :
      (∑ d ∈ D w, if ∀ k, d k ∣ v k then selbergCoefficient w d else 0) =
        ∑ d ∈ K, if ∀ k, d k ∣ v k then selbergCoefficient w d else 0 := by
    apply Finset.sum_subset hsub
    intro d _ hd
    have hc : selbergCoefficient w d = 0 := by
      by_contra hne
      exact hd (selbergCoefficient_mem_divisorClosure w d hne)
    simp only [hc, ite_self]
  calc
    _ = ∑ d ∈ K, if ∀ k, d k ∣ v k then selbergCoefficient z d else 0 :=
      hroot z Finset.subset_union_left
    _ = ∑ d ∈ K, ∑ j ∈ s,
        c j * (if ∀ k, d k ∣ v k then selbergCoefficient (y j) d else 0) := by
      apply Finset.sum_congr rfl
      intro d _
      by_cases hd : ∀ k, d k ∣ v k
      · simp only [ite_eq_left hd]
        exact (selbergCoefficient_finset_combination s c y).1 d
      · simp only [ite_eq_right hd, mul_zero, Finset.sum_const_zero]
    _ = _ := by
      rw [Finset.sum_comm]
      apply Finset.sum_congr rfl
      intro j hj
      rw [← Finset.mul_sum, ← hroot (y j) (fun d hd =>
        Finset.mem_union_right _ (Finset.mem_biUnion.mpr ⟨j, hj, hd⟩))]

open Classical in
theorem canonical_and_erased_coefficient_root_subpower
    {𝓗 : Finset ℕ} {h𝓗_card : 𝓗.card = 40}
    {m : ℕ} (i : Fin 40) (κ : ℝ) (hκ : 0 < κ)
    (a : Fin (m + 2) → ℝ)
    (G : (Fin 39 → Fin (m + 1) → ℝ) → ℝ)
    (F : (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
    (hbG : Bornology.IsBounded (Set.range G))
    (hbF : Bornology.IsBounded (Set.range F)) :
    let ρ : ℝ := 2624989 / 10000000
    let Cκ : ℝ := Real.exp Real.eulerMascheroniConstant * κ + 1
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    let W : ℝ → ℕ := fun x =>
      presievingModulus 𝓗 x
    let R : ℝ → ℝ := fun x => x ^ ρ
    let B : ℝ → ℝ := fun x =>
      fragmentNormalization (W x) (R x)
    let M_R : ℝ → ℝ := fun x =>
      harmonicFragmentMass (W x) (R x) κ
    let q : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) (R x) κ, p
    let T39 := fun x => (Fintype.piFinset (fun _ : Fin 39 => (q x).divisors)).filter
      (fun r => Squarefree (∏ j, r j))
    let T40 := fun x => (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
      (fun r => Squarefree (∏ j, r j))
    let X : ℝ → ℕ → Fin (m + 1) → ℝ := fun x s =>
      fragmentBandMasses a (primeLogConfiguration (R x) s)
    let w : ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun x =>
      ∑ r ∈ T39 x, Finsupp.single r (G (fun j => X x (r j)) / B x ^ 39)
    let y : ℝ → ((Fin 40 → ℕ) →₀ ℝ) := fun x =>
      ∑ r ∈ T40 x, Finsupp.single r (F (fun j => X x (r j)) / B x ^ 40)
    let e : ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun x =>
      (y x).sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
        (yr / ((r i).totient : ℝ)))
    let z : ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun x => w x + e x
    let D : ℝ → Finset (Fin 39 → ℕ) := fun x =>
      (z x).support.biUnion (fun r => Fintype.piFinset (fun j => (r j).divisors))
    ∃ M : ℝ, 0 < M ∧
      (∀ᶠ x : ℝ in Filter.atTop,
        1 < x ∧ 0 < B x ∧
        ∀ d : Fin 39 → ℕ,
          let D₀ : ℕ := ∏ j, d j
          |selbergCoefficient (z x) d| ≤
              M * (M_R x / B x) ^ 39 * ((D₀ : ℝ) / (D₀.totient : ℝ)) ∧
            |selbergCoefficient (z x) d| ≤
              M * Cκ ^ 39 * ((D₀ : ℝ) / (D₀.totient : ℝ))) ∧
      ∀ ε : ℝ, 0 < ε → ∃ A : ℝ, 0 < A ∧
        ∀ᶠ x : ℝ in Filter.atTop,
          ∀ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            |∑ d ∈ D x, if ∀ j, d j ∣ n + h (i.succAbove j) then
                selbergCoefficient (z x) d else 0| ≤ A * x ^ ε := by
  intro ρ Cκ h W R B M_R q T39 T40 X w y e z D
  obtain ⟨M, hM, hamp⟩ :=
    canonical_and_erased_diagonal_amplitude (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i κ hκ a G F hbG hbF
  have hnorm := harmonic_fragment_normalizer_tendsto
    𝓗 ρ κ (by norm_num [ρ]) hκ
  have hbound : ∀ᶠ x : ℝ in Filter.atTop,
      1 < x ∧ 0 < B x ∧
      ∀ d : Fin 39 → ℕ,
        let D₀ : ℕ := ∏ j, d j
        |selbergCoefficient (z x) d| ≤
            M * (M_R x / B x) ^ 39 * ((D₀ : ℝ) / (D₀.totient : ℝ)) ∧
          |selbergCoefficient (z x) d| ≤
            M * Cκ ^ 39 * ((D₀ : ℝ) / (D₀.totient : ℝ)) := by
    filter_upwards [hamp, hnorm.eventually_le_const (lt_add_one _)] with x hx hm
    obtain ⟨hx, hB, _, _, _, _, _, _, hzsupport, hzbound⟩ := hx
    change 0 < B x at hB
    change (∀ r ∈ (z x).support,
      Squarefree (∏ j, r j) ∧ ∀ j, r j ∈ (q x).divisors) at hzsupport
    change (∀ r, |(z x) r| ≤ M / B x ^ 39) at hzbound
    have hq : Squarefree (q x) := by
      apply (squarefree_primorial ⌊R x ^ κ⌋₊).squarefree_of_dvd
      exact Finset.prod_dvd_prod_of_subset _ _ _ (Finset.filter_subset _ _)
    have hmass_eq : M_R x = ∑ r ∈ (q x).divisors, (r.totient : ℝ)⁻¹ := rfl
    have hmass : 0 ≤ M_R x := by
      rw [hmass_eq]
      exact Finset.sum_nonneg fun r _ => inv_nonneg.mpr (Nat.cast_nonneg _)
    change M_R x / B x ≤ Cκ at hm
    refine ⟨hx, hB, ?_⟩
    intro d D₀
    have hfinite : |selbergCoefficient (z x) d| ≤
        (M / B x ^ 39) * ((D₀ : ℝ) / (D₀.totient : ℝ)) * M_R x ^ 39 := by
      rw [hmass_eq]
      dsimp only [D₀]
      simpa only [Fintype.card_fin] using
        selbergCoefficient_abs_le_totient_ratio (q x) hq (z x) (M / B x ^ 39)
          (div_nonneg hM.le (pow_nonneg hB.le 39))
          (fun r hr => ⟨(hzsupport r hr).1, fun j =>
            Nat.dvd_of_mem_divisors ((hzsupport r hr).2 j)⟩) hzbound d
    have hratio : |selbergCoefficient (z x) d| ≤
        M * (M_R x / B x) ^ 39 * ((D₀ : ℝ) / (D₀.totient : ℝ)) :=
      hfinite.trans_eq (by
        rw [div_pow]
        simp only [div_eq_mul_inv]
        ac_rfl)
    refine ⟨hratio, hratio.trans ?_⟩
    exact mul_le_mul_of_nonneg_right
      (mul_le_mul_of_nonneg_left
        (pow_le_pow_left₀ (div_nonneg hmass hB.le) hm 39) hM.le)
      (div_nonneg (Nat.cast_nonneg _) (Nat.cast_nonneg _))
  refine ⟨M, hM, hbound, ?_⟩
  intro ε hε
  obtain ⟨A, hA, hroot⟩ := selberg_divisor_root_uniform_subpower
    (fun j : Fin 39 => h (i.succAbove j)) (M * Cκ ^ 39) ε
    (by dsimp [Cκ]; positivity) hε
  refine ⟨A, hA, ?_⟩
  filter_upwards [hbound, hroot] with x hb hr
  intro n hn
  have hcoeff : ∀ d ∈ D x,
      |selbergCoefficient (z x) d| ≤
        M * Cκ ^ 39 * ((∏ j, d j : ℕ) : ℝ) / ((∏ j, d j : ℕ).totient : ℝ) := by
    intro d _
    simpa only [mul_div_assoc] using (hb.2.2 d).2
  have hvalue := hr (z x) (D x) n hn hcoeff
  refine le_trans ?_ hvalue
  apply le_of_eq
  apply congrArg abs
  apply Finset.sum_congr rfl
  intro d _
  exact @ite_cond_congr ℝ _ _ _ Fintype.decidableForallFintype _ _ rfl

end

section
open scoped ContDiff

end

open Asymptotics Topology Real Finset _root_.Filter Asymptotics.Filter

theorem selberg40_marked_count_error_small
    {𝓗 : Finset ℕ}
    (r σ M N : ℝ) (J : ℕ) (hmargin : σ + 2 * r < 1) :
    ∀ ε : ℝ, 0 < ε →
      ∀ᶠ x : ℝ in atTop,
        let ρ : ℝ := 2624989 / 10000000
        let W := presievingModulus 𝓗 x
        let Bx := fragmentNormalization W x
        let B := fragmentNormalization W (x ^ ρ)
        1 < x ∧ 0 < Bx ∧ 0 < B ∧
          x ^ σ * ((2 * M ^ 2 * N ^ 2 / (Bx ^ 2 * B ^ 78)) *
            x ^ (2 * r) * (Real.log x) ^ (2 * J)) ≤
              ε * (x / (W : ℝ) / Bx / B ^ 39) := by
  intro ε hε
  let ρ₀ : ℝ := 2624989 / 10000000
  let a : ℝ := r + σ / 2
  have hρ : 0 < ρ₀ := by norm_num [ρ₀]
  have hδ : 0 < 1 - 2 * a := by dsimp only [a]; linarith
  have hlogLimit : Tendsto
      (fun x : ℝ => Real.log x ^ (2 * J + 1) / x ^ (1 - 2 * a))
      atTop (nhds 0) := by
    simpa only [Real.rpow_natCast] using
      (isLittleO_log_rpow_rpow_atTop ((2 * J + 1 : ℕ) : ℝ) hδ).tendsto_div_nhds_zero
  have hlimit : Tendsto
      (fun x : ℝ => 2 * (M * N) ^ 2 * Real.log x ^ (2 * J + 1) /
        x ^ (1 - 2 * a)) atTop (nhds 0) := by
    simpa only [mul_zero, mul_div_assoc] using hlogLimit.const_mul (2 * (M * N) ^ 2)
  filter_upwards [eventually_gt_atTop (1 : ℝ),
    presieving_le_mul_log_eventually 𝓗 1 zero_lt_one,
    presieving_le_mul_log_eventually 𝓗 ρ₀ hρ,
    hlimit.eventually_le_const hε] with x hx hWlog hWρ hsmall
  intro ρ W Bx B
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hlog : 0 ≤ Real.log x := Real.log_nonneg hx.le
  have hW : 0 < W := presieving_pos 𝓗 x
  have hWR : (0 : ℝ) < W := Nat.cast_pos.mpr hW
  have hφ : (1 : ℝ) ≤ (Nat.totient W : ℝ) :=
    Nat.one_le_cast.mpr (Nat.totient_pos.mpr hW)
  have hWlog' : (W : ℝ) ≤ Real.log x := by simpa only [one_mul] using hWlog
  have hBx1 : 1 ≤ Bx := by
    change 1 ≤ ((Nat.totient W : ℝ) / (W : ℝ)) * Real.log x
    rw [div_mul_eq_mul_div]
    exact (one_le_div hWR).mpr
      (hWlog'.trans (le_mul_of_one_le_left hlog hφ))
  have hB1 : 1 ≤ B := by
    change 1 ≤ ((Nat.totient W : ℝ) / (W : ℝ)) * Real.log (x ^ ρ₀)
    rw [Real.log_rpow hx0, div_mul_eq_mul_div]
    exact (one_le_div hWR).mpr
      (hWρ.trans (le_mul_of_one_le_left (mul_nonneg hρ.le hlog) hφ))
  have hBx : 0 < Bx := zero_lt_one.trans_le hBx1
  have hB : 0 < B := zero_lt_one.trans_le hB1
  refine ⟨hx, hBx, hB, ?_⟩
  let A : ℝ := x / (W : ℝ) / Bx / B ^ 39
  let raw : ℝ := (2 * M ^ 2 * N ^ 2 / (Bx ^ 2 * B ^ 78)) *
    x ^ (2 * r) * (Real.log x) ^ (2 * J)
  have hA : 0 < A := div_pos (div_pos (div_pos hx0 hWR) hBx) (pow_pos hB 39)
  have hpow : x ^ σ * x ^ (2 * r) = (x ^ a) ^ 2 := by
    calc
      _ = x ^ (σ + 2 * r) := (Real.rpow_add hx0 _ _).symm
      _ = x ^ (a * 2) := by congr 1; dsimp only [a]; ring
      _ = _ := Real.rpow_mul_natCast hx0.le a 2
  have hlogpow : Real.log x ^ (2 * J) = (Real.log x ^ J) ^ 2 :=
    pow_mul' (Real.log x) 2 J
  have hden : 1 ≤ Bx * B ^ 39 :=
    one_le_mul_of_one_le_of_one_le hBx1 (one_le_pow₀ hB1)
  have hWscaled : (W : ℝ) / (Bx * B ^ 39) ≤ Real.log x :=
    (div_le_self (Nat.cast_nonneg W) hden).trans hWlog'
  have hrawNorm : x ^ σ * raw / A ≤
      2 * (M * N) ^ 2 * Real.log x ^ (2 * J + 1) / x ^ (1 - 2 * a) := by
    calc
      x ^ σ * raw / A =
          (2 * M ^ 2 * N ^ 2 / (Bx ^ 2 * B ^ 78)) *
            (x ^ σ * x ^ (2 * r)) * Real.log x ^ (2 * J) / A := by
        dsimp only [raw]
        ring
      _ = (2 * (M * N) ^ 2 * (x ^ a) ^ 2 * (Real.log x ^ J) ^ 2 / x) *
          ((W : ℝ) / (Bx * B ^ 39)) := by
        rw [hpow, hlogpow]
        dsimp only [A]
        field_simp [hBx.ne', hB.ne', hx0.ne', hWR.ne']
      _ ≤ (2 * (M * N) ^ 2 * (x ^ a) ^ 2 * (Real.log x ^ J) ^ 2 / x) *
          Real.log x :=
        mul_le_mul_of_nonneg_left hWscaled (by positivity)
      _ = 2 * (M * N) ^ 2 * Real.log x * (x ^ a) ^ 2 *
          (Real.log x ^ J) ^ 2 / x := by ring
      _ = _ := crt_power_identity (M * N) x a J hx0
  exact (div_le_iff₀ hA).mp (hrawNorm.trans hsmall)

open Classical in
theorem selberg40_auxiliary_marked_bin_uniform
    {𝓗 : Finset ℕ} {h𝓗_card : 𝓗.card = 40}
    (i : Fin 40) (κ r_c ζ_a M N ξ a l s : ℝ)
    (hκ : 0 < κ) (hζ_a : 0 < ζ_a) (hM : 0 ≤ M) (hN : 0 ≤ N)
    (hξ : 0 < ξ) (hξa : ξ ≤ a) (hs : 0 ≤ s)
    (hcap : ((2624989 : ℝ) / 10000000) * κ < ξ)
    (hmargin : s + 2 * (r_c + ζ_a) < 1) :
    ∀ ε : ℝ, 0 < ε →
      ∀ᶠ x : ℝ in Filter.atTop,
        let ρ : ℝ := 2624989 / 10000000
        let h : Fin 40 → ℕ :=
          𝓗.orderEmbOfFin h𝓗_card
        let W := presievingModulus 𝓗 x
        let R := x ^ ρ
        let Bx := fragmentNormalization W x
        let B := fragmentNormalization W R
        let P := fragmentPrimes W R κ
        let q : ℕ := ∏ p ∈ P, p
        let T := markedPrimePairBin x ξ a l s
        let pairMass : ℝ := ∑ v ∈ T, 1 / ((v.1 * v.2 : ℕ) : ℝ)
        1 < x ∧ 0 < Bx ∧ 0 < B ∧
          ∀ (u : (Fin 1 → ℕ) →₀ ℝ) (z : (Fin 39 → ℕ) →₀ ℝ),
            (∀ t ∈ u.support,
              t 0 ∈ q.divisors ∧ (t 0 : ℝ) ≤ x ^ ζ_a) →
            (∀ r ∈ z.support,
              Squarefree (∏ j, r j) ∧ (∀ j, r j ∈ q.divisors) ∧
                ((∏ j, r j : ℕ) : ℝ) ≤ x ^ r_c) →
            (∀ t, |u t| ≤ N / Bx) →
            (∀ r, |z r| ≤ M / B ^ 39) →
            let Du := u.support.biUnion
              (fun t => Fintype.piFinset (fun j => (t j).divisors))
            let Dz := z.support.biUnion
              (fun r => Fintype.piFinset (fun j => (r j).divisors))
            let L : ℕ → ℝ := fun t =>
              ∑ e ∈ Du, if e 0 ∣ t then selbergCoefficient u e else 0
            let C : ℕ → ℝ := fun n =>
              ∑ d ∈ Dz, if ∀ j, d j ∣ n + h (i.succAbove j) then
                selbergCoefficient z d else 0
            let harmonic : ℝ :=
              u.sum (fun t ut => ut ^ 2 / ((t 0).totient : ℝ)) *
                z.sum (fun r zr => zr ^ 2 / (∏ j, ((r j).totient : ℝ)))
            ∀ b : ℕ,
              |(∑ v ∈ T, ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
                  if Nat.ModEq W n b ∧ v.1 * v.2 ∣ n + h i then
                    (L (n + h i) * C n) ^ 2 else 0) -
                pairMass * (x / (W : ℝ) * harmonic)| ≤
                  ε * (x / (W : ℝ) / Bx / B ^ 39) := by
  intro ε hε
  obtain ⟨K, hK, hmass⟩ := markedPrimePairBin_reciprocal_eventually_bounded ξ a hξ hξa
  let η : ℝ := ε / (2 * K + 1)
  have hden : 0 < 2 * K + 1 := by positivity
  have hη : 0 < η := div_pos hε hden
  have hradius : 2 * (r_c + ζ_a) < 1 := by linarith
  let J : ℕ := 7 + (2 ^ (39 + 2) - 1)
  have hlogcap : ∀ᶠ x : ℝ in atTop,
      0 ≤ r_c → 1 + Real.log (⌊x ^ (r_c + ζ_a)⌋₊ : ℝ) ≤ Real.log x := by
    by_cases hrc : 0 ≤ r_c
    · have ha0 : 0 < r_c + ζ_a := add_pos_of_nonneg_of_pos hrc hζ_a
      have ha1 : r_c + ζ_a < 1 := by linarith
      exact (floor_rpow_log_envelope (r_c + ζ_a) ha0 ha1).mono
        fun _ hx _ => hx.2.2
    · exact Filter.Eventually.of_forall fun _ hc => (hrc hc).elim
  filter_upwards [hmass, hlogcap,
    markedPrimePairBin_coprime_eventually 𝓗
      ((2624989 : ℝ) / 10000000) κ ξ a l s hξ hcap,
    selberg40_marked_count_error_small (𝓗 := 𝓗) (r_c + ζ_a) s M N J hmargin η hη,
    selberg40_auxiliary_uniform_real_harmonic (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i κ r_c ζ_a M N
      hκ hζ_a hradius hM hN η hη] with x hmassx hlog hcop hsmallx hphysical
  intro ρ h W R Bx B P q T pairMass
  rcases hsmallx with ⟨hx, hBx, hB, hsmall⟩
  have hx0 : 0 < x := zero_lt_one.trans hx
  refine ⟨hx, hBx, hB, ?_⟩
  intro u z hu hz huBound hzBound Du Dz L C harmonic b
  let A : ℝ := x / (W : ℝ) / Bx / B ^ 39
  let E : ℝ := (2 * M ^ 2 * N ^ 2 / (Bx ^ 2 * B ^ 78)) *
    x ^ (2 * (r_c + ζ_a)) * Real.log x ^ (2 * J)
  let mean : ℝ := (1 / (q : ℝ)) *
    ∑ n ∈ Finset.range q, (L (n + h i) * C n) ^ 2
  let S₀ : ℝ := ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
    if Nat.ModEq W n b then (L (n + h i) * C n) ^ 2 else 0
  let S : (ℕ × ℕ) → ℝ := fun v =>
    ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
      if Nat.ModEq W n b ∧ v.1 * v.2 ∣ n + h i then
        (L (n + h i) * C n) ^ 2 else 0
  have hE : 0 ≤ E := by
    have hlog : 0 ≤ Real.log x := Real.log_nonneg hx.le
    dsimp only [E]
    positivity
  have hcountSmall : x ^ s * E ≤ η * A := hsmall
  have hEsmall : E ≤ η * A :=
    (le_mul_of_one_le_left hE (Real.one_le_rpow hx.le hs)).trans hcountSmall
  have hmass0 : 0 ≤ pairMass := (hmassx l s).1
  have hmassK : pairMass ≤ K := (hmassx l s).2
  have huMem : ∀ t ∈ u.support, t 0 ∈ q.divisors := fun t ht => (hu t ht).1
  have hzMem : ∀ r ∈ z.support,
      Squarefree (∏ j, r j) ∧ ∀ j, r j ∈ q.divisors :=
    fun r hr => ⟨(hz r hr).1, (hz r hr).2.1⟩
  have hl1 : 2 * (∑ e ∈ Du, |selbergCoefficient u e|) ^ 2 *
      (∑ d ∈ Dz, |selbergCoefficient z d|) ^ 2 ≤ E := by
    by_cases hrc : 0 ≤ r_c
    · have hP (p : ℕ) (hp : p ∈ P) : p.Prime :=
        Nat.prime_of_mem_primesLE (Finset.mem_filter.mp hp).1
      have hqsf : Squarefree q := squarefree_prime_prod P hP
      exact auxiliary_two_radius_l1_bound u z q x r_c ζ_a M N Bx B
        hx hrc hζ_a.le hM hN hBx hB hqsf hu
        (fun r hr => ⟨(hz r hr).1, (hz r hr).2.2⟩) huBound hzBound (hlog hrc)
    · have hz0 : z = 0 := by
        ext r
        by_contra hzr
        have hr : r ∈ z.support := Finsupp.mem_support_iff.mpr hzr
        have hp : (1 : ℝ) ≤ ((∏ j, r j : ℕ) : ℝ) := by
          exact_mod_cast (Nat.pos_of_ne_zero (hz r hr).1.ne_zero)
        have hlt : x ^ r_c < 1 :=
          Real.rpow_lt_one_of_one_lt_of_neg hx (lt_of_not_ge hrc)
        exact (not_lt_of_ge hp) ((hz r hr).2.2.trans_lt hlt)
      have hDz : Dz = ∅ := by
        simp only [Dz, hz0, Finsupp.support_zero, Finset.biUnion_empty]
      simpa only [hDz, Finset.sum_empty, zero_pow (by decide : (2 : ℕ) ≠ 0),
        mul_zero] using hE
  have hmarked (v : ℕ × ℕ) (hv : v ∈ T) :
      |S v - (1 / ((v.1 * v.2 : ℕ) : ℝ)) * (x / (W : ℝ) * mean)| ≤ E := by
    have hbox := (Finset.mem_filter.mp hv).1
    have hp : Nat.Prime v.1 :=
      Nat.prime_of_mem_primesLE (Finset.mem_product.mp hbox).1
    have hq : Nat.Prime v.2 :=
      Nat.prime_of_mem_primesLE (Finset.mem_product.mp hbox).2
    have hmpos : 0 < v.1 * v.2 := Nat.mul_pos hp.pos hq.pos
    have hc := hcop.2 v hv
    have huM : ∀ t ∈ u.support, Nat.Coprime (t 0) (v.1 * v.2) :=
      fun t ht => hc.2.symm.of_dvd_left (Nat.mem_divisors.mp (hu t ht).1).1
    have hzM : ∀ r ∈ z.support, Nat.Coprime (∏ j, r j) (v.1 * v.2) := by
      intro r hr
      exact Nat.Coprime.prod_left fun j _ =>
        hc.2.symm.of_dvd_left (Nat.mem_divisors.mp ((hz r hr).2.1 j)).1
    have hcrt := selberg40_auxiliary_marked_real_interval_crt
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i x κ hx hκ
      u z huMem hzMem (v.1 * v.2) hmpos hc.1.symm huM hzM b
    have hmain : x / ((W : ℝ) * ((v.1 * v.2 : ℕ) : ℝ)) * mean =
        (1 / ((v.1 * v.2 : ℕ) : ℝ)) * (x / (W : ℝ) * mean) := by
      simp only [div_eq_mul_inv, mul_inv]
      ring
    change |S v - x / ((W : ℝ) * ((v.1 * v.2 : ℕ) : ℝ)) * mean| ≤ _ at hcrt
    rw [hmain] at hcrt
    exact hcrt.trans hl1
  have hbin : |(∑ v ∈ T, S v) - pairMass * (x / (W : ℝ) * mean)| ≤ η * A := by
    calc
      _ = |∑ v ∈ T,
          (S v - (1 / ((v.1 * v.2 : ℕ) : ℝ)) * (x / (W : ℝ) * mean))| := by
        rw [Finset.sum_sub_distrib, Finset.sum_mul]
      _ ≤ ∑ v ∈ T,
          |S v - (1 / ((v.1 * v.2 : ℕ) : ℝ)) * (x / (W : ℝ) * mean)| :=
        Finset.abs_sum_le_sum_abs _ _
      _ ≤ ∑ _v ∈ T, E := Finset.sum_le_sum hmarked
      _ = (T.card : ℝ) * E := by simp
      _ ≤ x ^ s * E :=
        mul_le_mul_of_nonneg_right (markedPrimePairBin_card_le x ξ a l s hx) hE
      _ ≤ η * A := hcountSmall
  have hordinary := hphysical.2.2 u z hu hz huBound hzBound b
  have hordinary' : |S₀ - x / (W : ℝ) * mean| ≤ E ∧
      |S₀ - x / (W : ℝ) * harmonic| ≤ η * A := hordinary
  have hmean : |x / (W : ℝ) * mean - x / (W : ℝ) * harmonic| ≤ 2 * η * A := by
    calc
      _ ≤ |x / (W : ℝ) * mean - S₀| + |S₀ - x / (W : ℝ) * harmonic| :=
        abs_sub_le _ _ _
      _ ≤ E + η * A := add_le_add (by
        simpa only [abs_sub_comm] using hordinary'.1) hordinary'.2
      _ ≤ η * A + η * A := add_le_add hEsmall le_rfl
      _ = 2 * η * A := by ring
  have hweighted :
      |pairMass * (x / (W : ℝ) * mean) - pairMass * (x / (W : ℝ) * harmonic)| ≤
        K * (2 * η * A) := by
    rw [← mul_sub, abs_mul, abs_of_nonneg hmass0]
    exact mul_le_mul hmassK hmean (abs_nonneg _) hK.le
  change |(∑ v ∈ T, S v) - pairMass * (x / (W : ℝ) * harmonic)| ≤ ε * A
  calc
    _ ≤ |(∑ v ∈ T, S v) - pairMass * (x / (W : ℝ) * mean)| +
        |pairMass * (x / (W : ℝ) * mean) - pairMass * (x / (W : ℝ) * harmonic)| :=
      abs_sub_le _ _ _
    _ ≤ η * A + K * (2 * η * A) := add_le_add hbin hweighted
    _ = ε * A := by
      dsimp only [η]
      field_simp [hden.ne']
      ring

end PrimeGap186

section
open Set

namespace PrimeGap186

theorem sharp_scalar_cutoff_eq (W : ℕ) (x κ : ℝ) (hx : 1 < x) (hκ : 0 < κ) :
    (((harmonicConfigurationMass W x κ).map
      (fragmentBandMasses (![0, κ] : Fin 2 → ℝ))).map
        (fun v : Fin 1 → ℝ => v 0) : Measure ℝ).real (Set.Iic κ) =
      ∑ a ∈ Finset.Icc 1 ⌊x ^ κ⌋₊,
        if Squarefree a ∧ a.Coprime W then 1 / (a.totient : ℝ) else 0 := by
  classical
  have hcap : 1 ≤ x ^ κ := Real.one_le_rpow hx.le hκ.le
  let D := (∏ p ∈ fragmentPrimes W x κ, p).divisors
  let b := fragmentBandMasses (![0, κ] : Fin 2 → ℝ)
  have hb : Measurable b := measurable_fragmentBandMasses _
  have hset : D.filter (fun s : ℕ => Real.log s / Real.log x ≤ κ) =
      (Finset.Icc 1 ⌊x ^ κ⌋₊).filter (fun s => Squarefree s ∧ s.Coprime W) := by
    ext s
    simp only [Finset.mem_filter, Finset.mem_Icc]
    constructor
    · rintro ⟨hs, hlog⟩
      have hd := (mem_fragment_divisors_iff W x κ hcap s).mp hs
      have hs0 : 0 < (s : ℝ) := by exact_mod_cast Nat.pos_of_ne_zero hd.1.ne_zero
      have hle : (s : ℝ) ≤ x ^ κ :=
        (Real.le_rpow_iff_log_le hs0 (zero_lt_one.trans hx)).mpr
          ((div_le_iff₀ (Real.log_pos hx)).mp hlog)
      exact ⟨⟨Nat.one_le_iff_ne_zero.mpr hd.1.ne_zero,
        (Nat.le_floor_iff (zero_le_one.trans hcap)).mpr hle⟩, hd.1, hd.2.1⟩
    · rintro ⟨⟨hs1, hsle⟩, hsq, hcop⟩
      have hle : (s : ℝ) ≤ x ^ κ :=
        (Nat.le_floor_iff (zero_le_one.trans hcap)).mp hsle
      have hs0 : 0 < (s : ℝ) := by exact_mod_cast Nat.pos_of_ne_zero hsq.ne_zero
      refine ⟨(mem_fragment_divisors_iff W x κ hcap s).mpr ⟨hsq, hcop, ?_⟩, ?_⟩
      · have hmax : max 1 (s.primeFactors.sup id) ≤ s :=
          max_le hs1 (Finset.sup_le fun _ hp => Nat.le_of_mem_primeFactors hp)
        exact (Nat.cast_le.mpr hmax).trans hle
      · rw [div_le_iff₀ (Real.log_pos hx)]
        exact (Real.le_rpow_iff_log_le hs0 (zero_lt_one.trans hx)).mp hle
  have heval (T : Set (FiniteMeasure ℝ)) (hT : MeasurableSet T) :
      (harmonicConfigurationMass W x κ : Measure (FiniteMeasure ℝ)).real T =
        ∑ s ∈ D, if primeLogConfiguration x s ∈ T then (s.totient : ℝ)⁻¹ else 0 := by
    unfold harmonicConfigurationMass
    rw [FiniteMeasure.toMeasure_sum, Measure.real, Measure.finsetSum_apply,
      ENNReal.toReal_sum (by intros; finiteness)]
    apply Finset.sum_congr rfl
    intro s _
    change ((((s.totient : ℝ)⁻¹).toNNReal : ℝ≥0∞) *
      Measure.dirac (primeLogConfiguration x s) T).toReal = _
    simp only [ENNReal.toReal_mul, ENNReal.coe_toReal,
      Real.coe_toNNReal _ (by positivity : 0 ≤ (s.totient : ℝ)⁻¹),
      Measure.dirac_apply' _ hT]
    by_cases hs : primeLogConfiguration x s ∈ T <;> simp [hs]
  change (((harmonicConfigurationMass W x κ).map b).map
    (fun v : Fin 1 → ℝ => v 0) : Measure ℝ).real (Set.Iic κ) = _
  rw [FiniteMeasure.toMeasure_map,
    map_measureReal_apply (measurable_pi_apply 0) measurableSet_Iic,
    FiniteMeasure.toMeasure_map,
    map_measureReal_apply hb ((measurable_pi_apply 0) measurableSet_Iic),
    heval _ (hb ((measurable_pi_apply 0) measurableSet_Iic))]
  calc
    _ = ∑ s ∈ D, if Real.log s / Real.log x ≤ κ then (s.totient : ℝ)⁻¹ else 0 := by
      apply Finset.sum_congr rfl
      intro s hs
      have hm := fragment_divisor_configuration_mass W x κ hx hκ s hs
      simp only [Set.mem_preimage, Set.mem_Iic, b, fragmentBandMasses,
        Fin.castSucc_zero, Fin.succ_zero_eq_one, Matrix.cons_val_zero,
        Matrix.cons_val_one, hm]
    _ = _ := by
      rw [← Finset.sum_filter, hset, Finset.sum_filter]
      simp only [one_div]

theorem sharp_scalar_measure_tendsto (H : Finset ℕ) (κ : ℝ) (hκ : 0 < κ) :
    Tendsto (fun x : ℝ =>
      (((((fragmentNormalization (presievingModulus H x) x)⁻¹).toNNReal •
        (harmonicConfigurationMass (presievingModulus H x) x κ).map
          (fragmentBandMasses (![0, κ] : Fin 2 → ℝ))).map
            (fun v : Fin 1 → ℝ => v 0) : FiniteMeasure ℝ) : Measure ℝ).real (Iic κ))
      atTop (𝓝 κ) := by
  let a : Fin 2 → ℝ := ![0, κ]
  have ha : StrictMono a := by simpa [Fin.strictMono_iff_lt_succ, a] using hκ
  have hm : Measurable (fragmentBandMasses a) := measurable_fragmentBandMasses a
  let P : ProbabilityMeasure (FiniteMeasure ℝ) :=
    ⟨fragmentLaw κ, fragmentLaw_isProbabilityMeasure κ⟩
  let ν := ((Real.exp Real.eulerMascheroniConstant * κ).toNNReal •
    P.toFiniteMeasure.map (fragmentBandMasses a)).map (fun v : Fin 1 → ℝ => v 0)
  let μ (x : ℝ) :=
    (((fragmentNormalization (presievingModulus H x) x)⁻¹).toNNReal •
      (harmonicConfigurationMass (presievingModulus H x) x κ).map
        (fragmentBandMasses a)).map (fun v : Fin 1 → ℝ => v 0)
  have hw : Tendsto μ atTop (𝓝 ν) := by
    apply FiniteMeasure.tendsto_map_of_tendsto_of_continuous _ _ _ (continuous_apply 0)
    simpa only [Real.rpow_one] using
      (harmonic_fragment_band_vector_tendsto H 1 κ a zero_lt_one hκ ha rfl rfl).snd_nhds
  have hν : (ν : Measure ℝ) =
      (volume.restrict (Ici (0 : ℝ))).withDensity
        (fun t => ENNReal.ofReal (dickmanRho (t / κ))) := by
    dsimp only [ν]
    rw [FiniteMeasure.toMeasure_map, FiniteMeasure.toMeasure_smul,
      FiniteMeasure.toMeasure_map,
      Measure.map_smul _ (f := fun v : Fin 1 → ℝ => v 0)
        (measurable_pi_apply 0).aemeasurable,
      Measure.map_map (by fun_prop) hm]
    change ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
      Measure.map (fun c : FiniteMeasure ℝ => ((c.restrict (Ioc (0 : ℝ) κ)).mass : ℝ))
        (fragmentLaw κ) = _
    rw [Measure.map_congr (by
      filter_upwards [ae_restrict_Ioc_fragmentLaw κ] with c hc
      rw [hc])]
    exact normalized_fragmentLaw_mass_eq_dickman κ hκ
  have hνκ : (ν : Measure ℝ) (Iic κ) = ENNReal.ofReal κ := by
    rw [hν, withDensity_apply _ measurableSet_Iic, Measure.restrict_restrict measurableSet_Iic]
    rw [Set.inter_comm, Set.Ici_inter_Iic]
    calc
      (∫⁻ t in Icc (0 : ℝ) κ,
          ENNReal.ofReal (dickmanRho (t / κ))) =
          ∫⁻ _ in Icc (0 : ℝ) κ, (1 : ℝ≥0∞) := by
        apply lintegral_congr_ae
        filter_upwards [ae_restrict_mem measurableSet_Icc] with t ht
        rw [dickmanRho_analytic.2.1 _
          ⟨div_nonneg ht.1 hκ.le, (div_le_one hκ).2 ht.2⟩]
        simp
      _ = ENNReal.ofReal κ := by simp
  have hn : ν ≠ 0 := by
    intro hn
    have h0 : (0 : ℝ≥0∞) = ENNReal.ofReal κ := by simpa [hn] using hνκ
    exact (ENNReal.ofReal_pos.mpr hκ).ne' h0.symm
  have hb : (ν : Measure ℝ) (frontier (Iic κ)) = 0 := by
    rw [hν, frontier_Iic]
    exact measure_singleton κ
  have hb' : (ν.normalize : Measure ℝ) (frontier (Iic κ)) = 0 := by
    rw [ν.toMeasure_normalize_eq_of_nonzero hn,
      Measure.coe_nnreal_smul_apply, hb, mul_zero]
  have hp := ProbabilityMeasure.tendsto_measure_of_null_frontier_of_tendsto
    (FiniteMeasure.tendsto_normalize_of_tendsto hw hn)
    ((ProbabilityMeasure.null_iff_toMeasure_null _ _).2 hb')
  have ht' : Tendsto (fun x => μ x (Iic κ)) atTop (𝓝 (ν (Iic κ))) := by
    simpa only [← FiniteMeasure.self_eq_mass_mul_normalize] using hw.mass.mul hp
  have ht : Tendsto (fun x => (μ x : Measure ℝ).real (Iic κ)) atTop
      (𝓝 ((ν : Measure ℝ).real (Iic κ))) :=
    (NNReal.continuous_coe.tendsto (ν (Iic κ))).comp ht'
  have hr : (ν : Measure ℝ).real (Iic κ) = κ := by
    rw [measureReal_def, hνκ, ENNReal.toReal_ofReal hκ.le]
  simpa only [μ, a, hr] using ht

end PrimeGap186

theorem PrimeGap186.sharp_harmonic_normalizer_tendsto
    (H : Finset ℕ) (κ : ℝ) (hκ : 0 < κ) :
    Filter.Tendsto
      (fun x : ℝ =>
        (∑ a ∈ Finset.Icc 1 ⌊x ^ κ⌋₊,
          if Squarefree a ∧ a.Coprime (PrimeGap186.presievingModulus H x) then
            1 / (a.totient : ℝ) else 0) /
          PrimeGap186.fragmentNormalization (PrimeGap186.presievingModulus H x) x)
      Filter.atTop (𝓝 κ) := by
  classical
  have ht := PrimeGap186.sharp_scalar_measure_tendsto H κ hκ
  apply ht.congr'
  filter_upwards [eventually_gt_atTop (1 : ℝ)] with x hx
  rw [FiniteMeasure.map_smul _ (f := fun v : Fin 1 → ℝ => v 0)
      (measurable_pi_apply 0).aemeasurable,
    FiniteMeasure.toMeasure_smul,
    measureReal_nnreal_smul_apply, PrimeGap186.sharp_scalar_cutoff_eq _ x κ hx hκ]
  have hB : 0 ≤ PrimeGap186.fragmentNormalization (PrimeGap186.presievingModulus H x) x :=
    mul_nonneg (div_nonneg (Nat.cast_nonneg _) (Nat.cast_nonneg _))
      (Real.log_nonneg hx.le)
  rw [Real.coe_toNNReal _ (inv_nonneg.mpr hB)]
  exact (div_eq_inv_mul _ _).symm

end

namespace PrimeGap186

open Classical in
/-- The exact finite identities for the sharp array in Lemma 3.9 of the main paper.
The summation set is the squarefree, coprime integers at most `Z`, not all divisors
of a primorial. The cutoff is assumed nonempty by `1 ≤ Z`. -/
theorem sharp_cutoff_selberg (W : ℕ) (Z : ℝ) (hZ : 1 ≤ Z) :
    let A := (Finset.Icc 1 ⌊Z⌋₊).filter fun a => Squarefree a ∧ Nat.Coprime a W
    let G : ℝ := ∑ a ∈ A, 1 / (a.totient : ℝ)
    let y : (Fin 1 → ℕ) →₀ ℝ :=
      ∑ a ∈ A, Finsupp.single (fun _ : Fin 1 => a) (1 / G)
    let lam : ℕ → ℝ := fun d => selbergCoefficient y (fun _ : Fin 1 => d)
    0 < G ∧ lam 1 = 1 ∧
      (∀ d, lam d = (ArithmeticFunction.moebius d : ℝ) * d / G *
        ∑ a ∈ A, if d ∣ a then 1 / (a.totient : ℝ) else 0) ∧
      (∀ d, d ∉ A → lam d = 0) ∧
      (∀ a, (ArithmeticFunction.moebius a : ℝ) * (a.totient : ℝ) *
        (∑ d ∈ A, if a ∣ d then lam d / (d : ℝ) else 0) =
          if a ∈ A then 1 / G else 0) ∧
      (∑ d ∈ A, ∑ e ∈ A, lam d * lam e / (Nat.lcm d e : ℝ)) = 1 / G ∧
      y.sum (fun r yr => yr ^ 2 / ((r 0).totient : ℝ)) = 1 / G ∧
      y.support = A.image (fun a => fun _ : Fin 1 => a) ∧
      y.support.biUnion (fun r => Fintype.piFinset fun i => (r i).divisors) =
        A.image (fun a => fun _ : Fin 1 => a) ∧
      (∀ r, y r = (if r 0 ∈ A then 1 / G else 0) ∧ |y r| ≤ 1 / G) ∧
      (∀ t : ℕ, 0 < t →
        (∀ p : ℕ, p.Prime → p ∣ t → Z < (p : ℝ)) →
          (∑ d ∈ t.divisors, lam d) = 1) := by
  let : DecidableEq (Fin 1) := fun a b => Classical.propDecidable (a = b)
  intro A G y lam
  let c (a : ℕ) : Fin 1 → ℕ := fun _ => a
  have hc : Function.Injective c := fun _ _ h => congrFun h 0
  have hcr (r : Fin 1 → ℕ) : c (r 0) = r := by
    funext i
    exact congrArg r (Subsingleton.elim 0 i)
  have hA1 : 1 ∈ A := by
    simp only [A, Finset.mem_filter, Finset.mem_Icc, le_refl, true_and,
      squarefree_one, Nat.coprime_one_left_iff, and_true]
    exact (Nat.one_le_floor_iff Z).mpr hZ
  have hG : 0 < G := by
    apply Finset.sum_pos' (fun a _ => by positivity)
    exact ⟨1, hA1, by norm_num⟩
  have hdown {a d : ℕ} (ha : a ∈ A) (hda : d ∣ a) : d ∈ A := by
    obtain ⟨haI, hsf, hcop⟩ := Finset.mem_filter.mp ha
    refine Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr ⟨?_, ?_⟩,
      hsf.squarefree_of_dvd hda, hcop.coprime_dvd_left hda⟩
    · exact Nat.one_le_iff_ne_zero.mpr (ne_zero_of_dvd_ne_zero hsf.ne_zero hda)
    · exact (Nat.le_of_dvd hsf.ne_zero.bot_lt hda).trans (Finset.mem_Icc.mp haI).2
  have hyapply (r : Fin 1 → ℕ) :
      y r = if r 0 ∈ A then 1 / G else 0 := by
    have heq (a : ℕ) : (fun _ : Fin 1 => a) = r ↔ a = r 0 := by
      change c a = r ↔ a = r 0
      rw [← hcr r]
      exact hc.eq_iff
    simp only [y, Finsupp.finsetSum_apply, Finsupp.single_apply, heq, Finset.sum_ite_eq']
  have hsupp : y.support = A.image c := by
    ext r
    rw [Finsupp.mem_support_iff, hyapply]
    constructor
    · intro hr
      have hmem : r 0 ∈ A := by
        by_contra hnot
        simp [hnot] at hr
      exact Finset.mem_image.mpr ⟨r 0, hmem, hcr r⟩
    · intro hr
      obtain ⟨a, ha, rfl⟩ := Finset.mem_image.mp hr
      simp [c, ha, hG.ne']
  have hysf : ∀ r ∈ y.support, Squarefree (∏ i, r i) := by
    intro r hr
    obtain ⟨a, ha, rfl⟩ := Finset.mem_image.mp (hsupp ▸ hr)
    simpa [c] using (Finset.mem_filter.mp ha).2.1
  have hD : y.support.biUnion
      (fun r => Fintype.piFinset fun i => (r i).divisors) = A.image c := by
    ext d
    simp only [Finset.mem_biUnion]
    constructor
    · rintro ⟨r, hr, hdr⟩
      obtain ⟨a, ha, rfl⟩ := Finset.mem_image.mp (hsupp ▸ hr)
      exact Finset.mem_image.mpr ⟨d 0,
        hdown ha (Nat.dvd_of_mem_divisors (Fintype.mem_piFinset.mp hdr 0)), hcr d⟩
    · intro hd
      obtain ⟨a, ha, rfl⟩ := Finset.mem_image.mp hd
      refine ⟨c a, hsupp.symm ▸ Finset.mem_image.mpr ⟨a, ha, rfl⟩,
        Fintype.mem_piFinset.mpr ?_⟩
      intro i
      exact Nat.mem_divisors.mpr ⟨dvd_rfl, (Finset.mem_filter.mp ha).2.1.ne_zero⟩
  have hlam (d : ℕ) : lam d = (ArithmeticFunction.moebius d : ℝ) * d / G *
      ∑ a ∈ A, if d ∣ a then 1 / (a.totient : ℝ) else 0 := by
    dsimp only [lam]
    simp only [selbergCoefficient, Fin.prod_univ_one, Finsupp.sum]
    rw [hsupp, Finset.sum_image hc.injOn, Finset.mul_sum, Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro a ha
    rw [hyapply]
    simp only [c, ha, ite_true, forall_const]
    split_ifs <;> ring
  have hlam1 : lam 1 = 1 := by
    rw [hlam]
    simp only [ArithmeticFunction.moebius_apply_one, Int.cast_one, Nat.cast_one,
      one_mul, one_dvd, ite_true]
    change 1 / G * G = 1
    field_simp [hG.ne']
  have hdiag : y.sum (fun r yr => yr ^ 2 / (∏ i, ((r i).totient : ℝ))) =
      1 / G := by
    calc
      _ = ∑ a ∈ A, (1 / G) ^ 2 / (a.totient : ℝ) := by
        rw [Finsupp.sum, hsupp, Finset.sum_image hc.injOn]
        apply Finset.sum_congr rfl
        intro a ha
        rw [hyapply]
        simp [c, ha]
      _ = (1 / G) ^ 2 * G := by
        rw [Finset.mul_sum]
        apply Finset.sum_congr rfl
        intro a _
        ring
      _ = 1 / G := by field_simp [hG.ne']
  have hvanish (d : ℕ) (hd : d ∉ A) : lam d = 0 := by
    rw [hlam]
    have hz : (∑ a ∈ A, if d ∣ a then 1 / (a.totient : ℝ) else 0) = 0 := by
      apply Finset.sum_eq_zero
      intro a ha
      exact ite_eq_right (fun hda => hd (hdown ha hda))
    rw [hz, mul_zero]
  refine ⟨hG, hlam1, hlam, hvanish, ?_, ?_, ?_, hsupp, ?_, ?_, ?_⟩
  · intro a
    have h := selberg_forward_inverse y hysf (c a)
    dsimp only at h
    rw [hD, Finset.sum_image hc.injOn, hyapply] at h
    simpa only [Fin.prod_univ_one, c, forall_const] using h
  · have h := selberg_unrestricted_lcm_diagonal y hysf
    dsimp only at h
    rw [hD, Finset.sum_image hc.injOn] at h
    simp_rw [Finset.sum_image hc.injOn] at h
    simpa only [Fin.prod_univ_one, c] using h.trans hdiag
  · simpa only [Fin.prod_univ_one] using hdiag
  · convert hD using 1
    ext r
    simp only [Finset.mem_biUnion, Fintype.mem_piFinset]
  · intro r
    refine ⟨hyapply r, ?_⟩
    rw [hyapply]
    split_ifs
    · exact le_of_eq (abs_of_pos (one_div_pos.mpr hG))
    · simpa only [abs_zero] using (one_div_pos.mpr hG).le
  · intro t ht hrough
    rw [Finset.sum_eq_single 1]
    · exact hlam1
    · intro d hd hd1
      apply hvanish d
      intro ha
      obtain ⟨p, hp, hpd⟩ := Nat.exists_prime_and_dvd hd1
      have hsf := (Finset.mem_filter.mp ha).2.1
      have hdZ : (d : ℝ) ≤ Z :=
        (Nat.le_floor_iff (zero_le_one.trans hZ)).mp
          (Finset.mem_Icc.mp (Finset.mem_filter.mp ha).1).2
      have hpZ : (p : ℝ) ≤ Z :=
        (Nat.cast_le.mpr (Nat.le_of_dvd hsf.ne_zero.bot_lt hpd)).trans hdZ
      exact (not_lt_of_ge hpZ)
        (hrough p hp (hpd.trans (Nat.dvd_of_mem_divisors hd)))
    · intro hnot
      exact False.elim (hnot (Nat.one_mem_divisors.mpr ht.ne'))

open Classical in
/-- The sharp Selberg family used by the marked-bin bound and the exceptional term. -/
theorem sharp_auxiliary_family (H : Finset ℕ) (κ ξ : ℝ)
    (hκ : 0 < κ) (hκξ : κ < ξ) :
    let W : ℝ → ℕ := presievingModulus H
    let Bx : ℝ → ℝ := fun x => fragmentNormalization (W x) x
    let qa : ℝ → ℕ := fun x => ∏ p ∈ fragmentPrimes (W x) x κ, p
    let A : ℝ → Finset ℕ := fun x =>
      (Finset.Icc 1 ⌊x ^ κ⌋₊).filter fun a => Squarefree a ∧ Nat.Coprime a (W x)
    let G : ℝ → ℝ := fun x => ∑ a ∈ A x, 1 / (a.totient : ℝ)
    let u : ℝ → ((Fin 1 → ℕ) →₀ ℝ) := fun x =>
      ∑ a ∈ A x, Finsupp.single (fun _ : Fin 1 => a) (1 / G x)
    let Du : ℝ → Finset (Fin 1 → ℕ) := fun x => (u x).support.biUnion
      (fun r => Fintype.piFinset fun j => (r j).divisors)
    let L : ℝ → ℕ → ℝ := fun x t =>
      ∑ e ∈ Du x, if e 0 ∣ t then selbergCoefficient (u x) e else 0
    Tendsto (fun x => Bx x * (u x).sum (fun r ur => ur ^ 2 / ((r 0).totient : ℝ)))
        atTop (𝓝 (1 / κ)) ∧
      (∃ N : ℝ, 0 ≤ N ∧ ∀ᶠ x : ℝ in atTop,
        1 < x ∧ 0 < Bx x ∧ (∀ r, |u x r| ≤ N / Bx x) ∧
          ∀ r ∈ (u x).support, r 0 ∈ (qa x).divisors ∧ (r 0 : ℝ) ≤ x ^ κ) ∧
      ∀ᶠ x : ℝ in atTop, ∀ t : ℕ,
        (∀ p : ℕ, p.Prime → p ∣ t → x ^ ξ ≤ (p : ℝ)) → L x t = 1 := by
  intro W Bx qa A G u Du L
  have hnormal : Tendsto (fun x => G x / Bx x) atTop (𝓝 κ) := by
    simpa only [G, A, Bx, W, Finset.sum_filter] using
      sharp_harmonic_normalizer_tendsto H κ hκ
  have hfinite (x : ℝ) (hx : 1 < x) :=
    sharp_cutoff_selberg (W x) (x ^ κ) (Real.one_le_rpow hx.le hκ.le)
  have hlower : ∀ᶠ x : ℝ in atTop, κ / 2 < G x / Bx x :=
    hnormal.eventually (lt_mem_nhds (half_lt_self hκ))
  refine ⟨?_, ?_, ?_⟩
  · have hinv : Tendsto (fun x => Bx x / G x) atTop (𝓝 (1 / κ)) := by
      simpa only [inv_div, one_div] using hnormal.inv₀ hκ.ne'
    apply hinv.congr'
    filter_upwards [eventually_gt_atTop (1 : ℝ)] with x hx
    obtain ⟨_, _, _, _, _, _, hdiag, _, _, _, _⟩ := hfinite x hx
    change (u x).sum (fun r ur => ur ^ 2 / ((r 0).totient : ℝ)) = 1 / G x at hdiag
    rw [hdiag]
    ring
  · refine ⟨2 / κ, div_nonneg (by norm_num) hκ.le, ?_⟩
    filter_upwards [eventually_gt_atTop (1 : ℝ), hlower] with x hx hlowerx
    obtain ⟨hG, _, _, _, _, _, _, hsupp, _, harray, _⟩ := hfinite x hx
    change 0 < G x at hG
    have hBx : 0 < Bx x :=
      (div_pos_iff_of_pos_left hG).mp ((half_pos hκ).trans hlowerx)
    have hrecip : 1 / G x ≤ (2 / κ) / Bx x := by
      calc
        _ ≤ 1 / ((κ / 2) * Bx x) :=
          one_div_le_one_div_of_le (mul_pos (half_pos hκ) hBx)
            ((lt_div_iff₀ hBx).mp hlowerx).le
        _ = (2 / κ) / Bx x := by field_simp
    refine ⟨hx, hBx, fun r => ((harray r).2).trans hrecip, ?_⟩
    intro r hr
    obtain ⟨a, ha, rfl⟩ := Finset.mem_image.mp (hsupp ▸ hr)
    obtain ⟨haI, hsf, hcop⟩ := Finset.mem_filter.mp ha
    have hcap : 1 ≤ x ^ κ := Real.one_le_rpow hx.le hκ.le
    have haZ : (a : ℝ) ≤ x ^ κ :=
      (Nat.le_floor_iff (zero_le_one.trans hcap)).mp (Finset.mem_Icc.mp haI).2
    refine ⟨(mem_fragment_divisors_iff (W x) x κ hcap a).mpr ⟨hsf, hcop, ?_⟩, haZ⟩
    have hmax : max 1 (a.primeFactors.sup id) ≤ a :=
      max_le (Finset.mem_Icc.mp haI).1
        (Finset.sup_le fun _ hp => Nat.le_of_mem_primeFactors hp)
    exact (Nat.cast_le.mpr hmax).trans haZ
  · filter_upwards [eventually_gt_atTop (1 : ℝ),
      (tendsto_rpow_atTop (hκ.trans hκξ)).eventually_gt_atTop 2] with x hx hlarge
    obtain ⟨_, _, _, hvanish, _, _, _, _, hD, _, hrough⟩ := hfinite x hx
    intro t ht
    have htpos : 0 < t := by
      apply Nat.pos_of_ne_zero
      intro ht0
      subst t
      exact (not_le_of_gt hlarge) (ht 2 Nat.prime_two (dvd_zero 2))
    have hsharp : ∀ p : ℕ, p.Prime → p ∣ t → x ^ κ < (p : ℝ) :=
      fun p hp hpt => (Real.rpow_lt_rpow_of_exponent_lt hx hκξ).trans_le (ht p hp hpt)
    have hsum := hrough t htpos hsharp
    let lam (d : ℕ) : ℝ := selbergCoefficient (u x) (fun _ : Fin 1 => d)
    change (∑ d ∈ t.divisors, lam d) = 1 at hsum
    change (∑ e ∈ Du x, if e 0 ∣ t then selbergCoefficient (u x) e else 0) = 1
    dsimp only [Du]
    rw [hD, Finset.sum_image (fun a _ b _ hab => congrFun hab 0)]
    change (∑ d ∈ A x, if d ∣ t then lam d else 0) = 1
    rw [← Finset.sum_filter]
    calc
      _ = ∑ d ∈ t.divisors, lam d := by
        apply Finset.sum_subset
        · intro d hd
          exact Nat.mem_divisors.mpr ⟨(Finset.mem_filter.mp hd).2, htpos.ne'⟩
        · intro d hd hnot
          apply hvanish d
          intro hdA
          exact hnot (Finset.mem_filter.mpr ⟨hdA, Nat.dvd_of_mem_divisors hd⟩)
      _ = 1 := hsum

open scoped ContDiff
open Classical in
theorem canonical_and_erased_auxiliary_marked_bin_physical_square
    {𝓗 : Finset ℕ} {h𝓗_card : 𝓗.card = 40}
    {m : ℕ} (i : Fin 40) (r_c ζ_a l s : ℝ)
    (hζ_a : 0 < ζ_a) (hζrough : ζ_a < (9519 : ℝ) / 50000)
    (hl : 2 * ((9519 : ℝ) / 50000) ≤ l) (hls : l < s)
    (hs : s ≤ (40481 : ℝ) / 100000)
    (hmargin : s + 2 * (r_c + ζ_a) < 1)
    (a : Fin (m + 2) → ℝ) (ha : StrictMono a) (ha0 : a 0 = 0)
    (haLast : a (Fin.last (m + 1)) =
      ((19037 : ℝ) / 100000) / ((2624989 : ℝ) / 10000000))
    (G : (Fin 39 → Fin (m + 1) → ℝ) → ℝ)
    (F : (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
    (hG : Measurable G) (hF : Measurable F)
    (hbG : Bornology.IsBounded (Set.range G))
    (hbF : Bornology.IsBounded (Set.range F))
    (u : ℝ → ((Fin 1 → ℕ) →₀ ℝ)) (E_a : ℝ) :
    let ρ : ℝ := 2624989 / 10000000
    let ξ₀ : ℝ := 19037 / 100000
    let ζ : ℝ := ξ₀ / ρ
    let ν : Measure (Fin (m + 1) → ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * ζ) •
        Measure.map (fragmentBandMasses a)
          (fragmentLaw ζ)
    (∀ᵐ X ∂Measure.pi (fun _ : Fin 39 => ν), ContinuousAt G X) →
    (∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => ν), ContinuousAt F X) →
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    let W : ℝ → ℕ := presievingModulus 𝓗
    let R : ℝ → ℝ := fun x => x ^ ρ
    let Bx : ℝ → ℝ := fun x => fragmentNormalization (W x) x
    let BR : ℝ → ℝ := fun x => fragmentNormalization (W x) (R x)
    let q : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) (R x) ζ, p
    let T39 : ℝ → Finset (Fin 39 → ℕ) := fun x =>
      (Fintype.piFinset (fun _ : Fin 39 => (q x).divisors)).filter
        (fun r => Squarefree (∏ j, r j))
    let T40 : ℝ → Finset (Fin 40 → ℕ) := fun x =>
      (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
        (fun r => Squarefree (∏ j, r j))
    let X : ℝ → ℕ → Fin (m + 1) → ℝ := fun x s =>
      fragmentBandMasses a
        (primeLogConfiguration (R x) s)
    let w : ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun x =>
      ∑ r ∈ T39 x, Finsupp.single r (G (fun j => X x (r j)) / BR x ^ 39)
    let y : ℝ → ((Fin 40 → ℕ) →₀ ℝ) := fun x =>
      ∑ r ∈ T40 x, Finsupp.single r (F (fun j => X x (r j)) / BR x ^ 40)
    let z : ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun x =>
      w x + (y x).sum (fun r yr =>
        Finsupp.single (fun j => r (i.succAbove j)) (yr / ((r i).totient : ℝ)))
    let qa : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) x ζ_a, p
    let Du : ℝ → Finset (Fin 1 → ℕ) := fun x =>
      (u x).support.biUnion
        (fun s => Fintype.piFinset (fun j => (s j).divisors))
    let Dz : ℝ → Finset (Fin 39 → ℕ) := fun x =>
      (z x).support.biUnion
        (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let L : ℝ → ℕ → ℝ := fun x t =>
      ∑ e ∈ Du x, if e 0 ∣ t then PrimeGap186.selbergCoefficient (u x) e else 0
    let C : ℝ → ℕ → ℝ := fun x n =>
      ∑ d ∈ Dz x, if ∀ j, d j ∣ n + h (i.succAbove j) then
        PrimeGap186.selbergCoefficient (z x) d else 0
    let H : (Fin 39 → Fin (m + 1) → ℝ) → ℝ := fun Y =>
      G Y + ∫ t : Fin (m + 1) → ℝ, F (i.insertNth t Y) ∂ν
    (∃ N : ℝ, 0 ≤ N ∧ ∀ᶠ x : ℝ in Filter.atTop,
      1 < x ∧ 0 < Bx x ∧
        (∀ t : Fin 1 → ℕ, |u x t| ≤ N / Bx x) ∧
        ∀ t ∈ (u x).support, t 0 ∈ (qa x).divisors ∧ (t 0 : ℝ) ≤ x ^ ζ_a) →
    Tendsto (fun x => Bx x * (u x).sum
      (fun t ut => ut ^ 2 / ((t 0).totient : ℝ))) atTop (nhds E_a) →
    (∀ᶠ x : ℝ in Filter.atTop,
      ∀ d : Fin 39 → ℕ,
        (PrimeGap186.selbergCoefficient (w x) d ≠ 0 ∨
          PrimeGap186.selbergCoefficient (y x) (i.insertNth 1 d) ≠ 0) →
        ((∏ j, d j : ℕ) : ℝ) ≤ x ^ r_c) →
    ∀ ε : ℝ, 0 < ε →
      ∀ᶠ x : ℝ in Filter.atTop,
        ∀ b : ℕ,
          |(∑ v ∈ markedPrimePairBin x ((9519 : ℝ) / 50000)
                ((40481 : ℝ) / 100000) l s,
              ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
                if Nat.ModEq (W x) n b ∧ v.1 * v.2 ∣ n + h i then
                  L x (n + h i) ^ 2 * C x n ^ 2 else 0) -
            (x / (W x : ℝ) / Bx x / BR x ^ 39) *
              ((∫ t in l..s,
                  Real.log ((t - (9519 : ℝ) / 50000) / ((9519 : ℝ) / 50000)) / t) *
                ((∫ Y : Fin 39 → Fin (m + 1) → ℝ, H Y ^ 2
                    ∂Measure.pi (fun _ : Fin 39 => ν)) *
                  E_a))| ≤
            ε * (x / (W x : ℝ) / Bx x / BR x ^ 39) := by
  intro ρ ξ₀ ζ ν cG cF h W R Bx BR q T39 T40 X w y z qa Du Dz L C H
    hauxData hulim hsourceRadius
  have hρ : 0 < ρ := by norm_num [ρ]
  have hζ : 0 < ζ := by norm_num [ζ, ξ₀, ρ]
  let κ : ℝ := max ζ (ζ_a / ρ)
  have hκ : 0 < κ := hζ.trans_le (le_max_left _ _)
  have hcap : ρ * κ < (9519 : ℝ) / 50000 := by
    dsimp only [κ]
    rw [mul_max_of_nonneg _ _ hρ.le]
    apply max_lt
    · norm_num [ζ, ξ₀, ρ]
    · rw [← mul_div_assoc, mul_div_cancel_left₀ _ hρ.ne']
      exact hζrough
  obtain ⟨M, hM, hamp⟩ :=
    canonical_and_erased_diagonal_amplitude (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i ζ hζ a G F hbG hbF
  obtain ⟨N, hN, haux⟩ := hauxData
  have hzlim : Tendsto
      (fun x => BR x ^ 39 * (z x).sum
        (fun r zr => zr ^ 2 / (∏ j, ((r j).totient : ℝ)))) atTop
      (nhds (∫ Y, H Y ^ 2 ∂Measure.pi (fun _ : Fin 39 => ν))) := by
    have hraw := canonical_and_erased_polarized_harmonic_tendsto (𝓗 := 𝓗)
      i ζ hζ a ha ha0 haLast G G F F hG hG hF hF hbG hbG hbF hbF cG cG cF cF
    change Tendsto
      (fun x => BR x ^ 39 * (z x).sum
        (fun r zr => zr * z x r / (∏ j, ((r j).totient : ℝ)))) atTop
      (nhds (∫ Y, H Y * H Y ∂Measure.pi (fun _ : Fin 39 => ν))) at hraw
    simpa only [Finsupp.sum, pow_two] using hraw
  have hharmonic : Tendsto
      (fun x => (Bx x * BR x ^ 39) *
        ((u x).sum (fun t ut => ut ^ 2 / ((t 0).totient : ℝ)) *
          (z x).sum (fun r zr => zr ^ 2 / (∏ j, ((r j).totient : ℝ)))))
      atTop (nhds ((∫ Y, H Y ^ 2 ∂Measure.pi (fun _ : Fin 39 => ν)) * E_a)) := by
    convert hzlim.mul hulim using 1
    funext x
    ring
  let pairMass : ℝ → ℝ := fun x =>
    ∑ v ∈ markedPrimePairBin x ((9519 : ℝ) / 50000)
        ((40481 : ℝ) / 100000) l s, (((v.1 * v.2 : ℕ) : ℝ))⁻¹
  let pairI : ℝ := ∫ t in l..s,
    Real.log ((t - (9519 : ℝ) / 50000) / ((9519 : ℝ) / 50000)) / t
  have hpair : Tendsto pairMass atTop (nhds pairI) :=
    markedPrimePairBin_harmonic_tendsto l s hl hls hs
  let S : ℝ → ℕ → ℝ := fun x b =>
    ∑ v ∈ markedPrimePairBin x ((9519 : ℝ) / 50000)
        ((40481 : ℝ) / 100000) l s,
      ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        if Nat.ModEq (W x) n b ∧ v.1 * v.2 ∣ n + h i then
          L x (n + h i) ^ 2 * C x n ^ 2 else 0
  let A : ℝ → ℝ := fun x => x / (W x : ℝ)
  let B : ℝ → ℝ := fun x => Bx x * BR x ^ 39
  let E₀ : ℝ → ℝ := fun x =>
    (u x).sum (fun t ut => ut ^ 2 / ((t 0).totient : ℝ)) *
      (z x).sum (fun r zr => zr ^ 2 / (∏ j, ((r j).totient : ℝ)))
  let E : ℝ → ℝ := fun x => pairMass x * E₀ x
  let I₀ : ℝ :=
    (∫ Y, H Y ^ 2 ∂Measure.pi (fun _ : Fin 39 => ν)) *
      E_a
  let I : ℝ := pairI * I₀
  have hlim : Tendsto (fun x => B x * E x) atTop (nhds I) := by
    have hbase : Tendsto (fun x => B x * E₀ x) atTop (nhds I₀) := hharmonic
    convert hpair.mul hbase using 1
    funext x
    exact mul_left_comm _ _ _
  have hpos : ∀ᶠ x : ℝ in atTop, 0 ≤ A x ∧ 0 < B x := by
    filter_upwards [hamp, haux] with x hampx hauxx
    obtain ⟨hx, hBR, _, _, _, _, _, _, _, _⟩ := hampx
    obtain ⟨_, hBx, _, _⟩ := hauxx
    exact ⟨div_nonneg (zero_lt_one.trans hx).le (Nat.cast_nonneg _),
      mul_pos hBx (pow_pos hBR 39)⟩
  have harithmetic : ∀ ε : ℝ, 0 < ε →
      ∀ᶠ x : ℝ in atTop, ∀ b : ℕ,
        |S x b - A x * E x| ≤ ε * (A x / B x) := by
    intro ε hε
    have hcomparison := selberg40_auxiliary_marked_bin_uniform (𝓗 := 𝓗) (h𝓗_card := h𝓗_card)
      i κ r_c ζ_a M N ((9519 : ℝ) / 50000) ((40481 : ℝ) / 100000) l s
      hκ hζ_a hM.le hN (by norm_num) (by norm_num) (by linarith) hcap hmargin ε hε
    filter_upwards [hamp, haux, hsourceRadius, hcomparison]
      with x hampx hauxx hradx hcompx
    obtain ⟨hx, _, _, _, _, _, _, hzcoeff, hzsupport, hzbound⟩ := hampx
    obtain ⟨_, _, hubound, husupport⟩ := hauxx
    have hcommon := fragment_divisors_common_cap
      (W x) x ρ ζ ζ_a hx hρ
    have hzradius : ∀ r ∈ (z x).support,
        ((∏ j, r j : ℕ) : ℝ) ≤ x ^ r_c := by
      apply selberg_diagonal_support_le_of_coefficient_le
        (z x) (fun r hr => (hzsupport r hr).1) (x ^ r_c)
      intro d hd
      apply hradx d
      by_cases hwzero : selbergCoefficient (w x) d = 0
      · right
        intro hyzero
        apply hd
        rw [hzcoeff d, hwzero, hyzero, add_zero]
      · exact Or.inl hwzero
    have hucommon : ∀ t ∈ (u x).support,
        t 0 ∈ (∏ p ∈ fragmentPrimes (W x) (R x) κ, p).divisors ∧
          (t 0 : ℝ) ≤ x ^ ζ_a := by
      intro t ht
      exact ⟨hcommon.2 (husupport t ht).1, (husupport t ht).2⟩
    have hzcommon : ∀ r ∈ (z x).support,
        Squarefree (∏ j, r j) ∧
          (∀ j, r j ∈
            (∏ p ∈ fragmentPrimes (W x) (R x) κ, p).divisors) ∧
          ((∏ j, r j : ℕ) : ℝ) ≤ x ^ r_c := by
      intro r hr
      exact ⟨(hzsupport r hr).1, fun j => hcommon.1 ((hzsupport r hr).2 j),
        hzradius r hr⟩
    intro b
    have hb := hcompx.2.2.2 (u x) (z x) hucommon hzcommon hubound hzbound b
    have heq : pairMass x * (A x * E₀ x) = A x * E x :=
      mul_left_comm _ _ _
    rw [← heq]
    simpa only [S, A, B, E₀, pairMass, mul_pow, one_div, div_mul_eq_div_div] using hb
  have hfinal := uniform_scaled_error_of_normalized_tendsto
    S A B E I hpos hlim harithmetic
  simpa only [S, A, B, I, I₀, pairI, div_mul_eq_div_div] using hfinal

open Classical in
theorem canonical_and_erased_auxiliary_marked_bin_physical_square_finset
    {𝓗 : Finset ℕ} {h𝓗_card : 𝓗.card = 40}
    {J : Type*} {m : ℕ} (𝒥 : Finset J) (c : J → ℝ)
    (i : Fin 40) (r_c ζ_a l s : ℝ)
    (hζ_a : 0 < ζ_a) (hζrough : ζ_a < (9519 : ℝ) / 50000)
    (hl : 2 * ((9519 : ℝ) / 50000) ≤ l) (hls : l < s)
    (hs : s ≤ (40481 : ℝ) / 100000)
    (hmargin : s + 2 * (r_c + ζ_a) < 1)
    (a : Fin (m + 2) → ℝ) (ha : StrictMono a) (ha0 : a 0 = 0)
    (haLast : a (Fin.last (m + 1)) =
      ((19037 : ℝ) / 100000) / ((2624989 : ℝ) / 10000000))
    (G : J → (Fin 39 → Fin (m + 1) → ℝ) → ℝ)
    (F : J → (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
    (hG : ∀ j ∈ 𝒥, Measurable (G j)) (hF : ∀ j ∈ 𝒥, Measurable (F j))
    (hbG : ∀ j ∈ 𝒥, Bornology.IsBounded (Set.range (G j)))
    (hbF : ∀ j ∈ 𝒥, Bornology.IsBounded (Set.range (F j)))
    (u : ℝ → ((Fin 1 → ℕ) →₀ ℝ)) (E_a : ℝ) :
    let ρ : ℝ := 2624989 / 10000000
    let ξ₀ : ℝ := 19037 / 100000
    let ζ : ℝ := ξ₀ / ρ
    let ν : Measure (Fin (m + 1) → ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * ζ) •
        Measure.map (fragmentBandMasses a)
          (fragmentLaw ζ)
    (∀ j ∈ 𝒥, ∀ᵐ X ∂Measure.pi (fun _ : Fin 39 => ν), ContinuousAt (G j) X) →
    (∀ j ∈ 𝒥, ∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => ν), ContinuousAt (F j) X) →
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    let W : ℝ → ℕ := presievingModulus 𝓗
    let R : ℝ → ℝ := fun x => x ^ ρ
    let Bx : ℝ → ℝ := fun x => fragmentNormalization (W x) x
    let BR : ℝ → ℝ := fun x => fragmentNormalization (W x) (R x)
    let q : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) (R x) ζ, p
    let T39 : ℝ → Finset (Fin 39 → ℕ) := fun x =>
      (Fintype.piFinset (fun _ : Fin 39 => (q x).divisors)).filter
        (fun r => Squarefree (∏ k, r k))
    let T40 : ℝ → Finset (Fin 40 → ℕ) := fun x =>
      (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
        (fun r => Squarefree (∏ k, r k))
    let X : ℝ → ℕ → Fin (m + 1) → ℝ := fun x t =>
      fragmentBandMasses a
        (primeLogConfiguration (R x) t)
    let w : J → ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun j x =>
      ∑ r ∈ T39 x, Finsupp.single r (G j (fun k => X x (r k)) / BR x ^ 39)
    let y : J → ℝ → ((Fin 40 → ℕ) →₀ ℝ) := fun j x =>
      ∑ r ∈ T40 x, Finsupp.single r (F j (fun k => X x (r k)) / BR x ^ 40)
    let z : J → ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun j x =>
      w j x + (y j x).sum (fun r yr =>
        Finsupp.single (fun k => r (i.succAbove k)) (yr / ((r i).totient : ℝ)))
    let qa : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) x ζ_a, p
    let Du : ℝ → Finset (Fin 1 → ℕ) := fun x =>
      (u x).support.biUnion
        (fun t => Fintype.piFinset (fun k => (t k).divisors))
    let Dz : J → ℝ → Finset (Fin 39 → ℕ) := fun j x =>
      (z j x).support.biUnion
        (fun r => Fintype.piFinset (fun k => (r k).divisors))
    let L : ℝ → ℕ → ℝ := fun x t =>
      ∑ e ∈ Du x, if e 0 ∣ t then PrimeGap186.selbergCoefficient (u x) e else 0
    let C : ℝ → ℕ → ℝ := fun x n =>
      ∑ j ∈ 𝒥, c j *
        (∑ d ∈ Dz j x, if ∀ k, d k ∣ n + h (i.succAbove k) then
          PrimeGap186.selbergCoefficient (z j x) d else 0)
    let H : (Fin 39 → Fin (m + 1) → ℝ) → ℝ := fun Y =>
      ∑ j ∈ 𝒥, c j *
        (G j Y + ∫ t : Fin (m + 1) → ℝ, F j (i.insertNth t Y) ∂ν)
    (∃ N : ℝ, 0 ≤ N ∧ ∀ᶠ x : ℝ in Filter.atTop,
      1 < x ∧ 0 < Bx x ∧
        (∀ t : Fin 1 → ℕ, |u x t| ≤ N / Bx x) ∧
        ∀ t ∈ (u x).support, t 0 ∈ (qa x).divisors ∧ (t 0 : ℝ) ≤ x ^ ζ_a) →
    Tendsto (fun x => Bx x * (u x).sum
      (fun t ut => ut ^ 2 / ((t 0).totient : ℝ))) atTop (nhds E_a) →
    (∀ j ∈ 𝒥, ∀ᶠ x : ℝ in Filter.atTop,
      ∀ d : Fin 39 → ℕ,
        (PrimeGap186.selbergCoefficient (w j x) d ≠ 0 ∨
          PrimeGap186.selbergCoefficient (y j x) (i.insertNth 1 d) ≠ 0) →
        ((∏ k, d k : ℕ) : ℝ) ≤ x ^ r_c) →
    ∀ ε : ℝ, 0 < ε →
      ∀ᶠ x : ℝ in Filter.atTop,
        ∀ b : ℕ,
          |(∑ v ∈ markedPrimePairBin x ((9519 : ℝ) / 50000)
                ((40481 : ℝ) / 100000) l s,
              ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
                if Nat.ModEq (W x) n b ∧ v.1 * v.2 ∣ n + h i then
                  L x (n + h i) ^ 2 * C x n ^ 2 else 0) -
            (x / (W x : ℝ) / Bx x / BR x ^ 39) *
              ((∫ t in l..s,
                  Real.log ((t - (9519 : ℝ) / 50000) / ((9519 : ℝ) / 50000)) / t) *
                ((∫ Y : Fin 39 → Fin (m + 1) → ℝ, H Y ^ 2
                    ∂Measure.pi (fun _ : Fin 39 => ν)) *
                  E_a))| ≤
            ε * (x / (W x : ℝ) / Bx x / BR x ^ 39) := by
  intro ρ ξ₀ ζ ν cG cF h W R Bx BR q T39 T40 X w y z qa Du Dz L C H
    hauxData hulim hsourceRadius
  let Gsum : (Fin 39 → Fin (m + 1) → ℝ) → ℝ :=
    fun Y => ∑ j ∈ 𝒥, c j * G j Y
  let Fsum : (Fin 40 → Fin (m + 1) → ℝ) → ℝ :=
    fun Y => ∑ j ∈ 𝒥, c j * F j Y
  obtain ⟨hGsum, hbGsum, hcGsum⟩ := finite_profile_combination_regular
    (Measure.pi (fun _ : Fin 39 => ν)) 𝒥 c G hG hbG cG
  obtain ⟨hFsum, hbFsum, hcFsum⟩ := finite_profile_combination_regular
    (Measure.pi (fun _ : Fin 40 => ν)) 𝒥 c F hF hbF cF
  let wsum : ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun x =>
    ∑ r ∈ T39 x, Finsupp.single r (Gsum (fun k => X x (r k)) / BR x ^ 39)
  let ysum : ℝ → ((Fin 40 → ℕ) →₀ ℝ) := fun x =>
    ∑ r ∈ T40 x, Finsupp.single r (Fsum (fun k => X x (r k)) / BR x ^ 40)
  let zsum : ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun x =>
    wsum x + (ysum x).sum (fun r yr =>
      Finsupp.single (fun k => r (i.succAbove k)) (yr / ((r i).totient : ℝ)))
  let Csum : ℝ → ℕ → ℝ := fun x n =>
    ∑ d ∈ (zsum x).support.biUnion
        (fun r => Fintype.piFinset (fun k => (r k).divisors)),
      if ∀ k, d k ∣ n + h (i.succAbove k) then selbergCoefficient (zsum x) d else 0
  let Hsum : (Fin 39 → Fin (m + 1) → ℝ) → ℝ := fun Y =>
    Gsum Y + ∫ t : Fin (m + 1) → ℝ, Fsum (i.insertNth t Y) ∂ν
  have hw (x : ℝ) : wsum x = ∑ j ∈ 𝒥, c j • w j x :=
    canonical_diagonal_finset_smul 𝒥 c (T39 x) (X x) (BR x) G
  have hy (x : ℝ) : ysum x = ∑ j ∈ 𝒥, c j • y j x :=
    canonical_diagonal_finset_smul 𝒥 c (T40 x) (X x) (BR x) F
  have hz (x : ℝ) : zsum x = ∑ j ∈ 𝒥, c j • z j x := by
    dsimp only [zsum, z]
    rw [hw x, hy x, weighted_erasure_finset_smul]
    simp only [smul_add, Finset.sum_add_distrib]
  have hC : Csum = C := by
    funext x n
    dsimp only [Csum, C, Dz]
    rw [hz x]
    have hroot := selberg_divisor_root_finset_combination 𝒥 c (fun j => z j x)
      (fun k => n + h (i.succAbove k))
    refine Eq.trans ?_ (Eq.trans hroot ?_)
    · refine Finset.sum_congr ?_ ?_
      · ext d
        simp only [Finset.mem_biUnion, Fintype.mem_piFinset]
      · intro d _
        split_ifs <;> rfl
    · apply Finset.sum_congr rfl
      intro j _
      apply congrArg (fun t : ℝ => c j * t)
      refine Finset.sum_congr ?_ ?_
      · ext d
        simp only [Finset.mem_biUnion, Fintype.mem_piFinset]
      · intro d _
        split_ifs <;> rfl
  have hH : Hsum = H := by
    funext Y
    change (∑ j ∈ 𝒥, c j * G j Y) +
        (∫ t, (∑ j ∈ 𝒥, c j * F j (i.insertNth t Y)) ∂ν) =
      ∑ j ∈ 𝒥, c j * (G j Y + ∫ t, F j (i.insertNth t Y) ∂ν)
    rw [(fixed_band_erased_finset_integral 𝒥 c i ζ a F hF hbF).2.2.2 Y]
    simp only [mul_add, Finset.sum_add_distrib, ν]
  have hradSum : ∀ᶠ x : ℝ in atTop, ∀ d : Fin 39 → ℕ,
      (selbergCoefficient (wsum x) d ≠ 0 ∨
        selbergCoefficient (ysum x) (i.insertNth 1 d) ≠ 0) →
      ((∏ k, d k : ℕ) : ℝ) ≤ x ^ r_c := by
    filter_upwards [(Filter.eventually_all_finset 𝒥).2 hsourceRadius] with x hx
    intro d hd
    rcases hd with hd | hd
    · rw [hw x] at hd
      exact selbergCoefficient_finset_radius 𝒥 c (fun j => w j x) d (x ^ r_c)
        (fun j hj hne => hx j hj d (Or.inl hne)) hd
    · rw [hy x] at hd
      obtain ⟨j, hj, _, hne⟩ :=
        (selbergCoefficient_finset_combination 𝒥 c (fun j => y j x)).2 (i.insertNth 1 d) hd
      exact hx j hj d (Or.inr hne)
  have hmain := canonical_and_erased_auxiliary_marked_bin_physical_square
    (𝓗 := 𝓗) (h𝓗_card := h𝓗_card)
    i r_c ζ_a l s hζ_a hζrough hl hls hs hmargin a ha ha0 haLast Gsum Fsum
    hGsum hFsum hbGsum hbFsum u E_a hcGsum hcFsum hauxData hulim hradSum
  change (∀ ε : ℝ, 0 < ε → ∀ᶠ x : ℝ in atTop, ∀ b : ℕ,
    |(∑ v ∈ markedPrimePairBin x ((9519 : ℝ) / 50000)
          ((40481 : ℝ) / 100000) l s,
        ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
          if Nat.ModEq (W x) n b ∧ v.1 * v.2 ∣ n + h i then
            L x (n + h i) ^ 2 * Csum x n ^ 2 else 0) -
      (x / (W x : ℝ) / Bx x / BR x ^ 39) *
        ((∫ t in l..s,
            Real.log ((t - (9519 : ℝ) / 50000) / ((9519 : ℝ) / 50000)) / t) *
          ((∫ Y : Fin 39 → Fin (m + 1) → ℝ, Hsum Y ^ 2
              ∂Measure.pi (fun _ : Fin 39 => ν)) *
            E_a))| ≤
      ε * (x / (W x : ℝ) / Bx x / BR x ^ 39)) at hmain
  simpa only [hC, hH] using hmain

end PrimeGap186

section
open scoped ContDiff

end

namespace PrimeGap186

section
open Real Finset Filter Asymptotics

theorem selberg40_power_saving_error_small
    {𝓗 : Finset ℕ}
    (f : ℝ → ℝ) (δ : ℝ) (hδ : 0 < δ)
    (hf : f =O[atTop] (fun x : ℝ => x ^ (1 - δ))) :
    ∀ ε : ℝ, 0 < ε → ∀ᶠ x : ℝ in atTop,
      let ρ : ℝ := 2624989 / 10000000
      let W := presievingModulus 𝓗 x
      let Bx := fragmentNormalization W x
      let B := fragmentNormalization W (x ^ ρ)
      let A : ℝ := x / (W : ℝ) / Bx / B ^ 39
      1 < x ∧ 0 < A ∧ |f x| ≤ ε * A := by
  obtain ⟨C, hC, hbound⟩ := hf.exists_pos
  intro ε hε
  let ρ₀ : ℝ := 2624989 / 10000000
  have hρ : 0 < ρ₀ := by norm_num [ρ₀]
  have hρ1 : ρ₀ ≤ 1 := by norm_num [ρ₀]
  have hlogLimit : Tendsto (fun x : ℝ => Real.log x ^ 41 / x ^ δ)
      atTop (nhds 0) := by
    simpa only [Real.rpow_natCast] using
      (isLittleO_log_rpow_rpow_atTop ((41 : ℕ) : ℝ) hδ).tendsto_div_nhds_zero
  have hlimit : Tendsto (fun x : ℝ => C * Real.log x ^ 41 / x ^ δ)
      atTop (nhds 0) := by
    simpa only [mul_zero, mul_div_assoc] using hlogLimit.const_mul C
  filter_upwards [eventually_gt_atTop (1 : ℝ),
    presieving_le_mul_log_eventually 𝓗 1 zero_lt_one,
    hbound.bound, hlimit.eventually_le_const hε] with x hx hWlog hfx hsmall
  intro ρ W Bx B A
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hlog : 0 < Real.log x := Real.log_pos hx
  have hW : 0 < W := presieving_pos 𝓗 x
  have hWR : (0 : ℝ) < W := Nat.cast_pos.mpr hW
  have hφ : (0 : ℝ) < Nat.totient W := Nat.cast_pos.mpr (Nat.totient_pos.mpr hW)
  have hratio0 : 0 < (Nat.totient W : ℝ) / (W : ℝ) := div_pos hφ hWR
  have hratio1 : (Nat.totient W : ℝ) / (W : ℝ) ≤ 1 :=
    (div_le_one hWR).mpr (Nat.cast_le.mpr (Nat.totient_le W))
  have hBx : 0 < Bx := mul_pos hratio0 hlog
  have hBxle : Bx ≤ Real.log x := mul_le_of_le_one_left hlog.le hratio1
  have hBscale : B = ρ₀ * Bx := by
    change fragmentNormalization W (x ^ ρ₀) = ρ₀ * fragmentNormalization W x
    unfold fragmentNormalization
    rw [Real.log_rpow hx0]
    ring
  have hB : 0 < B := by rw [hBscale]; exact mul_pos hρ hBx
  have hBle : B ≤ Real.log x := by
    rw [hBscale]
    exact (mul_le_of_le_one_left hBx.le hρ1).trans hBxle
  have hA : 0 < A := div_pos (div_pos (div_pos hx0 hWR) hBx) (pow_pos hB 39)
  have hWlog' : (W : ℝ) ≤ Real.log x := by simpa only [one_mul] using hWlog
  have hden : (W : ℝ) * Bx * B ^ 39 ≤ Real.log x ^ 41 := by
    calc
      _ ≤ Real.log x * Real.log x * Real.log x ^ 39 :=
        mul_le_mul
          (mul_le_mul hWlog' hBxle hBx.le hlog.le)
          (pow_le_pow_left₀ hB.le hBle 39) (pow_nonneg hB.le 39)
          (mul_nonneg hlog.le hlog.le)
      _ = _ := by ring
  have hxδ : 0 < x ^ δ := Real.rpow_pos_of_pos hx0 δ
  have hfx' : |f x| ≤ C * x ^ (1 - δ) := by
    simpa only [Real.norm_eq_abs,
      abs_of_pos (Real.rpow_pos_of_pos hx0 (1 - δ))] using hfx
  refine ⟨hx, hA, (div_le_iff₀ hA).mp ?_⟩
  calc
    |f x| / A ≤ (C * x ^ (1 - δ)) / A := div_le_div_of_nonneg_right hfx' hA.le
    _ = C * ((W : ℝ) * Bx * B ^ 39) / x ^ δ := by
      dsimp only [A]
      rw [Real.rpow_sub hx0, Real.rpow_one]
      field_simp [hWR.ne', hBx.ne', hB.ne', hx0.ne', hxδ.ne']
    _ ≤ C * Real.log x ^ 41 / x ^ δ :=
      div_le_div_of_nonneg_right (mul_le_mul_of_nonneg_left hden hC.le) hxδ.le
    _ ≤ ε := hsmall

end

open Classical in
theorem canonical_and_erased_finite_coefficient_log_root_subpower
    {𝓗 : Finset ℕ} {h𝓗_card : 𝓗.card = 40}
    {m : ℕ} {J : Type*} [Fintype J]
    (i : Fin 40) (κ : ℝ) (hκ : 0 < κ)
    (a : Fin (m + 2) → ℝ) (c : J → ℝ)
    (G : J → (Fin 39 → Fin (m + 1) → ℝ) → ℝ)
    (F : J → (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
    (hbG : ∀ j, Bornology.IsBounded (Set.range (G j)))
    (hbF : ∀ j, Bornology.IsBounded (Set.range (F j))) :
    let ρ : ℝ := 2624989 / 10000000
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    let W : ℝ → ℕ := fun x =>
      presievingModulus 𝓗 x
    let R : ℝ → ℝ := fun x => x ^ ρ
    let B : ℝ → ℝ := fun x =>
      fragmentNormalization (W x) (R x)
    let q : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) (R x) κ, p
    let T39 := fun x => (Fintype.piFinset (fun _ : Fin 39 => (q x).divisors)).filter
      (fun r => Squarefree (∏ k, r k))
    let T40 := fun x => (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
      (fun r => Squarefree (∏ k, r k))
    let X : ℝ → ℕ → Fin (m + 1) → ℝ := fun x s =>
      fragmentBandMasses a (primeLogConfiguration (R x) s)
    let w : J → ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun j x =>
      ∑ r ∈ T39 x, Finsupp.single r (G j (fun k => X x (r k)) / B x ^ 39)
    let y : J → ℝ → ((Fin 40 → ℕ) →₀ ℝ) := fun j x =>
      ∑ r ∈ T40 x, Finsupp.single r (F j (fun k => X x (r k)) / B x ^ 40)
    let e : J → ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun j x =>
      (y j x).sum (fun r yr => Finsupp.single (fun k => r (i.succAbove k))
        (yr / ((r i).totient : ℝ)))
    let z : J → ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun j x => w j x + e j x
    let Z : ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun x => ∑ j, c j • z j x
    let D : J → ℝ → Finset (Fin 39 → ℕ) := fun j x =>
      (z j x).support.biUnion (fun r => Fintype.piFinset (fun k => (r k).divisors))
    (∃ C : ℝ, 0 < C ∧ ∀ᶠ x : ℝ in Filter.atTop,
      1 < x ∧ ∀ d : Fin 39 → ℕ, |selbergCoefficient (Z x) d| ≤ C * Real.log x) ∧
    ∀ ε : ℝ, 0 < ε → ∃ A : ℝ, 0 < A ∧
      ∀ᶠ x : ℝ in Filter.atTop,
        ∀ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
          |∑ j, c j *
            (∑ d ∈ D j x, if ∀ k, d k ∣ n + h (i.succAbove k) then
              selbergCoefficient (z j x) d else 0)| ≤ A * x ^ ε := by
  intro ρ h W R B q T39 T40 X w y e z Z D
  let Cκ : ℝ := Real.exp Real.eulerMascheroniConstant * κ + 1
  let M_R : ℝ → ℝ := fun x =>
    harmonicFragmentMass (W x) (R x) κ
  have hρ : 0 < ρ := by norm_num [ρ]
  have hCκ : 0 < Cκ := by dsimp [Cκ]; positivity
  have hsum_bound (b K : J → ℝ) (t : ℝ) (ht : 0 ≤ t)
      (hb : ∀ j, |b j| ≤ K j * t) :
      |∑ j, c j * b j| ≤ (1 + ∑ j, |c j| * K j) * t := by
    calc
      |∑ j, c j * b j| ≤ ∑ j, |c j * b j| :=
        Finset.abs_sum_le_sum_abs _ _
      _ ≤ ∑ j, |c j| * (K j * t) := Finset.sum_le_sum fun j _ => by
        simpa only [abs_mul] using mul_le_mul_of_nonneg_left (hb j) (abs_nonneg (c j))
      _ = (∑ j, |c j| * K j) * t := by simp only [Finset.sum_mul, mul_assoc]
      _ ≤ (1 + ∑ j, |c j| * K j) * t :=
        mul_le_mul_of_nonneg_right (le_add_of_nonneg_left zero_le_one) ht
  have hnorm := harmonic_fragment_normalizer_tendsto
    𝓗 ρ κ hρ hκ
  have hindividual (j : J) :
      (∃ C : ℝ, 0 < C ∧ ∀ᶠ x : ℝ in Filter.atTop,
        1 < x ∧ ∀ d : Fin 39 → ℕ,
          |selbergCoefficient (z j x) d| ≤ C * Real.log x) ∧
      ∀ ε : ℝ, 0 < ε → ∃ A : ℝ, 0 < A ∧
        ∀ᶠ x : ℝ in Filter.atTop,
          ∀ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            |∑ d ∈ D j x, if ∀ k, d k ∣ n + h (i.succAbove k) then
              selbergCoefficient (z j x) d else 0| ≤ A * x ^ ε := by
    obtain ⟨M, hM, hcoeff, hroot⟩ :=
      canonical_and_erased_coefficient_root_subpower
        (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i κ hκ a (G j) (F j) (hbG j) (hbF j)
    obtain ⟨_, _, hamp⟩ :=
      canonical_and_erased_diagonal_amplitude
        (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i κ hκ a (G j) (F j) (hbG j) (hbF j)
    let K : ℝ := M * Cκ ^ 39
    have hK : 0 < K := mul_pos hM (pow_pos hCκ 39)
    refine ⟨⟨K * Cκ * ρ, mul_pos (mul_pos hK hCκ) hρ, ?_⟩, hroot⟩
    filter_upwards [hcoeff, hamp, hnorm.eventually_le_const (lt_add_one _)] with x hc ha hm
    obtain ⟨hx, hB, hc⟩ := hc
    change 0 < B x at hB
    change M_R x / B x ≤ Cκ at hm
    obtain ⟨_, _, _, _, _, _, _, _, hzsupport, _⟩ := ha
    change (∀ r ∈ (z j x).support,
      Squarefree (∏ k, r k) ∧ ∀ k, r k ∈ (q x).divisors) at hzsupport
    have hlog : 0 ≤ Real.log x := Real.log_nonneg hx.le
    have hBupper : B x ≤ ρ * Real.log x := by
      change ((Nat.totient (W x) : ℝ) / (W x : ℝ)) * Real.log (x ^ ρ) ≤ _
      rw [Real.log_rpow (lt_trans zero_lt_one hx)]
      apply mul_le_of_le_one_left (mul_nonneg hρ.le hlog)
      exact div_le_one_of_le₀ (Nat.cast_le.mpr (Nat.totient_le (W x))) (Nat.cast_nonneg _)
    have hq : Squarefree (q x) := by
      apply (squarefree_primorial ⌊R x ^ κ⌋₊).squarefree_of_dvd
      exact Finset.prod_dvd_prod_of_subset _ _ _ (Finset.filter_subset _ _)
    have hsupport : ∀ r ∈ (z j x).support, (∏ k, r k) ∣ q x := by
      intro r hr
      obtain ⟨hsq, hd⟩ := hzsupport r hr
      apply hsq.isRadical 39 (q x)
      simpa only [Finset.prod_const, Finset.card_univ, Fintype.card_fin] using
        Finset.prod_dvd_prod_of_dvd (s := Finset.univ) r (fun _ => q x)
          (fun k _ => Nat.dvd_of_mem_divisors (hd k))
    refine ⟨hx, ?_⟩
    intro d
    by_cases hd : selbergCoefficient (z j x) d = 0
    · rw [hd, abs_zero]
      exact mul_nonneg (mul_pos (mul_pos hK hCκ) hρ).le hlog
    · let D₀ : ℕ := ∏ k, d k
      have hDq : D₀ ∣ q x :=
        selbergCoefficient_mem_hereditary (z j x) (fun d => (∏ k, d k) ∣ q x)
          (fun d r hdr hr =>
            (Finset.prod_dvd_prod_of_dvd d r (fun k _ => hdr k)).trans hr)
          hsupport d hd
      have hratio : (D₀ : ℝ) / (D₀.totient : ℝ) ≤ M_R x := by
        rw [squarefree_div_totient_eq_sum_divisors_inv_totient
          (hq.squarefree_of_dvd hDq)]
        exact Finset.sum_le_sum_of_subset_of_nonneg
          (Nat.divisors_subset_of_dvd hq.ne_zero hDq)
          (fun r _ _ => inv_nonneg.mpr (Nat.cast_nonneg _))
      calc
        |selbergCoefficient (z j x) d| ≤ K * ((D₀ : ℝ) / (D₀.totient : ℝ)) := (hc d).2
        _ ≤ K * M_R x := mul_le_mul_of_nonneg_left hratio hK.le
        _ ≤ K * (Cκ * B x) := mul_le_mul_of_nonneg_left ((div_le_iff₀ hB).mp hm) hK.le
        _ ≤ K * (Cκ * (ρ * Real.log x)) :=
          mul_le_mul_of_nonneg_left (mul_le_mul_of_nonneg_left hBupper hCκ.le) hK.le
        _ = (K * Cκ * ρ) * Real.log x := by ac_rfl
  constructor
  · choose C hC hbound using fun j => (hindividual j).1
    refine ⟨1 + ∑ j, |c j| * C j,
      add_pos_of_pos_of_nonneg zero_lt_one
        (Finset.sum_nonneg fun j _ => mul_nonneg (abs_nonneg _) (hC j).le), ?_⟩
    filter_upwards [Filter.eventually_all.mpr hbound,
      Filter.eventually_gt_atTop (1 : ℝ)] with x hx hx1
    refine ⟨hx1, ?_⟩
    intro d
    have hlinear :=
      (selbergCoefficient_finset_combination Finset.univ c (fun j => z j x)).1 d
    change selbergCoefficient (Z x) d = ∑ j, c j * selbergCoefficient (z j x) d at hlinear
    rw [hlinear]
    exact hsum_bound (fun j => selbergCoefficient (z j x) d) C (Real.log x)
      (Real.log_nonneg hx1.le) (fun j => (hx j).2 d)
  · intro ε hε
    choose A hA hroot using fun j => (hindividual j).2 ε hε
    refine ⟨1 + ∑ j, |c j| * A j,
      add_pos_of_pos_of_nonneg zero_lt_one
        (Finset.sum_nonneg fun j _ => mul_nonneg (abs_nonneg _) (hA j).le), ?_⟩
    filter_upwards [Filter.eventually_all.mpr hroot,
      Filter.eventually_gt_atTop (0 : ℝ)] with x hx hx0
    intro n hn
    exact hsum_bound
      (fun j => ∑ d ∈ D j x, if ∀ k, d k ∣ n + h (i.succAbove k) then
        selbergCoefficient (z j x) d else 0)
      A (x ^ ε) (Real.rpow_nonneg hx0.le _) (fun j => hx j n hn)

section
open Real Filter Asymptotics
open scoped ContDiff
open Classical in
theorem canonical_and_erased_exceptional_square
    {𝓗 : Finset ℕ} {h𝓗_card : 𝓗.card = 40}
    {J : Type*} {m : ℕ} (𝒥 : Finset J) (c : J → ℝ) (i : Fin 40)
    (a : Fin (m + 2) → ℝ) (ha : StrictMono a) (ha0 : a 0 = 0)
    (haLast : a (Fin.last (m + 1)) =
      ((19037 : ℝ) / 100000) / ((2624989 : ℝ) / 10000000))
    (G : J → (Fin 39 → Fin (m + 1) → ℝ) → ℝ)
    (F : J → (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
    (hG : ∀ j ∈ 𝒥, Measurable (G j)) (hF : ∀ j ∈ 𝒥, Measurable (F j))
    (hbG : ∀ j ∈ 𝒥, Bornology.IsBounded (Set.range (G j)))
    (hbF : ∀ j ∈ 𝒥, Bornology.IsBounded (Set.range (F j))) :
    let ρ : ℝ := 2624989 / 10000000
    let ξ₀ : ℝ := 19037 / 100000
    let ζ : ℝ := ξ₀ / ρ
    let ν : Measure (Fin (m + 1) → ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * ζ) •
        Measure.map (fragmentBandMasses a)
          (fragmentLaw ζ)
    (∀ j ∈ 𝒥, ∀ᵐ X ∂Measure.pi (fun _ : Fin 39 => ν), ContinuousAt (G j) X) →
    (∀ j ∈ 𝒥, ∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => ν), ContinuousAt (F j) X) →
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    let W : ℝ → ℕ := presievingModulus 𝓗
    let R : ℝ → ℝ := fun x => x ^ ρ
    let Bx : ℝ → ℝ := fun x => fragmentNormalization (W x) x
    let BR : ℝ → ℝ := fun x => fragmentNormalization (W x) (R x)
    let q : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) (R x) ζ, p
    let T39 : ℝ → Finset (Fin 39 → ℕ) := fun x =>
      (Fintype.piFinset (fun _ : Fin 39 => (q x).divisors)).filter
        (fun r => Squarefree (∏ k, r k))
    let T40 : ℝ → Finset (Fin 40 → ℕ) := fun x =>
      (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
        (fun r => Squarefree (∏ k, r k))
    let X : ℝ → ℕ → Fin (m + 1) → ℝ := fun x t =>
      fragmentBandMasses a
        (primeLogConfiguration (R x) t)
    let w : J → ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun j x =>
      ∑ r ∈ T39 x, Finsupp.single r (G j (fun k => X x (r k)) / BR x ^ 39)
    let y : J → ℝ → ((Fin 40 → ℕ) →₀ ℝ) := fun j x =>
      ∑ r ∈ T40 x, Finsupp.single r (F j (fun k => X x (r k)) / BR x ^ 40)
    let z : J → ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun j x =>
      w j x + (y j x).sum (fun r yr =>
        Finsupp.single (fun k => r (i.succAbove k)) (yr / ((r i).totient : ℝ)))
    let Dz : J → ℝ → Finset (Fin 39 → ℕ) := fun j x =>
      (z j x).support.biUnion
        (fun r => Fintype.piFinset (fun k => (r k).divisors))
    let C : ℝ → ℕ → ℝ := fun x n =>
      ∑ j ∈ 𝒥, c j *
        (∑ d ∈ Dz j x, if ∀ k, d k ∣ n + h (i.succAbove k) then
          PrimeGap186.selbergCoefficient (z j x) d else 0)
    let H : (Fin 39 → Fin (m + 1) → ℝ) → ℝ := fun Y =>
      ∑ j ∈ 𝒥, c j *
        (G j Y + ∫ t : Fin (m + 1) → ℝ, F j (i.insertNth t Y) ∂ν)
    (∀ j ∈ 𝒥, ∀ᶠ x : ℝ in Filter.atTop,
      ∀ d : Fin 39 → ℕ,
        (PrimeGap186.selbergCoefficient (w j x) d ≠ 0 ∨
          PrimeGap186.selbergCoefficient (y j x) (i.insertNth 1 d) ≠ 0) →
        ((∏ k, d k : ℕ) : ℝ) ≤ x ^ (11 / 40 : ℝ)) →
    ∀ ε : ℝ, 0 < ε → ∀ᶠ x : ℝ in Filter.atTop, ∀ b : ℕ,
      (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        if Nat.ModEq (W x) n b then
          (exceptionalPrimeDefect x 0 (n + h i) +
            exceptionalPrimeDefect x 1 (n + h i)) * C x n ^ 2 else 0) ≤
        (((17 : ℝ) / 50) * (ρ ^ 39)⁻¹ *
            (∫ Y : Fin 39 → Fin (m + 1) → ℝ, H Y ^ 2
              ∂Measure.pi (fun _ : Fin 39 => ν)) + ε) *
          (x / (W x : ℝ) / Bx x ^ 40) := by
  intro ρ ξ₀ ζ ν cG cF h W R Bx BR q T39 T40 X w y z Dz C H hsourceRadius
  have hρ : 0 < ρ := by norm_num [ρ]
  have hζ : 0 < ζ := by norm_num [ζ, ξ₀, ρ]
  let ξ : ℝ := 9519 / 50000
  let s : Fin 1024 → ℝ := fun j => (exceptionalBinRight j : ℝ)
  let l : Fin 1024 → ℝ := fun j => s j - (exceptionalBinStep : ℝ)
  let ζa : Fin 1024 → ℝ := fun j => (exceptionalBinAuxRadius j : ℝ)
  have hbin (j : Fin 1024) :
      0 < ζa j ∧ ζa j < ξ ∧ 2 * ξ ≤ l j ∧ l j < s j ∧
        s j ≤ (40481 : ℝ) / 100000 ∧ s j + 2 * ((11 : ℝ) / 40 + ζa j) < 1 := by
    obtain ⟨hstep, _, hs, hzlo, hzhi, hxi0, hxi, hgap, _⟩ := exceptionalBin_margins j
    have hstepR : (0 : ℝ) < (exceptionalBinStep : ℝ) := Rat.cast_pos.mpr hstep
    have hzposQ : (0 : ℚ) < exceptionalBinAuxRadius j :=
      (by norm_num : (0 : ℚ) < 4499 / 200000).trans_le hzlo
    have hzxiQ : exceptionalBinAuxRadius j < (9519 : ℚ) / 50000 :=
      hzhi.trans (hxi0.trans hxi)
    have hsR : s j ≤ (40481 : ℝ) / 100000 := by
      simpa only [s, Rat.cast_div, Rat.cast_ofNat] using (Rat.cast_le (K := ℝ)).mpr hs
    have hgapR : s j + 2 * (11 / 40 : ℝ) + 2 * ζa j = 1 - 1 / 5000 := by
      simpa only [s, ζa, Rat.cast_add, Rat.cast_sub, Rat.cast_mul, Rat.cast_div,
        Rat.cast_ofNat, Rat.cast_one] using congrArg (fun r : ℚ => (r : ℝ)) hgap
    have hsEq : s j = 2 * ξ + ((j.val : ℝ) + 1) * (exceptionalBinStep : ℝ) := by
      dsimp only [s, exceptionalBinRight, ξ]
      push_cast
      rfl
    refine ⟨Rat.cast_pos.mpr hzposQ, ?_, ?_, ?_, hsR, ?_⟩
    · simpa only [ζa, ξ, Rat.cast_div, Rat.cast_ofNat] using
        (Rat.cast_lt (K := ℝ)).mpr hzxiQ
    · dsimp only [l]
      rw [hsEq]
      nlinarith [mul_nonneg (Nat.cast_nonneg (α := ℝ) j.val) hstepR.le]
    · dsimp only [l]
      linarith
    · linarith
  let Aa : Fin 1024 → ℝ → Finset ℕ := fun j x =>
    (Finset.Icc 1 ⌊x ^ (ζa j)⌋₊).filter
      (fun t => Squarefree t ∧ Nat.Coprime t (W x))
  let Gaux : Fin 1024 → ℝ → ℝ := fun j x =>
    ∑ t ∈ Aa j x, 1 / (t.totient : ℝ)
  let u : Fin 1024 → ℝ → ((Fin 1 → ℕ) →₀ ℝ) := fun j x =>
    ∑ t ∈ Aa j x, Finsupp.single (fun _ : Fin 1 => t) (1 / Gaux j x)
  let Du : Fin 1024 → ℝ → Finset (Fin 1 → ℕ) := fun j x =>
    (u j x).support.biUnion
      (fun t => Fintype.piFinset (fun k => (t k).divisors))
  let L : Fin 1024 → ℝ → ℕ → ℝ := fun j x t =>
    ∑ e ∈ Du j x, if e 0 ∣ t then selbergCoefficient (u j x) e else 0
  let I : ℝ := ∫ Y : Fin 39 → Fin (m + 1) → ℝ,
    H Y ^ 2 ∂Measure.pi (fun _ : Fin 39 => ν)
  let E : Fin 1024 → ℝ := fun j => 1 / ζa j
  let D : Fin 1024 → ℝ := fun j =>
    ∫ t in l j..s j, Real.log ((t - ξ) / ξ) / t
  let P : Fin 1024 → ℝ → Finset (ℕ × ℕ) := fun j x =>
    markedPrimePairBin x ξ ((40481 : ℝ) / 100000) (l j) (s j)
  let A : ℝ → ℝ := fun x => x / (W x : ℝ) / Bx x / BR x ^ 39
  let S : Fin 1024 → ℝ → ℕ → ℝ := fun j x b =>
    ∑ pq ∈ P j x, ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
      if Nat.ModEq (W x) n b ∧ pq.1 * pq.2 ∣ n + h i then
        L j x (n + h i) ^ 2 * C x n ^ 2 else 0
  have hI : 0 ≤ I := integral_nonneg fun _ => sq_nonneg _
  have hfamily (j : Fin 1024) := sharp_auxiliary_family
    𝓗 (ζa j) ξ (hbin j).1 (hbin j).2.1
  have henergyUpper : (12 / 5 : ℝ) * (∑ j, E j * D j) ≤
      (exceptionalBinRationalSum : ℝ) := by
    have hterm (j : Fin 1024) : (12 / 5 : ℝ) * E j * D j ≤
        (exceptionalBinCeiling j : ℝ) / (10 : ℝ) ^ 25 := by
      simpa only [E, D, l, s, ζa, ξ, one_div] using
        (exceptionalBin_integral_upper j).2
    calc
      _ = ∑ j : Fin 1024, (12 / 5 : ℝ) * E j * D j := by
        rw [Finset.mul_sum]
        exact Finset.sum_congr rfl fun _ _ => (mul_assoc _ _ _).symm
      _ ≤ ∑ j : Fin 1024, (exceptionalBinCeiling j : ℝ) / (10 : ℝ) ^ 25 :=
        Finset.sum_le_sum fun j _ => hterm j
      _ = _ := by
        simp only [exceptionalBinRationalSum, Rat.cast_div, Rat.cast_sum,
          Rat.cast_intCast, Rat.cast_pow, Rat.cast_ofNat, Finset.sum_div]
  have henergy : (12 / 5 : ℝ) * (∑ j, E j * D j) < 17 / 50 := by
    have hsumLt : (exceptionalBinRationalSum : ℝ) < (337 / 1000 : ℝ) := by
      simpa only [Rat.cast_div, Rat.cast_ofNat] using
        (Rat.cast_lt (K := ℝ)).mpr exceptionalBinRationalSum_value.2.1
    exact (henergyUpper.trans_lt hsumLt).trans (by norm_num)
  have hrough (j : Fin 1024) : ∀ᶠ x : ℝ in atTop,
      ∀ t : ℕ, (∀ p : ℕ, p.Prime → p ∣ t → x ^ ξ ≤ (p : ℝ)) → L j x t = 1 :=
    (hfamily j).2.2
  have hmarked (j : Fin 1024) (η : ℝ) (hη : 0 < η) :
      ∀ᶠ x : ℝ in atTop, ∀ b : ℕ,
        |S j x b - A x * (D j * (I * E j))| ≤ η * A x :=
    canonical_and_erased_auxiliary_marked_bin_physical_square_finset (𝓗 := 𝓗) (h𝓗_card := h𝓗_card)
      𝒥 c i (11 / 40) (ζa j) (l j) (s j)
      (hbin j).1 (hbin j).2.1 (hbin j).2.2.1 (hbin j).2.2.2.1
      (hbin j).2.2.2.2.1 (hbin j).2.2.2.2.2
      a ha ha0 haLast G F hG hF hbG hbF (u j) (E j) cG cF
      (hfamily j).2.1 (hfamily j).1 hsourceRadius η hη
  have hsubpower (δ : ℝ) (hδ : 0 < δ) :
      ∃ K : ℝ, 0 < K ∧ ∀ᶠ x : ℝ in atTop,
        ∀ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, |C x n| ≤ K * x ^ δ := by
    have ht := (canonical_and_erased_finite_coefficient_log_root_subpower
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card)
      (J := 𝒥) i ζ hζ a (fun j => c j.val)
      (fun j => G j.val) (fun j => F j.val)
      (fun j => hbG j.val j.property) (fun j => hbF j.val j.property)).2 δ hδ
    obtain ⟨K, hK, ht⟩ := ht
    refine ⟨K, hK, ?_⟩
    filter_upwards [ht] with x hx
    intro n hn
    have hb := hx n hn
    change |∑ j : 𝒥, c j.val *
      (∑ d ∈ Dz j.val x, if ∀ k, d k ∣ n + h (i.succAbove k) then
        selbergCoefficient (z j.val x) d else 0)| ≤ K * x ^ δ at hb
    change |∑ j ∈ 𝒥, c j *
      (∑ d ∈ Dz j x, if ∀ k, d k ∣ n + h (i.succAbove k) then
        selbergCoefficient (z j x) d else 0)| ≤ K * x ^ δ
    rw [Finset.sum_subtype 𝒥 (fun _ => Iff.rfl)]
    exact hb
  let B : ℝ → ℕ → ℝ := fun x n =>
    exceptionalPrimeDefect x 0 (n + h i) +
      exceptionalPrimeDefect x 1 (n + h i)
  let ER : ℝ → ℝ := fun x => ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
    if ¬Squarefree (n + h i) ∧ ((n + h i : ℕ) : ℝ) ≤ 2 * x then
      B x n * C x n ^ 2 else 0
  let EE : ℝ → ℝ := fun x => ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
    if 2 * x < ((n + h i : ℕ) : ℝ) then B x n * C x n ^ 2 else 0
  have hER : ER =O[atTop] (fun x : ℝ => x ^ (1 - ξ / 2)) :=
    shifted_nonsquarefree_exceptional_weighted_isBigO (h i) C
      (hsubpower (ξ / 4) (by norm_num [ξ]))
  have hEE : EE =O[atTop] (fun x : ℝ => x ^ (1 - (1 / 2 : ℝ))) := by
    simpa only [show (1 - (1 / 2 : ℝ)) = 1 / 2 by norm_num] using
      exceptionalPrimeDefect_shifted_endpoint_error (h i) C
        (hsubpower (1 / 8) (by norm_num))
  have hB (x : ℝ) (n : ℕ) : 0 ≤ B x n :=
    add_nonneg (exceptionalPrimeDefect_nonneg x 0 _)
      (exceptionalPrimeDefect_nonneg x 1 _)
  intro ε hε
  let ε' : ℝ := ε * ρ ^ 39
  let η : ℝ := ε' / (3 * (12 / 5) * 1024)
  have hε' : 0 < ε' := mul_pos hε (pow_pos hρ 39)
  have hη : 0 < η := div_pos hε' (by norm_num)
  have hsmallR := selberg40_power_saving_error_small (𝓗 := 𝓗) ER (ξ / 2)
    (by norm_num [ξ]) hER (ε' / 3) (by positivity)
  have hsmallE := selberg40_power_saving_error_small (𝓗 := 𝓗) EE (1 / 2)
    (by norm_num) hEE (ε' / 3) (by positivity)
  filter_upwards [Filter.eventually_all.mpr (fun j => hmarked j η hη),
    Filter.eventually_all.mpr hrough,
    eventually_exceptionalPrimeDefect_bin_square_majorant,
    hsmallR, hsmallE] with x hmarkedx hroughx hmajorx hRx hEx
  have hx : 1 < x := hRx.1
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hA : 0 < A x := hRx.2.1
  have hRsmall : ER x ≤ (ε' / 3) * A x := (le_abs_self _).trans hRx.2.2
  have hEsmall : EE x ≤ (ε' / 3) * A x := (le_abs_self _).trans hEx.2.2
  intro b
  let U : ℕ → ℝ := fun n =>
    ∑ j : Fin 1024, ∑ pq ∈ P j x,
      if Nat.ModEq (W x) n b ∧ pq.1 * pq.2 ∣ n + h i then
        L j x (n + h i) ^ 2 * C x n ^ 2 else 0
  have hU (n : ℕ) : 0 ≤ U n := by
    exact Finset.sum_nonneg fun _ _ => Finset.sum_nonneg fun _ _ => by positivity
  have hpoint (n : ℕ) (hn : n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊) :
      (if Nat.ModEq (W x) n b then B x n * C x n ^ 2 else 0) ≤
        (12 / 5 : ℝ) * U n +
          (if ¬Squarefree (n + h i) ∧ ((n + h i : ℕ) : ℝ) ≤ 2 * x then
            B x n * C x n ^ 2 else 0) +
          (if 2 * x < ((n + h i : ℕ) : ℝ) then B x n * C x n ^ 2 else 0) := by
    have hb0 : 0 ≤ B x n * C x n ^ 2 := mul_nonneg (hB x n) (sq_nonneg _)
    by_cases hm : Nat.ModEq (W x) n b
    · rw [ite_eq_left hm]
      by_cases he : 2 * x < ((n + h i : ℕ) : ℝ)
      · simp only [not_le_of_gt he, and_false, ite_false, ite_eq_left he]
        nlinarith [hU n]
      · have hupper : ((n + h i : ℕ) : ℝ) ≤ 2 * x := le_of_not_gt he
        by_cases hsf : Squarefree (n + h i)
        · have hlower : x ≤ ((n + h i : ℕ) : ℝ) :=
            (Nat.le_of_ceil_le (Finset.mem_Icc.mp hn).1).trans
              (Nat.cast_le.mpr (Nat.le_add_right n (h i)))
          have hgood := hmajorx (fun j => L j x)
            (fun j t _ ht => hroughx j t ht) (n + h i) (C x n) hlower hupper hsf
          have hu : U n = ∑ j : Fin 1024, ∑ pq ∈ P j x,
              if pq.1 * pq.2 ∣ n + h i then (L j x (n + h i) * C x n) ^ 2 else 0 := by
            simp only [U, hm, true_and, mul_pow]
          rw [hu]
          simpa only [hsf, not_true_eq_false, false_and, he, ite_false, add_zero] using hgood
        · simp only [hsf, not_false_eq_true, hupper, true_and, ite_true, he, ite_false,
            add_zero]
          nlinarith [hU n]
    · rw [ite_eq_right hm]
      exact add_nonneg
        (add_nonneg (mul_nonneg (by norm_num) (hU n)) (by split_ifs <;> positivity))
        (by split_ifs <;> positivity)
  have hsumU : (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, U n) = ∑ j : Fin 1024, S j x b := by
    dsimp only [U, S]
    rw [Finset.sum_comm]
    apply Finset.sum_congr rfl
    intro j _
    rw [Finset.sum_comm]
  have htotal :
      (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        if Nat.ModEq (W x) n b then B x n * C x n ^ 2 else 0) ≤
        (12 / 5 : ℝ) * (∑ j : Fin 1024, S j x b) + ER x + EE x := by
    calc
      _ ≤ ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
          ((12 / 5 : ℝ) * U n +
            (if ¬Squarefree (n + h i) ∧ ((n + h i : ℕ) : ℝ) ≤ 2 * x then
              B x n * C x n ^ 2 else 0) +
            (if 2 * x < ((n + h i : ℕ) : ℝ) then B x n * C x n ^ 2 else 0)) :=
        Finset.sum_le_sum hpoint
      _ = _ := by rw [Finset.sum_add_distrib, Finset.sum_add_distrib,
        ← Finset.mul_sum, hsumU]
  have hsumMarked :
      (12 / 5 : ℝ) * (∑ j : Fin 1024, S j x b) ≤
        ((17 / 50 : ℝ) * I + ε' / 3) * A x := by
    have hupper (j : Fin 1024) : S j x b ≤ A x * (D j * (I * E j)) + η * A x :=
      le_add_of_sub_left_le (abs_le.mp (hmarkedx j b)).2
    calc
      _ ≤ (12 / 5 : ℝ) *
          (∑ j : Fin 1024, (A x * (D j * (I * E j)) + η * A x)) :=
        mul_le_mul_of_nonneg_left (Finset.sum_le_sum fun j _ => hupper j) (by norm_num)
      _ = (((12 / 5 : ℝ) * (∑ j : Fin 1024, E j * D j)) * I + ε' / 3) * A x := by
        rw [Finset.sum_add_distrib]
        have hmain : (∑ j : Fin 1024, A x * (D j * (I * E j))) =
            (A x * I) * (∑ j : Fin 1024, E j * D j) := by
          rw [Finset.mul_sum]
          apply Finset.sum_congr rfl
          intro j _
          ring
        rw [hmain, Finset.sum_const, Finset.card_univ, Fintype.card_fin, nsmul_eq_mul]
        dsimp only [η]
        norm_num
        ring
      _ ≤ ((17 / 50 : ℝ) * I + ε' / 3) * A x :=
        mul_le_mul_of_nonneg_right
          (add_le_add (mul_le_mul_of_nonneg_right henergy.le hI) le_rfl) hA.le
  have hfinal :
      (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        if Nat.ModEq (W x) n b then B x n * C x n ^ 2 else 0) ≤
        ((17 / 50 : ℝ) * I + ε') * A x := by
    calc
      _ ≤ (12 / 5 : ℝ) * (∑ j : Fin 1024, S j x b) + ER x + EE x := htotal
      _ ≤ (((17 / 50 : ℝ) * I + ε' / 3) * A x) +
          (ε' / 3) * A x + (ε' / 3) * A x :=
        add_le_add (add_le_add hsumMarked hRsmall) hEsmall
      _ = _ := by ring
  have hBRscale : BR x = ρ * Bx x := by
    dsimp only [BR, R, Bx, fragmentNormalization]
    rw [Real.log_rpow hx0]
    ring
  have hAscale : A x = (ρ ^ 39)⁻¹ * (x / (W x : ℝ) / Bx x ^ 40) := by
    simp only [A, hBRscale, mul_pow, div_eq_mul_inv, mul_inv_rev, ← inv_pow]
    ring
  calc
    _ ≤ ((17 / 50 : ℝ) * I + ε') * A x := hfinal
    _ = _ := by
      rw [hAscale]
      dsimp only [ε']
      field_simp [hρ.ne']
      ring

end

theorem selberg_sampled_coefficient_root {ι : Type*} [Fintype ι]
    (T : Finset (ι → ℕ)) (f : (ι → ℕ) → ℝ) (Z : ℝ) (d : ι → ℕ)
    (hd : selbergCoefficient (∑ r ∈ T, Finsupp.single r (f r / Z)) d ≠ 0) :
    ∃ r ∈ T, f r ≠ 0 ∧ ∀ j, d j ∣ r j := by
  classical
  apply selbergCoefficient_mem_hereditary
    (∑ r ∈ T, Finsupp.single r (f r / Z))
    (fun e => ∃ r ∈ T, f r ≠ 0 ∧ ∀ j, e j ∣ r j) ?_ ?_ d hd
  · rintro e s hes ⟨r, hr, hfr, hsr⟩
    exact ⟨r, hr, hfr, fun j => (hes j).trans (hsr j)⟩
  · intro r hr
    obtain ⟨s, hs, hsingle⟩ := Finsupp.mem_support_finsetSum r hr
    obtain ⟨rfl, hne⟩ := (Finsupp.mem_support_single r s (f s / Z)).mp hsingle
    exact ⟨r, hs, (div_ne_zero_iff.mp hne).1, fun j => dvd_rfl⟩

open Classical in
theorem selberg_sampled_coefficient_presieve {ι : Type*} [Fintype ι]
    (W : ℕ) (R κ Z : ℝ) (f : (ι → ℕ) → ℝ) (d : ι → ℕ) :
    let q := ∏ p ∈ fragmentPrimes W R κ, p
    let T := (Fintype.piFinset (fun _ : ι => q.divisors)).filter
      (fun r => Squarefree (∏ j, r j))
    let y := ∑ r ∈ T, Finsupp.single r (f r / Z)
    selbergCoefficient y d ≠ 0 →
      Squarefree (∏ j, d j) ∧ (∏ j, d j).Coprime W ∧ (∏ j, d j) ∣ q ∧
        ∃ r ∈ T, f r ≠ 0 ∧ ∀ j, d j ∣ r j := by
  intro q T y hd
  obtain ⟨r, hr, hfr, hdr⟩ := selberg_sampled_coefficient_root T f Z d hd
  dsimp only [T] at hr
  have hrT := Finset.mem_filter.mp hr
  have hrq : ∀ j, r j ∣ q := fun j =>
    (Nat.mem_divisors.mp ((Fintype.mem_piFinset.mp hrT.1) j)).1
  have hqW : q.Coprime W := by
    apply Nat.Coprime.prod_left
    intro p hp
    obtain ⟨hp, hpW⟩ := Finset.mem_filter.mp hp
    exact (Nat.Prime.coprime_iff_not_dvd (Nat.prime_of_mem_primesLE hp)).mpr hpW
  have hprod : (∏ j, d j) ∣ ∏ j, r j :=
    Finset.prod_dvd_prod_of_dvd d r (fun j _ => hdr j)
  have hsq : Squarefree (∏ j, d j) := hrT.2.squarefree_of_dvd hprod
  have hwhole : (∏ j, d j) ∣ q := by
    apply hsq.isRadical (Fintype.card ι) q
    simpa only [Finset.prod_const, Finset.card_univ] using
      Finset.prod_dvd_prod_of_dvd (s := Finset.univ) d (fun _ => q)
        (fun j _ => (hdr j).trans (hrq j))
  exact ⟨hsq, hqW.coprime_dvd_left hwhole, hwhole, r, hr, hfr, hdr⟩

theorem selberg_sampled_erased_coefficient_presieve
    (W : ℕ) (R κ Z : ℝ) (f : (Fin 40 → ℕ) → ℝ) (i : Fin 40)
    (d : Fin 39 → ℕ) :
    let q := ∏ p ∈ fragmentPrimes W R κ, p
    let T := (Fintype.piFinset (fun _ : Fin 40 => q.divisors)).filter
      (fun r => Squarefree (∏ j, r j))
    let y := ∑ r ∈ T, Finsupp.single r (f r / Z)
    let z : (Fin 39 → ℕ) →₀ ℝ :=
      y.sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
        (yr / ((r i).totient : ℝ)))
    selbergCoefficient z d ≠ 0 →
      Squarefree (∏ j, d j) ∧ (∏ j, d j).Coprime W ∧ (∏ j, d j) ∣ q ∧
        ∃ r ∈ T, f r ≠ 0 ∧ ∀ j, d j ∣ r (i.succAbove j) := by
  intro q T y z hd
  have hfull : selbergCoefficient y (i.insertNth 1 d) ≠ 0 := by
    rw [← selbergCoefficient_weighted_erase i y d]
    exact hd
  obtain ⟨r, hr, hfr, hdr⟩ :=
    selberg_sampled_coefficient_root T f Z (i.insertNth 1 d) hfull
  dsimp only [T] at hr
  have hrT := Finset.mem_filter.mp hr
  have hrq (j : Fin 40) : r j ∣ q :=
    (Nat.mem_divisors.mp ((Fintype.mem_piFinset.mp hrT.1) j)).1
  have hret (j : Fin 39) : d j ∣ r (i.succAbove j) := by
    simpa only [Fin.insertNth_apply_succAbove] using hdr (i.succAbove j)
  have hprod : (∏ j : Fin 39, d j) ∣ ∏ j : Fin 40, r j := by
    have hh := Finset.prod_dvd_prod_of_dvd (s := Finset.univ)
      (i.insertNth 1 d) r (fun j _ => hdr j)
    simpa only [Fin.prod_insertNth, one_mul] using hh
  have hsq : Squarefree (∏ j : Fin 39, d j) := hrT.2.squarefree_of_dvd hprod
  have hqW : q.Coprime W := by
    apply Nat.Coprime.prod_left
    intro p hp
    obtain ⟨hp, hpW⟩ := Finset.mem_filter.mp hp
    exact (Nat.Prime.coprime_iff_not_dvd (Nat.prime_of_mem_primesLE hp)).mpr hpW
  have hwhole : (∏ j : Fin 39, d j) ∣ q := by
    apply hsq.isRadical 39 q
    simpa only [Finset.prod_const, Finset.card_univ, Fintype.card_fin] using
      Finset.prod_dvd_prod_of_dvd (s := Finset.univ) d (fun _ => q)
        (fun j _ => (hret j).trans (hrq (i.succAbove j)))
  exact ⟨hsq, hqW.coprime_dvd_left hwhole, hwhole, r, hr, hfr, hret⟩

theorem coherent_color_fiber_card {ι : Type*} [Fintype ι] [DecidableEq ι]
    (c : ℕ) (T : Finset ι) (f : ι → Fin c) :
    ((Finset.univ : Finset (ι → Fin c)).filter
      (fun g => ∀ i ∈ T, g i = f i)).card = c ^ Tᶜ.card := by
  classical
  have hfiber :
      (Finset.univ : Finset (ι → Fin c)).filter (fun g => ∀ i ∈ T, g i = f i) =
        Fintype.piFinset (fun i => if i ∈ T then {f i} else Finset.univ) := by
    ext g
    simp [Fintype.mem_piFinset, mem_ite]
  rw [hfiber, Fintype.card_piFinset]
  simp only [apply_ite, Finset.card_singleton, Finset.card_univ, Fintype.card_fin]
  simpa only [Finset.mem_compl, ite_not, Finset.prod_const] using
    Finset.prod_ite_mem_eq Tᶜ (fun _ : ι => c)

theorem coherent_color_projection_average {ι : Type*} [Fintype ι] [DecidableEq ι]
    (c : ℕ) (hc : 0 < c) (T : Finset ι) (E : (ι → Fin c) → ℝ)
    (hE : ∀ g, 0 ≤ E g)
    (hlocal : ∀ f g, (∀ i ∈ T, f i = g i) → E f = E g)
    (f : ι → Fin c) :
    E f ≤ (c : ℝ) ^ T.card / (c : ℝ) ^ Fintype.card ι * ∑ g, E g := by
  classical
  let S : Finset (ι → Fin c) :=
    Finset.univ.filter (fun g => ∀ i ∈ T, g i = f i)
  have hcard : S.card = c ^ Tᶜ.card := coherent_color_fiber_card c T f
  have hfiber : ∑ g ∈ S, E g = (c : ℝ) ^ Tᶜ.card * E f := by
    calc
      ∑ g ∈ S, E g = ∑ _g ∈ S, E f := by
        apply Finset.sum_congr rfl
        intro g hg
        exact hlocal g f (Finset.mem_filter.mp hg).2
      _ = (S.card : ℝ) * E f := by simp
      _ = (c : ℝ) ^ Tᶜ.card * E f := by rw [hcard, Nat.cast_pow]
  have hsum : (c : ℝ) ^ Tᶜ.card * E f ≤ ∑ g, E g := by
    rw [← hfiber]
    exact Finset.sum_le_sum_of_subset_of_nonneg (Finset.subset_univ S)
      (fun g _ _ => hE g)
  have hcR : 0 < (c : ℝ) := Nat.cast_pos.mpr hc
  rw [div_mul_eq_mul_div]
  apply (le_div_iff₀ (pow_pos hcR _)).mpr
  calc
    E f * (c : ℝ) ^ Fintype.card ι =
        (c : ℝ) ^ T.card * ((c : ℝ) ^ Tᶜ.card * E f) := by
      rw [← Finset.card_add_card_compl T, pow_add]
      ring
    _ ≤ (c : ℝ) ^ T.card * ∑ g, E g :=
      mul_le_mul_of_nonneg_left hsum (pow_nonneg hcR.le _)

theorem coherent_color_fullDiscrepancy_transfer {ι : Type*} [Fintype ι] [DecidableEq ι]
    (c : ℕ) (hc : 0 < c) (Q : Finset ℕ) (T : ℕ → Finset ι) (J : ℕ)
    (u : ℕ →₀ ℂ) (a : (ι → Fin c) → ℕ)
    (hlocal : ∀ q ∈ Q, ∀ f g : ι → Fin c,
      (∀ i ∈ T q, f i = g i) → a f % q = a g % q)
    (f : ℕ → ι → Fin c) :
    (∑ q ∈ Q, (q.divisors.card : ℝ) ^ J *
      ‖fullDiscrepancy u q (a (f q))‖) ≤
      ((c : ℝ) ^ Fintype.card ι)⁻¹ *
        ∑ g : ι → Fin c, ∑ q ∈ Q,
          (q.divisors.card : ℝ) ^ J * (c : ℝ) ^ (T q).card *
            ‖fullDiscrepancy u q (a g)‖ := by
  classical
  have hprojection (q : ℕ) (hq : q ∈ Q) :
      ‖fullDiscrepancy u q (a (f q))‖ ≤
        (c : ℝ) ^ (T q).card / (c : ℝ) ^ Fintype.card ι *
          ∑ g : ι → Fin c, ‖fullDiscrepancy u q (a g)‖ := by
    apply coherent_color_projection_average c hc (T q)
      (fun g => ‖fullDiscrepancy u q (a g)‖)
      (fun g => norm_nonneg _) _ (f q)
    intro g g' hgg'
    simp only [fullDiscrepancy,
      progressionMass, hlocal q hq g g' hgg']
  calc
    (∑ q ∈ Q, (q.divisors.card : ℝ) ^ J *
        ‖fullDiscrepancy u q (a (f q))‖) ≤
        ∑ q ∈ Q, (q.divisors.card : ℝ) ^ J *
          ((c : ℝ) ^ (T q).card / (c : ℝ) ^ Fintype.card ι *
            ∑ g : ι → Fin c, ‖fullDiscrepancy u q (a g)‖) := by
      apply Finset.sum_le_sum
      intro q hq
      exact mul_le_mul_of_nonneg_left (hprojection q hq)
        (pow_nonneg (Nat.cast_nonneg _) _)
    _ = ((c : ℝ) ^ Fintype.card ι)⁻¹ *
        ∑ g : ι → Fin c, ∑ q ∈ Q,
          (q.divisors.card : ℝ) ^ J * (c : ℝ) ^ (T q).card *
            ‖fullDiscrepancy u q (a g)‖ := by
      simp only [Finset.mul_sum]
      rw [Finset.sum_comm]
      apply Finset.sum_congr rfl
      intro g hg
      apply Finset.sum_congr rfl
      intro q hq
      ring

theorem selberg_prime_face_residue_choice {k : ℕ}
    (h : Fin (k + 1) → ℕ) (i : Fin (k + 1)) (d e : Fin k → ℕ) (b : ℕ)
    (hd : ∀ j : Fin k, d j ∣ b + h (i.succAbove j))
    (he : ∀ j : Fin k, e j ∣ b + h (i.succAbove j))
    (p : ℕ) (hp : p.Prime) (hpm : p ∣ ∏ j : Fin k, Nat.lcm (d j) (e j)) :
    ∃ j : Fin k, ((b + h i : ℕ) : ZMod p) =
      (h i : ZMod p) - (h (i.succAbove j) : ZMod p) := by
  classical
  obtain ⟨j, _, hpj⟩ :=
    (hp.prime.dvd_finsetProd_iff (fun j : Fin k => Nat.lcm (d j) (e j))).mp hpm
  have hzero : (b : ZMod p) + (h (i.succAbove j) : ZMod p) = 0 := by
    simpa only [Nat.cast_add] using
      (ZMod.natCast_eq_zero_iff (b + h (i.succAbove j)) p).mpr
        (hpj.trans (Nat.lcm_dvd (hd j) (he j)))
  refine ⟨j, ?_⟩
  push_cast
  linear_combination hzero

theorem selberg_prime_face_residue_alphabet {k : ℕ}
    (h : Fin (k + 1) → ℕ) (hinj : Function.Injective h) (i : Fin (k + 1))
    (W : ℕ)
    (hcover : ∀ a b : Fin (k + 1), h a ≠ h b → ∀ p : ℕ,
      p.Prime → p ∣ Nat.dist (h a) (h b) → p ∣ W)
    (p : ℕ) (hp : p.Prime) (hpW : ¬ p ∣ W) :
    (∀ j : Fin k, (h i : ZMod p) - (h (i.succAbove j) : ZMod p) ≠ 0) ∧
      Function.Injective
        (fun j : Fin k => (h i : ZMod p) - (h (i.succAbove j) : ZMod p)) := by
  have hmodinj : Function.Injective (fun j : Fin (k + 1) => (h j : ZMod p)) := by
    intro a b hab
    apply hinj
    by_contra hne
    apply hpW
    apply hcover a b hne p hp
    have hmod := (ZMod.natCast_eq_natCast_iff (h a) (h b) p).mp hab
    rcases le_total (h a) (h b) with hle | hle
    · simpa only [Nat.dist_eq_sub_of_le hle] using hmod.dvd'
    · simpa only [Nat.dist_eq_sub_of_le_right hle] using hmod.symm.dvd'
  constructor
  · intro j hj
    exact (Fin.ne_succAbove i j) (hmodinj (sub_eq_zero.mp hj))
  · intro j l hjl
    apply (i.succAboveEmb).injective
    apply hmodinj
    exact sub_right_injective hjl

theorem coherent_prime_color_crt (P : Finset ℕ) (hP : ∀ p ∈ P, p.Prime)
    (c : ℕ) (r : (p : P) → Fin c → ZMod (p : ℕ))
    (hr : ∀ (p : P) (j : Fin c), r p j ≠ 0) :
    ∃ a : (P → Fin c) → ℕ,
      (∀ f, a f < ∏ p ∈ P, p) ∧
      (∀ (f : P → Fin c) (p : P), (a f : ZMod (p : ℕ)) = r p (f p)) ∧
      (∀ q : ℕ, Squarefree q → q.primeFactors ⊆ P →
        ∀ f : P → Fin c, Nat.Coprime (a f) q) ∧
      (∀ q : ℕ, Squarefree q → q.primeFactors ⊆ P →
        ∀ f g : P → Fin c,
          (∀ p : P, (p : ℕ) ∈ q.primeFactors → r p (f p) = r p (g p)) →
          a f % q = a g % q) := by
  classical
  have hnz (p : P) (_hp : p ∈ (Finset.univ : Finset P)) : (p : ℕ) ≠ 0 :=
    (hP p p.property).ne_zero
  have hpair : Set.Pairwise (↑(Finset.univ : Finset P) : Set P)
      (fun p q => Nat.Coprime (p : ℕ) (q : ℕ)) := by
    intro p _ q _ hpq
    exact (Nat.coprime_primes (hP p p.property) (hP q q.property)).mpr
      (fun h => hpq (Subtype.ext h))
  let a : (P → Fin c) → ℕ := fun f =>
    (Nat.chineseRemainderOfFinset (fun p : P => (r p (f p)).val)
      (fun p : P => (p : ℕ)) Finset.univ hnz hpair).val
  have hbound (f : P → Fin c) : a f < ∏ p ∈ P, p := by
    rw [← Finset.prod_coe_sort P (fun p : ℕ => p)]
    exact
      Nat.chineseRemainderOfFinset_lt_prod (fun p : P => (r p (f p)).val)
        (fun p : P => (p : ℕ)) hnz hpair
  have hres (f : P → Fin c) (p : P) : (a f : ZMod (p : ℕ)) = r p (f p) := by
    let : NeZero (p : ℕ) := ⟨(hP p p.property).ne_zero⟩
    have hclass : Nat.ModEq (p : ℕ) (a f) (r p (f p)).val :=
      (Nat.chineseRemainderOfFinset (fun p : P => (r p (f p)).val)
        (fun p : P => (p : ℕ)) Finset.univ hnz hpair).property p (Finset.mem_univ p)
    calc
      (a f : ZMod (p : ℕ)) = ((r p (f p)).val : ZMod (p : ℕ)) :=
        (ZMod.natCast_eq_natCast_iff _ _ _).mpr hclass
      _ = r p (f p) := ZMod.natCast_zmod_val _
  refine ⟨a, hbound, hres, ?_, ?_⟩
  · intro q hq hqP f
    apply Nat.coprime_of_dvd
    intro p hp hpa hpq
    have hpq' : p ∈ q.primeFactors := Nat.mem_primeFactors.mpr ⟨hp, hpq, hq.ne_zero⟩
    let pp : P := ⟨p, hqP hpq'⟩
    have hz : (a f : ZMod p) = 0 := (ZMod.natCast_eq_zero_iff (a f) p).mpr hpa
    exact hr pp (f pp) ((hres f pp).symm.trans hz)
  · intro q hq hqP f g hfg
    have hprod : (∏ p : q.primeFactors, (p : ℕ)) = q :=
      (Finset.prod_coe_sort q.primeFactors (fun p : ℕ => p)).trans
        (Nat.prod_primeFactors_of_squarefree hq)
    have hpairq : Pairwise
        (fun p t : q.primeFactors => Nat.Coprime (p : ℕ) (t : ℕ)) := by
      intro p t hpt
      exact (Nat.coprime_primes (Nat.prime_of_mem_primeFactors p.property)
        (Nat.prime_of_mem_primeFactors t.property)).mpr
          (fun h => hpt (Subtype.ext h))
    have hz : (a f : ZMod (∏ p : q.primeFactors, (p : ℕ))) =
        (a g : ZMod (∏ p : q.primeFactors, (p : ℕ))) := by
      apply (ZMod.prodEquivPi (fun p : q.primeFactors => (p : ℕ)) hpairq).injective
      funext p
      simp only [ZMod.prodEquivPi_apply, map_natCast]
      let pp : P := ⟨p, hqP p.property⟩
      change (a f : ZMod (pp : ℕ)) = (a g : ZMod (pp : ℕ))
      rw [hres f pp, hres g pp, hfg pp p.property]
    have hm : Nat.ModEq (∏ p : q.primeFactors, (p : ℕ)) (a f) (a g) :=
      (ZMod.natCast_eq_natCast_iff _ _ _).mp hz
    change Nat.ModEq q (a f) (a g)
    simpa only [hprod] using hm

theorem coherent_prime_color_fullDiscrepancy_transfer
    (P : Finset ℕ) (hP : ∀ p ∈ P, p.Prime) (c : ℕ) (hc : 0 < c)
    (r : (p : P) → Fin c → ZMod (p : ℕ))
    (hr : ∀ (p : P) (j : Fin c), r p j ≠ 0)
    (U : Finset P) (hfixed : ∀ p : P, p ∉ U → ∀ j l : Fin c, r p j = r p l)
    (Q : Finset ℕ) (hQ : ∀ q ∈ Q, Squarefree q ∧ q.primeFactors ⊆ P)
    (J : ℕ) (u : ℕ →₀ ℂ) :
    ∃ a : (P → Fin c) → ℕ,
      (∀ f, a f < ∏ p ∈ P, p) ∧
      (∀ (f : P → Fin c) (p : P), (a f : ZMod (p : ℕ)) = r p (f p)) ∧
      (∀ q ∈ Q, ∀ f : P → Fin c, Nat.Coprime (a f) q) ∧
      ∀ f : ℕ → P → Fin c,
        (∑ q ∈ Q, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy u q (a (f q))‖) ≤
          ((c : ℝ) ^ P.card)⁻¹ *
            ∑ g : P → Fin c, ∑ q ∈ Q,
              (q.divisors.card : ℝ) ^ J *
                (c : ℝ) ^ (U.filter (fun p : P => (p : ℕ) ∈ q.primeFactors)).card *
                ‖fullDiscrepancy u q (a g)‖ := by
  classical
  obtain ⟨a, habound, hres, hcoprime, hlocal⟩ := coherent_prime_color_crt P hP c r hr
  refine ⟨a, habound, hres, ?_, ?_⟩
  · intro q hq f
    exact hcoprime q (hQ q hq).1 (hQ q hq).2 f
  · intro f
    let T : ℕ → Finset P := fun q => U.filter
      (fun p : P => (p : ℕ) ∈ q.primeFactors)
    have hlocalT (q : ℕ) (hq : q ∈ Q) (g g' : P → Fin c)
        (hgg' : ∀ p ∈ T q, g p = g' p) : a g % q = a g' % q := by
      apply hlocal q (hQ q hq).1 (hQ q hq).2 g g'
      intro p hp
      by_cases hpU : p ∈ U
      · exact congrArg (r p) (hgg' p (Finset.mem_filter.mpr ⟨hpU, hp⟩))
      · exact hfixed p hpU (g p) (g' p)
    have hbound := coherent_color_fullDiscrepancy_transfer c hc Q T J u a hlocalT f
    simpa only [T, Fintype.card_coe] using hbound

theorem selberg40_color_representation_loss (q : ℕ) (hq : Squarefree q) :
    (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 117) q) *
        39 ^ q.primeFactors.card ≤ q.divisors.card ^ 13 := by
  have hprime (k : ℕ) (p : ℕ) (hp : p.Prime) :
      (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ k) p) = k := by
    induction k with
    | zero => simp [hp.ne_one]
    | succ k ih =>
      rw [pow_succ, ArithmeticFunction.mul_zeta_apply, hp.divisors]
      have hone : (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ k) 1) = 1 :=
        (ArithmeticFunction.isMultiplicative_zeta.pow).1
      simp only [Finset.sum_insert (show (1 : ℕ) ∉ ({p} : Finset ℕ) by
          simpa only [Finset.mem_singleton] using hp.ne_one.symm),
        Finset.sum_singleton, hone, ih]
      omega
  have hpow : (((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 117) q) =
      117 ^ q.primeFactors.card := by
    rw [← (ArithmeticFunction.isMultiplicative_zeta.pow).prod_primeFactors hq,
      ← Finset.prod_const 117]
    exact Finset.prod_congr rfl fun p hp =>
      hprime 117 p (Nat.prime_of_mem_primeFactors hp)
  rw [hpow, squarefree_card_divisors q hq]
  calc
    117 ^ q.primeFactors.card * 39 ^ q.primeFactors.card =
        (117 * 39) ^ q.primeFactors.card := (mul_pow _ _ _).symm
    _ ≤ (2 ^ 13) ^ q.primeFactors.card :=
      Nat.pow_le_pow_left (by norm_num : 117 * 39 ≤ 2 ^ 13) q.primeFactors.card
    _ = (2 ^ q.primeFactors.card) ^ 13 := by
      rw [← pow_mul, ← pow_mul, Nat.mul_comm 13 q.primeFactors.card]

theorem coherent_actual_residue_fullDiscrepancy_transfer
    (P : Finset ℕ) (hP : ∀ p ∈ P, p.Prime) (c : ℕ) (hc : 0 < c)
    (r : (p : P) → Fin c → ZMod (p : ℕ))
    (hr : ∀ (p : P) (j : Fin c), r p j ≠ 0)
    (U : Finset P) (hfixed : ∀ p : P, p ∉ U → ∀ j l : Fin c, r p j = r p l)
    (Q : Finset ℕ) (hQ : ∀ q ∈ Q, Squarefree q ∧ q.primeFactors ⊆ P)
    (J : ℕ) (u : ℕ →₀ ℂ) (b : ℕ → ℕ)
    (hchoices : ∀ q ∈ Q, ∀ p : P, (p : ℕ) ∈ q.primeFactors →
      ∃ j : Fin c, (b q : ZMod (p : ℕ)) = r p j) :
    ∃ a : (P → Fin c) → ℕ,
      (∀ f, a f < ∏ p ∈ P, p) ∧
      (∀ (f : P → Fin c) (p : P), (a f : ZMod (p : ℕ)) = r p (f p)) ∧
      (∀ q ∈ Q, ∀ f : P → Fin c, Nat.Coprime (a f) q) ∧
      (∑ q ∈ Q, (q.divisors.card : ℝ) ^ J *
        ‖fullDiscrepancy u q (b q)‖) ≤
        ((c : ℝ) ^ P.card)⁻¹ *
          ∑ g : P → Fin c, ∑ q ∈ Q,
            (q.divisors.card : ℝ) ^ J *
              (c : ℝ) ^ (U.filter (fun p : P => (p : ℕ) ∈ q.primeFactors)).card *
              ‖fullDiscrepancy u q (a g)‖ := by
  classical
  obtain ⟨a, habound, hres, hcoprime, htransfer⟩ :=
    coherent_prime_color_fullDiscrepancy_transfer P hP c hc r hr U hfixed Q hQ J u
  let f : ℕ → P → Fin c := fun q p =>
    if hq : q ∈ Q then
      if hp : (p : ℕ) ∈ q.primeFactors then Classical.choose (hchoices q hq p hp)
      else ⟨0, hc⟩
    else ⟨0, hc⟩
  have hf (q : ℕ) (hq : q ∈ Q) (p : P) (hp : (p : ℕ) ∈ q.primeFactors) :
      (b q : ZMod (p : ℕ)) = r p (f q p) := by
    dsimp only [f]
    rw [dite_eq_left hq, dite_eq_left hp]
    exact Classical.choose_spec (hchoices q hq p hp)
  have hmod (q : ℕ) (hq : q ∈ Q) : a (f q) % q = b q % q := by
    have hpair : q.primeFactors.toList.Pairwise Nat.Coprime := by
      apply q.primeFactors.nodup_toList.pairwise_of_forall_ne
      intro p hp t ht hpt
      exact (Nat.coprime_primes
        (Nat.prime_of_mem_primeFactors (Finset.mem_toList.mp hp))
        (Nat.prime_of_mem_primeFactors (Finset.mem_toList.mp ht))).mpr hpt
    have hlist : Nat.ModEq (q.primeFactors.toList.map (fun p : ℕ => p)).prod
        (a (f q)) (b q) := by
      apply (Nat.modEq_list_map_prod_iff (s := fun p : ℕ => p) hpair).mpr
      intro p hp
      have hpq : p ∈ q.primeFactors := Finset.mem_toList.mp hp
      let pp : P := ⟨p, (hQ q hq).2 hpq⟩
      apply (ZMod.natCast_eq_natCast_iff (a (f q)) (b q) p).mp
      exact (hres (f q) pp).trans (hf q hq pp hpq).symm
    change Nat.ModEq q (a (f q)) (b q)
    simpa [Finset.prod_toList, Nat.prod_primeFactors_of_squarefree (hQ q hq).1] using hlist
  refine ⟨a, habound, hres, hcoprime, ?_⟩
  calc
    (∑ q ∈ Q, (q.divisors.card : ℝ) ^ J *
        ‖fullDiscrepancy u q (b q)‖) =
        ∑ q ∈ Q, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy u q (a (f q))‖ := by
      apply Finset.sum_congr rfl
      intro q hq
      simp only [fullDiscrepancy,
        progressionMass, hmod q hq]
    _ ≤ ((c : ℝ) ^ P.card)⁻¹ *
          ∑ g : P → Fin c, ∑ q ∈ Q,
            (q.divisors.card : ℝ) ^ J *
              (c : ℝ) ^ (U.filter (fun p : P => (p : ℕ) ∈ q.primeFactors)).card *
              ‖fullDiscrepancy u q (a g)‖ := htransfer f

section
open scoped ContDiff

theorem selberg_auxiliary_unit_diagonal
    (P : Finset ℕ) (hP : ∀ p ∈ P, p.Prime) (B : ℝ) (hB : 0 < B) :
    let q : ℕ := ∏ p ∈ P, p
    let u : (Fin 1 → ℕ) →₀ ℝ :=
      ∑ s ∈ q.divisors, Finsupp.single (fun _ : Fin 1 => s) (1 / B)
    let Du := u.support.biUnion
      (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let mass : ℝ := ∑ s ∈ q.divisors, (s.totient : ℝ)⁻¹
    let L : ℕ → ℝ := fun t =>
      ∑ e ∈ Du, if e 0 ∣ t then selbergCoefficient u e else 0
    (∀ r : Fin 1 → ℕ, u r = if r 0 ∈ q.divisors then 1 / B else 0) ∧
      u.support = Fintype.piFinset (fun _ : Fin 1 => q.divisors) ∧
      Du = Fintype.piFinset (fun _ : Fin 1 => q.divisors) ∧
      (∀ r : Fin 1 → ℕ, |u r| ≤ 1 / B) ∧
      mass = (q : ℝ) / (q.totient : ℝ) ∧ 0 < mass ∧
      (∑ r ∈ u.support, u r ^ 2 / (∏ j, ((r j).totient : ℝ))) = mass / B ^ 2 ∧
      ∀ t : ℕ, L t = (mass / B) * (if Nat.Coprime t q then 1 else 0) := by
  classical
  intro q u Du mass L
  have hq : Squarefree q := squarefree_prime_prod P hP
  have hq0 : q ≠ 0 := hq.ne_zero
  have hqpos : 0 < (q : ℝ) := by exact_mod_cast Nat.pos_of_ne_zero hq0
  have hφpos : 0 < (q.totient : ℝ) := by
    exact_mod_cast Nat.totient_pos.mpr (Nat.pos_of_ne_zero hq0)
  have hconst (r : Fin 1 → ℕ) : (fun _ : Fin 1 => r 0) = r := by
    funext j
    exact congrArg r (Subsingleton.elim 0 j)
  have hvalue (r : Fin 1 → ℕ) :
      u r = if r 0 ∈ q.divisors then 1 / B else 0 := by
    conv_lhs => rw [← hconst r]
    simp only [u, Finsupp.finsetSum_apply, Finsupp.single_apply]
    have hc (s : ℕ) : ((fun _ : Fin 1 => s) = fun _ : Fin 1 => r 0) ↔ s = r 0 :=
      Function.const_inj
    simp only [hc, Finset.sum_ite_eq']
  have hsupport : u.support = Fintype.piFinset (fun _ : Fin 1 => q.divisors) := by
    ext r
    rw [Finsupp.mem_support_iff, Fintype.mem_piFinset]
    simp only [Fin.forall_fin_one, hvalue]
    by_cases hr : r 0 ∈ q.divisors <;> simp [hr, hB.ne']
  have hDu : Du = Fintype.piFinset (fun _ : Fin 1 => q.divisors) := by
    ext e
    change e ∈ u.support.biUnion _ ↔ _
    rw [Finset.mem_biUnion, hsupport]
    constructor
    · rintro ⟨r, hr, he⟩
      apply Fintype.mem_piFinset.mpr
      intro j
      exact Nat.mem_divisors.mpr ⟨
        (Nat.dvd_of_mem_divisors (Fintype.mem_piFinset.mp he j)).trans
          (Nat.dvd_of_mem_divisors (Fintype.mem_piFinset.mp hr j)), hq0⟩
    · intro he
      refine ⟨fun _ : Fin 1 => q, ?_, he⟩
      exact Fintype.mem_piFinset.mpr fun _ => Nat.mem_divisors_self q hq0
  have huBound (r : Fin 1 → ℕ) : |u r| ≤ 1 / B := by
    rw [hvalue]
    split_ifs
    · exact le_of_eq (abs_of_pos (one_div_pos.mpr hB))
    · simpa only [abs_zero] using (one_div_pos.mpr hB).le
  have hsum (f : (Fin 1 → ℕ) → ℝ) :
      (∑ r ∈ Fintype.piFinset (fun _ : Fin 1 => q.divisors), f r) =
        ∑ s ∈ q.divisors, f (fun _ : Fin 1 => s) := by
    apply Finset.sum_bij (fun r _ => r 0)
    · intro r hr
      exact Fintype.mem_piFinset.mp hr 0
    · intro r _ s _ hrs
      rw [← hconst r, ← hconst s, hrs]
    · intro s hs
      exact ⟨fun _ : Fin 1 => s, Fintype.mem_piFinset.mpr (fun _ => hs), rfl⟩
    · intro r _
      rw [hconst]
  have hmassProduct : mass = ∏ p ∈ P, (1 + 1 / ((p : ℝ) - 1)) :=
    reciprocal_totient_product P hP
  have hmassratio : mass = (q : ℝ) / (q.totient : ℝ) :=
    (squarefree_div_totient_eq_sum_divisors_inv_totient hq).symm
  have hmasspos : 0 < mass := by rw [hmassratio]; exact div_pos hqpos hφpos
  have huEnergy :
      (∑ r ∈ u.support, u r ^ 2 / (∏ j, ((r j).totient : ℝ))) = mass / B ^ 2 := by
    rw [hsupport, hsum]
    calc
      _ = ∑ s ∈ q.divisors, (s.totient : ℝ)⁻¹ / B ^ 2 := by
        apply Finset.sum_congr rfl
        intro s hs
        rw [hvalue, ite_eq_left hs, Fin.prod_univ_one]
        simp only [div_eq_mul_inv]
        ring
      _ = mass / B ^ 2 := by rw [Finset.sum_div]
  refine ⟨hvalue, hsupport, hDu, huBound, hmassratio, hmasspos, huEnergy, ?_⟩
  intro t
  let ψ : ℕ → ℝ := fun p =>
    (1 - (p : ℝ) * (if p ∣ t then 1 else 0)) / ((p : ℝ) - 1)
  have huSq : ∀ r ∈ u.support, Squarefree (∏ j, r j) := by
    intro r hr
    have hs : r 0 ∈ q.divisors :=
      Fintype.mem_piFinset.mp (hsupport ▸ hr) 0
    simpa only [Fin.prod_univ_one] using hq.squarefree_of_dvd (Nat.dvd_of_mem_divisors hs)
  have hpoint : L t = ∑ r ∈ u.support,
      u r * ∏ p ∈ (r 0).primeFactors, ψ p := by
    simpa only [L, Du, Fin.forall_fin_one, Fin.prod_univ_one, ψ] using
      selberg_pointwise_expansion u (fun _ : Fin 1 => t) huSq
  have hEuler : (∑ s ∈ q.divisors, ∏ p ∈ s.primeFactors, ψ p) =
      ∏ p ∈ P, (1 + ψ p) := by
    have hm := ArithmeticFunction.IsMultiplicative.prodPrimeFactors_one_add_of_squarefree
      (ArithmeticFunction.IsMultiplicative.prodPrimeFactors ψ) hq
    calc
      _ = ∑ s ∈ q.divisors, ArithmeticFunction.prodPrimeFactors ψ s := by
        apply Finset.sum_congr rfl
        intro s hs
        rw [ArithmeticFunction.prodPrimeFactors_apply (Nat.pos_of_mem_divisors hs).ne']
      _ = ∏ p ∈ P, (1 + ArithmeticFunction.prodPrimeFactors ψ p) := by
        simpa only [q, Nat.primeFactors_prod hP] using hm.symm
      _ = ∏ p ∈ P, (1 + ψ p) := by
        apply Finset.prod_congr rfl
        intro p hp
        rw [ArithmeticFunction.prodPrimeFactors_apply (hP p hp).ne_zero,
          (hP p hp).primeFactors, Finset.prod_singleton]
  have hpointProduct : L t = (1 / B) * ∏ p ∈ P, (1 + ψ p) := by
    rw [hpoint, hsupport, hsum]
    calc
      _ = (1 / B) * ∑ s ∈ q.divisors, ∏ p ∈ s.primeFactors, ψ p := by
        rw [Finset.mul_sum]
        apply Finset.sum_congr rfl
        intro s hs
        rw [hvalue, ite_eq_left hs]
      _ = _ := by rw [hEuler]
  rw [hpointProduct]
  by_cases hcop : Nat.Coprime t q
  · rw [ite_eq_left hcop, mul_one]
    have hfactor : (∏ p ∈ P, (1 + ψ p)) = mass := by
      rw [hmassProduct]
      apply Finset.prod_congr rfl
      intro p hp
      have hpnot : ¬ p ∣ t :=
        (hP p hp).coprime_iff_not_dvd.mp
          (Nat.Coprime.of_dvd_right (Finset.dvd_prod_of_mem (fun p : ℕ => p) hp) hcop).symm
      simp only [ψ, ite_eq_right hpnot, mul_zero, sub_zero]
    rw [hfactor]
    ring
  · rw [ite_eq_right hcop, mul_zero]
    obtain ⟨p, hp, hpt, hpq⟩ := Nat.Prime.not_coprime_iff_dvd.mp hcop
    have hpP : p ∈ P := by
      rw [← Nat.primeFactors_prod hP]
      exact hp.mem_primeFactors hpq hq0
    have hp1 : (p : ℝ) - 1 ≠ 0 :=
      ne_of_gt (sub_pos.mpr (by exact_mod_cast hp.one_lt))
    have hzero : 1 + ψ p = 0 := by
      simp only [ψ, ite_eq_left hpt, mul_one]
      field_simp
      ring
    rw [Finset.prod_eq_zero hpP hzero, mul_zero]

open Classical in
theorem squarefree_coprime_progression_density
    (q m a h : ℕ) (hq : Squarefree q) (hm : m ∣ q)
    (ha : Nat.Coprime (a + h) m) :
    (1 / (q.totient : ℝ)) *
      (∑ n ∈ Finset.range q,
        if Nat.ModEq m n a ∧ Nat.Coprime (n + h) q then (1 : ℝ) else 0) =
      1 / (m.totient : ℝ) := by
  have hq0 : 0 < q := Nat.pos_of_ne_zero hq.ne_zero
  have hm0 : 0 < m := Nat.pos_of_dvd_of_pos hm hq0
  let : NeZero q := ⟨hq.ne_zero⟩
  have haM : (a + h) % m ∈ primitiveResidues m :=
    Finset.mem_filter.mpr
      ⟨Finset.mem_range.mpr (Nat.mod_lt _ hm0), (ZMod.coprime_mod_iff_coprime (a + h) m).mpr ha⟩
  have hbaseC :
      (∑ n ∈ Finset.range q,
        if Nat.ModEq m n (a + h) ∧ Nat.Coprime n q then (1 : ℂ) else 0) /
          (q.totient : ℂ) = 1 / (m.totient : ℂ) := by
    have hsum :
        (∑ n ∈ Finset.range q,
          if Nat.ModEq m n (a + h) ∧ Nat.Coprime n q then (1 : ℂ) else 0) =
          ∑ n ∈ primitiveResidues q,
            if n % m = (a + h) % m then (1 : ℂ) else 0 := by
      rw [primitiveResidues, Finset.sum_filter]
      apply Finset.sum_congr rfl
      intro n hn
      by_cases hc : Nat.Coprime n q <;> by_cases hr : n % m = (a + h) % m <;>
        simp [Nat.ModEq, hc, hr]
    rw [hsum]
    have havg := average_primitiveResidues_mod hq0 hm
      (fun b : ℕ => if b = (a + h) % m then (1 : ℂ) else 0)
    simpa [haM] using havg
  have hbaseR :
      (∑ n ∈ Finset.range q,
        if Nat.ModEq m n (a + h) ∧ Nat.Coprime n q then (1 : ℝ) else 0) /
          (q.totient : ℝ) = 1 / (m.totient : ℝ) := by
    apply Complex.ofReal_injective
    push_cast
    simpa only [apply_ite, Complex.ofReal_one, Complex.ofReal_zero] using hbaseC
  have hsumrange (G : ℕ → ℝ) :
      (∑ n ∈ Finset.range q, G n) = ∑ z : ZMod q, G z.val := by
    cases q with
    | zero => omega
    | succ q => exact (Fin.sum_univ_eq_sum_range G (q + 1)).symm
  have hrotate (G : ℕ → ℝ) :
      (∑ n ∈ Finset.range q, G ((n + h) % q)) = ∑ n ∈ Finset.range q, G n := by
    rw [hsumrange, hsumrange]
    calc
      (∑ z : ZMod q, G ((z.val + h) % q)) =
          ∑ z : ZMod q, G (z + (h : ZMod q)).val := by
        apply Finset.sum_congr rfl
        intro z hz
        simp [ZMod.val_add, ZMod.val_natCast, Nat.add_mod]
      _ = ∑ z : ZMod q, G z.val :=
        Equiv.sum_comp (Equiv.addRight (h : ZMod q)) (fun z : ZMod q => G z.val)
  have hmod (n : ℕ) :
      Nat.ModEq m ((n + h) % q) (a + h) ↔ Nat.ModEq m n a := by
    change ((n + h) % q) % m = (a + h) % m ↔ n % m = a % m
    rw [Nat.mod_mod_of_dvd (n + h) hm]
    exact Nat.ModEq.add_iff_right (Nat.ModEq.refl h)
  let G : ℕ → ℝ := fun n =>
    if Nat.ModEq m n (a + h) ∧ Nat.Coprime n q then 1 else 0
  have hshift :
      (∑ n ∈ Finset.range q,
        if Nat.ModEq m n a ∧ Nat.Coprime (n + h) q then (1 : ℝ) else 0) =
        ∑ n ∈ Finset.range q, G n := by
    calc
      _ = ∑ n ∈ Finset.range q, G ((n + h) % q) := by
        apply Finset.sum_congr rfl
        intro n hn
        simp only [G, hmod n, ZMod.coprime_mod_iff_coprime]
      _ = ∑ n ∈ Finset.range q, G n := hrotate G
  rw [hshift]
  simpa only [G, one_div, div_eq_mul_inv, mul_comm, mul_one] using hbaseR

theorem selberg_retained_pair_modEq_iff {k : ℕ}
    (h : Fin k → ℕ) (d e : Fin k → ℕ)
    (hd : Squarefree (∏ j, d j)) (he : Squarefree (∏ j, e j))
    (hcross : ∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b))
    (c : ℕ) (hcd : ∀ j, d j ∣ c + h j) (hce : ∀ j, e j ∣ c + h j)
    (n : ℕ) :
    Nat.ModEq (∏ j, Nat.lcm (d j) (e j)) n c ↔
      (∀ j, d j ∣ n + h j) ∧ (∀ j, e j ∣ n + h j) := by
  classical
  let l := (Finset.univ : Finset (Fin k)).toList
  have hpairs := actual_modulus_pairwise_coprime_lcm d e hd he hcross
  have hpair : l.Pairwise
      (fun a b => Nat.Coprime (Nat.lcm (d a) (e a)) (Nat.lcm (d b) (e b))) := by
    apply (Finset.nodup_toList (Finset.univ : Finset (Fin k))).pairwise_of_forall_ne
    intro a ha b hb hab
    exact hpairs (Finset.mem_univ a) (Finset.mem_univ b) hab
  have hprod : (l.map (fun j => Nat.lcm (d j) (e j))).prod =
      ∏ j, Nat.lcm (d j) (e j) := by simp [l]
  have hcomponent (j : Fin k) :
      Nat.ModEq (Nat.lcm (d j) (e j)) n c ↔
        d j ∣ n + h j ∧ e j ∣ n + h j := by
    have hc0 : Nat.ModEq (Nat.lcm (d j) (e j)) (c + h j) 0 :=
      Nat.modEq_zero_iff_dvd.mpr (Nat.lcm_dvd (hcd j) (hce j))
    constructor
    · intro hn
      exact Nat.lcm_dvd_iff.mp
        (Nat.modEq_zero_iff_dvd.mp ((hn.add_right (h j)).trans hc0))
    · rintro ⟨hdn, hen⟩
      exact Nat.ModEq.add_right_cancel' (h j)
        ((Nat.modEq_zero_iff_dvd.mpr (Nat.lcm_dvd hdn hen)).trans hc0.symm)
  rw [← hprod, Nat.modEq_list_map_prod_iff hpair]
  simp only [l, Finset.mem_toList, Finset.mem_univ, forall_const, hcomponent, forall_and]

theorem selberg_prime_pair_density {k : ℕ}
    (h : Fin (k + 1) → ℕ) (hinj : Function.Injective h) (i : Fin (k + 1))
    (d e : Fin k → ℕ) (W v : ℕ) (hW : 0 < W)
    (hd : Squarefree (∏ j, d j) ∧ Nat.Coprime (∏ j, d j) W)
    (he : Squarefree (∏ j, e j) ∧ Nat.Coprime (∏ j, e j) W)
    (hcross : ∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b))
    (hcover : ∀ a b : Fin (k + 1), h a ≠ h b → ∀ p : ℕ,
      p.Prime → p ∣ Nat.dist (h a) (h b) → p ∣ W)
    (hv : Nat.Coprime (v + h i) W)
    (q : ℕ) (hq : Squarefree q) (hdq : (∏ j, d j) ∣ q) (heq : (∏ j, e j) ∣ q) :
    (1 / (q.totient : ℝ)) *
      (∑ n ∈ Finset.range q,
        if (∀ j : Fin k, d j ∣ n + h (i.succAbove j)) ∧
          (∀ j : Fin k, e j ∣ n + h (i.succAbove j)) ∧
          Nat.Coprime (n + h i) q then (1 : ℝ) else 0) =
      1 / (∏ j : Fin k, (Nat.totient (Nat.lcm (d j) (e j)) : ℝ)) := by
  classical
  have hdInsert : Squarefree (∏ j, i.insertNth (α := fun _ => ℕ) 1 d j) ∧
      Nat.Coprime (∏ j, i.insertNth (α := fun _ => ℕ) 1 d j) W := by
    simpa only [Fin.prod_insertNth, one_mul] using hd
  have hcrossInsert : ∀ a b : Fin k, a ≠ b →
      Nat.Coprime (i.insertNth (α := fun _ => ℕ) 1 d (i.succAbove a)) (e b) := by
    simpa only [Fin.insertNth_apply_succAbove] using hcross
  have hcrt := mixedPair_crt h hinj i
    (i.insertNth (α := fun _ => ℕ) 1 d) e W v hW
    hdInsert he hcrossInsert hcover hv
  simp only [Fin.insertNth_apply_succAbove] at hcrt
  obtain ⟨c, _, _, hcprimitive, hcclass⟩ := hcrt
  have hcdiv := (hcclass c).mp (Nat.ModEq.refl c)
  let m : ℕ := ∏ j : Fin k, Nat.lcm (d j) (e j)
  have hpure (n : ℕ) : Nat.ModEq m n c ↔
      (∀ j : Fin k, d j ∣ n + h (i.succAbove j)) ∧
      (∀ j : Fin k, e j ∣ n + h (i.succAbove j)) :=
    selberg_retained_pair_modEq_iff (fun j => h (i.succAbove j)) d e hd.1 he.1
      hcross c hcdiv.2.1 hcdiv.2.2 n
  have hdOne : Squarefree (∏ j, d j) ∧ Nat.Coprime (∏ j, d j) 1 := ⟨hd.1, by simp⟩
  have heOne : Squarefree (∏ j, e j) ∧ Nat.Coprime (∏ j, e j) 1 := ⟨he.1, by simp⟩
  have hmEq : m = Nat.lcm (∏ j, d j) (∏ j, e j) := by
    simpa only [Nat.lcm_one_left, one_mul] using
      (actual_modulus_eq_product 1 d e hdOne heOne hcross).symm
  have hmq : m ∣ q := by
    rw [hmEq]
    exact Nat.lcm_dvd hdq heq
  have hcm : Nat.Coprime (c + h i) m :=
    hcprimitive.of_dvd_right (dvd_mul_of_dvd_right (dvd_refl m) W)
  have hφ : m.totient = ∏ j : Fin k, Nat.totient (Nat.lcm (d j) (e j)) := by
    rw [hmEq]
    simpa only [Nat.lcm_one_left, Nat.totient_one, one_mul] using
      selberg_actual_modulus_totient_eq 1 (by decide) d e hdOne heOne hcross
  have hφR : (m.totient : ℝ) =
      ∏ j : Fin k, (Nat.totient (Nat.lcm (d j) (e j)) : ℝ) := by
    exact_mod_cast hφ
  calc
    (1 / (q.totient : ℝ)) *
        (∑ n ∈ Finset.range q,
          if (∀ j : Fin k, d j ∣ n + h (i.succAbove j)) ∧
            (∀ j : Fin k, e j ∣ n + h (i.succAbove j)) ∧
            Nat.Coprime (n + h i) q then (1 : ℝ) else 0) =
        (1 / (q.totient : ℝ)) *
          (∑ n ∈ Finset.range q,
            if Nat.ModEq m n c ∧ Nat.Coprime (n + h i) q then (1 : ℝ) else 0) := by
      congr 1
      apply Finset.sum_congr rfl
      intro n hn
      simp only [hpure n, and_assoc]
    _ = 1 / (m.totient : ℝ) :=
      squarefree_coprime_progression_density q m c (h i) hq hmq hcm
    _ = 1 / (∏ j : Fin k, (Nat.totient (Nat.lcm (d j) (e j)) : ℝ)) := by rw [hφR]

theorem selberg_prime_period_coefficient_identity
    {k : ℕ} (h : Fin (k + 1) → ℕ) (hinj : Function.Injective h)
    (i : Fin (k + 1)) (W v : ℕ) (hW : 0 < W)
    (hcover : ∀ a b : Fin (k + 1), h a ≠ h b → ∀ p : ℕ,
      p.Prime → p ∣ Nat.dist (h a) (h b) → p ∣ W)
    (hv : Nat.Coprime (v + h i) W)
    (q : ℕ) (hq : Squarefree q)
    (D E : Finset (Fin k → ℕ)) (lam mu : (Fin k → ℕ) → ℝ)
    (hD : ∀ d ∈ D,
      Squarefree (∏ j, d j) ∧ Nat.Coprime (∏ j, d j) W ∧ (∏ j, d j) ∣ q)
    (hE : ∀ e ∈ E,
      Squarefree (∏ j, e j) ∧ Nat.Coprime (∏ j, e j) W ∧ (∏ j, e j) ∣ q) :
    (1 / (q.totient : ℝ)) *
      (∑ n ∈ Finset.range q, if Nat.Coprime (n + h i) q then
        (∑ d ∈ D,
          if ∀ j : Fin k, d j ∣ n + h (i.succAbove j) then lam d else 0) *
        (∑ e ∈ E,
          if ∀ j : Fin k, e j ∣ n + h (i.succAbove j) then mu e else 0)
      else 0) =
      ∑ d ∈ D, ∑ e ∈ E,
        if ∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b) then
          lam d * mu e / (∏ j : Fin k, (Nat.totient (Nat.lcm (d j) (e j)) : ℝ))
        else 0 := by
  classical
  have hexpand :
      (∑ n ∈ Finset.range q, if Nat.Coprime (n + h i) q then
        (∑ d ∈ D,
          if ∀ j : Fin k, d j ∣ n + h (i.succAbove j) then lam d else 0) *
        (∑ e ∈ E,
          if ∀ j : Fin k, e j ∣ n + h (i.succAbove j) then mu e else 0)
      else 0) =
        ∑ d ∈ D, ∑ e ∈ E, (lam d * mu e) *
          ∑ n ∈ Finset.range q,
            if (∀ j : Fin k, d j ∣ n + h (i.succAbove j)) ∧
                (∀ j : Fin k, e j ∣ n + h (i.succAbove j)) ∧
                Nat.Coprime (n + h i) q then (1 : ℝ) else 0 := by
    calc
      _ = ∑ n ∈ Finset.range q, ∑ d ∈ D, ∑ e ∈ E,
          (lam d * mu e) *
            (if (∀ j : Fin k, d j ∣ n + h (i.succAbove j)) ∧
                (∀ j : Fin k, e j ∣ n + h (i.succAbove j)) ∧
                Nat.Coprime (n + h i) q then (1 : ℝ) else 0) := by
        apply Finset.sum_congr rfl
        intro n _hn
        by_cases hn : Nat.Coprime (n + h i) q
        · rw [ite_eq_left hn, Finset.sum_mul_sum]
          apply Finset.sum_congr rfl
          intro d _hd
          apply Finset.sum_congr rfl
          intro e _he
          split_ifs <;> simp_all
        · simp [hn]
      _ = ∑ d ∈ D, ∑ e ∈ E, ∑ n ∈ Finset.range q,
          (lam d * mu e) *
            (if (∀ j : Fin k, d j ∣ n + h (i.succAbove j)) ∧
                (∀ j : Fin k, e j ∣ n + h (i.succAbove j)) ∧
                Nat.Coprime (n + h i) q then (1 : ℝ) else 0) := by
        rw [Finset.sum_comm]
        apply Finset.sum_congr rfl
        intro d _hd
        exact Finset.sum_comm
      _ = _ := by simp_rw [Finset.mul_sum]
  rw [hexpand, Finset.mul_sum]
  apply Finset.sum_congr rfl
  intro d hd
  rw [Finset.mul_sum]
  apply Finset.sum_congr rfl
  intro e he
  by_cases hc : ∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b)
  · rw [ite_eq_left hc]
    have hpair := selberg_prime_pair_density h hinj i d e W v hW
      ⟨(hD d hd).1, (hD d hd).2.1⟩ ⟨(hE e he).1, (hE e he).2.1⟩
      hc hcover hv q hq (hD d hd).2.2 (hE e he).2.2
    calc
      _ = (lam d * mu e) * ((1 / (q.totient : ℝ)) *
          ∑ n ∈ Finset.range q,
            if (∀ j : Fin k, d j ∣ n + h (i.succAbove j)) ∧
                (∀ j : Fin k, e j ∣ n + h (i.succAbove j)) ∧
                Nat.Coprime (n + h i) q then (1 : ℝ) else 0) := by ring
      _ = (lam d * mu e) *
          (1 / (∏ j : Fin k, (Nat.totient (Nat.lcm (d j) (e j)) : ℝ))) := by
        rw [hpair]
      _ = _ := by ring
  · rw [ite_eq_right hc]
    have hzero : (∑ n ∈ Finset.range q,
        if (∀ j : Fin k, d j ∣ n + h (i.succAbove j)) ∧
            (∀ j : Fin k, e j ∣ n + h (i.succAbove j)) ∧
            Nat.Coprime (n + h i) q then (1 : ℝ) else 0) = 0 := by
      apply Finset.sum_eq_zero
      intro n _hn
      apply ite_eq_right
      intro hconditions
      have hdW : Nat.Coprime (∏ j, i.insertNth (α := fun _ => ℕ) 1 d j) W := by
        simpa only [Fin.prod_insertNth, one_mul] using (hD d hd).2.1
      have hnd : ∀ j : Fin k,
          i.insertNth (α := fun _ => ℕ) 1 d (i.succAbove j) ∣ n + h (i.succAbove j) := by
        simpa only [Fin.insertNth_apply_succAbove] using hconditions.1
      exact hc (by
        simpa only [Fin.insertNth_apply_succAbove] using
          mixedPair_compatible h hinj i
            (i.insertNth (α := fun _ => ℕ) 1 d) e W hdW hcover n
            hnd hconditions.2.1)
    rw [hzero, mul_zero, mul_zero]

end

section
open scoped ContDiff

theorem selberg39_prime_period_comparison
    {𝓗 : Finset ℕ} {h𝓗_card : 𝓗.card = 40}
    (i : Fin 40) (κ M : ℝ) (hκ : 0 < κ) (hM : 0 ≤ M) :
    ∀ ε : ℝ, 0 < ε → ∀ᶠ x : ℝ in Filter.atTop,
      let ρ : ℝ := 2624989 / 10000000
      let h : Fin 40 → ℕ :=
        𝓗.orderEmbOfFin h𝓗_card
      let W := presievingModulus 𝓗 x
      let R := x ^ ρ
      let B := fragmentNormalization W R
      let P := fragmentPrimes W R κ
      let q : ℕ := ∏ p ∈ P, p
      0 < B ∧ ∀ z : (Fin 39 → ℕ) →₀ ℝ,
        (∀ r ∈ z.support, Squarefree (∏ j, r j) ∧ ∀ j, r j ∈ q.divisors) →
        (∀ r, |z r| ≤ M / B ^ 39) →
        let Dz := z.support.biUnion
          (fun r => Fintype.piFinset (fun j => (r j).divisors))
        let C : ℕ → ℝ := fun n =>
          ∑ d ∈ Dz, if ∀ j, d j ∣ n + h (i.succAbove j) then
            selbergCoefficient z d else 0
        |(1 / (q.totient : ℝ)) * (∑ n ∈ Finset.range q,
            if Nat.Coprime (n + h i) q then C n ^ 2 else 0) -
          z.sum (fun r zr => zr ^ 2 / (∏ j, ((r j).totient : ℝ)))| ≤ ε / B ^ 39 := by
  classical
  intro ε hε
  let ρ : ℝ := 2624989 / 10000000
  have hρ : 0 < ρ := by norm_num [ρ]
  have hm := harmonic_fragment_normalizer_tendsto 𝓗 ρ κ hρ hκ
  have ht := presieved_prime_square_tail_tendsto 𝓗
  have he : Tendsto (fun x : ℝ => Real.exp (51200 *
      (∑' p : ℕ, if Nat.Prime p ∧ ¬ p ∣ presievingModulus 𝓗 x
        then 1 / (p : ℝ) ^ 2 else 0)) - 1) atTop (nhds 0) := by
    have h := (ht.const_mul (51200 : ℝ)).rexp.sub_const 1
    simpa only [mul_zero, Real.exp_zero, sub_self] using h
  have hsmall : Tendsto (fun x : ℝ =>
      M ^ 2 * (harmonicFragmentMass (presievingModulus 𝓗 x)
          (x ^ ρ) κ / fragmentNormalization (presievingModulus 𝓗 x)
          (x ^ ρ)) ^ 39 *
        (Real.exp (51200 * (∑' p : ℕ,
          if Nat.Prime p ∧ ¬ p ∣ presievingModulus 𝓗 x
          then 1 / (p : ℝ) ^ 2 else 0)) - 1)) atTop (nhds 0) := by
    have h := ((hm.pow 39).mul he).const_mul (M ^ 2)
    simpa only [mul_zero, mul_assoc] using h
  filter_upwards [eventually_gt_atTop (1 : ℝ),
    selberg40_auxiliary_period_comparison
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i κ M 1 hκ hM zero_le_one 1 zero_lt_one,
    hsmall.eventually_le_const hε] with x hx hcomparison hsmall
  intro ρ' h W R B P q
  have hB : 0 < B := hcomparison.1
  refine ⟨hB, ?_⟩
  intro z hz hzBound Dz C
  have hP (p : ℕ) (hp : p ∈ P) : p.Prime :=
    Nat.prime_of_mem_primesLE (Finset.mem_filter.mp hp).1
  let mass : ℝ := harmonicFragmentMass W R κ
  let tail : ℝ := ∑' p : ℕ,
    if Nat.Prime p ∧ ¬ p ∣ W then 1 / (p : ℝ) ^ 2 else 0
  let u : (Fin 1 → ℕ) →₀ ℝ :=
    ∑ s ∈ q.divisors, Finsupp.single (fun _ : Fin 1 => s) (1 / B)
  let Du := u.support.biUnion
    (fun s => Fintype.piFinset (fun j => (s j).divisors))
  let L : ℕ → ℝ := fun t =>
    ∑ e ∈ Du, if e 0 ∣ t then selbergCoefficient u e else 0
  obtain ⟨_huValue, huSupport, _hDu, huBound, hmassRatio, hmassPos, huEnergy₀, hL⟩ :=
    selberg_auxiliary_unit_diagonal P hP B hB
  change mass = (q : ℝ) / (q.totient : ℝ) at hmassRatio
  change 0 < mass at hmassPos
  change ∀ t : ℕ, L t = (mass / B) * (if Nat.Coprime t q then 1 else 0) at hL
  change (∑ r ∈ u.support, u r ^ 2 / (∏ j, ((r j).totient : ℝ))) =
    mass / B ^ 2 at huEnergy₀
  have huEnergy : u.sum (fun s us => us ^ 2 / ((s 0).totient : ℝ)) = mass / B ^ 2 := by
    simpa only [Finsupp.sum, Fin.prod_univ_one] using huEnergy₀
  have hu : ∀ s ∈ u.support, s 0 ∈ q.divisors := by
    intro s hs
    rw [huSupport] at hs
    exact (Fintype.mem_piFinset.mp hs) 0
  have hraw := (hcomparison.2 u z hu hz huBound hzBound 0).1
  obtain ⟨hq, _hcop, _hroots, _hexpansion, _hK, _hD, _hLperiod, _hCperiod,
      _hbijection, haffine⟩ :=
    selberg40_auxiliary_exact_period_bridge (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i x κ hx hκ u z hu hz
  have hmean : (1 / (q : ℝ)) *
      (∑ n ∈ Finset.range q, (L (W * n + h i) * C (W * n)) ^ 2) =
      (1 / (q : ℝ)) *
        (∑ n ∈ Finset.range q, (L (n + h i) * C n) ^ 2) := by
    simpa only [Nat.zero_add] using haffine 0
  let S : ℝ := ∑ n ∈ Finset.range q,
    if Nat.Coprime (n + h i) q then C n ^ 2 else 0
  let H : ℝ := z.sum (fun r zr => zr ^ 2 / (∏ j, ((r j).totient : ℝ)))
  let prime : ℝ := (1 / (q.totient : ℝ)) * S
  have hsum : (∑ n ∈ Finset.range q, (L (n + h i) * C n) ^ 2) =
      (mass / B) ^ 2 * S := by
    rw [Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro n hn
    rw [hL (n + h i)]
    by_cases hc : Nat.Coprime (n + h i) q <;> simp [hc, mul_pow]
  have hqR : (q : ℝ) ≠ 0 := by exact_mod_cast hq.ne'
  have hφR : (q.totient : ℝ) ≠ 0 := by
    exact_mod_cast (Nat.totient_pos.mpr hq).ne'
  have hshape :
      (1 / (q : ℝ)) * (∑ n ∈ Finset.range q, (L (n + h i) * C n) ^ 2) -
        u.sum (fun s us => us ^ 2 / ((s 0).totient : ℝ)) * H =
      (mass / B ^ 2) * (prime - H) := by
    rw [hsum, huEnergy]
    change (1 / (q : ℝ)) * ((mass / B) ^ 2 * S) - (mass / B ^ 2) * H =
      (mass / B ^ 2) * ((1 / (q.totient : ℝ)) * S - H)
    rw [hmassRatio]
    field_simp [hqR, hφR, hB.ne']
  have hscale : 0 < mass / B ^ 2 := div_pos hmassPos (pow_pos hB 2)
  have hscaled : (mass / B ^ 2) * |prime - H| ≤
      M ^ 2 / B ^ 80 * mass ^ 40 * (Real.exp (51200 * tail) - 1) := by
    change |(1 / (q : ℝ)) *
      (∑ n ∈ Finset.range q, (L (0 + W * n + h i) * C (0 + W * n)) ^ 2) -
      u.sum (fun s us => us ^ 2 / ((s 0).totient : ℝ)) * H| ≤
      M ^ 2 * 1 ^ 2 / B ^ 80 * mass ^ 40 * (Real.exp (51200 * tail) - 1) at hraw
    simpa only [Nat.zero_add, hmean, hshape, abs_mul, abs_of_pos hscale,
      one_pow, mul_one] using hraw
  change |prime - H| ≤ ε / B ^ 39
  calc
    |prime - H| = ((mass / B ^ 2) * |prime - H|) / (mass / B ^ 2) :=
      (mul_div_cancel_left₀ _ hscale.ne').symm
    _ ≤ (M ^ 2 / B ^ 80 * mass ^ 40 * (Real.exp (51200 * tail) - 1)) /
        (mass / B ^ 2) := div_le_div_of_nonneg_right hscaled hscale.le
    _ = (M ^ 2 * (mass / B) ^ 39 * (Real.exp (51200 * tail) - 1)) / B ^ 39 := by
      field_simp [hmassPos.ne', hB.ne']
    _ ≤ ε / B ^ 39 := div_le_div_of_nonneg_right hsmall (pow_nonneg hB.le _)

open Classical in
theorem selberg39_prime_diagonal_comparison
    {𝓗 : Finset ℕ} {h𝓗_card : 𝓗.card = 40}
    (i : Fin 40) (κ M : ℝ) (hκ : 0 < κ) (hM : 0 ≤ M) :
    ∀ ε : ℝ, 0 < ε → ∀ᶠ x : ℝ in Filter.atTop,
      let ρ : ℝ := 2624989 / 10000000
      let W := presievingModulus 𝓗 x
      let R := x ^ ρ
      let B := fragmentNormalization W R
      let q : ℕ := ∏ p ∈ fragmentPrimes W R κ, p
      0 < B ∧ ∀ z : (Fin 39 → ℕ) →₀ ℝ,
        (∀ r ∈ z.support, Squarefree (∏ j, r j) ∧ ∀ j, r j ∈ q.divisors) →
        (∀ r, |z r| ≤ M / B ^ 39) →
        let D := z.support.biUnion
          (fun r => Fintype.piFinset (fun j => (r j).divisors))
        |(∑ d ∈ D, ∑ e ∈ D,
            if ∀ a b : Fin 39, a ≠ b → Nat.Coprime (d a) (e b) then
              selbergCoefficient z d * selbergCoefficient z e /
                (∏ j, ((Nat.lcm (d j) (e j)).totient : ℝ)) else 0) -
          z.sum (fun r zr => zr ^ 2 / (∏ j, ((r j).totient : ℝ)))| ≤ ε / B ^ 39 := by
  intro ε hε
  filter_upwards [selberg39_prime_period_comparison
    (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i κ M hκ hM ε hε] with x hx
  intro ρ W R B q
  refine ⟨hx.1, ?_⟩
  intro z hz hzBound D
  let h : Fin 40 → ℕ := 𝓗.orderEmbOfFin h𝓗_card
  let P := fragmentPrimes W R κ
  have hP (p : ℕ) (hp : p ∈ P) : p.Prime :=
    Nat.prime_of_mem_primesLE (Finset.mem_filter.mp hp).1
  have hq : Squarefree q := squarefree_prime_prod P hP
  have hqW : q.Coprime W := by
    apply Nat.Coprime.prod_left
    intro p hp
    exact (hP p hp).coprime_iff_not_dvd.mpr (Finset.mem_filter.mp hp).2
  have hW : 0 < W := presieving_pos 𝓗 x
  have hclass (m a : ℕ) (hm : 0 < m) : ∃ v : ℕ, Nat.Coprime (v + a) m := by
    let : NeZero m := ⟨hm.ne'⟩
    let v := (1 - (a : ZMod m)).val
    refine ⟨v, (ZMod.isUnit_iff_coprime (v + a) m).mp ?_⟩
    have hvcast : ((v + a : ℕ) : ZMod m) = 1 := by
      simp only [Nat.cast_add, v, ZMod.natCast_zmod_val]
      ring
    rw [hvcast]
    exact isUnit_one
  obtain ⟨v, hv⟩ := hclass W (h i) hW
  have hinj : Function.Injective h :=
    (𝓗.orderEmbOfFin h𝓗_card).injective
  have hcover : ∀ a b : Fin 40, h a ≠ h b → ∀ p : ℕ,
      p.Prime → p ∣ Nat.dist (h a) (h b) → p ∣ W := by
    intro a b hab p hp hpd
    exact difference_prime_dvd_presieving 𝓗 x
      (𝓗.orderEmbOfFin_mem h𝓗_card a)
      (𝓗.orderEmbOfFin_mem h𝓗_card b) hab hp hpd
  have hD (d : Fin 39 → ℕ) (hd : d ∈ D) :
      Squarefree (∏ j, d j) ∧ (∏ j, d j).Coprime W ∧ (∏ j, d j) ∣ q := by
    obtain ⟨r, hr, hdr⟩ := Finset.mem_biUnion.mp hd
    have hdr' (j : Fin 39) : d j ∣ r j :=
      Nat.dvd_of_mem_divisors (Fintype.mem_piFinset.mp hdr j)
    have hdq (j : Fin 39) : d j ∣ q :=
      (hdr' j).trans (Nat.dvd_of_mem_divisors ((hz r hr).2 j))
    have hds : Squarefree (∏ j, d j) :=
      (hz r hr).1.squarefree_of_dvd
        (Finset.prod_dvd_prod_of_dvd d r (fun j _ => hdr' j))
    have hdpow : (∏ j : Fin 39, d j) ∣ q ^ 39 := by
      simpa only [Finset.prod_const, Finset.card_univ, Fintype.card_fin] using
        Finset.prod_dvd_prod_of_dvd (s := Finset.univ) d
          (fun _ : Fin 39 => q) (fun j _ => hdq j)
    have hdprod : (∏ j, d j) ∣ q :=
      hds.isRadical 39 q hdpow
    exact ⟨hds, hqW.of_dvd_left hdprod, hdprod⟩
  have hkernel := selberg_prime_period_coefficient_identity h hinj i W v hW
    hcover hv q hq D D (selbergCoefficient z) (selbergCoefficient z) hD hD
  have hperiod := hx.2 z hz hzBound
  have hrewrite :
      (1 / (q.totient : ℝ)) * (∑ n ∈ Finset.range q,
        if Nat.Coprime (n + h i) q then
          (∑ d ∈ D, if ∀ j, d j ∣ n + h (i.succAbove j) then
            selbergCoefficient z d else 0) ^ 2 else 0) =
      ∑ d ∈ D, ∑ e ∈ D,
        if ∀ a b : Fin 39, a ≠ b → Nat.Coprime (d a) (e b) then
          selbergCoefficient z d * selbergCoefficient z e /
            (∏ j, ((Nat.lcm (d j) (e j)).totient : ℝ)) else 0 := by
    simpa only [pow_two] using hkernel
  change |(1 / (q.totient : ℝ)) * (∑ n ∈ Finset.range q,
      if Nat.Coprime (n + h i) q then
        (∑ d ∈ D, if ∀ j, d j ∣ n + h (i.succAbove j) then
          selbergCoefficient z d else 0) ^ 2 else 0) -
      z.sum (fun r zr => zr ^ 2 / (∏ j, ((r j).totient : ℝ)))| ≤
    ε / B ^ 39 at hperiod
  rw [hrewrite] at hperiod
  exact hperiod

theorem selberg39_prime_bilinear_comparison
    {𝓗 : Finset ℕ} {h𝓗_card : 𝓗.card = 40}
    (i : Fin 40) (κ M M' : ℝ) (hκ : 0 < κ) (hM : 0 ≤ M) (hM' : 0 ≤ M') :
    ∀ ε : ℝ, 0 < ε → ∀ᶠ x : ℝ in Filter.atTop,
      let ρ : ℝ := 2624989 / 10000000
      let W := presievingModulus 𝓗 x
      let R := x ^ ρ
      let B := fragmentNormalization W R
      let q : ℕ := ∏ p ∈ fragmentPrimes W R κ, p
      0 < B ∧ ∀ z z' : (Fin 39 → ℕ) →₀ ℝ,
        (∀ r ∈ z.support, Squarefree (∏ j, r j) ∧ ∀ j, r j ∈ q.divisors) →
        (∀ r ∈ z'.support, Squarefree (∏ j, r j) ∧ ∀ j, r j ∈ q.divisors) →
        (∀ r, |z r| ≤ M / B ^ 39) → (∀ r, |z' r| ≤ M' / B ^ 39) →
        let D := z.support.biUnion
          (fun r => Fintype.piFinset (fun j => (r j).divisors))
        let E := z'.support.biUnion
          (fun r => Fintype.piFinset (fun j => (r j).divisors))
        |(∑ d ∈ D, ∑ e ∈ E,
            if ∀ a b : Fin 39, a ≠ b → Nat.Coprime (d a) (e b) then
              selbergCoefficient z d * selbergCoefficient z' e /
                (∏ j, ((Nat.lcm (d j) (e j)).totient : ℝ)) else 0) -
          z.sum (fun r zr => zr * z' r / (∏ j, ((r j).totient : ℝ)))| ≤
            ε / B ^ 39 := by
  classical
  intro ε hε
  filter_upwards [selberg39_prime_period_comparison (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i κ (M + M') hκ
    (add_nonneg hM hM') (2 * ε) (mul_pos (by norm_num) hε)] with x hx
  intro ρ W R B q
  refine ⟨hx.1, ?_⟩
  intro z z' hz hz' hzBound hzBound' D E
  let h : Fin 40 → ℕ := 𝓗.orderEmbOfFin h𝓗_card
  let K := z.support ∪ z'.support
  let roots : ((Fin 39 → ℕ) →₀ ℝ) → Finset (Fin 39 → ℕ) := fun w =>
    w.support.biUnion (fun r => Fintype.piFinset (fun j => (r j).divisors))
  let C : ((Fin 39 → ℕ) →₀ ℝ) → ℕ → ℝ := fun w n =>
    ∑ d ∈ roots w, if ∀ j, d j ∣ n + h (i.succAbove j) then
      selbergCoefficient w d else 0
  let H : ((Fin 39 → ℕ) →₀ ℝ) → ℝ := fun w =>
    w.sum (fun r wr => wr ^ 2 / (∏ j, ((r j).totient : ℝ)))
  let Q : ((Fin 39 → ℕ) →₀ ℝ) → ℝ := fun w =>
    (1 / (q.totient : ℝ)) * (∑ n ∈ Finset.range q,
      if Nat.Coprime (n + h i) q then C w n ^ 2 else 0)
  let Hcross : ℝ := z.sum (fun r zr => zr * z' r / (∏ j, ((r j).totient : ℝ)))
  let Qcross : ℝ := (1 / (q.totient : ℝ)) * (∑ n ∈ Finset.range q,
    if Nat.Coprime (n + h i) q then C z n * C z' n else 0)
  have hsupport (w : (Fin 39 → ℕ) →₀ ℝ) (hw : w.support ⊆ K) :
      ∀ r ∈ w.support, Squarefree (∏ j, r j) ∧ ∀ j, r j ∈ q.divisors := by
    intro r hr
    rcases Finset.mem_union.mp (hw hr) with hr | hr
    · exact hz r hr
    · exact hz' r hr
  have hplusBound (r : Fin 39 → ℕ) : |(z + z') r| ≤ (M + M') / B ^ 39 := by
    calc
      |(z + z') r| ≤ |z r| + |z' r| := abs_add_le _ _
      _ ≤ M / B ^ 39 + M' / B ^ 39 := add_le_add (hzBound r) (hzBound' r)
      _ = (M + M') / B ^ 39 := (add_div _ _ _).symm
  have hminusBound (r : Fin 39 → ℕ) : |(z - z') r| ≤ (M + M') / B ^ 39 := by
    calc
      |(z - z') r| ≤ |z r| + |z' r| := by
        simpa only [Real.norm_eq_abs, Finsupp.sub_apply] using norm_sub_le (z r) (z' r)
      _ ≤ M / B ^ 39 + M' / B ^ 39 := add_le_add (hzBound r) (hzBound' r)
      _ = (M + M') / B ^ 39 := (add_div _ _ _).symm
  have hplus : |Q (z + z') - H (z + z')| ≤ (2 * ε) / B ^ 39 :=
    hx.2 (z + z') (hsupport _ Finsupp.support_add) hplusBound
  have hminus : |Q (z - z') - H (z - z')| ≤ (2 * ε) / B ^ 39 :=
    hx.2 (z - z') (hsupport _ Finsupp.support_sub) hminusBound
  have hrootsEq (e : DecidableEq (Fin 39)) (w : (Fin 39 → ℕ) →₀ ℝ) :
      w.support.biUnion (fun r => @Fintype.piFinset (Fin 39) e inferInstance
        (fun _ => ℕ) (fun j => (r j).divisors)) = roots w := by
    ext d
    simp only [roots, Finset.mem_biUnion, Fintype.mem_piFinset]
  have hCplus (n : ℕ) : C (z + z') n = C z n + C z' n := by
    convert selberg_divisor_root_finset_combination (Finset.univ : Finset (Fin 2))
      (fun _ => (1 : ℝ)) ![z, z'] (fun j => n + h (i.succAbove j)) using 1 <;>
      simp only [Fin.sum_univ_two, C, hrootsEq, one_mul, one_smul, Fin.isValue,
        Matrix.cons_val_zero, Matrix.cons_val_one, Matrix.cons_val_fin_one]
    congr 1
    apply Finset.sum_congr rfl
    intro d hd
    split_ifs <;> rfl
  have hCminus (n : ℕ) : C (z - z') n = C z n - C z' n := by
    convert selberg_divisor_root_finset_combination (Finset.univ : Finset (Fin 2))
      ![(1 : ℝ), -1] ![z, z'] (fun j => n + h (i.succAbove j)) using 1 <;>
      simp only [Fin.sum_univ_two, C, hrootsEq, sub_eq_add_neg, one_mul, one_smul,
        neg_one_smul, neg_mul, Fin.isValue, Matrix.cons_val_zero, Matrix.cons_val_one,
        Matrix.cons_val_fin_one]
    congr 1
    apply Finset.sum_congr rfl
    intro d hd
    split_ifs <;> rfl
  have hH (w : (Fin 39 → ℕ) →₀ ℝ) (hw : w.support ⊆ K) :
      H w = ∑ r ∈ K, (w r) ^ 2 / (∏ j, ((r j).totient : ℝ)) := by
    exact w.sum_of_support_subset hw _ (by intro r hr; simp)
  have hHcross : Hcross =
      ∑ r ∈ K, z r * z' r / (∏ j, ((r j).totient : ℝ)) := by
    exact z.sum_of_support_subset Finset.subset_union_left _ (by intro r hr; simp)
  have hHpolar : H (z + z') - H (z - z') = 4 * Hcross := by
    rw [hH (z + z') Finsupp.support_add, hH (z - z') Finsupp.support_sub, hHcross,
      ← Finset.sum_sub_distrib, Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro r hr
    simp only [Finsupp.add_apply, Finsupp.sub_apply]
    ring
  have hQpolar : Q (z + z') - Q (z - z') = 4 * Qcross := by
    calc
      _ = (1 / (q.totient : ℝ)) * (∑ n ∈ Finset.range q,
          ((if Nat.Coprime (n + h i) q then C (z + z') n ^ 2 else 0) -
          (if Nat.Coprime (n + h i) q then C (z - z') n ^ 2 else 0))) := by
        simp only [Q, Finset.sum_sub_distrib, mul_sub]
      _ = (1 / (q.totient : ℝ)) * (∑ n ∈ Finset.range q,
          4 * (if Nat.Coprime (n + h i) q then C z n * C z' n else 0)) := by
        congr 1
        apply Finset.sum_congr rfl
        intro n hn
        rw [hCplus, hCminus]
        split_ifs <;> ring
      _ = 4 * Qcross := by
        rw [← Finset.mul_sum]
        dsimp only [Qcross]
        ring
  have hpolar : 4 * (Qcross - Hcross) =
      (Q (z + z') - H (z + z')) - (Q (z - z') - H (z - z')) := by
    linarith [hQpolar, hHpolar]
  have herror : |4 * (Qcross - Hcross)| ≤ (2 * ε) / B ^ 39 + (2 * ε) / B ^ 39 := by
    rw [hpolar]
    calc
      _ ≤ |Q (z + z') - H (z + z')| + |Q (z - z') - H (z - z')| := by
        simpa only [Real.norm_eq_abs] using
          norm_sub_le (Q (z + z') - H (z + z')) (Q (z - z') - H (z - z'))
      _ ≤ _ := add_le_add hplus hminus
  have hscale : (2 * ε) / B ^ 39 + (2 * ε) / B ^ 39 = 4 * (ε / B ^ 39) := by ring
  rw [abs_mul, show |(4 : ℝ)| = 4 by norm_num, hscale] at herror
  have hcross : |Qcross - Hcross| ≤ ε / B ^ 39 := by linarith
  let P := fragmentPrimes W R κ
  have hP (p : ℕ) (hp : p ∈ P) : p.Prime :=
    Nat.prime_of_mem_primesLE (Finset.mem_filter.mp hp).1
  have hq : Squarefree q := squarefree_prime_prod P hP
  have hqW : q.Coprime W := by
    apply Nat.Coprime.prod_left
    intro p hp
    exact (hP p hp).coprime_iff_not_dvd.mpr (Finset.mem_filter.mp hp).2
  have hW : 0 < W := presieving_pos 𝓗 x
  have hclass (m a : ℕ) (hm : 0 < m) : ∃ v : ℕ, Nat.Coprime (v + a) m := by
    let : NeZero m := ⟨hm.ne'⟩
    let v := (1 - (a : ZMod m)).val
    refine ⟨v, (ZMod.isUnit_iff_coprime (v + a) m).mp ?_⟩
    have hvcast : ((v + a : ℕ) : ZMod m) = 1 := by
      simp only [Nat.cast_add, v, ZMod.natCast_zmod_val]
      ring
    rw [hvcast]
    exact isUnit_one
  obtain ⟨v, hv⟩ := hclass W (h i) hW
  have hinj : Function.Injective h :=
    (𝓗.orderEmbOfFin h𝓗_card).injective
  have hcover : ∀ a b : Fin 40, h a ≠ h b → ∀ p : ℕ,
      p.Prime → p ∣ Nat.dist (h a) (h b) → p ∣ W := by
    intro a b hab p hp hpd
    exact difference_prime_dvd_presieving 𝓗 x
      (𝓗.orderEmbOfFin_mem h𝓗_card a)
      (𝓗.orderEmbOfFin_mem h𝓗_card b) hab hp hpd
  have hroots (w : (Fin 39 → ℕ) →₀ ℝ)
      (hw : ∀ r ∈ w.support, Squarefree (∏ j, r j) ∧ ∀ j, r j ∈ q.divisors)
      (d : Fin 39 → ℕ) (hd : d ∈ roots w) :
      Squarefree (∏ j, d j) ∧ (∏ j, d j).Coprime W ∧ (∏ j, d j) ∣ q := by
    obtain ⟨r, hr, hdr⟩ := Finset.mem_biUnion.mp hd
    have hdr' (j : Fin 39) : d j ∣ r j :=
      Nat.dvd_of_mem_divisors (Fintype.mem_piFinset.mp hdr j)
    have hdq (j : Fin 39) : d j ∣ q :=
      (hdr' j).trans (Nat.dvd_of_mem_divisors ((hw r hr).2 j))
    have hds : Squarefree (∏ j, d j) :=
      (hw r hr).1.squarefree_of_dvd
        (Finset.prod_dvd_prod_of_dvd d r (fun j _ => hdr' j))
    have hdpow : (∏ j : Fin 39, d j) ∣ q ^ 39 := by
      simpa only [Finset.prod_const, Finset.card_univ, Fintype.card_fin] using
        Finset.prod_dvd_prod_of_dvd (s := Finset.univ) d (fun _ : Fin 39 => q) (fun j _ => hdq j)
    have hdprod : (∏ j, d j) ∣ q :=
      hds.isRadical 39 q hdpow
    exact ⟨hds, hqW.of_dvd_left hdprod, hdprod⟩
  have hkernel := selberg_prime_period_coefficient_identity h hinj i W v hW
    hcover hv q hq D E (selbergCoefficient z) (selbergCoefficient z')
      (hroots z hz) (hroots z' hz')
  dsimp only [Qcross, C, roots] at hcross
  rw [hkernel] at hcross
  exact hcross

open Classical in
theorem canonical40_erased_prime_bilinear_tendsto
    {𝓗 : Finset ℕ} {h𝓗_card : 𝓗.card = 40}
    {m : ℕ} (i : Fin 40) (κ : ℝ) (hκ : 0 < κ)
    (a : Fin (m + 2) → ℝ) (ha : StrictMono a)
    (ha0 : a 0 = 0) (haLast : a (Fin.last (m + 1)) = κ)
    (F F' : (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
    (hF : Measurable F) (hF' : Measurable F')
    (hbF : Bornology.IsBounded (Set.range F))
    (hbF' : Bornology.IsBounded (Set.range F')) :
    let ν : Measure (Fin (m + 1) → ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        Measure.map (fragmentBandMasses a) (fragmentLaw κ)
    (∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => ν), ContinuousAt F X) →
    (∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => ν), ContinuousAt F' X) →
    let ρ : ℝ := 2624989 / 10000000
    let W : ℝ → ℕ := presievingModulus 𝓗
    let R : ℝ → ℝ := fun x => x ^ ρ
    let B : ℝ → ℝ := fun x => fragmentNormalization (W x) (R x)
    let q : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) (R x) κ, p
    let T40 : ℝ → Finset (Fin 40 → ℕ) := fun x =>
      (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
        (fun r => Squarefree (∏ j, r j))
    let X : ℝ → ℕ → Fin (m + 1) → ℝ := fun x s =>
      fragmentBandMasses a (primeLogConfiguration (R x) s)
    let y : ℝ → ((Fin 40 → ℕ) →₀ ℝ) := fun x =>
      ∑ r ∈ T40 x, Finsupp.single r (F (fun j => X x (r j)) / B x ^ 40)
    let y' : ℝ → ((Fin 40 → ℕ) →₀ ℝ) := fun x =>
      ∑ r ∈ T40 x, Finsupp.single r (F' (fun j => X x (r j)) / B x ^ 40)
    let z : ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun x =>
      (y x).sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
        (yr / ((r i).totient : ℝ)))
    let z' : ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun x =>
      (y' x).sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
        (yr / ((r i).totient : ℝ)))
    let D : ℝ → Finset (Fin 39 → ℕ) := fun x =>
      (z x).support.biUnion (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let E : ℝ → Finset (Fin 39 → ℕ) := fun x =>
      (z' x).support.biUnion (fun r => Fintype.piFinset (fun j => (r j).divisors))
    Tendsto
      (fun x : ℝ => B x ^ 39 * (∑ d ∈ D x, ∑ e ∈ E x,
        if ∀ s t : Fin 39, s ≠ t → Nat.Coprime (d s) (e t) then
          selbergCoefficient (z x) d * selbergCoefficient (z' x) e /
            (∏ j, ((Nat.lcm (d j) (e j)).totient : ℝ)) else 0))
      atTop (nhds (∫ Y : Fin 39 → Fin (m + 1) → ℝ,
        (∫ t : Fin (m + 1) → ℝ, F (i.insertNth t Y) ∂ν) *
          (∫ t : Fin (m + 1) → ℝ, F' (i.insertNth t Y) ∂ν)
        ∂Measure.pi (fun _ : Fin 39 => ν))) := by
  intro ν cF cF' ρ W R B q T40 X y y' z z' D E
  let H : ℝ → ℝ := fun x =>
    (z x).sum (fun r zr => zr * z' x r / (∏ j, ((r j).totient : ℝ)))
  let K : ℝ → ℝ := fun x => ∑ d ∈ D x, ∑ e ∈ E x,
    if ∀ s t : Fin 39, s ≠ t → Nat.Coprime (d s) (e t) then
      selbergCoefficient (z x) d * selbergCoefficient (z' x) e /
        (∏ j, ((Nat.lcm (d j) (e j)).totient : ℝ)) else 0
  let L : ℝ := ∫ Y : Fin 39 → Fin (m + 1) → ℝ,
    (∫ t : Fin (m + 1) → ℝ, F (i.insertNth t Y) ∂ν) *
      (∫ t : Fin (m + 1) → ℝ, F' (i.insertNth t Y) ∂ν)
    ∂Measure.pi (fun _ : Fin 39 => ν)
  have hlim : Tendsto (fun x => B x ^ 39 * H x) atTop (nhds L) := by
    let G : (Fin 39 → Fin (m + 1) → ℝ) → ℝ := fun _ => 0
    have hG : Measurable G := measurable_const
    have hbG : Bornology.IsBounded (Set.range G) :=
      Bornology.isBounded_singleton.subset Set.range_const_subset
    have cG : ∀ᵐ Y ∂Measure.pi (fun _ : Fin 39 => ν), ContinuousAt G Y :=
      Filter.Eventually.of_forall (fun _ => continuousAt_const)
    have hraw := canonical_and_erased_polarized_harmonic_tendsto (𝓗 := 𝓗)
      i κ hκ a ha ha0 haLast G G F F' hG hG hF hF' hbG hbG hbF hbF'
        cG cG cF cF'
    simpa only [G, zero_div, Finsupp.single_zero, Finset.sum_const_zero, zero_add]
      using hraw
  obtain ⟨MF, hMF, hFb⟩ := hbF.exists_pos_norm_le
  obtain ⟨MF', hMF', hFb'⟩ := hbF'.exists_pos_norm_le
  simp only [Real.norm_eq_abs] at hFb hFb'
  let Cκ : ℝ := Real.exp Real.eulerMascheroniConstant * κ + 1
  have hCκ : 0 < Cκ := by dsimp only [Cκ]; positivity
  have herror : Tendsto (fun x => B x ^ 39 * (K x - H x)) atTop (nhds 0) := by
    apply Metric.tendsto_nhds.mpr
    intro ε hε
    filter_upwards
      [selberg40_canonical_erased_face (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i κ MF hκ hMF.le,
        selberg40_canonical_erased_face (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i κ MF' hκ hMF'.le,
        selberg39_prime_bilinear_comparison
          (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i κ (MF * Cκ) (MF' * Cκ) hκ
          (mul_nonneg hMF.le hCκ.le) (mul_nonneg hMF'.le hCκ.le)
          (ε / 2) (half_pos hε)] with x hx hx' hc
    obtain ⟨_, _, hface⟩ := hx
    obtain ⟨_, _, hface'⟩ := hx'
    obtain ⟨_, _, _, _, hzsupport, hzbound⟩ :=
      hface (fun Y => F (fun j => fragmentBandMasses a (Y j)))
        (fun Y => hFb _ ⟨fun j => fragmentBandMasses a (Y j), rfl⟩)
    obtain ⟨_, _, _, _, hzsupport', hzbound'⟩ :=
      hface' (fun Y => F' (fun j => fragmentBandMasses a (Y j)))
        (fun Y => hFb' _ ⟨fun j => fragmentBandMasses a (Y j), rfl⟩)
    have hzs : ∀ r ∈ (z x).support,
        Squarefree (∏ j, r j) ∧ ∀ j, r j ∈ (q x).divisors := by
      intro r hr
      exact ⟨(hzsupport r hr).1, (hzsupport r hr).2.1⟩
    have hzs' : ∀ r ∈ (z' x).support,
        Squarefree (∏ j, r j) ∧ ∀ j, r j ∈ (q x).divisors := by
      intro r hr
      exact ⟨(hzsupport' r hr).1, (hzsupport' r hr).2.1⟩
    have hzb : ∀ r, |z x r| ≤ (MF * Cκ) / B x ^ 39 := fun r => (hzbound r).2
    have hzb' : ∀ r, |z' x r| ≤ (MF' * Cκ) / B x ^ 39 :=
      fun r => (hzbound' r).2
    have hB : 0 < B x := hc.1
    have herr : |K x - H x| ≤ (ε / 2) / B x ^ 39 :=
      hc.2 (z x) (z' x) hzs hzs' hzb hzb'
    have hB39 : 0 < B x ^ 39 := pow_pos hB 39
    have hscaled := mul_le_mul_of_nonneg_left herr hB39.le
    rw [mul_div_cancel₀ _ hB39.ne'] at hscaled
    have hstrict := hscaled.trans_lt (half_lt_self hε)
    simpa only [Real.dist_eq, sub_zero, abs_mul, abs_of_pos hB39] using hstrict
  have hsum := herror.add hlim
  simp only [zero_add] at hsum
  change Tendsto (fun x => B x ^ 39 * K x) atTop (nhds L)
  convert hsum using 1
  funext x
  ring

theorem fragment_band_law_integral_pullback
    {m : ℕ} (κ : ℝ) (a : Fin (m + 2) → ℝ) (d : ℕ)
    (F : (Fin d → Fin (m + 1) → ℝ) → ℝ) (hF : Measurable F) :
    let μ : Measure (FiniteMeasure ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        fragmentLaw κ
    let ν : Measure (Fin (m + 1) → ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        Measure.map (fragmentBandMasses a) (fragmentLaw κ)
    (∫ Y, F Y ∂Measure.pi (fun _ : Fin d => ν)) =
      ∫ X, F (fun j => fragmentBandMasses a (X j))
        ∂Measure.pi (fun _ : Fin d => μ) := by
  intro μ ν
  let b : FiniteMeasure ℝ → Fin (m + 1) → ℝ := fragmentBandMasses a
  have hb : Measurable b := measurable_fragmentBandMasses a
  let : IsProbabilityMeasure (fragmentLaw κ) :=
    fragmentLaw_isProbabilityMeasure κ
  let : IsFiniteMeasure μ := Measure.smul_finite
    (fragmentLaw κ) ENNReal.ofReal_ne_top
  have hmap : Measure.map b μ = ν := Measure.map_smul _ hb.aemeasurable
  have hpi : Measure.map (fun X : Fin d → FiniteMeasure ℝ => fun j => b (X j))
      (Measure.pi (fun _ : Fin d => μ)) = Measure.pi (fun _ : Fin d => ν) := by
    simpa only [hmap] using
      (Measure.pi_map_pi (μ := fun _ : Fin d => μ) (f := fun _ => b)
        (fun _ => hb.aemeasurable))
  rw [← hpi]
  exact integral_map_of_stronglyMeasurable
    (measurable_pi_lambda _ fun j => hb.comp (measurable_pi_apply j))
    hF.stronglyMeasurable

theorem fragment_band_law_fiber_function_integral_pullback
    {m : ℕ} (κ : ℝ) (a : Fin (m + 2) → ℝ) (d r : ℕ) (i : Fin (d + 1))
    (F : Fin r → (Fin (d + 1) → Fin (m + 1) → ℝ) → ℝ)
    (hF : ∀ j, Measurable (F j))
    (Ψ : (Fin d → Fin (m + 1) → ℝ) → (Fin r → ℝ) → ℝ)
    (hΨ : Measurable (Function.uncurry Ψ)) :
    let μ : Measure (FiniteMeasure ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        fragmentLaw κ
    let ν : Measure (Fin (m + 1) → ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        Measure.map (fragmentBandMasses a) (fragmentLaw κ)
    (∫ Y, Ψ Y (fun j =>
        ∫ t : Fin (m + 1) → ℝ, F j (i.insertNth t Y) ∂ν)
      ∂Measure.pi (fun _ : Fin d => ν)) =
      ∫ X, Ψ (fun k => fragmentBandMasses a (X k)) (fun j =>
        ∫ c : FiniteMeasure ℝ,
          F j (fun k => fragmentBandMasses a
            (i.insertNth (α := fun _ => FiniteMeasure ℝ) c X k)) ∂μ)
        ∂Measure.pi (fun _ : Fin d => μ) := by
  classical
  intro μ ν
  let b : FiniteMeasure ℝ → Fin (m + 1) → ℝ := fragmentBandMasses a
  have hb : Measurable b := measurable_fragmentBandMasses a
  let : IsProbabilityMeasure (fragmentLaw κ) :=
    fragmentLaw_isProbabilityMeasure κ
  let : IsFiniteMeasure μ := Measure.smul_finite
    (fragmentLaw κ) ENNReal.ofReal_ne_top
  have hmap : Measure.map b μ = ν := Measure.map_smul _ hb.aemeasurable
  let : IsFiniteMeasure ν := hmap ▸ Measure.isFiniteMeasure_map μ b
  let U : Fin r → (Fin d → Fin (m + 1) → ℝ) → ℝ := fun j Y =>
    ∫ t : Fin (m + 1) → ℝ, F j (i.insertNth t Y) ∂ν
  have hins : Measurable
      (fun p : (Fin d → Fin (m + 1) → ℝ) × (Fin (m + 1) → ℝ) =>
        i.insertNth (α := fun _ => Fin (m + 1) → ℝ) p.2 p.1) :=
    (continuous_snd.finInsertNth i continuous_fst).measurable
  have hU (j : Fin r) : Measurable (U j) :=
    ((hF j).comp hins).stronglyMeasurable.integral_prod_right'.measurable
  have houter : Measurable (fun Y => Ψ Y (fun j => U j Y)) :=
    hΨ.comp (measurable_id.prodMk (measurable_pi_lambda _ hU))
  have hfiber (j : Fin r) (X : Fin d → FiniteMeasure ℝ) :
      U j (fun k => b (X k)) =
        ∫ c : FiniteMeasure ℝ,
          F j (fun k => b (i.insertNth (α := fun _ => FiniteMeasure ℝ) c X k)) ∂μ := by
    have hslice : Measurable
        (fun t : Fin (m + 1) → ℝ => F j (i.insertNth t (fun k => b (X k)))) :=
      (hF j).comp (hins.comp (measurable_const.prodMk measurable_id))
    calc
      U j (fun k => b (X k)) =
          ∫ c : FiniteMeasure ℝ, F j (i.insertNth (b c) (fun k => b (X k))) ∂μ := by
        dsimp only [U]
        rw [← hmap]
        exact integral_map_of_stronglyMeasurable hb hslice.stronglyMeasurable
      _ = _ := by
        apply integral_congr_ae
        apply ae_of_all
        intro c
        apply congrArg (F j)
        funext k
        rcases Fin.eq_self_or_eq_succAbove i k with rfl | ⟨l, rfl⟩
        · simp only [Fin.insertNth_apply_same]
        · simp only [Fin.insertNth_apply_succAbove]
  calc
    _ = ∫ X, Ψ (fun k => b (X k)) (fun j => U j (fun k => b (X k)))
        ∂Measure.pi (fun _ : Fin d => μ) :=
      fragment_band_law_integral_pullback κ a d (fun Y => Ψ Y (fun j => U j Y)) houter
    _ = _ := by
      apply integral_congr_ae
      apply ae_of_all
      intro X
      apply congrArg (Ψ (fun k => b (X k)))
      funext j
      exact hfiber j X

end

open Classical in
theorem selberg39_coherent_pair_error_le
    (W : ℕ) (hW : 0 < W) (D E : Finset (Fin 39 → ℕ))
    (hD : ∀ d ∈ D, Squarefree (∏ i, d i) ∧ Nat.Coprime (∏ i, d i) W)
    (hE : ∀ e ∈ E, Squarefree (∏ i, e i) ∧ Nat.Coprime (∏ i, e i) W)
    (gate : (Fin 39 → ℕ) → (Fin 39 → ℕ) → Prop) [DecidableRel gate]
    (hcross : ∀ d ∈ D, ∀ e ∈ E, gate d e →
      ∀ i j : Fin 39, i ≠ j → Nat.Coprime (d i) (e j))
    (lam mu : (Fin 39 → ℕ) → ℝ) (B₁ B₂ Err : ℝ)
    (hB₁ : 0 ≤ B₁) (hB₂ : 0 ≤ B₂)
    (hlam : ∀ d ∈ D, |lam d| ≤ B₁) (hmu : ∀ e ∈ E, |mu e| ≤ B₂)
    (P : Finset ℕ) (hP : ∀ p ∈ P, p.Prime)
    (r : (p : P) → Fin 39 → ZMod (p : ℕ))
    (hr : ∀ (p : P) (j : Fin 39), r p j ≠ 0)
    (U : Finset P) (hfixed : ∀ p : P, p ∉ U → ∀ j l : Fin 39, r p j = r p l)
    (Q : Finset ℕ) (hQ : Q ⊆ (∏ p ∈ P, p).divisors)
    (u : ℕ →₀ ℂ) (residue : (Fin 39 → ℕ) → (Fin 39 → ℕ) → ℕ)
    (hmoduli : ∀ d ∈ D, ∀ e ∈ E, gate d e →
      Nat.lcm W (Nat.lcm (∏ i, d i) (∏ i, e i)) ∈ Q)
    (hchoices : ∀ d ∈ D, ∀ e ∈ E, gate d e →
      ∀ p : P,
        (p : ℕ) ∈ (Nat.lcm W (Nat.lcm (∏ i, d i) (∏ i, e i))).primeFactors →
        ∃ j : Fin 39, (residue d e : ZMod (p : ℕ)) = r p j)
    (hSource : ∀ a : ℕ, Nat.Coprime a (∏ p ∈ P, p) →
      (∑ q ∈ Q, (q.divisors.card : ℝ) ^ 13 *
        ‖fullDiscrepancy u q a‖) ≤ Err) :
    (∑ p ∈ (D.product E).filter (fun p => gate p.1 p.2),
      |lam p.1| * |mu p.2| *
        ‖fullDiscrepancy u
          (Nat.lcm W (Nat.lcm (∏ i, p.1 i) (∏ i, p.2 i)))
          (residue p.1 p.2)‖) ≤ B₁ * B₂ * Err := by
  let Pair := (Fin 39 → ℕ) × (Fin 39 → ℕ)
  let S : Finset Pair := (D.product E).filter (fun p => gate p.1 p.2)
  let mod : Pair → ℕ := fun p =>
    Nat.lcm W (Nat.lcm (∏ i, p.1 i) (∏ i, p.2 i))
  let err : Pair → ℝ := fun p =>
    ‖fullDiscrepancy u (mod p) (residue p.1 p.2)‖
  let Qa : Finset ℕ := S.image mod
  have hQaQ : Qa ⊆ Q := by
    intro q hq
    obtain ⟨p, hp, rfl⟩ := Finset.mem_image.mp hq
    obtain ⟨hpDE, hgate⟩ := Finset.mem_filter.mp hp
    obtain ⟨hpD, hpE⟩ := Finset.mem_product.mp hpDE
    exact hmoduli p.1 hpD p.2 hpE hgate
  have hPsq : Squarefree (∏ p ∈ P, p) := squarefree_prime_prod P hP
  have hQa (q : ℕ) (hq : q ∈ Qa) : Squarefree q ∧ q.primeFactors ⊆ P := by
    have hdiv : q ∣ ∏ p ∈ P, p := (Nat.mem_divisors.mp (hQ (hQaQ hq))).1
    refine ⟨hPsq.squarefree_of_dvd hdiv, ?_⟩
    simpa only [Nat.primeFactors_prod hP] using Nat.primeFactors_mono hdiv hPsq.ne_zero
  have hmax (q : Qa) :
      ∃ p ∈ S.filter (fun p => mod p = (q : ℕ)),
        ∀ p' ∈ S.filter (fun p => mod p = (q : ℕ)), err p' ≤ err p := by
    apply Finset.exists_max_image
    obtain ⟨p, hp, hpq⟩ := Finset.mem_image.mp q.property
    exact ⟨p, Finset.mem_filter.mpr ⟨hp, hpq⟩⟩
  choose pick hpickMem hpickMax using hmax
  have hpickS (q : Qa) : pick q ∈ S := (Finset.mem_filter.mp (hpickMem q)).1
  have hpickMod (q : Qa) : mod (pick q) = (q : ℕ) :=
    (Finset.mem_filter.mp (hpickMem q)).2
  let b : ℕ → ℕ := fun q =>
    if hq : q ∈ Qa then residue (pick ⟨q, hq⟩).1 (pick ⟨q, hq⟩).2 else 0
  let Delta : ℕ → ℝ := fun q => ‖fullDiscrepancy u q (b q)‖
  have hb (q : Qa) : b q = residue (pick q).1 (pick q).2 := by
    simp only [b, dite_eq_left q.property]
  have hpairMax (p : Pair) (hp : p ∈ S) : err p ≤ Delta (mod p) := by
    let q : Qa := ⟨mod p, Finset.mem_image.mpr ⟨p, hp, rfl⟩⟩
    have hh := hpickMax q p (Finset.mem_filter.mpr ⟨hp, rfl⟩)
    dsimp only [err] at hh
    rw [hpickMod q] at hh
    dsimp only [err, Delta]
    rw [hb q]
    exact hh
  have hbchoices (q : ℕ) (hq : q ∈ Qa) (p : P)
      (hp : (p : ℕ) ∈ q.primeFactors) :
      ∃ j : Fin 39, (b q : ZMod (p : ℕ)) = r p j := by
    let qq : Qa := ⟨q, hq⟩
    obtain ⟨hpDE, hgate⟩ := Finset.mem_filter.mp (hpickS qq)
    obtain ⟨hpD, hpE⟩ := Finset.mem_product.mp hpDE
    have hp' : (p : ℕ) ∈ (mod (pick qq)).primeFactors := by
      simpa only [hpickMod qq] using hp
    rw [hb qq]
    exact hchoices (pick qq).1 hpD (pick qq).2 hpE hgate p hp'
  let w : ℕ → ℝ := fun q =>
    ((((ArithmeticFunction.zeta : ArithmeticFunction ℕ) ^ 117) q : ℕ) : ℝ)
  have hw (q : ℕ) : 0 ≤ w q := Nat.cast_nonneg _
  have hrepresentation :
      (∑ p ∈ S, |lam p.1| * |mu p.2| * Delta (mod p)) ≤
        B₁ * B₂ * ∑ q ∈ Qa, w q * Delta q := by
    exact selberg_actual_modulus_weighted_error_le
      (k := 39) (by norm_num) W hW D E hD hE gate hcross lam mu B₁ B₂
      hB₁ hB₂ hlam hmu Qa Delta (fun _q _hq => norm_nonneg _) (by
        intro d hd e he hgate
        exact Finset.mem_image.mpr
          ⟨(d, e), Finset.mem_filter.mpr ⟨Finset.mem_product.mpr ⟨hd, he⟩, hgate⟩, rfl⟩)
  obtain ⟨a, _, hres, hcoprime, hlocal⟩ :=
    coherent_prime_color_crt P hP 39 r hr
  have hacoprime (g : P → Fin 39) : Nat.Coprime (a g) (∏ p ∈ P, p) :=
    hcoprime _ hPsq
      (by simpa only [Nat.primeFactors_prod hP] using (Finset.Subset.refl P)) g
  let f : ℕ → P → Fin 39 := fun q p =>
    if hq : q ∈ Qa then
      if hp : (p : ℕ) ∈ q.primeFactors then Classical.choose (hbchoices q hq p hp)
      else 0
    else 0
  have hf (q : ℕ) (hq : q ∈ Qa) (p : P) (hp : (p : ℕ) ∈ q.primeFactors) :
      (b q : ZMod (p : ℕ)) = r p (f q p) := by
    simpa only [f, dite_eq_left hq, dite_eq_left hp] using
      Classical.choose_spec (hbchoices q hq p hp)
  have hmod (q : ℕ) (hq : q ∈ Qa) : a (f q) % q = b q % q := by
    have hpair : q.primeFactors.toList.Pairwise Nat.Coprime := by
      apply q.primeFactors.nodup_toList.pairwise_of_forall_ne
      intro p hp t ht hpt
      exact (Nat.coprime_primes
        (Nat.prime_of_mem_primeFactors (Finset.mem_toList.mp hp))
        (Nat.prime_of_mem_primeFactors (Finset.mem_toList.mp ht))).mpr hpt
    have hlist : Nat.ModEq (q.primeFactors.toList.map (fun p : ℕ => p)).prod
        (a (f q)) (b q) := by
      apply (Nat.modEq_list_map_prod_iff (s := fun p : ℕ => p) hpair).mpr
      intro p hp
      have hpq : p ∈ q.primeFactors := Finset.mem_toList.mp hp
      let pp : P := ⟨p, (hQa q hq).2 hpq⟩
      apply (ZMod.natCast_eq_natCast_iff (a (f q)) (b q) p).mp
      exact (hres (f q) pp).trans (hf q hq pp hpq).symm
    change Nat.ModEq q (a (f q)) (b q)
    simpa [Finset.prod_toList, Nat.prod_primeFactors_of_squarefree (hQa q hq).1] using hlist
  let T : ℕ → Finset P := fun q =>
    U.filter (fun p : P => (p : ℕ) ∈ q.primeFactors)
  let den : ℝ := (39 : ℝ) ^ P.card
  have hden : 0 < den := by positivity
  have hprojection (q : ℕ) (hq : q ∈ Qa) :
      Delta q ≤ (39 : ℝ) ^ (T q).card / den *
        ∑ g : P → Fin 39, ‖fullDiscrepancy u q (a g)‖ := by
    have hp := coherent_color_projection_average
      39 (by norm_num) (T q)
      (fun g : P → Fin 39 => ‖fullDiscrepancy u q (a g)‖)
      (fun _g => norm_nonneg _) (by
        intro g g' hgg'
        have hsame : a g % q = a g' % q := by
          apply hlocal q (hQa q hq).1 (hQa q hq).2 g g'
          intro p hp
          by_cases hpU : p ∈ U
          · exact congrArg (r p) (hgg' p (Finset.mem_filter.mpr ⟨hpU, hp⟩))
          · exact hfixed p hpU (g p) (g' p)
        simp only [fullDiscrepancy,
          progressionMass, hsame]) (f q)
    have heq : Delta q = ‖fullDiscrepancy u q (a (f q))‖ := by
      simp only [Delta, fullDiscrepancy,
        progressionMass, hmod q hq]
    simpa only [← heq, Fintype.card_coe, Nat.cast_ofNat, den] using hp
  have hweight (q : ℕ) (hq : q ∈ Qa) :
      w q * (39 : ℝ) ^ (T q).card ≤ (q.divisors.card : ℝ) ^ 13 := by
    have hTcard : (T q).card ≤ q.primeFactors.card :=
      Finset.card_le_card_of_injOn (fun p : P => (p : ℕ))
        (fun _p hp => (Finset.mem_filter.mp hp).2)
        (fun _p _hp _p' _hp' hpp' => Subtype.ext hpp')
    calc
      w q * (39 : ℝ) ^ (T q).card ≤ w q * (39 : ℝ) ^ q.primeFactors.card :=
        mul_le_mul_of_nonneg_left (pow_le_pow_right₀ (by norm_num) hTcard) (hw q)
      _ ≤ (q.divisors.card : ℝ) ^ 13 := by
        dsimp only [w]
        exact_mod_cast selberg40_color_representation_loss q (hQa q hq).1
  have hinner (g : P → Fin 39) :
      (∑ q ∈ Qa, w q * (39 : ℝ) ^ (T q).card *
        ‖fullDiscrepancy u q (a g)‖) ≤ Err := by
    calc
      _ ≤ ∑ q ∈ Qa, (q.divisors.card : ℝ) ^ 13 *
          ‖fullDiscrepancy u q (a g)‖ := by
        apply Finset.sum_le_sum
        intro q hq
        exact mul_le_mul_of_nonneg_right (hweight q hq) (norm_nonneg _)
      _ ≤ ∑ q ∈ Q, (q.divisors.card : ℝ) ^ 13 *
          ‖fullDiscrepancy u q (a g)‖ :=
        Finset.sum_le_sum_of_subset_of_nonneg hQaQ
          (fun _q _hq _hqa => mul_nonneg (pow_nonneg (Nat.cast_nonneg _) _) (norm_nonneg _))
      _ ≤ Err := hSource (a g) (hacoprime g)
  have hcount : (Fintype.card (P → Fin 39) : ℝ) = den := by
    simp only [Fintype.card_fun, Fintype.card_fin, Fintype.card_coe,
      Nat.cast_pow, Nat.cast_ofNat, den]
  have hcoherent : (∑ q ∈ Qa, w q * Delta q) ≤ Err := by
    calc
      (∑ q ∈ Qa, w q * Delta q) ≤
          ∑ q ∈ Qa, w q * ((39 : ℝ) ^ (T q).card / den *
            ∑ g : P → Fin 39, ‖fullDiscrepancy u q (a g)‖) := by
        apply Finset.sum_le_sum
        intro q hq
        exact mul_le_mul_of_nonneg_left (hprojection q hq) (hw q)
      _ = den⁻¹ * ∑ g : P → Fin 39, ∑ q ∈ Qa,
          w q * (39 : ℝ) ^ (T q).card *
            ‖fullDiscrepancy u q (a g)‖ := by
        simp only [Finset.mul_sum]
        rw [Finset.sum_comm]
        apply Finset.sum_congr rfl
        intro g _hg
        apply Finset.sum_congr rfl
        intro q _hq
        ring
      _ ≤ den⁻¹ * ∑ _g : P → Fin 39, Err :=
        mul_le_mul_of_nonneg_left (Finset.sum_le_sum fun g _hg => hinner g)
          (inv_nonneg.mpr hden.le)
      _ = Err := by
        rw [Finset.sum_const, Finset.card_univ, nsmul_eq_mul, hcount,
          ← mul_assoc, inv_mul_cancel₀ hden.ne', one_mul]
  change (∑ p ∈ S, |lam p.1| * |mu p.2| * err p) ≤ B₁ * B₂ * Err
  calc
    (∑ p ∈ S, |lam p.1| * |mu p.2| * err p) ≤
        ∑ p ∈ S, |lam p.1| * |mu p.2| * Delta (mod p) := by
      apply Finset.sum_le_sum
      intro p hp
      exact mul_le_mul_of_nonneg_left (hpairMax p hp) (mul_nonneg (abs_nonneg _) (abs_nonneg _))
    _ ≤ B₁ * B₂ * ∑ q ∈ Qa, w q * Delta q := hrepresentation
    _ ≤ B₁ * B₂ * Err := mul_le_mul_of_nonneg_left hcoherent (mul_nonneg hB₁ hB₂)

open Classical in
theorem selberg_retained_weighted_interval_crt
    {k : ℕ} (h : Fin (k + 1) → ℕ) (hinj : Function.Injective h)
    (i : Fin (k + 1)) (D E : Finset (Fin k → ℕ))
    (lam mu : (Fin k → ℕ) → ℝ) (W v : ℕ) (hW : 0 < W)
    (hD : ∀ d ∈ D, Squarefree (∏ j, d j) ∧ Nat.Coprime (∏ j, d j) W)
    (hE : ∀ e ∈ E, Squarefree (∏ j, e j) ∧ Nat.Coprime (∏ j, e j) W)
    (hcover : ∀ a b : Fin (k + 1), h a ≠ h b → ∀ p : ℕ,
      p.Prime → p ∣ Nat.dist (h a) (h b) → p ∣ W)
    (hv : Nat.Coprime (v + h i) W) (I : Finset ℕ) (f : ℕ → ℝ) :
    let q : (Fin k → ℕ) → (Fin k → ℕ) → ℕ := fun d e =>
      Nat.lcm W (Nat.lcm (∏ j, d j) (∏ j, e j))
    ∃ residue : (Fin k → ℕ) → (Fin k → ℕ) → ℕ,
      (∀ d ∈ D, ∀ e ∈ E,
        (∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b)) →
        0 < q d e ∧ residue d e < q d e ∧
          Nat.Coprime (residue d e + h i) (q d e) ∧
          ∀ n : ℕ, Nat.ModEq (q d e) n (residue d e) ↔
            Nat.ModEq W n v ∧
              (∀ j : Fin k, d j ∣ n + h (i.succAbove j)) ∧
              (∀ j : Fin k, e j ∣ n + h (i.succAbove j))) ∧
      (∑ n ∈ I, if Nat.ModEq W n v then
        f (n + h i) *
          (∑ d ∈ D, if ∀ j : Fin k, d j ∣ n + h (i.succAbove j) then lam d else 0) *
          (∑ e ∈ E, if ∀ j : Fin k, e j ∣ n + h (i.succAbove j) then mu e else 0)
        else 0) =
        ∑ d ∈ D, ∑ e ∈ E,
          if ∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b) then
            lam d * mu e *
              ∑ n ∈ I, if Nat.ModEq (q d e) (n + h i) (residue d e + h i)
                then f (n + h i) else 0
          else 0 := by
  intro q
  have hpair (d : Fin k → ℕ) (hd : d ∈ D) (e : Fin k → ℕ) (he : e ∈ E)
      (hc : ∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b)) :
      ∃ c : ℕ, 0 < q d e ∧ c < q d e ∧ Nat.Coprime (c + h i) (q d e) ∧
        ∀ n : ℕ, Nat.ModEq (q d e) n c ↔ Nat.ModEq W n v ∧
          (∀ j : Fin k, d j ∣ n + h (i.succAbove j)) ∧
          (∀ j : Fin k, e j ∣ n + h (i.succAbove j)) := by
    have hd' : Squarefree (∏ j, (i.insertNth (α := fun _ => ℕ) 1 d) j) ∧
        Nat.Coprime (∏ j, (i.insertNth (α := fun _ => ℕ) 1 d) j) W := by
      simpa only [Fin.prod_insertNth, one_mul] using hD d hd
    have hmod : q d e = W * ∏ j, Nat.lcm (d j) (e j) :=
      actual_modulus_eq_product W d e (hD d hd) (hE e he) hc
    simpa only [Fin.insertNth_apply_succAbove, ← hmod] using
      mixedPair_crt h hinj i
        (i.insertNth (α := fun _ => ℕ) 1 d) e W v hW hd' (hE e he)
        (by simpa only [Fin.insertNth_apply_succAbove] using hc) hcover hv
  let residue : (Fin k → ℕ) → (Fin k → ℕ) → ℕ := fun d e =>
    if hd : d ∈ D then
      if he : e ∈ E then
        if hc : ∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b) then
          Classical.choose (hpair d hd e he hc)
        else 0
      else 0
    else 0
  have hresidue (d : Fin k → ℕ) (hd : d ∈ D) (e : Fin k → ℕ) (he : e ∈ E)
      (hc : ∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b)) :
      0 < q d e ∧ residue d e < q d e ∧
        Nat.Coprime (residue d e + h i) (q d e) ∧
        ∀ n : ℕ, Nat.ModEq (q d e) n (residue d e) ↔ Nat.ModEq W n v ∧
          (∀ j : Fin k, d j ∣ n + h (i.succAbove j)) ∧
          (∀ j : Fin k, e j ∣ n + h (i.succAbove j)) := by
    simpa only [residue, dite_eq_left hd, dite_eq_left he, dite_eq_left hc] using
      Classical.choose_spec (hpair d hd e he hc)
  refine ⟨residue, hresidue, ?_⟩
  have hexpand : (∑ n ∈ I, if Nat.ModEq W n v then
      f (n + h i) *
        (∑ d ∈ D, if ∀ j, d j ∣ n + h (i.succAbove j) then lam d else 0) *
        (∑ e ∈ E, if ∀ j, e j ∣ n + h (i.succAbove j) then mu e else 0)
      else 0) =
      ∑ d ∈ D, ∑ e ∈ E, lam d * mu e *
        ∑ n ∈ I, if Nat.ModEq W n v ∧
          (∀ j, d j ∣ n + h (i.succAbove j)) ∧
          (∀ j, e j ∣ n + h (i.succAbove j)) then f (n + h i) else 0 := by
    calc
      _ = ∑ n ∈ I, ∑ d ∈ D, ∑ e ∈ E,
          if Nat.ModEq W n v ∧
            (∀ j, d j ∣ n + h (i.succAbove j)) ∧
            (∀ j, e j ∣ n + h (i.succAbove j))
          then f (n + h i) * lam d * mu e else 0 := by
        apply Finset.sum_congr rfl
        intro n _
        by_cases hnv : Nat.ModEq W n v
        · simp only [hnv, ite_true, true_and]
          rw [mul_assoc, Finset.sum_mul_sum, Finset.mul_sum]
          apply Finset.sum_congr rfl
          intro d _
          rw [Finset.mul_sum]
          apply Finset.sum_congr rfl
          intro e _
          split_ifs <;> simp_all [mul_assoc]
        · simp only [hnv, ite_false, false_and, Finset.sum_const_zero]
      _ = ∑ d ∈ D, ∑ e ∈ E, ∑ n ∈ I,
          if Nat.ModEq W n v ∧
            (∀ j, d j ∣ n + h (i.succAbove j)) ∧
            (∀ j, e j ∣ n + h (i.succAbove j))
          then f (n + h i) * lam d * mu e else 0 := by
        rw [Finset.sum_comm]
        apply Finset.sum_congr rfl
        intro d _
        exact Finset.sum_comm
      _ = _ := by
        apply Finset.sum_congr rfl
        intro d _
        apply Finset.sum_congr rfl
        intro e _
        rw [Finset.mul_sum]
        apply Finset.sum_congr rfl
        intro n _
        split_ifs <;> ring
  rw [hexpand]
  apply Finset.sum_congr rfl
  intro d hd
  apply Finset.sum_congr rfl
  intro e he
  by_cases hc : ∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b)
  · rw [ite_eq_left hc]
    congr 1
    apply Finset.sum_congr rfl
    intro n _
    have hshift : Nat.ModEq (q d e) (n + h i) (residue d e + h i) ↔
        Nat.ModEq (q d e) n (residue d e) :=
      Nat.ModEq.add_iff_right (Nat.ModEq.refl (h i))
    simp only [hshift, (hresidue d hd e he hc).2.2.2 n]
  · rw [ite_eq_right hc]
    have hzero : (∑ n ∈ I, if Nat.ModEq W n v ∧
        (∀ j, d j ∣ n + h (i.succAbove j)) ∧
        (∀ j, e j ∣ n + h (i.succAbove j)) then f (n + h i) else 0) = 0 := by
      apply Finset.sum_eq_zero
      intro n _
      apply ite_eq_right
      intro hn
      apply hc
      simpa only [Fin.insertNth_apply_succAbove] using
        mixedPair_compatible h hinj i
          (i.insertNth (α := fun _ => ℕ) 1 d) e W
          (by simpa only [Fin.prod_insertNth, one_mul] using (hD d hd).2)
          hcover n (by simpa only [Fin.insertNth_apply_succAbove] using hn.2.1) hn.2.2
    rw [hzero, mul_zero]

open Classical in
theorem fullDiscrepancy_shifted_real_sample
    (I : Finset ℕ) (f : ℕ → ℝ) (h q a : ℕ) :
    fullDiscrepancy
      (∑ m ∈ I.image (fun n => n + h), Finsupp.single m ((f m : ℝ) : ℂ)) q a =
      (((∑ n ∈ I, if Nat.ModEq q (n + h) a then f (n + h) else 0) -
        (∑ n ∈ I, if Nat.Coprime (n + h) q then f (n + h) else 0) /
          (q.totient : ℝ) : ℝ) : ℂ) := by
  rw [fullDiscrepancy_sample,
    Finset.sum_image (fun n _ m _ hnm => Nat.add_right_cancel hnm),
    Finset.sum_sub_distrib, Finset.sum_div]
  simp only [Nat.ModEq]
  push_cast
  simp only [apply_ite, Complex.ofReal_zero]
  congr 1
  apply Finset.sum_congr rfl
  intro n _
  exact (apply_ite Complex.ofReal ((n + h) % q = a % q) (f (n + h)) 0).symm

open Classical in
theorem selberg_retained_weighted_discrepancy_bound
    {k : ℕ} (h : Fin (k + 1) → ℕ) (hinj : Function.Injective h)
    (i : Fin (k + 1)) (D E : Finset (Fin k → ℕ))
    (lam mu : (Fin k → ℕ) → ℝ) (W v : ℕ) (hW : 0 < W)
    (hD : ∀ d ∈ D, Squarefree (∏ j, d j) ∧ Nat.Coprime (∏ j, d j) W)
    (hE : ∀ e ∈ E, Squarefree (∏ j, e j) ∧ Nat.Coprime (∏ j, e j) W)
    (hcover : ∀ a b : Fin (k + 1), h a ≠ h b → ∀ p : ℕ,
      p.Prime → p ∣ Nat.dist (h a) (h b) → p ∣ W)
    (hv : Nat.Coprime (v + h i) W) (I : Finset ℕ) (f : ℕ → ℝ)
    (hweight : ∀ d ∈ D, ∀ e ∈ E,
      (∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b)) →
      ∀ n ∈ I, f (n + h i) ≠ 0 →
        Nat.Coprime (n + h i) (Nat.lcm W (Nat.lcm (∏ j, d j) (∏ j, e j)))) :
    let q : (Fin k → ℕ) → (Fin k → ℕ) → ℕ := fun d e =>
      Nat.lcm W (Nat.lcm (∏ j, d j) (∏ j, e j))
    let u : ℕ →₀ ℂ :=
      ∑ m ∈ I.image (fun n => n + h i), Finsupp.single m ((f m : ℝ) : ℂ)
    let G : ℝ := ∑ d ∈ D, ∑ e ∈ E,
      if ∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b) then
        lam d * mu e / (∏ j, ((Nat.lcm (d j) (e j)).totient : ℝ)) else 0
    ∃ residue : (Fin k → ℕ) → (Fin k → ℕ) → ℕ,
      (∀ d ∈ D, ∀ e ∈ E,
        (∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b)) →
        0 < q d e ∧ residue d e < q d e ∧
          Nat.Coprime (residue d e + h i) (q d e) ∧
          ∀ n : ℕ, Nat.ModEq (q d e) n (residue d e) ↔
            Nat.ModEq W n v ∧
              (∀ j : Fin k, d j ∣ n + h (i.succAbove j)) ∧
              (∀ j : Fin k, e j ∣ n + h (i.succAbove j))) ∧
      |(∑ n ∈ I, if Nat.ModEq W n v then
        f (n + h i) *
          (∑ d ∈ D, if ∀ j : Fin k, d j ∣ n + h (i.succAbove j) then lam d else 0) *
          (∑ e ∈ E, if ∀ j : Fin k, e j ∣ n + h (i.succAbove j) then mu e else 0)
        else 0) - ((∑ n ∈ I, f (n + h i)) / (W.totient : ℝ)) * G| ≤
        ∑ d ∈ D, ∑ e ∈ E,
          if ∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b) then
            |lam d| * |mu e| *
              ‖fullDiscrepancy u (q d e) (residue d e + h i)‖
          else 0 := by
  intro q u G
  obtain ⟨residue, hresidue, hexpand⟩ :=
    selberg_retained_weighted_interval_crt h hinj i D E lam mu W v hW
      hD hE hcover hv I f
  refine ⟨residue, hresidue, ?_⟩
  let total : ℝ := ∑ n ∈ I, f (n + h i)
  let progression : (Fin k → ℕ) → (Fin k → ℕ) → ℝ := fun d e =>
    ∑ n ∈ I, if Nat.ModEq (q d e) (n + h i) (residue d e + h i)
      then f (n + h i) else 0
  have hmean (d : Fin k → ℕ) (hd : d ∈ D) (e : Fin k → ℕ) (he : e ∈ E)
      (hc : ∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b)) :
      (∑ n ∈ I, if Nat.Coprime (n + h i) (q d e) then f (n + h i) else 0) = total := by
    apply Finset.sum_congr rfl
    intro n hn
    by_cases hf : f (n + h i) = 0
    · simp only [hf, ite_self]
    · exact ite_eq_left (hweight d hd e he hc n hn hf)
  have hdelta (d : Fin k → ℕ) (hd : d ∈ D) (e : Fin k → ℕ) (he : e ∈ E)
      (hc : ∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b)) :
      ‖fullDiscrepancy u (q d e) (residue d e + h i)‖ =
        |progression d e - total / ((q d e).totient : ℝ)| := by
    rw [fullDiscrepancy_shifted_real_sample, hmean d hd e he hc,
      Complex.norm_real, Real.norm_eq_abs]
  have hmain : (total / (W.totient : ℝ)) * G =
      ∑ d ∈ D, ∑ e ∈ E,
        if ∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b) then
          lam d * mu e * (total / ((q d e).totient : ℝ)) else 0 := by
    dsimp only [G]
    rw [Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro d hd
    rw [Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro e he
    by_cases hc : ∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b)
    · simp only [ite_eq_left hc]
      have hphi := selberg_actual_modulus_totient_eq W hW d e (hD d hd) (hE e he) hc
      change (q d e).totient = W.totient * ∏ j, (Nat.lcm (d j) (e j)).totient at hphi
      rw [hphi, Nat.cast_mul, Nat.cast_prod]
      simp only [div_eq_mul_inv, mul_inv_rev]
      ring
    · simp only [ite_eq_right hc, mul_zero]
  have hdiff :
      (∑ n ∈ I, if Nat.ModEq W n v then
        f (n + h i) *
          (∑ d ∈ D, if ∀ j : Fin k, d j ∣ n + h (i.succAbove j) then lam d else 0) *
          (∑ e ∈ E, if ∀ j : Fin k, e j ∣ n + h (i.succAbove j) then mu e else 0)
        else 0) - (total / (W.totient : ℝ)) * G =
      ∑ d ∈ D, ∑ e ∈ E,
        if ∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b) then
          lam d * mu e * (progression d e - total / ((q d e).totient : ℝ)) else 0 := by
    rw [hexpand, hmain, ← Finset.sum_sub_distrib]
    apply Finset.sum_congr rfl
    intro d _
    rw [← Finset.sum_sub_distrib]
    apply Finset.sum_congr rfl
    intro e _
    by_cases hc : ∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b)
    · simp only [ite_eq_left hc, progression]
      ring
    · simp only [ite_eq_right hc, sub_self]
  change |(_ : ℝ) - (total / (W.totient : ℝ)) * G| ≤ _
  rw [hdiff]
  calc
    _ ≤ ∑ d ∈ D, |∑ e ∈ E,
        if ∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b) then
          lam d * mu e * (progression d e - total / ((q d e).totient : ℝ)) else 0| :=
      Finset.abs_sum_le_sum_abs _ _
    _ ≤ ∑ d ∈ D, ∑ e ∈ E,
        |if ∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b) then
          lam d * mu e * (progression d e - total / ((q d e).totient : ℝ)) else 0| :=
      Finset.sum_le_sum fun d _ => Finset.abs_sum_le_sum_abs _ _
    _ = _ := by
      apply Finset.sum_congr rfl
      intro d hd
      apply Finset.sum_congr rfl
      intro e he
      by_cases hc : ∀ a b : Fin k, a ≠ b → Nat.Coprime (d a) (e b)
      · simp only [ite_eq_left hc, abs_mul, hdelta d hd e he hc]
      · simp only [ite_eq_right hc, abs_zero]

open Classical in
theorem selberg39_coherent_weighted_moment_bound
    (h : Fin 40 → ℕ) (hinj : Function.Injective h) (i : Fin 40)
    (D E : Finset (Fin 39 → ℕ)) (lam mu : (Fin 39 → ℕ) → ℝ)
    (W v : ℕ) (hW : 0 < W)
    (hD : ∀ d ∈ D, Squarefree (∏ j, d j) ∧ Nat.Coprime (∏ j, d j) W)
    (hE : ∀ e ∈ E, Squarefree (∏ j, e j) ∧ Nat.Coprime (∏ j, e j) W)
    (hcover : ∀ a b : Fin 40, h a ≠ h b → ∀ p : ℕ,
      p.Prime → p ∣ Nat.dist (h a) (h b) → p ∣ W)
    (hv : Nat.Coprime (v + h i) W) (I : Finset ℕ) (f : ℕ → ℝ)
    (hweight : ∀ d ∈ D, ∀ e ∈ E,
      (∀ a b : Fin 39, a ≠ b → Nat.Coprime (d a) (e b)) →
      ∀ n ∈ I, f (n + h i) ≠ 0 →
        Nat.Coprime (n + h i) (Nat.lcm W (Nat.lcm (∏ j, d j) (∏ j, e j))))
    (B₁ B₂ Err : ℝ) (hB₁ : 0 ≤ B₁) (hB₂ : 0 ≤ B₂)
    (hlam : ∀ d ∈ D, |lam d| ≤ B₁) (hmu : ∀ e ∈ E, |mu e| ≤ B₂)
    (P : Finset ℕ) (hP : ∀ p ∈ P, p.Prime)
    (Q : Finset ℕ) (hQ : Q ⊆ (∏ p ∈ P, p).divisors)
    (hmoduli : ∀ d ∈ D, ∀ e ∈ E,
      (∀ a b : Fin 39, a ≠ b → Nat.Coprime (d a) (e b)) →
      lam d ≠ 0 → mu e ≠ 0 →
        Nat.lcm W (Nat.lcm (∏ j, d j) (∏ j, e j)) ∈ Q)
    (hSource : ∀ a : ℕ, Nat.Coprime a (∏ p ∈ P, p) →
      (∑ q ∈ Q, (q.divisors.card : ℝ) ^ 13 *
        ‖fullDiscrepancy
          (∑ m ∈ I.image (fun n => n + h i), Finsupp.single m ((f m : ℝ) : ℂ)) q a‖) ≤
        Err) :
    let G : ℝ := ∑ d ∈ D, ∑ e ∈ E,
      if ∀ a b : Fin 39, a ≠ b → Nat.Coprime (d a) (e b) then
        lam d * mu e / (∏ j, ((Nat.lcm (d j) (e j)).totient : ℝ)) else 0
    |(∑ n ∈ I, if Nat.ModEq W n v then
        f (n + h i) *
          (∑ d ∈ D, if ∀ j : Fin 39, d j ∣ n + h (i.succAbove j) then lam d else 0) *
          (∑ e ∈ E, if ∀ j : Fin 39, e j ∣ n + h (i.succAbove j) then mu e else 0)
        else 0) - ((∑ n ∈ I, f (n + h i)) / (W.totient : ℝ)) * G| ≤
      B₁ * B₂ * Err := by
  intro G
  let q : (Fin 39 → ℕ) → (Fin 39 → ℕ) → ℕ := fun d e =>
    Nat.lcm W (Nat.lcm (∏ j, d j) (∏ j, e j))
  let u : ℕ →₀ ℂ :=
    ∑ m ∈ I.image (fun n => n + h i), Finsupp.single m ((f m : ℝ) : ℂ)
  obtain ⟨residue, hresidue, hmoment⟩ :=
    selberg_retained_weighted_discrepancy_bound h hinj i D E lam mu W v hW
      hD hE hcover hv I f hweight
  let gate : (Fin 39 → ℕ) → (Fin 39 → ℕ) → Prop := fun d e =>
    (∀ a b : Fin 39, a ≠ b → Nat.Coprime (d a) (e b)) ∧ lam d ≠ 0 ∧ mu e ≠ 0
  let r : (p : P) → Fin 39 → ZMod (p : ℕ) := fun p j =>
    if (p : ℕ) ∣ W then ((v + h i : ℕ) : ZMod (p : ℕ))
    else (h i : ZMod (p : ℕ)) - (h (i.succAbove j) : ZMod (p : ℕ))
  have hr (p : P) (j : Fin 39) : r p j ≠ 0 := by
    by_cases hpW : (p : ℕ) ∣ W
    · let : Fact (Nat.Prime (p : ℕ)) := ⟨hP p p.property⟩
      have hu : IsUnit ((v + h i : ℕ) : ZMod (p : ℕ)) :=
        (ZMod.isUnit_iff_coprime _ _).mpr (hv.of_dvd_right hpW)
      simpa only [r, ite_eq_left hpW] using hu.ne_zero
    · simpa only [r, ite_eq_right hpW] using
        (selberg_prime_face_residue_alphabet h hinj i W hcover
          p (hP p p.property) hpW).1 j
  let U : Finset P := Finset.univ.filter (fun p : P => ¬ (p : ℕ) ∣ W)
  have hfixed (p : P) (hp : p ∉ U) (j l : Fin 39) : r p j = r p l := by
    have hpW : (p : ℕ) ∣ W := by
      by_contra hpW
      exact hp (Finset.mem_filter.mpr ⟨Finset.mem_univ p, hpW⟩)
    simp only [r, ite_eq_left hpW]
  have hchoices (d : Fin 39 → ℕ) (hd : d ∈ D) (e : Fin 39 → ℕ) (he : e ∈ E)
      (hg : gate d e) (p : P) (hpq : (p : ℕ) ∈ (q d e).primeFactors) :
      ∃ j : Fin 39, ((residue d e + h i : ℕ) : ZMod (p : ℕ)) = r p j := by
    have hcrt := hresidue d hd e he hg.1
    have hpoint := (hcrt.2.2.2 (residue d e)).mp (Nat.ModEq.refl _)
    by_cases hpW : (p : ℕ) ∣ W
    · refine ⟨0, ?_⟩
      simp only [r, ite_eq_left hpW]
      exact (ZMod.natCast_eq_natCast_iff _ _ _).mpr
        (Nat.ModEq.add_right (h i) (Nat.ModEq.of_dvd hpW hpoint.1))
    · have hpdvd : (p : ℕ) ∣ W * ∏ j : Fin 39, Nat.lcm (d j) (e j) := by
        rw [← actual_modulus_eq_product W d e (hD d hd) (hE e he) hg.1]
        exact Nat.dvd_of_mem_primeFactors hpq
      have hplcm : (p : ℕ) ∣ ∏ j : Fin 39, Nat.lcm (d j) (e j) :=
        ((hP p p.property).dvd_mul.mp hpdvd).resolve_left hpW
      obtain ⟨j, hj⟩ := selberg_prime_face_residue_choice h i d e (residue d e)
        hpoint.2.1 hpoint.2.2 p (hP p p.property) hplcm
      exact ⟨j, by simpa only [r, ite_eq_right hpW] using hj⟩
  have hpair := selberg39_coherent_pair_error_le W hW D E hD hE gate
    (fun _ _ _ _ hg => hg.1) lam mu B₁ B₂ Err hB₁ hB₂ hlam hmu
    P hP r hr U hfixed Q hQ u (fun d e => residue d e + h i)
    (fun d hd e he hg => hmoduli d hd e he hg.1 hg.2.1 hg.2.2)
    hchoices hSource
  have hsum :
      (∑ d ∈ D, ∑ e ∈ E,
        if ∀ a b : Fin 39, a ≠ b → Nat.Coprime (d a) (e b) then
          |lam d| * |mu e| *
            ‖fullDiscrepancy u (q d e) (residue d e + h i)‖
        else 0) =
      ∑ p ∈ (D.product E).filter (fun p => gate p.1 p.2),
        |lam p.1| * |mu p.2| *
          ‖fullDiscrepancy u (q p.1 p.2)
            (residue p.1 p.2 + h i)‖ := by
    rw [Finset.sum_filter, Finset.product_eq_sprod, Finset.sum_product]
    apply Finset.sum_congr rfl
    intro d _hd
    apply Finset.sum_congr rfl
    intro e _he
    by_cases hl : lam d = 0 <;> by_cases hm : mu e = 0 <;>
      simp [gate, hl, hm]
  exact hmoment.trans (hsum.trans_le hpair)

section

open scoped ContDiff

open Classical in
theorem canonical40_presieving_fragment_carrier
    {𝓗 : Finset ℕ}
    (x R κ : ℝ) :
    let W := presievingModulus 𝓗 x
    let Pfrag := fragmentPrimes W R κ
    let P := W.primeFactors ∪ Pfrag
    (∀ p ∈ Pfrag, p.Prime) ∧ (∀ p ∈ P, p.Prime) ∧
      (∏ p ∈ P, p) = W * (∏ p ∈ Pfrag, p) ∧ 0 < ∏ p ∈ P, p := by
  intro W Pfrag P
  have hfrag (p : ℕ) (hp : p ∈ Pfrag) : p.Prime :=
    Nat.prime_of_mem_primesLE (Finset.mem_filter.mp hp).1
  have hprime (p : ℕ) (hp : p ∈ P) : p.Prime := by
    rcases Finset.mem_union.mp hp with hp | hp
    · exact Nat.prime_of_mem_primeFactors hp
    · exact hfrag p hp
  have hW : Squarefree W := by
    dsimp only [W]
    delta presievingModulus
    exact squarefree_prime_prod _
      (fun p hp => presieve_factor_prime 𝓗 x hp)
  have hdisjoint : Disjoint W.primeFactors Pfrag := by
    apply Finset.disjoint_left.mpr
    intro p hp hfragp
    exact (Finset.mem_filter.mp hfragp).2 (Nat.dvd_of_mem_primeFactors hp)
  refine ⟨hfrag, hprime, ?_, Finset.prod_pos (fun p hp => (hprime p hp).pos)⟩
  dsimp only [P]
  rw [Finset.prod_union hdisjoint, Nat.prod_primeFactors_of_squarefree hW]
open Classical in
theorem canonical40_coherent_weighted_error_transfer
    {𝓗 : Finset ℕ} {h𝓗_card : 𝓗.card = 40}
    (x : ℝ) (i : Fin 40) (D E : Finset (Fin 39 → ℕ))
    (F G : (Fin 39 → ℕ) → ℝ) (u : ℕ → ℝ)
    (C₁ C₂ K A : ℝ) (hC₁ : 0 < C₁) (hC₂ : 0 < C₂)
    (hlog : 0 < Real.log x) (P Q : Finset ℕ)
    (hP : ∀ p ∈ P, p.Prime) (hQ : Q ⊆ (∏ p ∈ P, p).divisors) :
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    let W := presievingModulus 𝓗 x
    let I := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
    let D' := D.filter (fun d => F d ≠ 0)
    let E' := E.filter (fun e => G e ≠ 0)
    (∀ d ∈ D', Squarefree (∏ j, d j) ∧ Nat.Coprime (∏ j, d j) W) →
    (∀ e ∈ E', Squarefree (∏ j, e j) ∧ Nat.Coprime (∏ j, e j) W) →
    (∀ d ∈ D, |F d| ≤ C₁ * Real.log x) →
    (∀ e ∈ E, |G e| ≤ C₂ * Real.log x) →
    (∀ d ∈ D', ∀ e ∈ E',
      (∀ a b : Fin 39, a ≠ b → Nat.Coprime (d a) (e b)) →
      ∀ n ∈ I, u (n + h i) ≠ 0 →
        Nat.Coprime (n + h i) (Nat.lcm W (Nat.lcm (∏ j, d j) (∏ j, e j)))) →
    (∀ d ∈ D', ∀ e ∈ E',
      Nat.lcm W (Nat.lcm (∏ j, d j) (∏ j, e j)) ∈ Q) →
    (∀ a : ℕ, Nat.Coprime a (∏ p ∈ P, p) →
      (∑ q ∈ Q, (q.divisors.card : ℝ) ^ 13 *
        ‖fullDiscrepancy
          (∑ m ∈ I.image (fun n => n + h i), Finsupp.single m (u m : ℂ)) q a‖) ≤
        K * x / (Real.log x) ^ (A + 2)) →
    ∀ v : ℕ, Nat.Coprime (v + h i) W →
      |(∑ n ∈ I, if Nat.ModEq W n v then
          u (n + h i) *
            (∑ d ∈ D, if ∀ j, d j ∣ n + h (i.succAbove j) then F d else 0) *
            (∑ e ∈ E, if ∀ j, e j ∣ n + h (i.succAbove j) then G e else 0)
          else 0) -
        ((∑ n ∈ I, u (n + h i)) / (W.totient : ℝ)) *
          (∑ d ∈ D, ∑ e ∈ E,
            if ∀ a b : Fin 39, a ≠ b → Nat.Coprime (d a) (e b) then
              F d * G e / (∏ j, ((Nat.lcm (d j) (e j)).totient : ℝ)) else 0)| ≤
        (C₁ * C₂ * K) * x / (Real.log x) ^ A := by
  intro h W I D' E' hD hE hF hG hweight hmoduli hSource v hv
  have hrootF (n : ℕ) :
      (∑ d ∈ D', if ∀ j, d j ∣ n + h (i.succAbove j) then F d else 0) =
        ∑ d ∈ D, if ∀ j, d j ∣ n + h (i.succAbove j) then F d else 0 :=
    Finset.sum_filter_of_ne fun d _ hd hzero => hd (by simp [hzero])
  have hrootG (n : ℕ) :
      (∑ e ∈ E', if ∀ j, e j ∣ n + h (i.succAbove j) then G e else 0) =
        ∑ e ∈ E, if ∀ j, e j ∣ n + h (i.succAbove j) then G e else 0 :=
    Finset.sum_filter_of_ne fun e _ he hzero => he (by simp [hzero])
  have hgram :
      (∑ d ∈ D', ∑ e ∈ E',
        if ∀ a b : Fin 39, a ≠ b → Nat.Coprime (d a) (e b) then
          F d * G e / (∏ j, ((Nat.lcm (d j) (e j)).totient : ℝ)) else 0) =
      ∑ d ∈ D, ∑ e ∈ E,
        if ∀ a b : Fin 39, a ≠ b → Nat.Coprime (d a) (e b) then
          F d * G e / (∏ j, ((Nat.lcm (d j) (e j)).totient : ℝ)) else 0 := by
    change (∑ d ∈ D.filter (fun d => F d ≠ 0), ∑ e ∈ E',
      if ∀ a b : Fin 39, a ≠ b → Nat.Coprime (d a) (e b) then
        F d * G e / (∏ j, ((Nat.lcm (d j) (e j)).totient : ℝ)) else 0) = _
    rw [Finset.sum_filter_of_ne (s := D)]
    · exact Finset.sum_congr rfl fun d _ =>
        Finset.sum_filter_of_ne fun e _ he hzero => he (by simp [hzero])
    · exact fun d _ hd hzero => hd (by simp [hzero])
  have hcover : ∀ a b : Fin 40, h a ≠ h b → ∀ p : ℕ,
      p.Prime → p ∣ Nat.dist (h a) (h b) → p ∣ W := by
    intro a b hab p hp hpd
    exact difference_prime_dvd_presieving 𝓗 x
      (𝓗.orderEmbOfFin_mem h𝓗_card a)
      (𝓗.orderEmbOfFin_mem h𝓗_card b) hab hp hpd
  have hfinite := selberg39_coherent_weighted_moment_bound h
    (𝓗.orderEmbOfFin h𝓗_card).injective i
    D' E' F G W v (presieving_pos 𝓗 x)
    hD hE hcover hv I u hweight
    (C₁ * Real.log x) (C₂ * Real.log x) (K * x / (Real.log x) ^ (A + 2))
    (mul_nonneg hC₁.le hlog.le) (mul_nonneg hC₂.le hlog.le)
    (fun d hd => hF d (Finset.mem_filter.mp hd).1)
    (fun e he => hG e (Finset.mem_filter.mp he).1)
    P hP Q hQ (fun d hd e he _ _ _ => hmoduli d hd e he) hSource
  dsimp only at hfinite
  simp only [hrootF, hrootG, hgram] at hfinite
  apply hfinite.trans_eq
  clear * - C₁ C₂ K x A hlog
  rw [Real.rpow_add hlog, Real.rpow_two]
  field_simp

end

section
open Set
/--
Eulerian numbers with initial row `A(0, 0) = 1` and all other entries zero. The recurrence is
`A(m + 1, a) = (a + 1) * A(m, a) + (m + 1 - a) * A(m, a - 1)`, with the second term omitted at
`a = 0`.
-/
def eulerianNumber : ℕ → ℕ → ℕ :=
  Nat.rec (motive := fun _ => ℕ → ℕ)
    (fun a => if a = 0 then 1 else 0)
    (fun m previous a =>
      (a + 1) * previous a +
        (if a = 0 then 0 else (m + 1 - a) * previous (a - 1)))

theorem eulerianNumber_eq_zero (m a : ℕ) (ha : 0 < a) (h : m ≤ a) :
    eulerianNumber m a = 0 := by
  induction m generalizing a with
  | zero => simp [eulerianNumber, ha.ne']
  | succ m ih =>
    change (a + 1) * eulerianNumber m a +
      (if a = 0 then 0 else (m + 1 - a) * eulerianNumber m (a - 1)) = 0
    simp [ih a ha ((Nat.le_succ m).trans h), Nat.sub_eq_zero_of_le h]

theorem fwdDiff_iter_mul_id (f : ℝ → ℝ) (k : ℕ) (x : ℝ) :
    ((fwdDiff (1 : ℝ))^[k + 1] (fun y => y * f y)) x =
      (x + (k : ℝ) + 1) * ((fwdDiff (1 : ℝ))^[k + 1] f) x +
        ((k : ℝ) + 1) * ((fwdDiff (1 : ℝ))^[k] f) x := by
  induction k generalizing x with
  | zero => simp [fwdDiff]; ring
  | succ k ih =>
    rw [Function.iterate_succ_apply']
    change
      ((fwdDiff (1 : ℝ))^[k + 1] (fun y => y * f y)) (x + 1) -
        ((fwdDiff (1 : ℝ))^[k + 1] (fun y => y * f y)) x = _
    rw [ih (x + 1), ih x]
    simp only [Function.iterate_succ_apply', fwdDiff, Nat.cast_succ]
    ring

theorem fwdDiff_iter_posPart_pow_eq_zero (m n : ℕ) (hm : 0 < m) (x : ℝ)
    (hx : x + (n : ℝ) ≤ 0) :
    ((fwdDiff (1 : ℝ))^[n] (fun y => (max y 0) ^ m)) x = 0 := by
  rw [fwdDiff_iter_eq_sum_shift]
  apply Finset.sum_eq_zero
  intro k hk
  have hkn : (k : ℝ) ≤ n := by exact_mod_cast Nat.le_of_lt_succ (Finset.mem_range.mp hk)
  have hsample : x + k • (1 : ℝ) ≤ 0 := by simpa using (show x + (k : ℝ) ≤ 0 by linarith)
  rw [max_eq_right hsample, zero_pow hm.ne', smul_zero]

theorem fwdDiff_iter_posPart_pow_succ (m : ℕ) (hm : 0 < m) (x : ℝ) :
    ((fwdDiff (1 : ℝ))^[m + 2] (fun y => (max y 0) ^ (m + 1)))
        (x - (m : ℝ) - 1) =
      (x + 1) * ((fwdDiff (1 : ℝ))^[m + 1] (fun y => (max y 0) ^ m))
        (x - (m : ℝ)) +
      ((m : ℝ) + 1 - x) *
        ((fwdDiff (1 : ℝ))^[m + 1] (fun y => (max y 0) ^ m))
          (x - 1 - (m : ℝ)) := by
  have hpow : (fun y : ℝ => (max y 0) ^ (m + 1)) =
      (fun y : ℝ => y * (max y 0) ^ m) := by
    funext y
    rcases le_total y 0 with hy | hy
    · simp [max_eq_right hy, zero_pow hm.ne']
    · rw [max_eq_left hy, pow_succ']
  rw [hpow, fwdDiff_iter_mul_id, Function.iterate_succ_apply']
  change
    (x - (m : ℝ) - 1 + ((m + 1 : ℕ) : ℝ) + 1) *
        (((fwdDiff (1 : ℝ))^[m + 1] (fun y => (max y 0) ^ m))
          (x - (m : ℝ) - 1 + 1) -
        ((fwdDiff (1 : ℝ))^[m + 1] (fun y => (max y 0) ^ m))
          (x - (m : ℝ) - 1)) +
      (((m + 1 : ℕ) : ℝ) + 1) *
        ((fwdDiff (1 : ℝ))^[m + 1] (fun y => (max y 0) ^ m))
          (x - (m : ℝ) - 1) = _
  rw [sub_add_cancel, show x - (m : ℝ) - 1 = x - 1 - (m : ℝ) by ring]
  push_cast
  ring

theorem fwdDiff_iter_posPart_pow_eq_eulerian (m a : ℕ) (hm : 0 < m) :
    ((fwdDiff (1 : ℝ))^[m + 1] (fun y => (max y 0) ^ m))
      ((a : ℝ) - (m : ℝ)) = (eulerianNumber m a : ℝ) := by
  induction m generalizing a with
  | zero => omega
  | succ m ih =>
    by_cases hm0 : m = 0
    · subst m
      by_cases ha : a = 0
      · subst a
        norm_num [fwdDiff, Function.iterate_succ_apply', eulerianNumber]
      · have ha' : 1 ≤ a := Nat.one_le_iff_ne_zero.mpr ha
        have har : (1 : ℝ) ≤ a := by exact_mod_cast ha'
        rw [eulerianNumber_eq_zero 1 a (Nat.pos_of_ne_zero ha) ha']
        simp only [Nat.zero_add, Function.iterate_succ_apply', Function.iterate_zero,
          id_eq, fwdDiff, pow_one, Nat.cast_one, Nat.cast_zero]
        rw [max_eq_left (by linarith : (0 : ℝ) ≤ (a : ℝ) - 1 + 1 + 1),
          max_eq_left (by linarith : (0 : ℝ) ≤ (a : ℝ) - 1 + 1),
          max_eq_left (by linarith : (0 : ℝ) ≤ (a : ℝ) - 1)]
        ring
    · have hm' : 0 < m := Nat.pos_of_ne_zero hm0
      rw [show (a : ℝ) - ((m + 1 : ℕ) : ℝ) = (a : ℝ) - (m : ℝ) - 1 by
        push_cast; ring]
      rw [fwdDiff_iter_posPart_pow_succ m hm', ih a hm']
      by_cases ha : a = 0
      · subst a
        rw [fwdDiff_iter_posPart_pow_eq_zero m (m + 1) hm' _ (by push_cast; linarith)]
        simp [eulerianNumber]
      · have ha' : 1 ≤ a := Nat.one_le_iff_ne_zero.mpr ha
        rw [show (a : ℝ) - 1 = ((a - 1 : ℕ) : ℝ) by
          rw [Nat.cast_sub ha', Nat.cast_one]]
        rw [ih (a - 1) hm']
        conv_rhs =>
          change (((a + 1) * eulerianNumber m a +
            (if a = 0 then 0 else (m + 1 - a) * eulerianNumber m (a - 1)) : ℕ) : ℝ)
        simp only [ha, ite_false, Nat.cast_add, Nat.cast_mul, Nat.cast_one]
        by_cases ham : a ≤ m + 1
        · rw [Nat.cast_sub ham]
          push_cast
          ring
        · rw [eulerianNumber_eq_zero m (a - 1) (by omega) (by omega)]
          simp

theorem unitCube_carry_eq_eulerian (m a : ℕ) :
    (MeasureTheory.volume : MeasureTheory.Measure (Fin m → ℝ))
      (Set.Icc (fun _ : Fin m => (0 : ℝ)) (fun _ => (1 : ℝ)) ∩
        {x | (a : ℝ) ≤ ∑ i : Fin m, x i ∧
          (∑ i : Fin m, x i) < (a : ℝ) + 1}) =
      (eulerianNumber m a : ℝ≥0∞) / (m.factorial : ℝ≥0∞) := by
  rcases Nat.eq_zero_or_pos m with rfl | hm
  · by_cases ha : a = 0
    · subst a
      simp [eulerianNumber, Real.volume_Icc_pi]
    · simp [eulerianNumber, ha]
  · rw [unitCube_carry_eq_forwardDifference m a hm,
      fwdDiff_iter_posPart_pow_eq_eulerian m a hm,
      ENNReal.ofReal_div_of_pos (Nat.cast_pos.mpr (Nat.factorial_pos m))]
    simp

/--
The polynomial whose coefficient of `X^a`, for `a < m`, is the Eulerian number `A(m, a)` divided
by `m!`. The empty sum gives zero when `m = 0`.
-/
noncomputable def eulerianCarryPolynomial (m : ℕ) : Polynomial ℚ :=
  ∑ a ∈ Finset.range m,
    Polynomial.monomial a
      ((eulerianNumber m a : ℚ) / (m.factorial : ℚ))

theorem physical_cell_sum_mass_eq_shifted_eulerian
    (m j : ℕ) (hm : 0 < m) (h : ℝ) (hh : 0 < h)
    (k : Fin m → ℕ) :
    (MeasureTheory.Measure.map (fun x : Fin m → ℝ => ∑ i, x i)
      (MeasureTheory.Measure.pi fun i : Fin m =>
        (MeasureTheory.volume : MeasureTheory.Measure ℝ).restrict
          (Set.Ico ((k i : ℝ) * h) (((k i : ℝ) + 1) * h))))
      (Set.Ico ((j : ℝ) * h) (((j : ℝ) + 1) * h)) =
        ENNReal.ofReal (h ^ m) *
          ENNReal.ofReal
            ((((Polynomial.X : Polynomial ℚ) ^ (∑ i, k i) *
              eulerianCarryPolynomial m).coeff j : ℚ) : ℝ) := by
  classical
  have hsum : Measurable (fun x : Fin m → ℝ => ∑ i, x i) := by fun_prop
  rw [Measure.map_apply hsum measurableSet_Ico, ← Measure.restrict_pi_pi,
    ← volume_pi, Measure.restrict_apply (hsum measurableSet_Ico)]
  let B : Set (Fin m → ℝ) :=
    Set.univ.pi fun i => Ico ((k i : ℝ) * h) (((k i : ℝ) + 1) * h)
  let P : Set (Fin m → ℝ) :=
    (fun x => ∑ i, x i) ⁻¹' Ico ((j : ℝ) * h) (((j : ℝ) + 1) * h)
  change volume (P ∩ B) = _
  rw [Polynomial.coeff_X_pow_mul']
  split_ifs with hkj
  · let a := j - ∑ i, k i
    have hcast : ((∑ i, k i : ℕ) : ℝ) + (a : ℝ) = (j : ℝ) := by
      exact_mod_cast Nat.add_sub_of_le hkj
    let A : Set (Fin m → ℝ) :=
      (Set.univ.pi fun _ => Ico (0 : ℝ) 1) ∩
        {u | (a : ℝ) ≤ ∑ i, u i ∧ (∑ i, u i) < (a : ℝ) + 1}
    let c : Fin m → ℝ := fun i => (k i : ℝ) * h
    have himage : P ∩ B = (fun u : Fin m → ℝ => c + h • u) '' A := by
      ext x
      constructor
      · rintro ⟨hxout, hxin⟩
        have hxin := Set.mem_univ_pi.mp hxin
        have hs : (∑ i, (x i / h - (k i : ℝ))) =
            (∑ i, x i) / h - ((∑ i, k i : ℕ) : ℝ) := by
          simp [Finset.sum_sub_distrib, Finset.sum_div]
        refine ⟨fun i => x i / h - (k i : ℝ), ?_, ?_⟩
        · refine ⟨Set.mem_univ_pi.mpr (fun i => ?_), ?_, ?_⟩
          · constructor
            · exact sub_nonneg.mpr ((le_div_iff₀ hh).mpr (hxin i).1)
            · linarith [(div_lt_iff₀ hh).mpr (hxin i).2]
          · rw [hs]
            linarith [(le_div_iff₀ hh).mpr hxout.1]
          · rw [hs]
            linarith [(div_lt_iff₀ hh).mpr hxout.2]
        · funext i
          dsimp [c]
          field_simp
          ring
      · rintro ⟨u, ⟨huin, huout⟩, rfl⟩
        have huin := Set.mem_univ_pi.mp huin
        have hs : (∑ i, (c + h • u) i) =
            ((∑ i, k i : ℕ) : ℝ) * h + h * ∑ i, u i := by
          simp [c, Finset.sum_add_distrib, Finset.sum_mul, Finset.mul_sum]
        constructor
        · change (j : ℝ) * h ≤ ∑ i, (c + h • u) i ∧
            (∑ i, (c + h • u) i) < ((j : ℝ) + 1) * h
          rw [hs]
          constructor
          · nlinarith [mul_le_mul_of_nonneg_left huout.1 hh.le]
          · nlinarith [mul_lt_mul_of_pos_left huout.2 hh]
        · apply Set.mem_univ_pi.mpr
          intro i
          change (k i : ℝ) * h ≤ (k i : ℝ) * h + h * u i ∧
            (k i : ℝ) * h + h * u i < ((k i : ℝ) + 1) * h
          constructor
          · exact le_add_of_nonneg_right (mul_nonneg hh.le (huin i).1)
          · nlinarith [mul_lt_mul_of_pos_left (huin i).2 hh]
    have hcube :
        volume A = (eulerianNumber m a : ℝ≥0∞) / (m.factorial : ℝ≥0∞) := by
      have heq :
          (Set.univ.pi (fun _ : Fin m => Ico (0 : ℝ) 1)) =ᵐ[volume]
            Icc (fun _ : Fin m => (0 : ℝ)) (fun _ => (1 : ℝ)) :=
        Measure.univ_pi_Ico_ae_eq_Icc
      exact (measure_congr (heq.inter (ae_eq_refl _))).trans
        (unitCube_carry_eq_eulerian m a)
    have hcoeff : (eulerianCarryPolynomial m).coeff a =
        (eulerianNumber m a : ℚ) / (m.factorial : ℚ) := by
      by_cases ha : a < m
      · simp [eulerianCarryPolynomial, Polynomial.coeff_monomial, ha]
      · have hz := eulerianNumber_eq_zero m a (hm.trans_le (Nat.le_of_not_gt ha))
          (Nat.le_of_not_gt ha)
        simp [eulerianCarryPolynomial, Polynomial.coeff_monomial, ha, hz]
    rw [himage]
    calc
      _ = volume ((fun v => c + v) '' ((fun u : Fin m → ℝ => h • u) '' A)) := by
        rw [Set.image_image]
      _ = ENNReal.ofReal (h ^ m) * volume A := by
        rw [Set.image_add_left, measure_preimage_add, Set.image_smul,
          Measure.addHaar_smul_of_nonneg volume hh.le, Module.finrank_fin_fun]
      _ = _ := by
        rw [hcube, hcoeff]
        simp [ENNReal.ofReal_div_of_pos (Nat.cast_pos.mpr (Nat.factorial_pos m))]
  · have hempty : P ∩ B = ∅ := by
      apply Set.eq_empty_iff_forall_notMem.mpr
      rintro x ⟨hxout, hxin⟩
      have hlow : ((∑ i, k i : ℕ) : ℝ) * h ≤ ∑ i, x i := by
        rw [Nat.cast_sum, Finset.sum_mul]
        exact Finset.sum_le_sum fun i _ => (Set.mem_univ_pi.mp hxin i).1
      have hk : (j : ℝ) + 1 ≤ ((∑ i, k i : ℕ) : ℝ) := by
        exact_mod_cast Nat.succ_le_of_lt (Nat.lt_of_not_ge hkj)
      exact (not_lt_of_ge ((mul_le_mul_of_nonneg_right hk hh.le).trans hlow)) hxout.2
    rw [hempty]
    simp

theorem physical_cell_mixture_sum_mass_eq_eulerian
    (m j : ℕ) (hm : 0 < m) (h : ℝ) (hh : 0 < h)
    (s : Fin m → Finset ℕ) (w : Fin m → ℕ → ℝ)
    (hw : ∀ i, ∀ a ∈ s i, 0 ≤ w i a) :
    let P : Fin m → Polynomial ℝ :=
      fun i => ∑ a ∈ s i, Polynomial.monomial a (w i a)
    (MeasureTheory.Measure.map (fun x : Fin m → ℝ => ∑ i, x i)
      (MeasureTheory.Measure.pi fun i : Fin m =>
        ∑ a ∈ s i,
          ENNReal.ofReal (w i a / h) •
            (MeasureTheory.volume : MeasureTheory.Measure ℝ).restrict
              (Set.Ico ((a : ℝ) * h) (((a : ℝ) + 1) * h))))
      (Set.Ico ((j : ℝ) * h) (((j : ℝ) + 1) * h)) =
        ENNReal.ofReal
          (((∏ i, P i) *
            (eulerianCarryPolynomial m).map (Rat.castHom ℝ)).coeff j) := by
  intro P
  let C (a : ℕ) := Ico ((a : ℝ) * h) (((a : ℝ) + 1) * h)
  let μ (a : ℕ) := volume.restrict (C a)
  let c (i : Fin m) (a : ℕ) := ENNReal.ofReal (w i a / h)
  let ν (i : Fin m) := ∑ a ∈ s i, c i a • μ a
  let E := (eulerianCarryPolynomial m).map (Rat.castHom ℝ)
  let (a : ℕ) : IsFiniteMeasure (μ a) := inferInstance
  let (i : Fin m) (a : ℕ) : IsFiniteMeasure (c i a • μ a) :=
    Measure.smul_finite _ ENNReal.ofReal_ne_top
  let (i : Fin m) : IsFiniteMeasure (ν i) := inferInstance
  have hpi :
      Measure.pi ν =
        ∑ k ∈ Fintype.piFinset s,
          (∏ i, c i (k i)) • Measure.pi (fun i => μ (k i)) := by
    apply Measure.pi_eq
    intro t _
    simp only [ν, Measure.finsetSum_apply, Measure.smul_apply, smul_eq_mul,
      Measure.pi_pi, Finset.prod_univ_sum, Finset.prod_mul_distrib]
  have hsum : Measurable (fun x : Fin m → ℝ => ∑ i, x i) := by fun_prop
  have hpoly :
      (∏ i, P i) * E =
        ∑ k ∈ Fintype.piFinset s,
          Polynomial.C (∏ i, w i (k i)) *
            ((Polynomial.X : Polynomial ℝ) ^ (∑ i, k i) * E) := by
    rw [Finset.prod_univ_sum, Finset.sum_mul]
    apply Finset.sum_congr rfl
    intro k _
    simp only [← Polynomial.C_mul_X_pow_eq_monomial, Finset.prod_mul_distrib,
      map_prod, Finset.prod_pow_eq_pow_sum, mul_assoc]
  have hE (a : ℕ) : 0 ≤ E.coeff a := by
    simp only [E, Polynomial.coeff_map, Rat.coe_castHom, Rat.cast_nonneg,
      eulerianCarryPolynomial, Polynomial.finsetSum_coeff, Polynomial.coeff_monomial,
      Finset.sum_ite_eq', Finset.mem_range]
    split_ifs <;> positivity
  have hbox (k : Fin m → ℕ) :
      (Measure.pi fun i => μ (k i)) ((fun x : Fin m → ℝ => ∑ i, x i) ⁻¹' C j) =
        ENNReal.ofReal (h ^ m) *
          ENNReal.ofReal
            (((Polynomial.X : Polynomial ℝ) ^ (∑ i, k i) * E).coeff j) := by
    by_cases hk : ∑ i, k i ≤ j <;>
      simpa [μ, C, Measure.map_apply hsum measurableSet_Ico,
        Polynomial.coeff_X_pow_mul', E, hk] using
        physical_cell_sum_mass_eq_shifted_eulerian m j hm h hh k
  have hweight (k : Fin m → ℕ) (hk : k ∈ Fintype.piFinset s) (i : Fin m) :=
    hw i _ (Fintype.mem_piFinset.mp hk i)
  rw [Measure.map_apply hsum (show MeasurableSet (C j) from measurableSet_Ico),
    hpi, Measure.finsetSum_apply, hpoly, Polynomial.finsetSum_coeff]
  simp only [Polynomial.coeff_C_mul]
  rw [ENNReal.ofReal_sum_of_nonneg (fun k hk =>
    mul_nonneg (Finset.prod_nonneg fun i _ => hweight k hk i) (by
      rw [Polynomial.coeff_X_pow_mul']
      split_ifs
      · exact hE _
      · exact le_rfl))]
  apply Finset.sum_congr rfl
  intro k hk
  have hd (i : Fin m) := div_nonneg (hweight k hk i) hh.le
  have hcancel : (∏ i, w i (k i) / h) * h ^ m = ∏ i, w i (k i) := by
    simp [Finset.prod_div_distrib, hh.ne']
  rw [Measure.smul_apply, smul_eq_mul, hbox k, ← mul_assoc,
    ← ENNReal.ofReal_prod_of_nonneg (fun i _ => hd i),
    ← ENNReal.ofReal_mul (Finset.prod_nonneg fun i _ => hd i), hcancel,
    ← ENNReal.ofReal_mul (Finset.prod_nonneg fun i _ => hweight k hk i)]

theorem eulerianCarryPolynomial_eq (m : ℕ) :
    eulerianCarryPolynomial m =
      Polynomial.C ((m.factorial : ℚ)⁻¹) *
        ∑ a ∈ Finset.range m,
          Polynomial.C (eulerianNumber m a : ℚ) * Polynomial.X ^ a := by
  classical
  ext a
  simp [eulerianCarryPolynomial, Polynomial.coeff_monomial, div_eq_mul_inv, mul_comm]

theorem eulerianCarryPolynomial_coeff_nonneg_le (m a : ℕ) (hm : 0 < m) :
    0 ≤ (eulerianCarryPolynomial m).coeff a ∧
      (eulerianCarryPolynomial m).coeff a ≤
        (∑ b ∈ Finset.range m, (Polynomial.X : Polynomial ℚ) ^ b).coeff a := by
  classical
  obtain ⟨m, rfl⟩ := Nat.exists_eq_succ_of_ne_zero hm.ne'
  have hcoeff :
      (eulerianCarryPolynomial (m + 1)).coeff a =
        if a < m + 1 then
          (eulerianNumber (m + 1) a : ℚ) / ((m + 1).factorial : ℚ) else 0 := by
    rw [eulerianCarryPolynomial_eq]
    simp [div_eq_mul_inv, mul_comm]
  have hrep :
      (∑ b ∈ Finset.range (m + 1), (Polynomial.X : Polynomial ℚ) ^ b).coeff a =
        if a < m + 1 then 1 else 0 := by
    simp [Polynomial.coeff_X_pow]
  rw [hcoeff, hrep]
  split_ifs with ha
  · refine ⟨by positivity, ?_⟩
    have hvol :
        (eulerianNumber (m + 1) a : ℝ≥0∞) / ((m + 1).factorial : ℝ≥0∞) ≤ 1 := by
      rw [← unitCube_carry_eq_eulerian]
      calc
        _ ≤ volume (Set.Icc (fun _ : Fin (m + 1) => (0 : ℝ)) (fun _ => (1 : ℝ))) :=
          measure_mono Set.inter_subset_left
        _ = 1 := by simp [Real.volume_Icc_pi]
    apply (Rat.cast_le (K := ℝ)).mp
    simpa using ENNReal.toReal_mono (by simp : (1 : ℝ≥0∞) ≠ ∞) hvol
  · exact ⟨le_rfl, le_rfl⟩

theorem eulerianCarryPolynomial_finite_hybrid
    (Q : Polynomial ℚ) (e : Fin 2) (countBound «prefix» j : ℕ)
    (hprefix : «prefix» ≤ countBound)
    (hQ : ∀ a ≤ j, 0 ≤ Q.coeff a) :
    let q : ℕ → Polynomial ℚ :=
      fun r => Polynomial.C ((r.factorial : ℚ)⁻¹) * Q ^ r
    let R : ℕ → Polynomial ℚ :=
      fun m => ∑ a ∈ Finset.range m, (Polynomial.X : Polynomial ℚ) ^ a
    let tail :=
      (∑ r ∈ Finset.range (countBound + 1), q r * R (r + e.val + 1)) -
        ∑ r ∈ Finset.range («prefix» + 1), q r * R (r + e.val + 1)
    0 ≤ tail.coeff j ∧
      (∑ r ∈ Finset.range (countBound + 1),
        q r * eulerianCarryPolynomial (r + e.val + 1)).coeff j ≤
      ((∑ r ∈ Finset.range («prefix» + 1),
        q r * eulerianCarryPolynomial (r + e.val + 1)) + tail).coeff j := by
  classical
  intro q R tail
  have hq0 : q 0 = 1 := by simp [q]
  have hqsucc (r : ℕ) :
      q (r + 1) = Polynomial.C (((r + 1 : ℕ) : ℚ)⁻¹) * (q r * Q) := by
    simp only [q, Nat.factorial_succ, Nat.cast_mul, mul_inv_rev, map_mul, pow_succ]
    ring
  have hqnonneg (r a : ℕ) (ha : a ≤ j) : 0 ≤ (q r).coeff a := by
    induction r generalizing a with
    | zero =>
        rw [hq0, Polynomial.coeff_one]
        split_ifs <;> norm_num
    | succ r ih =>
        rw [hqsucc, Polynomial.coeff_C_mul, Polynomial.coeff_mul]
        apply mul_nonneg (by positivity)
        apply Finset.sum_nonneg
        intro uv huv
        have huv' := Finset.HasAntidiagonal.mem_antidiagonal.mp huv
        exact mul_nonneg (ih uv.1 (by omega)) (hQ uv.2 (by omega))
  have hrepnonneg (r : ℕ) : 0 ≤ (q r * R (r + e.val + 1)).coeff j := by
    rw [Polynomial.coeff_mul]
    apply Finset.sum_nonneg
    intro uv huv
    have huv' := Finset.HasAntidiagonal.mem_antidiagonal.mp huv
    refine mul_nonneg (hqnonneg r uv.1 (by omega)) ?_
    simp only [R, Polynomial.finsetSum_coeff, Polynomial.coeff_X_pow]
    positivity
  have hcompare (r : ℕ) :
      (q r * eulerianCarryPolynomial (r + e.val + 1)).coeff j ≤
        (q r * R (r + e.val + 1)).coeff j := by
    rw [Polynomial.coeff_mul, Polynomial.coeff_mul]
    apply Finset.sum_le_sum
    intro uv huv
    have huv' := Finset.HasAntidiagonal.mem_antidiagonal.mp huv
    exact mul_le_mul_of_nonneg_left
      (eulerianCarryPolynomial_coeff_nonneg_le _ uv.2 (by omega)).2
      (hqnonneg r uv.1 (by omega))
  have htail :
      tail = ∑ r ∈ Finset.Ico («prefix» + 1) (countBound + 1),
        q r * R (r + e.val + 1) :=
    (Finset.sum_Ico_eq_sub (fun r => q r * R (r + e.val + 1))
      (Nat.add_le_add_right hprefix 1)).symm
  rw [htail]
  constructor
  · rw [Polynomial.finsetSum_coeff]
    exact Finset.sum_nonneg fun r _ => hrepnonneg r
  · rw [← Finset.sum_range_add_sum_Ico
      (fun r => q r * eulerianCarryPolynomial (r + e.val + 1))
      (Nat.add_le_add_right hprefix 1), Polynomial.coeff_add,
      Polynomial.coeff_add, add_le_add_iff_left]
    simp only [Polynomial.finsetSum_coeff]
    exact Finset.sum_le_sum fun r _ => hcompare r

/-!
## Renewal envelopes and rational error budgets

Develop renewal-kernel enclosures and the exact rational assembly of the retained numerical
bounds.
-/

/--
The convolution measure obtained by summing one nonnegative Dickman-density coordinate and `r +
e.val` logarithmic-density coordinates, scaled by `1 / r!`. The logarithmic coordinates lie
above `2331 * h`, with upper cap `3498 * h` for the optional marked coordinate and `49152 * h`
for the others.
-/
noncomputable def firstOuterLowCountMeasure (e : Fin 2) (r : ℕ) :
    MeasureTheory.Measure ℝ :=
  let h : ℝ := 2742997 / 258046918656
  let μ : Fin (r + e.val + 1) → MeasureTheory.Measure ℝ :=
    fun i =>
      if i.val = 0 then
        ((MeasureTheory.volume : MeasureTheory.Measure ℝ).restrict
          (Set.Ici 0)).withDensity
            (fun t => ENNReal.ofReal
              (dickmanRho (t / (2331 * h)) * Real.exp (-189 * t)))
      else
        let cap : ℝ := if i.val ≤ e.val then 3498 else 49152
        ((MeasureTheory.volume : MeasureTheory.Measure ℝ).restrict
          (Set.Ioc (2331 * h) (cap * h))).withDensity
            (fun t => ENNReal.ofReal (1 / t))
  ENNReal.ofReal ((r.factorial : ℝ)⁻¹) •
    MeasureTheory.Measure.map
      (fun x : Fin (r + e.val + 1) → ℝ => ∑ i, x i)
      (MeasureTheory.Measure.pi μ)

/--
The discretized renewal envelope combining the selected Dickman profile and exponential decay
with logarithmic convolution powers. Orders below `33` use normalized Eulerian carry
polynomials; orders `33` through `42` use coefficient-one carry envelopes, with an optional
marked factor selected by `e`.
-/
noncomputable def firstOuterLowRenewalEnvelopePolynomial (e : Fin 2) :
    Polynomial ℝ :=
  let h : ℝ := 2742997 / 258046918656
  let I := dickmanRenewalDyadicPrefix 160 2331 98303
  let f : ℚ := 1 / 10 ^ 40
  let flo := (f.toDyadic 160).toRat
  let stopped : ℕ → Bool := fun j =>
    (List.range (j + 1)).any
      (fun i => decide ((I.getD i (1, 1)).2 ≤ flo))
  let d : ℕ → ℚ := fun j =>
    if stopped j then f else (dickmanRenewalPrefix 2331 j).getD j 1
  let Q : Polynomial ℚ :=
    ∑ a ∈ Finset.Ico 2331 49152, Polynomial.monomial a ((a : ℚ)⁻¹)
  let mark : Polynomial ℚ :=
    ∑ a ∈ Finset.Ico 2331 3498, Polynomial.monomial a ((a : ℚ)⁻¹)
  let q : ℕ → Polynomial ℚ :=
    fun r => Polynomial.C ((r.factorial : ℚ)⁻¹) * Q ^ r
  let rep : ℕ → Polynomial ℚ :=
    fun m => ∑ a ∈ Finset.range m, (Polynomial.X : Polynomial ℚ) ^ a
  let T : Polynomial ℚ :=
    (∑ r ∈ Finset.range 33, q r * eulerianCarryPolynomial (r + e.val + 1)) +
      ∑ r ∈ Finset.Ico 33 43, q r * rep (r + e.val + 1)
  let D : Polynomial ℝ :=
    ∑ j ∈ Finset.range 98304,
      Polynomial.monomial j
        (h * (d j : ℝ) * Real.exp (-189 * (j : ℝ) * h))
  D * (mark ^ e.val * T).map (Rat.castHom ℝ)

theorem firstOuterLow_renewalIntervals_sound :
    let R : ℕ → ℚ := fun j => (dickmanRenewalPrefix 2331 j).getD j 1
    let I : ℕ → ℚ × ℚ := fun j =>
      (dickmanRenewalDyadicPrefix 160 2331 j).getD j (1, 1)
    let ε : ℚ := 1 / 2 ^ 160
    let f : ℚ := 1 / 10 ^ 40
    let flo := (f.toDyadic 160).toRat
    (∀ j : ℕ, (I j).1 ≤ R j ∧ R j ≤ (I j).2 ∧
      R j - (I j).1 ≤ (j : ℚ) * ε ∧
      (I j).2 - R j ≤ (j : ℚ) * ε) ∧
      0 < flo ∧ (I 81585).2 ≤ flo ∧
      (∀ j : ℕ, j ≤ 81585 →
        (∀ i : ℕ, i < j → flo < (I i).2) → 0 < (I j).1) := by
  intro R I ε f flo
  have hε : 0 < ε := by norm_num [ε]
  have hmesh : (2 : ℚ) ^ (-(160 : ℤ)) = ε := by norm_num [ε]
  have hb : ∀ j : ℕ, (I j).1 ≤ R j ∧ R j ≤ (I j).2 ∧
      R j - (I j).1 ≤ (j : ℚ) * ε ∧
      (I j).2 - R j ≤ (j : ℚ) * ε := by
    have hb0 := renewalDyadicPrefix_encloses (160 : ℤ) 2331 (by norm_num)
    change (∀ j : ℕ, (I j).1 ≤ R j ∧ R j ≤ (I j).2 ∧
      R j - (I j).1 ≤ (j : ℚ) * (2 : ℚ) ^ (-(160 : ℤ)) ∧
      (I j).2 - R j ≤ (j : ℚ) * (2 : ℚ) ^ (-(160 : ℤ))) at hb0
    simpa only [hmesh] using hb0
  have hpos (j : ℕ) : 0 < R j := (renewalPrefix_pos_le_one 2331 j).1
  have hanti : Antitone R := renewalPrefix_antitone 2331 (by norm_num)
  have hfact (k : ℕ) : R (k * 2331) ≤ (k.factorial : ℚ)⁻¹ :=
    renewalPrefix_factorial 2331 (by norm_num) k
  have hfloor : f - ε < flo := by
    have h := (renewal_dyadic_round_error (160 : ℤ) f).2
    rw [hmesh] at h
    dsimp only [flo]
    linarith
  have hscalarCross :
      ((35 : ℕ).factorial : ℚ)⁻¹ + (81586 : ℚ) * ε ≤ f := by
    norm_num [ε, f, Nat.factorial]
  have hscalarPositive : (2937061 : ℚ) * ε < f := by
    norm_num [ε, f]
  have hmargin : (2937060 : ℚ) * ε < flo := by
    linarith
  have close_crossing (u r b eps tail cut : ℚ)
      (hu : u - r ≤ 81585 * eps) (hr : r ≤ b)
      (hb : b + 81586 * eps ≤ tail) (hf : tail - eps < cut) : u ≤ cut := by
    linarith
  refine ⟨hb, ?_, ?_, ?_⟩
  · linarith
  · have hf35 : R 81585 ≤ ((35 : ℕ).factorial : ℚ)⁻¹ := by
      simpa only [show 35 * 2331 = 81585 by norm_num] using hfact 35
    have herr := (hb 81585).2.2.2
    change (I 81585).2 - R 81585 ≤ (81585 : ℚ) * ε at herr
    exact close_crossing (I 81585).2 (R 81585) ((35 : ℕ).factorial : ℚ)⁻¹
      ε f flo herr hf35 hscalarCross hfloor
  · intro j hj hbefore
    by_cases hjinit : j ≤ 2331
    · have hI : I j = (1, 1) := renewalDyadicPrefix_initial 160 2331 j hjinit
      rw [hI]
      norm_num
    · have hjpos : 0 < j := by omega
      have hjq : (0 : ℚ) < (j : ℚ) := by exact_mod_cast hjpos
      have hjqBound : (j : ℚ) ≤ 81585 := by exact_mod_cast hj
      have hprevious := hbefore (j - 1) (by omega)
      have hpreviousError := (hb (j - 1)).2.2.2
      have hpreviousMesh : ((j - 1 : ℕ) : ℚ) * ε ≤ 81585 * ε := by
        apply mul_le_mul_of_nonneg_right _ hε.le
        exact_mod_cast (show j - 1 ≤ 81585 by omega)
      have hpreviousR : flo - 81585 * ε < R (j - 1) := by linarith
      have hcard : (Finset.Ico (j - 2331) j).card = 2331 := by
        rw [Nat.card_Ico]
        omega
      have hwindow : (2331 : ℚ) * R (j - 1) ≤
          ∑ a ∈ Finset.Ico (j - 2331) j, R a := by
        calc
          (2331 : ℚ) * R (j - 1) =
              ∑ _a ∈ Finset.Ico (j - 2331) j, R (j - 1) := by
            simp [hcard, nsmul_eq_mul]
          _ ≤ ∑ a ∈ Finset.Ico (j - 2331) j, R a := by
            apply Finset.sum_le_sum
            intro a ha
            exact hanti (by have := (Finset.mem_Ico.mp ha).2; omega)
      have hrec : R j =
          (∑ a ∈ Finset.Ico (j - 2331) j, R a) / (j : ℚ) := by
        simpa only [R] using renewalPrefix_recurrence_at 2331 j (by norm_num) (by omega)
      have hwindowDiv : ((2331 : ℚ) * R (j - 1)) / (j : ℚ) ≤ R j := by
        rw [hrec]
        exact div_le_div_of_nonneg_right hwindow hjq.le
      have hwindowMul := (div_le_iff₀ hjq).mp hwindowDiv
      have hscale := mul_le_mul_of_nonneg_left hjqBound (hpos j).le
      have h35 : R (j - 1) ≤ 35 * R j := by nlinarith only [hwindowMul, hscale]
      have hjMesh : (j : ℚ) * ε ≤ 81585 * ε :=
        mul_le_mul_of_nonneg_right hjqBound hε.le
      have hjError := (hb j).2.2.1
      linarith only [hmargin, hpreviousR, h35, hjMesh, hjError]

theorem firstOuterLowCountMeasure_cell_eq_zero
    (e : Fin 2) (j : ℕ) (hj : j < 98304)
    (r : ℕ) (hr : 43 ≤ r) :
    firstOuterLowCountMeasure e r
      (Set.Ico ((j : ℝ) * (2742997 / 258046918656))
        (((j : ℝ) + 1) * (2742997 / 258046918656))) = 0 := by
  classical
  let h : ℝ := 2742997 / 258046918656
  have hh : 0 < h := by norm_num [h]
  let μ : Fin (r + e.val + 1) → Measure ℝ := fun i =>
    if i.val = 0 then
      (volume.restrict (Set.Ici (0 : ℝ))).withDensity
        (fun t => ENNReal.ofReal
          (dickmanRho (t / (2331 * h)) * Real.exp (-189 * t)))
    else
      let cap : ℝ := if i.val ≤ e.val then 3498 else 49152
      (volume.restrict (Set.Ioc (2331 * h) (cap * h))).withDensity
        (fun t => ENNReal.ofReal (1 / t))
  let (i : Fin (r + e.val + 1)) : SigmaFinite (μ i) := by
    dsimp only [μ]
    split_ifs <;> infer_instance
  have hcoord (i : Fin (r + e.val + 1)) :
      ∀ᵐ t ∂μ i, (if i.val = 0 then (0 : ℝ) else 2331 * h) ≤ t := by
    by_cases hi : i.val = 0
    · simp only [μ, hi, ite_true]
      exact (withDensity_absolutelyContinuous
        (volume.restrict (Set.Ici (0 : ℝ))) _).ae_le
          (ae_restrict_mem measurableSet_Ici)
    · simp only [μ, hi, ite_false]
      filter_upwards [(withDensity_absolutelyContinuous
        (volume.restrict
          (Set.Ioc (2331 * h) ((if i.val ≤ e.val then 3498 else 49152) * h)))
        (fun t : ℝ => ENNReal.ofReal (1 / t))).ae_le
          (ae_restrict_mem measurableSet_Ioc)] with t ht
      exact ht.1.le
  have hsupp : ∀ᵐ x : Fin (r + e.val + 1) → ℝ ∂Measure.pi μ,
      ∀ i, (if i.val = 0 then (0 : ℝ) else 2331 * h) ≤ x i :=
    Filter.eventually_all.2 fun i =>
      (Measure.tendsto_eval_ae_ae (μ := μ) (i := i)).eventually (hcoord i)
  have hzero : (Measure.pi μ)
      ((fun x : Fin (r + e.val + 1) → ℝ => ∑ i, x i) ⁻¹'
        Set.Ico ((j : ℝ) * h) (((j : ℝ) + 1) * h)) = 0 := by
    apply measure_eq_zero_iff_ae_notMem.mpr
    filter_upwards [hsupp] with x hx
    intro hxC
    have hx0 : 0 ≤ x 0 := by simpa using hx 0
    have hxs (i : Fin (r + e.val)) : 2331 * h ≤ x i.succ := by
      simpa using hx i.succ
    have hsum : ((r + e.val : ℕ) : ℝ) * (2331 * h) ≤ ∑ i, x i := by
      rw [Fin.sum_univ_succ]
      have hrest : ((r + e.val : ℕ) : ℝ) * (2331 * h) ≤
          ∑ i : Fin (r + e.val), x i.succ := by
        simpa using Finset.sum_le_sum (fun i (_ : i ∈ Finset.univ) => hxs i)
      exact hrest.trans (le_add_of_nonneg_left hx0)
    have hcount : (43 : ℝ) ≤ ((r + e.val : ℕ) : ℝ) := by
      exact_mod_cast (show 43 ≤ r + e.val by omega)
    have hcut : (98304 : ℝ) * h < 43 * (2331 * h) := by nlinarith
    have hfar : (98304 : ℝ) * h < ∑ i, x i :=
      hcut.trans_le ((mul_le_mul_of_nonneg_right hcount
        (by positivity : 0 ≤ 2331 * h)).trans hsum)
    have hjreal : (j : ℝ) + 1 ≤ 98304 := by
      exact_mod_cast (show j + 1 ≤ 98304 by omega)
    have hxupper : (∑ i, x i) < (98304 : ℝ) * h :=
      hxC.2.trans_le (mul_le_mul_of_nonneg_right hjreal hh.le)
    exact (not_lt_of_ge hfar.le) hxupper
  have hmeas : Measurable (fun x : Fin (r + e.val + 1) → ℝ => ∑ i, x i) := by
    fun_prop
  change (ENNReal.ofReal ((r.factorial : ℝ)⁻¹) •
    Measure.map (fun x : Fin (r + e.val + 1) → ℝ => ∑ i, x i)
      (Measure.pi μ)) (Set.Ico ((j : ℝ) * h) (((j : ℝ) + 1) * h)) = 0
  rw [Measure.smul_apply, smul_eq_mul,
    Measure.map_apply hmeas measurableSet_Ico, hzero, mul_zero]

theorem firstOuterLowCountMeasure_sum_cell
    (e : Fin 2) (j : ℕ) (hj : j < 98304) :
    (Measure.sum (firstOuterLowCountMeasure e))
      (Set.Ico ((j : ℝ) * (2742997 / 258046918656))
        (((j : ℝ) + 1) * (2742997 / 258046918656))) =
      ∑ r ∈ Finset.range 43, firstOuterLowCountMeasure e r
        (Set.Ico ((j : ℝ) * (2742997 / 258046918656))
          (((j : ℝ) + 1) * (2742997 / 258046918656))) := by
  rw [Measure.sum_apply _ measurableSet_Ico]
  apply tsum_eq_sum
  intro r hr
  exact firstOuterLowCountMeasure_cell_eq_zero e j hj r (by simpa using hr)

theorem firstOuterLow_lowDensity_finite (h : ℝ) :
    IsFiniteMeasure ((volume.restrict (Set.Ici (0 : ℝ))).withDensity
      (fun t => ENNReal.ofReal
        (dickmanRho (t / (2331 * h)) * Real.exp (-189 * t)))) := by
  rcases dickmanRho_analytic with ⟨_, _, _, hm, _, hρ, _, _⟩
  have hg : Integrable (fun t : ℝ => Real.exp (-189 * t))
      (volume.restrict (Set.Ici 0)) :=
    (integrableOn_Ici_iff_integrableOn_Ioi (by finiteness)).mpr
      (integrableOn_exp_mul_Ioi (by norm_num : (-189 : ℝ) < 0) 0)
  have hf : Measurable (fun t : ℝ =>
      dickmanRho (t / (2331 * h)) * Real.exp (-189 * t)) :=
    (hm.comp (measurable_id.div_const _)).mul
      (Real.continuous_exp.measurable.comp (measurable_const.mul measurable_id))
  apply isFiniteMeasure_withDensity_ofReal
  apply Integrable.hasFiniteIntegral
  refine hg.mono_nonneg hf.aestronglyMeasurable ?_ ?_
  · exact ae_of_all _ fun t => mul_nonneg (hρ _).1 (Real.exp_pos _).le
  · exact ae_of_all _ fun t => by
      simpa using mul_le_mul_of_nonneg_right (hρ (t / (2331 * h))).2
        (Real.exp_pos (-189 * t)).le

theorem firstOuterLow_highDensity_finite
    (a b : ℝ) (ha : 0 < a) :
    IsFiniteMeasure ((volume.restrict (Set.Ioc a b)).withDensity
      (fun t : ℝ => ENNReal.ofReal (1 / t))) := by
  have hc : ContinuousOn (fun t : ℝ => 1 / t) (Set.Icc a b) :=
    continuousOn_const.div continuousOn_id
      (fun t ht => ne_of_gt (ha.trans_le ht.1))
  exact isFiniteMeasure_withDensity_ofReal
    (hc.integrableOn_Icc.mono_set Set.Ioc_subset_Icc_self).hasFiniteIntegral

theorem pi_mono_coordinatewise
    {ι : Type*} [Fintype ι] {α : ι → Type*}
    [∀ i, MeasurableSpace (α i)]
    (μ ν : ∀ i, Measure (α i))
    (h : ∀ i, μ i ≤ ν i) :
    Measure.pi μ ≤ Measure.pi ν := by
  have ho : OuterMeasure.pi (fun i => (μ i).toOuterMeasure) ≤
      OuterMeasure.pi (fun i => (ν i).toOuterMeasure) := by
    refine OuterMeasure.le_pi.2 ?_
    intro s _
    exact (OuterMeasure.pi_pi_le _ s).trans
      (Finset.prod_le_prod' fun i _ => h i (s i))
  rw [← Measure.toOuterMeasure_le]
  simpa only [Measure.pi, MeasureTheory.toMeasure_toOuterMeasure]
    using OuterMeasure.trim_mono ho

theorem pi_restrict_low_output_eq
    {ι : Type*} [Fintype ι]
    (μ : ι → Measure ℝ) [∀ i, SigmaFinite (μ i)]
    (hμ : ∀ i, ∀ᵐ t ∂μ i, 0 ≤ t)
    (E : Set (ι → ℝ)) (B : ℝ)
    (hE : ∀ x ∈ E, (∑ i, x i) < B) :
    (Measure.pi μ).restrict E =
      (Measure.pi (fun i => (μ i).restrict (Set.Iio B))).restrict E := by
  have hn : ∀ᵐ x : ι → ℝ ∂Measure.pi μ, ∀ i, 0 ≤ x i :=
    Filter.eventually_all.2 fun i =>
      (Measure.tendsto_eval_ae_ae (μ := μ) (i := i)).eventually (hμ i)
  rw [← Measure.restrict_pi_pi μ (fun _ => Set.Iio B),
    Measure.restrict_restrict'
      (MeasurableSet.univ_pi fun _ => measurableSet_Iio)]
  apply Measure.restrict_congr_set
  filter_upwards [hn] with x hx
  apply propext
  constructor
  · intro hxE
    refine ⟨hxE, ?_⟩
    intro i _
    exact lt_of_le_of_lt
      (Finset.single_le_sum (fun k _ => hx k) (Finset.mem_univ i))
      (hE x hxE)
  · exact fun hxE => hxE.1

theorem firstOuterLow_lowDensity_cell_le
    (h : ℝ) (hh : 0 < h) (d : ℕ → ℝ)
    (hd : ∀ a : ℕ, a < 98304 → dickmanRho ((a : ℝ) / 2331) ≤ d a)
    (a : ℕ) (ha : a < 98304) (t : ℝ)
    (ht : t ∈ Set.Ico ((a : ℝ) * h) (((a : ℝ) + 1) * h)) :
    dickmanRho (t / (2331 * h)) * Real.exp (-189 * t) ≤
      d a * Real.exp (-189 * (a : ℝ) * h) := by
  rcases dickmanRho_analytic with ⟨_, _, _, _, _, hρ, hanti, _⟩
  have hL : (0 : ℝ) < 2331 * h := by positivity
  have ha0 : (0 : ℝ) ≤ (a : ℝ) / 2331 := by positivity
  have ht0 : 0 ≤ t := (mul_nonneg (Nat.cast_nonneg a) hh.le).trans ht.1
  have hdiv : (a : ℝ) / 2331 ≤ t / (2331 * h) := by
    apply (le_div_iff₀ hL).mpr
    calc
      (a : ℝ) / 2331 * (2331 * h) = (a : ℝ) * h := by ring
      _ ≤ t := ht.1
  have hρt : dickmanRho (t / (2331 * h)) ≤ d a :=
    (hanti ha0 (div_nonneg ht0 hL.le) hdiv).trans (hd a ha)
  have hda : 0 ≤ d a := (hρ _).1.trans (hd a ha)
  have he : Real.exp (-189 * t) ≤ Real.exp (-189 * (a : ℝ) * h) :=
    Real.exp_le_exp.mpr (by nlinarith [ht.1])
  exact mul_le_mul hρt he (Real.exp_pos _).le hda

theorem firstOuterLow_highDensity_cell_le
    (h : ℝ) (hh : 0 < h) (a : ℕ) (ha : 2331 ≤ a) (t : ℝ)
    (ht : t ∈ Set.Ico ((a : ℝ) * h) (((a : ℝ) + 1) * h)) :
    1 / t ≤ ((a : ℝ)⁻¹) / h := by
  have ha0 : (0 : ℝ) < a := by exact_mod_cast (show 0 < a by omega)
  calc
    1 / t ≤ 1 / ((a : ℝ) * h) :=
      one_div_le_one_div_of_le (mul_pos ha0 hh) ht.1
    _ = ((a : ℝ)⁻¹) / h := by
      simp [mul_inv_rev, div_eq_mul_inv, mul_comm]

theorem physical_withDensity_Ioc_eq_Ico
    (a b : ℝ) (f : ℝ → ℝ≥0∞) :
    ((volume : Measure ℝ).restrict (Set.Ioc a b)).withDensity f =
      (volume.restrict (Set.Ico a b)).withDensity f := by
  congr 1
  exact (Measure.restrict_congr_set
    (μ := (volume : Measure ℝ)) (Ico_ae_eq_Ioc (a := a) (b := b))).symm

theorem withDensity_physical_cells_le
    (h : ℝ) (hh : 0 < h) (A B : ℕ) (hAB : A ≤ B)
    (f : ℝ → ℝ≥0∞) (c : ℕ → ℝ≥0∞)
    (hfc : ∀ a ∈ Finset.Ico A B,
      ∀ᵐ t ∂(volume : Measure ℝ).restrict
        (Set.Ico ((a : ℝ) * h) (((a : ℝ) + 1) * h)), f t ≤ c a) :
    ((volume : Measure ℝ).restrict
      (Set.Ico ((A : ℝ) * h) ((B : ℝ) * h))).withDensity f ≤
      ∑ a ∈ Finset.Ico A B,
        c a • volume.restrict
          (Set.Ico ((a : ℝ) * h) (((a : ℝ) + 1) * h)) := by
  revert hfc
  induction B, hAB using Nat.le_induction with
  | base => intro _; simp
  | succ B hAB ih =>
    intro hfc
    have hab : (A : ℝ) * h ≤ (B : ℝ) * h :=
      mul_le_mul_of_nonneg_right (by exact_mod_cast hAB) hh.le
    have hbc : (B : ℝ) * h ≤ ((B : ℝ) + 1) * h := by nlinarith
    have hsplit :
        Set.Ico ((A : ℝ) * h) (((B : ℝ) + 1) * h) =
          Set.Ico ((A : ℝ) * h) ((B : ℝ) * h) ∪
            Set.Ico ((B : ℝ) * h) (((B : ℝ) + 1) * h) :=
      (Set.Ico_union_Ico_eq_Ico hab hbc).symm
    rw [Nat.cast_add, Nat.cast_one, hsplit,
      Measure.restrict_union Set.Ico_disjoint_Ico_same measurableSet_Ico,
      withDensity_add_measure, Finset.sum_Ico_succ_top hAB]
    refine add_le_add (ih ?_) ?_
    · intro a ha
      exact hfc a (Finset.mem_Ico.mpr
        ⟨(Finset.mem_Ico.mp ha).1,
          (Finset.mem_Ico.mp ha).2.trans (Nat.lt_succ_self B)⟩)
    · calc
        (volume.restrict
          (Set.Ico ((B : ℝ) * h) (((B : ℝ) + 1) * h))).withDensity f ≤
            (volume.restrict
              (Set.Ico ((B : ℝ) * h) (((B : ℝ) + 1) * h))).withDensity
                (fun _ => c B) :=
          withDensity_mono
            (hfc B (Finset.mem_Ico.mpr ⟨hAB, Nat.lt_succ_self B⟩))
        _ = c B • volume.restrict
            (Set.Ico ((B : ℝ) * h) (((B : ℝ) + 1) * h)) :=
          withDensity_const (c B)

theorem withDensity_physical_range_le
    (h : ℝ) (hh : 0 < h) (N : ℕ)
    (f : ℝ → ℝ≥0∞) (c : ℕ → ℝ≥0∞)
    (hfc : ∀ a ∈ Finset.Ico 0 N,
      ∀ᵐ t ∂(volume : Measure ℝ).restrict
        (Set.Ico ((a : ℝ) * h) (((a : ℝ) + 1) * h)), f t ≤ c a) :
    ((volume : Measure ℝ).restrict
      (Set.Ico 0 ((N : ℝ) * h))).withDensity f ≤
      ∑ a ∈ Finset.range N,
        c a • volume.restrict
          (Set.Ico ((a : ℝ) * h) (((a : ℝ) + 1) * h)) := by
  simpa only [Nat.cast_zero, zero_mul, Nat.Ico_zero_eq_range] using
    withDensity_physical_cells_le h hh 0 N (Nat.zero_le N) f c hfc

theorem withDensity_Ici_zero_restrict_Iio
    (μ : Measure ℝ) (b : ℝ) (f : ℝ → ℝ≥0∞) :
    ((μ.restrict (Set.Ici 0)).withDensity f).restrict (Set.Iio b) =
      (μ.restrict (Set.Ico 0 b)).withDensity f := by
  rw [restrict_withDensity measurableSet_Iio,
    Measure.restrict_restrict measurableSet_Iio, Set.inter_comm, Set.Ici_inter_Iio]

theorem withDensity_Ici_zero_physical_range_le
    (h : ℝ) (hh : 0 < h) (N : ℕ) (B : ℝ)
    (hNB : (N : ℝ) = B)
    (f : ℝ → ℝ≥0∞) (c : ℕ → ℝ≥0∞)
    (hfc : ∀ a ∈ Finset.Ico 0 N,
      ∀ᵐ t ∂(volume : Measure ℝ).restrict
        (Set.Ico ((a : ℝ) * h) (((a : ℝ) + 1) * h)), f t ≤ c a) :
    (((volume : Measure ℝ).restrict (Set.Ici 0)).withDensity f).restrict
        (Set.Iio (B * h)) ≤
      ∑ a ∈ Finset.range N,
        c a • volume.restrict
          (Set.Ico ((a : ℝ) * h) (((a : ℝ) + 1) * h)) := by
  rw [← hNB, withDensity_Ici_zero_restrict_Iio]
  exact withDensity_physical_range_le h hh N f c hfc

theorem firstOuterLow_lowMeasure_prefix_le_cells
    (h : ℝ) (hh : 0 < h) (d : ℕ → ℝ)
    (hd : ∀ a : ℕ, a < 98304 → dickmanRho ((a : ℝ) / 2331) ≤ d a)
    (N : ℕ) (hN : N ≤ 98304) (B : ℝ) (hNB : (N : ℝ) = B) :
    (((volume : Measure ℝ).restrict (Set.Ici 0)).withDensity
      (fun t => ENNReal.ofReal
        (dickmanRho (t / (2331 * h)) * Real.exp (-189 * t)))).restrict
          (Set.Iio (B * h)) ≤
      ∑ a ∈ Finset.range N,
        ENNReal.ofReal ((h * d a * Real.exp (-189 * (a : ℝ) * h)) / h) •
          volume.restrict
            (Set.Ico ((a : ℝ) * h) (((a : ℝ) + 1) * h)) := by
  refine withDensity_Ici_zero_physical_range_le h hh N B hNB _ _ ?_
  intro a ha
  filter_upwards [ae_restrict_mem measurableSet_Ico] with t ht
  apply ENNReal.ofReal_le_ofReal
  simpa only [mul_assoc, mul_div_cancel_left₀ _ hh.ne'] using
    firstOuterLow_lowDensity_cell_le h hh d hd a
      ((Finset.mem_Ico.mp ha).2.trans_le hN) t ht

theorem firstOuterLow_highMeasure_le_cells
    (h : ℝ) (hh : 0 < h) (B : ℕ) (hB : 2331 ≤ B) :
    ((volume : Measure ℝ).restrict
      (Set.Ioc (2331 * h) ((B : ℝ) * h))).withDensity
        (fun t : ℝ => ENNReal.ofReal (1 / t)) ≤
      ∑ a ∈ Finset.Ico 2331 B,
        ENNReal.ofReal (((a : ℝ)⁻¹) / h) • volume.restrict
          (Set.Ico ((a : ℝ) * h) (((a : ℝ) + 1) * h)) := by
  rw [physical_withDensity_Ioc_eq_Ico]
  apply withDensity_physical_cells_le h hh 2331 B hB
  intro a ha
  filter_upwards [ae_restrict_mem measurableSet_Ico] with t ht
  exact ENNReal.ofReal_le_ofReal
    (firstOuterLow_highDensity_cell_le h hh a (Finset.mem_Ico.mp ha).1 t ht)

theorem firstOuterLow_coordinate_polynomial_product
    (r : ℕ) (e : Fin 2) (D mark Q : Polynomial ℝ) :
    (∏ i : Fin (r + e.val + 1),
      if i.val = 0 then D else if i.val ≤ e.val then mark else Q) =
      D * mark ^ e.val * Q ^ r := by
  fin_cases e <;>
    simp [Fin.prod_univ_succ, Fin.val_succ, mul_assoc]

theorem physical_cell_mixture_factorial_scaled
    (r m j : ℕ) (hm : 0 < m) (h : ℝ) (hh : 0 < h)
    (s : Fin m → Finset ℕ) (w : Fin m → ℕ → ℝ)
    (hw : ∀ i, ∀ a ∈ s i, 0 ≤ w i a) :
    let P : Fin m → Polynomial ℝ :=
      fun i => ∑ a ∈ s i, Polynomial.monomial a (w i a)
    (ENNReal.ofReal ((r.factorial : ℝ)⁻¹) •
      Measure.map (fun x : Fin m → ℝ => ∑ i, x i)
        (Measure.pi fun i : Fin m =>
          ∑ a ∈ s i, ENNReal.ofReal (w i a / h) •
            (volume : Measure ℝ).restrict
              (Set.Ico ((a : ℝ) * h) (((a : ℝ) + 1) * h))))
      (Set.Ico ((j : ℝ) * h) (((j : ℝ) + 1) * h)) =
      ENNReal.ofReal
        ((Polynomial.C ((r.factorial : ℝ)⁻¹) *
          ((∏ i, P i) *
            (eulerianCarryPolynomial m).map (Rat.castHom ℝ))).coeff j) := by
  intro P
  rw [Measure.smul_apply, smul_eq_mul,
    physical_cell_mixture_sum_mass_eq_eulerian m j hm h hh s w hw,
    Polynomial.coeff_C_mul,
    ENNReal.ofReal_mul (by positivity : 0 ≤ (r.factorial : ℝ)⁻¹)]

theorem firstOuterLowCountMeasure_prefix_cell_le_majorant
    (N : ℕ) (hN : N ≤ 98304)
    (e : Fin 2) (r j : ℕ) (hj : j < N)
    (d : ℕ → ℝ)
    (hd : ∀ a : ℕ, a < 98304 → dickmanRho ((a : ℝ) / 2331) ≤ d a) :
    let h : ℝ := 2742997 / 258046918656
    let D : Polynomial ℝ := ∑ a ∈ Finset.range N,
      Polynomial.monomial a (h * d a * Real.exp (-189 * (a : ℝ) * h))
    let mark : Polynomial ℝ := ∑ a ∈ Finset.Ico 2331 3498,
      Polynomial.monomial a ((a : ℝ)⁻¹)
    let Q : Polynomial ℝ := ∑ a ∈ Finset.Ico 2331 49152,
      Polynomial.monomial a ((a : ℝ)⁻¹)
    firstOuterLowCountMeasure e r
      (Set.Ico ((j : ℝ) * h) (((j : ℝ) + 1) * h)) ≤
      ENNReal.ofReal
        ((Polynomial.C ((r.factorial : ℝ)⁻¹) *
          (D * mark ^ e.val * Q ^ r *
            (eulerianCarryPolynomial (r + e.val + 1)).map
              (Rat.castHom ℝ))).coeff j) := by
  classical
  intro h D mark Q
  have hh : 0 < h := by norm_num [h]
  let μ : Fin (r + e.val + 1) → Measure ℝ := fun i =>
    if i.val = 0 then
      (volume.restrict (Set.Ici (0 : ℝ))).withDensity
        (fun t => ENNReal.ofReal
          (dickmanRho (t / (2331 * h)) * Real.exp (-189 * t)))
    else
      let cap : ℝ := if i.val ≤ e.val then 3498 else 49152
      (volume.restrict (Set.Ioc (2331 * h) (cap * h))).withDensity
        (fun t => ENNReal.ofReal (1 / t))
  let s : Fin (r + e.val + 1) → Finset ℕ := fun i =>
    if i.val = 0 then Finset.range N
    else if i.val ≤ e.val then Finset.Ico 2331 3498
    else Finset.Ico 2331 49152
  let w : Fin (r + e.val + 1) → ℕ → ℝ := fun i a =>
    if i.val = 0 then h * d a * Real.exp (-189 * (a : ℝ) * h)
    else (a : ℝ)⁻¹
  let ν : Fin (r + e.val + 1) → Measure ℝ := fun i =>
    ∑ a ∈ s i, ENNReal.ofReal (w i a / h) •
      volume.restrict (Set.Ico ((a : ℝ) * h) (((a : ℝ) + 1) * h))
  let E : Set (Fin (r + e.val + 1) → ℝ) :=
    (fun x => ∑ i, x i) ⁻¹'
      Set.Ico ((j : ℝ) * h) (((j : ℝ) + 1) * h)
  let (i : Fin (r + e.val + 1)) : IsFiniteMeasure (μ i) := by
    by_cases hi : i.val = 0
    · simpa only [μ, hi, ite_true] using firstOuterLow_lowDensity_finite h
    · simp only [μ, hi, ite_false]
      exact firstOuterLow_highDensity_finite (2331 * h) _ (by positivity)
  have hμ (i : Fin (r + e.val + 1)) : ∀ᵐ t ∂μ i, 0 ≤ t := by
    by_cases hi : i.val = 0
    · simp only [μ, hi, ite_true]
      exact (withDensity_absolutelyContinuous
        (volume.restrict (Set.Ici (0 : ℝ))) _).ae_le
          (ae_restrict_mem measurableSet_Ici)
    · simp only [μ, hi, ite_false]
      filter_upwards [(withDensity_absolutelyContinuous
        (volume.restrict
          (Set.Ioc (2331 * h) ((if i.val ≤ e.val then 3498 else 49152) * h)))
        (fun t : ℝ => ENNReal.ofReal (1 / t))).ae_le
          (ae_restrict_mem measurableSet_Ioc)] with t ht
      exact (by positivity : (0 : ℝ) ≤ 2331 * h).trans ht.1.le
  have hw : ∀ i, ∀ a ∈ s i, 0 ≤ w i a := by
    intro i a ha
    by_cases hi : i.val = 0
    · have haN : a < N := by simpa only [s, hi, ite_true, Finset.mem_range] using ha
      have hd0 : 0 ≤ d a :=
        (dickmanRho_analytic.2.2.2.2.2.1 _).1.trans (hd a (haN.trans_le hN))
      simp only [w, hi, ite_true]
      exact mul_nonneg (mul_nonneg hh.le hd0) (Real.exp_pos _).le
    · simp only [w, hi, ite_false]
      positivity
  have hdom (i : Fin (r + e.val + 1)) :
      (μ i).restrict (Set.Iio ((N : ℝ) * h)) ≤ ν i := by
    change (μ i).restrict (Set.Iio ((N : ℝ) * h)) ≤
      ∑ a ∈ s i, ENNReal.ofReal (w i a / h) •
        (volume : Measure ℝ).restrict
          (Set.Ico ((a : ℝ) * h) (((a : ℝ) + 1) * h))
    by_cases hi : i.val = 0
    · simpa only [μ, s, w, hi, ite_true] using
        firstOuterLow_lowMeasure_prefix_le_cells h hh d hd N hN (N : ℝ) rfl
    · by_cases hm : i.val ≤ e.val
      · simpa only [μ, s, w, hi, hm, ite_false, ite_true, Nat.cast_ofNat] using
          (Measure.restrict_le_self (s := Set.Iio ((N : ℝ) * h))).trans
            (firstOuterLow_highMeasure_le_cells h hh 3498 (by omega))
      · simpa only [μ, s, w, hi, hm, ite_false, Nat.cast_ofNat] using
          (Measure.restrict_le_self (s := Set.Iio ((N : ℝ) * h))).trans
            (firstOuterLow_highMeasure_le_cells h hh 49152 (by omega))
  have hE : ∀ x ∈ E, (∑ i, x i) < (N : ℝ) * h := by
    intro x hx
    have hjreal : (j : ℝ) + 1 ≤ (N : ℝ) := by
      exact_mod_cast (show j + 1 ≤ N by omega)
    exact hx.2.trans_le (mul_le_mul_of_nonneg_right hjreal hh.le)
  have hlocal := pi_restrict_low_output_eq μ hμ E ((N : ℝ) * h) hE
  have hlocalmass : (Measure.pi μ) E =
      (Measure.pi (fun i => (μ i).restrict (Set.Iio ((N : ℝ) * h)))) E := by
    have hval := congrArg (fun η : Measure (Fin (r + e.val + 1) → ℝ) =>
      η Set.univ) hlocal
    simpa only [Measure.restrict_apply_univ] using hval
  have hmass : (Measure.pi μ) E ≤ (Measure.pi ν) E :=
    hlocalmass.le.trans
      ((pi_mono_coordinatewise
        (fun i => (μ i).restrict (Set.Iio ((N : ℝ) * h))) ν hdom) E)
  have hP (i : Fin (r + e.val + 1)) :
      (∑ a ∈ s i, Polynomial.monomial a (w i a)) =
        if i.val = 0 then D else if i.val ≤ e.val then mark else Q := by
    by_cases hi : i.val = 0 <;> by_cases hm : i.val ≤ e.val <;>
      simp only [s, w, D, mark, Q, hi, hm, ite_false, ite_true]
  have hprod :
      (∏ i : Fin (r + e.val + 1),
        ∑ a ∈ s i, Polynomial.monomial a (w i a)) =
      D * mark ^ e.val * Q ^ r := by
    calc
      _ = ∏ i : Fin (r + e.val + 1),
          if i.val = 0 then D else if i.val ≤ e.val then mark else Q :=
        Finset.prod_congr rfl (fun i _ => hP i)
      _ = _ := firstOuterLow_coordinate_polynomial_product r e D mark Q
  have hsum : Measurable (fun x : Fin (r + e.val + 1) → ℝ => ∑ i, x i) := by
    fun_prop
  change (ENNReal.ofReal ((r.factorial : ℝ)⁻¹) •
    Measure.map (fun x : Fin (r + e.val + 1) → ℝ => ∑ i, x i)
      (Measure.pi μ)) (Set.Ico ((j : ℝ) * h) (((j : ℝ) + 1) * h)) ≤ _
  calc
    _ ≤ (ENNReal.ofReal ((r.factorial : ℝ)⁻¹) •
        Measure.map (fun x : Fin (r + e.val + 1) → ℝ => ∑ i, x i)
          (Measure.pi ν))
        (Set.Ico ((j : ℝ) * h) (((j : ℝ) + 1) * h)) := by
      rw [Measure.smul_apply, Measure.smul_apply, smul_eq_mul, smul_eq_mul,
        Measure.map_apply hsum measurableSet_Ico,
        Measure.map_apply hsum measurableSet_Ico]
      exact mul_le_mul_of_nonneg_left hmass bot_le
    _ = ENNReal.ofReal
        ((Polynomial.C ((r.factorial : ℝ)⁻¹) *
          ((∏ i : Fin (r + e.val + 1),
            ∑ a ∈ s i, Polynomial.monomial a (w i a)) *
              (eulerianCarryPolynomial (r + e.val + 1)).map
                (Rat.castHom ℝ))).coeff j) :=
      physical_cell_mixture_factorial_scaled r (r + e.val + 1) j
        (by omega) h hh s w hw
    _ = _ := by rw [hprod]

theorem firstOuterLowCountMeasure_cell_le_majorant
    (e : Fin 2) (r j : ℕ) (hj : j < 98304)
    (d : ℕ → ℝ)
    (hd : ∀ a : ℕ, a < 98304 → dickmanRho ((a : ℝ) / 2331) ≤ d a) :
    let h : ℝ := 2742997 / 258046918656
    let D : Polynomial ℝ := ∑ a ∈ Finset.range 98304,
      Polynomial.monomial a (h * d a * Real.exp (-189 * (a : ℝ) * h))
    let mark : Polynomial ℝ := ∑ a ∈ Finset.Ico 2331 3498,
      Polynomial.monomial a ((a : ℝ)⁻¹)
    let Q : Polynomial ℝ := ∑ a ∈ Finset.Ico 2331 49152,
      Polynomial.monomial a ((a : ℝ)⁻¹)
    firstOuterLowCountMeasure e r
      (Set.Ico ((j : ℝ) * h) (((j : ℝ) + 1) * h)) ≤
      ENNReal.ofReal
        ((Polynomial.C ((r.factorial : ℝ)⁻¹) *
          (D * mark ^ e.val * Q ^ r *
            (eulerianCarryPolynomial (r + e.val + 1)).map
              (Rat.castHom ℝ))).coeff j) :=
  firstOuterLowCountMeasure_prefix_cell_le_majorant 98304 (Nat.le_refl _)
    e r j hj d hd

theorem firstOuterLow_factorial_power_map
    (r : ℕ) (Q : Polynomial ℚ) :
    (Polynomial.C ((r.factorial : ℚ)⁻¹) * Q ^ r).map (Rat.castHom ℝ) =
      Polynomial.C ((r.factorial : ℝ)⁻¹) *
        (Q.map (Rat.castHom ℝ)) ^ r := by
  simp

theorem firstOuterLow_reciprocal_polynomial_map (A B : ℕ) :
    (∑ a ∈ Finset.Ico A B, Polynomial.monomial a ((a : ℝ)⁻¹)) =
      (∑ a ∈ Finset.Ico A B, Polynomial.monomial a ((a : ℚ)⁻¹)).map
        (Rat.castHom ℝ) := by
  simp [Polynomial.map_sum]

theorem firstOuterLow_stopping_selection :
    let I := dickmanRenewalDyadicPrefix 160 2331 98303
    let f : ℚ := 1 / 10 ^ 40
    let flo := (f.toDyadic 160).toRat
    let stopped : ℕ → Bool := fun j =>
      (List.range (j + 1)).any
        (fun i => decide ((I.getD i (1, 1)).2 ≤ flo))
    let d : ℕ → ℚ := fun j =>
      if stopped j then f else (dickmanRenewalPrefix 2331 j).getD j 1
    (∀ j : ℕ, j < 98304 →
      I.getD j (1, 1) = (dickmanRenewalDyadicPrefix 160 2331 j).getD j (1, 1)) ∧
      (∀ j : ℕ, j < 98304 →
        (stopped j = true ↔ ∃ i ≤ j,
          ((dickmanRenewalDyadicPrefix 160 2331 i).getD i (1, 1)).2 ≤ flo)) ∧
      (∀ i j : ℕ, i ≤ j → stopped i = true → stopped j = true) ∧
      (∀ j : ℕ, 81585 ≤ j → stopped j = true) ∧
      (∀ j : ℕ, j < 98304 →
        0 < d j ∧ (dickmanRenewalPrefix 2331 j).getD j 1 ≤ d j ∧
          dickmanRho ((j : ℝ) / 2331) ≤ (d j : ℝ)) ∧
      (∀ j : ℕ, j < 98304 → ∀ t : ℝ, (j : ℝ) / 2331 ≤ t →
        dickmanRho t ≤ (d j : ℝ)) ∧
      (∀ j : ℕ, j < 98304 →
        let selected : ℚ × ℚ := if stopped j then (f, f) else I.getD j (1, 1)
        0 < selected.1 ∧ selected.1 ≤ d j ∧ d j ≤ selected.2) := by
  intro I f flo stopped d
  let R : ℕ → ℚ := fun j => (dickmanRenewalPrefix 2331 j).getD j 1
  let B : ℕ → ℚ × ℚ := fun j =>
    (dickmanRenewalDyadicPrefix 160 2331 j).getD j (1, 1)
  have hf : 0 < f := by norm_num [f]
  have hfloor : flo ≤ f := Rat.toRat_toDyadic_le
  obtain ⟨hrange, hanti, _⟩ := dickmanRenewalPrefix_encloses 2331 (by norm_num)
  obtain ⟨hbound, _, hcross, hfirst⟩ := firstOuterLow_renewalIntervals_sound
  have hfixed (j : ℕ) (hj : j < 98304) : I.getD j (1, 1) = B j :=
    renewalDyadicPrefix_get_prefix 160 2331 j 98303 (by omega)
  have hstopFixed (j : ℕ) :
      stopped j = true ↔ ∃ i ≤ j, (I.getD i (1, 1)).2 ≤ flo := by
    simp only [stopped, List.any_eq_true, List.mem_range,
      decide_eq_true_eq, Nat.lt_succ_iff]
  have hstopOwn (j : ℕ) (hj : j < 98304) :
      stopped j = true ↔ ∃ i ≤ j, (B i).2 ≤ flo := by
    rw [hstopFixed]
    exact exists_congr fun i => and_congr_right fun hij => by
      rw [hfixed i (lt_of_le_of_lt hij hj)]
  have hpersistent (i j : ℕ) (hij : i ≤ j) (hi : stopped i = true) :
      stopped j = true := by
    obtain ⟨a, hai, ha⟩ := (hstopFixed i).mp hi
    exact (hstopFixed j).mpr ⟨a, hai.trans hij, ha⟩
  have hafter (j : ℕ) (hj : 81585 ≤ j) : stopped j = true := by
    apply (hstopFixed j).mpr
    refine ⟨81585, hj, ?_⟩
    rw [hfixed 81585 (by norm_num)]
    exact hcross
  have hRmajor (j : ℕ) (hj : j < 98304) : R j ≤ d j := by
    by_cases hs : stopped j = true
    · have hd : d j = f := by simp [d, hs]
      rw [hd]
      obtain ⟨i, hij, hu⟩ := (hstopOwn j hj).mp hs
      calc
        R j ≤ R i := hanti hij
        _ ≤ (B i).2 := (hbound i).2.1
        _ ≤ flo := hu
        _ ≤ f := hfloor
    · have hd : d j = R j := by simp [d, hs, R]
      exact hd.ge
  have hdpos (j : ℕ) : 0 < d j := by
    dsimp only [d]
    split_ifs
    · exact hf
    · exact (hrange j).1
  have hrho (j : ℕ) (hj : j < 98304) :
      dickmanRho ((j : ℝ) / 2331) ≤ (d j : ℝ) :=
    (hrange j).2.1.trans (Rat.cast_le.mpr (hRmajor j hj))
  have hnoncross (j : ℕ) (hj : j < 98304) (hs : stopped j ≠ true) :
      ∀ i ≤ j, flo < (B i).2 := by
    intro i hij
    apply lt_of_not_ge
    intro hu
    exact hs ((hstopOwn j hj).mpr ⟨i, hij, hu⟩)
  have hselected (j : ℕ) (hj : j < 98304) :
      let selected : ℚ × ℚ := if stopped j then (f, f) else I.getD j (1, 1)
      0 < selected.1 ∧ selected.1 ≤ d j ∧ d j ≤ selected.2 := by
    dsimp only
    by_cases hs : stopped j = true
    · have hd : d j = f := by simp [d, hs]
      rw [ite_eq_left hs, hd]
      exact ⟨hf, le_rfl, le_rfl⟩
    · have hjCross : j < 81585 := by
        by_contra hn
        exact hs (hafter j (by omega))
      have hbefore : ∀ i : ℕ, i < j → flo < (B i).2 :=
        fun i hij => hnoncross j hj hs i hij.le
      have hlo : 0 < (B j).1 := hfirst j hjCross.le hbefore
      have hd : d j = R j := by simp [d, hs, R]
      rw [ite_eq_right hs, hfixed j hj, hd]
      exact ⟨hlo, (hbound j).1, (hbound j).2.1⟩
  refine ⟨hfixed, hstopOwn, hpersistent, hafter,
    (fun j hj => ⟨hdpos j, hRmajor j hj, hrho j hj⟩), ?_, hselected⟩
  intro j hj t ht
  obtain ⟨_, _, _, _, _, _, hrhoAnti, _⟩ := dickmanRho_analytic
  have hj0 : (0 : ℝ) ≤ (j : ℝ) / 2331 := by positivity
  have ht0 : 0 ≤ t := hj0.trans ht
  exact (hrhoAnti hj0 ht0 ht).trans (hrho j hj)

theorem envelope_coeff_mul_nonneg
    {K : Type*} [Semiring K] [PartialOrder K] [IsOrderedRing K]
    (P Q : Polynomial K)
    (hP : ∀ a, 0 ≤ P.coeff a) (hQ : ∀ a, 0 ≤ Q.coeff a) (j : ℕ) :
    0 ≤ (P * Q).coeff j := by
  rw [Polynomial.coeff_mul]
  exact Finset.sum_nonneg fun uv _ => mul_nonneg (hP uv.1) (hQ uv.2)

theorem envelope_coeff_pow_nonneg
    {K : Type*} [Semiring K] [PartialOrder K] [IsOrderedRing K]
    (P : Polynomial K) (hP : ∀ a, 0 ≤ P.coeff a) (r j : ℕ) :
    0 ≤ (P ^ r).coeff j := by
  induction r generalizing j with
  | zero =>
      simp only [pow_zero, Polynomial.coeff_one]
      split_ifs <;> simp only [zero_le_one, le_refl]
  | succ r ih =>
      rw [pow_succ]
      exact envelope_coeff_mul_nonneg (P ^ r) P ih hP j

theorem envelope_coeff_mul_mono_right
    {K : Type*} [Semiring K] [PartialOrder K] [IsOrderedRing K]
    (P A B : Polynomial K) (hP : ∀ a, 0 ≤ P.coeff a)
    (hAB : ∀ a, A.coeff a ≤ B.coeff a) (j : ℕ) :
    (P * A).coeff j ≤ (P * B).coeff j := by
  rw [Polynomial.coeff_mul, Polynomial.coeff_mul]
  exact Finset.sum_le_sum fun uv _ =>
    mul_le_mul_of_nonneg_left (hAB uv.2) (hP uv.1)

theorem envelope_monomial_sum_coeff_nonneg
    {K : Type*} [Semiring K] [PartialOrder K] [IsOrderedRing K]
    (s : Finset ℕ) (w : ℕ → K) (hw : ∀ a ∈ s, 0 ≤ w a) (j : ℕ) :
    0 ≤ (∑ a ∈ s, Polynomial.monomial a (w a)).coeff j := by
  classical
  simp only [Polynomial.finsetSum_coeff, Polynomial.coeff_monomial]
  refine Finset.sum_nonneg fun a ha => ?_
  have := hw a ha
  positivity

theorem envelope_coeff_map_rat_nonneg
    (P : Polynomial ℚ) (hP : ∀ a, 0 ≤ P.coeff a) (j : ℕ) :
    0 ≤ (P.map (Rat.castHom ℝ)).coeff j := by
  simpa only [Polynomial.coeff_map, Rat.coe_castHom, Rat.cast_nonneg] using hP j

theorem envelope_coeff_map_rat_mono
    (P Q : Polynomial ℚ) (hPQ : ∀ a, P.coeff a ≤ Q.coeff a) (j : ℕ) :
    (P.map (Rat.castHom ℝ)).coeff j ≤ (Q.map (Rat.castHom ℝ)).coeff j := by
  simpa only [Polynomial.coeff_map, Rat.coe_castHom, Rat.cast_le] using hPQ j

theorem firstOuterLow_reciprocal_polynomial_coeff_nonneg (A B j : ℕ) :
    0 ≤ (∑ a ∈ Finset.Ico A B,
      Polynomial.monomial a ((a : ℚ)⁻¹)).coeff j := by
  apply envelope_monomial_sum_coeff_nonneg
  intro a _
  positivity

theorem firstOuterLow_low_polynomial_coeff_nonneg
    (h : ℝ) (d : ℕ → ℚ) (hh : 0 ≤ h)
    (hd : ∀ a < 98304, 0 ≤ d a) (j : ℕ) :
    0 ≤ (∑ a ∈ Finset.range 98304,
      Polynomial.monomial a
        (h * (d a : ℝ) * Real.exp (-189 * (a : ℝ) * h))).coeff j := by
  apply envelope_monomial_sum_coeff_nonneg
  intro a ha
  exact mul_nonneg (mul_nonneg hh (by exact_mod_cast hd a (Finset.mem_range.mp ha)))
    (Real.exp_pos _).le

theorem firstOuterLow_hybrid_coeff_bounds
    (Q mark : Polynomial ℚ) (D : Polynomial ℝ) (e : Fin 2) (j : ℕ)
    (hQ : ∀ a, 0 ≤ Q.coeff a) (hmark : ∀ a, 0 ≤ mark.coeff a)
    (hD : ∀ a, 0 ≤ D.coeff a) :
    let q : ℕ → Polynomial ℚ :=
      fun r => Polynomial.C ((r.factorial : ℚ)⁻¹) * Q ^ r
    let rep : ℕ → Polynomial ℚ :=
      fun m => ∑ a ∈ Finset.range m, (Polynomial.X : Polynomial ℚ) ^ a
    let T : Polynomial ℚ :=
      (∑ r ∈ Finset.range 33, q r * eulerianCarryPolynomial (r + e.val + 1)) +
        ∑ r ∈ Finset.Ico 33 43, q r * rep (r + e.val + 1)
    (∀ r, 0 ≤ (D *
      (mark ^ e.val * q r * eulerianCarryPolynomial (r + e.val + 1)).map
        (Rat.castHom ℝ)).coeff j) ∧
      0 ≤ (D * (mark ^ e.val * T).map (Rat.castHom ℝ)).coeff j ∧
      (∑ r ∈ Finset.range 43,
        (D * (mark ^ e.val * q r *
          eulerianCarryPolynomial (r + e.val + 1)).map (Rat.castHom ℝ)).coeff j) ≤
        (D * (mark ^ e.val * T).map (Rat.castHom ℝ)).coeff j := by
  classical
  intro q rep T
  have hq (r a : ℕ) : 0 ≤ (q r).coeff a := by
    dsimp only [q]
    rw [Polynomial.coeff_C_mul]
    exact mul_nonneg (by positivity) (envelope_coeff_pow_nonneg Q hQ r a)
  have hmarkpow : ∀ a, 0 ≤ (mark ^ e.val).coeff a :=
    envelope_coeff_pow_nonneg mark hmark e.val
  have hcarry (r a : ℕ) :
      0 ≤ (eulerianCarryPolynomial (r + e.val + 1)).coeff a :=
    (eulerianCarryPolynomial_coeff_nonneg_le _ a (by omega)).1
  have hrep (m a : ℕ) : 0 ≤ (rep m).coeff a := by
    simp only [rep, Polynomial.finsetSum_coeff, Polynomial.coeff_X_pow]
    positivity
  have hT (a : ℕ) : 0 ≤ T.coeff a := by
    change 0 ≤ ((∑ r ∈ Finset.range 33,
        q r * eulerianCarryPolynomial (r + e.val + 1)) +
      ∑ r ∈ Finset.Ico 33 43, q r * rep (r + e.val + 1)).coeff a
    rw [Polynomial.coeff_add]
    apply add_nonneg
    · rw [Polynomial.finsetSum_coeff]
      exact Finset.sum_nonneg fun r _ =>
        envelope_coeff_mul_nonneg (q r) (eulerianCarryPolynomial (r + e.val + 1))
          (hq r) (hcarry r) a
    · rw [Polynomial.finsetSum_coeff]
      exact Finset.sum_nonneg fun r _ =>
        envelope_coeff_mul_nonneg (q r) (rep (r + e.val + 1))
          (hq r) (hrep _) a
  have htail :
      (∑ r ∈ Finset.range 43, q r * rep (r + e.val + 1)) -
        (∑ r ∈ Finset.range 33, q r * rep (r + e.val + 1)) =
      ∑ r ∈ Finset.Ico 33 43, q r * rep (r + e.val + 1) :=
    (Finset.sum_Ico_eq_sub (fun r => q r * rep (r + e.val + 1)) (by omega)).symm
  have hcompare (a : ℕ) :
      (∑ r ∈ Finset.range 43, q r * eulerianCarryPolynomial (r + e.val + 1)).coeff a ≤
        T.coeff a := by
    have hb := eulerianCarryPolynomial_finite_hybrid Q e 42 32 a
      (by omega) (fun b _ => hQ b)
    change
      (0 ≤ ((∑ r ∈ Finset.range 43, q r * rep (r + e.val + 1)) -
        (∑ r ∈ Finset.range 33, q r * rep (r + e.val + 1))).coeff a) ∧
      (∑ r ∈ Finset.range 43, q r * eulerianCarryPolynomial (r + e.val + 1)).coeff a ≤
        ((∑ r ∈ Finset.range 33, q r * eulerianCarryPolynomial (r + e.val + 1)) +
          ((∑ r ∈ Finset.range 43, q r * rep (r + e.val + 1)) -
            (∑ r ∈ Finset.range 33, q r * rep (r + e.val + 1)))).coeff a at hb
    rw [htail] at hb
    exact hb.2
  have hper (r : ℕ) :
      ∀ a, 0 ≤ (mark ^ e.val * q r * eulerianCarryPolynomial (r + e.val + 1)).coeff a :=
    envelope_coeff_mul_nonneg (mark ^ e.val * q r)
      (eulerianCarryPolynomial (r + e.val + 1))
      (envelope_coeff_mul_nonneg (mark ^ e.val) (q r) hmarkpow (hq r)) (hcarry r)
  have htarget : ∀ a, 0 ≤ (mark ^ e.val * T).coeff a :=
    envelope_coeff_mul_nonneg (mark ^ e.val) T hmarkpow hT
  refine ⟨?_, ?_, ?_⟩
  · intro r
    exact envelope_coeff_mul_nonneg D
      ((mark ^ e.val * q r * eulerianCarryPolynomial (r + e.val + 1)).map
        (Rat.castHom ℝ)) hD
      (envelope_coeff_map_rat_nonneg _ (hper r)) j
  · exact envelope_coeff_mul_nonneg D ((mark ^ e.val * T).map (Rat.castHom ℝ))
      hD (envelope_coeff_map_rat_nonneg _ htarget) j
  · have hmarked : ∀ a,
        (mark ^ e.val * (∑ r ∈ Finset.range 43,
          q r * eulerianCarryPolynomial (r + e.val + 1))).coeff a ≤
        (mark ^ e.val * T).coeff a :=
      envelope_coeff_mul_mono_right (mark ^ e.val) _ T hmarkpow hcompare
    have hsum :
        (∑ r ∈ Finset.range 43,
          D * (mark ^ e.val * q r * eulerianCarryPolynomial (r + e.val + 1)).map
            (Rat.castHom ℝ)) =
        D * (mark ^ e.val * (∑ r ∈ Finset.range 43,
          q r * eulerianCarryPolynomial (r + e.val + 1))).map (Rat.castHom ℝ) := by
      simp only [Finset.mul_sum, Polynomial.map_sum, mul_assoc]
    rw [← Polynomial.finsetSum_coeff, hsum]
    exact envelope_coeff_mul_mono_right D _ _ hD
      (envelope_coeff_map_rat_mono _ _ hmarked) j

theorem firstOuterLow_hybrid_coeff_bounds_explicit
    (Q mark : Polynomial ℚ) (D : Polynomial ℝ) (e : Fin 2) (j : ℕ)
    (q rep : ℕ → Polynomial ℚ) (T : Polynomial ℚ)
    (hq : q = fun r => Polynomial.C ((r.factorial : ℚ)⁻¹) * Q ^ r)
    (hrep : rep = fun m =>
      ∑ a ∈ Finset.range m, (Polynomial.X : Polynomial ℚ) ^ a)
    (hT : T =
      (∑ r ∈ Finset.range 33, q r * eulerianCarryPolynomial (r + e.val + 1)) +
        ∑ r ∈ Finset.Ico 33 43, q r * rep (r + e.val + 1))
    (hQ : ∀ a, 0 ≤ Q.coeff a) (hmark : ∀ a, 0 ≤ mark.coeff a)
    (hD : ∀ a, 0 ≤ D.coeff a) :
    (∀ r, 0 ≤ (D *
      (mark ^ e.val * q r * eulerianCarryPolynomial (r + e.val + 1)).map
        (Rat.castHom ℝ)).coeff j) ∧
      0 ≤ (D * (mark ^ e.val * T).map (Rat.castHom ℝ)).coeff j ∧
      (∑ r ∈ Finset.range 43,
        (D * (mark ^ e.val * q r *
          eulerianCarryPolynomial (r + e.val + 1)).map (Rat.castHom ℝ)).coeff j) ≤
        (D * (mark ^ e.val * T).map (Rat.castHom ℝ)).coeff j := by
  subst q rep T
  exact firstOuterLow_hybrid_coeff_bounds Q mark D e j hQ hmark hD

theorem firstOuterLow_perCount_polynomial_join
    (v : ℝ≥0∞) (r j : ℕ) (e : Fin 2)
    (D : Polynomial ℝ) (mark Q qr E : Polynomial ℚ)
    {D₀ mark₀ Q₀ : Polynomial ℝ}
    (hbound : v ≤ ENNReal.ofReal
      ((Polynomial.C ((r.factorial : ℝ)⁻¹) *
        (D₀ * mark₀ ^ e.val * Q₀ ^ r * E.map (Rat.castHom ℝ))).coeff j))
    (hD : D₀ = D)
    (hmark : mark₀ = mark.map (Rat.castHom ℝ))
    (hQ : Q₀ = Q.map (Rat.castHom ℝ))
    (hqr : qr.map (Rat.castHom ℝ) =
      Polynomial.C ((r.factorial : ℝ)⁻¹) * (Q.map (Rat.castHom ℝ)) ^ r) :
    v ≤ ENNReal.ofReal
      ((D * (mark ^ e.val * qr * E).map (Rat.castHom ℝ)).coeff j) := by
  rw [hD, hmark, hQ] at hbound
  have heq :
      Polynomial.C ((r.factorial : ℝ)⁻¹) *
        (D * (mark.map (Rat.castHom ℝ)) ^ e.val *
          (Q.map (Rat.castHom ℝ)) ^ r * E.map (Rat.castHom ℝ)) =
      D * (mark ^ e.val * qr * E).map (Rat.castHom ℝ) := by
    rw [Polynomial.map_mul, Polynomial.map_mul, Polynomial.map_pow, hqr]
    ring
  rwa [heq] at hbound

theorem firstOuterLow_renewal_cell_of_profile
    (e : Fin 2) (j : ℕ) (hj : j < 98304) (d : ℕ → ℚ)
    (hdNonneg : ∀ a : ℕ, a < 98304 → 0 ≤ d a)
    (hd : ∀ a : ℕ, a < 98304 → dickmanRho ((a : ℝ) / 2331) ≤ (d a : ℝ)) :
    let h : ℝ := 2742997 / 258046918656
    let C := Set.Ico ((j : ℝ) * h) (((j : ℝ) + 1) * h)
    let hSource : ℝ := 2742997 / 258046918656
    let Q : Polynomial ℚ :=
      ∑ a ∈ Finset.Ico 2331 49152, Polynomial.monomial a ((a : ℚ)⁻¹)
    let mark : Polynomial ℚ :=
      ∑ a ∈ Finset.Ico 2331 3498, Polynomial.monomial a ((a : ℚ)⁻¹)
    let q : ℕ → Polynomial ℚ :=
      fun r => Polynomial.C ((r.factorial : ℚ)⁻¹) * Q ^ r
    let rep : ℕ → Polynomial ℚ :=
      fun m => ∑ a ∈ Finset.range m, (Polynomial.X : Polynomial ℚ) ^ a
    let T : Polynomial ℚ :=
      (∑ r ∈ Finset.range 33, q r * eulerianCarryPolynomial (r + e.val + 1)) +
        ∑ r ∈ Finset.Ico 33 43, q r * rep (r + e.val + 1)
    let D : Polynomial ℝ :=
      ∑ j ∈ Finset.range 98304,
        Polynomial.monomial j
          (hSource * (d j : ℝ) * Real.exp (-189 * (j : ℝ) * hSource))
    (∀ r : ℕ, 43 ≤ r → firstOuterLowCountMeasure e r C = 0) ∧
    (Measure.sum (firstOuterLowCountMeasure e)) C =
      (∑ r ∈ Finset.range 43, firstOuterLowCountMeasure e r C) ∧
    0 ≤ (D * (mark ^ e.val * T).map (Rat.castHom ℝ)).coeff j ∧
    (Measure.sum (firstOuterLowCountMeasure e)) C ≤
      ENNReal.ofReal ((D * (mark ^ e.val * T).map (Rat.castHom ℝ)).coeff j) := by
  classical
  intro h C hSource Q mark q rep T D
  have hh : 0 < hSource := by norm_num [hSource]
  have hQ : ∀ a, 0 ≤ Q.coeff a :=
    firstOuterLow_reciprocal_polynomial_coeff_nonneg 2331 49152
  have hmark : ∀ a, 0 ≤ mark.coeff a :=
    firstOuterLow_reciprocal_polynomial_coeff_nonneg 2331 3498
  have hD : ∀ a, 0 ≤ D.coeff a :=
    firstOuterLow_low_polynomial_coeff_nonneg hSource d hh.le hdNonneg
  have hcoeffs := firstOuterLow_hybrid_coeff_bounds_explicit
    Q mark D e j q rep T rfl rfl rfl hQ hmark hD
  have hper (r : ℕ) : firstOuterLowCountMeasure e r C ≤
      ENNReal.ofReal ((D *
        (mark ^ e.val * q r * eulerianCarryPolynomial (r + e.val + 1)).map
          (Rat.castHom ℝ)).coeff j) := by
    let dReal : ℕ → ℝ := fun a => (d a : ℝ)
    have hdReal : ∀ a : ℕ, a < 98304 →
        dickmanRho ((a : ℝ) / 2331) ≤ dReal a := by
      intro a ha
      exact hd a ha
    have hm := firstOuterLowCountMeasure_cell_le_majorant e r j hj dReal hdReal
    refine firstOuterLow_perCount_polynomial_join
      (v := firstOuterLowCountMeasure e r C) (r := r) (j := j) (e := e)
      (D := D) (mark := mark) (Q := Q) (qr := q r)
      (E := eulerianCarryPolynomial (r + e.val + 1)) hm ?_ ?_ ?_ ?_
    · rfl
    · exact firstOuterLow_reciprocal_polynomial_map 2331 3498
    · exact firstOuterLow_reciprocal_polynomial_map 2331 49152
    · exact firstOuterLow_factorial_power_map r Q
  have hsum : (Measure.sum (firstOuterLowCountMeasure e)) C =
      ∑ r ∈ Finset.range 43, firstOuterLowCountMeasure e r C :=
    firstOuterLowCountMeasure_sum_cell e j hj
  refine ⟨fun r hr => firstOuterLowCountMeasure_cell_eq_zero e j hj r hr,
    hsum, ?_, ?_⟩
  · exact hcoeffs.2.1
  · rw [hsum]
    calc
      (∑ r ∈ Finset.range 43, firstOuterLowCountMeasure e r C) ≤
          ∑ r ∈ Finset.range 43, ENNReal.ofReal ((D *
            (mark ^ e.val * q r * eulerianCarryPolynomial (r + e.val + 1)).map
              (Rat.castHom ℝ)).coeff j) :=
        Finset.sum_le_sum fun r _ => hper r
      _ = ENNReal.ofReal (∑ r ∈ Finset.range 43, (D *
          (mark ^ e.val * q r * eulerianCarryPolynomial (r + e.val + 1)).map
            (Rat.castHom ℝ)).coeff j) :=
        (ENNReal.ofReal_sum_of_nonneg fun r _ => hcoeffs.1 r).symm
      _ ≤ ENNReal.ofReal ((D * (mark ^ e.val * T).map (Rat.castHom ℝ)).coeff j) :=
        ENNReal.ofReal_le_ofReal hcoeffs.2.2

/--
The rational renewal profile that switches permanently to `10^(-40)` once a dyadic upper
endpoint is at most the downward-rounded threshold. Before that switch it uses the exact
rational renewal prefix.
-/
def firstOuterLowSelectedProfile : ℕ → ℚ :=
  let I := dickmanRenewalDyadicPrefix 160 2331 98303
  let f : ℚ := 1 / 10 ^ 40
  let flo := (f.toDyadic 160).toRat
  let stopped : ℕ → Bool := fun j =>
    (List.range (j + 1)).any
      (fun i => decide ((I.getD i (1, 1)).2 ≤ flo))
  fun j => if stopped j then f else (dickmanRenewalPrefix 2331 j).getD j 1

theorem firstOuterLowSelectedProfile_spec (j : ℕ) (hj : j < 98304) :
    0 < firstOuterLowSelectedProfile j ∧
      (dickmanRenewalPrefix 2331 j).getD j 1 ≤ firstOuterLowSelectedProfile j ∧
      dickmanRho ((j : ℝ) / 2331) ≤ (firstOuterLowSelectedProfile j : ℝ) :=
  firstOuterLow_stopping_selection.2.2.2.2.1 j hj

theorem firstOuterLow_selected_profile_cell
    (e : Fin 2) (j : ℕ) (hj : j < 98304) :
    let h : ℝ := 2742997 / 258046918656
    let C := Set.Ico ((j : ℝ) * h) (((j : ℝ) + 1) * h)
    let hSource : ℝ := 2742997 / 258046918656
    let Q : Polynomial ℚ :=
      ∑ a ∈ Finset.Ico 2331 49152, Polynomial.monomial a ((a : ℚ)⁻¹)
    let mark : Polynomial ℚ :=
      ∑ a ∈ Finset.Ico 2331 3498, Polynomial.monomial a ((a : ℚ)⁻¹)
    let q : ℕ → Polynomial ℚ :=
      fun r => Polynomial.C ((r.factorial : ℚ)⁻¹) * Q ^ r
    let rep : ℕ → Polynomial ℚ :=
      fun m => ∑ a ∈ Finset.range m, (Polynomial.X : Polynomial ℚ) ^ a
    let T : Polynomial ℚ :=
      (∑ r ∈ Finset.range 33, q r * eulerianCarryPolynomial (r + e.val + 1)) +
        ∑ r ∈ Finset.Ico 33 43, q r * rep (r + e.val + 1)
    let D : Polynomial ℝ :=
      ∑ a ∈ Finset.range 98304,
        Polynomial.monomial a
          (hSource * (firstOuterLowSelectedProfile a : ℝ) *
            Real.exp (-189 * (a : ℝ) * hSource))
    (∀ r : ℕ, 43 ≤ r → firstOuterLowCountMeasure e r C = 0) ∧
      (Measure.sum (firstOuterLowCountMeasure e)) C =
        (∑ r ∈ Finset.range 43, firstOuterLowCountMeasure e r C) ∧
      0 ≤ (D * (mark ^ e.val * T).map (Rat.castHom ℝ)).coeff j ∧
      (Measure.sum (firstOuterLowCountMeasure e)) C ≤
        ENNReal.ofReal ((D * (mark ^ e.val * T).map (Rat.castHom ℝ)).coeff j) :=
  firstOuterLow_renewal_cell_of_profile e j hj firstOuterLowSelectedProfile
    (fun a ha => (firstOuterLowSelectedProfile_spec a ha).1.le)
    (fun a ha => (firstOuterLowSelectedProfile_spec a ha).2.2)

theorem firstOuterLow_countMixture_cell_lt_top
    (e : Fin 2) (j : ℕ) (hj : j < 98304) :
    (Measure.sum (firstOuterLowCountMeasure e))
      (Set.Ico ((j : ℝ) * (2742997 / 258046918656))
        (((j : ℝ) + 1) * (2742997 / 258046918656))) < ⊤ :=
  (firstOuterLow_selected_profile_cell e j hj).2.2.2.trans_lt ENNReal.ofReal_lt_top

theorem firstOuterLowCountMeasure_prefix_eq_zero
    (e : Fin 2) (N : ℕ) (hN : N ≤ 98304) (r : ℕ) (hr : 43 ≤ r) :
    firstOuterLowCountMeasure e r
      (Set.Ico 0 ((N : ℝ) * (2742997 / 258046918656))) = 0 := by
  let h : ℝ := 2742997 / 258046918656
  let cells : ℕ → Set ℝ := fun j => Set.Ico ((j : ℝ) * h) (((j : ℝ) + 1) * h)
  have hcover : Set.Ico 0 ((N : ℝ) * h) ⊆ ⋃ j ∈ Finset.range N, cells j := by
    simpa only [Nat.cast_zero, zero_mul, Nat.cast_add, Nat.cast_one, cells] using
      Ico_subset_biUnion_Ico N (fun j : ℕ => (j : ℝ) * h)
  apply bot_unique
  calc
    firstOuterLowCountMeasure e r (Set.Ico 0 ((N : ℝ) * h)) ≤
        firstOuterLowCountMeasure e r (⋃ j ∈ Finset.range N, cells j) :=
      measure_mono hcover
    _ ≤ ∑ j ∈ Finset.range N, firstOuterLowCountMeasure e r (cells j) :=
      measure_biUnion_finset_le _ _
    _ = 0 := by
      apply Finset.sum_eq_zero
      intro j hj
      exact firstOuterLowCountMeasure_cell_eq_zero e j
        (lt_of_lt_of_le (Finset.mem_range.mp hj) hN) r hr

theorem firstOuterLow_countMixture_prefix_eq_sum
    (e : Fin 2) (N : ℕ) (hN : N ≤ 98304) :
    (Measure.sum (firstOuterLowCountMeasure e))
      (Set.Ico 0 ((N : ℝ) * (2742997 / 258046918656))) =
      ∑ r ∈ Finset.range 43, firstOuterLowCountMeasure e r
        (Set.Ico 0 ((N : ℝ) * (2742997 / 258046918656))) := by
  rw [Measure.sum_apply _ measurableSet_Ico]
  apply tsum_eq_sum
  intro r hr
  exact firstOuterLowCountMeasure_prefix_eq_zero e N hN r (by simpa using hr)

theorem firstOuterLow_countMixture_prefix_lt_top
    (e : Fin 2) (N : ℕ) (hN : N ≤ 98304) :
    (Measure.sum (firstOuterLowCountMeasure e))
      (Set.Ico 0 ((N : ℝ) * (2742997 / 258046918656))) < ⊤ := by
  let h : ℝ := 2742997 / 258046918656
  let cells : ℕ → Set ℝ := fun j => Set.Ico ((j : ℝ) * h) (((j : ℝ) + 1) * h)
  have hcover : Set.Ico 0 ((N : ℝ) * h) ⊆ ⋃ j ∈ Finset.range N, cells j := by
    simpa only [Nat.cast_zero, zero_mul, Nat.cast_add, Nat.cast_one, cells] using
      Ico_subset_biUnion_Ico N (fun j : ℕ => (j : ℝ) * h)
  have hfinite :
      (∑ j ∈ Finset.range N, (Measure.sum (firstOuterLowCountMeasure e)) (cells j)) < ⊤ := by
    apply ENNReal.sum_lt_top.mpr
    intro j hj
    exact firstOuterLow_countMixture_cell_lt_top e j
      (lt_of_lt_of_le (Finset.mem_range.mp hj) hN)
  exact ((measure_mono hcover).trans (measure_biUnion_finset_le _ _)).trans_lt hfinite

end

theorem lowWitness_power_mul_coeff_eq_zero
    (L K r j : ℕ) (P : Polynomial ℚ) (hj : j < r * L) :
    let Q : Polynomial ℚ :=
      ∑ a ∈ Finset.Ico L K,
        Polynomial.C ((a : ℚ)⁻¹) * (Polynomial.X : Polynomial ℚ) ^ a
    (Polynomial.C ((r.factorial : ℚ)⁻¹) * Q ^ r * P).coeff j = 0 := by
  intro Q
  have hQ : (Polynomial.X : Polynomial ℚ) ^ L ∣ Q :=
    Finset.dvd_sum fun a ha =>
      (pow_dvd_pow Polynomial.X (Finset.mem_Ico.mp ha).1).mul_left _
  have hr : (Polynomial.X : Polynomial ℚ) ^ (r * L) ∣ Q ^ r := by
    simpa [pow_mul, Nat.mul_comm] using pow_dvd_pow_of_dvd hQ r
  exact Polynomial.X_pow_dvd_iff.mp ((hr.mul_left _).mul_right P) j hj

theorem lowWitness_replicated_tail_trunc_eq_zero
    (L K N : ℕ) (hL : 2 ≤ L) (hLK : L < K) (hKN : K ≤ N)
    (e : Fin 2) :
    let Q : Polynomial ℚ :=
      ∑ a ∈ Finset.Ico L K,
        Polynomial.C ((a : ℚ)⁻¹) * (Polynomial.X : Polynomial ℚ) ^ a
    let q : ℕ → Polynomial ℚ :=
      fun r => Polynomial.C ((r.factorial : ℚ)⁻¹) * Q ^ r
    let R : ℕ → Polynomial ℚ :=
      fun m => ∑ a ∈ Finset.range m, (Polynomial.X : Polynomial ℚ) ^ a
    let cutoff := (N - 1) / L
    (∀ r : ℕ, r ≤ cutoff ↔ r * L < N) ∧
      ∀ countBound J : ℕ, cutoff ≤ countBound → J = cutoff →
        PowerSeries.trunc N
          (((∑ r ∈ Finset.range (countBound + 1), q r * R (r + e.val + 1)) -
            ∑ r ∈ Finset.range (J + 1), q r * R (r + e.val + 1) :
              Polynomial ℚ) : PowerSeries ℚ) = 0 := by
  intro Q q R cutoff
  have hcut : ∀ r : ℕ, r ≤ cutoff ↔ r * L < N := by
    intro r
    change r ≤ (N - 1) / L ↔ r * L < N
    rw [Nat.le_div_iff_mul_le (by omega)]
    omega
  refine ⟨hcut, ?_⟩
  intro countBound J hcount hJ
  subst J
  rw [← Finset.sum_Ico_eq_sub _ (Nat.succ_le_succ hcount)]
  ext j
  rw [PowerSeries.coeff_trunc]
  split_ifs with hj
  · simp only [Polynomial.coeff_coe, Polynomial.finsetSum_coeff, Polynomial.coeff_zero]
    apply Finset.sum_eq_zero
    intro r hr
    have hNr : N ≤ r * L := by
      have := (Finset.mem_Ico.mp hr).1
      have := hcut r
      omega
    exact lowWitness_power_mul_coeff_eq_zero L K r j (R (r + e.val + 1))
      (hj.trans_le hNr)
  · simp

theorem lowWitness_formal_replicated_quotient_trunc
    (L K N : ℕ) (hL : 2 ≤ L) (hLK : L < K) (hKN : K ≤ N)
    (e : Fin 2) :
    let Q : Polynomial ℚ :=
      ∑ a ∈ Finset.Ico L K,
        Polynomial.C ((a : ℚ)⁻¹) * (Polynomial.X : Polynomial ℚ) ^ a
    let q : ℕ → Polynomial ℚ :=
      fun r => Polynomial.C ((r.factorial : ℚ)⁻¹) * Q ^ r
    let R : ℕ → Polynomial ℚ :=
      fun m => ∑ a ∈ Finset.range m, (Polynomial.X : Polynomial ℚ) ^ a
    let T : PowerSeries ℚ :=
      ((PowerSeries.exp ℚ).subst (Q : PowerSeries ℚ) -
        (PowerSeries.X : PowerSeries ℚ) ^ (e.val + 1) *
          (PowerSeries.exp ℚ).subst
            ((PowerSeries.X : PowerSeries ℚ) * (Q : PowerSeries ℚ))) *
        (1 - (PowerSeries.X : PowerSeries ℚ))⁻¹
    ∀ countBound : ℕ, (N - 1) / L ≤ countBound →
      PowerSeries.trunc N T =
        PowerSeries.trunc N
          ((∑ r ∈ Finset.range (countBound + 1),
            q r * R (r + e.val + 1) : Polynomial ℚ) : PowerSeries ℚ) := by
  intro Q q R T countBound hcount
  have hQ0 : Q.coeff 0 = 0 := by
    simp [Q]
  have hexp (V : Polynomial ℚ) (hV : V.coeff 0 = 0) :
      PowerSeries.trunc N ((PowerSeries.exp ℚ).subst (V : PowerSeries ℚ)) =
        PowerSeries.trunc N
          ((∑ r ∈ Finset.range (N + 1),
            Polynomial.C ((r.factorial : ℚ)⁻¹) * V ^ r : Polynomial ℚ) :
              PowerSeries ℚ) := by
    have hV0 : PowerSeries.constantCoeff (V : PowerSeries ℚ) = 0 := hV
    ext j
    rw [PowerSeries.coeff_trunc, PowerSeries.coeff_trunc]
    split_ifs with hj
    · rw [PowerSeries.coeff_subst' (.of_constantCoeff_zero' hV0)]
      have hsupp :
          Function.support (fun r : ℕ =>
            PowerSeries.coeff r (PowerSeries.exp ℚ) •
              PowerSeries.coeff j ((V : PowerSeries ℚ) ^ r)) ⊆
            (Finset.range (N + 1) : Set ℕ) := by
        intro r hr
        by_contra hrange
        have hNr : N + 1 ≤ r := by
          simpa only [Finset.mem_coe, Finset.mem_range, not_lt] using hrange
        have hz : PowerSeries.coeff j ((V : PowerSeries ℚ) ^ r) = 0 := by
          apply PowerSeries.coeff_of_lt_order
          exact lt_of_lt_of_le (by exact_mod_cast (show j < r by omega))
            (PowerSeries.le_order_pow_of_constantCoeff_eq_zero r hV0)
        exact hr (by simp [hz])
      rw [finsum_eq_finsetSum_of_support_subset _ hsupp]
      simp [← Polynomial.coe_pow, Polynomial.finsetSum_coeff, one_div, smul_eq_mul]
    · rfl
  let P : Polynomial ℚ := ∑ r ∈ Finset.range (N + 1), q r
  let S : Polynomial ℚ := ∑ r ∈ Finset.range (N + 1),
    Polynomial.C ((r.factorial : ℚ)⁻¹) * (Polynomial.X * Q) ^ r
  have hXexp :
      PowerSeries.trunc N
          ((PowerSeries.exp ℚ).subst
            ((PowerSeries.X : PowerSeries ℚ) * (Q : PowerSeries ℚ))) =
        PowerSeries.trunc N (S : PowerSeries ℚ) := by
    rw [← Polynomial.coe_X, ← Polynomial.coe_mul]
    exact hexp (Polynomial.X * Q) (by simp)
  have hnum :
      PowerSeries.trunc N
          ((PowerSeries.exp ℚ).subst (Q : PowerSeries ℚ) -
            (PowerSeries.X : PowerSeries ℚ) ^ (e.val + 1) *
              (PowerSeries.exp ℚ).subst
                ((PowerSeries.X : PowerSeries ℚ) * (Q : PowerSeries ℚ))) =
        PowerSeries.trunc N
          ((P - Polynomial.X ^ (e.val + 1) * S : Polynomial ℚ) : PowerSeries ℚ) := by
    simp only [Polynomial.coe_sub, Polynomial.coe_mul, Polynomial.coe_pow,
      Polynomial.coe_X, PowerSeries.trunc_sub]
    rw [hexp Q hQ0]
    congr 1
    rw [← PowerSeries.trunc_mul_trunc, hXexp, PowerSeries.trunc_mul_trunc]
  have hfinite :
      (∑ r ∈ Finset.range (N + 1), q r * R (r + e.val + 1)) *
          (1 - Polynomial.X) =
        P - Polynomial.X ^ (e.val + 1) * S := by
    dsimp only [P, S]
    rw [Finset.sum_mul, Finset.mul_sum, ← Finset.sum_sub_distrib]
    apply Finset.sum_congr rfl
    intro r _
    dsimp only [q, R]
    rw [mul_assoc, geom_sum_mul_neg]
    simp only [mul_pow, pow_add, pow_one]
    ring
  have hstable (k : ℕ) (hk : (N - 1) / L ≤ k) :
      PowerSeries.trunc N
          ((∑ r ∈ Finset.range (k + 1), q r * R (r + e.val + 1) :
              Polynomial ℚ) : PowerSeries ℚ) =
        PowerSeries.trunc N
          ((∑ r ∈ Finset.range ((N - 1) / L + 1), q r * R (r + e.val + 1) :
              Polynomial ℚ) : PowerSeries ℚ) := by
    have hz := (lowWitness_replicated_tail_trunc_eq_zero L K N hL hLK hKN e).2
      k ((N - 1) / L) hk rfl
    simpa only [Polynomial.coe_sub, PowerSeries.trunc_sub, sub_eq_zero] using hz
  calc
    PowerSeries.trunc N T =
        PowerSeries.trunc N
          ((∑ r ∈ Finset.range (N + 1), q r * R (r + e.val + 1) :
              Polynomial ℚ) : PowerSeries ℚ) := by
      dsimp only [T]
      rw [← PowerSeries.trunc_trunc_mul, hnum,
        PowerSeries.trunc_trunc_mul, ← hfinite]
      simp only [Polynomial.coe_mul, Polynomial.coe_sub, Polynomial.coe_one,
        Polynomial.coe_X]
      rw [mul_assoc, PowerSeries.mul_inv_cancel _ (by simp), mul_one]
    _ = PowerSeries.trunc N
        ((∑ r ∈ Finset.range ((N - 1) / L + 1), q r * R (r + e.val + 1) :
            Polynomial ℚ) : PowerSeries ℚ) :=
      hstable N ((Nat.div_le_self _ _).trans (Nat.sub_le _ _))
    _ = _ := (hstable countBound hcount).symm

theorem exp_sub_sum_range_le_geometric_tail
    (v : ℝ) (M : ℕ) (hv : 0 ≤ v) (hvhalf : v ≤ 1 / 2) :
    let E : ℝ := ∑ r ∈ Finset.range (M + 1), v ^ r / (r.factorial : ℝ)
    0 ≤ Real.exp v - E ∧
      Real.exp v - E ≤
        v ^ (M + 1) / ((M + 1).factorial : ℝ) *
          (1 / (1 - v / ((M + 2 : ℕ) : ℝ))) := by
  refine ⟨sub_nonneg.mpr (Real.sum_le_exp_of_nonneg hv _), ?_⟩
  have hbase : 0 < ((M + 2 : ℕ) : ℝ) := by positivity
  let q : ℝ := v / ((M + 2 : ℕ) : ℝ)
  have hq1 : q < 1 := by
    apply (div_lt_one₀ hbase).2
    push_cast
    linarith [Nat.cast_nonneg (α := ℝ) M]
  have hfull : HasSum (fun r : ℕ => v ^ r / (r.factorial : ℝ)) (Real.exp v) := by
    simpa [Real.exp_eq_exp_ℝ] using NormedSpace.expSeries_div_hasSum_exp v
  have htail := (hasSum_nat_add_iff' (M + 1)).2 hfull
  let a : ℝ := v ^ (M + 1) / ((M + 1).factorial : ℝ)
  have hterm (k : ℕ) :
      v ^ (k + (M + 1)) / ((k + (M + 1)).factorial : ℝ) ≤ a * q ^ k := by
    calc
      _ ≤ v ^ (k + (M + 1)) /
          (((M + 1).factorial : ℝ) * ((M + 2 : ℕ) : ℝ) ^ k) := by
        gcongr
        rw [Nat.add_comm k (M + 1)]
        exact_mod_cast (Nat.factorial_mul_pow_le_factorial (m := M + 1) (n := k))
      _ = a * q ^ k := by
        dsimp [a, q]
        rw [pow_add, div_pow]
        ring
  simpa only [a, q, one_div] using
    hasSum_le hterm htail
      ((hasSum_geometric_of_lt_one (div_nonneg hv hbase.le) hq1).mul_left a)

theorem formal_exp_coeff_recurrence
    (V : PowerSeries ℚ) (hV : PowerSeries.constantCoeff V = 0) :
    let A : PowerSeries ℚ := (PowerSeries.exp ℚ).subst V
    PowerSeries.coeff 0 A = 1 ∧
      ∀ j : ℕ, 0 < j →
        PowerSeries.coeff j A =
          (j : ℚ)⁻¹ *
            ∑ b ∈ Finset.Icc 1 j,
              (b : ℚ) * PowerSeries.coeff b V *
                PowerSeries.coeff (j - b) A := by
  intro A
  have hsubst := PowerSeries.HasSubst.of_constantCoeff_zero' hV
  constructor
  · rw [PowerSeries.coeff_subst' hsubst, finsum_eq_single _ 0] <;>
      simp +contextual [PowerSeries.coeff_zero_eq_constantCoeff_apply, hV]
  · intro j hj
    obtain ⟨n, rfl⟩ := Nat.exists_eq_succ_of_ne_zero hj.ne'
    rw [eq_inv_mul_iff_mul_eq₀ (by positivity)]
    have hd := congrArg (PowerSeries.coeff n)
      (PowerSeries.derivative_subst (f := PowerSeries.exp ℚ) hsubst)
    rw [PowerSeries.derivative_exp, mul_comm A (PowerSeries.derivative ℚ V),
      PowerSeries.coeff_derivative, PowerSeries.coeff_mul,
      Finset.Nat.sum_antidiagonal_eq_sum_range_succ_mk] at hd
    rw [← Finset.Ico_succ_right_eq_Icc, Finset.sum_Ico_eq_sum_range]
    simpa [PowerSeries.coeff_derivative, Nat.add_comm, mul_comm] using hd

theorem log_odd_partial_sum_enclosure
    (v : ℝ) (hv0 : 0 ≤ v) (hv1 : v < 1) (M : ℕ) :
    0 ≤ Real.log ((1 + v) / (1 - v)) -
        2 * (∑ r ∈ Finset.range M,
          v ^ (2 * r + 1) / (2 * (r : ℝ) + 1)) ∧
      Real.log ((1 + v) / (1 - v)) -
          2 * (∑ r ∈ Finset.range M,
            v ^ (2 * r + 1) / (2 * (r : ℝ) + 1)) ≤
        2 * v ^ (2 * M + 1) /
          ((2 * (M : ℝ) + 1) * (1 - v ^ 2)) := by
  have hfull : HasSum
      (fun r : ℕ => 2 * (v ^ (2 * r + 1) / (2 * (r : ℝ) + 1)))
      (Real.log ((1 + v) / (1 - v))) := by
    convert Real.hasSum_log_sub_log_of_abs_lt_one
      (show |v| < 1 by rwa [abs_of_nonneg hv0]) using 1
    · ext r
      ring
    · rw [Real.log_div (by linarith) (by linarith)]
  have htail := (hasSum_nat_add_iff' M).2 hfull
  simp only [← Finset.mul_sum] at htail
  let C : ℝ := 2 * v ^ (2 * M + 1) / (2 * (M : ℝ) + 1)
  have hterm (n : ℕ) :
      2 * (v ^ (2 * (n + M) + 1) / (2 * ((n + M : ℕ) : ℝ) + 1)) ≤
        C * (v ^ 2) ^ n := by
    calc
      _ ≤ 2 * (v ^ (2 * (n + M) + 1) / (2 * (M : ℝ) + 1)) := by
        gcongr
        norm_num
      _ = C * (v ^ 2) ^ n := by
        rw [show 2 * (n + M) + 1 = (2 * M + 1) + 2 * n by omega, pow_add, pow_mul]
        dsimp [C]
        ring
  constructor
  · exact hasSum_le (fun n => by positivity) hasSum_zero htail
  · simpa only [C, ← div_eq_mul_inv, div_div] using
      hasSum_le hterm htail
        ((hasSum_geometric_of_lt_one (sq_nonneg v) ((sq_lt_one_iff₀ hv0).2 hv1)).mul_left C)

theorem one_mark_square_coeff_eq
    {ι : Type*} (A : Finset ι) (d r : ℕ)
    (c : ι → ℝ) (f : ι → Fin d → ℕ → ℝ)
    (B D : Fin d → ℕ → ℝ) :
    (∑ a ∈ A, ∑ b ∈ A, c a * c b *
      (PowerSeries.coeff r
        (∏ i : Fin d,
          (PowerSeries.mk (fun j : ℕ =>
            (Polynomial.C (B i j) + Polynomial.monomial 1 (D i j)) *
              Polynomial.C (f a i j * f b i j)) :
            PowerSeries (Polynomial ℝ)))).coeff 1) =
      ∑ j ∈ Finset.Nat.antidiagonalTuple d r,
        (∑ a ∈ A, c a * ∏ i : Fin d, f a i (j i)) ^ 2 *
          ∑ i : Fin d, D i (j i) *
            ∏ k ∈ (Finset.univ : Finset (Fin d)).erase i, B k (j k) := by
  have hseries (v : Fin d → ℕ → Polynomial ℝ) :
      PowerSeries.coeff r (∏ i : Fin d, PowerSeries.mk (v i)) =
        ∑ j ∈ Finset.Nat.antidiagonalTuple d r, ∏ i : Fin d, v i (j i) := by
    simp only [PowerSeries.coeff_prod, PowerSeries.coeff_mk,
      Finset.finsuppAntidiag, Finset.sum_map]
    rw [← Finset.piAntidiag_univ_fin_eq_antidiagonalTuple]
    exact Finset.sum_attach _ (fun j : Fin d → ℕ => ∏ i : Fin d, v i (j i))
  have hmark (b e : Fin d → ℝ) :
      (∏ i : Fin d, (Polynomial.C (b i) + Polynomial.monomial 1 (e i))).coeff 1 =
        ∑ i : Fin d, e i * ∏ k ∈ (Finset.univ : Finset (Fin d)).erase i, b k := by
    calc
      _ = (Polynomial.derivative
          (∏ i : Fin d, (Polynomial.C (b i) + Polynomial.monomial 1 (e i)))).coeff 0 := by
        simpa using (Polynomial.coeff_derivative
          (∏ i : Fin d, (Polynomial.C (b i) + Polynomial.monomial 1 (e i))) 0).symm
      _ = _ := by
        rw [Polynomial.derivative_prod_finset]
        simp [Polynomial.finsetSum_coeff, Polynomial.coeff_zero_prod, mul_comm]
  conv_lhs => simp only [hseries, Polynomial.finsetSum_coeff, Finset.mul_sum]
  simp_rw [Finset.sum_comm (s := A) (t := Finset.Nat.antidiagonalTuple d r)]
  apply Finset.sum_congr rfl
  intro j _
  simp_rw [Finset.prod_mul_distrib, ← map_prod Polynomial.C, Polynomial.coeff_mul_C, hmark]
  simp_rw [Finset.prod_mul_distrib]
  rw [pow_two, Finset.sum_mul_sum]
  conv_rhs => simp only [Finset.sum_mul]
  apply Finset.sum_congr rfl
  intro a _
  apply Finset.sum_congr rfl
  intro b _
  ring

theorem one_mark_square_sum_nonneg_le
    (d : ℕ) (s : Finset ℕ) (P : ℕ → (Fin d → ℕ) → ℝ)
    (B B' D D' : Fin d → ℕ → ℝ) (W W' : ℕ → ℝ)
    (hW : ∀ r ∈ s, 0 ≤ W r ∧ W r ≤ W' r)
    (hB : ∀ r ∈ s, ∀ i : Fin d, ∀ j ≤ r, 0 ≤ B i j ∧ B i j ≤ B' i j)
    (hD : ∀ r ∈ s, ∀ i : Fin d, ∀ j ≤ r, 0 ≤ D i j ∧ D i j ≤ D' i j) :
    let form := fun (b e : Fin d → ℕ → ℝ) (w : ℕ → ℝ) =>
      ∑ r ∈ s, w r *
        ∑ j ∈ Finset.Nat.antidiagonalTuple d r, P r j ^ 2 *
          ∑ i : Fin d, e i (j i) *
            ∏ k ∈ (Finset.univ : Finset (Fin d)).erase i, b k (j k)
    0 ≤ form B D W ∧ form B D W ≤ form B' D' W' := by
  have hcoord {r : ℕ} {j : Fin d → ℕ}
      (hj : j ∈ Finset.Nat.antidiagonalTuple d r) (i : Fin d) : j i ≤ r := by
    rw [← Finset.Nat.mem_antidiagonalTuple.mp hj]
    exact Finset.single_le_sum (fun _ _ => Nat.zero_le _) (Finset.mem_univ i)
  have hinner (r : ℕ) (hr : r ∈ s) :
      0 ≤ ∑ j ∈ Finset.Nat.antidiagonalTuple d r, P r j ^ 2 *
        ∑ i : Fin d, D i (j i) *
          ∏ k ∈ (Finset.univ : Finset (Fin d)).erase i, B k (j k) := by
    refine Finset.sum_nonneg fun j hj => mul_nonneg (sq_nonneg _) ?_
    refine Finset.sum_nonneg fun i _ => mul_nonneg (hD r hr i (j i) (hcoord hj i)).1 ?_
    exact Finset.prod_nonneg fun k _ => (hB r hr k (j k) (hcoord hj k)).1
  constructor
  · exact Finset.sum_nonneg fun r hr => mul_nonneg (hW r hr).1 (hinner r hr)
  · refine Finset.sum_le_sum fun r hr =>
      mul_le_mul (hW r hr).2 ?_ (hinner r hr) ((hW r hr).1.trans (hW r hr).2)
    refine Finset.sum_le_sum fun j hj => mul_le_mul_of_nonneg_left ?_ (sq_nonneg _)
    refine Finset.sum_le_sum fun i _ => ?_
    have hDi := hD r hr i (j i) (hcoord hj i)
    refine mul_le_mul hDi.2 ?_ ?_ (hDi.1.trans hDi.2)
    · exact Finset.prod_le_prod
        (fun k _ => (hB r hr k (j k) (hcoord hj k)).1)
        (fun k _ => (hB r hr k (j k) (hcoord hj k)).2)
    · exact Finset.prod_nonneg fun k _ => (hB r hr k (j k) (hcoord hj k)).1

/--
Dyadic lower and upper numerators at scale `2^640` for the one-step decay `exp (-189 * h)`. They
are obtained by reciprocating a degree-64 exponential Taylor sum and its geometric-tail upper
estimate, with outward rounding.
-/
def firstOuterLowExpRatio : ℕ × ℕ :=
  let S : ℕ := 2 ^ 640
  let v : ℚ := 189 * (2742997 / 258046918656)
  let E : ℚ :=
    ∑ r ∈ Finset.range 65, v ^ r / (r.factorial : ℚ)
  let R : ℚ :=
    v ^ 65 / ((65 : ℕ).factorial : ℚ) * (1 / (1 - v / 66))
  (⌊(S : ℚ) / (E + R)⌋₊, ⌈(S : ℚ) / E⌉₊)

/--
The first `J + 1` dyadic exponential-decay intervals, starting with the exact pair `(2^640,
2^640)`. Each step multiplies by the one-step ratio interval and rounds the lower endpoint down
and upper endpoint up.
-/
def firstOuterLowExpDyadicPrefix (J : ℕ) : Array (ℕ × ℕ) :=
  let S : ℕ := 2 ^ 640
  let q := firstOuterLowExpRatio
  (List.range J).foldl
    (fun (A : Array (ℕ × ℕ)) j =>
      let a := A.getD j (S, S)
      A.push (a.1 * q.1 / S, (a.2 * q.2 + S - 1) / S))
    #[(S, S)]

theorem rounded_reciprocal_spec
    (S : ℕ) (hS : 0 < S) (E R : ℚ) (hE : 1 ≤ E) (hR : 0 ≤ R)
    (hsmall : R ≤ 1 / (S : ℚ)) (z : ℝ)
    (hzlo : ((1 / (E + R) : ℚ) : ℝ) ≤ z)
    (hzhi : z ≤ ((1 / E : ℚ) : ℝ)) :
    let a := (⌊(S : ℚ) / (E + R)⌋₊, ⌈(S : ℚ) / E⌉₊)
    (a.1 : ℝ) / S ≤ z ∧ z ≤ (a.2 : ℝ) / S ∧ (a.2 : ℝ) / S ≤ 1 ∧
      z - (a.1 : ℝ) / S ≤ 2 / S ∧ (a.2 : ℝ) / S - z ≤ 2 / S := by
  have hSq : (0 : ℚ) < S := by exact_mod_cast hS
  have hEp : 0 < E := by linarith
  have hER : 0 < E + R := by linarith
  let l : ℚ := (⌊(S : ℚ) / (E + R)⌋₊ : ℚ) / S
  let u : ℚ := (⌈(S : ℚ) / E⌉₊ : ℚ) / S
  have hl : l ≤ 1 / (E + R) := by
    apply (div_le_iff₀ hSq).2
    have hf := Nat.floor_le (show 0 ≤ (S : ℚ) / (E + R) by positivity)
    convert hf using 1
    ring
  have hu : 1 / E ≤ u := by
    apply (le_div_iff₀ hSq).2
    have hc := Nat.le_ceil ((S : ℚ) / E)
    convert hc using 1
    ring
  have hu1 : u ≤ 1 := by
    apply (div_le_one₀ hSq).2
    exact_mod_cast
      (Nat.ceil_le.2 (show (S : ℚ) / E ≤ S from
        (div_le_iff₀ hEp).2 (by nlinarith)))
  have hlerr : 1 / (E + R) - l < 1 / (S : ℚ) := by
    apply (lt_div_iff₀ hSq).2
    calc
      (1 / (E + R) - l) * S =
          (S : ℚ) / (E + R) - (⌊(S : ℚ) / (E + R)⌋₊ : ℚ) := by
        dsimp [l]
        field_simp
      _ < 1 := Nat.self_sub_floor_lt_one _
  have huerr : u - 1 / E < 1 / (S : ℚ) := by
    apply (lt_div_iff₀ hSq).2
    calc
      (u - 1 / E) * S =
          (⌈(S : ℚ) / E⌉₊ : ℚ) - (S : ℚ) / E := by
        dsimp [u]
        field_simp
      _ < 1 := sub_lt_iff_lt_add'.2 (Nat.ceil_lt_add_one (by positivity))
  have hw : 1 / E - 1 / (E + R) ≤ R := by
    calc
      1 / E - 1 / (E + R) = R / (E * (E + R)) := by
        field_simp
        ring
      _ ≤ R := div_le_self hR (by nlinarith)
  have hlcast : (l : ℝ) = (⌊(S : ℚ) / (E + R)⌋₊ : ℝ) / S := by
    simp only [l, Rat.cast_div, Rat.cast_natCast]
  have hucast : (u : ℝ) = (⌈(S : ℚ) / E⌉₊ : ℝ) / S := by
    simp only [u, Rat.cast_div, Rat.cast_natCast]
  have hlreal : (l : ℝ) ≤ ((1 / (E + R) : ℚ) : ℝ) := by exact_mod_cast hl
  have hlz : (l : ℝ) ≤ z := hlreal.trans hzlo
  have hzu : z ≤ (u : ℝ) := hzhi.trans (by exact_mod_cast hu)
  have hup : (u : ℝ) ≤ 1 := by exact_mod_cast hu1
  have htwo : 2 / (S : ℚ) = 1 / S + 1 / S := by ring
  have hql : 1 / E - l ≤ 2 / (S : ℚ) := by rw [htwo]; linarith
  have hqu : u - 1 / (E + R) ≤ 2 / (S : ℚ) := by rw [htwo]; linarith
  have herrl : ((1 / E - l : ℚ) : ℝ) ≤ ((2 / (S : ℚ) : ℚ) : ℝ) := by
    exact_mod_cast hql
  have herru : ((u - 1 / (E + R) : ℚ) : ℝ) ≤ ((2 / (S : ℚ) : ℚ) : ℝ) := by
    exact_mod_cast hqu
  push_cast at herrl herru hzlo hzhi
  simpa only [hlcast, hucast] using
    And.intro hlz (And.intro hzu (And.intro hup
      (And.intro (by linarith : z - (l : ℝ) ≤ 2 / S)
        (by linarith : (u : ℝ) - z ≤ 2 / S))))

theorem firstOuterLowExpRatio_spec :
    let S : ℝ := 2 ^ 640
    let v : ℝ := 189 * (2742997 / 258046918656)
    let a := firstOuterLowExpRatio
    (a.1 : ℝ) / S ≤ Real.exp (-v) ∧
      Real.exp (-v) ≤ (a.2 : ℝ) / S ∧ (a.2 : ℝ) / S ≤ 1 ∧
      Real.exp (-v) - (a.1 : ℝ) / S ≤ 2 / S ∧
      (a.2 : ℝ) / S - Real.exp (-v) ≤ 2 / S := by
  let v : ℚ := 189 * (2742997 / 258046918656)
  let E : ℚ := ∑ r ∈ Finset.range 65, v ^ r / (r.factorial : ℚ)
  let R : ℚ := v ^ 65 / ((65 : ℕ).factorial : ℚ) * (1 / (1 - v / 66))
  have hv : 0 ≤ v := by norm_num [v]
  have hvhalf : (v : ℝ) ≤ 1 / 2 := by norm_num [v]
  have hE : 1 ≤ E := by
    have h := Finset.single_le_sum
      (f := fun r : ℕ => v ^ r / (r.factorial : ℚ))
      (fun r (_ : r ∈ Finset.range 65) => by positivity)
      (show 0 ∈ Finset.range 65 by simp)
    simpa only [pow_zero, Nat.factorial_zero, Nat.cast_one, div_one] using h
  have hden : 0 < 1 - v / 66 := by norm_num [v]
  have hR : 0 ≤ R := by dsimp [R]; positivity
  have hsmall : R ≤ 1 / ((2 ^ 640 : ℕ) : ℚ) := by
    have hvsmall : v ≤ 1 / (2 : ℚ) ^ 8 := by norm_num [v]
    have hfac : (2 : ℚ) ^ 128 ≤ (65 : ℕ).factorial := by
      norm_num [Nat.factorial]
    have ht : 1 / (1 - v / 66) ≤ (2 : ℚ) := by norm_num [v]
    calc
      R ≤ ((1 / (2 : ℚ) ^ 8) ^ 65 / (2 : ℚ) ^ 128) * 2 := by
        apply mul_le_mul
          (div_le_div₀ (by positivity) (pow_le_pow_left₀ hv hvsmall 65)
            (by positivity) hfac) ht (by positivity) (by positivity)
      _ ≤ 1 / ((2 ^ 640 : ℕ) : ℚ) := by
        rw [Nat.cast_pow, Nat.cast_ofNat, show (640 : ℕ) = 128 * 5 from rfl, pow_mul]
        norm_num
  have hEcast : (E : ℝ) =
      ∑ r ∈ Finset.range 65, (v : ℝ) ^ r / (r.factorial : ℝ) := by
    simp only [E, Rat.cast_sum, Rat.cast_div, Rat.cast_pow, Rat.cast_natCast]
  have hRcast : (R : ℝ) =
      (v : ℝ) ^ 65 / ((65 : ℕ).factorial : ℝ) * (1 / (1 - (v : ℝ) / 66)) := by
    simp only [R, Rat.cast_mul, Rat.cast_div, Rat.cast_pow, Rat.cast_natCast,
      Rat.cast_one, Rat.cast_sub, Rat.cast_ofNat]
  have he : 0 ≤ Real.exp (v : ℝ) - (E : ℝ) ∧
      Real.exp (v : ℝ) - (E : ℝ) ≤ (R : ℝ) := by
    simpa only [Nat.reduceAdd, Nat.cast_ofNat, ← hEcast, ← hRcast] using
      exp_sub_sum_range_le_geometric_tail (v : ℝ) 64 (by exact_mod_cast hv) hvhalf
  have hEp : (0 : ℝ) < E := by exact_mod_cast (show 0 < E by linarith)
  have hlo : ((1 / (E + R) : ℚ) : ℝ) ≤ Real.exp (-(v : ℝ)) := by
    rw [Real.exp_neg]
    push_cast
    simpa only [one_div] using one_div_le_one_div_of_le (Real.exp_pos (v : ℝ))
      (show Real.exp (v : ℝ) ≤ (E : ℝ) + (R : ℝ) by linarith [he.2])
  have hhi : Real.exp (-(v : ℝ)) ≤ ((1 / E : ℚ) : ℝ) := by
    rw [Real.exp_neg]
    push_cast
    simpa only [one_div] using one_div_le_one_div_of_le hEp
      (show (E : ℝ) ≤ Real.exp (v : ℝ) by linarith [he.1])
  have h := rounded_reciprocal_spec (2 ^ 640) (by positivity) E R hE hR hsmall
    (Real.exp (-(v : ℝ))) hlo hhi
  simpa only [firstOuterLowExpRatio, v, E, R, Nat.cast_pow, Nat.cast_ofNat,
    Rat.cast_mul, Rat.cast_div, Rat.cast_ofNat] using h

theorem nat_div_rounding_bounds (S n : ℕ) (hS : 0 < S) :
    0 ≤ (n : ℝ) / (S : ℝ) ^ 2 - ((n / S : ℕ) : ℝ) / (S : ℝ) ∧
      (n : ℝ) / (S : ℝ) ^ 2 - ((n / S : ℕ) : ℝ) / (S : ℝ) < 1 / (S : ℝ) ∧
      0 ≤ (((n + S - 1) / S : ℕ) : ℝ) / (S : ℝ) - (n : ℝ) / (S : ℝ) ^ 2 ∧
      (((n + S - 1) / S : ℕ) : ℝ) / (S : ℝ) - (n : ℝ) / (S : ℝ) ^ 2 <
        1 / (S : ℝ) := by
  have hs : (0 : ℝ) < S := by exact_mod_cast hS
  have hlo := Nat.div_mul_le_self n S
  have hhi := (Nat.div_lt_iff_lt_mul hS).1 (Nat.lt_succ_self (n / S))
  have hclo : n ≤ S * ((n + S - 1) / S) := by
    simpa only [Nat.ceilDiv_eq_add_pred_div] using
      (ceilDiv_le_iff_le_mul (a := S) (b := n) (c := n ⌈/⌉ S) hS).1 le_rfl
  have hchi : (n + S - 1) / S * S < n + S :=
    (Nat.div_mul_le_self (n + S - 1) S).trans_lt (by omega)
  have hf0 : ((n / S : ℕ) : ℝ) ≤ (n : ℝ) / (S : ℝ) :=
    (le_div_iff₀ hs).2 (by exact_mod_cast hlo)
  have hf1 : (n : ℝ) / (S : ℝ) < ((n / S : ℕ) : ℝ) + 1 :=
    (div_lt_iff₀ hs).2 (by exact_mod_cast hhi)
  have hc0 : (n : ℝ) / (S : ℝ) ≤ (((n + S - 1) / S : ℕ) : ℝ) :=
    (div_le_iff₀ hs).2 (by exact_mod_cast hclo.trans_eq (Nat.mul_comm _ _))
  have hc1 : (((n + S - 1) / S : ℕ) : ℝ) < (n : ℝ) / (S : ℝ) + 1 := by
    have hchi' : (((n + S - 1) / S : ℕ) : ℝ) * (S : ℝ) < (n : ℝ) + (S : ℝ) := by
      exact_mod_cast hchi
    simpa [add_div, hs.ne'] using (lt_div_iff₀ hs).2 hchi'
  have hd0 : 0 ≤ (n : ℝ) / (S : ℝ) - ((n / S : ℕ) : ℝ) := sub_nonneg.mpr hf0
  have hd1 : (n : ℝ) / (S : ℝ) - ((n / S : ℕ) : ℝ) < 1 := by linarith
  have hu0 : 0 ≤ (((n + S - 1) / S : ℕ) : ℝ) - (n : ℝ) / (S : ℝ) :=
    sub_nonneg.mpr hc0
  have hu1 : (((n + S - 1) / S : ℕ) : ℝ) - (n : ℝ) / (S : ℝ) < 1 := by linarith
  refine ⟨?_, ?_, ?_, ?_⟩
  · simpa only [sub_div, div_div, ← pow_two] using div_nonneg hd0 hs.le
  · simpa only [sub_div, div_div, ← pow_two] using div_lt_div_of_pos_right hd1 hs
  · simpa only [sub_div, div_div, ← pow_two] using div_nonneg hu0 hs.le
  · simpa only [sub_div, div_div, ← pow_two] using div_lt_div_of_pos_right hu1 hs

theorem exp_array_mul_encloses
    (S : ℕ) (hS : 0 < S) (q a : ℕ × ℕ) (z t E : ℝ)
    (hlo : (q.1 : ℝ) / S ≤ z) (hhi : z ≤ (q.2 : ℝ) / S)
    (hqhi : (q.2 : ℝ) / S ≤ 1)
    (hloerr : z - (q.1 : ℝ) / S ≤ 2 / S)
    (hhierr : (q.2 : ℝ) / S - z ≤ 2 / S)
    (ha : 0 ≤ (a.1 : ℝ) / S ∧ (a.1 : ℝ) / S ≤ t ∧
      t ≤ (a.2 : ℝ) / S ∧ (a.2 : ℝ) / S ≤ 1 ∧
      t - (a.1 : ℝ) / S ≤ E ∧ (a.2 : ℝ) / S - t ≤ E) :
    let b := (a.1 * q.1 / S, (a.2 * q.2 + S - 1) / S)
    0 ≤ (b.1 : ℝ) / S ∧ (b.1 : ℝ) / S ≤ t * z ∧
      t * z ≤ (b.2 : ℝ) / S ∧ (b.2 : ℝ) / S ≤ 1 ∧
      t * z - (b.1 : ℝ) / S ≤ E + 3 / S ∧
      (b.2 : ℝ) / S - t * z ≤ E + 3 / S := by
  have hs : (0 : ℝ) < S := by exact_mod_cast hS
  rcases ha with ⟨ha0, hat, hta, ha1, haerr, haerr'⟩
  have hz0 : 0 ≤ z := (div_nonneg (Nat.cast_nonneg _) hs.le).trans hlo
  have hz1 : z ≤ 1 := hhi.trans hqhi
  have ht0 : 0 ≤ t := ha0.trans hat
  have ht1 : t ≤ 1 := hta.trans ha1
  have ha1' : (a.1 : ℝ) / S ≤ 1 := hat.trans ht1
  have ha2 : a.2 ≤ S := by
    exact_mod_cast (by simpa using (div_le_iff₀ hs).1 ha1 : (a.2 : ℝ) ≤ S)
  have hq2 : q.2 ≤ S := by
    exact_mod_cast (by simpa using (div_le_iff₀ hs).1 hqhi : (q.2 : ℝ) ≤ S)
  have hceil : (a.2 * q.2 + S - 1) / S ≤ S := by
    rw [← Nat.ceilDiv_eq_add_pred_div]
    exact (ceilDiv_le_iff_le_mul hS).2 (Nat.mul_le_mul ha2 hq2)
  have hfloor := nat_div_rounding_bounds S (a.1 * q.1) hS
  have hupper := nat_div_rounding_bounds S (a.2 * q.2) hS
  simp only [Nat.cast_mul] at hfloor hupper
  have hprod (x y : ℕ) : (x : ℝ) * (y : ℝ) / (S : ℝ) ^ 2 =
      ((x : ℝ) / S) * ((y : ℝ) / S) := by ring
  rw [hprod] at hfloor hupper
  have hloProd := mul_le_mul hat hlo (div_nonneg (Nat.cast_nonneg _) hs.le) ht0
  have hhiProd := mul_le_mul hta hhi hz0 (ht0.trans hta)
  have hel := (mul_le_of_le_one_right (sub_nonneg.mpr hat) hz1).trans haerr
  have heq := (mul_le_of_le_one_left (sub_nonneg.mpr hlo) ha1').trans hloerr
  have heu := (mul_le_of_le_one_right (sub_nonneg.mpr hta) hqhi).trans haerr'
  have heq' := (mul_le_of_le_one_left (sub_nonneg.mpr hhi) ht1).trans hhierr
  have hbudget : (3 : ℝ) / S = 2 / S + 1 / S := by ring
  dsimp only
  refine ⟨div_nonneg (Nat.cast_nonneg _) hs.le, ?_, ?_, ?_, ?_, ?_⟩
  · linarith [hfloor.1]
  · linarith [hupper.2.2.1]
  · apply (div_le_iff₀ hs).2
    simpa only [one_mul] using (show (((a.2 * q.2 + S - 1) / S : ℕ) : ℝ) ≤ S by
      exact_mod_cast hceil)
  · rw [hbudget]
    nlinarith only [hel, heq, hfloor.2.1]
  · rw [hbudget]
    nlinarith only [heu, heq', hupper.2.2.2]

theorem exp_array_prefix_encloses
    (S : ℕ) (hS : 0 < S) (q : ℕ × ℕ) (z : ℝ)
    (hlo : (q.1 : ℝ) / S ≤ z) (hhi : z ≤ (q.2 : ℝ) / S)
    (hqhi : (q.2 : ℝ) / S ≤ 1)
    (hloerr : z - (q.1 : ℝ) / S ≤ 2 / S)
    (hhierr : (q.2 : ℝ) / S - z ≤ 2 / S) (J : ℕ) :
    let A : Array (ℕ × ℕ) :=
      (List.range J).foldl (fun A j =>
        let a := A.getD j (S, S)
        A.push (a.1 * q.1 / S, (a.2 * q.2 + S - 1) / S)) #[(S, S)]
    A.size = J + 1 ∧ A.getD 0 (S, S) = (S, S) ∧
      ∀ j ≤ J, let a := A.getD j (S, S)
        0 ≤ (a.1 : ℝ) / S ∧ (a.1 : ℝ) / S ≤ z ^ j ∧
        z ^ j ≤ (a.2 : ℝ) / S ∧ (a.2 : ℝ) / S ≤ 1 ∧
        z ^ j - (a.1 : ℝ) / S ≤ 3 * (j : ℝ) / S ∧
        (a.2 : ℝ) / S - z ^ j ≤ 3 * (j : ℝ) / S := by
  let F (n : ℕ) : Array (ℕ × ℕ) :=
    (List.range n).foldl (fun A j =>
      let a := A.getD j (S, S)
      A.push (a.1 * q.1 / S, (a.2 * q.2 + S - 1) / S)) #[(S, S)]
  change (F J).size = J + 1 ∧ (F J).getD 0 (S, S) = (S, S) ∧
    ∀ j ≤ J, let a := (F J).getD j (S, S)
      0 ≤ (a.1 : ℝ) / S ∧ (a.1 : ℝ) / S ≤ z ^ j ∧
      z ^ j ≤ (a.2 : ℝ) / S ∧ (a.2 : ℝ) / S ≤ 1 ∧
      z ^ j - (a.1 : ℝ) / S ≤ 3 * (j : ℝ) / S ∧
      (a.2 : ℝ) / S - z ^ j ≤ 3 * (j : ℝ) / S
  have hF (n : ℕ) : F (n + 1) =
      (F n).push (((F n).getD n (S, S)).1 * q.1 / S,
        (((F n).getD n (S, S)).2 * q.2 + S - 1) / S) := by
    simp only [F, List.range_succ, List.foldl_append, List.foldl_cons, List.foldl_nil]
  induction J with
  | zero =>
      refine ⟨by simp [F], by simp [F], ?_⟩
      intro j hj
      obtain rfl : j = 0 := by omega
      simp [F, hS.ne']
  | succ J ih =>
      rcases ih with ⟨hsize, hzero, hbounds⟩
      let a := (F J).getD J (S, S)
      let b := (a.1 * q.1 / S, (a.2 * q.2 + S - 1) / S)
      have hget (j : ℕ) (hj : j ≤ J) :
          (F (J + 1)).getD j (S, S) = (F J).getD j (S, S) := by
        simp only [hF, Array.getD_eq_getD_getElem?, Array.getElem?_push, hsize,
          show ¬ j = J + 1 by omega, ite_false]
      have hnew : (F (J + 1)).getD (J + 1) (S, S) = b := by
        simp only [hF, b, a, Array.getD_eq_getD_getElem?, Array.getElem?_push, hsize,
          ite_true, Option.getD_some]
      refine ⟨by rw [hF, Array.size_push, hsize], (hget 0 (Nat.zero_le J)).trans hzero, ?_⟩
      intro j hj
      dsimp only
      by_cases hj' : j ≤ J
      · simpa only [hget j hj'] using hbounds j hj'
      · have hjeq : j = J + 1 := by omega
        subst j
        rw [hnew]
        have hstep := exp_array_mul_encloses S hS q a z (z ^ J) (3 * (J : ℝ) / S)
          hlo hhi hqhi hloerr hhierr (hbounds J le_rfl)
        simpa only [b, pow_succ, Nat.cast_add, Nat.cast_one, mul_add, mul_one, add_div]
          using hstep

theorem firstOuterLowExp_lower (j : ℕ) (hj : j ≤ 98304) :
    (1 : ℝ) / 2 ^ 400 <
      Real.exp (-189 * (j : ℝ) * (2742997 / 258046918656)) := by
  have hjr : (j : ℝ) ≤ 98304 := by exact_mod_cast hj
  have ht : 189 * (j : ℝ) * (2742997 / 258046918656) < 200 := by
    nlinarith
  have hbase : Real.exp 1 < 4 := Real.exp_one_lt_three.trans (by norm_num)
  have he : Real.exp (189 * (j : ℝ) * (2742997 / 258046918656)) < (2 : ℝ) ^ 400 := by
    calc
      _ < Real.exp 200 := Real.exp_lt_exp.mpr ht
      _ = Real.exp 1 ^ 200 := by simp only [← Real.exp_nat_mul, Nat.cast_ofNat, mul_one]
      _ < (4 : ℝ) ^ 200 := pow_lt_pow_left₀ hbase (Real.exp_pos 1).le (by decide)
      _ = (2 : ℝ) ^ 400 := by rw [show (4 : ℝ) = 2 ^ 2 by norm_num, ← pow_mul]
  simpa only [one_div, ← Real.exp_neg, neg_mul] using
    one_div_lt_one_div_of_lt (Real.exp_pos _) he

theorem firstOuterLowExp_precision (j : ℕ) (hj : j ≤ 98304) :
    (3 * (j : ℚ)) / 2 ^ 640 ≤ 1 / 2 ^ 401 ∧
      (6 * (j : ℚ)) / 2 ^ 640 < 1 / 2 ^ 620 ∧
      ((1 : ℚ) / 2 ^ 620) * 2 ^ 164 ≤ 1 / 2 ^ 401 ∧
      (1 : ℚ) / 2 ^ 400 = 1 / 2 ^ 401 + 1 / 2 ^ 401 := by
  have hjq : (j : ℚ) ≤ 98304 := by exact_mod_cast hj
  have h400 : (2 : ℚ) ^ 400 = ((2 : ℚ) ^ 200) ^ 2 := by rw [← pow_mul]
  have h401 : (2 : ℚ) ^ 401 = ((2 : ℚ) ^ 200) ^ 2 * 2 := by
    rw [show 401 = 400 + 1 from rfl, pow_succ, h400]
  have h620 : (2 : ℚ) ^ 620 = ((2 : ℚ) ^ 124) ^ 5 := by rw [← pow_mul]
  have h640 : (2 : ℚ) ^ 640 = ((2 : ℚ) ^ 128) ^ 5 := by rw [← pow_mul]
  refine ⟨?_, ?_, ?_, ?_⟩
  · calc
      _ ≤ (3 * (98304 : ℚ)) / 2 ^ 640 := by gcongr
      _ ≤ 1 / 2 ^ 401 := by norm_num [h640, h401]
  · calc
      _ ≤ (6 * (98304 : ℚ)) / 2 ^ 640 := by gcongr
      _ < 1 / 2 ^ 620 := by norm_num [h640, h620]
  · norm_num [h620, h401]
  · norm_num [h400, h401]

theorem firstOuterLowExpDyadicPrefix_sound
    (J j : ℕ) (hj : j ≤ J) (hJ : J ≤ 98304) :
    let S : ℚ := 2 ^ 640
    let A := firstOuterLowExpDyadicPrefix J
    let a := A.getD j (2 ^ 640, 2 ^ 640)
    let lo : ℚ := (a.1 : ℚ) / S
    let hi : ℚ := (a.2 : ℚ) / S
    let h : ℝ := 2742997 / 258046918656
    A.size = J + 1 ∧
      0 < lo ∧ lo ≤ hi ∧ hi ≤ 1 ∧
      (lo : ℝ) ≤ Real.exp (-189 * (j : ℝ) * h) ∧
      Real.exp (-189 * (j : ℝ) * h) ≤ (hi : ℝ) ∧
      hi - lo ≤ (6 * (j : ℚ)) / S ∧
      hi - lo < (1 : ℚ) / 2 ^ 620 ∧
      (hi - lo) * (2 : ℚ) ^ 164 ≤ lo ∧
      (j = 0 → lo = 1 ∧ hi = 1) := by
  intro S A a lo hi h
  let v : ℝ := 189 * (2742997 / 258046918656)
  have hq := firstOuterLowExpRatio_spec
  dsimp only at hq
  have hA := exp_array_prefix_encloses (2 ^ 640) (by positivity) firstOuterLowExpRatio
    (Real.exp (-v))
    (by simpa only [Nat.cast_pow, Nat.cast_ofNat] using hq.1)
    (by simpa only [Nat.cast_pow, Nat.cast_ofNat] using hq.2.1)
    (by simpa only [Nat.cast_pow, Nat.cast_ofNat] using hq.2.2.1)
    (by simpa only [Nat.cast_pow, Nat.cast_ofNat] using hq.2.2.2.1)
    (by simpa only [Nat.cast_pow, Nat.cast_ofNat] using hq.2.2.2.2) J
  have hsize : A.size = J + 1 := hA.1
  have hzero : A.getD 0 (2 ^ 640, 2 ^ 640) = (2 ^ 640, 2 ^ 640) := hA.2.1
  have hb := hA.2.2 j hj
  change 0 ≤ (a.1 : ℝ) / ((2 ^ 640 : ℕ) : ℝ) ∧
    (a.1 : ℝ) / ((2 ^ 640 : ℕ) : ℝ) ≤ Real.exp (-v) ^ j ∧
    Real.exp (-v) ^ j ≤ (a.2 : ℝ) / ((2 ^ 640 : ℕ) : ℝ) ∧
    (a.2 : ℝ) / ((2 ^ 640 : ℕ) : ℝ) ≤ 1 ∧
    Real.exp (-v) ^ j - (a.1 : ℝ) / ((2 ^ 640 : ℕ) : ℝ) ≤
      3 * (j : ℝ) / ((2 ^ 640 : ℕ) : ℝ) ∧
    (a.2 : ℝ) / ((2 ^ 640 : ℕ) : ℝ) - Real.exp (-v) ^ j ≤
      3 * (j : ℝ) / ((2 ^ 640 : ℕ) : ℝ) at hb
  have hexp : Real.exp (-v) ^ j =
      Real.exp (-189 * (j : ℝ) * (2742997 / 258046918656)) := by
    rw [← Real.exp_nat_mul]
    congr 1
    dsimp [v]
    ring
  have hlcast : (lo : ℝ) = (a.1 : ℝ) / (2 : ℝ) ^ 640 := by
    simp only [lo, S, Rat.cast_div, Rat.cast_natCast, Rat.cast_pow, Rat.cast_ofNat]
  have hucast : (hi : ℝ) = (a.2 : ℝ) / (2 : ℝ) ^ 640 := by
    simp only [hi, S, Rat.cast_div, Rat.cast_natCast, Rat.cast_pow, Rat.cast_ofNat]
  simp only [Nat.cast_pow, Nat.cast_ofNat, ← hlcast, ← hucast, hexp] at hb
  have hjmax := hj.trans hJ
  have hp := firstOuterLowExp_precision j hjmax
  have he := firstOuterLowExp_lower j hjmax
  have herr : ((3 * (j : ℚ) / 2 ^ 640 : ℚ) : ℝ) ≤ ((1 / 2 ^ 401 : ℚ) : ℝ) :=
    (Rat.cast_le (K := ℝ)).2 hp.1
  have hhalf := congrArg (fun x : ℚ => (x : ℝ)) hp.2.2.2
  push_cast at herr hhalf
  have hlargeR : (1 : ℝ) / 2 ^ 401 < (lo : ℝ) := by
    have hle := hb.2.2.2.2.1.trans herr
    have hsum : (1 : ℝ) / 2 ^ 401 + 1 / 2 ^ 401 < (lo : ℝ) + 1 / 2 ^ 401 := by
      rw [← hhalf]
      exact he.trans_le (by simpa only [add_comm] using (sub_le_iff_le_add).1 hle)
    exact lt_of_add_lt_add_right hsum
  have hlarge : (1 : ℚ) / 2 ^ 401 < lo := by
    apply (Rat.cast_lt (K := ℝ)).1
    simpa only [Rat.cast_div, Rat.cast_one, Rat.cast_pow, Rat.cast_ofNat] using hlargeR
  have hlo : 0 < lo := (by positivity : (0 : ℚ) < 1 / 2 ^ 401).trans hlarge
  have hlohi : lo ≤ hi := by exact_mod_cast hb.2.1.trans hb.2.2.1
  have hhi1 : hi ≤ 1 := by exact_mod_cast hb.2.2.2.1
  have hdouble (x y : ℝ) : 3 * x / y + 3 * x / y = 6 * x / y := by ring
  have hwR : (hi : ℝ) - (lo : ℝ) ≤ 6 * (j : ℝ) / (2 : ℝ) ^ 640 := by
    simpa only [sub_add_sub_cancel, hdouble] using
      add_le_add hb.2.2.2.2.2 hb.2.2.2.2.1
  have hw : hi - lo ≤ (6 * (j : ℚ)) / S := by
    apply (Rat.cast_le (K := ℝ)).1
    simpa only [S, Rat.cast_sub, Rat.cast_div, Rat.cast_mul, Rat.cast_pow,
      Rat.cast_ofNat, Rat.cast_natCast] using hwR
  have hwidth : hi - lo < (1 : ℚ) / 2 ^ 620 := hw.trans_lt hp.2.1
  have hrel : (hi - lo) * (2 : ℚ) ^ 164 ≤ lo :=
    ((mul_le_mul_of_nonneg_right hwidth.le (by positivity)).trans hp.2.2.1).trans hlarge.le
  refine ⟨hsize, hlo, hlohi, hhi1, hb.2.1, hb.2.2.1, hw, hwidth, hrel, ?_⟩
  intro hjzero
  have ha : a = (2 ^ 640, 2 ^ 640) := by simpa only [a, hjzero] using hzero
  simp only [lo, hi, ha, S, Nat.cast_pow, Nat.cast_ofNat]
  constructor <;> exact div_self (by positivity)

/--
An upward-rounded exponential radial weight at precision `2^(-640)` on indices `94919` through
`95638`, and zero elsewhere. A degree-128 Taylor sum with a geometric-tail estimate is raised to
the fourth power before rounding.
-/
def firstOuterLowRadialDyadicWeight (r : ℕ) : ℚ :=
  if 94919 ≤ r ∧ r ≤ 95638 then
    let S : ℚ := 2 ^ 640
    let h : ℚ := 2742997 / 258046918656
    let U : ℚ := 7200342320019 / 6890569875110
    let v : ℚ := 189 * ((r : ℚ) * h - U + 3498 * h + 40 * h) / 4
    let E : ℚ :=
      ∑ k ∈ Finset.range 129, v ^ k / (k.factorial : ℚ)
    let R : ℚ :=
      v ^ 129 / ((129 : ℕ).factorial : ℚ) * (1 / (1 - v / 130))
    (⌈S * (E + R) ^ 4⌉₊ : ℚ) / S
  else
    0

theorem firstOuterLowRadial_remainder
    (v : ℚ) (hv : 0 ≤ v) (hvhalf : v < 1 / 2) :
    let R : ℚ := v ^ 129 / ((129 : ℕ).factorial : ℚ) * (1 / (1 - v / 130))
    0 ≤ R ∧ R < (1 : ℚ) / 2 ^ 768 := by
  have h32 : (2 : ℕ) ^ 96 ≤ (32 : ℕ).factorial := by norm_num [Nat.factorial]
  have h64 : (2 : ℕ) ^ 256 ≤ (64 : ℕ).factorial := by
    calc
      _ = (2 : ℕ) ^ 96 * 32 ^ 32 := by norm_num
      _ ≤ (32 : ℕ).factorial * 32 ^ 32 := Nat.mul_le_mul_right _ h32
      _ ≤ (64 : ℕ).factorial :=
        Nat.factorial_mul_pow_sub_le_factorial (show 32 ≤ 64 by decide)
  have h128 : (2 : ℕ) ^ 640 ≤ (128 : ℕ).factorial := by
    calc
      _ = (2 : ℕ) ^ 256 * 64 ^ 64 := by
        rw [show 640 = 256 + 6 * 64 from rfl, pow_add, pow_mul]
        norm_num
      _ ≤ (64 : ℕ).factorial * 64 ^ 64 := Nat.mul_le_mul_right _ h64
      _ ≤ (128 : ℕ).factorial :=
        Nat.factorial_mul_pow_sub_le_factorial (show 64 ≤ 128 by decide)
  have h129 : (2 : ℚ) ^ 640 ≤ ((129 : ℕ).factorial : ℚ) := by
    exact_mod_cast h128.trans (Nat.factorial_le (show 128 ≤ 129 by decide))
  have hden : 0 < 1 - v / 130 := by linarith
  have hinv : 1 / (1 - v / 130) < (2 : ℚ) := by
    apply (div_lt_iff₀ hden).2
    linarith
  have hbase : v ^ 129 / ((129 : ℕ).factorial : ℚ) ≤
      (1 / 2 : ℚ) ^ 129 / 2 ^ 640 :=
    div_le_div₀ (by positivity) (pow_le_pow_left₀ hv hvhalf.le 129) (by positivity) h129
  dsimp only
  refine ⟨mul_nonneg (div_nonneg (pow_nonneg hv _) (Nat.cast_nonneg _))
    (one_div_nonneg.mpr hden.le), ?_⟩
  calc
    _ ≤ ((1 / 2 : ℚ) ^ 129 / 2 ^ 640) * (1 / (1 - v / 130)) :=
      mul_le_mul_of_nonneg_right hbase (one_div_nonneg.mpr hden.le)
    _ < ((1 / 2 : ℚ) ^ 129 / 2 ^ 640) * 2 :=
      mul_lt_mul_of_pos_left hinv (by positivity)
    _ = (1 : ℚ) / 2 ^ 768 := by
      rw [show 640 = 128 * 5 from rfl, show 768 = 128 * 6 from rfl, pow_mul, pow_mul]
      norm_num

theorem rounded_quartic_encloses
    (E R : ℚ) (hE : 1 ≤ E) (hE3 : E < 3)
    (hR : 0 ≤ R) (hRsmall : R < 1 / 2 ^ 768)
    (z : ℝ) (hzlo : (E : ℝ) ≤ z) (hzhi : z ≤ ((E + R : ℚ) : ℝ)) :
    let S : ℚ := 2 ^ 640
    let W : ℚ := (⌈S * (E + R) ^ 4⌉₊ : ℚ) / S
    1 ≤ W ∧ z ^ 4 ≤ (W : ℝ) ∧
      (W : ℝ) - z ^ 4 < (2 : ℝ) / 2 ^ 640 := by
  intro S W
  have hS : 0 < S := by positivity
  have hE0 : 0 ≤ E := le_trans (by norm_num) hE
  have hR1 : R < 1 := hRsmall.trans_le
    ((div_le_one₀ (by positivity)).2 (one_le_pow₀ (by norm_num)))
  have hH0 : 0 ≤ E + R := add_nonneg hE0 hR
  have hH4 : E + R < 4 := by linarith
  have hEH : E ≤ E + R := le_add_of_nonneg_right hR
  have hpow : E ^ 4 ≤ (E + R) ^ 4 := pow_le_pow_left₀ hE0 hEH 4
  have hdiff : (E + R) ^ 4 - E ^ 4 ≤ R * 4 * (E + R) ^ 3 := by
    simpa only [abs_of_nonneg (sub_nonneg.mpr hpow), add_sub_cancel_left,
      abs_of_nonneg hR, abs_of_nonneg hH0, abs_of_nonneg hE0,
      max_eq_left hEH, Nat.reduceSub, Nat.cast_ofNat] using
      (abs_pow_sub_pow_le (E + R) E 4)
  have hdiff256 : (E + R) ^ 4 - E ^ 4 ≤ R * 256 := calc
    _ ≤ R * 4 * (E + R) ^ 3 := hdiff
    _ ≤ R * 4 * 4 ^ 3 := by gcongr
    _ = R * 256 := by ring
  have hscale : (1 / (2 : ℚ) ^ 768) * 256 ≤ 1 / S := by
    have hp : S * 256 ≤ (2 : ℚ) ^ 768 := calc
      _ = (2 : ℚ) ^ (640 + 8) := by
        rw [pow_add, show (2 : ℚ) ^ 8 = 256 by norm_num]
      _ ≤ (2 : ℚ) ^ 768 := pow_le_pow_right₀ (by norm_num) (by omega)
    calc
      _ = (256 : ℚ) / 2 ^ 768 := by rw [div_mul_eq_mul_div, one_mul]
      _ ≤ 1 / S := (div_le_div_iff₀ (by positivity) hS).2
        (by simpa only [one_mul, mul_comm] using hp)
  have htaylor : (E + R) ^ 4 - E ^ 4 < 1 / S :=
    hdiff256.trans_lt
      ((mul_lt_mul_of_pos_right hRsmall (by norm_num)).trans_le hscale)
  have hup : (E + R) ^ 4 ≤ W := by
    apply (le_div_iff₀ hS).2
    change (E + R) ^ 4 * S ≤ (⌈S * (E + R) ^ 4⌉₊ : ℚ)
    rw [mul_comm ((E + R) ^ 4) S]
    exact Nat.le_ceil (S * (E + R) ^ 4)
  have hround : W - (E + R) ^ 4 < 1 / S := by
    have hc := Nat.ceil_lt_add_one
      (show (0 : ℚ) ≤ S * (E + R) ^ 4 by positivity)
    apply (lt_div_iff₀ hS).2
    calc
      _ = (⌈S * (E + R) ^ 4⌉₊ : ℚ) - S * (E + R) ^ 4 := by
        dsimp only [W]
        rw [sub_mul, div_mul_cancel₀ _ hS.ne', mul_comm ((E + R) ^ 4) S]
      _ < 1 := (sub_lt_iff_lt_add').2 hc
  have hwidth : W - E ^ 4 < 2 / S := calc
    _ = (W - (E + R) ^ 4) + ((E + R) ^ 4 - E ^ 4) :=
      (sub_add_sub_cancel _ _ _).symm
    _ < 1 / S + 1 / S := add_lt_add hround htaylor
    _ = 2 / S := by rw [← add_div]; norm_num
  have hWone : 1 ≤ W := (one_le_pow₀ hE).trans (hpow.trans hup)
  have hE0R : (0 : ℝ) ≤ (E : ℝ) := by exact_mod_cast hE0
  have hz0 : 0 ≤ z := hE0R.trans hzlo
  have hzlo4 : (E : ℝ) ^ 4 ≤ z ^ 4 :=
    pow_le_pow_left₀ hE0R hzlo 4
  have hzhi4 : z ^ 4 ≤ (((E + R : ℚ) : ℝ)) ^ 4 :=
    pow_le_pow_left₀ hz0 hzhi 4
  have hupR : (((E + R : ℚ) : ℝ)) ^ 4 ≤ (W : ℝ) := by exact_mod_cast hup
  have hwidthR : (W : ℝ) - (E : ℝ) ^ 4 < (2 : ℝ) / 2 ^ 640 := by
    simpa only [S, Rat.cast_sub, Rat.cast_pow, Rat.cast_ofNat, Rat.cast_div] using
      (Rat.cast_lt (K := ℝ)).2 hwidth
  exact ⟨hWone, hzhi4.trans hupR,
    (sub_le_sub_left hzlo4 (W : ℝ)).trans_lt hwidthR⟩

theorem firstOuterLowRadialDyadicWeight_sound (r : ℕ) :
    let h : ℝ := 2742997 / 258046918656
    let U : ℝ := 7200342320019 / 6890569875110
    let x : ℝ := 189 * ((r : ℝ) * h - U + 3498 * h + 40 * h)
    let W : ℚ := firstOuterLowRadialDyadicWeight r
    0 ≤ W ∧
      (r < 94919 ∨ 95638 < r → W = 0) ∧
      (94919 ≤ r ∧ r ≤ 95638 →
        0 < x ∧ x < 2 ∧ 1 ≤ W ∧
          Real.exp x ≤ (W : ℝ) ∧
          (W : ℝ) - Real.exp x < (2 : ℝ) / 2 ^ 640) := by
  intro h U x W
  by_cases hr : 94919 ≤ r ∧ r ≤ 95638
  · have hrlo : (94919 : ℝ) ≤ r := by exact_mod_cast hr.1
    have hrhi : (r : ℝ) ≤ 95638 := by exact_mod_cast hr.2
    have hxpos : 0 < x := by
      dsimp only [x, h, U]
      nlinarith only [hrlo]
    have hxlt : x < 2 := by
      dsimp only [x, h, U]
      nlinarith only [hrhi]
    let hq : ℚ := 2742997 / 258046918656
    let Uq : ℚ := 7200342320019 / 6890569875110
    let v : ℚ := 189 * ((r : ℚ) * hq - Uq + 3498 * hq + 40 * hq) / 4
    let E : ℚ := ∑ k ∈ Finset.range 129, v ^ k / (k.factorial : ℚ)
    let R : ℚ := v ^ 129 / ((129 : ℕ).factorial : ℚ) * (1 / (1 - v / 130))
    have hvcast : (v : ℝ) = x / 4 := by
      simp only [v, hq, Uq, x, h, U, Rat.cast_div, Rat.cast_mul, Rat.cast_sub,
        Rat.cast_add, Rat.cast_natCast, Rat.cast_ofNat]
    have hvR : (0 : ℝ) ≤ v := by rw [hvcast]; positivity
    have hvhalfR : (v : ℝ) < 1 / 2 := by
      rw [hvcast]
      linarith only [hxlt]
    have hv : 0 ≤ v := by exact_mod_cast hvR
    have hvhalf : v < 1 / 2 := by
      apply (Rat.cast_lt (K := ℝ)).1
      simpa only [Rat.cast_div, Rat.cast_one, Rat.cast_ofNat] using hvhalfR
    have hE : 1 ≤ E := by
      have ht := Finset.single_le_sum
        (f := fun k : ℕ => v ^ k / (k.factorial : ℚ))
        (fun k (_ : k ∈ Finset.range 129) =>
          div_nonneg (pow_nonneg hv _) (Nat.cast_nonneg _))
        (show 0 ∈ Finset.range 129 by simp)
      simpa only [pow_zero, Nat.factorial_zero, Nat.cast_one, div_one] using ht
    have he : 0 ≤ Real.exp (v : ℝ) - (E : ℝ) ∧
        Real.exp (v : ℝ) - (E : ℝ) ≤ (R : ℝ) := by
      simpa only [E, R, Rat.cast_sum, Rat.cast_div, Rat.cast_pow, Rat.cast_natCast,
        Rat.cast_mul, Rat.cast_one, Rat.cast_sub, Rat.cast_ofNat, Nat.reduceAdd,
        Nat.cast_ofNat] using
        exp_sub_sum_range_le_geometric_tail (v : ℝ) 128 hvR hvhalfR.le
    have hlo : (E : ℝ) ≤ Real.exp (v : ℝ) := sub_nonneg.mp he.1
    have hhi : Real.exp (v : ℝ) ≤ ((E + R : ℚ) : ℝ) := by
      rw [Rat.cast_add, add_comm (E : ℝ) (R : ℝ)]
      exact (sub_le_iff_le_add).1 he.2
    have hE3 : E < 3 := by
      have hE3R : (E : ℝ) < 3 := calc
        _ ≤ Real.exp (v : ℝ) := hlo
        _ < Real.exp 1 := Real.exp_lt_exp.mpr (by linarith only [hvhalfR])
        _ < 3 := Real.exp_one_lt_three
      exact_mod_cast hE3R
    have hrm := firstOuterLowRadial_remainder v hv hvhalf
    change 0 ≤ R ∧ R < (1 : ℚ) / 2 ^ 768 at hrm
    have hk := rounded_quartic_encloses E R hE hE3 hrm.1 hrm.2
      (Real.exp (v : ℝ)) hlo hhi
    dsimp only at hk
    have hW : W = (⌈(2 : ℚ) ^ 640 * (E + R) ^ 4⌉₊ : ℚ) / 2 ^ 640 := by
      dsimp only [W]
      delta firstOuterLowRadialDyadicWeight
      rw [ite_eq_left hr]
    rw [← hW] at hk
    have hrestore : Real.exp (v : ℝ) ^ 4 = Real.exp x := by
      rw [← Real.exp_nat_mul]
      congr 1
      rw [hvcast]
      ring
    rw [hrestore] at hk
    refine ⟨le_trans (by norm_num) hk.1, ?_, ?_⟩
    · intro ho
      omega
    · intro _
      exact ⟨hxpos, hxlt, hk.1, hk.2.1, hk.2.2⟩
  · have hW : W = 0 := by
      dsimp only [W]
      delta firstOuterLowRadialDyadicWeight
      rw [ite_eq_right hr]
    exact ⟨by simp only [hW, le_refl], fun _ => hW, fun hc => False.elim (hr hc)⟩

/--
The dyadic interval for the selected renewal profile. After the stopping criterion is met it
returns an outward-rounded enclosure of `10^(-40)`; before then it uses the renewal-prefix
interval.
-/
def firstOuterLowSelectedRenewalInterval (j : ℕ) : ℚ × ℚ :=
  let I := dickmanRenewalDyadicPrefix 160 2331 98303
  let f : ℚ := 1 / 10 ^ 40
  let flo : ℚ := (f.toDyadic 160).toRat
  let fhi : ℚ := -(((-f).toDyadic 160).toRat)
  let stopped : Bool := (List.range (j + 1)).any
    (fun i => decide ((I.getD i (1, 1)).2 ≤ flo))
  if stopped then (flo, fhi) else I.getD j (1, 1)

/--
The lower and upper rational bounds for the discretized low-density coefficient at index `j`,
obtained by multiplying the mesh width, selected renewal interval, and dyadic exponential
interval.
-/
def firstOuterLowRenewalLowDensityInterval (j : ℕ) : ℚ × ℚ :=
  let h : ℚ := 2742997 / 258046918656
  let S : ℚ := 2 ^ 640
  let d := firstOuterLowSelectedRenewalInterval j
  let a := (firstOuterLowExpDyadicPrefix 98303).getD j (2 ^ 640, 2 ^ 640)
  (h * d.1 * ((a.1 : ℚ) / S), h * d.2 * ((a.2 : ℚ) / S))

/--
The ordinary coefficient convolution of two rational arrays truncated to `98304` entries.
Missing input entries are treated as zero.
-/
def firstOuterLowTruncatedConvolution (A B : Array ℚ) : Array ℚ :=
  Array.ofFn (fun j : Fin 98304 =>
    ∑ a ∈ Finset.range (j.val + 1), A.getD a 0 * B.getD (j.val - a) 0)

/--
The array of truncated coefficient arrays for `Q^r / r!`, from order zero through the requested
order, where `Q` has coefficient `1 / j` for `2331 ≤ j < 49152`. Each new order is formed by
convolution with `Q` followed by division by the order.
-/
def firstOuterLowHighPowerPrefix : ℕ → Array (Array ℚ) :=
  Nat.rec (motive := fun _ => Array (Array ℚ))
    #[Array.ofFn (fun j : Fin 98304 => if j.val = 0 then (1 : ℚ) else 0)]
    (fun r G =>
      let Q : Array ℚ := Array.ofFn (fun j : Fin 98304 =>
        if 2331 ≤ j.val ∧ j.val < 49152 then (j.val : ℚ)⁻¹ else 0)
      let P := firstOuterLowTruncatedConvolution
        (G.getD r (Array.replicate 98304 (0 : ℚ))) Q
      G.push (P.map (fun x => x / ((r : ℚ) + 1))))

/--
The `98304`-entry coefficient array of the normalized Eulerian carry polynomial, padded by zeros
outside degrees below `m`.
-/
def firstOuterLowEulerianCarryArray (m : ℕ) : Array ℚ :=
  Array.ofFn (fun j : Fin 98304 =>
    if j.val < m then (eulerianNumber m j.val : ℚ) / (m.factorial : ℚ) else 0)

/--
Lower and upper coefficient arrays for the renewal envelope kernel, formed by convolving the
low-density interval arrays with the common rational kernel. The kernel includes orders through
`42`, Eulerian carries below order `33`, coefficient-one tail envelopes, and the optional marked
factor.
-/
def firstOuterLowRenewalKernelBounds (e : Fin 2) : Array ℚ × Array ℚ :=
  let zero : Array ℚ := Array.replicate 98304 0
  let powers := firstOuterLowHighPowerPrefix 42
  let exactTerms : Array (Array ℚ) := Array.ofFn (fun r : Fin 33 =>
    firstOuterLowTruncatedConvolution (powers.getD r.val zero)
      (firstOuterLowEulerianCarryArray (r.val + e.val + 1)))
  let tailTerms : Array (Array ℚ) := Array.ofFn (fun s : Fin 10 =>
    let r : ℕ := s.val + 33
    let rep : Array ℚ := Array.ofFn (fun j : Fin 98304 =>
      if j.val < r + e.val + 1 then (1 : ℚ) else 0)
    firstOuterLowTruncatedConvolution (powers.getD r zero) rep)
  let T : Array ℚ := Array.ofFn (fun j : Fin 98304 =>
    (∑ r ∈ Finset.range 33, (exactTerms.getD r zero).getD j.val 0) +
      ∑ s ∈ Finset.range 10, (tailTerms.getD s zero).getD j.val 0)
  let mark : Array ℚ := Array.ofFn (fun j : Fin 98304 =>
    if 2331 ≤ j.val ∧ j.val < 3498 then (j.val : ℚ)⁻¹ else 0)
  let MT := if e.val = 0 then T else firstOuterLowTruncatedConvolution mark T
  let Dlo : Array ℚ := Array.ofFn (fun j : Fin 98304 =>
    (firstOuterLowRenewalLowDensityInterval j.val).1)
  let Dhi : Array ℚ := Array.ofFn (fun j : Fin 98304 =>
    (firstOuterLowRenewalLowDensityInterval j.val).2)
  (firstOuterLowTruncatedConvolution Dlo MT, firstOuterLowTruncatedConvolution Dhi MT)

/--
The coordinatewise renewal-kernel upper estimate, rounded upward to `192` dyadic bits. The
weight is uniform when `p = 0`, and otherwise is the squared midpoint trial profile normalized
by its discrete sum of squares; both cases include division by the mesh width.
-/
def firstOuterLowRenewalProfileCoordinateUpper (e p : Fin 2) : Array ℚ :=
  let h : ℚ := 2742997 / 258046918656
  let g : ℕ → ℚ := fun j =>
    let t : ℚ := ((j : ℚ) + 1 / 2) * h
    trialProfile t
  let Z : ℚ := ∑ j ∈ Finset.range 98264, (g j) ^ 2
  let K := (firstOuterLowRenewalKernelBounds e).2
  Array.ofFn (fun j : Fin 98264 =>
    let w : ℚ := if p.val = 0 then 1 else (g j.val) ^ 2 / Z
    let v : ℚ := w / h * K.getD j.val 0
    show ℚ from -(((-v).toDyadic 192).toRat))

theorem firstOuterLowSelectedRenewalInterval_eq (j : ℕ) :
    let I := dickmanRenewalDyadicPrefix 160 2331 98303
    let f : ℚ := 1 / 10 ^ 40
    let flo : ℚ := (f.toDyadic 160).toRat
    let fhi : ℚ := -(((-f).toDyadic 160).toRat)
    let stopped : Bool := (List.range (j + 1)).any
      (fun i => decide ((I.getD i (1, 1)).2 ≤ flo))
    firstOuterLowSelectedRenewalInterval j = if stopped then (flo, fhi) else I.getD j (1, 1) := by
  rfl

theorem firstOuterLowSelectedRenewalInterval_sound
    (j : ℕ) (hj : j < 98304) :
    let I := dickmanRenewalDyadicPrefix 160 2331 98303
    let f : ℚ := 1 / 10 ^ 40
    let flo : ℚ := (f.toDyadic 160).toRat
    let fhi : ℚ := -(((-f).toDyadic 160).toRat)
    let stopped : Bool := (List.range (j + 1)).any
      (fun i => decide ((I.getD i (1, 1)).2 ≤ flo))
    let d : ℚ := if stopped then f else (dickmanRenewalPrefix 2331 j).getD j 1
    let J := firstOuterLowSelectedRenewalInterval j
    0 < J.1 ∧ J.1 ≤ d ∧ d ≤ J.2 ∧
      J.2 - J.1 ≤ (2 * ((j : ℚ) + 1)) / 2 ^ 160 ∧
      dickmanRho ((j : ℝ) / 2331) ≤ (d : ℝ) ∧
      (81585 ≤ j → d = f ∧ J = (flo, fhi)) := by
  intro I f flo fhi stopped d J
  have sel := firstOuterLow_stopping_selection
  have rh : dickmanRho ((j : ℝ) / 2331) ≤ (d : ℝ) := (sel.2.2.2.2.1 j hj).2.2
  have hsfar : 81585 ≤ j → stopped = true := sel.2.2.2.1 j
  let eps : ℚ := 1 / 2 ^ 160
  have heps : 0 < eps := by dsimp only [eps]; positivity
  have hmesh : (2 : ℚ) ^ (-(160 : ℤ)) = eps := by norm_num [eps]
  have hJdef : J = if stopped then (flo, fhi) else I.getD j (1, 1) :=
    firstOuterLowSelectedRenewalInterval_eq j
  have prefix_width (lo hi t : ℚ) (j : ℕ) (h1 : t - lo ≤ (j : ℚ) * eps)
      (h2 : hi - t ≤ (j : ℚ) * eps) : hi - lo ≤ (2 * ((j : ℚ) + 1)) / 2 ^ 160 := by
    calc
      hi - lo = (hi - t) + (t - lo) := by ring
      _ ≤ (j : ℚ) * eps + (j : ℚ) * eps := add_le_add h2 h1
      _ ≤ 2 * ((j : ℚ) + 1) / 2 ^ 160 := by
        have hj0 : (0 : ℚ) ≤ j := by positivity
        dsimp only [eps]
        nlinarith [heps]
  by_cases hs : stopped = true
  · have e1 := renewal_dyadic_round_error (160 : ℤ) f
    have e2 := renewal_dyadic_round_error (160 : ℤ) (-f)
    rw [hmesh] at e1 e2
    have hlo : 0 < flo := firstOuterLow_renewalIntervals_sound.2.1
    have hjnn : (1 : ℚ) ≤ (j : ℚ) + 1 := by linarith [show (0 : ℚ) ≤ j by positivity]
    have hb : fhi - flo ≤ (2 * ((j : ℚ) + 1)) / 2 ^ 160 := by
      have ht : 2 * eps ≤ (2 * ((j : ℚ) + 1)) * eps := by nlinarith [heps]
      have hw : fhi - flo < 2 * eps := by
        dsimp only [flo, fhi]
        linarith [e1.2, e2.2]
      simpa only [eps, mul_div_assoc, div_eq_mul_inv, one_mul] using hw.le.trans ht
    have hd : d = f := by simp only [d, hs, ite_true]
    have hJ : J = (flo, fhi) := by rw [hJdef, ite_eq_left hs]
    rw [hJ, hd]
    exact ⟨hlo, sub_nonneg.mp e1.1, by dsimp only [fhi]; linarith [e2.1], hb,
      by simpa only [hd] using rh, fun _ => ⟨rfl, rfl⟩⟩
  · let R : ℚ := (dickmanRenewalPrefix 2331 j).getD j 1
    have hJ : J = I.getD j (1, 1) := by rw [hJdef, ite_eq_right hs]
    have hd : d = R := by dsimp only [d]; rw [ite_eq_right hs]
    have hp := (sel.2.2.2.2.2.2 j hj)
    change let selected : ℚ × ℚ := if stopped then (f, f) else I.getD j (1, 1)
      0 < selected.1 ∧ selected.1 ≤ d ∧ d ≤ selected.2 at hp
    simp only [ite_eq_right hs] at hp
    have hlo : 0 < (I.getD j (1, 1)).1 := hp.1
    have hi := sel.1 j hj
    have hb := firstOuterLow_renewalIntervals_sound.1 j
    dsimp only at hb
    rw [← hi] at hb
    have hw : (I.getD j (1, 1)).2 - (I.getD j (1, 1)).1 ≤
        (2 * ((j : ℚ) + 1)) / 2 ^ 160 := prefix_width
      (I.getD j (1, 1)).1 (I.getD j (1, 1)).2 R j hb.2.2.1 hb.2.2.2
    refine ⟨hJ ▸ hlo, ?_, ?_, hJ ▸ hw, rh, ?_⟩
    · rw [hJ, hd]; exact hb.1
    · rw [hJ, hd]; exact hb.2.1
    · intro hjfar
      exact False.elim (hs (hsfar hjfar))

theorem array_getD_ofFn {α : Type*} {N : ℕ} (F : Fin N → α) (z : α)
    (i : ℕ) (hi : i < N) :
    (Array.ofFn F).getD i z = F ⟨i, hi⟩ := by
  have hi' : i < (Array.ofFn F).size := by simpa using hi
  rw [← Array.getElem_eq_getD (h := hi') z, Array.getElem_ofFn]

theorem coeff_sum_monomial_eq_ite {k : Type*} [Semiring k]
    (s : Finset ℕ) (w : ℕ → k) (i : ℕ) :
    (∑ a ∈ s, Polynomial.monomial a (w a)).coeff i =
      if i ∈ s then w i else 0 := by
  classical
  simp [Polynomial.coeff_monomial, eq_comm]

theorem coeff_sum_range_X_pow (m i : ℕ) :
    (∑ a ∈ Finset.range m, (Polynomial.X : Polynomial ℚ) ^ a).coeff i =
      if i < m then 1 else 0 := by
  simp [Polynomial.coeff_X_pow]

theorem firstOuterLowTruncatedConvolution_getD_eq_coeff_mul
    (A B : Array ℚ) (P Q : Polynomial ℚ)
    (hA : ∀ i < 98304, A.getD i 0 = P.coeff i)
    (hB : ∀ i < 98304, B.getD i 0 = Q.coeff i)
    (j : ℕ) (hj : j < 98304) :
    (firstOuterLowTruncatedConvolution A B).getD j 0 = (P * Q).coeff j := by
  rw [Polynomial.coeff_mul, Finset.Nat.sum_antidiagonal_eq_sum_range_succ_mk]
  rw [firstOuterLowTruncatedConvolution, array_getD_ofFn _ 0 j hj]
  apply Finset.sum_congr rfl
  intro a ha
  have ha' := Finset.mem_range.mp ha
  rw [hA a (by omega), hB (j - a) (by omega)]

theorem firstOuterLowEulerianCarryArray_getD_eq_coeff (m : ℕ) :
    ∀ i < 98304, (firstOuterLowEulerianCarryArray m).getD i 0 =
      (eulerianCarryPolynomial m).coeff i := by
  classical
  intro i hi
  rw [firstOuterLowEulerianCarryArray, array_getD_ofFn _ 0 i hi]
  rw [eulerianCarryPolynomial, coeff_sum_monomial_eq_ite]
  simp only [Finset.mem_range]

theorem replicationArray_getD_eq_coeff (m i : ℕ) (hi : i < 98304) :
    (Array.ofFn (fun j : Fin 98304 => if j.val < m then (1 : ℚ) else 0)).getD i 0 =
      (∑ a ∈ Finset.range m, (Polynomial.X : Polynomial ℚ) ^ a).coeff i := by
  rw [array_getD_ofFn _ 0 i hi, coeff_sum_range_X_pow]

theorem reciprocalArray_getD_eq_coeff (A B i : ℕ) (hi : i < 98304) :
    (Array.ofFn (fun j : Fin 98304 => if A ≤ j.val ∧ j.val < B
      then (j.val : ℚ)⁻¹ else 0)).getD i 0 =
    (∑ a ∈ Finset.Ico A B, Polynomial.monomial a ((a : ℚ)⁻¹)).coeff i := by
  rw [array_getD_ofFn _ 0 i hi, coeff_sum_monomial_eq_ite]
  simp only [Finset.mem_Ico]

theorem firstOuterLowRenewalLowDensityInterval_encloses (a : ℕ) (ha : a < 98304) :
    let stopped : Bool := (List.range (a + 1)).any (fun i => decide
      (((dickmanRenewalDyadicPrefix 160 2331 98303).getD i (1, 1)).2 ≤
        ((1 / 10 ^ 40 : ℚ).toDyadic 160).toRat))
    let d : ℚ := if stopped then 1 / 10 ^ 40 else (dickmanRenewalPrefix 2331 a).getD a 1
    let D := firstOuterLowRenewalLowDensityInterval a
    let h : ℝ := 2742997 / 258046918656
    0 ≤ D.1 ∧ D.1 ≤ D.2 ∧
      (D.1 : ℝ) ≤ h * (d : ℝ) * Real.exp (-189 * (a : ℝ) * h) ∧
      h * (d : ℝ) * Real.exp (-189 * (a : ℝ) * h) ≤ (D.2 : ℝ) := by
  intro stopped d D h
  have hsel := firstOuterLowSelectedRenewalInterval_sound a ha
  have hex := firstOuterLowExpDyadicPrefix_sound 98303 a (by omega) (by omega)
  let J := firstOuterLowSelectedRenewalInterval a
  let lo : ℚ :=
    (((firstOuterLowExpDyadicPrefix 98303).getD a (2 ^ 640, 2 ^ 640)).1 : ℚ) / (2 ^ 640 : ℚ)
  let hi : ℚ :=
    (((firstOuterLowExpDyadicPrefix 98303).getD a (2 ^ 640, 2 ^ 640)).2 : ℚ) / (2 ^ 640 : ℚ)
  let hq : ℚ := 2742997 / 258046918656
  have hhq : 0 < hq := by norm_num [hq]
  have hh : (hq : ℝ) = h := by norm_num [hq, h]
  have hD1 : D.1 = hq * J.1 * lo := rfl
  have hD2 : D.2 = hq * J.2 * hi := rfl
  have hla : 0 ≤ lo := hex.2.1.le
  have hdd : 0 ≤ d := (hsel.1.trans_le hsel.2.1).le
  have hja : 0 ≤ J.1 := hsel.1.le
  have hJa : J.1 ≤ J.2 := (hsel.2.1).trans hsel.2.2.1
  have hLo : lo ≤ hi := hex.2.2.1
  have hUp : 0 ≤ hi := hla.trans hLo
  have hDa : 0 ≤ D.1 := hD1.symm ▸ mul_nonneg (mul_nonneg hhq.le hja) hla
  have hMono : D.1 ≤ D.2 := by
    rw [hD1, hD2]
    exact mul_le_mul (mul_le_mul_of_nonneg_left hJa hhq.le) hLo hla
      (mul_nonneg hhq.le (hja.trans hJa))
  have hLreal : (lo : ℝ) ≤ Real.exp (-189 * (a : ℝ) * h) := hex.2.2.2.2.1
  have hUreal : Real.exp (-189 * (a : ℝ) * h) ≤ (hi : ℝ) := hex.2.2.2.2.2.1
  have jlow : (J.1 : ℝ) ≤ (d : ℝ) := by exact_mod_cast hsel.2.1
  have dupp : (d : ℝ) ≤ (J.2 : ℝ) := by exact_mod_cast hsel.2.2.1
  refine ⟨hDa, hMono, ?_, ?_⟩
  · rw [hD1, Rat.cast_mul, Rat.cast_mul, hh]
    exact mul_le_mul (mul_le_mul_of_nonneg_left jlow (by rw [← hh]; exact_mod_cast hhq.le))
      hLreal (by exact_mod_cast hla) (by rw [← hh]; exact_mod_cast (mul_nonneg hhq.le hdd))
  · rw [hD2, Rat.cast_mul, Rat.cast_mul, hh]
    exact mul_le_mul (mul_le_mul_of_nonneg_left dupp (by rw [← hh]; exact_mod_cast hhq.le))
      hUreal (Real.exp_pos _).le
      (by rw [← hh]; exact_mod_cast (mul_nonneg hhq.le ((hja.trans hJa))))

section
open Set

theorem eulerianNumber_eq_alternating_sum (m a : ℕ) (hm : 0 < m) :
    (eulerianNumber m a : ℝ) =
      ∑ b ∈ Finset.range (a + 2),
        (-1 : ℝ) ^ b * ((m + 1).choose b : ℝ) *
          ((a : ℝ) + 1 - (b : ℝ)) ^ m := by
  calc
    _ = ∑ b ∈ Finset.range (m + 2),
        (-1 : ℝ) ^ b * ((m + 1).choose b : ℝ) *
          (max ((a : ℝ) + 1 - (b : ℝ)) 0) ^ m := by
      rw [← fwdDiff_iter_posPart_pow_eq_eulerian m a hm, fwdDiff_iter_eq_sum_shift,
        ← Finset.sum_range_reflect]
      apply Finset.sum_congr rfl
      intro b hb
      have hb' : b ≤ m + 1 := Nat.le_of_lt_succ (Finset.mem_range.mp hb)
      simp only [show m + 1 + 1 - 1 = m + 1 by omega]
      rw [Nat.sub_sub_self hb', Nat.choose_symm hb']
      simp only [zsmul_eq_mul, Int.cast_mul, Int.cast_pow, Int.cast_neg, Int.cast_one,
        Int.cast_natCast, nsmul_eq_mul, mul_one, Nat.cast_sub hb', Nat.cast_add,
        Nat.cast_one]
      congr 3
      ring
    _ = ∑ b ∈ Finset.range (a + 2),
        (-1 : ℝ) ^ b * ((m + 1).choose b : ℝ) *
          (max ((a : ℝ) + 1 - (b : ℝ)) 0) ^ m := by
      rcases le_total (m + 2) (a + 2) with h | h
      · apply Finset.sum_subset (Finset.range_mono h)
        intro b _ hb
        have hb' : m + 2 ≤ b := Nat.le_of_not_gt fun h' => hb (Finset.mem_range.mpr h')
        rw [Nat.choose_eq_zero_of_lt (by omega : m + 1 < b)]
        simp
      · symm
        apply Finset.sum_subset (Finset.range_mono h)
        intro b _ hb
        have hb' : a + 2 ≤ b := Nat.le_of_not_gt fun h' => hb (Finset.mem_range.mpr h')
        have hab : (a : ℝ) + 1 ≤ b := by exact_mod_cast (show a + 1 ≤ b by omega)
        rw [max_eq_right (sub_nonpos.mpr hab), zero_pow hm.ne', mul_zero]
    _ = _ := by
      apply Finset.sum_congr rfl
      intro b hb
      have hab : (b : ℝ) ≤ (a : ℝ) + 1 := by
        exact_mod_cast Nat.le_of_lt_succ (Finset.mem_range.mp hb)
      rw [max_eq_left (sub_nonneg.mpr hab)]

end

theorem exists_rat_log_normalization
    (x : ℚ) (hx : 0 < x) :
    ∃ (b : ℤ) (y : ℚ),
      x = (2 : ℚ) ^ b * y ∧ 1 ≤ y ∧ y < 2 ∧
        Real.log (x : ℝ) =
          (b : ℝ) * Real.log 2 + Real.log (y : ℝ) := by
  obtain ⟨b, hlo, hhi⟩ := exists_mem_Ico_zpow hx (by norm_num : (1 : ℚ) < 2)
  have hb : 0 < (2 : ℚ) ^ b := zpow_pos (by norm_num) b
  let y : ℚ := x / (2 : ℚ) ^ b
  have hxy : x = (2 : ℚ) ^ b * y := (mul_div_cancel₀ x hb.ne').symm
  refine ⟨b, y, hxy, (one_le_div₀ hb).2 hlo, ?_, ?_⟩
  · apply (div_lt_iff₀' hb).2
    simpa [zpow_add_one₀ (by norm_num : (2 : ℚ) ≠ 0)] using hhi
  · rw [hxy, Rat.cast_mul, Rat.cast_zpow, Rat.cast_ofNat,
      Real.log_mul (by positivity) (by positivity), Real.log_zpow]

theorem tendsto_logarithm_remainder_bound_zero
    (v : ℝ) (hv : 0 ≤ v) (hvone : v < 1) :
    Filter.Tendsto
      (fun M : ℕ =>
        2 * v ^ (2 * M + 1) /
          ((2 * (M : ℝ) + 1) * (1 - v ^ 2)))
      Filter.atTop (nhds 0) := by
  have hs : v ^ 2 < 1 := (sq_lt_one_iff₀ hv).2 hvone
  have hd : 0 < 1 - v ^ 2 := sub_pos.mpr hs
  refine squeeze_zero (fun M => by positivity) (fun M => ?_)
    (by
      simpa using Filter.Tendsto.const_mul (2 * v / (1 - v ^ 2))
        (tendsto_pow_atTop_nhds_zero_of_lt_one (sq_nonneg v) hs))
  calc
    _ ≤ 2 * v ^ (2 * M + 1) / (1 - v ^ 2) :=
      div_le_div_of_nonneg_left (by positivity) hd (by
        nlinarith [Nat.cast_nonneg (α := ℝ) M])
    _ = (2 * v / (1 - v ^ 2)) * (v ^ 2) ^ M := by
      rw [pow_succ, pow_mul]
      ring

theorem tendsto_exponential_remainder_bound_zero
    (v : ℝ) (hv : 0 ≤ v) (hvhalf : v ≤ 1 / 2) :
    Filter.Tendsto
      (fun M : ℕ =>
        v ^ (M + 1) / ((M + 1).factorial : ℝ) *
          (1 / (1 - v / ((M + 2 : ℕ) : ℝ))))
      Filter.atTop (nhds 0) := by
  have hq (M : ℕ) : v / ((M + 2 : ℕ) : ℝ) ≤ 1 / 2 :=
    (div_le_self hv (by exact_mod_cast (show 1 ≤ M + 2 by omega))).trans hvhalf
  have hd (M : ℕ) : 0 < 1 - v / ((M + 2 : ℕ) : ℝ) := by
    linarith [hq M]
  refine squeeze_zero (fun M => ?_) (fun M => ?_)
    (by
      simpa using Filter.Tendsto.const_mul (2 * v)
        (tendsto_pow_atTop_nhds_zero_of_lt_one hv (by linarith : v < 1)))
  · have := hd M
    positivity
  · have hf : 1 ≤ ((M + 1).factorial : ℝ) := by
      exact_mod_cast Nat.succ_le_of_lt (Nat.factorial_pos (M + 1))
    have hr : 1 / (1 - v / ((M + 2 : ℕ) : ℝ)) ≤ 2 := by
      apply (div_le_iff₀ (hd M)).2
      linarith [hq M]
    calc
      _ ≤ v ^ (M + 1) * 2 :=
        mul_le_mul (div_le_self (pow_nonneg hv _) hf) hr
          (one_div_nonneg.mpr (hd M).le) (pow_nonneg hv _)
      _ = (2 * v) * v ^ M := by
        rw [pow_succ]
        ring

theorem eulerianNumber_zero_right (m : ℕ) : eulerianNumber m 0 = 1 := by
  induction m with
  | zero => rfl
  | succ m ih =>
      change 1 * eulerianNumber m 0 + 0 = 1
      simpa only [one_mul, add_zero] using ih

/--
The rational outer-row budget `k * a + b / k`, decoding `k` at scale `10^6` and the two estimate
entries at scale `10^18`.
-/
def outerBoundRowBudget (r : OuterBoundRow) : ℚ :=
  ((r.1 : ℚ) / 10 ^ 6) * ((r.2.1 : ℚ) / 10 ^ 18) +
    ((r.2.2.1 : ℚ) / 10 ^ 18) / ((r.1 : ℚ) / 10 ^ 6)

/--
The rational inner-row budget, multiplying `k` by the row's estimate decoded at scale `10^18`.
-/
def innerBoundRowBudget (k : ℚ) (r : InnerBoundRow) : ℚ := k * ((r.1 : ℚ) / 10 ^ 18)

theorem outerBoundRows_rounding : ∀ r ∈ outerOrderTwoBounds ++ outerOrderFiveHalvesBounds,
    0 < r.1 ∧ ((r.2.2.2 : ℚ) - 1) / 10 ^ 12 < outerBoundRowBudget r ∧
      outerBoundRowBudget r ≤ (r.2.2.2 : ℚ) / 10 ^ 12 := by
  norm_num [outerOrderTwoBounds, outerOrderFiveHalvesBounds, outerBoundRowBudget]

theorem innerBaseBoundRows_rounding :
    ∀ r ∈ innerBaseOrderTwoBounds ++ innerBaseOrderFiveHalvesBounds,
    ((r.2 : ℚ) - 1) / 10 ^ 12 < innerBoundRowBudget (44415113 / 5000000000) r ∧
      innerBoundRowBudget (44415113 / 5000000000) r ≤ (r.2 : ℚ) / 10 ^ 12 := by
  norm_num [innerBaseOrderTwoBounds, innerBaseOrderFiveHalvesBounds, innerBoundRowBudget]

theorem innerEnlargedBoundRows_rounding :
    ∀ r ∈ innerEnlargedOrderTwoBounds ++ innerEnlargedOrderFiveHalvesBounds,
    ((r.2 : ℚ) - 1) / 10 ^ 12 < innerBoundRowBudget (1000843183 / 1000000000) r ∧
      innerBoundRowBudget (1000843183 / 1000000000) r ≤ (r.2 : ℚ) / 10 ^ 12 := by
  norm_num [innerEnlargedOrderTwoBounds, innerEnlargedOrderFiveHalvesBounds, innerBoundRowBudget]

/--
The sums of the stored integer totals for the six audit groups, ordered as the two outer groups,
the two base inner groups, and the two enlarged inner groups.
-/
def sourceErrorGroupTotals : List ℕ :=
  [(outerOrderTwoBounds.map fun r => r.2.2.2).sum,
   (outerOrderFiveHalvesBounds.map fun r => r.2.2.2).sum,
   (innerBaseOrderTwoBounds.map Prod.snd).sum,
   (innerBaseOrderFiveHalvesBounds.map Prod.snd).sum,
   (innerEnlargedOrderTwoBounds.map Prod.snd).sum,
   (innerEnlargedOrderFiveHalvesBounds.map Prod.snd).sum]

theorem sourceErrorGroupTotals_eq :
    sourceErrorGroupTotals = [38927522, 622829241, 55254, 435544, 1405159, 32422390] := by
  decide

theorem sourceBoundRows_lengths :
    [outerOrderTwoBounds.length, outerOrderFiveHalvesBounds.length, innerBaseOrderTwoBounds.length,
      innerBaseOrderFiveHalvesBounds.length, innerEnlargedOrderTwoBounds.length,
      innerEnlargedOrderFiveHalvesBounds.length] =
      [17, 35, 7, 10, 11, 17] ∧
    outerOrderTwoBounds.length + outerOrderFiveHalvesBounds.length +
      innerBaseOrderTwoBounds.length +
      innerBaseOrderFiveHalvesBounds.length + innerEnlargedOrderTwoBounds.length +
        innerEnlargedOrderFiveHalvesBounds.length = 97 := by
  decide

theorem sourceErrorGroupTotals_sum : sourceErrorGroupTotals.sum = 696075110 := by decide

theorem source_error_budget_lt_697_div_million :
    (sourceErrorGroupTotals.sum : ℚ) / 10 ^ 12 < 697 / 10 ^ 6 := by
  rw [sourceErrorGroupTotals_sum]
  norm_num

theorem source_error_budget_margin :
    (697 : ℚ) / 10 ^ 6 - (sourceErrorGroupTotals.sum : ℚ) / 10 ^ 12 = 924890 / 10 ^ 12 := by
  rw [sourceErrorGroupTotals_sum]
  norm_num

theorem exists_rat_log_interval_recombination
    (x : ℚ) (hx : 0 < x) :
    ∃ (b : ℤ) (y : ℚ),
      x = (2 : ℚ) ^ b * y ∧ 1 ≤ y ∧ y < 2 ∧
        ∀ M : ℕ,
          let v : ℚ := (y - 1) / (y + 1)
          let P : ℚ → ℚ := fun z =>
            2 * (∑ r ∈ Finset.range M,
              z ^ (2 * r + 1) / (2 * (r : ℚ) + 1))
          let R : ℚ → ℚ := fun z =>
            2 * z ^ (2 * M + 1) /
              ((2 * (M : ℚ) + 1) * (1 - z ^ 2))
          let c : ℚ := (b : ℚ) * P (1 / 3) + P v
          let lo : ℚ := c + min (b : ℚ) 0 * R (1 / 3)
          let hi : ℚ := c + max (b : ℚ) 0 * R (1 / 3) + R v
          (lo : ℝ) ≤ Real.log (x : ℝ) ∧
            Real.log (x : ℝ) ≤ (hi : ℝ) ∧
              hi - lo = |(b : ℚ)| * R (1 / 3) + R v := by
  by_cases hxone : x = 1
  · subst x
    refine ⟨0, 1, by norm_num, le_rfl, by norm_num, ?_⟩
    intro M
    simp
  obtain ⟨b, y, hxy, hy1, hy2, hlog⟩ := exists_rat_log_normalization x hx
  refine ⟨b, y, hxy, hy1, hy2, ?_⟩
  intro M v P R c lo hi
  have hyden : 0 < y + 1 := by linarith
  have hv0 : 0 ≤ v := div_nonneg (sub_nonneg.mpr hy1) hyden.le
  have hvthird : v < 1 / 3 := (div_lt_iff₀ hyden).2 (by linarith)
  have hv1 : v < 1 := by linarith
  have hvreal0 : 0 ≤ (v : ℝ) := by exact_mod_cast hv0
  have hvreal1 : (v : ℝ) < 1 := by exact_mod_cast hv1
  have hratio : (1 + v) / (1 - v) = y := by
    have hvden : 1 - v ≠ 0 := ne_of_gt (sub_pos.mpr hv1)
    rw [div_eq_iff hvden]
    dsimp [v]
    field_simp [hyden.ne']
    ring
  have hratioReal : (1 + (v : ℝ)) / (1 - (v : ℝ)) = (y : ℝ) := by
    exact_mod_cast hratio
  have hP (z : ℚ) :
      (P z : ℝ) = 2 * (∑ r ∈ Finset.range M,
        (z : ℝ) ^ (2 * r + 1) / (2 * (r : ℝ) + 1)) := by
    dsimp [P]
    push_cast
    rfl
  have hR (z : ℚ) :
      (R z : ℝ) = 2 * (z : ℝ) ^ (2 * M + 1) /
        ((2 * (M : ℝ) + 1) * (1 - (z : ℝ) ^ 2)) := by
    dsimp [R]
    push_cast
    rfl
  have hybound :
      0 ≤ Real.log (y : ℝ) - (P v : ℝ) ∧
        Real.log (y : ℝ) - (P v : ℝ) ≤ (R v : ℝ) := by
    simpa only [hratioReal, hP, hR] using
      log_odd_partial_sum_enclosure (v : ℝ) hvreal0 hvreal1 M
  have hratioTwo :
      (1 + ((1 / 3 : ℚ) : ℝ)) / (1 - ((1 / 3 : ℚ) : ℝ)) = 2 := by
    norm_num
  have htwobound :
      0 ≤ Real.log 2 - (P (1 / 3) : ℝ) ∧
        Real.log 2 - (P (1 / 3) : ℝ) ≤ (R (1 / 3) : ℝ) := by
    simpa only [hratioTwo, hP, hR] using
      log_odd_partial_sum_enclosure ((1 / 3 : ℚ) : ℝ)
        (by norm_num) (by norm_num) M
  have henclose : (lo : ℝ) ≤ Real.log (x : ℝ) ∧
      Real.log (x : ℝ) ≤ (hi : ℝ) := by
    dsimp only [lo, hi, c]
    push_cast
    rw [hlog]
    rcases le_total (0 : ℝ) (b : ℝ) with hb | hb
    · simp only [min_eq_right hb, max_eq_left hb, zero_mul, add_zero]
      have hlow := mul_nonneg hb htwobound.1
      have hhigh := mul_le_mul_of_nonneg_left htwobound.2 hb
      constructor <;> nlinarith [hybound.1, hybound.2]
    · simp only [min_eq_left hb, max_eq_right hb, zero_mul, add_zero]
      have hlow := mul_le_mul_of_nonpos_left htwobound.2 hb
      have hhigh := mul_nonpos_of_nonpos_of_nonneg hb htwobound.1
      constructor <;> nlinarith [hybound.1, hybound.2]
  refine ⟨henclose.1, henclose.2, ?_⟩
  calc
    hi - lo = (max (b : ℚ) 0 - min (b : ℚ) 0) * R (1 / 3) + R v := by
      dsimp [hi, lo]
      ring
    _ = |(b : ℚ)| * R (1 / 3) + R v := by
      rw [max_sub_min_eq_abs', sub_zero]

theorem exists_rat_log_interval_refinement
    (x : ℚ) (hx : 0 < x) :
    ∃ (b : ℤ) (y : ℚ) (M₀ : ℕ),
      x = (2 : ℚ) ^ b * y ∧ 1 ≤ y ∧ y < 2 ∧
        ∀ M : ℕ,
          let v : ℚ := (y - 1) / (y + 1)
          let P : ℚ → ℚ := fun z =>
            2 * (∑ r ∈ Finset.range M,
              z ^ (2 * r + 1) / (2 * (r : ℚ) + 1))
          let R : ℚ → ℚ := fun z =>
            2 * z ^ (2 * M + 1) /
              ((2 * (M : ℚ) + 1) * (1 - z ^ 2))
          let c : ℚ := (b : ℚ) * P (1 / 3) + P v
          let lo : ℚ := c + min (b : ℚ) 0 * R (1 / 3)
          let hi : ℚ := c + max (b : ℚ) 0 * R (1 / 3) + R v
          (lo : ℝ) ≤ Real.log (x : ℝ) ∧
            Real.log (x : ℝ) ≤ (hi : ℝ) ∧
              hi - lo = |(b : ℚ)| * R (1 / 3) + R v ∧
                (x = 1 → lo = 0 ∧ hi = 0) ∧
                (x ≠ 1 → M₀ ≤ M →
                  (0 < lo ∨ hi < 0) ∧
                    (hi - lo) * (2 : ℚ) ^ 164 ≤ min |lo| |hi|) := by
  by_cases hxone : x = 1
  · subst x
    refine ⟨0, 1, 0, by norm_num, le_rfl, by norm_num, ?_⟩
    intro M
    simp
  obtain ⟨b, y, hxy, hy1, hy2, hbounds⟩ :=
    exists_rat_log_interval_recombination x hx
  let v : ℚ := (y - 1) / (y + 1)
  have hyden : 0 < y + 1 := by linarith
  have hv0 : 0 ≤ v := div_nonneg (sub_nonneg.mpr hy1) hyden.le
  have hvthird : v < 1 / 3 := (div_lt_iff₀ hyden).2 (by linarith)
  have hv1 : v < 1 := by linarith
  let R : ℕ → ℚ → ℚ := fun M z =>
    2 * z ^ (2 * M + 1) / ((2 * (M : ℚ) + 1) * (1 - z ^ 2))
  let W : ℕ → ℝ := fun M => ((|(b : ℚ)| * R M (1 / 3) + R M v : ℚ) : ℝ)
  have htwo := tendsto_logarithm_remainder_bound_zero
    ((1 / 3 : ℚ) : ℝ) (by norm_num) (by norm_num)
  have hv := tendsto_logarithm_remainder_bound_zero (v : ℝ)
    (by exact_mod_cast hv0) (by exact_mod_cast hv1)
  have hW : Filter.Tendsto W Filter.atTop (nhds 0) := by
    simpa [W, R] using (Filter.Tendsto.const_mul |(b : ℝ)| htwo).add hv
  have hz : Real.log (x : ℝ) ≠ 0 :=
    Real.log_ne_zero_of_pos_of_ne_one (by exact_mod_cast hx)
      (by exact_mod_cast hxone)
  let A : ℝ := |Real.log (x : ℝ)|
  let K : ℝ := 2 ^ 164
  have hA : 0 < A := abs_pos.mpr hz
  have hK : 0 < K := by positivity
  have hδ : 0 < A / (K + 1) := div_pos hA (by linarith)
  have hδlt : A / (K + 1) < A := div_lt_self hA (by linarith)
  have hsmall : ∀ᶠ M in Filter.atTop, W M < A / (K + 1) :=
    Filter.Tendsto.eventually_lt_const hδ hW
  obtain ⟨M₀, hM₀⟩ := Filter.eventually_atTop.1 hsmall
  refine ⟨b, y, M₀, hxy, hy1, hy2, ?_⟩
  intro M vM P RM c lo hi
  have hm := hbounds M
  change (lo : ℝ) ≤ Real.log (x : ℝ) ∧
    Real.log (x : ℝ) ≤ (hi : ℝ) ∧
      hi - lo = |(b : ℚ)| * RM (1 / 3) + RM vM at hm
  refine ⟨hm.1, hm.2.1, hm.2.2, ?_, ?_⟩
  · intro heq
    exact (hxone heq).elim
  · intro _ hM
    have hwidth : (hi : ℝ) - (lo : ℝ) = W M := by
      rw [← Rat.cast_sub, hm.2.2]
    have hWM : W M < A / (K + 1) := hM₀ M hM
    have hWA : W M < A := hWM.trans hδlt
    have hWK : W M * (K + 1) < A := (lt_div_iff₀ (by linarith)).1 hWM
    rcases lt_or_gt_of_ne hz with hneg | hpos
    · have hAeq : A = -Real.log (x : ℝ) := abs_of_neg hneg
      rw [hAeq] at hWA hWK
      have hloNeg : (lo : ℝ) < 0 := hm.1.trans_lt hneg
      have hhiNeg : (hi : ℝ) < 0 := by
        linarith only [hwidth, hWA, hm.1]
      have hnear : W M * K ≤ -(hi : ℝ) := by
        nlinarith only [hWK, hwidth, hm.1]
      refine ⟨Or.inr (by exact_mod_cast hhiNeg), ?_⟩
      have hsmallReal :
          ((hi : ℝ) - (lo : ℝ)) * K ≤ min |(lo : ℝ)| |(hi : ℝ)| := by
        rw [hwidth, abs_of_neg hloNeg, abs_of_neg hhiNeg,
          min_eq_right (neg_le_neg (hm.1.trans hm.2.1))]
        exact hnear
      dsimp [K] at hsmallReal
      exact_mod_cast hsmallReal
    · have hAeq : A = Real.log (x : ℝ) := abs_of_pos hpos
      rw [hAeq] at hWA hWK
      have hloPos : 0 < (lo : ℝ) := by
        linarith only [hwidth, hWA, hm.2.1]
      have hhiPos : 0 < (hi : ℝ) := hpos.trans_le hm.2.1
      have hnear : W M * K ≤ (lo : ℝ) := by
        nlinarith only [hWK, hwidth, hm.2.1]
      refine ⟨Or.inl (by exact_mod_cast hloPos), ?_⟩
      have hsmallReal :
          ((hi : ℝ) - (lo : ℝ)) * K ≤ min |(lo : ℝ)| |(hi : ℝ)| := by
        rw [hwidth, abs_of_pos hloPos, abs_of_pos hhiPos,
          min_eq_left (hm.1.trans hm.2.1)]
        exact hnear
      dsimp [K] at hsmallReal
      exact_mod_cast hsmallReal

theorem exists_rat_exp_interval_refinement (x : ℚ) :
    ∃ b : ℕ,
      let v : ℚ := |x| / (2 : ℚ) ^ b
      let E : ℕ → ℚ := fun M =>
        ∑ r ∈ Finset.range (M + 1), v ^ r / (r.factorial : ℚ)
      let R : ℕ → ℚ := fun M =>
        v ^ (M + 1) / ((M + 1).factorial : ℚ) *
          (1 / (1 - v / ((M + 2 : ℕ) : ℚ)))
      let S : ℚ → ℚ := (fun z : ℚ => z ^ 2)^[b]
      let T : ℝ := ((fun z : ℝ => z ^ 2)^[b]) (Real.exp (v : ℝ))
      let L : ℕ → ℚ := fun M =>
        if 0 ≤ x then S (E M) else (S (E M + R M))⁻¹
      let U : ℕ → ℚ := fun M =>
        if 0 ≤ x then S (E M + R M) else (S (E M))⁻¹
      0 ≤ v ∧ v ≤ 1 / 2 ∧ |x| = (2 : ℚ) ^ b * v ∧
        Real.exp (x : ℝ) = (if 0 ≤ x then T else T⁻¹) ∧
        (∀ M : ℕ,
          1 ≤ E M ∧ 0 ≤ R M ∧ 0 < L M ∧ L M ≤ U M ∧
            (L M : ℝ) ≤ Real.exp (x : ℝ) ∧
              Real.exp (x : ℝ) ≤ (U M : ℝ)) ∧
        (x = 0 → ∀ M : ℕ, L M = 1 ∧ U M = 1) ∧
        ∃ M₀ : ℕ, ∀ M : ℕ, M₀ ≤ M →
          (U M - L M) * (2 : ℚ) ^ 164 ≤ L M := by
  obtain ⟨b, hb⟩ :=
    pow_unbounded_of_one_lt (2 * |x|) (show (1 : ℚ) < 2 by norm_num)
  refine ⟨b, ?_⟩
  intro v E R S T L U
  have hpow : 0 < (2 : ℚ) ^ b := by positivity
  have hv : 0 ≤ v := by dsimp [v]; positivity
  have hvhalf : v ≤ 1 / 2 := by
    dsimp only [v]
    apply (div_le_iff₀ hpow).2
    linarith
  have hvhalfReal : (v : ℝ) ≤ 1 / 2 := by
    simpa only [Rat.cast_div, Rat.cast_one, Rat.cast_ofNat] using
      (Rat.cast_le (K := ℝ)).2 hvhalf
  have habs : |x| = (2 : ℚ) ^ b * v := by
    dsimp only [v]
    field_simp
  have hscale : |(x : ℝ)| = ((2 ^ b : ℕ) : ℝ) * (v : ℝ) := by
    exact_mod_cast habs
  have hT : T = Real.exp |(x : ℝ)| := by
    simpa only [T, pow_iterate, hscale] using
      (Real.exp_nat_mul (v : ℝ) (2 ^ b)).symm
  have hTpos : 0 < T := by rw [hT]; exact Real.exp_pos _
  have hrestore : Real.exp (x : ℝ) = (if 0 ≤ x then T else T⁻¹) := by
    rw [hT]
    split_ifs with hx
    · rw [abs_of_nonneg (by exact_mod_cast hx)]
    · have hx' : (x : ℝ) < 0 := by exact_mod_cast (lt_of_not_ge hx)
      rw [abs_of_neg hx', Real.exp_neg, inv_inv]
  have hEone (M : ℕ) : 1 ≤ E M := by
    have h := Finset.single_le_sum
      (f := fun r : ℕ => v ^ r / (r.factorial : ℚ))
      (fun r _ => by positivity)
      (show 0 ∈ Finset.range (M + 1) by simp)
    simpa [E] using h
  have hEpos (M : ℕ) : 0 < E M := lt_of_lt_of_le zero_lt_one (hEone M)
  have hRnonneg (M : ℕ) : 0 ≤ R M := by
    have hq : v / ((M + 2 : ℕ) : ℚ) ≤ 1 / 2 :=
      (div_le_self hv (by exact_mod_cast (show 1 ≤ M + 2 by omega))).trans hvhalf
    have hd : 0 < 1 - v / ((M + 2 : ℕ) : ℚ) := by linarith
    dsimp only [R]
    positivity
  have hbase (M : ℕ) :
      0 ≤ Real.exp (v : ℝ) - (E M : ℝ) ∧
        Real.exp (v : ℝ) - (E M : ℝ) ≤ (R M : ℝ) := by
    simpa [E, R] using exp_sub_sum_range_le_geometric_tail
      (v : ℝ) M (by exact_mod_cast hv) hvhalfReal
  have hsmall (M : ℕ) :
      (E M : ℝ) ≤ Real.exp (v : ℝ) ∧
        Real.exp (v : ℝ) ≤ (E M : ℝ) + (R M : ℝ) := by
    constructor <;> linarith [(hbase M).1, (hbase M).2]
  have hSlo (M : ℕ) : 0 < S (E M) := by
    simpa [S, pow_iterate] using pow_pos (hEpos M) (2 ^ b)
  have hShi (M : ℕ) : 0 < S (E M + R M) := by
    simpa [S, pow_iterate] using
      pow_pos (add_pos_of_pos_of_nonneg (hEpos M) (hRnonneg M)) (2 ^ b)
  have hbig (M : ℕ) :
      (S (E M) : ℝ) ≤ T ∧ T ≤ (S (E M + R M) : ℝ) := by
    constructor
    · simpa [S, T, pow_iterate] using
        pow_le_pow_left₀ (by exact_mod_cast (hEpos M).le) (hsmall M).1 (2 ^ b)
    · simpa [S, T, pow_iterate] using
        pow_le_pow_left₀ (Real.exp_nonneg _) (hsmall M).2 (2 ^ b)
  have hLpos (M : ℕ) : 0 < L M := by
    by_cases hx : 0 ≤ x
    · simpa [L, hx] using hSlo M
    · simpa [L, hx] using inv_pos.mpr (hShi M)
  have hbounds (M : ℕ) :
      (L M : ℝ) ≤ Real.exp (x : ℝ) ∧ Real.exp (x : ℝ) ≤ (U M : ℝ) := by
    by_cases hx : 0 ≤ x
    · simpa only [L, U, hrestore, ite_eq_left hx] using hbig M
    · have hlo : 0 < (S (E M) : ℝ) := by exact_mod_cast hSlo M
      simpa only [L, U, hrestore, ite_eq_right hx, Rat.cast_inv] using
        And.intro (inv_anti₀ hTpos (hbig M).2) (inv_anti₀ hlo (hbig M).1)
  have horder (M : ℕ) : L M ≤ U M := by
    exact_mod_cast (hbounds M).1.trans (hbounds M).2
  refine ⟨hv, hvhalf, habs, hrestore, ?_, ?_, ?_⟩
  · intro M
    exact ⟨hEone M, hRnonneg M, hLpos M, horder M, (hbounds M).1, (hbounds M).2⟩
  · intro hx M
    simp [L, U, S, E, R, v, hx, pow_iterate, Finset.sum_range_succ']
  · have hRlim : Filter.Tendsto (fun M : ℕ => (R M : ℝ)) Filter.atTop (nhds 0) := by
      simpa [R] using tendsto_exponential_remainder_bound_zero
        (v : ℝ) (by exact_mod_cast hv) hvhalfReal
    have herror : Filter.Tendsto
        (fun M : ℕ => Real.exp (v : ℝ) - (E M : ℝ)) Filter.atTop (nhds 0) :=
      squeeze_zero (fun M => (hbase M).1) (fun M => (hbase M).2) hRlim
    have hElim : Filter.Tendsto (fun M : ℕ => (E M : ℝ))
        Filter.atTop (nhds (Real.exp (v : ℝ))) := by
      simpa only [sub_sub_cancel, sub_zero] using herror.const_sub (Real.exp (v : ℝ))
    have hLoLim : Filter.Tendsto (fun M : ℕ => (S (E M) : ℝ))
        Filter.atTop (nhds T) := by
      simpa [S, T, pow_iterate] using hElim.pow (2 ^ b)
    have hHiLim : Filter.Tendsto (fun M : ℕ => (S (E M + R M) : ℝ))
        Filter.atTop (nhds T) := by
      simpa [S, T, pow_iterate] using (hElim.add hRlim).pow (2 ^ b)
    have hlimits :
        Filter.Tendsto (fun M : ℕ => (L M : ℝ))
          Filter.atTop (nhds (Real.exp (x : ℝ))) ∧
        Filter.Tendsto (fun M : ℕ => (U M : ℝ))
          Filter.atTop (nhds (Real.exp (x : ℝ))) := by
      by_cases hx : 0 ≤ x
      · simpa only [L, U, hrestore, ite_eq_left hx] using And.intro hLoLim hHiLim
      · simpa only [L, U, hrestore, ite_eq_right hx, Rat.cast_inv] using
          And.intro (hHiLim.inv₀ hTpos.ne') (hLoLim.inv₀ hTpos.ne')
    have hwidth : Filter.Tendsto
        (fun M : ℕ => ((U M - L M : ℚ) : ℝ)) Filter.atTop (nhds 0) := by
      simpa only [Rat.cast_sub, sub_self] using hlimits.2.sub hlimits.1
    let K : ℝ := (2 : ℝ) ^ 164
    have hK : 0 < K := by dsimp [K]; positivity
    have hsmallWidth : ∀ᶠ M : ℕ in Filter.atTop,
        ((U M - L M : ℚ) : ℝ) < Real.exp (x : ℝ) / (K + 1) :=
      hwidth.eventually_lt_const (by positivity)
    obtain ⟨M₀, hM₀⟩ := Filter.eventually_atTop.1 hsmallWidth
    refine ⟨M₀, fun M hM => ?_⟩
    have hw : ((U M - L M : ℚ) : ℝ) * (K + 1) < Real.exp (x : ℝ) :=
      (lt_div_iff₀ (by positivity)).1 (hM₀ M hM)
    have hstop : ((U M - L M : ℚ) : ℝ) * K ≤ (L M : ℝ) := by
      calc
        _ = ((U M - L M : ℚ) : ℝ) * (K + 1) - ((U M - L M : ℚ) : ℝ) := by ring
        _ ≤ Real.exp (x : ℝ) - ((U M - L M : ℚ) : ℝ) :=
          (sub_lt_sub_right hw _).le
        _ ≤ (L M : ℝ) := by
          push_cast
          linarith only [(hbounds M).2]
    dsimp only [K] at hstop
    exact_mod_cast hstop

section
open Set

theorem power_array_ofFn_getD {α : Type*} {N : ℕ} (F : Fin N → α) (z : α)
    (i : ℕ) (hi : i < N) :
    (Array.ofFn F).getD i z = F ⟨i, hi⟩ :=
  array_getD_ofFn F z i hi

theorem firstOuterLowArray_getD_of_size_le (A : Array ℚ) (j : ℕ) (hj : A.size ≤ j) :
    A.getD j 0 = 0 := by
  simp only [Array.getD_eq_getD_getElem?, Array.getElem?_eq_none hj, Option.getD_none]

theorem power_array_ofFn_nonneg {N : ℕ} (F : Fin N → ℚ)
    (hF : ∀ j, 0 ≤ F j) (j : ℕ) : 0 ≤ (Array.ofFn F).getD j 0 := by
  by_cases hj : j < N
  · rw [power_array_ofFn_getD F 0 j hj]
    exact hF ⟨j, hj⟩
  · rw [firstOuterLowArray_getD_of_size_le _ j (by simpa using Nat.le_of_not_gt hj)]

theorem power_array_getD_map_div (A : Array ℚ) (c : ℚ) (j : ℕ) :
    (A.map (fun x => x / c)).getD j 0 = A.getD j 0 / c := by
  simpa only [Array.getD_eq_getD_getElem?, Array.getElem?_map, zero_div] using
    (Option.getD_map (fun x : ℚ => x / c) 0 A[j]?)

theorem power_array_getD_push_lt {α : Type*} (A : Array α) (x z : α)
    (j : ℕ) (hj : j < A.size) : (A.push x).getD j z = A.getD j z := by
  rw [← Array.getElem_eq_getD
    (h := by simpa only [Array.size_push] using Nat.lt_succ_of_lt hj) z,
    Array.getElem_push_lt hj, Array.getElem_eq_getD z]

theorem power_array_getD_push_size {α : Type*} (A : Array α) (x z : α) :
    (A.push x).getD A.size z = x := by
  simp only [Array.getD_eq_getD_getElem?, Array.getElem?_push_size, Option.getD_some]

theorem firstOuterLowTruncatedConvolution_size (A B : Array ℚ) :
    (firstOuterLowTruncatedConvolution A B).size = 98304 := by
  simp only [firstOuterLowTruncatedConvolution, Array.size_ofFn]

theorem firstOuterLowTruncatedConvolution_coeff
    (A B : Array ℚ) (P Q : Polynomial ℚ)
    (hA : ∀ i < 98304, A.getD i 0 = P.coeff i)
    (hB : ∀ i < 98304, B.getD i 0 = Q.coeff i)
    (j : ℕ) (hj : j < 98304) :
    (firstOuterLowTruncatedConvolution A B).getD j 0 = (P * Q).coeff j :=
  firstOuterLowTruncatedConvolution_getD_eq_coeff_mul A B P Q hA hB j hj

theorem firstOuterLowTruncatedConvolution_nonneg
    (A B : Array ℚ) (hA : ∀ j, 0 ≤ A.getD j 0) (hB : ∀ j, 0 ≤ B.getD j 0)
    (j : ℕ) : 0 ≤ (firstOuterLowTruncatedConvolution A B).getD j 0 :=
  power_array_ofFn_nonneg _ (fun i =>
    Finset.sum_nonneg fun a _ => mul_nonneg (hA a) (hB (i.val - a))) j

theorem power_reciprocal_array_coeff (j : ℕ) (hj : j < 98304) :
    (Array.ofFn (fun i : Fin 98304 =>
      if 2331 ≤ i.val ∧ i.val < 49152 then (i.val : ℚ)⁻¹ else 0)).getD j 0 =
      (∑ a ∈ Finset.Ico 2331 49152,
        Polynomial.monomial a ((a : ℚ)⁻¹)).coeff j :=
  reciprocalArray_getD_eq_coeff 2331 49152 j hj

theorem power_factorial_step (Q : Polynomial ℚ) (r j : ℕ) :
    ((Polynomial.C ((r.factorial : ℚ)⁻¹) * Q ^ r) * Q).coeff j /
        ((r : ℚ) + 1) =
      (Polynomial.C (((r + 1).factorial : ℚ)⁻¹) * Q ^ (r + 1)).coeff j := by
  rw [mul_assoc, Polynomial.coeff_C_mul, Polynomial.coeff_C_mul, pow_succ]
  simp only [Nat.factorial_succ, Nat.cast_mul, Nat.cast_add, Nat.cast_one,
    mul_inv_rev, div_eq_mul_inv]
  ring

theorem firstOuterLowHighPowerPrefix_coefficients (r : ℕ) :
    let Q : Polynomial ℚ :=
      ∑ a ∈ Finset.Ico 2331 49152, Polynomial.monomial a ((a : ℚ)⁻¹)
    let G := firstOuterLowHighPowerPrefix r
    let zero : Array ℚ := Array.replicate 98304 0
    G.size = r + 1 ∧
      ∀ k : ℕ, k ≤ r →
        let P := G.getD k zero
        P.size = 98304 ∧
          (∀ j : ℕ, j < 98304 →
            P.getD j 0 =
              (Polynomial.C ((k.factorial : ℚ)⁻¹) * Q ^ k).coeff j) ∧
          (∀ j : ℕ, 0 ≤ P.getD j 0) ∧
          (∀ j : ℕ, 98304 ≤ j → P.getD j 0 = 0) := by
  classical
  let Q : Polynomial ℚ :=
    ∑ a ∈ Finset.Ico 2331 49152, Polynomial.monomial a ((a : ℚ)⁻¹)
  let zero : Array ℚ := Array.replicate 98304 0
  change (firstOuterLowHighPowerPrefix r).size = r + 1 ∧
    ∀ k : ℕ, k ≤ r →
      ((firstOuterLowHighPowerPrefix r).getD k zero).size = 98304 ∧
      (∀ j : ℕ, j < 98304 →
        ((firstOuterLowHighPowerPrefix r).getD k zero).getD j 0 =
          (Polynomial.C ((k.factorial : ℚ)⁻¹) * Q ^ k).coeff j) ∧
      (∀ j : ℕ, 0 ≤ ((firstOuterLowHighPowerPrefix r).getD k zero).getD j 0) ∧
      (∀ j : ℕ, 98304 ≤ j →
        ((firstOuterLowHighPowerPrefix r).getD k zero).getD j 0 = 0)
  induction r with
  | zero =>
      refine ⟨rfl, ?_⟩
      intro k hk
      have hk0 : k = 0 := Nat.eq_zero_of_le_zero hk
      subst k
      let U := Array.ofFn (fun j : Fin 98304 => if j.val = 0 then (1 : ℚ) else 0)
      have hU : (firstOuterLowHighPowerPrefix 0).getD 0 zero = U := by
        simp only [U, firstOuterLowHighPowerPrefix, Nat.rec_zero,
          Array.getD_eq_getD_getElem?, Array.getElem?_singleton, ite_true, Option.getD_some]
      rw [hU]
      refine ⟨by simp only [U, Array.size_ofFn], ?_, ?_, ?_⟩
      · intro j hj
        rw [show U.getD j 0 = if j = 0 then 1 else 0 from
          power_array_ofFn_getD _ 0 j hj]
        simp only [Nat.factorial_zero, Nat.cast_one, inv_one, map_one, pow_zero,
          one_mul, Polynomial.coeff_one]
      · exact power_array_ofFn_nonneg _ (fun j => by split <;> norm_num)
      · intro j hj
        exact firstOuterLowArray_getD_of_size_le U j (by simpa only [U, Array.size_ofFn])
  | succ r ih =>
      let G := firstOuterLowHighPowerPrefix r
      let QA : Array ℚ := Array.ofFn (fun j : Fin 98304 =>
        if 2331 ≤ j.val ∧ j.val < 49152 then (j.val : ℚ)⁻¹ else 0)
      let P := firstOuterLowTruncatedConvolution (G.getD r zero) QA
      let S := P.map (fun x => x / ((r : ℚ) + 1))
      have hG : G.size = r + 1 := ih.1
      have hrec : firstOuterLowHighPowerPrefix (r + 1) = G.push S := rfl
      rw [hrec]
      refine ⟨by simp only [Array.size_push, hG], ?_⟩
      intro k hk
      by_cases hkr : k ≤ r
      · have hkG : k < G.size := by rw [hG]; omega
        rw [power_array_getD_push_lt G S zero k hkG]
        exact ih.2 k hkr
      · have hkEq : k = r + 1 := by omega
        subst k
        have hlast : (G.push S).getD (r + 1) zero = S := by
          rw [← hG, power_array_getD_push_size]
        rw [hlast]
        have hSsize : S.size = 98304 := by
          simp only [S, Array.size_map, P, firstOuterLowTruncatedConvolution_size]
        have hQA : ∀ j, 0 ≤ QA.getD j 0 := by
          apply power_array_ofFn_nonneg
          intro j
          split <;> positivity
        have hP : ∀ j, 0 ≤ P.getD j 0 :=
          firstOuterLowTruncatedConvolution_nonneg _ _ (ih.2 r le_rfl).2.2.1 hQA
        refine ⟨hSsize, ?_, ?_, ?_⟩
        · intro j hj
          rw [power_array_getD_map_div]
          rw [firstOuterLowTruncatedConvolution_coeff _ _
            (Polynomial.C ((r.factorial : ℚ)⁻¹) * Q ^ r) Q
            (ih.2 r le_rfl).2.1 power_reciprocal_array_coeff j hj]
          exact power_factorial_step Q r j
        · intro j
          rw [power_array_getD_map_div]
          exact div_nonneg (hP j) (by positivity)
        · intro j hj
          exact firstOuterLowArray_getD_of_size_le S j (by omega)

theorem coefficient_mul_nonneg {R : Type*} [Semiring R] [PartialOrder R]
    [IsOrderedRing R] {P Q : Polynomial R}
    (hP : ∀ i, 0 ≤ P.coeff i) (hQ : ∀ i, 0 ≤ Q.coeff i) (j : ℕ) :
    0 ≤ (P * Q).coeff j :=
  envelope_coeff_mul_nonneg P Q hP hQ j

theorem coefficient_pow_nonneg {R : Type*} [Semiring R] [PartialOrder R]
    [IsOrderedRing R] {P : Polynomial R}
    (hP : ∀ i, 0 ≤ P.coeff i) (k j : ℕ) :
    0 ≤ (P ^ k).coeff j :=
  envelope_coeff_pow_nonneg P hP k j

theorem coefficient_mul_mono_left {R : Type*} [Semiring R] [PartialOrder R]
    [IsOrderedRing R] {P Q S : Polynomial R}
    (hPQ : ∀ i, P.coeff i ≤ Q.coeff i) (hS : ∀ i, 0 ≤ S.coeff i) (j : ℕ) :
    (P * S).coeff j ≤ (Q * S).coeff j := by
  simp only [Polynomial.coeff_mul]
  exact Finset.sum_le_sum fun a _ => mul_le_mul_of_nonneg_right (hPQ a.1) (hS a.2)

theorem coefficient_mul_zero_below {R : Type*} [Semiring R]
    {P Q : Polynomial R} {m j : ℕ}
    (hP : ∀ i < m, P.coeff i = 0) (hj : j < m) : (P * Q).coeff j = 0 :=
  Polynomial.X_pow_dvd_iff.mp
    ((Polynomial.X_pow_dvd_iff.mpr hP).mul_right Q) j hj

theorem firstOuterLowRenewalTail_coeff_nonneg (e : Fin 2) (j : ℕ) :
    let Q : Polynomial ℚ :=
      ∑ a ∈ Finset.Ico 2331 49152, Polynomial.monomial a ((a : ℚ)⁻¹)
    let mark : Polynomial ℚ :=
      ∑ a ∈ Finset.Ico 2331 3498, Polynomial.monomial a ((a : ℚ)⁻¹)
    let q : ℕ → Polynomial ℚ :=
      fun r => Polynomial.C ((r.factorial : ℚ)⁻¹) * Q ^ r
    let rep : ℕ → Polynomial ℚ :=
      fun m => ∑ a ∈ Finset.range m, (Polynomial.X : Polynomial ℚ) ^ a
    let Tpoly : Polynomial ℚ :=
      (∑ r ∈ Finset.range 33, q r * eulerianCarryPolynomial (r + e.val + 1)) +
        ∑ r ∈ Finset.Ico 33 43, q r * rep (r + e.val + 1)
    0 ≤ Tpoly.coeff j ∧ 0 ≤ (mark ^ e.val * Tpoly).coeff j := by
  intro Q mark q rep Tpoly
  have hQ : ∀ i, 0 ≤ Q.coeff i :=
    firstOuterLow_reciprocal_polynomial_coeff_nonneg 2331 49152
  have hmark : ∀ i, 0 ≤ mark.coeff i :=
    firstOuterLow_reciprocal_polynomial_coeff_nonneg 2331 3498
  have hq (r i : ℕ) : 0 ≤ (q r).coeff i := by
    change 0 ≤ (Polynomial.C ((r.factorial : ℚ)⁻¹) * Q ^ r).coeff i
    rw [Polynomial.coeff_C_mul]
    exact mul_nonneg (by positivity) (coefficient_pow_nonneg hQ r i)
  have hcarry (m i : ℕ) : 0 ≤ (eulerianCarryPolynomial m).coeff i := by
    rw [eulerianCarryPolynomial, coeff_sum_monomial_eq_ite]
    split <;> positivity
  have hrep (m i : ℕ) : 0 ≤ (rep m).coeff i := by
    change 0 ≤ (∑ a ∈ Finset.range m, (Polynomial.X : Polynomial ℚ) ^ a).coeff i
    rw [coeff_sum_range_X_pow]
    split <;> positivity
  have hT (i : ℕ) : 0 ≤ Tpoly.coeff i := by
    change 0 ≤ ((∑ r ∈ Finset.range 33,
      q r * eulerianCarryPolynomial (r + e.val + 1)) +
      ∑ r ∈ Finset.Ico 33 43, q r * rep (r + e.val + 1)).coeff i
    simp only [Polynomial.coeff_add, Polynomial.finsetSum_coeff]
    exact add_nonneg
      (Finset.sum_nonneg fun r _ => coefficient_mul_nonneg (hq r) (hcarry _) i)
      (Finset.sum_nonneg fun r _ => coefficient_mul_nonneg (hq r) (hrep _) i)
  have hMT (i : ℕ) : 0 ≤ (mark ^ e.val * Tpoly).coeff i :=
    coefficient_mul_nonneg (coefficient_pow_nonneg hmark e.val) hT i
  exact ⟨hT j, hMT j⟩

theorem firstOuterLowRenewalDensity_coeff_bounds (j : ℕ) :
    let Dlo : Polynomial ℚ :=
      ∑ a ∈ Finset.range 98304,
        Polynomial.monomial a (firstOuterLowRenewalLowDensityInterval a).1
    let Dhi : Polynomial ℚ :=
      ∑ a ∈ Finset.range 98304,
        Polynomial.monomial a (firstOuterLowRenewalLowDensityInterval a).2
    let h : ℝ := 2742997 / 258046918656
    let stopped : ℕ → Bool := fun a => (List.range (a + 1)).any (fun i => decide
      (((dickmanRenewalDyadicPrefix 160 2331 98303).getD i (1, 1)).2 ≤
        ((1 / 10 ^ 40 : ℚ).toDyadic 160).toRat))
    let d : ℕ → ℚ := fun a =>
      if stopped a then 1 / 10 ^ 40 else (dickmanRenewalPrefix 2331 a).getD a 1
    let D : Polynomial ℝ := ∑ a ∈ Finset.range 98304,
      Polynomial.monomial a (h * (d a : ℝ) * Real.exp (-189 * (a : ℝ) * h))
    0 ≤ Dlo.coeff j ∧ Dlo.coeff j ≤ Dhi.coeff j ∧
      (Dlo.coeff j : ℝ) ≤ D.coeff j ∧ D.coeff j ≤ (Dhi.coeff j : ℝ) := by
  intro Dlo Dhi h stopped d D
  dsimp only [Dlo, Dhi, D]
  simp only [coeff_sum_monomial_eq_ite, Finset.mem_range]
  by_cases hj : j < 98304
  · simp only [ite_eq_left hj]
    exact firstOuterLowRenewalLowDensityInterval_encloses j hj
  · simp only [ite_eq_right hj, Rat.cast_zero, le_refl, and_self]

theorem firstOuterLowPolynomialProduct_enclosure (φ : ℚ →+* ℝ)
    (L U P : Polynomial ℚ) (D : Polynomial ℝ)
    (hP : ∀ i, 0 ≤ P.coeff i)
    (hD : ∀ i, 0 ≤ L.coeff i ∧ L.coeff i ≤ U.coeff i ∧
      (L.coeff i : ℝ) ≤ D.coeff i ∧ D.coeff i ≤ (U.coeff i : ℝ)) (j : ℕ) :
    0 ≤ (L * P).coeff j ∧ (L * P).coeff j ≤ (U * P).coeff j ∧
      ((L * P).coeff j : ℝ) ≤ (D * P.map φ).coeff j ∧
      (D * P.map φ).coeff j ≤ ((U * P).coeff j : ℝ) := by
  have hPr (i : ℕ) : 0 ≤ (P.map φ).coeff i := by
    rw [Polynomial.coeff_map, eq_ratCast]
    exact_mod_cast hP i
  refine ⟨coefficient_mul_nonneg (fun i => (hD i).1) hP j,
    coefficient_mul_mono_left (fun i => (hD i).2.1) hP j, ?_, ?_⟩
  · have hc := coefficient_mul_mono_left (P := L.map φ) (Q := D)
      (fun i => by simpa only [Polynomial.coeff_map, eq_ratCast] using (hD i).2.2.1)
      hPr j
    simpa only [← Polynomial.map_mul, Polynomial.coeff_map, eq_ratCast] using hc
  · have hc := coefficient_mul_mono_left (P := D) (Q := U.map φ)
      (fun i => by simpa only [Polynomial.coeff_map, eq_ratCast] using (hD i).2.2.2)
      hPr j
    simpa only [← Polynomial.map_mul, Polynomial.coeff_map, eq_ratCast] using hc

theorem firstOuterLowMarkedPolynomial_support (e : Fin 2)
    (P L U : Polynomial ℚ) (j : ℕ) (he : e.val = 1) (hj : j < 2331) :
    let mark : Polynomial ℚ :=
      ∑ a ∈ Finset.Ico 2331 3498, Polynomial.monomial a ((a : ℚ)⁻¹)
    (mark ^ e.val * P).coeff j = 0 ∧
      (L * (mark ^ e.val * P)).coeff j = 0 ∧
      (U * (mark ^ e.val * P)).coeff j = 0 := by
  intro mark
  have hm (i : ℕ) (hi : i < 2331) : mark.coeff i = 0 := by
    rw [show mark = ∑ a ∈ Finset.Ico 2331 3498,
      Polynomial.monomial a ((a : ℚ)⁻¹) from rfl, coeff_sum_monomial_eq_ite]
    simp only [Finset.mem_Ico, not_le.mpr hi, false_and, ite_false]
  rw [he, pow_one]
  have hz (i : ℕ) (hi : i < 2331) : (mark * P).coeff i = 0 :=
    coefficient_mul_zero_below hm hi
  refine ⟨hz j hj, ?_, ?_⟩
  · rw [mul_comm L]
    exact coefficient_mul_zero_below hz hj
  · rw [mul_comm U]
    exact coefficient_mul_zero_below hz hj

/--
The finite set of angular signatures that occur when multiplying any two of the eleven trial
terms. Repeated merged signatures are identified by the finset image.
-/
def trialMergedSignatures : Finset (Multiset ℕ) :=
  (Finset.univ : Finset (Fin 11 × Fin 11)).image
    (fun st => trialAngularSignature st.1 + trialAngularSignature st.2)

/--
The radial polynomial multiplying angular signature `η` in the square of the trial expansion. It
sums over ordered pairs of trial terms, so cross terms retain their multiplicity.
-/
noncomputable def trialSquareRadialPolynomial (η : Multiset ℕ) : Polynomial ℚ :=
  ∑ s : Fin 11, ∑ t : Fin 11,
    if trialAngularSignature s + trialAngularSignature t = η then
      trialRadialPolynomial s * trialRadialPolynomial t else 0

theorem trial_angular_index_data :
    Function.Injective trialAngularSignature ∧
      trialMergedSignatures.card = 53 ∧
      (∀ s : Fin 11,
        (trialAngularSignature s).card ≤ 3 ∧ (trialAngularSignature s).sum ≤ 6) ∧
      ∀ η ∈ trialMergedSignatures, η.card ≤ 6 ∧ η.sum ≤ 12 := by
  have hsmall : ∀ s : Fin 11,
      (trialAngularSignature s).card ≤ 3 ∧ (trialAngularSignature s).sum ≤ 6 := by
    decide
  refine ⟨?_, ?_, hsmall, ?_⟩
  · decide +kernel
  · decide +kernel
  · intro η hη
    obtain ⟨⟨s, t⟩, _, rfl⟩ := Finset.mem_image.mp hη
    have hs := hsmall s
    have ht := hsmall t
    simp only [Multiset.card_add, Multiset.sum_add]
    omega

theorem trialRadialPolynomial_coeff (s : Fin 11) (k : ℕ) :
    (trialRadialPolynomial s).coeff k =
      if hk : k < 7 then (trialCoefficientInteger s ⟨k, hk⟩ : ℚ) / 10000000000 else 0 := by
  by_cases hk : k < 7
  · simp only [trialRadialPolynomial, dite_eq_left hk,
      Polynomial.ofFn_coeff_eq_val_of_lt _ hk]
  · simp only [trialRadialPolynomial, dite_eq_right hk,
      Polynomial.ofFn_coeff_eq_zero_of_ge _ (Nat.le_of_not_gt hk)]

theorem trialRadialPolynomial_eval (s : Fin 11) (x : ℝ) :
    (trialRadialPolynomial s).eval₂ (Rat.castHom ℝ) x =
      ∑ d : Fin 7, ((trialCoefficientInteger s d : ℝ) / 10000000000) * x ^ d.val := by
  simp [trialRadialPolynomial, Polynomial.ofFn_eq_sum_monomial,
    Polynomial.eval₂_finsetSum, Polynomial.eval₂_monomial]

theorem trialCore_formula
    (X : Fin 40 → FiniteMeasure ℝ) (t : Fin 40 → ℝ) :
    trialCore X t =
      trialOuterMask X * (∏ i : Fin 40, trialProfile (t i)) *
        ∑ s : Fin 11, ∑ d : Fin 7,
          ((trialCoefficientInteger s d : ℝ) / 10000000000) *
            ((∑ i : Fin 40, t i) - 9 / 10) ^ d.val *
              angularMonomial (trialAngularSignature s) t := by
  simp only [trialCore, trialRadialPolynomial_eval, Finset.sum_mul]

theorem trialFormalFunction_formula (X : Fin 40 → FiniteMeasure ℝ) :
    trialFormalFunction X =
      trialOuterMask X * (∏ i : Fin 40, trialProfile ((X i).mass : ℝ)) *
        ∑ s : Fin 11, ∑ d : Fin 7,
          ((trialCoefficientInteger s d : ℝ) / 10000000000) *
            ((∑ i : Fin 40, ((X i).mass : ℝ)) - 9 / 10) ^ d.val *
              angularMonomial (trialAngularSignature s)
                (fun i => ((X i).mass : ℝ)) :=
  trialCore_formula X (fun i => ((X i).mass : ℝ))

theorem trialSquareRadialPolynomial_natDegree_le (η : Multiset ℕ) :
    (trialSquareRadialPolynomial η).natDegree ≤ 12 := by
  have hdegree (s : Fin 11) : (trialRadialPolynomial s).natDegree ≤ 6 :=
    Nat.le_of_lt_succ (Polynomial.ofFn_natDegree_lt (by decide : 1 ≤ 7)
      (fun d : Fin 7 => (trialCoefficientInteger s d : ℚ) / 10000000000))
  apply Polynomial.natDegree_sum_le_of_forall_le
  intro s _
  apply Polynomial.natDegree_sum_le_of_forall_le
  intro t _
  split_ifs
  · exact Polynomial.natDegree_mul_le.trans (add_le_add (hdegree s) (hdegree t))
  · simp

theorem literal_trial_square_regrouping (d : ℕ) (x : ℝ) (t : Fin d → ℝ) :
    (∑ s : Fin 11,
      (trialRadialPolynomial s).eval₂ (Rat.castHom ℝ) x *
        angularMonomial (trialAngularSignature s) t) ^ 2 =
      ∑ η ∈ trialMergedSignatures,
        (trialSquareRadialPolynomial η).eval₂ (Rat.castHom ℝ) x * angularMonomial η t := by
  let a : Fin 11 → ℝ := fun s => (trialRadialPolynomial s).eval₂ (Rat.castHom ℝ) x
  let g : Fin 11 × Fin 11 → Multiset ℕ := fun st =>
    trialAngularSignature st.1 + trialAngularSignature st.2
  have heval (η : Multiset ℕ) :
      (trialSquareRadialPolynomial η).eval₂ (Rat.castHom ℝ) x =
        ∑ st : Fin 11 × Fin 11, if g st = η then a st.1 * a st.2 else 0 := by
    rw [Fintype.sum_prod_type]
    simp [trialSquareRadialPolynomial, Polynomial.eval₂_finsetSum, apply_ite, a, g]
  have hfibre := Finset.sum_fiberwise_of_maps_to
    (s := (Finset.univ : Finset (Fin 11 × Fin 11)))
    (t := trialMergedSignatures) (g := g)
    (fun st _ => Finset.mem_image.mpr ⟨st, Finset.mem_univ _, rfl⟩)
    (fun st => (a st.1 * a st.2) * angularMonomial (g st) t)
  calc
    _ = ∑ s : Fin 11, ∑ u : Fin 11,
        (a s * a u) * angularMonomial (trialAngularSignature s + trialAngularSignature u) t := by
      rw [pow_two, Finset.sum_mul_sum]
      apply Finset.sum_congr rfl
      intro s _
      apply Finset.sum_congr rfl
      intro u _
      simp only [angularMonomial, Multiset.map_add, Multiset.prod_add]
      dsimp [a]
      ring
    _ = ∑ st : Fin 11 × Fin 11, (a st.1 * a st.2) * angularMonomial (g st) t := by
      rw [Fintype.sum_prod_type]
    _ = ∑ η ∈ trialMergedSignatures,
        ∑ st ∈ Finset.univ.filter (fun st => g st = η),
          (a st.1 * a st.2) * angularMonomial (g st) t := hfibre.symm
    _ = _ := by
      apply Finset.sum_congr rfl
      intro η _
      rw [heval, Finset.sum_mul, Finset.sum_filter]
      apply Finset.sum_congr rfl
      intro st _
      by_cases h : g st = η <;> simp [h]

theorem sum_functions_eq_sum_finpartitions_embeddings
    {α β R : Type*} [Fintype α] [DecidableEq α] [Fintype β] [AddCommMonoid R]
    (F : (α → β) → R) :
    (∑ f : α → β, F f) =
      ∑ π : Finpartition (Finset.univ : Finset α),
        ∑ e : π.parts ↪ β,
          F (fun a => e ⟨π.part a, π.part_mem.mpr (Finset.mem_univ a)⟩) := by
  classical
  let assemble : (Σ π : Finpartition (Finset.univ : Finset α), π.parts ↪ β) → α → β :=
    fun x a => x.2 ⟨x.1.part a, x.1.part_mem.mpr (Finset.mem_univ a)⟩
  have hrel (π : Finpartition (Finset.univ : Finset α)) (e : π.parts ↪ β) (a b : α) :
      a ∈ π.part b ↔
        e ⟨π.part a, π.part_mem.mpr (Finset.mem_univ a)⟩ =
          e ⟨π.part b, π.part_mem.mpr (Finset.mem_univ b)⟩ := by
    rw [EmbeddingLike.apply_eq_iff_eq, Subtype.mk.injEq]
    exact π.mem_part_iff_part_eq_part (Finset.mem_univ a) (Finset.mem_univ b)
  have hbij : Function.Bijective assemble := by
    constructor
    · rintro ⟨π, e⟩ ⟨ρ, g⟩ h
      have hv (a : α) :
          e ⟨π.part a, π.part_mem.mpr (Finset.mem_univ a)⟩ =
            g ⟨ρ.part a, ρ.part_mem.mpr (Finset.mem_univ a)⟩ := congrFun h a
      have hparts (a : α) : π.part a = ρ.part a := by
        ext b
        rw [hrel π e b a, hrel ρ g b a, hv b, hv a]
      have hp : π = ρ := by
        apply Finpartition.ext
        apply Finset.Subset.antisymm
        · intro B hB
          obtain ⟨a, ha⟩ := π.nonempty_of_mem_parts hB
          rw [← π.part_eq_of_mem hB ha, hparts a]
          exact ρ.part_mem.mpr (Finset.mem_univ a)
        · intro B hB
          obtain ⟨a, ha⟩ := ρ.nonempty_of_mem_parts hB
          rw [← ρ.part_eq_of_mem hB ha, ← hparts a]
          exact π.part_mem.mpr (Finset.mem_univ a)
      subst ρ
      suffices he : e = g by cases he; rfl
      apply Function.Embedding.ext
      intro B
      obtain ⟨a, ha⟩ := π.nonempty_of_mem_parts B.property
      simpa only [π.part_eq_of_mem B.property ha] using hv a
    · intro f
      let π := Finpartition.ofSetoid (Setoid.ker f)
      let pick (B : π.parts) : α := (π.nonempty_of_mem_parts B.property).choose
      have hpick (B : π.parts) : pick B ∈ B.val :=
        (π.nonempty_of_mem_parts B.property).choose_spec
      let e : π.parts ↪ β :=
        { toFun := fun B => f (pick B)
          inj' := by
            intro A B h
            apply Subtype.ext
            calc
              A.val = π.part (pick A) := (π.part_eq_of_mem A.property (hpick A)).symm
              _ = π.part (pick B) := by
                apply π.part_eq_of_mem (π.part_mem.mpr (Finset.mem_univ (pick B)))
                exact Finpartition.mem_part_ofSetoid_iff_rel.mpr h.symm
              _ = B.val := π.part_eq_of_mem B.property (hpick B) }
      refine ⟨⟨π, e⟩, ?_⟩
      funext a
      change f (pick ⟨π.part a, π.part_mem.mpr (Finset.mem_univ a)⟩) = f a
      exact (Finpartition.mem_part_ofSetoid_iff_rel.mp
        (hpick ⟨π.part a, π.part_mem.mpr (Finset.mem_univ a)⟩)).symm
  exact (hbij.sum_comp F).symm.trans (Fintype.sum_sigma _)

open Classical in
theorem sum_weighted_embedding
    {R α β γ : Type*} [CommSemiring R]
    [Fintype α] [Fintype β] [Fintype γ]
    (e : β ↪ α) (W : γ → R) (V : β → γ → R) :
    (∑ j : α → γ, (∏ i : α, W (j i)) * ∏ b : β, V b (j (e b))) =
      (∑ x : γ, W x) ^ (Fintype.card α - Fintype.card β) *
        ∏ b : β, ∑ x : γ, W x * V b x := by
  let S : Finset α := Finset.univ.image e
  let H (i : α) (x : γ) : R :=
    W x * ∏ b : β, if e b = i then V b x else 1
  have hpoint (j : α → γ) :
      (∏ i : α, W (j i)) * ∏ b : β, V b (j (e b)) = ∏ i : α, H i (j i) := by
    simp only [H, Finset.prod_mul_distrib]
    congr 1
    rw [Finset.prod_comm]
    exact Finset.prod_congr rfl fun b _ => by simp
  have hoccupied (b : β) (x : γ) : H (e b) x = W x * V b x := by
    simp [H, e.injective.eq_iff]
  have hunused (i : α) (hi : i ∈ Sᶜ) (x : γ) : H i x = W x := by
    have hne (b : β) : e b ≠ i := by
      intro h
      exact (Finset.mem_compl.mp hi)
        (h ▸ Finset.mem_image_of_mem e (Finset.mem_univ b))
    simp [H, hne]
  have hcard : Sᶜ.card = Fintype.card α - Fintype.card β := by
    rw [Finset.card_compl]
    simp [S, Finset.card_image_of_injective _ e.injective]
  have hinside :
      (∏ i ∈ S, ∑ x : γ, H i x) = ∏ b : β, ∑ x : γ, W x * V b x := by
    calc
      _ = ∏ b : β, ∑ x : γ, H (e b) x :=
        Finset.prod_image (s := Finset.univ) (g := (e : β → α))
          (f := fun i => ∑ x : γ, H i x) e.injective.injOn
      _ = _ := by simp only [hoccupied]
  have houtside :
      (∏ i ∈ Sᶜ, ∑ x : γ, H i x) =
        (∑ x : γ, W x) ^ (Fintype.card α - Fintype.card β) := by
    calc
      _ = ∏ _i ∈ Sᶜ, ∑ x : γ, W x := by
        refine Finset.prod_congr rfl fun i hi => ?_
        exact Finset.sum_congr rfl fun x _ => hunused i hi x
      _ = _ := by rw [Finset.prod_const, hcard]
  calc
    _ = ∑ j : α → γ, ∏ i : α, H i (j i) :=
      Finset.sum_congr rfl fun j _ => hpoint j
    _ = ∏ i : α, ∑ x : γ, H i x := (Fintype.prod_sum H).symm
    _ = (∏ i ∈ Sᶜ, ∑ x : γ, H i x) * ∏ i ∈ S, ∑ x : γ, H i x :=
      (Finset.prod_compl_mul_prod S (fun i => ∑ x : γ, H i x)).symm
    _ = _ := by rw [houtside, hinside]

theorem weighted_partition_moment
    {R : Type*} [CommSemiring R] (n d k : ℕ)
    (W : Fin n → R) (V : Fin k → Fin n → R) :
    (∑ j : Fin d → Fin n,
      (∏ i : Fin d, W (j i)) * ∏ a : Fin k, ∑ i : Fin d, V a (j i)) =
      ∑ π : Finpartition (Finset.univ : Finset (Fin k)),
        (d.descFactorial π.parts.card : R) *
          (∑ x : Fin n, W x) ^ (d - π.parts.card) *
            ∏ B ∈ π.parts, ∑ x : Fin n, W x * ∏ a ∈ B, V a x := by
  classical
  calc
    _ = ∑ f : Fin k → Fin d, ∑ j : Fin d → Fin n,
        (∏ i : Fin d, W (j i)) * ∏ a : Fin k, V a (j (f a)) := by
      simp_rw [Fintype.prod_sum, Finset.mul_sum]
      rw [Finset.sum_comm]
    _ = ∑ π : Finpartition (Finset.univ : Finset (Fin k)),
        ∑ e : π.parts ↪ Fin d, ∑ j : Fin d → Fin n,
          (∏ i : Fin d, W (j i)) *
            ∏ a : Fin k, V a (j (e ⟨π.part a, π.part_mem.mpr (Finset.mem_univ a)⟩)) :=
      sum_functions_eq_sum_finpartitions_embeddings _
    _ = _ := by
      refine Finset.sum_congr rfl fun π _ => ?_
      have hblock (e : π.parts ↪ Fin d) (j : Fin d → Fin n) :
          (∏ a : Fin k, V a (j (e ⟨π.part a, π.part_mem.mpr (Finset.mem_univ a)⟩))) =
            ∏ B : π.parts, ∏ a ∈ B.val, V a (j (e B)) := by
        conv_lhs => arg 1; rw [← π.biUnion_parts]
        rw [Finset.prod_biUnion π.supIndep.pairwiseDisjoint]
        conv_lhs => rw [← Finset.prod_coe_sort]
        refine Finset.prod_congr rfl fun B _ => ?_
        refine Finset.prod_congr rfl fun a ha => ?_
        have he :
            (⟨π.part a, π.part_mem.mpr (Finset.mem_univ a)⟩ : π.parts) = B :=
          Subtype.ext (π.part_eq_of_mem B.property ha)
        rw [he]
      have hconst (e : π.parts ↪ Fin d) :
          (∑ j : Fin d → Fin n,
            (∏ i : Fin d, W (j i)) *
              ∏ a : Fin k, V a (j (e ⟨π.part a, π.part_mem.mpr (Finset.mem_univ a)⟩))) =
            (∑ x : Fin n, W x) ^ (d - π.parts.card) *
              ∏ B ∈ π.parts, ∑ x : Fin n, W x * ∏ a ∈ B, V a x := by
        calc
          _ = ∑ j : Fin d → Fin n,
              (∏ i : Fin d, W (j i)) * ∏ B : π.parts, ∏ a ∈ B.val, V a (j (e B)) := by
            exact Finset.sum_congr rfl fun j _ => by rw [hblock e j]
          _ = (∑ x : Fin n, W x) ^ (d - π.parts.card) *
              ∏ B : π.parts, ∑ x : Fin n, W x * ∏ a ∈ B.val, V a x := by
            convert! sum_weighted_embedding e W (fun B x => ∏ a ∈ B.val, V a x) using 1
            · exact Finset.sum_congr (by ext j; simp only [Finset.mem_univ]) fun _ _ => rfl
            · simp only [Fintype.card_fin, Fintype.card_coe]
          _ = _ := by
            congr 1
            exact Finset.prod_coe_sort π.parts
              (fun B : Finset (Fin k) => ∑ x : Fin n, W x * ∏ a ∈ B, V a x)
      simp_rw [hconst]
      simp only [Finset.sum_const, Finset.card_univ, Fintype.card_embedding_eq,
        Fintype.card_fin, Fintype.card_coe, nsmul_eq_mul, mul_assoc]

theorem labelled_angular_partition_identity
    {R : Type*} [CommSemiring R] (n d k : ℕ)
    (σ : Fin k → ℕ) (t K : Fin n → R) :
    let P : ℕ → Polynomial R := fun e =>
      ∑ j : Fin n, Polynomial.C (K j * t j ^ e) * Polynomial.X ^ j.val
    (∑ j : Fin d → Fin n,
      (∏ i : Fin d, Polynomial.C (K (j i)) * Polynomial.X ^ (j i).val) *
        Polynomial.C (∏ a : Fin k, ∑ i : Fin d, t (j i) ^ σ a)) =
      ∑ π : Finpartition (Finset.univ : Finset (Fin k)),
        Polynomial.C (d.descFactorial π.parts.card : R) *
          P 0 ^ (d - π.parts.card) *
            ∏ B ∈ π.parts, P (∑ a ∈ B, σ a) := by
  intro P
  classical
  let W (j : Fin n) : Polynomial R := Polynomial.C (K j) * Polynomial.X ^ j.val
  let V (a : Fin k) (j : Fin n) : Polynomial R := Polynomial.C (t j ^ σ a)
  have hP0 : (∑ j : Fin n, W j) = P 0 := by simp [P, W]
  have hPB (B : Finset (Fin k)) :
      (∑ j : Fin n, W j * ∏ a ∈ B, V a j) = P (∑ a ∈ B, σ a) := by
    dsimp only [P]
    refine Finset.sum_congr rfl fun j _ => ?_
    dsimp only [W, V]
    rw [← map_prod, Finset.prod_pow_eq_pow_sum, Polynomial.C_mul]
    ac_rfl
  calc
    _ = ∑ j : Fin d → Fin n,
        (∏ i : Fin d, W (j i)) * ∏ a : Fin k, ∑ i : Fin d, V a (j i) := by
      refine Finset.sum_congr rfl fun j _ => ?_
      simp only [W, V, map_prod, map_sum]
    _ = ∑ π : Finpartition (Finset.univ : Finset (Fin k)),
        (d.descFactorial π.parts.card : Polynomial R) *
          (∑ x : Fin n, W x) ^ (d - π.parts.card) *
            ∏ B ∈ π.parts, ∑ x : Fin n, W x * ∏ a ∈ B, V a x :=
      weighted_partition_moment n d k W V
    _ = _ := by simp only [hP0, hPB, Polynomial.C_eq_natCast]

theorem fst_eq_of_eq_pair {α β : Type} {x : α × β} {a : α} {b : β}
    (h : x = (a, b)) : x.1 = a := congrArg Prod.fst h

theorem snd_eq_of_eq_pair {α β : Type} {x : α × β} {a : α} {b : β}
    (h : x = (a, b)) : x.2 = b := congrArg Prod.snd h

theorem firstOuterLowRenewalKernelBounds_polynomials
    (e : Fin 2) (j : ℕ) (hj : j < 98304) :
    let zero : Array ℚ := Array.replicate 98304 0
    let powers := firstOuterLowHighPowerPrefix 42
    let exactTerms : Array (Array ℚ) := Array.ofFn (fun r : Fin 33 =>
      firstOuterLowTruncatedConvolution (powers.getD r.val zero)
        (firstOuterLowEulerianCarryArray (r.val + e.val + 1)))
    let tailTerms : Array (Array ℚ) := Array.ofFn (fun s : Fin 10 =>
      let r : ℕ := s.val + 33
      let rep : Array ℚ := Array.ofFn (fun a : Fin 98304 =>
        if a.val < r + e.val + 1 then (1 : ℚ) else 0)
      firstOuterLowTruncatedConvolution (powers.getD r zero) rep)
    let Tarr : Array ℚ := Array.ofFn (fun a : Fin 98304 =>
      (∑ r ∈ Finset.range 33, (exactTerms.getD r zero).getD a.val 0) +
        ∑ s ∈ Finset.range 10, (tailTerms.getD s zero).getD a.val 0)
    let markArray : Array ℚ := Array.ofFn (fun a : Fin 98304 =>
      if 2331 ≤ a.val ∧ a.val < 3498 then (a.val : ℚ)⁻¹ else 0)
    let MTarr :=
      if e.val = 0 then Tarr else firstOuterLowTruncatedConvolution markArray Tarr
    let K := firstOuterLowRenewalKernelBounds e
    let Q : Polynomial ℚ :=
      ∑ a ∈ Finset.Ico 2331 49152, Polynomial.monomial a ((a : ℚ)⁻¹)
    let mark : Polynomial ℚ :=
      ∑ a ∈ Finset.Ico 2331 3498, Polynomial.monomial a ((a : ℚ)⁻¹)
    let q : ℕ → Polynomial ℚ :=
      fun r => Polynomial.C ((r.factorial : ℚ)⁻¹) * Q ^ r
    let rep : ℕ → Polynomial ℚ :=
      fun m => ∑ a ∈ Finset.range m, (Polynomial.X : Polynomial ℚ) ^ a
    let Tpoly : Polynomial ℚ :=
      (∑ r ∈ Finset.range 33, q r * eulerianCarryPolynomial (r + e.val + 1)) +
        ∑ r ∈ Finset.Ico 33 43, q r * rep (r + e.val + 1)
    let Dlo : Polynomial ℚ :=
      ∑ a ∈ Finset.range 98304,
        Polynomial.monomial a (firstOuterLowRenewalLowDensityInterval a).1
    let Dhi : Polynomial ℚ :=
      ∑ a ∈ Finset.range 98304,
        Polynomial.monomial a (firstOuterLowRenewalLowDensityInterval a).2
    Tarr.size = 98304 ∧ MTarr.size = 98304 ∧
      K.1.size = 98304 ∧ K.2.size = 98304 ∧
      Tarr.getD j 0 = Tpoly.coeff j ∧
      MTarr.getD j 0 = (mark ^ e.val * Tpoly).coeff j ∧
      K.1.getD j 0 = (Dlo * (mark ^ e.val * Tpoly)).coeff j ∧
      K.2.getD j 0 = (Dhi * (mark ^ e.val * Tpoly)).coeff j := by
  intro zero powers exactTerms tailTerms Tarr markArray MTarr K Q mark q rep Tpoly Dlo Dhi
  have hpowers (r : ℕ) (hr : r ≤ 42) (i : ℕ) (hi : i < 98304) :
      (powers.getD r zero).getD i 0 = (q r).coeff i :=
    ((firstOuterLowHighPowerPrefix_coefficients 42).2 r hr).2.1 i hi
  have hT (i : ℕ) (hi : i < 98304) : Tarr.getD i 0 = Tpoly.coeff i := by
      rw [show Tarr = Array.ofFn (fun a : Fin 98304 =>
        (∑ r ∈ Finset.range 33, (exactTerms.getD r zero).getD a.val 0) +
          ∑ s ∈ Finset.range 10, (tailTerms.getD s zero).getD a.val 0) from rfl]
      rw [array_getD_ofFn _ 0 i hi]
      dsimp only [Tpoly]
      rw [Polynomial.coeff_add, Polynomial.finsetSum_coeff, Polynomial.finsetSum_coeff]
      apply congrArg₂ (· + ·)
      · apply Finset.sum_congr rfl
        intro r hr
        have hr' : r < 33 := Finset.mem_range.mp hr
        dsimp only [exactTerms]
        rw [array_getD_ofFn _ zero r hr']
        exact firstOuterLowTruncatedConvolution_getD_eq_coeff_mul _ _ _ _ (hpowers r (by omega))
          (firstOuterLowEulerianCarryArray_getD_eq_coeff (r + e.val + 1)) i hi
      · rw [Finset.sum_Ico_eq_sum_range]
        change (∑ s ∈ Finset.range 10, (tailTerms.getD s zero).getD i 0) =
          ∑ s ∈ Finset.range 10, (q (33 + s) * rep (33 + s + e.val + 1)).coeff i
        apply Finset.sum_congr rfl
        intro s hs
        have hs' : s < 10 := Finset.mem_range.mp hs
        dsimp only [tailTerms]
        rw [array_getD_ofFn _ zero s hs']
        simpa only [show 33 + s = s + 33 from Nat.add_comm 33 s] using
          firstOuterLowTruncatedConvolution_getD_eq_coeff_mul (powers.getD (s + 33) zero)
            (Array.ofFn (fun a : Fin 98304 =>
              if a.val < s + 33 + e.val + 1 then (1 : ℚ) else 0))
            (q (s + 33)) (rep (s + 33 + e.val + 1))
            (hpowers (s + 33) (by omega)) (fun a ha => replicationArray_getD_eq_coeff _ a ha) i hi
  have hMT (i : ℕ) (hi : i < 98304) :
      MTarr.getD i 0 = (mark ^ e.val * Tpoly).coeff i := by
      by_cases he : e.val = 0
      · simpa only [MTarr, he, ite_eq_left, pow_zero, one_mul] using hT i hi
      · have he' : e.val = 1 := by omega
        simp only [MTarr, ite_eq_right he, he', pow_one]
        exact firstOuterLowTruncatedConvolution_getD_eq_coeff_mul _ _ _ _
          (fun a ha => reciprocalArray_getD_eq_coeff 2331 3498 a ha)
          hT i hi
  let Alo : Array ℚ := Array.ofFn (fun a : Fin 98304 =>
    (firstOuterLowRenewalLowDensityInterval a.val).1)
  let Ahi : Array ℚ := Array.ofFn (fun a : Fin 98304 =>
    (firstOuterLowRenewalLowDensityInterval a.val).2)
  have hAlo (i : ℕ) (hi : i < 98304) : Alo.getD i 0 = Dlo.coeff i := by
    rw [show Alo = Array.ofFn (fun a : Fin 98304 =>
      (firstOuterLowRenewalLowDensityInterval a.val).1) from rfl, array_getD_ofFn _ 0 i hi]
    dsimp only [Dlo]
    rw [coeff_sum_monomial_eq_ite, ite_eq_left (Finset.mem_range.mpr hi)]
  have hAhi (i : ℕ) (hi : i < 98304) : Ahi.getD i 0 = Dhi.coeff i := by
    rw [show Ahi = Array.ofFn (fun a : Fin 98304 =>
      (firstOuterLowRenewalLowDensityInterval a.val).2) from rfl, array_getD_ofFn _ 0 i hi]
    dsimp only [Dhi]
    rw [coeff_sum_monomial_eq_ite, ite_eq_left (Finset.mem_range.mpr hi)]
  have hKpair : K = (firstOuterLowTruncatedConvolution Alo MTarr,
      firstOuterLowTruncatedConvolution Ahi MTarr) := by
    rfl
  have hKlo : K.1 = firstOuterLowTruncatedConvolution Alo MTarr :=
    fst_eq_of_eq_pair hKpair
  have hKhi : K.2 = firstOuterLowTruncatedConvolution Ahi MTarr :=
    snd_eq_of_eq_pair hKpair
  have hlo : K.1.getD j 0 = (Dlo * (mark ^ e.val * Tpoly)).coeff j := by
    rw [hKlo]
    exact firstOuterLowTruncatedConvolution_getD_eq_coeff_mul _ _ _ _ hAlo hMT j hj
  have hhi : K.2.getD j 0 = (Dhi * (mark ^ e.val * Tpoly)).coeff j := by
    rw [hKhi]
    exact firstOuterLowTruncatedConvolution_getD_eq_coeff_mul _ _ _ _ hAhi hMT j hj
  have hsizeT : Tarr.size = 98304 := Array.size_ofFn
  have hsizeMT : MTarr.size = 98304 := by
    by_cases he : e.val = 0
    · simpa only [MTarr, ite_eq_left he] using hsizeT
    · simp only [MTarr, ite_eq_right he, firstOuterLowTruncatedConvolution, Array.size_ofFn]
  have hsizeLo : K.1.size = 98304 := by
    rw [hKlo]
    exact Array.size_ofFn
  have hsizeHi : K.2.size = 98304 := by
    rw [hKhi]
    exact Array.size_ofFn
  exact ⟨hsizeT, hsizeMT, hsizeLo, hsizeHi, hT j hj, hMT j hj, hlo, hhi⟩

theorem firstOuterLowProfile_upward_error (v : ℚ) :
    0 ≤ -(((-v).toDyadic 192).toRat) - v ∧
      -(((-v).toDyadic 192).toRat) - v < (1 : ℚ) / 2 ^ 192 := by
  have hround := renewal_dyadic_round_error (192 : ℤ) (-v)
  have heps : (2 : ℚ) ^ (-(192 : ℤ)) = (1 : ℚ) / 2 ^ 192 := by norm_num
  have hupper := hround.2.trans_le heps.le
  constructor <;> linarith only [hround.1, hupper]

theorem firstOuterLowRenewalProfileCoordinateUpper_rounding
    (e p : Fin 2) (j : ℕ) (hj : j < 98264) :
    let h : ℚ := 2742997 / 258046918656
    let g : ℕ → ℚ := fun a =>
      let t : ℚ := ((a : ℚ) + 1 / 2) * h
      trialProfile t
    let Z : ℚ := ∑ a ∈ Finset.range 98264, (g a) ^ 2
    let w : ℚ := if p.val = 0 then 1 else (g j) ^ 2 / Z
    let K := firstOuterLowRenewalKernelBounds e
    let v : ℚ := w / h * K.2.getD j 0
    let A := firstOuterLowRenewalProfileCoordinateUpper e p
    A.size = 98264 ∧ 0 < Z ∧ 0 < w ∧
      (∀ a : ℕ, 98264 ≤ a → A.getD a 0 = 0) ∧
      A.getD j 0 = -(((-v).toDyadic 192).toRat) ∧
      0 ≤ A.getD j 0 - v ∧
      A.getD j 0 - v < (1 : ℚ) / 2 ^ 192 := by
  intro h g Z w K v A
  have hh : 0 < h := by norm_num [h]
  have hg (a : ℕ) : 0 < g a := by
    dsimp only [g, trialProfile]
    positivity
  have hZ : 0 < Z := by
    apply Finset.sum_pos'
    · intro a _
      exact sq_nonneg _
    · exact ⟨0, by simp, sq_pos_of_pos (hg 0)⟩
  have hw : 0 < w := by
    dsimp only [w]
    split
    · norm_num
    · exact div_pos (sq_pos_of_pos (hg j)) hZ
  have hAsize : A.size = 98264 := Array.size_ofFn
  have hA : A.getD j 0 = -(((-v).toDyadic 192).toRat) := by
    simp only [A, firstOuterLowRenewalProfileCoordinateUpper]
    rw [array_getD_ofFn _ 0 j hj]
  refine ⟨hAsize, hZ, hw, ?_, hA, ?_⟩
  · intro a ha
    exact firstOuterLowArray_getD_of_size_le A a (by omega)
  · rw [hA]
    exact firstOuterLowProfile_upward_error v

theorem firstOuterLowTruncatedConvolution_mono_left (A B C : Array ℚ)
    (hAB : ∀ j, A.getD j 0 ≤ B.getD j 0) (hC : ∀ j, 0 ≤ C.getD j 0) (j : ℕ) :
    (firstOuterLowTruncatedConvolution A C).getD j 0 ≤
      (firstOuterLowTruncatedConvolution B C).getD j 0 := by
  by_cases hj : j < 98304
  · rw [firstOuterLowTruncatedConvolution, firstOuterLowTruncatedConvolution,
      power_array_ofFn_getD _ 0 j hj, power_array_ofFn_getD _ 0 j hj]
    exact Finset.sum_le_sum fun a _ => mul_le_mul_of_nonneg_right (hAB a) (hC (j - a))
  · have hz (X Y : Array ℚ) :
        (firstOuterLowTruncatedConvolution X Y).getD j 0 = 0 :=
      firstOuterLowArray_getD_of_size_le _ j
        (by simpa only [firstOuterLowTruncatedConvolution_size] using Nat.le_of_not_gt hj)
    rw [hz, hz]

theorem firstOuterLowTruncatedConvolution_zero_below_left (A B : Array ℚ) (m : ℕ)
    (hA : ∀ a < m, A.getD a 0 = 0) (j : ℕ) (hj : j < m) :
    (firstOuterLowTruncatedConvolution A B).getD j 0 = 0 := by
  by_cases hjN : j < 98304
  · rw [firstOuterLowTruncatedConvolution, power_array_ofFn_getD _ 0 j hjN]
    apply Finset.sum_eq_zero
    intro a ha
    have ha' : a < j + 1 := Finset.mem_range.mp ha
    rw [hA a (by omega), zero_mul]
  · exact firstOuterLowArray_getD_of_size_le _ j
      (by simpa only [firstOuterLowTruncatedConvolution_size] using Nat.le_of_not_gt hjN)

theorem firstOuterLowTruncatedConvolution_zero_below_right (A B : Array ℚ) (m : ℕ)
    (hB : ∀ a < m, B.getD a 0 = 0) (j : ℕ) (hj : j < m) :
    (firstOuterLowTruncatedConvolution A B).getD j 0 = 0 := by
  by_cases hjN : j < 98304
  · rw [firstOuterLowTruncatedConvolution, power_array_ofFn_getD _ 0 j hjN]
    apply Finset.sum_eq_zero
    intro a _
    rw [hB (j - a) (by omega), mul_zero]
  · exact firstOuterLowArray_getD_of_size_le _ j
      (by simpa only [firstOuterLowTruncatedConvolution_size] using Nat.le_of_not_gt hjN)

theorem firstOuterLowRenewalKernelBounds_order_support (e : Fin 2) :
    let K := firstOuterLowRenewalKernelBounds e
    K.1.size = 98304 ∧ K.2.size = 98304 ∧
      (∀ j : ℕ, 0 ≤ K.1.getD j 0 ∧ K.1.getD j 0 ≤ K.2.getD j 0) ∧
      (e.val = 1 → ∀ j : ℕ, j < 2331 → K.1.getD j 0 = 0 ∧ K.2.getD j 0 = 0) := by
  intro K
  have hs := firstOuterLowRenewalKernelBounds_polynomials e 0 (by decide)
  have hlo : K.1.size = 98304 := hs.2.2.1
  have hhi : K.2.size = 98304 := hs.2.2.2.1
  refine ⟨hlo, hhi, ?_, ?_⟩
  · intro j
    by_cases hj : j < 98304
    · have hp := firstOuterLowRenewalKernelBounds_polynomials e j hj
      rw [hp.2.2.2.2.2.2.1, hp.2.2.2.2.2.2.2]
      exact ⟨coefficient_mul_nonneg
        (fun i => (firstOuterLowRenewalDensity_coeff_bounds i).1)
        (fun i => (firstOuterLowRenewalTail_coeff_nonneg e i).2) j,
        coefficient_mul_mono_left
          (fun i => (firstOuterLowRenewalDensity_coeff_bounds i).2.1)
          (fun i => (firstOuterLowRenewalTail_coeff_nonneg e i).2) j⟩
    · rw [firstOuterLowArray_getD_of_size_le _ j (by omega),
        firstOuterLowArray_getD_of_size_le _ j (by omega)]
      exact ⟨le_rfl, le_rfl⟩
  · intro he j hj
    have hp := firstOuterLowRenewalKernelBounds_polynomials e j (by omega)
    rw [hp.2.2.2.2.2.2.1, hp.2.2.2.2.2.2.2]
    exact (firstOuterLowMarkedPolynomial_support e _ _ _ j he hj).2

theorem firstOuterLowRenewalProfileCoordinateUpper_nonneg_support
    (e p : Fin 2) (j : ℕ) :
    0 ≤ (firstOuterLowRenewalProfileCoordinateUpper e p).getD j 0 ∧
      (e.val = 1 → j < 2331 →
        (firstOuterLowRenewalProfileCoordinateUpper e p).getD j 0 = 0) := by
  let A := firstOuterLowRenewalProfileCoordinateUpper e p
  change 0 ≤ A.getD j 0 ∧ (e.val = 1 → j < 2331 → A.getD j 0 = 0)
  by_cases hj : j < 98264
  · let h : ℚ := 2742997 / 258046918656
    let g : ℕ → ℚ := fun a =>
      let t : ℚ := ((a : ℚ) + 1 / 2) * h
      trialProfile t
    let Z : ℚ := ∑ a ∈ Finset.range 98264, (g a) ^ 2
    let w : ℚ := if p.val = 0 then 1 else (g j) ^ 2 / Z
    let K := firstOuterLowRenewalKernelBounds e
    let v : ℚ := w / h * K.2.getD j 0
    have hh : 0 < h := by norm_num [h]
    have hround := firstOuterLowRenewalProfileCoordinateUpper_rounding e p j hj
    have hw : 0 ≤ w := hround.2.2.1.le
    have hk := firstOuterLowRenewalKernelBounds_order_support e
    have hKhi : 0 ≤ K.2.getD j 0 := (hk.2.2.1 j).1.trans (hk.2.2.1 j).2
    have hv : 0 ≤ v := mul_nonneg (div_nonneg hw hh.le) hKhi
    have hA : A.getD j 0 = -(((-v).toDyadic 192).toRat) := hround.2.2.2.2.1
    refine ⟨?_, ?_⟩
    · exact hv.trans (sub_nonneg.mp hround.2.2.2.2.2.1)
    · intro he hjlow
      have hzero : K.2.getD j 0 = 0 := (hk.2.2.2 he j hjlow).2
      have hvzero : v = 0 := by simp only [v, hzero, mul_zero]
      rw [hA, hvzero]
      norm_num [Rat.toDyadic]
  · have hzero : A.getD j 0 = 0 :=
      firstOuterLowArray_getD_of_size_le A j (by simpa only [A,
        firstOuterLowRenewalProfileCoordinateUpper, Array.size_ofFn] using Nat.le_of_not_gt hj)
    simp only [hzero, le_refl, implies_true, and_self]

end

section
open Set

theorem firstOuterLowRenewalKernelBounds_cell_mass
    (e : Fin 2) (j : ℕ) (hj : j < 98304) :
    let K := firstOuterLowRenewalKernelBounds e
    let h : ℝ := 2742997 / 258046918656
    let C := Set.Ico ((j : ℝ) * h) (((j : ℝ) + 1) * h)
    (Measure.sum (firstOuterLowCountMeasure e)) C ≤
      ENNReal.ofReal (K.2.getD j 0 : ℝ) := by
  intro K h C
  have hcell := (firstOuterLow_selected_profile_cell e j hj).2.2.2
  have hkernel := (firstOuterLowRenewalKernelBounds_polynomials e j hj).2.2.2.2.2.2.2
  refine hcell.trans (ENNReal.ofReal_le_ofReal ?_)
  rw [hkernel]
  refine (firstOuterLowPolynomialProduct_enclosure _ 0 _ _ _ ?_ ?_ j).2.2.2
  · intro i
    exact (firstOuterLowRenewalTail_coeff_nonneg e i).2
  · intro i
    have hb := firstOuterLowRenewalDensity_coeff_bounds i
    refine ⟨by simp only [Polynomial.coeff_zero, le_refl], ?_, ?_, hb.2.2.2⟩
    · simpa only [Polynomial.coeff_zero] using hb.1.trans hb.2.1
    · simp only [Polynomial.coeff_zero, Rat.cast_zero]
      exact (show (0 : ℝ) ≤ _ from by exact_mod_cast hb.1).trans hb.2.2.1

theorem firstOuterLowRenewalProfileCoordinateUpper_cell_mass
    (e p : Fin 2) (j : ℕ) (hj : j < 98264) :
    let h : ℚ := 2742997 / 258046918656
    let g : ℕ → ℚ := fun a =>
      let t : ℚ := ((a : ℚ) + 1 / 2) * h
      trialProfile t
    let Z : ℚ := ∑ a ∈ Finset.range 98264, (g a) ^ 2
    let w : ℚ := if p.val = 0 then 1 else (g j) ^ 2 / Z
    let A := firstOuterLowRenewalProfileCoordinateUpper e p
    let C := Set.Ico ((j : ℝ) * (h : ℝ)) (((j : ℝ) + 1) * (h : ℝ))
    ENNReal.ofReal ((w / h : ℚ) : ℝ) *
        (Measure.sum (firstOuterLowCountMeasure e)) C ≤
      ENNReal.ofReal (A.getD j 0 : ℝ) := by
  intro h g Z w A C
  let K := firstOuterLowRenewalKernelBounds e
  let v : ℚ := w / h * K.2.getD j 0
  have hround := firstOuterLowRenewalProfileCoordinateUpper_rounding e p j hj
  have hh : 0 < h := by norm_num [h]
  have hwq : 0 < w := hround.2.2.1
  have hw : 0 ≤ ((w / h : ℚ) : ℝ) := by
    exact_mod_cast div_nonneg hwq.le hh.le
  have hAup : v ≤ A.getD j 0 := sub_nonneg.mp hround.2.2.2.2.2.1
  have hAup_real : (v : ℝ) ≤ (A.getD j 0 : ℝ) := by exact_mod_cast hAup
  have hvcast : ((w / h : ℚ) : ℝ) * (K.2.getD j 0 : ℝ) = (v : ℝ) :=
    (Rat.cast_mul _ _).symm
  have hcast : (h : ℝ) = 2742997 / 258046918656 := by norm_num [h]
  have hmass : (Measure.sum (firstOuterLowCountMeasure e)) C ≤
      ENNReal.ofReal (K.2.getD j 0 : ℝ) := by
    simpa only [C, hcast] using firstOuterLowRenewalKernelBounds_cell_mass e j (by omega)
  calc
    _ ≤ ENNReal.ofReal ((w / h : ℚ) : ℝ) *
        ENNReal.ofReal (K.2.getD j 0 : ℝ) := mul_le_mul_right hmass _
    _ = ENNReal.ofReal (v : ℝ) := by rw [← ENNReal.ofReal_mul hw, hvcast]
    _ ≤ ENNReal.ofReal (A.getD j 0 : ℝ) := ENNReal.ofReal_le_ofReal hAup_real

theorem firstOuterLowRenewalKernelBounds_prefix_mass
    (e : Fin 2) (N : ℕ) (hN : N ≤ 98304) :
    let K := firstOuterLowRenewalKernelBounds e
    let h : ℝ := 2742997 / 258046918656
    (Measure.sum (firstOuterLowCountMeasure e)) (Set.Ico 0 ((N : ℝ) * h)) ≤
      ENNReal.ofReal ((∑ j ∈ Finset.range N, K.2.getD j 0 : ℚ) : ℝ) := by
  intro K h
  let cells : ℕ → Set ℝ := fun j => Set.Ico ((j : ℝ) * h) (((j : ℝ) + 1) * h)
  have hcover : Set.Ico 0 ((N : ℝ) * h) ⊆ ⋃ j ∈ Finset.range N, cells j := by
    simpa only [Nat.cast_zero, zero_mul, Nat.cast_add, Nat.cast_one, cells] using
      Ico_subset_biUnion_Ico N (fun j : ℕ => (j : ℝ) * h)
  have hnonneg (j : ℕ) : 0 ≤ (K.2.getD j 0 : ℝ) := by
    have horder := (firstOuterLowRenewalKernelBounds_order_support e).2.2.1 j
    exact_mod_cast horder.1.trans horder.2
  calc
    _ ≤ (Measure.sum (firstOuterLowCountMeasure e))
        (⋃ j ∈ Finset.range N, cells j) := measure_mono hcover
    _ ≤ ∑ j ∈ Finset.range N, (Measure.sum (firstOuterLowCountMeasure e)) (cells j) :=
      measure_biUnion_finset_le _ _
    _ ≤ ∑ j ∈ Finset.range N, ENNReal.ofReal (K.2.getD j 0 : ℝ) := by
      apply Finset.sum_le_sum
      intro j hj
      exact firstOuterLowRenewalKernelBounds_cell_mass e j
        (lt_of_lt_of_le (Finset.mem_range.mp hj) hN)
    _ = ENNReal.ofReal ((∑ j ∈ Finset.range N, K.2.getD j 0 : ℚ) : ℝ) := by
      rw [Rat.cast_sum, ENNReal.ofReal_sum_of_nonneg (fun j _ => hnonneg j)]

end

theorem trial_fixed_positive_data :
    trialMesh = (2742997 : ℚ) / 258046918656 ∧
      0 < trialMesh ∧ 0 < trialLargestCap ∧
      (∀ j : ℕ, 0 < trialCellMidpoint j ∧ 0 < trialProfileValue j) ∧
      0 < trialProfileNormalizer ∧ 0 < trialPhysicalNormalizer := by
  have hmeshEq : trialMesh = (2742997 : ℚ) / 258046918656 := by
    norm_num [trialMesh]
  have hmesh : 0 < trialMesh := by rw [hmeshEq]; norm_num
  have hcap : 0 < trialLargestCap := by
    dsimp only [trialLargestCap]
    positivity
  have hprofile (j : ℕ) : 0 < trialCellMidpoint j ∧ 0 < trialProfileValue j := by
    have ht : 0 < trialCellMidpoint j := by
      dsimp only [trialCellMidpoint]
      positivity
    refine ⟨ht, ?_⟩
    dsimp only [trialProfileValue, trialProfile]
    positivity
  have hZ : 0 < trialProfileNormalizer := by
    apply Finset.sum_pos' (fun j _ => sq_nonneg (trialProfileValue j))
    exact ⟨0, by simp, sq_pos_of_pos (hprofile 0).2⟩
  exact ⟨hmeshEq, hmesh, hcap, hprofile, hZ,
    pow_pos (mul_pos (Rat.cast_pos.mpr hmesh) (Rat.cast_pos.mpr hZ)) 40⟩

/-!
## Trial geometry and source-supported profiles

Match radial cells and atom caps to the source geometry before constructing smooth profiles.
-/

/-- The support geometry uses `ρ`, while the sieve uses the smaller `ρ_*`. -/
theorem trial_rational_geometry :
    physicalSourceRho - (2624989 / 10000000 : ℚ) = 1 / 10000000 ∧
      (2624989 / 10000000 : ℚ) < physicalSourceRho ∧
      physicalSourceOuterRadius = 2742997 / 2624989 ∧
      physicalSourceInnerRadius 0 = 2499106033 / 2624989000 ∧
      physicalSourceInnerRadius 1 = 2510000 / 2624989 ∧
      (2624989 / 10000000 : ℚ) * physicalSourceOuterRadius = 2742997 / 10000000 ∧
      (2624989 / 10000000 : ℚ) * physicalSourceInnerRadius 0 =
        2499106033 / 10000000000 ∧
      (2624989 / 10000000 : ℚ) * physicalSourceInnerRadius 1 = 251 / 1000 := by
  norm_num [physicalSourceRho, physicalSourceOuterRadius,
    physicalSourceInnerRadius, trialMesh]

/-- `trialLargestCap` is the numerical ambient cap rounded down to the grid.
The last inequality compares it with the main paper's ambient cap.
These are caps on individual atoms, not on the coordinate total. -/
theorem trial_aligned_ambient_cap :
    (⌊((19037 / 100000 : ℚ) / physicalSourceRho) / trialMesh⌋ : ℤ) = 68225 ∧
      trialLargestCap = trialMesh *
        ((⌊((19037 / 100000 : ℚ) / physicalSourceRho) / trialMesh⌋ : ℤ) : ℚ) ∧
      trialLargestCap < (19037 / 100000 : ℚ) / physicalSourceRho ∧
      (19037 / 100000 : ℚ) / physicalSourceRho <
        (19037 / 100000 : ℚ) / (2624989 / 10000000 : ℚ) := by
  norm_num [physicalSourceRho, trialMesh, trialLargestCap]

/-- Restriction to the aligned atom cap gives the physical measure, without
renormalizing it as a conditional probability measure. -/
theorem trialPhysicalMeasure_eq_cap_restriction (κ : ℝ)
    (hκ : (trialLargestCap : ℝ) ≤ κ) :
    (ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
      fragmentLaw κ).restrict
        {X : FiniteMeasure ℝ | (X : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0} =
      trialPhysicalMeasure :=
  (fragmentLaw_full_configuration_cap_restriction
    κ (trialLargestCap : ℝ)
    (Rat.cast_pos.mpr trial_fixed_positive_data.2.2.1) hκ).2

theorem trialCellIndex_eq_iff (X : FiniteMeasure ℝ) (j : ℕ) :
    trialCellIndex X = j ↔
      (j : ℝ) * (trialMesh : ℝ) ≤ (X.mass : ℝ) ∧
        (X.mass : ℝ) < ((j : ℝ) + 1) * (trialMesh : ℝ) := by
  have hmesh : 0 < (trialMesh : ℝ) := Rat.cast_pos.mpr trial_fixed_positive_data.2.1
  rw [trialCellIndex, Nat.floor_eq_iff (div_nonneg X.mass.coe_nonneg hmesh.le),
    le_div_iff₀ hmesh, div_lt_iff₀ hmesh]

theorem trial_mask_values_and_nesting :
    (∀ X : Fin 40 → FiniteMeasure ℝ,
      trialOuterMask X = 0 ∨ trialOuterMask X = 1) ∧
    ∀ Y : Fin 39 → FiniteMeasure ℝ,
      (trialBaseMask Y = 0 ∨ trialBaseMask Y = 1) ∧
      (trialEnlargedMask Y = 0 ∨ trialEnlargedMask Y = 1) ∧
      (trialFullMask Y = 0 ∨ trialFullMask Y = 1) ∧
      trialBaseMask Y ≤ trialEnlargedMask Y ∧
      trialEnlargedMask Y ≤ trialFullMask Y ∧
      trialEnlargedMask Y * (1 - trialBaseMask Y) =
        trialEnlargedMask Y - trialBaseMask Y ∧
      trialFullMask Y * (1 - trialEnlargedMask Y) =
        trialFullMask Y - trialEnlargedMask Y := by
  classical
  have hmono {P Q : Prop} {dP : Decidable P} {dQ : Decidable Q} (h : P → Q) :
      @ite ℝ P dP 1 0 ≤ @ite ℝ Q dQ 1 0 := by
    cases dP <;> cases dQ <;> simp_all
  have hnull {u v : ℕ} (huv : u ≤ v) (μ : FiniteMeasure ℝ)
      (hμ : (μ : Measure ℝ) (Set.Ioi ((u : ℝ) * (trialMesh : ℝ))) = 0) :
      (μ : Measure ℝ) (Set.Ioi ((v : ℝ) * (trialMesh : ℝ))) = 0 := by
    apply measure_mono_null _ hμ
    exact Set.Ioi_subset_Ioi (mul_le_mul_of_nonneg_right (Nat.cast_le.mpr huv)
      (Rat.cast_nonneg.mpr trial_fixed_positive_data.2.1.le))
  have hlayer {a b : ℝ} (ha : a = 0 ∨ a = 1) (hb : b = 0 ∨ b = 1)
      (hab : a ≤ b) : b * (1 - a) = b - a := by
    rcases ha with rfl | rfl <;> rcases hb with rfl | rfl <;> norm_num at *
  refine ⟨?_, ?_⟩
  · intro X
    dsimp only [trialOuterMask]
    exact (@ite_eq_or_eq ℝ _ _ _ _).symm
  intro Y
  let r : ℕ := ∑ i : Fin 39, trialCellIndex (Y i)
  let b : ℕ := if r ≤ 84930 then 68225 else if r ≤ 87194 then 44781 else 35265
  let e : ℕ := if r ≤ 85161 then 68225 else if r ≤ 87249 then 44976 else 35419
  have hbe : b ≤ e := by
    dsimp only [b, e]
    split_ifs <;> omega
  have hef : e ≤ 68225 := by
    dsimp only [e]
    split_ifs <;> omega
  have hb : trialBaseMask Y = 0 ∨ trialBaseMask Y = 1 := by
    dsimp only [trialBaseMask]
    exact (@ite_eq_or_eq ℝ _ _ _ _).symm
  have he : trialEnlargedMask Y = 0 ∨ trialEnlargedMask Y = 1 := by
    dsimp only [trialEnlargedMask]
    exact (@ite_eq_or_eq ℝ _ _ _ _).symm
  have hf : trialFullMask Y = 0 ∨ trialFullMask Y = 1 := by
    dsimp only [trialFullMask]
    exact (@ite_eq_or_eq ℝ _ _ _ _).symm
  have hBE : trialBaseMask Y ≤ trialEnlargedMask Y := by
    change (if r ≤ 89524 ∧ ∀ i : Fin 39,
      (Y i : Measure ℝ) (Set.Ioi ((b : ℝ) * (trialMesh : ℝ))) = 0 then (1 : ℝ) else 0) ≤
      if r ≤ 89914 ∧ ∀ i : Fin 39,
        (Y i : Measure ℝ) (Set.Ioi ((e : ℝ) * (trialMesh : ℝ))) = 0 then 1 else 0
    apply hmono
    rintro ⟨hr, hcap⟩
    exact ⟨by omega, fun i => hnull hbe (Y i) (hcap i)⟩
  have hEF : trialEnlargedMask Y ≤ trialFullMask Y := by
    change (if r ≤ 89914 ∧ ∀ i : Fin 39,
      (Y i : Measure ℝ) (Set.Ioi ((e : ℝ) * (trialMesh : ℝ))) = 0 then (1 : ℝ) else 0) ≤
      if r ≤ 98263 ∧ ∀ i : Fin 39,
        (Y i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0 then 1 else 0
    apply hmono
    rintro ⟨hr, hcap⟩
    refine ⟨by omega, fun i => ?_⟩
    simpa only [trialLargestCap, Rat.cast_mul, Rat.cast_ofNat, Nat.cast_ofNat] using
      hnull hef (Y i) (hcap i)
  exact ⟨hb, he, hf, hBE, hEF, hlayer hb he hBE, hlayer he hf hEF⟩

theorem trialStepFunction_cell_formula (X : Fin 40 → FiniteMeasure ℝ) :
    trialStepFunction X =
      trialOuterMask X *
        (∏ i : Fin 40, (trialProfileValue (trialCellIndex (X i)) : ℝ)) *
        ∑ s : Fin 11, ∑ d : Fin 7,
          ((trialCoefficientInteger s d : ℝ) / 10000000000) *
            ((((∑ i : Fin 40, trialCellIndex (X i) : ℕ) : ℝ) + 20) *
              (trialMesh : ℝ) - 9 / 10) ^ d.val *
            angularMonomial (trialAngularSignature s)
              (fun i => (trialCellMidpoint (trialCellIndex (X i)) : ℝ)) := by
  simp only [trialStepFunction_eq_cellExpression, trialRadialPolynomial_eval,
    Finset.sum_mul]

theorem trialStepFunction_support (X : Fin 40 → FiniteMeasure ℝ)
    (hX : trialStepFunction X ≠ 0) :
    (∑ i : Fin 40, trialCellIndex (X i)) ≤ 98263 ∧
      (∀ i : Fin 40, trialCellIndex (X i) < 98264) ∧
      ∀ i : Fin 40,
        (X i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0 := by
  classical
  have hmask : trialOuterMask X ≠ 0 := by
    intro hzero
    exact hX (by simp only [trialStepFunction_eq_cellExpression, hzero, zero_mul])
  let r : ℕ := ∑ i : Fin 40, trialCellIndex (X i)
  let cap : ℕ := if r ≤ 89196 then 68225 else if r ≤ 95598 then 49152 else 46580
  have hrow : r ≤ 98263 ∧ ∀ i : Fin 40,
      (X i : Measure ℝ) (Set.Ioi ((cap : ℝ) * (trialMesh : ℝ))) = 0 := by
    dsimp only [trialOuterMask] at hmask
    exact (ite_ne_right_iff.mp hmask).1
  have hcap : cap ≤ 68225 := by
    dsimp only [cap]
    split_ifs <;> omega
  refine ⟨hrow.1, ?_, ?_⟩
  · intro i
    exact Nat.lt_succ_of_le
      ((Finset.single_le_sum (fun _ _ => Nat.zero_le _)
        (Finset.mem_univ i)).trans hrow.1)
  · intro i
    have hnull : (X i : Measure ℝ)
        (Set.Ioi ((68225 : ℝ) * (trialMesh : ℝ))) = 0 := by
      apply measure_mono_null _ (hrow.2 i)
      exact Set.Ioi_subset_Ioi (mul_le_mul_of_nonneg_right (Nat.cast_le_ofNat.mpr hcap)
        (Rat.cast_nonneg.mpr trial_fixed_positive_data.2.1.le))
    simpa only [trialLargestCap, Rat.cast_mul, Rat.cast_ofNat] using hnull

theorem trial_data_measurable :
    Measurable trialCellIndex ∧
      Measurable trialOuterMask ∧
      Measurable trialBaseMask ∧
      Measurable trialEnlargedMask ∧
      Measurable trialFullMask ∧
      Measurable trialStepFunction ∧
      @Measurable (FiniteMeasure ℝ) ℕ
        (borel (FiniteMeasure ℝ)) inferInstance trialCellIndex ∧
      @Measurable (Fin 40 → FiniteMeasure ℝ) ℝ
        (borel (Fin 40 → FiniteMeasure ℝ)) inferInstance trialOuterMask ∧
      @Measurable (Fin 39 → FiniteMeasure ℝ) ℝ
        (borel (Fin 39 → FiniteMeasure ℝ)) inferInstance trialBaseMask ∧
      @Measurable (Fin 39 → FiniteMeasure ℝ) ℝ
        (borel (Fin 39 → FiniteMeasure ℝ)) inferInstance trialEnlargedMask ∧
      @Measurable (Fin 39 → FiniteMeasure ℝ) ℝ
        (borel (Fin 39 → FiniteMeasure ℝ)) inferInstance trialFullMask ∧
      @Measurable (Fin 40 → FiniteMeasure ℝ) ℝ
        (borel (Fin 40 → FiniteMeasure ℝ)) inferInstance trialStepFunction := by
  classical
  have hmask {α : Type} [MeasurableSpace α] {n : ℕ}
      (v : α → Fin n → FiniteMeasure ℝ)
      (hc : ∀ i : Fin n, Measurable fun a => trialCellIndex (v a i))
      (hz : ∀ (i : Fin n) (c : ℝ),
        MeasurableSet {a | (v a i : Measure ℝ) (Set.Ioi c) = 0})
      (N : ℕ) (cap : ℕ → ℝ) :
      Measurable fun a =>
        if (∑ i : Fin n, trialCellIndex (v a i)) ≤ N ∧
            ∀ i : Fin n,
              (v a i : Measure ℝ)
                (Set.Ioi (cap (∑ j : Fin n, trialCellIndex (v a j)))) = 0
        then (1 : ℝ) else 0 := by
    let r : α → ℕ := fun a => ∑ i : Fin n, trialCellIndex (v a i)
    have hr : Measurable r := Finset.measurable_sum Finset.univ fun i _ => hc i
    have hrows : Measurable fun p : α × ℕ =>
        if ∀ i : Fin n, (v p.1 i : Measure ℝ) (Set.Ioi (cap p.2)) = 0
        then (1 : ℝ) else 0 := by
      apply measurable_from_prod_countable_left
      intro k
      apply Measurable.ite ?_ measurable_const measurable_const
      rw [Set.ofPred_forall]
      exact MeasurableSet.iInter fun i => hz i (cap k)
    have hstop : Measurable fun a => if r a ≤ N then (1 : ℝ) else 0 :=
      Measurable.ite (measurableSet_le hr measurable_const) measurable_const measurable_const
    change Measurable fun a =>
      if r a ≤ N ∧ ∀ i : Fin n, (v a i : Measure ℝ) (Set.Ioi (cap (r a))) = 0
      then (1 : ℝ) else 0
    convert hstop.mul (hrows.comp (measurable_id.prodMk hr)) using 1
    funext a
    dsimp only [Function.comp_def]
    simp only [Pi.mul_apply, id_eq, ite_and, ite_mul, one_mul, zero_mul]
  have h40 (m : MeasurableSpace (Fin 40 → FiniteMeasure ℝ))
      (hc : ∀ i : Fin 40,
        @Measurable (Fin 40 → FiniteMeasure ℝ) ℕ m inferInstance
          (fun X => trialCellIndex (X i)))
      (hz : ∀ (i : Fin 40) (c : ℝ),
        @MeasurableSet (Fin 40 → FiniteMeasure ℝ) m
          {X | (X i : Measure ℝ) (Set.Ioi c) = 0}) :
      @Measurable (Fin 40 → FiniteMeasure ℝ) ℝ m inferInstance trialOuterMask ∧
        @Measurable (Fin 40 → FiniteMeasure ℝ) ℝ m inferInstance trialStepFunction := by
    let : MeasurableSpace (Fin 40 → FiniteMeasure ℝ) := m
    have ho : Measurable trialOuterMask :=
      hmask (fun X : Fin 40 → FiniteMeasure ℝ => X) hc hz 98263
        (fun r => ((if r ≤ 89196 then 68225 else if r ≤ 95598 then 49152 else 46580 : ℕ)
          : ℝ) * (trialMesh : ℝ))
    refine ⟨ho, ?_⟩
    let A : (Fin 40 → ℕ) → ℝ := fun j =>
      let r : ℕ := ∑ i : Fin 40, j i
      let t : Fin 40 → ℝ := fun i => (trialCellMidpoint (j i) : ℝ)
      let x : ℝ := ((r : ℝ) + 20) * (trialMesh : ℝ) - 9 / 10
      (∏ i : Fin 40, (trialProfileValue (j i) : ℝ)) *
        ∑ s : Fin 11,
          (trialRadialPolynomial s).eval₂ (Rat.castHom ℝ) x *
            angularMonomial (trialAngularSignature s) t
    have hj : Measurable fun X : Fin 40 → FiniteMeasure ℝ =>
        fun i : Fin 40 => trialCellIndex (X i) := measurable_pi_lambda _ hc
    have hfun : trialStepFunction = fun X : Fin 40 → FiniteMeasure ℝ =>
        trialOuterMask X * A (fun i => trialCellIndex (X i)) := by
      funext X
      rw [trialStepFunction_eq_cellExpression]
      dsimp only [A]
      exact mul_assoc _ _ _
    rw [hfun]
    exact ho.mul ((measurable_of_countable A).comp hj)
  have h39 (m : MeasurableSpace (Fin 39 → FiniteMeasure ℝ))
      (hc : ∀ i : Fin 39,
        @Measurable (Fin 39 → FiniteMeasure ℝ) ℕ m inferInstance
          (fun Y => trialCellIndex (Y i)))
      (hz : ∀ (i : Fin 39) (c : ℝ),
        @MeasurableSet (Fin 39 → FiniteMeasure ℝ) m
          {Y | (Y i : Measure ℝ) (Set.Ioi c) = 0}) :
      @Measurable (Fin 39 → FiniteMeasure ℝ) ℝ m inferInstance trialBaseMask ∧
        @Measurable (Fin 39 → FiniteMeasure ℝ) ℝ m inferInstance trialEnlargedMask ∧
        @Measurable (Fin 39 → FiniteMeasure ℝ) ℝ m inferInstance trialFullMask := by
    let : MeasurableSpace (Fin 39 → FiniteMeasure ℝ) := m
    refine ⟨?_, ?_, ?_⟩
    · exact hmask (fun Y : Fin 39 → FiniteMeasure ℝ => Y) hc hz 89524
        (fun r => ((if r ≤ 84930 then 68225 else if r ≤ 87194 then 44781 else 35265 : ℕ)
          : ℝ) * (trialMesh : ℝ))
    · exact hmask (fun Y : Fin 39 → FiniteMeasure ℝ => Y) hc hz 89914
        (fun r => ((if r ≤ 85161 then 68225 else if r ≤ 87249 then 44976 else 35419 : ℕ)
          : ℝ) * (trialMesh : ℝ))
    · exact hmask (fun Y : Fin 39 → FiniteMeasure ℝ => Y) hc hz 98263
        (fun _ => (trialLargestCap : ℝ))
  have hc : Measurable trialCellIndex :=
    (((Measure.measurable_coe MeasurableSet.univ).comp
      measurable_subtype_coe).ennreal_toReal.div_const (trialMesh : ℝ)).nat_floor
  have hz (c : ℝ) :
      MeasurableSet {X : FiniteMeasure ℝ | (X : Measure ℝ) (Set.Ioi c) = 0} :=
    (measurableSet_singleton (0 : ℝ≥0∞)).preimage
      ((Measure.measurable_coe measurableSet_Ioi).comp measurable_subtype_coe)
  obtain ⟨ho, hs⟩ := h40 inferInstance
    (fun i => hc.comp (measurable_pi_apply i))
    (fun i c => (hz c).preimage (measurable_pi_apply i))
  obtain ⟨hb, he, hf⟩ := h39 inferInstance
    (fun i => hc.comp (measurable_pi_apply i))
    (fun i c => (hz c).preimage (measurable_pi_apply i))
  have hclosed (c : ℝ) :
      IsClosed {X : FiniteMeasure ℝ | (X : Measure ℝ) (Set.Ioi c) = 0} := by
    apply isClosed_iff_forall_filter.mpr
    intro X L hL hLS hLX
    let : L.NeBot := hL
    have hm : Filter.Tendsto (fun Y : FiniteMeasure ℝ => (Y : Measure ℝ) Set.univ)
        L (nhds ((X : Measure ℝ) Set.univ)) := by
      simpa only [Function.comp_def, id_eq, FiniteMeasure.ennreal_mass] using
        (ENNReal.continuous_coe.tendsto X.mass).comp
          (Filter.tendsto_id'.mpr hLX).mass
    have hmass : (fun Y : FiniteMeasure ℝ => (Y : Measure ℝ) (Set.Iic c)) =ᶠ[L]
        (fun Y : FiniteMeasure ℝ => (Y : Measure ℝ) Set.univ) := by
      filter_upwards [hLS (Filter.mem_principal_self _)] with Y hY
      change (Y : Measure ℝ) (Set.Ioi c) = 0 at hY
      simpa only [Set.compl_Iic, hY, add_zero] using
        (measure_add_measure_compl (μ := (Y : Measure ℝ)) (s := Set.Iic c)
          measurableSet_Iic)
    have hport := FiniteMeasure.limsup_measure_closed_le_of_tendsto
      (μ := X) (μs := fun Y : FiniteMeasure ℝ => Y) (F := Set.Iic c)
      (Filter.tendsto_id'.mpr hLX) isClosed_Iic
    rw [Filter.limsup_congr hmass, hm.limsup_eq] at hport
    change (X : Measure ℝ) (Set.Ioi c) = 0
    rw [← Set.compl_Iic, measure_compl measurableSet_Iic
      (measure_ne_top (X : Measure ℝ) (Set.Iic c))]
    exact tsub_eq_zero_of_le hport
  have hcB : @Measurable (FiniteMeasure ℝ) ℕ
      (borel (FiniteMeasure ℝ)) inferInstance trialCellIndex := by
    let : MeasurableSpace (FiniteMeasure ℝ) := borel (FiniteMeasure ℝ)
    have : BorelSpace (FiniteMeasure ℝ) := ⟨rfl⟩
    exact ((NNReal.continuous_coe.comp FiniteMeasure.continuous_mass).measurable.div_const
      (trialMesh : ℝ)).nat_floor
  have hzB (c : ℝ) : @MeasurableSet (FiniteMeasure ℝ)
      (borel (FiniteMeasure ℝ))
      {X | (X : Measure ℝ) (Set.Ioi c) = 0} := by
    let : MeasurableSpace (FiniteMeasure ℝ) := borel (FiniteMeasure ℝ)
    have : BorelSpace (FiniteMeasure ℝ) := ⟨rfl⟩
    exact (hclosed c).measurableSet
  obtain ⟨hoB, hsB⟩ := h40 (borel (Fin 40 → FiniteMeasure ℝ))
    (fun i => hcB.comp (continuous_apply i).borel_measurable)
    (fun i c => (hzB c).preimage (continuous_apply i).borel_measurable)
  obtain ⟨hbB, heB, hfB⟩ := h39 (borel (Fin 39 → FiniteMeasure ℝ))
    (fun i => hcB.comp (continuous_apply i).borel_measurable)
    (fun i c => (hzB c).preimage (continuous_apply i).borel_measurable)
  exact ⟨hc, ho, hb, he, hf, hs, hcB, hoB, hbB, heB, hfB, hsB⟩

theorem trialStepFunction_finite_range :
    (Set.range trialStepFunction).Finite ∧
      Bornology.IsBounded (Set.range trialStepFunction) := by
  classical
  let P : (Fin 40 → Fin 98264) → ℝ := fun v =>
    (∏ i : Fin 40, (trialProfileValue (v i).val : ℝ)) *
      ∑ s : Fin 11, ∑ d : Fin 7,
        ((trialCoefficientInteger s d : ℝ) / 10000000000) *
          ((((∑ i : Fin 40, (v i).val : ℕ) : ℝ) + 20) *
            (trialMesh : ℝ) - 9 / 10) ^ d.val *
          angularMonomial (trialAngularSignature s)
            (fun i => (trialCellMidpoint (v i).val : ℝ))
  have hfinite : (Set.range trialStepFunction).Finite := by
    apply ((Set.finite_range P).insert 0).subset
    rintro _ ⟨X, rfl⟩
    by_cases hX : trialStepFunction X = 0
    · simp only [hX, Set.mem_insert_iff, true_or]
    · have hsupport := trialStepFunction_support X hX
      let v : Fin 40 → Fin 98264 := fun i => ⟨trialCellIndex (X i), hsupport.2.1 i⟩
      have hmask : trialOuterMask X = 1 :=
        (trial_mask_values_and_nesting.1 X).resolve_left
          (fun hzero => hX (by
            simp only [trialStepFunction_eq_cellExpression, hzero, zero_mul]))
      have hformula : trialStepFunction X = P v := by
        dsimp only [P, v]
        rw [trialStepFunction_cell_formula, hmask, one_mul]
      exact Set.mem_insert_of_mem 0 ⟨v, hformula.symm⟩
  exact ⟨hfinite, hfinite.isBounded⟩

theorem trialPhysicalMeasure_finite_mass :
    IsFiniteMeasure trialPhysicalMeasure ∧
      trialPhysicalMeasure Set.univ =
        ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * (trialLargestCap : ℝ)) := by
  let : IsProbabilityMeasure
      (fragmentLaw (trialLargestCap : ℝ)) :=
    fragmentLaw_isProbabilityMeasure _
  refine ⟨Measure.smul_finite
    (fragmentLaw (trialLargestCap : ℝ)) ENNReal.ofReal_ne_top, ?_⟩
  simp [trialPhysicalMeasure]

theorem trial_integrable_marginals :
    ∃ C : ℝ, 0 < C ∧
      (∀ X : Fin 40 → FiniteMeasure ℝ, ‖trialStepFunction X‖ ≤ C) ∧
      Integrable trialStepFunction
        (Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)) ∧
      Integrable (fun X : Fin 40 → FiniteMeasure ℝ => trialStepFunction X ^ 2)
        (Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)) ∧
      ∀ i : Fin 40,
        Measurable (trialMarginal i) ∧
        (∀ Y : Fin 39 → FiniteMeasure ℝ, ‖trialMarginal i Y‖ ≤ C) ∧
        Integrable (trialMarginal i)
          (Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)) ∧
        Integrable (fun Y : Fin 39 → FiniteMeasure ℝ => trialMarginal i Y ^ 2)
          (Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)) ∧
        (∀ Y : Fin 39 → FiniteMeasure ℝ,
          Integrable (fun X : FiniteMeasure ℝ => trialStepFunction (i.insertNth X Y))
            trialPhysicalMeasure ∧
          Integrable (fun X : FiniteMeasure ℝ × FiniteMeasure ℝ =>
            trialStepFunction (i.insertNth X.1 Y) * trialStepFunction (i.insertNth X.2 Y))
            (trialPhysicalMeasure.prod trialPhysicalMeasure)) ∧
        Integrable (fun Y : Fin 39 → FiniteMeasure ℝ =>
          trialBaseMask Y * trialMarginal i Y ^ 2)
          (Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)) ∧
        Integrable (fun Y : Fin 39 → FiniteMeasure ℝ =>
          trialEnlargedMask Y * (1 - trialBaseMask Y) * trialMarginal i Y ^ 2)
          (Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)) ∧
        Integrable (fun Y : Fin 39 → FiniteMeasure ℝ =>
          trialFullMask Y * (1 - trialEnlargedMask Y) * trialMarginal i Y ^ 2)
          (Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)) := by
  let : IsFiniteMeasure trialPhysicalMeasure := trialPhysicalMeasure_finite_mass.1
  obtain ⟨M, hM, hMF⟩ := trialStepFunction_finite_range.2.exists_pos_norm_le
  have hFM (X : Fin 40 → FiniteMeasure ℝ) : ‖trialStepFunction X‖ ≤ M :=
    hMF _ ⟨X, rfl⟩
  let C : ℝ := max M (M * trialPhysicalMeasure.real Set.univ)
  have hC : 0 < C := hM.trans_le (le_max_left _ _)
  have hFC (X : Fin 40 → FiniteMeasure ℝ) : ‖trialStepFunction X‖ ≤ C :=
    (hFM X).trans (le_max_left _ _)
  have hFmeas : Measurable trialStepFunction := trial_data_measurable.2.2.2.2.2.1
  have hFint : Integrable trialStepFunction
      (Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)) :=
    Integrable.of_bound hFmeas.aestronglyMeasurable C (ae_of_all _ hFC)
  have hFsq : Integrable (fun X : Fin 40 → FiniteMeasure ℝ => trialStepFunction X ^ 2)
      (Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)) := by
    simpa only [pow_two] using
      hFint.mul_bdd hFmeas.aestronglyMeasurable (ae_of_all _ hFC)
  have hins (i : Fin 40) : Measurable
      (fun Z : FiniteMeasure ℝ × (Fin 39 → FiniteMeasure ℝ) =>
        trialStepFunction (i.insertNth Z.1 Z.2)) := by
    change Measurable (trialStepFunction ∘
      (MeasurableEquiv.piFinSuccAbove (fun _ : Fin 40 => FiniteMeasure ℝ) i).symm)
    exact hFmeas.comp
      (MeasurableEquiv.piFinSuccAbove (fun _ : Fin 40 => FiniteMeasure ℝ) i).symm.measurable
  have hVmeas (i : Fin 40) : Measurable (trialMarginal i) :=
    ((hins i).stronglyMeasurable.integral_prod_left'
      (μ := trialPhysicalMeasure)).measurable
  have hVC (i : Fin 40) (Y : Fin 39 → FiniteMeasure ℝ) : ‖trialMarginal i Y‖ ≤ C :=
    (norm_integral_le_of_norm_le_const
      (μ := trialPhysicalMeasure) (ae_of_all _ fun X => hFM (i.insertNth X Y))).trans
        (le_max_right _ _)
  have hmask (Y : Fin 39 → FiniteMeasure ℝ) :
      ‖trialBaseMask Y‖ ≤ (1 : ℝ) ∧ ‖trialEnlargedMask Y‖ ≤ (1 : ℝ) ∧
        ‖trialFullMask Y‖ ≤ (1 : ℝ) ∧ ‖1 - trialBaseMask Y‖ ≤ (1 : ℝ) ∧
        ‖1 - trialEnlargedMask Y‖ ≤ (1 : ℝ) := by
    obtain ⟨hb, he, hf, _, _, _, _⟩ := trial_mask_values_and_nesting.2 Y
    rcases hb with hb | hb <;> rcases he with he | he <;> rcases hf with hf | hf <;>
      simp [hb, he, hf]
  refine ⟨C, hC, hFC, hFint, hFsq, ?_⟩
  intro i
  have hVi : Integrable (trialMarginal i)
      (Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)) :=
    Integrable.of_bound (hVmeas i).aestronglyMeasurable C (ae_of_all _ (hVC i))
  have hVsq : Integrable (fun Y : Fin 39 → FiniteMeasure ℝ => trialMarginal i Y ^ 2)
      (Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)) := by
    simpa only [pow_two] using
      hVi.mul_bdd (hVmeas i).aestronglyMeasurable (ae_of_all _ (hVC i))
  refine ⟨hVmeas i, hVC i, hVi, hVsq, ?_, ?_, ?_, ?_⟩
  · intro Y
    have hf : Integrable (fun X : FiniteMeasure ℝ => trialStepFunction (i.insertNth X Y))
        trialPhysicalMeasure :=
      Integrable.of_bound
        ((hins i).comp (measurable_id.prodMk measurable_const)).aestronglyMeasurable
        C (ae_of_all _ fun X => hFC (i.insertNth X Y))
    exact ⟨hf, hf.mul_prod hf⟩
  · exact hVsq.bdd_mul trial_data_measurable.2.2.1.aestronglyMeasurable
      (ae_of_all _ fun Y => (hmask Y).1)
  · apply hVsq.bdd_mul (c := 1)
      (trial_data_measurable.2.2.2.1.mul
        (measurable_const.sub trial_data_measurable.2.2.1)).aestronglyMeasurable
    filter_upwards [] with Y
    change ‖trialEnlargedMask Y * (1 - trialBaseMask Y)‖ ≤ 1
    rw [norm_mul]
    exact (mul_le_of_le_one_left (norm_nonneg _) (hmask Y).2.1).trans
      (hmask Y).2.2.2.1
  · apply hVsq.bdd_mul (c := 1)
      (trial_data_measurable.2.2.2.2.1.mul
        (measurable_const.sub trial_data_measurable.2.2.2.1)).aestronglyMeasurable
    filter_upwards [] with Y
    change ‖trialFullMask Y * (1 - trialEnlargedMask Y)‖ ≤ 1
    rw [norm_mul]
    exact (mul_le_of_le_one_left (norm_nonneg _) (hmask Y).2.2.1).trans
      (hmask Y).2.2.2.2

theorem trialMarginal_support_and_independent_square
    (i : Fin 40) (Y : Fin 39 → FiniteMeasure ℝ) :
    (trialMarginal i Y ≠ 0 → trialFullMask Y = 1) ∧
      trialMarginal i Y ^ 2 =
        ∫ X : FiniteMeasure ℝ × FiniteMeasure ℝ,
          trialStepFunction (i.insertNth X.1 Y) * trialStepFunction (i.insertNth X.2 Y)
          ∂(trialPhysicalMeasure.prod trialPhysicalMeasure) := by
  let : IsFiniteMeasure trialPhysicalMeasure := trialPhysicalMeasure_finite_mass.1
  have hsupport (X : FiniteMeasure ℝ)
      (hX : trialStepFunction (i.insertNth X Y) ≠ 0) : trialFullMask Y = 1 := by
    have h := trialStepFunction_support (i.insertNth X Y) hX
    have hretained : (∑ j : Fin 39, trialCellIndex (Y j)) ≤ 98263 := by
      have hr := h.1
      rw [Fin.sum_univ_succAbove _ i] at hr
      simp only [Fin.insertNth_apply_same, Fin.insertNth_apply_succAbove] at hr
      omega
    have hcap (j : Fin 39) :
        (Y j : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0 := by
      simpa only [Fin.insertNth_apply_succAbove] using h.2.2 (i.succAbove j)
    simp only [trialFullMask, hretained, hcap, implies_true, and_self, ite_true]
  refine ⟨?_, ?_⟩
  · intro hV
    obtain ⟨X, hX⟩ := exists_ne_zero_of_integral_ne_zero hV
    exact hsupport X hX
  · simpa only [trialMarginal, pow_two] using
      (integral_prod_mul (μ := trialPhysicalMeasure) (ν := trialPhysicalMeasure)
        (fun X : FiniteMeasure ℝ => trialStepFunction (i.insertNth X Y))
        (fun X : FiniteMeasure ℝ => trialStepFunction (i.insertNth X Y))).symm

theorem trial_positive_layers_partition :
    0 ≤ trialIH ∧ 0 ≤ trialJ0 ∧ 0 ≤ trialJPlus ∧ 0 ≤ trialJTail ∧
      trialJ0 + trialJPlus + trialJTail =
        (∑ i : Fin 40,
          ∫ Y : Fin 39 → FiniteMeasure ℝ, trialMarginal i Y ^ 2
            ∂Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)) / trialPhysicalNormalizer := by
  have hden : 0 < trialPhysicalNormalizer := trial_fixed_positive_data.2.2.2.2.2
  have hmask (Y : Fin 39 → FiniteMeasure ℝ) :
      0 ≤ trialBaseMask Y ∧ 0 ≤ trialEnlargedMask Y ∧ 0 ≤ trialFullMask Y ∧
        0 ≤ 1 - trialBaseMask Y ∧ 0 ≤ 1 - trialEnlargedMask Y := by
    obtain ⟨hb, he, hf, _, _, _, _⟩ := trial_mask_values_and_nesting.2 Y
    rcases hb with hb | hb <;> rcases he with he | he <;> rcases hf with hf | hf <;>
      simp [hb, he, hf]
  have hbase (i : Fin 40) (Y : Fin 39 → FiniteMeasure ℝ) :
      0 ≤ trialBaseMask Y * trialMarginal i Y ^ 2 :=
    mul_nonneg (hmask Y).1 (sq_nonneg _)
  have hplus (i : Fin 40) (Y : Fin 39 → FiniteMeasure ℝ) :
      0 ≤ trialEnlargedMask Y * (1 - trialBaseMask Y) * trialMarginal i Y ^ 2 :=
    mul_nonneg (mul_nonneg (hmask Y).2.1 (hmask Y).2.2.2.1) (sq_nonneg _)
  have htail (i : Fin 40) (Y : Fin 39 → FiniteMeasure ℝ) :
      0 ≤ trialFullMask Y * (1 - trialEnlargedMask Y) * trialMarginal i Y ^ 2 :=
    mul_nonneg (mul_nonneg (hmask Y).2.2.1 (hmask Y).2.2.2.2) (sq_nonneg _)
  refine ⟨div_nonneg (integral_nonneg fun _ => sq_nonneg _) hden.le,
    div_nonneg (Finset.sum_nonneg fun i _ => integral_nonneg (hbase i)) hden.le,
    div_nonneg (Finset.sum_nonneg fun i _ => integral_nonneg (hplus i)) hden.le,
    div_nonneg (Finset.sum_nonneg fun i _ => integral_nonneg (htail i)) hden.le, ?_⟩
  obtain ⟨_, _, _, _, _, hV⟩ := trial_integrable_marginals
  have hpoint (i : Fin 40) (Y : Fin 39 → FiniteMeasure ℝ) :
      trialBaseMask Y * trialMarginal i Y ^ 2 +
          trialEnlargedMask Y * (1 - trialBaseMask Y) * trialMarginal i Y ^ 2 +
          trialFullMask Y * (1 - trialEnlargedMask Y) * trialMarginal i Y ^ 2 =
        trialMarginal i Y ^ 2 := by
    obtain ⟨_, _, _, _, _, hBE, hEF⟩ := trial_mask_values_and_nesting.2 Y
    rw [hBE, hEF]
    by_cases hzero : trialMarginal i Y = 0
    · simp [hzero]
    · rw [(trialMarginal_support_and_independent_square i Y).1 hzero]
      ring
  unfold trialJ0 trialJPlus trialJTail
  rw [← add_div, ← add_div, ← Finset.sum_add_distrib, ← Finset.sum_add_distrib]
  congr 1
  apply Finset.sum_congr rfl
  intro i _
  obtain ⟨_, _, _, _, _, hb, hp, ht⟩ := hV i
  rw [← integral_add hb hp, ← integral_add (hb.fun_add hp) ht]
  exact integral_congr_ae (ae_of_all _ (hpoint i))

theorem physicalSourceCountMeasure_regular (d : ℕ) :
    Measurable (fun X : Fin d → FiniteMeasure ℝ => physicalSourceCountMeasure X) ∧
      ∀ a : ℝ, 0 < a → ∀ X : Fin d → FiniteMeasure ℝ,
        IsFiniteMeasure ((physicalSourceCountMeasure X).restrict (Set.Ioi a)) ∧
          (physicalSourceCountMeasure X).real (Set.Ioi a) ≤
            (∑ i : Fin d, ((X i).mass : ℝ)) / a := by
  classical
  constructor
  · apply Measure.measurable_of_measurable_coe
    intro s hs
    have hsum : Measurable (fun X : Fin d → FiniteMeasure ℝ =>
        ∑ i : Fin d, (X i : Measure ℝ)) :=
      Finset.measurable_fun_sum Finset.univ fun i _ =>
        measurable_subtype_coe.comp (measurable_pi_apply i)
    have hf : Measurable (fun t : ℝ => ENNReal.ofReal t⁻¹) := by fun_prop
    have hsi : MeasurableSet (s ∩ Set.Ioi (0 : ℝ)) := hs.inter measurableSet_Ioi
    have htest := (Measure.measurable_lintegral (hf.indicator hsi)).comp hsum
    simpa only [physicalSourceCountMeasure, withDensity_apply _ hs,
      Measure.restrict_restrict hs, lintegral_indicator hsi, Function.comp_def]
      using htest
  · intro a ha X
    let μ : Measure ℝ := ∑ i : Fin d, (X i : Measure ℝ)
    have hbound : physicalSourceCountMeasure X (Set.Ioi a) ≤
        ENNReal.ofReal a⁻¹ * μ Set.univ := by
      change ((μ.restrict (Set.Ioi (0 : ℝ))).withDensity
        (fun t : ℝ => ENNReal.ofReal t⁻¹)) (Set.Ioi a) ≤ _
      rw [withDensity_apply _ measurableSet_Ioi,
        Measure.restrict_restrict_of_subset (Set.Ioi_subset_Ioi ha.le)]
      calc
        _ ≤ ∫⁻ _t : ℝ in Set.Ioi a, ENNReal.ofReal a⁻¹ ∂μ := by
          apply lintegral_mono_ae
          filter_upwards [ae_restrict_mem measurableSet_Ioi] with t ht
          exact ENNReal.ofReal_le_ofReal (inv_anti₀ ha ht.le)
        _ = ENNReal.ofReal a⁻¹ * μ (Set.Ioi a) := by
          rw [lintegral_const, Measure.restrict_apply_univ]
        _ ≤ ENNReal.ofReal a⁻¹ * μ Set.univ :=
          mul_le_mul_right (measure_mono (Set.subset_univ _)) _
    have htop : ENNReal.ofReal a⁻¹ * μ Set.univ < ∞ :=
      ENNReal.mul_lt_top ENNReal.ofReal_lt_top (measure_lt_top μ Set.univ)
    refine ⟨isFiniteMeasure_restrict.mpr (hbound.trans_lt htop).ne, ?_⟩
    have hmass : (μ Set.univ).toReal = ∑ i : Fin d, ((X i).mass : ℝ) := by
      dsimp only [μ]
      rw [Measure.finsetSum_apply, ENNReal.toReal_sum (by finiteness)]
      simp only [← FiniteMeasure.ennreal_mass, ENNReal.coe_toReal]
    change (physicalSourceCountMeasure X (Set.Ioi a)).toReal ≤ _
    calc
      _ ≤ (ENNReal.ofReal a⁻¹ * μ Set.univ).toReal :=
        ENNReal.toReal_mono htop.ne hbound
      _ = (∑ i : Fin d, ((X i).mass : ℝ)) / a := by
        rw [ENNReal.toReal_mul, ENNReal.toReal_ofReal (inv_nonneg.mpr ha.le), hmass]
        ring

theorem physicalSource_rank_cover_regular
    (d : ℕ) (m U a b : ℝ) (hm : 0 < m) (ha : 0 < a) (hb : b < U) :
    let K : (Fin d → FiniteMeasure ℝ) → ℝ := fun X =>
      ∫ q : ℝ in Set.Ioc a b,
        (if physicalSourceCountMeasure X (Set.Ioi q) = 0 ∧
            (2 : ℝ) ≤ (physicalSourceCountMeasure X).real
              (Set.Ioc ((U - q) / m) q)
          then (1 : ℝ) else 0) ∂physicalSourceCountMeasure X
    Measurable K ∧
      ∀ X : Fin d → FiniteMeasure ℝ,
        0 ≤ K X ∧ K X ≤ (∑ i : Fin d, ((X i).mass : ℝ)) / a := by
  classical
  intro K
  let A : ℝ := min a ((U - b) / m)
  have hA : 0 < A := lt_min ha (div_pos (sub_pos.mpr hb) hm)
  have hregular := physicalSourceCountMeasure_regular d
  let ν : ProbabilityTheory.Kernel (Fin d → FiniteMeasure ℝ) ℝ :=
    ⟨physicalSourceCountMeasure, hregular.1⟩
  let κ : ProbabilityTheory.Kernel (Fin d → FiniteMeasure ℝ) ℝ :=
    ν.restrict (s := Set.Ioi A) measurableSet_Ioi
  have hκ (X : Fin d → FiniteMeasure ℝ) : IsFiniteMeasure (κ X) :=
    (hregular.2 A hA X).1
  let η : ProbabilityTheory.Kernel ((Fin d → FiniteMeasure ℝ) × ℝ) ℝ :=
    ⟨fun z => κ z.1, κ.measurable.comp measurable_fst⟩
  have htail : Measurable (fun z : (Fin d → FiniteMeasure ℝ) × ℝ =>
      κ z.1 (Set.Ioi z.2)) :=
    ProbabilityTheory.Kernel.measurable_kernel_prodMk_left_of_finite (κ := η)
      (measurableSet_lt measurable_fst.snd measurable_snd) (fun z => hκ z.1)
  have hwindow : Measurable (fun z : (Fin d → FiniteMeasure ℝ) × ℝ =>
      κ z.1 (Set.Ioc ((U - z.2) / m) z.2)) :=
    ProbabilityTheory.Kernel.measurable_kernel_prodMk_left_of_finite (κ := η)
      ((measurableSet_lt ((measurable_const.sub measurable_fst.snd).div_const m)
        measurable_snd).inter (measurableSet_le measurable_snd measurable_fst.snd))
      (fun z => hκ z.1)
  let E : Set ((Fin d → FiniteMeasure ℝ) × ℝ) :=
    {z | z.2 ∈ Set.Ioc a b ∧ κ z.1 (Set.Ioi z.2) = 0 ∧
      (2 : ℝ) ≤ (κ z.1).real (Set.Ioc ((U - z.2) / m) z.2)}
  have hE : MeasurableSet E :=
    (measurableSet_Ioc.preimage measurable_snd).inter
      ((measurableSet_eq_fun htail measurable_const).inter
        (measurableSet_le measurable_const hwindow.ennreal_toReal))
  have hmass : Measurable (fun X : Fin d → FiniteMeasure ℝ =>
      (κ X).real (Prod.mk X ⁻¹' E)) :=
    (ProbabilityTheory.Kernel.measurable_kernel_prodMk_left_of_finite
      (κ := κ) hE hκ).ennreal_toReal
  have hbin : Set.Ioc a b ⊆ Set.Ioi A :=
    fun q hq => (min_le_left a ((U - b) / m)).trans_lt hq.1
  have hlower (q : ℝ) (hq : q ∈ Set.Ioc a b) : A ≤ (U - q) / m :=
    (min_le_right a ((U - b) / m)).trans
      (div_le_div_of_nonneg_right (sub_le_sub_left hq.2 U) hm.le)
  have hK (X : Fin d → FiniteMeasure ℝ) : K X = (κ X).real (Prod.mk X ⁻¹' E) := by
    have htail_eq (q : ℝ) (hq : q ∈ Set.Ioc a b) :
        κ X (Set.Ioi q) = physicalSourceCountMeasure X (Set.Ioi q) :=
      Measure.restrict_eq_self _ (Set.Ioi_subset_Ioi (hbin hq).le)
    have hwindow_eq (q : ℝ) (hq : q ∈ Set.Ioc a b) :
        (κ X).real (Set.Ioc ((U - q) / m) q) =
          (physicalSourceCountMeasure X).real (Set.Ioc ((U - q) / m) q) :=
      congrArg ENNReal.toReal (Measure.restrict_eq_self (physicalSourceCountMeasure X)
        (fun t ht => (hlower q hq).trans_lt ht.1))
    calc
      K X = ∫ q : ℝ in Set.Ioc a b,
          (if κ X (Set.Ioi q) = 0 ∧
              (2 : ℝ) ≤ (κ X).real (Set.Ioc ((U - q) / m) q)
            then (1 : ℝ) else 0) ∂physicalSourceCountMeasure X := by
        apply setIntegral_congr_fun measurableSet_Ioc
        intro q hq
        simp only [htail_eq q hq, hwindow_eq q hq]
      _ = ∫ q : ℝ in Set.Ioc a b,
          (if κ X (Set.Ioi q) = 0 ∧
              (2 : ℝ) ≤ (κ X).real (Set.Ioc ((U - q) / m) q)
            then (1 : ℝ) else 0) ∂κ X := by
        rw [show (κ X).restrict (Set.Ioc a b) =
            (physicalSourceCountMeasure X).restrict (Set.Ioc a b) from
          Measure.restrict_restrict_of_subset hbin]
      _ = ∫ q : ℝ, (Prod.mk X ⁻¹' E).indicator (fun _ => (1 : ℝ)) q ∂κ X := by
        rw [← integral_indicator measurableSet_Ioc]
        apply integral_congr_ae
        exact Filter.Eventually.of_forall fun q => by
          simp only [Set.indicator, Set.mem_preimage, E, Set.mem_ofPred_eq, ite_and]
      _ = (κ X).real (Prod.mk X ⁻¹' E) :=
        integral_indicator_one (hE.preimage measurable_prodMk_left)
  refine ⟨(funext hK).symm ▸ hmass, ?_⟩
  intro X
  rw [hK X]
  let : IsFiniteMeasure (κ X) := hκ X
  refine ⟨measureReal_nonneg, ?_⟩
  calc
    _ ≤ (κ X).real (Set.Ioi a) :=
      measureReal_mono (fun q hq => hq.1.1)
    _ = (physicalSourceCountMeasure X).real (Set.Ioi a) :=
      congrArg ENNReal.toReal (Measure.restrict_eq_self (physicalSourceCountMeasure X)
        (Set.Ioi_subset_Ioi (min_le_left a ((U - b) / m))))
    _ ≤ (∑ i : Fin d, ((X i).mass : ℝ)) / a := (hregular.2 a ha X).2

/--
The number of entries in the two physical-source ladders: `29` for index `0` and `43` for index
`1`.
-/
def physicalSourceLadderLength (ν : Fin 2) : ℕ := if ν = 0 then 29 else 43

theorem physicalSource_first_hit_and_monotone :
    ∀ ν : Fin 2,
      let L := physicalSourceLadderLength ν
      let Ω : ℚ := if ν = 0 then 12499 / 1000000 else 253 / 20000
      physicalSourceOmegaPrefix ν 0 = 0 ∧
      StrictMono (fun t : Fin (L + 1) => physicalSourceOmegaPrefix ν t.val) ∧
      physicalSourceOmegaPrefix ν L = Ω ∧
      (∀ t : Fin L, physicalSourceOmegaPrefix ν t.val < Ω) ∧
      [((Finset.range L).filter (fun t => physicalSourceOrder t = 1)).card,
        ((Finset.range L).filter (fun t => physicalSourceOrder t = 2)).card,
        ((Finset.range L).filter (fun t => physicalSourceOrder t = 3)).card] =
        if ν = 0 then [12, 12, 5] else [12, 12, 19] := by
  intro ν L Ω
  have hlast : physicalSourceOmegaPrefix ν L = Ω := by
    fin_cases ν <;> decide +kernel
  have hmono : StrictMono (fun t : Fin (L + 1) => physicalSourceOmegaPrefix ν t.val) := by
    apply Fin.strictMono_iff_lt_succ.mpr
    fin_cases ν <;> decide +kernel
  refine ⟨rfl, hmono, hlast, ?_, ?_⟩
  · intro t
    exact (hmono t.castSucc_lt_last).trans_eq hlast
  · fin_cases ν <;> decide +kernel

theorem physicalSource_actual_lcm_bands :
    ∀ ν : Fin 2,
      let K : ℕ := if ν = 0 then 28 else 39
      let M : ℚ := 98303 * trialMesh +
        (if ν = 0 then 89563 else 89953) * trialMesh
      (physicalSourceRow ν 0).lowerBand = (1 / 2) / physicalSourceRho ∧
      (∀ t : ℕ,
        (physicalSourceRow ν t).upperBand = (physicalSourceRow ν (t + 1)).lowerBand) ∧
      (∀ t : Fin (physicalSourceLadderLength ν),
        (physicalSourceRow ν t.val).lowerBand < M ↔ t.val < K) ∧
      (∀ z : ℝ,
        (((1 / 2) / physicalSourceRho : ℚ) : ℝ) < z → z ≤ (M : ℝ) →
          ∃ t : Fin (physicalSourceLadderLength ν),
            t.val < K ∧
              ((physicalSourceRow ν t.val).lowerBand : ℝ) < z ∧
              z ≤ ((physicalSourceRow ν t.val).upperBand : ℝ)) := by
  intro ν K M
  let L := physicalSourceLadderLength ν
  have hρ : (0 : ℚ) < physicalSourceRho := by decide +kernel
  have hK : K < L := by
    fin_cases ν <;> decide
  have hprefix : StrictMono
      (fun t : Fin (L + 1) => physicalSourceOmegaPrefix ν t.val) :=
    (physicalSource_first_hit_and_monotone ν).2.1
  have hmono (i j : ℕ) (hi : i ≤ L) (hj : j ≤ L) (hij : i ≤ j) :
      (physicalSourceRow ν i).lowerBand ≤ (physicalSourceRow ν j).lowerBand := by
    have hp : physicalSourceOmegaPrefix ν i ≤ physicalSourceOmegaPrefix ν j :=
      hprefix.monotone
        (show (⟨i, Nat.lt_succ_of_le hi⟩ : Fin (L + 1)) ≤
          ⟨j, Nat.lt_succ_of_le hj⟩ from hij)
    change (1 / 2 + 2 * physicalSourceOmegaPrefix ν i) / physicalSourceRho ≤
      (1 / 2 + 2 * physicalSourceOmegaPrefix ν j) / physicalSourceRho
    gcongr
  have hboundary :
      (physicalSourceRow ν (K - 1)).lowerBand < M ∧
        M ≤ (physicalSourceRow ν K).lowerBand := by
    dsimp only [K, M]
    fin_cases ν <;> decide +kernel
  have hretained (t : Fin L) :
      (physicalSourceRow ν t.val).lowerBand < M ↔ t.val < K := by
    constructor
    · intro ht
      by_contra hnot
      have hKt : K ≤ t.val := Nat.le_of_not_gt hnot
      exact (not_lt_of_ge (hboundary.2.trans
        (hmono K t.val hK.le t.isLt.le hKt))) ht
    · intro ht
      exact lt_of_le_of_lt
        (hmono t.val (K - 1) t.isLt.le
          ((Nat.sub_le K 1).trans hK.le) (Nat.le_sub_one_of_lt ht))
        hboundary.1
  have hzero : (physicalSourceRow ν 0).lowerBand =
      (1 / 2) / physicalSourceRho := by
    change ((1 / 2 : ℚ) + 2 * 0) / physicalSourceRho = _
    simp
  have hadj (t : ℕ) :
      (physicalSourceRow ν t).upperBand = (physicalSourceRow ν (t + 1)).lowerBand := rfl
  refine ⟨hzero, hadj, hretained, ?_⟩
  intro z hz0 hzM
  have hM : (M : ℝ) ≤ ((physicalSourceRow ν K).lowerBand : ℝ) :=
    (Rat.cast_le (K := ℝ)).mpr hboundary.2
  have hz : z ∈ Set.Ioc ((physicalSourceRow ν 0).lowerBand : ℝ)
      ((physicalSourceRow ν K).lowerBand : ℝ) :=
    ⟨by simpa only [hzero] using hz0, hzM.trans hM⟩
  have hcover := Ioc_subset_biUnion_Ioc K
    (fun t : ℕ => ((physicalSourceRow ν t).lowerBand : ℝ)) hz
  rcases Set.mem_iUnion₂.mp hcover with ⟨t, ht, hzt⟩
  have htK : t < K := Finset.mem_range.mp ht
  refine ⟨⟨t, lt_trans htK hK⟩, htK, hzt.1, ?_⟩
  simpa only [hadj] using hzt.2

theorem physicalSource_retained_thresholds :
    ∀ ν : Fin 2,
      (∀ t : Fin (physicalSourceLadderLength ν - 1),
        physicalSourceRho * (physicalSourceRow ν t.val).activation -
          (physicalSourceRho *
            (physicalSourceOuterRadius + physicalSourceInnerRadius ν) - 1 / 2) +
          2 * physicalSourceOmegaPrefix ν t.val = (1 : ℚ) / 10000000) ∧
      (∀ t : Fin (if ν = 0 then 28 else 39),
        (physicalSourceRow ν t.val).outerThreshold =
            physicalSourceOuterRadius +
              (if physicalSourceOrder t.val ≤ 2
                then physicalSourceAdvance else physicalSourceAdvance / 2) ∧
        (physicalSourceRow ν t.val).innerThreshold =
            physicalSourceInnerRadius ν +
              (if physicalSourceOrder t.val ≤ 2
                then physicalSourceAdvance else physicalSourceAdvance / 2)) := by
  intro ν
  let Ω : ℚ := if ν = 0 then 12499 / 1000000 else 253 / 20000
  let ε : ℚ := if ν = 0 then 1 / 1000000 else 1 / 10000000
  let E : ℚ := physicalSourceRho *
    (physicalSourceOuterRadius + physicalSourceInnerRadius ν) - 1 / 2
  have hρ : physicalSourceRho ≠ 0 := by decide +kernel
  have hprefix : ∀ t : Fin (physicalSourceLadderLength ν),
      physicalSourceOmegaPrefix ν t.val < Ω :=
    (physicalSource_first_hit_and_monotone ν).2.2.2.1
  have hslack : ∀ t : Fin (physicalSourceLadderLength ν - 1),
      physicalSourceRho * (physicalSourceRow ν t.val).activation - E +
        2 * physicalSourceOmegaPrefix ν t.val = (1 : ℚ) / 10000000 := by
    intro t
    have ht := Nat.add_lt_of_lt_sub t.isLt
    have hbefore := hprefix ⟨t.val, Nat.lt_of_succ_lt ht⟩
    have hafter := hprefix ⟨t.val + 1, ht⟩
    let cs := physicalSourceAffine ν t.val
    have hslope : cs.2 ≠ 0 := by
      dsimp only [cs, physicalSourceAffine]
      split_ifs <;> norm_num
    have hrec : physicalSourceOmegaPrefix ν (t.val + 1) =
        min Ω ((cs.1 - ε - E + 2 * physicalSourceOmegaPrefix ν t.val -
          1 / 10000000) / cs.2) :=
      ite_eq_right (ne_of_lt hbefore)
    have haff : (cs.1 - ε - E + 2 * physicalSourceOmegaPrefix ν t.val -
        1 / 10000000) / cs.2 < Ω :=
      (min_lt_iff.mp (hrec ▸ hafter)).resolve_left (lt_irrefl Ω)
    have hnext := hrec.trans (min_eq_right_of_lt haff)
    have hmul := (div_eq_iff hslope).mp hnext.symm
    change physicalSourceRho *
      ((cs.1 - cs.2 * physicalSourceOmegaPrefix ν (t.val + 1) - ε) /
        physicalSourceRho) - E + 2 * physicalSourceOmegaPrefix ν t.val =
          (1 : ℚ) / 10000000
    rw [mul_div_cancel₀ _ hρ]
    linear_combination hmul
  refine ⟨hslack, ?_⟩
  intro t
  have ht : t.val < physicalSourceLadderLength ν - 1 := by
    have ht' := t.isLt
    fin_cases ν <;> norm_num [physicalSourceLadderLength] at ht' ⊢ <;> omega
  have hs := hslack ⟨t.val, ht⟩
  let B := (physicalSourceRow ν t.val).lowerBand
  let ξ := (physicalSourceRow ν t.val).activation
  have hB : physicalSourceRho * B =
      1 / 2 + 2 * physicalSourceOmegaPrefix ν t.val :=
    mul_div_cancel₀ _ hρ
  have he : physicalSourceRho * physicalSourceAdvance = (1 : ℚ) / 10000000 :=
    mul_div_cancel₀ _ hρ
  have hkey : B + ξ = physicalSourceOuterRadius + physicalSourceInnerRadius ν +
      physicalSourceAdvance := by
    apply mul_left_cancel₀ hρ
    change physicalSourceRho * ξ - E + 2 * physicalSourceOmegaPrefix ν t.val =
      (1 : ℚ) / 10000000 at hs
    dsimp only [E] at hs
    linear_combination hs + hB - he
  change
    (B - physicalSourceInnerRadius ν +
        (if physicalSourceOrder t.val ≤ 2 then ξ else
          (ξ + physicalSourceOuterRadius + physicalSourceInnerRadius ν - B) / 2) =
      physicalSourceOuterRadius +
        (if physicalSourceOrder t.val ≤ 2 then physicalSourceAdvance else
          physicalSourceAdvance / 2)) ∧
    (B - physicalSourceOuterRadius +
        (if physicalSourceOrder t.val ≤ 2 then ξ else
          (ξ + physicalSourceOuterRadius + physicalSourceInnerRadius ν - B) / 2) =
      physicalSourceInnerRadius ν +
        (if physicalSourceOrder t.val ≤ 2 then physicalSourceAdvance else
          physicalSourceAdvance / 2))
  by_cases horder : physicalSourceOrder t.val ≤ 2 <;>
    simp only [horder, ↓reduceIte] <;> constructor <;> linarith only [hkey]

theorem physicalSource_fixed_cutoffs (g : Fin 6) :
    0 < (physicalSourceGroup g).order ∧
      0 < (physicalSourceGroup g).split ∧
      ∀ j : ℕ, j < physicalSourceRowCount g →
        (physicalSourceComponentKind g j < 2 →
          0 < (physicalSourceComponentEndpoints g j).1) ∧
        (physicalSourceComponentKind g j = 1 →
          (physicalSourceComponentEndpoints g j).2 < (physicalSourceGroup g).threshold) := by
  classical
  have hρ : (0 : ℚ) < physicalSourceRho := by norm_num [physicalSourceRho]
  have hactivation (ν : Fin 2) (t : ℕ)
      (ht : t < if ν = 0 then 28 else 39) :
      0 < (physicalSourceRow ν t).activation := by
    have htB : t < physicalSourceLadderLength ν - 1 := by
      fin_cases ν <;> norm_num [physicalSourceLadderLength] at ht ⊢ <;> omega
    have hband := ((physicalSource_actual_lcm_bands ν).2.2.1
      ⟨t, htB.trans_le (Nat.sub_le _ _)⟩).mpr ht
    have hmax : 98303 * trialMesh +
        (if ν = 0 then 89563 else 89953) * trialMesh ≤
          physicalSourceOuterRadius + physicalSourceInnerRadius ν := by
      fin_cases ν <;>
        norm_num [physicalSourceOuterRadius, physicalSourceInnerRadius, trialMesh]
    have hsmall : (physicalSourceRow ν t).lowerBand <
        physicalSourceOuterRadius + physicalSourceInnerRadius ν := hband.trans_le hmax
    have hs := (physicalSource_retained_thresholds ν).1 ⟨t, htB⟩
    have hB : physicalSourceRho * (physicalSourceRow ν t).lowerBand =
        1 / 2 + 2 * physicalSourceOmegaPrefix ν t := by
      change physicalSourceRho *
        ((1 / 2 + 2 * physicalSourceOmegaPrefix ν t) / physicalSourceRho) = _
      exact mul_div_cancel₀ _ hρ.ne'
    have hmul := mul_lt_mul_of_pos_left hsmall hρ
    nlinarith only [hs, hB, hmul, hρ]
  have hξ : 0 < (physicalSourceGroup g).activation := by
    fin_cases g
    · exact hactivation 0 23 (by decide)
    · exact hactivation 1 38 (by decide)
    · exact hactivation 0 23 (by decide)
    · exact hactivation 0 27 (by decide)
    · exact hactivation 1 23 (by decide)
    · exact hactivation 1 38 (by decide)
  have hparameters : 0 < (physicalSourceGroup g).order ∧
      0 < (physicalSourceGroup g).split ∧
      0 < (physicalSourceGroup g).threshold ∧
      (physicalSourceGroup g).cap < (physicalSourceGroup g).threshold ∧
      (physicalSourceGroup g).threshold / ((physicalSourceGroup g).order + 1) ≤
        (physicalSourceGroup g).cap := by
    fin_cases g <;>
      norm_num [physicalSourceGroup, physicalSourceOuterRadius, physicalSourceInnerRadius,
        physicalSourceAdvance, physicalSourceRho, trialMesh]
  obtain ⟨hm, hp, hU, hcap, hqcap⟩ := hparameters
  have hlowpos : ∀ x ∈ physicalSourceLowBoundaries g, (0 : ℚ) < x := by
    fin_cases g <;> norm_num [physicalSourceLowBoundaries] <;>
      first | exact ⟨hξ, hp⟩ | exact ⟨hξ, add_pos (by norm_num) hp, hp⟩
  have hfractions : ∀ x ∈ physicalSourceRankFractions g, (0 : ℚ) ≤ x ∧ x ≤ 1 := by
    fin_cases g <;> norm_num [physicalSourceRankFractions]
  have hget {α : Type} (l : List α) (z : α) (n : ℕ) (hn : n < l.length) :
      l.getD n z ∈ l :=
    List.mem_of_getElem (l.getD_eq_getElem z hn).symm
  have hconvex (v : ℚ) (hv : 0 ≤ v ∧ v ≤ 1) :
      0 < (physicalSourceGroup g).threshold / ((physicalSourceGroup g).order + 1) +
          v * ((physicalSourceGroup g).cap -
            (physicalSourceGroup g).threshold / ((physicalSourceGroup g).order + 1)) ∧
      (physicalSourceGroup g).threshold / ((physicalSourceGroup g).order + 1) +
          v * ((physicalSourceGroup g).cap -
            (physicalSourceGroup g).threshold / ((physicalSourceGroup g).order + 1)) <
        (physicalSourceGroup g).threshold := by
    have hq : 0 < (physicalSourceGroup g).threshold /
        ((physicalSourceGroup g).order + 1) := div_pos hU (by positivity)
    simpa only [smul_eq_mul, Set.mem_Ioo] using
      (convex_Ioo (𝕜 := ℚ) (0 : ℚ) (physicalSourceGroup g).threshold).add_smul_sub_mem
        ⟨hq, hqcap.trans_lt hcap⟩ ⟨hq.trans_le hqcap, hcap⟩ hv
  have hrank (j : ℕ) (hk : physicalSourceComponentKind g j = 1) :
      0 < (physicalSourceComponentEndpoints g j).1 ∧
        (physicalSourceComponentEndpoints g j).2 < (physicalSourceGroup g).threshold := by
    have hindices : physicalSourceLowCount g ≤ j ∧
        j < physicalSourceLowCount g + physicalSourceRankCount g := by
      unfold physicalSourceComponentKind at hk
      split_ifs at hk <;> omega
    have hlength : j - physicalSourceLowCount g + 1 <
        (physicalSourceRankFractions g).length := by
      dsimp only [physicalSourceRankCount] at hindices
      omega
    have hfirst := hconvex _ (hfractions _ (hget _ 0 _ (by omega :
      j - physicalSourceLowCount g < (physicalSourceRankFractions g).length)))
    have hsecond := hconvex _ (hfractions _ (hget _ 0 _ hlength))
    simpa only [physicalSourceComponentEndpoints, hk, one_ne_zero, ↓reduceIte] using
      And.intro hfirst.1 hsecond.2
  refine ⟨hm, hp, ?_⟩
  intro j _hj
  refine ⟨?_, fun hk => (hrank j hk).2⟩
  intro hk
  by_cases hlow : j < physicalSourceLowCount g
  · have hz : physicalSourceComponentKind g j = 0 := by
      simp only [physicalSourceComponentKind, hlow, ↓reduceIte]
    have hlen : j < (physicalSourceLowBoundaries g).length := by
      dsimp only [physicalSourceLowCount] at hlow
      omega
    simpa only [physicalSourceComponentEndpoints, hz, ↓reduceIte] using
      hlowpos _ (hget _ 0 j hlen)
  · have hupper : j < physicalSourceLowCount g + physicalSourceRankCount g := by
      by_contra hu
      simp only [physicalSourceComponentKind, hlow, hu, ↓reduceIte] at hk
      omega
    have hone : physicalSourceComponentKind g j = 1 := by
      simp only [physicalSourceComponentKind, hlow, hupper, ↓reduceIte]
    exact (hrank j hone).1

theorem physicalSourceCover_regular (g : Fin 6) (j d : ℕ) :
    Measurable (fun X : Fin d → FiniteMeasure ℝ => physicalSourceCover g j X) ∧
      ∃ C : ℝ, 0 < C ∧
        ∀ X : Fin d → FiniteMeasure ℝ,
          0 ≤ physicalSourceCover g j X ∧ physicalSourceCover g j X ≤ C := by
  classical
  let r : (Fin d → FiniteMeasure ℝ) → ℕ := fun X => ∑ i, trialCellIndex (X i)
  let s : (Fin d → FiniteMeasure ℝ) → ℝ := fun X => ∑ i, ((X i).mass : ℝ)
  let P := physicalSourceGroup g
  let e := physicalSourceComponentEndpoints g j
  let top : ℕ := if g.val < 2 then 98263 else if g.val < 4 then 89524 else 89914
  let M : ℝ := ((top : ℝ) + d) * (trialMesh : ℝ)
  let A : (Fin d → FiniteMeasure ℝ) → ℝ := fun X =>
    if ∀ i : Fin d, (X i : Measure ℝ)
        (Set.Ioi ((physicalSourceAlignedCapIndex g (r X) : ℝ) * (trialMesh : ℝ))) = 0
    then physicalSourceRadialMask g j d (r X) else 0
  have hh : (0 : ℝ) < (trialMesh : ℝ) := by
    exact_mod_cast trial_fixed_positive_data.2.1
  have hM : 0 ≤ M := by dsimp only [M]; positivity
  have hr : Measurable r := Finset.measurable_sum Finset.univ fun i _ =>
    trial_data_measurable.1.comp (measurable_pi_apply i)
  have hs : Measurable s := Finset.measurable_sum Finset.univ fun i _ =>
    ((Measure.measurable_coe MeasurableSet.univ).comp
      (measurable_subtype_coe.comp (measurable_pi_apply i))).ennreal_toReal
  have hN := (physicalSourceCountMeasure_regular d).1
  have hχ (t : ℕ) :
      (physicalSourceRadialMask g j d t = 0 ∨ physicalSourceRadialMask g j d t = 1) ∧
      (physicalSourceRadialMask g j d t ≠ 0 → j < physicalSourceRowCount g ∧ t ≤ top) := by
    cases hlower : (if physicalSourceComponentKind g j = 0 then
        physicalSourceLowClipping g (physicalSourceComponentEndpoints g j).2
      else some (physicalSourceGroup g).lowerRadius) with
    | none => simp [physicalSourceRadialMask, hlower]
    | some c =>
        simp only [physicalSourceRadialMask, hlower]
        split_ifs <;> simp_all [top] <;> split_ifs <;> omega
  have hAvalues (X : Fin d → FiniteMeasure ℝ) : A X = 0 ∨ A X = 1 := by
    dsimp only [A]
    split_ifs
    · exact (hχ (r X)).1
    · exact Or.inl rfl
  have hAsupport (X : Fin d → FiniteMeasure ℝ) (hX : A X ≠ 0) :
      j < physicalSourceRowCount g ∧ r X ≤ top := by
    apply (hχ (r X)).2
    intro hz
    exact hX (by simp only [A, hz, ite_self])
  have hAmeas : Measurable A := by
    have hrows : Measurable fun p : (Fin d → FiniteMeasure ℝ) × ℕ =>
        if ∀ i : Fin d, (p.1 i : Measure ℝ)
            (Set.Ioi ((physicalSourceAlignedCapIndex g p.2 : ℝ) * (trialMesh : ℝ))) = 0
        then (1 : ℝ) else 0 := by
      apply measurable_from_prod_countable_left
      intro k
      change Measurable fun X : Fin d → FiniteMeasure ℝ =>
        if ∀ i : Fin d, (X i : Measure ℝ)
            (Set.Ioi ((physicalSourceAlignedCapIndex g k : ℝ) * (trialMesh : ℝ))) = 0
        then (1 : ℝ) else 0
      apply Measurable.ite ?_ measurable_const measurable_const
      rw [Set.ofPred_forall]
      apply MeasurableSet.iInter
      intro i
      apply (measurableSet_singleton (0 : ℝ≥0∞)).preimage
      exact (Measure.measurable_coe measurableSet_Ioi).comp
        (measurable_subtype_coe.comp
          (measurable_pi_apply i : Measurable fun X : Fin d → FiniteMeasure ℝ => X i))
    have hradial : Measurable fun X : Fin d → FiniteMeasure ℝ =>
        physicalSourceRadialMask g j d (r X) :=
      (measurable_of_countable (physicalSourceRadialMask g j d)).comp hr
    convert (hrows.comp (measurable_id.prodMk hr)).mul hradial using 1
    funext X
    simp only [A, Function.comp_def, Pi.mul_apply, id_eq, ite_mul, one_mul, zero_mul]
  have hmass (X : Fin d → FiniteMeasure ℝ) (hX : A X ≠ 0) : s X ≤ M := by
    calc
      s X ≤ ∑ i : Fin d, ((trialCellIndex (X i) : ℝ) + 1) * (trialMesh : ℝ) := by
        apply Finset.sum_le_sum
        intro i _
        exact ((trialCellIndex_eq_iff (X i) (trialCellIndex (X i))).mp rfl).2.le
      _ = ((r X : ℝ) + d) * (trialMesh : ℝ) := by
        rw [← Finset.sum_mul]
        congr 1
        simp only [r, Nat.cast_sum, Finset.sum_add_distrib, Finset.sum_const,
          Finset.card_univ, Fintype.card_fin, nsmul_eq_mul, mul_one]
      _ ≤ M := by
        apply mul_le_mul_of_nonneg_right _ hh.le
        have hcast : (r X : ℝ) ≤ (top : ℝ) := Nat.cast_le.mpr (hAsupport X hX).2
        exact add_le_add hcast le_rfl
  have hfinish (f : (Fin d → FiniteMeasure ℝ) → ℝ)
      (hf : Measurable f) (hf0 : ∀ X, 0 ≤ f X) (C : ℝ) (hC : 0 ≤ C)
      (hfC : ∀ X, A X ≠ 0 → f X ≤ C)
      (heq : ∀ X, physicalSourceCover g j X = A X * f X) :
      Measurable (fun X : Fin d → FiniteMeasure ℝ => physicalSourceCover g j X) ∧
        ∃ B : ℝ, 0 < B ∧ ∀ X : Fin d → FiniteMeasure ℝ,
          0 ≤ physicalSourceCover g j X ∧ physicalSourceCover g j X ≤ B := by
    simp only [heq]
    refine ⟨hAmeas.mul hf, C + 1, by linarith, ?_⟩
    intro X
    rcases hAvalues X with hzero | hone
    · simp only [hzero, zero_mul, le_refl, true_and]
      linarith
    · simp only [hone, one_mul]
      exact ⟨hf0 X, (hfC X (by rw [hone]; norm_num)).trans (by linarith)⟩
  by_cases hj : j < physicalSourceRowCount g
  swap
  · have hzero (X : Fin d → FiniteMeasure ℝ) : physicalSourceCover g j X = 0 := by
      have hz : physicalSourceRadialMask g j d (r X) = 0 := by
        by_contra hne
        exact hj ((hχ (r X)).2 hne).1
      simp only [physicalSourceCover, r] at hz ⊢
      rw [hz]
      simp only [zero_mul, ite_self]
    simp only [hzero]
    exact ⟨measurable_const, 1, zero_lt_one, fun _ => ⟨le_refl _, zero_le_one⟩⟩
  obtain ⟨hm, hp, hcut⟩ := physicalSource_fixed_cutoffs g
  by_cases hlow : physicalSourceComponentKind g j = 0
  · have he : (0 : ℝ) < (e.1 : ℝ) := by
      exact_mod_cast (hcut j hj).1 (by omega : physicalSourceComponentKind g j < 2)
    let L : (Fin d → FiniteMeasure ℝ) → ℝ := fun X =>
      ∑ i : Fin d, (X i : Measure ℝ).real (Set.Ioc (0 : ℝ) (e.1 : ℝ))
    let T : ℝ := ((P.order : ℝ) - 1) * (e.2 : ℝ) - (P.threshold : ℝ)
    let θ : ℝ := (physicalSourceTheta g j : ℝ)
    let E : ℝ := Real.exp (|θ| * (2 * M + |T|))
    let f : (Fin d → FiniteMeasure ℝ) → ℝ := fun X =>
      (physicalSourceCountMeasure X).real (Set.Ioc (e.1 : ℝ) (e.2 : ℝ)) *
        Real.exp (θ * (s X + ((P.order : ℝ) - 1) * (e.2 : ℝ) -
          (P.threshold : ℝ) - L X))
    have hL : Measurable L := Finset.measurable_sum Finset.univ fun i _ =>
      ((Measure.measurable_coe measurableSet_Ioc).comp
        (measurable_subtype_coe.comp (measurable_pi_apply i))).ennreal_toReal
    have hf : Measurable f :=
      (((Measure.measurable_coe measurableSet_Ioc).comp hN).ennreal_toReal).mul
        (measurable_const.mul (((hs.add_const _).sub_const _).sub hL)).exp
    apply hfinish f hf (fun X => mul_nonneg measureReal_nonneg (Real.exp_pos _).le)
      ((M / (e.1 : ℝ)) * E) (by dsimp only [E]; positivity)
    · intro X hX
      have hsM := hmass X hX
      have hs0 : 0 ≤ s X := Finset.sum_nonneg fun _ _ => NNReal.coe_nonneg _
      have hL0 : 0 ≤ L X := Finset.sum_nonneg fun _ _ => measureReal_nonneg
      have hLs : L X ≤ s X := by
        apply Finset.sum_le_sum
        intro i _
        change (X i : Measure ℝ).real (Set.Ioc (0 : ℝ) (e.1 : ℝ)) ≤
          (X i : Measure ℝ).real Set.univ
        exact measureReal_mono (Set.subset_univ _)
      obtain ⟨hfinite, hcount⟩ := (physicalSourceCountMeasure_regular d).2 (e.1 : ℝ) he X
      have hcountM : (physicalSourceCountMeasure X).real
          (Set.Ioc (e.1 : ℝ) (e.2 : ℝ)) ≤ M / (e.1 : ℝ) :=
        (measureReal_mono (fun _ hx => hx.1) (isFiniteMeasure_restrict.mp hfinite)).trans
          (hcount.trans (div_le_div_of_nonneg_right hsM he.le))
      have habs : |s X + T - L X| ≤ 2 * M + |T| := by
        apply abs_le.mpr
        constructor <;> linarith only [hL0, hLs, hs0, hsM, hM, neg_abs_le T, le_abs_self T]
      have hexp : Real.exp (θ * (s X + T - L X)) ≤ E := by
        apply Real.exp_le_exp.mpr
        calc
          θ * (s X + T - L X) ≤ |θ * (s X + T - L X)| := le_abs_self _
          _ = |θ| * |s X + T - L X| := abs_mul _ _
          _ ≤ |θ| * (2 * M + |T|) := mul_le_mul_of_nonneg_left habs (abs_nonneg _)
      have harg : s X + ((P.order : ℝ) - 1) * (e.2 : ℝ) -
          (P.threshold : ℝ) - L X = s X + T - L X := by dsimp only [T]; ring
      dsimp only [f]
      rw [harg]
      exact mul_le_mul hcountM hexp (Real.exp_pos _).le (div_nonneg hM he.le)
    · intro X
      simp only [physicalSourceCover, hlow, ↓reduceIte, A, f, θ, L, s, r, P, e,
        ite_mul, zero_mul]
  · by_cases hrank : physicalSourceComponentKind g j = 1
    · have he : (0 : ℝ) < (e.1 : ℝ) := by
        exact_mod_cast (hcut j hj).1 (by omega : physicalSourceComponentKind g j < 2)
      have hm' : (0 : ℝ) < (P.order : ℝ) := by exact_mod_cast hm
      have hb : (e.2 : ℝ) < (P.threshold : ℝ) := by
        exact_mod_cast (hcut j hj).2 hrank
      obtain ⟨hf, hfbound⟩ := physicalSource_rank_cover_regular d
        (P.order : ℝ) (P.threshold : ℝ) (e.1 : ℝ) (e.2 : ℝ) hm' he hb
      apply hfinish _ hf (fun X => (hfbound X).1) (M / (e.1 : ℝ))
        (div_nonneg hM he.le)
      · intro X hX
        exact (hfbound X).2.trans (div_le_div_of_nonneg_right (hmass X hX) he.le)
      · intro X
        simp only [physicalSourceCover, hrank, one_ne_zero, ↓reduceIte, A, r, P, e,
          ite_mul, zero_mul]
    · have hp' : (0 : ℝ) < (P.split : ℝ) := by exact_mod_cast hp
      let f : (Fin d → FiniteMeasure ℝ) → ℝ := fun X =>
        (Nat.choose ⌊(physicalSourceCountMeasure X).real (Set.Ioi (P.split : ℝ))⌋₊ 3 : ℝ)
      have hf : Measurable f :=
        (measurable_of_countable (fun n : ℕ => (Nat.choose n 3 : ℝ))).comp
          (((Measure.measurable_coe measurableSet_Ioi).comp hN).ennreal_toReal.nat_floor)
      apply hfinish f hf (fun _ => Nat.cast_nonneg _) (⌊M / (P.split : ℝ)⌋₊ ^ 3 : ℝ)
        (by positivity)
      · intro X hX
        have hcount := ((physicalSourceCountMeasure_regular d).2
          (P.split : ℝ) hp' X).2
        have hfloor := Nat.floor_mono (hcount.trans
          (div_le_div_of_nonneg_right (hmass X hX) hp'.le))
        have hchoose := (Nat.choose_le_pow
          ⌊(physicalSourceCountMeasure X).real (Set.Ioi (P.split : ℝ))⌋₊ 3).trans
            (Nat.pow_le_pow_left hfloor 3)
        dsimp only [f]
        exact_mod_cast hchoose
      · intro X
        simp only [physicalSourceCover, hlow, hrank, ↓reduceIte, A, f, r, P,
          ite_mul, zero_mul]

theorem physicalSource_outer_young (g : Fin 6) (j : ℕ) (c : ℝ) (hc : 0 < c) :
    (∑ i : Fin 40,
      ∫ X : Fin 40 → FiniteMeasure ℝ,
        2 * physicalSourceCover g j X * physicalSourceFaceWeight (i.removeNth X) *
          |trialStepFunction X * trialMarginal i (i.removeNth X)|
        ∂Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)) / trialPhysicalNormalizer ≤
      c * physicalSourceOuterRoot g j + physicalSourceOuterFace g j / c := by
  classical
  let : IsFiniteMeasure trialPhysicalMeasure := trialPhysicalMeasure_finite_mass.1
  let μ := Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)
  obtain ⟨C, _, _, hFint, hFsq, hV⟩ := trial_integrable_marginals
  obtain ⟨hcover, B, hB, hBbound⟩ := physicalSourceCover_regular g j 40
  have hweight : Measurable physicalSourceFaceWeight := by
    unfold physicalSourceFaceWeight
    exact Measurable.ite
      ((measurableSet_singleton (1 : ℝ)).preimage trial_data_measurable.2.2.1)
      measurable_const
      (Measurable.ite
        ((measurableSet_singleton (1 : ℝ)).preimage trial_data_measurable.2.2.2.1)
        measurable_const measurable_const)
  have hweightbound (Y : Fin 39 → FiniteMeasure ℝ) :
      0 ≤ physicalSourceFaceWeight Y ∧ physicalSourceFaceWeight Y ≤ 1 := by
    unfold physicalSourceFaceWeight
    split_ifs <;> norm_num
  have hrow (i : Fin 40) :
      (∫ X : Fin 40 → FiniteMeasure ℝ,
        2 * physicalSourceCover g j X * physicalSourceFaceWeight (i.removeNth X) *
          |trialStepFunction X * trialMarginal i (i.removeNth X)| ∂μ) ≤
        c * (∫ X : Fin 40 → FiniteMeasure ℝ,
          physicalSourceCover g j X * physicalSourceFaceWeight (i.removeNth X) *
            trialStepFunction X ^ 2 ∂μ) +
        (∫ X : Fin 40 → FiniteMeasure ℝ,
          physicalSourceCover g j X * physicalSourceFaceWeight (i.removeNth X) *
            trialMarginal i (i.removeNth X) ^ 2 ∂μ) / c := by
    let a : (Fin 40 → FiniteMeasure ℝ) → ℝ := fun X =>
      physicalSourceCover g j X * physicalSourceFaceWeight (i.removeNth X)
    let v : (Fin 40 → FiniteMeasure ℝ) → ℝ := fun X => trialMarginal i (i.removeNth X)
    have hremove : Measurable (fun X : Fin 40 → FiniteMeasure ℝ => i.removeNth X) :=
      measurable_pi_lambda _ fun k => measurable_pi_apply (i.succAbove k)
    have ha : Measurable a := hcover.mul (hweight.comp hremove)
    have hv : Measurable v := (hV i).1.comp hremove
    have ha0 (X : Fin 40 → FiniteMeasure ℝ) : 0 ≤ a X :=
      mul_nonneg (hBbound X).1 (hweightbound _).1
    have haB (X : Fin 40 → FiniteMeasure ℝ) : ‖a X‖ ≤ B := by
      rw [Real.norm_eq_abs, abs_of_nonneg (ha0 X)]
      exact (mul_le_mul (hBbound X).2 (hweightbound _).2
        (hweightbound _).1 hB.le).trans_eq (mul_one B)
    have hvC (X : Fin 40 → FiniteMeasure ℝ) : ‖v X‖ ≤ C := (hV i).2.1 _
    have hvint : Integrable v μ :=
      Integrable.of_bound hv.aestronglyMeasurable C (ae_of_all _ hvC)
    have hvsq : Integrable (fun X => v X ^ 2) μ := by
      simpa only [pow_two] using
        hvint.mul_bdd hv.aestronglyMeasurable (ae_of_all _ hvC)
    have hroot : Integrable (fun X => a X * trialStepFunction X ^ 2) μ :=
      hFsq.bdd_mul ha.aestronglyMeasurable (ae_of_all _ haB)
    have hface : Integrable (fun X => a X * v X ^ 2) μ :=
      hvsq.bdd_mul ha.aestronglyMeasurable (ae_of_all _ haB)
    have hmixed : Integrable (fun X => 2 * (a X * |trialStepFunction X * v X|)) μ :=
      (((hFint.mul_bdd hv.aestronglyMeasurable (ae_of_all _ hvC)).abs).bdd_mul
        ha.aestronglyMeasurable (ae_of_all _ haB)).const_mul 2
    have hpoint (X : Fin 40 → FiniteMeasure ℝ) :
        2 * (a X * |trialStepFunction X * v X|) ≤
          c * (a X * trialStepFunction X ^ 2) + (a X * v X ^ 2) / c := by
      calc
        2 * (a X * |trialStepFunction X * v X|) =
            a X * (2 * |trialStepFunction X| * |v X|) := by rw [abs_mul]; ring
        _ ≤ a X * (c * |trialStepFunction X| ^ 2 + c⁻¹ * |v X| ^ 2) :=
          mul_le_mul_of_nonneg_left (two_mul_le_add_mul_sq hc) (ha0 X)
        _ = c * (a X * trialStepFunction X ^ 2) + (a X * v X ^ 2) / c := by
          rw [sq_abs, sq_abs]
          ring
    calc
      _ = ∫ X, 2 * (a X * |trialStepFunction X * v X|) ∂μ := by
        apply integral_congr_ae
        filter_upwards [] with X
        dsimp only [a, v]
        ring
      _ ≤ ∫ X, c * (a X * trialStepFunction X ^ 2) + (a X * v X ^ 2) / c ∂μ :=
        integral_mono hmixed ((hroot.const_mul c).add (hface.div_const c)) hpoint
      _ = _ := by
        rw [integral_add (hroot.const_mul c) (hface.div_const c),
          integral_const_mul, integral_div]
  have hden : 0 < trialPhysicalNormalizer := trial_fixed_positive_data.2.2.2.2.2
  convert div_le_div_of_nonneg_right
    (Finset.sum_le_sum fun i _ => hrow i) hden.le using 1
  · rfl
  · simp only [Finset.sum_add_distrib, ← Finset.mul_sum, ← Finset.sum_div,
      physicalSourceOuterRoot, physicalSourceOuterFace, μ]
    ring

theorem physicalSource_positive_row_ledger
    (hNumerics :
      (∀ j : Fin outerOrderTwoBounds.length,
        physicalSourceOuterRoot 0 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((outerOrderTwoBounds.get j).2.1 : ℝ) / (10 : ℝ) ^ 18 ∧
        physicalSourceOuterFace 0 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((outerOrderTwoBounds.get j).2.2.1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (∀ j : Fin outerOrderFiveHalvesBounds.length,
        physicalSourceOuterRoot 1 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((outerOrderFiveHalvesBounds.get j).2.1 : ℝ) / (10 : ℝ) ^ 18 ∧
        physicalSourceOuterFace 1 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((outerOrderFiveHalvesBounds.get j).2.2.1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (∀ j : Fin innerBaseOrderTwoBounds.length,
        physicalSourceInnerMass 2 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((innerBaseOrderTwoBounds.get j).1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (∀ j : Fin innerBaseOrderFiveHalvesBounds.length,
        physicalSourceInnerMass 3 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((innerBaseOrderFiveHalvesBounds.get j).1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (∀ j : Fin innerEnlargedOrderTwoBounds.length,
        physicalSourceInnerMass 4 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((innerEnlargedOrderTwoBounds.get j).1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (∀ j : Fin innerEnlargedOrderFiveHalvesBounds.length,
        physicalSourceInnerMass 5 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((innerEnlargedOrderFiveHalvesBounds.get j).1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (23685317816 : ℝ) / (10 : ℝ) ^ 24 ≤ trialIH ∧
      trialIH ≤ (23685317890 : ℝ) / (10 : ℝ) ^ 24 ∧
      (90248755123 : ℝ) / (10 : ℝ) ^ 24 ≤ trialJLambdaH) :
    let mixed : Fin 6 → ℕ → ℝ := fun g j =>
      (∑ i : Fin 40,
        ∫ X : Fin 40 → FiniteMeasure ℝ,
          2 * physicalSourceCover g j X * physicalSourceFaceWeight (i.removeNth X) *
            |trialStepFunction X * trialMarginal i (i.removeNth X)|
          ∂Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)) / trialPhysicalNormalizer
    let inner : ℝ :=
      ((44415113 : ℝ) / 5000000000) *
        ((∑ j : Fin innerBaseOrderTwoBounds.length,
            physicalSourceInnerMass 2 j.val) +
          ∑ j : Fin innerBaseOrderFiveHalvesBounds.length,
            physicalSourceInnerMass 3 j.val) +
      ((1000843183 : ℝ) / 1000000000) *
        ((∑ j : Fin innerEnlargedOrderTwoBounds.length,
            physicalSourceInnerMass 4 j.val) +
          ∑ j : Fin innerEnlargedOrderFiveHalvesBounds.length,
            physicalSourceInnerMass 5 j.val)
    let ledger : ℝ :=
      (∑ j : Fin outerOrderTwoBounds.length,
        ((((outerOrderTwoBounds.get j).1 : ℝ) / (10 : ℝ) ^ 6) *
            physicalSourceOuterRoot 0 j.val +
          physicalSourceOuterFace 0 j.val /
            (((outerOrderTwoBounds.get j).1 : ℝ) / (10 : ℝ) ^ 6))) +
      (∑ j : Fin outerOrderFiveHalvesBounds.length,
        ((((outerOrderFiveHalvesBounds.get j).1 : ℝ) / (10 : ℝ) ^ 6) *
            physicalSourceOuterRoot 1 j.val +
          physicalSourceOuterFace 1 j.val /
            (((outerOrderFiveHalvesBounds.get j).1 : ℝ) / (10 : ℝ) ^ 6))) + inner
    (∑ j : Fin outerOrderTwoBounds.length, mixed 0 j.val) +
        (∑ j : Fin outerOrderFiveHalvesBounds.length, mixed 1 j.val) + inner ≤
      ledger ∧ ledger / trialIH ≤ (696075110 : ℝ) / (10 : ℝ) ^ 12 := by
  classical
  dsimp only
  rcases hNumerics with ⟨h₀, h₁, h₂, h₃, h₄, h₅, hDle, _, _⟩
  let D : ℝ := (23685317816 : ℝ) / (10 : ℝ) ^ 24
  have hD : 0 < D := by norm_num [D]
  change D ≤ trialIH at hDle
  have hIH : 0 < trialIH := hD.trans_le hDle
  have hroundOuter (r : OuterBoundRow)
      (hr : r ∈ outerOrderTwoBounds ++ outerOrderFiveHalvesBounds) :
      0 < r.1 ∧ outerBoundRowBudget r ≤ (r.2.2.2 : ℚ) / 10 ^ 12 :=
    ⟨(outerBoundRows_rounding r hr).1,
      (outerBoundRows_rounding r hr).2.2⟩
  have sumScaled {α : Type} (L : List α) (col : α → ℕ) :
      (∑ j : Fin L.length, D * ((col (L.get j) : ℝ) / (10 : ℝ) ^ 12)) =
        D * (((L.map col).sum : ℝ) / (10 : ℝ) ^ 12) := by
    rw [← Finset.mul_sum, ← Finset.sum_div]
    congr 2
    simpa only [List.get_eq_getElem, Nat.cast_list_sum, List.map_map, Function.comp_def]
      using (Fin.sum_univ_fun_getElem L (fun r => (col r : ℝ)))
  have outerBound (g : Fin 6) (L : List OuterBoundRow)
      (hrows : ∀ r ∈ L,
        0 < r.1 ∧ outerBoundRowBudget r ≤ (r.2.2.2 : ℚ) / 10 ^ 12)
      (hrowsNumerics : ∀ j : Fin L.length,
        physicalSourceOuterRoot g j.val / D ≤ ((L.get j).2.1 : ℝ) / (10 : ℝ) ^ 18 ∧
        physicalSourceOuterFace g j.val / D ≤ ((L.get j).2.2.1 : ℝ) / (10 : ℝ) ^ 18) :
      (∑ j : Fin L.length,
        ((((L.get j).1 : ℝ) / (10 : ℝ) ^ 6) * physicalSourceOuterRoot g j.val +
          physicalSourceOuterFace g j.val / (((L.get j).1 : ℝ) / (10 : ℝ) ^ 6))) ≤
        D * ((((L.map fun r => r.2.2.2).sum : ℕ) : ℝ) / (10 : ℝ) ^ 12) := by
    calc
      _ ≤ ∑ j : Fin L.length, D * (((L.get j).2.2.2 : ℝ) / (10 : ℝ) ^ 12) := by
        refine Finset.sum_le_sum fun j _ => ?_
        let r := L.get j
        have hr := hrows r (List.get_mem L j)
        have hc : 0 < (r.1 : ℝ) / (10 : ℝ) ^ 6 :=
          div_pos (Nat.cast_pos.mpr hr.1) (by norm_num)
        have hR := (div_le_iff₀ hD).mp (hrowsNumerics j).1
        have hV := (div_le_iff₀ hD).mp (hrowsNumerics j).2
        have hround :
            ((r.1 : ℝ) / (10 : ℝ) ^ 6) * ((r.2.1 : ℝ) / (10 : ℝ) ^ 18) +
                ((r.2.2.1 : ℝ) / (10 : ℝ) ^ 18) / ((r.1 : ℝ) / (10 : ℝ) ^ 6) ≤
              (r.2.2.2 : ℝ) / (10 : ℝ) ^ 12 := by
          have h := hr.2
          dsimp only [outerBoundRowBudget] at h
          convert (Rat.cast_le (K := ℝ)).2 h using 1 <;> push_cast <;> rfl
        calc
          _ ≤ ((r.1 : ℝ) / (10 : ℝ) ^ 6) *
                (((r.2.1 : ℝ) / (10 : ℝ) ^ 18) * D) +
              (((r.2.2.1 : ℝ) / (10 : ℝ) ^ 18) * D) /
                ((r.1 : ℝ) / (10 : ℝ) ^ 6) :=
            add_le_add (mul_le_mul_of_nonneg_left hR hc.le)
              (div_le_div_of_nonneg_right hV hc.le)
          _ = D * (((r.1 : ℝ) / (10 : ℝ) ^ 6) *
                ((r.2.1 : ℝ) / (10 : ℝ) ^ 18) +
              ((r.2.2.1 : ℝ) / (10 : ℝ) ^ 18) /
                ((r.1 : ℝ) / (10 : ℝ) ^ 6)) := by ring
          _ ≤ D * ((r.2.2.2 : ℝ) / (10 : ℝ) ^ 12) :=
            mul_le_mul_of_nonneg_left hround hD.le
      _ = _ := sumScaled L (fun r => r.2.2.2)
  have innerBound (g : Fin 6) (L : List InnerBoundRow)
      (k : ℚ) (hk : 0 ≤ k)
      (hrows : ∀ r ∈ L, innerBoundRowBudget k r ≤ (r.2 : ℚ) / 10 ^ 12)
      (hrowsNumerics : ∀ j : Fin L.length,
        physicalSourceInnerMass g j.val / D ≤ ((L.get j).1 : ℝ) / (10 : ℝ) ^ 18) :
      (k : ℝ) * (∑ j : Fin L.length, physicalSourceInnerMass g j.val) ≤
        D * (((L.map Prod.snd).sum : ℝ) / (10 : ℝ) ^ 12) := by
    rw [Finset.mul_sum]
    have hkR : (0 : ℝ) ≤ k := by exact_mod_cast hk
    calc
      _ ≤ ∑ j : Fin L.length, D * (((L.get j).2 : ℝ) / (10 : ℝ) ^ 12) := by
        refine Finset.sum_le_sum fun j _ => ?_
        let r := L.get j
        have hM := (div_le_iff₀ hD).mp (hrowsNumerics j)
        have hround : (k : ℝ) * ((r.1 : ℝ) / (10 : ℝ) ^ 18) ≤
            (r.2 : ℝ) / (10 : ℝ) ^ 12 := by
          have h := hrows r (List.get_mem L j)
          dsimp only [innerBoundRowBudget] at h
          convert (Rat.cast_le (K := ℝ)).2 h using 1 <;> push_cast <;> rfl
        calc
          _ ≤ (k : ℝ) * (((r.1 : ℝ) / (10 : ℝ) ^ 18) * D) :=
            mul_le_mul_of_nonneg_left hM hkR
          _ = D * ((k : ℝ) * ((r.1 : ℝ) / (10 : ℝ) ^ 18)) := by ring
          _ ≤ D * ((r.2 : ℝ) / (10 : ℝ) ^ 12) :=
            mul_le_mul_of_nonneg_left hround hD.le
      _ = _ := sumScaled L Prod.snd
  have hOuterTwo := outerBound 0 outerOrderTwoBounds
    (fun r hr => hroundOuter r (List.mem_append_left _ hr)) h₀
  have hOuterFiveHalves := outerBound 1 outerOrderFiveHalvesBounds
    (fun r hr => hroundOuter r (List.mem_append_right _ hr)) h₁
  have hInnerOldTwo := innerBound 2 innerBaseOrderTwoBounds
    (44415113 / 5000000000) (by norm_num)
    (fun r hr => (innerBaseBoundRows_rounding r
      (List.mem_append_left _ hr)).2) h₂
  have hInnerOldFiveHalves := innerBound 3 innerBaseOrderFiveHalvesBounds
    (44415113 / 5000000000) (by norm_num)
    (fun r hr => (innerBaseBoundRows_rounding r
      (List.mem_append_right _ hr)).2) h₃
  have hInnerNewTwo := innerBound 4 innerEnlargedOrderTwoBounds
    (1000843183 / 1000000000) (by norm_num)
    (fun r hr => (innerEnlargedBoundRows_rounding r
      (List.mem_append_left _ hr)).2) h₄
  have hInnerNewFiveHalves := innerBound 5 innerEnlargedOrderFiveHalvesBounds
    (1000843183 / 1000000000) (by norm_num)
    (fun r hr => (innerEnlargedBoundRows_rounding r
      (List.mem_append_right _ hr)).2) h₅
  simp only [Rat.cast_div, Rat.cast_ofNat] at hInnerOldTwo hInnerOldFiveHalves
  simp only [Rat.cast_div, Rat.cast_ofNat] at hInnerNewTwo hInnerNewFiveHalves
  have hTotal := congrArg (fun n : ℕ => (n : ℝ)) sourceErrorGroupTotals_sum
  simp only [sourceErrorGroupTotals, List.sum_cons, List.sum_nil,
    Nat.cast_add, Nat.cast_ofNat, add_zero] at hTotal
  have hTotalScaled := congrArg (fun x : ℝ => D * (x / (10 : ℝ) ^ 12)) hTotal
  constructor
  · refine add_le_add (add_le_add ?_ ?_) le_rfl
    · refine Finset.sum_le_sum fun j _ => ?_
      have hq := (hroundOuter (outerOrderTwoBounds.get j)
        (List.mem_append_left _ (List.get_mem outerOrderTwoBounds j))).1
      exact physicalSource_outer_young 0 j.val _
        (div_pos (Nat.cast_pos.mpr hq) (by norm_num))
    · refine Finset.sum_le_sum fun j _ => ?_
      have hq := (hroundOuter (outerOrderFiveHalvesBounds.get j)
        (List.mem_append_right _ (List.get_mem outerOrderFiveHalvesBounds j))).1
      exact physicalSource_outer_young 1 j.val _
        (div_pos (Nat.cast_pos.mpr hq) (by norm_num))
  · apply (div_le_iff₀ hIH).mpr
    have hLedger := add_le_add (add_le_add hOuterTwo hOuterFiveHalves)
      (add_le_add (add_le_add hInnerOldTwo hInnerOldFiveHalves)
        (add_le_add hInnerNewTwo hInnerNewFiveHalves))
    calc
      _ ≤ D * ((696075110 : ℝ) / (10 : ℝ) ^ 12) := by
        nlinarith only [hLedger, hTotalScaled]
      _ ≤ ((696075110 : ℝ) / (10 : ℝ) ^ 12) * trialIH := by
        simpa only [mul_comm] using
          mul_le_mul_of_nonneg_right hDle (by norm_num :
            0 ≤ (696075110 : ℝ) / (10 : ℝ) ^ 12)

section
open scoped InnerProductSpace

theorem trialPhysicalMeasure_mass_map :
    Measure.map (fun X : FiniteMeasure ℝ => (X.mass : ℝ)) trialPhysicalMeasure =
        (volume.restrict (Set.Ici (0 : ℝ))).withDensity
          (fun t => ENNReal.ofReal (dickmanRho (t / (trialLargestCap : ℝ)))) ∧
      Measure.map (fun X : FiniteMeasure ℝ => (X.mass : ℝ)) trialPhysicalMeasure ≤
        volume.restrict (Set.Ici (0 : ℝ)) := by
  have hcap : 0 < (trialLargestCap : ℝ) :=
    Rat.cast_pos.mpr trial_fixed_positive_data.2.2.1
  have heq : Measure.map (fun X : FiniteMeasure ℝ => (X.mass : ℝ))
      trialPhysicalMeasure =
      (volume.restrict (Set.Ici (0 : ℝ))).withDensity
        (fun t => ENNReal.ofReal (dickmanRho (t / (trialLargestCap : ℝ)))) := by
    have hm : Measurable (fun X : FiniteMeasure ℝ => (X.mass : ℝ)) :=
      ((Measure.measurable_coe MeasurableSet.univ).comp
        measurable_subtype_coe).ennreal_toReal
    simpa only [trialPhysicalMeasure, Measure.map_smul _ hm.aemeasurable] using
      normalized_fragmentLaw_mass_eq_dickman (trialLargestCap : ℝ) hcap
  refine ⟨heq, ?_⟩
  rw [heq]
  have hle : (fun t : ℝ => ENNReal.ofReal
      (dickmanRho (t / (trialLargestCap : ℝ)))) ≤ᵐ[volume.restrict (Set.Ici 0)]
      (1 : ℝ → ℝ≥0∞) := by
    filter_upwards [] with t
    exact ENNReal.ofReal_le_one.mpr (dickmanRho_analytic.2.2.2.2.2.1 _).2
  simpa only [withDensity_one] using withDensity_mono hle

theorem trial_inverse_face_fiber (a : ℝ) (ha : 0 < a) :
    (∫ X : FiniteMeasure ℝ in {X | (X.mass : ℝ) ≤ a},
      (a + 39 * (X.mass : ℝ))⁻¹ ∂trialPhysicalMeasure) ≤ Real.log 40 / 39 := by
  have hm : Measurable (fun X : FiniteMeasure ℝ => (X.mass : ℝ)) :=
    ((Measure.measurable_coe MeasurableSet.univ).comp measurable_subtype_coe).ennreal_toReal
  have hreal : Measurable (fun t : ℝ => (a + 39 * t)⁻¹) :=
    (measurable_const.add (measurable_const.mul measurable_id)).inv
  have hdom :
      (Measure.map (fun X : FiniteMeasure ℝ => (X.mass : ℝ))
        trialPhysicalMeasure).restrict (Set.Iic a) ≤ volume.restrict (Set.Icc 0 a) := by
    calc
      _ ≤ (volume.restrict (Set.Ici (0 : ℝ))).restrict (Set.Iic a) :=
        Measure.restrict_mono_measure trialPhysicalMeasure_mass_map.2 _
      _ = _ := by
        rw [Measure.restrict_restrict measurableSet_Iic, Set.Iic_inter_Ici]
  have hcont : ContinuousOn (fun t : ℝ => (a + 39 * t)⁻¹) (Set.Icc 0 a) := by
    apply (continuous_const.add (continuous_const.mul continuous_id)).continuousOn.inv₀
    intro t ht
    change a + 39 * t ≠ 0
    exact ne_of_gt (by nlinarith [ht.1])
  have hnonneg : 0 ≤ᵐ[volume.restrict (Set.Icc 0 a)]
      (fun t : ℝ => (a + 39 * t)⁻¹) := by
    filter_upwards [ae_restrict_mem measurableSet_Icc] with t ht
    exact inv_nonneg.mpr (by nlinarith [ht.1])
  have heval : (∫ t : ℝ in Set.Icc 0 a, (a + 39 * t)⁻¹) = Real.log 40 / 39 := by
    rw [integral_Icc_eq_integral_Ioc, ← intervalIntegral.integral_of_le ha.le]
    rw [intervalIntegral.integral_comp_add_mul (fun t : ℝ => t⁻¹)
      (by norm_num : (39 : ℝ) ≠ 0) a]
    simp only [mul_zero, add_zero, smul_eq_mul]
    rw [integral_inv_of_pos ha (by linarith : 0 < a + 39 * a)]
    rw [show (a + 39 * a) / a = 40 by field_simp; ring]
    ring
  calc
    _ = ∫ t : ℝ in Set.Iic a, (a + 39 * t)⁻¹
        ∂Measure.map (fun X : FiniteMeasure ℝ => (X.mass : ℝ)) trialPhysicalMeasure :=
      (setIntegral_map measurableSet_Iic hreal.aestronglyMeasurable hm.aemeasurable).symm
    _ ≤ ∫ t : ℝ in Set.Icc 0 a, (a + 39 * t)⁻¹ :=
      integral_mono_measure hdom hnonneg hcont.integrableOn_Icc
    _ = _ := heval

theorem trial_weighted_face_fiber
    (a : ℝ) (ha : 0 ≤ a) (f : FiniteMeasure ℝ → ℝ)
    (hf : MemLp f 2 trialPhysicalMeasure)
    (hsupport : ∀ᵐ X ∂trialPhysicalMeasure, a < (X.mass : ℝ) → f X = 0) :
    Integrable (fun X => (a + 39 * (X.mass : ℝ)) * f X ^ 2) trialPhysicalMeasure ∧
      (∫ X, f X ∂trialPhysicalMeasure) ^ 2 ≤
        (Real.log 40 / 39) *
          ∫ X, (a + 39 * (X.mass : ℝ)) * f X ^ 2 ∂trialPhysicalMeasure := by
  let : IsFiniteMeasure trialPhysicalMeasure := trialPhysicalMeasure_finite_mass.1
  have hm : Measurable (fun X : FiniteMeasure ℝ => (X.mass : ℝ)) :=
    ((Measure.measurable_coe MeasurableSet.univ).comp measurable_subtype_coe).ennreal_toReal
  let w : FiniteMeasure ℝ → ℝ := fun X => a + 39 * (X.mass : ℝ)
  have hwm : Measurable w := measurable_const.add (measurable_const.mul hm)
  have hw0 (X : FiniteMeasure ℝ) : 0 ≤ w X := by
    dsimp only [w]
    nlinarith [X.mass.coe_nonneg]
  have hemeas : AEStronglyMeasurable (fun X => w X * f X ^ 2)
      trialPhysicalMeasure := hwm.aestronglyMeasurable.mul (hf.aestronglyMeasurable.pow 2)
  have henergy : Integrable (fun X => w X * f X ^ 2) trialPhysicalMeasure := by
    apply (hf.integrable_sq.const_mul (40 * a)).mono' hemeas
    filter_upwards [hsupport] with X hs
    rw [Real.norm_of_nonneg (mul_nonneg (hw0 X) (sq_nonneg _))]
    by_cases hX : (X.mass : ℝ) ≤ a
    · apply mul_le_mul_of_nonneg_right _ (sq_nonneg _)
      dsimp only [w]
      linarith
    · rw [hs (lt_of_not_ge hX)]
      simp
  refine ⟨henergy, ?_⟩
  by_cases ha0 : a = 0
  · subst a
    have hmassNe : ∀ᵐ X ∂trialPhysicalMeasure, (X.mass : ℝ) ≠ 0 :=
      ae_of_ae_map hm.aemeasurable
        ((ae_mono trialPhysicalMeasure_mass_map.2)
          (Measure.ae_ne (volume.restrict (Set.Ici (0 : ℝ))) 0))
    have hfzero : f =ᵐ[trialPhysicalMeasure] 0 := by
      filter_upwards [hsupport, hmassNe] with X hs hX
      exact hs (lt_of_le_of_ne X.mass.coe_nonneg (Ne.symm hX))
    have hezero : (fun X => w X * f X ^ 2) =ᵐ[trialPhysicalMeasure] 0 := by
      filter_upwards [hfzero] with X hX
      simp only [hX, Pi.zero_apply, zero_pow (by norm_num : 2 ≠ 0), mul_zero]
    rw [integral_eq_zero_of_ae hfzero, integral_eq_zero_of_ae hezero]
    norm_num
  have ha' : 0 < a := lt_of_le_of_ne ha (Ne.symm ha0)
  let s : Set (FiniteMeasure ℝ) := {X | (X.mass : ℝ) ≤ a}
  let μ : Measure (FiniteMeasure ℝ) := trialPhysicalMeasure.restrict s
  have hw (X : FiniteMeasure ℝ) : 0 < w X := by
    dsimp only [w]
    nlinarith [X.mass.coe_nonneg]
  let u : FiniteMeasure ℝ → ℝ := fun X => f X * Real.sqrt (w X)
  let v : FiniteMeasure ℝ → ℝ := fun X => (Real.sqrt (w X))⁻¹
  have hsm : Measurable (fun X : FiniteMeasure ℝ => Real.sqrt (w X)) :=
    hwm.sqrt
  have hum : AEStronglyMeasurable u μ :=
    (hf.restrict s).aestronglyMeasurable.mul hsm.aestronglyMeasurable
  have husq : Integrable (fun X => u X ^ 2) μ := by
    apply henergy.integrableOn.congr
    filter_upwards [] with X
    dsimp only [u]
    rw [mul_pow, Real.sq_sqrt (hw0 X)]
    ring
  have hu : MemLp u 2 μ := (memLp_two_iff_integrable_sq hum).mpr husq
  have hv : MemLp v 2 μ := by
    apply MemLp.of_bound hsm.inv.aestronglyMeasurable ((Real.sqrt a)⁻¹)
    filter_upwards [] with X
    change ‖(Real.sqrt (w X))⁻¹‖ ≤ (Real.sqrt a)⁻¹
    rw [Real.norm_of_nonneg (inv_nonneg.mpr (Real.sqrt_nonneg _))]
    apply inv_anti₀ (Real.sqrt_pos.mpr ha')
    apply Real.sqrt_le_sqrt
    dsimp only [w]
    nlinarith [X.mass.coe_nonneg]
  have huv : ⟪hu.toLp u, hv.toLp v⟫_ℝ = ∫ X, f X ∂μ := by
    rw [L2.inner_def]
    apply integral_congr_ae
    filter_upwards [hu.coeFn_toLp, hv.coeFn_toLp] with X hX hY
    rw [hX, hY, Real.inner_apply]
    exact mul_inv_cancel_right₀ (ne_of_gt (Real.sqrt_pos.mpr (hw X))) (f X)
  have huu : ⟪hu.toLp u, hu.toLp u⟫_ℝ = ∫ X, w X * f X ^ 2 ∂μ := by
    rw [L2.inner_def]
    apply integral_congr_ae
    filter_upwards [hu.coeFn_toLp] with X hX
    rw [hX, Real.inner_apply, ← pow_two]
    dsimp only [u]
    rw [mul_pow, Real.sq_sqrt (hw0 X)]
    ring
  have hvv : ⟪hv.toLp v, hv.toLp v⟫_ℝ = ∫ X, (w X)⁻¹ ∂μ := by
    rw [L2.inner_def]
    apply integral_congr_ae
    filter_upwards [hv.coeFn_toLp] with X hX
    rw [hX, Real.inner_apply, ← pow_two]
    dsimp only [v]
    rw [inv_pow, Real.sq_sqrt (hw0 X)]
  have hcs := real_inner_mul_inner_self_le (hu.toLp u) (hv.toLp v)
  rw [huv, huu, hvv, ← pow_two] at hcs
  have hrestoreF : (∫ X, f X ∂μ) = ∫ X, f X ∂trialPhysicalMeasure := by
    apply setIntegral_eq_integral_of_ae_compl_eq_zero
    filter_upwards [hsupport] with X hX
    exact fun hn => hX (lt_of_not_ge hn)
  have hrestoreE : (∫ X, w X * f X ^ 2 ∂μ) =
      ∫ X, w X * f X ^ 2 ∂trialPhysicalMeasure := by
    apply setIntegral_eq_integral_of_ae_compl_eq_zero
    filter_upwards [hsupport] with X hX
    intro hn
    rw [hX (lt_of_not_ge hn)]
    simp
  have hinv : (∫ X, (w X)⁻¹ ∂μ) ≤ Real.log 40 / 39 :=
    trial_inverse_face_fiber a ha'
  have hEnonneg : 0 ≤ ∫ X, w X * f X ^ 2 ∂μ :=
    integral_nonneg fun X => mul_nonneg (hw0 X) (sq_nonneg _)
  have hfinal := hcs.trans (mul_le_mul_of_nonneg_left hinv hEnonneg)
  rw [hrestoreF, hrestoreE] at hfinal
  simpa only [mul_comm] using hfinal

theorem trial_simplex_face_energy
    (S : ℝ) (hS : 0 < S) (f : (Fin 40 → FiniteMeasure ℝ) → ℝ)
    (hf : MemLp f 2 (Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)))
    (hsupport : ∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure),
      S < ∑ i : Fin 40, ((X i).mass : ℝ) → f X = 0) :
    (∀ i : Fin 40,
      MemLp (fun Y : Fin 39 → FiniteMeasure ℝ =>
        ∫ X : FiniteMeasure ℝ, f (i.insertNth X Y) ∂trialPhysicalMeasure)
        2 (Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure))) ∧
      (∑ i : Fin 40,
        ∫ Y : Fin 39 → FiniteMeasure ℝ,
          (∫ X : FiniteMeasure ℝ, f (i.insertNth X Y) ∂trialPhysicalMeasure) ^ 2
          ∂Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)) ≤
        (S * 40 * Real.log 40 / 39) *
          ∫ X : Fin 40 → FiniteMeasure ℝ, f X ^ 2
            ∂Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure) := by
  classical
  let μ : Measure (FiniteMeasure ℝ) := trialPhysicalMeasure
  let ν : Measure (Fin 39 → FiniteMeasure ℝ) := Measure.pi (fun _ => μ)
  let πμ : Measure (Fin 40 → FiniteMeasure ℝ) := Measure.pi (fun _ => μ)
  let : IsFiniteMeasure μ := trialPhysicalMeasure_finite_mass.1
  have hf' : MemLp f 2 πμ := hf
  have hmass : Measurable (fun X : FiniteMeasure ℝ => (X.mass : ℝ)) :=
    ((Measure.measurable_coe MeasurableSet.univ).comp measurable_subtype_coe).ennreal_toReal
  let total : (Fin 40 → FiniteMeasure ℝ) → ℝ := fun X =>
    ∑ j : Fin 40, ((X j).mass : ℝ)
  let retained : (Fin 39 → FiniteMeasure ℝ) → ℝ := fun Y =>
    ∑ j : Fin 39, ((Y j).mass : ℝ)
  let W : Fin 40 → (Fin 40 → FiniteMeasure ℝ) → ℝ := fun i X =>
    (S - total X + 40 * ((X i).mass : ℝ)) * f X ^ 2
  let c : ℝ := Real.log 40 / 39
  have hsupport' : ∀ᵐ X ∂πμ, S < total X → f X = 0 := hsupport
  have htotal_meas : Measurable total :=
    Finset.measurable_sum Finset.univ fun i _ => hmass.comp (measurable_pi_apply i)
  have hcoord (i : Fin 40) (X : Fin 40 → FiniteMeasure ℝ) :
      ((X i).mass : ℝ) ≤ total X :=
    Finset.single_le_sum (fun j _ => (X j).mass.coe_nonneg) (Finset.mem_univ i)
  have hWbounds (i : Fin 40) : ∀ᵐ X ∂πμ,
      ‖W i X‖ ≤ (40 * S) * f X ^ 2 := by
    filter_upwards [hsupport'] with X hs
    by_cases hX : total X ≤ S
    · have hw0 : 0 ≤ S - total X + 40 * ((X i).mass : ℝ) := by
        have hm0 := (X i).mass.coe_nonneg
        linarith
      have hw : S - total X + 40 * ((X i).mass : ℝ) ≤ 40 * S := by
        have hi := hcoord i X
        linarith
      have hprod : 0 ≤ W i X := mul_nonneg hw0 (sq_nonneg _)
      rw [Real.norm_of_nonneg hprod]
      exact mul_le_mul_of_nonneg_right hw (sq_nonneg _)
    · have hz : f X = 0 := hs (lt_of_not_ge hX)
      simp only [W, hz, zero_pow (by norm_num : 2 ≠ 0), mul_zero, norm_zero, le_refl]
  have hW (i : Fin 40) : Integrable (W i) πμ := by
    have hwmeas : Measurable (fun X : Fin 40 → FiniteMeasure ℝ =>
        S - total X + 40 * ((X i).mass : ℝ)) :=
      (measurable_const.sub htotal_meas).add
        (measurable_const.mul (hmass.comp (measurable_pi_apply i)))
    apply (hf'.integrable_sq.const_mul (40 * S)).mono
      (hwmeas.aestronglyMeasurable.mul (hf'.aestronglyMeasurable.pow 2))
    filter_upwards [hWbounds i] with X hX
    exact hX.trans_eq (Real.norm_of_nonneg
      (mul_nonneg (mul_nonneg (by norm_num) hS.le) (sq_nonneg _))).symm
  let e (i : Fin 40) :
      (FiniteMeasure ℝ × (Fin 39 → FiniteMeasure ℝ)) ≃ᵐ
        (Fin 40 → FiniteMeasure ℝ) :=
    (MeasurableEquiv.piFinSuccAbove (fun _ : Fin 40 => FiniteMeasure ℝ) i).symm
  have he (i : Fin 40) : MeasurePreserving (e i) (μ.prod ν) πμ :=
    (measurePreserving_piFinSuccAbove (fun _ : Fin 40 => μ) i).symm
  let F : Fin 40 → (FiniteMeasure ℝ × (Fin 39 → FiniteMeasure ℝ)) → ℝ :=
    fun i Z => f (e i Z)
  let V : Fin 40 → (Fin 39 → FiniteMeasure ℝ) → ℝ := fun i Y =>
    ∫ X : FiniteMeasure ℝ, F i (X, Y) ∂μ
  let Q : Fin 40 → (Fin 39 → FiniteMeasure ℝ) → ℝ := fun i Y =>
    ∫ X : FiniteMeasure ℝ, W i (e i (X, Y)) ∂μ
  have hF (i : Fin 40) : MemLp (F i) 2 (μ.prod ν) :=
    hf'.comp_measurePreserving (he i)
  have hWcomp (i : Fin 40) :
      Integrable (fun Z => W i (e i Z)) (μ.prod ν) :=
    (he i).integrable_comp_of_integrable (hW i)
  have hQ (i : Fin 40) : Integrable (Q i) ν :=
    (hWcomp i).integral_prod_right
  have hVm (i : Fin 40) : AEStronglyMeasurable (V i) ν :=
    (hF i).aestronglyMeasurable.prod_swap.integral_prod_right'
  have htotal_insert (i : Fin 40) (X : FiniteMeasure ℝ)
      (Y : Fin 39 → FiniteMeasure ℝ) :
      total (i.insertNth X Y) = (X.mass : ℝ) + retained Y := by
    dsimp only [total, retained]
    rw [Fin.sum_univ_succAbove _ i]
    simp only [Fin.insertNth_apply_same, Fin.insertNth_apply_succAbove]
  have hweight (i : Fin 40) (X : FiniteMeasure ℝ)
      (Y : Fin 39 → FiniteMeasure ℝ) :
      W i (e i (X, Y)) =
        (S - retained Y + 39 * (X.mass : ℝ)) * F i (X, Y) ^ 2 := by
    change W i (i.insertNth X Y) =
      (S - retained Y + 39 * (X.mass : ℝ)) * f (i.insertNth X Y) ^ 2
    dsimp only [W]
    rw [htotal_insert, Fin.insertNth_apply_same]
    ring
  have hFibre (i : Fin 40) :
      ∀ᵐ Y ∂ν, MemLp (fun X : FiniteMeasure ℝ => F i (X, Y)) 2 μ := by
    filter_upwards [(hF i).aestronglyMeasurable.prodMk_right,
      (hF i).integrable_sq.prod_left_ae] with Y hm hsq
    exact (memLp_two_iff_integrable_sq hm).2 hsq
  have hsupportFibre (i : Fin 40) : ∀ᵐ Y ∂ν, ∀ᵐ X ∂μ,
      S < (X.mass : ℝ) + retained Y → F i (X, Y) = 0 := by
    have hpull : ∀ᵐ Z ∂μ.prod ν, S < total (e i Z) → F i Z = 0 :=
      (he i).quasiMeasurePreserving.ae hsupport'
    have hswap : ∀ᵐ Z ∂ν.prod μ, S < total (e i Z.swap) → F i Z.swap = 0 :=
      (Measure.measurePreserving_swap (μ := ν) (ν := μ)).quasiMeasurePreserving.ae hpull
    filter_upwards [Measure.ae_ae_of_ae_prod hswap] with Y hY
    filter_upwards [hY] with X hX
    change S < total (i.insertNth X Y) → f (i.insertNth X Y) = 0 at hX
    rw [htotal_insert] at hX
    exact hX
  have hface (i : Fin 40) : ∀ᵐ Y ∂ν, V i Y ^ 2 ≤ c * Q i Y := by
    filter_upwards [hFibre i, hsupportFibre i] with Y hFY hsY
    by_cases hs : retained Y ≤ S
    · have hsupp : ∀ᵐ X ∂μ,
          S - retained Y < (X.mass : ℝ) → F i (X, Y) = 0 := by
        filter_upwards [hsY] with X hX
        intro hmassX
        exact hX (by linarith)
      have h := (trial_weighted_face_fiber (S - retained Y) (sub_nonneg.mpr hs)
        (fun X : FiniteMeasure ℝ => F i (X, Y)) hFY hsupp).2
      have hQeq : Q i Y = ∫ X : FiniteMeasure ℝ,
          (S - retained Y + 39 * (X.mass : ℝ)) * F i (X, Y) ^ 2 ∂μ := by
        apply integral_congr_ae
        exact ae_of_all _ fun X => hweight i X Y
      simpa only [V, c, hQeq] using h
    · have hzero : (fun X : FiniteMeasure ℝ => F i (X, Y)) =ᵐ[μ] 0 := by
        filter_upwards [hsY] with X hX
        exact hX (by
          have hm0 := X.mass.coe_nonneg
          linarith [lt_of_not_ge hs])
      have hVzero : V i Y = 0 := integral_eq_zero_of_ae hzero
      have hQzero : Q i Y = 0 := by
        apply integral_eq_zero_of_ae
        filter_upwards [hzero] with X hX
        rw [hweight, hX]
        simp
      simp only [hVzero, hQzero, zero_pow (by norm_num : 2 ≠ 0), mul_zero, le_refl]
  have hV2 (i : Fin 40) : Integrable (fun Y => V i Y ^ 2) ν := by
    apply ((hQ i).const_mul c).mono' ((hVm i).pow 2)
    filter_upwards [hface i] with Y hY
    rw [Real.norm_eq_abs, abs_of_nonneg (sq_nonneg _)]
    exact hY
  have hQintegral (i : Fin 40) : (∫ Y, Q i Y ∂ν) = ∫ X, W i X ∂πμ := by
    calc
      (∫ Y, Q i Y ∂ν) = ∫ Z, W i (e i Z) ∂μ.prod ν :=
        (integral_prod_symm (fun Z => W i (e i Z)) (hWcomp i)).symm
      _ = ∫ X, W i X ∂πμ := (he i).integral_comp' (W i)
  have hfaceIntegral (i : Fin 40) :
      (∫ Y, V i Y ^ 2 ∂ν) ≤ c * ∫ X, W i X ∂πμ := by
    calc
      (∫ Y, V i Y ^ 2 ∂ν) ≤ ∫ Y, c * Q i Y ∂ν :=
        integral_mono_ae (hV2 i) ((hQ i).const_mul c) (hface i)
      _ = c * ∫ X, W i X ∂πμ := by rw [integral_const_mul, hQintegral]
  have hsumW (X : Fin 40 → FiniteMeasure ℝ) :
      (∑ i : Fin 40, W i X) = (40 * S) * f X ^ 2 := by
    dsimp only [W]
    rw [← Finset.sum_mul]
    simp only [Finset.sum_add_distrib, Finset.sum_const, Finset.card_univ,
      Fintype.card_fin, nsmul_eq_mul, ← Finset.mul_sum]
    change (40 * (S - total X) + 40 * total X) * f X ^ 2 = (40 * S) * f X ^ 2
    ring
  refine ⟨?_, ?_⟩
  · intro i
    change MemLp (V i) 2 ν
    exact (memLp_two_iff_integrable_sq (hVm i)).2 (hV2 i)
  · change (∑ i : Fin 40, ∫ Y, V i Y ^ 2 ∂ν) ≤
      (S * 40 * Real.log 40 / 39) * ∫ X, f X ^ 2 ∂πμ
    calc
      (∑ i : Fin 40, ∫ Y, V i Y ^ 2 ∂ν) ≤
          ∑ i : Fin 40, c * ∫ X, W i X ∂πμ :=
        Finset.sum_le_sum fun i _ => hfaceIntegral i
      _ = c * ∫ X, ∑ i : Fin 40, W i X ∂πμ := by
        rw [← Finset.mul_sum, ← integral_finsetSum Finset.univ (fun i _ => hW i)]
      _ = c * ((40 * S) * ∫ X, f X ^ 2 ∂πμ) := by
        simp_rw [hsumW]
        rw [integral_const_mul]
      _ = (S * 40 * Real.log 40 / 39) * ∫ X, f X ^ 2 ∂πμ := by
        dsimp only [c]
        ring

theorem trial_face_operator_constants :
    (∑ j ∈ Finset.range 12, (369 / 100 : ℝ) ^ j / (j.factorial : ℝ)) - 40 =
        (130369159716327491537440749 : ℝ) / 4928000000000000000000000000 ∧
      Real.log 40 < (369 / 100 : ℝ) ∧
      ((2742997 / 2624989 : ℝ) * 40 * Real.log 40 / 39) < 4 ∧
      1 - 4 * (2624989 / 10 ^ 7 : ℝ) * |(-843183 / 1000000000 : ℝ)| =
        (2497786653900013 : ℝ) / 2500000000000000 ∧
      0 < (2497786653900013 : ℝ) / 2500000000000000 := by
  have hsum : (∑ j ∈ Finset.range 12,
      (369 / 100 : ℝ) ^ j / (j.factorial : ℝ)) - 40 =
      (130369159716327491537440749 : ℝ) / 4928000000000000000000000000 := by
    norm_num [Finset.sum_range_succ, Nat.factorial]
  have hexp : (40 : ℝ) < Real.exp (369 / 100) := by
    have h := Real.sum_le_exp_of_nonneg (by norm_num : (0 : ℝ) ≤ 369 / 100) 12
    linarith [hsum]
  have hlog : Real.log 40 < (369 / 100 : ℝ) :=
    (Real.log_lt_iff_lt_exp (by norm_num : (0 : ℝ) < 40)).mpr hexp
  refine ⟨hsum, hlog, ?_, ?_, ?_⟩
  · nlinarith
  · norm_num
  · norm_num

theorem trial_physical_face_operator_bound
    (f : (Fin 40 → FiniteMeasure ℝ) → ℝ)
    (hf : MemLp f 2 (Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)))
    (hsupport : ∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure),
      (2742997 / 2624989 : ℝ) < ∑ i : Fin 40, ((X i).mass : ℝ) → f X = 0) :
    (∑ i : Fin 40,
      ∫ Y : Fin 39 → FiniteMeasure ℝ,
        (∫ X : FiniteMeasure ℝ, f (i.insertNth X Y) ∂trialPhysicalMeasure) ^ 2
        ∂Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)) ≤
      4 * ∫ X : Fin 40 → FiniteMeasure ℝ, f X ^ 2
        ∂Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure) := by
  have h := (trial_simplex_face_energy (2742997 / 2624989)
    (by norm_num) f hf hsupport).2
  exact h.trans (mul_le_mul_of_nonneg_right trial_face_operator_constants.2.2.1.le
    (integral_nonneg fun _ => sq_nonneg _))

theorem trial_marginal_energy_le_four_IH :
    ((∑ i : Fin 40,
      ∫ Y : Fin 39 → FiniteMeasure ℝ, trialMarginal i Y ^ 2
        ∂Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)) / trialPhysicalNormalizer) ≤
      4 * trialIH := by
  obtain ⟨_, _, _, hF, hFsq, _⟩ := trial_integrable_marginals
  have hmem : MemLp trialStepFunction 2
      (Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)) :=
    (memLp_two_iff_integrable_sq hF.aestronglyMeasurable).mpr hFsq
  have hmesh : 0 < (trialMesh : ℝ) :=
    Rat.cast_pos.mpr trial_fixed_positive_data.2.1
  have hsupport : ∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure),
      (2742997 / 2624989 : ℝ) < ∑ i : Fin 40, ((X i).mass : ℝ) →
        trialStepFunction X = 0 := by
    filter_upwards [] with X htotal
    by_contra hX
    have hr := (trialStepFunction_support X hX).1
    have hcell (i : Fin 40) : ((X i).mass : ℝ) <
        ((trialCellIndex (X i) : ℝ) + 1) * (trialMesh : ℝ) :=
      ((trialCellIndex_eq_iff (X i) (trialCellIndex (X i))).mp rfl).2
    have hsum := Finset.sum_lt_sum_of_nonempty
      (Finset.univ_nonempty : (Finset.univ : Finset (Fin 40)).Nonempty)
      (fun i _ => hcell i)
    have hcast : (∑ i : Fin 40, (trialCellIndex (X i) : ℝ)) ≤ 98263 := by
      exact_mod_cast hr
    have hupper : (∑ i : Fin 40,
        ((trialCellIndex (X i) : ℝ) + 1) * (trialMesh : ℝ)) ≤
        98303 * (trialMesh : ℝ) := by
      rw [← Finset.sum_mul, Finset.sum_add_distrib]
      norm_num only [Finset.sum_const, Finset.card_univ, Fintype.card_fin,
        nsmul_eq_mul, mul_one]
      exact mul_le_mul_of_nonneg_right (by linarith) hmesh.le
    have hrad : (98303 : ℝ) * (trialMesh : ℝ) < 2742997 / 2624989 := by
      norm_num [trialMesh]
    exact lt_asymm (htotal.trans (hsum.trans_le hupper)) hrad
  have h := trial_physical_face_operator_bound trialStepFunction hmem hsupport
  have hden : 0 < trialPhysicalNormalizer := trial_fixed_positive_data.2.2.2.2.2
  simpa only [trialMarginal, trialIH, mul_div_assoc] using
    div_le_div_of_nonneg_right h hden.le

end

section
open Set
/--
The nine ordered endpoints of the trial radial bands: zero, seven specified mesh multiples, and
the final rational cutoff.
-/
noncomputable def trialBandEndpoints : Fin 9 → ℝ :=
  ![0, 35265 * (trialMesh : ℝ), 35419 * (trialMesh : ℝ),
    44781 * (trialMesh : ℝ), 44976 * (trialMesh : ℝ),
    46580 * (trialMesh : ℝ), 49152 * (trialMesh : ℝ),
    68225 * (trialMesh : ℝ),
    ((19037 : ℝ) / 100000) / ((2624989 : ℝ) / 10000000)]

theorem trialBandEndpoints_geometry :
    StrictMono trialBandEndpoints ∧
      trialBandEndpoints 0 = 0 ∧
      trialBandEndpoints 7 = (trialLargestCap : ℝ) ∧
      trialBandEndpoints 8 =
        ((19037 : ℝ) / 100000) / ((2624989 : ℝ) / 10000000) ∧
      (trialLargestCap : ℝ) < trialBandEndpoints 8 ∧
      ((2624989 : ℝ) / 10000000) * (98303 * (trialMesh : ℝ)) < 11 / 40 ∧
      ((2624989 : ℝ) / 10000000) * (98303 * (trialMesh : ℝ)) < 1 / 2 ∧
      ∀ b : Fin 3,
        0 < ((2624989 : ℝ) / 10000000) *
            ((((![89524, 89914, 98263] : Fin 3 → ℕ) b : ℕ) : ℝ) + 39) *
            (trialMesh : ℝ) ∧
          ((2624989 : ℝ) / 10000000) *
              ((((![89524, 89914, 98263] : Fin 3 → ℕ) b : ℕ) : ℝ) + 39) *
              (trialMesh : ℝ) < 11 / 40 ∧
          ((2624989 : ℝ) / 10000000) *
              ((((![89524, 89914, 98263] : Fin 3 → ℕ) b : ℕ) : ℝ) + 39) *
              (trialMesh : ℝ) < 1 / 2 := by
  refine ⟨?_, rfl, ?_, rfl, ?_, ?_, ?_, ?_⟩
  · rw [Fin.strictMono_iff_lt_succ]
    intro i
    fin_cases i <;> dsimp [trialBandEndpoints, Fin.castSucc, Fin.succ] <;>
      norm_num [trialMesh]
  · change 68225 * (trialMesh : ℝ) = (trialLargestCap : ℝ)
    norm_num [trialLargestCap]
  · change (trialLargestCap : ℝ) <
      ((19037 : ℝ) / 100000) / ((2624989 : ℝ) / 10000000)
    norm_num [trialLargestCap, trialMesh]
  · norm_num [trialMesh]
  · norm_num [trialMesh]
  · intro b
    fin_cases b <;> norm_num [trialMesh]

open Classical in
theorem exists_trial_fixed_band_profiles :
    let a : Fin 9 → ℝ := trialBandEndpoints
    let κ : ℝ := a 8
    let B : FiniteMeasure ℝ → Fin 8 → ℝ :=
      fragmentBandMasses a
    let P : Measure (FiniteMeasure ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        fragmentLaw κ
    let ν : Measure (Fin 8 → ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        Measure.map B (fragmentLaw κ)
    let masks : Fin 3 → (Fin 39 → FiniteMeasure ℝ) → ℝ :=
      ![trialBaseMask, trialEnlargedMask, trialFullMask]
    let stops : Fin 3 → ℕ := ![89524, 89914, 98263]
    (Measure.pi (fun _ : Fin 40 => ν))
        {V : Fin 40 → Fin 8 → ℝ |
          ∃ i : Fin 40, ∃ n : ℕ, (∑ j : Fin 8, V i j) = (n : ℝ) * (trialMesh : ℝ)} = 0 ∧
      ∃ U : (Fin 40 → Fin 8 → ℝ) → ℝ,
        ∃ F : Fin 3 → Fin 40 → (Fin 40 → Fin 8 → ℝ) → ℝ,
          Measurable U ∧ Bornology.IsBounded (Set.range U) ∧
          (∀ b : Fin 3, ∀ i : Fin 40,
            Measurable (F b i) ∧ Bornology.IsBounded (Set.range (F b i))) ∧
          (∀ V : Fin 40 → Fin 8 → ℝ,
            (∀ i : Fin 40, ∀ n : ℕ,
              (∑ j : Fin 8, V i j) ≠ (n : ℝ) * (trialMesh : ℝ)) →
              ContinuousAt U V ∧ ∀ b : Fin 3, ∀ i : Fin 40, ContinuousAt (F b i) V) ∧
          (∀ᵐ V ∂Measure.pi (fun _ : Fin 40 => ν),
            ContinuousAt U V ∧ ∀ b : Fin 3, ∀ i : Fin 40, ContinuousAt (F b i) V) ∧
          (∀ W : ℕ, ∀ R : ℝ, 1 < R →
            let q : ℕ := ∏ p ∈ fragmentPrimes W R κ, p
            ∀ r : Fin 40 → ℕ, (∀ j : Fin 40, r j ∈ q.divisors) →
              let X : Fin 40 → FiniteMeasure ℝ :=
                fun j => primeLogConfiguration R (r j)
              U (fun j => B (X j)) = trialStepFunction X ∧
                ∀ b : Fin 3, ∀ i : Fin 40,
                  F b i (fun j => B (X j)) =
                    masks b (fun j => X (i.succAbove j)) * trialStepFunction X) ∧
          (∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => P),
            U (fun j => B (X j)) = trialStepFunction X ∧
              ∀ b : Fin 3, ∀ i : Fin 40,
                F b i (fun j => B (X j)) =
                  masks b (fun j => X (i.succAbove j)) * trialStepFunction X) ∧
          (∀ W : ℕ, ∀ R β : ℝ, 1 < R →
            let q : ℕ := ∏ p ∈ fragmentPrimes W R κ, p
            let T : Finset (Fin 40 → ℕ) :=
              (Fintype.piFinset (fun _ : Fin 40 => q.divisors)).filter
                (fun r => Squarefree (∏ j : Fin 40, r j))
            let X : (Fin 40 → ℕ) → Fin 40 → Fin 8 → ℝ :=
              fun r j => B (primeLogConfiguration R (r j))
            let y : (Fin 40 → ℕ) →₀ ℝ :=
              ∑ r ∈ T, Finsupp.single r (U (X r) / β ^ 40)
            let z : Fin 3 → Fin 40 → (Fin 40 → ℕ) →₀ ℝ :=
              fun b i => ∑ r ∈ T, Finsupp.single r (F b i (X r) / β ^ 40)
            (∀ d : Fin 40 → ℕ, selbergCoefficient y d ≠ 0 →
              ((∏ j : Fin 40, d j : ℕ) : ℝ) < R ^ (98303 * (trialMesh : ℝ))) ∧
              ∀ b : Fin 3, ∀ i : Fin 40, ∀ d : Fin 39 → ℕ,
                selbergCoefficient (z b i) (i.insertNth 1 d) ≠ 0 →
                  ((∏ j : Fin 39, d j : ℕ) : ℝ) <
                    R ^ (((stops b : ℝ) + 39) * (trialMesh : ℝ))) := by
  intro a κ B P ν masks stops
  let h : ℝ := (trialMesh : ℝ)
  have hh : 0 < h := Rat.cast_pos.mpr trial_fixed_positive_data.2.1
  have ha : StrictMono a := trialBandEndpoints_geometry.1
  have ha0 : a 0 = 0 := trialBandEndpoints_geometry.2.1
  have hcut (k : Fin 8) (hk : k ≠ 0) : 0 < a k.castSucc := by
    simpa only [ha0] using ha (Fin.castSucc_pos (Fin.pos_iff_ne_zero.mpr hk))
  have hκ : 0 < κ := by
    change 0 < ((19037 : ℝ) / 100000) / ((2624989 : ℝ) / 10000000)
    norm_num
  have hB : Measurable B := measurable_fragmentBandMasses a
  let : IsProbabilityMeasure (fragmentLaw κ) :=
    fragmentLaw_isProbabilityMeasure κ
  let : IsFiniteMeasure P :=
    Measure.smul_finite (fragmentLaw κ) ENNReal.ofReal_ne_top
  have hlawMapBP : Measure.map B P = ν := Measure.map_smul _ hB.aemeasurable
  let : IsFiniteMeasure ν := hlawMapBP ▸ Measure.isFiniteMeasure_map P B
  have hconfiggood : ∀ᵐ c ∂P,
      c.restrict (Set.Ioc (0 : ℝ) κ) = c ∧
        ∀ k : Fin 8, k ≠ 0 →
          ((c.restrict (Set.Ioc (a k.castSucc) κ)).mass : ℝ) = 0 ∨
            a k.castSucc < ((c.restrict (Set.Ioc (a k.castSucc) κ)).mass : ℝ) := by
    have htail (k : Fin 8) : ∀ᵐ c ∂fragmentLaw κ,
        k ≠ 0 →
          ((c.restrict (Set.Ioc (a k.castSucc) κ)).mass : ℝ) = 0 ∨
            a k.castSucc < ((c.restrict (Set.Ioc (a k.castSucc) κ)).mass : ℝ) := by
      rw [Filter.eventually_imp_distrib_left]
      intro hk
      exact fragmentLaw_restricted_mass_gap
        κ (a k.castSucc) κ (hcut k hk)
    exact Measure.ae_smul_measure
      ((ae_restrict_Ioc_fragmentLaw κ).and
        (ae_all_iff.mpr htail))
      (ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ))
  let total : (Fin 8 → ℝ) → ℝ := fun v => ∑ j : Fin 8, v j
  have htotal : Continuous total := by dsimp only [total]; fun_prop
  have hlawSum (c : FiniteMeasure ℝ)
      (hc : c.restrict (Set.Ioc (0 : ℝ) κ) = c) :
      total (B c) = (c.mass : ℝ) := by
    calc
      total (B c) =
          ((c.restrict (Set.Ioc (a 0) (a (Fin.last 8)))).mass : ℝ) :=
        sum_fragmentBandMasses a ha.monotone c
      _ = (c.mass : ℝ) := by
        rw [ha0]
        change ((c.restrict (Set.Ioc (0 : ℝ) κ)).mass : ℝ) = (c.mass : ℝ)
        rw [hc]
  have hlawTotalMap :
      Measure.map total ν =
        (volume.restrict (Set.Ici (0 : ℝ))).withDensity
          (fun t => ENNReal.ofReal (dickmanRho (t / κ))) := by
    calc
      Measure.map total ν =
          Measure.map (fun c : FiniteMeasure ℝ => (c.mass : ℝ)) P := by
        rw [← hlawMapBP, Measure.map_map htotal.measurable hB]
        apply Measure.map_congr
        filter_upwards [hconfiggood] with c hc
        exact hlawSum c hc.1
      _ = _ := by
        change Measure.map (fun c : FiniteMeasure ℝ => (c.mass : ℝ))
          (ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
            fragmentLaw κ) = _
        have hm : Measurable (fun c : FiniteMeasure ℝ => (c.mass : ℝ)) :=
          ((Measure.measurable_coe MeasurableSet.univ).comp
            measurable_subtype_coe).ennreal_toReal
        rw [Measure.map_smul _ hm.aemeasurable]
        exact normalized_fragmentLaw_mass_eq_dickman κ hκ
  have hlawPoint (t : ℝ) : ν {v : Fin 8 → ℝ | total v = t} = 0 := by
    change ν (total ⁻¹' {t}) = 0
    rw [← Measure.map_apply htotal.measurable (measurableSet_singleton t), hlawTotalMap]
    exact measure_singleton t
  have hgridnull :
      (Measure.pi (fun _ : Fin 40 => ν))
        {V : Fin 40 → Fin 8 → ℝ |
          ∃ i : Fin 40, ∃ n : ℕ, (∑ j : Fin 8, V i j) = (n : ℝ) * h} = 0 := by
    simp only [Set.ofPred_exists]
    exact measure_iUnion_null fun i => measure_iUnion_null fun n =>
      Measure.pi_eval_preimage_null (fun _ : Fin 40 => ν) (i := i) (hlawPoint ((n : ℝ) * h))
  let idx : (Fin 8 → ℝ) → ℕ := fun v => ⌊total v / h⌋₊
  let tail : Fin 8 → (Fin 8 → ℝ) → ℝ := fun k v =>
    ∑ j ∈ Finset.univ.filter (fun j : Fin 8 => k ≤ j), v j
  let test : Fin 8 → (Fin 8 → ℝ) → ℝ := fun k v =>
    max 0 (min 1 (1 - tail k v / a k.castSucc))
  let mask (n stop : ℕ) (cap : ℕ → Fin 8) (V : Fin n → Fin 8 → ℝ) : ℝ :=
    if (∑ i : Fin n, idx (V i)) ≤ stop then
      ∏ i : Fin n, test (cap (∑ j : Fin n, idx (V j))) (V i)
    else 0
  let capO : ℕ → Fin 8 := fun r =>
    if r ≤ 89196 then 7 else if r ≤ 95598 then 6 else 5
  let capF : Fin 3 → ℕ → Fin 8 := fun b r =>
    if b = 0 then
      if r ≤ 84930 then 7 else if r ≤ 87194 then 3 else 1
    else if b = 1 then
      if r ≤ 85161 then 7 else if r ≤ 87249 then 4 else 2
    else 7
  let amp : (Fin 40 → ℕ) → ℝ := fun v =>
    (∏ i : Fin 40, (trialProfileValue (v i) : ℝ)) *
      ∑ s : Fin 11,
        (trialRadialPolynomial s).eval₂ (Rat.castHom ℝ)
            ((((∑ i : Fin 40, v i : ℕ) : ℝ) + 20) * h - 9 / 10) *
          angularMonomial (trialAngularSignature s)
            (fun i => (trialCellMidpoint (v i) : ℝ))
  let U : (Fin 40 → Fin 8 → ℝ) → ℝ := fun V =>
    mask 40 98263 capO V * amp (fun i => idx (V i))
  let F : Fin 3 → Fin 40 → (Fin 40 → Fin 8 → ℝ) → ℝ := fun b i V =>
    mask 39 (stops b) (capF b) (fun j => V (i.succAbove j)) * U V
  have htail (k : Fin 8) : Continuous (tail k) := by
    dsimp only [tail]
    exact continuous_finsetSum _ fun j _ => continuous_apply j
  have htest (k : Fin 8) : Continuous (test k) := by
    dsimp only [test]
    exact continuous_const.max
      (continuous_const.min (continuous_const.sub ((htail k).div_const _)))
  have htest01 (k : Fin 8) (v : Fin 8 → ℝ) : 0 ≤ test k v ∧ test k v ≤ 1 :=
    ⟨le_max_left _ _, max_le zero_le_one (min_le_left _ _)⟩
  have hidx : Measurable idx := (htotal.measurable.div_const h).nat_floor
  have hindices (n : ℕ) :
      Measurable (fun V : Fin n → Fin 8 → ℝ => fun i => idx (V i)) :=
    measurable_pi_lambda _ fun i => hidx.comp (measurable_pi_apply i)
  have hmaskMeas (n stop : ℕ) (cap : ℕ → Fin 8) : Measurable (mask n stop cap) := by
    have hr : Measurable (fun V : Fin n → Fin 8 → ℝ => ∑ i : Fin n, idx (V i)) :=
      Finset.measurable_fun_sum _ fun i _ => hidx.comp (measurable_pi_apply i)
    have hm : Measurable
        (fun p : ℕ × (Fin n → Fin 8 → ℝ) =>
          if p.1 ≤ stop then ∏ i : Fin n, test (cap p.1) (p.2 i) else 0) := by
      apply measurable_from_prod_countable_right
      intro r
      exact Measurable.ite (MeasurableSet.const (r ≤ stop))
        (Finset.measurable_fun_prod _ fun i _ =>
          (htest (cap r)).measurable.comp (measurable_pi_apply i)) measurable_const
    exact hm.comp (hr.prodMk measurable_id)
  have hmask01 (n stop : ℕ) (cap : ℕ → Fin 8) (V : Fin n → Fin 8 → ℝ) :
      0 ≤ mask n stop cap V ∧ mask n stop cap V ≤ 1 := by
    dsimp only [mask]
    split_ifs
    · exact ⟨Finset.prod_nonneg fun i _ => (htest01 _ (V i)).1,
        Finset.prod_le_one (fun i _ => (htest01 _ (V i)).1)
          (fun i _ => (htest01 _ (V i)).2)⟩
    · norm_num
  have hmaskNonzero (n stop : ℕ) (cap : ℕ → Fin 8) (V : Fin n → Fin 8 → ℝ)
      (hm : mask n stop cap V ≠ 0) : (∑ j : Fin n, idx (V j)) ≤ stop := by
    dsimp only [mask] at hm
    exact (ite_ne_right_iff.mp hm).1
  have hUmeas : Measurable U :=
    (hmaskMeas 40 98263 capO).fun_mul
      ((Measurable.of_discrete : Measurable amp).fun_comp (hindices 40))
  have hFmeas (b : Fin 3) (i : Fin 40) : Measurable (F b i) := by
    have he : Measurable (fun V : Fin 40 → Fin 8 → ℝ =>
        fun j : Fin 39 => V (i.succAbove j)) := by fun_prop
    dsimp only [F]
    exact ((hmaskMeas 39 (stops b) (capF b)).fun_comp he).fun_mul hUmeas
  obtain ⟨M, hM, hMA⟩ :=
    (Set.finite_range (fun v : Fin 40 → Fin 98264 =>
      amp (fun i => (v i).val))).isBounded.exists_pos_norm_le
  have hUbound (V : Fin 40 → Fin 8 → ℝ) : ‖U V‖ ≤ M := by
    by_cases hr : (∑ i : Fin 40, idx (V i)) ≤ 98263
    · have hi (i : Fin 40) : idx (V i) < 98264 := by
        have hle : idx (V i) ≤ ∑ j : Fin 40, idx (V j) :=
          Finset.single_le_sum_of_canonicallyOrdered (f := fun j : Fin 40 => idx (V j))
            (Finset.mem_univ i)
        exact Nat.lt_succ_of_le (hle.trans hr)
      let v : Fin 40 → Fin 98264 := fun i => ⟨idx (V i), hi i⟩
      have hamp : ‖amp (fun i => idx (V i))‖ ≤ M := hMA _ ⟨v, rfl⟩
      have hm : ‖mask 40 98263 capO V‖ ≤ 1 := by
        rw [Real.norm_of_nonneg (hmask01 _ _ _ _).1]
        exact (hmask01 _ _ _ _).2
      simpa only [U, one_mul] using norm_mul_le_of_le hm hamp
    · simpa only [U, mask, hr, ite_false, zero_mul, norm_zero] using hM.le
  have hFbound (b : Fin 3) (i : Fin 40) (V : Fin 40 → Fin 8 → ℝ) :
      ‖F b i V‖ ≤ M := by
    have hm : ‖mask 39 (stops b) (capF b) (fun j => V (i.succAbove j))‖ ≤ 1 := by
      rw [Real.norm_of_nonneg (hmask01 _ _ _ _).1]
      exact (hmask01 _ _ _ _).2
    simpa only [F, one_mul] using norm_mul_le_of_le hm (hUbound V)
  have hlocalIdx (v : Fin 8 → ℝ)
      (hv : ∀ n : ℕ, total v ≠ (n : ℝ) * h) :
      ∀ᶠ w in 𝓝 v, idx w = idx v := by
    let t : ℝ := total v / h
    have hc : Continuous (fun w : Fin 8 → ℝ => total w / h) := htotal.div_const h
    by_cases ht : t < 0
    · have hlt : t < 1 := ht.trans zero_lt_one
      filter_upwards [hc.continuousAt.eventually (Iio_mem_nhds hlt)] with w hw
      exact (Nat.floor_eq_zero.mpr hw).trans (Nat.floor_eq_zero.mpr hlt).symm
    · have ht0 : 0 ≤ t := le_of_not_gt ht
      have hlo : (idx v : ℝ) < t := by
        apply lt_of_le_of_ne (Nat.floor_le ht0)
        intro heq
        apply hv (idx v)
        exact (div_eq_iff hh.ne').mp heq.symm
      filter_upwards [hc.continuousAt.eventually
        (Ioo_mem_nhds hlo (Nat.lt_floor_add_one t))] with w hw
      apply (Nat.floor_eq_iff ((Nat.cast_nonneg (idx v)).trans hw.1.le)).mpr
      exact ⟨hw.1.le, hw.2⟩
  have hlocalIndices (n : ℕ) (V : Fin n → Fin 8 → ℝ)
      (hV : ∀ i : Fin n, ∀ r : ℕ, total (V i) ≠ (r : ℝ) * h) :
      ∀ᶠ Y in 𝓝 V, (fun i => idx (Y i)) = (fun i => idx (V i)) := by
    have he : ∀ᶠ Y in 𝓝 V, ∀ i : Fin n, idx (Y i) = idx (V i) :=
      Filter.eventually_all.mpr fun i =>
        (continuous_apply i).continuousAt.eventually (hlocalIdx (V i) (hV i))
    exact he.mono fun _ hY => funext hY
  have hmaskCont (n stop : ℕ) (cap : ℕ → Fin 8) (V : Fin n → Fin 8 → ℝ)
      (hV : ∀ i : Fin n, ∀ r : ℕ, total (V i) ≠ (r : ℝ) * h) :
      ContinuousAt (mask n stop cap) V := by
    let r : ℕ := ∑ i : Fin n, idx (V i)
    have hc : Continuous (fun Y : Fin n → Fin 8 → ℝ =>
        if r ≤ stop then ∏ i : Fin n, test (cap r) (Y i) else 0) :=
      (continuous_finsetProd _ fun i _ => (htest (cap r)).comp
        (continuous_apply i)).if_const (r ≤ stop) continuous_const
    apply hc.continuousAt.congr_of_eventuallyEq
    filter_upwards [hlocalIndices n V hV] with Y hY
    simp only [mask, r, hY]
  have hUcont (V : Fin 40 → Fin 8 → ℝ)
      (hV : ∀ i : Fin 40, ∀ n : ℕ, total (V i) ≠ (n : ℝ) * h) :
      ContinuousAt U V := by
    have hamp : ContinuousAt (fun Y : Fin 40 → Fin 8 → ℝ =>
        amp (fun i => idx (Y i))) V := by
      apply continuousAt_const.congr_of_eventuallyEq
      exact (hlocalIndices 40 V hV).mono fun _ hY => congrArg amp hY
    exact (hmaskCont 40 98263 capO V hV).fun_mul hamp
  have hFcont (b : Fin 3) (i : Fin 40) (V : Fin 40 → Fin 8 → ℝ)
      (hV : ∀ j : Fin 40, ∀ n : ℕ, total (V j) ≠ (n : ℝ) * h) :
      ContinuousAt (F b i) V := by
    have he : Continuous (fun Y : Fin 40 → Fin 8 → ℝ =>
        fun j : Fin 39 => Y (i.succAbove j)) := by fun_prop
    have hm := ContinuousAt.comp'
      (f := fun Y : Fin 40 → Fin 8 → ℝ => fun j : Fin 39 => Y (i.succAbove j))
      (g := mask 39 (stops b) (capF b)) (x := V)
      (hmaskCont 39 (stops b) (capF b) (fun j => V (i.succAbove j))
        (fun j => hV (i.succAbove j))) he.continuousAt
    exact hm.fun_mul (hUcont V hV)
  have htailMass (c : FiniteMeasure ℝ) (k : Fin 8) :
      tail k (B c) = ((c.restrict (Set.Ioc (a k.castSucc) κ)).mass : ℝ) := by
    simp only [tail, B, fragmentBandMasses, FiniteMeasure.restrict_mass]
    change (∑ j ∈ Finset.univ.filter (fun j : Fin 8 => k ≤ j),
      (c : Measure ℝ).real (Set.Ioc (a j.castSucc) (a j.succ))) =
        (c : Measure ℝ).real (Set.Ioc (a k.castSucc) κ)
    fin_cases k
    · simpa [Finset.sum_filter, Fin.sum_univ_succ, κ] using
        sum_measureReal_adjacent_Ioc a ha.monotone (c : Measure ℝ)
    · simpa [Finset.sum_filter, Fin.sum_univ_succ, κ] using
        sum_measureReal_adjacent_Ioc
          (fun j : Fin 8 => a (Fin.natAdd 1 j))
          (ha.monotone.comp (Fin.strictMono_natAdd 1).monotone) (c : Measure ℝ)
    · simpa [Finset.sum_filter, Fin.sum_univ_succ, κ] using
        sum_measureReal_adjacent_Ioc
          (fun j : Fin 7 => a (Fin.natAdd 2 j))
          (ha.monotone.comp (Fin.strictMono_natAdd 2).monotone) (c : Measure ℝ)
    · simpa [Finset.sum_filter, Fin.sum_univ_succ, κ] using
        sum_measureReal_adjacent_Ioc
          (fun j : Fin 6 => a (Fin.natAdd 3 j))
          (ha.monotone.comp (Fin.strictMono_natAdd 3).monotone) (c : Measure ℝ)
    · simpa [Finset.sum_filter, Fin.sum_univ_succ, κ] using
        sum_measureReal_adjacent_Ioc
          (fun j : Fin 5 => a (Fin.natAdd 4 j))
          (ha.monotone.comp (Fin.strictMono_natAdd 4).monotone) (c : Measure ℝ)
    · simpa [Finset.sum_filter, Fin.sum_univ_succ, κ] using
        sum_measureReal_adjacent_Ioc
          (fun j : Fin 4 => a (Fin.natAdd 5 j))
          (ha.monotone.comp (Fin.strictMono_natAdd 5).monotone) (c : Measure ℝ)
    · simpa [Finset.sum_filter, Fin.sum_univ_succ, κ] using
        sum_measureReal_adjacent_Ioc
          (fun j : Fin 3 => a (Fin.natAdd 6 j))
          (ha.monotone.comp (Fin.strictMono_natAdd 6).monotone) (c : Measure ℝ)
    · simp [Finset.sum_filter, Fin.sum_univ_succ, κ]
  have htestConfig (c : FiniteMeasure ℝ)
      (hc : c.restrict (Set.Ioc (0 : ℝ) κ) = c)
      (hg : ∀ k : Fin 8, k ≠ 0 →
        ((c.restrict (Set.Ioc (a k.castSucc) κ)).mass : ℝ) = 0 ∨
          a k.castSucc < ((c.restrict (Set.Ioc (a k.castSucc) κ)).mass : ℝ))
      (k : Fin 8) (hk : k ≠ 0) :
      test k (B c) = if (c : Measure ℝ) (Set.Ioi (a k.castSucc)) = 0 then 1 else 0 := by
    have hkpos := hcut k hk
    have hsets : Set.Ioi (a k.castSucc) ∩ Set.Ioc (0 : ℝ) κ =
        Set.Ioc (a k.castSucc) κ := by
      rw [Set.inter_comm, Set.Ioc_inter_Ioi, sup_of_le_right hkpos.le]
    have he : c (Set.Ioc (a k.castSucc) κ) = c (Set.Ioi (a k.castSucc)) := by
      simpa only [FiniteMeasure.restrict_apply _ _ measurableSet_Ioi, hsets] using
        congrArg (fun μ : FiniteMeasure ℝ => μ (Set.Ioi (a k.castSucc))) hc
    have hz : tail k (B c) = 0 ↔ (c : Measure ℝ) (Set.Ioi (a k.castSucc)) = 0 := by
      rw [htailMass, FiniteMeasure.restrict_mass, he]
      exact NNReal.coe_eq_zero.trans (FiniteMeasure.null_iff_toMeasure_null c _)
    by_cases hc0 : (c : Measure ℝ) (Set.Ioi (a k.castSucc)) = 0
    · have ht0 := hz.mpr hc0
      simp only [test, ht0, zero_div, sub_zero, min_self, max_eq_right zero_le_one,
        hc0, ite_true]
    · have ht : a k.castSucc < tail k (B c) := by
        have hgap : tail k (B c) = 0 ∨ a k.castSucc < tail k (B c) := by
          simpa only [htailMass] using hg k hk
        exact hgap.resolve_left (fun hzero => hc0 (hz.mp hzero))
      have hnegative : 1 - tail k (B c) / a k.castSucc ≤ 0 :=
        sub_nonpos.mpr ((one_lt_div hkpos).mpr ht).le
      simp only [test, min_eq_right (hnegative.trans zero_le_one),
        max_eq_left hnegative, hc0, ite_false]
  have hidxConfig (c : FiniteMeasure ℝ)
      (hc : c.restrict (Set.Ioc (0 : ℝ) κ) = c) : idx (B c) = trialCellIndex c := by
    simp only [idx, hlawSum c hc, trialCellIndex, h]
  have hmaskConfig (n stop : ℕ) (cap : ℕ → Fin 8) (hcap : ∀ r, cap r ≠ 0)
      (X : Fin n → FiniteMeasure ℝ)
      (hX : ∀ i : Fin n,
        (X i).restrict (Set.Ioc (0 : ℝ) κ) = X i ∧
          ∀ k : Fin 8, k ≠ 0 →
            (((X i).restrict (Set.Ioc (a k.castSucc) κ)).mass : ℝ) = 0 ∨
              a k.castSucc < (((X i).restrict (Set.Ioc (a k.castSucc) κ)).mass : ℝ)) :
      mask n stop cap (fun i => B (X i)) =
        if (∑ i : Fin n, trialCellIndex (X i)) ≤ stop ∧
            ∀ i : Fin n,
              (X i : Measure ℝ)
                (Set.Ioi (a (cap (∑ j : Fin n, trialCellIndex (X j))).castSucc)) = 0
        then 1 else 0 := by
    have hindicesEq : (fun i : Fin n => idx (B (X i))) =
        (fun i : Fin n => trialCellIndex (X i)) :=
      funext fun i => hidxConfig (X i) (hX i).1
    simp only [mask, hindicesEq, ite_and]
    congr 1
    have hprod := Finset.prod_congr (s₁ := Finset.univ) rfl (fun i _ =>
        htestConfig (X i) (hX i).1 (hX i).2
          (cap (∑ j : Fin n, trialCellIndex (X j))) (hcap _))
    rw [Fintype.prod_boole] at hprod
    exact hprod.trans (ite_cond_congr rfl)
  have hcapO (r : ℕ) : capO r ≠ 0 := by
    dsimp only [capO]
    split_ifs <;> decide
  have hcapF (b : Fin 3) (r : ℕ) : capF b r ≠ 0 := by
    dsimp only [capF]
    split_ifs <;> decide
  have hOuterConfig (X : Fin 40 → FiniteMeasure ℝ)
      (hX : ∀ i : Fin 40,
        (X i).restrict (Set.Ioc (0 : ℝ) κ) = X i ∧
          ∀ k : Fin 8, k ≠ 0 →
            (((X i).restrict (Set.Ioc (a k.castSucc) κ)).mass : ℝ) = 0 ∨
              a k.castSucc < (((X i).restrict (Set.Ioc (a k.castSucc) κ)).mass : ℝ)) :
      mask 40 98263 capO (fun i => B (X i)) = trialOuterMask X := by
    have hm := hmaskConfig 40 98263 capO hcapO X hX
    by_cases h0 : (∑ i : Fin 40, trialCellIndex (X i)) ≤ 89196
    · simpa [trialOuterMask, capO, a, trialBandEndpoints, h0, h] using hm
    · by_cases h1 : (∑ i : Fin 40, trialCellIndex (X i)) ≤ 95598
      · simpa [trialOuterMask, capO, a, trialBandEndpoints, h0, h1, h] using hm
      · simpa [trialOuterMask, capO, a, trialBandEndpoints, h0, h1, h] using hm
  have hFaceConfig (b : Fin 3) (X : Fin 39 → FiniteMeasure ℝ)
      (hX : ∀ i : Fin 39,
        (X i).restrict (Set.Ioc (0 : ℝ) κ) = X i ∧
          ∀ k : Fin 8, k ≠ 0 →
            (((X i).restrict (Set.Ioc (a k.castSucc) κ)).mass : ℝ) = 0 ∨
              a k.castSucc < (((X i).restrict (Set.Ioc (a k.castSucc) κ)).mass : ℝ)) :
      mask 39 (stops b) (capF b) (fun i => B (X i)) = masks b X := by
    have hm := hmaskConfig 39 (stops b) (capF b) (hcapF b) X hX
    fin_cases b
    · by_cases h0 : (∑ i : Fin 39, trialCellIndex (X i)) ≤ 84930
      · simpa [masks, stops, trialBaseMask, capF, a, trialBandEndpoints, h0, h] using hm
      · by_cases h1 : (∑ i : Fin 39, trialCellIndex (X i)) ≤ 87194
        · simpa [masks, stops, trialBaseMask, capF, a, trialBandEndpoints, h0, h1, h] using hm
        · simpa [masks, stops, trialBaseMask, capF, a, trialBandEndpoints, h0, h1, h] using hm
    · by_cases h0 : (∑ i : Fin 39, trialCellIndex (X i)) ≤ 85161
      · simpa [masks, stops, trialEnlargedMask, capF, a, trialBandEndpoints, h0, h] using hm
      · by_cases h1 : (∑ i : Fin 39, trialCellIndex (X i)) ≤ 87249
        · simpa [masks, stops, trialEnlargedMask, capF, a, trialBandEndpoints, h0, h1, h] using hm
        · simpa [masks, stops, trialEnlargedMask, capF, a, trialBandEndpoints, h0, h1, h] using hm
    · simpa [masks, stops, trialFullMask, trialLargestCap, capF, a,
        trialBandEndpoints, h] using hm
  have hAgreement (X : Fin 40 → FiniteMeasure ℝ)
      (hX : ∀ i : Fin 40,
        (X i).restrict (Set.Ioc (0 : ℝ) κ) = X i ∧
          ∀ k : Fin 8, k ≠ 0 →
            (((X i).restrict (Set.Ioc (a k.castSucc) κ)).mass : ℝ) = 0 ∨
              a k.castSucc < (((X i).restrict (Set.Ioc (a k.castSucc) κ)).mass : ℝ)) :
      U (fun j => B (X j)) = trialStepFunction X ∧
        ∀ b : Fin 3, ∀ i : Fin 40,
          F b i (fun j => B (X j)) =
            masks b (fun j => X (i.succAbove j)) * trialStepFunction X := by
    have hindicesEq : (fun i : Fin 40 => idx (B (X i))) =
        (fun i : Fin 40 => trialCellIndex (X i)) :=
      funext fun i => hidxConfig (X i) (hX i).1
    have hUeq : U (fun j => B (X j)) = trialStepFunction X := by
      dsimp only [U]
      rw [hOuterConfig X hX, hindicesEq]
      simp only [amp, trialStepFunction_eq_cellExpression, h]
      exact (mul_assoc _ _ _).symm
    refine ⟨hUeq, ?_⟩
    intro b i
    dsimp only [F]
    rw [hUeq, hFaceConfig b (fun j => X (i.succAbove j))
      (fun j => hX (i.succAbove j))]
  have hArithSupport (W : ℕ) (R : ℝ) (hR : 1 < R) (s : ℕ)
      (hs : s ∈ (∏ p ∈ fragmentPrimes W R κ, p).divisors) :
      (primeLogConfiguration R s).restrict (Set.Ioc (0 : ℝ) κ) =
        primeLogConfiguration R s := by
    have hd := (mem_fragment_divisors_iff W R κ
      (Real.one_le_rpow hR.le hκ.le) s).mp hs
    have hmark (p : ℕ) (hp : p ∈ s.primeFactors) :
        Real.log p / Real.log R ∈ Set.Ioc (0 : ℝ) κ := by
      have hprime := Nat.prime_of_mem_primeFactors hp
      have hpR : (p : ℝ) ≤ R ^ κ :=
        (Nat.cast_le.mpr ((Finset.le_sup (f := id) hp).trans (le_max_right 1 _))).trans
          hd.2.2
      refine ⟨div_pos (Real.log_pos (by exact_mod_cast hprime.one_lt))
        (Real.log_pos hR), ?_⟩
      exact (div_le_iff₀ (Real.log_pos hR)).mpr
        ((Real.le_rpow_iff_log_le (by exact_mod_cast hprime.pos)
          (zero_lt_one.trans hR)).mp hpR)
    apply FiniteMeasure.toMeasure_injective
    apply Measure.restrict_eq_self_of_ae_mem
    apply ae_iff.mpr
    change (primeLogConfiguration R s : Measure ℝ)
      (Set.Ioc (0 : ℝ) κ)ᶜ = 0
    rw [primeLogConfiguration, FiniteMeasure.toMeasure_sum,
      Measure.finsetSum_apply]
    apply Finset.sum_eq_zero
    intro p hp
    change ((Real.log p / Real.log R).toNNReal • Measure.dirac (Real.log p / Real.log R))
      (Set.Ioc (0 : ℝ) κ)ᶜ = 0
    have hout : Real.log p / Real.log R ∉ (Set.Ioc (0 : ℝ) κ)ᶜ := by
      simpa only [Set.mem_compl_iff, not_not] using hmark p hp
    simp only [Measure.smul_apply, Measure.dirac_apply' _ measurableSet_Ioc.compl,
      Set.indicator_of_notMem hout, smul_zero]
  have hArith (W : ℕ) (R : ℝ) (hR : 1 < R) (r : Fin 40 → ℕ)
      (hr : ∀ j : Fin 40,
        r j ∈ (∏ p ∈ fragmentPrimes W R κ, p).divisors) :
      let X : Fin 40 → FiniteMeasure ℝ :=
        fun j => primeLogConfiguration R (r j)
      U (fun j => B (X j)) = trialStepFunction X ∧
        ∀ b : Fin 3, ∀ i : Fin 40,
          F b i (fun j => B (X j)) =
            masks b (fun j => X (i.succAbove j)) * trialStepFunction X := by
    intro X
    apply hAgreement X
    intro j
    refine ⟨hArithSupport W R hR (r j) (hr j), ?_⟩
    intro k hk
    exact primeLogConfiguration_restricted_mass_gap
      R (r j) (a k.castSucc) κ (hcut k hk)
  have hLawAgreement : ∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => P),
      U (fun j => B (X j)) = trialStepFunction X ∧
        ∀ b : Fin 3, ∀ i : Fin 40,
          F b i (fun j => B (X j)) =
            masks b (fun j => X (i.succAbove j)) * trialStepFunction X := by
    have hgood : ∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => P), ∀ i : Fin 40,
        (X i).restrict (Set.Ioc (0 : ℝ) κ) = X i ∧
          ∀ k : Fin 8, k ≠ 0 →
            (((X i).restrict (Set.Ioc (a k.castSucc) κ)).mass : ℝ) = 0 ∨
              a k.castSucc < (((X i).restrict (Set.Ioc (a k.castSucc) κ)).mass : ℝ) :=
      ae_all_iff.mpr fun i =>
        (Measure.quasiMeasurePreserving_eval (fun _ : Fin 40 => P) i).ae hconfiggood
    filter_upwards [hgood] with X hX
    exact hAgreement X hX
  have hradius :
      ∀ W : ℕ, ∀ R β : ℝ, 1 < R →
        let q : ℕ := ∏ p ∈ fragmentPrimes W R κ, p
        let T : Finset (Fin 40 → ℕ) :=
          (Fintype.piFinset (fun _ : Fin 40 => q.divisors)).filter
            (fun r => Squarefree (∏ j : Fin 40, r j))
        let X : (Fin 40 → ℕ) → Fin 40 → Fin 8 → ℝ :=
          fun r j => B (primeLogConfiguration R (r j))
        let y : (Fin 40 → ℕ) →₀ ℝ :=
          ∑ r ∈ T, Finsupp.single r (U (X r) / β ^ 40)
        let z : Fin 3 → Fin 40 → (Fin 40 → ℕ) →₀ ℝ :=
          fun b i => ∑ r ∈ T, Finsupp.single r (F b i (X r) / β ^ 40)
        (∀ d : Fin 40 → ℕ, selbergCoefficient y d ≠ 0 →
          ((∏ j : Fin 40, d j : ℕ) : ℝ) < R ^ (98303 * (trialMesh : ℝ))) ∧
          ∀ b : Fin 3, ∀ i : Fin 40, ∀ d : Fin 39 → ℕ,
            selbergCoefficient (z b i) (i.insertNth 1 d) ≠ 0 →
              ((∏ j : Fin 39, d j : ℕ) : ℝ) <
                R ^ (((stops b : ℝ) + 39) * (trialMesh : ℝ)) := by
    intro W R β hR q T X y z
    have hcell {ι : Type} [Fintype ι] [Nonempty ι]
        (r : ι → ℕ) (hr : ∀ j, r j ∈ q.divisors) (N : ℕ)
        (hN : (∑ j, trialCellIndex
          (primeLogConfiguration R (r j))) ≤ N) :
        ((∏ j, r j : ℕ) : ℝ) <
          R ^ (((N : ℝ) + (Fintype.card ι : ℝ)) * h) := by
      let C : ι → FiniteMeasure ℝ :=
        fun j => primeLogConfiguration R (r j)
      have hmass (j : ι) : ((C j).mass : ℝ) = Real.log (r j) / Real.log R := by
        calc
          ((C j).mass : ℝ) =
              (((C j).restrict (Set.Ioc (0 : ℝ) κ)).mass : ℝ) :=
            congrArg (fun c : FiniteMeasure ℝ => (c.mass : ℝ))
              (hArithSupport W R hR (r j) (hr j)).symm
          _ = Real.log (r j) / Real.log R :=
            fragment_divisor_configuration_mass
              W R κ hR hκ (r j) (hr j)
      have hsum : (∑ j, ((C j).mass : ℝ)) <
          ((N : ℝ) + (Fintype.card ι : ℝ)) * h := by
        calc
          (∑ j, ((C j).mass : ℝ)) <
              ∑ j, ((trialCellIndex (C j) : ℝ) + 1) * h :=
            Finset.sum_lt_sum_of_nonempty Finset.univ_nonempty fun j _ =>
              ((trialCellIndex_eq_iff (C j) (trialCellIndex (C j))).mp rfl).2
          _ = (((∑ j, trialCellIndex (C j) : ℕ) : ℝ) +
                (Fintype.card ι : ℝ)) * h := by
            simp only [← Finset.sum_mul, Finset.sum_add_distrib, Finset.sum_const,
              Finset.card_univ, nsmul_eq_mul, mul_one, Nat.cast_sum]
          _ ≤ ((N : ℝ) + (Fintype.card ι : ℝ)) * h :=
            mul_le_mul_of_nonneg_right
              (add_le_add (Nat.cast_le.mpr hN) le_rfl) hh.le
      have hlog : Real.log ((∏ j, r j : ℕ) : ℝ) / Real.log R =
          ∑ j, ((C j).mass : ℝ) := by
        rw [Nat.cast_prod, Real.log_prod (fun j _ =>
          Nat.cast_ne_zero.mpr (Nat.pos_of_mem_divisors (hr j)).ne'), Finset.sum_div]
        exact Finset.sum_congr rfl fun j _ => (hmass j).symm
      apply Real.lt_rpow_of_log_lt (zero_lt_one.trans hR)
      apply (div_lt_iff₀ (Real.log_pos hR)).mp
      rw [hlog]
      exact hsum
    have hdiagonalSupport (f : (Fin 40 → ℕ) → ℝ) (r : Fin 40 → ℕ)
        (hr : r ∈ (∑ s ∈ T, Finsupp.single s (f s / β ^ 40)).support) :
        r ∈ T ∧ f r ≠ 0 := by
      obtain ⟨s, hs, hsingle⟩ := Finsupp.mem_support_finsetSum r hr
      obtain ⟨rfl, hne⟩ := (Finsupp.mem_support_single r s (f s / β ^ 40)).mp hsingle
      exact ⟨hs, (div_ne_zero_iff.mp hne).1⟩
    have hdown {ι : Type} [Fintype ι] (e : ι → Fin 40) (L : ℝ)
        (d r : Fin 40 → ℕ) (hdr : ∀ j, d j ∣ r j)
        (hr : (∀ j, 0 < r j) ∧ ((∏ j, r (e j) : ℕ) : ℝ) < R ^ L) :
        (∀ j, 0 < d j) ∧ ((∏ j, d (e j) : ℕ) : ℝ) < R ^ L := by
      refine ⟨fun j => Nat.pos_of_dvd_of_pos (hdr j) (hr.1 j), ?_⟩
      have hp : (∏ j : ι, d (e j)) ≤ ∏ j : ι, r (e j) :=
        Finset.prod_le_prod' (f := fun j : ι => d (e j)) (g := fun j : ι => r (e j))
          (fun j _ => Nat.le_of_dvd (hr.1 (e j)) (hdr (e j)))
      exact (Nat.cast_le.mpr hp).trans_lt hr.2
    refine ⟨?_, ?_⟩
    · have hy : ∀ r ∈ y.support,
          (∀ j, 0 < r j) ∧ ((∏ j : Fin 40, r j : ℕ) : ℝ) < R ^ (98303 * h) := by
        intro r hr
        obtain ⟨hrT, hrU⟩ := hdiagonalSupport (fun s => U (X s)) r hr
        have hrq : ∀ j, r j ∈ q.divisors :=
          Fintype.mem_piFinset.mp (Finset.mem_filter.mp hrT).1
        change mask 40 98263 capO (X r) * amp (fun j => idx (X r j)) ≠ 0 at hrU
        have hrow := hmaskNonzero 40 98263 capO (X r) (mul_ne_zero_iff.mp hrU).1
        have hindicesEq : (fun j : Fin 40 => idx (X r j)) =
            (fun j : Fin 40 => trialCellIndex
              (primeLogConfiguration R (r j))) :=
          funext fun j => hidxConfig (primeLogConfiguration R (r j))
            (hArithSupport W R hR (r j) (hrq j))
        simp only [hindicesEq] at hrow
        refine ⟨fun j => Nat.pos_of_mem_divisors (hrq j), ?_⟩
        have hb := hcell (ι := Fin 40) r hrq 98263 hrow
        norm_num only [Fintype.card_fin, Nat.cast_ofNat] at hb
        exact hb
      intro d hd
      exact (selbergCoefficient_mem_hereditary y
        (fun r => (∀ j, 0 < r j) ∧
          ((∏ j : Fin 40, r j : ℕ) : ℝ) < R ^ (98303 * h))
        (hdown (fun j : Fin 40 => j) (98303 * h)) hy d hd).2
    · intro b i d hd
      have hz : ∀ r ∈ (z b i).support,
          (∀ j, 0 < r j) ∧
            ((∏ j : Fin 39, r (i.succAbove j) : ℕ) : ℝ) <
              R ^ (((stops b : ℝ) + 39) * h) := by
        intro r hr
        obtain ⟨hrT, hrF⟩ := hdiagonalSupport (fun s => F b i (X s)) r hr
        have hrq : ∀ j, r j ∈ q.divisors :=
          Fintype.mem_piFinset.mp (Finset.mem_filter.mp hrT).1
        have hrow : (∑ j : Fin 39, idx (X r (i.succAbove j))) ≤ stops b := by
          change mask 39 (stops b) (capF b) (fun j => X r (i.succAbove j)) *
            U (X r) ≠ 0 at hrF
          exact hmaskNonzero 39 (stops b) (capF b) (fun j => X r (i.succAbove j))
            (mul_ne_zero_iff.mp hrF).1
        have hindicesEq : (fun j : Fin 39 => idx (X r (i.succAbove j))) =
            (fun j : Fin 39 => trialCellIndex
              (primeLogConfiguration R (r (i.succAbove j)))) :=
          funext fun j => hidxConfig
            (primeLogConfiguration R (r (i.succAbove j)))
            (hArithSupport W R hR (r (i.succAbove j)) (hrq (i.succAbove j)))
        simp only [hindicesEq] at hrow
        refine ⟨fun j => Nat.pos_of_mem_divisors (hrq j), ?_⟩
        have hb := hcell (ι := Fin 39) (fun j : Fin 39 => r (i.succAbove j))
          (fun j => hrq (i.succAbove j)) (stops b) hrow
        simpa only [Fintype.card_fin, Nat.cast_ofNat] using hb
      have hd' := selbergCoefficient_mem_hereditary (z b i)
        (fun r => (∀ j, 0 < r j) ∧
          ((∏ j : Fin 39, r (i.succAbove j) : ℕ) : ℝ) <
            R ^ (((stops b : ℝ) + 39) * h))
        (hdown i.succAbove (((stops b : ℝ) + 39) * h)) hz (i.insertNth 1 d) hd
      simpa only [Fin.insertNth_apply_succAbove] using hd'.2
  refine ⟨hgridnull, U, F, hUmeas, ?_, ?_, ?_, ?_, ?_, hLawAgreement, hradius⟩
  · apply isBounded_iff_forall_norm_le.mpr
    refine ⟨M, ?_⟩
    rintro _ ⟨V, rfl⟩
    exact hUbound V
  · intro b i
    refine ⟨hFmeas b i, isBounded_iff_forall_norm_le.mpr ⟨M, ?_⟩⟩
    rintro _ ⟨V, rfl⟩
    exact hFbound b i V
  · intro V hV
    exact ⟨hUcont V hV, fun b i => hFcont b i V hV⟩
  · have hgood : ∀ᵐ V ∂Measure.pi (fun _ : Fin 40 => ν),
        ∀ i : Fin 40, ∀ n : ℕ, total (V i) ≠ (n : ℝ) * h := by
      rw [ae_iff]
      simpa only [not_forall, not_not, total] using hgridnull
    filter_upwards [hgood] with V hV
    exact ⟨hUcont V hV, fun b i => hFcont b i V hV⟩
  · intro W R hR q r hr
    exact hArith W R hR r hr

end

/--
The real-valued indicator of the outer admissibility conditions for `40` finite measures. It
checks the total-mass radius, absence of mass above the fixed cutoff, and that each active
ladder violation has zero count measure unless the corresponding outer-core bound already holds.
-/
noncomputable def physicalSourceOuterSupport
    (X : Fin 40 → FiniteMeasure ℝ) : ℝ := by
  classical
  exact
    let μ : Measure ℝ := ∑ i : Fin 40, (X i : Measure ℝ)
    let s : ℝ := ∑ i : Fin 40, ((X i).mass : ℝ)
    let N := physicalSourceCountMeasure X
    let ζ : ℝ := (((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ)
    if s ≤ (physicalSourceOuterRadius : ℝ) ∧ μ (Set.Ioi ζ) = 0 ∧
        ∀ (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)),
          let R := physicalSourceRow ν t.val
          s ≤ (R.outerCore : ℝ) ∨
            N {p : ℝ | (R.activation : ℝ) < p ∧
              (if R.order ≤ 2 then
                (R.outerThreshold : ℝ) < μ.real (Set.Ici p) + p
              else
                let L : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
                (R.outerThreshold : ℝ) <
                    μ.real (Set.Ici p) + min ((3 / 2) * p) L ∨
                  (R.innerThreshold : ℝ) < 3 * p - min ((3 / 2) * p) L)} = 0
    then 1 else 0

/--
The real-valued indicator of the inner admissibility conditions for `39` finite measures and
ladder `ν`. It checks the total-mass radius and cutoff, while each ladder row is accepted if its
order is one, its inner-core bound holds, or its violation set has zero count measure.
-/
noncomputable def physicalSourceInnerSupport
    (ν : Fin 2) (Y : Fin 39 → FiniteMeasure ℝ) : ℝ := by
  classical
  exact
    let μ : Measure ℝ := ∑ i : Fin 39, (Y i : Measure ℝ)
    let s : ℝ := ∑ i : Fin 39, ((Y i).mass : ℝ)
    let N := physicalSourceCountMeasure Y
    let ζ : ℝ := (((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ)
    if s ≤ (physicalSourceInnerRadius ν : ℝ) ∧ μ (Set.Ioi ζ) = 0 ∧
        ∀ t : Fin (if ν = 0 then 28 else 39),
          let R := physicalSourceRow ν t.val
          R.order = 1 ∨ s ≤ (R.innerCore : ℝ) ∨
            N {p : ℝ | (R.activation : ℝ) < p ∧
              (if R.order ≤ 2 then
                (R.innerThreshold : ℝ) < μ.real (Set.Ici p) + p
              else
                let L : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
                (R.innerThreshold : ℝ) <
                    μ.real (Set.Ici p) + (3 * p - min ((3 / 2) * p) L) ∨
                  (R.outerThreshold : ℝ) < min ((3 / 2) * p) L)} = 0
    then 1 else 0

/-- The trial step function restricted by the outer physical-source admissibility indicator. -/
noncomputable def trialSourceStepFunction
    (X : Fin 40 → FiniteMeasure ℝ) : ℝ :=
  physicalSourceOuterSupport X * trialStepFunction X

/--
The signed three-mask face multiplier with the fixed rational coefficients. The base term
requires both inner-support conditions, the enlarged term requires the second, and the full-mask
correction has a negative coefficient.
-/
noncomputable def physicalSourceFaceMultiplier
    (Y : Fin 39 → FiniteMeasure ℝ) : ℝ :=
  (44415113 / 5000000000 : ℝ) * trialBaseMask Y *
      physicalSourceInnerSupport 0 Y * physicalSourceInnerSupport 1 Y +
    (2479900401 / 2500000000 : ℝ) * trialEnlargedMask Y *
      physicalSourceInnerSupport 1 Y +
    (-843183 / 1000000000 : ℝ) * trialFullMask Y

theorem physicalSourceCountMeasure_finite_tail
    (d : ℕ) (δ : ℝ) (hδ : 0 < δ)
    (Y : Fin d → FiniteMeasure ℝ) (n : Fin d → ℕ)
    (x : (i : Fin d) → Fin (n i) → ℝ)
    (hY : ∀ i, (Y i).restrict (Set.Ioc (0 : ℝ) δ) = Y i)
    (hx : ∀ i a, δ < x i a) :
    (physicalSourceCountMeasure
      (fun i => Y i + weightedEmpirical (n i) (x i))).restrict
        (Set.Ioi δ) =
      ∑ i : Fin d, ∑ a : Fin (n i), Measure.dirac (x i a) := by
  classical
  have hlow (i : Fin d) : (Y i : Measure ℝ).restrict (Set.Ioi δ) = 0 := by
    have hi := congrArg (fun μ : FiniteMeasure ℝ => (μ : Measure ℝ)) (hY i)
    change (Y i : Measure ℝ).restrict (Set.Ioc (0 : ℝ) δ) = (Y i : Measure ℝ) at hi
    rw [← hi, Measure.restrict_restrict measurableSet_Ioi,
      Set.disjoint_iff_inter_eq_empty.mp Set.Ioc_disjoint_Ioi_same.symm,
      Measure.restrict_empty]
  have htail (i : Fin d) :
      ((Y i + weightedEmpirical (n i) (x i) :
          FiniteMeasure ℝ) : Measure ℝ).restrict (Set.Ioi δ) =
        ∑ a : Fin (n i), ENNReal.ofReal (x i a) • Measure.dirac (x i a) := by
    rw [FiniteMeasure.toMeasure_add, Measure.restrict_add, hlow i, zero_add,
      coe_weightedEmpirical]
    conv_lhs =>
      rw [← Measure.sum_fintype, Measure.restrict_sum _ measurableSet_Ioi,
        Measure.sum_fintype]
    apply Finset.sum_congr rfl
    intro a _ha
    simp only [Measure.restrict_smul, restrict_dirac, Set.mem_Ioi,
      hx i a, ↓reduceIte]
  dsimp only [physicalSourceCountMeasure]
  rw [restrict_withDensity measurableSet_Ioi,
    Measure.restrict_restrict_of_subset (Set.Ioi_subset_Ioi hδ.le)]
  conv_lhs =>
    rw [← Measure.sum_fintype, Measure.restrict_sum _ measurableSet_Ioi,
      withDensity_sum, Measure.sum_fintype]
  apply Finset.sum_congr rfl
  intro i _hi
  rw [htail i]
  conv_lhs => rw [← Measure.sum_fintype, withDensity_sum, Measure.sum_fintype]
  apply Finset.sum_congr rfl
  intro a _ha
  have hpos : 0 < x i a := hδ.trans (hx i a)
  rw [withDensity_smul_measure, dirac_withDensity, smul_smul,
    ← ENNReal.ofReal_mul hpos.le, mul_inv_cancel₀ hpos.ne',
    ENNReal.ofReal_one, one_smul]

theorem physicalSourceSupport_measurable :
    Measurable physicalSourceOuterSupport ∧
      ∀ ν : Fin 2, Measurable (physicalSourceInnerSupport ν) := by
  classical
  have hhQ : (0 : ℚ) < trialMesh := trial_fixed_positive_data.2.1
  have hh : (0 : ℝ) < (trialMesh : ℝ) := by exact_mod_cast hhQ
  have hactivation (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)) :
      (trialMesh : ℝ) < ((physicalSourceRow ν t.val).activation : ℝ) := by
    let k : ℕ := (if ν = 0 then 28 else 39) - 1
    have ht : t.val < physicalSourceLadderLength ν - 1 := by
      have ht' := t.isLt
      fin_cases ν <;> norm_num [physicalSourceLadderLength] at ht' ⊢ <;> omega
    have hk : k < physicalSourceLadderLength ν - 1 := by
      dsimp only [k]
      fin_cases ν <;> decide
    have htk : t.val ≤ k := by
      have ht' := t.isLt
      dsimp only [k]
      omega
    have hmono := (physicalSource_first_hit_and_monotone ν).2.1
    have hprefix : physicalSourceOmegaPrefix ν t.val ≤ physicalSourceOmegaPrefix ν k :=
      hmono.monotone
        (show (⟨t.val, by omega⟩ : Fin (physicalSourceLadderLength ν + 1)) ≤
          ⟨k, by omega⟩ from htk)
    have hslack := (physicalSource_retained_thresholds ν).1 ⟨t.val, ht⟩
    have hlastSlack := (physicalSource_retained_thresholds ν).1 ⟨k, hk⟩
    have hρ : (0 : ℚ) < physicalSourceRho := by norm_num [physicalSourceRho]
    have hlast : (2 : ℚ) * trialMesh < (physicalSourceRow ν k).activation := by
      dsimp only [k]
      fin_cases ν <;> decide +kernel
    have hcompare : (physicalSourceRow ν k).activation ≤
        (physicalSourceRow ν t.val).activation := by
      apply (mul_le_mul_iff_right₀ hρ).mp
      linarith only [hslack, hlastSlack, hprefix]
    have htwo := hlast.trans_le hcompare
    have hcutoff : trialMesh < (physicalSourceRow ν t.val).activation := by
      linarith only [hhQ, htwo]
    exact_mod_cast hcutoff
  let μ (d : ℕ) (X : Fin d → FiniteMeasure ℝ) : Measure ℝ :=
    ∑ i : Fin d, (X i : Measure ℝ)
  let s (d : ℕ) (X : Fin d → FiniteMeasure ℝ) : ℝ :=
    ∑ i : Fin d, ((X i).mass : ℝ)
  have hμ (d : ℕ) : Measurable (μ d) :=
    Finset.measurable_fun_sum Finset.univ fun i _ =>
      measurable_subtype_coe.comp (measurable_pi_apply i)
  have hs (d : ℕ) : Measurable (s d) :=
    Finset.measurable_sum Finset.univ fun i _ =>
      ((Measure.measurable_coe MeasurableSet.univ).comp
        (measurable_subtype_coe.comp (measurable_pi_apply i))).ennreal_toReal
  have htail (d : ℕ) : Measurable
      (fun z : (Fin d → FiniteMeasure ℝ) × ℝ => (μ d z.1).real (Set.Ici z.2)) := by
    let η : ProbabilityTheory.Kernel ((Fin d → FiniteMeasure ℝ) × ℝ) ℝ :=
      ⟨fun z => μ d z.1, (hμ d).comp measurable_fst⟩
    have hη (z : (Fin d → FiniteMeasure ℝ) × ℝ) : IsFiniteMeasure (η z) := by
      change IsFiniteMeasure (∑ i : Fin d, (z.1 i : Measure ℝ))
      infer_instance
    exact (ProbabilityTheory.Kernel.measurable_kernel_prodMk_left_of_finite
      (κ := η) (measurableSet_le measurable_fst.snd measurable_snd) hη).ennreal_toReal
  have hcount (d : ℕ) (E : Set ((Fin d → FiniteMeasure ℝ) × ℝ))
      (hE : MeasurableSet E)
      (hsub : ∀ X, Prod.mk X ⁻¹' E ⊆ Set.Ioi (trialMesh : ℝ)) :
      Measurable (fun X : Fin d → FiniteMeasure ℝ =>
        physicalSourceCountMeasure X (Prod.mk X ⁻¹' E)) := by
    have hregular := physicalSourceCountMeasure_regular d
    let N : ProbabilityTheory.Kernel (Fin d → FiniteMeasure ℝ) ℝ :=
      ⟨physicalSourceCountMeasure, hregular.1⟩
    let κ : ProbabilityTheory.Kernel (Fin d → FiniteMeasure ℝ) ℝ :=
      N.restrict (s := Set.Ioi (trialMesh : ℝ)) measurableSet_Ioi
    have hκ (X : Fin d → FiniteMeasure ℝ) : IsFiniteMeasure (κ X) :=
      (hregular.2 (trialMesh : ℝ) hh X).1
    have hm := ProbabilityTheory.Kernel.measurable_kernel_prodMk_left_of_finite
      (κ := κ) hE hκ
    have heq (X : Fin d → FiniteMeasure ℝ) :
        κ X (Prod.mk X ⁻¹' E) = physicalSourceCountMeasure X (Prod.mk X ⁻¹' E) :=
      Measure.restrict_eq_self _ (hsub X)
    exact (funext heq) ▸ hm
  have houter (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)) :
      Measurable (fun X : Fin 40 → FiniteMeasure ℝ =>
        let R := physicalSourceRow ν t.val
        physicalSourceCountMeasure X {p : ℝ | (R.activation : ℝ) < p ∧
          (if R.order ≤ 2 then
            (R.outerThreshold : ℝ) < (μ 40 X).real (Set.Ici p) + p
          else
            let L : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
            (R.outerThreshold : ℝ) <
                (μ 40 X).real (Set.Ici p) + min ((3 / 2) * p) L ∨
              (R.innerThreshold : ℝ) < 3 * p - min ((3 / 2) * p) L)}) := by
    let R := physicalSourceRow ν t.val
    apply hcount 40 {z | (R.activation : ℝ) < z.2 ∧
      (if R.order ≤ 2 then
        (R.outerThreshold : ℝ) < (μ 40 z.1).real (Set.Ici z.2) + z.2
      else
        let L : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
        (R.outerThreshold : ℝ) <
            (μ 40 z.1).real (Set.Ici z.2) + min ((3 / 2) * z.2) L ∨
          (R.innerThreshold : ℝ) < 3 * z.2 - min ((3 / 2) * z.2) L)}
    · refine (measurableSet_lt measurable_const measurable_snd).inter ?_
      cases hdecision : Nat.decLe R.order 2 with
      | isTrue _ =>
        exact measurableSet_lt measurable_const ((htail 40).add measurable_snd)
      | isFalse _ =>
        have hD : Measurable (fun z : (Fin 40 → FiniteMeasure ℝ) × ℝ =>
            min ((3 / 2) * z.2) ((23 / 40) * (R.innerThreshold : ℝ))) := by fun_prop
        have hE : Measurable (fun z : (Fin 40 → FiniteMeasure ℝ) × ℝ =>
            3 * z.2 - min ((3 / 2) * z.2) ((23 / 40) * (R.innerThreshold : ℝ))) :=
          (measurable_const.mul measurable_snd).sub hD
        exact (measurableSet_lt measurable_const ((htail 40).add hD)).union
          (measurableSet_lt measurable_const hE)
    · intro X p hp
      exact (hactivation ν t).trans hp.1
  have hinner (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)) :
      Measurable (fun X : Fin 39 → FiniteMeasure ℝ =>
        let R := physicalSourceRow ν t.val
        physicalSourceCountMeasure X {p : ℝ | (R.activation : ℝ) < p ∧
          (if R.order ≤ 2 then
            (R.innerThreshold : ℝ) < (μ 39 X).real (Set.Ici p) + p
          else
            let L : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
            (R.innerThreshold : ℝ) <
                (μ 39 X).real (Set.Ici p) + (3 * p - min ((3 / 2) * p) L) ∨
              (R.outerThreshold : ℝ) < min ((3 / 2) * p) L)}) := by
    let R := physicalSourceRow ν t.val
    apply hcount 39 {z | (R.activation : ℝ) < z.2 ∧
      (if R.order ≤ 2 then
        (R.innerThreshold : ℝ) < (μ 39 z.1).real (Set.Ici z.2) + z.2
      else
        let L : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
        (R.innerThreshold : ℝ) <
            (μ 39 z.1).real (Set.Ici z.2) + (3 * z.2 - min ((3 / 2) * z.2) L) ∨
          (R.outerThreshold : ℝ) < min ((3 / 2) * z.2) L)}
    · refine (measurableSet_lt measurable_const measurable_snd).inter ?_
      cases hdecision : Nat.decLe R.order 2 with
      | isTrue _ =>
        exact measurableSet_lt measurable_const ((htail 39).add measurable_snd)
      | isFalse _ =>
        have hD : Measurable (fun z : (Fin 39 → FiniteMeasure ℝ) × ℝ =>
            min ((3 / 2) * z.2) ((23 / 40) * (R.innerThreshold : ℝ))) := by fun_prop
        have hE : Measurable (fun z : (Fin 39 → FiniteMeasure ℝ) × ℝ =>
            3 * z.2 - min ((3 / 2) * z.2) ((23 / 40) * (R.innerThreshold : ℝ))) :=
          (measurable_const.mul measurable_snd).sub hD
        exact (measurableSet_lt measurable_const ((htail 39).add hE)).union
          (measurableSet_lt measurable_const hD)
    · intro X p hp
      exact (hactivation ν t).trans hp.1
  constructor
  · apply Measurable.ite ?_ measurable_const measurable_const
    refine (measurableSet_le (hs 40) measurable_const).inter
      ((measurableSet_eq_fun
        ((Measure.measurable_coe measurableSet_Ioi).comp (hμ 40)) measurable_const).inter ?_)
    change MeasurableSet (Set.ofPred _)
    simp only [Set.ofPred_forall]
    exact MeasurableSet.iInter fun ν => MeasurableSet.iInter fun t =>
      (measurableSet_le (hs 40) measurable_const).union
        (measurableSet_eq_fun (houter ν t) measurable_const)
  · intro ν
    apply Measurable.ite ?_ measurable_const measurable_const
    refine (measurableSet_le (hs 39) measurable_const).inter
      ((measurableSet_eq_fun
        ((Measure.measurable_coe measurableSet_Ioi).comp (hμ 39)) measurable_const).inter ?_)
    change MeasurableSet (Set.ofPred _)
    simp only [Set.ofPred_forall]
    exact MeasurableSet.iInter fun t => (MeasurableSet.const _).union
      ((measurableSet_le (hs 39) measurable_const).union
        (measurableSet_eq_fun (hinner ν t) measurable_const))

theorem physicalSource_cover_fixed_geometry :
    (∀ (g : Fin 6),
      let G := physicalSourceGroup g
      2 * trialMesh < G.activation ∧
        G.activation < G.split ∧
        G.split ≤ G.cap ∧
        0 < G.order ∧
        G.cap + G.order * G.split ≤ G.threshold ∧
        G.split < G.threshold / (G.order + 1) ∧
        G.threshold / (G.order + 1) < G.cap ∧
        G.lowerRadius < G.upperRadius ∧
        G.dimension = (if g.val < 2 then 40 else 39) ∧
        (((![89196, 95598, 84930, 87194, 85161, 87249] : Fin 6 → ℕ) g +
          G.dimension : ℕ) : ℚ) * trialMesh ≤ G.lowerRadius) ∧
    (∀ (k : Fin 3),
      let ge : Fin 6 := ⟨2 * k.val, by omega⟩
      let go : Fin 6 := ⟨2 * k.val + 1, by omega⟩
      let E := physicalSourceGroup ge
      let O := physicalSourceGroup go
      E.upperRadius = O.lowerRadius ∧
        O.activation ≤ E.activation ∧
        O.threshold ≤ E.threshold ∧
        E.order = 2 ∧ O.order = 5 / 2 ∧
        O.cap ≤ E.cap) ∧
    (∀ (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)),
      let R := physicalSourceRow ν t.val
      let go : Fin 6 := if R.order ≤ 2 then 0 else 1
      let gi : Fin 6 :=
        if ν = 0 then (if R.order ≤ 2 then 2 else 3)
        else (if R.order ≤ 2 then 4 else 5)
      let A := R.outerThreshold
      let C := R.innerThreshold
      let L := 23 * C / 40
      0 < A ∧ 0 < C ∧
        2 * trialMesh < R.activation ∧
        (physicalSourceGroup go).activation ≤ R.activation ∧
        (physicalSourceGroup go).lowerRadius ≤ R.outerCore ∧
        (ν, t.val) ∈ physicalSourceRows go ∧
        (if R.order ≤ 2 then 2 * (physicalSourceGroup go).cap ≤ A
        else
          (physicalSourceGroup go).cap +
              min (3 * (physicalSourceGroup go).cap / 2) L ≤ A ∧
            3 * (physicalSourceGroup go).cap -
              min (3 * (physicalSourceGroup go).cap / 2) L ≤ C) ∧
        (R.order ≠ 1 →
          (physicalSourceGroup gi).activation ≤ R.activation ∧
            (physicalSourceGroup gi).lowerRadius ≤ R.innerCore ∧
            (ν, t.val) ∈ physicalSourceRows gi ∧
            (if R.order ≤ 2 then 2 * (physicalSourceGroup gi).cap ≤ C
            else
              (physicalSourceGroup gi).cap +
                  (3 * (physicalSourceGroup gi).cap -
                    min (3 * (physicalSourceGroup gi).cap / 2) L) ≤ C ∧
                min (3 * (physicalSourceGroup gi).cap / 2) L ≤ A))) := by
  classical
  refine ⟨?_, ?_, ?_⟩
  · intro g G
    fin_cases g <;> decide +kernel
  · intro k ge go E O
    fin_cases k <;> decide +kernel
  · intro ν t R go gi A C L
    have hgeometry :
        2 * trialMesh < R.activation ∧
          (physicalSourceGroup go).activation ≤ R.activation ∧
          (physicalSourceGroup go).lowerRadius ≤ R.outerCore ∧
          (ν, t.val) ∈ physicalSourceRows go ∧
          (R.order ≠ 1 →
            (physicalSourceGroup gi).activation ≤ R.activation ∧
              (physicalSourceGroup gi).lowerRadius ≤ R.innerCore ∧
              (ν, t.val) ∈ physicalSourceRows gi) := by
      dsimp only [R, go, gi]
      fin_cases ν <;> fin_cases t <;> decide +kernel
    have hthresholds := (physicalSource_retained_thresholds ν).2 t
    change
      A = physicalSourceOuterRadius +
          (if R.order ≤ 2 then physicalSourceAdvance else physicalSourceAdvance / 2) ∧
        C = physicalSourceInnerRadius ν +
          (if R.order ≤ 2 then physicalSourceAdvance else physicalSourceAdvance / 2)
      at hthresholds
    have hcaps :
        0 < A ∧ 0 < C ∧
          (if R.order ≤ 2 then 2 * (physicalSourceGroup go).cap ≤ A
          else
            (physicalSourceGroup go).cap +
                min (3 * (physicalSourceGroup go).cap / 2) L ≤ A ∧
              3 * (physicalSourceGroup go).cap -
                min (3 * (physicalSourceGroup go).cap / 2) L ≤ C) ∧
          (if R.order ≤ 2 then 2 * (physicalSourceGroup gi).cap ≤ C
          else
            (physicalSourceGroup gi).cap +
                (3 * (physicalSourceGroup gi).cap -
                  min (3 * (physicalSourceGroup gi).cap / 2) L) ≤ C ∧
              min (3 * (physicalSourceGroup gi).cap / 2) L ≤ A) := by
      dsimp only [go, gi, L]
      rw [hthresholds.1, hthresholds.2]
      by_cases horder : R.order ≤ 2 <;>
        simp only [horder, ↓reduceIte] <;> fin_cases ν <;> decide +kernel
    rcases hgeometry with ⟨hsmall, hactivation, hcore, hmem, hinner⟩
    rcases hcaps with ⟨hA, hC, houterCap, hinnerCap⟩
    refine ⟨hA, hC, hsmall, hactivation, hcore, hmem, houterCap, ?_⟩
    intro horder
    exact ⟨(hinner horder).1, (hinner horder).2.1,
      (hinner horder).2.2, hinnerCap⟩

theorem physicalSource_cover_interval_partition :
    (∀ (g : Fin 6) (p : ℝ)
      (_ : ((physicalSourceGroup g).activation : ℝ) < p)
      (_ : p ≤ ((physicalSourceGroup g).split : ℝ)),
      ∃ j : ℕ, j < physicalSourceLowCount g ∧
        p ∈ Set.Ioc ((physicalSourceComponentEndpoints g j).1 : ℝ)
          ((physicalSourceComponentEndpoints g j).2 : ℝ)) ∧
    (∀ (g : Fin 6) (q : ℝ)
      (_ : ((physicalSourceGroup g).threshold : ℝ) /
        (((physicalSourceGroup g).order : ℝ) + 1) < q)
      (_ : q ≤ ((physicalSourceGroup g).cap : ℝ)),
      ∃ j : ℕ, j < physicalSourceRowCount g ∧
        physicalSourceComponentKind g j = 1 ∧
          q ∈ Set.Ioc ((physicalSourceComponentEndpoints g j).1 : ℝ)
            ((physicalSourceComponentEndpoints g j).2 : ℝ)) ∧
    (∀ (g : Fin 6) (j : ℕ) (_ : j < physicalSourceRowCount g)
      (_ : physicalSourceComponentKind g j = 1),
      ((physicalSourceGroup g).threshold : ℝ) /
          (((physicalSourceGroup g).order : ℝ) + 1) ≤
        ((physicalSourceComponentEndpoints g j).1 : ℝ)) ∧
    (∀ (g : Fin 6) (j : ℕ) (_ : j < physicalSourceRowCount g)
      (_ : physicalSourceComponentKind g j < 2),
      (trialMesh : ℝ) < ((physicalSourceComponentEndpoints g j).1 : ℝ)) := by
  classical
  have hgroup := physicalSource_cover_fixed_geometry.1
  have hlowEndpoints (g : Fin 6) :
      0 < physicalSourceLowCount g ∧
        (physicalSourceLowBoundaries g).getD 0 0 =
          (physicalSourceGroup g).activation ∧
        (physicalSourceLowBoundaries g).getD (physicalSourceLowCount g) 0 =
          (physicalSourceGroup g).split := by
    fin_cases g <;> exact ⟨by decide, rfl, rfl⟩
  have hrankEndpoints (g : Fin 6) :
      0 < physicalSourceRankCount g ∧
        (physicalSourceRankFractions g).getD 0 0 = 0 ∧
        (physicalSourceRankFractions g).getD (physicalSourceRankCount g) 0 = 1 := by
    fin_cases g <;> exact ⟨by decide, rfl, rfl⟩
  have hlowBand (g : Fin 6) (p : ℝ)
      (hp : ((physicalSourceGroup g).activation : ℝ) < p)
      (hps : p ≤ ((physicalSourceGroup g).split : ℝ)) :
      ∃ j : ℕ, j < physicalSourceLowCount g ∧
        p ∈ Set.Ioc ((physicalSourceComponentEndpoints g j).1 : ℝ)
          ((physicalSourceComponentEndpoints g j).2 : ℝ) := by
    let a : ℕ → ℝ := fun j => ((physicalSourceLowBoundaries g).getD j 0 : ℝ)
    have hstart : a 0 = ((physicalSourceGroup g).activation : ℝ) := by
      dsimp only [a]
      rw [(hlowEndpoints g).2.1]
    have hend : a (physicalSourceLowCount g) =
        ((physicalSourceGroup g).split : ℝ) := by
      dsimp only [a]
      rw [(hlowEndpoints g).2.2]
    have hp' : p ∈ Set.Ioc (a 0) (a (physicalSourceLowCount g)) := by
      rw [hstart, hend]
      exact ⟨hp, hps⟩
    rcases Set.mem_iUnion₂.mp
      (Ioc_subset_biUnion_Ioc (physicalSourceLowCount g) a hp') with ⟨j, hj, hpj⟩
    have hj' : j < physicalSourceLowCount g := Finset.mem_range.mp hj
    have hk : physicalSourceComponentKind g j = 0 := by
      simp only [physicalSourceComponentKind, hj', ↓reduceIte]
    refine ⟨j, hj', ?_⟩
    simpa only [physicalSourceComponentEndpoints, hk, ↓reduceIte, a] using hpj
  have hrankBand (g : Fin 6) (q : ℝ)
      (hq : ((physicalSourceGroup g).threshold : ℝ) /
        (((physicalSourceGroup g).order : ℝ) + 1) < q)
      (hqc : q ≤ ((physicalSourceGroup g).cap : ℝ)) :
      ∃ j : ℕ, j < physicalSourceRowCount g ∧
        physicalSourceComponentKind g j = 1 ∧
          q ∈ Set.Ioc ((physicalSourceComponentEndpoints g j).1 : ℝ)
            ((physicalSourceComponentEndpoints g j).2 : ℝ) := by
    let a : ℕ → ℝ := fun k =>
      ((physicalSourceGroup g).threshold : ℝ) /
          (((physicalSourceGroup g).order : ℝ) + 1) +
        ((physicalSourceRankFractions g).getD k 0 : ℝ) *
          (((physicalSourceGroup g).cap : ℝ) -
            ((physicalSourceGroup g).threshold : ℝ) /
              (((physicalSourceGroup g).order : ℝ) + 1))
    have hstart : a 0 = ((physicalSourceGroup g).threshold : ℝ) /
        (((physicalSourceGroup g).order : ℝ) + 1) := by
      dsimp only [a]
      rw [(hrankEndpoints g).2.1]
      simp only [Rat.cast_zero, zero_mul, add_zero]
    have hend : a (physicalSourceRankCount g) =
        ((physicalSourceGroup g).cap : ℝ) := by
      dsimp only [a]
      rw [(hrankEndpoints g).2.2]
      simp only [Rat.cast_one, one_mul]
      ring
    have hq' : q ∈ Set.Ioc (a 0) (a (physicalSourceRankCount g)) := by
      rw [hstart, hend]
      exact ⟨hq, hqc⟩
    rcases Set.mem_iUnion₂.mp
      (Ioc_subset_biUnion_Ioc (physicalSourceRankCount g) a hq') with ⟨k, hk, hqk⟩
    have hk' : k < physicalSourceRankCount g := Finset.mem_range.mp hk
    let j := physicalSourceLowCount g + k
    have hj : j < physicalSourceRowCount g := by
      dsimp only [j, physicalSourceRowCount]
      omega
    have hjlow : ¬j < physicalSourceLowCount g := by dsimp only [j]; omega
    have hjhigh : j < physicalSourceLowCount g + physicalSourceRankCount g := by
      dsimp only [j]
      omega
    have hkind : physicalSourceComponentKind g j = 1 := by
      simp only [physicalSourceComponentKind, hjlow, hjhigh, ↓reduceIte]
    have hendpoints :
        ((physicalSourceComponentEndpoints g j).1 : ℝ) = a k ∧
          ((physicalSourceComponentEndpoints g j).2 : ℝ) = a (k + 1) := by
      simp only [physicalSourceComponentEndpoints, hkind, one_ne_zero, ↓reduceIte,
        j, Nat.add_sub_cancel_left, a, Rat.cast_add, Rat.cast_sub, Rat.cast_mul,
        Rat.cast_div, Rat.cast_one, and_self]
    refine ⟨j, hj, hkind, ?_⟩
    simpa only [hendpoints.1, hendpoints.2] using hqk
  have hrankLower (g : Fin 6) (j : ℕ) (_hj : j < physicalSourceRowCount g)
      (hk : physicalSourceComponentKind g j = 1) :
      ((physicalSourceGroup g).threshold : ℝ) /
          (((physicalSourceGroup g).order : ℝ) + 1) ≤
        ((physicalSourceComponentEndpoints g j).1 : ℝ) := by
    have hindices : physicalSourceLowCount g ≤ j ∧
        j < physicalSourceLowCount g + physicalSourceRankCount g := by
      unfold physicalSourceComponentKind at hk
      split_ifs at hk <;> omega
    have hlength : j - physicalSourceLowCount g <
        (physicalSourceRankFractions g).length := by
      dsimp only [physicalSourceRankCount] at hindices
      omega
    have hfractions : ∀ v ∈ physicalSourceRankFractions g, (0 : ℚ) ≤ v := by
      fin_cases g <;> norm_num [physicalSourceRankFractions]
    have hmem : (physicalSourceRankFractions g).getD
        (j - physicalSourceLowCount g) 0 ∈ physicalSourceRankFractions g :=
      List.mem_of_getElem ((physicalSourceRankFractions g).getD_eq_getElem 0 hlength).symm
    obtain ⟨_, _, _, _, _, _, hqcap, _, _, _⟩ := hgroup g
    have hrat : (physicalSourceGroup g).threshold /
        ((physicalSourceGroup g).order + 1) ≤
          (physicalSourceComponentEndpoints g j).1 := by
      have hnonneg := mul_nonneg (hfractions _ hmem) (sub_nonneg.mpr hqcap.le)
      simpa only [physicalSourceComponentEndpoints, hk, one_ne_zero, ↓reduceIte] using
        (le_add_of_nonneg_right hnonneg :
          (physicalSourceGroup g).threshold / ((physicalSourceGroup g).order + 1) ≤ _)
    exact_mod_cast hrat
  have hcomponentLower (g : Fin 6) (j : ℕ) (hj : j < physicalSourceRowCount g)
      (hk : physicalSourceComponentKind g j < 2) :
      (trialMesh : ℝ) < ((physicalSourceComponentEndpoints g j).1 : ℝ) := by
    by_cases hlow : j < physicalSourceLowCount g
    · have hvalues : ∀ v ∈ physicalSourceLowBoundaries g, trialMesh < v := by
        have hlist : List.Forall (fun v : ℚ => trialMesh < v)
            (physicalSourceLowBoundaries g) := by
          fin_cases g <;> decide +kernel
        exact List.forall_iff_forall_mem.mp hlist
      have hlength : j < (physicalSourceLowBoundaries g).length := by
        dsimp only [physicalSourceLowCount] at hlow
        omega
      have hmem : (physicalSourceLowBoundaries g).getD j 0 ∈
          physicalSourceLowBoundaries g :=
        List.mem_of_getElem ((physicalSourceLowBoundaries g).getD_eq_getElem 0 hlength).symm
      have hkind : physicalSourceComponentKind g j = 0 := by
        simp only [physicalSourceComponentKind, hlow, ↓reduceIte]
      have hrat : trialMesh < (physicalSourceComponentEndpoints g j).1 := by
        simpa only [physicalSourceComponentEndpoints, hkind, ↓reduceIte] using
          hvalues _ hmem
      exact_mod_cast hrat
    · have hhigh : j < physicalSourceLowCount g + physicalSourceRankCount g := by
        by_contra hnot
        simp only [physicalSourceComponentKind, hlow, hnot, ↓reduceIte] at hk
        omega
      have hkind : physicalSourceComponentKind g j = 1 := by
        simp only [physicalSourceComponentKind, hlow, hhigh, ↓reduceIte]
      obtain ⟨hsmall, hactivation, _, _, _, hsplit, _, _, _, _⟩ := hgroup g
      have hrat : trialMesh < (physicalSourceGroup g).threshold /
          ((physicalSourceGroup g).order + 1) := by
        linarith only [trial_fixed_positive_data.2.1, hsmall, hactivation, hsplit]
      have hreal : (trialMesh : ℝ) < ((physicalSourceGroup g).threshold : ℝ) /
          (((physicalSourceGroup g).order : ℝ) + 1) := by exact_mod_cast hrat
      exact hreal.trans_le (hrankLower g j hj hkind)
  exact ⟨hlowBand, hrankBand, hrankLower, hcomponentLower⟩

theorem physicalSource_balanced_failure_of_offender {ι : Type} [Fintype ι]
    (f : ι → ℝ) (a : ι) (k : Fin 3) (R : PhysicalSourceRowData) (cap : ℝ)
    (hpositive : ∀ b, 0 < f b) (hcap : f a ≤ cap)
    (hC : 0 < (R.innerThreshold : ℝ))
    (hcapOwner :
      let L : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
      if k = 0 then
        if R.order ≤ 2 then 2 * cap ≤ (R.outerThreshold : ℝ)
        else cap + min ((3 / 2) * cap) L ≤ (R.outerThreshold : ℝ) ∧
          3 * cap - min ((3 / 2) * cap) L ≤ (R.innerThreshold : ℝ)
      else
        if R.order ≤ 2 then 2 * cap ≤ (R.innerThreshold : ℝ)
        else cap + (3 * cap - min ((3 / 2) * cap) L) ≤
            (R.innerThreshold : ℝ) ∧
          min ((3 / 2) * cap) L ≤ (R.outerThreshold : ℝ))
    (hfailure :
      let p := f a
      let tail := ∑ b ∈ Finset.univ.filter (fun b : ι => p ≤ f b), f b
      let L : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
      if k = 0 then
        if R.order ≤ 2 then (R.outerThreshold : ℝ) < tail + p
        else (R.outerThreshold : ℝ) < tail + min ((3 / 2) * p) L ∨
          (R.innerThreshold : ℝ) < 3 * p - min ((3 / 2) * p) L
      else
        if R.order ≤ 2 then (R.innerThreshold : ℝ) < tail + p
        else (R.innerThreshold : ℝ) < tail + (3 * p - min ((3 / 2) * p) L) ∨
          (R.outerThreshold : ℝ) < min ((3 / 2) * p) L) :
    2 ≤ (Finset.univ.filter (fun b : ι => f a ≤ f b)).card ∧
      ((if k = 0 then R.outerThreshold else R.innerThreshold : ℚ) : ℝ) <
        (∑ b ∈ Finset.univ.filter (fun b : ι => f a ≤ f b), f b) +
          (((if R.order ≤ 2 then 2 else 5 / 2 : ℚ) : ℝ) - 1) * f a := by
  classical
  let p := f a
  let I : Finset ι := Finset.univ.filter (fun b : ι => p ≤ f b)
  let tail : ℝ := ∑ b ∈ I, f b
  let L : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
  have ha : a ∈ I := Finset.mem_filter.mpr ⟨Finset.mem_univ a, le_rfl⟩
  have hp : 0 < p := hpositive a
  have hD : min ((3 / 2) * p) L ≤ min ((3 / 2) * cap) L :=
    min_le_min_right L (mul_le_mul_of_nonneg_left hcap (by norm_num))
  have hE : 3 * p - min ((3 / 2) * p) L ≤
      3 * cap - min ((3 / 2) * cap) L := by
    rw [← max_sub_sub_left, ← max_sub_sub_left]
    apply max_le_max <;> linarith only [hcap]
  have hcapAtP :
      if k = 0 then
        if R.order ≤ 2 then 2 * p ≤ (R.outerThreshold : ℝ)
        else p + min ((3 / 2) * p) L ≤ (R.outerThreshold : ℝ) ∧
          3 * p - min ((3 / 2) * p) L ≤ (R.innerThreshold : ℝ)
      else
        if R.order ≤ 2 then 2 * p ≤ (R.innerThreshold : ℝ)
        else p + (3 * p - min ((3 / 2) * p) L) ≤
            (R.innerThreshold : ℝ) ∧
          min ((3 / 2) * p) L ≤ (R.outerThreshold : ℝ) := by
    by_cases hk : k = 0 <;> by_cases ho : R.order ≤ 2 <;>
      simp only [hk, ho, ↓reduceIte] at hcapOwner ⊢
    · linarith only [hcap, hcapOwner]
    · exact ⟨(add_le_add hcap hD).trans hcapOwner.1, hE.trans hcapOwner.2⟩
    · linarith only [hcap, hcapOwner]
    · exact ⟨(add_le_add hcap hE).trans hcapOwner.1, hD.trans hcapOwner.2⟩
  have htwo : 2 ≤ I.card := by
    by_contra hsmall
    have hI : I = {a} := Finset.eq_singleton_iff_unique_mem.mpr
      ⟨ha, fun b hb => Finset.card_le_one.mp (by omega) b hb a ha⟩
    have htail : tail = p := by simp only [tail, hI, Finset.sum_singleton, p]
    change (if k = 0 then
      if R.order ≤ 2 then (R.outerThreshold : ℝ) < tail + p
      else (R.outerThreshold : ℝ) < tail + min ((3 / 2) * p) L ∨
        (R.innerThreshold : ℝ) < 3 * p - min ((3 / 2) * p) L
      else if R.order ≤ 2 then (R.innerThreshold : ℝ) < tail + p
      else (R.innerThreshold : ℝ) < tail + (3 * p - min ((3 / 2) * p) L) ∨
        (R.outerThreshold : ℝ) < min ((3 / 2) * p) L) at hfailure
    rw [htail] at hfailure
    by_cases hk : k = 0 <;> by_cases ho : R.order ≤ 2 <;>
      simp only [hk, ho, ↓reduceIte] at hfailure hcapAtP
    · linarith only [hfailure, hcapAtP]
    · exact hfailure.elim (not_lt_of_ge hcapAtP.1) (not_lt_of_ge hcapAtP.2)
    · linarith only [hfailure, hcapAtP]
    · exact hfailure.elim (not_lt_of_ge hcapAtP.1) (not_lt_of_ge hcapAtP.2)
  have htail2 : 2 * p ≤ tail := by
    have hsum : (I.card : ℝ) * p ≤ tail := by
      calc
        _ = ∑ _b ∈ I, p := by simp
        _ ≤ _ := Finset.sum_le_sum fun b hb => (Finset.mem_filter.mp hb).2
    have hcard : (2 : ℝ) ≤ I.card := by exact_mod_cast htwo
    exact (mul_le_mul_of_nonneg_right hcard hp.le).trans hsum
  refine ⟨htwo, ?_⟩
  change ((if k = 0 then R.outerThreshold else R.innerThreshold : ℚ) : ℝ) <
    tail + (((if R.order ≤ 2 then 2 else 5 / 2 : ℚ) : ℝ) - 1) * p
  by_cases hk : k = 0 <;> by_cases ho : R.order ≤ 2 <;>
    simp only [hk, ho, ↓reduceIte, Rat.cast_ofNat, Rat.cast_div] at hfailure hcapAtP ⊢
  · linarith only [hfailure]
  · have hmain := hfailure.resolve_right (not_lt_of_ge hcapAtP.2)
    have hmin := min_le_left ((3 / 2 : ℝ) * p) L
    linarith only [hmain, hmin]
  · linarith only [hfailure]
  · have hmain := hfailure.resolve_right (not_lt_of_ge hcapAtP.2)
    by_cases hsmall : (3 / 2 : ℝ) * p ≤ L
    · rw [min_eq_left hsmall] at hmain
      linarith only [hmain]
    · have hlarge : L < (3 / 2 : ℝ) * p := lt_of_not_ge hsmall
      dsimp only [L] at hlarge
      nlinarith only [hlarge, htail2, hC]

theorem physicalSource_low_cover_of_offender
    (d : ℕ) (X : Fin d → FiniteMeasure ℝ) (g : Fin 6)
    (p tail : ℝ) (ν : Fin 2) (t : ℕ)
    (hband : ∃ j : ℕ, j < physicalSourceLowCount g ∧
      p ∈ Set.Ioc ((physicalSourceComponentEndpoints g j).1 : ℝ)
        ((physicalSourceComponentEndpoints g j).2 : ℝ))
    (hlower : ∀ j : ℕ, j < physicalSourceRowCount g →
      physicalSourceComponentKind g j < 2 →
        (trialMesh : ℝ) < ((physicalSourceComponentEndpoints g j).1 : ℝ))
    (hcount : ∀ a b : ℝ, (trialMesh : ℝ) < a → p ∈ Set.Ioc a b →
      1 ≤ (physicalSourceCountMeasure X).real (Set.Ioc a b))
    (hbudget : ∀ a : ℝ, (trialMesh : ℝ) < a → a < p →
      tail + ∑ i : Fin d, (X i : Measure ℝ).real (Set.Ioc (0 : ℝ) a) ≤
        ∑ i : Fin d, ((X i).mass : ℝ))
    (hgroup : ((physicalSourceGroup g).order : ℝ) ≥ 1)
    (hgroupFailure : ((physicalSourceGroup g).threshold : ℝ) <
      tail + (((physicalSourceGroup g).order : ℝ) - 1) * p)
    (hrow : (ν, t) ∈ physicalSourceRows g ∪
      (if g = 1 then physicalSourceRows 0 else if g = 3 then physicalSourceRows 2
        else if g = 5 then physicalSourceRows 4 else ∅))
    (hactivation : ((physicalSourceRow ν t).activation : ℝ) < p)
    (hcore : ((if g.val < 2 then (physicalSourceRow ν t).outerCore
      else (physicalSourceRow ν t).innerCore : ℚ) : ℝ) <
        ∑ i : Fin d, ((X i).mass : ℝ))
    (horiginal : ((if g.val < 2 then (physicalSourceRow ν t).outerThreshold
      else (physicalSourceRow ν t).innerThreshold : ℚ) : ℝ) <
        (∑ i : Fin d, ((X i).mass : ℝ)) +
          (((if (physicalSourceRow ν t).order ≤ 2 then 2 else 5 / 2 : ℚ) : ℝ) - 1) * p)
    (hpositive : 0 < p)
    (hradius : ((physicalSourceGroup g).lowerRadius : ℝ) <
        (∑ i : Fin d, ((X i).mass : ℝ)) ∧
      (∑ i : Fin d, ((X i).mass : ℝ)) ≤
        ((physicalSourceGroup g).upperRadius : ℝ))
    (hcell : ((∑ i : Fin d, trialCellIndex (X i) : ℕ) : ℝ) *
        (trialMesh : ℝ) ≤ (∑ i : Fin d, ((X i).mass : ℝ)) ∧
      (∑ i : Fin d, ((X i).mass : ℝ)) <
        (((∑ i : Fin d, trialCellIndex (X i) : ℕ) : ℝ) + d) * (trialMesh : ℝ))
    (htop : (∑ i : Fin d, trialCellIndex (X i)) ≤
      if g.val < 2 then 98263 else if g.val < 4 then 89524 else 89914)
    (hcap : ∀ i : Fin d, (X i : Measure ℝ)
      (Set.Ioi ((physicalSourceAlignedCapIndex g
        (∑ i : Fin d, trialCellIndex (X i)) : ℝ) * (trialMesh : ℝ))) = 0) :
    1 ≤ ∑ j ∈ Finset.range (physicalSourceRowCount g), physicalSourceCover g j X := by
  classical
  obtain ⟨j, hj, hp⟩ := hband
  have hjall : j < physicalSourceRowCount g := by
    dsimp only [physicalSourceRowCount]
    omega
  have hjkind : physicalSourceComponentKind g j = 0 := by
    simp only [physicalSourceComponentKind, hj, ↓reduceIte]
  let a : ℚ := (physicalSourceComponentEndpoints g j).1
  let b : ℚ := (physicalSourceComponentEndpoints g j).2
  let G := physicalSourceGroup g
  let R := physicalSourceRow ν t
  let s : ℝ := ∑ i : Fin d, ((X i).mass : ℝ)
  let r : ℕ := ∑ i : Fin d, trialCellIndex (X i)
  let eligible : Finset (Fin 2 × ℕ) :=
    (physicalSourceRows g ∪
      (if g = 1 then physicalSourceRows 0 else if g = 3 then physicalSourceRows 2
        else if g = 5 then physicalSourceRows 4 else ∅)).filter
      (fun row => (physicalSourceRow row.1 row.2).activation < b)
  let values : Finset ℚ := eligible.image (fun row =>
    let Q := physicalSourceRow row.1 row.2
    let core := if g.val < 2 then Q.outerCore else Q.innerCore
    let threshold := if g.val < 2 then Q.outerThreshold else Q.innerThreshold
    let m : ℚ := if Q.order ≤ 2 then 2 else 5 / 2
    max core (threshold - (m - 1) * b))
  have he : (ν, t) ∈ eligible := by
    refine Finset.mem_filter.mpr ⟨hrow, ?_⟩
    exact_mod_cast hactivation.trans_le hp.2
  have hv : max (if g.val < 2 then R.outerCore else R.innerCore)
      ((if g.val < 2 then R.outerThreshold else R.innerThreshold) -
        ((if R.order ≤ 2 then 2 else 5 / 2 : ℚ) - 1) * b) ∈ values :=
    Finset.mem_image.mpr ⟨(ν, t), he, rfl⟩
  have hne : values.Nonempty := ⟨_, hv⟩
  let c : ℚ := max G.lowerRadius (values.min' hne)
  have hclip : physicalSourceLowClipping g b = some c := by
    change (if hvalues : values.Nonempty then
      some (max G.lowerRadius (values.min' hvalues)) else none) = some c
    simp only [hne, ↓reduceDIte, c]
  have hm : (0 : ℝ) ≤ ((if R.order ≤ 2 then 2 else 5 / 2 : ℚ) : ℝ) - 1 := by
    split_ifs <;> norm_num
  have hb : 0 < (b : ℝ) := hpositive.trans_le hp.2
  have hmin : ((values.min' hne : ℚ) : ℝ) ≤
      max ((if g.val < 2 then R.outerCore else R.innerCore : ℚ) : ℝ)
        (((if g.val < 2 then R.outerThreshold else R.innerThreshold : ℚ) : ℝ) -
          (((if R.order ≤ 2 then 2 else 5 / 2 : ℚ) : ℝ) - 1) * (b : ℝ)) := by
    exact_mod_cast Finset.min'_le values _ hv
  have hc : (c : ℝ) < s := by
    have hmultiply := mul_le_mul_of_nonneg_left hp.2 hm
    have hvalue : max ((if g.val < 2 then R.outerCore else R.innerCore : ℚ) : ℝ)
        (((if g.val < 2 then R.outerThreshold else R.innerThreshold : ℚ) : ℝ) -
          (((if R.order ≤ 2 then 2 else 5 / 2 : ℚ) : ℝ) - 1) * (b : ℝ)) < s := by
      refine max_lt_iff.mpr ⟨hcore, ?_⟩
      linarith only [horiginal, hmultiply]
    simpa only [c, Rat.cast_max] using
      max_lt_iff.mpr ⟨hradius.1, hmin.trans_lt hvalue⟩
  have hh : 0 < (trialMesh : ℝ) :=
    Rat.cast_pos.mpr trial_fixed_positive_data.2.1
  have hfloorlo : (⌊c / trialMesh⌋ : ℤ) - (d : ℤ) + 1 ≤ (r : ℤ) := by
    have hc' : (c : ℝ) / (trialMesh : ℝ) < (r : ℝ) + d :=
      (div_lt_iff₀ hh).mpr (hc.trans hcell.2)
    have hf : (⌊c / trialMesh⌋ : ℤ) < (r : ℤ) + d := by
      apply Int.floor_lt.mpr
      exact_mod_cast hc'
    omega
  have hfloorhi : (r : ℤ) ≤ (⌊G.upperRadius / trialMesh⌋ : ℤ) := by
    apply Int.le_floor.mpr
    have hr : (r : ℝ) ≤ (G.upperRadius : ℝ) / (trialMesh : ℝ) :=
      (le_div_iff₀ hh).mpr (hcell.1.trans hradius.2)
    exact_mod_cast hr
  have hχ : physicalSourceRadialMask g j d r = 1 := by
    change (match (if physicalSourceComponentKind g j = 0 then
        physicalSourceLowClipping g b else some G.lowerRadius) with
      | none => (0 : ℝ)
      | some c' => if j < physicalSourceRowCount g ∧
          r ≤ (if g.val < 2 then 98263 else if g.val < 4 then 89524 else 89914) ∧
          (⌊c' / trialMesh⌋ : ℤ) - (d : ℤ) + 1 ≤ (r : ℤ) ∧
          (r : ℤ) ≤ (⌊G.upperRadius / trialMesh⌋ : ℤ)
        then 1 else 0) = 1
    rw [ite_eq_left hjkind, hclip]
    exact ite_eq_left ⟨hjall, htop, hfloorlo, hfloorhi⟩
  have hθ : 0 ≤ (physicalSourceTheta g j : ℝ) := by
    unfold physicalSourceTheta
    simp only [hjkind, ↓reduceIte]
    by_cases hspecial : g = 0 ∧ j = 2
    · rw [ite_eq_left hspecial]
      norm_num
    · rw [ite_eq_right hspecial]
      have hn : (0 : ℚ) < if g = 5 then 9 else 7 := by
        split_ifs <;> norm_num
      have hbq : (0 : ℚ) < b := by exact_mod_cast hb
      have hcq : (0 : ℤ) < ⌈(if g = 5 then 9 else 7 : ℚ) / b⌉ :=
        Int.ceil_pos.mpr (div_pos hn hbq)
      exact_mod_cast hcq.le
  have ha : (trialMesh : ℝ) < (a : ℝ) := hlower j hjall (by omega)
  have hbudget' := hbudget a ha hp.1
  have hmult := mul_le_mul_of_nonneg_left hp.2 (sub_nonneg.mpr hgroup)
  have hphase : 0 ≤ s + ((G.order : ℝ) - 1) * (b : ℝ) -
      (G.threshold : ℝ) -
        ∑ i : Fin d, (X i : Measure ℝ).real (Set.Ioc (0 : ℝ) (a : ℝ)) := by
    linarith only [hgroupFailure, hbudget', hmult]
  have hexp : 1 ≤ Real.exp ((physicalSourceTheta g j : ℝ) *
      (s + ((G.order : ℝ) - 1) * (b : ℝ) - (G.threshold : ℝ) -
        ∑ i : Fin d, (X i : Measure ℝ).real (Set.Ioc (0 : ℝ) (a : ℝ)))) :=
    Real.one_le_exp_iff.mpr (mul_nonneg hθ hphase)
  have hcomponent : 1 ≤ physicalSourceCover g j X := by
    change 1 ≤ if ∀ i : Fin d, (X i : Measure ℝ)
        (Set.Ioi ((physicalSourceAlignedCapIndex g r : ℝ) * (trialMesh : ℝ))) = 0
      then physicalSourceRadialMask g j d r *
        (if physicalSourceComponentKind g j = 0 then
          (physicalSourceCountMeasure X).real (Set.Ioc (a : ℝ) (b : ℝ)) *
            Real.exp ((physicalSourceTheta g j : ℝ) *
              (s + ((G.order : ℝ) - 1) * (b : ℝ) - (G.threshold : ℝ) -
                ∑ i : Fin d, (X i : Measure ℝ).real
                  (Set.Ioc (0 : ℝ) (a : ℝ)))) else _) else 0
    rw [ite_eq_left hcap, hχ, ite_eq_left hjkind, one_mul]
    exact one_le_mul_of_one_le_of_one_le (hcount a b ha hp) hexp
  exact hcomponent.trans (Finset.single_le_sum
    (fun k _ => (physicalSourceCover_regular g k d).2.choose_spec.2 X |>.1)
    (Finset.mem_range.mpr hjall))

theorem physicalSource_rank_high_cover_of_offender
    (d : ℕ) (X : Fin d → FiniteMeasure ℝ) (g : Fin 6)
    {ι : Type} [Fintype ι] (f : ι → ℝ)
    (hN : (physicalSourceCountMeasure X).restrict (Set.Ioi (trialMesh : ℝ)) =
      ∑ a : ι, Measure.dirac (f a)) :
    let G := physicalSourceGroup g
    let r := ∑ i : Fin d, trialCellIndex (X i)
    let s := ∑ i : Fin d, ((X i).mass : ℝ)
    (∀ a, (trialMesh : ℝ) < f a ∧ f a ≤ (G.cap : ℝ)) →
    ((2 : ℝ) * (trialMesh : ℝ) < (G.activation : ℝ) ∧
      (G.activation : ℝ) < (G.split : ℝ) ∧
      (0 : ℝ) < (G.order : ℝ) ∧
      (G.cap : ℝ) + (G.order : ℝ) * (G.split : ℝ) ≤ (G.threshold : ℝ) ∧
      (G.split : ℝ) < (G.threshold : ℝ) / ((G.order : ℝ) + 1)) →
    (G.lowerRadius : ℝ) < s → s ≤ (G.upperRadius : ℝ) →
    (r : ℝ) * (trialMesh : ℝ) ≤ s →
    s < ((r : ℝ) + d) * (trialMesh : ℝ) →
    r ≤ (if g.val < 2 then 98263 else if g.val < 4 then 89524 else 89914) →
    (∀ i : Fin d, (X i : Measure ℝ)
      (Set.Ioi ((physicalSourceAlignedCapIndex g r : ℝ) * (trialMesh : ℝ))) = 0) →
    ∀ a : ι, (G.split : ℝ) < f a →
      2 ≤ (Finset.univ.filter (fun b => f a ≤ f b)).card →
      (G.threshold : ℝ) <
        (∑ b ∈ Finset.univ.filter (fun b => f a ≤ f b), f b) +
          ((G.order : ℝ) - 1) * f a →
      1 ≤ ∑ j ∈ Finset.range (physicalSourceRowCount g), physicalSourceCover g j X := by
  classical
  have hrankBand := physicalSource_cover_interval_partition.2.1
  have hrankLower := physicalSource_cover_interval_partition.2.2.1
  intro G r s hf hparameters hsLower hsUpper hcellLower hcellUpper htop hcap a ha htwo hbad
  obtain ⟨hactivation, hactivationSplit, hm, hguard, hsplitRank⟩ := hparameters
  have hh : (0 : ℝ) < (trialMesh : ℝ) := by
    exact_mod_cast trial_fixed_positive_data.2.1
  have hsplit : (trialMesh : ℝ) < (G.split : ℝ) := by
    linarith only [hh, hactivation, hactivationSplit]
  let N := physicalSourceCountMeasure X
  have hrestrict (S : Set ℝ)
      (hSh : S ⊆ Set.Ioi (trialMesh : ℝ)) :
      N.restrict S = ∑ b : ι, if f b ∈ S then Measure.dirac (f b) else 0 := by
    calc
      N.restrict S = (N.restrict (Set.Ioi (trialMesh : ℝ))).restrict S :=
        (Measure.restrict_restrict_of_subset hSh).symm
      _ = ∑ b : ι, if f b ∈ S then Measure.dirac (f b) else 0 := by
        rw [hN, ← Measure.restrictₗ_apply, map_sum]
        simp only [Measure.restrictₗ_apply]
        apply Finset.sum_congr rfl
        intro b _hb
        exact restrict_dirac
  have hmeasure (S : Set ℝ)
      (hSh : S ⊆ Set.Ioi (trialMesh : ℝ)) :
      N S = ((Finset.univ.filter (fun b => f b ∈ S)).card : ℝ≥0∞) := by
    simpa [Measure.finsetSum_apply, apply_ite, ite_apply] using
      congrArg (fun ν : Measure ℝ => ν Set.univ) (hrestrict S hSh)
  have hreal (S : Set ℝ)
      (hSh : S ⊆ Set.Ioi (trialMesh : ℝ)) :
      N.real S = ((Finset.univ.filter (fun b => f b ∈ S)).card : ℝ) := by
    change (N S).toReal = _
    rw [hmeasure S hSh, ENNReal.toReal_natCast]
  have hsummand (j : ℕ) (hj : j < physicalSourceRowCount g) :
      physicalSourceCover g j X ≤
        ∑ k ∈ Finset.range (physicalSourceRowCount g), physicalSourceCover g k X :=
    Finset.single_le_sum
      (fun k _ => ((physicalSourceCover_regular g k d).2.choose_spec.2 X).1)
      (Finset.mem_range.mpr hj)
  have hχ (j : ℕ) (hj : j < physicalSourceRowCount g)
      (hk : physicalSourceComponentKind g j ≠ 0) :
      physicalSourceRadialMask g j d r = 1 := by
    have hratioLower : (G.lowerRadius : ℝ) / (trialMesh : ℝ) < (r : ℝ) + d :=
      (div_lt_iff₀ hh).mpr (hsLower.trans hcellUpper)
    have hfloorLower : (⌊G.lowerRadius / trialMesh⌋ : ℤ) < (r : ℤ) + d :=
      Int.floor_lt.mpr (by exact_mod_cast hratioLower)
    have hleft : (⌊G.lowerRadius / trialMesh⌋ : ℤ) - d + 1 ≤ (r : ℤ) := by omega
    have hratioUpper : (r : ℝ) ≤ (G.upperRadius : ℝ) / (trialMesh : ℝ) :=
      (le_div_iff₀ hh).mpr (hcellLower.trans hsUpper)
    have hright : (r : ℤ) ≤ ⌊G.upperRadius / trialMesh⌋ :=
      Int.le_floor.mpr (by exact_mod_cast hratioUpper)
    simp only [physicalSourceRadialMask, hk, ↓reduceIte]
    exact ite_eq_left ⟨hj, htop, hleft, hright⟩
  let H : Finset ι := Finset.univ.filter (fun b => (G.split : ℝ) < f b)
  let T : Finset ι := Finset.univ.filter (fun b => f a ≤ f b)
  change 2 ≤ T.card at htwo
  have haH : a ∈ H := Finset.mem_filter.mpr ⟨Finset.mem_univ a, ha⟩
  have hTH : T ⊆ H := by
    intro b hb
    exact Finset.mem_filter.mpr
      ⟨Finset.mem_univ b, ha.trans_le (Finset.mem_filter.mp hb).2⟩
  have htwoH : 2 ≤ H.card := htwo.trans (Finset.card_le_card hTH)
  have hsplitCount : N.real (Set.Ioi (G.split : ℝ)) = (H.card : ℝ) := by
    simpa only [H, Set.mem_Ioi] using
      hreal (Set.Ioi (G.split : ℝ)) (Set.Ioi_subset_Ioi hsplit.le)
  by_cases hthree : 3 ≤ H.card
  · let j := physicalSourceLowCount g + physicalSourceRankCount g
    have hj : j < physicalSourceRowCount g := by
      dsimp only [j, physicalSourceRowCount]
      omega
    have hk : physicalSourceComponentKind g j = 2 := by
      dsimp only [physicalSourceComponentKind, j]
      split_ifs <;> omega
    have hcover : physicalSourceCover g j X = (Nat.choose H.card 3 : ℝ) := by
      dsimp only [physicalSourceCover]
      rw [ite_eq_left hcap, hχ j hj (by omega)]
      rw [hk, ite_eq_right (by decide : (2 : ℕ) ≠ 0),
        ite_eq_right (by decide : (2 : ℕ) ≠ 1), one_mul, hsplitCount, Nat.floor_natCast]
    have hchoose : 1 ≤ Nat.choose H.card 3 := Nat.succ_le_of_lt (Nat.choose_pos hthree)
    apply le_trans (b := physicalSourceCover g j X) ?_ (hsummand j hj)
    rw [hcover]
    exact_mod_cast hchoose
  · have hcard : H.card = 2 := by omega
    have hT : T = H := Finset.eq_of_subset_of_card_le hTH (by omega)
    obtain ⟨b, hb, hmax⟩ := H.exists_max_image f ⟨a, haH⟩
    obtain ⟨c, hc, hcb⟩ := H.exists_mem_ne (by omega) b
    have hbc : b ≠ c := hcb.symm
    have hpair : ({b, c} : Finset ι) = H :=
      Finset.eq_of_subset_of_card_le
        (Finset.insert_subset_iff.mpr ⟨hb, Finset.singleton_subset_iff.mpr hc⟩)
        (hcard.trans (Finset.card_pair hbc).symm).le
    have hcbValue : f c ≤ f b := hmax c hc
    have hac : f a ≤ f c := by
      simpa only [T, Finset.mem_filter, Finset.mem_univ, true_and] using
        (hT.symm ▸ hc : c ∈ T)
    have hacEq : f a = f c := by
      have hamem : a = b ∨ a = c := by simpa only [← hpair, Finset.mem_insert,
        Finset.mem_singleton] using haH
      rcases hamem with rfl | rfl
      · exact le_antisymm hac hcbValue
      · rfl
    change (G.threshold : ℝ) < (∑ u ∈ T, f u) + ((G.order : ℝ) - 1) * f a at hbad
    rw [hT, ← hpair, Finset.sum_pair hbc, hacEq] at hbad
    let q := f b
    have hbalanced : (G.threshold : ℝ) < q + (G.order : ℝ) * f c := by
      dsimp only [q]
      nlinarith only [hbad]
    have hqsplit : (G.split : ℝ) < q := (Finset.mem_filter.mp hb).2
    have hqpos : (trialMesh : ℝ) < q := (hf b).1
    have hqcap : q ≤ (G.cap : ℝ) := (hf b).2
    have hqrank : (G.threshold : ℝ) / ((G.order : ℝ) + 1) < q := by
      apply (div_lt_iff₀ (by linarith only [hm])).mpr
      have hmul := mul_le_mul_of_nonneg_left hcbValue hm.le
      dsimp only [q] at hbalanced ⊢
      nlinarith only [hbalanced, hmul]
    have hwindowLower : (G.split : ℝ) ≤ ((G.threshold : ℝ) - q) / (G.order : ℝ) := by
      apply (le_div_iff₀ hm).mpr
      nlinarith only [hguard, hqcap]
    have hcWindow : ((G.threshold : ℝ) - q) / (G.order : ℝ) < f c :=
      (div_lt_iff₀ hm).mpr (by linarith only [hbalanced])
    have hbWindow : ((G.threshold : ℝ) - q) / (G.order : ℝ) < q :=
      hcWindow.trans_le hcbValue
    have hglobal (u : ι) : f u ≤ q := by
      by_cases hu : (G.split : ℝ) < f u
      · exact hmax u (Finset.mem_filter.mpr ⟨Finset.mem_univ u, hu⟩)
      · exact (le_of_not_gt hu).trans hqsplit.le
    have htailZero : N (Set.Ioi q) = 0 := by
      rw [hmeasure (Set.Ioi q) (Set.Ioi_subset_Ioi hqpos.le)]
      norm_cast
      apply Finset.card_eq_zero.mpr
      apply Finset.filter_eq_empty_iff.mpr
      intro u _hu
      exact not_lt_of_ge (hglobal u)
    have hwindowTwo : 2 ≤ N.real (Set.Ioc (((G.threshold : ℝ) - q) / (G.order : ℝ)) q) := by
      rw [hreal _
        (fun u hu => (hsplit.trans_le hwindowLower).trans hu.1)]
      norm_cast
      calc
        2 = ({b, c} : Finset ι).card := (Finset.card_pair hbc).symm
        _ ≤ _ := Finset.card_le_card (Finset.insert_subset_iff.mpr
          ⟨by simpa only [Finset.mem_filter, Finset.mem_univ, true_and, Set.mem_Ioc, q] using
                And.intro hbWindow le_rfl,
            Finset.singleton_subset_iff.mpr (by
              simpa only [Finset.mem_filter, Finset.mem_univ, true_and, Set.mem_Ioc, q] using
                And.intro hcWindow hcbValue)⟩)
    obtain ⟨j, hj, hk, hqbin⟩ := hrankBand g q hqrank hqcap
    let S : Set ℝ := Set.Ioc ((physicalSourceComponentEndpoints g j).1 : ℝ)
      ((physicalSourceComponentEndpoints g j).2 : ℝ)
    have hSh : S ⊆ Set.Ioi (trialMesh : ℝ) := by
      intro u hu
      exact ((hsplit.trans hsplitRank).trans_le (hrankLower g j hj hk)).trans hu.1
    let F : ℝ → ℝ := fun v =>
      if N (Set.Ioi v) = 0 ∧
          (2 : ℝ) ≤ N.real (Set.Ioc (((G.threshold : ℝ) - v) / (G.order : ℝ)) v)
      then 1 else 0
    have hFq : F q = 1 := ite_eq_left ⟨htailZero, hwindowTwo⟩
    have hFnonneg (v : ℝ) : 0 ≤ F v := by
      dsimp only [F]
      split_ifs <;> norm_num
    have hintegral : (∫ v : ℝ in S, F v ∂N) =
        ∑ u : ι, if f u ∈ S then F (f u) else 0 := by
      rw [hrestrict S hSh, integral_finsetSum_measure (s := (Finset.univ : Finset ι))]
      · apply Finset.sum_congr rfl
        intro u _hu
        by_cases hu : f u ∈ S <;> simp [hu]
      · intro u _hu
        by_cases hu : f u ∈ S
        · simp only [hu, ↓reduceIte]
          exact integrable_dirac (by simp)
        · simp only [hu, ↓reduceIte]
          exact integrable_zero_measure
    have hrank : 1 ≤ ∫ v : ℝ in S, F v ∂N := by
      rw [hintegral]
      calc
        1 = (if f b ∈ S then F (f b) else 0) := by
          rw [ite_eq_left (show f b ∈ S from hqbin)]
          exact hFq.symm
        _ ≤ ∑ u : ι, if f u ∈ S then F (f u) else 0 :=
          Finset.single_le_sum
            (s := (Finset.univ : Finset ι))
            (f := fun u => if f u ∈ S then F (f u) else 0)
            (fun u _hu => by
              by_cases hu : f u ∈ S
              · simpa only [hu, ↓reduceIte] using hFnonneg (f u)
              · simp only [hu, ↓reduceIte, le_refl]) (Finset.mem_univ b)
    have hcover : physicalSourceCover g j X = ∫ v : ℝ in S, F v ∂N := by
      dsimp only [physicalSourceCover]
      rw [ite_eq_left hcap, hχ j hj (by omega)]
      simp only [hk, one_ne_zero, ↓reduceIte, one_mul, F, N, S, G]
    exact (hcover.symm ▸ hrank).trans (hsummand j hj)

theorem physicalSource_finite_offender_cover
    (k : Fin 3) (d : ℕ) (hd : d = if k = 0 then 40 else 39)
    (Y : Fin d → FiniteMeasure ℝ) (n : Fin d → ℕ)
    (x : (i : Fin d) → Fin (n i) → ℝ)
    (hY : ∀ i, (Y i).restrict (Set.Ioc (0 : ℝ) (trialMesh : ℝ)) = Y i)
    (hx : ∀ i a, (trialMesh : ℝ) < x i a ∧ x i a ≤ (trialLargestCap : ℝ))
    (hmask : let X := fun i => Y i + weightedEmpirical (n i) (x i)
      let r : ℕ := ∑ i : Fin d, trialCellIndex (X i)
      r ≤ (if k = 0 then 98263 else if k = 1 then 89524 else 89914) ∧
        ∀ i : Fin d, (X i : Measure ℝ)
          (Set.Ioi ((physicalSourceAlignedCapIndex ⟨2 * k.val, by omega⟩ r : ℝ) *
            (trialMesh : ℝ))) = 0)
    (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39))
    (hrole : k = 0 ∨ (k = 1 ∧ ν = 0) ∨ (k = 2 ∧ ν = 1))
    (horder : k ≠ 0 → (physicalSourceRow ν t.val).order ≠ 1)
    (p : ℝ) (hlabel : ∃ i a, x i a = p)
    (hactivation : ((physicalSourceRow ν t.val).activation : ℝ) < p)
    (hcore : ((if k = 0 then (physicalSourceRow ν t.val).outerCore
      else (physicalSourceRow ν t.val).innerCore : ℚ) : ℝ) <
        ∑ i : Fin d, ((Y i + weightedEmpirical (n i) (x i)).mass : ℝ))
    (hfailure :
      let R := physicalSourceRow ν t.val
      let μ : Measure ℝ := ∑ i : Fin d,
        ((Y i + weightedEmpirical (n i) (x i) : FiniteMeasure ℝ) :
          Measure ℝ)
      let L : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
      if k = 0 then
        if R.order ≤ 2 then (R.outerThreshold : ℝ) < μ.real (Set.Ici p) + p
        else (R.outerThreshold : ℝ) < μ.real (Set.Ici p) + min ((3 / 2) * p) L ∨
          (R.innerThreshold : ℝ) < 3 * p - min ((3 / 2) * p) L
      else
        if R.order ≤ 2 then (R.innerThreshold : ℝ) < μ.real (Set.Ici p) + p
        else (R.innerThreshold : ℝ) < μ.real (Set.Ici p) +
            (3 * p - min ((3 / 2) * p) L) ∨
          (R.outerThreshold : ℝ) < min ((3 / 2) * p) L) :
    let X := fun i => Y i + weightedEmpirical (n i) (x i)
    (1 : ℝ) ≤
      (∑ j ∈ Finset.range (physicalSourceRowCount ⟨2 * k.val, by omega⟩),
        physicalSourceCover ⟨2 * k.val, by omega⟩ j X) +
      ∑ j ∈ Finset.range (physicalSourceRowCount ⟨2 * k.val + 1, by omega⟩),
        physicalSourceCover ⟨2 * k.val + 1, by omega⟩ j X := by
  classical
  obtain ⟨hgroup, hpair, hrows⟩ := physicalSource_cover_fixed_geometry
  have hlowBand := physicalSource_cover_interval_partition.1
  have hcomponentLower := physicalSource_cover_interval_partition.2.2.2
  intro X
  let flm_h : ℝ := (trialMesh : ℝ)
  have flm_hpos : 0 < flm_h := by norm_num [flm_h, trialMesh]
  let flm_X : Fin d → FiniteMeasure ℝ := fun i =>
    Y i + weightedEmpirical (n i) (x i)
  let flm_μ : Measure ℝ := ∑ i : Fin d, (flm_X i : Measure ℝ)
  let flm_N : Measure ℝ := physicalSourceCountMeasure flm_X
  let flm_ι := (i : Fin d) × Fin (n i)
  let flm_f : flm_ι → ℝ := fun a => x a.1 a.2
  let : IsFiniteMeasure flm_μ := by dsimp [flm_μ]; infer_instance
  have flm_positive (a : flm_ι) : 0 < flm_f a :=
    flm_hpos.trans (hx a.1 a.2).1
  have flm_Ntail : flm_N.restrict (Set.Ioi flm_h) =
      ∑ a : flm_ι, Measure.dirac (flm_f a) := by
    change (physicalSourceCountMeasure (fun i =>
      Y i + weightedEmpirical (n i) (x i))).restrict
        (Set.Ioi (trialMesh : ℝ)) = _
    rw [physicalSourceCountMeasure_finite_tail d (trialMesh : ℝ) flm_hpos
      Y n x hY (fun i a => (hx i a).1)]
    exact (Fintype.sum_sigma (fun a : flm_ι => Measure.dirac (flm_f a))).symm
  have flm_Ncount (S : Set ℝ) (hS : S ⊆ Set.Ioi flm_h) :
      flm_N S = ((Finset.univ.filter (fun a : flm_ι => flm_f a ∈ S)).card : ℝ≥0∞) := by
    rw [← Measure.restrict_eq_self flm_N hS, flm_Ntail, Measure.finsetSum_apply]
    simp [Measure.dirac_apply, Set.indicator_apply]
  have flm_Nreal (S : Set ℝ) (hS : S ⊆ Set.Ioi flm_h) :
      flm_N.real S = ((Finset.univ.filter (fun a : flm_ι => flm_f a ∈ S)).card : ℝ) := by
    rw [measureReal_def, flm_Ncount S hS]
    simp
  have flm_one_le (S : Set ℝ) (hS : S ⊆ Set.Ioi flm_h)
      (a : flm_ι) (ha : flm_f a ∈ S) : 1 ≤ flm_N.real S := by
    rw [flm_Nreal S hS]
    have hcard : 0 < (Finset.univ.filter (fun a : flm_ι => flm_f a ∈ S)).card :=
      Finset.card_pos.mpr ⟨a, by simp [ha]⟩
    exact_mod_cast (Nat.succ_le_iff.mpr hcard)
  have flm_Ytail (i : Fin d) :
      (Y i : Measure ℝ).restrict (Set.Ioi flm_h) = 0 := by
    have hlow : (Y i : Measure ℝ).restrict (Set.Ioc (0 : ℝ) flm_h) =
        (Y i : Measure ℝ) :=
      congrArg (fun Z : FiniteMeasure ℝ => (Z : Measure ℝ)) (hY i)
    rw [← hlow, Measure.restrict_restrict measurableSet_Ioi,
      Set.disjoint_iff_inter_eq_empty.mp Set.Ioc_disjoint_Ioi_same.symm,
      Measure.restrict_empty]
  have flm_μtail : flm_μ.restrict (Set.Ioi flm_h) =
      ∑ a : flm_ι, ENNReal.ofReal (flm_f a) • Measure.dirac (flm_f a) := by
    change (∑ i : Fin d, (flm_X i : Measure ℝ)).restrict (Set.Ioi flm_h) = _
    rw [← Measure.restrictₗ_apply, map_sum]
    simp only [Measure.restrictₗ_apply]
    calc
      (∑ i : Fin d, (flm_X i : Measure ℝ).restrict (Set.Ioi flm_h)) =
          ∑ i : Fin d, ∑ a : Fin (n i), ENNReal.ofReal (x i a) • Measure.dirac (x i a) := by
        apply Finset.sum_congr rfl
        intro i _
        change ((Y i : Measure ℝ) +
          (weightedEmpirical (n i) (x i) : Measure ℝ)).restrict
            (Set.Ioi flm_h) = _
        rw [Measure.restrict_add, flm_Ytail i, zero_add,
          coe_weightedEmpirical, ← Measure.restrictₗ_apply, map_sum]
        simp only [Measure.restrictₗ_apply]
        apply Finset.sum_congr rfl
        intro a _
        have ha : flm_h < x i a := (hx i a).1
        simp [Measure.restrict_smul, restrict_dirac, Set.mem_Ioi, ha]
      _ = _ := (Fintype.sum_sigma (fun a : flm_ι =>
        ENNReal.ofReal (flm_f a) • Measure.dirac (flm_f a))).symm
  have flm_μvalues (S : Set ℝ) (hS : S ⊆ Set.Ioi flm_h) :
      flm_μ S = ∑ a : flm_ι, if flm_f a ∈ S then ENNReal.ofReal (flm_f a) else 0 := by
    rw [← Measure.restrict_eq_self flm_μ hS, flm_μtail, Measure.finsetSum_apply]
    apply Finset.sum_congr rfl
    intro a _
    by_cases ha : flm_f a ∈ S <;> simp [Measure.smul_apply, Measure.dirac_apply, ha]
  have flm_μreal (S : Set ℝ) (hS : S ⊆ Set.Ioi flm_h) :
      flm_μ.real S = ∑ a ∈ Finset.univ.filter (fun a : flm_ι => flm_f a ∈ S), flm_f a := by
    rw [measureReal_def, flm_μvalues S hS,
      ENNReal.toReal_sum (fun a _ => by split_ifs <;> simp), Finset.sum_filter]
    apply Finset.sum_congr rfl
    intro a _
    by_cases ha : flm_f a ∈ S <;> simp [ha, ENNReal.toReal_ofReal (flm_positive a).le]
  have flm_μIci (p : ℝ) (hp : flm_h < p) :
      flm_μ.real (Set.Ici p) =
        ∑ a ∈ Finset.univ.filter (fun a : flm_ι => p ≤ flm_f a), flm_f a := by
    simpa only [Set.mem_Ici] using flm_μreal (Set.Ici p) (fun _ hu => hp.trans_le hu)
  have flm_μreal_sum (S : Set ℝ) :
      flm_μ.real S = ∑ i : Fin d, (flm_X i : Measure ℝ).real S := by
    rw [measureReal_def]
    change ((∑ i : Fin d, (flm_X i : Measure ℝ)) S).toReal = _
    rw [Measure.finsetSum_apply, ENNReal.toReal_sum (fun _ _ => measure_ne_top _ _)]
    rfl
  have flm_total : flm_μ.real Set.univ = ∑ i : Fin d, ((flm_X i).mass : ℝ) :=
    flm_μreal_sum Set.univ
  have flm_mass_budget (p ℓ : ℝ) (hℓp : ℓ < p) :
      flm_μ.real (Set.Ici p) +
          (∑ i : Fin d, (flm_X i : Measure ℝ).real (Set.Ioc (0 : ℝ) ℓ)) ≤
        ∑ i : Fin d, ((flm_X i).mass : ℝ) := by
    rw [← flm_μreal_sum (Set.Ioc (0 : ℝ) ℓ), ← flm_total]
    have hdis : Disjoint (Set.Ici p) (Set.Ioc (0 : ℝ) ℓ) :=
      (Set.Ici_disjoint_Iic.mpr hℓp.not_ge).mono_right Set.Ioc_subset_Iic_self
    rw [← measureReal_union hdis measurableSet_Ioc]
    exact measureReal_mono (Set.subset_univ _)
  let R := physicalSourceRow ν t.val
  let A : ℚ := R.outerThreshold
  let C : ℚ := R.innerThreshold
  let L : ℚ := 23 * C / 40
  let ge : Fin 6 := ⟨2 * k.val, by omega⟩
  let go : Fin 6 := ⟨2 * k.val + 1, by omega⟩
  let gr : Fin 6 := if R.order ≤ 2 then ge else go
  let s : ℝ := ∑ i : Fin d, ((flm_X i).mass : ℝ)
  let r : ℕ := ∑ i : Fin d, trialCellIndex (flm_X i)
  let g : Fin 6 := if s ≤ ((physicalSourceGroup ge).upperRadius : ℝ) then ge else go
  let G := physicalSourceGroup g
  have hh : (0 : ℝ) < (trialMesh : ℝ) :=
    Rat.cast_pos.mpr trial_fixed_positive_data.2.1
  change r ≤ (if k = 0 then 98263 else if k = 1 then 89524 else 89914) ∧
    ∀ i : Fin d, (flm_X i : Measure ℝ)
      (Set.Ioi ((physicalSourceAlignedCapIndex ge r : ℝ) * (trialMesh : ℝ))) = 0
    at hmask
  change (((if k = 0 then R.outerCore else R.innerCore : ℚ) : ℝ)) < s at hcore
  obtain ⟨hAq, hCq, hsmallq, hactivationq, hcoreq, hmemq, houterCapq, hinnerq⟩ :=
    hrows ν t
  have hOrig :
      (physicalSourceGroup gr).activation ≤ R.activation ∧
        (physicalSourceGroup gr).lowerRadius ≤
          (if k = 0 then R.outerCore else R.innerCore) ∧
        (ν, t.val) ∈ physicalSourceRows gr := by
    rcases hrole with rfl | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩
    · simpa [gr, ge, go, R] using
        And.intro hactivationq (And.intro hcoreq hmemq)
    · have hi := hinnerq (horder (by decide))
      simpa [gr, ge, go, R] using
        And.intro hi.1 (And.intro hi.2.1 hi.2.2.1)
    · have hi := hinnerq (horder (by decide))
      simpa [gr, ge, go, R] using
        And.intro hi.1 (And.intro hi.2.1 hi.2.2.1)
  have hOriginalThreshold :
      (if k = 0 then A else C) = (physicalSourceGroup gr).threshold := by
    have ht := (physicalSource_retained_thresholds ν).2 t
    change A = physicalSourceOuterRadius +
        (if R.order ≤ 2 then physicalSourceAdvance else physicalSourceAdvance / 2) ∧
      C = physicalSourceInnerRadius ν +
        (if R.order ≤ 2 then physicalSourceAdvance else physicalSourceAdvance / 2) at ht
    rcases hrole with rfl | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩
    · by_cases ho : R.order ≤ 2
      · simpa [gr, ge, physicalSourceGroup, ho] using ht.1
      · simpa [gr, go, physicalSourceGroup, ho] using ht.1
    · by_cases ho : R.order ≤ 2
      · simpa [gr, ge, physicalSourceGroup, ho] using ht.2
      · simpa [gr, go, physicalSourceGroup, ho] using ht.2
    · by_cases ho : R.order ≤ 2
      · simpa [gr, ge, physicalSourceGroup, ho] using ht.2
      · simpa [gr, go, physicalSourceGroup, ho] using ht.2
  have hOrigCap :
      if k = 0 then
        if R.order ≤ 2 then 2 * (physicalSourceGroup gr).cap ≤ A
        else
          (physicalSourceGroup gr).cap +
              min (3 * (physicalSourceGroup gr).cap / 2) L ≤ A ∧
            3 * (physicalSourceGroup gr).cap -
              min (3 * (physicalSourceGroup gr).cap / 2) L ≤ C
      else
        if R.order ≤ 2 then 2 * (physicalSourceGroup gr).cap ≤ C
        else
          (physicalSourceGroup gr).cap +
              (3 * (physicalSourceGroup gr).cap -
                min (3 * (physicalSourceGroup gr).cap / 2) L) ≤ C ∧
            min (3 * (physicalSourceGroup gr).cap / 2) L ≤ A := by
    rcases hrole with rfl | ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩
    · simpa [gr, ge, go, R, A, C, L] using houterCapq
    · simpa [gr, ge, go, R, A, C, L] using
        (hinnerq (horder (by decide))).2.2.2
    · simpa [gr, ge, go, R, A, C, L] using
        (hinnerq (horder (by decide))).2.2.2
  have hOrig_radius : ((physicalSourceGroup gr).lowerRadius : ℝ) < s :=
    (Rat.cast_le.mpr hOrig.2.1).trans_lt hcore
  obtain ⟨hjoin, hpairActivation, hpairThreshold, horderEven, horderOdd, hpairCap⟩ := hpair k
  have hdpos : 0 < d := by rw [hd]; split_ifs <;> norm_num
  have hcelli (i : Fin d) :
      (trialCellIndex (flm_X i) : ℝ) * (trialMesh : ℝ) ≤ ((flm_X i).mass : ℝ) ∧
        ((flm_X i).mass : ℝ) <
          ((trialCellIndex (flm_X i) : ℝ) + 1) * (trialMesh : ℝ) :=
    (trialCellIndex_eq_iff (flm_X i) (trialCellIndex (flm_X i))).mp rfl
  have hcell :
      (r : ℝ) * (trialMesh : ℝ) ≤ s ∧
        s < ((r : ℝ) + d) * (trialMesh : ℝ) := by
    constructor
    · simpa only [r, s, Nat.cast_sum, Finset.sum_mul] using
        (Finset.sum_le_sum (fun i (_ : i ∈ (Finset.univ : Finset (Fin d))) =>
          (hcelli i).1))
    · have hsum := Finset.sum_lt_sum_of_nonempty
        (show (Finset.univ : Finset (Fin d)).Nonempty from
          ⟨⟨0, hdpos⟩, Finset.mem_univ _⟩)
        (fun i _ => (hcelli i).2)
      have heq :
          (∑ i : Fin d, ((trialCellIndex (flm_X i) : ℝ) + 1) * (trialMesh : ℝ)) =
            ((r : ℝ) + d) * (trialMesh : ℝ) := by
        rw [← Finset.sum_mul, Finset.sum_add_distrib]
        simp [r]
      exact hsum.trans_eq heq
  have hselected :
      (g = ge ∧ s ≤ ((physicalSourceGroup ge).upperRadius : ℝ)) ∨
        (g = go ∧ ((physicalSourceGroup ge).upperRadius : ℝ) < s) := by
    by_cases hs : s ≤ ((physicalSourceGroup ge).upperRadius : ℝ)
    · exact Or.inl ⟨by simp only [g, hs, ↓reduceIte], hs⟩
    · exact Or.inr ⟨by simp only [g, hs, ↓reduceIte], lt_of_not_ge hs⟩
  have hupperOdd : s ≤ ((physicalSourceGroup go).upperRadius : ℝ) := by
    have htopReal : (r : ℝ) ≤
        ((if k = 0 then 98263 else if k = 1 then 89524 else 89914 : ℕ) : ℝ) := by
      exact_mod_cast hmask.1
    calc
      s ≤ ((r : ℝ) + d) * (trialMesh : ℝ) := hcell.2.le
      _ ≤ (((if k = 0 then 98263 else if k = 1 then 89524 else 89914 : ℕ) : ℝ) + d) *
          (trialMesh : ℝ) := by
        have hm := mul_le_mul_of_nonneg_right htopReal hh.le
        nlinarith only [hm]
      _ = ((physicalSourceGroup go).upperRadius : ℝ) := by
        rw [hd]
        fin_cases k <;> norm_num [go, physicalSourceGroup]
  have hgeLower : (physicalSourceGroup ge).lowerRadius ≤
      (physicalSourceGroup go).lowerRadius := by
    rw [← hjoin]
    exact (hgroup ge).2.2.2.2.2.2.2.1.le
  have hgeOrigLower : (physicalSourceGroup ge).lowerRadius ≤
      (physicalSourceGroup gr).lowerRadius := by
    by_cases ho : R.order ≤ 2
    · simpa only [gr, ho, ↓reduceIte] using
        (le_rfl : (physicalSourceGroup ge).lowerRadius ≤ (physicalSourceGroup ge).lowerRadius)
    · simpa only [gr, ho, ↓reduceIte] using hgeLower
  have hG_radius : (G.lowerRadius : ℝ) < s ∧ s ≤ (G.upperRadius : ℝ) := by
    rcases hselected with ⟨hg, hs⟩ | ⟨hg, hs⟩
    · exact ⟨by simpa only [G, hg] using
          (Rat.cast_le.mpr hgeOrigLower).trans_lt hOrig_radius,
        by simpa only [G, hg] using hs⟩
    · have hlower : ((physicalSourceGroup go).lowerRadius : ℝ) < s := by
        rw [← hjoin]
        exact hs
      exact ⟨by simpa only [G, hg] using hlower,
        by simpa only [G, hg] using hupperOdd⟩
  have hselected_compatible : gr = go → g = go := by
    intro hgr
    rcases hselected with ⟨_hg, hs⟩ | ⟨hg, _hs⟩
    · have hstrict : ((physicalSourceGroup ge).upperRadius : ℝ) < s := by
        calc
          ((physicalSourceGroup ge).upperRadius : ℝ) =
              ((physicalSourceGroup go).lowerRadius : ℝ) :=
            congrArg (fun z : ℚ => (z : ℝ)) hjoin
          _ < s := by simpa only [hgr] using hOrig_radius
      exact False.elim ((not_lt_of_ge hs) hstrict)
    · exact hg
  have hG_role : g.val < 2 ↔ k = 0 := by
    rcases hselected with ⟨hg, _⟩ | ⟨hg, _⟩
    · rw [hg]
      fin_cases k <;> norm_num [ge]
    · rw [hg]
      fin_cases k <;> norm_num [go]
  have hG_dimension : d = G.dimension := by
    rw [hd]
    rcases hselected with ⟨hg, _⟩ | ⟨hg, _⟩ <;>
      simp only [G, hg] <;> fin_cases k <;> rfl
  have hG_top :
      r ≤ (if g.val < 2 then 98263 else if g.val < 4 then 89524 else 89914) := by
    rcases hselected with ⟨hg, _⟩ | ⟨hg, _⟩
    · rw [hg]
      fin_cases k <;> simpa [ge] using hmask.1
    · rw [hg]
      fin_cases k <;> simpa [go] using hmask.1
  have hAlignedIndex_eq :
      physicalSourceAlignedCapIndex g r = physicalSourceAlignedCapIndex ge r := by
    rcases hselected with ⟨hg, _⟩ | ⟨hg, _⟩
    · rw [hg]
    · rw [hg]
      fin_cases k <;> rfl
  have hG_capGuard : ∀ i : Fin d, (flm_X i : Measure ℝ)
      (Set.Ioi ((physicalSourceAlignedCapIndex g r : ℝ) * (trialMesh : ℝ))) = 0 := by
    simpa only [hAlignedIndex_eq] using hmask.2
  let guard : ℕ := (![89196, 95598, 84930, 87194, 85161, 87249] : Fin 6 → ℕ) g
  have hG_guard : guard < r := by
    have hguardQ : (((guard + G.dimension : ℕ) : ℚ) * trialMesh) ≤ G.lowerRadius :=
      (hgroup g).2.2.2.2.2.2.2.2.2
    have hguardReal : ((guard : ℝ) + d) * (trialMesh : ℝ) ≤ (G.lowerRadius : ℝ) := by
      rw [hG_dimension]
      exact_mod_cast hguardQ
    have hprod : ((guard : ℝ) + d) * (trialMesh : ℝ) <
        ((r : ℝ) + d) * (trialMesh : ℝ) :=
      hguardReal.trans_lt (hG_radius.1.trans hcell.2)
    have hsum : (guard : ℝ) + d < (r : ℝ) + d :=
      lt_of_mul_lt_mul_right hprod hh.le
    have hr : (guard : ℝ) < r := by linarith only [hsum]
    exact_mod_cast hr
  have hfixedCap (g' : Fin 6) (r' : ℕ)
      (hguard : (![89196, 95598, 84930, 87194, 85161, 87249] : Fin 6 → ℕ) g' < r') :
      (physicalSourceAlignedCapIndex g' r' : ℚ) * trialMesh ≤
        (physicalSourceGroup g').cap := by
    fin_cases g' <;>
      norm_num [physicalSourceAlignedCapIndex, physicalSourceGroup] at hguard ⊢
    all_goals split_ifs <;> first | omega | norm_num [trialMesh]
  have hAlignedCap_le :
      (physicalSourceAlignedCapIndex g r : ℝ) * (trialMesh : ℝ) ≤ (G.cap : ℝ) := by
    exact_mod_cast hfixedCap g r hG_guard
  have hG_capNull : ∀ i : Fin d, (flm_X i : Measure ℝ) (Set.Ioi (G.cap : ℝ)) = 0 := by
    intro i
    exact measure_mono_null (Set.Ioi_subset_Ioi hAlignedCap_le) (hG_capGuard i)
  have hcapMesh : (trialMesh : ℝ) < (G.cap : ℝ) := by
    obtain ⟨hξ, hp, hpc, _, _, _, _, _, _, _⟩ := hgroup g
    have hq : trialMesh < G.cap := by
      linarith only [trial_fixed_positive_data.2.1, hξ, hp, hpc]
    exact_mod_cast hq
  have hG_marks (a : flm_ι) : flm_h < flm_f a ∧ flm_f a ≤ (G.cap : ℝ) := by
    refine ⟨(hx a.1 a.2).1, ?_⟩
    by_contra hnot
    have ha : flm_f a ∈ Set.Ioi (G.cap : ℝ) := lt_of_not_ge hnot
    have hset : Set.Ioi (G.cap : ℝ) ⊆ Set.Ioi flm_h :=
      Set.Ioi_subset_Ioi hcapMesh.le
    have hzero : flm_μ (Set.Ioi (G.cap : ℝ)) = 0 := by
      change (∑ i : Fin d, (flm_X i : Measure ℝ)) (Set.Ioi (G.cap : ℝ)) = 0
      rw [Measure.finsetSum_apply]
      exact Finset.sum_eq_zero (fun i _ => hG_capNull i)
    have hle : ENNReal.ofReal (flm_f a) ≤ flm_μ (Set.Ioi (G.cap : ℝ)) := by
      rw [flm_μvalues _ hset]
      simpa only [ha, ↓reduceIte] using!
        (Finset.single_le_sum (s := (Finset.univ : Finset flm_ι))
          (f := fun b => if flm_f b ∈ Set.Ioi (G.cap : ℝ)
            then ENNReal.ofReal (flm_f b) else 0)
          (fun _ _ => bot_le) (Finset.mem_univ a))
    exact (not_le_of_gt (ENNReal.ofReal_pos.mpr (flm_positive a))) (hzero ▸ hle)
  have hAbsorption :
      G.cap ≤ (physicalSourceGroup gr).cap ∧
        G.activation ≤ (physicalSourceGroup gr).activation ∧
        G.threshold ≤ (physicalSourceGroup gr).threshold ∧
        (if R.order ≤ 2 then 2 else 5 / 2 : ℚ) ≤ G.order := by
    by_cases ho : R.order ≤ 2
    · have hgr : gr = ge := by simp only [gr, ho, ↓reduceIte]
      rcases hselected with ⟨hg, _⟩ | ⟨hg, _⟩
      · simp only [G, hg, hgr, ho, ↓reduceIte]
        exact ⟨le_rfl, le_rfl, le_rfl, by rw [horderEven]⟩
      · simp only [G, hg, hgr, ho, ↓reduceIte]
        exact ⟨hpairCap, hpairActivation, hpairThreshold, by rw [horderOdd]; norm_num⟩
    · have hgr : gr = go := by simp only [gr, ho, ↓reduceIte]
      have hg := hselected_compatible hgr
      simp only [G, hg, hgr, ho, ↓reduceIte]
      exact ⟨le_rfl, le_rfl, le_rfl, by rw [horderOdd]⟩
  have hcapOrig : G.cap ≤ (physicalSourceGroup gr).cap := hAbsorption.1
  have hG_activation : G.activation ≤ R.activation := hAbsorption.2.1.trans hOrig.1
  have hG_threshold : G.threshold ≤ (if k = 0 then A else C) := by
    rw [hOriginalThreshold]
    exact hAbsorption.2.2.1
  have hG_order : (if R.order ≤ 2 then 2 else 5 / 2 : ℚ) ≤ G.order :=
    hAbsorption.2.2.2
  have habsorbed :
      (if go = 1 then physicalSourceRows 0 else if go = 3 then physicalSourceRows 2
        else if go = 5 then physicalSourceRows 4 else ∅) = physicalSourceRows ge := by
    fin_cases k <;> rfl
  have hG_origin : (ν, t.val) ∈ physicalSourceRows g ∪
      (if g = 1 then physicalSourceRows 0 else if g = 3 then physicalSourceRows 2
        else if g = 5 then physicalSourceRows 4 else ∅) := by
    by_cases ho : R.order ≤ 2
    · have hgr : gr = ge := by simp only [gr, ho, ↓reduceIte]
      have hmem : (ν, t.val) ∈ physicalSourceRows ge := by
        simpa only [hgr] using hOrig.2.2
      rcases hselected with ⟨hg, _⟩ | ⟨hg, _⟩
      · rw [hg]
        exact Finset.mem_union_left _ hmem
      · rw [hg, habsorbed]
        exact Finset.mem_union_right _ hmem
    · have hgr : gr = go := by simp only [gr, ho, ↓reduceIte]
      have hg := hselected_compatible hgr
      rw [hg]
      exact Finset.mem_union_left _ (by simpa only [hgr] using hOrig.2.2)
  obtain ⟨i, a, hpa⟩ := hlabel
  let a₀ : flm_ι := ⟨i, a⟩
  have hpa₀ : flm_f a₀ = p := hpa
  have hpmesh : (trialMesh : ℝ) < p := by
    simpa only [← hpa₀] using (hx i a).1
  have hp : 0 < p := flm_hpos.trans hpmesh
  have hCpos : (0 : ℝ) < (R.innerThreshold : ℝ) := by
    exact_mod_cast (hrows ν t).2.1
  have hpOrigCap : flm_f a₀ ≤ ((physicalSourceGroup gr).cap : ℝ) :=
    (hG_marks a₀).2.trans (by exact_mod_cast hcapOrig)
  obtain ⟨htwo, horiginalBalanced⟩ := physicalSource_balanced_failure_of_offender flm_f a₀ k R
    ((physicalSourceGroup gr).cap : ℝ) flm_positive hpOrigCap hCpos (by
      dsimp only
      have hthree : (3 / 2 : ℝ) * ((physicalSourceGroup gr).cap : ℝ) =
          3 * ((physicalSourceGroup gr).cap : ℝ) / 2 := by ring
      have htwentythree : (23 / 40 : ℝ) * (R.innerThreshold : ℝ) = (L : ℝ) := by
        dsimp only [L, C]
        push_cast
        ring
      rw [hthree, htwentythree]
      by_cases hk : k = 0 <;> by_cases ho : R.order ≤ 2 <;>
        simp only [hk, ho, ↓reduceIte] at hOrigCap ⊢ <;>
        exact_mod_cast hOrigCap) (by
      dsimp only
      rw [hpa₀, ← flm_μIci p hpmesh]
      exact hfailure)
  have htail : flm_μ.real (Set.Ici p) =
      ∑ b ∈ Finset.univ.filter (fun b : flm_ι => p ≤ flm_f b), flm_f b :=
    flm_μIci p hpmesh
  have horiginalBalanced' :
      ((if k = 0 then R.outerThreshold else R.innerThreshold : ℚ) : ℝ) <
        flm_μ.real (Set.Ici p) +
          (((if R.order ≤ 2 then 2 else 5 / 2 : ℚ) : ℝ) - 1) * p := by
    simpa only [hpa₀, ← htail] using horiginalBalanced
  have horiginalOrder : (1 : ℝ) ≤
      ((if R.order ≤ 2 then 2 else 5 / 2 : ℚ) : ℝ) := by
    split_ifs <;> norm_num
  have hGorderReal : ((if R.order ≤ 2 then 2 else 5 / 2 : ℚ) : ℝ) ≤
      (G.order : ℝ) := by exact_mod_cast hG_order
  have hGthresholdReal : (G.threshold : ℝ) ≤
      ((if k = 0 then R.outerThreshold else R.innerThreshold : ℚ) : ℝ) := by
    exact_mod_cast hG_threshold
  have hGactivationReal : (G.activation : ℝ) ≤ (R.activation : ℝ) := by
    exact_mod_cast hG_activation
  have hGfailure : (G.threshold : ℝ) < flm_μ.real (Set.Ici p) +
      ((G.order : ℝ) - 1) * p := by
    have hmul := mul_le_mul_of_nonneg_right
      (sub_le_sub_right hGorderReal 1) hp.le
    exact (hGthresholdReal.trans_lt horiginalBalanced').trans_le
      (add_le_add le_rfl hmul)
  have htailMass : flm_μ.real (Set.Ici p) ≤ s :=
    (measureReal_mono (μ := flm_μ) (Set.subset_univ _)).trans_eq flm_total
  have horiginalMass :
      ((if g.val < 2 then R.outerThreshold else R.innerThreshold : ℚ) : ℝ) <
        s + (((if R.order ≤ 2 then 2 else 5 / 2 : ℚ) : ℝ) - 1) * p := by
    have heq : (if g.val < 2 then R.outerThreshold else R.innerThreshold) =
        (if k = 0 then R.outerThreshold else R.innerThreshold) := by
      simp only [hG_role]
    rw [heq]
    exact horiginalBalanced'.trans_le (add_le_add htailMass le_rfl)
  have hcoreG :
      ((if g.val < 2 then R.outerCore else R.innerCore : ℚ) : ℝ) < s := by
    simpa only [hG_role] using hcore
  have hdone : 1 ≤ ∑ j ∈ Finset.range (physicalSourceRowCount g),
      physicalSourceCover g j flm_X := by
    by_cases hlow : p ≤ (G.split : ℝ)
    · apply physicalSource_low_cover_of_offender d flm_X g p (flm_μ.real (Set.Ici p)) ν t.val
        (hlowBand g p (hGactivationReal.trans_lt hactivation) hlow)
        (hcomponentLower g)
      · intro u v hu hpv
        exact flm_one_le (Set.Ioc u v) (fun z hz => hu.trans hz.1) a₀
          (by simpa only [hpa₀] using hpv)
      · intro u _hu hup
        exact flm_mass_budget p u hup
      · exact horiginalOrder.trans hGorderReal
      · exact hGfailure
      · exact hG_origin
      · exact hactivation
      · exact hcoreG
      · exact horiginalMass
      · exact hp
      · exact hG_radius
      · exact hcell
      · exact hG_top
      · exact hG_capGuard
    · refine physicalSource_rank_high_cover_of_offender d flm_X g flm_f flm_Ntail ?_ ?_
        hG_radius.1 hG_radius.2 hcell.1 hcell.2 hG_top hG_capGuard a₀ ?_ htwo ?_
      · intro b
        exact hG_marks b
      · obtain ⟨hsmall, hsplit, _, hm, hguard, hq, _, _, _, _⟩ := hgroup g
        exact ⟨by exact_mod_cast hsmall, by exact_mod_cast hsplit,
          by exact_mod_cast hm, by exact_mod_cast hguard, by exact_mod_cast hq⟩
      · simpa only [hpa₀] using lt_of_not_ge hlow
      · simpa only [hpa₀, ← htail] using hGfailure
  have hsumNonneg (j : Fin 6) : 0 ≤
      ∑ q ∈ Finset.range (physicalSourceRowCount j), physicalSourceCover j q flm_X :=
    Finset.sum_nonneg fun q _ =>
      ((physicalSourceCover_regular j q d).2.choose_spec.2 flm_X).1
  rcases hselected with ⟨hge, _⟩ | ⟨hgo, _⟩
  · rw [hge] at hdone
    exact hdone.trans (le_add_of_nonneg_right (hsumNonneg go))
  · rw [hgo] at hdone
    exact hdone.trans (le_add_of_nonneg_left (hsumNonneg ge))

theorem physicalSource_mask_global_bounds
    (k : Fin 3) (d : ℕ) (hd : d = if k = 0 then 40 else 39)
    (X : Fin d → FiniteMeasure ℝ)
    (hm : (∑ i : Fin d, trialCellIndex (X i)) ≤
        (if k = 0 then 98263 else if k = 1 then 89524 else 89914) ∧
      ∀ i : Fin d, (X i : Measure ℝ)
        (Set.Ioi ((physicalSourceAlignedCapIndex ⟨2 * k.val, by omega⟩
          (∑ i : Fin d, trialCellIndex (X i)) : ℝ) * (trialMesh : ℝ))) = 0) :
    (∑ i : Fin d, ((X i).mass : ℝ)) ≤
        (if k = 0 then (physicalSourceOuterRadius : ℝ)
          else if k = 1 then (physicalSourceInnerRadius 0 : ℝ)
          else (physicalSourceInnerRadius 1 : ℝ)) ∧
      (∑ i : Fin d, (X i : Measure ℝ))
        (Set.Ioi ((((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ))) = 0 := by
  classical
  have fcb_hpos : 0 < (trialMesh : ℝ) :=
    Rat.cast_pos.mpr trial_fixed_positive_data.2.1
  have fcb_top (k : Fin 3) :
      (((if k = 0 then 98263 else if k = 1 then 89524 else 89914 : ℕ) : ℝ) +
        ((if k = 0 then 40 else 39 : ℕ) : ℝ)) * (trialMesh : ℝ) ≤
      (if k = 0 then (physicalSourceOuterRadius : ℝ)
        else if k = 1 then (physicalSourceInnerRadius 0 : ℝ)
        else (physicalSourceInnerRadius 1 : ℝ)) := by
    fin_cases k
    · change ((98263 : ℝ) + 40) * (trialMesh : ℝ) ≤ (physicalSourceOuterRadius : ℝ)
      exact_mod_cast (show ((98263 : ℚ) + 40) * trialMesh ≤ physicalSourceOuterRadius
        from by decide +kernel)
    · change ((89524 : ℝ) + 39) * (trialMesh : ℝ) ≤ (physicalSourceInnerRadius 0 : ℝ)
      exact_mod_cast (show ((89524 : ℚ) + 39) * trialMesh ≤ physicalSourceInnerRadius 0
        from by decide +kernel)
    · change ((89914 : ℝ) + 39) * (trialMesh : ℝ) ≤ (physicalSourceInnerRadius 1 : ℝ)
      exact_mod_cast (show ((89914 : ℚ) + 39) * trialMesh ≤ physicalSourceInnerRadius 1
        from by decide +kernel)
  let r : ℕ := ∑ i : Fin d, trialCellIndex (X i)
  let top : ℕ := if k = 0 then 98263 else if k = 1 then 89524 else 89914
  have hsize : (∑ i : Fin d, ((X i).mass : ℝ)) ≤
      ((r : ℝ) + d) * (trialMesh : ℝ) := by
    calc
      (∑ i : Fin d, ((X i).mass : ℝ)) ≤
          ∑ i : Fin d, ((trialCellIndex (X i) : ℝ) + 1) * (trialMesh : ℝ) :=
        Finset.sum_le_sum fun i _ =>
          ((trialCellIndex_eq_iff (X i) (trialCellIndex (X i))).mp rfl).2.le
      _ = ((r : ℝ) + d) * (trialMesh : ℝ) := by
        rw [← Finset.sum_mul]
        congr 1
        simp [r, Finset.sum_add_distrib]
  have htop : ((top : ℝ) + d) * (trialMesh : ℝ) ≤
      (if k = 0 then (physicalSourceOuterRadius : ℝ)
        else if k = 1 then (physicalSourceInnerRadius 0 : ℝ)
        else (physicalSourceInnerRadius 1 : ℝ)) := by
    simpa only [top, hd] using fcb_top k
  have hr : (r : ℝ) ≤ (top : ℝ) := by exact_mod_cast hm.1
  refine ⟨hsize.trans ((mul_le_mul_of_nonneg_right
    (add_le_add hr (le_rfl : (d : ℝ) ≤ d)) fcb_hpos.le).trans htop), ?_⟩
  let ζ : ℝ := (((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ)
  have hζ : (trialLargestCap : ℝ) < ζ := by
    simpa only [ζ, Rat.cast_div] using
      (Rat.cast_lt (K := ℝ)).mpr
        (show trialLargestCap < (19037 / 100000 : ℚ) / physicalSourceRho
          from by decide +kernel)
  have hindex : physicalSourceAlignedCapIndex ⟨2 * k.val, by omega⟩ r ≤ 68225 := by
    dsimp only [physicalSourceAlignedCapIndex]
    split_ifs <;> decide
  have hcap : (physicalSourceAlignedCapIndex ⟨2 * k.val, by omega⟩ r : ℝ) *
      (trialMesh : ℝ) ≤ ζ := by
    calc
      _ ≤ (68225 : ℝ) * (trialMesh : ℝ) :=
        mul_le_mul_of_nonneg_right (by exact_mod_cast hindex) fcb_hpos.le
      _ = (trialLargestCap : ℝ) := by norm_num [trialLargestCap]
      _ ≤ ζ := hζ.le
  rw [Measure.finsetSum_apply]
  apply Finset.sum_eq_zero
  intro i _
  exact measure_mono_null (Set.Ioi_subset_Ioi hcap) (hm.2 i)

theorem physicalSource_finite_inner_event_cover (ν : Fin 2) :
    ∀ (Y : Fin 39 → FiniteMeasure ℝ) (n : Fin 39 → ℕ)
      (x : (i : Fin 39) → Fin (n i) → ℝ),
      (∀ i, (Y i).restrict (Set.Ioc (0 : ℝ) (trialMesh : ℝ)) = Y i) →
      (∀ i a, (trialMesh : ℝ) < x i a ∧ x i a ≤ (trialLargestCap : ℝ)) →
      let X := fun i => Y i + weightedEmpirical (n i) (x i)
      let k : Fin 3 := if ν = 0 then 1 else 2
      (if ν = 0 then trialBaseMask X else trialEnlargedMask X) *
          (1 - physicalSourceInnerSupport ν X) ≤
        (∑ j ∈ Finset.range (physicalSourceRowCount ⟨2 * k.val, by omega⟩),
          physicalSourceCover ⟨2 * k.val, by omega⟩ j X) +
        ∑ j ∈ Finset.range (physicalSourceRowCount ⟨2 * k.val + 1, by omega⟩),
          physicalSourceCover ⟨2 * k.val + 1, by omega⟩ j X := by
  classical
  let ge (k : Fin 3) : Fin 6 :=
    ⟨2 * k.val, Nat.mul_lt_mul_of_pos_left k.isLt (by decide)⟩
  let go (k : Fin 3) : Fin 6 :=
    ⟨2 * k.val + 1, Nat.lt_succ_of_le
      (Nat.add_le_add_right (Nat.mul_le_mul_left 2 (Nat.le_of_lt_succ k.isLt)) 1)⟩
  have fcb_indicator_le (a R : ℝ) {P : Prop} [Decidable P]
      (ha : a = 0 ∨ a = 1) (hR : 0 ≤ R)
      (h : a = 1 → ¬P → 1 ≤ R) :
      a * (1 - (if P then 1 else 0)) ≤ R := by
    rcases ha with rfl | rfl
    · simpa only [zero_mul] using hR
    by_cases hp : P
    · simpa only [ite_eq_left hp, sub_self, mul_zero] using hR
    · simpa only [ite_eq_right hp, sub_zero, one_mul] using h rfl hp
  have hrows := physicalSource_cover_fixed_geometry.2.2
  have fcb_hpos : 0 < (trialMesh : ℝ) :=
    Rat.cast_pos.mpr trial_fixed_positive_data.2.1
  have fcb_activation (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)) :
      (trialMesh : ℝ) < ((physicalSourceRow ν t.val).activation : ℝ) := by
    exact Rat.cast_lt.mpr
      ((lt_mul_of_one_lt_left trial_fixed_positive_data.2.1
        (by norm_num : (1 : ℚ) < 2)).trans ((hrows ν t).2.2.1))
  have fcb_nonneg (g : Fin 6) (d : ℕ) (X : Fin d → FiniteMeasure ℝ) :
      0 ≤ ∑ j ∈ Finset.range (physicalSourceRowCount g), physicalSourceCover g j X :=
    Finset.sum_nonneg fun j _ =>
      ((physicalSourceCover_regular g j d).2.choose_spec.2 X).1
  have fcb_mask_values (ν : Fin 2) (X : Fin 39 → FiniteMeasure ℝ) :
      (if ν = 0 then trialBaseMask X else trialEnlargedMask X) = 0 ∨
        (if ν = 0 then trialBaseMask X else trialEnlargedMask X) = 1 := by
    by_cases hν : ν = 0
    · simpa only [ite_eq_left hν] using (trial_mask_values_and_nesting.2 X).1
    · simpa only [ite_eq_right hν] using (trial_mask_values_and_nesting.2 X).2.1
  intro Y n x hY hx X k
  let mask : ℝ := if ν = 0 then trialBaseMask X else trialEnlargedMask X
  let μ : Measure ℝ := ∑ i : Fin 39, (X i : Measure ℝ)
  let s : ℝ := ∑ i : Fin 39, ((X i).mass : ℝ)
  let N := physicalSourceCountMeasure X
  let E (t : Fin (if ν = 0 then 28 else 39)) : Set ℝ :=
    let R := physicalSourceRow ν t.val
    {p : ℝ | (R.activation : ℝ) < p ∧
      (if R.order ≤ 2 then (R.innerThreshold : ℝ) < μ.real (Set.Ici p) + p
      else
        let L : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
        (R.innerThreshold : ℝ) < μ.real (Set.Ici p) +
            (3 * p - min ((3 / 2) * p) L) ∨
          (R.outerThreshold : ℝ) < min ((3 / 2) * p) L)}
  have hnn := add_nonneg
    (fcb_nonneg (ge k) 39 X)
    (fcb_nonneg (go k) 39 X)
  change mask * (1 - physicalSourceInnerSupport ν X) ≤ _
  apply fcb_indicator_le mask _
    (P := s ≤ (physicalSourceInnerRadius ν : ℝ) ∧
      μ (Set.Ioi ((((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ))) = 0 ∧
      ∀ t : Fin (if ν = 0 then 28 else 39),
        (physicalSourceRow ν t.val).order = 1 ∨
          s ≤ ((physicalSourceRow ν t.val).innerCore : ℝ) ∨ N (E t) = 0)
    (fcb_mask_values ν X) hnn
  intro hm1 hs
  have hk0 : k ≠ 0 := by
    dsimp only [k]
    split_ifs <;> decide
  have hd : (39 : ℕ) = if k = 0 then 40 else 39 :=
    (ite_eq_right hk0).symm
  have hm : (∑ i : Fin 39, trialCellIndex (X i)) ≤
        (if k = 0 then 98263 else if k = 1 then 89524 else 89914) ∧
      ∀ i : Fin 39, (X i : Measure ℝ)
        (Set.Ioi ((physicalSourceAlignedCapIndex (ge k)
          (∑ i : Fin 39, trialCellIndex (X i)) : ℝ) * (trialMesh : ℝ))) = 0 := by
    by_cases hν : ν = 0
    · have hk : k = 1 := ite_eq_left hν
      have hm : mask = trialBaseMask X := ite_eq_left hν
      have hb : trialBaseMask X = 1 := hm.symm.trans hm1
      dsimp only [trialBaseMask] at hb
      generalize hr : (∑ i : Fin 39, trialCellIndex (X i)) = r at hb ⊢
      simpa [hk, ge, physicalSourceAlignedCapIndex] using
        (Ne.ite_eq_left_iff (one_ne_zero : (1 : ℝ) ≠ 0)).mp hb
    · have hk : k = 2 := ite_eq_right hν
      have hm : mask = trialEnlargedMask X := ite_eq_right hν
      have hb : trialEnlargedMask X = 1 := hm.symm.trans hm1
      dsimp only [trialEnlargedMask] at hb
      generalize hr : (∑ i : Fin 39, trialCellIndex (X i)) = r at hb ⊢
      simpa [hk, ge, physicalSourceAlignedCapIndex] using
        (Ne.ite_eq_left_iff (one_ne_zero : (1 : ℝ) ≠ 0)).mp hb
  have hg := physicalSource_mask_global_bounds k 39 hd X hm
  have hradius : s ≤ (physicalSourceInnerRadius ν : ℝ) := by
    by_cases hν : ν = 0
    · have hk : k = 1 := ite_eq_left hν
      have hr := hg.1
      rw [hk] at hr
      rw [hν]
      exact hr
    · have hk : k = 2 := ite_eq_right hν
      have hr := hg.1
      rw [hk] at hr
      rw [Fin.eq_one_of_ne_zero ν hν]
      exact hr
  have hnotrows : ¬∀ t : Fin (if ν = 0 then 28 else 39),
      (physicalSourceRow ν t.val).order = 1 ∨
        s ≤ ((physicalSourceRow ν t.val).innerCore : ℝ) ∨ N (E t) = 0 :=
    fun hgood => hs ⟨hradius, hg.2, hgood⟩
  obtain ⟨t, ht⟩ := not_forall.mp hnotrows
  obtain ⟨horder, hrow⟩ := not_or.mp ht
  obtain ⟨hcore, hN⟩ := not_or.mp hrow
  have hcore' := lt_of_not_ge hcore
  have hSh : E t ⊆ Set.Ioi (trialMesh : ℝ) :=
    fun p hp => (fcb_activation ν t).trans hp.1
  have htail := physicalSourceCountMeasure_finite_tail 39 (trialMesh : ℝ) fcb_hpos
    Y n x hY (fun i a => (hx i a).1)
  rw [← Measure.restrict_eq_self N hSh, htail] at hN
  simp only [Measure.finsetSum_apply] at hN
  obtain ⟨i, _, hi⟩ := Finset.exists_ne_zero_of_sum_ne_zero hN
  obtain ⟨a, _, ha⟩ := Finset.exists_ne_zero_of_sum_ne_zero hi
  have hpa : x i a ∈ E t :=
    Set.mem_of_indicator_ne_zero (f := (1 : ℝ → ℝ≥0∞))
      (by simpa only [Measure.dirac_apply] using ha)
  have hrole : k = 0 ∨ (k = 1 ∧ ν = 0) ∨ (k = 2 ∧ ν = 1) := by
    by_cases hν : ν = 0
    · exact Or.inr (Or.inl ⟨ite_eq_left hν, hν⟩)
    · exact Or.inr (Or.inr ⟨ite_eq_right hν, Fin.eq_one_of_ne_zero ν hν⟩)
  have hv := physicalSource_finite_offender_cover k 39 hd Y n x hY hx hm ν t hrole
    (fun _ => horder)
    (x i a) ⟨i, a, rfl⟩ hpa.1
    (by simpa only [hk0, ↓reduceIte] using hcore')
    (by simpa only [hk0, ↓reduceIte] using hpa.2)
  exact hv

theorem physicalSource_finite_event_cover :
    (∀ (Y : Fin 40 → FiniteMeasure ℝ) (n : Fin 40 → ℕ)
      (x : (i : Fin 40) → Fin (n i) → ℝ),
      (∀ i, (Y i).restrict (Set.Ioc (0 : ℝ) (trialMesh : ℝ)) = Y i) →
      (∀ i a, (trialMesh : ℝ) < x i a ∧ x i a ≤ (trialLargestCap : ℝ)) →
      let X := fun i => Y i + weightedEmpirical (n i) (x i)
      trialOuterMask X * (1 - physicalSourceOuterSupport X) ≤
        (∑ j ∈ Finset.range (physicalSourceRowCount 0), physicalSourceCover 0 j X) +
          ∑ j ∈ Finset.range (physicalSourceRowCount 1), physicalSourceCover 1 j X) ∧
    (∀ (Y : Fin 39 → FiniteMeasure ℝ) (n : Fin 39 → ℕ)
      (x : (i : Fin 39) → Fin (n i) → ℝ),
      (∀ i, (Y i).restrict (Set.Ioc (0 : ℝ) (trialMesh : ℝ)) = Y i) →
      (∀ i a, (trialMesh : ℝ) < x i a ∧ x i a ≤ (trialLargestCap : ℝ)) →
      let X := fun i => Y i + weightedEmpirical (n i) (x i)
      trialBaseMask X * (1 - physicalSourceInnerSupport 0 X) ≤
        (∑ j ∈ Finset.range (physicalSourceRowCount 2), physicalSourceCover 2 j X) +
          ∑ j ∈ Finset.range (physicalSourceRowCount 3), physicalSourceCover 3 j X) ∧
    (∀ (Y : Fin 39 → FiniteMeasure ℝ) (n : Fin 39 → ℕ)
      (x : (i : Fin 39) → Fin (n i) → ℝ),
      (∀ i, (Y i).restrict (Set.Ioc (0 : ℝ) (trialMesh : ℝ)) = Y i) →
      (∀ i a, (trialMesh : ℝ) < x i a ∧ x i a ≤ (trialLargestCap : ℝ)) →
      let X := fun i => Y i + weightedEmpirical (n i) (x i)
      trialEnlargedMask X * (1 - physicalSourceInnerSupport 1 X) ≤
        (∑ j ∈ Finset.range (physicalSourceRowCount 4), physicalSourceCover 4 j X) +
          ∑ j ∈ Finset.range (physicalSourceRowCount 5), physicalSourceCover 5 j X) := by
  classical
  have fcb_indicator_le (a R : ℝ) {P : Prop} [Decidable P]
      (ha : a = 0 ∨ a = 1) (hR : 0 ≤ R)
      (h : a = 1 → ¬P → 1 ≤ R) :
      a * (1 - (if P then 1 else 0)) ≤ R := by
    rcases ha with rfl | rfl
    · simpa only [zero_mul] using hR
    by_cases hp : P
    · simpa only [ite_eq_left hp, sub_self, mul_zero] using hR
    · simpa only [ite_eq_right hp, sub_zero, one_mul] using h rfl hp
  have hrows := physicalSource_cover_fixed_geometry.2.2
  have fcb_hpos : 0 < (trialMesh : ℝ) :=
    Rat.cast_pos.mpr trial_fixed_positive_data.2.1
  have fcb_activation (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)) :
      (trialMesh : ℝ) < ((physicalSourceRow ν t.val).activation : ℝ) := by
    exact Rat.cast_lt.mpr
      ((lt_mul_of_one_lt_left trial_fixed_positive_data.2.1
        (by norm_num : (1 : ℚ) < 2)).trans ((hrows ν t).2.2.1))
  have fcb_nonneg (g : Fin 6) (d : ℕ) (X : Fin d → FiniteMeasure ℝ) :
      0 ≤ ∑ j ∈ Finset.range (physicalSourceRowCount g), physicalSourceCover g j X :=
    Finset.sum_nonneg fun j _ =>
      ((physicalSourceCover_regular g j d).2.choose_spec.2 X).1
  have fcb_outer_mask (X : Fin 40 → FiniteMeasure ℝ) (h : trialOuterMask X = 1) :
      (∑ i : Fin 40, trialCellIndex (X i)) ≤ 98263 ∧
        ∀ i : Fin 40, (X i : Measure ℝ)
          (Set.Ioi ((physicalSourceAlignedCapIndex 0
            (∑ i : Fin 40, trialCellIndex (X i)) : ℝ) * (trialMesh : ℝ))) = 0 := by
    dsimp only [trialOuterMask] at h
    generalize hr : (∑ i : Fin 40, trialCellIndex (X i)) = r at h ⊢
    simpa [physicalSourceAlignedCapIndex] using
      (Ne.ite_eq_left_iff (one_ne_zero : (1 : ℝ) ≠ 0)).mp h
  refine ⟨?_, ?_, ?_⟩
  · intro Y n x hY hx X
    let μ : Measure ℝ := ∑ i : Fin 40, (X i : Measure ℝ)
    let s : ℝ := ∑ i : Fin 40, ((X i).mass : ℝ)
    let N := physicalSourceCountMeasure X
    let E (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)) : Set ℝ :=
      let R := physicalSourceRow ν t.val
      {p : ℝ | (R.activation : ℝ) < p ∧
        (if R.order ≤ 2 then (R.outerThreshold : ℝ) < μ.real (Set.Ici p) + p
        else
          let L : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
          (R.outerThreshold : ℝ) < μ.real (Set.Ici p) + min ((3 / 2) * p) L ∨
            (R.innerThreshold : ℝ) < 3 * p - min ((3 / 2) * p) L)}
    have hnn := add_nonneg (fcb_nonneg 0 40 X) (fcb_nonneg 1 40 X)
    apply fcb_indicator_le _ _
      (P := s ≤ (physicalSourceOuterRadius : ℝ) ∧
        μ (Set.Ioi ((((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ))) = 0 ∧
        ∀ (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)),
          s ≤ ((physicalSourceRow ν t.val).outerCore : ℝ) ∨ N (E ν t) = 0)
      (trial_mask_values_and_nesting.1 X) hnn
    intro hm1 hs
    have hm := fcb_outer_mask X hm1
    have hg := physicalSource_mask_global_bounds 0 40 rfl X hm
    have hnotrows : ¬∀ (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)),
        s ≤ ((physicalSourceRow ν t.val).outerCore : ℝ) ∨ N (E ν t) = 0 :=
      fun hgood => hs ⟨hg.1, hg.2, hgood⟩
    obtain ⟨ν, hν⟩ := not_forall.mp hnotrows
    obtain ⟨t, ht⟩ := not_forall.mp hν
    obtain ⟨hcore, hN⟩ := not_or.mp ht
    have hcore' := lt_of_not_ge hcore
    have hSh : E ν t ⊆ Set.Ioi (trialMesh : ℝ) :=
      fun p hp => (fcb_activation ν t).trans hp.1
    have htail := physicalSourceCountMeasure_finite_tail 40 (trialMesh : ℝ) fcb_hpos
      Y n x hY (fun i a => (hx i a).1)
    rw [← Measure.restrict_eq_self N hSh, htail] at hN
    simp only [Measure.finsetSum_apply] at hN
    obtain ⟨i, _, hi⟩ := Finset.exists_ne_zero_of_sum_ne_zero hN
    obtain ⟨a, _, ha⟩ := Finset.exists_ne_zero_of_sum_ne_zero hi
    have hpa : x i a ∈ E ν t :=
      Set.mem_of_indicator_ne_zero (f := (1 : ℝ → ℝ≥0∞))
        (by simpa only [Measure.dirac_apply] using ha)
    have hv := physicalSource_finite_offender_cover 0 40 rfl Y n x hY hx hm ν t (Or.inl rfl)
      (fun hk => False.elim (hk rfl)) (x i a) ⟨i, a, rfl⟩ hpa.1 hcore'
      (by simpa only [↓reduceIte] using hpa.2)
    exact hv
  · intro Y n x hY hx X
    simpa only [Fin.coe_ofNat_eq_mod, Nat.reduceMod, Nat.reduceMul,
      Nat.reduceAdd, Fin.reduceFinMk, ↓reduceIte] using
      physicalSource_finite_inner_event_cover 0 Y n x hY hx
  · intro Y n x hY hx X
    simpa only [Fin.coe_ofNat_eq_mod, Nat.reduceMod, Nat.reduceMul,
      Nat.reduceAdd, Fin.reduceFinMk, Fin.reduceEq, ↓reduceIte] using
      physicalSource_finite_inner_event_cover 1 Y n x hY hx

theorem physicalSource_actual_event_cover :
    (∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure),
      trialOuterMask X * (1 - physicalSourceOuterSupport X) ≤
        (∑ j ∈ Finset.range (physicalSourceRowCount 0), physicalSourceCover 0 j X) +
          ∑ j ∈ Finset.range (physicalSourceRowCount 1), physicalSourceCover 1 j X) ∧
    (∀ᵐ Y ∂Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure),
      trialBaseMask Y * (1 - physicalSourceInnerSupport 0 Y) ≤
        (∑ j ∈ Finset.range (physicalSourceRowCount 2), physicalSourceCover 2 j Y) +
          ∑ j ∈ Finset.range (physicalSourceRowCount 3), physicalSourceCover 3 j Y) ∧
    (∀ᵐ Y ∂Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure),
      trialEnlargedMask Y * (1 - physicalSourceInnerSupport 1 Y) ≤
        (∑ j ∈ Finset.range (physicalSourceRowCount 4), physicalSourceCover 4 j Y) +
          ∑ j ∈ Finset.range (physicalSourceRowCount 5), physicalSourceCover 5 j Y) := by
  classical
  let κ : ℝ := trialLargestCap
  let c : ℝ≥0∞ := ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ)
  have hκ : 0 < κ := Rat.cast_pos.mpr trial_fixed_positive_data.2.2.1
  have hh : 0 < (trialMesh : ℝ) := Rat.cast_pos.mpr trial_fixed_positive_data.2.1
  let : IsProbabilityMeasure (fragmentLaw κ) :=
    fragmentLaw_isProbabilityMeasure κ
  let : IsFiniteMeasure trialPhysicalMeasure := trialPhysicalMeasure_finite_mass.1
  have hpi (d : ℕ) :
      Measure.pi (fun _ : Fin d => trialPhysicalMeasure) =
        c ^ d • Measure.pi (fun _ : Fin d => fragmentLaw κ) := by
    apply Measure.pi_eq
    intro S _hS
    rw [Measure.smul_apply, Measure.pi_pi]
    change c ^ d * (∏ i : Fin d, fragmentLaw κ (S i)) =
      ∏ i : Fin d, c * fragmentLaw κ (S i)
    rw [Finset.prod_mul_distrib]
    simp only [Finset.prod_const, Finset.card_univ, Fintype.card_fin]
  have htransfer (d : ℕ) (P : (Fin d → FiniteMeasure ℝ) → Prop)
      (hP : MeasurableSet {X | P X})
      (hfinite : ∀ (Y : Fin d → FiniteMeasure ℝ) (n : Fin d → ℕ)
        (x : (i : Fin d) → Fin (n i) → ℝ),
        (∀ i, (Y i).restrict (Set.Ioc (0 : ℝ) (trialMesh : ℝ)) = Y i) →
        (∀ i a, (trialMesh : ℝ) < x i a ∧ x i a ≤ κ) →
        P (fun i => Y i + weightedEmpirical (n i) (x i))) :
      ∀ᵐ X ∂Measure.pi (fun _ : Fin d => trialPhysicalMeasure), P X := by
    rw [hpi d]
    exact Measure.ae_smul_measure
      (fragmentLaw_ae_finite_tail_elim
        κ (trialMesh : ℝ) hκ hh d P hP hfinite) (c ^ d)
  have hsum (g : Fin 6) (d : ℕ) :
      Measurable (fun X : Fin d → FiniteMeasure ℝ =>
        ∑ j ∈ Finset.range (physicalSourceRowCount g), physicalSourceCover g j X) :=
    Finset.measurable_sum _ fun j _ => (physicalSourceCover_regular g j d).1
  obtain ⟨houter, hinner⟩ := physicalSourceSupport_measurable
  refine ⟨htransfer 40 _ ?_ physicalSource_finite_event_cover.1,
    htransfer 39 _ ?_ physicalSource_finite_event_cover.2.1,
    htransfer 39 _ ?_ physicalSource_finite_event_cover.2.2⟩
  · exact measurableSet_le
      (trial_data_measurable.2.1.mul (measurable_const.sub houter))
      ((hsum 0 40).add (hsum 1 40))
  · exact measurableSet_le
      (trial_data_measurable.2.2.1.mul (measurable_const.sub (hinner 0)))
      ((hsum 2 39).add (hsum 3 39))
  · exact measurableSet_le
      (trial_data_measurable.2.2.2.1.mul (measurable_const.sub (hinner 1)))
      ((hsum 4 39).add (hsum 5 39))

theorem trialSource_projection_regular :
    let e : (Fin 40 → FiniteMeasure ℝ) → ℝ := fun X =>
      (1 - physicalSourceOuterSupport X) * trialStepFunction X
    let U : Fin 40 → (Fin 39 → FiniteMeasure ℝ) → ℝ := fun i Y =>
      ∫ Z : FiniteMeasure ℝ, trialSourceStepFunction (i.insertNth Z Y)
        ∂trialPhysicalMeasure
    let W : Fin 40 → (Fin 39 → FiniteMeasure ℝ) → ℝ := fun i Y =>
      ∫ Z : FiniteMeasure ℝ, e (i.insertNth Z Y) ∂trialPhysicalMeasure
    Measurable trialSourceStepFunction ∧
      Measurable physicalSourceFaceMultiplier ∧
      (∀ X : Fin 40 → FiniteMeasure ℝ,
        physicalSourceOuterSupport X = 0 ∨ physicalSourceOuterSupport X = 1) ∧
      (∀ (ν : Fin 2) (Y : Fin 39 → FiniteMeasure ℝ),
        physicalSourceInnerSupport ν Y = 0 ∨ physicalSourceInnerSupport ν Y = 1) ∧
      (∀ Y : Fin 39 → FiniteMeasure ℝ,
        let δ : ℝ :=
          (44415113 / 5000000000 : ℝ) * trialBaseMask Y *
              (1 - physicalSourceInnerSupport 0 Y * physicalSourceInnerSupport 1 Y) +
            (2479900401 / 2500000000 : ℝ) * trialEnlargedMask Y *
              (1 - physicalSourceInnerSupport 1 Y);
        -|(-843183 / 1000000000 : ℝ)| ≤ physicalSourceFaceMultiplier Y ∧
          |physicalSourceFaceMultiplier Y| ≤ physicalSourceFaceWeight Y ∧
          (44415113 / 5000000000 : ℝ) * trialBaseMask Y +
              (2479900401 / 2500000000 : ℝ) * trialEnlargedMask Y +
              (-843183 / 1000000000 : ℝ) * trialFullMask Y -
                physicalSourceFaceMultiplier Y = δ ∧
          0 ≤ δ ∧
          δ ≤ (44415113 / 5000000000 : ℝ) * trialBaseMask Y *
              (1 - physicalSourceInnerSupport 0 Y) +
            (1000843183 / 1000000000 : ℝ) * trialEnlargedMask Y *
              (1 - physicalSourceInnerSupport 1 Y)) ∧
      (∀ X : Fin 40 → FiniteMeasure ℝ,
        (2742997 / 2624989 : ℝ) < ∑ i : Fin 40, ((X i).mass : ℝ) →
          trialSourceStepFunction X = 0 ∧ e X = 0) ∧
      ∃ C : ℝ, 0 < C ∧
        (∀ X : Fin 40 → FiniteMeasure ℝ,
          ‖trialSourceStepFunction X‖ ≤ C ∧ ‖e X‖ ≤ C) ∧
        ∀ i : Fin 40,
          Measurable (U i) ∧ Measurable (W i) ∧
          ∀ Y : Fin 39 → FiniteMeasure ℝ,
            ‖U i Y‖ ≤ C ∧ ‖W i Y‖ ≤ C ∧
            Integrable (fun Z : FiniteMeasure ℝ =>
              trialSourceStepFunction (i.insertNth Z Y)) trialPhysicalMeasure ∧
            Integrable (fun Z : FiniteMeasure ℝ => e (i.insertNth Z Y))
              trialPhysicalMeasure ∧
            trialMarginal i Y = U i Y + W i Y ∧
            (trialFullMask Y = 0 → U i Y = 0 ∧ W i Y = 0) := by
  classical
  intro e U W
  let : IsFiniteMeasure trialPhysicalMeasure := trialPhysicalMeasure_finite_mass.1
  obtain ⟨hPmeas, hInnerMeas⟩ := physicalSourceSupport_measurable
  have hFmeas : Measurable trialStepFunction := trial_data_measurable.2.2.2.2.2.1
  have hGmeas : Measurable trialSourceStepFunction := hPmeas.mul hFmeas
  have hemeas : Measurable e := (measurable_const.sub hPmeas).mul hFmeas
  have hmmeas : Measurable physicalSourceFaceMultiplier :=
    ((((measurable_const.mul trial_data_measurable.2.2.1).mul
        (hInnerMeas 0)).mul (hInnerMeas 1)).add
      ((measurable_const.mul trial_data_measurable.2.2.2.1).mul (hInnerMeas 1))).add
        (measurable_const.mul trial_data_measurable.2.2.2.2.1)
  have hPbit (X : Fin 40 → FiniteMeasure ℝ) :
      physicalSourceOuterSupport X = 0 ∨ physicalSourceOuterSupport X = 1 := by
    unfold physicalSourceOuterSupport
    exact Or.symm (ite_eq_or_eq _ _ _)
  have hInnerBit (ν : Fin 2) (Y : Fin 39 → FiniteMeasure ℝ) :
      physicalSourceInnerSupport ν Y = 0 ∨ physicalSourceInnerSupport ν Y = 1 := by
    unfold physicalSourceInnerSupport
    exact Or.symm (ite_eq_or_eq _ _ _)
  refine ⟨hGmeas, hmmeas, hPbit, hInnerBit, ?_, ?_, ?_⟩
  · intro Y
    obtain ⟨h₀, h₁, hf, h₀₁, h₁f, _, _⟩ := trial_mask_values_and_nesting.2 Y
    obtain ho | ho := hInnerBit 0 Y <;>
      obtain hn | hn := hInnerBit 1 Y <;>
      obtain h₀ | h₀ := h₀ <;> obtain h₁ | h₁ := h₁ <;> obtain hf | hf := hf
    all_goals norm_num [h₀, h₁] at h₀₁
    all_goals norm_num [h₁, hf] at h₁f
    all_goals norm_num [physicalSourceFaceMultiplier, physicalSourceFaceWeight,
      ho, hn, h₀, h₁, hf]
  · intro X htotal
    have hzero : trialStepFunction X = 0 := by
      by_contra hX
      have hm : trialOuterMask X = 1 :=
        (trial_mask_values_and_nesting.1 X).resolve_left
          (fun hz => hX (by
            simp only [trialStepFunction_eq_cellExpression, hz, zero_mul]))
      dsimp only [trialOuterMask] at hm
      have hm' := (Ne.ite_eq_left_iff (one_ne_zero : (1 : ℝ) ≠ 0)).mp hm
      have hsize := (physicalSource_mask_global_bounds 0 40 rfl X (by
        generalize hr : (∑ i : Fin 40, trialCellIndex (X i)) = r at hm' ⊢
        simpa [physicalSourceAlignedCapIndex] using hm')).1
      norm_num [physicalSourceOuterRadius, trialMesh] at hsize
      exact (not_le_of_gt htotal) hsize
    simp only [trialSourceStepFunction, e, hzero, mul_zero, and_self]
  · obtain ⟨M, hM, hMF, _⟩ := trial_integrable_marginals
    have hbound (X : Fin 40 → FiniteMeasure ℝ) :
        ‖trialSourceStepFunction X‖ ≤ M ∧ ‖e X‖ ≤ M := by
      rcases hPbit X with hP | hP
      · simpa only [trialSourceStepFunction, e, hP, zero_mul, sub_zero,
          one_mul, norm_zero] using And.intro hM.le (hMF X)
      · simpa only [trialSourceStepFunction, e, hP, one_mul, sub_self,
          zero_mul, norm_zero] using And.intro (hMF X) hM.le
    let C : ℝ := max M (M * trialPhysicalMeasure.real Set.univ)
    have hins (f : (Fin 40 → FiniteMeasure ℝ) → ℝ) (hf : Measurable f)
        (i : Fin 40) :
        Measurable (fun Z : FiniteMeasure ℝ × (Fin 39 → FiniteMeasure ℝ) =>
          f (i.insertNth Z.1 Z.2)) :=
      hf.comp
        (MeasurableEquiv.piFinSuccAbove (fun _ : Fin 40 => FiniteMeasure ℝ) i).symm.measurable
    refine ⟨C, lt_max_of_lt_left hM, fun X => ⟨le_max_of_le_left (hbound X).1,
      le_max_of_le_left (hbound X).2⟩, ?_⟩
    intro i
    have hUmeas : Measurable (U i) :=
      ((hins trialSourceStepFunction hGmeas i).stronglyMeasurable.integral_prod_left'
        (μ := trialPhysicalMeasure)).measurable
    have hWmeas : Measurable (W i) :=
      ((hins e hemeas i).stronglyMeasurable.integral_prod_left'
        (μ := trialPhysicalMeasure)).measurable
    refine ⟨hUmeas, hWmeas, ?_⟩
    intro Y
    have hUbound : ‖U i Y‖ ≤ C :=
      le_max_of_le_right (norm_integral_le_of_norm_le_const (μ := trialPhysicalMeasure)
        (ae_of_all _ fun Z => (hbound (i.insertNth Z Y)).1))
    have hWbound : ‖W i Y‖ ≤ C :=
      le_max_of_le_right (norm_integral_le_of_norm_le_const (μ := trialPhysicalMeasure)
        (ae_of_all _ fun Z => (hbound (i.insertNth Z Y)).2))
    have hUint : Integrable (fun Z : FiniteMeasure ℝ =>
        trialSourceStepFunction (i.insertNth Z Y)) trialPhysicalMeasure :=
      Integrable.of_bound
        ((hins trialSourceStepFunction hGmeas i).comp
          (measurable_id.prodMk measurable_const)).aestronglyMeasurable
        M (ae_of_all _ fun Z => (hbound (i.insertNth Z Y)).1)
    have hWint : Integrable (fun Z : FiniteMeasure ℝ =>
        e (i.insertNth Z Y)) trialPhysicalMeasure :=
      Integrable.of_bound
        ((hins e hemeas i).comp
          (measurable_id.prodMk measurable_const)).aestronglyMeasurable
        M (ae_of_all _ fun Z => (hbound (i.insertNth Z Y)).2)
    refine ⟨hUbound, hWbound, hUint, hWint, ?_, ?_⟩
    · dsimp only [trialMarginal, U, W]
      rw [← integral_add hUint hWint]
      apply integral_congr_ae
      filter_upwards [] with Z
      dsimp only [trialSourceStepFunction, e]
      ring
    · intro hfull
      have hzero (Z : FiniteMeasure ℝ) :
          trialStepFunction (i.insertNth Z Y) = 0 := by
        by_contra hZ
        have h := trialStepFunction_support (i.insertNth Z Y) hZ
        have hretained : (∑ j : Fin 39, trialCellIndex (Y j)) ≤ 98263 := by
          have hr := h.1
          rw [Fin.sum_univ_succAbove _ i] at hr
          simp only [Fin.insertNth_apply_same, Fin.insertNth_apply_succAbove] at hr
          omega
        have hcap (j : Fin 39) :
            (Y j : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0 := by
          simpa only [Fin.insertNth_apply_succAbove] using h.2.2 (i.succAbove j)
        have hval : trialFullMask Y = 1 := by
          simp only [trialFullMask, hretained, hcap, implies_true, and_self, ite_true]
        exact zero_ne_one (hfull.symm.trans hval)
      constructor
      · simp only [U, trialSourceStepFunction, hzero, mul_zero, integral_zero]
      · simp only [W, e, hzero, mul_zero, integral_zero]

theorem trialSource_exact_quadratic_decomposition :
    let μ₄₀ := Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)
    let μ₃₉ := Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)
    let e : (Fin 40 → FiniteMeasure ℝ) → ℝ := fun X =>
      (1 - physicalSourceOuterSupport X) * trialStepFunction X
    let U : Fin 40 → (Fin 39 → FiniteMeasure ℝ) → ℝ := fun i Y =>
      ∫ Z : FiniteMeasure ℝ, trialSourceStepFunction (i.insertNth Z Y)
        ∂trialPhysicalMeasure
    let W : Fin 40 → (Fin 39 → FiniteMeasure ℝ) → ℝ := fun i Y =>
      ∫ Z : FiniteMeasure ℝ, e (i.insertNth Z Y) ∂trialPhysicalMeasure
    let α : ℝ := (∫ X, e X ^ 2 ∂μ₄₀) / trialPhysicalNormalizer
    let I : ℝ := (∫ X, trialSourceStepFunction X ^ 2 ∂μ₄₀) /
      trialPhysicalNormalizer
    let J : ℝ := (∑ i : Fin 40, ∫ Y,
      physicalSourceFaceMultiplier Y * U i Y ^ 2 ∂μ₃₉) / trialPhysicalNormalizer
    let Bₑ : ℝ := (∑ i : Fin 40, ∫ Y,
      physicalSourceFaceMultiplier Y * W i Y ^ 2 ∂μ₃₉) / trialPhysicalNormalizer
    let cross : ℝ := (∑ i : Fin 40, ∫ Y,
      physicalSourceFaceMultiplier Y * W i Y * trialMarginal i Y ∂μ₃₉) /
        trialPhysicalNormalizer
    let β : ℝ := (∑ i : Fin 40, ∫ Y,
      ((44415113 / 5000000000 : ℝ) * trialBaseMask Y *
          (1 - physicalSourceInnerSupport 0 Y * physicalSourceInnerSupport 1 Y) +
        (2479900401 / 2500000000 : ℝ) * trialEnlargedMask Y *
          (1 - physicalSourceInnerSupport 1 Y)) * trialMarginal i Y ^ 2 ∂μ₃₉) /
        trialPhysicalNormalizer
    0 ≤ α ∧ I = trialIH - α ∧
      J = trialJLambdaH - β - 2 * cross + Bₑ ∧
      cross = (∑ i : Fin 40, ∫ X,
        physicalSourceFaceMultiplier (i.removeNth X) * e X *
          trialMarginal i (i.removeNth X) ∂μ₄₀) / trialPhysicalNormalizer ∧
      -4 * |(-843183 / 1000000000 : ℝ)| * α ≤ Bₑ := by
  classical
  intro μ₄₀ μ₃₉ e U W α I J Bₑ cross β
  let cap : (Fin 39 → FiniteMeasure ℝ) → ℝ := fun Y =>
    (44415113 / 5000000000 : ℝ) * trialBaseMask Y +
      (2479900401 / 2500000000 : ℝ) * trialEnlargedMask Y +
      (-843183 / 1000000000 : ℝ) * trialFullMask Y
  let δ : (Fin 39 → FiniteMeasure ℝ) → ℝ := fun Y =>
    (44415113 / 5000000000 : ℝ) * trialBaseMask Y *
        (1 - physicalSourceInnerSupport 0 Y * physicalSourceInnerSupport 1 Y) +
      (2479900401 / 2500000000 : ℝ) * trialEnlargedMask Y *
        (1 - physicalSourceInnerSupport 1 Y)
  let : IsFiniteMeasure trialPhysicalMeasure := trialPhysicalMeasure_finite_mass.1
  have hden : 0 < trialPhysicalNormalizer := trial_fixed_positive_data.2.2.2.2.2
  obtain ⟨_, hm, hP, _, hmask, hsupport, C, _, hbound, hUW⟩ :=
    trialSource_projection_regular
  obtain ⟨D, _, _, _, hF2, hV⟩ := trial_integrable_marginals
  have hemeas : Measurable e :=
    (measurable_const.sub physicalSourceSupport_measurable.1).mul
      trial_data_measurable.2.2.2.2.2.1
  have heLp : MemLp e 2 μ₄₀ :=
    MemLp.of_bound hemeas.aestronglyMeasurable C
      (ae_of_all _ fun X => (hbound X).2)
  have hmnorm (Y : Fin 39 → FiniteMeasure ℝ) :
      ‖physicalSourceFaceMultiplier Y‖ ≤ (1 : ℝ) := by
    have hw : physicalSourceFaceWeight Y ≤ 1 := by
      unfold physicalSourceFaceWeight
      split_ifs <;> norm_num
    exact (Real.norm_eq_abs _).trans_le ((hmask Y).2.1.trans hw)
  have hcapmeas : Measurable cap :=
    ((measurable_const.mul trial_data_measurable.2.2.1).add
      (measurable_const.mul trial_data_measurable.2.2.2.1)).add
      (measurable_const.mul trial_data_measurable.2.2.2.2.1)
  have hcapnorm (Y : Fin 39 → FiniteMeasure ℝ) : ‖cap Y‖ ≤ (2 : ℝ) := by
    obtain ⟨hb, he, hf, _⟩ := trial_mask_values_and_nesting.2 Y
    rcases hb with hb | hb <;> rcases he with he | he <;>
      rcases hf with hf | hf <;> norm_num [cap, hb, he, hf]
  have hδ (Y : Fin 39 → FiniteMeasure ℝ) :
      cap Y - physicalSourceFaceMultiplier Y = δ Y := (hmask Y).2.2.1
  have hVW (i : Fin 40) (Y : Fin 39 → FiniteMeasure ℝ) :
      trialMarginal i Y = U i Y + W i Y := ((hUW i).2.2 Y).2.2.2.2.1
  have hWLp (i : Fin 40) : MemLp (W i) 2 μ₃₉ :=
    MemLp.of_bound ((hUW i).2.1).aestronglyMeasurable C
      (ae_of_all _ fun Y => ((hUW i).2.2 Y).2.1)
  have hmW2 (i : Fin 40) :
      Integrable (fun Y => physicalSourceFaceMultiplier Y * W i Y ^ 2) μ₃₉ :=
    (hWLp i).integrable_sq.bdd_mul hm.aestronglyMeasurable (ae_of_all _ hmnorm)
  have hmV2 (i : Fin 40) : Integrable
      (fun Y => physicalSourceFaceMultiplier Y * trialMarginal i Y ^ 2) μ₃₉ :=
    (hV i).2.2.2.1.bdd_mul hm.aestronglyMeasurable (ae_of_all _ hmnorm)
  have hcapV2 (i : Fin 40) :
      Integrable (fun Y => cap Y * trialMarginal i Y ^ 2) μ₃₉ :=
    (hV i).2.2.2.1.bdd_mul hcapmeas.aestronglyMeasurable (ae_of_all _ hcapnorm)
  have hδV2 (i : Fin 40) :
      Integrable (fun Y => δ Y * trialMarginal i Y ^ 2) μ₃₉ := by
    simpa only [← sub_mul, hδ] using (hcapV2 i).sub' (hmV2 i)
  have hcrossint (i : Fin 40) : Integrable
      (fun Y => physicalSourceFaceMultiplier Y * W i Y * trialMarginal i Y) μ₃₉ :=
    ((MemLp.integrable one_le_two (hWLp i)).bdd_mul
      hm.aestronglyMeasurable (ae_of_all _ hmnorm)).mul_bdd
      (hV i).1.aestronglyMeasurable (ae_of_all _ (hV i).2.1)
  have hroot : (∫ X, trialSourceStepFunction X ^ 2 ∂μ₄₀) =
      (∫ X, trialStepFunction X ^ 2 ∂μ₄₀) - ∫ X, e X ^ 2 ∂μ₄₀ := by
    rw [← integral_sub hF2 heLp.integrable_sq]
    apply integral_congr_ae
    filter_upwards [] with X
    rcases hP X with hX | hX <;> simp [trialSourceStepFunction, e, hX]
  have hI : I = trialIH - α := by
    dsimp only [I, trialIH, α, μ₄₀]
    rw [hroot, sub_div]
  have hcaprow (i : Fin 40) :
      (∫ Y, cap Y * trialMarginal i Y ^ 2 ∂μ₃₉) =
        (∫ Y, trialBaseMask Y * trialMarginal i Y ^ 2 ∂μ₃₉) +
        ((2479900401 / 2500000000 : ℝ) + (-843183 / 1000000000 : ℝ)) *
          (∫ Y, trialEnlargedMask Y * (1 - trialBaseMask Y) *
            trialMarginal i Y ^ 2 ∂μ₃₉) +
        (-843183 / 1000000000 : ℝ) *
          (∫ Y, trialFullMask Y * (1 - trialEnlargedMask Y) *
            trialMarginal i Y ^ 2 ∂μ₃₉) := by
    obtain ⟨_, _, _, _, _, hb, hp, ht⟩ := hV i
    calc
      _ = ∫ Y,
          trialBaseMask Y * trialMarginal i Y ^ 2 +
          ((2479900401 / 2500000000 : ℝ) + (-843183 / 1000000000 : ℝ)) *
            (trialEnlargedMask Y * (1 - trialBaseMask Y) * trialMarginal i Y ^ 2) +
          (-843183 / 1000000000 : ℝ) *
            (trialFullMask Y * (1 - trialEnlargedMask Y) * trialMarginal i Y ^ 2)
          ∂μ₃₉ := by
        apply integral_congr_ae
        filter_upwards [] with Y
        obtain ⟨_, _, _, _, _, hBE, hEF⟩ := trial_mask_values_and_nesting.2 Y
        rw [hBE, hEF]
        dsimp only [cap]
        ring
      _ = _ := by
        rw [integral_add
            (hb.fun_add (hp.const_mul
              ((2479900401 / 2500000000 : ℝ) + (-843183 / 1000000000 : ℝ))))
            (ht.const_mul (-843183 / 1000000000 : ℝ)),
          integral_add hb
            (hp.const_mul
              ((2479900401 / 2500000000 : ℝ) + (-843183 / 1000000000 : ℝ))),
          integral_const_mul, integral_const_mul]
  have hcap_total :
      (∑ i : Fin 40, ∫ Y, cap Y * trialMarginal i Y ^ 2 ∂μ₃₉) /
          trialPhysicalNormalizer = trialJLambdaH := by
    dsimp only [trialJLambdaH, trialJ0, trialJPlus, trialJTail]
    simp_rw [hcaprow]
    simp only [Finset.sum_add_distrib, ← Finset.mul_sum, add_div, mul_div_assoc, μ₃₉]
  have hrow (i : Fin 40) :
      (∫ Y, physicalSourceFaceMultiplier Y * U i Y ^ 2 ∂μ₃₉) =
        (∫ Y, cap Y * trialMarginal i Y ^ 2 ∂μ₃₉) -
        (∫ Y, δ Y * trialMarginal i Y ^ 2 ∂μ₃₉) -
        2 * (∫ Y, physicalSourceFaceMultiplier Y * W i Y * trialMarginal i Y ∂μ₃₉) +
        (∫ Y, physicalSourceFaceMultiplier Y * W i Y ^ 2 ∂μ₃₉) := by
    calc
      _ = ∫ Y,
          cap Y * trialMarginal i Y ^ 2 - δ Y * trialMarginal i Y ^ 2 -
            2 * (physicalSourceFaceMultiplier Y * W i Y * trialMarginal i Y) +
            physicalSourceFaceMultiplier Y * W i Y ^ 2 ∂μ₃₉ := by
        apply integral_congr_ae
        filter_upwards [] with Y
        rw [← hδ Y, hVW i Y]
        ring
      _ = _ := by
        rw [integral_add
            (((hcapV2 i).sub' (hδV2 i)).sub' ((hcrossint i).const_mul 2)) (hmW2 i),
          integral_sub ((hcapV2 i).sub' (hδV2 i)) ((hcrossint i).const_mul 2),
          integral_sub (hcapV2 i) (hδV2 i), integral_const_mul]
  have hJ : J = trialJLambdaH - β - 2 * cross + Bₑ := by
    dsimp only [J, β, cross, Bₑ]
    rw [← hcap_total]
    simp_rw [hrow, δ]
    simp only [Finset.sum_add_distrib, Finset.sum_sub_distrib, ← Finset.mul_sum,
      add_div, sub_div, mul_div_assoc]
  have hcrossrow (i : Fin 40) :
      (∫ Y, physicalSourceFaceMultiplier Y * W i Y * trialMarginal i Y ∂μ₃₉) =
        ∫ X, physicalSourceFaceMultiplier (i.removeNth X) * e X *
          trialMarginal i (i.removeNth X) ∂μ₄₀ := by
    let ins : (FiniteMeasure ℝ × (Fin 39 → FiniteMeasure ℝ)) ≃ᵐ
        (Fin 40 → FiniteMeasure ℝ) :=
      (MeasurableEquiv.piFinSuccAbove (fun _ : Fin 40 => FiniteMeasure ℝ) i).symm
    have hins : MeasurePreserving ins (trialPhysicalMeasure.prod μ₃₉) μ₄₀ :=
      (measurePreserving_piFinSuccAbove (fun _ : Fin 40 => trialPhysicalMeasure) i).symm
    let q : (Fin 40 → FiniteMeasure ℝ) → ℝ := fun X =>
      physicalSourceFaceMultiplier (i.removeNth X) * e X * trialMarginal i (i.removeNth X)
    have hremove : Measurable (fun X : Fin 40 → FiniteMeasure ℝ => i.removeNth X) :=
      measurable_pi_lambda _ fun j => measurable_pi_apply (i.succAbove j)
    have hq : Integrable q μ₄₀ :=
      ((MemLp.integrable one_le_two heLp).bdd_mul
        (hm.comp hremove).aestronglyMeasurable
        (ae_of_all _ fun X => hmnorm (i.removeNth X))).mul_bdd
        ((hV i).1.comp hremove).aestronglyMeasurable
        (ae_of_all _ fun X => (hV i).2.1 (i.removeNth X))
    calc
      _ = ∫ Y, ∫ Z : FiniteMeasure ℝ, q (ins (Z, Y)) ∂trialPhysicalMeasure ∂μ₃₉ := by
        simp only [q, ins, MeasurableEquiv.piFinSuccAbove_symm_apply,
          Fin.insertNthEquiv, Equiv.coe_fn_mk, Fin.removeNth_insertNth,
          W, integral_mul_const, integral_const_mul]
      _ = ∫ Z, q (ins Z) ∂trialPhysicalMeasure.prod μ₃₉ :=
        (integral_prod_symm (fun Z => q (ins Z))
          (hins.integrable_comp_of_integrable hq)).symm
      _ = _ := hins.integral_comp' q
  have hcross : cross = (∑ i : Fin 40, ∫ X,
      physicalSourceFaceMultiplier (i.removeNth X) * e X *
        trialMarginal i (i.removeNth X) ∂μ₄₀) / trialPhysicalNormalizer := by
    simp only [cross, hcrossrow]
  have hC4 : (∑ i : Fin 40, ∫ Y, W i Y ^ 2 ∂μ₃₉) ≤
      4 * ∫ X, e X ^ 2 ∂μ₄₀ :=
    trial_physical_face_operator_bound e heLp
      (ae_of_all _ fun X hX => (hsupport X hX).2)
  have hsource_lower :
      -|(-843183 / 1000000000 : ℝ)| * (∑ i : Fin 40, ∫ Y, W i Y ^ 2 ∂μ₃₉) ≤
        ∑ i : Fin 40, ∫ Y, physicalSourceFaceMultiplier Y * W i Y ^ 2 ∂μ₃₉ := by
    rw [Finset.mul_sum]
    apply Finset.sum_le_sum
    intro i _
    rw [← integral_const_mul]
    exact integral_mono ((hWLp i).integrable_sq.const_mul (-|(-843183 / 1000000000 : ℝ)|))
      (hmW2 i) fun Y => mul_le_mul_of_nonneg_right (hmask Y).1 (sq_nonneg _)
  have hraw :
      -4 * |(-843183 / 1000000000 : ℝ)| * (∫ X, e X ^ 2 ∂μ₄₀) ≤
        ∑ i : Fin 40, ∫ Y, physicalSourceFaceMultiplier Y * W i Y ^ 2 ∂μ₃₉ := by
    calc
      _ = -|(-843183 / 1000000000 : ℝ)| * (4 * ∫ X, e X ^ 2 ∂μ₄₀) := by ring
      _ ≤ -|(-843183 / 1000000000 : ℝ)| *
          (∑ i : Fin 40, ∫ Y, W i Y ^ 2 ∂μ₃₉) :=
        mul_le_mul_of_nonpos_left hC4 (neg_nonpos.mpr (abs_nonneg _))
      _ ≤ _ := hsource_lower
  refine ⟨div_nonneg (integral_nonneg fun _ => sq_nonneg _) hden.le,
    hI, hJ, hcross, ?_⟩
  simpa only [α, Bₑ, mul_div_assoc] using
    div_le_div_of_nonneg_right hraw hden.le

theorem trialSource_actual_loss_cover :
    let μ₄₀ := Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)
    let μ₃₉ := Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)
    let β : ℝ := (∑ i : Fin 40, ∫ Y,
      ((44415113 / 5000000000 : ℝ) * trialBaseMask Y *
          (1 - physicalSourceInnerSupport 0 Y * physicalSourceInnerSupport 1 Y) +
        (2479900401 / 2500000000 : ℝ) * trialEnlargedMask Y *
          (1 - physicalSourceInnerSupport 1 Y)) * trialMarginal i Y ^ 2 ∂μ₃₉) /
        trialPhysicalNormalizer
    let old : ℝ := (∑ i : Fin 40, ∫ Y,
      trialBaseMask Y * (1 - physicalSourceInnerSupport 0 Y) *
        trialMarginal i Y ^ 2 ∂μ₃₉) / trialPhysicalNormalizer
    let new : ℝ := (∑ i : Fin 40, ∫ Y,
      trialEnlargedMask Y * (1 - physicalSourceInnerSupport 1 Y) *
        trialMarginal i Y ^ 2 ∂μ₃₉) / trialPhysicalNormalizer
    let inner : ℝ :=
      (44415113 / 5000000000 : ℝ) *
        ((∑ j : Fin innerBaseOrderTwoBounds.length,
            physicalSourceInnerMass 2 j.val) +
          ∑ j : Fin innerBaseOrderFiveHalvesBounds.length,
            physicalSourceInnerMass 3 j.val) +
      (1000843183 / 1000000000 : ℝ) *
        ((∑ j : Fin innerEnlargedOrderTwoBounds.length,
            physicalSourceInnerMass 4 j.val) +
          ∑ j : Fin innerEnlargedOrderFiveHalvesBounds.length,
            physicalSourceInnerMass 5 j.val)
    let mixed : Fin 6 → ℕ → ℝ := fun g j =>
      (∑ i : Fin 40, ∫ X,
        2 * physicalSourceCover g j X * physicalSourceFaceWeight (i.removeNth X) *
          |trialStepFunction X * trialMarginal i (i.removeNth X)| ∂μ₄₀) /
            trialPhysicalNormalizer
    0 ≤ β ∧
      β ≤ (44415113 / 5000000000 : ℝ) * old +
        (1000843183 / 1000000000 : ℝ) * new ∧
      (44415113 / 5000000000 : ℝ) * old +
        (1000843183 / 1000000000 : ℝ) * new ≤ inner ∧
      2 * ((∑ i : Fin 40, ∫ X,
        physicalSourceFaceMultiplier (i.removeNth X) *
          ((1 - physicalSourceOuterSupport X) * trialStepFunction X) *
            trialMarginal i (i.removeNth X) ∂μ₄₀) / trialPhysicalNormalizer) ≤
        (∑ j : Fin outerOrderTwoBounds.length, mixed 0 j.val) +
          ∑ j : Fin outerOrderFiveHalvesBounds.length, mixed 1 j.val := by
  classical
  intro μ₄₀ μ₃₉ β old new inner mixed
  let : IsFiniteMeasure trialPhysicalMeasure := trialPhysicalMeasure_finite_mass.1
  have hden : 0 < trialPhysicalNormalizer := trial_fixed_positive_data.2.2.2.2.2
  obtain ⟨C, _, _, hFint, _, hV⟩ := trial_integrable_marginals
  obtain ⟨_, hm, hP, hO, hδ, _, _⟩ := trialSource_projection_regular
  have hsupport := physicalSourceSupport_measurable
  have hcover := physicalSource_actual_event_cover
  let a : ℝ := 44415113 / 5000000000
  let b : ℝ := 1000843183 / 1000000000
  have ha : 0 ≤ a := by norm_num [a]
  have hb : 0 ≤ b := by norm_num [b]
  let H : Fin 2 → (Fin 39 → FiniteMeasure ℝ) → ℝ := fun ν =>
    if ν = 0 then trialBaseMask else trialEnlargedMask
  let δ : (Fin 39 → FiniteMeasure ℝ) → ℝ := fun Y =>
    (44415113 / 5000000000 : ℝ) * trialBaseMask Y *
        (1 - physicalSourceInnerSupport 0 Y * physicalSourceInnerSupport 1 Y) +
      (2479900401 / 2500000000 : ℝ) * trialEnlargedMask Y *
        (1 - physicalSourceInnerSupport 1 Y)
  let loss : Fin 2 → Fin 40 → (Fin 39 → FiniteMeasure ℝ) → ℝ := fun ν i Y =>
    H ν Y * (1 - physicalSourceInnerSupport ν Y) * trialMarginal i Y ^ 2
  let row : Fin 2 → Fin 6 → ℕ → Fin 40 → (Fin 39 → FiniteMeasure ℝ) → ℝ :=
    fun ν g j i Y => H ν Y * physicalSourceCover g j Y * trialMarginal i Y ^ 2
  let innerRow : Fin 2 → Fin 6 → ℕ → ℝ := fun ν g j =>
    (∑ i : Fin 40, ∫ Y, row ν g j i Y ∂μ₃₉) / trialPhysicalNormalizer
  have hHm (ν : Fin 2) : Measurable (H ν) := by
    dsimp only [H]
    split_ifs
    · exact trial_data_measurable.2.2.1
    · exact trial_data_measurable.2.2.2.1
  have hHv (ν : Fin 2) (Y : Fin 39 → FiniteMeasure ℝ) :
      H ν Y = 0 ∨ H ν Y = 1 := by
    dsimp only [H]
    split_ifs
    · exact (trial_mask_values_and_nesting.2 Y).1
    · exact (trial_mask_values_and_nesting.2 Y).2.1
  have hH0 (ν : Fin 2) (Y : Fin 39 → FiniteMeasure ℝ) : 0 ≤ H ν Y := by
    rcases hHv ν Y with h | h <;> simp [h]
  have hHnorm (ν : Fin 2) (Y : Fin 39 → FiniteMeasure ℝ) : ‖H ν Y‖ ≤ 1 := by
    rcases hHv ν Y with h | h <;> simp [h]
  have hHsq (ν : Fin 2) (Y : Fin 39 → FiniteMeasure ℝ) : H ν Y * H ν Y = H ν Y :=
    (IsIdempotentElem.iff_eq_zero_or_one.mpr (hHv ν Y)).eq
  have hfactor (ν : Fin 2) (Y : Fin 39 → FiniteMeasure ℝ) :
      0 ≤ H ν Y * (1 - physicalSourceInnerSupport ν Y) ∧
        H ν Y * (1 - physicalSourceInnerSupport ν Y) ≤ 1 := by
    rcases hHv ν Y with hH | hH <;> rcases hO ν Y with hS | hS <;> simp [hH, hS]
  have hLossInt (ν : Fin 2) (i : Fin 40) : Integrable (loss ν i) μ₃₉ := by
    apply (hV i).2.2.2.1.bdd_mul
      ((hHm ν).mul (measurable_const.sub (hsupport.2 ν))).aestronglyMeasurable
      (c := 1)
    filter_upwards [] with Y
    rw [Pi.mul_apply, Pi.sub_apply, Real.norm_eq_abs, abs_of_nonneg (hfactor ν Y).1]
    exact (hfactor ν Y).2
  have hδ0 (Y : Fin 39 → FiniteMeasure ℝ) : 0 ≤ δ Y := (hδ Y).2.2.2.1
  have hδle (Y : Fin 39 → FiniteMeasure ℝ) :
      δ Y ≤ a * (H 0 Y * (1 - physicalSourceInnerSupport 0 Y)) +
        b * (H 1 Y * (1 - physicalSourceInnerSupport 1 Y)) := by
    simpa only [δ, a, b, H, Fin.reduceEq, ↓reduceIte, mul_assoc] using (hδ Y).2.2.2.2
  have hδm : Measurable δ :=
    ((measurable_const.mul trial_data_measurable.2.2.1).mul
      (measurable_const.sub ((hsupport.2 0).mul (hsupport.2 1)))).add
        ((measurable_const.mul trial_data_measurable.2.2.2.1).mul
          (measurable_const.sub (hsupport.2 1)))
  have hδnorm (Y : Fin 39 → FiniteMeasure ℝ) : ‖δ Y‖ ≤ 2 := by
    rw [Real.norm_eq_abs, abs_of_nonneg (hδ0 Y)]
    calc
      δ Y ≤ a * (H 0 Y * (1 - physicalSourceInnerSupport 0 Y)) +
          b * (H 1 Y * (1 - physicalSourceInnerSupport 1 Y)) := hδle Y
      _ ≤ a * 1 + b * 1 := add_le_add
        (mul_le_mul_of_nonneg_left (hfactor 0 Y).2 ha)
        (mul_le_mul_of_nonneg_left (hfactor 1 Y).2 hb)
      _ ≤ 2 := by norm_num [a, b]
  have hδInt (i : Fin 40) :
      Integrable (fun Y => δ Y * trialMarginal i Y ^ 2) μ₃₉ :=
    (hV i).2.2.2.1.bdd_mul hδm.aestronglyMeasurable (ae_of_all _ hδnorm)
  have hRowInt (ν : Fin 2) (g : Fin 6) (j : ℕ) (i : Fin 40) :
      Integrable (row ν g j i) μ₃₉ := by
    obtain ⟨hcm, B, _, hB⟩ := physicalSourceCover_regular g j 39
    apply (hV i).2.2.2.1.bdd_mul ((hHm ν).mul hcm).aestronglyMeasurable (c := B)
    filter_upwards [] with Y
    rw [Pi.mul_apply, norm_mul, Real.norm_eq_abs (physicalSourceCover g j Y),
      abs_of_nonneg (hB Y).1]
    exact (mul_le_mul (hHnorm ν Y) (hB Y).2 (hB Y).1 zero_le_one).trans_eq (one_mul B)
  have hswap (s : Finset ℕ) (f : Fin 40 → ℕ → ℝ) :
      (∑ i : Fin 40, ∑ j ∈ s, f i j) / trialPhysicalNormalizer =
        ∑ j ∈ s, (∑ i : Fin 40, f i j) / trialPhysicalNormalizer := by
    rw [Finset.sum_comm, Finset.sum_div]
  have hcharge (ν : Fin 2) (g₀ g₁ : Fin 6)
      (hc : ∀ᵐ Y ∂μ₃₉,
        H ν Y * (1 - physicalSourceInnerSupport ν Y) ≤
          (∑ j ∈ Finset.range (physicalSourceRowCount g₀), physicalSourceCover g₀ j Y) +
            ∑ j ∈ Finset.range (physicalSourceRowCount g₁), physicalSourceCover g₁ j Y) :
      (∑ i : Fin 40, ∫ Y, loss ν i Y ∂μ₃₉) / trialPhysicalNormalizer ≤
        (∑ j ∈ Finset.range (physicalSourceRowCount g₀), innerRow ν g₀ j) +
          ∑ j ∈ Finset.range (physicalSourceRowCount g₁), innerRow ν g₁ j := by
    have hi (i : Fin 40) :
        (∫ Y, loss ν i Y ∂μ₃₉) ≤
          (∑ j ∈ Finset.range (physicalSourceRowCount g₀), ∫ Y, row ν g₀ j i Y ∂μ₃₉) +
            ∑ j ∈ Finset.range (physicalSourceRowCount g₁), ∫ Y, row ν g₁ j i Y ∂μ₃₉ := by
      have hsum (g : Fin 6) := integrable_finsetSum
        (Finset.range (physicalSourceRowCount g)) (fun j _ => hRowInt ν g j i)
      calc
        _ ≤ ∫ Y,
            (∑ j ∈ Finset.range (physicalSourceRowCount g₀), row ν g₀ j i Y) +
              ∑ j ∈ Finset.range (physicalSourceRowCount g₁), row ν g₁ j i Y ∂μ₃₉ := by
          apply integral_mono_ae (hLossInt ν i) ((hsum g₀).fun_add (hsum g₁))
          filter_upwards [hc] with Y hY
          calc
            loss ν i Y = H ν Y *
                (H ν Y * (1 - physicalSourceInnerSupport ν Y)) * trialMarginal i Y ^ 2 := by
              dsimp only [loss]
              rw [← mul_assoc, hHsq]
            _ ≤ H ν Y *
                ((∑ j ∈ Finset.range (physicalSourceRowCount g₀), physicalSourceCover g₀ j Y) +
                  ∑ j ∈ Finset.range (physicalSourceRowCount g₁), physicalSourceCover g₁ j Y) *
                    trialMarginal i Y ^ 2 :=
              mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_left hY (hH0 ν Y))
                (sq_nonneg _)
            _ = _ := by
              simp only [row, mul_add, add_mul, Finset.mul_sum, Finset.sum_mul]
        _ = _ := by
          rw [integral_add (hsum g₀) (hsum g₁),
            integral_finsetSum _ (fun j _ => hRowInt ν g₀ j i),
            integral_finsetSum _ (fun j _ => hRowInt ν g₁ j i)]
    convert div_le_div_of_nonneg_right
      (Finset.sum_le_sum fun i _ => hi i) hden.le using 1
    · rfl
    · rw [Finset.sum_add_distrib, add_div, hswap, hswap]
  have hlen₀ : physicalSourceRowCount 0 = outerOrderTwoBounds.length := by decide
  have hlen₁ : physicalSourceRowCount 1 = outerOrderFiveHalvesBounds.length := by decide
  have hlen₂ : physicalSourceRowCount 2 = innerBaseOrderTwoBounds.length := by decide
  have hlen₃ : physicalSourceRowCount 3 = innerBaseOrderFiveHalvesBounds.length := by
    decide
  have hlen₄ : physicalSourceRowCount 4 = innerEnlargedOrderTwoBounds.length := by decide
  have hlen₅ : physicalSourceRowCount 5 = innerEnlargedOrderFiveHalvesBounds.length := by
    decide
  have hOld : old ≤
      (∑ j ∈ Finset.range (physicalSourceRowCount 2), physicalSourceInnerMass 2 j) +
        ∑ j ∈ Finset.range (physicalSourceRowCount 3), physicalSourceInnerMass 3 j := by
    simpa [old, loss, innerRow, row, H, physicalSourceInnerMass, μ₃₉] using
      (hcharge 0 2 3 (by simpa [H] using hcover.2.1))
  rw [hlen₂, hlen₃, ← Fin.sum_univ_eq_sum_range, ← Fin.sum_univ_eq_sum_range] at hOld
  have hNew : new ≤
      (∑ j ∈ Finset.range (physicalSourceRowCount 4), physicalSourceInnerMass 4 j) +
        ∑ j ∈ Finset.range (physicalSourceRowCount 5), physicalSourceInnerMass 5 j := by
    simpa [new, loss, innerRow, row, H, physicalSourceInnerMass, μ₃₉] using
      (hcharge 1 4 5 (by simpa [H] using hcover.2.2))
  rw [hlen₄, hlen₅, ← Fin.sum_univ_eq_sum_range, ← Fin.sum_univ_eq_sum_range] at hNew
  refine ⟨?_, ?_, add_le_add (mul_le_mul_of_nonneg_left hOld ha)
    (mul_le_mul_of_nonneg_left hNew hb), ?_⟩
  · exact div_nonneg (Finset.sum_nonneg fun i _ =>
      integral_nonneg fun Y => mul_nonneg (hδ0 Y) (sq_nonneg _)) hden.le
  · have hi (i : Fin 40) :
        (∫ Y, δ Y * trialMarginal i Y ^ 2 ∂μ₃₉) ≤
          a * (∫ Y, loss 0 i Y ∂μ₃₉) + b * (∫ Y, loss 1 i Y ∂μ₃₉) := by
      calc
        _ ≤ ∫ Y, a * loss 0 i Y + b * loss 1 i Y ∂μ₃₉ := by
          apply integral_mono (hδInt i)
            (((hLossInt 0 i).const_mul a).fun_add ((hLossInt 1 i).const_mul b))
          intro Y
          simpa only [loss, add_mul, mul_assoc] using
            mul_le_mul_of_nonneg_right (hδle Y) (sq_nonneg (trialMarginal i Y))
        _ = _ := by
          rw [integral_add ((hLossInt 0 i).const_mul a) ((hLossInt 1 i).const_mul b),
            integral_const_mul, integral_const_mul]
    convert div_le_div_of_nonneg_right
      (Finset.sum_le_sum fun i _ => hi i) hden.le using 1
    · rfl
    · simp only [Finset.sum_add_distrib, ← Finset.mul_sum, add_div, mul_div_assoc,
        old, new, loss, H, Fin.reduceEq, ↓reduceIte, μ₃₉, a, b]
  · let v : Fin 40 → (Fin 40 → FiniteMeasure ℝ) → ℝ := fun i X =>
      trialMarginal i (i.removeNth X)
    let cross : Fin 40 → (Fin 40 → FiniteMeasure ℝ) → ℝ := fun i X =>
      physicalSourceFaceMultiplier (i.removeNth X) *
        ((1 - physicalSourceOuterSupport X) * trialStepFunction X) * v i X
    let T : Fin 6 → ℕ → Fin 40 → (Fin 40 → FiniteMeasure ℝ) → ℝ := fun g j i X =>
      2 * physicalSourceCover g j X * physicalSourceFaceWeight (i.removeNth X) *
        |trialStepFunction X * v i X|
    have hremove (i : Fin 40) : Measurable
        (fun X : Fin 40 → FiniteMeasure ℝ => i.removeNth X) :=
      measurable_pi_lambda _ fun k => measurable_pi_apply (i.succAbove k)
    have hvm (i : Fin 40) : Measurable (v i) := (hV i).1.comp (hremove i)
    have hvC (i : Fin 40) (X : Fin 40 → FiniteMeasure ℝ) : ‖v i X‖ ≤ C :=
      (hV i).2.1 _
    have hweightm : Measurable physicalSourceFaceWeight := by
      unfold physicalSourceFaceWeight
      exact Measurable.ite
        ((measurableSet_singleton (1 : ℝ)).preimage trial_data_measurable.2.2.1)
        measurable_const
        (Measurable.ite
          ((measurableSet_singleton (1 : ℝ)).preimage trial_data_measurable.2.2.2.1)
          measurable_const measurable_const)
    have hweight (Y : Fin 39 → FiniteMeasure ℝ) :
        0 ≤ physicalSourceFaceWeight Y ∧ physicalSourceFaceWeight Y ≤ 1 := by
      unfold physicalSourceFaceWeight
      split_ifs <;> norm_num
    have hPcomp (X : Fin 40 → FiniteMeasure ℝ) :
        0 ≤ 1 - physicalSourceOuterSupport X ∧ ‖1 - physicalSourceOuterSupport X‖ ≤ 1 := by
      rcases hP X with h | h <;> simp [h]
    have hcrossInt (i : Fin 40) : Integrable (cross i) μ₄₀ := by
      have hprod := hFint.mul_bdd (hvm i).aestronglyMeasurable (ae_of_all _ (hvC i))
      have hfactorMeas : Measurable (fun X : Fin 40 → FiniteMeasure ℝ =>
          physicalSourceFaceMultiplier (i.removeNth X) * (1 - physicalSourceOuterSupport X)) :=
        (hm.comp (hremove i)).fun_mul (hsupport.1.const_sub (1 : ℝ))
      have hfactorBound : ∀ X : Fin 40 → FiniteMeasure ℝ,
          ‖physicalSourceFaceMultiplier (i.removeNth X) *
            (1 - physicalSourceOuterSupport X)‖ ≤ (1 : ℝ) := by
        intro X
        rw [norm_mul, Real.norm_eq_abs (physicalSourceFaceMultiplier (i.removeNth X))]
        exact (mul_le_of_le_one_left (norm_nonneg _)
          (((hδ (i.removeNth X)).2.1).trans (hweight _).2)).trans (hPcomp X).2
      simpa only [cross, mul_assoc] using
        hprod.bdd_mul hfactorMeas.aestronglyMeasurable (ae_of_all _ hfactorBound)
    have hTInt (g : Fin 6) (j : ℕ) (i : Fin 40) : Integrable (T g j i) μ₄₀ := by
      obtain ⟨hcm, B, _, hB⟩ := physicalSourceCover_regular g j 40
      have hprod := (hFint.mul_bdd (hvm i).aestronglyMeasurable (ae_of_all _ (hvC i))).abs
      have ham : Measurable (fun X : Fin 40 → FiniteMeasure ℝ =>
          physicalSourceCover g j X * physicalSourceFaceWeight (i.removeNth X)) :=
        hcm.fun_mul (hweightm.comp (hremove i))
      have haB : ∀ X : Fin 40 → FiniteMeasure ℝ,
          ‖physicalSourceCover g j X * physicalSourceFaceWeight (i.removeNth X)‖ ≤ B := by
        intro X
        rw [Real.norm_eq_abs, abs_of_nonneg (mul_nonneg (hB X).1 (hweight _).1)]
        exact (mul_le_mul (hB X).2 (hweight _).2 (hweight _).1
          ((hB X).1.trans (hB X).2)).trans_eq (mul_one B)
      simpa only [T, mul_assoc] using
        (hprod.bdd_mul ham.aestronglyMeasurable (ae_of_all _ haB)).const_mul 2
    have hmaskF (X : Fin 40 → FiniteMeasure ℝ) :
        trialOuterMask X * trialStepFunction X = trialStepFunction X := by
      rcases trial_mask_values_and_nesting.1 X with h | h
      · simp only [trialStepFunction_eq_cellExpression, h, zero_mul]
      · rw [h, one_mul]
    have hi (i : Fin 40) :
        2 * (∫ X, cross i X ∂μ₄₀) ≤
          (∑ j ∈ Finset.range (physicalSourceRowCount 0), ∫ X, T 0 j i X ∂μ₄₀) +
            ∑ j ∈ Finset.range (physicalSourceRowCount 1), ∫ X, T 1 j i X ∂μ₄₀ := by
      have hsum (g : Fin 6) := integrable_finsetSum
        (Finset.range (physicalSourceRowCount g)) (fun j _ => hTInt g j i)
      calc
        _ = ∫ X, 2 * cross i X ∂μ₄₀ := (integral_const_mul 2 _).symm
        _ ≤ ∫ X,
            (∑ j ∈ Finset.range (physicalSourceRowCount 0), T 0 j i X) +
              ∑ j ∈ Finset.range (physicalSourceRowCount 1), T 1 j i X ∂μ₄₀ := by
          apply integral_mono_ae ((hcrossInt i).const_mul 2) ((hsum 0).fun_add (hsum 1))
          filter_upwards [hcover.1] with X hX
          have hH0' : 0 ≤ trialOuterMask X := by
            rcases trial_mask_values_and_nesting.1 X with h | h <;> simp [h]
          have hmaskAbs : trialOuterMask X * |trialStepFunction X * v i X| =
              |trialStepFunction X * v i X| := by
            rw [← abs_of_nonneg hH0', ← abs_mul, ← mul_assoc, hmaskF]
          have hpos : 0 ≤ 2 * physicalSourceFaceWeight (i.removeNth X) *
              |trialStepFunction X * v i X| :=
            mul_nonneg (mul_nonneg zero_le_two (hweight _).1) (abs_nonneg _)
          calc
            2 * cross i X = (2 * (1 - physicalSourceOuterSupport X)) *
                (physicalSourceFaceMultiplier (i.removeNth X) *
                  (trialStepFunction X * v i X)) := by dsimp only [cross]; ring
            _ ≤ (2 * (1 - physicalSourceOuterSupport X)) *
                (|physicalSourceFaceMultiplier (i.removeNth X)| *
                  |trialStepFunction X * v i X|) := by
              rw [← abs_mul]
              exact mul_le_mul_of_nonneg_left (le_abs_self _)
                (mul_nonneg zero_le_two (hPcomp X).1)
            _ ≤ (2 * (1 - physicalSourceOuterSupport X)) *
                (physicalSourceFaceWeight (i.removeNth X) *
                  |trialStepFunction X * v i X|) :=
              mul_le_mul_of_nonneg_left
                (mul_le_mul_of_nonneg_right (hδ (i.removeNth X)).2.1 (abs_nonneg _))
                (mul_nonneg zero_le_two (hPcomp X).1)
            _ = (trialOuterMask X * (1 - physicalSourceOuterSupport X)) *
                (2 * physicalSourceFaceWeight (i.removeNth X) *
                  |trialStepFunction X * v i X|) := by
              calc
                _ = (2 * (1 - physicalSourceOuterSupport X)) *
                    physicalSourceFaceWeight (i.removeNth X) *
                    (trialOuterMask X * |trialStepFunction X * v i X|) := by rw [hmaskAbs]; ring
                _ = _ := by ring
            _ ≤ ((∑ j ∈ Finset.range (physicalSourceRowCount 0), physicalSourceCover 0 j X) +
                ∑ j ∈ Finset.range (physicalSourceRowCount 1), physicalSourceCover 1 j X) *
                (2 * physicalSourceFaceWeight (i.removeNth X) *
                  |trialStepFunction X * v i X|) := mul_le_mul_of_nonneg_right hX hpos
            _ = _ := by
              simp only [T, add_mul, Finset.sum_mul, mul_assoc, mul_left_comm]
              rw [mul_add, Finset.mul_sum, Finset.mul_sum]
        _ = _ := by
          rw [integral_add (hsum 0) (hsum 1),
            integral_finsetSum _ (fun j _ => hTInt 0 j i),
            integral_finsetSum _ (fun j _ => hTInt 1 j i)]
    have htotal :
        2 * ((∑ i : Fin 40, ∫ X, cross i X ∂μ₄₀) / trialPhysicalNormalizer) ≤
          (∑ j ∈ Finset.range (physicalSourceRowCount 0), mixed 0 j) +
            ∑ j ∈ Finset.range (physicalSourceRowCount 1), mixed 1 j := by
      convert div_le_div_of_nonneg_right
        (Finset.sum_le_sum fun i _ => hi i) hden.le using 1
      · rfl
      · rw [← Finset.mul_sum, mul_div_assoc]
      · dsimp only [mixed, T, v]
        rw [Finset.sum_add_distrib, add_div, hswap, hswap]
    rw [hlen₀, hlen₁, ← Fin.sum_univ_eq_sum_range, ← Fin.sum_univ_eq_sum_range] at htotal
    simpa only [cross, v] using htotal

theorem trial_actual_signed_restoration :
    let μ₄₀ := Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)
    let μ₃₉ := Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)
    let α : ℝ := (∫ X,
      ((1 - physicalSourceOuterSupport X) * trialStepFunction X) ^ 2 ∂μ₄₀) /
        trialPhysicalNormalizer
    let I : ℝ := (∫ X, trialSourceStepFunction X ^ 2 ∂μ₄₀) /
      trialPhysicalNormalizer
    let J : ℝ := (∑ i : Fin 40, ∫ Y,
      physicalSourceFaceMultiplier Y *
        (∫ Z : FiniteMeasure ℝ, trialSourceStepFunction (i.insertNth Z Y)
          ∂trialPhysicalMeasure) ^ 2 ∂μ₃₉) / trialPhysicalNormalizer
    let β : ℝ := (∑ i : Fin 40, ∫ Y,
      ((44415113 / 5000000000 : ℝ) * trialBaseMask Y *
          (1 - physicalSourceInnerSupport 0 Y * physicalSourceInnerSupport 1 Y) +
        (2479900401 / 2500000000 : ℝ) * trialEnlargedMask Y *
          (1 - physicalSourceInnerSupport 1 Y)) * trialMarginal i Y ^ 2 ∂μ₃₉) /
        trialPhysicalNormalizer
    let outer : ℝ :=
      (∑ j : Fin outerOrderTwoBounds.length,
        ((((outerOrderTwoBounds.get j).1 : ℝ) / (10 : ℝ) ^ 6) *
            physicalSourceOuterRoot 0 j.val +
          physicalSourceOuterFace 0 j.val /
            (((outerOrderTwoBounds.get j).1 : ℝ) / (10 : ℝ) ^ 6))) +
      (∑ j : Fin outerOrderFiveHalvesBounds.length,
        ((((outerOrderFiveHalvesBounds.get j).1 : ℝ) / (10 : ℝ) ^ 6) *
            physicalSourceOuterRoot 1 j.val +
          physicalSourceOuterFace 1 j.val /
            (((outerOrderFiveHalvesBounds.get j).1 : ℝ) / (10 : ℝ) ^ 6)))
    let inner : ℝ :=
      (44415113 / 5000000000 : ℝ) *
        ((∑ j : Fin innerBaseOrderTwoBounds.length,
            physicalSourceInnerMass 2 j.val) +
          ∑ j : Fin innerBaseOrderFiveHalvesBounds.length,
            physicalSourceInnerMass 3 j.val) +
      (1000843183 / 1000000000 : ℝ) *
        ((∑ j : Fin innerEnlargedOrderTwoBounds.length,
            physicalSourceInnerMass 4 j.val) +
          ∑ j : Fin innerEnlargedOrderFiveHalvesBounds.length,
            physicalSourceInnerMass 5 j.val)
    (2624989 / 10 ^ 7 : ℝ) * (trialJLambdaH - β - outer) - trialIH +
        (1 - 4 * (2624989 / 10 ^ 7 : ℝ) * |(-843183 / 1000000000 : ℝ)|) * α ≤
      (2624989 / 10 ^ 7 : ℝ) * J - I ∧
    (2624989 / 10 ^ 7 : ℝ) * (trialJLambdaH - (outer + inner)) - trialIH +
        (1 - 4 * (2624989 / 10 ^ 7 : ℝ) * |(-843183 / 1000000000 : ℝ)|) * α ≤
      (2624989 / 10 ^ 7 : ℝ) * J - I := by
  classical
  intro μ₄₀ μ₃₉ α I J β outer inner
  let cross : ℝ := (∑ i : Fin 40, ∫ X,
    physicalSourceFaceMultiplier (i.removeNth X) *
      ((1 - physicalSourceOuterSupport X) * trialStepFunction X) *
        trialMarginal i (i.removeNth X) ∂μ₄₀) / trialPhysicalNormalizer
  let Bₑ : ℝ := (∑ i : Fin 40, ∫ Y,
    physicalSourceFaceMultiplier Y *
      (∫ Z : FiniteMeasure ℝ,
        (1 - physicalSourceOuterSupport (i.insertNth Z Y)) *
          trialStepFunction (i.insertNth Z Y) ∂trialPhysicalMeasure) ^ 2 ∂μ₃₉) /
            trialPhysicalNormalizer
  let mixed : Fin 6 → ℕ → ℝ := fun g j =>
    (∑ i : Fin 40, ∫ X,
      2 * physicalSourceCover g j X * physicalSourceFaceWeight (i.removeNth X) *
        |trialStepFunction X * trialMarginal i (i.removeNth X)| ∂μ₄₀) /
          trialPhysicalNormalizer
  obtain ⟨_, hI, hJ, hcross, hB⟩ := trialSource_exact_quadratic_decomposition
  change I = trialIH - α at hI
  change -4 * |(-843183 / 1000000000 : ℝ)| * α ≤ Bₑ at hB
  rw [hcross] at hJ
  change J = trialJLambdaH - β - 2 * cross + Bₑ at hJ
  have hcover := trialSource_actual_loss_cover
  have hβinner : β ≤ inner := hcover.2.1.trans hcover.2.2.1
  have hYoung :
      (∑ j : Fin outerOrderTwoBounds.length, mixed 0 j.val) +
        (∑ j : Fin outerOrderFiveHalvesBounds.length, mixed 1 j.val) ≤ outer := by
    apply add_le_add
    · refine Finset.sum_le_sum fun j _ => ?_
      have hq := (outerBoundRows_rounding (outerOrderTwoBounds.get j)
        (List.mem_append_left _ (List.get_mem outerOrderTwoBounds j))).1
      exact physicalSource_outer_young 0 j.val _
        (div_pos (Nat.cast_pos.mpr hq) (by norm_num))
    · refine Finset.sum_le_sum fun j _ => ?_
      have hq := (outerBoundRows_rounding
        (outerOrderFiveHalvesBounds.get j)
        (List.mem_append_right _ (List.get_mem outerOrderFiveHalvesBounds j))).1
      exact physicalSource_outer_young 1 j.val _
        (div_pos (Nat.cast_pos.mpr hq) (by norm_num))
  have hcrossOuter : 2 * cross ≤ outer := hcover.2.2.2.trans hYoung
  constructor
  · nlinarith only [hI, hJ, hB, hcrossOuter]
  · nlinarith only [hI, hJ, hB, hcrossOuter, hβinner]

theorem trial_actual_source_quadratic_positive
    (hNumerics :
      (∀ j : Fin outerOrderTwoBounds.length,
        physicalSourceOuterRoot 0 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((outerOrderTwoBounds.get j).2.1 : ℝ) / (10 : ℝ) ^ 18 ∧
        physicalSourceOuterFace 0 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((outerOrderTwoBounds.get j).2.2.1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (∀ j : Fin outerOrderFiveHalvesBounds.length,
        physicalSourceOuterRoot 1 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((outerOrderFiveHalvesBounds.get j).2.1 : ℝ) / (10 : ℝ) ^ 18 ∧
        physicalSourceOuterFace 1 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((outerOrderFiveHalvesBounds.get j).2.2.1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (∀ j : Fin innerBaseOrderTwoBounds.length,
        physicalSourceInnerMass 2 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((innerBaseOrderTwoBounds.get j).1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (∀ j : Fin innerBaseOrderFiveHalvesBounds.length,
        physicalSourceInnerMass 3 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((innerBaseOrderFiveHalvesBounds.get j).1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (∀ j : Fin innerEnlargedOrderTwoBounds.length,
        physicalSourceInnerMass 4 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((innerEnlargedOrderTwoBounds.get j).1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (∀ j : Fin innerEnlargedOrderFiveHalvesBounds.length,
        physicalSourceInnerMass 5 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((innerEnlargedOrderFiveHalvesBounds.get j).1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (23685317816 : ℝ) / (10 : ℝ) ^ 24 ≤ trialIH ∧
      trialIH ≤ (23685317890 : ℝ) / (10 : ℝ) ^ 24 ∧
      (90248755123 : ℝ) / (10 : ℝ) ^ 24 ≤ trialJLambdaH) :
    let μ₄₀ := Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)
    let μ₃₉ := Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)
    let I : ℝ := (∫ X, trialSourceStepFunction X ^ 2 ∂μ₄₀) /
      trialPhysicalNormalizer
    let J : ℝ := (∑ i : Fin 40, ∫ Y,
      physicalSourceFaceMultiplier Y *
        (∫ Z : FiniteMeasure ℝ, trialSourceStepFunction (i.insertNth Z Y)
          ∂trialPhysicalMeasure) ^ 2 ∂μ₃₉) / trialPhysicalNormalizer
    (230382667 : ℝ) / (10 : ℝ) ^ 13 <
        ((2624989 / 10 ^ 7 : ℝ) * J - I) / trialIH ∧
      0 < (2624989 / 10 ^ 7 : ℝ) * J - I
 := by
  classical
  dsimp only
  have hrest := trial_actual_signed_restoration.2
  have hledger := (physicalSource_positive_row_ledger hNumerics).2
  obtain ⟨hIlower, hIupper, hJlower⟩ := hNumerics.2.2.2.2.2.2
  have hIH : 0 < trialIH :=
    (by norm_num : (0 : ℝ) < 23685317816 / (10 : ℝ) ^ 24).trans_le hIlower
  have hα : 0 ≤
      (∫ X : Fin 40 → FiniteMeasure ℝ,
        ((1 - physicalSourceOuterSupport X) * trialStepFunction X) ^ 2
          ∂Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)) /
        trialPhysicalNormalizer :=
    div_nonneg (integral_nonneg fun _ => sq_nonneg _) trial_fixed_positive_data.2.2.2.2.2.le
  have hcoef : 0 ≤
      1 - 4 * (2624989 / 10 ^ 7 : ℝ) * |(-843183 / 1000000000 : ℝ)| := by
    rw [trial_face_operator_constants.2.2.2.1]
    exact trial_face_operator_constants.2.2.2.2.le
  have hfavorable := mul_nonneg hcoef hα
  have hdrop := (le_add_of_nonneg_right hfavorable).trans hrest
  have hcap : (500103 / 500000 : ℝ) * trialIH <
      (2624989 / 10 ^ 7 : ℝ) * trialJLambdaH := by
    nlinarith only [hIupper, hJlower]
  have hbudget := (div_le_iff₀ hIH).mp hledger
  constructor
  · apply (lt_div_iff₀ hIH).mpr
    nlinarith only [hdrop, hcap, hbudget, hIH]
  · nlinarith only [hdrop, hcap, hbudget, hIH]

theorem primeLogConfiguration_prod {ι : Type*}
    (R : ℝ) (s : Finset ι) (r : ι → ℕ) (hr : Squarefree (∏ i ∈ s, r i)) :
    primeLogConfiguration R (∏ i ∈ s, r i) =
      ∑ i ∈ s, primeLogConfiguration R (r i) := by
  classical
  revert hr
  induction s using Finset.induction_on with
  | empty => intro _hr; simp [primeLogConfiguration]
  | @insert i s hi ih =>
      intro hr
      rw [Finset.prod_insert hi] at hr ⊢
      have hcop := Nat.coprime_of_squarefree_mul hr
      rw [primeLogConfiguration, hcop.primeFactors_mul,
        Finset.sum_union hcop.disjoint_primeFactors]
      change primeLogConfiguration R (r i) +
        primeLogConfiguration R (∏ j ∈ s, r j) = _
      rw [ih hr.of_mul_right, Finset.sum_insert hi]

open Classical in
theorem primeLogConfiguration_real_apply (R : ℝ) (hR : 1 < R)
    (D : ℕ) (A : Set ℝ) :
    (primeLogConfiguration R D : Measure ℝ).real A =
      ∑ p ∈ D.primeFactors, if logSize R p ∈ A then logSize R p else 0 := by
  have hmeasure : (primeLogConfiguration R D : Measure ℝ) =
      ∑ p ∈ D.primeFactors,
        ENNReal.ofReal (logSize R p) • Measure.dirac (logSize R p) := by
    rw [primeLogConfiguration, FiniteMeasure.toMeasure_sum]
    rfl
  rw [hmeasure, measureReal_def, Measure.finsetSum_apply,
    ENNReal.toReal_sum (fun p _hp => by
      rw [Measure.smul_apply, smul_eq_mul]
      exact ENNReal.mul_ne_top ENNReal.ofReal_ne_top (measure_ne_top _ _))]
  apply Finset.sum_congr rfl
  intro p hp
  have hu : 0 < logSize R p :=
    Real.logb_pos hR (by exact_mod_cast (Nat.prime_of_mem_primeFactors hp).one_lt)
  simp +contextual [Measure.smul_apply, Measure.dirac_apply,
    Set.indicator, hu.le, apply_ite]

theorem primeLogConfiguration_mass_of_squarefree
    (R : ℝ) (hR : 1 < R) (D : ℕ) (hD : Squarefree D) :
    ((primeLogConfiguration R D).mass : ℝ) = logSize R D := by
  have h := primeLogConfiguration_real_apply R hR D Set.univ
  simp only [FiniteMeasure.measureReal_eq_coe_coeFn, Set.mem_univ, ite_eq_left] at h
  change ((primeLogConfiguration R D).mass : ℝ) =
    ∑ p ∈ D.primeFactors, logSize R p at h
  rw [h, ← sum_primeFactors_logFragment_eq_logSize R hR hD, NNReal.coe_sum]
  apply Finset.sum_congr rfl
  intro p hp
  exact (coe_logFragment R hR (Nat.pos_of_mem_primeFactors hp)).symm

theorem primeLogConfiguration_Ici_prime
    (R : ℝ) (hR : 1 < R) (D p : ℕ) (hp : p ∈ D.primeFactors) :
    (primeLogConfiguration R D : Measure ℝ).real (Set.Ici (logSize R p)) =
      (primeFragmentSuffix R D p : ℝ) + logSize R p := by
  classical
  rw [primeLogConfiguration_real_apply R hR]
  have horder (q : ℕ) (hq : q ∈ D.primeFactors) :
      logSize R p ≤ logSize R q ↔ p ≤ q := by
    simpa only [logSize, Nat.cast_le] using
      Real.logb_le_logb hR
        (by exact_mod_cast (Nat.pos_of_mem_primeFactors hp) : (0 : ℝ) < (p : ℝ))
        (by exact_mod_cast (Nat.pos_of_mem_primeFactors hq) : (0 : ℝ) < (q : ℝ))
  have hafter : (primeFragmentSuffix R D p : ℝ) =
      ∑ q ∈ D.primeFactors, if p < q then logSize R q else 0 := by
    dsimp only [primeFragmentSuffix]
    rw [NNReal.coe_sum, Finset.sum_filter]
    apply Finset.sum_congr rfl
    intro q hq
    simp only [coe_logFragment R hR (Nat.pos_of_mem_primeFactors hq)]
  rw [hafter]
  conv_rhs =>
    rhs
    rw [← Finset.sum_ite_eq_of_mem' D.primeFactors p (logSize R) hp]
  rw [← Finset.sum_add_distrib]
  apply Finset.sum_congr rfl
  intro q hq
  simp only [Set.mem_Ici, horder q hq]
  rcases lt_trichotomy p q with hpq | rfl | hqp
  · simp [hpq, hpq.le, hpq.ne']
  · simp
  · simp [not_le_of_gt hqp, not_lt_of_gt hqp, hqp.ne]

theorem physicalSourceCountMeasure_primeLogConfiguration
    (d : ℕ) (R : ℝ) (hR : 1 < R) (r : Fin d → ℕ)
    (hr : Squarefree (∏ i, r i)) :
    physicalSourceCountMeasure (fun i => primeLogConfiguration R (r i)) =
      ∑ p ∈ (∏ i, r i).primeFactors, Measure.dirac (logSize R p) := by
  classical
  have hsum : (∑ i, (primeLogConfiguration R (r i) : Measure ℝ)) =
      (primeLogConfiguration R (∏ i, r i) : Measure ℝ) := by
    rw [primeLogConfiguration_prod R Finset.univ r hr, FiniteMeasure.toMeasure_sum]
  have hmeasure : (primeLogConfiguration R (∏ i, r i) : Measure ℝ) =
      ∑ p ∈ (∏ i, r i).primeFactors,
        ENNReal.ofReal (logSize R p) • Measure.dirac (logSize R p) := by
    rw [primeLogConfiguration, FiniteMeasure.toMeasure_sum]
    rfl
  dsimp only [physicalSourceCountMeasure]
  rw [hsum, hmeasure,
    ← Measure.sum_coe_finset, Measure.restrict_sum _ measurableSet_Ioi,
    withDensity_sum, ← Measure.sum_coe_finset]
  apply congrArg Measure.sum
  funext p
  have hup : 0 < logSize R p :=
    Real.logb_pos hR (by exact_mod_cast (Nat.prime_of_mem_primeFactors p.property).one_lt)
  rw [Measure.restrict_smul, restrict_dirac,
    ite_eq_left (show logSize R p ∈ Set.Ioi (0 : ℝ) from hup),
    withDensity_smul_measure, dirac_withDensity, smul_smul,
    ← ENNReal.ofReal_mul hup.le, mul_inv_cancel₀ hup.ne',
    ENNReal.ofReal_one, one_smul]

theorem primeLogConfiguration_notMem_of_measure_zero
    (R : ℝ) (hR : 1 < R) (D : ℕ) (A : Set ℝ)
    (hA : (primeLogConfiguration R D : Measure ℝ) A = 0)
    (p : ℕ) (hp : p ∈ D.primeFactors) : logSize R p ∉ A := by
  classical
  intro hpa
  have hreal : (primeLogConfiguration R D : Measure ℝ).real A = 0 := by
    simp [measureReal_def, hA]
  rw [primeLogConfiguration_real_apply R hR] at hreal
  have hpos : 0 < logSize R p :=
    Real.logb_pos hR (by exact_mod_cast (Nat.prime_of_mem_primeFactors hp).one_lt)
  have hle : logSize R p ≤
      ∑ q ∈ D.primeFactors, if logSize R q ∈ A then logSize R q else 0 := by
    simpa only [hpa, ite_eq_left] using
      Finset.single_le_sum (f := fun q => if logSize R q ∈ A then logSize R q else 0)
        (fun q hq => by
          split_ifs
          · exact (Real.logb_pos hR
              (by exact_mod_cast (Nat.prime_of_mem_primeFactors hq).one_lt)).le
          · exact le_rfl) hp
  exact hpos.not_ge (hreal ▸ hle)

theorem physicalSourceCountMeasure_notMem_of_zero
    (d : ℕ) (R : ℝ) (hR : 1 < R) (r : Fin d → ℕ)
    (hr : Squarefree (∏ i, r i)) (A : Set ℝ)
    (hA : physicalSourceCountMeasure (fun i => primeLogConfiguration R (r i)) A = 0)
    (p : ℕ) (hp : p ∈ (∏ i, r i).primeFactors) : logSize R p ∉ A := by
  classical
  intro hpa
  rw [physicalSourceCountMeasure_primeLogConfiguration d R hR r hr,
    Measure.finsetSum_apply] at hA
  have hle := Finset.single_le_sum
    (f := fun q => Measure.dirac (logSize R q) A) (fun _ _ => zero_le) hp
  rw [Measure.dirac_apply_of_mem hpa, hA] at hle
  exact not_le_of_gt zero_lt_one hle

theorem primeLogConfiguration_total_mass
    (d : ℕ) (R : ℝ) (hR : 1 < R) (r : Fin d → ℕ)
    (hr : Squarefree (∏ i, r i)) :
    (∑ i, ((primeLogConfiguration R (r i)).mass : ℝ)) = logSize R (∏ i, r i) := by
  classical
  have hi (i : Fin d) : Squarefree (r i) :=
    hr.squarefree_of_dvd (Finset.dvd_prod_of_mem r (Finset.mem_univ i))
  simp_rw [primeLogConfiguration_mass_of_squarefree R hR _ (hi _)]
  simp only [logSize, Nat.cast_prod]
  exact (Real.logb_prod _ _ (fun i _hi => by exact_mod_cast (hi i).ne_zero)).symm

theorem physicalSourceOuterSupport_prime_arithmetic
    (R : ℝ) (hR : 1 < R) (r : Fin 40 → ℕ)
    (hr : Squarefree (∏ i, r i))
    (hmask : physicalSourceOuterSupport (fun i => primeLogConfiguration R (r i)) = 1) :
    logSize R (∏ i, r i) ≤ (physicalSourceOuterRadius : ℝ) ∧
      (∀ p ∈ (∏ i, r i).primeFactors,
        logSize R p ≤ (((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ)) ∧
      ∀ (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)),
        let row := physicalSourceRow ν t.val
        logSize R (∏ i, r i) ≤ (row.outerCore : ℝ) ∨
          ∀ p ∈ activatedPrimeFactors R (row.activation : ℝ) (∏ i, r i),
            if row.order ≤ 2 then
              (primeFragmentSuffix R (∏ i, r i) p : ℝ) + 2 * logSize R p ≤
                (row.outerThreshold : ℝ)
            else
              let L : ℝ := (23 / 40) * (row.innerThreshold : ℝ)
              (primeFragmentSuffix R (∏ i, r i) p : ℝ) + logSize R p +
                  min ((3 / 2) * logSize R p) L ≤ (row.outerThreshold : ℝ) ∧
                3 * logSize R p - min ((3 / 2) * logSize R p) L ≤
                  (row.innerThreshold : ℝ) := by
  classical
  have hsum : (∑ i, (primeLogConfiguration R (r i) : Measure ℝ)) =
      (primeLogConfiguration R (∏ i, r i) : Measure ℝ) := by
    rw [primeLogConfiguration_prod R Finset.univ r hr, FiniteMeasure.toMeasure_sum]
  dsimp only [physicalSourceOuterSupport] at hmask
  have hsupport := (Ne.ite_eq_left_iff one_ne_zero).mp hmask
  refine ⟨?_, ?_, ?_⟩
  · simpa only [primeLogConfiguration_total_mass 40 R hR r hr] using hsupport.1
  · intro p hp
    have hcap := hsupport.2.1
    rw [hsum] at hcap
    exact le_of_not_gt
      (primeLogConfiguration_notMem_of_measure_zero R hR _ _ hcap p hp)
  · intro ν t
    dsimp only
    rcases hsupport.2.2 ν t with hcore | hzero
    · left
      simpa only [primeLogConfiguration_total_mass 40 R hR r hr] using hcore
    · right
      intro p hp
      have hpD := (Finset.mem_filter.mp hp).1
      have hpact : ((physicalSourceRow ν t.val).activation : ℝ) < logSize R p :=
        (Real.lt_logb_iff_rpow_lt hR
          (by exact_mod_cast Nat.pos_of_mem_primeFactors hpD)).mpr
            (Finset.mem_filter.mp hp).2
      have hnot := physicalSourceCountMeasure_notMem_of_zero 40 R hR r hr _ hzero p hpD
      simp only [Set.mem_ofPred_eq] at hnot
      rw [hsum, primeLogConfiguration_Ici_prime R hR _ p hpD] at hnot
      by_cases horder : (physicalSourceRow ν t.val).order ≤ 2
      · rw [ite_eq_left horder] at hnot ⊢
        simp only [not_and, hpact, true_implies, not_lt] at hnot
        linarith
      · rw [ite_eq_right horder] at hnot ⊢
        simp only [not_and, hpact, true_implies, not_or, not_lt] at hnot
        exact hnot

theorem physicalSourceInnerSupport_prime_arithmetic
    (ν : Fin 2) (R : ℝ) (hR : 1 < R) (r : Fin 39 → ℕ)
    (hr : Squarefree (∏ i, r i))
    (hmask : physicalSourceInnerSupport ν (fun i => primeLogConfiguration R (r i)) = 1) :
    logSize R (∏ i, r i) ≤ (physicalSourceInnerRadius ν : ℝ) ∧
      (∀ p ∈ (∏ i, r i).primeFactors,
        logSize R p ≤ (((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ)) ∧
      ∀ t : Fin (if ν = 0 then 28 else 39),
        let row := physicalSourceRow ν t.val
        row.order = 1 ∨ logSize R (∏ i, r i) ≤ (row.innerCore : ℝ) ∨
          ∀ p ∈ activatedPrimeFactors R (row.activation : ℝ) (∏ i, r i),
            if row.order ≤ 2 then
              (primeFragmentSuffix R (∏ i, r i) p : ℝ) + 2 * logSize R p ≤
                (row.innerThreshold : ℝ)
            else
              let L : ℝ := (23 / 40) * (row.innerThreshold : ℝ)
              (primeFragmentSuffix R (∏ i, r i) p : ℝ) + logSize R p +
                  (3 * logSize R p - min ((3 / 2) * logSize R p) L) ≤
                    (row.innerThreshold : ℝ) ∧
                min ((3 / 2) * logSize R p) L ≤ (row.outerThreshold : ℝ) := by
  classical
  have hsum : (∑ i, (primeLogConfiguration R (r i) : Measure ℝ)) =
      (primeLogConfiguration R (∏ i, r i) : Measure ℝ) := by
    rw [primeLogConfiguration_prod R Finset.univ r hr, FiniteMeasure.toMeasure_sum]
  dsimp only [physicalSourceInnerSupport] at hmask
  have hsupport := (Ne.ite_eq_left_iff one_ne_zero).mp hmask
  refine ⟨?_, ?_, ?_⟩
  · simpa only [primeLogConfiguration_total_mass 39 R hR r hr] using hsupport.1
  · intro p hp
    have hcap := hsupport.2.1
    rw [hsum] at hcap
    exact le_of_not_gt
      (primeLogConfiguration_notMem_of_measure_zero R hR _ _ hcap p hp)
  · intro t
    dsimp only
    rcases hsupport.2.2 t with hone | hcore | hzero
    · exact Or.inl hone
    · right
      left
      simpa only [primeLogConfiguration_total_mass 39 R hR r hr] using hcore
    · right
      right
      intro p hp
      have hpD := (Finset.mem_filter.mp hp).1
      have hpact : ((physicalSourceRow ν t.val).activation : ℝ) < logSize R p :=
        (Real.lt_logb_iff_rpow_lt hR
          (by exact_mod_cast Nat.pos_of_mem_primeFactors hpD)).mpr
            (Finset.mem_filter.mp hp).2
      have hnot := physicalSourceCountMeasure_notMem_of_zero 39 R hR r hr _ hzero p hpD
      simp only [Set.mem_ofPred_eq] at hnot
      rw [hsum, primeLogConfiguration_Ici_prime R hR _ p hpD] at hnot
      by_cases horder : (physicalSourceRow ν t.val).order ≤ 2
      · rw [ite_eq_left horder] at hnot ⊢
        simp only [not_and, hpact, true_implies, not_lt] at hnot
        linarith
      · rw [ite_eq_right horder] at hnot ⊢
        simp only [not_and, hpact, true_implies, not_or, not_lt] at hnot
        exact hnot

theorem physicalSource_owner_sup_bounds
    (R ξ : ℝ) (D : ℕ) (φ ψ : ℝ≥0 → ℝ≥0) (hψ : ψ 0 = 0)
    (A C : ℝ) (hA : 0 ≤ A) (hC : 0 ≤ C)
    (h : ∀ p ∈ activatedPrimeFactors R ξ D,
      ((primeFragmentSuffix R D p + logFragment R p + φ (logFragment R p) : ℝ≥0) : ℝ) ≤ A ∧
        (ψ (logFragment R p) : ℝ) ≤ C) :
    (primeFragmentOwner φ R ξ D : ℝ) ≤ A ∧ (ψ (maxActivatedPrimeFragment R ξ D) : ℝ) ≤ C := by
  classical
  have howner : primeFragmentOwner φ R ξ D ≤ (⟨A, hA⟩ : ℝ≥0) :=
    Finset.sup_le fun p hp => by exact_mod_cast (h p hp).1
  refine ⟨by exact_mod_cast howner, ?_⟩
  by_cases hn : (activatedPrimeFactors R ξ D).Nonempty
  · obtain ⟨p, hp, heq⟩ :=
      Finset.exists_mem_eq_sup (activatedPrimeFactors R ξ D) hn (logFragment R)
    change (ψ ((activatedPrimeFactors R ξ D).sup (logFragment R)) : ℝ) ≤ C
    rw [heq]
    exact (h p hp).2
  · have hempty := Finset.not_nonempty_iff_eq_empty.mp hn
    simpa only [maxActivatedPrimeFragment, hempty, Finset.sup_empty, bot_eq_zero, hψ,
      NNReal.coe_zero] using hC

theorem physicalSource_owner_real (L u : ℝ≥0) :
    (physicalOuterOwner L u : ℝ) = min ((3 / 2) * (u : ℝ)) (L : ℝ) ∧
      (physicalInnerOwner L u : ℝ) =
        3 * (u : ℝ) - min ((3 / 2) * (u : ℝ)) (L : ℝ) := by
  have hout : (physicalOuterOwner L u : ℝ) = min ((3 / 2) * (u : ℝ)) (L : ℝ) := by
    simp [physicalOuterOwner]
  refine ⟨hout, ?_⟩
  rw [← hout, eq_sub_iff_add_eq']
  exact_mod_cast physicalOwner_sum L u

theorem physicalSourceOuterSupport_divisor_owner
    (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39))
    (R : ℝ) (hR : 1 < R) (r : Fin 40 → ℕ)
    (hr : Squarefree (∏ i, r i))
    (hmask : physicalSourceOuterSupport (fun i => primeLogConfiguration R (r i)) = 1)
    (D : ℕ) (hD : D ∣ ∏ i, r i) :
    let row := physicalSourceRow ν t.val
    let L : ℝ≥0 := ((23 / 40 : ℝ) * (row.innerThreshold : ℝ)).toNNReal
    logSize R D ≤ (physicalSourceOuterRadius : ℝ) ∧
      (∀ p ∈ D.primeFactors,
        logSize R p ≤ (((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ)) ∧
      (if row.order ≤ 2 then
        logSize R D ≤ (row.outerCore : ℝ) ∨
          (primeFragmentOwner id R (row.activation : ℝ) D : ℝ) ≤ (row.outerThreshold : ℝ)
      else
        logSize R D ≤ (row.outerCore : ℝ) ∨
          (primeFragmentOwner (physicalOuterOwner L) R (row.activation : ℝ) D : ℝ) ≤
              (row.outerThreshold : ℝ) ∧
            (physicalInnerOwner L (maxActivatedPrimeFragment R (row.activation : ℝ) D) : ℝ) ≤
              (row.innerThreshold : ℝ)) := by
  classical
  intro row L
  have hDs : Squarefree D := hr.squarefree_of_dvd hD
  have hDpos := Nat.pos_of_ne_zero hDs.ne_zero
  have hprodpos := Nat.pos_of_ne_zero hr.ne_zero
  have hraw := physicalSourceOuterSupport_prime_arithmetic R hR r hr hmask
  have hgeom := physicalSource_cover_fixed_geometry.2.2 ν t
  dsimp only at hgeom
  have hA : 0 ≤ (row.outerThreshold : ℝ) := by exact_mod_cast hgeom.1.le
  have hC : 0 ≤ (row.innerThreshold : ℝ) := by exact_mod_cast hgeom.2.1.le
  have hL : (L : ℝ) = (23 / 40) * (row.innerThreshold : ℝ) :=
    Real.coe_toNNReal _ (mul_nonneg (by norm_num) hC)
  refine ⟨?_, ?_, ?_⟩
  · exact (Real.logb_le_logb_of_le hR (by exact_mod_cast hDpos)
      (by exact_mod_cast Nat.le_of_dvd hprodpos hD)).trans hraw.1
  · intro p hp
    exact hraw.2.1 p (Nat.primeFactors_mono hD hr.ne_zero hp)
  · have hrow := hraw.2.2 ν t
    by_cases hord : row.order ≤ 2
    · rw [ite_eq_left hord]
      have hsrc : logSize R (∏ i, r i) ≤ (row.outerCore : ℝ) ∨
          (primeFragmentOwner id R (row.activation : ℝ) (∏ i, r i) : ℝ) ≤
              (row.outerThreshold : ℝ) ∧
            (((fun _ : ℝ≥0 => (0 : ℝ≥0))
              (maxActivatedPrimeFragment R (row.activation : ℝ) (∏ i, r i))) : ℝ) ≤ 0 := by
        rcases hrow with hcore | hpoint
        · exact Or.inl hcore
        · right
          apply physicalSource_owner_sup_bounds R _ _ id (fun _ => 0) rfl
            _ 0 hA le_rfl
          intro p hp
          have h := hpoint p hp
          rw [ite_eq_left hord] at h
          have hu := coe_logFragment R hR
            (Nat.pos_of_mem_primeFactors (Finset.mem_filter.mp hp).1)
          refine ⟨?_, le_rfl⟩
          simp only [id_eq, NNReal.coe_add, hu]
          linarith
      have hsmall := sourceSupport_dvd hR hD hDpos hprodpos id (fun _ => 0)
        monotone_const hsrc
      exact hsmall.imp_right And.left
    · rw [ite_eq_right hord]
      have hsrc : logSize R (∏ i, r i) ≤ (row.outerCore : ℝ) ∨
          (primeFragmentOwner (physicalOuterOwner L) R (row.activation : ℝ) (∏ i, r i) : ℝ) ≤
              (row.outerThreshold : ℝ) ∧
            (physicalInnerOwner L
              (maxActivatedPrimeFragment R (row.activation : ℝ) (∏ i, r i)) : ℝ) ≤
                (row.innerThreshold : ℝ) := by
        rcases hrow with hcore | hpoint
        · exact Or.inl hcore
        · right
          apply physicalSource_owner_sup_bounds R _ _ (physicalOuterOwner L)
            (physicalInnerOwner L) (by simp [physicalInnerOwner]) _ _ hA hC
          intro p hp
          have h := hpoint p hp
          rw [ite_eq_right hord] at h
          have hu := coe_logFragment R hR
            (Nat.pos_of_mem_primeFactors (Finset.mem_filter.mp hp).1)
          have hf := physicalSource_owner_real L (logFragment R p)
          simp only [NNReal.coe_add, hf.1, hf.2, hu, hL]
          exact h
      exact sourceSupport_dvd hR hD hDpos hprodpos (physicalOuterOwner L)
        (physicalInnerOwner L) (physicalInner_mono L) hsrc

theorem physicalSourceInnerSupport_divisor_owner
    (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39))
    (R : ℝ) (hR : 1 < R) (r : Fin 39 → ℕ)
    (hr : Squarefree (∏ i, r i))
    (hmask : physicalSourceInnerSupport ν (fun i => primeLogConfiguration R (r i)) = 1)
    (D : ℕ) (hD : D ∣ ∏ i, r i) :
    let row := physicalSourceRow ν t.val
    let L : ℝ≥0 := ((23 / 40 : ℝ) * (row.innerThreshold : ℝ)).toNNReal
    logSize R D ≤ (physicalSourceInnerRadius ν : ℝ) ∧
      (∀ p ∈ D.primeFactors,
        logSize R p ≤ (((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ)) ∧
      (row.order = 1 ∨
        if row.order ≤ 2 then
          logSize R D ≤ (row.innerCore : ℝ) ∨
            (primeFragmentOwner id R (row.activation : ℝ) D : ℝ) ≤ (row.innerThreshold : ℝ)
        else
          logSize R D ≤ (row.innerCore : ℝ) ∨
            (primeFragmentOwner (physicalInnerOwner L) R (row.activation : ℝ) D : ℝ) ≤
                (row.innerThreshold : ℝ) ∧
              (physicalOuterOwner L (maxActivatedPrimeFragment R (row.activation : ℝ) D) : ℝ) ≤
                (row.outerThreshold : ℝ)) := by
  classical
  intro row L
  have hDs : Squarefree D := hr.squarefree_of_dvd hD
  have hDpos := Nat.pos_of_ne_zero hDs.ne_zero
  have hprodpos := Nat.pos_of_ne_zero hr.ne_zero
  have hraw := physicalSourceInnerSupport_prime_arithmetic ν R hR r hr hmask
  have hgeom := physicalSource_cover_fixed_geometry.2.2 ν t
  dsimp only at hgeom
  have hA : 0 ≤ (row.outerThreshold : ℝ) := by exact_mod_cast hgeom.1.le
  have hC : 0 ≤ (row.innerThreshold : ℝ) := by exact_mod_cast hgeom.2.1.le
  have hL : (L : ℝ) = (23 / 40) * (row.innerThreshold : ℝ) :=
    Real.coe_toNNReal _ (mul_nonneg (by norm_num) hC)
  refine ⟨?_, ?_, ?_⟩
  · exact (Real.logb_le_logb_of_le hR (by exact_mod_cast hDpos)
      (by exact_mod_cast Nat.le_of_dvd hprodpos hD)).trans hraw.1
  · intro p hp
    exact hraw.2.1 p (Nat.primeFactors_mono hD hr.ne_zero hp)
  · rcases hraw.2.2 t with hone | hrow
    · exact Or.inl hone
    · right
      by_cases hord : row.order ≤ 2
      · rw [ite_eq_left hord]
        have hsrc : logSize R (∏ i, r i) ≤ (row.innerCore : ℝ) ∨
            (primeFragmentOwner id R (row.activation : ℝ) (∏ i, r i) : ℝ) ≤
                (row.innerThreshold : ℝ) ∧
              (((fun _ : ℝ≥0 => (0 : ℝ≥0))
                (maxActivatedPrimeFragment R (row.activation : ℝ) (∏ i, r i))) : ℝ) ≤ 0 := by
          rcases hrow with hcore | hpoint
          · exact Or.inl hcore
          · right
            apply physicalSource_owner_sup_bounds R _ _ id (fun _ => 0) rfl
              _ 0 hC le_rfl
            intro p hp
            have h := hpoint p hp
            rw [ite_eq_left hord] at h
            have hu := coe_logFragment R hR
              (Nat.pos_of_mem_primeFactors (Finset.mem_filter.mp hp).1)
            refine ⟨?_, le_rfl⟩
            simp only [id_eq, NNReal.coe_add, hu]
            linarith
        have hsmall := sourceSupport_dvd hR hD hDpos hprodpos id (fun _ => 0)
          monotone_const hsrc
        exact hsmall.imp_right And.left
      · rw [ite_eq_right hord]
        have hsrc : logSize R (∏ i, r i) ≤ (row.innerCore : ℝ) ∨
            (primeFragmentOwner (physicalInnerOwner L) R (row.activation : ℝ) (∏ i, r i) : ℝ) ≤
                (row.innerThreshold : ℝ) ∧
              (physicalOuterOwner L
                (maxActivatedPrimeFragment R (row.activation : ℝ) (∏ i, r i)) : ℝ) ≤
                  (row.outerThreshold : ℝ) := by
          rcases hrow with hcore | hpoint
          · exact Or.inl hcore
          · right
            apply physicalSource_owner_sup_bounds R _ _ (physicalInnerOwner L)
              (physicalOuterOwner L) (by simp [physicalOuterOwner]) _ _ hC hA
            intro p hp
            have h := hpoint p hp
            rw [ite_eq_right hord] at h
            have hu := coe_logFragment R hR
              (Nat.pos_of_mem_primeFactors (Finset.mem_filter.mp hp).1)
            have hf := physicalSource_owner_real L (logFragment R p)
            simp only [NNReal.coe_add, hf.1, hf.2, hu, hL]
            exact h
        exact sourceSupport_dvd hR hD hDpos hprodpos (physicalInnerOwner L)
          (physicalOuterOwner L) (physicalOuter_mono L) hsrc

theorem physicalSourceRow_actual_lcm_dense
    (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39))
    (R : ℝ) (hR : 1 < R) (r : Fin 40 → ℕ) (s : Fin 39 → ℕ)
    (hr : Squarefree (∏ i, r i)) (hs : Squarefree (∏ i, s i))
    (houter : physicalSourceOuterSupport (fun i => primeLogConfiguration R (r i)) = 1)
    (hinner : physicalSourceInnerSupport ν (fun i => primeLogConfiguration R (s i)) = 1)
    (D E : ℕ) (hD : D ∣ ∏ i, r i) (hE : E ∣ ∏ i, s i)
    (hband : R ^ ((physicalSourceRow ν t.val).lowerBand : ℝ) < (D.lcm E : ℝ)) :
    ∃ hξ : 1 ≤ R ^ ((physicalSourceRow ν t.val).activation : ℝ),
      Nonempty (DenseDivisibilityWitness
        ⟨R ^ ((physicalSourceRow ν t.val).activation : ℝ), hξ⟩
        (physicalSourceRow ν t.val).order (D.lcm E)) := by
  classical
  let row := physicalSourceRow ν t.val
  let S : ℝ := physicalSourceOuterRadius
  let T : ℝ := physicalSourceInnerRadius ν
  let B : ℝ := row.lowerBand
  let ξ : ℝ := row.activation
  let L : ℝ≥0 := ((23 / 40 : ℝ) * (row.innerThreshold : ℝ)).toNNReal
  have hgeom := physicalSource_cover_fixed_geometry.2.2 ν t
  dsimp only at hgeom
  have hmesh : (0 : ℚ) < trialMesh := by norm_num [trialMesh]
  have hξQ : (0 : ℚ) < row.activation := lt_trans (by positivity) hgeom.2.2.1
  have hξ : 0 ≤ ξ := by
    change (0 : ℝ) ≤ (row.activation : ℝ)
    exact_mod_cast hξQ.le
  refine ⟨Real.one_le_rpow hR.le hξ, ?_⟩
  change Nonempty (DenseDivisibilityWitness
    ⟨R ^ ξ, Real.one_le_rpow hR.le hξ⟩ row.order (D.lcm E))
  have hDs : Squarefree D := hr.squarefree_of_dvd hD
  have hEs : Squarefree E := hs.squarefree_of_dvd hE
  have hO := physicalSourceOuterSupport_divisor_owner ν t R hR r hr houter D hD
  have hI := physicalSourceInnerSupport_divisor_owner ν t R hR s hs hinner E hE
  have hOO : if row.order ≤ 2 then
      logSize R D ≤ (row.outerCore : ℝ) ∨
        (primeFragmentOwner id R ξ D : ℝ) ≤ (row.outerThreshold : ℝ)
    else logSize R D ≤ (row.outerCore : ℝ) ∨
      (primeFragmentOwner (physicalOuterOwner L) R ξ D : ℝ) ≤ (row.outerThreshold : ℝ) ∧
        (physicalInnerOwner L (maxActivatedPrimeFragment R ξ D) : ℝ) ≤
          (row.innerThreshold : ℝ) := hO.2.2
  have hII : row.order = 1 ∨ if row.order ≤ 2 then
      logSize R E ≤ (row.innerCore : ℝ) ∨
        (primeFragmentOwner id R ξ E : ℝ) ≤ (row.innerThreshold : ℝ)
    else logSize R E ≤ (row.innerCore : ℝ) ∨
      (primeFragmentOwner (physicalInnerOwner L) R ξ E : ℝ) ≤ (row.innerThreshold : ℝ) ∧
        (physicalOuterOwner L (maxActivatedPrimeFragment R ξ E) : ℝ) ≤
          (row.outerThreshold : ℝ) := hI.2.2
  have hS : logSize R D ≤ S := hO.1
  have hT : logSize R E ≤ T := hI.1
  have hcoreO : (row.outerCore : ℝ) = B - T := Rat.cast_sub _ _
  have hcoreI : (row.innerCore : ℝ) = B - S := Rat.cast_sub _ _
  have hord : row.order = 1 ∨ row.order = 2 ∨ row.order = 3 := by
    change physicalSourceOrder t.val = 1 ∨ physicalSourceOrder t.val = 2 ∨
      physicalSourceOrder t.val = 3
    by_cases ht12 : t.val < 12 <;> by_cases ht24 : t.val < 24 <;>
      simp [physicalSourceOrder, ht12, ht24]
  by_cases hlow : row.order ≤ 2
  · have hAO : (row.outerThreshold : ℝ) = B - T + ξ := by
      change ((row.outerCore +
        (if row.order ≤ 2 then row.activation else
          (row.activation + physicalSourceOuterRadius + physicalSourceInnerRadius ν -
            row.lowerBand) / 2) : ℚ) : ℝ) = _
      rw [ite_eq_left hlow, Rat.cast_add, hcoreO]
    have hAI : (row.innerThreshold : ℝ) = B - S + ξ := by
      change ((row.innerCore +
        (if row.order ≤ 2 then row.activation else
          (row.activation + physicalSourceOuterRadius + physicalSourceInnerRadius ν -
            row.lowerBand) / 2) : ℚ) : ℝ) = _
      rw [ite_eq_left hlow, Rat.cast_add, hcoreI]
    have hret := (physicalSource_retained_thresholds ν).2 t
    have hretO : (row.outerThreshold : ℝ) = S + (physicalSourceAdvance : ℝ) := by
      have hq := hret.1
      change row.outerThreshold = physicalSourceOuterRadius +
        (if row.order ≤ 2 then physicalSourceAdvance else physicalSourceAdvance / 2) at hq
      rw [ite_eq_left hlow] at hq
      change (row.outerThreshold : ℝ) = (physicalSourceOuterRadius : ℝ) +
        (physicalSourceAdvance : ℝ)
      exact_mod_cast hq
    have hkey : B + ξ = S + T + (physicalSourceAdvance : ℝ) := by linarith
    have hguards : 2 * T ≤ S + T + (physicalSourceAdvance : ℝ) ∧
        2 * S - T ≤ S + T + (physicalSourceAdvance : ℝ) ∧
        2 * T - S ≤ S + T + (physicalSourceAdvance : ℝ) := by
      dsimp only [S, T]
      fin_cases ν <;>
        norm_num [physicalSourceOuterRadius, physicalSourceInnerRadius,
          physicalSourceAdvance, physicalSourceRho, trialMesh]
    have hOs : logSize R D ≤ B - T ∨
        (primeFragmentOwner id R ξ D : ℝ) ≤ B - T + ξ := by
      simpa only [ite_eq_left hlow, hcoreO, hAO] using hOO
    rcases hord with hone | htwo | hthree
    · simpa only [hone] using denseDivisibility_lcm_one_of_owner_bound hR hξ hDs hEs hS hT
        (by rw [hkey]; exact hguards.1) hOs hband
    · have hIs : logSize R E ≤ B - S ∨
          (primeFragmentOwner id R ξ E : ℝ) ≤ B - S + ξ := by
        have hh := hII.resolve_left (by omega)
        simpa only [ite_eq_left hlow, hcoreI, hAI] using hh
      simpa only [htwo] using denseDivisibility_lcm_two_of_owner_bounds hR hξ hDs hEs hS hT
        (by rw [hkey]; exact hguards.2.1) (by rw [hkey]; exact hguards.2.2)
        hOs hIs hband
    · omega
  · have hthree : row.order = 3 := by omega
    let η : ℝ := (ξ + S + T - B) / 2
    have hAO : (row.outerThreshold : ℝ) = B - T + η := by
      change ((row.outerCore +
        (if row.order ≤ 2 then row.activation else
          (row.activation + physicalSourceOuterRadius + physicalSourceInnerRadius ν -
            row.lowerBand) / 2) : ℚ) : ℝ) = _
      rw [ite_eq_right hlow, Rat.cast_add, hcoreO]
      simp only [η, ξ, S, T, B, Rat.cast_div, Rat.cast_sub, Rat.cast_add,
        Rat.cast_ofNat]
    have hAI : (row.innerThreshold : ℝ) = B - S + η := by
      change ((row.innerCore +
        (if row.order ≤ 2 then row.activation else
          (row.activation + physicalSourceOuterRadius + physicalSourceInnerRadius ν -
            row.lowerBand) / 2) : ℚ) : ℝ) = _
      rw [ite_eq_right hlow, Rat.cast_add, hcoreI]
      simp only [η, ξ, S, T, B, Rat.cast_div, Rat.cast_sub, Rat.cast_add,
        Rat.cast_ofNat]
    have hOs : logSize R D ≤ B - T ∨
        (primeFragmentOwner (physicalOuterOwner L) R ξ D : ℝ) ≤ B - T + η ∧
          (physicalInnerOwner L (maxActivatedPrimeFragment R ξ D) : ℝ) ≤ B - S + η := by
      simpa only [ite_eq_right hlow, hcoreO, hAO, hAI] using hOO
    have hIs : logSize R E ≤ B - S ∨
        (primeFragmentOwner (physicalInnerOwner L) R ξ E : ℝ) ≤ B - S + η ∧
          (physicalOuterOwner L (maxActivatedPrimeFragment R ξ E) : ℝ) ≤ B - T + η := by
      have hh := hII.resolve_left (by omega)
      simpa only [ite_eq_right hlow, hcoreI, hAO, hAI] using hh
    have hbudget : (B - T + η) + (B - S + η) ≤ B + ξ := by dsimp [η]; linarith
    simpa only [hthree] using denseDivisibility_lcm_three_of_nonlinear_owner_bounds hR
      hξ hDs hEs hS hT
      (physicalOuterOwner L) (physicalInnerOwner L) (physicalOuter_mono L)
      (physicalInner_mono L) (physicalOwner_sum L) hbudget hOs hIs hband

theorem physicalSource_actual_lcm_row_of_radii (ν : Fin 2) (R : ℝ) (hR : 1 < R)
    (D E : ℕ) (hD : Squarefree D) (hE : Squarefree E)
    (hDsize : logSize R D ≤ (98303 : ℝ) * (trialMesh : ℝ))
    (hEsize : logSize R E ≤
      (if ν = 0 then (89563 : ℝ) else 89953) * (trialMesh : ℝ)) :
    (D.lcm E : ℝ) ≤ R ^ ((((1 / 2) / physicalSourceRho : ℚ) : ℝ)) ∨
      ∃ t : Fin (if ν = 0 then 28 else 39),
        R ^ ((physicalSourceRow ν t.val).lowerBand : ℝ) < (D.lcm E : ℝ) ∧
          (D.lcm E : ℝ) ≤ R ^ ((physicalSourceRow ν t.val).upperBand : ℝ) := by
  have hqpos : 0 < (D.lcm E : ℝ) := by
    exact_mod_cast Nat.lcm_pos (Nat.pos_of_ne_zero hD.ne_zero)
      (Nat.pos_of_ne_zero hE.ne_zero)
  by_cases hbase : (D.lcm E : ℝ) ≤
      R ^ ((((1 / 2) / physicalSourceRho : ℚ) : ℝ))
  · exact Or.inl hbase
  right
  have hlow : ((((1 / 2) / physicalSourceRho : ℚ) : ℝ)) <
      logSize R (D.lcm E) :=
    (Real.lt_logb_iff_rpow_lt hR hqpos).mpr (lt_of_not_ge hbase)
  have hlog : logSize R (D.lcm E) ≤ logSize R D + logSize R E := by
    calc
      logSize R (D.lcm E) ≤ logSize R (D * E) :=
        Real.logb_le_logb_of_le hR hqpos (Nat.cast_le.mpr
          (Nat.lcm_le_mul (Nat.pos_of_ne_zero hD.ne_zero)
            (Nat.pos_of_ne_zero hE.ne_zero)))
      _ = logSize R D + logSize R E := by
        dsimp only [logSize]
        rw [Nat.cast_mul, Real.logb_mul
          (Nat.cast_ne_zero.mpr hD.ne_zero) (Nat.cast_ne_zero.mpr hE.ne_zero)]
  have hhigh : logSize R (D.lcm E) ≤
      ((98303 * trialMesh + (if ν = 0 then 89563 else 89953) * trialMesh : ℚ) : ℝ) := by
    simpa only [Rat.cast_add, Rat.cast_mul, apply_ite, Rat.cast_ofNat] using
      hlog.trans (add_le_add hDsize hEsize)
  obtain ⟨t, ht, hlo, hhi⟩ :=
    (physicalSource_actual_lcm_bands ν).2.2.2 (logSize R (D.lcm E)) hlow hhigh
  refine ⟨⟨t.val, ht⟩, ?_, ?_⟩
  · exact (Real.lt_logb_iff_rpow_lt hR hqpos).mp hlo
  · exact (Real.logb_le_iff_le_rpow hR hqpos).mp hhi

theorem physicalSource_sampled_pair_actual_lcm_dense
    (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39))
    (W : ℕ) (R κ Z₀ Z₁ : ℝ) (hR : 1 < R)
    (f : (Fin 40 → ℕ) → ℝ) (g : (Fin 39 → ℕ) → ℝ)
    (i : Fin 40) (d e : Fin 39 → ℕ) :
    let q := ∏ p ∈ fragmentPrimes W R κ, p
    let T₀ := (Fintype.piFinset (fun _ : Fin 40 => q.divisors)).filter
      (fun r => Squarefree (∏ j, r j))
    let T₁ := (Fintype.piFinset (fun _ : Fin 39 => q.divisors)).filter
      (fun r => Squarefree (∏ j, r j))
    let y := ∑ r ∈ T₀, Finsupp.single r (f r / Z₀)
    let z := ∑ r ∈ T₁, Finsupp.single r (g r / Z₁)
    (∀ r ∈ T₀, f r ≠ 0 →
      physicalSourceOuterSupport (fun j => primeLogConfiguration R (r j)) = 1) →
    (∀ r ∈ T₁, g r ≠ 0 →
      physicalSourceInnerSupport ν (fun j => primeLogConfiguration R (r j)) = 1) →
    selbergCoefficient y (i.insertNth 1 d) ≠ 0 → selbergCoefficient z e ≠ 0 →
    R ^ ((physicalSourceRow ν t.val).lowerBand : ℝ) <
      (Nat.lcm (∏ j, d j) (∏ j, e j) : ℝ) →
    ∃ hξ : 1 ≤ R ^ ((physicalSourceRow ν t.val).activation : ℝ),
      Nonempty (DenseDivisibilityWitness
        ⟨R ^ ((physicalSourceRow ν t.val).activation : ℝ), hξ⟩
        (physicalSourceRow ν t.val).order (Nat.lcm (∏ j, d j) (∏ j, e j))) := by
  classical
  intro q T₀ T₁ y z hf hg hd he hband
  obtain ⟨r, hr, hfr, hdr⟩ :=
    selberg_sampled_coefficient_root T₀ f Z₀ (i.insertNth 1 d) hd
  obtain ⟨s, hs, hgs, hes⟩ := selberg_sampled_coefficient_root T₁ g Z₁ e he
  have hD : (∏ j : Fin 39, d j) ∣ ∏ j : Fin 40, r j := by
    have h := Finset.prod_dvd_prod_of_dvd (s := Finset.univ) (i.insertNth 1 d) r
      (fun j _ => hdr j)
    simpa only [Fin.prod_insertNth, one_mul] using h
  exact physicalSourceRow_actual_lcm_dense ν t R hR r s
    (Finset.mem_filter.mp hr).2 (Finset.mem_filter.mp hs).2
    (hf r hr hfr) (hg s hs hgs) _ _ hD
    (Finset.prod_dvd_prod_of_dvd e s (fun j _ => hes j)) hband

theorem physicalSource_sampled_erased_pair_actual_lcm_dense
    (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39))
    (W : ℕ) (R κ Z₀ Z₁ : ℝ) (hR : 1 < R)
    (f g : (Fin 40 → ℕ) → ℝ) (i : Fin 40) (d e : Fin 39 → ℕ) :
    let q := ∏ p ∈ fragmentPrimes W R κ, p
    let T := (Fintype.piFinset (fun _ : Fin 40 => q.divisors)).filter
      (fun r => Squarefree (∏ j, r j))
    let y := ∑ r ∈ T, Finsupp.single r (f r / Z₀)
    let z₀ := ∑ r ∈ T, Finsupp.single r (g r / Z₁)
    let z : (Fin 39 → ℕ) →₀ ℝ :=
      z₀.sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
        (yr / ((r i).totient : ℝ)))
    (∀ r ∈ T, f r ≠ 0 →
      physicalSourceOuterSupport (fun j => primeLogConfiguration R (r j)) = 1) →
    (∀ r ∈ T, g r ≠ 0 →
      physicalSourceInnerSupport ν
        (fun j => primeLogConfiguration R (r (i.succAbove j))) = 1) →
    selbergCoefficient y (i.insertNth 1 d) ≠ 0 → selbergCoefficient z e ≠ 0 →
    R ^ ((physicalSourceRow ν t.val).lowerBand : ℝ) <
      (Nat.lcm (∏ j, d j) (∏ j, e j) : ℝ) →
    ∃ hξ : 1 ≤ R ^ ((physicalSourceRow ν t.val).activation : ℝ),
      Nonempty (DenseDivisibilityWitness
        ⟨R ^ ((physicalSourceRow ν t.val).activation : ℝ), hξ⟩
        (physicalSourceRow ν t.val).order (Nat.lcm (∏ j, d j) (∏ j, e j))) := by
  classical
  intro q T y z₀ z hf hg hd he hband
  obtain ⟨r, hr, hfr, hdr⟩ :=
    selberg_sampled_coefficient_root T f Z₀ (i.insertNth 1 d) hd
  obtain ⟨_, _, _, s, hs, hgs, hes⟩ :=
    selberg_sampled_erased_coefficient_presieve W R κ Z₁ g i e he
  have hsfull : Squarefree (∏ j : Fin 40, s j) := (Finset.mem_filter.mp hs).2
  have hsdiv : (∏ j : Fin 39, s (i.succAbove j)) ∣ ∏ j : Fin 40, s j := by
    rw [Fin.prod_univ_succAbove _ i]
    exact dvd_mul_left _ _
  have hD : (∏ j : Fin 39, d j) ∣ ∏ j : Fin 40, r j := by
    have h := Finset.prod_dvd_prod_of_dvd (s := Finset.univ) (i.insertNth 1 d) r
      (fun j _ => hdr j)
    simpa only [Fin.prod_insertNth, one_mul] using h
  exact physicalSourceRow_actual_lcm_dense ν t R hR r (fun j => s (i.succAbove j))
    (Finset.mem_filter.mp hr).2 (hsfull.squarefree_of_dvd hsdiv)
    (hf r hr hfr) (hg s hs hgs) _ _ hD
    (Finset.prod_dvd_prod_of_dvd e (fun j => s (i.succAbove j))
      (fun j _ => hes j)) hband

theorem physicalSource_common_self_geometry :
    let row := physicalSourceRow (1 : Fin 2) 12
    let B : ℚ := (1 / 2) / physicalSourceRho
    let T : ℚ := physicalSourceInnerRadius 1
    let ξ : ℚ := (21319 / 800000) / physicalSourceRho
    row.order = 2 ∧
      row.innerCore ≤ B - T ∧
      row.activation ≤ ξ ∧
      row.innerThreshold = row.innerCore + row.activation ∧
      row.innerThreshold ≤ B - T + ξ ∧
      0 ≤ B - T + ξ ∧ 0 ≤ ξ := by
  decide +kernel

theorem physicalSourceInnerSupport_common_self_buffer
    (R : ℝ) (hR : 1 < R) (r : Fin 39 → ℕ)
    (hr : Squarefree (∏ i, r i))
    (hmask : physicalSourceInnerSupport (1 : Fin 2)
      (fun i => primeLogConfiguration R (r i)) = 1)
    (D : ℕ) (hD : D ∣ ∏ i, r i) :
    let B : ℝ := (((1 / 2 : ℚ) / physicalSourceRho) : ℝ)
    let T : ℝ := physicalSourceInnerRadius 1
    let ξ : ℝ := (((21319 / 800000 : ℚ) / physicalSourceRho) : ℝ)
    logSize R D ≤ T ∧
      (∀ p ∈ D.primeFactors,
        logSize R p ≤ (((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ)) ∧
      (logSize R D ≤ B - T ∨ (primeFragmentOwner id R ξ D : ℝ) ≤ B - T + ξ) := by
  classical
  intro B T ξ
  let row := physicalSourceRow (1 : Fin 2) 12
  obtain ⟨horder, hcore, hactivation, _hthreshold, hbound, _hbudget, _hξ⟩ :=
    physicalSource_common_self_geometry
  have hsource := physicalSourceInnerSupport_divisor_owner (1 : Fin 2)
    (⟨12, by decide⟩ : Fin (if (1 : Fin 2) = 0 then 28 else 39))
    R hR r hr hmask D hD
  have hcoreR : (row.innerCore : ℝ) ≤ B - T := by
    dsimp only [row, B, T]
    exact_mod_cast hcore
  have hactivationR : (row.activation : ℝ) ≤ ξ := by
    dsimp only [row, ξ]
    exact_mod_cast hactivation
  have hboundR : (row.innerThreshold : ℝ) ≤ B - T + ξ := by
    dsimp only [row, B, T, ξ]
    exact_mod_cast hbound
  refine ⟨hsource.1, hsource.2.1, ?_⟩
  have hnotone : row.order ≠ 1 := by rw [horder]; norm_num
  have hlow : row.order ≤ 2 := by rw [horder]
  have hrow := hsource.2.2.resolve_left hnotone
  rw [ite_eq_left hlow] at hrow
  rcases hrow with hsmall | howner
  · exact Or.inl (hsmall.trans hcoreR)
  · right
    have hactive : activatedPrimeFactors R ξ D ⊆ activatedPrimeFactors R (row.activation : ℝ) D :=
      Finset.monotone_filter_right _ (fun p _ hp =>
        (Real.rpow_le_rpow_of_exponent_le hR.le hactivationR).trans_lt hp)
    have hmono : primeFragmentOwner id R ξ D ≤ primeFragmentOwner id R (row.activation : ℝ) D :=
      Finset.sup_mono hactive
    exact (show (primeFragmentOwner id R ξ D : ℝ) ≤
      (primeFragmentOwner id R (row.activation : ℝ) D : ℝ) by exact_mod_cast hmono).trans
        (howner.trans hboundR)

theorem physicalSourceInnerSupport_common_self_lcm_dense
    (R : ℝ) (hR : 1 < R) (r s : Fin 39 → ℕ)
    (hr : Squarefree (∏ i, r i)) (hs : Squarefree (∏ i, s i))
    (hleft : physicalSourceInnerSupport (1 : Fin 2)
      (fun i => primeLogConfiguration R (r i)) = 1)
    (hright : physicalSourceInnerSupport (1 : Fin 2)
      (fun i => primeLogConfiguration R (s i)) = 1)
    (D E : ℕ) (hD : D ∣ ∏ i, r i) (hE : E ∣ ∏ i, s i)
    (hband : R ^ ((((1 / 2 : ℚ) / physicalSourceRho) : ℝ)) < (D.lcm E : ℝ)) :
    ∃ hξ : 1 ≤ R ^ ((((21319 / 800000 : ℚ) / physicalSourceRho) : ℝ)),
      Nonempty (DenseDivisibilityWitness
        ⟨R ^ ((((21319 / 800000 : ℚ) / physicalSourceRho) : ℝ)), hξ⟩ 2 (D.lcm E)) := by
  let B : ℝ := (((1 / 2 : ℚ) / physicalSourceRho) : ℝ)
  let T : ℝ := physicalSourceInnerRadius 1
  let ξ : ℝ := (((21319 / 800000 : ℚ) / physicalSourceRho) : ℝ)
  have hdata := physicalSource_common_self_geometry
  have hξ : 0 ≤ ξ := by
    dsimp only [ξ]
    exact_mod_cast hdata.2.2.2.2.2.2
  have hbudget : 0 ≤ B - T + ξ := by
    dsimp only [B, T, ξ]
    exact_mod_cast hdata.2.2.2.2.2.1
  refine ⟨Real.one_le_rpow hR.le hξ, ?_⟩
  have hl := physicalSourceInnerSupport_common_self_buffer R hR r hr hleft D hD
  have hh := physicalSourceInnerSupport_common_self_buffer R hR s hs hright E hE
  exact denseDivisibility_lcm_two_of_common_owner_bounds hR hξ hbudget
    (hr.squarefree_of_dvd hD) (hs.squarefree_of_dvd hE)
    hl.1 hh.1 hl.2.2 hh.2.2 hband

theorem physicalSourceRow_presieve_parameter_retreat
    (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)) :
    let row := physicalSourceRow ν t.val
    let ρ : ℝ := 2624989 / 10000000
    ∃ ε : ℝ, 0 < ε ∧ ∀ x : ℝ, 1 < x → ∀ W D E : ℕ,
      0 < W → (W : ℝ) ≤ x ^ ε → D.Coprime W → E.Coprime W →
      (∃ hY : 1 ≤ (x ^ ρ) ^ (row.activation : ℝ),
        Nonempty (DenseDivisibilityWitness
          ⟨(x ^ ρ) ^ (row.activation : ℝ), hY⟩ row.order (D.lcm E))) →
      (D.lcm E : ℝ) ≤ (x ^ ρ) ^ (row.upperBand : ℝ) →
      ∃ hδ : 1 ≤ x ^ ((physicalSourceRho : ℝ) * (row.activation : ℝ)),
        Nonempty (DenseDivisibilityWitness
          ⟨x ^ ((physicalSourceRho : ℝ) * (row.activation : ℝ)), hδ⟩
          row.order (W.lcm (D.lcm E))) ∧
          (W.lcm (D.lcm E) : ℝ) <
            x ^ ((1 / 2 : ℝ) + 2 * (physicalSourceOmegaPrefix ν (t.val + 1) : ℝ)) := by
  intro row ρ
  have hρ : 0 < ρ := by norm_num [ρ]
  have hρformal : (0 : ℚ) < physicalSourceRho := by norm_num [physicalSourceRho]
  have hρgap : ρ < (physicalSourceRho : ℝ) := by norm_num [ρ, physicalSourceRho]
  have htL : t.val + 1 ≤ physicalSourceLadderLength ν := by
    have ht := t.isLt
    fin_cases ν <;> norm_num [physicalSourceLadderLength] at * <;> omega
  have hprefix := physicalSource_first_hit_and_monotone ν
  have hω : (0 : ℚ) < physicalSourceOmegaPrefix ν (t.val + 1) := by
    have h := hprefix.2.1
      (show (⟨0, Nat.succ_pos _⟩ : Fin (physicalSourceLadderLength ν + 1)) <
        ⟨t.val + 1, Nat.lt_succ_of_le htL⟩ from Nat.succ_pos _)
    simpa only [hprefix.1] using h
  have hB : 0 < (row.upperBand : ℝ) := by
    change (0 : ℝ) <
      (((1 / 2 + 2 * physicalSourceOmegaPrefix ν (t.val + 1)) /
        physicalSourceRho : ℚ) : ℝ)
    exact_mod_cast div_pos (by positivity) hρformal
  have hgeom := physicalSource_cover_fixed_geometry.2.2 ν t
  have hξ : 0 < (row.activation : ℝ) := by
    have hmesh : (0 : ℚ) < trialMesh := by norm_num [trialMesh]
    exact_mod_cast lt_trans (by positivity : (0 : ℚ) < 2 * trialMesh) hgeom.2.2.1
  have hθ : (physicalSourceRho : ℝ) * (row.upperBand : ℝ) =
      (1 / 2 : ℝ) + 2 * (physicalSourceOmegaPrefix ν (t.val + 1) : ℝ) := by
    change (physicalSourceRho : ℝ) *
      (((1 / 2 + 2 * physicalSourceOmegaPrefix ν (t.val + 1)) /
        physicalSourceRho : ℚ) : ℝ) = _
    push_cast
    field_simp [ne_of_gt (show (0 : ℝ) < physicalSourceRho by exact_mod_cast hρformal)]
  let ε := min (((physicalSourceRho : ℝ) - ρ) * (row.upperBand : ℝ) / 2)
    (ρ * (row.activation : ℝ) / 2)
  have hε : 0 < ε := lt_min
    (div_pos (mul_pos (sub_pos.mpr hρgap) hB) (by norm_num))
    (div_pos (mul_pos hρ hξ) (by norm_num))
  refine ⟨ε, hε, ?_⟩
  intro x hx W D E hW hWsize hDW hEW hN hNsize
  obtain ⟨hY, hN⟩ := hN
  have hεξ : ε ≤ ρ * (row.activation : ℝ) :=
    (min_le_right _ _).trans (by nlinarith [mul_pos hρ hξ])
  have hWY : (W : ℝ) ≤ (x ^ ρ) ^ (row.activation : ℝ) := by
    rw [← Real.rpow_mul (zero_le_one.trans hx.le)]
    exact hWsize.trans (Real.rpow_le_rpow_of_exponent_le hx.le hεξ)
  have hpresieve := denseDivisibility_presieve_lcm hN hW hWY hDW hEW
  have hδnonneg : 0 ≤ (physicalSourceRho : ℝ) * (row.activation : ℝ) :=
    mul_nonneg (by exact_mod_cast hρformal.le) hξ.le
  refine ⟨Real.one_le_rpow hx.le hδnonneg, ?_, ?_⟩
  · apply denseDivisibility_mono_scale _ hpresieve
    change (x ^ ρ) ^ (row.activation : ℝ) ≤
      x ^ ((physicalSourceRho : ℝ) * (row.activation : ℝ))
    rw [← Real.rpow_mul (zero_le_one.trans hx.le)]
    exact Real.rpow_le_rpow_of_exponent_le hx.le
      (mul_le_mul_of_nonneg_right hρgap.le hξ.le)
  · have hcop : W.Coprime (D.lcm E) :=
      (hDW.symm.mul_right hEW.symm).coprime_dvd_right (Nat.lcm_dvd_mul D E)
    have he : ε + ρ * (row.upperBand : ℝ) <
        (physicalSourceRho : ℝ) * (row.upperBand : ℝ) := by
      have hm := min_le_left
        (((physicalSourceRho : ℝ) - ρ) * (row.upperBand : ℝ) / 2)
        (ρ * (row.activation : ℝ) / 2)
      change ε ≤ _ at hm
      norm_num [ρ, physicalSourceRho] at hm ⊢
      linarith only [hm, hB]
    calc
      (W.lcm (D.lcm E) : ℝ) = (W : ℝ) * (D.lcm E : ℝ) := by
        rw [hcop.lcm_eq_mul, Nat.cast_mul]
      _ ≤ x ^ ε * (x ^ ρ) ^ (row.upperBand : ℝ) :=
        mul_le_mul hWsize hNsize (Nat.cast_nonneg _)
          (Real.rpow_nonneg (zero_le_one.trans hx.le) _)
      _ = x ^ (ε + ρ * (row.upperBand : ℝ)) := by
        rw [← Real.rpow_mul (zero_le_one.trans hx.le),
          Real.rpow_add (zero_lt_one.trans hx)]
      _ < x ^ ((physicalSourceRho : ℝ) * (row.upperBand : ℝ)) :=
        Real.rpow_lt_rpow_of_exponent_lt hx he
      _ = _ := by rw [hθ]

section
open scoped ContDiff

/-!
## Roughness, erased coordinates, and first moments

Use coordinate erasure on rough inputs and correction profiles to obtain positive
prime-detecting moments.
-/

theorem selberg_root_eq_erased_on_rough
    (i : Fin 40) (y : (Fin 40 → ℕ) →₀ ℝ) (h : Fin 40 → ℕ) (n : ℕ) (Y : ℝ)
    (hcap : ∀ d : Fin 40 → ℕ, selbergCoefficient y d ≠ 0 →
      ∀ p : ℕ, p.Prime → p ∣ d i → (p : ℝ) < Y)
    (hrough : ∀ p : ℕ, p.Prime → p ∣ n + h i → Y ≤ (p : ℝ)) :
    let z : (Fin 39 → ℕ) →₀ ℝ :=
      y.sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
        (yr / ((r i).totient : ℝ)))
    let D := y.support.biUnion
      (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let E := z.support.biUnion
      (fun r => Fintype.piFinset (fun j => (r j).divisors))
    (∑ d ∈ D, if ∀ j, d j ∣ n + h j then selbergCoefficient y d else 0) =
      ∑ d ∈ E, if ∀ j, d j ∣ n + h (i.succAbove j) then
        selbergCoefficient z d else 0 := by
  classical
  intro z D E
  rw [← selberg_divisor_sum_weighted_erase i y h n]
  apply Finset.sum_congr rfl
  intro d _
  by_cases hc : selbergCoefficient y d = 0
  · simp only [hc, ite_self]
  by_cases hdiv : ∀ j, d j ∣ n + h j
  · have hdi : d i = 1 := by
      by_contra hne
      obtain ⟨p, hp, hpd⟩ := Nat.exists_prime_and_dvd hne
      exact (not_lt_of_ge (hrough p hp (hpd.trans (hdiv i)))) (hcap d hc p hp hpd)
    simp only [hdiv, hdi, true_and]
  · simp only [hdiv, and_false, ite_false]

theorem coprime_of_prime_cap_of_rough
    (q n : ℕ) (Y Z : ℝ) (hZY : Z < Y)
    (hcap : ∀ p : ℕ, p.Prime → p ∣ q → (p : ℝ) ≤ Z)
    (hrough : ∀ p : ℕ, p.Prime → p ∣ n → Y ≤ (p : ℝ)) :
    Nat.Coprime n q :=
  Nat.coprime_of_dvd fun p hp hpn hpq =>
    not_lt_of_ge ((hrough p hp hpn).trans (hcap p hp hpq)) hZY

theorem reduced_shifted_weight_eq_total
    (I : Finset ℕ) (f : ℕ → ℝ) (h q : ℕ) (Y Z : ℝ) (hZY : Z < Y)
    (hcap : ∀ p : ℕ, p.Prime → p ∣ q → (p : ℝ) ≤ Z)
    (hrough : ∀ n ∈ I, f (n + h) ≠ 0 → n + h ≠ 0 ∧
      ∀ p ∈ (n + h).primeFactors, Y ≤ (p : ℝ)) :
    (∑ n ∈ I, if Nat.Coprime (n + h) q then f (n + h) else 0) =
      ∑ n ∈ I, f (n + h) := by
  classical
  apply Finset.sum_congr rfl
  intro n hn
  by_cases hf : f (n + h) = 0
  · simp only [hf, ite_self]
  have hr := hrough n hn hf
  have hc : Nat.Coprime (n + h) q :=
    coprime_of_prime_cap_of_rough q (n + h) Y Z hZY hcap
      (fun p hp hpd => hr.2 p (Nat.mem_primeFactors.mpr ⟨hp, hpd, hr.1⟩))
  exact ite_eq_left hc

open Classical in
theorem canonical40_fixed_profile_coefficient_roots
    {𝓗 : Finset ℕ}
    {h𝓗_card : 𝓗.card = 40}
    {m : ℕ} (i : Fin 40) (a : Fin (m + 2) → ℝ)
    (F : (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
    (hbF : Bornology.IsBounded (Set.range F)) :
    let ρ : ℝ := 2624989 / 10000000
    let ξ₀ : ℝ := 19037 / 100000
    let κ : ℝ := ξ₀ / ρ
    let h : Fin 40 → ℕ := 𝓗.orderEmbOfFin h𝓗_card
    let W : ℝ → ℕ := presievingModulus 𝓗
    let R : ℝ → ℝ := fun x => x ^ ρ
    let B : ℝ → ℝ := fun x => fragmentNormalization (W x) (R x)
    let q : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) (R x) κ, p
    let T : ℝ → Finset (Fin 40 → ℕ) := fun x =>
      (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
        (fun r => Squarefree (∏ j, r j))
    let X : ℝ → ℕ → Fin (m + 1) → ℝ := fun x n =>
      fragmentBandMasses a (primeLogConfiguration (R x) n)
    let y : ℝ → ((Fin 40 → ℕ) →₀ ℝ) := fun x =>
      ∑ r ∈ T x, Finsupp.single r (F (fun j => X x (r j)) / B x ^ 40)
    let z : ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun x =>
      (y x).sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
        (yr / ((r i).totient : ℝ)))
    let D : ℝ → Finset (Fin 40 → ℕ) := fun x =>
      (y x).support.biUnion (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let E : ℝ → Finset (Fin 39 → ℕ) := fun x =>
      (z x).support.biUnion (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let A : ℝ → ℕ → ℝ := fun x n =>
      ∑ d ∈ D x, if ∀ j, d j ∣ n + h j then selbergCoefficient (y x) d else 0
    let C : ℝ → ℕ → ℝ := fun x n =>
      ∑ d ∈ E x, if ∀ j, d j ∣ n + h (i.succAbove j) then
        selbergCoefficient (z x) d else 0
    (∃ K : ℝ, 0 < K ∧ ∀ᶠ x : ℝ in atTop,
      1 < x ∧ ∀ d : Fin 39 → ℕ, |selbergCoefficient (z x) d| ≤ K * Real.log x) ∧
    ∀ η : ℝ, 0 < η → ∃ K : ℝ, 0 < K ∧ ∀ᶠ x : ℝ in atTop,
      ∀ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        |A x n| ≤ K * x ^ η ∧ |C x n| ≤ K * x ^ η := by
  intro ρ ξ₀ κ h W R B q T X y z D E A C
  have hite (p : Prop) (dec : Decidable p) (u v : ℝ) :
      @ite ℝ p dec u v = @ite ℝ p (Classical.propDecidable p) u v :=
    @ite_cond_congr ℝ p p dec (Classical.propDecidable p) u v rfl
  have hκ : 0 < κ := by norm_num [κ, ξ₀, ρ]
  have hb0 : Bornology.IsBounded
      (Set.range (fun _ : Fin 39 → Fin (m + 1) → ℝ => (0 : ℝ))) := by simp
  have he :
      (∃ K : ℝ, 0 < K ∧ ∀ᶠ x : ℝ in atTop,
        1 < x ∧ ∀ d : Fin 39 → ℕ, |selbergCoefficient (z x) d| ≤ K * Real.log x) ∧
      ∀ η : ℝ, 0 < η → ∃ K : ℝ, 0 < K ∧ ∀ᶠ x : ℝ in atTop,
        ∀ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, |C x n| ≤ K * x ^ η := by
    have hraw := canonical_and_erased_finite_coefficient_log_root_subpower
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card)
      (J := Fin 1) i κ hκ a (fun _ => (1 : ℝ)) (fun _ _ => (0 : ℝ))
        (fun _ => F) (fun _ => hb0) (fun _ => hbF)
    simpa only [T, y, z, E, C, hite, zero_div, Finsupp.single_zero,
      Finset.sum_const_zero, zero_add, Fin.sum_univ_one, one_smul, one_mul] using hraw
  refine ⟨he.1, ?_⟩
  intro η hη
  obtain ⟨MF, hMF, hFb⟩ := hbF.exists_pos_norm_le
  simp only [Real.norm_eq_abs] at hFb
  let Cκ : ℝ := Real.exp Real.eulerMascheroniConstant * κ + 1
  let K₀ : ℝ := MF * Cκ ^ 40
  have hK₀ : 0 ≤ K₀ := by dsimp only [K₀, Cκ]; positivity
  obtain ⟨K40, hK40, h40⟩ := selberg_divisor_root_uniform_subpower h K₀ η hK₀ hη
  obtain ⟨K39, hK39, h39⟩ := he.2 η hη
  refine ⟨K40 + K39, add_pos hK40 hK39, ?_⟩
  filter_upwards [selberg40_canonical_erased_coefficient_bound (𝓗 := 𝓗) MF hMF.le, h40, h39]
    with x hc h40x h39x
  obtain ⟨hx, _, _, _, _, hcoeff⟩ := hc
  obtain ⟨hcoeff40, _⟩ :=
    hcoeff (fun Y => F (fun j => fragmentBandMasses a (Y j)))
      (fun Y => hFb _ ⟨fun j => fragmentBandMasses a (Y j), rfl⟩)
  intro n hn
  have hb40 : ∀ d ∈ D x, |selbergCoefficient (y x) d| ≤
      K₀ * ((∏ j, d j : ℕ) : ℝ) / ((∏ j, d j : ℕ).totient : ℝ) := by
    intro d _
    simpa only [K₀, Cκ, T, y, mul_div_assoc] using (hcoeff40 d).2
  have hfull : |A x n| ≤ K40 * x ^ η := by
    simpa only [A, hite] using h40x (y x) (D x) n hn hb40
  have hpow : 0 ≤ x ^ η := Real.rpow_nonneg (zero_le_one.trans hx.le) η
  exact ⟨hfull.trans (mul_le_mul_of_nonneg_right
    (le_add_of_nonneg_right hK39.le) hpow),
    (h39x n hn).trans (mul_le_mul_of_nonneg_right
      (le_add_of_nonneg_left hK40.le) hpow)⟩

open Classical in
theorem canonical40_fixed_profile_prime_minorant_erasure
    {𝓗 : Finset ℕ}
    {h𝓗_card : 𝓗.card = 40}
    {m : ℕ} (i : Fin 40) (a : Fin (m + 2) → ℝ)
    (F : (Fin 40 → Fin (m + 1) → ℝ) → ℝ) :
    let ρ : ℝ := 2624989 / 10000000
    let ξ₀ : ℝ := 19037 / 100000
    let κ : ℝ := ξ₀ / ρ
    let h : Fin 40 → ℕ := 𝓗.orderEmbOfFin h𝓗_card
    let W : ℝ → ℕ := presievingModulus 𝓗
    let R : ℝ → ℝ := fun x => x ^ ρ
    let B : ℝ → ℝ := fun x => fragmentNormalization (W x) (R x)
    let q : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) (R x) κ, p
    let T : ℝ → Finset (Fin 40 → ℕ) := fun x =>
      (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
        (fun r => Squarefree (∏ j, r j))
    let X : ℝ → ℕ → Fin (m + 1) → ℝ := fun x n =>
      fragmentBandMasses a (primeLogConfiguration (R x) n)
    let y : ℝ → ((Fin 40 → ℕ) →₀ ℝ) := fun x =>
      ∑ r ∈ T x, Finsupp.single r (F (fun j => X x (r j)) / B x ^ 40)
    let z : ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun x =>
      (y x).sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
        (yr / ((r i).totient : ℝ)))
    let D : ℝ → Finset (Fin 40 → ℕ) := fun x =>
      (y x).support.biUnion (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let E : ℝ → Finset (Fin 39 → ℕ) := fun x =>
      (z x).support.biUnion (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let A : ℝ → ℕ → ℝ := fun x n =>
      ∑ d ∈ D x, if ∀ j, d j ∣ n + h j then selbergCoefficient (y x) d else 0
    let C : ℝ → ℕ → ℝ := fun x n =>
      ∑ d ∈ E x, if ∀ j, d j ∣ n + h (i.succAbove j) then
        selbergCoefficient (z x) d else 0
    let P : ℕ → ℝ := fun n => if n.Prime then 1 else 0
    let b : ℝ → Fin 2 → ℕ → ℝ := fun x j n =>
      exceptionalPrimeDefect x j n
    let rho : ℝ → ℕ → ℝ := fun x n => P n - b x 0 n - b x 1 n
    ∀ᶠ x : ℝ in atTop, ∀ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
      P (n + h i) * A x n = P (n + h i) * C x n ∧
      (((n + h i : ℕ) : ℝ) ≤ 2 * x →
        rho x (n + h i) * A x n = rho x (n + h i) * C x n ∧
        ∀ j : Fin 2, b x j (n + h i) * A x n = b x j (n + h i) * C x n) := by
  intro ρ ξ₀ κ h W R B q T X y z D E A C P b rho
  have hpi {n : ℕ} (t : Fin n → Finset ℕ) (dec : DecidableEq (Fin n)) :
      @Fintype.piFinset (Fin n) dec _ (fun _ => ℕ) t =
        @Fintype.piFinset (Fin n) (Classical.typeDecidableEq _) _ (fun _ => ℕ) t := by
    ext r
    simp only [Fintype.mem_piFinset]
  have hfilter {n : ℕ} (s : Finset (Fin n → ℕ)) (p : (Fin n → ℕ) → Prop)
      (dec : DecidablePred p) :
      @Finset.filter _ p dec s =
        @Finset.filter _ p (fun r => Classical.propDecidable (p r)) s :=
    @Finset.filter_congr_decidable _ s p dec (fun r => Classical.propDecidable (p r))
  have hite (p : Prop) (dec : Decidable p) (u v : ℝ) :
      @ite ℝ p dec u v = @ite ℝ p (Classical.propDecidable p) u v :=
    @ite_cond_congr ℝ p p dec (Classical.propDecidable p) u v rfl
  filter_upwards [eventually_exceptional_large,
    eventually_literal_minorant_pointwise] with x hx hpoint
  obtain ⟨hx, hlarge⟩ := hx
  have hx0 : 0 < x := zero_lt_one.trans hx
  let ξ : ℝ := 9519 / 50000
  have hscale : R x ^ κ = x ^ ξ₀ := by
    dsimp only [R]
    rw [← Real.rpow_mul hx0.le]
    norm_num [κ, ξ₀, ρ]
  have hcap : ∀ d : Fin 40 → ℕ, selbergCoefficient (y x) d ≠ 0 →
      ∀ p : ℕ, p.Prime → p ∣ d i → (p : ℝ) < x ^ ξ := by
    intro d hd p hp hpd
    have hraw := selberg_sampled_coefficient_presieve (W x) (R x) κ (B x ^ 40)
      (fun r => F (fun j => X x (r j))) d
    have hd' := hd
    simp only [y, T, hpi, hfilter] at hd'
    simp only [hpi, hfilter] at hraw
    have hdq : (∏ j, d j) ∣ q x := (hraw hd').2.2.1
    have hpq : p ∣ q x :=
      (hpd.trans (Finset.dvd_prod_of_mem d (Finset.mem_univ i))).trans hdq
    obtain ⟨r, hr, hpr⟩ := hp.prime.exists_mem_finset_dvd hpq
    have hrp : r.Prime := Nat.prime_of_mem_primesLE (Finset.mem_filter.mp hr).1
    have hpr' : p = r := (Nat.prime_dvd_prime_iff_eq hp hrp).mp hpr
    subst r
    have hpf : p ≤ ⌊R x ^ κ⌋₊ := (Nat.mem_primesLE.mp (Finset.mem_filter.mp hr).1).1
    have hple : (p : ℝ) ≤ x ^ ξ₀ := by
      rw [← hscale]
      exact (Nat.cast_le.mpr hpf).trans
        (Nat.floor_le (Real.rpow_nonneg (Real.rpow_nonneg hx0.le _) _))
    exact hple.trans_lt
      (Real.rpow_lt_rpow_of_exponent_lt hx (by norm_num [ξ₀, ξ]))
  intro n hn
  have hlo : x ≤ ((n + h i : ℕ) : ℝ) :=
    (Nat.le_of_ceil_le (Finset.mem_Icc.mp hn).1).trans
      (Nat.cast_le.mpr (Nat.le_add_right n (h i)))
  have herase (hr : ∀ p : ℕ, p.Prime → p ∣ n + h i → x ^ ξ ≤ (p : ℝ)) :
      A x n = C x n := by
    simpa only [A, C, D, E, z, hpi, hite] using
      selberg_root_eq_erased_on_rough i (y x) h n (x ^ ξ) hcap hr
  constructor
  · by_cases hp : (n + h i).Prime
    · apply congrArg (fun t : ℝ => P (n + h i) * t)
      apply herase
      intro p hpp hpd
      have heq : p = n + h i := (Nat.prime_dvd_prime_iff_eq hpp hp).mp hpd
      rw [heq]
      exact (Real.rpow_le_self_of_one_le hx.le (by norm_num [ξ])).trans hlo
    · simp only [P, hp, ite_false, zero_mul]
  · intro hhi
    constructor
    · by_cases hrho : rho x (n + h i) = 0
      · simp only [hrho, zero_mul]
      · have hrough := (hpoint (n + h i) hlo hhi).2.2.1 hrho
        apply congrArg (fun t : ℝ => rho x (n + h i) * t)
        exact herase (fun p hp hpd =>
          hrough.2 p (hp.mem_primeFactors hpd hrough.1))
    · intro j
      by_cases hb : b x j (n + h i) = 0
      · simp only [hb, zero_mul]
      · have hrough :=
          (exceptionalPrimeDefect_pointwise_properties
            hx hlarge hlo hhi j).2.1 hb
        apply congrArg (fun t : ℝ => b x j (n + h i) * t)
        exact herase (fun p hp hpd =>
          hrough.2 p (hp.mem_primeFactors hpd hrough.1))

open Classical in
theorem canonical40_fixed_profiles_first_moment_erasure
    {𝓗 : Finset ℕ}
    {h𝓗_card : 𝓗.card = 40}
    {m : ℕ} (i : Fin 40) (a : Fin (m + 2) → ℝ)
    (F F' : (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
    (hbF : Bornology.IsBounded (Set.range F))
    (hbF' : Bornology.IsBounded (Set.range F')) :
    let ρ : ℝ := 2624989 / 10000000
    let ξ₀ : ℝ := 19037 / 100000
    let κ : ℝ := ξ₀ / ρ
    let h : Fin 40 → ℕ := 𝓗.orderEmbOfFin h𝓗_card
    let W : ℝ → ℕ := presievingModulus 𝓗
    let R : ℝ → ℝ := fun x => x ^ ρ
    let B : ℝ → ℝ := fun x => fragmentNormalization (W x) (R x)
    let q : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) (R x) κ, p
    let T : ℝ → Finset (Fin 40 → ℕ) := fun x =>
      (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
        (fun r => Squarefree (∏ j, r j))
    let X : ℝ → ℕ → Fin (m + 1) → ℝ := fun x n =>
      fragmentBandMasses a (primeLogConfiguration (R x) n)
    let y : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → ((Fin 40 → ℕ) →₀ ℝ) :=
      fun K x => ∑ r ∈ T x, Finsupp.single r (K (fun j => X x (r j)) / B x ^ 40)
    let z : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → ((Fin 39 → ℕ) →₀ ℝ) :=
      fun K x => (y K x).sum (fun r yr => Finsupp.single
        (fun j => r (i.succAbove j)) (yr / ((r i).totient : ℝ)))
    let D : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → Finset (Fin 40 → ℕ) :=
      fun K x => (y K x).support.biUnion
        (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let E : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → Finset (Fin 39 → ℕ) :=
      fun K x => (z K x).support.biUnion
        (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let A : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → ℕ → ℝ := fun K x n =>
      ∑ d ∈ D K x, if ∀ j, d j ∣ n + h j then selbergCoefficient (y K x) d else 0
    let C : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → ℕ → ℝ := fun K x n =>
      ∑ d ∈ E K x, if ∀ j, d j ∣ n + h (i.succAbove j) then
        selbergCoefficient (z K x) d else 0
    let P : ℕ → ℝ := fun n => if n.Prime then 1 else 0
    let b : ℝ → Fin 2 → ℕ → ℝ := fun x j n =>
      PrimeGap186.exceptionalPrimeDefect x j n
    let rho : ℝ → ℕ → ℝ := fun x n => P n - b x 0 n - b x 1 n
    let EX : ℝ → ℕ → ℝ := fun x n => b x 0 n + b x 1 n
    let I : ℝ → Finset ℕ := fun x => Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
    let S : (ℝ → ℕ → ℝ) → ℝ → ℕ → ℝ := fun f x v =>
      (∑ n ∈ I x, if Nat.ModEq (W x) n v then
        f x (n + h i) * A F x n * C F' x n else 0) -
      ∑ n ∈ I x, if Nat.ModEq (W x) n v then
        f x (n + h i) * C F x n * C F' x n else 0
    (∀ᶠ x : ℝ in atTop, ∀ v : ℕ, S (fun _ => P) x v = 0) ∧
    ∀ ε : ℝ, 0 < ε → ∀ᶠ x : ℝ in atTop,
      let Bx := fragmentNormalization (W x) x
      let N := x / (W x : ℝ) / Bx / B x ^ 39
      1 < x ∧ 0 < N ∧ ∀ v : ℕ,
        |S rho x v| ≤ ε * N ∧ |S EX x v| ≤ ε * N := by
  classical
  intro ρ ξ₀ κ h W R B q T X y z D E A C P b rho EX I S
  have hEndpoint (h : ℕ) (A C E : ℝ → ℕ → ℝ) (mask : ℝ → ℕ → ℕ → Prop)
      (hbound : ∃ K : ℝ, 0 < K ∧ ∀ᶠ x : ℝ in atTop,
        ∀ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
          |A x n| ≤ K * x ^ (1 / 8 : ℝ) ∧
          |C x n| ≤ K * x ^ (1 / 8 : ℝ) ∧
          |E x n| ≤ K * x ^ (1 / 8 : ℝ))
      (hprime : ∀ᶠ x : ℝ in atTop, ∀ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        (if (n + h).Prime then (1 : ℝ) else 0) * A x n =
          (if (n + h).Prime then (1 : ℝ) else 0) * C x n)
      (hinside : ∀ᶠ x : ℝ in atTop, ∀ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        ((n + h : ℕ) : ℝ) ≤ 2 * x →
          ((if (n + h).Prime then (1 : ℝ) else 0) -
              exceptionalPrimeDefect x 0 (n + h) - exceptionalPrimeDefect x 1 (n + h)) *
            A x n =
          ((if (n + h).Prime then (1 : ℝ) else 0) -
              exceptionalPrimeDefect x 0 (n + h) - exceptionalPrimeDefect x 1 (n + h)) *
            C x n) :
      ∃ D : ℝ, 0 < D ∧ ∀ᶠ x : ℝ in atTop, ∀ v : ℕ,
        |∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, if mask x v n then
          ((if (n + h).Prime then (1 : ℝ) else 0) -
              exceptionalPrimeDefect x 0 (n + h) - exceptionalPrimeDefect x 1 (n + h)) *
            A x n * E x n -
          ((if (n + h).Prime then (1 : ℝ) else 0) -
              exceptionalPrimeDefect x 0 (n + h) - exceptionalPrimeDefect x 1 (n + h)) *
            C x n * E x n else 0| ≤ D * x ^ (1 / 2 : ℝ) := by
    clear * - h A C E mask hbound hprime hinside
    classical
    obtain ⟨K, hK, hw⟩ := hbound
    have hOA := exceptionalPrimeDefect_shifted_endpoint_error h A
      ⟨K, hK, hw.mono fun _ hx n hn => (hx n hn).1⟩
    have hOC := exceptionalPrimeDefect_shifted_endpoint_error h C
      ⟨K, hK, hw.mono fun _ hx n hn => (hx n hn).2.1⟩
    have hOE := exceptionalPrimeDefect_shifted_endpoint_error h E
      ⟨K, hK, hw.mono fun _ hx n hn => (hx n hn).2.2⟩
    obtain ⟨D, hD, hsumBound⟩ := Asymptotics.isBigO_iff'.mp ((hOA.add hOC).add hOE)
    refine ⟨D, hD, ?_⟩
    filter_upwards [hprime, hinside, hsumBound, Filter.eventually_ge_atTop (0 : ℝ)]
      with x hxprime hxinside hxsum hx0
    let I : Finset ℕ := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
    let B : ℕ → ℝ := fun n =>
      exceptionalPrimeDefect x 0 (n + h) + exceptionalPrimeDefect x 1 (n + h)
    let rho : ℕ → ℝ := fun n =>
      (if (n + h).Prime then (1 : ℝ) else 0) -
        exceptionalPrimeDefect x 0 (n + h) - exceptionalPrimeDefect x 1 (n + h)
    let T : ℕ → ℝ := fun n => if 2 * x < ((n + h : ℕ) : ℝ) then
      B n * (A x n ^ 2 + C x n ^ 2 + E x n ^ 2) else 0
    have hB (n : ℕ) : 0 ≤ B n :=
      add_nonneg (exceptionalPrimeDefect_nonneg x 0 _) (exceptionalPrimeDefect_nonneg x 1 _)
    have hT (n : ℕ) : 0 ≤ T n := by
      have hb := hB n
      dsimp only [T]
      positivity
    have hsumT : (∑ n ∈ I, T n) =
        (∑ n ∈ I, if 2 * x < ((n + h : ℕ) : ℝ) then B n * A x n ^ 2 else 0) +
        (∑ n ∈ I, if 2 * x < ((n + h : ℕ) : ℝ) then B n * C x n ^ 2 else 0) +
        ∑ n ∈ I, if 2 * x < ((n + h : ℕ) : ℝ) then B n * E x n ^ 2 else 0 := by
      simp only [T, mul_add, ite_add_zero, Finset.sum_add_distrib]
    have hsumTnonneg : 0 ≤ ∑ n ∈ I, T n := Finset.sum_nonneg fun n _ => hT n
    have htotal : (∑ n ∈ I, T n) ≤ D * x ^ (1 / 2 : ℝ) := by
      change ‖(∑ n ∈ I, if 2 * x < ((n + h : ℕ) : ℝ) then B n * A x n ^ 2 else 0) +
          (∑ n ∈ I, if 2 * x < ((n + h : ℕ) : ℝ) then B n * C x n ^ 2 else 0) +
          (∑ n ∈ I, if 2 * x < ((n + h : ℕ) : ℝ) then B n * E x n ^ 2 else 0)‖ ≤
        D * ‖x ^ (1 / 2 : ℝ)‖ at hxsum
      rw [← hsumT, Real.norm_of_nonneg hsumTnonneg,
        Real.norm_of_nonneg (Real.rpow_nonneg hx0 _)] at hxsum
      exact hxsum
    intro v
    change |∑ n ∈ I, if mask x v n then
      rho n * A x n * E x n - rho n * C x n * E x n else 0| ≤ D * x ^ (1 / 2 : ℝ)
    have hpoint (n : ℕ) (hn : n ∈ I) :
        |if mask x v n then rho n * A x n * E x n - rho n * C x n * E x n else 0| ≤
          T n := by
      by_cases hm : mask x v n
      · rw [ite_eq_left hm]
        by_cases hi : ((n + h : ℕ) : ℝ) ≤ 2 * x
        · have he : rho n * A x n = rho n * C x n := hxinside n hn hi
          rw [he, sub_self, abs_zero]
          exact hT n
        · have ho : 2 * x < ((n + h : ℕ) : ℝ) := lt_of_not_ge hi
          have hp := congrArg (fun t : ℝ => t * E x n) (hxprime n hn)
          have he : rho n * A x n * E x n - rho n * C x n * E x n =
              -(B n * ((A x n - C x n) * E x n)) := by
            calc
              _ = ((if (n + h).Prime then (1 : ℝ) else 0) * A x n * E x n -
                    (if (n + h).Prime then (1 : ℝ) else 0) * C x n * E x n) -
                    B n * ((A x n - C x n) * E x n) := by
                dsimp only [rho, B]
                ring
              _ = _ := by rw [hp, sub_self, zero_sub]
          have hYoung : |(A x n - C x n) * E x n| ≤
              A x n ^ 2 + C x n ^ 2 + E x n ^ 2 := by
            rw [abs_le]
            constructor <;> nlinarith only [sq_nonneg (A x n + E x n),
              sq_nonneg (C x n - E x n), sq_nonneg (A x n - E x n),
              sq_nonneg (C x n + E x n), sq_nonneg (A x n), sq_nonneg (C x n)]
          rw [he, abs_neg, abs_mul, abs_of_nonneg (hB n)]
          change B n * |(A x n - C x n) * E x n| ≤
            if 2 * x < ((n + h : ℕ) : ℝ) then
              B n * (A x n ^ 2 + C x n ^ 2 + E x n ^ 2) else 0
          rw [ite_eq_left ho]
          exact mul_le_mul_of_nonneg_left hYoung (hB n)
      · rw [ite_eq_right hm, abs_zero]
        exact hT n
    calc
      _ ≤ ∑ n ∈ I, |if mask x v n then
          rho n * A x n * E x n - rho n * C x n * E x n else 0| :=
        Finset.abs_sum_le_sum_abs _ _
      _ ≤ ∑ n ∈ I, T n := Finset.sum_le_sum hpoint
      _ ≤ D * x ^ (1 / 2 : ℝ) := htotal
  have hpoint := canonical40_fixed_profile_prime_minorant_erasure
    (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i a F
  have hprime : ∀ᶠ x : ℝ in atTop, ∀ n ∈ I x,
      P (n + h i) * A F x n = P (n + h i) * C F x n :=
    hpoint.mono fun _ hx n hn => (hx n hn).1
  have hinside : ∀ᶠ x : ℝ in atTop, ∀ n ∈ I x,
      ((n + h i : ℕ) : ℝ) ≤ 2 * x →
        rho x (n + h i) * A F x n = rho x (n + h i) * C F x n :=
    hpoint.mono fun _ hx n hn hhi => ((hx n hn).2 hhi).1
  have hprimeSum : ∀ᶠ x : ℝ in atTop, ∀ v : ℕ, S (fun _ => P) x v = 0 := by
    filter_upwards [hprime] with x hx
    intro v
    apply sub_eq_zero.mpr
    apply Finset.sum_congr rfl
    intro n hn
    split_ifs
    · exact congrArg (fun t : ℝ => t * C F' x n) (hx n hn)
    · rfl
  refine ⟨hprimeSum, ?_⟩
  obtain ⟨K₁, hK₁, hroots₁⟩ :=
    (canonical40_fixed_profile_coefficient_roots (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i a F hbF).2
      (1 / 8 : ℝ) (by norm_num)
  obtain ⟨K₂, hK₂, hroots₂⟩ :=
    (canonical40_fixed_profile_coefficient_roots (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i a F' hbF').2
      (1 / 8 : ℝ) (by norm_num)
  have hbound : ∃ K : ℝ, 0 < K ∧ ∀ᶠ x : ℝ in atTop,
      ∀ n ∈ I x,
        |A F x n| ≤ K * x ^ (1 / 8 : ℝ) ∧
        |C F x n| ≤ K * x ^ (1 / 8 : ℝ) ∧
        |C F' x n| ≤ K * x ^ (1 / 8 : ℝ) := by
    refine ⟨K₁ + K₂, add_pos hK₁ hK₂, ?_⟩
    filter_upwards [hroots₁, hroots₂, Filter.eventually_ge_atTop (0 : ℝ)]
      with x h₁ h₂ hx
    intro n hn
    have hp : 0 ≤ x ^ (1 / 8 : ℝ) := Real.rpow_nonneg hx _
    exact ⟨(h₁ n hn).1.trans (mul_le_mul_of_nonneg_right
      (le_add_of_nonneg_right hK₂.le) hp),
      (h₁ n hn).2.trans (mul_le_mul_of_nonneg_right
        (le_add_of_nonneg_right hK₂.le) hp),
      (h₂ n hn).2.trans (mul_le_mul_of_nonneg_right
        (le_add_of_nonneg_left hK₁.le) hp)⟩
  obtain ⟨K, hK, hendpoint⟩ := hEndpoint (h i) (A F) (C F) (C F')
    (fun x v n => Nat.ModEq (W x) n v) hbound hprime hinside
  have hsum (x : ℝ) (v : ℕ) : S rho x v =
      ∑ n ∈ I x, if Nat.ModEq (W x) n v then
        rho x (n + h i) * A F x n * C F' x n -
          rho x (n + h i) * C F x n * C F' x n else 0 := by
    simp only [S, ← Finset.sum_sub_distrib, ite_sub_ite, sub_self]
  have hpower : (fun x : ℝ => K * x ^ (1 / 2 : ℝ)) =O[atTop]
      (fun x : ℝ => x ^ (1 - (1 / 2 : ℝ))) := by
    simpa only [show (1 : ℝ) - 1 / 2 = 1 / 2 by norm_num] using
      Asymptotics.isBigO_const_mul_self K (fun x : ℝ => x ^ (1 / 2 : ℝ)) Filter.atTop
  intro ε hε
  filter_upwards [hendpoint, hprime,
    selberg40_power_saving_error_small (𝓗 := 𝓗) (fun x : ℝ => K * x ^ (1 / 2 : ℝ))
      (1 / 2) (by norm_num) hpower ε hε] with x he hp hs
  intro Bx N
  have hnonneg : 0 ≤ K * x ^ (1 / 2 : ℝ) :=
    mul_nonneg hK.le (Real.rpow_nonneg (zero_le_one.trans hs.1.le) _)
  have hsmall : K * x ^ (1 / 2 : ℝ) ≤ ε * N := by
    simpa only [abs_of_nonneg hnonneg] using hs.2.2
  refine ⟨hs.1, hs.2.1, ?_⟩
  intro v
  have hrho : |S rho x v| ≤ ε * N := by
    rw [hsum]
    convert (he v).trans hsmall using 1 <;> congr 1
    apply Finset.sum_congr rfl
    intro n hn
    dsimp only [rho, P, b]
    split_ifs <;> rfl
  refine ⟨hrho, ?_⟩
  have hEX : S EX x v = -S rho x v := by
    dsimp only [S]
    rw [← Finset.sum_sub_distrib, ← Finset.sum_sub_distrib, ← Finset.sum_neg_distrib]
    apply Finset.sum_congr rfl
    intro n hn
    split_ifs
    · have hp' := congrArg (fun t : ℝ => t * C F' x n) (hp n hn)
      dsimp only [rho, EX]
      linear_combination hp'
    · ring
  simpa only [hEX, abs_neg] using hrho

theorem canonical40_fixed_band_harmonic_tendsto
    {𝓗 : Finset ℕ}
    {m : ℕ} (κ : ℝ) (hκ : 0 < κ)
    (a : Fin (m + 2) → ℝ) (ha : StrictMono a)
    (ha0 : a 0 = 0) (haLast : a (Fin.last (m + 1)) = κ)
    (F : (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
    (hF : Measurable F) (hbF : Bornology.IsBounded (Set.range F)) :
    let ν : Measure (Fin (m + 1) → ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        Measure.map (fragmentBandMasses a) (fragmentLaw κ)
    (∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => ν), ContinuousAt F X) →
    let ρ : ℝ := 2624989 / 10000000
    let W : ℝ → ℕ := presievingModulus 𝓗
    let R : ℝ → ℝ := fun x => x ^ ρ
    let B : ℝ → ℝ := fun x => fragmentNormalization (W x) (R x)
    let q : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) (R x) κ, p
    let T : ℝ → Finset (Fin 40 → ℕ) := fun x =>
      (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
        (fun r => Squarefree (∏ j, r j))
    let X : ℝ → ℕ → Fin (m + 1) → ℝ := fun x s =>
      fragmentBandMasses a (primeLogConfiguration (R x) s)
    let y : ℝ → ((Fin 40 → ℕ) →₀ ℝ) := fun x =>
      ∑ r ∈ T x, Finsupp.single r (F (fun j => X x (r j)) / B x ^ 40)
    Filter.Tendsto
      (fun x : ℝ => B x ^ 40 *
        (y x).sum (fun r yr => yr ^ 2 / (∏ j, ((r j).totient : ℝ))))
      Filter.atTop
      (nhds (∫ X : Fin 40 → Fin (m + 1) → ℝ, F X ^ 2
        ∂Measure.pi (fun _ : Fin 40 => ν))) := by
  classical
  intro ν hFc ρ W R B q T X y
  have hρ : 0 < ρ := by norm_num [ρ]
  have hbSquare : Bornology.IsBounded (Set.range (fun X => F X ^ 2)) := by
    simpa only [← Set.range_comp'] using isBounded_pow hbF 2
  have hcSquare : ∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => ν),
      ContinuousAt (fun X => F X ^ 2) X := hFc.mono fun _ h => h.pow 2
  have hraw := tendsto_restricted_harmonic_pi_sum
    𝓗 ρ κ a hρ hκ ha ha0 haLast
    (fun r : Fin 40 → ℕ => Squarefree (∏ j, r j))
    (fun S hS r hr h => exists_shared_prime_of_not_squarefree_prod S hS r hr h)
    (fun X => F X ^ 2) (hF.pow_const 2) hbSquare hcSquare
  apply hraw.congr'
  filter_upwards [(tendsto_rpow_atTop hρ).eventually_gt_atTop 1] with x hx
  have hWpos : 0 < W x := presieving_pos 𝓗 x
  have hBpos : 0 < B x := by
    change 0 < ((W x).totient : ℝ) / (W x : ℝ) * Real.log (R x)
    exact mul_pos
      (div_pos (Nat.cast_pos.mpr (Nat.totient_pos.mpr hWpos)) (Nat.cast_pos.mpr hWpos))
      (Real.log_pos hx)
  have hBpow : B x ^ 40 ≠ 0 := pow_ne_zero _ hBpos.ne'
  have hy : y x = Finsupp.indicator (T x)
      (fun r _ => F (fun j => X x (r j)) / B x ^ 40) :=
    (Finsupp.indicator_eq_sum_single (T x)
      (fun r => F (fun j => X x (r j)) / B x ^ 40)).symm
  have hysupport : (y x).support ⊆ T x := by
    rw [hy]
    exact Finsupp.support_indicator_subset _ _
  have hyvalue (r : Fin 40 → ℕ) (hr : r ∈ T x) :
      y x r = F (fun j => X x (r j)) / B x ^ 40 := by
    rw [hy, Finsupp.indicator_of_mem hr]
  have hscalar (b v w : ℝ) (hb : b ≠ 0) :
      b * ((v / b) ^ 2 * w) = b⁻¹ * (w * v ^ 2) := by
    field_simp [hb]
  symm
  calc
    B x ^ 40 * (y x).sum (fun r yr => yr ^ 2 / (∏ j, ((r j).totient : ℝ))) =
        B x ^ 40 * ∑ r ∈ T x,
          (F (fun j => X x (r j)) / B x ^ 40) ^ 2 /
            (∏ j, ((r j).totient : ℝ)) := by
      apply congrArg (fun z : ℝ => B x ^ 40 * z)
      rw [Finsupp.sum_of_support_subset _ hysupport _ (by simp)]
      apply Finset.sum_congr rfl
      intro r hr
      rw [hyvalue r hr]
    _ = (B x ^ 40)⁻¹ * ∑ r ∈ T x,
        (∏ j, ((r j).totient : ℝ)⁻¹) * F (fun j => X x (r j)) ^ 2 := by
      rw [Finset.mul_sum, Finset.mul_sum]
      apply Finset.sum_congr rfl
      intro r _
      simpa only [div_eq_mul_inv, Finset.prod_inv_distrib] using
        hscalar (B x ^ 40) (F (fun j => X x (r j)))
          ((∏ j, ((r j).totient : ℝ))⁻¹) hBpow
    _ = (B x ^ 40)⁻¹ *
        ∑ r ∈ Fintype.piFinset (fun _ : Fin 40 => (q x).divisors),
          (∏ j, ((r j).totient : ℝ)⁻¹) *
            (if Squarefree (∏ j, r j) then F (fun j => X x (r j)) ^ 2 else 0) := by
      simp only [T, Finset.sum_filter, mul_ite, mul_zero]

theorem canonical40_fixed_band_ordinary_square
    {𝓗 : Finset ℕ}
    {h𝓗_card : 𝓗.card = 40}
    {m : ℕ} (κ : ℝ) (hκ : 0 < κ)
    (a : Fin (m + 2) → ℝ) (ha : StrictMono a)
    (ha0 : a 0 = 0) (haLast : a (Fin.last (m + 1)) = κ)
    (F : (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
    (hF : Measurable F) (hbF : Bornology.IsBounded (Set.range F))
    (hRadius : ∀ (W : ℕ) (R : ℝ), 1 < R → ∀ r : Fin 40 → ℕ,
      Squarefree (∏ j, r j) →
      (∀ j, r j ∈ (∏ p ∈ fragmentPrimes W R κ, p).divisors) →
      F (fun j => fragmentBandMasses a
        (primeLogConfiguration R (r j))) ≠ 0 →
      ((∏ j, r j : ℕ) : ℝ) ≤ R ^ (2742997 / 2624989 : ℝ)) :
    let ν : Measure (Fin (m + 1) → ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        Measure.map (fragmentBandMasses a) (fragmentLaw κ)
    (∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => ν), ContinuousAt F X) →
    let ρ : ℝ := 2624989 / 10000000
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    let W : ℝ → ℕ := presievingModulus 𝓗
    let R : ℝ → ℝ := fun x => x ^ ρ
    let B : ℝ → ℝ := fun x => fragmentNormalization (W x) (R x)
    let q : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) (R x) κ, p
    let T : ℝ → Finset (Fin 40 → ℕ) := fun x =>
      (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
        (fun r => Squarefree (∏ j, r j))
    let X : ℝ → ℕ → Fin (m + 1) → ℝ := fun x s =>
      fragmentBandMasses a (primeLogConfiguration (R x) s)
    let y : ℝ → ((Fin 40 → ℕ) →₀ ℝ) := fun x =>
      ∑ r ∈ T x, Finsupp.single r (F (fun j => X x (r j)) / B x ^ 40)
    let D : ℝ → Finset (Fin 40 → ℕ) := fun x =>
      (y x).support.biUnion
        (fun r => Fintype.piFinset (fun j : Fin 40 => (r j).divisors))
    let A : ℝ → ℕ → ℝ := fun x n =>
      ∑ d ∈ D x, if ∀ j : Fin 40, d j ∣ n + h j then selbergCoefficient (y x) d else 0
    ∀ ε : ℝ, 0 < ε → ∀ᶠ x : ℝ in Filter.atTop, ∀ v : ℕ,
      |(∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
          if Nat.ModEq (W x) n v then A x n ^ 2 else 0) -
        (∫ X : Fin 40 → Fin (m + 1) → ℝ, F X ^ 2
          ∂Measure.pi (fun _ : Fin 40 => ν)) *
          (x / (W x : ℝ) / B x ^ 40)| ≤
        ε * (x / (W x : ℝ) / B x ^ 40) := by
  classical
  intro ν hFc ρ h W R B q T X y D A
  obtain ⟨M, hM, hFM⟩ := hbF.exists_pos_norm_le
  have hFabs (Z : Fin 40 → Fin (m + 1) → ℝ) : |F Z| ≤ M := by
    simpa only [Real.norm_eq_abs] using hFM _ ⟨Z, rfl⟩
  have hρ : 0 < ρ := by norm_num [ρ]
  have hbase : ∀ᶠ x : ℝ in Filter.atTop, 1 < x ∧ 1 < R x ∧ 0 < B x := by
    filter_upwards [Filter.eventually_gt_atTop (1 : ℝ)] with x hx
    have hR : 1 < R x := Real.one_lt_rpow hx hρ
    have hW : 0 < W x := presieving_pos 𝓗 x
    refine ⟨hx, hR, ?_⟩
    change 0 < ((W x).totient : ℝ) / (W x : ℝ) * Real.log (R x)
    exact mul_pos
      (div_pos (Nat.cast_pos.mpr (Nat.totient_pos.mpr hW)) (Nat.cast_pos.mpr hW))
      (Real.log_pos hR)
  have hyvalue (x : ℝ) (r : Fin 40 → ℕ) :
      y x r = if r ∈ T x then F (fun j => X x (r j)) / B x ^ 40 else 0 := by
    dsimp only [y]
    simp only [← Finsupp.indicator_eq_sum_single, Finsupp.indicator_apply, dite_eq_ite]
  have hyroots (x : ℝ) (hR : 1 < R x) (r : Fin 40 → ℕ)
      (hr : r ∈ (y x).support) :
      Squarefree (∏ j, r j) ∧ Nat.Coprime (∏ j, r j) (W x) ∧
        ((∏ j, r j : ℕ) : ℝ) ≤ (R x) ^ (2742997 / 2624989 : ℝ) := by
    have hyr : y x r ≠ 0 := Finsupp.mem_support_iff.mp hr
    have hmem : r ∈ T x := by
      by_contra hout
      exact hyr (by rw [hyvalue, ite_eq_right hout])
    obtain ⟨hpi, hsq⟩ := Finset.mem_filter.mp hmem
    have hdiv (j : Fin 40) : r j ∈ (q x).divisors := Fintype.mem_piFinset.mp hpi j
    have hFne : F (fun j => X x (r j)) ≠ 0 := by
      intro hz
      exact hyr (by rw [hyvalue, ite_eq_left hmem, hz, zero_div])
    refine ⟨hsq, ?_, hRadius (W x) (R x) hR r hsq hdiv hFne⟩
    exact Nat.Coprime.prod_left fun j _ =>
      ((mem_fragment_divisors_iff (W x) (R x) κ
        (Real.one_le_rpow hR.le hκ.le) (r j)).mp (hdiv j)).2.1
  have hybound (x : ℝ) (hB : 0 < B x) (r : Fin 40 → ℕ) :
      |y x r| ≤ M / B x ^ 40 := by
    rw [hyvalue]
    split_ifs with hr
    · rw [abs_div, abs_of_pos (pow_pos hB 40)]
      exact div_le_div_of_nonneg_right (hFabs _) (pow_nonneg hB.le _)
    · rw [abs_zero]
      exact div_nonneg hM.le (pow_nonneg hB.le _)
  let S : ℝ → ℕ → ℝ := fun x v =>
    ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
      if Nat.ModEq (W x) n v then A x n ^ 2 else 0
  let e : ℝ → ℝ := fun x =>
    (y x).sum (fun r yr => yr ^ 2 / (∏ j, ((r j).totient : ℝ)))
  let I : ℝ := ∫ X : Fin 40 → Fin (m + 1) → ℝ, F X ^ 2
    ∂Measure.pi (fun _ : Fin 40 => ν)
  have hlim : Filter.Tendsto (fun x => B x ^ 40 * e x) Filter.atTop (nhds I) :=
    canonical40_fixed_band_harmonic_tendsto (𝓗 := 𝓗) κ hκ a ha ha0 haLast F hF hbF hFc
  have hpos : ∀ᶠ x : ℝ in Filter.atTop,
      0 ≤ x / (W x : ℝ) ∧ 0 < B x ^ 40 := by
    filter_upwards [hbase] with x hx
    exact ⟨div_nonneg (zero_lt_one.trans hx.1).le (Nat.cast_nonneg _),
      pow_pos hx.2.2 40⟩
  have herr (ε : ℝ) (hε : 0 < ε) : ∀ᶠ x : ℝ in Filter.atTop, ∀ v : ℕ,
      |S x v - (x / (W x : ℝ)) * e x| ≤ ε * (x / (W x : ℝ) / B x ^ 40) := by
    filter_upwards [hbase, selberg40_uniform_real_diagonal
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) M hM.le ε hε] with x hx hdiag
    intro v
    exact hdiag (y x) v (hyroots x hx.2.1) (hybound x hx.2.2)
  have hcombined := uniform_scaled_error_of_normalized_tendsto S
    (fun x => x / (W x : ℝ)) (fun x => B x ^ 40) e I hpos hlim herr
  intro ε hε
  filter_upwards [hcombined ε hε] with x hx
  intro v
  simpa only [S, I, mul_comm (x / (W x : ℝ) / B x ^ 40)] using hx v

theorem fixed_shift_literal_weights_mass_tendsto (h : ℕ) :
    Filter.Tendsto
      (fun x : ℝ => Real.log x / x *
        (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
          if (n + h).Prime then (1 : ℝ) else 0))
      Filter.atTop (nhds 1) ∧
    Filter.Tendsto
      (fun x : ℝ => Real.log x / x *
        (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
          ((if (n + h).Prime then (1 : ℝ) else 0) -
            exceptionalPrimeDefect x 0 (n + h) -
            exceptionalPrimeDefect x 1 (n + h))))
      Filter.atTop (nhds (1 -
        (exceptionalMassCoefficient 0 +
          exceptionalMassCoefficient 1))) := by
  classical
  have hfinite (a b : ℕ) (f : ℕ → ℝ) (B : ℝ) (hB : 0 ≤ B)
      (hf : ∀ n ∈ Finset.Icc a (b + h), |f n| ≤ B) :
      |(∑ n ∈ Finset.Icc a b, f (n + h)) -
        ∑ n ∈ Finset.Icc a b, f n| ≤ 2 * (h : ℝ) * B := by
    let S := Finset.Icc a b
    let T := Finset.Icc (a + h) (b + h)
    have hshift : (∑ n ∈ Finset.Icc a b, f (n + h)) = ∑ n ∈ T, f n := by
      dsimp only [T]
      rw [← Finset.map_add_right_Icc a b h, Finset.sum_map]
      rfl
    have hTS : T \ S ⊆ Finset.Ioc b (b + h) := by
      intro n hn
      simp only [T, S, Finset.mem_sdiff, Finset.mem_Icc, Finset.mem_Ioc] at hn ⊢
      omega
    have hST : S \ T ⊆ Finset.Ico a (a + h) := by
      intro n hn
      simp only [T, S, Finset.mem_sdiff, Finset.mem_Icc, Finset.mem_Ico] at hn ⊢
      omega
    have hcardTS : (T \ S).card ≤ h := by
      simpa using Finset.card_le_card hTS
    have hcardST : (S \ T).card ≤ h := by
      simpa using Finset.card_le_card hST
    have hsum (U : Finset ℕ) (hU : U ⊆ Finset.Icc a (b + h))
        (hcard : U.card ≤ h) : |∑ n ∈ U, f n| ≤ (h : ℝ) * B := by
      calc
        _ ≤ ∑ n ∈ U, |f n| := Finset.abs_sum_le_sum_abs f U
        _ ≤ ∑ n ∈ U, B := Finset.sum_le_sum (fun n hn => hf n (hU hn))
        _ = (U.card : ℝ) * B := by simp
        _ ≤ (h : ℝ) * B := mul_le_mul_of_nonneg_right (by exact_mod_cast hcard) hB
    have hsumTS : |∑ n ∈ T \ S, f n| ≤ (h : ℝ) * B :=
      hsum _ (Finset.sdiff_subset.trans
        (Finset.Icc_subset_Icc (Nat.le_add_right a h) le_rfl)) hcardTS
    have hsumST : |∑ n ∈ S \ T, f n| ≤ (h : ℝ) * B :=
      hsum _ (Finset.sdiff_subset.trans
        (Finset.Icc_subset_Icc le_rfl (Nat.le_add_right b h))) hcardST
    rw [hshift]
    change |(∑ n ∈ T, f n) - ∑ n ∈ S, f n| ≤ _
    rw [← Finset.sum_sdiff_sub_sum_sdiff (s₁ := S) (s₂ := T) (f := f)]
    calc
      _ ≤ |∑ n ∈ T \ S, f n| + |∑ n ∈ S \ T, f n| := abs_sub _ _
      _ ≤ (h : ℝ) * B + (h : ℝ) * B := add_le_add hsumTS hsumST
      _ = _ := by ring
  have htransfer (f : ℝ → ℕ → ℝ) (L C : ℝ) (hC : 0 ≤ C)
      (hf : Filter.Tendsto
        (fun x : ℝ => Real.log x / x * (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, f x n))
        Filter.atTop (nhds L))
      (hbound : ∀ᶠ x : ℝ in Filter.atTop,
        ∀ n ∈ Finset.Icc ⌈x⌉₊ (⌊2 * x⌋₊ + h), |f x n| ≤ C * x ^ (1 / 2 : ℝ)) :
      Filter.Tendsto
        (fun x : ℝ => Real.log x / x *
          (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, f x (n + h)))
        Filter.atTop (nhds L) := by
    let E : ℝ → ℝ := fun x => Real.log x / x *
      ((∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, f x (n + h)) -
        ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, f x n)
    have hlog : Filter.Tendsto (fun x : ℝ => Real.log x / x ^ (1 / 2 : ℝ))
        Filter.atTop (nhds 0) :=
      (isLittleO_log_rpow_atTop (by norm_num : (0 : ℝ) < 1 / 2)).tendsto_div_nhds_zero
    have herr : Filter.Tendsto
        (fun x : ℝ => (2 * (h : ℝ) * C) * (Real.log x / x ^ (1 / 2 : ℝ)))
        Filter.atTop (nhds 0) := by
      simpa only [mul_zero] using hlog.const_mul (2 * (h : ℝ) * C)
    have hE : Filter.Tendsto E Filter.atTop (nhds 0) := by
      apply squeeze_zero_norm' _ herr
      filter_upwards [hbound, Filter.eventually_gt_atTop (1 : ℝ)] with x hbx hx
      have hx0 : 0 < x := zero_lt_one.trans hx
      have hp : 0 < x ^ (1 / 2 : ℝ) := Real.rpow_pos_of_pos hx0 _
      have hL : 0 ≤ Real.log x / x :=
        div_nonneg (Real.log_nonneg hx.le) hx0.le
      have hsq : (x ^ (1 / 2 : ℝ)) ^ 2 = x := by
        rw [← Real.rpow_mul_natCast hx0.le]
        norm_num
      have hratio : x ^ (1 / 2 : ℝ) / x = 1 / x ^ (1 / 2 : ℝ) := by
        apply (div_eq_div_iff hx0.ne' hp.ne').2
        simpa only [pow_two, one_mul] using hsq
      have hscale : Real.log x / x * (2 * (h : ℝ) * (C * x ^ (1 / 2 : ℝ))) =
          (2 * (h : ℝ) * C) * (Real.log x / x ^ (1 / 2 : ℝ)) := by
        calc
          _ = (2 * (h : ℝ) * C) * (Real.log x * (x ^ (1 / 2 : ℝ) / x)) := by ring
          _ = _ := by rw [hratio]; ring
      have hb := mul_le_mul_of_nonneg_left
        (hfinite ⌈x⌉₊ ⌊2 * x⌋₊ (f x) (C * x ^ (1 / 2 : ℝ))
          (mul_nonneg hC hp.le) hbx) hL
      rw [hscale] at hb
      simpa only [E, Real.norm_eq_abs, abs_mul, abs_of_nonneg hL] using hb
    convert hE.add hf using 1
    · funext x
      dsimp only [E]
      ring
    · simp
  obtain ⟨D, hD, hdefect⟩ :=
    exceptionalPrimeDefect_uniform_subpower (1 / 2 : ℝ) (by norm_num)
  let C : ℝ := 1 + 2 * D * (3 : ℝ) ^ (1 / 2 : ℝ)
  have hC : 0 < C := by dsimp only [C]; positivity
  have hb : ∀ᶠ x : ℝ in Filter.atTop,
      ∀ n ∈ Finset.Icc ⌈x⌉₊ (⌊2 * x⌋₊ + h),
        |(if n.Prime then (1 : ℝ) else 0) -
          exceptionalPrimeDefect x 0 n -
          exceptionalPrimeDefect x 1 n| ≤ C * x ^ (1 / 2 : ℝ) := by
    filter_upwards [Filter.eventually_ge_atTop (max (1 : ℝ) (h : ℝ))] with x hx
    have hx1 : 1 ≤ x := (le_max_left _ _).trans hx
    have hhx : (h : ℝ) ≤ x := (le_max_right _ _).trans hx
    have hx0 : 0 < x := zero_lt_one.trans_le hx1
    have hpow : 1 ≤ x ^ (1 / 2 : ℝ) := Real.one_le_rpow hx1 (by norm_num)
    intro n hn
    have hnlo : x ≤ (n : ℝ) := Nat.le_of_ceil_le (Finset.mem_Icc.mp hn).1
    have hnhi : (n : ℝ) ≤ 3 * x := by
      have hn' : (n : ℝ) ≤ (⌊2 * x⌋₊ : ℝ) + (h : ℝ) := by
        exact_mod_cast (Finset.mem_Icc.mp hn).2
      have hflo : (⌊2 * x⌋₊ : ℝ) ≤ 2 * x := Nat.floor_le (by positivity)
      linarith
    have hn0 : n ≠ 0 := by
      have : (0 : ℝ) < n := hx0.trans_le hnlo
      exact (Nat.cast_pos.mp this).ne'
    have hnPow : (n : ℝ) ^ (1 / 2 : ℝ) ≤
        (3 : ℝ) ^ (1 / 2 : ℝ) * x ^ (1 / 2 : ℝ) := by
      calc
        _ ≤ (3 * x) ^ (1 / 2 : ℝ) :=
          Real.rpow_le_rpow (Nat.cast_nonneg _) hnhi (by norm_num)
        _ = _ := Real.mul_rpow (by norm_num) hx0.le
    have hd (j : Fin 2) : exceptionalPrimeDefect x j n ≤
        D * (3 : ℝ) ^ (1 / 2 : ℝ) * x ^ (1 / 2 : ℝ) := by
      calc
        _ ≤ D * (n : ℝ) ^ (1 / 2 : ℝ) := hdefect x j n hn0
        _ ≤ D * ((3 : ℝ) ^ (1 / 2 : ℝ) * x ^ (1 / 2 : ℝ)) :=
          mul_le_mul_of_nonneg_left hnPow hD.le
        _ = _ := by ring
    have hp : 0 ≤ (if n.Prime then (1 : ℝ) else 0) ∧
        (if n.Prime then (1 : ℝ) else 0) ≤ 1 := by
      split_ifs <;> norm_num
    obtain ⟨hp0, hp1⟩ := hp
    have hd0 := exceptionalPrimeDefect_nonneg x 0 n
    have hd1 := exceptionalPrimeDefect_nonneg x 1 n
    have hscale : C * x ^ (1 / 2 : ℝ) = x ^ (1 / 2 : ℝ) +
        2 * (D * (3 : ℝ) ^ (1 / 2 : ℝ) * x ^ (1 / 2 : ℝ)) := by
      dsimp only [C]
      ring
    rw [hscale]
    exact abs_le.mpr ⟨by linarith [hd 0, hd 1], by linarith [hd 0]⟩
  constructor
  · apply htransfer (fun _ n => if n.Prime then 1 else 0) 1 1 zero_le_one
    · simpa only [Finset.sum_boole] using closed_dyadic_prime_count_tendsto
    · filter_upwards [Filter.eventually_ge_atTop (1 : ℝ)] with x hx
      intro n hn
      have hp : 1 ≤ x ^ (1 / 2 : ℝ) := Real.one_le_rpow hx (by norm_num)
      split_ifs
      · simpa using hp
      · simpa using zero_le_one.trans hp
  · exact htransfer
      (fun x n => (if n.Prime then (1 : ℝ) else 0) -
        exceptionalPrimeDefect x 0 n -
        exceptionalPrimeDefect x 1 n)
      (1 - (exceptionalMassCoefficient 0 +
        exceptionalMassCoefficient 1)) C hC.le
      literal_minorant_closed_true_mass.2.2.2 hb

theorem selberg40_log_saving_error_small
    {𝓗 : Finset ℕ}
    (S : ℝ → ℕ → ℝ) (Admissible : ℝ → ℕ → Prop)
    (hS : ∀ A : ℝ, 0 < A → ∃ K : ℝ, 0 < K ∧
      ∀ᶠ x : ℝ in Filter.atTop, ∀ v : ℕ, Admissible x v →
        |S x v| ≤ K * x / (Real.log x) ^ A) :
    ∀ ε : ℝ, 0 < ε → ∀ᶠ x : ℝ in Filter.atTop,
      let ρ : ℝ := 2624989 / 10000000
      let W := presievingModulus 𝓗 x
      let B := fragmentNormalization W (x ^ ρ)
      let Z : ℝ := x / (W : ℝ) / B ^ 40
      1 < x ∧ 0 < B ∧ 0 < Z ∧ ∀ v : ℕ, Admissible x v → |S x v| ≤ ε * Z := by
  intro ε hε
  obtain ⟨K, hK, hbound⟩ := hS 42 (by norm_num)
  filter_upwards [Filter.eventually_gt_atTop (1 : ℝ),
    presieving_le_mul_log_eventually 𝓗 1 zero_lt_one,
    Real.tendsto_log_atTop.eventually_ge_atTop (K / ε), hbound]
      with x hx hWlog hloglarge hbound
  intro ρ W B Z
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hlog : 0 < Real.log x := Real.log_pos hx
  have hρ : 0 < ρ := by norm_num [ρ]
  have hρ1 : ρ ≤ 1 := by norm_num [ρ]
  have hW : 0 < W := presieving_pos 𝓗 x
  have hWR : (0 : ℝ) < W := Nat.cast_pos.mpr hW
  have hφ : (0 : ℝ) < W.totient := Nat.cast_pos.mpr (Nat.totient_pos.mpr hW)
  have hratio : (W.totient : ℝ) / (W : ℝ) ≤ 1 :=
    (div_le_one hWR).mpr (Nat.cast_le.mpr (Nat.totient_le W))
  have hBformula : B = ((W.totient : ℝ) / (W : ℝ)) * (ρ * Real.log x) := by
    dsimp only [B, fragmentNormalization]
    rw [Real.log_rpow hx0]
  have hB : 0 < B := by
    rw [hBformula]
    exact mul_pos (div_pos hφ hWR) (mul_pos hρ hlog)
  have hBle : B ≤ Real.log x := by
    rw [hBformula]
    exact (mul_le_of_le_one_left (mul_nonneg hρ.le hlog.le) hratio).trans
      (mul_le_of_le_one_left hlog.le hρ1)
  have hWlog' : (W : ℝ) ≤ Real.log x := by simpa only [one_mul] using hWlog
  have hden : (W : ℝ) * B ^ 40 ≤ (Real.log x) ^ 41 := by
    calc
      (W : ℝ) * B ^ 40 ≤ Real.log x * (Real.log x) ^ 40 :=
        mul_le_mul hWlog' (pow_le_pow_left₀ hB.le hBle 40)
          (pow_nonneg hB.le 40) hlog.le
      _ = (Real.log x) ^ 41 := by ring
  have hZ : 0 < Z := div_pos (div_pos hx0 hWR) (pow_pos hB 40)
  have hZlower : x / (Real.log x) ^ 41 ≤ Z := by
    change x / (Real.log x) ^ 41 ≤ x / (W : ℝ) / B ^ 40
    rw [div_div]
    exact div_le_div_of_nonneg_left hx0.le (mul_pos hWR (pow_pos hB 40)) hden
  have hKsmall : K / Real.log x ≤ ε :=
    (div_le_comm₀ hlog hε).2 hloglarge
  refine ⟨hx, hB, hZ, ?_⟩
  intro v hv
  calc
    |S x v| ≤ K * x / (Real.log x) ^ 42 := by
      simpa only [Real.rpow_ofNat] using hbound v hv
    _ = (K / Real.log x) * (x / (Real.log x) ^ 41) := by
      rw [show (Real.log x) ^ 42 = (Real.log x) ^ 41 * Real.log x by ring]
      ring
    _ ≤ ε * (x / (Real.log x) ^ 41) :=
      mul_le_mul_of_nonneg_right hKsmall (div_nonneg hx0.le (pow_nonneg hlog.le 41))
    _ ≤ ε * Z := mul_le_mul_of_nonneg_left hZlower hε.le

theorem selberg40_moment_from_diagonal_error
    {𝓗 : Finset ℕ}
    (S : ℝ → ℕ → ℝ) (Admissible : ℝ → ℕ → Prop)
    (total gram : ℝ → ℝ) (m J : ℝ)
    (hmass : Filter.Tendsto (fun x => (Real.log x / x) * total x)
      Filter.atTop (nhds m))
    (hgram : Filter.Tendsto (fun x =>
      (fragmentNormalization
        (presievingModulus 𝓗 x)
        (x ^ (2624989 / 10000000 : ℝ))) ^ 39 * gram x)
      Filter.atTop (nhds J))
    (herror : ∀ A : ℝ, 0 < A → ∃ K : ℝ, 0 < K ∧
      ∀ᶠ x : ℝ in Filter.atTop, ∀ v : ℕ, Admissible x v →
        |S x v - total x /
          ((presievingModulus 𝓗 x).totient : ℝ) *
          gram x| ≤ K * x / (Real.log x) ^ A) :
    ∀ ε : ℝ, 0 < ε → ∀ᶠ x : ℝ in Filter.atTop,
      let ρ : ℝ := 2624989 / 10000000
      let W := presievingModulus 𝓗 x
      let B := fragmentNormalization W (x ^ ρ)
      let Z : ℝ := x / (W : ℝ) / B ^ 40
      ∀ v : ℕ, Admissible x v → |S x v - (ρ * m * J) * Z| ≤ ε * Z := by
  let ρ : ℝ := 2624989 / 10000000
  let W : ℝ → ℕ := presievingModulus 𝓗
  let B : ℝ → ℝ := fun x => fragmentNormalization (W x) (x ^ ρ)
  let Z : ℝ → ℝ := fun x => x / (W x : ℝ) / B x ^ 40
  let T : ℝ → ℝ := fun x => ρ * ((Real.log x / x) * total x) * (B x ^ 39 * gram x)
  have hlim : Filter.Tendsto T Filter.atTop (nhds (ρ * m * J)) :=
    (hmass.const_mul ρ).mul hgram
  intro ε hε
  have hhalf : 0 < ε / 2 := half_pos hε
  have hsmall : ∀ᶠ x : ℝ in Filter.atTop, |T x - ρ * m * J| < ε / 2 := by
    simpa only [Real.norm_eq_abs] using
      hlim.eventually (eventually_norm_sub_lt (ρ * m * J) hhalf)
  filter_upwards [selberg40_log_saving_error_small (𝓗 := 𝓗)
    (fun x v => S x v - total x / ((W x).totient : ℝ) * gram x)
      Admissible herror (ε / 2) hhalf, hsmall] with x hx hsmall
  intro ρ' W' B' Z' v hv
  have hx0 : 0 < x := zero_lt_one.trans hx.1
  have hlog : 0 < Real.log x := Real.log_pos hx.1
  have hρ : 0 < ρ := by norm_num [ρ]
  have hW : (0 : ℝ) < W x :=
    Nat.cast_pos.mpr (presieving_pos 𝓗 x)
  have hφ : (0 : ℝ) < (W x).totient := Nat.cast_pos.mpr
    (Nat.totient_pos.mpr (presieving_pos 𝓗 x))
  have hZ : 0 < Z x := hx.2.2.1
  have hBformula : B x = (((W x).totient : ℝ) / (W x : ℝ)) * (ρ * Real.log x) := by
    dsimp only [B, fragmentNormalization]
    rw [Real.log_rpow hx0]
  have hmain : total x / ((W x).totient : ℝ) * gram x = Z x * T x := by
    dsimp only [Z, T]
    rw [hBformula]
    field_simp [hW.ne', hφ.ne', hρ.ne', hlog.ne', hx0.ne']
  change |S x v - (ρ * m * J) * Z x| ≤ ε * Z x
  calc
    |S x v - (ρ * m * J) * Z x| =
        |(S x v - total x / ((W x).totient : ℝ) * gram x) +
          Z x * (T x - ρ * m * J)| := by rw [hmain]; ring_nf
    _ ≤ |S x v - total x / ((W x).totient : ℝ) * gram x| +
        |Z x * (T x - ρ * m * J)| := abs_add_le _ _
    _ = |S x v - total x / ((W x).totient : ℝ) * gram x| +
        Z x * |T x - ρ * m * J| := by rw [abs_mul, abs_of_pos hZ]
    _ ≤ (ε / 2) * Z x + Z x * (ε / 2) :=
      add_le_add (hx.2.2.2 v hv) (mul_le_mul_of_nonneg_left hsmall.le hZ.le)
    _ = ε * Z x := by ring

theorem finite_coherent_discrepancy_log_saving
    {ι : Type*} [Fintype ι] [Nonempty ι]
    (u : ℝ → ℕ →₀ ℂ) (J : ℕ)
    (Q : ι → ℝ → Finset ℕ → Finset ℕ)
    (hQ : ∀ i : ι, ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧
        ∀ x : ℝ, X ≤ x → ∀ I : Finset ℕ,
        (∀ p ∈ I, Nat.Prime p) → ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
          (∑ q ∈ Q i x I, (q.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy (u x) q a‖) ≤
              K * x / (Real.log x) ^ A) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
      0 < K ∧ Real.exp 1 ≤ X ∧
        ∀ x : ℝ, X ≤ x → ∀ I : Finset ℕ,
        (∀ p ∈ I, Nat.Prime p) → ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
          (∑ q ∈ (Finset.univ : Finset ι).biUnion (fun i => Q i x I),
            (q.divisors.card : ℝ) ^ J *
              ‖fullDiscrepancy (u x) q a‖) ≤
                K * x / (Real.log x) ^ A := by
  classical
  intro A hA
  choose K X hK hX hsource using fun i : ι => hQ i A hA
  let Ksum : ℝ := ∑ i : ι, K i
  let Xmax : ℝ := max (Real.exp 1)
    ((Finset.univ : Finset ι).sup' Finset.univ_nonempty X)
  have hKsum : 0 < Ksum :=
    Finset.sum_pos (fun i _ => hK i) Finset.univ_nonempty
  have hXi (i : ι) : X i ≤ Xmax :=
    (Finset.le_sup' X (Finset.mem_univ i)).trans (le_max_right _ _)
  refine ⟨Ksum, Xmax, hKsum, le_max_left _ _, ?_⟩
  intro x hx I hI a ha
  let U : Finset ℕ := (Finset.univ : Finset ι).biUnion (fun i => Q i x I)
  let E : ℕ → ℝ := fun q => (q.divisors.card : ℝ) ^ J *
    ‖fullDiscrepancy (u x) q a‖
  have hE (q : ℕ) : 0 ≤ E q :=
    mul_nonneg (pow_nonneg (Nat.cast_nonneg _) _) (norm_nonneg _)
  have hunion : (∑ q ∈ U, E q) ≤ ∑ i : ι, ∑ q ∈ Q i x I, E q := by
    dsimp only [U]
    rw [← Finset.sup_eq_biUnion]
    refine Finset.apply_sup_le_sum (f := fun s : Finset ℕ => ∑ q ∈ s, E q)
      (by simp) ?_ Finset.univ
    intro s t
    exact (le_add_of_nonneg_right (Finset.sum_nonneg fun q _ => hE q)).trans
      (Finset.sum_union_inter).le
  change (∑ q ∈ U, E q) ≤ Ksum * x / (Real.log x) ^ A
  calc
    (∑ q ∈ U, E q) ≤ ∑ i : ι, ∑ q ∈ Q i x I, E q := hunion
    _ ≤ ∑ i : ι, K i * x / (Real.log x) ^ A :=
      Finset.sum_le_sum fun i _ => hsource i x ((hXi i).trans hx) I hI a ha
    _ = Ksum * x / (Real.log x) ^ A := by
      rw [← Finset.sum_div, ← Finset.sum_mul]

open Classical in
theorem literal_minorant_clipped_root_moment_error
    {𝓗 : Finset ℕ}
    (h : ℕ) (U V : ℝ → ℕ → ℝ) (mask : ℝ → ℕ → ℕ → Prop)
    (hroot : ∃ C : ℝ, 0 < C ∧ ∀ᶠ x : ℝ in Filter.atTop,
      ∀ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        |U x n| ≤ C * x ^ (1 / 8 : ℝ) ∧
          |V x n| ≤ C * x ^ (1 / 8 : ℝ)) :
    ∀ ε : ℝ, 0 < ε → ∀ᶠ x : ℝ in Filter.atTop,
      let ρ : ℝ := 2624989 / 10000000
      let W := presievingModulus 𝓗 x
      let Bx := fragmentNormalization W x
      let B := fragmentNormalization W (x ^ ρ)
      let N := x / (W : ℝ) / Bx / B ^ 39
      let rho : ℕ → ℝ := fun n => (if n.Prime then 1 else 0) -
        exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n
      1 < x ∧ 0 < N ∧ ∀ v : ℕ,
        |(∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            if mask x v n then rho (n + h) * U x n * V x n else 0) -
          ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            if mask x v n then
              (if ((n + h : ℕ) : ℝ) ≤ 2 * x then rho (n + h) else 0) *
                U x n * V x n else 0| ≤ ε * N := by
  classical
  obtain ⟨C, hC, hroot⟩ := hroot
  obtain ⟨D, hD, hdefect⟩ := exceptionalPrimeDefect_uniform_subpower
    (1 / 4 : ℝ) (by norm_num)
  let L : ℝ := 1 + 2 * D * (3 : ℝ) ^ (1 / 4 : ℝ)
  let K : ℝ := ((h : ℝ) + 1) * L * C ^ 2
  have hL : 0 < L := by dsimp only [L]; positivity
  have hK : 0 < K := by dsimp only [K]; positivity
  have hbound : ∀ᶠ x : ℝ in Filter.atTop, ∀ v : ℕ,
      let rho : ℕ → ℝ := fun n => (if n.Prime then 1 else 0) -
        exceptionalPrimeDefect x 0 n - exceptionalPrimeDefect x 1 n
      |(∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
          if mask x v n then rho (n + h) * U x n * V x n else 0) -
        ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
          if mask x v n then
            (if ((n + h : ℕ) : ℝ) ≤ 2 * x then rho (n + h) else 0) *
              U x n * V x n else 0| ≤ K * x ^ (1 / 2 : ℝ) := by
    filter_upwards [hroot, Filter.eventually_ge_atTop (max (1 : ℝ) (h : ℝ))]
      with x hroot hx
    intro v rho
    have hx1 : 1 ≤ x := (le_max_left _ _).trans hx
    have hx0 : 0 < x := zero_lt_one.trans_le hx1
    have hh : (h : ℝ) ≤ x := (le_max_right _ _).trans hx
    let I := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
    let T := I.filter (fun n => 2 * x < ((n + h : ℕ) : ℝ))
    have hmap : Set.MapsTo (fun n : ℕ => n + h) T
        (Finset.Ioc ⌊2 * x⌋₊ (⌊2 * x⌋₊ + h)) := by
      intro n hn
      obtain ⟨hnI, htail⟩ := Finset.mem_filter.mp hn
      apply Finset.mem_Ioc.mpr
      refine ⟨?_, Nat.add_le_add_right (Finset.mem_Icc.mp hnI).2 h⟩
      have hf : (⌊2 * x⌋₊ : ℝ) ≤ 2 * x := Nat.floor_le (by positivity)
      exact_mod_cast hf.trans_lt htail
    have hcard : T.card ≤ h := by
      have ht := Finset.card_le_card_of_injOn (fun n : ℕ => n + h) hmap
        (fun _ _ _ _ he => Nat.add_right_cancel he)
      simpa only [Nat.card_Ioc, Nat.add_sub_cancel_left] using ht
    have hrho (n : ℕ) (hn : n ∈ I) : |rho (n + h)| ≤ L * x ^ (1 / 4 : ℝ) := by
      have hnx : x ≤ (n : ℝ) := Nat.le_of_ceil_le (Finset.mem_Icc.mp hn).1
      have hn2 : (n : ℝ) ≤ 2 * x :=
        (Nat.le_floor_iff (by positivity)).mp (Finset.mem_Icc.mp hn).2
      have hn0 : n + h ≠ 0 :=
        (Nat.add_pos_left (Nat.cast_pos.mp (hx0.trans_le hnx)) h).ne'
      have hn3 : ((n + h : ℕ) : ℝ) ≤ 3 * x := by
        push_cast
        linarith
      have hb0 := hdefect x 0 (n + h) hn0
      have hb1 := hdefect x 1 (n + h) hn0
      have hn0' := exceptionalPrimeDefect_nonneg x 0 (n + h)
      have hn1' := exceptionalPrimeDefect_nonneg x 1 (n + h)
      have hp0 : 0 ≤ (if (n + h).Prime then (1 : ℝ) else 0) := by
        split_ifs <;> norm_num
      have hp1 : (if (n + h).Prime then (1 : ℝ) else 0) ≤ 1 := by
        split_ifs <;> norm_num
      have habs : |rho (n + h)| ≤ 1 + 2 * D * ((n + h : ℕ) : ℝ) ^ (1 / 4 : ℝ) := by
        apply abs_le.mpr
        dsimp only [rho]
        constructor <;> linarith
      calc
        |rho (n + h)| ≤ 1 + 2 * D * ((n + h : ℕ) : ℝ) ^ (1 / 4 : ℝ) := habs
        _ ≤ 1 + 2 * D * (3 * x) ^ (1 / 4 : ℝ) :=
          add_le_add (le_refl (1 : ℝ)) (mul_le_mul_of_nonneg_left
            (Real.rpow_le_rpow (Nat.cast_nonneg (n + h)) hn3
              (by norm_num : (0 : ℝ) ≤ 1 / 4))
            (mul_nonneg zero_le_two hD.le))
        _ = 1 + 2 * D * (3 : ℝ) ^ (1 / 4 : ℝ) * x ^ (1 / 4 : ℝ) := by
          rw [Real.mul_rpow (by norm_num : (0 : ℝ) ≤ 3) hx0.le]
          ring
        _ ≤ L * x ^ (1 / 4 : ℝ) := by
          have hpow : 1 ≤ x ^ (1 / 4 : ℝ) := Real.one_le_rpow hx1 (by norm_num)
          dsimp only [L]
          nlinarith only [hpow]
    have hterm (n : ℕ) (hn : n ∈ T) :
        |if mask x v n then rho (n + h) * U x n * V x n else 0| ≤
          L * C ^ 2 * x ^ (1 / 2 : ℝ) := by
      have hnI := (Finset.mem_filter.mp hn).1
      by_cases hm : mask x v n
      · rw [ite_eq_left hm, abs_mul, abs_mul]
        calc
          |rho (n + h)| * |U x n| * |V x n| ≤
              (L * x ^ (1 / 4 : ℝ)) * (C * x ^ (1 / 8 : ℝ)) *
                (C * x ^ (1 / 8 : ℝ)) :=
            by
              gcongr
              · exact hrho n hnI
              · exact (hroot n hnI).1
              · exact (hroot n hnI).2
          _ = L * C ^ 2 * x ^ (1 / 2 : ℝ) := by
            rw [show (1 / 2 : ℝ) = (1 / 4 + 1 / 8) + 1 / 8 by norm_num,
              Real.rpow_add hx0, Real.rpow_add hx0]
            ring
      · rw [ite_eq_right hm, abs_zero]
        exact mul_nonneg (mul_nonneg hL.le (sq_nonneg C)) (Real.rpow_nonneg hx0.le _)
    have hsum :
        (∑ n ∈ I, if mask x v n then rho (n + h) * U x n * V x n else 0) -
          (∑ n ∈ I, if mask x v n then
            (if ((n + h : ℕ) : ℝ) ≤ 2 * x then rho (n + h) else 0) *
              U x n * V x n else 0) =
        ∑ n ∈ T, if mask x v n then rho (n + h) * U x n * V x n else 0 := by
      rw [← Finset.sum_sub_distrib, Finset.sum_filter]
      apply Finset.sum_congr rfl
      intro n _
      by_cases hm : mask x v n <;>
        by_cases ht : (n : ℝ) + (h : ℝ) ≤ 2 * x <;> simp [hm, ht]
    change |(_ : ℝ) - _| ≤ K * x ^ (1 / 2 : ℝ)
    rw [hsum]
    calc
      _ ≤ ∑ n ∈ T, |if mask x v n then rho (n + h) * U x n * V x n else 0| :=
        Finset.abs_sum_le_sum_abs _ _
      _ ≤ ∑ _n ∈ T, L * C ^ 2 * x ^ (1 / 2 : ℝ) := Finset.sum_le_sum hterm
      _ = (T.card : ℝ) * (L * C ^ 2 * x ^ (1 / 2 : ℝ)) := by
        simp only [Finset.sum_const, nsmul_eq_mul]
      _ ≤ ((h : ℝ) + 1) * (L * C ^ 2 * x ^ (1 / 2 : ℝ)) :=
        mul_le_mul_of_nonneg_right
          ((Nat.cast_le.mpr hcard).trans (le_add_of_nonneg_right zero_le_one))
          (mul_nonneg (mul_nonneg hL.le (sq_nonneg C)) (Real.rpow_nonneg hx0.le _))
      _ = K * x ^ (1 / 2 : ℝ) := by dsimp only [K]; ring
  have hpower : (fun x : ℝ => K * x ^ (1 / 2 : ℝ)) =O[Filter.atTop]
      (fun x : ℝ => x ^ (1 - (1 / 2 : ℝ))) := by
    simpa only [show (1 : ℝ) - 1 / 2 = 1 / 2 by norm_num] using
      Asymptotics.isBigO_const_mul_self K (fun x : ℝ => x ^ (1 / 2 : ℝ)) Filter.atTop
  intro ε hε
  filter_upwards [hbound, selberg40_power_saving_error_small (𝓗 := 𝓗)
    (fun x : ℝ => K * x ^ (1 / 2 : ℝ)) (1 / 2) (by norm_num) hpower ε hε]
    with x hx hsmall
  intro ρ W Bx B N rho
  have hnonneg : 0 ≤ K * x ^ (1 / 2 : ℝ) :=
    mul_nonneg hK.le (Real.rpow_nonneg (zero_le_one.trans hsmall.1.le) _)
  refine ⟨hsmall.1, hsmall.2.1, ?_⟩
  intro v
  exact (hx v).trans (by
    simpa only [abs_of_nonneg hnonneg] using hsmall.2.2)

theorem literal_minorant_eventually_positive_first_moment
    {𝓗 : Finset ℕ}
    (s : ℝ → Finset ℕ) (A : ℝ → ℕ → ℝ)
    (B H : ℝ → ℕ → ℕ → ℝ) (Z : ℝ → ℝ)
    (I Jold Jcross Jself E : ℝ) :
    let ρ : ℝ := 2624989 / 10000000
    let t : ℝ := 49599 / 50000
    let η : ℝ := 49599 / 20000000
    let κ : ℝ := exceptionalMassCoefficient 0 +
      exceptionalMassCoefficient 1
    let m : ℝ := 1 - κ
    let P : ℕ → ℝ := fun n => if n.Prime then 1 else 0
    let b : ℝ → ℕ → ℝ := fun x n =>
      exceptionalPrimeDefect x 0 n +
        exceptionalPrimeDefect x 1 n
    let r : ℝ → ℕ → ℝ := fun x n =>
      P n - exceptionalPrimeDefect x 0 n -
        exceptionalPrimeDefect x 1 n
    let O : ℝ → ℝ := fun x => ∑ n ∈ s x, A x n ^ 2
    let Lold : ℝ → ℝ := fun x => ∑ n ∈ s x, ∑ h ∈ 𝓗,
      P (n + h) * (2 * A x n * B x h n - B x h n ^ 2)
    let C : ℝ → ℝ := fun x => ∑ n ∈ s x, ∑ h ∈ 𝓗,
      r x (n + h) * (A x n - B x h n) * H x h n
    let SP : ℝ → ℝ := fun x => ∑ n ∈ s x, ∑ h ∈ 𝓗,
      P (n + h) * H x h n ^ 2
    let SR : ℝ → ℝ := fun x => ∑ n ∈ s x, ∑ h ∈ 𝓗,
      r x (n + h) * H x h n ^ 2
    let EX : ℝ → ℝ := fun x => ∑ n ∈ s x, ∑ h ∈ 𝓗,
      b x (n + h) * (A x n - B x h n) ^ 2
    (∀ᶠ x : ℝ in Filter.atTop, 0 < Z x) →
    0 < ρ * (Jold + 2 * m * t * Jcross - t ^ 2 * Jself -
      η * (17 / 50 : ℝ) * E - η⁻¹ * κ * t ^ 2 * Jself) - I →
    (∀ ε : ℝ, 0 < ε → ∀ᶠ x : ℝ in Filter.atTop,
      O x ≤ (I + ε) * Z x ∧
      (ρ * Jold - ε) * Z x ≤ Lold x ∧
      (ρ * m * Jcross - ε) * Z x ≤ C x ∧
      SP x ≤ (ρ * Jself + ε) * Z x ∧
      (ρ * m * Jself - ε) * Z x ≤ SR x ∧
      EX x ≤ (ρ * (17 / 50 : ℝ) * E + ε) * Z x) →
    ∀ᶠ x : ℝ in Filter.atTop,
      0 < ∑ n ∈ s x,
        (((𝓗.filter (fun h => (n + h).Prime)).card : ℝ) - 1) *
          A x n ^ 2 := by
  classical
  intro ρ t η κ m P b r O Lold C SP SR EX hZ hmargin hmoments
  let M : ℝ := ρ * (Jold + 2 * m * t * Jcross - t ^ 2 * Jself -
    η * (17 / 50 : ℝ) * E - η⁻¹ * κ * t ^ 2 * Jself) - I
  have hM : 0 < M := hmargin
  let β : ℝ := η⁻¹ * t ^ 2
  let τ : ℝ := 2 + 2 * t + t ^ 2 + η + 2 * β
  have ht : 0 < t := by norm_num [t]
  have hη : 0 < η := by norm_num [η]
  have hβ : 0 ≤ β := mul_nonneg (inv_nonneg.mpr hη.le) (sq_nonneg t)
  have hτ : τ ≤ 1000 := by norm_num [τ, β, t, η]
  let ε : ℝ := M / 2000
  have hε : 0 < ε := div_pos hM (by norm_num)
  have hsmall : M / 2 ≤ M - ε * τ := by
    calc
      M / 2 = M - ε * 1000 := by dsimp only [ε]; ring
      _ ≤ M - ε * τ :=
        sub_le_sub_left (mul_le_mul_of_nonneg_left hτ hε.le) M
  filter_upwards [hZ, hmoments ε hε] with x hxZ hxmoments
  rcases hxmoments with ⟨hO, hOld, hCross, hSP, hSR, hEX⟩
  let L : ℝ := Lold x + 2 * t * C x + β * SR x -
    ((t ^ 2 + β) * SP x + η * EX x + O x)
  have hcombined := sub_le_sub
    (add_le_add
      (add_le_add hOld
        (mul_le_mul_of_nonneg_left hCross (mul_nonneg zero_le_two ht.le)))
      (mul_le_mul_of_nonneg_left hSR hβ))
    (add_le_add
      (add_le_add
        (mul_le_mul_of_nonneg_left hSP (add_nonneg (sq_nonneg t) hβ))
        (mul_le_mul_of_nonneg_left hEX hη.le)) hO)
  have hmain : (M - ε * τ) * Z x ≤ L := by
    calc
      (M - ε * τ) * Z x =
          ((ρ * Jold - ε) * Z x +
            2 * t * ((ρ * m * Jcross - ε) * Z x) +
            β * ((ρ * m * Jself - ε) * Z x)) -
          ((t ^ 2 + β) * ((ρ * Jself + ε) * Z x) +
            η * ((ρ * (17 / 50 : ℝ) * E + ε) * Z x) +
            (I + ε) * Z x) := by
        dsimp only [M, τ, β, m]
        ring
      _ ≤ L := hcombined
  have hL : 0 < L :=
    ((mul_pos (half_pos hM) hxZ).trans_le
      (mul_le_mul_of_nonneg_right hsmall hxZ.le)).trans_le hmain
  have hpoint (n h : ℕ) :
      P (n + h) * (2 * A x n * B x h n - B x h n ^ 2) +
          2 * r x (n + h) * (A x n - B x h n) * (t * H x h n) -
          P (n + h) * (t * H x h n) ^ 2 -
          η * b x (n + h) * (A x n - B x h n) ^ 2 -
          η⁻¹ * b x (n + h) * (t * H x h n) ^ 2 =
        P (n + h) * (2 * A x n * B x h n - B x h n ^ 2) +
          (2 * t) * (r x (n + h) * (A x n - B x h n) * H x h n) +
          β * (r x (n + h) * H x h n ^ 2) -
          (t ^ 2 + β) * (P (n + h) * H x h n ^ 2) -
          η * (b x (n + h) * (A x n - B x h n) ^ 2) := by
    dsimp only [β, r, b]
    ring
  have hsum :
      (∑ n ∈ s x,
        ((∑ h ∈ 𝓗,
          (P (n + h) * (2 * A x n * B x h n - B x h n ^ 2) +
            2 * r x (n + h) * (A x n - B x h n) * (t * H x h n) -
            P (n + h) * (t * H x h n) ^ 2 -
            η * b x (n + h) * (A x n - B x h n) ^ 2 -
            η⁻¹ * b x (n + h) * (t * H x h n) ^ 2)) - A x n ^ 2)) = L := by
    simp_rw [hpoint]
    dsimp only [L, Lold, C, SR, SP, EX, O]
    simp only [Finset.sum_add_distrib, Finset.sum_sub_distrib, ← Finset.mul_sum]
    ring
  have hfinite := literal_minorant_finite_first_moment_lower_bound (𝓗 := 𝓗)
    (s x) x (A x) (B x) (H x)
  change (∑ n ∈ s x,
      ((∑ h ∈ 𝓗,
        (P (n + h) * (2 * A x n * B x h n - B x h n ^ 2) +
          2 * r x (n + h) * (A x n - B x h n) * (t * H x h n) -
          P (n + h) * (t * H x h n) ^ 2 -
          η * b x (n + h) * (A x n - B x h n) ^ 2 -
          η⁻¹ * b x (n + h) * (t * H x h n) ^ 2)) - A x n ^ 2)) ≤
      ∑ n ∈ s x,
        (((𝓗.filter (fun h => (n + h).Prime)).card : ℝ) - 1) *
          A x n ^ 2 at hfinite
  rw [hsum] at hfinite
  exact hL.trans_le hfinite

theorem literal_minorant_eventually_positive_first_moment_fin40
    {𝓗 : Finset ℕ}
    {h𝓗_card : 𝓗.card = 40}
    (s : ℝ → Finset ℕ) (A : ℝ → ℕ → ℝ)
    (B H : ℝ → Fin 40 → ℕ → ℝ) (Z : ℝ → ℝ)
    (I Jold Jcross Jself E : ℝ) :
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    let ρ : ℝ := 2624989 / 10000000
    let t : ℝ := 49599 / 50000
    let η : ℝ := 49599 / 20000000
    let κ : ℝ := exceptionalMassCoefficient 0 +
      exceptionalMassCoefficient 1
    let m : ℝ := 1 - κ
    let P : ℕ → ℝ := fun n => if n.Prime then 1 else 0
    let b : ℝ → ℕ → ℝ := fun x n =>
      exceptionalPrimeDefect x 0 n +
        exceptionalPrimeDefect x 1 n
    let r : ℝ → ℕ → ℝ := fun x n =>
      P n - exceptionalPrimeDefect x 0 n -
        exceptionalPrimeDefect x 1 n
    let O : ℝ → ℝ := fun x => ∑ n ∈ s x, A x n ^ 2
    let Lold : ℝ → ℝ := fun x => ∑ n ∈ s x, ∑ i : Fin 40,
      P (n + h i) * (2 * A x n * B x i n - B x i n ^ 2)
    let C : ℝ → ℝ := fun x => ∑ n ∈ s x, ∑ i : Fin 40,
      r x (n + h i) * (A x n - B x i n) * H x i n
    let SP : ℝ → ℝ := fun x => ∑ n ∈ s x, ∑ i : Fin 40,
      P (n + h i) * H x i n ^ 2
    let SR : ℝ → ℝ := fun x => ∑ n ∈ s x, ∑ i : Fin 40,
      r x (n + h i) * H x i n ^ 2
    let EX : ℝ → ℝ := fun x => ∑ n ∈ s x, ∑ i : Fin 40,
      b x (n + h i) * (A x n - B x i n) ^ 2
    (∀ᶠ x : ℝ in Filter.atTop, 0 < Z x) →
    0 < ρ * (Jold + 2 * m * t * Jcross - t ^ 2 * Jself -
      η * (17 / 50 : ℝ) * E - η⁻¹ * κ * t ^ 2 * Jself) - I →
    (∀ ε : ℝ, 0 < ε → ∀ᶠ x : ℝ in Filter.atTop,
      O x ≤ (I + ε) * Z x ∧
      (ρ * Jold - ε) * Z x ≤ Lold x ∧
      (ρ * m * Jcross - ε) * Z x ≤ C x ∧
      SP x ≤ (ρ * Jself + ε) * Z x ∧
      (ρ * m * Jself - ε) * Z x ≤ SR x ∧
      EX x ≤ (ρ * (17 / 50 : ℝ) * E + ε) * Z x) →
    ∀ᶠ x : ℝ in Filter.atTop,
      0 < ∑ n ∈ s x,
        (((𝓗.filter (fun h => (n + h).Prime)).card : ℝ) - 1) *
          A x n ^ 2 := by
  classical
  intro h ρ t η κ m P b r O Lold C SP SR EX hZ hmargin hmoments
  have hh : Function.Injective h :=
    (𝓗.orderEmbOfFin h𝓗_card).injective
  let B' : ℝ → ℕ → ℕ → ℝ := fun x => Function.extend h (B x) (fun _ => 0)
  let H' : ℝ → ℕ → ℕ → ℝ := fun x => Function.extend h (H x) (fun _ => 0)
  have hsum (g : ℕ → ℝ) :
      (∑ u ∈ 𝓗, g u) = ∑ i : Fin 40, g (h i) := by
    rw [← 𝓗.map_orderEmbOfFin_univ h𝓗_card,
      Finset.sum_map]
    rfl
  refine literal_minorant_eventually_positive_first_moment (𝓗 := 𝓗)
    s A B' H' Z I Jold Jcross Jself E hZ hmargin ?_
  intro ε hε
  filter_upwards [hmoments ε hε] with x hx
  simpa only [O, Lold, C, SP, SR, EX, hsum, B', H', hh.extend_apply] using hx

theorem exists_admissible_presieve_residue
    {𝓗 : Finset ℕ}
    {h𝓗_card : 𝓗.card = 40}
    {h𝓗_admissible : ∀ p : ℕ, p.Prime →
      ∃ a ∈ Finset.range p, a ∉ 𝓗.image (fun h => h % p)} (W : ℕ) (hW : 0 < W) :
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    ∃ v : ℕ, v < W ∧ ∀ i : Fin 40, Nat.Coprime (v + h i) W := by
  classical
  intro h
  let P : Finset ℕ := W.primeFactors
  have hP (p : P) : (p : ℕ).Prime := Nat.prime_of_mem_primeFactors p.property
  have havailable (p : P) : ∃ a ∈ Finset.range (p : ℕ),
      a ∉ 𝓗.image (fun n => n % (p : ℕ)) :=
    h𝓗_admissible p (hP p)
  choose a haRange haMissing using havailable
  let r : (p : P) → ZMod (p : ℕ) := fun p => -(a p : ZMod (p : ℕ))
  have hnz (p : P) (_ : p ∈ (Finset.univ : Finset P)) : (p : ℕ) ≠ 0 := (hP p).ne_zero
  have hpair : Set.Pairwise (↑(Finset.univ : Finset P) : Set P)
      (fun p q => Nat.Coprime (p : ℕ) (q : ℕ)) := by
    intro p _ q _ hpq
    exact (Nat.coprime_primes (hP p) (hP q)).mpr
      (fun hpq' => hpq (Subtype.ext hpq'))
  let raw : ℕ :=
    (Nat.chineseRemainderOfFinset (fun p : P => (r p).val)
      (fun p : P => (p : ℕ)) Finset.univ hnz hpair).val
  have hraw (p : P) : (raw : ZMod (p : ℕ)) = -(a p : ZMod (p : ℕ)) := by
    let : NeZero (p : ℕ) := ⟨(hP p).ne_zero⟩
    have hh : Nat.ModEq (p : ℕ) raw (r p).val :=
      (Nat.chineseRemainderOfFinset (fun p : P => (r p).val)
        (fun p : P => (p : ℕ)) Finset.univ hnz hpair).property p (Finset.mem_univ p)
    exact ((ZMod.natCast_eq_natCast_iff _ _ _).mpr hh).trans (ZMod.natCast_zmod_val _)
  have hcoprime (i : Fin 40) : Nat.Coprime (raw + h i) W := by
    apply Nat.coprime_of_dvd
    intro p hp hpd hpW
    let pp : P := ⟨p, Nat.mem_primeFactors.mpr ⟨hp, hpW, hW.ne'⟩⟩
    have hz : (raw : ZMod p) + (h i : ZMod p) = 0 := by
      simpa only [Nat.cast_add] using (ZMod.natCast_eq_zero_iff (raw + h i) p).mpr hpd
    rw [hraw pp] at hz
    have heq : (h i : ZMod p) = (a pp : ZMod p) :=
      sub_eq_zero.mp (by simpa only [sub_eq_add_neg, add_comm] using hz)
    have hmod : h i % p = a pp :=
      ((ZMod.natCast_eq_natCast_iff' (h i) (a pp) p).mp heq).trans
        (Nat.mod_eq_of_lt (Finset.mem_range.mp (haRange pp)))
    exact haMissing pp (Finset.mem_image.mpr
      ⟨h i, 𝓗.orderEmbOfFin_mem h𝓗_card i, hmod⟩)
  refine ⟨raw % W, Nat.mod_lt raw hW, ?_⟩
  intro i
  have hh := (Nat.mod_modEq raw W).add_right (h i)
  rw [Nat.coprime_iff_gcd_eq_one, hh.gcd_eq]
  exact hcoprime i

end

theorem trial_band_interval_cover {m : ℕ} (a : Fin (m + 2) → ℝ)
    {p : ℝ} (hp : a 0 < p ∧ p ≤ a (Fin.last (m + 1))) :
    ∃ j : Fin (m + 1), a j.castSucc < p ∧ p ≤ a j.succ := by
  classical
  let b : ℕ → ℝ := fun i => a ⟨min i (m + 1), Nat.lt_succ_of_le (min_le_right _ _)⟩
  have hb : p ∈ Set.Ioc (b 0) (b (m + 1)) := by
    simpa only [b, Nat.zero_min, min_self, Set.mem_Ioc] using! hp
  obtain ⟨j, hj⟩ := Set.mem_iUnion.mp (Ioc_subset_biUnion_Ioc (m + 1) b hb)
  obtain ⟨hj, hband⟩ := Set.mem_iUnion.mp hj
  have hj' := Finset.mem_range.mp hj
  refine ⟨⟨j, hj'⟩, ?_⟩
  simpa only [b, Set.mem_Ioc, Nat.min_eq_left (Nat.le_of_lt hj'),
    Nat.min_eq_left (Nat.succ_le_of_lt hj')] using! hband

theorem trial_band_tail_upper_bound {m : ℕ} (a : Fin (m + 2) → ℝ)
    (ha : Monotone a) (c : FiniteMeasure ℝ)
    (hc : c.restrict (Set.Ioc (a 0) (a (Fin.last (m + 1)))) = c)
    (j : Fin (m + 1)) {p : ℝ} (hp : a j.castSucc < p) :
    (c : Measure ℝ).real (Set.Ici p) ≤
      ∑ k ∈ (Finset.univ : Finset (Fin (m + 1))).filter (fun k => j ≤ k),
        fragmentBandMasses a c k := by
  classical
  let C := Set.Ioc (a 0) (a (Fin.last (m + 1)))
  have hcm : (c : Measure ℝ).restrict C = (c : Measure ℝ) :=
    congrArg (fun z : FiniteMeasure ℝ => (z : Measure ℝ)) hc
  have hleft : (c : Measure ℝ).real (Set.Ici p) =
      (c : Measure ℝ).real (Set.Ici p ∩ C) := by
    calc
      _ = ((c : Measure ℝ).restrict C).real (Set.Ici p) :=
        congrArg (fun μ : Measure ℝ => μ.real (Set.Ici p)) hcm.symm
      _ = _ := measureReal_restrict_apply measurableSet_Ici
  rw [hleft]
  calc
    _ ≤ (c : Measure ℝ).real
        (⋃ k ∈ (Finset.univ : Finset (Fin (m + 1))).filter (fun k => j ≤ k),
          Set.Ioc (a k.castSucc) (a k.succ)) := by
      apply measureReal_mono _ (measure_ne_top _ _)
      intro x hx
      obtain ⟨k, hk⟩ := trial_band_interval_cover a (Set.mem_Ioc.mp hx.2)
      have hjk : j ≤ k := by
        by_contra h
        have hkj := Fin.succ_le_castSucc_iff.mpr (lt_of_not_ge h)
        exact (not_lt_of_ge (hk.2.trans (ha hkj))) (hp.trans_le hx.1)
      exact Set.mem_iUnion.mpr ⟨k, Set.mem_iUnion.mpr
        ⟨Finset.mem_filter.mpr ⟨Finset.mem_univ k, hjk⟩, Set.mem_Ioc.mpr hk⟩⟩
    _ ≤ ∑ k ∈ (Finset.univ : Finset (Fin (m + 1))).filter (fun k => j ≤ k),
        (c : Measure ℝ).real (Set.Ioc (a k.castSucc) (a k.succ)) :=
      measureReal_biUnion_finset_le _ _
    _ = _ := by
      simp only [fragmentBandMasses, FiniteMeasure.restrict_mass,
        FiniteMeasure.coeFn_def, ENNReal.coe_toNNReal_eq_toReal, measureReal_def]

theorem trial_band_count_bad_zero {m : ℕ} (a : Fin (m + 2) → ℝ)
    (ha : Monotone a) (c : FiniteMeasure ℝ)
    (hc : c.restrict (Set.Ioc (a 0) (a (Fin.last (m + 1)))) = c)
    (δ : ℝ) (G : ℝ → ℝ → Prop)
    (hG : ∀ {u v p q : ℝ}, u ≤ v → p ≤ q → G v q → G u p)
    (hband : ∀ j : Fin (m + 1),
      a j.succ ≤ δ ∨ fragmentBandMasses a c j = 0 ∨
        G (∑ k ∈ (Finset.univ : Finset (Fin (m + 1))).filter (fun k => j ≤ k),
          fragmentBandMasses a c k) (a j.succ)) :
    (((c : Measure ℝ).restrict (Set.Ioi (0 : ℝ))).withDensity
      (fun p : ℝ => ENNReal.ofReal p⁻¹))
      {p : ℝ | δ < p ∧ ¬ G ((c : Measure ℝ).real (Set.Ici p)) p} = 0 := by
  classical
  have hcap : ∀ᵐ p ∂(c : Measure ℝ),
      p ∈ Set.Ioc (a 0) (a (Fin.last (m + 1))) := by
    have hcm := congrArg (fun z : FiniteMeasure ℝ => (z : Measure ℝ)) hc
    rw [← hcm]
    exact ae_restrict_mem measurableSet_Ioc
  have hzero : ∀ᵐ p ∂(c : Measure ℝ), ∀ j : Fin (m + 1),
      fragmentBandMasses a c j = 0 →
        p ∉ Set.Ioc (a j.castSucc) (a j.succ) := by
    rw [ae_all_iff]
    intro j
    rw [Filter.eventually_imp_distrib_left]
    intro hj
    apply measure_eq_zero_iff_ae_notMem.mp
    apply (measureReal_eq_zero_iff (by finiteness)).mp
    simpa only [fragmentBandMasses, FiniteMeasure.restrict_mass,
      FiniteMeasure.coeFn_def, ENNReal.coe_toNNReal_eq_toReal, measureReal_def] using hj
  have hbad : (c : Measure ℝ)
      {p : ℝ | δ < p ∧ ¬ G ((c : Measure ℝ).real (Set.Ici p)) p} = 0 := by
    apply measure_eq_zero_iff_ae_notMem.mpr
    filter_upwards [hcap, hzero] with p hp hz
    intro hbad
    obtain ⟨hpδ, hnot⟩ := hbad
    obtain ⟨j, hj⟩ := trial_band_interval_cover a (Set.mem_Ioc.mp hp)
    rcases hband j with hsmall | hempty | hgood
    · exact (not_lt_of_ge (hj.2.trans hsmall)) hpδ
    · exact hz j hempty (Set.mem_Ioc.mpr hj)
    · exact hnot (hG (trial_band_tail_upper_bound a ha c hc j hj.1) hj.2 hgood)
  exact ((withDensity_absolutelyContinuous _ _).trans
    Measure.absolutelyContinuous_restrict) hbad

theorem trial_fragmentBandMasses_sum {d m : ℕ}
    (a : Fin (m + 2) → ℝ) (X : Fin d → FiniteMeasure ℝ) (j : Fin (m + 1)) :
    fragmentBandMasses a (∑ i, X i) j =
      ∑ i, fragmentBandMasses a (X i) j := by
  classical
  simp only [fragmentBandMasses, FiniteMeasure.restrict_mass,
    FiniteMeasure.coeFn_def, ENNReal.coe_toNNReal_eq_toReal]
  rw [FiniteMeasure.toMeasure_sum, Measure.finsetSum_apply,
    ENNReal.toReal_sum (fun _ _ => measure_ne_top _ _)]

theorem trial_band_cap_zero_of_empty {m : ℕ} (a : Fin (m + 2) → ℝ)
    (c : FiniteMeasure ℝ)
    (hc : c.restrict (Set.Ioc (a 0) (a (Fin.last (m + 1)))) = c)
    (ζ : ℝ)
    (hband : ∀ j : Fin (m + 1), ζ < a j.succ →
      fragmentBandMasses a c j = 0) :
    (c : Measure ℝ) (Set.Ioi ζ) = 0 := by
  classical
  have hcm := congrArg (fun z : FiniteMeasure ℝ => (z : Measure ℝ)) hc
  have hcap : ∀ᵐ p ∂(c : Measure ℝ),
      p ∈ Set.Ioc (a 0) (a (Fin.last (m + 1))) := by
    rw [← hcm]
    exact ae_restrict_mem measurableSet_Ioc
  have hzero : ∀ᵐ p ∂(c : Measure ℝ), ∀ j : Fin (m + 1),
      ζ < a j.succ → p ∉ Set.Ioc (a j.castSucc) (a j.succ) := by
    rw [ae_all_iff]
    intro j
    rw [Filter.eventually_imp_distrib_left]
    intro hj
    apply measure_eq_zero_iff_ae_notMem.mp
    apply (measureReal_eq_zero_iff (by finiteness)).mp
    simpa only [fragmentBandMasses, FiniteMeasure.restrict_mass,
      FiniteMeasure.coeFn_def, ENNReal.coe_toNNReal_eq_toReal, measureReal_def]
      using hband j hj
  apply measure_eq_zero_iff_ae_notMem.mpr
  filter_upwards [hcap, hzero] with p hp hz hpζ
  obtain ⟨j, hj⟩ := trial_band_interval_cover a (Set.mem_Ioc.mp hp)
  exact hz j ((Set.mem_Ioi.mp hpζ).trans_le hj.2) (Set.mem_Ioc.mpr hj)

theorem trial_three_owner_mono {p q : ℝ} (hpq : p ≤ q) (L : ℝ) :
    3 * p - min ((3 / 2) * p) L ≤ 3 * q - min ((3 / 2) * q) L := by
  simp only [min_def]
  split_ifs <;> linarith

theorem physicalSourceOuterSupport_eq_one_of_band_certificate {m : ℕ}
    (a : Fin (m + 2) → ℝ) (ha : Monotone a)
    (X : Fin 40 → FiniteMeasure ℝ)
    (hcap : (∑ i, X i).restrict (Set.Ioc (a 0) (a (Fin.last (m + 1)))) = ∑ i, X i)
    (hbandcap : ∀ j : Fin (m + 1),
      (((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ) < a j.succ →
        fragmentBandMasses a (∑ i, X i) j = 0)
    (hrad : (∑ i : Fin 40, ((X i).mass : ℝ)) ≤ (physicalSourceOuterRadius : ℝ))
    (hrows : ∀ (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)),
      let R := physicalSourceRow ν t.val
      (∑ i : Fin 40, ((X i).mass : ℝ)) ≤ (R.outerCore : ℝ) ∨
        ∀ j : Fin (m + 1),
          a j.succ ≤ (R.activation : ℝ) ∨
          fragmentBandMasses a (∑ i, X i) j = 0 ∨
          (if R.order ≤ 2 then
            (∑ k ∈ (Finset.univ : Finset (Fin (m + 1))).filter (fun k => j ≤ k),
              fragmentBandMasses a (∑ i, X i) k) + a j.succ ≤
                (R.outerThreshold : ℝ)
          else
            let L : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
            ((∑ k ∈ (Finset.univ : Finset (Fin (m + 1))).filter (fun k => j ≤ k),
              fragmentBandMasses a (∑ i, X i) k) +
                min ((3 / 2) * a j.succ) L ≤ (R.outerThreshold : ℝ)) ∧
              3 * a j.succ - min ((3 / 2) * a j.succ) L ≤ (R.innerThreshold : ℝ))) :
    physicalSourceOuterSupport X = 1 := by
  classical
  let c : FiniteMeasure ℝ := ∑ i, X i
  have hcoe : (c : Measure ℝ) = ∑ i, (X i : Measure ℝ) := by
    simp only [c, FiniteMeasure.toMeasure_sum]
  have hcount : ((c : Measure ℝ).restrict (Set.Ioi (0 : ℝ))).withDensity
      (fun p : ℝ => ENNReal.ofReal p⁻¹) = physicalSourceCountMeasure X := by
    rw [hcoe]
    rfl
  unfold physicalSourceOuterSupport
  apply ite_eq_left
  refine ⟨hrad, ?_, ?_⟩
  · rw [← hcoe]
    exact trial_band_cap_zero_of_empty a c hcap _ hbandcap
  · intro ν t
    rcases hrows ν t with hcore | hband
    · exact Or.inl hcore
    · right
      let R := physicalSourceRow ν t.val
      let L : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
      let G : ℝ → ℝ → Prop := fun u p =>
        if R.order ≤ 2 then u + p ≤ (R.outerThreshold : ℝ)
        else u + min ((3 / 2) * p) L ≤ (R.outerThreshold : ℝ) ∧
          3 * p - min ((3 / 2) * p) L ≤ (R.innerThreshold : ℝ)
      have hG : ∀ {u v p q : ℝ}, u ≤ v → p ≤ q → G v q → G u p := by
        intro u v p q huv hpq h
        dsimp only [G] at h ⊢
        split_ifs at h ⊢ with horder
        · exact (add_le_add huv hpq).trans h
        · exact ⟨(add_le_add huv (min_le_min
              (mul_le_mul_of_nonneg_left hpq (by norm_num)) le_rfl)).trans h.1,
            (trial_three_owner_mono hpq L).trans h.2⟩
      have hzero := trial_band_count_bad_zero a ha c hcap (R.activation : ℝ) G hG hband
      rw [hcount, hcoe] at hzero
      simpa only [G, apply_ite Not, not_le, not_and_or] using hzero

theorem physicalSourceInnerSupport_eq_one_of_band_certificate {m : ℕ}
    (a : Fin (m + 2) → ℝ) (ha : Monotone a)
    (ν : Fin 2) (X : Fin 39 → FiniteMeasure ℝ)
    (hcap : (∑ i, X i).restrict (Set.Ioc (a 0) (a (Fin.last (m + 1)))) = ∑ i, X i)
    (hbandcap : ∀ j : Fin (m + 1),
      (((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ) < a j.succ →
        fragmentBandMasses a (∑ i, X i) j = 0)
    (hrad : (∑ i : Fin 39, ((X i).mass : ℝ)) ≤ (physicalSourceInnerRadius ν : ℝ))
    (hrows : ∀ t : Fin (if ν = 0 then 28 else 39),
      let R := physicalSourceRow ν t.val
      R.order = 1 ∨ (∑ i : Fin 39, ((X i).mass : ℝ)) ≤ (R.innerCore : ℝ) ∨
        ∀ j : Fin (m + 1),
          a j.succ ≤ (R.activation : ℝ) ∨
          fragmentBandMasses a (∑ i, X i) j = 0 ∨
          (if R.order ≤ 2 then
            (∑ k ∈ (Finset.univ : Finset (Fin (m + 1))).filter (fun k => j ≤ k),
              fragmentBandMasses a (∑ i, X i) k) + a j.succ ≤
                (R.innerThreshold : ℝ)
          else
            let L : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
            ((∑ k ∈ (Finset.univ : Finset (Fin (m + 1))).filter (fun k => j ≤ k),
              fragmentBandMasses a (∑ i, X i) k) +
                (3 * a j.succ - min ((3 / 2) * a j.succ) L) ≤
                  (R.innerThreshold : ℝ)) ∧
              min ((3 / 2) * a j.succ) L ≤ (R.outerThreshold : ℝ))) :
    physicalSourceInnerSupport ν X = 1 := by
  classical
  let c : FiniteMeasure ℝ := ∑ i, X i
  have hcoe : (c : Measure ℝ) = ∑ i, (X i : Measure ℝ) := by
    simp only [c, FiniteMeasure.toMeasure_sum]
  have hcount : ((c : Measure ℝ).restrict (Set.Ioi (0 : ℝ))).withDensity
      (fun p : ℝ => ENNReal.ofReal p⁻¹) = physicalSourceCountMeasure X := by
    rw [hcoe]
    rfl
  unfold physicalSourceInnerSupport
  apply ite_eq_left
  refine ⟨hrad, ?_, ?_⟩
  · rw [← hcoe]
    exact trial_band_cap_zero_of_empty a c hcap _ hbandcap
  · intro t
    rcases hrows t with hfirst | hcore | hband
    · exact Or.inl hfirst
    · exact Or.inr (Or.inl hcore)
    · right
      right
      let R := physicalSourceRow ν t.val
      let L : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
      let G : ℝ → ℝ → Prop := fun u p =>
        if R.order ≤ 2 then u + p ≤ (R.innerThreshold : ℝ)
        else u + (3 * p - min ((3 / 2) * p) L) ≤ (R.innerThreshold : ℝ) ∧
          min ((3 / 2) * p) L ≤ (R.outerThreshold : ℝ)
      have hG : ∀ {u v p q : ℝ}, u ≤ v → p ≤ q → G v q → G u p := by
        intro u v p q huv hpq h
        dsimp only [G] at h ⊢
        split_ifs at h ⊢ with horder
        · exact (add_le_add huv hpq).trans h
        · exact ⟨(add_le_add huv (trial_three_owner_mono hpq L)).trans h.1,
            (min_le_min (mul_le_mul_of_nonneg_left hpq (by norm_num)) le_rfl).trans h.2⟩
      have hzero := trial_band_count_bad_zero a ha c hcap (R.activation : ℝ) G hG hband
      rw [hcount, hcoe] at hzero
      simpa only [G, apply_ite Not, not_le, not_and_or] using hzero

theorem trial_isOpen_finite_forall {E ι : Type*}
    [TopologicalSpace E] [Finite ι] (P : E → ι → Prop)
    (hP : ∀ i, IsOpen {v | P v i}) : IsOpen {v | ∀ i, P v i} := by
  rw [Set.ofPred_forall]
  exact isOpen_iInter_of_finite hP

theorem trial_band_positive_lower_of_seed {m : ℕ}
    (a : Fin (m + 2) → ℝ) (ha : StrictMono a) (ha0 : a 0 = 0)
    {δ : ℝ} (hseed : a (0 : Fin (m + 1)).succ ≤ δ)
    {j : Fin (m + 1)} (hj : δ < a j.succ) : 0 < a j.castSucc := by
  have hj0 : j ≠ 0 := by
    rintro rfl
    exact (not_lt_of_ge hseed) hj
  rw [← ha0]
  exact ha (Fin.castSucc_pos (Fin.pos_iff_ne_zero.mpr hj0))

theorem trial_band_total_sum {d m : ℕ} (a : Fin (m + 2) → ℝ)
    (ha : Monotone a) (X : Fin d → FiniteMeasure ℝ)
    (hc : (∑ i, X i).restrict (Set.Ioc (a 0) (a (Fin.last (m + 1)))) = ∑ i, X i) :
    (∑ i, ∑ j, fragmentBandMasses a (X i) j) =
      ∑ i, ((X i).mass : ℝ) := by
  classical
  have hmass : (((∑ i, X i : FiniteMeasure ℝ)).mass : ℝ) =
      ∑ i, ((X i).mass : ℝ) := by
    simp only [FiniteMeasure.mass, FiniteMeasure.coeFn_def,
      ENNReal.coe_toNNReal_eq_toReal, FiniteMeasure.toMeasure_sum, Measure.finsetSum_apply,
      ENNReal.toReal_sum (fun _ _ => measure_ne_top _ _)]
  calc
    _ = ∑ j, fragmentBandMasses a (∑ i, X i) j := by
      simp only [trial_fragmentBandMasses_sum]
      exact Finset.sum_comm
    _ = _ := by
      rw [sum_fragmentBandMasses a ha, hc, hmass]

theorem physicalSourceOuter_inward_band_domain {m : ℕ}
    (a : Fin (m + 2) → ℝ) (ha : StrictMono a) (ha0 : a 0 = 0)
    (hseedcap : a (0 : Fin (m + 1)).succ ≤
      (((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ))
    (hseedrows : ∀ (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)),
      a (0 : Fin (m + 1)).succ ≤ ((physicalSourceRow ν t.val).activation : ℝ)) :
    let b : (Fin 40 → Fin (m + 1) → ℝ) → Fin (m + 1) → ℝ :=
      fun v j => ∑ i, v i j
    let total : (Fin 40 → Fin (m + 1) → ℝ) → ℝ :=
      fun v => ∑ i, ∑ j, v i j
    let tail : (Fin 40 → Fin (m + 1) → ℝ) → Fin (m + 1) → ℝ :=
      fun v j => ∑ k ∈ (Finset.univ : Finset (Fin (m + 1))).filter (fun k => j ≤ k), b v k
    let U : Set (Fin 40 → Fin (m + 1) → ℝ) := {v |
      total v < (physicalSourceOuterRadius : ℝ) ∧
      (∀ j : Fin (m + 1),
        (((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ) < a j.succ →
          b v j < a j.castSucc) ∧
      ∀ (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)),
        let R := physicalSourceRow ν t.val
        total v < (R.outerCore : ℝ) ∨
          ∀ j : Fin (m + 1),
            a j.succ ≤ (R.activation : ℝ) ∨ b v j < a j.castSucc ∨
              (if R.order ≤ 2 then tail v j + a j.succ < (R.outerThreshold : ℝ)
              else
                let L : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
                tail v j + min ((3 / 2) * a j.succ) L < (R.outerThreshold : ℝ) ∧
                  3 * a j.succ - min ((3 / 2) * a j.succ) L < (R.innerThreshold : ℝ))}
    IsOpen U ∧
      ∀ X : Fin 40 → FiniteMeasure ℝ,
        (∑ i, X i).restrict (Set.Ioc (a 0) (a (Fin.last (m + 1)))) = ∑ i, X i →
        (∀ j : Fin (m + 1), 0 < a j.castSucc →
          fragmentBandMasses a (∑ i, X i) j = 0 ∨
            a j.castSucc < fragmentBandMasses a (∑ i, X i) j) →
        (fun i => fragmentBandMasses a (X i)) ∈ U →
        physicalSourceOuterSupport X = 1 ∧
          (∑ i, ((X i).mass : ℝ)) < (physicalSourceOuterRadius : ℝ) := by
  classical
  intro b total tail U
  have hb (j : Fin (m + 1)) : Continuous (fun v => b v j) := by fun_prop
  have ht : Continuous total := by fun_prop
  have htail (j : Fin (m + 1)) : Continuous (fun v => tail v j) := by fun_prop
  have hcapopen : IsOpen {v : Fin 40 → Fin (m + 1) → ℝ |
      ∀ j : Fin (m + 1),
        (((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ) < a j.succ →
          b v j < a j.castSucc} := by
    apply trial_isOpen_finite_forall
    intro j
    rw [Set.ofPred_forall]
    exact isOpen_iInter_of_finite fun _ => isOpen_lt (hb j) continuous_const
  have hrowopen (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)) :
      IsOpen {v : Fin 40 → Fin (m + 1) → ℝ |
        let R := physicalSourceRow ν t.val
        total v < (R.outerCore : ℝ) ∨
          ∀ j : Fin (m + 1),
            a j.succ ≤ (R.activation : ℝ) ∨ b v j < a j.castSucc ∨
              (if R.order ≤ 2 then tail v j + a j.succ < (R.outerThreshold : ℝ)
              else
                let L : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
                tail v j + min ((3 / 2) * a j.succ) L < (R.outerThreshold : ℝ) ∧
                  3 * a j.succ - min ((3 / 2) * a j.succ) L < (R.innerThreshold : ℝ))} := by
    by_cases ho : (physicalSourceRow ν t.val).order ≤ 2
    all_goals
      simp only [ho, ↓reduceIte]
      apply (isOpen_lt ht continuous_const).union
      apply trial_isOpen_finite_forall
      intro j
      refine isOpen_const.union ((isOpen_lt (hb j) continuous_const).union ?_)
    · exact isOpen_lt ((htail j).add continuous_const) continuous_const
    · exact (isOpen_lt ((htail j).add continuous_const) continuous_const).inter isOpen_const
  constructor
  · apply (isOpen_lt ht continuous_const).inter
    apply hcapopen.inter
    apply trial_isOpen_finite_forall
    intro ν
    apply trial_isOpen_finite_forall
    exact hrowopen ν
  · intro X hXcap hXgap hXU
    let v : Fin 40 → Fin (m + 1) → ℝ :=
      fun i => fragmentBandMasses a (X i)
    have hbX (j : Fin (m + 1)) :
        b v j = fragmentBandMasses a (∑ i, X i) j :=
      (trial_fragmentBandMasses_sum a X j).symm
    have htX : total v = ∑ i, ((X i).mass : ℝ) :=
      trial_band_total_sum a ha.monotone X hXcap
    change v ∈ U at hXU
    have hrad : (∑ i, ((X i).mass : ℝ)) < (physicalSourceOuterRadius : ℝ) := by
      simpa only [htX] using hXU.1
    refine ⟨physicalSourceOuterSupport_eq_one_of_band_certificate a ha.monotone X hXcap
      ?_ hrad.le ?_, hrad⟩
    · intro j hj
      have hpos := trial_band_positive_lower_of_seed a ha ha0 hseedcap hj
      rcases hXgap j hpos with hz | hlarge
      · exact hz
      · exact False.elim ((not_lt_of_ge hlarge.le) (by
          simpa only [hbX] using hXU.2.1 j hj))
    · intro ν t
      rcases hXU.2.2 ν t with hcore | hband
      · left
        simpa only [htX] using hcore.le
      · right
        intro j
        by_cases hsmall : a j.succ ≤ ((physicalSourceRow ν t.val).activation : ℝ)
        · exact Or.inl hsmall
        rcases hband j with hs | hempty | hgood
        · exact False.elim (hsmall hs)
        · right
          left
          have hpos := trial_band_positive_lower_of_seed a ha ha0 (hseedrows ν t)
            (lt_of_not_ge hsmall)
          rcases hXgap j hpos with hz | hlarge
          · exact hz
          · exact False.elim ((not_lt_of_ge hlarge.le) (by simpa only [hbX] using hempty))
        · right
          right
          let R := physicalSourceRow ν t.val
          let T : ℝ := ∑ k ∈
            (Finset.univ : Finset (Fin (m + 1))).filter (fun k => j ≤ k),
              fragmentBandMasses a (∑ i, X i) k
          change (if R.order ≤ 2 then tail v j + a j.succ < (R.outerThreshold : ℝ)
            else tail v j + min ((3 / 2) * a j.succ)
                ((23 / 40) * (R.innerThreshold : ℝ)) < (R.outerThreshold : ℝ) ∧
              3 * a j.succ - min ((3 / 2) * a j.succ)
                ((23 / 40) * (R.innerThreshold : ℝ)) < (R.innerThreshold : ℝ)) at hgood
          change if R.order ≤ 2 then T + a j.succ ≤ (R.outerThreshold : ℝ)
            else T + min ((3 / 2) * a j.succ)
                ((23 / 40) * (R.innerThreshold : ℝ)) ≤ (R.outerThreshold : ℝ) ∧
              3 * a j.succ - min ((3 / 2) * a j.succ)
                ((23 / 40) * (R.innerThreshold : ℝ)) ≤ (R.innerThreshold : ℝ)
          split_ifs at hgood ⊢ with ho
          · simpa only [T, tail, hbX] using hgood.le
          · exact ⟨by simpa only [T, tail, hbX] using hgood.1.le, hgood.2.le⟩

theorem physicalSourceInner_inward_band_domain {m : ℕ}
    (a : Fin (m + 2) → ℝ) (ha : StrictMono a) (ha0 : a 0 = 0) (ν : Fin 2)
    (hseedcap : a (0 : Fin (m + 1)).succ ≤
      (((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ))
    (hseedrows : ∀ t : Fin (if ν = 0 then 28 else 39),
      a (0 : Fin (m + 1)).succ ≤ ((physicalSourceRow ν t.val).activation : ℝ)) :
    let b : (Fin 39 → Fin (m + 1) → ℝ) → Fin (m + 1) → ℝ :=
      fun v j => ∑ i, v i j
    let total : (Fin 39 → Fin (m + 1) → ℝ) → ℝ :=
      fun v => ∑ i, ∑ j, v i j
    let tail : (Fin 39 → Fin (m + 1) → ℝ) → Fin (m + 1) → ℝ :=
      fun v j => ∑ k ∈ (Finset.univ : Finset (Fin (m + 1))).filter (fun k => j ≤ k), b v k
    let U : Set (Fin 39 → Fin (m + 1) → ℝ) := {v |
      total v < (physicalSourceInnerRadius ν : ℝ) ∧
      (∀ j : Fin (m + 1),
        (((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ) < a j.succ →
          b v j < a j.castSucc) ∧
      ∀ t : Fin (if ν = 0 then 28 else 39),
        let R := physicalSourceRow ν t.val
        R.order = 1 ∨ total v < (R.innerCore : ℝ) ∨
          ∀ j : Fin (m + 1),
            a j.succ ≤ (R.activation : ℝ) ∨ b v j < a j.castSucc ∨
              (if R.order ≤ 2 then tail v j + a j.succ < (R.innerThreshold : ℝ)
              else
                let L : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
                tail v j + (3 * a j.succ - min ((3 / 2) * a j.succ) L) <
                    (R.innerThreshold : ℝ) ∧
                  (min ((3 / 2) * a j.succ) L < (R.outerThreshold : ℝ) ∨
                    L ≤ (R.outerThreshold : ℝ)))}
    IsOpen U ∧
      ∀ X : Fin 39 → FiniteMeasure ℝ,
        (∑ i, X i).restrict (Set.Ioc (a 0) (a (Fin.last (m + 1)))) = ∑ i, X i →
        (∀ j : Fin (m + 1), 0 < a j.castSucc →
          fragmentBandMasses a (∑ i, X i) j = 0 ∨
            a j.castSucc < fragmentBandMasses a (∑ i, X i) j) →
        (fun i => fragmentBandMasses a (X i)) ∈ U →
        physicalSourceInnerSupport ν X = 1 ∧
          (∑ i, ((X i).mass : ℝ)) < (physicalSourceInnerRadius ν : ℝ) := by
  classical
  intro b total tail U
  have hb (j : Fin (m + 1)) : Continuous (fun v => b v j) := by fun_prop
  have ht : Continuous total := by fun_prop
  have htail (j : Fin (m + 1)) : Continuous (fun v => tail v j) := by fun_prop
  have hcapopen : IsOpen {v : Fin 39 → Fin (m + 1) → ℝ |
      ∀ j : Fin (m + 1),
        (((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ) < a j.succ →
          b v j < a j.castSucc} := by
    apply trial_isOpen_finite_forall
    intro j
    rw [Set.ofPred_forall]
    exact isOpen_iInter_of_finite fun _ => isOpen_lt (hb j) continuous_const
  have hrowopen (t : Fin (if ν = 0 then 28 else 39)) :
      IsOpen {v : Fin 39 → Fin (m + 1) → ℝ |
        let R := physicalSourceRow ν t.val
        R.order = 1 ∨ total v < (R.innerCore : ℝ) ∨
          ∀ j : Fin (m + 1),
            a j.succ ≤ (R.activation : ℝ) ∨ b v j < a j.castSucc ∨
              (if R.order ≤ 2 then tail v j + a j.succ < (R.innerThreshold : ℝ)
              else
                let L : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
                tail v j + (3 * a j.succ - min ((3 / 2) * a j.succ) L) <
                    (R.innerThreshold : ℝ) ∧
                  (min ((3 / 2) * a j.succ) L < (R.outerThreshold : ℝ) ∨
                    L ≤ (R.outerThreshold : ℝ)))} := by
    by_cases ho : (physicalSourceRow ν t.val).order ≤ 2
    all_goals
      simp only [ho, ↓reduceIte]
      refine isOpen_const.union ((isOpen_lt ht continuous_const).union ?_)
      apply trial_isOpen_finite_forall
      intro j
      refine isOpen_const.union ((isOpen_lt (hb j) continuous_const).union ?_)
    · exact isOpen_lt ((htail j).add continuous_const) continuous_const
    · exact (isOpen_lt ((htail j).add continuous_const) continuous_const).inter isOpen_const
  constructor
  · apply (isOpen_lt ht continuous_const).inter
    apply hcapopen.inter
    apply trial_isOpen_finite_forall
    exact hrowopen
  · intro X hXcap hXgap hXU
    let v : Fin 39 → Fin (m + 1) → ℝ :=
      fun i => fragmentBandMasses a (X i)
    have hbX (j : Fin (m + 1)) :
        b v j = fragmentBandMasses a (∑ i, X i) j :=
      (trial_fragmentBandMasses_sum a X j).symm
    have htX : total v = ∑ i, ((X i).mass : ℝ) :=
      trial_band_total_sum a ha.monotone X hXcap
    change v ∈ U at hXU
    have hrad : (∑ i, ((X i).mass : ℝ)) < (physicalSourceInnerRadius ν : ℝ) := by
      simpa only [htX] using hXU.1
    refine ⟨physicalSourceInnerSupport_eq_one_of_band_certificate a ha.monotone ν X hXcap
      ?_ hrad.le ?_, hrad⟩
    · intro j hj
      have hpos := trial_band_positive_lower_of_seed a ha ha0 hseedcap hj
      rcases hXgap j hpos with hz | hlarge
      · exact hz
      · exact False.elim ((not_lt_of_ge hlarge.le) (by
          simpa only [hbX] using hXU.2.1 j hj))
    · intro t
      rcases hXU.2.2 t with hfirst | hcore | hband
      · exact Or.inl hfirst
      · right
        left
        simpa only [htX] using hcore.le
      · right
        right
        intro j
        by_cases hsmall : a j.succ ≤ ((physicalSourceRow ν t.val).activation : ℝ)
        · exact Or.inl hsmall
        rcases hband j with hs | hempty | hgood
        · exact False.elim (hsmall hs)
        · right
          left
          have hpos := trial_band_positive_lower_of_seed a ha ha0 (hseedrows t)
            (lt_of_not_ge hsmall)
          rcases hXgap j hpos with hz | hlarge
          · exact hz
          · exact False.elim ((not_lt_of_ge hlarge.le) (by simpa only [hbX] using hempty))
        · right
          right
          let R := physicalSourceRow ν t.val
          let T : ℝ := ∑ k ∈
            (Finset.univ : Finset (Fin (m + 1))).filter (fun k => j ≤ k),
              fragmentBandMasses a (∑ i, X i) k
          change (if R.order ≤ 2 then tail v j + a j.succ < (R.innerThreshold : ℝ)
            else tail v j + (3 * a j.succ - min ((3 / 2) * a j.succ)
                ((23 / 40) * (R.innerThreshold : ℝ))) < (R.innerThreshold : ℝ) ∧
              (min ((3 / 2) * a j.succ) ((23 / 40) * (R.innerThreshold : ℝ)) <
                  (R.outerThreshold : ℝ) ∨
                (23 / 40) * (R.innerThreshold : ℝ) ≤ (R.outerThreshold : ℝ))) at hgood
          change if R.order ≤ 2 then T + a j.succ ≤ (R.innerThreshold : ℝ)
            else T + (3 * a j.succ - min ((3 / 2) * a j.succ)
                ((23 / 40) * (R.innerThreshold : ℝ))) ≤ (R.innerThreshold : ℝ) ∧
              min ((3 / 2) * a j.succ) ((23 / 40) * (R.innerThreshold : ℝ)) ≤
                (R.outerThreshold : ℝ)
          split_ifs at hgood ⊢ with ho
          · simpa only [T, tail, hbX] using hgood.le
          · refine ⟨by simpa only [T, tail, hbX] using hgood.1.le, ?_⟩
            rcases hgood.2 with hstrict | hplateau
            · exact hstrict.le
            · exact (min_le_right _ _).trans hplateau

theorem trial_inward_band_cap_domain {d m : ℕ}
    (a : Fin (m + 2) → ℝ) (ha : StrictMono a) (ha0 : a 0 = 0)
    (c : ℝ) (hseed : a (0 : Fin (m + 1)).succ ≤ c) :
    let U : Set (Fin d → Fin (m + 1) → ℝ) := {v |
      ∀ j : Fin (m + 1), c < a j.succ → (∑ i, v i j) < a j.castSucc}
    IsOpen U ∧
      ∀ X : Fin d → FiniteMeasure ℝ,
        (∑ i, X i).restrict (Set.Ioc (a 0) (a (Fin.last (m + 1)))) = ∑ i, X i →
        (∀ j : Fin (m + 1), 0 < a j.castSucc →
          fragmentBandMasses a (∑ i, X i) j = 0 ∨
            a j.castSucc < fragmentBandMasses a (∑ i, X i) j) →
        (fun i => fragmentBandMasses a (X i)) ∈ U →
        ∀ i, (X i : Measure ℝ) (Set.Ioi c) = 0 := by
  classical
  intro U
  constructor
  · dsimp only [U]
    apply trial_isOpen_finite_forall
    intro j
    rw [Set.ofPred_forall]
    exact isOpen_iInter_of_finite fun _ => isOpen_lt (by fun_prop) continuous_const
  · intro X hXcap hXgap hXU
    have hzero : ((∑ i, X i : FiniteMeasure ℝ) : Measure ℝ) (Set.Ioi c) = 0 := by
      apply trial_band_cap_zero_of_empty a _ hXcap c
      intro j hj
      have hpos := trial_band_positive_lower_of_seed a ha ha0 hseed hj
      rcases hXgap j hpos with hz | hlarge
      · exact hz
      · have hsmall := hXU j hj
        rw [← trial_fragmentBandMasses_sum a X j] at hsmall
        exact False.elim ((not_lt_of_ge hlarge.le) hsmall)
    rw [FiniteMeasure.toMeasure_sum, Measure.finsetSum_apply, Finset.sum_eq_zero_iff] at hzero
    exact fun i => hzero i (Finset.mem_univ i)

theorem trial_band_tail_eq {m : ℕ} (a : Fin (m + 2) → ℝ)
    (ha : Monotone a) (c : FiniteMeasure ℝ) (j : Fin (m + 1)) :
    (∑ k ∈ (Finset.univ : Finset (Fin (m + 1))).filter (fun k => j ≤ k),
      fragmentBandMasses a c k) =
        (c : Measure ℝ).real (Set.Ioc (a j.castSucc) (a (Fin.last (m + 1)))) := by
  classical
  let S : Finset (Fin (m + 1)) := Finset.univ.filter (fun k => j ≤ k)
  let E : Fin (m + 1) → Set ℝ := fun k => Set.Ioc (a k.castSucc) (a k.succ)
  have hdis : (S : Set (Fin (m + 1))).Pairwise (fun k l => Disjoint (E k) (E l)) := by
    intro k _ l _ hkl
    rcases lt_or_gt_of_ne hkl with h | h
    · exact Set.Ioc_disjoint_Ioc_of_le (ha (Fin.succ_le_castSucc_iff.mpr h))
    · exact (Set.Ioc_disjoint_Ioc_of_le (ha (Fin.succ_le_castSucc_iff.mpr h))).symm
  have hcover : (⋃ k ∈ S, E k) =
      Set.Ioc (a j.castSucc) (a (Fin.last (m + 1))) := by
    ext p
    constructor
    · simp only [Set.mem_iUnion, S, Finset.mem_filter, Finset.mem_univ, true_and]
      rintro ⟨k, hjk, hk⟩
      have hk' := Set.mem_Ioc.mp hk
      exact Set.mem_Ioc.mpr
        ⟨(ha (Fin.castSucc_le_castSucc_iff.mpr hjk)).trans_lt hk'.1,
          hk'.2.trans (ha (Fin.le_last _))⟩
    · intro hp
      have hp' := Set.mem_Ioc.mp hp
      obtain ⟨k, hk⟩ := trial_band_interval_cover a
        ⟨(ha (Fin.zero_le _)).trans_lt hp'.1, hp'.2⟩
      have hjk : j ≤ k := by
        by_contra h
        have hkj := Fin.succ_le_castSucc_iff.mpr (lt_of_not_ge h)
        exact (not_lt_of_ge (hk.2.trans (ha hkj))) hp'.1
      exact Set.mem_iUnion.mpr ⟨k, Set.mem_iUnion.mpr
        ⟨Finset.mem_filter.mpr ⟨Finset.mem_univ _, hjk⟩, Set.mem_Ioc.mpr hk⟩⟩
  calc
    _ = ∑ k ∈ S, (c : Measure ℝ).real (E k) := by
      simp only [S, E, fragmentBandMasses, FiniteMeasure.restrict_mass,
        FiniteMeasure.coeFn_def, ENNReal.coe_toNNReal_eq_toReal, measureReal_def]
    _ = (c : Measure ℝ).real (⋃ k ∈ S, E k) :=
      (measureReal_biUnion_finset hdis (fun _ _ => measurableSet_Ioc)).symm
    _ = _ := congrArg (fun A : Set ℝ => (c : Measure ℝ).real A) hcover

open scoped Classical in
theorem trial_finite_tail_measureReal {ι : Type*} [Fintype ι]
    (c : FiniteMeasure ℝ) (δ : ℝ) (x : ι → ℝ)
    (htail : (c : Measure ℝ).restrict (Set.Ioi δ) =
      ∑ k, ENNReal.ofReal (x k) • Measure.dirac (x k))
    (hx : ∀ k, 0 ≤ x k) (A : Set ℝ) (hA : MeasurableSet A)
    (hAδ : A ⊆ Set.Ioi δ) :
    (c : Measure ℝ).real A = ∑ k, if x k ∈ A then x k else 0 := by
  classical
  change ((c : Measure ℝ) A).toReal = _
  rw [← Measure.restrict_eq_self (c : Measure ℝ) hAδ, htail, Measure.finsetSum_apply]
  rw [ENNReal.toReal_sum (fun _ _ => by
    rw [Measure.smul_apply, smul_eq_mul]
    exact ENNReal.mul_ne_top ENNReal.ofReal_ne_top (measure_ne_top _ _))]
  apply Finset.sum_congr rfl
  intro k _
  by_cases hk : x k ∈ A
  · rw [ite_eq_left hk, Measure.smul_apply, smul_eq_mul,
      Measure.dirac_apply_of_mem hk, mul_one, ENNReal.toReal_ofReal (hx k)]
  · simp only [Measure.smul_apply, smul_eq_mul, Measure.dirac_apply' _ hA,
      Set.indicator_of_notMem hk, mul_zero, ENNReal.toReal_zero, ite_eq_right hk]

theorem trial_occupied_band_has_minimal_mark {m : ℕ} {ι : Type*} [Fintype ι]
    (a : Fin (m + 2) → ℝ) (ha : Monotone a)
    (c : FiniteMeasure ℝ) (δ : ℝ) (x : ι → ℝ)
    (htail : (c : Measure ℝ).restrict (Set.Ioi δ) =
      ∑ k, ENNReal.ofReal (x k) • Measure.dirac (x k))
    (hx : ∀ k, 0 ≤ x k ∧ x k ≤ a (Fin.last (m + 1)))
    (j : Fin (m + 1)) (hjδ : δ ≤ a j.castSucc)
    (hj : fragmentBandMasses a c j ≠ 0) :
    ∃ k : ι, a j.castSucc < x k ∧ x k ≤ a j.succ ∧
      (∑ l ∈ (Finset.univ : Finset (Fin (m + 1))).filter (fun l => j ≤ l),
        fragmentBandMasses a c l) =
          (c : Measure ℝ).real (Set.Ici (x k)) := by
  classical
  let S : Finset ι :=
    Finset.univ.filter (fun k => x k ∈ Set.Ioc (a j.castSucc) (a j.succ))
  have hS : S.Nonempty := by
    by_contra h
    have hnone : ∀ k : ι, x k ∉ Set.Ioc (a j.castSucc) (a j.succ) := by
      intro k hk
      exact h ⟨k, Finset.mem_filter.mpr ⟨Finset.mem_univ _, hk⟩⟩
    have he := trial_finite_tail_measureReal c δ x htail (fun k => (hx k).1)
      (Set.Ioc (a j.castSucc) (a j.succ)) measurableSet_Ioc
      (fun p hp => Set.mem_Ioi.mpr (hjδ.trans_lt (Set.mem_Ioc.mp hp).1))
    have hz : (c : Measure ℝ).real (Set.Ioc (a j.castSucc) (a j.succ)) = 0 := by
      simpa only [hnone, ↓reduceIte, Finset.sum_const_zero] using he
    apply hj
    simpa only [fragmentBandMasses, FiniteMeasure.restrict_mass,
      FiniteMeasure.coeFn_def, ENNReal.coe_toNNReal_eq_toReal, measureReal_def] using hz
  obtain ⟨k, hkS, hkmin⟩ := S.exists_min_image x hS
  have hk : a j.castSucc < x k ∧ x k ≤ a j.succ :=
    Set.mem_Ioc.mp (Finset.mem_filter.mp hkS).2
  refine ⟨k, hk.1, hk.2, ?_⟩
  rw [trial_band_tail_eq a ha]
  rw [trial_finite_tail_measureReal c δ x htail (fun l => (hx l).1)
    (Set.Ioc (a j.castSucc) (a (Fin.last (m + 1)))) measurableSet_Ioc
    (fun p hp => Set.mem_Ioi.mpr (hjδ.trans_lt (Set.mem_Ioc.mp hp).1))]
  rw [trial_finite_tail_measureReal c δ x htail (fun l => (hx l).1)
    (Set.Ici (x k)) measurableSet_Ici
    (fun p hp => Set.mem_Ioi.mpr ((hjδ.trans_lt hk.1).trans_le (Set.mem_Ici.mp hp)))]
  apply Finset.sum_congr rfl
  intro l _
  have hiff : x l ∈ Set.Ioc (a j.castSucc) (a (Fin.last (m + 1))) ↔ x k ≤ x l := by
    constructor
    · intro hl
      have hl' := Set.mem_Ioc.mp hl
      by_cases hlupper : x l ≤ a j.succ
      · exact hkmin l (Finset.mem_filter.mpr
          ⟨Finset.mem_univ _, Set.mem_Ioc.mpr ⟨hl'.1, hlupper⟩⟩)
      · exact hk.2.trans (le_of_lt (lt_of_not_ge hlupper))
    · intro hl
      exact Set.mem_Ioc.mpr ⟨hk.1.trans_le hl, (hx l).2⟩
  simp only [Set.mem_Ici, hiff]

theorem trial_finite_band_inward_row {ι : Type*} [Fintype ι]
    (c : FiniteMeasure ℝ) (δ κ A : ℝ) (hδA : δ ≤ A) (x : ι → ℝ)
    (hx : ∀ k, 0 ≤ x k ∧ x k ≤ κ)
    (htail : (c : Measure ℝ).restrict (Set.Ioi δ) =
      ∑ k, ENNReal.ofReal (x k) • Measure.dirac (x k))
    (G : ℝ → ℝ → Prop) (hGopen : ∀ u : ℝ, IsOpen {p : ℝ | G u p})
    (hgood : ∀ k, x k < A ∨ G ((c : Measure ℝ).real (Set.Ici (x k))) (x k)) :
    ∃ ε : ℝ, 0 < ε ∧
      ∀ (m : ℕ) (a : Fin (m + 2) → ℝ),
        Monotone a → a (0 : Fin (m + 1)).succ = δ →
        a (Fin.last (m + 1)) = κ →
        (∀ j : Fin (m + 1), j ≠ 0 → a j.succ - a j.castSucc < ε) →
        ∀ j : Fin (m + 1),
          a j.succ ≤ A ∨ fragmentBandMasses a c j = 0 ∨
            G (∑ l ∈ (Finset.univ : Finset (Fin (m + 1))).filter (fun l => j ≤ l),
              fragmentBandMasses a c l) (a j.succ) := by
  classical
  have hlocal (k : ι) : ∃ r : ℝ, 0 < r ∧
      Metric.ball (x k) r ⊆
        {p : ℝ | p < A ∨ G ((c : Measure ℝ).real (Set.Ici (x k))) p} :=
    Metric.mem_nhds_iff.mp
      (((isOpen_lt continuous_id continuous_const).union (hGopen _)).mem_nhds (hgood k))
  choose r hrpos hr using hlocal
  obtain ⟨ε, hε, hεr⟩ := Pi.exists_forall_pos_add_lt (x := fun _ : ι => (0 : ℝ)) hrpos
  simp only [zero_add] at hεr
  refine ⟨ε, hε, ?_⟩
  intro m a ha hseed hlast hmesh j
  by_cases hj0 : j = 0
  · subst j
    exact Or.inl (by simpa only [hseed] using hδA)
  by_cases hj : fragmentBandMasses a c j = 0
  · exact Or.inr (Or.inl hj)
  have hjδ : δ ≤ a j.castSucc := by
    rw [← hseed]
    exact ha (Fin.succ_le_castSucc_iff.mpr (Fin.pos_iff_ne_zero.mpr hj0))
  have hx' : ∀ k, 0 ≤ x k ∧ x k ≤ a (Fin.last (m + 1)) := by
    simpa only [hlast] using hx
  obtain ⟨k, hkleft, hkright, hkeq⟩ :=
    trial_occupied_band_has_minimal_mark a ha c δ x htail hx' j hjδ hj
  have hball : a j.succ ∈ Metric.ball (x k) (r k) := by
    rw [Metric.mem_ball, Real.dist_eq, abs_of_nonneg (sub_nonneg.mpr hkright)]
    have hdist : a j.succ - x k < ε := by
      linarith only [hkleft, hmesh j hj0]
    exact hdist.trans (hεr k)
  rcases hr k hball with hsmall | howner
  · exact Or.inl hsmall.le
  · exact Or.inr (Or.inr (hkeq.symm ▸ howner))

theorem trial_finite_tail_coordinate_mass
    (δ : ℝ) (Y : FiniteMeasure ℝ) (n : ℕ) (x : Fin n → ℝ)
    (hY : Y.restrict (Set.Ioc (0 : ℝ) δ) = Y) (hx : ∀ a, δ < x a) :
    (((Y + weightedEmpirical n x : FiniteMeasure ℝ) : Measure ℝ).restrict
      (Set.Ioi δ)) = ∑ a, ENNReal.ofReal (x a) • Measure.dirac (x a) := by
  classical
  have hlow : (Y : Measure ℝ).restrict (Set.Ioi δ) = 0 := by
    have hi := congrArg (fun z : FiniteMeasure ℝ => (z : Measure ℝ)) hY
    rw [FiniteMeasure.restrict_measure_eq] at hi
    rw [← hi, Measure.restrict_restrict measurableSet_Ioi,
      Set.disjoint_iff_inter_eq_empty.mp Set.Ioc_disjoint_Ioi_same.symm,
      Measure.restrict_empty]
  rw [FiniteMeasure.toMeasure_add, Measure.restrict_add, hlow, zero_add,
    coe_weightedEmpirical]
  rw [← Measure.restrictₗ_apply, map_sum]
  simp only [Measure.restrictₗ_apply]
  apply Finset.sum_congr rfl
  intro a _
  rw [Measure.restrict_smul, restrict_dirac, ite_eq_left (Set.mem_Ioi.mpr (hx a))]

theorem trial_finite_tail_mass_and_count
    (d : ℕ) (δ : ℝ) (hδ : 0 < δ)
    (Y : Fin d → FiniteMeasure ℝ) (n : Fin d → ℕ)
    (x : (i : Fin d) → Fin (n i) → ℝ)
    (hY : ∀ i, (Y i).restrict (Set.Ioc (0 : ℝ) δ) = Y i)
    (hx : ∀ i a, δ < x i a) :
    let X : Fin d → FiniteMeasure ℝ :=
      fun i => Y i + weightedEmpirical (n i) (x i)
    (((∑ i, X i : FiniteMeasure ℝ) : Measure ℝ).restrict (Set.Ioi δ) =
      ∑ k : (i : Fin d) × Fin (n i),
        ENNReal.ofReal (x k.1 k.2) • Measure.dirac (x k.1 k.2)) ∧
      (physicalSourceCountMeasure X).restrict (Set.Ioi δ) =
        ∑ k : (i : Fin d) × Fin (n i), Measure.dirac (x k.1 k.2) := by
  classical
  intro X
  have htail (i : Fin d) : (X i : Measure ℝ).restrict (Set.Ioi δ) =
      ∑ a : Fin (n i), ENNReal.ofReal (x i a) • Measure.dirac (x i a) :=
    trial_finite_tail_coordinate_mass δ (Y i) (n i) (x i) (hY i) (hx i)
  constructor
  · rw [FiniteMeasure.toMeasure_sum]
    rw [← Measure.restrictₗ_apply, map_sum]
    simp only [Measure.restrictₗ_apply]
    simp only [htail, Fintype.sum_sigma]
  · simpa only [Fintype.sum_sigma] using
      physicalSourceCountMeasure_finite_tail d δ hδ Y n x hY hx

theorem trial_finite_count_zero_excludes_marks {ι : Type*} [Fintype ι]
    (N : Measure ℝ) (δ : ℝ) (x : ι → ℝ)
    (hN : N.restrict (Set.Ioi δ) = ∑ k, Measure.dirac (x k))
    (A : Set ℝ) (hAδ : A ⊆ Set.Ioi δ) (hA : N A = 0) :
    ∀ k, x k ∉ A := by
  classical
  have hzero : (∑ k, Measure.dirac (x k)) A = 0 := by
    rw [← hN, Measure.restrict_eq_self N hAδ, hA]
  rw [Measure.finsetSum_apply, Finset.sum_eq_zero_iff] at hzero
  intro k hk
  have hz := hzero k (Finset.mem_univ k)
  rw [Measure.dirac_apply_of_mem hk] at hz
  exact one_ne_zero hz

theorem trial_finite_count_strict_row {ι : Type*} [Fintype ι]
    (c : FiniteMeasure ℝ) (N : Measure ℝ) (δ A : ℝ) (hδA : δ < A) (x : ι → ℝ)
    (hN : N.restrict (Set.Ioi δ) = ∑ k, Measure.dirac (x k))
    (G : ℝ → ℝ → Prop)
    (hlevel : N {A} = 0)
    (hbad : N {p : ℝ | A < p ∧ ¬ G ((c : Measure ℝ).real (Set.Ici p)) p} = 0) :
    ∀ k, x k < A ∨ G ((c : Measure ℝ).real (Set.Ici (x k))) (x k) := by
  have hnolevel := trial_finite_count_zero_excludes_marks N δ x hN {A}
    (Set.singleton_subset_iff.mpr hδA) hlevel
  have hnobad := trial_finite_count_zero_excludes_marks N δ x hN
    {p : ℝ | A < p ∧ ¬ G ((c : Measure ℝ).real (Set.Ici p)) p}
    (fun p hp => Set.mem_Ioi.mpr (hδA.trans (Set.mem_ofPred_eq.mp hp).1)) hbad
  intro k
  have hkA : x k ≠ A := by
    simpa only [Set.mem_singleton_iff] using hnolevel k
  rcases lt_or_gt_of_ne hkA with h | h
  · exact Or.inl h
  · right
    by_contra hg
    exact hnobad k (Set.mem_ofPred_eq.mpr ⟨h, hg⟩)

theorem trial_restrict_eq_self_of_subset
    (c : FiniteMeasure ℝ) (A B : Set ℝ) (hc : c.restrict A = c) (hAB : A ⊆ B) :
    c.restrict B = c := by
  apply FiniteMeasure.toMeasure_injective
  apply le_antisymm Measure.restrict_le_self
  calc
    (c : Measure ℝ) = (c : Measure ℝ).restrict A := by
      simpa only [FiniteMeasure.restrict_measure_eq] using
        (congrArg (fun z : FiniteMeasure ℝ => (z : Measure ℝ)) hc).symm
    _ ≤ (c : Measure ℝ).restrict B := Measure.restrict_mono_set _ hAB

theorem trial_finite_configuration_cap
    (d : ℕ) (δ κ : ℝ) (hδ : 0 < δ) (hδκ : δ ≤ κ)
    (Y : Fin d → FiniteMeasure ℝ) (n : Fin d → ℕ)
    (x : (i : Fin d) → Fin (n i) → ℝ)
    (hY : ∀ i, (Y i).restrict (Set.Ioc (0 : ℝ) δ) = Y i)
    (hx : ∀ i a, δ < x i a ∧ x i a ≤ κ) :
    let X : Fin d → FiniteMeasure ℝ :=
      fun i => Y i + weightedEmpirical (n i) (x i)
    (∀ i, (X i).restrict (Set.Ioc (0 : ℝ) κ) = X i) ∧
      (∑ i, X i).restrict (Set.Ioc (0 : ℝ) κ) = ∑ i, X i := by
  classical
  intro X
  have hYcap (i : Fin d) : (Y i).restrict (Set.Ioc (0 : ℝ) κ) = Y i :=
    trial_restrict_eq_self_of_subset (Y i) _ _ (hY i)
      (Set.Ioc_subset_Ioc le_rfl hδκ)
  have hXcap (i : Fin d) : (X i).restrict (Set.Ioc (0 : ℝ) κ) = X i := by
    apply FiniteMeasure.toMeasure_injective
    change ((Y i : Measure ℝ) +
      (weightedEmpirical (n i) (x i) : Measure ℝ)).restrict
        (Set.Ioc (0 : ℝ) κ) = (Y i : Measure ℝ) +
          (weightedEmpirical (n i) (x i) : Measure ℝ)
    rw [Measure.restrict_add]
    have hYeq := congrArg (fun z : FiniteMeasure ℝ => (z : Measure ℝ)) (hYcap i)
    rw [FiniteMeasure.restrict_measure_eq] at hYeq
    rw [hYeq, coe_weightedEmpirical]
    congr 1
    rw [← Measure.restrictₗ_apply, map_sum]
    simp only [Measure.restrictₗ_apply]
    apply Finset.sum_congr rfl
    intro a _
    rw [Measure.restrict_smul, restrict_dirac,
      ite_eq_left (Set.mem_Ioc.mpr ⟨hδ.trans (hx i a).1, (hx i a).2⟩)]
  refine ⟨hXcap, ?_⟩
  apply FiniteMeasure.toMeasure_injective
  rw [FiniteMeasure.restrict_measure_eq, FiniteMeasure.toMeasure_sum]
  rw [← Measure.restrictₗ_apply, map_sum]
  simp only [Measure.restrictₗ_apply]
  apply Finset.sum_congr rfl
  intro i _
  simpa only [FiniteMeasure.restrict_measure_eq] using
    congrArg (fun z : FiniteMeasure ℝ => (z : Measure ℝ)) (hXcap i)

theorem trial_count_tail_of_weighted_tail {ι : Type*} [Fintype ι]
    (c : FiniteMeasure ℝ) (δ : ℝ) (hδ : 0 < δ) (x : ι → ℝ)
    (hx : ∀ k, δ < x k)
    (htail : (c : Measure ℝ).restrict (Set.Ioi δ) =
      ∑ k, ENNReal.ofReal (x k) • Measure.dirac (x k)) :
    (((c : Measure ℝ).restrict (Set.Ioi (0 : ℝ))).withDensity
      (fun p : ℝ => ENNReal.ofReal p⁻¹)).restrict (Set.Ioi δ) =
        ∑ k, Measure.dirac (x k) := by
  classical
  rw [restrict_withDensity measurableSet_Ioi,
    Measure.restrict_restrict_of_subset (Set.Ioi_subset_Ioi hδ.le), htail]
  conv_lhs => rw [← Measure.sum_fintype, withDensity_sum, Measure.sum_fintype]
  apply Finset.sum_congr rfl
  intro k _
  have hpos : 0 < x k := hδ.trans (hx k)
  rw [withDensity_smul_measure, dirac_withDensity, smul_smul,
    ← ENNReal.ofReal_mul hpos.le, mul_inv_cancel₀ hpos.ne',
    ENNReal.ofReal_one, one_smul]

theorem trial_fragmentBandMasses_sum_gap {d m : ℕ}
    (a : Fin (m + 2) → ℝ) (X : Fin d → FiniteMeasure ℝ) (j : Fin (m + 1))
    (hgap : ∀ i, fragmentBandMasses a (X i) j = 0 ∨
      a j.castSucc < fragmentBandMasses a (X i) j) :
    fragmentBandMasses a (∑ i, X i) j = 0 ∨
      a j.castSucc < fragmentBandMasses a (∑ i, X i) j := by
  classical
  by_cases hall : ∀ i, fragmentBandMasses a (X i) j = 0
  · left
    simp only [trial_fragmentBandMasses_sum, hall, Finset.sum_const_zero]
  · push Not at hall
    obtain ⟨i, hi⟩ := hall
    right
    calc
      _ < fragmentBandMasses a (X i) j := (hgap i).resolve_left hi
      _ ≤ ∑ k, fragmentBandMasses a (X k) j := by
        apply Finset.single_le_sum _ (Finset.mem_univ i)
        intro k _
        exact NNReal.coe_nonneg _
      _ = _ := (trial_fragmentBandMasses_sum a X j).symm

theorem trial_finite_tail_band_gap {m : ℕ} {ι : Type*} [Fintype ι]
    (a : Fin (m + 2) → ℝ) (ha : Monotone a)
    (c : FiniteMeasure ℝ) (δ : ℝ) (x : ι → ℝ)
    (htail : (c : Measure ℝ).restrict (Set.Ioi δ) =
      ∑ k, ENNReal.ofReal (x k) • Measure.dirac (x k))
    (hx : ∀ k, 0 ≤ x k ∧ x k ≤ a (Fin.last (m + 1)))
    (j : Fin (m + 1)) (hjδ : δ ≤ a j.castSucc) :
    fragmentBandMasses a c j = 0 ∨
      a j.castSucc < fragmentBandMasses a c j := by
  classical
  by_cases hj : fragmentBandMasses a c j = 0
  · exact Or.inl hj
  · right
    obtain ⟨k, hkleft, hkright, _⟩ :=
      trial_occupied_band_has_minimal_mark a ha c δ x htail hx j hjδ hj
    have hformula := trial_finite_tail_measureReal c δ x htail (fun l => (hx l).1)
      (Set.Ioc (a j.castSucc) (a j.succ)) measurableSet_Ioc
      (fun p hp => Set.mem_Ioi.mpr (hjδ.trans_lt (Set.mem_Ioc.mp hp).1))
    have hformula' : (c : Measure ℝ).real (Set.Ioc (a j.castSucc) (a j.succ)) =
        ∑ l, if x l ∈ Set.Ioc (a j.castSucc) (a j.succ) then x l else 0 := by
      rw [hformula]
      exact Finset.sum_congr rfl fun _ _ => ite_cond_congr rfl
    have hle : x k ≤ ∑ l, if x l ∈ Set.Ioc (a j.castSucc) (a j.succ) then x l else 0 := by
      have h := Finset.single_le_sum (s := (Finset.univ : Finset ι))
        (f := fun l => if x l ∈ Set.Ioc (a j.castSucc) (a j.succ) then x l else 0)
        (fun l _ => by split_ifs <;> first | exact (hx l).1 | exact le_rfl)
        (Finset.mem_univ k)
      simpa only [ite_eq_left (show x k ∈ Set.Ioc (a j.castSucc) (a j.succ) from
        Set.mem_Ioc.mpr ⟨hkleft, hkright⟩)] using h
    have hbound := hkleft.trans_le (hle.trans_eq hformula'.symm)
    simpa only [fragmentBandMasses, FiniteMeasure.restrict_mass,
      FiniteMeasure.coeFn_def, ENNReal.coe_toNNReal_eq_toReal, measureReal_def] using hbound

/--
The finite atomic representative placing mass `max (v j) 0` at the right endpoint `a j.succ` of
each band. Negative proposed masses are discarded by `ENNReal.ofReal`.
-/
noncomputable def trialBandRepresentative {m : ℕ}
    (a : Fin (m + 2) → ℝ) (v : Fin (m + 1) → ℝ) : FiniteMeasure ℝ := by
  classical
  let μ : Fin (m + 1) → Measure ℝ :=
    fun j => ENNReal.ofReal (v j) • Measure.dirac (a j.succ)
  letI : ∀ j, IsFiniteMeasure (μ j) :=
    fun j => Measure.smul_finite (Measure.dirac (a j.succ)) ENNReal.ofReal_ne_top
  exact ⟨∑ j, μ j, inferInstance⟩

theorem trialBandRepresentative_coe {m : ℕ}
    (a : Fin (m + 2) → ℝ) (v : Fin (m + 1) → ℝ) :
    (trialBandRepresentative a v : Measure ℝ) =
      ∑ j, ENNReal.ofReal (v j) • Measure.dirac (a j.succ) := rfl

theorem trialBandRepresentative_measurable {m : ℕ}
    (a : Fin (m + 2) → ℝ) : Measurable (trialBandRepresentative a) := by
  apply Measurable.subtype_mk
  apply Measure.measurable_of_measurable_coe
  intro A hA
  simp only [Measure.finsetSum_apply]
  apply Finset.measurable_fun_sum
  intro j _
  simp only [Measure.smul_apply, smul_eq_mul]
  exact ((measurable_pi_apply j).ennreal_ofReal).mul measurable_const

theorem trialBandRepresentative_mass {m : ℕ}
    (a : Fin (m + 2) → ℝ) (v : Fin (m + 1) → ℝ) (hv : ∀ j, 0 ≤ v j) :
    ((trialBandRepresentative a v).mass : ℝ) = ∑ j, v j := by
  classical
  change (trialBandRepresentative a v : Measure ℝ).real Set.univ = _
  simp only [measureReal_def, trialBandRepresentative_coe, Measure.finsetSum_apply,
    Measure.smul_apply, smul_eq_mul, measure_univ, mul_one]
  rw [ENNReal.toReal_sum (fun _ _ => ENNReal.ofReal_ne_top)]
  exact Finset.sum_congr rfl fun j _ => ENNReal.toReal_ofReal (hv j)

theorem trialBandRepresentative_cap_zero_iff {m : ℕ}
    (a : Fin (m + 2) → ℝ) (v : Fin (m + 1) → ℝ) (hv : ∀ j, 0 ≤ v j) (c : ℝ) :
    (trialBandRepresentative a v : Measure ℝ) (Set.Ioi c) = 0 ↔
      ∀ j : Fin (m + 1), c < a j.succ → v j = 0 := by
  classical
  have hz (j : Fin (m + 1)) : ENNReal.ofReal (v j) = 0 ↔ v j = 0 :=
    ENNReal.ofReal_eq_zero.trans
      ⟨fun h => le_antisymm h (hv j), fun h => h.le⟩
  simp [trialBandRepresentative_coe, Measure.finsetSum_apply,
    Measure.smul_apply, Measure.dirac_apply' _ measurableSet_Ioi, Set.indicator, hz]

theorem trialBandRepresentative_preserves_mass {m : ℕ}
    (a : Fin (m + 2) → ℝ) (ha : Monotone a) (c : FiniteMeasure ℝ)
    (hc : c.restrict (Set.Ioc (a 0) (a (Fin.last (m + 1)))) = c) :
    ((trialBandRepresentative a (fragmentBandMasses a c)).mass : ℝ) =
      (c.mass : ℝ) := by
  rw [trialBandRepresentative_mass a (fragmentBandMasses a c)
    (fun _ => NNReal.coe_nonneg _)]
  rw [sum_fragmentBandMasses a ha, hc]

theorem trialBandRepresentative_cap_implies_cap {m : ℕ}
    (a : Fin (m + 2) → ℝ) (c : FiniteMeasure ℝ)
    (hc : c.restrict (Set.Ioc (a 0) (a (Fin.last (m + 1)))) = c) (ζ : ℝ)
    (hcap : (trialBandRepresentative a (fragmentBandMasses a c) :
      Measure ℝ) (Set.Ioi ζ) = 0) :
    (c : Measure ℝ) (Set.Ioi ζ) = 0 := by
  apply trial_band_cap_zero_of_empty a c hc ζ
  exact (trialBandRepresentative_cap_zero_iff a (fragmentBandMasses a c)
    (fun _ => NNReal.coe_nonneg _) ζ).mp hcap

theorem trialStepFunction_eq_of_mass_and_caps
    (X Y : Fin 40 → FiniteMeasure ℝ)
    (hmass : ∀ i, (X i).mass = (Y i).mass)
    (hcaps : ∀ i (n : ℕ), n ∈ ({68225, 49152, 46580} : Finset ℕ) →
      ((X i : Measure ℝ) (Set.Ioi ((n : ℝ) * (trialMesh : ℝ))) = 0 ↔
        (Y i : Measure ℝ) (Set.Ioi ((n : ℝ) * (trialMesh : ℝ))) = 0)) :
    trialStepFunction X = trialStepFunction Y := by
  have hcell (i : Fin 40) : trialCellIndex (X i) = trialCellIndex (Y i) := by
    simp only [trialCellIndex, hmass]
  have hcap (r : ℕ) (i : Fin 40) :
      (X i : Measure ℝ) (Set.Ioi
        (((if r ≤ 89196 then 68225 else if r ≤ 95598 then 49152 else 46580 : ℕ) : ℝ) *
          (trialMesh : ℝ))) = 0 ↔
      (Y i : Measure ℝ) (Set.Ioi
        (((if r ≤ 89196 then 68225 else if r ≤ 95598 then 49152 else 46580 : ℕ) : ℝ) *
          (trialMesh : ℝ))) = 0 := by
    split_ifs <;> exact hcaps i _ (by decide)
  have houter : trialOuterMask X = trialOuterMask Y := by
    simp only [trialOuterMask, hcell, hcap]
  simp only [trialStepFunction_eq_cellExpression, houter, hcell]

theorem trialBandRepresentative_cap_fine {ι : Type*} [Fintype ι]
    (c : FiniteMeasure ℝ) (N : Measure ℝ) (δ κ A : ℝ) (hδA : δ < A)
    (x : ι → ℝ) (hx : ∀ k, 0 ≤ x k ∧ x k ≤ κ)
    (hfull : c.restrict (Set.Ioc (0 : ℝ) κ) = c)
    (htail : (c : Measure ℝ).restrict (Set.Ioi δ) =
      ∑ k, ENNReal.ofReal (x k) • Measure.dirac (x k))
    (hNtail : N.restrict (Set.Ioi δ) = ∑ k, Measure.dirac (x k))
    (hNac : N ≪ (c : Measure ℝ)) (hlevel : N {A} = 0) :
    ∃ ε : ℝ, 0 < ε ∧
      ∀ (m : ℕ) (a : Fin (m + 2) → ℝ),
        Monotone a → a 0 = 0 → a (0 : Fin (m + 1)).succ = δ →
        a (Fin.last (m + 1)) = κ →
        (∀ j : Fin (m + 1), j ≠ 0 → a j.succ - a j.castSucc < ε) →
        ((trialBandRepresentative a (fragmentBandMasses a c) :
          Measure ℝ) (Set.Ioi A) = 0 ↔ (c : Measure ℝ) (Set.Ioi A) = 0) := by
  classical
  by_cases hcap : (c : Measure ℝ) (Set.Ioi A) = 0
  · have hnobig := trial_finite_count_zero_excludes_marks N δ x hNtail (Set.Ioi A)
      (Set.Ioi_subset_Ioi hδA.le) (hNac hcap)
    have hnolevel := trial_finite_count_zero_excludes_marks N δ x hNtail {A}
      (Set.singleton_subset_iff.mpr hδA) hlevel
    have hsmall (k : ι) : x k < A := by
      have hle : x k ≤ A := le_of_not_gt (by
        simpa only [Set.mem_Ioi] using hnobig k)
      have hne : x k ≠ A := by
        simpa only [Set.mem_singleton_iff] using hnolevel k
      exact lt_of_le_of_ne hle hne
    obtain ⟨ε, hε, hfine⟩ := trial_finite_band_inward_row c δ κ A hδA.le x hx htail
      (fun _ _ => False) (fun _ => isOpen_const)
      (fun k => Or.inl (hsmall k))
    refine ⟨ε, hε, ?_⟩
    intro m a ha ha0 hseed hlast hmesh
    have hrep : (trialBandRepresentative a (fragmentBandMasses a c) :
        Measure ℝ) (Set.Ioi A) = 0 := by
      apply (trialBandRepresentative_cap_zero_iff a _
        (fun j => NNReal.coe_nonneg _) A).mpr
      intro j hj
      rcases hfine m a ha hseed hlast hmesh j with hlow | hzero | hfalse
      · exact False.elim ((not_lt_of_ge hlow) hj)
      · exact hzero
      · exact hfalse.elim
    exact ⟨fun _ => hcap, fun _ => hrep⟩
  · refine ⟨1, zero_lt_one, ?_⟩
    intro m a _ ha0 _ hlast _
    have hc : c.restrict (Set.Ioc (a 0) (a (Fin.last (m + 1)))) = c := by
      simpa only [ha0, hlast] using hfull
    constructor
    · exact trialBandRepresentative_cap_implies_cap a c hc A
    · intro h
      exact (hcap h).elim

theorem trialMasks_eq_of_mass_and_caps
    (X Y : Fin 39 → FiniteMeasure ℝ)
    (hmass : ∀ i, (X i).mass = (Y i).mass)
    (hcaps : ∀ i (n : ℕ),
      n ∈ ({68225, 44781, 35265, 44976, 35419} : Finset ℕ) →
      ((X i : Measure ℝ) (Set.Ioi ((n : ℝ) * (trialMesh : ℝ))) = 0 ↔
        (Y i : Measure ℝ) (Set.Ioi ((n : ℝ) * (trialMesh : ℝ))) = 0)) :
    trialBaseMask X = trialBaseMask Y ∧ trialEnlargedMask X = trialEnlargedMask Y ∧
      trialFullMask X = trialFullMask Y := by
  classical
  have hcell (i : Fin 39) : trialCellIndex (X i) = trialCellIndex (Y i) := by
    simp only [trialCellIndex, hmass]
  have hbase (r : ℕ) (i : Fin 39) :
      (X i : Measure ℝ) (Set.Ioi
        (((if r ≤ 84930 then 68225 else if r ≤ 87194 then 44781 else 35265 : ℕ) : ℝ) *
          (trialMesh : ℝ))) = 0 ↔
      (Y i : Measure ℝ) (Set.Ioi
        (((if r ≤ 84930 then 68225 else if r ≤ 87194 then 44781 else 35265 : ℕ) : ℝ) *
          (trialMesh : ℝ))) = 0 := by
    split_ifs <;> exact hcaps i _ (by decide)
  have hplus (r : ℕ) (i : Fin 39) :
      (X i : Measure ℝ) (Set.Ioi
        (((if r ≤ 85161 then 68225 else if r ≤ 87249 then 44976 else 35419 : ℕ) : ℝ) *
          (trialMesh : ℝ))) = 0 ↔
      (Y i : Measure ℝ) (Set.Ioi
        (((if r ≤ 85161 then 68225 else if r ≤ 87249 then 44976 else 35419 : ℕ) : ℝ) *
          (trialMesh : ℝ))) = 0 := by
    split_ifs <;> exact hcaps i _ (by decide)
  have hfull (i : Fin 39) :
      (X i : Measure ℝ) (Set.Ioi (68225 * (trialMesh : ℝ))) = 0 ↔
        (Y i : Measure ℝ) (Set.Ioi (68225 * (trialMesh : ℝ))) = 0 := by
    simpa only [Nat.cast_ofNat] using hcaps i 68225 (by decide)
  refine ⟨?_, ?_, ?_⟩
  · simp only [trialBaseMask, hcell, hbase]
  · simp only [trialEnlargedMask, hcell, hplus]
  · simp only [trialFullMask, hcell, trialLargestCap, Rat.cast_mul, Rat.cast_ofNat,
      hfull]

theorem trial_cell_sum_strict_mass {d : ℕ} (hd : 0 < d)
    (X : Fin d → FiniteMeasure ℝ) (N : ℕ)
    (hN : (∑ i, trialCellIndex (X i)) ≤ N) :
    (∑ i, ((X i).mass : ℝ)) < ((N : ℝ) + d) * (trialMesh : ℝ) := by
  classical
  let : NeZero d := ⟨hd.ne'⟩
  have hmesh : 0 < (trialMesh : ℝ) := Rat.cast_pos.mpr trial_fixed_positive_data.2.1
  have hcell (i : Fin d) : ((X i).mass : ℝ) <
      ((trialCellIndex (X i) : ℝ) + 1) * (trialMesh : ℝ) :=
    ((trialCellIndex_eq_iff (X i) (trialCellIndex (X i))).mp rfl).2
  have hsum := Finset.sum_lt_sum_of_nonempty
    (Finset.univ_nonempty : (Finset.univ : Finset (Fin d)).Nonempty)
    (fun i _ => hcell i)
  have hcast : (∑ i : Fin d, (trialCellIndex (X i) : ℝ)) ≤ N := by
    exact_mod_cast hN
  apply hsum.trans_le
  rw [← Finset.sum_mul, Finset.sum_add_distrib]
  simp only [Finset.sum_const, Finset.card_univ, Fintype.card_fin, nsmul_eq_mul, mul_one]
  exact mul_le_mul_of_nonneg_right (add_le_add hcast le_rfl) hmesh.le

theorem trial_original_strict_radial_bounds :
    (∀ X : Fin 40 → FiniteMeasure ℝ, trialStepFunction X ≠ 0 →
      (∑ i, ((X i).mass : ℝ)) < 98303 * (trialMesh : ℝ)) ∧
    (∀ Y : Fin 39 → FiniteMeasure ℝ, trialBaseMask Y = 1 →
      (∑ i, ((Y i).mass : ℝ)) < 89563 * (trialMesh : ℝ)) ∧
    (∀ Y : Fin 39 → FiniteMeasure ℝ, trialEnlargedMask Y = 1 →
      (∑ i, ((Y i).mass : ℝ)) < 89953 * (trialMesh : ℝ)) ∧
    (∀ Y : Fin 39 → FiniteMeasure ℝ, trialFullMask Y = 1 →
      (∑ i, ((Y i).mass : ℝ)) < 98302 * (trialMesh : ℝ)) := by
  refine ⟨?_, ?_, ?_, ?_⟩
  · intro X hX
    convert trial_cell_sum_strict_mass (by decide : 0 < 40) X 98263
      (trialStepFunction_support X hX).1 using 1
    norm_num
  · intro Y hY
    dsimp only [trialBaseMask] at hY
    have hr := ((Ne.ite_eq_left_iff (one_ne_zero : (1 : ℝ) ≠ 0)).mp hY).1
    convert trial_cell_sum_strict_mass (by decide : 0 < 39) Y 89524 hr using 1
    norm_num
  · intro Y hY
    dsimp only [trialEnlargedMask] at hY
    have hr := ((Ne.ite_eq_left_iff (one_ne_zero : (1 : ℝ) ≠ 0)).mp hY).1
    convert trial_cell_sum_strict_mass (by decide : 0 < 39) Y 89914 hr using 1
    norm_num
  · intro Y hY
    dsimp only [trialFullMask] at hY
    have hr := ((Ne.ite_eq_left_iff (one_ne_zero : (1 : ℝ) ≠ 0)).mp hY).1
    convert trial_cell_sum_strict_mass (by decide : 0 < 39) Y 98263 hr using 1
    norm_num

theorem trial_source_seed_below_activation
    (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)) :
    (trialMesh : ℝ) < ((physicalSourceRow ν t.val).activation : ℝ) := by
  have htwo := (physicalSource_cover_fixed_geometry.2.2 ν t).2.2.1
  have hcutoff : trialMesh < (physicalSourceRow ν t.val).activation := by
    linarith only [trial_fixed_positive_data.2.1, htwo]
  exact_mod_cast hcutoff

theorem trialPhysical_ae_finite_tail_elim_of_ae
    (δ : ℝ) (hδ : 0 < δ) (d : ℕ)
    (P Q : (Fin d → FiniteMeasure ℝ) → Prop)
    (hP : MeasurableSet {X | P X})
    (hQ : ∀ᵐ X ∂Measure.pi (fun _ : Fin d => trialPhysicalMeasure), Q X)
    (hfinite : ∀ (Y : Fin d → FiniteMeasure ℝ) (n : Fin d → ℕ)
      (x : (i : Fin d) → Fin (n i) → ℝ),
      (∀ i, (Y i).restrict (Set.Ioc (0 : ℝ) δ) = Y i) →
      (∀ i a, δ < x i a ∧ x i a ≤ (trialLargestCap : ℝ)) →
      Q (fun i => Y i + weightedEmpirical (n i) (x i)) →
      P (fun i => Y i + weightedEmpirical (n i) (x i))) :
    ∀ᵐ X ∂Measure.pi (fun _ : Fin d => trialPhysicalMeasure), P X := by
  classical
  let : IsFiniteMeasure trialPhysicalMeasure := trialPhysicalMeasure_finite_mass.1
  let κ : ℝ := trialLargestCap
  let μ := Measure.pi (fun _ : Fin d => fragmentLaw κ)
  let c := ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ)
  have hκ : 0 < κ := Rat.cast_pos.mpr trial_fixed_positive_data.2.2.1
  let : IsProbabilityMeasure (fragmentLaw κ) :=
    fragmentLaw_isProbabilityMeasure κ
  have hc : c ^ d ≠ 0 := pow_ne_zero _ ((ENNReal.ofReal_pos.mpr
    (mul_pos (Real.exp_pos _) hκ)).ne')
  have hpi : Measure.pi (fun _ : Fin d => trialPhysicalMeasure) = c ^ d • μ := by
    apply Measure.pi_eq
    intro s _
    rw [Measure.smul_apply, Measure.pi_pi]
    change c ^ d * (∏ i : Fin d, fragmentLaw κ (s i)) =
      ∏ i : Fin d, c * fragmentLaw κ (s i)
    rw [Finset.prod_mul_distrib]
    simp only [Finset.prod_const, Finset.card_univ, Fintype.card_fin]
  rw [hpi] at hQ ⊢
  have hQμ : ∀ᵐ X ∂μ, Q X := (Measure.ae_ennreal_smul_measure_iff hc).mp hQ
  let R : Set (Fin d → FiniteMeasure ℝ) := (toMeasurable μ {X | ¬ Q X})ᶜ
  have hR : MeasurableSet R := (measurableSet_toMeasurable μ _).compl
  have hRQ : ∀ X ∈ R, Q X := by
    intro X hX
    by_contra h
    exact hX (subset_toMeasurable μ {X | ¬ Q X} h)
  have hRae : ∀ᵐ X ∂μ, X ∈ R := by
    apply measure_eq_zero_iff_ae_notMem.mp
    simpa only [measure_toMeasurable] using ae_iff.mp hQμ
  have himp : ∀ᵐ X ∂μ, X ∈ R → P X := by
    apply fragmentLaw_ae_finite_tail_elim κ δ hκ hδ d
      (fun X => X ∈ R → P X)
    · convert hR.compl.union hP using 1
      ext X
      simp only [Set.mem_ofPred_eq, Set.mem_union, Set.mem_compl_iff, imp_iff_not_or]
    · intro Y n x hY hx hX
      exact hfinite Y n x hY hx (hRQ _ hX)
  apply Measure.ae_smul_measure _ (c ^ d)
  filter_upwards [hRae, himp] with X hX hXP
  exact hXP hX

theorem trial_weighted_square_l2_error {α : Type*} [MeasurableSpace α]
    (μ : Measure α) (r : ℝ) (hr : 0 < r)
    (u v w : α → ℝ) (b : ℝ) (hb : 0 ≤ b)
    (hu : MemLp u 2 μ) (hv : MemLp v 2 μ)
    (hw : AEStronglyMeasurable w μ) (hwnorm : ∀ᵐ x ∂μ, ‖w x‖ ≤ b) :
    |(∫ x, w x * u x ^ 2 ∂μ) - ∫ x, w x * v x ^ 2 ∂μ| ≤
      b * (r * (∫ x, v x ^ 2 ∂μ) + (1 + r⁻¹) * ∫ x, (u x - v x) ^ 2 ∂μ) := by
  have hsquare (s t : ℝ) :
      |s ^ 2 - t ^ 2| ≤ r * t ^ 2 + (1 + r⁻¹) * (s - t) ^ 2 := by
    have hy := two_mul_le_add_mul_sq (a := |t|) (b := |s - t|) hr
    rw [sq_abs, sq_abs] at hy
    calc
      _ = |2 * t * (s - t) + (s - t) ^ 2| := by congr 1; ring
      _ ≤ |2 * t * (s - t)| + |(s - t) ^ 2| := abs_add_le _ _
      _ = 2 * |t| * |s - t| + (s - t) ^ 2 := by
        rw [abs_mul, abs_mul, abs_of_nonneg (by norm_num : (0 : ℝ) ≤ 2),
          abs_of_nonneg (sq_nonneg (s - t))]
      _ ≤ _ := by nlinarith only [hy]
  have hwu := hu.integrable_sq.bdd_mul hw hwnorm
  have hwv := hv.integrable_sq.bdd_mul hw hwnorm
  have huv : Integrable (fun x => (u x - v x) ^ 2) μ := (hu.sub hv).integrable_sq
  have hz : Integrable (fun x => r * v x ^ 2 + (1 + r⁻¹) * (u x - v x) ^ 2) μ :=
    (hv.integrable_sq.const_mul r).fun_add (huv.const_mul (1 + r⁻¹))
  calc
    _ = |∫ x, w x * u x ^ 2 - w x * v x ^ 2 ∂μ| := by
      rw [integral_sub hwu hwv]
    _ ≤ ∫ x, |w x * u x ^ 2 - w x * v x ^ 2| ∂μ :=
      abs_integral_le_integral_abs
    _ ≤ ∫ x, b * (r * v x ^ 2 + (1 + r⁻¹) * (u x - v x) ^ 2) ∂μ := by
      apply integral_mono_ae (hwu.sub' hwv).abs (hz.const_mul b)
      filter_upwards [hwnorm] with x hx
      rw [← mul_sub, abs_mul]
      exact (mul_le_mul_of_nonneg_right
        (by simpa only [Real.norm_eq_abs] using hx) (abs_nonneg _)).trans
          (mul_le_mul_of_nonneg_left (hsquare _ _) hb)
    _ = _ := by
      rw [integral_const_mul, integral_add (hv.integrable_sq.const_mul r)
        (huv.const_mul (1 + r⁻¹)), integral_const_mul, integral_const_mul]

theorem trial_weighted_square_coefficient_error {α : Type*} [MeasurableSpace α]
    (μ : Measure α) [IsFiniteMeasure μ] (r : ℝ) (hr : 0 < r)
    (v w z e₀ e₁ : α → ℝ) (C B : ℝ) (hB : 0 ≤ B)
    (hw : Integrable (fun x => w x * v x ^ 2) μ)
    (hz : Integrable (fun x => z x * v x ^ 2) μ)
    (he₀ : Integrable (fun x => e₀ x ^ 2) μ)
    (he₁ : Integrable (fun x => e₁ x ^ 2) μ)
    (hv : ∀ x, v x ^ 2 ≤ C ^ 2)
    (hcoeff : ∀ x, |w x - z x| ≤ B * (|e₀ x| + |e₁ x|)) :
    |(∫ x, w x * v x ^ 2 ∂μ) - ∫ x, z x * v x ^ 2 ∂μ| ≤
      C ^ 2 * B * (2 * r * μ.real Set.univ +
        (1 + r⁻¹) * ((∫ x, e₀ x ^ 2 ∂μ) + ∫ x, e₁ x ^ 2 ∂μ)) := by
  have habs (s : ℝ) : |s| ≤ r + (1 + r⁻¹) * s ^ 2 := by
    have hy := two_mul_le_add_mul_sq (a := (1 : ℝ)) (b := |s|) hr
    rw [one_pow, sq_abs] at hy
    nlinarith only [hy, sq_nonneg s, abs_nonneg s]
  have hdom : Integrable (fun x =>
      2 * r + (1 + r⁻¹) * (e₀ x ^ 2 + e₁ x ^ 2)) μ :=
    (integrable_const (2 * r)).fun_add ((he₀.fun_add he₁).const_mul (1 + r⁻¹))
  calc
    _ = |∫ x, w x * v x ^ 2 - z x * v x ^ 2 ∂μ| := by rw [integral_sub hw hz]
    _ ≤ ∫ x, |w x * v x ^ 2 - z x * v x ^ 2| ∂μ :=
      abs_integral_le_integral_abs
    _ ≤ ∫ x, C ^ 2 * B * (2 * r + (1 + r⁻¹) * (e₀ x ^ 2 + e₁ x ^ 2)) ∂μ := by
      apply integral_mono (hw.sub' hz).abs (hdom.const_mul (C ^ 2 * B))
      intro x
      dsimp only
      rw [← sub_mul, abs_mul, abs_of_nonneg (sq_nonneg (v x))]
      calc
        _ ≤ (B * (|e₀ x| + |e₁ x|)) * C ^ 2 :=
          mul_le_mul (hcoeff x) (hv x) (sq_nonneg (v x))
            (mul_nonneg hB (add_nonneg (abs_nonneg _) (abs_nonneg _)))
        _ ≤ (B * ((r + (1 + r⁻¹) * e₀ x ^ 2) +
            (r + (1 + r⁻¹) * e₁ x ^ 2))) * C ^ 2 :=
          mul_le_mul_of_nonneg_right
            (mul_le_mul_of_nonneg_left (add_le_add (habs _) (habs _)) hB) (sq_nonneg C)
        _ = _ := by ring
    _ = _ := by
      rw [integral_const_mul, integral_add (integrable_const (2 * r))
        ((he₀.fun_add he₁).const_mul (1 + r⁻¹)), integral_const, integral_const_mul,
        integral_add he₀ he₁]
      simp only [smul_eq_mul]
      ring

theorem exists_trial_fine_positive_bands
    (δ κ ε : ℝ) (hδ : 0 < δ) (hδκ : δ < κ) (hε : 0 < ε) :
    ∃ (m : ℕ) (a : Fin (m + 2) → ℝ),
      StrictMono a ∧ a 0 = 0 ∧ a (0 : Fin (m + 1)).succ = δ ∧
      a (Fin.last (m + 1)) = κ ∧
      ∀ j : Fin (m + 1), j ≠ 0 → a j.succ - a j.castSucc < ε := by
  obtain ⟨N, hN⟩ := exists_nat_gt (max ((κ - δ) / ε) 0)
  have hNpos : 0 < (N : ℝ) := (le_max_right _ _).trans_lt hN
  let w : ℝ := (κ - δ) / N
  have hw : 0 < w := div_pos (sub_pos.mpr hδκ) hNpos
  have hwε : w < ε := by
    apply (div_lt_iff₀ hNpos).mpr
    have h := (div_lt_iff₀ hε).mp ((le_max_left _ _).trans_lt hN)
    simpa only [mul_comm] using h
  let b : Fin (N + 1) → ℝ := fun j => δ + w * (j : ℝ)
  let a : Fin (N + 2) → ℝ := Fin.cons 0 b
  have hbpos (j : Fin (N + 1)) : 0 < b j :=
    hδ.trans_le (le_add_of_nonneg_right
      (mul_nonneg hw.le (Nat.cast_nonneg _)))
  have hbmono : StrictMono b := by
    intro i j hij
    apply add_lt_add_right
    exact mul_lt_mul_of_pos_left (by exact_mod_cast Fin.lt_def.mp hij) hw
  refine ⟨N, a, Fin.strictMono_cons.mpr ⟨hbpos, hbmono⟩, ?_, ?_, ?_, ?_⟩
  · simp only [a, Fin.cons_zero]
  · simp only [a, Fin.cons_succ, b, Fin.val_zero, Nat.cast_zero, mul_zero, add_zero]
  · simp only [a, Fin.cons_last, b, Fin.val_last]
    dsimp only [w]
    rw [div_mul_cancel₀ _ hNpos.ne']
    ring
  · intro j hj
    obtain ⟨k, rfl⟩ := Fin.exists_succ_eq_of_ne_zero hj
    simp only [a, Fin.castSucc_succ, Fin.cons_succ, b, Fin.val_succ,
      Fin.val_castSucc, Nat.cast_add, Nat.cast_one]
    convert hwε using 1
    ring

theorem trial_signed_coefficient_control (κ t η : ℝ) :
    let P : ℝ → ℝ → ℝ := fun x y =>
      2 * x - x ^ 2 + 2 * (1 - κ) * t * (1 - x) * (y - x) -
        t ^ 2 * (y - x) ^ 2 - η * (17 / 50 : ℝ) * (1 - x) ^ 2 -
        η⁻¹ * κ * t ^ 2 * (y - x) ^ 2
    ∃ B : ℝ, 0 < B ∧
      (∀ x y : ℝ, 0 ≤ x → x ≤ 1 → 0 ≤ y → y ≤ 1 → |P x y| ≤ B) ∧
      ∀ x y x' y' : ℝ,
        0 ≤ x → x ≤ 1 → 0 ≤ y → y ≤ 1 →
        0 ≤ x' → x' ≤ 1 → 0 ≤ y' → y' ≤ 1 →
        |P x y - P x' y'| ≤ B * (|x - x'| + |y - y'|) := by
  intro P
  let Q : ℝ × ℝ → ℝ := fun z => P z.1 z.2
  let S : Set (ℝ × ℝ) := Set.Icc (0 : ℝ) 1 ×ˢ Set.Icc (0 : ℝ) 1
  have hQ : ContDiff ℝ 1 Q := by fun_prop
  have hS : IsCompact S := isCompact_Icc.prod isCompact_Icc
  have hconvex : Convex ℝ S := (convex_Icc _ _).prod (convex_Icc _ _)
  obtain ⟨K, hK⟩ := hQ.contDiffOn.exists_lipschitzOnWith (by norm_num) hconvex hS
  obtain ⟨M, hM⟩ := hS.exists_bound_of_continuousOn hQ.continuous.continuousOn
  let B : ℝ := max M ((K : ℝ) + 1)
  have hB : 0 < B := lt_max_of_lt_right (by positivity)
  have hKB : (K : ℝ) ≤ B :=
    (le_add_of_nonneg_right zero_le_one).trans (le_max_right _ _)
  refine ⟨B, hB, ?_, ?_⟩
  · intro x y hx hx1 hy hy1
    simpa only [Q, Real.norm_eq_abs] using
      (hM (x, y) ⟨⟨hx, hx1⟩, ⟨hy, hy1⟩⟩).trans (le_max_left _ _)
  · intro x y x' y' hx hx1 hy hy1 hx' hx'1 hy' hy'1
    have h := hK.dist_le_mul (x, y) ⟨⟨hx, hx1⟩, ⟨hy, hy1⟩⟩
      (x', y') ⟨⟨hx', hx'1⟩, ⟨hy', hy'1⟩⟩
    simp only [Q, Prod.dist_eq, Real.dist_eq] at h
    exact h.trans (mul_le_mul hKB
      (max_le (le_add_of_nonneg_right (abs_nonneg _))
        (le_add_of_nonneg_left (abs_nonneg _)))
      (le_max_of_le_left (abs_nonneg _)) hB.le)

theorem trial_fine_band_sequence
    (δ κ : ℝ) (hδ : 0 < δ) (hδκ : δ < κ) :
    ∃ (m : ℕ → ℕ) (a : (n : ℕ) → Fin (m n + 2) → ℝ),
      (∀ n, StrictMono (a n) ∧ a n 0 = 0 ∧
        a n (0 : Fin (m n + 1)).succ = δ ∧
        a n (Fin.last (m n + 1)) = κ) ∧
      ∀ ε : ℝ, 0 < ε →
        ∀ᶠ n : ℕ in atTop, ∀ j : Fin (m n + 1), j ≠ 0 →
          a n j.succ - a n j.castSucc < ε := by
  classical
  choose m a ha ha0 hseed hlast hmesh using
    (fun n : ℕ => exists_trial_fine_positive_bands δ κ (1 / ((n : ℝ) + 1))
      hδ hδκ (by positivity))
  refine ⟨m, a, (fun n => ⟨ha n, ha0 n, hseed n, hlast n⟩), ?_⟩
  intro ε hε
  filter_upwards [tendsto_one_div_add_atTop_nhds_zero_nat.eventually
    (gt_mem_nhds hε)] with n hn
  intro j hj
  exact (hmesh n j hj).trans hn

theorem trial_finite_band_representatives_eventually
    (κ : ℝ) (hκ : (trialLargestCap : ℝ) ≤ κ)
    (m : ℕ → ℕ) (a : (N : ℕ) → Fin (m N + 2) → ℝ)
    (hgeom : ∀ N, StrictMono (a N) ∧ a N 0 = 0 ∧
      a N (0 : Fin (m N + 1)).succ = (trialMesh : ℝ) ∧
      a N (Fin.last (m N + 1)) = κ)
    (hmesh : ∀ ε : ℝ, 0 < ε → ∀ᶠ N in atTop,
      ∀ j : Fin (m N + 1), j ≠ 0 → a N j.succ - a N j.castSucc < ε)
    (d : ℕ) (Y : Fin d → FiniteMeasure ℝ) (n : Fin d → ℕ)
    (x : (i : Fin d) → Fin (n i) → ℝ)
    (hY : ∀ i, (Y i).restrict (Set.Ioc (0 : ℝ) (trialMesh : ℝ)) = Y i)
    (hx : ∀ i k, (trialMesh : ℝ) < x i k ∧ x i k ≤ (trialLargestCap : ℝ))
    (hfixed : ∀ i (q : ℚ),
      ((Y i + weightedEmpirical (n i) (x i) : FiniteMeasure ℝ) :
        Measure ℝ) {(q : ℝ)} = 0)
    (C : Finset ℕ) (hC : ∀ k ∈ C, 1 < k) :
    let X : Fin d → FiniteMeasure ℝ :=
      fun i => Y i + weightedEmpirical (n i) (x i)
    (∀ N i, (trialBandRepresentative (a N)
      (fragmentBandMasses (a N) (X i))).mass = (X i).mass) ∧
    ∀ᶠ N in atTop, ∀ i (k : ℕ), k ∈ C →
      ((trialBandRepresentative (a N)
        (fragmentBandMasses (a N) (X i)) : Measure ℝ)
          (Set.Ioi ((k : ℝ) * (trialMesh : ℝ))) = 0 ↔
        (X i : Measure ℝ) (Set.Ioi ((k : ℝ) * (trialMesh : ℝ))) = 0) := by
  classical
  intro X
  have hδ : 0 < (trialMesh : ℝ) := by exact_mod_cast trial_fixed_positive_data.2.1
  have hδκ : (trialMesh : ℝ) ≤ κ := by
    have hlarge : (trialMesh : ℝ) ≤ (trialLargestCap : ℝ) := by
      simp only [trialLargestCap, Rat.cast_mul, Rat.cast_ofNat]
      nlinarith
    exact hlarge.trans hκ
  have hfull := (trial_finite_configuration_cap d (trialMesh : ℝ) κ hδ hδκ
    Y n x hY (fun i k => ⟨(hx i k).1, (hx i k).2.trans hκ⟩)).1
  have htail (i : Fin d) : (X i : Measure ℝ).restrict (Set.Ioi (trialMesh : ℝ)) =
      ∑ k, ENNReal.ofReal (x i k) • Measure.dirac (x i k) :=
    trial_finite_tail_coordinate_mass (trialMesh : ℝ) (Y i) (n i) (x i)
      (hY i) (fun k => (hx i k).1)
  refine ⟨?_, ?_⟩
  · intro N i
    apply NNReal.coe_injective
    apply trialBandRepresentative_preserves_mass (a N) (hgeom N).1.monotone
    simpa only [(hgeom N).2.1, (hgeom N).2.2.2] using hfull i
  · apply Filter.eventually_all.mpr
    intro i
    apply C.eventually_all.mpr
    intro k hk
    let Ni : Measure ℝ := ((X i : Measure ℝ).restrict (Set.Ioi (0 : ℝ))).withDensity
      (fun p : ℝ => ENNReal.ofReal p⁻¹)
    have hNi : Ni ≪ (X i : Measure ℝ) :=
      (withDensity_absolutelyContinuous _ _).trans Measure.absolutelyContinuous_restrict
    have hNtail : Ni.restrict (Set.Ioi (trialMesh : ℝ)) =
        ∑ j : Fin (n i), Measure.dirac (x i j) :=
      trial_count_tail_of_weighted_tail (X i) (trialMesh : ℝ) hδ (x i)
        (fun j => (hx i j).1) (htail i)
    have hδk : (trialMesh : ℝ) < (k : ℝ) * (trialMesh : ℝ) :=
      lt_mul_of_one_lt_left hδ (by exact_mod_cast hC k hk)
    have hlevel : Ni {((k : ℝ) * (trialMesh : ℝ))} = 0 := by
      apply hNi
      simpa only [Rat.cast_mul, Rat.cast_natCast] using
        hfixed i ((k : ℚ) * trialMesh)
    obtain ⟨ε, hε, hfine⟩ := trialBandRepresentative_cap_fine (X i) Ni
      (trialMesh : ℝ) κ ((k : ℝ) * (trialMesh : ℝ)) hδk (x i)
      (fun j => ⟨(hδ.trans (hx i j).1).le, (hx i j).2.trans hκ⟩)
      (hfull i) (htail i) hNtail hNi hlevel
    filter_upwards [hmesh ε hε] with N hN
    exact hfine (m N) (a N) (hgeom N).1.monotone (hgeom N).2.1
      (hgeom N).2.2.1 (hgeom N).2.2.2 hN

theorem trialPhysical_count_tail_affine_boundary_null
    (d : ℕ) (δ a b : ℝ) (hδ : 0 < δ) (ha : 0 ≤ a) :
    ∀ᵐ X ∂Measure.pi (fun _ : Fin d => trialPhysicalMeasure),
      physicalSourceCountMeasure X
        {p : ℝ | δ < p ∧
          (∑ i : Fin d, (X i : Measure ℝ)).real (Set.Ici p) + a * p = b} = 0 := by
  classical
  let : IsFiniteMeasure trialPhysicalMeasure := trialPhysicalMeasure_finite_mass.1
  let κ : ℝ := trialLargestCap
  have hκ : 0 < κ := Rat.cast_pos.mpr trial_fixed_positive_data.2.2.1
  let : IsProbabilityMeasure (fragmentLaw κ) := fragmentLaw_isProbabilityMeasure κ
  let intensity : ℤ → FiniteMeasure ℝ := cappedDyadicIntensity κ
  let ν : ℤ → Measure (ℕ × (ℕ → ℝ)) := fun k =>
    (ProbabilityTheory.poissonMeasure (intensity k).mass).prod
      (Measure.infinitePi (fun _ : ℕ => ((intensity k).normalize : Measure ℝ)))
  let : ∀ k : ℤ, IsProbabilityMeasure (ν k) := fun k => by
    dsimp only [ν]
    infer_instance
  let rawOne := Measure.infinitePi ν
  let rawLaw := Measure.infinitePi (fun u : Fin d × ℤ => ν u.2)
  let sample : (ℕ × (ℕ → ℝ)) → FiniteMeasure ℝ := fun p =>
    weightedEmpirical p.1 (fun n => p.2 n.val)
  have hsample : Measurable sample := measurable_weightedEmpirical_sample
  let f : (ℤ → ℕ × (ℕ → ℝ)) → FiniteMeasure ℝ := fun ω =>
    finiteFragments (fun k => sample (ω k))
  have hsamples : Measurable (fun ω : ℤ → ℕ × (ℕ → ℝ) => fun k => sample (ω k)) :=
    measurable_pi_lambda _ fun k => hsample.comp (measurable_pi_apply k)
  have hf : Measurable f := measurable_finiteFragments.comp hsamples
  have hsamplelaw : rawOne.map (fun ω k => sample (ω k)) =
      Measure.infinitePi (fun k => finitePoissonLaw (intensity k)) :=
    Measure.infinitePi_map_pi ν (fun _ => hsample)
  have hflaw : rawOne.map f = fragmentLaw κ := by
    change rawOne.map (finiteFragments ∘ (fun ω k => sample (ω k))) = _
    rw [← Measure.map_map measurable_finiteFragments hsamples, hsamplelaw]
    rfl
  let curry := MeasurableEquiv.curry (Fin d) ℤ (ℕ × (ℕ → ℝ))
  have hcurry : MeasurePreserving curry rawLaw
      (Measure.pi (fun _ : Fin d => rawOne)) := by
    refine ⟨curry.measurable, ?_⟩
    change (Measure.infinitePi (fun u : Fin d × ℤ => ν u.2)).map
      (MeasurableEquiv.curry (Fin d) ℤ (ℕ × (ℕ → ℝ))) =
        Measure.pi (fun _ : Fin d => Measure.infinitePi ν)
    rw [Measure.infinitePi_map_curry (fun _ : Fin d => ν), Measure.infinitePi_eq_pi]
  let F : ((Fin d × ℤ) → ℕ × (ℕ → ℝ)) → (Fin d → FiniteMeasure ℝ) :=
    fun Ω i => f (fun k => Ω (i, k))
  have hF : Measurable F := measurable_pi_lambda _ fun i =>
    hf.comp (measurable_pi_lambda _ fun k => measurable_pi_apply (i, k))
  have hfamily : Measurable
      (fun ω : Fin d → (ℤ → ℕ × (ℕ → ℝ)) => fun i => f (ω i)) :=
    measurable_pi_lambda _ fun i => hf.comp (measurable_pi_apply i)
  have hFlaw : rawLaw.map F = Measure.pi (fun _ : Fin d => fragmentLaw κ) := by
    change rawLaw.map ((fun ω i => f (ω i)) ∘ curry) = _
    rw [← Measure.map_map hfamily curry.measurable, hcurry.map_eq,
      Measure.pi_map_pi (fun _ => hf.aemeasurable)]
    simp only [hflaw]
  have hfiniteOne : ∀ᵐ ω ∂rawOne,
      IsFiniteMeasure (Measure.sum (fun k : ℤ => (sample (ω k) : Measure ℝ))) := by
    have h : ∀ᵐ ξ ∂rawOne.map (fun ω k => sample (ω k)),
        IsFiniteMeasure (Measure.sum (fun k : ℤ => (ξ k : Measure ℝ))) := by
      rw [hsamplelaw]
      exact ae_isFiniteMeasure_fragment_sum κ
    exact ae_of_ae_map hsamples.aemeasurable h
  have hfinite : ∀ᵐ Ω ∂rawLaw, ∀ i : Fin d,
      IsFiniteMeasure
        (Measure.sum (fun k : ℤ => (sample (Ω (i, k)) : Measure ℝ))) := by
    rw [ae_all_iff]
    intro i
    have heval := (measurePreserving_eval (fun _ : Fin d => rawOne) i).comp hcurry
    exact heval.quasiMeasurePreserving.ae hfiniteOne
  let μ : (Fin d → FiniteMeasure ℝ) → Measure ℝ := fun X =>
    ∑ i : Fin d, (X i : Measure ℝ)
  let B (X : Fin d → FiniteMeasure ℝ) :=
    {p : ℝ | δ < p ∧ (μ X).real (Set.Ici p) + a * p = b}
  have hμ : Measurable μ := Finset.measurable_fun_sum Finset.univ fun i _ =>
    measurable_subtype_coe.comp (measurable_pi_apply i)
  have htail : Measurable
      (fun z : (Fin d → FiniteMeasure ℝ) × ℝ => (μ z.1).real (Set.Ici z.2)) := by
    let η : ProbabilityTheory.Kernel ((Fin d → FiniteMeasure ℝ) × ℝ) ℝ :=
      ⟨fun z => μ z.1, hμ.comp measurable_fst⟩
    have hη (z : (Fin d → FiniteMeasure ℝ) × ℝ) : IsFiniteMeasure (η z) := by
      change IsFiniteMeasure (∑ i : Fin d, (z.1 i : Measure ℝ))
      infer_instance
    exact (ProbabilityTheory.Kernel.measurable_kernel_prodMk_left_of_finite
      (κ := η) (measurableSet_le measurable_fst.snd measurable_snd) hη).ennreal_toReal
  let E : Set ((Fin d → FiniteMeasure ℝ) × ℝ) :=
    {z | δ < z.2 ∧ (μ z.1).real (Set.Ici z.2) + a * z.2 = b}
  have hE : MeasurableSet E :=
    (measurableSet_lt measurable_const measurable_snd).inter
      (measurableSet_eq_fun
        (htail.add (measurable_const.mul measurable_snd)) measurable_const)
  let N : ProbabilityTheory.Kernel (Fin d → FiniteMeasure ℝ) ℝ :=
    ⟨physicalSourceCountMeasure,
      (physicalSourceCountMeasure_regular d).1⟩
  let Nδ := N.restrict (s := Set.Ioi δ) measurableSet_Ioi
  have hNδ (X : Fin d → FiniteMeasure ℝ) : IsFiniteMeasure (Nδ X) :=
    ((physicalSourceCountMeasure_regular d).2 δ hδ X).1
  have hcount := ProbabilityTheory.Kernel.measurable_kernel_prodMk_left_of_finite
    (κ := Nδ) hE hNδ
  have hcountEq (X : Fin d → FiniteMeasure ℝ) :
      Nδ X (Prod.mk X ⁻¹' E) = physicalSourceCountMeasure X (B X) :=
    Measure.restrict_eq_self _ fun p hp => hp.1
  have hcountMeas : Measurable (fun X : Fin d → FiniteMeasure ℝ =>
      physicalSourceCountMeasure X (B X)) := (funext hcountEq) ▸ hcount
  have hP : MeasurableSet {X : Fin d → FiniteMeasure ℝ |
      physicalSourceCountMeasure X (B X) = 0} :=
    measurableSet_eq_fun hcountMeas measurable_const
  have hfragment : ∀ᵐ X ∂Measure.pi (fun _ : Fin d => fragmentLaw κ),
      physicalSourceCountMeasure X (B X) = 0 := by
    rw [← hFlaw, ae_map_iff hF.aemeasurable hP]
    filter_upwards [cappedDyadicIntensity_ae_marks_mem_bands_and_affine_ne κ d a b ha, hfinite]
      with Ω hΩ hfin
    obtain ⟨S, hS, hT⟩ :=
      exists_finset_sum_finiteFragments_restrict_Ioi_eq_sum_dirac κ δ hκ hδ d Ω hΩ.1 hfin
    change (μ (F Ω)).restrict (Set.Ioi δ) =
      ∑ v ∈ S, ENNReal.ofReal ((Ω v.1).2 v.2) •
        Measure.dirac ((Ω v.1).2 v.2) at hT
    let mark (v : (Fin d × ℤ) × ℕ) := (Ω v.1).2 v.2
    have htailReal (p : ℝ) (hp : δ < p) :
        (μ (F Ω)).real (Set.Ici p) = ∑ v ∈ S.filter (fun v => p ≤ mark v), mark v := by
      have hm : μ (F Ω) (Set.Ici p) =
          ∑ v ∈ S.filter (fun v => p ≤ mark v), ENNReal.ofReal (mark v) := by
        rw [← Measure.restrict_eq_self (μ (F Ω))
          (show Set.Ici p ⊆ Set.Ioi δ from fun x hx => hp.trans_le hx),
          hT, Measure.finsetSum_apply, Finset.sum_filter]
        apply Finset.sum_congr rfl
        intro v _
        by_cases hv : p ≤ mark v <;>
          simp [Measure.smul_apply, Set.mem_Ici, mark, hv]
      change (μ (F Ω) (Set.Ici p)).toReal = _
      rw [hm, ENNReal.toReal_sum (fun _ _ => ENNReal.ofReal_ne_top)]
      apply Finset.sum_congr rfl
      intro v hv
      exact ENNReal.toReal_ofReal (hδ.trans (hS v (Finset.mem_filter.mp hv).1).2).le
    have hbad : μ (F Ω) (B (F Ω)) = 0 := by
      rw [← Measure.restrict_eq_self (μ (F Ω))
        (show B (F Ω) ⊆ Set.Ioi δ from fun p hp => hp.1), hT,
        Measure.finsetSum_apply]
      apply Finset.sum_eq_zero
      intro v hv
      have hnot : mark v ∉ B (F Ω) := by
        rintro ⟨hp, heq⟩
        let T := S.filter (fun w => mark v ≤ mark w)
        have hvT : v ∈ T := Finset.mem_filter.mpr ⟨hv, le_rfl⟩
        have hg := hΩ.2 T v hvT (hS v hv).1
        apply hg
        rw [← htailReal (mark v) hp]
        exact heq
      simp [Measure.smul_apply, Measure.dirac_apply, mark, hnot]
    exact (withDensity_absolutelyContinuous _ _)
      (Measure.absolutelyContinuous_restrict hbad)
  let c := ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ)
  have hpi : Measure.pi (fun _ : Fin d => trialPhysicalMeasure) =
      c ^ d • Measure.pi (fun _ : Fin d => fragmentLaw κ) := by
    apply Measure.pi_eq
    intro s _
    rw [Measure.smul_apply, Measure.pi_pi]
    change c ^ d * (∏ i : Fin d, fragmentLaw κ (s i)) =
      ∏ i : Fin d, c * fragmentLaw κ (s i)
    rw [Finset.prod_mul_distrib]
    simp only [Finset.prod_const, Finset.card_univ, Fintype.card_fin]
  rw [hpi]
  exact Measure.ae_smul_measure hfragment (c ^ d)

theorem trialPhysical_fixed_mark_null (b : ℝ) :
    ∀ᵐ X : FiniteMeasure ℝ ∂trialPhysicalMeasure, (X : Measure ℝ) {b} = 0 := by
  have hsingleton := measurableSet_singleton b
  have hmeas : Measurable (fun X : FiniteMeasure ℝ => (X : Measure ℝ) {b}) :=
    (Measure.measurable_coe hsingleton).comp measurable_subtype_coe
  have hzero : (∫⁻ X : FiniteMeasure ℝ, (X : Measure ℝ) {b}
      ∂fragmentLaw (trialLargestCap : ℝ)) = 0 := by
    have h := lintegral_fragmentLaw (trialLargestCap : ℝ)
      (({b} : Set ℝ).indicator (1 : ℝ → ℝ≥0∞)) (measurable_const.indicator hsingleton)
    simpa only [lintegral_indicator_one hsingleton, measure_singleton] using h
  exact Measure.ae_smul_measure ((lintegral_eq_zero_iff hmeas).mp hzero) _

theorem trialPhysical_count_fixed_mark_null (d : ℕ) (b : ℝ) :
    ∀ᵐ X ∂Measure.pi (fun _ : Fin d => trialPhysicalMeasure),
      physicalSourceCountMeasure X {b} = 0 := by
  let : IsFiniteMeasure trialPhysicalMeasure := trialPhysicalMeasure_finite_mass.1
  have hall : ∀ᵐ X ∂Measure.pi (fun _ : Fin d => trialPhysicalMeasure),
      ∀ i : Fin d, (X i : Measure ℝ) {b} = 0 := by
    rw [ae_all_iff]
    intro i
    exact (Measure.tendsto_eval_ae_ae
      (μ := fun _ : Fin d => trialPhysicalMeasure) (i := i)).eventually
        (trialPhysical_fixed_mark_null b)
  filter_upwards [hall] with X hX
  have hsum : (∑ i : Fin d, (X i : Measure ℝ)) {b} = 0 := by
    simp only [Measure.finsetSum_apply, hX, Finset.sum_const_zero]
  exact (withDensity_absolutelyContinuous _ _)
    (Measure.absolutelyContinuous_restrict hsum)

theorem trialPhysical_total_mass_ne (d : ℕ) (b : ℝ) :
    ∀ᵐ X ∂Measure.pi (fun _ : Fin (d + 1) => trialPhysicalMeasure),
      (∑ i : Fin (d + 1), ((X i).mass : ℝ)) ≠ b := by
  classical
  let : IsFiniteMeasure trialPhysicalMeasure := trialPhysicalMeasure_finite_mass.1
  have hm : Measurable (fun X : FiniteMeasure ℝ => (X.mass : ℝ)) :=
    ((Measure.measurable_coe MeasurableSet.univ).comp measurable_subtype_coe).ennreal_toReal
  have hsingle (c : ℝ) : ∀ᵐ X ∂trialPhysicalMeasure, (X.mass : ℝ) ≠ c :=
    ae_of_ae_map hm.aemeasurable
      ((ae_mono trialPhysicalMeasure_mass_map.2)
        (Measure.ae_ne (volume.restrict (Set.Ici (0 : ℝ))) c))
  let μ := Measure.pi (fun _ : Fin (d + 1) => trialPhysicalMeasure)
  let ν := Measure.pi (fun _ : Fin d => trialPhysicalMeasure)
  let ins : (FiniteMeasure ℝ × (Fin d → FiniteMeasure ℝ)) ≃ᵐ
      (Fin (d + 1) → FiniteMeasure ℝ) :=
    (MeasurableEquiv.piFinSuccAbove
      (fun _ : Fin (d + 1) => FiniteMeasure ℝ) 0).symm
  have hins : MeasurePreserving ins (trialPhysicalMeasure.prod ν) μ :=
    (measurePreserving_piFinSuccAbove
      (fun _ : Fin (d + 1) => trialPhysicalMeasure) 0).symm
  have hP : MeasurableSet {X : Fin (d + 1) → FiniteMeasure ℝ |
      (∑ i : Fin (d + 1), ((X i).mass : ℝ)) ≠ b} :=
    (measurableSet_eq_fun
      (Finset.measurable_sum Finset.univ fun i _ =>
        hm.comp (measurable_pi_apply i)) measurable_const).compl
  change ∀ᵐ X ∂μ, (∑ i : Fin (d + 1), ((X i).mass : ℝ)) ≠ b
  rw [← hins.map_eq, ae_map_iff ins.measurable.aemeasurable hP]
  have hpair := hP.preimage ins.measurable
  rw [Set.preimage_ofPred_eq] at hpair
  apply (Measure.ae_prod_iff_ae_ae hpair).2
  apply (Measure.ae_ae_comm
    (p := fun X Y => (∑ i : Fin (d + 1), ((ins (X, Y) i).mass : ℝ)) ≠ b)
    hpair).2
  filter_upwards [] with Y
  filter_upwards [hsingle (b - ∑ i : Fin d, ((Y i).mass : ℝ))] with X hX
  intro h
  apply hX
  rw [Fin.sum_univ_succAbove _ (0 : Fin (d + 1))] at h
  simp only [ins, MeasurableEquiv.piFinSuccAbove_symm_apply, Fin.insertNthEquiv,
    Equiv.coe_fn_mk, Fin.insertNth_apply_same, Fin.insertNth_apply_succAbove] at h
  linarith only [h]

theorem physicalSourceOuterSupport_row_ae_strict
    (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)) :
    let R := physicalSourceRow ν t.val
    let L : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
    ∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure),
      physicalSourceOuterSupport X = 1 →
      let μ : Measure ℝ := ∑ i : Fin 40, (X i : Measure ℝ)
      let s : ℝ := ∑ i : Fin 40, ((X i).mass : ℝ)
      let N := physicalSourceCountMeasure X
      s < (R.outerCore : ℝ) ∨
        N {p : ℝ | (R.activation : ℝ) < p ∧
          (if R.order ≤ 2 then ¬ (μ.real (Set.Ici p) + p < (R.outerThreshold : ℝ))
          else ¬ (μ.real (Set.Ici p) + min ((3 / 2) * p) L < (R.outerThreshold : ℝ) ∧
            3 * p - min ((3 / 2) * p) L < (R.innerThreshold : ℝ)))} = 0 := by
  classical
  intro R L
  have hactivation : 0 < (R.activation : ℝ) :=
    (Rat.cast_pos.mpr trial_fixed_positive_data.2.1).trans
      (trial_source_seed_below_activation ν t)
  filter_upwards [
    trialPhysical_total_mass_ne 39 (R.outerCore : ℝ),
    trialPhysical_count_tail_affine_boundary_null 40 (R.activation : ℝ) 1
      (R.outerThreshold : ℝ) hactivation (by norm_num),
    trialPhysical_count_tail_affine_boundary_null 40 (R.activation : ℝ) (3 / 2)
      (R.outerThreshold : ℝ) hactivation (by norm_num),
    trialPhysical_count_tail_affine_boundary_null 40 (R.activation : ℝ) 0
      ((R.outerThreshold : ℝ) - L) hactivation (by norm_num),
    trialPhysical_count_fixed_mark_null 40 ((R.innerThreshold : ℝ) / (3 / 2)),
    trialPhysical_count_fixed_mark_null 40 (((R.innerThreshold : ℝ) + L) / 3)]
      with X hcore hbase hleft hright hψleft hψright hmask
  intro μ s N
  unfold physicalSourceOuterSupport at hmask
  have hsource := (Ne.ite_eq_left_iff (one_ne_zero : (1 : ℝ) ≠ 0)).mp hmask
  rcases hsource.2.2 ν t with hcorele | hbad
  · exact Or.inl (lt_of_le_of_ne hcorele hcore)
  · refine Or.inr ?_
    change N {p : ℝ | (R.activation : ℝ) < p ∧
      (if R.order ≤ 2 then (R.outerThreshold : ℝ) < μ.real (Set.Ici p) + p
      else (R.outerThreshold : ℝ) < μ.real (Set.Ici p) + min ((3 / 2) * p) L ∨
        (R.innerThreshold : ℝ) < 3 * p - min ((3 / 2) * p) L)} = 0 at hbad
    by_cases horder : R.order ≤ 2
    · simp only [ite_eq_left horder] at hbad ⊢
      have heq : N {p : ℝ | (R.activation : ℝ) < p ∧
          μ.real (Set.Ici p) + p = (R.outerThreshold : ℝ)} = 0 := by
        simpa only [one_mul] using hbase
      apply measure_mono_null _ (measure_union_null hbad heq)
      intro p hp
      by_cases hgt : (R.outerThreshold : ℝ) < μ.real (Set.Ici p) + p
      · exact Or.inl ⟨hp.1, hgt⟩
      · exact Or.inr ⟨hp.1,
          le_antisymm (le_of_not_gt hgt) (le_of_not_gt hp.2)⟩
    · simp only [ite_eq_right horder] at hbad ⊢
      apply measure_mono_null _
        (measure_union_null hbad (measure_union_null hleft
          (measure_union_null hright (measure_union_null hψleft hψright))))
      intro p hp
      by_cases hgt :
          (R.outerThreshold : ℝ) < μ.real (Set.Ici p) + min ((3 / 2) * p) L ∨
            (R.innerThreshold : ℝ) < 3 * p - min ((3 / 2) * p) L
      · exact Or.inl ⟨hp.1, hgt⟩
      · have hle := not_or.mp hgt
        rcases not_and_or.mp hp.2 with hfirst | hsecond
        · have heq : μ.real (Set.Ici p) + min ((3 / 2) * p) L =
              (R.outerThreshold : ℝ) :=
            le_antisymm (le_of_not_gt hle.1) (le_of_not_gt hfirst)
          by_cases hmin : (3 / 2 : ℝ) * p ≤ L
          · exact Or.inr (Or.inl ⟨hp.1, by
              simpa only [min_eq_left hmin] using heq⟩)
          · refine Or.inr (Or.inr (Or.inl ⟨hp.1, ?_⟩))
            rw [min_eq_right (lt_of_not_ge hmin).le] at heq
            simp only [zero_mul, add_zero]
            linarith only [heq]
        · have heq : 3 * p - min ((3 / 2) * p) L = (R.innerThreshold : ℝ) :=
            le_antisymm (le_of_not_gt hle.2) (le_of_not_gt hsecond)
          by_cases hmin : (3 / 2 : ℝ) * p ≤ L
          · refine Or.inr (Or.inr (Or.inr (Or.inl ?_)))
            apply (eq_div_iff (by norm_num : (3 / 2 : ℝ) ≠ 0)).2
            rw [min_eq_left hmin] at heq
            linarith only [heq]
          · refine Or.inr (Or.inr (Or.inr (Or.inr ?_)))
            apply (eq_div_iff (by norm_num : (3 : ℝ) ≠ 0)).2
            rw [min_eq_right (lt_of_not_ge hmin).le] at heq
            linarith only [heq]

theorem physicalSourceInnerSupport_row_ae_strict
    (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)) :
    let R := physicalSourceRow ν t.val
    let L : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
    ∀ᵐ X ∂Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure),
      physicalSourceInnerSupport ν X = 1 →
      let μ : Measure ℝ := ∑ i : Fin 39, (X i : Measure ℝ)
      let s : ℝ := ∑ i : Fin 39, ((X i).mass : ℝ)
      let N := physicalSourceCountMeasure X
      R.order = 1 ∨ s < (R.innerCore : ℝ) ∨
        N {p : ℝ | (R.activation : ℝ) < p ∧
          (if R.order ≤ 2 then ¬ (μ.real (Set.Ici p) + p < (R.innerThreshold : ℝ))
          else ¬ (μ.real (Set.Ici p) + (3 * p - min ((3 / 2) * p) L) <
              (R.innerThreshold : ℝ) ∧
            (min ((3 / 2) * p) L < (R.outerThreshold : ℝ) ∨
              L ≤ (R.outerThreshold : ℝ))))} = 0 := by
  classical
  intro R L
  have hactivation : 0 < (R.activation : ℝ) :=
    (Rat.cast_pos.mpr trial_fixed_positive_data.2.1).trans
      (trial_source_seed_below_activation ν t)
  filter_upwards [
    trialPhysical_total_mass_ne 38 (R.innerCore : ℝ),
    trialPhysical_count_tail_affine_boundary_null 39 (R.activation : ℝ) 1
      (R.innerThreshold : ℝ) hactivation (by norm_num),
    trialPhysical_count_tail_affine_boundary_null 39 (R.activation : ℝ) (3 / 2)
      (R.innerThreshold : ℝ) hactivation (by norm_num),
    trialPhysical_count_tail_affine_boundary_null 39 (R.activation : ℝ) 3
      ((R.innerThreshold : ℝ) + L) hactivation (by norm_num),
    trialPhysical_count_fixed_mark_null 39 ((R.outerThreshold : ℝ) / (3 / 2))]
      with X hcore hbase hleft hright hφ hmask
  intro μ s N
  unfold physicalSourceInnerSupport at hmask
  have hsource := (Ne.ite_eq_left_iff (one_ne_zero : (1 : ℝ) ≠ 0)).mp hmask
  rcases hsource.2.2 t with horderOne | hcorele | hbad
  · exact Or.inl horderOne
  · exact Or.inr (Or.inl (lt_of_le_of_ne hcorele hcore))
  · refine Or.inr (Or.inr ?_)
    change N {p : ℝ | (R.activation : ℝ) < p ∧
      (if R.order ≤ 2 then (R.innerThreshold : ℝ) < μ.real (Set.Ici p) + p
      else (R.innerThreshold : ℝ) <
          μ.real (Set.Ici p) + (3 * p - min ((3 / 2) * p) L) ∨
        (R.outerThreshold : ℝ) < min ((3 / 2) * p) L)} = 0 at hbad
    by_cases horder : R.order ≤ 2
    · simp only [ite_eq_left horder] at hbad ⊢
      have heq : N {p : ℝ | (R.activation : ℝ) < p ∧
          μ.real (Set.Ici p) + p = (R.innerThreshold : ℝ)} = 0 := by
        simpa only [one_mul] using hbase
      apply measure_mono_null _ (measure_union_null hbad heq)
      intro p hp
      by_cases hgt : (R.innerThreshold : ℝ) < μ.real (Set.Ici p) + p
      · exact Or.inl ⟨hp.1, hgt⟩
      · exact Or.inr ⟨hp.1,
          le_antisymm (le_of_not_gt hgt) (le_of_not_gt hp.2)⟩
    · simp only [ite_eq_right horder] at hbad ⊢
      apply measure_mono_null _
        (measure_union_null hbad (measure_union_null hleft (measure_union_null hright hφ)))
      intro p hp
      by_cases hgt :
          (R.innerThreshold : ℝ) < μ.real (Set.Ici p) + (3 * p - min ((3 / 2) * p) L) ∨
            (R.outerThreshold : ℝ) < min ((3 / 2) * p) L
      · exact Or.inl ⟨hp.1, hgt⟩
      · have hle := not_or.mp hgt
        rcases not_and_or.mp hp.2 with hfirst | hsecond
        · have heq : μ.real (Set.Ici p) + (3 * p - min ((3 / 2) * p) L) =
              (R.innerThreshold : ℝ) :=
            le_antisymm (le_of_not_gt hle.1) (le_of_not_gt hfirst)
          by_cases hmin : (3 / 2 : ℝ) * p ≤ L
          · refine Or.inr (Or.inl ⟨hp.1, ?_⟩)
            rw [min_eq_left hmin] at heq
            linarith only [heq]
          · refine Or.inr (Or.inr (Or.inl ⟨hp.1, ?_⟩))
            rw [min_eq_right (lt_of_not_ge hmin).le] at heq
            linarith only [heq]
        · have hnot := not_or.mp hsecond
          have heq : min ((3 / 2) * p) L = (R.outerThreshold : ℝ) :=
            le_antisymm (le_of_not_gt hle.2) (le_of_not_gt hnot.1)
          have hmin : (3 / 2 : ℝ) * p ≤ L := by
            by_contra hmin
            rw [min_eq_right (lt_of_not_ge hmin).le] at heq
            exact hnot.2 heq.le
          refine Or.inr (Or.inr (Or.inr ?_))
          apply (eq_div_iff (by norm_num : (3 / 2 : ℝ) ≠ 0)).2
          rw [min_eq_left hmin] at heq
          linarith only [heq]

theorem trial_source_outer_band_exhaustion
    (κ : ℝ) (hκ : (trialLargestCap : ℝ) ≤ κ)
    (m : ℕ → ℕ) (a : (N : ℕ) → Fin (m N + 2) → ℝ)
    (hgeom : ∀ N, StrictMono (a N) ∧ a N 0 = 0 ∧
      a N (0 : Fin (m N + 1)).succ = (trialMesh : ℝ) ∧
      a N (Fin.last (m N + 1)) = κ)
    (hmesh : ∀ ε : ℝ, 0 < ε → ∀ᶠ N in atTop,
      ∀ j : Fin (m N + 1), j ≠ 0 → a N j.succ - a N j.castSucc < ε) :
    ∃ U : (N : ℕ) → Set (Fin 40 → Fin (m N + 1) → ℝ),
      (∀ N, IsOpen (U N)) ∧
      (∀ N (X : Fin 40 → FiniteMeasure ℝ),
        (∑ i, X i).restrict (Set.Ioc (0 : ℝ) κ) = ∑ i, X i →
        (∀ j : Fin (m N + 1), 0 < a N j.castSucc →
          fragmentBandMasses (a N) (∑ i, X i) j = 0 ∨
            a N j.castSucc < fragmentBandMasses (a N) (∑ i, X i) j) →
        (fun i => fragmentBandMasses (a N) (X i)) ∈ U N →
        physicalSourceOuterSupport X = 1 ∧
          (∑ i, ((X i).mass : ℝ)) < 98303 * (trialMesh : ℝ) ∧
          ∀ i, (X i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0) ∧
      Tendsto (fun N => ∫ X : Fin 40 → FiniteMeasure ℝ,
        ((U N).indicator (fun v => trialStepFunction
          (fun i => trialBandRepresentative (a N) (v i)))
            (fun i => fragmentBandMasses (a N) (X i)) -
          trialSourceStepFunction X) ^ 2
        ∂Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)) atTop (𝓝 0) := by
  classical
  let : IsFiniteMeasure trialPhysicalMeasure := trialPhysicalMeasure_finite_mass.1
  let μ := Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)
  let b (N : ℕ) (v : Fin 40 → Fin (m N + 1) → ℝ) (j : Fin (m N + 1)) :=
    ∑ i, v i j
  let total (N : ℕ) (v : Fin 40 → Fin (m N + 1) → ℝ) := ∑ i, ∑ j, v i j
  let tail (N : ℕ) (v : Fin 40 → Fin (m N + 1) → ℝ) (j : Fin (m N + 1)) :=
    ∑ k ∈ (Finset.univ : Finset (Fin (m N + 1))).filter (fun k => j ≤ k), b N v k
  let O (N : ℕ) : Set (Fin 40 → Fin (m N + 1) → ℝ) := {v |
    total N v < (physicalSourceOuterRadius : ℝ) ∧
    (∀ j : Fin (m N + 1),
      (((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ) < a N j.succ →
        b N v j < a N j.castSucc) ∧
    ∀ (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)),
      let R := physicalSourceRow ν t.val
      total N v < (R.outerCore : ℝ) ∨
        ∀ j : Fin (m N + 1),
          a N j.succ ≤ (R.activation : ℝ) ∨ b N v j < a N j.castSucc ∨
            (if R.order ≤ 2 then tail N v j + a N j.succ < (R.outerThreshold : ℝ)
            else tail N v j + min ((3 / 2) * a N j.succ)
                ((23 / 40) * (R.innerThreshold : ℝ)) < (R.outerThreshold : ℝ) ∧
              3 * a N j.succ - min ((3 / 2) * a N j.succ)
                ((23 / 40) * (R.innerThreshold : ℝ)) < (R.innerThreshold : ℝ))}
  let V (N : ℕ) : Set (Fin 40 → Fin (m N + 1) → ℝ) := {v |
    ∀ j : Fin (m N + 1), (trialLargestCap : ℝ) < a N j.succ →
      b N v j < a N j.castSucc}
  let U (N : ℕ) := O N ∩ (V N ∩ {v | total N v < 98303 * (trialMesh : ℝ)})
  let B (N : ℕ) (X : Fin 40 → FiniteMeasure ℝ) :=
    fun i => fragmentBandMasses (a N) (X i)
  let f (N : ℕ) := (U N).indicator
    (fun v => trialStepFunction (fun i => trialBandRepresentative (a N) (v i)))
  have hδ : 0 < (trialMesh : ℝ) := Rat.cast_pos.mpr trial_fixed_positive_data.2.1
  have hδlarge : (trialMesh : ℝ) ≤ (trialLargestCap : ℝ) := by
    simp only [trialLargestCap, Rat.cast_mul, Rat.cast_ofNat]
    nlinarith
  have hlargeζ : (trialLargestCap : ℝ) <
      (((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ) := by
    norm_num [trialLargestCap, trialMesh, physicalSourceRho]
  have hseedζ (N : ℕ) : a N (0 : Fin (m N + 1)).succ ≤
      (((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ) := by
    rw [(hgeom N).2.2.1]
    exact hδlarge.trans hlargeζ.le
  have hseedrow (N : ℕ) (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)) :
      a N (0 : Fin (m N + 1)).succ ≤ ((physicalSourceRow ν t.val).activation : ℝ) := by
    rw [(hgeom N).2.2.1]
    exact (trial_source_seed_below_activation ν t).le
  have hO (N : ℕ) := physicalSourceOuter_inward_band_domain (a N) (hgeom N).1
    (hgeom N).2.1 (hseedζ N) (hseedrow N)
  have hV (N : ℕ) := trial_inward_band_cap_domain (d := 40) (a N) (hgeom N).1
    (hgeom N).2.1 (trialLargestCap : ℝ) (by
      rw [(hgeom N).2.2.1]
      exact hδlarge)
  have hopen (N : ℕ) : IsOpen (U N) :=
    (hO N).1.inter ((hV N).1.inter
      (isOpen_lt (show Continuous (total N) by fun_prop) continuous_const))
  have hvalid (N : ℕ) (X : Fin 40 → FiniteMeasure ℝ)
      (hfull : (∑ i, X i).restrict (Set.Ioc (0 : ℝ) κ) = ∑ i, X i)
      (hgap : ∀ j : Fin (m N + 1), 0 < a N j.castSucc →
        fragmentBandMasses (a N) (∑ i, X i) j = 0 ∨
          a N j.castSucc < fragmentBandMasses (a N) (∑ i, X i) j)
      (hU : B N X ∈ U N) :
      physicalSourceOuterSupport X = 1 ∧
        (∑ i, ((X i).mass : ℝ)) < 98303 * (trialMesh : ℝ) ∧
        ∀ i, (X i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0 := by
    have hfull' : (∑ i, X i).restrict
        (Set.Ioc (a N 0) (a N (Fin.last (m N + 1)))) = ∑ i, X i := by
      simpa only [(hgeom N).2.1, (hgeom N).2.2.2] using hfull
    refine ⟨((hO N).2 X hfull' hgap hU.1).1, ?_,
      (hV N).2 X hfull' hgap hU.2.1⟩
    simpa only [Set.mem_ofPred_eq, total, B,
      trial_band_total_sum (a N) (hgeom N).1.monotone X hfull']
      using hU.2.2
  have hBm (N : ℕ) : Measurable (B N) := measurable_pi_lambda _ fun i =>
    (measurable_fragmentBandMasses (a N)).comp
      (measurable_pi_apply i)
  have hfm (N : ℕ) : Measurable (f N) := by
    apply Measurable.indicator _ (hopen N).measurableSet
    exact trial_data_measurable.2.2.2.2.2.1.comp
      (measurable_pi_lambda _ fun i =>
        (trialBandRepresentative_measurable (a N)).comp (measurable_pi_apply i))
  have hP : MeasurableSet {X : Fin 40 → FiniteMeasure ℝ |
      ∀ᶠ N in atTop, f N (B N X) = trialSourceStepFunction X} := by
    simp only [Filter.eventually_atTop, Set.ofPred_exists, Set.ofPred_forall]
    exact MeasurableSet.iUnion fun _ => MeasurableSet.iInter fun M =>
      MeasurableSet.iInter fun _ => measurableSet_eq_fun ((hfm M).comp (hBm M))
        trialSource_projection_regular.1
  have hcount : ∀ᵐ X ∂μ, ∀ q : ℚ, physicalSourceCountMeasure X {(q : ℝ)} = 0 := by
    simpa only [ae_all_iff] using fun q : ℚ => trialPhysical_count_fixed_mark_null 40 (q : ℝ)
  have hfixed : ∀ᵐ X ∂μ, ∀ i (q : ℚ), (X i : Measure ℝ) {(q : ℝ)} = 0 := by
    simp only [ae_all_iff]
    intro i q
    exact (Measure.tendsto_eval_ae_ae
      (μ := fun _ : Fin 40 => trialPhysicalMeasure) (i := i)).eventually
        (trialPhysical_fixed_mark_null (q : ℝ))
  have hrows : ∀ᵐ X ∂μ, ∀ (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)),
      physicalSourceOuterSupport X = 1 →
        let R := physicalSourceRow ν t.val
        let c : Measure ℝ := ∑ i : Fin 40, (X i : Measure ℝ)
        (∑ i, ((X i).mass : ℝ)) < (R.outerCore : ℝ) ∨
          physicalSourceCountMeasure X {p : ℝ | (R.activation : ℝ) < p ∧
            (if R.order ≤ 2 then ¬ (c.real (Set.Ici p) + p < (R.outerThreshold : ℝ))
            else ¬ (c.real (Set.Ici p) + min ((3 / 2) * p)
                ((23 / 40) * (R.innerThreshold : ℝ)) < (R.outerThreshold : ℝ) ∧
              3 * p - min ((3 / 2) * p) ((23 / 40) * (R.innerThreshold : ℝ)) <
                (R.innerThreshold : ℝ)))} = 0 := by
    simpa only [ae_all_iff] using fun ν t => physicalSourceOuterSupport_row_ae_strict ν t
  have hevent : ∀ᵐ X ∂μ, ∀ᶠ N in atTop, f N (B N X) = trialSourceStepFunction X := by
    refine trialPhysical_ae_finite_tail_elim_of_ae (trialMesh : ℝ) hδ 40
      (fun X => ∀ᶠ N in atTop, f N (B N X) = trialSourceStepFunction X) _ hP
      (hcount.and (hfixed.and hrows)) ?_
    · intro Y n x hY hx hQ
      let X : Fin 40 → FiniteMeasure ℝ :=
        fun i => Y i + weightedEmpirical (n i) (x i)
      change ∀ᶠ N in atTop, f N (B N X) = trialSourceStepFunction X
      let c : FiniteMeasure ℝ := ∑ i, X i
      let z : ((i : Fin 40) × Fin (n i)) → ℝ := fun k => x k.1 k.2
      have htail := trial_finite_tail_mass_and_count 40 (trialMesh : ℝ) hδ Y n x hY
        (fun i k => (hx i k).1)
      have hfullκ := trial_finite_configuration_cap 40 (trialMesh : ℝ) κ hδ
        (hδlarge.trans hκ) Y n x hY (fun i k => ⟨(hx i k).1, (hx i k).2.trans hκ⟩)
      have hfullL := trial_finite_configuration_cap 40 (trialMesh : ℝ)
        (trialLargestCap : ℝ) hδ hδlarge Y n x hY hx
      have hcapL (i : Fin 40) : (X i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0 := by
        have hi := congrArg (fun Z : FiniteMeasure ℝ => (Z : Measure ℝ)) (hfullL.1 i)
        rw [FiniteMeasure.restrict_measure_eq] at hi
        rw [← hi, Measure.restrict_apply measurableSet_Ioi,
          Set.disjoint_iff_inter_eq_empty.mp Set.Ioc_disjoint_Ioi_same.symm, measure_empty]
      have hgap (N : ℕ) (j : Fin (m N + 1)) (hj : 0 < a N j.castSucc) :
          fragmentBandMasses (a N) c j = 0 ∨
            a N j.castSucc < fragmentBandMasses (a N) c j := by
        have hj0 : j ≠ 0 := by
          rintro rfl
          simp only [Fin.castSucc_zero, (hgeom N).2.1, lt_self_iff_false] at hj
        have hδj : (trialMesh : ℝ) ≤ a N j.castSucc := by
          rw [← (hgeom N).2.2.1]
          exact (hgeom N).1.monotone
            (Fin.succ_le_castSucc_iff.mpr (Fin.pos_iff_ne_zero.mpr hj0))
        apply trial_finite_tail_band_gap (a N) (hgeom N).1.monotone c (trialMesh : ℝ)
          z htail.1 _ j hδj
        intro k
        exact ⟨(hδ.trans (hx k.1 k.2).1).le,
          (by simpa only [(hgeom N).2.2.2] using (hx k.1 k.2).2.trans hκ)⟩
      have htotal (N : ℕ) : total N (B N X) = ∑ i, ((X i).mass : ℝ) := by
        apply trial_band_total_sum (a N) (hgeom N).1.monotone
        simpa only [(hgeom N).2.1, (hgeom N).2.2.2] using hfullκ.2
      obtain ⟨hmass, hcaps⟩ := trial_finite_band_representatives_eventually κ hκ m a
        hgeom hmesh 40 Y n x hY hx hQ.2.1 {68225, 49152, 46580}
        (by intro k hk; simp only [Finset.mem_insert, Finset.mem_singleton] at hk
            rcases hk with rfl | rfl | rfl <;> norm_num)
      have hrep : ∀ᶠ N in atTop,
          trialStepFunction (fun i => trialBandRepresentative (a N) (B N X i)) =
            trialStepFunction X := by
        filter_upwards [hcaps] with N hN
        exact trialStepFunction_eq_of_mass_and_caps _ X (hmass N) hN
      have hzero : ∀ᶠ N in atTop, ∀ j : Fin (m N + 1),
          (trialLargestCap : ℝ) < a N j.succ → b N (B N X) j = 0 := by
        filter_upwards [hcaps] with N hN j hj
        apply Finset.sum_eq_zero
        intro i _
        have hcap : (trialBandRepresentative (a N) (B N X i) : Measure ℝ)
            (Set.Ioi (trialLargestCap : ℝ)) = 0 := by
          have hc := (hN i 68225 (by decide)).2 (by
            simpa only [trialLargestCap, Rat.cast_mul, Rat.cast_ofNat, Nat.cast_ofNat, X]
              using hcapL i)
          simpa only [trialLargestCap, Rat.cast_mul, Rat.cast_ofNat, Nat.cast_ofNat, B, X]
            using hc
        exact (trialBandRepresentative_cap_zero_iff (a N) _
          (fun l => NNReal.coe_nonneg _) (trialLargestCap : ℝ)).mp hcap j hj
      by_cases hstep : trialStepFunction X = 0
      · filter_upwards [hrep] with N hN
        simp only [f, Set.indicator_apply, hN, hstep, ite_self,
          trialSourceStepFunction, mul_zero]
      by_cases hsource : physicalSourceOuterSupport X = 1
      · have hradius := trial_original_strict_radial_bounds.1 X hstep
        have hrowevent : ∀ᶠ N in atTop,
            ∀ (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)),
              let R := physicalSourceRow ν t.val
              total N (B N X) < (R.outerCore : ℝ) ∨
                ∀ j : Fin (m N + 1),
                  a N j.succ ≤ (R.activation : ℝ) ∨ b N (B N X) j < a N j.castSucc ∨
                    (if R.order ≤ 2 then tail N (B N X) j + a N j.succ < (R.outerThreshold : ℝ)
                    else tail N (B N X) j + min ((3 / 2) * a N j.succ)
                        ((23 / 40) * (R.innerThreshold : ℝ)) < (R.outerThreshold : ℝ) ∧
                      3 * a N j.succ - min ((3 / 2) * a N j.succ)
                        ((23 / 40) * (R.innerThreshold : ℝ)) < (R.innerThreshold : ℝ)) := by
          simp only [Filter.eventually_all]
          intro ν t
          let R := physicalSourceRow ν t.val
          let G : ℝ → ℝ → Prop := fun u p =>
            if R.order ≤ 2 then u + p < (R.outerThreshold : ℝ)
            else u + min ((3 / 2) * p) ((23 / 40) * (R.innerThreshold : ℝ)) <
                (R.outerThreshold : ℝ) ∧
              3 * p - min ((3 / 2) * p) ((23 / 40) * (R.innerThreshold : ℝ)) <
                (R.innerThreshold : ℝ)
          rcases hQ.2.2 ν t hsource with hcore | hbad
          · exact Filter.Eventually.of_forall fun N => Or.inl (by
              simpa only [htotal] using hcore)
          have hGopen (u : ℝ) : IsOpen {p : ℝ | G u p} := by
            dsimp only [G]
            split_ifs
            · exact isOpen_lt (by fun_prop) continuous_const
            · exact (isOpen_lt (continuous_const.add
                ((continuous_const.mul continuous_id).min continuous_const)) continuous_const).inter
                (isOpen_lt ((continuous_const.mul continuous_id).sub
                  ((continuous_const.mul continuous_id).min continuous_const)) continuous_const)
          have hbadG : physicalSourceCountMeasure X
              {p : ℝ | (R.activation : ℝ) < p ∧ ¬ G ((c : Measure ℝ).real (Set.Ici p)) p} = 0 := by
            simpa only [G, apply_ite Not, c, FiniteMeasure.toMeasure_sum] using hbad
          have hgood := trial_finite_count_strict_row c (physicalSourceCountMeasure X)
            (trialMesh : ℝ) (R.activation : ℝ) (trial_source_seed_below_activation ν t)
            z htail.2 G (hQ.1 R.activation) hbadG
          obtain ⟨ε, hε, hfine⟩ := trial_finite_band_inward_row c (trialMesh : ℝ) κ
            (R.activation : ℝ) (trial_source_seed_below_activation ν t).le z
            (fun k => ⟨(hδ.trans (hx k.1 k.2).1).le, (hx k.1 k.2).2.trans hκ⟩)
            htail.1 G hGopen hgood
          filter_upwards [hmesh ε hε] with N hN
          right
          intro j
          rcases hfine (m N) (a N) (hgeom N).1.monotone (hgeom N).2.2.1
              (hgeom N).2.2.2 hN j with hlow | hempty | hgood
          · exact Or.inl hlow
          · by_cases hlow : a N j.succ ≤ (R.activation : ℝ)
            · exact Or.inl hlow
            right
            left
            have hpos := trial_band_positive_lower_of_seed (a N) (hgeom N).1
              (hgeom N).2.1 (hseedrow N ν t) (lt_of_not_ge hlow)
            have hz : b N (B N X) j = 0 := by
              simpa only [b, B, ← trial_fragmentBandMasses_sum] using hempty
            simpa only [hz] using hpos
          · right
            right
            simpa only [G, tail, b, B, ← trial_fragmentBandMasses_sum] using hgood
        filter_upwards [hrep, hzero, hrowevent] with N hrepN hzeroN hrowN
        have hU : B N X ∈ U N := by
          refine ⟨⟨?_, ?_, hrowN⟩, ?_, ?_⟩
          · rw [htotal]
            apply hradius.trans_le
            norm_num [physicalSourceOuterRadius, trialMesh]
          · intro j hj
            rw [hzeroN j (hlargeζ.trans hj)]
            exact trial_band_positive_lower_of_seed (a N) (hgeom N).1 (hgeom N).2.1
              (hseedζ N) hj
          · intro j hj
            rw [hzeroN j hj]
            exact trial_band_positive_lower_of_seed (a N) (hgeom N).1 (hgeom N).2.1
              (by rw [(hgeom N).2.2.1]; exact hδlarge) hj
          · simpa only [Set.mem_ofPred_eq, htotal] using hradius
        simp only [f, Set.indicator_of_mem hU, hrepN, trialSourceStepFunction,
          hsource, one_mul]
      · have hsource0 : physicalSourceOuterSupport X = 0 :=
          (trialSource_projection_regular.2.2.1 X).resolve_right
            hsource
        exact Filter.Eventually.of_forall fun N => by
          have hnot : B N X ∉ U N := by
            intro hU
            exact hsource (hvalid N X hfullκ.2 (hgap N) hU).1
          simp only [f, Set.indicator_of_notMem hnot, trialSourceStepFunction,
            hsource0, zero_mul]
  obtain ⟨C, hC, hbound, _⟩ := trial_integrable_marginals
  have hfb (N : ℕ) (v : Fin 40 → Fin (m N + 1) → ℝ) : ‖f N v‖ ≤ C :=
    (norm_indicator_le_norm_self _ _).trans
      (hbound (fun i => trialBandRepresentative (a N) (v i)))
  have hgb (X : Fin 40 → FiniteMeasure ℝ) : ‖trialSourceStepFunction X‖ ≤ C := by
    rcases trialSource_projection_regular.2.2.1 X with hX | hX
    · simpa only [trialSourceStepFunction, hX, zero_mul, norm_zero] using hC.le
    · simpa only [trialSourceStepFunction, hX, one_mul] using hbound X
  refine ⟨U, hopen, hvalid, ?_⟩
  have hconv := tendsto_integral_of_dominated_convergence
    (μ := μ) (F := fun N X => (f N (B N X) - trialSourceStepFunction X) ^ 2)
    (f := fun _ => (0 : ℝ)) (fun _ => (2 * C) ^ 2)
    (fun N => (((hfm N).comp (hBm N)).sub
      trialSource_projection_regular.1).pow_const 2
      |>.aestronglyMeasurable)
    (integrable_const _) (fun N => Filter.Eventually.of_forall fun X => by
      rw [norm_pow]
      apply pow_le_pow_left₀ (norm_nonneg _) _
      calc
        ‖f N (B N X) - trialSourceStepFunction X‖ ≤
            ‖f N (B N X)‖ + ‖trialSourceStepFunction X‖ := norm_sub_le _ _
        _ ≤ C + C := add_le_add (hfb N _) (hgb X)
        _ = 2 * C := by ring)
    (by filter_upwards [hevent] with X hX
        apply tendsto_const_nhds.congr'
        filter_upwards [hX] with N hN
        simp only [hN, sub_self, zero_pow (by decide : 2 ≠ 0)])
  simpa only [integral_zero] using hconv

theorem trial_source_inner_mask_data (b : Fin 3)
    (X : Fin 39 → FiniteMeasure ℝ) :
    let L : Fin 3 → (Fin 39 → FiniteMeasure ℝ) → ℝ := fun b =>
      if b = 0 then trialBaseMask else if b = 1 then trialEnlargedMask else trialFullMask
    let M : Fin 3 → (Fin 39 → FiniteMeasure ℝ) → ℝ := fun b X =>
      if b = 0 then trialBaseMask X * physicalSourceInnerSupport 0 X *
        physicalSourceInnerSupport 1 X
      else if b = 1 then trialEnlargedMask X * physicalSourceInnerSupport 1 X
      else trialFullMask X
    (M b X = 0 ∨ M b X = 1) ∧
      (M b X = 1 ↔ L b X = 1 ∧
        (b = 0 → physicalSourceInnerSupport 0 X = 1 ∧ physicalSourceInnerSupport 1 X = 1) ∧
        (b = 1 → physicalSourceInnerSupport 1 X = 1)) := by
  classical
  intro L M
  have hmul (u v : ℝ) (hu : u = 0 ∨ u = 1) (hv : v = 0 ∨ v = 1) :
      (u * v = 0 ∨ u * v = 1) ∧ (u * v = 1 ↔ u = 1 ∧ v = 1) := by
    rcases hu with rfl | rfl <;> rcases hv with rfl | rfl <;> norm_num
  have hi (ν : Fin 2) : physicalSourceInnerSupport ν X = 0 ∨
      physicalSourceInnerSupport ν X = 1 :=
    trialSource_projection_regular.2.2.2.1 ν X
  fin_cases b
  · have h₀ := hmul _ _ (trial_mask_values_and_nesting.2 X).1 (hi 0)
    simpa [L, M, h₀.2, and_assoc] using hmul _ _ h₀.1 (hi 1)
  · simpa [L, M] using hmul _ _ (trial_mask_values_and_nesting.2 X).2.1 (hi 1)
  · simpa [L, M] using (trial_mask_values_and_nesting.2 X).2.2.1

theorem trial_inner_band_exhaustion
    (κ : ℝ) (hκ : (trialLargestCap : ℝ) ≤ κ)
    (m : ℕ → ℕ) (a : (n : ℕ) → Fin (m n + 2) → ℝ)
    (ha : ∀ n, StrictMono (a n) ∧ a n 0 = 0 ∧
      a n (0 : Fin (m n + 1)).succ = (trialMesh : ℝ) ∧
      a n (Fin.last (m n + 1)) = κ)
    (hmesh : ∀ ε : ℝ, 0 < ε →
      ∀ᶠ n : ℕ in atTop, ∀ j : Fin (m n + 1), j ≠ 0 →
        a n j.succ - a n j.castSucc < ε) :
    let μ := Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)
    let B : (n : ℕ) → (Fin 39 → FiniteMeasure ℝ) → Fin 39 → Fin (m n + 1) → ℝ :=
      fun n X i => fragmentBandMasses (a n) (X i)
    let L : Fin 3 → (Fin 39 → FiniteMeasure ℝ) → ℝ := fun b =>
      if b = 0 then trialBaseMask else if b = 1 then trialEnlargedMask else trialFullMask
    let M : Fin 3 → (Fin 39 → FiniteMeasure ℝ) → ℝ := fun b X =>
      if b = 0 then trialBaseMask X * physicalSourceInnerSupport 0 X *
        physicalSourceInnerSupport 1 X
      else if b = 1 then trialEnlargedMask X * physicalSourceInnerSupport 1 X
      else trialFullMask X
    let r : Fin 3 → ℝ := fun b =>
      (if b = 0 then 89563 else if b = 1 then 89953 else 98302) * (trialMesh : ℝ)
    ∃ U A : (b : Fin 3) → (n : ℕ) → Set (Fin 39 → Fin (m n + 1) → ℝ),
      (∀ b n, IsOpen (U b n) ∧ MeasurableSet (A b n) ∧ A b n ⊆ U b n ∧
        A b n = U b n ∩ {v | L b (fun i => trialBandRepresentative (a n) (v i)) = 1}) ∧
      (∀ (b : Fin 3) (n : ℕ) (X : Fin 39 → FiniteMeasure ℝ),
        (∑ i, X i).restrict (Set.Ioc (0 : ℝ) κ) = ∑ i, X i →
        (∀ j : Fin (m n + 1), 0 < a n j.castSucc →
          fragmentBandMasses (a n) (∑ i, X i) j = 0 ∨
            a n j.castSucc < fragmentBandMasses (a n) (∑ i, X i) j) →
        B n X ∈ U b n →
        (∀ i, (X i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0) ∧
          (∑ i, ((X i).mass : ℝ)) < r b ∧
          (b = 0 → physicalSourceInnerSupport 0 X = 1 ∧
            physicalSourceInnerSupport 1 X = 1) ∧
          (b = 1 → physicalSourceInnerSupport 1 X = 1)) ∧
      (∀ᵐ X ∂μ, ∀ b : Fin 3, ∀ᶠ n : ℕ in atTop,
        (A b n).indicator (1 : (Fin 39 → Fin (m n + 1) → ℝ) → ℝ) (B n X) = M b X) ∧
      ∀ b : Fin 3, Tendsto
        (fun n => ∫ X,
          ((A b n).indicator (1 : (Fin 39 → Fin (m n + 1) → ℝ) → ℝ) (B n X) -
            M b X) ^ 2 ∂μ) atTop (𝓝 0) := by
  classical
  intro μ B L M r
  let : IsFiniteMeasure trialPhysicalMeasure := trialPhysicalMeasure_finite_mass.1
  let δ : ℝ := trialMesh
  let ζ : ℝ := (((19037 / 100000 : ℚ) / physicalSourceRho) : ℝ)
  have hδ : 0 < δ := Rat.cast_pos.mpr trial_fixed_positive_data.2.1
  have hδlargest : δ < (trialLargestCap : ℝ) := by
    norm_num [δ, trialLargestCap, trialMesh]
  have hlargestζ : (trialLargestCap : ℝ) < ζ := by
    norm_num [ζ, trialLargestCap, trialMesh, physicalSourceRho]
  let s : (n : ℕ) → (Fin 39 → Fin (m n + 1) → ℝ) → ℝ :=
    fun n v => ∑ i, ∑ j, v i j
  let bsum : (n : ℕ) → (Fin 39 → Fin (m n + 1) → ℝ) → Fin (m n + 1) → ℝ :=
    fun n v j => ∑ i, v i j
  let tail : (n : ℕ) → (Fin 39 → Fin (m n + 1) → ℝ) → Fin (m n + 1) → ℝ :=
    fun n v j => ∑ k ∈ (Finset.univ : Finset (Fin (m n + 1))).filter (fun k => j ≤ k),
      bsum n v k
  let G : (ν : Fin 2) → Fin (if ν = 0 then 28 else 39) → ℝ → ℝ → Prop :=
    fun ν t u p =>
      let R := physicalSourceRow ν t.val
      let C : ℝ := (23 / 40) * (R.innerThreshold : ℝ)
      if R.order ≤ 2 then u + p < (R.innerThreshold : ℝ)
      else u + (3 * p - min ((3 / 2) * p) C) < (R.innerThreshold : ℝ) ∧
        (min ((3 / 2) * p) C < (R.outerThreshold : ℝ) ∨ C ≤ (R.outerThreshold : ℝ))
  let W : (ν : Fin 2) → (n : ℕ) → Set (Fin 39 → Fin (m n + 1) → ℝ) :=
    fun ν n => {v |
      s n v < (physicalSourceInnerRadius ν : ℝ) ∧
      (∀ j : Fin (m n + 1), ζ < a n j.succ → bsum n v j < a n j.castSucc) ∧
      ∀ t : Fin (if ν = 0 then 28 else 39),
        (physicalSourceRow ν t.val).order = 1 ∨
          s n v < ((physicalSourceRow ν t.val).innerCore : ℝ) ∨
          ∀ j : Fin (m n + 1),
            a n j.succ ≤ ((physicalSourceRow ν t.val).activation : ℝ) ∨
              bsum n v j < a n j.castSucc ∨ G ν t (tail n v j) (a n j.succ)}
  let V : (n : ℕ) → Set (Fin 39 → Fin (m n + 1) → ℝ) := fun n => {v |
    ∀ j : Fin (m n + 1), (trialLargestCap : ℝ) < a n j.succ →
      bsum n v j < a n j.castSucc}
  let U : (b : Fin 3) → (n : ℕ) → Set (Fin 39 → Fin (m n + 1) → ℝ) := fun b n =>
    (if b = 0 then W 0 n ∩ W 1 n else if b = 1 then W 1 n else Set.univ) ∩
      (V n ∩ {v | s n v < r b})
  let A : (b : Fin 3) → (n : ℕ) → Set (Fin 39 → Fin (m n + 1) → ℝ) := fun b n =>
    U b n ∩ {v | L b (fun i => trialBandRepresentative (a n) (v i)) = 1}
  have hW (ν : Fin 2) (n : ℕ) :=
    physicalSourceInner_inward_band_domain (a n) (ha n).1 (ha n).2.1 ν
      (by rw [(ha n).2.2.1]; exact (hδlargest.trans hlargestζ).le)
      (fun t => by rw [(ha n).2.2.1]; exact (trial_source_seed_below_activation ν t).le)
  have hV (n : ℕ) := trial_inward_band_cap_domain (d := 39)
    (a n) (ha n).1 (ha n).2.1 (trialLargestCap : ℝ)
    (by rw [(ha n).2.2.1]; exact hδlargest.le)
  have hUopen (b : Fin 3) (n : ℕ) : IsOpen (U b n) := by
    have hi : IsOpen (if b = 0 then W 0 n ∩ W 1 n
        else if b = 1 then W 1 n else Set.univ) := by
      split_ifs
      · exact (hW 0 n).1.inter (hW 1 n).1
      · exact (hW 1 n).1
      · exact isOpen_univ
    exact hi.inter ((hV n).1.inter
      (isOpen_lt (show Continuous (s n) by fun_prop) continuous_const))
  have hLmeas (b : Fin 3) : Measurable (L b) := by
    dsimp only [L]
    split_ifs
    · exact trial_data_measurable.2.2.1
    · exact trial_data_measurable.2.2.2.1
    · exact trial_data_measurable.2.2.2.2.1
  have hMmeas (b : Fin 3) : Measurable (M b) := by
    dsimp only [M]
    split_ifs
    · exact (trial_data_measurable.2.2.1.mul
        (physicalSourceSupport_measurable.2 0)).mul
        (physicalSourceSupport_measurable.2 1)
    · exact trial_data_measurable.2.2.2.1.mul
        (physicalSourceSupport_measurable.2 1)
    · exact trial_data_measurable.2.2.2.2.1
  have hrepmeas (n : ℕ) : Measurable
      (fun v : Fin 39 → Fin (m n + 1) → ℝ =>
        fun i => trialBandRepresentative (a n) (v i)) :=
    measurable_pi_iff.mpr fun i =>
      (trialBandRepresentative_measurable (a n)).comp (measurable_pi_apply i)
  have hAmeas (b : Fin 3) (n : ℕ) : MeasurableSet (A b n) :=
    (hUopen b n).measurableSet.inter
      (measurableSet_eq_fun ((hLmeas b).comp (hrepmeas n)) measurable_const)
  have hBmeas (n : ℕ) : Measurable (B n) :=
    measurable_pi_iff.mpr fun i =>
      (measurable_fragmentBandMasses (a n)).comp
        (measurable_pi_apply i)
  have hMdata (b : Fin 3) (X : Fin 39 → FiniteMeasure ℝ) :
      (M b X = 0 ∨ M b X = 1) ∧
      (M b X = 1 ↔ L b X = 1 ∧
        (b = 0 → physicalSourceInnerSupport 0 X = 1 ∧ physicalSourceInnerSupport 1 X = 1) ∧
        (b = 1 → physicalSourceInnerSupport 1 X = 1)) :=
    trial_source_inner_mask_data b X
  have hradL (b : Fin 3) (X : Fin 39 → FiniteMeasure ℝ) (hL : L b X = 1) :
      (∑ i, ((X i).mass : ℝ)) < r b := by
    dsimp only [L, r] at hL ⊢
    split_ifs at hL ⊢
    · exact trial_original_strict_radial_bounds.2.1 X hL
    · exact trial_original_strict_radial_bounds.2.2.1 X hL
    · exact trial_original_strict_radial_bounds.2.2.2 X hL
  have hUsupport (b : Fin 3) (n : ℕ) (X : Fin 39 → FiniteMeasure ℝ)
      (hfull : (∑ i, X i).restrict (Set.Ioc (0 : ℝ) κ) = ∑ i, X i)
      (hgap : ∀ j : Fin (m n + 1), 0 < a n j.castSucc →
        fragmentBandMasses (a n) (∑ i, X i) j = 0 ∨
          a n j.castSucc < fragmentBandMasses (a n) (∑ i, X i) j)
      (hXU : B n X ∈ U b n) :
      (∀ i, (X i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0) ∧
        (∑ i, ((X i).mass : ℝ)) < r b ∧
        (b = 0 → physicalSourceInnerSupport 0 X = 1 ∧ physicalSourceInnerSupport 1 X = 1) ∧
        (b = 1 → physicalSourceInnerSupport 1 X = 1) := by
    have hc : (∑ i, X i).restrict (Set.Ioc (a n 0) (a n (Fin.last (m n + 1)))) =
        ∑ i, X i := by simpa only [(ha n).2.1, (ha n).2.2.2] using hfull
    have ht : s n (B n X) = ∑ i, ((X i).mass : ℝ) :=
      trial_band_total_sum (a n) (ha n).1.monotone X hc
    refine ⟨(hV n).2 X hc hgap hXU.2.1, ?_, ?_, ?_⟩
    · simpa only [Set.mem_ofPred_eq, ht] using hXU.2.2
    · intro hb
      have hi : B n X ∈ W 0 n ∩ W 1 n := by simpa only [hb, ↓reduceIte] using hXU.1
      exact ⟨((hW 0 n).2 X hc hgap hi.1).1, ((hW 1 n).2 X hc hgap hi.2).1⟩
    · intro hb
      have hb₀ : b ≠ 0 := fun h =>
        (by decide : (1 : Fin 3) ≠ 0) (hb.symm.trans h)
      have hi := hXU.1
      rw [ite_eq_right hb₀, ite_eq_left hb] at hi
      exact ((hW 1 n).2 X hc hgap hi).1
  let Q : (Fin 39 → FiniteMeasure ℝ) → Prop := fun X =>
    (∀ q : ℚ, physicalSourceCountMeasure X {(q : ℝ)} = 0) ∧
    (∀ (i : Fin 39) (q : ℚ), (X i : Measure ℝ) {(q : ℝ)} = 0) ∧
    ∀ ν : Fin 2, physicalSourceInnerSupport ν X = 1 →
      (∑ i, ((X i).mass : ℝ)) < (physicalSourceInnerRadius ν : ℝ) ∧
      ∀ t : Fin (if ν = 0 then 28 else 39),
        (physicalSourceRow ν t.val).order = 1 ∨
          (∑ i, ((X i).mass : ℝ)) < ((physicalSourceRow ν t.val).innerCore : ℝ) ∨
          physicalSourceCountMeasure X {p : ℝ |
            ((physicalSourceRow ν t.val).activation : ℝ) < p ∧
              ¬ G ν t (((∑ i, X i : FiniteMeasure ℝ) : Measure ℝ).real (Set.Ici p)) p} = 0
  have hQ : ∀ᵐ X ∂μ, Q X := by
    have hcount : ∀ᵐ X ∂μ, ∀ q : ℚ, physicalSourceCountMeasure X {(q : ℝ)} = 0 :=
      ae_all_iff.mpr fun q => trialPhysical_count_fixed_mark_null 39 (q : ℝ)
    have hcoord : ∀ᵐ X ∂μ, ∀ (i : Fin 39) (q : ℚ), (X i : Measure ℝ) {(q : ℝ)} = 0 := by
      simp only [ae_all_iff]
      intro i q
      exact (Measure.tendsto_eval_ae_ae
        (μ := fun _ : Fin 39 => trialPhysicalMeasure) (i := i)).eventually
          (trialPhysical_fixed_mark_null (q : ℝ))
    refine hcount.and (hcoord.and ?_)
    rw [ae_all_iff]
    intro ν
    have hrows := ae_all_iff.mpr (fun t : Fin (if ν = 0 then 28 else 39) =>
      physicalSourceInnerSupport_row_ae_strict ν t)
    filter_upwards [trialPhysical_total_mass_ne 38 (physicalSourceInnerRadius ν : ℝ),
      hrows] with X hrad hrowsX hν
    have hsource := hν
    unfold physicalSourceInnerSupport at hsource
    have hs := (Ne.ite_eq_left_iff (one_ne_zero : (1 : ℝ) ≠ 0)).mp hsource
    refine ⟨lt_of_le_of_ne hs.1 hrad, ?_⟩
    intro t
    simpa only [G, apply_ite Not, FiniteMeasure.toMeasure_sum] using hrowsX t hν
  let F : Fin 3 → ℕ → (Fin 39 → FiniteMeasure ℝ) → ℝ := fun b n X =>
    (A b n).indicator (1 : (Fin 39 → Fin (m n + 1) → ℝ) → ℝ) (B n X)
  have hFmeas (b : Fin 3) (n : ℕ) : Measurable (F b n) :=
    (measurable_const.indicator (hAmeas b n)).comp (hBmeas n)
  let P : (Fin 39 → FiniteMeasure ℝ) → Prop := fun X =>
    ∀ b : Fin 3, ∀ᶠ n : ℕ in atTop, F b n X = M b X
  have hP : MeasurableSet {X | P X} := by
    simp only [P, eventually_atTop, Set.ofPred_forall, Set.ofPred_exists]
    exact MeasurableSet.iInter fun b => MeasurableSet.iUnion fun _ =>
      MeasurableSet.iInter fun n => MeasurableSet.iInter fun _ =>
        measurableSet_eq_fun (hFmeas b n) (hMmeas b)
  have hPae : ∀ᵐ X ∂μ, P X := by
    apply trialPhysical_ae_finite_tail_elim_of_ae δ hδ 39 P Q hP hQ
    intro Y k x hY hx hQX
    let X : Fin 39 → FiniteMeasure ℝ := fun i =>
      Y i + weightedEmpirical (k i) (x i)
    change P X
    obtain ⟨hNlevel, hcoordlevel, hinnerQ⟩ := hQX
    have hcapκ := trial_finite_configuration_cap 39 δ κ hδ
      (hδlargest.le.trans hκ) Y k x hY
      (fun i j => ⟨(hx i j).1, (hx i j).2.trans hκ⟩)
    have hcaplargest := trial_finite_configuration_cap 39 δ (trialLargestCap : ℝ)
      hδ hδlargest.le Y k x hY hx
    have hactualcap (i : Fin 39) : (X i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0 := by
      have hc := congrArg (fun c : FiniteMeasure ℝ => (c : Measure ℝ)) (hcaplargest.1 i)
      rw [FiniteMeasure.restrict_measure_eq] at hc
      rw [← hc, Measure.restrict_apply measurableSet_Ioi,
        Set.disjoint_iff_inter_eq_empty.mp Set.Ioc_disjoint_Ioi_same.symm, measure_empty]
    obtain ⟨hmass, hcaps⟩ := trial_finite_band_representatives_eventually κ hκ m a ha hmesh
      39 Y k x hY hx hcoordlevel
      ({68225, 44781, 35265, 44976, 35419} : Finset ℕ) (by
        intro j hj
        norm_num only [Finset.mem_insert, Finset.mem_singleton] at hj
        rcases hj with rfl | rfl | rfl | rfl | rfl <;> norm_num)
    have hmaskEq : ∀ᶠ n : ℕ in atTop, ∀ b : Fin 3,
        L b (fun i => trialBandRepresentative (a n) (B n X i)) = L b X := by
      filter_upwards [hcaps] with n hn
      have hm := trialMasks_eq_of_mass_and_caps
        (fun i => trialBandRepresentative (a n) (B n X i)) X (hmass n) hn
      intro b
      dsimp only [L]
      split_ifs
      · exact hm.1
      · exact hm.2.1
      · exact hm.2.2
    have hVevent : ∀ᶠ n : ℕ in atTop, B n X ∈ V n := by
      filter_upwards [hcaps] with n hn
      intro j hj
      have hz (i : Fin 39) : B n X i j = 0 := by
        have hrep : (trialBandRepresentative (a n) (B n X i) : Measure ℝ)
            (Set.Ioi (trialLargestCap : ℝ)) = 0 := by
          have hc := (hn i 68225 (by decide)).mpr
            (by simpa only [trialLargestCap, Rat.cast_mul, Rat.cast_ofNat, Nat.cast_ofNat, X]
              using hactualcap i)
          simpa only [trialLargestCap, Rat.cast_mul, Rat.cast_ofNat, Nat.cast_ofNat, B, X]
            using hc
        exact (trialBandRepresentative_cap_zero_iff (a n) (B n X i)
          (fun l => NNReal.coe_nonneg _) (trialLargestCap : ℝ)).mp hrep j hj
      have hzero : bsum n (B n X) j = 0 := Finset.sum_eq_zero fun i _ => hz i
      rw [hzero]
      exact trial_band_positive_lower_of_seed (a n) (ha n).1 (ha n).2.1
        (by rw [(ha n).2.2.1]; exact hδlargest.le) hj
    let c : FiniteMeasure ℝ := ∑ i, X i
    let z : ((i : Fin 39) × Fin (k i)) → ℝ := fun v => x v.1 v.2
    obtain ⟨htail, hNtail⟩ := trial_finite_tail_mass_and_count 39 δ hδ Y k x hY
      (fun i j => (hx i j).1)
    have hz : ∀ v : (i : Fin 39) × Fin (k i), 0 ≤ z v ∧ z v ≤ κ :=
      fun v => ⟨(hδ.trans (hx v.1 v.2).1).le, (hx v.1 v.2).2.trans hκ⟩
    have hfull (n : ℕ) :
        c.restrict (Set.Ioc (a n 0) (a n (Fin.last (m n + 1)))) = c := by
      simpa only [(ha n).2.1, (ha n).2.2.2] using hcapκ.2
    have htotal (n : ℕ) : s n (B n X) = ∑ i, ((X i).mass : ℝ) :=
      trial_band_total_sum (a n) (ha n).1.monotone X (hfull n)
    have hbsum (n : ℕ) (j : Fin (m n + 1)) :
        bsum n (B n X) j = fragmentBandMasses (a n) c j :=
      (trial_fragmentBandMasses_sum (a n) X j).symm
    have hbandtail (n : ℕ) (j : Fin (m n + 1)) :
        tail n (B n X) j =
          ∑ l ∈ (Finset.univ : Finset (Fin (m n + 1))).filter (fun l => j ≤ l),
            fragmentBandMasses (a n) c l :=
      Finset.sum_congr rfl fun l _ => hbsum n l
    have hgap (n : ℕ) (j : Fin (m n + 1)) (hj : 0 < a n j.castSucc) :
        fragmentBandMasses (a n) c j = 0 ∨
          a n j.castSucc < fragmentBandMasses (a n) c j := by
      have hj0 : j ≠ 0 := by
        rintro rfl
        simp only [Fin.castSucc_zero, (ha n).2.1, lt_self_iff_false] at hj
      have hjδ : δ ≤ a n j.castSucc := by
        change (trialMesh : ℝ) ≤ a n j.castSucc
        rw [← (ha n).2.2.1]
        exact (ha n).1.monotone
          (Fin.succ_le_castSucc_iff.mpr (Fin.pos_iff_ne_zero.mpr hj0))
      apply trial_finite_tail_band_gap (a n) (ha n).1.monotone c δ z htail
        (fun v => ⟨(hz v).1, by simpa only [(ha n).2.2.2] using (hz v).2⟩) j hjδ
    have hGopen (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)) (u : ℝ) :
        IsOpen {p : ℝ | G ν t u p} := by
      dsimp only [G]
      by_cases ho : (physicalSourceRow ν t.val).order ≤ 2
      · simp only [ite_eq_left ho]
        exact isOpen_lt (by fun_prop) continuous_const
      · simp only [ite_eq_right ho]
        simp only [Set.ofPred_and, Set.ofPred_or]
        refine IsOpen.inter ?_ (IsOpen.union ?_ isOpen_const) <;>
          exact isOpen_lt (by fun_prop) continuous_const
    have hinnerEvent (ν : Fin 2) (hν : physicalSourceInnerSupport ν X = 1) :
        ∀ᶠ n : ℕ in atTop, B n X ∈ W ν n := by
      obtain ⟨hrad, hrows⟩ := hinnerQ ν hν
      have hrowevent (t : Fin (if ν = 0 then 28 else 39)) :
          ∀ᶠ n : ℕ in atTop,
            (physicalSourceRow ν t.val).order = 1 ∨
              s n (B n X) < ((physicalSourceRow ν t.val).innerCore : ℝ) ∨
              ∀ j : Fin (m n + 1),
                a n j.succ ≤ ((physicalSourceRow ν t.val).activation : ℝ) ∨
                  bsum n (B n X) j < a n j.castSucc ∨
                    G ν t (tail n (B n X) j) (a n j.succ) := by
        rcases hrows t with hfirst | hcore | hbad
        · exact Eventually.of_forall fun _ => Or.inl hfirst
        · exact Eventually.of_forall fun n => Or.inr (Or.inl (by
            simpa only [htotal n] using hcore))
        · have hact := trial_source_seed_below_activation ν t
          have hgood := trial_finite_count_strict_row c (physicalSourceCountMeasure X) δ
            ((physicalSourceRow ν t.val).activation : ℝ) hact z hNtail (G ν t)
            (hNlevel (physicalSourceRow ν t.val).activation) hbad
          obtain ⟨ε, hε, hfine⟩ := trial_finite_band_inward_row c δ κ
            ((physicalSourceRow ν t.val).activation : ℝ) hact.le z hz htail
            (G ν t) (hGopen ν t) hgood
          filter_upwards [hmesh ε hε] with n hn
          refine Or.inr (Or.inr ?_)
          intro j
          by_cases hlow : a n j.succ ≤ ((physicalSourceRow ν t.val).activation : ℝ)
          · exact Or.inl hlow
          rcases hfine (m n) (a n) (ha n).1.monotone (ha n).2.2.1
            (ha n).2.2.2 hn j with hlow' | hzero | hgood'
          · exact False.elim (hlow hlow')
          · right
            left
            rw [hbsum n j, hzero]
            exact trial_band_positive_lower_of_seed (a n) (ha n).1 (ha n).2.1
              (by rw [(ha n).2.2.1]; exact hact.le) (lt_of_not_ge hlow)
          · right
            right
            rw [hbandtail n j]
            exact hgood'
      filter_upwards [hVevent, Filter.eventually_all.mpr hrowevent] with n hn hrowsn
      refine ⟨?_, ?_, hrowsn⟩
      · simpa only [htotal n] using hrad
      · intro j hj
        exact hn j (hlargestζ.trans hj)
    intro b
    rcases (hMdata b X).1 with hzero | hone
    · filter_upwards [hmaskEq] with n hn
      have hnot : B n X ∉ A b n := by
        intro hmem
        have hs := hUsupport b n X hcapκ.2 (hgap n) hmem.1
        have hl : L b X = 1 := by simpa only [Set.mem_ofPred_eq, hn b] using hmem.2
        have hm : M b X = 1 := (hMdata b X).2.mpr ⟨hl, hs.2.2.1, hs.2.2.2⟩
        exact zero_ne_one (hzero.symm.trans hm)
      simp only [F, Set.indicator_of_notMem hnot, hzero]
    · obtain ⟨hl, hi₀, hi₁⟩ := (hMdata b X).2.mp hone
      have hi : ∀ᶠ n : ℕ in atTop,
          B n X ∈ (if b = 0 then W 0 n ∩ W 1 n
            else if b = 1 then W 1 n else Set.univ) := by
        by_cases hb₀ : b = 0
        · obtain ⟨h₀, h₁⟩ := hi₀ hb₀
          filter_upwards [hinnerEvent 0 h₀, hinnerEvent 1 h₁] with n hn₀ hn₁
          simpa only [ite_eq_left hb₀, Set.mem_inter_iff] using And.intro hn₀ hn₁
        · by_cases hb₁ : b = 1
          · filter_upwards [hinnerEvent 1 (hi₁ hb₁)] with n hn
            simpa only [ite_eq_right hb₀, ite_eq_left hb₁] using hn
          · exact Eventually.of_forall fun _ => by
              simp only [ite_eq_right hb₀, ite_eq_right hb₁, Set.mem_univ]
      filter_upwards [hmaskEq, hi, hVevent] with n hn hiN hVN
      have hmem : B n X ∈ A b n := by
        refine ⟨⟨hiN, hVN, ?_⟩, ?_⟩
        · simpa only [Set.mem_ofPred_eq, htotal n] using hradL b X hl
        · simpa only [Set.mem_ofPred_eq, hn b] using hl
      simp only [F, Set.indicator_of_mem hmem, Pi.one_apply, hone]
  refine ⟨U, A, ?_, hUsupport, hPae, ?_⟩
  · intro b n
    exact ⟨hUopen b n, hAmeas b n, Set.inter_subset_left, rfl⟩
  · intro b
    have hmeas (n : ℕ) : AEStronglyMeasurable (fun X => (F b n X - M b X) ^ 2) μ :=
      (((hFmeas b n).sub (hMmeas b)).pow_const 2).aestronglyMeasurable
    have hbound (n : ℕ) : ∀ᵐ X ∂μ, ‖(F b n X - M b X) ^ 2‖ ≤ (1 : ℝ) := by
      refine ae_of_all _ fun X => ?_
      rcases (hMdata b X).1 with hM | hM <;> by_cases hmem : B n X ∈ A b n
      all_goals norm_num [F, Set.indicator_apply, hmem, hM]
    have hlim : ∀ᵐ X ∂μ,
        Tendsto (fun n => (F b n X - M b X) ^ 2) atTop (𝓝 (0 : ℝ)) := by
      filter_upwards [hPae] with X hX
      apply tendsto_const_nhds.congr'
      filter_upwards [hX b] with n hn
      simp only [hn, sub_self, zero_pow (by decide : 2 ≠ 0)]
    simpa only [F, integral_zero] using
      tendsto_integral_of_dominated_convergence (fun _ : Fin 39 → FiniteMeasure ℝ => (1 : ℝ))
        hmeas (integrable_const 1) hbound hlim

end PrimeGap186

section

open scoped ContDiff

theorem PrimeGap186.trial_bounded_open_support_smooth_density
    {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]
    [MeasurableSpace E] [BorelSpace E] {μ : Measure E} [IsFiniteMeasure μ]
    {f : E → ℝ} (hf : MemLp f 2 μ) {C : ℝ} (hC : 0 ≤ C)
    (hbound : ∀ x, ‖f x‖ ≤ C) {U : Set E} (hU : IsOpen U)
    (hsupport : Function.support f ⊆ U) {ε : ℝ} (hε : 0 < ε) :
    ∃ g : E → ℝ, ContDiff ℝ ∞ g ∧ HasCompactSupport g ∧
      tsupport g ⊆ U ∧ eLpNorm (f - g) 2 μ ≤ ENNReal.ofReal ε := by
  classical
  have hhalf : 0 < ε / 2 := half_pos hε
  have hhalfE : ENNReal.ofReal (ε / 2) ≠ 0 :=
    (ENNReal.ofReal_pos.mpr hhalf).ne'
  obtain ⟨η, hη, hsmall⟩ :=
    exists_eLpNorm_indicator_le (E := ℝ) (μ := μ) (p := 2)
      (by norm_num) C hhalfE
  obtain ⟨K, hKU, hK, hKclosed, hmeasure⟩ :=
    hU.measurableSet.exists_isCompact_isClosed_sdiff_lt
      (measure_ne_top μ U) (ENNReal.coe_pos.mpr hη).ne'
  let fK : E → ℝ := K.indicator f
  have hfK : MemLp fK 2 μ := hf.indicator hKclosed.measurableSet
  have hsupportK : Function.support fK ⊆ K := Set.support_indicator_subset
  have hfirst : eLpNorm (f - fK) 2 μ ≤ ENNReal.ofReal (ε / 2) := by
    apply (eLpNorm_mono (g := (U \ K).indicator (fun _ : E => C)) ?_).trans
      (hsmall _ hmeasure.le)
    intro x
    by_cases hxK : x ∈ K
    · simp only [Pi.sub_apply, fK, Set.indicator_of_mem hxK, sub_self, norm_zero]
      exact norm_nonneg _
    · by_cases hxU : x ∈ U
      · simp only [Pi.sub_apply, fK, Set.indicator_of_notMem hxK, sub_zero,
          Set.indicator_of_mem (show x ∈ U \ K from ⟨hxU, hxK⟩),
          Real.norm_eq_abs, abs_of_nonneg hC]
        simpa only [Real.norm_eq_abs] using hbound x
      · have hfx : f x = 0 := Function.support_subset_iff'.mp hsupport x hxU
        simp only [Pi.sub_apply, hfx, fK, Set.indicator_of_notMem hxK, sub_zero,
          norm_zero]
        exact norm_nonneg _
  obtain ⟨g, hgsmooth, hgcompact, hgsupport, hsecond⟩ :=
    hfK.exists_contDiff_tsupport_subset_eLpNorm_sub_le
      hK hsupportK hU hKU hhalf
  refine ⟨g, hgsmooth, hgcompact, hgsupport, ?_⟩
  rw [← sub_add_sub_cancel f fK g]
  calc
    _ ≤ eLpNorm (f - fK) 2 μ + eLpNorm (fK - g) 2 μ :=
      eLpNorm_add_le (hf.aestronglyMeasurable.sub hfK.aestronglyMeasurable)
        (hfK.aestronglyMeasurable.sub hgsmooth.continuous.aestronglyMeasurable)
        (by norm_num)
    _ ≤ ENNReal.ofReal (ε / 2) + ENNReal.ofReal (ε / 2) :=
      add_le_add hfirst hsecond
    _ = ENNReal.ofReal ε := by
      rw [← ENNReal.ofReal_add hhalf.le hhalf.le, add_halves]

end

section

open scoped ContDiff Manifold

theorem PrimeGap186.trial_smooth_unit_cutoff_density
    {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [FiniteDimensional ℝ E]
    [MeasurableSpace E] [BorelSpace E] {μ : Measure E} [IsFiniteMeasure μ]
    {A U : Set E} (hA : MeasurableSet A) (hU : IsOpen U) (hAU : A ⊆ U)
    {ε : ℝ} (hε : 0 < ε) :
    ∃ g : E → ℝ, ContDiff ℝ ∞ g ∧ HasCompactSupport g ∧ tsupport g ⊆ U ∧
      (∀ x, 0 ≤ g x ∧ g x ≤ 1) ∧
      eLpNorm (A.indicator (1 : E → ℝ) - g) 2 μ ≤ ENNReal.ofReal ε := by
  classical
  obtain ⟨η, hη, hbudget⟩ :=
    exists_eLpNorm_indicator_le (E := ℝ) (μ := μ) (p := 2)
      (by norm_num) (1 : ℝ) (ENNReal.ofReal_pos.mpr hε).ne'
  have hηhalf : ((η / 2 : ℝ≥0) : ℝ≥0∞) ≠ 0 :=
    (ENNReal.coe_pos.mpr (half_pos hη)).ne'
  obtain ⟨K, hKA, hK, hKclosed, hAK⟩ :=
    hA.exists_isCompact_isClosed_sdiff_lt (measure_ne_top μ A) hηhalf
  obtain ⟨V, hKV, hV, _, hVK⟩ :=
    hKclosed.measurableSet.exists_isOpen_sdiff_lt (measure_ne_top μ K) hηhalf
  obtain ⟨W, hW, hKW, hWU, hWcompact⟩ :=
    exists_open_between_and_isCompact_closure hK (hU.inter hV)
      (fun x hx => ⟨hAU (hKA hx), hKV hx⟩)
  obtain ⟨θ, hθ0, hθ1, hθrange⟩ :=
    exists_contMDiffMap_zero_one_of_isClosed (𝓘(ℝ, E)) (n := ⊤)
      hW.isClosed_compl hKclosed
      (Set.disjoint_left.mpr fun x hxW hxK => hxW (hKW hxK))
  have hsupport : Function.support (fun x : E => θ x) ⊆ W :=
    Function.support_subset_iff'.mpr hθ0
  have htsupport : tsupport (fun x : E => θ x) ⊆ closure W := closure_mono hsupport
  have hcompact : HasCompactSupport (fun x : E => θ x) :=
    HasCompactSupport.of_support_subset_isCompact hWcompact
      (hsupport.trans subset_closure)
  let B := (A \ K) ∪ (V \ K)
  have hmeasure : μ B ≤ η := by
    calc
      μ B ≤ μ (A \ K) + μ (V \ K) := measure_union_le _ _
      _ ≤ ((η / 2 : ℝ≥0) : ℝ≥0∞) + ((η / 2 : ℝ≥0) : ℝ≥0∞) :=
        add_le_add hAK.le hVK.le
      _ = (η : ℝ≥0∞) := by rw [← ENNReal.coe_add, add_halves]
  refine ⟨(fun x => θ x), θ.contMDiff.contDiff, hcompact,
    fun x hx => (hWU (htsupport hx)).1, hθrange, ?_⟩
  apply (eLpNorm_mono (g := B.indicator (fun _ : E => (1 : ℝ))) ?_).trans
    (hbudget B hmeasure)
  intro x
  change ‖A.indicator (1 : E → ℝ) x - θ x‖ ≤ ‖B.indicator (fun _ : E => (1 : ℝ)) x‖
  by_cases hxB : x ∈ B
  · rw [Set.indicator_of_mem hxB, norm_one, Real.norm_eq_abs, abs_le]
    by_cases hxA : x ∈ A
    · rw [Set.indicator_of_mem hxA, Pi.one_apply]
      constructor <;> linarith [(hθrange x).1, (hθrange x).2]
    · rw [Set.indicator_of_notMem hxA, zero_sub]
      constructor <;> linarith [(hθrange x).1, (hθrange x).2]
  · have hzero : A.indicator (1 : E → ℝ) x - θ x = 0 := by
      by_cases hxK : x ∈ K
      · rw [Set.indicator_of_mem (hKA hxK), hθ1 hxK]
        simp only [Pi.one_apply, sub_self]
      · have hxA : x ∉ A := fun h => hxB (Or.inl ⟨h, hxK⟩)
        have hxV : x ∉ V := fun h => hxB (Or.inr ⟨h, hxK⟩)
        have hxW : x ∉ W := fun h => hxV (hWU (subset_closure h)).2
        rw [Set.indicator_of_notMem hxA, hθ0 hxW]
        simp only [Pi.zero_apply, sub_self]
    rw [hzero, norm_zero]
    exact norm_nonneg _

end

namespace PrimeGap186

section

open scoped InnerProductSpace

theorem trial_eLpNorm_sq_integral_bound {α : Type*} [MeasurableSpace α]
    {μ : Measure α} {f : α → ℝ} (hf : MemLp f 2 μ)
    {τ : ℝ} (hτ : 0 ≤ τ) (h : eLpNorm f 2 μ ≤ ENNReal.ofReal τ) :
    (∫ x, f x ^ 2 ∂μ) ≤ τ ^ 2 := by
  have hI : (∫ x, f x ^ 2 ∂μ) = ‖hf.toLp f‖ ^ 2 := by
    rw [← real_inner_self_eq_norm_sq, L2.inner_def]
    apply integral_congr_ae
    filter_upwards [hf.coeFn_toLp] with x hx
    rw [hx]
    simp only [real_inner_self_eq_norm_sq, Real.norm_eq_abs, sq_abs]
  have hn : ‖hf.toLp f‖ ≤ τ := by
    rw [Lp.norm_toLp f hf]
    simpa only [ENNReal.toReal_ofReal hτ] using
      ENNReal.toReal_mono ENNReal.ofReal_ne_top h
  rw [hI]
  exact pow_le_pow_left₀ (norm_nonneg _) hn 2

end

theorem trial_l2_triangle_integral
    {α : Type*} [MeasurableSpace α] {μ : Measure α}
    {f g h : α → ℝ} (hf : MemLp f 2 μ) (hg : MemLp g 2 μ) (hh : MemLp h 2 μ) :
    (∫ x, (f x - h x) ^ 2 ∂μ) ≤
      2 * (∫ x, (f x - g x) ^ 2 ∂μ) + 2 * (∫ x, (g x - h x) ^ 2 ∂μ) := by
  have hfg : Integrable (fun x => (f x - g x) ^ 2) μ := (hf.sub hg).integrable_sq
  have hgh : Integrable (fun x => (g x - h x) ^ 2) μ := (hg.sub hh).integrable_sq
  calc
    _ ≤ ∫ x, 2 * (f x - g x) ^ 2 + 2 * (g x - h x) ^ 2 ∂μ := by
      apply integral_mono (hf.sub hh).integrable_sq
        ((hfg.const_mul 2).add (hgh.const_mul 2))
      intro x
      simp only [Pi.add_apply, Pi.sub_apply]
      nlinarith only [sq_nonneg (f x - 2 * g x + h x)]
    _ = _ := by
      rw [integral_add (hfg.const_mul 2) (hgh.const_mul 2),
        integral_const_mul, integral_const_mul]

theorem trial_l2_band_dense_transfer
    {α E : Type*} [MeasurableSpace α] [MeasurableSpace E] {μ : Measure α}
    (B : α → E) (hB : Measurable B) (f g : E → ℝ) (h : α → ℝ)
    (hf : MemLp f 2 (Measure.map B μ)) (hg : MemLp g 2 (Measure.map B μ))
    (hh : MemLp h 2 μ) {ε : ℝ} (hε : 0 < ε)
    (hdense : eLpNorm (f - g) 2 (Measure.map B μ) ≤
      ENNReal.ofReal (min 1 (ε / 8)))
    (hband : (∫ x, (f (B x) - h x) ^ 2 ∂μ) < ε / 4) :
    (∫ x, (g (B x) - h x) ^ 2 ∂μ) < ε := by
  let τ : ℝ := min 1 (ε / 8)
  have hτ : 0 < τ := lt_min zero_lt_one (div_pos hε (by norm_num))
  have hτone : τ ≤ 1 := min_le_left _ _
  have hτε : τ ≤ ε / 8 := min_le_right _ _
  have hτsq : τ ^ 2 ≤ ε / 8 := by
    have h : τ ^ 2 ≤ τ := by nlinarith only [hτ.le, hτone]
    exact h.trans hτε
  have hfB : MemLp (fun x => f (B x)) 2 μ := hf.comp_of_map hB.aemeasurable
  have hgB : MemLp (fun x => g (B x)) 2 μ := hg.comp_of_map hB.aemeasurable
  have herror : eLpNorm (fun x => g (B x) - f (B x)) 2 μ ≤ ENNReal.ofReal τ := by
    change eLpNorm ((g - f) ∘ B) 2 μ ≤ _
    rw [← eLpNorm_map_measure (hg.sub hf).aestronglyMeasurable hB.aemeasurable,
      eLpNorm_sub_comm]
    exact hdense
  have hsmall := trial_eLpNorm_sq_integral_bound (hgB.sub hfB) hτ.le herror
  have htriangle := trial_l2_triangle_integral hgB hfB hh
  change (∫ x, (g (B x) - f (B x)) ^ 2 ∂μ) ≤ τ ^ 2 at hsmall
  linarith only [htriangle, hsmall, hτsq, hband, hε]

theorem trialSource_signed_reference_dominates :
    let μ₄₀ := Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)
    let μ₃₉ := Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)
    let κ : ℝ := exceptionalMassCoefficient 0 +
      exceptionalMassCoefficient 1
    let t : ℝ := 49599 / 50000
    let η : ℝ := 49599 / 20000000
    let R : ℝ → ℝ → ℝ → ℝ := fun u v₀ v₁ =>
      2 * u * v₀ - v₀ ^ 2 + 2 * (1 - κ) * t * (u - v₀) * (v₁ - v₀) -
        t ^ 2 * (v₁ - v₀) ^ 2 - η * (17 / 50 : ℝ) * (u - v₀) ^ 2 -
        η⁻¹ * κ * t ^ 2 * (v₁ - v₀) ^ 2
    let U : Fin 40 → (Fin 39 → FiniteMeasure ℝ) → ℝ := fun i Y =>
      ∫ Z : FiniteMeasure ℝ, trialSourceStepFunction (i.insertNth Z Y)
        ∂trialPhysicalMeasure
    let M₀ : (Fin 39 → FiniteMeasure ℝ) → ℝ := fun Y =>
      trialBaseMask Y * physicalSourceInnerSupport 0 Y * physicalSourceInnerSupport 1 Y
    let M₁ : (Fin 39 → FiniteMeasure ℝ) → ℝ := fun Y =>
      trialEnlargedMask Y * physicalSourceInnerSupport 1 Y
    (2624989 / 10 ^ 7 : ℝ) *
        ((∑ i : Fin 40, ∫ Y, physicalSourceFaceMultiplier Y * U i Y ^ 2 ∂μ₃₉) /
          trialPhysicalNormalizer) -
      (∫ X, trialSourceStepFunction X ^ 2 ∂μ₄₀) / trialPhysicalNormalizer ≤
    (2624989 / 10 ^ 7 : ℝ) *
        ((∑ i : Fin 40, ∫ Y, R (U i Y) (M₀ Y * U i Y) (M₁ Y * U i Y) ∂μ₃₉) /
          trialPhysicalNormalizer) -
      (∫ X, trialSourceStepFunction X ^ 2 ∂μ₄₀) / trialPhysicalNormalizer := by
  classical
  intro μ₄₀ μ₃₉ κ t η R U M₀ M₁
  let : IsFiniteMeasure trialPhysicalMeasure := trialPhysicalMeasure_finite_mass.1
  let P : ℝ → ℝ → ℝ := fun x y =>
    2 * x - x ^ 2 + 2 * (1 - κ) * t * (1 - x) * (y - x) -
      t ^ 2 * (y - x) ^ 2 - η * (17 / 50 : ℝ) * (1 - x) ^ 2 -
      η⁻¹ * κ * t ^ 2 * (y - x) ^ 2
  obtain ⟨B, _, hPB, _⟩ := trial_signed_coefficient_control κ t η
  obtain ⟨_, hmmeas, _, hinnerbit, hmask, _, C, _, _, hface⟩ :=
    trialSource_projection_regular
  have hM₀ : Measurable M₀ :=
    (trial_data_measurable.2.2.1.mul
      (physicalSourceSupport_measurable.2 0)).mul
      (physicalSourceSupport_measurable.2 1)
  have hM₁ : Measurable M₁ :=
    trial_data_measurable.2.2.2.1.mul
      (physicalSourceSupport_measurable.2 1)
  have hbits (Y : Fin 39 → FiniteMeasure ℝ) :
      (M₀ Y = 0 ∨ M₀ Y = 1) ∧ (M₁ Y = 0 ∨ M₁ Y = 1) ∧
        (trialFullMask Y = 0 ∨ trialFullMask Y = 1) ∧
        M₀ Y ≤ M₁ Y ∧ M₁ Y ≤ trialFullMask Y := by
    obtain ⟨hb, he, hf, hbe, hef, _, _⟩ := trial_mask_values_and_nesting.2 Y
    obtain hi | hi := hinnerbit 0 Y <;> obtain hj | hj := hinnerbit 1 Y <;>
      obtain hb | hb := hb <;> obtain he | he := he <;> obtain hf | hf := hf
    all_goals norm_num [hb, he] at hbe
    all_goals norm_num [he, hf] at hef
    all_goals norm_num [M₀, M₁, hb, he, hf, hi, hj]
  have hunit (Y : Fin 39 → FiniteMeasure ℝ) :
      0 ≤ M₀ Y ∧ M₀ Y ≤ 1 ∧ 0 ≤ M₁ Y ∧ M₁ Y ≤ 1 := by
    obtain ⟨h₀, h₁, _⟩ := hbits Y
    rcases h₀ with h₀ | h₀ <;> rcases h₁ with h₁ | h₁ <;> norm_num [h₀, h₁]
  have hfactor (u x y : ℝ) : R u (x * u) (y * u) = P x y * u ^ 2 := by
    dsimp only [R, P]
    ring
  have hPmeas : Measurable (fun Y => P (M₀ Y) (M₁ Y)) := by
    dsimp only [P]
    fun_prop
  have hpoint (i : Fin 40) (Y : Fin 39 → FiniteMeasure ℝ) :
      physicalSourceFaceMultiplier Y * U i Y ^ 2 ≤
        R (U i Y) (M₀ Y * U i Y) (M₁ Y * U i Y) := by
    rw [hfactor]
    have hm : physicalSourceFaceMultiplier Y =
        (44415113 / 5000000000 : ℝ) * M₀ Y +
          (2479900401 / 2500000000 : ℝ) * M₁ Y +
          (-843183 / 1000000000 : ℝ) * trialFullMask Y := by
      dsimp only [physicalSourceFaceMultiplier, M₀, M₁]
      ring
    rw [hm]
    obtain ⟨h₀, h₁, hf, h₀₁, _⟩ := hbits Y
    rcases hf with hf | hf
    · have hu : U i Y = 0 := (((hface i).2.2 Y).2.2.2.2.2 hf).1
      simp only [hu, zero_pow (by norm_num : 2 ≠ 0), mul_zero, le_refl]
    · rcases h₀ with h₀ | h₀
      · rcases h₁ with h₁ | h₁
        · norm_num [h₀, h₁, hf, P, t, η]
        · have h := literal_minorant_fixed_rational_increment
            (U i Y ^ 2) (U i Y ^ 2) (sq_nonneg _)
          dsimp only at h
          norm_num [h₀, h₁, hf, P, κ, t, η]
          nlinarith only [h]
      · have h₁ : M₁ Y = 1 := h₁.resolve_left (by
          intro hz
          norm_num [h₀, hz] at h₀₁)
        norm_num [h₀, h₁, hf, P, t, η]
  apply sub_le_sub_right
  apply mul_le_mul_of_nonneg_left _ (by norm_num : (0 : ℝ) ≤ 2624989 / 10 ^ 7)
  apply div_le_div_of_nonneg_right _ trial_fixed_positive_data.2.2.2.2.2.le
  refine Finset.sum_le_sum fun i _ => ?_
  have hU : MemLp (U i) 2 μ₃₉ := MemLp.of_bound
    (hface i).1.aestronglyMeasurable C (ae_of_all _ fun Y => ((hface i).2.2 Y).1)
  have hmnorm : ∀ᵐ Y ∂μ₃₉, ‖physicalSourceFaceMultiplier Y‖ ≤ (1 : ℝ) := by
    refine ae_of_all _ fun Y => ?_
    have hw : physicalSourceFaceWeight Y ≤ 1 := by
      unfold physicalSourceFaceWeight
      split_ifs <;> norm_num
    simpa only [Real.norm_eq_abs] using (hmask Y).2.1.trans hw
  have hPnorm : ∀ᵐ Y ∂μ₃₉, ‖P (M₀ Y) (M₁ Y)‖ ≤ B := by
    refine ae_of_all _ fun Y => ?_
    obtain ⟨h₀, h₀', h₁, h₁'⟩ := hunit Y
    simpa only [Real.norm_eq_abs] using hPB _ _ h₀ h₀' h₁ h₁'
  exact integral_mono
    (hU.integrable_sq.bdd_mul hmmeas.aestronglyMeasurable hmnorm)
    ((hU.integrable_sq.bdd_mul hPmeas.aestronglyMeasurable hPnorm).congr
      (ae_of_all _ fun Y => (hfactor (U i Y) (M₀ Y) (M₁ Y)).symm)) (hpoint i)

theorem trialSource_signed_quadratic_l2_continuous (ε : ℝ) (hε : 0 < ε) :
    let μ₄₀ := Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)
    let μ₃₉ := Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)
    let κ : ℝ := exceptionalMassCoefficient 0 +
      exceptionalMassCoefficient 1
    let t : ℝ := 49599 / 50000
    let η : ℝ := 49599 / 20000000
    let R : ℝ → ℝ → ℝ → ℝ := fun u v₀ v₁ =>
      2 * u * v₀ - v₀ ^ 2 + 2 * (1 - κ) * t * (u - v₀) * (v₁ - v₀) -
        t ^ 2 * (v₁ - v₀) ^ 2 - η * (17 / 50 : ℝ) * (u - v₀) ^ 2 -
        η⁻¹ * κ * t ^ 2 * (v₁ - v₀) ^ 2
    let U : ((Fin 40 → FiniteMeasure ℝ) → ℝ) →
        Fin 40 → (Fin 39 → FiniteMeasure ℝ) → ℝ := fun f i Y =>
      ∫ Z : FiniteMeasure ℝ, f (i.insertNth Z Y) ∂trialPhysicalMeasure
    let M₀ : (Fin 39 → FiniteMeasure ℝ) → ℝ := fun Y =>
      trialBaseMask Y * physicalSourceInnerSupport 0 Y * physicalSourceInnerSupport 1 Y
    let M₁ : (Fin 39 → FiniteMeasure ℝ) → ℝ := fun Y =>
      trialEnlargedMask Y * physicalSourceInnerSupport 1 Y
    let Q := fun f H₀ H₁ =>
      (2624989 / 10 ^ 7 : ℝ) *
          ((∑ i : Fin 40, ∫ Y,
            R (U f i Y) (H₀ Y * U f i Y) (H₁ Y * U f i Y) ∂μ₃₉) /
            trialPhysicalNormalizer) -
        (∫ X, f X ^ 2 ∂μ₄₀) / trialPhysicalNormalizer
    ∃ δ : ℝ, 0 < δ ∧
      ∀ (f : (Fin 40 → FiniteMeasure ℝ) → ℝ)
        (H₀ H₁ : (Fin 39 → FiniteMeasure ℝ) → ℝ),
        MemLp f 2 μ₄₀ → Measurable H₀ → Measurable H₁ →
        (∀ Y, 0 ≤ H₀ Y ∧ H₀ Y ≤ 1 ∧ 0 ≤ H₁ Y ∧ H₁ Y ≤ 1) →
        (∀ᵐ X ∂μ₄₀,
          (2742997 / 2624989 : ℝ) < ∑ i : Fin 40, ((X i).mass : ℝ) → f X = 0) →
        (∫ X, (f X - trialSourceStepFunction X) ^ 2 ∂μ₄₀) < δ →
        (∫ Y, (H₀ Y - M₀ Y) ^ 2 ∂μ₃₉) < δ →
        (∫ Y, (H₁ Y - M₁ Y) ^ 2 ∂μ₃₉) < δ →
        |Q f H₀ H₁ - Q trialSourceStepFunction M₀ M₁| < ε := by
  classical
  intro μ₄₀ μ₃₉ κ t η R U M₀ M₁ Q
  let : IsFiniteMeasure trialPhysicalMeasure := trialPhysicalMeasure_finite_mass.1
  let g := trialSourceStepFunction
  let I : ((Fin 40 → FiniteMeasure ℝ) → ℝ) → ℝ := fun f => ∫ X, f X ^ 2 ∂μ₄₀
  let P : ℝ → ℝ → ℝ := fun x y =>
    2 * x - x ^ 2 + 2 * (1 - κ) * t * (1 - x) * (y - x) -
      t ^ 2 * (y - x) ^ 2 - η * (17 / 50 : ℝ) * (1 - x) ^ 2 -
      η⁻¹ * κ * t ^ 2 * (y - x) ^ 2
  let J := fun (f : (Fin 40 → FiniteMeasure ℝ) → ℝ)
      (H₀ H₁ : (Fin 39 → FiniteMeasure ℝ) → ℝ) =>
    ∑ i : Fin 40, ∫ Y, P (H₀ Y) (H₁ Y) * U f i Y ^ 2 ∂μ₃₉
  let a : ℝ := 2624989 / 10 ^ 7
  have ha : 0 < a := by norm_num [a]
  have hden : 0 < trialPhysicalNormalizer := trial_fixed_positive_data.2.2.2.2.2
  obtain ⟨B, hB, hPB, hPLip⟩ := trial_signed_coefficient_control κ t η
  obtain ⟨hgmeas, _, _, hinnerbit, _, hsupport, C, hC, hbound, hface⟩ :=
    trialSource_projection_regular
  have hg : MemLp g 2 μ₄₀ := MemLp.of_bound hgmeas.aestronglyMeasurable C
    (ae_of_all _ fun X => (hbound X).1)
  have hgsupport : ∀ᵐ X ∂μ₄₀,
      (2742997 / 2624989 : ℝ) < ∑ i : Fin 40, ((X i).mass : ℝ) → g X = 0 :=
    ae_of_all _ fun X hX => (hsupport X hX).1
  have hM₀ : Measurable M₀ :=
    (trial_data_measurable.2.2.1.mul
      (physicalSourceSupport_measurable.2 0)).mul
      (physicalSourceSupport_measurable.2 1)
  have hM₁ : Measurable M₁ :=
    trial_data_measurable.2.2.2.1.mul
      (physicalSourceSupport_measurable.2 1)
  have hMunit (Y : Fin 39 → FiniteMeasure ℝ) :
      0 ≤ M₀ Y ∧ M₀ Y ≤ 1 ∧ 0 ≤ M₁ Y ∧ M₁ Y ≤ 1 := by
    obtain ⟨hb, he, _⟩ := trial_mask_values_and_nesting.2 Y
    obtain hi | hi := hinnerbit 0 Y <;> obtain hj | hj := hinnerbit 1 Y <;>
      obtain hb | hb := hb <;> obtain he | he := he
    all_goals norm_num [M₀, M₁, hb, he, hi, hj]
  let A : ℝ := 4 * a * B + 1
  let D : ℝ := 40 * a * C ^ 2 * B
  let T : ℝ := (A * I g + 2 * D * μ₃₉.real Set.univ) / trialPhysicalNormalizer
  let K : ℝ := (A + 2 * D) / trialPhysicalNormalizer
  have hA : 0 < A := by dsimp only [A]; positivity
  have hD : 0 ≤ D := by dsimp only [D]; positivity
  obtain ⟨r, hr, hrsmall⟩ := exists_pos_mul_lt (half_pos hε) T
  let k : ℝ := 1 + r⁻¹
  have hk : 0 < k := by dsimp only [k]; positivity
  obtain ⟨δ, hδ, hδsmall⟩ := exists_pos_mul_lt (half_pos hε) (K * k)
  refine ⟨δ, hδ, ?_⟩
  intro f H₀ H₁ hf hH₀ hH₁ hHunit hfsupport hfe h₀e h₁e
  let e : (Fin 40 → FiniteMeasure ℝ) → ℝ := fun X => f X - g X
  let E₀ : ℝ := ∫ Y, (H₀ Y - M₀ Y) ^ 2 ∂μ₃₉
  let E₁ : ℝ := ∫ Y, (H₁ Y - M₁ Y) ^ 2 ∂μ₃₉
  have he : MemLp e 2 μ₄₀ := hf.sub hg
  have hesupport : ∀ᵐ X ∂μ₄₀,
      (2742997 / 2624989 : ℝ) < ∑ i : Fin 40, ((X i).mass : ℝ) → e X = 0 := by
    filter_upwards [hfsupport, hgsupport] with X hfX hgX hX
    simp only [e, hfX hX, hgX hX, sub_self]
  have hfgface (i : Fin 40) : MemLp (U g i) 2 μ₃₉ :=
    (trial_simplex_face_energy (2742997 / 2624989) (by norm_num) g hg hgsupport).1 i
  have hfface (i : Fin 40) : MemLp (U f i) 2 μ₃₉ :=
    (trial_simplex_face_energy (2742997 / 2624989) (by norm_num) f hf hfsupport).1 i
  have hreference (i : Fin 40) (Y : Fin 39 → FiniteMeasure ℝ) : |U g i Y| ≤ C := by
    simpa only [Real.norm_eq_abs] using ((hface i).2.2 Y).1
  have hsub (i : Fin 40) : (fun Y => U f i Y - U g i Y) =ᵐ[μ₃₉] U e i := by
    let ins : (FiniteMeasure ℝ × (Fin 39 → FiniteMeasure ℝ)) ≃ᵐ
        (Fin 40 → FiniteMeasure ℝ) :=
      (MeasurableEquiv.piFinSuccAbove (fun _ : Fin 40 => FiniteMeasure ℝ) i).symm
    have hins : MeasurePreserving ins (trialPhysicalMeasure.prod μ₃₉) μ₄₀ :=
      (measurePreserving_piFinSuccAbove (fun _ : Fin 40 => trialPhysicalMeasure) i).symm
    have hfi := hins.integrable_comp_of_integrable (MemLp.integrable one_le_two hf)
    have hgi := hins.integrable_comp_of_integrable (MemLp.integrable one_le_two hg)
    simp only [Function.comp_def, ins, MeasurableEquiv.piFinSuccAbove_symm_apply,
      Fin.insertNthEquiv, Equiv.coe_fn_mk] at hfi hgi
    filter_upwards [hfi.prod_left_ae, hgi.prod_left_ae] with Y hfY hgY
    exact (integral_sub hfY hgY).symm
  have hunitLp (v : (Fin 39 → FiniteMeasure ℝ) → ℝ) (hv : Measurable v)
      (hvb : ∀ Y, 0 ≤ v Y ∧ v Y ≤ 1) : MemLp v 2 μ₃₉ := by
    refine MemLp.of_bound hv.aestronglyMeasurable 1 (ae_of_all _ fun Y => ?_)
    rw [Real.norm_eq_abs, abs_of_nonneg (hvb Y).1]
    exact (hvb Y).2
  have hE₀ : Integrable (fun Y => (H₀ Y - M₀ Y) ^ 2) μ₃₉ := by
    simpa only [Pi.sub_apply] using
      ((hunitLp H₀ hH₀ fun Y => ⟨(hHunit Y).1, (hHunit Y).2.1⟩).sub
        (hunitLp M₀ hM₀ fun Y => ⟨(hMunit Y).1, (hMunit Y).2.1⟩)).integrable_sq
  have hE₁ : Integrable (fun Y => (H₁ Y - M₁ Y) ^ 2) μ₃₉ := by
    simpa only [Pi.sub_apply] using
      ((hunitLp H₁ hH₁ fun Y => (hHunit Y).2.2).sub
        (hunitLp M₁ hM₁ fun Y => (hMunit Y).2.2)).integrable_sq
  have hPHmeas : Measurable (fun Y => P (H₀ Y) (H₁ Y)) := by
    dsimp only [P]
    fun_prop
  have hPMmeas : Measurable (fun Y => P (M₀ Y) (M₁ Y)) := by
    dsimp only [P]
    fun_prop
  have hPHbound : ∀ᵐ Y ∂μ₃₉, ‖P (H₀ Y) (H₁ Y)‖ ≤ B := by
    refine ae_of_all _ fun Y => ?_
    obtain ⟨h₀, h₀', h₁, h₁'⟩ := hHunit Y
    simpa only [Real.norm_eq_abs] using hPB _ _ h₀ h₀' h₁ h₁'
  have hPMbound : ∀ᵐ Y ∂μ₃₉, ‖P (M₀ Y) (M₁ Y)‖ ≤ B := by
    refine ae_of_all _ fun Y => ?_
    obtain ⟨h₀, h₀', h₁, h₁'⟩ := hMunit Y
    simpa only [Real.norm_eq_abs] using hPB _ _ h₀ h₀' h₁ h₁'
  have hroot : |I f - I g| ≤ r * I g + k * I e := by
    simpa only [I, e, k, one_mul] using
      trial_weighted_square_l2_error μ₄₀ r hr f g (fun _ => 1) 1 (by norm_num) hf hg
        aestronglyMeasurable_const (ae_of_all _ fun _ => by norm_num)
  have hmaskrow (i : Fin 40) :
      |(∫ Y, P (H₀ Y) (H₁ Y) * U g i Y ^ 2 ∂μ₃₉) -
        ∫ Y, P (M₀ Y) (M₁ Y) * U g i Y ^ 2 ∂μ₃₉| ≤
      C ^ 2 * B * (2 * r * μ₃₉.real Set.univ + k * (E₀ + E₁)) := by
    have hH := (hfgface i).integrable_sq.bdd_mul hPHmeas.aestronglyMeasurable hPHbound
    have hM := (hfgface i).integrable_sq.bdd_mul hPMmeas.aestronglyMeasurable hPMbound
    have hu (Y : Fin 39 → FiniteMeasure ℝ) : U g i Y ^ 2 ≤ C ^ 2 :=
      sq_le_sq.mpr (by simpa only [abs_of_pos hC] using hreference i Y)
    have hcoeff (Y : Fin 39 → FiniteMeasure ℝ) :
        |P (H₀ Y) (H₁ Y) - P (M₀ Y) (M₁ Y)| ≤
          B * (|H₀ Y - M₀ Y| + |H₁ Y - M₁ Y|) := by
      obtain ⟨h₀, h₀', h₁, h₁'⟩ := hHunit Y
      obtain ⟨m₀, m₀', m₁, m₁'⟩ := hMunit Y
      exact hPLip _ _ _ _ h₀ h₀' h₁ h₁' m₀ m₀' m₁ m₁'
    simpa only [k, E₀, E₁] using
      trial_weighted_square_coefficient_error μ₃₉ r hr (U g i)
        (fun Y => P (H₀ Y) (H₁ Y)) (fun Y => P (M₀ Y) (M₁ Y))
        (fun Y => H₀ Y - M₀ Y) (fun Y => H₁ Y - M₁ Y)
        C B hB.le hH hM hE₀ hE₁ hu hcoeff
  have hrow (i : Fin 40) :
      |(∫ Y, P (H₀ Y) (H₁ Y) * U f i Y ^ 2 ∂μ₃₉) -
        ∫ Y, P (M₀ Y) (M₁ Y) * U g i Y ^ 2 ∂μ₃₉| ≤
      B * (r * (∫ Y, U g i Y ^ 2 ∂μ₃₉) + k * ∫ Y, U e i Y ^ 2 ∂μ₃₉) +
        C ^ 2 * B * (2 * r * μ₃₉.real Set.univ + k * (E₀ + E₁)) := by
    have hh := trial_weighted_square_l2_error μ₃₉ r hr
      (U f i) (U g i) (fun Y => P (H₀ Y) (H₁ Y))
      B hB.le (hfface i) (hfgface i) hPHmeas.aestronglyMeasurable hPHbound
    have heq : (∫ Y, (U f i Y - U g i Y) ^ 2 ∂μ₃₉) =
        ∫ Y, U e i Y ^ 2 ∂μ₃₉ :=
      integral_congr_ae ((hsub i).pow_const 2)
    rw [heq] at hh
    exact (abs_sub_le _ (∫ Y, P (H₀ Y) (H₁ Y) * U g i Y ^ 2 ∂μ₃₉) _).trans
      (add_le_add hh (hmaskrow i))
  have hfaceg : (∑ i : Fin 40, ∫ Y, U g i Y ^ 2 ∂μ₃₉) ≤ 4 * I g :=
    trial_physical_face_operator_bound g hg hgsupport
  have hfacee : (∑ i : Fin 40, ∫ Y, U e i Y ^ 2 ∂μ₃₉) ≤ 4 * I e :=
    trial_physical_face_operator_bound e he hesupport
  have hfaces : |J f H₀ H₁ - J g M₀ M₁| ≤
      4 * B * (r * I g + k * I e) +
        40 * C ^ 2 * B * (2 * r * μ₃₉.real Set.univ + k * (E₀ + E₁)) := by
    calc
      _ = |∑ i : Fin 40,
          ((∫ Y, P (H₀ Y) (H₁ Y) * U f i Y ^ 2 ∂μ₃₉) -
            ∫ Y, P (M₀ Y) (M₁ Y) * U g i Y ^ 2 ∂μ₃₉)| := by
        rw [Finset.sum_sub_distrib]
      _ ≤ ∑ i : Fin 40,
          |(∫ Y, P (H₀ Y) (H₁ Y) * U f i Y ^ 2 ∂μ₃₉) -
            ∫ Y, P (M₀ Y) (M₁ Y) * U g i Y ^ 2 ∂μ₃₉| :=
        Finset.abs_sum_le_sum_abs _ _
      _ ≤ ∑ i : Fin 40,
          (B * (r * (∫ Y, U g i Y ^ 2 ∂μ₃₉) + k * ∫ Y, U e i Y ^ 2 ∂μ₃₉) +
            C ^ 2 * B * (2 * r * μ₃₉.real Set.univ + k * (E₀ + E₁))) :=
        Finset.sum_le_sum fun i _ => hrow i
      _ = B * (r * (∑ i : Fin 40, ∫ Y, U g i Y ^ 2 ∂μ₃₉) +
          k * (∑ i : Fin 40, ∫ Y, U e i Y ^ 2 ∂μ₃₉)) +
          40 * C ^ 2 * B * (2 * r * μ₃₉.real Set.univ + k * (E₀ + E₁)) := by
        simp only [Finset.sum_add_distrib, ← Finset.mul_sum,
          Finset.sum_const, Finset.card_univ, Fintype.card_fin, nsmul_eq_mul]
        ring
      _ ≤ B * (r * (4 * I g) + k * (4 * I e)) +
          40 * C ^ 2 * B * (2 * r * μ₃₉.real Set.univ + k * (E₀ + E₁)) :=
        add_le_add (mul_le_mul_of_nonneg_left
          (add_le_add (mul_le_mul_of_nonneg_left hfaceg hr.le)
            (mul_le_mul_of_nonneg_left hfacee hk.le)) hB.le) le_rfl
      _ = _ := by ring
  have hQeq (v : (Fin 40 → FiniteMeasure ℝ) → ℝ)
      (H₀ H₁ : (Fin 39 → FiniteMeasure ℝ) → ℝ) : Q v H₀ H₁ =
      a * (J v H₀ H₁ / trialPhysicalNormalizer) - I v / trialPhysicalNormalizer := by
    apply congrArg (fun z => a * (z / trialPhysicalNormalizer) - I v / trialPhysicalNormalizer)
    apply Finset.sum_congr rfl
    intro i _
    exact integral_congr_ae (ae_of_all _ fun Y => by dsimp only [R, P]; ring)
  have hQ : |Q f H₀ H₁ - Q g M₀ M₁| ≤
      T * r + ((A * I e + D * (E₀ + E₁)) / trialPhysicalNormalizer) * k := by
    rw [hQeq, hQeq]
    calc
      _ = |(a * (J f H₀ H₁ - J g M₀ M₁) - (I f - I g)) /
          trialPhysicalNormalizer| := by congr 1; ring
      _ = |a * (J f H₀ H₁ - J g M₀ M₁) - (I f - I g)| /
          trialPhysicalNormalizer := by rw [abs_div, abs_of_pos hden]
      _ ≤ (a * |J f H₀ H₁ - J g M₀ M₁| + |I f - I g|) /
          trialPhysicalNormalizer := by
        apply div_le_div_of_nonneg_right _ hden.le
        simpa only [Real.norm_eq_abs, abs_mul, abs_of_pos ha] using
          norm_sub_le (a * (J f H₀ H₁ - J g M₀ M₁)) (I f - I g)
      _ ≤ (a * (4 * B * (r * I g + k * I e) +
          40 * C ^ 2 * B * (2 * r * μ₃₉.real Set.univ + k * (E₀ + E₁))) +
          (r * I g + k * I e)) / trialPhysicalNormalizer :=
        div_le_div_of_nonneg_right
          (add_le_add (mul_le_mul_of_nonneg_left hfaces ha.le) hroot) hden.le
      _ = _ := by dsimp only [T, A, D]; ring
  have herrors : A * I e + D * (E₀ + E₁) < (A + 2 * D) * δ := by
    have hfsmall : A * I e < A * δ := mul_lt_mul_of_pos_left hfe hA
    have hmsmall : D * (E₀ + E₁) ≤ D * (2 * δ) :=
      mul_le_mul_of_nonneg_left (by dsimp only [E₀, E₁]; linarith only [h₀e, h₁e]) hD
    nlinarith only [hfsmall, hmsmall]
  have hsmall : ((A * I e + D * (E₀ + E₁)) / trialPhysicalNormalizer) * k < ε / 2 := by
    calc
      _ < (((A + 2 * D) * δ) / trialPhysicalNormalizer) * k :=
        mul_lt_mul_of_pos_right (div_lt_div_of_pos_right herrors hden) hk
      _ = (K * k) * δ := by dsimp only [K]; ring
      _ < ε / 2 := hδsmall
  exact hQ.trans_lt (by linarith only [hrsmall, hsmall])

section

open scoped ContDiff

theorem trial_source_supported_smooth_profiles_approx (ε : ℝ) (hε : 0 < ε) :
    let κ : ℝ := (19037 / 100000) / (2624989 / 10000000)
    let M : Fin 3 → (Fin 39 → FiniteMeasure ℝ) → ℝ := fun b Y =>
      if b = 0 then trialBaseMask Y * physicalSourceInnerSupport 0 Y *
        physicalSourceInnerSupport 1 Y
      else if b = 1 then trialEnlargedMask Y * physicalSourceInnerSupport 1 Y
      else trialFullMask Y
    let r : Fin 3 → ℝ := fun b =>
      (if b = 0 then 89563 else if b = 1 then 89953 else 98302) * (trialMesh : ℝ)
    ∃ (m : ℕ) (a : Fin (m + 2) → ℝ)
      (F : (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
      (H : Fin 3 → (Fin 39 → Fin (m + 1) → ℝ) → ℝ),
      StrictMono a ∧ a 0 = 0 ∧ a (Fin.last (m + 1)) = κ ∧
      ContDiff ℝ ∞ F ∧ HasCompactSupport F ∧
      (∀ b, ContDiff ℝ ∞ (H b) ∧ HasCompactSupport (H b) ∧
        ∀ v, 0 ≤ H b v ∧ H b v ≤ 1) ∧
      (∀ (b : Fin 3) (i : Fin 40),
        ContDiff ℝ ∞ (fun v => H b (i.removeNth v) * F v) ∧
          HasCompactSupport (fun v => H b (i.removeNth v) * F v)) ∧
      (∀ X : Fin 40 → FiniteMeasure ℝ,
        (∑ i, X i).restrict (Set.Ioc (0 : ℝ) κ) = ∑ i, X i →
        (∀ j : Fin (m + 1), 0 < a j.castSucc →
          fragmentBandMasses a (∑ i, X i) j = 0 ∨
            a j.castSucc < fragmentBandMasses a (∑ i, X i) j) →
        F (fun i => fragmentBandMasses a (X i)) ≠ 0 →
        physicalSourceOuterSupport X = 1 ∧
          (∑ i, ((X i).mass : ℝ)) < 98303 * (trialMesh : ℝ) ∧
          ∀ i, (X i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0) ∧
      (∀ (b : Fin 3) (Y : Fin 39 → FiniteMeasure ℝ),
        (∑ i, Y i).restrict (Set.Ioc (0 : ℝ) κ) = ∑ i, Y i →
        (∀ j : Fin (m + 1), 0 < a j.castSucc →
          fragmentBandMasses a (∑ i, Y i) j = 0 ∨
            a j.castSucc < fragmentBandMasses a (∑ i, Y i) j) →
        H b (fun i => fragmentBandMasses a (Y i)) ≠ 0 →
        (∀ i, (Y i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0) ∧
          (∑ i, ((Y i).mass : ℝ)) < r b ∧
          (b = 0 → physicalSourceInnerSupport 0 Y = 1 ∧ physicalSourceInnerSupport 1 Y = 1) ∧
          (b = 1 → physicalSourceInnerSupport 1 Y = 1)) ∧
      MemLp (fun X : Fin 40 → FiniteMeasure ℝ =>
        F (fun i => fragmentBandMasses a (X i))) 2
        (Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)) ∧
      (∫ X : Fin 40 → FiniteMeasure ℝ,
        (F (fun i => fragmentBandMasses a (X i)) -
          trialSourceStepFunction X) ^ 2
        ∂Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)) < ε ∧
      ∀ b : Fin 3,
        (∫ Y : Fin 39 → FiniteMeasure ℝ,
          (H b (fun i => fragmentBandMasses a (Y i)) - M b Y) ^ 2
          ∂Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)) < ε := by
  classical
  intro κ M r
  let : IsFiniteMeasure trialPhysicalMeasure := trialPhysicalMeasure_finite_mass.1
  let μ₄₀ := Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)
  let μ₃₉ := Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)
  have hδ : 0 < (trialMesh : ℝ) := Rat.cast_pos.mpr trial_fixed_positive_data.2.1
  have hδκ : (trialMesh : ℝ) < κ := by norm_num [κ, trialMesh]
  have hlargeκ : (trialLargestCap : ℝ) ≤ κ := by
    norm_num [κ, trialLargestCap, trialMesh]
  obtain ⟨m, a, hgeom, hmesh⟩ := trial_fine_band_sequence (trialMesh : ℝ) κ hδ hδκ
  obtain ⟨U₄₀, hU₄₀, hsource₄₀, hlim₄₀⟩ :=
    trial_source_outer_band_exhaustion κ hlargeκ m a hgeom hmesh
  obtain ⟨U₃₉, A, hA, hsource₃₉, _, hlim₃₉⟩ :=
    trial_inner_band_exhaustion κ hlargeκ m a hgeom hmesh
  let B₄₀ (N : ℕ) (X : Fin 40 → FiniteMeasure ℝ) :=
    fun i => fragmentBandMasses (a N) (X i)
  let B₃₉ (N : ℕ) (Y : Fin 39 → FiniteMeasure ℝ) :=
    fun i => fragmentBandMasses (a N) (Y i)
  let f (N : ℕ) := (U₄₀ N).indicator
    (fun v => trialStepFunction (fun i => trialBandRepresentative (a N) (v i)))
  let g (b : Fin 3) (N : ℕ) :=
    (A b N).indicator (1 : (Fin 39 → Fin (m N + 1) → ℝ) → ℝ)
  have hquarter : 0 < ε / 4 := div_pos hε (by norm_num)
  have houter : ∀ᶠ N in atTop,
      (∫ X, (f N (B₄₀ N X) - trialSourceStepFunction X) ^ 2 ∂μ₄₀) < ε / 4 :=
    hlim₄₀.eventually (gt_mem_nhds hquarter)
  have hinner : ∀ᶠ N in atTop, ∀ b : Fin 3,
      (∫ Y, (g b N (B₃₉ N Y) - M b Y) ^ 2 ∂μ₃₉) < ε / 4 :=
    Filter.eventually_all.mpr fun b => (hlim₃₉ b).eventually (gt_mem_nhds hquarter)
  obtain ⟨N, houterN, hinnerN⟩ := (houter.and hinner).exists
  let ν₄₀ := Measure.map (B₄₀ N) μ₄₀
  let ν₃₉ := Measure.map (B₃₉ N) μ₃₉
  have hB₄₀ : Measurable (B₄₀ N) := measurable_pi_lambda _ fun i =>
    (measurable_fragmentBandMasses (a N)).comp (measurable_pi_apply i)
  have hB₃₉ : Measurable (B₃₉ N) := measurable_pi_lambda _ fun i =>
    (measurable_fragmentBandMasses (a N)).comp (measurable_pi_apply i)
  have hfm : Measurable (f N) := by
    apply Measurable.indicator _ (hU₄₀ N).measurableSet
    exact trial_data_measurable.2.2.2.2.2.1.comp
      (measurable_pi_lambda _ fun i =>
        (trialBandRepresentative_measurable (a N)).comp (measurable_pi_apply i))
  obtain ⟨C, hC, hbound, _⟩ := trial_integrable_marginals
  have hfb (v : Fin 40 → Fin (m N + 1) → ℝ) : ‖f N v‖ ≤ C := by
    by_cases hv : v ∈ U₄₀ N
    · simpa only [f, Set.indicator_of_mem hv] using
        hbound (fun i => trialBandRepresentative (a N) (v i))
    · simpa only [f, Set.indicator_of_notMem hv, norm_zero] using hC.le
  have hf : MemLp (f N) 2 ν₄₀ :=
    MemLp.of_bound hfm.aestronglyMeasurable C (Filter.Eventually.of_forall hfb)
  have hfsupport : Function.support (f N) ⊆ U₄₀ N := Set.support_indicator_subset
  have hτ : 0 < min (1 : ℝ) (ε / 8) :=
    lt_min zero_lt_one (div_pos hε (by norm_num))
  obtain ⟨F, hFsmooth, hFcompact, hFsupport, hFerror⟩ :=
    trial_bounded_open_support_smooth_density hf hC.le hfb (hU₄₀ N) hfsupport hτ
  have hHchoice (b : Fin 3) :
      ∃ H : (Fin 39 → Fin (m N + 1) → ℝ) → ℝ,
        ContDiff ℝ ∞ H ∧ HasCompactSupport H ∧ tsupport H ⊆ U₃₉ b N ∧
          (∀ v, 0 ≤ H v ∧ H v ≤ 1) ∧
          eLpNorm (g b N - H) 2 ν₃₉ ≤ ENNReal.ofReal (min 1 (ε / 8)) :=
    trial_smooth_unit_cutoff_density (μ := ν₃₉)
      (hA b N).2.1 (hA b N).1 (hA b N).2.2.1 hτ
  choose H hHsmooth hHcompact hHsupport hHrange hHerror using hHchoice
  have hFmem : MemLp F 2 ν₄₀ := hFsmooth.continuous.memLp_of_hasCompactSupport hFcompact
  have hHmem (b : Fin 3) : MemLp (H b) 2 ν₃₉ :=
    (hHsmooth b).continuous.memLp_of_hasCompactSupport (hHcompact b)
  have hgb (b : Fin 3) : MemLp (g b N) 2 ν₃₉ :=
    (memLp_const (1 : ℝ)).indicator (hA b N).2.1
  have hMmeas (b : Fin 3) : Measurable (M b) := by
    dsimp only [M]
    split_ifs
    · exact (trial_data_measurable.2.2.1.mul
        (physicalSourceSupport_measurable.2 0)).mul
        (physicalSourceSupport_measurable.2 1)
    · exact trial_data_measurable.2.2.2.1.mul
        (physicalSourceSupport_measurable.2 1)
    · exact trial_data_measurable.2.2.2.2.1
  have hMbits (b : Fin 3) (Y : Fin 39 → FiniteMeasure ℝ) :
      M b Y = 0 ∨ M b Y = 1 := by
    have hi (ν : Fin 2) := trialSource_projection_regular.2.2.2.1 ν Y
    fin_cases b
    · obtain hb | hb := (trial_mask_values_and_nesting.2 Y).1 <;>
        obtain h₀ | h₀ := hi 0 <;> obtain h₁ | h₁ := hi 1
      all_goals norm_num [M, hb, h₀, h₁]
    · obtain hb | hb := (trial_mask_values_and_nesting.2 Y).2.1 <;>
        obtain h₁ | h₁ := hi 1
      all_goals norm_num [M, hb, h₁]
    · obtain hb | hb := (trial_mask_values_and_nesting.2 Y).2.2.1
      all_goals norm_num [M, hb]
  have hMmem (b : Fin 3) : MemLp (M b) 2 μ₃₉ := by
    apply MemLp.of_bound (hMmeas b).aestronglyMeasurable 1
    exact Filter.Eventually.of_forall fun Y => by
      rcases hMbits b Y with h | h <;> simp only [h, norm_zero, norm_one, zero_le_one, le_refl]
  have hsourceMem : MemLp trialSourceStepFunction 2 μ₄₀ := by
    apply MemLp.of_bound
      trialSource_projection_regular.1.aestronglyMeasurable C
    exact Filter.Eventually.of_forall fun X => by
      rcases trialSource_projection_regular.2.2.1 X with h | h
      · simpa only [trialSourceStepFunction, h, zero_mul, norm_zero] using hC.le
      · simpa only [trialSourceStepFunction, h, one_mul] using hbound X
  refine ⟨m N, a N, F, H, (hgeom N).1, (hgeom N).2.1, (hgeom N).2.2.2,
    hFsmooth, hFcompact, ?_, ?_, ?_, ?_, hFmem.comp_of_map hB₄₀.aemeasurable, ?_, ?_⟩
  · exact fun b => ⟨hHsmooth b, hHcompact b, hHrange b⟩
  · intro b i
    constructor
    · apply ContDiff.mul _ hFsmooth
      apply (hHsmooth b).comp
      change ContDiff ℝ ∞ (fun v : Fin 40 → Fin (m N + 1) → ℝ =>
        fun j : Fin 39 => v (i.succAbove j))
      fun_prop
    · exact hFcompact.mul_left
  · intro X hfull hgap hF
    exact hsource₄₀ N X hfull hgap (hFsupport (subset_closure hF))
  · intro b Y hfull hgap hH
    exact hsource₃₉ b N Y hfull hgap (hHsupport b (subset_closure hH))
  · exact trial_l2_band_dense_transfer (B₄₀ N) hB₄₀ (f N) F trialSourceStepFunction
      hf hFmem hsourceMem hε hFerror houterN
  · intro b
    exact trial_l2_band_dense_transfer (B₃₉ N) hB₃₉ (g b N) (H b) (M b)
      (hgb b) (hHmem b) (hMmem b) hε (hHerror b) (hinnerN b)

end

theorem trial_cap_law_ae_band_structure (κ : ℝ) (d : ℕ) {m : ℕ}
    (a : Fin (m + 2) → ℝ) :
    let P : Measure (FiniteMeasure ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        fragmentLaw κ
    ∀ᵐ X ∂Measure.pi (fun _ : Fin d => P),
      (∀ i, (X i).restrict (Set.Ioc (0 : ℝ) κ) = X i) ∧
      (∑ i, X i).restrict (Set.Ioc (0 : ℝ) κ) = ∑ i, X i ∧
      ∀ j : Fin (m + 1), 0 < a j.castSucc →
        fragmentBandMasses a (∑ i, X i) j = 0 ∨
          a j.castSucc < fragmentBandMasses a (∑ i, X i) j := by
  classical
  intro P
  let : IsProbabilityMeasure (fragmentLaw κ) :=
    fragmentLaw_isProbabilityMeasure κ
  let : IsFiniteMeasure P := Measure.smul_finite
    (fragmentLaw κ) ENNReal.ofReal_ne_top
  have hfull : ∀ᵐ X ∂Measure.pi (fun _ : Fin d => P),
      ∀ i, (X i).restrict (Set.Ioc (0 : ℝ) κ) = X i :=
    ae_all_iff.mpr fun i =>
      (Measure.tendsto_eval_ae_ae (μ := fun _ : Fin d => P) (i := i)).eventually
      (Measure.ae_smul_measure (ae_restrict_Ioc_fragmentLaw κ)
        (ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ)))
  have hgap (j : Fin (m + 1)) :
      ∀ᵐ X ∂Measure.pi (fun _ : Fin d => P), 0 < a j.castSucc →
        fragmentBandMasses a (∑ i, X i) j = 0 ∨
          a j.castSucc < fragmentBandMasses a (∑ i, X i) j := by
    rw [Filter.eventually_imp_distrib_left]
    intro hj
    have hc : ∀ᵐ c ∂P,
        fragmentBandMasses a c j = 0 ∨
          a j.castSucc < fragmentBandMasses a c j := by
      simpa only [fragmentBandMasses] using
        Measure.ae_smul_measure (fragmentLaw_restricted_mass_gap
          κ (a j.castSucc) (a j.succ) hj)
            (ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ))
    have hall : ∀ᵐ X ∂Measure.pi (fun _ : Fin d => P), ∀ i : Fin d,
        fragmentBandMasses a (X i) j = 0 ∨
          a j.castSucc < fragmentBandMasses a (X i) j :=
      ae_all_iff.mpr fun i =>
        (Measure.tendsto_eval_ae_ae (μ := fun _ : Fin d => P) (i := i)).eventually hc
    filter_upwards [hall] with X hX
    exact trial_fragmentBandMasses_sum_gap a X j hX
  filter_upwards [hfull, ae_all_iff.mpr hgap] with X hX hgapX
  refine ⟨hX, ?_, hgapX⟩
  apply FiniteMeasure.toMeasure_injective
  simpa only [FiniteMeasure.restrict_measure_eq, FiniteMeasure.toMeasure_sum,
    Measure.restrict, map_sum] using
    Finset.sum_congr rfl (fun i (_ : i ∈ Finset.univ) =>
      congrArg (fun c : FiniteMeasure ℝ => (c : Measure ℝ)) (hX i))

theorem trialPhysical_band_structured (d : ℕ) (κ : ℝ)
    (hlargeκ : (trialLargestCap : ℝ) ≤ κ) {m : ℕ} (a : Fin (m + 2) → ℝ) :
    ∀ᵐ X ∂Measure.pi (fun _ : Fin d => trialPhysicalMeasure),
      (∑ i, X i).restrict (Set.Ioc (0 : ℝ) κ) = ∑ i, X i ∧
      ∀ j : Fin (m + 1), 0 < a j.castSucc →
        fragmentBandMasses a (∑ i, X i) j = 0 ∨
          a j.castSucc < fragmentBandMasses a (∑ i, X i) j := by
  filter_upwards [trial_cap_law_ae_band_structure (trialLargestCap : ℝ) d a] with X hX
  exact ⟨trial_restrict_eq_self_of_subset (∑ i, X i) _ _ hX.2.1
    (Set.Ioc_subset_Ioc le_rfl hlargeκ), hX.2.2⟩

theorem trial_cap_law_ae_cap_of_band_certificate
    (κ : ℝ) (d : ℕ) {m : ℕ} (a : Fin (m + 2) → ℝ)
    (f : (Fin d → FiniteMeasure ℝ) → ℝ)
    (hcert : ∀ X : Fin d → FiniteMeasure ℝ,
      (∑ i, X i).restrict (Set.Ioc (0 : ℝ) κ) = ∑ i, X i →
      (∀ j : Fin (m + 1), 0 < a j.castSucc →
        fragmentBandMasses a (∑ i, X i) j = 0 ∨
          a j.castSucc < fragmentBandMasses a (∑ i, X i) j) →
      f X ≠ 0 → ∀ i, (X i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0) :
    let P : Measure (FiniteMeasure ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        fragmentLaw κ
    ∀ᵐ X ∂Measure.pi (fun _ : Fin d => P),
      f X ≠ 0 → ∀ i, (X i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0 := by
  intro P
  filter_upwards [trial_cap_law_ae_band_structure κ d a] with X hX
  exact hcert X hX.2.1 hX.2.2

theorem trial_cap_law_pi_restrict (κ : ℝ)
    (hκ : (trialLargestCap : ℝ) ≤ κ) (d : ℕ) :
    let P : Measure (FiniteMeasure ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        fragmentLaw κ
    let C : Set (Fin d → FiniteMeasure ℝ) :=
      {X | ∀ i, (X i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0}
    MeasurableSet C ∧
      (Measure.pi (fun _ : Fin d => P)).restrict C =
        Measure.pi (fun _ : Fin d => trialPhysicalMeasure) := by
  classical
  intro P C
  let : IsProbabilityMeasure (fragmentLaw κ) :=
    fragmentLaw_isProbabilityMeasure κ
  let : IsFiniteMeasure P := Measure.smul_finite
    (fragmentLaw κ) ENNReal.ofReal_ne_top
  let C₁ : Set (FiniteMeasure ℝ) :=
    {c | (c : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0}
  have hlarge : 0 < (trialLargestCap : ℝ) :=
    Rat.cast_pos.mpr trial_fixed_positive_data.2.2.1
  have hcap := fragmentLaw_full_configuration_cap_restriction
    κ (trialLargestCap : ℝ) hlarge hκ
  have hC : C = Set.univ.pi (fun _ : Fin d => C₁) := by
    ext X
    simp only [C, C₁, Set.mem_ofPred_eq, Set.mem_pi, Set.mem_univ, forall_const]
  refine ⟨?_, ?_⟩
  · rw [hC]
    exact MeasurableSet.univ_pi fun _ => hcap.1
  · rw [hC, Measure.restrict_pi_pi]
    exact congrArg Measure.pi (funext fun _ => hcap.2)

theorem trial_cap_law_integral_eq (κ : ℝ)
    (hκ : (trialLargestCap : ℝ) ≤ κ) (d : ℕ)
    (f : (Fin d → FiniteMeasure ℝ) → ℝ) :
    let P : Measure (FiniteMeasure ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        fragmentLaw κ
    (∀ᵐ X ∂Measure.pi (fun _ : Fin d => P),
      f X ≠ 0 → ∀ i, (X i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0) →
    (∫ X, f X ∂Measure.pi (fun _ : Fin d => P)) =
      ∫ X, f X ∂Measure.pi (fun _ : Fin d => trialPhysicalMeasure) := by
  intro P hf
  let C : Set (Fin d → FiniteMeasure ℝ) :=
    {X | ∀ i, (X i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0}
  have hz : ∀ᵐ X ∂Measure.pi (fun _ : Fin d => P), X ∉ C → f X = 0 :=
    hf.mono fun _ hX => not_imp_comm.mp hX
  calc
    _ = ∫ X in C, f X ∂Measure.pi (fun _ : Fin d => P) :=
      (setIntegral_eq_integral_of_ae_compl_eq_zero hz).symm
    _ = _ := by rw [(trial_cap_law_pi_restrict κ hκ d).2]

theorem trial_cap_law_square_integral_eq (κ : ℝ)
    (hκ : (trialLargestCap : ℝ) ≤ κ) (d : ℕ)
    (f : (Fin d → FiniteMeasure ℝ) → ℝ) :
    let P : Measure (FiniteMeasure ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        fragmentLaw κ
    (∀ᵐ X ∂Measure.pi (fun _ : Fin d => P),
      f X ≠ 0 → ∀ i, (X i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0) →
    (∫ X, f X ^ 2 ∂Measure.pi (fun _ : Fin d => P)) =
      ∫ X, f X ^ 2 ∂Measure.pi (fun _ : Fin d => trialPhysicalMeasure) := by
  intro P hf
  apply trial_cap_law_integral_eq κ hκ d (fun X => f X ^ 2)
  exact hf.mono fun _ hX hne => hX ((pow_ne_zero_iff (by decide)).mp hne)

theorem trial_cap_law_fiber_eq (κ : ℝ)
    (hκ : (trialLargestCap : ℝ) ≤ κ) (d : ℕ) (i : Fin (d + 1))
    (f : (Fin (d + 1) → FiniteMeasure ℝ) → ℝ) :
    let P : Measure (FiniteMeasure ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        fragmentLaw κ
    let U : (Fin d → FiniteMeasure ℝ) → ℝ := fun Y =>
      ∫ Z : FiniteMeasure ℝ, f (i.insertNth Z Y) ∂P
    let V : (Fin d → FiniteMeasure ℝ) → ℝ := fun Y =>
      ∫ Z : FiniteMeasure ℝ, f (i.insertNth Z Y) ∂trialPhysicalMeasure
    (∀ᵐ X ∂Measure.pi (fun _ : Fin (d + 1) => P),
      f X ≠ 0 → ∀ j, (X j : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0) →
    (∀ᵐ Y ∂Measure.pi (fun _ : Fin d => P), U Y = V Y ∧
      (¬ (∀ j, (Y j : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0) → U Y = 0)) ∧
      ∀ᵐ Y ∂Measure.pi (fun _ : Fin d => trialPhysicalMeasure), U Y = V Y := by
  classical
  intro P U V hf
  let : IsProbabilityMeasure (fragmentLaw κ) :=
    fragmentLaw_isProbabilityMeasure κ
  let : IsFiniteMeasure P := Measure.smul_finite
    (fragmentLaw κ) ENNReal.ofReal_ne_top
  let C : Set (FiniteMeasure ℝ) :=
    {Z | (Z : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0}
  have hcap : P.restrict C = trialPhysicalMeasure :=
    trialPhysicalMeasure_eq_cap_restriction κ hκ
  have hins : MeasurePreserving
      (fun p : (Fin d → FiniteMeasure ℝ) × FiniteMeasure ℝ => i.insertNth p.2 p.1)
      ((Measure.pi (fun _ : Fin d => P)).prod P)
      (Measure.pi (fun _ : Fin (d + 1) => P)) := by
    simpa only [Function.comp_def, MeasurableEquiv.piFinSuccAbove_symm_apply,
      Fin.insertNthEquiv, Equiv.coe_fn_mk, Prod.swap] using
      ((measurePreserving_piFinSuccAbove (fun _ : Fin (d + 1) => P) i).symm.comp
        (Measure.measurePreserving_swap (μ := Measure.pi (fun _ : Fin d => P)) (ν := P)))
  have hcurr := Measure.ae_ae_of_ae_prod (hins.quasiMeasurePreserving.ae hf)
  have hmain : ∀ᵐ Y ∂Measure.pi (fun _ : Fin d => P), U Y = V Y ∧
      (¬ (∀ j, (Y j : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0) → U Y = 0) := by
    filter_upwards [hcurr] with Y hY
    have hz : ∀ᵐ Z ∂P, Z ∉ C → f (i.insertNth Z Y) = 0 := by
      filter_upwards [hY] with Z hZ hnot
      by_contra hne
      apply hnot
      simpa only [C, Set.mem_ofPred_eq, Fin.insertNth_apply_same] using hZ hne i
    refine ⟨?_, ?_⟩
    · dsimp only [U, V]
      rw [← setIntegral_eq_integral_of_ae_compl_eq_zero hz, hcap]
    · intro hnot
      have hz' : ∀ᵐ Z ∂P, f (i.insertNth Z Y) = 0 := by
        filter_upwards [hY] with Z hZ
        by_contra hne
        apply hnot
        intro j
        simpa only [Fin.insertNth_apply_succAbove] using hZ hne (i.succAbove j)
      exact integral_eq_zero_of_ae hz'
  have hle : Measure.pi (fun _ : Fin d => trialPhysicalMeasure) ≤
      Measure.pi (fun _ : Fin d => P) := by
    rw [← (trial_cap_law_pi_restrict κ hκ d).2]
    exact Measure.restrict_le_self
  exact ⟨hmain, (ae_mono hle) (hmain.mono fun _ hY => hY.1)⟩

theorem trial_cap_law_fiber_function_integral_eq (κ : ℝ)
    (hκ : (trialLargestCap : ℝ) ≤ κ) (d r : ℕ) (i : Fin (d + 1))
    (f : Fin r → (Fin (d + 1) → FiniteMeasure ℝ) → ℝ)
    (Ψ : (Fin d → FiniteMeasure ℝ) → (Fin r → ℝ) → ℝ)
    (hΨ : ∀ Y, Ψ Y (fun _ => 0) = 0) :
    let P : Measure (FiniteMeasure ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        fragmentLaw κ
    (∀ j : Fin r, ∀ᵐ X ∂Measure.pi (fun _ : Fin (d + 1) => P),
      f j X ≠ 0 → ∀ k, (X k : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0) →
    (∫ Y, Ψ Y (fun j => ∫ Z : FiniteMeasure ℝ, f j (i.insertNth Z Y) ∂P)
      ∂Measure.pi (fun _ : Fin d => P)) =
      ∫ Y, Ψ Y (fun j => ∫ Z : FiniteMeasure ℝ,
        f j (i.insertNth Z Y) ∂trialPhysicalMeasure)
      ∂Measure.pi (fun _ : Fin d => trialPhysicalMeasure) := by
  classical
  intro P hf
  let U : Fin r → (Fin d → FiniteMeasure ℝ) → ℝ := fun j Y =>
    ∫ Z : FiniteMeasure ℝ, f j (i.insertNth Z Y) ∂P
  let V : Fin r → (Fin d → FiniteMeasure ℝ) → ℝ := fun j Y =>
    ∫ Z : FiniteMeasure ℝ, f j (i.insertNth Z Y) ∂trialPhysicalMeasure
  have hfaces : ∀ᵐ Y ∂Measure.pi (fun _ : Fin d => P), ∀ j : Fin r,
      U j Y = V j Y ∧
      (¬ (∀ k, (Y k : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0) → U j Y = 0) :=
    ae_all_iff.mpr fun j => (trial_cap_law_fiber_eq κ hκ d i (f j) (hf j)).1
  have hphysical : ∀ᵐ Y ∂Measure.pi (fun _ : Fin d => trialPhysicalMeasure),
      ∀ j : Fin r, U j Y = V j Y :=
    ae_all_iff.mpr fun j => (trial_cap_law_fiber_eq κ hκ d i (f j) (hf j)).2
  have hsupport : ∀ᵐ Y ∂Measure.pi (fun _ : Fin d => P),
      Ψ Y (fun j => U j Y) ≠ 0 →
        ∀ k, (Y k : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0 := by
    filter_upwards [hfaces] with Y hY hne
    by_contra hnot
    have hz : (fun j => U j Y) = fun _ => 0 := funext fun j => (hY j).2 hnot
    exact hne (by rw [hz, hΨ Y])
  calc
    _ = ∫ Y, Ψ Y (fun j => U j Y)
        ∂Measure.pi (fun _ : Fin d => trialPhysicalMeasure) :=
      trial_cap_law_integral_eq κ hκ d (fun Y => Ψ Y (fun j => U j Y)) hsupport
    _ = _ := integral_congr_ae
      (hphysical.mono fun Y hY => congrArg (Ψ Y) (funext hY))

section

open scoped ContDiff

theorem trial_source_supported_smooth_profiles_positive
    (hNumerics :
      (∀ j : Fin outerOrderTwoBounds.length,
        physicalSourceOuterRoot 0 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((outerOrderTwoBounds.get j).2.1 : ℝ) / (10 : ℝ) ^ 18 ∧
        physicalSourceOuterFace 0 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((outerOrderTwoBounds.get j).2.2.1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (∀ j : Fin outerOrderFiveHalvesBounds.length,
        physicalSourceOuterRoot 1 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((outerOrderFiveHalvesBounds.get j).2.1 : ℝ) / (10 : ℝ) ^ 18 ∧
        physicalSourceOuterFace 1 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((outerOrderFiveHalvesBounds.get j).2.2.1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (∀ j : Fin innerBaseOrderTwoBounds.length,
        physicalSourceInnerMass 2 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((innerBaseOrderTwoBounds.get j).1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (∀ j : Fin innerBaseOrderFiveHalvesBounds.length,
        physicalSourceInnerMass 3 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((innerBaseOrderFiveHalvesBounds.get j).1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (∀ j : Fin innerEnlargedOrderTwoBounds.length,
        physicalSourceInnerMass 4 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((innerEnlargedOrderTwoBounds.get j).1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (∀ j : Fin innerEnlargedOrderFiveHalvesBounds.length,
        physicalSourceInnerMass 5 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((innerEnlargedOrderFiveHalvesBounds.get j).1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (23685317816 : ℝ) / (10 : ℝ) ^ 24 ≤ trialIH ∧
      trialIH ≤ (23685317890 : ℝ) / (10 : ℝ) ^ 24 ∧
      (90248755123 : ℝ) / (10 : ℝ) ^ 24 ≤ trialJLambdaH) :
    let κ : ℝ := (19037 / 100000) / (2624989 / 10000000)
    let μ₄₀ := Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)
    let μ₃₉ := Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)
    let κE : ℝ := exceptionalMassCoefficient 0 +
      exceptionalMassCoefficient 1
    let t : ℝ := 49599 / 50000
    let η : ℝ := 49599 / 20000000
    let R : ℝ → ℝ → ℝ → ℝ := fun u v₀ v₁ =>
      2 * u * v₀ - v₀ ^ 2 + 2 * (1 - κE) * t * (u - v₀) * (v₁ - v₀) -
        t ^ 2 * (v₁ - v₀) ^ 2 - η * (17 / 50 : ℝ) * (u - v₀) ^ 2 -
        η⁻¹ * κE * t ^ 2 * (v₁ - v₀) ^ 2
    let r : Fin 3 → ℝ := fun b =>
      (if b = 0 then 89563 else if b = 1 then 89953 else 98302) * (trialMesh : ℝ)
    ∃ (m : ℕ) (a : Fin (m + 2) → ℝ)
      (F : (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
      (H : Fin 3 → (Fin 39 → Fin (m + 1) → ℝ) → ℝ),
      StrictMono a ∧ a 0 = 0 ∧ a (Fin.last (m + 1)) = κ ∧
      ContDiff ℝ ∞ F ∧ HasCompactSupport F ∧
      (∀ b, ContDiff ℝ ∞ (H b) ∧ HasCompactSupport (H b) ∧
        ∀ v, 0 ≤ H b v ∧ H b v ≤ 1) ∧
      (∀ (b : Fin 3) (i : Fin 40),
        ContDiff ℝ ∞ (fun v => H b (i.removeNth v) * F v) ∧
          HasCompactSupport (fun v => H b (i.removeNth v) * F v)) ∧
      (∀ X : Fin 40 → FiniteMeasure ℝ,
        (∑ i, X i).restrict (Set.Ioc (0 : ℝ) κ) = ∑ i, X i →
        (∀ j : Fin (m + 1), 0 < a j.castSucc →
          fragmentBandMasses a (∑ i, X i) j = 0 ∨
            a j.castSucc < fragmentBandMasses a (∑ i, X i) j) →
        F (fun i => fragmentBandMasses a (X i)) ≠ 0 →
        physicalSourceOuterSupport X = 1 ∧
          (∑ i, ((X i).mass : ℝ)) < 98303 * (trialMesh : ℝ) ∧
          ∀ i, (X i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0) ∧
      (∀ (b : Fin 3) (Y : Fin 39 → FiniteMeasure ℝ),
        (∑ i, Y i).restrict (Set.Ioc (0 : ℝ) κ) = ∑ i, Y i →
        (∀ j : Fin (m + 1), 0 < a j.castSucc →
          fragmentBandMasses a (∑ i, Y i) j = 0 ∨
            a j.castSucc < fragmentBandMasses a (∑ i, Y i) j) →
        H b (fun i => fragmentBandMasses a (Y i)) ≠ 0 →
        (∀ i, (Y i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0) ∧
          (∑ i, ((Y i).mass : ℝ)) < r b ∧
          (b = 0 → physicalSourceInnerSupport 0 Y = 1 ∧ physicalSourceInnerSupport 1 Y = 1) ∧
          (b = 1 → physicalSourceInnerSupport 1 Y = 1)) ∧
      let f : (Fin 40 → FiniteMeasure ℝ) → ℝ :=
        fun X => F (fun i => fragmentBandMasses a (X i))
      let U : Fin 40 → (Fin 39 → FiniteMeasure ℝ) → ℝ := fun i Y =>
        ∫ Z : FiniteMeasure ℝ, f (i.insertNth Z Y) ∂trialPhysicalMeasure
      let H₀ : (Fin 39 → FiniteMeasure ℝ) → ℝ :=
        fun Y => H 0 (fun i => fragmentBandMasses a (Y i))
      let H₁ : (Fin 39 → FiniteMeasure ℝ) → ℝ :=
        fun Y => H 1 (fun i => fragmentBandMasses a (Y i))
      MemLp f 2 μ₄₀ ∧
        0 < (2624989 / 10 ^ 7 : ℝ) *
            ((∑ i : Fin 40, ∫ Y, R (U i Y) (H₀ Y * U i Y) (H₁ Y * U i Y) ∂μ₃₉) /
              trialPhysicalNormalizer) -
          (∫ X, f X ^ 2 ∂μ₄₀) / trialPhysicalNormalizer := by
  classical
  intro κ μ₄₀ μ₃₉ κE t η R r
  let M₀ : (Fin 39 → FiniteMeasure ℝ) → ℝ := fun Y =>
    trialBaseMask Y * physicalSourceInnerSupport 0 Y * physicalSourceInnerSupport 1 Y
  let M₁ : (Fin 39 → FiniteMeasure ℝ) → ℝ := fun Y =>
    trialEnlargedMask Y * physicalSourceInnerSupport 1 Y
  let Q := fun (f : (Fin 40 → FiniteMeasure ℝ) → ℝ)
      (H₀ H₁ : (Fin 39 → FiniteMeasure ℝ) → ℝ) =>
    (2624989 / 10 ^ 7 : ℝ) *
        ((∑ i : Fin 40, ∫ Y,
          let u := ∫ Z : FiniteMeasure ℝ, f (i.insertNth Z Y) ∂trialPhysicalMeasure
          R u (H₀ Y * u) (H₁ Y * u) ∂μ₃₉) / trialPhysicalNormalizer) -
      (∫ X, f X ^ 2 ∂μ₄₀) / trialPhysicalNormalizer
  let q₀ := Q trialSourceStepFunction M₀ M₁
  have hq₀ : 0 < q₀ :=
    (trial_actual_source_quadratic_positive hNumerics).2.trans_le
      trialSource_signed_reference_dominates
  obtain ⟨δ, hδ, hclose⟩ :=
    trialSource_signed_quadratic_l2_continuous (q₀ / 2) (half_pos hq₀)
  obtain ⟨m, a, F, H, ha, ha0, halast, hFsmooth, hFcompact, hHdata, hG,
      hFsource, hHsource, hFmem, hFerror, hHerror⟩ :=
    trial_source_supported_smooth_profiles_approx δ hδ
  let f : (Fin 40 → FiniteMeasure ℝ) → ℝ :=
    fun X => F (fun i => fragmentBandMasses a (X i))
  let H₀ : (Fin 39 → FiniteMeasure ℝ) → ℝ :=
    fun Y => H 0 (fun i => fragmentBandMasses a (Y i))
  let H₁ : (Fin 39 → FiniteMeasure ℝ) → ℝ :=
    fun Y => H 1 (fun i => fragmentBandMasses a (Y i))
  have hB : Measurable (fun Y : Fin 39 → FiniteMeasure ℝ =>
      fun i => fragmentBandMasses a (Y i)) :=
    measurable_pi_lambda _ fun i =>
      (measurable_fragmentBandMasses a).comp (measurable_pi_apply i)
  have hH₀ : Measurable H₀ := (hHdata 0).1.continuous.measurable.comp hB
  have hH₁ : Measurable H₁ := (hHdata 1).1.continuous.measurable.comp hB
  have hHunit (Y : Fin 39 → FiniteMeasure ℝ) :
      0 ≤ H₀ Y ∧ H₀ Y ≤ 1 ∧ 0 ≤ H₁ Y ∧ H₁ Y ≤ 1 :=
    ⟨((hHdata 0).2.2 _).1, ((hHdata 0).2.2 _).2,
      ((hHdata 1).2.2 _).1, ((hHdata 1).2.2 _).2⟩
  have hlargeκ : (trialLargestCap : ℝ) ≤ κ := by
    norm_num [κ, trialLargestCap, trialMesh]
  have hradial : ∀ᵐ X ∂μ₄₀,
      (2742997 / 2624989 : ℝ) < ∑ i : Fin 40, ((X i).mass : ℝ) → f X = 0 := by
    filter_upwards [trialPhysical_band_structured 40 κ hlargeκ a]
      with X hX hlarge
    by_contra hnonzero
    have hsmall := (hFsource X hX.1 hX.2 hnonzero).2.1
    have hcap : 98303 * (trialMesh : ℝ) ≤ (2742997 / 2624989 : ℝ) := by
      norm_num [trialMesh]
    exact (not_lt_of_ge hcap) (hlarge.trans hsmall)
  have hdiff : |Q f H₀ H₁ - q₀| < q₀ / 2 :=
    hclose f H₀ H₁ hFmem hH₀ hH₁ hHunit hradial hFerror
      (by simpa only [Fin.isValue, ↓reduceIte] using hHerror 0)
      (by
        simpa only [Fin.isValue, ite_eq_right (by decide : (1 : Fin 3) ≠ 0),
          ↓reduceIte] using hHerror 1)
  have hpositive : 0 < Q f H₀ H₁ := by
    have hlow := (abs_lt.mp hdiff).1
    linarith only [hlow, hq₀]
  exact ⟨m, a, F, H, ha, ha0, halast, hFsmooth, hFcompact, hHdata, hG,
    hFsource, hHsource, hFmem, hpositive⟩

end

open Classical in
theorem physicalSource_retained_row_parameter_ranges
    (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)) :
    let ω : ℝ := physicalSourceOmegaPrefix ν (t.val + 1)
    let δ : ℝ := (physicalSourceRho : ℝ) * (physicalSourceRow ν t.val).activation
    let τ : ℝ := 1 / (10 : ℝ) ^ 10
    let σ : ℝ := if ν = 0 then 100001 / 1000000 else 1 / 2 - 40481 / 100000 + τ
    0 < ω ∧ ω < 1 / 12 ∧ 0 < δ ∧ δ < 1 / 4 + ω ∧
      0 < σ ∧ σ < 1 / 2 ∧ 2 * ω < σ ∧
      68 * ω + 14 * δ < 1 ∧
      1 / 18 + 28 * ω / 9 + 2 * δ / 9 < σ ∧
      1 / 2 + 2 * ω < 2 / 3 ∧
      (physicalSourceOrder t.val = 1 → 54 * ω + 15 * δ + 5 * σ < 1) ∧
      (physicalSourceOrder t.val = 2 → 56 * ω + 16 * δ + 4 * σ < 1) ∧
      (ν = 0 → 1 / 10 < σ ∧
        (physicalSourceOrder t.val = 3 → 240 * ω + 80 * δ < 3)) ∧
      (ν = 1 →
        1 / 4 + 7 * ω + 2 * δ < 1058 / 3125 - τ ∧
        1 / 18 + 28 * ω / 9 + 2 * δ / 9 < 19 / 200 - τ ∧
        1 / 2 + 2 * ω < 59519 / 100000 - τ ∧
        (physicalSourceOrder t.val = 3 →
          72 * ω + 24 * δ < 1 ∧
          1 / 4 + 12 * ω + 4 * δ < 40481 / 100000 - τ ∧
          32 * ω + 10 * δ < 40481 / 100000 - τ)) := by
  intro ω δ τ σ
  have hρ : (0 : ℚ) < physicalSourceRho := by norm_num [physicalSourceRho]
  have htL : t.val + 1 ≤ physicalSourceLadderLength ν := by
    have ht := t.isLt
    fin_cases ν <;> norm_num [physicalSourceLadderLength] at ht ⊢ <;> omega
  have hprefix := physicalSource_first_hit_and_monotone ν
  have hωq : (0 : ℚ) < physicalSourceOmegaPrefix ν (t.val + 1) := by
    have h := hprefix.2.1
      (show (⟨0, Nat.succ_pos _⟩ : Fin (physicalSourceLadderLength ν + 1)) <
        ⟨t.val + 1, Nat.lt_succ_of_le htL⟩ from Nat.succ_pos _)
    simpa only [hprefix.1] using h
  have hω : 0 < ω := Rat.cast_pos.mpr hωq
  have hωupperq : physicalSourceOmegaPrefix ν (t.val + 1) ≤
      (if ν = 0 then 12499 / 1000000 else 253 / 20000 : ℚ) :=
    (hprefix.2.1.monotone
      (show (⟨t.val + 1, Nat.lt_succ_of_le htL⟩ :
          Fin (physicalSourceLadderLength ν + 1)) ≤
        Fin.last (physicalSourceLadderLength ν) from htL)).trans_eq hprefix.2.2.1
  have hωupper : ω ≤
      ((if ν = 0 then 12499 / 1000000 else 253 / 20000 : ℚ) : ℝ) :=
    Rat.cast_le.mpr hωupperq
  have hξ : (0 : ℚ) < (physicalSourceRow ν t.val).activation :=
    (by norm_num [trialMesh] : (0 : ℚ) < 2 * trialMesh).trans
      (physicalSource_cover_fixed_geometry.2.2 ν t).2.2.1
  have hδ : 0 < δ := mul_pos (Rat.cast_pos.mpr hρ) (Rat.cast_pos.mpr hξ)
  have hδq : physicalSourceRho * (physicalSourceRow ν t.val).activation =
      (physicalSourceAffine ν t.val).1 -
        (physicalSourceAffine ν t.val).2 * physicalSourceOmegaPrefix ν (t.val + 1) -
          (if ν = 0 then 1 / 1000000 else 1 / 10000000 : ℚ) := by
    change physicalSourceRho *
      (((physicalSourceAffine ν t.val).1 -
        (physicalSourceAffine ν t.val).2 * physicalSourceOmegaPrefix ν (t.val + 1) -
          (if ν = 0 then 1 / 1000000 else 1 / 10000000)) / physicalSourceRho) = _
    exact mul_div_cancel₀ _ hρ.ne'
  have hδeq : δ = ((physicalSourceAffine ν t.val).1 : ℝ) -
      ((physicalSourceAffine ν t.val).2 : ℝ) * ω -
        ((if ν = 0 then 1 / 1000000 else 1 / 10000000 : ℚ) : ℝ) := by
    simpa only [Rat.cast_mul, Rat.cast_sub] using
      congrArg (fun q : ℚ => (q : ℝ)) hδq
  have hωlow :
      (if ν = 1 ∧ physicalSourceOrder t.val = 3 then (9 / 1000 : ℝ) else 0) < ω := by
    by_cases hcase : ν = 1 ∧ physicalSourceOrder t.val = 3
    · rw [ite_eq_left hcase]
      obtain ⟨hν, horder⟩ := hcase
      subst ν
      have ht25 : 25 ≤ t.val + 1 := by
        by_cases ht12 : t.val < 12 <;> by_cases ht24 : t.val < 24 <;>
          simp [physicalSourceOrder, ht12, ht24] at horder
        omega
      have h25 : (9 / 1000 : ℚ) < physicalSourceOmegaPrefix 1 25 := by decide +kernel
      have hmono : physicalSourceOmegaPrefix 1 25 ≤
          physicalSourceOmegaPrefix 1 (t.val + 1) :=
        (physicalSource_first_hit_and_monotone 1).2.1.monotone
          (show (⟨25, by norm_num [physicalSourceLadderLength]⟩ :
              Fin (physicalSourceLadderLength 1 + 1)) ≤
            ⟨t.val + 1, Nat.lt_succ_of_le htL⟩ from ht25)
      change (9 / 1000 : ℝ) < (physicalSourceOmegaPrefix 1 (t.val + 1) : ℝ)
      have hcast : (((9 / 1000 : ℚ) : ℝ)) <
          (physicalSourceOmegaPrefix 1 (t.val + 1) : ℝ) :=
        Rat.cast_lt.mpr (h25.trans_le hmono)
      simpa only [Rat.cast_div, Rat.cast_ofNat] using hcast
    · rw [ite_eq_right hcase]
      exact hω
  have horder : physicalSourceOrder t.val = 1 ∨
      physicalSourceOrder t.val = 2 ∨ physicalSourceOrder t.val = 3 := by
    by_cases ht12 : t.val < 12 <;> by_cases ht24 : t.val < 24 <;>
      simp [physicalSourceOrder, ht12, ht24]
  rcases horder with horder | horder | horder <;> fin_cases ν
  all_goals
    norm_num [physicalSourceAffine, horder, σ, τ] at hδeq hωupper hωlow ⊢
    repeat' constructor
    all_goals linarith only [hω, hδ, hωupper, hδeq, hωlow]

open Classical in
theorem canonical40_sampled_profile_support
    {m : ℕ} (κ : ℝ) (hκ : 0 < κ) (a : Fin (m + 2) → ℝ)
    (F : (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
    (H : Fin 3 → (Fin 39 → Fin (m + 1) → ℝ) → ℝ)
    (hF : ∀ X : Fin 40 → FiniteMeasure ℝ,
      (∑ i, X i).restrict (Set.Ioc (0 : ℝ) κ) = ∑ i, X i →
      (∀ j : Fin (m + 1), 0 < a j.castSucc →
        fragmentBandMasses a (∑ i, X i) j = 0 ∨
          a j.castSucc < fragmentBandMasses a (∑ i, X i) j) →
      F (fun i => fragmentBandMasses a (X i)) ≠ 0 →
      physicalSourceOuterSupport X = 1 ∧
        (∑ i, ((X i).mass : ℝ)) < 98303 * (trialMesh : ℝ) ∧
        ∀ i, (X i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0)
    (hH : ∀ (b : Fin 3) (Y : Fin 39 → FiniteMeasure ℝ),
      (∑ i, Y i).restrict (Set.Ioc (0 : ℝ) κ) = ∑ i, Y i →
      (∀ j : Fin (m + 1), 0 < a j.castSucc →
        fragmentBandMasses a (∑ i, Y i) j = 0 ∨
          a j.castSucc < fragmentBandMasses a (∑ i, Y i) j) →
      H b (fun i => fragmentBandMasses a (Y i)) ≠ 0 →
      (∀ i, (Y i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0) ∧
        (∑ i, ((Y i).mass : ℝ)) <
          (if b = 0 then 89563 else if b = 1 then 89953 else 98302) * (trialMesh : ℝ) ∧
        (b = 0 → physicalSourceInnerSupport 0 Y = 1 ∧
          physicalSourceInnerSupport 1 Y = 1) ∧
        (b = 1 → physicalSourceInnerSupport 1 Y = 1)) :
    ∀ (W : ℕ) (R : ℝ), 1 < R →
      let q : ℕ := ∏ p ∈ fragmentPrimes W R κ, p
      let T : Finset (Fin 40 → ℕ) :=
        (Fintype.piFinset (fun _ : Fin 40 => q.divisors)).filter
          (fun r => Squarefree (∏ j, r j))
      ∀ r ∈ T,
        let X : Fin 40 → FiniteMeasure ℝ :=
          fun j => primeLogConfiguration R (r j)
        let v : Fin 40 → Fin (m + 1) → ℝ :=
          fun j => fragmentBandMasses a (X j)
        ((∑ j, X j).restrict (Set.Ioc (0 : ℝ) κ) = ∑ j, X j) ∧
        (∀ k : Fin (m + 1), 0 < a k.castSucc →
          fragmentBandMasses a (∑ j, X j) k = 0 ∨
            a k.castSucc < fragmentBandMasses a (∑ j, X j) k) ∧
        (F v ≠ 0 →
          physicalSourceOuterSupport X = 1 ∧
          (∑ j, ((X j).mass : ℝ)) < 98303 * (trialMesh : ℝ) ∧
          (∀ j, (X j : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0) ∧
          ((∏ j, r j : ℕ) : ℝ) < R ^ (98303 * (trialMesh : ℝ)) ∧
          ((∏ j, r j : ℕ) : ℝ) ≤ R ^ (2742997 / 2624989 : ℝ)) ∧
        ∀ (b : Fin 3) (i : Fin 40), H b (i.removeNth v) * F v ≠ 0 →
          (∀ j, (X (i.succAbove j) : Measure ℝ)
            (Set.Ioi (trialLargestCap : ℝ)) = 0) ∧
          (∑ j, ((X (i.succAbove j)).mass : ℝ)) <
            (if b = 0 then 89563 else if b = 1 then 89953 else 98302) * (trialMesh : ℝ) ∧
          (b = 0 → physicalSourceInnerSupport 0 (i.removeNth X) = 1 ∧
            physicalSourceInnerSupport 1 (i.removeNth X) = 1) ∧
          (b = 1 → physicalSourceInnerSupport 1 (i.removeNth X) = 1) ∧
          ((∏ j : Fin 39, r (i.succAbove j) : ℕ) : ℝ) <
            R ^ ((if b = 0 then 89563 else if b = 1 then 89953 else 98302) *
              (trialMesh : ℝ)) := by
  intro W R hR q T r hr X v
  have hdiv : ∀ j : Fin 40, r j ∈ q.divisors :=
    Fintype.mem_piFinset.mp (Finset.mem_filter.mp hr).1
  have hsf : Squarefree (∏ j, r j) := (Finset.mem_filter.mp hr).2
  have hrestrict (s : ℕ) (hs : s ∈ q.divisors) :
      (primeLogConfiguration R s).restrict (Set.Ioc (0 : ℝ) κ) =
        primeLogConfiguration R s := by
    have hd := (mem_fragment_divisors_iff W R κ
      (Real.one_le_rpow hR.le hκ.le) s).mp hs
    have hmark (p : ℕ) (hp : p ∈ s.primeFactors) :
        Real.log p / Real.log R ∈ Set.Ioc (0 : ℝ) κ := by
      have hprime := Nat.prime_of_mem_primeFactors hp
      have hpR : (p : ℝ) ≤ R ^ κ :=
        (Nat.cast_le.mpr ((Finset.le_sup (f := id) hp).trans (le_max_right 1 _))).trans
          hd.2.2
      refine ⟨div_pos (Real.log_pos (by exact_mod_cast hprime.one_lt))
        (Real.log_pos hR), ?_⟩
      exact (div_le_iff₀ (Real.log_pos hR)).mpr
        ((Real.le_rpow_iff_log_le (by exact_mod_cast hprime.pos)
          (zero_lt_one.trans hR)).mp hpR)
    apply FiniteMeasure.toMeasure_injective
    simp only [FiniteMeasure.restrict_measure_eq,
      primeLogConfiguration, FiniteMeasure.toMeasure_sum]
    change (Measure.restrictₗ (Set.Ioc (0 : ℝ) κ)) _ = _
    rw [map_sum]
    apply Finset.sum_congr rfl
    intro p hp
    change ((Real.log p / Real.log R).toNNReal • Measure.dirac (Real.log p / Real.log R)).restrict
      (Set.Ioc (0 : ℝ) κ) = _
    rw [Measure.restrict_smul, restrict_dirac, ite_eq_left (hmark p hp)]
    rfl
  have hstructured (d : ℕ) (s : Fin d → ℕ) (hs : ∀ j, s j ∈ q.divisors)
      (hsf : Squarefree (∏ j, s j)) :
      ((∑ j, primeLogConfiguration R (s j)).restrict
          (Set.Ioc (0 : ℝ) κ) =
        ∑ j, primeLogConfiguration R (s j)) ∧
      ∀ k : Fin (m + 1), 0 < a k.castSucc →
        fragmentBandMasses a
          (∑ j, primeLogConfiguration R (s j)) k = 0 ∨
        a k.castSucc < fragmentBandMasses a
          (∑ j, primeLogConfiguration R (s j)) k := by
    constructor
    · apply FiniteMeasure.toMeasure_injective
      simpa only [FiniteMeasure.restrict_measure_eq, FiniteMeasure.toMeasure_sum,
        Measure.restrict, map_sum] using
        Finset.sum_congr rfl (fun j (_ : j ∈ Finset.univ) =>
          congrArg (fun c : FiniteMeasure ℝ => (c : Measure ℝ)) (hrestrict (s j) (hs j)))
    · intro k hk
      simpa only [primeLogConfiguration_prod R Finset.univ s hsf,
        fragmentBandMasses] using
        primeLogConfiguration_restricted_mass_gap R (∏ j, s j)
          (a k.castSucc) (a k.succ) hk
  have hproduct (d : ℕ) (s : Fin d → ℕ) (hsf : Squarefree (∏ j, s j))
      (c : ℝ)
      (hmass : (∑ j, ((primeLogConfiguration R (s j)).mass : ℝ)) < c) :
      ((∏ j, s j : ℕ) : ℝ) < R ^ c := by
    apply (Real.logb_lt_iff_lt_rpow hR
      (Nat.cast_pos.mpr (Nat.pos_of_ne_zero hsf.ne_zero))).mp
    change logSize R (∏ j, s j) < c
    rw [← primeLogConfiguration_total_mass d R hR s hsf]
    exact hmass
  have hgood := hstructured 40 r hdiv hsf
  refine ⟨hgood.1, hgood.2, ?_, ?_⟩
  · intro hFne
    obtain ⟨hmask, hmass, hcap⟩ := hF X hgood.1 hgood.2 hFne
    have hsize := hproduct 40 r hsf (98303 * (trialMesh : ℝ)) hmass
    refine ⟨hmask, hmass, hcap, hsize, ?_⟩
    exact hsize.le.trans (Real.rpow_le_rpow_of_exponent_le hR.le
      (by norm_num [trialMesh] : 98303 * (trialMesh : ℝ) ≤ 2742997 / 2624989))
  · intro b i hGne
    have hretDvd : (∏ j : Fin 39, r (i.succAbove j)) ∣ ∏ j : Fin 40, r j := by
      rw [Fin.prod_univ_succAbove _ i]
      exact dvd_mul_left _ _
    have hretSf := hsf.squarefree_of_dvd hretDvd
    have hretGood := hstructured 39 (fun j => r (i.succAbove j))
      (fun j => hdiv (i.succAbove j)) hretSf
    have hHne : H b (fun j => fragmentBandMasses a
        (X (i.succAbove j))) ≠ 0 := (mul_ne_zero_iff.mp hGne).1
    obtain ⟨hcap, hmass, hold, hnew⟩ :=
      hH b (i.removeNth X) hretGood.1 hretGood.2 hHne
    exact ⟨hcap, hmass, hold, hnew,
      hproduct 39 (fun j => r (i.succAbove j)) hretSf _ hmass⟩

open Classical in
theorem physicalSource_sampled_erased_pair_source_classification
    (ν : Fin 2) (W : ℕ) (R κ Z₀ Z₁ : ℝ) (hR : 1 < R)
    (f g : (Fin 40 → ℕ) → ℝ) (i : Fin 40) (d e : Fin 39 → ℕ) :
    let q := ∏ p ∈ fragmentPrimes W R κ, p
    let T := (Fintype.piFinset (fun _ : Fin 40 => q.divisors)).filter
      (fun r => Squarefree (∏ j, r j))
    let y := ∑ r ∈ T, Finsupp.single r (f r / Z₀)
    let y' := ∑ r ∈ T, Finsupp.single r (g r / Z₁)
    let z : (Fin 39 → ℕ) →₀ ℝ :=
      y.sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
        (yr / ((r i).totient : ℝ)))
    let z' : (Fin 39 → ℕ) →₀ ℝ :=
      y'.sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
        (yr / ((r i).totient : ℝ)))
    (∀ r ∈ T, f r ≠ 0 →
      physicalSourceOuterSupport
        (fun j => primeLogConfiguration R (r j)) = 1 ∧
      logSize R (∏ j, r j) ≤ 98303 * (trialMesh : ℝ)) →
    (∀ r ∈ T, g r ≠ 0 →
      physicalSourceInnerSupport ν
        (fun j => primeLogConfiguration R (r (i.succAbove j))) = 1 ∧
      logSize R (∏ j : Fin 39, r (i.succAbove j)) ≤
        (if ν = 0 then 89563 else 89953) * (trialMesh : ℝ)) →
    selbergCoefficient z d ≠ 0 →
    selbergCoefficient z' e ≠ 0 →
      Squarefree (∏ j, d j) ∧ (∏ j, d j).Coprime W ∧ (∏ j, d j) ∣ q ∧
      Squarefree (∏ j, e j) ∧ (∏ j, e j).Coprime W ∧ (∏ j, e j) ∣ q ∧
      ((Nat.lcm (∏ j, d j) (∏ j, e j) : ℝ) ≤
          R ^ ((((1 / 2) / physicalSourceRho : ℚ) : ℝ)) ∨
        ∃ t : Fin (if ν = 0 then 28 else 39),
          R ^ ((physicalSourceRow ν t.val).lowerBand : ℝ) <
            (Nat.lcm (∏ j, d j) (∏ j, e j) : ℝ) ∧
          (Nat.lcm (∏ j, d j) (∏ j, e j) : ℝ) ≤
            R ^ ((physicalSourceRow ν t.val).upperBand : ℝ) ∧
          ∃ hξ : 1 ≤ R ^ ((physicalSourceRow ν t.val).activation : ℝ),
            Nonempty (DenseDivisibilityWitness
              ⟨R ^ ((physicalSourceRow ν t.val).activation : ℝ), hξ⟩
              (physicalSourceRow ν t.val).order (Nat.lcm (∏ j, d j) (∏ j, e j)))) := by
  intro q T y y' z z' hf hg hd he
  obtain ⟨hD, hDW, hDq, r, hr, hfr, hdr⟩ :=
    selberg_sampled_erased_coefficient_presieve W R κ Z₀ f i d hd
  obtain ⟨hE, hEW, hEq, s, hs, hgs, hes⟩ :=
    selberg_sampled_erased_coefficient_presieve W R κ Z₁ g i e he
  have hrSf : Squarefree (∏ j, r j) := (Finset.mem_filter.mp hr).2
  have hsSf : Squarefree (∏ j, s j) := (Finset.mem_filter.mp hs).2
  have hret (r : Fin 40 → ℕ) :
      (∏ j : Fin 39, r (i.succAbove j)) ∣ ∏ j : Fin 40, r j := by
    rw [Fin.prod_univ_succAbove _ i]
    exact dvd_mul_left _ _
  have hDr : (∏ j, d j) ∣ ∏ j : Fin 40, r j :=
    (Finset.prod_dvd_prod_of_dvd d (fun j => r (i.succAbove j))
      (fun j _ => hdr j)).trans (hret r)
  have hEs : (∏ j, e j) ∣ ∏ j : Fin 39, s (i.succAbove j) :=
    Finset.prod_dvd_prod_of_dvd e (fun j => s (i.succAbove j)) (fun j _ => hes j)
  have hsRetSf : Squarefree (∏ j : Fin 39, s (i.succAbove j)) :=
    hsSf.squarefree_of_dvd (hret s)
  have hDsize : logSize R (∏ j, d j) ≤ 98303 * (trialMesh : ℝ) :=
    (Real.logb_le_logb_of_le hR
      (Nat.cast_pos.mpr (Nat.pos_of_ne_zero hD.ne_zero))
      (Nat.cast_le.mpr (Nat.le_of_dvd (Nat.pos_of_ne_zero hrSf.ne_zero) hDr))).trans
        (hf r hr hfr).2
  have hEsize : logSize R (∏ j, e j) ≤
      (if ν = 0 then 89563 else 89953) * (trialMesh : ℝ) :=
    (Real.logb_le_logb_of_le hR
      (Nat.cast_pos.mpr (Nat.pos_of_ne_zero hE.ne_zero))
      (Nat.cast_le.mpr (Nat.le_of_dvd (Nat.pos_of_ne_zero hsRetSf.ne_zero) hEs))).trans
        (hg s hs hgs).2
  refine ⟨hD, hDW, hDq, hE, hEW, hEq, ?_⟩
  rcases physicalSource_actual_lcm_row_of_radii ν R hR
      (∏ j, d j) (∏ j, e j) hD hE hDsize hEsize with hbase | ⟨t, hlo, hhi⟩
  · exact Or.inl hbase
  · right
    refine ⟨t, hlo, hhi, ?_⟩
    have hdFull : selbergCoefficient y (i.insertNth 1 d) ≠ 0 := by
      rw [← selbergCoefficient_weighted_erase i y d]
      exact hd
    exact physicalSource_sampled_erased_pair_actual_lcm_dense ν t W R κ Z₀ Z₁ hR
      f g i d e (fun r hr hfr => (hf r hr hfr).1)
      (fun s hs hgs => (hg s hs hgs).1) hdFull he hlo

open Classical in
theorem physicalSourceRow_strict_presieve_retreat
    (ν : Fin 2) (t : Fin (if ν = 0 then 28 else 39)) :
    let row := physicalSourceRow ν t.val
    let ρ : ℝ := 2624989 / 10000000
    ∃ θ δ ε : ℝ,
      0 < θ ∧ θ < 1 / 2 + 2 * (physicalSourceOmegaPrefix ν (t.val + 1) : ℝ) ∧
      0 < δ ∧ δ < (physicalSourceRho : ℝ) * (row.activation : ℝ) ∧
      0 < ε ∧
      ∀ x : ℝ, 1 < x → ∀ W D E : ℕ,
        0 < W → (W : ℝ) ≤ x ^ ε → D.Coprime W → E.Coprime W →
        (∃ hY : 1 ≤ (x ^ ρ) ^ (row.activation : ℝ),
          Nonempty (DenseDivisibilityWitness
            ⟨(x ^ ρ) ^ (row.activation : ℝ), hY⟩ row.order (D.lcm E))) →
        (D.lcm E : ℝ) ≤ (x ^ ρ) ^ (row.upperBand : ℝ) →
        ∃ hδ : 1 ≤ x ^ δ,
          Nonempty (DenseDivisibilityWitness
            ⟨x ^ δ, hδ⟩ row.order (W.lcm (D.lcm E))) ∧
          (W.lcm (D.lcm E) : ℝ) ≤ x ^ θ := by
  intro row ρ
  have hρ : 0 < ρ := by norm_num [ρ]
  have hρf : (0 : ℝ) < physicalSourceRho := by norm_num [physicalSourceRho]
  have hgap : 0 < (physicalSourceRho : ℝ) - ρ := by norm_num [physicalSourceRho, ρ]
  have htL : t.val + 1 ≤ physicalSourceLadderLength ν := by
    have ht := t.isLt
    fin_cases ν <;> norm_num [physicalSourceLadderLength] at ht ⊢ <;> omega
  have hprefix := physicalSource_first_hit_and_monotone ν
  have hω : (0 : ℚ) < physicalSourceOmegaPrefix ν (t.val + 1) := by
    have hh := hprefix.2.1
      (show (⟨0, Nat.succ_pos _⟩ : Fin (physicalSourceLadderLength ν + 1)) <
        ⟨t.val + 1, Nat.lt_succ_of_le htL⟩ from Nat.succ_pos _)
    simpa only [hprefix.1] using hh
  have hupper : 0 < (row.upperBand : ℝ) := by
    change (0 : ℝ) < (((1 / 2 + 2 * physicalSourceOmegaPrefix ν (t.val + 1)) /
      physicalSourceRho : ℚ) : ℝ)
    exact_mod_cast div_pos (by positivity)
      (by norm_num [physicalSourceRho] : (0 : ℚ) < physicalSourceRho)
  have hactivation : 0 < (row.activation : ℝ) := by
    have hgeom := (physicalSource_cover_fixed_geometry.2.2 ν t).2.2.1
    exact_mod_cast (by norm_num [trialMesh] : (0 : ℚ) < 2 * trialMesh).trans hgeom
  have hθeq : (physicalSourceRho : ℝ) * (row.upperBand : ℝ) =
      1 / 2 + 2 * (physicalSourceOmegaPrefix ν (t.val + 1) : ℝ) := by
    change (physicalSourceRho : ℝ) *
      (((1 / 2 + 2 * physicalSourceOmegaPrefix ν (t.val + 1)) /
        physicalSourceRho : ℚ) : ℝ) = _
    push_cast
    field_simp [hρf.ne']
  let ρmid : ℝ := (ρ + (physicalSourceRho : ℝ)) / 2
  let θ : ℝ := ρmid * (row.upperBand : ℝ)
  let δ : ℝ := ρmid * (row.activation : ℝ)
  let ε : ℝ := min (((physicalSourceRho : ℝ) - ρ) * (row.upperBand : ℝ) / 4)
    (ρ * (row.activation : ℝ) / 2)
  have hmid : ρ < ρmid ∧ ρmid < (physicalSourceRho : ℝ) :=
    ⟨left_lt_add_div_two.mpr (sub_pos.mp hgap),
      add_div_two_lt_right.mpr (sub_pos.mp hgap)⟩
  have hθ : 0 < θ := mul_pos (hρ.trans hmid.1) hupper
  have hδ : 0 < δ := mul_pos (hρ.trans hmid.1) hactivation
  have hε : 0 < ε := lt_min
    (div_pos (mul_pos hgap hupper) (by norm_num))
    (div_pos (mul_pos hρ hactivation) zero_lt_two)
  refine ⟨θ, δ, ε, hθ, ?_, hδ, ?_, hε, ?_⟩
  · rw [← hθeq]
    exact mul_lt_mul_of_pos_right hmid.2 hupper
  · exact mul_lt_mul_of_pos_right hmid.2 hactivation
  · intro x hx W D E hW hWsize hDW hEW hN hNsize
    obtain ⟨hY, hN⟩ := hN
    have hx0 : 0 < x := zero_lt_one.trans hx
    have hεact : ε ≤ ρ * (row.activation : ℝ) :=
      (min_le_right _ _).trans (half_le_self (mul_nonneg hρ.le hactivation.le))
    have hWY : (W : ℝ) ≤ (x ^ ρ) ^ (row.activation : ℝ) := by
      rw [← Real.rpow_mul hx0.le]
      exact hWsize.trans (Real.rpow_le_rpow_of_exponent_le hx.le hεact)
    have hpresieve := denseDivisibility_presieve_lcm
      hN hW hWY hDW hEW
    refine ⟨Real.one_le_rpow hx.le hδ.le, ?_, ?_⟩
    · apply denseDivisibility_mono_scale _ hpresieve
      change (x ^ ρ) ^ (row.activation : ℝ) ≤ x ^ δ
      rw [← Real.rpow_mul hx0.le]
      exact Real.rpow_le_rpow_of_exponent_le hx.le
        (mul_le_mul_of_nonneg_right hmid.1.le hactivation.le)
    · have hcop : W.Coprime (D.lcm E) :=
        (hDW.symm.mul_right hEW.symm).coprime_dvd_right (Nat.lcm_dvd_mul D E)
      have he : ε + ρ * (row.upperBand : ℝ) ≤ θ := by
        have hεbound := min_le_left
          (((physicalSourceRho : ℝ) - ρ) * (row.upperBand : ℝ) / 4)
          (ρ * (row.activation : ℝ) / 2)
        change ε ≤ _ at hεbound
        dsimp only [θ, ρmid]
        norm_num [ρ, physicalSourceRho] at hεbound ⊢
        linarith only [hεbound, hupper]
      calc
        (W.lcm (D.lcm E) : ℝ) = (W : ℝ) * (D.lcm E : ℝ) := by
          rw [hcop.lcm_eq_mul, Nat.cast_mul]
        _ ≤ x ^ ε * (x ^ ρ) ^ (row.upperBand : ℝ) :=
          mul_le_mul hWsize hNsize (Nat.cast_nonneg _) (Real.rpow_nonneg hx0.le ε)
        _ = x ^ (ε + ρ * (row.upperBand : ℝ)) := by
          rw [← Real.rpow_mul hx0.le, Real.rpow_add hx0]
        _ ≤ x ^ θ := Real.rpow_le_rpow_of_exponent_le hx.le he

open Classical in
theorem physicalSource_common_self_parameters :
    let ωs : ℝ := 31 / 10000
    let δs : ℝ := 21319 / 800000
    let σp : ℝ := 100001 / 1000000
    let τ : ℝ := 1 / 10000000000
    let σm : ℝ := 1 / 2 - 40481 / 100000 + τ
    (0 < ωs ∧ ωs < 1 / 12 ∧ ωs < 1 / 4) ∧
      (0 < δs ∧ δs < 1 / 4 + ωs) ∧
      (1 / 10 < σp ∧ σp < 1 / 2 ∧ 2 * ωs < σp ∧
        56 * ωs + 16 * δs + 4 * σp < 1 ∧
        68 * ωs + 14 * δs < 1 ∧
        1 / 18 + 28 / 9 * ωs + 2 / 9 * δs < σp) ∧
      (0 < σm ∧ σm < 1 / 2 ∧ 2 * ωs < σm ∧
        56 * ωs + 16 * δs + 4 * σm < 1 ∧
        1 / 18 + 28 * ωs / 9 + 2 * δs / 9 < σm ∧
        1 / 4 + 7 * ωs + 2 * δs < 1058 / 3125 - τ ∧
        1 / 18 + 28 * ωs / 9 + 2 * δs / 9 < 19 / 200 - τ ∧
        1 / 2 + 2 * ωs < 59519 / 100000 - τ) := by
  norm_num

open Classical in
theorem physicalSource_common_self_strict_presieve_retreat :
    let ρ : ℝ := 2624989 / 10000000
    let δs : ℝ := 21319 / 800000
    let ξs : ℝ := (((21319 / 800000 : ℚ) / physicalSourceRho) : ℝ)
    let T : ℝ := physicalSourceInnerRadius 1
    let θsrc : ℝ := 1 / 2 + 2 * (31 / 10000)
    let δ0 : ℝ := ((ρ + (physicalSourceRho : ℝ)) / 2) * ξs
    let θ0 : ℝ := (2 * ρ * T + θsrc) / 2
    let ε : ℝ := min ((θsrc - 2 * ρ * T) / 4) (ρ * ξs / 2)
    0 < δ0 ∧ δ0 < δs ∧ 0 < θ0 ∧ θ0 < θsrc ∧ 0 < ε ∧
      ∀ x : ℝ, 1 < x → ∀ W D E : ℕ,
        0 < W → (W : ℝ) ≤ x ^ ε → D.Coprime W → E.Coprime W →
        (∃ hY : 1 ≤ (x ^ ρ) ^ ξs,
          Nonempty (DenseDivisibilityWitness
            ⟨(x ^ ρ) ^ ξs, hY⟩ 2 (D.lcm E))) →
        (D.lcm E : ℝ) ≤ (x ^ ρ) ^ (2 * T) →
        ∃ hδ : 1 ≤ x ^ δ0,
          Nonempty (DenseDivisibilityWitness
            ⟨x ^ δ0, hδ⟩ 2 (W.lcm (D.lcm E))) ∧
          (W.lcm (D.lcm E) : ℝ) ≤ x ^ θ0 := by
  intro ρ δs ξs T θsrc δ0 θ0 ε
  have hconstants : 0 < δ0 ∧ δ0 < δs ∧ 0 < θ0 ∧ θ0 < θsrc ∧ 0 < ε ∧
      ε ≤ ρ * ξs ∧ ρ * ξs ≤ δ0 ∧ ε + ρ * (2 * T) ≤ θ0 := by
    norm_num [δ0, θ0, ε, ξs, T, δs, θsrc, ρ,
      physicalSourceRho, physicalSourceInnerRadius]
  obtain ⟨hδ0, hδs, hθ0, hθsrc, hε, hεact, hδact, hlevel⟩ := hconstants
  refine ⟨hδ0, hδs, hθ0, hθsrc, hε, ?_⟩
  intro x hx W D E hW hWsize hDW hEW hN hNsize
  obtain ⟨hY, hN⟩ := hN
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hWY : (W : ℝ) ≤ (x ^ ρ) ^ ξs := by
    rw [← Real.rpow_mul hx0.le]
    exact hWsize.trans (Real.rpow_le_rpow_of_exponent_le hx.le hεact)
  have hpresieve := denseDivisibility_presieve_lcm
    hN hW hWY hDW hEW
  refine ⟨Real.one_le_rpow hx.le hδ0.le, ?_, ?_⟩
  · apply denseDivisibility_mono_scale _ hpresieve
    change (x ^ ρ) ^ ξs ≤ x ^ δ0
    rw [← Real.rpow_mul hx0.le]
    exact Real.rpow_le_rpow_of_exponent_le hx.le hδact
  · have hcop : W.Coprime (D.lcm E) :=
      (hDW.symm.mul_right hEW.symm).coprime_dvd_right (Nat.lcm_dvd_mul D E)
    calc
      (W.lcm (D.lcm E) : ℝ) = (W : ℝ) * (D.lcm E : ℝ) := by
        rw [hcop.lcm_eq_mul, Nat.cast_mul]
      _ ≤ x ^ ε * (x ^ ρ) ^ (2 * T) :=
        mul_le_mul hWsize hNsize (Nat.cast_nonneg _) (Real.rpow_nonneg hx0.le ε)
      _ = x ^ (ε + ρ * (2 * T)) := by
        rw [← Real.rpow_mul hx0.le, Real.rpow_add hx0]
      _ ≤ x ^ θ0 := Real.rpow_le_rpow_of_exponent_le hx.le hlevel

open Classical in
theorem physicalSource_base_strict_presieve_retreat :
    let ρ : ℝ := 2624989 / 10000000
    let B : ℝ := (((1 / 2 : ℚ) / physicalSourceRho) : ℝ)
    let θb : ℝ := (ρ * B + 1 / 2) / 2
    let εb : ℝ := (1 / 2 - ρ * B) / 4
    0 < θb ∧ ρ * B < θb ∧ θb < 1 / 2 ∧ 0 < εb ∧
      ∀ x : ℝ, 1 < x → ∀ W D E : ℕ,
        0 < W → 0 < D → 0 < E → (W : ℝ) ≤ x ^ εb →
        (D.lcm E : ℝ) ≤ (x ^ ρ) ^ B →
        (W.lcm (D.lcm E) : ℝ) ≤ x ^ θb := by
  intro ρ B θb εb
  have hconstants : 0 < θb ∧ ρ * B < θb ∧ θb < 1 / 2 ∧ 0 < εb ∧
      εb + ρ * B ≤ θb := by
    norm_num [θb, εb, B, ρ, physicalSourceRho]
  obtain ⟨hθb, hβ, hθhalf, hεb, hlevel⟩ := hconstants
  refine ⟨hθb, hβ, hθhalf, hεb, ?_⟩
  intro x hx W D E hW hD hE hWsize hNsize
  have hx0 : 0 < x := zero_lt_one.trans hx
  have hlcm : W.lcm (D.lcm E) ≤ W * (D.lcm E) :=
    Nat.lcm_le_mul hW (Nat.lcm_pos hD hE)
  calc
    (W.lcm (D.lcm E) : ℝ) ≤ (W : ℝ) * (D.lcm E : ℝ) := by exact_mod_cast hlcm
    _ ≤ x ^ εb * (x ^ ρ) ^ B :=
      mul_le_mul hWsize hNsize (Nat.cast_nonneg _) (Real.rpow_nonneg hx0.le εb)
    _ = x ^ (εb + ρ * B) := by
      rw [← Real.rpow_mul hx0.le, Real.rpow_add hx0]
    _ ≤ x ^ θb := Real.rpow_le_rpow_of_exponent_le hx.le hlevel

theorem clipped_literal_minorant_discrepancy_error
    (h : ℕ) (θ : ℝ) (J : ℕ) (hθ : 0 < θ) (hθsmall : θ < 1) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ a : ℕ → ℕ,
        let ρ : ℕ → ℝ := fun n => (if n.Prime then 1 else 0) -
          exceptionalPrimeDefect x 0 n -
          exceptionalPrimeDefect x 1 n
        let u : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
          Finsupp.single n (ρ n : ℂ)
        let v : ℕ →₀ ℂ := ∑ n ∈ Finset.Icc ⌈x + (h : ℝ)⌉₊ ⌊2 * x⌋₊,
          Finsupp.single n (ρ n : ℂ)
        (∑ q ∈ Finset.Icc 1 ⌊x ^ θ⌋₊, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy (v - u) q (a q)‖) ≤
            K * x / (Real.log x) ^ A := by
  classical
  intro A _hA
  let ε : ℝ := (1 - θ) / 2
  let β : ℝ := θ + ε
  let γ : ℝ := 1 - β
  have hε : 0 < ε := by dsimp only [ε]; linarith only [hθsmall]
  have hγ : 0 < γ := by dsimp only [γ, β, ε]; linarith only [hθsmall]
  obtain ⟨Cq, hCq, hdivisor⟩ := exists_divisorPower_bound J hε
  obtain ⟨Xp, hpoint⟩ := Filter.eventually_atTop.mp
    eventually_literal_minorant_pointwise
  obtain ⟨Xlog, hXlog⟩ := Filter.eventually_atTop.mp
    ((isLittleO_log_rpow_rpow_atTop A hγ).bound zero_lt_one)
  let F : ℝ := 2 * ((h : ℝ) + 1) * 6251
  let K : ℝ := F * Cq
  let X : ℝ := max (max Xp Xlog) 2
  have hF : 0 < F := by dsimp only [F]; positivity
  have hK : 0 < K := mul_pos hF hCq
  refine ⟨K, X, hK, (by norm_num : (1 : ℝ) < 2).trans_le (le_max_right _ _), ?_⟩
  intro x hx a ρ u v
  have hx2 : 2 ≤ x := (le_max_right _ _).trans hx
  have hx1 : 1 ≤ x := (by norm_num : (1 : ℝ) ≤ 2).trans hx2
  have hx0 : 0 < x := zero_lt_one.trans_le hx1
  have hxp : Xp ≤ x := (le_max_left _ _).trans ((le_max_left _ _).trans hx)
  have hxlog : Xlog ≤ x := (le_max_right _ _).trans ((le_max_left _ _).trans hx)
  let f : ℕ → ℂ := fun n => (ρ n : ℂ)
  let I := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
  let Iclip := Finset.Icc (⌈x⌉₊ + h) ⌊2 * x⌋₊
  let T := I \ Iclip
  have hv : v = ∑ n ∈ Iclip, Finsupp.single n (f n) := by
    dsimp only [v, Iclip, f]
    rw [Nat.ceil_add_natCast hx0.le]
  have hsubset : Iclip ⊆ I :=
    Finset.Icc_subset_Icc (Nat.le_add_right _ _) le_rfl
  have hTcard : T.card ≤ h := by
    calc
      T.card ≤ (Finset.Ico ⌈x⌉₊ (⌈x⌉₊ + h)).card := Finset.card_le_card (by
        intro n hn
        simp only [T, I, Iclip, Finset.mem_sdiff, Finset.mem_Icc, Finset.mem_Ico] at hn ⊢
        omega)
      _ = h := by simp
  have henv (n : ℕ) (hn : n ∈ T) : ‖f n‖ ≤ 6251 := by
    obtain ⟨hnlo, hnhi⟩ := Finset.mem_Icc.mp (Finset.mem_sdiff.mp hn).1
    have hnloReal : x ≤ (n : ℝ) := (Nat.le_ceil x).trans (Nat.cast_le.mpr hnlo)
    have hnhiReal : (n : ℝ) ≤ 2 * x :=
      (Nat.cast_le.mpr hnhi).trans (Nat.floor_le (by positivity))
    simpa only [f, ρ, Complex.norm_real, Real.norm_eq_abs] using
      (hpoint x hxp n hnloReal hnhiReal).2.2.2
  have hremoved : (∑ n ∈ T, Finsupp.single n (f n)) = u - v := by
    rw [hv]
    exact Finset.sum_sdiff_eq_sub hsubset
  have hdeltaSample : v - u = ∑ n ∈ T, Finsupp.single n (-f n) := by
    simpa only [Finsupp.single_neg, Finset.sum_neg_distrib, neg_sub] using
      congrArg Neg.neg hremoved.symm
  have hdelta (q b : ℕ) (hq : 0 < q) :
      ‖fullDiscrepancy (v - u) q b‖ ≤ F := by
    rw [hdeltaSample]
    calc
      _ ≤ 2 * ∑ n ∈ T, ‖-f n‖ :=
        norm_fullDiscrepancy_sample_le_two_sum_norm
          T (fun n => -f n) q b hq
      _ ≤ 2 * ∑ _n ∈ T, (6251 : ℝ) :=
        mul_le_mul_of_nonneg_left
          (Finset.sum_le_sum (fun n hn => by simpa only [norm_neg] using henv n hn))
          (by norm_num)
      _ = 2 * (T.card : ℝ) * 6251 := by
        simp only [Finset.sum_const, nsmul_eq_mul]
        ring
      _ ≤ 2 * (h : ℝ) * 6251 := by
        gcongr
      _ ≤ F := by dsimp only [F]; linarith
  have hweight (q : ℕ) (hq : q ∈ Finset.Icc 1 ⌊x ^ θ⌋₊) :
      (q.divisors.card : ℝ) ^ J ≤ Cq * x ^ ε := by
    obtain ⟨hqpos, hqle⟩ := Finset.mem_Icc.mp hq
    have hqpositive : 0 < q := hqpos
    have hqx : (q : ℝ) ≤ x :=
      ((Nat.cast_le.mpr hqle).trans
        (Nat.floor_le (zero_le_one.trans (Real.one_le_rpow hx1 hθ.le)))).trans
        (Real.rpow_le_self_of_one_le hx1 hθsmall.le)
    exact (hdivisor q hqpositive.ne').trans
      (mul_le_mul_of_nonneg_left
        (Real.rpow_le_rpow (Nat.cast_nonneg _) hqx hε.le) hCq.le)
  have hpower :
      (∑ q ∈ Finset.Icc 1 ⌊x ^ θ⌋₊, (q.divisors.card : ℝ) ^ J *
        ‖fullDiscrepancy (v - u) q (a q)‖) ≤ K * x ^ β := by
    calc
      _ ≤ ∑ _q ∈ Finset.Icc 1 ⌊x ^ θ⌋₊, (Cq * x ^ ε) * F := by
        apply Finset.sum_le_sum
        intro q hq
        exact mul_le_mul (hweight q hq) (hdelta q (a q) (Finset.mem_Icc.mp hq).1)
          (norm_nonneg _) (by positivity)
      _ = (⌊x ^ θ⌋₊ : ℝ) * ((Cq * x ^ ε) * F) := by simp
      _ ≤ x ^ θ * ((Cq * x ^ ε) * F) :=
        mul_le_mul_of_nonneg_right (Nat.floor_le (Real.rpow_nonneg hx0.le θ)) (by positivity)
      _ = K * x ^ β := by
        dsimp only [K, β]
        rw [Real.rpow_add hx0]
        ring
  have hlog0 : 0 < Real.log x :=
    Real.log_pos ((by norm_num : (1 : ℝ) < 2).trans_le hx2)
  have hlogbound : (Real.log x) ^ A ≤ x ^ γ := by
    simpa only [Real.norm_of_nonneg (Real.rpow_nonneg hlog0.le A),
      Real.norm_of_nonneg (Real.rpow_nonneg hx0.le γ), one_mul] using hXlog x hxlog
  have habsorb : x ^ β ≤ x / (Real.log x) ^ A := by
    apply (le_div_iff₀ (Real.rpow_pos_of_pos hlog0 A)).2
    calc
      x ^ β * (Real.log x) ^ A ≤ x ^ β * x ^ γ :=
        mul_le_mul_of_nonneg_left hlogbound (Real.rpow_nonneg hx0.le β)
      _ = x := by
        rw [← Real.rpow_add hx0, show β + γ = 1 by dsimp only [γ]; ring, Real.rpow_one]
  exact hpower.trans (by
    simpa only [mul_div_assoc] using mul_le_mul_of_nonneg_left habsorb hK.le)

theorem clipped_literal_minorant_mass_tendsto (h : ℕ) :
    Filter.Tendsto
      (fun x : ℝ => Real.log x / x *
        (∑ n ∈ Finset.Icc ⌈x + (h : ℝ)⌉₊ ⌊2 * x⌋₊,
          ((if n.Prime then (1 : ℝ) else 0) -
            exceptionalPrimeDefect x 0 n -
            exceptionalPrimeDefect x 1 n)))
      Filter.atTop (nhds (1 -
        (exceptionalMassCoefficient 0 +
          exceptionalMassCoefficient 1))) := by
  classical
  let f : ℝ → ℕ → ℝ := fun x n => (if n.Prime then 1 else 0) -
    exceptionalPrimeDefect x 0 n -
    exceptionalPrimeDefect x 1 n
  let m : ℝ → ℝ := fun x => ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊, f x n
  let c : ℝ → ℝ := fun x => ∑ n ∈ Finset.Icc ⌈x + (h : ℝ)⌉₊ ⌊2 * x⌋₊, f x n
  let E : ℝ → ℝ := fun x => Real.log x / x * (c x - m x)
  have hlog : Filter.Tendsto (fun x : ℝ => Real.log x / x)
      Filter.atTop (nhds 0) := Real.isLittleO_log_id_atTop.tendsto_div_nhds_zero
  have hmajorant : Filter.Tendsto (fun x : ℝ => Real.log x / x * ((h : ℝ) * 6251))
      Filter.atTop (nhds 0) := by
    simpa only [zero_mul] using hlog.mul_const ((h : ℝ) * 6251)
  have hE : Filter.Tendsto E Filter.atTop (nhds 0) := by
    apply squeeze_zero_norm' _ hmajorant
    filter_upwards [eventually_literal_minorant_pointwise,
      Filter.eventually_gt_atTop (1 : ℝ)] with x hpoint hx
    have hx0 : 0 < x := zero_lt_one.trans hx
    let I := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
    let Iclip := Finset.Icc (⌈x⌉₊ + h) ⌊2 * x⌋₊
    let T := I \ Iclip
    have hc : c x = ∑ n ∈ Iclip, f x n := by
      dsimp only [c, Iclip]
      rw [Nat.ceil_add_natCast hx0.le]
    have hsubset : Iclip ⊆ I :=
      Finset.Icc_subset_Icc (Nat.le_add_right _ _) le_rfl
    have hcard : T.card ≤ h := by
      calc
        T.card ≤ (Finset.Ico ⌈x⌉₊ (⌈x⌉₊ + h)).card := Finset.card_le_card (by
          intro n hn
          simp only [T, I, Iclip, Finset.mem_sdiff, Finset.mem_Icc, Finset.mem_Ico] at hn ⊢
          omega)
        _ = h := by simp
    have hsum : (∑ n ∈ T, f x n) = m x - c x := by
      rw [hc]
      exact Finset.sum_sdiff_eq_sub hsubset
    have hbounded : |c x - m x| ≤ (h : ℝ) * 6251 := by
      calc
        |c x - m x| = |∑ n ∈ T, f x n| := by rw [hsum, abs_sub_comm]
        _ ≤ ∑ n ∈ T, |f x n| := Finset.abs_sum_le_sum_abs (f x) T
        _ ≤ ∑ _n ∈ T, (6251 : ℝ) := by
          apply Finset.sum_le_sum
          intro n hn
          obtain ⟨hnlo, hnhi⟩ := Finset.mem_Icc.mp (Finset.mem_sdiff.mp hn).1
          have hnloReal : x ≤ (n : ℝ) := (Nat.le_ceil x).trans (Nat.cast_le.mpr hnlo)
          have hnhiReal : (n : ℝ) ≤ 2 * x :=
            (Nat.cast_le.mpr hnhi).trans (Nat.floor_le (by positivity))
          exact (hpoint n hnloReal hnhiReal).2.2.2
        _ = (T.card : ℝ) * 6251 := by simp
        _ ≤ (h : ℝ) * 6251 :=
          mul_le_mul_of_nonneg_right (by exact_mod_cast hcard) (by norm_num)
    have hratio : 0 ≤ Real.log x / x := div_nonneg (Real.log_nonneg hx.le) hx0.le
    calc
      ‖E x‖ = Real.log x / x * |c x - m x| := by
        simp only [E, Real.norm_eq_abs, abs_mul, abs_of_nonneg hratio]
      _ ≤ Real.log x / x * ((h : ℝ) * 6251) :=
        mul_le_mul_of_nonneg_left hbounded hratio
  convert hE.add literal_minorant_closed_true_mass.2.2.2 using 1
  · funext x
    dsimp only [E, c, m, f]
    ring
  · simp

section

open scoped ContDiff

theorem canonical40_correction_profile_data
    {m : ℕ} (a : Fin (m + 2) → ℝ)
    (F : (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
    (H : Fin 3 → (Fin 39 → Fin (m + 1) → ℝ) → ℝ)
    (hF : ContDiff ℝ ∞ F) (hFc : HasCompactSupport F)
    (hH : ∀ b, ContDiff ℝ ∞ (H b) ∧ HasCompactSupport (H b) ∧
      ∀ v, 0 ≤ H b v ∧ H b v ≤ 1)
    (hG : ∀ (b : Fin 3) (i : Fin 40),
      ContDiff ℝ ∞ (fun v => H b (i.removeNth v) * F v) ∧
        HasCompactSupport (fun v => H b (i.removeNth v) * F v)) :
    let κ : ℝ := (19037 / 100000) / (2624989 / 10000000)
    let ρ : ℝ := 2624989 / 10000000
    (∀ X : Fin 40 → FiniteMeasure ℝ,
      (∑ i, X i).restrict (Set.Ioc (0 : ℝ) κ) = ∑ i, X i →
      (∀ j : Fin (m + 1), 0 < a j.castSucc →
        fragmentBandMasses a (∑ i, X i) j = 0 ∨
          a j.castSucc < fragmentBandMasses a (∑ i, X i) j) →
      F (fun i => fragmentBandMasses a (X i)) ≠ 0 →
      physicalSourceOuterSupport X = 1 ∧
        (∑ i, ((X i).mass : ℝ)) < 98303 * (trialMesh : ℝ) ∧
        ∀ i, (X i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0) →
    (∀ (b : Fin 3) (Y : Fin 39 → FiniteMeasure ℝ),
      (∑ i, Y i).restrict (Set.Ioc (0 : ℝ) κ) = ∑ i, Y i →
      (∀ j : Fin (m + 1), 0 < a j.castSucc →
        fragmentBandMasses a (∑ i, Y i) j = 0 ∨
          a j.castSucc < fragmentBandMasses a (∑ i, Y i) j) →
      H b (fun i => fragmentBandMasses a (Y i)) ≠ 0 →
      (∀ i, (Y i : Measure ℝ) (Set.Ioi (trialLargestCap : ℝ)) = 0) ∧
        (∑ i, ((Y i).mass : ℝ)) <
          (if b = 0 then 89563 else if b = 1 then 89953 else 98302) * (trialMesh : ℝ) ∧
        (b = 0 → physicalSourceInnerSupport 0 Y = 1 ∧ physicalSourceInnerSupport 1 Y = 1) ∧
        (b = 1 → physicalSourceInnerSupport 1 Y = 1)) →
    let G : Fin 3 → Fin 40 → (Fin 40 → Fin (m + 1) → ℝ) → ℝ :=
      fun b i v => H b (i.removeNth v) * F v
    let D : Fin 40 → (Fin 40 → Fin (m + 1) → ℝ) → ℝ :=
      fun i v => G 1 i v - G 0 i v
    Measurable F ∧
    (∀ b i, ContDiff ℝ ∞ (G b i) ∧ HasCompactSupport (G b i) ∧ Measurable (G b i)) ∧
    (∀ i, ContDiff ℝ ∞ (D i) ∧ HasCompactSupport (D i) ∧ Measurable (D i)) ∧
    (∀ b i v, G b i v ≠ 0 → F v ≠ 0) ∧
    (∀ i v, D i v ≠ 0 → F v ≠ 0) ∧
    ∃ C : ℝ, 0 < C ∧ (∀ v, |F v| ≤ C) ∧
      (∀ b i v, |G b i v| ≤ C) ∧ (∀ i v, |D i v| ≤ C) ∧
      (∀ (W : ℕ) (R : ℝ), 1 < R →
        let q : ℕ := ∏ p ∈ fragmentPrimes W R κ, p
        let T : Finset (Fin 40 → ℕ) :=
          (Fintype.piFinset (fun _ : Fin 40 => q.divisors)).filter
            (fun r => Squarefree (∏ j, r j))
        ∀ r ∈ T,
          let X : Fin 40 → FiniteMeasure ℝ :=
            fun j => primeLogConfiguration R (r j)
          let v : Fin 40 → Fin (m + 1) → ℝ :=
            fun j => fragmentBandMasses a (X j)
          (F v ≠ 0 → physicalSourceOuterSupport X = 1 ∧
            logSize R (∏ j, r j) ≤ 98303 * (trialMesh : ℝ) ∧
            ((∏ j, r j : ℕ) : ℝ) ≤ R ^ (2742997 / 2624989 : ℝ) ∧
            ((∏ j, r j : ℕ) : ℝ) ≤ R ^ ((11 / 40 : ℝ) / ρ)) ∧
          ∀ i : Fin 40,
            (G 0 i v ≠ 0 → physicalSourceOuterSupport X = 1 ∧
              logSize R (∏ j, r j) ≤ 98303 * (trialMesh : ℝ) ∧
              physicalSourceInnerSupport 0 (i.removeNth X) = 1 ∧
              physicalSourceInnerSupport 1 (i.removeNth X) = 1 ∧
              logSize R (∏ j : Fin 39, r (i.succAbove j)) ≤ 89563 * (trialMesh : ℝ) ∧
              logSize R (∏ j : Fin 39, r (i.succAbove j)) ≤ (physicalSourceInnerRadius 1 : ℝ) ∧
              ((∏ j, r j : ℕ) : ℝ) ≤ R ^ ((11 / 40 : ℝ) / ρ)) ∧
            (D i v ≠ 0 → physicalSourceInnerSupport 1 (i.removeNth X) = 1 ∧
              logSize R (∏ j : Fin 39, r (i.succAbove j)) ≤ 89953 * (trialMesh : ℝ) ∧
              logSize R (∏ j : Fin 39, r (i.succAbove j)) ≤ (physicalSourceInnerRadius 1 : ℝ))) ∧
      let ν : Measure (Fin (m + 1) → ℝ) :=
        ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
          Measure.map (fragmentBandMasses a)
            (fragmentLaw κ)
      let UF : Fin 40 → (Fin 39 → Fin (m + 1) → ℝ) → ℝ := fun i Y =>
        ∫ z : Fin (m + 1) → ℝ, F (i.insertNth z Y) ∂ν
      let V₀ : Fin 40 → (Fin 39 → Fin (m + 1) → ℝ) → ℝ := fun i Y =>
        ∫ z : Fin (m + 1) → ℝ, G 0 i (i.insertNth z Y) ∂ν
      let V₁ : Fin 40 → (Fin 39 → Fin (m + 1) → ℝ) → ℝ := fun i Y =>
        ∫ z : Fin (m + 1) → ℝ, G 1 i (i.insertNth z Y) ∂ν
      let ED : Fin 40 → (Fin 39 → Fin (m + 1) → ℝ) → ℝ := fun i Y =>
        ∫ z : Fin (m + 1) → ℝ, D i (i.insertNth z Y) ∂ν
      ∀ i : Fin 40,
        (∀ Y, ED i Y = V₁ i Y - V₀ i Y) ∧
        (∫ Y, 2 * UF i Y * V₀ i Y - V₀ i Y ^ 2 ∂Measure.pi (fun _ : Fin 39 => ν)) =
          2 * (∫ Y, UF i Y * V₀ i Y ∂Measure.pi (fun _ : Fin 39 => ν)) -
            (∫ Y, V₀ i Y ^ 2 ∂Measure.pi (fun _ : Fin 39 => ν)) ∧
        (∫ Y, (UF i Y - V₀ i Y) * (V₁ i Y - V₀ i Y)
          ∂Measure.pi (fun _ : Fin 39 => ν)) =
          (∫ Y, UF i Y * ED i Y ∂Measure.pi (fun _ : Fin 39 => ν)) -
            (∫ Y, V₀ i Y * ED i Y ∂Measure.pi (fun _ : Fin 39 => ν)) ∧
        (∫ Y, (V₁ i Y - V₀ i Y) ^ 2 ∂Measure.pi (fun _ : Fin 39 => ν)) =
          ∫ Y, ED i Y ^ 2 ∂Measure.pi (fun _ : Fin 39 => ν) := by
  classical
  intro κ ρ hFsource hHsource G D
  have hGdata (b : Fin 3) (i : Fin 40) :
      ContDiff ℝ ∞ (G b i) ∧ HasCompactSupport (G b i) ∧ Measurable (G b i) :=
    ⟨(hG b i).1, (hG b i).2, (hG b i).1.continuous.measurable⟩
  have hDdata (i : Fin 40) :
      ContDiff ℝ ∞ (D i) ∧ HasCompactSupport (D i) ∧ Measurable (D i) := by
    have hd : ContDiff ℝ ∞ (D i) := (hGdata 1 i).1.sub (hGdata 0 i).1
    exact ⟨hd, (hGdata 1 i).2.1.sub (hGdata 0 i).2.1, hd.continuous.measurable⟩
  have hGne (b : Fin 3) (i : Fin 40) (v : Fin 40 → Fin (m + 1) → ℝ)
      (hne : G b i v ≠ 0) : F v ≠ 0 := right_ne_zero_of_mul hne
  have hDne (i : Fin 40) (v : Fin 40 → Fin (m + 1) → ℝ)
      (hne : D i v ≠ 0) : F v ≠ 0 := by
    intro hz
    apply hne
    simp only [D, G, hz, mul_zero, sub_self]
  refine ⟨hF.continuous.measurable, hGdata, hDdata, hGne, hDne, ?_⟩
  obtain ⟨M, hM, hMb⟩ := (hFc.isCompact_range hF.continuous).isBounded.exists_pos_norm_le
  have hFbound (v : Fin 40 → Fin (m + 1) → ℝ) : ‖F v‖ ≤ M := hMb _ ⟨v, rfl⟩
  have hGbound (b : Fin 3) (i : Fin 40) (v : Fin 40 → Fin (m + 1) → ℝ) :
      ‖G b i v‖ ≤ M := by
    have hHb : ‖H b (i.removeNth v)‖ ≤ 1 := by
      simpa only [Real.norm_eq_abs, abs_of_nonneg ((hH b).2.2 (i.removeNth v)).1] using
        ((hH b).2.2 (i.removeNth v)).2
    dsimp only [G]
    rw [norm_mul]
    exact (mul_le_mul hHb (hFbound v) (norm_nonneg _) zero_le_one).trans_eq (one_mul M)
  have hDbound (i : Fin 40) (v : Fin 40 → Fin (m + 1) → ℝ) : ‖D i v‖ ≤ 2 * M := by
    calc
      _ ≤ ‖G 1 i v‖ + ‖G 0 i v‖ := norm_sub_le _ _
      _ ≤ M + M := add_le_add (hGbound 1 i v) (hGbound 0 i v)
      _ = _ := by ring
  refine ⟨2 * M, mul_pos (by norm_num) hM, ?_, ?_, ?_, ?_, ?_⟩
  · intro v
    simpa only [Real.norm_eq_abs] using (hFbound v).trans (show M ≤ 2 * M by linarith)
  · intro b i v
    simpa only [Real.norm_eq_abs] using (hGbound b i v).trans (show M ≤ 2 * M by linarith)
  · intro i v
    simpa only [Real.norm_eq_abs] using hDbound i v
  · intro W R hR q T r hr X v
    have hκ : 0 < κ := by norm_num [κ]
    have hsample := canonical40_sampled_profile_support κ hκ a F H hFsource hHsource W R hR r hr
    have hrSf : Squarefree (∏ j, r j) := (Finset.mem_filter.mp hr).2
    have hfull (hne : F v ≠ 0) : physicalSourceOuterSupport X = 1 ∧
        logSize R (∏ j, r j) ≤ 98303 * (trialMesh : ℝ) ∧
        ((∏ j, r j : ℕ) : ℝ) ≤ R ^ (2742997 / 2624989 : ℝ) ∧
        ((∏ j, r j : ℕ) : ℝ) ≤ R ^ ((11 / 40 : ℝ) / ρ) := by
      obtain ⟨hmask, hmass, _, hsize, hord⟩ := hsample.2.2.1 hne
      refine ⟨hmask, ?_, hord, ?_⟩
      · rw [← primeLogConfiguration_total_mass 40 R hR r hrSf]
        exact hmass.le
      · exact hsize.le.trans (Real.rpow_le_rpow_of_exponent_le hR.le
          (by norm_num [trialMesh, ρ] : 98303 * (trialMesh : ℝ) ≤ (11 / 40 : ℝ) / ρ))
    refine ⟨hfull, ?_⟩
    intro i
    have hretDvd : (∏ j : Fin 39, r (i.succAbove j)) ∣ ∏ j : Fin 40, r j := by
      rw [Fin.prod_univ_succAbove _ i]
      exact dvd_mul_left _ _
    have hretSf := hrSf.squarefree_of_dvd hretDvd
    have hretLog (b : Fin 3) (hne : G b i v ≠ 0) :
        logSize R (∏ j : Fin 39, r (i.succAbove j)) <
          (if b = 0 then 89563 else if b = 1 then 89953 else 98302) * (trialMesh : ℝ) := by
      rw [← primeLogConfiguration_total_mass 39 R hR (fun j => r (i.succAbove j)) hretSf]
      exact (hsample.2.2.2 b i hne).2.1
    have hOldNew : (89563 : ℝ) * (trialMesh : ℝ) ≤ 89953 * (trialMesh : ℝ) := by
      norm_num [trialMesh]
    have hNewRadius : (89953 : ℝ) * (trialMesh : ℝ) ≤ (physicalSourceInnerRadius 1 : ℝ) := by
      norm_num [trialMesh, physicalSourceInnerRadius]
    have hold (hne : G 0 i v ≠ 0) :
        physicalSourceInnerSupport 0 (i.removeNth X) = 1 ∧
        physicalSourceInnerSupport 1 (i.removeNth X) = 1 ∧
        logSize R (∏ j : Fin 39, r (i.succAbove j)) ≤ 89563 * (trialMesh : ℝ) := by
      have hmasks := (hsample.2.2.2 0 i hne).2.2.1 rfl
      refine ⟨hmasks.1, hmasks.2, ?_⟩
      simpa using (hretLog 0 hne).le
    have hnew (hne : G 1 i v ≠ 0) :
        physicalSourceInnerSupport 1 (i.removeNth X) = 1 ∧
        logSize R (∏ j : Fin 39, r (i.succAbove j)) ≤ 89953 * (trialMesh : ℝ) := by
      refine ⟨(hsample.2.2.2 1 i hne).2.2.2.1 rfl, ?_⟩
      simpa using (hretLog 1 hne).le
    constructor
    · intro hne
      obtain ⟨houter, hlog, _, hrad⟩ := hfull (hGne 0 i v hne)
      obtain ⟨hinner₀, hinner₁, hret⟩ := hold hne
      exact ⟨houter, hlog, hinner₀, hinner₁, hret,
        hret.trans (hOldNew.trans hNewRadius), hrad⟩
    · intro hne
      by_cases hzero : G 1 i v = 0
      · have hnonzero : G 0 i v ≠ 0 := by
          intro hz
          apply hne
          simp only [D, hzero, hz, sub_self]
        obtain ⟨_, hinner, hret⟩ := hold hnonzero
        exact ⟨hinner, hret.trans hOldNew, hret.trans (hOldNew.trans hNewRadius)⟩
      · obtain ⟨hinner, hret⟩ := hnew hzero
        exact ⟨hinner, hret, hret.trans hNewRadius⟩
  · intro ν UF V₀ V₁ ED i
    let : IsProbabilityMeasure (fragmentLaw κ) :=
      fragmentLaw_isProbabilityMeasure κ
    let : IsFiniteMeasure
        (Measure.map (fragmentBandMasses a)
          (fragmentLaw κ)) :=
      Measure.isFiniteMeasure_map (fragmentLaw κ)
        (fragmentBandMasses a)
    let : IsFiniteMeasure ν := Measure.smul_finite
      (Measure.map (fragmentBandMasses a)
        (fragmentLaw κ)) ENNReal.ofReal_ne_top
    have hins : Measurable
        (fun p : (Fin 39 → Fin (m + 1) → ℝ) × (Fin (m + 1) → ℝ) =>
          i.insertNth (α := fun _ => Fin (m + 1) → ℝ) p.2 p.1) :=
      (Continuous.finInsertNth i continuous_snd continuous_fst).measurable
    have hslice (b : Fin 3) (Y : Fin 39 → Fin (m + 1) → ℝ) :
        Integrable (fun z : Fin (m + 1) → ℝ => G b i (i.insertNth z Y)) ν := by
      apply (integrable_const M).mono'
        ((hGdata b i).2.2.comp
          (hins.comp (measurable_const.prodMk measurable_id))).aestronglyMeasurable
      exact ae_of_all _ fun z => hGbound b i (i.insertNth z Y)
    have hDiff (Y : Fin 39 → Fin (m + 1) → ℝ) : ED i Y = V₁ i Y - V₀ i Y :=
      integral_sub (hslice 1 Y) (hslice 0 Y)
    have hfiberMeas (g : (Fin 40 → Fin (m + 1) → ℝ) → ℝ) (hg : Measurable g) :
        Measurable (fun Y : Fin 39 → Fin (m + 1) → ℝ =>
          ∫ z : Fin (m + 1) → ℝ, g (i.insertNth z Y) ∂ν) :=
      (hg.comp hins).stronglyMeasurable.integral_prod_right'.measurable
    have hUFm : Measurable (UF i) := hfiberMeas F hF.continuous.measurable
    have hV₀m : Measurable (V₀ i) := hfiberMeas (G 0 i) (hGdata 0 i).2.2
    have hEDm : Measurable (ED i) := hfiberMeas (D i) (hDdata i).2.2
    let L : ℝ := 2 * M * ν.real Set.univ
    have hUFb (Y : Fin 39 → Fin (m + 1) → ℝ) : ‖UF i Y‖ ≤ L :=
      norm_integral_le_of_norm_le_const (ae_of_all _ fun z =>
        (hFbound (i.insertNth z Y)).trans (show M ≤ 2 * M by linarith))
    have hV₀b (Y : Fin 39 → Fin (m + 1) → ℝ) : ‖V₀ i Y‖ ≤ L :=
      norm_integral_le_of_norm_le_const (ae_of_all _ fun z =>
        (hGbound 0 i (i.insertNth z Y)).trans (show M ≤ 2 * M by linarith))
    have hEDb (Y : Fin 39 → Fin (m + 1) → ℝ) : ‖ED i Y‖ ≤ L :=
      norm_integral_le_of_norm_le_const (ae_of_all _ fun z => hDbound i (i.insertNth z Y))
    have hprod (u v : (Fin 39 → Fin (m + 1) → ℝ) → ℝ)
        (hu : Measurable u) (hv : Measurable v)
        (hub : ∀ Y, ‖u Y‖ ≤ L) (hvb : ∀ Y, ‖v Y‖ ≤ L) :
        Integrable (fun Y => u Y * v Y) (Measure.pi (fun _ : Fin 39 => ν)) :=
      (MemLp.of_bound (p := 2) hu.aestronglyMeasurable L (ae_of_all _ hub)).integrable_mul
        (MemLp.of_bound (p := 2) hv.aestronglyMeasurable L (ae_of_all _ hvb))
    have hUV := hprod (UF i) (V₀ i) hUFm hV₀m hUFb hV₀b
    have hVV : Integrable (fun Y => V₀ i Y ^ 2) (Measure.pi (fun _ : Fin 39 => ν)) := by
      simpa only [pow_two] using hprod (V₀ i) (V₀ i) hV₀m hV₀m hV₀b hV₀b
    have hUE := hprod (UF i) (ED i) hUFm hEDm hUFb hEDb
    have hVE := hprod (V₀ i) (ED i) hV₀m hEDm hV₀b hEDb
    refine ⟨hDiff, ?_, ?_, ?_⟩
    · calc
        _ = ∫ Y, 2 * (UF i Y * V₀ i Y) - V₀ i Y ^ 2
            ∂Measure.pi (fun _ : Fin 39 => ν) := by
          apply integral_congr_ae
          exact ae_of_all _ fun Y => by ring
        _ = _ := by rw [integral_sub (hUV.const_mul 2) hVV, integral_const_mul]
    · calc
        _ = ∫ Y, UF i Y * ED i Y - V₀ i Y * ED i Y
            ∂Measure.pi (fun _ : Fin 39 => ν) := by
          apply integral_congr_ae
          exact ae_of_all _ fun Y => by
            change (UF i Y - V₀ i Y) * (V₁ i Y - V₀ i Y) =
              UF i Y * ED i Y - V₀ i Y * ED i Y
            rw [← hDiff Y]
            ring
        _ = _ := integral_sub hUE hVE
    · apply integral_congr_ae
      exact ae_of_all _ fun Y => by simp only [hDiff]

theorem literal_minorant_fin40_moment_bounds_of_coordinate_bounds
    {𝓗 : Finset ℕ}
    {h𝓗_card : 𝓗.card = 40}
    (s : ℝ → Finset ℕ) (A : ℝ → ℕ → ℝ)
    (B H : ℝ → Fin 40 → ℕ → ℝ) (Z : ℝ → ℝ) (I : ℝ)
    (JAB JBB JAH JBH JHH E : Fin 40 → ℝ) :
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    let ρ : ℝ := 2624989 / 10000000
    let κ : ℝ := exceptionalMassCoefficient 0 +
      exceptionalMassCoefficient 1
    let m : ℝ := 1 - κ
    let P : ℕ → ℝ := fun n => if n.Prime then 1 else 0
    let b : ℝ → ℕ → ℝ := fun x n =>
      exceptionalPrimeDefect x 0 n +
        exceptionalPrimeDefect x 1 n
    let r : ℝ → ℕ → ℝ := fun x n =>
      P n - exceptionalPrimeDefect x 0 n -
        exceptionalPrimeDefect x 1 n
    let Jold : ℝ := ∑ i : Fin 40, (2 * JAB i - JBB i)
    let Jcross : ℝ := ∑ i : Fin 40, (JAH i - JBH i)
    let Jself : ℝ := ∑ i : Fin 40, JHH i
    let Etotal : ℝ := ∑ i : Fin 40, E i
    let O : ℝ → ℝ := fun x => ∑ n ∈ s x, A x n ^ 2
    let Lold : ℝ → ℝ := fun x => ∑ n ∈ s x, ∑ i : Fin 40,
      P (n + h i) * (2 * A x n * B x i n - B x i n ^ 2)
    let C : ℝ → ℝ := fun x => ∑ n ∈ s x, ∑ i : Fin 40,
      r x (n + h i) * (A x n - B x i n) * H x i n
    let SP : ℝ → ℝ := fun x => ∑ n ∈ s x, ∑ i : Fin 40,
      P (n + h i) * H x i n ^ 2
    let SR : ℝ → ℝ := fun x => ∑ n ∈ s x, ∑ i : Fin 40,
      r x (n + h i) * H x i n ^ 2
    let EX : ℝ → ℝ := fun x => ∑ n ∈ s x, ∑ i : Fin 40,
      b x (n + h i) * (A x n - B x i n) ^ 2
    (∀ᶠ x : ℝ in Filter.atTop, 0 < Z x) →
    (∀ δ : ℝ, 0 < δ → ∀ᶠ x : ℝ in Filter.atTop,
      O x ≤ (I + δ) * Z x ∧ ∀ i : Fin 40,
        |(∑ n ∈ s x, P (n + h i) * A x n * B x i n) -
            (ρ * JAB i) * Z x| ≤ δ * Z x ∧
        |(∑ n ∈ s x, P (n + h i) * B x i n ^ 2) -
            (ρ * JBB i) * Z x| ≤ δ * Z x ∧
        |(∑ n ∈ s x, r x (n + h i) * A x n * H x i n) -
            (ρ * m * JAH i) * Z x| ≤ δ * Z x ∧
        |(∑ n ∈ s x, r x (n + h i) * B x i n * H x i n) -
            (ρ * m * JBH i) * Z x| ≤ δ * Z x ∧
        |(∑ n ∈ s x, P (n + h i) * H x i n ^ 2) -
            (ρ * JHH i) * Z x| ≤ δ * Z x ∧
        |(∑ n ∈ s x, r x (n + h i) * H x i n ^ 2) -
            (ρ * m * JHH i) * Z x| ≤ δ * Z x ∧
        (∑ n ∈ s x, b x (n + h i) * (A x n - B x i n) ^ 2) ≤
          (ρ * (17 / 50 : ℝ) * E i + δ) * Z x) →
      ∀ ε : ℝ, 0 < ε → ∀ᶠ x : ℝ in Filter.atTop,
        O x ≤ (I + ε) * Z x ∧
        (ρ * Jold - ε) * Z x ≤ Lold x ∧
        (ρ * m * Jcross - ε) * Z x ≤ C x ∧
        SP x ≤ (ρ * Jself + ε) * Z x ∧
        (ρ * m * Jself - ε) * Z x ≤ SR x ∧
        EX x ≤ (ρ * (17 / 50 : ℝ) * Etotal + ε) * Z x := by
  classical
  intro h ρ κ m P b r Jold Jcross Jself Etotal O Lold C SP SR EX hZ hmoments ε hε
  let δ : ℝ := ε / 160
  have hδ : 0 < δ := div_pos hε (by norm_num)
  have hbudget : 120 * δ ≤ ε := by dsimp only [δ]; linarith only [hε]
  filter_upwards [hZ, hmoments δ hδ] with x hxZ hx
  obtain ⟨hO, hcoordinate⟩ := hx
  have hsum (F : Fin 40 → ℝ) (c d : ℝ) :
      (∑ i : Fin 40, (c * F i + d) * Z x) =
        (c * (∑ i : Fin 40, F i) + 40 * d) * Z x := by
    rw [← Finset.sum_mul, Finset.sum_add_distrib, ← Finset.mul_sum]
    simp
  have hLower (F M : Fin 40 → ℝ) (c d : ℝ) (hd : 40 * d ≤ ε)
      (hM : ∀ i : Fin 40, (c * F i - d) * Z x ≤ M i) :
      (c * (∑ i : Fin 40, F i) - ε) * Z x ≤ ∑ i : Fin 40, M i := by
    have hs : (c * (∑ i : Fin 40, F i) - 40 * d) * Z x ≤
        ∑ i : Fin 40, M i := by
      calc
        _ = ∑ i : Fin 40, (c * F i - d) * Z x := by
          simpa only [sub_eq_add_neg, mul_neg] using (hsum F c (-d)).symm
        _ ≤ ∑ i : Fin 40, M i := Finset.sum_le_sum (fun i _ => hM i)
    have he := mul_le_mul_of_nonneg_right hd hxZ.le
    nlinarith only [hs, he]
  have hUpper (F M : Fin 40 → ℝ) (c d : ℝ) (hd : 40 * d ≤ ε)
      (hM : ∀ i : Fin 40, M i ≤ (c * F i + d) * Z x) :
      (∑ i : Fin 40, M i) ≤ (c * (∑ i : Fin 40, F i) + ε) * Z x := by
    have he := mul_le_mul_of_nonneg_right hd hxZ.le
    calc
      (∑ i : Fin 40, M i) ≤ ∑ i : Fin 40, (c * F i + d) * Z x :=
        Finset.sum_le_sum (fun i _ => hM i)
      _ = (c * (∑ i : Fin 40, F i) + 40 * d) * Z x := hsum F c d
      _ ≤ (c * (∑ i : Fin 40, F i) + ε) * Z x := by nlinarith only [he]
  refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩
  · have hδle : δ ≤ ε := by linarith only [hbudget, hδ]
    have he := mul_le_mul_of_nonneg_right hδle hxZ.le
    nlinarith only [hO, he]
  · dsimp only [Lold, Jold]
    rw [Finset.sum_comm]
    apply hLower (fun i => 2 * JAB i - JBB i)
      (fun i => ∑ n ∈ s x,
        P (n + h i) * (2 * A x n * B x i n - B x i n ^ 2))
      ρ (3 * δ) (by linarith only [hbudget])
    intro i
    have hAB := abs_le.mp (hcoordinate i).1
    have hBB := abs_le.mp (hcoordinate i).2.1
    have hid :
        (∑ n ∈ s x, P (n + h i) * (2 * A x n * B x i n - B x i n ^ 2)) =
          2 * (∑ n ∈ s x, P (n + h i) * A x n * B x i n) -
            ∑ n ∈ s x, P (n + h i) * B x i n ^ 2 := by
      simp only [mul_sub, mul_assoc, mul_left_comm _ (2 : ℝ),
        Finset.sum_sub_distrib, ← Finset.mul_sum]
    rw [hid]
    nlinarith only [hAB.1, hBB.2]
  · dsimp only [C, Jcross]
    rw [Finset.sum_comm]
    apply hLower (fun i => JAH i - JBH i)
      (fun i => ∑ n ∈ s x, r x (n + h i) * (A x n - B x i n) * H x i n)
      (ρ * m) (2 * δ) (by linarith only [hbudget, hδ])
    intro i
    have hAH := abs_le.mp (hcoordinate i).2.2.1
    have hBH := abs_le.mp (hcoordinate i).2.2.2.1
    have hid :
        (∑ n ∈ s x, r x (n + h i) * (A x n - B x i n) * H x i n) =
          (∑ n ∈ s x, r x (n + h i) * A x n * H x i n) -
            ∑ n ∈ s x, r x (n + h i) * B x i n * H x i n := by
      simp only [mul_sub, sub_mul, Finset.sum_sub_distrib]
    rw [hid]
    nlinarith only [hAH.1, hBH.2]
  · dsimp only [SP, Jself]
    rw [Finset.sum_comm]
    apply hUpper JHH (fun i => ∑ n ∈ s x, P (n + h i) * H x i n ^ 2)
      ρ δ (by linarith only [hbudget, hδ])
    intro i
    have hh := (abs_le.mp (hcoordinate i).2.2.2.2.1).2
    nlinarith only [hh]
  · dsimp only [SR, Jself]
    rw [Finset.sum_comm]
    apply hLower JHH (fun i => ∑ n ∈ s x, r x (n + h i) * H x i n ^ 2)
      (ρ * m) δ (by linarith only [hbudget, hδ])
    intro i
    have hh := (abs_le.mp (hcoordinate i).2.2.2.2.2.1).1
    nlinarith only [hh]
  · dsimp only [EX, Etotal]
    rw [Finset.sum_comm]
    exact hUpper E
      (fun i => ∑ n ∈ s x, b x (n + h i) * (A x n - B x i n) ^ 2)
      (ρ * (17 / 50 : ℝ)) δ (by linarith only [hbudget, hδ])
      (fun i => (hcoordinate i).2.2.2.2.2.2)

theorem canonical40_source_profile_signed_margin
    {m : ℕ} (a : Fin (m + 2) → ℝ)
    (F : (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
    (H : Fin 3 → (Fin 39 → Fin (m + 1) → ℝ) → ℝ)
    (hF : ContDiff ℝ ∞ F) (hFc : HasCompactSupport F)
    (hH : ∀ b, ContDiff ℝ ∞ (H b) ∧ HasCompactSupport (H b) ∧
      ∀ v, 0 ≤ H b v ∧ H b v ≤ 1) :
    let κ : ℝ := (19037 / 100000) / (2624989 / 10000000)
    let ρ : ℝ := 2624989 / 10000000
    let κE : ℝ := exceptionalMassCoefficient 0 +
      exceptionalMassCoefficient 1
    let t : ℝ := 49599 / 50000
    let η : ℝ := 49599 / 20000000
    let R : ℝ → ℝ → ℝ → ℝ := fun u v₀ v₁ =>
      2 * u * v₀ - v₀ ^ 2 + 2 * (1 - κE) * t * (u - v₀) * (v₁ - v₀) -
        t ^ 2 * (v₁ - v₀) ^ 2 - η * (17 / 50 : ℝ) * (u - v₀) ^ 2 -
        η⁻¹ * κE * t ^ 2 * (v₁ - v₀) ^ 2
    let f : (Fin 40 → FiniteMeasure ℝ) → ℝ :=
      fun X => F (fun i => fragmentBandMasses a (X i))
    let U : Fin 40 → (Fin 39 → FiniteMeasure ℝ) → ℝ := fun i Y =>
      ∫ Z : FiniteMeasure ℝ, f (i.insertNth Z Y)
        ∂trialPhysicalMeasure
    let H₀ : (Fin 39 → FiniteMeasure ℝ) → ℝ :=
      fun Y => H 0 (fun i => fragmentBandMasses a (Y i))
    let H₁ : (Fin 39 → FiniteMeasure ℝ) → ℝ :=
      fun Y => H 1 (fun i => fragmentBandMasses a (Y i))
    (∀ X : Fin 40 → FiniteMeasure ℝ,
      (∑ i, X i).restrict (Set.Ioc (0 : ℝ) κ) = ∑ i, X i →
      (∀ j : Fin (m + 1), 0 < a j.castSucc →
        fragmentBandMasses a (∑ i, X i) j = 0 ∨
          a j.castSucc < fragmentBandMasses a (∑ i, X i) j) →
      F (fun i => fragmentBandMasses a (X i)) ≠ 0 →
      physicalSourceOuterSupport X = 1 ∧
        (∑ i, ((X i).mass : ℝ)) <
          98303 * (trialMesh : ℝ) ∧
        ∀ i, (X i : Measure ℝ)
          (Set.Ioi (trialLargestCap : ℝ)) = 0) →
    0 < ρ *
      ((∑ i : Fin 40, ∫ Y, R (U i Y) (H₀ Y * U i Y) (H₁ Y * U i Y)
          ∂Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure)) /
        trialPhysicalNormalizer) -
      (∫ X, f X ^ 2
        ∂Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure)) /
        trialPhysicalNormalizer →
    let ν : Measure (Fin (m + 1) → ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        Measure.map (fragmentBandMasses a) (fragmentLaw κ)
    let G : Fin 3 → Fin 40 → (Fin 40 → Fin (m + 1) → ℝ) → ℝ :=
      fun b i v => H b (i.removeNth v) * F v
    let UF : Fin 40 → (Fin 39 → Fin (m + 1) → ℝ) → ℝ := fun i Y =>
      ∫ z : Fin (m + 1) → ℝ, F (i.insertNth z Y) ∂ν
    let V₀ : Fin 40 → (Fin 39 → Fin (m + 1) → ℝ) → ℝ := fun i Y =>
      ∫ z : Fin (m + 1) → ℝ, G 0 i (i.insertNth z Y) ∂ν
    let V₁ : Fin 40 → (Fin 39 → Fin (m + 1) → ℝ) → ℝ := fun i Y =>
      ∫ z : Fin (m + 1) → ℝ, G 1 i (i.insertNth z Y) ∂ν
    let I : ℝ := ∫ v, F v ^ 2 ∂Measure.pi (fun _ : Fin 40 => ν)
    let Jold : ℝ := ∑ i : Fin 40, ∫ Y,
      2 * UF i Y * V₀ i Y - V₀ i Y ^ 2 ∂Measure.pi (fun _ : Fin 39 => ν)
    let Jcross : ℝ := ∑ i : Fin 40, ∫ Y,
      (UF i Y - V₀ i Y) * (V₁ i Y - V₀ i Y) ∂Measure.pi (fun _ : Fin 39 => ν)
    let Jself : ℝ := ∑ i : Fin 40, ∫ Y,
      (V₁ i Y - V₀ i Y) ^ 2 ∂Measure.pi (fun _ : Fin 39 => ν)
    let E : ℝ := ∑ i : Fin 40, ∫ Y,
      (UF i Y - V₀ i Y) ^ 2 ∂Measure.pi (fun _ : Fin 39 => ν)
    0 < ρ * (Jold + 2 * (1 - κE) * t * Jcross - t ^ 2 * Jself -
      η * (17 / 50 : ℝ) * E - η⁻¹ * κE * t ^ 2 * Jself) - I := by
  classical
  intro κ ρ κE t η R f U H₀ H₁ hFsource hpositive ν G UF V₀ V₁ I Jold Jcross Jself E
  let P : Measure (FiniteMeasure ℝ) :=
    ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
      fragmentLaw κ
  let : IsProbabilityMeasure (fragmentLaw κ) :=
    fragmentLaw_isProbabilityMeasure κ
  let : IsFiniteMeasure P := Measure.smul_finite
    (fragmentLaw κ) ENNReal.ofReal_ne_top
  have hmap : Measure.map (fragmentBandMasses a) P = ν :=
    Measure.map_smul _ (measurable_fragmentBandMasses a).aemeasurable
  let : IsFiniteMeasure ν := hmap ▸ Measure.isFiniteMeasure_map P (fragmentBandMasses a)
  have hκ : (trialLargestCap : ℝ) ≤ κ := by
    norm_num [κ, trialLargestCap, trialMesh]
  have hcap : ∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => P),
      f X ≠ 0 → ∀ i, (X i : Measure ℝ)
        (Set.Ioi (trialLargestCap : ℝ)) = 0 :=
    trial_cap_law_ae_cap_of_band_certificate κ 40 a f
      (fun X hs hg hn => (hFsource X hs hg hn).2.2)
  have hI : I = ∫ X, f X ^ 2
      ∂Measure.pi (fun _ : Fin 40 => trialPhysicalMeasure) := by
    calc
      I = ∫ X, f X ^ 2 ∂Measure.pi (fun _ : Fin 40 => P) :=
        fragment_band_law_integral_pullback κ a 40 (fun v => F v ^ 2)
          (hF.continuous.measurable.pow_const 2)
      _ = _ := trial_cap_law_square_integral_eq κ hκ 40 f hcap
  have hG (b : Fin 3) (i : Fin 40) (Y : Fin 39 → Fin (m + 1) → ℝ) :
      (∫ z : Fin (m + 1) → ℝ, G b i (i.insertNth z Y) ∂ν) = H b Y * UF i Y := by
    simp only [G, Fin.removeNth_insertNth, UF, integral_const_mul]
  have hV₀ (i : Fin 40) (Y : Fin 39 → Fin (m + 1) → ℝ) :
      V₀ i Y = H 0 Y * UF i Y := hG 0 i Y
  have hV₁ (i : Fin 40) (Y : Fin 39 → Fin (m + 1) → ℝ) :
      V₁ i Y = H 1 Y * UF i Y := hG 1 i Y
  have hface (i : Fin 40) :
      (∫ Y, R (UF i Y) (V₀ i Y) (V₁ i Y) ∂Measure.pi (fun _ : Fin 39 => ν)) =
        ∫ Y, R (U i Y) (H₀ Y * U i Y) (H₁ Y * U i Y)
          ∂Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure) := by
    let Ψ : (Fin 39 → Fin (m + 1) → ℝ) → (Fin 1 → ℝ) → ℝ :=
      fun Y v => R (v 0) (H 0 Y * v 0) (H 1 Y * v 0)
    have hH₀m : Measurable (H 0) := (hH 0).1.continuous.measurable
    have hH₁m : Measurable (H 1) := (hH 1).1.continuous.measurable
    have hΨ : Measurable (Function.uncurry Ψ) := by
      dsimp only [Ψ, R, Function.uncurry]
      fun_prop
    calc
      _ = ∫ Y, Ψ Y (fun _ : Fin 1 => UF i Y)
          ∂Measure.pi (fun _ : Fin 39 => ν) := by
        apply integral_congr_ae
        exact ae_of_all _ fun Y => by simp only [Ψ, hV₀, hV₁]
      _ = ∫ X, Ψ (fun k => fragmentBandMasses a (X k))
          (fun _ : Fin 1 => ∫ Z : FiniteMeasure ℝ, f (i.insertNth Z X) ∂P)
          ∂Measure.pi (fun _ : Fin 39 => P) :=
        fragment_band_law_fiber_function_integral_pullback κ a 39 1 i
          (fun _ => F) (fun _ => hF.continuous.measurable) Ψ hΨ
      _ = _ := by
        simpa only [Ψ, U, H₀, H₁] using
          (trial_cap_law_fiber_function_integral_eq κ hκ 39 1 i
            (fun _ : Fin 1 => f)
            (fun Y v => Ψ (fun k => fragmentBandMasses a (Y k)) v)
            (by intro Y; simp only [Ψ, R]; ring) (fun _ => hcap))
  obtain ⟨C, hC⟩ := hFc.exists_bound_of_continuous hF.continuous
  let L : ℝ := max C 0 * ν.real Set.univ
  have hUFbound (i : Fin 40) (Y : Fin 39 → Fin (m + 1) → ℝ) : ‖UF i Y‖ ≤ L :=
    norm_integral_le_of_norm_le_const (ae_of_all _ fun z => (hC _).trans (le_max_left _ _))
  have hUFmeas (i : Fin 40) : Measurable (UF i) := by
    have hins : Measurable
        (fun p : (Fin 39 → Fin (m + 1) → ℝ) × (Fin (m + 1) → ℝ) =>
          i.insertNth (α := fun _ => Fin (m + 1) → ℝ) p.2 p.1) :=
      (Continuous.finInsertNth i continuous_snd continuous_fst).measurable
    exact (hF.continuous.measurable.comp hins).stronglyMeasurable.integral_prod_right'.measurable
  have hHbound (b : Fin 3) (Y : Fin 39 → Fin (m + 1) → ℝ) : ‖H b Y‖ ≤ 1 := by
    simpa only [Real.norm_eq_abs, abs_of_nonneg ((hH b).2.2 Y).1] using ((hH b).2.2 Y).2
  have hV₀meas (i : Fin 40) : Measurable (V₀ i) := by
    have heq : V₀ i = fun Y => H 0 Y * UF i Y := funext (hV₀ i)
    rw [heq]
    exact (hH 0).1.continuous.measurable.mul (hUFmeas i)
  have hV₁meas (i : Fin 40) : Measurable (V₁ i) := by
    have heq : V₁ i = fun Y => H 1 Y * UF i Y := funext (hV₁ i)
    rw [heq]
    exact (hH 1).1.continuous.measurable.mul (hUFmeas i)
  have hV₀bound (i : Fin 40) (Y : Fin 39 → Fin (m + 1) → ℝ) : ‖V₀ i Y‖ ≤ L := by
    rw [hV₀, norm_mul]
    exact (mul_le_mul (hHbound 0 Y) (hUFbound i Y) (norm_nonneg _) zero_le_one).trans_eq
      (one_mul L)
  have hV₁bound (i : Fin 40) (Y : Fin 39 → Fin (m + 1) → ℝ) : ‖V₁ i Y‖ ≤ L := by
    rw [hV₁, norm_mul]
    exact (mul_le_mul (hHbound 1 Y) (hUFbound i Y) (norm_nonneg _) zero_le_one).trans_eq
      (one_mul L)
  have hprod (u v : (Fin 39 → Fin (m + 1) → ℝ) → ℝ)
      (hu : Measurable u) (hv : Measurable v) (Cu Cv : ℝ)
      (huC : ∀ Y, ‖u Y‖ ≤ Cu) (hvC : ∀ Y, ‖v Y‖ ≤ Cv) :
      Integrable (fun Y => u Y * v Y) (Measure.pi (fun _ : Fin 39 => ν)) :=
    (MemLp.of_bound (p := 2) hu.aestronglyMeasurable Cu (ae_of_all _ huC)).integrable_mul
      (MemLp.of_bound (p := 2) hv.aestronglyMeasurable Cv (ae_of_all _ hvC))
  have hlinear (i : Fin 40) :
      (∫ Y, R (UF i Y) (V₀ i Y) (V₁ i Y) ∂Measure.pi (fun _ : Fin 39 => ν)) =
        (∫ Y, 2 * UF i Y * V₀ i Y - V₀ i Y ^ 2 ∂Measure.pi (fun _ : Fin 39 => ν)) +
        2 * (1 - κE) * t * (∫ Y, (UF i Y - V₀ i Y) * (V₁ i Y - V₀ i Y)
          ∂Measure.pi (fun _ : Fin 39 => ν)) -
        t ^ 2 * (∫ Y, (V₁ i Y - V₀ i Y) ^ 2 ∂Measure.pi (fun _ : Fin 39 => ν)) -
        η * (17 / 50 : ℝ) * (∫ Y, (UF i Y - V₀ i Y) ^ 2
          ∂Measure.pi (fun _ : Fin 39 => ν)) -
        η⁻¹ * κE * t ^ 2 * (∫ Y, (V₁ i Y - V₀ i Y) ^ 2
          ∂Measure.pi (fun _ : Fin 39 => ν)) := by
    let o := fun Y => 2 * UF i Y * V₀ i Y - V₀ i Y ^ 2
    let c := fun Y => (UF i Y - V₀ i Y) * (V₁ i Y - V₀ i Y)
    let s := fun Y => (V₁ i Y - V₀ i Y) ^ 2
    let e := fun Y => (UF i Y - V₀ i Y) ^ 2
    have hD (Y : Fin 39 → Fin (m + 1) → ℝ) : ‖UF i Y - V₀ i Y‖ ≤ 2 * L := by
      calc
        _ ≤ ‖UF i Y‖ + ‖V₀ i Y‖ := norm_sub_le _ _
        _ ≤ L + L := add_le_add (hUFbound i Y) (hV₀bound i Y)
        _ = _ := by ring
    have hV (Y : Fin 39 → Fin (m + 1) → ℝ) : ‖V₁ i Y - V₀ i Y‖ ≤ 2 * L := by
      calc
        _ ≤ ‖V₁ i Y‖ + ‖V₀ i Y‖ := norm_sub_le _ _
        _ ≤ L + L := add_le_add (hV₁bound i Y) (hV₀bound i Y)
        _ = _ := by ring
    have hUV := hprod (UF i) (V₀ i) (hUFmeas i) (hV₀meas i) L L
      (hUFbound i) (hV₀bound i)
    have hVV : Integrable (fun Y => V₀ i Y ^ 2) (Measure.pi (fun _ : Fin 39 => ν)) := by
      simpa only [pow_two] using
        hprod (V₀ i) (V₀ i) (hV₀meas i) (hV₀meas i) L L (hV₀bound i) (hV₀bound i)
    have ho : Integrable o (Measure.pi (fun _ : Fin 39 => ν)) := by
      have ho' : Integrable (fun Y => 2 * (UF i Y * V₀ i Y) - V₀ i Y ^ 2)
          (Measure.pi (fun _ : Fin 39 => ν)) := (hUV.const_mul 2).sub hVV
      simpa only [o, mul_assoc] using ho'
    have hc : Integrable c (Measure.pi (fun _ : Fin 39 => ν)) :=
      hprod _ _ ((hUFmeas i).sub (hV₀meas i)) ((hV₁meas i).sub (hV₀meas i))
        (2 * L) (2 * L) hD hV
    have hs : Integrable s (Measure.pi (fun _ : Fin 39 => ν)) := by
      simpa only [s, Pi.sub_apply, pow_two] using
        hprod _ _ ((hV₁meas i).sub (hV₀meas i)) ((hV₁meas i).sub (hV₀meas i))
          (2 * L) (2 * L) hV hV
    have he : Integrable e (Measure.pi (fun _ : Fin 39 => ν)) := by
      simpa only [e, Pi.sub_apply, pow_two] using
        hprod _ _ ((hUFmeas i).sub (hV₀meas i)) ((hUFmeas i).sub (hV₀meas i))
          (2 * L) (2 * L) hD hD
    have hc' := hc.const_mul (2 * (1 - κE) * t)
    have hs' := hs.const_mul (t ^ 2)
    have he' := he.const_mul (η * (17 / 50 : ℝ))
    have hs'' := hs.const_mul (η⁻¹ * κE * t ^ 2)
    calc
      _ = ∫ Y, o Y + 2 * (1 - κE) * t * c Y - t ^ 2 * s Y -
          η * (17 / 50 : ℝ) * e Y - η⁻¹ * κE * t ^ 2 * s Y
          ∂Measure.pi (fun _ : Fin 39 => ν) := by
        apply integral_congr_ae
        exact ae_of_all _ fun Y => by dsimp only [R, o, c, s, e]; ring
      _ = _ := by
        have h₁ := integral_sub (((ho.add hc').sub hs').sub he') hs''
        have h₂ := integral_sub ((ho.add hc').sub hs') he'
        have h₃ := integral_sub (ho.add hc') hs'
        have h₄ := integral_add ho hc'
        simp only [Pi.add_apply, Pi.sub_apply] at h₁ h₂ h₃ h₄
        rw [h₁, h₂, h₃, h₄]
        simp only [integral_const_mul, o, c, s, e]
  have hJ : Jold + 2 * (1 - κE) * t * Jcross - t ^ 2 * Jself -
      η * (17 / 50 : ℝ) * E - η⁻¹ * κE * t ^ 2 * Jself =
        ∑ i : Fin 40, ∫ Y, R (U i Y) (H₀ Y * U i Y) (H₁ Y * U i Y)
          ∂Measure.pi (fun _ : Fin 39 => trialPhysicalMeasure) := by
    calc
      _ = ∑ i : Fin 40, ∫ Y, R (UF i Y) (V₀ i Y) (V₁ i Y)
          ∂Measure.pi (fun _ : Fin 39 => ν) := by
        simp only [Jold, Jcross, Jself, E, hlinear, Finset.sum_sub_distrib,
          Finset.sum_add_distrib, ← Finset.mul_sum]
      _ = _ := Finset.sum_congr rfl fun i _ => hface i
  rw [hJ, hI]
  have hden : 0 < trialPhysicalNormalizer :=
    trial_fixed_positive_data.2.2.2.2.2
  apply (div_pos_iff_of_pos_right hden).mp
  simpa only [sub_div, mul_div_assoc] using hpositive

open Classical in
theorem canonical40_fixed_band_exceptional_full_minus_erased_square
    {𝓗 : Finset ℕ}
    {h𝓗_card : 𝓗.card = 40}
    {m : ℕ} (i : Fin 40)
    (a : Fin (m + 2) → ℝ) (ha : StrictMono a) (ha0 : a 0 = 0)
    (haLast : a (Fin.last (m + 1)) =
      ((19037 : ℝ) / 100000) / ((2624989 : ℝ) / 10000000))
    (F G : (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
    (hF : Measurable F) (hG : Measurable G)
    (hbF : Bornology.IsBounded (Set.range F))
    (hbG : Bornology.IsBounded (Set.range G))
    (hRadiusF : ∀ (W : ℕ) (R : ℝ), 1 < R → ∀ r : Fin 40 → ℕ,
      Squarefree (∏ j, r j) →
      (∀ j, r j ∈ (∏ p ∈ fragmentPrimes W R
        (((19037 : ℝ) / 100000) / ((2624989 : ℝ) / 10000000)), p).divisors) →
      F (fun j => fragmentBandMasses a
        (primeLogConfiguration R (r j))) ≠ 0 →
      ((∏ j, r j : ℕ) : ℝ) ≤
        R ^ ((11 / 40 : ℝ) / ((2624989 : ℝ) / 10000000)))
    (hRadiusG : ∀ (W : ℕ) (R : ℝ), 1 < R → ∀ r : Fin 40 → ℕ,
      Squarefree (∏ j, r j) →
      (∀ j, r j ∈ (∏ p ∈ fragmentPrimes W R
        (((19037 : ℝ) / 100000) / ((2624989 : ℝ) / 10000000)), p).divisors) →
      G (fun j => fragmentBandMasses a
        (primeLogConfiguration R (r j))) ≠ 0 →
      ((∏ j, r j : ℕ) : ℝ) ≤
        R ^ ((11 / 40 : ℝ) / ((2624989 : ℝ) / 10000000))) :
    let ρ : ℝ := 2624989 / 10000000
    let κ : ℝ := ((19037 : ℝ) / 100000) / ρ
    let ν : Measure (Fin (m + 1) → ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        Measure.map (fragmentBandMasses a) (fragmentLaw κ)
    (∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => ν), ContinuousAt F X) →
    (∀ᵐ X ∂Measure.pi (fun _ : Fin 40 => ν), ContinuousAt G X) →
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    let W : ℝ → ℕ := presievingModulus 𝓗
    let R : ℝ → ℝ := fun x => x ^ ρ
    let B : ℝ → ℝ := fun x => fragmentNormalization (W x) (R x)
    let q : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) (R x) κ, p
    let T : ℝ → Finset (Fin 40 → ℕ) := fun x =>
      (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
        (fun r => Squarefree (∏ j, r j))
    let X : ℝ → ℕ → Fin (m + 1) → ℝ := fun x n =>
      fragmentBandMasses a (primeLogConfiguration (R x) n)
    let y : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → ((Fin 40 → ℕ) →₀ ℝ) :=
      fun H x => ∑ r ∈ T x, Finsupp.single r (H (fun j => X x (r j)) / B x ^ 40)
    let z : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → ((Fin 39 → ℕ) →₀ ℝ) :=
      fun H x => (y H x).sum (fun r yr => Finsupp.single
        (fun j => r (i.succAbove j)) (yr / ((r i).totient : ℝ)))
    let D : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → Finset (Fin 40 → ℕ) :=
      fun H x => (y H x).support.biUnion
        (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let E : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → Finset (Fin 39 → ℕ) :=
      fun H x => (z H x).support.biUnion
        (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let A : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → ℕ → ℝ := fun H x n =>
      ∑ d ∈ D H x, if ∀ j, d j ∣ n + h j then selbergCoefficient (y H x) d else 0
    let C : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → ℕ → ℝ := fun H x n =>
      ∑ d ∈ E H x, if ∀ j, d j ∣ n + h (i.succAbove j) then
        selbergCoefficient (z H x) d else 0
    let energy : ℝ := ∫ Y : Fin 39 → Fin (m + 1) → ℝ,
      ((∫ t : Fin (m + 1) → ℝ, F (i.insertNth t Y) ∂ν) -
        ∫ t : Fin (m + 1) → ℝ, G (i.insertNth t Y) ∂ν) ^ 2
          ∂Measure.pi (fun _ : Fin 39 => ν)
    ∀ ε : ℝ, 0 < ε → ∀ᶠ x : ℝ in Filter.atTop, ∀ v : ℕ,
      (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        if Nat.ModEq (W x) n v then
          (exceptionalPrimeDefect x 0 (n + h i) +
            exceptionalPrimeDefect x 1 (n + h i)) *
              (A F x n - C G x n) ^ 2 else 0) ≤
        (ρ * (17 / 50 : ℝ) * energy + ε) * (x / (W x : ℝ) / B x ^ 40) := by
  intro ρ κ ν cF cG h W R B q T X y z D E A C energy
  have hρ : 0 < ρ := by norm_num [ρ]
  let Bx : ℝ → ℝ := fun x => fragmentNormalization (W x) x
  let profiles : Fin 2 → (Fin 40 → Fin (m + 1) → ℝ) → ℝ := ![F, G]
  have hprofiles (j : Fin 2) : Measurable (profiles j) := by
    fin_cases j <;> assumption
  have hbprofiles (j : Fin 2) : Bornology.IsBounded (Set.range (profiles j)) := by
    fin_cases j <;> assumption
  have hcprofiles (j : Fin 2) :
      ∀ᵐ Y ∂Measure.pi (fun _ : Fin 40 => ν), ContinuousAt (profiles j) Y := by
    fin_cases j <;> assumption
  have hradius (j : Fin 2) (W : ℕ) (R : ℝ) (hR : 1 < R)
      (r : Fin 40 → ℕ) (hsf : Squarefree (∏ k, r k))
      (hdiv : ∀ k, r k ∈
        (∏ p ∈ fragmentPrimes W R κ, p).divisors)
      (hne : profiles j (fun k => fragmentBandMasses a
        (primeLogConfiguration R (r k))) ≠ 0) :
      ((∏ k, r k : ℕ) : ℝ) ≤ R ^ ((11 / 40 : ℝ) / ρ) := by
    fin_cases j
    · exact hRadiusF W R hR r hsf hdiv hne
    · exact hRadiusG W R hR r hsf hdiv hne
  have hsource (j : Fin 2) : ∀ᶠ x : ℝ in Filter.atTop, ∀ d : Fin 39 → ℕ,
      selbergCoefficient (y (profiles j) x) (i.insertNth 1 d) ≠ 0 →
        ((∏ k, d k : ℕ) : ℝ) ≤ x ^ (11 / 40 : ℝ) := by
    filter_upwards [Filter.eventually_gt_atTop (1 : ℝ)] with x hx
    intro d hd
    obtain ⟨r, hr, hfr, hdr⟩ := selberg_sampled_coefficient_root
      (T x) (fun r => profiles j (fun k => X x (r k))) (B x ^ 40)
        (i.insertNth 1 d) hd
    have hsf : Squarefree (∏ k, r k) := (Finset.mem_filter.mp hr).2
    have hdiv : ∀ k : Fin 40, r k ∈ (q x).divisors :=
      Fintype.mem_piFinset.mp (Finset.mem_filter.mp hr).1
    have hprod : (∏ k : Fin 39, d k) ∣ ∏ k : Fin 40, r k := by
      clear * - i d r hdr
      have hp : (∏ k : Fin 40, i.insertNth 1 d k) ∣ ∏ k : Fin 40, r k :=
        Finset.prod_dvd_prod_of_dvd (i.insertNth 1 d) r (fun k _ => hdr k)
      simpa only [Fin.prod_insertNth, one_mul] using hp
    calc
      ((∏ k, d k : ℕ) : ℝ) ≤ ((∏ k, r k : ℕ) : ℝ) :=
        Nat.cast_le.mpr (Nat.le_of_dvd (Nat.pos_of_ne_zero hsf.ne_zero) hprod)
      _ ≤ (R x) ^ ((11 / 40 : ℝ) / ρ) :=
        hradius j (W x) (R x) (Real.one_lt_rpow hx hρ) r hsf hdiv hfr
      _ = x ^ (11 / 40 : ℝ) := by
        dsimp only [R]
        rw [← Real.rpow_mul (zero_lt_one.trans hx).le]
        congr 1
        norm_num [ρ]
  have herasedRaw (η : ℝ) (hη : 0 < η) :
      ∀ᶠ x : ℝ in Filter.atTop, ∀ v : ℕ,
        (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
          if Nat.ModEq (W x) n v then
            (exceptionalPrimeDefect x 0 (n + h i) +
              exceptionalPrimeDefect x 1 (n + h i)) *
                (C F x n - C G x n) ^ 2 else 0) ≤
          ((17 / 50 : ℝ) * (ρ ^ 39)⁻¹ * energy + η) *
            (x / (W x : ℝ) / Bx x ^ 40) := by
    have ht := canonical_and_erased_exceptional_square (𝓗 := 𝓗) (h𝓗_card := h𝓗_card)
      (Finset.univ : Finset (Fin 2)) ![(1 : ℝ), -1] i a ha ha0 haLast
      (fun (_ : Fin 2) (_ : Fin 39 → Fin (m + 1) → ℝ) => (0 : ℝ)) profiles
      (fun _ _ => measurable_const) (fun j _ => hprofiles j)
      (fun _ _ => by simp only [Set.range_const]; exact Bornology.isBounded_singleton)
      (fun j _ => hbprofiles j)
      (fun _ _ => Filter.Eventually.of_forall (fun _ => continuousAt_const))
      (fun j _ => hcprofiles j)
      (by
        intro j _
        filter_upwards [hsource j] with x hx
        intro d hd
        apply hx d
        exact hd.resolve_left (by simp [selbergCoefficient])) η hη
    simpa only [profiles, Fin.sum_univ_two, Matrix.cons_val_zero, Matrix.cons_val_one,
      zero_div, Finsupp.single_zero, Finset.sum_const_zero, zero_add,
      one_mul, neg_one_mul, ← sub_eq_add_neg] using ht
  have hscale (x : ℝ) (hx : 1 < x) : B x = ρ * Bx x := by
    dsimp only [B, R, Bx, fragmentNormalization]
    rw [Real.log_rpow (zero_lt_one.trans hx)]
    ring
  have hBxpos (x : ℝ) (hx : 1 < x) : 0 < Bx x := by
    have hW : 0 < W x := presieving_pos 𝓗 x
    change 0 < ((W x).totient : ℝ) / (W x : ℝ) * Real.log x
    exact mul_pos
      (div_pos (Nat.cast_pos.mpr (Nat.totient_pos.mpr hW)) (Nat.cast_pos.mpr hW))
      (Real.log_pos hx)
  have herased (ε : ℝ) (hε : 0 < ε) :
      ∀ᶠ x : ℝ in Filter.atTop, ∀ v : ℕ,
        (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
          if Nat.ModEq (W x) n v then
            (exceptionalPrimeDefect x 0 (n + h i) +
              exceptionalPrimeDefect x 1 (n + h i)) *
                (C F x n - C G x n) ^ 2 else 0) ≤
          (ρ * (17 / 50 : ℝ) * energy + ε) * (x / (W x : ℝ) / B x ^ 40) := by
    filter_upwards [herasedRaw (ε / ρ ^ 40) (div_pos hε (pow_pos hρ 40)),
      Filter.eventually_gt_atTop (1 : ℝ)] with x hx hx1
    intro v
    refine (hx v).trans_eq ?_
    have hBx := hBxpos x hx1
    have hW := presieving_pos 𝓗 x
    rw [hscale x hx1, mul_pow]
    field_simp [hρ.ne', hBx.ne', (Nat.cast_pos.mpr hW : (0 : ℝ) < W x).ne']
  let b : ℝ → ℕ → ℝ := fun x n =>
    exceptionalPrimeDefect x 0 (n + h i) +
      exceptionalPrimeDefect x 1 (n + h i)
  let EA : ℝ → ℝ := fun x => ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
    if 2 * x < ((n + h i : ℕ) : ℝ) then b x n * A F x n ^ 2 else 0
  let EG : ℝ → ℝ := fun x => ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
    if 2 * x < ((n + h i : ℕ) : ℝ) then b x n * C G x n ^ 2 else 0
  let tail : ℝ → ℝ := fun x => 2 * (EA x + EG x)
  obtain ⟨KF, hKF, hrootsF⟩ :=
    (canonical40_fixed_profile_coefficient_roots (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i a F hbF).2
      (1 / 8 : ℝ) (by norm_num)
  obtain ⟨KG, hKG, hrootsG⟩ :=
    (canonical40_fixed_profile_coefficient_roots (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i a G hbG).2
      (1 / 8 : ℝ) (by norm_num)
  have hEA : EA =O[Filter.atTop] (fun x : ℝ => x ^ (1 / 2 : ℝ)) :=
    exceptionalPrimeDefect_shifted_endpoint_error (h i) (A F)
      ⟨KF, hKF, hrootsF.mono (fun _ hx n hn => (hx n hn).1)⟩
  have hEG : EG =O[Filter.atTop] (fun x : ℝ => x ^ (1 / 2 : ℝ)) :=
    exceptionalPrimeDefect_shifted_endpoint_error (h i) (C G)
      ⟨KG, hKG, hrootsG.mono (fun _ hx n hn => (hx n hn).2)⟩
  have htail : tail =O[Filter.atTop] (fun x : ℝ => x ^ (1 - (1 / 2 : ℝ))) := by
    simpa only [show (1 : ℝ) - 1 / 2 = 1 / 2 by norm_num] using
      (hEA.add hEG).const_mul_left (2 : ℝ)
  have hb (x : ℝ) (n : ℕ) : 0 ≤ b x n :=
    add_nonneg (exceptionalPrimeDefect_nonneg x 0 _)
      (exceptionalPrimeDefect_nonneg x 1 _)
  intro ε hε
  filter_upwards [herased (ε / 2) (half_pos hε),
    canonical40_fixed_profile_prime_minorant_erasure (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i a F,
    selberg40_power_saving_error_small (𝓗 := 𝓗) tail (1 / 2) (by norm_num) htail
      (ε / (2 * ρ)) (div_pos hε (mul_pos zero_lt_two hρ))]
    with x herasedx herasex hsmall
  have hx1 : 1 < x := hsmall.1
  have hBx := hBxpos x hx1
  have hW := presieving_pos 𝓗 x
  have hNscale : x / (W x : ℝ) / Bx x / B x ^ 39 =
      ρ * (x / (W x : ℝ) / B x ^ 40) := by
    simp only [hscale x hx1, mul_pow]
    field_simp [hρ.ne', hBx.ne', (Nat.cast_pos.mpr hW : (0 : ℝ) < W x).ne']
  have hsmallTail : tail x ≤ (ε / 2) * (x / (W x : ℝ) / B x ^ 40) := by
    calc
      tail x ≤ |tail x| := le_abs_self _
      _ ≤ (ε / (2 * ρ)) * (x / (W x : ℝ) / Bx x / B x ^ 39) := hsmall.2.2
      _ = (ε / 2) * (x / (W x : ℝ) / B x ^ 40) := by
        rw [hNscale]
        field_simp [hρ.ne']
  intro v
  let I := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
  let t : ℕ → ℝ := fun n => if 2 * x < ((n + h i : ℕ) : ℝ) then
    2 * (b x n * A F x n ^ 2 + b x n * C G x n ^ 2) else 0
  have ht (n : ℕ) : 0 ≤ t n := by
    dsimp only [t]
    split_ifs
    · exact mul_nonneg zero_le_two
        (add_nonneg (mul_nonneg (hb x n) (sq_nonneg _))
          (mul_nonneg (hb x n) (sq_nonneg _)))
    · exact le_rfl
  have htsum : (∑ n ∈ I, t n) = tail x := by
    dsimp only [tail, EA, EG]
    rw [← Finset.sum_add_distrib, Finset.mul_sum]
    apply Finset.sum_congr rfl
    intro n _
    dsimp only [t]
    split_ifs <;> ring
  have hpoint (n : ℕ) (hn : n ∈ I) :
      (if Nat.ModEq (W x) n v then b x n * (A F x n - C G x n) ^ 2 else 0) ≤
        (if Nat.ModEq (W x) n v then b x n * (C F x n - C G x n) ^ 2 else 0) + t n := by
    by_cases hm : Nat.ModEq (W x) n v
    · simp only [ite_eq_left hm]
      by_cases hi : ((n + h i : ℕ) : ℝ) ≤ 2 * x
      · have hdef (j : Fin 2) := ((herasex n hn).2 hi).2 j
        have he : b x n * A F x n = b x n * C F x n := by
          simpa only [← add_mul] using congrArg₂ (fun u v : ℝ => u + v) (hdef 0) (hdef 1)
        have heq : b x n * (A F x n - C G x n) ^ 2 =
            b x n * (C F x n - C G x n) ^ 2 := by
          by_cases hz : b x n = 0
          · simp only [hz, zero_mul]
          · rw [mul_left_cancel₀ hz he]
        rw [heq]
        exact le_add_of_nonneg_right (ht n)
      · have ho : 2 * x < ((n + h i : ℕ) : ℝ) := lt_of_not_ge hi
        have hsq : (A F x n - C G x n) ^ 2 ≤ 2 * (A F x n ^ 2 + C G x n ^ 2) := by
          nlinarith only [sq_nonneg (A F x n + C G x n)]
        have hbound := mul_le_mul_of_nonneg_left hsq (hb x n)
        have htbound : b x n * (A F x n - C G x n) ^ 2 ≤ t n := by
          dsimp only [t]
          rw [ite_eq_left ho]
          exact hbound.trans_eq (by ring)
        exact htbound.trans (le_add_of_nonneg_left (mul_nonneg (hb x n) (sq_nonneg _)))
    · simp only [ite_eq_right hm, zero_add]
      exact ht n
  calc
    (∑ n ∈ I, if Nat.ModEq (W x) n v then
        b x n * (A F x n - C G x n) ^ 2 else 0) ≤
        ∑ n ∈ I, ((if Nat.ModEq (W x) n v then
          b x n * (C F x n - C G x n) ^ 2 else 0) + t n) :=
      Finset.sum_le_sum hpoint
    _ = (∑ n ∈ I, if Nat.ModEq (W x) n v then
          b x n * (C F x n - C G x n) ^ 2 else 0) + tail x := by
      rw [Finset.sum_add_distrib, htsum]
    _ ≤ (ρ * (17 / 50 : ℝ) * energy + ε / 2) *
          (x / (W x : ℝ) / B x ^ 40) +
        (ε / 2) * (x / (W x : ℝ) / B x ^ 40) :=
      add_le_add (herasedx v) hsmallTail
    _ = (ρ * (17 / 50 : ℝ) * energy + ε) * (x / (W x : ℝ) / B x ^ 40) := by ring

open Classical in
theorem physicalSource_base_row_primeIndicator_distribution
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ s : ZMod p, if s ≠ 0 ∧ s ≠ -1 then
            unnormalizedKloosterman2 p (A / s) *
              unnormalizedKloosterman2 p (B / (s + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (t : Fin 28) :
    let row := physicalSourceRow 0 t.val
    let ρ : ℝ := 2624989 / 10000000
    let «ω» : ℝ := physicalSourceOmegaPrefix 0 (t.val + 1)
    let δsrc : ℝ := (physicalSourceRho : ℝ) * (row.activation : ℝ)
    ∃ θ₀ δ₀ ε : ℝ,
      0 < θ₀ ∧ θ₀ < 1 / 2 + 2 * «ω» ∧
      0 < δ₀ ∧ δ₀ < δsrc ∧ 0 < ε ∧
      (∀ x : ℝ, 1 < x → ∀ W D E : ℕ,
        0 < W → (W : ℝ) ≤ x ^ ε → D.Coprime W → E.Coprime W →
        (∃ hY : 1 ≤ (x ^ ρ) ^ (row.activation : ℝ),
          Nonempty (DenseDivisibilityWitness
            ⟨(x ^ ρ) ^ (row.activation : ℝ), hY⟩ row.order (D.lcm E))) →
        (D.lcm E : ℝ) ≤ (x ^ ρ) ^ (row.upperBand : ℝ) →
        ∃ hδ : 1 ≤ x ^ δ₀,
          Nonempty (DenseDivisibilityWitness
            ⟨x ^ δ₀, hδ⟩ row.order (W.lcm (D.lcm E))) ∧
          (W.lcm (D.lcm E) : ℝ) ≤ x ^ θ₀) ∧
      ∀ J h : ℕ, ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
        0 < K ∧ Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
        ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
        ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
          (∑ q ∈ (Finset.Icc 1 ⌊x ^ θ₀⌋₊).filter (fun q =>
            q ∣ ∏ p ∈ I, p ∧
            Nonempty (DenseDivisibilityWitness
              ⟨max 1 (x ^ δ₀), by exact le_max_left (1 : ℝ) (x ^ δ₀)⟩ row.order q)),
            (q.divisors.card : ℝ) ^ J *
              ‖fullDiscrepancy
                (∑ n ∈ Finset.Icc ⌈x + (h : ℝ)⌉₊ ⌊2 * x + (h : ℝ)⌋₊,
                  Finsupp.single n (if n.Prime then (1 : ℂ) else 0)) q a‖) ≤
              K * x / (Real.log x) ^ A := by
  intro row ρ «ω» δsrc
  let σ : ℝ := 100001 / 1000000
  obtain ⟨hω, hω12, hδsrc, hδupper, _, hσhalf, hσgap, hII, hIII, _,
    hI1, hI2, hOld, _⟩ := physicalSource_retained_row_parameter_ranges 0 t
  have hωquarter : «ω» < 1 / 4 := by linarith only [hω12]
  have hσ0 : 1 / 10 < σ := (hOld rfl).1
  have hIII' : 1 / 18 + 28 / 9 * «ω» + 2 / 9 * δsrc < σ := by
    change 1 / 18 + 28 * «ω» / 9 + 2 * δsrc / 9 < σ at hIII
    linarith only [hIII]
  obtain ⟨θ₀, δ₀, ε, hθ₀, hθgap, hδ₀, hδgap, hε, hgeometry⟩ :=
    physicalSourceRow_strict_presieve_retreat 0 t
  have hL0sub : Filter.Tendsto
      (fun x : ℝ => Real.log (1 : ℝ) / Real.log x) Filter.atTop (nhds 0) := by
    simp only [Real.log_one, zero_div]
    exact tendsto_const_nhds
  have horder : row.order = 1 ∨ row.order = 2 ∨ row.order = 3 := by
    change physicalSourceOrder t.val = 1 ∨
      physicalSourceOrder t.val = 2 ∨ physicalSourceOrder t.val = 3
    unfold physicalSourceOrder
    split_ifs <;> simp
  have hinterval (J : ℕ) (A : ℝ) (hA : 0 < A) :
      ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
      ∀ u v : ℝ, x ≤ u → u ≤ v → v ≤ 2 * x →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊x ^ θ₀⌋₊).filter (fun q =>
          q ∣ ∏ p ∈ I, p ∧
          Nonempty (DenseDivisibilityWitness
            ⟨max 1 (x ^ δ₀), le_max_left (1 : ℝ) (x ^ δ₀)⟩ row.order q)),
          (q.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy
              (∑ n ∈ Finset.Icc ⌈u⌉₊ ⌊v⌋₊,
                Finsupp.single n (if n.Prime then (1 : ℂ) else 0)) q a‖) ≤
            K * x / (Real.log x) ^ A := by
    rcases horder with horder | horder | horder
    · simpa only [horder, mul_one, Nat.cast_zero, add_zero] using
        source_mpz1_primeIndicator_coherent_divisor_weight_log_saving_of_deligne
          hDeligne «ω» δsrc σ hω hωquarter hδsrc hδupper hσ0 hσhalf hσgap
          (hI1 horder) hII hIII' θ₀ δ₀ hθ₀ hθgap hδ₀ hδgap
          (fun _ => 1) (fun _ => zero_lt_one) hL0sub J 0 A hA
    · simpa only [horder, mul_one, Nat.cast_zero, add_zero] using
        source_mpz2_primeIndicator_coherent_divisor_weight_log_saving_of_deligne
          hDeligne «ω» δsrc σ hω hωquarter hδsrc hδupper hσ0 hσhalf hσgap
          (hI2 horder) hII hIII' θ₀ δ₀ hθ₀ hθgap hδ₀ hδgap
          (fun _ => 1) (fun _ => zero_lt_one) hL0sub J 0 A hA
    · simpa only [horder, mul_one] using
        source_mpz3_primeIndicator_coherent_divisor_weight_log_saving_of_deligne
          hDeligne «ω» δsrc hω hδsrc ((hOld rfl).2 horder)
          θ₀ δ₀ hθ₀ hθgap hδ₀ hδgap (fun _ => 1) (fun _ => zero_lt_one) hL0sub J A hA
  refine ⟨θ₀, δ₀, ε, hθ₀, hθgap, hδ₀, hδgap, hε, hgeometry, ?_⟩
  intro J h A hA
  obtain ⟨K, X, hK, hX, hbound⟩ := hinterval J A hA
  refine ⟨2 * K, max X (h : ℝ), mul_pos zero_lt_two hK,
    hX.trans (le_max_left _ _), ?_⟩
  intro x hx I hI a ha
  have hxX : X ≤ x := (le_max_left _ _).trans hx
  have hhx : (h : ℝ) ≤ x := (le_max_right _ _).trans hx
  have hxexp : Real.exp 1 ≤ x := hX.trans hxX
  have hx1 : 1 < x := (Real.one_lt_exp_iff.mpr zero_lt_one).trans_le hxexp
  have hx0 : 0 < x := zero_lt_one.trans hx1
  let y : ℝ := x + (h : ℝ)
  have hxy : x ≤ y := le_add_of_nonneg_right (Nat.cast_nonneg h)
  have hy2 : y ≤ 2 * x := by dsimp only [y]; linarith only [hhx]
  let Q : ℝ → Finset ℕ := fun z =>
    (Finset.Icc 1 ⌊z ^ θ₀⌋₊).filter (fun q =>
      q ∣ ∏ p ∈ I, p ∧
      Nonempty (DenseDivisibilityWitness
        ⟨max 1 (z ^ δ₀), le_max_left (1 : ℝ) (z ^ δ₀)⟩ row.order q))
  let u : ℕ →₀ ℂ :=
    ∑ n ∈ Finset.Icc ⌈x + (h : ℝ)⌉₊ ⌊2 * x + (h : ℝ)⌋₊,
      Finsupp.single n (if n.Prime then (1 : ℂ) else 0)
  have hsubset : Q x ⊆ Q y :=
    (Finset.filter_subset_filter _ (Finset.Icc_subset_Icc le_rfl
      (Nat.floor_mono (Real.rpow_le_rpow hx0.le hxy hθ₀.le)))).trans
      (Finset.monotone_filter_right _ (fun q _ hq => ⟨hq.1,
        denseDivisibility_mono_scale
          (max_le_max le_rfl (Real.rpow_le_rpow hx0.le hxy hδ₀.le)) hq.2⟩))
  have hs := hbound y (hxX.trans hxy) y (2 * x + (h : ℝ)) le_rfl
    (by dsimp only [y]; linarith only [hx0])
    (by dsimp only [y]
        linarith only [show (0 : ℝ) ≤ (h : ℝ) from Nat.cast_nonneg h]) I hI a ha
  change (∑ q ∈ Q y, (q.divisors.card : ℝ) ^ J *
    ‖fullDiscrepancy u q a‖) ≤ K * y / (Real.log y) ^ A at hs
  have hlogx : 0 < Real.log x := Real.log_pos hx1
  have hlogpow : (Real.log x) ^ A ≤ (Real.log y) ^ A :=
    Real.rpow_le_rpow hlogx.le (Real.log_le_log hx0 hxy) hA.le
  have hKy : K * y ≤ (2 * K) * x := by
    calc
      K * y ≤ K * (2 * x) := mul_le_mul_of_nonneg_left hy2 hK.le
      _ = (2 * K) * x := by ring
  calc
    (∑ q ∈ Q x, (q.divisors.card : ℝ) ^ J *
        ‖fullDiscrepancy u q a‖) ≤
        ∑ q ∈ Q y, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy u q a‖ :=
      Finset.sum_le_sum_of_subset_of_nonneg hsubset
        (fun q _ _ => mul_nonneg (pow_nonneg (Nat.cast_nonneg _) _) (norm_nonneg _))
    _ ≤ K * y / (Real.log y) ^ A := hs
    _ ≤ (2 * K) * x / (Real.log x) ^ A :=
      div_le_div₀ (mul_nonneg (mul_nonneg zero_le_two hK.le) hx0.le) hKy
        (Real.rpow_pos_of_pos hlogx A) hlogpow

open Classical in
theorem physicalSource_common_self_primeIndicator_distribution
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ s : ZMod p, if s ≠ 0 ∧ s ≠ -1 then
            unnormalizedKloosterman2 p (A / s) *
              unnormalizedKloosterman2 p (B / (s + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ))) :
    let ρ : ℝ := 2624989 / 10000000
    let δs : ℝ := 21319 / 800000
    let ξs : ℝ := (((21319 / 800000 : ℚ) / physicalSourceRho) : ℝ)
    let T : ℝ := physicalSourceInnerRadius 1
    let θsrc : ℝ := 1 / 2 + 2 * (31 / 10000)
    let δ0 : ℝ := ((ρ + (physicalSourceRho : ℝ)) / 2) * ξs
    let θ0 : ℝ := (2 * ρ * T + θsrc) / 2
    let ε : ℝ := min ((θsrc - 2 * ρ * T) / 4) (ρ * ξs / 2)
    0 < δ0 ∧ δ0 < δs ∧ 0 < θ0 ∧ θ0 < θsrc ∧ 0 < ε ∧
      (∀ x : ℝ, 1 < x → ∀ W D E : ℕ,
        0 < W → (W : ℝ) ≤ x ^ ε → D.Coprime W → E.Coprime W →
        (∃ hY : 1 ≤ (x ^ ρ) ^ ξs,
          Nonempty (DenseDivisibilityWitness
            ⟨(x ^ ρ) ^ ξs, hY⟩ 2 (D.lcm E))) →
        (D.lcm E : ℝ) ≤ (x ^ ρ) ^ (2 * T) →
        ∃ hδ : 1 ≤ x ^ δ0,
          Nonempty (DenseDivisibilityWitness
            ⟨x ^ δ0, hδ⟩ 2 (W.lcm (D.lcm E))) ∧
          (W.lcm (D.lcm E) : ℝ) ≤ x ^ θ0) ∧
      ∀ J h : ℕ, ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
        0 < K ∧ Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
        ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
        ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
          (∑ q ∈ (Finset.Icc 1 ⌊x ^ θ0⌋₊).filter (fun q =>
            q ∣ ∏ p ∈ I, p ∧
            Nonempty (DenseDivisibilityWitness
              ⟨max 1 (x ^ δ0), by exact le_max_left (1 : ℝ) (x ^ δ0)⟩ 2 q)),
            (q.divisors.card : ℝ) ^ J *
              ‖fullDiscrepancy
                (∑ n ∈ Finset.Icc ⌈x + (h : ℝ)⌉₊ ⌊2 * x + (h : ℝ)⌋₊,
                  Finsupp.single n (if n.Prime then (1 : ℂ) else 0)) q a‖) ≤
              K * x / (Real.log x) ^ A := by
  intro ρ δs ξs T θsrc δ0 θ0 ε
  obtain ⟨hδ0, hδgap, hθ0, hθgap, hε, hgeometry⟩ :=
    physicalSource_common_self_strict_presieve_retreat
  refine ⟨hδ0, hδgap, hθ0, hθgap, hε, hgeometry, ?_⟩
  intro J h A hA
  obtain ⟨⟨hω, _hω12, hωquarter⟩, ⟨hδ, hδupper⟩,
    ⟨hσ0, hσhalf, hσgap, hI, hII, hIII⟩, _hminorant⟩ :=
    physicalSource_common_self_parameters
  have hL0sub : Filter.Tendsto
      (fun x : ℝ => Real.log (1 : ℝ) / Real.log x) Filter.atTop (nhds 0) := by
    simp only [Real.log_one, zero_div]
    exact tendsto_const_nhds
  obtain ⟨K, X, hK, hX, hbound⟩ :=
    source_mpz2_primeIndicator_coherent_divisor_weight_log_saving_of_deligne
      hDeligne (31 / 10000) δs (100001 / 1000000)
      hω hωquarter hδ hδupper hσ0 hσhalf hσgap hI hII hIII
      θ0 δ0 hθ0 hθgap hδ0 hδgap
      (fun _ => 1) (fun _ => zero_lt_one) hL0sub J h A hA
  refine ⟨K, X, hK, hX, ?_⟩
  intro x hx I hI a ha
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le (hX.trans hx)
  simpa only [mul_one] using
    hbound x hx x (2 * x) le_rfl (by linarith) le_rfl I hI a ha

theorem physicalSource_sampled_inner_self_pair_classification
    (W : ℕ) (R κ Z₀ Z₁ : ℝ) (hR : 1 < R)
    (f g : (Fin 40 → ℕ) → ℝ) (i : Fin 40) (d e : Fin 39 → ℕ) :
    let q := ∏ p ∈ fragmentPrimes W R κ, p
    let T := (Fintype.piFinset (fun _ : Fin 40 => q.divisors)).filter
      (fun r => Squarefree (∏ j, r j))
    let y := ∑ r ∈ T, Finsupp.single r (f r / Z₀)
    let y' := ∑ r ∈ T, Finsupp.single r (g r / Z₁)
    let z : (Fin 39 → ℕ) →₀ ℝ :=
      y.sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
        (yr / ((r i).totient : ℝ)))
    let z' : (Fin 39 → ℕ) →₀ ℝ :=
      y'.sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
        (yr / ((r i).totient : ℝ)))
    (∀ r ∈ T, f r ≠ 0 →
      physicalSourceInnerSupport 1
        (fun j => primeLogConfiguration R (r (i.succAbove j))) = 1 ∧
      logSize R (∏ j : Fin 39, r (i.succAbove j)) ≤ (physicalSourceInnerRadius 1 : ℝ)) →
    (∀ r ∈ T, g r ≠ 0 →
      physicalSourceInnerSupport 1
        (fun j => primeLogConfiguration R (r (i.succAbove j))) = 1 ∧
      logSize R (∏ j : Fin 39, r (i.succAbove j)) ≤ (physicalSourceInnerRadius 1 : ℝ)) →
    selbergCoefficient z d ≠ 0 →
    selbergCoefficient z' e ≠ 0 →
      Squarefree (∏ j, d j) ∧ (∏ j, d j).Coprime W ∧ (∏ j, d j) ∣ q ∧
      Squarefree (∏ j, e j) ∧ (∏ j, e j).Coprime W ∧ (∏ j, e j) ∣ q ∧
      (Nat.lcm (∏ j, d j) (∏ j, e j) : ℝ) ≤ R ^ (2 * (physicalSourceInnerRadius 1 : ℝ)) ∧
      ((Nat.lcm (∏ j, d j) (∏ j, e j) : ℝ) ≤
          R ^ ((((1 / 2 : ℚ) / physicalSourceRho) : ℝ)) ∨
        ∃ hξ : 1 ≤ R ^ ((((21319 / 800000 : ℚ) / physicalSourceRho) : ℝ)),
          Nonempty (DenseDivisibilityWitness
            ⟨R ^ ((((21319 / 800000 : ℚ) / physicalSourceRho) : ℝ)), hξ⟩
            2 (Nat.lcm (∏ j, d j) (∏ j, e j)))) := by
  classical
  intro q T y y' z z' hf hg hd he
  obtain ⟨hD, hDW, hDq, r, hr, hfr, hdr⟩ :=
    selberg_sampled_erased_coefficient_presieve W R κ Z₀ f i d hd
  obtain ⟨hE, hEW, hEq, s, hs, hgs, hes⟩ :=
    selberg_sampled_erased_coefficient_presieve W R κ Z₁ g i e he
  have hret (v : Fin 40 → ℕ) :
      (∏ j : Fin 39, v (i.succAbove j)) ∣ ∏ j : Fin 40, v j := by
    rw [Fin.prod_univ_succAbove _ i]
    exact dvd_mul_left _ _
  have hrSf : Squarefree (∏ j : Fin 39, r (i.succAbove j)) :=
    (Finset.mem_filter.mp hr).2.squarefree_of_dvd (hret r)
  have hsSf : Squarefree (∏ j : Fin 39, s (i.succAbove j)) :=
    (Finset.mem_filter.mp hs).2.squarefree_of_dvd (hret s)
  have hDr : (∏ j, d j) ∣ ∏ j : Fin 39, r (i.succAbove j) :=
    Finset.prod_dvd_prod_of_dvd (s := Finset.univ) d
      (fun j => r (i.succAbove j)) (fun j _ => hdr j)
  have hEs : (∏ j, e j) ∣ ∏ j : Fin 39, s (i.succAbove j) :=
    Finset.prod_dvd_prod_of_dvd (s := Finset.univ) e
      (fun j => s (i.succAbove j)) (fun j _ => hes j)
  have hDpos : 0 < ∏ j, d j := Nat.pos_of_ne_zero hD.ne_zero
  have hEpos : 0 < ∏ j, e j := Nat.pos_of_ne_zero hE.ne_zero
  have hDsize : logSize R (∏ j, d j) ≤ (physicalSourceInnerRadius 1 : ℝ) :=
    (Real.logb_le_logb_of_le hR (Nat.cast_pos.mpr hDpos)
      (Nat.cast_le.mpr (Nat.le_of_dvd (Nat.pos_of_ne_zero hrSf.ne_zero) hDr))).trans
        (hf r hr hfr).2
  have hEsize : logSize R (∏ j, e j) ≤ (physicalSourceInnerRadius 1 : ℝ) :=
    (Real.logb_le_logb_of_le hR (Nat.cast_pos.mpr hEpos)
      (Nat.cast_le.mpr (Nat.le_of_dvd (Nat.pos_of_ne_zero hsSf.ne_zero) hEs))).trans
        (hg s hs hgs).2
  have hDpow : ((∏ j, d j : ℕ) : ℝ) ≤ R ^ (physicalSourceInnerRadius 1 : ℝ) :=
    (Real.logb_le_iff_le_rpow hR (Nat.cast_pos.mpr hDpos)).mp hDsize
  have hEpow : ((∏ j, e j : ℕ) : ℝ) ≤ R ^ (physicalSourceInnerRadius 1 : ℝ) :=
    (Real.logb_le_iff_le_rpow hR (Nat.cast_pos.mpr hEpos)).mp hEsize
  refine ⟨hD, hDW, hDq, hE, hEW, hEq, ?_, ?_⟩
  · calc
      (Nat.lcm (∏ j, d j) (∏ j, e j) : ℝ) ≤
          ((∏ j, d j : ℕ) : ℝ) * ((∏ j, e j : ℕ) : ℝ) := by
        exact_mod_cast Nat.lcm_le_mul hDpos hEpos
      _ ≤ R ^ (physicalSourceInnerRadius 1 : ℝ) * R ^ (physicalSourceInnerRadius 1 : ℝ) :=
        mul_le_mul hDpow hEpow (Nat.cast_nonneg _) (Real.rpow_nonneg (zero_lt_one.trans hR).le _)
      _ = R ^ (2 * (physicalSourceInnerRadius 1 : ℝ)) := by
        rw [two_mul, Real.rpow_add (zero_lt_one.trans hR)]
  · by_cases hbase : (Nat.lcm (∏ j, d j) (∏ j, e j) : ℝ) ≤
        R ^ ((((1 / 2 : ℚ) / physicalSourceRho) : ℝ))
    · exact Or.inl hbase
    · right
      exact physicalSourceInnerSupport_common_self_lcm_dense R hR
        (fun j => r (i.succAbove j)) (fun j => s (i.succAbove j)) hrSf hsSf
        (hf r hr hfr).1 (hg s hs hgs).1 (∏ j, d j) (∏ j, e j) hDr hEs
        (lt_of_not_ge hbase)

theorem physicalSource_clipped_literalMinorant_transfer
    {ι : Type*} (θ : ℝ) (hθ : 0 < θ) (hθone : θ < 1)
    (Q : ℝ → ι → Finset ℕ) (a : ℝ → ι → ℕ → ℕ)
    (hQ : ∀ x : ℝ, ∀ i : ι, Q x i ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊)
    (J h : ℕ) :
    let u : ℝ → ℕ →₀ ℂ := fun x =>
      ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
        Finsupp.single n
          (((if n.Prime then (1 : ℝ) else 0) -
            exceptionalPrimeDefect x 0 n -
            exceptionalPrimeDefect x 1 n : ℝ) : ℂ)
    (∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ i : ι,
        (∑ q ∈ Q x i, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy (u x) q (a x i q)‖) ≤
            K * x / (Real.log x) ^ A) →
      ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
        ∀ x : ℝ, X ≤ x → ∀ i : ι,
          let v : ℕ →₀ ℂ :=
            ∑ n ∈ Finset.Icc ⌈x + (h : ℝ)⌉₊ ⌊2 * x⌋₊,
              Finsupp.single n
                (((if n.Prime then (1 : ℝ) else 0) -
                  exceptionalPrimeDefect x 0 n -
                  exceptionalPrimeDefect x 1 n : ℝ) : ℂ)
          (∑ q ∈ Q x i, (q.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy v q (a x i q)‖) ≤
              K * x / (Real.log x) ^ A := by
  classical
  intro u hsource A hA
  obtain ⟨K, X, hK, _hX, hbound⟩ := hsource A hA
  obtain ⟨Ke, Xe, hKe, _hXe, herror⟩ :=
    clipped_literal_minorant_discrepancy_error h θ J hθ hθone A hA
  refine ⟨K + Ke, max (max X Xe) (Real.exp 1), add_pos hK hKe,
    le_max_right _ _, ?_⟩
  intro x hx i v
  have hxX : X ≤ x := (le_max_left _ _).trans ((le_max_left _ _).trans hx)
  have hxXe : Xe ≤ x := (le_max_right _ _).trans ((le_max_left _ _).trans hx)
  have he :
      (∑ q ∈ Finset.Icc 1 ⌊x ^ θ⌋₊, (q.divisors.card : ℝ) ^ J *
        ‖fullDiscrepancy (v - u x) q (a x i q)‖) ≤
          Ke * x / (Real.log x) ^ A := herror x hxXe (a x i)
  calc
    (∑ q ∈ Q x i, (q.divisors.card : ℝ) ^ J *
        ‖fullDiscrepancy v q (a x i q)‖) ≤
        (∑ q ∈ Q x i, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy (v - u x) q (a x i q)‖) +
        ∑ q ∈ Q x i, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy (u x) q (a x i q)‖ := by
      simpa only [sub_add_cancel] using
        hbBoundary_weighted_discrepancy_add_le
          (v - u x) (u x) (Q x i) (a x i) J
    _ ≤ Ke * x / (Real.log x) ^ A + K * x / (Real.log x) ^ A :=
      add_le_add
        ((Finset.sum_le_sum_of_subset_of_nonneg (hQ x i)
          (fun q _ _ => mul_nonneg (pow_nonneg (Nat.cast_nonneg _) J)
            (norm_nonneg _))).trans he)
        (hbound x hxX i)
    _ = (K + Ke) * x / (Real.log x) ^ A := by ring

theorem physicalSource_base_clipped_literalMinorant_distribution
    (θ : ℝ) (hθ : 0 < θ) (hθhalf : θ < 1 / 2) (J h : ℕ) :
    ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
      ∀ x : ℝ, X ≤ x → ∀ P : Finset ℕ,
      (∀ p ∈ P, Nat.Prime p) → ∀ a : ℕ, Nat.Coprime a (∏ p ∈ P, p) →
        (∑ q ∈ (Finset.Icc 1 ⌊x ^ θ⌋₊).filter (fun q => q ∣ ∏ p ∈ P, p),
          (q.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy
              (∑ n ∈ Finset.Icc ⌈x + (h : ℝ)⌉₊ ⌊2 * x⌋₊,
                Finsupp.single n
                  (((if n.Prime then (1 : ℝ) else 0) -
                    exceptionalPrimeDefect x 0 n -
                    exceptionalPrimeDefect x 1 n : ℝ) : ℂ)) q a‖) ≤
          K * x / (Real.log x) ^ A := by
  classical
  let ι : Type := { pa : Finset ℕ × ℕ // Nat.Coprime pa.2 (∏ p ∈ pa.1, p) }
  let Q : ℝ → ι → Finset ℕ := fun x pa =>
    (Finset.Icc 1 ⌊x ^ θ⌋₊).filter (fun q => q ∣ ∏ p ∈ pa.val.1, p)
  let residue : ℝ → ι → ℕ → ℕ := fun _ pa _ => pa.val.2
  have hQ (x : ℝ) (pa : ι) : Q x pa ⊆ Finset.Icc 1 ⌊x ^ θ⌋₊ :=
    Finset.filter_subset _ _
  let u : ℝ → ℕ →₀ ℂ := fun x =>
    ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
      Finsupp.single n
        (((if n.Prime then (1 : ℝ) else 0) -
          exceptionalPrimeDefect x 0 n -
          exceptionalPrimeDefect x 1 n : ℝ) : ℂ)
  have hsource (A : ℝ) (hA : 0 < A) :
      ∃ K X : ℝ, 0 < K ∧ 1 < X ∧ ∀ x : ℝ, X ≤ x → ∀ pa : ι,
        (∑ q ∈ Q x pa, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy (u x) q (residue x pa q)‖) ≤
            K * x / (Real.log x) ^ A := by
    obtain ⟨K, X, hK, hX, hs⟩ :=
      literal_minorant_closed_ordinary_bv_divisor_weight_log_saving
        (1 / 2 - θ) (sub_pos.mpr hθhalf) J A hA
    have hexp : (1 / 2 : ℝ) - (1 / 2 - θ) = θ := by ring
    simp only [hexp] at hs
    refine ⟨K, X, hK, hX, ?_⟩
    intro x hx pa
    let a : ℕ → ℕ := fun q => if q ∣ ∏ p ∈ pa.val.1, p then pa.val.2 else 1
    have ha (q : ℕ) (_ : q ∈ Finset.Icc 1 ⌊x ^ θ⌋₊) : Nat.Coprime (a q) q := by
      by_cases hq : q ∣ ∏ p ∈ pa.val.1, p
      · simpa only [a, ite_eq_left hq] using pa.property.coprime_dvd_right hq
      · simpa only [a, ite_eq_right hq] using Nat.coprime_one_left q
    calc
      (∑ q ∈ Q x pa, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy (u x) q (residue x pa q)‖) =
          ∑ q ∈ Q x pa, (q.divisors.card : ℝ) ^ J *
            ‖fullDiscrepancy (u x) q (a q)‖ := by
        apply Finset.sum_congr rfl
        intro q hq
        simp only [a, residue, ite_eq_left (Finset.mem_filter.mp hq).2]
      _ ≤ ∑ q ∈ Finset.Icc 1 ⌊x ^ θ⌋₊, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy (u x) q (a q)‖ :=
        Finset.sum_le_sum_of_subset_of_nonneg (hQ x pa)
          (fun q _ _ => mul_nonneg (pow_nonneg (Nat.cast_nonneg _) J) (norm_nonneg _))
      _ ≤ K * x / (Real.log x) ^ A := hs x hx a ha
  have htransfer := physicalSource_clipped_literalMinorant_transfer θ hθ
    (hθhalf.trans (by norm_num)) Q residue hQ J h hsource
  intro A hA
  obtain ⟨K, X, hK, hX, hs⟩ := htransfer A hA
  refine ⟨K, X, hK, hX, ?_⟩
  intro x hx P _hP a ha
  exact hs x hx ⟨(P, a), ha⟩

open Classical in
theorem physicalSource_enlarged_row_literalMinorant_distribution
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ s : ZMod p, if s ≠ 0 ∧ s ≠ -1 then
            unnormalizedKloosterman2 p (A / s) *
              unnormalizedKloosterman2 p (B / (s + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (t : Fin 39) :
    let row := physicalSourceRow 1 t.val
    let ρ : ℝ := 2624989 / 10000000
    let «ω» : ℝ := physicalSourceOmegaPrefix 1 (t.val + 1)
    let δsrc : ℝ := (physicalSourceRho : ℝ) * (row.activation : ℝ)
    ∃ θ₀ δ₀ ε : ℝ,
      0 < θ₀ ∧ θ₀ < 1 / 2 + 2 * «ω» ∧
      0 < δ₀ ∧ δ₀ < δsrc ∧ 0 < ε ∧
      (∀ x : ℝ, 1 < x → ∀ W D E : ℕ,
        0 < W → (W : ℝ) ≤ x ^ ε → D.Coprime W → E.Coprime W →
        (∃ hY : 1 ≤ (x ^ ρ) ^ (row.activation : ℝ),
          Nonempty (DenseDivisibilityWitness
            ⟨(x ^ ρ) ^ (row.activation : ℝ), hY⟩ row.order (D.lcm E))) →
        (D.lcm E : ℝ) ≤ (x ^ ρ) ^ (row.upperBand : ℝ) →
        ∃ hδ : 1 ≤ x ^ δ₀,
          Nonempty (DenseDivisibilityWitness
            ⟨x ^ δ₀, hδ⟩ row.order (W.lcm (D.lcm E))) ∧
          (W.lcm (D.lcm E) : ℝ) ≤ x ^ θ₀) ∧
      ∀ J h : ℕ, ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
        0 < K ∧ Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
        ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
        ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
          (∑ q ∈ (Finset.Icc 1 ⌊x ^ θ₀⌋₊).filter (fun q =>
            q ∣ ∏ p ∈ I, p ∧
            Nonempty (DenseDivisibilityWitness
              ⟨max 1 (x ^ δ₀), by exact le_max_left (1 : ℝ) (x ^ δ₀)⟩ row.order q)),
            (q.divisors.card : ℝ) ^ J *
              ‖fullDiscrepancy
                (∑ n ∈ Finset.Icc ⌈x + (h : ℝ)⌉₊ ⌊2 * x + (h : ℝ)⌋₊,
                  Finsupp.single n
                    (((if n.Prime then (1 : ℝ) else 0) -
                      exceptionalPrimeDefect x 0 n -
                      exceptionalPrimeDefect x 1 n : ℝ) : ℂ)) q a‖) ≤
              K * x / (Real.log x) ^ A := by
  intro row ρ «ω» δsrc
  obtain ⟨hω, _, hδsrc, _, _, _, _, hII, _hIIIold, hlevelsmall,
    hI1, hI2, _, hNew⟩ := physicalSource_retained_row_parameter_ranges 1 t
  obtain ⟨hsmooth, hthree, hlevel, hthird⟩ := hNew rfl
  obtain ⟨θ₀, δ₀, ε, hθ₀, hθgap, hδ₀, hδgap, hε, hgeometry⟩ :=
    physicalSourceRow_strict_presieve_retreat 1 t
  have hθsmall : θ₀ < 2 / 3 := hθgap.trans hlevelsmall
  have hθone : θ₀ < 1 := hθsmall.trans (by norm_num)
  have hL0sub : Filter.Tendsto
      (fun x : ℝ => Real.log (1 : ℝ) / Real.log x) Filter.atTop (nhds 0) := by
    simp only [Real.log_one, zero_div]
    exact tendsto_const_nhds
  let u : ℝ → ℕ →₀ ℂ := fun x =>
    ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
      Finsupp.single n
        (((if n.Prime then (1 : ℝ) else 0) -
          exceptionalPrimeDefect x 0 n -
          exceptionalPrimeDefect x 1 n : ℝ) : ℂ)
  let Qsrc (x : ℝ) (Y : Set.Ici (1 : ℝ)) (I : Finset ℕ) : Finset ℕ :=
    (Finset.Icc 1 ⌊x ^ (1 / 2 + 2 * «ω»)⌋₊).filter (fun q =>
      q ∣ ∏ p ∈ I, p ∧
      Nonempty (DenseDivisibilityWitness Y row.order q))
  have horder : row.order = 1 ∨ row.order = 2 ∨ row.order = 3 := by
    change physicalSourceOrder t.val = 1 ∨
      physicalSourceOrder t.val = 2 ∨ physicalSourceOrder t.val = 3
    unfold physicalSourceOrder
    split_ifs <;> simp
  have hsource (A : ℝ) (hA : 0 < A) :
      ∃ K X : ℝ, 0 < K ∧ 1 < X ∧ ∀ x : ℝ, X ≤ x →
      ∀ Y : Set.Ici (1 : ℝ), (Y : ℝ) = x ^ δsrc →
      ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
      ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
        (∑ q ∈ Qsrc x Y I, ‖fullDiscrepancy (u x) q a‖) ≤
          K * x / (Real.log x) ^ A := by
    simpa only [Qsrc, u, mul_one] using
      literal_minorant_closed_source_coherent_log_saving_of_deligne
        hDeligne row.order «ω» δsrc hω hδsrc
        (by linarith only [hlevel]) (by linarith only [hsmooth])
        (by linarith only [hthree])
        (by
          rcases horder with horder | horder | horder
          · have hi : 54 * «ω» + 15 * δsrc +
                5 * (1 / 2 - 40481 / 100000 + 1 / (10 : ℝ) ^ 10) < 1 := by
              simpa only [ite_eq_right (show ¬(1 : Fin 2) = 0 by decide)] using hI1 horder
            exact Or.inl ⟨horder, by linarith only [hi], hII⟩
          · have hi : 56 * «ω» + 16 * δsrc +
                4 * (1 / 2 - 40481 / 100000 + 1 / (10 : ℝ) ^ 10) < 1 := by
              simpa only [ite_eq_right (show ¬(1 : Fin 2) = 0 by decide)] using hI2 horder
            exact Or.inr (Or.inl ⟨horder, by linarith only [hi], hII⟩)
          · obtain ⟨hI, hII', hIII'⟩ := hthird horder
            exact Or.inr (Or.inr ⟨horder, hI,
              by linarith only [hII'], by linarith only [hIII']⟩))
        (fun _ => 1) (fun _ => zero_lt_one) hL0sub A hA
  let ι : Type := { ia : Finset ℕ × ℕ //
    (∀ p ∈ ia.1, Nat.Prime p) ∧ Nat.Coprime ia.2 (∏ p ∈ ia.1, p) }
  let Q (x : ℝ) (ia : ι) : Finset ℕ :=
    (Finset.Icc 1 ⌊x ^ θ₀⌋₊).filter (fun q =>
      q ∣ ∏ p ∈ ia.val.1, p ∧
      Nonempty (DenseDivisibilityWitness
        ⟨max 1 (x ^ δ₀), le_max_left (1 : ℝ) (x ^ δ₀)⟩ row.order q))
  let residue : ℝ → ι → ℕ → ℕ := fun _ ia _ => ia.val.2
  have hQ (x : ℝ) (ia : ι) : Q x ia ⊆ Finset.Icc 1 ⌊x ^ θ₀⌋₊ :=
    Finset.filter_subset _ _
  have hresidue (x : ℝ) (ia : ι) (q : ℕ) (hq : q ∈ Q x ia) :
      Nat.Coprime (residue x ia q) q :=
    ia.property.2.coprime_dvd_right (Finset.mem_filter.mp hq).2.1
  have hunweighted : ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ ia : ι,
        (∑ q ∈ Q x ia, ‖fullDiscrepancy (u x) q
          (residue x ia q)‖) ≤ K * x / (Real.log x) ^ A := by
    intro A hA
    obtain ⟨K, X, hK, hX, hbound⟩ := hsource A hA
    refine ⟨K, X, hK, hX, ?_⟩
    intro x hx ia
    have hx1 : 1 < x := hX.trans_le hx
    let Y : Set.Ici (1 : ℝ) := ⟨x ^ δsrc, Real.one_le_rpow hx1.le hδsrc.le⟩
    have hsubset : Q x ia ⊆ Qsrc x Y ia.val.1 :=
      (Finset.filter_subset_filter _ (Finset.Icc_subset_Icc le_rfl
        (Nat.floor_mono (Real.rpow_le_rpow_of_exponent_le hx1.le hθgap.le)))).trans
        (Finset.monotone_filter_right _ (fun q _ hq => ⟨hq.1,
          denseDivisibility_mono_scale
            (max_le (Real.one_le_rpow hx1.le hδsrc.le)
              (Real.rpow_le_rpow_of_exponent_le hx1.le hδgap.le)) hq.2⟩))
    exact (Finset.sum_le_sum_of_subset_of_nonneg hsubset
      (fun q _ _ => norm_nonneg
        (fullDiscrepancy (u x) q ia.val.2))).trans
          (hbound x hx Y rfl ia.val.1 ia.property.1 ia.val.2 ia.property.2)
  refine ⟨θ₀, δ₀, ε, hθ₀, hθgap, hδ₀, hδgap, hε, hgeometry, ?_⟩
  intro J h A hA
  obtain ⟨K, X, hK, _hX, hbound⟩ :
      ∃ K X : ℝ, 0 < K ∧ 1 < X ∧ ∀ x : ℝ, X ≤ x → ∀ ia : ι,
        (∑ q ∈ Q x ia, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy (u x) q (residue x ia q)‖) ≤
            K * x / (Real.log x) ^ A := by
    simpa only [u, Complex.ofReal_sub] using
      literal_minorant_divisor_weight_log_saving_of_unweighted
        θ₀ hθ₀ hθone Q residue (Filter.Eventually.of_forall hQ)
        (Filter.Eventually.of_forall hresidue) J
        (by simpa only [u, Complex.ofReal_sub] using hunweighted) A hA
  obtain ⟨Ke, Xe, hKe, _hXe, hshift⟩ :=
    literal_minorant_fixed_shift_divisor_weight_log_saving
      h θ₀ hθ₀ hθone J A hA
  refine ⟨K + Ke, max (max X Xe) (Real.exp 1), add_pos hK hKe,
    le_max_right _ _, ?_⟩
  intro x hx I hI a ha
  let ia : ι := ⟨(I, a), hI, ha⟩
  have hxX : X ≤ x := (le_max_left _ _).trans ((le_max_left _ _).trans hx)
  have hxXe : Xe ≤ x := (le_max_right _ _).trans ((le_max_left _ _).trans hx)
  have hx0 : 0 < x := (Real.exp_pos 1).trans_le ((le_max_right _ _).trans hx)
  let v : ℕ →₀ ℂ :=
    ∑ n ∈ Finset.Icc ⌈x + (h : ℝ)⌉₊ ⌊2 * x + (h : ℝ)⌋₊,
      Finsupp.single n
        (((if n.Prime then (1 : ℝ) else 0) -
          exceptionalPrimeDefect x 0 n -
          exceptionalPrimeDefect x 1 n : ℝ) : ℂ)
  have he :
      (∑ q ∈ Finset.Icc 1 ⌊x ^ θ₀⌋₊, (q.divisors.card : ℝ) ^ J *
        ‖fullDiscrepancy (v - u x) q a‖) ≤
          Ke * x / (Real.log x) ^ A := by
    simpa only [v, u, Complex.ofReal_sub, Nat.ceil_add_natCast hx0.le h,
      Nat.floor_add_natCast (show 0 ≤ 2 * x by positivity) h] using
        hshift x hxXe (fun _ => a)
  calc
    (∑ q ∈ Q x ia, (q.divisors.card : ℝ) ^ J *
        ‖fullDiscrepancy v q (a)‖) ≤
        (∑ q ∈ Q x ia, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy (v - u x) q (a)‖) +
        ∑ q ∈ Q x ia, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy (u x) q (a)‖ := by
      simpa only [sub_add_cancel] using
        hbBoundary_weighted_discrepancy_add_le
          (v - u x) (u x) (Q x ia) (fun _ => a) J
    _ ≤ Ke * x / (Real.log x) ^ A + K * x / (Real.log x) ^ A :=
      add_le_add
        ((Finset.sum_le_sum_of_subset_of_nonneg (hQ x ia)
          (fun q _ _ => mul_nonneg (pow_nonneg (Nat.cast_nonneg _) J)
            (norm_nonneg _))).trans he)
        (hbound x hxX ia)
    _ = (K + Ke) * x / (Real.log x) ^ A := by ring

open Classical in
theorem physicalSource_enlarged_row_clipped_literalMinorant_distribution
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ s : ZMod p, if s ≠ 0 ∧ s ≠ -1 then
            unnormalizedKloosterman2 p (A / s) *
              unnormalizedKloosterman2 p (B / (s + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (t : Fin 39) :
    let row := physicalSourceRow 1 t.val
    let ρ : ℝ := 2624989 / 10000000
    let «ω» : ℝ := physicalSourceOmegaPrefix 1 (t.val + 1)
    let δsrc : ℝ := (physicalSourceRho : ℝ) * (row.activation : ℝ)
    ∃ θ₀ δ₀ ε : ℝ,
      0 < θ₀ ∧ θ₀ < 1 / 2 + 2 * «ω» ∧
      0 < δ₀ ∧ δ₀ < δsrc ∧ 0 < ε ∧
      (∀ x : ℝ, 1 < x → ∀ W D E : ℕ,
        0 < W → (W : ℝ) ≤ x ^ ε → D.Coprime W → E.Coprime W →
        (∃ hY : 1 ≤ (x ^ ρ) ^ (row.activation : ℝ),
          Nonempty (DenseDivisibilityWitness
            ⟨(x ^ ρ) ^ (row.activation : ℝ), hY⟩ row.order (D.lcm E))) →
        (D.lcm E : ℝ) ≤ (x ^ ρ) ^ (row.upperBand : ℝ) →
        ∃ hδ : 1 ≤ x ^ δ₀,
          Nonempty (DenseDivisibilityWitness
            ⟨x ^ δ₀, hδ⟩ row.order (W.lcm (D.lcm E))) ∧
          (W.lcm (D.lcm E) : ℝ) ≤ x ^ θ₀) ∧
      ∀ J h : ℕ, ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
        0 < K ∧ Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
        ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
        ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
          (∑ q ∈ (Finset.Icc 1 ⌊x ^ θ₀⌋₊).filter (fun q =>
            q ∣ ∏ p ∈ I, p ∧
            Nonempty (DenseDivisibilityWitness
              ⟨max 1 (x ^ δ₀), by exact le_max_left (1 : ℝ) (x ^ δ₀)⟩ row.order q)),
            (q.divisors.card : ℝ) ^ J *
              ‖fullDiscrepancy
                (∑ n ∈ Finset.Icc ⌈x + (h : ℝ)⌉₊ ⌊2 * x⌋₊,
                  Finsupp.single n
                    (((if n.Prime then (1 : ℝ) else 0) -
                      exceptionalPrimeDefect x 0 n -
                      exceptionalPrimeDefect x 1 n : ℝ) : ℂ)) q a‖) ≤
              K * x / (Real.log x) ^ A := by
  intro row ρ «ω» δsrc
  obtain ⟨θ₀, δ₀, ε, hθ₀, hθgap, hδ₀, hδgap, hε, hgeometry, hfull⟩ :=
    physicalSource_enlarged_row_literalMinorant_distribution hDeligne t
  obtain ⟨_, _, _, _, _, _, _, _, _, hlevelsmall, _⟩ :=
    physicalSource_retained_row_parameter_ranges 1 t
  have hθone : θ₀ < 1 := (hθgap.trans hlevelsmall).trans (by norm_num)
  let ι : Type := { ia : Finset ℕ × ℕ //
    (∀ p ∈ ia.1, Nat.Prime p) ∧ Nat.Coprime ia.2 (∏ p ∈ ia.1, p) }
  let Q (x : ℝ) (ia : ι) : Finset ℕ :=
    (Finset.Icc 1 ⌊x ^ θ₀⌋₊).filter (fun q =>
      q ∣ ∏ p ∈ ia.val.1, p ∧
      Nonempty (DenseDivisibilityWitness
        ⟨max 1 (x ^ δ₀), le_max_left (1 : ℝ) (x ^ δ₀)⟩ row.order q))
  let residue : ℝ → ι → ℕ → ℕ := fun _ ia _ => ia.val.2
  refine ⟨θ₀, δ₀, ε, hθ₀, hθgap, hδ₀, hδgap, hε, hgeometry, ?_⟩
  intro J h A hA
  have hcore : ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ ia : ι,
        (∑ q ∈ Q x ia, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy
            (∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
              Finsupp.single n
                (((if n.Prime then (1 : ℝ) else 0) -
                  exceptionalPrimeDefect x 0 n -
                  exceptionalPrimeDefect x 1 n : ℝ) : ℂ))
            q (residue x ia q)‖) ≤ K * x / (Real.log x) ^ A := by
    intro A hA
    obtain ⟨K, X, hK, hX, hbound⟩ := hfull J 0 A hA
    refine ⟨K, X, hK, (Real.one_lt_exp_iff.mpr zero_lt_one).trans_le hX, ?_⟩
    intro x hx ia
    simpa only [Nat.cast_zero, add_zero] using
      hbound x hx ia.val.1 ia.property.1 ia.val.2 ia.property.2
  obtain ⟨K, X, hK, hX, hbound⟩ :=
    physicalSource_clipped_literalMinorant_transfer θ₀ hθ₀ hθone Q residue
      (fun _ _ => Finset.filter_subset _ _) J h hcore A hA
  refine ⟨K, X, hK, hX, ?_⟩
  intro x hx I hI a ha
  exact hbound x hx ⟨(I, a), hI, ha⟩

open Classical in
theorem physicalSource_common_self_minorant_distribution
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ s : ZMod p, if s ≠ 0 ∧ s ≠ -1 then
            unnormalizedKloosterman2 p (A / s) *
              unnormalizedKloosterman2 p (B / (s + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ))) :
    let ρ : ℝ := 2624989 / 10000000
    let δs : ℝ := 21319 / 800000
    let ξs : ℝ := (((21319 / 800000 : ℚ) / physicalSourceRho) : ℝ)
    let T : ℝ := physicalSourceInnerRadius 1
    let θsrc : ℝ := 1 / 2 + 2 * (31 / 10000)
    let δ0 : ℝ := ((ρ + (physicalSourceRho : ℝ)) / 2) * ξs
    let θ0 : ℝ := (2 * ρ * T + θsrc) / 2
    let ε : ℝ := min ((θsrc - 2 * ρ * T) / 4) (ρ * ξs / 2)
    0 < δ0 ∧ δ0 < δs ∧ 0 < θ0 ∧ θ0 < θsrc ∧ 0 < ε ∧
      (∀ x : ℝ, 1 < x → ∀ W D E : ℕ,
        0 < W → (W : ℝ) ≤ x ^ ε → D.Coprime W → E.Coprime W →
        (∃ hY : 1 ≤ (x ^ ρ) ^ ξs,
          Nonempty (DenseDivisibilityWitness
            ⟨(x ^ ρ) ^ ξs, hY⟩ 2 (D.lcm E))) →
        (D.lcm E : ℝ) ≤ (x ^ ρ) ^ (2 * T) →
        ∃ hδ : 1 ≤ x ^ δ0,
          Nonempty (DenseDivisibilityWitness
            ⟨x ^ δ0, hδ⟩ 2 (W.lcm (D.lcm E))) ∧
          (W.lcm (D.lcm E) : ℝ) ≤ x ^ θ0) ∧
      ∀ J h : ℕ, ∀ A : ℝ, 0 < A → ∃ K X : ℝ,
        0 < K ∧ Real.exp 1 ≤ X ∧ ∀ x : ℝ, X ≤ x →
        ∀ I : Finset ℕ, (∀ p ∈ I, Nat.Prime p) →
        ∀ a : ℕ, Nat.Coprime a (∏ p ∈ I, p) →
          (∑ q ∈ (Finset.Icc 1 ⌊x ^ θ0⌋₊).filter (fun q =>
            q ∣ ∏ p ∈ I, p ∧
            Nonempty (DenseDivisibilityWitness
              ⟨max 1 (x ^ δ0), by exact le_max_left (1 : ℝ) (x ^ δ0)⟩ 2 q)),
            (q.divisors.card : ℝ) ^ J *
              ‖fullDiscrepancy
                (∑ n ∈ Finset.Icc ⌈x + (h : ℝ)⌉₊ ⌊2 * x⌋₊,
                  Finsupp.single n
                    (((if n.Prime then (1 : ℝ) else 0) -
                      exceptionalPrimeDefect x 0 n -
                      exceptionalPrimeDefect x 1 n : ℝ) : ℂ)) q a‖) ≤
              K * x / (Real.log x) ^ A := by
  intro ρ δs ξs T θsrc δ0 θ0 ε
  obtain ⟨hδ0, hδgap, hθ0, hθgap, hε, hgeometry⟩ :=
    physicalSource_common_self_strict_presieve_retreat
  obtain ⟨⟨hω, _, _⟩, ⟨hδs, _⟩, ⟨_, _, _, _, hII, _⟩,
    ⟨_, _, _, hI, _hIIIold, hsmooth, hthree, hlevel⟩⟩ :=
      physicalSource_common_self_parameters
  have hθone : θ0 < 1 := hθgap.trans (by norm_num [θsrc])
  have hL0sub : Filter.Tendsto
      (fun x : ℝ => Real.log (1 : ℝ) / Real.log x) Filter.atTop (nhds 0) := by
    simp only [Real.log_one, zero_div]
    exact tendsto_const_nhds
  let u : ℝ → ℕ →₀ ℂ := fun x =>
    ∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
      Finsupp.single n
        (((if n.Prime then (1 : ℝ) else 0) -
          exceptionalPrimeDefect x 0 n -
          exceptionalPrimeDefect x 1 n : ℝ) : ℂ)
  let ι : Type := { ia : Finset ℕ × ℕ //
    (∀ p ∈ ia.1, Nat.Prime p) ∧ Nat.Coprime ia.2 (∏ p ∈ ia.1, p) }
  let Q (x : ℝ) (ia : ι) : Finset ℕ :=
    (Finset.Icc 1 ⌊x ^ θ0⌋₊).filter (fun q =>
      q ∣ ∏ p ∈ ia.val.1, p ∧
      Nonempty (DenseDivisibilityWitness
        ⟨max 1 (x ^ δ0), le_max_left (1 : ℝ) (x ^ δ0)⟩ 2 q))
  let residue : ℝ → ι → ℕ → ℕ := fun _ ia _ => ia.val.2
  have hQ (x : ℝ) (ia : ι) : Q x ia ⊆ Finset.Icc 1 ⌊x ^ θ0⌋₊ :=
    Finset.filter_subset _ _
  have hresidue (x : ℝ) (ia : ι) (q : ℕ) (hq : q ∈ Q x ia) :
      Nat.Coprime (residue x ia q) q :=
    ia.property.2.coprime_dvd_right (Finset.mem_filter.mp hq).2.1
  have hunweighted : ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ ia : ι,
        (∑ q ∈ Q x ia, ‖fullDiscrepancy (u x) q
          (residue x ia q)‖) ≤ K * x / (Real.log x) ^ A := by
    intro A hA
    obtain ⟨K, X, hK, hX, hbound⟩ :=
      literal_minorant_closed_source_coherent_log_saving_of_deligne
        hDeligne 2 (31 / 10000) δs hω hδs
        (by linarith only [hlevel]) (by linarith only [hsmooth])
        (by linarith only [hthree])
        (Or.inr (Or.inl ⟨rfl, by linarith only [hI], hII⟩))
        (fun _ => 1) (fun _ => zero_lt_one) hL0sub A hA
    refine ⟨K, X, hK, hX, ?_⟩
    intro x hx ia
    have hx1 : 1 < x := hX.trans_le hx
    let Y : Set.Ici (1 : ℝ) := ⟨x ^ δs, Real.one_le_rpow hx1.le hδs.le⟩
    let S : Finset ℕ := (Finset.Icc 1 ⌊x ^ θsrc⌋₊).filter (fun q =>
      q ∣ ∏ p ∈ ia.val.1, p ∧
      Nonempty (DenseDivisibilityWitness Y 2 q))
    have hsubset : Q x ia ⊆ S :=
      (Finset.filter_subset_filter _ (Finset.Icc_subset_Icc le_rfl
        (Nat.floor_mono (Real.rpow_le_rpow_of_exponent_le hx1.le hθgap.le)))).trans
        (Finset.monotone_filter_right _ (fun q _ hq => ⟨hq.1,
          denseDivisibility_mono_scale
            (max_le (Real.one_le_rpow hx1.le hδs.le)
              (Real.rpow_le_rpow_of_exponent_le hx1.le hδgap.le)) hq.2⟩))
    have hs : (∑ q ∈ S, ‖fullDiscrepancy (u x) q ia.val.2‖) ≤
        K * x / (Real.log x) ^ A := by
      simpa only [mul_one] using
        hbound x hx Y rfl ia.val.1 ia.property.1 ia.val.2 ia.property.2
    exact (Finset.sum_le_sum_of_subset_of_nonneg hsubset
      (fun q _ _ => norm_nonneg
        (fullDiscrepancy (u x) q ia.val.2))).trans hs
  refine ⟨hδ0, hδgap, hθ0, hθgap, hε, hgeometry, ?_⟩
  intro J h A hA
  have hweighted : ∀ A : ℝ, 0 < A → ∃ K X : ℝ, 0 < K ∧ 1 < X ∧
      ∀ x : ℝ, X ≤ x → ∀ ia : ι,
        (∑ q ∈ Q x ia, (q.divisors.card : ℝ) ^ J *
          ‖fullDiscrepancy (u x) q (residue x ia q)‖) ≤
            K * x / (Real.log x) ^ A := by
    simpa only [u, Complex.ofReal_sub] using
      literal_minorant_divisor_weight_log_saving_of_unweighted
        θ0 hθ0 hθone Q residue (Filter.Eventually.of_forall hQ)
        (Filter.Eventually.of_forall hresidue) J
        (by simpa only [u, Complex.ofReal_sub] using hunweighted)
  obtain ⟨K, X, hK, hX, hbound⟩ :=
    physicalSource_clipped_literalMinorant_transfer θ0 hθ0 hθone Q residue hQ J h
      hweighted A hA
  refine ⟨K, X, hK, hX, ?_⟩
  intro x hx I hI a ha
  exact hbound x hx ⟨(I, a), hI, ha⟩

theorem canonical40_base_prime_weighted_error
    {𝓗 : Finset ℕ}
    {h𝓗_card : 𝓗.card = 40}
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ s : ZMod p, if s ≠ 0 ∧ s ≠ -1 then
            unnormalizedKloosterman2 p (A / s) *
              unnormalizedKloosterman2 p (B / (s + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (i : Fin 40) (f g : ℝ → (Fin 40 → ℕ) → ℝ)
    (C₁ C₂ : ℝ) (hC₁ : 0 < C₁) (hC₂ : 0 < C₂) :
    let ρ : ℝ := 2624989 / 10000000
    let κ : ℝ := (19037 / 100000) / ρ
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    let W : ℝ → ℕ := presievingModulus 𝓗
    let R : ℝ → ℝ := fun x => x ^ ρ
    let B : ℝ → ℝ := fun x => fragmentNormalization (W x) (R x)
    let q : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) (R x) κ, p
    let T : ℝ → Finset (Fin 40 → ℕ) := fun x =>
      (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
        (fun r => Squarefree (∏ j, r j))
    let yF : ℝ → ((Fin 40 → ℕ) →₀ ℝ) := fun x =>
      ∑ r ∈ T x, Finsupp.single r (f x r / B x ^ 40)
    let yG : ℝ → ((Fin 40 → ℕ) →₀ ℝ) := fun x =>
      ∑ r ∈ T x, Finsupp.single r (g x r / B x ^ 40)
    let zF : ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun x =>
      (yF x).sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
        (yr / ((r i).totient : ℝ)))
    let zG : ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun x =>
      (yG x).sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
        (yr / ((r i).totient : ℝ)))
    let D : ℝ → Finset (Fin 39 → ℕ) := fun x =>
      (zF x).support.biUnion (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let E : ℝ → Finset (Fin 39 → ℕ) := fun x =>
      (zG x).support.biUnion (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let C_F : ℝ → ℕ → ℝ := fun x n =>
      ∑ d ∈ D x, if ∀ j, d j ∣ n + h (i.succAbove j) then
        selbergCoefficient (zF x) d else 0
    let C_G : ℝ → ℕ → ℝ := fun x n =>
      ∑ e ∈ E x, if ∀ j, e j ∣ n + h (i.succAbove j) then
        selbergCoefficient (zG x) e else 0
    (∀ᶠ x : ℝ in Filter.atTop, ∀ d ∈ D x,
      |selbergCoefficient (zF x) d| ≤ C₁ * Real.log x) →
    (∀ᶠ x : ℝ in Filter.atTop, ∀ e ∈ E x,
      |selbergCoefficient (zG x) e| ≤ C₂ * Real.log x) →
    (∀ᶠ x : ℝ in Filter.atTop, ∀ r ∈ T x, f x r ≠ 0 →
      physicalSourceOuterSupport
        (fun j => primeLogConfiguration (R x) (r j)) = 1 ∧
      logSize (R x) (∏ j, r j) ≤ 98303 * (trialMesh : ℝ)) →
    (∀ᶠ x : ℝ in Filter.atTop, ∀ r ∈ T x, g x r ≠ 0 →
      physicalSourceInnerSupport 0
        (fun j => primeLogConfiguration (R x) (r (i.succAbove j))) = 1 ∧
      logSize (R x) (∏ j : Fin 39, r (i.succAbove j)) ≤ 89563 * (trialMesh : ℝ)) →
    ∀ A : ℝ, 0 < A → ∃ K : ℝ, 0 < K ∧
      ∀ᶠ x : ℝ in Filter.atTop, ∀ v : ℕ, Nat.Coprime (v + h i) (W x) →
        |(∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            if Nat.ModEq (W x) n v then
              (if (n + h i).Prime then (1 : ℝ) else 0) * C_F x n * C_G x n
            else 0) -
          ((∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            if (n + h i).Prime then (1 : ℝ) else 0) / ((W x).totient : ℝ)) *
            (∑ d ∈ D x, ∑ e ∈ E x,
              if ∀ a b : Fin 39, a ≠ b → Nat.Coprime (d a) (e b) then
                selbergCoefficient (zF x) d * selbergCoefficient (zG x) e /
                  (∏ j, ((Nat.lcm (d j) (e j)).totient : ℝ)) else 0)| ≤
          K * x / (Real.log x) ^ A := by
  classical
  intro ρ κ h W R B q T yF yG zF zG D E C_F C_G hcoefF hcoefG hsupportF hsupportG
  let β : ℝ := (((1 / 2 : ℚ) / physicalSourceRho) : ℝ)
  let θb : ℝ := (ρ * β + 1 / 2) / 2
  let εb : ℝ := (1 / 2 - ρ * β) / 4
  obtain ⟨hθb, _, hθbhalf, hεb, hbase⟩ := physicalSource_base_strict_presieve_retreat
  change 0 < θb at hθb
  change θb < 1 / 2 at hθbhalf
  change 0 < εb at hεb
  choose θ δ ε hθ hθgap hδ hδgap hε hgeometry hdistribution using
    fun t : Fin 28 => physicalSource_base_row_primeIndicator_distribution hDeligne t
  let U : ℝ → ℕ →₀ ℂ := fun x =>
    ∑ n ∈ Finset.Icc ⌈x + (h i : ℝ)⌉₊ ⌊2 * x + (h i : ℝ)⌋₊,
      Finsupp.single n (if n.Prime then (1 : ℂ) else 0)
  let Q : Option (Fin 28) → ℝ → Finset ℕ → Finset ℕ := fun t x P =>
    match t with
    | none => (Finset.Icc 1 ⌊x ^ θb⌋₊).filter (fun n =>
        n ∣ ∏ p ∈ P, p ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ (1 : ℝ)), le_max_left (1 : ℝ) (x ^ (1 : ℝ))⟩ 0 n))
    | some t => (Finset.Icc 1 ⌊x ^ θ t⌋₊).filter (fun n =>
        n ∣ ∏ p ∈ P, p ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ t), le_max_left (1 : ℝ) (x ^ δ t)⟩
          (physicalSourceRow 0 t.val).order n))
  have hQsource (t : Option (Fin 28)) (A : ℝ) (hA : 0 < A) :
      ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
        ∀ x : ℝ, X ≤ x → ∀ P : Finset ℕ,
        (∀ p ∈ P, Nat.Prime p) → ∀ a : ℕ, Nat.Coprime a (∏ p ∈ P, p) →
          (∑ n ∈ Q t x P, (n.divisors.card : ℝ) ^ 13 *
            ‖fullDiscrepancy (U x) n a‖) ≤
              K * x / (Real.log x) ^ A := by
    cases t with
    | none =>
      obtain ⟨K, X, hK, hX, hs⟩ :=
        primeIndicator_shifted_closedSubinterval_divisor_weight_bombieriVinogradov
          0 θb 1 hθb hθbhalf zero_lt_one 13 (h i) A hA
      refine ⟨K, X, hK, hX, ?_⟩
      intro x hx P hP a ha
      have hx0 : 0 ≤ x := (Real.exp_pos 1).le.trans (hX.trans hx)
      exact hs x hx x (2 * x) le_rfl (by linarith) le_rfl P hP a ha
    | some t => exact hdistribution t 13 (h i) A hA
  have hsource := finite_coherent_discrepancy_log_saving U 13 Q hQsource
  have hWsmall (η : ℝ) (hη : 0 < η) :
      ∀ᶠ x : ℝ in Filter.atTop, (W x : ℝ) ≤ x ^ η := by
    filter_upwards [presieving_le_mul_log_eventually 𝓗 1 zero_lt_one,
      (isLittleO_log_rpow_atTop hη).eventuallyLE,
      Filter.eventually_ge_atTop (0 : ℝ)] with x hWlog hsmall hx
    exact (show (W x : ℝ) ≤ Real.log x by simpa only [one_mul] using hWlog).trans
      ((le_abs_self _).trans (by
        simpa only [Real.norm_eq_abs, abs_of_nonneg (Real.rpow_nonneg hx η)] using hsmall))
  have hWall : ∀ᶠ x : ℝ in Filter.atTop, ∀ t : Fin 28, (W x : ℝ) ≤ x ^ ε t :=
    Filter.eventually_all.mpr (fun t => hWsmall (ε t) (hε t))
  intro A hA
  obtain ⟨K₀, X₀, hK₀, hX₀, hsource₀⟩ := hsource (A + 2) (by linarith)
  refine ⟨C₁ * C₂ * K₀, mul_pos (mul_pos hC₁ hC₂) hK₀, ?_⟩
  filter_upwards [hcoefF, hcoefG, hsupportF, hsupportG, hWall, hWsmall εb hεb,
    eventually_large_prime_coprime_presieving 𝓗 1 zero_lt_one,
    Filter.eventually_ge_atTop X₀] with x hcoefF hcoefG hsupportF hsupportG hWall hWb hcopW hx
  have hxexp : Real.exp 1 ≤ x := hX₀.trans hx
  have hx1 : 1 < x := (Real.one_lt_exp_iff.mpr zero_lt_one).trans_le hxexp
  have hx0 : 0 < x := zero_lt_one.trans hx1
  have hlog : 0 < Real.log x := Real.log_pos hx1
  have hR : 1 < R x := Real.one_lt_rpow hx1 (by norm_num [ρ])
  have hW : 0 < W x := presieving_pos 𝓗 x
  let F : (Fin 39 → ℕ) → ℝ := selbergCoefficient (zF x)
  let G : (Fin 39 → ℕ) → ℝ := selbergCoefficient (zG x)
  let D' := (D x).filter (fun d => F d ≠ 0)
  let E' := (E x).filter (fun e => G e ≠ 0)
  have hFD (d : Fin 39 → ℕ) (hd : d ∈ D') :
      Squarefree (∏ j, d j) ∧ (∏ j, d j).Coprime (W x) ∧ (∏ j, d j) ∣ q x := by
    have hh := selberg_sampled_erased_coefficient_presieve
      (W x) (R x) κ (B x ^ 40) (f x) i d (Finset.mem_filter.mp hd).2
    exact ⟨hh.1, hh.2.1, hh.2.2.1⟩
  have hGE (e : Fin 39 → ℕ) (he : e ∈ E') :
      Squarefree (∏ j, e j) ∧ (∏ j, e j).Coprime (W x) ∧ (∏ j, e j) ∣ q x := by
    have hh := selberg_sampled_erased_coefficient_presieve
      (W x) (R x) κ (B x ^ 40) (g x) i e (Finset.mem_filter.mp he).2
    exact ⟨hh.1, hh.2.1, hh.2.2.1⟩
  let Pfrag := fragmentPrimes (W x) (R x) κ
  let P := (W x).primeFactors ∪ Pfrag
  obtain ⟨_hPfrag, hP, hPprod, hPpos⟩ :
      (∀ p ∈ Pfrag, p.Prime) ∧ (∀ p ∈ P, p.Prime) ∧
        (∏ p ∈ P, p) = W x * q x ∧ 0 < ∏ p ∈ P, p :=
    canonical40_presieving_fragment_carrier (𝓗 := 𝓗) x (R x) κ
  let Qall := (Finset.univ : Finset (Option (Fin 28))).biUnion (fun t => Q t x P)
  have hQdiv : Qall ⊆ (∏ p ∈ P, p).divisors := by
    intro n hn
    obtain ⟨t, _, ht⟩ := Finset.mem_biUnion.mp hn
    have hnP : n ∣ ∏ p ∈ P, p := by
      cases t <;> exact (Finset.mem_filter.mp ht).2.1
    exact Nat.mem_divisors.mpr ⟨hnP, hPpos.ne'⟩
  have hmoduli (d : Fin 39 → ℕ) (hd : d ∈ D') (e : Fin 39 → ℕ) (he : e ∈ E') :
      Nat.lcm (W x) (Nat.lcm (∏ j, d j) (∏ j, e j)) ∈ Qall := by
    obtain ⟨hDs, hDW, hDq, hEs, hEW, hEq, hcase⟩ :=
      physicalSource_sampled_erased_pair_source_classification 0 (W x) (R x) κ
        (B x ^ 40) (B x ^ 40) hR (f x) (g x) i d e hsupportF
        (by simpa only [ite_true] using hsupportG)
        (Finset.mem_filter.mp hd).2 (Finset.mem_filter.mp he).2
    let n := Nat.lcm (W x) (Nat.lcm (∏ j, d j) (∏ j, e j))
    have hnpos : 0 < n := Nat.lcm_pos hW
      (Nat.lcm_pos (Nat.pos_of_ne_zero hDs.ne_zero) (Nat.pos_of_ne_zero hEs.ne_zero))
    have hnP : n ∣ ∏ p ∈ P, p := by
      rw [hPprod]
      exact Nat.lcm_dvd (dvd_mul_right _ _)
        ((Nat.lcm_dvd hDq hEq).trans (dvd_mul_left _ _))
    rcases hcase with hsmall | ⟨t, _, hupper, hY, hdense⟩
    · have hsize := hbase x hx1 (W x) (∏ j, d j) (∏ j, e j) hW
        (Nat.pos_of_ne_zero hDs.ne_zero) (Nat.pos_of_ne_zero hEs.ne_zero) hWb
        (by simpa only [R, Rat.cast_div] using hsmall)
      exact Finset.mem_biUnion.mpr ⟨none, Finset.mem_univ _,
        Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr
          ⟨hnpos, (Nat.le_floor_iff' hnpos.ne').mpr hsize⟩, hnP,
          ⟨DenseDivisibilityWitness.zero hnpos⟩⟩⟩
    · obtain ⟨hY', hdense', hsize⟩ := hgeometry t x hx1
        (W x) (∏ j, d j) (∏ j, e j) hW (hWall t) hDW hEW ⟨hY, hdense⟩ hupper
      exact Finset.mem_biUnion.mpr ⟨some t, Finset.mem_univ _,
        Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr
          ⟨hnpos, (Nat.le_floor_iff' hnpos.ne').mpr hsize⟩, hnP,
          denseDivisibility_mono_scale
            (le_max_right (1 : ℝ) (x ^ δ t)) hdense'⟩⟩
  let I := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
  let prime : ℕ → ℝ := fun n => if n.Prime then 1 else 0
  have himage : I.image (fun n => n + h i) =
      Finset.Icc ⌈x + (h i : ℝ)⌉₊ ⌊2 * x + (h i : ℝ)⌋₊ := by
    rw [Nat.ceil_add_natCast hx0.le, Nat.floor_add_natCast (by positivity)]
    exact Finset.image_add_right_Icc _ _ _
  have hu : (∑ m ∈ I.image (fun n => n + h i),
      Finsupp.single m ((prime m : ℝ) : ℂ)) = U x := by
    rw [himage]
    simp only [U, prime, apply_ite Complex.ofReal, Complex.ofReal_one, Complex.ofReal_zero]
  have hweight (d : Fin 39 → ℕ) (hd : d ∈ D') (e : Fin 39 → ℕ) (he : e ∈ E')
      (_ : ∀ a b : Fin 39, a ≠ b → Nat.Coprime (d a) (e b))
      (n : ℕ) (hn : n ∈ I) (hpne : prime (n + h i) ≠ 0) :
      Nat.Coprime (n + h i) (Nat.lcm (W x) (Nat.lcm (∏ j, d j) (∏ j, e j))) := by
    have hp : (n + h i).Prime := by simpa [prime] using hpne
    have hxn : x ≤ (n + h i : ℕ) :=
      (Nat.le_of_ceil_le (Finset.mem_Icc.mp hn).1).trans
        (by exact_mod_cast Nat.le_add_right n (h i))
    have hpW : Nat.Coprime (n + h i) (W x) :=
      hcopW _ hp (by simpa only [Real.rpow_one] using hxn)
    have hcap : (R x) ^ κ < x := by
      dsimp only [R]
      rw [← Real.rpow_mul hx0.le]
      have hexp : ρ * κ < 1 := by norm_num [κ, ρ]
      simpa only [Real.rpow_one] using Real.rpow_lt_rpow_of_exponent_lt hx1 hexp
    have hpq := fragmentPrimeProduct_coprime_of_large_prime
      (W x) (n + h i) (R x) κ (zero_lt_one.trans hR).le hp (hcap.trans_le hxn)
    have hplcm : Nat.Coprime (n + h i) (Nat.lcm (∏ j, d j) (∏ j, e j)) :=
      hpq.of_dvd_right (Nat.lcm_dvd (hFD d hd).2.2 (hGE e he).2.2)
    exact (hpW.mul_right hplcm).of_dvd_right (Nat.lcm_dvd_mul _ _)
  exact canonical40_coherent_weighted_error_transfer
    (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) x i (D x) (E x) F G prime
    C₁ C₂ K₀ A hC₁ hC₂ hlog P Qall hP hQdiv
    (fun d hd => ⟨(hFD d hd).1, (hFD d hd).2.1⟩)
    (fun e he => ⟨(hGE e he).1, (hGE e he).2.1⟩)
    hcoefF hcoefG hweight hmoduli (by
      intro a ha
      rw [hu]
      exact hsource₀ x hx P hP a ha)

theorem canonical40_self_prime_weighted_error
    {𝓗 : Finset ℕ}
    {h𝓗_card : 𝓗.card = 40}
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ s : ZMod p, if s ≠ 0 ∧ s ≠ -1 then
            unnormalizedKloosterman2 p (A / s) *
              unnormalizedKloosterman2 p (B / (s + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (i : Fin 40) (f g : ℝ → (Fin 40 → ℕ) → ℝ)
    (C₁ C₂ : ℝ) (hC₁ : 0 < C₁) (hC₂ : 0 < C₂) :
    let ρ : ℝ := 2624989 / 10000000
    let κ : ℝ := (19037 / 100000) / ρ
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    let W : ℝ → ℕ := presievingModulus 𝓗
    let R : ℝ → ℝ := fun x => x ^ ρ
    let B : ℝ → ℝ := fun x => fragmentNormalization (W x) (R x)
    let q : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) (R x) κ, p
    let T : ℝ → Finset (Fin 40 → ℕ) := fun x =>
      (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
        (fun r => Squarefree (∏ j, r j))
    let yF : ℝ → ((Fin 40 → ℕ) →₀ ℝ) := fun x =>
      ∑ r ∈ T x, Finsupp.single r (f x r / B x ^ 40)
    let yG : ℝ → ((Fin 40 → ℕ) →₀ ℝ) := fun x =>
      ∑ r ∈ T x, Finsupp.single r (g x r / B x ^ 40)
    let zF : ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun x =>
      (yF x).sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
        (yr / ((r i).totient : ℝ)))
    let zG : ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun x =>
      (yG x).sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
        (yr / ((r i).totient : ℝ)))
    let D : ℝ → Finset (Fin 39 → ℕ) := fun x =>
      (zF x).support.biUnion (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let E : ℝ → Finset (Fin 39 → ℕ) := fun x =>
      (zG x).support.biUnion (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let C_F : ℝ → ℕ → ℝ := fun x n =>
      ∑ d ∈ D x, if ∀ j, d j ∣ n + h (i.succAbove j) then
        selbergCoefficient (zF x) d else 0
    let C_G : ℝ → ℕ → ℝ := fun x n =>
      ∑ e ∈ E x, if ∀ j, e j ∣ n + h (i.succAbove j) then
        selbergCoefficient (zG x) e else 0
    (∀ᶠ x : ℝ in Filter.atTop, ∀ d ∈ D x,
      |selbergCoefficient (zF x) d| ≤ C₁ * Real.log x) →
    (∀ᶠ x : ℝ in Filter.atTop, ∀ e ∈ E x,
      |selbergCoefficient (zG x) e| ≤ C₂ * Real.log x) →
    (∀ᶠ x : ℝ in Filter.atTop, ∀ r ∈ T x, f x r ≠ 0 →
      physicalSourceInnerSupport 1
        (fun j => primeLogConfiguration (R x) (r (i.succAbove j))) = 1 ∧
      logSize (R x) (∏ j : Fin 39, r (i.succAbove j)) ≤
        (physicalSourceInnerRadius 1 : ℝ)) →
    (∀ᶠ x : ℝ in Filter.atTop, ∀ r ∈ T x, g x r ≠ 0 →
      physicalSourceInnerSupport 1
        (fun j => primeLogConfiguration (R x) (r (i.succAbove j))) = 1 ∧
      logSize (R x) (∏ j : Fin 39, r (i.succAbove j)) ≤
        (physicalSourceInnerRadius 1 : ℝ)) →
    ∀ A : ℝ, 0 < A → ∃ K : ℝ, 0 < K ∧
      ∀ᶠ x : ℝ in Filter.atTop, ∀ v : ℕ, Nat.Coprime (v + h i) (W x) →
        |(∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            if Nat.ModEq (W x) n v then
              (if (n + h i).Prime then (1 : ℝ) else 0) * C_F x n * C_G x n
            else 0) -
          ((∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            if (n + h i).Prime then (1 : ℝ) else 0) / ((W x).totient : ℝ)) *
            (∑ d ∈ D x, ∑ e ∈ E x,
              if ∀ a b : Fin 39, a ≠ b → Nat.Coprime (d a) (e b) then
                selbergCoefficient (zF x) d * selbergCoefficient (zG x) e /
                  (∏ j, ((Nat.lcm (d j) (e j)).totient : ℝ)) else 0)| ≤
          K * x / (Real.log x) ^ A := by
  classical
  intro ρ κ h W R B q T yF yG zF zG D E C_F C_G hcoefF hcoefG hsupportF hsupportG
  let β : ℝ := (((1 / 2 : ℚ) / physicalSourceRho) : ℝ)
  let θb : ℝ := (ρ * β + 1 / 2) / 2
  let εb : ℝ := (1 / 2 - ρ * β) / 4
  obtain ⟨hθb, _, hθbhalf, hεb, hbase⟩ := physicalSource_base_strict_presieve_retreat
  change 0 < θb at hθb
  change θb < 1 / 2 at hθbhalf
  change 0 < εb at hεb
  let ξs : ℝ := (((21319 / 800000 : ℚ) / physicalSourceRho) : ℝ)
  let θsrc : ℝ := 1 / 2 + 2 * (31 / 10000)
  let δ : ℝ := ((ρ + (physicalSourceRho : ℝ)) / 2) * ξs
  let θ : ℝ := (2 * ρ * (physicalSourceInnerRadius 1 : ℝ) + θsrc) / 2
  let ε : ℝ := min ((θsrc - 2 * ρ * (physicalSourceInnerRadius 1 : ℝ)) / 4)
    (ρ * ξs / 2)
  obtain ⟨hδ, hδgap, hθ, hθgap, hε, hgeometry, hdistribution⟩ :=
    physicalSource_common_self_primeIndicator_distribution hDeligne
  let U : ℝ → ℕ →₀ ℂ := fun x =>
    ∑ n ∈ Finset.Icc ⌈x + (h i : ℝ)⌉₊ ⌊2 * x + (h i : ℝ)⌋₊,
      Finsupp.single n (if n.Prime then (1 : ℂ) else 0)
  let Q : Option Unit → ℝ → Finset ℕ → Finset ℕ := fun t x P =>
    match t with
    | none => (Finset.Icc 1 ⌊x ^ θb⌋₊).filter (fun n =>
        n ∣ ∏ p ∈ P, p ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ (1 : ℝ)), le_max_left (1 : ℝ) (x ^ (1 : ℝ))⟩ 0 n))
    | some _ => (Finset.Icc 1 ⌊x ^ θ⌋₊).filter (fun n =>
        n ∣ ∏ p ∈ P, p ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ), le_max_left (1 : ℝ) (x ^ δ)⟩ 2 n))
  have hQsource (t : Option Unit) (A : ℝ) (hA : 0 < A) :
      ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
        ∀ x : ℝ, X ≤ x → ∀ P : Finset ℕ,
        (∀ p ∈ P, Nat.Prime p) → ∀ a : ℕ, Nat.Coprime a (∏ p ∈ P, p) →
          (∑ n ∈ Q t x P, (n.divisors.card : ℝ) ^ 13 *
            ‖fullDiscrepancy (U x) n a‖) ≤
              K * x / (Real.log x) ^ A := by
    cases t with
    | none =>
      obtain ⟨K, X, hK, hX, hs⟩ :=
        primeIndicator_shifted_closedSubinterval_divisor_weight_bombieriVinogradov
          0 θb 1 hθb hθbhalf zero_lt_one 13 (h i) A hA
      refine ⟨K, X, hK, hX, ?_⟩
      intro x hx P hP a ha
      have hx0 : 0 ≤ x := (Real.exp_pos 1).le.trans (hX.trans hx)
      exact hs x hx x (2 * x) le_rfl (by linarith) le_rfl P hP a ha
    | some _ => exact hdistribution 13 (h i) A hA
  have hsource := finite_coherent_discrepancy_log_saving U 13 Q hQsource
  have hWsmall (η : ℝ) (hη : 0 < η) :
      ∀ᶠ x : ℝ in Filter.atTop, (W x : ℝ) ≤ x ^ η := by
    filter_upwards [presieving_le_mul_log_eventually 𝓗 1 zero_lt_one,
      (isLittleO_log_rpow_atTop hη).eventuallyLE,
      Filter.eventually_ge_atTop (0 : ℝ)] with x hWlog hsmall hx
    exact (show (W x : ℝ) ≤ Real.log x by simpa only [one_mul] using hWlog).trans
      ((le_abs_self _).trans (by
        simpa only [Real.norm_eq_abs, abs_of_nonneg (Real.rpow_nonneg hx η)] using hsmall))
  intro A hA
  obtain ⟨K₀, X₀, hK₀, hX₀, hsource₀⟩ := hsource (A + 2) (by linarith)
  refine ⟨C₁ * C₂ * K₀, mul_pos (mul_pos hC₁ hC₂) hK₀, ?_⟩
  filter_upwards [hcoefF, hcoefG, hsupportF, hsupportG, hWsmall ε hε, hWsmall εb hεb,
    eventually_large_prime_coprime_presieving 𝓗 1 zero_lt_one,
    Filter.eventually_ge_atTop X₀] with x hcoefF hcoefG hsupportF hsupportG hWself hWb hcopW hx
  have hxexp : Real.exp 1 ≤ x := hX₀.trans hx
  have hx1 : 1 < x := (Real.one_lt_exp_iff.mpr zero_lt_one).trans_le hxexp
  have hx0 : 0 < x := zero_lt_one.trans hx1
  have hlog : 0 < Real.log x := Real.log_pos hx1
  have hR : 1 < R x := Real.one_lt_rpow hx1 (by norm_num [ρ])
  have hW : 0 < W x := presieving_pos 𝓗 x
  let F : (Fin 39 → ℕ) → ℝ := selbergCoefficient (zF x)
  let G : (Fin 39 → ℕ) → ℝ := selbergCoefficient (zG x)
  let D' := (D x).filter (fun d => F d ≠ 0)
  let E' := (E x).filter (fun e => G e ≠ 0)
  have hFD (d : Fin 39 → ℕ) (hd : d ∈ D') :
      Squarefree (∏ j, d j) ∧ (∏ j, d j).Coprime (W x) ∧ (∏ j, d j) ∣ q x := by
    have hh := selberg_sampled_erased_coefficient_presieve
      (W x) (R x) κ (B x ^ 40) (f x) i d (Finset.mem_filter.mp hd).2
    exact ⟨hh.1, hh.2.1, hh.2.2.1⟩
  have hGE (e : Fin 39 → ℕ) (he : e ∈ E') :
      Squarefree (∏ j, e j) ∧ (∏ j, e j).Coprime (W x) ∧ (∏ j, e j) ∣ q x := by
    have hh := selberg_sampled_erased_coefficient_presieve
      (W x) (R x) κ (B x ^ 40) (g x) i e (Finset.mem_filter.mp he).2
    exact ⟨hh.1, hh.2.1, hh.2.2.1⟩
  let Pfrag := fragmentPrimes (W x) (R x) κ
  let P := (W x).primeFactors ∪ Pfrag
  obtain ⟨_hPfrag, hP, hPprod, hPpos⟩ :
      (∀ p ∈ Pfrag, p.Prime) ∧ (∀ p ∈ P, p.Prime) ∧
        (∏ p ∈ P, p) = W x * q x ∧ 0 < ∏ p ∈ P, p :=
    canonical40_presieving_fragment_carrier (𝓗 := 𝓗) x (R x) κ
  let Qall := (Finset.univ : Finset (Option Unit)).biUnion (fun t => Q t x P)
  have hQdiv : Qall ⊆ (∏ p ∈ P, p).divisors := by
    intro n hn
    obtain ⟨t, _, ht⟩ := Finset.mem_biUnion.mp hn
    have hnP : n ∣ ∏ p ∈ P, p := by
      cases t <;> exact (Finset.mem_filter.mp ht).2.1
    exact Nat.mem_divisors.mpr ⟨hnP, hPpos.ne'⟩
  have hmoduli (d : Fin 39 → ℕ) (hd : d ∈ D') (e : Fin 39 → ℕ) (he : e ∈ E') :
      Nat.lcm (W x) (Nat.lcm (∏ j, d j) (∏ j, e j)) ∈ Qall := by
    obtain ⟨hDs, hDW, hDq, hEs, hEW, hEq, hupper, hcase⟩ :=
      physicalSource_sampled_inner_self_pair_classification (W x) (R x) κ
        (B x ^ 40) (B x ^ 40) hR (f x) (g x) i d e hsupportF hsupportG
        (Finset.mem_filter.mp hd).2 (Finset.mem_filter.mp he).2
    let n := Nat.lcm (W x) (Nat.lcm (∏ j, d j) (∏ j, e j))
    have hnpos : 0 < n := Nat.lcm_pos hW
      (Nat.lcm_pos (Nat.pos_of_ne_zero hDs.ne_zero) (Nat.pos_of_ne_zero hEs.ne_zero))
    have hnP : n ∣ ∏ p ∈ P, p := by
      rw [hPprod]
      exact Nat.lcm_dvd (dvd_mul_right _ _)
        ((Nat.lcm_dvd hDq hEq).trans (dvd_mul_left _ _))
    rcases hcase with hsmall | ⟨hY, hdense⟩
    · have hsize := hbase x hx1 (W x) (∏ j, d j) (∏ j, e j) hW
        (Nat.pos_of_ne_zero hDs.ne_zero) (Nat.pos_of_ne_zero hEs.ne_zero) hWb hsmall
      exact Finset.mem_biUnion.mpr ⟨none, Finset.mem_univ _,
        Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr
          ⟨hnpos, (Nat.le_floor_iff' hnpos.ne').mpr hsize⟩, hnP,
          ⟨DenseDivisibilityWitness.zero hnpos⟩⟩⟩
    · obtain ⟨hY', hdense', hsize⟩ := hgeometry x hx1
        (W x) (∏ j, d j) (∏ j, e j) hW hWself hDW hEW ⟨hY, hdense⟩ hupper
      exact Finset.mem_biUnion.mpr ⟨some (), Finset.mem_univ _,
        Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr
          ⟨hnpos, (Nat.le_floor_iff' hnpos.ne').mpr hsize⟩, hnP,
          denseDivisibility_mono_scale
            (le_max_right (1 : ℝ) (x ^ δ)) hdense'⟩⟩
  let I := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
  let prime : ℕ → ℝ := fun n => if n.Prime then 1 else 0
  have himage : I.image (fun n => n + h i) =
      Finset.Icc ⌈x + (h i : ℝ)⌉₊ ⌊2 * x + (h i : ℝ)⌋₊ := by
    rw [Nat.ceil_add_natCast hx0.le, Nat.floor_add_natCast (by positivity)]
    exact Finset.image_add_right_Icc _ _ _
  have hu : (∑ m ∈ I.image (fun n => n + h i),
      Finsupp.single m ((prime m : ℝ) : ℂ)) = U x := by
    rw [himage]
    simp only [U, prime, apply_ite Complex.ofReal, Complex.ofReal_one, Complex.ofReal_zero]
  have hweight (d : Fin 39 → ℕ) (hd : d ∈ D') (e : Fin 39 → ℕ) (he : e ∈ E')
      (_ : ∀ a b : Fin 39, a ≠ b → Nat.Coprime (d a) (e b))
      (n : ℕ) (hn : n ∈ I) (hpne : prime (n + h i) ≠ 0) :
      Nat.Coprime (n + h i) (Nat.lcm (W x) (Nat.lcm (∏ j, d j) (∏ j, e j))) := by
    have hp : (n + h i).Prime := by simpa [prime] using hpne
    have hxn : x ≤ (n + h i : ℕ) :=
      (Nat.le_of_ceil_le (Finset.mem_Icc.mp hn).1).trans
        (by exact_mod_cast Nat.le_add_right n (h i))
    have hpW : Nat.Coprime (n + h i) (W x) :=
      hcopW _ hp (by simpa only [Real.rpow_one] using hxn)
    have hcap : (R x) ^ κ < x := by
      dsimp only [R]
      rw [← Real.rpow_mul hx0.le]
      have hexp : ρ * κ < 1 := by norm_num [κ, ρ]
      simpa only [Real.rpow_one] using Real.rpow_lt_rpow_of_exponent_lt hx1 hexp
    have hpq := fragmentPrimeProduct_coprime_of_large_prime
      (W x) (n + h i) (R x) κ (zero_lt_one.trans hR).le hp (hcap.trans_le hxn)
    have hplcm : Nat.Coprime (n + h i) (Nat.lcm (∏ j, d j) (∏ j, e j)) :=
      hpq.of_dvd_right (Nat.lcm_dvd (hFD d hd).2.2 (hGE e he).2.2)
    exact (hpW.mul_right hplcm).of_dvd_right (Nat.lcm_dvd_mul _ _)
  exact canonical40_coherent_weighted_error_transfer
    (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) x i (D x) (E x) F G prime
    C₁ C₂ K₀ A hC₁ hC₂ hlog P Qall hP hQdiv
    (fun d hd => ⟨(hFD d hd).1, (hFD d hd).2.1⟩)
    (fun e he => ⟨(hGE e he).1, (hGE e he).2.1⟩)
    hcoefF hcoefG hweight hmoduli (by
      intro a ha
      rw [hu]
      exact hsource₀ x hx P hP a ha)

theorem canonical40_enlarged_clipped_minorant_weighted_error
    {𝓗 : Finset ℕ}
    {h𝓗_card : 𝓗.card = 40}
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ s : ZMod p, if s ≠ 0 ∧ s ≠ -1 then
            unnormalizedKloosterman2 p (A / s) *
              unnormalizedKloosterman2 p (B / (s + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (i : Fin 40) (f g : ℝ → (Fin 40 → ℕ) → ℝ)
    (C₁ C₂ : ℝ) (hC₁ : 0 < C₁) (hC₂ : 0 < C₂) :
    let ρ : ℝ := 2624989 / 10000000
    let κ : ℝ := (19037 / 100000) / ρ
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    let W : ℝ → ℕ := presievingModulus 𝓗
    let R : ℝ → ℝ := fun x => x ^ ρ
    let B : ℝ → ℝ := fun x => fragmentNormalization (W x) (R x)
    let q : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) (R x) κ, p
    let T : ℝ → Finset (Fin 40 → ℕ) := fun x =>
      (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
        (fun r => Squarefree (∏ j, r j))
    let yF : ℝ → ((Fin 40 → ℕ) →₀ ℝ) := fun x =>
      ∑ r ∈ T x, Finsupp.single r (f x r / B x ^ 40)
    let yG : ℝ → ((Fin 40 → ℕ) →₀ ℝ) := fun x =>
      ∑ r ∈ T x, Finsupp.single r (g x r / B x ^ 40)
    let zF : ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun x =>
      (yF x).sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
        (yr / ((r i).totient : ℝ)))
    let zG : ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun x =>
      (yG x).sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
        (yr / ((r i).totient : ℝ)))
    let D : ℝ → Finset (Fin 39 → ℕ) := fun x =>
      (zF x).support.biUnion (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let E : ℝ → Finset (Fin 39 → ℕ) := fun x =>
      (zG x).support.biUnion (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let C_F : ℝ → ℕ → ℝ := fun x n =>
      ∑ d ∈ D x, if ∀ j, d j ∣ n + h (i.succAbove j) then
        selbergCoefficient (zF x) d else 0
    let C_G : ℝ → ℕ → ℝ := fun x n =>
      ∑ e ∈ E x, if ∀ j, e j ∣ n + h (i.succAbove j) then
        selbergCoefficient (zG x) e else 0
    let rho : ℝ → ℕ → ℝ := fun x n => (if n.Prime then 1 else 0) -
      exceptionalPrimeDefect x 0 n -
      exceptionalPrimeDefect x 1 n
    let weight : ℝ → ℕ → ℝ := fun x n => if (n : ℝ) ≤ 2 * x then rho x n else 0
    (∀ᶠ x : ℝ in Filter.atTop, ∀ d ∈ D x,
      |selbergCoefficient (zF x) d| ≤ C₁ * Real.log x) →
    (∀ᶠ x : ℝ in Filter.atTop, ∀ e ∈ E x,
      |selbergCoefficient (zG x) e| ≤ C₂ * Real.log x) →
    (∀ᶠ x : ℝ in Filter.atTop, ∀ r ∈ T x, f x r ≠ 0 →
      physicalSourceOuterSupport
        (fun j => primeLogConfiguration (R x) (r j)) = 1 ∧
      logSize (R x) (∏ j, r j) ≤ 98303 * (trialMesh : ℝ)) →
    (∀ᶠ x : ℝ in Filter.atTop, ∀ r ∈ T x, g x r ≠ 0 →
      physicalSourceInnerSupport 1
        (fun j => primeLogConfiguration (R x) (r (i.succAbove j))) = 1 ∧
      logSize (R x) (∏ j : Fin 39, r (i.succAbove j)) ≤ 89953 * (trialMesh : ℝ)) →
    ∀ A : ℝ, 0 < A → ∃ K : ℝ, 0 < K ∧
      ∀ᶠ x : ℝ in Filter.atTop, ∀ v : ℕ, Nat.Coprime (v + h i) (W x) →
        |(∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            if Nat.ModEq (W x) n v then
              weight x (n + h i) * C_F x n * C_G x n
            else 0) -
          ((∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            weight x (n + h i)) / ((W x).totient : ℝ)) *
            (∑ d ∈ D x, ∑ e ∈ E x,
              if ∀ a b : Fin 39, a ≠ b → Nat.Coprime (d a) (e b) then
                selbergCoefficient (zF x) d * selbergCoefficient (zG x) e /
                  (∏ j, ((Nat.lcm (d j) (e j)).totient : ℝ)) else 0)| ≤
          K * x / (Real.log x) ^ A := by
  classical
  intro ρ κ h W R B q T yF yG zF zG D E C_F C_G rho weight
    hcoefF hcoefG hsupportF hsupportG
  let β : ℝ := (((1 / 2 : ℚ) / physicalSourceRho) : ℝ)
  let ξ₀ : ℝ := 19037 / 100000
  let θb : ℝ := (ρ * β + 1 / 2) / 2
  let εb : ℝ := (1 / 2 - ρ * β) / 4
  obtain ⟨hθb, _, hθbhalf, hεb, hbase⟩ := physicalSource_base_strict_presieve_retreat
  change 0 < θb at hθb
  change θb < 1 / 2 at hθbhalf
  change 0 < εb at hεb
  choose θ δ ε hθ hθgap hδ hδgap hε hgeometry hdistribution using
    fun t : Fin 39 => physicalSource_enlarged_row_clipped_literalMinorant_distribution hDeligne t
  let U : ℝ → ℕ →₀ ℂ := fun x =>
    ∑ n ∈ Finset.Icc ⌈x + (h i : ℝ)⌉₊ ⌊2 * x⌋₊,
      Finsupp.single n (rho x n : ℂ)
  let Q : Option (Fin 39) → ℝ → Finset ℕ → Finset ℕ := fun t x P =>
    match t with
    | none => (Finset.Icc 1 ⌊x ^ θb⌋₊).filter (fun n => n ∣ ∏ p ∈ P, p)
    | some t => (Finset.Icc 1 ⌊x ^ θ t⌋₊).filter (fun n =>
        n ∣ ∏ p ∈ P, p ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ t), le_max_left (1 : ℝ) (x ^ δ t)⟩
          (physicalSourceRow 1 t.val).order n))
  have hQsource (t : Option (Fin 39)) (A : ℝ) (hA : 0 < A) :
      ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
        ∀ x : ℝ, X ≤ x → ∀ P : Finset ℕ,
        (∀ p ∈ P, Nat.Prime p) → ∀ a : ℕ, Nat.Coprime a (∏ p ∈ P, p) →
          (∑ n ∈ Q t x P, (n.divisors.card : ℝ) ^ 13 *
            ‖fullDiscrepancy (U x) n a‖) ≤
              K * x / (Real.log x) ^ A := by
    cases t with
    | none =>
      exact physicalSource_base_clipped_literalMinorant_distribution
        θb hθb hθbhalf 13 (h i) A hA
    | some t => exact hdistribution t 13 (h i) A hA
  have hsource := finite_coherent_discrepancy_log_saving U 13 Q hQsource
  have hWsmall (η : ℝ) (hη : 0 < η) :
      ∀ᶠ x : ℝ in Filter.atTop, (W x : ℝ) ≤ x ^ η := by
    filter_upwards [presieving_le_mul_log_eventually 𝓗 1 zero_lt_one,
      (isLittleO_log_rpow_atTop hη).eventuallyLE,
      Filter.eventually_ge_atTop (0 : ℝ)] with x hWlog hsmall hx
    exact (show (W x : ℝ) ≤ Real.log x by simpa only [one_mul] using hWlog).trans
      ((le_abs_self _).trans (by
        simpa only [Real.norm_eq_abs, abs_of_nonneg (Real.rpow_nonneg hx η)] using hsmall))
  have hWall : ∀ᶠ x : ℝ in Filter.atTop, ∀ t : Fin 39, (W x : ℝ) ≤ x ^ ε t :=
    Filter.eventually_all.mpr (fun t => hWsmall (ε t) (hε t))
  intro A hA
  obtain ⟨K₀, X₀, hK₀, hX₀, hsource₀⟩ := hsource (A + 2) (by linarith)
  refine ⟨C₁ * C₂ * K₀, mul_pos (mul_pos hC₁ hC₂) hK₀, ?_⟩
  filter_upwards [hcoefF, hcoefG, hsupportF, hsupportG, hWall, hWsmall εb hεb,
    hWsmall ξ₀ (by norm_num [ξ₀]), eventually_literal_minorant_pointwise,
    Filter.eventually_ge_atTop X₀] with x hcoefF hcoefG hsupportF hsupportG hWall hWb
    hWcap hpoint hx
  have hxexp : Real.exp 1 ≤ x := hX₀.trans hx
  have hx1 : 1 < x := (Real.one_lt_exp_iff.mpr zero_lt_one).trans_le hxexp
  have hx0 : 0 < x := zero_lt_one.trans hx1
  have hlog : 0 < Real.log x := Real.log_pos hx1
  have hR : 1 < R x := Real.one_lt_rpow hx1 (by norm_num [ρ])
  have hW : 0 < W x := presieving_pos 𝓗 x
  let F : (Fin 39 → ℕ) → ℝ := selbergCoefficient (zF x)
  let G : (Fin 39 → ℕ) → ℝ := selbergCoefficient (zG x)
  let D' := (D x).filter (fun d => F d ≠ 0)
  let E' := (E x).filter (fun e => G e ≠ 0)
  have hFD (d : Fin 39 → ℕ) (hd : d ∈ D') :
      Squarefree (∏ j, d j) ∧ (∏ j, d j).Coprime (W x) ∧ (∏ j, d j) ∣ q x := by
    have hh := selberg_sampled_erased_coefficient_presieve
      (W x) (R x) κ (B x ^ 40) (f x) i d (Finset.mem_filter.mp hd).2
    exact ⟨hh.1, hh.2.1, hh.2.2.1⟩
  have hGE (e : Fin 39 → ℕ) (he : e ∈ E') :
      Squarefree (∏ j, e j) ∧ (∏ j, e j).Coprime (W x) ∧ (∏ j, e j) ∣ q x := by
    have hh := selberg_sampled_erased_coefficient_presieve
      (W x) (R x) κ (B x ^ 40) (g x) i e (Finset.mem_filter.mp he).2
    exact ⟨hh.1, hh.2.1, hh.2.2.1⟩
  let Pfrag := fragmentPrimes (W x) (R x) κ
  let P := (W x).primeFactors ∪ Pfrag
  obtain ⟨hPfrag, hP, hPprod, hPpos⟩ :
      (∀ p ∈ Pfrag, p.Prime) ∧ (∀ p ∈ P, p.Prime) ∧
        (∏ p ∈ P, p) = W x * q x ∧ 0 < ∏ p ∈ P, p :=
    canonical40_presieving_fragment_carrier (𝓗 := 𝓗) x (R x) κ
  let Qall := (Finset.univ : Finset (Option (Fin 39))).biUnion (fun t => Q t x P)
  have hQdiv : Qall ⊆ (∏ p ∈ P, p).divisors := by
    intro n hn
    obtain ⟨t, _, ht⟩ := Finset.mem_biUnion.mp hn
    have hnP : n ∣ ∏ p ∈ P, p := by
      cases t with
      | none => exact (Finset.mem_filter.mp ht).2
      | some t => exact (Finset.mem_filter.mp ht).2.1
    exact Nat.mem_divisors.mpr ⟨hnP, hPpos.ne'⟩
  have hmoduli (d : Fin 39 → ℕ) (hd : d ∈ D') (e : Fin 39 → ℕ) (he : e ∈ E') :
      Nat.lcm (W x) (Nat.lcm (∏ j, d j) (∏ j, e j)) ∈ Qall := by
    obtain ⟨hDs, hDW, hDq, hEs, hEW, hEq, hcase⟩ :=
      physicalSource_sampled_erased_pair_source_classification 1 (W x) (R x) κ
        (B x ^ 40) (B x ^ 40) hR (f x) (g x) i d e hsupportF
        (by simpa only [ite_eq_right (show ¬(1 : Fin 2) = 0 by decide)] using hsupportG)
        (Finset.mem_filter.mp hd).2 (Finset.mem_filter.mp he).2
    let n := Nat.lcm (W x) (Nat.lcm (∏ j, d j) (∏ j, e j))
    have hnpos : 0 < n := Nat.lcm_pos hW
      (Nat.lcm_pos (Nat.pos_of_ne_zero hDs.ne_zero) (Nat.pos_of_ne_zero hEs.ne_zero))
    have hnP : n ∣ ∏ p ∈ P, p := by
      rw [hPprod]
      exact Nat.lcm_dvd (dvd_mul_right _ _)
        ((Nat.lcm_dvd hDq hEq).trans (dvd_mul_left _ _))
    rcases hcase with hsmall | ⟨t, _, hupper, hY, hdense⟩
    · have hsize := hbase x hx1 (W x) (∏ j, d j) (∏ j, e j) hW
        (Nat.pos_of_ne_zero hDs.ne_zero) (Nat.pos_of_ne_zero hEs.ne_zero) hWb
        (by simpa only [R, Rat.cast_div] using hsmall)
      exact Finset.mem_biUnion.mpr ⟨none, Finset.mem_univ _,
        Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr
          ⟨hnpos, (Nat.le_floor_iff' hnpos.ne').mpr hsize⟩, hnP⟩⟩
    · obtain ⟨hY', hdense', hsize⟩ := hgeometry t x hx1
        (W x) (∏ j, d j) (∏ j, e j) hW (hWall t) hDW hEW ⟨hY, hdense⟩ hupper
      exact Finset.mem_biUnion.mpr ⟨some t, Finset.mem_univ _,
        Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr
          ⟨hnpos, (Nat.le_floor_iff' hnpos.ne').mpr hsize⟩, hnP,
          denseDivisibility_mono_scale
            (le_max_right (1 : ℝ) (x ^ δ t)) hdense'⟩⟩
  let I := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
  have himage : I.image (fun n => n + h i) =
      Finset.Icc ⌈x + (h i : ℝ)⌉₊ ⌊2 * x + (h i : ℝ)⌋₊ := by
    rw [Nat.ceil_add_natCast hx0.le, Nat.floor_add_natCast (by positivity)]
    exact Finset.image_add_right_Icc _ _ _
  have hu : (∑ m ∈ I.image (fun n => n + h i),
      Finsupp.single m ((weight x m : ℝ) : ℂ)) = U x := by
    rw [himage]
    let V : Finset ℕ := Finset.Icc ⌈x + (h i : ℝ)⌉₊ ⌊2 * x + (h i : ℝ)⌋₊
    have hfilter : V.filter (fun m : ℕ => (m : ℝ) ≤ 2 * x) =
        (Finset.Icc ⌈x + (h i : ℝ)⌉₊ ⌊2 * x⌋₊ : Finset ℕ) := by
      have hupper : ⌊2 * x⌋₊ ≤ ⌊2 * x + (h i : ℝ)⌋₊ :=
        Nat.floor_mono (le_add_of_nonneg_right (Nat.cast_nonneg _))
      ext m
      simp only [V, Finset.mem_filter, Finset.mem_Icc,
        ← Nat.le_floor_iff (show 0 ≤ 2 * x by positivity)]
      omega
    change (∑ m ∈ V, (Finsupp.single m (weight x m : ℂ) : ℕ →₀ ℂ)) = U x
    calc
      (∑ m ∈ V, (Finsupp.single m (weight x m : ℂ) : ℕ →₀ ℂ)) =
          ∑ m ∈ V, if (m : ℝ) ≤ 2 * x then
            (Finsupp.single m (rho x m : ℂ) : ℕ →₀ ℂ) else 0 := by
        simp only [weight, apply_ite, Complex.ofReal_zero, Finsupp.single_zero]
      _ = ∑ m ∈ V.filter (fun m : ℕ => (m : ℝ) ≤ 2 * x),
          (Finsupp.single m (rho x m : ℂ) : ℕ →₀ ℂ) := (Finset.sum_filter ..).symm
      _ = U x := by rw [hfilter]
  have hweight (d : Fin 39 → ℕ) (hd : d ∈ D') (e : Fin 39 → ℕ) (he : e ∈ E')
      (_ : ∀ a b : Fin 39, a ≠ b → Nat.Coprime (d a) (e b))
      (n : ℕ) (hn : n ∈ I) (hne : weight x (n + h i) ≠ 0) :
      Nat.Coprime (n + h i) (Nat.lcm (W x) (Nat.lcm (∏ j, d j) (∏ j, e j))) := by
    have hxn : x ≤ (n + h i : ℕ) :=
      (Nat.le_of_ceil_le (Finset.mem_Icc.mp hn).1).trans
        (Nat.cast_le.mpr (Nat.le_add_right n (h i)))
    obtain ⟨hcut, hrhone⟩ : ((n + h i : ℕ) : ℝ) ≤ 2 * x ∧
        rho x (n + h i) ≠ 0 := by
      simpa only [weight, ne_eq, ite_eq_right_iff, not_imp] using hne
    have hrough := (hpoint (n + h i) hxn hcut).2.2.1 hrhone
    let ξ : ℝ := 9519 / 50000
    have hgap : x ^ ξ₀ < x ^ ξ :=
      Real.rpow_lt_rpow_of_exponent_lt hx1 (by norm_num [ξ₀, ξ])
    have hscale : (R x) ^ κ = x ^ ξ₀ := by
      dsimp only [R]
      rw [← Real.rpow_mul hx0.le]
      congr 1
      norm_num [κ, ρ, ξ₀]
    have hmoddiv : Nat.lcm (W x) (Nat.lcm (∏ j, d j) (∏ j, e j)) ∣ W x * q x :=
      Nat.lcm_dvd (dvd_mul_right _ _)
        ((Nat.lcm_dvd (hFD d hd).2.2 (hGE e he).2.2).trans (dvd_mul_left _ _))
    apply coprime_of_prime_cap_of_rough _ _ (x ^ ξ) (x ^ ξ₀) hgap
    · intro p hp hpd
      rcases hp.dvd_mul.mp (hpd.trans hmoddiv) with hpW | hpq
      · exact (Nat.cast_le.mpr (Nat.le_of_dvd hW hpW)).trans hWcap
      · obtain ⟨r, hr, hpr⟩ := hp.prime.exists_mem_finset_dvd hpq
        have heq : p = r := (Nat.prime_dvd_prime_iff_eq hp (hPfrag r hr)).mp hpr
        subst r
        have hpfloor : p ≤ ⌊(R x) ^ κ⌋₊ :=
          (Nat.mem_primesLE.mp (Finset.mem_filter.mp hr).1).1
        exact ((Nat.cast_le.mpr hpfloor).trans
          (Nat.floor_le (Real.rpow_nonneg (zero_lt_one.trans hR).le κ))).trans_eq hscale
    · intro p hp hpd
      exact hrough.2 p (hp.mem_primeFactors hpd hrough.1)
  exact canonical40_coherent_weighted_error_transfer
    (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) x i (D x) (E x) F G (weight x)
    C₁ C₂ K₀ A hC₁ hC₂ hlog P Qall hP hQdiv
    (fun d hd => ⟨(hFD d hd).1, (hFD d hd).2.1⟩)
    (fun e he => ⟨(hGE e he).1, (hGE e he).2.1⟩)
    hcoefF hcoefG hweight hmoduli (by
      intro a ha
      rw [hu]
      exact hsource₀ x hx P hP a ha)

theorem canonical40_self_clipped_minorant_weighted_error
    {𝓗 : Finset ℕ}
    {h𝓗_card : 𝓗.card = 40}
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ s : ZMod p, if s ≠ 0 ∧ s ≠ -1 then
            unnormalizedKloosterman2 p (A / s) *
              unnormalizedKloosterman2 p (B / (s + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (i : Fin 40) (f g : ℝ → (Fin 40 → ℕ) → ℝ)
    (C₁ C₂ : ℝ) (hC₁ : 0 < C₁) (hC₂ : 0 < C₂) :
    let ρ : ℝ := 2624989 / 10000000
    let κ : ℝ := (19037 / 100000) / ρ
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    let W : ℝ → ℕ := presievingModulus 𝓗
    let R : ℝ → ℝ := fun x => x ^ ρ
    let B : ℝ → ℝ := fun x => fragmentNormalization (W x) (R x)
    let q : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) (R x) κ, p
    let T : ℝ → Finset (Fin 40 → ℕ) := fun x =>
      (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
        (fun r => Squarefree (∏ j, r j))
    let yF : ℝ → ((Fin 40 → ℕ) →₀ ℝ) := fun x =>
      ∑ r ∈ T x, Finsupp.single r (f x r / B x ^ 40)
    let yG : ℝ → ((Fin 40 → ℕ) →₀ ℝ) := fun x =>
      ∑ r ∈ T x, Finsupp.single r (g x r / B x ^ 40)
    let zF : ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun x =>
      (yF x).sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
        (yr / ((r i).totient : ℝ)))
    let zG : ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun x =>
      (yG x).sum (fun r yr => Finsupp.single (fun j => r (i.succAbove j))
        (yr / ((r i).totient : ℝ)))
    let D : ℝ → Finset (Fin 39 → ℕ) := fun x =>
      (zF x).support.biUnion (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let E : ℝ → Finset (Fin 39 → ℕ) := fun x =>
      (zG x).support.biUnion (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let C_F : ℝ → ℕ → ℝ := fun x n =>
      ∑ d ∈ D x, if ∀ j, d j ∣ n + h (i.succAbove j) then
        selbergCoefficient (zF x) d else 0
    let C_G : ℝ → ℕ → ℝ := fun x n =>
      ∑ e ∈ E x, if ∀ j, e j ∣ n + h (i.succAbove j) then
        selbergCoefficient (zG x) e else 0
    let rho : ℝ → ℕ → ℝ := fun x n => (if n.Prime then 1 else 0) -
      exceptionalPrimeDefect x 0 n -
      exceptionalPrimeDefect x 1 n
    let weight : ℝ → ℕ → ℝ := fun x n => if (n : ℝ) ≤ 2 * x then rho x n else 0
    (∀ᶠ x : ℝ in Filter.atTop, ∀ d ∈ D x,
      |selbergCoefficient (zF x) d| ≤ C₁ * Real.log x) →
    (∀ᶠ x : ℝ in Filter.atTop, ∀ e ∈ E x,
      |selbergCoefficient (zG x) e| ≤ C₂ * Real.log x) →
    (∀ᶠ x : ℝ in Filter.atTop, ∀ r ∈ T x, f x r ≠ 0 →
      physicalSourceInnerSupport 1
        (fun j => primeLogConfiguration (R x) (r (i.succAbove j))) = 1 ∧
      logSize (R x) (∏ j : Fin 39, r (i.succAbove j)) ≤
        (physicalSourceInnerRadius 1 : ℝ)) →
    (∀ᶠ x : ℝ in Filter.atTop, ∀ r ∈ T x, g x r ≠ 0 →
      physicalSourceInnerSupport 1
        (fun j => primeLogConfiguration (R x) (r (i.succAbove j))) = 1 ∧
      logSize (R x) (∏ j : Fin 39, r (i.succAbove j)) ≤
        (physicalSourceInnerRadius 1 : ℝ)) →
    ∀ A : ℝ, 0 < A → ∃ K : ℝ, 0 < K ∧
      ∀ᶠ x : ℝ in Filter.atTop, ∀ v : ℕ, Nat.Coprime (v + h i) (W x) →
        |(∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            if Nat.ModEq (W x) n v then
              weight x (n + h i) * C_F x n * C_G x n
            else 0) -
          ((∑ n ∈ Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊,
            weight x (n + h i)) / ((W x).totient : ℝ)) *
            (∑ d ∈ D x, ∑ e ∈ E x,
              if ∀ a b : Fin 39, a ≠ b → Nat.Coprime (d a) (e b) then
                selbergCoefficient (zF x) d * selbergCoefficient (zG x) e /
                  (∏ j, ((Nat.lcm (d j) (e j)).totient : ℝ)) else 0)| ≤
          K * x / (Real.log x) ^ A := by
  classical
  intro ρ κ h W R B q T yF yG zF zG D E C_F C_G rho weight
    hcoefF hcoefG hsupportF hsupportG
  let β : ℝ := (((1 / 2 : ℚ) / physicalSourceRho) : ℝ)
  let ξ₀ : ℝ := 19037 / 100000
  let θb : ℝ := (ρ * β + 1 / 2) / 2
  let εb : ℝ := (1 / 2 - ρ * β) / 4
  obtain ⟨hθb, _, hθbhalf, hεb, hbase⟩ := physicalSource_base_strict_presieve_retreat
  change 0 < θb at hθb
  change θb < 1 / 2 at hθbhalf
  change 0 < εb at hεb
  let ξs : ℝ := (((21319 / 800000 : ℚ) / physicalSourceRho) : ℝ)
  let θsrc : ℝ := 1 / 2 + 2 * (31 / 10000)
  let δ : ℝ := ((ρ + (physicalSourceRho : ℝ)) / 2) * ξs
  let θ : ℝ := (2 * ρ * (physicalSourceInnerRadius 1 : ℝ) + θsrc) / 2
  let ε : ℝ := min ((θsrc - 2 * ρ * (physicalSourceInnerRadius 1 : ℝ)) / 4)
    (ρ * ξs / 2)
  obtain ⟨hδ, hδgap, hθ, hθgap, hε, hgeometry, hdistribution⟩ :=
    physicalSource_common_self_minorant_distribution hDeligne
  let U : ℝ → ℕ →₀ ℂ := fun x =>
    ∑ n ∈ Finset.Icc ⌈x + (h i : ℝ)⌉₊ ⌊2 * x⌋₊,
      Finsupp.single n (rho x n : ℂ)
  let Q : Option Unit → ℝ → Finset ℕ → Finset ℕ := fun t x P =>
    match t with
    | none => (Finset.Icc 1 ⌊x ^ θb⌋₊).filter (fun n => n ∣ ∏ p ∈ P, p)
    | some _ => (Finset.Icc 1 ⌊x ^ θ⌋₊).filter (fun n =>
        n ∣ ∏ p ∈ P, p ∧
        Nonempty (DenseDivisibilityWitness
          ⟨max 1 (x ^ δ), le_max_left (1 : ℝ) (x ^ δ)⟩ 2 n))
  have hQsource (t : Option Unit) (A : ℝ) (hA : 0 < A) :
      ∃ K X : ℝ, 0 < K ∧ Real.exp 1 ≤ X ∧
        ∀ x : ℝ, X ≤ x → ∀ P : Finset ℕ,
        (∀ p ∈ P, Nat.Prime p) → ∀ a : ℕ, Nat.Coprime a (∏ p ∈ P, p) →
          (∑ n ∈ Q t x P, (n.divisors.card : ℝ) ^ 13 *
            ‖fullDiscrepancy (U x) n a‖) ≤
              K * x / (Real.log x) ^ A := by
    cases t with
    | none =>
      exact physicalSource_base_clipped_literalMinorant_distribution
        θb hθb hθbhalf 13 (h i) A hA
    | some _ => exact hdistribution 13 (h i) A hA
  have hsource := finite_coherent_discrepancy_log_saving U 13 Q hQsource
  have hWsmall (η : ℝ) (hη : 0 < η) :
      ∀ᶠ x : ℝ in Filter.atTop, (W x : ℝ) ≤ x ^ η := by
    filter_upwards [presieving_le_mul_log_eventually 𝓗 1 zero_lt_one,
      (isLittleO_log_rpow_atTop hη).eventuallyLE,
      Filter.eventually_ge_atTop (0 : ℝ)] with x hWlog hsmall hx
    exact (show (W x : ℝ) ≤ Real.log x by simpa only [one_mul] using hWlog).trans
      ((le_abs_self _).trans (by
        simpa only [Real.norm_eq_abs, abs_of_nonneg (Real.rpow_nonneg hx η)] using hsmall))
  intro A hA
  obtain ⟨K₀, X₀, hK₀, hX₀, hsource₀⟩ := hsource (A + 2) (by linarith)
  refine ⟨C₁ * C₂ * K₀, mul_pos (mul_pos hC₁ hC₂) hK₀, ?_⟩
  filter_upwards [hcoefF, hcoefG, hsupportF, hsupportG, hWsmall ε hε, hWsmall εb hεb,
    hWsmall ξ₀ (by norm_num [ξ₀]), eventually_literal_minorant_pointwise,
    Filter.eventually_ge_atTop X₀] with x hcoefF hcoefG hsupportF hsupportG hWself hWb
    hWcap hpoint hx
  have hxexp : Real.exp 1 ≤ x := hX₀.trans hx
  have hx1 : 1 < x := (Real.one_lt_exp_iff.mpr zero_lt_one).trans_le hxexp
  have hx0 : 0 < x := zero_lt_one.trans hx1
  have hlog : 0 < Real.log x := Real.log_pos hx1
  have hR : 1 < R x := Real.one_lt_rpow hx1 (by norm_num [ρ])
  have hW : 0 < W x := presieving_pos 𝓗 x
  let F : (Fin 39 → ℕ) → ℝ := selbergCoefficient (zF x)
  let G : (Fin 39 → ℕ) → ℝ := selbergCoefficient (zG x)
  let D' := (D x).filter (fun d => F d ≠ 0)
  let E' := (E x).filter (fun e => G e ≠ 0)
  have hFD (d : Fin 39 → ℕ) (hd : d ∈ D') :
      Squarefree (∏ j, d j) ∧ (∏ j, d j).Coprime (W x) ∧ (∏ j, d j) ∣ q x := by
    have hh := selberg_sampled_erased_coefficient_presieve
      (W x) (R x) κ (B x ^ 40) (f x) i d (Finset.mem_filter.mp hd).2
    exact ⟨hh.1, hh.2.1, hh.2.2.1⟩
  have hGE (e : Fin 39 → ℕ) (he : e ∈ E') :
      Squarefree (∏ j, e j) ∧ (∏ j, e j).Coprime (W x) ∧ (∏ j, e j) ∣ q x := by
    have hh := selberg_sampled_erased_coefficient_presieve
      (W x) (R x) κ (B x ^ 40) (g x) i e (Finset.mem_filter.mp he).2
    exact ⟨hh.1, hh.2.1, hh.2.2.1⟩
  let Pfrag := fragmentPrimes (W x) (R x) κ
  let P := (W x).primeFactors ∪ Pfrag
  obtain ⟨hPfrag, hP, hPprod, hPpos⟩ :
      (∀ p ∈ Pfrag, p.Prime) ∧ (∀ p ∈ P, p.Prime) ∧
        (∏ p ∈ P, p) = W x * q x ∧ 0 < ∏ p ∈ P, p :=
    canonical40_presieving_fragment_carrier (𝓗 := 𝓗) x (R x) κ
  let Qall := (Finset.univ : Finset (Option Unit)).biUnion (fun t => Q t x P)
  have hQdiv : Qall ⊆ (∏ p ∈ P, p).divisors := by
    intro n hn
    obtain ⟨t, _, ht⟩ := Finset.mem_biUnion.mp hn
    have hnP : n ∣ ∏ p ∈ P, p := by
      cases t with
      | none => exact (Finset.mem_filter.mp ht).2
      | some t => exact (Finset.mem_filter.mp ht).2.1
    exact Nat.mem_divisors.mpr ⟨hnP, hPpos.ne'⟩
  have hmoduli (d : Fin 39 → ℕ) (hd : d ∈ D') (e : Fin 39 → ℕ) (he : e ∈ E') :
      Nat.lcm (W x) (Nat.lcm (∏ j, d j) (∏ j, e j)) ∈ Qall := by
    obtain ⟨hDs, hDW, hDq, hEs, hEW, hEq, hupper, hcase⟩ :=
      physicalSource_sampled_inner_self_pair_classification (W x) (R x) κ
        (B x ^ 40) (B x ^ 40) hR (f x) (g x) i d e hsupportF hsupportG
        (Finset.mem_filter.mp hd).2 (Finset.mem_filter.mp he).2
    let n := Nat.lcm (W x) (Nat.lcm (∏ j, d j) (∏ j, e j))
    have hnpos : 0 < n := Nat.lcm_pos hW
      (Nat.lcm_pos (Nat.pos_of_ne_zero hDs.ne_zero) (Nat.pos_of_ne_zero hEs.ne_zero))
    have hnP : n ∣ ∏ p ∈ P, p := by
      rw [hPprod]
      exact Nat.lcm_dvd (dvd_mul_right _ _)
        ((Nat.lcm_dvd hDq hEq).trans (dvd_mul_left _ _))
    rcases hcase with hsmall | ⟨hY, hdense⟩
    · have hsize := hbase x hx1 (W x) (∏ j, d j) (∏ j, e j) hW
        (Nat.pos_of_ne_zero hDs.ne_zero) (Nat.pos_of_ne_zero hEs.ne_zero) hWb hsmall
      exact Finset.mem_biUnion.mpr ⟨none, Finset.mem_univ _,
        Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr
          ⟨hnpos, (Nat.le_floor_iff' hnpos.ne').mpr hsize⟩, hnP⟩⟩
    · obtain ⟨hY', hdense', hsize⟩ := hgeometry x hx1
        (W x) (∏ j, d j) (∏ j, e j) hW hWself hDW hEW ⟨hY, hdense⟩ hupper
      exact Finset.mem_biUnion.mpr ⟨some (), Finset.mem_univ _,
        Finset.mem_filter.mpr ⟨Finset.mem_Icc.mpr
          ⟨hnpos, (Nat.le_floor_iff' hnpos.ne').mpr hsize⟩, hnP,
          denseDivisibility_mono_scale
            (le_max_right (1 : ℝ) (x ^ δ)) hdense'⟩⟩
  let I := Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
  have himage : I.image (fun n => n + h i) =
      Finset.Icc ⌈x + (h i : ℝ)⌉₊ ⌊2 * x + (h i : ℝ)⌋₊ := by
    rw [Nat.ceil_add_natCast hx0.le, Nat.floor_add_natCast (by positivity)]
    exact Finset.image_add_right_Icc _ _ _
  have hu : (∑ m ∈ I.image (fun n => n + h i),
      Finsupp.single m ((weight x m : ℝ) : ℂ)) = U x := by
    rw [himage]
    let V : Finset ℕ := Finset.Icc ⌈x + (h i : ℝ)⌉₊ ⌊2 * x + (h i : ℝ)⌋₊
    have hfilter : V.filter (fun m : ℕ => (m : ℝ) ≤ 2 * x) =
        (Finset.Icc ⌈x + (h i : ℝ)⌉₊ ⌊2 * x⌋₊ : Finset ℕ) := by
      have hupper : ⌊2 * x⌋₊ ≤ ⌊2 * x + (h i : ℝ)⌋₊ :=
        Nat.floor_mono (le_add_of_nonneg_right (Nat.cast_nonneg _))
      ext m
      simp only [V, Finset.mem_filter, Finset.mem_Icc,
        ← Nat.le_floor_iff (show 0 ≤ 2 * x by positivity)]
      omega
    change (∑ m ∈ V, (Finsupp.single m (weight x m : ℂ) : ℕ →₀ ℂ)) = U x
    calc
      (∑ m ∈ V, (Finsupp.single m (weight x m : ℂ) : ℕ →₀ ℂ)) =
          ∑ m ∈ V, if (m : ℝ) ≤ 2 * x then
            (Finsupp.single m (rho x m : ℂ) : ℕ →₀ ℂ) else 0 := by
        simp only [weight, apply_ite, Complex.ofReal_zero, Finsupp.single_zero]
      _ = ∑ m ∈ V.filter (fun m : ℕ => (m : ℝ) ≤ 2 * x),
          (Finsupp.single m (rho x m : ℂ) : ℕ →₀ ℂ) := (Finset.sum_filter ..).symm
      _ = U x := by rw [hfilter]
  have hweight (d : Fin 39 → ℕ) (hd : d ∈ D') (e : Fin 39 → ℕ) (he : e ∈ E')
      (_ : ∀ a b : Fin 39, a ≠ b → Nat.Coprime (d a) (e b))
      (n : ℕ) (hn : n ∈ I) (hne : weight x (n + h i) ≠ 0) :
      Nat.Coprime (n + h i) (Nat.lcm (W x) (Nat.lcm (∏ j, d j) (∏ j, e j))) := by
    have hxn : x ≤ (n + h i : ℕ) :=
      (Nat.le_of_ceil_le (Finset.mem_Icc.mp hn).1).trans
        (Nat.cast_le.mpr (Nat.le_add_right n (h i)))
    obtain ⟨hcut, hrhone⟩ : ((n + h i : ℕ) : ℝ) ≤ 2 * x ∧
        rho x (n + h i) ≠ 0 := by
      simpa only [weight, ne_eq, ite_eq_right_iff, not_imp] using hne
    have hrough := (hpoint (n + h i) hxn hcut).2.2.1 hrhone
    let ξ : ℝ := 9519 / 50000
    have hgap : x ^ ξ₀ < x ^ ξ :=
      Real.rpow_lt_rpow_of_exponent_lt hx1 (by norm_num [ξ₀, ξ])
    have hscale : (R x) ^ κ = x ^ ξ₀ := by
      dsimp only [R]
      rw [← Real.rpow_mul hx0.le]
      congr 1
      norm_num [κ, ρ, ξ₀]
    have hmoddiv : Nat.lcm (W x) (Nat.lcm (∏ j, d j) (∏ j, e j)) ∣ W x * q x :=
      Nat.lcm_dvd (dvd_mul_right _ _)
        ((Nat.lcm_dvd (hFD d hd).2.2 (hGE e he).2.2).trans (dvd_mul_left _ _))
    apply coprime_of_prime_cap_of_rough _ _ (x ^ ξ) (x ^ ξ₀) hgap
    · intro p hp hpd
      rcases hp.dvd_mul.mp (hpd.trans hmoddiv) with hpW | hpq
      · exact (Nat.cast_le.mpr (Nat.le_of_dvd hW hpW)).trans hWcap
      · obtain ⟨r, hr, hpr⟩ := hp.prime.exists_mem_finset_dvd hpq
        have heq : p = r := (Nat.prime_dvd_prime_iff_eq hp (hPfrag r hr)).mp hpr
        subst r
        have hpfloor : p ≤ ⌊(R x) ^ κ⌋₊ :=
          (Nat.mem_primesLE.mp (Finset.mem_filter.mp hr).1).1
        exact ((Nat.cast_le.mpr hpfloor).trans
          (Nat.floor_le (Real.rpow_nonneg (zero_lt_one.trans hR).le κ))).trans_eq hscale
    · intro p hp hpd
      exact hrough.2 p (hp.mem_primeFactors hpd hrough.1)
  exact canonical40_coherent_weighted_error_transfer
    (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) x i (D x) (E x) F G (weight x)
    C₁ C₂ K₀ A hC₁ hC₂ hlog P Qall hP hQdiv
    (fun d hd => ⟨(hFD d hd).1, (hFD d hd).2.1⟩)
    (fun e he => ⟨(hGE e he).1, (hGE e he).2.1⟩)
    hcoefF hcoefG hweight hmoduli (by
      intro a ha
      rw [hu]
      exact hsource₀ x hx P hP a ha)

open Classical in
theorem canonical40_base_prime_moment
    {𝓗 : Finset ℕ}
    {h𝓗_card : 𝓗.card = 40}
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ s : ZMod p, if s ≠ 0 ∧ s ≠ -1 then
            unnormalizedKloosterman2 p (A / s) *
              unnormalizedKloosterman2 p (B / (s + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    {m : ℕ} (i : Fin 40) (a : Fin (m + 2) → ℝ) (ha : StrictMono a)
    (ha0 : a 0 = 0)
    (haLast : a (Fin.last (m + 1)) =
      ((19037 : ℝ) / 100000) / ((2624989 : ℝ) / 10000000))
    (F G : (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
    (hF : ContDiff ℝ ∞ F) (hG : ContDiff ℝ ∞ G)
    (hcF : HasCompactSupport F) (hcG : HasCompactSupport G) :
    let ρ : ℝ := 2624989 / 10000000
    let κ : ℝ := (19037 / 100000) / ρ
    let ν : Measure (Fin (m + 1) → ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        Measure.map (fragmentBandMasses a) (fragmentLaw κ)
    let h : Fin 40 → ℕ := 𝓗.orderEmbOfFin h𝓗_card
    let W : ℝ → ℕ := presievingModulus 𝓗
    let R : ℝ → ℝ := fun x => x ^ ρ
    let B : ℝ → ℝ := fun x => fragmentNormalization (W x) (R x)
    let q : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) (R x) κ, p
    let T : ℝ → Finset (Fin 40 → ℕ) := fun x =>
      (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
        (fun r => Squarefree (∏ j, r j))
    let X : ℝ → ℕ → Fin (m + 1) → ℝ := fun x n =>
      fragmentBandMasses a (PrimeGap186.primeLogConfiguration (R x) n)
    let y : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → ((Fin 40 → ℕ) →₀ ℝ) :=
      fun K x => ∑ r ∈ T x, Finsupp.single r (K (fun j => X x (r j)) / B x ^ 40)
    let z : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → ((Fin 39 → ℕ) →₀ ℝ) :=
      fun K x => (y K x).sum (fun r yr => Finsupp.single
        (fun j => r (i.succAbove j)) (yr / ((r i).totient : ℝ)))
    let D : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → Finset (Fin 40 → ℕ) :=
      fun K x => (y K x).support.biUnion
        (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let E : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → Finset (Fin 39 → ℕ) :=
      fun K x => (z K x).support.biUnion
        (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let A : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → ℕ → ℝ := fun K x n =>
      ∑ d ∈ D K x, if ∀ j, d j ∣ n + h j then selbergCoefficient (y K x) d else 0
    let C : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → ℕ → ℝ := fun K x n =>
      ∑ d ∈ E K x, if ∀ j, d j ∣ n + h (i.succAbove j) then
        selbergCoefficient (z K x) d else 0
    let P : ℕ → ℝ := fun n => if n.Prime then 1 else 0
    let I : ℝ → Finset ℕ := fun x => Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
    let erased : ℝ → ℕ → ℝ := fun x v =>
      ∑ n ∈ I x, if Nat.ModEq (W x) n v then
        P (n + h i) * C F x n * C G x n else 0
    let full : ℝ → ℕ → ℝ := fun x v =>
      ∑ n ∈ I x, if Nat.ModEq (W x) n v then
        P (n + h i) * A F x n * C G x n else 0
    let J : ℝ := ∫ Y : Fin 39 → Fin (m + 1) → ℝ,
      (∫ t : Fin (m + 1) → ℝ, F (i.insertNth t Y) ∂ν) *
        (∫ t : Fin (m + 1) → ℝ, G (i.insertNth t Y) ∂ν)
      ∂Measure.pi (fun _ : Fin 39 => ν)
    (∀ᶠ x : ℝ in atTop, ∀ r ∈ T x, F (fun j => X x (r j)) ≠ 0 →
      physicalSourceOuterSupport
        (fun j => primeLogConfiguration (R x) (r j)) = 1 ∧
      logSize (R x) (∏ j, r j) ≤ 98303 * (trialMesh : ℝ)) →
    (∀ᶠ x : ℝ in atTop, ∀ r ∈ T x, G (fun j => X x (r j)) ≠ 0 →
      physicalSourceInnerSupport 0
        (fun j => primeLogConfiguration (R x) (r (i.succAbove j))) = 1 ∧
      logSize (R x) (∏ j : Fin 39, r (i.succAbove j)) ≤ 89563 * (trialMesh : ℝ)) →
    ∀ ε : ℝ, 0 < ε → ∀ᶠ x : ℝ in atTop,
      let Z : ℝ := x / (W x : ℝ) / B x ^ 40
      ∀ v : ℕ, Nat.Coprime (v + h i) (W x) →
        |erased x v - (ρ * J) * Z| ≤ ε * Z ∧
          |full x v - (ρ * J) * Z| ≤ ε * Z := by
  classical
  intro ρ κ ν h W R B q T X y z D E A C P I erased full J hsupportF hsupportG
  have hκ : 0 < κ := by norm_num [κ, ρ]
  have hbF : Bornology.IsBounded (Set.range F) :=
    (hcF.isCompact_range hF.continuous).isBounded
  have hbG : Bornology.IsBounded (Set.range G) :=
    (hcG.isCompact_range hG.continuous).isBounded
  have hite (p : Prop) (dec : Decidable p) (u v : ℝ) :
      @ite ℝ p dec u v = @ite ℝ p (Classical.propDecidable p) u v :=
    @ite_cond_congr ℝ p p dec (Classical.propDecidable p) u v rfl
  let gram : ℝ → ℝ := fun x => ∑ d ∈ E F x, ∑ e ∈ E G x,
    if ∀ s t : Fin 39, s ≠ t → Nat.Coprime (d s) (e t) then
      selbergCoefficient (z F x) d * selbergCoefficient (z G x) e /
        (∏ j, ((Nat.lcm (d j) (e j)).totient : ℝ)) else 0
  let total : ℝ → ℝ := fun x => ∑ n ∈ I x, P (n + h i)
  let admissible : ℝ → ℕ → Prop := fun x v => Nat.Coprime (v + h i) (W x)
  have hmass : Tendsto (fun x => (Real.log x / x) * total x) atTop (nhds 1) := by
    simpa only [total, I, P, hite] using (fixed_shift_literal_weights_mass_tendsto (h i)).1
  have hgram : Tendsto (fun x => B x ^ 39 * gram x) atTop (nhds J) := by
    have hraw := canonical40_erased_prime_bilinear_tendsto
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i κ hκ a ha ha0 haLast
      F G hF.continuous.measurable hG.continuous.measurable hbF hbG
        (ae_of_all _ fun _ => hF.continuous.continuousAt)
        (ae_of_all _ fun _ => hG.continuous.continuousAt)
    simpa only [gram, E, z, y, T, hite] using hraw
  obtain ⟨C₁, hC₁, hcoefFraw⟩ :=
    (canonical40_fixed_profile_coefficient_roots (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i a F hbF).1
  obtain ⟨C₂, hC₂, hcoefGraw⟩ :=
    (canonical40_fixed_profile_coefficient_roots (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i a G hbG).1
  have hcoefF : ∀ᶠ x : ℝ in atTop, ∀ d ∈ E F x,
      |selbergCoefficient (z F x) d| ≤ C₁ * Real.log x :=
    hcoefFraw.mono fun _ hx d _ => hx.2 d
  have hcoefG : ∀ᶠ x : ℝ in atTop, ∀ d ∈ E G x,
      |selbergCoefficient (z G x) d| ≤ C₂ * Real.log x :=
    hcoefGraw.mono fun _ hx d _ => hx.2 d
  have herror : ∀ L : ℝ, 0 < L → ∃ K : ℝ, 0 < K ∧
      ∀ᶠ x : ℝ in atTop, ∀ v : ℕ, admissible x v →
        |erased x v - total x / ((W x).totient : ℝ) * gram x| ≤
          K * x / (Real.log x) ^ L := by
    have hraw := canonical40_base_prime_weighted_error (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) hDeligne i
      (fun x r => F (fun j => X x (r j))) (fun x r => G (fun j => X x (r j)))
      C₁ C₂ hC₁ hC₂
    have hf := hcoefF
    have hg := hcoefG
    have hsF := hsupportF
    have hsG := hsupportG
    simp only [E, z, y, T] at hf hg
    simp only [T] at hsF hsG
    simp only [hite] at hraw
    have herr := hraw hf hg hsF hsG
    simpa only [erased, total, gram, I, P, C, E, z, y, T, admissible,
      hite] using herr
  have hmoment := selberg40_moment_from_diagonal_error (𝓗 := 𝓗) erased admissible total gram 1 J
    hmass hgram herror
  have hpoint : ∀ᶠ x : ℝ in atTop, ∀ n ∈ I x,
      P (n + h i) * A F x n = P (n + h i) * C F x n := by
    filter_upwards [canonical40_fixed_profile_prime_minorant_erasure
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i a F] with x hx
    intro n hn
    simpa only [A, C, D, E, z, y, T, P, hite] using (hx n hn).1
  have hfull : ∀ᶠ x : ℝ in atTop, ∀ v : ℕ, full x v = erased x v := by
    filter_upwards [hpoint] with x hx
    intro v
    apply Finset.sum_congr rfl
    intro n hn
    split_ifs
    · exact congrArg (fun t : ℝ => t * C G x n) (hx n hn)
    · rfl
  intro ε hε
  filter_upwards [hmoment ε hε, hfull] with x hm hf
  intro Z v hv
  have he : |erased x v - (ρ * J) * Z| ≤ ε * Z := by
    simpa only [mul_one] using hm v hv
  refine ⟨he, ?_⟩
  rw [hf v]
  exact he

open Classical in
theorem canonical40_self_prime_moment
    {𝓗 : Finset ℕ}
    {h𝓗_card : 𝓗.card = 40}
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ s : ZMod p, if s ≠ 0 ∧ s ≠ -1 then
            unnormalizedKloosterman2 p (A / s) *
              unnormalizedKloosterman2 p (B / (s + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    {m : ℕ} (i : Fin 40) (a : Fin (m + 2) → ℝ) (ha : StrictMono a)
    (ha0 : a 0 = 0)
    (haLast : a (Fin.last (m + 1)) =
      ((19037 : ℝ) / 100000) / ((2624989 : ℝ) / 10000000))
    (F G : (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
    (hF : ContDiff ℝ ∞ F) (hG : ContDiff ℝ ∞ G)
    (hcF : HasCompactSupport F) (hcG : HasCompactSupport G) :
    let ρ : ℝ := 2624989 / 10000000
    let κ : ℝ := (19037 / 100000) / ρ
    let ν : Measure (Fin (m + 1) → ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        Measure.map (fragmentBandMasses a) (fragmentLaw κ)
    let h : Fin 40 → ℕ := 𝓗.orderEmbOfFin h𝓗_card
    let W : ℝ → ℕ := presievingModulus 𝓗
    let R : ℝ → ℝ := fun x => x ^ ρ
    let B : ℝ → ℝ := fun x => fragmentNormalization (W x) (R x)
    let q : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) (R x) κ, p
    let T : ℝ → Finset (Fin 40 → ℕ) := fun x =>
      (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
        (fun r => Squarefree (∏ j, r j))
    let X : ℝ → ℕ → Fin (m + 1) → ℝ := fun x n =>
      fragmentBandMasses a (PrimeGap186.primeLogConfiguration (R x) n)
    let y : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → ((Fin 40 → ℕ) →₀ ℝ) :=
      fun K x => ∑ r ∈ T x, Finsupp.single r (K (fun j => X x (r j)) / B x ^ 40)
    let z : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → ((Fin 39 → ℕ) →₀ ℝ) :=
      fun K x => (y K x).sum (fun r yr => Finsupp.single
        (fun j => r (i.succAbove j)) (yr / ((r i).totient : ℝ)))
    let E : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → Finset (Fin 39 → ℕ) :=
      fun K x => (z K x).support.biUnion
        (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let C : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → ℕ → ℝ := fun K x n =>
      ∑ d ∈ E K x, if ∀ j, d j ∣ n + h (i.succAbove j) then
        selbergCoefficient (z K x) d else 0
    let P : ℕ → ℝ := fun n => if n.Prime then 1 else 0
    let I : ℝ → Finset ℕ := fun x => Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
    let erased : ℝ → ℕ → ℝ := fun x v =>
      ∑ n ∈ I x, if Nat.ModEq (W x) n v then
        P (n + h i) * C F x n * C G x n else 0
    let J : ℝ := ∫ Y : Fin 39 → Fin (m + 1) → ℝ,
      (∫ t : Fin (m + 1) → ℝ, F (i.insertNth t Y) ∂ν) *
        (∫ t : Fin (m + 1) → ℝ, G (i.insertNth t Y) ∂ν)
      ∂Measure.pi (fun _ : Fin 39 => ν)
    (∀ᶠ x : ℝ in atTop, ∀ r ∈ T x, F (fun j => X x (r j)) ≠ 0 →
      physicalSourceInnerSupport 1
        (fun j => primeLogConfiguration (R x) (r (i.succAbove j))) = 1 ∧
      logSize (R x) (∏ j : Fin 39, r (i.succAbove j)) ≤
        (physicalSourceInnerRadius 1 : ℝ)) →
    (∀ᶠ x : ℝ in atTop, ∀ r ∈ T x, G (fun j => X x (r j)) ≠ 0 →
      physicalSourceInnerSupport 1
        (fun j => primeLogConfiguration (R x) (r (i.succAbove j))) = 1 ∧
      logSize (R x) (∏ j : Fin 39, r (i.succAbove j)) ≤
        (physicalSourceInnerRadius 1 : ℝ)) →
    ∀ ε : ℝ, 0 < ε → ∀ᶠ x : ℝ in atTop,
      let Z : ℝ := x / (W x : ℝ) / B x ^ 40
      ∀ v : ℕ, Nat.Coprime (v + h i) (W x) →
        |erased x v - (ρ * J) * Z| ≤ ε * Z := by
  classical
  intro ρ κ ν h W R B q T X y z E C P I erased J hsupportF hsupportG
  have hκ : 0 < κ := by norm_num [κ, ρ]
  have hbF : Bornology.IsBounded (Set.range F) :=
    (hcF.isCompact_range hF.continuous).isBounded
  have hbG : Bornology.IsBounded (Set.range G) :=
    (hcG.isCompact_range hG.continuous).isBounded
  have hite (p : Prop) (dec : Decidable p) (u v : ℝ) :
      @ite ℝ p dec u v = @ite ℝ p (Classical.propDecidable p) u v :=
    @ite_cond_congr ℝ p p dec (Classical.propDecidable p) u v rfl
  let gram : ℝ → ℝ := fun x => ∑ d ∈ E F x, ∑ e ∈ E G x,
    if ∀ s t : Fin 39, s ≠ t → Nat.Coprime (d s) (e t) then
      selbergCoefficient (z F x) d * selbergCoefficient (z G x) e /
        (∏ j, ((Nat.lcm (d j) (e j)).totient : ℝ)) else 0
  let total : ℝ → ℝ := fun x => ∑ n ∈ I x, P (n + h i)
  let admissible : ℝ → ℕ → Prop := fun x v => Nat.Coprime (v + h i) (W x)
  have hmass : Tendsto (fun x => (Real.log x / x) * total x) atTop (nhds 1) := by
    simpa only [total, I, P, hite] using (fixed_shift_literal_weights_mass_tendsto (h i)).1
  have hgram : Tendsto (fun x => B x ^ 39 * gram x) atTop (nhds J) := by
    have hraw := canonical40_erased_prime_bilinear_tendsto
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i κ hκ a ha ha0 haLast
      F G hF.continuous.measurable hG.continuous.measurable hbF hbG
        (ae_of_all _ fun _ => hF.continuous.continuousAt)
        (ae_of_all _ fun _ => hG.continuous.continuousAt)
    simpa only [gram, E, z, y, T, hite] using hraw
  obtain ⟨C₁, hC₁, hcoefFraw⟩ :=
    (canonical40_fixed_profile_coefficient_roots (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i a F hbF).1
  obtain ⟨C₂, hC₂, hcoefGraw⟩ :=
    (canonical40_fixed_profile_coefficient_roots (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i a G hbG).1
  have hcoefF : ∀ᶠ x : ℝ in atTop, ∀ d ∈ E F x,
      |selbergCoefficient (z F x) d| ≤ C₁ * Real.log x :=
    hcoefFraw.mono fun _ hx d _ => hx.2 d
  have hcoefG : ∀ᶠ x : ℝ in atTop, ∀ d ∈ E G x,
      |selbergCoefficient (z G x) d| ≤ C₂ * Real.log x :=
    hcoefGraw.mono fun _ hx d _ => hx.2 d
  have herror : ∀ L : ℝ, 0 < L → ∃ K : ℝ, 0 < K ∧
      ∀ᶠ x : ℝ in atTop, ∀ v : ℕ, admissible x v →
        |erased x v - total x / ((W x).totient : ℝ) * gram x| ≤
          K * x / (Real.log x) ^ L := by
    have hraw := canonical40_self_prime_weighted_error (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) hDeligne i
      (fun x r => F (fun j => X x (r j))) (fun x r => G (fun j => X x (r j)))
      C₁ C₂ hC₁ hC₂
    have hf := hcoefF
    have hg := hcoefG
    have hsF := hsupportF
    have hsG := hsupportG
    simp only [E, z, y, T] at hf hg
    simp only [T] at hsF hsG
    simp only [hite] at hraw
    have herr := hraw hf hg hsF hsG
    simpa only [erased, total, gram, I, P, C, E, z, y, T, admissible,
      hite] using herr
  have hmoment := selberg40_moment_from_diagonal_error (𝓗 := 𝓗) erased admissible total gram 1 J
    hmass hgram herror
  intro ε hε
  filter_upwards [hmoment ε hε] with x hm
  intro Z v hv
  simpa only [mul_one] using hm v hv

open Classical in
theorem canonical40_minorant_erased_moment
    {𝓗 : Finset ℕ}
    {h𝓗_card : 𝓗.card = 40}
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ s : ZMod p, if s ≠ 0 ∧ s ≠ -1 then
            unnormalizedKloosterman2 p (A / s) *
              unnormalizedKloosterman2 p (B / (s + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (selfPair : Bool) {m : ℕ} (i : Fin 40) (a : Fin (m + 2) → ℝ) (ha : StrictMono a)
    (ha0 : a 0 = 0)
    (haLast : a (Fin.last (m + 1)) =
      ((19037 : ℝ) / 100000) / ((2624989 : ℝ) / 10000000))
    (F G : (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
    (hF : ContDiff ℝ ∞ F) (hG : ContDiff ℝ ∞ G)
    (hcF : HasCompactSupport F) (hcG : HasCompactSupport G) :
    let ρ : ℝ := 2624989 / 10000000
    let κ : ℝ := (19037 / 100000) / ρ
    let ν : Measure (Fin (m + 1) → ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        Measure.map (fragmentBandMasses a) (fragmentLaw κ)
    let h : Fin 40 → ℕ := 𝓗.orderEmbOfFin h𝓗_card
    let W : ℝ → ℕ := presievingModulus 𝓗
    let R : ℝ → ℝ := fun x => x ^ ρ
    let B : ℝ → ℝ := fun x => fragmentNormalization (W x) (R x)
    let q : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) (R x) κ, p
    let T : ℝ → Finset (Fin 40 → ℕ) := fun x =>
      (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
        (fun r => Squarefree (∏ j, r j))
    let X : ℝ → ℕ → Fin (m + 1) → ℝ := fun x n =>
      fragmentBandMasses a (PrimeGap186.primeLogConfiguration (R x) n)
    let y : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → ((Fin 40 → ℕ) →₀ ℝ) :=
      fun K x => ∑ r ∈ T x, Finsupp.single r (K (fun j => X x (r j)) / B x ^ 40)
    let z : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → ((Fin 39 → ℕ) →₀ ℝ) :=
      fun K x => (y K x).sum (fun r yr => Finsupp.single
        (fun j => r (i.succAbove j)) (yr / ((r i).totient : ℝ)))
    let E : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → Finset (Fin 39 → ℕ) :=
      fun K x => (z K x).support.biUnion
        (fun r => Fintype.piFinset (fun j => (r j).divisors))
    let C : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → ℕ → ℝ := fun K x n =>
      ∑ d ∈ E K x, if ∀ j, d j ∣ n + h (i.succAbove j) then
        selbergCoefficient (z K x) d else 0
    let rho : ℝ → ℕ → ℝ := fun x n => (if n.Prime then 1 else 0) -
      exceptionalPrimeDefect x 0 n -
      exceptionalPrimeDefect x 1 n
    let weight : ℝ → ℕ → ℝ := fun x n => if (n : ℝ) ≤ 2 * x then rho x n else 0
    let mass : ℝ := 1 - (exceptionalMassCoefficient 0 +
      exceptionalMassCoefficient 1)
    let I : ℝ → Finset ℕ := fun x => Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊
    let erased : ℝ → ℕ → ℝ := fun x v =>
      ∑ n ∈ I x, if Nat.ModEq (W x) n v then
        rho x (n + h i) * C F x n * C G x n else 0
    let _clipped : ℝ → ℕ → ℝ := fun x v =>
      ∑ n ∈ I x, if Nat.ModEq (W x) n v then
        weight x (n + h i) * C F x n * C G x n else 0
    let J : ℝ := ∫ Y : Fin 39 → Fin (m + 1) → ℝ,
      (∫ t : Fin (m + 1) → ℝ, F (i.insertNth t Y) ∂ν) *
        (∫ t : Fin (m + 1) → ℝ, G (i.insertNth t Y) ∂ν)
      ∂Measure.pi (fun _ : Fin 39 => ν)
    (∀ᶠ x : ℝ in atTop, ∀ r ∈ T x, F (fun j => X x (r j)) ≠ 0 →
      if selfPair then
        physicalSourceInnerSupport 1
          (fun j => primeLogConfiguration (R x) (r (i.succAbove j))) = 1 ∧
        logSize (R x) (∏ j : Fin 39, r (i.succAbove j)) ≤
          (physicalSourceInnerRadius 1 : ℝ)
      else physicalSourceOuterSupport
          (fun j => primeLogConfiguration (R x) (r j)) = 1 ∧
        logSize (R x) (∏ j, r j) ≤ 98303 * (trialMesh : ℝ)) →
    (∀ᶠ x : ℝ in atTop, ∀ r ∈ T x, G (fun j => X x (r j)) ≠ 0 →
      physicalSourceInnerSupport 1
        (fun j => primeLogConfiguration (R x) (r (i.succAbove j))) = 1 ∧
      logSize (R x) (∏ j : Fin 39, r (i.succAbove j)) ≤ 89953 * (trialMesh : ℝ)) →
    ∀ ε : ℝ, 0 < ε → ∀ᶠ x : ℝ in atTop,
      let Z : ℝ := x / (W x : ℝ) / B x ^ 40
      ∀ v : ℕ, Nat.Coprime (v + h i) (W x) →
        |erased x v - (ρ * mass * J) * Z| ≤ ε * Z := by
  classical
  intro ρ κ ν h W R B q T X y z E C rho weight mass I erased clipped J hsupportF hsupportG
  have hκ : 0 < κ := by norm_num [κ, ρ]
  have hbF : Bornology.IsBounded (Set.range F) :=
    (hcF.isCompact_range hF.continuous).isBounded
  have hbG : Bornology.IsBounded (Set.range G) :=
    (hcG.isCompact_range hG.continuous).isBounded
  have hite (p : Prop) (dec : Decidable p) (u v : ℝ) :
      @ite ℝ p dec u v = @ite ℝ p (Classical.propDecidable p) u v :=
    @ite_cond_congr ℝ p p dec (Classical.propDecidable p) u v rfl
  let gram : ℝ → ℝ := fun x => ∑ d ∈ E F x, ∑ e ∈ E G x,
    if ∀ s t : Fin 39, s ≠ t → Nat.Coprime (d s) (e t) then
      selbergCoefficient (z F x) d * selbergCoefficient (z G x) e /
        (∏ j, ((Nat.lcm (d j) (e j)).totient : ℝ)) else 0
  let total : ℝ → ℝ := fun x => ∑ n ∈ I x, weight x (n + h i)
  let admissible : ℝ → ℕ → Prop := fun x v => Nat.Coprime (v + h i) (W x)
  have htotal (x : ℝ) (hx : 0 < x) : total x =
      ∑ n ∈ Finset.Icc ⌈x + (h i : ℝ)⌉₊ ⌊2 * x⌋₊, rho x n := by
    let V : Finset ℕ := Finset.Icc ⌈x + (h i : ℝ)⌉₊ ⌊2 * x + (h i : ℝ)⌋₊
    have himage : (I x).image (fun n => n + h i) = V := by
      dsimp only [I, V]
      rw [Nat.ceil_add_natCast hx.le, Nat.floor_add_natCast (by positivity)]
      exact Finset.image_add_right_Icc _ _ _
    have hfilterV : V.filter (fun n : ℕ => (n : ℝ) ≤ 2 * x) =
        (Finset.Icc ⌈x + (h i : ℝ)⌉₊ ⌊2 * x⌋₊ : Finset ℕ) := by
      have hu : ⌊2 * x⌋₊ ≤ ⌊2 * x + (h i : ℝ)⌋₊ :=
        Nat.floor_mono (le_add_of_nonneg_right (Nat.cast_nonneg _))
      ext n
      simp only [V, Finset.mem_filter, Finset.mem_Icc,
        ← Nat.le_floor_iff (show 0 ≤ 2 * x by positivity)]
      omega
    calc
      total x = ∑ n ∈ (I x).image (fun n => n + h i), weight x n := by
        rw [Finset.sum_image (fun _ _ _ _ he => Nat.add_right_cancel he)]
      _ = ∑ n ∈ V, if (n : ℝ) ≤ 2 * x then rho x n else 0 := by rw [himage]
      _ = ∑ n ∈ V.filter (fun n : ℕ => (n : ℝ) ≤ 2 * x), rho x n :=
        (Finset.sum_filter ..).symm
      _ = _ := by rw [hfilterV]
  have hmass : Tendsto (fun x => (Real.log x / x) * total x) atTop (nhds mass) := by
    apply (clipped_literal_minorant_mass_tendsto (h i)).congr'
    filter_upwards [Filter.eventually_gt_atTop (0 : ℝ)] with x hx
    rw [htotal x hx]
  have hgram : Tendsto (fun x => B x ^ 39 * gram x) atTop (nhds J) := by
    have hraw := canonical40_erased_prime_bilinear_tendsto
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i κ hκ a ha ha0 haLast
      F G hF.continuous.measurable hG.continuous.measurable hbF hbG
        (ae_of_all _ fun _ => hF.continuous.continuousAt)
        (ae_of_all _ fun _ => hG.continuous.continuousAt)
    simpa only [gram, E, z, y, T, hite] using hraw
  obtain ⟨C₁, hC₁, hcoefFraw⟩ :=
    (canonical40_fixed_profile_coefficient_roots (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i a F hbF).1
  obtain ⟨C₂, hC₂, hcoefGraw⟩ :=
    (canonical40_fixed_profile_coefficient_roots (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i a G hbG).1
  have hcoefF : ∀ᶠ x : ℝ in atTop, ∀ d ∈ E F x,
      |selbergCoefficient (z F x) d| ≤ C₁ * Real.log x :=
    hcoefFraw.mono fun _ hx d _ => hx.2 d
  have hcoefG : ∀ᶠ x : ℝ in atTop, ∀ d ∈ E G x,
      |selbergCoefficient (z G x) d| ≤ C₂ * Real.log x :=
    hcoefGraw.mono fun _ hx d _ => hx.2 d
  have herror : ∀ L : ℝ, 0 < L → ∃ K : ℝ, 0 < K ∧
      ∀ᶠ x : ℝ in atTop, ∀ v : ℕ, admissible x v →
        |clipped x v - total x / ((W x).totient : ℝ) * gram x| ≤
          K * x / (Real.log x) ^ L := by
    have hf := hcoefF
    have hg := hcoefG
    have hsF := hsupportF
    have hsG := hsupportG
    simp only [E, z, y, T] at hf hg
    simp only [T] at hsF hsG
    cases selfPair with
    | false =>
      have hraw := canonical40_enlarged_clipped_minorant_weighted_error
        (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) hDeligne i
        (fun x r => F (fun j => X x (r j))) (fun x r => G (fun j => X x (r j)))
        C₁ C₂ hC₁ hC₂
      simp only [hite] at hraw
      have herr := hraw hf hg hsF hsG
      simpa only [clipped, total, gram, I, rho, weight, C, E, z, y, T, admissible,
        hite] using herr
    | true =>
      have hsG' : ∀ᶠ x : ℝ in atTop, ∀ r ∈ T x, G (fun j => X x (r j)) ≠ 0 →
          physicalSourceInnerSupport 1
            (fun j => primeLogConfiguration (R x) (r (i.succAbove j))) = 1 ∧
          logSize (R x) (∏ j : Fin 39, r (i.succAbove j)) ≤
            (physicalSourceInnerRadius 1 : ℝ) := by
        filter_upwards [hsupportG] with x hx
        intro r hr hne
        obtain ⟨hmask, hsize⟩ := hx r hr hne
        exact ⟨hmask, hsize.trans (by
          norm_num [physicalSourceInnerRadius, trialMesh])⟩
      simp only [T] at hsG'
      have hraw := canonical40_self_clipped_minorant_weighted_error
        (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) hDeligne i
        (fun x r => F (fun j => X x (r j))) (fun x r => G (fun j => X x (r j)))
        C₁ C₂ hC₁ hC₂
      simp only [hite] at hraw
      have herr := hraw hf hg hsF hsG'
      simpa only [clipped, total, gram, I, rho, weight, C, E, z, y, T, admissible,
        hite] using herr
  have hmoment := selberg40_moment_from_diagonal_error (𝓗 := 𝓗) clipped admissible total gram mass J
    hmass hgram herror
  obtain ⟨K₁, hK₁, hrootF⟩ :=
    (canonical40_fixed_profile_coefficient_roots
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i a F hbF).2 (1 / 8) (by norm_num)
  obtain ⟨K₂, hK₂, hrootG⟩ :=
    (canonical40_fixed_profile_coefficient_roots
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i a G hbG).2 (1 / 8) (by norm_num)
  have hroots : ∃ K : ℝ, 0 < K ∧ ∀ᶠ x : ℝ in atTop,
      ∀ n ∈ I x, |C F x n| ≤ K * x ^ (1 / 8 : ℝ) ∧
        |C G x n| ≤ K * x ^ (1 / 8 : ℝ) := by
    refine ⟨K₁ + K₂, add_pos hK₁ hK₂, ?_⟩
    filter_upwards [hrootF, hrootG, Filter.eventually_ge_atTop (0 : ℝ)]
      with x hf hg hx
    intro n hn
    have hpow : 0 ≤ x ^ (1 / 8 : ℝ) := Real.rpow_nonneg hx _
    exact ⟨(hf n hn).2.trans (mul_le_mul_of_nonneg_right
      (le_add_of_nonneg_right hK₂.le) hpow),
      (hg n hn).2.trans (mul_le_mul_of_nonneg_right
        (le_add_of_nonneg_left hK₁.le) hpow)⟩
  have htail := literal_minorant_clipped_root_moment_error (𝓗 := 𝓗) (h i) (C F) (C G)
    (fun x v n => Nat.ModEq (W x) n v) hroots
  intro ε hε
  filter_upwards [hmoment (ε / 2) (half_pos hε), htail (ε / 2) (half_pos hε)]
    with x hm ht
  intro Z v hv
  have hx0 : 0 < x := zero_lt_one.trans ht.1
  let Bx : ℝ := fragmentNormalization (W x) x
  let N : ℝ := x / (W x : ℝ) / Bx / B x ^ 39
  have hρ : 0 < ρ := by norm_num [ρ]
  have hρone : ρ ≤ 1 := by norm_num [ρ]
  have hW : (0 : ℝ) < W x := Nat.cast_pos.mpr
    (presieving_pos 𝓗 x)
  have hφ : (0 : ℝ) < (W x).totient := Nat.cast_pos.mpr
    (Nat.totient_pos.mpr (presieving_pos 𝓗 x))
  have hBx : 0 < Bx := by
    dsimp only [Bx, fragmentNormalization]
    exact mul_pos (div_pos hφ hW) (Real.log_pos ht.1)
  have hBformula : B x = ρ * Bx := by
    dsimp only [B, R, Bx, fragmentNormalization]
    rw [Real.log_rpow hx0]
    ring
  have hB : 0 < B x := hBformula.symm ▸ mul_pos hρ hBx
  have hZ : 0 < Z := div_pos (div_pos hx0 hW) (pow_pos hB 40)
  have hN : N = ρ * Z := by
    change x / (W x : ℝ) / Bx / B x ^ 39 =
      ρ * (x / (W x : ℝ) / B x ^ 40)
    rw [hBformula]
    field_simp [hW.ne', hBx.ne', hρ.ne']
  have hNZ : N ≤ Z := hN.le.trans (mul_le_of_le_one_left hZ.le hρone)
  have hdiff : |erased x v - clipped x v| ≤ (ε / 2) * Z := by
    have hh : |erased x v - clipped x v| ≤ (ε / 2) * N := by
      simpa only [erased, clipped, rho, weight, I] using ht.2.2 v
    exact hh.trans (mul_le_mul_of_nonneg_left hNZ (half_pos hε).le)
  calc
    |erased x v - (ρ * mass * J) * Z| ≤
        |erased x v - clipped x v| + |clipped x v - (ρ * mass * J) * Z| :=
      abs_sub_le _ _ _
    _ ≤ (ε / 2) * Z + (ε / 2) * Z := add_le_add hdiff (hm v hv)
    _ = ε * Z := by ring

open Classical in
theorem canonical40_fixed_source_positive_first_moment
    {𝓗 : Finset ℕ}
    {h𝓗_card : 𝓗.card = 40}
    {h𝓗_admissible : ∀ p : ℕ, p.Prime →
      ∃ a ∈ Finset.range p, a ∉ 𝓗.image (fun h => h % p)}
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    {m : ℕ} (a : Fin (m + 2) → ℝ) (ha : StrictMono a)
    (ha0 : a 0 = 0)
    (haLast : a (Fin.last (m + 1)) =
      ((19037 : ℝ) / 100000) / ((2624989 : ℝ) / 10000000))
    (F : (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
    (G H : Fin 40 → (Fin 40 → Fin (m + 1) → ℝ) → ℝ)
    (hF : ContDiff ℝ ∞ F) (hcF : HasCompactSupport F)
    (hG : ∀ i, ContDiff ℝ ∞ (G i) ∧ HasCompactSupport (G i))
    (hH : ∀ i, ContDiff ℝ ∞ (H i) ∧ HasCompactSupport (H i)) :
    let ρ : ℝ := 2624989 / 10000000
    let κ : ℝ := (19037 / 100000 : ℝ) / ρ
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    let W : ℝ → ℕ := fun x =>
      presievingModulus 𝓗 x
    let R : ℝ → ℝ := fun x => x ^ ρ
    let B : ℝ → ℝ := fun x =>
      PrimeGap186.fragmentNormalization (W x) (R x)
    let q : ℝ → ℕ := fun x =>
      ∏ p ∈ PrimeGap186.fragmentPrimes (W x) (R x) κ, p
    let ν : Measure (Fin (m + 1) → ℝ) :=
      ENNReal.ofReal (Real.exp Real.eulerMascheroniConstant * κ) •
        Measure.map (fragmentBandMasses a) (fragmentLaw κ)
    let UF : Fin 40 → (Fin 39 → Fin (m + 1) → ℝ) → ℝ := fun i Y =>
      ∫ t : Fin (m + 1) → ℝ, F (i.insertNth t Y) ∂ν
    let VG : Fin 40 → (Fin 39 → Fin (m + 1) → ℝ) → ℝ := fun i Y =>
      ∫ t : Fin (m + 1) → ℝ, G i (i.insertNth t Y) ∂ν
    let VH : Fin 40 → (Fin 39 → Fin (m + 1) → ℝ) → ℝ := fun i Y =>
      ∫ t : Fin (m + 1) → ℝ, H i (i.insertNth t Y) ∂ν
    let I₀ : ℝ := ∫ v, F v ^ 2 ∂Measure.pi (fun _ : Fin 40 => ν)
    let JAB : Fin 40 → ℝ := fun i =>
      ∫ Y, UF i Y * VG i Y ∂Measure.pi (fun _ : Fin 39 => ν)
    let JBB : Fin 40 → ℝ := fun i =>
      ∫ Y, VG i Y ^ 2 ∂Measure.pi (fun _ : Fin 39 => ν)
    let JAH : Fin 40 → ℝ := fun i =>
      ∫ Y, UF i Y * VH i Y ∂Measure.pi (fun _ : Fin 39 => ν)
    let JBH : Fin 40 → ℝ := fun i =>
      ∫ Y, VG i Y * VH i Y ∂Measure.pi (fun _ : Fin 39 => ν)
    let JHH : Fin 40 → ℝ := fun i =>
      ∫ Y, VH i Y ^ 2 ∂Measure.pi (fun _ : Fin 39 => ν)
    let E₀ : Fin 40 → ℝ := fun i =>
      ∫ Y, (UF i Y - VG i Y) ^ 2 ∂Measure.pi (fun _ : Fin 39 => ν)
    let κE : ℝ := exceptionalMassCoefficient 0 +
      exceptionalMassCoefficient 1
    (∀ (W₀ : ℕ) (R₀ : ℝ), 1 < R₀ →
      let q₀ : ℕ := ∏ p ∈ fragmentPrimes W₀ R₀ κ, p
      let T₀ : Finset (Fin 40 → ℕ) :=
        (Fintype.piFinset (fun _ : Fin 40 => q₀.divisors)).filter
          (fun r => Squarefree (∏ j, r j))
      ∀ r ∈ T₀,
        let X : Fin 40 → FiniteMeasure ℝ := fun j => primeLogConfiguration R₀ (r j)
        let v : Fin 40 → Fin (m + 1) → ℝ := fun j => fragmentBandMasses a (X j)
        (F v ≠ 0 → physicalSourceOuterSupport X = 1 ∧
          logSize R₀ (∏ j, r j) ≤ 98303 * (trialMesh : ℝ) ∧
          ((∏ j, r j : ℕ) : ℝ) ≤ R₀ ^ (2742997 / 2624989 : ℝ) ∧
          ((∏ j, r j : ℕ) : ℝ) ≤ R₀ ^ ((11 / 40 : ℝ) / ρ)) ∧
        ∀ i : Fin 40,
          (G i v ≠ 0 → physicalSourceOuterSupport X = 1 ∧
            logSize R₀ (∏ j, r j) ≤ 98303 * (trialMesh : ℝ) ∧
            physicalSourceInnerSupport 0 (i.removeNth X) = 1 ∧
            physicalSourceInnerSupport 1 (i.removeNth X) = 1 ∧
            logSize R₀ (∏ j : Fin 39, r (i.succAbove j)) ≤ 89563 * (trialMesh : ℝ) ∧
            logSize R₀ (∏ j : Fin 39, r (i.succAbove j)) ≤
              (physicalSourceInnerRadius 1 : ℝ) ∧
            ((∏ j, r j : ℕ) : ℝ) ≤ R₀ ^ ((11 / 40 : ℝ) / ρ)) ∧
          (H i v ≠ 0 → physicalSourceInnerSupport 1 (i.removeNth X) = 1 ∧
            logSize R₀ (∏ j : Fin 39, r (i.succAbove j)) ≤ 89953 * (trialMesh : ℝ) ∧
            logSize R₀ (∏ j : Fin 39, r (i.succAbove j)) ≤
              (physicalSourceInnerRadius 1 : ℝ))) →
    0 < ρ * ((∑ i : Fin 40, (2 * JAB i - JBB i)) +
      2 * (1 - κE) * (49599 / 50000) * (∑ i : Fin 40, (JAH i - JBH i)) -
      (49599 / 50000 : ℝ) ^ 2 * (∑ i : Fin 40, JHH i) -
      (49599 / 20000000 : ℝ) * (17 / 50 : ℝ) * (∑ i : Fin 40, E₀ i) -
      (49599 / 20000000 : ℝ)⁻¹ * κE * (49599 / 50000 : ℝ) ^ 2 *
        (∑ i : Fin 40, JHH i)) - I₀ →
      ∀ N : ℕ, ∃ x : ℝ, (N : ℝ) < x ∧ 1 < x ∧
        ∃ v : ℕ, v < W x ∧ (∀ j : Fin 40, Nat.Coprime (v + h j) (W x)) ∧
          let T : Finset (Fin 40 → ℕ) :=
            (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
              (fun r => Squarefree (∏ j : Fin 40, r j))
          let X : (Fin 40 → ℕ) → Fin 40 → Fin (m + 1) → ℝ :=
            fun r j => PrimeGap186.fragmentBandMasses a
              (PrimeGap186.primeLogConfiguration (R x) (r j))
          let y : (Fin 40 → ℕ) →₀ ℝ :=
            ∑ r ∈ T, Finsupp.single r (F (X r) / B x ^ 40)
          let D : Finset (Fin 40 → ℕ) :=
            y.support.biUnion (fun r =>
              Fintype.piFinset (fun j : Fin 40 => (r j).divisors))
          let A : ℕ → ℝ := fun n =>
            ∑ d ∈ D, if ∀ j : Fin 40, d j ∣ n + h j then
              PrimeGap186.selbergCoefficient y d else 0
          let S : Finset ℕ :=
            (Finset.Ico ⌈x⌉₊ ⌈2 * x⌉₊).filter (fun n => Nat.ModEq (W x) n v)
          0 < ∑ n ∈ S,
            (((𝓗.filter (fun h => (n + h).Prime)).card : ℝ) - 1) *
              A n ^ 2 := by
  intro ρ κ h W R B q ν UF VG VH I₀ JAB JBB JAH JBH JHH E₀ κE hData hMargin
  have hρ : 0 < ρ := by norm_num [ρ]
  have hρone : ρ ≤ 1 := by norm_num [ρ]
  have hκ : 0 < κ := by norm_num [κ, ρ]
  have hbF : Bornology.IsBounded (Set.range F) :=
    (hcF.isCompact_range hF.continuous).isBounded
  have hbG (i : Fin 40) : Bornology.IsBounded (Set.range (G i)) :=
    ((hG i).2.isCompact_range (hG i).1.continuous).isBounded
  have hbH (i : Fin 40) : Bornology.IsBounded (Set.range (H i)) :=
    ((hH i).2.isCompact_range (hH i).1.continuous).isBounded
  have hite (p : Prop) (dec : Decidable p) (u v : ℝ) :
      @ite ℝ p dec u v = @ite ℝ p (Classical.propDecidable p) u v :=
    @ite_cond_congr ℝ p p dec (Classical.propDecidable p) u v rfl
  let T : ℝ → Finset (Fin 40 → ℕ) := fun x =>
    (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
      (fun r => Squarefree (∏ j, r j))
  let X : ℝ → ℕ → Fin (m + 1) → ℝ := fun x n =>
    fragmentBandMasses a (primeLogConfiguration (R x) n)
  let y : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → ((Fin 40 → ℕ) →₀ ℝ) :=
    fun K x => ∑ r ∈ T x, Finsupp.single r (K (fun j => X x (r j)) / B x ^ 40)
  let z : Fin 40 → ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) →
      ℝ → ((Fin 39 → ℕ) →₀ ℝ) := fun i K x =>
    (y K x).sum (fun r yr => Finsupp.single
      (fun j => r (i.succAbove j)) (yr / ((r i).totient : ℝ)))
  let DF : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → Finset (Fin 40 → ℕ) :=
    fun K x => (y K x).support.biUnion
      (fun r => Fintype.piFinset (fun j => (r j).divisors))
  let DE : Fin 40 → ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) →
      ℝ → Finset (Fin 39 → ℕ) := fun i K x =>
    (z i K x).support.biUnion (fun r => Fintype.piFinset (fun j => (r j).divisors))
  let AA : ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → ℕ → ℝ := fun K x n =>
    ∑ d ∈ DF K x, if ∀ j, d j ∣ n + h j then selbergCoefficient (y K x) d else 0
  let CC : Fin 40 → ((Fin 40 → Fin (m + 1) → ℝ) → ℝ) → ℝ → ℕ → ℝ :=
    fun i K x n => ∑ d ∈ DE i K x, if ∀ j, d j ∣ n + h (i.succAbove j) then
      selbergCoefficient (z i K x) d else 0
  let Af : ℝ → ℕ → ℝ := AA F
  let Bf : ℝ → Fin 40 → ℕ → ℝ := fun x i => CC i (G i) x
  let Hf : ℝ → Fin 40 → ℕ → ℝ := fun x i => CC i (H i) x
  let Z : ℝ → ℝ := fun x => x / (W x : ℝ) / B x ^ 40
  let Nface : ℝ → ℝ := fun x =>
    x / (W x : ℝ) / fragmentNormalization (W x) x / B x ^ 39
  let P : ℕ → ℝ := fun n => if n.Prime then 1 else 0
  let rho : ℝ → ℕ → ℝ := fun x n => P n -
    exceptionalPrimeDefect x 0 n -
    exceptionalPrimeDefect x 1 n
  let ex : ℝ → ℕ → ℝ := fun x n =>
    exceptionalPrimeDefect x 0 n +
      exceptionalPrimeDefect x 1 n
  have hvExists (x : ℝ) : ∃ v : ℕ, v < W x ∧
      ∀ i : Fin 40, Nat.Coprime (v + h i) (W x) :=
    exists_admissible_presieve_residue
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) (h𝓗_admissible := h𝓗_admissible) (W x)
      (presieving_pos 𝓗 x)
  choose v hvlt hv using hvExists
  let s : ℝ → Finset ℕ := fun x =>
    (Finset.Icc ⌈x⌉₊ ⌊2 * x⌋₊).filter (fun n => Nat.ModEq (W x) n (v x))
  have hbase : ∀ᶠ x : ℝ in atTop,
      1 < x ∧ 1 < R x ∧ 0 < B x ∧ 0 < Z x ∧ Nface x ≤ Z x := by
    filter_upwards [Filter.eventually_gt_atTop (1 : ℝ)] with x hx
    have hx0 : 0 < x := zero_lt_one.trans hx
    have hR : 1 < R x := Real.one_lt_rpow hx hρ
    have hW : (0 : ℝ) < W x := Nat.cast_pos.mpr
      (presieving_pos 𝓗 x)
    have hφ : (0 : ℝ) < (W x).totient := Nat.cast_pos.mpr
      (Nat.totient_pos.mpr (presieving_pos 𝓗 x))
    let Bx : ℝ := fragmentNormalization (W x) x
    have hBx : 0 < Bx := by
      dsimp only [Bx, fragmentNormalization]
      exact mul_pos (div_pos hφ hW) (Real.log_pos hx)
    have hBformula : B x = ρ * Bx := by
      dsimp only [B, R, Bx, fragmentNormalization]
      rw [Real.log_rpow hx0]
      ring
    have hB : 0 < B x := hBformula.symm ▸ mul_pos hρ hBx
    have hZ : 0 < Z x := div_pos (div_pos hx0 hW) (pow_pos hB 40)
    have hN : Nface x = ρ * Z x := by
      change x / (W x : ℝ) / Bx / B x ^ 39 =
        ρ * (x / (W x : ℝ) / B x ^ 40)
      rw [hBformula]
      field_simp [hW.ne', hBx.ne', hρ.ne']
    exact ⟨hx, hR, hB, hZ,
      hN.le.trans (mul_le_of_le_one_left hZ.le hρone)⟩
  have hZ : ∀ᶠ x : ℝ in atTop, 0 < Z x :=
    hbase.mono fun _ hx => hx.2.2.2.1
  have hFout : ∀ᶠ x : ℝ in atTop, ∀ r ∈ T x,
      F (fun j => X x (r j)) ≠ 0 →
        physicalSourceOuterSupport (fun j => primeLogConfiguration (R x) (r j)) = 1 ∧
        logSize (R x) (∏ j, r j) ≤ 98303 * (trialMesh : ℝ) := by
    filter_upwards [hbase] with x hx
    intro r hr hne
    rcases (hData (W x) (R x) hx.2.1 r hr).1 hne with ⟨hout, hlog, _, _⟩
    exact ⟨hout, hlog⟩
  have hGout (i : Fin 40) : ∀ᶠ x : ℝ in atTop, ∀ r ∈ T x,
      G i (fun j => X x (r j)) ≠ 0 →
        physicalSourceOuterSupport (fun j => primeLogConfiguration (R x) (r j)) = 1 ∧
        logSize (R x) (∏ j, r j) ≤ 98303 * (trialMesh : ℝ) := by
    filter_upwards [hbase] with x hx
    intro r hr hne
    rcases ((hData (W x) (R x) hx.2.1 r hr).2 i).1 hne with
      ⟨hout, hlog, _, _, _, _, _⟩
    exact ⟨hout, hlog⟩
  have hGold (i : Fin 40) : ∀ᶠ x : ℝ in atTop, ∀ r ∈ T x,
      G i (fun j => X x (r j)) ≠ 0 →
        physicalSourceInnerSupport 0
          (fun j => primeLogConfiguration (R x) (r (i.succAbove j))) = 1 ∧
        logSize (R x) (∏ j : Fin 39, r (i.succAbove j)) ≤ 89563 * (trialMesh : ℝ) := by
    filter_upwards [hbase] with x hx
    intro r hr hne
    rcases ((hData (W x) (R x) hx.2.1 r hr).2 i).1 hne with
      ⟨_, _, hinner, _, hlog, _, _⟩
    exact ⟨hinner, hlog⟩
  have hHnew (i : Fin 40) : ∀ᶠ x : ℝ in atTop, ∀ r ∈ T x,
      H i (fun j => X x (r j)) ≠ 0 →
        physicalSourceInnerSupport 1
          (fun j => primeLogConfiguration (R x) (r (i.succAbove j))) = 1 ∧
        logSize (R x) (∏ j : Fin 39, r (i.succAbove j)) ≤ 89953 * (trialMesh : ℝ) := by
    filter_upwards [hbase] with x hx
    intro r hr hne
    rcases ((hData (W x) (R x) hx.2.1 r hr).2 i).2 hne with ⟨hinner, hlog, _⟩
    exact ⟨hinner, hlog⟩
  have hHself (i : Fin 40) : ∀ᶠ x : ℝ in atTop, ∀ r ∈ T x,
      H i (fun j => X x (r j)) ≠ 0 →
        physicalSourceInnerSupport 1
          (fun j => primeLogConfiguration (R x) (r (i.succAbove j))) = 1 ∧
        logSize (R x) (∏ j : Fin 39, r (i.succAbove j)) ≤
          (physicalSourceInnerRadius 1 : ℝ) := by
    filter_upwards [hbase] with x hx
    intro r hr hne
    rcases ((hData (W x) (R x) hx.2.1 r hr).2 i).2 hne with ⟨hinner, _, hlog⟩
    exact ⟨hinner, hlog⟩
  have hRadiusF (W₀ : ℕ) (R₀ : ℝ) (hR : 1 < R₀) (r : Fin 40 → ℕ)
      (hr : Squarefree (∏ j, r j))
      (hdiv : ∀ j, r j ∈ (∏ p ∈ fragmentPrimes W₀ R₀ κ, p).divisors)
      (hne : F (fun j => fragmentBandMasses a (primeLogConfiguration R₀ (r j))) ≠ 0) :
      ((∏ j, r j : ℕ) : ℝ) ≤ R₀ ^ (2742997 / 2624989 : ℝ) ∧
      ((∏ j, r j : ℕ) : ℝ) ≤ R₀ ^ ((11 / 40 : ℝ) / ρ) := by
    have hmem : r ∈
        (Fintype.piFinset (fun _ : Fin 40 =>
          (∏ p ∈ fragmentPrimes W₀ R₀ κ, p).divisors)).filter
            (fun t => Squarefree (∏ j, t j)) :=
      Finset.mem_filter.mpr ⟨Fintype.mem_piFinset.mpr hdiv, hr⟩
    exact ((hData W₀ R₀ hR r hmem).1 hne).right.right
  have hRadiusG (i : Fin 40) (W₀ : ℕ) (R₀ : ℝ) (hR : 1 < R₀)
      (r : Fin 40 → ℕ) (hr : Squarefree (∏ j, r j))
      (hdiv : ∀ j, r j ∈ (∏ p ∈ fragmentPrimes W₀ R₀ κ, p).divisors)
      (hne : G i (fun j => fragmentBandMasses a (primeLogConfiguration R₀ (r j))) ≠ 0) :
      ((∏ j, r j : ℕ) : ℝ) ≤ R₀ ^ ((11 / 40 : ℝ) / ρ) := by
    have hmem : r ∈
        (Fintype.piFinset (fun _ : Fin 40 =>
          (∏ p ∈ fragmentPrimes W₀ R₀ κ, p).divisors)).filter
            (fun t => Squarefree (∏ j, t j)) :=
      Finset.mem_filter.mpr ⟨Fintype.mem_piFinset.mpr hdiv, hr⟩
    rcases ((hData W₀ R₀ hR r hmem).2 i).1 hne with
      ⟨_, _, _, _, _, _, hbound⟩
    exact hbound
  have hOrd := canonical40_fixed_band_ordinary_square
    (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) κ hκ a ha ha0 haLast
    F hF.continuous.measurable hbF
      (fun W₀ R₀ hR r hr hd hn => (hRadiusF W₀ R₀ hR r hr hd hn).1)
      (ae_of_all _ fun _ => hF.continuous.continuousAt)
  have hOldAB (i : Fin 40) :=
    canonical40_base_prime_moment (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) hDeligne i a ha ha0 haLast F (G i)
      hF (hG i).1 hcF (hG i).2 hFout (hGold i)
  have hOldBB (i : Fin 40) :=
    canonical40_base_prime_moment
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) hDeligne i a ha ha0 haLast (G i) (G i)
      (hG i).1 (hG i).1 (hG i).2 (hG i).2 (hGout i) (hGold i)
  have hNewAH (i : Fin 40) :=
    canonical40_minorant_erased_moment
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) hDeligne false i a ha ha0 haLast F (H i)
      hF (hH i).1 hcF (hH i).2
      (by simpa only [Bool.false_eq_true, ↓reduceIte] using hFout) (hHnew i)
  have hNewBH (i : Fin 40) :=
    canonical40_minorant_erased_moment
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) hDeligne false i a ha ha0 haLast (G i) (H i)
      (hG i).1 (hH i).1 (hG i).2 (hH i).2
      (by simpa only [Bool.false_eq_true, ↓reduceIte] using hGout i) (hHnew i)
  have hSelfP (i : Fin 40) :=
    canonical40_self_prime_moment
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) hDeligne i a ha ha0 haLast (H i) (H i)
      (hH i).1 (hH i).1 (hH i).2 (hH i).2 (hHself i) (hHself i)
  have hSelfR (i : Fin 40) :=
    canonical40_minorant_erased_moment
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) hDeligne true i a ha ha0 haLast (H i) (H i)
      (hH i).1 (hH i).1 (hH i).2 (hH i).2
      (by simpa only [↓reduceIte] using hHself i) (hHnew i)
  have hEx (i : Fin 40) :=
    canonical40_fixed_band_exceptional_full_minus_erased_square (𝓗 := 𝓗) (h𝓗_card := h𝓗_card)
      i a ha ha0 haLast F (G i) hF.continuous.measurable
      (hG i).1.continuous.measurable hbF (hbG i)
      (fun W₀ R₀ hR r hr hd hn => (hRadiusF W₀ R₀ hR r hr hd hn).2)
      (hRadiusG i) (ae_of_all _ fun _ => hF.continuous.continuousAt)
      (ae_of_all _ fun _ => (hG i).1.continuous.continuousAt)
  have hErase (i : Fin 40) :=
    (canonical40_fixed_profiles_first_moment_erasure
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) i a F (H i) hbF (hbH i)).2
  have hCoordinates (δ : ℝ) (hδ : 0 < δ) : ∀ᶠ x : ℝ in atTop, ∀ i : Fin 40,
      |(∑ n ∈ s x, P (n + h i) * Af x n * Bf x i n) -
          (ρ * JAB i) * Z x| ≤ δ * Z x ∧
      |(∑ n ∈ s x, P (n + h i) * Bf x i n ^ 2) -
          (ρ * JBB i) * Z x| ≤ δ * Z x ∧
      |(∑ n ∈ s x, rho x (n + h i) * Af x n * Hf x i n) -
          (ρ * (1 - κE) * JAH i) * Z x| ≤ δ * Z x ∧
      |(∑ n ∈ s x, rho x (n + h i) * Bf x i n * Hf x i n) -
          (ρ * (1 - κE) * JBH i) * Z x| ≤ δ * Z x ∧
      |(∑ n ∈ s x, P (n + h i) * Hf x i n ^ 2) -
          (ρ * JHH i) * Z x| ≤ δ * Z x ∧
      |(∑ n ∈ s x, rho x (n + h i) * Hf x i n ^ 2) -
          (ρ * (1 - κE) * JHH i) * Z x| ≤ δ * Z x ∧
      (∑ n ∈ s x, ex x (n + h i) * (Af x n - Bf x i n) ^ 2) ≤
        (ρ * (17 / 50 : ℝ) * E₀ i + δ) * Z x := by
    apply Filter.eventually_all.mpr
    intro i
    have hhalf : 0 < δ / 2 := half_pos hδ
    filter_upwards [hbase, hOldAB i δ hδ, hOldBB i δ hδ,
      hNewAH i (δ / 2) hhalf, hNewBH i δ hδ,
      hSelfP i δ hδ, hSelfR i δ hδ, hEx i δ hδ, hErase i (δ / 2) hhalf]
      with x hx hAB hBB hAH hBH hPH hRH hE hAE
    refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_⟩
    · simpa only [s, Finset.sum_filter, Af, Bf, AA, CC, DF, DE, z, y, T, X,
        P, Z, JAB, UF, VG, hite] using
        (hAB (v x) (hv x i)).2
    · simpa only [s, Finset.sum_filter, Bf, CC, DE, z, y, T, X,
        P, Z, JBB, VG, pow_two, mul_assoc, hite] using
        (hBB (v x) (hv x i)).1
    · let e : ℝ := ∑ n ∈ s x, rho x (n + h i) * CC i F x n * Hf x i n
      have hmain : |e - (ρ * (1 - κE) * JAH i) * Z x| ≤ (δ / 2) * Z x := by
        simpa only [e, s, Finset.sum_filter, Hf, CC, DE, z, y, T, X,
          rho, P, Z, κE, JAH, UF, VH, hite] using
          hAH (v x) (hv x i)
      have hdiff : |(∑ n ∈ s x, rho x (n + h i) * Af x n * Hf x i n) - e| ≤
          (δ / 2) * Nface x := by
        simpa only [e, s, Finset.sum_filter, Af, Hf, AA, CC, DF, DE, z, y, T, X,
          rho, P, Nface, hite] using (hAE.2.2 (v x)).1
      calc
        |(∑ n ∈ s x, rho x (n + h i) * Af x n * Hf x i n) -
            (ρ * (1 - κE) * JAH i) * Z x| ≤
            |(∑ n ∈ s x, rho x (n + h i) * Af x n * Hf x i n) - e| +
              |e - (ρ * (1 - κE) * JAH i) * Z x| := abs_sub_le _ _ _
        _ ≤ (δ / 2) * Z x + (δ / 2) * Z x :=
          add_le_add (hdiff.trans
            (mul_le_mul_of_nonneg_left hx.2.2.2.2 hhalf.le)) hmain
        _ = δ * Z x := by ring
    · simpa only [s, Finset.sum_filter, Bf, Hf, CC, DE, z, y, T, X,
        rho, P, Z, κE, JBH, VG, VH, hite] using
        hBH (v x) (hv x i)
    · simpa only [s, Finset.sum_filter, Hf, CC, DE, z, y, T, X,
        P, Z, JHH, VH, pow_two, mul_assoc, hite] using
        hPH (v x) (hv x i)
    · simpa only [s, Finset.sum_filter, Hf, CC, DE, z, y, T, X,
        rho, P, Z, κE, JHH, VH, pow_two, mul_assoc, hite] using
        hRH (v x) (hv x i)
    · simpa only [s, Finset.sum_filter, Af, Bf, AA, CC, DF, DE, z, y, T, X,
        ex, Z, E₀, UF, VG, hite] using hE (v x)
  have hSix := literal_minorant_fin40_moment_bounds_of_coordinate_bounds
    (𝓗 := 𝓗) (h𝓗_card := h𝓗_card)
    s Af Bf Hf Z I₀ JAB JBB JAH JBH JHH E₀ hZ (by
      intro δ hδ
      filter_upwards [hOrd δ hδ, hCoordinates δ hδ] with x hOrd hCoordinates
      have hO : |(∑ n ∈ s x, Af x n ^ 2) - I₀ * Z x| ≤ δ * Z x := by
        simpa only [s, Finset.sum_filter, Af, AA, DF, y, T, X, I₀, Z,
          hite] using hOrd (v x)
      exact ⟨by nlinarith only [(abs_le.mp hO).2], hCoordinates⟩)
  have hPositive := literal_minorant_eventually_positive_first_moment_fin40
    (𝓗 := 𝓗) (h𝓗_card := h𝓗_card)
    s Af Bf Hf Z I₀ (∑ i : Fin 40, (2 * JAB i - JBB i))
      (∑ i : Fin 40, (JAH i - JBH i)) (∑ i : Fin 40, JHH i)
      (∑ i : Fin 40, E₀ i) hZ hMargin hSix
  intro N
  obtain ⟨x, hxN, hx, hxEndpoint⟩ :=
    exists_large_nonintegral_endpoint_of_eventually
      (hPositive.and hbase) (N : ℝ)
  obtain ⟨hxPositive, hxBase⟩ := hx
  have hInterval :=
    closed_interval_eq_half_open_of_no_endpoint x
      (zero_le_one.trans hxBase.1.le) hxEndpoint
  refine ⟨x, hxN, hxBase.1, v x, hvlt x, hv x, ?_⟩
  intro T' X' y' D' A' S'
  simpa only [T', X', y', D', A', S', s, Af, AA, DF, y, T, X,
    hite, hInterval] using hxPositive

end

theorem weighted_prime_detection
    {𝓗 : Finset ℕ} (s : Finset ℕ) (w : ℕ → ℝ)
    (hw : ∀ n ∈ s, 0 ≤ w n)
    (hpos : 0 < ∑ n ∈ s,
      (((𝓗.filter (fun h ↦ (n + h).Prime)).card : ℝ) - 1) * w n) :
    ∃ n ∈ s, 2 ≤ (𝓗.filter (fun h ↦ (n + h).Prime)).card := by
  obtain ⟨n, hn, hterm⟩ := Finset.exists_lt_of_sum_lt (f := fun _ => (0 : ℝ))
    (by simpa only [Finset.sum_const_zero] using hpos)
  refine ⟨n, hn, Nat.succ_le_of_lt ?_⟩
  exact_mod_cast (sub_pos.mp (pos_of_mul_pos_left hterm (hw n hn)))

theorem exists_prime_pair_of_two_prime_translates_admissibleTuple (n : ℕ)
    (hcount : 2 ≤ (admissibleTuple.filter (fun h ↦ (n + h).Prime)).card) :
    ∃ p q, n ≤ p ∧ p < q ∧ p.Prime ∧ q.Prime ∧ q - p ≤ 186 := by
  obtain ⟨a, ha, b, hb, hab⟩ := Finset.one_lt_card.mp
    (show 1 < _ from Nat.lt_of_succ_le hcount)
  obtain ⟨ha, hpa⟩ := Finset.mem_filter.mp ha
  obtain ⟨hb, hpb⟩ := Finset.mem_filter.mp hb
  have bounds : ∀ h ∈ admissibleTuple, h ≤ 186 := by decide
  have ha_bound := bounds a ha
  have hb_bound := bounds b hb
  rcases lt_or_gt_of_ne hab with hab | hba
  · exact ⟨n + a, n + b, by omega, by omega, hpa, hpb, by omega⟩
  · exact ⟨n + b, n + a, by omega, by omega, hpb, hpa, by omega⟩

theorem unbounded_consecutive_prime_pairs_of_admissibleTuple_translates
    (h : ∀ N : ℕ, ∃ n, N ≤ n ∧
      2 ≤ (admissibleTuple.filter (fun h ↦ (n + h).Prime)).card) :
    ∀ N : ℕ, ∃ p q, N ≤ p ∧ p < q ∧ p.Prime ∧ q.Prime ∧ q - p ≤ 186 ∧
      ∀ r, p < r → r < q → ¬ r.Prime := by
  intro N
  obtain ⟨n, hNn, hcount⟩ := h N
  obtain ⟨p, q, hnp, hpq, hp, hq, hgap⟩ :=
    exists_prime_pair_of_two_prime_translates_admissibleTuple n hcount
  have hex : ∃ s, p < s ∧ s.Prime := ⟨q, hpq, hq⟩
  have hsq : Nat.find hex ≤ q := Nat.find_min' hex ⟨hpq, hq⟩
  refine ⟨p, Nat.find hex, hNn.trans hnp, (Nat.find_spec hex).1,
    hp, (Nat.find_spec hex).2, (Nat.sub_le_sub_right hsq p).trans hgap, ?_⟩
  intro r hpr hrs hr
  exact Nat.find_min hex hrs ⟨hpr, hr⟩

theorem trial_sieve_margin_gt_one_div_50000 :
    (500103 : ℚ) / 500000 - 1 - (2624989 : ℚ) / 10 ^ 7 * (697 : ℚ) / 10 ^ 6 =
        (230382667 : ℚ) / 10 ^ 13 ∧
      (230382667 : ℚ) / 10 ^ 13 > 1 / 50000 := by
  norm_num

theorem primeGapLiminf_le_186_of_infinite_admissibleTuple_translates
    (hinf : Set.Infinite {n : ℕ |
      2 ≤ (PrimeGap186.admissibleTuple.filter fun h => Nat.Prime (n + h)).card}) :
    primeGapLiminf ≤ (186 : EReal) := by
  apply Filter.liminf_le_of_frequently_le'
  rw [Filter.frequently_atTop]
  intro N
  obtain ⟨n, hn, hNn⟩ := hinf.exists_gt (Nat.nth Nat.Prime N)
  change 2 ≤ (PrimeGap186.admissibleTuple.filter (fun h ↦ (n + h).Prime)).card at hn
  obtain ⟨p, q, hnp, hpq, hp, hq, hgap⟩ :=
    exists_prime_pair_of_two_prime_translates_admissibleTuple n hn
  have hqbound : q ≤ p + 186 := by omega
  have hnext : Nat.nth Nat.Prime (Nat.count Nat.Prime p + 1) ≤ q := by
    rw [← Nat.nth_count hq]
    exact Nat.nth_monotone Nat.infinite_setOfPred_prime (Nat.count_strict_mono hp hpq)
  refine ⟨Nat.count Nat.Prime p, ?_, ?_⟩
  · apply (Nat.nth_le_nth Nat.infinite_setOfPred_prime).mp
    rw [Nat.nth_count hp]
    exact hNn.le.trans hnp
  · rw [Nat.nth_count hp]
    apply EReal.sub_le_of_le_add'
    exact_mod_cast hnext.trans hqbound

section

open scoped ContDiff

/-!
## DHL[40, 2] and the prime-gap bound of 186

Combine the finite-field estimates and physical integral bounds with positive weighted moments
to obtain the prime-translate and liminf conclusions.
-/

open Classical in
/--
Construct source-supported smooth Selberg profiles with positive prime-detecting first moment at
arbitrarily large scales, assuming the prime-field and numerical bounds.
-/
theorem exists_smooth_selberg_profiles_with_positive_first_moment
    {𝓗 : Finset ℕ}
    {h𝓗_card : 𝓗.card = 40}
    {h𝓗_admissible : ∀ p : ℕ, p.Prime →
      ∃ a ∈ Finset.range p, a ∉ 𝓗.image (fun h => h % p)}
    (hDeligne :
      (∀ (p : ℕ) [Fact p.Prime] (c : ZMod p),
        c ≠ 0 → ‖normalizedKloosterman3 p c‖ ≤ (3 : ℝ)) ∧
      (∀ (p : ℕ) [Fact p.Prime] (A B : ZMod p),
        A ≠ 0 → B ≠ 0 →
          ‖∑ t : ZMod p, if t ≠ 0 ∧ t ≠ -1 then
            unnormalizedKloosterman2 p (A / t) *
              unnormalizedKloosterman2 p (B / (t + 1)) else 0‖ ≤
            8 * (p : ℝ) * Real.sqrt (p : ℝ)))
    (hNumerics :
      (∀ j : Fin outerOrderTwoBounds.length,
        physicalSourceOuterRoot 0 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((outerOrderTwoBounds.get j).2.1 : ℝ) / (10 : ℝ) ^ 18 ∧
        physicalSourceOuterFace 0 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((outerOrderTwoBounds.get j).2.2.1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (∀ j : Fin outerOrderFiveHalvesBounds.length,
        physicalSourceOuterRoot 1 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((outerOrderFiveHalvesBounds.get j).2.1 : ℝ) / (10 : ℝ) ^ 18 ∧
        physicalSourceOuterFace 1 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((outerOrderFiveHalvesBounds.get j).2.2.1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (∀ j : Fin innerBaseOrderTwoBounds.length,
        physicalSourceInnerMass 2 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((innerBaseOrderTwoBounds.get j).1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (∀ j : Fin innerBaseOrderFiveHalvesBounds.length,
        physicalSourceInnerMass 3 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((innerBaseOrderFiveHalvesBounds.get j).1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (∀ j : Fin innerEnlargedOrderTwoBounds.length,
        physicalSourceInnerMass 4 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((innerEnlargedOrderTwoBounds.get j).1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (∀ j : Fin innerEnlargedOrderFiveHalvesBounds.length,
        physicalSourceInnerMass 5 j.val /
            ((23685317816 : ℝ) / (10 : ℝ) ^ 24) ≤
          ((innerEnlargedOrderFiveHalvesBounds.get j).1 : ℝ) / (10 : ℝ) ^ 18) ∧
      (23685317816 : ℝ) / (10 : ℝ) ^ 24 ≤ trialIH ∧
      trialIH ≤ (23685317890 : ℝ) / (10 : ℝ) ^ 24 ∧
      (90248755123 : ℝ) / (10 : ℝ) ^ 24 ≤ trialJLambdaH) :
    let ρ : ℝ := 2624989 / 10000000
    let κ : ℝ := (19037 / 100000 : ℝ) / ρ
    let h : Fin 40 → ℕ :=
      𝓗.orderEmbOfFin h𝓗_card
    let W : ℝ → ℕ := fun x =>
      presievingModulus 𝓗 x
    let R : ℝ → ℝ := fun x => x ^ ρ
    let B : ℝ → ℝ := fun x =>
      fragmentNormalization (W x) (R x)
    let q : ℝ → ℕ := fun x =>
      ∏ p ∈ fragmentPrimes (W x) (R x) κ, p
    ∃ (m : ℕ) (a : Fin (m + 2) → ℝ)
      (F : (Fin 40 → Fin (m + 1) → ℝ) → ℝ),
      StrictMono a ∧ a 0 = 0 ∧ a (Fin.last (m + 1)) = κ ∧
      ContDiff ℝ ∞ F ∧ HasCompactSupport F ∧
      ∀ N : ℕ, ∃ x : ℝ, (N : ℝ) < x ∧ 1 < x ∧
        ∃ v : ℕ, v < W x ∧ (∀ j : Fin 40, Nat.Coprime (v + h j) (W x)) ∧
          let T : Finset (Fin 40 → ℕ) :=
            (Fintype.piFinset (fun _ : Fin 40 => (q x).divisors)).filter
              (fun r => Squarefree (∏ j : Fin 40, r j))
          let X : (Fin 40 → ℕ) → Fin 40 → Fin (m + 1) → ℝ :=
            fun r j => fragmentBandMasses a
              (primeLogConfiguration (R x) (r j))
          let y : (Fin 40 → ℕ) →₀ ℝ :=
            ∑ r ∈ T, Finsupp.single r (F (X r) / B x ^ 40)
          let D : Finset (Fin 40 → ℕ) :=
            y.support.biUnion (fun r =>
              Fintype.piFinset (fun j : Fin 40 => (r j).divisors))
          let A : ℕ → ℝ := fun n =>
            ∑ d ∈ D, if ∀ j : Fin 40, d j ∣ n + h j then
              selbergCoefficient y d else 0
          let S : Finset ℕ :=
            (Finset.Ico ⌈x⌉₊ ⌈2 * x⌉₊).filter (fun n => Nat.ModEq (W x) n v)
          0 < ∑ n ∈ S,
            (((𝓗.filter (fun h => (n + h).Prime)).card : ℝ) - 1) *
              A n ^ 2 := by
  intro ρ κ h W R B q
  obtain ⟨m, a, F, H, ha, ha0, haLast, hF, hFc, hH, hG,
    hFsource, hHsource, _hFmem, hpositive⟩ :=
      trial_source_supported_smooth_profiles_positive hNumerics
  let G : Fin 3 → Fin 40 → (Fin 40 → Fin (m + 1) → ℝ) → ℝ :=
    fun b i v => H b (i.removeNth v) * F v
  let D : Fin 40 → (Fin 40 → Fin (m + 1) → ℝ) → ℝ :=
    fun i v => G 1 i v - G 0 i v
  obtain ⟨_hFm, hGdata, hDdata, _hGne, _hDne,
    _C, _hC, _hFbound, _hGbound, _hDbound, hSample, hFib⟩ :=
      canonical40_correction_profile_data
        a F H hF hFc hH hG hFsource hHsource
  have hmargin :=
    canonical40_source_profile_signed_margin
      a F H hF hFc hH hFsource (by
        simpa only [show (10 : ℝ) ^ (7 : ℕ) = 10000000 by norm_num] using hpositive)
  have hOld (i : Fin 40) := (hFib i).2.1
  have hCross (i : Fin 40) := (hFib i).2.2.1
  have hSelf (i : Fin 40) := (hFib i).2.2.2
  refine ⟨m, a, F, ha, ha0, haLast, hF, hFc, ?_⟩
  exact canonical40_fixed_source_positive_first_moment
    (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) (h𝓗_admissible := h𝓗_admissible)
    hDeligne a ha ha0 haLast F (G 0) D hF hFc
    (fun i => ⟨(hGdata 0 i).1, (hGdata 0 i).2.1⟩)
    (fun i => ⟨(hDdata i).1, (hDdata i).2.1⟩)
    hSample (by simpa only [hOld, hCross, hSelf] using hmargin)

end

open Classical in
/--
Every admissible forty-element subset of the natural numbers has infinitely many translates
containing at least two primes, conditional on the three explicit input axioms.
-/
theorem infinite_two_prime_translates_of_admissible_card_eq_40
    (𝓗 : Finset ℕ)
    (h𝓗_card : 𝓗.card = 40)
    (h𝓗_admissible : ∀ p : ℕ, p.Prime →
      ∃ a ∈ Finset.range p, a ∉ 𝓗.image (fun h => h % p)) :
    Set.Infinite {n : ℕ |
      2 ≤ (𝓗.filter (fun h => (n + h).Prime)).card} := by
  have hrealization :=
    exists_smooth_selberg_profiles_with_positive_first_moment
      (𝓗 := 𝓗) (h𝓗_card := h𝓗_card) (h𝓗_admissible := h𝓗_admissible)
      ⟨kloosterman3_bound, kloosterman2_correlation_bound⟩ physical_integral_bounds
  dsimp only at hrealization
  obtain ⟨_, _, _, _, _, _, _, _, hlarge⟩ := hrealization
  apply Set.infinite_of_forall_exists_gt
  intro N
  obtain ⟨x, hNx, hx1, v, hv, hcop, hpositive⟩ := hlarge N
  obtain ⟨n, hn, htwo⟩ :=
    weighted_prime_detection (𝓗 := 𝓗) _ _
      (fun _ _ => sq_nonneg _) hpositive
  have hxn : x ≤ (n : ℝ) :=
    (Nat.le_ceil x).trans
      (Nat.cast_le.mpr (Finset.mem_Ico.mp (Finset.mem_filter.mp hn).1).1)
  refine ⟨n, htwo, ?_⟩
  exact_mod_cast hNx.trans_le hxn

/--
Transfer an infinite prime-translate statement from natural-number tuples to integer tuples by
translating the tuple above a lower bound.
-/
theorem infinite_int_prime_translates_of_nat {k j : ℕ}
    (hNat : ∀ H : Finset ℕ, H.card = k →
      (∀ p : ℕ, p.Prime → ∃ a ∈ Finset.range p,
        a ∉ H.image (fun h => h % p)) →
      Set.Infinite {n : ℕ | j ≤ (H.filter (fun h => (n + h).Prime)).card})
    (H : Finset ℤ) (hcard : H.card = k)
    (hadm : ∀ p : ℕ, p.Prime → ∃ a : ZMod p, ∀ h ∈ H, (h : ZMod p) ≠ a) :
    Set.Infinite {n : ℤ | j ≤ (H.filter (fun h => (n + h).toNat.Prime)).card} := by
  classical
  obtain ⟨b, hb⟩ := H.bddBelow
  let f : ℤ → ℕ := fun h => (h - b).toNat
  have hf (h : ℤ) (hh : h ∈ H) : (f h : ℤ) = h - b :=
    Int.toNat_of_nonneg (sub_nonneg.mpr (hb hh))
  have hinj : Set.InjOn f H := by
    intro h hh g hg heq
    have := hf h hh
    have := hf g hg
    omega
  have hnat := hNat (H.image f) (by rwa [Finset.card_image_of_injOn hinj])
  have hshift : ∀ p : ℕ, p.Prime → ∃ a ∈ Finset.range p,
      a ∉ (H.image f).image (fun h => h % p) := by
    intro p hp
    have : NeZero p := ⟨hp.ne_zero⟩
    obtain ⟨a, ha⟩ := hadm p hp
    refine ⟨(a - (b : ZMod p)).val, Finset.mem_range.mpr (ZMod.val_lt _), ?_⟩
    intro hmem
    rw [Finset.image_image] at hmem
    obtain ⟨h, hh, hmod⟩ := Finset.mem_image.mp hmem
    have hcast : (f h : ZMod p) = a - (b : ZMod p) := by
      simpa using congrArg (fun r : ℕ => (r : ZMod p)) hmod
    apply ha h hh
    have hfcast := congrArg (fun z : ℤ => (z : ZMod p)) (hf h hh)
    simpa [hcast] using hfcast.symm
  refine Set.infinite_of_injOn_mapsTo (f := fun n : ℕ => (n : ℤ) - b) ?_ ?_
    (hnat hshift)
  · intro n _ m _ heq
    exact Int.natCast_inj.mp (sub_left_injective heq)
  · intro n hn
    change j ≤ (H.filter (fun h => ((n : ℤ) - b + h).toNat.Prime)).card
    change j ≤ ((H.image f).filter (fun h => (n + h).Prime)).card at hn
    rw [Finset.filter_image, Finset.card_image_of_injOn
      (hinj.mono (Finset.filter_subset _ _))] at hn
    convert hn using 1
    congr 1
    apply Finset.filter_congr
    intro h hh
    have heq : ((n : ℤ) - b + h).toNat = n + f h := by
      have := hf h hh
      omega
    rw [heq]

/-- Theorem 1.1 of the main paper, with the three explicit input axioms above.
`Int.toNat.Prime` counts positive primes and excludes negative integers. -/
theorem dhl_40_2
    (H : Finset ℤ) (hcard : H.card = 40)
    (hadm : ∀ p : ℕ, p.Prime → ∃ a : ZMod p, ∀ h ∈ H, (h : ZMod p) ≠ a) :
    Set.Infinite {n : ℤ | 2 ≤ (H.filter (fun h => (n + h).toNat.Prime)).card} :=
  infinite_int_prime_translates_of_nat
    infinite_two_prime_translates_of_admissible_card_eq_40
    H hcard hadm

/-- The explicit tuple in Equation (1.3) of the main paper, now a specialization of DHL[40,2]. -/
theorem infinite_two_prime_translates_admissibleTuple :
    Set.Infinite {n : ℕ |
      2 ≤ (PrimeGap186.admissibleTuple.filter (fun h => (n + h).Prime)).card} :=
  infinite_two_prime_translates_of_admissible_card_eq_40
    PrimeGap186.admissibleTuple admissibleTuple_card admissibleTuple_admissible

open Classical in
/--
Corollary 1.2 of the main paper: the prime-gap liminf is at most 186, conditional on the prime-field
estimates and the numerical companion bounds.
-/
theorem primeGapLiminf_le_186 :
    primeGapLiminf ≤ (186 : EReal) :=
  primeGapLiminf_le_186_of_infinite_admissibleTuple_translates
    infinite_two_prime_translates_admissibleTuple

end PrimeGap186